summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBill Wohler <wohler@newt.com>2012-11-24 19:43:02 -0800
committerBill Wohler <wohler@newt.com>2012-11-24 19:43:02 -0800
commit5244bc019bf7376caff3bb198ff674e0ad9fb0e6 (patch)
tree02ee1615e904771f692ec2957c79a08ae029a13d
parent9f7e719509474e92f85955e22e57ffeebd4e96f3 (diff)
parentc07a6ded1df2f4156badc9add2953579622c3722 (diff)
downloademacs-5244bc019bf7376caff3bb198ff674e0ad9fb0e6.tar.gz
Merge from trunk.
-rw-r--r--.dir-locals.el4
-rw-r--r--BUGS13
-rw-r--r--ChangeLog1863
-rw-r--r--GNUmakefile2
-rw-r--r--INSTALL108
-rw-r--r--INSTALL.BZR9
-rw-r--r--Makefile.in665
-rw-r--r--README19
-rw-r--r--admin/CPP-DEFINES510
-rw-r--r--admin/ChangeLog442
-rw-r--r--admin/FOR-RELEASE195
-rw-r--r--admin/MAINTAINERS4
-rw-r--r--admin/README2
-rw-r--r--admin/admin.el313
-rw-r--r--admin/alloc-colors.c2
-rwxr-xr-xadmin/build-configs2
-rw-r--r--admin/bzrmerge.el52
-rw-r--r--admin/charsets/Makefile127
-rw-r--r--admin/charsets/gb180302.awk21
-rwxr-xr-xadmin/charsets/mapconv13
-rw-r--r--admin/charsets/mapfiles/MULE-ethiopic.map2
-rw-r--r--admin/charsets/mapfiles/MULE-ipa.map2
-rw-r--r--admin/charsets/mapfiles/MULE-is13194.map2
-rw-r--r--admin/charsets/mapfiles/MULE-lviscii.map2
-rw-r--r--admin/charsets/mapfiles/MULE-sisheng.map2
-rw-r--r--admin/charsets/mapfiles/MULE-tibetan.map2
-rw-r--r--admin/charsets/mapfiles/MULE-uviscii.map2
-rw-r--r--admin/charsets/mapfiles/README2
-rw-r--r--admin/charsets/mule-charsets.el2
-rw-r--r--admin/coccinelle/README3
-rw-r--r--admin/coccinelle/build_string.cocci6
-rw-r--r--admin/coccinelle/frame.cocci133
-rw-r--r--admin/coccinelle/list_loop.cocci19
-rw-r--r--admin/coccinelle/process.cocci110
-rw-r--r--admin/coccinelle/unibyte_string.cocci6
-rw-r--r--admin/coccinelle/vector_contents.cocci16
-rw-r--r--admin/coccinelle/window.cocci242
-rw-r--r--admin/coccinelle/xzalloc.cocci10
-rw-r--r--admin/cus-test.el2
-rwxr-xr-xadmin/diff-tar-files2
-rw-r--r--admin/grammars/README4
-rw-r--r--admin/grammars/c.by19
-rw-r--r--admin/grammars/grammar.wy14
-rw-r--r--admin/grammars/java-tags.wy14
-rw-r--r--admin/grammars/js.wy3
-rw-r--r--admin/grammars/make.by3
-rw-r--r--admin/grammars/python.wy69
-rw-r--r--admin/grammars/scheme.by3
-rw-r--r--admin/grammars/srecode-template.wy69
-rwxr-xr-xadmin/make-announcement2
-rwxr-xr-xadmin/make-emacs8
-rw-r--r--admin/make-tarball.txt11
-rwxr-xr-xadmin/merge-gnulib94
-rw-r--r--admin/notes/bugtracker54
-rw-r--r--admin/notes/copyright6
-rw-r--r--admin/notes/documentation3
-rw-r--r--admin/notes/font-backend2
-rw-r--r--admin/notes/lel-TODO13
-rw-r--r--admin/notes/multi-tty6
-rw-r--r--admin/notes/tags1006
-rw-r--r--admin/notes/unicode30
-rw-r--r--admin/nt/README-UNDUMP.W322
-rw-r--r--admin/nt/README-ftp-server2
-rwxr-xr-xadmin/quick-install-emacs10
-rw-r--r--admin/unidata/BidiMirroring.txt23
-rw-r--r--admin/unidata/Makefile.in42
-rw-r--r--admin/unidata/README2
-rw-r--r--admin/unidata/UnicodeData.txt808
-rw-r--r--admin/unidata/copyright.html76
-rw-r--r--admin/unidata/unidata-gen.el14
-rwxr-xr-xautogen.sh13
-rw-r--r--autogen/Makefile.in358
-rw-r--r--autogen/aclocal.m431
-rw-r--r--autogen/config.in748
-rwxr-xr-xautogen/configure9529
-rwxr-xr-xautogen/copy_autogen17
-rwxr-xr-xautogen/update_autogen4
-rwxr-xr-xbuild-aux/move-if-change6
-rw-r--r--build-aux/snippet/_Noreturn.h2
-rw-r--r--build-aux/snippet/arg-nonnull.h2
-rw-r--r--build-aux/snippet/c++defs.h2
-rw-r--r--build-aux/snippet/warn-on-use.h2
-rwxr-xr-xbuild-aux/update-subdirs (renamed from update-subdirs)2
-rw-r--r--config.bat25
-rw-r--r--configure.ac (renamed from configure.in)2229
-rw-r--r--doc/emacs/ChangeLog1077
-rw-r--r--doc/emacs/Makefile.in46
-rw-r--r--doc/emacs/abbrevs.texi20
-rw-r--r--doc/emacs/ack.texi286
-rw-r--r--doc/emacs/anti.texi172
-rw-r--r--doc/emacs/arevert-xtra.texi8
-rw-r--r--doc/emacs/basic.texi83
-rw-r--r--doc/emacs/buffers.texi281
-rw-r--r--doc/emacs/building.texi180
-rw-r--r--doc/emacs/cal-xtra.texi123
-rw-r--r--doc/emacs/calendar.texi223
-rw-r--r--doc/emacs/cmdargs.texi256
-rw-r--r--doc/emacs/commands.texi12
-rw-r--r--doc/emacs/custom.texi1133
-rw-r--r--doc/emacs/dired-xtra.texi13
-rw-r--r--doc/emacs/dired.texi147
-rw-r--r--doc/emacs/display.texi273
-rw-r--r--doc/emacs/doclicense.texi27
-rw-r--r--doc/emacs/emacs-xtra.texi11
-rw-r--r--doc/emacs/emacs.texi554
-rw-r--r--doc/emacs/emacsver.texi2
-rw-r--r--doc/emacs/emerge-xtra.texi26
-rw-r--r--doc/emacs/entering.texi29
-rw-r--r--doc/emacs/files.texi150
-rw-r--r--doc/emacs/fixit.texi29
-rw-r--r--doc/emacs/fortran-xtra.texi71
-rw-r--r--doc/emacs/frames.texi125
-rw-r--r--doc/emacs/glossary.texi270
-rw-r--r--doc/emacs/gnu.texi4
-rw-r--r--doc/emacs/gpl.texi8
-rw-r--r--doc/emacs/help.texi19
-rw-r--r--doc/emacs/indent.texi4
-rw-r--r--doc/emacs/killing.texi26
-rw-r--r--doc/emacs/kmacro.texi21
-rw-r--r--doc/emacs/m-x.texi4
-rw-r--r--doc/emacs/macos.texi89
-rw-r--r--doc/emacs/maintaining.texi75
-rw-r--r--doc/emacs/makefile.w32-in11
-rw-r--r--doc/emacs/mark.texi15
-rw-r--r--doc/emacs/mini.texi155
-rw-r--r--doc/emacs/misc.texi1507
-rw-r--r--doc/emacs/modes.texi16
-rw-r--r--doc/emacs/msdog-xtra.texi41
-rw-r--r--doc/emacs/msdog.texi93
-rw-r--r--doc/emacs/mule.texi454
-rw-r--r--doc/emacs/package.texi63
-rw-r--r--doc/emacs/picture-xtra.texi11
-rw-r--r--doc/emacs/programs.texi72
-rw-r--r--doc/emacs/regs.texi30
-rw-r--r--doc/emacs/rmail.texi126
-rw-r--r--doc/emacs/screen.texi47
-rw-r--r--doc/emacs/search.texi119
-rw-r--r--doc/emacs/sending.texi360
-rw-r--r--doc/emacs/text.texi349
-rw-r--r--doc/emacs/trouble.texi418
-rw-r--r--doc/emacs/vc-xtra.texi4
-rw-r--r--doc/emacs/vc1-xtra.texi12
-rw-r--r--doc/emacs/windows.texi33
-rw-r--r--doc/emacs/xresources.texi947
-rw-r--r--doc/lispintro/ChangeLog82
-rw-r--r--doc/lispintro/Makefile.in32
-rw-r--r--doc/lispintro/README2
-rw-r--r--doc/lispintro/cons-1.eps2
-rw-r--r--doc/lispintro/cons-2.eps2
-rw-r--r--doc/lispintro/cons-2a.eps2
-rw-r--r--doc/lispintro/cons-3.eps2
-rw-r--r--doc/lispintro/cons-4.eps2
-rw-r--r--doc/lispintro/cons-5.eps2
-rw-r--r--doc/lispintro/doclicense.texi27
-rw-r--r--doc/lispintro/drawers.eps2
-rw-r--r--doc/lispintro/emacs-lisp-intro.texi892
-rw-r--r--doc/lispintro/lambda-1.eps2
-rw-r--r--doc/lispintro/lambda-2.eps2
-rw-r--r--doc/lispintro/lambda-3.eps2
-rw-r--r--doc/lispintro/makefile.w32-in12
-rw-r--r--doc/lispref/ChangeLog2024
-rw-r--r--doc/lispref/Makefile.in41
-rw-r--r--doc/lispref/README25
-rw-r--r--doc/lispref/abbrevs.texi139
-rw-r--r--doc/lispref/advice.texi106
-rw-r--r--doc/lispref/anti.texi200
-rw-r--r--doc/lispref/back.texi2
-rw-r--r--doc/lispref/backups.texi62
-rw-r--r--doc/lispref/book-spine.texi4
-rw-r--r--doc/lispref/buffers.texi144
-rw-r--r--doc/lispref/commands.texi438
-rw-r--r--doc/lispref/compile.texi337
-rw-r--r--doc/lispref/control.texi128
-rw-r--r--doc/lispref/customize.texi545
-rw-r--r--doc/lispref/debugging.texi332
-rw-r--r--doc/lispref/display.texi2545
-rw-r--r--doc/lispref/doclicense.texi29
-rw-r--r--doc/lispref/edebug.texi103
-rw-r--r--doc/lispref/elisp-covers.texi252
-rw-r--r--doc/lispref/elisp.texi252
-rw-r--r--doc/lispref/errors.texi195
-rw-r--r--doc/lispref/eval.texi202
-rw-r--r--doc/lispref/files.texi629
-rw-r--r--doc/lispref/frames.texi534
-rw-r--r--doc/lispref/front-cover-1.texi52
-rw-r--r--doc/lispref/functions.texi900
-rw-r--r--doc/lispref/gpl.texi14
-rw-r--r--doc/lispref/hash.texi13
-rw-r--r--doc/lispref/help.texi199
-rw-r--r--doc/lispref/hooks.texi372
-rw-r--r--doc/lispref/index.texi3
-rw-r--r--doc/lispref/internals.texi763
-rw-r--r--doc/lispref/intro.texi134
-rw-r--r--doc/lispref/keymaps.texi621
-rw-r--r--doc/lispref/lay-flat.texi2
-rw-r--r--doc/lispref/lists.texi248
-rw-r--r--doc/lispref/loading.texi350
-rw-r--r--doc/lispref/locals.texi217
-rw-r--r--doc/lispref/macros.texi247
-rw-r--r--doc/lispref/makefile.w32-in22
-rw-r--r--doc/lispref/maps.texi287
-rw-r--r--doc/lispref/markers.texi104
-rw-r--r--doc/lispref/minibuf.texi897
-rw-r--r--doc/lispref/modes.texi1361
-rw-r--r--doc/lispref/nonascii.texi35
-rw-r--r--doc/lispref/numbers.texi371
-rw-r--r--doc/lispref/objects.texi336
-rw-r--r--doc/lispref/os.texi1144
-rw-r--r--doc/lispref/package.texi54
-rw-r--r--doc/lispref/positions.texi61
-rw-r--r--doc/lispref/processes.texi817
-rw-r--r--doc/lispref/searching.texi285
-rw-r--r--doc/lispref/sequences.texi132
-rw-r--r--doc/lispref/spellfile1
-rw-r--r--doc/lispref/streams.texi26
-rw-r--r--doc/lispref/strings.texi72
-rw-r--r--doc/lispref/symbols.texi217
-rw-r--r--doc/lispref/syntax.texi819
-rw-r--r--doc/lispref/text.texi658
-rwxr-xr-xdoc/lispref/tindex.pl124
-rw-r--r--doc/lispref/tips.texi325
-rw-r--r--doc/lispref/two-volume-cross-refs.txt2
-rw-r--r--doc/lispref/two-volume.make37
-rw-r--r--doc/lispref/two.el78
-rw-r--r--doc/lispref/variables.texi1305
-rw-r--r--doc/lispref/vol1.texi1555
-rw-r--r--doc/lispref/vol2.texi1554
-rw-r--r--doc/lispref/windows.texi1597
-rw-r--r--doc/man/ChangeLog12
-rw-r--r--doc/man/ebrowse.12
-rw-r--r--doc/man/emacs.18
-rw-r--r--doc/man/etags.13
-rw-r--r--doc/man/grep-changelog.12
-rw-r--r--doc/man/rcs-checkin.187
-rw-r--r--doc/misc/ChangeLog1238
-rw-r--r--doc/misc/Makefile.in647
-rw-r--r--doc/misc/ada-mode.texi2
-rw-r--r--doc/misc/auth.texi216
-rw-r--r--doc/misc/autotype.texi2
-rw-r--r--doc/misc/calc.texi865
-rw-r--r--doc/misc/cc-mode.texi38
-rw-r--r--doc/misc/cl.texi3613
-rw-r--r--doc/misc/dbus.texi326
-rw-r--r--doc/misc/dired-x.texi64
-rw-r--r--doc/misc/doclicense.texi26
-rw-r--r--doc/misc/ebrowse.texi4
-rw-r--r--doc/misc/ede.texi857
-rw-r--r--doc/misc/ediff.texi8
-rw-r--r--doc/misc/edt.texi2
-rw-r--r--doc/misc/eieio.texi143
-rw-r--r--doc/misc/emacs-gnutls.texi198
-rw-r--r--doc/misc/emacs-mime.texi12
-rw-r--r--doc/misc/epa.texi2
-rw-r--r--doc/misc/erc.texi364
-rw-r--r--doc/misc/ert.texi10
-rw-r--r--doc/misc/eshell.texi4
-rw-r--r--doc/misc/eudc.texi2
-rw-r--r--doc/misc/faq.texi318
-rw-r--r--doc/misc/flymake.texi56
-rw-r--r--doc/misc/forms.texi11
-rw-r--r--doc/misc/gnus-coding.texi2
-rw-r--r--doc/misc/gnus-faq.texi17
-rw-r--r--doc/misc/gnus-news.el4
-rw-r--r--doc/misc/gnus-news.texi6
-rw-r--r--doc/misc/gnus.texi408
-rw-r--r--doc/misc/gpl.texi8
-rw-r--r--doc/misc/idlwave.texi18
-rw-r--r--doc/misc/info.texi12
-rw-r--r--doc/misc/mairix-el.texi2
-rw-r--r--doc/misc/makefile.w32-in246
-rw-r--r--doc/misc/message.texi52
-rw-r--r--doc/misc/mh-e.texi29
-rw-r--r--doc/misc/newsticker.texi41
-rw-r--r--doc/misc/nxml-mode.texi79
-rw-r--r--doc/misc/org.texi3638
-rw-r--r--doc/misc/pcl-cvs.texi10
-rw-r--r--doc/misc/pgg.texi2
-rw-r--r--doc/misc/rcirc.texi2
-rw-r--r--doc/misc/reftex.texi1305
-rw-r--r--doc/misc/remember.texi11
-rw-r--r--doc/misc/sasl.texi2
-rw-r--r--doc/misc/sc.texi151
-rw-r--r--doc/misc/sem-user.texi8
-rw-r--r--doc/misc/semantic.texi4
-rw-r--r--doc/misc/ses.texi135
-rw-r--r--doc/misc/sieve.texi2
-rw-r--r--doc/misc/smtpmail.texi213
-rw-r--r--doc/misc/speedbar.texi2
-rw-r--r--doc/misc/texinfo.tex722
-rw-r--r--doc/misc/tramp.texi259
-rw-r--r--doc/misc/trampver.texi4
-rw-r--r--doc/misc/url.texi667
-rw-r--r--doc/misc/vip.texi4
-rw-r--r--doc/misc/viper.texi14
-rw-r--r--doc/misc/widget.texi2
-rw-r--r--doc/misc/woman.texi18
-rw-r--r--etc/AUTHORS663
-rw-r--r--etc/CONTRIBUTE25
-rw-r--r--etc/ChangeLog468
-rw-r--r--etc/DEBUG2
-rw-r--r--etc/DISTRIB2
-rw-r--r--etc/ERC-NEWS4
-rw-r--r--etc/ETAGS.EBNF2
-rw-r--r--etc/ETAGS.README2
-rw-r--r--etc/GNU2
-rw-r--r--etc/GNUS-NEWS265
-rw-r--r--etc/HELLO7
-rw-r--r--etc/MACHINES17
-rw-r--r--etc/MAILINGLISTS2
-rw-r--r--etc/MH-E-NEWS2
-rw-r--r--etc/MORE.STUFF141
-rw-r--r--etc/NEWS2400
-rw-r--r--etc/NEWS.1-172
-rw-r--r--etc/NEWS.182
-rw-r--r--etc/NEWS.194
-rw-r--r--etc/NEWS.202
-rw-r--r--etc/NEWS.214
-rw-r--r--etc/NEWS.224
-rw-r--r--etc/NEWS.2316
-rw-r--r--etc/NEXTSTEP2
-rw-r--r--etc/ORG-NEWS1432
-rw-r--r--etc/PROBLEMS153
-rw-r--r--etc/README2
-rw-r--r--etc/TERMS2
-rw-r--r--etc/TODO85
-rw-r--r--etc/charsets/CNS-2.map2
-rw-r--r--etc/charsets/CNS-3.map2
-rw-r--r--etc/charsets/CNS-4.map2
-rw-r--r--etc/charsets/CNS-5.map2
-rw-r--r--etc/charsets/CNS-6.map2
-rw-r--r--etc/charsets/CNS-7.map2
-rw-r--r--etc/charsets/CP932-2BYTE.map2
-rw-r--r--etc/charsets/GB180302.map23
-rw-r--r--etc/charsets/GB180304.map329
-rw-r--r--etc/charsets/JISC6226.map9
-rw-r--r--etc/charsets/JISX2131.map10
-rw-r--r--etc/charsets/MIK.map2
-rw-r--r--etc/charsets/MULE-ethiopic.map2
-rw-r--r--etc/charsets/MULE-ipa.map2
-rw-r--r--etc/charsets/MULE-is13194.map2
-rw-r--r--etc/charsets/MULE-lviscii.map2
-rw-r--r--etc/charsets/MULE-sisheng.map2
-rw-r--r--etc/charsets/MULE-tibetan.map2
-rw-r--r--etc/charsets/MULE-uviscii.map2
-rw-r--r--etc/charsets/PTCP154.map2
-rw-r--r--etc/charsets/README3
-rw-r--r--etc/charsets/stdenc.map2
-rw-r--r--etc/charsets/symbol.map2
-rw-r--r--etc/compilation.txt9
-rw-r--r--etc/edt-user.el2
-rw-r--r--etc/emacs-buffer.gdb9
-rw-r--r--etc/emacs.py10
-rw-r--r--etc/emacs2.py236
-rw-r--r--etc/emacs3.py234
-rw-r--r--etc/enriched.doc2
-rw-r--r--etc/forms/README1
-rw-r--r--etc/forms/forms-d2.dat (renamed from etc/forms-d2.dat)0
-rw-r--r--etc/forms/forms-d2.el (renamed from lisp/forms-d2.el)6
-rw-r--r--etc/forms/forms-pass.el (renamed from lisp/forms-pass.el)2
-rw-r--r--etc/future-bug2
-rw-r--r--etc/gnus-tut.txt2
-rw-r--r--etc/grep.txt2
-rw-r--r--etc/images/README8
-rw-r--r--etc/images/checked.xpm2
-rw-r--r--etc/images/custom/README2
-rw-r--r--etc/images/ezimage/README2
-rw-r--r--etc/images/gnus/README6
-rw-r--r--etc/images/gnus/gnus.svg2
-rw-r--r--etc/images/gud/README6
-rw-r--r--etc/images/icons/README6
-rw-r--r--etc/images/icons/hicolor/scalable/apps/emacs.svg2
-rw-r--r--etc/images/icons/hicolor/scalable/mimetypes/emacs-document.svg2
-rw-r--r--etc/images/mh-logo.xpm2
-rw-r--r--etc/images/mpc/README2
-rw-r--r--etc/images/newsticker/README2
-rw-r--r--etc/images/smilies/README2
-rw-r--r--etc/images/smilies/grayscale/README2
-rw-r--r--etc/images/smilies/medium/README2
-rw-r--r--etc/images/splash.pngbin39572 -> 37472 bytes
-rw-r--r--etc/images/splash.svg199
-rw-r--r--etc/images/splash.xpm2
-rw-r--r--etc/images/tree-widget/default/README2
-rw-r--r--etc/images/tree-widget/folder/README2
-rw-r--r--etc/images/unchecked.xpm2
-rw-r--r--etc/org/OrgOdtContentTemplate.xml263
-rw-r--r--etc/org/OrgOdtStyles.xml797
-rw-r--r--etc/org/README36
-rw-r--r--etc/ps-prin0.ps2
-rw-r--r--etc/ps-prin1.ps2
-rw-r--r--etc/publicsuffix.txt5189
-rw-r--r--etc/refcards/Makefile29
-rw-r--r--etc/refcards/README15
-rw-r--r--etc/refcards/calccard.pdfbin153616 -> 153779 bytes
-rw-r--r--etc/refcards/calccard.tex7
-rw-r--r--etc/refcards/cs-dired-ref.pdfbin67057 -> 66941 bytes
-rw-r--r--etc/refcards/cs-dired-ref.tex5
-rw-r--r--etc/refcards/cs-refcard.pdfbin87237 -> 87189 bytes
-rw-r--r--etc/refcards/cs-refcard.tex5
-rw-r--r--etc/refcards/cs-survival.tex5
-rw-r--r--etc/refcards/de-refcard.pdfbin125665 -> 125594 bytes
-rw-r--r--etc/refcards/de-refcard.tex5
-rw-r--r--etc/refcards/dired-ref.pdfbin85646 -> 85574 bytes
-rw-r--r--etc/refcards/dired-ref.tex5
-rw-r--r--etc/refcards/emacsver.tex4
-rw-r--r--etc/refcards/fr-dired-ref.pdfbin87517 -> 87452 bytes
-rw-r--r--etc/refcards/fr-dired-ref.tex5
-rw-r--r--etc/refcards/fr-refcard.pdfbin121482 -> 121431 bytes
-rw-r--r--etc/refcards/fr-refcard.tex5
-rw-r--r--etc/refcards/fr-survival.tex5
-rw-r--r--etc/refcards/gnus-booklet.pdfbin152568 -> 152542 bytes
-rw-r--r--etc/refcards/gnus-logo.eps2
-rw-r--r--etc/refcards/gnus-refcard.pdfbin154872 -> 154831 bytes
-rw-r--r--etc/refcards/gnus-refcard.tex2
-rw-r--r--etc/refcards/orgcard.pdfbin60101 -> 118492 bytes
-rw-r--r--etc/refcards/orgcard.tex20
-rw-r--r--etc/refcards/pdflayout.sty2
-rw-r--r--etc/refcards/pl-refcard.pdfbin65689 -> 92536 bytes
-rw-r--r--etc/refcards/pl-refcard.tex5
-rw-r--r--etc/refcards/pt-br-refcard.pdfbin116731 -> 116662 bytes
-rw-r--r--etc/refcards/pt-br-refcard.tex5
-rw-r--r--etc/refcards/refcard.pdfbin116497 -> 116725 bytes
-rw-r--r--etc/refcards/refcard.tex5
-rw-r--r--etc/refcards/ru-refcard.pdfbin147939 -> 147864 bytes
-rw-r--r--etc/refcards/ru-refcard.tex6
-rw-r--r--etc/refcards/sk-dired-ref.pdfbin66284 -> 66171 bytes
-rw-r--r--etc/refcards/sk-dired-ref.tex5
-rw-r--r--etc/refcards/sk-refcard.pdfbin88590 -> 88535 bytes
-rw-r--r--etc/refcards/sk-refcard.tex5
-rw-r--r--etc/refcards/sk-survival.tex5
-rw-r--r--etc/refcards/survival.tex5
-rw-r--r--etc/refcards/vipcard.tex4
-rw-r--r--etc/refcards/viperCard.tex4
-rw-r--r--etc/schema/locate.rnc2
-rw-r--r--etc/schema/relaxng.rnc2
-rw-r--r--etc/schema/schemas.xml2
-rw-r--r--etc/ses-example.ses2
-rw-r--r--etc/spook.linesbin4447 -> 9643 bytes
-rw-r--r--etc/srecode/c.srt164
-rw-r--r--etc/srecode/cpp.srt125
-rw-r--r--etc/srecode/default.srt2
-rw-r--r--etc/srecode/doc-cpp.srt2
-rw-r--r--etc/srecode/doc-default.srt2
-rw-r--r--etc/srecode/doc-java.srt2
-rw-r--r--etc/srecode/ede-autoconf.srt54
-rw-r--r--etc/srecode/ede-make.srt34
-rw-r--r--etc/srecode/el.srt4
-rw-r--r--etc/srecode/getset-cpp.srt2
-rw-r--r--etc/srecode/java.srt2
-rw-r--r--etc/srecode/make.srt2
-rw-r--r--etc/srecode/template.srt2
-rw-r--r--etc/srecode/test.srt2
-rw-r--r--etc/srecode/texi.srt2
-rw-r--r--etc/srecode/wisent.srt2
-rw-r--r--etc/themes/adwaita-theme.el2
-rw-r--r--etc/themes/deeper-blue-theme.el3
-rw-r--r--etc/themes/dichromacy-theme.el2
-rw-r--r--etc/themes/light-blue-theme.el2
-rw-r--r--etc/themes/manoj-dark-theme.el40
-rw-r--r--etc/themes/misterioso-theme.el2
-rw-r--r--etc/themes/tango-dark-theme.el5
-rw-r--r--etc/themes/tango-theme.el2
-rw-r--r--etc/themes/tsdh-dark-theme.el7
-rw-r--r--etc/themes/tsdh-light-theme.el2
-rw-r--r--etc/themes/wheatgrass-theme.el6
-rw-r--r--etc/themes/whiteboard-theme.el2
-rw-r--r--etc/themes/wombat-theme.el2
-rw-r--r--etc/tutorials/TUTORIAL417
-rw-r--r--etc/tutorials/TUTORIAL.bg692
-rw-r--r--etc/tutorials/TUTORIAL.cn4
-rw-r--r--etc/tutorials/TUTORIAL.cs2
-rw-r--r--etc/tutorials/TUTORIAL.de748
-rw-r--r--etc/tutorials/TUTORIAL.eo2
-rw-r--r--etc/tutorials/TUTORIAL.es558
-rw-r--r--etc/tutorials/TUTORIAL.fr396
-rw-r--r--etc/tutorials/TUTORIAL.he231
-rw-r--r--etc/tutorials/TUTORIAL.it2
-rw-r--r--etc/tutorials/TUTORIAL.ja2
-rw-r--r--etc/tutorials/TUTORIAL.ko2
-rw-r--r--etc/tutorials/TUTORIAL.nl809
-rw-r--r--etc/tutorials/TUTORIAL.pl2
-rw-r--r--etc/tutorials/TUTORIAL.pt_BR4
-rw-r--r--etc/tutorials/TUTORIAL.ro2
-rw-r--r--etc/tutorials/TUTORIAL.ru1858
-rw-r--r--etc/tutorials/TUTORIAL.sk2
-rw-r--r--etc/tutorials/TUTORIAL.sl1323
-rw-r--r--etc/tutorials/TUTORIAL.sv412
-rw-r--r--etc/tutorials/TUTORIAL.th2
-rw-r--r--etc/tutorials/TUTORIAL.translators13
-rw-r--r--etc/tutorials/TUTORIAL.zh2
-rw-r--r--info/.gitignore2
-rw-r--r--info/dir17
-rw-r--r--leim/ChangeLog150
-rw-r--r--leim/Makefile.in241
-rw-r--r--leim/README2
-rw-r--r--leim/SKK-DIC/SKK-JISYO.L2
-rw-r--r--leim/ja-dic/ja-dic.el2
-rw-r--r--leim/leim-ext.el2
-rw-r--r--leim/makefile.w32-in12
-rw-r--r--leim/quail/arabic.el2
-rw-r--r--leim/quail/croatian.el2
-rw-r--r--leim/quail/cyril-jis.el2
-rw-r--r--leim/quail/cyrillic.el75
-rw-r--r--leim/quail/czech.el2
-rw-r--r--leim/quail/georgian.el2
-rw-r--r--leim/quail/greek.el2
-rw-r--r--leim/quail/hangul.el13
-rw-r--r--leim/quail/hanja.el2
-rw-r--r--leim/quail/hanja3.el2
-rw-r--r--leim/quail/hebrew.el12
-rw-r--r--leim/quail/indian.el11
-rw-r--r--leim/quail/ipa-praat.el2
-rw-r--r--leim/quail/ipa.el20
-rw-r--r--leim/quail/japanese.el2
-rw-r--r--leim/quail/latin-alt.el2
-rw-r--r--leim/quail/latin-ltx.el644
-rw-r--r--leim/quail/latin-post.el2
-rw-r--r--leim/quail/latin-pre.el2
-rw-r--r--leim/quail/lrt.el2
-rw-r--r--leim/quail/persian.el402
-rw-r--r--leim/quail/py-punct.el2
-rw-r--r--leim/quail/rfc1345.el2
-rw-r--r--leim/quail/sgml-input.el2
-rw-r--r--leim/quail/sisheng.el2
-rw-r--r--leim/quail/slovak.el2
-rw-r--r--leim/quail/symbol-ksc.el2
-rw-r--r--leim/quail/tibetan.el6
-rw-r--r--leim/quail/uni-input.el12
-rw-r--r--leim/quail/vntelex.el2
-rw-r--r--leim/quail/vnvni.el305
-rw-r--r--leim/quail/welsh.el2
-rw-r--r--lib-src/ChangeLog576
-rw-r--r--lib-src/Makefile.in110
-rw-r--r--lib-src/ebrowse.c24
-rw-r--r--lib-src/emacsclient.c575
-rw-r--r--lib-src/etags.c272
-rwxr-xr-xlib-src/grep-changelog2
-rw-r--r--lib-src/hexl.c6
-rw-r--r--lib-src/make-docfile.c351
-rw-r--r--lib-src/makefile.w32-in267
-rw-r--r--lib-src/movemail.c150
-rw-r--r--lib-src/ntlib.c50
-rw-r--r--lib-src/ntlib.h2
-rw-r--r--lib-src/pop.c77
-rw-r--r--lib-src/pop.h2
-rw-r--r--lib-src/profile.c43
-rwxr-xr-xlib-src/rcs-checkin116
-rwxr-xr-xlib-src/rcs2log4
-rw-r--r--lib-src/test-distrib.c2
-rw-r--r--lib-src/update-game-score.c37
-rwxr-xr-xlib-src/vcdiff114
-rw-r--r--lib/Makefile.am3
-rw-r--r--lib/alloca.in.h15
-rw-r--r--lib/allocator.h2
-rw-r--r--lib/at-func.c146
-rw-r--r--lib/c-ctype.c395
-rw-r--r--lib/c-ctype.h294
-rw-r--r--lib/c-strcase.h56
-rw-r--r--lib/c-strcasecmp.c56
-rw-r--r--lib/c-strncasecmp.c56
-rw-r--r--lib/careadlinkat.c2
-rw-r--r--lib/careadlinkat.h2
-rw-r--r--lib/close-stream.c78
-rw-r--r--lib/close-stream.h2
-rw-r--r--lib/dosname.h2
-rw-r--r--lib/dtotimespec.c69
-rw-r--r--lib/dup2.c4
-rw-r--r--lib/euidaccess.c221
-rw-r--r--lib/execinfo.c3
-rw-r--r--lib/execinfo.in.h54
-rw-r--r--lib/faccessat.c45
-rw-r--r--lib/fcntl.in.h347
-rw-r--r--lib/filemode.c6
-rw-r--r--lib/filemode.h4
-rw-r--r--lib/fpending.c30
-rw-r--r--lib/fpending.h30
-rw-r--r--lib/ftoastr.c3
-rw-r--r--lib/ftoastr.h4
-rw-r--r--lib/getgroups.c116
-rw-r--r--lib/getloadavg.c36
-rw-r--r--lib/getopt.c66
-rw-r--r--lib/getopt.in.h54
-rw-r--r--lib/getopt1.c6
-rw-r--r--lib/getopt_.h566
-rw-r--r--lib/getopt_int.h16
-rw-r--r--lib/gettext.h14
-rw-r--r--lib/gettime.c48
-rw-r--r--lib/gettimeofday.c154
-rw-r--r--lib/gnulib.mk355
-rw-r--r--lib/group-member.c119
-rw-r--r--lib/ignore-value.h17
-rw-r--r--lib/intprops.h2
-rw-r--r--lib/inttypes.in.h1770
-rw-r--r--lib/lstat.c8
-rw-r--r--lib/makefile.w32-in252
-rw-r--r--lib/md5.c17
-rw-r--r--lib/md5.h7
-rw-r--r--lib/mktime.c436
-rw-r--r--lib/pathmax.h83
-rw-r--r--lib/pselect.c110
-rw-r--r--lib/pthread_sigmask.c29
-rw-r--r--lib/readlink.c2
-rw-r--r--lib/root-uid.h30
-rw-r--r--lib/sha1.c17
-rw-r--r--lib/sha1.h5
-rw-r--r--lib/sha256.c14
-rw-r--r--lib/sha256.h2
-rw-r--r--lib/sha512.c16
-rw-r--r--lib/sha512.h2
-rw-r--r--lib/signal.in.h14
-rw-r--r--lib/sigprocmask.c348
-rw-r--r--lib/stat-time.c3
-rw-r--r--lib/stat-time.h196
-rw-r--r--lib/stat.c17
-rw-r--r--lib/stdalign.in.h90
-rw-r--r--lib/stdarg.in.h5
-rw-r--r--lib/stdbool.in.h56
-rw-r--r--lib/stddef.in.h5
-rw-r--r--lib/stdint.in.h86
-rw-r--r--lib/stdio.in.h41
-rw-r--r--lib/stdlib.in.h207
-rw-r--r--lib/strftime.c10
-rw-r--r--lib/strftime.h2
-rw-r--r--lib/strtoimax.c2
-rw-r--r--lib/strtol.c14
-rw-r--r--lib/strtoll.c4
-rw-r--r--lib/strtoul.c2
-rw-r--r--lib/strtoull.c4
-rw-r--r--lib/symlink.c2
-rw-r--r--lib/sys_select.in.h298
-rw-r--r--lib/sys_stat.in.h70
-rw-r--r--lib/sys_time.in.h205
-rw-r--r--lib/sys_types.in.h51
-rw-r--r--lib/time.in.h5
-rw-r--r--lib/time_r.c5
-rw-r--r--lib/timespec-add.c71
-rw-r--r--lib/timespec-sub.c71
-rw-r--r--lib/timespec.c3
-rw-r--r--lib/timespec.h92
-rw-r--r--lib/u64.c3
-rw-r--r--lib/u64.h38
-rw-r--r--lib/unistd.in.h80
-rw-r--r--lib/utimens.c534
-rw-r--r--lib/utimens.h46
-rw-r--r--lib/verify.h22
-rw-r--r--lib/xalloc-oversized.h38
-rw-r--r--lisp/ChangeLog12138
-rw-r--r--lisp/ChangeLog.1369
-rw-r--r--lisp/ChangeLog.104
-rw-r--r--lisp/ChangeLog.116
-rw-r--r--lisp/ChangeLog.124
-rw-r--r--lisp/ChangeLog.136
-rw-r--r--lisp/ChangeLog.1410
-rw-r--r--lisp/ChangeLog.1558
-rw-r--r--lisp/ChangeLog.224
-rw-r--r--lisp/ChangeLog.332
-rw-r--r--lisp/ChangeLog.468
-rw-r--r--lisp/ChangeLog.570
-rw-r--r--lisp/ChangeLog.6221
-rw-r--r--lisp/ChangeLog.717
-rw-r--r--lisp/ChangeLog.812
-rw-r--r--lisp/ChangeLog.917
-rw-r--r--lisp/Makefile.in90
-rw-r--r--lisp/abbrev.el63
-rw-r--r--lisp/align.el162
-rw-r--r--lisp/allout-widgets.el79
-rw-r--r--lisp/allout.el154
-rw-r--r--lisp/ansi-color.el246
-rw-r--r--lisp/apropos.el124
-rw-r--r--lisp/arc-mode.el106
-rw-r--r--lisp/array.el2
-rw-r--r--lisp/autoarg.el2
-rw-r--r--lisp/autoinsert.el21
-rw-r--r--lisp/autorevert.el21
-rw-r--r--lisp/avoid.el69
-rw-r--r--lisp/battery.el42
-rw-r--r--lisp/bindings.el591
-rw-r--r--lisp/bookmark.el215
-rw-r--r--lisp/bs.el19
-rw-r--r--lisp/buff-menu.el1119
-rw-r--r--lisp/button.el6
-rw-r--r--lisp/calc/README17
-rw-r--r--lisp/calc/README.prev2
-rw-r--r--lisp/calc/calc-aent.el5
-rw-r--r--lisp/calc/calc-alg.el19
-rw-r--r--lisp/calc/calc-arith.el2
-rw-r--r--lisp/calc/calc-bin.el2
-rw-r--r--lisp/calc/calc-comb.el17
-rw-r--r--lisp/calc/calc-cplx.el2
-rw-r--r--lisp/calc/calc-embed.el2
-rw-r--r--lisp/calc/calc-ext.el92
-rw-r--r--lisp/calc/calc-fin.el2
-rw-r--r--lisp/calc/calc-forms.el352
-rw-r--r--lisp/calc/calc-frac.el2
-rw-r--r--lisp/calc/calc-funcs.el2
-rw-r--r--lisp/calc/calc-graph.el2
-rw-r--r--lisp/calc/calc-help.el4
-rw-r--r--lisp/calc/calc-incom.el2
-rw-r--r--lisp/calc/calc-keypd.el2
-rw-r--r--lisp/calc/calc-lang.el37
-rw-r--r--lisp/calc/calc-macs.el2
-rw-r--r--lisp/calc/calc-map.el22
-rw-r--r--lisp/calc/calc-math.el2
-rw-r--r--lisp/calc/calc-menu.el98
-rw-r--r--lisp/calc/calc-misc.el5
-rw-r--r--lisp/calc/calc-mode.el35
-rw-r--r--lisp/calc/calc-mtx.el2
-rw-r--r--lisp/calc/calc-nlfit.el2
-rw-r--r--lisp/calc/calc-poly.el2
-rw-r--r--lisp/calc/calc-prog.el224
-rw-r--r--lisp/calc/calc-rewr.el22
-rw-r--r--lisp/calc/calc-rules.el2
-rw-r--r--lisp/calc/calc-sel.el2
-rw-r--r--lisp/calc/calc-stat.el2
-rw-r--r--lisp/calc/calc-store.el5
-rw-r--r--lisp/calc/calc-stuff.el2
-rw-r--r--lisp/calc/calc-trail.el2
-rw-r--r--lisp/calc/calc-undo.el2
-rw-r--r--lisp/calc/calc-units.el157
-rw-r--r--lisp/calc/calc-vec.el2
-rw-r--r--lisp/calc/calc-yank.el2
-rw-r--r--lisp/calc/calc.el130
-rw-r--r--lisp/calc/calcalg2.el29
-rw-r--r--lisp/calc/calcalg3.el2
-rw-r--r--lisp/calc/calccomp.el15
-rw-r--r--lisp/calc/calcsel2.el2
-rw-r--r--lisp/calculator.el24
-rw-r--r--lisp/calendar/appt.el2
-rw-r--r--lisp/calendar/cal-bahai.el2
-rw-r--r--lisp/calendar/cal-china.el2
-rw-r--r--lisp/calendar/cal-coptic.el2
-rw-r--r--lisp/calendar/cal-dst.el6
-rw-r--r--lisp/calendar/cal-french.el2
-rw-r--r--lisp/calendar/cal-hebrew.el4
-rw-r--r--lisp/calendar/cal-html.el45
-rw-r--r--lisp/calendar/cal-islam.el2
-rw-r--r--lisp/calendar/cal-iso.el2
-rw-r--r--lisp/calendar/cal-julian.el2
-rw-r--r--lisp/calendar/cal-mayan.el2
-rw-r--r--lisp/calendar/cal-menu.el19
-rw-r--r--lisp/calendar/cal-move.el2
-rw-r--r--lisp/calendar/cal-persia.el2
-rw-r--r--lisp/calendar/cal-tex.el619
-rw-r--r--lisp/calendar/cal-x.el14
-rw-r--r--lisp/calendar/calendar.el223
-rw-r--r--lisp/calendar/diary-lib.el71
-rw-r--r--lisp/calendar/holidays.el78
-rw-r--r--lisp/calendar/icalendar.el68
-rw-r--r--lisp/calendar/lunar.el4
-rw-r--r--lisp/calendar/parse-time.el55
-rw-r--r--lisp/calendar/solar.el4
-rw-r--r--lisp/calendar/time-date.el116
-rw-r--r--lisp/calendar/timeclock.el107
-rw-r--r--lisp/calendar/todo-mode.el2
-rw-r--r--lisp/case-table.el2
-rw-r--r--lisp/cdl.el2
-rw-r--r--lisp/cedet/ChangeLog730
-rw-r--r--lisp/cedet/cedet-cscope.el4
-rw-r--r--lisp/cedet/cedet-files.el2
-rw-r--r--lisp/cedet/cedet-global.el4
-rw-r--r--lisp/cedet/cedet-idutils.el7
-rw-r--r--lisp/cedet/cedet.el25
-rw-r--r--lisp/cedet/data-debug.el57
-rw-r--r--lisp/cedet/ede.el420
-rw-r--r--lisp/cedet/ede/auto.el231
-rw-r--r--lisp/cedet/ede/autoconf-edit.el56
-rw-r--r--lisp/cedet/ede/base.el29
-rw-r--r--lisp/cedet/ede/cpp-root.el42
-rw-r--r--lisp/cedet/ede/custom.el2
-rw-r--r--lisp/cedet/ede/dired.el4
-rw-r--r--lisp/cedet/ede/emacs.el61
-rw-r--r--lisp/cedet/ede/files.el28
-rw-r--r--lisp/cedet/ede/generic.el82
-rw-r--r--lisp/cedet/ede/linux.el97
-rw-r--r--lisp/cedet/ede/locate.el32
-rw-r--r--lisp/cedet/ede/make.el2
-rw-r--r--lisp/cedet/ede/makefile-edit.el5
-rw-r--r--lisp/cedet/ede/pconf.el2
-rw-r--r--lisp/cedet/ede/pmake.el15
-rw-r--r--lisp/cedet/ede/proj-archive.el2
-rw-r--r--lisp/cedet/ede/proj-aux.el2
-rw-r--r--lisp/cedet/ede/proj-comp.el23
-rw-r--r--lisp/cedet/ede/proj-elisp.el94
-rw-r--r--lisp/cedet/ede/proj-info.el2
-rw-r--r--lisp/cedet/ede/proj-misc.el2
-rw-r--r--lisp/cedet/ede/proj-obj.el2
-rw-r--r--lisp/cedet/ede/proj-prog.el2
-rw-r--r--lisp/cedet/ede/proj-scheme.el2
-rw-r--r--lisp/cedet/ede/proj-shared.el2
-rw-r--r--lisp/cedet/ede/proj.el91
-rw-r--r--lisp/cedet/ede/project-am.el10
-rw-r--r--lisp/cedet/ede/shell.el2
-rw-r--r--lisp/cedet/ede/simple.el5
-rw-r--r--lisp/cedet/ede/source.el2
-rw-r--r--lisp/cedet/ede/speedbar.el2
-rw-r--r--lisp/cedet/ede/srecode.el2
-rw-r--r--lisp/cedet/ede/system.el2
-rw-r--r--lisp/cedet/ede/util.el4
-rw-r--r--lisp/cedet/inversion.el64
-rw-r--r--lisp/cedet/mode-local.el6
-rw-r--r--lisp/cedet/pulse.el6
-rw-r--r--lisp/cedet/semantic.el117
-rw-r--r--lisp/cedet/semantic/analyze.el36
-rw-r--r--lisp/cedet/semantic/analyze/complete.el35
-rw-r--r--lisp/cedet/semantic/analyze/debug.el4
-rw-r--r--lisp/cedet/semantic/analyze/fcn.el24
-rw-r--r--lisp/cedet/semantic/analyze/refs.el21
-rw-r--r--lisp/cedet/semantic/bovine.el2
-rw-r--r--lisp/cedet/semantic/bovine/c-by.el33
-rw-r--r--lisp/cedet/semantic/bovine/c.el523
-rw-r--r--lisp/cedet/semantic/bovine/debug.el2
-rw-r--r--lisp/cedet/semantic/bovine/el.el4
-rw-r--r--lisp/cedet/semantic/bovine/gcc.el54
-rw-r--r--lisp/cedet/semantic/bovine/grammar.el (renamed from admin/grammars/bovine-grammar.el)55
-rw-r--r--lisp/cedet/semantic/bovine/make-by.el12
-rw-r--r--lisp/cedet/semantic/bovine/make.el3
-rw-r--r--lisp/cedet/semantic/bovine/scm-by.el14
-rw-r--r--lisp/cedet/semantic/bovine/scm.el7
-rw-r--r--lisp/cedet/semantic/chart.el7
-rw-r--r--lisp/cedet/semantic/complete.el343
-rw-r--r--lisp/cedet/semantic/ctxt.el2
-rw-r--r--lisp/cedet/semantic/db-debug.el2
-rw-r--r--lisp/cedet/semantic/db-ebrowse.el2
-rw-r--r--lisp/cedet/semantic/db-el.el66
-rw-r--r--lisp/cedet/semantic/db-file.el14
-rw-r--r--lisp/cedet/semantic/db-find.el23
-rw-r--r--lisp/cedet/semantic/db-global.el43
-rw-r--r--lisp/cedet/semantic/db-javascript.el2
-rw-r--r--lisp/cedet/semantic/db-mode.el2
-rw-r--r--lisp/cedet/semantic/db-ref.el2
-rw-r--r--lisp/cedet/semantic/db-typecache.el13
-rw-r--r--lisp/cedet/semantic/db.el61
-rw-r--r--lisp/cedet/semantic/debug.el6
-rw-r--r--lisp/cedet/semantic/decorate.el2
-rw-r--r--lisp/cedet/semantic/decorate/include.el130
-rw-r--r--lisp/cedet/semantic/decorate/mode.el4
-rw-r--r--lisp/cedet/semantic/dep.el2
-rw-r--r--lisp/cedet/semantic/doc.el7
-rw-r--r--lisp/cedet/semantic/ede-grammar.el121
-rw-r--r--lisp/cedet/semantic/edit.el26
-rw-r--r--lisp/cedet/semantic/find.el16
-rw-r--r--lisp/cedet/semantic/format.el2
-rw-r--r--lisp/cedet/semantic/fw.el204
-rw-r--r--lisp/cedet/semantic/grammar-wy.el69
-rw-r--r--lisp/cedet/semantic/grammar.el73
-rw-r--r--lisp/cedet/semantic/html.el2
-rw-r--r--lisp/cedet/semantic/ia-sb.el2
-rw-r--r--lisp/cedet/semantic/ia.el46
-rw-r--r--lisp/cedet/semantic/idle.el80
-rw-r--r--lisp/cedet/semantic/imenu.el2
-rw-r--r--lisp/cedet/semantic/java.el28
-rw-r--r--lisp/cedet/semantic/lex-spp.el54
-rw-r--r--lisp/cedet/semantic/lex.el48
-rw-r--r--lisp/cedet/semantic/mru-bookmark.el11
-rw-r--r--lisp/cedet/semantic/sb.el2
-rw-r--r--lisp/cedet/semantic/scope.el15
-rw-r--r--lisp/cedet/semantic/senator.el5
-rw-r--r--lisp/cedet/semantic/sort.el2
-rw-r--r--lisp/cedet/semantic/symref.el14
-rw-r--r--lisp/cedet/semantic/symref/cscope.el2
-rw-r--r--lisp/cedet/semantic/symref/filter.el23
-rw-r--r--lisp/cedet/semantic/symref/global.el2
-rw-r--r--lisp/cedet/semantic/symref/grep.el2
-rw-r--r--lisp/cedet/semantic/symref/idutils.el2
-rw-r--r--lisp/cedet/semantic/symref/list.el5
-rw-r--r--lisp/cedet/semantic/tag-file.el2
-rw-r--r--lisp/cedet/semantic/tag-ls.el270
-rw-r--r--lisp/cedet/semantic/tag-write.el8
-rw-r--r--lisp/cedet/semantic/tag.el112
-rw-r--r--lisp/cedet/semantic/texi.el18
-rw-r--r--lisp/cedet/semantic/util-modes.el14
-rw-r--r--lisp/cedet/semantic/util.el5
-rw-r--r--lisp/cedet/semantic/wisent.el2
-rw-r--r--lisp/cedet/semantic/wisent/comp.el21
-rw-r--r--lisp/cedet/semantic/wisent/grammar.el (renamed from admin/grammars/wisent-grammar.el)77
-rw-r--r--lisp/cedet/semantic/wisent/java-tags.el30
-rw-r--r--lisp/cedet/semantic/wisent/javascript.el58
-rw-r--r--lisp/cedet/semantic/wisent/javat-wy.elbin19144 -> 19301 bytes
-rw-r--r--lisp/cedet/semantic/wisent/js-wy.el51
-rw-r--r--lisp/cedet/semantic/wisent/python-wy.el86
-rw-r--r--lisp/cedet/semantic/wisent/python.el334
-rw-r--r--lisp/cedet/semantic/wisent/wisent.el2
-rw-r--r--lisp/cedet/srecode.el4
-rw-r--r--lisp/cedet/srecode/args.el2
-rw-r--r--lisp/cedet/srecode/compile.el17
-rw-r--r--lisp/cedet/srecode/cpp.el57
-rw-r--r--lisp/cedet/srecode/ctxt.el4
-rw-r--r--lisp/cedet/srecode/dictionary.el46
-rw-r--r--lisp/cedet/srecode/document.el4
-rw-r--r--lisp/cedet/srecode/el.el2
-rw-r--r--lisp/cedet/srecode/expandproto.el2
-rw-r--r--lisp/cedet/srecode/extract.el2
-rw-r--r--lisp/cedet/srecode/fields.el2
-rw-r--r--lisp/cedet/srecode/filters.el7
-rw-r--r--lisp/cedet/srecode/find.el47
-rw-r--r--lisp/cedet/srecode/getset.el10
-rw-r--r--lisp/cedet/srecode/insert.el186
-rw-r--r--lisp/cedet/srecode/java.el19
-rw-r--r--lisp/cedet/srecode/map.el7
-rw-r--r--lisp/cedet/srecode/mode.el22
-rw-r--r--lisp/cedet/srecode/semantic.el8
-rw-r--r--lisp/cedet/srecode/srt-mode.el14
-rw-r--r--lisp/cedet/srecode/srt-wy.el66
-rw-r--r--lisp/cedet/srecode/srt.el2
-rw-r--r--lisp/cedet/srecode/table.el61
-rw-r--r--lisp/cedet/srecode/template.el2
-rw-r--r--lisp/cedet/srecode/texi.el2
-rw-r--r--lisp/chistory.el2
-rw-r--r--lisp/cmuscheme.el2
-rw-r--r--lisp/color.el299
-rw-r--r--lisp/comint.el522
-rw-r--r--lisp/completion.el25
-rw-r--r--lisp/composite.el2
-rw-r--r--lisp/cus-dep.el7
-rw-r--r--lisp/cus-edit.el559
-rw-r--r--lisp/cus-face.el35
-rw-r--r--lisp/cus-start.el99
-rw-r--r--lisp/cus-theme.el35
-rw-r--r--lisp/custom.el353
-rw-r--r--lisp/dabbrev.el166
-rw-r--r--lisp/delim-col.el2
-rw-r--r--lisp/delsel.el142
-rw-r--r--lisp/descr-text.el77
-rw-r--r--lisp/desktop.el47
-rw-r--r--lisp/dframe.el17
-rw-r--r--lisp/dired-aux.el284
-rw-r--r--lisp/dired-x.el63
-rw-r--r--lisp/dired.el551
-rw-r--r--lisp/dirtrack.el149
-rw-r--r--lisp/disp-table.el2
-rw-r--r--lisp/dnd.el2
-rw-r--r--lisp/doc-view.el268
-rw-r--r--lisp/dos-fns.el8
-rw-r--r--lisp/dos-vars.el2
-rw-r--r--lisp/dos-w32.el23
-rw-r--r--lisp/double.el2
-rw-r--r--lisp/dynamic-setting.el58
-rw-r--r--lisp/ebuff-menu.el146
-rw-r--r--lisp/echistory.el2
-rw-r--r--lisp/edmacro.el205
-rw-r--r--lisp/ehelp.el19
-rw-r--r--lisp/electric.el78
-rw-r--r--lisp/elide-head.el2
-rw-r--r--lisp/emacs-lisp/advice.el1429
-rw-r--r--lisp/emacs-lisp/authors.el78
-rw-r--r--lisp/emacs-lisp/autoload.el168
-rw-r--r--lisp/emacs-lisp/avl-tree.el22
-rw-r--r--lisp/emacs-lisp/backquote.el2
-rw-r--r--lisp/emacs-lisp/benchmark.el8
-rw-r--r--lisp/emacs-lisp/bindat.el2
-rw-r--r--lisp/emacs-lisp/byte-opt.el162
-rw-r--r--lisp/emacs-lisp/byte-run.el249
-rw-r--r--lisp/emacs-lisp/bytecomp.el1169
-rw-r--r--lisp/emacs-lisp/cconv.el77
-rw-r--r--lisp/emacs-lisp/chart.el40
-rw-r--r--lisp/emacs-lisp/check-declare.el4
-rw-r--r--lisp/emacs-lisp/checkdoc.el57
-rw-r--r--lisp/emacs-lisp/cl-extra.el396
-rw-r--r--lisp/emacs-lisp/cl-indent.el5
-rw-r--r--lisp/emacs-lisp/cl-lib.el756
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el745
-rw-r--r--lisp/emacs-lisp/cl-macs.el3318
-rw-r--r--lisp/emacs-lisp/cl-seq.el516
-rw-r--r--lisp/emacs-lisp/cl-specs.el471
-rw-r--r--lisp/emacs-lisp/cl.el1395
-rw-r--r--lisp/emacs-lisp/copyright.el20
-rw-r--r--lisp/emacs-lisp/crm.el4
-rw-r--r--lisp/emacs-lisp/debug.el387
-rw-r--r--lisp/emacs-lisp/derived.el16
-rw-r--r--lisp/emacs-lisp/disass.el14
-rw-r--r--lisp/emacs-lisp/easy-mmode.el130
-rw-r--r--lisp/emacs-lisp/easymenu.el185
-rw-r--r--lisp/emacs-lisp/edebug.el837
-rw-r--r--lisp/emacs-lisp/eieio-base.el179
-rw-r--r--lisp/emacs-lisp/eieio-custom.el20
-rw-r--r--lisp/emacs-lisp/eieio-datadebug.el11
-rw-r--r--lisp/emacs-lisp/eieio-opt.el151
-rw-r--r--lisp/emacs-lisp/eieio-speedbar.el20
-rw-r--r--lisp/emacs-lisp/eieio.el314
-rw-r--r--lisp/emacs-lisp/eldoc.el2
-rw-r--r--lisp/emacs-lisp/elint.el19
-rw-r--r--lisp/emacs-lisp/elp.el334
-rw-r--r--lisp/emacs-lisp/ert-x.el78
-rw-r--r--lisp/emacs-lisp/ert.el832
-rw-r--r--lisp/emacs-lisp/ewoc.el19
-rw-r--r--lisp/emacs-lisp/find-func.el5
-rw-r--r--lisp/emacs-lisp/find-gc.el2
-rw-r--r--lisp/emacs-lisp/float-sup.el12
-rw-r--r--lisp/emacs-lisp/generic.el8
-rw-r--r--lisp/emacs-lisp/gulp.el2
-rw-r--r--lisp/emacs-lisp/gv.el482
-rw-r--r--lisp/emacs-lisp/helper.el2
-rw-r--r--lisp/emacs-lisp/lisp-mnt.el2
-rw-r--r--lisp/emacs-lisp/lisp-mode.el395
-rw-r--r--lisp/emacs-lisp/lisp.el23
-rw-r--r--lisp/emacs-lisp/macroexp.el388
-rw-r--r--lisp/emacs-lisp/map-ynp.el13
-rw-r--r--lisp/emacs-lisp/nadvice.el457
-rw-r--r--lisp/emacs-lisp/package-x.el12
-rw-r--r--lisp/emacs-lisp/package.el211
-rw-r--r--lisp/emacs-lisp/pcase.el365
-rw-r--r--lisp/emacs-lisp/pp.el36
-rw-r--r--lisp/emacs-lisp/re-builder.el4
-rw-r--r--lisp/emacs-lisp/regexp-opt.el34
-rw-r--r--lisp/emacs-lisp/regi.el2
-rw-r--r--lisp/emacs-lisp/ring.el35
-rw-r--r--lisp/emacs-lisp/rx.el54
-rw-r--r--lisp/emacs-lisp/shadow.el10
-rw-r--r--lisp/emacs-lisp/smie.el173
-rw-r--r--lisp/emacs-lisp/syntax.el75
-rw-r--r--lisp/emacs-lisp/tabulated-list.el357
-rw-r--r--lisp/emacs-lisp/tcover-ses.el2
-rw-r--r--lisp/emacs-lisp/tcover-unsafep.el2
-rw-r--r--lisp/emacs-lisp/testcover.el26
-rw-r--r--lisp/emacs-lisp/timer.el127
-rw-r--r--lisp/emacs-lisp/tq.el2
-rw-r--r--lisp/emacs-lisp/trace.el208
-rw-r--r--lisp/emacs-lisp/unsafep.el2
-rw-r--r--lisp/emacs-lisp/warnings.el2
-rw-r--r--lisp/emacs-lock.el48
-rw-r--r--lisp/emulation/crisp.el21
-rw-r--r--lisp/emulation/cua-base.el50
-rw-r--r--lisp/emulation/cua-gmrk.el2
-rw-r--r--lisp/emulation/cua-rect.el84
-rw-r--r--lisp/emulation/edt-lk201.el2
-rw-r--r--lisp/emulation/edt-mapper.el6
-rw-r--r--lisp/emulation/edt-pc.el2
-rw-r--r--lisp/emulation/edt-vt100.el2
-rw-r--r--lisp/emulation/edt.el36
-rw-r--r--lisp/emulation/keypad.el4
-rw-r--r--lisp/emulation/tpu-edt.el22
-rw-r--r--lisp/emulation/tpu-extras.el9
-rw-r--r--lisp/emulation/tpu-mapper.el4
-rw-r--r--lisp/emulation/vi.el2
-rw-r--r--lisp/emulation/vip.el10
-rw-r--r--lisp/emulation/viper-cmd.el21
-rw-r--r--lisp/emulation/viper-ex.el6
-rw-r--r--lisp/emulation/viper-init.el79
-rw-r--r--lisp/emulation/viper-keym.el10
-rw-r--r--lisp/emulation/viper-macs.el2
-rw-r--r--lisp/emulation/viper-mous.el10
-rw-r--r--lisp/emulation/viper-util.el8
-rw-r--r--lisp/emulation/viper.el28
-rw-r--r--lisp/emulation/ws-mode.el4
-rw-r--r--lisp/env.el27
-rw-r--r--lisp/epa-dired.el2
-rw-r--r--lisp/epa-file.el2
-rw-r--r--lisp/epa-hook.el2
-rw-r--r--lisp/epa-mail.el54
-rw-r--r--lisp/epa.el95
-rw-r--r--lisp/epg-config.el8
-rw-r--r--lisp/epg.el17
-rw-r--r--lisp/erc/ChangeLog202
-rw-r--r--lisp/erc/ChangeLog.012
-rw-r--r--lisp/erc/ChangeLog.024
-rw-r--r--lisp/erc/ChangeLog.034
-rw-r--r--lisp/erc/ChangeLog.045
-rw-r--r--lisp/erc/ChangeLog.052
-rw-r--r--lisp/erc/ChangeLog.066
-rw-r--r--lisp/erc/ChangeLog.072
-rw-r--r--lisp/erc/ChangeLog.082
-rw-r--r--lisp/erc/erc-autoaway.el15
-rw-r--r--lisp/erc/erc-backend.el267
-rw-r--r--lisp/erc/erc-button.el22
-rw-r--r--lisp/erc/erc-capab.el9
-rw-r--r--lisp/erc/erc-compat.el5
-rw-r--r--lisp/erc/erc-dcc.el107
-rw-r--r--lisp/erc/erc-desktop-notifications.el91
-rw-r--r--lisp/erc/erc-ezbounce.el4
-rw-r--r--lisp/erc/erc-fill.el3
-rw-r--r--lisp/erc/erc-goodies.el111
-rw-r--r--lisp/erc/erc-ibuffer.el3
-rw-r--r--lisp/erc/erc-identd.el3
-rw-r--r--lisp/erc/erc-imenu.el3
-rw-r--r--lisp/erc/erc-join.el37
-rw-r--r--lisp/erc/erc-lang.el4
-rw-r--r--lisp/erc/erc-list.el3
-rw-r--r--lisp/erc/erc-log.el36
-rw-r--r--lisp/erc/erc-match.el38
-rw-r--r--lisp/erc/erc-menu.el3
-rw-r--r--lisp/erc/erc-netsplit.el12
-rw-r--r--lisp/erc/erc-networks.el17
-rw-r--r--lisp/erc/erc-notify.el15
-rw-r--r--lisp/erc/erc-page.el6
-rw-r--r--lisp/erc/erc-pcomplete.el6
-rw-r--r--lisp/erc/erc-replace.el6
-rw-r--r--lisp/erc/erc-ring.el3
-rw-r--r--lisp/erc/erc-services.el9
-rw-r--r--lisp/erc/erc-sound.el6
-rw-r--r--lisp/erc/erc-speedbar.el4
-rw-r--r--lisp/erc/erc-spelling.el3
-rw-r--r--lisp/erc/erc-stamp.el38
-rw-r--r--lisp/erc/erc-track.el55
-rw-r--r--lisp/erc/erc-truncate.el5
-rw-r--r--lisp/erc/erc-xdcc.el11
-rw-r--r--lisp/erc/erc.el384
-rw-r--r--lisp/eshell/em-alias.el15
-rw-r--r--lisp/eshell/em-banner.el15
-rw-r--r--lisp/eshell/em-basic.el7
-rw-r--r--lisp/eshell/em-cmpl.el31
-rw-r--r--lisp/eshell/em-dirs.el7
-rw-r--r--lisp/eshell/em-glob.el7
-rw-r--r--lisp/eshell/em-hist.el16
-rw-r--r--lisp/eshell/em-ls.el16
-rw-r--r--lisp/eshell/em-pred.el7
-rw-r--r--lisp/eshell/em-prompt.el13
-rw-r--r--lisp/eshell/em-rebind.el7
-rw-r--r--lisp/eshell/em-script.el8
-rw-r--r--lisp/eshell/em-smart.el7
-rw-r--r--lisp/eshell/em-term.el12
-rw-r--r--lisp/eshell/em-unix.el74
-rw-r--r--lisp/eshell/em-xtra.el9
-rw-r--r--lisp/eshell/esh-arg.el14
-rw-r--r--lisp/eshell/esh-cmd.el63
-rw-r--r--lisp/eshell/esh-ext.el48
-rw-r--r--lisp/eshell/esh-io.el6
-rw-r--r--lisp/eshell/esh-mode.el23
-rw-r--r--lisp/eshell/esh-module.el6
-rw-r--r--lisp/eshell/esh-opt.el17
-rw-r--r--lisp/eshell/esh-proc.el2
-rw-r--r--lisp/eshell/esh-util.el10
-rw-r--r--lisp/eshell/esh-var.el4
-rw-r--r--lisp/eshell/eshell.el50
-rw-r--r--lisp/expand.el2
-rw-r--r--lisp/ezimage.el2
-rw-r--r--lisp/face-remap.el145
-rw-r--r--lisp/facemenu.el35
-rw-r--r--lisp/faces.el418
-rw-r--r--lisp/ffap.el280
-rw-r--r--lisp/filecache.el178
-rw-r--r--lisp/files-x.el4
-rw-r--r--lisp/files.el1003
-rw-r--r--lisp/filesets.el92
-rw-r--r--lisp/find-cmd.el17
-rw-r--r--lisp/find-dired.el20
-rw-r--r--lisp/find-file.el18
-rw-r--r--lisp/find-lisp.el2
-rw-r--r--lisp/finder.el2
-rw-r--r--lisp/flow-ctrl.el4
-rw-r--r--lisp/foldout.el42
-rw-r--r--lisp/follow.el1612
-rw-r--r--lisp/font-core.el11
-rw-r--r--lisp/font-lock.el223
-rw-r--r--lisp/format-spec.el2
-rw-r--r--lisp/format.el2
-rw-r--r--lisp/forms.el14
-rw-r--r--lisp/frame.el205
-rw-r--r--lisp/fringe.el136
-rw-r--r--lisp/generic-x.el92
-rw-r--r--lisp/gnus/ChangeLog1545
-rw-r--r--lisp/gnus/ChangeLog.14
-rw-r--r--lisp/gnus/ChangeLog.28
-rw-r--r--lisp/gnus/auth-source.el457
-rw-r--r--lisp/gnus/canlock.el2
-rw-r--r--lisp/gnus/compface.el2
-rw-r--r--lisp/gnus/deuglify.el2
-rw-r--r--lisp/gnus/ecomplete.el2
-rw-r--r--lisp/gnus/flow-fill.el2
-rw-r--r--lisp/gnus/gmm-utils.el6
-rw-r--r--lisp/gnus/gnus-agent.el106
-rw-r--r--lisp/gnus/gnus-art.el116
-rw-r--r--lisp/gnus/gnus-async.el3
-rw-r--r--lisp/gnus/gnus-bcklg.el2
-rw-r--r--lisp/gnus/gnus-bookmark.el2
-rw-r--r--lisp/gnus/gnus-cache.el2
-rw-r--r--lisp/gnus/gnus-cite.el15
-rw-r--r--lisp/gnus/gnus-cus.el28
-rw-r--r--lisp/gnus/gnus-delay.el2
-rw-r--r--lisp/gnus/gnus-demon.el109
-rw-r--r--lisp/gnus/gnus-diary.el14
-rw-r--r--lisp/gnus/gnus-dired.el6
-rw-r--r--lisp/gnus/gnus-draft.el2
-rw-r--r--lisp/gnus/gnus-dup.el2
-rw-r--r--lisp/gnus/gnus-eform.el2
-rw-r--r--lisp/gnus/gnus-ems.el2
-rw-r--r--lisp/gnus/gnus-fun.el13
-rw-r--r--lisp/gnus/gnus-gravatar.el2
-rw-r--r--lisp/gnus/gnus-group.el75
-rw-r--r--lisp/gnus/gnus-html.el4
-rw-r--r--lisp/gnus/gnus-int.el102
-rw-r--r--lisp/gnus/gnus-kill.el20
-rw-r--r--lisp/gnus/gnus-logic.el78
-rw-r--r--lisp/gnus/gnus-mh.el2
-rw-r--r--lisp/gnus/gnus-ml.el2
-rw-r--r--lisp/gnus/gnus-mlspl.el2
-rw-r--r--lisp/gnus/gnus-msg.el263
-rw-r--r--lisp/gnus/gnus-notifications.el190
-rw-r--r--lisp/gnus/gnus-picon.el15
-rw-r--r--lisp/gnus/gnus-range.el23
-rw-r--r--lisp/gnus/gnus-registry.el268
-rw-r--r--lisp/gnus/gnus-salt.el8
-rw-r--r--lisp/gnus/gnus-score.el311
-rw-r--r--lisp/gnus/gnus-setup.el2
-rw-r--r--lisp/gnus/gnus-sieve.el2
-rw-r--r--lisp/gnus/gnus-spec.el102
-rw-r--r--lisp/gnus/gnus-srvr.el7
-rw-r--r--lisp/gnus/gnus-start.el57
-rw-r--r--lisp/gnus/gnus-sum.el204
-rw-r--r--lisp/gnus/gnus-sync.el819
-rw-r--r--lisp/gnus/gnus-topic.el22
-rw-r--r--lisp/gnus/gnus-undo.el2
-rw-r--r--lisp/gnus/gnus-util.el84
-rw-r--r--lisp/gnus/gnus-uu.el12
-rw-r--r--lisp/gnus/gnus-vm.el2
-rw-r--r--lisp/gnus/gnus-win.el32
-rw-r--r--lisp/gnus/gnus.el143
-rw-r--r--lisp/gnus/gravatar.el3
-rw-r--r--lisp/gnus/gssapi.el3
-rw-r--r--lisp/gnus/html2text.el2
-rw-r--r--lisp/gnus/ietf-drums.el2
-rw-r--r--lisp/gnus/legacy-gnus-agent.el20
-rw-r--r--lisp/gnus/mail-parse.el2
-rw-r--r--lisp/gnus/mail-prsvr.el2
-rw-r--r--lisp/gnus/mail-source.el29
-rw-r--r--lisp/gnus/mailcap.el2
-rw-r--r--lisp/gnus/message.el213
-rw-r--r--lisp/gnus/messcompat.el2
-rw-r--r--lisp/gnus/mm-archive.el107
-rw-r--r--lisp/gnus/mm-bodies.el2
-rw-r--r--lisp/gnus/mm-decode.el185
-rw-r--r--lisp/gnus/mm-encode.el2
-rw-r--r--lisp/gnus/mm-extern.el2
-rw-r--r--lisp/gnus/mm-partial.el2
-rw-r--r--lisp/gnus/mm-url.el65
-rw-r--r--lisp/gnus/mm-util.el6
-rw-r--r--lisp/gnus/mm-uu.el10
-rw-r--r--lisp/gnus/mm-view.el10
-rw-r--r--lisp/gnus/mml-sec.el2
-rw-r--r--lisp/gnus/mml-smime.el2
-rw-r--r--lisp/gnus/mml.el81
-rw-r--r--lisp/gnus/mml1991.el4
-rw-r--r--lisp/gnus/mml2015.el2
-rw-r--r--lisp/gnus/nnagent.el2
-rw-r--r--lisp/gnus/nnbabyl.el2
-rw-r--r--lisp/gnus/nndiary.el36
-rw-r--r--lisp/gnus/nndir.el2
-rw-r--r--lisp/gnus/nndoc.el2
-rw-r--r--lisp/gnus/nndraft.el20
-rw-r--r--lisp/gnus/nneething.el2
-rw-r--r--lisp/gnus/nnfolder.el153
-rw-r--r--lisp/gnus/nngateway.el2
-rw-r--r--lisp/gnus/nnheader.el2
-rw-r--r--lisp/gnus/nnimap.el133
-rw-r--r--lisp/gnus/nnir.el15
-rw-r--r--lisp/gnus/nnmail.el8
-rw-r--r--lisp/gnus/nnmaildir.el288
-rw-r--r--lisp/gnus/nnmairix.el4
-rw-r--r--lisp/gnus/nnmbox.el2
-rw-r--r--lisp/gnus/nnmh.el2
-rw-r--r--lisp/gnus/nnml.el136
-rw-r--r--lisp/gnus/nnoo.el2
-rw-r--r--lisp/gnus/nnregistry.el2
-rw-r--r--lisp/gnus/nnrss.el2
-rw-r--r--lisp/gnus/nnspool.el22
-rw-r--r--lisp/gnus/nntp.el293
-rw-r--r--lisp/gnus/nnvirtual.el2
-rw-r--r--lisp/gnus/nnweb.el4
-rw-r--r--lisp/gnus/plstore.el149
-rw-r--r--lisp/gnus/pop3.el330
-rw-r--r--lisp/gnus/qp.el26
-rw-r--r--lisp/gnus/registry.el130
-rw-r--r--lisp/gnus/rfc1843.el2
-rw-r--r--lisp/gnus/rfc2045.el2
-rw-r--r--lisp/gnus/rfc2047.el13
-rw-r--r--lisp/gnus/rfc2104.el2
-rw-r--r--lisp/gnus/rfc2231.el2
-rw-r--r--lisp/gnus/rtree.el2
-rw-r--r--lisp/gnus/score-mode.el2
-rw-r--r--lisp/gnus/shr-color.el11
-rw-r--r--lisp/gnus/shr.el345
-rw-r--r--lisp/gnus/sieve-manage.el3
-rw-r--r--lisp/gnus/sieve-mode.el4
-rw-r--r--lisp/gnus/sieve.el33
-rw-r--r--lisp/gnus/smiley.el2
-rw-r--r--lisp/gnus/smime.el4
-rw-r--r--lisp/gnus/spam-report.el2
-rw-r--r--lisp/gnus/spam-stat.el2
-rw-r--r--lisp/gnus/spam-wash.el2
-rw-r--r--lisp/gnus/spam.el29
-rw-r--r--lisp/gnus/starttls.el11
-rw-r--r--lisp/gnus/utf7.el2
-rw-r--r--lisp/gnus/yenc.el2
-rw-r--r--lisp/gs.el2
-rw-r--r--lisp/help-at-pt.el2
-rw-r--r--lisp/help-fns.el497
-rw-r--r--lisp/help-macro.el15
-rw-r--r--lisp/help-mode.el67
-rw-r--r--lisp/help.el95
-rw-r--r--lisp/hex-util.el2
-rw-r--r--lisp/hexl.el119
-rw-r--r--lisp/hfy-cmap.el2
-rw-r--r--lisp/hi-lock.el97
-rw-r--r--lisp/hilit-chg.el2
-rw-r--r--lisp/hippie-exp.el14
-rw-r--r--lisp/hl-line.el2
-rw-r--r--lisp/htmlfontify.el178
-rw-r--r--lisp/ibuf-ext.el193
-rw-r--r--lisp/ibuf-macs.el33
-rw-r--r--lisp/ibuffer.el179
-rw-r--r--lisp/icomplete.el31
-rw-r--r--lisp/ido.el118
-rw-r--r--lisp/ielm.el4
-rw-r--r--lisp/iimage.el5
-rw-r--r--lisp/image-dired.el23
-rw-r--r--lisp/image-file.el2
-rw-r--r--lisp/image-mode.el230
-rw-r--r--lisp/image.el213
-rw-r--r--lisp/imenu.el332
-rw-r--r--lisp/indent.el2
-rw-r--r--lisp/info-look.el4
-rw-r--r--lisp/info-xref.el15
-rw-r--r--lisp/info.el427
-rw-r--r--lisp/informat.el2
-rw-r--r--lisp/international/ccl.el2
-rw-r--r--lisp/international/characters.el151
-rw-r--r--lisp/international/charprop.el6
-rw-r--r--lisp/international/eucjp-ms.el1
-rw-r--r--lisp/international/fontset.el3
-rw-r--r--lisp/international/isearch-x.el2
-rw-r--r--lisp/international/iso-ascii.el19
-rw-r--r--lisp/international/iso-cvt.el2
-rw-r--r--lisp/international/iso-transl.el8
-rw-r--r--lisp/international/kinsoku.el2
-rw-r--r--lisp/international/kkc.el2
-rw-r--r--lisp/international/latexenc.el2
-rw-r--r--lisp/international/latin1-disp.el6
-rw-r--r--lisp/international/mule-cmds.el294
-rw-r--r--lisp/international/mule-conf.el5
-rw-r--r--lisp/international/mule-diag.el4
-rw-r--r--lisp/international/mule-util.el38
-rw-r--r--lisp/international/mule.el55
-rw-r--r--lisp/international/ogonek.el9
-rw-r--r--lisp/international/quail.el106
-rw-r--r--lisp/international/robin.el22
-rw-r--r--lisp/international/titdic-cnv.el6
-rw-r--r--lisp/international/ucs-normalize.el10
-rw-r--r--lisp/international/uni-bidi.el6
-rw-r--r--lisp/international/uni-category.el18
-rw-r--r--lisp/international/uni-combining.el4
-rw-r--r--lisp/international/uni-comment.elbin2407 -> 2386 bytes
-rw-r--r--lisp/international/uni-decimal.elbin2710 -> 2770 bytes
-rw-r--r--lisp/international/uni-decomposition.elbin28497 -> 29332 bytes
-rw-r--r--lisp/international/uni-digit.elbin3028 -> 3088 bytes
-rw-r--r--lisp/international/uni-lowercase.elbin6421 -> 6445 bytes
-rw-r--r--lisp/international/uni-mirrored.elbin9342 -> 9423 bytes
-rw-r--r--lisp/international/uni-name.elbin158786 -> 162318 bytes
-rw-r--r--lisp/international/uni-numeric.elbin4522 -> 4609 bytes
-rw-r--r--lisp/international/uni-old-name.elbin19713 -> 19760 bytes
-rw-r--r--lisp/international/uni-titlecase.elbin6462 -> 6485 bytes
-rw-r--r--lisp/international/uni-uppercase.elbin6458 -> 6481 bytes
-rw-r--r--lisp/international/utf-7.el2
-rw-r--r--lisp/isearch.el588
-rw-r--r--lisp/isearchb.el2
-rw-r--r--lisp/iswitchb.el69
-rw-r--r--lisp/jit-lock.el4
-rw-r--r--lisp/jka-cmpr-hook.el22
-rw-r--r--lisp/jka-compr.el12
-rw-r--r--lisp/json.el30
-rw-r--r--lisp/kermit.el2
-rw-r--r--lisp/kmacro.el51
-rw-r--r--lisp/language/burmese.el2
-rw-r--r--lisp/language/cham.el9
-rw-r--r--lisp/language/china-util.el2
-rw-r--r--lisp/language/chinese.el12
-rw-r--r--lisp/language/cyril-util.el2
-rw-r--r--lisp/language/cyrillic.el2
-rw-r--r--lisp/language/czech.el4
-rw-r--r--lisp/language/english.el6
-rw-r--r--lisp/language/ethio-util.el18
-rw-r--r--lisp/language/ethiopic.el2
-rw-r--r--lisp/language/european.el10
-rw-r--r--lisp/language/georgian.el4
-rw-r--r--lisp/language/greek.el2
-rw-r--r--lisp/language/hanja-util.el4
-rw-r--r--lisp/language/hebrew.el2
-rw-r--r--lisp/language/ind-util.el2
-rw-r--r--lisp/language/indian.el4
-rw-r--r--lisp/language/japan-util.el2
-rw-r--r--lisp/language/japanese.el4
-rw-r--r--lisp/language/khmer.el2
-rw-r--r--lisp/language/korea-util.el6
-rw-r--r--lisp/language/korean.el4
-rw-r--r--lisp/language/lao-util.el2
-rw-r--r--lisp/language/lao.el4
-rw-r--r--lisp/language/misc-lang.el10
-rw-r--r--lisp/language/romanian.el4
-rw-r--r--lisp/language/sinhala.el2
-rw-r--r--lisp/language/slovak.el4
-rw-r--r--lisp/language/tai-viet.el8
-rw-r--r--lisp/language/thai-util.el8
-rw-r--r--lisp/language/thai.el4
-rw-r--r--lisp/language/tibet-util.el4
-rw-r--r--lisp/language/tibetan.el2
-rw-r--r--lisp/language/utf-8-lang.el4
-rw-r--r--lisp/language/viet-util.el2
-rw-r--r--lisp/language/vietnamese.el2
-rw-r--r--lisp/ldefs-boot.el5754
-rw-r--r--lisp/linum.el7
-rw-r--r--lisp/loadhist.el20
-rw-r--r--lisp/loadup.el82
-rw-r--r--lisp/locate.el4
-rw-r--r--lisp/longlines.el2
-rw-r--r--lisp/lpr.el8
-rw-r--r--lisp/ls-lisp.el19
-rw-r--r--lisp/macros.el2
-rw-r--r--lisp/mail/binhex.el8
-rw-r--r--lisp/mail/blessmail.el2
-rw-r--r--lisp/mail/emacsbug.el210
-rw-r--r--lisp/mail/feedmail.el252
-rw-r--r--lisp/mail/footnote.el29
-rw-r--r--lisp/mail/hashcash.el18
-rw-r--r--lisp/mail/mail-extr.el16
-rw-r--r--lisp/mail/mail-hist.el10
-rw-r--r--lisp/mail/mail-utils.el10
-rw-r--r--lisp/mail/mailabbrev.el65
-rw-r--r--lisp/mail/mailalias.el4
-rw-r--r--lisp/mail/mailclient.el2
-rw-r--r--lisp/mail/mailheader.el10
-rw-r--r--lisp/mail/metamail.el10
-rw-r--r--lisp/mail/mspools.el14
-rw-r--r--lisp/mail/reporter.el2
-rw-r--r--lisp/mail/rfc2368.el4
-rw-r--r--lisp/mail/rfc822.el2
-rw-r--r--lisp/mail/rmail-spam-filter.el2
-rw-r--r--lisp/mail/rmail.el203
-rw-r--r--lisp/mail/rmailedit.el4
-rw-r--r--lisp/mail/rmailkwd.el2
-rw-r--r--lisp/mail/rmailmm.el98
-rw-r--r--lisp/mail/rmailmsc.el2
-rw-r--r--lisp/mail/rmailout.el82
-rw-r--r--lisp/mail/rmailsort.el2
-rw-r--r--lisp/mail/rmailsum.el4
-rw-r--r--lisp/mail/sendmail.el117
-rw-r--r--lisp/mail/smtpmail.el85
-rw-r--r--lisp/mail/supercite.el27
-rw-r--r--lisp/mail/uce.el4
-rw-r--r--lisp/mail/undigest.el9
-rw-r--r--lisp/mail/unrmail.el8
-rw-r--r--lisp/mail/uudecode.el12
-rw-r--r--lisp/makefile.w32-in63
-rw-r--r--lisp/makesum.el2
-rw-r--r--lisp/man.el339
-rw-r--r--lisp/master.el2
-rw-r--r--lisp/mb-depth.el2
-rw-r--r--lisp/md4.el2
-rw-r--r--lisp/menu-bar.el1546
-rw-r--r--lisp/mh-e/ChangeLog263
-rw-r--r--lisp/mh-e/ChangeLog.112
-rw-r--r--lisp/mh-e/mh-acros.el2
-rw-r--r--lisp/mh-e/mh-alias.el2
-rw-r--r--lisp/mh-e/mh-buffers.el2
-rw-r--r--lisp/mh-e/mh-comp.el2
-rw-r--r--lisp/mh-e/mh-compat.el6
-rw-r--r--lisp/mh-e/mh-e.el10
-rw-r--r--lisp/mh-e/mh-folder.el4
-rw-r--r--lisp/mh-e/mh-funcs.el2
-rw-r--r--lisp/mh-e/mh-gnus.el2
-rw-r--r--lisp/mh-e/mh-identity.el2
-rw-r--r--lisp/mh-e/mh-inc.el2
-rw-r--r--lisp/mh-e/mh-junk.el2
-rw-r--r--lisp/mh-e/mh-letter.el9
-rw-r--r--lisp/mh-e/mh-limit.el2
-rw-r--r--lisp/mh-e/mh-mime.el2
-rw-r--r--lisp/mh-e/mh-print.el2
-rw-r--r--lisp/mh-e/mh-scan.el2
-rw-r--r--lisp/mh-e/mh-search.el2
-rw-r--r--lisp/mh-e/mh-seq.el2
-rw-r--r--lisp/mh-e/mh-show.el2
-rw-r--r--lisp/mh-e/mh-speed.el2
-rw-r--r--lisp/mh-e/mh-thread.el2
-rw-r--r--lisp/mh-e/mh-tool-bar.el2
-rw-r--r--lisp/mh-e/mh-utils.el5
-rw-r--r--lisp/mh-e/mh-xface.el2
-rw-r--r--lisp/midnight.el16
-rw-r--r--lisp/minibuf-eldef.el71
-rw-r--r--lisp/minibuffer.el911
-rw-r--r--lisp/misc.el21
-rw-r--r--lisp/misearch.el12
-rw-r--r--lisp/mouse-copy.el4
-rw-r--r--lisp/mouse-drag.el6
-rw-r--r--lisp/mouse.el214
-rw-r--r--lisp/mpc.el124
-rw-r--r--lisp/msb.el108
-rw-r--r--lisp/mwheel.el11
-rw-r--r--lisp/net/ange-ftp.el94
-rw-r--r--lisp/net/browse-url.el64
-rw-r--r--lisp/net/dbus.el1089
-rw-r--r--lisp/net/dig.el2
-rw-r--r--lisp/net/dns.el2
-rw-r--r--lisp/net/eudc-bob.el2
-rw-r--r--lisp/net/eudc-export.el2
-rw-r--r--lisp/net/eudc-hotlist.el2
-rw-r--r--lisp/net/eudc-vars.el2
-rw-r--r--lisp/net/eudc.el10
-rw-r--r--lisp/net/eudcb-bbdb.el26
-rw-r--r--lisp/net/eudcb-ldap.el2
-rw-r--r--lisp/net/eudcb-mab.el2
-rw-r--r--lisp/net/eudcb-ph.el2
-rw-r--r--lisp/net/gnutls.el58
-rw-r--r--lisp/net/goto-addr.el15
-rw-r--r--lisp/net/hmac-def.el2
-rw-r--r--lisp/net/hmac-md5.el2
-rw-r--r--lisp/net/imap.el45
-rw-r--r--lisp/net/ldap.el16
-rw-r--r--lisp/net/mairix.el26
-rw-r--r--lisp/net/net-utils.el2
-rw-r--r--lisp/net/netrc.el23
-rw-r--r--lisp/net/network-stream.el25
-rw-r--r--lisp/net/newst-backend.el4
-rw-r--r--lisp/net/newst-plainview.el46
-rw-r--r--lisp/net/newst-reader.el23
-rw-r--r--lisp/net/newst-ticker.el4
-rw-r--r--lisp/net/newst-treeview.el40
-rw-r--r--lisp/net/newsticker.el6
-rw-r--r--lisp/net/ntlm.el2
-rw-r--r--lisp/net/quickurl.el111
-rw-r--r--lisp/net/rcirc.el269
-rw-r--r--lisp/net/rcompile.el4
-rw-r--r--lisp/net/rlogin.el14
-rw-r--r--lisp/net/sasl-cram.el2
-rw-r--r--lisp/net/sasl-digest.el2
-rw-r--r--lisp/net/sasl-ntlm.el2
-rw-r--r--lisp/net/sasl.el4
-rw-r--r--lisp/net/secrets.el13
-rw-r--r--lisp/net/snmp-mode.el11
-rw-r--r--lisp/net/soap-client.el113
-rw-r--r--lisp/net/soap-inspect.el27
-rw-r--r--lisp/net/socks.el19
-rw-r--r--lisp/net/telnet.el2
-rw-r--r--lisp/net/tls.el9
-rw-r--r--lisp/net/tramp-cache.el55
-rw-r--r--lisp/net/tramp-cmds.el13
-rw-r--r--lisp/net/tramp-compat.el154
-rw-r--r--lisp/net/tramp-ftp.el13
-rw-r--r--lisp/net/tramp-gvfs.el28
-rw-r--r--lisp/net/tramp-gw.el12
-rw-r--r--lisp/net/tramp-sh.el624
-rw-r--r--lisp/net/tramp-smb.el728
-rw-r--r--lisp/net/tramp-uu.el2
-rw-r--r--lisp/net/tramp.el952
-rw-r--r--lisp/net/trampver.el6
-rw-r--r--lisp/net/webjump.el6
-rw-r--r--lisp/net/xesam.el25
-rw-r--r--lisp/net/zeroconf.el9
-rw-r--r--lisp/newcomment.el78
-rw-r--r--lisp/notifications.el222
-rw-r--r--lisp/novice.el16
-rw-r--r--lisp/nxml/nxml-enc.el2
-rw-r--r--lisp/nxml/nxml-glyph.el33
-rw-r--r--lisp/nxml/nxml-maint.el2
-rw-r--r--lisp/nxml/nxml-mode.el55
-rw-r--r--lisp/nxml/nxml-ns.el2
-rw-r--r--lisp/nxml/nxml-outln.el19
-rw-r--r--lisp/nxml/nxml-parse.el2
-rw-r--r--lisp/nxml/nxml-rap.el2
-rw-r--r--lisp/nxml/nxml-uchnm.el2
-rw-r--r--lisp/nxml/nxml-util.el2
-rw-r--r--lisp/nxml/rng-cmpct.el2
-rw-r--r--lisp/nxml/rng-dt.el2
-rw-r--r--lisp/nxml/rng-loc.el2
-rw-r--r--lisp/nxml/rng-maint.el2
-rw-r--r--lisp/nxml/rng-match.el2
-rw-r--r--lisp/nxml/rng-nxml.el4
-rw-r--r--lisp/nxml/rng-parse.el2
-rw-r--r--lisp/nxml/rng-pttrn.el2
-rw-r--r--lisp/nxml/rng-uri.el2
-rw-r--r--lisp/nxml/rng-util.el2
-rw-r--r--lisp/nxml/rng-valid.el6
-rw-r--r--lisp/nxml/rng-xsd.el2
-rw-r--r--lisp/nxml/xmltok.el2
-rw-r--r--lisp/nxml/xsd-regexp.el2
-rw-r--r--lisp/obsolete/abbrevlist.el2
-rw-r--r--lisp/obsolete/assoc.el (renamed from lisp/emacs-lisp/assoc.el)22
-rw-r--r--lisp/obsolete/awk-mode.el2
-rw-r--r--lisp/obsolete/bruce.el (renamed from lisp/play/bruce.el)3
-rw-r--r--lisp/obsolete/cl-compat.el2
-rw-r--r--lisp/obsolete/complete.el2
-rw-r--r--lisp/obsolete/cust-print.el (renamed from lisp/emacs-lisp/cust-print.el)3
-rw-r--r--lisp/obsolete/erc-hecomplete.el6
-rw-r--r--lisp/obsolete/fast-lock.el12
-rw-r--r--lisp/obsolete/iso-acc.el8
-rw-r--r--lisp/obsolete/iso-insert.el2
-rw-r--r--lisp/obsolete/iso-swed.el2
-rw-r--r--lisp/obsolete/keyswap.el2
-rw-r--r--lisp/obsolete/lazy-lock.el2
-rw-r--r--lisp/obsolete/ledit.el (renamed from lisp/ledit.el)5
-rw-r--r--lisp/obsolete/levents.el2
-rw-r--r--lisp/obsolete/lmenu.el2
-rw-r--r--lisp/obsolete/lucid.el2
-rw-r--r--lisp/obsolete/mailpost.el (renamed from lisp/mail/mailpost.el)1
-rw-r--r--lisp/obsolete/mouse-sel.el (renamed from lisp/mouse-sel.el)5
-rw-r--r--lisp/obsolete/old-emacs-lock.el2
-rw-r--r--lisp/obsolete/old-whitespace.el12
-rw-r--r--lisp/obsolete/options.el2
-rw-r--r--lisp/obsolete/patcomp.el (renamed from lisp/patcomp.el)2
-rw-r--r--lisp/obsolete/pc-mode.el2
-rw-r--r--lisp/obsolete/pc-select.el2
-rw-r--r--lisp/obsolete/pgg-def.el2
-rw-r--r--lisp/obsolete/pgg-gpg.el2
-rw-r--r--lisp/obsolete/pgg-parse.el4
-rw-r--r--lisp/obsolete/pgg-pgp.el2
-rw-r--r--lisp/obsolete/pgg-pgp5.el2
-rw-r--r--lisp/obsolete/pgg.el2
-rw-r--r--lisp/obsolete/resume.el4
-rw-r--r--lisp/obsolete/s-region.el2
-rw-r--r--lisp/obsolete/scribe.el8
-rw-r--r--lisp/obsolete/spell.el2
-rw-r--r--lisp/obsolete/sregex.el2
-rw-r--r--lisp/obsolete/swedish.el2
-rw-r--r--lisp/obsolete/sym-comp.el2
-rw-r--r--lisp/obsolete/vc-mcvs.el4
-rw-r--r--lisp/org/ChangeLog7681
-rw-r--r--lisp/org/ob-C.el47
-rw-r--r--lisp/org/ob-R.el133
-rw-r--r--lisp/org/ob-asymptote.el87
-rw-r--r--lisp/org/ob-awk.el18
-rw-r--r--lisp/org/ob-calc.el22
-rw-r--r--lisp/org/ob-clojure.el10
-rw-r--r--lisp/org/ob-comint.el81
-rw-r--r--lisp/org/ob-css.el5
-rw-r--r--lisp/org/ob-ditaa.el23
-rw-r--r--lisp/org/ob-dot.el6
-rw-r--r--lisp/org/ob-emacs-lisp.el15
-rw-r--r--lisp/org/ob-eval.el7
-rw-r--r--lisp/org/ob-exp.el296
-rw-r--r--lisp/org/ob-fortran.el162
-rw-r--r--lisp/org/ob-gnuplot.el89
-rw-r--r--lisp/org/ob-haskell.el11
-rw-r--r--lisp/org/ob-io.el122
-rw-r--r--lisp/org/ob-java.el11
-rw-r--r--lisp/org/ob-js.el10
-rw-r--r--lisp/org/ob-keys.el9
-rw-r--r--lisp/org/ob-latex.el33
-rw-r--r--lisp/org/ob-ledger.el7
-rw-r--r--lisp/org/ob-lilypond.el177
-rw-r--r--lisp/org/ob-lisp.el20
-rw-r--r--lisp/org/ob-lob.el109
-rw-r--r--lisp/org/ob-matlab.el3
-rw-r--r--lisp/org/ob-maxima.el107
-rw-r--r--lisp/org/ob-mscgen.el9
-rw-r--r--lisp/org/ob-ocaml.el19
-rw-r--r--lisp/org/ob-octave.el55
-rw-r--r--lisp/org/ob-org.el5
-rw-r--r--lisp/org/ob-perl.el19
-rw-r--r--lisp/org/ob-picolisp.el195
-rw-r--r--lisp/org/ob-plantuml.el9
-rw-r--r--lisp/org/ob-python.el68
-rw-r--r--lisp/org/ob-ref.el235
-rw-r--r--lisp/org/ob-ruby.el21
-rw-r--r--lisp/org/ob-sass.el3
-rw-r--r--lisp/org/ob-scala.el128
-rw-r--r--lisp/org/ob-scheme.el4
-rw-r--r--lisp/org/ob-screen.el19
-rw-r--r--lisp/org/ob-sh.el62
-rw-r--r--lisp/org/ob-shen.el79
-rw-r--r--lisp/org/ob-sql.el97
-rw-r--r--lisp/org/ob-sqlite.el39
-rw-r--r--lisp/org/ob-table.el102
-rw-r--r--lisp/org/ob-tangle.el375
-rw-r--r--lisp/org/ob.el1441
-rw-r--r--lisp/org/org-agenda.el4520
-rw-r--r--lisp/org/org-archive.el506
-rw-r--r--lisp/org/org-ascii.el119
-rw-r--r--lisp/org/org-attach.el39
-rw-r--r--lisp/org/org-bbdb.el146
-rw-r--r--lisp/org/org-beamer.el90
-rw-r--r--lisp/org/org-bibtex.el344
-rw-r--r--lisp/org/org-capture.el577
-rw-r--r--lisp/org/org-clock.el1090
-rw-r--r--lisp/org/org-colview.el242
-rw-r--r--lisp/org/org-compat.el70
-rw-r--r--lisp/org/org-crypt.el94
-rw-r--r--lisp/org/org-ctags.el69
-rw-r--r--lisp/org/org-datetree.el92
-rw-r--r--lisp/org/org-docbook.el43
-rw-r--r--lisp/org/org-docview.el5
-rw-r--r--lisp/org/org-element.el4418
-rw-r--r--lisp/org/org-entities.el63
-rw-r--r--lisp/org/org-eshell.el65
-rw-r--r--lisp/org/org-exp-blocks.el248
-rw-r--r--lisp/org/org-exp.el634
-rw-r--r--lisp/org/org-faces.el95
-rw-r--r--lisp/org/org-feed.el132
-rw-r--r--lisp/org/org-footnote.el542
-rw-r--r--lisp/org/org-freemind.el121
-rw-r--r--lisp/org/org-gnus.el32
-rw-r--r--lisp/org/org-habit.el53
-rw-r--r--lisp/org/org-html.el908
-rw-r--r--lisp/org/org-icalendar.el93
-rw-r--r--lisp/org/org-id.el83
-rw-r--r--lisp/org/org-indent.el508
-rw-r--r--lisp/org/org-info.el11
-rw-r--r--lisp/org/org-inlinetask.el251
-rw-r--r--lisp/org/org-install.el44
-rw-r--r--lisp/org/org-irc.el89
-rw-r--r--lisp/org/org-jsinfo.el191
-rw-r--r--lisp/org/org-latex.el710
-rw-r--r--lisp/org/org-list.el721
-rw-r--r--lisp/org/org-lparse.el2303
-rw-r--r--lisp/org/org-mac-message.el103
-rw-r--r--lisp/org/org-macs.el226
-rw-r--r--lisp/org/org-mew.el8
-rw-r--r--lisp/org/org-mhe.el31
-rw-r--r--lisp/org/org-mks.el7
-rw-r--r--lisp/org/org-mobile.el281
-rw-r--r--lisp/org/org-mouse.el774
-rw-r--r--lisp/org/org-odt.el2854
-rw-r--r--lisp/org/org-pcomplete.el118
-rw-r--r--lisp/org/org-plot.el124
-rw-r--r--lisp/org/org-protocol.el118
-rw-r--r--lisp/org/org-publish.el173
-rw-r--r--lisp/org/org-remember.el101
-rw-r--r--lisp/org/org-rmail.el20
-rw-r--r--lisp/org/org-special-blocks.el29
-rw-r--r--lisp/org/org-src.el205
-rw-r--r--lisp/org/org-table.el615
-rw-r--r--lisp/org/org-taskjuggler.el99
-rw-r--r--lisp/org/org-timer.el162
-rw-r--r--lisp/org/org-version.el27
-rw-r--r--lisp/org/org-vm.el90
-rw-r--r--lisp/org/org-w3m.el5
-rw-r--r--lisp/org/org-wl.el22
-rw-r--r--lisp/org/org-xoxo.el8
-rw-r--r--lisp/org/org.el6854
-rw-r--r--lisp/outline.el9
-rw-r--r--lisp/paren.el15
-rw-r--r--lisp/password-cache.el5
-rw-r--r--lisp/paths.el188
-rw-r--r--lisp/pcmpl-cvs.el2
-rw-r--r--lisp/pcmpl-gnu.el7
-rw-r--r--lisp/pcmpl-linux.el2
-rw-r--r--lisp/pcmpl-rpm.el68
-rw-r--r--lisp/pcmpl-unix.el20
-rw-r--r--lisp/pcomplete.el176
-rw-r--r--lisp/play/5x5.el136
-rw-r--r--lisp/play/animate.el6
-rw-r--r--lisp/play/blackbox.el7
-rw-r--r--lisp/play/bubbles.el65
-rw-r--r--lisp/play/cookie1.el9
-rw-r--r--lisp/play/decipher.el65
-rw-r--r--lisp/play/dissociate.el4
-rw-r--r--lisp/play/doctor.el84
-rw-r--r--lisp/play/dunnet.el5
-rw-r--r--lisp/play/fortune.el2
-rw-r--r--lisp/play/gamegrid.el47
-rw-r--r--lisp/play/gametree.el2
-rw-r--r--lisp/play/gomoku.el38
-rw-r--r--lisp/play/handwrite.el6
-rw-r--r--lisp/play/hanoi.el185
-rw-r--r--lisp/play/landmark.el34
-rw-r--r--lisp/play/life.el8
-rw-r--r--lisp/play/morse.el2
-rw-r--r--lisp/play/mpuz.el26
-rw-r--r--lisp/play/pong.el52
-rw-r--r--lisp/play/snake.el31
-rw-r--r--lisp/play/solitaire.el10
-rw-r--r--lisp/play/spook.el2
-rw-r--r--lisp/play/tetris.el185
-rw-r--r--lisp/play/yow.el8
-rw-r--r--lisp/play/zone.el21
-rw-r--r--lisp/printing.el20
-rw-r--r--lisp/proced.el320
-rw-r--r--lisp/profiler.el769
-rw-r--r--lisp/progmodes/ada-mode.el78
-rw-r--r--lisp/progmodes/ada-prj.el2
-rw-r--r--lisp/progmodes/ada-stmt.el2
-rw-r--r--lisp/progmodes/ada-xref.el48
-rw-r--r--lisp/progmodes/antlr-mode.el40
-rw-r--r--lisp/progmodes/asm-mode.el4
-rw-r--r--lisp/progmodes/autoconf.el25
-rw-r--r--lisp/progmodes/bug-reference.el21
-rw-r--r--lisp/progmodes/cap-words.el2
-rw-r--r--lisp/progmodes/cc-align.el2
-rw-r--r--lisp/progmodes/cc-awk.el2
-rw-r--r--lisp/progmodes/cc-bytecomp.el26
-rw-r--r--lisp/progmodes/cc-cmds.el107
-rw-r--r--lisp/progmodes/cc-compat.el2
-rw-r--r--lisp/progmodes/cc-defs.el10
-rw-r--r--lisp/progmodes/cc-engine.el545
-rw-r--r--lisp/progmodes/cc-fonts.el63
-rw-r--r--lisp/progmodes/cc-guess.el4
-rw-r--r--lisp/progmodes/cc-langs.el23
-rw-r--r--lisp/progmodes/cc-menus.el51
-rw-r--r--lisp/progmodes/cc-mode.el48
-rw-r--r--lisp/progmodes/cc-styles.el6
-rw-r--r--lisp/progmodes/cc-vars.el13
-rw-r--r--lisp/progmodes/cfengine.el4
-rw-r--r--lisp/progmodes/cmacexp.el12
-rw-r--r--lisp/progmodes/compile.el254
-rw-r--r--lisp/progmodes/cperl-mode.el33
-rw-r--r--lisp/progmodes/cpp.el14
-rw-r--r--lisp/progmodes/cwarn.el55
-rw-r--r--lisp/progmodes/dcl-mode.el44
-rw-r--r--lisp/progmodes/delphi.el24
-rw-r--r--lisp/progmodes/ebnf-abn.el2
-rw-r--r--lisp/progmodes/ebnf-bnf.el2
-rw-r--r--lisp/progmodes/ebnf-dtd.el2
-rw-r--r--lisp/progmodes/ebnf-ebx.el2
-rw-r--r--lisp/progmodes/ebnf-iso.el2
-rw-r--r--lisp/progmodes/ebnf-otz.el2
-rw-r--r--lisp/progmodes/ebnf-yac.el6
-rw-r--r--lisp/progmodes/ebnf2ps.el142
-rw-r--r--lisp/progmodes/ebrowse.el794
-rw-r--r--lisp/progmodes/etags.el101
-rw-r--r--lisp/progmodes/executable.el19
-rw-r--r--lisp/progmodes/f90.el41
-rw-r--r--lisp/progmodes/flymake.el110
-rw-r--r--lisp/progmodes/fortran.el6
-rw-r--r--lisp/progmodes/gdb-mi.el718
-rw-r--r--lisp/progmodes/glasses.el14
-rw-r--r--lisp/progmodes/grep.el37
-rw-r--r--lisp/progmodes/gud.el137
-rw-r--r--lisp/progmodes/hideif.el23
-rw-r--r--lisp/progmodes/hideshow.el42
-rw-r--r--lisp/progmodes/icon.el16
-rw-r--r--lisp/progmodes/idlw-complete-structtag.el6
-rw-r--r--lisp/progmodes/idlw-help.el12
-rw-r--r--lisp/progmodes/idlw-shell.el97
-rw-r--r--lisp/progmodes/idlw-toolbar.el2
-rw-r--r--lisp/progmodes/idlwave.el147
-rw-r--r--lisp/progmodes/inf-lisp.el29
-rw-r--r--lisp/progmodes/js.el1048
-rw-r--r--lisp/progmodes/ld-script.el2
-rw-r--r--lisp/progmodes/m4-mode.el4
-rw-r--r--lisp/progmodes/make-mode.el43
-rw-r--r--lisp/progmodes/mantemp.el2
-rw-r--r--lisp/progmodes/meta-mode.el6
-rw-r--r--lisp/progmodes/mixal-mode.el40
-rw-r--r--lisp/progmodes/modula2.el4
-rw-r--r--lisp/progmodes/octave-inf.el6
-rw-r--r--lisp/progmodes/octave-mod.el27
-rw-r--r--lisp/progmodes/pascal.el94
-rw-r--r--lisp/progmodes/perl-mode.el195
-rw-r--r--lisp/progmodes/prolog.el589
-rw-r--r--lisp/progmodes/ps-mode.el28
-rw-r--r--lisp/progmodes/python.el5607
-rw-r--r--lisp/progmodes/ruby-mode.el465
-rw-r--r--lisp/progmodes/scheme.el8
-rw-r--r--lisp/progmodes/sh-script.el757
-rw-r--r--lisp/progmodes/simula.el24
-rw-r--r--lisp/progmodes/sql.el384
-rw-r--r--lisp/progmodes/subword.el30
-rw-r--r--lisp/progmodes/tcl.el30
-rw-r--r--lisp/progmodes/vera-mode.el32
-rw-r--r--lisp/progmodes/verilog-mode.el1949
-rw-r--r--lisp/progmodes/vhdl-mode.el1559
-rw-r--r--lisp/progmodes/which-func.el44
-rw-r--r--lisp/progmodes/xscheme.el22
-rw-r--r--lisp/ps-bdf.el21
-rw-r--r--lisp/ps-def.el2
-rw-r--r--lisp/ps-mule.el4
-rw-r--r--lisp/ps-print.el6
-rw-r--r--lisp/ps-samp.el4
-rw-r--r--lisp/recentf.el4
-rw-r--r--lisp/rect.el22
-rw-r--r--lisp/register.el110
-rw-r--r--lisp/repeat.el154
-rw-r--r--lisp/replace.el399
-rw-r--r--lisp/reposition.el2
-rw-r--r--lisp/reveal.el2
-rw-r--r--lisp/rfn-eshadow.el2
-rw-r--r--lisp/rot13.el2
-rw-r--r--lisp/ruler-mode.el2
-rw-r--r--lisp/savehist.el15
-rw-r--r--lisp/saveplace.el53
-rw-r--r--lisp/sb-image.el2
-rw-r--r--lisp/scroll-all.el3
-rw-r--r--lisp/scroll-bar.el16
-rw-r--r--lisp/scroll-lock.el12
-rw-r--r--lisp/select.el103
-rw-r--r--lisp/server.el415
-rw-r--r--lisp/ses.el285
-rw-r--r--lisp/shadowfile.el2
-rw-r--r--lisp/shell.el166
-rw-r--r--lisp/simple.el999
-rw-r--r--lisp/skeleton.el18
-rw-r--r--lisp/sort.el33
-rw-r--r--lisp/soundex.el2
-rw-r--r--lisp/speedbar.el130
-rw-r--r--lisp/startup.el195
-rw-r--r--lisp/strokes.el285
-rw-r--r--lisp/subr.el996
-rw-r--r--lisp/t-mouse.el2
-rw-r--r--lisp/tabify.el2
-rw-r--r--lisp/talk.el2
-rw-r--r--lisp/tar-mode.el69
-rw-r--r--lisp/tempo.el2
-rw-r--r--lisp/term.el737
-rw-r--r--lisp/term/AT386.el4
-rw-r--r--lisp/term/README2
-rw-r--r--lisp/term/apollo.el1
-rw-r--r--lisp/term/bobcat.el1
-rw-r--r--lisp/term/common-win.el4
-rw-r--r--lisp/term/cygwin.el2
-rw-r--r--lisp/term/internal.el2
-rw-r--r--lisp/term/iris-ansi.el6
-rw-r--r--lisp/term/linux.el3
-rw-r--r--lisp/term/lk201.el3
-rw-r--r--lisp/term/news.el4
-rw-r--r--lisp/term/ns-win.el90
-rw-r--r--lisp/term/pc-win.el77
-rw-r--r--lisp/term/rxvt.el4
-rw-r--r--lisp/term/screen.el3
-rw-r--r--lisp/term/sun.el3
-rw-r--r--lisp/term/sup-mouse.el8
-rw-r--r--lisp/term/tty-colors.el2
-rw-r--r--lisp/term/tvi970.el6
-rw-r--r--lisp/term/vt100.el2
-rw-r--r--lisp/term/vt102.el1
-rw-r--r--lisp/term/vt125.el1
-rw-r--r--lisp/term/vt200.el1
-rw-r--r--lisp/term/vt201.el1
-rw-r--r--lisp/term/vt220.el1
-rw-r--r--lisp/term/vt240.el1
-rw-r--r--lisp/term/vt300.el1
-rw-r--r--lisp/term/vt320.el1
-rw-r--r--lisp/term/vt400.el1
-rw-r--r--lisp/term/vt420.el1
-rw-r--r--lisp/term/w32-win.el64
-rw-r--r--lisp/term/w32console.el14
-rw-r--r--lisp/term/wyse50.el8
-rw-r--r--lisp/term/x-win.el32
-rw-r--r--lisp/term/xterm.el20
-rw-r--r--lisp/terminal.el2
-rw-r--r--lisp/textmodes/artist.el59
-rw-r--r--lisp/textmodes/bib-mode.el4
-rw-r--r--lisp/textmodes/bibtex-style.el2
-rw-r--r--lisp/textmodes/bibtex.el292
-rw-r--r--lisp/textmodes/conf-mode.el2
-rw-r--r--lisp/textmodes/css-mode.el3
-rw-r--r--lisp/textmodes/dns-mode.el2
-rw-r--r--lisp/textmodes/enriched.el9
-rw-r--r--lisp/textmodes/fill.el8
-rw-r--r--lisp/textmodes/flyspell.el432
-rw-r--r--lisp/textmodes/ispell.el635
-rw-r--r--lisp/textmodes/makeinfo.el2
-rw-r--r--lisp/textmodes/nroff-mode.el2
-rw-r--r--lisp/textmodes/page-ext.el2
-rw-r--r--lisp/textmodes/page.el2
-rw-r--r--lisp/textmodes/paragraphs.el2
-rw-r--r--lisp/textmodes/picture.el146
-rw-r--r--lisp/textmodes/po.el2
-rw-r--r--lisp/textmodes/refbib.el10
-rw-r--r--lisp/textmodes/refer.el2
-rw-r--r--lisp/textmodes/refill.el16
-rw-r--r--lisp/textmodes/reftex-auc.el31
-rw-r--r--lisp/textmodes/reftex-cite.el173
-rw-r--r--lisp/textmodes/reftex-dcr.el20
-rw-r--r--lisp/textmodes/reftex-global.el25
-rw-r--r--lisp/textmodes/reftex-index.el35
-rw-r--r--lisp/textmodes/reftex-parse.el19
-rw-r--r--lisp/textmodes/reftex-ref.el138
-rw-r--r--lisp/textmodes/reftex-sel.el65
-rw-r--r--lisp/textmodes/reftex-toc.el22
-rw-r--r--lisp/textmodes/reftex-vars.el351
-rw-r--r--lisp/textmodes/reftex.el669
-rw-r--r--lisp/textmodes/remember.el2
-rw-r--r--lisp/textmodes/rst.el4729
-rw-r--r--lisp/textmodes/sgml-mode.el63
-rw-r--r--lisp/textmodes/table.el478
-rw-r--r--lisp/textmodes/tex-mode.el132
-rw-r--r--lisp/textmodes/texinfmt.el34
-rw-r--r--lisp/textmodes/texinfo.el4
-rw-r--r--lisp/textmodes/texnfo-upd.el12
-rw-r--r--lisp/textmodes/text-mode.el28
-rw-r--r--lisp/textmodes/tildify.el4
-rw-r--r--lisp/textmodes/two-column.el211
-rw-r--r--lisp/textmodes/underline.el2
-rw-r--r--lisp/thingatpt.el6
-rw-r--r--lisp/thumbs.el2
-rw-r--r--lisp/time-stamp.el6
-rw-r--r--lisp/time.el41
-rw-r--r--lisp/timezone.el4
-rw-r--r--lisp/tmm.el124
-rw-r--r--lisp/tool-bar.el3
-rw-r--r--lisp/tooltip.el45
-rw-r--r--lisp/tree-widget.el3
-rw-r--r--lisp/tutorial.el30
-rw-r--r--lisp/type-break.el152
-rw-r--r--lisp/uniquify.el37
-rw-r--r--lisp/url/ChangeLog312
-rw-r--r--lisp/url/url-about.el2
-rw-r--r--lisp/url/url-auth.el4
-rw-r--r--lisp/url/url-cache.el30
-rw-r--r--lisp/url/url-cid.el2
-rw-r--r--lisp/url/url-cookie.el51
-rw-r--r--lisp/url/url-dav.el93
-rw-r--r--lisp/url/url-dired.el7
-rw-r--r--lisp/url/url-domsuf.el98
-rw-r--r--lisp/url/url-expand.el9
-rw-r--r--lisp/url/url-file.el22
-rw-r--r--lisp/url/url-ftp.el2
-rw-r--r--lisp/url/url-future.el36
-rw-r--r--lisp/url/url-gw.el15
-rw-r--r--lisp/url/url-handlers.el76
-rw-r--r--lisp/url/url-history.el2
-rw-r--r--lisp/url/url-http.el320
-rw-r--r--lisp/url/url-imap.el2
-rw-r--r--lisp/url/url-irc.el2
-rw-r--r--lisp/url/url-ldap.el6
-rw-r--r--lisp/url/url-mailto.el2
-rw-r--r--lisp/url/url-methods.el21
-rw-r--r--lisp/url/url-misc.el21
-rw-r--r--lisp/url/url-news.el2
-rw-r--r--lisp/url/url-nfs.el14
-rw-r--r--lisp/url/url-ns.el2
-rw-r--r--lisp/url/url-parse.el239
-rw-r--r--lisp/url/url-privacy.el13
-rw-r--r--lisp/url/url-proxy.el2
-rw-r--r--lisp/url/url-queue.el99
-rw-r--r--lisp/url/url-util.el223
-rw-r--r--lisp/url/url-vars.el29
-rw-r--r--lisp/url/url.el63
-rw-r--r--lisp/userlock.el51
-rw-r--r--lisp/vc/add-log.el31
-rw-r--r--lisp/vc/compare-w.el2
-rw-r--r--lisp/vc/cvs-status.el76
-rw-r--r--lisp/vc/diff-mode.el604
-rw-r--r--lisp/vc/diff.el29
-rw-r--r--lisp/vc/ediff-diff.el48
-rw-r--r--lisp/vc/ediff-help.el2
-rw-r--r--lisp/vc/ediff-hook.el2
-rw-r--r--lisp/vc/ediff-init.el69
-rw-r--r--lisp/vc/ediff-merg.el2
-rw-r--r--lisp/vc/ediff-mult.el7
-rw-r--r--lisp/vc/ediff-ptch.el2
-rw-r--r--lisp/vc/ediff-util.el8
-rw-r--r--lisp/vc/ediff-vers.el2
-rw-r--r--lisp/vc/ediff-wind.el41
-rw-r--r--lisp/vc/ediff.el20
-rw-r--r--lisp/vc/emerge.el20
-rw-r--r--lisp/vc/log-edit.el163
-rw-r--r--lisp/vc/log-view.el50
-rw-r--r--lisp/vc/pcvs-defs.el31
-rw-r--r--lisp/vc/pcvs-info.el44
-rw-r--r--lisp/vc/pcvs-parse.el16
-rw-r--r--lisp/vc/pcvs-util.el30
-rw-r--r--lisp/vc/pcvs.el131
-rw-r--r--lisp/vc/smerge-mode.el133
-rw-r--r--lisp/vc/vc-annotate.el35
-rw-r--r--lisp/vc/vc-arch.el57
-rw-r--r--lisp/vc/vc-bzr.el570
-rw-r--r--lisp/vc/vc-cvs.el55
-rw-r--r--lisp/vc/vc-dav.el10
-rw-r--r--lisp/vc/vc-dir.el100
-rw-r--r--lisp/vc/vc-dispatcher.el32
-rw-r--r--lisp/vc/vc-git.el236
-rw-r--r--lisp/vc/vc-hg.el110
-rw-r--r--lisp/vc/vc-hooks.el164
-rw-r--r--lisp/vc/vc-mtn.el113
-rw-r--r--lisp/vc/vc-rcs.el225
-rw-r--r--lisp/vc/vc-sccs.el140
-rw-r--r--lisp/vc/vc-svn.el36
-rw-r--r--lisp/vc/vc.el330
-rw-r--r--lisp/vcursor.el13
-rw-r--r--lisp/version.el132
-rw-r--r--lisp/view.el40
-rw-r--r--lisp/vt-control.el2
-rw-r--r--lisp/vt100-led.el2
-rw-r--r--lisp/w32-common-fns.el130
-rw-r--r--lisp/w32-fns.el129
-rw-r--r--lisp/w32-vars.el26
-rw-r--r--lisp/wdired.el66
-rw-r--r--lisp/whitespace.el78
-rw-r--r--lisp/wid-browse.el8
-rw-r--r--lisp/wid-edit.el65
-rw-r--r--lisp/widget.el2
-rw-r--r--lisp/windmove.el24
-rw-r--r--lisp/window.el2411
-rw-r--r--lisp/winner.el181
-rw-r--r--lisp/woman.el226
-rw-r--r--lisp/x-dnd.el4
-rw-r--r--lisp/xml.el1124
-rw-r--r--lisp/xt-mouse.el183
-rw-r--r--lwlib/ChangeLog69
-rw-r--r--lwlib/Makefile.in19
-rw-r--r--lwlib/lwlib-Xaw.c41
-rw-r--r--lwlib/lwlib-Xlw.c4
-rw-r--r--lwlib/lwlib-Xm.c7
-rw-r--r--lwlib/lwlib-int.h2
-rw-r--r--lwlib/lwlib-utils.c4
-rw-r--r--lwlib/lwlib.c29
-rw-r--r--lwlib/lwlib.h2
-rw-r--r--lwlib/xlwmenu.c26
-rw-r--r--lwlib/xlwmenu.h2
-rw-r--r--lwlib/xlwmenuP.h2
-rw-r--r--m4/00gnulib.m42
-rw-r--r--m4/alloca.m418
-rw-r--r--m4/c-strtod.m42
-rw-r--r--m4/clock_time.m431
-rw-r--r--m4/close-stream.m411
-rw-r--r--m4/dup2.m429
-rw-r--r--m4/environ.m447
-rw-r--r--m4/euidaccess.m452
-rw-r--r--m4/execinfo.m431
-rw-r--r--m4/extensions.m48
-rw-r--r--m4/extern-inline.m457
-rw-r--r--m4/faccessat.m428
-rw-r--r--m4/fcntl_h.m450
-rw-r--r--m4/filemode.m42
-rw-r--r--m4/fpending.m490
-rw-r--r--m4/getgroups.m4107
-rw-r--r--m4/getloadavg.m410
-rw-r--r--m4/getopt.m4295
-rw-r--r--m4/gettime.m413
-rw-r--r--m4/gettimeofday.m4140
-rw-r--r--m4/gnulib-common.m415
-rw-r--r--m4/gnulib-comp.m4 (renamed from m4/gl-comp.m4)497
-rw-r--r--m4/gnulib-tool.m42
-rw-r--r--m4/group-member.m429
-rw-r--r--m4/include_next.m417
-rw-r--r--m4/inttypes.m421
-rw-r--r--m4/largefile.m447
-rw-r--r--m4/longlong.m48
-rw-r--r--m4/lstat.m435
-rw-r--r--m4/manywarnings.m4224
-rw-r--r--m4/md5.m42
-rw-r--r--m4/mktime.m434
-rw-r--r--m4/multiarch.m46
-rw-r--r--m4/nocrash.m46
-rw-r--r--m4/off_t.m418
-rw-r--r--m4/pathmax.m442
-rw-r--r--m4/pselect.m469
-rw-r--r--m4/pthread_sigmask.m46
-rw-r--r--m4/readlink.m432
-rw-r--r--m4/sha1.m42
-rw-r--r--m4/sha256.m42
-rw-r--r--m4/sha512.m42
-rw-r--r--m4/signal_h.m42
-rw-r--r--m4/signalblocking.m427
-rw-r--r--m4/socklen.m42
-rw-r--r--m4/ssize_t.m42
-rw-r--r--m4/st_dm_mode.m42
-rw-r--r--m4/stat-time.m483
-rw-r--r--m4/stat.m417
-rw-r--r--m4/stdalign.m451
-rw-r--r--m4/stdarg.m42
-rw-r--r--m4/stdbool.m42
-rw-r--r--m4/stddef_h.m42
-rw-r--r--m4/stdint.m48
-rw-r--r--m4/stdio_h.m414
-rw-r--r--m4/stdlib_h.m422
-rw-r--r--m4/strftime.m42
-rw-r--r--m4/strtoimax.m464
-rw-r--r--m4/strtoll.m42
-rw-r--r--m4/strtoull.m42
-rw-r--r--m4/strtoumax.m42
-rw-r--r--m4/symlink.m422
-rw-r--r--m4/sys_select_h.m495
-rw-r--r--m4/sys_socket_h.m4177
-rw-r--r--m4/sys_stat_h.m417
-rw-r--r--m4/sys_time_h.m4110
-rw-r--r--m4/sys_types_h.m424
-rw-r--r--m4/time_h.m46
-rw-r--r--m4/time_r.m44
-rw-r--r--m4/timer_time.m439
-rw-r--r--m4/timespec.m411
-rw-r--r--m4/tm_gmtoff.m42
-rw-r--r--m4/unistd_h.m423
-rw-r--r--m4/utimbuf.m439
-rw-r--r--m4/utimens.m450
-rw-r--r--m4/utimes.m4136
-rw-r--r--m4/warnings.m461
-rw-r--r--m4/wchar_t.m42
-rwxr-xr-xmake-dist84
-rw-r--r--msdos/ChangeLog186
-rw-r--r--msdos/INSTALL2
-rw-r--r--msdos/README4
-rw-r--r--msdos/depfiles.bat2
-rw-r--r--msdos/inttypes.h3
-rw-r--r--msdos/mainmake.v28
-rw-r--r--msdos/sed1v2.inp39
-rw-r--r--msdos/sed1x.inp2
-rw-r--r--msdos/sed2v2.inp40
-rw-r--r--msdos/sed2x.inp3
-rw-r--r--msdos/sed3v2.inp12
-rw-r--r--msdos/sed4.inp3
-rw-r--r--msdos/sed5x.inp2
-rw-r--r--msdos/sed6.inp4
-rw-r--r--msdos/sedalloc.inp2
-rw-r--r--msdos/sedleim.inp23
-rw-r--r--msdos/sedlibcf.inp2
-rw-r--r--msdos/sedlibmk.inp82
-rw-r--r--msdos/sedlisp.inp2
-rw-r--r--nextstep/ChangeLog40
-rw-r--r--nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings6
-rw-r--r--nextstep/INSTALL5
-rw-r--r--nextstep/Makefile.in67
-rw-r--r--nextstep/README2
-rw-r--r--nextstep/templates/Emacs.desktop.in (renamed from nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop)2
-rw-r--r--nextstep/templates/Info-gnustep.plist.in (renamed from nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist)6
-rw-r--r--nextstep/templates/Info.plist.in (renamed from nextstep/Cocoa/Emacs.base/Contents/Info.plist)6
-rw-r--r--nextstep/templates/InfoPlist.strings.in6
-rw-r--r--nt/ChangeLog682
-rw-r--r--nt/INSTALL71
-rw-r--r--nt/README2
-rw-r--r--nt/README.W3231
-rw-r--r--nt/addpm.c2
-rw-r--r--nt/addsection.c49
-rw-r--r--nt/cmdproxy.c81
-rw-r--r--nt/config.nt1884
-rwxr-xr-xnt/configure.bat96
-rw-r--r--nt/ddeclient.c2
-rw-r--r--nt/emacs-x64.manifest21
-rw-r--r--nt/emacs-x86.manifest (renamed from nt/emacs.manifest)0
-rw-r--r--nt/emacs.rc16
-rw-r--r--nt/emacsclient.rc10
-rw-r--r--nt/envadd.bat3
-rw-r--r--nt/gmake.defs42
-rw-r--r--nt/icons/README6
-rw-r--r--nt/inc/dirent.h (renamed from src/ndir.h)9
-rw-r--r--nt/inc/grp.h7
-rw-r--r--nt/inc/inttypes.h2
-rw-r--r--nt/inc/langinfo.h2
-rw-r--r--nt/inc/ms-w32.h (renamed from src/s/ms-w32.h)299
-rw-r--r--nt/inc/nl_types.h2
-rw-r--r--nt/inc/pwd.h7
-rw-r--r--nt/inc/stdalign.h25
-rw-r--r--nt/inc/stdint.h5
-rw-r--r--nt/inc/sys/dir.h6
-rw-r--r--nt/inc/sys/socket.h109
-rw-r--r--nt/inc/sys/stat.h14
-rw-r--r--nt/inc/sys/time.h32
-rw-r--r--nt/inc/sys/wait.h (renamed from src/m/sparc.h)21
-rw-r--r--nt/inc/unistd.h23
-rw-r--r--nt/makefile.w32-in923
-rw-r--r--nt/multi-install-info.bat3
-rw-r--r--nt/nmake.defs73
-rw-r--r--nt/paths.h20
-rw-r--r--nt/preprep.c81
-rw-r--r--nt/runemacs.c2
-rw-r--r--nt/zipdist.bat13
-rw-r--r--oldXMenu/Activate.c2
-rw-r--r--oldXMenu/ChangeLog27
-rw-r--r--oldXMenu/Create.c2
-rw-r--r--oldXMenu/FindSel.c2
-rw-r--r--oldXMenu/Internal.c2
-rw-r--r--oldXMenu/Makefile.in20
-rw-r--r--oldXMenu/insque.c2
-rw-r--r--src/.gdbinit291
-rw-r--r--src/.gitignore1
-rw-r--r--src/ChangeLog11287
-rw-r--r--src/ChangeLog.12
-rw-r--r--src/ChangeLog.1012
-rw-r--r--src/ChangeLog.1122
-rw-r--r--src/ChangeLog.24
-rw-r--r--src/ChangeLog.34
-rw-r--r--src/ChangeLog.42
-rw-r--r--src/ChangeLog.52
-rw-r--r--src/ChangeLog.622
-rw-r--r--src/ChangeLog.721
-rw-r--r--src/ChangeLog.84
-rw-r--r--src/ChangeLog.92
-rw-r--r--src/Makefile.in127
-rw-r--r--src/README2
-rw-r--r--src/alloc.c2892
-rw-r--r--src/atimer.c180
-rw-r--r--src/atimer.h5
-rw-r--r--src/bidi.c340
-rw-r--r--src/blockinput.h126
-rw-r--r--src/buffer.c1863
-rw-r--r--src/buffer.h854
-rw-r--r--src/bytecode.c1123
-rw-r--r--src/callint.c75
-rw-r--r--src/callproc.c286
-rw-r--r--src/casefiddle.c66
-rw-r--r--src/casetab.c49
-rw-r--r--src/category.c58
-rw-r--r--src/category.h52
-rw-r--r--src/ccl.c144
-rw-r--r--src/ccl.h8
-rw-r--r--src/character.c235
-rw-r--r--src/character.h73
-rw-r--r--src/charset.c252
-rw-r--r--src/charset.h76
-rw-r--r--src/chartab.c163
-rw-r--r--src/cm.c5
-rw-r--r--src/cm.h2
-rw-r--r--src/cmds.c177
-rw-r--r--src/coding.c1028
-rw-r--r--src/coding.h100
-rw-r--r--src/commands.h5
-rw-r--r--src/composite.c238
-rw-r--r--src/composite.h47
-rw-r--r--src/conf_post.h238
-rw-r--r--src/cygw32.c138
-rw-r--r--src/cygw32.h (renamed from src/m/m68k.h)33
-rw-r--r--src/data.c634
-rw-r--r--src/dbusbind.c1914
-rw-r--r--src/deps.mk2
-rw-r--r--src/dired.c356
-rw-r--r--src/dispextern.h308
-rw-r--r--src/dispnew.c1069
-rw-r--r--src/disptab.h2
-rw-r--r--src/doc.c174
-rw-r--r--src/doprnt.c72
-rw-r--r--src/dosfns.c72
-rw-r--r--src/dosfns.h2
-rw-r--r--src/editfns.c1039
-rw-r--r--src/emacs-icon.h2
-rw-r--r--src/emacs.c600
-rw-r--r--src/emacsgtkfixed.c41
-rw-r--r--src/emacsgtkfixed.h28
-rw-r--r--src/epaths.in39
-rw-r--r--src/eval.c933
-rw-r--r--src/fileio.c1216
-rw-r--r--src/filelock.c100
-rw-r--r--src/firstfile.c7
-rw-r--r--src/floatfns.c669
-rw-r--r--src/fns.c853
-rw-r--r--src/font.c512
-rw-r--r--src/font.h95
-rw-r--r--src/fontset.c275
-rw-r--r--src/fontset.h3
-rw-r--r--src/frame.c1015
-rw-r--r--src/frame.h258
-rw-r--r--src/fringe.c90
-rw-r--r--src/ftfont.c71
-rw-r--r--src/ftxfont.c43
-rw-r--r--src/getpagesize.h2
-rw-r--r--src/gmalloc.c620
-rw-r--r--src/gnutls.c152
-rw-r--r--src/gnutls.h15
-rw-r--r--src/gtkutil.c630
-rw-r--r--src/gtkutil.h50
-rw-r--r--src/image.c1498
-rw-r--r--src/indent.c339
-rw-r--r--src/indent.h52
-rw-r--r--src/insdel.c474
-rw-r--r--src/intervals.c801
-rw-r--r--src/intervals.h242
-rw-r--r--src/keyboard.c2165
-rw-r--r--src/keyboard.h134
-rw-r--r--src/keymap.c345
-rw-r--r--src/keymap.h25
-rw-r--r--src/lastfile.c2
-rw-r--r--src/lisp.h2793
-rw-r--r--src/lisp.mk55
-rw-r--r--src/lread.c1156
-rw-r--r--src/m/README7
-rw-r--r--src/m/alpha.h53
-rw-r--r--src/m/amdx86-64.h35
-rw-r--r--src/m/ia64.h42
-rw-r--r--src/m/ibmrs6000.h46
-rw-r--r--src/m/ibms390x.h32
-rw-r--r--src/m/intel386.h29
-rw-r--r--src/m/template.h34
-rw-r--r--src/m/vax.h23
-rw-r--r--src/macros.c55
-rw-r--r--src/macros.h2
-rw-r--r--src/makefile.w32-in394
-rw-r--r--src/marker.c614
-rw-r--r--src/mem-limits.h10
-rw-r--r--src/menu.c230
-rw-r--r--src/menu.h12
-rw-r--r--src/minibuf.c204
-rw-r--r--src/msdos.c160
-rw-r--r--src/msdos.h2
-rw-r--r--src/ns.mk39
-rw-r--r--src/nsfns.m295
-rw-r--r--src/nsfont.m219
-rw-r--r--src/nsgui.h4
-rw-r--r--src/nsimage.m27
-rw-r--r--src/nsmenu.m336
-rw-r--r--src/nsselect.m138
-rw-r--r--src/nsterm.h130
-rw-r--r--src/nsterm.m2188
-rw-r--r--src/print.c460
-rw-r--r--src/process.c1921
-rw-r--r--src/process.h72
-rw-r--r--src/profiler.c607
-rw-r--r--src/puresize.h16
-rw-r--r--src/ralloc.c234
-rw-r--r--src/regex.c239
-rw-r--r--src/regex.h93
-rw-r--r--src/region-cache.c42
-rw-r--r--src/region-cache.h2
-rw-r--r--src/s/README8
-rw-r--r--src/s/aix4-2.h77
-rw-r--r--src/s/bsd-common.h72
-rw-r--r--src/s/cygwin.h101
-rw-r--r--src/s/darwin.h150
-rw-r--r--src/s/freebsd.h63
-rw-r--r--src/s/gnu-kfreebsd.h9
-rw-r--r--src/s/gnu-linux.h161
-rw-r--r--src/s/gnu.h48
-rw-r--r--src/s/hpux10-20.h107
-rw-r--r--src/s/hpux11.h9
-rw-r--r--src/s/irix6-5.h105
-rw-r--r--src/s/msdos.h140
-rw-r--r--src/s/netbsd.h43
-rw-r--r--src/s/openbsd.h9
-rw-r--r--src/s/sol2-10.h10
-rw-r--r--src/s/sol2-6.h62
-rw-r--r--src/s/template.h113
-rw-r--r--src/s/unixware.h52
-rw-r--r--src/s/usg5-4-common.h98
-rw-r--r--src/scroll.c42
-rw-r--r--src/search.c553
-rw-r--r--src/sheap.c5
-rw-r--r--src/sound.c126
-rw-r--r--src/stamp-h.in1
-rw-r--r--src/syntax.c289
-rw-r--r--src/syntax.h18
-rw-r--r--src/sysdep.c1611
-rw-r--r--src/sysselect.h13
-rw-r--r--src/syssignal.h125
-rw-r--r--src/systime.h259
-rw-r--r--src/systty.h41
-rw-r--r--src/syswait.h10
-rw-r--r--src/term.c351
-rw-r--r--src/termcap.c21
-rw-r--r--src/termchar.h6
-rw-r--r--src/termhooks.h75
-rw-r--r--src/terminal.c42
-rw-r--r--src/terminfo.c5
-rw-r--r--src/termopts.h13
-rw-r--r--src/textprop.c228
-rw-r--r--src/tparam.c10
-rw-r--r--src/tparam.h2
-rw-r--r--src/undo.c108
-rw-r--r--src/unexaix.c31
-rw-r--r--src/unexcoff.c5
-rw-r--r--src/unexcw.c4
-rw-r--r--src/unexelf.c20
-rw-r--r--src/unexmacosx.c91
-rw-r--r--src/unexsol.c2
-rw-r--r--src/unexw32.c53
-rw-r--r--src/vm-limit.c21
-rw-r--r--src/w16select.c36
-rw-r--r--src/w32.c1598
-rw-r--r--src/w32.h51
-rw-r--r--src/w32common.h53
-rw-r--r--src/w32console.c148
-rw-r--r--src/w32fns.c1465
-rw-r--r--src/w32font.c66
-rw-r--r--src/w32font.h10
-rw-r--r--src/w32gui.h7
-rw-r--r--src/w32heap.c134
-rw-r--r--src/w32heap.h34
-rw-r--r--src/w32inevt.c338
-rw-r--r--src/w32inevt.h9
-rw-r--r--src/w32menu.c152
-rw-r--r--src/w32proc.c933
-rw-r--r--src/w32reg.c9
-rw-r--r--src/w32select.c54
-rw-r--r--src/w32select.h (renamed from src/m/macppc.h)16
-rw-r--r--src/w32term.c580
-rw-r--r--src/w32term.h134
-rw-r--r--src/w32uniscribe.c78
-rw-r--r--src/w32xfns.c173
-rw-r--r--src/widget.c63
-rw-r--r--src/widget.h2
-rw-r--r--src/widgetprv.h2
-rw-r--r--src/window.c1993
-rw-r--r--src/window.h410
-rw-r--r--src/xdisp.c3243
-rw-r--r--src/xfaces.c993
-rw-r--r--src/xfns.c582
-rw-r--r--src/xfont.c102
-rw-r--r--src/xftfont.c97
-rw-r--r--src/xgselect.c90
-rw-r--r--src/xgselect.h8
-rw-r--r--src/xmenu.c303
-rw-r--r--src/xml.c140
-rw-r--r--src/xrdb.c134
-rw-r--r--src/xselect.c324
-rw-r--r--src/xsettings.c25
-rw-r--r--src/xsettings.h4
-rw-r--r--src/xsmfns.c6
-rw-r--r--src/xterm.c1003
-rw-r--r--src/xterm.h80
-rw-r--r--test/ChangeLog224
-rw-r--r--test/automated/Makefile.in6
-rw-r--r--test/automated/advice-tests.el116
-rw-r--r--test/automated/bytecomp-tests.el2
-rw-r--r--test/automated/comint-testsuite.el2
-rw-r--r--test/automated/compile-tests.el8
-rw-r--r--test/automated/ert-tests.el134
-rw-r--r--test/automated/ert-x-tests.el198
-rw-r--r--test/automated/f90.el2
-rw-r--r--test/automated/files.el149
-rw-r--r--test/automated/font-parse-tests.el2
-rw-r--r--test/automated/gnus-tests.el2
-rw-r--r--test/automated/icalendar-tests.el216
-rw-r--r--test/automated/lexbind-tests.el2
-rw-r--r--test/automated/newsticker-tests.el2
-rw-r--r--test/automated/occur-tests.el51
-rw-r--r--test/automated/ruby-mode-tests.el365
-rw-r--r--test/automated/url-future-tests.el57
-rw-r--r--test/automated/url-util-tests.el51
-rw-r--r--test/automated/vc-bzr.el29
-rw-r--r--test/automated/xml-parse-tests.el135
-rw-r--r--test/cedet/cedet-utests.el2
-rw-r--r--test/cedet/ede-tests.el2
-rw-r--r--test/cedet/semantic-ia-utest.el2
-rw-r--r--test/cedet/semantic-tests.el2
-rw-r--r--test/cedet/semantic-utest-c.el2
-rw-r--r--test/cedet/semantic-utest.el2
-rw-r--r--test/cedet/srecode-tests.el2
-rw-r--r--test/cedet/tests/test.c2
-rw-r--r--test/cedet/tests/test.el2
-rw-r--r--test/cedet/tests/test.make2
-rw-r--r--test/cedet/tests/testdoublens.cpp2
-rw-r--r--test/cedet/tests/testdoublens.hpp2
-rw-r--r--test/cedet/tests/testjavacomp.java2
-rw-r--r--test/cedet/tests/testpolymorph.cpp2
-rw-r--r--test/cedet/tests/testspp.c2
-rw-r--r--test/cedet/tests/testsppreplace.c2
-rw-r--r--test/cedet/tests/testsppreplaced.c2
-rw-r--r--test/cedet/tests/testsubclass.cpp2
-rw-r--r--test/cedet/tests/testsubclass.hh2
-rw-r--r--test/cedet/tests/testtypedefs.cpp2
-rw-r--r--test/cedet/tests/testvarnames.c9
-rw-r--r--test/eshell.el8
-rw-r--r--test/indent/latex-mode.tex11
-rwxr-xr-xtest/indent/perl.perl5
-rw-r--r--test/indent/ruby.rb27
-rwxr-xr-xtest/indent/shell.rc9
-rwxr-xr-xtest/indent/shell.sh26
-rw-r--r--test/redisplay-testsuite.el99
-rw-r--r--test/rmailmm.el2
-rw-r--r--vpath.sed8
2522 files changed, 239088 insertions, 136678 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index 4da890f92ab..5bee88267c8 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -2,10 +2,12 @@
(sentence-end-double-space . t)
(fill-column . 70)))
(c-mode . ((c-file-style . "GNU")))
+ (objc-mode . ((c-file-style . "GNU")))
;; You must set bugtracker_debbugs_url in your bazaar.conf for this to work.
;; See admin/notes/bugtracker.
(log-edit-mode . ((log-edit-rewrite-fixes
- "[ \n](bug#\\([0-9]+\\))" . "debbugs:\\1")))
+ "[ \n](bug#\\([0-9]+\\))" . "debbugs:\\1")
+ (log-edit-font-lock-gnu-style . t)))
(change-log-mode . ((add-log-time-zone-rule . t)
(fill-column . 74)
(bug-reference-url-format . "http://debbugs.gnu.org/%s")
diff --git a/BUGS b/BUGS
index 552be81a0f9..30bf10ed94f 100644
--- a/BUGS
+++ b/BUGS
@@ -4,10 +4,13 @@ Bugs section of the Emacs manual for advice on
(1) how to tell when to report a bug, and
(2) how to write a useful bug report and what information it needs to have.
-You can read the read the Bugs section of the manual from inside Emacs.
-Start Emacs, do C-h i to enter Info, then m Emacs RET to get to the
-Emacs manual, then m Bugs RET to get to the section on bugs.
-Or you can use the standalone Info program in a like manner.
+You can read the Bugs section of the manual from inside Emacs.
+Start Emacs, and press
+ C-h r (to view the Emacs manual)
+ m Bugs RET (to go to the section on Bugs)
+Or you can use the standalone Info program:
+ info emacs
+ m Bugs RET
(Standalone Info is part of the Texinfo distribution, not part of the
Emacs distribution.)
@@ -16,7 +19,7 @@ Software Foundation's online store at <http://shop.fsf.org/>.
If necessary, you can read the manual without an info program:
- cat info/emacs* | more "+/^File: emacs, Node: Bugs,"
+ cat info/emacs* | more "+/^File: emacs.*, Node: Bugs,"
Please first check the file etc/PROBLEMS (e.g. with C-h C-p in Emacs) to
diff --git a/ChangeLog b/ChangeLog
index 605ef32b598..bddec07fc19 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,1634 @@
+2012-11-24 Ken Brown <kbrown@cornell.edu>
+
+ * configure.ac (HAVE_MOUSE): Remove.
+
+2012-11-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958).
+ * configure.ac: Do not check for dirent.h or closdir.
+
+2012-11-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945).
+ * configure.ac: Do not check for getcwd or getwd.
+
+2012-11-21 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (--enable-profiling): Doc fix.
+
+2012-11-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve static checking of integer overflow and stack smashing.
+ * configure.ac (WARN_CFLAGS): Add -Wstack-protector
+ if using GCC 4.7.2 or later on a platform with
+ at least 64-bit long int. This improves static checking on these
+ platforms, when configured with --enable-gcc-warnings.
+
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881).
+ * configure.ac: Do not check for fcntl.h.
+ * lib/gnulib.mk: Regenerate.
+
+2012-11-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove no-longer-used pty_max_bytes variable.
+ * configure.ac (fpathconf): Remove unnecessary check.
+
+2012-11-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use faccessat, not access, when checking file permissions (Bug#12632).
+ * .bzrignore: Add lib/fcntl.h.
+ * configure.ac (euidaccess): Remove check; gnulib does this for us now.
+ (gl_FCNTL_O_FLAGS): Define a dummy version.
+ * lib/at-func.c, lib/euidaccess.c, lib/faccessat.c, lib/fcntl.in.h:
+ * lib/getgroups.c, lib/group-member.c, lib/root-uid.h:
+ * lib/xalloc-oversized.h, m4/euidaccess.m4, m4/faccessat.m4:
+ * m4/fcntl_h.m4, m4/getgroups.m4, m4/group-member.m4:
+ New files, from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+
+2012-11-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume at least POSIX.1-1988 for getpgrp, setpgid, setsid (Bug#12800).
+ * configure.ac (setpgid, setsid): Assume their existence.
+ (AC_FUNC_GETPGRP, SETPGRP_RELEASES_CTTY): Remove; obsolete.
+
+ Simplify by assuming __fpending.
+ Now that Emacs is using the gnulib fpending module,
+ there's no need for Emacs to have a separate implementation.
+ * configure.ac (stdio_ext.h, __fpending): Remove now-duplicate checks.
+ (PENDING_OUTPUT_COUNT, DISPNEW_NEEDS_STDIO_EXT): Remove.
+
+2012-11-03 Eli Zaretskii <eliz@gnu.org>
+
+ * lib/makefile.w32-in (GNULIBOBJS): Add $(BLD)/fpending.$(O) and
+ $(BLD)/close-stream.$(O).
+ ($(BLD)/close-stream.$(O)):
+ ($(BLD)/fpending.$(O)): New dependencies.
+
+2012-11-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix data-loss with --batch (Bug#9574).
+ * lib/close-stream.c, lib/close-stream.h, lib/fpending.c
+ * lib/fpending.h, m4/close-stream.m4, m4/fpending.m4:
+ New files, from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+
+2012-11-03 Eli Zaretskii <eliz@gnu.org>
+
+ * config.bat: Copy lib/execinfo.in.h to lib/execinfo.in-h if needed.
+
+2012-11-02 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (EMACS_ICON): New variable.
+ (install-etc): Use EMACS_ICON to allow choice of icon.
+
+2012-10-26 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (EMACS_NAME): New variable.
+ (EMACS, install-etc, uninstall): Use $EMACS_NAME.
+
+ * Makefile.in (EMACS, EMACSFULL): Transformations should not be
+ applied to $EXEEXT.
+
+ * Makefile.in (uninstall): Don't abort if some directories are missing.
+ Apply transformation rules to manual pages, desktop and icon files.
+ No more emacs22 icons to uninstall.
+
+2012-10-24 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-etc, install-man):
+ Don't apply program transform to standard file suffixes.
+
+2012-10-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac (_FORTIFY_SOURCE): Do not multiply define (Bug#12714).
+ This ports to Gentoo. Problem originally reported against coreutils,
+ but Emacs has it too.
+
+2012-10-23 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (emacs_transform): Remove.
+ (install-man): Revert 2012-10-21 change. (Bug#12713)
+
+2012-10-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-etc): Don't install emacs22 icons.
+
+ * Makefile.in (emacs_transform): New variable.
+ (install-etc): Prefer a make variable to a shell variable.
+
+2012-10-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * Makefile.in ($(MAKEFILE_NAME)): Depend on src/lisp.mk as well.
+
+2012-10-15 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-man, install-etc):
+ Apply $TRANSFORM. (Bug#12536#34)
+ (clean): Delete etc/emacs.tmpdesktop.
+
+2012-10-11 Kenichi Handa <handa@gnu.org>
+
+ * .bzrignore: Add several files under admin/charsets.
+
+2012-10-08 Daniel Colascione <dancol@dancol.org>
+
+ * configure.ac: Add --with-w32 as a window system option.
+ Limit it to Cygwin for now. Integrate w32 into the refactored window
+ system configuration and set TERM_HEADER to w32term.h when w32 is
+ configured.
+
+ (CYGWIN_OBJ): Add cygw32.o.
+
+2012-10-07 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.ac: Check that OSX is 10.4 or newer.
+
+2012-10-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve sys_siglist detection.
+ * configure.ac (sys_siglist): Look for its decl in <signal.h>.
+ Otherwise, it's not found in either Fedora 17 or Solaris 11.
+
+2012-10-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-10-02 pselect: reject invalid file descriptors
+ 2012-10-02 ptsname: reject invalid file descriptors
+ 2012-10-02 manywarnings: cater to more gcc infelicities
+ 2012-09-30 sockets, sys_stat: restore AC_C_INLINE
+ * lib/pselect.c, lib/stdlib.in.h, m4/manywarnings.m4, m4/pselect.m4:
+ * m4/stdlib_h.m4, m4/sys_stat_h.m4: Update from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+
+2012-09-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-09-28 extern-inline: provide a -Wundef safe config.h
+
+2012-09-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Check more robustly for timer_settime.
+ This should fix an OS X build problem reported by Ivan Andrus in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00671.html>.
+ * configure.ac (gl_THREADLIB): Define to empty, since Emacs
+ does threads its own way.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+
+2012-09-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * Makefile.in (bootstrap): Set MAKEFILE_NAME when building Makefile,
+ to avoid problems with recursion when using GNU make.
+
+2012-09-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * Makefile.in (bootstrap): Simplify build procedure.
+ Suggested by Wolfgang Jenker in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00456.html>.
+
+ Merge from gnulib, incorporating:
+ 2012-09-22 sockets, sys_stat: remove AC_C_INLINE in MSVC-only cases
+
+2012-09-19 Tassilo Horn <tsdh@gnu.org>
+
+ * doc/emacs/misc.texi (DocView Slicing): Document new slice from
+ BoundingBox feature.
+
+2012-09-18 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.ac (HAVE_GTK): Mention if we use GTK2 or GTK3.
+
+2012-09-17 Andreas Schwab <schwab@linux-m68k.org>
+
+ * Makefile.in (bootstrap): Revert last change. Run config.status
+ after config.status --recheck, run configure from $(srcdir).
+ (config.status): Run configure from $(srcdir).
+
+2012-09-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * Makefile.in: Fix build error on FreeBSD.
+ ($(MAKEFILE_NAME)): Pass MAKE='$(MAKE)' to config.status's env.
+ Suggested by Wolfgang Jenker in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00430.html>.
+ (MAKE_CONFIG_STATUS): Remove. Remaining use expanded.
+ This undoes part of the 2012-09-10 patch.
+ (bootstrap): Run ./configure, rather than trying to run config.status
+ if it exists. That builds src/epaths.h more reliably.
+ Run autogen/copy_autogen if autogen.sh fails,
+ to create 'configure'; problem reported by Andreas Schwab in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00438.html>.
+ * autogen.sh: Exit with status 1 when failing due to missing tools,
+ reverting the 2012-09-10 change to this file.
+ * autogen/copy_autogen: Fail if one of the subsidiary actions fail.
+ Use 'cp -f' for the build-aux files, since the destinations are
+ typically read-only.
+
+ Remove no-longer-needed Solaris 2.4 vfork bug workaround.
+ * configure.ac (ac_cv_func_vfork_works): Default to 'no' on
+ Solaris 2.4, so that AC_FUNC_VFORK doesn't think vfork works.
+
+2012-09-17 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (copyright): New output variable.
+ (COPYRIGHT): New AC_DEFINE.
+
+2012-09-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove configure's --without-sync-input option (Bug#12450).
+ * configure.ac (SYNC_INPUT, BROKEN_SA_RESTART): Remove.
+
+2012-09-16 Glenn Morris <rgm@gnu.org>
+
+ Increase compartmentalization of Nextstep builds rules,
+ and store Emacs version number in fewer versioned files.
+ * configure.ac (ns_appsrc): Use relative names.
+ (ns_frag): Remove.
+ (Info-gnustep.plist, Emacs.desktop, Info.plist, InfoPlist.strings)
+ (nextstep/Makefile): Generate these nextstep files.
+ (SUBDIR_MAKEFILES): Add nextstep.
+ * Makefile.in (clean, distclean, bootstrap-clean): Add nextstep.
+ * make-dist (nextstep/templates): Add directory.
+ (nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj): Remove.
+ (nextstep/Cocoa/Emacs.base/Contents)
+ (nextstep, nextstep/GNUstep/Emacs.base/Resources): Update contents.
+
+2012-09-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port better to POSIX hosts lacking _setjmp (Bug#12446).
+ * configure.ac (HAVE__SETJMP, HAVE_SIGSETJMP): New symbols.
+ (_setjmp, _longjmp): Remove.
+
+2012-09-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac (--without-sync-input): Fix typo in usage message.
+
+ * configure.ac: Port to hosts lacking gtk.
+ (PKG_CHECK_MODULES): Capture pkg-config diagnostics
+ better, in particular, problems in invoking pkg-config itself.
+ This is useful on hosts that don't have pkg-config.
+ (GTK_MODULES): Do not exit 'configure' simply because gtk3
+ and gtk2 are both missing. Problem found on Solaris 8.
+
+2012-09-13 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.ac: Reorder Xaw3d messages.
+ Report Gtk+ 3 as GTK.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify SIGIO usage (Bug#12408).
+ * configure.ac (NO_TERMIO, BROKEN_FIONREAD, BROKEN_SIGAIO)
+ (BROKEN_SIGPOLL, BROKEN_SIGPTY): Remove.
+ (USABLE_FIONREAD, USABLE_SIGIO): New symbols. All uses of
+ 'defined SIGIO' replaced with 'defined USABLE_SIGIO', with no need
+ to #undef SIGIO now (which was error-prone). Likewise, all uses
+ of 'defined FIONREAD' replaced with 'defined USABLE_FIONREAD'.
+
+2012-09-12 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.ac: No --with-x-toolkit given: Try gtk3 toolkit first
+ and then gtk2 if not found.
+ --with-x-toolkit=gtk|yes: As above, but fail if gtk2 or gt3 not found.
+ --with-x-toolkit=gtk2: Only try gtk2, fail if not found.
+ --with-x-toolkit=gtk3: Only try gtk3, fail if not found.
+
+2012-09-11 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-dep, install-arch-indep, install-doc):
+ Be more explicit about dependencies, for parallel `make install'.
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify, document, and port floating-point (Bug#12381).
+ * configure.ac (logb, cbrt): Do not check for these functions,
+ as they are not being used.
+
+2012-09-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve robustness of 'make bootstrap' (Bug#12376).
+ Run autogen.sh after bootstrap-clean, to avoid bzr pull issues.
+ * INSTALL, README: Document autogen.sh.
+ * Makefile.in (Makefile): Mark it as precious, since it's updated
+ atomically.
+ (MAKE_CONFIG_STATUS): New macro.
+ (config.status, bootstrap): Use it. This causes 'make bootstrap'
+ to run config.status with the --recheck option, which is more
+ appropriate for a bootstrap.
+ (bootstrap): Run autogen.sh right after cleaning. Don't worry
+ about failures due to missing tools.
+ * autogen.sh: Exit with status 101 when failing due to missing tools.
+ * make-dist: Distribute autogen.sh.
+
+2012-09-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume C89 or later for math functions (Bug#12381).
+ * configure.ac (frexp, fmod): Remove checks for these functions,
+ as we now assume them.
+ (FLOAT_CHECK_DOMAIN, HAVE_INVERSE_HYPERBOLIC, NO_MATHERR)
+ (HAVE_EXCEPTION):
+ Remove; no longer needed.
+
+2012-09-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ More signal-handler cleanup (Bug#12327).
+ * configure.ac (FLOAT_CHECK_DOMAIN): Comment fix (Bug#12327).
+
+2012-09-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Signal-handler cleanup (Bug#12327).
+ * configure.ac (PTY_OPEN, PTY_TTY_NAME_SPRINTF):
+ Adjust to syssignal.h changes.
+ (SIGNAL_H_AB): Remove; no longer needed.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify redefinition of 'abort' (Bug#12316).
+ * configure.ac (NO_ABRT): Remove.
+
+ * configure.ac (_setjmp, _longjmp): Check by compiling
+ instead of by guessing. The guesses were wrong for
+ recent versions of Solaris, such as Solaris 11.
+
+2012-09-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac (WARN_CFLAGS): Omit -Wjump-misses-init.
+ It generates false alarms in doc.c, regex.c, xdisp.c. See
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00040.html>.
+
+ Merge from gnulib, incorporating:
+ 2012-08-29 stdbool: be more compatible with mixed C/C++ compiles
+ 2011-11-30 manywarnings: update the list of "all" warnings
+
+2012-09-02 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.ac (HAVE_GOBJECT): Check for gobject-2.0 (Bug#12332).
+
+2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac (_FORTIFY_SOURCE): Define only when optimizing.
+ This ports to glibc 2.15 or later, when configured with
+ --enable-gcc-warnings. See Eric Blake in
+ <http://lists.gnu.org/archive/html/bug-grep/2012-09/msg00000.html>.
+
+2012-09-01 Daniel Colascione <dan.colascione@gmail.com>
+
+ * configure.ac: Introduce term_header variable, which holds the
+ value which will become TERM_HEADER in code. We effect our choice
+ of window system by setting term_header and WINDOW_SYSTEM_OBJ
+ instead of using ad-hoc variables and flags for each window
+ system.
+
+2012-08-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac (CFLAGS): Prefer -g3 to -g if -g3 works
+ and if the user has not specified CFLAGS. -g3 simplifies
+ debugging, since it makes macros visible to the debugger.
+
+2012-08-25 Juanma Barranquero <lekktu@gmail.com>
+
+ * lib/makefile.w32-in ($(BLD)/execinfo.$(O)): Update dependencies.
+
+2012-08-25 Eli Zaretskii <eliz@gnu.org>
+
+ * lib/makefile.w32-in ($(BLD)/execinfo.$(O), execinfo.h): New targets.
+ (GNULIBOBJS): Add $(BLD)/execinfo.$(O).
+
+2012-08-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ On assertion failure, print backtrace if available.
+ Merge from gnulib, incorporating:
+ 2012-08-24 execinfo: port to FreeBSD
+ 2012-08-22 execinfo: new module
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+ * lib/execinfo.c, lib/execinfo.in.h, m4/execinfo.m4: New files.
+
+2012-08-22 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-dep): If NO_BIN_LINK is non-null,
+ do not create the bin/emacs link. (Bug#12011)
+
+2012-08-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-08-20 extern-inline: support old GCC 'inline'
+
+2012-08-20 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (AC_PROG_LN_S): Test for ln.
+ * Makefile.in (LN_S): New, set by configure.
+ (install-arch-dep): Use $LN_S.
+
+2012-08-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-08-19 ignore-value, stat-time, timespec: omit AC_C_INLINE
+ 2012-08-19 mktime, sys_select: avoid 'static inline'
+ 2012-08-19 gnulib-tool: Fix indentation.
+
+2012-08-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lib/sigprocmask.c, m4/signalblocking.m4: Remove.
+ These files have been unused since the 2012-06-22 patch that
+ introduced high-resolution time stamps.
+
+2012-08-17 Jan Beich <jbeich@tormail.org> (tiny change)
+
+ * configure.ac (PTY_OPEN): Try posix_openpt on gnu-linux,
+ gnu-kfreebsd, freebsd, and netbsd. (Bug#12040)
+
+2012-08-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-08-05 extern-inline: also ignore -Wmissing-declarations
+
+2012-08-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * lib/makefile.w32-in (STAT_TIME_H): New macro.
+ (FTOASTR_C, $(BLD)/stat-time.$(O), $(BLD)/timespec.$(O))
+ ($(BLD)/u64.$(O)): Update dependencies.
+
+2012-08-10 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (DIRECTORY_SEP): Move here from src/lisp.h.
+
+2012-08-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.ac (--disable-features): Rename to --without-all.
+ (OPTION_DEFAULT_ON): Change to use with_features.
+ * INSTALL: Fix description.
+
+2012-08-07 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.ac: New option --disable-features.
+ (OPTION_DEFAULT_ON): Change to use enable_features.
+ * INSTALL: Explain --disable-features.
+
+2012-08-07 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac: Require automake 1.11 (fairly arbitrarily).
+ * autogen.sh (automake_min): Get it from configure.ac.
+
+2012-08-06 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (BROKEN_GETWD) [unixware]: New define.
+
+ * configure.ac (GNU_LIBRARY_PENDING_OUTPUT_COUNT): Remove.
+ (PENDING_OUTPUT_COUNT): Absorb GNU_LIBRARY_PENDING_OUTPUT_COUNT.
+ (DISPNEW_NEEDS_STDIO_EXT): New define.
+
+2012-08-05 Michael Albinus <michael.albinus@gmx.de>
+
+ * INSTALL: Explain how to completely disable D-Bus. (Bug#12112)
+
+2012-08-05 Ulrich Müller <ulm@gentoo.org>
+
+ * configure.ac: Disable paxctl if binaries don't have a
+ PT_PAX_FLAGS program header. (Bug#11979)
+
+2012-08-03 Eli Zaretskii <eliz@gnu.org>
+
+ * lib/makefile.w32-in (GNULIBOBJS): Add $(BLD)/stat-time.$(O),
+ $(BLD)/timespec.$(O), and $(BLD)/u64.$(O).
+ (SHA512_H): Don't mention u64.h twice.
+ ($(BLD)/stat-time.$(O), ($(BLD)/timespec.$(O), ($(BLD)/u64.$(O)):
+ New targets.
+
+2012-08-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-08-02 stat-time, timespec, u64: support naive out-of-dir builds
+
+2012-08-02 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * lib/Makefile.am (DEFAULT_INCLUDES): Add -I$(top_srcdir)/lib for
+ out-of-tree build.
+
+2012-08-02 Glenn Morris <rgm@gnu.org>
+
+ * make-dist: Remove src/s.
+
+ * lib/makefile.w32-in (MS_W32_H): Update for new ms-w32.h location.
+
+2012-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib (Bug#12116), incorporating:
+ 2012-08-01 extern-inline: new module
+ 2012-08-01 stat-time, timespec, u64, utimens: use extern-inline
+ * lib/stat-time.c, lib/timespec.c, lib/u64.c, m4/extern-inline.m4:
+ New files. The new .c files are for instantiating extern inline
+ functions.
+
+ Port to Solaris 8.
+ Without this change, 'configure' fails because the recently-added
+ wait3 prototype in config.h messes up later 'configure' tests.
+ Fix this problem by droping wait3 and WRETCODE, as they're
+ no longer needed on hosts that are current porting targets.
+ * configure.ac (wait3, WRETCODE): Remove, fixing a FIXME.
+ All uses changed to waitpid and WEXITSTATUS.
+
+ Avoid needless autoheader after autogen.sh.
+ * src/stamp-h.in: Remove from bzr repository; no longer needed there.
+ * .bzrignore: Add it.
+ * autogen.sh: Create it.
+
+2012-08-01 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (DOS_NT, MSDOS): New system type templates.
+
+2012-08-01 Ulrich Müller <ulm@gentoo.org>
+
+ * configure.ac (LIB_STANDARD, START_FILES) [FreeBSD]:
+ Don't include crtbegin.o and crtend.o. (Bug#12047)
+
+2012-08-01 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (FLOAT_CHECK_DOMAIN, HAVE_INVERSE_HYPERBOLIC)
+ (INTERNAL_TERMINAL): New.
+
+ * configure.ac (DEVICE_SEP, IS_DEVICE_SEP, IS_DIRECTORY_SEP)
+ (IS_ANY_SEP): Move here from src/lisp.h.
+
+2012-08-01 Juanma Barranquero <lekktu@gmail.com>
+
+ * lib/makefile.w32-in (CONFIG_H): Update dependencies.
+ (CONF_POST_H): New macro.
+
+2012-07-31 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (S_FILE): Remove output variable.
+
+ * configure.ac (opsysfile): Use AH_TEMPLATE. Doc fix.
+
+ * configure.ac (NULL_DEVICE, SEPCHAR, USER_FULL_NAME):
+ Move here from src.
+
+ * configure.ac (AMPERSAND_FULL_NAME, subprocesses):
+ Move here from conf_post.h.
+
+2012-07-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Improve OpenMotif detection on GNU/Linux systems.
+ * configure.ac (MOTIF): Check for /usr/include/openmotif
+ and /usr/(lib|lib64)/openmotif if --with-x-toolkit=motif.
+
+2012-07-31 Andreas Schwab <schwab@linux-m68k.org>
+
+ * Makefile.in (install-arch-indep): Avoid eval.
+
+2012-07-31 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (opsysfile, S_FILE): Now they are always empty.
+
+ * configure.ac (opsysfile): Forgot to set it to empty on sol2-10
+ when removing src/s/sol2-6.h yesterday.
+
+ * configure.ac (USG5_4): Reintroduce this.
+ (opsysfile): Set to empty on irix6-5, sol2*, and unixware.
+
+ * configure.ac (wait3, WRETCODE): Move here from src/s/usg5-4-common.h.
+
+ * configure.ac (opsysfile): Set to empty on hpux*, darwin;
+ and to s/usg5-4-common.h on irix6-5.
+
+2012-07-30 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (AH_BOTTOM): Use an include file, so that the
+ contents do not get processed by autoheader.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not overwrite config.status while executing it (Bug#11214).
+ * Makefile.in (MAKEFILE_NAME): New macro.
+ ($(MAKEFILE_NAME)): Rename rule from Makefile.
+ * configure.ac (epaths): Set MAKEFILE_NAME to a bogus value,
+ so that GNU 'make' isn't tempted to make the Makefile and then
+ regenerate config.status while config.status is running.
+
+ Update .PHONY listings in makefiles.
+ * Makefile.in (.PHONY): Add all, ${SUBDIR}, blessmail, epath-force,
+ FRC, install-arch-dep, install-arch-indep, install-doc,
+ install-info, install-man, install-etc, install-strip, uninstall,
+ bootstrap-clean, TAGS, tags, info-real, force-info, check-info-dir.
+ (.RECURSIVE): Remove; hasn't been needed for years.
+
+2012-07-30 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (SIGNAL_H_AHB): New hack macro.
+ (opsysfile): Set to empty on netbsd, openbsd.
+ (AH_BOTTOM): Include signal.h if SIGNAL_H_AHB is defined.
+
+ * configure.ac (_longjmp, _setjmp, TIOCSIGSEND): Move here from src/s.
+
+2012-07-30 Jan Djärv <jan.h.d@swipnet.se>
+
+ * Makefile.in (install-arch-indep): Remove sh -x.
+
+2012-07-30 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (opsysfile): Tweak message for null case.
+
+ * configure.ac (opsysfile): Set to empty on aix4-2, freebsd,
+ gnu-linux, gnu-kfreebsd; and to usg5-4-common.h on sol2*, unixware.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ * doc/misc/texinfo.tex: Update to 2012-07-29.17 version.
+
+2012-07-29 Jan Djärv <jan.h.d@swipnet.se>
+
+ * Makefile.in (install-arch-indep): Handle space in locallisppath.
+
+2012-07-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use Gnulib environ module (Bug#9772).
+ * m4/environ.m4: New file, from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+
+ Use Gnulib stdalign module (Bug#9772, Bug#9960).
+ This should improve portability of macros like alignof and DECL_ALIGN.
+ * lib/stdalign.in.h, m4/stdalign.m4: New files, from gnulib.
+ * .bzrignore: Add lib/stdalign.h.
+ * config.bat: Do not set NO_DECL_ALIGN; no longer needed.
+ Copy lib/stdalign.in.h to lib/stdalign.in-h as needed.
+ * configure.ac (HAVE_ATTRIBUTE_ALIGNED): Remove the code that
+ fiddles with this, as gnulib now does this for us.
+
+2012-07-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix toolkit configuration report.
+ * configure.ac (USE_X_TOOLKIT): Report toolkit as GTK3 if
+ --with-x-toolkit=gtk3 is used.
+
+2012-07-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix regression with pthread_sigmask on FreeBSD (Bug#11884).
+ * configure.ac: Configure gnulib at the end, not before running
+ pkg-config. This restores the behavior before 2012-06-22, when
+ higher-resolution time stamps were added, and fixes a bug whereby
+ LIB_PTHREAD was not used and gnulib's part of 'configure'
+ therefore incorrectly assumed that pthread_sigmask wasn't working.
+ Fix the problem with -lrt and clock_gettime a different way.
+ This should complete the fix for Bug#11884.
+ (pre_PKG_CONFIG_CFLAGS, pre_PKG_CONFIG_LIBS): New shell vars.
+
+2012-07-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-07-15 pthread_sigmask: fix bug on FreeBSD 9 (Bug#11884)
+ 2012-07-11 gettext: do not assume '#define ... defined ...' behavior
+
+2012-07-14 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (GC_SETJMP_WORKS, GC_MARK_STACK): Move here from src/s.
+ (AH_BOTTOM): Move GC_SETJMP_WORKS GCC fallback to main body.
+
+2012-07-13 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (opsysfile): Set to empty on gnu, cygwin.
+
+ * configure.ac (BSD4_2, BSD_SYSTEM, USG, USG5, _AIX, CYGWIN)
+ (DARWIN_OS, GNU_LINUX, HPUX, IRIX6_5, SOLARIS2):
+ Move "system type" macros here from src/s.
+ (BSD_SYSTEM_AHB): New hack macro.
+ (AH_BOTTOM): Set BSD_SYSTEM, using BSD_SYSTEM_AHB.
+
+ * configure.ac (NSIG_MINIMUM, ULIMIT_BREAK_VALUE, SETUP_SLAVE_PTY)
+ (GC_MARK_SECONDARY_STACK): Move here from src/s.
+
+2012-07-12 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (AH_BOTTOM) [DARWIN_OS]: Move SYSTEM_PURESIZE_EXTRA
+ setting here from src/s/darwin.h.
+
+ * configure.ac (NO_MATHERR): Unconditionally define for Darwin;
+ as src/s/darwin.h used to.
+
+ * configure.ac (NARROWPROTO, NO_ABORT, BROKEN_GET_CURRENT_DIR_NAME)
+ (BROKEN_FIONREAD, BROKEN_PTY_READ_AFTER_EAGAIN, BROKEN_SIGAIO)
+ (BROKEN_SIGPOLL, BROKEN_SIGPTY, FIRST_PTY_LETTER, NO_EDITRES)
+ (G_SLICE_ALWAYS_MALLOC, PREFER_VSUSP, PTY_ITERATION, PTY_OPEN)
+ (PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF, RUN_TIME_REMAP)
+ (SETPGRP_RELEASES_CTTY, TAB3, TABDLY, RUN_TIME_REMAP, UNIX98_PTYS)
+ (XOS_NEEDS_TIME_H): Move here from src/s.
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (INTERRUPT_INPUT): Move here from src/s.
+ (HAVE_PTYS, HAVE_SOCKETS): Define unconditionally.
+
+2012-07-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac (tzset): Remove check that's redundant with gnulib.
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (CLASH_DETECTION): Define unconditionally.
+
+ * configure.ac (opsysfile): Use bsd-common on gnu systems.
+
+ * configure.ac (GNU_LIBRARY_PENDING_OUTPUT_COUNT):
+ (SIGNALS_VIA_CHARACTERS): Move here from src/s.
+
+2012-07-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume mkdir, rename, rmdir, strerror.
+ * configure.ac (mkdir, rename, rmdir, strerror): Remove check.
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (DONT_REOPEN_PTY): Move here from src/s.
+
+ * configure.ac (DEFAULT_SOUND_DEVICE): New definition.
+
+2012-07-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove "#define unix" that is no longer needed (Bug#11905).
+ Merge from gnulib to make "#define unix" unnecessary, incorporating:
+ 2012-07-10 getloadavg: clean out old Emacs and Autoconf cruft
+ 2012-07-09 getopt: Simplify after Emacs changed.
+
+2012-07-10 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (DATA_START, DATA_SEG_BITS, PENDING_OUTPUT_COUNT):
+ Move here from src/s.
+
+2012-07-09 Andreas Schwab <schwab@linux-m68k.org>
+
+ * configure.ac (PNG_DEPSTRUCT): Define this instead of
+ PNG_DEPRECATED.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Add GCC-style 'const' attribute to functions that can use it.
+ * configure.ac (WARN_CFLAGS): Add -Wsuggest-attribute=const.
+ (ATTRIBUTE_CONST): New macro, in config.h.
+
+2012-07-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * lib/makefile.w32-in: Rework dependencies.
+ (GNU_LIB, NT_INC, C_CTYPE_H, MS_W32_H, CONFIG_H, FILEMODE_H)
+ (FTOASTR_H, FTOASTR_C, GETOPT_INT_H, MD5_H, SHA1_H, SHA256_H)
+ (U64_H, SHA512_H): New macros.
+ (SRC): Redefine to point to src/, not current directory.
+ ($(BLD)/c-ctype.$(O), $(BLD)/c-strcasecmp.$(O))
+ ($(BLD)/c-strncasecmp.$(O), $(BLD)/dtoastr.$(O))
+ ($(BLD)/dtotimespec.$(O), $(BLD)/getopt.$(O), $(BLD)/getopt1.$(O))
+ ($(BLD)/gettime.$(O), $(BLD)/strftime.$(O), $(BLD)/time_r.$(O))
+ ($(BLD)/timespec-add.$(O), $(BLD)/timespec-sub.$(O), $(BLD)/md5.$(O))
+ ($(BLD)/sha1.$(O), $(BLD)/sha256.$(O), $(BLD)/sha512.$(O))
+ ($(BLD)/filemode.$(O)): Update dependencies.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-07-09 timespec: mark functions with const attributes
+
+ Rename configure.in to configure.ac (Bug#11603).
+ The name 'configure.in' has been obsolescent for quite some time,
+ and the next release of Autoconf will generate warnings for it.
+ See commit 'v2.69-4-g560f16b' of 2012-05-06, "general: deprecate
+ 'configure.in' as autoconf input" in the Autoconf git repository.
+ * configure.ac: Rename from configure.in.
+ * INSTALL, INSTALL.BZR, README, make-dist:
+ * Makefile.in (AUTOCONF_INPUTS):
+ * autogen.sh (autoconf_min):
+ * autogen/update_autogen (sources):
+ Adjust to reflect new name.
+
+2012-07-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Restore deprecation warnings, except for older libpng.
+ * configure.in (WARN_CFLAGS): Remove -Wno-deprecated-declarations.
+ (HAVE_LIBPNG_PNG_H): Don't bother checking for this if we have png.h.
+ (PNG_DEPRECATED): Define when compiling with older PNG versions.
+
+2012-07-07 Andreas Schwab <schwab@linux-m68k.org>
+
+ * configure.in (WARN_CFLAGS): Add -Wno-deprecated-declarations.
+
+2012-07-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve static checking when configured --with-ns.
+ See Samuel Bronson's remarks in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00146.html>.
+ * configure.in (WARN_CFLAGS): Omit -Wunreachable-code, as it's
+ a no-op with recent GCC and harmful in earlier ones.
+ Omit -Wsync-nand, as it's irrelevant to Emacs and provokes a
+ warning when compiling with ObjC. Always omit
+ -Wunsafe-loop-optimizations, as we don't mind when optimization is
+ being done correctly.
+
+2012-07-07 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (BROKEN_SA_RESTART): Doc fix.
+
+ * configure.in: Rather than checking for things then undef'ing
+ them on some platforms, simply don't check for them.
+ (getwd): Don't check for it on unixware.
+ (random, rint): Don't check for these on hpux.
+ (res_init, libresolv): Don't check for these on darwin.
+
+2012-07-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * lib/makefile.w32-in (GNULIBOBJS): Add $(BLD)/c-ctype.$(O),
+ $(BLD)/c-strcasecmp.$(O) and $(BLD)/c-strncasecmp.$(O).
+ ($(BLD)/c-ctype.$(O), $(BLD)/c-strcasecmp.$(O))
+ ($(BLD)/c-strncasecmp.$(O)): New dependencies.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.in: Document --enable-gcc-warnings better.
+
+ Use c_strcasecmp for ASCII case-insensitive comparison (Bug#11786).
+ This is safer than strcasecmp, which has unspecified behavior
+ outside the POSIX locale and in practice sometimes does not work
+ in multibyte locales. Similarly for c_strncasecmp and strncasecmp.
+ * configure.in (strcasecmp, strncasecmp): Remove checks.
+
+ * lib/c-ctype.c, lib/c-ctype.h, lib/c-strcase.h, lib/c-strcasecmp.c:
+ * lib/c-strncasecmp.c: New files, taken from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+
+ Merge from gnulib, incorporating:
+ 2012-07-06 timespec-sub: avoid duplicate include
+ Reported by Juanma Barranquero.
+
+2012-07-06 Glenn Morris <rgm@gnu.org>
+
+ * make-dist [update]: Let autoreconf figure out what needs updating.
+ Use `make info-real'. leim/leim-list.el should always exist.
+ Check cd return value.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib. This is for OpenBSD 5.1 amd64.
+ * m4/sys_time_h.m4: New version from gnulib, incorporating:
+ 2012-07-05 sys_time: allow too-wide tv_sec
+
+2012-07-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib.
+ * lib/alloca.in.h: New version from gnulib, incorporating:
+ 2012-07-03 alloca: add support for HP NonStop TNS/E native
+
+2012-07-04 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.in: If --enable-gcc-warnings, disable
+ -Wunsafe-loop-optimizations for -O1 optimization level.
+
+2012-06-30 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (standardlisppath): New output variable.
+ (lisppath): Use standardlisppath.
+ * Makefile.in (standardlisppath): New, set by configure.
+ (epaths-force): Use standardlisppath and locallisppath rather than
+ lisppath.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.in: Fix previous change. Remove --enable-asserts.
+ (CPPFLAGS): Remove conditional -DXASSERTS=1.
+ Add --enable-link-time-optimization.
+ * INSTALL: Mention this.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.in: Add glyphs category to --enable-checking option.
+ (GLYPH_DEBUG): Define if glyphs debugging is enabled.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.in (ENABLE_CHECKING): Update comment.
+
+2012-06-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.in: Don't check for sys/select.h, sys/time.h, utime.h.
+ Emacs proper no longer uses these headers, and can rely on Gnulib
+ for these checks.
+
+ Merge from gnulib.
+ * m4/getopt.m4: Copy new version from gnulib, incorporating:
+ getopt-posix: No longer guarantee that option processing is resettable.
+
+2012-06-27 Glenn Morris <rgm@gnu.org>
+
+ * configure.in: Only check for paxctl on gnu-linux. (Bug#11398#26)
+
+ * INSTALL: Remove references to paths.el.
+
+2012-06-26 Eli Zaretskii <eliz@gnu.org>
+
+ * lib/makefile.w32-in ($(GNULIBOBJS)): Depend on stamp_BLD.
+ This replaces separate dependency for each object file, which required
+ the same object file to be mentioned twice, causing failures in
+ parallel builds.
+
+2012-06-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clean out last vestiges of the old HAVE_CONFIG_H stuff.
+ * lib/makefile.w32-in (LOCAL_FLAGS): Remove -DHAVE_CONFIG_H.
+
+2012-06-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.in (AC_CHECK_FUNCS): Detect library functions
+ strcasecmp and strncasecmp.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Switch from NO_RETURN to C11's _Noreturn (Bug#11750).
+ We might as well use the spelling standardized by C11,
+ as in the long run that should simplify maintenance.
+ * configure.in (NO_RETURN): Remove. All uses replaced by _Noreturn.
+
+2012-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ * lib/makefile.w32-in ($(BLD)/dtotimespec.$(O)):
+ ($(BLD)/timespec-add.$(O)):
+ ($(BLD)/timespec-sub.$(O)): Don't depend on
+ $(EMACS_ROOT)/nt/inc/sys/time.h.
+
+ * lib/stat-time.h:
+ * lib/timespec.h:
+ * lib/utimens.h: Revert last change.
+
+2012-06-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib.
+ * m4/getopt.m4: Copy new version from gnulib, incorporating:
+ getopt-gnu: Handle suboptimal getopt_long's abbreviation handling.
+
+2012-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the MS-Windows build broken by 2012-06-22T21:17:42Z!eggert@cs.ucla.edu.
+ * lib/makefile.w32-in (GNULIBOBJS): Add $(BLD)/dtotimespec.$(O),
+ $(BLD)/gettime.$(O), $(BLD)/timespec-add.$(O), and
+ $(BLD)/timespec-sub.$(O).
+ ($(BLD)/dtotimespec.$(O)):
+ ($(BLD)/gettime.$(O)):
+ ($(BLD)/timespec-add.$(O)):
+ ($(BLD)/timespec-sub.$(O)): New dependencies.
+
+ * lib/stat-time.h:
+ * lib/timespec.h:
+ * lib/utimens.h: Include sys/time.h.
+
+2012-06-23 Andreas Schwab <schwab@linux-m68k.org>
+
+ * configure.in: Don't use AC_CHECK_FUNCS_ONCE, which doesn't use
+ the correct CFLAGS and LIBS.
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+ * configure.in (gl_ASSERT_NO_GNULIB_POSIXCHECK)
+ (gl_ASSERT_NO_GNULIB_TESTS, gl_INIT): Move these up earlier, so
+ that the new clock stuff doesn't clash with RSVG_LIBS.
+ (AC_CHECK_HEADERS): Don't check for sys/select.h, sys/time.h, utime.h,
+ as gnulib does that for us now.
+ (emacs_cv_struct_utimbuf, HAVE_STRUCT_UTIMBUF, HAVE_TIMEVAL)
+ (GETTIMEOFDAY_ONE_ARGUMENT): Remove; gnulib does these now.
+ (AC_CHECK_FUNCS): Remove utimes; no longer needed.
+ * lib/dtotimespec.c, lib/gettime.c, lib/gettimeofday.c, lib/pselect.c:
+ * lib/stat-time.h, lib/sys_select.in.h, lib/sys_time.in.h:
+ * lib/timespec-add.c, lib/timespec-sub.c, lib/timespec.h:
+ * lib/utimens.c, lib/utimens.h, m4/clock_time.m4, m4/gettime.m4:
+ * m4/gettimeofday.m4, m4/pselect.m4, m4/stat-time.m4:
+ * m4/sys_select_h.m4, m4/sys_socket_h.m4, m4/sys_time_h.m4:
+ * m4/timespec.m4, m4/utimbuf.m4, m4/utimens.m4, m4/utimes.m4:
+ New files, copied automatically from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Merge from gnulib.
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib.
+ * lib/filemode.h, lib/signal.in.h, lib/stat.c, lib/stdint.in.h:
+ * lib/stdlib.in.h, lib/unistd.in.h, m4/extensions.m4, m4/getloadavg.m4:
+ * m4/getopt.m4, m4/gnulib-common.m4, m4/largefile.m4, m4/mktime.m4:
+ * m4/multiarch.m4, m4/nocrash.m4, m4/stdio_h.m4, m4/time_r.m4:
+ Copy new versions from gnulib, incorporating the following changes:
+ 2012-06-22 time_r: fix typo that always overrode localtime_r decl
+ 2012-06-22 Write "Mac OS X" instead of "MacOS X".
+ 2012-06-21 mktime: fix integer overflow in 'configure'-time test
+ 2012-06-21 nonblocking: Avoid compilation error on mingw64.
+ 2012-06-19 stat, fstat: Avoid warnings on mingw64.
+ 2012-06-19 getopt-gnu: Fix exit code overflow in autoconf test.
+
+2012-06-13 Andreas Schwab <schwab@linux-m68k.org>
+
+ * configure.in: Rename --enable-use-lisp-union-type to
+ --enable-check-lisp-object-type and define CHECK_LISP_OBJECT_TYPE
+ instead of USE_LISP_UNION_TYPE.
+
+2012-06-12 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (HAVE_PROCFS, _STRUCTURED_PROC): New AC_DEFINEs.
+ (opsysfile): Set specially for sol2-10.
+
+ * configure.in (BROKEN_SA_RESTART, USG_SUBTTY_WORKS):
+ New AC_DEFINEs, for hpux11.
+ (opsysfile): Set specially for hpux11.
+
+2012-06-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.in: Coalesce some function checking.
+ This makes 'configure' a bit smaller.
+ Prefer AC_CHECK_FUNCS_ONCE for functions that we always check for.
+
+2012-06-12 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (opsysfile): Set specially for gnu-kfreebsd, openbsd.
+
+ * configure.in (NO_TERMIO, BROKEN_SIGIO): Move here from src/s.
+
+ * configure.in: Anticipate platforms with no src/s file.
+
+2012-06-12 Chong Yidong <cyd@gnu.org>
+
+ * configure.in: Check for MagickMergeImageLayers (Bug#11678).
+
+2012-06-11 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (SYSTEM_TYPE): New AC_DEFINE.
+
+2012-06-09 Michael Albinus <michael.albinus@gmx.de>
+
+ * configure.in (dbus_type_is_valid): Check for library function.
+
+2012-06-06 Glenn Morris <rgm@gnu.org>
+
+ * INSTALL, make-dist: Remove vcdiff.
+
+2012-06-03 Glenn Morris <rgm@gnu.org>
+
+ * INSTALL, make-dist: Remove rcs-checkin.
+
+2012-06-03 Ulrich Müller <ulm@gentoo.org>
+
+ * configure.in (PAXCTL): Check for paxctl. (Bug#11398)
+
+2012-06-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove --disable-maintainer-mode option from 'configure'. (Bug#11555)
+ It is confusingly named and rarely useful. See, for example,
+ <http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00089.html>.
+ * INSTALL.BZR: Don't mention --disable-maintainer-mode.
+ * Makefile.in (MAINTAINER_MODE_FLAG): Remove; all uses removed.
+ * configure.in: Remove --disable-maintainer-mode.
+ (USE_MAINTAINER_MODE, MAINT): Remove.
+
+2012-05-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Make 'configure' a bit smaller and faster.
+ * configure.in (INSTALL_INFO): Set it with one call to
+ AC_PATH_PROG, not three.
+ (PKG_CONFIG): Hoist this out of PKG_CHECK_MODULES, since it's
+ so likely that it'll be needed.
+ (AC_CHECK_HEADERS_ONCE): Prefer to AC_CHECK_HEADERS where either works.
+ (AC_PROG_MAKE_SET): Remove; Automake does this.
+ (sysinfo): Do not check for this function, as it's never used.
+ (tzset): Check for this function just once.
+ * m4/manywarnings.m4: Sync from gnulib, incorporating the following:
+ 2012-05-27 manywarnings: remove duplicate -Wmultichar entry
+
+2012-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ * config.bat (lib): Create/update lib/stdalign.in-h and
+ lib/sys_types.in-h.
+
+ * lib/makefile.w32-in ($(BLD)/md5.$(O)):
+ ($(BLD)/sha1.$(O)):
+ ($(BLD)/sha256.$(O)):
+ ($(BLD)/sha512.$(O)): Depend on $(EMACS_ROOT)/nt/inc/stdalign.h.
+ Suggested by Christoph Scholtes <cschol2112@googlemail.com>.
+
+ * lib/getopt_.h: Regenerate.
+
+2012-05-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume gnulib does largefile.
+ Gnulib does the largefile configuration anyway, so when configure.in
+ invokes AC_SYS_LARGEFILE, that bloats 'configure' unnecessarily.
+ * configure.in (AC_SYS_LARGEFILE): Remove.
+ * lib/gnulib.mk: Autoupdate.
+
+2012-05-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib. (Bug#11527)
+
+ The build procedure now creates <stdalign.h> and <sys/types.h> for
+ older hosts that lack a working <stdalign.h> or whose
+ <sys/types.h> does not define pid_t, size_t, ssize_t, mode_t.
+ New symbols such as WINDOWS_64_BIT_OFF_T may require attention in the
+ msdos and nt builds.
+
+ Here is a precis of gnulib changes that seem relevant; please see
+ the gnulib ChangeLog for details.
+
+ 2012-05-18 crypto: fix bug in large buffer handling
+ 2012-05-14 ignore-value.h: remove unused _GL_ATTRIBUTE_DEPRECATED
+ 2012-05-10 _Noreturn: port config.h to gcc -Wundef
+ 2012-05-08 warnings.m4: give a means to specify the program to compile
+ 2012-05-07 stdint: be more consistent with glibc, SunOS libc
+ 2012-04-21 Large File Support for native Windows platforms.
+ 2012-04-14 stat: Bypass buggy override in mingw64.
+ 2012-03-29 stdio: don't assume gets any more
+ 2012-03-24 Enable common subexpression optimization in GCC.
+ 2012-02-09 maint: replace FSF snail-mail addresses with URLs
+ 2012-01-30 sys_stat: Fix support for mingw64 and MSVC.
+ 2012-01-28 strtoimax: eliminate need for stdint.h, inttypes.h checks
+ 2012-01-21 stdint: Add support for Android.
+ 2012-01-15 Improve support for MSVC 9.
+ 2012-01-08 mktime: Avoid compilation error on Solaris 11.
+ 2012-01-05 Use ', not `, for quoting output.
+ 2012-01-05 strtoimax: Don't replace systems where intmax_t is int.
+ 2012-01-05 strtoimax: Work around AIX 5.1 bug.
+ 2012-01-05 inttypes: Modernize.
+ 2011-12-13 inttypes, stdint: add C++11 support
+ 2011-11-26 Fix conflict between two instantiations of module 'unistd'.
+ 2011-11-21 _Noreturn: Check that _MSC_VER is defined
+ 2011-11-10 ptsname_r: Avoid compilation error on OSF/1 5.1.
+ 2011-11-09 raise: fix mingw handling of SIGPIPE
+ 2011-10-27 Add stdalign module and use it in other modules.
+
+ * lib/stdalign.in.h, lib/sys_types.in.h, m4/off_t.m4, m4/stdalign.m4:
+ * m4/sys_types_h.m4:
+ New files.
+ * build-aux/move-if-change, build-aux/snippet/_Noreturn.h:
+ * build-aux/snippet/arg-nonnull.h, build-aux/snippet/c++defs.h:
+ * build-aux/snippet/warn-on-use.h, doc/misc/texinfo.tex:
+ * lib/alloca.in.h, lib/allocator.h, lib/careadlinkat.c:
+ * lib/careadlinkat.h, lib/dosname.h, lib/dup2.c, lib/filemode.c:
+ * lib/filemode.h, lib/ftoastr.c, lib/ftoastr.h, lib/getloadavg.c:
+ * lib/getopt.c, lib/getopt.in.h, lib/getopt1.c, lib/getopt_int.h:
+ * lib/gettext.h, lib/gnulib.mk, lib/ignore-value.h, lib/intprops.h:
+ * lib/inttypes.in.h, lib/lstat.c, lib/md5.c, lib/md5.h, lib/mktime.c:
+ * lib/pathmax.h, lib/pthread_sigmask.c, lib/readlink.c, lib/sha1.c:
+ * lib/sha1.h, lib/sha256.c, lib/sha256.h, lib/sha512.c, lib/sha512.h:
+ * lib/signal.in.h, lib/sigprocmask.c, lib/stat.c, lib/stdarg.in.h:
+ * lib/stdbool.in.h, lib/stddef.in.h, lib/stdint.in.h, lib/stdio.in.h:
+ * lib/stdlib.in.h, lib/strftime.c, lib/strftime.h, lib/strtoimax.c:
+ * lib/strtol.c, lib/strtoll.c, lib/strtoul.c, lib/strtoull.c:
+ * lib/symlink.c, lib/sys_stat.in.h, lib/time.in.h, lib/time_r.c:
+ * lib/u64.h, lib/unistd.in.h, lib/verify.h, m4/00gnulib.m4:
+ * m4/alloca.m4, m4/c-strtod.m4, m4/dup2.m4, m4/extensions.m4:
+ * m4/filemode.m4, m4/getloadavg.m4, m4/getopt.m4, m4/gl-comp.m4:
+ * m4/gnulib-common.m4, m4/gnulib-tool.m4, m4/include_next.m4:
+ * m4/inttypes.m4, m4/largefile.m4, m4/longlong.m4, m4/lstat.m4:
+ * m4/md5.m4, m4/mktime.m4, m4/multiarch.m4, m4/nocrash.m4:
+ * m4/pathmax.m4, m4/pthread_sigmask.m4, m4/readlink.m4, m4/sha1.m4:
+ * m4/sha256.m4, m4/sha512.m4, m4/signal_h.m4, m4/signalblocking.m4:
+ * m4/socklen.m4, m4/ssize_t.m4, m4/st_dm_mode.m4, m4/stat.m4:
+ * m4/stdarg.m4, m4/stdbool.m4, m4/stddef_h.m4, m4/stdint.m4:
+ * m4/stdio_h.m4, m4/stdlib_h.m4, m4/strftime.m4, m4/strtoimax.m4:
+ * m4/strtoll.m4, m4/strtoull.m4, m4/strtoumax.m4, m4/symlink.m4:
+ * m4/sys_stat_h.m4, m4/time_h.m4, m4/time_r.m4, m4/tm_gmtoff.m4:
+ * m4/unistd_h.m4, m4/warnings.m4, m4/wchar_t.m4:
+ Update from gnulib.
+
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove src/m/*.
+ * configure.in: Remove all mention of src/m/*.
+ (machine, machfile, M_FILE, config_machfile, and_machfile): Remove.
+ All uses removed.
+ (BITS_PER_CHAR, BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG)
+ (BITS_PER_LONG_LONG): Move to src/lisp.h.
+ * lib/makefile.w32-in: Remove dependencies on
+ $(EMACS_ROOT)/src/m/intel386.h.
+ * make-dist: Don't make links to src/m.
+
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * Makefile.in (ACLOCAL_INPUTS): Fix up gnulib-comp.m4 name. (Bug#11529)
+ Without this further fix, aclocal was being invoked unnecessarily.
+
+2012-05-22 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (blessmail, install-arch-dep, uninstall):
+ Check cd lib-src works.
+ (install-arch-dep, uninstall): Remove unneeded subshells.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * update-subdirs: Move to build-aux/.
+ * make-dist, Makefile.in (install-arch-indep): Update for this change.
+
+ * Makefile.in (leimdir): New, set by configure.
+ (COPYDIR, COPYDESTS): Add leim directories.
+ (install-leim): Remove.
+ (install-arch-indep): Handle leim installation directly.
+
+ * vpath.sed: Remove unused file.
+ * make-dist: No more vpath.sed.
+
+2012-05-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use full name for m4/gnulib-comp.m4. (Bug#11529)
+ Previously the file was named m4/gl-comp.m4 due to DOS 8+3 restrictions,
+ even though the file's name in gnulib is m4/gnulib-comp.m4.
+ This had a problem when merging from gnulib, as the code temporarily
+ renamed it to the full name, causing problems when interrupted.
+ Now the file has its full name, with the idea that we will find
+ a solution for MS-DOS that does not affect the rest of Emacs.
+ * m4/gnulib-comp.m4: Rename from m4/gl-comp.m4.
+
+ Assume C89 or later.
+ * configure.in (AC_C_PROTOTYPES, AC_C_VOLATILE, AC_C_CONST)
+ (POINTER_TYPE, PROTOTYPES): Remove.
+
+ Make merging from gnulib a script, not a makefile action.
+ Putting it in a makefile has some problems with reflection, as
+ merging from gnulib updates 'configure', which can update the makefile.
+ Putting it in a standalone script breaks this loop.
+ * Makefile.in (gnulib_srcdir, $(gnulib_srcdir), DOS_gnulib_comp.m4)
+ (GNULIB_MODULES, GNULIB_TOOL_FLAGS, sync-from-gnulib):
+ Remove, moving the actions to the script admin/merge-gnulib.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (LEIM_INSTALLDIR):
+ Rename to leimdir, treat like lispdir.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-indep, install-doc, install-info)
+ (uninstall): Scrap superfluous subshells.
+
+2012-05-19 Ulrich Mueller <ulm@gentoo.org>
+
+ * Makefile.in (install-etc): Respect DESTDIR. (Bug#11518)
+
+2012-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.in (AC_CHECK_FUNCS): Remove XSetWMProtocols,
+ getdomainname, mblen (twice), mbrlen (twice), mbsinit, ualarm,
+ getsockopt, setsockopt, mremap, mempcpy.
+
+ * configure.in (machine): Do not set to 'vax', since src/m/vax.h
+ is being removed.
+ (AC_CHECK_FUNCS): Remove ftime.
+
+2012-05-19 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-indep): Remove unneeded subshell.
+
+ * Makefile.in (install-arch-indep): Remove unneeded chmod.
+ Set permissions of lisp/subdirs.el.
+
+ * Makefile.in (SUBDIR): Add leim. Update users.
+
+ * Makefile.in (lib, lib-src, lisp): Check cd return value.
+
+ * Makefile.in (leim): No need to set PARALLEL.
+
+2012-05-18 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-indep, install-info, install-man):
+ Simplify some one-sided ifs.
+
+ * Makefile.in: Install only the relevant DOC file.
+ (install-arch-indep): Delete etc/DOC*.
+ (install-doc): No more need to delete etc/DOC.
+
+ * Makefile.in (install-arch-indep): Split into several rules.
+ (install-doc, innstall-info, install-man): New rules.
+
+ * configure.in (mandir): May as well include it in the NS app bundle.
+
+ * configure.in (INSTALL_ARCH_INDEP_EXTRA): New output variable.
+ * Makefile.in (INSTALL_ARCH_INDEP_EXTRA): New, set by configure.
+ (install-arch-indep): Don't install-etc for self-contained ns builds.
+
+ * configure.in (GCC_TEST_OPTIONS, NON_GCC_TEST_OPTIONS) <darwin>:
+ No longer unconditonally add /sw directories. (Bug#2280)
+
+ * Makefile.in (install-arch-dep): Depend on install-arch-indep.
+ (install-arch-indep): Depend on install-leim.
+ (install): Remove explicit install-leim dependence.
+
+ * Makefile.in (install-arch-indep):
+ Move last element of mkdir rule here.
+ (mkdir): Remove rule.
+
+ * Makefile.in (install-arch-indep): Remove unneeded chmods.
+ INSTALL_DATA does this for us.
+
+ * Makefile.in (install-arch-dep): Ensure bindir exists.
+ Drop mkdir dependency.
+ (install-arch-indep): Ensure docdir, infodir, mandir exist.
+ (install-leim): Drop mkdir dependency.
+ (mkdir): Remove most directories, now made in relevant rules.
+
+ * Makefile.in (install-arch-indep): Combine adjacent loops.
+
+2012-05-17 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-etc, mkdir):
+ Make relevant directories in install-etc rather than mkdir.
+
+ * Makefile.in (write_subdir): Create the directory if needed.
+ (install-arch-dep, mkdir): No need to make site-lisp directories.
+
+ * Makefile.in (write_subdir): New.
+ (install-arch-indep, install-arch-dep): Use $write_subdir.
+
+ * configure.in (docdir, etcdir, infodir, lispdir):
+ For a self-contained ns build, set these to the appropriate values.
+ * Makefile.in (install-arch-dep): No need to move info/ any more.
+
+ * configure.in (ns_self_contained): New output variable.
+ * Makefile.in (ns_self_contained): New, set by configure.
+ (install-arch-dep): For a self-contained ns build,
+ don't bother installing binaries then immediately deleting them.
+
+ * Makefile.in (ns_appbindir, ns_appresdir):
+ Move them before things that may refer to them.
+ (install-arch-dep): No need to relocate self-contained ns libexec.
+
+ * configure.in (archlibdir): Set it for self-contained ns builds.
+ (libexecdir): Don't expand it now (this is mainly cosmetic).
+
+2012-05-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.in: Simplify by removing CPP etc.
+ (CPP_TEST_OPTIONS, NON_GNU_CPP, cc_specified, SPECIFIED_CFLAGS)
+ (SPECIFED_CPP, CPP, NON_GNU_CC, AC_PROG_CPP): Remove; not needed.
+ In particular we no longer need to fiddle with CPP, since we don't
+ use CPP specially any more.
+ (gl_EARLY): Invoke this after adjusting CC, so that it uses the
+ adjusted compiler.
+ (AC_PROG_INSTALL, AC_PROG_MKDIR_P, AC_PROG_RANLIB): Comment out,
+ since gl_EARLY and/or Autoconf already does these.
+
+2012-05-16 Glenn Morris <rgm@gnu.org>
+
+ * configure.in: Try to fix building with gcc >= 4.6 on Darwin.
+ (CPP): Do not unconditionally set it on Darwin.
+ Instead, try to test if -no-cpp-precomp is accepted.
+ (CPP_TEST_OPTIONS, SPECIFIED_CPP): New. (Bug#9755)
+
+2012-05-15 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-dep): Replace use of MV_DIRS.
+
+ * Makefile.in (install-arch-dep): Do not hard-code version number.
+
+ * Makefile.in (install-arch-dep): NS install no longer needs to
+ symlink libexec/* into bin/, since 2012-05-14 ns_init_paths change.
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (ns_appbindir): Remove trailing "/".
+
+ * configure.in (AC_PROG_MKDIR_P): Call it, to set MKDIR_P.
+ (MKDEPDIR): Use $MKDIR_P.
+ * Makefile.in (MKDIR_P): New, set by configure.
+ (mkdir): Use $MKDIR_P.
+
+2012-05-11 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-indep): There are no more Makefile.c files.
+ Use INSTALL_DATA for the DOC file.
+ Remove dead code for ./lisp that never executes.
+
+2012-05-10 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (LEIM_INSTALLDIR): New output variable.
+
+2012-05-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * .dir-locals.el (log-edit-mode): Enable gnu-style checks.
+
+2012-05-08 Glenn Morris <rgm@gnu.org>
+
+ * make-dist: No more doc/lispref/*.el.
+
+2012-05-05 Andreas Schwab <schwab@linux-m68k.org>
+
+ * configure.in: Fix quoting bugs.
+
+2012-05-04 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (INFO_EXT, INFO_OPTS): New output variables.
+
+2012-05-02 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (LD_SWITCH_SYSTEM): Don't try to defeat
+ the choices made by FreeBSD and NetBSD. (Bug#10313)
+
+ * Makefile.in (INFO_FILES): Remove variable.
+ (INFO_NONMISC): New variable.
+ (install-arch-indep, uninstall): Don't use $INFO_FILES.
+
+ * Makefile.in (uninstall): Remove useless-use-of-for; that for
+ some reason caused problems on an old Solaris.
+
+ * Makefile.in (install-arch-indep, uninstall):
+ Ensure that INSTALL-type commands are run from top-level.
+
+ * info/dir: Make some entries consistent with the source texi files.
+
+ * configure.in (LIBS_TERMCAP): Fix netbsd logic, broken 2012-03-04.
+
+2012-05-02 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-indep):
+ Combine adjacent install-data and install-info loops.
+
+2012-05-01 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MAN_PAGES): Remove.
+ (install-arch-indep, uninstall): Don't use $MAN_PAGES.
+
+ * configure.in: Try libtinfo for tputs.
+ (LIBS_TERMCAP) [gnu*]: Use libtinfo if it was found. (Bug#9741)
+
+ * configure.in: Combine adjacent $opsys case blocks.
+
+ * configure.in (LIBS_TERMCAP): Remove unreachable branch for sol2.
+
+ * configure.in: Invert the TERMINFO logic,
+ since "yes" is far more common than "no".
+
+ * configure.in (HAVE_LIBNCURSES): Remove; it is required to be true.
+
+ * configure.in (LD_SWITCH_X_SITE_RPATH):
+ Rename from LD_SWITCH_X_SITE_AUX_RPATH.
+
+ * configure.in (LD_SWITCH_X_SITE_AUX): Remove; no longer used.
+
+2012-04-26 Glenn Morris <rgm@gnu.org>
+
+ * make-dist: No more doc/lispref/tindex.pl.
+
+2012-04-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * configure.in (dbus_validate_bus_name, dbus_validate_path)
+ (dbus_validate_interface, dbus_validate_member): Check also for
+ these library functions.
+
+2012-04-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.in (doug_lea_malloc): Check for __malloc_initialize_hook.
+ With glibc 2.14 or later, when compiled with GCC 4.7.0's
+ -Werror=deprecated-declarations flag, use of hooks like
+ __malloc_initialize_hook causes compilation to fail because these
+ hooks are deprecated. Modify 'configure' to check for these hooks too.
+ Simplify the 'configure' code to test for all the hooks at once.
+ (emacs_cv_var___after_morecore_hook): Remove, replacing with ...
+ (emacs_cv_var_doug_lea_malloc): ... this new var.
+
+2012-04-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Sync from gnulib version 4f11d6bebc3098c64ffde27079ab0d0cecfd0cdc
+ dated 2011-10-07. Regenerating from current gnulib would be a
+ pervasive change, and currently the trunk isn't open to such changes.
+ * configure.in (WARN_CFLAGS): Remove; no longer needed now
+ that gnulib does it.
+ * lib/gnulib.mk, m4/gl-comp.m4: Regenerate.
+
+2012-04-21 Andreas Schwab <schwab@linux-m68k.org>
+
+ * m4/gl-comp.m4: Update. (Bug#11285)
+
+2012-04-20 Ludovic Courtès <ludo@gnu.org>
+
+ * configure.in: Don't use the -R option (Bug#11251).
+
+2012-04-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ configure: new option --enable-gcc-warnings (Bug#11207)
+ I have been using this change for many months in my private copy
+ of Emacs, and have used it to find several bugs. It's mature
+ enough to publish now.
+ * Makefile.in (GNULIB_MODULES): Add warnings, manywarnings.
+ * configure.in: Support --enable-gcc-warnings, in the style of
+ other GNU packages such as coreutils.
+ (C_WARNINGS_SWITCH): Remove, replacing with...
+ (WARN_CFLAGS, GNULIB_WARN_CFLAGS): New variable.
+ (PKG_CHECK_MODULES, C_SWITCH_X_SITE): Use -isystem rather than -I,
+ when including system files with GCC.
+ * etc/NEWS: Mention --enable-gcc-warnings.
+ * INSTALL (DETAILED BUILDING AND INSTALLATION): Likewise.
+ * lib/Makefile.am (AM_CFLAGS): New macro.
+ * m4/manywarnings.m4, m4/warnings.m4: New files, from gnulib.
+
+2012-04-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.in (AC_CHECK_FUNCS):
+ Add getpwent, endpwent, getgrent, endgrent. (Bug#7900)
+
+2012-04-16 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (NS_HAVE_NSINTEGER): Remove unnecessary variable.
+
+ * configure.in: Remove X libs workaround for old autoconf.
+
+2012-04-12 Ken Brown <kbrown@cornell.edu>
+
+ * configure.in: Warn that Cygwin 1.5 is unsupported. (Bug#10398)
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (GNUSTEP_CFLAGS): Rename from C_SWITCH_X_SYSTEM.
+
+2012-04-10 Glenn Morris <rgm@gnu.org>
+
+ * configure.in: Conditionally generate admin/unidata/Makefile.
+
+2012-04-09 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * info/dir, Makefile.in (INFO_FILES): Add emacs-gnutls manual.
+
+2012-04-09 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (leim): Check cd return value. Pass fewer variables.
+ (install-leim): Check cd return value. Pass $MFLAGS.
+ (install-strip): Pass $MFLAGS.
+
+ * configure.in: Require makeinfo >= 4.7. (Bug#10910)
+ Eg org.texi has been using 4.7 functions for some time.
+
+2012-04-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Check pkg-config exit status when configuring (Bug#10626).
+ * configure.in (PKG_CHECK_MODULES): Do not assume that pkg-config
+ works; check its exit status. Problem reported by Jordi Gutiérrez
+ Hermoso in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-01/msg00787.html>.
+
+2012-04-07 Glenn Morris <rgm@gnu.org>
+
+ * README, configure.in (AC_INIT): Bump version to 24.1.50.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * lib/makefile.w32-in (gnulib, all): Don't depend on stamp_BLD.
+
+2012-03-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ configure: fix ncurses 'configure' issue on Solaris 10 (Bug#10677)
+ * configure.in (LIBS_TERMCAP): Default this to the result of
+ the tputs library search. Do a run-time test for the linkability
+ of tputs unless cross-compiling, as that's more reliable if the
+ link flags and libraries are messed up. Don't change LIBS as
+ a result of the test, as that may mess up later tests.
+
+2012-02-05 Christoph Scholtes <cschol2112@googlemail.com>
+
+ * make-dist (README.W32): Include file in source tarball. (Bug#9750)
+
+ * lib/makefile.w32-in (PRAGMA_SYSTEM_HEADER): Move to platform
+ specific makefiles to support getopt_.h generation with MSVC.
+
+2012-02-04 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (uninstall):
+ Handle compressed info files and man pages. (Bug#10718)
+
+2012-02-02 Glenn Morris <rgm@gnu.org>
+
+ * configure.in [HAVE_NS]:
+ Error if use --without-toolkit-scroll-bars. (Bug#10673)
+
+2012-02-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port to older Solaris 10 versions (Bug#10677).
+ Bug reported by Chong Yidong for SunOS 5.10 Generic_127111-11 sparc.
+ I cannot reproduce it on SunOS 5.10 Generic_141444-09 sparc but
+ possibly this is because Sun fixed the 'stat' bug in my version.
+ * Makefile.in (GNULIB_TOOL_FLAGS): Do not avoid the pathmax module.
+ * lib/pathmax.h, m4/pathmax.m4: New files, from gnulib.
+ * lib/gnulib.mk, m4/gl-comp.m4: Regenerate.
+ These changes are based on gnulib version
+ 4f11d6bebc3098c64ffde27079ab0d0cecfd0cdc dated 2011-10-07 20:59:10,
+ because Emacs is in feature freeze and we do not want to merge any
+ more-recent changes from gnulib.
+
+2012-01-31 Glenn Morris <rgm@gnu.org>
+
+ * configure.in: Throw an explicit error if Motif toolkit was
+ requested but requirements could not be found.
+
+ * configure.in: Allow Emacs to actually be built with xaw scroll-bars.
+
+2012-01-30 Eli Zaretskii <eliz@gnu.org>
+
+ * lib/makefile.w32-in ($(BLD)/sha1.$(O) $(BLD)/sha256.$(O)
+ $(BLD)/sha512.$(O)): Depend on stamp_BLD. Fixes a build failure
+ with "make -j3".
+
+2012-01-16 Juanma Barranquero <lekktu@gmail.com>
+
+ * .bzrignore: Ignore etc/__pycache__.
+
2011-12-17 Paul Eggert <eggert@cs.ucla.edu>
Port HAVE_PTHREAD configuration to MirBSD 10 (Bug#10201).
- * configure.in (HAVE_PTHREAD): Check for pthread_atfork if linking
+ * configure.in (HAVE_PTHREAD): Check for pthread_atfork if linking
to gmalloc.c. This should prevent a MirBSD 10 build failure reported
by Nelson H. F. Beebe in
<http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00065.html>.
@@ -69,7 +1696,7 @@
2011-11-04 Glenn Morris <rgm@gnu.org>
- * configure.in: Increase minimum GnuTLS version to 2.6.6. (Bug#9929)
+ * configure.in: Increase minimum GnuTLS version to 2.6.6. (Bug#9929)
Do not include GnuTLS version info in final summary message.
2011-10-31 Eli Zaretskii <eliz@gnu.org>
@@ -789,8 +2416,8 @@
* .bzrignore: Ignore new lib/*.in-h files.
- * config.bat: Rename stdint.in.h and sys_stat.in.h. Call
- depfiles.bat even if lib/deps already exist.
+ * config.bat: Rename stdint.in.h and sys_stat.in.h.
+ Call depfiles.bat even if lib/deps already exist.
2011-02-25 Paul Eggert <eggert@cs.ucla.edu>
@@ -817,7 +2444,7 @@
2011-02-21 Christoph Scholtes <cschol2112@gmail.com>
- * lib/makefile.w32-in ($(BLD)/md5.$(O)): Added dependency on
+ * lib/makefile.w32-in ($(BLD)/md5.$(O)): Add dependency on
$(EMACS_ROOT)/nt/inc/stdint.h.
2011-02-21 Eli Zaretskii <eliz@gnu.org>
@@ -918,7 +2545,7 @@
2011-02-13 Bruno Haible <bruno@clisp.org>
Consistent macro naming for macros that use GCC __attribute__.
- * lib/ignore-value.h (_GL_ATTRIBUTE_DEPRECATED): Renamed from
+ * lib/ignore-value.h (_GL_ATTRIBUTE_DEPRECATED): Rename from
ATTRIBUTE_DEPRECATED.
2011-02-12 Bruno Haible <bruno@clisp.org>
@@ -979,7 +2606,7 @@
2011-02-05 Paul Eggert <eggert@cs.ucla.edu>
sync from gnulib to remove HAVE_STDBOOL_H
- * m4/stdbool.m4 (AC_CHECK_HEADER_STDBOOL): Renamed from
+ * m4/stdbool.m4 (AC_CHECK_HEADER_STDBOOL): Rename from
AC_HEADER_STDBOOL. All uses changed. Do not define
HAVE_STDBOOL_H, as gnulib does not need this. This change is
imported from the latest Autoconf git. It was motivated by Emacs,
@@ -1064,8 +2691,8 @@
* lib/mktime.c (isdst_differ): New function.
(__mktime_internal): Use it systematically for all isdst comparisons.
This completes the fix for libc BZ #6723, and removes the need for
- normalizing tm_isdst. See
- <http://sourceware.org/bugzilla/show_bug.cgi?id=6723>
+ normalizing tm_isdst.
+ See <http://sourceware.org/bugzilla/show_bug.cgi?id=6723>
(not_equal_tm) [DEBUG]: Use isdst_differ here, too.
mktime: fix some integer overflow issues and sidestep the rest
@@ -1139,7 +2766,7 @@
2011-01-28 Paul Eggert <eggert@cs.ucla.edu>
improve fix for MS-DOS file name clash
- * Makefile.in (DOS_gnulib_comp.m4): Renamed from DOS-gnulib-comp.m4,
+ * Makefile.in (DOS_gnulib_comp.m4): Rename from DOS-gnulib-comp.m4,
for portability to POSIX make. Reported by Bruno Haible.
(sync-from-gnulib): Copy gl-comp.m4 (if present) back to
gnulib-comp.m4 before running gnulib-tool, to prevent old gnulib
@@ -1430,8 +3057,8 @@
2010-12-04 Andreas Schwab <schwab@linux-m68k.org>
* configure.in: Remove reference to removed machine description
- files and allow $machine and $machfile to be empty. Substitute
- M_FILE/S_FILE instead of machfile/opsysfile.
+ files and allow $machine and $machfile to be empty.
+ Substitute M_FILE/S_FILE instead of machfile/opsysfile.
2010-12-03 Glenn Morris <rgm@gnu.org>
@@ -1464,8 +3091,8 @@
2010-10-31 Ken Brown <kbrown@cornell.edu>
- * configure.in (checking whether localtime caches TZ): Use
- unsetenv instead of modifying environment directly.
+ * configure.in (checking whether localtime caches TZ):
+ Use unsetenv instead of modifying environment directly.
2010-10-25 Andreas Schwab <schwab@linux-m68k.org>
@@ -1498,8 +3125,8 @@
2010-10-12 Dan Nicolaescu <dann@ics.uci.edu>
- * configure (ns_appdir, OLDXMENU, TOOLTIP_SUPPORT): Remove
- trailing / from directory names.
+ * configure (ns_appdir, OLDXMENU, TOOLTIP_SUPPORT):
+ Remove trailing / from directory names.
2010-10-12 Glenn Morris <rgm@gnu.org>
@@ -2210,7 +3837,7 @@
2010-03-12 Eli Zaretskii <eliz@gnu.org>
- These changes remove termcap.c from the build on Posix platforms.
+ These changes remove termcap.c from the build on POSIX platforms.
* configure.in <AC_CHECK_HEADERS>: Remove termcap.h.
* configure: Regenerated.
@@ -2687,7 +4314,7 @@
* configure.in: Only check for m17n-flt if HAVE_LIBOTF.
-2008-08-28 Adrian Robert <Adrian.B.Robert@gmail.com>
+2008-10-03 Adrian Robert <Adrian.B.Robert@gmail.com>
* configure.in: Report USE_TOOLKIT_SCROLLBARS as such (not mentioning
"X") to avoid confusion.
@@ -2710,8 +4337,8 @@
2008-08-21 Christian Faulhammer <opfer@gentoo.org> (tiny change)
- * configure.in (GNUSTEP_SYSTEM_HEADERS): Define
- GNUSTEP_SYSTEM_HEADERS and GNUSTEP_SYSTEM_LIBRARIES.
+ * configure.in (GNUSTEP_SYSTEM_HEADERS):
+ Define GNUSTEP_SYSTEM_HEADERS and GNUSTEP_SYSTEM_LIBRARIES.
* configure: Regenerate.
@@ -2752,8 +4379,8 @@
2008-08-06 Adrian Robert <Adrian.B.Robert@gmail.com>
* configure.in (NS_HAVE_INTEGER): Rename to NS_HAVE_NSINTEGER.
- (C_SWITCH_X_SYSTEM): Drop -MMD -MP under NS_IMPL_GNUstep. Don't
- bother undef'ing since won't have desired effect.
+ (C_SWITCH_X_SYSTEM): Drop -MMD -MP under NS_IMPL_GNUstep.
+ Don't bother undef'ing since won't have desired effect.
2008-08-06 Andreas Schwab <schwab@suse.de>
@@ -3650,8 +5277,8 @@
2007-03-19 Deanna Phillips <deanna@sixbit.org> (tiny change)
* configure.in (arm-*-openbsd*, hppa-*-openbsd*)
- (m88k-*-openbsd*, mips64-*-openbsd*, sh-*-openbsd*): Added.
- (ns32k-*-openbsd*, ns32k-*-openbsd*): Deleted.
+ (m88k-*-openbsd*, mips64-*-openbsd*, sh-*-openbsd*): Add.
+ (ns32k-*-openbsd*, ns32k-*-openbsd*): Delete.
2007-03-19 Chong Yidong <cyd@stupidchicken.com>
@@ -3849,7 +5476,7 @@
$PKG_CONFIG --exists "$2" to config.log.
* configure: Regenerate.
-2006-07-08 Richard Stallman <rms@gnu.org>
+2006-07-09 Richard Stallman <rms@gnu.org>
* INSTALL (DETAILED BUILDING AND INSTALLATION): Minor corrections.
@@ -3981,7 +5608,7 @@
* configure.in: Use GZIP_PROG instead of GZIP.
- * Makefile.in (GZIP_PROG): Renamed from GZIP.
+ * Makefile.in (GZIP_PROG): Rename from GZIP.
(install-arch-indep): Adjust.
2005-11-01 Andreas Schwab <schwab@suse.de>
@@ -4081,21 +5708,21 @@
2005-06-08 Steven Tamm <steventamm@mac.com>
- * configure.in: Support Darwin/MacOSX on Intel
+ * configure.in: Support Darwin/MacOSX on Intel.
2005-06-06 Jan Djärv <jan.h.d@swipnet.se>
* configure.in (HAVE_CANCELMENUTRACKING): New test.
-2005-05-11 Jérôme Marant <jmarant@marant.org>
+2005-05-19 Jérôme Marant <jmarant@marant.org>
* configure.in: Add --enable-locallisppath.
2005-05-13 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* configure.in: Don't check HAVE_CARBON if HAVE_X11 is set to yes.
- Check HAVE_CARBON before USE_TOOLKIT_SCROLL_BARS. Define
- USE_TOOLKIT_SCROLL_BARS by default if HAVE_CARBON is set to yes.
+ Check HAVE_CARBON before USE_TOOLKIT_SCROLL_BARS.
+ Define USE_TOOLKIT_SCROLL_BARS by default if HAVE_CARBON is set to yes.
2005-05-07 Jérôme Marant <jerome@marant.org>
@@ -4211,7 +5838,7 @@
2004-10-08 Steven Tamm <steventamm@mac.com>
- * configure.in (HAVE_MALLOC_MALLOC_H): Test for malloc/malloc.h
+ * configure.in (HAVE_MALLOC_MALLOC_H): Test for malloc/malloc.h.
2004-10-06 Jan Djärv <jan.h.d@swipnet.se>
@@ -4236,6 +5863,12 @@
* configure.in: Check for exec-shield.
+2004-09-04 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * Makefile.in (install-arch-indep): Add pgg and sieve.
+
+ * info/.cvsignore: Added pgg and sieve.
+
2004-08-06 Andreas Schwab <schwab@suse.de>
* Makefile.in (install-arch-indep, uninstall): Add flymake.
@@ -4244,12 +5877,6 @@
* config.bat: Update URLs in the comments.
-2004-08-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (install-arch-indep): Add pgg and sieve.
-
- * info/.cvsignore: Added pgg and sieve.
-
2004-07-05 Andreas Schwab <schwab@suse.de>
* Makefile.in (install-arch-indep): Remove .arch-inventory files.
@@ -4351,7 +5978,7 @@
* INSTALL.CVS: Renamed from INSTALL-CVS to avoid file-name
clashes with install-sh on 8+3 filesystems.
-2003-12-08 Miles Bader <miles@gnu.org>
+2003-12-24 Miles Bader <miles@gnu.org>
* .cvsignore: Add .arch-inventory.
@@ -4484,19 +6111,6 @@
* configure.in: Append * to s390-*-linux-gnu case.
(LIBMAIL) <lockfile>: Don't define.
-2003-04-30 Richard M. Stallman <rms@gnu.org>
-
- * configure.in: Handle system types sysv5uw* and sysv5OpenUNIX*.
-
-2003-04-28 Francesco Potortì <pot@gnu.org>
-
- * configure.in: Undo last (RMS') change, as it is useless, per
- Dave Love.
-
-2003-04-08 Richard M. Stallman <rms@gnu.org>
-
- * configure.in: Put #include of jpeglib.h at start of line.
-
2003-04-30 Kai Großjohann <kai.grossjohann@gmx.net>
* INSTALL (* GNU/Linux development packages): Mention Debian and
@@ -4511,6 +6125,19 @@
* INSTALL (* GNU/Linux development packages): Tell people to
install additional packages for compiling Emacs.
+2003-04-30 Richard M. Stallman <rms@gnu.org>
+
+ * configure.in: Handle system types sysv5uw* and sysv5OpenUNIX*.
+
+2003-04-28 Francesco Potortì <pot@gnu.org>
+
+ * configure.in: Undo last (RMS') change, as it is useless, per
+ Dave Love.
+
+2003-04-08 Richard M. Stallman <rms@gnu.org>
+
+ * configure.in: Put #include of jpeglib.h at start of line.
+
2003-04-06 Francesco Potortì <pot@gnu.org>
* configure.in: Use the same configuration for all aix5, not just
@@ -4566,7 +6193,7 @@
2003-01-19 Jan Djärv <jan.h.d@swipnet.se>
- * configure.in: Add --with-gtk, --with-x-toolkit=gtk
+ * configure.in: Add --with-gtk, --with-x-toolkit=gtk.
* INSTALL (DETAILED BUILDING AND INSTALLATION): Add text about GTK.
@@ -4579,7 +6206,7 @@
* configure.in: New option, --enable-carbon-app, to specify
that the application should be installed
* Makefile.in (install-arch-dep): On Mac OS X, install the
- Emacs.app application if carbon-app is enabled
+ Emacs.app application if carbon-app is enabled.
2003-01-06 Dave Love <fx@gnu.org>
@@ -4619,7 +6246,7 @@
* autogen.sh: New file.
-2002-11-15 Dave Love <fx@gnu.org>
+2002-11-18 Dave Love <fx@gnu.org>
* configure.in: Tidy up various quoting issues throughout.
Use AC_GNU_SOURCE.
@@ -4775,7 +6402,7 @@
variable HAVE_CARBON. Also define HAVE_WINDOW_SYSTEM, HAVE_MOUSE,
and HAVE_MENUS in AH_BOTTOM if HAVE_CARBON is defined.
-2002-04-28 Colin Walters <walters@verbum.org>
+2002-04-29 Colin Walters <walters@verbum.org>
* configure.in: Delete configure check for access to the game user.
@@ -5189,8 +6816,8 @@
* Makefile.in (uninstall): Ignore exit code of `rm'.
- * Makefile.in (uninstall): Remove more info files. Remove
- ${libexecdir}/emacs/${version}. Remove ${archlibdir}/fns-*.
+ * Makefile.in (uninstall): Remove more info files.
+ Remove ${libexecdir}/emacs/${version}. Remove ${archlibdir}/fns-*.
2001-01-31 Gerd Moellmann <gerd@gnu.org>
@@ -5198,7 +6825,7 @@
2001-01-28 Gerd Moellmann <gerd@gnu.org>
- * Makefile.in (extraclean): Added -f to -rm config-tmp-* to keep
+ * Makefile.in (extraclean): Add -f to -rm config-tmp-* to keep
it quiet.
2001-01-24 Colin Walters <walters@cis.ohio-state.edu>
@@ -5393,7 +7020,7 @@
(NON-TIT-CNS, JAPANESE, KOREAN, THAI, VIETNAMESE, LAO, INDIAN)
(TIBETAN, LATIN, SLAVIC, GREEK, RUSSIAN, MISC): Rename all .el
files to .elc.
- (${TIT}): Adjusted for the above change.
+ (${TIT}): Adjust for the above change.
(clean mostlyclean): Likewise.
(.el.elc): New target.
@@ -5480,7 +7107,7 @@
2000-07-26 Dave Love <fx@gnu.org>
- * configure.in (AC_SYS_LARGEFILE): Moved earlier.
+ * configure.in (AC_SYS_LARGEFILE): Move earlier.
2000-07-24 Dave Love <fx@gnu.org>
@@ -5652,8 +7279,8 @@
* Makefile.in (bootstrap-lisp-1, bootstrap-lisp, bootstrap-src):
New targets.
- (bootstrap): Rewritten in terms of the new targets above. Make
- info files, too.
+ (bootstrap): Rewritten in terms of the new targets above.
+ Make info files, too.
2000-03-12 Gerd Moellmann <gerd@gnu.org>
@@ -5732,8 +7359,8 @@
2000-01-03 Andreas Schwab <schwab@suse.de>
- * Makefile.in (install-arch-indep): Install autotype*. Run
- install-info on autotype and emacs-faq.info.
+ * Makefile.in (install-arch-indep): Install autotype*.
+ Run install-info on autotype and emacs-faq.info.
1999-12-04 Dave Love <fx@gnu.org>
@@ -5809,7 +7436,7 @@
1999-09-07 Gerd Moellmann <gerd@gnu.org>
- * configure.in (--with-sound): Removed.
+ * configure.in (--with-sound): Remove.
1999-08-30 Gerd Moellmann <gerd@gnu.org>
@@ -5906,7 +7533,7 @@
* configure.in: Use epaths.h and epaths-force instead of paths...
- * Makefile.in (epaths-force): Renamed from paths-force;
+ * Makefile.in (epaths-force): Rename from paths-force;
operate on epaths.in and produce epaths.h.
1999-02-24 Richard Stallman <rms@gnu.org>
@@ -6251,8 +7878,8 @@
1997-08-24 NIIBE Yutaka <gniibe@mri.co.jp>
- * configure.in (x_default_search_path): Corrected
- '${x_library}' to '${x_library}/X11'.
+ * configure.in (x_default_search_path):
+ Corrected '${x_library}' to '${x_library}/X11'.
1997-08-22 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -6952,7 +8579,7 @@
1995-12-24 Richard Stallman <rms@mole.gnu.ai.mit.edu>
* configure.in: Determine HAVE_X11R6.
- (HAVE_MENUS): Renamed from HAVE_X_MENU.
+ (HAVE_MENUS): Rename from HAVE_X_MENU.
1995-12-21 Richard Stallman <rms@whiz-bang.gnu.ai.mit.edu>
@@ -7058,7 +8685,7 @@
1995-09-30 Richard Stallman <rms@mole.gnu.ai.mit.edu>
- * configure.in (powerpc-*-solaris2): New alternative.x
+ * configure.in (powerpc-*-solaris2): New alternative.
1995-09-12 Karl Heuer <kwzh@gnu.ai.mit.edu>
@@ -7145,8 +8772,8 @@
1995-07-06 David J. MacKenzie <djm@geech.gnu.ai.mit.edu>
- * configure.in: Put back archlibdir initialization. Require
- autoconf 2.4.1 or later.
+ * configure.in: Put back archlibdir initialization.
+ Require autoconf 2.4.1 or later.
1995-07-01 Richard Stallman <rms@mole.gnu.ai.mit.edu>
@@ -7274,7 +8901,7 @@
* make-dist: Put src/makefile.nt in dist.
* configure.in (i[345]86-*-bsdi2*): New configuration.
- (vax-dec-bsd386*): Deleted.
+ (vax-dec-bsd386*): Delete.
1995-05-06 David J. MacKenzie <djm@geech.gnu.ai.mit.edu>
@@ -7284,7 +8911,7 @@
1995-05-03 Richard Stallman <rms@mole.gnu.ai.mit.edu>
- * configure.in (m68*-apollo-*): Renamed from m68*-apollo*.
+ * configure.in (m68*-apollo-*): Rename from m68*-apollo*.
Use bsd4-3. Don't set NON_GNU_CPP.
* make-dist: Don't copy in src/s/*.inp. Don't copy nt/src.
@@ -7361,7 +8988,7 @@
1995-02-07 Richard Stallman <rms@pogo.gnu.ai.mit.edu>
- * Makefile.in (maintainer-clean): Renamed from realclean.
+ * Makefile.in (maintainer-clean): Rename from realclean.
1995-02-02 David J. MacKenzie <djm@geech.gnu.ai.mit.edu>
@@ -7530,8 +9157,8 @@
* Makefile.in: Use libexecdir and sharedstatedir as appropriate.
- * configure.in (libexecdir): Renamed from libdir. New default.
- (sharedstatedir): Renamed from statedir. New default.
+ * configure.in (libexecdir): Rename from libdir. New default.
+ (sharedstatedir): Rename from statedir. New default.
(datadir): New default.
* make-dist: Don't distribute subdirs.el.
@@ -7572,11 +9199,11 @@
1994-09-21 Richard Stallman <rms@mole.gnu.ai.mit.edu>
- * configure.in (i[345]86-sequent-ptx*): Handle
+ * configure.in (i[345]86-sequent-ptx*): Handle.
1994-09-20 Richard Stallman <rms@mole.gnu.ai.mit.edu>
- * Makefile.in (paths-force): Depend on src/paths.h
+ * Makefile.in (paths-force): Depend on src/paths.h.
1994-09-19 Karl Heuer <kwzh@hal.gnu.ai.mit.edu>
@@ -7584,7 +9211,7 @@
1994-09-18 Karl Heuer <kwzh@hal.gnu.ai.mit.edu>
- * Makefile.in (install-arch-indep): Copy DOC-*, not DOC*
+ * Makefile.in (install-arch-indep): Copy DOC-*, not DOC*.
* configure.in: Add AC_AIX.
Add checks to set HAVE_STRUCT_UTIMBUF, HAVE_TIMEVAL, HAVE_SELECT.
@@ -8081,7 +9708,7 @@
1994-02-14 Frederic Pierresteguy (fp@mole.gnu.ai.mit.edu)
- * configure.in (rs6000-bull-bosx*): Added support for BULL dpx20.
+ * configure.in (rs6000-bull-bosx*): Add support for BULL dpx20.
1994-02-11 Karl Heuer (kwzh@mole.gnu.ai.mit.edu)
@@ -8234,7 +9861,7 @@
* Makefile.in (mkdir): Make only the lockdir writable.
- * configure.in (i860-*-sysv4): Renamed from i860-*-sysvr4.
+ * configure.in (i860-*-sysv4): Rename from i860-*-sysvr4.
1993-12-11 Richard Stallman (rms@srarc2)
@@ -8348,8 +9975,8 @@
1993-09-28 Brian J. Fox (bfox@cubit)
* configure.in: Don't copy ${srcdir}/src/Makefile.in; that file
- doesn't exist. Just copy src/Makefile.in instead. Touch
- all of the Makefiles after editing config.status.
+ doesn't exist. Just copy src/Makefile.in instead.
+ Touch all of the Makefiles after editing config.status.
* INSTALL: Update documentation to match new configuration
mechanism.
@@ -8417,7 +10044,7 @@
1993-09-12 Roland McGrath (roland@sugar-bombs.gnu.ai.mit.edu)
- * make-dist: Dist vpath.sed
+ * make-dist: Dist vpath.sed.
* Makefile.in (lib-src/Makefile, src/Makefile, oldXMenu/Makefile):
Depend on vpath.sed.
@@ -8430,8 +10057,8 @@
1993-09-10 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
- * configure.in: Remove check for $srcdir being configured. This
- pretty much works now.
+ * configure.in: Remove check for $srcdir being configured.
+ This pretty much works now.
Grok {m68*-hp,i[34]86-*}-netbsd* and set opsys=netbsd.
Check for XFree86 (/usr/X386/include) independent of whether
-lXbsd exists.
@@ -8472,7 +10099,7 @@
1993-08-10 Richard Stallman (rms@mole.gnu.ai.mit.edu)
- * configure.in (m88k-tektronix-sysv3*): Added the missing *.
+ * configure.in (m88k-tektronix-sysv3*): Add the missing *.
Use tekxd88, not tekXD88.
1993-08-10 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
@@ -8847,8 +10474,8 @@
* INSTALL: Mention its usage.
* configure.in (hppa-hp-hpux): Use uname -r instead of uname -m;
- the former gives you the operating system rev directly. Use
- s/hpux.h if we don't recognize what we got.
+ the former gives you the operating system rev directly.
+ Use s/hpux.h if we don't recognize what we got.
* Makefile.in (do-install): Don't remove a destination directory
if it's the same as the source. If ${srcdir}/info == ${infodir},
@@ -8895,8 +10522,8 @@
* Makefile.in (install): Split this into `install' and
`do-install', to give people more control over exactly what gets
done.
- (do-install): New target, containing the guts of `install'. Don't
- remove and recreate the directories inside the copying loop - do
+ (do-install): New target, containing the guts of `install'.
+ Don't remove and recreate the directories inside the copying loop - do
it all before the copying loop. Pass more flags to the lib-src
make.
(mkdir): Create ${infodir}, ${mandir}, and ${sitelispdir} here, to
@@ -8953,7 +10580,7 @@
* configure.in: Make the first line of the configure script be
"#!/bin/sh". Leaving the first line blank didn't work.
- * configure.in (long_usage): Removed; made short_usage describe
+ * configure.in (long_usage): Remove; made short_usage describe
the options briefly.
* configure.in: Implement the --prefix option.
@@ -9025,11 +10652,11 @@
* PROBLEMS: Some updates from David J. Mackenzie.
More changes from David J. Mackenzie.
- * Makefile.in (install.sysv, install.xenix, install.aix): Targets
- removed; autoconf and config.h should specify all these
+ * Makefile.in (install.sysv, install.xenix, install.aix):
+ Targets removed; autoconf and config.h should specify all these
differences.
(buildlisppath): Make this path depend on ${srcdir}.
- (INSTALLFLAGS): Removed.
+ (INSTALLFLAGS): Remove.
(INSTALL): Include the -c flag.
(install): Change the way we invoke install accordingly.
@@ -9072,14 +10699,14 @@
1993-05-09 Jim Blandy (jimb@totoro.cs.oberlin.edu)
- * Makefile.in (DEFS): Deleted; since we're using AC_CONFIG_HEADER,
+ * Makefile.in (DEFS): Delete; since we're using AC_CONFIG_HEADER,
this is always just -DHAVE_CONFIG_H.
The GNU coding standards specify that CFLAGS should be left for
users to set.
* Makefile.in (CFLAGS): Let configure determine the default value
- for this. Don't
- have it default to DEFS.
+ for this.
+ Don't have it default to DEFS.
(${SUBDIR}): Pass CFLAGS down to submakes, not DEFS.
(lib-src/Makefile, src/Makefile): Edit the default value for
CFLAGS into these files, not DEFS.
@@ -9205,17 +10832,17 @@
Use autoconf to produce Makefile and src/config.h.
Remove the Makefile-style comment that autoconf places at the top
of src/config.h.
- (config_h_opts): Removed - no longer necessary.
- * Makefile.in (configname): Renamed to configuration.
- (CONFIG_CFLAGS): Renamed to DEFS.
- (CC, DEFS, C_SWITCH_SYSTEM, version, configuration): Adjusted to
+ (config_h_opts): Remove - no longer necessary.
+ * Makefile.in (configname): Rename to configuration.
+ (CONFIG_CFLAGS): Rename to DEFS.
+ (CC, DEFS, C_SWITCH_SYSTEM, version, configuration): Adjust to
get values via autoload @cookies@.
(libsrc_libs): Get this from autoconf. We used to do nothing
about this.
(${SUBDIR}): Pass DEFS to submakes instead of CONFIG_CFLAGS.
- * Makefile.in (src/paths.h, lib-src/Makefile, src/Makefile): Don't
- echo the move-if-change command.
+ * Makefile.in (src/paths.h, lib-src/Makefile, src/Makefile):
+ Don't echo the move-if-change command.
1993-04-08 Jim Blandy (jimb@churchy.gnu.ai.mit.edu)
@@ -9270,8 +10897,8 @@
* configure: Properly handle extracting values of LIBS_MACHINE and
LIBS_SYSTEM that contain spaces.
- * configure: Add `--x-includes' and `--x-libraries' options. I
- think these are dopey, but no less than three alpha testers, at
+ * configure: Add `--x-includes' and `--x-libraries' options.
+ I think these are dopey, but no less than three alpha testers, at
large sites, have said they have their X files installed in odd
places. Implement them by setting C_SWITCH_X_SITE and
LD_SWITCH_X_SITE in src/config.h.
@@ -9476,8 +11103,8 @@
* Makefile.in (datadir, statedir, libdir): Make these all default
to ${prefix}/lib.
- (lispdir, locallisppath, etcdir, lockdir, archlibdir): Adjusted
- to compensate.
+ (lispdir, locallisppath, etcdir, lockdir, archlibdir):
+ Adjust to compensate.
* Makefile.in (install, install.sysv, install.xenix, install.aix):
Install the etags and ctags man pages too.
@@ -9492,7 +11119,7 @@
* configure (long_usage): Remove all traces of old arguments from
usage messages, and document the options we do accept in more
detail: -with-x... and --srcdir.
- (options, boolean_opts): Deleted; we don't have enough options to
+ (options, boolean_opts): Delete; we don't have enough options to
make this worthwhile.
(prefix, bindir, lisppath, datadir, libdir, lockdir): Deleted,
along with the code which supported them; these should be set as
@@ -9517,8 +11144,8 @@
compile in don't exist yet, create them under the current directory.
Note that the rest of the build process doesn't really support
this.
- Edit only the top Makefile. That should edit the others. Edit
- into the makefile: `version', from lisp/version.el, `configname'
+ Edit only the top Makefile. That should edit the others.
+ Edit into the makefile: `version', from lisp/version.el, `configname'
and `srcdir' from the configuration arguments, `CC' and
`CONFIG_CFLAGS' as guessed from the presence or absence of GCC in
the user's path, and LOADLIBES as gleaned from the system
@@ -9761,8 +11388,8 @@
* make-dist: When setting up etc/COPYING, always nuke whatever is
there, and then copy it in, to make sure we get a real file.
- * make-dist: Don't try to distribute *.defns files any more. The
- only such file was for simula.el, which has been superseded by a
+ * make-dist: Don't try to distribute *.defns files any more.
+ The only such file was for simula.el, which has been superseded by a
version which doesn't have a separate .defns file.
1992-05-28 Ken Raeburn (Raeburn@Cygnus.COM)
@@ -9933,10 +11560,10 @@
(mostlyclean): New target, synonymous with clean.
(realclean): New target. Currently, this just calls the
subdirectories's makefiles and then deletes config.status.
- (INSTALL, INSTALLFLAGS, INSTALL_PROGRAM, INSTALL_DATA): New
- variables.
+ (INSTALL, INSTALLFLAGS, INSTALL_PROGRAM, INSTALL_DATA):
+ New variables.
Installation directory variables changed to conform.
- (install, install.sysv, install.xenix, install.aix): Changed the
+ (install, install.sysv, install.xenix, install.aix): Change the
code which copies the directories into their installed location to
allow the installed locations to be in several different
directories; the old version assumed that they would all be in
@@ -10080,7 +11707,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1993-1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/GNUmakefile b/GNUmakefile
index 5fd329c78ef..0602266adee 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -1,6 +1,6 @@
# Build Emacs from a fresh tarball or version-control checkout.
-# Copyright 2011 Free Software Foundation, Inc.
+# Copyright (C) 2011-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/INSTALL b/INSTALL
index dcbc729b463..4716bbecf99 100644
--- a/INSTALL
+++ b/INSTALL
@@ -1,5 +1,5 @@
GNU Emacs Installation Guide
-Copyright (C) 1992, 1994, 1996-1997, 2000-2011
+Copyright (C) 1992, 1994, 1996-1997, 2000-2012
Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -280,6 +280,12 @@ You can tell configure where to search for GTK by specifying
`--with-pkg-config-prog=PATH' where PATH is the pathname to
pkg-config. Note that GTK version 2.6 or newer is required for Emacs.
+Emacs will autolaunch a D-Bus session bus, when the environment
+variable DISPLAY is set, but no session bus is running. This might be
+inconvenient for Emacs when running as daemon or running via a remote
+ssh connection. In order to completely prevent the use of D-Bus, configure
+Emacs with the options `--without-dbus --without-gconf --without-gsettings'.
+
The Emacs mail reader RMAIL is configured to be able to read mail from
a POP3 server by default. Versions of the POP protocol older than
POP3 are not supported. For Kerberos-authenticated POP add
@@ -313,10 +319,39 @@ systems which support that.
Use --without-sound to disable sound support.
+Use --without-all if you want to build a small executable with the minimal
+dependencies on external libraries, at the cost of disabling most of the
+features that are normally enabled by default. Using --without-all is
+equivalent to --without-sound --without-dbus --without-libotf
+--without-selinux --without-xft --without-gsettings --without-gnutls
+--without-rsvg --without-xml2 --without-gconf --without-imagemagick
+--without-m17n-flt --without-jpeg --without-tiff --without-gif
+--without-png --without-gpm. Note that --without-all leaves X support
+enabled, and using the GTK2 or GTK3 toolkit creates a lot of library
+dependencies. So if you want to build a small executable with very basic
+X support, use --without-all --with-x-toolkit=no. For the smallest possible
+executable without X, use --without-all --without-x. If you want to build
+with just a few features enabled, you can combine --without-all with
+--with-FEATURE. For example, you can use --without-all --with-dbus
+to build with DBus support and nothing more.
+
Use --with-wide-int to implement Emacs values with the type 'long long',
even on hosts where a narrower type would do. With this option, on a
typical 32-bit host, Emacs integers have 62 bits instead of 30.
+Use --enable-gcc-warnings to enable compile-time checks that warn
+about possibly-questionable C code. This is intended for developers
+and is useful with GNU-compatible compilers. On a recent GNU system
+there should be no warnings; on older and on non-GNU systems the
+generated warnings may still be useful.
+
+Use --enable-link-time-optimization to enable link-time optimizer, which
+is available in GNU compiler since version 4.5.0. If your compiler is not
+GNU or older than version 4.5.0, this option does nothing. If `configure'
+can determine number of online CPUS on your system, final link-time
+optimization and code generation is executed in parallel using one job
+per each available online CPU.
+
The `--prefix=PREFIXDIR' option specifies where the installation process
should put emacs and its data files. This defaults to `/usr/local'.
- Emacs (and the other utilities users run) go in PREFIXDIR/bin
@@ -423,11 +458,19 @@ that supports the `VPATH' variable, such as GNU `make'.
to the real source directory--there is no need, and installation will
fail.)
-4) Look at `./lisp/paths.el'; if some of those values are not right
-for your system, set up the file `./lisp/site-init.el' with Emacs
-Lisp code to override them; it is not a good idea to edit paths.el
-itself. YOU MUST USE THE LISP FUNCTION `setq' TO ASSIGN VALUES,
-rather than `defvar', as used by `./lisp/paths.el'. For example,
+4) Put into `./lisp/site-init.el' or `./lisp/site-load.el' any Emacs
+Lisp code you want Emacs to load before it is dumped out. Use
+site-load.el for additional libraries if you arrange for their
+documentation strings to be in the etc/DOC file (see
+src/Makefile.in if you wish to figure out how to do that). For all
+else, use site-init.el. Do not load byte-compiled code which
+was built with a non-nil value of `byte-compile-dynamic'.
+
+It is not a good idea to edit the normal .el files that come with Emacs.
+Instead, use a file like site-init.el to change settings.
+
+To change the value of a variable that is already defined in Emacs,
+you should use the Lisp function `setq', not `defvar'. For example,
(setq news-inews-program "/usr/bin/inews")
@@ -439,14 +482,6 @@ variable gets by default! Make sure you know what kind of value the
variable should have. If you don't pay attention to what you are
doing, you'll make a mistake.
-5) Put into `./lisp/site-init.el' or `./lisp/site-load.el' any Emacs
-Lisp code you want Emacs to load before it is dumped out. Use
-site-load.el for additional libraries if you arrange for their
-documentation strings to be in the etc/DOC file (see
-src/Makefile.in if you wish to figure out how to do that). For all
-else, use site-init.el. Do not load byte-compiled code which
-was built with a non-nil value of `byte-compile-dynamic'.
-
If you set load-path to a different value in site-init.el or
site-load.el, Emacs will use *precisely* that value when it starts up
again. If you do this, you are on your own!
@@ -454,10 +489,10 @@ again. If you do this, you are on your own!
The `site-*.el' files are nonexistent in the distribution. You do not
need to create them if you have nothing to put in them.
-6) Refer to the file `./etc/TERMS' for information on fields you may
+5) Refer to the file `./etc/TERMS' for information on fields you may
wish to add to various termcap entries. (This is unlikely to be necessary.)
-7) Run `make' in the top directory of the Emacs distribution to finish
+6) Run `make' in the top directory of the Emacs distribution to finish
building Emacs in the standard way. The final executable file is
named `src/emacs'. You can execute this file "in place" without
copying it, if you wish; then it automatically uses the sibling
@@ -468,8 +503,8 @@ installed locations, with `make install'. By default, Emacs's files
are installed in the following directories:
`/usr/local/bin' holds the executable programs users normally run -
- `emacs', `etags', `ctags', `emacsclient',
- `grep-changelog', and `rcs-checkin'.
+ `emacs', `etags', `ctags', `emacsclient', and
+ `grep-changelog'.
`/usr/local/share/emacs/VERSION/lisp' holds the Emacs Lisp library;
`VERSION' stands for the number of the Emacs version
@@ -528,15 +563,15 @@ for its Lisp files by giving values for `make' variables as part of
the command. See the section below called `MAKE VARIABLES' for more
information on this.
-8) Check the file `dir' in your site's info directory (usually
+7) Check the file `dir' in your site's info directory (usually
/usr/local/share/info) to make sure that it has a menu entry for the
Emacs info files.
-9) If your system uses lock files to interlock access to mailer inbox files,
+8) If your system uses lock files to interlock access to mailer inbox files,
then you might need to make the movemail program setuid or setgid
to enable it to write the lock files. We believe this is safe.
-10) You are done! You can remove executables and object files from
+9) You are done! You can remove executables and object files from
the build directory by typing `make clean'. To also remove the files
that `configure' created (so you can compile Emacs for a different
configuration), type `make distclean'. If you don't need some, or all
@@ -654,25 +689,15 @@ running the `configure' program, you have to perform the following steps.
1) Copy `./src/config.in' to `./src/config.h'.
-2) Consult `./etc/MACHINES' to see what configuration name you should
-use for your system. Look at the code of the `configure' script to
-see which operating system and architecture description files from
-`src/s' and `src/m' should be used for that configuration name. Edit
-`src/config.h', and change the two `#include' directives to include
-the appropriate system and architecture description files.
-
-2) Edit `./src/config.h' to set the right options for your system. If
-you need to override any of the definitions in the s/*.h and m/*.h
-files for your system and machine, do so by editing config.h, not by
-changing the s/*.h and m/*.h files.
+2) Edit `./src/config.h' to set the right options for your system.
3) Create `Makefile' files in various directories from the
corresponding `Makefile.in' files. This isn't so hard, just a matter
of editing in appropriate substitutions for the @...@ constructs.
-The `configure' script is built from `configure.in' by the `autoconf'
-program. You need at least the version of autoconf specified in the
-AC_PREREQ(...) command to rebuild `configure' from `configure.in'.
+The `configure' script is built from `configure.ac' by the
+`autogen.sh' script, which checks that `autoconf' and other build
+tools are sufficiently up to date and then runs the build tools.
BUILDING GNU EMACS BY HAND
@@ -713,15 +738,15 @@ directory of the Emacs distribution.
in `./lib-src' to their final destinations, as selected in `./src/epaths.h'.
Strictly speaking, not all of the executables in `./lib-src' need be copied.
-- The programs `hexl', `movemail', `profile', `rcs2log', and `vcdiff'
+- The programs `hexl', `movemail', `profile', and `rcs2log'
are used by Emacs; they do need to be copied.
-- The programs `etags', `ctags', `emacsclient', and `rcs-checkin'
- are intended to be run by users; they are handled below.
+- The programs `etags', `ctags', and `emacsclient' are intended to be
+ run by users; they are handled below.
- The programs `make-docfile' and `test-distrib' were
used in building Emacs, and are not needed any more.
2) Copy the files in `./info' to the place specified in
-`./lisp/site-init.el' or `./lisp/paths.el'. Note that if the
+`./lisp/site-init.el' or `./lisp/info.el'. Note that if the
destination directory already contains a file named `dir', you
probably don't want to replace it with the `dir' file in the Emacs
distribution. Instead, you should make sure that the existing `dir'
@@ -735,9 +760,8 @@ of installing different versions.
You can delete `./src/temacs'.
-4) Copy the programs `emacsclient', `ctags', `etags', and `rcs-checkin'
-from `./lib-src' to `/usr/local/bin'. These programs are intended for
-users to run.
+4) Copy the programs `emacsclient', `ctags', and `etags' from `./lib-src'
+to `/usr/local/bin'. These programs are intended for users to run.
5) Copy the man pages in `./doc/man' into the appropriate man directory.
diff --git a/INSTALL.BZR b/INSTALL.BZR
index 69babac7a8b..9ff6a73a1c5 100644
--- a/INSTALL.BZR
+++ b/INSTALL.BZR
@@ -1,4 +1,4 @@
-Copyright (C) 2002-2011 Free Software Foundation, Inc.
+Copyright (C) 2002-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -8,8 +8,9 @@ Building Emacs from Bazaar requires some tools that are not needed
when building from a release. You will need:
autoconf - at least the version specified near the start of
- configure.in (in the AC_PREREQ command).
-automake - we recommend at least version 1.11.
+ configure.ac (in the AC_PREREQ command).
+automake - at least the version specified near the start of
+ configure.ac (in the AM_INIT_AUTOMAKE command).
makeinfo - not strictly necessary, but highly recommended, so that
you can build the manuals.
@@ -30,7 +31,7 @@ options you can set):
If you want later builds to go faster, at the expense of sometimes
doing the wrong thing if you update the build procedure, you can
-invoke "./configure -C --disable-maintainer-mode" instead.
+invoke "./configure -C" instead.
Some of the files that are included in the Emacs tarball, such as
byte-compiled Lisp files, are not stored in Bazaar. Therefore, to
diff --git a/Makefile.in b/Makefile.in
index 3ba7c9baae7..9b7bf795b84 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -2,7 +2,7 @@
# DIST: make most of the changes to this file you might want, so try
# DIST: that first.
-# Copyright (C) 1992-2011 Free Software Foundation, Inc.
+# Copyright (C) 1992-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -66,10 +66,8 @@ CDPATH=
# ==================== Things `configure' Might Edit ====================
-MAINTAINER_MODE_FLAG = --disable-maintainer-mode
-@MAINT@MAINTAINER_MODE_FLAG = --enable-maintainer-mode
cache_file = @cache_file@
-CONFIGURE_FLAGS = --cache-file=$(cache_file) $(MAINTAINER_MODE_FLAG)
+CONFIGURE_FLAGS = --cache-file=$(cache_file)
CC=@CC@
CFLAGS=@CFLAGS@
@@ -90,6 +88,13 @@ configuration=@configuration@
# ==================== Where To Install Things ====================
+# Location to install Emacs.app under GNUstep / Mac OS X.
+# Later values may use these.
+ns_appbindir=@ns_appbindir@
+ns_appresdir=@ns_appresdir@
+# Either yes or no depending on whether this is a relocatable Emacs.app.
+ns_self_contained=@ns_self_contained@
+
# The default location for installation. Everything is placed in
# subdirectories of this directory. The default values for many of
# the variables below are expressed in terms of this one, so you may
@@ -117,30 +122,22 @@ datadir=@datadir@
sharedstatedir=@sharedstatedir@
# Where to install and expect executable files to be run by Emacs
-# rather than directly by users, and other architecture-dependent
-# data. ${archlibdir} is a subdirectory of this.
+# rather than directly by users (and other architecture-dependent
+# data, although Emacs does not have any). The executables
+# are actually installed in ${archlibdir}, which is (normally)
+# a subdirectory of this.
libexecdir=@libexecdir@
# Where to install Emacs's man pages.
-# This used to allow choice of the numeric extension, but this made
-# little sense since the files were always installed in man1/
-# (and they contain cross-references that expect them to be there).
+# Note they contain cross-references that expect them to be in section 1.
mandir=@mandir@
man1dir=$(mandir)/man1
-MAN_PAGES=ctags.1 ebrowse.1 emacs.1 emacsclient.1 etags.1 \
- grep-changelog.1 rcs-checkin.1
-# Where to install and expect the info files describing Emacs. In the
-# past, this defaulted to a subdirectory of ${prefix}/lib/emacs, but
-# since there are now many packages documented with the texinfo
-# system, it is inappropriate to imply that it is part of Emacs.
+# Where to install and expect the info files describing Emacs.
infodir=@infodir@
-INFO_FILES=ada-mode auth autotype calc ccmode cl dbus dired-x ebrowse \
- ede ediff edt eieio efaq eintr elisp emacs emacs-mime epa erc \
- ert eshell eudc flymake forms gnus idlwave info mairix-el \
- message mh-e newsticker nxml-mode org pcl-cvs pgg rcirc \
- reftex remember sasl sc semantic ses sieve smtpmail speedbar \
- tramp url vip viper widget woman
+# Info files not in the doc/misc directory (we get those via make echo-info).
+INFO_EXT=@INFO_EXT@
+INFO_NONMISC=emacs$(INFO_EXT) eintr$(INFO_EXT) elisp$(INFO_EXT)
# If no makeinfo was found and configured --without-makeinfo, "no"; else "yes".
HAVE_MAKEINFO=@HAVE_MAKEINFO@
@@ -168,10 +165,6 @@ VPATH=@srcdir@
# Where to find the application default.
x_default_search_path=@x_default_search_path@
-# Location to install Emacs.app under NeXT/Open/GNUstep / Cocoa
-ns_appbindir=@ns_appbindir@
-ns_appresdir=@ns_appresdir@
-
# Where the etc/emacs.desktop file is to be installed.
desktopdir=$(datarootdir)/applications
@@ -186,33 +179,35 @@ iconsrcdir=$(srcdir)/etc/images/icons
# These variables hold the values Emacs will actually use. They are
# based on the values of the standard Make variables above.
-# Where to install the lisp files distributed with
+# Where to install the lisp, leim files distributed with
# Emacs. This includes the Emacs version, so that the
# lisp files for different versions of Emacs will install
# themselves in separate directories.
lispdir=@lispdir@
+leimdir=@leimdir@
-# Directories Emacs should search for lisp files specific
-# to this site (i.e. customizations), before consulting
-# ${lispdir}. This should be a colon-separated list of
-# directories.
+# Directories Emacs should search for standard lisp files.
+# The default is ${lispdir}:${leimdir}.
+standardlisppath=@standardlisppath@
+
+# Directories Emacs should search for lisp files specific to this
+# site (i.e. customizations), before consulting ${standardlisppath}.
+# This should be a colon-separated list of directories.
locallisppath=@locallisppath@
# Where Emacs will search to find its lisp files. Before
# changing this, check to see if your purpose wouldn't
# better be served by changing locallisppath. This
# should be a colon-separated list of directories.
+# The default is ${locallisppath}:${standardlisppath}.
lisppath=@lisppath@
# Where Emacs will search for its lisp files while
# building. This is only used during the process of
# compiling Emacs, to help Emacs find its lisp files
# before they've been installed in their final location.
-# It's usually identical to lisppath, except that
-# it does not include locallisppath, and the
-# entry for the directory containing the installed lisp
-# files has been replaced with ../lisp. This should be a
-# colon-separated list of directories.
+# This should be a colon-separated list of directories.
+# Normally it points to the lisp/ directory in the sources.
buildlisppath=${srcdir}/lisp
# Where to install the other architecture-independent
@@ -239,12 +234,19 @@ gamedir=@gamedir@
# ==================== Utility Programs for the Build ====================
# Allow the user to specify the install program.
+# Note that if the system does not provide a suitable install,
+# configure will use build-aux/install-sh. Annoyingly, it does
+# not use an absolute path. So we must take care to always run
+# INSTALL-type commands from the directory containing the Makefile.
+# This explains (I think) the cd thisdir seen in several install rules.
INSTALL = @INSTALL@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_INFO = @INSTALL_INFO@
# By default, we uphold the dignity of our programs.
INSTALL_STRIP =
+MKDIR_P = @MKDIR_P@
+LN_S = @LN_S@
# We use gzip to compress installed .el files.
GZIP_PROG = @GZIP_PROG@
@@ -257,17 +259,12 @@ GZIP_INFO = @GZIP_INFO@
TRANSFORM = @program_transform_name@
# What emacs should be called when installed.
-EMACS = `echo emacs${EXEEXT} | sed '$(TRANSFORM)'`
-EMACSFULL = `echo emacs-${version}${EXEEXT} | sed '$(TRANSFORM)'`
+EMACS_NAME = `echo emacs | sed '$(TRANSFORM)'`
+EMACS = ${EMACS_NAME}${EXEEXT}
+EMACSFULL = `echo emacs-${version} | sed '$(TRANSFORM)'`${EXEEXT}
-# Subdirectories to make recursively. `lisp' is not included
-# because the compiled lisp files are part of the distribution.
-# leim is not included because it needs special handling.
-#
-# Actually, we now include `lisp' as well, since the compiled files
-# are not included any more in case of bootstrap or in case Emacs was
-# checked out from a VCS.
-SUBDIR = lib lib-src src lisp
+# Subdirectories to make recursively.
+SUBDIR = lib lib-src src lisp leim
# The subdir makefiles created by config.status.
SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@
@@ -275,28 +272,31 @@ SUBDIR_MAKEFILES = `echo $(SUBDIR_MAKEFILES_IN:.in=) | sed 's|$(srcdir)/||g'`
# Subdirectories to install, and where they'll go.
# lib-src's makefile knows how to install it, so we don't do that here.
-# leim's makefile also knows how to install it, so we don't do that here.
-# When installing the info files, we need to do special things to
-# avoid nuking an existing dir file, so we don't do that here;
-# instead, we have written out explicit code in the `install' targets.
-COPYDIR = ${srcdir}/etc ${srcdir}/lisp
-COPYDESTS = $(DESTDIR)${etcdir} $(DESTDIR)${lispdir}
+# Directories that cannot simply be copied, eg info,
+# are treated separately.
+# quail appears twice because in out-of-tree builds, it exists twice.
+COPYDIR = ${srcdir}/etc ${srcdir}/lisp ${srcdir}/leim/ja-dic ${srcdir}/leim/quail leim/quail
+COPYDESTS = $(DESTDIR)${etcdir} $(DESTDIR)${lispdir} $(DESTDIR)${leimdir}/ja-dic $(DESTDIR)${leimdir}/quail $(DESTDIR)${leimdir}/quail
+
+all: ${SUBDIR}
-all: ${SUBDIR} leim
+.PHONY: all ${SUBDIR} blessmail epaths-force FRC
removenullpaths=sed -e 's/^://g' -e 's/:$$//g' -e 's/::/:/g'
# Generate epaths.h from epaths.in. This target is invoked by `configure'.
-# See comments in configure.in for why it is done this way, as opposed
+# See comments in configure.ac for why it is done this way, as opposed
# to just letting configure generate epaths.h from epaths.in in a
# similar way to how Makefile is made from Makefile.in.
epaths-force: FRC
- @(lisppath=`echo ${lisppath} | ${removenullpaths}` ; \
- buildlisppath=`echo ${buildlisppath} | ${removenullpaths}` ; \
+ @(standardlisppath=`echo "${standardlisppath}" | ${removenullpaths}` ; \
+ locallisppath=`echo "${locallisppath}" | ${removenullpaths}` ; \
+ buildlisppath=`echo "${buildlisppath}" | ${removenullpaths}` ; \
x_default_search_path=`echo ${x_default_search_path}`; \
gamedir=`echo ${gamedir}`; \
sed < ${srcdir}/src/epaths.in > epaths.h.$$$$ \
- -e 's;\(#.*PATH_LOADSEARCH\).*$$;\1 "'"$${lisppath}"'";' \
+ -e 's;\(#.*PATH_LOADSEARCH\).*$$;\1 "'"$${standardlisppath}"'";' \
+ -e 's;\(#.*PATH_SITELOADSEARCH\).*$$;\1 "'"$${locallisppath}"'";' \
-e 's;\(#.*PATH_DUMPLOADSEARCH\).*$$;\1 "'"$${buildlisppath}"'";' \
-e 's;\(#.*PATH_EXEC\).*$$;\1 "${archlibdir}";' \
-e 's;\(#.*PATH_INFO\).*$$;\1 "${infodir}";' \
@@ -307,63 +307,17 @@ epaths-force: FRC
-e 's;\(#.*PATH_DOC\).*$$;\1 "${docdir}";') && \
${srcdir}/build-aux/move-if-change epaths.h.$$$$ src/epaths.h
-# For parallel make, src should be built before leim.
-# "export PARALLEL=0" is for SGI's Make, to prevent it from
-# running more than 1 process in the leim directory, especially for
-# the $TIT files there.
-leim: src Makefile FRC
- (export PARALLEL; PARALLEL=0; cd $@; $(MAKE) all $(MFLAGS) \
- CC='${CC}' CFLAGS='${CFLAGS}' CPPFLAGS='${CPPFLAGS}' \
- LDFLAGS='${LDFLAGS}' MAKE='${MAKE}')
-
lib-src src: lib
src: lib-src FRC
-.RECURSIVE: ${SUBDIR} leim
-
-# We need to build `emacs' in `src' to compile the *.elc files in `lisp'.
-lisp: src
-
-# Maintainers can put a copy of gnulib into $(gnulib_srcdir).
-gnulib_srcdir = ../gnulib
-$(gnulib_srcdir):
- git clone git://git.savannah.gnu.org/gnulib.git $@
-
-# A shorter name that satisfies MS-DOS 8+3 constraints.
-DOS_gnulib_comp.m4 = gl-comp.m4
-
-# Update modules from gnulib, for maintainers, who should have it in
-# $(gnulib_srcdir) (relative to $(srcdir) and should have build tools
-# as per $(gnulib_srcdir)/DEPENDENCIES.
-GNULIB_MODULES = \
- alloca-opt \
- careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr \
- dup2 \
- filemode getloadavg getopt-gnu ignore-value intprops lstat \
- mktime pthread_sigmask readlink \
- socklen stdarg stdio strftime strtoimax strtoumax symlink sys_stat
-GNULIB_TOOL_FLAGS = \
- --avoid=msvc-inval --avoid=msvc-nothrow --avoid=pathmax \
- --avoid=raise --avoid=threadlib \
- --conditional-dependencies --import --no-changelog --no-vc-files \
- --makefile-name=gnulib.mk
-sync-from-gnulib: $(gnulib_srcdir)
- -cd $(srcdir)/m4 && cp $(DOS_gnulib_comp.m4) gnulib-comp.m4
- cd $(srcdir) && \
- $(gnulib_srcdir)/gnulib-tool $(GNULIB_TOOL_FLAGS) $(GNULIB_MODULES)
- cd $(srcdir)/m4 && rm gnulib-cache.m4 warn-on-use.m4
- cd $(srcdir)/m4 && mv gnulib-comp.m4 $(DOS_gnulib_comp.m4)
- cp $(gnulib_srcdir)/build-aux/texinfo.tex $(srcdir)/doc/misc
- cp \
- $(gnulib_srcdir)/build-aux/move-if-change \
- $(srcdir)/build-aux
- cd $(srcdir) && autoreconf -i -I m4
-.PHONY: sync-from-gnulib
+# We need to build `emacs' in `src' to compile the *.elc files in `lisp'
+# and `leim'.
+lisp leim: src
# These targets should be "${SUBDIR} without `src'".
-lib lib-src lisp: Makefile FRC
- cd $@; $(MAKE) all $(MFLAGS) \
+lib lib-src lisp leim: Makefile FRC
+ cd $@ && $(MAKE) all $(MFLAGS) \
CC='${CC}' CFLAGS='${CFLAGS}' CPPFLAGS='${CPPFLAGS}' \
LDFLAGS='${LDFLAGS}' MAKE='${MAKE}'
@@ -392,38 +346,52 @@ src: Makefile FRC
VCSWITNESS="$$vcswitness"
blessmail: Makefile src FRC
- cd lib-src; $(MAKE) maybe-blessmail $(MFLAGS) \
+ cd lib-src && $(MAKE) maybe-blessmail $(MFLAGS) \
MAKE='${MAKE}' archlibdir='$(archlibdir)'
# We used to have one rule per */Makefile.in, but that leads to race
# conditions with parallel makes, so let's assume that the time stamp on
# ./Makefile is representative of the time stamp on all the other Makefiles.
-Makefile: config.status $(srcdir)/src/config.in \
- $(srcdir)/Makefile.in $(SUBDIR_MAKEFILES_IN)
- ./config.status
+#
+# config.status overrides MAKEFILE_NAME with a bogus name when creating
+# src/epaths.h, so that 'make epaths-force' does not recursively invoke
+# config.status and overwrite config.status while executing it (Bug#11214).
+#
+# 'make bootstrap' overrides MAKEFILE_NAME to a nonexistent file but
+# then attempts to build that file. This forces 'Makefile', 'lib/Makefile',
+# etc. to be built without running into similar recursion problems.
+MAKEFILE_NAME = Makefile
+$(MAKEFILE_NAME): config.status $(srcdir)/src/config.in \
+ $(srcdir)/Makefile.in $(SUBDIR_MAKEFILES_IN) $(srcdir)/src/lisp.mk
+ MAKE='$(MAKE)' ./config.status
-# Don't erase config.status if make is interrupted while refreshing it.
-.PRECIOUS: config.status
+# Don't erase these files if make is interrupted while refreshing them.
+.PRECIOUS: Makefile config.status
config.status: ${srcdir}/configure ${srcdir}/lisp/version.el
if [ -x ./config.status ]; then \
./config.status --recheck; \
else \
- ./configure $(CONFIGURE_FLAGS); \
+ $(srcdir)/configure $(CONFIGURE_FLAGS); \
fi
-AUTOCONF_INPUTS = @MAINT@ $(srcdir)/configure.in $(srcdir)/aclocal.m4
+AUTOCONF_INPUTS = $(srcdir)/configure.ac $(srcdir)/aclocal.m4
$(srcdir)/configure: $(AUTOCONF_INPUTS)
cd ${srcdir} && autoconf
-ACLOCAL_INPUTS = @MAINT@ $(srcdir)/m4/$(DOS_gnulib_comp.m4)
+ACLOCAL_INPUTS = $(srcdir)/m4/gnulib-comp.m4
$(srcdir)/aclocal.m4: $(ACLOCAL_INPUTS)
cd $(srcdir) && aclocal -I m4
-AUTOMAKE_INPUTS = @MAINT@ $(srcdir)/aclocal.m4 $(srcdir)/lib/Makefile.am $(srcdir)/lib/gnulib.mk
+AUTOMAKE_INPUTS = $(srcdir)/aclocal.m4 $(srcdir)/lib/Makefile.am \
+ $(srcdir)/lib/gnulib.mk
$(srcdir)/lib/Makefile.in: $(AUTOMAKE_INPUTS)
cd $(srcdir) && automake --gnu -a -c lib/Makefile
+
+# Regenerate files that this makefile would have made, if this makefile
+# had been built by Automake. The name 'am--refresh' is for
+# compatibility with subsidiary Automake-generated makefiles.
am--refresh: $(srcdir)/aclocal.m4 $(srcdir)/configure $(srcdir)/src/config.in
.PHONY: am--refresh
@@ -440,55 +408,62 @@ $(srcdir)/src/stamp-h.in: $(AUTOCONF_INPUTS)
# ==================== Installation ====================
+.PHONY: install install-arch-dep install-arch-indep install-doc install-info
+.PHONY: install-man install-etc install-strip uninstall
+
## If we let lib-src do its own installation, that means we
## don't have to duplicate the list of utilities to install in
## this Makefile as well.
-## On AIX, use tar xBf.
-## On Xenix, use tar xpf.
-
-.PHONY: install mkdir
-
-## We delete each directory in ${COPYDESTS} before we copy into it;
-## that way, we can reinstall over directories that have been put in
-## place with their files read-only (perhaps because they are checked
-## into RCS). In order to make this safe, we make sure that the
-## source exists and is distinct from the destination.
-### We do install-arch-indep first because
-### the executable needs the Lisp files and DOC file to work properly.
-install: all install-arch-indep install-arch-dep install-leim blessmail
+install: all install-arch-indep install-doc install-arch-dep blessmail
@true
-MV_DIRS = for i in $$dir; do rm -fr `basename "$$i"` ; mv "$$i" . ; done
+## Ensure that $subdir contains a subdirs.el file.
+## Here and elsewhere, we set the umask so that any created files are
+## world-readable.
+## TODO it might be good to warn about non-standard permissions of
+## pre-existing directories, but that does not seem easy.
+write_subdir=if [ -f $${subdir}/subdirs.el ]; \
+ then true; \
+ else \
+ umask 022; \
+ ${MKDIR_P} $${subdir}; \
+ (echo "(if (fboundp 'normal-top-level-add-subdirs-to-load-path)"; \
+ echo " (normal-top-level-add-subdirs-to-load-path))") \
+ > $${subdir}/subdirs.el; \
+ fi
### Install the executables that were compiled specifically for this machine.
-### It would be nice to do something for a parallel make
-### to ensure that install-arch-indep finishes before this starts.
-install-arch-dep: mkdir
- (cd lib-src; \
+### We do install-arch-indep first because the executable needs the
+### Lisp files and DOC file to work properly.
+install-arch-dep: src install-arch-indep install-doc
+ umask 022; ${MKDIR_P} $(DESTDIR)${bindir}
+ cd lib-src && \
$(MAKE) install $(MFLAGS) prefix=${prefix} \
exec_prefix=${exec_prefix} bindir=${bindir} \
libexecdir=${libexecdir} archlibdir=${archlibdir} \
- INSTALL_STRIP=${INSTALL_STRIP})
- ${INSTALL_PROGRAM} $(INSTALL_STRIP) src/emacs${EXEEXT} $(DESTDIR)${bindir}/$(EMACSFULL)
- -chmod 1755 $(DESTDIR)${bindir}/$(EMACSFULL)
- rm -f $(DESTDIR)${bindir}/$(EMACS)
- -ln $(DESTDIR)${bindir}/$(EMACSFULL) $(DESTDIR)${bindir}/$(EMACS)
- if test "${ns_appresdir}" != ""; then \
- ( cd ${ns_appresdir} ; \
- if test -d share/emacs ; then dir=share/emacs/*/*; $(MV_DIRS); fi;\
- if test -d share/info ; then dir=share/info; $(MV_DIRS) ; fi ; \
- rm -fr share ) ; \
- ( cd ${ns_appbindir} ; \
- if cd libexec ; then dir=emacs/*/*/* ; $(MV_DIRS); \
- rm -fr emacs; if cd ../bin; then rm -f emacs emacs-24*; \
- ln -sf ../libexec/* . ; fi ; fi ) ; \
- else true ; fi
-
-## FIXME is the emacs-24* bit above really necessary and correct?
-## What if I have 24.1 and 24.2 installed at the same time?
-## In any case, it should use something like echo $version | sed 's/\..*//'
-## instead of hard-coding a version.
+ INSTALL_STRIP=${INSTALL_STRIP}
+ if test "${ns_self_contained}" = "no"; then \
+ ${INSTALL_PROGRAM} $(INSTALL_STRIP) src/emacs${EXEEXT} $(DESTDIR)${bindir}/$(EMACSFULL) || exit 1 ; \
+ chmod 1755 $(DESTDIR)${bindir}/$(EMACSFULL) ; \
+ if test "x${NO_BIN_LINK}" = x; then \
+ rm -f $(DESTDIR)${bindir}/$(EMACS) ; \
+ cd $(DESTDIR)${bindir} && $(LN_S) $(EMACSFULL) $(EMACS); \
+ fi; \
+ else \
+ subdir=${ns_appresdir}/site-lisp; \
+ ${write_subdir} || exit 1; \
+ rm -rf ${ns_appresdir}/share; \
+ fi
+
+## In the share directory, we are deleting:
+## applications (with emacs.desktop, also found in etc/)
+## emacs (basically empty except for unneeded site-lisp directories)
+## icons (duplicates etc/images/icons/hicolor)
+
+## This is install-etc for everything except self-contained-ns builds.
+## For them, it is empty.
+INSTALL_ARCH_INDEP_EXTRA = @INSTALL_ARCH_INDEP_EXTRA@
## http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg01672.html
## Needs to be the user running install, so configure can't set it.
@@ -498,80 +473,113 @@ set_installuser=for installuser in $${LOGNAME} $${USERNAME} $${USER} \
done
### Install the files that are machine-independent.
-### Most of them come straight from the distribution;
-### the exception is the DOC-* files, which are copied
-### from the build directory.
+### Most of them come straight from the distribution; the exception is
+### the DOC file, which is copied from the build directory.
-## Note that we copy DOC* and then delete DOC
-## as a workaround for a bug in tar on Ultrix 4.2.
-
-## We install only the relevant DOC file if possible
-## (ie DOC-${version}.buildnumber), otherwise DOC-${version}*.
+## We delete each directory in ${COPYDESTS} before we copy into it;
+## that way, we can reinstall over directories that have been put in
+## place with their files read-only (perhaps because they are checked
+## into RCS). In order to make this safe, we make sure that the
+## source exists and is distinct from the destination.
-## If people complain about the h flag in tar command, take that out.
-## That flag is also used in leim/Makefile.in
+## We delete etc/DOC* because there may be irrelevant DOC files from
+## other builds in the source directory. This is ok because we just
+## deleted the entire installed etc/ directory and recreated it.
+## install-doc installs the relevant DOC.
## Note that the Makefiles in the etc directory are potentially useful
## in an installed Emacs, so should not be excluded.
-install-arch-indep: mkdir info install-etc
- -set ${COPYDESTS} ; \
- unset CDPATH; \
- for dir in ${COPYDIR} ; do \
- if [ `(cd $$1 && /bin/pwd)` != `(cd $${dir} && /bin/pwd)` ] ; then \
- rm -rf $$1 ; \
- fi ; \
- shift ; \
+## I'm not sure creating locallisppath here serves any useful purpose.
+## If it has the default value, then the later write_subdir commands
+## will ensure all these components exist.
+## This will only do something if locallisppath has a non-standard value.
+## Is it really Emacs's job to create those directories?
+## Should we also be ensuring they contain subdirs.el files?
+## It would be easy to do, just use write_subdir.
+
+## Note that we use tar instead of plain old cp -R/-r because the latter
+## is apparently not portable (even in 2012!).
+## http://lists.gnu.org/archive/html/emacs-devel/2012-05/msg00278.html
+## I have no idea which platforms Emacs supports where cp -R does not
+## work correctly, and therefore no idea when tar can be replaced.
+## See also these comments from 2004 about cp -r working fine:
+## http://lists.gnu.org/archive/html/autoconf-patches/2004-11/msg00005.html
+install-arch-indep: lisp leim install-info install-man ${INSTALL_ARCH_INDEP_EXTRA}
+ umask 022 ; \
+ locallisppath='${locallisppath}'; \
+ IFS=:; \
+ for d in $$locallisppath; do \
+ ${MKDIR_P} "$(DESTDIR)$$d"; \
done
-set ${COPYDESTS} ; \
- mkdir ${COPYDESTS} ; \
- chmod ugo+rx ${COPYDESTS} ; \
unset CDPATH; \
$(set_installuser); \
for dir in ${COPYDIR} ; do \
+ [ -d $${dir} ] || exit 1 ; \
dest=$$1 ; shift ; \
- [ -d $${dir} ] \
- && [ `(cd $${dir} && /bin/pwd)` != `(cd $${dest} && /bin/pwd)` ] \
- && (echo "Copying $${dir} to $${dest}..." ; \
- (cd $${dir}; tar -chf - . ) \
- | (cd $${dest}; umask 022; \
- tar -xvf - && cat > /dev/null) || exit 1; \
- find $${dest} -exec chown $${installuser} {} ';' ;\
- for subdir in `find $${dest} -type d -print` ; do \
- chmod a+rx $${subdir} ; \
- rm -f $${subdir}/.gitignore ; \
- rm -f $${subdir}/.arch-inventory ; \
- rm -f $${subdir}/.DS_Store ; \
- rm -f $${subdir}/\#* ; \
- rm -f $${subdir}/.\#* ; \
- rm -f $${subdir}/*~ ; \
- rm -f $${subdir}/*.orig ; \
- [ "$${dir}" != "${srcdir}/etc" ] && \
- rm -f $${subdir}/[mM]akefile*.c $${subdir}/[mM]akefile*[.-]in \
- $${subdir}/[mM]akefile ; \
- rm -f $${subdir}/ChangeLog* ; \
- done) ; \
+ [ -d $${dest} ] && \
+ [ `cd $${dest} && /bin/pwd` = `cd $${dir} && /bin/pwd` ] && \
+ continue ; \
+ if [ "$${dir}" = "leim/quail" ]; then \
+ [ `cd $${dir} && /bin/pwd` = `cd ${srcdir}/leim/quail && /bin/pwd` ] && \
+ continue ; \
+ else \
+ rm -rf $${dest} ; \
+ umask 022; ${MKDIR_P} $${dest} ; \
+ fi ; \
+ echo "Copying $${dir} to $${dest}..." ; \
+ (cd $${dir}; tar -chf - . ) \
+ | (cd $${dest}; umask 022; \
+ tar -xvf - && cat > /dev/null) || exit 1; \
+ [ "$${dir}" != "${srcdir}/etc" ] || rm -f $${dest}/DOC* ; \
+ for subdir in `find $${dest} -type d -print` ; do \
+ rm -f $${subdir}/.gitignore ; \
+ rm -f $${subdir}/.arch-inventory ; \
+ rm -f $${subdir}/.DS_Store ; \
+ rm -f $${subdir}/\#* ; \
+ rm -f $${subdir}/.\#* ; \
+ rm -f $${subdir}/*~ ; \
+ rm -f $${subdir}/*.orig ; \
+ rm -f $${subdir}/ChangeLog* ; \
+ [ "$${dir}" != "${srcdir}/etc" ] && \
+ rm -f $${subdir}/[mM]akefile*[.-]in $${subdir}/[mM]akefile ; \
+ done ; \
+ find $${dest} -exec chown $${installuser} {} ';' ;\
done
+ -rm -f $(DESTDIR)${leimdir}/leim-list.el
+ ${INSTALL_DATA} leim/leim-list.el $(DESTDIR)${leimdir}/leim-list.el
-rm -f $(DESTDIR)${lispdir}/subdirs.el
- $(srcdir)/update-subdirs $(DESTDIR)${lispdir}
- if [ -f $(DESTDIR)${datadir}/emacs/${version}/site-lisp/subdirs.el ]; \
- then true; \
- else \
- (echo "(if (fboundp 'normal-top-level-add-subdirs-to-load-path)"; \
- echo " (normal-top-level-add-subdirs-to-load-path))") \
- > $(DESTDIR)${datadir}/emacs/${version}/site-lisp/subdirs.el; \
- fi
- chmod a+r $(DESTDIR)${datadir}/emacs/${version}/site-lisp/subdirs.el
- -if [ -f $(DESTDIR)${datadir}/emacs/site-lisp/subdirs.el ]; \
- then true; \
- else \
- (echo "(if (fboundp 'normal-top-level-add-subdirs-to-load-path)"; \
- echo " (normal-top-level-add-subdirs-to-load-path))") \
- > $(DESTDIR)${datadir}/emacs/site-lisp/subdirs.el; \
- fi
- -chmod a+r $(DESTDIR)${datadir}/emacs/site-lisp/subdirs.el
+ umask 022; $(srcdir)/build-aux/update-subdirs $(DESTDIR)${lispdir}
+ subdir=$(DESTDIR)${datadir}/emacs/${version}/site-lisp ; \
+ ${write_subdir}
+ subdir=$(DESTDIR)${datadir}/emacs/site-lisp ; \
+ ${write_subdir} || true
+ [ -z "${GZIP_PROG}" ] || \
+ ( echo "Compressing *.el ..." ; \
+ unset CDPATH; \
+ thisdir=`/bin/pwd`; \
+ for dir in $(DESTDIR)${lispdir} $(DESTDIR)${leimdir}; do \
+ cd $${thisdir} ; \
+ cd $${dir} || exit 1 ; \
+ for f in `find . -name "*.elc" -print`; do \
+ ${GZIP_PROG} -9n `echo $$f|sed 's/.elc$$/.el/'` ; \
+ done ; \
+ done )
+ -chmod -R a+r $(DESTDIR)${datadir}/emacs/${version} ${COPYDESTS}
+
+# The last chmod isn't needed at present.
+
+## We install only the relevant DOC file if possible
+## (ie DOC-${version}.buildnumber), otherwise DOC-${version}*.
+## (Note "otherwise" is inaccurate since 2009-08-23.)
+
+## Note that install-arch-indep deletes and recreates the entire
+## installed etc/ directory, so we need it to run before this does.
+install-doc: src install-arch-indep
-unset CDPATH; \
- if [ `(cd ./etc; /bin/pwd)` != `(cd $(DESTDIR)${docdir}; /bin/pwd)` ]; \
+ umask 022; ${MKDIR_P} $(DESTDIR)${docdir} ; \
+ if [ `cd ./etc; /bin/pwd` != `cd $(DESTDIR)${docdir}; /bin/pwd` ]; \
then \
fullversion=`./src/emacs --version | sed -n '1 s/GNU Emacs *//p'`; \
if [ -f "./etc/DOC-$${fullversion}" ]; \
@@ -581,142 +589,96 @@ install-arch-indep: mkdir info install-etc
docfile="DOC"; \
fi; \
echo "Copying etc/$${docfile} to $(DESTDIR)${docdir} ..." ; \
- (cd ./etc; tar -chf - $${docfile}) \
- |(cd $(DESTDIR)${docdir}; umask 022; tar -xvf - && cat > /dev/null) || exit 1; \
- (cd $(DESTDIR)$(docdir); \
- $(set_installuser); \
- chown $${installuser} DOC*; chmod a+r DOC*; \
- if test "`echo DOC-*`" != "DOC-*"; then rm -f DOC; fi); \
- else true; fi
- -unset CDPATH; \
- if [ -r ./lisp ] \
- && [ -r ./lisp/simple.el ] \
- && [ x`(cd ./lisp; /bin/pwd)` != x`(cd $(DESTDIR)${lispdir}; /bin/pwd)` ] \
- && [ x`(cd ${srcdir}/lisp; /bin/pwd)` != x`(cd ./lisp; /bin/pwd)` ]; \
- then \
- echo "Copying lisp/*.el and lisp/*.elc to $(DESTDIR)${lispdir} ..." ; \
- (cd lisp; tar -chf - *.el *.elc) \
- |(cd $(DESTDIR)${lispdir}; umask 022; tar -xvf - && cat > /dev/null) || exit 1; \
- (cd $(DESTDIR)${lispdir}; \
- $(set_installuser); \
- find . -exec chown $${installuser} {} ';') ; \
- else true; fi
- -unset CDPATH; \
- if [ -n "${GZIP_PROG}" ]; \
- then \
- echo "Compressing *.el ..." ; \
- (cd $(DESTDIR)${lispdir}; for f in `find . -name "*.elc" -print`; do \
- ${GZIP_PROG} -9n `echo $$f|sed 's/.elc$$/.el/'` ; \
- done) \
+ ${INSTALL_DATA} etc/$${docfile} $(DESTDIR)${docdir}/$${docfile}; \
+ $(set_installuser); \
+ chown $${installuser} $(DESTDIR)${docdir}/$${docfile} || true ; \
else true; fi
+
+install-info: info
+ umask 022; ${MKDIR_P} $(DESTDIR)${infodir}
-unset CDPATH; \
thisdir=`/bin/pwd`; \
- if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd $(DESTDIR)${infodir} && /bin/pwd)` ]; \
- then \
+ [ `cd ${srcdir}/info && /bin/pwd` = `cd $(DESTDIR)${infodir} && /bin/pwd` ] || \
(cd $(DESTDIR)${infodir}; \
- if [ -f dir ]; then true; \
- else \
+ [ -f dir ] || \
(cd $${thisdir}; \
- ${INSTALL_DATA} ${srcdir}/info/dir $(DESTDIR)${infodir}/dir; \
- chmod a+r $(DESTDIR)${infodir}/dir); \
- fi; \
+ ${INSTALL_DATA} ${srcdir}/info/dir $(DESTDIR)${infodir}/dir) ; \
+ info_misc=`cd $${thisdir}/doc/misc; ${MAKE} echo-info | sed '/ing directory/d'`; \
cd ${srcdir}/info ; \
- for elt in $(INFO_FILES); do \
+ for elt in ${INFO_NONMISC} $${info_misc}; do \
test "$(HAVE_MAKEINFO)" = "no" && test ! -f $$elt && continue; \
for f in `ls $$elt $$elt-[1-9] $$elt-[1-9][0-9] 2>/dev/null`; do \
- ${INSTALL_DATA} $$f $(DESTDIR)${infodir}/$$f; \
- chmod a+r $(DESTDIR)${infodir}/$$f; \
- if [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ]; then \
- rm -f $(DESTDIR)${infodir}/$$f.gz; \
- ${GZIP_PROG} -9n $(DESTDIR)${infodir}/$$f; \
- else true; fi; \
+ (cd $${thisdir}; \
+ ${INSTALL_DATA} ${srcdir}/info/$$f $(DESTDIR)${infodir}/$$f); \
+ ( [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ] ) || continue ; \
+ rm -f $(DESTDIR)${infodir}/$$f.gz; \
+ ${GZIP_PROG} -9n $(DESTDIR)${infodir}/$$f; \
done; \
- done); \
- else true; fi
- -unset CDPATH; \
- thisdir=`/bin/pwd`; \
- if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd $(DESTDIR)${infodir} && /bin/pwd)` ]; \
- then \
- for elt in $(INFO_FILES); do \
- test "$(HAVE_MAKEINFO)" = "no" && test ! -f $$elt && continue; \
- (cd $${thisdir}; \
- ${INSTALL_INFO} --info-dir=$(DESTDIR)${infodir} $(DESTDIR)${infodir}/$$elt); \
- done; \
- else true; fi
- -chmod -R a+r $(DESTDIR)${datadir}/emacs/${version} ${COPYDESTS}
+ (cd $${thisdir}; \
+ ${INSTALL_INFO} --info-dir=$(DESTDIR)${infodir} $(DESTDIR)${infodir}/$$elt); \
+ done)
+
+install-man:
+ umask 022; ${MKDIR_P} $(DESTDIR)${man1dir}
thisdir=`/bin/pwd`; \
cd ${mansrcdir}; \
- for page in ${MAN_PAGES}; do \
+ for page in *.1; do \
+ dest=`echo "$${page}" | sed -e 's/\.1$$//' -e '$(TRANSFORM)'`.1; \
(cd $${thisdir}; \
- ${INSTALL_DATA} ${mansrcdir}/$${page} $(DESTDIR)${man1dir}/$${page}; \
- chmod a+r $(DESTDIR)${man1dir}/$${page}; \
- if [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ]; then \
- rm -f $(DESTDIR)${man1dir}/$${page}.gz; \
- ${GZIP_PROG} -9n $(DESTDIR)${man1dir}/$${page}; \
- else true; fi ); \
+ ${INSTALL_DATA} ${mansrcdir}/$${page} $(DESTDIR)${man1dir}/$${dest}); \
+ ( [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ] ) || continue ; \
+ rm -f $(DESTDIR)${man1dir}/$${dest}.gz; \
+ ${GZIP_PROG} -9n $(DESTDIR)${man1dir}/$${dest}; \
done
## Install those items from etc/ that need to end up elsewhere.
-install-etc: mkdir
- ${INSTALL_DATA} ${srcdir}/etc/emacs.desktop \
- $(DESTDIR)${desktopdir}/emacs.desktop
- for icon in $(iconsrcdir)/*/*/apps/*.* \
- $(iconsrcdir)/*/*/mimetypes/*.*; do \
- if [ -r $${icon} ]; then \
- iicon=`echo "$${icon}" | sed 's,$(srcdir)/etc/images/icons,$(DESTDIR)${icondir},'` ; \
- ${INSTALL_DATA} $${icon} $${iicon} ; \
- fi ; \
- done
-### Install LEIM files. Although they are machine-independent, we
-### have separate target here instead of including it in
-### `install-arch-indep'. People who extracted LEIM files after they
-### installed Emacs itself can install only LEIM files by this target.
-install-leim: leim/Makefile mkdir
- cd leim; $(MAKE) install
+## If you prefer, choose "emacs22" at installation time.
+## Note: emacs22 does not have all the resolutions.
+EMACS_ICON=emacs
+
+install-etc:
+ umask 022; ${MKDIR_P} $(DESTDIR)${desktopdir}
+ tmp=etc/emacs.tmpdesktop; rm -f $${tmp}; \
+ emacs_name=`echo emacs | sed '$(TRANSFORM)'`; \
+ sed -e "/^Exec=emacs/ s/emacs/$${emacs_name}/" \
+ -e "/^Icon=emacs/ s/emacs/$${emacs_name}/" \
+ ${srcdir}/etc/emacs.desktop > $${tmp}; \
+ ${INSTALL_DATA} $${tmp} $(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop; \
+ rm -f $${tmp}
+ thisdir=`/bin/pwd`; \
+ cd ${iconsrcdir} || exit 1; umask 022 ; \
+ for dir in */*/apps */*/mimetypes; do \
+ [ -d $${dir} ] || continue ; \
+ ( cd $${thisdir}; ${MKDIR_P} $(DESTDIR)${icondir}/$${dir} ) ; \
+ for icon in $${dir}/${EMACS_ICON}[.-]*; do \
+ [ -r $${icon} ] || continue ; \
+ ext=`echo "$${icon}" | sed -e 's|.*\.||'`; \
+ dest=`echo "$${icon}" | sed -e 's|.*/||' -e "s|\.$${ext}$$||" -e 's/$(EMACS_ICON)/emacs/' -e '$(TRANSFORM)'`.$${ext} ; \
+ ( cd $${thisdir}; \
+ ${INSTALL_DATA} ${iconsrcdir}/$${icon} $(DESTDIR)${icondir}/$${dir}/$${dest} ) \
+ || exit 1; \
+ done ; \
+ done
### Build Emacs and install it, stripping binaries while installing them.
install-strip:
- $(MAKE) INSTALL_STRIP=-s install
-
-### Build all the directories we're going to install Emacs in. Since
-### we may be creating several layers of directories (for example,
-### /usr/local/lib/emacs/19.0/mips-dec-ultrix4.2), we use install-sh -d
-### instead of mkdir. Not all systems' mkdir programs have the `-p' flag.
-### We set the umask so that any created directories are world-readable.
-### FIXME it would be good to warn about non-standard permissions of
-### pre-existing directories, but that does not seem easy.
-mkdir: FRC
- icondirs= ; \
- for dir in $(iconsrcdir)/*/*/apps $(iconsrcdir)/*/*/mimetypes; do \
- if [ -d $${dir} ]; then \
- icondirs="$${icondirs} $${dir}" ; \
- fi ; \
- done ; \
- icondirs=`echo "$${icondirs}" | sed 's,$(srcdir)/etc/images/icons,$(DESTDIR)${icondir},g'` ; \
- umask 022 ; \
- $(srcdir)/build-aux/install-sh -d $(DESTDIR)${datadir} ${COPYDESTS} \
- $(DESTDIR)${infodir} $(DESTDIR)${man1dir} \
- $(DESTDIR)${bindir} $(DESTDIR)${docdir} $(DESTDIR)${libexecdir} \
- $(DESTDIR)${datadir}/emacs/site-lisp \
- $(DESTDIR)${datadir}/emacs/${version}/site-lisp \
- $(DESTDIR)`echo ${locallisppath} | sed 's,:, $(DESTDIR),g'` \
- $(DESTDIR)${desktopdir} $${icondirs}
+ $(MAKE) $(MFLAGS) INSTALL_STRIP=-s install
### Delete all the installed files that the `install' target would
### create (but not the noninstalled files such as `make all' would create).
###
### Don't delete the lisp and etc directories if they're in the source tree.
uninstall:
- (cd lib-src; \
+ cd lib-src && \
$(MAKE) $(MFLAGS) uninstall \
prefix=${prefix} exec_prefix=${exec_prefix} \
- bindir=${bindir} libexecdir=${libexecdir} archlibdir=${archlibdir})
+ bindir=${bindir} libexecdir=${libexecdir} archlibdir=${archlibdir}
-unset CDPATH; \
for dir in $(DESTDIR)${lispdir} $(DESTDIR)${etcdir} ; do \
if [ -d $${dir} ]; then \
- case `(cd $${dir} ; /bin/pwd)` in \
- `(cd ${srcdir} ; /bin/pwd)`* ) ;; \
+ case `cd $${dir} ; /bin/pwd` in \
+ `cd ${srcdir} ; /bin/pwd`* ) ;; \
* ) rm -rf $${dir} ;; \
esac ; \
case $${dir} in \
@@ -727,17 +689,30 @@ uninstall:
fi ; \
done
-rm -rf $(DESTDIR)${libexecdir}/emacs/${version}
- (cd $(DESTDIR)${infodir} && \
- for elt in $(INFO_FILES); do \
- $(INSTALL_INFO) --remove --info-dir=. $$elt; \
- for f in `ls $$elt $$elt-[1-9] $$elt-[1-9][0-9] 2>/dev/null`; do \
- rm -f $$f; \
- done; \
- done;)
- (cd $(DESTDIR)${man1dir} && rm -f $(MAN_PAGES))
- (cd $(DESTDIR)${bindir} && rm -f $(EMACSFULL) $(EMACS))
- (cd $(DESTDIR)${icondir} && rm -f hicolor/*x*/apps/emacs.png hicolor/*x*/apps/emacs22.png hicolor/scalable/apps/emacs.svg hicolor/scalable/mimetypes/emacs-document.svg )
- -rm -f $(DESTDIR)${desktopdir}/emacs.desktop
+ thisdir=`/bin/pwd`; \
+ (info_misc=`cd doc/misc; ${MAKE} echo-info | sed '/ing directory/d'`; \
+ if cd $(DESTDIR)${infodir}; then \
+ for elt in ${INFO_NONMISC} $${info_misc}; do \
+ (cd $${thisdir}; \
+ $(INSTALL_INFO) --remove --info-dir=$(DESTDIR)${infodir} $(DESTDIR)${infodir}/$$elt); \
+ if [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ]; then \
+ ext=.gz; else ext=; fi; \
+ rm -f $$elt$$ext $$elt-[1-9]$$ext $$elt-[1-9][0-9]$$ext; \
+ done; \
+ fi)
+ (if [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ]; then \
+ ext=.gz; else ext=; fi; \
+ if cd ${mansrcdir}; then \
+ for page in *.1; do \
+ rm -f $(DESTDIR)${man1dir}/`echo "$${page}" | sed -e 's/\.1$$//' -e '$(TRANSFORM)'`.1$$ext; done; \
+ fi)
+ (cd $(DESTDIR)${bindir} && rm -f $(EMACSFULL) $(EMACS) || true)
+ (if cd $(DESTDIR)${icondir}; then \
+ rm -f hicolor/*x*/apps/${EMACS_NAME}.png \
+ hicolor/scalable/apps/${EMACS_NAME}.svg \
+ hicolor/scalable/mimetypes/`echo emacs-document | sed '$(TRANSFORM)'`.svg; \
+ fi)
+ -rm -f $(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop
for file in snake-scores tetris-scores; do \
file=$(DESTDIR)${gamedir}/$${file}; \
[ -s $${file} ] || rm -f $$file; \
@@ -747,7 +722,7 @@ FRC:
# ==================== Cleaning up and miscellanea ====================
-.PHONY: mostlyclean clean distclean maintainer-clean extraclean
+.PHONY: mostlyclean clean distclean bootstrap-clean maintainer-clean extraclean
### `mostlyclean'
### Like `clean', but may refrain from deleting a few files that people
@@ -775,6 +750,7 @@ mostlyclean: FRC
###
### Delete `.dvi' files here if they are not part of the distribution.
clean: FRC
+ -rm -f etc/emacs.tmpdesktop
(cd src; $(MAKE) $(MFLAGS) clean)
(cd oldXMenu; $(MAKE) $(MFLAGS) clean)
(cd lwlib; $(MAKE) $(MFLAGS) clean)
@@ -785,6 +761,7 @@ clean: FRC
-(cd doc/lispref && $(MAKE) $(MFLAGS) clean)
-(cd doc/lispintro && $(MAKE) $(MFLAGS) clean)
(cd leim; $(MAKE) $(MFLAGS) clean)
+ (cd nextstep && $(MAKE) $(MFLAGS) clean)
### `bootclean'
### Delete all files that need to be remade for a clean bootstrap.
@@ -811,6 +788,7 @@ distclean: FRC
(cd doc/lispintro && $(MAKE) $(MFLAGS) distclean)
(cd leim; $(MAKE) $(MFLAGS) distclean)
(cd lisp; $(MAKE) $(MFLAGS) distclean)
+ (cd nextstep && $(MAKE) $(MFLAGS) distclean)
${top_distclean}
### `bootstrap-clean'
@@ -828,10 +806,9 @@ bootstrap-clean: FRC
-(cd doc/lispintro && $(MAKE) $(MFLAGS) maintainer-clean)
(cd leim; $(MAKE) $(MFLAGS) maintainer-clean)
(cd lisp; $(MAKE) $(MFLAGS) bootstrap-clean)
+ (cd nextstep && $(MAKE) $(MFLAGS) maintainer-clean)
[ ! -f config.log ] || mv -f config.log config.log~
${top_bootclean}
-## configure; make bootstrap replaces the real config.log from configure
-## with the truncated one from config.status. The former is more useful.
### `maintainer-clean'
### Delete everything from the current directory that can be
@@ -857,13 +834,14 @@ maintainer-clean: bootstrap-clean FRC
### the coding standards seem to come from. It's like distclean, but
### it deletes backup and autosave files too.
extraclean:
- for i in ${SUBDIR} leim; do (cd $$i; $(MAKE) $(MFLAGS) extraclean); done
+ for i in ${SUBDIR}; do (cd $$i; $(MAKE) $(MFLAGS) extraclean); done
${top_maintainer_clean}
-rm -f config-tmp-*
-rm -f *~ \#*
# The src subdir knows how to do the right thing
# even when the build directory and source dir are different.
+.PHONY: TAGS tags
TAGS tags: lib lib-src src
cd src; $(MAKE) $(MFLAGS) tags
@@ -878,7 +856,7 @@ check:
dist:
cd ${srcdir}; ./make-dist
-.PHONY: info dvi dist check html
+.PHONY: info dvi dist check html info-real force-info check-info-dir
info-real:
(cd doc/emacs; $(MAKE) $(MFLAGS) info)
@@ -914,6 +892,7 @@ check-info-dir: info
case $${file} in \
*-[0-9]*|COPYING|dir) continue ;; \
esac ; \
+ file=`echo $${file} | sed 's/\.info//'` ; \
grep -q -F ": ($${file})." dir || missing="$${missing} $${file}" ; \
done ; \
if test -n "$${missing}"; then \
@@ -935,14 +914,14 @@ dvi:
.PHONY: bootstrap
-## configure; make bootstrap replaces the real config.log from configure
-## with the truncated one from config.status. The former is more useful.
+# Bootstrapping does the following:
+# * Remove files to start from a bootstrap-clean slate.
+# * Run autogen.sh, falling back on copy_autogen if autogen.sh fails.
+# * Rebuild Makefile, to update the build procedure itself.
+# * Do the actual build.
bootstrap: bootstrap-clean FRC
- if [ -x ./config.status ]; then \
- ./config.status; \
- else \
- ./configure $(CONFIGURE_FLAGS); \
- fi
+ cd $(srcdir) && { ./autogen.sh || autogen/copy_autogen; }
+ $(MAKE) $(MFLAGS) MAKEFILE_NAME=force-Makefile force-Makefile
$(MAKE) $(MFLAGS) info all
.PHONY: check-declare
diff --git a/README b/README
index eda81de1bbe..9153c656dbe 100644
--- a/README
+++ b/README
@@ -1,8 +1,8 @@
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
-This directory tree holds version 24.0.92 of GNU Emacs, the extensible,
+This directory tree holds version 24.3.50 of GNU Emacs, the extensible,
customizable, self-documenting real-time display editor.
The file INSTALL in this directory says how to build and install GNU
@@ -37,13 +37,18 @@ oddities of your processor and operating system. It creates the file
process of building and installing Emacs. See INSTALL for more
detailed information.
-The file `configure.in' is the input used by the autoconf program to
+The file `configure.ac' is the input used by the autoconf program to
construct the `configure' script. Since Emacs has some configuration
requirements that autoconf can't meet directly, and for historical
-reasons, `configure.in' uses an unholy marriage of custom-baked
-configuration code and autoconf macros. If you want to rebuild
-`configure' from `configure.in', you will need to install a recent
-version of autoconf and GNU m4.
+reasons, `configure.ac' uses an unholy marriage of custom-baked
+configuration code and autoconf macros.
+
+The shell script `autogen.sh' generates 'configure' and other files by
+running the GNU build tools autoconf and automake, which in turn use
+GNU m4 and Perl. If you want to use it, you will need to install
+recent versions of these build tools. This should be needed only if
+you edit files like `configure.ac' that specify Emacs's autobuild
+procedure.
The file `Makefile.in' is a template used by `configure' to create
`Makefile'.
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES
index c5f8c7ab31f..20c97f886dd 100644
--- a/admin/CPP-DEFINES
+++ b/admin/CPP-DEFINES
@@ -1,10 +1,21 @@
Here are some of the cpp macros used, together with some short explanation
of their use. Feel free to add more macros and more categories.
+Most of these are from config.in, so it's probably better to put the
+explanations in that file. Ideally, everything would be defined and
+documented in config.in, and this file would not be necessary.
+
** Distinguishing OSes **
+AIX
+_AIX
+BSD4_2
+BSD_SYSTEM
CYGWIN Compiling the Cygwin port.
__CYGWIN__ Ditto
+GNU_LINUX
+HPUX
+IRIX6_5
MSDOS Compiling the MS-DOS port.
__MSDOS__ Ditto.
__DJGPP_MINOR__ Minor version number of the DJGPP library; used only in msdos.c and dosfns.c.
@@ -13,6 +24,10 @@ WINDOWSNT Compiling the native MS-Windows (W32) port.
__MINGW32__ Compiling the W32 port with the MinGW port of GCC.
_MSC_VER Compiling the W32 port with the Microsoft C compiler.
DARWIN_OS Compiling on Mac OS X or pure Darwin (and using s/darwin.h).
+SOLARIS2
+USG
+USG5
+USG5_4
** Distinguishing GUIs **
@@ -25,6 +40,9 @@ HAVE_X_WINDOWS Compile support for X Window system
(It looks like, nowadays, if HAVE_X11 is set, HAVE_X_WINDOWS must
be, and vice versa. At least, this is true for configure, and
msdos; not sure about nt.)
+HAVE_X11R6
+HAVE_X11R6_XIM
+HAVE_X11XTR6
USE_LUCID Use the Lucid toolkit for menus&scrollbars. Requires HAVE_X11.
USE_MOTIF Use the Motif toolkit for menus&scrollbars. Requires HAVE_X11.
USE_GTK Use the Gtk toolkit for menus&scrollbars. Requires HAVE_X11.
@@ -45,12 +63,12 @@ HAVE_PROCFS The /proc filesystem is supported.
REL_ALLOC Compile in the relocatable memory allocator ralloc.c.
SYSTEM_MALLOC Use the system library's malloc.
-subprocesses System can use subprocesses (for M-x shell for example). Defined by default, only MSDOS undefines it.
-USE_LISP_UNION_TYPE Define it in lisp.h to make Lisp_Object be a union type instead of the default int.
+subprocesses System can use subprocesses (for M-x shell for example).
+ Defined by default, only MSDOS undefines it.
+DEBUG_LISP_OBJECT_TYPE Define it in lisp.h enable compile time checks
+ on Lisp_Object use.
-** System specific macros, described in detail in src/s/template.h
-CLASH_DETECTION
-COFF
+** System specific macros
FIRST_PTY_LETTER
HAVE_PTYS
INTERRUPT_INPUT
@@ -59,159 +77,340 @@ SEPCHAR
SYSTEM_TYPE
** Misc macros
-USER_FULL_NAME If defined, overrides the default pw->pw_gecos for getting at the full user name. Only MSDOS overrides the default.
-
-** Replace, the definition is trivial: SWITCH_ENUM_CAST
-
-** Defines from src/m/*.h and src/s/*.h. Some of these might not be used in the code anymore, so they can be removed. The HAVE_* definitions are probably handled by autoconf, so it might be possible to just remove them from src/[sm]/*.h.
+USER_FULL_NAME If defined, overrides the default pw->pw_gecos for
+getting at the full user name. Only MSDOS overrides the default.
+** Miscellaneous defines. Some of these might not be used in the code
+anymore, so they can be removed.
-AIX
AMPERSAND_FULL_NAME
-BITS_PER_EMACS_INT
-BITS_PER_LONG
-BITS_PER_CHAR
-BITS_PER_SHORT
-BITS_PER_INT
BROKEN_DATAGRAM_SOCKETS
BROKEN_FIONREAD
BROKEN_GET_CURRENT_DIR_NAME
BROKEN_NON_BLOCKING_CONNECT
BROKEN_PTY_READ_AFTER_EAGAIN
-BROKEN_SA_RESTART
-BROKEN_SIGAIO
-BROKEN_SIGIO
-BROKEN_SIGPOLL
-BROKEN_SIGPTY
-BSD4_2
-BSD4_3
-BSD_SYSTEM
CLASH_DETECTION
DATA_SEG_BITS
DATA_START
-DBL_MIN_REPLACEMENT
DEFAULT_SOUND_DEVICE
DEVICE_SEP
DIRECTORY_SEP
DONT_REOPEN_PTY
DOUG_LEA_MALLOC
-DebPrint
-EMACSDEBUG
EMACS_CONFIGURATION
EMACS_CONFIG_OPTIONS
EMACS_INT
EMACS_UINT
-FILE_SYSTEM_CASE
-FLOAT_CHECK_DOMAIN
-GC_LISP_OBJECT_ALIGNMENT
GC_MARK_SECONDARY_STACK
GC_MARK_STACK
GC_SETJMP_WORKS
-GMALLOC_INHIBIT_VALLOC
-GNU_LIBRARY_PENDING_OUTPUT_COUNT
-GNU_LINUX
GNU_MALLOC
HAVE_AIX_SMT_EXP
-HAVE_CBRT
-HAVE_CLOSEDIR
+HAVE_ALARM
+HAVE_ALLOCA
+HAVE_ALLOCA_H
+HAVE_ALSA
+HAVE_ATTRIBUTE_ALIGNED
+HAVE_BDFFONT
+HAVE_BOXES
+HAVE_C99_STRTOLD
+HAVE_CFMAKERAW
+HAVE_CFSETSPEED
+HAVE_CLOCK_GETTIME
+HAVE_CLOCK_SETTIME
+HAVE_COFF_H
+HAVE_COM_ERR_H
+HAVE_COPYSIGN
+HAVE_DBUS
+HAVE_DBUS_TYPE_IS_VALID
+HAVE_DBUS_VALIDATE_BUS_NAME
+HAVE_DBUS_VALIDATE_INTERFACE
+HAVE_DBUS_VALIDATE_MEMBER
+HAVE_DBUS_VALIDATE_PATH
+HAVE_DBUS_WATCH_GET_UNIX_FD
+HAVE_DECL_GETENV
+HAVE_DECL_LOCALTIME_R
+HAVE_DECL_STRMODE
+HAVE_DECL_STRTOIMAX
+HAVE_DECL_STRTOLL
+HAVE_DECL_STRTOULL
+HAVE_DECL_STRTOUMAX
+HAVE_DECL_SYS_SIGLIST
+HAVE_DECL_TZNAME
+HAVE_DECL___SYS_SIGLIST
+HAVE_DES_H
+HAVE_DEV_PTMX
+HAVE_DIALOGS
+HAVE_DIFFTIME
HAVE_DUP2
+HAVE_ENDGRENT
+HAVE_ENDPWENT
+HAVE_ENVIRON_DECL
HAVE_EUIDACCESS
-HAVE_FMOD
-HAVE_FPATHCONF
-HAVE_FREXP
+HAVE_FORK
+HAVE_FREEIFADDRS
+HAVE_FREETYPE
+HAVE_FSEEKO
HAVE_FSYNC
-HAVE_FTIME
-HAVE_GETCWD
-HAVE_GETDOMAINNAME
+HAVE_FUTIMENS
+HAVE_FUTIMES
+HAVE_FUTIMESAT
+HAVE_GAI_STRERROR
+HAVE_GCONF
+HAVE_GETADDRINFO
+HAVE_GETDELIM
+HAVE_GETGRENT
HAVE_GETHOSTNAME
+HAVE_GETIFADDRS
+HAVE_GETLINE
HAVE_GETLOADAVG
+HAVE_GETOPT_H
+HAVE_GETOPT_LONG_ONLY
HAVE_GETPAGESIZE
+HAVE_GETPEERNAME
HAVE_GETPT
+HAVE_GETPWENT
+HAVE_GETRLIMIT
+HAVE_GETRUSAGE
+HAVE_GETSOCKNAME
HAVE_GETTIMEOFDAY
-HAVE_GETWD
+HAVE_GET_CURRENT_DIR_NAME
+HAVE_GHOSTSCRIPT
+HAVE_GIF
+HAVE_GNUTLS
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+HAVE_GNUTLS_CERTIFICATE_SET_VERIFY_FUNCTION
+HAVE_GPM
+HAVE_GRANTPT
+HAVE_GSETTINGS
+HAVE_GTK3
+HAVE_GTK_ADJUSTMENT_GET_PAGE_SIZE
+HAVE_GTK_DIALOG_GET_ACTION_AREA
+HAVE_GTK_FILE_SELECTION_NEW
+HAVE_GTK_MAIN
+HAVE_GTK_MULTIDISPLAY
+HAVE_GTK_ORIENTABLE_SET_ORIENTATION
+HAVE_GTK_WIDGET_GET_MAPPED
+HAVE_GTK_WIDGET_GET_SENSITIVE
+HAVE_GTK_WIDGET_GET_WINDOW
+HAVE_GTK_WIDGET_SET_HAS_WINDOW
+HAVE_GTK_WINDOW_SET_HAS_RESIZE_GRIP
+HAVE_G_TYPE_INIT
HAVE_H_ERRNO
+HAVE_IFADDRS_H
+HAVE_IMAGEMAGICK
HAVE_INET_SOCKETS
-HAVE_INVERSE_HYPERBOLIC
+HAVE_INTTYPES_H
+HAVE_JPEG
+HAVE_KERBEROSIV_DES_H
+HAVE_KERBEROSIV_KRB_H
+HAVE_KERBEROS_DES_H
+HAVE_KERBEROS_KRB_H
+HAVE_KRB5_ERROR_E_TEXT
+HAVE_KRB5_ERROR_TEXT
+HAVE_KRB5_H
+HAVE_KRB_H
+HAVE_LANGINFO_CODESET
+HAVE_LIBCOM_ERR
+HAVE_LIBCRYPTO
+HAVE_LIBDES
+HAVE_LIBDES425
+HAVE_LIBDGC
+HAVE_LIBDNET
+HAVE_LIBHESIOD
+HAVE_LIBK5CRYPTO
+HAVE_LIBKRB
+HAVE_LIBKRB4
+HAVE_LIBKRB5
HAVE_LIBKSTAT
-HAVE_LIMITS_H
+HAVE_LIBLOCKFILE
+HAVE_LIBM
+HAVE_LIBMAIL
+HAVE_LIBOTF
+HAVE_LIBPERFSTAT
+HAVE_LIBPNG_PNG_H
+HAVE_LIBPTHREADS
+HAVE_LIBRESOLV
+HAVE_LIBSELINUX
+HAVE_LIBXEXT
+HAVE_LIBXML2
+HAVE_LIBXMU
HAVE_LINUX_VERSION_H
-HAVE_LOGB
+HAVE_LOCALTIME_R
+HAVE_LOCAL_SOCKETS
HAVE_LONG_FILE_NAMES
+HAVE_LONG_LONG_INT
HAVE_LRAND48
+HAVE_LSTAT
+HAVE_LUTIMES
+HAVE_M17N_FLT
+HAVE_MACHINE_SOUNDCARD_H
+HAVE_MACH_MACH_H
+HAVE_MAGICKEXPORTIMAGEPIXELS
+HAVE_MAGICKMERGEIMAGELAYERS
+HAVE_MAILLOCK_H
+HAVE_MALLOC_MALLOC_H
+HAVE_MATHERR
+HAVE_MBSTATE_T
+HAVE_MEMCMP
+HAVE_MEMMOVE
+HAVE_MEMORY_H
+HAVE_MEMSET
HAVE_MENUS
-HAVE_MKDIR
-HAVE_MKTIME
-HAVE_MOUSE
-HAVE_PERROR
+HAVE_MKSTEMP
+HAVE_MMAP
+HAVE_MULTILINGUAL_MENU
+HAVE_NANOTIME
+HAVE_NET_IF_DL_H
+HAVE_NET_IF_H
+HAVE_NLIST_H
+HAVE_OTF_GET_VARIATION_GLYPHS
+HAVE_PERSONALITY_LINUX32
+HAVE_PNG
+HAVE_PNG_H
+HAVE_POSIX_MEMALIGN
+HAVE_PROCFS
+HAVE_PSELECT
HAVE_PSTAT_GETDYNAMIC
+HAVE_PTHREAD
+HAVE_PTHREAD_H
+HAVE_PTHREAD_SIGMASK
+HAVE_PTYS
+HAVE_PTY_H
HAVE_PWD_H
HAVE_RANDOM
-HAVE_RENAME
+HAVE_READLINK
+HAVE_READLINKAT
+HAVE_RECVFROM
HAVE_RES_INIT
HAVE_RINT
-HAVE_RMDIR
+HAVE_RSVG
HAVE_SELECT
+HAVE_SENDTO
+HAVE_SEQPACKET
+HAVE_SETITIMER
HAVE_SETLOCALE
-HAVE_SETPGID
HAVE_SETRLIMIT
-HAVE_SETSID
+HAVE_SHARED_GAME_DIR
HAVE_SHUTDOWN
+HAVE_SIGNED_${GLTYPE}
+HAVE_SIGNED_SIG_ATOMIC_T
+HAVE_SIGNED_WCHAR_T
+HAVE_SIGNED_WINT_T
+HAVE_SIGSET_T
+HAVE_SNPRINTF
HAVE_SOCKETS
HAVE_SOUND
+HAVE_SOUNDCARD_H
+HAVE_SPEED_T
+HAVE_STDINT_H
+HAVE_STDIO_EXT_H
HAVE_STDLIB_H
-HAVE_STRERROR
-HAVE_STRFTIME
+HAVE_STLIB_H_1
+HAVE_STRINGS_H
HAVE_STRING_H
+HAVE_STRNCASECMP
+HAVE_STRSIGNAL
+HAVE_STRTOIMAX
+HAVE_STRTOLL
+HAVE_STRTOULL
+HAVE_STRTOUMAX
+HAVE_STRUCT_ERA_ENTRY
+HAVE_STRUCT_IFREQ_IFR_ADDR
+HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
+HAVE_STRUCT_IFREQ_IFR_BROADADDR
+HAVE_STRUCT_IFREQ_IFR_FLAGS
+HAVE_STRUCT_IFREQ_IFR_HWADDR
+HAVE_STRUCT_IFREQ_IFR_NETMASK
+HAVE_STRUCT_NLIST_N_UN_N_NAME
+HAVE_STRUCT_STAT_ST_ATIMENSEC
+HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC
+HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC
+HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC
+HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC
+HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC
+HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC
+HAVE_STRUCT_TIMEZONE
+HAVE_STRUCT_TM_TM_ZONE
HAVE_STRUCT_UTIMBUF
-HAVE_SYSINFO
-HAVE_SYSV_SIGPAUSE
+HAVE_ST_DM_MODE
+HAVE_SYMLINK
+HAVE_SYNC
+HAVE_SYS_BITYPES_H
+HAVE_SYS_INTTYPES_H
+HAVE_SYS_LOADAVG_H
+HAVE_SYS_PARAM_H
+HAVE_SYS_RESOURCE_H
HAVE_SYS_SELECT_H
+HAVE_SYS_SOCKET_H
+HAVE_SYS_SOUNDCARD_H
+HAVE_SYS_STAT_H
HAVE_SYS_SYSTEMINFO_H
HAVE_SYS_TIMEB_H
HAVE_SYS_TIME_H
+HAVE_SYS_TYPES_H
+HAVE_SYS_UN_H
+HAVE_SYS_UTSNAME_H
+HAVE_SYS_VLIMIT_H
+HAVE_SYS_WAIT_H
HAVE_TCATTR
+HAVE_TERM_H
+HAVE_TIFF
HAVE_TIMEVAL
+HAVE_TM_GMTOFF
HAVE_TM_ZONE
+HAVE_TOUCHLOCK
+HAVE_TZNAME
HAVE_TZSET
-HAVE_UNISTD_H
+HAVE_UNSIGNED_LONG_LONG_INT
+HAVE_UTIL_H
+HAVE_UTIMENSAT
HAVE_UTIMES
HAVE_UTIME_H
+HAVE_UTMP_H
+HAVE_VFORK
+HAVE_VFORK_H
+HAVE_WCHAR_H
+HAVE_WCHAR_T
HAVE_WINDOW_SYSTEM
+HAVE_WINSOCK2_H
+HAVE_WORKING_FORK
+HAVE_WORKING_UTIMES
HAVE_WORKING_VFORK
+HAVE_WS2TCPIP_H
+HAVE_XAW3D
+HAVE_XFT
+HAVE_XIM
+HAVE_XKBGETKEYBOARD
+HAVE_XPM
HAVE_XRMSETDATABASE
-HPUX
+HAVE_XSCREENNUMBEROFSCREEN
+HAVE_XSCREENRESOURCESTRING
+HAVE_X_I18N
+HAVE_X_MENU
+HAVE_X_SM
+HAVE_X_WINDOWS
+HAVE__BOOL
+HAVE__FTIME
+HAVE___BUILTIN_UNWIND_INIT
+HAVE___EXECUTABLE_START
+HAVE___FPENDING
INTERNAL_TERMINAL
IS_ANY_SEP
IS_DIRECTORY_SEP
-LINKER
-LINUX_VERSION_CODE
-LISP_FLOAT_TYPE
-LNOFLSH
LOCALTIME_CACHE
MAIL_USE_FLOCK
MAIL_USE_LOCKF
MAIL_USE_POP
MAIL_USE_SYSTEM_LOCK
MAXPATHLEN
-MIN_PTY_KERNEL_VERSION -- only used on Mac
-MODE_LINE_BINARY_TEXT
-MUST_UNDEF__STDC__
NLIST_STRUCT
-NO_ABORT
NO_EDITRES
-NO_MATHERR
-NO_TERMIO
NSIG
NSIG_MINIMUM
-NULL
NULL_DEVICE
ORDINARY_LINK
-O_APPEND
-O_RDONLY
-O_RDWR
PAGESIZE
-PENDING_OUTPUT_COUNT
-POSIX
PREFER_VSUSP
PTY_ITERATION
PTY_NAME_SPRINTF
@@ -219,9 +418,6 @@ PTY_OPEN
PTY_TTY_NAME_SPRINTF
PURESIZE
RUN_TIME_REMAP
-SA_RESTART
-SEGMENT_MASK
-SETPGRP_RELEASES_CTTY
SETUP_SLAVE_PTY
SIGALRM
SIGCHLD
@@ -231,11 +427,9 @@ SIGNALS_VIA_CHARACTERS
SIGPIPE
SIGQUIT
SIGTRAP
-SOLARIS2
STDC_HEADERS
SYSTEM_PURESIZE_EXTRA
SYSTEM_MALLOC
-SYSV_SYSTEM_DIR
TAB3
TABDLY
TERM
@@ -244,104 +438,168 @@ TIOCSIGSEND
TM_IN_SYS_TIME
ULIMIT_BREAK_VALUE
UNIX98_PTYS
-USE_CRT_DLL
USE_TOOLKIT_SCROLL_BARS
-USG
-USG5
-USG5_4
USG_SUBTTY_WORKS
VALBITS
-WRETCODE
XOS_NEEDS_TIME_H
-_AIX
-_ARCH_PPC64
_FILE_OFFSET_BITS
_LP64
-_MALLOC_INTERNAL
+_longjmp
+_setjmp
+abort
+alloca
+close
+emacs
+free
+gmtime
+localtime
+malloc
+random
+read
+realloc
+select
+umask
+vfork
+
+
+src/sysdep.c:
+write
+
+src/syssignal.h:
+signal
+sigmask
+sigsetmask
+
+
+lib/dup2.c:
+dup2
+
+lib/signal.h:
+signal
+
+lib/stdio.h:
+fdopen
+fopen
+fwrite
+popen
+rename
+
+lib/stdlib.h:
+calloc
+srandom (conf_post.h may undo)
+
+lib/strftime.c:
+tzname
+tzset
+
+lib/sys/stat.h:
+mkdir
+
+lib/unistd.h:
+chown
+dup
+dup2
+ftruncate
+isatty
+link
+lseek
+pipe
+rmdir
+sleep
+unlink
+
+
+MS DOS stuff:
+
_NAIVE_DOS_REGS
+
+
+MS stuff:
+
+USE_CRT_DLL
+
+ms-w32.h:
+DebPrint
+EMACSDEBUG
+MUST_UNDEF__STDC__
+
_VARARGS_
_WINSOCKAPI_
_WINSOCK_H
-_longjmp
-_setjmp
-_start
-abort
+
access
-alloca
-brk
calloc
chdir
chmod
chown
-close
-const
creat
ctime
dup
dup2
-edata
-emacs
-etext
execlp
-execvp
+execvp (also emacsclient.c [WINDOWSNT])
fdopen
fileno
fopen
-free
fsync
ftruncate
-fwrite
getdefdir
getdisk
-getenv
getpid
-getuid
-gmtime
-index
isatty
kill
link
-linux
-localtime
-logb
lseek
-malloc
mkdir
mktemp
open
pclose
pipe
popen
-random
-read
-realloc
rename
-rindex
rmdir
-sbrk
-select
-sigmask
signal
-sigsetmask
sleep
spawnve
-srandom
strdup
-strerror
stricmp
strnicmp
strupr
sys_nerr
-system
-temacs
tzname
tzset
umask
-unix
unlink
utimbuf
utime
-vfork
-wait
+wait (also movemail.c [WINDOWSNT])
write
-xfree
+
+lib-src/ntlib:
+access
+chdir
+chmod
+creat
+dup
+dup2
+execlp
+execvp
+fdopen
+fileno
+fopen
+getpid
+index
+isatty
+lseek
+mkdir
+mktemp
+open
+pclose
+pipe
+popen
+rmdir
+rindex
+sleep
+umask
+unlink
+utime
diff --git a/admin/ChangeLog b/admin/ChangeLog
index 4da85943b7f..05c1463d325 100644
--- a/admin/ChangeLog
+++ b/admin/ChangeLog
@@ -1,3 +1,421 @@
+2012-11-24 Ken Brown <kbrown@cornell.edu>
+
+ * CPP-DEFINES (HAVE_MOUSE): Remove.
+
+2012-11-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958).
+ * CPP-DEFINES (HAVE_CLOSEDIR, HAVE_DIRENT_H): Remove.
+ * notes/copyright: Adjust to src/ndir.h -> nt/inc/dirent.h renaming.
+
+2012-11-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945).
+ * CPP-DEFINES (BROKEN_GETWD, HAVE_GETCWD, HAVE_GETWD, HAVE_SIZE_T)
+ (HAVE_UNISTD_H): Remove.
+
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881).
+ * CPP-DEFINES (O_RDONLY, O_RDWR, HAVE_FCNTL_H): Remove.
+ * merge-gnulib (GNULIB_MODULES): Add fcntl-h.
+
+2012-11-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove no-longer-used pty_max_bytes variable.
+ * CPP-DEFINES (HAVE_FPATHCONF): Remove.
+
+2012-11-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use faccessat, not access, when checking file permissions (Bug#12632).
+ * merge-gnulib (GNULIB_MODULES): Add faccessat.
+ (GNULIB_TOOL_FLAGS): Avoid at-internal, fchdir, malloc-posix,
+ openat-die, openat-h, save-cwd. Do not avoid fcntl-h.
+ Omit gnulib's m4/fcntl-o.m4.
+
+2012-11-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume at least POSIX.1-1988 for getpgrp, setpgid, setsid (Bug#12800).
+ * CPP-DEFINES (HAVE_SETPGID, HAVE_SETSID, SETPGRP_RELEASES_CTTY):
+ Remove; obsolete.
+
+ Simplify by assuming __fpending.
+ * CPP-DEFINES (PENDING_OUTPUT_COUNT): Remove.
+
+2012-11-03 Glenn Morris <rgm@gnu.org>
+
+ * admin.el (set-copyright): Add msdos/sed2v2.inp.
+
+2012-11-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix data-loss with --batch (Bug#9574).
+ * merge-gnulib (GNULIB_MODULES): Add close-stream.
+
+2012-10-12 Kenichi Handa <handa@gnu.org>
+
+ * charsets/Makefile (JISC6226.map): Add missing mappings.
+
+2012-10-11 Kenichi Handa <handa@gnu.org>
+
+ * charsets/mapconv: Adjusted for the change of mapfiles/*.gz to
+ mapfiles/*.
+
+ * charsets/gb180302.awk: Handle 4-byte sequences in the input file.
+
+ * charsets/Makefile: Be sure to call mapconv script of the current
+ directory. Adjusted for the change of mapfiles/*.gz to
+ mapfiles/*.
+ (SED_SCRIPT): New variable.
+ (jisx2131-filter): New target.
+ (JISX2131.map): Use jisx2131-filter to filter out characters added
+ for the 2004 year version.
+ (clear): Remove ${SED_SCRIPT} too.
+
+ * charsets/mapfiles/MULE-ethiopic.map,
+ charsets/mapfiles/MULE-ipa.map,
+ charsets/mapfiles/MULE-is13194.map,
+ charsets/mapfiles/MULE-lviscii.map,
+ charsets/mapfiles/MULE-sisheng.map,
+ charsets/mapfiles/MULE-tibetan.map,
+ charsets/mapfiles/MULE-uviscii.map: Fix typo.
+
+2012-10-09 Glenn Morris <rgm@gnu.org>
+
+ * admin.el (cusver-scan-cus-start): New function.
+ (cusver-check): Scan old cus-start.el.
+
+2012-10-07 Glenn Morris <rgm@gnu.org>
+
+ * admin.el (cusver-new-version): Set default.
+ (cusver-check): Improve interactive argument reading.
+
+2012-10-06 Glenn Morris <rgm@gnu.org>
+
+ * admin.el (cusver-new-version): New variable.
+ (cusver-scan): Check if containing group has a :version.
+ (cusver-check): Add VERSION argument.
+
+2012-10-01 David Engster <deng@randomsample.de>
+
+ * grammars/bovine-grammar.el:
+ * grammars/wisent-grammar.el: Move to lisp directory.
+
+2012-10-01 David Engster <deng@randomsample.de>
+
+ * grammars/bovine-grammar.el (bovine--grammar-newstyle-unquote):
+ Remove.
+ (bovine-grammar-expand-form): Test for emacs-major-version.
+
+ * grammars/c.by: Add EXPLICIT to keyword tokens.
+
+ * grammars/f90.by: Add %provide token.
+
+ * grammar/grammar.wy (semantic-grammar-lexer): Remove, since it
+ was copied to grammar.el. New %provide token to generate prefix
+ which conforms with Emacs conventions. Remove lexer definition,
+ which is now in grammar.el.
+
+2012-09-27 Glenn Morris <rgm@gnu.org>
+
+ * admin.el (set-version): Set msdos.c's Vwindow_system_version.
+
+2012-09-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Check more robustly for timer_settime.
+ * merge-gnulib (GNULIB_MODULES): Add timer-time.
+
+2012-09-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * unidata/BidiMirroring.txt:
+ * unidata/UnicodeData.txt: Update to Unicode 6.2.
+
+2012-09-17 Glenn Morris <rgm@gnu.org>
+
+ * admin.el (add-log-time-format): Declare.
+
+ * admin.el (cusver-scan, cusver-check): Bind local variables.
+
+ * admin.el (set-version): Set major version in
+ etc/refcards/ru-refcard.tex and etc/refcards/emacsver.tex.
+ (set-copyright): In etc/refcards, only change ru-refcard.tex
+ and emacsver.tex.
+
+ * admin.el (set-copyright): No more need to set copyrights for
+ nextstep, or .c files. Add configure.ac and config.nt.
+
+2012-09-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove configure's --without-sync-input option (Bug#12450).
+ * CPP-DEFINES (BROKEN_SA_RESTART, SA_RESTART): Remove.
+
+2012-09-16 Glenn Morris <rgm@gnu.org>
+
+ * admin.el (set-version): No more need to set nextstep versions.
+ (set-copyright): Update for moved nextstep files.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify SIGIO usage (Bug#12408).
+ * CPP_DEFINES (BROKEN_SIGAIO, BROKEN_SIGIO, BROKEN_SIGPOLL)
+ (BROKEN_SIGPTY, NO_TERMIO): Remove.
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify, document, and port floating-point (Bug#12381).
+ * CPP-DEFINES (HAVE_CBRT, HAVE_LOGB, logb): Remove.
+
+2012-09-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume C89 or later for math functions (Bug#12381).
+ * CPP-DEFINES (HAVE_FMOD, HAVE_FREXP, FLOAT_CHECK_DOMAIN)
+ (HAVE_INVERSE_HYPERBOLIC, NO_MATHERR): Remove.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify redefinition of 'abort' (Bug#12316).
+ * CPP-DEFINES (NO_ABORT): Remove.
+
+2012-08-28 Glenn Morris <rgm@gnu.org>
+
+ * bzrmerge.el (bzrmerge-merges): Allow unversioned files in the tree.
+
+2012-08-28 Andreas Schwab <schwab@linux-m68k.org>
+
+ * charsets/mule-charsets.el (header): Fix typo.
+
+2012-08-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ On assertion failure, print backtrace if available.
+ * merge-gnulib (GNULIB_MODULES): Add execinfo.
+
+2012-08-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use ASCII tests for character types.
+ * merge-gnulib (GNULIB_MODULES): Add c-ctype. This documents a
+ new direct dependency; c-ctype was already being used indirectly
+ via other gnulib modules.
+
+2012-08-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use bool for Emacs Lisp booleans.
+ * merge-gnulib (GNULIB_MODULES): Add stdbool. This documents a
+ new direct dependency; stdbool was already being used indirectly
+ via other gnulib modules.
+
+2012-08-11 Glenn Morris <rgm@gnu.org>
+
+ * bzrmerge.el (bzrmerge-resolve): Disable local eval:.
+
+2012-08-07 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/overlay.cocci, coccinelle/symbol.cocci: Remove.
+
+2012-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port to Solaris 8.
+ * CPP-DEFINES (WRETCODE): Remove.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/overlay.cocci: Semantic patch to replace direct
+ access to Lisp_Object members of struct Lisp_Overlay to MVAR.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/symbol.cocci: Semantic patch to replace direct
+ access to Lisp_Object members of struct Lisp_Symbol to SVAR.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/process.cocci: Semantic patch to replace direct
+ access to Lisp_Object members of struct Lisp_Process to PVAR.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/window.cocci: Semantic patch to replace direct
+ access to Lisp_Object members of struct window to WVAR.
+
+2012-07-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/frame.cocci: Semantic patch to replace direct
+ access to Lisp_Object members of struct frame to FVAR.
+
+2012-07-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use Gnulib environ and stdalign modules (Bug#9772, Bug#9960).
+ * merge-gnulib: Add environ, stdalign.
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/unibyte_string.cocci: Semantic patch to convert from
+ make_unibyte_string to build_unibyte_string where appropriate.
+
+2012-07-17 Eli Zaretskii <eliz@gnu.org>
+
+ * CPP-DEFINES: Remove FILE_SYSTEM_CASE.
+
+2012-07-17 Chong Yidong <cyd@gnu.org>
+
+ * Version 24.1 released.
+
+2012-07-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume mkdir, perror, rename, rmdir, strerror.
+ * CPP-DEFINES (HAVE_MKDIR, HAVE_PERROR, HAVE_RENAME, HAVE_RMDIR)
+ (HAVE_STRERROR, strerror):
+ Remove.
+
+2012-07-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/list_loop.cocci: Semantic patch to convert from Fcdr
+ to XCDR and consistently use CONSP in the list iteration loops.
+ * coccinelle/vector_contents.cocci: Fix indentation.
+
+2012-07-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * bzrmerge.el: Use cl-lib.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rename configure.in to configure.ac (Bug#11603).
+ * admin.el (set-version):
+ * quick-install-emacs (VERSION):
+ Get version number from configure.ac, not configure.in.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use c_strcasecmp for ASCII case-insensitive comparison (Bug#11786).
+ * merge-gnulib (GNULIB_MODULES): Add c-strcase.
+
+2012-07-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/xzalloc.cocci: Semantic patch to convert
+ calls to xmalloc with following memset to xzalloc.
+
+2012-07-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * CPP-DEFINES (LISP_FLOAT_TYPE): Remove, obsolete.
+
+2012-06-26 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/build_string.cocci: Semantic patch
+ to convert from make_string to build_string.
+
+2012-06-24 Dmitry Antipov <dmantipov@yandex.ru>
+
+ First Coccinelle semantic patch.
+ * coccinelle: New subdirectory
+ * coccinelle/README: Documentation stub.
+ * coccinelle/vector_contents.cocci: Semantic patch to replace direct
+ access to `contents' member of Lisp_Vector objects with AREF and ASET
+ where appropriate.
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+ * merge-gnulib (GNULIB_MODULES): Add dtotimespec, gettime,
+ gettimeofday, pselect, stat-time, sys_time, time, timespec-add,
+ timespec-sub, utimens.
+ (GNULIB_TOOL_FLAGS): Add --avoid=select --avoid=sigprocmask.
+ This trims down the gnulib import, from the very latest gnulib.
+ Emacs does its own implementation of 'select' and 'sigprocmask'
+ on Windows, and it assumes 'select' and 'sigprocmask' on non-Windows
+ hosts, so it doesn't need these modules.
+ Similarly, avoid errno, fcntl, fcntl-h, fstat, and sys_types, as
+ these gnulib modules are only for Windows porting and Emacs ports
+ to Windows in a different way.
+
+2012-06-13 Andreas Schwab <schwab@linux-m68k.org>
+
+ * make-emacs: Rename --union-type to --check-lisp-type.
+ Define CHECK_LISP_OBJECT_TYPE insted of USE_LISP_UNION_TYPE.
+ * CPP-DEFINES (DEBUG_LISP_OBJECT_TYPE): Rename from
+ USE_LISP_UNION_TYPE.
+
+2012-06-03 Glenn Morris <rgm@gnu.org>
+
+ * quick-install-emacs (PUBLIC_LIBSRC_SCRIPTS): Remove rcs-checkin.
+
+2012-06-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove --disable-maintainer-mode option from 'configure'. (Bug#11555)
+ * make-tarball.txt: Don't worry about maintainer mode.
+
+2012-05-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ * CPP-DEFINES: Remove HAVE_SYSINFO.
+
+2012-05-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume gnulib does largefile.
+ * merge-gnulib (GNULIB_MODULES): Add largefile.
+
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove src/m/*.
+ * CPP-DEFINES: Do not mention src/m/*.h.
+ (BITS_PER_EMACS_INT, BITS_PER_LONG, BITS_PER_CHAR)
+ (BITS_PER_SHORT, BITS_PER_INT): Remove.
+ * MAINTAINERS: Remove src/m/.
+
+2012-05-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use full name for m4/gnulib-comp.m4. (Bug#11529)
+ * merge-gnulib: Leave m4/gnulib-comp.m4's name alone.
+
+ Assume C89 or later.
+ * CPP-DEFINES: Remove NULL, const.
+
+ Make merging from gnulib a script, not a makefile action.
+ * merge-gnulib: New script, with actions moved here from
+ ../Makefile.in.
+
+2012-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * CPP-DEFINES (HAVE_GETDOMAINNAME): Remove.
+
+ * CPP-DEFINES (HAVE_FTIME): Remove.
+
+2012-05-02 Glenn Morris <rgm@gnu.org>
+
+ * bzrmerge.el (bzrmerge-skip-regexp): Add "Auto-commit".
+
+2012-04-10 Glenn Morris <rgm@gnu.org>
+
+ * bzrmerge.el (bzrmerge-skip-regexp): Add "from trunk".
+
+ * unidata/Makefile.in: Add FSF copyright.
+ Make it use autoconf features, and work for out-of-tree builds.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * unidata/README:
+ * unidata/copyright.html:
+ * unidata/BidiMirroring.txt:
+ * unidata/UnicodeData.txt: Update for the latest version 6.1 of
+ the Unicode Standard.
+
+2012-02-16 Kenichi Handa <handa@m17n.org>
+
+ * unidata/unidata-gen.el (unidata-prop-alist): Change the default
+ values of name and old-name to nil.
+ (unidata-get-name): Return nil for the default value.
+
+2012-02-11 Glenn Morris <rgm@gnu.org>
+
+ * admin.el (cusver-find-files, cusver-scan, cusver-goto-xref)
+ (cusver-check): New functions.
+
+2012-01-19 Glenn Morris <rgm@gnu.org>
+
+ * bzrmerge.el (bzrmerge-missing): Allow a definitive "no" answer to the
+ "skip?" question, since there can be multiple such for any revision.
+
+2012-01-14 Eli Zaretskii <eliz@gnu.org>
+
+ * FOR-RELEASE (Check the Emacs Tutorial): Mark TUTORIAL.he as
+ updated and checked.
+
2011-11-26 Andreas Schwab <schwab@linux-m68k.org>
* grammars/bovine-grammar.el (bovine--grammar-newstyle-unquote):
@@ -82,11 +500,11 @@
* unidata/makefile.w32-in (all): Remove src/biditype.h and
src/bidimirror.h.
- (../../src/biditype.h, ../../src/bidimirror.h): Deleted.
+ (../../src/biditype.h, ../../src/bidimirror.h): Delete.
* unidata/Makefile.in (all): Remove src/biditype.h and
src/bidimirror.h.
- (../../src/biditype.h, ../../src/bidimirror.h): Deleted.
+ (../../src/biditype.h, ../../src/bidimirror.h): Delete.
2011-07-07 Juanma Barranquero <lekktu@gmail.com>
@@ -97,8 +515,8 @@
* unidata/unidata-gen.el (unidata-dir): New variable.
(unidata-setup-list): Expand unidata-text-file in unidata-dir.
- (unidata-prop-alist): INDEX element may be a function. New
- optional element VAL-LIST (for general-category and bidi-class).
+ (unidata-prop-alist): INDEX element may be a function.
+ New optional element VAL-LIST (for general-category and bidi-class).
New entry `mirroring'.
(unidata-prop-default, unidata-prop-val-list): New subst.
(unidata-get-character, unidata-put-character): Delete them.
@@ -454,13 +872,13 @@
2009-04-17 Kenichi Handa <handa@m17n.org>
- * unidata/unidata-gen.el (unidata-get-decomposition): Adjust
- Hangle decomposition rule to Unicode.
+ * unidata/unidata-gen.el (unidata-get-decomposition):
+ Adjust Hangle decomposition rule to Unicode.
2009-04-09 Kenichi Handa <handa@m17n.org>
- * unidata/unidata-gen.el (unidata-describe-decomposition): Return
- a string with a composition property to disable combining
+ * unidata/unidata-gen.el (unidata-describe-decomposition):
+ Return a string with a composition property to disable combining
characters being composed.
2009-03-11 Miles Bader <miles@gnu.org>
@@ -473,7 +891,7 @@
2009-02-23 Jason Rumney <jasonr@gnu.org>
- * nt/README-ftp-server: Update for 23.0.91
+ * nt/README-ftp-server: Update for 23.0.91.
* nt/README.W32: Remove ever expanding versions of Windows.
Shorten FAQ URL. Remove mention of obsolete lock directory.
@@ -955,7 +1373,7 @@
2005-10-17 Bill Wohler <wohler@newt.com>
- * FOR-RELEASE (DOCUMENTATION): Removed lisp/toolbar from list
+ * FOR-RELEASE (DOCUMENTATION): Remove lisp/toolbar from list
since it's gone. Also marked mh-e as done.
2005-10-11 Juanma Barranquero <lekktu@gmail.com>
@@ -1002,7 +1420,7 @@
2005-03-30 Marcelo Toledo <marcelo@marcelotoledo.org>
- * FOR-RELEASE (Documentation): Added check the Emacs Tutorial.
+ * FOR-RELEASE (Documentation): Add check the Emacs Tutorial.
The first line of every tutorial must begin with a sentence saying
"Emacs Tutorial" in the respective language. This should be
followed by "See end for copying conditions", likewise in the
@@ -1226,7 +1644,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/admin/FOR-RELEASE b/admin/FOR-RELEASE
index 65f98c85496..1e4f9f3b48d 100644
--- a/admin/FOR-RELEASE
+++ b/admin/FOR-RELEASE
@@ -7,7 +7,7 @@ Check cross-references between the manuals (eg from emacs to elisp)
are correct. You can use something like the following in the info
directory in the Emacs build tree:
-emacs -Q --eval "(setq Info-default-directory-list '(\".\"))" \
+emacs -Q --eval "(progn (require 'info) (setq Info-directory-list '(\".\")))" \
-f info-xref-check-all
make emacs.dvi, elisp.dvi, and deal with any errors (undefined
@@ -31,12 +31,22 @@ its own at the start of a line. It looks better if you reword/respace
things to avoid these. (AFAIK, there is no way to find these except
paging through the whole manual.) This should be the very last thing
you do, since any change can alter the layout.
+(Actually, there is probably little point in trying to do this.
+It's only really relevant if printed versions of the manuals are going
+to be published. End-users are not likely to print out all 1000+
+pages of the manuals, and even if they do, the resulting page breaks
+depend on what paper and font size they use. This also means that if
+you _are_ going to do this, it should be done with the paper and font
+size that the GNU Press are going to use when they print the manuals.
+I think this is different to what you get if you just use eg `make
+emacs.pdf' (e.g., enable "smallbook").
** Check the keybindings in the refcards are correct, and add any new ones.
Regenerate the pdf versions in etc/refcards/.
What paper size are the English versions supposed to be on?
On Debian testing, the packages texlive-lang-czechslovak and
texlive-lang-polish will let you generate the cs-* and sk-* pdfs.
+(You may need texlive-lang-cyrillic, texlive-lang-german for others.)
The Makefile rules did not work for me, I had to use something like:
csplain -output-format=pdf cs-refcard
@@ -53,18 +63,18 @@ pt-br Rodrigo Real
ru Alex Ott
sk Miroslav Vaško
+** For a major release, add a "New in Emacs XX" section to faq.texi.
+
** Remove temporary +++/--- lines in NEWS.
** Try to reorder NEWS: most important things first, related items together.
** Consider bumping customize-changed-options-previous-release.
-* BUGS
+** cusver-check from admin.el can help find new defcustoms missing
+:version tags.
-** rms: gnus-dired.el is a mistake. Those features should not
-be part of Gnus. They should be moved to some other part of Emacs.
-rsteib: Gnus dependencies in `gnus-dired.el' (and `mailcap.el') have been
-minimized. I don't know what is left to do here.
+* BUGS
** Check for modes which bind M-s that conflicts with a new global binding M-s
and change key bindings where necessary. The current list of modes:
@@ -83,9 +93,10 @@ and change key bindings where necessary. The current list of modes:
`log-edit-comment-search-forward'. Perhaps search commands
on the global key binding `M-s' are useless in these modes.
-* DOCUMENTATION
+5. Rmail binds `\es' to `rmail-search'/`rmail-summary-search'.
-** Document XEmbed support
+
+* DOCUMENTATION
** Check the Emacs Tutorial.
@@ -99,142 +110,136 @@ names of the people who have checked it.
SECTION READERS
----------------------------------
-TUTORIAL
-TUTORIAL.bg
+TUTORIAL cyd
+TUTORIAL.bg ogi
TUTORIAL.cn
TUTORIAL.cs
-TUTORIAL.de
+TUTORIAL.de wl
TUTORIAL.eo
TUTORIAL.es
TUTORIAL.fr
-TUTORIAL.he
+TUTORIAL.he eliz
TUTORIAL.it
TUTORIAL.ja
TUTORIAL.ko
-TUTORIAL.nl
+TUTORIAL.nl Pieter Schoenmakers
TUTORIAL.pl
TUTORIAL.pt_BR
TUTORIAL.ro
-TUTORIAL.ru
+TUTORIAL.ru Alex Ott
TUTORIAL.sk
-TUTORIAL.sl
-TUTORIAL.sv
+TUTORIAL.sl Primoz PETERLIN
+TUTORIAL.sv Mats Lidell
TUTORIAL.th
TUTORIAL.zh
** Check the manual.
abbrevs.texi cyd
-ack.texi
-anti.texi
+ack.texi rgm
+anti.texi cyd
arevert-xtra.texi cyd
basic.texi cyd
buffers.texi cyd
building.texi cyd
-calendar.texi
-cal-xtra.texi
-cmdargs.texi
+calendar.texi rgm
+cal-xtra.texi rgm
+cmdargs.texi cyd
commands.texi cyd
-custom.texi
+custom.texi cyd
dired.texi cyd
-dired-xtra.texi
+dired-xtra.texi rgm
display.texi cyd
-emacs.texi
-emacs-xtra.texi
-emerge-xtra.texi
+emacs.texi rgm
+emacs-xtra.texi rgm
+emerge-xtra.texi rgm
entering.texi cyd
files.texi cyd
-fixit.texi
-fortran-xtra.texi
+fixit.texi cyd
+fortran-xtra.texi rgm
frames.texi cyd
-glossary.texi
+glossary.texi rgm
help.texi cyd
indent.texi cyd
killing.texi cyd
kmacro.texi cyd
-macos.texi
+macos.texi rgm (can't actually test any of it though)
maintaining.texi cyd
-major.texi
mark.texi cyd
-mini.texi
-misc.texi
+mini.texi rgm
+misc.texi cyd
modes.texi cyd
-msdog.texi
-msdog-xtra.texi
-mule.texi
+msdog.texi rgm (can't actually test any of it though)
+msdog-xtra.texi rgm (can't actually test any of it though)
+mule.texi rgm (not 100% sure about "Fontsets")
m-x.texi cyd
-picture-xtra.texi
+package.texi cyd
+picture-xtra.texi rgm
programs.texi cyd
regs.texi cyd
-rmail.texi
+rmail.texi rgm
screen.texi cyd
search.texi cyd
-sending.texi
+sending.texi cyd
text.texi cyd
-trouble.texi
+trouble.texi cyd
vc-xtra.texi cyd
vc1-xtra.texi cyd
windows.texi cyd
-xresources.texi
+xresources.texi cyd
** Check the Lisp manual.
-abbrevs.texi
-advice.texi
-anti.texi
-back.texi
-backups.texi
-buffers.texi
-commands.texi
-compile.texi
-control.texi
-customize.texi
-debugging.texi
-display.texi
-edebug.texi
+abbrevs.texi rgm
+advice.texi cyd
+anti.texi rgm
+back.texi rgm
+backups.texi cyd
+buffers.texi cyd
+commands.texi cyd
+compile.texi cyd
+control.texi cyd
+customize.texi cyd
+debugging.texi cyd
+display.texi cyd
+edebug.texi rgm
elisp.texi
-errors.texi
-eval.texi
-files.texi
-frames.texi
-functions.texi
-hash.texi
-help.texi
-hooks.texi
+errors.texi rgm
+eval.texi cyd
+files.texi cyd
+frames.texi cyd
+functions.texi cyd
+hash.texi cyd
+help.texi cyd
+hooks.texi rgm
index.texi
-internals.texi
-intro.texi
-keymaps.texi
-lists.texi
-loading.texi
-locals.texi
-macros.texi
-maps.texi
-markers.texi
-minibuf.texi
-modes.texi
-nonascii.texi
-numbers.texi
-objects.texi
-os.texi
-package.texi
-positions.texi
-processes.texi
-searching.texi
-sequences.texi
-streams.texi
-strings.texi
-symbols.texi
-syntax.texi
-text.texi
-tips.texi
-variables.texi
-windows.texi
-
-* PLANNED ADDITIONS
-
-** pov-mode (probably not for Emacs-23: waiting for a Free POV-Ray).
-** gas-mode ?
+internals.texi rgm cyd
+intro.texi cyd
+keymaps.texi cyd
+lists.texi cyd
+loading.texi cyd
+macros.texi cyd
+maps.texi rgm
+markers.texi rgm
+minibuf.texi rgm
+modes.texi cyd
+nonascii.texi cyd
+numbers.texi cyd
+objects.texi cyd
+os.texi cyd
+package.texi rgm
+positions.texi cyd
+processes.texi rgm
+searching.texi rgm
+sequences.texi cyd
+streams.texi cyd
+strings.texi cyd
+symbols.texi cyd
+syntax.texi cyd
+text.texi cyd
+tips.texi rgm
+variables.texi cyd
+windows.texi rgm (skimmed)
Local variables:
diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS
index bfac347eb15..34763083e9a 100644
--- a/admin/MAINTAINERS
+++ b/admin/MAINTAINERS
@@ -34,7 +34,6 @@ Eli Zaretskii
src/msdos.[ch]
src/dosfns.[ch]
src/w16select.c
- src/s/msdos.h
lisp/term/internal.el
lisp/term/pc-win.el
lisp/dos-fns.el
@@ -171,7 +170,6 @@ src/insdel.c
src/image.c
src/lastfile.c
src/lread.c
-src/m/
src/macros.c
src/makefile.w32-in
src/marker.c
@@ -184,7 +182,6 @@ src/print.c
src/process.c
src/ralloc.c
src/region-cache.c
-src/s/
src/scroll.c
src/search.c
src/sound.c
@@ -220,4 +217,3 @@ src/xmenu.c
src/xrdb.c
src/xselect.c
src/xterm.c
-
diff --git a/admin/README b/admin/README
index 10a8f2244fc..b5eefc2da7a 100644
--- a/admin/README
+++ b/admin/README
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/admin/admin.el b/admin/admin.el
index 9235144f6c6..ec78fb27865 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -1,6 +1,6 @@
;;; admin.el --- utilities for Emacs administration
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -26,6 +26,8 @@
;;; Code:
+(defvar add-log-time-format) ; in add-log
+
(defun add-release-logs (root version)
"Add \"Version VERSION released.\" change log entries in ROOT.
Root must be the root of an Emacs source tree."
@@ -62,7 +64,7 @@ Root must be the root of an Emacs source tree."
(set-version-in-file root "README" version
(rx (and "version" (1+ space)
(submatch (1+ (in "0-9."))))))
- (set-version-in-file root "configure.in" version
+ (set-version-in-file root "configure.ac" version
(rx (and "AC_INIT" (1+ (not (in ?,)))
?, (0+ space)
(submatch (1+ (in "0-9."))))))
@@ -126,39 +128,20 @@ Root must be the root of an Emacs source tree."
(set-version-in-file root "nt/emacsclient.rc" comma-space-version
(rx (and "\"ProductVersion\"" (0+ space) ?,
(0+ space) ?\" (submatch (1+ (in "0-9, ")))
- "\\0\""))))
- ;; nextstep.
- (set-version-in-file
- root "nextstep/Cocoa/Emacs.base/Contents/Info.plist"
- version (rx (and "CFBundleGetInfoString" (1+ anything) "Emacs" (1+ space)
- (submatch (1+ (in "0-9."))))))
- (set-version-in-file
- root "nextstep/Cocoa/Emacs.base/Contents/Info.plist"
- version (rx (and "CFBundleShortVersionString" (1+ not-newline) ?\n
- (0+ not-newline) "<string>" (0+ space)
- (submatch (1+ (in "0-9."))))))
- (set-version-in-file
- root "nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings"
- version (rx (and "CFBundleShortVersionString" (0+ space) ?= (0+ space)
- ?\" (0+ space) "Version" (1+ space)
- (submatch (1+ (in "0-9."))))))
- (set-version-in-file
- root "nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings"
- version (rx (and "CFBundleGetInfoString" (0+ space) ?= (0+ space)
- ?\" (0+ space) "Emacs version" (1+ space)
- (submatch (1+ (in "0-9."))))))
- (set-version-in-file
- root "nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist"
- version (rx (and "ApplicationRelease" (0+ space) ?= (0+ space)
- ?\" (0+ space) (submatch (1+ (in "0-9."))))))
- (set-version-in-file
- root "nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist"
- version (rx (and "FullVersionID" (0+ space) ?= (0+ space)
- ?\" (0+ space) "Emacs" (1+ space)
- (submatch (1+ (in "0-9."))))))
- (set-version-in-file
- root "nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop"
- version (rx (and "Version=" (submatch (1+ (in "0-9.")))))))
+ "\\0\"")))
+ ;; Major version only.
+ (when (string-match "\\([0-9]\\{2,\\}\\)" version)
+ (setq version (match-string 1 version))
+ (set-version-in-file root "src/msdos.c" version
+ (rx (and "Vwindow_system_version" (1+ not-newline)
+ ?\( (submatch (1+ (in "0-9"))) ?\))))
+ (set-version-in-file root "etc/refcards/ru-refcard.tex" version
+ "\\\\newcommand{\\\\versionemacs}\\[0\\]\
+{\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs")
+ (set-version-in-file root "etc/refcards/emacsver.tex" version
+ "\\\\def\\\\versionemacs\
+{\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs"))))
+
;; Note this makes some assumptions about form of short copyright.
(defun set-copyright (root copyright)
@@ -172,45 +155,28 @@ Root must be the root of an Emacs source tree."
(format-time-string "%Y")))))
(unless (file-exists-p (expand-file-name "src/emacs.c" root))
(error "%s doesn't seem to be the root of an Emacs source tree" root))
- (set-version-in-file root "src/emacs.c" copyright
- (rx (and "emacs_copyright" (0+ (not (in ?\")))
- ?\" (submatch (1+ (not (in ?\")))) ?\")))
- (set-version-in-file root "lib-src/ebrowse.c" copyright
- (rx (and "emacs_copyright" (0+ (not (in ?\")))
- ?\" (submatch (1+ (not (in ?\")))) ?\")))
- (set-version-in-file root "lib-src/etags.c" copyright
- (rx (and "emacs_copyright" (0+ (not (in ?\")))
+ (set-version-in-file root "configure.ac" copyright
+ (rx (and bol "copyright" (0+ (not (in ?\")))
?\" (submatch (1+ (not (in ?\")))) ?\")))
+ (set-version-in-file root "msdos/sed2v2.inp" copyright
+ (rx (and bol "/^#undef " (1+ not-newline)
+ "define COPYRIGHT" (1+ space)
+ ?\" (submatch (1+ (not (in ?\")))) ?\")))
+ (set-version-in-file root "nt/config.nt" copyright
+ (rx (and bol "#" (0+ blank) "define" (1+ blank)
+ "COPYRIGHT" (1+ blank)
+ ?\" (submatch (1+ (not (in ?\")))) ?\")))
(set-version-in-file root "lib-src/rcs2log" copyright
(rx (and "Copyright" (0+ space) ?= (0+ space)
?\' (submatch (1+ nonl)))))
- ;; This one is a nuisance, as it needs to be split over two lines.
- (string-match "\\(.*[0-9]\\{4\\} *\\)\\(.*\\)" copyright)
- ;; nextstep.
- (set-version-in-file
- root "nextstep/Cocoa/Emacs.base/Contents/Info.plist"
- copyright (rx (and "CFBundleGetInfoString" (1+ anything) "Emacs" (1+ space)
- (1+ (in "0-9.")) (1+ space)
- (submatch (1+ (not (in ?\<)))))))
- (set-version-in-file
- root "nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings"
- copyright (rx (and "NSHumanReadableCopyright" (0+ space) ?\= (0+ space)
- ?\" (submatch (1+ (not (in ?\")))))))
- (set-version-in-file
- root "nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist"
- copyright (rx (and "Copyright" (0+ space) ?\= (0+ space)
- ?\" (submatch (1+ (not (in ?\")))))))
(when (string-match "\\([0-9]\\{4\\}\\)" copyright)
(setq copyright (match-string 1 copyright))
- (dolist (file (directory-files (expand-file-name "etc/refcards" root)
- t "\\.tex\\'"))
- (unless (string-match "gnus-refcard\\.tex" file)
- (set-version-in-file
- root file copyright
- (concat (if (string-match "ru-refcard\\.tex" file)
- "\\\\newcommand{\\\\cyear}\\[0\\]{"
- "\\\\def\\\\year{")
- "\\([0-9]\\{4\\}\\)}.+%.+copyright year"))))))
+ (set-version-in-file root "etc/refcards/ru-refcard.tex" copyright
+ "\\\\newcommand{\\\\cyear}\\[0\\]\
+{\\([0-9]\\{4\\}\\)}.+%.+copyright year")
+ (set-version-in-file root "etc/refcards/emacsver.tex" copyright
+ "\\\\def\\\\year\
+{\\([0-9]\\{4\\}\\)}.+%.+copyright year")))
;;; Various bits of magic for generating the web manuals
@@ -240,7 +206,7 @@ Root must be the root of an Emacs source tree."
(manual-txt texi (expand-file-name "emacs.txt" txt-dir))
(manual-pdf texi (expand-file-name "emacs.pdf" dest))
(manual-dvi texi (expand-file-name "emacs.dvi" dvi-dir)
- (expand-file-name "emacs.ps" ps-dir)))
+ (expand-file-name "emacs.ps" ps-dir)))
;; Lisp manual
(let ((texi (expand-file-name "doc/lispref/elisp.texi" root)))
(manual-html-node texi (expand-file-name "elisp" html-node-dir))
@@ -248,7 +214,20 @@ Root must be the root of an Emacs source tree."
(manual-txt texi (expand-file-name "elisp.txt" txt-dir))
(manual-pdf texi (expand-file-name "elisp.pdf" dest))
(manual-dvi texi (expand-file-name "elisp.dvi" dvi-dir)
- (expand-file-name "elisp.ps" ps-dir)))
+ (expand-file-name "elisp.ps" ps-dir)))
+ ;; Misc manuals
+ (let ((manuals '("ada-mode" "auth" "autotype" "calc" "cc-mode"
+ "cl" "dbus" "dired-x" "ebrowse" "ede" "ediff"
+ "edt" "eieio" "emacs-mime" "epa" "erc" "ert"
+ "eshell" "eudc" "faq" "flymake" "forms"
+ "gnus" "emacs-gnutls" "idlwave" "info"
+ "mairix-el" "message" "mh-e" "newsticker"
+ "nxml-mode" "org" "pcl-cvs" "pgg" "rcirc"
+ "remember" "reftex" "sasl" "sc" "semantic"
+ "ses" "sieve" "smtpmail" "speedbar" "tramp"
+ "url" "vip" "viper" "widget" "woman")))
+ (dolist (manual manuals)
+ (manual-misc-html manual root html-node-dir html-mono-dir)))
(message "Manuals created in %s" dest)))
(defconst manual-doctype-string
@@ -265,6 +244,12 @@ Root must be the root of an Emacs source tree."
(defconst manual-style-string "<style type=\"text/css\">
@import url('/style.css');\n</style>\n")
+(defun manual-misc-html (name root html-node-dir html-mono-dir)
+ (let ((texi (expand-file-name (format "doc/misc/%s.texi" name) root)))
+ (manual-html-node texi (expand-file-name name html-node-dir))
+ (manual-html-mono texi (expand-file-name (concat name ".html")
+ html-mono-dir))))
+
(defun manual-html-mono (texi-file dest)
"Run Makeinfo on TEXI-FILE, emitting mono HTML output to DEST.
This function also edits the HTML files so that they validate as
@@ -307,13 +292,15 @@ the @import directive."
(let (copyright-text)
(manual-html-fix-index-1)
;; Move copyright notice to the end.
- (re-search-forward "[ \t]*<p>Copyright &copy;")
- (setq opoint (match-beginning 0))
- (re-search-forward "</blockquote>")
- (setq copyright-text (buffer-substring opoint (point)))
- (delete-region opoint (point))
+ (when (re-search-forward "[ \t]*<p>Copyright &copy;" nil t)
+ (setq opoint (match-beginning 0))
+ (re-search-forward "</blockquote>")
+ (setq copyright-text (buffer-substring opoint (point)))
+ (delete-region opoint (point)))
(manual-html-fix-index-2)
- (insert copyright-text "\n</div>\n"))
+ (if copyright-text
+ (insert copyright-text))
+ (insert "\n</div>\n"))
;; For normal nodes, give the header div a blue bg.
(manual-html-fix-node-div))
(save-buffer))))))
@@ -369,9 +356,9 @@ Also generate PostScript output in PS-DEST."
(defun manual-html-fix-index-1 ()
(let (opoint)
- (re-search-forward "<body>\n\\(<h1 class=\"settitle\\)")
- (setq opoint (match-beginning 1))
- (search-forward "<h2 class=\"unnumbered")
+ (re-search-forward "<body>\n")
+ (setq opoint (match-end 0))
+ (search-forward "<h2 class=\"")
(goto-char (match-beginning 0))
(delete-region opoint (point))
(insert "<div id=\"content\" class=\"inner\">\n\n")))
@@ -380,7 +367,8 @@ Also generate PostScript output in PS-DEST."
"Replace the index list in the current buffer with a HTML table."
(let (done open-td tag desc)
;; Convert the list that Makeinfo made into a table.
- (search-forward "<ul class=\"menu\">")
+ (or (search-forward "<ul class=\"menu\">" nil t)
+ (search-forward "<ul>"))
(replace-match "<table style=\"float:left\" width=\"100%\">")
(forward-line 1)
(while (not done)
@@ -413,7 +401,7 @@ Also generate PostScript output in PS-DEST."
(replace-match " </td></tr></table>\n
<h3>Detailed Node Listing</h3>\n\n" t t)
(search-forward "<p>")
- (search-forward "<p>")
+ (search-forward "<p>" nil t)
(goto-char (match-beginning 0))
(skip-chars-backward "\n ")
(setq open-td nil)
@@ -427,8 +415,8 @@ Also generate PostScript output in PS-DEST."
(setq open-td nil))
(insert " <tr>
<th colspan=\"2\" align=\"left\" style=\"text-align:left\">")
- (re-search-forward "</p>[ \t\n]*<ul class=\"menu\">")
- (replace-match " </th></tr>"))
+ (if (re-search-forward "</p>[ \t\n]*<ul class=\"menu\">" nil t)
+ (replace-match " </th></tr>")))
((looking-at "[ \t]*</ul>[ \t]*$")
(replace-match
(if open-td
@@ -437,11 +425,168 @@ Also generate PostScript output in PS-DEST."
(setq done t))
(t
(if (eobp)
- (error "Parse error in %s" f))
+ (error "Parse error in %s" f)) ; f is bound in manual-html-node
(unless open-td
(setq done t))))
(forward-line 1))))
+
+;; Stuff to check new defcustoms got :version tags.
+;; Adapted from check-declare.el.
+
+(defun cusver-find-files (root &optional old)
+ "Find .el files beneath directory ROOT that contain defcustoms.
+If optional OLD is non-nil, also include defvars."
+ (process-lines find-program root
+ "-name" "*.el"
+ "-exec" grep-program
+ "-l" "-E" (format "^[ \\t]*\\(def%s"
+ (if old "(custom|var)"
+ "custom"
+ ))
+ "{}" "+"))
+
+(defvar cusver-new-version (format "%s.%s" emacs-major-version
+ (1+ emacs-minor-version))
+ "Version number that new defcustoms should have.")
+
+(defun cusver-scan (file &optional old)
+ "Scan FILE for `defcustom' calls.
+Return a list with elements of the form (VAR . VER),
+This means that FILE contains a defcustom for variable VAR, with
+a :version tag having value VER (may be nil).
+If optional argument OLD is non-nil, also scan for defvars."
+ (let ((m (format "Scanning %s..." file))
+ (re (format "^[ \t]*\\((def%s\\)[ \t\n]"
+ (if old "\\(custom\\|var\\)" "\\(custom\\|group\\)")))
+ alist var ver form glist grp)
+ (message "%s" m)
+ (with-temp-buffer
+ (insert-file-contents file)
+ ;; FIXME we could theoretically be inside a string.
+ (while (re-search-forward re nil t)
+ (goto-char (match-beginning 1))
+ (if (and (setq form (ignore-errors (read (current-buffer))))
+ (setq var (car-safe (cdr-safe form)))
+ ;; Exclude macros, eg (defcustom ,varname ...).
+ (symbolp var))
+ (progn
+ (setq ver (car (cdr-safe (memq :version form))))
+ (if (equal "group" (match-string 2))
+ ;; Group :version could be old.
+ (if (equal ver cusver-new-version)
+ (setq glist (cons (cons var ver) glist)))
+ ;; If it specifies a group and the whole group has a
+ ;; version. use that.
+ (unless ver
+ (setq grp (car (cdr-safe (memq :group form))))
+ (and grp
+ (setq grp (car (cdr-safe grp))) ; (quote foo) -> foo
+ (setq ver (assq grp glist))))
+ (setq alist (cons (cons var ver) alist))))
+ (if form (message "Malformed defcustom: `%s'" form)))))
+ (message "%sdone" m)
+ alist))
+
+(defun cusver-scan-cus-start (file)
+ "Scan cus-start.el and return an alist with elements (VAR . VER)."
+ (if (file-readable-p file)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (when (search-forward "(let ((all '(" nil t)
+ (backward-char 1)
+ (let (var ver alist)
+ (dolist (elem (ignore-errors (read (current-buffer))))
+ (when (symbolp (setq var (car-safe elem)))
+ (or (stringp (setq ver (nth 3 elem)))
+ (setq ver nil))
+ (setq alist (cons (cons var ver) alist))))
+ alist)))))
+
+(define-button-type 'cusver-xref 'action #'cusver-goto-xref)
+
+(defun cusver-goto-xref (button)
+ "Jump to a lisp file for the BUTTON at point."
+ (let ((file (button-get button 'file))
+ (var (button-get button 'var)))
+ (if (not (file-readable-p file))
+ (message "Cannot read `%s'" file)
+ (with-current-buffer (find-file-noselect file)
+ (goto-char (point-min))
+ (or (re-search-forward (format "^[ \t]*(defcustom[ \t]*%s" var) nil t)
+ (message "Unable to locate defcustom"))
+ (pop-to-buffer (current-buffer))))))
+
+;; You should probably at least do a grep over the old directory
+;; to check the results of this look sensible.
+;; TODO Check cus-start if something moved from C to Lisp.
+;; TODO Handle renamed things with aliases to the old names.
+(defun cusver-check (newdir olddir version)
+ "Check that defcustoms have :version tags where needed.
+NEWDIR is the current lisp/ directory, OLDDIR is that from the previous
+release. A defcustom that is only in NEWDIR should have a :version
+tag. We exclude cases where a defvar exists in OLDDIR, since
+just converting a defvar to a defcustom does not require a :version bump.
+
+Note that a :version tag should also be added if the value of a defcustom
+changes (in a non-trivial way). This function does not check for that."
+ (interactive (list (read-directory-name "New Lisp directory: ")
+ (read-directory-name "Old Lisp directory: ")
+ (number-to-string
+ (read-number "New version number: "
+ (string-to-number cusver-new-version)))))
+ (or (file-directory-p (setq newdir (expand-file-name newdir)))
+ (error "Directory `%s' not found" newdir))
+ (or (file-directory-p (setq olddir (expand-file-name olddir)))
+ (error "Directory `%s' not found" olddir))
+ (setq cusver-new-version version)
+ (let* ((newfiles (progn (message "Finding new files with defcustoms...")
+ (cusver-find-files newdir)))
+ (oldfiles (progn (message "Finding old files with defcustoms...")
+ (cusver-find-files olddir t)))
+ (newcus (progn (message "Reading new defcustoms...")
+ (mapcar
+ (lambda (file)
+ (cons file (cusver-scan file))) newfiles)))
+ oldcus result thisfile file)
+ (message "Reading old defcustoms...")
+ (dolist (file oldfiles)
+ (setq oldcus (append oldcus (cusver-scan file t))))
+ (setq oldcus (append oldcus (cusver-scan-cus-start
+ (expand-file-name "cus-start.el" olddir))))
+ ;; newcus has elements (FILE (VAR VER) ... ).
+ ;; oldcus just (VAR . VER).
+ (message "Checking for version tags...")
+ (dolist (new newcus)
+ (setq file (car new)
+ thisfile
+ (let (missing var)
+ (dolist (cons (cdr new))
+ (or (cdr cons)
+ (assq (setq var (car cons)) oldcus)
+ (push var missing)))
+ (if missing
+ (cons file missing))))
+ (if thisfile
+ (setq result (cons thisfile result))))
+ (message "Checking for version tags... done")
+ (if (not result)
+ (message "No missing :version tags")
+ (pop-to-buffer "*cusver*")
+ (erase-buffer)
+ (insert "These defcustoms might be missing :version tags:\n\n")
+ (dolist (elem result)
+ (let* ((str (file-relative-name (car elem) newdir))
+ (strlen (length str)))
+ (dolist (var (cdr elem))
+ (insert (format "%s: %s\n" str var))
+ (make-text-button (+ (line-beginning-position 0) strlen 2)
+ (line-end-position 0)
+ 'file (car elem)
+ 'var var
+ 'help-echo "Mouse-2: visit this definition"
+ :type 'cusver-xref)))))))
+
(provide 'admin)
;;; admin.el ends here
diff --git a/admin/alloc-colors.c b/admin/alloc-colors.c
index b3ea8af9d70..2ad5acadcb0 100644
--- a/admin/alloc-colors.c
+++ b/admin/alloc-colors.c
@@ -1,6 +1,6 @@
/* Allocate X colors. Used for testing with dense colormaps.
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/admin/build-configs b/admin/build-configs
index 79ba58aeec0..59a3a1bbbca 100755
--- a/admin/build-configs
+++ b/admin/build-configs
@@ -1,7 +1,7 @@
#! /usr/bin/perl
# Build Emacs in several different configurations.
-# Copyright (C) 2001-2011 Free Software Foundation, Inc.
+# Copyright (C) 2001-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el
index 583f0d88866..8d64dd9edbf 100644
--- a/admin/bzrmerge.el
+++ b/admin/bzrmerge.el
@@ -1,9 +1,9 @@
;;; bzrmerge.el --- help merge one Emacs bzr branch to another
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-;; Keywords:
+;; Keywords: maint
;; 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
@@ -24,11 +24,11 @@
;;; Code:
-(eval-when-compile
- (require 'cl)) ; assert
+(eval-when-compile (require 'cl-lib))
(defvar bzrmerge-skip-regexp
- "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version"
+ "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version\\|from trunk\\|\
+Auto-commit"
"Regexp matching logs of revisions that might be skipped.
`bzrmerge-missing' will ask you if it should skip any matches.")
@@ -45,16 +45,23 @@ The list returned is sorted by oldest-first."
(erase-buffer)
;; We generally want to make sure we start with a clean tree, but we also
;; want to allow restarts (i.e. with some part of FROM already merged but
- ;; not yet committed).
+ ;; not yet committed). Unversioned (unknown) files in the tree
+ ;; are also ok.
(call-process "bzr" nil t nil "status" "-v")
(goto-char (point-min))
(when (re-search-forward "^conflicts:\n" nil t)
(error "You still have unresolved conflicts"))
- (let ((merges ()))
+ (let ((merges ())
+ found)
(if (not (re-search-forward "^pending merges:\n" nil t))
(when (save-excursion
(goto-char (point-min))
- (re-search-forward "^[a-z ]*:\n" nil t))
+ (while (and
+ (re-search-forward "^\\([a-z ]*\\):\n" nil t)
+ (not
+ (setq found
+ (not (equal "unknown" (match-string 1)))))))
+ found)
(error "You still have uncommitted changes"))
;; This is really stupid, but it seems there's no easy way to figure
;; out which revisions have been merged already. The only info I can
@@ -133,9 +140,23 @@ are both lists of revnos, in oldest-first order."
(setq str (substring str (match-end 0))))
(when (string-match "[.!;, ]+\\'" str)
(setq str (substring str 0 (match-beginning 0))))
- (if (save-excursion (y-or-n-p (concat str ": Skip? ")))
- (setq skip t))))
- (if skip
+ (let ((help-form "\
+Type `y' to skip this revision,
+`N' to include it and go on to the next revision,
+`n' to not skip, but continue to search this log entry for skip regexps,
+`q' to quit merging."))
+ (pcase (save-excursion
+ (read-char-choice
+ (format "%s: Skip (y/n/N/q/%s)? " str
+ (key-description (vector help-char)))
+ '(?y ?n ?N ?q)))
+ (`?y (setq skip t))
+ (`?q (keyboard-quit))
+ ;; A single log entry can match skip-regexp multiple
+ ;; times. If you are sure you don't want to skip it,
+ ;; you don't want to be asked multiple times.
+ (`?N (setq skip 'no))))))
+ (if (eq skip t)
(push revno skipped)
(push revno revnos)))))
(delete-region (point) (point-max)))
@@ -146,7 +167,8 @@ are both lists of revnos, in oldest-first order."
(unless (file-exists-p file) (error "Bzrmerge-resolve: Can't find %s" file))
(with-demoted-errors
(let ((exists (find-buffer-visiting file)))
- (with-current-buffer (let ((enable-local-variables :safe))
+ (with-current-buffer (let ((enable-local-variables :safe)
+ (enable-local-eval nil))
(find-file-noselect file))
(if (buffer-modified-p)
(error "Unsaved changes in %s" (current-buffer)))
@@ -241,17 +263,17 @@ Does not make other difference."
;; Do a "skip" (i.e. merge the meta-data only).
(setq beg (1- (car skip)))
(while (and skip (or (null merge) (< (car skip) (car merge))))
- (assert (> (car skip) (or end beg)))
+ (cl-assert (> (car skip) (or end beg)))
(setq end (pop skip)))
(message "Skipping %s..%s" beg end)
(bzrmerge-add-metadata from end))
(t
;; Do a "normal" merge.
- (assert (or (null skip) (< (car merge) (car skip))))
+ (cl-assert (or (null skip) (< (car merge) (car skip))))
(setq beg (1- (car merge)))
(while (and merge (or (null skip) (< (car merge) (car skip))))
- (assert (> (car merge) (or end beg)))
+ (cl-assert (> (car merge) (or end beg)))
(setq end (pop merge)))
(message "Merging %s..%s" beg end)
(if (with-temp-buffer
diff --git a/admin/charsets/Makefile b/admin/charsets/Makefile
index b16e7ccd748..e5cf2508d85 100644
--- a/admin/charsets/Makefile
+++ b/admin/charsets/Makefile
@@ -77,6 +77,7 @@ MULE = MULE-ethiopic.map MULE-ipa.map MULE-is13194.map \
MULE-lviscii.map MULE-uviscii.map
TRANS_TABLE = cp51932.el eucjp-ms.el
+SED_SCRIPT = jisx2131-filter
all: ${CHARSETS} ${TRANS_TABLE}
@@ -86,11 +87,11 @@ AWK = gawk
VSCII.map: ${GLIBC_CHARMAPS}/TCVN5712-1.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x[0-9a-f].[ ]/' GLIBC-1 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x[0-9a-f].[ ]/' GLIBC-1 compact.awk > $@
VSCII-2.map: ${GLIBC_CHARMAPS}/TCVN5712-1.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x[2-7a-f].[ ]/' GLIBC-1 compact.awk \
+ @./mapconv $< '/^<.*[ ]\/x[2-7a-f].[ ]/' GLIBC-1 compact.awk \
| sed 's/0x20-0x7F.*/0x00-0x7F 0x0000/' > $@
ALTERNATIVNYJ.map: IBM866.map
@@ -110,45 +111,45 @@ ALTERNATIVNYJ.map: IBM866.map
-e '/0xFA/ s/ .*/ 0x00B1/' \
-e '/0xFB/ s/ .*/ 0x00F7/' < $< >> $@
-MIK.map: mapfiles/bulgarian-mik.txt.gz mapconv compact.awk
+MIK.map: mapfiles/bulgarian-mik.txt mapconv compact.awk
# Generating $@...
- @mapconv $< '1,$$' CZYBORRA compact.awk > $@
+ @./mapconv $< '1,$$' CZYBORRA compact.awk > $@
-PTCP154.map: mapfiles/PTCP154.gz mapconv compact.awk
+PTCP154.map: mapfiles/PTCP154 mapconv compact.awk
# Generating $@...
- @mapconv $< '/^0x/' IANA compact.awk > $@
+ @./mapconv $< '/^0x/' IANA compact.awk > $@
-stdenc.map: mapfiles/stdenc.txt.gz mapconv compact.awk
+stdenc.map: mapfiles/stdenc.txt mapconv compact.awk
# Generating $@...
- @mapconv $< '/^[0-9A-Fa-f]/' UNICODE compact.awk > $@
+ @./mapconv $< '/^[0-9A-Fa-f]/' UNICODE compact.awk > $@
-symbol.map: mapfiles/symbol.txt.gz mapconv compact.awk
+symbol.map: mapfiles/symbol.txt mapconv compact.awk
# Generating $@...
- @mapconv $< '/^[0-9A-Fa-f]/' UNICODE compact.awk > $@
+ @./mapconv $< '/^[0-9A-Fa-f]/' UNICODE compact.awk > $@
-CP720.map: mapfiles/CP720.map.gz
+CP720.map: mapfiles/CP720.map
# Generating $@...
- @zcat $< > $@
+ @cp $< $@
-CP858.map: mapfiles/CP858.map.gz
+CP858.map: mapfiles/CP858.map
# Generating $@...
- @zcat $< > $@
+ @cp $< $@
CP949-2BYTE.map: ${GLIBC_CHARMAPS}/CP949.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x[89a-f]/' GLIBC-2 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x[89a-f]/' GLIBC-2 compact.awk > $@
GB2312.map: ${GLIBC_CHARMAPS}/GB2312.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x[a-f]/' GLIBC-2-7 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x[a-f]/' GLIBC-2-7 compact.awk > $@
GBK.map: ${GLIBC_CHARMAPS}/GBK.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x[89a-f]/' GLIBC-2 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x[89a-f]/' GLIBC-2 compact.awk > $@
GB180302.map: ${GLIBC_CHARMAPS}/GB18030.gz mapconv gb180302.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x..\/x..[ ]/' GLIBC-2 gb180302.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x..\/x..[ ]/' GLIBC-2 gb180302.awk > $@
GB180304.map: GB180302.map gb180304.awk
# Generating $@...
@@ -156,35 +157,39 @@ GB180304.map: GB180302.map gb180304.awk
JISX0201.map: ${GLIBC_CHARMAPS}/JIS_X0201.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x[0-9]/' GLIBC-1 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x[0-9]/' GLIBC-1 compact.awk > $@
@echo "# Generated by hand" >> $@
@echo "0xA1-0xDF 0xFF61" >> $@
JISX0208.map: ${GLIBC_CHARMAPS}/EUC-JP.gz mapconv
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x[a-f]/' GLIBC-2-7 \
+ @./mapconv $< '/^<.*[ ]\/x[a-f]/' GLIBC-2-7 \
| sed 's/0x2015/0x2014/' > $@
JISX0212.map: ${GLIBC_CHARMAPS}/EUC-JP.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x8f/ s,/x8f,,' GLIBC-2-7 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x8f/ s,/x8f,,' GLIBC-2-7 compact.awk > $@
-JISX2131.map: ${GLIBC_CHARMAPS}/EUC-JISX0213.gz mapconv
+jisx2131-filter: mapfiles/JISX213A.map
+ @sed -n -e '/^#/d' -e 's,.*0x\([0-9A-Z]*\)$$,/0x0*\1$$/d,p' < $< > $@
+
+JISX2131.map: ${GLIBC_CHARMAPS}/EUC-JISX0213.gz mapconv jisx2131-filter
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x[a-f]/' GLIBC-2-7 \
+ @./mapconv $< '/^<.*[ ]\/x[a-f]/' GLIBC-2-7 \
+ | sed -f jisx2131-filter \
| sed -e 's/0x2015/0x2014/' -e 's/0x2299/0x29BF/' > $@
JISX2132.map: ${GLIBC_CHARMAPS}/EUC-JISX0213.gz mapconv
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x8f/ s,/x8f,,' GLIBC-2-7 > $@
+ @./mapconv $< '/^<.*[ ]\/x8f/ s,/x8f,,' GLIBC-2-7 > $@
-JISX213A.map: mapfiles/JISX213A.map.gz
+JISX213A.map: mapfiles/JISX213A.map
# Generating $@
- @zcat $< > $@
+ @cp $< $@
-CP932-2BYTE.map: mapfiles/CP932.TXT.gz mapconv cp932.awk
+CP932-2BYTE.map: mapfiles/CP932.TXT mapconv cp932.awk
# Generating $@...
- @mapconv $< '/^0x[89A-F][0-9A-F][0-9A-F]/' UNICODE2 cp932.awk > $@
+ @./mapconv $< '/^0x[89A-F][0-9A-F][0-9A-F]/' UNICODE2 cp932.awk > $@
cp51932.el: CP932-2BYTE.map cp51932.awk
@$(AWK) -f cp51932.awk < CP932-2BYTE.map > $@
@@ -192,17 +197,27 @@ cp51932.el: CP932-2BYTE.map cp51932.awk
eucjp-ms.el: ${GLIBC_CHARMAPS}/EUC-JP-MS.gz eucjp-ms.awk
@zcat $< | $(AWK) -f eucjp-ms.awk > $@
-JISC6226.map : mapfiles/Uni2JIS.gz mapconv kuten.awk
+JISC6226.map: mapfiles/Uni2JIS mapconv kuten.awk
# Generating $@...
- @mapconv $< '/^[^#].*0-/' YASUOKA kuten.awk > $@
+# As Uni2JIS doesn't contain mappings of characters added to Unicode
+# recently, we add them manually here (including one correction for
+# U+005C vs U+FF3C). These changes are based on bogytech's blog at
+# http://bogytech.blogspot.jp/search/label/emacs.
+ @./mapconv $< '/^[^#].*0-/' YASUOKA kuten.awk \
+ | sed -e '/0x2140/s/005C/FF3C/' \
+ -e '$$ a 0x3442 0x3D4E' \
+ -e '$$ a 0x374E 0x25874' \
+ -e '$$ a 0x3764 0x28EF6' \
+ -e '$$ a 0x513D 0x2F80F' \
+ -e '$$ a 0x7045 0x9724' > $@
KSC5601.map: ${GLIBC_CHARMAPS}/EUC-KR.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x[a-f]/' GLIBC-2-7 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x[a-f]/' GLIBC-2-7 compact.awk > $@
BIG5.map: ${GLIBC_CHARMAPS}/BIG5.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x[a-f]/' GLIBC-2 > $@
+ @./mapconv $< '/^<.*[ ]\/x[a-f]/' GLIBC-2 > $@
BIG5-1.map: BIG5.map mapconv big5.awk
# Generating $@...
@@ -216,52 +231,52 @@ BIG5-2.map: BIG5.map mapconv big5.awk
BIG5-HKSCS.map: ${GLIBC_CHARMAPS}/BIG5-HKSCS.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x[89a-f].\//' GLIBC-2 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x[89a-f].\//' GLIBC-2 compact.awk > $@
JOHAB.map: ${GLIBC_CHARMAPS}/JOHAB.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x[89a-f]/' GLIBC-2 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x[89a-f]/' GLIBC-2 compact.awk > $@
CNS-1.map: ${GLIBC_CHARMAPS}/EUC-TW.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x[a-f]/' GLIBC-2-7 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x[a-f]/' GLIBC-2-7 compact.awk > $@
# CNS-1.map: mapfiles/cns2ucsdkw.txt mapconv compact.awk
# # Generating $@...
-# @mapconv $< '/^C1/' KANJI-DATABASE compact.awk > $@
+# @./mapconv $< '/^C1/' KANJI-DATABASE compact.awk > $@
-CNS-2.map: mapfiles/cns2ucsdkw.txt.gz mapconv compact.awk
+CNS-2.map: mapfiles/cns2ucsdkw.txt mapconv compact.awk
# Generating $@...
- @mapconv $< '/^C2/' KANJI-DATABASE compact.awk > $@
+ @./mapconv $< '/^C2/' KANJI-DATABASE compact.awk > $@
-CNS-3.map: mapfiles/cns2ucsdkw.txt.gz mapconv compact.awk
+CNS-3.map: mapfiles/cns2ucsdkw.txt mapconv compact.awk
# Generating $@...
- @mapconv $< '/^C3/' KANJI-DATABASE compact.awk > $@
+ @./mapconv $< '/^C3/' KANJI-DATABASE compact.awk > $@
-CNS-4.map: mapfiles/cns2ucsdkw.txt.gz mapconv compact.awk
+CNS-4.map: mapfiles/cns2ucsdkw.txt mapconv compact.awk
# Generating $@...
- @mapconv $< '/^C4/' KANJI-DATABASE compact.awk > $@
+ @./mapconv $< '/^C4/' KANJI-DATABASE compact.awk > $@
-CNS-5.map: mapfiles/cns2ucsdkw.txt.gz mapconv compact.awk
+CNS-5.map: mapfiles/cns2ucsdkw.txt mapconv compact.awk
# Generating $@...
- @mapconv $< '/^C5/' KANJI-DATABASE compact.awk > $@
+ @./mapconv $< '/^C5/' KANJI-DATABASE compact.awk > $@
-CNS-6.map: mapfiles/cns2ucsdkw.txt.gz mapconv compact.awk
+CNS-6.map: mapfiles/cns2ucsdkw.txt mapconv compact.awk
# Generating $@...
- @mapconv $< '/^C6/' KANJI-DATABASE compact.awk > $@
+ @./mapconv $< '/^C6/' KANJI-DATABASE compact.awk > $@
-CNS-7.map: mapfiles/cns2ucsdkw.txt.gz mapconv compact.awk
+CNS-7.map: mapfiles/cns2ucsdkw.txt mapconv compact.awk
# Generating $@...
- @mapconv $< '/^C7/' KANJI-DATABASE compact.awk > $@
+ @./mapconv $< '/^C7/' KANJI-DATABASE compact.awk > $@
CNS-F.map: ${GLIBC_CHARMAPS}/EUC-TW.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*\/x8e\/xaf/ s,/x8e/xaf,,' GLIBC-2-7 compact.awk > $@
+ @./mapconv $< '/^<.*\/x8e\/xaf/ s,/x8e/xaf,,' GLIBC-2-7 compact.awk > $@
# General target to produce map files for mule charsets.
-MULE-%.map: mapfiles/MULE-%.map.gz
+MULE-%.map: mapfiles/MULE-%.map
# Generating $@...
- @zcat $< > $@
+ @cp $< $@
# General target to produce map files for ISO-8859, GEORGIAN, and
# EBCDIC charsets. We can not use the original file name because of
@@ -269,21 +284,21 @@ MULE-%.map: mapfiles/MULE-%.map.gz
8859-%.map: ${GLIBC_CHARMAPS}/ISO-8859-%.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x/' GLIBC-1 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x/' GLIBC-1 compact.awk > $@
KA-%.map: ${GLIBC_CHARMAPS}/GEORGIAN-%.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x/' GLIBC-1 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x/' GLIBC-1 compact.awk > $@
EBCDIC%.map: ${GLIBC_CHARMAPS}/EBCDIC-%.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x/' GLIBC-1 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x/' GLIBC-1 compact.awk > $@
# General target to produce map files for single-byte charsets.
%.map: ${GLIBC_CHARMAPS}/%.gz mapconv compact.awk
# Generating $@...
- @mapconv $< '/^<.*[ ]\/x/' GLIBC-1 compact.awk > $@
+ @./mapconv $< '/^<.*[ ]\/x/' GLIBC-1 compact.awk > $@
install:
@for f in ${CHARSETS}; do \
@@ -305,5 +320,5 @@ install:
# Clear files that are automatically generated.
clean:
- rm -f ${CHARSETS} ${TRANS_TABLE}
+ rm -f ${CHARSETS} ${TRANS_TABLE} ${SED_SCRIPT}
diff --git a/admin/charsets/gb180302.awk b/admin/charsets/gb180302.awk
index 6cd9521ce90..40d92bf9be4 100644
--- a/admin/charsets/gb180302.awk
+++ b/admin/charsets/gb180302.awk
@@ -74,19 +74,30 @@ function index_to_gb(idx) {
{
gb = gb_to_index(decode_hex(substr($1, 3, 4)));
- unicode = decode_hex(substr($2, 3, 4));
+ unicode = decode_hex(substr($2, 3));
if ((gb == to_gb + 1) && (unicode == to_unicode + 1))
{
to_gb++;
to_unicode++;
}
- else
+ else if (gb > to_gb) # ignore the case gb == to_gb that is a duplication
{
if (from_gb == to_gb)
- printf "0x%04X 0x%04X\n", index_to_gb(from_gb), from_unicode;
+ {
+ if (from_unicode <= 65535)
+ printf "0x%04X 0x%04X\n", index_to_gb(from_gb), from_unicode;
+ else
+ printf "0x%04X 0x%08X\n", index_to_gb(from_gb), from_unicode;
+ }
else if (from_gb < to_gb)
- printf "0x%04X-0x%04X 0x%04X\n",
- index_to_gb(from_gb), index_to_gb(to_gb), from_unicode;
+ {
+ if (from_unicode <= 65535)
+ printf "0x%04X-0x%04X 0x%04X\n",
+ index_to_gb(from_gb), index_to_gb(to_gb), from_unicode;
+ else
+ printf "0x%04X-0x%04X 0x%08X\n",
+ index_to_gb(from_gb), index_to_gb(to_gb), from_unicode;
+ }
from_gb = to_gb = gb;
from_unicode = to_unicode = unicode;
}
diff --git a/admin/charsets/mapconv b/admin/charsets/mapconv
index 4f7a8b96f54..8433d222b8d 100755
--- a/admin/charsets/mapconv
+++ b/admin/charsets/mapconv
@@ -98,18 +98,17 @@ elif [ "$3" = "GLIBC-2-7" ] ; then
| sed -e 's/xa/x2/g' -e 's/xb/x3/g' -e 's/xc/x4/g' \
-e 's/xd/x5/g' -e 's/xe/x6/g' -e 's/xf/x7/g' \
-e 's,<U\([^>]*\)>[ ]*/x\(..\)/x\(..\).*,0x\2\3 0x\1,' \
- | tee temp \
| sort | ${AWKPROG}
elif [ "$3" = "CZYBORRA" ] ; then
# Source format is:
# =XX U+YYYY
- zcat $1 | sed -n -e "$2 p" \
+ sed -n -e "$2 p" < $1 \
| sed -e 's/=\(..\)[^U]*U+\([0-9A-F]*\).*/0x\1 0x\2/' \
| sort | ${AWKPROG}
elif [ "$3" = "IANA" ] ; then
# Source format is:
# 0xXX 0xYYYY
- zcat $1 | sed -n -e "$2 p" \
+ sed -n -e "$2 p" < $1 \
| sed -e 's/\(0x[0-9A-Fa-f]*\)[^0]*\(0x[0-9A-Fa-f]*\).*/\1 \2/' \
| sort | ${AWKPROG}
elif [ "$3" = "UNICODE" ] ; then
@@ -117,25 +116,25 @@ elif [ "$3" = "UNICODE" ] ; then
# YYYY XX
# We perform reverse sort to prefer the first one in the
# duplicated mappings (e.g. 0x20->U+0020, 0x20->U+00A0).
- zcat $1 | sed -n -e "$2 p" \
+ sed -n -e "$2 p" < $1 \
| sed -e 's/\([0-9A-F]*\)[^0-9A-F]*\([0-9A-F]*\).*/0x\2 0x\1/' \
| sort -r
elif [ "$3" = "UNICODE2" ] ; then
# Source format is:
# 0xXXXX 0xYYYY # ...
- zcat $1 | sed -n -e "$2 p" \
+ sed -n -e "$2 p" < $1 \
| sed -e 's/\([0-9A-Fx]*\)[^0]*\([0-9A-Fx]*\).*/\1 \2/' \
| ${AWKPROG} | sort -n -k 4,4
elif [ "$3" = "YASUOKA" ] ; then
# Source format is:
# YYYY 0-XXXX (XXXX is a Kuten code)
- zcat $1 | sed -n -e "$2 p" \
+ sed -n -e "$2 p" < $1 \
| sed -e 's/\([0-9A-F]*\)[^0]*0-\([0-9]*\).*/0x\2 0x\1/' \
| sort | ${AWKPROG}
elif [ "$3" = "KANJI-DATABASE" ] ; then
# Source format is:
# C?-XXXX U+YYYYY .....
- zcat $1 | sed -n -e "$2 p" \
+ sed -n -e "$2 p" < $1 \
| sed -e 's/...\(....\) U+\([0-9A-F]*\).*/0x\1 0x\2/' \
| sort | ${AWKPROG}
else
diff --git a/admin/charsets/mapfiles/MULE-ethiopic.map b/admin/charsets/mapfiles/MULE-ethiopic.map
index d2720bd10ba..30cf5736763 100644
--- a/admin/charsets/mapfiles/MULE-ethiopic.map
+++ b/admin/charsets/mapfiles/MULE-ethiopic.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x2121 0x1200
0x2122 0x1201
0x2123 0x1202
diff --git a/admin/charsets/mapfiles/MULE-ipa.map b/admin/charsets/mapfiles/MULE-ipa.map
index 35e5d50ecec..0a6c61d5a95 100644
--- a/admin/charsets/mapfiles/MULE-ipa.map
+++ b/admin/charsets/mapfiles/MULE-ipa.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x20 0x0069
0x21 0x026A
0x22 0x0065
diff --git a/admin/charsets/mapfiles/MULE-is13194.map b/admin/charsets/mapfiles/MULE-is13194.map
index 1fa9b21dcf8..390132cd375 100644
--- a/admin/charsets/mapfiles/MULE-is13194.map
+++ b/admin/charsets/mapfiles/MULE-is13194.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x21 0x0901
0x22 0x0902
0x23 0x0903
diff --git a/admin/charsets/mapfiles/MULE-lviscii.map b/admin/charsets/mapfiles/MULE-lviscii.map
index 3b6a38be616..e4d2eca90ac 100644
--- a/admin/charsets/mapfiles/MULE-lviscii.map
+++ b/admin/charsets/mapfiles/MULE-lviscii.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x21 0x1EAF
0x22 0x1EB1
0x23 0x1EB7
diff --git a/admin/charsets/mapfiles/MULE-sisheng.map b/admin/charsets/mapfiles/MULE-sisheng.map
index 405bb1ffa2c..144a3ff5134 100644
--- a/admin/charsets/mapfiles/MULE-sisheng.map
+++ b/admin/charsets/mapfiles/MULE-sisheng.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x21 0x0101
0x22 0x00E1
0x23 0x01CE
diff --git a/admin/charsets/mapfiles/MULE-tibetan.map b/admin/charsets/mapfiles/MULE-tibetan.map
index 0d6ff3a0a39..b885585c094 100644
--- a/admin/charsets/mapfiles/MULE-tibetan.map
+++ b/admin/charsets/mapfiles/MULE-tibetan.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x2130 0x0F00
0x2131 0x0F01
0x2132 0x0F02
diff --git a/admin/charsets/mapfiles/MULE-uviscii.map b/admin/charsets/mapfiles/MULE-uviscii.map
index 65e5d2968e5..dc19583bdfe 100644
--- a/admin/charsets/mapfiles/MULE-uviscii.map
+++ b/admin/charsets/mapfiles/MULE-uviscii.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x21 0x1EAE
0x22 0x1EB0
0x23 0x1EB6
diff --git a/admin/charsets/mapfiles/README b/admin/charsets/mapfiles/README
index e87d548cf31..b43611db11d 100644
--- a/admin/charsets/mapfiles/README
+++ b/admin/charsets/mapfiles/README
@@ -1,4 +1,4 @@
-Copyright (C) 2009-2011 Free Software Foundation, Inc.
+Copyright (C) 2009-2012 Free Software Foundation, Inc.
Copyright (C) 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
diff --git a/admin/charsets/mule-charsets.el b/admin/charsets/mule-charsets.el
index 9ac08bef724..4a48d994b1b 100644
--- a/admin/charsets/mule-charsets.el
+++ b/admin/charsets/mule-charsets.el
@@ -45,7 +45,7 @@
(defconst header
(format
- "# Generated by running amdin/charsets/mule-charsets.el in Emacs %d.%d.\n"
+ "# Generated by running admin/charsets/mule-charsets.el in Emacs %d.%d.\n"
emacs-major-version emacs-minor-version))
(dolist (elt charset-alist)
diff --git a/admin/coccinelle/README b/admin/coccinelle/README
new file mode 100644
index 00000000000..48a88dbc8d8
--- /dev/null
+++ b/admin/coccinelle/README
@@ -0,0 +1,3 @@
+This directory contains semantic patches for Coccinelle, a program matching
+and transformation tool for programs written in C. For more details, see
+http://coccinelle.lip6.fr.
diff --git a/admin/coccinelle/build_string.cocci b/admin/coccinelle/build_string.cocci
new file mode 100644
index 00000000000..d47727018dd
--- /dev/null
+++ b/admin/coccinelle/build_string.cocci
@@ -0,0 +1,6 @@
+// Convert simple cases to build_string.
+@@
+identifier I;
+@@
+- make_string (I, strlen (I))
++ build_string (I)
diff --git a/admin/coccinelle/frame.cocci b/admin/coccinelle/frame.cocci
new file mode 100644
index 00000000000..a817382120a
--- /dev/null
+++ b/admin/coccinelle/frame.cocci
@@ -0,0 +1,133 @@
+// Change direct access to Lisp_Object fields of struct frame to FVAR.
+@@
+expression F;
+@@
+(
+- F->icon_name
++ FVAR (F, icon_name)
+|
+- F->title
++ FVAR (F, title)
+|
+- F->focus_frame
++ FVAR (F, focus_frame)
+|
+- F->root_window
++ FVAR (F, root_window)
+|
+- F->selected_window
++ FVAR (F, selected_window)
+|
+- F->minibuffer_window
++ FVAR (F, minibuffer_window)
+|
+- F->param_alist
++ FVAR (F, param_alist)
+|
+- F->scroll_bars
++ FVAR (F, scroll_bars)
+|
+- F->condemned_scroll_bars
++ FVAR (F, condemned_scroll_bars)
+|
+- F->menu_bar_items
++ FVAR (F, menu_bar_items)
+|
+- F->face_alist
++ FVAR (F, face_alist)
+|
+- F->menu_bar_vector
++ FVAR (F, menu_bar_vector)
+|
+- F->buffer_predicate
++ FVAR (F, buffer_predicate)
+|
+- F->buffer_list
++ FVAR (F, buffer_list)
+|
+- F->buried_buffer_list
++ FVAR (F, buried_buffer_list)
+|
+- F->menu_bar_window
++ FVAR (F, menu_bar_window)
+|
+- F->tool_bar_window
++ FVAR (F, tool_bar_window)
+|
+- F->tool_bar_items
++ FVAR (F, tool_bar_items)
+|
+- F->tool_bar_position
++ FVAR (F, tool_bar_position)
+|
+- F->desired_tool_bar_string
++ FVAR (F, desired_tool_bar_string)
+|
+- F->current_tool_bar_string
++ FVAR (F, current_tool_bar_string)
+
+|
+
+- XFRAME (F)->icon_name
++ FVAR (XFRAME (F), icon_name)
+|
+- XFRAME (F)->title
++ FVAR (XFRAME (F), title)
+|
+- XFRAME (F)->focus_frame
++ FVAR (XFRAME (F), focus_frame)
+|
+- XFRAME (F)->root_window
++ FVAR (XFRAME (F), root_window)
+|
+- XFRAME (F)->selected_window
++ FVAR (XFRAME (F), selected_window)
+|
+- XFRAME (F)->minibuffer_window
++ FVAR (XFRAME (F), minibuffer_window)
+|
+- XFRAME (F)->param_alist
++ FVAR (XFRAME (F), param_alist)
+|
+- XFRAME (F)->scroll_bars
++ FVAR (XFRAME (F), scroll_bars)
+|
+- XFRAME (F)->condemned_scroll_bars
++ FVAR (XFRAME (F), condemned_scroll_bars)
+|
+- XFRAME (F)->menu_bar_items
++ FVAR (XFRAME (F), menu_bar_items)
+|
+- XFRAME (F)->face_alist
++ FVAR (XFRAME (F), face_alist)
+|
+- XFRAME (F)->menu_bar_vector
++ FVAR (XFRAME (F), menu_bar_vector)
+|
+- XFRAME (F)->buffer_predicate
++ FVAR (XFRAME (F), buffer_predicate)
+|
+- XFRAME (F)->buffer_list
++ FVAR (XFRAME (F), buffer_list)
+|
+- XFRAME (F)->buried_buffer_list
++ FVAR (XFRAME (F), buried_buffer_list)
+|
+- XFRAME (F)->menu_bar_window
++ FVAR (XFRAME (F), menu_bar_window)
+|
+- XFRAME (F)->tool_bar_window
++ FVAR (XFRAME (F), tool_bar_window)
+|
+- XFRAME (F)->tool_bar_items
++ FVAR (XFRAME (F), tool_bar_items)
+|
+- XFRAME (F)->tool_bar_position
++ FVAR (XFRAME (F), tool_bar_position)
+|
+- XFRAME (F)->desired_tool_bar_string
++ FVAR (XFRAME (F), desired_tool_bar_string)
+|
+- XFRAME (F)->current_tool_bar_string
++ FVAR (XFRAME (F), current_tool_bar_string)
+)
diff --git a/admin/coccinelle/list_loop.cocci b/admin/coccinelle/list_loop.cocci
new file mode 100644
index 00000000000..89f0bfff7b3
--- /dev/null
+++ b/admin/coccinelle/list_loop.cocci
@@ -0,0 +1,19 @@
+// Omit redundant type check, consistently use CONSP.
+@@
+identifier A;
+expression X;
+statement S;
+@@
+(
+for (A = X;
+- !NILP (A);
++ CONSP (A);
+- A = Fcdr (A))
++ A = XCDR (A))
+S
+|
+for (A = X; CONSP (A);
+- A = Fcdr (A))
++ A = XCDR (A))
+S
+)
diff --git a/admin/coccinelle/process.cocci b/admin/coccinelle/process.cocci
new file mode 100644
index 00000000000..bf295ab7b6f
--- /dev/null
+++ b/admin/coccinelle/process.cocci
@@ -0,0 +1,110 @@
+// Change direct access to Lisp_Object fields of struct Lisp_Process to PVAR.
+@@
+struct Lisp_Process *P;
+Lisp_Object O;
+@@
+(
+- P->tty_name
++ PVAR (P, tty_name)
+|
+- P->name
++ PVAR (P, name)
+|
+- P->command
++ PVAR (P, command)
+|
+- P->filter
++ PVAR (P, filter)
+|
+- P->sentinel
++ PVAR (P, sentinel)
+|
+- P->log
++ PVAR (P, log)
+|
+- P->buffer
++ PVAR (P, buffer)
+|
+- P->childp
++ PVAR (P, childp)
+|
+- P->plist
++ PVAR (P, plist)
+|
+- P->type
++ PVAR (P, type)
+|
+- P->mark
++ PVAR (P, mark)
+|
+- P->status
++ PVAR (P, status)
+|
+- P->decode_coding_system
++ PVAR (P, decode_coding_system)
+|
+- P->decoding_buf
++ PVAR (P, decoding_buf)
+|
+- P->encode_coding_system
++ PVAR (P, encode_coding_system)
+|
+- P->encoding_buf
++ PVAR (P, encoding_buf)
+|
+- P->write_queue
++ PVAR (P, write_queue)
+
+|
+
+- XPROCESS (O)->tty_name
++ PVAR (XPROCESS (O), tty_name)
+|
+- XPROCESS (O)->name
++ PVAR (XPROCESS (O), name)
+|
+- XPROCESS (O)->command
++ PVAR (XPROCESS (O), command)
+|
+- XPROCESS (O)->filter
++ PVAR (XPROCESS (O), filter)
+|
+- XPROCESS (O)->sentinel
++ PVAR (XPROCESS (O), sentinel)
+|
+- XPROCESS (O)->log
++ PVAR (XPROCESS (O), log)
+|
+- XPROCESS (O)->buffer
++ PVAR (XPROCESS (O), buffer)
+|
+- XPROCESS (O)->childp
++ PVAR (XPROCESS (O), childp)
+|
+- XPROCESS (O)->plist
++ PVAR (XPROCESS (O), plist)
+|
+- XPROCESS (O)->type
++ PVAR (XPROCESS (O), type)
+|
+- XPROCESS (O)->mark
++ PVAR (XPROCESS (O), mark)
+|
+- XPROCESS (O)->status
++ PVAR (XPROCESS (O), status)
+|
+- XPROCESS (O)->decode_coding_system
++ PVAR (XPROCESS (O), decode_coding_system)
+|
+- XPROCESS (O)->decoding_buf
++ PVAR (XPROCESS (O), decoding_buf)
+|
+- XPROCESS (O)->encode_coding_system
++ PVAR (XPROCESS (O), encode_coding_system)
+|
+- XPROCESS (O)->encoding_buf
++ PVAR (XPROCESS (O), encoding_buf)
+|
+- XPROCESS (O)->write_queue
++ PVAR (XPROCESS (O), write_queue)
+)
diff --git a/admin/coccinelle/unibyte_string.cocci b/admin/coccinelle/unibyte_string.cocci
new file mode 100644
index 00000000000..0ff8cafa15d
--- /dev/null
+++ b/admin/coccinelle/unibyte_string.cocci
@@ -0,0 +1,6 @@
+// make_unibyte_string (str, strlen (str)) -> build_unibyte_string (str)
+@@
+identifier I;
+@@
+- make_unibyte_string (I, strlen (I))
++ build_unibyte_string (I)
diff --git a/admin/coccinelle/vector_contents.cocci b/admin/coccinelle/vector_contents.cocci
new file mode 100644
index 00000000000..3c696ffd237
--- /dev/null
+++ b/admin/coccinelle/vector_contents.cocci
@@ -0,0 +1,16 @@
+// Avoid direct access to `contents' member of
+// Lisp_Vector, use AREF and ASET where possible.
+@expression@
+identifier I1, I2;
+expression E1, E2;
+@@
+(
+- XVECTOR (I1)->contents[I2++] = E1
++ ASET (I1, I2, E1), I2++
+|
+- XVECTOR (I1)->contents[E1] = E2
++ ASET (I1, E1, E2)
+|
+- XVECTOR (I1)->contents[E1]
++ AREF (I1, E1)
+)
diff --git a/admin/coccinelle/window.cocci b/admin/coccinelle/window.cocci
new file mode 100644
index 00000000000..1448febfcc1
--- /dev/null
+++ b/admin/coccinelle/window.cocci
@@ -0,0 +1,242 @@
+// Change direct access to Lisp_Object fields of struct window to WVAR.
+@@
+struct window *W;
+Lisp_Object O;
+@@
+(
+- W->frame
++ WVAR (W, frame)
+|
+- W->next
++ WVAR (W, next)
+|
+- W->prev
++ WVAR (W, prev)
+|
+- W->hchild
++ WVAR (W, hchild)
+|
+- W->vchild
++ WVAR (W, vchild)
+|
+- W->parent
++ WVAR (W, parent)
+|
+- W->left_col
++ WVAR (W, left_col)
+|
+- W->top_line
++ WVAR (W, top_line)
+|
+- W->total_lines
++ WVAR (W, total_lines)
+|
+- W->total_cols
++ WVAR (W, total_cols)
+|
+- W->normal_lines
++ WVAR (W, normal_lines)
+|
+- W->normal_cols
++ WVAR (W, normal_cols)
+|
+- W->new_total
++ WVAR (W, new_total)
+|
+- W->new_normal
++ WVAR (W, new_normal)
+|
+- W->buffer
++ WVAR (W, buffer)
+|
+- W->start
++ WVAR (W, start)
+|
+- W->pointm
++ WVAR (W, pointm)
+|
+- W->temslot
++ WVAR (W, temslot)
+|
+- W->vertical_scroll_bar
++ WVAR (W, vertical_scroll_bar)
+|
+- W->left_margin_cols
++ WVAR (W, left_margin_cols)
+|
+- W->right_margin_cols
++ WVAR (W, right_margin_cols)
+|
+- W->left_fringe_width
++ WVAR (W, left_fringe_width)
+|
+- W->right_fringe_width
++ WVAR (W, right_fringe_width)
+|
+- W->scroll_bar_width
++ WVAR (W, scroll_bar_width)
+|
+- W->vertical_scroll_bar_type
++ WVAR (W, vertical_scroll_bar_type)
+|
+- W->window_end_pos
++ WVAR (W, window_end_pos)
+|
+- W->window_end_vpos
++ WVAR (W, window_end_vpos)
+|
+- W->window_end_valid
++ WVAR (W, window_end_valid)
+|
+- W->display_table
++ WVAR (W, display_table)
+|
+- W->dedicated
++ WVAR (W, dedicated)
+|
+- W->base_line_number
++ WVAR (W, base_line_number)
+|
+- W->base_line_pos
++ WVAR (W, base_line_pos)
+|
+- W->region_showing
++ WVAR (W, region_showing)
+|
+- W->column_number_displayed
++ WVAR (W, column_number_displayed)
+|
+- W->redisplay_end_trigger
++ WVAR (W, redisplay_end_trigger)
+|
+- W->combination_limit
++ WVAR (W, combination_limit)
+|
+- W->prev_buffers
++ WVAR (W, prev_buffers)
+|
+- W->next_buffers
++ WVAR (W, next_buffers)
+|
+- W->window_parameters
++ WVAR (W, window_parameters)
+
+|
+
+- XWINDOW (O)->frame
++ WVAR (XWINDOW (O), frame)
+|
+- XWINDOW (O)->next
++ WVAR (XWINDOW (O), next)
+|
+- XWINDOW (O)->prev
++ WVAR (XWINDOW (O), prev)
+|
+- XWINDOW (O)->hchild
++ WVAR (XWINDOW (O), hchild)
+|
+- XWINDOW (O)->vchild
++ WVAR (XWINDOW (O), vchild)
+|
+- XWINDOW (O)->parent
++ WVAR (XWINDOW (O), parent)
+|
+- XWINDOW (O)->left_col
++ WVAR (XWINDOW (O), left_col)
+|
+- XWINDOW (O)->top_line
++ WVAR (XWINDOW (O), top_line)
+|
+- XWINDOW (O)->total_lines
++ WVAR (XWINDOW (O), total_lines)
+|
+- XWINDOW (O)->total_cols
++ WVAR (XWINDOW (O), total_cols)
+|
+- XWINDOW (O)->normal_lines
++ WVAR (XWINDOW (O), normal_lines)
+|
+- XWINDOW (O)->normal_cols
++ WVAR (XWINDOW (O), normal_cols)
+|
+- XWINDOW (O)->new_total
++ WVAR (XWINDOW (O), new_total)
+|
+- XWINDOW (O)->new_normal
++ WVAR (XWINDOW (O), new_normal)
+|
+- XWINDOW (O)->buffer
++ WVAR (XWINDOW (O), buffer)
+|
+- XWINDOW (O)->start
++ WVAR (XWINDOW (O), start)
+|
+- XWINDOW (O)->pointm
++ WVAR (XWINDOW (O), pointm)
+|
+- XWINDOW (O)->temslot
++ WVAR (XWINDOW (O), temslot)
+|
+- XWINDOW (O)->vertical_scroll_bar
++ WVAR (XWINDOW (O), vertical_scroll_bar)
+|
+- XWINDOW (O)->left_margin_cols
++ WVAR (XWINDOW (O), left_margin_cols)
+|
+- XWINDOW (O)->right_margin_cols
++ WVAR (XWINDOW (O), right_margin_cols)
+|
+- XWINDOW (O)->left_fringe_width
++ WVAR (XWINDOW (O), left_fringe_width)
+|
+- XWINDOW (O)->right_fringe_width
++ WVAR (XWINDOW (O), right_fringe_width)
+|
+- XWINDOW (O)->scroll_bar_width
++ WVAR (XWINDOW (O), scroll_bar_width)
+|
+- XWINDOW (O)->vertical_scroll_bar_type
++ WVAR (XWINDOW (O), vertical_scroll_bar_type)
+|
+- XWINDOW (O)->window_end_pos
++ WVAR (XWINDOW (O), window_end_pos)
+|
+- XWINDOW (O)->window_end_vpos
++ WVAR (XWINDOW (O), window_end_vpos)
+|
+- XWINDOW (O)->window_end_valid
++ WVAR (XWINDOW (O), window_end_valid)
+|
+- XWINDOW (O)->display_table
++ WVAR (XWINDOW (O), display_table)
+|
+- XWINDOW (O)->dedicated
++ WVAR (XWINDOW (O), dedicated)
+|
+- XWINDOW (O)->base_line_number
++ WVAR (XWINDOW (O), base_line_number)
+|
+- XWINDOW (O)->base_line_pos
++ WVAR (XWINDOW (O), base_line_pos)
+|
+- XWINDOW (O)->region_showing
++ WVAR (XWINDOW (O), region_showing)
+|
+- XWINDOW (O)->column_number_displayed
++ WVAR (XWINDOW (O), column_number_displayed)
+|
+- XWINDOW (O)->redisplay_end_trigger
++ WVAR (XWINDOW (O), redisplay_end_trigger)
+|
+- XWINDOW (O)->combination_limit
++ WVAR (XWINDOW (O), combination_limit)
+|
+- XWINDOW (O)->prev_buffers
++ WVAR (XWINDOW (O), prev_buffers)
+|
+- XWINDOW (O)->next_buffers
++ WVAR (XWINDOW (O), next_buffers)
+|
+- XWINDOW (O)->window_parameters
++ WVAR (XWINDOW (O), window_parameters)
+)
diff --git a/admin/coccinelle/xzalloc.cocci b/admin/coccinelle/xzalloc.cocci
new file mode 100644
index 00000000000..5d3ba990266
--- /dev/null
+++ b/admin/coccinelle/xzalloc.cocci
@@ -0,0 +1,10 @@
+@@
+expression x;
+expression E;
+@@
+ x =
+- xmalloc
++ xzalloc
+ (E)
+ ...
+- memset (x, 0, E);
diff --git a/admin/cus-test.el b/admin/cus-test.el
index b254fedccc4..11d781ed01e 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -1,6 +1,6 @@
;;; cus-test.el --- tests for custom types and load problems
-;; Copyright (C) 1998, 2000, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2002-2012 Free Software Foundation, Inc.
;; Author: Markus Rost <markus.rost@mathematik.uni-regensburg.de>
;; Maintainer: Markus Rost <rost@math.ohio-state.edu>
diff --git a/admin/diff-tar-files b/admin/diff-tar-files
index 59ae1a6f26c..1dbf9a12399 100755
--- a/admin/diff-tar-files
+++ b/admin/diff-tar-files
@@ -1,6 +1,6 @@
#! /bin/sh
-# Copyright (C) 2001-2011 Free Software Foundation, Inc.
+# Copyright (C) 2001-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/admin/grammars/README b/admin/grammars/README
index 419797e0dcb..e38260952a5 100644
--- a/admin/grammars/README
+++ b/admin/grammars/README
@@ -3,8 +3,8 @@ generate the parser data in the lisp/semantic/bovine/ and
lisp/semantic/wisent/ directories. You can run the parser generators
with
-emacs -batch -Q -l bovine-grammar.el -f bovine-make-parsers
-emacs -batch -Q -l wisent-grammar.el -f wisent-make-parsers
+emacs -batch -Q -l semantic/bovine/grammar -f bovine-make-parsers
+emacs -batch -Q -l semantic/wisent/grammar -f wisent-make-parsers
Currently, the parser files in lisp/ are not generated directly from
these grammar files when making Emacs. This state of affairs, and the
diff --git a/admin/grammars/c.by b/admin/grammars/c.by
index b49f8ce76c7..dfced9813d1 100644
--- a/admin/grammars/c.by
+++ b/admin/grammars/c.by
@@ -1,6 +1,5 @@
;;; c.by -- LL grammar for C/C++ language specification
-
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;;
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; David Ponce <david@dponce.com>
@@ -39,6 +38,13 @@
;; > * Can't parse signature element: "RmcBucStatus* rftBucStatus"
%package semantic-c-by
+%provide semantic/bovine/c-by
+
+%{
+(declare-function semantic-c-reconstitute-token "semantic/bovine/c")
+(declare-function semantic-c-reconstitute-template "semantic/bovine/c")
+(declare-function semantic-expand-c-tag "semantic/bovine/c")
+}
%languagemode c-mode c++-mode
%start declaration
@@ -98,6 +104,8 @@
%put VIRTUAL summary "Method Modifier: virtual <type> <name>(...) ..."
%token MUTABLE "mutable"
%put MUTABLE summary "Member Declaration Modifier: mutable <type> <name> ..."
+%token EXPLICIT "explicit"
+%put EXPLICIT summary "Forbids implicit type conversion: explicit <constructor>"
%token STRUCT "struct"
%put STRUCT summary "Structure Type Declaration: struct [name] { ... };"
@@ -261,7 +269,7 @@ define
;
;; In C++, structures can have the same things as classes.
-;; So delete this somday in the figure.
+;; So delete this some day in the figure.
;;
;;structparts : semantic-list
;; (EXPANDFULL $1 structsubparts)
@@ -370,6 +378,9 @@ namespacesubparts
;; PUBLIC or PRIVATE bits. Ignore them for now.
| template
| using
+ ;; Includes inside namespaces
+ | spp-include
+ (TAG $1 'include :inside-ns t)
| ;;EMPTY
;
@@ -1098,6 +1109,8 @@ functionname
function-pointer
: LPAREN STAR symbol RPAREN
( (concat "*" $3) )
+ | LPAREN symbol RPAREN
+ ( $2 )
;
fun-or-proto-end
diff --git a/admin/grammars/grammar.wy b/admin/grammars/grammar.wy
index 18e8b814303..f89fe6220ff 100644
--- a/admin/grammars/grammar.wy
+++ b/admin/grammars/grammar.wy
@@ -1,6 +1,6 @@
;;; semantic-grammar.wy -- LALR grammar of Semantic input grammars
;;
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -23,6 +23,9 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+%package semantic-grammar-wy
+%provide semantic/grammar-wy
+
%{
(defvar semantic-grammar-lex-c-char-re)
@@ -32,8 +35,6 @@
(defvar semantic-grammar-wy--rindx nil)
}
-%package semantic-grammar-wy
-
%languagemode wy-mode
;; Main
@@ -52,6 +53,7 @@
%keyword LEFT "%left"
%keyword NONASSOC "%nonassoc"
%keyword PACKAGE "%package"
+%keyword PROVIDE "%provide"
%keyword PREC "%prec"
%keyword PUT "%put"
%keyword QUOTEMODE "%quotemode"
@@ -134,6 +136,7 @@ decl:
| no_default_prec_decl
| languagemode_decl
| package_decl
+ | provide_decl
| precedence_decl
| put_decl
| quotemode_decl
@@ -165,6 +168,11 @@ package_decl:
`(PACKAGE-TAG ',$2 nil)
;
+provide_decl:
+ PROVIDE SYMBOL
+ `(TAG ',$2 'provide)
+ ;
+
precedence_decl:
associativity token_type_opt items
`(TAG ',$1 'assoc :type ',$2 :value ',$3)
diff --git a/admin/grammars/java-tags.wy b/admin/grammars/java-tags.wy
index f4b2f1f1f49..708715533ff 100644
--- a/admin/grammars/java-tags.wy
+++ b/admin/grammars/java-tags.wy
@@ -1,6 +1,6 @@
;;; java-tags.wy -- Semantic LALR grammar for Java
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -23,6 +23,7 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
%package wisent-java-tags-wy
+%provide semantic/wisent/javat-wy
%languagemode java-mode
@@ -444,7 +445,7 @@ class_member_declaration
;;; Type Declaration token
;; ("NAME" type "TYPE" ( PART-LIST ) ( PARENTS ) EXTRA-SPEC "DOCSTRING")
interface_declaration
- : modifiers_opt INTERFACE IDENTIFIER extends_interfaces_opt interface_body
+ : modifiers_opt INTERFACE qualified_name extends_interfaces_opt interface_body
(TYPE-TAG $3 $2 $5 (if $4 (cons nil $4)) :typemodifiers $1)
;
@@ -547,7 +548,7 @@ formal_parameters
;;; Variable token
;; ("NAME" variable "TYPE" DEFAULT-VALUE EXTRA-SPEC "DOCSTRING")
formal_parameter
- : formal_parameter_modifier_opt type variable_declarator_id
+ : formal_parameter_modifier_opt type opt_variable_declarator_id
(VARIABLE-TAG $3 $2 nil :typemodifiers $1)
;
@@ -582,6 +583,13 @@ variable_declarator
(cons $1 $region)
;
+opt_variable_declarator_id
+ : ;; EMPTY
+ (identity "")
+ | variable_declarator_id
+ (identity $1)
+ ;
+
variable_declarator_id
: IDENTIFIER dims_opt
(concat $1 $2)
diff --git a/admin/grammars/js.wy b/admin/grammars/js.wy
index ffa324806cf..7b55f5c3834 100644
--- a/admin/grammars/js.wy
+++ b/admin/grammars/js.wy
@@ -1,6 +1,6 @@
;;; javascript-jv.wy -- LALR grammar for Javascript
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;; Copyright (C) 1998-2011 Ecma International.
;; Author: Joakim Verona
@@ -58,6 +58,7 @@
;; DAMAGE.
%package wisent-javascript-jv-wy
+%provide semantic/wisent/js-wy
;; JAVE I prefere ecmascript-mode
%languagemode ecmascript-mode javascript-mode
diff --git a/admin/grammars/make.by b/admin/grammars/make.by
index dab4472b737..6cff4716f82 100644
--- a/admin/grammars/make.by
+++ b/admin/grammars/make.by
@@ -1,6 +1,6 @@
;;; make.by -- BY notation for Makefiles.
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;;
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; David Ponce <david@dponce.com>
@@ -22,6 +22,7 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
%package semantic-make-by
+%provide semantic/bovine/make-by
%languagemode makefile-mode
%start Makefile
diff --git a/admin/grammars/python.wy b/admin/grammars/python.wy
index b30305ee78a..f17f41c9b1b 100644
--- a/admin/grammars/python.wy
+++ b/admin/grammars/python.wy
@@ -1,7 +1,8 @@
;;; python.wy -- LALR grammar for Python
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
-;; Copyright (C) 2001-2010 Python Software Foundation
+;; 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
;; Author: Richard Kim <ryk@dspwiz.com>
;; Maintainer: Richard Kim <ryk@dspwiz.com>
@@ -87,6 +88,12 @@
;; --------
%package wisent-python-wy
+%provide semantic/wisent/python-wy
+
+%{
+(declare-function wisent-python-reconstitute-function-tag "semantic/wisent/python")
+(declare-function wisent-python-reconstitute-class-tag "semantic/wisent/python")
+}
%languagemode python-mode
@@ -172,6 +179,7 @@
%token <punctuation> COMMA ","
%token <punctuation> ASSIGN "="
%token <punctuation> BACKQUOTE "`"
+%token <punctuation> AT "@"
;; -----------------
@@ -306,6 +314,10 @@
%put WHILE summary
"Start a 'while' loop"
+%keyword WITH "with"
+%put WITH summary
+"Start statement with an associated context object"
+
%keyword YIELD "yield"
%put YIELD summary
"Create a generator function"
@@ -544,8 +556,10 @@ import_stmt
;; dotted_as_name (',' dotted_as_name)*
dotted_as_name_list
- : dotted_as_name
- | dotted_as_name_list COMMA dotted_as_name
+ : dotted_as_name_list COMMA dotted_as_name
+ (cons $3 $1)
+ | dotted_as_name
+ (list $1)
;
;; ('*' | import_as_name (',' import_as_name)*)
@@ -648,6 +662,7 @@ compound_stmt
| while_stmt
| for_stmt
| try_stmt
+ | with_stmt
| funcdef
| class_declaration
;
@@ -755,13 +770,46 @@ zero_one_or_two_test
;
;;;============================================================================
+;;@@ with_stmt
+;;;============================================================================
+
+;; with_stmt: 'with' test [ with_var ] ':' suite
+with_stmt
+ : WITH test COLON suite
+ (CODE-TAG $1 nil)
+ | WITH test with_var COLON suite
+ (CODE-TAG $1 nil) ;; TODO capture variable
+ ;
+
+with_var
+ : AS expr
+ () ;; TODO capture
+ ;
+
+;;;============================================================================
;;;@@ funcdef
;;;============================================================================
-;; funcdef: 'def' NAME parameters ':' suite
+decorator
+ : AT dotted_name varargslist_opt NEWLINE
+ (FUNCTION-TAG $2 "decorator" $3)
+ ;
+
+decorators
+ : decorator
+ (list $1)
+ | decorator decorators
+ (cons $1 $2)
+ ;
+
+;; funcdef: [decorators] 'def' NAME parameters ':' suite
funcdef
: DEF NAME function_parameter_list COLON suite
- (FUNCTION-TAG $2 nil $3)
+ (wisent-python-reconstitute-function-tag
+ (FUNCTION-TAG $2 nil $3) $5)
+ | decorators DEF NAME function_parameter_list COLON suite
+ (wisent-python-reconstitute-function-tag
+ (FUNCTION-TAG $3 nil $4 :decorators $1) $6)
;
function_parameter_list
@@ -797,10 +845,11 @@ function_parameter
;; classdef: 'class' NAME ['(' testlist ')'] ':' suite
class_declaration
: CLASS NAME paren_class_list_opt COLON suite
- (TYPE-TAG $2 $1 ;; Name "class"
- $5 ;; Members
- (cons $3 nil) ;; (SUPERCLASSES . INTERFACES)
- )
+ (wisent-python-reconstitute-class-tag
+ (TYPE-TAG $2 $1 ;; Name "class"
+ $5 ;; Members
+ (cons $3 nil) ;; (SUPERCLASSES . INTERFACES)
+ ))
;
;; ['(' testlist ')']
diff --git a/admin/grammars/scheme.by b/admin/grammars/scheme.by
index bc6612d4c70..98e75901a71 100644
--- a/admin/grammars/scheme.by
+++ b/admin/grammars/scheme.by
@@ -1,6 +1,6 @@
;;; scheme.by -- Scheme BNF language specification
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -18,6 +18,7 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
%package semantic-scm-by
+%provide semantic/bovine/scm-by
%languagemode scheme-mode
%start scheme
diff --git a/admin/grammars/srecode-template.wy b/admin/grammars/srecode-template.wy
index 4ff2d7e4e41..f84a414b46e 100644
--- a/admin/grammars/srecode-template.wy
+++ b/admin/grammars/srecode-template.wy
@@ -1,6 +1,6 @@
;;; srecode-template.wy --- Semantic Recoder Template parser
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;; Author: Eric Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -28,6 +28,9 @@
;; Semantic Recoder templates are based on Google Templates
;; and are at the bottom of the Semantic Recoder API.
+%package srecode-template-wy
+%provide srecode/srt-wy
+
%languagemode srecode-mode
%start template_file
@@ -46,6 +49,15 @@
%put TEMPLATE summary "template <name>\\n <template definition>"
%keyword SECTIONDICTIONARY "sectiondictionary"
%put SECTIONDICTIONARY summary "sectiondictionary <name>\\n <dictionary entries>"
+
+%keyword SECTION "section"
+%put SECTION summary
+ "section <name>\\n <dictionary entries>\\n end"
+
+%keyword END "end"
+%put END summary
+ "section ... end"
+
%keyword PROMPT "prompt"
%keyword DEFAULT "default"
%keyword DEFAULTMACRO "defaultmacro"
@@ -62,7 +74,7 @@
%token <separator> TEMPLATE_BLOCK "^----"
;;; Bland default types
-%type <property> ":\\(\\w\\|\\s_\\)*"
+%type <property> syntax ":\\(\\w\\|\\s_\\)*"
%token <property> property
%type <symbol>
@@ -134,7 +146,7 @@ insertable-string
template
: TEMPLATE templatename opt-dynamic-arguments newline
opt-string
- opt-section-dictionaries
+ section-dictionary-list
TEMPLATE_BLOCK newline
opt-bind
(FUNCTION-TAG $2 nil $3 :documentation $5 :code $7
@@ -165,29 +177,52 @@ opt-string
| ()
;
-opt-section-dictionaries
- : () ;; EMPTY
- | section-dictionary-list
- ;
-
section-dictionary-list
- : one-section-dictionary
- (list $1)
- | section-dictionary-list one-section-dictionary
+ : ;; empty
+ ()
+ | section-dictionary-list flat-section-dictionary
+ (append $1 (list $2))
+ | section-dictionary-list section-dictionary
(append $1 (list $2))
;
-one-section-dictionary
+flat-section-dictionary
: SECTIONDICTIONARY string newline
- variable-list
+ flat-dictionary-entry-list
+ (cons (read $2) $4)
+ ;
+
+flat-dictionary-entry-list
+ : ;; empty
+ ()
+ | flat-dictionary-entry-list flat-dictionary-entry
+ (append $1 $2)
+ ;
+
+flat-dictionary-entry
+ : variable
+ (EXPANDTAG $1)
+ ;
+
+section-dictionary
+ : SECTION string newline
+ dictionary-entry-list
+ END newline
(cons (read $2) $4)
;
-variable-list
+dictionary-entry-list
+ : ;; empty
+ ()
+ | dictionary-entry-list dictionary-entry
+ (append $1 $2)
+ ;
+
+dictionary-entry
: variable
(EXPANDTAG $1)
- | variable-list variable
- (append $1 (EXPANDTAG $2))
+ | section-dictionary
+ (list $1)
;
opt-bind
@@ -232,4 +267,4 @@ It ignores whitespace, newlines and comments."
semantic-lex-default-action
)
-;;; wisent-dot.wy ends here
+;;; srecode-template.wy ends here
diff --git a/admin/make-announcement b/admin/make-announcement
index dcfd55e8375..5b45d09e89b 100755
--- a/admin/make-announcement
+++ b/admin/make-announcement
@@ -1,6 +1,6 @@
#! /bin/bash
-## Copyright (C) 2002-2011 Free Software Foundation, Inc.
+## Copyright (C) 2002-2012 Free Software Foundation, Inc.
## Author: Francesco Potorti` <pot@gnu.org>
diff --git a/admin/make-emacs b/admin/make-emacs
index d231f66b03b..688f5c196bf 100755
--- a/admin/make-emacs
+++ b/admin/make-emacs
@@ -2,7 +2,7 @@
# Build Emacs with various options for profiling, debugging,
# with and without warnings enabled etc.
-# Copyright (C) 2001-2011 Free Software Foundation, Inc.
+# Copyright (C) 2001-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -42,7 +42,7 @@ $rc = GetOptions ("help" => \$help,
"check-marked" => \$check_marked,
"all" => \$all,
"no-optim" => \$no_optim,
- "union-type" => \$union_type,
+ "check-lisp-type" => \$check_lisp_type,
"gprof" => \$profile,
"malloc-check" => \$malloc_check,
"no-mcheck" => \$no_mcheck,
@@ -70,7 +70,7 @@ Build Emacs.
--check-marked GC_CHECK_MARKED_OBJECTS=1
--optim no debug defines
--gprof make Emacs for profiling
- --union-type define USE_LISP_UNION_TYPE (bad for GDB)
+ --check-lisp-type define CHECK_LISP_OBJECT_TYPE
--malloc-check define GC_MALLOC_CHECK
--no-mcheck don't define GC_MCHECK
--wall compile with -Wall
@@ -140,7 +140,7 @@ else
}
}
-$defs = "$defs -DUSE_LISP_UNION_TYPE" if $union_type;
+$defs = "$defs -DCHECK_LISP_OBJECT_TYPE" if $check_lisp_type;
$defs = "$defs -DGC_MALLOC_CHECK=1 -DGC_PROTECT_MALLOC_STATE=1" if $malloc_check;
$defs = "$defs -DGC_MCHECK=1" unless $no_mcheck;
diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt
index 06793b31097..ea9c4a3c2d1 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -28,13 +28,7 @@ For each step, check for possible errors.
refer to a newer release of Emacs. (This is probably needed only
when preparing a major Emacs release, or branching for it.)
-5. Edit configure.in so that maintainer-mode is off by default.
- (FIXME - need to find a better way of dealing with this.
- Or maybe it's fine and indeed correct to leave it on?
- See http://lists.gnu.org/archive/html/emacs-devel/2011-03/msg00859.html
- and subsequent.)
-
- autoreconf -i -I m4 --force
+5. autoreconf -i -I m4 --force
make bootstrap
6. Commit etc/AUTHORS, all the files changed by M-x set-version, and
@@ -102,3 +96,6 @@ For each step, check for possible errors.
13. For a pretest, announce it on emacs-devel and BCC the pretesters.
For a release, announce it on info-gnu@gnu.org,
info-gnu-emacs@gnu.org, and emacs-devel.
+
+14. For a release, update the Emacs homepage in the web repository.
+ Also add the new NEWS file as NEWS.xx.y.
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
new file mode 100755
index 00000000000..792818b2efe
--- /dev/null
+++ b/admin/merge-gnulib
@@ -0,0 +1,94 @@
+#! /bin/sh
+# Merge gnulib sources into Emacs sources.
+# Typical usage:
+#
+# admin/merge-gnulib
+
+# Copyright 2012 Free Software Foundation, Inc.
+
+# 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/>.
+
+# written by Paul Eggert
+
+GNULIB_URL=git://git.savannah.gnu.org/gnulib.git
+
+GNULIB_MODULES='
+ alloca-opt c-ctype c-strcase
+ careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512
+ dtoastr dtotimespec dup2 environ execinfo faccessat
+ fcntl-h filemode getloadavg getopt-gnu gettime gettimeofday
+ ignore-value intprops largefile lstat
+ manywarnings mktime pselect pthread_sigmask readlink
+ socklen stat-time stdalign stdarg stdbool stdio
+ strftime strtoimax strtoumax symlink sys_stat
+ sys_time time timer-time timespec-add timespec-sub utimens
+ warnings
+'
+
+GNULIB_TOOL_FLAGS='
+ --avoid=at-internal
+ --avoid=errno --avoid=fchdir --avoid=fcntl --avoid=fstat
+ --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow
+ --avoid=openat-die --avoid=openat-h
+ --avoid=raise
+ --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types
+ --avoid=threadlib
+ --conditional-dependencies --import --no-changelog --no-vc-files
+ --makefile-name=gnulib.mk
+'
+
+# The source directory, with a trailing '/'.
+# If empty, the source directory is the working directory.
+src=$2
+case $src in
+ */ | '') ;;
+ *) src=$src/ ;;
+esac
+
+# Gnulib's source directory.
+gnulib_srcdir=${1-$src../gnulib}
+
+case $gnulib_srcdir in
+ -*) src=- ;;
+esac
+case $src in
+ -*)
+ echo >&2 "$0: usage: $0 [GNULIB_SRCDIR [SRCDIR]]
+
+ SRCDIR is the Emacs source directory (default: working directory).
+ GNULIB_SRCDIR is the Gnulib source directory (default: SRCDIR/../gnulib)."
+ exit 1 ;;
+esac
+
+test -x "$src"autogen.sh || {
+ echo >&2 "$0: '${src:-.}' is not an Emacs source directory."
+ exit 1
+}
+
+test -d "$gnulib_srcdir" ||
+git clone -- "$GNULIB_URL" "$gnulib_srcdir" ||
+exit
+
+test -x "$gnulib_srcdir"/gnulib-tool || {
+ echo >&2 "$0: '$gnulib_srcdir' is not a Gnulib source directory."
+ exit 1
+}
+
+"$gnulib_srcdir"/gnulib-tool --dir="$src" $GNULIB_TOOL_FLAGS $GNULIB_MODULES &&
+rm -- "$src"m4/fcntl-o.m4 "$src"m4/gnulib-cache.m4 "$src"m4/warn-on-use.m4 &&
+cp -- "$gnulib_srcdir"/build-aux/texinfo.tex "$src"doc/misc &&
+cp -- "$gnulib_srcdir"/build-aux/move-if-change "$src"build-aux &&
+autoreconf -i -I m4 -- ${src:+"$src"}
diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker
index dd1ea46ceb2..ee385f4dd75 100644
--- a/admin/notes/bugtracker
+++ b/admin/notes/bugtracker
@@ -125,7 +125,7 @@ Resent-CC: maintainer email address, plus any X-Debbugs-CC: entries
The "maintainer email address" is "bug-gnu-emacs@gnu.org" in most cases.
-** To not get acknowledgement mail from the tracker,
+** To not get acknowledgment mail from the tracker,
add an "X-Debbugs-No-Ack:" header (with any value). If you use Gnus,
you can add an element to gnus-posting-styles to do this automatically, eg:
@@ -270,32 +270,35 @@ to a bug. There are two differences between normal tags and user tags:
1) Anyone can define any valid usertag they like. In contrast, only a
limited, predefined set of normal tags are available (see above).
-2) A usertag is associated with a specific email address.
+2) A usertag is associated with a specific user. This is normally
+an email address (with an "@" sign and least 4 characters after the "@"),
+but on debbugs.gnu.org, the definition is less strict - anything with
+5 or more alphanumeric characters will work. For personal tags,
+using an email address is still recommended. Please only use the
+"emacs" user, or other short users, for "official" tags.
-You set usertags in the same way as tags, by talking to the control
-server. One difference is that you can also specify the associated
-email address. If you don't explicitly specify an address, then it
-will use the one from which you send the control message. The address
-must have the form of an email address (with an "@" sign and least 4
-characters after the "@").
+You set usertags in the same way as tags, by talking to the control server.
+One difference is that you can also specify the associated user.
+If you don't explicitly specify a user, then it will use the email
+address from which you send the control message.
*** Setting usertags
a) In a control message:
-user bug-gnu-emacs@gnu.org
+user emacs # or email@example.com
usertags 1234 any-tag-you-like
This will add a usertag "any-tag-you-like" to bug 1234. The tag will
-be associated with the address "bug-gnu-emacs@gnu.org". If you omit
-the first line, the tag will be associated with your email address.
+be associated with the user "emacs". If you omit the first line,
+the tag will be associated with your email address.
The syntax of the usertags command is the same as that of tags (eg wrt
the optional [=+-] argument).
b) In an initial submission, in the pseudo-header:
-User: bug-gnu-emacs@gnu.org
+User: emacs
Usertags: a-new-tag
Again, the "User" is optional.
@@ -312,7 +315,7 @@ http://debbugs.gnu.org/cgi/pkgindex.cgi?indexon=users
**** To find all bugs usertagged by a given email address:
-http://debbugs.gnu.org/cgi/pkgreport.cgi?users=bug-gnu-emacs@gnu.org
+http://debbugs.gnu.org/cgi/pkgreport.cgi?users=emacs
(Supposedly, the "users" field can be a comma-separated list of more
than one email address, but it does not seem to work for me.)
@@ -322,7 +325,7 @@ than one email address, but it does not seem to work for me.)
This works just like a normal tags search, but with the addition of a
"users" field. Eg:
-http://debbugs.gnu.org/cgi/pkgreport.cgi?users=bug-gnu-emacs@gnu.org;tag=calendar
+http://debbugs.gnu.org/cgi/pkgreport.cgi?users=emacs;tag=calendar
*** To merge bugs:
Eg when bad replies create a bunch of new bugs for the same report.
@@ -610,7 +613,7 @@ An /etc/aliases entry redirects it to the real emacs-bug-tracker address.
All discarded messages are stored in /var/lib/mailman/spam.
If a non-spam message accidentally gets discarded, just do:
-cat /var/lib/mailman/spam/not-really-spam.msg | /usr/lib/debbugs/receive
+/usr/lib/debbugs/receive < /var/lib/mailman/spam/not-really-spam.msg
chown Debian-debbugs:Debian-debbugs /var/lib/debbugs/spool/incoming/*
... check it works ...
mv /var/lib/mailman/spam/not-really-spam.msg /var/lib/mailman/not-spam/
@@ -618,6 +621,16 @@ mv /var/lib/mailman/spam/not-really-spam.msg /var/lib/mailman/not-spam/
Also check that the sender was not added to the auto-discard/reject list
in the debbugs-submit Mailman interface.
+If you don't have the actual mail, just the mailman moderation mail
+version of it, you need to extract the original mail, and add the
+following headers:
+
+1) The leading envelope From line.
+2) Message-ID (get it from /var/log/mailman/vette).
+3) X-Debbugs-Envelope-To: submit
+
+Then pipe it to receive as above.
+
** Administrivia
The debbugs-submit list should have the administrivia option off,
@@ -640,3 +653,14 @@ I think you also have to add them to 'tags' and 'tags_single_letter'
in /usr/share/perl5/Debbugs/Config.pm.
And update /var/www/Developer.html with a description of what the tag means.
And the "valid tags" list in /var/www/index.html.
+
+** Backups
+
+The FSF sysadmins handle multi-generational backups of the filesystem
+on debbugs.gnu.org. But if you really want to have your own backup of
+the bug database, you can use rsync (this requires login access to
+debbugs.gnu.org):
+
+ rsync -azvv -e ssh USER@debbugs.gnu.org:/var/lib/debbugs/ DEST
+
+Note that this occupies well over 1G of disk space.
diff --git a/admin/notes/copyright b/admin/notes/copyright
index 0ad99900779..173ff83343a 100644
--- a/admin/notes/copyright
+++ b/admin/notes/copyright
@@ -1,4 +1,4 @@
-Copyright (C) 2007-2011 Free Software Foundation, Inc.
+Copyright (C) 2007-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -380,7 +380,7 @@ Makefile.in does now.
src/gmalloc.c
- contains numerous copyrights from the GNU C library. Leave them alone.
-src/ndir.h
+nt/inc/dirent.h
- see comments below. This file is OK to be released with Emacs
22, but we may want to revisit it afterwards.
@@ -429,7 +429,7 @@ admin/check-doc-strings
File says it's in the public domain, but that might not make it so.
etc/e/eterm-color.ti
-src/ndir.h
+nt/inc/dirent.h
On legal advice from Matt Norwood, the following comment was added
to these files in Feb/Mar 2007:
diff --git a/admin/notes/documentation b/admin/notes/documentation
index f2e2aab73e7..09476ad6962 100644
--- a/admin/notes/documentation
+++ b/admin/notes/documentation
@@ -112,3 +112,6 @@ The kind of change for which the user really needs help from Antinews
is where a feature works _differently_ in the previous version.
In those cases, the user might have trouble figuring out how to use
the old version without some sort of help.
+
+** To indicate possession, write Emacs's rather than Emacs'.
+http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00649.html
diff --git a/admin/notes/font-backend b/admin/notes/font-backend
index d51d3ec1c3b..ec2dc11345b 100644
--- a/admin/notes/font-backend
+++ b/admin/notes/font-backend
@@ -1,4 +1,4 @@
-Copyright (C) 2002-2011 Free Software Foundation, Inc.
+Copyright (C) 2002-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/admin/notes/lel-TODO b/admin/notes/lel-TODO
index c03d0f6fdfb..139aa09e919 100644
--- a/admin/notes/lel-TODO
+++ b/admin/notes/lel-TODO
@@ -1,12 +1,13 @@
Some lisp/emacs-lisp/ Features and Where They Are Documented
-Copyright (C) 2007-2011 Free Software Foundation, Inc.
+Copyright (C) 2007-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
* Status Key
- -- as yet unknown
n/a -- not applicable (internal, uninteresting, etc)
+ obsolete -- an obsolete feature, to be removed in future
todo -- not documented but should be
NODE -- documented in or under info node NODE
@@ -26,7 +27,6 @@ See the end of the file for license conditions.
bytecomp (elisp) Compilation Functions
checkdoc (elisp) Documentation Tips
cl (cl)
- cl-19 n/a
cl-compat n/a
cl-specs n/a
copyright -
@@ -47,13 +47,12 @@ See the end of the file for license conditions.
generic (elisp) Generic Modes
gulp n/a
helper -
- levents -
+ levents obsolete
lisp-float-type -
lisp-mnt -
lisp-mode n/a
- lmenu -
- lselect -
- lucid -
+ lmenu obsolete
+ lucid obsolete
macroexp (elisp) Expansion
pp (emacs) Program Indent
re-builder -
@@ -62,7 +61,7 @@ See the end of the file for license conditions.
ring (elisp) Rings
rx -
shadow -
- sregex -
+ sregex obsolete
syntax (elisp) Position Parse
testcover -
timer (elisp) Timers
diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty
index 8a10997eb8b..5408b9a3d00 100644
--- a/admin/notes/multi-tty
+++ b/admin/notes/multi-tty
@@ -1,6 +1,6 @@
-*- coding: utf-8; mode: text; -*-
-Copyright (C) 2007-2011 Free Software Foundation, Inc.
+Copyright (C) 2007-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
From README.multi-tty in the multi-tty branch.
@@ -789,7 +789,7 @@ DIARY OF CHANGES
frame's kboard from there.)
-- Fix rif issue with X-tty combo sessions. IMHO the best thing to do
- is to get rid of that global variable (and use the value value in
+ is to get rid of that global variable (and use the value in
display_method, which is guaranteed to be correct).
(Done, did exactly that. Core dumps during combo sessions became
@@ -906,7 +906,7 @@ DIARY OF CHANGES
read_avail_input.
(Fixed. This was caused by unconditionally including stdin in
- input_wait_mask in init_process. The select call in
+ input_wait_mask in init_process_emacs. The select call in
wait_reading_process_input always returned immediately, indicating
that there is pending input from stdin, which nobody read.
diff --git a/admin/notes/tags b/admin/notes/tags
new file mode 100644
index 00000000000..9c3700f2e4d
--- /dev/null
+++ b/admin/notes/tags
@@ -0,0 +1,1006 @@
+Prior to 2012/04, the Emacs repository used to contain many more tags.
+Apparently these date from ye olden days, when tags were common
+to several GNU projects. So many of them had no relevance to Emacs,
+and hence were removed. See:
+
+http://lists.gnu.org/archive/html/emacs-devel/2012-04/msg00042.html
+
+(UPDATE: It seems tag deletion is basically impossible in bzr, so all
+these tags came back.)
+
+In the unlikely event that you need them, the removed tags were:
+
+tag revision
+
+amigados-merge 14846
+before-thomas-posix1996 16843
+gcc-2_8_1-980401 20893
+gcc-2_8_1-980402 21795
+gcc-2_8_1-980407 20893
+gcc-2_8_1-980412 20893
+gcc-2_8_1-980413 20893
+gcc-2_8_1-980419 21502
+gcc-2_8_1-980426 21502
+gcc-2_8_1-980502 21795
+gcc-2_8_1-980513 21795
+gcc-2_8_1-980525 22147
+gcc-2_8_1-980529 22147
+gcc-2_8_1-980608 22147
+gcc-2_8_1-980609 22147
+gcc-2_8_1-980627 22478
+gcc-2_8_1-980705 22478
+gcc-2_8_1-980718 22478
+gcc-2_8_1-980811 22971
+gcc-2_8_1-980813 23005
+gcc-2_8_1-980928 23338
+gcc-2_8_1-980929 23338
+gcc-2_8_1-RELEASE 20893
+gcc_2_8_1-980315 20893
+gcc_2_8_1-980929 23338
+glibc-2_0_2 16843
+gnumach-release-1-1 17693
+gnumach-release-1-1-1 17693
+gnumach-release-1-1-2 18209
+gnumach-release-1-1-3 18209
+hurd-release-0-2 18209
+jimb-sync-Nov-3-1992 1552
+libc20x-97031 16843
+libc20x-970306 16843
+libc20x-970316 16843
+libc20x-970318 16843
+libc20x-970319 16843
+libc20x-970404 16843
+libc-1-90 15360
+libc-1-91 15451
+libc-1-92 15463
+libc-1-93 15702
+libc-950402 11085
+libc-950411 11255
+libc-950722 12418
+libc-950723 12418
+libc-950922 12859
+libc-951016 12859
+libc-951018 13231
+libc-951029 13231
+libc-951031 13231
+libc-951101 13231
+libc-951102 13231
+libc-951103 13231
+libc-951104 13231
+libc-951105 13231
+libc-951106 13231
+libc-951107 13231
+libc-951108 13231
+libc-951109 13231
+libc-951110 13231
+libc-951111 13231
+libc-951112 13231
+libc-951113 13231
+libc-951114 13231
+libc-951115 13231
+libc-951116 13231
+libc-951117 13231
+libc-951118 13231
+libc-951119 13231
+libc-951120 13231
+libc-951121 13231
+libc-951122 13231
+libc-951123 13231
+libc-951124 13231
+libc-951125 13231
+libc-951126 13231
+libc-951127 13231
+libc-951128 13231
+libc-951129 13231
+libc-951130 13231
+libc-951201 13679
+libc-951202 13679
+libc-951203 13679
+libc-951204 13679
+libc-951206 13686
+libc-951208 13693
+libc-951209 13693
+libc-951210 13693
+libc-951211 13693
+libc-951212 13704
+libc-951213 13704
+libc-951214 13730
+libc-951215 13730
+libc-951216 13741
+libc-951217 13741
+libc-951218 13741
+libc-951219 13741
+libc-951220 13741
+libc-951221 13741
+libc-951222 13741
+libc-951223 13741
+libc-951224 13741
+libc-951225 13741
+libc-951226 13741
+libc-951227 13741
+libc-951228 13741
+libc-951229 13741
+libc-951230 13741
+libc-951231 13741
+libc-960101 13741
+libc-960102 13741
+libc-960103 13741
+libc-960104 13741
+libc-960105 13741
+libc-960106 13741
+libc-960107 13741
+libc-960108 13741
+libc-960109 13741
+libc-960110 13741
+libc-960111 13741
+libc-960112 13741
+libc-960113 13741
+libc-960114 13741
+libc-960115 13741
+libc-960116 14192
+libc-960117 14192
+libc-960118 14213
+libc-960119 14213
+libc-960120 14213
+libc-960121 14213
+libc-960122 14213
+libc-960123 14213
+libc-960124 14213
+libc-960125 14213
+libc-960126 14213
+libc-960127 14213
+libc-960128 14213
+libc-960129 14213
+libc-960130 14213
+libc-960131 14213
+libc-960201 14449
+libc-960202 14449
+libc-960203 14473
+libc-960204 14473
+libc-960205 14473
+libc-960206 14473
+libc-960207 14473
+libc-960208 14473
+libc-960209 14473
+libc-960210 14473
+libc-960211 14540
+libc-960212 14548
+libc-960213 14562
+libc-960214 14562
+libc-960215 14562
+libc-960216 14562
+libc-960217 14562
+libc-960218 14562
+libc-960219 14562
+libc-960220 14562
+libc-960221 14562
+libc-960222 14562
+libc-960223 14562
+libc-960224 14562
+libc-960225 14562
+libc-960226 14562
+libc-960227 14562
+libc-960228 14562
+libc-960229 14562
+libc-960302 14724
+libc-960303 14724
+libc-960304 14724
+libc-960305 14753
+libc-960306 14764
+libc-960307 14764
+libc-960308 14764
+libc-960309 14764
+libc-960310 14764
+libc-960311 14764
+libc-960312 14764
+libc-960313 14764
+libc-960314 14764
+libc-960315 14809
+libc-960316 14809
+libc-960317 14809
+libc-960318 14809
+libc-960319 14809
+libc-960320 14809
+libc-960321 14809
+libc-960322 14855
+libc-960323 14855
+libc-960324 14855
+libc-960325 14855
+libc-960326 14855
+libc-960327 14855
+libc-960328 14855
+libc-960329 14912
+libc-960330 14912
+libc-960331 14912
+libc-960401 14912
+libc-960402 14912
+libc-960403 14912
+libc-960404 14912
+libc-960405 14912
+libc-960406 14912
+libc-960407 14912
+libc-960408 14912
+libc-960409 14962
+libc-960410 14962
+libc-960411 14962
+libc-960412 14962
+libc-960413 15014
+libc-960414 15014
+libc-960415 15014
+libc-960416 15014
+libc-960417 15014
+libc-960418 15014
+libc-960419 15014
+libc-960420 15014
+libc-960421 15014
+libc-960422 15014
+libc-960423 15014
+libc-960424 15014
+libc-960425 15014
+libc-960426 15014
+libc-960427 15014
+libc-960428 15014
+libc-960429 15014
+libc-960430 15014
+libc-960501 15014
+libc-960502 15014
+libc-960503 15014
+libc-960504 15014
+libc-960505 15014
+libc-960506 15014
+libc-960507 15014
+libc-960508 15014
+libc-960509 15014
+libc-960510 15014
+libc-960511 15014
+libc-960512 15014
+libc-960513 15014
+libc-960514 15014
+libc-960515 15014
+libc-960516 15014
+libc-960517 15014
+libc-960518 15014
+libc-960519 15014
+libc-960520 15014
+libc-960521 15261
+libc-960522 15278
+libc-960523 15278
+libc-960524 15278
+libc-960525 15287
+libc-960526 15287
+libc-960527 15287
+libc-960528 15287
+libc-960529 15287
+libc-960530 15287
+libc-960531 15287
+libc-960601 15287
+libc-960602 15287
+libc-960603 15287
+libc-960604 15319
+libc-960605 15334
+libc-960606 15334
+libc-960607 15334
+libc-960608 15360
+libc-960609 15360
+libc-960610 15360
+libc-960611 15360
+libc-960612 15360
+libc-960613 15360
+libc-960614 15360
+libc-960615 15360
+libc-960616 15360
+libc-960617 15360
+libc-960618 15360
+libc-960619 15451
+libc-960620 15451
+libc-960621 15463
+libc-960622 15463
+libc-960623 15463
+libc-960624 15463
+libc-960625 15463
+libc-960626 15463
+libc-960627 15463
+libc-960628 15463
+libc-960629 15554
+libc-960630 15554
+libc-960701 15554
+libc-960702 15554
+libc-960703 15554
+libc-960704 15554
+libc-960705 15554
+libc-960706 15554
+libc-960707 15554
+libc-960708 15620
+libc-960709 15620
+libc-960710 15620
+libc-960711 15620
+libc-960712 15620
+libc-960713 15620
+libc-960714 15620
+libc-960715 15673
+libc-960716 15702
+libc-960717 15702
+libc-960718 15702
+libc-960719 15702
+libc-960720 15702
+libc-960721 15702
+libc-960722 15702
+libc-960723 15702
+libc-960724 15702
+libc-960725 15702
+libc-960726 15702
+libc-960727 15702
+libc-960728 15702
+libc-960729 15702
+libc-960730 15702
+libc-960731 15702
+libc-960801 15702
+libc-960802 15702
+libc-960803 15702
+libc-960804 15702
+libc-960805 15702
+libc-960806 15702
+libc-960807 15702
+libc-960808 15702
+libc-960809 15702
+libc-960810 15702
+libc-960811 15702
+libc-960812 15702
+libc-960813 15702
+libc-960814 15702
+libc-960815 15702
+libc-960816 15702
+libc-960817 15702
+libc-960818 15702
+libc-960819 15702
+libc-960820 15702
+libc-960821 15702
+libc-960822 15702
+libc-960823 15702
+libc-960824 15702
+libc-960825 15702
+libc-960826 15702
+libc-960827 15702
+libc-960828 15702
+libc-960829 15702
+libc-960830 15702
+libc-960831 15702
+libc-960901 15702
+libc-960902 15702
+libc-960903 15702
+libc-960904 15702
+libc-960905 15702
+libc-960906 15702
+libc-960907 15702
+libc-960908 15702
+libc-960909 15702
+libc-960910 15702
+libc-960911 15702
+libc-960912 15702
+libc-960913 16178
+libc-960918 16190
+libc-960919 16190
+libc-960920 16190
+libc-960921 16190
+libc-960922 16190
+libc-960923 16190
+libc-960925 16307
+libc-960926 16307
+libc-960927 16307
+libc-960928 16307
+libc-960929 16307
+libc-961001 16307
+libc-961004 16307
+libc-961005 16307
+libc-961006 16307
+libc-961007 16307
+libc-961008 16307
+libc-961009 16307
+libc-961010 16307
+libc-961011 16307
+libc-961012 16307
+libc-961013 16307
+libc-961014 16307
+libc-961015 16307
+libc-961016 16307
+libc-961017 16307
+libc-961018 16307
+libc-961019 16307
+libc-961020 16307
+libc-961021 16307
+libc-961022 16307
+libc-961023 16307
+libc-961024 16307
+libc-961025 16307
+libc-961026 16307
+libc-961027 16307
+libc-961028 16307
+libc-961029 16482
+libc-961030 16482
+libc-961031 16482
+libc-961101 16482
+libc-961102 16482
+libc-961103 16482
+libc-961104 16482
+libc-961105 16482
+libc-961106 16482
+libc-961107 16482
+libc-961108 16540
+libc-961109 16540
+libc-961110 16540
+libc-961111 16540
+libc-961114 16576
+libc-961115 16576
+libc-961116 16576
+libc-961117 16576
+libc-961118 16576
+libc-961119 16576
+libc-961120 16601
+libc-961121 16602
+libc-961203 16607
+libc-961204 16607
+libc-961205 16607
+libc-961206 16607
+libc-961207 16607
+libc-961208 16638
+libc-961209 16638
+libc-961210 16638
+libc-961211 16664
+libc-961212 16664
+libc-961213 16664
+libc-961214 16664
+libc-961215 16664
+libc-961216 16664
+libc-961217 16664
+libc-961218 16664
+libc-961219 16664
+libc-961220 16664
+libc-961221 16664
+libc-961222 16664
+libc-961223 16664
+libc-961224 16664
+libc-961225 16664
+libc-961226 16664
+libc-961227 16664
+libc-961228 16664
+libc-961229 16664
+libc-961230 16664
+libc-961231 16664
+libc-970101 16802
+libc-970102 16802
+libc-970103 16802
+libc-970104 16821
+libc-970105 16833
+libc-970106 16833
+libc-970107 16833
+libc-970108 16843
+libc-970109 16843
+libc-970110 16843
+libc-970111 16843
+libc-970112 16843
+libc-970113 16843
+libc-970114 16843
+libc-970115 16843
+libc-970116 16843
+libc-970117 16843
+libc-970118 16843
+libc-970119 16843
+libc-970120 16843
+libc-970121 16843
+libc-970122 16843
+libc-970123 16843
+libc-970124 16843
+libc-970125 16843
+libc-970126 16843
+libc-970127 16843
+libc-970128 16843
+libc-970129 16843
+libc-970130 16843
+libc-970131 16843
+libc-970201 16843
+libc-970202 16843
+libc-970203 16843
+libc-970204 16843
+libc-970205 16843
+libc-970206 16843
+libc-970207 16843
+libc-970208 16843
+libc-970209 16843
+libc-970210 16843
+libc-970211 16843
+libc-970212 16843
+libc-970213 16843
+libc-970214 16843
+libc-970215 16843
+libc-970216 16843
+libc-970217 16843
+libc-970218 16843
+libc-970219 16843
+libc-970220 16843
+libc-970221 16843
+libc-970222 16843
+libc-970223 16843
+libc-970224 16843
+libc-970225 16843
+libc-970226 16843
+libc-970227 16843
+libc-970228 16843
+libc-970301 16843
+libc-970302 16843
+libc-970303 16843
+libc-970304 16843
+libc-970305 16843
+libc-970306 16843
+libc-970307 16843
+libc-970308 16843
+libc-970309 16843
+libc-970310 16843
+libc-970311 16843
+libc-970312 16843
+libc-970313 16843
+libc-970314 16843
+libc-970315 16843
+libc-970316 16843
+libc-970317 16843
+libc-970318 16843
+libc-970319 16843
+libc-970320 16843
+libc-970321 16843
+libc-970322 16843
+libc-970323 16843
+libc-970324 16843
+libc-970325 17242
+libc-970326 17242
+libc-970327 17242
+libc-970328 17242
+libc-970329 17242
+libc-970330 17242
+libc-970331 17242
+libc-970401 17242
+libc-970402 17242
+libc-970403 17242
+libc-970404 17242
+libc-970405 17242
+libc-970406 17242
+libc-970407 17242
+libc-970408 17242
+libc-970409 17242
+libc-970410 17242
+libc-970411 17242
+libc-970412 17404
+libc-970413 17404
+libc-970414 17404
+libc-970415 17404
+libc-970416 17404
+libc-970417 17404
+libc-970418 17500
+libc-970419 17500
+libc-970420 17500
+libc-970421 17500
+libc-970422 17500
+libc-970423 17500
+libc-970424 17500
+libc-970425 17500
+libc-970426 17500
+libc-970427 17500
+libc-970428 17500
+libc-970429 17500
+libc-970430 17500
+libc-970501 17500
+libc-970502 17500
+libc-970503 17500
+libc-970504 17500
+libc-970505 17500
+libc-970506 17675
+libc-970507 17675
+libc-970508 17693
+libc-970509 17693
+libc-970510 17693
+libc-970511 17693
+libc-970512 17693
+libc-970513 17693
+libc-970514 17693
+libc-970515 17693
+libc-970516 17693
+libc-970517 17693
+libc-970518 17693
+libc-970519 17693
+libc-970520 17693
+libc-970521 17693
+libc-970522 17693
+libc-970523 17693
+libc-970524 17693
+libc-970525 17693
+libc-970526 17693
+libc-970527 17693
+libc-970528 17693
+libc-970529 17693
+libc-970530 17693
+libc-970531 17693
+libc-970601 17693
+libc-970602 17693
+libc-970603 17693
+libc-970604 17693
+libc-970605 17693
+libc-970606 18148
+libc-970607 18148
+libc-970608 18164
+libc-970609 18174
+libc-970610 18209
+libc-970611 18209
+libc-970612 18209
+libc-970613 18209
+libc-970614 18209
+libc-970615 18209
+libc-970616 18209
+libc-970617 18209
+libc-970618 18209
+libc-970619 18209
+libc-970620 18209
+libc-970621 18209
+libc-970622 18209
+libc-970624 18421
+libc-970625 18421
+libc-970626 18421
+libc-970627 18421
+libc-970628 18473
+libc-970629 18473
+libc-970630 18473
+libc-970701 18473
+libc-970702 18473
+libc-970703 18473
+libc-970704 18473
+libc-970705 18473
+libc-970707 18663
+libc-970708 18663
+libc-970709 18663
+libc-970710 18663
+libc-970713 18663
+libc-970715 18780
+libc-970717 18824
+libc-970718 18824
+libc-970719 18824
+libc-970720 18824
+libc-970721 18889
+libc-970722 18889
+libc-970723 18889
+libc-970724 18889
+libc-970725 18889
+libc-970726 18889
+libc-970727 19000
+libc-970728 19000
+libc-970729 19030
+libc-970730 19030
+libc-970731 19030
+libc-970801 19030
+libc-970802 19074
+libc-970803 19074
+libc-970804 19074
+libc-970805 19074
+libc-970806 19074
+libc-970807 19074
+libc-970808 19074
+libc-970809 19074
+libc-970810 19074
+libc-970811 19074
+libc-970812 19074
+libc-970813 19074
+libc-970814 19074
+libc-970815 19074
+libc-970816 19074
+libc-970817 19074
+libc-970818 19074
+libc-970819 19074
+libc-970820 19074
+libc-970821 19074
+libc-970822 19074
+libc-970823 19472
+libc-970824 19472
+libc-970825 19472
+libc-970826 19472
+libc-970827 19541
+libc-970828 19541
+libc-970829 19541
+libc-970830 19541
+libc-970831 19541
+libc-970901 19541
+libc-970902 19541
+libc-970903 19541
+libc-970904 19541
+libc-970905 19541
+libc-970906 19766
+libc-970907 19766
+libc-970908 19766
+libc-970911 19861
+libc-970912 19861
+libc-970913 19861
+libc-970914 19861
+libc-970915 19861
+libc-970916 19861
+libc-970917 19861
+libc-970918 19861
+libc-970919 19861
+libc-970920 19861
+libc-970921 19861
+libc-970922 19861
+libc-970923 19861
+libc-970924 19861
+libc-970925 19861
+libc-970926 19861
+libc-970927 19861
+libc-970928 19861
+libc-970929 19861
+libc-970930 19861
+libc-971001 19861
+libc-971018 19861
+libc-971019 19861
+libc-971020 19861
+libc-971021 19861
+libc-971022 19861
+libc-971023 19861
+libc-971024 19861
+libc-971025 19861
+libc-971026 19861
+libc-971027 19861
+libc-971028 19861
+libc-971029 19861
+libc-971030 19861
+libc-971031 19861
+libc-971101 19861
+libc-971102 19861
+libc-971103 19861
+libc-971104 19861
+libc-971105 19861
+libc-971106 19861
+libc-971107 19861
+libc-971108 19861
+libc-971109 19861
+libc-971110 19861
+libc-971111 19861
+libc-971112 19861
+libc-971113 19861
+libc-971114 19861
+libc-971115 19861
+libc-971116 19861
+libc-971117 19861
+libc-971118 19861
+libc-971120 19861
+libc-971121 19861
+libc-971122 19861
+libc-971123 19861
+libc-971124 19861
+libc-971125 19861
+libc-971126 19861
+libc-971127 19861
+libc-971128 19861
+libc-971129 19861
+libc-971130 19861
+libc-971201 19861
+libc-971203 19861
+libc-971204 19861
+libc-971205 19861
+libc-971206 19861
+libc-971207 19861
+libc-971208 19861
+libc-971209 19861
+libc-971210 19861
+libc-971211 19861
+libc-971212 19861
+libc-971213 19861
+libc-971214 19861
+libc-971217 19861
+libc-971218 19861
+libc-971219 19861
+libc-971220 19861
+libc-971221 19861
+libc-971222 19861
+libc-971223 19861
+libc-971224 19861
+libc-971225 19861
+libc-971226 19861
+libc-971227 19861
+libc-971228 19861
+libc-971229 19861
+libc-971230 19861
+libc-971231 19861
+libc-980103 19861
+libc-980104 19861
+libc-980105 19861
+libc-980106 19861
+libc-980107 19861
+libc-980108 19861
+libc-980109 19861
+libc-980110 19861
+libc-980111 19861
+libc-980112 19861
+libc-980114 19861
+libc-980115 19861
+libc-980116 19861
+libc-980117 19861
+libc-980118 19861
+libc-980119 19861
+libc-980120 19861
+libc-980121 19861
+libc-980122 19861
+libc-980123 19861
+libc-980124 19861
+libc-980125 19861
+libc-980126 19861
+libc-980127 19861
+libc-980128 19861
+libc-980129 20797
+libc-980130 20797
+libc-980212 20832
+libc-980213 20832
+libc-980214 20893
+libc-980215 20893
+libc-980216 20893
+libc-980217 20893
+libc-980218 20893
+libc-980219 20893
+libc-980220 20893
+libc-980221 20893
+libc-980222 20893
+libc-980223 20893
+libc-980224 20893
+libc-980225 20893
+libc-980226 20893
+libc-980227 20893
+libc-980228 20893
+libc-980301 20893
+libc-980302 20893
+libc-980303 20893
+libc-980304 20893
+libc-980306 20893
+libc-980307 20893
+libc-980308 20893
+libc-980309 20893
+libc-980310 20893
+libc-980311 20893
+libc-980312 20893
+libc-980313 20893
+libc-980314 20893
+libc-980315 20893
+libc-980316 20893
+libc-980317 20893
+libc-980318 20893
+libc-980319 20893
+libc-980320 20893
+libc-980321 20893
+libc-980322 20893
+libc-980323 20893
+libc-980324 20893
+libc-980325 20893
+libc-980326 20893
+libc-980327 20893
+libc-980328 20893
+libc-980329 20893
+libc-980330 20893
+libc-980331 20893
+libc-980401 20893
+libc-980402 20893
+libc-980403 20893
+libc-980404 20893
+libc-980405 20893
+libc-980406 20893
+libc-980407 20893
+libc-980408 20893
+libc-980409 20893
+libc-980410 20893
+libc-980411 20893
+libc-980412 20893
+libc-980413 20893
+libc-980414 20893
+libc-980428 20893
+libc-980429 20893
+libc-980430 20893
+libc-980501 20893
+libc-980502 20893
+libc-980503 20893
+libc-980504 20893
+libc-980505 20893
+libc-980506 20893
+libc-980507 20893
+libc-980508 20893
+libc-980509 20893
+libc-980510 20893
+libc-980512 20893
+libc-980513 20893
+libc-980514 20893
+libc-980515 20893
+libc-980516 20893
+libc-980517 20893
+libc-980518 20893
+libc-980519 20893
+libc-980520 20893
+libc-980521 20893
+libc-980522 20893
+libc-980523 20893
+libc-980524 20893
+libc-980525 20893
+libc-980526 20893
+libc-980527 20893
+libc-980528 20893
+libc-980529 20893
+libc-980530 20893
+libc-980531 20893
+libc-980601 20893
+libc-980602 20893
+libc-980603 20893
+libc-980604 20893
+libc-980605 20893
+libc-980606 20893
+libc-980607 20893
+libc-980608 20893
+libc-980609 20893
+libc-980610 20893
+libc-980611 20893
+libc-980612 20893
+libc-980613 20893
+libc-980614 22478
+libc-980615 22478
+libc-980616 22478
+libc-980617 22478
+libc-980618 22478
+libc-980619 22478
+libc-980620 22478
+libc-980621 22478
+libc-980622 22478
+libc-980623 22478
+libc-980624 22478
+libc-980625 22478
+libc-980626 22478
+libc-980627 22478
+libc-980628 22478
+libc-980629 22478
+libc-980630 22478
+libc-980701 22478
+libc-980702 22478
+libc-980703 22478
+libc-980704 22478
+libc-980705 22478
+libc-980706 22478
+libc-980707 22478
+libc-980708 22478
+libc-980709 22478
+libc-980710 22478
+libc-980711 22478
+libc-980712 22478
+libc-980713 22478
+libc-980714 22478
+libc-980715 22478
+libc-980716 22478
+libc-980717 22478
+libc-980718 22478
+libc-980719 22478
+libc-980720 22787
+libc_1_09 10803
+make-3-72-9 10364
+make-3-72-10 10364
+make-3-72-11 10364
+make-3-72-12 10364
+make-3-72-13 10364
+make-3-73 10364
+make-3-73-1 10364
+make-3-73-2 10364
+make-3-73-3 11789
+make-3-74 11789
+make-3-74-1 12800
+make-3-74-2 12800
+make-3-74-3 14458
+make-3-74-4 14846
+make-3-74-5 15594
+make-3-74-6 15594
+make-3-74-7 15594
+make-3-75 15594
+make-3-75-1 18912
+make-3-75-91 18912
+make-3-75-92 19342
+make-3-75-93 21502
+make-3-76 19768
+make-3-76-1 19768
+release-0-0 15702
+release-0-1 15702
+release-1-0 17404
+Release_5_25 24283
+root-libc-2_0_x-branch 16843
diff --git a/admin/notes/unicode b/admin/notes/unicode
index ce7d3732f03..dda6ec4cc93 100644
--- a/admin/notes/unicode
+++ b/admin/notes/unicode
@@ -1,6 +1,6 @@
-*-mode: text; coding: latin-1;-*-
-Copyright (C) 2002-2011 Free Software Foundation, Inc.
+Copyright (C) 2002-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
Problems, fixmes and other unicode-related issues
@@ -62,14 +62,6 @@ regard to completeness.
dumped emacs. But, those maps (char tables) generated while
temacs is running can't be removed from the dumped emacs.
- * Translation tables for {en,de}code currently aren't supported.
-
- This should be fixed by the changes of 2002-10-14.
-
- * Defining CCL coding systems currently doesn't work.
-
- This should be fixed by the changes of 2003-01-30.
-
* iso-2022 charsets get unified on i/o.
With the change on 2003-01-06, decoding routines put `charset'
@@ -88,8 +80,6 @@ regard to completeness.
handle more scripts specifically ( la Devanagari). There are
issues with canonicalization.
- * Bidi is a separate issue with no support currently.
-
* We need tabular input methods, e.g. for maths symbols. (Not
specific to Unicode.)
@@ -102,27 +92,9 @@ regard to completeness.
worry about what happens when double-width charsets covering
non-CJK characters are unified.
- * Emacs 20/21 .elc files are currently not loadable. It may or may
- not be possible to do this properly.
-
- With the change on 2002-07-24, elc files generated by Emacs
- 20.3 and later are correctly loaded (including those
- containing multibyte characters and compressed). But, elc
- files generated by 20.2 and the primer are still not loadable.
- Is it really worth working on it?
-
- * Rmail won't work with non-ASCII text. Encoding issues for Babyl
- files need sorting out, but rms says Babyl will go before this is
- released.
-
- * Gnus still needs some attention, and we need to get changes
- accepted by Gnus maintainers...
-
* There are type errors lurking, e.g. in
Fcheck_coding_systems_region. Define ENABLE_CHECKING to find them.
- * You can grep the code for lots of fixmes.
-
* Old auto-save files, and similar files, such as Gnus drafts,
containing non-ASCII characters probably won't be re-read correctly.
diff --git a/admin/nt/README-UNDUMP.W32 b/admin/nt/README-UNDUMP.W32
index 8c7d1510a05..d3dd88a99ec 100644
--- a/admin/nt/README-UNDUMP.W32
+++ b/admin/nt/README-UNDUMP.W32
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
Emacs for Windows
diff --git a/admin/nt/README-ftp-server b/admin/nt/README-ftp-server
index c320bbe915d..1b0c9390889 100644
--- a/admin/nt/README-ftp-server
+++ b/admin/nt/README-ftp-server
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
Precompiled Distributions of
diff --git a/admin/quick-install-emacs b/admin/quick-install-emacs
index 841a895248e..4abef102dc4 100755
--- a/admin/quick-install-emacs
+++ b/admin/quick-install-emacs
@@ -1,7 +1,7 @@
#!/bin/sh
### quick-install-emacs --- do a halfway-decent job of installing emacs quickly
-## Copyright (C) 2001-2011 Free Software Foundation, Inc.
+## Copyright (C) 2001-2012 Free Software Foundation, Inc.
## Author: Miles Bader <miles@gnu.org>
@@ -28,7 +28,7 @@
PUBLIC_LIBSRC_BINARIES='emacsclient etags ctags ebrowse'
-PUBLIC_LIBSRC_SCRIPTS='grep-changelog rcs-checkin'
+PUBLIC_LIBSRC_SCRIPTS='grep-changelog'
AVOID="CVS -DIC README COPYING ChangeLog ~ [.]orig$ [.]rej$ Makefile$ Makefile.in$ makefile$ makefile.w32-in$ stamp-subdir [.]cvsignore [.]arch-ids [{]arch[}] [.][cho]$ make-docfile testfile test-distrib"
@@ -49,7 +49,7 @@ COPY='cp -f'
REMOVE='rm -r'
MKDIR='mkdir -p'
-# Used to execute commands once once we create them
+# Used to execute commands once we create them
EXEC='sh'
NAWK=/usr/bin/nawk
@@ -171,9 +171,9 @@ test x"$prefix" = x && { prefix="`get_config_var prefix`" || exit 4 ; }
test x"$ARCH" = x && { ARCH="`get_config_var host`" || exit 4 ; }
VERSION=`
- sed -n 's/^AC_INIT(emacs,[ ]*\([^ )]*\).*/\1/p' <$SRC/configure.in
+ sed -n 's/^AC_INIT(emacs,[ ]*\([^ )]*\).*/\1/p' <$SRC/configure.ac
` || exit 4
-test -n "$VERSION" || { echo >&2 "$me: no version in configure.in"; exit 4; }
+test -n "$VERSION" || { echo >&2 "$me: no version in configure.ac"; exit 4; }
DST_SHARE="$prefix/share/emacs/$VERSION"
DST_BIN="$prefix/bin"
diff --git a/admin/unidata/BidiMirroring.txt b/admin/unidata/BidiMirroring.txt
index 902f9a6b886..ec41b769375 100644
--- a/admin/unidata/BidiMirroring.txt
+++ b/admin/unidata/BidiMirroring.txt
@@ -1,19 +1,19 @@
-# BidiMirroring-6.0.0.txt
-# Date: 2010-06-21, 12:09:00 PDT [KW]
+# BidiMirroring-6.2.0.txt
+# Date: 2012-05-15, 24:19:00 GMT [KW, LI]
#
# Bidi_Mirroring_Glyph Property
#
# This file is an informative contributory data file in the
# Unicode Character Database.
#
-# Copyright (c) 1991-2010 Unicode, Inc.
+# Copyright (c) 1991-2012 Unicode, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
-# This data file lists characters that have the Bidi_Mirrored=True property
+# This data file lists characters that have the Bidi_Mirrored=Yes property
# value, for which there is another Unicode character that typically has a glyph
# that is the mirror image of the original character's glyph.
#
-# The repertoire covered by the file is Unicode 6.0.0.
+# The repertoire covered by the file is Unicode 6.2.0.
#
# The file contains a list of lines with mappings from one code point
# to another one for character-based mirroring.
@@ -26,12 +26,12 @@
# variable-length hexadecimal value with 4 to 6 digits.
# A comment indicates where the characters are "BEST FIT" mirroring.
#
-# Code points for which Bidi_Mirrored=True, but for which no appropriate
+# Code points for which Bidi_Mirrored=Yes, but for which no appropriate
# characters exist with mirrored glyphs, are
# listed as comments at the end of the file.
#
# Formally, the default value of the Bidi_Mirroring_Glyph property
-# for each code point is the code point itself, unless a mapping to
+# for each code point is <none>, unless a mapping to
# some other character is specified in this data file. When a code
# point has the default value for the Bidi_Mirroring_Glyph property,
# that means that no other character exists whose glyph is suitable
@@ -41,9 +41,14 @@
# at http://www.unicode.org/unicode/reports/tr9/
#
# This file was originally created by Markus Scherer.
-# Extended for Unicode 3.2, 4.0, 4.1, 5.0, 5.1, 5.2, and 6.0 by Ken Whistler.
+# Extended for Unicode 3.2, 4.0, 4.1, 5.0, 5.1, 5.2, and 6.0 by Ken Whistler,
+# and for Unicode 6.1 and 6.2 by Ken Whistler and Laurentiu Iancu.
#
# ############################################################
+#
+# Property: Bidi_Mirroring_Glyph
+#
+# @missing: 0000..10FFFF; <none>
0028; 0029 # LEFT PARENTHESIS
0029; 0028 # RIGHT PARENTHESIS
@@ -209,6 +214,8 @@
27C6; 27C5 # RIGHT S-SHAPED BAG DELIMITER
27C8; 27C9 # REVERSE SOLIDUS PRECEDING SUBSET
27C9; 27C8 # SUPERSET PRECEDING SOLIDUS
+27CB; 27CD # MATHEMATICAL RISING DIAGONAL
+27CD; 27CB # MATHEMATICAL FALLING DIAGONAL
27D5; 27D6 # LEFT OUTER JOIN
27D6; 27D5 # RIGHT OUTER JOIN
27DD; 27DE # LONG RIGHT TACK
diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in
index c890dad8903..ecbd0490246 100644
--- a/admin/unidata/Makefile.in
+++ b/admin/unidata/Makefile.in
@@ -1,4 +1,7 @@
# Makefile -- Makefile to generate character property tables.
+
+# Copyright (C) 2012 Free Software Foundation, Inc.
+
# Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011
# National Institute of Advanced Industrial Science and Technology (AIST)
# Registration Number H13PRO009
@@ -18,25 +21,33 @@
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+SHELL = /bin/sh
+
+srcdir = @srcdir@
+abs_builddir = @abs_builddir@
+top_srcdir = @top_srcdir@
+abs_top_builddir = @abs_top_builddir@
-EMACS = ../../src/emacs
-DSTDIR = ../../lisp/international
-RUNEMACS = ${EMACS} -Q -batch
+EMACS = ${abs_top_builddir}/src/emacs
+DSTDIR = ${top_srcdir}/lisp/international
+emacs = ${EMACS} -batch --no-site-file --no-site-lisp
all: ${DSTDIR}/charprop.el
.el.elc:
- ${RUNEMACS} -batch -f batch-byte-compile $<
+ ${emacs} -f batch-byte-compile $<
-unidata.txt: UnicodeData.txt
- sed -e 's/\([^;]*\);\(.*\)/(#x\1 "\2")/' -e 's/;/" "/g' < UnicodeData.txt > $@
+unidata.txt: ${srcdir}/UnicodeData.txt
+ sed -e 's/\([^;]*\);\(.*\)/(#x\1 "\2")/' -e 's/;/" "/g' < ${srcdir}/UnicodeData.txt > $@
-${DSTDIR}/charprop.el: unidata-gen.elc unidata.txt
- ELC=`/bin/pwd`/unidata-gen.elc; \
- DATADIR=`/bin/pwd`; \
- DATA=unidata.txt; \
- cd ${DSTDIR}; \
- ${RUNEMACS} -batch --load $${ELC} -f unidata-gen-files $${DATADIR} $${DATA}
+${DSTDIR}/charprop.el: ${srcdir}/unidata-gen.elc unidata.txt
+ cd ${DSTDIR} && ${emacs} -l ${srcdir}/unidata-gen \
+ -f unidata-gen-files ${srcdir} ${abs_builddir}/unidata.txt
+
+## Like the above, but generate in PWD rather than lisp/international.
+charprop.el: ${srcdir}/unidata-gen.elc unidata.txt
+ ${emacs} -l ${srcdir}/unidata-gen \
+ -f unidata-gen-files ${srcdir} unidata.txt
install: charprop.el
cp charprop.el ${DSTDIR}
@@ -46,4 +57,9 @@ clean:
if test -f charprop.el; then \
rm -f `sed -n 's/^;; FILE: //p' < charprop.el`; \
fi
- rm -f charprop.el unidata-gen.elc unidata.txt
+ rm -f charprop.el ${srcdir}/unidata-gen.elc unidata.txt
+
+distclean: clean
+ -rm -f ./Makefile
+
+maintainer-clean: distclean
diff --git a/admin/unidata/README b/admin/unidata/README
index 6048a6d624e..481cd5e9b6a 100644
--- a/admin/unidata/README
+++ b/admin/unidata/README
@@ -1,4 +1,4 @@
The file `UnicodeData.txt' in this directory is a copy of
-<http://www.unicode.org/Public/UNIDATA/UnicodeData.txt> on 2009.10.1,
+<http://www.unicode.org/Public/UNIDATA/UnicodeData.txt> on 2012.04.07,
and is a part of the Unicode Character Database governed by the "UCD
Terms of Use" shown in the file `copyright.html'.
diff --git a/admin/unidata/UnicodeData.txt b/admin/unidata/UnicodeData.txt
index 8d7222b1378..086379eb4f3 100644
--- a/admin/unidata/UnicodeData.txt
+++ b/admin/unidata/UnicodeData.txt
@@ -165,10 +165,10 @@
00A4;CURRENCY SIGN;Sc;0;ET;;;;;N;;;;;
00A5;YEN SIGN;Sc;0;ET;;;;;N;;;;;
00A6;BROKEN BAR;So;0;ON;;;;;N;BROKEN VERTICAL BAR;;;;
-00A7;SECTION SIGN;So;0;ON;;;;;N;;;;;
+00A7;SECTION SIGN;Po;0;ON;;;;;N;;;;;
00A8;DIAERESIS;Sk;0;ON;<compat> 0020 0308;;;;N;SPACING DIAERESIS;;;;
00A9;COPYRIGHT SIGN;So;0;ON;;;;;N;;;;;
-00AA;FEMININE ORDINAL INDICATOR;Ll;0;L;<super> 0061;;;;N;;;;;
+00AA;FEMININE ORDINAL INDICATOR;Lo;0;L;<super> 0061;;;;N;;;;;
00AB;LEFT-POINTING DOUBLE ANGLE QUOTATION MARK;Pi;0;ON;;;;;Y;LEFT POINTING GUILLEMET;;;;
00AC;NOT SIGN;Sm;0;ON;;;;;N;;;;;
00AD;SOFT HYPHEN;Cf;0;BN;;;;;N;;;;;
@@ -180,11 +180,11 @@
00B3;SUPERSCRIPT THREE;No;0;EN;<super> 0033;;3;3;N;SUPERSCRIPT DIGIT THREE;;;;
00B4;ACUTE ACCENT;Sk;0;ON;<compat> 0020 0301;;;;N;SPACING ACUTE;;;;
00B5;MICRO SIGN;Ll;0;L;<compat> 03BC;;;;N;;;039C;;039C
-00B6;PILCROW SIGN;So;0;ON;;;;;N;PARAGRAPH SIGN;;;;
+00B6;PILCROW SIGN;Po;0;ON;;;;;N;PARAGRAPH SIGN;;;;
00B7;MIDDLE DOT;Po;0;ON;;;;;N;;;;;
00B8;CEDILLA;Sk;0;ON;<compat> 0020 0327;;;;N;SPACING CEDILLA;;;;
00B9;SUPERSCRIPT ONE;No;0;EN;<super> 0031;;1;1;N;SUPERSCRIPT DIGIT ONE;;;;
-00BA;MASCULINE ORDINAL INDICATOR;Ll;0;L;<super> 006F;;;;N;;;;;
+00BA;MASCULINE ORDINAL INDICATOR;Lo;0;L;<super> 006F;;;;N;;;;;
00BB;RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK;Pf;0;ON;;;;;Y;RIGHT POINTING GUILLEMET;;;;
00BC;VULGAR FRACTION ONE QUARTER;No;0;ON;<fraction> 0031 2044 0034;;;1/4;N;FRACTION ONE QUARTER;;;;
00BD;VULGAR FRACTION ONE HALF;No;0;ON;<fraction> 0031 2044 0032;;;1/2;N;FRACTION ONE HALF;;;;
@@ -612,7 +612,7 @@
0263;LATIN SMALL LETTER GAMMA;Ll;0;L;;;;;N;;;0194;;0194
0264;LATIN SMALL LETTER RAMS HORN;Ll;0;L;;;;;N;LATIN SMALL LETTER BABY GAMMA;;;;
0265;LATIN SMALL LETTER TURNED H;Ll;0;L;;;;;N;;;A78D;;A78D
-0266;LATIN SMALL LETTER H WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER H HOOK;;;;
+0266;LATIN SMALL LETTER H WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER H HOOK;;A7AA;;A7AA
0267;LATIN SMALL LETTER HENG WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER HENG HOOK;;;;
0268;LATIN SMALL LETTER I WITH STROKE;Ll;0;L;;;;;N;LATIN SMALL LETTER BARRED I;;0197;;0197
0269;LATIN SMALL LETTER IOTA;Ll;0;L;;;;;N;;;0196;;0196
@@ -1394,6 +1394,7 @@
0587;ARMENIAN SMALL LIGATURE ECH YIWN;Ll;0;L;<compat> 0565 0582;;;;N;;;;;
0589;ARMENIAN FULL STOP;Po;0;L;;;;;N;ARMENIAN PERIOD;;;;
058A;ARMENIAN HYPHEN;Pd;0;ON;;;;;N;;;;;
+058F;ARMENIAN DRAM SIGN;Sc;0;ET;;;;;N;;;;;
0591;HEBREW ACCENT ETNAHTA;Mn;220;NSM;;;;;N;;;;;
0592;HEBREW ACCENT SEGOL;Mn;230;NSM;;;;;N;;;;;
0593;HEBREW ACCENT SHALSHELET;Mn;230;NSM;;;;;N;;;;;
@@ -1485,6 +1486,7 @@
0601;ARABIC SIGN SANAH;Cf;0;AN;;;;;N;;;;;
0602;ARABIC FOOTNOTE MARKER;Cf;0;AN;;;;;N;;;;;
0603;ARABIC SIGN SAFHA;Cf;0;AN;;;;;N;;;;;
+0604;ARABIC SIGN SAMVAT;Cf;0;AN;;;;;N;;;;;
0606;ARABIC-INDIC CUBE ROOT;Sm;0;ON;;;;;N;;;;;
0607;ARABIC-INDIC FOURTH ROOT;Sm;0;ON;;;;;N;;;;;
0608;ARABIC RAY;Sm;0;AL;;;;;N;;;;;
@@ -1747,7 +1749,7 @@
070B;SYRIAC HARKLEAN OBELUS;Po;0;AL;;;;;N;;;;;
070C;SYRIAC HARKLEAN METOBELUS;Po;0;AL;;;;;N;;;;;
070D;SYRIAC HARKLEAN ASTERISCUS;Po;0;AL;;;;;N;;;;;
-070F;SYRIAC ABBREVIATION MARK;Cf;0;AN;;;;;N;;;;;
+070F;SYRIAC ABBREVIATION MARK;Cf;0;AL;;;;;N;;;;;
0710;SYRIAC LETTER ALAPH;Lo;0;AL;;;;;N;;;;;
0711;SYRIAC LETTER SUPERSCRIPT ALAPH;Mn;36;NSM;;;;;N;;;;;
0712;SYRIAC LETTER BETH;Lo;0;AL;;;;;N;;;;;
@@ -2057,6 +2059,45 @@
085A;MANDAIC VOCALIZATION MARK;Mn;220;NSM;;;;;N;;;;;
085B;MANDAIC GEMINATION MARK;Mn;220;NSM;;;;;N;;;;;
085E;MANDAIC PUNCTUATION;Po;0;R;;;;;N;;;;;
+08A0;ARABIC LETTER BEH WITH SMALL V BELOW;Lo;0;AL;;;;;N;;;;;
+08A2;ARABIC LETTER JEEM WITH TWO DOTS ABOVE;Lo;0;AL;;;;;N;;;;;
+08A3;ARABIC LETTER TAH WITH TWO DOTS ABOVE;Lo;0;AL;;;;;N;;;;;
+08A4;ARABIC LETTER FEH WITH DOT BELOW AND THREE DOTS ABOVE;Lo;0;AL;;;;;N;;;;;
+08A5;ARABIC LETTER QAF WITH DOT BELOW;Lo;0;AL;;;;;N;;;;;
+08A6;ARABIC LETTER LAM WITH DOUBLE BAR;Lo;0;AL;;;;;N;;;;;
+08A7;ARABIC LETTER MEEM WITH THREE DOTS ABOVE;Lo;0;AL;;;;;N;;;;;
+08A8;ARABIC LETTER YEH WITH TWO DOTS BELOW AND HAMZA ABOVE;Lo;0;AL;;;;;N;;;;;
+08A9;ARABIC LETTER YEH WITH TWO DOTS BELOW AND DOT ABOVE;Lo;0;AL;;;;;N;;;;;
+08AA;ARABIC LETTER REH WITH LOOP;Lo;0;AL;;;;;N;;;;;
+08AB;ARABIC LETTER WAW WITH DOT WITHIN;Lo;0;AL;;;;;N;;;;;
+08AC;ARABIC LETTER ROHINGYA YEH;Lo;0;AL;;;;;N;;;;;
+08E4;ARABIC CURLY FATHA;Mn;230;NSM;;;;;N;;;;;
+08E5;ARABIC CURLY DAMMA;Mn;230;NSM;;;;;N;;;;;
+08E6;ARABIC CURLY KASRA;Mn;220;NSM;;;;;N;;;;;
+08E7;ARABIC CURLY FATHATAN;Mn;230;NSM;;;;;N;;;;;
+08E8;ARABIC CURLY DAMMATAN;Mn;230;NSM;;;;;N;;;;;
+08E9;ARABIC CURLY KASRATAN;Mn;220;NSM;;;;;N;;;;;
+08EA;ARABIC TONE ONE DOT ABOVE;Mn;230;NSM;;;;;N;;;;;
+08EB;ARABIC TONE TWO DOTS ABOVE;Mn;230;NSM;;;;;N;;;;;
+08EC;ARABIC TONE LOOP ABOVE;Mn;230;NSM;;;;;N;;;;;
+08ED;ARABIC TONE ONE DOT BELOW;Mn;220;NSM;;;;;N;;;;;
+08EE;ARABIC TONE TWO DOTS BELOW;Mn;220;NSM;;;;;N;;;;;
+08EF;ARABIC TONE LOOP BELOW;Mn;220;NSM;;;;;N;;;;;
+08F0;ARABIC OPEN FATHATAN;Mn;27;NSM;;;;;N;;;;;
+08F1;ARABIC OPEN DAMMATAN;Mn;28;NSM;;;;;N;;;;;
+08F2;ARABIC OPEN KASRATAN;Mn;29;NSM;;;;;N;;;;;
+08F3;ARABIC SMALL HIGH WAW;Mn;230;NSM;;;;;N;;;;;
+08F4;ARABIC FATHA WITH RING;Mn;230;NSM;;;;;N;;;;;
+08F5;ARABIC FATHA WITH DOT ABOVE;Mn;230;NSM;;;;;N;;;;;
+08F6;ARABIC KASRA WITH DOT BELOW;Mn;220;NSM;;;;;N;;;;;
+08F7;ARABIC LEFT ARROWHEAD ABOVE;Mn;230;NSM;;;;;N;;;;;
+08F8;ARABIC RIGHT ARROWHEAD ABOVE;Mn;230;NSM;;;;;N;;;;;
+08F9;ARABIC LEFT ARROWHEAD BELOW;Mn;220;NSM;;;;;N;;;;;
+08FA;ARABIC RIGHT ARROWHEAD BELOW;Mn;220;NSM;;;;;N;;;;;
+08FB;ARABIC DOUBLE RIGHT ARROWHEAD ABOVE;Mn;230;NSM;;;;;N;;;;;
+08FC;ARABIC DOUBLE RIGHT ARROWHEAD ABOVE WITH DOT;Mn;230;NSM;;;;;N;;;;;
+08FD;ARABIC RIGHT ARROWHEAD ABOVE WITH DOT;Mn;230;NSM;;;;;N;;;;;
+08FE;ARABIC DAMMA WITH DOT;Mn;230;NSM;;;;;N;;;;;
0900;DEVANAGARI SIGN INVERTED CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
0901;DEVANAGARI SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
0902;DEVANAGARI SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
@@ -2437,6 +2478,7 @@
0AED;GUJARATI DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
0AEE;GUJARATI DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
0AEF;GUJARATI DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
+0AF0;GUJARATI ABBREVIATION SIGN;Po;0;L;;;;;N;;;;;
0AF1;GUJARATI RUPEE SIGN;Sc;0;ET;;;;;N;;;;;
0B01;ORIYA SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
0B02;ORIYA SIGN ANUSVARA;Mc;0;L;;;;;N;;;;;
@@ -3109,6 +3151,8 @@
0ED9;LAO DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
0EDC;LAO HO NO;Lo;0;L;<compat> 0EAB 0E99;;;;N;;;;;
0EDD;LAO HO MO;Lo;0;L;<compat> 0EAB 0EA1;;;;N;;;;;
+0EDE;LAO LETTER KHMU GO;Lo;0;L;;;;;N;;;;;
+0EDF;LAO LETTER KHMU NYO;Lo;0;L;;;;;N;;;;;
0F00;TIBETAN SYLLABLE OM;Lo;0;L;;;;;N;;;;;
0F01;TIBETAN MARK GTER YIG MGO TRUNCATED A;So;0;L;;;;;N;;;;;
0F02;TIBETAN MARK GTER YIG MGO -UM RNAM BCAD MA;So;0;L;;;;;N;;;;;
@@ -3129,7 +3173,7 @@
0F11;TIBETAN MARK RIN CHEN SPUNGS SHAD;Po;0;L;;;;;N;TIBETAN RINCHANPHUNGSHAD;;;;
0F12;TIBETAN MARK RGYA GRAM SHAD;Po;0;L;;;;;N;;;;;
0F13;TIBETAN MARK CARET -DZUD RTAGS ME LONG CAN;So;0;L;;;;;N;;;;;
-0F14;TIBETAN MARK GTER TSHEG;So;0;L;;;;;N;TIBETAN COMMA;;;;
+0F14;TIBETAN MARK GTER TSHEG;Po;0;L;;;;;N;TIBETAN COMMA;;;;
0F15;TIBETAN LOGOTYPE SIGN CHAD RTAGS;So;0;L;;;;;N;;;;;
0F16;TIBETAN LOGOTYPE SIGN LHAG RTAGS;So;0;L;;;;;N;;;;;
0F17;TIBETAN ASTROLOGICAL SIGN SGRA GCAN -CHAR RTAGS;So;0;L;;;;;N;;;;;
@@ -3518,6 +3562,8 @@
10C3;GEORGIAN CAPITAL LETTER WE;Lu;0;L;;;;;N;;;;2D23;
10C4;GEORGIAN CAPITAL LETTER HAR;Lu;0;L;;;;;N;;;;2D24;
10C5;GEORGIAN CAPITAL LETTER HOE;Lu;0;L;;;;;N;;;;2D25;
+10C7;GEORGIAN CAPITAL LETTER YN;Lu;0;L;;;;;N;;;;2D27;
+10CD;GEORGIAN CAPITAL LETTER AEN;Lu;0;L;;;;;N;;;;2D2D;
10D0;GEORGIAN LETTER AN;Lo;0;L;;;;;N;GEORGIAN SMALL LETTER AN;;;;
10D1;GEORGIAN LETTER BAN;Lo;0;L;;;;;N;GEORGIAN SMALL LETTER BAN;;;;
10D2;GEORGIAN LETTER GAN;Lo;0;L;;;;;N;GEORGIAN SMALL LETTER GAN;;;;
@@ -3563,6 +3609,9 @@
10FA;GEORGIAN LETTER AIN;Lo;0;L;;;;;N;;;;;
10FB;GEORGIAN PARAGRAPH SEPARATOR;Po;0;L;;;;;N;;;;;
10FC;MODIFIER LETTER GEORGIAN NAR;Lm;0;L;<super> 10DC;;;;N;;;;;
+10FD;GEORGIAN LETTER AEN;Lo;0;L;;;;;N;;;;;
+10FE;GEORGIAN LETTER HARD SIGN;Lo;0;L;;;;;N;;;;;
+10FF;GEORGIAN LETTER LABIAL SIGN;Lo;0;L;;;;;N;;;;;
1100;HANGUL CHOSEONG KIYEOK;Lo;0;L;;;;;N;;;;;
1101;HANGUL CHOSEONG SSANGKIYEOK;Lo;0;L;;;;;N;;;;;
1102;HANGUL CHOSEONG NIEUN;Lo;0;L;;;;;N;;;;;
@@ -4148,7 +4197,7 @@
135D;ETHIOPIC COMBINING GEMINATION AND VOWEL LENGTH MARK;Mn;230;NSM;;;;;N;;;;;
135E;ETHIOPIC COMBINING VOWEL LENGTH MARK;Mn;230;NSM;;;;;N;;;;;
135F;ETHIOPIC COMBINING GEMINATION MARK;Mn;230;NSM;;;;;N;;;;;
-1360;ETHIOPIC SECTION MARK;So;0;L;;;;;N;;;;;
+1360;ETHIOPIC SECTION MARK;Po;0;L;;;;;N;;;;;
1361;ETHIOPIC WORDSPACE;Po;0;L;;;;;N;;;;;
1362;ETHIOPIC FULL STOP;Po;0;L;;;;;N;;;;;
1363;ETHIOPIC COMMA;Po;0;L;;;;;N;;;;;
@@ -5171,8 +5220,8 @@
17B1;KHMER INDEPENDENT VOWEL QOO TYPE ONE;Lo;0;L;;;;;N;;;;;
17B2;KHMER INDEPENDENT VOWEL QOO TYPE TWO;Lo;0;L;;;;;N;;;;;
17B3;KHMER INDEPENDENT VOWEL QAU;Lo;0;L;;;;;N;;;;;
-17B4;KHMER VOWEL INHERENT AQ;Cf;0;L;;;;;N;;;;;
-17B5;KHMER VOWEL INHERENT AA;Cf;0;L;;;;;N;;;;;
+17B4;KHMER VOWEL INHERENT AQ;Mn;0;NSM;;;;;N;;;;;
+17B5;KHMER VOWEL INHERENT AA;Mn;0;NSM;;;;;N;;;;;
17B6;KHMER VOWEL SIGN AA;Mc;0;L;;;;;N;;;;;
17B7;KHMER VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;;
17B8;KHMER VOWEL SIGN II;Mn;0;NSM;;;;;N;;;;;
@@ -5996,6 +6045,9 @@
1BA8;SUNDANESE VOWEL SIGN PAMEPET;Mn;0;NSM;;;;;N;;;;;
1BA9;SUNDANESE VOWEL SIGN PANEULEUNG;Mn;0;NSM;;;;;N;;;;;
1BAA;SUNDANESE SIGN PAMAAEH;Mc;9;L;;;;;N;;;;;
+1BAB;SUNDANESE SIGN VIRAMA;Mn;9;NSM;;;;;N;;;;;
+1BAC;SUNDANESE CONSONANT SIGN PASANGAN MA;Mc;0;L;;;;;N;;;;;
+1BAD;SUNDANESE CONSONANT SIGN PASANGAN WA;Mc;0;L;;;;;N;;;;;
1BAE;SUNDANESE LETTER KHA;Lo;0;L;;;;;N;;;;;
1BAF;SUNDANESE LETTER SYA;Lo;0;L;;;;;N;;;;;
1BB0;SUNDANESE DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
@@ -6008,6 +6060,12 @@
1BB7;SUNDANESE DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
1BB8;SUNDANESE DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
1BB9;SUNDANESE DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
+1BBA;SUNDANESE AVAGRAHA;Lo;0;L;;;;;N;;;;;
+1BBB;SUNDANESE LETTER REU;Lo;0;L;;;;;N;;;;;
+1BBC;SUNDANESE LETTER LEU;Lo;0;L;;;;;N;;;;;
+1BBD;SUNDANESE LETTER BHA;Lo;0;L;;;;;N;;;;;
+1BBE;SUNDANESE LETTER FINAL K;Lo;0;L;;;;;N;;;;;
+1BBF;SUNDANESE LETTER FINAL M;Lo;0;L;;;;;N;;;;;
1BC0;BATAK LETTER A;Lo;0;L;;;;;N;;;;;
1BC1;BATAK LETTER SIMALUNGUN A;Lo;0;L;;;;;N;;;;;
1BC2;BATAK LETTER HA;Lo;0;L;;;;;N;;;;;
@@ -6186,6 +6244,14 @@
1C7D;OL CHIKI AHAD;Lm;0;L;;;;;N;;;;;
1C7E;OL CHIKI PUNCTUATION MUCAAD;Po;0;L;;;;;N;;;;;
1C7F;OL CHIKI PUNCTUATION DOUBLE MUCAAD;Po;0;L;;;;;N;;;;;
+1CC0;SUNDANESE PUNCTUATION BINDU SURYA;Po;0;L;;;;;N;;;;;
+1CC1;SUNDANESE PUNCTUATION BINDU PANGLONG;Po;0;L;;;;;N;;;;;
+1CC2;SUNDANESE PUNCTUATION BINDU PURNAMA;Po;0;L;;;;;N;;;;;
+1CC3;SUNDANESE PUNCTUATION BINDU CAKRA;Po;0;L;;;;;N;;;;;
+1CC4;SUNDANESE PUNCTUATION BINDU LEU SATANGA;Po;0;L;;;;;N;;;;;
+1CC5;SUNDANESE PUNCTUATION BINDU KA SATANGA;Po;0;L;;;;;N;;;;;
+1CC6;SUNDANESE PUNCTUATION BINDU DA SATANGA;Po;0;L;;;;;N;;;;;
+1CC7;SUNDANESE PUNCTUATION BINDU BA SATANGA;Po;0;L;;;;;N;;;;;
1CD0;VEDIC TONE KARSHANA;Mn;230;NSM;;;;;N;;;;;
1CD1;VEDIC TONE SHARA;Mn;230;NSM;;;;;N;;;;;
1CD2;VEDIC TONE PRENKHA;Mn;230;NSM;;;;;N;;;;;
@@ -6221,6 +6287,10 @@
1CF0;VEDIC SIGN RTHANG LONG ANUSVARA;Lo;0;L;;;;;N;;;;;
1CF1;VEDIC SIGN ANUSVARA UBHAYATO MUKHA;Lo;0;L;;;;;N;;;;;
1CF2;VEDIC SIGN ARDHAVISARGA;Mc;0;L;;;;;N;;;;;
+1CF3;VEDIC SIGN ROTATED ARDHAVISARGA;Mc;0;L;;;;;N;;;;;
+1CF4;VEDIC TONE CANDRA ABOVE;Mn;230;NSM;;;;;N;;;;;
+1CF5;VEDIC SIGN JIHVAMULIYA;Lo;0;L;;;;;N;;;;;
+1CF6;VEDIC SIGN UPADHMANIYA;Lo;0;L;;;;;N;;;;;
1D00;LATIN LETTER SMALL CAPITAL A;Ll;0;L;;;;;N;;;;;
1D01;LATIN LETTER SMALL CAPITAL AE;Ll;0;L;;;;;N;;;;;
1D02;LATIN SMALL LETTER TURNED AE;Ll;0;L;;;;;N;;;;;
@@ -6319,15 +6389,15 @@
1D5F;MODIFIER LETTER SMALL DELTA;Lm;0;L;<super> 03B4;;;;N;;;;;
1D60;MODIFIER LETTER SMALL GREEK PHI;Lm;0;L;<super> 03C6;;;;N;;;;;
1D61;MODIFIER LETTER SMALL CHI;Lm;0;L;<super> 03C7;;;;N;;;;;
-1D62;LATIN SUBSCRIPT SMALL LETTER I;Ll;0;L;<sub> 0069;;;;N;;;;;
-1D63;LATIN SUBSCRIPT SMALL LETTER R;Ll;0;L;<sub> 0072;;;;N;;;;;
-1D64;LATIN SUBSCRIPT SMALL LETTER U;Ll;0;L;<sub> 0075;;;;N;;;;;
-1D65;LATIN SUBSCRIPT SMALL LETTER V;Ll;0;L;<sub> 0076;;;;N;;;;;
-1D66;GREEK SUBSCRIPT SMALL LETTER BETA;Ll;0;L;<sub> 03B2;;;;N;;;;;
-1D67;GREEK SUBSCRIPT SMALL LETTER GAMMA;Ll;0;L;<sub> 03B3;;;;N;;;;;
-1D68;GREEK SUBSCRIPT SMALL LETTER RHO;Ll;0;L;<sub> 03C1;;;;N;;;;;
-1D69;GREEK SUBSCRIPT SMALL LETTER PHI;Ll;0;L;<sub> 03C6;;;;N;;;;;
-1D6A;GREEK SUBSCRIPT SMALL LETTER CHI;Ll;0;L;<sub> 03C7;;;;N;;;;;
+1D62;LATIN SUBSCRIPT SMALL LETTER I;Lm;0;L;<sub> 0069;;;;N;;;;;
+1D63;LATIN SUBSCRIPT SMALL LETTER R;Lm;0;L;<sub> 0072;;;;N;;;;;
+1D64;LATIN SUBSCRIPT SMALL LETTER U;Lm;0;L;<sub> 0075;;;;N;;;;;
+1D65;LATIN SUBSCRIPT SMALL LETTER V;Lm;0;L;<sub> 0076;;;;N;;;;;
+1D66;GREEK SUBSCRIPT SMALL LETTER BETA;Lm;0;L;<sub> 03B2;;;;N;;;;;
+1D67;GREEK SUBSCRIPT SMALL LETTER GAMMA;Lm;0;L;<sub> 03B3;;;;N;;;;;
+1D68;GREEK SUBSCRIPT SMALL LETTER RHO;Lm;0;L;<sub> 03C1;;;;N;;;;;
+1D69;GREEK SUBSCRIPT SMALL LETTER PHI;Lm;0;L;<sub> 03C6;;;;N;;;;;
+1D6A;GREEK SUBSCRIPT SMALL LETTER CHI;Lm;0;L;<sub> 03C7;;;;N;;;;;
1D6B;LATIN SMALL LETTER UE;Ll;0;L;;;;;N;;;;;
1D6C;LATIN SMALL LETTER B WITH MIDDLE TILDE;Ll;0;L;;;;;N;;;;;
1D6D;LATIN SMALL LETTER D WITH MIDDLE TILDE;Ll;0;L;;;;;N;;;;;
@@ -7120,6 +7190,7 @@
20B7;SPESMILO SIGN;Sc;0;ET;;;;;N;;;;;
20B8;TENGE SIGN;Sc;0;ET;;;;;N;;;;;
20B9;INDIAN RUPEE SIGN;Sc;0;ET;;;;;N;;;;;
+20BA;TURKISH LIRA SIGN;Sc;0;ET;;;;;N;;;;;
20D0;COMBINING LEFT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING LEFT HARPOON ABOVE;;;;
20D1;COMBINING RIGHT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING RIGHT HARPOON ABOVE;;;;
20D2;COMBINING LONG VERTICAL LINE OVERLAY;Mn;1;NSM;;;;;N;NON-SPACING LONG VERTICAL BAR OVERLAY;;;;
@@ -8827,7 +8898,9 @@
27C8;REVERSE SOLIDUS PRECEDING SUBSET;Sm;0;ON;;;;;Y;;;;;
27C9;SUPERSET PRECEDING SOLIDUS;Sm;0;ON;;;;;Y;;;;;
27CA;VERTICAL BAR WITH HORIZONTAL STROKE;Sm;0;ON;;;;;N;;;;;
+27CB;MATHEMATICAL RISING DIAGONAL;Sm;0;ON;;;;;Y;;;;;
27CC;LONG DIVISION;Sm;0;ON;;;;;Y;;;;;
+27CD;MATHEMATICAL FALLING DIAGONAL;Sm;0;ON;;;;;Y;;;;;
27CE;SQUARED LOGICAL AND;Sm;0;ON;;;;;N;;;;;
27CF;SQUARED LOGICAL OR;Sm;0;ON;;;;;N;;;;;
27D0;WHITE DIAMOND WITH CENTRED DOT;Sm;0;ON;;;;;N;;;;;
@@ -9855,7 +9928,7 @@
2C79;LATIN SMALL LETTER TURNED R WITH TAIL;Ll;0;L;;;;;N;;;;;
2C7A;LATIN SMALL LETTER O WITH LOW RING INSIDE;Ll;0;L;;;;;N;;;;;
2C7B;LATIN LETTER SMALL CAPITAL TURNED E;Ll;0;L;;;;;N;;;;;
-2C7C;LATIN SUBSCRIPT SMALL LETTER J;Ll;0;L;<sub> 006A;;;;N;;;;;
+2C7C;LATIN SUBSCRIPT SMALL LETTER J;Lm;0;L;<sub> 006A;;;;N;;;;;
2C7D;MODIFIER LETTER CAPITAL V;Lm;0;L;<super> 0056;;;;N;;;;;
2C7E;LATIN CAPITAL LETTER S WITH SWASH TAIL;Lu;0;L;;;;;N;;;;023F;
2C7F;LATIN CAPITAL LETTER Z WITH SWASH TAIL;Lu;0;L;;;;;N;;;;0240;
@@ -9973,6 +10046,8 @@
2CEF;COPTIC COMBINING NI ABOVE;Mn;230;NSM;;;;;N;;;;;
2CF0;COPTIC COMBINING SPIRITUS ASPER;Mn;230;NSM;;;;;N;;;;;
2CF1;COPTIC COMBINING SPIRITUS LENIS;Mn;230;NSM;;;;;N;;;;;
+2CF2;COPTIC CAPITAL LETTER BOHAIRIC KHEI;Lu;0;L;;;;;N;;;;2CF3;
+2CF3;COPTIC SMALL LETTER BOHAIRIC KHEI;Ll;0;L;;;;;N;;;2CF2;;2CF2
2CF9;COPTIC OLD NUBIAN FULL STOP;Po;0;ON;;;;;N;;;;;
2CFA;COPTIC OLD NUBIAN DIRECT QUESTION MARK;Po;0;ON;;;;;N;;;;;
2CFB;COPTIC OLD NUBIAN INDIRECT QUESTION MARK;Po;0;ON;;;;;N;;;;;
@@ -10018,6 +10093,8 @@
2D23;GEORGIAN SMALL LETTER WE;Ll;0;L;;;;;N;;;10C3;;10C3
2D24;GEORGIAN SMALL LETTER HAR;Ll;0;L;;;;;N;;;10C4;;10C4
2D25;GEORGIAN SMALL LETTER HOE;Ll;0;L;;;;;N;;;10C5;;10C5
+2D27;GEORGIAN SMALL LETTER YN;Ll;0;L;;;;;N;;;10C7;;10C7
+2D2D;GEORGIAN SMALL LETTER AEN;Ll;0;L;;;;;N;;;10CD;;10CD
2D30;TIFINAGH LETTER YA;Lo;0;L;;;;;N;;;;;
2D31;TIFINAGH LETTER YAB;Lo;0;L;;;;;N;;;;;
2D32;TIFINAGH LETTER YABH;Lo;0;L;;;;;N;;;;;
@@ -10072,6 +10149,8 @@
2D63;TIFINAGH LETTER YAZ;Lo;0;L;;;;;N;;;;;
2D64;TIFINAGH LETTER TAWELLEMET YAZ;Lo;0;L;;;;;N;;;;;
2D65;TIFINAGH LETTER YAZZ;Lo;0;L;;;;;N;;;;;
+2D66;TIFINAGH LETTER YE;Lo;0;L;;;;;N;;;;;
+2D67;TIFINAGH LETTER YO;Lo;0;L;;;;;N;;;;;
2D6F;TIFINAGH MODIFIER LETTER LABIALIZATION MARK;Lm;0;L;<super> 2D61;;;;N;;;;;
2D70;TIFINAGH SEPARATOR MARK;Po;0;L;;;;;N;;;;;
2D7F;TIFINAGH CONSONANT JOINER;Mn;9;NSM;;;;;N;;;;;
@@ -10236,6 +10315,16 @@
2E2F;VERTICAL TILDE;Lm;0;ON;;;;;N;;;;;
2E30;RING POINT;Po;0;ON;;;;;N;;;;;
2E31;WORD SEPARATOR MIDDLE DOT;Po;0;ON;;;;;N;;;;;
+2E32;TURNED COMMA;Po;0;ON;;;;;N;;;;;
+2E33;RAISED DOT;Po;0;ON;;;;;N;;;;;
+2E34;RAISED COMMA;Po;0;ON;;;;;N;;;;;
+2E35;TURNED SEMICOLON;Po;0;ON;;;;;N;;;;;
+2E36;DAGGER WITH LEFT GUARD;Po;0;ON;;;;;N;;;;;
+2E37;DAGGER WITH RIGHT GUARD;Po;0;ON;;;;;N;;;;;
+2E38;TURNED DAGGER;Po;0;ON;;;;;N;;;;;
+2E39;TOP HALF SECTION SIGN;Po;0;ON;;;;;N;;;;;
+2E3A;TWO-EM DASH;Pd;0;ON;;;;;N;;;;;
+2E3B;THREE-EM DASH;Pd;0;ON;;;;;N;;;;;
2E80;CJK RADICAL REPEAT;So;0;ON;;;;;N;;;;;
2E81;CJK RADICAL CLIFF;So;0;ON;;;;;N;;;;;
2E82;CJK RADICAL SECOND ONE;So;0;ON;;;;;N;;;;;
@@ -10623,8 +10712,8 @@
302B;IDEOGRAPHIC RISING TONE MARK;Mn;228;NSM;;;;;N;;;;;
302C;IDEOGRAPHIC DEPARTING TONE MARK;Mn;232;NSM;;;;;N;;;;;
302D;IDEOGRAPHIC ENTERING TONE MARK;Mn;222;NSM;;;;;N;;;;;
-302E;HANGUL SINGLE DOT TONE MARK;Mn;224;NSM;;;;;N;;;;;
-302F;HANGUL DOUBLE DOT TONE MARK;Mn;224;NSM;;;;;N;;;;;
+302E;HANGUL SINGLE DOT TONE MARK;Mc;224;L;;;;;N;;;;;
+302F;HANGUL DOUBLE DOT TONE MARK;Mc;224;L;;;;;N;;;;;
3030;WAVY DASH;Pd;0;ON;;;;;N;;;;;
3031;VERTICAL KANA REPEAT MARK;Lm;0;L;;;;;N;;;;;
3032;VERTICAL KANA REPEAT WITH VOICED SOUND MARK;Lm;0;L;;;;;N;;;;;
@@ -11131,14 +11220,14 @@
3245;CIRCLED IDEOGRAPH KINDERGARTEN;So;0;L;<circle> 5E7C;;;;N;;;;;
3246;CIRCLED IDEOGRAPH SCHOOL;So;0;L;<circle> 6587;;;;N;;;;;
3247;CIRCLED IDEOGRAPH KOTO;So;0;L;<circle> 7B8F;;;;N;;;;;
-3248;CIRCLED NUMBER TEN ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-3249;CIRCLED NUMBER TWENTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-324A;CIRCLED NUMBER THIRTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-324B;CIRCLED NUMBER FORTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-324C;CIRCLED NUMBER FIFTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-324D;CIRCLED NUMBER SIXTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-324E;CIRCLED NUMBER SEVENTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-324F;CIRCLED NUMBER EIGHTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
+3248;CIRCLED NUMBER TEN ON BLACK SQUARE;No;0;L;;;;10;N;;;;;
+3249;CIRCLED NUMBER TWENTY ON BLACK SQUARE;No;0;L;;;;20;N;;;;;
+324A;CIRCLED NUMBER THIRTY ON BLACK SQUARE;No;0;L;;;;30;N;;;;;
+324B;CIRCLED NUMBER FORTY ON BLACK SQUARE;No;0;L;;;;40;N;;;;;
+324C;CIRCLED NUMBER FIFTY ON BLACK SQUARE;No;0;L;;;;50;N;;;;;
+324D;CIRCLED NUMBER SIXTY ON BLACK SQUARE;No;0;L;;;;60;N;;;;;
+324E;CIRCLED NUMBER SEVENTY ON BLACK SQUARE;No;0;L;;;;70;N;;;;;
+324F;CIRCLED NUMBER EIGHTY ON BLACK SQUARE;No;0;L;;;;80;N;;;;;
3250;PARTNERSHIP SIGN;So;0;ON;<square> 0050 0054 0045;;;;N;;;;;
3251;CIRCLED NUMBER TWENTY ONE;No;0;ON;<circle> 0032 0031;;;21;N;;;;;
3252;CIRCLED NUMBER TWENTY TWO;No;0;ON;<circle> 0032 0032;;;22;N;;;;;
@@ -11637,7 +11726,7 @@
4DFE;HEXAGRAM FOR AFTER COMPLETION;So;0;ON;;;;;N;;;;;
4DFF;HEXAGRAM FOR BEFORE COMPLETION;So;0;ON;;;;;N;;;;;
4E00;<CJK Ideograph, First>;Lo;0;L;;;;;N;;;;;
-9FCB;<CJK Ideograph, Last>;Lo;0;L;;;;;N;;;;;
+9FCC;<CJK Ideograph, Last>;Lo;0;L;;;;;N;;;;;
A000;YI SYLLABLE IT;Lo;0;L;;;;;N;;;;;
A001;YI SYLLABLE IX;Lo;0;L;;;;;N;;;;;
A002;YI SYLLABLE I;Lo;0;L;;;;;N;;;;;
@@ -13258,6 +13347,14 @@ A670;COMBINING CYRILLIC TEN MILLIONS SIGN;Me;0;NSM;;;;;N;;;;;
A671;COMBINING CYRILLIC HUNDRED MILLIONS SIGN;Me;0;NSM;;;;;N;;;;;
A672;COMBINING CYRILLIC THOUSAND MILLIONS SIGN;Me;0;NSM;;;;;N;;;;;
A673;SLAVONIC ASTERISK;Po;0;ON;;;;;N;;;;;
+A674;COMBINING CYRILLIC LETTER UKRAINIAN IE;Mn;230;NSM;;;;;N;;;;;
+A675;COMBINING CYRILLIC LETTER I;Mn;230;NSM;;;;;N;;;;;
+A676;COMBINING CYRILLIC LETTER YI;Mn;230;NSM;;;;;N;;;;;
+A677;COMBINING CYRILLIC LETTER U;Mn;230;NSM;;;;;N;;;;;
+A678;COMBINING CYRILLIC LETTER HARD SIGN;Mn;230;NSM;;;;;N;;;;;
+A679;COMBINING CYRILLIC LETTER YERU;Mn;230;NSM;;;;;N;;;;;
+A67A;COMBINING CYRILLIC LETTER SOFT SIGN;Mn;230;NSM;;;;;N;;;;;
+A67B;COMBINING CYRILLIC LETTER OMEGA;Mn;230;NSM;;;;;N;;;;;
A67C;COMBINING CYRILLIC KAVYKA;Mn;230;NSM;;;;;N;;;;;
A67D;COMBINING CYRILLIC PAYEROK;Mn;230;NSM;;;;;N;;;;;
A67E;CYRILLIC KAVYKA;Po;0;ON;;;;;N;;;;;
@@ -13286,6 +13383,7 @@ A694;CYRILLIC CAPITAL LETTER HWE;Lu;0;L;;;;;N;;;;A695;
A695;CYRILLIC SMALL LETTER HWE;Ll;0;L;;;;;N;;;A694;;A694
A696;CYRILLIC CAPITAL LETTER SHWE;Lu;0;L;;;;;N;;;;A697;
A697;CYRILLIC SMALL LETTER SHWE;Ll;0;L;;;;;N;;;A696;;A696
+A69F;COMBINING CYRILLIC LETTER IOTIFIED E;Mn;230;NSM;;;;;N;;;;;
A6A0;BAMUM LETTER A;Lo;0;L;;;;;N;;;;;
A6A1;BAMUM LETTER KA;Lo;0;L;;;;;N;;;;;
A6A2;BAMUM LETTER U;Lo;0;L;;;;;N;;;;;
@@ -13519,6 +13617,8 @@ A78D;LATIN CAPITAL LETTER TURNED H;Lu;0;L;;;;;N;;;;0265;
A78E;LATIN SMALL LETTER L WITH RETROFLEX HOOK AND BELT;Ll;0;L;;;;;N;;;;;
A790;LATIN CAPITAL LETTER N WITH DESCENDER;Lu;0;L;;;;;N;;;;A791;
A791;LATIN SMALL LETTER N WITH DESCENDER;Ll;0;L;;;;;N;;;A790;;A790
+A792;LATIN CAPITAL LETTER C WITH BAR;Lu;0;L;;;;;N;;;;A793;
+A793;LATIN SMALL LETTER C WITH BAR;Ll;0;L;;;;;N;;;A792;;A792
A7A0;LATIN CAPITAL LETTER G WITH OBLIQUE STROKE;Lu;0;L;;;;;N;;;;A7A1;
A7A1;LATIN SMALL LETTER G WITH OBLIQUE STROKE;Ll;0;L;;;;;N;;;A7A0;;A7A0
A7A2;LATIN CAPITAL LETTER K WITH OBLIQUE STROKE;Lu;0;L;;;;;N;;;;A7A3;
@@ -13529,6 +13629,9 @@ A7A6;LATIN CAPITAL LETTER R WITH OBLIQUE STROKE;Lu;0;L;;;;;N;;;;A7A7;
A7A7;LATIN SMALL LETTER R WITH OBLIQUE STROKE;Ll;0;L;;;;;N;;;A7A6;;A7A6
A7A8;LATIN CAPITAL LETTER S WITH OBLIQUE STROKE;Lu;0;L;;;;;N;;;;A7A9;
A7A9;LATIN SMALL LETTER S WITH OBLIQUE STROKE;Ll;0;L;;;;;N;;;A7A8;;A7A8
+A7AA;LATIN CAPITAL LETTER H WITH HOOK;Lu;0;L;;;;;N;;;;0266;
+A7F8;MODIFIER LETTER CAPITAL H WITH STROKE;Lm;0;L;<super> 0126;;;;N;;;;;
+A7F9;MODIFIER LETTER SMALL LIGATURE OE;Lm;0;L;<super> 0153;;;;N;;;;;
A7FA;LATIN LETTER SMALL CAPITAL TURNED M;Ll;0;L;;;;;N;;;;;
A7FB;LATIN EPIGRAPHIC LETTER REVERSED F;Lo;0;L;;;;;N;;;;;
A7FC;LATIN EPIGRAPHIC LETTER REVERSED P;Lo;0;L;;;;;N;;;;;
@@ -14142,6 +14245,29 @@ AADC;TAI VIET SYMBOL NUENG;Lo;0;L;;;;;N;;;;;
AADD;TAI VIET SYMBOL SAM;Lm;0;L;;;;;N;;;;;
AADE;TAI VIET SYMBOL HO HOI;Po;0;L;;;;;N;;;;;
AADF;TAI VIET SYMBOL KOI KOI;Po;0;L;;;;;N;;;;;
+AAE0;MEETEI MAYEK LETTER E;Lo;0;L;;;;;N;;;;;
+AAE1;MEETEI MAYEK LETTER O;Lo;0;L;;;;;N;;;;;
+AAE2;MEETEI MAYEK LETTER CHA;Lo;0;L;;;;;N;;;;;
+AAE3;MEETEI MAYEK LETTER NYA;Lo;0;L;;;;;N;;;;;
+AAE4;MEETEI MAYEK LETTER TTA;Lo;0;L;;;;;N;;;;;
+AAE5;MEETEI MAYEK LETTER TTHA;Lo;0;L;;;;;N;;;;;
+AAE6;MEETEI MAYEK LETTER DDA;Lo;0;L;;;;;N;;;;;
+AAE7;MEETEI MAYEK LETTER DDHA;Lo;0;L;;;;;N;;;;;
+AAE8;MEETEI MAYEK LETTER NNA;Lo;0;L;;;;;N;;;;;
+AAE9;MEETEI MAYEK LETTER SHA;Lo;0;L;;;;;N;;;;;
+AAEA;MEETEI MAYEK LETTER SSA;Lo;0;L;;;;;N;;;;;
+AAEB;MEETEI MAYEK VOWEL SIGN II;Mc;0;L;;;;;N;;;;;
+AAEC;MEETEI MAYEK VOWEL SIGN UU;Mn;0;NSM;;;;;N;;;;;
+AAED;MEETEI MAYEK VOWEL SIGN AAI;Mn;0;NSM;;;;;N;;;;;
+AAEE;MEETEI MAYEK VOWEL SIGN AU;Mc;0;L;;;;;N;;;;;
+AAEF;MEETEI MAYEK VOWEL SIGN AAU;Mc;0;L;;;;;N;;;;;
+AAF0;MEETEI MAYEK CHEIKHAN;Po;0;L;;;;;N;;;;;
+AAF1;MEETEI MAYEK AHANG KHUDAM;Po;0;L;;;;;N;;;;;
+AAF2;MEETEI MAYEK ANJI;Lo;0;L;;;;;N;;;;;
+AAF3;MEETEI MAYEK SYLLABLE REPETITION MARK;Lm;0;L;;;;;N;;;;;
+AAF4;MEETEI MAYEK WORD REPETITION MARK;Lm;0;L;;;;;N;;;;;
+AAF5;MEETEI MAYEK VOWEL SIGN VISARGA;Mc;0;L;;;;;N;;;;;
+AAF6;MEETEI MAYEK VIRAMA;Mn;9;NSM;;;;;N;;;;;
AB01;ETHIOPIC SYLLABLE TTHU;Lo;0;L;;;;;N;;;;;
AB02;ETHIOPIC SYLLABLE TTHI;Lo;0;L;;;;;N;;;;;
AB03;ETHIOPIC SYLLABLE TTHAA;Lo;0;L;;;;;N;;;;;
@@ -14614,6 +14740,8 @@ FA2A;CJK COMPATIBILITY IDEOGRAPH-FA2A;Lo;0;L;98EF;;;;N;;;;;
FA2B;CJK COMPATIBILITY IDEOGRAPH-FA2B;Lo;0;L;98FC;;;;N;;;;;
FA2C;CJK COMPATIBILITY IDEOGRAPH-FA2C;Lo;0;L;9928;;;;N;;;;;
FA2D;CJK COMPATIBILITY IDEOGRAPH-FA2D;Lo;0;L;9DB4;;;;N;;;;;
+FA2E;CJK COMPATIBILITY IDEOGRAPH-FA2E;Lo;0;L;90DE;;;;N;;;;;
+FA2F;CJK COMPATIBILITY IDEOGRAPH-FA2F;Lo;0;L;96B7;;;;N;;;;;
FA30;CJK COMPATIBILITY IDEOGRAPH-FA30;Lo;0;L;4FAE;;;;N;;;;;
FA31;CJK COMPATIBILITY IDEOGRAPH-FA31;Lo;0;L;50E7;;;;N;;;;;
FA32;CJK COMPATIBILITY IDEOGRAPH-FA32;Lo;0;L;514D;;;;N;;;;;
@@ -16126,7 +16254,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
100FA;LINEAR B IDEOGRAM VESSEL B305;Lo;0;L;;;;;N;;;;;
10100;AEGEAN WORD SEPARATOR LINE;Po;0;L;;;;;N;;;;;
10101;AEGEAN WORD SEPARATOR DOT;Po;0;ON;;;;;N;;;;;
-10102;AEGEAN CHECK MARK;So;0;L;;;;;N;;;;;
+10102;AEGEAN CHECK MARK;Po;0;L;;;;;N;;;;;
10107;AEGEAN NUMBER ONE;No;0;L;;;;1;N;;;;;
10108;AEGEAN NUMBER TWO;No;0;L;;;;2;N;;;;;
10109;AEGEAN NUMBER THREE;No;0;L;;;;3;N;;;;;
@@ -16845,6 +16973,64 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
10938;LYDIAN LETTER NN;Lo;0;R;;;;;N;;;;;
10939;LYDIAN LETTER C;Lo;0;R;;;;;N;;;;;
1093F;LYDIAN TRIANGULAR MARK;Po;0;R;;;;;N;;;;;
+10980;MEROITIC HIEROGLYPHIC LETTER A;Lo;0;R;;;;;N;;;;;
+10981;MEROITIC HIEROGLYPHIC LETTER E;Lo;0;R;;;;;N;;;;;
+10982;MEROITIC HIEROGLYPHIC LETTER I;Lo;0;R;;;;;N;;;;;
+10983;MEROITIC HIEROGLYPHIC LETTER O;Lo;0;R;;;;;N;;;;;
+10984;MEROITIC HIEROGLYPHIC LETTER YA;Lo;0;R;;;;;N;;;;;
+10985;MEROITIC HIEROGLYPHIC LETTER WA;Lo;0;R;;;;;N;;;;;
+10986;MEROITIC HIEROGLYPHIC LETTER BA;Lo;0;R;;;;;N;;;;;
+10987;MEROITIC HIEROGLYPHIC LETTER BA-2;Lo;0;R;;;;;N;;;;;
+10988;MEROITIC HIEROGLYPHIC LETTER PA;Lo;0;R;;;;;N;;;;;
+10989;MEROITIC HIEROGLYPHIC LETTER MA;Lo;0;R;;;;;N;;;;;
+1098A;MEROITIC HIEROGLYPHIC LETTER NA;Lo;0;R;;;;;N;;;;;
+1098B;MEROITIC HIEROGLYPHIC LETTER NA-2;Lo;0;R;;;;;N;;;;;
+1098C;MEROITIC HIEROGLYPHIC LETTER NE;Lo;0;R;;;;;N;;;;;
+1098D;MEROITIC HIEROGLYPHIC LETTER NE-2;Lo;0;R;;;;;N;;;;;
+1098E;MEROITIC HIEROGLYPHIC LETTER RA;Lo;0;R;;;;;N;;;;;
+1098F;MEROITIC HIEROGLYPHIC LETTER RA-2;Lo;0;R;;;;;N;;;;;
+10990;MEROITIC HIEROGLYPHIC LETTER LA;Lo;0;R;;;;;N;;;;;
+10991;MEROITIC HIEROGLYPHIC LETTER KHA;Lo;0;R;;;;;N;;;;;
+10992;MEROITIC HIEROGLYPHIC LETTER HHA;Lo;0;R;;;;;N;;;;;
+10993;MEROITIC HIEROGLYPHIC LETTER SA;Lo;0;R;;;;;N;;;;;
+10994;MEROITIC HIEROGLYPHIC LETTER SA-2;Lo;0;R;;;;;N;;;;;
+10995;MEROITIC HIEROGLYPHIC LETTER SE;Lo;0;R;;;;;N;;;;;
+10996;MEROITIC HIEROGLYPHIC LETTER KA;Lo;0;R;;;;;N;;;;;
+10997;MEROITIC HIEROGLYPHIC LETTER QA;Lo;0;R;;;;;N;;;;;
+10998;MEROITIC HIEROGLYPHIC LETTER TA;Lo;0;R;;;;;N;;;;;
+10999;MEROITIC HIEROGLYPHIC LETTER TA-2;Lo;0;R;;;;;N;;;;;
+1099A;MEROITIC HIEROGLYPHIC LETTER TE;Lo;0;R;;;;;N;;;;;
+1099B;MEROITIC HIEROGLYPHIC LETTER TE-2;Lo;0;R;;;;;N;;;;;
+1099C;MEROITIC HIEROGLYPHIC LETTER TO;Lo;0;R;;;;;N;;;;;
+1099D;MEROITIC HIEROGLYPHIC LETTER DA;Lo;0;R;;;;;N;;;;;
+1099E;MEROITIC HIEROGLYPHIC SYMBOL VIDJ;Lo;0;R;;;;;N;;;;;
+1099F;MEROITIC HIEROGLYPHIC SYMBOL VIDJ-2;Lo;0;R;;;;;N;;;;;
+109A0;MEROITIC CURSIVE LETTER A;Lo;0;R;;;;;N;;;;;
+109A1;MEROITIC CURSIVE LETTER E;Lo;0;R;;;;;N;;;;;
+109A2;MEROITIC CURSIVE LETTER I;Lo;0;R;;;;;N;;;;;
+109A3;MEROITIC CURSIVE LETTER O;Lo;0;R;;;;;N;;;;;
+109A4;MEROITIC CURSIVE LETTER YA;Lo;0;R;;;;;N;;;;;
+109A5;MEROITIC CURSIVE LETTER WA;Lo;0;R;;;;;N;;;;;
+109A6;MEROITIC CURSIVE LETTER BA;Lo;0;R;;;;;N;;;;;
+109A7;MEROITIC CURSIVE LETTER PA;Lo;0;R;;;;;N;;;;;
+109A8;MEROITIC CURSIVE LETTER MA;Lo;0;R;;;;;N;;;;;
+109A9;MEROITIC CURSIVE LETTER NA;Lo;0;R;;;;;N;;;;;
+109AA;MEROITIC CURSIVE LETTER NE;Lo;0;R;;;;;N;;;;;
+109AB;MEROITIC CURSIVE LETTER RA;Lo;0;R;;;;;N;;;;;
+109AC;MEROITIC CURSIVE LETTER LA;Lo;0;R;;;;;N;;;;;
+109AD;MEROITIC CURSIVE LETTER KHA;Lo;0;R;;;;;N;;;;;
+109AE;MEROITIC CURSIVE LETTER HHA;Lo;0;R;;;;;N;;;;;
+109AF;MEROITIC CURSIVE LETTER SA;Lo;0;R;;;;;N;;;;;
+109B0;MEROITIC CURSIVE LETTER ARCHAIC SA;Lo;0;R;;;;;N;;;;;
+109B1;MEROITIC CURSIVE LETTER SE;Lo;0;R;;;;;N;;;;;
+109B2;MEROITIC CURSIVE LETTER KA;Lo;0;R;;;;;N;;;;;
+109B3;MEROITIC CURSIVE LETTER QA;Lo;0;R;;;;;N;;;;;
+109B4;MEROITIC CURSIVE LETTER TA;Lo;0;R;;;;;N;;;;;
+109B5;MEROITIC CURSIVE LETTER TE;Lo;0;R;;;;;N;;;;;
+109B6;MEROITIC CURSIVE LETTER TO;Lo;0;R;;;;;N;;;;;
+109B7;MEROITIC CURSIVE LETTER DA;Lo;0;R;;;;;N;;;;;
+109BE;MEROITIC CURSIVE LOGOGRAM RMT;Lo;0;R;;;;;N;;;;;
+109BF;MEROITIC CURSIVE LOGOGRAM IMN;Lo;0;R;;;;;N;;;;;
10A00;KHAROSHTHI LETTER A;Lo;0;R;;;;;N;;;;;
10A01;KHAROSHTHI VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;;
10A02;KHAROSHTHI VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
@@ -17338,6 +17524,257 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
110BF;KAITHI DOUBLE SECTION MARK;Po;0;L;;;;;N;;;;;
110C0;KAITHI DANDA;Po;0;L;;;;;N;;;;;
110C1;KAITHI DOUBLE DANDA;Po;0;L;;;;;N;;;;;
+110D0;SORA SOMPENG LETTER SAH;Lo;0;L;;;;;N;;;;;
+110D1;SORA SOMPENG LETTER TAH;Lo;0;L;;;;;N;;;;;
+110D2;SORA SOMPENG LETTER BAH;Lo;0;L;;;;;N;;;;;
+110D3;SORA SOMPENG LETTER CAH;Lo;0;L;;;;;N;;;;;
+110D4;SORA SOMPENG LETTER DAH;Lo;0;L;;;;;N;;;;;
+110D5;SORA SOMPENG LETTER GAH;Lo;0;L;;;;;N;;;;;
+110D6;SORA SOMPENG LETTER MAH;Lo;0;L;;;;;N;;;;;
+110D7;SORA SOMPENG LETTER NGAH;Lo;0;L;;;;;N;;;;;
+110D8;SORA SOMPENG LETTER LAH;Lo;0;L;;;;;N;;;;;
+110D9;SORA SOMPENG LETTER NAH;Lo;0;L;;;;;N;;;;;
+110DA;SORA SOMPENG LETTER VAH;Lo;0;L;;;;;N;;;;;
+110DB;SORA SOMPENG LETTER PAH;Lo;0;L;;;;;N;;;;;
+110DC;SORA SOMPENG LETTER YAH;Lo;0;L;;;;;N;;;;;
+110DD;SORA SOMPENG LETTER RAH;Lo;0;L;;;;;N;;;;;
+110DE;SORA SOMPENG LETTER HAH;Lo;0;L;;;;;N;;;;;
+110DF;SORA SOMPENG LETTER KAH;Lo;0;L;;;;;N;;;;;
+110E0;SORA SOMPENG LETTER JAH;Lo;0;L;;;;;N;;;;;
+110E1;SORA SOMPENG LETTER NYAH;Lo;0;L;;;;;N;;;;;
+110E2;SORA SOMPENG LETTER AH;Lo;0;L;;;;;N;;;;;
+110E3;SORA SOMPENG LETTER EEH;Lo;0;L;;;;;N;;;;;
+110E4;SORA SOMPENG LETTER IH;Lo;0;L;;;;;N;;;;;
+110E5;SORA SOMPENG LETTER UH;Lo;0;L;;;;;N;;;;;
+110E6;SORA SOMPENG LETTER OH;Lo;0;L;;;;;N;;;;;
+110E7;SORA SOMPENG LETTER EH;Lo;0;L;;;;;N;;;;;
+110E8;SORA SOMPENG LETTER MAE;Lo;0;L;;;;;N;;;;;
+110F0;SORA SOMPENG DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
+110F1;SORA SOMPENG DIGIT ONE;Nd;0;L;;1;1;1;N;;;;;
+110F2;SORA SOMPENG DIGIT TWO;Nd;0;L;;2;2;2;N;;;;;
+110F3;SORA SOMPENG DIGIT THREE;Nd;0;L;;3;3;3;N;;;;;
+110F4;SORA SOMPENG DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;;
+110F5;SORA SOMPENG DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;;
+110F6;SORA SOMPENG DIGIT SIX;Nd;0;L;;6;6;6;N;;;;;
+110F7;SORA SOMPENG DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
+110F8;SORA SOMPENG DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
+110F9;SORA SOMPENG DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
+11100;CHAKMA SIGN CANDRABINDU;Mn;230;NSM;;;;;N;;;;;
+11101;CHAKMA SIGN ANUSVARA;Mn;230;NSM;;;;;N;;;;;
+11102;CHAKMA SIGN VISARGA;Mn;230;NSM;;;;;N;;;;;
+11103;CHAKMA LETTER AA;Lo;0;L;;;;;N;;;;;
+11104;CHAKMA LETTER I;Lo;0;L;;;;;N;;;;;
+11105;CHAKMA LETTER U;Lo;0;L;;;;;N;;;;;
+11106;CHAKMA LETTER E;Lo;0;L;;;;;N;;;;;
+11107;CHAKMA LETTER KAA;Lo;0;L;;;;;N;;;;;
+11108;CHAKMA LETTER KHAA;Lo;0;L;;;;;N;;;;;
+11109;CHAKMA LETTER GAA;Lo;0;L;;;;;N;;;;;
+1110A;CHAKMA LETTER GHAA;Lo;0;L;;;;;N;;;;;
+1110B;CHAKMA LETTER NGAA;Lo;0;L;;;;;N;;;;;
+1110C;CHAKMA LETTER CAA;Lo;0;L;;;;;N;;;;;
+1110D;CHAKMA LETTER CHAA;Lo;0;L;;;;;N;;;;;
+1110E;CHAKMA LETTER JAA;Lo;0;L;;;;;N;;;;;
+1110F;CHAKMA LETTER JHAA;Lo;0;L;;;;;N;;;;;
+11110;CHAKMA LETTER NYAA;Lo;0;L;;;;;N;;;;;
+11111;CHAKMA LETTER TTAA;Lo;0;L;;;;;N;;;;;
+11112;CHAKMA LETTER TTHAA;Lo;0;L;;;;;N;;;;;
+11113;CHAKMA LETTER DDAA;Lo;0;L;;;;;N;;;;;
+11114;CHAKMA LETTER DDHAA;Lo;0;L;;;;;N;;;;;
+11115;CHAKMA LETTER NNAA;Lo;0;L;;;;;N;;;;;
+11116;CHAKMA LETTER TAA;Lo;0;L;;;;;N;;;;;
+11117;CHAKMA LETTER THAA;Lo;0;L;;;;;N;;;;;
+11118;CHAKMA LETTER DAA;Lo;0;L;;;;;N;;;;;
+11119;CHAKMA LETTER DHAA;Lo;0;L;;;;;N;;;;;
+1111A;CHAKMA LETTER NAA;Lo;0;L;;;;;N;;;;;
+1111B;CHAKMA LETTER PAA;Lo;0;L;;;;;N;;;;;
+1111C;CHAKMA LETTER PHAA;Lo;0;L;;;;;N;;;;;
+1111D;CHAKMA LETTER BAA;Lo;0;L;;;;;N;;;;;
+1111E;CHAKMA LETTER BHAA;Lo;0;L;;;;;N;;;;;
+1111F;CHAKMA LETTER MAA;Lo;0;L;;;;;N;;;;;
+11120;CHAKMA LETTER YYAA;Lo;0;L;;;;;N;;;;;
+11121;CHAKMA LETTER YAA;Lo;0;L;;;;;N;;;;;
+11122;CHAKMA LETTER RAA;Lo;0;L;;;;;N;;;;;
+11123;CHAKMA LETTER LAA;Lo;0;L;;;;;N;;;;;
+11124;CHAKMA LETTER WAA;Lo;0;L;;;;;N;;;;;
+11125;CHAKMA LETTER SAA;Lo;0;L;;;;;N;;;;;
+11126;CHAKMA LETTER HAA;Lo;0;L;;;;;N;;;;;
+11127;CHAKMA VOWEL SIGN A;Mn;0;NSM;;;;;N;;;;;
+11128;CHAKMA VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;;
+11129;CHAKMA VOWEL SIGN II;Mn;0;NSM;;;;;N;;;;;
+1112A;CHAKMA VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
+1112B;CHAKMA VOWEL SIGN UU;Mn;0;NSM;;;;;N;;;;;
+1112C;CHAKMA VOWEL SIGN E;Mc;0;L;;;;;N;;;;;
+1112D;CHAKMA VOWEL SIGN AI;Mn;0;NSM;;;;;N;;;;;
+1112E;CHAKMA VOWEL SIGN O;Mn;0;NSM;11131 11127;;;;N;;;;;
+1112F;CHAKMA VOWEL SIGN AU;Mn;0;NSM;11132 11127;;;;N;;;;;
+11130;CHAKMA VOWEL SIGN OI;Mn;0;NSM;;;;;N;;;;;
+11131;CHAKMA O MARK;Mn;0;NSM;;;;;N;;;;;
+11132;CHAKMA AU MARK;Mn;0;NSM;;;;;N;;;;;
+11133;CHAKMA VIRAMA;Mn;9;NSM;;;;;N;;;;;
+11134;CHAKMA MAAYYAA;Mn;9;NSM;;;;;N;;;;;
+11136;CHAKMA DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
+11137;CHAKMA DIGIT ONE;Nd;0;L;;1;1;1;N;;;;;
+11138;CHAKMA DIGIT TWO;Nd;0;L;;2;2;2;N;;;;;
+11139;CHAKMA DIGIT THREE;Nd;0;L;;3;3;3;N;;;;;
+1113A;CHAKMA DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;;
+1113B;CHAKMA DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;;
+1113C;CHAKMA DIGIT SIX;Nd;0;L;;6;6;6;N;;;;;
+1113D;CHAKMA DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
+1113E;CHAKMA DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
+1113F;CHAKMA DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
+11140;CHAKMA SECTION MARK;Po;0;L;;;;;N;;;;;
+11141;CHAKMA DANDA;Po;0;L;;;;;N;;;;;
+11142;CHAKMA DOUBLE DANDA;Po;0;L;;;;;N;;;;;
+11143;CHAKMA QUESTION MARK;Po;0;L;;;;;N;;;;;
+11180;SHARADA SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
+11181;SHARADA SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
+11182;SHARADA SIGN VISARGA;Mc;0;L;;;;;N;;;;;
+11183;SHARADA LETTER A;Lo;0;L;;;;;N;;;;;
+11184;SHARADA LETTER AA;Lo;0;L;;;;;N;;;;;
+11185;SHARADA LETTER I;Lo;0;L;;;;;N;;;;;
+11186;SHARADA LETTER II;Lo;0;L;;;;;N;;;;;
+11187;SHARADA LETTER U;Lo;0;L;;;;;N;;;;;
+11188;SHARADA LETTER UU;Lo;0;L;;;;;N;;;;;
+11189;SHARADA LETTER VOCALIC R;Lo;0;L;;;;;N;;;;;
+1118A;SHARADA LETTER VOCALIC RR;Lo;0;L;;;;;N;;;;;
+1118B;SHARADA LETTER VOCALIC L;Lo;0;L;;;;;N;;;;;
+1118C;SHARADA LETTER VOCALIC LL;Lo;0;L;;;;;N;;;;;
+1118D;SHARADA LETTER E;Lo;0;L;;;;;N;;;;;
+1118E;SHARADA LETTER AI;Lo;0;L;;;;;N;;;;;
+1118F;SHARADA LETTER O;Lo;0;L;;;;;N;;;;;
+11190;SHARADA LETTER AU;Lo;0;L;;;;;N;;;;;
+11191;SHARADA LETTER KA;Lo;0;L;;;;;N;;;;;
+11192;SHARADA LETTER KHA;Lo;0;L;;;;;N;;;;;
+11193;SHARADA LETTER GA;Lo;0;L;;;;;N;;;;;
+11194;SHARADA LETTER GHA;Lo;0;L;;;;;N;;;;;
+11195;SHARADA LETTER NGA;Lo;0;L;;;;;N;;;;;
+11196;SHARADA LETTER CA;Lo;0;L;;;;;N;;;;;
+11197;SHARADA LETTER CHA;Lo;0;L;;;;;N;;;;;
+11198;SHARADA LETTER JA;Lo;0;L;;;;;N;;;;;
+11199;SHARADA LETTER JHA;Lo;0;L;;;;;N;;;;;
+1119A;SHARADA LETTER NYA;Lo;0;L;;;;;N;;;;;
+1119B;SHARADA LETTER TTA;Lo;0;L;;;;;N;;;;;
+1119C;SHARADA LETTER TTHA;Lo;0;L;;;;;N;;;;;
+1119D;SHARADA LETTER DDA;Lo;0;L;;;;;N;;;;;
+1119E;SHARADA LETTER DDHA;Lo;0;L;;;;;N;;;;;
+1119F;SHARADA LETTER NNA;Lo;0;L;;;;;N;;;;;
+111A0;SHARADA LETTER TA;Lo;0;L;;;;;N;;;;;
+111A1;SHARADA LETTER THA;Lo;0;L;;;;;N;;;;;
+111A2;SHARADA LETTER DA;Lo;0;L;;;;;N;;;;;
+111A3;SHARADA LETTER DHA;Lo;0;L;;;;;N;;;;;
+111A4;SHARADA LETTER NA;Lo;0;L;;;;;N;;;;;
+111A5;SHARADA LETTER PA;Lo;0;L;;;;;N;;;;;
+111A6;SHARADA LETTER PHA;Lo;0;L;;;;;N;;;;;
+111A7;SHARADA LETTER BA;Lo;0;L;;;;;N;;;;;
+111A8;SHARADA LETTER BHA;Lo;0;L;;;;;N;;;;;
+111A9;SHARADA LETTER MA;Lo;0;L;;;;;N;;;;;
+111AA;SHARADA LETTER YA;Lo;0;L;;;;;N;;;;;
+111AB;SHARADA LETTER RA;Lo;0;L;;;;;N;;;;;
+111AC;SHARADA LETTER LA;Lo;0;L;;;;;N;;;;;
+111AD;SHARADA LETTER LLA;Lo;0;L;;;;;N;;;;;
+111AE;SHARADA LETTER VA;Lo;0;L;;;;;N;;;;;
+111AF;SHARADA LETTER SHA;Lo;0;L;;;;;N;;;;;
+111B0;SHARADA LETTER SSA;Lo;0;L;;;;;N;;;;;
+111B1;SHARADA LETTER SA;Lo;0;L;;;;;N;;;;;
+111B2;SHARADA LETTER HA;Lo;0;L;;;;;N;;;;;
+111B3;SHARADA VOWEL SIGN AA;Mc;0;L;;;;;N;;;;;
+111B4;SHARADA VOWEL SIGN I;Mc;0;L;;;;;N;;;;;
+111B5;SHARADA VOWEL SIGN II;Mc;0;L;;;;;N;;;;;
+111B6;SHARADA VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
+111B7;SHARADA VOWEL SIGN UU;Mn;0;NSM;;;;;N;;;;;
+111B8;SHARADA VOWEL SIGN VOCALIC R;Mn;0;NSM;;;;;N;;;;;
+111B9;SHARADA VOWEL SIGN VOCALIC RR;Mn;0;NSM;;;;;N;;;;;
+111BA;SHARADA VOWEL SIGN VOCALIC L;Mn;0;NSM;;;;;N;;;;;
+111BB;SHARADA VOWEL SIGN VOCALIC LL;Mn;0;NSM;;;;;N;;;;;
+111BC;SHARADA VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;;
+111BD;SHARADA VOWEL SIGN AI;Mn;0;NSM;;;;;N;;;;;
+111BE;SHARADA VOWEL SIGN O;Mn;0;NSM;;;;;N;;;;;
+111BF;SHARADA VOWEL SIGN AU;Mc;0;L;;;;;N;;;;;
+111C0;SHARADA SIGN VIRAMA;Mc;9;L;;;;;N;;;;;
+111C1;SHARADA SIGN AVAGRAHA;Lo;0;L;;;;;N;;;;;
+111C2;SHARADA SIGN JIHVAMULIYA;Lo;0;L;;;;;N;;;;;
+111C3;SHARADA SIGN UPADHMANIYA;Lo;0;L;;;;;N;;;;;
+111C4;SHARADA OM;Lo;0;L;;;;;N;;;;;
+111C5;SHARADA DANDA;Po;0;L;;;;;N;;;;;
+111C6;SHARADA DOUBLE DANDA;Po;0;L;;;;;N;;;;;
+111C7;SHARADA ABBREVIATION SIGN;Po;0;L;;;;;N;;;;;
+111C8;SHARADA SEPARATOR;Po;0;L;;;;;N;;;;;
+111D0;SHARADA DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
+111D1;SHARADA DIGIT ONE;Nd;0;L;;1;1;1;N;;;;;
+111D2;SHARADA DIGIT TWO;Nd;0;L;;2;2;2;N;;;;;
+111D3;SHARADA DIGIT THREE;Nd;0;L;;3;3;3;N;;;;;
+111D4;SHARADA DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;;
+111D5;SHARADA DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;;
+111D6;SHARADA DIGIT SIX;Nd;0;L;;6;6;6;N;;;;;
+111D7;SHARADA DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
+111D8;SHARADA DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
+111D9;SHARADA DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
+11680;TAKRI LETTER A;Lo;0;L;;;;;N;;;;;
+11681;TAKRI LETTER AA;Lo;0;L;;;;;N;;;;;
+11682;TAKRI LETTER I;Lo;0;L;;;;;N;;;;;
+11683;TAKRI LETTER II;Lo;0;L;;;;;N;;;;;
+11684;TAKRI LETTER U;Lo;0;L;;;;;N;;;;;
+11685;TAKRI LETTER UU;Lo;0;L;;;;;N;;;;;
+11686;TAKRI LETTER E;Lo;0;L;;;;;N;;;;;
+11687;TAKRI LETTER AI;Lo;0;L;;;;;N;;;;;
+11688;TAKRI LETTER O;Lo;0;L;;;;;N;;;;;
+11689;TAKRI LETTER AU;Lo;0;L;;;;;N;;;;;
+1168A;TAKRI LETTER KA;Lo;0;L;;;;;N;;;;;
+1168B;TAKRI LETTER KHA;Lo;0;L;;;;;N;;;;;
+1168C;TAKRI LETTER GA;Lo;0;L;;;;;N;;;;;
+1168D;TAKRI LETTER GHA;Lo;0;L;;;;;N;;;;;
+1168E;TAKRI LETTER NGA;Lo;0;L;;;;;N;;;;;
+1168F;TAKRI LETTER CA;Lo;0;L;;;;;N;;;;;
+11690;TAKRI LETTER CHA;Lo;0;L;;;;;N;;;;;
+11691;TAKRI LETTER JA;Lo;0;L;;;;;N;;;;;
+11692;TAKRI LETTER JHA;Lo;0;L;;;;;N;;;;;
+11693;TAKRI LETTER NYA;Lo;0;L;;;;;N;;;;;
+11694;TAKRI LETTER TTA;Lo;0;L;;;;;N;;;;;
+11695;TAKRI LETTER TTHA;Lo;0;L;;;;;N;;;;;
+11696;TAKRI LETTER DDA;Lo;0;L;;;;;N;;;;;
+11697;TAKRI LETTER DDHA;Lo;0;L;;;;;N;;;;;
+11698;TAKRI LETTER NNA;Lo;0;L;;;;;N;;;;;
+11699;TAKRI LETTER TA;Lo;0;L;;;;;N;;;;;
+1169A;TAKRI LETTER THA;Lo;0;L;;;;;N;;;;;
+1169B;TAKRI LETTER DA;Lo;0;L;;;;;N;;;;;
+1169C;TAKRI LETTER DHA;Lo;0;L;;;;;N;;;;;
+1169D;TAKRI LETTER NA;Lo;0;L;;;;;N;;;;;
+1169E;TAKRI LETTER PA;Lo;0;L;;;;;N;;;;;
+1169F;TAKRI LETTER PHA;Lo;0;L;;;;;N;;;;;
+116A0;TAKRI LETTER BA;Lo;0;L;;;;;N;;;;;
+116A1;TAKRI LETTER BHA;Lo;0;L;;;;;N;;;;;
+116A2;TAKRI LETTER MA;Lo;0;L;;;;;N;;;;;
+116A3;TAKRI LETTER YA;Lo;0;L;;;;;N;;;;;
+116A4;TAKRI LETTER RA;Lo;0;L;;;;;N;;;;;
+116A5;TAKRI LETTER LA;Lo;0;L;;;;;N;;;;;
+116A6;TAKRI LETTER VA;Lo;0;L;;;;;N;;;;;
+116A7;TAKRI LETTER SHA;Lo;0;L;;;;;N;;;;;
+116A8;TAKRI LETTER SA;Lo;0;L;;;;;N;;;;;
+116A9;TAKRI LETTER HA;Lo;0;L;;;;;N;;;;;
+116AA;TAKRI LETTER RRA;Lo;0;L;;;;;N;;;;;
+116AB;TAKRI SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
+116AC;TAKRI SIGN VISARGA;Mc;0;L;;;;;N;;;;;
+116AD;TAKRI VOWEL SIGN AA;Mn;0;NSM;;;;;N;;;;;
+116AE;TAKRI VOWEL SIGN I;Mc;0;L;;;;;N;;;;;
+116AF;TAKRI VOWEL SIGN II;Mc;0;L;;;;;N;;;;;
+116B0;TAKRI VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
+116B1;TAKRI VOWEL SIGN UU;Mn;0;NSM;;;;;N;;;;;
+116B2;TAKRI VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;;
+116B3;TAKRI VOWEL SIGN AI;Mn;0;NSM;;;;;N;;;;;
+116B4;TAKRI VOWEL SIGN O;Mn;0;NSM;;;;;N;;;;;
+116B5;TAKRI VOWEL SIGN AU;Mn;0;NSM;;;;;N;;;;;
+116B6;TAKRI SIGN VIRAMA;Mc;9;L;;;;;N;;;;;
+116B7;TAKRI SIGN NUKTA;Mn;7;NSM;;;;;N;;;;;
+116C0;TAKRI DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
+116C1;TAKRI DIGIT ONE;Nd;0;L;;1;1;1;N;;;;;
+116C2;TAKRI DIGIT TWO;Nd;0;L;;2;2;2;N;;;;;
+116C3;TAKRI DIGIT THREE;Nd;0;L;;3;3;3;N;;;;;
+116C4;TAKRI DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;;
+116C5;TAKRI DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;;
+116C6;TAKRI DIGIT SIX;Nd;0;L;;6;6;6;N;;;;;
+116C7;TAKRI DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
+116C8;TAKRI DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
+116C9;TAKRI DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
12000;CUNEIFORM SIGN A;Lo;0;L;;;;;N;;;;;
12001;CUNEIFORM SIGN A TIMES A;Lo;0;L;;;;;N;;;;;
12002;CUNEIFORM SIGN A TIMES BAD;Lo;0;L;;;;;N;;;;;
@@ -18267,8 +18704,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1242F;CUNEIFORM NUMERIC SIGN THREE SHARU VARIANT FORM;Nl;0;L;;;;3;N;;;;;
12430;CUNEIFORM NUMERIC SIGN FOUR SHARU;Nl;0;L;;;;4;N;;;;;
12431;CUNEIFORM NUMERIC SIGN FIVE SHARU;Nl;0;L;;;;5;N;;;;;
-12432;CUNEIFORM NUMERIC SIGN SHAR2 TIMES GAL PLUS DISH;Nl;0;L;;;;;N;;;;;
-12433;CUNEIFORM NUMERIC SIGN SHAR2 TIMES GAL PLUS MIN;Nl;0;L;;;;;N;;;;;
+12432;CUNEIFORM NUMERIC SIGN SHAR2 TIMES GAL PLUS DISH;Nl;0;L;;;;216000;N;;;;;
+12433;CUNEIFORM NUMERIC SIGN SHAR2 TIMES GAL PLUS MIN;Nl;0;L;;;;432000;N;;;;;
12434;CUNEIFORM NUMERIC SIGN ONE BURU;Nl;0;L;;;;1;N;;;;;
12435;CUNEIFORM NUMERIC SIGN TWO BURU;Nl;0;L;;;;2;N;;;;;
12436;CUNEIFORM NUMERIC SIGN THREE BURU;Nl;0;L;;;;3;N;;;;;
@@ -18303,8 +18740,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
12453;CUNEIFORM NUMERIC SIGN FOUR BAN2 VARIANT FORM;Nl;0;L;;;;4;N;;;;;
12454;CUNEIFORM NUMERIC SIGN FIVE BAN2;Nl;0;L;;;;5;N;;;;;
12455;CUNEIFORM NUMERIC SIGN FIVE BAN2 VARIANT FORM;Nl;0;L;;;;5;N;;;;;
-12456;CUNEIFORM NUMERIC SIGN NIGIDAMIN;Nl;0;L;;;;;N;;;;;
-12457;CUNEIFORM NUMERIC SIGN NIGIDAESH;Nl;0;L;;;;;N;;;;;
+12456;CUNEIFORM NUMERIC SIGN NIGIDAMIN;Nl;0;L;;;;-1;N;;;;;
+12457;CUNEIFORM NUMERIC SIGN NIGIDAESH;Nl;0;L;;;;-1;N;;;;;
12458;CUNEIFORM NUMERIC SIGN ONE ESHE3;Nl;0;L;;;;1;N;;;;;
12459;CUNEIFORM NUMERIC SIGN TWO ESHE3;Nl;0;L;;;;2;N;;;;;
1245A;CUNEIFORM NUMERIC SIGN ONE THIRD DISH;Nl;0;L;;;;1/3;N;;;;;
@@ -19960,6 +20397,139 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
16A36;BAMUM LETTER PHASE-F KPA;Lo;0;L;;;;;N;;;;;
16A37;BAMUM LETTER PHASE-F SAMBA;Lo;0;L;;;;;N;;;;;
16A38;BAMUM LETTER PHASE-F VUEQ;Lo;0;L;;;;;N;;;;;
+16F00;MIAO LETTER PA;Lo;0;L;;;;;N;;;;;
+16F01;MIAO LETTER BA;Lo;0;L;;;;;N;;;;;
+16F02;MIAO LETTER YI PA;Lo;0;L;;;;;N;;;;;
+16F03;MIAO LETTER PLA;Lo;0;L;;;;;N;;;;;
+16F04;MIAO LETTER MA;Lo;0;L;;;;;N;;;;;
+16F05;MIAO LETTER MHA;Lo;0;L;;;;;N;;;;;
+16F06;MIAO LETTER ARCHAIC MA;Lo;0;L;;;;;N;;;;;
+16F07;MIAO LETTER FA;Lo;0;L;;;;;N;;;;;
+16F08;MIAO LETTER VA;Lo;0;L;;;;;N;;;;;
+16F09;MIAO LETTER VFA;Lo;0;L;;;;;N;;;;;
+16F0A;MIAO LETTER TA;Lo;0;L;;;;;N;;;;;
+16F0B;MIAO LETTER DA;Lo;0;L;;;;;N;;;;;
+16F0C;MIAO LETTER YI TTA;Lo;0;L;;;;;N;;;;;
+16F0D;MIAO LETTER YI TA;Lo;0;L;;;;;N;;;;;
+16F0E;MIAO LETTER TTA;Lo;0;L;;;;;N;;;;;
+16F0F;MIAO LETTER DDA;Lo;0;L;;;;;N;;;;;
+16F10;MIAO LETTER NA;Lo;0;L;;;;;N;;;;;
+16F11;MIAO LETTER NHA;Lo;0;L;;;;;N;;;;;
+16F12;MIAO LETTER YI NNA;Lo;0;L;;;;;N;;;;;
+16F13;MIAO LETTER ARCHAIC NA;Lo;0;L;;;;;N;;;;;
+16F14;MIAO LETTER NNA;Lo;0;L;;;;;N;;;;;
+16F15;MIAO LETTER NNHA;Lo;0;L;;;;;N;;;;;
+16F16;MIAO LETTER LA;Lo;0;L;;;;;N;;;;;
+16F17;MIAO LETTER LYA;Lo;0;L;;;;;N;;;;;
+16F18;MIAO LETTER LHA;Lo;0;L;;;;;N;;;;;
+16F19;MIAO LETTER LHYA;Lo;0;L;;;;;N;;;;;
+16F1A;MIAO LETTER TLHA;Lo;0;L;;;;;N;;;;;
+16F1B;MIAO LETTER DLHA;Lo;0;L;;;;;N;;;;;
+16F1C;MIAO LETTER TLHYA;Lo;0;L;;;;;N;;;;;
+16F1D;MIAO LETTER DLHYA;Lo;0;L;;;;;N;;;;;
+16F1E;MIAO LETTER KA;Lo;0;L;;;;;N;;;;;
+16F1F;MIAO LETTER GA;Lo;0;L;;;;;N;;;;;
+16F20;MIAO LETTER YI KA;Lo;0;L;;;;;N;;;;;
+16F21;MIAO LETTER QA;Lo;0;L;;;;;N;;;;;
+16F22;MIAO LETTER QGA;Lo;0;L;;;;;N;;;;;
+16F23;MIAO LETTER NGA;Lo;0;L;;;;;N;;;;;
+16F24;MIAO LETTER NGHA;Lo;0;L;;;;;N;;;;;
+16F25;MIAO LETTER ARCHAIC NGA;Lo;0;L;;;;;N;;;;;
+16F26;MIAO LETTER HA;Lo;0;L;;;;;N;;;;;
+16F27;MIAO LETTER XA;Lo;0;L;;;;;N;;;;;
+16F28;MIAO LETTER GHA;Lo;0;L;;;;;N;;;;;
+16F29;MIAO LETTER GHHA;Lo;0;L;;;;;N;;;;;
+16F2A;MIAO LETTER TSSA;Lo;0;L;;;;;N;;;;;
+16F2B;MIAO LETTER DZZA;Lo;0;L;;;;;N;;;;;
+16F2C;MIAO LETTER NYA;Lo;0;L;;;;;N;;;;;
+16F2D;MIAO LETTER NYHA;Lo;0;L;;;;;N;;;;;
+16F2E;MIAO LETTER TSHA;Lo;0;L;;;;;N;;;;;
+16F2F;MIAO LETTER DZHA;Lo;0;L;;;;;N;;;;;
+16F30;MIAO LETTER YI TSHA;Lo;0;L;;;;;N;;;;;
+16F31;MIAO LETTER YI DZHA;Lo;0;L;;;;;N;;;;;
+16F32;MIAO LETTER REFORMED TSHA;Lo;0;L;;;;;N;;;;;
+16F33;MIAO LETTER SHA;Lo;0;L;;;;;N;;;;;
+16F34;MIAO LETTER SSA;Lo;0;L;;;;;N;;;;;
+16F35;MIAO LETTER ZHA;Lo;0;L;;;;;N;;;;;
+16F36;MIAO LETTER ZSHA;Lo;0;L;;;;;N;;;;;
+16F37;MIAO LETTER TSA;Lo;0;L;;;;;N;;;;;
+16F38;MIAO LETTER DZA;Lo;0;L;;;;;N;;;;;
+16F39;MIAO LETTER YI TSA;Lo;0;L;;;;;N;;;;;
+16F3A;MIAO LETTER SA;Lo;0;L;;;;;N;;;;;
+16F3B;MIAO LETTER ZA;Lo;0;L;;;;;N;;;;;
+16F3C;MIAO LETTER ZSA;Lo;0;L;;;;;N;;;;;
+16F3D;MIAO LETTER ZZA;Lo;0;L;;;;;N;;;;;
+16F3E;MIAO LETTER ZZSA;Lo;0;L;;;;;N;;;;;
+16F3F;MIAO LETTER ARCHAIC ZZA;Lo;0;L;;;;;N;;;;;
+16F40;MIAO LETTER ZZYA;Lo;0;L;;;;;N;;;;;
+16F41;MIAO LETTER ZZSYA;Lo;0;L;;;;;N;;;;;
+16F42;MIAO LETTER WA;Lo;0;L;;;;;N;;;;;
+16F43;MIAO LETTER AH;Lo;0;L;;;;;N;;;;;
+16F44;MIAO LETTER HHA;Lo;0;L;;;;;N;;;;;
+16F50;MIAO LETTER NASALIZATION;Lo;0;L;;;;;N;;;;;
+16F51;MIAO SIGN ASPIRATION;Mc;0;L;;;;;N;;;;;
+16F52;MIAO SIGN REFORMED VOICING;Mc;0;L;;;;;N;;;;;
+16F53;MIAO SIGN REFORMED ASPIRATION;Mc;0;L;;;;;N;;;;;
+16F54;MIAO VOWEL SIGN A;Mc;0;L;;;;;N;;;;;
+16F55;MIAO VOWEL SIGN AA;Mc;0;L;;;;;N;;;;;
+16F56;MIAO VOWEL SIGN AHH;Mc;0;L;;;;;N;;;;;
+16F57;MIAO VOWEL SIGN AN;Mc;0;L;;;;;N;;;;;
+16F58;MIAO VOWEL SIGN ANG;Mc;0;L;;;;;N;;;;;
+16F59;MIAO VOWEL SIGN O;Mc;0;L;;;;;N;;;;;
+16F5A;MIAO VOWEL SIGN OO;Mc;0;L;;;;;N;;;;;
+16F5B;MIAO VOWEL SIGN WO;Mc;0;L;;;;;N;;;;;
+16F5C;MIAO VOWEL SIGN W;Mc;0;L;;;;;N;;;;;
+16F5D;MIAO VOWEL SIGN E;Mc;0;L;;;;;N;;;;;
+16F5E;MIAO VOWEL SIGN EN;Mc;0;L;;;;;N;;;;;
+16F5F;MIAO VOWEL SIGN ENG;Mc;0;L;;;;;N;;;;;
+16F60;MIAO VOWEL SIGN OEY;Mc;0;L;;;;;N;;;;;
+16F61;MIAO VOWEL SIGN I;Mc;0;L;;;;;N;;;;;
+16F62;MIAO VOWEL SIGN IA;Mc;0;L;;;;;N;;;;;
+16F63;MIAO VOWEL SIGN IAN;Mc;0;L;;;;;N;;;;;
+16F64;MIAO VOWEL SIGN IANG;Mc;0;L;;;;;N;;;;;
+16F65;MIAO VOWEL SIGN IO;Mc;0;L;;;;;N;;;;;
+16F66;MIAO VOWEL SIGN IE;Mc;0;L;;;;;N;;;;;
+16F67;MIAO VOWEL SIGN II;Mc;0;L;;;;;N;;;;;
+16F68;MIAO VOWEL SIGN IU;Mc;0;L;;;;;N;;;;;
+16F69;MIAO VOWEL SIGN ING;Mc;0;L;;;;;N;;;;;
+16F6A;MIAO VOWEL SIGN U;Mc;0;L;;;;;N;;;;;
+16F6B;MIAO VOWEL SIGN UA;Mc;0;L;;;;;N;;;;;
+16F6C;MIAO VOWEL SIGN UAN;Mc;0;L;;;;;N;;;;;
+16F6D;MIAO VOWEL SIGN UANG;Mc;0;L;;;;;N;;;;;
+16F6E;MIAO VOWEL SIGN UU;Mc;0;L;;;;;N;;;;;
+16F6F;MIAO VOWEL SIGN UEI;Mc;0;L;;;;;N;;;;;
+16F70;MIAO VOWEL SIGN UNG;Mc;0;L;;;;;N;;;;;
+16F71;MIAO VOWEL SIGN Y;Mc;0;L;;;;;N;;;;;
+16F72;MIAO VOWEL SIGN YI;Mc;0;L;;;;;N;;;;;
+16F73;MIAO VOWEL SIGN AE;Mc;0;L;;;;;N;;;;;
+16F74;MIAO VOWEL SIGN AEE;Mc;0;L;;;;;N;;;;;
+16F75;MIAO VOWEL SIGN ERR;Mc;0;L;;;;;N;;;;;
+16F76;MIAO VOWEL SIGN ROUNDED ERR;Mc;0;L;;;;;N;;;;;
+16F77;MIAO VOWEL SIGN ER;Mc;0;L;;;;;N;;;;;
+16F78;MIAO VOWEL SIGN ROUNDED ER;Mc;0;L;;;;;N;;;;;
+16F79;MIAO VOWEL SIGN AI;Mc;0;L;;;;;N;;;;;
+16F7A;MIAO VOWEL SIGN EI;Mc;0;L;;;;;N;;;;;
+16F7B;MIAO VOWEL SIGN AU;Mc;0;L;;;;;N;;;;;
+16F7C;MIAO VOWEL SIGN OU;Mc;0;L;;;;;N;;;;;
+16F7D;MIAO VOWEL SIGN N;Mc;0;L;;;;;N;;;;;
+16F7E;MIAO VOWEL SIGN NG;Mc;0;L;;;;;N;;;;;
+16F8F;MIAO TONE RIGHT;Mn;0;NSM;;;;;N;;;;;
+16F90;MIAO TONE TOP RIGHT;Mn;0;NSM;;;;;N;;;;;
+16F91;MIAO TONE ABOVE;Mn;0;NSM;;;;;N;;;;;
+16F92;MIAO TONE BELOW;Mn;0;NSM;;;;;N;;;;;
+16F93;MIAO LETTER TONE-2;Lm;0;L;;;;;N;;;;;
+16F94;MIAO LETTER TONE-3;Lm;0;L;;;;;N;;;;;
+16F95;MIAO LETTER TONE-4;Lm;0;L;;;;;N;;;;;
+16F96;MIAO LETTER TONE-5;Lm;0;L;;;;;N;;;;;
+16F97;MIAO LETTER TONE-6;Lm;0;L;;;;;N;;;;;
+16F98;MIAO LETTER TONE-7;Lm;0;L;;;;;N;;;;;
+16F99;MIAO LETTER TONE-8;Lm;0;L;;;;;N;;;;;
+16F9A;MIAO LETTER REFORMED TONE-1;Lm;0;L;;;;;N;;;;;
+16F9B;MIAO LETTER REFORMED TONE-2;Lm;0;L;;;;;N;;;;;
+16F9C;MIAO LETTER REFORMED TONE-4;Lm;0;L;;;;;N;;;;;
+16F9D;MIAO LETTER REFORMED TONE-5;Lm;0;L;;;;;N;;;;;
+16F9E;MIAO LETTER REFORMED TONE-6;Lm;0;L;;;;;N;;;;;
+16F9F;MIAO LETTER REFORMED TONE-8;Lm;0;L;;;;;N;;;;;
1B000;KATAKANA LETTER ARCHAIC E;Lo;0;L;;;;;N;;;;;
1B001;HIRAGANA LETTER ARCHAIC YE;Lo;0;L;;;;;N;;;;;
1D000;BYZANTINE MUSICAL SYMBOL PSILI;So;0;L;;;;;N;;;;;
@@ -21599,6 +22169,149 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1D7FD;MATHEMATICAL MONOSPACE DIGIT SEVEN;Nd;0;EN;<font> 0037;7;7;7;N;;;;;
1D7FE;MATHEMATICAL MONOSPACE DIGIT EIGHT;Nd;0;EN;<font> 0038;8;8;8;N;;;;;
1D7FF;MATHEMATICAL MONOSPACE DIGIT NINE;Nd;0;EN;<font> 0039;9;9;9;N;;;;;
+1EE00;ARABIC MATHEMATICAL ALEF;Lo;0;AL;<font> 0627;;;;N;;;;;
+1EE01;ARABIC MATHEMATICAL BEH;Lo;0;AL;<font> 0628;;;;N;;;;;
+1EE02;ARABIC MATHEMATICAL JEEM;Lo;0;AL;<font> 062C;;;;N;;;;;
+1EE03;ARABIC MATHEMATICAL DAL;Lo;0;AL;<font> 062F;;;;N;;;;;
+1EE05;ARABIC MATHEMATICAL WAW;Lo;0;AL;<font> 0648;;;;N;;;;;
+1EE06;ARABIC MATHEMATICAL ZAIN;Lo;0;AL;<font> 0632;;;;N;;;;;
+1EE07;ARABIC MATHEMATICAL HAH;Lo;0;AL;<font> 062D;;;;N;;;;;
+1EE08;ARABIC MATHEMATICAL TAH;Lo;0;AL;<font> 0637;;;;N;;;;;
+1EE09;ARABIC MATHEMATICAL YEH;Lo;0;AL;<font> 064A;;;;N;;;;;
+1EE0A;ARABIC MATHEMATICAL KAF;Lo;0;AL;<font> 0643;;;;N;;;;;
+1EE0B;ARABIC MATHEMATICAL LAM;Lo;0;AL;<font> 0644;;;;N;;;;;
+1EE0C;ARABIC MATHEMATICAL MEEM;Lo;0;AL;<font> 0645;;;;N;;;;;
+1EE0D;ARABIC MATHEMATICAL NOON;Lo;0;AL;<font> 0646;;;;N;;;;;
+1EE0E;ARABIC MATHEMATICAL SEEN;Lo;0;AL;<font> 0633;;;;N;;;;;
+1EE0F;ARABIC MATHEMATICAL AIN;Lo;0;AL;<font> 0639;;;;N;;;;;
+1EE10;ARABIC MATHEMATICAL FEH;Lo;0;AL;<font> 0641;;;;N;;;;;
+1EE11;ARABIC MATHEMATICAL SAD;Lo;0;AL;<font> 0635;;;;N;;;;;
+1EE12;ARABIC MATHEMATICAL QAF;Lo;0;AL;<font> 0642;;;;N;;;;;
+1EE13;ARABIC MATHEMATICAL REH;Lo;0;AL;<font> 0631;;;;N;;;;;
+1EE14;ARABIC MATHEMATICAL SHEEN;Lo;0;AL;<font> 0634;;;;N;;;;;
+1EE15;ARABIC MATHEMATICAL TEH;Lo;0;AL;<font> 062A;;;;N;;;;;
+1EE16;ARABIC MATHEMATICAL THEH;Lo;0;AL;<font> 062B;;;;N;;;;;
+1EE17;ARABIC MATHEMATICAL KHAH;Lo;0;AL;<font> 062E;;;;N;;;;;
+1EE18;ARABIC MATHEMATICAL THAL;Lo;0;AL;<font> 0630;;;;N;;;;;
+1EE19;ARABIC MATHEMATICAL DAD;Lo;0;AL;<font> 0636;;;;N;;;;;
+1EE1A;ARABIC MATHEMATICAL ZAH;Lo;0;AL;<font> 0638;;;;N;;;;;
+1EE1B;ARABIC MATHEMATICAL GHAIN;Lo;0;AL;<font> 063A;;;;N;;;;;
+1EE1C;ARABIC MATHEMATICAL DOTLESS BEH;Lo;0;AL;<font> 066E;;;;N;;;;;
+1EE1D;ARABIC MATHEMATICAL DOTLESS NOON;Lo;0;AL;<font> 06BA;;;;N;;;;;
+1EE1E;ARABIC MATHEMATICAL DOTLESS FEH;Lo;0;AL;<font> 06A1;;;;N;;;;;
+1EE1F;ARABIC MATHEMATICAL DOTLESS QAF;Lo;0;AL;<font> 066F;;;;N;;;;;
+1EE21;ARABIC MATHEMATICAL INITIAL BEH;Lo;0;AL;<font> 0628;;;;N;;;;;
+1EE22;ARABIC MATHEMATICAL INITIAL JEEM;Lo;0;AL;<font> 062C;;;;N;;;;;
+1EE24;ARABIC MATHEMATICAL INITIAL HEH;Lo;0;AL;<font> 0647;;;;N;;;;;
+1EE27;ARABIC MATHEMATICAL INITIAL HAH;Lo;0;AL;<font> 062D;;;;N;;;;;
+1EE29;ARABIC MATHEMATICAL INITIAL YEH;Lo;0;AL;<font> 064A;;;;N;;;;;
+1EE2A;ARABIC MATHEMATICAL INITIAL KAF;Lo;0;AL;<font> 0643;;;;N;;;;;
+1EE2B;ARABIC MATHEMATICAL INITIAL LAM;Lo;0;AL;<font> 0644;;;;N;;;;;
+1EE2C;ARABIC MATHEMATICAL INITIAL MEEM;Lo;0;AL;<font> 0645;;;;N;;;;;
+1EE2D;ARABIC MATHEMATICAL INITIAL NOON;Lo;0;AL;<font> 0646;;;;N;;;;;
+1EE2E;ARABIC MATHEMATICAL INITIAL SEEN;Lo;0;AL;<font> 0633;;;;N;;;;;
+1EE2F;ARABIC MATHEMATICAL INITIAL AIN;Lo;0;AL;<font> 0639;;;;N;;;;;
+1EE30;ARABIC MATHEMATICAL INITIAL FEH;Lo;0;AL;<font> 0641;;;;N;;;;;
+1EE31;ARABIC MATHEMATICAL INITIAL SAD;Lo;0;AL;<font> 0635;;;;N;;;;;
+1EE32;ARABIC MATHEMATICAL INITIAL QAF;Lo;0;AL;<font> 0642;;;;N;;;;;
+1EE34;ARABIC MATHEMATICAL INITIAL SHEEN;Lo;0;AL;<font> 0634;;;;N;;;;;
+1EE35;ARABIC MATHEMATICAL INITIAL TEH;Lo;0;AL;<font> 062A;;;;N;;;;;
+1EE36;ARABIC MATHEMATICAL INITIAL THEH;Lo;0;AL;<font> 062B;;;;N;;;;;
+1EE37;ARABIC MATHEMATICAL INITIAL KHAH;Lo;0;AL;<font> 062E;;;;N;;;;;
+1EE39;ARABIC MATHEMATICAL INITIAL DAD;Lo;0;AL;<font> 0636;;;;N;;;;;
+1EE3B;ARABIC MATHEMATICAL INITIAL GHAIN;Lo;0;AL;<font> 063A;;;;N;;;;;
+1EE42;ARABIC MATHEMATICAL TAILED JEEM;Lo;0;AL;<font> 062C;;;;N;;;;;
+1EE47;ARABIC MATHEMATICAL TAILED HAH;Lo;0;AL;<font> 062D;;;;N;;;;;
+1EE49;ARABIC MATHEMATICAL TAILED YEH;Lo;0;AL;<font> 064A;;;;N;;;;;
+1EE4B;ARABIC MATHEMATICAL TAILED LAM;Lo;0;AL;<font> 0644;;;;N;;;;;
+1EE4D;ARABIC MATHEMATICAL TAILED NOON;Lo;0;AL;<font> 0646;;;;N;;;;;
+1EE4E;ARABIC MATHEMATICAL TAILED SEEN;Lo;0;AL;<font> 0633;;;;N;;;;;
+1EE4F;ARABIC MATHEMATICAL TAILED AIN;Lo;0;AL;<font> 0639;;;;N;;;;;
+1EE51;ARABIC MATHEMATICAL TAILED SAD;Lo;0;AL;<font> 0635;;;;N;;;;;
+1EE52;ARABIC MATHEMATICAL TAILED QAF;Lo;0;AL;<font> 0642;;;;N;;;;;
+1EE54;ARABIC MATHEMATICAL TAILED SHEEN;Lo;0;AL;<font> 0634;;;;N;;;;;
+1EE57;ARABIC MATHEMATICAL TAILED KHAH;Lo;0;AL;<font> 062E;;;;N;;;;;
+1EE59;ARABIC MATHEMATICAL TAILED DAD;Lo;0;AL;<font> 0636;;;;N;;;;;
+1EE5B;ARABIC MATHEMATICAL TAILED GHAIN;Lo;0;AL;<font> 063A;;;;N;;;;;
+1EE5D;ARABIC MATHEMATICAL TAILED DOTLESS NOON;Lo;0;AL;<font> 06BA;;;;N;;;;;
+1EE5F;ARABIC MATHEMATICAL TAILED DOTLESS QAF;Lo;0;AL;<font> 066F;;;;N;;;;;
+1EE61;ARABIC MATHEMATICAL STRETCHED BEH;Lo;0;AL;<font> 0628;;;;N;;;;;
+1EE62;ARABIC MATHEMATICAL STRETCHED JEEM;Lo;0;AL;<font> 062C;;;;N;;;;;
+1EE64;ARABIC MATHEMATICAL STRETCHED HEH;Lo;0;AL;<font> 0647;;;;N;;;;;
+1EE67;ARABIC MATHEMATICAL STRETCHED HAH;Lo;0;AL;<font> 062D;;;;N;;;;;
+1EE68;ARABIC MATHEMATICAL STRETCHED TAH;Lo;0;AL;<font> 0637;;;;N;;;;;
+1EE69;ARABIC MATHEMATICAL STRETCHED YEH;Lo;0;AL;<font> 064A;;;;N;;;;;
+1EE6A;ARABIC MATHEMATICAL STRETCHED KAF;Lo;0;AL;<font> 0643;;;;N;;;;;
+1EE6C;ARABIC MATHEMATICAL STRETCHED MEEM;Lo;0;AL;<font> 0645;;;;N;;;;;
+1EE6D;ARABIC MATHEMATICAL STRETCHED NOON;Lo;0;AL;<font> 0646;;;;N;;;;;
+1EE6E;ARABIC MATHEMATICAL STRETCHED SEEN;Lo;0;AL;<font> 0633;;;;N;;;;;
+1EE6F;ARABIC MATHEMATICAL STRETCHED AIN;Lo;0;AL;<font> 0639;;;;N;;;;;
+1EE70;ARABIC MATHEMATICAL STRETCHED FEH;Lo;0;AL;<font> 0641;;;;N;;;;;
+1EE71;ARABIC MATHEMATICAL STRETCHED SAD;Lo;0;AL;<font> 0635;;;;N;;;;;
+1EE72;ARABIC MATHEMATICAL STRETCHED QAF;Lo;0;AL;<font> 0642;;;;N;;;;;
+1EE74;ARABIC MATHEMATICAL STRETCHED SHEEN;Lo;0;AL;<font> 0634;;;;N;;;;;
+1EE75;ARABIC MATHEMATICAL STRETCHED TEH;Lo;0;AL;<font> 062A;;;;N;;;;;
+1EE76;ARABIC MATHEMATICAL STRETCHED THEH;Lo;0;AL;<font> 062B;;;;N;;;;;
+1EE77;ARABIC MATHEMATICAL STRETCHED KHAH;Lo;0;AL;<font> 062E;;;;N;;;;;
+1EE79;ARABIC MATHEMATICAL STRETCHED DAD;Lo;0;AL;<font> 0636;;;;N;;;;;
+1EE7A;ARABIC MATHEMATICAL STRETCHED ZAH;Lo;0;AL;<font> 0638;;;;N;;;;;
+1EE7B;ARABIC MATHEMATICAL STRETCHED GHAIN;Lo;0;AL;<font> 063A;;;;N;;;;;
+1EE7C;ARABIC MATHEMATICAL STRETCHED DOTLESS BEH;Lo;0;AL;<font> 066E;;;;N;;;;;
+1EE7E;ARABIC MATHEMATICAL STRETCHED DOTLESS FEH;Lo;0;AL;<font> 06A1;;;;N;;;;;
+1EE80;ARABIC MATHEMATICAL LOOPED ALEF;Lo;0;AL;<font> 0627;;;;N;;;;;
+1EE81;ARABIC MATHEMATICAL LOOPED BEH;Lo;0;AL;<font> 0628;;;;N;;;;;
+1EE82;ARABIC MATHEMATICAL LOOPED JEEM;Lo;0;AL;<font> 062C;;;;N;;;;;
+1EE83;ARABIC MATHEMATICAL LOOPED DAL;Lo;0;AL;<font> 062F;;;;N;;;;;
+1EE84;ARABIC MATHEMATICAL LOOPED HEH;Lo;0;AL;<font> 0647;;;;N;;;;;
+1EE85;ARABIC MATHEMATICAL LOOPED WAW;Lo;0;AL;<font> 0648;;;;N;;;;;
+1EE86;ARABIC MATHEMATICAL LOOPED ZAIN;Lo;0;AL;<font> 0632;;;;N;;;;;
+1EE87;ARABIC MATHEMATICAL LOOPED HAH;Lo;0;AL;<font> 062D;;;;N;;;;;
+1EE88;ARABIC MATHEMATICAL LOOPED TAH;Lo;0;AL;<font> 0637;;;;N;;;;;
+1EE89;ARABIC MATHEMATICAL LOOPED YEH;Lo;0;AL;<font> 064A;;;;N;;;;;
+1EE8B;ARABIC MATHEMATICAL LOOPED LAM;Lo;0;AL;<font> 0644;;;;N;;;;;
+1EE8C;ARABIC MATHEMATICAL LOOPED MEEM;Lo;0;AL;<font> 0645;;;;N;;;;;
+1EE8D;ARABIC MATHEMATICAL LOOPED NOON;Lo;0;AL;<font> 0646;;;;N;;;;;
+1EE8E;ARABIC MATHEMATICAL LOOPED SEEN;Lo;0;AL;<font> 0633;;;;N;;;;;
+1EE8F;ARABIC MATHEMATICAL LOOPED AIN;Lo;0;AL;<font> 0639;;;;N;;;;;
+1EE90;ARABIC MATHEMATICAL LOOPED FEH;Lo;0;AL;<font> 0641;;;;N;;;;;
+1EE91;ARABIC MATHEMATICAL LOOPED SAD;Lo;0;AL;<font> 0635;;;;N;;;;;
+1EE92;ARABIC MATHEMATICAL LOOPED QAF;Lo;0;AL;<font> 0642;;;;N;;;;;
+1EE93;ARABIC MATHEMATICAL LOOPED REH;Lo;0;AL;<font> 0631;;;;N;;;;;
+1EE94;ARABIC MATHEMATICAL LOOPED SHEEN;Lo;0;AL;<font> 0634;;;;N;;;;;
+1EE95;ARABIC MATHEMATICAL LOOPED TEH;Lo;0;AL;<font> 062A;;;;N;;;;;
+1EE96;ARABIC MATHEMATICAL LOOPED THEH;Lo;0;AL;<font> 062B;;;;N;;;;;
+1EE97;ARABIC MATHEMATICAL LOOPED KHAH;Lo;0;AL;<font> 062E;;;;N;;;;;
+1EE98;ARABIC MATHEMATICAL LOOPED THAL;Lo;0;AL;<font> 0630;;;;N;;;;;
+1EE99;ARABIC MATHEMATICAL LOOPED DAD;Lo;0;AL;<font> 0636;;;;N;;;;;
+1EE9A;ARABIC MATHEMATICAL LOOPED ZAH;Lo;0;AL;<font> 0638;;;;N;;;;;
+1EE9B;ARABIC MATHEMATICAL LOOPED GHAIN;Lo;0;AL;<font> 063A;;;;N;;;;;
+1EEA1;ARABIC MATHEMATICAL DOUBLE-STRUCK BEH;Lo;0;AL;<font> 0628;;;;N;;;;;
+1EEA2;ARABIC MATHEMATICAL DOUBLE-STRUCK JEEM;Lo;0;AL;<font> 062C;;;;N;;;;;
+1EEA3;ARABIC MATHEMATICAL DOUBLE-STRUCK DAL;Lo;0;AL;<font> 062F;;;;N;;;;;
+1EEA5;ARABIC MATHEMATICAL DOUBLE-STRUCK WAW;Lo;0;AL;<font> 0648;;;;N;;;;;
+1EEA6;ARABIC MATHEMATICAL DOUBLE-STRUCK ZAIN;Lo;0;AL;<font> 0632;;;;N;;;;;
+1EEA7;ARABIC MATHEMATICAL DOUBLE-STRUCK HAH;Lo;0;AL;<font> 062D;;;;N;;;;;
+1EEA8;ARABIC MATHEMATICAL DOUBLE-STRUCK TAH;Lo;0;AL;<font> 0637;;;;N;;;;;
+1EEA9;ARABIC MATHEMATICAL DOUBLE-STRUCK YEH;Lo;0;AL;<font> 064A;;;;N;;;;;
+1EEAB;ARABIC MATHEMATICAL DOUBLE-STRUCK LAM;Lo;0;AL;<font> 0644;;;;N;;;;;
+1EEAC;ARABIC MATHEMATICAL DOUBLE-STRUCK MEEM;Lo;0;AL;<font> 0645;;;;N;;;;;
+1EEAD;ARABIC MATHEMATICAL DOUBLE-STRUCK NOON;Lo;0;AL;<font> 0646;;;;N;;;;;
+1EEAE;ARABIC MATHEMATICAL DOUBLE-STRUCK SEEN;Lo;0;AL;<font> 0633;;;;N;;;;;
+1EEAF;ARABIC MATHEMATICAL DOUBLE-STRUCK AIN;Lo;0;AL;<font> 0639;;;;N;;;;;
+1EEB0;ARABIC MATHEMATICAL DOUBLE-STRUCK FEH;Lo;0;AL;<font> 0641;;;;N;;;;;
+1EEB1;ARABIC MATHEMATICAL DOUBLE-STRUCK SAD;Lo;0;AL;<font> 0635;;;;N;;;;;
+1EEB2;ARABIC MATHEMATICAL DOUBLE-STRUCK QAF;Lo;0;AL;<font> 0642;;;;N;;;;;
+1EEB3;ARABIC MATHEMATICAL DOUBLE-STRUCK REH;Lo;0;AL;<font> 0631;;;;N;;;;;
+1EEB4;ARABIC MATHEMATICAL DOUBLE-STRUCK SHEEN;Lo;0;AL;<font> 0634;;;;N;;;;;
+1EEB5;ARABIC MATHEMATICAL DOUBLE-STRUCK TEH;Lo;0;AL;<font> 062A;;;;N;;;;;
+1EEB6;ARABIC MATHEMATICAL DOUBLE-STRUCK THEH;Lo;0;AL;<font> 062B;;;;N;;;;;
+1EEB7;ARABIC MATHEMATICAL DOUBLE-STRUCK KHAH;Lo;0;AL;<font> 062E;;;;N;;;;;
+1EEB8;ARABIC MATHEMATICAL DOUBLE-STRUCK THAL;Lo;0;AL;<font> 0630;;;;N;;;;;
+1EEB9;ARABIC MATHEMATICAL DOUBLE-STRUCK DAD;Lo;0;AL;<font> 0636;;;;N;;;;;
+1EEBA;ARABIC MATHEMATICAL DOUBLE-STRUCK ZAH;Lo;0;AL;<font> 0638;;;;N;;;;;
+1EEBB;ARABIC MATHEMATICAL DOUBLE-STRUCK GHAIN;Lo;0;AL;<font> 063A;;;;N;;;;;
+1EEF0;ARABIC MATHEMATICAL OPERATOR MEEM WITH HAH WITH TATWEEL;Sm;0;ON;;;;;N;;;;;
+1EEF1;ARABIC MATHEMATICAL OPERATOR HAH WITH DAL;Sm;0;ON;;;;;N;;;;;
1F000;MAHJONG TILE EAST WIND;So;0;ON;;;;;N;;;;;
1F001;MAHJONG TILE SOUTH WIND;So;0;ON;;;;;N;;;;;
1F002;MAHJONG TILE WEST WIND;So;0;ON;;;;;N;;;;;
@@ -21902,6 +22615,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F167;NEGATIVE CIRCLED LATIN CAPITAL LETTER X;So;0;L;;;;;N;;;;;
1F168;NEGATIVE CIRCLED LATIN CAPITAL LETTER Y;So;0;L;;;;;N;;;;;
1F169;NEGATIVE CIRCLED LATIN CAPITAL LETTER Z;So;0;L;;;;;N;;;;;
+1F16A;RAISED MC SIGN;So;0;ON;<super> 004D 0043;;;;N;;;;;
+1F16B;RAISED MD SIGN;So;0;ON;<super> 004D 0044;;;;N;;;;;
1F170;NEGATIVE SQUARED LATIN CAPITAL LETTER A;So;0;L;;;;;N;;;;;
1F171;NEGATIVE SQUARED LATIN CAPITAL LETTER B;So;0;L;;;;;N;;;;;
1F172;NEGATIVE SQUARED LATIN CAPITAL LETTER C;So;0;L;;;;;N;;;;;
@@ -22354,7 +23069,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F489;SYRINGE;So;0;ON;;;;;N;;;;;
1F48A;PILL;So;0;ON;;;;;N;;;;;
1F48B;KISS MARK;So;0;ON;;;;;N;;;;;
-1F48C;LOVE LETTER;So;0;L;;;;;N;;;;;
+1F48C;LOVE LETTER;So;0;ON;;;;;N;;;;;
1F48D;RING;So;0;ON;;;;;N;;;;;
1F48E;GEM STONE;So;0;ON;;;;;N;;;;;
1F48F;KISS;So;0;ON;;;;;N;;;;;
@@ -22502,7 +23217,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F521;INPUT SYMBOL FOR LATIN SMALL LETTERS;So;0;ON;;;;;N;;;;;
1F522;INPUT SYMBOL FOR NUMBERS;So;0;ON;;;;;N;;;;;
1F523;INPUT SYMBOL FOR SYMBOLS;So;0;ON;;;;;N;;;;;
-1F524;INPUT SYMBOL FOR LATIN LETTERS;So;0;L;;;;;N;;;;;
+1F524;INPUT SYMBOL FOR LATIN LETTERS;So;0;ON;;;;;N;;;;;
1F525;FIRE;So;0;ON;;;;;N;;;;;
1F526;ELECTRIC TORCH;So;0;ON;;;;;N;;;;;
1F527;WRENCH;So;0;ON;;;;;N;;;;;
@@ -22528,6 +23243,10 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F53B;DOWN-POINTING RED TRIANGLE;So;0;ON;;;;;N;;;;;
1F53C;UP-POINTING SMALL RED TRIANGLE;So;0;ON;;;;;N;;;;;
1F53D;DOWN-POINTING SMALL RED TRIANGLE;So;0;ON;;;;;N;;;;;
+1F540;CIRCLED CROSS POMMEE;So;0;ON;;;;;N;;;;;
+1F541;CROSS POMMEE WITH HALF-CIRCLE BELOW;So;0;ON;;;;;N;;;;;
+1F542;CROSS POMMEE;So;0;ON;;;;;N;;;;;
+1F543;NOTCHED LEFT SEMICIRCLE WITH THREE DOTS;So;0;ON;;;;;N;;;;;
1F550;CLOCK FACE ONE OCLOCK;So;0;ON;;;;;N;;;;;
1F551;CLOCK FACE TWO OCLOCK;So;0;ON;;;;;N;;;;;
1F552;CLOCK FACE THREE OCLOCK;So;0;ON;;;;;N;;;;;
@@ -22557,6 +23276,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F5FD;STATUE OF LIBERTY;So;0;ON;;;;;N;;;;;
1F5FE;SILHOUETTE OF JAPAN;So;0;ON;;;;;N;;;;;
1F5FF;MOYAI;So;0;ON;;;;;N;;;;;
+1F600;GRINNING FACE;So;0;ON;;;;;N;;;;;
1F601;GRINNING FACE WITH SMILING EYES;So;0;ON;;;;;N;;;;;
1F602;FACE WITH TEARS OF JOY;So;0;ON;;;;;N;;;;;
1F603;SMILING FACE WITH OPEN MOUTH;So;0;ON;;;;;N;;;;;
@@ -22573,30 +23293,42 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F60E;SMILING FACE WITH SUNGLASSES;So;0;ON;;;;;N;;;;;
1F60F;SMIRKING FACE;So;0;ON;;;;;N;;;;;
1F610;NEUTRAL FACE;So;0;ON;;;;;N;;;;;
+1F611;EXPRESSIONLESS FACE;So;0;ON;;;;;N;;;;;
1F612;UNAMUSED FACE;So;0;ON;;;;;N;;;;;
1F613;FACE WITH COLD SWEAT;So;0;ON;;;;;N;;;;;
1F614;PENSIVE FACE;So;0;ON;;;;;N;;;;;
+1F615;CONFUSED FACE;So;0;ON;;;;;N;;;;;
1F616;CONFOUNDED FACE;So;0;ON;;;;;N;;;;;
+1F617;KISSING FACE;So;0;ON;;;;;N;;;;;
1F618;FACE THROWING A KISS;So;0;ON;;;;;N;;;;;
+1F619;KISSING FACE WITH SMILING EYES;So;0;ON;;;;;N;;;;;
1F61A;KISSING FACE WITH CLOSED EYES;So;0;ON;;;;;N;;;;;
+1F61B;FACE WITH STUCK-OUT TONGUE;So;0;ON;;;;;N;;;;;
1F61C;FACE WITH STUCK-OUT TONGUE AND WINKING EYE;So;0;ON;;;;;N;;;;;
1F61D;FACE WITH STUCK-OUT TONGUE AND TIGHTLY-CLOSED EYES;So;0;ON;;;;;N;;;;;
1F61E;DISAPPOINTED FACE;So;0;ON;;;;;N;;;;;
+1F61F;WORRIED FACE;So;0;ON;;;;;N;;;;;
1F620;ANGRY FACE;So;0;ON;;;;;N;;;;;
1F621;POUTING FACE;So;0;ON;;;;;N;;;;;
1F622;CRYING FACE;So;0;ON;;;;;N;;;;;
1F623;PERSEVERING FACE;So;0;ON;;;;;N;;;;;
1F624;FACE WITH LOOK OF TRIUMPH;So;0;ON;;;;;N;;;;;
1F625;DISAPPOINTED BUT RELIEVED FACE;So;0;ON;;;;;N;;;;;
+1F626;FROWNING FACE WITH OPEN MOUTH;So;0;ON;;;;;N;;;;;
+1F627;ANGUISHED FACE;So;0;ON;;;;;N;;;;;
1F628;FEARFUL FACE;So;0;ON;;;;;N;;;;;
1F629;WEARY FACE;So;0;ON;;;;;N;;;;;
1F62A;SLEEPY FACE;So;0;ON;;;;;N;;;;;
1F62B;TIRED FACE;So;0;ON;;;;;N;;;;;
+1F62C;GRIMACING FACE;So;0;ON;;;;;N;;;;;
1F62D;LOUDLY CRYING FACE;So;0;ON;;;;;N;;;;;
+1F62E;FACE WITH OPEN MOUTH;So;0;ON;;;;;N;;;;;
+1F62F;HUSHED FACE;So;0;ON;;;;;N;;;;;
1F630;FACE WITH OPEN MOUTH AND COLD SWEAT;So;0;ON;;;;;N;;;;;
1F631;FACE SCREAMING IN FEAR;So;0;ON;;;;;N;;;;;
1F632;ASTONISHED FACE;So;0;ON;;;;;N;;;;;
1F633;FLUSHED FACE;So;0;ON;;;;;N;;;;;
+1F634;SLEEPING FACE;So;0;ON;;;;;N;;;;;
1F635;DIZZY FACE;So;0;ON;;;;;N;;;;;
1F636;FACE WITHOUT MOUTH;So;0;ON;;;;;N;;;;;
1F637;FACE WITH MEDICAL MASK;So;0;ON;;;;;N;;;;;
diff --git a/admin/unidata/copyright.html b/admin/unidata/copyright.html
index f414ca461f2..90cd895d984 100644
--- a/admin/unidata/copyright.html
+++ b/admin/unidata/copyright.html
@@ -10,7 +10,7 @@
<meta name="VI60_defaultClientScript" content="JavaScript">
-<meta name="GENERATOR" content="Microsoft FrontPage 6.0">
+<meta name="GENERATOR" content="Microsoft FrontPage 5.0">
<meta name="keywords" content="Unicode Standard, copyright">
@@ -28,10 +28,6 @@ href="http://www.unicode.org/webscripts/standard_styles.css">
<body text="#330000">
-
-
-<form action="http://www.unicode.org/webscripts/POST">
-
<table width="100%" cellpadding="0" cellspacing="0" border="0">
<tr>
@@ -79,7 +75,7 @@ href="http://www.unicode.org/webscripts/standard_styles.css">
<td valign="top" class="navColCell"><a href="#4">Waiver of Damages</a></td>
</tr>
<tr>
- <td valign="top" class="navColCell"><a href="#5">Trademarks</a></td>
+ <td valign="top" class="navColCell"><a href="#5">Trademarks & Logos</a></td>
</tr>
<tr>
<td valign="top" class="navColCell"><a href="#7">Miscellaneous</a></td>
@@ -99,8 +95,7 @@ href="http://www.unicode.org/webscripts/standard_styles.css">
</tr>
<tr>
<td valign="top" class="navColCell">
- <a href="http://www.unicode.org/policies/logo_policy.html">The
- Unicode® Consortium Trademarks and Logo Policy</a></td>
+ <a href="http://www.unicode.org/policies/logo_policy.html">Trademark Policy</a></td>
</tr>
<tr>
<td valign="top" class="navColCell">
@@ -125,7 +120,7 @@ href="http://www.unicode.org/webscripts/standard_styles.css">
<a href="http://www.unicode.org/policies/privacy_policy.html">
Unicode Privacy Policy</a>. For trademark usage, see
<a href="http://www.unicode.org/policies/logo_policy.html">the
- Unicode Consortium® Trademarks and Logo Policy</a>.</p>
+ Unicode® Consortium Name and Trademark Usage Policy</a>.</p>
<table class="sidebar" align="right" width="50%" id="table1">
<tr>
@@ -135,13 +130,13 @@ href="http://www.unicode.org/webscripts/standard_styles.css">
<td class="sidebar">Carefully read the following legal agreement
(&quot;Agreement&quot;). Use or copying of the software and/or codes
provided with this agreement (The &quot;Software&quot;) constitutes your
- acceptance of these terms</td>
+ acceptance of these terms. If you have any questions about these terms of use, please <a href="http://www.unicode.org/contacts.html">contact the Unicode Consortium</a>.</td>
</tr>
</table>
<ol type="A">
<li><u><a name="1"></a>Unicode Copyright.</u>
<ol>
- <li>Copyright © 1991-2006 Unicode, Inc. All rights reserved.</li>
+ <li>Copyright © 1991-2012 Unicode, Inc. All rights reserved.</li>
<li>Certain documents and files on this website contain a legend
indicating that &quot;Modification is permitted.&quot; Any person is
hereby authorized, without fee, to modify such documents and
@@ -156,17 +151,12 @@ href="http://www.unicode.org/webscripts/standard_styles.css">
to the use of the particular set of data files known as the
&quot;Unicode Character Database&quot; can be found in <a href="#Exhibit1">
Exhibit 1</a>.</li>
- <li>Each version of the Unicode Standard has further specifications of rights and restrictions
- of use. For the book editions, these are found on the back of
- the
- <a href="http://www.unicode.org/versions/Unicode4.0.0/Title.pdf">
- title page</a>. For the online edition, certain files (such as
- the PDF files for book chapters and code charts) carry specific
- restrictions. All other files are covered under these general
- Terms of Use.&nbsp; To request a permission to reproduce any
- part of the Unicode Standard, please
- <a href="http://www.unicode.org/contacts.html">contact the
- Unicode Consortium</a>.</li>
+ <li>Each version of the Unicode Standard has further
+ specifications of rights and restrictions of use. For the book
+ editions (Unicode 5.0 and earlier), these are found on the back
+ of the
+ <a href="http://www.unicode.org/versions/Unicode5.0.0/Title.pdf">title page</a>.
+ The online code charts carry specific restrictions. All other files, including online documentation of the core specification for Unicode 6.0 and later, are covered under these general Terms of Use.</li>
<li>No license is granted to &quot;mirror&quot; the Unicode website where
a fee is charged for access to the &quot;mirror&quot; site.</li>
<li>Modification is not permitted with respect to this document.
@@ -217,19 +207,12 @@ href="http://www.unicode.org/webscripts/standard_styles.css">
the following: loss of use, data or profits, in connection with
the use, modification or distribution of this information or its
derivatives.</li>
- <li><u><a name="5"></a>Trademarks.</u>
- <ol>
- <li>Unicode and the Unicode logo are registered trademarks of
- Unicode, Inc.&nbsp;</li>
- <li>This site contains product names and corporate names of
- other companies. All product names and company names and logos
- mentioned herein are the trademarks or registered trademarks of
- their respective owners. Other products and corporate names
- mentioned herein which are trademarks of a third party are used
- only for explanation and for the owners&#39; benefit and with no
- intent to infringe.</li>
- <li>Use of third party products or information referred to
- herein is at the user’s risk.</li>
+ <li><u><a name="5"></a>Trademarks &amp; Logos.</u>
+ <ol>
+ <li>The Unicode Word Mark and the Unicode Logo are trademarks of Unicode, Inc. “The Unicode Consortium” and “Unicode, Inc.” are trade names of Unicode, Inc. Use of the information and materials found on this website indicates your acknowledgement of Unicode, Inc.’s exclusive worldwide rights in the Unicode Word Mark, the Unicode Logo, and the Unicode trade names.</li>
+<li><a href="http://www.unicode.org/policies/logo_policy.html">The Unicode Consortium Name and Trademark Usage Policy</a> (“Trademark Policy”) are incorporated herein by reference and you agree to abide by the provisions of the Trademark Policy, which may be changed from time to time in the sole discretion of Unicode, Inc.</li>
+<li>All third party trademarks referenced herein are the property of their respective owners.
+</li>
</ol>
</li>
@@ -274,19 +257,18 @@ UNICODE, INC. LICENSE AGREEMENT - DATA FILES AND SOFTWARE</h3>
<a href="http://www.unicode.org/Public/">http://www.unicode.org/Public/</a>,
<a href="http://www.unicode.org/reports/">http://www.unicode.org/reports/</a>,
and
-<a title="http://www.unicode.org/cldr/data/" onclick="return top.js.OpenExtLink(window,event,this)" target="_blank" href="http://www.unicode.org/cldr/data/">
-http://www.unicode.org/cldr/data/ </a>. Unicode Software includes any source code
-published in the Unicode Standard or under the directories
-<a href="http://www.unicode.org/Public/">http://www.unicode.org/Public/</a>,
+<a title="http://www.unicode.org/cldr/data/" onClick="return top.js.OpenExtLink(window,event,this)" target="_blank" href="http://www.unicode.org/cldr/data/">
+http://www.unicode.org/cldr/data/</a>. Unicode Data Files do not include PDF online code charts under the directory <a href="http://www.unicode.org/Public/">http://www.unicode.org/Public/</a>. Software includes any source code
+published in the Unicode Standard or under the directories <a href="http://www.unicode.org/Public/">http://www.unicode.org/Public/</a>,
<a href="http://www.unicode.org/reports/">http://www.unicode.org/reports/</a>,
and
-<a title="http://www.unicode.org/cldr/data/" onclick="return top.js.OpenExtLink(window,event,this)" target="_blank" href="http://www.unicode.org/cldr/data/">
-http://www.unicode.org/cldr/data/.</a></p>
+<a title="http://www.unicode.org/cldr/data/" onClick="return top.js.OpenExtLink(window,event,this)" target="_blank" href="http://www.unicode.org/cldr/data/">
+http://www.unicode.org/cldr/data/</a>.</p>
<p>NOTICE TO USER: Carefully read the following legal agreement. BY DOWNLOADING, INSTALLING, COPYING OR OTHERWISE USING UNICODE INC.'S DATA FILES ("DATA FILES"), AND/OR SOFTWARE ("SOFTWARE"), YOU UNEQUIVOCALLY ACCEPT, AND AGREE TO BE BOUND BY, ALL OF THE TERMS AND CONDITIONS OF THIS AGREEMENT. IF YOU DO NOT AGREE, DO NOT DOWNLOAD, INSTALL, COPY, DISTRIBUTE OR USE THE DATA FILES OR SOFTWARE.</p>
<p>COPYRIGHT AND PERMISSION NOTICE</p>
-<p>Copyright © 1991-2005 Unicode, Inc. All rights reserved. Distributed under the Terms of Use in
+<p>Copyright © 1991-2012 Unicode, Inc. All rights reserved. Distributed under the Terms of Use in
<a href="http://www.unicode.org/copyright.html">http://www.unicode.org/copyright.html</a>.</p>
<p>Permission is hereby granted, free of charge, to any person obtaining a copy of the Unicode data files and
@@ -300,7 +282,7 @@ PERFORMANCE OF THE DATA FILES OR SOFTWARE.</p>
<hr width="80%">
-<p>Unicode and the Unicode logo are trademarks of Unicode, Inc., and may be registered in some jurisdictions. All other trademarks and registered trademarks mentioned herein are the property of their respective owners.</p>
+<p>Unicode and the Unicode logo are trademarks of Unicode, Inc. in the United States and other countries. All third party trademarks referenced herein are the property of their respective owners.</p>
</blockquote>
@@ -330,13 +312,5 @@ PERFORMANCE OF THE DATA FILES OR SOFTWARE.</p>
</tr>
</table>
-
-</form>
-
-
-
</body>
-
-
-
</html>
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 713b0512e09..d9277217f0e 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -166,9 +166,10 @@
'((name
1 unidata-gen-table-name "uni-name.el"
"Unicode character name.
-Property value is a string."
+Property value is a string or nil.
+The value nil stands for the default value \"null string\")."
nil
- "")
+ nil)
(general-category
2 unidata-gen-table-symbol "uni-category.el"
"Unicode general category.
@@ -235,7 +236,8 @@ Property value is a symbol `Y' or `N'. See also the property `mirroring'."
(old-name
10 unidata-gen-table-name "uni-old-name.el"
"Unicode old names as published in Unicode 1.0.
-Property value is a string.")
+Property value is a string or nil.
+The value nil stands for the default value \"null string\").")
(iso-10646-comment
11 unidata-gen-table-name "uni-comment.el"
"Unicode ISO 10646 comment.
@@ -712,7 +714,7 @@ is the character itself.")))
(aset table c name)
(if (= c char)
(setq val name))))
- (or val ""))))
+ val)))
((and (integerp val) (> val 0))
(let* ((symbol-table (aref (char-table-extra-slot table 4) 1))
@@ -738,9 +740,7 @@ is the character itself.")))
((eq sym 'CJK\ COMPATIBILITY\ IDEOGRAPH)
(format "%s-%04X" sym char))
((eq sym 'VARIATION\ SELECTOR)
- (format "%s-%d" sym (+ (- char #xe0100) 17))))))
-
- (t "")))
+ (format "%s-%d" sym (+ (- char #xe0100) 17))))))))
;; Store VAL as the name of CHAR in TABLE.
diff --git a/autogen.sh b/autogen.sh
index 4778d6ca2ad..9cfaa40eee5 100755
--- a/autogen.sh
+++ b/autogen.sh
@@ -1,7 +1,7 @@
#!/bin/sh
### autogen.sh - tool to help build Emacs from a bzr checkout
-## Copyright (C) 2011 Free Software Foundation, Inc.
+## Copyright (C) 2011-2012 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
@@ -34,10 +34,11 @@
progs="autoconf automake"
## Minimum versions we need:
-autoconf_min=`sed -n 's/^ *AC_PREREQ(\([0-9\.]*\)).*/\1/p' configure.in`
+autoconf_min=`sed -n 's/^ *AC_PREREQ(\([0-9\.]*\)).*/\1/p' configure.ac`
-## FIXME how to determine this from the sources?
-automake_min=1.11
+## This will need improving if more options are ever added to the
+## AM_INIT_AUTOMAKE call.
+automake_min=`sed -n 's/^ *AM_INIT_AUTOMAKE(\([0-9\.]*\)).*/\1/p' configure.ac`
## $1 = program, eg "autoconf".
@@ -209,6 +210,10 @@ echo "Your system has the required tools, running autoreconf..."
## Let autoreconf figure out what, if anything, needs doing.
autoreconf -i -I m4 || exit $?
+## Create a timestamp, so that './autogen.sh; make' doesn't
+## cause 'make' to needlessly run 'autoheader'.
+echo timestamp > src/stamp-h.in || exit
+
echo "You can now run \`./configure'."
exit 0
diff --git a/autogen/Makefile.in b/autogen/Makefile.in
index c3cca3f9f1b..4599f20df45 100644
--- a/autogen/Makefile.in
+++ b/autogen/Makefile.in
@@ -15,7 +15,7 @@
@SET_MAKE@
-# Copyright (C) 2002-2011 Free Software Foundation, Inc.
+# Copyright (C) 2002-2012 Free Software Foundation, Inc.
#
# This file is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -36,7 +36,7 @@
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
-# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=msvc-inval --avoid=msvc-nothrow --avoid=pathmax --avoid=raise --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dup2 filemode getloadavg getopt-gnu ignore-value intprops lstat mktime pthread_sigmask readlink socklen stdarg stdio strftime strtoimax strtoumax symlink sys_stat
+# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=at-internal --avoid=errno --avoid=fchdir --avoid=fcntl --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=openat-die --avoid=openat-h --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl-h filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub utimens warnings
VPATH = @srcdir@
pkgdatadir = $(datadir)/@PACKAGE@
@@ -64,31 +64,47 @@ subdir = lib
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \
$(top_srcdir)/m4/alloca.m4 $(top_srcdir)/m4/c-strtod.m4 \
- $(top_srcdir)/m4/dup2.m4 $(top_srcdir)/m4/extensions.m4 \
- $(top_srcdir)/m4/filemode.m4 $(top_srcdir)/m4/getloadavg.m4 \
- $(top_srcdir)/m4/getopt.m4 $(top_srcdir)/m4/gl-comp.m4 \
+ $(top_srcdir)/m4/clock_time.m4 \
+ $(top_srcdir)/m4/close-stream.m4 $(top_srcdir)/m4/dup2.m4 \
+ $(top_srcdir)/m4/environ.m4 $(top_srcdir)/m4/euidaccess.m4 \
+ $(top_srcdir)/m4/execinfo.m4 $(top_srcdir)/m4/extensions.m4 \
+ $(top_srcdir)/m4/extern-inline.m4 \
+ $(top_srcdir)/m4/faccessat.m4 $(top_srcdir)/m4/fcntl_h.m4 \
+ $(top_srcdir)/m4/filemode.m4 $(top_srcdir)/m4/fpending.m4 \
+ $(top_srcdir)/m4/getgroups.m4 $(top_srcdir)/m4/getloadavg.m4 \
+ $(top_srcdir)/m4/getopt.m4 $(top_srcdir)/m4/gettime.m4 \
+ $(top_srcdir)/m4/gettimeofday.m4 \
$(top_srcdir)/m4/gnulib-common.m4 \
+ $(top_srcdir)/m4/gnulib-comp.m4 \
+ $(top_srcdir)/m4/group-member.m4 \
$(top_srcdir)/m4/include_next.m4 $(top_srcdir)/m4/inttypes.m4 \
$(top_srcdir)/m4/largefile.m4 $(top_srcdir)/m4/longlong.m4 \
- $(top_srcdir)/m4/lstat.m4 $(top_srcdir)/m4/md5.m4 \
- $(top_srcdir)/m4/mktime.m4 $(top_srcdir)/m4/multiarch.m4 \
- $(top_srcdir)/m4/nocrash.m4 \
+ $(top_srcdir)/m4/lstat.m4 $(top_srcdir)/m4/manywarnings.m4 \
+ $(top_srcdir)/m4/md5.m4 $(top_srcdir)/m4/mktime.m4 \
+ $(top_srcdir)/m4/multiarch.m4 $(top_srcdir)/m4/nocrash.m4 \
+ $(top_srcdir)/m4/off_t.m4 $(top_srcdir)/m4/pathmax.m4 \
+ $(top_srcdir)/m4/pselect.m4 \
$(top_srcdir)/m4/pthread_sigmask.m4 \
$(top_srcdir)/m4/readlink.m4 $(top_srcdir)/m4/sha1.m4 \
$(top_srcdir)/m4/sha256.m4 $(top_srcdir)/m4/sha512.m4 \
- $(top_srcdir)/m4/signal_h.m4 \
- $(top_srcdir)/m4/signalblocking.m4 $(top_srcdir)/m4/socklen.m4 \
+ $(top_srcdir)/m4/signal_h.m4 $(top_srcdir)/m4/socklen.m4 \
$(top_srcdir)/m4/ssize_t.m4 $(top_srcdir)/m4/st_dm_mode.m4 \
- $(top_srcdir)/m4/stat.m4 $(top_srcdir)/m4/stdarg.m4 \
+ $(top_srcdir)/m4/stat-time.m4 $(top_srcdir)/m4/stat.m4 \
+ $(top_srcdir)/m4/stdalign.m4 $(top_srcdir)/m4/stdarg.m4 \
$(top_srcdir)/m4/stdbool.m4 $(top_srcdir)/m4/stddef_h.m4 \
$(top_srcdir)/m4/stdint.m4 $(top_srcdir)/m4/stdio_h.m4 \
$(top_srcdir)/m4/stdlib_h.m4 $(top_srcdir)/m4/strftime.m4 \
$(top_srcdir)/m4/strtoimax.m4 $(top_srcdir)/m4/strtoll.m4 \
$(top_srcdir)/m4/strtoull.m4 $(top_srcdir)/m4/strtoumax.m4 \
- $(top_srcdir)/m4/symlink.m4 $(top_srcdir)/m4/sys_stat_h.m4 \
+ $(top_srcdir)/m4/symlink.m4 $(top_srcdir)/m4/sys_select_h.m4 \
+ $(top_srcdir)/m4/sys_socket_h.m4 \
+ $(top_srcdir)/m4/sys_stat_h.m4 $(top_srcdir)/m4/sys_time_h.m4 \
$(top_srcdir)/m4/time_h.m4 $(top_srcdir)/m4/time_r.m4 \
+ $(top_srcdir)/m4/timer_time.m4 $(top_srcdir)/m4/timespec.m4 \
$(top_srcdir)/m4/tm_gmtoff.m4 $(top_srcdir)/m4/unistd_h.m4 \
- $(top_srcdir)/m4/wchar_t.m4 $(top_srcdir)/configure.in
+ $(top_srcdir)/m4/utimbuf.m4 $(top_srcdir)/m4/utimens.m4 \
+ $(top_srcdir)/m4/utimes.m4 $(top_srcdir)/m4/warnings.m4 \
+ $(top_srcdir)/m4/wchar_t.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
@@ -98,13 +114,21 @@ CONFIG_CLEAN_VPATH_FILES =
LIBRARIES = $(noinst_LIBRARIES)
libgnu_a_AR = $(AR) $(ARFLAGS)
am__DEPENDENCIES_1 =
-am__libgnu_a_SOURCES_DIST = allocator.c careadlinkat.c md5.c sha1.c \
- sha256.c sha512.c dtoastr.c filemode.c gettext.h strftime.c
+am__libgnu_a_SOURCES_DIST = allocator.c c-ctype.h c-ctype.c \
+ c-strcase.h c-strcasecmp.c c-strncasecmp.c careadlinkat.c \
+ close-stream.c md5.c sha1.c sha256.c sha512.c dtoastr.c \
+ dtotimespec.c filemode.c gettext.h gettime.c stat-time.c \
+ strftime.c timespec.c timespec-add.c timespec-sub.c u64.c \
+ utimens.c
am__objects_1 =
-am_libgnu_a_OBJECTS = allocator.$(OBJEXT) careadlinkat.$(OBJEXT) \
- md5.$(OBJEXT) sha1.$(OBJEXT) sha256.$(OBJEXT) sha512.$(OBJEXT) \
- dtoastr.$(OBJEXT) filemode.$(OBJEXT) $(am__objects_1) \
- strftime.$(OBJEXT)
+am_libgnu_a_OBJECTS = allocator.$(OBJEXT) c-ctype.$(OBJEXT) \
+ c-strcasecmp.$(OBJEXT) c-strncasecmp.$(OBJEXT) \
+ careadlinkat.$(OBJEXT) close-stream.$(OBJEXT) md5.$(OBJEXT) \
+ sha1.$(OBJEXT) sha256.$(OBJEXT) sha512.$(OBJEXT) \
+ dtoastr.$(OBJEXT) dtotimespec.$(OBJEXT) filemode.$(OBJEXT) \
+ $(am__objects_1) gettime.$(OBJEXT) stat-time.$(OBJEXT) \
+ strftime.$(OBJEXT) timespec.$(OBJEXT) timespec-add.$(OBJEXT) \
+ timespec-sub.$(OBJEXT) u64.$(OBJEXT) utimens.$(OBJEXT)
libgnu_a_OBJECTS = $(am_libgnu_a_OBJECTS)
depcomp = $(SHELL) $(top_srcdir)/build-aux/depcomp
am__depfiles_maybe = depfiles
@@ -152,8 +176,6 @@ CYGWIN_OBJ = @CYGWIN_OBJ@
C_SWITCH_MACHINE = @C_SWITCH_MACHINE@
C_SWITCH_SYSTEM = @C_SWITCH_SYSTEM@
C_SWITCH_X_SITE = @C_SWITCH_X_SITE@
-C_SWITCH_X_SYSTEM = @C_SWITCH_X_SYSTEM@
-C_WARNINGS_SWITCH = @C_WARNINGS_SWITCH@
DBUS_CFLAGS = @DBUS_CFLAGS@
DBUS_LIBS = @DBUS_LIBS@
DBUS_OBJ = @DBUS_OBJ@
@@ -165,6 +187,7 @@ ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
+EXECINFO_H = @EXECINFO_H@
EXEEXT = @EXEEXT@
FONTCONFIG_CFLAGS = @FONTCONFIG_CFLAGS@
FONTCONFIG_LIBS = @FONTCONFIG_LIBS@
@@ -193,6 +216,7 @@ GNULIB_FCHDIR = @GNULIB_FCHDIR@
GNULIB_FCHMODAT = @GNULIB_FCHMODAT@
GNULIB_FCHOWNAT = @GNULIB_FCHOWNAT@
GNULIB_FCLOSE = @GNULIB_FCLOSE@
+GNULIB_FCNTL = @GNULIB_FCNTL@
GNULIB_FDATASYNC = @GNULIB_FDATASYNC@
GNULIB_FDOPEN = @GNULIB_FDOPEN@
GNULIB_FFLUSH = @GNULIB_FFLUSH@
@@ -230,13 +254,15 @@ GNULIB_GETLOADAVG = @GNULIB_GETLOADAVG@
GNULIB_GETLOGIN = @GNULIB_GETLOGIN@
GNULIB_GETLOGIN_R = @GNULIB_GETLOGIN_R@
GNULIB_GETPAGESIZE = @GNULIB_GETPAGESIZE@
-GNULIB_GETS = @GNULIB_GETS@
GNULIB_GETSUBOPT = @GNULIB_GETSUBOPT@
+GNULIB_GETTIMEOFDAY = @GNULIB_GETTIMEOFDAY@
GNULIB_GETUSERSHELL = @GNULIB_GETUSERSHELL@
+GNULIB_GL_UNISTD_H_GETOPT = @GNULIB_GL_UNISTD_H_GETOPT@
GNULIB_GRANTPT = @GNULIB_GRANTPT@
GNULIB_GROUP_MEMBER = @GNULIB_GROUP_MEMBER@
GNULIB_IMAXABS = @GNULIB_IMAXABS@
GNULIB_IMAXDIV = @GNULIB_IMAXDIV@
+GNULIB_ISATTY = @GNULIB_ISATTY@
GNULIB_LCHMOD = @GNULIB_LCHMOD@
GNULIB_LCHOWN = @GNULIB_LCHOWN@
GNULIB_LINK = @GNULIB_LINK@
@@ -257,24 +283,31 @@ GNULIB_MKSTEMP = @GNULIB_MKSTEMP@
GNULIB_MKSTEMPS = @GNULIB_MKSTEMPS@
GNULIB_MKTIME = @GNULIB_MKTIME@
GNULIB_NANOSLEEP = @GNULIB_NANOSLEEP@
+GNULIB_NONBLOCKING = @GNULIB_NONBLOCKING@
GNULIB_OBSTACK_PRINTF = @GNULIB_OBSTACK_PRINTF@
GNULIB_OBSTACK_PRINTF_POSIX = @GNULIB_OBSTACK_PRINTF_POSIX@
+GNULIB_OPEN = @GNULIB_OPEN@
+GNULIB_OPENAT = @GNULIB_OPENAT@
GNULIB_PCLOSE = @GNULIB_PCLOSE@
GNULIB_PERROR = @GNULIB_PERROR@
GNULIB_PIPE = @GNULIB_PIPE@
GNULIB_PIPE2 = @GNULIB_PIPE2@
GNULIB_POPEN = @GNULIB_POPEN@
+GNULIB_POSIX_OPENPT = @GNULIB_POSIX_OPENPT@
GNULIB_PREAD = @GNULIB_PREAD@
GNULIB_PRINTF = @GNULIB_PRINTF@
GNULIB_PRINTF_POSIX = @GNULIB_PRINTF_POSIX@
+GNULIB_PSELECT = @GNULIB_PSELECT@
GNULIB_PTHREAD_SIGMASK = @GNULIB_PTHREAD_SIGMASK@
GNULIB_PTSNAME = @GNULIB_PTSNAME@
+GNULIB_PTSNAME_R = @GNULIB_PTSNAME_R@
GNULIB_PUTC = @GNULIB_PUTC@
GNULIB_PUTCHAR = @GNULIB_PUTCHAR@
GNULIB_PUTENV = @GNULIB_PUTENV@
GNULIB_PUTS = @GNULIB_PUTS@
GNULIB_PWRITE = @GNULIB_PWRITE@
GNULIB_RAISE = @GNULIB_RAISE@
+GNULIB_RANDOM = @GNULIB_RANDOM@
GNULIB_RANDOM_R = @GNULIB_RANDOM_R@
GNULIB_READ = @GNULIB_READ@
GNULIB_READLINK = @GNULIB_READLINK@
@@ -287,7 +320,9 @@ GNULIB_RENAMEAT = @GNULIB_RENAMEAT@
GNULIB_RMDIR = @GNULIB_RMDIR@
GNULIB_RPMATCH = @GNULIB_RPMATCH@
GNULIB_SCANF = @GNULIB_SCANF@
+GNULIB_SELECT = @GNULIB_SELECT@
GNULIB_SETENV = @GNULIB_SETENV@
+GNULIB_SETHOSTNAME = @GNULIB_SETHOSTNAME@
GNULIB_SIGACTION = @GNULIB_SIGACTION@
GNULIB_SIGNAL_H_SIGPIPE = @GNULIB_SIGNAL_H_SIGPIPE@
GNULIB_SIGPROCMASK = @GNULIB_SIGPROCMASK@
@@ -310,7 +345,6 @@ GNULIB_TIMEGM = @GNULIB_TIMEGM@
GNULIB_TIME_R = @GNULIB_TIME_R@
GNULIB_TMPFILE = @GNULIB_TMPFILE@
GNULIB_TTYNAME_R = @GNULIB_TTYNAME_R@
-GNULIB_UNISTD_H_GETOPT = @GNULIB_UNISTD_H_GETOPT@
GNULIB_UNISTD_H_NONBLOCKING = @GNULIB_UNISTD_H_NONBLOCKING@
GNULIB_UNISTD_H_SIGPIPE = @GNULIB_UNISTD_H_SIGPIPE@
GNULIB_UNLINK = @GNULIB_UNLINK@
@@ -329,10 +363,14 @@ GNULIB_VPRINTF_POSIX = @GNULIB_VPRINTF_POSIX@
GNULIB_VSCANF = @GNULIB_VSCANF@
GNULIB_VSNPRINTF = @GNULIB_VSNPRINTF@
GNULIB_VSPRINTF_POSIX = @GNULIB_VSPRINTF_POSIX@
+GNULIB_WARN_CFLAGS = @GNULIB_WARN_CFLAGS@
GNULIB_WCTOMB = @GNULIB_WCTOMB@
GNULIB_WRITE = @GNULIB_WRITE@
GNULIB__EXIT = @GNULIB__EXIT@
+GNUSTEP_CFLAGS = @GNUSTEP_CFLAGS@
GNU_OBJC_CFLAGS = @GNU_OBJC_CFLAGS@
+GOBJECT_CFLAGS = @GOBJECT_CFLAGS@
+GOBJECT_LIBS = @GOBJECT_LIBS@
GREP = @GREP@
GSETTINGS_CFLAGS = @GSETTINGS_CFLAGS@
GSETTINGS_LIBS = @GSETTINGS_LIBS@
@@ -362,6 +400,7 @@ HAVE_DECL_IMAXDIV = @HAVE_DECL_IMAXDIV@
HAVE_DECL_LOCALTIME_R = @HAVE_DECL_LOCALTIME_R@
HAVE_DECL_OBSTACK_PRINTF = @HAVE_DECL_OBSTACK_PRINTF@
HAVE_DECL_SETENV = @HAVE_DECL_SETENV@
+HAVE_DECL_SETHOSTNAME = @HAVE_DECL_SETHOSTNAME@
HAVE_DECL_SNPRINTF = @HAVE_DECL_SNPRINTF@
HAVE_DECL_STRTOIMAX = @HAVE_DECL_STRTOIMAX@
HAVE_DECL_STRTOUMAX = @HAVE_DECL_STRTOUMAX@
@@ -376,6 +415,7 @@ HAVE_FACCESSAT = @HAVE_FACCESSAT@
HAVE_FCHDIR = @HAVE_FCHDIR@
HAVE_FCHMODAT = @HAVE_FCHMODAT@
HAVE_FCHOWNAT = @HAVE_FCHOWNAT@
+HAVE_FCNTL = @HAVE_FCNTL@
HAVE_FDATASYNC = @HAVE_FDATASYNC@
HAVE_FSEEKO = @HAVE_FSEEKO@
HAVE_FSTATAT = @HAVE_FSTATAT@
@@ -390,6 +430,7 @@ HAVE_GETLOGIN = @HAVE_GETLOGIN@
HAVE_GETOPT_H = @HAVE_GETOPT_H@
HAVE_GETPAGESIZE = @HAVE_GETPAGESIZE@
HAVE_GETSUBOPT = @HAVE_GETSUBOPT@
+HAVE_GETTIMEOFDAY = @HAVE_GETTIMEOFDAY@
HAVE_GRANTPT = @HAVE_GRANTPT@
HAVE_GROUP_MEMBER = @HAVE_GROUP_MEMBER@
HAVE_INTTYPES_H = @HAVE_INTTYPES_H@
@@ -411,17 +452,22 @@ HAVE_MKOSTEMPS = @HAVE_MKOSTEMPS@
HAVE_MKSTEMP = @HAVE_MKSTEMP@
HAVE_MKSTEMPS = @HAVE_MKSTEMPS@
HAVE_NANOSLEEP = @HAVE_NANOSLEEP@
+HAVE_OPENAT = @HAVE_OPENAT@
HAVE_OS_H = @HAVE_OS_H@
HAVE_PCLOSE = @HAVE_PCLOSE@
HAVE_PIPE = @HAVE_PIPE@
HAVE_PIPE2 = @HAVE_PIPE2@
HAVE_POPEN = @HAVE_POPEN@
+HAVE_POSIX_OPENPT = @HAVE_POSIX_OPENPT@
HAVE_POSIX_SIGNALBLOCKING = @HAVE_POSIX_SIGNALBLOCKING@
HAVE_PREAD = @HAVE_PREAD@
+HAVE_PSELECT = @HAVE_PSELECT@
HAVE_PTHREAD_SIGMASK = @HAVE_PTHREAD_SIGMASK@
HAVE_PTSNAME = @HAVE_PTSNAME@
+HAVE_PTSNAME_R = @HAVE_PTSNAME_R@
HAVE_PWRITE = @HAVE_PWRITE@
HAVE_RAISE = @HAVE_RAISE@
+HAVE_RANDOM = @HAVE_RANDOM@
HAVE_RANDOM_H = @HAVE_RANDOM_H@
HAVE_RANDOM_R = @HAVE_RANDOM_R@
HAVE_READLINK = @HAVE_READLINK@
@@ -430,6 +476,7 @@ HAVE_REALPATH = @HAVE_REALPATH@
HAVE_RENAMEAT = @HAVE_RENAMEAT@
HAVE_RPMATCH = @HAVE_RPMATCH@
HAVE_SETENV = @HAVE_SETENV@
+HAVE_SETHOSTNAME = @HAVE_SETHOSTNAME@
HAVE_SIGACTION = @HAVE_SIGACTION@
HAVE_SIGHANDLER_T = @HAVE_SIGHANDLER_T@
HAVE_SIGINFO_T = @HAVE_SIGINFO_T@
@@ -445,12 +492,15 @@ HAVE_STRTOLL = @HAVE_STRTOLL@
HAVE_STRTOULL = @HAVE_STRTOULL@
HAVE_STRUCT_RANDOM_DATA = @HAVE_STRUCT_RANDOM_DATA@
HAVE_STRUCT_SIGACTION_SA_SIGACTION = @HAVE_STRUCT_SIGACTION_SA_SIGACTION@
+HAVE_STRUCT_TIMEVAL = @HAVE_STRUCT_TIMEVAL@
HAVE_SYMLINK = @HAVE_SYMLINK@
HAVE_SYMLINKAT = @HAVE_SYMLINKAT@
HAVE_SYS_BITYPES_H = @HAVE_SYS_BITYPES_H@
HAVE_SYS_INTTYPES_H = @HAVE_SYS_INTTYPES_H@
HAVE_SYS_LOADAVG_H = @HAVE_SYS_LOADAVG_H@
HAVE_SYS_PARAM_H = @HAVE_SYS_PARAM_H@
+HAVE_SYS_SELECT_H = @HAVE_SYS_SELECT_H@
+HAVE_SYS_TIME_H = @HAVE_SYS_TIME_H@
HAVE_SYS_TYPES_H = @HAVE_SYS_TYPES_H@
HAVE_TIMEGM = @HAVE_TIMEGM@
HAVE_TYPE_VOLATILE_SIG_ATOMIC_T = @HAVE_TYPE_VOLATILE_SIG_ATOMIC_T@
@@ -464,6 +514,7 @@ HAVE_VASPRINTF = @HAVE_VASPRINTF@
HAVE_VDPRINTF = @HAVE_VDPRINTF@
HAVE_WCHAR_H = @HAVE_WCHAR_H@
HAVE_WCHAR_T = @HAVE_WCHAR_T@
+HAVE_WINSOCK2_H = @HAVE_WINSOCK2_H@
HAVE_XSERVER = @HAVE_XSERVER@
HAVE__BOOL = @HAVE__BOOL@
HAVE__EXIT = @HAVE__EXIT@
@@ -471,7 +522,10 @@ IMAGEMAGICK_CFLAGS = @IMAGEMAGICK_CFLAGS@
IMAGEMAGICK_LIBS = @IMAGEMAGICK_LIBS@
INCLUDE_NEXT = @INCLUDE_NEXT@
INCLUDE_NEXT_AS_FIRST_DIRECTIVE = @INCLUDE_NEXT_AS_FIRST_DIRECTIVE@
+INFO_EXT = @INFO_EXT@
+INFO_OPTS = @INFO_OPTS@
INSTALL = @INSTALL@
+INSTALL_ARCH_INDEP_EXTRA = @INSTALL_ARCH_INDEP_EXTRA@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_INFO = @INSTALL_INFO@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
@@ -486,8 +540,7 @@ LD_FIRSTFLAG = @LD_FIRSTFLAG@
LD_SWITCH_SYSTEM = @LD_SWITCH_SYSTEM@
LD_SWITCH_SYSTEM_TEMACS = @LD_SWITCH_SYSTEM_TEMACS@
LD_SWITCH_X_SITE = @LD_SWITCH_X_SITE@
-LD_SWITCH_X_SITE_AUX = @LD_SWITCH_X_SITE_AUX@
-LD_SWITCH_X_SITE_AUX_RPATH = @LD_SWITCH_X_SITE_AUX_RPATH@
+LD_SWITCH_X_SITE_RPATH = @LD_SWITCH_X_SITE_RPATH@
LIBGIF = @LIBGIF@
LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@
LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@
@@ -518,20 +571,24 @@ LIBXSM = @LIBXSM@
LIBXTR6 = @LIBXTR6@
LIBXT_OTHER = @LIBXT_OTHER@
LIBX_OTHER = @LIBX_OTHER@
+LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@
+LIB_EACCESS = @LIB_EACCESS@
+LIB_EXECINFO = @LIB_EXECINFO@
LIB_GCC = @LIB_GCC@
LIB_MATH = @LIB_MATH@
LIB_PTHREAD = @LIB_PTHREAD@
LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@
LIB_STANDARD = @LIB_STANDARD@
+LIB_TIMER_TIME = @LIB_TIMER_TIME@
+LN_S = @LN_S@
LTLIBINTL = @LTLIBINTL@
LTLIBOBJS = @LTLIBOBJS@
M17N_FLT_CFLAGS = @M17N_FLT_CFLAGS@
M17N_FLT_LIBS = @M17N_FLT_LIBS@
-MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MKDEPDIR = @MKDEPDIR@
MKDIR_P = @MKDIR_P@
-M_FILE = @M_FILE@
+NEXT_AS_FIRST_DIRECTIVE_FCNTL_H = @NEXT_AS_FIRST_DIRECTIVE_FCNTL_H@
NEXT_AS_FIRST_DIRECTIVE_GETOPT_H = @NEXT_AS_FIRST_DIRECTIVE_GETOPT_H@
NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H = @NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H@
NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H = @NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H@
@@ -540,9 +597,12 @@ NEXT_AS_FIRST_DIRECTIVE_STDDEF_H = @NEXT_AS_FIRST_DIRECTIVE_STDDEF_H@
NEXT_AS_FIRST_DIRECTIVE_STDINT_H = @NEXT_AS_FIRST_DIRECTIVE_STDINT_H@
NEXT_AS_FIRST_DIRECTIVE_STDIO_H = @NEXT_AS_FIRST_DIRECTIVE_STDIO_H@
NEXT_AS_FIRST_DIRECTIVE_STDLIB_H = @NEXT_AS_FIRST_DIRECTIVE_STDLIB_H@
+NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H@
NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H@
+NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H@
NEXT_AS_FIRST_DIRECTIVE_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_TIME_H@
NEXT_AS_FIRST_DIRECTIVE_UNISTD_H = @NEXT_AS_FIRST_DIRECTIVE_UNISTD_H@
+NEXT_FCNTL_H = @NEXT_FCNTL_H@
NEXT_GETOPT_H = @NEXT_GETOPT_H@
NEXT_INTTYPES_H = @NEXT_INTTYPES_H@
NEXT_SIGNAL_H = @NEXT_SIGNAL_H@
@@ -551,7 +611,9 @@ NEXT_STDDEF_H = @NEXT_STDDEF_H@
NEXT_STDINT_H = @NEXT_STDINT_H@
NEXT_STDIO_H = @NEXT_STDIO_H@
NEXT_STDLIB_H = @NEXT_STDLIB_H@
+NEXT_SYS_SELECT_H = @NEXT_SYS_SELECT_H@
NEXT_SYS_STAT_H = @NEXT_SYS_STAT_H@
+NEXT_SYS_TIME_H = @NEXT_SYS_TIME_H@
NEXT_TIME_H = @NEXT_TIME_H@
NEXT_UNISTD_H = @NEXT_UNISTD_H@
NS_OBJ = @NS_OBJ@
@@ -569,6 +631,7 @@ PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
+PAXCTL = @PAXCTL@
PKG_CONFIG = @PKG_CONFIG@
POST_ALLOC_OBJ = @POST_ALLOC_OBJ@
PRAGMA_COLUMNS = @PRAGMA_COLUMNS@
@@ -590,6 +653,7 @@ REPLACE_DUP = @REPLACE_DUP@
REPLACE_DUP2 = @REPLACE_DUP2@
REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@
REPLACE_FCLOSE = @REPLACE_FCLOSE@
+REPLACE_FCNTL = @REPLACE_FCNTL@
REPLACE_FDOPEN = @REPLACE_FDOPEN@
REPLACE_FFLUSH = @REPLACE_FFLUSH@
REPLACE_FOPEN = @REPLACE_FOPEN@
@@ -602,6 +666,7 @@ REPLACE_FSTAT = @REPLACE_FSTAT@
REPLACE_FSTATAT = @REPLACE_FSTATAT@
REPLACE_FTELL = @REPLACE_FTELL@
REPLACE_FTELLO = @REPLACE_FTELLO@
+REPLACE_FTRUNCATE = @REPLACE_FTRUNCATE@
REPLACE_FUTIMENS = @REPLACE_FUTIMENS@
REPLACE_GETCWD = @REPLACE_GETCWD@
REPLACE_GETDELIM = @REPLACE_GETDELIM@
@@ -610,6 +675,8 @@ REPLACE_GETGROUPS = @REPLACE_GETGROUPS@
REPLACE_GETLINE = @REPLACE_GETLINE@
REPLACE_GETLOGIN_R = @REPLACE_GETLOGIN_R@
REPLACE_GETPAGESIZE = @REPLACE_GETPAGESIZE@
+REPLACE_GETTIMEOFDAY = @REPLACE_GETTIMEOFDAY@
+REPLACE_ISATTY = @REPLACE_ISATTY@
REPLACE_LCHOWN = @REPLACE_LCHOWN@
REPLACE_LINK = @REPLACE_LINK@
REPLACE_LINKAT = @REPLACE_LINKAT@
@@ -626,14 +693,20 @@ REPLACE_MKTIME = @REPLACE_MKTIME@
REPLACE_NANOSLEEP = @REPLACE_NANOSLEEP@
REPLACE_NULL = @REPLACE_NULL@
REPLACE_OBSTACK_PRINTF = @REPLACE_OBSTACK_PRINTF@
+REPLACE_OPEN = @REPLACE_OPEN@
+REPLACE_OPENAT = @REPLACE_OPENAT@
REPLACE_PERROR = @REPLACE_PERROR@
REPLACE_POPEN = @REPLACE_POPEN@
REPLACE_PREAD = @REPLACE_PREAD@
REPLACE_PRINTF = @REPLACE_PRINTF@
+REPLACE_PSELECT = @REPLACE_PSELECT@
REPLACE_PTHREAD_SIGMASK = @REPLACE_PTHREAD_SIGMASK@
+REPLACE_PTSNAME = @REPLACE_PTSNAME@
+REPLACE_PTSNAME_R = @REPLACE_PTSNAME_R@
REPLACE_PUTENV = @REPLACE_PUTENV@
REPLACE_PWRITE = @REPLACE_PWRITE@
REPLACE_RAISE = @REPLACE_RAISE@
+REPLACE_RANDOM_R = @REPLACE_RANDOM_R@
REPLACE_READ = @REPLACE_READ@
REPLACE_READLINK = @REPLACE_READLINK@
REPLACE_REALLOC = @REPLACE_REALLOC@
@@ -642,6 +715,7 @@ REPLACE_REMOVE = @REPLACE_REMOVE@
REPLACE_RENAME = @REPLACE_RENAME@
REPLACE_RENAMEAT = @REPLACE_RENAMEAT@
REPLACE_RMDIR = @REPLACE_RMDIR@
+REPLACE_SELECT = @REPLACE_SELECT@
REPLACE_SETENV = @REPLACE_SETENV@
REPLACE_SLEEP = @REPLACE_SLEEP@
REPLACE_SNPRINTF = @REPLACE_SNPRINTF@
@@ -650,6 +724,8 @@ REPLACE_STAT = @REPLACE_STAT@
REPLACE_STDIO_READ_FUNCS = @REPLACE_STDIO_READ_FUNCS@
REPLACE_STDIO_WRITE_FUNCS = @REPLACE_STDIO_WRITE_FUNCS@
REPLACE_STRTOD = @REPLACE_STRTOD@
+REPLACE_STRTOIMAX = @REPLACE_STRTOIMAX@
+REPLACE_STRUCT_TIMEVAL = @REPLACE_STRUCT_TIMEVAL@
REPLACE_SYMLINK = @REPLACE_SYMLINK@
REPLACE_TIMEGM = @REPLACE_TIMEGM@
REPLACE_TMPFILE = @REPLACE_TMPFILE@
@@ -676,6 +752,7 @@ SHELL = @SHELL@
SIG_ATOMIC_T_SUFFIX = @SIG_ATOMIC_T_SUFFIX@
SIZE_T_SUFFIX = @SIZE_T_SUFFIX@
START_FILES = @START_FILES@
+STDALIGN_H = @STDALIGN_H@
STDARG_H = @STDARG_H@
STDBOOL_H = @STDBOOL_H@
STDDEF_H = @STDDEF_H@
@@ -683,7 +760,6 @@ STDINT_H = @STDINT_H@
STRIP = @STRIP@
SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@
SYS_TIME_H_DEFINES_STRUCT_TIMESPEC = @SYS_TIME_H_DEFINES_STRUCT_TIMESPEC@
-S_FILE = @S_FILE@
TEMACS_LDFLAGS2 = @TEMACS_LDFLAGS2@
TERMCAP_OBJ = @TERMCAP_OBJ@
TIME_H_DEFINES_STRUCT_TIMESPEC = @TIME_H_DEFINES_STRUCT_TIMESPEC@
@@ -695,8 +771,15 @@ UNISTD_H_HAVE_WINSOCK2_H = @UNISTD_H_HAVE_WINSOCK2_H@
UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS = @UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS@
VERSION = @VERSION@
VMLIMIT_OBJ = @VMLIMIT_OBJ@
+W32_LIBS = @W32_LIBS@
+W32_OBJ = @W32_OBJ@
+WARN_CFLAGS = @WARN_CFLAGS@
WCHAR_T_SUFFIX = @WCHAR_T_SUFFIX@
+WERROR_CFLAGS = @WERROR_CFLAGS@
WIDGET_OBJ = @WIDGET_OBJ@
+WINDOWS_64_BIT_OFF_T = @WINDOWS_64_BIT_OFF_T@
+WINDOWS_64_BIT_ST_SIZE = @WINDOWS_64_BIT_ST_SIZE@
+WINDOW_SYSTEM_OBJ = @WINDOW_SYSTEM_OBJ@
WINT_T_SUFFIX = @WINT_T_SUFFIX@
XFT_CFLAGS = @XFT_CFLAGS@
XFT_LIBS = @XFT_LIBS@
@@ -726,6 +809,7 @@ builddir = @builddir@
cache_file = @cache_file@
canonical = @canonical@
configuration = @configuration@
+copyright = @copyright@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
@@ -748,6 +832,7 @@ htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
+leimdir = @leimdir@
libdir = @libdir@
libexecdir = @libexecdir@
liblockfile = @liblockfile@
@@ -762,6 +847,7 @@ ns_appbindir = @ns_appbindir@
ns_appdir = @ns_appdir@
ns_appresdir = @ns_appresdir@
ns_appsrc = @ns_appsrc@
+ns_self_contained = @ns_self_contained@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
@@ -770,6 +856,7 @@ psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
+standardlisppath = @standardlisppath@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
@@ -787,43 +874,55 @@ x_default_search_path = @x_default_search_path@
# statements but through direct file reference. Therefore this snippet must be
# present in all Makefile.am that need it. This is ensured by the applicability
# 'all' defined above.
-BUILT_SOURCES = $(ALLOCA_H) $(GETOPT_H) inttypes.h signal.h \
- arg-nonnull.h c++defs.h warn-on-use.h $(STDARG_H) $(STDBOOL_H) \
- $(STDDEF_H) $(STDINT_H) stdio.h stdlib.h sys/stat.h time.h \
+BUILT_SOURCES = $(ALLOCA_H) $(EXECINFO_H) fcntl.h $(GETOPT_H) \
+ inttypes.h signal.h arg-nonnull.h c++defs.h warn-on-use.h \
+ $(STDALIGN_H) $(STDARG_H) $(STDBOOL_H) $(STDDEF_H) $(STDINT_H) \
+ stdio.h stdlib.h sys/select.h sys/stat.h sys/time.h time.h \
unistd.h
-EXTRA_DIST = alloca.in.h allocator.h careadlinkat.h md5.h sha1.h \
- sha256.h sha512.h dosname.h ftoastr.c ftoastr.h dup2.c \
- filemode.h getloadavg.c getopt.c getopt.in.h getopt1.c \
- getopt_int.h ignore-value.h intprops.h inttypes.in.h lstat.c \
- mktime-internal.h mktime.c pthread_sigmask.c readlink.c \
- signal.in.h sigprocmask.c \
- $(top_srcdir)/build-aux/snippet/_Noreturn.h \
+EXTRA_DIST = alloca.in.h allocator.h careadlinkat.h close-stream.h \
+ md5.h sha1.h sha256.h sha512.h dosname.h ftoastr.c ftoastr.h \
+ dup2.c euidaccess.c execinfo.c execinfo.in.h at-func.c \
+ faccessat.c fcntl.in.h filemode.h fpending.c fpending.h \
+ getgroups.c getloadavg.c getopt.c getopt.in.h getopt1.c \
+ getopt_int.h gettimeofday.c group-member.c ignore-value.h \
+ intprops.h inttypes.in.h lstat.c mktime-internal.h mktime.c \
+ pathmax.h pselect.c pthread_sigmask.c readlink.c root-uid.h \
+ signal.in.h $(top_srcdir)/build-aux/snippet/_Noreturn.h \
$(top_srcdir)/build-aux/snippet/arg-nonnull.h \
$(top_srcdir)/build-aux/snippet/c++defs.h \
$(top_srcdir)/build-aux/snippet/warn-on-use.h stat.c \
- stdarg.in.h stdbool.in.h stddef.in.h stdint.in.h stdio.in.h \
- stdlib.in.h strftime.h strtoimax.c strtol.c strtoll.c strtol.c \
- strtoul.c strtoull.c strtoimax.c strtoumax.c symlink.c \
- sys_stat.in.h time.in.h time_r.c u64.h unistd.in.h verify.h
-MOSTLYCLEANDIRS = sys
-MOSTLYCLEANFILES = core *.stackdump alloca.h alloca.h-t getopt.h \
- getopt.h-t inttypes.h inttypes.h-t signal.h signal.h-t \
- arg-nonnull.h arg-nonnull.h-t c++defs.h c++defs.h-t \
- warn-on-use.h warn-on-use.h-t stdarg.h stdarg.h-t stdbool.h \
- stdbool.h-t stddef.h stddef.h-t stdint.h stdint.h-t stdio.h \
- stdio.h-t stdlib.h stdlib.h-t sys/stat.h sys/stat.h-t time.h \
- time.h-t unistd.h unistd.h-t
+ stat-time.h stdalign.in.h stdarg.in.h stdbool.in.h stddef.in.h \
+ stdint.in.h stdio.in.h stdlib.in.h strftime.h strtoimax.c \
+ strtol.c strtoll.c strtol.c strtoul.c strtoull.c strtoimax.c \
+ strtoumax.c symlink.c sys_select.in.h sys_stat.in.h \
+ sys_time.in.h time.in.h time_r.c timespec.h u64.h unistd.in.h \
+ utimens.h verify.h xalloc-oversized.h
+MOSTLYCLEANDIRS = sys sys
+MOSTLYCLEANFILES = core *.stackdump alloca.h alloca.h-t execinfo.h \
+ execinfo.h-t fcntl.h fcntl.h-t getopt.h getopt.h-t inttypes.h \
+ inttypes.h-t signal.h signal.h-t arg-nonnull.h arg-nonnull.h-t \
+ c++defs.h c++defs.h-t warn-on-use.h warn-on-use.h-t stdalign.h \
+ stdalign.h-t stdarg.h stdarg.h-t stdbool.h stdbool.h-t \
+ stddef.h stddef.h-t stdint.h stdint.h-t stdio.h stdio.h-t \
+ stdlib.h stdlib.h-t sys/select.h sys/select.h-t sys/stat.h \
+ sys/stat.h-t sys/time.h sys/time.h-t time.h time.h-t unistd.h \
+ unistd.h-t
noinst_LIBRARIES = libgnu.a
-DEFAULT_INCLUDES = -I. -I../src -I$(top_srcdir)/src
-libgnu_a_SOURCES = allocator.c careadlinkat.c md5.c sha1.c sha256.c \
- sha512.c dtoastr.c filemode.c $(am__append_1) strftime.c
+AM_CFLAGS = $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS)
+DEFAULT_INCLUDES = -I. -I$(top_srcdir)/lib -I../src -I$(top_srcdir)/src
+libgnu_a_SOURCES = allocator.c c-ctype.h c-ctype.c c-strcase.h \
+ c-strcasecmp.c c-strncasecmp.c careadlinkat.c close-stream.c \
+ md5.c sha1.c sha256.c sha512.c dtoastr.c dtotimespec.c \
+ filemode.c $(am__append_1) gettime.c stat-time.c strftime.c \
+ timespec.c timespec-add.c timespec-sub.c u64.c utimens.c
libgnu_a_LIBADD = $(gl_LIBOBJS)
libgnu_a_DEPENDENCIES = $(gl_LIBOBJS)
-EXTRA_libgnu_a_SOURCES = ftoastr.c dup2.c getloadavg.c getopt.c \
- getopt1.c lstat.c mktime.c pthread_sigmask.c readlink.c \
- sigprocmask.c stat.c strtoimax.c strtol.c strtoll.c strtol.c \
- strtoul.c strtoull.c strtoimax.c strtoumax.c symlink.c \
- time_r.c
+EXTRA_libgnu_a_SOURCES = ftoastr.c dup2.c euidaccess.c execinfo.c \
+ at-func.c faccessat.c fpending.c getgroups.c getloadavg.c \
+ getopt.c getopt1.c gettimeofday.c group-member.c lstat.c \
+ mktime.c pselect.c pthread_sigmask.c readlink.c stat.c \
+ strtoimax.c strtol.c strtoll.c strtol.c strtoul.c strtoull.c \
+ strtoimax.c strtoumax.c symlink.c time_r.c
# Because this Makefile snippet defines a variable used by other
# gnulib Makefile snippets, it must be present in all Makefile.am that
@@ -882,23 +981,38 @@ distclean-compile:
-rm -f *.tab.c
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/allocator.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/at-func.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-ctype.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-strcasecmp.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-strncasecmp.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/careadlinkat.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/close-stream.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtoastr.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtotimespec.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dup2.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/euidaccess.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/execinfo.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/faccessat.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/filemode.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fpending.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ftoastr.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getgroups.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getloadavg.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt1.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gettime.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gettimeofday.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/group-member.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/lstat.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/md5.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mktime.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pselect.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pthread_sigmask.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/readlink.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha1.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha256.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha512.Po@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sigprocmask.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stat-time.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stat.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strftime.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoimax.Po@am__quote@
@@ -909,6 +1023,11 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoumax.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/symlink.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/time_r.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/timespec-add.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/timespec-sub.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/timespec.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/u64.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/utimens.Po@am__quote@
.c.o:
@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@@ -1136,6 +1255,43 @@ uninstall-am:
@GL_GENERATE_ALLOCA_H_FALSE@alloca.h: $(top_builddir)/config.status
@GL_GENERATE_ALLOCA_H_FALSE@ rm -f $@
+# We need the following in order to create <execinfo.h> when the system
+# doesn't have one that works.
+@GL_GENERATE_EXECINFO_H_TRUE@execinfo.h: execinfo.in.h $(top_builddir)/config.status
+@GL_GENERATE_EXECINFO_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \
+@GL_GENERATE_EXECINFO_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+@GL_GENERATE_EXECINFO_H_TRUE@ cat $(srcdir)/execinfo.in.h; \
+@GL_GENERATE_EXECINFO_H_TRUE@ } > $@-t && \
+@GL_GENERATE_EXECINFO_H_TRUE@ mv $@-t $@
+@GL_GENERATE_EXECINFO_H_FALSE@execinfo.h: $(top_builddir)/config.status
+@GL_GENERATE_EXECINFO_H_FALSE@ rm -f $@
+
+# We need the following in order to create <fcntl.h> when the system
+# doesn't have one that works with the given compiler.
+fcntl.h: fcntl.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H)
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_FCNTL_H''@|$(NEXT_FCNTL_H)|g' \
+ -e 's/@''GNULIB_FCNTL''@/$(GNULIB_FCNTL)/g' \
+ -e 's/@''GNULIB_NONBLOCKING''@/$(GNULIB_NONBLOCKING)/g' \
+ -e 's/@''GNULIB_OPEN''@/$(GNULIB_OPEN)/g' \
+ -e 's/@''GNULIB_OPENAT''@/$(GNULIB_OPENAT)/g' \
+ -e 's|@''HAVE_FCNTL''@|$(HAVE_FCNTL)|g' \
+ -e 's|@''HAVE_OPENAT''@|$(HAVE_OPENAT)|g' \
+ -e 's|@''REPLACE_FCNTL''@|$(REPLACE_FCNTL)|g' \
+ -e 's|@''REPLACE_OPEN''@|$(REPLACE_OPEN)|g' \
+ -e 's|@''REPLACE_OPENAT''@|$(REPLACE_OPENAT)|g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/fcntl.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+
# We need the following in order to create <getopt.h> when the system
# doesn't have one that works with the given compiler.
getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H)
@@ -1154,7 +1310,7 @@ getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H)
# We need the following in order to create <inttypes.h> when the system
# doesn't have one that works with the given compiler.
-inttypes.h: inttypes.in.h $(top_builddir)/config.status $(WARN_ON_USE_H) $(ARG_NONNULL_H)
+inttypes.h: inttypes.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_USE_H) $(ARG_NONNULL_H)
$(AM_V_GEN)rm -f $@-t $@ && \
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
sed -e 's/@''HAVE_INTTYPES_H''@/$(HAVE_INTTYPES_H)/g' \
@@ -1175,10 +1331,12 @@ inttypes.h: inttypes.in.h $(top_builddir)/config.status $(WARN_ON_USE_H) $(ARG_N
-e 's/@''HAVE_DECL_IMAXDIV''@/$(HAVE_DECL_IMAXDIV)/g' \
-e 's/@''HAVE_DECL_STRTOIMAX''@/$(HAVE_DECL_STRTOIMAX)/g' \
-e 's/@''HAVE_DECL_STRTOUMAX''@/$(HAVE_DECL_STRTOUMAX)/g' \
+ -e 's/@''REPLACE_STRTOIMAX''@/$(REPLACE_STRTOIMAX)/g' \
-e 's/@''INT32_MAX_LT_INTMAX_MAX''@/$(INT32_MAX_LT_INTMAX_MAX)/g' \
-e 's/@''INT64_MAX_EQ_LONG_MAX''@/$(INT64_MAX_EQ_LONG_MAX)/g' \
-e 's/@''UINT32_MAX_LT_UINTMAX_MAX''@/$(UINT32_MAX_LT_UINTMAX_MAX)/g' \
-e 's/@''UINT64_MAX_EQ_ULONG_MAX''@/$(UINT64_MAX_EQ_ULONG_MAX)/g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
-e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
-e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
< $(srcdir)/inttypes.in.h; \
@@ -1244,6 +1402,17 @@ warn-on-use.h: $(top_srcdir)/build-aux/snippet/warn-on-use.h
> $@-t && \
mv $@-t $@
+# We need the following in order to create <stdalign.h> when the system
+# doesn't have one that works.
+@GL_GENERATE_STDALIGN_H_TRUE@stdalign.h: stdalign.in.h $(top_builddir)/config.status
+@GL_GENERATE_STDALIGN_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \
+@GL_GENERATE_STDALIGN_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+@GL_GENERATE_STDALIGN_H_TRUE@ cat $(srcdir)/stdalign.in.h; \
+@GL_GENERATE_STDALIGN_H_TRUE@ } > $@-t && \
+@GL_GENERATE_STDALIGN_H_TRUE@ mv $@-t $@
+@GL_GENERATE_STDALIGN_H_FALSE@stdalign.h: $(top_builddir)/config.status
+@GL_GENERATE_STDALIGN_H_FALSE@ rm -f $@
+
# We need the following in order to create <stdarg.h> when the system
# doesn't have one that works with the given compiler.
@GL_GENERATE_STDARG_H_TRUE@stdarg.h: stdarg.in.h $(top_builddir)/config.status
@@ -1361,7 +1530,6 @@ stdio.h: stdio.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H)
-e 's/@''GNULIB_GETCHAR''@/$(GNULIB_GETCHAR)/g' \
-e 's/@''GNULIB_GETDELIM''@/$(GNULIB_GETDELIM)/g' \
-e 's/@''GNULIB_GETLINE''@/$(GNULIB_GETLINE)/g' \
- -e 's/@''GNULIB_GETS''@/$(GNULIB_GETS)/g' \
-e 's/@''GNULIB_OBSTACK_PRINTF''@/$(GNULIB_OBSTACK_PRINTF)/g' \
-e 's/@''GNULIB_OBSTACK_PRINTF_POSIX''@/$(GNULIB_OBSTACK_PRINTF_POSIX)/g' \
-e 's/@''GNULIB_PCLOSE''@/$(GNULIB_PCLOSE)/g' \
@@ -1472,8 +1640,11 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's/@''GNULIB_MKOSTEMPS''@/$(GNULIB_MKOSTEMPS)/g' \
-e 's/@''GNULIB_MKSTEMP''@/$(GNULIB_MKSTEMP)/g' \
-e 's/@''GNULIB_MKSTEMPS''@/$(GNULIB_MKSTEMPS)/g' \
+ -e 's/@''GNULIB_POSIX_OPENPT''@/$(GNULIB_POSIX_OPENPT)/g' \
-e 's/@''GNULIB_PTSNAME''@/$(GNULIB_PTSNAME)/g' \
+ -e 's/@''GNULIB_PTSNAME_R''@/$(GNULIB_PTSNAME_R)/g' \
-e 's/@''GNULIB_PUTENV''@/$(GNULIB_PUTENV)/g' \
+ -e 's/@''GNULIB_RANDOM''@/$(GNULIB_RANDOM)/g' \
-e 's/@''GNULIB_RANDOM_R''@/$(GNULIB_RANDOM_R)/g' \
-e 's/@''GNULIB_REALLOC_POSIX''@/$(GNULIB_REALLOC_POSIX)/g' \
-e 's/@''GNULIB_REALPATH''@/$(GNULIB_REALPATH)/g' \
@@ -1498,7 +1669,10 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's|@''HAVE_MKOSTEMPS''@|$(HAVE_MKOSTEMPS)|g' \
-e 's|@''HAVE_MKSTEMP''@|$(HAVE_MKSTEMP)|g' \
-e 's|@''HAVE_MKSTEMPS''@|$(HAVE_MKSTEMPS)|g' \
+ -e 's|@''HAVE_POSIX_OPENPT''@|$(HAVE_POSIX_OPENPT)|g' \
-e 's|@''HAVE_PTSNAME''@|$(HAVE_PTSNAME)|g' \
+ -e 's|@''HAVE_PTSNAME_R''@|$(HAVE_PTSNAME_R)|g' \
+ -e 's|@''HAVE_RANDOM''@|$(HAVE_RANDOM)|g' \
-e 's|@''HAVE_RANDOM_H''@|$(HAVE_RANDOM_H)|g' \
-e 's|@''HAVE_RANDOM_R''@|$(HAVE_RANDOM_R)|g' \
-e 's|@''HAVE_REALPATH''@|$(HAVE_REALPATH)|g' \
@@ -1516,7 +1690,10 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's|@''REPLACE_MALLOC''@|$(REPLACE_MALLOC)|g' \
-e 's|@''REPLACE_MBTOWC''@|$(REPLACE_MBTOWC)|g' \
-e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \
+ -e 's|@''REPLACE_PTSNAME''@|$(REPLACE_PTSNAME)|g' \
+ -e 's|@''REPLACE_PTSNAME_R''@|$(REPLACE_PTSNAME_R)|g' \
-e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \
+ -e 's|@''REPLACE_RANDOM_R''@|$(REPLACE_RANDOM_R)|g' \
-e 's|@''REPLACE_REALLOC''@|$(REPLACE_REALLOC)|g' \
-e 's|@''REPLACE_REALPATH''@|$(REPLACE_REALPATH)|g' \
-e 's|@''REPLACE_SETENV''@|$(REPLACE_SETENV)|g' \
@@ -1530,6 +1707,30 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
} > $@-t && \
mv $@-t $@
+# We need the following in order to create <sys/select.h> when the system
+# doesn't have one that works with the given compiler.
+sys/select.h: sys_select.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_USE_H)
+ $(AM_V_at)$(MKDIR_P) sys
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_SYS_SELECT_H''@|$(NEXT_SYS_SELECT_H)|g' \
+ -e 's|@''HAVE_SYS_SELECT_H''@|$(HAVE_SYS_SELECT_H)|g' \
+ -e 's/@''GNULIB_PSELECT''@/$(GNULIB_PSELECT)/g' \
+ -e 's/@''GNULIB_SELECT''@/$(GNULIB_SELECT)/g' \
+ -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \
+ -e 's|@''HAVE_PSELECT''@|$(HAVE_PSELECT)|g' \
+ -e 's|@''REPLACE_PSELECT''@|$(REPLACE_PSELECT)|g' \
+ -e 's|@''REPLACE_SELECT''@|$(REPLACE_SELECT)|g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/sys_select.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+
# We need the following in order to create <sys/stat.h> when the system
# has one that is incomplete.
sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H)
@@ -1541,6 +1742,7 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU
-e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_SYS_STAT_H''@|$(NEXT_SYS_STAT_H)|g' \
+ -e 's|@''WINDOWS_64_BIT_ST_SIZE''@|$(WINDOWS_64_BIT_ST_SIZE)|g' \
-e 's/@''GNULIB_FCHMODAT''@/$(GNULIB_FCHMODAT)/g' \
-e 's/@''GNULIB_FSTAT''@/$(GNULIB_FSTAT)/g' \
-e 's/@''GNULIB_FSTATAT''@/$(GNULIB_FSTATAT)/g' \
@@ -1581,6 +1783,31 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU
} > $@-t && \
mv $@-t $@
+# We need the following in order to create <sys/time.h> when the system
+# doesn't have one that works with the given compiler.
+sys/time.h: sys_time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H)
+ $(AM_V_at)$(MKDIR_P) sys
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's/@''HAVE_SYS_TIME_H''@/$(HAVE_SYS_TIME_H)/g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_SYS_TIME_H''@|$(NEXT_SYS_TIME_H)|g' \
+ -e 's/@''GNULIB_GETTIMEOFDAY''@/$(GNULIB_GETTIMEOFDAY)/g' \
+ -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \
+ -e 's/@''HAVE_GETTIMEOFDAY''@/$(HAVE_GETTIMEOFDAY)/g' \
+ -e 's/@''HAVE_STRUCT_TIMEVAL''@/$(HAVE_STRUCT_TIMEVAL)/g' \
+ -e 's/@''REPLACE_GETTIMEOFDAY''@/$(REPLACE_GETTIMEOFDAY)/g' \
+ -e 's/@''REPLACE_STRUCT_TIMEVAL''@/$(REPLACE_STRUCT_TIMEVAL)/g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/sys_time.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+
# We need the following in order to create <time.h> when the system
# doesn't have one that works with the given compiler.
time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H)
@@ -1625,6 +1852,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_UNISTD_H''@|$(NEXT_UNISTD_H)|g' \
+ -e 's|@''WINDOWS_64_BIT_OFF_T''@|$(WINDOWS_64_BIT_OFF_T)|g' \
-e 's/@''GNULIB_CHDIR''@/$(GNULIB_CHDIR)/g' \
-e 's/@''GNULIB_CHOWN''@/$(GNULIB_CHOWN)/g' \
-e 's/@''GNULIB_CLOSE''@/$(GNULIB_CLOSE)/g' \
@@ -1649,6 +1877,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's/@''GNULIB_GETPAGESIZE''@/$(GNULIB_GETPAGESIZE)/g' \
-e 's/@''GNULIB_GETUSERSHELL''@/$(GNULIB_GETUSERSHELL)/g' \
-e 's/@''GNULIB_GROUP_MEMBER''@/$(GNULIB_GROUP_MEMBER)/g' \
+ -e 's/@''GNULIB_ISATTY''@/$(GNULIB_ISATTY)/g' \
-e 's/@''GNULIB_LCHOWN''@/$(GNULIB_LCHOWN)/g' \
-e 's/@''GNULIB_LINK''@/$(GNULIB_LINK)/g' \
-e 's/@''GNULIB_LINKAT''@/$(GNULIB_LINKAT)/g' \
@@ -1661,11 +1890,12 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's/@''GNULIB_READLINK''@/$(GNULIB_READLINK)/g' \
-e 's/@''GNULIB_READLINKAT''@/$(GNULIB_READLINKAT)/g' \
-e 's/@''GNULIB_RMDIR''@/$(GNULIB_RMDIR)/g' \
+ -e 's/@''GNULIB_SETHOSTNAME''@/$(GNULIB_SETHOSTNAME)/g' \
-e 's/@''GNULIB_SLEEP''@/$(GNULIB_SLEEP)/g' \
-e 's/@''GNULIB_SYMLINK''@/$(GNULIB_SYMLINK)/g' \
-e 's/@''GNULIB_SYMLINKAT''@/$(GNULIB_SYMLINKAT)/g' \
-e 's/@''GNULIB_TTYNAME_R''@/$(GNULIB_TTYNAME_R)/g' \
- -e 's/@''GNULIB_UNISTD_H_GETOPT''@/$(GNULIB_UNISTD_H_GETOPT)/g' \
+ -e 's/@''GNULIB_UNISTD_H_GETOPT''@/0$(GNULIB_GL_UNISTD_H_GETOPT)/g' \
-e 's/@''GNULIB_UNISTD_H_NONBLOCKING''@/$(GNULIB_UNISTD_H_NONBLOCKING)/g' \
-e 's/@''GNULIB_UNISTD_H_SIGPIPE''@/$(GNULIB_UNISTD_H_SIGPIPE)/g' \
-e 's/@''GNULIB_UNLINK''@/$(GNULIB_UNLINK)/g' \
@@ -1698,6 +1928,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_PWRITE''@|$(HAVE_PWRITE)|g' \
-e 's|@''HAVE_READLINK''@|$(HAVE_READLINK)|g' \
-e 's|@''HAVE_READLINKAT''@|$(HAVE_READLINKAT)|g' \
+ -e 's|@''HAVE_SETHOSTNAME''@|$(HAVE_SETHOSTNAME)|g' \
-e 's|@''HAVE_SLEEP''@|$(HAVE_SLEEP)|g' \
-e 's|@''HAVE_SYMLINK''@|$(HAVE_SYMLINK)|g' \
-e 's|@''HAVE_SYMLINKAT''@|$(HAVE_SYMLINKAT)|g' \
@@ -1710,6 +1941,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_DECL_GETLOGIN_R''@|$(HAVE_DECL_GETLOGIN_R)|g' \
-e 's|@''HAVE_DECL_GETPAGESIZE''@|$(HAVE_DECL_GETPAGESIZE)|g' \
-e 's|@''HAVE_DECL_GETUSERSHELL''@|$(HAVE_DECL_GETUSERSHELL)|g' \
+ -e 's|@''HAVE_DECL_SETHOSTNAME''@|$(HAVE_DECL_SETHOSTNAME)|g' \
-e 's|@''HAVE_DECL_TTYNAME_R''@|$(HAVE_DECL_TTYNAME_R)|g' \
-e 's|@''HAVE_OS_H''@|$(HAVE_OS_H)|g' \
-e 's|@''HAVE_SYS_PARAM_H''@|$(HAVE_SYS_PARAM_H)|g' \
@@ -1719,11 +1951,13 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''REPLACE_DUP''@|$(REPLACE_DUP)|g' \
-e 's|@''REPLACE_DUP2''@|$(REPLACE_DUP2)|g' \
-e 's|@''REPLACE_FCHOWNAT''@|$(REPLACE_FCHOWNAT)|g' \
+ -e 's|@''REPLACE_FTRUNCATE''@|$(REPLACE_FTRUNCATE)|g' \
-e 's|@''REPLACE_GETCWD''@|$(REPLACE_GETCWD)|g' \
-e 's|@''REPLACE_GETDOMAINNAME''@|$(REPLACE_GETDOMAINNAME)|g' \
-e 's|@''REPLACE_GETLOGIN_R''@|$(REPLACE_GETLOGIN_R)|g' \
-e 's|@''REPLACE_GETGROUPS''@|$(REPLACE_GETGROUPS)|g' \
-e 's|@''REPLACE_GETPAGESIZE''@|$(REPLACE_GETPAGESIZE)|g' \
+ -e 's|@''REPLACE_ISATTY''@|$(REPLACE_ISATTY)|g' \
-e 's|@''REPLACE_LCHOWN''@|$(REPLACE_LCHOWN)|g' \
-e 's|@''REPLACE_LINK''@|$(REPLACE_LINK)|g' \
-e 's|@''REPLACE_LINKAT''@|$(REPLACE_LINKAT)|g' \
diff --git a/autogen/aclocal.m4 b/autogen/aclocal.m4
index 98a0e905b08..f423953b3c8 100644
--- a/autogen/aclocal.m4
+++ b/autogen/aclocal.m4
@@ -987,33 +987,51 @@ AC_SUBST([am__untar])
m4_include([m4/00gnulib.m4])
m4_include([m4/alloca.m4])
m4_include([m4/c-strtod.m4])
+m4_include([m4/clock_time.m4])
+m4_include([m4/close-stream.m4])
m4_include([m4/dup2.m4])
+m4_include([m4/environ.m4])
+m4_include([m4/euidaccess.m4])
+m4_include([m4/execinfo.m4])
m4_include([m4/extensions.m4])
+m4_include([m4/extern-inline.m4])
+m4_include([m4/faccessat.m4])
+m4_include([m4/fcntl_h.m4])
m4_include([m4/filemode.m4])
+m4_include([m4/fpending.m4])
+m4_include([m4/getgroups.m4])
m4_include([m4/getloadavg.m4])
m4_include([m4/getopt.m4])
-m4_include([m4/gl-comp.m4])
+m4_include([m4/gettime.m4])
+m4_include([m4/gettimeofday.m4])
m4_include([m4/gnulib-common.m4])
+m4_include([m4/gnulib-comp.m4])
+m4_include([m4/group-member.m4])
m4_include([m4/include_next.m4])
m4_include([m4/inttypes.m4])
m4_include([m4/largefile.m4])
m4_include([m4/longlong.m4])
m4_include([m4/lstat.m4])
+m4_include([m4/manywarnings.m4])
m4_include([m4/md5.m4])
m4_include([m4/mktime.m4])
m4_include([m4/multiarch.m4])
m4_include([m4/nocrash.m4])
+m4_include([m4/off_t.m4])
+m4_include([m4/pathmax.m4])
+m4_include([m4/pselect.m4])
m4_include([m4/pthread_sigmask.m4])
m4_include([m4/readlink.m4])
m4_include([m4/sha1.m4])
m4_include([m4/sha256.m4])
m4_include([m4/sha512.m4])
m4_include([m4/signal_h.m4])
-m4_include([m4/signalblocking.m4])
m4_include([m4/socklen.m4])
m4_include([m4/ssize_t.m4])
m4_include([m4/st_dm_mode.m4])
+m4_include([m4/stat-time.m4])
m4_include([m4/stat.m4])
+m4_include([m4/stdalign.m4])
m4_include([m4/stdarg.m4])
m4_include([m4/stdbool.m4])
m4_include([m4/stddef_h.m4])
@@ -1026,9 +1044,18 @@ m4_include([m4/strtoll.m4])
m4_include([m4/strtoull.m4])
m4_include([m4/strtoumax.m4])
m4_include([m4/symlink.m4])
+m4_include([m4/sys_select_h.m4])
+m4_include([m4/sys_socket_h.m4])
m4_include([m4/sys_stat_h.m4])
+m4_include([m4/sys_time_h.m4])
m4_include([m4/time_h.m4])
m4_include([m4/time_r.m4])
+m4_include([m4/timer_time.m4])
+m4_include([m4/timespec.m4])
m4_include([m4/tm_gmtoff.m4])
m4_include([m4/unistd_h.m4])
+m4_include([m4/utimbuf.m4])
+m4_include([m4/utimens.m4])
+m4_include([m4/utimes.m4])
+m4_include([m4/warnings.m4])
m4_include([m4/wchar_t.m4])
diff --git a/autogen/config.in b/autogen/config.in
index fde44761db4..c0fb1f34bf4 100644
--- a/autogen/config.in
+++ b/autogen/config.in
@@ -1,8 +1,8 @@
-/* src/config.in. Generated from configure.in by autoheader. */
+/* src/config.in. Generated from configure.ac by autoheader. */
/* GNU Emacs site configuration template file.
-Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2011
+Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -31,6 +31,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define if building universal (internal helper macro) */
#undef AC_APPLE_UNIVERSAL_BUILD
+/* Define to use the convention that & in the full name stands for the login
+ id. */
+#undef AMPERSAND_FULL_NAME
+
/* Define to the number of bits in type 'ptrdiff_t'. */
#undef BITSIZEOF_PTRDIFF_T
@@ -46,20 +50,75 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to the number of bits in type 'wint_t'. */
#undef BITSIZEOF_WINT_T
+/* Define if get_current_dir_name should not be used. */
+#undef BROKEN_GET_CURRENT_DIR_NAME
+
+/* Define on FreeBSD to work around an issue when reading from a PTY. */
+#undef BROKEN_PTY_READ_AFTER_EAGAIN
+
+/* Define if the system is compatible with BSD 4.2. */
+#undef BSD4_2
+
+/* Define if the system is compatible with BSD 4.2. */
+#undef BSD_SYSTEM
+
+/* Define if AH_BOTTOM should change BSD_SYSTEM. */
+#undef BSD_SYSTEM_AHB
+
/* Define if Emacs cannot be dumped on your system. */
#undef CANNOT_DUMP
-/* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP
- systems. This function is required for `alloca.c' support on those systems.
+/* Define this to enable compile time checks for the Lisp_Object data type. */
+#undef CHECK_LISP_OBJECT_TYPE
+
+/* Define if you want lock files to be written, so that Emacs can tell
+ instantly when you try to modify a file that someone else has modified in
+ his/her Emacs. */
+#undef CLASH_DETECTION
+
+/* Short copyright string for this version of Emacs. */
+#undef COPYRIGHT
+
+/* Define to one of '_getb67', 'GETB67', 'getb67' for Cray-2 and Cray-YMP
+ systems. This function is required for 'alloca.c' support on those systems.
*/
#undef CRAY_STACKSEG_END
-/* Define to 1 if using `alloca.c'. */
+/* Define if the system is Cygwin. */
+#undef CYGWIN
+
+/* Define to 1 if using 'alloca.c'. */
#undef C_ALLOCA
+/* Define if the system is Darwin. */
+#undef DARWIN_OS
+
+/* Extra bits to be or'd in with any pointers stored in a Lisp_Object. */
+#undef DATA_SEG_BITS
+
+/* Address of the start of the data segment. */
+#undef DATA_START
+
+/* Name of the default sound device. */
+#undef DEFAULT_SOUND_DEVICE
+
+/* Character that separates a device in a file name. */
+#undef DEVICE_SEP
+
/* Define to 1 for DGUX with <sys/dg_sys_info.h>. */
#undef DGUX
+/* Character that separates directories in a file name. */
+#undef DIRECTORY_SEP
+
+/* Define if process.c does not need to close a pty to make it a controlling
+ terminal (it is already a controlling terminal of the subprocess, because
+ we did ioctl TIOCSCTTY). */
+#undef DONT_REOPEN_PTY
+
+/* Define if the system is MS DOS or MS Windows. */
+#undef DOS_NT
+
/* Define to 1 if you are using the GNU C Library. */
#undef DOUG_LEA_MALLOC
@@ -69,9 +128,24 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to the options passed to configure. */
#undef EMACS_CONFIG_OPTIONS
-/* Enable expensive run-time checking of data types? */
+/* Define to 1 if expensive run-time data type and consistency checks are
+ enabled. */
#undef ENABLE_CHECKING
+/* Letter to use in finding device name of first PTY, if PTYs are supported.
+ */
+#undef FIRST_PTY_LETTER
+
+/* Enable compile-time and run-time bounds-checking, and some warnings,
+ without upsetting glibc 2.15+. */
+ #if !defined _FORTIFY_SOURCE && defined __OPTIMIZE__ && __OPTIMIZE__
+ # define _FORTIFY_SOURCE 2
+ #endif
+
+
+/* Define to 1 if futimesat mishandles a NULL file name. */
+#undef FUTIMESAT_NULL_BUG
+
/* Define this to check for errors in cons list. */
#undef GC_CHECK_CONS_LIST
@@ -86,18 +160,67 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define this to check for short string overrun. */
#undef GC_CHECK_STRING_OVERRUN
-/* Define to 1 if the `getpgrp' function requires zero arguments. */
-#undef GETPGRP_VOID
+/* Mark a secondary stack, like the register stack on the ia64. */
+#undef GC_MARK_SECONDARY_STACK
+
+/* Define to GC_USE_GCPROS_AS_BEFORE if conservative garbage collection is not
+ known to work. */
+#undef GC_MARK_STACK
+
+/* Define if setjmp is known to save all registers relevant for conservative
+ garbage collection in the jmp_buf. */
+#undef GC_SETJMP_WORKS
+
+/* Define to the type of elements in the array set by `getgroups'. Usually
+ this is either `int' or `gid_t'. */
+#undef GETGROUPS_T
+
+/* Define this to 1 if getgroups(0,NULL) does not return the number of groups.
+ */
+#undef GETGROUPS_ZERO_BUG
-/* Define to 1 if gettimeofday accepts only one argument. */
-#undef GETTIMEOFDAY_ONE_ARGUMENT
+/* Define if gettimeofday clobbers the localtime buffer. */
+#undef GETTIMEOFDAY_CLOBBERS_LOCALTIME
-/* Define to make the limit macros in <stdint.h> visible. */
-#undef GL_TRIGGER_STDC_LIMIT_MACROS
+/* Define this to 'void' or 'struct timezone' to match the system's
+ declaration of the second argument to gettimeofday. */
+#undef GETTIMEOFDAY_TIMEZONE
+
+/* Define this to enable glyphs debugging code. */
+#undef GLYPH_DEBUG
+
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module close-stream shall be considered present. */
+#undef GNULIB_CLOSE_STREAM
+
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module faccessat shall be considered present. */
+#undef GNULIB_FACCESSAT
+
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module fscanf shall be considered present. */
+#undef GNULIB_FSCANF
+
+/* enable some gnulib portability checks */
+#undef GNULIB_PORTCHECK
+
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module scanf shall be considered present. */
+#undef GNULIB_SCANF
+
+/* Define if ths system is compatible with GNU/Linux. */
+#undef GNU_LINUX
/* Define to 1 if you want to use the GNU memory allocator. */
#undef GNU_MALLOC
+/* Define to set the G_SLICE environment variable to "always-malloc" at
+ startup, if using GTK. */
+#undef G_SLICE_ALWAYS_MALLOC
+
+/* Define to 1 if you have the `access' function. */
+#undef HAVE_ACCESS
+
/* Define to 1 if the file /usr/lpp/X11/bin/smt.exp exists. */
#undef HAVE_AIX_SMT_EXP
@@ -115,23 +238,20 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if ALSA is available. */
#undef HAVE_ALSA
-/* Define to 1 if GCC-style __attribute__ ((__aligned__ (expr))) works. */
-#undef HAVE_ATTRIBUTE_ALIGNED
-
/* Define to 1 if strtold conforms to C99. */
#undef HAVE_C99_STRTOLD
-/* Define to 1 if you have the `cbrt' function. */
-#undef HAVE_CBRT
-
/* Define to 1 if you have the `cfmakeraw' function. */
#undef HAVE_CFMAKERAW
/* Define to 1 if you have the `cfsetspeed' function. */
#undef HAVE_CFSETSPEED
-/* Define to 1 if you have the `closedir' function. */
-#undef HAVE_CLOSEDIR
+/* Define to 1 if you have the `clock_gettime' function. */
+#undef HAVE_CLOCK_GETTIME
+
+/* Define to 1 if you have the `clock_settime' function. */
+#undef HAVE_CLOCK_SETTIME
/* Define to 1 if you have the <coff.h> header file. */
#undef HAVE_COFF_H
@@ -145,6 +265,21 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if using D-Bus. */
#undef HAVE_DBUS
+/* Define to 1 if you have the `dbus_type_is_valid' function. */
+#undef HAVE_DBUS_TYPE_IS_VALID
+
+/* Define to 1 if you have the `dbus_validate_bus_name' function. */
+#undef HAVE_DBUS_VALIDATE_BUS_NAME
+
+/* Define to 1 if you have the `dbus_validate_interface' function. */
+#undef HAVE_DBUS_VALIDATE_INTERFACE
+
+/* Define to 1 if you have the `dbus_validate_member' function. */
+#undef HAVE_DBUS_VALIDATE_MEMBER
+
+/* Define to 1 if you have the `dbus_validate_path' function. */
+#undef HAVE_DBUS_VALIDATE_PATH
+
/* Define to 1 if you have the `dbus_watch_get_unix_fd' function. */
#undef HAVE_DBUS_WATCH_GET_UNIX_FD
@@ -184,6 +319,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
*/
#undef HAVE_DECL_TZNAME
+/* Define to 1 if you have the declaration of `__fpending', and to 0 if you
+ don't. */
+#undef HAVE_DECL___FPENDING
+
/* Define to 1 if you have the declaration of `__sys_siglist', and to 0 if you
don't. */
#undef HAVE_DECL___SYS_SIGLIST
@@ -197,44 +336,53 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `difftime' function. */
#undef HAVE_DIFFTIME
-/* Define to 1 if you have the <dirent.h> header file. */
-#undef HAVE_DIRENT_H
-
/* Define to 1 if you have the 'dup2' function. */
#undef HAVE_DUP2
+/* Define to 1 if you have the `eaccess' function. */
+#undef HAVE_EACCESS
+
+/* Define to 1 if you have the `endgrent' function. */
+#undef HAVE_ENDGRENT
+
+/* Define to 1 if you have the `endpwent' function. */
+#undef HAVE_ENDPWENT
+
+/* Define if you have the declaration of environ. */
+#undef HAVE_ENVIRON_DECL
+
/* Define to 1 if you have the `euidaccess' function. */
#undef HAVE_EUIDACCESS
-/* Define to 1 if you have the <fcntl.h> header file. */
-#undef HAVE_FCNTL_H
+/* Define to 1 if you have the <execinfo.h> header file. */
+#undef HAVE_EXECINFO_H
-/* Define to 1 if you have the `fmod' function. */
-#undef HAVE_FMOD
+/* Define to 1 if you have the `faccessat' function. */
+#undef HAVE_FACCESSAT
/* Define to 1 if you have the `fork' function. */
#undef HAVE_FORK
-/* Define to 1 if you have the `fpathconf' function. */
-#undef HAVE_FPATHCONF
-
/* Define to 1 if you have the `freeifaddrs' function. */
#undef HAVE_FREEIFADDRS
/* Define to 1 if using the freetype and fontconfig libraries. */
#undef HAVE_FREETYPE
-/* Define to 1 if you have the `frexp' function. */
-#undef HAVE_FREXP
-
/* Define to 1 if fseeko (and presumably ftello) exists and is declared. */
#undef HAVE_FSEEKO
/* Define to 1 if you have the `fsync' function. */
#undef HAVE_FSYNC
-/* Define to 1 if you have the `ftime' function. */
-#undef HAVE_FTIME
+/* Define to 1 if you have the `futimens' function. */
+#undef HAVE_FUTIMENS
+
+/* Define to 1 if you have the `futimes' function. */
+#undef HAVE_FUTIMES
+
+/* Define to 1 if you have the `futimesat' function. */
+#undef HAVE_FUTIMESAT
/* Define to 1 if you have the `gai_strerror' function. */
#undef HAVE_GAI_STRERROR
@@ -245,14 +393,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `getaddrinfo' function. */
#undef HAVE_GETADDRINFO
-/* Define to 1 if you have the `getcwd' function. */
-#undef HAVE_GETCWD
-
/* Define to 1 if you have the `getdelim' function. */
#undef HAVE_GETDELIM
-/* Define to 1 if you have the `getdomainname' function. */
-#undef HAVE_GETDOMAINNAME
+/* Define to 1 if you have the `getgrent' function. */
+#undef HAVE_GETGRENT
+
+/* Define to 1 if your system has a working `getgroups' function. */
+#undef HAVE_GETGROUPS
/* Define to 1 if you have the `gethostname' function. */
#undef HAVE_GETHOSTNAME
@@ -278,6 +426,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `getpt' function. */
#undef HAVE_GETPT
+/* Define to 1 if you have the `getpwent' function. */
+#undef HAVE_GETPWENT
+
/* Define to 1 if you have the `getrlimit' function. */
#undef HAVE_GETRLIMIT
@@ -287,15 +438,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `getsockname' function. */
#undef HAVE_GETSOCKNAME
-/* Define to 1 if you have the `getsockopt' function. */
-#undef HAVE_GETSOCKOPT
-
/* Define to 1 if you have the `gettimeofday' function. */
#undef HAVE_GETTIMEOFDAY
-/* Define to 1 if you have the `getwd' function. */
-#undef HAVE_GETWD
-
/* Define to 1 if you have the `get_current_dir_name' function. */
#undef HAVE_GET_CURRENT_DIR_NAME
@@ -420,6 +565,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `dnet' library (-ldnet). */
#undef HAVE_LIBDNET
+/* Define to 1 if you have the <libgen.h> header file. */
+#undef HAVE_LIBGEN_H
+
/* Define to 1 if you have the hesiod library (-lhesiod). */
#undef HAVE_LIBHESIOD
@@ -447,9 +595,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `mail' library (-lmail). */
#undef HAVE_LIBMAIL
-/* Define to 1 if you have the `ncurses' library (-lncurses). */
-#undef HAVE_LIBNCURSES
-
/* Define to 1 if using libotf. */
#undef HAVE_LIBOTF
@@ -480,19 +625,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the <linux/version.h> header file. */
#undef HAVE_LINUX_VERSION_H
-/* Define to 1 if you have the <locale.h> header file. */
-#undef HAVE_LOCALE_H
-
/* Define to 1 if you have the `localtime_r' function. */
#undef HAVE_LOCALTIME_R
-/* Define to 1 if you have the `logb' function. */
-#undef HAVE_LOGB
-
/* Define to 1 if you support file names longer than 14 characters. */
#undef HAVE_LONG_FILE_NAMES
-/* Define to 1 if the system has the type `long long int'. */
+/* Define to 1 if the system has the type 'long long int'. */
#undef HAVE_LONG_LONG_INT
/* Define to 1 if you have the `lrand48' function. */
@@ -501,6 +640,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `lstat' function. */
#undef HAVE_LSTAT
+/* Define to 1 if you have the `lutimes' function. */
+#undef HAVE_LUTIMES
+
/* Define to 1 if using libm17n-flt. */
#undef HAVE_M17N_FLT
@@ -513,38 +655,26 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `MagickExportImagePixels' function. */
#undef HAVE_MAGICKEXPORTIMAGEPIXELS
+/* Define to 1 if you have the `MagickMergeImageLayers' function. */
+#undef HAVE_MAGICKMERGEIMAGELAYERS
+
/* Define to 1 if you have the <maillock.h> header file. */
#undef HAVE_MAILLOCK_H
/* Define to 1 if you have the <malloc/malloc.h> header file. */
#undef HAVE_MALLOC_MALLOC_H
-/* Define to 1 if you have the `mblen' function. */
-#undef HAVE_MBLEN
-
-/* Define to 1 if you have the `mbrlen' function. */
-#undef HAVE_MBRLEN
-
-/* Define to 1 if you have the `mbsinit' function. */
-#undef HAVE_MBSINIT
-
/* Define to 1 if <wchar.h> declares mbstate_t. */
#undef HAVE_MBSTATE_T
/* Define to 1 if you have the <memory.h> header file. */
#undef HAVE_MEMORY_H
-/* Define to 1 if you have the `mempcpy' function. */
-#undef HAVE_MEMPCPY
-
/* Define to 1 if you have mouse menus. (This is automatic if you use X, but
the option to specify it remains.) It is also defined with other window
systems that support xmenu.c. */
#undef HAVE_MENUS
-/* Define to 1 if you have the `mkdir' function. */
-#undef HAVE_MKDIR
-
/* Define to 1 if you have the `mkstemp' function. */
#undef HAVE_MKSTEMP
@@ -554,8 +684,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define if you have mouse support. */
#undef HAVE_MOUSE
-/* Define to 1 if you have the `mremap' function. */
-#undef HAVE_MREMAP
+/* Define to 1 if you have the `nanotime' function. */
+#undef HAVE_NANOTIME
/* Define to 1 if you have the <net/if_dl.h> header file. */
#undef HAVE_NET_IF_DL_H
@@ -570,6 +700,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
Mac OS X. */
#undef HAVE_NS
+/* Define to use native MS Windows GUI. */
+#undef HAVE_NTGUI
+
/* Define to 1 if libotf has OTF_get_variation_glyphs. */
#undef HAVE_OTF_GET_VARIATION_GLYPHS
@@ -585,6 +718,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `posix_memalign' function. */
#undef HAVE_POSIX_MEMALIGN
+/* Define to 1 if you have the `posix_openpt' function. */
+#undef HAVE_POSIX_OPENPT
+
+/* Define if you have the /proc filesystem. */
+#undef HAVE_PROCFS
+
+/* Define to 1 if you have the `pselect' function. */
+#undef HAVE_PSELECT
+
/* Define to 1 if you have the `pstat_getdynamic' function. */
#undef HAVE_PSTAT_GETDYNAMIC
@@ -597,6 +739,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if the pthread_sigmask function can be used (despite bugs). */
#undef HAVE_PTHREAD_SIGMASK
+/* Define if the system supports pty devices. */
+#undef HAVE_PTYS
+
/* Define to 1 if you have the <pty.h> header file. */
#undef HAVE_PTY_H
@@ -615,18 +760,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `recvfrom' function. */
#undef HAVE_RECVFROM
-/* Define to 1 if you have the `rename' function. */
-#undef HAVE_RENAME
-
/* Define to 1 if res_init is available. */
#undef HAVE_RES_INIT
/* Define to 1 if you have the `rint' function. */
#undef HAVE_RINT
-/* Define to 1 if you have the `rmdir' function. */
-#undef HAVE_RMDIR
-
/* Define to 1 if using librsvg. */
#undef HAVE_RSVG
@@ -642,18 +781,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `setlocale' function. */
#undef HAVE_SETLOCALE
-/* Define to 1 if you have the `setpgid' function. */
-#undef HAVE_SETPGID
-
/* Define to 1 if you have the `setrlimit' function. */
#undef HAVE_SETRLIMIT
-/* Define to 1 if you have the `setsid' function. */
-#undef HAVE_SETSID
-
-/* Define to 1 if you have the `setsockopt' function. */
-#undef HAVE_SETSOCKOPT
-
/* Define to 1 if you have the `shutdown' function. */
#undef HAVE_SHUTDOWN
@@ -666,12 +796,19 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if 'wint_t' is a signed integer type. */
#undef HAVE_SIGNED_WINT_T
+/* Define to 1 if sigsetjmp and siglongjmp work. The value of this symbol is
+ irrelevant if HAVE__SETJMP is defined. */
+#undef HAVE_SIGSETJMP
+
/* Define to 1 if the system has the type `sigset_t'. */
#undef HAVE_SIGSET_T
/* Define to 1 if you have the `snprintf' function. */
#undef HAVE_SNPRINTF
+/* Define if the system supports 4.2-compatible sockets. */
+#undef HAVE_SOCKETS
+
/* Define to 1 if you have sound support. */
#undef HAVE_SOUND
@@ -690,9 +827,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the <stdlib.h> header file. */
#undef HAVE_STDLIB_H
-/* Define to 1 if you have the `strerror' function. */
-#undef HAVE_STRERROR
-
/* Define to 1 if you have the <strings.h> header file. */
#undef HAVE_STRINGS_H
@@ -735,10 +869,32 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if `n_un.n_name' is a member of `struct nlist'. */
#undef HAVE_STRUCT_NLIST_N_UN_N_NAME
+/* Define to 1 if `st_atimensec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIMENSEC
+
+/* Define to 1 if `st_atimespec.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC
+
+/* Define to 1 if `st_atim.st__tim.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC
+
+/* Define to 1 if `st_atim.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC
+
+/* Define to 1 if `st_birthtimensec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC
+
+/* Define to 1 if `st_birthtimespec.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC
+
+/* Define to 1 if `st_birthtim.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC
+
/* Define to 1 if `tm_zone' is a member of `struct tm'. */
#undef HAVE_STRUCT_TM_TM_ZONE
-/* Define to 1 if `struct utimbuf' is declared by <utime.h>. */
+/* Define if struct utimbuf is declared -- usually in <utime.h>. Some systems
+ have utime.h but don't declare the struct anywhere. */
#undef HAVE_STRUCT_UTIMBUF
/* Define if struct stat has an st_dm_mode member. */
@@ -750,9 +906,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `sync' function. */
#undef HAVE_SYNC
-/* Define to 1 if you have the `sysinfo' function. */
-#undef HAVE_SYSINFO
-
/* Define to 1 if you have the <sys/bitypes.h> header file. */
#undef HAVE_SYS_BITYPES_H
@@ -762,9 +915,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the <sys/loadavg.h> header file. */
#undef HAVE_SYS_LOADAVG_H
-/* Define to 1 if you have the <sys/mman.h> header file. */
-#undef HAVE_SYS_MMAN_H
-
/* Define to 1 if you have the <sys/param.h> header file. */
#undef HAVE_SYS_PARAM_H
@@ -786,6 +936,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the <sys/systeminfo.h> header file. */
#undef HAVE_SYS_SYSTEMINFO_H
+/* Define to 1 if you have the <sys/timeb.h> header file. */
+#undef HAVE_SYS_TIMEB_H
+
/* Define to 1 if you have the <sys/time.h> header file. */
#undef HAVE_SYS_TIME_H
@@ -804,17 +957,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have <sys/wait.h> that is POSIX.1 compatible. */
#undef HAVE_SYS_WAIT_H
-/* Define to 1 if you have the <sys/_mbstate_t.h> header file. */
-#undef HAVE_SYS__MBSTATE_T_H
-
/* Define to 1 if you have the <term.h> header file. */
#undef HAVE_TERM_H
/* Define to 1 if you have the tiff library (-ltiff). */
#undef HAVE_TIFF
-/* Define to 1 if `struct timeval' is declared by <sys/time.h>. */
-#undef HAVE_TIMEVAL
+/* Define to 1 if you have the `timer_settime' function. */
+#undef HAVE_TIMER_SETTIME
/* Define if struct tm has the tm_gmtoff member. */
#undef HAVE_TM_GMTOFF
@@ -833,18 +983,18 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `tzset' function. */
#undef HAVE_TZSET
-/* Define to 1 if you have the `ualarm' function. */
-#undef HAVE_UALARM
-
/* Define to 1 if you have the <unistd.h> header file. */
#undef HAVE_UNISTD_H
-/* Define to 1 if the system has the type `unsigned long long int'. */
+/* Define to 1 if the system has the type 'unsigned long long int'. */
#undef HAVE_UNSIGNED_LONG_LONG_INT
/* Define to 1 if you have the <util.h> header file. */
#undef HAVE_UTIL_H
+/* Define to 1 if you have the `utimensat' function. */
+#undef HAVE_UTIMENSAT
+
/* Define to 1 if you have the `utimes' function. */
#undef HAVE_UTIMES
@@ -869,9 +1019,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define if you have a window system. */
#undef HAVE_WINDOW_SYSTEM
+/* Define to 1 if you have the <winsock2.h> header file. */
+#undef HAVE_WINSOCK2_H
+
/* Define to 1 if `fork' works. */
#undef HAVE_WORKING_FORK
+/* Define if utimes works properly. */
+#undef HAVE_WORKING_UTIMES
+
/* Define to 1 if `vfork' works. */
#undef HAVE_WORKING_VFORK
@@ -915,9 +1071,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the `XScreenResourceString' function. */
#undef HAVE_XSCREENRESOURCESTRING
-/* Define to 1 if you have the `XSetWMProtocols' function. */
-#undef HAVE_XSETWMPROTOCOLS
-
/* Define if you have usable i18n support. */
#undef HAVE_X_I18N
@@ -930,6 +1083,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if the system has the type `_Bool'. */
#undef HAVE__BOOL
+/* Define to 1 if you have the `_ftime' function. */
+#undef HAVE__FTIME
+
+/* Define to 1 if _setjmp and _longjmp work. */
+#undef HAVE__SETJMP
+
/* Define to 1 if you have the `__builtin_unwind_init' function. */
#undef HAVE___BUILTIN_UNWIND_INIT
@@ -942,6 +1101,27 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to support using a Hesiod database to find the POP server. */
#undef HESIOD
+/* Define if the system is HPUX. */
+#undef HPUX
+
+/* This is substituted when $TERM is "internal". */
+#undef INTERNAL_TERMINAL
+
+/* Define to read input using SIGIO. */
+#undef INTERRUPT_INPUT
+
+/* Define if the system is IRIX. */
+#undef IRIX6_5
+
+/* Returns true if character is any form of separator. */
+#undef IS_ANY_SEP
+
+/* Returns true if character is a device separator. */
+#undef IS_DEVICE_SEP
+
+/* Returns true if character is a directory separator. */
+#undef IS_DIRECTORY_SEP
+
/* Define to support Kerberos-authenticated POP mail retrieval. */
#undef KERBEROS
@@ -951,7 +1131,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if localtime caches TZ. */
#undef LOCALTIME_CACHE
-/* Define to 1 if `lstat' dereferences a symlink specified with a trailing
+/* Define to 1 if 'lstat' dereferences a symlink specified with a trailing
slash. */
#undef LSTAT_FOLLOWS_SLASHED_SYMLINK
@@ -973,12 +1153,22 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to support POP mail retrieval. */
#undef MAIL_USE_POP
-/* Define to 1 if you don't have struct exception in math.h. */
-#undef NO_MATHERR
+/* Define if the system is MS DOS. */
+#undef MSDOS
+
+/* Define if system's imake configuration file defines `NeedWidePrototypes' as
+ `NO'. */
+#undef NARROWPROTO
+
+/* Define if XEditRes should not be used. */
+#undef NO_EDITRES
/* Define to 1 if your C compiler doesn't accept -c and -o together. */
#undef NO_MINUS_C_MINUS_O
+/* Minimum value of NSIG. */
+#undef NSIG_MINIMUM
+
/* Define to 1 if `NSInteger' is defined. */
#undef NS_HAVE_NSINTEGER
@@ -988,6 +1178,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you are using NS windowing under GNUstep. */
#undef NS_IMPL_GNUSTEP
+/* Name of the file to open to get a null file, or a data sink. */
+#undef NULL_DEVICE
+
/* Define to 1 if the nlist n_name member is a pointer */
#undef N_NAME_POINTER
@@ -1015,12 +1208,16 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to the version of this package. */
#undef PACKAGE_VERSION
-/* Define as `void' if your compiler accepts `void *'; otherwise define as
- `char'. */
-#undef POINTER_TYPE
+/* the number of pending output bytes on stream 'fp' */
+#undef PENDING_OUTPUT_N_BYTES
+
+/* Define to empty to suppress deprecation warnings when building with
+ --enable-gcc-warnings and with libpng versions before 1.5, which lack
+ png_longjmp. */
+#undef PNG_DEPSTRUCT
-/* Define to 1 if the C compiler supports function prototypes. */
-#undef PROTOTYPES
+/* Define if process_send_signal should use VSUSP instead of VSWTCH. */
+#undef PREFER_VSUSP
/* Define to 1 if pthread_sigmask(), when it fails, returns -1 and sets errno.
*/
@@ -1036,6 +1233,18 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
'ptrdiff_t'. */
#undef PTRDIFF_T_SUFFIX
+/* How to iterate over PTYs. */
+#undef PTY_ITERATION
+
+/* How to get the device name of the control end of a PTY, if non-standard. */
+#undef PTY_NAME_SPRINTF
+
+/* How to open a PTY, if non-standard. */
+#undef PTY_OPEN
+
+/* How to get device name of the tty end of a PTY, if non-standard. */
+#undef PTY_TTY_NAME_SPRINTF
+
/* Define to 1 if readlink fails to recognize a trailing slash. */
#undef READLINK_TRAILING_SLASH_BUG
@@ -1051,6 +1260,18 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
slash */
#undef REPLACE_FUNC_STAT_FILE
+/* Define if emacs.c needs to call run_time_remap; for HPUX. */
+#undef RUN_TIME_REMAP
+
+/* Character that separates PATH elements. */
+#undef SEPCHAR
+
+/* How to set up a slave PTY, if needed. */
+#undef SETUP_SLAVE_PTY
+
+/* Make process_send_signal work by "typing" a signal character on the pty. */
+#undef SIGNALS_VIA_CHARACTERS
+
/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
'sig_atomic_t'. */
#undef SIG_ATOMIC_T_SUFFIX
@@ -1059,6 +1280,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
'size_t'. */
#undef SIZE_T_SUFFIX
+/* Define if the system is Solaris. */
+#undef SOLARIS2
+
/* If using the C implementation of alloca, define if you know the
direction of stack growth for your system; otherwise it will be
automatically deduced at runtime.
@@ -1076,21 +1300,40 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 on System V Release 4. */
#undef SVR4
-/* Process async input synchronously. */
-#undef SYNC_INPUT
-
/* Define to use system malloc. */
#undef SYSTEM_MALLOC
+/* The type of system you are compiling for; sets `system-type'. */
+#undef SYSTEM_TYPE
+
+/* Undocumented. */
+#undef TAB3
+
+/* Undocumented. */
+#undef TABDLY
+
/* Define to 1 if you use terminfo instead of termcap. */
#undef TERMINFO
+/* Define to the header for the built-in window system. */
+#undef TERM_HEADER
+
/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. */
#undef TIME_WITH_SYS_TIME
+/* Some platforms redefine this. */
+#undef TIOCSIGSEND
+
/* Define to 1 if your <sys/time.h> declares `struct tm'. */
#undef TM_IN_SYS_TIME
+/* Define to 1 if the type of the st_atim member of a struct stat is struct
+ timespec. */
+#undef TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC
+
+/* Undocumented. */
+#undef ULIMIT_BREAK_VALUE
+
/* Define to 1 for Encore UMAX. */
#undef UMAX
@@ -1098,12 +1341,21 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
<sys/cpustats.h>. */
#undef UMAX4_3
+/* Define if the system has Unix98 PTYs. */
+#undef UNIX98_PTYS
+
+/* Define to 1 if FIONREAD is usable. */
+#undef USABLE_FIONREAD
+
+/* Define to 1 if SIGIO is usable. */
+#undef USABLE_SIGIO
+
+/* How to get a user's full name. */
+#undef USER_FULL_NAME
+
/* Define to 1 if using GTK. */
#undef USE_GTK
-/* Define this to use a lisp union for the Lisp_Object data type. */
-#undef USE_LISP_UNION_TYPE
-
/* Define to 1 if using the Lucid X toolkit. */
#undef USE_LUCID
@@ -1122,6 +1374,19 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if using an X toolkit. */
#undef USE_X_TOOLKIT
+/* Define if the system is compatible with System III. */
+#undef USG
+
+/* Define if the system is compatible with System V. */
+#undef USG5
+
+/* Define if the system is compatible with System V Release 4. */
+#undef USG5_4
+
+/* Define for USG systems where it works to open a pty's tty in the parent
+ process, then close and reopen it in the child. */
+#undef USG_SUBTTY_WORKS
+
/* Version number of package */
#undef VERSION
@@ -1151,10 +1416,16 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define this to check for malloc buffer overrun. */
#undef XMALLOC_OVERRUN_CHECK
+/* Compensate for a bug in Xos.h on some systems, where it requires time.h. */
+#undef XOS_NEEDS_TIME_H
+
/* Define to the type of the 6th arg of XRegisterIMInstantiateCallback, either
XPointer or XPointer*. */
#undef XRegisterIMInstantiateCallback_arg6
+/* Define if the system is AIX. */
+#undef _AIX
+
/* Enable large inode numbers on Mac OS X. */
#ifndef _DARWIN_USE_64_BIT_INODE
# define _DARWIN_USE_64_BIT_INODE 1
@@ -1163,6 +1434,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Number of bits in a file offset, on hosts where this is settable. */
#undef _FILE_OFFSET_BITS
+/* Define to 1 if Gnulib overrides 'struct stat' on Windows so that struct
+ stat.st_size becomes 64-bit. */
+#undef _GL_WINDOWS_64_BIT_ST_SIZE
+
/* Define to 1 to make fseeko visible on some hosts (e.g. glibc 2.2). */
#undef _LARGEFILE_SOURCE
@@ -1175,12 +1450,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define if GNUstep uses ObjC exceptions. */
#undef _NATIVE_OBJC_EXCEPTIONS
-/* The _Noreturn keyword of draft C1X. */
-#ifndef _Noreturn
+/* The _Noreturn keyword of C11. */
+#if ! (defined _Noreturn \
+ || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__))
# if (3 <= __GNUC__ || (__GNUC__ == 2 && 8 <= __GNUC_MINOR__) \
|| 0x5110 <= __SUNPRO_C)
# define _Noreturn __attribute__ ((__noreturn__))
-# elif 1200 <= _MSC_VER
+# elif defined _MSC_VER && 1200 <= _MSC_VER
# define _Noreturn __declspec (noreturn)
# else
# define _Noreturn
@@ -1192,9 +1468,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
this defined. */
#undef _POSIX_1_SOURCE
-/* Define to 1 if you need to in order for `stat' and other things to work. */
+/* Define to 1 if you need to in order for 'stat' and other things to work. */
#undef _POSIX_SOURCE
+/* Needed for system_process_attributes on Solaris. */
+#undef _STRUCTURED_PROC
+
/* Define to 500 only on HP-UX. */
#undef _XOPEN_SOURCE
@@ -1202,7 +1481,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef _ALL_SOURCE
# undef _ALL_SOURCE
#endif
-/* Enable general extensions on MacOS X. */
+/* Enable general extensions on Mac OS X. */
#ifndef _DARWIN_C_SOURCE
# undef _DARWIN_C_SOURCE
#endif
@@ -1228,32 +1507,66 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
used. */
#undef __GETOPT_PREFIX
-/* Define like PROTOTYPES; this can be used by system headers. */
-#undef __PROTOTYPES
-
-/* Ensure that <stdint.h> defines the limit macros, since gnulib's
- <inttypes.h> relies on them. */
-#if defined __cplusplus && !defined __STDC_LIMIT_MACROS && GL_TRIGGER_STDC_LIMIT_MACROS
-# define __STDC_LIMIT_MACROS 1
-#endif
-
-
/* Define to compiler's equivalent of C99 restrict keyword in array
declarations. Define as empty for no equivalent. */
#undef __restrict_arr
-/* Define to the used machine dependent file. */
-#undef config_machfile
-
-/* Define to the used os dependent file. */
+/* Some platforms that do not use configure define this to include extra
+ configuration information. */
#undef config_opsysfile
-/* Define to empty if `const' does not conform to ANSI C. */
-#undef const
+/* _GL_INLINE is a portable alternative to ISO C99 plain 'inline'.
+ _GL_EXTERN_INLINE is a portable alternative to 'extern inline'.
+ _GL_INLINE_HEADER_BEGIN contains useful stuff to put
+ in an include file, before uses of _GL_INLINE.
+ It suppresses GCC's bogus "no previous prototype for 'FOO'" diagnostic,
+ when FOO is an inline function in the header; see
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54113>.
+ _GL_INLINE_HEADER_END contains useful stuff to put
+ in the same include file, after uses of _GL_INLINE. */
+#if (__GNUC__ \
+ ? defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__ \
+ : 199901L <= __STDC_VERSION__)
+# define _GL_INLINE inline
+# define _GL_EXTERN_INLINE extern inline
+#elif 2 < __GNUC__ + (7 <= __GNUC_MINOR__)
+# if __GNUC_GNU_INLINE__
+ /* __gnu_inline__ suppresses a GCC 4.2 diagnostic. */
+# define _GL_INLINE extern inline __attribute__ ((__gnu_inline__))
+# else
+# define _GL_INLINE extern inline
+# endif
+# define _GL_EXTERN_INLINE extern
+#else
+# define _GL_INLINE static inline
+# define _GL_EXTERN_INLINE static inline
+#endif
+
+#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
+# if defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__
+# define _GL_INLINE_HEADER_CONST_PRAGMA
+# else
+# define _GL_INLINE_HEADER_CONST_PRAGMA \
+ _Pragma ("GCC diagnostic ignored \"-Wsuggest-attribute=const\"")
+# endif
+# define _GL_INLINE_HEADER_BEGIN \
+ _Pragma ("GCC diagnostic push") \
+ _Pragma ("GCC diagnostic ignored \"-Wmissing-prototypes\"") \
+ _Pragma ("GCC diagnostic ignored \"-Wmissing-declarations\"") \
+ _GL_INLINE_HEADER_CONST_PRAGMA
+# define _GL_INLINE_HEADER_END \
+ _Pragma ("GCC diagnostic pop")
+#else
+# define _GL_INLINE_HEADER_BEGIN
+# define _GL_INLINE_HEADER_END
+#endif
/* A replacement for va_copy, if needed. */
#define gl_va_copy(a,b) ((a) = (b))
+/* Define to rpl_gmtime if the replacement function should be used. */
+#undef gmtime
+
/* Define to `__inline__' or `__inline' if that's what the C compiler
calls it, or to nothing if 'inline' is not supported under any name. */
#ifndef __cplusplus
@@ -1263,13 +1576,19 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Work around a bug in Apple GCC 4.0.1 build 5465: In C99 mode, it supports
the ISO C 99 semantics of 'extern inline' (unlike the GNU C semantics of
earlier versions), but does not display it by setting __GNUC_STDC_INLINE__.
- __APPLE__ && __MACH__ test for MacOS X.
+ __APPLE__ && __MACH__ test for Mac OS X.
__APPLE_CC__ tests for the Apple compiler and its version.
__STDC_VERSION__ tests for the C99 mode. */
#if defined __APPLE__ && defined __MACH__ && __APPLE_CC__ >= 5465 && !defined __cplusplus && __STDC_VERSION__ >= 199901L && !defined __GNUC_STDC_INLINE__
# define __GNUC_STDC_INLINE__ 1
#endif
+/* Define to 1 if the compiler is checking for lint. */
+#undef lint
+
+/* Define to rpl_localtime if the replacement function should be used. */
+#undef localtime
+
/* Define to a type if <wchar.h> does not define. */
#undef mbstate_t
@@ -1305,6 +1624,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define as a signed type of the same size as size_t. */
#undef ssize_t
+/* Define to enable asynchronous subprocesses. */
+#undef subprocesses
+
/* Define to any substitute for sys_siglist. */
#undef sys_siglist
@@ -1341,139 +1663,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define as `fork' if `vfork' does not work. */
#undef vfork
-/* Define to empty if the keyword `volatile' does not work. Warning: valid
- code using `volatile' can become incorrect without. Disable with care. */
-#undef volatile
-
-
-/* On AIX 3 this must be included before any other include file. */
-#include <alloca.h>
-#if ! HAVE_ALLOCA
-# error "alloca not available on this machine"
-#endif
-
-/* Define AMPERSAND_FULL_NAME if you use the convention
- that & in the full name stands for the login id. */
-/* Turned on June 1996 supposing nobody will mind it. */
-#define AMPERSAND_FULL_NAME
-
-/* `subprocesses' should be defined if you want to
- have code for asynchronous subprocesses
- (as used in M-x compile and M-x shell).
- Only MSDOS does not support this (it overrides
- this in its config_opsysfile below). */
-
-#define subprocesses
-
-/* Include the os and machine dependent files. */
-#include config_opsysfile
-#ifdef config_machfile
-# include config_machfile
-#endif
-
-/* GNUstep needs a bit more pure memory. Of the existing knobs,
- SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems.
- (There is probably a better place to do this, but right now the
- Cocoa side does this in s/darwin.h and we cannot parallel this
- exactly since GNUstep is multi-OS. */
-#if defined HAVE_NS && defined NS_IMPL_GNUSTEP
-# define SYSTEM_PURESIZE_EXTRA 30000
-#endif
-
-#ifdef emacs /* Don't do this for lib-src. */
-/* Tell regex.c to use a type compatible with Emacs. */
-#define RE_TRANSLATE_TYPE Lisp_Object
-#define RE_TRANSLATE(TBL, C) CHAR_TABLE_TRANSLATE (TBL, C)
-#ifdef make_number
-/* If make_number is a macro, use it. */
-#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0)))
-#else
-/* If make_number is a function, avoid it. */
-#define RE_TRANSLATE_P(TBL) (!(INTEGERP (TBL) && XINT (TBL) == 0))
-#endif
-#endif
-
-/* These default definitions are good for almost all machines.
- Any exceptions should override them in m/MACHINE.h.
- They must be usable in preprocessor conditionals. */
-
-#ifndef BITS_PER_CHAR
-#define BITS_PER_CHAR 8
-#endif
-
-#ifndef BITS_PER_SHORT
-#define BITS_PER_SHORT 16
-#endif
-
-#ifndef BITS_PER_INT
-#define BITS_PER_INT 32
-#endif
-
-#ifndef BITS_PER_LONG
-#ifdef _LP64
-#define BITS_PER_LONG 64
-#else
-#define BITS_PER_LONG 32
-#endif
-#endif
-
-#if !defined BITS_PER_LONG_LONG && HAVE_LONG_LONG_INT
-#define BITS_PER_LONG_LONG 64
-#endif
-
-/* Define if the compiler supports function prototypes. It may do so but
- not define __STDC__ (e.g. DEC C by default) or may define it as zero. */
-#undef PROTOTYPES
-
-#include <string.h>
-#include <stdlib.h>
-
-#if defined __GNUC__ && (__GNUC__ > 2 \
- || (__GNUC__ == 2 && __GNUC_MINOR__ >= 5))
-#define NO_RETURN __attribute__ ((__noreturn__))
-#else
-#define NO_RETURN /* nothing */
-#endif
-
-#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */
-#define NO_INLINE __attribute__((noinline))
-#else
-#define NO_INLINE
-#endif
-
-#if (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1))
-#define EXTERNALLY_VISIBLE __attribute__((externally_visible))
-#else
-#define EXTERNALLY_VISIBLE
-#endif
-
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
-# define ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
-#else
-# define ATTRIBUTE_FORMAT(spec) /* empty */
-#endif
-
-#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__gnu_printf__, formatstring_parameter, first_argument))
-#else
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument))
-#endif
-
-/* Some versions of GNU/Linux define noinline in their headers. */
-#ifdef noinline
-#undef noinline
-#endif
-
-/* These won't be used automatically yet. We also need to know, at least,
- that the stack is continuous. */
-#ifdef __GNUC__
-# ifndef GC_SETJMP_WORKS
- /* GC_SETJMP_WORKS is nearly always appropriate for GCC. */
-# define GC_SETJMP_WORKS 1
-# endif
-#endif
+#include <conf_post.h>
#endif /* EMACS_CONFIG_H */
diff --git a/autogen/configure b/autogen/configure
index 325df38a2df..fbb2efbc860 100755
--- a/autogen/configure
+++ b/autogen/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.65 for emacs 24.0.92.
+# Generated by GNU Autoconf 2.65 for emacs 24.3.50.
#
#
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -549,8 +549,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='emacs'
PACKAGE_TARNAME='emacs'
-PACKAGE_VERSION='24.0.92'
-PACKAGE_STRING='emacs 24.0.92'
+PACKAGE_VERSION='24.3.50'
+PACKAGE_STRING='emacs 24.3.50'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''
@@ -604,12 +604,15 @@ am__EXEEXT_TRUE
LTLIBOBJS
LIBOBJS
SUBDIR_MAKEFILES_IN
+WINDOW_SYSTEM_OBJ
LIB_GCC
LD_FIRSTFLAG
LD_SWITCH_SYSTEM_TEMACS
LIBGNU_LTLIBDEPS
LIBGNU_LIBDEPS
gltests_WITNESS
+gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE
+gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE
gl_GNULIB_ENABLED_verify_FALSE
gl_GNULIB_ENABLED_verify_TRUE
gl_GNULIB_ENABLED_strtoull_FALSE
@@ -618,22 +621,34 @@ gl_GNULIB_ENABLED_strtoll_FALSE
gl_GNULIB_ENABLED_strtoll_TRUE
gl_GNULIB_ENABLED_stat_FALSE
gl_GNULIB_ENABLED_stat_TRUE
-gl_GNULIB_ENABLED_sigprocmask_FALSE
-gl_GNULIB_ENABLED_sigprocmask_TRUE
+gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE
+gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE
+gl_GNULIB_ENABLED_pathmax_FALSE
+gl_GNULIB_ENABLED_pathmax_TRUE
+gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE
+gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE
+gl_GNULIB_ENABLED_getgroups_FALSE
+gl_GNULIB_ENABLED_getgroups_TRUE
+gl_GNULIB_ENABLED_euidaccess_FALSE
+gl_GNULIB_ENABLED_euidaccess_TRUE
gl_GNULIB_ENABLED_dosname_FALSE
gl_GNULIB_ENABLED_dosname_TRUE
LTLIBINTL
LIBINTL
+LIB_EACCESS
+WINDOWS_64_BIT_OFF_T
HAVE_UNISTD_H
NEXT_AS_FIRST_DIRECTIVE_UNISTD_H
NEXT_UNISTD_H
+LIB_TIMER_TIME
PTHREAD_H_DEFINES_STRUCT_TIMESPEC
SYS_TIME_H_DEFINES_STRUCT_TIMESPEC
TIME_H_DEFINES_STRUCT_TIMESPEC
NEXT_AS_FIRST_DIRECTIVE_TIME_H
NEXT_TIME_H
+WINDOWS_64_BIT_ST_SIZE
NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H
NEXT_SYS_STAT_H
NEXT_AS_FIRST_DIRECTIVE_STDLIB_H
@@ -717,7 +732,6 @@ GNULIB_PERROR
GNULIB_PCLOSE
GNULIB_OBSTACK_PRINTF_POSIX
GNULIB_OBSTACK_PRINTF
-GNULIB_GETS
GNULIB_GETLINE
GNULIB_GETDELIM
GNULIB_GETCHAR
@@ -758,8 +772,12 @@ GL_GENERATE_STDARG_H_TRUE
STDARG_H
NEXT_AS_FIRST_DIRECTIVE_STDARG_H
NEXT_STDARG_H
+GL_GENERATE_STDALIGN_H_FALSE
+GL_GENERATE_STDALIGN_H_TRUE
+STDALIGN_H
NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H
NEXT_SIGNAL_H
+LIB_PTHREAD_SIGMASK
REPLACE_RAISE
REPLACE_PTHREAD_SIGMASK
HAVE_SIGHANDLER_T
@@ -776,7 +794,14 @@ GNULIB_SIGPROCMASK
GNULIB_SIGNAL_H_SIGPIPE
GNULIB_RAISE
GNULIB_PTHREAD_SIGMASK
-LIB_PTHREAD_SIGMASK
+HAVE_SYS_SELECT_H
+NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H
+NEXT_SYS_SELECT_H
+REPLACE_SELECT
+REPLACE_PSELECT
+HAVE_PSELECT
+GNULIB_SELECT
+GNULIB_PSELECT
REPLACE_TIMEGM
REPLACE_NANOSLEEP
REPLACE_MKTIME
@@ -831,6 +856,7 @@ PRIPTR_PREFIX
PRI_MACROS_BROKEN
INT64_MAX_EQ_LONG_MAX
INT32_MAX_LT_INTMAX_MAX
+REPLACE_STRTOIMAX
HAVE_DECL_STRTOUMAX
HAVE_DECL_STRTOIMAX
HAVE_DECL_IMAXDIV
@@ -866,14 +892,20 @@ HAVE_INTTYPES_H
HAVE_WCHAR_H
HAVE_UNSIGNED_LONG_LONG_INT
HAVE_LONG_LONG_INT
+HAVE_WINSOCK2_H
+NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H
+NEXT_SYS_TIME_H
+REPLACE_STRUCT_TIMEVAL
+REPLACE_GETTIMEOFDAY
+HAVE_SYS_TIME_H
+HAVE_STRUCT_TIMEVAL
+HAVE_GETTIMEOFDAY
+GNULIB_GETTIMEOFDAY
+GNULIB_GL_UNISTD_H_GETOPT
GETOPT_H
HAVE_GETOPT_H
NEXT_AS_FIRST_DIRECTIVE_GETOPT_H
NEXT_GETOPT_H
-PRAGMA_COLUMNS
-PRAGMA_SYSTEM_HEADER
-INCLUDE_NEXT_AS_FIRST_DIRECTIVE
-INCLUDE_NEXT
GETLOADAVG_LIBS
REPLACE_WCTOMB
REPLACE_UNSETENV
@@ -881,7 +913,10 @@ REPLACE_STRTOD
REPLACE_SETENV
REPLACE_REALPATH
REPLACE_REALLOC
+REPLACE_RANDOM_R
REPLACE_PUTENV
+REPLACE_PTSNAME_R
+REPLACE_PTSNAME
REPLACE_MKSTEMP
REPLACE_MBTOWC
REPLACE_MALLOC
@@ -900,7 +935,10 @@ HAVE_RPMATCH
HAVE_REALPATH
HAVE_RANDOM_R
HAVE_RANDOM_H
+HAVE_RANDOM
+HAVE_PTSNAME_R
HAVE_PTSNAME
+HAVE_POSIX_OPENPT
HAVE_MKSTEMPS
HAVE_MKSTEMP
HAVE_MKOSTEMPS
@@ -924,8 +962,11 @@ GNULIB_RPMATCH
GNULIB_REALPATH
GNULIB_REALLOC_POSIX
GNULIB_RANDOM_R
+GNULIB_RANDOM
GNULIB_PUTENV
+GNULIB_PTSNAME_R
GNULIB_PTSNAME
+GNULIB_POSIX_OPENPT
GNULIB_MKSTEMPS
GNULIB_MKSTEMP
GNULIB_MKOSTEMPS
@@ -940,6 +981,25 @@ GNULIB_CANONICALIZE_FILE_NAME
GNULIB_CALLOC_POSIX
GNULIB_ATOLL
GNULIB__EXIT
+NEXT_AS_FIRST_DIRECTIVE_FCNTL_H
+NEXT_FCNTL_H
+PRAGMA_COLUMNS
+PRAGMA_SYSTEM_HEADER
+INCLUDE_NEXT_AS_FIRST_DIRECTIVE
+INCLUDE_NEXT
+REPLACE_OPENAT
+REPLACE_OPEN
+REPLACE_FCNTL
+HAVE_OPENAT
+HAVE_FCNTL
+GNULIB_OPENAT
+GNULIB_OPEN
+GNULIB_NONBLOCKING
+GNULIB_FCNTL
+GL_GENERATE_EXECINFO_H_FALSE
+GL_GENERATE_EXECINFO_H_TRUE
+LIB_EXECINFO
+EXECINFO_H
UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS
UNISTD_H_HAVE_WINSOCK2_H
REPLACE_WRITE
@@ -958,11 +1018,13 @@ REPLACE_LSEEK
REPLACE_LINKAT
REPLACE_LINK
REPLACE_LCHOWN
+REPLACE_ISATTY
REPLACE_GETPAGESIZE
REPLACE_GETGROUPS
REPLACE_GETLOGIN_R
REPLACE_GETDOMAINNAME
REPLACE_GETCWD
+REPLACE_FTRUNCATE
REPLACE_FCHOWNAT
REPLACE_DUP2
REPLACE_DUP
@@ -971,6 +1033,7 @@ REPLACE_CHOWN
HAVE_SYS_PARAM_H
HAVE_OS_H
HAVE_DECL_TTYNAME_R
+HAVE_DECL_SETHOSTNAME
HAVE_DECL_GETUSERSHELL
HAVE_DECL_GETPAGESIZE
HAVE_DECL_GETLOGIN_R
@@ -983,6 +1046,7 @@ HAVE_UNLINKAT
HAVE_SYMLINKAT
HAVE_SYMLINK
HAVE_SLEEP
+HAVE_SETHOSTNAME
HAVE_READLINKAT
HAVE_READLINK
HAVE_PWRITE
@@ -1014,11 +1078,11 @@ GNULIB_UNLINKAT
GNULIB_UNLINK
GNULIB_UNISTD_H_SIGPIPE
GNULIB_UNISTD_H_NONBLOCKING
-GNULIB_UNISTD_H_GETOPT
GNULIB_TTYNAME_R
GNULIB_SYMLINKAT
GNULIB_SYMLINK
GNULIB_SLEEP
+GNULIB_SETHOSTNAME
GNULIB_RMDIR
GNULIB_READLINKAT
GNULIB_READLINK
@@ -1031,6 +1095,7 @@ GNULIB_LSEEK
GNULIB_LINKAT
GNULIB_LINK
GNULIB_LCHOWN
+GNULIB_ISATTY
GNULIB_GROUP_MEMBER
GNULIB_GETUSERSHELL
GNULIB_GETPAGESIZE
@@ -1055,6 +1120,7 @@ GNULIB_DUP
GNULIB_CLOSE
GNULIB_CHOWN
GNULIB_CHDIR
+LIB_CLOCK_GETTIME
GL_GENERATE_ALLOCA_H_FALSE
GL_GENERATE_ALLOCA_H_TRUE
ALLOCA_H
@@ -1082,10 +1148,8 @@ ns_appsrc
ns_appresdir
ns_appbindir
ns_appdir
-S_FILE
-M_FILE
X_TOOLKIT_TYPE
-C_SWITCH_X_SYSTEM
+GNUSTEP_CFLAGS
C_SWITCH_X_SITE
LD_SWITCH_X_SITE
gameuser
@@ -1096,11 +1160,14 @@ etcdir
x_default_search_path
lisppath
locallisppath
+standardlisppath
+leimdir
lispdir
srcdir
canonical
configuration
version
+copyright
KRB4LIB
DESLIB
KRB5LIB
@@ -1139,6 +1206,8 @@ LIBGNUTLS_CFLAGS
LIBSELINUX_LIBS
SETTINGS_LIBS
SETTINGS_CFLAGS
+GOBJECT_LIBS
+GOBJECT_CFLAGS
GCONF_LIBS
GCONF_CFLAGS
GSETTINGS_LIBS
@@ -1157,20 +1226,23 @@ LIB_PTHREAD
VMLIMIT_OBJ
GMALLOC_OBJ
HAVE_XSERVER
+W32_LIBS
+W32_OBJ
LIB_STANDARD
NS_OBJC_OBJ
NS_OBJ
+ns_self_contained
+INSTALL_ARCH_INDEP_EXTRA
TEMACS_LDFLAGS2
-LD_SWITCH_X_SITE_AUX_RPATH
-LD_SWITCH_X_SITE_AUX
+LD_SWITCH_X_SITE_RPATH
XMKMF
DEPFLAGS
MKDEPDIR
CFLAGS_SOUND
ALSA_LIBS
ALSA_CFLAGS
-PKG_CONFIG
LIBSOUND
+PKG_CONFIG
CRT_DIR
START_FILES
LIB_MATH
@@ -1180,10 +1252,16 @@ UNEXEC_OBJ
C_SWITCH_MACHINE
LD_SWITCH_SYSTEM
CANNOT_DUMP
+INFO_OPTS
+INFO_EXT
HAVE_MAKEINFO
+PAXCTL
GZIP_PROG
INSTALL_INFO
-C_WARNINGS_SWITCH
+LN_S
+GNULIB_WARN_CFLAGS
+WARN_CFLAGS
+WERROR_CFLAGS
RANLIB
ARFLAGS
AR
@@ -1215,7 +1293,6 @@ build_vendor
build_cpu
build
PROFILING_CFLAGS
-MAINT
GZIP_INFO
cache_file
am__untar
@@ -1280,10 +1357,10 @@ PACKAGE_NAME
PATH_SEPARATOR
SHELL'
ac_subst_files='deps_frag
-lisp_frag
-ns_frag'
+lisp_frag'
ac_user_opts='
enable_option_checking
+with_all
with_pop
with_kerberos
with_kerberos5
@@ -1292,7 +1369,6 @@ with_mmdf
with_mail_unlink
with_mailhost
with_sound
-with_sync_input
with_x_toolkit
with_wide_int
with_xpm
@@ -1310,6 +1386,7 @@ with_toolkit_scroll_bars
with_xaw3d
with_xim
with_ns
+with_w32
with_gpm
with_dbus
with_gconf
@@ -1323,15 +1400,15 @@ with_crt_dir
with_gameuser
with_gnustep_conf
enable_ns_self_contained
-enable_asserts
-enable_maintainer_mode
enable_locallisppath
enable_checking
-enable_use_lisp_union_type
+enable_check_lisp_object_type
enable_profiling
enable_autodepend
enable_dependency_tracking
enable_largefile
+enable_gcc_warnings
+enable_link_time_optimization
with_x
'
ac_precious_vars='build_alias
@@ -1885,7 +1962,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures emacs 24.0.92 to adapt to many kinds of systems.
+\`configure' configures emacs 24.3.50 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1959,7 +2036,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of emacs 24.0.92:";;
+ short | recursive ) echo "Configuration of emacs 24.3.50:";;
esac
cat <<\_ACEOF
@@ -1969,10 +2046,6 @@ Optional Features:
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
--disable-ns-self-contained
disable self contained build under NeXTstep
- --enable-asserts compile code with asserts enabled
- --disable-maintainer-mode
- disable make rules and dependencies not useful (and
- sometimes confusing) to the casual installer
--enable-locallisppath=PATH
directories Emacs should search for lisp files
specific to this site
@@ -1980,23 +2053,32 @@ Optional Features:
enable expensive run-time checks. With LIST, enable
only specific categories of checks. Categories are:
all,yes,no. Flags are: stringbytes, stringoverrun,
- stringfreelist, xmallocoverrun, conslist
- --enable-use-lisp-union-type
- use a union for the Lisp_Object data type. This is
- only useful for development for catching certain
- types of bugs.
- --enable-profiling build emacs with profiling support. This might not
- work on all platforms
+ stringfreelist, xmallocoverrun, conslist, glyphs
+ --enable-check-lisp-object-type
+ enable compile time checks for the Lisp_Object data
+ type. This is useful for development for catching
+ certain types of bugs.
+ --enable-profiling build emacs with low-level, gprof profiling support.
+ Mainly useful for debugging Emacs itself. May not
+ work on all platforms. Stops profiler.el working.
--enable-autodepend automatically generate dependencies to .h-files.
Requires GNU Make and Gcc. Enabled if GNU Make and
Gcc is found
--disable-dependency-tracking speeds up one-time build
--enable-dependency-tracking do not reject slow dependency extractors
--disable-largefile omit support for large files
+ --enable-gcc-warnings turn on lots of GCC warnings. This is intended for
+ developers, and may generate false alarms when used
+ with older or non-GNU development tools.
+ --enable-link-time-optimization
+ build emacs with link-time optimization. This is
+ supported only for GCC since 4.5.0.
Optional Packages:
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --without-all omit almost all features and build small executable
+ with minimal dependencies
--without-pop don't support POP mail retrieval with movemail
--with-kerberos support Kerberos-authenticated POP
--with-kerberos5 support Kerberos version 5 authenticated POP
@@ -2006,9 +2088,8 @@ Optional Packages:
--with-mailhost=HOSTNAME
string giving default POP mail host
--without-sound don't compile with sound support
- --without-sync-input process async input synchronously
- --with-x-toolkit=KIT use an X toolkit (KIT one of: yes or gtk, gtk3,
- lucid or athena, motif, no)
+ --with-x-toolkit=KIT use an X toolkit (KIT one of: yes or gtk, gtk2,
+ gtk3, lucid or athena, motif, no)
--with-wide-int prefer wide Emacs integers (typically 62-bit)
--without-xpm don't compile with XPM image support
--without-jpeg don't compile with JPEG image support
@@ -2026,6 +2107,7 @@ Optional Packages:
--without-xaw3d don't use Xaw3d
--without-xim don't use X11 XIM
--with-ns use NeXTstep (Cocoa or GNUstep) windowing system
+ --with-w32 use native MS Windows GUI
--without-gpm don't use -lgpm for mouse support on a GNU/Linux
console
--without-dbus don't compile with D-Bus support
@@ -2122,7 +2204,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-emacs configure 24.0.92
+emacs configure 24.3.50
generated by GNU Autoconf 2.65
Copyright (C) 2009 Free Software Foundation, Inc.
@@ -2485,6 +2567,63 @@ $as_echo "$ac_res" >&6; }
} # ac_fn_c_check_header_preproc
+# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES
+# ----------------------------------------------------
+# Tries to find if the field MEMBER exists in type AGGR, after including
+# INCLUDES, setting cache variable VAR accordingly.
+ac_fn_c_check_member ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5
+$as_echo_n "checking for $2.$3... " >&6; }
+if { as_var=$4; eval "test \"\${$as_var+set}\" = set"; }; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$5
+int
+main ()
+{
+static $2 ac_aggr;
+if (ac_aggr.$3)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$4=yes"
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$5
+int
+main ()
+{
+static $2 ac_aggr;
+if (sizeof ac_aggr.$3)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$4=yes"
+else
+ eval "$4=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$4
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+
+} # ac_fn_c_check_member
+
# ac_fn_c_check_func LINENO FUNC VAR
# ----------------------------------
# Tests whether FUNC exists, setting the cache variable VAR accordingly
@@ -2552,63 +2691,6 @@ $as_echo "$ac_res" >&6; }
} # ac_fn_c_check_func
-# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES
-# ----------------------------------------------------
-# Tries to find if the field MEMBER exists in type AGGR, after including
-# INCLUDES, setting cache variable VAR accordingly.
-ac_fn_c_check_member ()
-{
- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5
-$as_echo_n "checking for $2.$3... " >&6; }
-if { as_var=$4; eval "test \"\${$as_var+set}\" = set"; }; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$5
-int
-main ()
-{
-static $2 ac_aggr;
-if (ac_aggr.$3)
-return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- eval "$4=yes"
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$5
-int
-main ()
-{
-static $2 ac_aggr;
-if (sizeof ac_aggr.$3)
-return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- eval "$4=yes"
-else
- eval "$4=no"
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-eval ac_res=\$$4
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
- eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
-
-} # ac_fn_c_check_member
-
# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
# -------------------------------------------
# Tests whether TYPE exists after having included INCLUDES, setting cache
@@ -2844,7 +2926,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by emacs $as_me 24.0.92, which was
+It was created by emacs $as_me 24.3.50, which was
generated by GNU Autoconf 2.65. Invocation command line was
$ $0 $@
@@ -3123,27 +3205,55 @@ $as_echo "$as_me: creating cache $cache_file" >&6;}
>$cache_file
fi
+as_fn_append ac_header_list " linux/version.h"
+as_fn_append ac_header_list " sys/systeminfo.h"
+as_fn_append ac_header_list " coff.h"
+as_fn_append ac_header_list " pty.h"
+as_fn_append ac_header_list " sys/vlimit.h"
+as_fn_append ac_header_list " sys/resource.h"
+as_fn_append ac_header_list " sys/utsname.h"
+as_fn_append ac_header_list " pwd.h"
+as_fn_append ac_header_list " utmp.h"
+as_fn_append ac_header_list " util.h"
+as_fn_append ac_header_list " sys/socket.h"
as_fn_append ac_header_list " stdlib.h"
as_fn_append ac_header_list " unistd.h"
as_fn_append ac_header_list " sys/param.h"
+as_fn_append ac_header_list " pthread.h"
+as_fn_append ac_header_list " malloc/malloc.h"
+as_fn_append ac_header_list " maillock.h"
+as_fn_append ac_header_list " sys/un.h"
+as_fn_append ac_func_list " tzset"
as_fn_append ac_func_list " readlinkat"
+as_fn_append ac_header_list " execinfo.h"
+as_fn_append ac_func_list " faccessat"
+as_fn_append ac_header_list " stdio_ext.h"
+as_fn_append ac_func_list " __fpending"
gl_getopt_required=GNU
as_fn_append ac_header_list " getopt.h"
+as_fn_append ac_func_list " gettimeofday"
+as_fn_append ac_func_list " nanotime"
+as_fn_append ac_header_list " sys/time.h"
as_fn_append ac_header_list " wchar.h"
as_fn_append ac_header_list " stdint.h"
as_fn_append ac_header_list " inttypes.h"
as_fn_append ac_func_list " lstat"
as_fn_append ac_func_list " alarm"
+as_fn_append ac_header_list " sys/select.h"
+as_fn_append ac_func_list " pselect"
as_fn_append ac_func_list " pthread_sigmask"
as_fn_append ac_func_list " readlink"
-as_fn_append ac_header_list " sys/socket.h"
-as_fn_append ac_func_list " tzset"
as_fn_append ac_func_list " strtoimax"
as_fn_append ac_func_list " strtoumax"
as_fn_append ac_func_list " symlink"
as_fn_append ac_header_list " sys/stat.h"
-as_fn_append ac_header_list " sys/time.h"
as_fn_append ac_func_list " localtime_r"
+as_fn_append ac_header_list " utime.h"
+as_fn_append ac_func_list " futimes"
+as_fn_append ac_func_list " futimesat"
+as_fn_append ac_func_list " futimens"
+as_fn_append ac_func_list " utimensat"
+as_fn_append ac_func_list " lutimes"
# Check that the precious variables saved in the cache have kept the same
# value.
ac_cache_corrupted=false
@@ -3677,7 +3787,7 @@ fi
# Define the identity of the package.
PACKAGE='emacs'
- VERSION='24.0.92'
+ VERSION='24.3.50'
cat >>confdefs.h <<_ACEOF
@@ -3721,22 +3831,33 @@ am__tar='${AMTAR} chof - "$$tardir"'; am__untar='${AMTAR} xf -'
lispdir='${datadir}/emacs/${version}/lisp'
+leimdir='${datadir}/emacs/${version}/leim'
+standardlisppath='${lispdir}:${leimdir}'
locallisppath='${datadir}/emacs/${version}/site-lisp:'\
'${datadir}/emacs/site-lisp'
-lisppath='${locallisppath}:${lispdir}:${datadir}/emacs/${version}/leim'
+lisppath='${locallisppath}:${standardlisppath}'
etcdir='${datadir}/emacs/${version}/etc'
archlibdir='${libexecdir}/emacs/${version}/${configuration}'
docdir='${datadir}/emacs/${version}/etc'
gamedir='${localstatedir}/games/emacs'
+# Check whether --with-all was given.
+if test "${with_all+set}" = set; then :
+ withval=$with_all; with_features=$withval
+else
+ with_features=yes
+fi
+
+
+
# Check whether --with-pop was given.
if test "${with_pop+set}" = set; then :
withval=$with_pop;
else
- with_pop=yes
+ with_pop=$with_features
fi
if test "$with_pop" = yes; then
@@ -3834,25 +3955,11 @@ fi
if test "${with_sound+set}" = set; then :
withval=$with_sound;
else
- with_sound=yes
+ with_sound=$with_features
fi
-# Check whether --with-sync-input was given.
-if test "${with_sync_input+set}" = set; then :
- withval=$with_sync_input;
-else
- with_sync_input=yes
-fi
-
-if test "$with_sync_input" = yes; then
-
-$as_echo "#define SYNC_INPUT 1" >>confdefs.h
-
-fi
-
-
# Check whether --with-x-toolkit was given.
if test "${with_x_toolkit+set}" = set; then :
withval=$with_x_toolkit; case "${withval}" in
@@ -3862,11 +3969,13 @@ if test "${with_x_toolkit+set}" = set; then :
a | at | ath | athe | athen | athena ) val=athena ;;
m | mo | mot | moti | motif ) val=motif ;;
g | gt | gtk ) val=gtk ;;
+ gtk2 ) val=gtk2 ;;
gtk3 ) val=gtk3 ;;
* )
as_fn_error "\`--with-x-toolkit=$withval' is invalid;
-this option's value should be \`yes', \`no', \`lucid', \`athena', \`motif', \`gtk' or
-\`gtk3'. \`yes' and \`gtk' are synonyms. \`athena' and \`lucid' are synonyms." "$LINENO" 5
+this option's value should be \`yes', \`no', \`lucid', \`athena', \`motif', \`gtk',
+\`gtk2' or \`gtk3'. \`yes' and \`gtk' are synonyms.
+\`athena' and \`lucid' are synonyms." "$LINENO" 5
;;
esac
with_x_toolkit=$val
@@ -3893,7 +4002,7 @@ fi
if test "${with_xpm+set}" = set; then :
withval=$with_xpm;
else
- with_xpm=yes
+ with_xpm=$with_features
fi
@@ -3901,7 +4010,7 @@ fi
if test "${with_jpeg+set}" = set; then :
withval=$with_jpeg;
else
- with_jpeg=yes
+ with_jpeg=$with_features
fi
@@ -3909,7 +4018,7 @@ fi
if test "${with_tiff+set}" = set; then :
withval=$with_tiff;
else
- with_tiff=yes
+ with_tiff=$with_features
fi
@@ -3917,7 +4026,7 @@ fi
if test "${with_gif+set}" = set; then :
withval=$with_gif;
else
- with_gif=yes
+ with_gif=$with_features
fi
@@ -3925,7 +4034,7 @@ fi
if test "${with_png+set}" = set; then :
withval=$with_png;
else
- with_png=yes
+ with_png=$with_features
fi
@@ -3933,7 +4042,7 @@ fi
if test "${with_rsvg+set}" = set; then :
withval=$with_rsvg;
else
- with_rsvg=yes
+ with_rsvg=$with_features
fi
@@ -3941,7 +4050,7 @@ fi
if test "${with_xml2+set}" = set; then :
withval=$with_xml2;
else
- with_xml2=yes
+ with_xml2=$with_features
fi
@@ -3949,7 +4058,7 @@ fi
if test "${with_imagemagick+set}" = set; then :
withval=$with_imagemagick;
else
- with_imagemagick=yes
+ with_imagemagick=$with_features
fi
@@ -3958,7 +4067,7 @@ fi
if test "${with_xft+set}" = set; then :
withval=$with_xft;
else
- with_xft=yes
+ with_xft=$with_features
fi
@@ -3966,7 +4075,7 @@ fi
if test "${with_libotf+set}" = set; then :
withval=$with_libotf;
else
- with_libotf=yes
+ with_libotf=$with_features
fi
@@ -3974,7 +4083,7 @@ fi
if test "${with_m17n_flt+set}" = set; then :
withval=$with_m17n_flt;
else
- with_m17n_flt=yes
+ with_m17n_flt=$with_features
fi
@@ -3983,7 +4092,7 @@ fi
if test "${with_toolkit_scroll_bars+set}" = set; then :
withval=$with_toolkit_scroll_bars;
else
- with_toolkit_scroll_bars=yes
+ with_toolkit_scroll_bars=$with_features
fi
@@ -3991,7 +4100,7 @@ fi
if test "${with_xaw3d+set}" = set; then :
withval=$with_xaw3d;
else
- with_xaw3d=yes
+ with_xaw3d=$with_features
fi
@@ -3999,7 +4108,7 @@ fi
if test "${with_xim+set}" = set; then :
withval=$with_xim;
else
- with_xim=yes
+ with_xim=$with_features
fi
@@ -4011,12 +4120,20 @@ else
fi
+# Check whether --with-w32 was given.
+if test "${with_w32+set}" = set; then :
+ withval=$with_w32;
+else
+ with_w32=no
+fi
+
+
# Check whether --with-gpm was given.
if test "${with_gpm+set}" = set; then :
withval=$with_gpm;
else
- with_gpm=yes
+ with_gpm=$with_features
fi
@@ -4024,7 +4141,7 @@ fi
if test "${with_dbus+set}" = set; then :
withval=$with_dbus;
else
- with_dbus=yes
+ with_dbus=$with_features
fi
@@ -4032,7 +4149,7 @@ fi
if test "${with_gconf+set}" = set; then :
withval=$with_gconf;
else
- with_gconf=yes
+ with_gconf=$with_features
fi
@@ -4040,7 +4157,7 @@ fi
if test "${with_gsettings+set}" = set; then :
withval=$with_gsettings;
else
- with_gsettings=yes
+ with_gsettings=$with_features
fi
@@ -4048,7 +4165,7 @@ fi
if test "${with_selinux+set}" = set; then :
withval=$with_selinux;
else
- with_selinux=yes
+ with_selinux=$with_features
fi
@@ -4056,7 +4173,7 @@ fi
if test "${with_gnutls+set}" = set; then :
withval=$with_gnutls;
else
- with_gnutls=yes
+ with_gnutls=$with_features
fi
@@ -4067,7 +4184,7 @@ fi
if test "${with_makeinfo+set}" = set; then :
withval=$with_makeinfo;
else
- with_makeinfo=yes
+ with_makeinfo=$with_features
fi
@@ -4081,7 +4198,7 @@ fi
if test "${with_compress_info+set}" = set; then :
withval=$with_compress_info;
else
- with_compress_info=yes
+ with_compress_info=$with_features
fi
if test $with_compress_info = yes; then
@@ -4141,28 +4258,6 @@ else
fi
-# Check whether --enable-asserts was given.
-if test "${enable_asserts+set}" = set; then :
- enableval=$enable_asserts; USE_XASSERTS=$enableval
-else
- USE_XASSERTS=no
-fi
-
-
-# Check whether --enable-maintainer-mode was given.
-if test "${enable_maintainer_mode+set}" = set; then :
- enableval=$enable_maintainer_mode; USE_MAINTAINER_MODE=$enableval
-else
- USE_MAINTAINER_MODE=yes
-fi
-
-if test $USE_MAINTAINER_MODE = yes; then
- MAINT=
-else
- MAINT=#
-fi
-
-
# Check whether --enable-locallisppath was given.
if test "${enable_locallisppath+set}" = set; then :
enableval=$enable_locallisppath; if test "${enableval}" = "no"; then
@@ -4189,19 +4284,22 @@ do
ac_gc_check_string_overrun= ;
ac_gc_check_string_free_list= ;
ac_xmalloc_overrun= ;
- ac_gc_check_cons_list= ;;
+ ac_gc_check_cons_list= ;
+ ac_glyphs_debug= ;;
all) ac_enable_checking=1 ;
ac_gc_check_stringbytes=1 ;
ac_gc_check_string_overrun=1 ;
ac_gc_check_string_free_list=1 ;
ac_xmalloc_overrun=1 ;
- ac_gc_check_cons_list=1 ;;
+ ac_gc_check_cons_list=1 ;
+ ac_glyphs_debug=1 ;;
# these enable particular checks
stringbytes) ac_gc_check_stringbytes=1 ;;
stringoverrun) ac_gc_check_string_overrun=1 ;;
stringfreelist) ac_gc_check_string_free_list=1 ;;
xmallocoverrun) ac_xmalloc_overrun=1 ;;
conslist) ac_gc_check_cons_list=1 ;;
+ glyphs) ac_glyphs_debug=1 ;;
*) as_fn_error "unknown check category $check" "$LINENO" 5 ;;
esac
done
@@ -4237,12 +4335,17 @@ if test x$ac_gc_check_cons_list != x ; then
$as_echo "#define GC_CHECK_CONS_LIST 1" >>confdefs.h
fi
+if test x$ac_glyphs_debug != x ; then
-# Check whether --enable-use-lisp-union-type was given.
-if test "${enable_use_lisp_union_type+set}" = set; then :
- enableval=$enable_use_lisp_union_type; if test "${enableval}" != "no"; then
+$as_echo "#define GLYPH_DEBUG 1" >>confdefs.h
-$as_echo "#define USE_LISP_UNION_TYPE 1" >>confdefs.h
+fi
+
+# Check whether --enable-check-lisp-object-type was given.
+if test "${enable_check_lisp_object_type+set}" = set; then :
+ enableval=$enable_check_lisp_object_type; if test "${enableval}" != "no"; then
+
+$as_echo "#define CHECK_LISP_OBJECT_TYPE 1" >>confdefs.h
fi
fi
@@ -4293,9 +4396,6 @@ case "${srcdir}" in
* ) srcdir="`(cd ${srcdir}; pwd)`" ;;
esac
-#### Given the configuration name, set machfile and opsysfile to the
-#### names of the m/*.h and s/*.h files we should use.
-
### Canonicalize the configuration name.
# Make sure we can run config.sub.
@@ -4376,13 +4476,11 @@ configuration=${host_alias-${build_alias-$host}}
### If you add support for a new configuration, add code to this
### switch statement to recognize your configuration name and select
-### the appropriate operating system and machine description files.
+### the appropriate operating system file.
-### You would hope that you could choose an m/*.h file pretty much
-### based on the machine portion of the configuration name, and an s/*.h
+### You would hope that you could choose an s/*.h
### file based on the operating system portion. However, it turns out
-### that each m/*.h file is pretty manufacturer-specific - for
-### example mips.h is MIPS
+### that each s/*.h file is pretty manufacturer-specific.
### So we basically have to have a special case for each
### configuration name.
###
@@ -4392,95 +4490,49 @@ configuration=${host_alias-${build_alias-$host}}
### prepared to handle anything reasonably. If version numbers
### matter, be sure /etc/MACHINES says something about it.
-machine='' opsys='' unported=no
+opsys='' unported=no
case "${canonical}" in
## GNU/Linux and similar ports
*-*-linux* )
opsys=gnu-linux
- case ${canonical} in
- alpha*) machine=alpha ;;
- s390x-*) machine=ibms390x ;;
- powerpc*) machine=macppc ;;
- sparc*) machine=sparc ;;
- ia64*) machine=ia64 ;;
- m68k*) machine=m68k ;;
- x86_64*) machine=amdx86-64 ;;
- esac
;;
## FreeBSD ports
*-*-freebsd* )
opsys=freebsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- amd64-*|x86_64-*) machine=amdx86-64 ;;
- ia64-*) machine=ia64 ;;
- i[3456]86-*) machine=intel386 ;;
- powerpc-*) machine=macppc ;;
- sparc-*) machine=sparc ;;
- sparc64-*) machine=sparc ;;
- esac
;;
## FreeBSD kernel + glibc based userland
*-*-kfreebsd*gnu* )
opsys=gnu-kfreebsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- amd64-*|x86_64-*) machine=amdx86-64 ;;
- ia64-*) machine=ia64 ;;
- i[3456]86-*) machine=intel386 ;;
- powerpc-*) machine=macppc ;;
- sparc-*) machine=sparc ;;
- sparc64-*) machine=sparc ;;
- esac
;;
## NetBSD ports
*-*-netbsd* )
opsys=netbsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- x86_64-*) machine=amdx86-64 ;;
- i[3456]86-*) machine=intel386 ;;
- m68k-*) machine=m68k ;;
- powerpc-*) machine=macppc ;;
- sparc*-) machine=sparc ;;
- vax-*) machine=vax ;;
- esac
;;
## OpenBSD ports
*-*-openbsd* )
opsys=openbsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- x86_64-*) machine=amdx86-64 ;;
- i386-*) machine=intel386 ;;
- powerpc-*) machine=macppc ;;
- sparc*) machine=sparc ;;
- vax-*) machine=vax ;;
- esac
;;
## Apple Darwin / Mac OS X
*-apple-darwin* )
case "${canonical}" in
- i[3456]86-* ) machine=intel386 ;;
- powerpc-* ) machine=macppc ;;
- x86_64-* ) machine=amdx86-64 ;;
+ i[3456]86-* ) ;;
+ powerpc-* ) ;;
+ x86_64-* ) ;;
* ) unported=yes ;;
esac
opsys=darwin
- # Define CPP as follows to make autoconf work correctly.
- CPP="${CC-cc} -E -no-cpp-precomp"
- # Use fink packages if available.
- if test -d /sw/include && test -d /sw/lib; then
- GCC_TEST_OPTIONS="-I/sw/include -L/sw/lib"
- CPP="${CPP} ${GCC_TEST_OPTIONS}"
- NON_GCC_TEST_OPTIONS=${GCC_TEST_OPTIONS}
- fi
+ ## Use fink packages if available.
+ ## FIXME find a better way to do this: http://debbugs.gnu.org/11507
+## if test -d /sw/include && test -d /sw/lib; then
+## GCC_TEST_OPTIONS="-I/sw/include -L/sw/lib"
+## NON_GCC_TEST_OPTIONS=${GCC_TEST_OPTIONS}
+## fi
;;
## HP 9000 series 700 and 800, running HP/UX
@@ -4494,16 +4546,16 @@ case "${canonical}" in
## IBM machines
rs6000-ibm-aix4.[23]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
powerpc-ibm-aix4.[23]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
rs6000-ibm-aix[56]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
powerpc-ibm-aix[56]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
## Silicon Graphics machines
@@ -4513,7 +4565,6 @@ case "${canonical}" in
# Without defining _LANGUAGE_C, things get masked out in the headers
# so that, for instance, grepping for `free' in stdlib.h fails and
# AC_HEADER_STD_C fails. (MIPSPro 7.2.1.2m compilers, Irix 6.5.3m).
- NON_GNU_CPP="/lib/cpp -D_LANGUAGE_C"
NON_GCC_TEST_OPTIONS="-D_LANGUAGE_C"
;;
@@ -4522,26 +4573,23 @@ case "${canonical}" in
| i[3456]86-*-solaris2* | i[3456]86-*-sunos5* \
| x86_64-*-solaris2* | x86_64-*-sunos5*)
case "${canonical}" in
- i[3456]86-*-* ) machine=intel386 ;;
- amd64-*-*|x86_64-*-*) machine=amdx86-64 ;;
- sparc* ) machine=sparc ;;
+ i[3456]86-*-* ) ;;
+ amd64-*-*|x86_64-*-*) ;;
+ sparc* ) ;;
* ) unported=yes ;;
esac
case "${canonical}" in
*-sunos5.6* | *-solaris2.6* )
opsys=sol2-6
- NON_GNU_CPP=/usr/ccs/lib/cpp
RANLIB="ar -ts"
;;
*-sunos5.[7-9]* | *-solaris2.[7-9]* )
opsys=sol2-6
emacs_check_sunpro_c=yes
- NON_GNU_CPP=/usr/ccs/lib/cpp
;;
*-sunos5* | *-solaris* )
opsys=sol2-10
emacs_check_sunpro_c=yes
- NON_GNU_CPP=/usr/ccs/lib/cpp
;;
esac
## Watch out for a compiler that we know will not work.
@@ -4559,15 +4607,12 @@ case "${canonical}" in
## Intel 386 machines where we don't care about the manufacturer.
i[3456]86-*-* )
- machine=intel386
case "${canonical}" in
*-cygwin ) opsys=cygwin ;;
- *-darwin* ) opsys=darwin
- CPP="${CC-cc} -E -no-cpp-precomp"
- ;;
- *-sysv4.2uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
- *-sysv5uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
- *-sysv5OpenUNIX* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
+ *-darwin* ) opsys=darwin ;;
+ *-sysv4.2uw* ) opsys=unixware ;;
+ *-sysv5uw* ) opsys=unixware ;;
+ *-sysv5OpenUNIX* ) opsys=unixware ;;
## Otherwise, we'll fall through to the generic opsys code at the bottom.
esac
;;
@@ -4599,19 +4644,8 @@ if test $unported = yes; then
Check \`etc/MACHINES' for recognized configuration names." "$LINENO" 5
fi
-if test -n "$machine"; then
- machfile="m/${machine}.h"
-else
- machfile=
-fi
-opsysfile="s/${opsys}.h"
-
#### Choose a compiler.
-test -n "$CC" && cc_specified=yes
-
-# Save the value of CFLAGS that the user specified.
-SPECIFIED_CFLAGS="$CFLAGS"
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
@@ -5720,7 +5754,18 @@ fi
-# Initialize gnulib right after verifying that the C compiler works.
+if test x$GCC = xyes; then
+ test "x$GCC_TEST_OPTIONS" != x && CC="$CC $GCC_TEST_OPTIONS"
+else
+ test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS"
+fi
+
+# Avoid gnulib's tests for O_NOATIME and O_NOFOLLOW, as we don't use them.
+
+# Avoid gnulib's threadlib module, as we do threads our own way.
+
+
+# Initialize gnulib right after choosing the compiler.
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
@@ -6934,21 +6979,37 @@ esac
# Code from module alloca-opt:
# Code from module allocator:
+ # Code from module c-ctype:
+ # Code from module c-strcase:
# Code from module careadlinkat:
+ # Code from module clock-time:
+ # Code from module close-stream:
# Code from module crypto/md5:
# Code from module crypto/sha1:
# Code from module crypto/sha256:
# Code from module crypto/sha512:
# Code from module dosname:
# Code from module dtoastr:
+ # Code from module dtotimespec:
# Code from module dup2:
+ # Code from module environ:
+ # Code from module euidaccess:
+ # Code from module execinfo:
# Code from module extensions:
+ # Code from module extern-inline:
+ # Code from module faccessat:
+ # Code from module fcntl-h:
# Code from module filemode:
+ # Code from module fpending:
+ # Code from module getgroups:
# Code from module getloadavg:
# Code from module getopt-gnu:
# Code from module getopt-posix:
# Code from module gettext-h:
+ # Code from module gettime:
+ # Code from module gettimeofday:
+ # Code from module group-member:
# Code from module ignore-value:
# Code from module include_next:
# Code from module intprops:
@@ -6956,13 +7017,16 @@ esac
# Code from module largefile:
# Code from module lstat:
+ # Code from module manywarnings:
# Code from module mktime:
# Code from module multiarch:
# Code from module nocrash:
+ # Code from module pathmax:
+ # Code from module pselect:
# Code from module pthread_sigmask:
# Code from module readlink:
+ # Code from module root-uid:
# Code from module signal-h:
- # Code from module sigprocmask:
# Code from module snippet/_Noreturn:
# Code from module snippet/arg-nonnull:
# Code from module snippet/c++defs:
@@ -6970,6 +7034,8 @@ esac
# Code from module socklen:
# Code from module ssize_t:
# Code from module stat:
+ # Code from module stat-time:
+ # Code from module stdalign:
# Code from module stdarg:
@@ -6985,26 +7051,41 @@ esac
# Code from module strtoull:
# Code from module strtoumax:
# Code from module symlink:
+ # Code from module sys_select:
# Code from module sys_stat:
+ # Code from module sys_time:
# Code from module time:
# Code from module time_r:
+ # Code from module timer-time:
+ # Code from module timespec:
+ # Code from module timespec-add:
+ # Code from module timespec-sub:
# Code from module u64:
# Code from module unistd:
+ # Code from module utimens:
# Code from module verify:
-
-
-# On Suns, sometimes $CPP names a directory.
-if test -n "$CPP" && test -d "$CPP"; then
- CPP=
-fi
-
-## If not using gcc, and on Solaris, and no CPP specified, see if
-## using a Sun compiler, which needs -Xs to prevent whitespace.
-if test x"$GCC" != xyes && test x"$emacs_check_sunpro_c" = xyes && \
- test x"$CPP" = x; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using a Sun C compiler" >&5
-$as_echo_n "checking whether we are using a Sun C compiler... " >&6; }
- if test "${emacs_cv_sunpro_c+set}" = set; then :
+ # Code from module warnings:
+ # Code from module xalloc-oversized:
+
+
+# It's helpful to have C macros available to GDB, so prefer -g3 to -g
+# if -g3 works and the user does not specify CFLAGS.
+# This test must follow gl_EARLY; otherwise AC_LINK_IFELSE complains.
+if test "$ac_test_CFLAGS" != set; then
+ case $CFLAGS in
+ '-g')
+ emacs_g3_CFLAGS='-g3';;
+ '-g -O2')
+ emacs_g3_CFLAGS='-g3 -O2';;
+ *)
+ emacs_g3_CFLAGS='';;
+ esac
+ if test -n "$emacs_g3_CFLAGS"; then
+ emacs_save_CFLAGS=$CFLAGS
+ CFLAGS=$emacs_g3_CFLAGS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts $emacs_g3_CFLAGS" >&5
+$as_echo_n "checking whether $CC accepts $emacs_g3_CFLAGS... " >&6; }
+if test "${emacs_cv_prog_cc_g3+set}" = set; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
@@ -7013,60 +7094,223 @@ else
int
main ()
{
-#ifndef __SUNPRO_C
-fail;
-#endif
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- emacs_cv_sunpro_c=yes
+ emacs_cv_prog_cc_g3=yes
else
- emacs_cv_sunpro_c=no
+ emacs_cv_prog_cc_g3=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_prog_cc_g3" >&5
+$as_echo "$emacs_cv_prog_cc_g3" >&6; }
+ if test $emacs_cv_prog_cc_g3 = yes; then
+ CFLAGS=$emacs_g3_CFLAGS
+ else
+ CFLAGS=$emacs_save_CFLAGS
+ fi
+ fi
+fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_sunpro_c" >&5
-$as_echo "$emacs_cv_sunpro_c" >&6; }
+# Check whether --enable-gcc-warnings was given.
+if test "${enable_gcc_warnings+set}" = set; then :
+ enableval=$enable_gcc_warnings; case $enableval in
+ yes|no) ;;
+ *) as_fn_error "bad value $enableval for gcc-warnings option" "$LINENO" 5 ;;
+ esac
+ gl_gcc_warnings=$enableval
+else
+ gl_gcc_warnings=no
- if test x"$emacs_cv_sunpro_c" = xyes; then
- NON_GNU_CPP="$CC -E -Xs"
- fi
fi
-#### Some systems specify a CPP to use unless we are using GCC.
-#### Now that we know whether we are using GCC, we can decide whether
-#### to use that one.
-if test "x$NON_GNU_CPP" != x && test x$GCC != xyes && test "x$CPP" = x
-then
- CPP="$NON_GNU_CPP"
+
+# Check whether --enable-link-time-optimization was given.
+if test "${enable_link_time_optimization+set}" = set; then :
+ enableval=$enable_link_time_optimization; if test "${enableval}" != "no"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether link-time optimization is supported" >&5
+$as_echo_n "checking whether link-time optimization is supported... " >&6; }
+ ac_lto_supported=no
+ if test x$GCC = xyes; then
+ CPUS=`getconf _NPROCESSORS_ONLN 2>/dev/null`
+ if test x$CPUS != x; then
+ LTO="-flto=$CPUS"
+ else
+ LTO="-flto"
+ fi
+ old_CFLAGS=$CFLAGS
+ CFLAGS="$CFLAGS $LTO"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_lto_supported=yes
+else
+ ac_lto_supported=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$old_CFLAGS"
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_lto_supported" >&5
+$as_echo "$ac_lto_supported" >&6; }
+ if test "$ac_lto_supported" = "yes"; then
+ CFLAGS="$CFLAGS $LTO"
+ fi
+fi
fi
-#### Some systems specify a CC to use unless we are using GCC.
-#### Now that we know whether we are using GCC, we can decide whether
-#### to use that one.
-if test "x$NON_GNU_CC" != x && test x$GCC != xyes &&
- test x$cc_specified != xyes
-then
- CC="$NON_GNU_CC"
+
+# gl_GCC_VERSION_IFELSE([major], [minor], [run-if-found], [run-if-not-found])
+# ------------------------------------------------
+# If $CPP is gcc-MAJOR.MINOR or newer, then run RUN-IF-FOUND.
+# Otherwise, run RUN-IF-NOT-FOUND.
+
+
+# When compiling with GCC, prefer -isystem to -I when including system
+# include files, to avoid generating useless diagnostics for the files.
+if test "$gl_gcc_warnings" != yes; then
+ isystem='-I'
+else
+ isystem='-isystem '
+
+ # This, $nw, is the list of warnings we disable.
+ nw=
+
+ case $with_x_toolkit in
+ lucid | athena | motif)
+ # Old toolkits mishandle 'const'.
+ nw="$nw -Wwrite-strings"
+ ;;
+ *)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Werror" >&5
+$as_echo_n "checking whether C compiler handles -Werror... " >&6; }
+if test "${gl_cv_warn_c__Werror+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Werror"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Werror=yes
+else
+ gl_cv_warn_c__Werror=no
fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
-if test x$GCC = xyes; then
- test "x$GCC_TEST_OPTIONS" != x && CC="$CC $GCC_TEST_OPTIONS"
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Werror" >&5
+$as_echo "$gl_cv_warn_c__Werror" >&6; }
+if test "x$gl_cv_warn_c__Werror" = x""yes; then :
+ as_fn_append WERROR_CFLAGS " -Werror"
+fi
+
+
+ ;;
+ esac
+
+
+ nw="$nw -Waggregate-return" # anachronistic
+ nw="$nw -Wlong-long" # C90 is anachronistic
+ nw="$nw -Wc++-compat" # We don't care about C++ compilers
+ nw="$nw -Wundef" # Warns on '#if GNULIB_FOO' etc in gnulib
+ nw="$nw -Wtraditional" # Warns on #elif which we use often
+ nw="$nw -Wcast-qual" # Too many warnings for now
+ nw="$nw -Wconversion" # Too many warnings for now
+ nw="$nw -Wsystem-headers" # Don't let system headers trigger warnings
+ nw="$nw -Wsign-conversion" # Too many warnings for now
+ nw="$nw -Woverlength-strings" # Not a problem these days
+ nw="$nw -Wtraditional-conversion" # Too many warnings for now
+ nw="$nw -Wunreachable-code" # so buggy that it's now silently ignored
+ nw="$nw -Wpadded" # Our structs are not padded
+ nw="$nw -Wredundant-decls" # we regularly (re)declare functions
+ nw="$nw -Wlogical-op" # any use of fwrite provokes this
+ nw="$nw -Wformat-nonliteral" # we do this a lot
+ nw="$nw -Wvla" # warnings in gettext.h
+ nw="$nw -Wnested-externs" # use of XARGMATCH/verify_function__
+ nw="$nw -Wswitch-enum" # Too many warnings for now
+ nw="$nw -Wswitch-default" # Too many warnings for now
+ nw="$nw -Wfloat-equal" # warns about high-quality code
+ nw="$nw -Winline" # OK to ignore 'inline'
+ nw="$nw -Wjump-misses-init" # We sometimes safely jump over init.
+ nw="$nw -Wstrict-overflow" # OK to optimize assuming that
+ # signed overflow has undefined behavior
+ nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning
+ nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations
+
+ # Emacs doesn't care about shadowing; see
+ # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>.
+ nw="$nw -Wshadow"
+
+ # The following line should be removable at some point.
+ nw="$nw -Wsuggest-attribute=pure"
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use -Wstack-protector" >&5
+$as_echo_n "checking whether to use -Wstack-protector... " >&6; }
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#if (1 <= __LONG_MAX__ >> 31 >> 31 \
+ && 4 < __GNUC__ + (7 < __GNUC_MINOR__ + (2 <= __GNUC_PATCHLEVEL__)))
+ /* OK */
+ #else
+ #error "Not GCC, or GCC before 4.7.2, or 'long int' has < 64 bits."
+ #endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
else
- test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ nw="$nw -Wstack-protector"
fi
+rm -f conftest.err conftest.$ac_ext
-### Use -Wdeclaration-after-statement if the compiler supports it
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gcc understands -Wdeclaration-after-statement" >&5
-$as_echo_n "checking whether gcc understands -Wdeclaration-after-statement... " >&6; }
-SAVE_CFLAGS="$CFLAGS"
-CFLAGS="$CFLAGS -Wdeclaration-after-statement"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+
+
+ if test -n "$GCC"; then
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -Wno-missing-field-initializers is supported" >&5
+$as_echo_n "checking whether -Wno-missing-field-initializers is supported... " >&6; }
+ if test "${gl_cv_cc_nomfi_supported+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -W -Werror -Wno-missing-field-initializers"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -7078,28 +7322,33 @@ main ()
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- has_option=yes
+ gl_cv_cc_nomfi_supported=yes
else
- has_option=no
+ gl_cv_cc_nomfi_supported=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-if test $has_option = yes; then
- C_WARNINGS_SWITCH="-Wdeclaration-after-statement $C_WARNINGS_SWITCH"
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $has_option" >&5
-$as_echo "$has_option" >&6; }
-CFLAGS="$SAVE_CFLAGS"
-unset has_option
-unset SAVE_CFLAGS
-
-### Use -Wold-style-definition if the compiler supports it
-# This can be removed when conversion to standard C is finished.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gcc understands -Wold-style-definition" >&5
-$as_echo_n "checking whether gcc understands -Wold-style-definition... " >&6; }
-SAVE_CFLAGS="$CFLAGS"
-CFLAGS="$CFLAGS -Wold-style-definition"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ CFLAGS="$gl_save_CFLAGS"
+fi
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_cc_nomfi_supported" >&5
+$as_echo "$gl_cv_cc_nomfi_supported" >&6; }
+
+ if test "$gl_cv_cc_nomfi_supported" = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -Wno-missing-field-initializers is needed" >&5
+$as_echo_n "checking whether -Wno-missing-field-initializers is needed... " >&6; }
+ if test "${gl_cv_cc_nomfi_needed+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -W -Werror"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+void f (void)
+ {
+ typedef struct { int a; int b; } s_t;
+ s_t s1 = { 0, };
+ }
int
main ()
@@ -7110,26 +7359,28 @@ main ()
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- has_option=yes
+ gl_cv_cc_nomfi_needed=no
else
- has_option=no
+ gl_cv_cc_nomfi_needed=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-if test $has_option = yes; then
- C_WARNINGS_SWITCH="-Wold-style-definition $C_WARNINGS_SWITCH"
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $has_option" >&5
-$as_echo "$has_option" >&6; }
-CFLAGS="$SAVE_CFLAGS"
-unset has_option
-unset SAVE_CFLAGS
-
-### Use -Wimplicit-function-declaration if the compiler supports it
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gcc understands -Wimplicit-function-declaration" >&5
-$as_echo_n "checking whether gcc understands -Wimplicit-function-declaration... " >&6; }
-SAVE_CFLAGS="$CFLAGS"
-CFLAGS="$CFLAGS -Wimplicit-function-declaration"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ CFLAGS="$gl_save_CFLAGS"
+
+fi
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_cc_nomfi_needed" >&5
+$as_echo "$gl_cv_cc_nomfi_needed" >&6; }
+ fi
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -Wuninitialized is supported" >&5
+$as_echo_n "checking whether -Wuninitialized is supported... " >&6; }
+ if test "${gl_cv_cc_uninitialized_supported+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -Werror -Wuninitialized"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -7141,312 +7392,566 @@ main ()
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- has_option=yes
+ gl_cv_cc_uninitialized_supported=yes
else
- has_option=no
+ gl_cv_cc_uninitialized_supported=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-if test $has_option = yes; then
- C_WARNINGS_SWITCH="-Wimplicit-function-declaration $C_WARNINGS_SWITCH"
+ CFLAGS="$gl_save_CFLAGS"
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $has_option" >&5
-$as_echo "$has_option" >&6; }
-CFLAGS="$SAVE_CFLAGS"
-unset has_option
-unset SAVE_CFLAGS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_cc_uninitialized_supported" >&5
+$as_echo "$gl_cv_cc_uninitialized_supported" >&6; }
+ fi
+ # List all gcc warning categories.
+ gl_manywarn_set=
+ for gl_manywarn_item in \
+ -W \
+ -Wabi \
+ -Waddress \
+ -Wall \
+ -Warray-bounds \
+ -Wattributes \
+ -Wbad-function-cast \
+ -Wbuiltin-macro-redefined \
+ -Wcast-align \
+ -Wchar-subscripts \
+ -Wclobbered \
+ -Wcomment \
+ -Wcomments \
+ -Wcoverage-mismatch \
+ -Wcpp \
+ -Wdeprecated \
+ -Wdeprecated-declarations \
+ -Wdisabled-optimization \
+ -Wdiv-by-zero \
+ -Wdouble-promotion \
+ -Wempty-body \
+ -Wendif-labels \
+ -Wenum-compare \
+ -Wextra \
+ -Wformat-contains-nul \
+ -Wformat-extra-args \
+ -Wformat-nonliteral \
+ -Wformat-security \
+ -Wformat-y2k \
+ -Wformat-zero-length \
+ -Wformat=2 \
+ -Wfree-nonheap-object \
+ -Wignored-qualifiers \
+ -Wimplicit \
+ -Wimplicit-function-declaration \
+ -Wimplicit-int \
+ -Winit-self \
+ -Winline \
+ -Wint-to-pointer-cast \
+ -Winvalid-memory-model \
+ -Winvalid-pch \
+ -Wjump-misses-init \
+ -Wlogical-op \
+ -Wmain \
+ -Wmaybe-uninitialized \
+ -Wmissing-braces \
+ -Wmissing-declarations \
+ -Wmissing-field-initializers \
+ -Wmissing-format-attribute \
+ -Wmissing-include-dirs \
+ -Wmissing-noreturn \
+ -Wmissing-parameter-type \
+ -Wmissing-prototypes \
+ -Wmudflap \
+ -Wmultichar \
+ -Wnarrowing \
+ -Wnested-externs \
+ -Wnonnull \
+ -Wnormalized=nfc \
+ -Wold-style-declaration \
+ -Wold-style-definition \
+ -Woverflow \
+ -Woverlength-strings \
+ -Woverride-init \
+ -Wpacked \
+ -Wpacked-bitfield-compat \
+ -Wparentheses \
+ -Wpointer-arith \
+ -Wpointer-sign \
+ -Wpointer-to-int-cast \
+ -Wpragmas \
+ -Wreturn-type \
+ -Wsequence-point \
+ -Wshadow \
+ -Wsizeof-pointer-memaccess \
+ -Wstack-protector \
+ -Wstrict-aliasing \
+ -Wstrict-overflow \
+ -Wstrict-prototypes \
+ -Wsuggest-attribute=const \
+ -Wsuggest-attribute=format \
+ -Wsuggest-attribute=noreturn \
+ -Wsuggest-attribute=pure \
+ -Wswitch \
+ -Wswitch-default \
+ -Wsync-nand \
+ -Wsystem-headers \
+ -Wtrampolines \
+ -Wtrigraphs \
+ -Wtype-limits \
+ -Wuninitialized \
+ -Wunknown-pragmas \
+ -Wunreachable-code \
+ -Wunsafe-loop-optimizations \
+ -Wunused \
+ -Wunused-but-set-parameter \
+ -Wunused-but-set-variable \
+ -Wunused-function \
+ -Wunused-label \
+ -Wunused-local-typedefs \
+ -Wunused-macros \
+ -Wunused-parameter \
+ -Wunused-result \
+ -Wunused-value \
+ -Wunused-variable \
+ -Wvarargs \
+ -Wvariadic-macros \
+ -Wvector-operation-performance \
+ -Wvla \
+ -Wvolatile-register-var \
+ -Wwrite-strings \
+ \
+ ; do
+ gl_manywarn_set="$gl_manywarn_set $gl_manywarn_item"
+ done
-#### Some other nice autoconf tests.
+ # Disable specific options as needed.
+ if test "$gl_cv_cc_nomfi_needed" = yes; then
+ gl_manywarn_set="$gl_manywarn_set -Wno-missing-field-initializers"
+ fi
-ac_ext=c
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
-ac_compiler_gnu=$ac_cv_c_compiler_gnu
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
-$as_echo_n "checking how to run the C preprocessor... " >&6; }
-# On Suns, sometimes $CPP names a directory.
-if test -n "$CPP" && test -d "$CPP"; then
- CPP=
-fi
-if test -z "$CPP"; then
- if test "${ac_cv_prog_CPP+set}" = set; then :
+ if test "$gl_cv_cc_uninitialized_supported" = no; then
+ gl_manywarn_set="$gl_manywarn_set -Wno-uninitialized"
+ fi
+
+ ws=$gl_manywarn_set
+
+
+ gl_warn_set=
+ set x $ws; shift
+ for gl_warn_item
+ do
+ case " $nw " in
+ *" $gl_warn_item "*)
+ ;;
+ *)
+ gl_warn_set="$gl_warn_set $gl_warn_item"
+ ;;
+ esac
+ done
+ ws=$gl_warn_set
+
+ for w in $ws; do
+ as_gl_Warn=`$as_echo "gl_cv_warn_c_$w" | $as_tr_sh`
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles $w" >&5
+$as_echo_n "checking whether C compiler handles $w... " >&6; }
+if { as_var=$as_gl_Warn; eval "test \"\${$as_var+set}\" = set"; }; then :
$as_echo_n "(cached) " >&6
else
- # Double quotes because CPP needs to be expanded
- for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
- do
- ac_preproc_ok=false
-for ac_c_preproc_warn_flag in '' yes
-do
- # Use a header file that comes with gcc, so configuring glibc
- # with a fresh cross-compiler works.
- # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- # <limits.h> exists even on freestanding compilers.
- # On the NeXT, cc -E runs the code through the compiler's parser,
- # not just through cpp. "Syntax error" is here to catch this case.
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " $w"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
- Syntax error
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$as_gl_Warn=yes"
else
- # Broken: fails on valid input.
-continue
+ eval "$as_gl_Warn=no"
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
- # OK, works on sane cases. Now check whether nonexistent headers
- # can be detected and how.
+fi
+eval ac_res=\$$as_gl_Warn
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+eval as_val=\$$as_gl_Warn
+ if test "x$as_val" = x""yes; then :
+ as_fn_append WARN_CFLAGS " $w"
+fi
+
+
+ done
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-missing-field-initializers" >&5
+$as_echo_n "checking whether C compiler handles -Wno-missing-field-initializers... " >&6; }
+if test "${gl_cv_warn_c__Wno_missing_field_initializers+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-missing-field-initializers"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <ac_nonexistent.h>
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
- # Broken: success on invalid input.
-continue
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_missing_field_initializers=yes
else
- # Passes both tests.
-ac_preproc_ok=:
-break
+ gl_cv_warn_c__Wno_missing_field_initializers=no
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
-done
-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
-rm -f conftest.err conftest.$ac_ext
-if $ac_preproc_ok; then :
- break
fi
-
- done
- ac_cv_prog_CPP=$CPP
-
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_missing_field_initializers" >&5
+$as_echo "$gl_cv_warn_c__Wno_missing_field_initializers" >&6; }
+if test "x$gl_cv_warn_c__Wno_missing_field_initializers" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-missing-field-initializers"
fi
- CPP=$ac_cv_prog_CPP
+
+ # We need this one
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-sign-compare" >&5
+$as_echo_n "checking whether C compiler handles -Wno-sign-compare... " >&6; }
+if test "${gl_cv_warn_c__Wno_sign_compare+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- ac_cv_prog_CPP=$CPP
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
-$as_echo "$CPP" >&6; }
-ac_preproc_ok=false
-for ac_c_preproc_warn_flag in '' yes
-do
- # Use a header file that comes with gcc, so configuring glibc
- # with a fresh cross-compiler works.
- # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- # <limits.h> exists even on freestanding compilers.
- # On the NeXT, cc -E runs the code through the compiler's parser,
- # not just through cpp. "Syntax error" is here to catch this case.
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-sign-compare"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
- Syntax error
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_sign_compare=yes
else
- # Broken: fails on valid input.
-continue
+ gl_cv_warn_c__Wno_sign_compare=no
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
- # OK, works on sane cases. Now check whether nonexistent headers
- # can be detected and how.
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_sign_compare" >&5
+$as_echo "$gl_cv_warn_c__Wno_sign_compare" >&6; }
+if test "x$gl_cv_warn_c__Wno_sign_compare" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-sign-compare"
+fi
+
+ # Too many warnings for now
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-type-limits" >&5
+$as_echo_n "checking whether C compiler handles -Wno-type-limits... " >&6; }
+if test "${gl_cv_warn_c__Wno_type_limits+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-type-limits"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <ac_nonexistent.h>
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
- # Broken: success on invalid input.
-continue
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_type_limits=yes
else
- # Passes both tests.
-ac_preproc_ok=:
-break
+ gl_cv_warn_c__Wno_type_limits=no
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
-done
-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
-rm -f conftest.err conftest.$ac_ext
-if $ac_preproc_ok; then :
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_type_limits" >&5
+$as_echo "$gl_cv_warn_c__Wno_type_limits" >&6; }
+if test "x$gl_cv_warn_c__Wno_type_limits" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-type-limits"
+fi
+ # Too many warnings for now
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-switch" >&5
+$as_echo_n "checking whether C compiler handles -Wno-switch... " >&6; }
+if test "${gl_cv_warn_c__Wno_switch+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error "C preprocessor \"$CPP\" fails sanity check
-See \`config.log' for more details." "$LINENO" 5; }
-fi
-ac_ext=c
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
-ac_compiler_gnu=$ac_cv_c_compiler_gnu
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-switch"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+int
+main ()
+{
-if test "x$RANLIB" = x; then
- if test -n "$ac_tool_prefix"; then
- # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
-set dummy ${ac_tool_prefix}ranlib; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_prog_RANLIB+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- if test -n "$RANLIB"; then
- ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_switch=yes
else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
+ gl_cv_warn_c__Wno_switch=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_switch" >&5
+$as_echo "$gl_cv_warn_c__Wno_switch" >&6; }
+if test "x$gl_cv_warn_c__Wno_switch" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-switch"
fi
-RANLIB=$ac_cv_prog_RANLIB
-if test -n "$RANLIB"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
-$as_echo "$RANLIB" >&6; }
+
+ # Too many warnings for now
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-unused-parameter" >&5
+$as_echo_n "checking whether C compiler handles -Wno-unused-parameter... " >&6; }
+if test "${gl_cv_warn_c__Wno_unused_parameter+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-unused-parameter"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_unused_parameter=yes
+else
+ gl_cv_warn_c__Wno_unused_parameter=no
fi
-if test -z "$ac_cv_prog_RANLIB"; then
- ac_ct_RANLIB=$RANLIB
- # Extract the first word of "ranlib", so it can be a program name with args.
-set dummy ranlib; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then :
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_unused_parameter" >&5
+$as_echo "$gl_cv_warn_c__Wno_unused_parameter" >&6; }
+if test "x$gl_cv_warn_c__Wno_unused_parameter" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-unused-parameter"
+fi
+
+ # Too many warnings for now
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-format-nonliteral" >&5
+$as_echo_n "checking whether C compiler handles -Wno-format-nonliteral... " >&6; }
+if test "${gl_cv_warn_c__Wno_format_nonliteral+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- if test -n "$ac_ct_RANLIB"; then
- ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-format-nonliteral"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_format_nonliteral=yes
else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_prog_ac_ct_RANLIB="ranlib"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
+ gl_cv_warn_c__Wno_format_nonliteral=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_format_nonliteral" >&5
+$as_echo "$gl_cv_warn_c__Wno_format_nonliteral" >&6; }
+if test "x$gl_cv_warn_c__Wno_format_nonliteral" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-format-nonliteral"
fi
-ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
-if test -n "$ac_ct_RANLIB"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
-$as_echo "$ac_ct_RANLIB" >&6; }
+
+
+
+ # In spite of excluding -Wlogical-op above, it is enabled, as of
+ # gcc 4.5.0 20090517.
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-logical-op" >&5
+$as_echo_n "checking whether C compiler handles -Wno-logical-op... " >&6; }
+if test "${gl_cv_warn_c__Wno_logical_op+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
- if test "x$ac_ct_RANLIB" = x; then
- RANLIB=":"
- else
- case $cross_compiling:$ac_tool_warned in
-yes:)
-{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
-$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
-ac_tool_warned=yes ;;
-esac
- RANLIB=$ac_ct_RANLIB
- fi
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-logical-op"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_logical_op=yes
else
- RANLIB="$ac_cv_prog_RANLIB"
+ gl_cv_warn_c__Wno_logical_op=no
fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_logical_op" >&5
+$as_echo "$gl_cv_warn_c__Wno_logical_op" >&6; }
+if test "x$gl_cv_warn_c__Wno_logical_op" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-logical-op"
+fi
+
-## Although we're running on an amd64 kernel, we're actually compiling for
-## the x86 architecture. The user should probably have provided an
-## explicit --build to `configure', but if everything else than the kernel
-## is running in i386 mode, we can help them out.
-if test "$machine" = "amdx86-64"; then
- ac_fn_c_check_decl "$LINENO" "i386" "ac_cv_have_decl_i386" "$ac_includes_default"
-if test "x$ac_cv_have_decl_i386" = x""yes; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -fdiagnostics-show-option" >&5
+$as_echo_n "checking whether C compiler handles -fdiagnostics-show-option... " >&6; }
+if test "${gl_cv_warn_c__fdiagnostics_show_option+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -fdiagnostics-show-option"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__fdiagnostics_show_option=yes
+else
+ gl_cv_warn_c__fdiagnostics_show_option=no
fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
- if test "$ac_cv_have_decl_i386" = "yes"; then
- canonical=`echo "$canonical" | sed -e 's/^amd64/i386/' -e 's/^x86_64/i386/'`
- machine=intel386
- machfile="m/${machine}.h"
- fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__fdiagnostics_show_option" >&5
+$as_echo "$gl_cv_warn_c__fdiagnostics_show_option" >&6; }
+if test "x$gl_cv_warn_c__fdiagnostics_show_option" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -fdiagnostics-show-option"
fi
-# Extract the first word of "install-info", so it can be a program name with args.
-set dummy install-info; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_INSTALL_INFO+set}" = set; then :
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -funit-at-a-time" >&5
+$as_echo_n "checking whether C compiler handles -funit-at-a-time... " >&6; }
+if test "${gl_cv_warn_c__funit_at_a_time+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- case $INSTALL_INFO in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_INSTALL_INFO="$INSTALL_INFO" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_INSTALL_INFO="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -funit-at-a-time"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__funit_at_a_time=yes
+else
+ gl_cv_warn_c__funit_at_a_time=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__funit_at_a_time" >&5
+$as_echo "$gl_cv_warn_c__funit_at_a_time" >&6; }
+if test "x$gl_cv_warn_c__funit_at_a_time" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -funit-at-a-time"
+fi
+
+
+
+
+$as_echo "#define lint 1" >>confdefs.h
+
+
+
+$as_echo "#define GNULIB_PORTCHECK 1" >>confdefs.h
+
+
+ # We use a slightly smaller set of warning options for lib/.
+ # Remove the following and save the result in GNULIB_WARN_CFLAGS.
+ nw=
+ nw="$nw -Wunused-macros"
+
+
+ gl_warn_set=
+ set x $WARN_CFLAGS; shift
+ for gl_warn_item
+ do
+ case " $nw " in
+ *" $gl_warn_item "*)
+ ;;
+ *)
+ gl_warn_set="$gl_warn_set $gl_warn_item"
+ ;;
+ esac
done
-IFS=$as_save_IFS
+ GNULIB_WARN_CFLAGS=$gl_warn_set
+
- ;;
-esac
fi
-INSTALL_INFO=$ac_cv_path_INSTALL_INFO
-if test -n "$INSTALL_INFO"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL_INFO" >&5
-$as_echo "$INSTALL_INFO" >&6; }
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5
+$as_echo_n "checking whether ln -s works... " >&6; }
+LN_S=$as_ln_s
+if test "$LN_S" = "ln -s"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5
+$as_echo "no, using $LN_S" >&6; }
fi
@@ -7463,7 +7968,7 @@ else
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /usr/sbin
+for as_dir in $PATH$PATH_SEPARATOR/usr/sbin$PATH_SEPARATOR/sbin
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
@@ -7477,6 +7982,7 @@ done
done
IFS=$as_save_IFS
+ test -z "$ac_cv_path_INSTALL_INFO" && ac_cv_path_INSTALL_INFO=":"
;;
esac
fi
@@ -7490,26 +7996,26 @@ $as_echo "no" >&6; }
fi
-# Extract the first word of "install-info", so it can be a program name with args.
-set dummy install-info; ac_word=$2
+# Extract the first word of "gzip", so it can be a program name with args.
+set dummy gzip; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_INSTALL_INFO+set}" = set; then :
+if test "${ac_cv_path_GZIP_PROG+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- case $INSTALL_INFO in
+ case $GZIP_PROG in
[\\/]* | ?:[\\/]*)
- ac_cv_path_INSTALL_INFO="$INSTALL_INFO" # Let the user override the test with a path.
+ ac_cv_path_GZIP_PROG="$GZIP_PROG" # Let the user override the test with a path.
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /sbin
+for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_INSTALL_INFO="$as_dir/$ac_word$ac_exec_ext"
+ ac_cv_path_GZIP_PROG="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
@@ -7517,40 +8023,41 @@ done
done
IFS=$as_save_IFS
- test -z "$ac_cv_path_INSTALL_INFO" && ac_cv_path_INSTALL_INFO=":"
;;
esac
fi
-INSTALL_INFO=$ac_cv_path_INSTALL_INFO
-if test -n "$INSTALL_INFO"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL_INFO" >&5
-$as_echo "$INSTALL_INFO" >&6; }
+GZIP_PROG=$ac_cv_path_GZIP_PROG
+if test -n "$GZIP_PROG"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GZIP_PROG" >&5
+$as_echo "$GZIP_PROG" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
-# Extract the first word of "gzip", so it can be a program name with args.
-set dummy gzip; ac_word=$2
+
+if test $opsys = gnu-linux; then
+ # Extract the first word of "paxctl", so it can be a program name with args.
+set dummy paxctl; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_GZIP_PROG+set}" = set; then :
+if test "${ac_cv_path_PAXCTL+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- case $GZIP_PROG in
+ case $PAXCTL in
[\\/]* | ?:[\\/]*)
- ac_cv_path_GZIP_PROG="$GZIP_PROG" # Let the user override the test with a path.
+ ac_cv_path_PAXCTL="$PAXCTL" # Let the user override the test with a path.
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
+for as_dir in $PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_GZIP_PROG="$as_dir/$ac_word$ac_exec_ext"
+ ac_cv_path_PAXCTL="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
@@ -7561,19 +8068,42 @@ IFS=$as_save_IFS
;;
esac
fi
-GZIP_PROG=$ac_cv_path_GZIP_PROG
-if test -n "$GZIP_PROG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GZIP_PROG" >&5
-$as_echo "$GZIP_PROG" >&6; }
+PAXCTL=$ac_cv_path_PAXCTL
+if test -n "$PAXCTL"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PAXCTL" >&5
+$as_echo "$PAXCTL" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
+ if test "X$PAXCTL" != X; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether binaries have a PT_PAX_FLAGS header" >&5
+$as_echo_n "checking whether binaries have a PT_PAX_FLAGS header... " >&6; }
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ if $PAXCTL -v conftest$EXEEXT >/dev/null 2>&1; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }; PAXCTL=""; fi
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ fi
+fi
-## Need makeinfo >= 4.6 (?) to build the manuals.
+## Need makeinfo >= 4.7 (?) to build the manuals.
# Extract the first word of "makeinfo", so it can be a program name with args.
set dummy makeinfo; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
@@ -7616,7 +8146,7 @@ fi
if test "$MAKEINFO" != "no" && \
- test x"`$MAKEINFO --version 2> /dev/null | $EGREP 'texinfo[^0-9]*([1-4][0-9]+|[5-9]|4\.[6-9]|4\.[1-5][0-9]+)'`" = x; then
+ test x"`$MAKEINFO --version 2> /dev/null | $EGREP 'texinfo[^0-9]*([1-4][0-9]+|[5-9]|4\.[7-9]|4\.[1-6][0-9]+)'`" = x; then
MAKEINFO=no
fi
@@ -7636,7 +8166,7 @@ if test "$MAKEINFO" = "no"; then
if test "x${with_makeinfo}" = "xno"; then
HAVE_MAKEINFO=no
elif test ! -e $srcdir/info/emacs; then
- as_fn_error "You do not seem to have makeinfo >= 4.6, and your
+ as_fn_error "You do not seem to have makeinfo >= 4.7, and your
source tree does not seem to have pre-built manuals in the \`info' directory.
Either install a suitable version of makeinfo, or re-run configure
with the \`--without-makeinfo' option to build without the manuals. " "$LINENO" 5
@@ -7644,6 +8174,11 @@ with the \`--without-makeinfo' option to build without the manuals. " "$LINENO"
fi
+INFO_EXT=.info
+INFO_OPTS=--no-split
+
+
+
if test x$GCC = xyes; then
test "x$GCC_LINK_TEST_OPTIONS" != x && \
@@ -7686,11 +8221,6 @@ rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
-# The value of CPP is a quoted variable reference, so we need to do this
-# to get its actual value...
-CPP=`eval "echo $CPP"`
-
-
test "x$CANNOT_DUMP" = "x" && CANNOT_DUMP=no
case "$opsys" in
your-opsys-here) CANNOT_DUMP=yes ;;
@@ -7742,7 +8272,9 @@ case "$opsys" in
## Let `ld' find image libs and similar things in /usr/local/lib.
## The system compiler, GCC, has apparently been modified to not
## look there, contrary to what a stock GCC would do.
- LD_SWITCH_SYSTEM=-L/usr/local/lib
+### It's not our place to do this. See bug#10313#17.
+### LD_SWITCH_SYSTEM=-L/usr/local/lib
+ :
;;
gnu-linux)
@@ -7751,7 +8283,9 @@ case "$opsys" in
;;
netbsd)
- LD_SWITCH_SYSTEM="-Wl,-rpath,/usr/pkg/lib -L/usr/pkg/lib -Wl,-rpath,/usr/local/lib -L/usr/local/lib"
+### It's not our place to do this. See bug#10313#17.
+### LD_SWITCH_SYSTEM="-Wl,-rpath,/usr/pkg/lib -L/usr/pkg/lib -Wl,-rpath,/usr/local/lib -L/usr/local/lib"
+ :
;;
openbsd)
@@ -7764,7 +8298,7 @@ esac
ac_link="$ac_link $LD_SWITCH_SYSTEM"
-## This setting of LD_SWITCH_SYSTEM references LD_SWITCH_X_SITE_AUX,
+## This setting of LD_SWITCH_SYSTEM references LD_SWITCH_X_SITE_RPATH,
## which has not been defined yet. When this was handled with cpp,
## it was expanded to null when configure sourced the s/*.h file.
## Thus LD_SWITCH_SYSTEM had different values in configure and the Makefiles.
@@ -7776,13 +8310,13 @@ ac_link="$ac_link $LD_SWITCH_SYSTEM"
## LD_SWITCH_SYSTEM_TEMACS.
case "$opsys" in
netbsd|openbsd)
- ## _AUX_RPATH is like _AUX, but uses -rpath instead of -R.
- LD_SWITCH_SYSTEM="\$(LD_SWITCH_X_SITE_AUX_RPATH) $LD_SWITCH_SYSTEM" ;;
+ LD_SWITCH_SYSTEM="\$(LD_SWITCH_X_SITE_RPATH) $LD_SWITCH_SYSTEM" ;;
esac
C_SWITCH_MACHINE=
-if test "$machine" = "alpha"; then
+case $canonical in
+ alpha*)
ac_fn_c_check_decl "$LINENO" "__ELF__" "ac_cv_have_decl___ELF__" "$ac_includes_default"
if test "x$ac_cv_have_decl___ELF__" = x""yes; then :
@@ -7802,7 +8336,8 @@ fi
else
UNEXEC_OBJ=unexalpha.o
fi
-fi
+ ;;
+esac
@@ -7848,211 +8383,11 @@ fi
# Likewise for obsolescent test for uid_t, gid_t; Emacs assumes them.
-# Check whether --enable-largefile was given.
-if test "${enable_largefile+set}" = set; then :
- enableval=$enable_largefile;
-fi
-
-if test "$enable_largefile" != no; then
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for special C compiler options needed for large files" >&5
-$as_echo_n "checking for special C compiler options needed for large files... " >&6; }
-if test "${ac_cv_sys_largefile_CC+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_cv_sys_largefile_CC=no
- if test "$GCC" != yes; then
- ac_save_CC=$CC
- while :; do
- # IRIX 6.2 and later do not support large files by default,
- # so use the C compiler's -n32 option if that helps.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
- if ac_fn_c_try_compile "$LINENO"; then :
- break
-fi
-rm -f core conftest.err conftest.$ac_objext
- CC="$CC -n32"
- if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_largefile_CC=' -n32'; break
-fi
-rm -f core conftest.err conftest.$ac_objext
- break
- done
- CC=$ac_save_CC
- rm -f conftest.$ac_ext
- fi
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_CC" >&5
-$as_echo "$ac_cv_sys_largefile_CC" >&6; }
- if test "$ac_cv_sys_largefile_CC" != no; then
- CC=$CC$ac_cv_sys_largefile_CC
- fi
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _FILE_OFFSET_BITS value needed for large files" >&5
-$as_echo_n "checking for _FILE_OFFSET_BITS value needed for large files... " >&6; }
-if test "${ac_cv_sys_file_offset_bits+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- while :; do
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_file_offset_bits=no; break
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#define _FILE_OFFSET_BITS 64
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_file_offset_bits=64; break
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- ac_cv_sys_file_offset_bits=unknown
- break
-done
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_file_offset_bits" >&5
-$as_echo "$ac_cv_sys_file_offset_bits" >&6; }
-case $ac_cv_sys_file_offset_bits in #(
- no | unknown) ;;
- *)
-cat >>confdefs.h <<_ACEOF
-#define _FILE_OFFSET_BITS $ac_cv_sys_file_offset_bits
-_ACEOF
-;;
-esac
-rm -rf conftest*
- if test $ac_cv_sys_file_offset_bits = unknown; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGE_FILES value needed for large files" >&5
-$as_echo_n "checking for _LARGE_FILES value needed for large files... " >&6; }
-if test "${ac_cv_sys_large_files+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- while :; do
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_large_files=no; break
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#define _LARGE_FILES 1
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_large_files=1; break
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- ac_cv_sys_large_files=unknown
- break
-done
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_large_files" >&5
-$as_echo "$ac_cv_sys_large_files" >&6; }
-case $ac_cv_sys_large_files in #(
- no | unknown) ;;
- *)
-cat >>confdefs.h <<_ACEOF
-#define _LARGE_FILES $ac_cv_sys_large_files
-_ACEOF
-;;
-esac
-rm -rf conftest*
- fi
-
-
-fi
-
-
LIB_MATH=-lm
LIB_STANDARD=
START_FILES=
+SYSTEM_TYPE=`echo $opsys | sed -e 's/[0-9].*//' -e 's|-|/|'`
case $opsys in
cygwin )
@@ -8065,8 +8400,9 @@ case $opsys in
START_FILES='pre-crt0.o'
;;
freebsd )
- LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtend.o $(CRT_DIR)/crtn.o'
- START_FILES='pre-crt0.o $(CRT_DIR)/crt1.o $(CRT_DIR)/crti.o $(CRT_DIR)/crtbegin.o'
+ LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtn.o'
+ START_FILES='pre-crt0.o $(CRT_DIR)/crt1.o $(CRT_DIR)/crti.o'
+ SYSTEM_TYPE=berkeley-unix
;;
gnu-linux | gnu-kfreebsd )
LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtn.o'
@@ -8079,12 +8415,23 @@ case $opsys in
netbsd | openbsd )
LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtend.o'
START_FILES='pre-crt0.o $(CRT_DIR)/crt0.o $(CRT_DIR)/crtbegin.o'
+ SYSTEM_TYPE=berkeley-unix
;;
+
+ sol2* | unixware )
+ SYSTEM_TYPE=usg-unix-v
+ ;;
+
esac
+cat >>confdefs.h <<_ACEOF
+#define SYSTEM_TYPE "$SYSTEM_TYPE"
+_ACEOF
+
+
crt_files=
for file in x $LIB_STANDARD $START_FILES; do
@@ -8191,6 +8538,51 @@ case $opsys in
esac
+pre_PKG_CONFIG_CFLAGS=$CFLAGS
+pre_PKG_CONFIG_LIBS=$LIBS
+
+# Extract the first word of "pkg-config", so it can be a program name with args.
+set dummy pkg-config; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ case $PKG_CONFIG in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+ test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
+ ;;
+esac
+fi
+PKG_CONFIG=$ac_cv_path_PKG_CONFIG
+if test -n "$PKG_CONFIG"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
+$as_echo "$PKG_CONFIG" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+
@@ -8260,48 +8652,6 @@ fi
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
HAVE_ALSA=no
else
@@ -8310,30 +8660,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ALSA_MODULES" >&5
$as_echo_n "checking for $ALSA_MODULES... " >&6; }
- if $PKG_CONFIG --exists "$ALSA_MODULES" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "$ALSA_MODULES" 2>&5 &&
+ ALSA_CFLAGS=`$PKG_CONFIG --cflags "$ALSA_MODULES" 2>&5` &&
+ ALSA_LIBS=`$PKG_CONFIG --libs "$ALSA_MODULES" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ ALSA_CFLAGS=`$as_echo "$ALSA_CFLAGS" | sed -e "$edit_cflags"`
+ ALSA_LIBS=`$as_echo "$ALSA_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$ALSA_CFLAGS' LIBS='$ALSA_LIBS'" >&5
+$as_echo "yes CFLAGS='$ALSA_CFLAGS' LIBS='$ALSA_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking ALSA_CFLAGS" >&5
-$as_echo_n "checking ALSA_CFLAGS... " >&6; }
- ALSA_CFLAGS=`$PKG_CONFIG --cflags "$ALSA_MODULES"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ALSA_CFLAGS" >&5
-$as_echo "$ALSA_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking ALSA_LIBS" >&5
-$as_echo_n "checking ALSA_LIBS... " >&6; }
- ALSA_LIBS=`$PKG_CONFIG --libs "$ALSA_MODULES"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ALSA_LIBS" >&5
-$as_echo "$ALSA_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
ALSA_CFLAGS=""
ALSA_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- ALSA_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "$ALSA_MODULES"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ ALSA_PKG_ERRORS=`($PKG_CONFIG --print-errors "$ALSA_MODULES") 2>&1`
fi
@@ -8419,14 +8768,14 @@ $as_echo "#define HAVE_SOUND 1" >>confdefs.h
fi
-for ac_header in sys/select.h sys/time.h unistd.h utime.h \
- linux/version.h sys/systeminfo.h \
- stdio_ext.h fcntl.h coff.h pty.h sys/mman.h \
- sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h \
- sys/utsname.h pwd.h utmp.h dirent.h util.h
+
+
+
+ for ac_header in $ac_header_list
do :
as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
-ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
+ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
+"
eval as_val=\$$as_ac_Header
if test "x$as_val" = x""yes; then :
cat >>confdefs.h <<_ACEOF
@@ -8438,6 +8787,27 @@ fi
done
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if personality LINUX32 can be set" >&5
$as_echo_n "checking if personality LINUX32 can be set... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
@@ -8513,7 +8883,9 @@ $as_echo "#define TIME_WITH_SYS_TIME 1" >>confdefs.h
fi
-ac_fn_c_check_decl "$LINENO" "sys_siglist" "ac_cv_have_decl_sys_siglist" "$ac_includes_default"
+ac_fn_c_check_decl "$LINENO" "sys_siglist" "ac_cv_have_decl_sys_siglist" "#include <signal.h>
+
+"
if test "x$ac_cv_have_decl_sys_siglist" = x""yes; then :
ac_have_decl=1
else
@@ -8526,7 +8898,9 @@ _ACEOF
if test $ac_cv_have_decl_sys_siglist != yes; then
# For Tru64, at least:
- ac_fn_c_check_decl "$LINENO" "__sys_siglist" "ac_cv_have_decl___sys_siglist" "$ac_includes_default"
+ ac_fn_c_check_decl "$LINENO" "__sys_siglist" "ac_cv_have_decl___sys_siglist" "#include <signal.h>
+
+"
if test "x$ac_cv_have_decl___sys_siglist" = x""yes; then :
ac_have_decl=1
else
@@ -8585,49 +8959,6 @@ $as_echo "#define HAVE_SYS_WAIT_H 1" >>confdefs.h
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct utimbuf" >&5
-$as_echo_n "checking for struct utimbuf... " >&6; }
-if test "${emacs_cv_struct_utimbuf+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
-#endif
-#ifdef HAVE_UTIME_H
-#include <utime.h>
-#endif
-int
-main ()
-{
-static struct utimbuf x; x.actime = x.modtime;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_struct_utimbuf=yes
-else
- emacs_cv_struct_utimbuf=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_struct_utimbuf" >&5
-$as_echo "$emacs_cv_struct_utimbuf" >&6; }
-if test $emacs_cv_struct_utimbuf = yes; then
-
-$as_echo "#define HAVE_STRUCT_UTIMBUF 1" >>confdefs.h
-
-fi
-
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for speed_t" >&5
$as_echo_n "checking for speed_t... " >&6; }
if test "${emacs_cv_speed_t+set}" = set; then :
@@ -8659,90 +8990,8 @@ $as_echo "#define HAVE_SPEED_T 1" >>confdefs.h
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timeval" >&5
-$as_echo_n "checking for struct timeval... " >&6; }
-if test "${emacs_cv_struct_timeval+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
-#endif
-int
-main ()
-{
-static struct timeval x; x.tv_sec = x.tv_usec;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_struct_timeval=yes
-else
- emacs_cv_struct_timeval=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_struct_timeval" >&5
-$as_echo "$emacs_cv_struct_timeval" >&6; }
-HAVE_TIMEVAL=$emacs_cv_struct_timeval
-if test $emacs_cv_struct_timeval = yes; then
-$as_echo "#define HAVE_TIMEVAL 1" >>confdefs.h
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct exception" >&5
-$as_echo_n "checking for struct exception... " >&6; }
-if test "${emacs_cv_struct_exception+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <math.h>
-int
-main ()
-{
-static struct exception x; x.arg1 = x.arg2 = x.retval; x.name = ""; x.type = 1;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_struct_exception=yes
-else
- emacs_cv_struct_exception=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_struct_exception" >&5
-$as_echo "$emacs_cv_struct_exception" >&6; }
-HAVE_EXCEPTION=$emacs_cv_struct_exception
-if test $emacs_cv_struct_exception != yes; then
-
-$as_echo "#define NO_MATHERR 1" >>confdefs.h
-
-fi
-
-for ac_header in sys/socket.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "sys/socket.h" "ac_cv_header_sys_socket_h" "$ac_includes_default"
-if test "x$ac_cv_header_sys_socket_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_SYS_SOCKET_H 1
-_ACEOF
-
-fi
-
-done
for ac_header in net/if.h
do :
@@ -8792,19 +9041,6 @@ fi
done
-for ac_func in getifaddrs freeifaddrs
-do :
- as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
-eval as_val=\$$as_ac_var
- if test "x$as_val" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
-
ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_flags" "ac_cv_member_struct_ifreq_ifr_flags" "$ac_includes_default
#if HAVE_SYS_SOCKET_H
@@ -8905,456 +9141,6 @@ fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for function prototypes" >&5
-$as_echo_n "checking for function prototypes... " >&6; }
-if test "$ac_cv_prog_cc_c89" != no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-$as_echo "#define PROTOTYPES 1" >>confdefs.h
-
-
-$as_echo "#define __PROTOTYPES 1" >>confdefs.h
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working volatile" >&5
-$as_echo_n "checking for working volatile... " >&6; }
-if test "${ac_cv_c_volatile+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-int
-main ()
-{
-
-volatile int x;
-int * volatile y = (int *) 0;
-return !x && !y;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_c_volatile=yes
-else
- ac_cv_c_volatile=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_volatile" >&5
-$as_echo "$ac_cv_c_volatile" >&6; }
-if test $ac_cv_c_volatile = no; then
-
-$as_echo "#define volatile /**/" >>confdefs.h
-
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for an ANSI C-conforming const" >&5
-$as_echo_n "checking for an ANSI C-conforming const... " >&6; }
-if test "${ac_cv_c_const+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-int
-main ()
-{
-/* FIXME: Include the comments suggested by Paul. */
-#ifndef __cplusplus
- /* Ultrix mips cc rejects this. */
- typedef int charset[2];
- const charset cs;
- /* SunOS 4.1.1 cc rejects this. */
- char const *const *pcpcc;
- char **ppc;
- /* NEC SVR4.0.2 mips cc rejects this. */
- struct point {int x, y;};
- static struct point const zero = {0,0};
- /* AIX XL C 1.02.0.0 rejects this.
- It does not let you subtract one const X* pointer from another in
- an arm of an if-expression whose if-part is not a constant
- expression */
- const char *g = "string";
- pcpcc = &g + (g ? g-g : 0);
- /* HPUX 7.0 cc rejects these. */
- ++pcpcc;
- ppc = (char**) pcpcc;
- pcpcc = (char const *const *) ppc;
- { /* SCO 3.2v4 cc rejects this. */
- char *t;
- char const *s = 0 ? (char *) 0 : (char const *) 0;
-
- *t++ = 0;
- if (s) return 0;
- }
- { /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */
- int x[] = {25, 17};
- const int *foo = &x[0];
- ++foo;
- }
- { /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
- typedef const int *iptr;
- iptr p = 0;
- ++p;
- }
- { /* AIX XL C 1.02.0.0 rejects this saying
- "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
- struct s { int j; const int *ap[3]; };
- struct s *b; b->j = 5;
- }
- { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
- const int foo = 10;
- if (!foo) return 0;
- }
- return !cs[0] && !zero.x;
-#endif
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_c_const=yes
-else
- ac_cv_c_const=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_const" >&5
-$as_echo "$ac_cv_c_const" >&6; }
-if test $ac_cv_c_const = no; then
-
-$as_echo "#define const /**/" >>confdefs.h
-
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for void * support" >&5
-$as_echo_n "checking for void * support... " >&6; }
-if test "${emacs_cv_void_star+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-int
-main ()
-{
-void * foo;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_void_star=yes
-else
- emacs_cv_void_star=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_void_star" >&5
-$as_echo "$emacs_cv_void_star" >&6; }
-if test $emacs_cv_void_star = yes; then
- $as_echo "#define POINTER_TYPE void" >>confdefs.h
-
-else
- $as_echo "#define POINTER_TYPE char" >>confdefs.h
-
-fi
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5
-$as_echo_n "checking whether byte ordering is bigendian... " >&6; }
-if test "${ac_cv_c_bigendian+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_cv_c_bigendian=unknown
- # See if we're dealing with a universal compiler.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#ifndef __APPLE_CC__
- not a universal capable compiler
- #endif
- typedef int dummy;
-
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
-
- # Check for potential -arch flags. It is not universal unless
- # there are at least two -arch flags with different values.
- ac_arch=
- ac_prev=
- for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do
- if test -n "$ac_prev"; then
- case $ac_word in
- i?86 | x86_64 | ppc | ppc64)
- if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then
- ac_arch=$ac_word
- else
- ac_cv_c_bigendian=universal
- break
- fi
- ;;
- esac
- ac_prev=
- elif test "x$ac_word" = "x-arch"; then
- ac_prev=arch
- fi
- done
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- if test $ac_cv_c_bigendian = unknown; then
- # See if sys/param.h defines the BYTE_ORDER macro.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- #include <sys/param.h>
-
-int
-main ()
-{
-#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \
- && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \
- && LITTLE_ENDIAN)
- bogus endian macros
- #endif
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- # It does; now see whether it defined to BIG_ENDIAN or not.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- #include <sys/param.h>
-
-int
-main ()
-{
-#if BYTE_ORDER != BIG_ENDIAN
- not big endian
- #endif
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_c_bigendian=yes
-else
- ac_cv_c_bigendian=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- fi
- if test $ac_cv_c_bigendian = unknown; then
- # See if <limits.h> defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris).
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <limits.h>
-
-int
-main ()
-{
-#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN)
- bogus endian macros
- #endif
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- # It does; now see whether it defined to _BIG_ENDIAN or not.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <limits.h>
-
-int
-main ()
-{
-#ifndef _BIG_ENDIAN
- not big endian
- #endif
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_c_bigendian=yes
-else
- ac_cv_c_bigendian=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- fi
- if test $ac_cv_c_bigendian = unknown; then
- # Compile a test program.
- if test "$cross_compiling" = yes; then :
- # Try to guess by grepping values from an object file.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-short int ascii_mm[] =
- { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
- short int ascii_ii[] =
- { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
- int use_ascii (int i) {
- return ascii_mm[i] + ascii_ii[i];
- }
- short int ebcdic_ii[] =
- { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
- short int ebcdic_mm[] =
- { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 };
- int use_ebcdic (int i) {
- return ebcdic_mm[i] + ebcdic_ii[i];
- }
- extern int foo;
-
-int
-main ()
-{
-return use_ascii (foo) == use_ebcdic (foo);
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then
- ac_cv_c_bigendian=yes
- fi
- if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then
- if test "$ac_cv_c_bigendian" = unknown; then
- ac_cv_c_bigendian=no
- else
- # finding both strings is unlikely to happen, but who knows?
- ac_cv_c_bigendian=unknown
- fi
- fi
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-
- /* Are we little or big endian? From Harbison&Steele. */
- union
- {
- long int l;
- char c[sizeof (long int)];
- } u;
- u.l = 1;
- return u.c[sizeof (long int) - 1] == 1;
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- ac_cv_c_bigendian=no
-else
- ac_cv_c_bigendian=yes
-fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
-fi
-
- fi
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5
-$as_echo "$ac_cv_c_bigendian" >&6; }
- case $ac_cv_c_bigendian in #(
- yes)
- $as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h
-;; #(
- no)
- ;; #(
- universal)
-
-$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h
-
- ;; #(
- *)
- as_fn_error "unknown endianness
- presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;;
- esac
-
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __attribute__ ((__aligned__ (expr)))" >&5
-$as_echo_n "checking for __attribute__ ((__aligned__ (expr)))... " >&6; }
-if test "${emacs_cv_attribute_aligned+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-char __attribute__ ((__aligned__ (1 << 3))) c;
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_attribute_aligned=yes
-else
- emacs_cv_attribute_aligned=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_attribute_aligned" >&5
-$as_echo "$emacs_cv_attribute_aligned" >&6; }
-if test $emacs_cv_attribute_aligned = yes; then
-
-$as_echo "#define HAVE_ATTRIBUTE_ALIGNED 1" >>confdefs.h
-
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5
-$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; }
-set x ${MAKE-make}
-ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'`
-if { as_var=ac_cv_prog_make_${ac_make}_set; eval "test \"\${$as_var+set}\" = set"; }; then :
- $as_echo_n "(cached) " >&6
-else
- cat >conftest.make <<\_ACEOF
-SHELL = /bin/sh
-all:
- @echo '@@@%%%=$(MAKE)=@@@%%%'
-_ACEOF
-# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
-case `${MAKE-make} -f conftest.make 2>/dev/null` in
- *@@@%%%=?*=@@@%%%*)
- eval ac_cv_prog_make_${ac_make}_set=yes;;
- *)
- eval ac_cv_prog_make_${ac_make}_set=no;;
-esac
-rm -f conftest.make
-fi
-if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- SET_MAKE=
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- SET_MAKE="MAKE=${MAKE-make}"
-fi
-
DEPFLAGS=
MKDEPDIR=":"
@@ -9401,10 +9187,8 @@ $as_echo "$ac_enable_autodepend" >&6; }
fi
if test $ac_enable_autodepend = yes; then
DEPFLAGS='-MMD -MF ${DEPDIR}/$*.d -MP'
- ## In parallel builds, another make might create depdir between
- ## the first test and mkdir, so stick another test on the end.
- ## Or use install-sh -d? mkdir -p is not portable.
- MKDEPDIR='test -d ${DEPDIR} || mkdir ${DEPDIR} || test -d ${DEPDIR}'
+ ## MKDIR_P is documented (see AC_PROG_MKDIR_P) to be parallel-safe.
+ MKDEPDIR='${MKDIR_P} ${DEPDIR}'
deps_frag=autodeps.mk
fi
fi
@@ -9461,6 +9245,12 @@ fi
#### Choose a window system.
+## We leave window_system equal to none if
+## we end up building without one. Any new window system should
+## set window_system to an appropriate value and add objects to
+## window-system-specific substs.
+
+window_system=none
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5
$as_echo_n "checking for X... " >&6; }
@@ -9654,28 +9444,15 @@ else
$as_echo "libraries $x_libraries, headers $x_includes" >&6; }
fi
-if test "$no_x" = yes; then
- window_system=none
-else
+if test "$no_x" != yes; then
window_system=x11
fi
-## Workaround for bug in autoconf <= 2.62.
-## http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg01551.html
-## No need to do anything special for these standard directories.
-if test -n "${x_libraries}" && test x"${x_libraries}" != xNONE; then
-
- x_libraries=`echo :${x_libraries}: | sed -e 's|:/usr/lib64:|:|g' -e 's|:/lib64:|:|g' -e 's|^:||' -e 's|:$||'`
-
-fi
-
-LD_SWITCH_X_SITE_AUX=
-LD_SWITCH_X_SITE_AUX_RPATH=
+LD_SWITCH_X_SITE_RPATH=
if test "${x_libraries}" != NONE; then
if test -n "${x_libraries}"; then
LD_SWITCH_X_SITE=-L`echo ${x_libraries} | sed -e "s/:/ -L/g"`
- LD_SWITCH_X_SITE_AUX=-R`echo ${x_libraries} | sed -e "s/:/ -R/g"`
- LD_SWITCH_X_SITE_AUX_RPATH=`echo ${LD_SWITCH_X_SITE_AUX} | sed -e 's/-R/-Wl,-rpath,/'`
+ LD_SWITCH_X_SITE_RPATH=-Wl,-rpath,`echo ${x_libraries} | sed -e "s/:/ -Wl,-rpath,/g"`
fi
x_default_search_path=""
x_search_path=${x_libraries}
@@ -9700,9 +9477,8 @@ ${x_library}/X11/%T/%N%S"
fi
-
if test "${x_includes}" != NONE && test -n "${x_includes}"; then
- C_SWITCH_X_SITE=-I`echo ${x_includes} | sed -e "s/:/ -I/g"`
+ C_SWITCH_X_SITE="$isystem"`echo ${x_includes} | sed -e "s/:/ $isystem/g"`
fi
if test x"${x_includes}" = x; then
@@ -9736,15 +9512,15 @@ if test "${with_ns}" != no; then
if test "${opsys}" = darwin; then
NS_IMPL_COCOA=yes
ns_appdir=`pwd`/nextstep/Emacs.app
- ns_appbindir=${ns_appdir}/Contents/MacOS/
+ ns_appbindir=${ns_appdir}/Contents/MacOS
ns_appresdir=${ns_appdir}/Contents/Resources
- ns_appsrc=${srcdir}/nextstep/Cocoa/Emacs.base
+ ns_appsrc=Cocoa/Emacs.base
elif test -f $GNUSTEP_CONFIG_FILE; then
NS_IMPL_GNUSTEP=yes
ns_appdir=`pwd`/nextstep/Emacs.app
- ns_appbindir=${ns_appdir}/
+ ns_appbindir=${ns_appdir}
ns_appresdir=${ns_appdir}/Resources
- ns_appsrc=${srcdir}/nextstep/GNUstep/Emacs.base
+ ns_appsrc=GNUstep/Emacs.base
GNUSTEP_SYSTEM_HEADERS="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_SYSTEM_HEADERS)"
GNUSTEP_SYSTEM_LIBRARIES="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_SYSTEM_LIBRARIES)"
GNUSTEP_LOCAL_HEADERS="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_LOCAL_HEADERS)"
@@ -9807,7 +9583,32 @@ else
fi
- NS_HAVE_NSINTEGER=yes
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <AppKit/AppKit.h>
+int
+main ()
+{
+
+#ifdef MAC_OS_X_VERSION_MAX_ALLOWED
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1040
+ ; /* OK */
+#else
+#error "OSX 10.4 or newer required"
+#endif
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ns_osx_have_104=yes
+else
+ ns_osx_have_104=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <Foundation/NSObjCRuntime.h>
@@ -9825,26 +9626,43 @@ else
ns_have_nsinteger=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- if test $ns_have_nsinteger = no; then
- NS_HAVE_NSINTEGER=no
+ if test $ns_osx_have_104 = no; then
+ as_fn_error "\`OSX 10.4 or newer is required'" "$LINENO" 5;
+ fi
+ if test $ns_have_nsinteger = yes; then
+
+$as_echo "#define NS_HAVE_NSINTEGER 1" >>confdefs.h
+
fi
fi
-ns_frag=/dev/null
+
+INSTALL_ARCH_INDEP_EXTRA=install-etc
+ns_self_contained=no
NS_OBJ=
NS_OBJC_OBJ=
if test "${HAVE_NS}" = yes; then
+ if test "$with_toolkit_scroll_bars" = "no"; then
+ as_fn_error "Non-toolkit scroll bars are not implemented for Nextstep." "$LINENO" 5
+ fi
+
window_system=nextstep
- with_xft=no
# set up packaging dirs
if test "${EN_NS_SELF_CONTAINED}" = yes; then
+ ns_self_contained=yes
prefix=${ns_appresdir}
exec_prefix=${ns_appbindir}
- libexecdir=${ns_appbindir}/libexec
+ libexecdir="\${ns_appbindir}/libexec"
+ archlibdir="\${ns_appbindir}/libexec"
+ docdir="\${ns_appresdir}/etc"
+ etcdir="\${ns_appresdir}/etc"
+ infodir="\${ns_appresdir}/info"
+ mandir="\${ns_appresdir}/man"
+ lispdir="\${ns_appresdir}/lisp"
+ leimdir="\${ns_appresdir}/leim"
+ INSTALL_ARCH_INDEP_EXTRA=
fi
- ns_frag=$srcdir/src/ns.mk
- NS_OBJ="fontset.o fringe.o image.o"
NS_OBJC_OBJ="nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o"
fi
CFLAGS="$tmp_CFLAGS"
@@ -9854,28 +9672,84 @@ CPPFLAGS="$tmp_CPPFLAGS"
+
+HAVE_W32=no
+W32_OBJ=
+W32_LIBS=
+if test "${with_w32}" != no; then
+ if test "${opsys}" != "cygwin"; then
+ as_fn_error "Using w32 with an autotools build is only supported for Cygwin." "$LINENO" 5
+ fi
+ ac_fn_c_check_header_mongrel "$LINENO" "windows.h" "ac_cv_header_windows_h" "$ac_includes_default"
+if test "x$ac_cv_header_windows_h" = x""yes; then :
+ HAVE_W32=yes
+else
+ as_fn_error "\`--with-w32' was specified, but windows.h
+ cannot be found." "$LINENO" 5
+fi
+
+
+
+$as_echo "#define HAVE_NTGUI 1" >>confdefs.h
+
+ W32_OBJ="w32fns.o w32menu.o w32reg.o w32font.o w32term.o"
+ W32_OBJ="$W32_OBJ w32xfns.o w32select.o w32uniscribe.o"
+ W32_LIBS="$W32_LIBS -lkernel32 -luser32 -lgdi32 -lole32 -lcomdlg32"
+ W32_LIBS="$W32_LIBS -lusp10 -lcomctl32 -lwinspool"
+fi
+
+
+
+if test "${HAVE_W32}" = "yes"; then
+ window_system=w32
+ with_xft=no
+fi
+
+## $window_system is now set to the window system we will
+## ultimately use.
+
+term_header=
+HAVE_X_WINDOWS=no
+HAVE_X11=no
+USE_X_TOOLKIT=none
+
case "${window_system}" in
x11 )
HAVE_X_WINDOWS=yes
HAVE_X11=yes
+ term_header=xterm.h
case "${with_x_toolkit}" in
athena | lucid ) USE_X_TOOLKIT=LUCID ;;
motif ) USE_X_TOOLKIT=MOTIF ;;
gtk ) with_gtk=yes
+ term_header=gtkutil.h
USE_X_TOOLKIT=none ;;
+ gtk2 ) with_gtk2=yes
+ term_header=gtkutil.h
+ USE_X_TOOLKIT=none ;;
gtk3 ) with_gtk3=yes
+ term_header=gtkutil.h
USE_X_TOOLKIT=none ;;
no ) USE_X_TOOLKIT=none ;;
* ) USE_X_TOOLKIT=maybe ;;
esac
;;
- nextstep | none )
- HAVE_X_WINDOWS=no
- HAVE_X11=no
- USE_X_TOOLKIT=none
+ nextstep )
+ term_header=nsterm.h
+ ;;
+ w32 )
+ term_header=w32term.h
;;
esac
+if test -n "${term_header}"; then
+
+cat >>confdefs.h <<_ACEOF
+#define TERM_HEADER "${term_header}"
+_ACEOF
+
+fi
+
if test "$window_system" = none && test "X$with_x" != "Xno"; then
# Extract the first word of "X", so it can be a program name with args.
set dummy X; ac_word=$2
@@ -9935,53 +9809,40 @@ case ${HAVE_X11} in
yes ) HAVE_MENUS=yes ;;
esac
-# Do the opsystem or machine files prohibit the use of the GNU malloc?
+# Does the opsystem file prohibit the use of the GNU malloc?
# Assume not, until told otherwise.
GNU_MALLOC=yes
-doug_lea_malloc=yes
-ac_fn_c_check_func "$LINENO" "malloc_get_state" "ac_cv_func_malloc_get_state"
-if test "x$ac_cv_func_malloc_get_state" = x""yes; then :
-
-else
- doug_lea_malloc=no
-fi
-
-ac_fn_c_check_func "$LINENO" "malloc_set_state" "ac_cv_func_malloc_set_state"
-if test "x$ac_cv_func_malloc_set_state" = x""yes; then :
-else
- doug_lea_malloc=no
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether __after_morecore_hook exists" >&5
-$as_echo_n "checking whether __after_morecore_hook exists... " >&6; }
-if test "${emacs_cv_var___after_morecore_hook+set}" = set; then :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether malloc is Doug Lea style" >&5
+$as_echo_n "checking whether malloc is Doug Lea style... " >&6; }
+if test "${emacs_cv_var_doug_lea_malloc+set}" = set; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-extern void (* __after_morecore_hook)();
+#include <malloc.h>
+ static void hook (void) {}
int
main ()
{
-__after_morecore_hook = 0
+malloc_set_state (malloc_get_state ());
+ __after_morecore_hook = hook;
+ __malloc_initialize_hook = hook;
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- emacs_cv_var___after_morecore_hook=yes
+ emacs_cv_var_doug_lea_malloc=yes
else
- emacs_cv_var___after_morecore_hook=no
+ emacs_cv_var_doug_lea_malloc=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_var___after_morecore_hook" >&5
-$as_echo "$emacs_cv_var___after_morecore_hook" >&6; }
-if test $emacs_cv_var___after_morecore_hook = no; then
- doug_lea_malloc=no
-fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_var_doug_lea_malloc" >&5
+$as_echo "$emacs_cv_var_doug_lea_malloc" >&6; }
+doug_lea_malloc=$emacs_cv_var_doug_lea_malloc
system_malloc=no
@@ -10036,24 +9897,6 @@ esac
- for ac_header in $ac_header_list
-do :
- as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
-ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
-"
-eval as_val=\$$as_ac_Header
- if test "x$as_val" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-
-done
-
-
-
-
@@ -10326,17 +10169,8 @@ fi
LIB_PTHREAD=
-for ac_header in pthread.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "pthread.h" "ac_cv_header_pthread_h" "$ac_includes_default"
-if test "x$ac_cv_header_pthread_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_PTHREAD_H 1
-_ACEOF
-fi
-done
if test "$ac_cv_header_pthread_h"; then
if test "$GMALLOC_OBJ" = gmalloc.o; then
@@ -10513,9 +10347,9 @@ if test "${HAVE_X11}" = "yes"; then
CPPFLAGS="$C_SWITCH_X_SITE $CPPFLAGS"
# On Solaris, arrange for LD_RUN_PATH to point to the X libraries for tests.
- # This is handled by LD_SWITCH_X_SITE_AUX during the real build,
- # but it's more convenient here to set LD_RUN_PATH
- # since this also works on hosts that don't understand LD_SWITCH_X_SITE_AUX.
+ # This is handled by LD_SWITCH_X_SITE_RPATH during the real build,
+ # but it's more convenient here to set LD_RUN_PATH since this
+ # also works on hosts that don't understand LD_SWITCH_X_SITE_RPATH.
if test "${x_libraries}" != NONE && test -n "${x_libraries}"; then
LD_RUN_PATH=$x_libraries${LD_RUN_PATH+:}$LD_RUN_PATH
export LD_RUN_PATH
@@ -10620,7 +10454,7 @@ $as_echo "#define HAVE_XKBGETKEYBOARD 1" >>confdefs.h
fi
for ac_func in XrmSetDatabase XScreenResourceString \
-XScreenNumberOfScreen XSetWMProtocols
+XScreenNumberOfScreen
do :
as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
@@ -10699,48 +10533,6 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes"; then
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
:
else
@@ -10749,30 +10541,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $RSVG_MODULE" >&5
$as_echo_n "checking for $RSVG_MODULE... " >&6; }
- if $PKG_CONFIG --exists "$RSVG_MODULE" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "$RSVG_MODULE" 2>&5 &&
+ RSVG_CFLAGS=`$PKG_CONFIG --cflags "$RSVG_MODULE" 2>&5` &&
+ RSVG_LIBS=`$PKG_CONFIG --libs "$RSVG_MODULE" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ RSVG_CFLAGS=`$as_echo "$RSVG_CFLAGS" | sed -e "$edit_cflags"`
+ RSVG_LIBS=`$as_echo "$RSVG_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$RSVG_CFLAGS' LIBS='$RSVG_LIBS'" >&5
+$as_echo "yes CFLAGS='$RSVG_CFLAGS' LIBS='$RSVG_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking RSVG_CFLAGS" >&5
-$as_echo_n "checking RSVG_CFLAGS... " >&6; }
- RSVG_CFLAGS=`$PKG_CONFIG --cflags "$RSVG_MODULE"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RSVG_CFLAGS" >&5
-$as_echo "$RSVG_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking RSVG_LIBS" >&5
-$as_echo_n "checking RSVG_LIBS... " >&6; }
- RSVG_LIBS=`$PKG_CONFIG --libs "$RSVG_MODULE"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RSVG_LIBS" >&5
-$as_echo "$RSVG_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
RSVG_CFLAGS=""
RSVG_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- RSVG_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "$RSVG_MODULE"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ RSVG_PKG_ERRORS=`($PKG_CONFIG --print-errors "$RSVG_MODULE") 2>&1`
fi
@@ -10813,48 +10604,6 @@ if test "${HAVE_X11}" = "yes"; then
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
:
else
@@ -10863,30 +10612,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $IMAGEMAGICK_MODULE" >&5
$as_echo_n "checking for $IMAGEMAGICK_MODULE... " >&6; }
- if $PKG_CONFIG --exists "$IMAGEMAGICK_MODULE" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "$IMAGEMAGICK_MODULE" 2>&5 &&
+ IMAGEMAGICK_CFLAGS=`$PKG_CONFIG --cflags "$IMAGEMAGICK_MODULE" 2>&5` &&
+ IMAGEMAGICK_LIBS=`$PKG_CONFIG --libs "$IMAGEMAGICK_MODULE" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ IMAGEMAGICK_CFLAGS=`$as_echo "$IMAGEMAGICK_CFLAGS" | sed -e "$edit_cflags"`
+ IMAGEMAGICK_LIBS=`$as_echo "$IMAGEMAGICK_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$IMAGEMAGICK_CFLAGS' LIBS='$IMAGEMAGICK_LIBS'" >&5
+$as_echo "yes CFLAGS='$IMAGEMAGICK_CFLAGS' LIBS='$IMAGEMAGICK_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking IMAGEMAGICK_CFLAGS" >&5
-$as_echo_n "checking IMAGEMAGICK_CFLAGS... " >&6; }
- IMAGEMAGICK_CFLAGS=`$PKG_CONFIG --cflags "$IMAGEMAGICK_MODULE"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $IMAGEMAGICK_CFLAGS" >&5
-$as_echo "$IMAGEMAGICK_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking IMAGEMAGICK_LIBS" >&5
-$as_echo_n "checking IMAGEMAGICK_LIBS... " >&6; }
- IMAGEMAGICK_LIBS=`$PKG_CONFIG --libs "$IMAGEMAGICK_MODULE"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $IMAGEMAGICK_LIBS" >&5
-$as_echo "$IMAGEMAGICK_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
IMAGEMAGICK_CFLAGS=""
IMAGEMAGICK_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- IMAGEMAGICK_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "$IMAGEMAGICK_MODULE"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ IMAGEMAGICK_PKG_ERRORS=`($PKG_CONFIG --print-errors "$IMAGEMAGICK_MODULE") 2>&1`
fi
@@ -10913,12 +10661,14 @@ $as_echo "#define HAVE_IMAGEMAGICK 1" >>confdefs.h
CFLAGS="$CFLAGS $IMAGEMAGICK_CFLAGS"
LIBS="$IMAGEMAGICK_LIBS $LIBS"
- for ac_func in MagickExportImagePixels
+ for ac_func in MagickExportImagePixels MagickMergeImageLayers
do :
- ac_fn_c_check_func "$LINENO" "MagickExportImagePixels" "ac_cv_func_MagickExportImagePixels"
-if test "x$ac_cv_func_MagickExportImagePixels" = x""yes; then :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
cat >>confdefs.h <<_ACEOF
-#define HAVE_MAGICKEXPORTIMAGEPIXELS 1
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
fi
@@ -10931,7 +10681,9 @@ fi
HAVE_GTK=no
GTK_OBJ=
-if test "${with_gtk3}" = "yes"; then
+check_gtk2=no
+gtk3_pkg_errors=
+if test "${with_gtk3}" = "yes" || test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then
GLIB_REQUIRED=2.28
GTK_REQUIRED=3.0
GTK_MODULES="gtk+-3.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED"
@@ -10939,48 +10691,6 @@ if test "${with_gtk3}" = "yes"; then
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
pkg_check_gtk=no
else
@@ -10989,30 +10699,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $GTK_MODULES" >&5
$as_echo_n "checking for $GTK_MODULES... " >&6; }
- if $PKG_CONFIG --exists "$GTK_MODULES" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "$GTK_MODULES" 2>&5 &&
+ GTK_CFLAGS=`$PKG_CONFIG --cflags "$GTK_MODULES" 2>&5` &&
+ GTK_LIBS=`$PKG_CONFIG --libs "$GTK_MODULES" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ GTK_CFLAGS=`$as_echo "$GTK_CFLAGS" | sed -e "$edit_cflags"`
+ GTK_LIBS=`$as_echo "$GTK_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GTK_CFLAGS' LIBS='$GTK_LIBS'" >&5
+$as_echo "yes CFLAGS='$GTK_CFLAGS' LIBS='$GTK_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GTK_CFLAGS" >&5
-$as_echo_n "checking GTK_CFLAGS... " >&6; }
- GTK_CFLAGS=`$PKG_CONFIG --cflags "$GTK_MODULES"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GTK_CFLAGS" >&5
-$as_echo "$GTK_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GTK_LIBS" >&5
-$as_echo_n "checking GTK_LIBS... " >&6; }
- GTK_LIBS=`$PKG_CONFIG --libs "$GTK_MODULES"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GTK_LIBS" >&5
-$as_echo "$GTK_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
GTK_CFLAGS=""
GTK_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- GTK_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "$GTK_MODULES"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ GTK_PKG_ERRORS=`($PKG_CONFIG --print-errors "$GTK_MODULES") 2>&1`
fi
@@ -11030,18 +10739,23 @@ $as_echo "no" >&6; }
pkg_check_gtk=no
fi
- if test "$pkg_check_gtk" = "no" && test "$USE_X_TOOLKIT" != "maybe"; then
+ if test "$pkg_check_gtk" = "no" && test "$with_gtk3" = "yes"; then
as_fn_error "$GTK_PKG_ERRORS" "$LINENO" 5
fi
+ if test "$pkg_check_gtk" = "yes"; then
$as_echo "#define HAVE_GTK3 1" >>confdefs.h
- GTK_OBJ=emacsgtkfixed.o
+ GTK_OBJ=emacsgtkfixed.o
+ term_header=gtkutil.h
+ USE_GTK_TOOLKIT="GTK3"
+ else
+ check_gtk2=yes
+ gtk3_pkg_errors="$GTK_PKG_ERRORS "
+ fi
fi
-if test "$pkg_check_gtk" != "yes"; then
- HAVE_GTK=no
-if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then
+if test "${with_gtk2}" = "yes" || test "$check_gtk2" = "yes"; then
GLIB_REQUIRED=2.10
GTK_REQUIRED=2.10
GTK_MODULES="gtk+-2.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED"
@@ -11049,48 +10763,6 @@ if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
pkg_check_gtk=no
else
@@ -11099,30 +10771,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $GTK_MODULES" >&5
$as_echo_n "checking for $GTK_MODULES... " >&6; }
- if $PKG_CONFIG --exists "$GTK_MODULES" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "$GTK_MODULES" 2>&5 &&
+ GTK_CFLAGS=`$PKG_CONFIG --cflags "$GTK_MODULES" 2>&5` &&
+ GTK_LIBS=`$PKG_CONFIG --libs "$GTK_MODULES" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ GTK_CFLAGS=`$as_echo "$GTK_CFLAGS" | sed -e "$edit_cflags"`
+ GTK_LIBS=`$as_echo "$GTK_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GTK_CFLAGS' LIBS='$GTK_LIBS'" >&5
+$as_echo "yes CFLAGS='$GTK_CFLAGS' LIBS='$GTK_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GTK_CFLAGS" >&5
-$as_echo_n "checking GTK_CFLAGS... " >&6; }
- GTK_CFLAGS=`$PKG_CONFIG --cflags "$GTK_MODULES"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GTK_CFLAGS" >&5
-$as_echo "$GTK_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GTK_LIBS" >&5
-$as_echo_n "checking GTK_LIBS... " >&6; }
- GTK_LIBS=`$PKG_CONFIG --libs "$GTK_MODULES"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GTK_LIBS" >&5
-$as_echo "$GTK_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
GTK_CFLAGS=""
GTK_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- GTK_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "$GTK_MODULES"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ GTK_PKG_ERRORS=`($PKG_CONFIG --print-errors "$GTK_MODULES") 2>&1`
fi
@@ -11140,10 +10811,12 @@ $as_echo "no" >&6; }
pkg_check_gtk=no
fi
- if test "$pkg_check_gtk" = "no" && test "$USE_X_TOOLKIT" != "maybe"; then
- as_fn_error "$GTK_PKG_ERRORS" "$LINENO" 5
+ if test "$pkg_check_gtk" = "no" &&
+ { test "$with_gtk" = yes || test "$with_gtk2" = "yes"; }
+ then
+ as_fn_error "$gtk3_pkg_errors$GTK_PKG_ERRORS" "$LINENO" 5
fi
-fi
+ test "$pkg_check_gtk" = "yes" && USE_GTK_TOOLKIT="GTK2"
fi
if test x"$pkg_check_gtk" = xyes; then
@@ -11243,6 +10916,8 @@ _ACEOF
fi
done
+
+ term_header=gtkutil.h
fi
HAVE_DBUS=no
@@ -11251,48 +10926,6 @@ if test "${with_dbus}" = "yes"; then
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
HAVE_DBUS=no
else
@@ -11301,30 +10934,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dbus-1 >= 1.0" >&5
$as_echo_n "checking for dbus-1 >= 1.0... " >&6; }
- if $PKG_CONFIG --exists "dbus-1 >= 1.0" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "dbus-1 >= 1.0" 2>&5 &&
+ DBUS_CFLAGS=`$PKG_CONFIG --cflags "dbus-1 >= 1.0" 2>&5` &&
+ DBUS_LIBS=`$PKG_CONFIG --libs "dbus-1 >= 1.0" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ DBUS_CFLAGS=`$as_echo "$DBUS_CFLAGS" | sed -e "$edit_cflags"`
+ DBUS_LIBS=`$as_echo "$DBUS_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$DBUS_CFLAGS' LIBS='$DBUS_LIBS'" >&5
+$as_echo "yes CFLAGS='$DBUS_CFLAGS' LIBS='$DBUS_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking DBUS_CFLAGS" >&5
-$as_echo_n "checking DBUS_CFLAGS... " >&6; }
- DBUS_CFLAGS=`$PKG_CONFIG --cflags "dbus-1 >= 1.0"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DBUS_CFLAGS" >&5
-$as_echo "$DBUS_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking DBUS_LIBS" >&5
-$as_echo_n "checking DBUS_LIBS... " >&6; }
- DBUS_LIBS=`$PKG_CONFIG --libs "dbus-1 >= 1.0"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DBUS_LIBS" >&5
-$as_echo "$DBUS_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
DBUS_CFLAGS=""
DBUS_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- DBUS_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "dbus-1 >= 1.0"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ DBUS_PKG_ERRORS=`($PKG_CONFIG --print-errors "dbus-1 >= 1.0") 2>&1`
fi
@@ -11347,12 +10979,19 @@ $as_echo "no" >&6; }
$as_echo "#define HAVE_DBUS 1" >>confdefs.h
- for ac_func in dbus_watch_get_unix_fd
+ for ac_func in dbus_watch_get_unix_fd \
+ dbus_type_is_valid \
+ dbus_validate_bus_name \
+ dbus_validate_path \
+ dbus_validate_interface \
+ dbus_validate_member
do :
- ac_fn_c_check_func "$LINENO" "dbus_watch_get_unix_fd" "ac_cv_func_dbus_watch_get_unix_fd"
-if test "x$ac_cv_func_dbus_watch_get_unix_fd" = x""yes; then :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
cat >>confdefs.h <<_ACEOF
-#define HAVE_DBUS_WATCH_GET_UNIX_FD 1
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
fi
@@ -11368,48 +11007,6 @@ if test "${HAVE_X11}" = "yes" && test "${with_gsettings}" = "yes"; then
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
HAVE_GSETTINGS=no
else
@@ -11418,30 +11015,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gio-2.0 >= 2.26" >&5
$as_echo_n "checking for gio-2.0 >= 2.26... " >&6; }
- if $PKG_CONFIG --exists "gio-2.0 >= 2.26" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "gio-2.0 >= 2.26" 2>&5 &&
+ GSETTINGS_CFLAGS=`$PKG_CONFIG --cflags "gio-2.0 >= 2.26" 2>&5` &&
+ GSETTINGS_LIBS=`$PKG_CONFIG --libs "gio-2.0 >= 2.26" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ GSETTINGS_CFLAGS=`$as_echo "$GSETTINGS_CFLAGS" | sed -e "$edit_cflags"`
+ GSETTINGS_LIBS=`$as_echo "$GSETTINGS_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GSETTINGS_CFLAGS' LIBS='$GSETTINGS_LIBS'" >&5
+$as_echo "yes CFLAGS='$GSETTINGS_CFLAGS' LIBS='$GSETTINGS_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GSETTINGS_CFLAGS" >&5
-$as_echo_n "checking GSETTINGS_CFLAGS... " >&6; }
- GSETTINGS_CFLAGS=`$PKG_CONFIG --cflags "gio-2.0 >= 2.26"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GSETTINGS_CFLAGS" >&5
-$as_echo "$GSETTINGS_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GSETTINGS_LIBS" >&5
-$as_echo_n "checking GSETTINGS_LIBS... " >&6; }
- GSETTINGS_LIBS=`$PKG_CONFIG --libs "gio-2.0 >= 2.26"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GSETTINGS_LIBS" >&5
-$as_echo "$GSETTINGS_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
GSETTINGS_CFLAGS=""
GSETTINGS_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- GSETTINGS_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "gio-2.0 >= 2.26"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ GSETTINGS_PKG_ERRORS=`($PKG_CONFIG --print-errors "gio-2.0 >= 2.26") 2>&1`
fi
@@ -11473,48 +11069,6 @@ if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
HAVE_GCONF=no
else
@@ -11523,30 +11077,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gconf-2.0 >= 2.13" >&5
$as_echo_n "checking for gconf-2.0 >= 2.13... " >&6; }
- if $PKG_CONFIG --exists "gconf-2.0 >= 2.13" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "gconf-2.0 >= 2.13" 2>&5 &&
+ GCONF_CFLAGS=`$PKG_CONFIG --cflags "gconf-2.0 >= 2.13" 2>&5` &&
+ GCONF_LIBS=`$PKG_CONFIG --libs "gconf-2.0 >= 2.13" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ GCONF_CFLAGS=`$as_echo "$GCONF_CFLAGS" | sed -e "$edit_cflags"`
+ GCONF_LIBS=`$as_echo "$GCONF_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GCONF_CFLAGS' LIBS='$GCONF_LIBS'" >&5
+$as_echo "yes CFLAGS='$GCONF_CFLAGS' LIBS='$GCONF_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GCONF_CFLAGS" >&5
-$as_echo_n "checking GCONF_CFLAGS... " >&6; }
- GCONF_CFLAGS=`$PKG_CONFIG --cflags "gconf-2.0 >= 2.13"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCONF_CFLAGS" >&5
-$as_echo "$GCONF_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GCONF_LIBS" >&5
-$as_echo_n "checking GCONF_LIBS... " >&6; }
- GCONF_LIBS=`$PKG_CONFIG --libs "gconf-2.0 >= 2.13"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCONF_LIBS" >&5
-$as_echo "$GCONF_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
GCONF_CFLAGS=""
GCONF_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- GCONF_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "gconf-2.0 >= 2.13"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ GCONF_PKG_ERRORS=`($PKG_CONFIG --print-errors "gconf-2.0 >= 2.13") 2>&1`
fi
@@ -11574,6 +11127,61 @@ $as_echo "#define HAVE_GCONF 1" >>confdefs.h
fi
if test "$HAVE_GSETTINGS" = "yes" || test "$HAVE_GCONF" = "yes"; then
+
+ succeeded=no
+
+ if test "$PKG_CONFIG" = "no" ; then
+ HAVE_GOBJECT=no
+ else
+ PKG_CONFIG_MIN_VERSION=0.9.0
+ if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gobject-2.0 >= 2.0" >&5
+$as_echo_n "checking for gobject-2.0 >= 2.0... " >&6; }
+
+ if $PKG_CONFIG --exists "gobject-2.0 >= 2.0" 2>&5 &&
+ GOBJECT_CFLAGS=`$PKG_CONFIG --cflags "gobject-2.0 >= 2.0" 2>&5` &&
+ GOBJECT_LIBS=`$PKG_CONFIG --libs "gobject-2.0 >= 2.0" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ GOBJECT_CFLAGS=`$as_echo "$GOBJECT_CFLAGS" | sed -e "$edit_cflags"`
+ GOBJECT_LIBS=`$as_echo "$GOBJECT_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GOBJECT_CFLAGS' LIBS='$GOBJECT_LIBS'" >&5
+$as_echo "yes CFLAGS='$GOBJECT_CFLAGS' LIBS='$GOBJECT_LIBS'" >&6; }
+ succeeded=yes
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ GOBJECT_CFLAGS=""
+ GOBJECT_LIBS=""
+ ## If we have a custom action on failure, don't print errors, but
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ GOBJECT_PKG_ERRORS=`($PKG_CONFIG --print-errors "gobject-2.0 >= 2.0") 2>&1`
+
+ fi
+
+
+
+ else
+ echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
+ echo "*** See http://www.freedesktop.org/software/pkgconfig"
+ fi
+ fi
+
+ if test $succeeded = yes; then
+ HAVE_GOBJECT=yes
+ else
+ HAVE_GOBJECT=no
+ fi
+
+ if test "$HAVE_GOBJECT" = "yes"; then
+ SETTINGS_CFLAGS="$SETTINGS_CFLAGS $GOBJECT_CFLAGS"
+ SETTINGS_LIBS="$SETTINGS_LIBS $GOBJECT_LIBS"
+ fi
SAVE_CFLAGS="$CFLAGS"
SAVE_LIBS="$LIBS"
CFLAGS="$SETTINGS_CFLAGS $CFLAGS"
@@ -11656,48 +11264,6 @@ if test "${with_gnutls}" = "yes" ; then
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
HAVE_GNUTLS=no
else
@@ -11706,30 +11272,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gnutls >= 2.6.6" >&5
$as_echo_n "checking for gnutls >= 2.6.6... " >&6; }
- if $PKG_CONFIG --exists "gnutls >= 2.6.6" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "gnutls >= 2.6.6" 2>&5 &&
+ LIBGNUTLS_CFLAGS=`$PKG_CONFIG --cflags "gnutls >= 2.6.6" 2>&5` &&
+ LIBGNUTLS_LIBS=`$PKG_CONFIG --libs "gnutls >= 2.6.6" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ LIBGNUTLS_CFLAGS=`$as_echo "$LIBGNUTLS_CFLAGS" | sed -e "$edit_cflags"`
+ LIBGNUTLS_LIBS=`$as_echo "$LIBGNUTLS_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$LIBGNUTLS_CFLAGS' LIBS='$LIBGNUTLS_LIBS'" >&5
+$as_echo "yes CFLAGS='$LIBGNUTLS_CFLAGS' LIBS='$LIBGNUTLS_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBGNUTLS_CFLAGS" >&5
-$as_echo_n "checking LIBGNUTLS_CFLAGS... " >&6; }
- LIBGNUTLS_CFLAGS=`$PKG_CONFIG --cflags "gnutls >= 2.6.6"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBGNUTLS_CFLAGS" >&5
-$as_echo "$LIBGNUTLS_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBGNUTLS_LIBS" >&5
-$as_echo_n "checking LIBGNUTLS_LIBS... " >&6; }
- LIBGNUTLS_LIBS=`$PKG_CONFIG --libs "gnutls >= 2.6.6"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBGNUTLS_LIBS" >&5
-$as_echo "$LIBGNUTLS_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
LIBGNUTLS_CFLAGS=""
LIBGNUTLS_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- LIBGNUTLS_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "gnutls >= 2.6.6"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ LIBGNUTLS_PKG_ERRORS=`($PKG_CONFIG --print-errors "gnutls >= 2.6.6") 2>&1`
fi
@@ -11781,8 +11346,6 @@ HAVE_XAW3D=no
LUCID_LIBW=
if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then
if test "$with_xaw3d" != no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xaw3d" >&5
-$as_echo_n "checking for xaw3d... " >&6; }
if test "${emacs_cv_xaw3d+set}" = set; then :
$as_echo_n "(cached) " >&6
else
@@ -11853,6 +11416,8 @@ fi
emacs_cv_xaw3d=no
fi
if test $emacs_cv_xaw3d = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xaw3d" >&5
+$as_echo_n "checking for xaw3d... " >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes; using Lucid toolkit" >&5
$as_echo "yes; using Lucid toolkit" >&6; }
USE_X_TOOLKIT=LUCID
@@ -11862,6 +11427,8 @@ $as_echo "yes; using Lucid toolkit" >&6; }
$as_echo "#define HAVE_XAW3D 1" >>confdefs.h
else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xaw3d" >&5
+$as_echo_n "checking for xaw3d... " >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for libXaw" >&5
@@ -12009,7 +11576,7 @@ _ACEOF
fi
test $ac_cv_lib_Xmu_XmuConvertStandardSelection = no && LIBS="$OLDLIBS"
-fi
+ fi
LIBXMU=-lXmu
@@ -12074,8 +11641,22 @@ fi
LIBXP=
if test "${USE_X_TOOLKIT}" = "MOTIF"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Motif version 2.1" >&5
-$as_echo_n "checking for Motif version 2.1... " >&6; }
+ # OpenMotif may be installed in such a way on some GNU/Linux systems.
+ if test -d /usr/include/openmotif; then
+ CPPFLAGS="-I/usr/include/openmotif $CPPFLAGS"
+ emacs_cv_openmotif=yes
+ case "$canonical" in
+ x86_64-*-linux-gnu* | powerpc64-*-linux-gnu* | sparc64-*-linux-gnu*)
+ test -d /usr/lib64/openmotif && LDFLAGS="-L/usr/lib64/openmotif $LDFLAGS"
+ ;;
+ *)
+ test -d /usr/lib/openmotif && LDFLAGS="-L/usr/lib/openmotif $LDFLAGS"
+ esac
+ else
+ emacs_cv_openmotif=no
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for (Open)Motif version 2.1" >&5
+$as_echo_n "checking for (Open)Motif version 2.1... " >&6; }
if test "${emacs_cv_motif_version_2_1+set}" = set; then :
$as_echo_n "(cached) " >&6
else
@@ -12144,6 +11725,9 @@ if test "x$ac_cv_lib_Xp_XpCreateContext" = x""yes; then :
LIBXP=-lXp
fi
+ if test x$emacs_cv_openmotif = xyes; then
+ REAL_CPPFLAGS="-I/usr/include/openmotif $REAL_CPPFLAGS"
+ fi
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for LessTif where some systems put it" >&5
$as_echo_n "checking for LessTif where some systems put it... " >&6; }
@@ -12190,6 +11774,14 @@ $as_echo "$emacs_cv_lesstif" >&6; }
CPPFLAGS=$OLD_CPPFLAGS
fi
fi
+ ac_fn_c_check_header_mongrel "$LINENO" "Xm/BulletinB.h" "ac_cv_header_Xm_BulletinB_h" "$ac_includes_default"
+if test "x$ac_cv_header_Xm_BulletinB_h" = x""yes; then :
+
+else
+ as_fn_error "Motif toolkit requested but requirements not found." "$LINENO" 5
+fi
+
+
fi
@@ -12201,7 +11793,7 @@ if test "${with_toolkit_scroll_bars}" != "no"; then
HAVE_XAW3D=no
USE_TOOLKIT_SCROLL_BARS=yes
- elif test "${HAVE_XAW3D}" = "yes"; then
+ elif test "${HAVE_XAW3D}" = "yes" || test "${USE_X_TOOLKIT}" = "LUCID"; then
$as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h
USE_TOOLKIT_SCROLL_BARS=yes
@@ -12214,6 +11806,10 @@ if test "${with_toolkit_scroll_bars}" != "no"; then
$as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h
USE_TOOLKIT_SCROLL_BARS=yes
+ elif test "${HAVE_W32}" = "yes"; then
+ $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h
+
+ USE_TOOLKIT_SCROLL_BARS=yes
fi
fi
@@ -12302,48 +11898,6 @@ if test "${HAVE_X11}" = "yes"; then
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
HAVE_FC=no
else
@@ -12352,30 +11906,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fontconfig >= 2.2.0" >&5
$as_echo_n "checking for fontconfig >= 2.2.0... " >&6; }
- if $PKG_CONFIG --exists "fontconfig >= 2.2.0" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "fontconfig >= 2.2.0" 2>&5 &&
+ FONTCONFIG_CFLAGS=`$PKG_CONFIG --cflags "fontconfig >= 2.2.0" 2>&5` &&
+ FONTCONFIG_LIBS=`$PKG_CONFIG --libs "fontconfig >= 2.2.0" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ FONTCONFIG_CFLAGS=`$as_echo "$FONTCONFIG_CFLAGS" | sed -e "$edit_cflags"`
+ FONTCONFIG_LIBS=`$as_echo "$FONTCONFIG_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$FONTCONFIG_CFLAGS' LIBS='$FONTCONFIG_LIBS'" >&5
+$as_echo "yes CFLAGS='$FONTCONFIG_CFLAGS' LIBS='$FONTCONFIG_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking FONTCONFIG_CFLAGS" >&5
-$as_echo_n "checking FONTCONFIG_CFLAGS... " >&6; }
- FONTCONFIG_CFLAGS=`$PKG_CONFIG --cflags "fontconfig >= 2.2.0"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FONTCONFIG_CFLAGS" >&5
-$as_echo "$FONTCONFIG_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking FONTCONFIG_LIBS" >&5
-$as_echo_n "checking FONTCONFIG_LIBS... " >&6; }
- FONTCONFIG_LIBS=`$PKG_CONFIG --libs "fontconfig >= 2.2.0"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FONTCONFIG_LIBS" >&5
-$as_echo "$FONTCONFIG_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
FONTCONFIG_CFLAGS=""
FONTCONFIG_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- FONTCONFIG_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "fontconfig >= 2.2.0"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ FONTCONFIG_PKG_ERRORS=`($PKG_CONFIG --print-errors "fontconfig >= 2.2.0") 2>&1`
fi
@@ -12404,48 +11957,6 @@ $as_echo "no" >&6; }
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
HAVE_XFT=no
else
@@ -12454,30 +11965,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for xft >= 0.13.0" >&5
$as_echo_n "checking for xft >= 0.13.0... " >&6; }
- if $PKG_CONFIG --exists "xft >= 0.13.0" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "xft >= 0.13.0" 2>&5 &&
+ XFT_CFLAGS=`$PKG_CONFIG --cflags "xft >= 0.13.0" 2>&5` &&
+ XFT_LIBS=`$PKG_CONFIG --libs "xft >= 0.13.0" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ XFT_CFLAGS=`$as_echo "$XFT_CFLAGS" | sed -e "$edit_cflags"`
+ XFT_LIBS=`$as_echo "$XFT_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$XFT_CFLAGS' LIBS='$XFT_LIBS'" >&5
+$as_echo "yes CFLAGS='$XFT_CFLAGS' LIBS='$XFT_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking XFT_CFLAGS" >&5
-$as_echo_n "checking XFT_CFLAGS... " >&6; }
- XFT_CFLAGS=`$PKG_CONFIG --cflags "xft >= 0.13.0"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $XFT_CFLAGS" >&5
-$as_echo "$XFT_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking XFT_LIBS" >&5
-$as_echo_n "checking XFT_LIBS... " >&6; }
- XFT_LIBS=`$PKG_CONFIG --libs "xft >= 0.13.0"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $XFT_LIBS" >&5
-$as_echo "$XFT_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
XFT_CFLAGS=""
XFT_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- XFT_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "xft >= 0.13.0"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ XFT_PKG_ERRORS=`($PKG_CONFIG --print-errors "xft >= 0.13.0") 2>&1`
fi
@@ -12615,48 +12125,6 @@ $as_echo "#define HAVE_XFT 1" >>confdefs.h
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
HAVE_FREETYPE=no
else
@@ -12665,30 +12133,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for freetype2" >&5
$as_echo_n "checking for freetype2... " >&6; }
- if $PKG_CONFIG --exists "freetype2" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "freetype2" 2>&5 &&
+ FREETYPE_CFLAGS=`$PKG_CONFIG --cflags "freetype2" 2>&5` &&
+ FREETYPE_LIBS=`$PKG_CONFIG --libs "freetype2" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ FREETYPE_CFLAGS=`$as_echo "$FREETYPE_CFLAGS" | sed -e "$edit_cflags"`
+ FREETYPE_LIBS=`$as_echo "$FREETYPE_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$FREETYPE_CFLAGS' LIBS='$FREETYPE_LIBS'" >&5
+$as_echo "yes CFLAGS='$FREETYPE_CFLAGS' LIBS='$FREETYPE_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking FREETYPE_CFLAGS" >&5
-$as_echo_n "checking FREETYPE_CFLAGS... " >&6; }
- FREETYPE_CFLAGS=`$PKG_CONFIG --cflags "freetype2"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FREETYPE_CFLAGS" >&5
-$as_echo "$FREETYPE_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking FREETYPE_LIBS" >&5
-$as_echo_n "checking FREETYPE_LIBS... " >&6; }
- FREETYPE_LIBS=`$PKG_CONFIG --libs "freetype2"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FREETYPE_LIBS" >&5
-$as_echo "$FREETYPE_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
FREETYPE_CFLAGS=""
FREETYPE_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- FREETYPE_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "freetype2"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ FREETYPE_PKG_ERRORS=`($PKG_CONFIG --print-errors "freetype2") 2>&1`
fi
@@ -12719,48 +12186,6 @@ $as_echo "#define HAVE_FREETYPE 1" >>confdefs.h
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
HAVE_LIBOTF=no
else
@@ -12769,30 +12194,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for libotf" >&5
$as_echo_n "checking for libotf... " >&6; }
- if $PKG_CONFIG --exists "libotf" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "libotf" 2>&5 &&
+ LIBOTF_CFLAGS=`$PKG_CONFIG --cflags "libotf" 2>&5` &&
+ LIBOTF_LIBS=`$PKG_CONFIG --libs "libotf" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ LIBOTF_CFLAGS=`$as_echo "$LIBOTF_CFLAGS" | sed -e "$edit_cflags"`
+ LIBOTF_LIBS=`$as_echo "$LIBOTF_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$LIBOTF_CFLAGS' LIBS='$LIBOTF_LIBS'" >&5
+$as_echo "yes CFLAGS='$LIBOTF_CFLAGS' LIBS='$LIBOTF_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBOTF_CFLAGS" >&5
-$as_echo_n "checking LIBOTF_CFLAGS... " >&6; }
- LIBOTF_CFLAGS=`$PKG_CONFIG --cflags "libotf"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBOTF_CFLAGS" >&5
-$as_echo "$LIBOTF_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBOTF_LIBS" >&5
-$as_echo_n "checking LIBOTF_LIBS... " >&6; }
- LIBOTF_LIBS=`$PKG_CONFIG --libs "libotf"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBOTF_LIBS" >&5
-$as_echo "$LIBOTF_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
LIBOTF_CFLAGS=""
LIBOTF_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- LIBOTF_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "libotf"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ LIBOTF_PKG_ERRORS=`($PKG_CONFIG --print-errors "libotf") 2>&1`
fi
@@ -12871,48 +12295,6 @@ $as_echo "#define HAVE_OTF_GET_VARIATION_GLYPHS 1" >>confdefs.h
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
HAVE_M17N_FLT=no
else
@@ -12921,30 +12303,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for m17n-flt" >&5
$as_echo_n "checking for m17n-flt... " >&6; }
- if $PKG_CONFIG --exists "m17n-flt" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "m17n-flt" 2>&5 &&
+ M17N_FLT_CFLAGS=`$PKG_CONFIG --cflags "m17n-flt" 2>&5` &&
+ M17N_FLT_LIBS=`$PKG_CONFIG --libs "m17n-flt" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ M17N_FLT_CFLAGS=`$as_echo "$M17N_FLT_CFLAGS" | sed -e "$edit_cflags"`
+ M17N_FLT_LIBS=`$as_echo "$M17N_FLT_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$M17N_FLT_CFLAGS' LIBS='$M17N_FLT_LIBS'" >&5
+$as_echo "yes CFLAGS='$M17N_FLT_CFLAGS' LIBS='$M17N_FLT_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking M17N_FLT_CFLAGS" >&5
-$as_echo_n "checking M17N_FLT_CFLAGS... " >&6; }
- M17N_FLT_CFLAGS=`$PKG_CONFIG --cflags "m17n-flt"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $M17N_FLT_CFLAGS" >&5
-$as_echo "$M17N_FLT_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking M17N_FLT_LIBS" >&5
-$as_echo_n "checking M17N_FLT_LIBS... " >&6; }
- M17N_FLT_LIBS=`$PKG_CONFIG --libs "m17n-flt"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $M17N_FLT_LIBS" >&5
-$as_echo "$M17N_FLT_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
M17N_FLT_CFLAGS=""
M17N_FLT_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- M17N_FLT_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "m17n-flt"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ M17N_FLT_PKG_ERRORS=`($PKG_CONFIG --print-errors "m17n-flt") 2>&1`
fi
@@ -12990,6 +12371,99 @@ fi
### Use -lXpm if available, unless `--with-xpm=no'.
HAVE_XPM=no
LIBXPM=
+
+if test "${HAVE_W32}" = "yes"; then
+ if test "${with_xpm}" != "no"; then
+ SAVE_CPPFLAGS="$CPPFLAGS"
+ SAVE_LDFLAGS="$LDFLAGS"
+ CPPFLAGS="$CPPFLAGS -I/usr/include/noX"
+ LDFLAGS="$LDFLAGS -L/usr/lib/noX"
+ ac_fn_c_check_header_mongrel "$LINENO" "X11/xpm.h" "ac_cv_header_X11_xpm_h" "$ac_includes_default"
+if test "x$ac_cv_header_X11_xpm_h" = x""yes; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpmReadFileToImage in -lXpm" >&5
+$as_echo_n "checking for XpmReadFileToImage in -lXpm... " >&6; }
+if test "${ac_cv_lib_Xpm_XpmReadFileToImage+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lXpm $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char XpmReadFileToImage ();
+int
+main ()
+{
+return XpmReadFileToImage ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_Xpm_XpmReadFileToImage=yes
+else
+ ac_cv_lib_Xpm_XpmReadFileToImage=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xpm_XpmReadFileToImage" >&5
+$as_echo "$ac_cv_lib_Xpm_XpmReadFileToImage" >&6; }
+if test "x$ac_cv_lib_Xpm_XpmReadFileToImage" = x""yes; then :
+ HAVE_XPM=yes
+fi
+
+fi
+
+
+ if test "${HAVE_XPM}" = "yes"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpmReturnAllocPixels preprocessor define" >&5
+$as_echo_n "checking for XpmReturnAllocPixels preprocessor define... " >&6; }
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include "X11/xpm.h"
+#ifndef XpmReturnAllocPixels
+no_return_alloc_pixels
+#endif
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "no_return_alloc_pixels" >/dev/null 2>&1; then :
+ HAVE_XPM=no
+else
+ HAVE_XPM=yes
+fi
+rm -f conftest*
+
+
+ if test "${HAVE_XPM}" = "yes"; then
+ REAL_CPPFLAGS="$REAL_CPPFLAGS -I/usr/include/noX"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ CPPFLAGS="$SAVE_CPPFLAGS"
+ LDFLAGS="$SAVE_LDFLAGS"
+ fi
+ fi
+ fi
+
+ if test "${HAVE_XPM}" = "yes"; then
+
+$as_echo "#define HAVE_XPM 1" >>confdefs.h
+
+ LIBXPM=-lXpm
+ fi
+fi
+
if test "${HAVE_X11}" = "yes"; then
if test "${with_xpm}" != "no"; then
ac_fn_c_check_header_mongrel "$LINENO" "X11/xpm.h" "ac_cv_header_X11_xpm_h" "$ac_includes_default"
@@ -13076,10 +12550,11 @@ $as_echo "#define HAVE_XPM 1" >>confdefs.h
fi
+
### Use -ljpeg if available, unless `--with-jpeg=no'.
HAVE_JPEG=no
LIBJPEG=
-if test "${HAVE_X11}" = "yes"; then
+if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then
if test "${with_jpeg}" != "no"; then
ac_fn_c_check_header_mongrel "$LINENO" "jerror.h" "ac_cv_header_jerror_h" "$ac_includes_default"
if test "x$ac_cv_header_jerror_h" = x""yes; then :
@@ -13158,7 +12633,7 @@ fi
### Use -lpng if available, unless `--with-png=no'.
HAVE_PNG=no
LIBPNG=
-if test "${HAVE_X11}" = "yes"; then
+if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then
if test "${with_png}" != "no"; then
# Debian unstable as of July 2003 has multiple libpngs, and puts png.h
# in /usr/include/libpng.
@@ -13171,7 +12646,7 @@ eval as_val=\$$as_ac_Header
cat >>confdefs.h <<_ACEOF
#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
_ACEOF
-
+ break
fi
done
@@ -13225,6 +12700,22 @@ fi
$as_echo "#define HAVE_PNG 1" >>confdefs.h
LIBPNG="-lpng -lz -lm"
+
+ ac_fn_c_check_decl "$LINENO" "png_longjmp" "ac_cv_have_decl_png_longjmp" "#ifdef HAVE_LIBPNG_PNG_H
+ # include <libpng/png.h>
+ #else
+ # include <png.h>
+ #endif
+
+"
+if test "x$ac_cv_have_decl_png_longjmp" = x""yes; then :
+
+else
+
+$as_echo "#define PNG_DEPSTRUCT /**/" >>confdefs.h
+
+fi
+
fi
fi
@@ -13232,7 +12723,7 @@ fi
### Use -ltiff if available, unless `--with-tiff=no'.
HAVE_TIFF=no
LIBTIFF=
-if test "${HAVE_X11}" = "yes"; then
+if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then
if test "${with_tiff}" != "no"; then
ac_fn_c_check_header_mongrel "$LINENO" "tiffio.h" "ac_cv_header_tiffio_h" "$ac_includes_default"
if test "x$ac_cv_header_tiffio_h" = x""yes; then :
@@ -13296,7 +12787,8 @@ fi
### Use -lgif or -lungif if available, unless `--with-gif=no'.
HAVE_GIF=no
LIBGIF=
-if test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no"; then
+if test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no" \
+ || test "${HAVE_W32}" = "yes"; then
ac_fn_c_check_header_mongrel "$LINENO" "gif_lib.h" "ac_cv_header_gif_lib_h" "$ac_includes_default"
if test "x$ac_cv_header_gif_lib_h" = x""yes; then :
# EGifPutExtensionLast only exists from version libungif-4.1.0b1.
@@ -13487,16 +12979,11 @@ $as_echo "#define HAVE_GPM 1" >>confdefs.h
fi
-ac_fn_c_check_header_mongrel "$LINENO" "malloc/malloc.h" "ac_cv_header_malloc_malloc_h" "$ac_includes_default"
-if test "x$ac_cv_header_malloc_malloc_h" = x""yes; then :
-
-$as_echo "#define HAVE_MALLOC_MALLOC_H 1" >>confdefs.h
-fi
-C_SWITCH_X_SYSTEM=
+GNUSTEP_CFLAGS=
### Use NeXTstep API to implement GUI.
if test "${HAVE_NS}" = "yes"; then
@@ -13513,20 +13000,18 @@ $as_echo "#define NS_IMPL_GNUSTEP 1" >>confdefs.h
# See also .m.o rule in Makefile.in */
# FIXME: are all these flags really needed? Document here why. */
- C_SWITCH_X_SYSTEM="-D_REENTRANT -fPIC -fno-strict-aliasing -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}"
+ GNUSTEP_CFLAGS="-D_REENTRANT -fPIC -fno-strict-aliasing -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}"
## Extra CFLAGS applied to src/*.m files.
GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -fgnu-runtime -Wno-import -fconstant-string-class=NSConstantString -DGNUSTEP_BASE_LIBRARY=1 -DGNU_GUI_LIBRARY=1 -DGNU_RUNTIME=1 -DGSWARN -DGSDIAGNOSE"
fi
- if test "${NS_HAVE_NSINTEGER}" = "yes"; then
-
-$as_echo "#define NS_HAVE_NSINTEGER 1" >>confdefs.h
-
- fi
# We also have mouse menus.
HAVE_MENUS=yes
OTHER_FILES=ns-app
fi
+if test "${HAVE_W32}" = "yes"; then
+ HAVE_MENUS=yes
+fi
### Use session management (-lSM -lICE) if available
HAVE_X_SM=no
@@ -13598,48 +13083,6 @@ if test "${with_xml2}" != "no"; then
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
HAVE_LIBXML2=no
else
@@ -13648,30 +13091,29 @@ fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for libxml-2.0 > 2.6.17" >&5
$as_echo_n "checking for libxml-2.0 > 2.6.17... " >&6; }
- if $PKG_CONFIG --exists "libxml-2.0 > 2.6.17" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "libxml-2.0 > 2.6.17" 2>&5 &&
+ LIBXML2_CFLAGS=`$PKG_CONFIG --cflags "libxml-2.0 > 2.6.17" 2>&5` &&
+ LIBXML2_LIBS=`$PKG_CONFIG --libs "libxml-2.0 > 2.6.17" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ LIBXML2_CFLAGS=`$as_echo "$LIBXML2_CFLAGS" | sed -e "$edit_cflags"`
+ LIBXML2_LIBS=`$as_echo "$LIBXML2_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$LIBXML2_CFLAGS' LIBS='$LIBXML2_LIBS'" >&5
+$as_echo "yes CFLAGS='$LIBXML2_CFLAGS' LIBS='$LIBXML2_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_CFLAGS" >&5
-$as_echo_n "checking LIBXML2_CFLAGS... " >&6; }
- LIBXML2_CFLAGS=`$PKG_CONFIG --cflags "libxml-2.0 > 2.6.17"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_CFLAGS" >&5
-$as_echo "$LIBXML2_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_LIBS" >&5
-$as_echo_n "checking LIBXML2_LIBS... " >&6; }
- LIBXML2_LIBS=`$PKG_CONFIG --libs "libxml-2.0 > 2.6.17"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_LIBS" >&5
-$as_echo "$LIBXML2_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
LIBXML2_CFLAGS=""
LIBXML2_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- LIBXML2_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "libxml-2.0 > 2.6.17"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ LIBXML2_PKG_ERRORS=`($PKG_CONFIG --print-errors "libxml-2.0 > 2.6.17") 2>&1`
fi
@@ -13779,8 +13221,8 @@ $as_echo "#define HAVE_H_ERRNO 1" >>confdefs.h
fi
-# fmod, logb, and frexp are found in -lm on most systems.
-# On HPUX 9.01, -lm does not contain logb, so check for sqrt.
+# sqrt and other floating-point functions such as fmod and frexp
+# are found in -lm on most systems.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sqrt in -lm" >&5
$as_echo_n "checking for sqrt in -lm... " >&6; }
if test "${ac_cv_lib_m_sqrt+set}" = set; then :
@@ -13977,28 +13419,8 @@ This probably means that movemail could lose mail.
There may be a \`development' package to install containing liblockfile." "$LINENO" 5
fi
fi
-for ac_func in touchlock
-do :
- ac_fn_c_check_func "$LINENO" "touchlock" "ac_cv_func_touchlock"
-if test "x$ac_cv_func_touchlock" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_TOUCHLOCK 1
-_ACEOF
-fi
-done
-for ac_header in maillock.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "maillock.h" "ac_cv_header_maillock_h" "$ac_includes_default"
-if test "x$ac_cv_header_maillock_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_MAILLOCK_H 1
-_ACEOF
-
-fi
-
-done
@@ -14048,15 +13470,17 @@ esac
-for ac_func in gethostname getdomainname \
-rename closedir mkdir rmdir sysinfo getrusage get_current_dir_name \
-random lrand48 logb frexp fmod rint cbrt ftime setsid \
-strerror fpathconf select euidaccess getpagesize tzset setlocale \
-utimes getrlimit setrlimit setpgid getcwd getwd shutdown getaddrinfo \
-__fpending mblen mbrlen mbsinit strsignal setitimer ualarm \
-sendto recvfrom getsockopt setsockopt getsockname getpeername \
-gai_strerror mkstemp getline getdelim mremap fsync sync \
-difftime mempcpy mblen mbrlen posix_memalign \
+for ac_func in gethostname \
+getrusage get_current_dir_name \
+lrand48 \
+select getpagesize setlocale \
+utimes getrlimit setrlimit shutdown getaddrinfo \
+strsignal setitimer \
+sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \
+gai_strerror mkstemp getline getdelim fsync sync \
+difftime posix_memalign \
+getpwent endpwent getgrent endgrent \
+touchlock \
cfmakeraw cfsetspeed copysign __executable_start
do :
as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
@@ -14071,6 +13495,29 @@ fi
done
+## Eric Backus <ericb@lsid.hp.com> says, HP-UX 9.x on HP 700 machines
+## has a broken `rint' in some library versions including math library
+## version number A.09.05.
+## You can fix the math library by installing patch number PHSS_4630.
+## But we can fix it more reliably for Emacs by just not using rint.
+## We also skip HAVE_RANDOM - see comments in src/conf_post.h.
+case $opsys in
+ hpux*) : ;;
+ *) for ac_func in random rint
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+ ;;
+esac
+
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __builtin_unwind_init" >&5
$as_echo_n "checking for __builtin_unwind_init... " >&6; }
if test "${emacs_cv_func___builtin_unwind_init+set}" = set; then :
@@ -14103,17 +13550,8 @@ $as_echo "#define HAVE___BUILTIN_UNWIND_INIT 1" >>confdefs.h
fi
-for ac_header in sys/un.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "sys/un.h" "ac_cv_header_sys_un_h" "$ac_includes_default"
-if test "x$ac_cv_header_sys_un_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_SYS_UN_H 1
-_ACEOF
-fi
-done
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGEFILE_SOURCE value needed for large files" >&5
@@ -14185,40 +13623,6 @@ $as_echo "#define HAVE_FSEEKO 1" >>confdefs.h
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getpgrp requires zero arguments" >&5
-$as_echo_n "checking whether getpgrp requires zero arguments... " >&6; }
-if test "${ac_cv_func_getpgrp_void+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- # Use it with a single arg.
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-getpgrp (0);
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_func_getpgrp_void=no
-else
- ac_cv_func_getpgrp_void=yes
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getpgrp_void" >&5
-$as_echo "$ac_cv_func_getpgrp_void" >&6; }
-if test $ac_cv_func_getpgrp_void = yes; then
-
-$as_echo "#define GETPGRP_VOID 1" >>confdefs.h
-
-fi
-
-
# UNIX98 PTYs.
for ac_func in grantpt
do :
@@ -14233,12 +13637,14 @@ done
# PTY-related GNU extensions.
-for ac_func in getpt
+for ac_func in getpt posix_openpt
do :
- ac_fn_c_check_func "$LINENO" "getpt" "ac_cv_func_getpt"
-if test "x$ac_cv_func_getpt" = x""yes; then :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
cat >>confdefs.h <<_ACEOF
-#define HAVE_GETPT 1
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
fi
@@ -14250,106 +13656,99 @@ done
# It's better to believe a function is not available
# than to expect to find it in ncurses.
# Also we need tputs and friends to be able to build at all.
-have_tputs_et_al=true
-# Maybe curses should be tried earlier?
-# See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9736#35
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing tputs" >&5
$as_echo_n "checking for library containing tputs... " >&6; }
-if test "${ac_cv_search_tputs+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_func_search_save_LIBS=$LIBS
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+# Run a test program that contains a call to tputs, a call that is
+# never executed. This tests whether a pre-'main' dynamic linker
+# works with the library. It's too much trouble to actually call
+# tputs in the test program, due to portability hassles. When
+# cross-compiling, assume the test program will run if it links.
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char tputs ();
-int
-main ()
-{
-return tputs ();
- ;
- return 0;
-}
-_ACEOF
-for ac_lib in '' ncurses terminfo termcap curses; do
- if test -z "$ac_lib"; then
- ac_res="none required"
+# Maybe curses should be tried earlier?
+# See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9736#35
+for tputs_library in '' tinfo ncurses terminfo termcap curses; do
+ OLIBS=$LIBS
+ if test -z "$tputs_library"; then
+ LIBS_TERMCAP=
+ msg='none required'
else
- ac_res=-l$ac_lib
- LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ LIBS_TERMCAP=-l$tputs_library
+ msg=$LIBS_TERMCAP
+ LIBS="$LIBS_TERMCAP $LIBS"
fi
- if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_search_tputs=$ac_res
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext
- if test "${ac_cv_search_tputs+set}" = set; then :
- break
-fi
-done
-if test "${ac_cv_search_tputs+set}" = set; then :
+ if test "$cross_compiling" = yes; then :
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+ extern void tputs (const char *, int, int (*)(int));
+ int main (int argc, char **argv)
+ {
+ if (argc == 10000)
+ tputs (argv[0], 0, 0);
+ return 0;
+ }
+
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
else
- ac_cv_search_tputs=no
-fi
-rm conftest.$ac_ext
-LIBS=$ac_func_search_save_LIBS
+ msg=no
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_tputs" >&5
-$as_echo "$ac_cv_search_tputs" >&6; }
-ac_res=$ac_cv_search_tputs
-if test "$ac_res" != no; then :
- test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+ extern void tputs (const char *, int, int (*)(int));
+ int main (int argc, char **argv)
+ {
+ if (argc == 10000)
+ tputs (argv[0], 0, 0);
+ return 0;
+ }
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
else
- have_tputs_et_al=false
+ msg=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
-if test "$have_tputs_et_al" != true; then
+ LIBS=$OLIBS
+ if test "X$msg" != Xno; then
+ break
+ fi
+done
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $msg" >&5
+$as_echo "$msg" >&6; }
+if test "X$msg" = Xno; then
as_fn_error "The required function \`tputs' was not found in any library.
-These libraries were tried: libncurses, libterminfo, libtermcap, libcurses.
+The following libraries were tried (in order):
+ libtinfo, libncurses, libterminfo, libtermcap, libcurses
Please try installing whichever of these libraries is most appropriate
for your system, together with its header files.
For example, a libncurses-dev(el) or similar package." "$LINENO" 5
fi
-# Must define this when any termcap library is found.
-$as_echo "#define HAVE_LIBNCURSES 1" >>confdefs.h
-
-## FIXME This was the cpp logic, but I am not sure it is right.
-## The above test has not necessarily found libncurses.
-HAVE_LIBNCURSES=yes
-
-## Use terminfo instead of termcap?
-## Note only system files NOT using terminfo are:
-## freebsd < 40000, ms-w32, msdos, netbsd < 599002500, and
-## darwin|gnu without ncurses.
-TERMINFO=no
-LIBS_TERMCAP=
+## Use termcap instead of terminfo?
+## Only true for: freebsd < 40000, ms-w32, msdos, netbsd < 599002500.
+TERMINFO=yes
+## FIXME? In the cases below where we unconditionally set
+## LIBS_TERMCAP="-lncurses", this overrides LIBS_TERMCAP = -ltinfo,
+## if that was found above to have tputs.
+## Should we use the gnu* logic everywhere?
case "$opsys" in
- ## cygwin: Fewer environment variables to go wrong, more terminal types.
- ## hpux10-20: Use the system provided termcap(3) library.
- ## openbsd: David Mazieres <dm@reeducation-labor.lcs.mit.edu> says this
- ## is necessary. Otherwise Emacs dumps core when run -nw.
- aix4-2|cygwin|hpux*|irix6-5|openbsd|sol2*|unixware) TERMINFO=yes ;;
-
## darwin: Prevents crashes when running Emacs in Terminal.app under 10.2.
## The ncurses library has been moved out of the System framework in
## Mac OS X 10.2. So if configure detects it, set the command-line
## option to use it.
- darwin|gnu*)
- ## (HAVE_LIBNCURSES was not always true, but is since 2010-03-18.)
- if test "x$HAVE_LIBNCURSES" = "xyes"; then
- TERMINFO=yes
- LIBS_TERMCAP="-lncurses"
- fi
- ;;
+ darwin) LIBS_TERMCAP="-lncurses" ;;
+
+ gnu*) test -z "$LIBS_TERMCAP" && LIBS_TERMCAP="-lncurses" ;;
freebsd)
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether FreeBSD is new enough to use terminfo" >&5
@@ -14385,34 +13784,29 @@ fi
$as_echo "$emacs_cv_freebsd_terminfo" >&6; }
if test $emacs_cv_freebsd_terminfo = yes; then
- TERMINFO=yes
LIBS_TERMCAP="-lncurses"
else
+ TERMINFO=no
LIBS_TERMCAP="-ltermcap"
fi
;;
netbsd)
- if test $ac_cv_search_tputs = -lterminfo; then
- TERMINFO=yes
- LIBS_TERMCAP="-lterminfo"
- else
+ if test "x$LIBS_TERMCAP" != "x-lterminfo"; then
+ TERMINFO=no
LIBS_TERMCAP="-ltermcap"
fi
;;
-esac
+ openbsd) LIBS_TERMCAP="-lncurses" ;;
-case "$opsys" in
## hpux: Make sure we get select from libc rather than from libcurses
## because libcurses on HPUX 10.10 has a broken version of select.
## We used to use -lc -lcurses, but this may be cleaner.
+ ## FIXME? But TERMINFO = yes on hpux (it used to be explicitly
+ # set that way, now it uses the default). Isn't this a contradiction?
hpux*) LIBS_TERMCAP="-ltermcap" ;;
- openbsd) LIBS_TERMCAP="-lncurses" ;;
-
- ## Must use system termcap, if we use any termcap. It does special things.
- sol2*) test "$TERMINFO" != yes && LIBS_TERMCAP="-ltermcap" ;;
esac
TERMCAP_OBJ=tparam.o
@@ -14420,10 +13814,6 @@ if test $TERMINFO = yes; then
$as_echo "#define TERMINFO 1" >>confdefs.h
-
- ## Default used to be -ltermcap. Add a case above if need something else.
- test "x$LIBS_TERMCAP" = "x" && LIBS_TERMCAP="-lcurses"
-
TERMCAP_OBJ=terminfo.o
fi
@@ -14431,8 +13821,13 @@ fi
# Do we have res_init, for detecting changes in /etc/resolv.conf?
+# On Darwin, res_init appears not to be useful: see bug#562 and
+# http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01467.html
resolv=no
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+
+if test $opsys != darwin; then
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <netinet/in.h>
#include <arpa/nameser.h>
@@ -14452,12 +13847,12 @@ else
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
-if test "$have_res_init" = no; then
- OLIBS="$LIBS"
- LIBS="$LIBS -lresolv"
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for res_init with -lresolv" >&5
+ if test "$have_res_init" = no; then
+ OLIBS="$LIBS"
+ LIBS="$LIBS -lresolv"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for res_init with -lresolv" >&5
$as_echo_n "checking for res_init with -lresolv... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <netinet/in.h>
#include <arpa/nameser.h>
@@ -14477,20 +13872,20 @@ else
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_res_init" >&5
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_res_init" >&5
$as_echo "$have_res_init" >&6; }
- if test "$have_res_init" = yes ; then
- resolv=yes
+ if test "$have_res_init" = yes ; then
+ resolv=yes
+ fi
+ LIBS="$OLIBS"
fi
- LIBS="$OLIBS"
-fi
-if test "$have_res_init" = yes; then
+ if test "$have_res_init" = yes; then
$as_echo "#define HAVE_RES_INIT 1" >>confdefs.h
+ fi
fi
-
# Do we need the Hesiod library to provide the support routines?
LIBHESIOD=
if test "$with_hesiod" != no ; then
@@ -14652,7 +14047,7 @@ fi
# Do we need libresolv (due to res_init or Hesiod)?
-if test "$resolv" = yes ; then
+if test "$resolv" = yes && test $opsys != darwin; then
$as_echo "#define HAVE_LIBRESOLV 1" >>confdefs.h
@@ -15198,6 +14593,25 @@ fi
+
+
+
+ for ac_func in $ac_func_list
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
+
+
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether localtime caches TZ" >&5
$as_echo_n "checking whether localtime caches TZ... " >&6; }
if test "${emacs_cv_localtime_cache+set}" = set; then :
@@ -15255,63 +14669,6 @@ $as_echo "#define LOCALTIME_CACHE 1" >>confdefs.h
fi
-if test "x$HAVE_TIMEVAL" = xyes; then
- for ac_func in gettimeofday
-do :
- ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday"
-if test "x$ac_cv_func_gettimeofday" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_GETTIMEOFDAY 1
-_ACEOF
-
-fi
-done
-
- if test $ac_cv_func_gettimeofday = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gettimeofday can accept two arguments" >&5
-$as_echo_n "checking whether gettimeofday can accept two arguments... " >&6; }
-if test "${emacs_cv_gettimeofday_two_arguments+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
-#endif
-int
-main ()
-{
-struct timeval time;
- gettimeofday (&time, 0);
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_gettimeofday_two_arguments=yes
-else
- emacs_cv_gettimeofday_two_arguments=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_gettimeofday_two_arguments" >&5
-$as_echo "$emacs_cv_gettimeofday_two_arguments" >&6; }
- if test $emacs_cv_gettimeofday_two_arguments = no; then
-
-$as_echo "#define GETTIMEOFDAY_ONE_ARGUMENT 1" >>confdefs.h
-
- fi
- fi
-fi
-
ok_so_far=yes
ac_fn_c_check_func "$LINENO" "socket" "ac_cv_func_socket"
if test "x$ac_cv_func_socket" = x""yes; then :
@@ -15365,6 +14722,11 @@ else
$as_echo "no" >&6; }
fi
+case $canonical in
+ *-solaris2.4 | *-solaris2.4.*)
+ : ${ac_cv_func_vfork_works=no};;
+esac
+
ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default"
if test "x$ac_cv_type_pid_t" = x""yes; then :
@@ -15704,6 +15066,804 @@ $as_echo "#define __restrict_arr __restrict" >>confdefs.h
fi
+
+$as_echo "#define AMPERSAND_FULL_NAME 1" >>confdefs.h
+
+
+
+$as_echo "#define CLASH_DETECTION 1" >>confdefs.h
+
+
+## Note: PTYs are broken on darwin <6. Use at your own risk.
+
+$as_echo "#define HAVE_PTYS 1" >>confdefs.h
+
+
+
+$as_echo "#define HAVE_SOCKETS 1" >>confdefs.h
+
+
+
+
+
+$as_echo "#define NULL_DEVICE \"/dev/null\"" >>confdefs.h
+
+
+
+$as_echo "#define SEPCHAR ':'" >>confdefs.h
+
+
+
+$as_echo "#define subprocesses 1" >>confdefs.h
+
+
+
+$as_echo "#define USER_FULL_NAME pw->pw_gecos" >>confdefs.h
+
+
+
+
+$as_echo "#define DIRECTORY_SEP '/'" >>confdefs.h
+
+
+
+
+
+$as_echo "#define IS_DEVICE_SEP(_c_) 0" >>confdefs.h
+
+
+
+$as_echo "#define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP)" >>confdefs.h
+
+
+
+$as_echo "#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_))" >>confdefs.h
+
+
+
+
+
+case $opsys in
+ aix4-2)
+ if test x$ac_cv_lib_Xmu_XmuConvertStandardSelection != xyes; then
+ $as_echo "#define NO_EDITRES 1" >>confdefs.h
+
+ fi
+ ;;
+
+ hpux*)
+ $as_echo "#define NO_EDITRES 1" >>confdefs.h
+
+ ;;
+esac
+
+
+case $opsys in
+ irix6-5 | sol2* | unixware )
+
+$as_echo "#define NSIG_MINIMUM 32" >>confdefs.h
+
+ ;;
+esac
+
+emacs_broken_SIGIO=no
+
+case $opsys in
+ hpux* | irix6-5 | openbsd | sol2* | unixware )
+ emacs_broken_SIGIO=yes
+ ;;
+
+ aix4-2)
+
+$as_echo "#define BROKEN_GET_CURRENT_DIR_NAME 1" >>confdefs.h
+
+ ;;
+
+ freebsd)
+
+$as_echo "#define BROKEN_PTY_READ_AFTER_EAGAIN 1" >>confdefs.h
+
+ ;;
+esac
+
+case $opsys in
+ gnu-* | sol2-10 )
+
+$as_echo "#define HAVE_PROCFS 1" >>confdefs.h
+
+ ;;
+esac
+
+case $opsys in
+ darwin | freebsd | netbsd | openbsd )
+
+$as_echo "#define DONT_REOPEN_PTY 1" >>confdefs.h
+
+ ;;
+esac
+
+case $opsys in
+ netbsd | openbsd) sound_device="/dev/audio" ;;
+ *) sound_device="/dev/dsp" ;;
+esac
+
+
+cat >>confdefs.h <<_ACEOF
+#define DEFAULT_SOUND_DEVICE "$sound_device"
+_ACEOF
+
+
+
+case $opsys in
+ darwin | gnu-linux | gnu-kfreebsd )
+
+$as_echo "#define INTERRUPT_INPUT 1" >>confdefs.h
+
+ ;;
+esac
+
+
+case $opsys in
+ cygwin|gnu|gnu-linux|gnu-kfreebsd|irix6-5|freebsd|netbsd|openbsd)
+
+$as_echo "#define NARROWPROTO 1" >>confdefs.h
+
+ ;;
+esac
+
+
+
+
+
+
+
+
+case $opsys in
+ aix4-2 )
+ $as_echo "#define PTY_ITERATION int c; for (c = 0; !c ; c++)" >>confdefs.h
+
+ $as_echo "#define PTY_NAME_SPRINTF strcpy (pty_name, \"/dev/ptc\");" >>confdefs.h
+
+ $as_echo "#define PTY_TTY_NAME_SPRINTF strcpy (pty_name, ttyname (fd));" >>confdefs.h
+
+ ;;
+
+ cygwin )
+ $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++)" >>confdefs.h
+
+ $as_echo "#define PTY_OPEN do { int dummy; sigset_t blocked, procmask; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, &procmask); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; pthread_sigmask (SIG_SETMASK, &procmask, 0); if (fd >= 0) emacs_close (dummy); } while (0)" >>confdefs.h
+
+ $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h
+
+ $as_echo "#define PTY_TTY_NAME_SPRINTF /**/" >>confdefs.h
+
+ ;;
+
+ darwin )
+ $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++)" >>confdefs.h
+
+ $as_echo "#define FIRST_PTY_LETTER 'p'" >>confdefs.h
+
+ $as_echo "#define PTY_OPEN do { int slave; if (openpty (&fd, &slave, pty_name, NULL, NULL) == -1) fd = -1; else emacs_close (slave); } while (0)" >>confdefs.h
+
+ $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h
+
+ $as_echo "#define PTY_TTY_NAME_SPRINTF /**/" >>confdefs.h
+
+ ;;
+
+ gnu | openbsd )
+ $as_echo "#define FIRST_PTY_LETTER 'p'" >>confdefs.h
+
+ ;;
+
+ gnu-linux | gnu-kfreebsd | freebsd | netbsd )
+ if test "x$ac_cv_func_grantpt" = xyes; then
+
+$as_echo "#define UNIX98_PTYS 1" >>confdefs.h
+
+ $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++)" >>confdefs.h
+
+ $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { close (fd); return -1; } snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); }" >>confdefs.h
+
+ if test "x$ac_cv_func_posix_openpt" = xyes; then
+ $as_echo "#define PTY_OPEN fd = posix_openpt (O_RDWR | O_NOCTTY)" >>confdefs.h
+
+ $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h
+
+ elif test "x$ac_cv_func_getpt" = xyes; then
+ $as_echo "#define PTY_OPEN fd = getpt ()" >>confdefs.h
+
+ $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h
+
+ else
+ $as_echo "#define PTY_NAME_SPRINTF strcpy (pty_name, \"/dev/ptmx\");" >>confdefs.h
+
+ fi
+ else
+ $as_echo "#define FIRST_PTY_LETTER 'p'" >>confdefs.h
+
+ fi
+ ;;
+
+ hpux*)
+ $as_echo "#define FIRST_PTY_LETTER 'p'" >>confdefs.h
+
+ $as_echo "#define PTY_NAME_SPRINTF sprintf (pty_name, \"/dev/ptym/pty%c%x\", c, i);" >>confdefs.h
+
+ $as_echo "#define PTY_TTY_NAME_SPRINTF sprintf (pty_name, \"/dev/pty/tty%c%x\", c, i);" >>confdefs.h
+
+ ;;
+
+ irix6-5 )
+ $as_echo "#define PTY_ITERATION /**/" >>confdefs.h
+
+ $as_echo "#define FIRST_PTY_LETTER 'q'" >>confdefs.h
+
+ $as_echo "#define PTY_OPEN { struct sigaction ocstat, cstat; struct stat stb; char * name; sigemptyset(&cstat.sa_mask); cstat.sa_handler = SIG_DFL; cstat.sa_flags = 0; sigaction(SIGCLD, &cstat, &ocstat); name = _getpty (&fd, O_RDWR | O_NDELAY, 0600, 0); sigaction(SIGCLD, &ocstat, (struct sigaction *)0); if (name == 0) return -1; if (fd < 0) return -1; if (fstat (fd, &stb) < 0) return -1; strcpy (pty_name, name); }" >>confdefs.h
+
+ $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h
+
+ $as_echo "#define PTY_TTY_NAME_SPRINTF /**/" >>confdefs.h
+
+ ;;
+
+ sol2* )
+ $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); }" >>confdefs.h
+
+ ;;
+
+ unixware )
+ $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal(\"could not grant slave pty\"); if (unlockpt(fd) == -1) fatal(\"could not unlock slave pty\"); if (!(ptyname = ptsname(fd))) fatal (\"could not enable slave pty\"); snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); }" >>confdefs.h
+
+ ;;
+esac
+
+
+case $opsys in
+ sol2* | unixware )
+ $as_echo "#define FIRST_PTY_LETTER 'z'" >>confdefs.h
+
+ $as_echo "#define PTY_NAME_SPRINTF strcpy (pty_name, \"/dev/ptmx\");" >>confdefs.h
+
+
+$as_echo "#define SETUP_SLAVE_PTY if (ioctl (xforkin, I_PUSH, \"ptem\") == -1) fatal (\"ioctl I_PUSH ptem\"); if (ioctl (xforkin, I_PUSH, \"ldterm\") == -1) fatal (\"ioctl I_PUSH ldterm\"); if (ioctl (xforkin, I_PUSH, \"ttcompat\") == -1) fatal (\"ioctl I_PUSH ttcompat\");" >>confdefs.h
+
+ ;;
+esac
+
+
+
+
+case $opsys in
+ aix4-2 | cygwin | gnu | irix6-5 | freebsd | netbsd | openbsd )
+ $as_echo "#define SIGNALS_VIA_CHARACTERS 1" >>confdefs.h
+
+ ;;
+
+ gnu-linux | gnu-kfreebsd )
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for signals via characters" >&5
+$as_echo_n "checking for signals via characters... " >&6; }
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#include <linux/version.h>
+#if LINUX_VERSION_CODE < 0x20400
+# error "Linux version too old"
+#endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+ emacs_signals_via_chars=yes
+else
+ emacs_signals_via_chars=no
+fi
+rm -f conftest.err conftest.$ac_ext
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_signals_via_chars" >&5
+$as_echo "$emacs_signals_via_chars" >&6; }
+ test $emacs_signals_via_chars = yes && $as_echo "#define SIGNALS_VIA_CHARACTERS 1" >>confdefs.h
+
+ ;;
+esac
+
+
+
+
+
+case $opsys in
+ gnu)
+ $as_echo "#define DATA_START ({ extern int data_start; (char *) &data_start; })" >>confdefs.h
+
+ ;;
+
+ hpux*)
+ $as_echo "#define DATA_START 0x40000000" >>confdefs.h
+
+ $as_echo "#define DATA_SEG_BITS 0x40000000" >>confdefs.h
+
+ ;;
+ irix6-5)
+ $as_echo "#define DATA_START 0x10000000" >>confdefs.h
+
+ $as_echo "#define DATA_SEG_BITS 0x10000000" >>confdefs.h
+
+ ;;
+esac
+
+
+
+
+
+case $opsys in
+ darwin) $as_echo "#define TAB3 OXTABS" >>confdefs.h
+ ;;
+
+ gnu | freebsd | netbsd | openbsd )
+
+$as_echo "#define TABDLY OXTABS" >>confdefs.h
+
+ $as_echo "#define TAB3 OXTABS" >>confdefs.h
+
+ ;;
+
+ gnu-linux | gnu-kfreebsd )
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#ifndef __i386__
+# error "not i386"
+#endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+ $as_echo "#define ULIMIT_BREAK_VALUE (32*1024*1024)" >>confdefs.h
+
+fi
+rm -f conftest.err conftest.$ac_ext
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#ifndef __ia64__
+# error "not ia64"
+#endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+$as_echo "#define GC_MARK_SECONDARY_STACK() do { extern void *__libc_ia64_register_backing_store_base; __builtin_ia64_flushrs (); mark_memory (__libc_ia64_register_backing_store_base, __builtin_ia64_bsp ());} while (0)" >>confdefs.h
+
+fi
+rm -f conftest.err conftest.$ac_ext
+ ;;
+
+ hpux*)
+
+$as_echo "#define RUN_TIME_REMAP 1" >>confdefs.h
+
+ ;;
+
+ irix6-5)
+ $as_echo "#define ULIMIT_BREAK_VALUE 0x14000000" >>confdefs.h
+
+ ;;
+esac
+
+
+
+
+
+
+
+case $opsys in
+ aix4-2 | hpux* | unixware)
+ $as_echo "#define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE" >>confdefs.h
+
+ ;;
+
+ gnu-linux | gnu-kfreebsd )
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#if defined __i386__ || defined __sparc__ || defined __mc68000__ \
+ || defined __alpha__ || defined __mips__ || defined __s390__ \
+ || defined __arm__ || defined __powerpc__ || defined __amd64__ \
+ || defined __ia64__ || defined __sh__
+/* ok */
+#else
+# error "setjmp not known to work on this arch"
+#endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+ $as_echo "#define GC_SETJMP_WORKS 1" >>confdefs.h
+
+else
+ $as_echo "#define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE" >>confdefs.h
+
+fi
+rm -f conftest.err conftest.$ac_ext
+ ;;
+esac
+
+
+if test x$GCC = xyes; then
+ $as_echo "#define GC_SETJMP_WORKS 1" >>confdefs.h
+
+else
+ case $opsys in
+ freebsd | netbsd | openbsd | irix6-5 | sol2* )
+ $as_echo "#define GC_SETJMP_WORKS 1" >>confdefs.h
+
+ ;;
+ esac
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for _setjmp" >&5
+$as_echo_n "checking for _setjmp... " >&6; }
+if test "${emacs_cv_func__setjmp+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <setjmp.h>
+
+int
+main ()
+{
+jmp_buf j;
+ if (! _setjmp (j))
+ _longjmp (j, 1);
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ emacs_cv_func__setjmp=yes
+else
+ emacs_cv_func__setjmp=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_func__setjmp" >&5
+$as_echo "$emacs_cv_func__setjmp" >&6; }
+if test $emacs_cv_func__setjmp = yes; then
+
+$as_echo "#define HAVE__SETJMP 1" >>confdefs.h
+
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigsetjmp" >&5
+$as_echo_n "checking for sigsetjmp... " >&6; }
+if test "${emacs_cv_func_sigsetjmp+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <setjmp.h>
+
+int
+main ()
+{
+sigjmp_buf j;
+ if (! sigsetjmp (j, 1))
+ siglongjmp (j, 1);
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ emacs_cv_func_sigsetjmp=yes
+else
+ emacs_cv_func_sigsetjmp=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_func_sigsetjmp" >&5
+$as_echo "$emacs_cv_func_sigsetjmp" >&6; }
+ if test $emacs_cv_func_sigsetjmp = yes; then
+
+$as_echo "#define HAVE_SIGSETJMP 1" >>confdefs.h
+
+ fi
+fi
+
+case $opsys in
+ sol2* | unixware )
+
+$as_echo "#define TIOCSIGSEND TIOCSIGNAL" >>confdefs.h
+
+ ;;
+esac
+
+
+case $opsys in
+ hpux* | sol2* )
+
+$as_echo "#define XOS_NEEDS_TIME_H 1" >>confdefs.h
+
+ ;;
+esac
+
+
+
+
+
+
+
+
+
+
+case $opsys in
+ aix4-2)
+ $as_echo "#define USG /**/" >>confdefs.h
+
+ $as_echo "#define USG5 /**/" >>confdefs.h
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#ifndef _AIX
+# error "_AIX not defined"
+#endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+
+$as_echo "#define _AIX /**/" >>confdefs.h
+
+fi
+rm -f conftest.err conftest.$ac_ext
+ ;;
+
+ cygwin)
+
+$as_echo "#define CYGWIN 1" >>confdefs.h
+
+ ;;
+
+ darwin)
+ $as_echo "#define BSD4_2 /**/" >>confdefs.h
+
+ $as_echo "#define BSD_SYSTEM /**/" >>confdefs.h
+
+
+$as_echo "#define DARWIN_OS /**/" >>confdefs.h
+
+ ;;
+
+ freebsd)
+ $as_echo "#define BSD4_2 /**/" >>confdefs.h
+
+
+$as_echo "#define BSD_SYSTEM_AHB 1" >>confdefs.h
+
+ ;;
+
+ gnu | netbsd | openbsd )
+ $as_echo "#define BSD4_2 /**/" >>confdefs.h
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#ifndef BSD_SYSTEM
+# error "BSD_SYSTEM not defined"
+#endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+ $as_echo "#define BSD_SYSTEM 43" >>confdefs.h
+
+fi
+rm -f conftest.err conftest.$ac_ext
+ ;;
+
+ gnu-linux | gnu-kfreebsd )
+ $as_echo "#define USG /**/" >>confdefs.h
+
+
+$as_echo "#define GNU_LINUX /**/" >>confdefs.h
+
+ ;;
+
+ hpux*)
+ $as_echo "#define USG /**/" >>confdefs.h
+
+ $as_echo "#define USG5 /**/" >>confdefs.h
+
+
+$as_echo "#define HPUX /**/" >>confdefs.h
+
+ ;;
+
+ irix6-5)
+ $as_echo "#define USG /**/" >>confdefs.h
+
+ $as_echo "#define USG5 /**/" >>confdefs.h
+
+ $as_echo "#define USG5_4 /**/" >>confdefs.h
+
+
+$as_echo "#define IRIX6_5 /**/" >>confdefs.h
+
+ ;;
+
+ sol2*)
+ $as_echo "#define USG /**/" >>confdefs.h
+
+ $as_echo "#define USG5 /**/" >>confdefs.h
+
+ $as_echo "#define USG5_4 /**/" >>confdefs.h
+
+
+$as_echo "#define SOLARIS2 /**/" >>confdefs.h
+
+ ;;
+
+ unixware)
+ $as_echo "#define USG /**/" >>confdefs.h
+
+ $as_echo "#define USG5 /**/" >>confdefs.h
+
+ $as_echo "#define USG5_4 /**/" >>confdefs.h
+
+ ;;
+esac
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for usable FIONREAD" >&5
+$as_echo_n "checking for usable FIONREAD... " >&6; }
+if test "${emacs_cv_usable_FIONREAD+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ case $opsys in
+ aix4-2)
+ emacs_cv_usable_FIONREAD=no
+ ;;
+
+ *)
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/types.h>
+ #include <sys/ioctl.h>
+ #ifdef USG5_4
+ # include <sys/filio.h>
+ #endif
+
+int
+main ()
+{
+int foo = ioctl (0, FIONREAD, &foo);
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ emacs_cv_usable_FIONREAD=yes
+else
+ emacs_cv_usable_FIONREAD=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ ;;
+ esac
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_usable_FIONREAD" >&5
+$as_echo "$emacs_cv_usable_FIONREAD" >&6; }
+if test $emacs_cv_usable_FIONREAD = yes; then
+
+$as_echo "#define USABLE_FIONREAD 1" >>confdefs.h
+
+
+ if test $emacs_broken_SIGIO = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for usable SIGIO" >&5
+$as_echo_n "checking for usable SIGIO... " >&6; }
+if test "${emacs_cv_usable_SIGIO+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <fcntl.h>
+ #include <signal.h>
+
+int
+main ()
+{
+int foo = SIGIO | F_SETFL | FASYNC;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ emacs_cv_usable_SIGIO=yes
+else
+ emacs_cv_usable_SIGIO=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_usable_SIGIO" >&5
+$as_echo "$emacs_cv_usable_SIGIO" >&6; }
+ if test $emacs_cv_usable_SIGIO = yes; then
+
+$as_echo "#define USABLE_SIGIO 1" >>confdefs.h
+
+ fi
+ fi
+fi
+
+
+case $opsys in
+ cygwin)
+
+$as_echo "#define G_SLICE_ALWAYS_MALLOC 1" >>confdefs.h
+
+ ;;
+
+ hpux11)
+
+$as_echo "#define USG_SUBTTY_WORKS 1" >>confdefs.h
+
+ ;;
+
+ irix6-5)
+
+$as_echo "#define PREFER_VSUSP 1" >>confdefs.h
+
+ ;;
+
+ sol2-10)
+
+$as_echo "#define _STRUCTURED_PROC 1" >>confdefs.h
+
+ ;;
+esac
+
# Set up the CFLAGS for real compilation, so we can substitute it.
CFLAGS="$REAL_CFLAGS"
CPPFLAGS="$REAL_CPPFLAGS"
@@ -15718,6 +15878,14 @@ fi
version=$PACKAGE_VERSION
+copyright="Copyright (C) 2012 Free Software Foundation, Inc."
+
+cat >>confdefs.h <<_ACEOF
+#define COPYRIGHT "$copyright"
+_ACEOF
+
+
+
### Specify what sort of things we'll be editing into Makefile and config.h.
### Use configuration here uncanonicalized to avoid exceeding size limits.
@@ -15743,6 +15911,8 @@ version=$PACKAGE_VERSION
+
+
## FIXME? Nothing uses @LD_SWITCH_X_SITE@.
## src/Makefile.in did add LD_SWITCH_X_SITE (as a cpp define) to the
## end of LIBX_BASE, but nothing ever set it.
@@ -15752,14 +15922,6 @@ version=$PACKAGE_VERSION
## Used in lwlib/Makefile.in.
-if test -n "${machfile}"; then
- M_FILE="\$(srcdir)/${machfile}"
-else
- M_FILE=
-fi
-S_FILE="\$(srcdir)/${opsysfile}"
-
-
@@ -15767,29 +15929,26 @@ S_FILE="\$(srcdir)/${opsysfile}"
+if test -n "${term_header}"; then
cat >>confdefs.h <<_ACEOF
-#define EMACS_CONFIGURATION "${canonical}"
+#define TERM_HEADER "${term_header}"
_ACEOF
+fi
-cat >>confdefs.h <<_ACEOF
-#define EMACS_CONFIG_OPTIONS "${ac_configure_args}"
-_ACEOF
-
-if test -n "$machfile"; then
cat >>confdefs.h <<_ACEOF
-#define config_machfile "${machfile}"
+#define EMACS_CONFIGURATION "${canonical}"
_ACEOF
-fi
cat >>confdefs.h <<_ACEOF
-#define config_opsysfile "${opsysfile}"
+#define EMACS_CONFIG_OPTIONS "${ac_configure_args}"
_ACEOF
+
XMENU_OBJ=
XOBJ=
FONT_OBJ=
@@ -15798,7 +15957,7 @@ if test "${HAVE_X_WINDOWS}" = "yes" ; then
$as_echo "#define HAVE_X_WINDOWS 1" >>confdefs.h
XMENU_OBJ=xmenu.o
- XOBJ="xterm.o xfns.o xselect.o xrdb.o fontset.o xsmfns.o fringe.o image.o xsettings.o xgselect.o"
+ XOBJ="xterm.o xfns.o xselect.o xrdb.o xsmfns.o xsettings.o xgselect.o"
FONT_OBJ=xfont.o
if test "$HAVE_XFT" = "yes"; then
FONT_OBJ="$FONT_OBJ ftfont.o xftfont.o ftxfont.o"
@@ -15932,7 +16091,7 @@ fi
if test "$opsys" = "cygwin"; then
- CYGWIN_OBJ="sheap.o"
+ CYGWIN_OBJ="sheap.o cygw32.o"
## Cygwin differs because of its unexec().
PRE_ALLOC_OBJ=
POST_ALLOC_OBJ=lastfile.o
@@ -15945,7 +16104,18 @@ fi
-# Configure gnulib here, now that we know LIBS.
+# Configure gnulib. Although this does not affect CFLAGS or LIBS permanently.
+# it temporarily reverts them to their pre-pkg-config values,
+# because gnulib needs to work with both src (which uses the
+# pkg-config stuff) and lib-src (which does not). For example, gnulib
+# may need to determine whether LIB_CLOCK_GETTIME should contain -lrt,
+# and it therefore needs to run in an environment where LIBS does not
+# already contain -lrt merely because 'pkg-config --libs' printed '-lrt'
+# for some package unrelated to lib-src.
+SAVE_CFLAGS=$CFLAGS
+SAVE_LIBS=$LIBS
+CFLAGS=$pre_PKG_CONFIG_CFLAGS
+LIBS="$LIB_PTHREAD $pre_PKG_CONFIG_LIBS"
@@ -16062,8 +16232,8 @@ ALLOCA=\${LIBOBJDIR}alloca.$ac_objext
$as_echo "#define C_ALLOCA 1" >>confdefs.h
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether \`alloca.c' needs Cray hooks" >&5
-$as_echo_n "checking whether \`alloca.c' needs Cray hooks... " >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether 'alloca.c' needs Cray hooks" >&5
+$as_echo_n "checking whether 'alloca.c' needs Cray hooks... " >&6; }
if test "${ac_cv_os_cray+set}" = set; then :
$as_echo_n "(cached) " >&6
else
@@ -16154,22 +16324,6 @@ fi
- for ac_func in $ac_func_list
-do :
- as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
-eval as_val=\$$as_ac_var
- if test "x$as_val" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
-
-
-
-
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5
$as_echo_n "checking whether byte ordering is bigendian... " >&6; }
if test "${ac_cv_c_bigendian+set}" = set; then :
@@ -16506,6 +16660,7 @@ $as_echo "#define HAVE_C99_STRTOLD 1" >>confdefs.h
GNULIB_GETPAGESIZE=0;
GNULIB_GETUSERSHELL=0;
GNULIB_GROUP_MEMBER=0;
+ GNULIB_ISATTY=0;
GNULIB_LCHOWN=0;
GNULIB_LINK=0;
GNULIB_LINKAT=0;
@@ -16518,11 +16673,11 @@ $as_echo "#define HAVE_C99_STRTOLD 1" >>confdefs.h
GNULIB_READLINK=0;
GNULIB_READLINKAT=0;
GNULIB_RMDIR=0;
+ GNULIB_SETHOSTNAME=0;
GNULIB_SLEEP=0;
GNULIB_SYMLINK=0;
GNULIB_SYMLINKAT=0;
GNULIB_TTYNAME_R=0;
- GNULIB_UNISTD_H_GETOPT=0;
GNULIB_UNISTD_H_NONBLOCKING=0;
GNULIB_UNISTD_H_SIGPIPE=0;
GNULIB_UNLINK=0;
@@ -16554,6 +16709,7 @@ $as_echo "#define HAVE_C99_STRTOLD 1" >>confdefs.h
HAVE_PWRITE=1;
HAVE_READLINK=1;
HAVE_READLINKAT=1;
+ HAVE_SETHOSTNAME=1;
HAVE_SLEEP=1;
HAVE_SYMLINK=1;
HAVE_SYMLINKAT=1;
@@ -16566,6 +16722,7 @@ $as_echo "#define HAVE_C99_STRTOLD 1" >>confdefs.h
HAVE_DECL_GETLOGIN_R=1;
HAVE_DECL_GETPAGESIZE=1;
HAVE_DECL_GETUSERSHELL=1;
+ HAVE_DECL_SETHOSTNAME=1;
HAVE_DECL_TTYNAME_R=1;
HAVE_OS_H=0;
HAVE_SYS_PARAM_H=0;
@@ -16574,11 +16731,13 @@ $as_echo "#define HAVE_C99_STRTOLD 1" >>confdefs.h
REPLACE_DUP=0;
REPLACE_DUP2=0;
REPLACE_FCHOWNAT=0;
+ REPLACE_FTRUNCATE=0;
REPLACE_GETCWD=0;
REPLACE_GETDOMAINNAME=0;
REPLACE_GETLOGIN_R=0;
REPLACE_GETGROUPS=0;
REPLACE_GETPAGESIZE=0;
+ REPLACE_ISATTY=0;
REPLACE_LCHOWN=0;
REPLACE_LINK=0;
REPLACE_LINKAT=0;
@@ -16599,118 +16758,76 @@ $as_echo "#define HAVE_C99_STRTOLD 1" >>confdefs.h
UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS=0;
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for st_dm_mode in struct stat" >&5
-$as_echo_n "checking for st_dm_mode in struct stat... " >&6; }
-if test "${ac_cv_struct_st_dm_mode+set}" = set; then :
+
+
+
+
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if environ is properly declared" >&5
+$as_echo_n "checking if environ is properly declared... " >&6; }
+ if test "${gt_cv_var_environ_declaration+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+#if HAVE_UNISTD_H
+ #include <unistd.h>
+ #endif
+ /* mingw, BeOS, Haiku declare environ in <stdlib.h>, not in <unistd.h>. */
+ #include <stdlib.h>
-#include <sys/types.h>
-#include <sys/stat.h>
+ extern struct { int foo; } environ;
int
main ()
{
-struct stat s; s.st_dm_mode;
+environ.foo = 1;
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_struct_st_dm_mode=yes
+ gt_cv_var_environ_declaration=no
else
- ac_cv_struct_st_dm_mode=no
+ gt_cv_var_environ_declaration=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_struct_st_dm_mode" >&5
-$as_echo "$ac_cv_struct_st_dm_mode" >&6; }
- if test $ac_cv_struct_st_dm_mode = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_var_environ_declaration" >&5
+$as_echo "$gt_cv_var_environ_declaration" >&6; }
+ if test $gt_cv_var_environ_declaration = yes; then
-$as_echo "#define HAVE_ST_DM_MODE 1" >>confdefs.h
+$as_echo "#define HAVE_ENVIRON_DECL 1" >>confdefs.h
fi
-ac_fn_c_check_decl "$LINENO" "strmode" "ac_cv_have_decl_strmode" "$ac_includes_default"
-if test "x$ac_cv_have_decl_strmode" = x""yes; then :
- ac_have_decl=1
-else
- ac_have_decl=0
-fi
+ if test $gt_cv_var_environ_declaration != yes; then
+ HAVE_DECL_ENVIRON=0
+ fi
+
+
+
-cat >>confdefs.h <<_ACEOF
-#define HAVE_DECL_STRMODE $ac_have_decl
-_ACEOF
- GNULIB__EXIT=0;
- GNULIB_ATOLL=0;
- GNULIB_CALLOC_POSIX=0;
- GNULIB_CANONICALIZE_FILE_NAME=0;
- GNULIB_GETLOADAVG=0;
- GNULIB_GETSUBOPT=0;
- GNULIB_GRANTPT=0;
- GNULIB_MALLOC_POSIX=0;
- GNULIB_MBTOWC=0;
- GNULIB_MKDTEMP=0;
- GNULIB_MKOSTEMP=0;
- GNULIB_MKOSTEMPS=0;
- GNULIB_MKSTEMP=0;
- GNULIB_MKSTEMPS=0;
- GNULIB_PTSNAME=0;
- GNULIB_PUTENV=0;
- GNULIB_RANDOM_R=0;
- GNULIB_REALLOC_POSIX=0;
- GNULIB_REALPATH=0;
- GNULIB_RPMATCH=0;
- GNULIB_SETENV=0;
- GNULIB_STRTOD=0;
- GNULIB_STRTOLL=0;
- GNULIB_STRTOULL=0;
- GNULIB_SYSTEM_POSIX=0;
- GNULIB_UNLOCKPT=0;
- GNULIB_UNSETENV=0;
- GNULIB_WCTOMB=0;
- HAVE__EXIT=1;
- HAVE_ATOLL=1;
- HAVE_CANONICALIZE_FILE_NAME=1;
- HAVE_DECL_GETLOADAVG=1;
- HAVE_GETSUBOPT=1;
- HAVE_GRANTPT=1;
- HAVE_MKDTEMP=1;
- HAVE_MKOSTEMP=1;
- HAVE_MKOSTEMPS=1;
- HAVE_MKSTEMP=1;
- HAVE_MKSTEMPS=1;
- HAVE_PTSNAME=1;
- HAVE_RANDOM_H=1;
- HAVE_RANDOM_R=1;
- HAVE_REALPATH=1;
- HAVE_RPMATCH=1;
- HAVE_SETENV=1;
- HAVE_DECL_SETENV=1;
- HAVE_STRTOD=1;
- HAVE_STRTOLL=1;
- HAVE_STRTOULL=1;
- HAVE_STRUCT_RANDOM_DATA=1;
- HAVE_SYS_LOADAVG_H=0;
- HAVE_UNLOCKPT=1;
- HAVE_DECL_UNSETENV=1;
- REPLACE_CALLOC=0;
- REPLACE_CANONICALIZE_FILE_NAME=0;
- REPLACE_MALLOC=0;
- REPLACE_MBTOWC=0;
- REPLACE_MKSTEMP=0;
- REPLACE_PUTENV=0;
- REPLACE_REALLOC=0;
- REPLACE_REALPATH=0;
- REPLACE_SETENV=0;
- REPLACE_STRTOD=0;
- REPLACE_UNSETENV=0;
- REPLACE_WCTOMB=0;
+
+
+
+
+ GNULIB_FCNTL=0;
+ GNULIB_NONBLOCKING=0;
+ GNULIB_OPEN=0;
+ GNULIB_OPENAT=0;
+ HAVE_FCNTL=1;
+ HAVE_OPENAT=1;
+ REPLACE_FCNTL=0;
+ REPLACE_OPEN=0;
+ REPLACE_OPENAT=0;
+
@@ -16826,6 +16943,143 @@ $as_echo "$gl_cv_pragma_columns" >&6; }
fi
+ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default"
+if test "x$ac_cv_type_mode_t" = x""yes; then :
+
+else
+
+cat >>confdefs.h <<_ACEOF
+#define mode_t int
+_ACEOF
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for st_dm_mode in struct stat" >&5
+$as_echo_n "checking for st_dm_mode in struct stat... " >&6; }
+if test "${ac_cv_struct_st_dm_mode+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#include <sys/types.h>
+#include <sys/stat.h>
+int
+main ()
+{
+struct stat s; s.st_dm_mode;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_struct_st_dm_mode=yes
+else
+ ac_cv_struct_st_dm_mode=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_struct_st_dm_mode" >&5
+$as_echo "$ac_cv_struct_st_dm_mode" >&6; }
+
+ if test $ac_cv_struct_st_dm_mode = yes; then
+
+$as_echo "#define HAVE_ST_DM_MODE 1" >>confdefs.h
+
+ fi
+
+
+ac_fn_c_check_decl "$LINENO" "strmode" "ac_cv_have_decl_strmode" "$ac_includes_default"
+if test "x$ac_cv_have_decl_strmode" = x""yes; then :
+ ac_have_decl=1
+else
+ ac_have_decl=0
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_DECL_STRMODE $ac_have_decl
+_ACEOF
+
+
+
+
+
+
+ GNULIB__EXIT=0;
+ GNULIB_ATOLL=0;
+ GNULIB_CALLOC_POSIX=0;
+ GNULIB_CANONICALIZE_FILE_NAME=0;
+ GNULIB_GETLOADAVG=0;
+ GNULIB_GETSUBOPT=0;
+ GNULIB_GRANTPT=0;
+ GNULIB_MALLOC_POSIX=0;
+ GNULIB_MBTOWC=0;
+ GNULIB_MKDTEMP=0;
+ GNULIB_MKOSTEMP=0;
+ GNULIB_MKOSTEMPS=0;
+ GNULIB_MKSTEMP=0;
+ GNULIB_MKSTEMPS=0;
+ GNULIB_POSIX_OPENPT=0;
+ GNULIB_PTSNAME=0;
+ GNULIB_PTSNAME_R=0;
+ GNULIB_PUTENV=0;
+ GNULIB_RANDOM=0;
+ GNULIB_RANDOM_R=0;
+ GNULIB_REALLOC_POSIX=0;
+ GNULIB_REALPATH=0;
+ GNULIB_RPMATCH=0;
+ GNULIB_SETENV=0;
+ GNULIB_STRTOD=0;
+ GNULIB_STRTOLL=0;
+ GNULIB_STRTOULL=0;
+ GNULIB_SYSTEM_POSIX=0;
+ GNULIB_UNLOCKPT=0;
+ GNULIB_UNSETENV=0;
+ GNULIB_WCTOMB=0;
+ HAVE__EXIT=1;
+ HAVE_ATOLL=1;
+ HAVE_CANONICALIZE_FILE_NAME=1;
+ HAVE_DECL_GETLOADAVG=1;
+ HAVE_GETSUBOPT=1;
+ HAVE_GRANTPT=1;
+ HAVE_MKDTEMP=1;
+ HAVE_MKOSTEMP=1;
+ HAVE_MKOSTEMPS=1;
+ HAVE_MKSTEMP=1;
+ HAVE_MKSTEMPS=1;
+ HAVE_POSIX_OPENPT=1;
+ HAVE_PTSNAME=1;
+ HAVE_PTSNAME_R=1;
+ HAVE_RANDOM=1;
+ HAVE_RANDOM_H=1;
+ HAVE_RANDOM_R=1;
+ HAVE_REALPATH=1;
+ HAVE_RPMATCH=1;
+ HAVE_SETENV=1;
+ HAVE_DECL_SETENV=1;
+ HAVE_STRTOD=1;
+ HAVE_STRTOLL=1;
+ HAVE_STRTOULL=1;
+ HAVE_STRUCT_RANDOM_DATA=1;
+ HAVE_SYS_LOADAVG_H=0;
+ HAVE_UNLOCKPT=1;
+ HAVE_DECL_UNSETENV=1;
+ REPLACE_CALLOC=0;
+ REPLACE_CANONICALIZE_FILE_NAME=0;
+ REPLACE_MALLOC=0;
+ REPLACE_MBTOWC=0;
+ REPLACE_MKSTEMP=0;
+ REPLACE_PTSNAME=0;
+ REPLACE_PTSNAME_R=0;
+ REPLACE_PUTENV=0;
+ REPLACE_RANDOM_R=0;
+ REPLACE_REALLOC=0;
+ REPLACE_REALPATH=0;
+ REPLACE_SETENV=0;
+ REPLACE_STRTOD=0;
+ REPLACE_UNSETENV=0;
+ REPLACE_WCTOMB=0;
+
@@ -16868,12 +17122,15 @@ _ACEOF
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'getopt.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'getopt.h\)".*|\1|
+ gl_header_literal_regex=`echo 'getopt.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
@@ -16945,57 +17202,124 @@ done
fi
- if test -z "$gl_replace_getopt"; then
+ if test -z "$gl_replace_getopt"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getopt is POSIX compatible" >&5
$as_echo_n "checking whether getopt is POSIX compatible... " >&6; }
if test "${gl_cv_func_getopt_posix+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ if test $cross_compiling = no; then
+ if test "$cross_compiling" = yes; then :
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot run test program while cross compiling
+See \`config.log' for more details." "$LINENO" 5; }
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+
#include <unistd.h>
+#include <stdlib.h>
+#include <string.h>
+
int
main ()
{
-int *p = &optreset; return optreset;
- ;
+ static char program[] = "program";
+ static char a[] = "-a";
+ static char foo[] = "foo";
+ static char bar[] = "bar";
+ char *argv[] = { program, a, foo, bar, NULL };
+ int c;
+
+ c = getopt (4, argv, "ab");
+ if (!(c == 'a'))
+ return 1;
+ c = getopt (4, argv, "ab");
+ if (!(c == -1))
+ return 2;
+ if (!(optind == 2))
+ return 3;
return 0;
}
+
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- gl_optind_min=1
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_getopt_posix=maybe
+else
+ gl_cv_func_getopt_posix=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+ if test $gl_cv_func_getopt_posix = maybe; then
+ if test "$cross_compiling" = yes; then :
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot run test program while cross compiling
+See \`config.log' for more details." "$LINENO" 5; }
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <getopt.h>
+
+#include <unistd.h>
+#include <stdlib.h>
+#include <string.h>
+
int
main ()
{
-return !getopt_clip;
- ;
+ static char program[] = "program";
+ static char donald[] = "donald";
+ static char p[] = "-p";
+ static char billy[] = "billy";
+ static char duck[] = "duck";
+ static char a[] = "-a";
+ static char bar[] = "bar";
+ char *argv[] = { program, donald, p, billy, duck, a, bar, NULL };
+ int c;
+
+ c = getopt (7, argv, "+abp:q:");
+ if (!(c == -1))
+ return 4;
+ if (!(strcmp (argv[0], "program") == 0))
+ return 5;
+ if (!(strcmp (argv[1], "donald") == 0))
+ return 6;
+ if (!(strcmp (argv[2], "-p") == 0))
+ return 7;
+ if (!(strcmp (argv[3], "billy") == 0))
+ return 8;
+ if (!(strcmp (argv[4], "duck") == 0))
+ return 9;
+ if (!(strcmp (argv[5], "-a") == 0))
+ return 10;
+ if (!(strcmp (argv[6], "bar") == 0))
+ return 11;
+ if (!(optind == 1))
+ return 12;
return 0;
}
+
_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- gl_optind_min=1
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_getopt_posix=maybe
else
- gl_optind_min=0
+ gl_cv_func_getopt_posix=no
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
- gl_save_CPPFLAGS=$CPPFLAGS
- CPPFLAGS="$CPPFLAGS -DOPTIND_MIN=$gl_optind_min"
- if test "$cross_compiling" = yes; then :
- case "$host_os" in
- mingw*) gl_cv_func_getopt_posix="guessing no";;
- darwin* | aix*) gl_cv_func_getopt_posix="guessing no";;
- *) gl_cv_func_getopt_posix="guessing yes";;
- esac
+ fi
+ if test $gl_cv_func_getopt_posix = maybe; then
+ if test "$cross_compiling" = yes; then :
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot run test program while cross compiling
+See \`config.log' for more details." "$LINENO" 5; }
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
@@ -17007,78 +17331,17 @@ else
int
main ()
{
- {
- static char program[] = "program";
- static char a[] = "-a";
- static char foo[] = "foo";
- static char bar[] = "bar";
- char *argv[] = { program, a, foo, bar, NULL };
- int c;
-
- optind = OPTIND_MIN;
- opterr = 0;
-
- c = getopt (4, argv, "ab");
- if (!(c == 'a'))
- return 1;
- c = getopt (4, argv, "ab");
- if (!(c == -1))
- return 2;
- if (!(optind == 2))
- return 3;
- }
- /* Some internal state exists at this point. */
- {
- static char program[] = "program";
- static char donald[] = "donald";
- static char p[] = "-p";
- static char billy[] = "billy";
- static char duck[] = "duck";
- static char a[] = "-a";
- static char bar[] = "bar";
- char *argv[] = { program, donald, p, billy, duck, a, bar, NULL };
- int c;
-
- optind = OPTIND_MIN;
- opterr = 0;
-
- c = getopt (7, argv, "+abp:q:");
- if (!(c == -1))
- return 4;
- if (!(strcmp (argv[0], "program") == 0))
- return 5;
- if (!(strcmp (argv[1], "donald") == 0))
- return 6;
- if (!(strcmp (argv[2], "-p") == 0))
- return 7;
- if (!(strcmp (argv[3], "billy") == 0))
- return 8;
- if (!(strcmp (argv[4], "duck") == 0))
- return 9;
- if (!(strcmp (argv[5], "-a") == 0))
- return 10;
- if (!(strcmp (argv[6], "bar") == 0))
- return 11;
- if (!(optind == 1))
- return 12;
- }
- /* Detect MacOS 10.5, AIX 7.1 bug. */
- {
- static char program[] = "program";
- static char ab[] = "-ab";
- char *argv[3] = { program, ab, NULL };
- optind = OPTIND_MIN;
- opterr = 0;
- if (getopt (2, argv, "ab:") != 'a')
- return 13;
- if (getopt (2, argv, "ab:") != '?')
- return 14;
- if (optopt != 'b')
- return 15;
- if (optind != 2)
- return 16;
- }
-
+ static char program[] = "program";
+ static char ab[] = "-ab";
+ char *argv[3] = { program, ab, NULL };
+ if (getopt (2, argv, "ab:") != 'a')
+ return 13;
+ if (getopt (2, argv, "ab:") != '?')
+ return 14;
+ if (optopt != 'b')
+ return 15;
+ if (optind != 2)
+ return 16;
return 0;
}
@@ -17092,7 +17355,13 @@ rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
- CPPFLAGS=$gl_save_CPPFLAGS
+ fi
+ else
+ case "$host_os" in
+ darwin* | aix* | mingw*) gl_cv_func_getopt_posix="guessing no";;
+ *) gl_cv_func_getopt_posix="guessing yes";;
+ esac
+ fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_getopt_posix" >&5
@@ -17123,11 +17392,7 @@ else
POSIXLY_CORRECT=1
export POSIXLY_CORRECT
if test "$cross_compiling" = yes; then :
- case $host_os:$ac_cv_have_decl_optreset in
- *-gnu*:* | mingw*:*) gl_cv_func_getopt_gnu=no;;
- *:yes) gl_cv_func_getopt_gnu=no;;
- *) gl_cv_func_getopt_gnu=yes;;
- esac
+ gl_cv_func_getopt_gnu="guessing no"
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
@@ -17138,7 +17403,7 @@ else
#include <stdlib.h>
#if defined __MACH__ && defined __APPLE__
-/* Avoid a crash on MacOS X. */
+/* Avoid a crash on Mac OS X. */
#include <mach/mach.h>
#include <mach/mach_error.h>
#include <mach/thread_status.h>
@@ -17258,7 +17523,7 @@ main ()
nocrash_init();
/* This code succeeds on glibc 2.8, OpenBSD 4.0, Cygwin, mingw,
- and fails on MacOS X 10.5, AIX 5.2, HP-UX 11, IRIX 6.5,
+ and fails on Mac OS X 10.5, AIX 5.2, HP-UX 11, IRIX 6.5,
OSF/1 5.1, Solaris 10. */
{
static char conftest[] = "conftest";
@@ -17269,7 +17534,7 @@ main ()
result |= 1;
}
/* This code succeeds on glibc 2.8, mingw,
- and fails on MacOS X 10.5, OpenBSD 4.0, AIX 5.2, HP-UX 11,
+ and fails on Mac OS X 10.5, OpenBSD 4.0, AIX 5.2, HP-UX 11,
IRIX 6.5, OSF/1 5.1, Solaris 10, Cygwin 1.5.x. */
{
static char program[] = "program";
@@ -17298,7 +17563,7 @@ main ()
if (getopt (3, argv, "-p") != 1)
result |= 16;
else if (getopt (3, argv, "-p") != 'p')
- result |= 32;
+ result |= 16;
}
/* This code fails on glibc 2.11. */
{
@@ -17308,9 +17573,9 @@ main ()
char *argv[] = { program, b, a, NULL };
optind = opterr = 0;
if (getopt (3, argv, "+:a:b") != 'b')
- result |= 64;
+ result |= 32;
else if (getopt (3, argv, "+:a:b") != ':')
- result |= 64;
+ result |= 32;
}
/* This code dumps core on glibc 2.14. */
{
@@ -17320,7 +17585,7 @@ main ()
char *argv[] = { program, w, dummy, NULL };
optind = opterr = 1;
if (getopt (3, argv, "W;") != 'W')
- result |= 128;
+ result |= 64;
}
return result;
@@ -17346,24 +17611,83 @@ fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_getopt_gnu" >&5
$as_echo "$gl_cv_func_getopt_gnu" >&6; }
- if test "$gl_cv_func_getopt_gnu" = "no"; then
+ if test "$gl_cv_func_getopt_gnu" != yes; then
gl_replace_getopt=yes
- fi
- fi
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working GNU getopt_long function" >&5
+$as_echo_n "checking for working GNU getopt_long function... " >&6; }
+if test "${gl_cv_func_getopt_long_gnu+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ case "$host_os" in
+ openbsd*) gl_cv_func_getopt_long_gnu="guessing no";;
+ *) gl_cv_func_getopt_long_gnu="guessing yes";;
+ esac
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <getopt.h>
+ #include <stddef.h>
+ #include <string.h>
+int
+main ()
+{
+static const struct option long_options[] =
+ {
+ { "xtremely-",no_argument, NULL, 1003 },
+ { "xtra", no_argument, NULL, 1001 },
+ { "xtreme", no_argument, NULL, 1002 },
+ { "xtremely", no_argument, NULL, 1003 },
+ { NULL, 0, NULL, 0 }
+ };
+ /* This code fails on OpenBSD 5.0. */
+ {
+ static char program[] = "program";
+ static char xtremel[] = "--xtremel";
+ char *argv[] = { program, xtremel, NULL };
+ int option_index;
+ optind = 1; opterr = 0;
+ if (getopt_long (2, argv, "", long_options, &option_index) != 1003)
+ return 1;
+ }
+ return 0;
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_getopt_long_gnu=yes
+else
+ gl_cv_func_getopt_long_gnu=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_getopt_long_gnu" >&5
+$as_echo "$gl_cv_func_getopt_long_gnu" >&6; }
+ case "$gl_cv_func_getopt_long_gnu" in
+ *yes) ;;
+ *) gl_replace_getopt=yes ;;
+ esac
+ fi
+ fi
- REPLACE_GETOPT=0
- if test -n "$gl_replace_getopt"; then :
- REPLACE_GETOPT=1
-fi
+ REPLACE_GETOPT=0
+ if test -n "$gl_replace_getopt"; then
+ REPLACE_GETOPT=1
+ fi
if test $REPLACE_GETOPT = 1; then
@@ -17373,7 +17697,6 @@ $as_echo "#define __GETOPT_PREFIX rpl_" >>confdefs.h
- GNULIB_UNISTD_H_GETOPT=1
fi
ac_fn_c_check_decl "$LINENO" "getenv" "ac_cv_have_decl_getenv" "$ac_includes_default"
@@ -17387,6 +17710,260 @@ cat >>confdefs.h <<_ACEOF
#define HAVE_DECL_GETENV $ac_have_decl
_ACEOF
+:
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C/C++ restrict keyword" >&5
+$as_echo_n "checking for C/C++ restrict keyword... " >&6; }
+if test "${ac_cv_c_restrict+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_cv_c_restrict=no
+ # The order here caters to the fact that C++ does not require restrict.
+ for ac_kw in __restrict __restrict__ _Restrict restrict; do
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+typedef int * int_ptr;
+ int foo (int_ptr $ac_kw ip) {
+ return ip[0];
+ }
+int
+main ()
+{
+int s[1];
+ int * $ac_kw t = s;
+ t[0] = 0;
+ return foo(t)
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_c_restrict=$ac_kw
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ test "$ac_cv_c_restrict" != no && break
+ done
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_restrict" >&5
+$as_echo "$ac_cv_c_restrict" >&6; }
+
+ case $ac_cv_c_restrict in
+ restrict) ;;
+ no) $as_echo "#define restrict /**/" >>confdefs.h
+ ;;
+ *) cat >>confdefs.h <<_ACEOF
+#define restrict $ac_cv_c_restrict
+_ACEOF
+ ;;
+ esac
+
+
+ GNULIB_GETTIMEOFDAY=0;
+ HAVE_GETTIMEOFDAY=1;
+ HAVE_STRUCT_TIMEVAL=1;
+ HAVE_SYS_TIME_H=1;
+ REPLACE_GETTIMEOFDAY=0;
+ REPLACE_STRUCT_TIMEVAL=0;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ if test $gl_cv_have_include_next = yes; then
+ gl_cv_next_sys_time_h='<'sys/time.h'>'
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <sys/time.h>" >&5
+$as_echo_n "checking absolute name of <sys/time.h>... " >&6; }
+if test "${gl_cv_next_sys_time_h+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ if test $ac_cv_header_sys_time_h = yes; then
+
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/time.h>
+
+_ACEOF
+ case "$host_os" in
+ aix*) gl_absname_cpp="$ac_cpp -C" ;;
+ *) gl_absname_cpp="$ac_cpp" ;;
+ esac
+
+ case "$host_os" in
+ mingw*)
+ gl_dirsep_regex='[/\\]'
+ ;;
+ *)
+ gl_dirsep_regex='\/'
+ ;;
+ esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
+
+ gl_header_literal_regex=`echo 'sys/time.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
+ s|^/[^/]|//&|
+ p
+ q
+ }'
+ gl_cv_next_sys_time_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 |
+ sed -n "$gl_absolute_header_sed"`'"'
+ else
+ gl_cv_next_sys_time_h='<'sys/time.h'>'
+ fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_sys_time_h" >&5
+$as_echo "$gl_cv_next_sys_time_h" >&6; }
+ fi
+ NEXT_SYS_TIME_H=$gl_cv_next_sys_time_h
+
+ if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next'
+ gl_next_as_first_directive='<'sys/time.h'>'
+ else
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
+ gl_next_as_first_directive=$gl_cv_next_sys_time_h
+ fi
+ NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H=$gl_next_as_first_directive
+
+
+
+
+
+ if test $ac_cv_header_sys_time_h != yes; then
+ HAVE_SYS_TIME_H=0
+ fi
+
+
+
+
+
+ if test $ac_cv_header_sys_socket_h != yes; then
+ for ac_header in winsock2.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "winsock2.h" "ac_cv_header_winsock2_h" "$ac_includes_default"
+if test "x$ac_cv_header_winsock2_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_WINSOCK2_H 1
+_ACEOF
+
+fi
+
+done
+
+ fi
+ if test "$ac_cv_header_winsock2_h" = yes; then
+ HAVE_WINSOCK2_H=1
+ UNISTD_H_HAVE_WINSOCK2_H=1
+ SYS_IOCTL_H_HAVE_WINSOCK2_H=1
+ else
+ HAVE_WINSOCK2_H=0
+ fi
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timeval" >&5
+$as_echo_n "checking for struct timeval... " >&6; }
+if test "${gl_cv_sys_struct_timeval+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#if HAVE_SYS_TIME_H
+ #include <sys/time.h>
+ #endif
+ #include <time.h>
+ #if HAVE_WINSOCK2_H
+ # include <winsock2.h>
+ #endif
+
+int
+main ()
+{
+static struct timeval x; x.tv_sec = x.tv_usec;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_sys_struct_timeval=yes
+else
+ gl_cv_sys_struct_timeval=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sys_struct_timeval" >&5
+$as_echo "$gl_cv_sys_struct_timeval" >&6; }
+ if test $gl_cv_sys_struct_timeval != yes; then
+ HAVE_STRUCT_TIMEVAL=0
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for wide-enough struct timeval.tv_sec member" >&5
+$as_echo_n "checking for wide-enough struct timeval.tv_sec member... " >&6; }
+if test "${gl_cv_sys_struct_timeval_tv_sec+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#if HAVE_SYS_TIME_H
+ #include <sys/time.h>
+ #endif
+ #include <time.h>
+ #if HAVE_WINSOCK2_H
+ # include <winsock2.h>
+ #endif
+
+int
+main ()
+{
+static struct timeval x;
+ typedef int verify_tv_sec_type[
+ sizeof (time_t) <= sizeof x.tv_sec ? 1 : -1
+ ];
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_sys_struct_timeval_tv_sec=yes
+else
+ gl_cv_sys_struct_timeval_tv_sec=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sys_struct_timeval_tv_sec" >&5
+$as_echo "$gl_cv_sys_struct_timeval_tv_sec" >&6; }
+ if test $gl_cv_sys_struct_timeval_tv_sec != yes; then
+ REPLACE_STRUCT_TIMEVAL=1
+ fi
+ fi
+
+
+
+
+
+
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for unsigned long long int" >&5
$as_echo_n "checking for unsigned long long int... " >&6; }
@@ -17625,12 +18202,15 @@ _ACEOF
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'stdint.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'stdint.h\)".*|\1|
+ gl_header_literal_regex=`echo 'stdint.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
@@ -17678,8 +18258,6 @@ else
/* end confdefs.h. */
-#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */
-#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */
#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */
#include <stdint.h>
/* Dragonfly defines WCHAR_MIN, WCHAR_MAX only in <wchar.h>. */
@@ -17848,8 +18426,6 @@ else
/* end confdefs.h. */
-#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */
-#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */
#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */
#include <stdint.h>
@@ -18288,6 +18864,7 @@ fi
HAVE_DECL_IMAXDIV=1;
HAVE_DECL_STRTOIMAX=1;
HAVE_DECL_STRTOUMAX=1;
+ REPLACE_STRTOIMAX=0;
INT32_MAX_LT_INTMAX_MAX=1;
INT64_MAX_EQ_LONG_MAX='defined _LP64';
PRI_MACROS_BROKEN=0;
@@ -18336,12 +18913,15 @@ _ACEOF
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'inttypes.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'inttypes.h\)".*|\1|
+ gl_header_literal_regex=`echo 'inttypes.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
@@ -18375,11 +18955,51 @@ $as_echo "$gl_cv_next_inttypes_h" >&6; }
-$as_echo "#define GL_TRIGGER_STDC_LIMIT_MACROS 1" >>confdefs.h
+ case "$host_os" in
+ mingw*)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit off_t" >&5
+$as_echo_n "checking for 64-bit off_t... " >&6; }
+if test "${gl_cv_type_off_t_64+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/types.h>
+ int verify_off_t_size[sizeof (off_t) >= 8 ? 1 : -1];
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_type_off_t_64=yes
+else
+ gl_cv_type_off_t_64=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_type_off_t_64" >&5
+$as_echo "$gl_cv_type_off_t_64" >&6; }
+ if test $gl_cv_type_off_t_64 = no; then
+ WINDOWS_64_BIT_OFF_T=1
+ else
+ WINDOWS_64_BIT_OFF_T=0
+ fi
+ WINDOWS_64_BIT_ST_SIZE=1
+ ;;
+ *)
+ WINDOWS_64_BIT_OFF_T=0
+ WINDOWS_64_BIT_ST_SIZE=0
+ ;;
+ esac
GNULIB_FCHMODAT=0;
@@ -18428,10 +19048,12 @@ else
echo >conftest.file
if test "$as_ln_s" = "ln -s" && ln -s conftest.file conftest.sym; then
if test "$cross_compiling" = yes; then :
- # When cross-compiling, be pessimistic so we will end up using the
- # replacement version of lstat that checks for trailing slashes and
- # calls lstat a second time when necessary.
- gl_cv_func_lstat_dereferences_slashed_symlink=no
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_lstat_dereferences_slashed_symlink="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_lstat_dereferences_slashed_symlink="guessing no" ;;
+ esac
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
@@ -18462,19 +19084,22 @@ fi
else
# If the 'ln -s' command failed, then we probably don't even
# have an lstat function.
- gl_cv_func_lstat_dereferences_slashed_symlink=no
+ gl_cv_func_lstat_dereferences_slashed_symlink="guessing no"
fi
rm -f conftest.sym conftest.file
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_lstat_dereferences_slashed_symlink" >&5
$as_echo "$gl_cv_func_lstat_dereferences_slashed_symlink" >&6; }
- test $gl_cv_func_lstat_dereferences_slashed_symlink = yes &&
+ case "$gl_cv_func_lstat_dereferences_slashed_symlink" in
+ *yes)
cat >>confdefs.h <<_ACEOF
#define LSTAT_FOLLOWS_SLASHED_SYMLINK 1
_ACEOF
+ ;;
+ esac
GNULIB_MKTIME=0;
@@ -18494,6 +19119,209 @@ _ACEOF
+ GNULIB_PSELECT=0;
+ GNULIB_SELECT=0;
+ HAVE_PSELECT=1;
+ REPLACE_PSELECT=0;
+ REPLACE_SELECT=0;
+
+
+
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether <sys/select.h> is self-contained" >&5
+$as_echo_n "checking whether <sys/select.h> is self-contained... " >&6; }
+if test "${gl_cv_header_sys_select_h_selfcontained+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+int
+main ()
+{
+struct timeval b;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_header_sys_select_h_selfcontained=yes
+else
+ gl_cv_header_sys_select_h_selfcontained=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ if test $gl_cv_header_sys_select_h_selfcontained = yes; then
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+int
+main ()
+{
+int memset; int bzero;
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+int
+main ()
+{
+
+ #undef memset
+ #define memset nonexistent_memset
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void *memset (void *, int, unsigned long);
+ #undef bzero
+ #define bzero nonexistent_bzero
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void bzero (void *, unsigned long);
+ fd_set fds;
+ FD_ZERO (&fds);
+
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+
+else
+ gl_cv_header_sys_select_h_selfcontained=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_header_sys_select_h_selfcontained" >&5
+$as_echo "$gl_cv_header_sys_select_h_selfcontained" >&6; }
+
+
+
+
+
+
+
+
+
+ if test $gl_cv_have_include_next = yes; then
+ gl_cv_next_sys_select_h='<'sys/select.h'>'
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <sys/select.h>" >&5
+$as_echo_n "checking absolute name of <sys/select.h>... " >&6; }
+if test "${gl_cv_next_sys_select_h+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ if test $ac_cv_header_sys_select_h = yes; then
+
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+
+_ACEOF
+ case "$host_os" in
+ aix*) gl_absname_cpp="$ac_cpp -C" ;;
+ *) gl_absname_cpp="$ac_cpp" ;;
+ esac
+
+ case "$host_os" in
+ mingw*)
+ gl_dirsep_regex='[/\\]'
+ ;;
+ *)
+ gl_dirsep_regex='\/'
+ ;;
+ esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
+
+ gl_header_literal_regex=`echo 'sys/select.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
+ s|^/[^/]|//&|
+ p
+ q
+ }'
+ gl_cv_next_sys_select_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 |
+ sed -n "$gl_absolute_header_sed"`'"'
+ else
+ gl_cv_next_sys_select_h='<'sys/select.h'>'
+ fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_sys_select_h" >&5
+$as_echo "$gl_cv_next_sys_select_h" >&6; }
+ fi
+ NEXT_SYS_SELECT_H=$gl_cv_next_sys_select_h
+
+ if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next'
+ gl_next_as_first_directive='<'sys/select.h'>'
+ else
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
+ gl_next_as_first_directive=$gl_cv_next_sys_select_h
+ fi
+ NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H=$gl_next_as_first_directive
+
+
+
+
+ if test $ac_cv_header_sys_select_h = yes; then
+ HAVE_SYS_SELECT_H=1
+ else
+ HAVE_SYS_SELECT_H=0
+ fi
+
+
+
+
+
+ if test $ac_cv_header_sys_socket_h != yes; then
+ for ac_header in winsock2.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "winsock2.h" "ac_cv_header_winsock2_h" "$ac_includes_default"
+if test "x$ac_cv_header_winsock2_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_WINSOCK2_H 1
+_ACEOF
+
+fi
+
+done
+
+ fi
+ if test "$ac_cv_header_winsock2_h" = yes; then
+ HAVE_WINSOCK2_H=1
+ UNISTD_H_HAVE_WINSOCK2_H=1
+ SYS_IOCTL_H_HAVE_WINSOCK2_H=1
+ else
+ HAVE_WINSOCK2_H=0
+ fi
+
+
+
+
+
+
GNULIB_PTHREAD_SIGMASK=0;
@@ -18518,6 +19346,9 @@ _ACEOF
+
+
+
ac_fn_c_check_type "$LINENO" "sigset_t" "ac_cv_type_sigset_t" "
#include <signal.h>
/* Mingw defines sigset_t not in <signal.h>, but in <sys/types.h>. */
@@ -18541,8 +19372,6 @@ fi
-
-
if test $ac_cv_header_sys_socket_h = no; then
for ac_header in ws2tcpip.h
do :
@@ -18707,7 +19536,6 @@ $as_echo "#define HAVE_WCHAR_T 1" >>confdefs.h
GNULIB_GETCHAR=0;
GNULIB_GETDELIM=0;
GNULIB_GETLINE=0;
- GNULIB_GETS=0;
GNULIB_OBSTACK_PRINTF=0;
GNULIB_OBSTACK_PRINTF_POSIX=0;
GNULIB_PCLOSE=0;
@@ -18900,8 +19728,6 @@ fi
-
-
ac_fn_c_check_decl "$LINENO" "strtoimax" "ac_cv_have_decl_strtoimax" "$ac_includes_default"
if test "x$ac_cv_have_decl_strtoimax" = x""yes; then :
ac_have_decl=1
@@ -18972,65 +19798,6 @@ fi
-ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default"
-if test "x$ac_cv_type_mode_t" = x""yes; then :
-
-else
-
-cat >>confdefs.h <<_ACEOF
-#define mode_t int
-_ACEOF
-
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C/C++ restrict keyword" >&5
-$as_echo_n "checking for C/C++ restrict keyword... " >&6; }
-if test "${ac_cv_c_restrict+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_cv_c_restrict=no
- # The order here caters to the fact that C++ does not require restrict.
- for ac_kw in __restrict __restrict__ _Restrict restrict; do
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-typedef int * int_ptr;
- int foo (int_ptr $ac_kw ip) {
- return ip[0];
- }
-int
-main ()
-{
-int s[1];
- int * $ac_kw t = s;
- t[0] = 0;
- return foo(t)
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_c_restrict=$ac_kw
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- test "$ac_cv_c_restrict" != no && break
- done
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_restrict" >&5
-$as_echo "$ac_cv_c_restrict" >&6; }
-
- case $ac_cv_c_restrict in
- restrict) ;;
- no) $as_echo "#define restrict /**/" >>confdefs.h
- ;;
- *) cat >>confdefs.h <<_ACEOF
-#define restrict $ac_cv_c_restrict
-_ACEOF
- ;;
- esac
-
-
-
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timespec in <time.h>" >&5
@@ -19165,12 +19932,15 @@ _ACEOF
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'time.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'time.h\)".*|\1|
+ gl_header_literal_regex=`echo 'time.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
@@ -19199,15 +19969,266 @@ $as_echo "$gl_cv_next_time_h" >&6; }
-ac_fn_c_check_decl "$LINENO" "localtime_r" "ac_cv_have_decl_localtime_r" "$ac_includes_default"
-if test "x$ac_cv_have_decl_localtime_r" = x""yes; then :
- ac_have_decl=1
+
+
+
+
+
+
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the utimes function works" >&5
+$as_echo_n "checking whether the utimes function works... " >&6; }
+if test "${gl_cv_func_working_utimes+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- ac_have_decl=0
+
+ if test "$cross_compiling" = yes; then :
+ gl_cv_func_working_utimes=no
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <sys/time.h>
+#include <time.h>
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <utime.h>
+
+static int
+inorder (time_t a, time_t b, time_t c)
+{
+ return a <= b && b <= c;
+}
+
+int
+main ()
+{
+ int result = 0;
+ char const *file = "conftest.utimes";
+ static struct timeval timeval[2] = {{9, 10}, {999999, 999999}};
+
+ /* Test whether utimes() essentially works. */
+ {
+ struct stat sbuf;
+ FILE *f = fopen (file, "w");
+ if (f == NULL)
+ result |= 1;
+ else if (fclose (f) != 0)
+ result |= 1;
+ else if (utimes (file, timeval) != 0)
+ result |= 2;
+ else if (lstat (file, &sbuf) != 0)
+ result |= 1;
+ else if (!(sbuf.st_atime == timeval[0].tv_sec
+ && sbuf.st_mtime == timeval[1].tv_sec))
+ result |= 4;
+ if (unlink (file) != 0)
+ result |= 1;
+ }
+
+ /* Test whether utimes() with a NULL argument sets the file's timestamp
+ to the current time. Use 'fstat' as well as 'time' to
+ determine the "current" time, to accommodate NFS file systems
+ if there is a time skew between the host and the NFS server. */
+ {
+ int fd = open (file, O_WRONLY|O_CREAT, 0644);
+ if (fd < 0)
+ result |= 1;
+ else
+ {
+ time_t t0, t2;
+ struct stat st0, st1, st2;
+ if (time (&t0) == (time_t) -1)
+ result |= 1;
+ else if (fstat (fd, &st0) != 0)
+ result |= 1;
+ else if (utimes (file, timeval) != 0)
+ result |= 2;
+ else if (utimes (file, NULL) != 0)
+ result |= 8;
+ else if (fstat (fd, &st1) != 0)
+ result |= 1;
+ else if (write (fd, "\n", 1) != 1)
+ result |= 1;
+ else if (fstat (fd, &st2) != 0)
+ result |= 1;
+ else if (time (&t2) == (time_t) -1)
+ result |= 1;
+ else
+ {
+ int m_ok_POSIX = inorder (t0, st1.st_mtime, t2);
+ int m_ok_NFS = inorder (st0.st_mtime, st1.st_mtime, st2.st_mtime);
+ if (! (st1.st_atime == st1.st_mtime))
+ result |= 16;
+ if (! (m_ok_POSIX || m_ok_NFS))
+ result |= 32;
+ }
+ if (close (fd) != 0)
+ result |= 1;
+ }
+ if (unlink (file) != 0)
+ result |= 1;
+ }
+
+ /* Test whether utimes() with a NULL argument works on read-only files. */
+ {
+ int fd = open (file, O_WRONLY|O_CREAT, 0444);
+ if (fd < 0)
+ result |= 1;
+ else if (close (fd) != 0)
+ result |= 1;
+ else if (utimes (file, NULL) != 0)
+ result |= 64;
+ if (unlink (file) != 0)
+ result |= 1;
+ }
+
+ return result;
+}
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_working_utimes=yes
+else
+ gl_cv_func_working_utimes=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_working_utimes" >&5
+$as_echo "$gl_cv_func_working_utimes" >&6; }
+
+ if test $gl_cv_func_working_utimes = yes; then
+
+$as_echo "#define HAVE_WORKING_UTIMES 1" >>confdefs.h
+
+ fi
+
+
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct utimbuf" >&5
+$as_echo_n "checking for struct utimbuf... " >&6; }
+if test "${gl_cv_sys_struct_utimbuf+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#if HAVE_SYS_TIME_H
+ #include <sys/time.h>
+ #endif
+ #include <time.h>
+ #ifdef HAVE_UTIME_H
+ #include <utime.h>
+ #endif
+
+int
+main ()
+{
+static struct utimbuf x; x.actime = x.modtime;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_sys_struct_utimbuf=yes
+else
+ gl_cv_sys_struct_utimbuf=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sys_struct_utimbuf" >&5
+$as_echo "$gl_cv_sys_struct_utimbuf" >&6; }
+
+ if test $gl_cv_sys_struct_utimbuf = yes; then
+
+$as_echo "#define HAVE_STRUCT_UTIMBUF 1" >>confdefs.h
+
+ fi
+
+
+
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking type of array argument to getgroups" >&5
+$as_echo_n "checking type of array argument to getgroups... " >&6; }
+if test "${ac_cv_type_getgroups+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ ac_cv_type_getgroups=cross
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+/* Thanks to Mike Rendell for this test. */
+$ac_includes_default
+#define NGID 256
+#undef MAX
+#define MAX(x, y) ((x) > (y) ? (x) : (y))
+
+int
+main ()
+{
+ gid_t gidset[NGID];
+ int i, n;
+ union { gid_t gval; long int lval; } val;
+
+ val.lval = -1;
+ for (i = 0; i < NGID; i++)
+ gidset[i] = val.gval;
+ n = getgroups (sizeof (gidset) / MAX (sizeof (int), sizeof (gid_t)) - 1,
+ gidset);
+ /* Exit non-zero if getgroups seems to require an array of ints. This
+ happens when gid_t is short int but getgroups modifies an array
+ of ints. */
+ return n > 0 && gidset[n] != val.gval;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ ac_cv_type_getgroups=gid_t
+else
+ ac_cv_type_getgroups=int
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+if test $ac_cv_type_getgroups = cross; then
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <unistd.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "getgroups.*int.*gid_t" >/dev/null 2>&1; then :
+ ac_cv_type_getgroups=gid_t
+else
+ ac_cv_type_getgroups=int
fi
+rm -f conftest*
+
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_getgroups" >&5
+$as_echo "$ac_cv_type_getgroups" >&6; }
cat >>confdefs.h <<_ACEOF
-#define HAVE_DECL_LOCALTIME_R $ac_have_decl
+#define GETGROUPS_T $ac_cv_type_getgroups
_ACEOF
@@ -19294,6 +20315,100 @@ fi
+ # Solaris 2.5.1 needs -lposix4 to get the clock_gettime function.
+ # Solaris 7 prefers the library name -lrt to the obsolescent name -lposix4.
+
+ # Save and restore LIBS so e.g., -lrt, isn't added to it. Otherwise, *all*
+ # programs in the package would end up linked with that potentially-shared
+ # library, inducing unnecessary run-time overhead.
+ LIB_CLOCK_GETTIME=
+
+ gl_saved_libs=$LIBS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing clock_gettime" >&5
+$as_echo_n "checking for library containing clock_gettime... " >&6; }
+if test "${ac_cv_search_clock_gettime+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char clock_gettime ();
+int
+main ()
+{
+return clock_gettime ();
+ ;
+ return 0;
+}
+_ACEOF
+for ac_lib in '' rt posix4; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ fi
+ if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_search_clock_gettime=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if test "${ac_cv_search_clock_gettime+set}" = set; then :
+ break
+fi
+done
+if test "${ac_cv_search_clock_gettime+set}" = set; then :
+
+else
+ ac_cv_search_clock_gettime=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_clock_gettime" >&5
+$as_echo "$ac_cv_search_clock_gettime" >&6; }
+ac_res=$ac_cv_search_clock_gettime
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+ test "$ac_cv_search_clock_gettime" = "none required" ||
+ LIB_CLOCK_GETTIME=$ac_cv_search_clock_gettime
+fi
+
+ for ac_func in clock_gettime clock_settime
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+ LIBS=$gl_saved_libs
+
+
+ :
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define GNULIB_CLOSE_STREAM 1
+_ACEOF
+
+
+
+
+
:
@@ -19327,17 +20442,17 @@ else
if test "$cross_compiling" = yes; then :
case "$host_os" in
mingw*) # on this platform, dup2 always returns 0 for success
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
linux*) # On linux between 2008-07-27 and 2009-05-11, dup2 of a
# closed fd may yield -EBADF instead of -1 / errno=EBADF.
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
freebsd*) # on FreeBSD 6.1, dup2(1,1000000) gives EMFILE, not EBADF.
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC.
- gl_cv_func_dup2_works=no;;
- *) gl_cv_func_dup2_works=yes;;
+ gl_cv_func_dup2_works="guessing no" ;;
+ *) gl_cv_func_dup2_works="guessing yes" ;;
esac
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
@@ -19386,13 +20501,16 @@ fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_dup2_works" >&5
$as_echo "$gl_cv_func_dup2_works" >&6; }
- if test "$gl_cv_func_dup2_works" = no; then
- REPLACE_DUP2=1
- fi
+ case "$gl_cv_func_dup2_works" in
+ *yes) ;;
+ *)
+ REPLACE_DUP2=1
+ ;;
+ esac
fi
-if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
+ if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
@@ -19404,7 +20522,7 @@ if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
gl_LIBOBJS="$gl_LIBOBJS dup2.$ac_objext"
-fi
+ fi
@@ -19422,12 +20540,362 @@ fi
+ GNULIB_ENVIRON=1
+
+
+
+
+
+
+
+
+ LIB_EXECINFO=''
+ EXECINFO_H='execinfo.h'
+
+ if test $ac_cv_header_execinfo_h = yes; then
+ gl_saved_libs=$LIBS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing backtrace_symbols_fd" >&5
+$as_echo_n "checking for library containing backtrace_symbols_fd... " >&6; }
+if test "${ac_cv_search_backtrace_symbols_fd+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char backtrace_symbols_fd ();
+int
+main ()
+{
+return backtrace_symbols_fd ();
+ ;
+ return 0;
+}
+_ACEOF
+for ac_lib in '' execinfo; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ fi
+ if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_search_backtrace_symbols_fd=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if test "${ac_cv_search_backtrace_symbols_fd+set}" = set; then :
+ break
+fi
+done
+if test "${ac_cv_search_backtrace_symbols_fd+set}" = set; then :
+
+else
+ ac_cv_search_backtrace_symbols_fd=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_backtrace_symbols_fd" >&5
+$as_echo "$ac_cv_search_backtrace_symbols_fd" >&6; }
+ac_res=$ac_cv_search_backtrace_symbols_fd
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+ test "$ac_cv_search_backtrace_symbols_fd" = "none required" ||
+ LIB_EXECINFO=$ac_cv_search_backtrace_symbols_fd
+fi
+
+ LIBS=$gl_saved_libs
+ test "$ac_cv_search_backtrace_symbols_fd" = no || EXECINFO_H=''
+ fi
+
+ if test -n "$EXECINFO_H"; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS execinfo.$ac_objext"
+
+ fi
+
+
+
+ if test -n "$EXECINFO_H"; then
+ GL_GENERATE_EXECINFO_H_TRUE=
+ GL_GENERATE_EXECINFO_H_FALSE='#'
+else
+ GL_GENERATE_EXECINFO_H_TRUE='#'
+ GL_GENERATE_EXECINFO_H_FALSE=
+fi
+
+
+
+
+
+
+
+
+
+ if test $ac_cv_func_faccessat = no; then
+ HAVE_FACCESSAT=0
+ fi
+
+ if test $HAVE_FACCESSAT = 0; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS faccessat.$ac_objext"
+
+
+ for ac_func in access
+do :
+ ac_fn_c_check_func "$LINENO" "access" "ac_cv_func_access"
+if test "x$ac_cv_func_access" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_ACCESS 1
+_ACEOF
+
+fi
+done
+
+
+ fi
+
+
+cat >>confdefs.h <<_ACEOF
+#define GNULIB_FACCESSAT 1
+_ACEOF
+
+
+
+
+
+
+
+ GNULIB_FACCESSAT=1
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ if test $gl_cv_have_include_next = yes; then
+ gl_cv_next_fcntl_h='<'fcntl.h'>'
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <fcntl.h>" >&5
+$as_echo_n "checking absolute name of <fcntl.h>... " >&6; }
+if test "${gl_cv_next_fcntl_h+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <fcntl.h>
+
+_ACEOF
+ case "$host_os" in
+ aix*) gl_absname_cpp="$ac_cpp -C" ;;
+ *) gl_absname_cpp="$ac_cpp" ;;
+ esac
+
+ case "$host_os" in
+ mingw*)
+ gl_dirsep_regex='[/\\]'
+ ;;
+ *)
+ gl_dirsep_regex='\/'
+ ;;
+ esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
+
+ gl_header_literal_regex=`echo 'fcntl.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
+ s|^/[^/]|//&|
+ p
+ q
+ }'
+ gl_cv_next_fcntl_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 |
+ sed -n "$gl_absolute_header_sed"`'"'
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_fcntl_h" >&5
+$as_echo "$gl_cv_next_fcntl_h" >&6; }
+ fi
+ NEXT_FCNTL_H=$gl_cv_next_fcntl_h
+
+ if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next'
+ gl_next_as_first_directive='<'fcntl.h'>'
+ else
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
+ gl_next_as_first_directive=$gl_cv_next_fcntl_h
+ fi
+ NEXT_AS_FIRST_DIRECTIVE_FCNTL_H=$gl_next_as_first_directive
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ fp_headers='
+# include <stdio.h>
+# if HAVE_STDIO_EXT_H
+# include <stdio_ext.h>
+# endif
+'
+ ac_fn_c_check_decl "$LINENO" "__fpending" "ac_cv_have_decl___fpending" "$fp_headers
+"
+if test "x$ac_cv_have_decl___fpending" = x""yes; then :
+ ac_have_decl=1
+else
+ ac_have_decl=0
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_DECL___FPENDING $ac_have_decl
+_ACEOF
+
+
+ if test $ac_cv_func___fpending = no; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS fpending.$ac_objext"
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to determine the number of pending output bytes on a stream" >&5
+$as_echo_n "checking how to determine the number of pending output bytes on a stream... " >&6; }
+if test "${ac_cv_sys_pending_output_n_bytes+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ for ac_expr in \
+ \
+ '# glibc2' \
+ 'fp->_IO_write_ptr - fp->_IO_write_base' \
+ \
+ '# traditional Unix' \
+ 'fp->_ptr - fp->_base' \
+ \
+ '# BSD' \
+ 'fp->_p - fp->_bf._base' \
+ \
+ '# SCO, Unixware' \
+ '(fp->__ptr ? fp->__ptr - fp->__base : 0)' \
+ \
+ '# QNX' \
+ '(fp->_Mode & 0x2000 /*_MWRITE*/ ? fp->_Next - fp->_Buf : 0)' \
+ \
+ '# old glibc?' \
+ 'fp->__bufp - fp->__buffer' \
+ \
+ '# old glibc iostream?' \
+ 'fp->_pptr - fp->_pbase' \
+ \
+ '# emx+gcc' \
+ 'fp->_ptr - fp->_buffer' \
+ \
+ '# Minix' \
+ 'fp->_ptr - fp->_buf' \
+ \
+ '# Plan9' \
+ 'fp->wp - fp->buf' \
+ \
+ '# VMS' \
+ '(*fp)->_ptr - (*fp)->_base' \
+ \
+ '# e.g., DGUX R4.11; the info is not available' \
+ 1 \
+ ; do
+
+ # Skip each embedded comment.
+ case "$ac_expr" in '#'*) continue;; esac
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <stdio.h>
+int
+main ()
+{
+FILE *fp = stdin; (void) ($ac_expr);
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ fp_done=yes
+
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ test "$fp_done" = yes && break
+ done
+
+ ac_cv_sys_pending_output_n_bytes=$ac_expr
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_pending_output_n_bytes" >&5
+$as_echo "$ac_cv_sys_pending_output_n_bytes" >&6; }
+
+cat >>confdefs.h <<_ACEOF
+#define PENDING_OUTPUT_N_BYTES $ac_cv_sys_pending_output_n_bytes
+_ACEOF
+
+
+ fi
+
+
# Persuade glibc <stdlib.h> to declare getloadavg().
gl_save_LIBS=$LIBS
-# getloadvg is present in libc on glibc >= 2.2, MacOS X, FreeBSD >= 2.0,
+# getloadvg is present in libc on glibc >= 2.2, Mac OS X, FreeBSD >= 2.0,
# NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7.
HAVE_GETLOADAVG=1
ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg"
@@ -19815,7 +21283,7 @@ else
fi
-if test $HAVE_GETLOADAVG = 0; then
+ if test $HAVE_GETLOADAVG = 0; then
@@ -19829,6 +21297,8 @@ if test $HAVE_GETLOADAVG = 0; then
# Figure out what our getloadavg.c needs.
+
+
# On HPUX9, an unprivileged user can get load averages this way.
if test $gl_func_getloadavg_done = no; then
for ac_func in pstat_getdynamic
@@ -19941,7 +21411,7 @@ fi
done
-fi
+ fi
@@ -19958,7 +21428,7 @@ fi
-if test $REPLACE_GETOPT = 1; then
+ if test $REPLACE_GETOPT = 1; then
@@ -19982,21 +21452,19 @@ if test $REPLACE_GETOPT = 1; then
-fi
+ GNULIB_GL_UNISTD_H_GETOPT=1
+ fi
- REPLACE_GETOPT=0
- if test -n "$gl_replace_getopt"; then :
-
+ REPLACE_GETOPT=0
+ if test -n "$gl_replace_getopt"; then
REPLACE_GETOPT=1
-
-fi
-
+ fi
if test $REPLACE_GETOPT = 1; then
@@ -20006,10 +21474,9 @@ $as_echo "#define __GETOPT_PREFIX rpl_" >>confdefs.h
- GNULIB_UNISTD_H_GETOPT=1
fi
-if test $REPLACE_GETOPT = 1; then
+ if test $REPLACE_GETOPT = 1; then
@@ -20033,22 +21500,232 @@ if test $REPLACE_GETOPT = 1; then
+ GNULIB_GL_UNISTD_H_GETOPT=1
+ fi
+
+
+
+
+
+
+
+
+
+
+
+
+ gl_gettimeofday_timezone=void
+ if test $ac_cv_func_gettimeofday != yes; then
+ HAVE_GETTIMEOFDAY=0
+ else
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gettimeofday clobbers localtime buffer" >&5
+$as_echo_n "checking whether gettimeofday clobbers localtime buffer... " >&6; }
+if test "${gl_cv_func_gettimeofday_clobber+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ # When cross-compiling:
+ case "$host_os" in
+ # Guess all is fine on glibc systems.
+ *-gnu*) gl_cv_func_gettimeofday_clobber="guessing no" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_gettimeofday_clobber="guessing yes" ;;
+ esac
+
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <string.h>
+ #include <sys/time.h>
+ #include <time.h>
+ #include <stdlib.h>
+
+int
+main ()
+{
+
+ time_t t = 0;
+ struct tm *lt;
+ struct tm saved_lt;
+ struct timeval tv;
+ lt = localtime (&t);
+ saved_lt = *lt;
+ gettimeofday (&tv, NULL);
+ return memcmp (lt, &saved_lt, sizeof (struct tm)) != 0;
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_gettimeofday_clobber=no
+else
+ gl_cv_func_gettimeofday_clobber=yes
fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_gettimeofday_clobber" >&5
+$as_echo "$gl_cv_func_gettimeofday_clobber" >&6; }
+ case "$gl_cv_func_gettimeofday_clobber" in
+ *yes)
+ REPLACE_GETTIMEOFDAY=1
+$as_echo "#define gmtime rpl_gmtime" >>confdefs.h
- if test $ac_cv_func_lstat = yes; then
+$as_echo "#define localtime rpl_localtime" >>confdefs.h
+
+
+
+$as_echo "#define GETTIMEOFDAY_CLOBBERS_LOCALTIME 1" >>confdefs.h
+
+ ;;
+ esac
- if test $gl_cv_func_lstat_dereferences_slashed_symlink = no; then
- REPLACE_LSTAT=1
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gettimeofday with POSIX signature" >&5
+$as_echo_n "checking for gettimeofday with POSIX signature... " >&6; }
+if test "${gl_cv_func_gettimeofday_posix_signature+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/time.h>
+ struct timeval c;
+ int gettimeofday (struct timeval *restrict, void *restrict);
+
+int
+main ()
+{
+/* glibc uses struct timezone * rather than the POSIX void *
+ if _GNU_SOURCE is defined. However, since the only portable
+ use of gettimeofday uses NULL as the second parameter, and
+ since the glibc definition is actually more typesafe, it is
+ not worth wrapping this to get a compliant signature. */
+ int (*f) (struct timeval *restrict, void *restrict)
+ = gettimeofday;
+ int x = f (&c, 0);
+ return !(x | c.tv_sec | c.tv_usec);
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_func_gettimeofday_posix_signature=yes
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/time.h>
+int gettimeofday (struct timeval *restrict, struct timezone *restrict);
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_func_gettimeofday_posix_signature=almost
+else
+ gl_cv_func_gettimeofday_posix_signature=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_gettimeofday_posix_signature" >&5
+$as_echo "$gl_cv_func_gettimeofday_posix_signature" >&6; }
+ if test $gl_cv_func_gettimeofday_posix_signature = almost; then
+ gl_gettimeofday_timezone='struct timezone'
+ elif test $gl_cv_func_gettimeofday_posix_signature != yes; then
+ REPLACE_GETTIMEOFDAY=1
fi
+ if test $REPLACE_STRUCT_TIMEVAL = 1; then
+ REPLACE_GETTIMEOFDAY=1
+ fi
+
+ fi
+
+cat >>confdefs.h <<_ACEOF
+#define GETTIMEOFDAY_TIMEZONE $gl_gettimeofday_timezone
+_ACEOF
+
+
+ if test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS gettimeofday.$ac_objext"
+
+
+ for ac_header in sys/timeb.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/timeb.h" "ac_cv_header_sys_timeb_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_timeb_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_SYS_TIMEB_H 1
+_ACEOF
+
+fi
+
+done
+
+ for ac_func in _ftime
+do :
+ ac_fn_c_check_func "$LINENO" "_ftime" "ac_cv_func__ftime"
+if test "x$ac_cv_func__ftime" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE__FTIME 1
+_ACEOF
+
+fi
+done
+
+
+ fi
+
+
+
+
+
+ GNULIB_GETTIMEOFDAY=1
+
+
+
+
+
+
+
+
+
+
+ if test $ac_cv_func_lstat = yes; then
+
+ case "$gl_cv_func_lstat_dereferences_slashed_symlink" in
+ *no)
+ REPLACE_LSTAT=1
+ ;;
+ esac
else
HAVE_LSTAT=0
fi
-if test $REPLACE_LSTAT = 1; then
+ if test $REPLACE_LSTAT = 1; then
@@ -20063,7 +21740,7 @@ if test $REPLACE_LSTAT = 1; then
:
-fi
+ fi
@@ -20082,7 +21759,7 @@ fi
if test $APPLE_UNIVERSAL_BUILD = 1; then
- # A universal build on Apple MacOS X platforms.
+ # A universal build on Apple Mac OS X platforms.
# The test result would be 'yes' in 32-bit mode and 'no' in 64-bit mode.
# But we need a configuration result that is valid in both modes.
gl_cv_func_working_mktime=no
@@ -20264,20 +21941,23 @@ main ()
if (tz_strings[i])
putenv (tz_strings[i]);
- for (t = 0; t <= time_t_max - delta; t += delta)
+ for (t = 0; t <= time_t_max - delta && (result & 1) == 0; t += delta)
if (! mktime_test (t))
result |= 1;
- if (! (mktime_test ((time_t) 1)
- && mktime_test ((time_t) (60 * 60))
- && mktime_test ((time_t) (60 * 60 * 24))))
+ if ((result & 2) == 0
+ && ! (mktime_test ((time_t) 1)
+ && mktime_test ((time_t) (60 * 60))
+ && mktime_test ((time_t) (60 * 60 * 24))))
result |= 2;
- for (j = 1; ; j <<= 1)
- if (! bigtime_test (j))
- result |= 4;
- else if (INT_MAX / 2 < j)
- break;
- if (! bigtime_test (INT_MAX))
+ for (j = 1; (result & 4) == 0; j <<= 1)
+ {
+ if (! bigtime_test (j))
+ result |= 4;
+ if (INT_MAX / 2 < j)
+ break;
+ }
+ if ((result & 8) == 0 && ! bigtime_test (INT_MAX))
result |= 8;
}
if (! irix_6_4_bug ())
@@ -20309,7 +21989,7 @@ $as_echo "$gl_cv_func_working_mktime" >&6; }
REPLACE_MKTIME=0
fi
-if test $REPLACE_MKTIME = 1; then
+ if test $REPLACE_MKTIME = 1; then
@@ -20320,16 +22000,144 @@ if test $REPLACE_MKTIME = 1; then
gl_LIBOBJS="$gl_LIBOBJS mktime.$ac_objext"
+ :
+ fi
+
+
+
+
+
+ GNULIB_MKTIME=1
+
+
+
+
+
+
+
+
+ if test $ac_cv_func_pselect = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether signature of pselect conforms to POSIX" >&5
+$as_echo_n "checking whether signature of pselect conforms to POSIX... " >&6; }
+if test "${gl_cv_sig_pselect+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+
+int
+main ()
+{
+int (*p) (int, fd_set *, fd_set *, fd_set *restrict,
+ struct timespec const *restrict,
+ sigset_t const *restrict) = pselect;
+ return !p;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ gl_cv_sig_pselect=yes
+else
+ gl_cv_sig_pselect=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sig_pselect" >&5
+$as_echo "$gl_cv_sig_pselect" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pselect detects invalid fds" >&5
+$as_echo_n "checking whether pselect detects invalid fds... " >&6; }
+if test "${gl_cv_func_pselect_detects_ebadf+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_pselect_detects_ebadf="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_pselect_detects_ebadf="guessing no" ;;
+ esac
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/types.h>
+#include <sys/time.h>
+#if HAVE_SYS_SELECT_H
+# include <sys/select.h>
+#endif
+#include <unistd.h>
+#include <errno.h>
+
+int
+main ()
+{
+
+ fd_set set;
+ dup2(0, 16);
+ FD_ZERO(&set);
+ FD_SET(16, &set);
+ close(16);
+ struct timespec timeout;
+ timeout.tv_sec = 0;
+ timeout.tv_nsec = 5000;
+ return pselect (17, &set, NULL, NULL, &timeout, NULL) != -1 || errno != EBADF;
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_pselect_detects_ebadf=yes
+else
+ gl_cv_func_pselect_detects_ebadf=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_pselect_detects_ebadf" >&5
+$as_echo "$gl_cv_func_pselect_detects_ebadf" >&6; }
+ case $gl_cv_func_pselect_detects_ebadf in
+ *yes) ;;
+ *) REPLACE_PSELECT=1 ;;
+ esac
+ fi
+
+ if test $ac_cv_func_pselect = no || test $gl_cv_sig_pselect = no; then
+ REPLACE_PSELECT=1
+ fi
+
+ if test $HAVE_PSELECT = 0 || test $REPLACE_PSELECT = 1; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS pselect.$ac_objext"
+
+ fi
+
+
+
+
+
+ GNULIB_PSELECT=1
- GNULIB_MKTIME=1
@@ -20341,11 +22149,61 @@ fi
LIB_PTHREAD_SIGMASK=
- if test $ac_cv_func_pthread_sigmask = yes; then
- :
+
+
+ if test "$gl_threads_api" = posix; then
+ if test $ac_cv_func_pthread_sigmask = yes; then
+ :
+ else
+ if test -n "$LIBMULTITHREAD"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_sigmask in $LIBMULTITHREAD" >&5
+$as_echo_n "checking for pthread_sigmask in $LIBMULTITHREAD... " >&6; }
+if test "${gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ gl_save_LIBS="$LIBS"
+ LIBS="$LIBS $LIBMULTITHREAD"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <pthread.h>
+ #include <signal.h>
+
+int
+main ()
+{
+return pthread_sigmask (0, (sigset_t *) 0, (sigset_t *) 0);
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD=yes
+else
+ gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ LIBS="$gl_save_LIBS"
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD" >&5
+$as_echo "$gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD" >&6; }
+ if test $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD = yes; then
+ LIB_PTHREAD_SIGMASK="$LIBMULTITHREAD"
+ else
+ HAVE_PTHREAD_SIGMASK=0
+ fi
+ else
+ HAVE_PTHREAD_SIGMASK=0
+ fi
+ fi
else
- HAVE_PTHREAD_SIGMASK=0
- REPLACE_PTHREAD_SIGMASK=1
+ if test $ac_cv_func_pthread_sigmask = yes; then
+ REPLACE_PTHREAD_SIGMASK=1
+ else
+ HAVE_PTHREAD_SIGMASK=0
+ fi
fi
@@ -20540,7 +22398,7 @@ $as_echo "#define PTHREAD_SIGMASK_UNBLOCK_BUG 1" >>confdefs.h
esac
fi
-if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
+ if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
@@ -20558,7 +22416,7 @@ $as_echo "#define HAVE_PTHREAD_SIGMASK 1" >>confdefs.h
fi
-fi
+ fi
@@ -20612,7 +22470,13 @@ else
ln -s conftest.no-such conftest.link
ln -s conftest.link conftest.lnk2
if test "$cross_compiling" = yes; then :
- gl_cv_func_readlink_works="guessing no"
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_readlink_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_readlink_works="guessing no" ;;
+ esac
+
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
@@ -20640,17 +22504,22 @@ fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_readlink_works" >&5
$as_echo "$gl_cv_func_readlink_works" >&6; }
- if test "$gl_cv_func_readlink_works" != yes; then
+ case "$gl_cv_func_readlink_works" in
+ *yes)
+ if test "$gl_cv_decl_readlink_works" != yes; then
+ REPLACE_READLINK=1
+ fi
+ ;;
+ *)
$as_echo "#define READLINK_TRAILING_SLASH_BUG 1" >>confdefs.h
- REPLACE_READLINK=1
- elif test "$gl_cv_decl_readlink_works" != yes; then
- REPLACE_READLINK=1
- fi
+ REPLACE_READLINK=1
+ ;;
+ esac
fi
-if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
+ if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
@@ -20664,7 +22533,7 @@ if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
:
-fi
+ fi
@@ -20711,12 +22580,15 @@ _ACEOF
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'signal.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'signal.h\)".*|\1|
+ gl_header_literal_regex=`echo 'signal.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
@@ -20775,7 +22647,7 @@ fi
- ac_fn_c_check_type "$LINENO" "socklen_t" "ac_cv_type_socklen_t" "
+ ac_fn_c_check_type "$LINENO" "socklen_t" "ac_cv_type_socklen_t" "
/* <sys/types.h> is not needed according to POSIX, but the
<sys/socket.h> in i386-unknown-freebsd4.10 and
powerpc-apple-darwin5.5 required it. */
@@ -20872,6 +22744,210 @@ $as_echo "#define ssize_t int" >>confdefs.h
fi
+
+
+
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_atim.tv_nsec" "ac_cv_member_struct_stat_st_atim_tv_nsec" "#include <sys/types.h>
+ #include <sys/stat.h>
+"
+if test "x$ac_cv_member_struct_stat_st_atim_tv_nsec" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC 1
+_ACEOF
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether struct stat.st_atim is of type struct timespec" >&5
+$as_echo_n "checking whether struct stat.st_atim is of type struct timespec... " >&6; }
+if test "${ac_cv_typeof_struct_stat_st_atim_is_struct_timespec+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+ #include <sys/types.h>
+ #include <sys/stat.h>
+ #if HAVE_SYS_TIME_H
+ # include <sys/time.h>
+ #endif
+ #include <time.h>
+ struct timespec ts;
+ struct stat st;
+
+int
+main ()
+{
+
+ st.st_atim = ts;
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_typeof_struct_stat_st_atim_is_struct_timespec=yes
+else
+ ac_cv_typeof_struct_stat_st_atim_is_struct_timespec=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_typeof_struct_stat_st_atim_is_struct_timespec" >&5
+$as_echo "$ac_cv_typeof_struct_stat_st_atim_is_struct_timespec" >&6; }
+ if test $ac_cv_typeof_struct_stat_st_atim_is_struct_timespec = yes; then
+
+$as_echo "#define TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC 1" >>confdefs.h
+
+ fi
+else
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_atimespec.tv_nsec" "ac_cv_member_struct_stat_st_atimespec_tv_nsec" "#include <sys/types.h>
+ #include <sys/stat.h>
+"
+if test "x$ac_cv_member_struct_stat_st_atimespec_tv_nsec" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC 1
+_ACEOF
+
+
+else
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_atimensec" "ac_cv_member_struct_stat_st_atimensec" "#include <sys/types.h>
+ #include <sys/stat.h>
+"
+if test "x$ac_cv_member_struct_stat_st_atimensec" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_ATIMENSEC 1
+_ACEOF
+
+
+else
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_atim.st__tim.tv_nsec" "ac_cv_member_struct_stat_st_atim_st__tim_tv_nsec" "#include <sys/types.h>
+ #include <sys/stat.h>
+"
+if test "x$ac_cv_member_struct_stat_st_atim_st__tim_tv_nsec" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC 1
+_ACEOF
+
+
+fi
+
+fi
+
+fi
+
+fi
+
+
+
+
+
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_birthtimespec.tv_nsec" "ac_cv_member_struct_stat_st_birthtimespec_tv_nsec" "#include <sys/types.h>
+ #include <sys/stat.h>
+"
+if test "x$ac_cv_member_struct_stat_st_birthtimespec_tv_nsec" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC 1
+_ACEOF
+
+
+else
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_birthtimensec" "ac_cv_member_struct_stat_st_birthtimensec" "#include <sys/types.h>
+ #include <sys/stat.h>
+"
+if test "x$ac_cv_member_struct_stat_st_birthtimensec" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC 1
+_ACEOF
+
+
+else
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_birthtim.tv_nsec" "ac_cv_member_struct_stat_st_birthtim_tv_nsec" "#include <sys/types.h>
+ #include <sys/stat.h>
+"
+if test "x$ac_cv_member_struct_stat_st_birthtim_tv_nsec" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC 1
+_ACEOF
+
+
+fi
+
+fi
+
+fi
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working stdalign.h" >&5
+$as_echo_n "checking for working stdalign.h... " >&6; }
+if test "${gl_cv_header_working_stdalign_h+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <stdalign.h>
+ #include <stddef.h>
+
+ /* Test that alignof yields a result consistent with offsetof.
+ This catches GCC bug 52023
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. */
+ #ifdef __cplusplus
+ template <class t> struct alignof_helper { char a; t b; };
+ # define ao(type) offsetof (alignof_helper<type>, b)
+ #else
+ # define ao(type) offsetof (struct { char a; type b; }, b)
+ #endif
+ char test_double[ao (double) % _Alignof (double) == 0 ? 1 : -1];
+ char test_long[ao (long int) % _Alignof (long int) == 0 ? 1 : -1];
+ char test_alignof[alignof (double) == _Alignof (double) ? 1 : -1];
+
+ /* Test _Alignas only on platforms where gnulib can help. */
+ #if \
+ (__GNUC__ || __IBMC__ || __IBMCPP__ \
+ || 0x5110 <= __SUNPRO_C || 1300 <= _MSC_VER)
+ int alignas (8) alignas_int = 1;
+ char test_alignas[_Alignof (alignas_int) == 8 ? 1 : -1];
+ #endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_header_working_stdalign_h=yes
+else
+ gl_cv_header_working_stdalign_h=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_header_working_stdalign_h" >&5
+$as_echo "$gl_cv_header_working_stdalign_h" >&6; }
+
+ if test $gl_cv_header_working_stdalign_h = yes; then
+ STDALIGN_H=''
+ else
+ STDALIGN_H='stdalign.h'
+ fi
+
+
+ if test -n "$STDALIGN_H"; then
+ GL_GENERATE_STDALIGN_H_TRUE=
+ GL_GENERATE_STDALIGN_H_FALSE='#'
+else
+ GL_GENERATE_STDALIGN_H_TRUE='#'
+ GL_GENERATE_STDALIGN_H_FALSE=
+fi
+
+
+
STDARG_H=''
NEXT_STDARG_H='<stdarg.h>'
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for va_copy" >&5
@@ -20955,12 +23031,15 @@ _ACEOF
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'stdarg.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'stdarg.h\)".*|\1|
+ gl_header_literal_regex=`echo 'stdarg.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
@@ -21155,12 +23234,15 @@ _ACEOF
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'stddef.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'stddef.h\)".*|\1|
+ gl_header_literal_regex=`echo 'stddef.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
@@ -21225,12 +23307,15 @@ _ACEOF
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'stdio.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'stdio.h\)".*|\1|
+ gl_header_literal_regex=`echo 'stdio.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
@@ -21259,12 +23344,25 @@ $as_echo "$gl_cv_next_stdio_h" >&6; }
GNULIB_FSCANF=1
+
+
+cat >>confdefs.h <<_ACEOF
+#define GNULIB_FSCANF 1
+_ACEOF
+
+
GNULIB_SCANF=1
+
+
+cat >>confdefs.h <<_ACEOF
+#define GNULIB_SCANF 1
+_ACEOF
+
+
GNULIB_FGETC=1
GNULIB_GETC=1
GNULIB_GETCHAR=1
GNULIB_FGETS=1
- GNULIB_GETS=1
GNULIB_FREAD=1
@@ -21317,12 +23415,15 @@ _ACEOF
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'stdlib.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'stdlib.h\)".*|\1|
+ gl_header_literal_regex=`echo 'stdlib.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
@@ -21375,7 +23476,83 @@ $as_echo "#define my_strftime nstrftime" >>confdefs.h
HAVE_DECL_STRTOIMAX=0
fi
-if test $ac_cv_func_strtoimax = no; then
+ if test $ac_cv_func_strtoimax = yes; then
+ HAVE_STRTOIMAX=1
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether strtoimax works" >&5
+$as_echo_n "checking whether strtoimax works... " >&6; }
+if test "${gl_cv_func_strtoimax+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ case "$host_os" in
+ # Guess no on AIX 5.
+ aix5*) gl_cv_func_strtoimax="guessing no" ;;
+ # Guess yes otherwise.
+ *) gl_cv_func_strtoimax="guessing yes" ;;
+ esac
+
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#include <errno.h>
+#include <string.h>
+#include <inttypes.h>
+int main ()
+{
+ if (sizeof (intmax_t) > sizeof (int))
+ {
+ const char *s = "4294967295";
+ char *p;
+ intmax_t res;
+ errno = 0;
+ res = strtoimax (s, &p, 10);
+ if (p != s + strlen (s))
+ return 1;
+ if (errno != 0)
+ return 2;
+ if (res != (intmax_t) 65535 * (intmax_t) 65537)
+ return 3;
+ }
+ else
+ {
+ const char *s = "2147483647";
+ char *p;
+ intmax_t res;
+ errno = 0;
+ res = strtoimax (s, &p, 10);
+ if (p != s + strlen (s))
+ return 1;
+ if (errno != 0)
+ return 2;
+ if (res != 2147483647)
+ return 3;
+ }
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_strtoimax=yes
+else
+ gl_cv_func_strtoimax=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_strtoimax" >&5
+$as_echo "$gl_cv_func_strtoimax" >&6; }
+ case "$gl_cv_func_strtoimax" in
+ *no) REPLACE_STRTOIMAX=1 ;;
+ esac
+ else
+ HAVE_STRTOIMAX=0
+ fi
+
+ if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
@@ -21400,7 +23577,7 @@ _ACEOF
-fi
+ fi
@@ -21420,7 +23597,7 @@ fi
HAVE_DECL_STRTOUMAX=0
fi
-if test $ac_cv_func_strtoumax = no; then
+ if test $ac_cv_func_strtoumax = no; then
@@ -21445,7 +23622,7 @@ _ACEOF
-fi
+ fi
@@ -21468,7 +23645,13 @@ if test "${gl_cv_func_symlink_works+set}" = set; then :
$as_echo_n "(cached) " >&6
else
if test "$cross_compiling" = yes; then :
- gl_cv_func_symlink_works="guessing no"
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_symlink_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_symlink_works="guessing no" ;;
+ esac
+
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
@@ -21503,12 +23686,15 @@ fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_symlink_works" >&5
$as_echo "$gl_cv_func_symlink_works" >&6; }
- if test "$gl_cv_func_symlink_works" != yes; then
- REPLACE_SYMLINK=1
- fi
+ case "$gl_cv_func_symlink_works" in
+ *yes) ;;
+ *)
+ REPLACE_SYMLINK=1
+ ;;
+ esac
fi
-if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
+ if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
@@ -21519,7 +23705,7 @@ if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
gl_LIBOBJS="$gl_LIBOBJS symlink.$ac_objext"
-fi
+ fi
@@ -21534,6 +23720,201 @@ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether <sys/select.h> is self-contained" >&5
+$as_echo_n "checking whether <sys/select.h> is self-contained... " >&6; }
+if test "${gl_cv_header_sys_select_h_selfcontained+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+int
+main ()
+{
+struct timeval b;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_header_sys_select_h_selfcontained=yes
+else
+ gl_cv_header_sys_select_h_selfcontained=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ if test $gl_cv_header_sys_select_h_selfcontained = yes; then
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+int
+main ()
+{
+int memset; int bzero;
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+int
+main ()
+{
+
+ #undef memset
+ #define memset nonexistent_memset
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void *memset (void *, int, unsigned long);
+ #undef bzero
+ #define bzero nonexistent_bzero
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void bzero (void *, unsigned long);
+ fd_set fds;
+ FD_ZERO (&fds);
+
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+
+else
+ gl_cv_header_sys_select_h_selfcontained=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_header_sys_select_h_selfcontained" >&5
+$as_echo "$gl_cv_header_sys_select_h_selfcontained" >&6; }
+
+
+
+
+
+
+
+
+
+ if test $gl_cv_have_include_next = yes; then
+ gl_cv_next_sys_select_h='<'sys/select.h'>'
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <sys/select.h>" >&5
+$as_echo_n "checking absolute name of <sys/select.h>... " >&6; }
+if test "${gl_cv_next_sys_select_h+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ if test $ac_cv_header_sys_select_h = yes; then
+
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+
+_ACEOF
+ case "$host_os" in
+ aix*) gl_absname_cpp="$ac_cpp -C" ;;
+ *) gl_absname_cpp="$ac_cpp" ;;
+ esac
+
+ case "$host_os" in
+ mingw*)
+ gl_dirsep_regex='[/\\]'
+ ;;
+ *)
+ gl_dirsep_regex='\/'
+ ;;
+ esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
+
+ gl_header_literal_regex=`echo 'sys/select.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
+ s|^/[^/]|//&|
+ p
+ q
+ }'
+ gl_cv_next_sys_select_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 |
+ sed -n "$gl_absolute_header_sed"`'"'
+ else
+ gl_cv_next_sys_select_h='<'sys/select.h'>'
+ fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_sys_select_h" >&5
+$as_echo "$gl_cv_next_sys_select_h" >&6; }
+ fi
+ NEXT_SYS_SELECT_H=$gl_cv_next_sys_select_h
+
+ if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next'
+ gl_next_as_first_directive='<'sys/select.h'>'
+ else
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
+ gl_next_as_first_directive=$gl_cv_next_sys_select_h
+ fi
+ NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H=$gl_next_as_first_directive
+
+
+
+
+ if test $ac_cv_header_sys_select_h = yes; then
+ HAVE_SYS_SELECT_H=1
+ else
+ HAVE_SYS_SELECT_H=0
+ fi
+
+
+
+
+
+ if test $ac_cv_header_sys_socket_h != yes; then
+ for ac_header in winsock2.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "winsock2.h" "ac_cv_header_winsock2_h" "$ac_includes_default"
+if test "x$ac_cv_header_winsock2_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_WINSOCK2_H 1
+_ACEOF
+
+fi
+
+done
+
+ fi
+ if test "$ac_cv_header_winsock2_h" = yes; then
+ HAVE_WINSOCK2_H=1
+ UNISTD_H_HAVE_WINSOCK2_H=1
+ SYS_IOCTL_H_HAVE_WINSOCK2_H=1
+ else
+ HAVE_WINSOCK2_H=0
+ fi
+
+
+
+
+
+
+
+
+
@@ -21574,12 +23955,15 @@ _ACEOF
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'sys/stat.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'sys/stat.h\)".*|\1|
+ gl_header_literal_regex=`echo 'sys/stat.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
@@ -21612,6 +23996,16 @@ $as_echo "$gl_cv_next_sys_stat_h" >&6; }
+
+
+
+
+ if test $WINDOWS_64_BIT_ST_SIZE = 1; then
+
+$as_echo "#define _GL_WINDOWS_64_BIT_ST_SIZE 1" >>confdefs.h
+
+ fi
+
ac_fn_c_check_type "$LINENO" "nlink_t" "ac_cv_type_nlink_t" "#include <sys/types.h>
#include <sys/stat.h>
"
@@ -21637,6 +24031,21 @@ fi
+
+
+
+ ac_fn_c_check_decl "$LINENO" "localtime_r" "ac_cv_have_decl_localtime_r" "#include <time.h>
+"
+if test "x$ac_cv_have_decl_localtime_r" = x""yes; then :
+ ac_have_decl=1
+else
+ ac_have_decl=0
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_DECL_LOCALTIME_R $ac_have_decl
+_ACEOF
+
if test $ac_cv_have_decl_localtime_r = no; then
HAVE_DECL_LOCALTIME_R=0
fi
@@ -21687,7 +24096,7 @@ $as_echo "$gl_cv_time_r_posix" >&6; }
HAVE_LOCALTIME_R=0
fi
-if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
+ if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
@@ -21701,7 +24110,7 @@ if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
:
-fi
+ fi
@@ -21718,6 +24127,102 @@ fi
+ LIB_TIMER_TIME=
+
+ gl_saved_libs=$LIBS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing timer_settime" >&5
+$as_echo_n "checking for library containing timer_settime... " >&6; }
+if test "${ac_cv_search_timer_settime+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char timer_settime ();
+int
+main ()
+{
+return timer_settime ();
+ ;
+ return 0;
+}
+_ACEOF
+for ac_lib in '' rt posix4; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ fi
+ if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_search_timer_settime=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if test "${ac_cv_search_timer_settime+set}" = set; then :
+ break
+fi
+done
+if test "${ac_cv_search_timer_settime+set}" = set; then :
+
+else
+ ac_cv_search_timer_settime=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_timer_settime" >&5
+$as_echo "$ac_cv_search_timer_settime" >&6; }
+ac_res=$ac_cv_search_timer_settime
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+ test "$ac_cv_search_timer_settime" = "none required" ||
+ LIB_TIMER_TIME=$ac_cv_search_timer_settime
+fi
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#include <features.h>
+#ifdef __GNU_LIBRARY__
+ #if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 2) || (__GLIBC__ > 2)) \
+ && !defined __UCLIBC__
+ Thread emulation available
+ #endif
+#endif
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "Thread" >/dev/null 2>&1; then :
+ LIB_TIMER_TIME="$LIB_TIMER_TIME $LIBMULTITHREAD"
+fi
+rm -f conftest*
+
+ for ac_func in timer_settime
+do :
+ ac_fn_c_check_func "$LINENO" "timer_settime" "ac_cv_func_timer_settime"
+if test "x$ac_cv_func_timer_settime" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_TIMER_SETTIME 1
+_ACEOF
+
+fi
+done
+
+ LIBS=$gl_saved_libs
+
+ :
+
+
+
+
@@ -21754,12 +24259,15 @@ _ACEOF
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'unistd.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'unistd.h\)".*|\1|
+ gl_header_literal_regex=`echo 'unistd.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
@@ -21800,45 +24308,522 @@ $as_echo "$gl_cv_next_unistd_h" >&6; }
+
+
+
+
+
+
+
+
+ if test $ac_cv_func_futimens = no && test $ac_cv_func_futimesat = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether futimesat handles NULL file" >&5
+$as_echo_n "checking whether futimesat handles NULL file... " >&6; }
+if test "${gl_cv_func_futimesat_works+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ touch conftest.file
+ if test "$cross_compiling" = yes; then :
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_futimesat_works="guessing no" ;;
+ esac
+
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#include <stddef.h>
+#include <sys/times.h>
+#include <fcntl.h>
+
+int
+main ()
+{
+ int fd = open ("conftest.file", O_RDWR);
+ if (fd < 0) return 1;
+ if (futimesat (fd, NULL, NULL)) return 2;
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_futimesat_works=yes
+else
+ gl_cv_func_futimesat_works=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+ rm -f conftest.file
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_futimesat_works" >&5
+$as_echo "$gl_cv_func_futimesat_works" >&6; }
+ case "$gl_cv_func_futimesat_works" in
+ *yes) ;;
+ *)
+
+$as_echo "#define FUTIMESAT_NULL_BUG 1" >>confdefs.h
+
+ ;;
+ esac
+ fi
+
gl_gnulib_enabled_dosname=false
+ gl_gnulib_enabled_euidaccess=false
+ gl_gnulib_enabled_getgroups=false
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false
- gl_gnulib_enabled_sigprocmask=false
+ gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false
+ gl_gnulib_enabled_pathmax=false
+ gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false
gl_gnulib_enabled_stat=false
gl_gnulib_enabled_strtoll=false
gl_gnulib_enabled_strtoull=false
gl_gnulib_enabled_verify=false
+ gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false
func_gl_gnulib_m4code_dosname ()
{
if ! $gl_gnulib_enabled_dosname; then
gl_gnulib_enabled_dosname=true
fi
}
- func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 ()
+ func_gl_gnulib_m4code_euidaccess ()
{
- if ! $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then
+ if ! $gl_gnulib_enabled_euidaccess; then
- gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true
+
+
+
+ for ac_func in euidaccess
+do :
+ ac_fn_c_check_func "$LINENO" "euidaccess" "ac_cv_func_euidaccess"
+if test "x$ac_cv_func_euidaccess" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_EUIDACCESS 1
+_ACEOF
+
+fi
+done
+
+ if test $ac_cv_func_euidaccess = no; then
+ HAVE_EUIDACCESS=0
+ fi
+
+ if test $HAVE_EUIDACCESS = 0; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS euidaccess.$ac_objext"
+
+
+
+ for ac_header in libgen.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "libgen.h" "ac_cv_header_libgen_h" "$ac_includes_default"
+if test "x$ac_cv_header_libgen_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_LIBGEN_H 1
+_ACEOF
+
+fi
+
+done
+
+
+ ac_fn_c_check_func "$LINENO" "getgroups" "ac_cv_func_getgroups"
+if test "x$ac_cv_func_getgroups" = x""yes; then :
+
+fi
+
+
+ # If we don't yet have getgroups, see if it's in -lbsd.
+ # This is reported to be necessary on an ITOS 3000WS running SEIUX 3.1.
+ ac_save_LIBS=$LIBS
+ if test $ac_cv_func_getgroups = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgroups in -lbsd" >&5
+$as_echo_n "checking for getgroups in -lbsd... " >&6; }
+if test "${ac_cv_lib_bsd_getgroups+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lbsd $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char getgroups ();
+int
+main ()
+{
+return getgroups ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_bsd_getgroups=yes
+else
+ ac_cv_lib_bsd_getgroups=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bsd_getgroups" >&5
+$as_echo "$ac_cv_lib_bsd_getgroups" >&6; }
+if test "x$ac_cv_lib_bsd_getgroups" = x""yes; then :
+ GETGROUPS_LIB=-lbsd
+fi
+
+ fi
+
+ # Run the program to test the functionality of the system-supplied
+ # getgroups function only if there is such a function.
+ if test $ac_cv_func_getgroups = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working getgroups" >&5
+$as_echo_n "checking for working getgroups... " >&6; }
+if test "${ac_cv_func_getgroups_works+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ case "$host_os" in # ((
+ # Guess yes on glibc systems.
+ *-gnu*) ac_cv_func_getgroups_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) ac_cv_func_getgroups_works="guessing no" ;;
+ esac
+
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+/* On Ultrix 4.3, getgroups (0, 0) always fails. */
+ return getgroups (0, 0) == -1;
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ ac_cv_func_getgroups_works=yes
+else
+ ac_cv_func_getgroups_works=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getgroups_works" >&5
+$as_echo "$ac_cv_func_getgroups_works" >&6; }
+ else
+ ac_cv_func_getgroups_works=no
+ fi
+ case "$ac_cv_func_getgroups_works" in
+ *yes)
+
+$as_echo "#define HAVE_GETGROUPS 1" >>confdefs.h
+
+ ;;
+ esac
+ LIBS=$ac_save_LIBS
+
+
+ # Solaris 9 and 10 need -lgen to get the eaccess function.
+ # Save and restore LIBS so -lgen isn't added to it. Otherwise, *all*
+ # programs in the package would end up linked with that potentially-shared
+ # library, inducing unnecessary run-time overhead.
+ LIB_EACCESS=
+
+ gl_saved_libs=$LIBS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing eaccess" >&5
+$as_echo_n "checking for library containing eaccess... " >&6; }
+if test "${ac_cv_search_eaccess+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char eaccess ();
+int
+main ()
+{
+return eaccess ();
+ ;
+ return 0;
+}
+_ACEOF
+for ac_lib in '' gen; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ fi
+ if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_search_eaccess=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if test "${ac_cv_search_eaccess+set}" = set; then :
+ break
+fi
+done
+if test "${ac_cv_search_eaccess+set}" = set; then :
+
+else
+ ac_cv_search_eaccess=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_eaccess" >&5
+$as_echo "$ac_cv_search_eaccess" >&6; }
+ac_res=$ac_cv_search_eaccess
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+ test "$ac_cv_search_eaccess" = "none required" ||
+ LIB_EACCESS=$ac_cv_search_eaccess
+fi
+
+ for ac_func in eaccess
+do :
+ ac_fn_c_check_func "$LINENO" "eaccess" "ac_cv_func_eaccess"
+if test "x$ac_cv_func_eaccess" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_EACCESS 1
+_ACEOF
+
+fi
+done
+
+ LIBS=$gl_saved_libs
+
+ fi
+
+
+
+
+
+ GNULIB_EUIDACCESS=1
+
+
+
+
+
+ gl_gnulib_enabled_euidaccess=true
+ if test $HAVE_EUIDACCESS = 0; then
+ func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1
+ fi
+ func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c
+ if test $HAVE_EUIDACCESS = 0; then
+ func_gl_gnulib_m4code_stat
+ fi
fi
}
- func_gl_gnulib_m4code_sigprocmask ()
+ func_gl_gnulib_m4code_getgroups ()
{
- if ! $gl_gnulib_enabled_sigprocmask; then
+ if ! $gl_gnulib_enabled_getgroups; then
+
- if test $gl_cv_type_sigset_t = yes; then
- ac_fn_c_check_func "$LINENO" "sigprocmask" "ac_cv_func_sigprocmask"
-if test "x$ac_cv_func_sigprocmask" = x""yes; then :
- gl_cv_func_sigprocmask=1
+
+ ac_fn_c_check_func "$LINENO" "getgroups" "ac_cv_func_getgroups"
+if test "x$ac_cv_func_getgroups" = x""yes; then :
+
fi
+
+ # If we don't yet have getgroups, see if it's in -lbsd.
+ # This is reported to be necessary on an ITOS 3000WS running SEIUX 3.1.
+ ac_save_LIBS=$LIBS
+ if test $ac_cv_func_getgroups = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgroups in -lbsd" >&5
+$as_echo_n "checking for getgroups in -lbsd... " >&6; }
+if test "${ac_cv_lib_bsd_getgroups+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lbsd $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char getgroups ();
+int
+main ()
+{
+return getgroups ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_bsd_getgroups=yes
+else
+ ac_cv_lib_bsd_getgroups=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bsd_getgroups" >&5
+$as_echo "$ac_cv_lib_bsd_getgroups" >&6; }
+if test "x$ac_cv_lib_bsd_getgroups" = x""yes; then :
+ GETGROUPS_LIB=-lbsd
+fi
+
+ fi
+
+ # Run the program to test the functionality of the system-supplied
+ # getgroups function only if there is such a function.
+ if test $ac_cv_func_getgroups = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working getgroups" >&5
+$as_echo_n "checking for working getgroups... " >&6; }
+if test "${ac_cv_func_getgroups_works+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ case "$host_os" in # ((
+ # Guess yes on glibc systems.
+ *-gnu*) ac_cv_func_getgroups_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) ac_cv_func_getgroups_works="guessing no" ;;
+ esac
+
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+/* On Ultrix 4.3, getgroups (0, 0) always fails. */
+ return getgroups (0, 0) == -1;
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ ac_cv_func_getgroups_works=yes
+else
+ ac_cv_func_getgroups_works=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getgroups_works" >&5
+$as_echo "$ac_cv_func_getgroups_works" >&6; }
+ else
+ ac_cv_func_getgroups_works=no
fi
- if test -z "$gl_cv_func_sigprocmask"; then
- HAVE_POSIX_SIGNALBLOCKING=0
+ case "$ac_cv_func_getgroups_works" in
+ *yes)
+
+$as_echo "#define HAVE_GETGROUPS 1" >>confdefs.h
+
+ ;;
+ esac
+ LIBS=$ac_save_LIBS
+
+ if test $ac_cv_func_getgroups != yes; then
+ HAVE_GETGROUPS=0
+ else
+ if test "$ac_cv_type_getgroups" != gid_t \
+ || { case "$ac_cv_func_getgroups_works" in
+ *yes) false;;
+ *) true;;
+ esac
+ }; then
+ REPLACE_GETGROUPS=1
+
+$as_echo "#define GETGROUPS_ZERO_BUG 1" >>confdefs.h
+
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getgroups handles negative values" >&5
+$as_echo_n "checking whether getgroups handles negative values... " >&6; }
+if test "${gl_cv_func_getgroups_works+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_getgroups_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_getgroups_works="guessing no" ;;
+ esac
+
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+int size = getgroups (0, 0);
+ gid_t *list = malloc (size * sizeof *list);
+ return getgroups (-1, list) != -1;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_getgroups_works=yes
+else
+ gl_cv_func_getgroups_works=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_getgroups_works" >&5
+$as_echo "$gl_cv_func_getgroups_works" >&6; }
+ case "$gl_cv_func_getgroups_works" in
+ *yes) ;;
+ *) REPLACE_GETGROUPS=1 ;;
+ esac
+ fi
fi
+ test -n "$GETGROUPS_LIB" && LIBS="$GETGROUPS_LIB $LIBS"
-if test $HAVE_POSIX_SIGNALBLOCKING = 0; then
+ if test $HAVE_GETGROUPS = 0 || test $REPLACE_GETGROUPS = 1; then
@@ -21847,24 +24832,97 @@ if test $HAVE_POSIX_SIGNALBLOCKING = 0; then
- gl_LIBOBJS="$gl_LIBOBJS sigprocmask.$ac_objext"
+ gl_LIBOBJS="$gl_LIBOBJS getgroups.$ac_objext"
+
+ fi
+
+
+
+ GNULIB_GETGROUPS=1
+
+
+
+ gl_gnulib_enabled_getgroups=true
+ fi
+ }
+ func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 ()
+ {
+ if ! $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then
+
+
+ gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true
+ fi
+ }
+ func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1 ()
+ {
+ if ! $gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1; then
+
+
+
+
+
+ ac_fn_c_check_func "$LINENO" "group_member" "ac_cv_func_group_member"
+if test "x$ac_cv_func_group_member" = x""yes; then :
+
+else
+
+ HAVE_GROUP_MEMBER=0
+
fi
+ if test $HAVE_GROUP_MEMBER = 0; then
+
+
+
+
+
- GNULIB_SIGPROCMASK=1
+ gl_LIBOBJS="$gl_LIBOBJS group-member.$ac_objext"
+
+
+
+
+ fi
- gl_gnulib_enabled_sigprocmask=true
+ GNULIB_GROUP_MEMBER=1
+
+
+
+
+
+ gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=true
+ if test $HAVE_GROUP_MEMBER = 0; then
+ func_gl_gnulib_m4code_getgroups
+ fi
+ if test $HAVE_GROUP_MEMBER = 0; then
+ func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec
+ fi
+ fi
+ }
+ func_gl_gnulib_m4code_pathmax ()
+ {
+ if ! $gl_gnulib_enabled_pathmax; then
+
+
+
+ gl_gnulib_enabled_pathmax=true
+ fi
+ }
+ func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c ()
+ {
+ if ! $gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c; then
+ gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=true
fi
}
func_gl_gnulib_m4code_stat ()
@@ -21908,7 +24966,7 @@ fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_stat_dir_slash" >&5
$as_echo "$gl_cv_func_stat_dir_slash" >&6; }
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat handles trailing slashes on files" >&5
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat handles trailing slashes on files" >&5
$as_echo_n "checking whether stat handles trailing slashes on files... " >&6; }
if test "${gl_cv_func_stat_file_slash+set}" = set; then :
$as_echo_n "(cached) " >&6
@@ -21919,7 +24977,13 @@ else
ln -s conftest.tmp conftest.lnk
fi
if test "$cross_compiling" = yes; then :
- gl_cv_func_stat_file_slash="guessing no"
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_stat_file_slash="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_stat_file_slash="guessing no" ;;
+ esac
+
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
@@ -21968,7 +25032,7 @@ $as_echo "#define REPLACE_FUNC_STAT_FILE 1" >>confdefs.h
;;
esac
-if test $REPLACE_STAT = 1; then
+ if test $REPLACE_STAT = 1; then
@@ -21983,7 +25047,7 @@ if test $REPLACE_STAT = 1; then
:
-fi
+ fi
@@ -22000,6 +25064,9 @@ fi
func_gl_gnulib_m4code_dosname
fi
if test $REPLACE_STAT = 1; then
+ func_gl_gnulib_m4code_pathmax
+ fi
+ if test $REPLACE_STAT = 1; then
func_gl_gnulib_m4code_verify
fi
fi
@@ -22027,7 +25094,7 @@ done
fi
fi
-if test $HAVE_STRTOLL = 0; then
+ if test $HAVE_STRTOLL = 0; then
@@ -22041,7 +25108,7 @@ if test $HAVE_STRTOLL = 0; then
:
-fi
+ fi
@@ -22079,7 +25146,7 @@ done
fi
fi
-if test $HAVE_STRTOULL = 0; then
+ if test $HAVE_STRTOULL = 0; then
@@ -22093,7 +25160,7 @@ if test $HAVE_STRTOULL = 0; then
:
-fi
+ fi
@@ -22114,6 +25181,18 @@ fi
gl_gnulib_enabled_verify=true
fi
}
+ func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec ()
+ {
+ if ! $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then
+ gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=true
+ fi
+ }
+ if test $HAVE_FACCESSAT = 0; then
+ func_gl_gnulib_m4code_dosname
+ fi
+ if test $HAVE_FACCESSAT = 0; then
+ func_gl_gnulib_m4code_euidaccess
+ fi
if test $REPLACE_GETOPT = 1; then
func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36
fi
@@ -22123,24 +25202,21 @@ fi
if test $REPLACE_LSTAT = 1; then
func_gl_gnulib_m4code_stat
fi
- if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
- func_gl_gnulib_m4code_sigprocmask
- fi
if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
func_gl_gnulib_m4code_stat
fi
- if test $ac_cv_func_strtoimax = no; then
- func_gl_gnulib_m4code_verify
- fi
- if test $ac_cv_func_strtoimax = no && test $ac_cv_type_long_long_int = yes; then
+ if { test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then
func_gl_gnulib_m4code_strtoll
fi
- if test $ac_cv_func_strtoumax = no; then
+ if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
func_gl_gnulib_m4code_verify
fi
if test $ac_cv_func_strtoumax = no && test $ac_cv_type_unsigned_long_long_int = yes; then
func_gl_gnulib_m4code_strtoull
fi
+ if test $ac_cv_func_strtoumax = no; then
+ func_gl_gnulib_m4code_verify
+ fi
if $gl_gnulib_enabled_dosname; then
gl_GNULIB_ENABLED_dosname_TRUE=
@@ -22150,6 +25226,22 @@ else
gl_GNULIB_ENABLED_dosname_FALSE=
fi
+ if $gl_gnulib_enabled_euidaccess; then
+ gl_GNULIB_ENABLED_euidaccess_TRUE=
+ gl_GNULIB_ENABLED_euidaccess_FALSE='#'
+else
+ gl_GNULIB_ENABLED_euidaccess_TRUE='#'
+ gl_GNULIB_ENABLED_euidaccess_FALSE=
+fi
+
+ if $gl_gnulib_enabled_getgroups; then
+ gl_GNULIB_ENABLED_getgroups_TRUE=
+ gl_GNULIB_ENABLED_getgroups_FALSE='#'
+else
+ gl_GNULIB_ENABLED_getgroups_TRUE='#'
+ gl_GNULIB_ENABLED_getgroups_FALSE=
+fi
+
if $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE=
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE='#'
@@ -22158,12 +25250,28 @@ else
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE=
fi
- if $gl_gnulib_enabled_sigprocmask; then
- gl_GNULIB_ENABLED_sigprocmask_TRUE=
- gl_GNULIB_ENABLED_sigprocmask_FALSE='#'
+ if $gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1; then
+ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE=
+ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE='#'
+else
+ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE='#'
+ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE=
+fi
+
+ if $gl_gnulib_enabled_pathmax; then
+ gl_GNULIB_ENABLED_pathmax_TRUE=
+ gl_GNULIB_ENABLED_pathmax_FALSE='#'
+else
+ gl_GNULIB_ENABLED_pathmax_TRUE='#'
+ gl_GNULIB_ENABLED_pathmax_FALSE=
+fi
+
+ if $gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c; then
+ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE=
+ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE='#'
else
- gl_GNULIB_ENABLED_sigprocmask_TRUE='#'
- gl_GNULIB_ENABLED_sigprocmask_FALSE=
+ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE='#'
+ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE=
fi
if $gl_gnulib_enabled_stat; then
@@ -22198,6 +25306,14 @@ else
gl_GNULIB_ENABLED_verify_FALSE=
fi
+ if $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then
+ gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE=
+ gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE='#'
+else
+ gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE='#'
+ gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE=
+fi
+
# End of code from modules
@@ -22238,6 +25354,8 @@ fi
LIBGNU_LTLIBDEPS="$gl_ltlibdeps"
+CFLAGS=$SAVE_CFLAGS
+LIBS=$SAVE_LIBS
case "$opsys" in
aix4-2) LD_SWITCH_SYSTEM_TEMACS="-Wl,-bnodelcsect" ;;
@@ -22261,8 +25379,7 @@ case "$opsys" in
## #ifndef LD_SWITCH_SYSTEM
## #if !defined (__GNUC__) && ((defined (BSD_SYSTEM) && !defined (COFF)))
## Since all the *bsds define LD_SWITCH_SYSTEM, this simplifies to:
- ## not using gcc, darwin system not on an alpha (ie darwin, since
- ## darwin + alpha does not occur).
+ ## not using gcc, darwin.
## Because this was done in src/Makefile.in, the resulting part of
## LD_SWITCH_SYSTEM was not used in configure (ie, in ac_link).
## It therefore seems cleaner to put this in LD_SWITCH_SYSTEM_TEMACS,
@@ -22271,13 +25388,14 @@ case "$opsys" in
LD_SWITCH_SYSTEM_TEMACS="-X $LD_SWITCH_SYSTEM_TEMACS"
;;
- ## LD_SWITCH_X_SITE_AUX is a -R option saying where to find X at run-time.
- ## When handled by cpp, this was in LD_SWITCH_SYSTEM. However, at
- ## the point where configure sourced the s/*.h file, LD_SWITCH_X_SITE_AUX
+ ## LD_SWITCH_X_SITE_RPATH is a -rpath option saying where to
+ ## find X at run-time.
+ ## When handled by cpp, this was in LD_SWITCH_SYSTEM. However, at the
+ ## point where configure sourced the s/*.h file, LD_SWITCH_X_SITE_RPATH
## had not yet been defined and was expanded to null. Hence LD_SWITCH_SYSTEM
## had different values in configure (in ac_link) and src/Makefile.in.
## It seems clearer therefore to put this piece in LD_SWITCH_SYSTEM_TEMACS.
- gnu-linux) LD_SWITCH_SYSTEM_TEMACS="\$(LD_SWITCH_X_SITE_AUX)" ;;
+ gnu*) LD_SWITCH_SYSTEM_TEMACS="\$(LD_SWITCH_X_SITE_RPATH)" ;;
*) LD_SWITCH_SYSTEM_TEMACS= ;;
esac
@@ -22301,12 +25419,12 @@ case "$opsys" in
## will also work on earlier NetBSD releases.
netbsd|openbsd) LD_FIRSTFLAG="-nostartfiles" ;;
- ## macpcc: NAKAJI Hiroyuki <nakaji@tutrp.tut.ac.jp> says
+ ## powerpc*: NAKAJI Hiroyuki <nakaji@tutrp.tut.ac.jp> says
## MkLinux/LinuxPPC needs this.
- ## ibms390x only supports opsys = gnu-linux so it can be added here.
+ ## s390x-* only supports opsys = gnu-linux so it can be added here.
gnu-*)
- case "$machine" in
- macppc|ibms390x) LD_FIRSTFLAG="-nostdlib" ;;
+ case "$canonical" in
+ powerpc*|s390x-*) LD_FIRSTFLAG="-nostdlib" ;;
esac
;;
esac
@@ -22320,7 +25438,7 @@ $as_echo "#define ORDINARY_LINK 1" >>confdefs.h
## The system files defining neither ORDINARY_LINK nor LD_FIRSTFLAG are:
-## freebsd, gnu-* not on macppc|ibms390x.
+## freebsd, gnu-* not on powerpc*|s390x*.
elif test "x$GCC" = "xyes" && test "x$LD_FIRSTFLAG" = "x"; then
## Versions of GCC >= 2.0 put their library, libgcc.a, in obscure
@@ -22371,39 +25489,33 @@ if test "x$GCC" = "xyes" && test "x$ORDINARY_LINK" != "xyes"; then
esac
fi
-
-## If we're using X11/GNUstep, define some consequences.
-if test "$HAVE_X_WINDOWS" = "yes" || test "$HAVE_NS" = "yes"; then
+## Common for all window systems
+if test "$window_system" != "none"; then
$as_echo "#define HAVE_WINDOW_SYSTEM 1" >>confdefs.h
$as_echo "#define HAVE_MOUSE 1" >>confdefs.h
+ WINDOW_SYSTEM_OBJ="fontset.o fringe.o image.o"
fi
+
#### Report on what we decided to do.
#### Report GTK as a toolkit, even if it doesn't use Xt.
#### It makes printing result more understandable as using GTK sets
#### toolkit_scroll_bars to yes by default.
if test "${HAVE_GTK}" = "yes"; then
- USE_X_TOOLKIT=GTK
-fi
-
-and_machfile=
-if test -n "$machfile"; then
- and_machfile=" and \`${machfile}'"
+ USE_X_TOOLKIT="$USE_GTK_TOOLKIT"
fi
echo "
Configured for \`${canonical}'.
Where should the build process find the source code? ${srcdir}
- What operating system and machine description files should Emacs use?
- \`${opsysfile}'${and_machfile}
What compiler should emacs be built with? ${CC} ${CFLAGS}
Should Emacs use the GNU version of malloc? ${GNU_MALLOC}${GNU_MALLOC_reason}
Should Emacs use a relocating allocator for buffers? ${REL_ALLOC}
@@ -22454,11 +25566,6 @@ if test -n "${EMACSDOC}"; then
echo " Environment variable EMACSDOC set to: $EMACSDOC"
fi
-if test $USE_XASSERTS = yes; then
- echo " Compiling with asserts turned on."
- CPPFLAGS="$CPPFLAGS -DXASSERTS=1"
-fi
-
echo
if test "$HAVE_NS" = "yes"; then
@@ -22476,6 +25583,14 @@ to run if these resources are not installed."
echo
fi
+if test "${opsys}" = "cygwin"; then
+ case `uname -r` in
+ 1.5.*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: building Emacs on Cygwin 1.5 is not supported." >&5
+$as_echo "$as_me: WARNING: building Emacs on Cygwin 1.5 is not supported." >&2;}
+ echo
+ ;;
+ esac
+fi
# Remove any trailing slashes in these variables.
test "${prefix}" != NONE &&
@@ -22483,9 +25598,19 @@ test "${prefix}" != NONE &&
test "${exec_prefix}" != NONE &&
exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'`
-SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile"
+if test "$HAVE_NS" = "yes"; then
+ if test "$NS_IMPL_GNUSTEP" = yes; then
+ ac_config_files="$ac_config_files nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist:nextstep/templates/Info-gnustep.plist.in nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop:nextstep/templates/Emacs.desktop.in"
+
+ else
+ ac_config_files="$ac_config_files nextstep/Cocoa/Emacs.base/Contents/Info.plist:nextstep/templates/Info.plist.in nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:nextstep/templates/InfoPlist.strings.in"
-ac_config_files="$ac_config_files Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile"
+ fi
+fi
+
+SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile nextstep/Makefile"
+
+ac_config_files="$ac_config_files Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile nextstep/Makefile"
opt_makefile=test/automated/Makefile
@@ -22496,6 +25621,16 @@ if test -f $srcdir/${opt_makefile}.in; then
fi
+
+opt_makefile=admin/unidata/Makefile
+
+if test -f $srcdir/${opt_makefile}.in; then
+ SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES $opt_makefile"
+ ac_config_files="$ac_config_files admin/unidata/Makefile"
+
+fi
+
+
SUBDIR_MAKEFILES_IN=`echo " ${SUBDIR_MAKEFILES}" | sed -e 's| | $(srcdir)/|g' -e 's|Makefile|Makefile.in|g'`
@@ -22622,7 +25757,6 @@ if test -z "${am__fastdepCC_TRUE}" && test -z "${am__fastdepCC_FALSE}"; then
as_fn_error "conditional \"am__fastdepCC\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
-
if test -z "${GL_COND_LIBTOOL_TRUE}" && test -z "${GL_COND_LIBTOOL_FALSE}"; then
as_fn_error "conditional \"GL_COND_LIBTOOL\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
@@ -22632,10 +25766,18 @@ if test -z "${GL_GENERATE_ALLOCA_H_TRUE}" && test -z "${GL_GENERATE_ALLOCA_H_FAL
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
+if test -z "${GL_GENERATE_EXECINFO_H_TRUE}" && test -z "${GL_GENERATE_EXECINFO_H_FALSE}"; then
+ as_fn_error "conditional \"GL_GENERATE_EXECINFO_H\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
if test -z "${GL_GENERATE_STDINT_H_TRUE}" && test -z "${GL_GENERATE_STDINT_H_FALSE}"; then
as_fn_error "conditional \"GL_GENERATE_STDINT_H\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
+if test -z "${GL_GENERATE_STDALIGN_H_TRUE}" && test -z "${GL_GENERATE_STDALIGN_H_FALSE}"; then
+ as_fn_error "conditional \"GL_GENERATE_STDALIGN_H\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
if test -z "${GL_GENERATE_STDARG_H_TRUE}" && test -z "${GL_GENERATE_STDARG_H_FALSE}"; then
as_fn_error "conditional \"GL_GENERATE_STDARG_H\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
@@ -22652,12 +25794,28 @@ if test -z "${gl_GNULIB_ENABLED_dosname_TRUE}" && test -z "${gl_GNULIB_ENABLED_d
as_fn_error "conditional \"gl_GNULIB_ENABLED_dosname\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
+if test -z "${gl_GNULIB_ENABLED_euidaccess_TRUE}" && test -z "${gl_GNULIB_ENABLED_euidaccess_FALSE}"; then
+ as_fn_error "conditional \"gl_GNULIB_ENABLED_euidaccess\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+if test -z "${gl_GNULIB_ENABLED_getgroups_TRUE}" && test -z "${gl_GNULIB_ENABLED_getgroups_FALSE}"; then
+ as_fn_error "conditional \"gl_GNULIB_ENABLED_getgroups\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
if test -z "${gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE}" && test -z "${gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE}"; then
as_fn_error "conditional \"gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
-if test -z "${gl_GNULIB_ENABLED_sigprocmask_TRUE}" && test -z "${gl_GNULIB_ENABLED_sigprocmask_FALSE}"; then
- as_fn_error "conditional \"gl_GNULIB_ENABLED_sigprocmask\" was never defined.
+if test -z "${gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE}" && test -z "${gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE}"; then
+ as_fn_error "conditional \"gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+if test -z "${gl_GNULIB_ENABLED_pathmax_TRUE}" && test -z "${gl_GNULIB_ENABLED_pathmax_FALSE}"; then
+ as_fn_error "conditional \"gl_GNULIB_ENABLED_pathmax\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+if test -z "${gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE}" && test -z "${gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE}"; then
+ as_fn_error "conditional \"gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
if test -z "${gl_GNULIB_ENABLED_stat_TRUE}" && test -z "${gl_GNULIB_ENABLED_stat_FALSE}"; then
@@ -22676,6 +25834,10 @@ if test -z "${gl_GNULIB_ENABLED_verify_TRUE}" && test -z "${gl_GNULIB_ENABLED_ve
as_fn_error "conditional \"gl_GNULIB_ENABLED_verify\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
+if test -z "${gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE}" && test -z "${gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE}"; then
+ as_fn_error "conditional \"gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
gl_libobjs=
gl_ltlibobjs=
@@ -23116,7 +26278,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by emacs $as_me 24.0.92, which was
+This file was extended by emacs $as_me 24.3.50, which was
generated by GNU Autoconf 2.65. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -23182,7 +26344,7 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-emacs config.status 24.0.92
+emacs config.status 24.3.50
configured by $0, generated by GNU Autoconf 2.65,
with options \\"\$ac_cs_config\\"
@@ -23296,7 +26458,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
# INIT-COMMANDS
#
AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"
-GCC="$GCC" NON_GNU_CPP="$NON_GNU_CPP" CPP="$CPP" CPPFLAGS="$CPPFLAGS"
+GCC="$GCC" CPPFLAGS="$CPPFLAGS"
_ACEOF
@@ -23308,6 +26470,10 @@ do
case $ac_config_target in
"src/config.h") CONFIG_HEADERS="$CONFIG_HEADERS src/config.h:src/config.in" ;;
"depfiles") CONFIG_COMMANDS="$CONFIG_COMMANDS depfiles" ;;
+ "nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist") CONFIG_FILES="$CONFIG_FILES nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist:nextstep/templates/Info-gnustep.plist.in" ;;
+ "nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop") CONFIG_FILES="$CONFIG_FILES nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop:nextstep/templates/Emacs.desktop.in" ;;
+ "nextstep/Cocoa/Emacs.base/Contents/Info.plist") CONFIG_FILES="$CONFIG_FILES nextstep/Cocoa/Emacs.base/Contents/Info.plist:nextstep/templates/Info.plist.in" ;;
+ "nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings") CONFIG_FILES="$CONFIG_FILES nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:nextstep/templates/InfoPlist.strings.in" ;;
"Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
"lib/Makefile") CONFIG_FILES="$CONFIG_FILES lib/Makefile" ;;
"lib-src/Makefile") CONFIG_FILES="$CONFIG_FILES lib-src/Makefile" ;;
@@ -23320,7 +26486,9 @@ do
"lwlib/Makefile") CONFIG_FILES="$CONFIG_FILES lwlib/Makefile" ;;
"lisp/Makefile") CONFIG_FILES="$CONFIG_FILES lisp/Makefile" ;;
"leim/Makefile") CONFIG_FILES="$CONFIG_FILES leim/Makefile" ;;
+ "nextstep/Makefile") CONFIG_FILES="$CONFIG_FILES nextstep/Makefile" ;;
"test/automated/Makefile") CONFIG_FILES="$CONFIG_FILES test/automated/Makefile" ;;
+ "admin/unidata/Makefile") CONFIG_FILES="$CONFIG_FILES admin/unidata/Makefile" ;;
"mkdirs") CONFIG_COMMANDS="$CONFIG_COMMANDS mkdirs" ;;
"epaths") CONFIG_COMMANDS="$CONFIG_COMMANDS epaths" ;;
"gdbinit") CONFIG_COMMANDS="$CONFIG_COMMANDS gdbinit" ;;
@@ -24049,7 +27217,7 @@ done
;;
"epaths":C)
echo creating src/epaths.h
-${MAKE-make} epaths-force
+${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force
;;
"gdbinit":C)
if test ! -f src/.gdbinit && test -f $srcdir/src/.gdbinit; then
@@ -24095,4 +27263,3 @@ if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
fi
-
diff --git a/autogen/copy_autogen b/autogen/copy_autogen
index c9f04ad6253..8aacd4d399a 100755
--- a/autogen/copy_autogen
+++ b/autogen/copy_autogen
@@ -3,12 +3,12 @@
## Helper script for those building Emacs from bzr without autoconf etc.
## This installs some pre-generated versions of the automatically
## generated files. It is highly recommended to install the necessary
-## tools instead of using this. Note that if eg configure.in
+## tools instead of using this. Note that if eg configure.ac
## is updated, the next time you run make it will attempt to
## regenerate configure and will fail if you do not have the required
## tools. You will have to run this script again.
-test -d autogen && cd autogen
+test ! -d autogen || cd autogen || exit
if test ! -e config.in; then
echo "Cannot find autogen/ directory."
@@ -16,11 +16,12 @@ if test ! -e config.in; then
fi
## Order implied by top-level Makefile's rules, for time-stamps.
-cp compile config.guess config.sub depcomp install-sh missing ../build-aux
-cp aclocal.m4 ../
-cp configure ../
-touch ../src/stamp-h.in
-cp config.in ../src/
-cp Makefile.in ../lib/
+cp -f compile config.guess config.sub depcomp install-sh missing \
+ ../build-aux &&
+cp aclocal.m4 ../ &&
+cp configure ../ &&
+touch ../src/stamp-h.in &&
+cp config.in ../src/ &&
+cp Makefile.in ../lib/ &&
echo "You can now run configure"
diff --git a/autogen/update_autogen b/autogen/update_autogen
index e406f346ede..14a4119087e 100755
--- a/autogen/update_autogen
+++ b/autogen/update_autogen
@@ -1,7 +1,7 @@
#!/bin/bash
### update_autogen - update the generated files in Emacs autogen/ directory
-## Copyright (C) 2011 Free Software Foundation, Inc.
+## Copyright (C) 2011-2012 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
@@ -79,7 +79,7 @@ lboot_flag=
## Parameters.
ldefs_in=lisp/loaddefs.el
ldefs_out=lisp/ldefs-boot.el
-sources="configure.in lib/Makefile.am"
+sources="configure.ac lib/Makefile.am"
genfiles="
configure aclocal.m4 src/config.in lib/Makefile.in
build-aux/compile build-aux/config.guess build-aux/config.sub
diff --git a/build-aux/move-if-change b/build-aux/move-if-change
index e7ba25e3127..8cae2b392c6 100755
--- a/build-aux/move-if-change
+++ b/build-aux/move-if-change
@@ -2,13 +2,13 @@
# Like mv $1 $2, but if the files are the same, just delete $1.
# Status is zero if successful, nonzero otherwise.
-VERSION='2011-01-28 20:09'; # UTC
+VERSION='2012-01-06 07:23'; # UTC
# The definition above must lie within the first 8 lines in order
# for the Emacs time-stamp write hook (at end) to update it.
# If you change this file with Emacs, please let the write hook
# do its job. Otherwise, update this string manually.
-# Copyright (C) 2002-2007, 2009-2011 Free Software Foundation, Inc.
+# Copyright (C) 2002-2012 Free Software Foundation, Inc.
# 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
@@ -32,7 +32,7 @@ If SOURCE is different than DEST, then move it to DEST; else remove SOURCE.
--help display this help and exit
--version output version information and exit
-The variable CMPPROG can be used to specify an alternative to \`cmp'.
+The variable CMPPROG can be used to specify an alternative to 'cmp'.
Report bugs to <bug-gnulib@gnu.org>."
diff --git a/build-aux/snippet/_Noreturn.h b/build-aux/snippet/_Noreturn.h
index 1a7b4daed0a..c44ad89b7c0 100644
--- a/build-aux/snippet/_Noreturn.h
+++ b/build-aux/snippet/_Noreturn.h
@@ -1,4 +1,4 @@
-#ifndef _Noreturn
+#if !defined _Noreturn && __STDC_VERSION__ < 201112
# if (3 <= __GNUC__ || (__GNUC__ == 2 && 8 <= __GNUC_MINOR__) \
|| 0x5110 <= __SUNPRO_C)
# define _Noreturn __attribute__ ((__noreturn__))
diff --git a/build-aux/snippet/arg-nonnull.h b/build-aux/snippet/arg-nonnull.h
index 6c2f1e82d06..3a9dd2664ea 100644
--- a/build-aux/snippet/arg-nonnull.h
+++ b/build-aux/snippet/arg-nonnull.h
@@ -1,5 +1,5 @@
/* A C macro for declaring that specific arguments must not be NULL.
- Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2009-2012 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU General Public License as published
diff --git a/build-aux/snippet/c++defs.h b/build-aux/snippet/c++defs.h
index b6821a64ac4..96da94b97b6 100644
--- a/build-aux/snippet/c++defs.h
+++ b/build-aux/snippet/c++defs.h
@@ -1,5 +1,5 @@
/* C++ compatible function declaration macros.
- Copyright (C) 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2010-2012 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU General Public License as published
diff --git a/build-aux/snippet/warn-on-use.h b/build-aux/snippet/warn-on-use.h
index 2cdeec3e663..d4cb94f3525 100644
--- a/build-aux/snippet/warn-on-use.h
+++ b/build-aux/snippet/warn-on-use.h
@@ -1,5 +1,5 @@
/* A C macro for emitting warnings if a function is used.
- Copyright (C) 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2010-2012 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU General Public License as published
diff --git a/update-subdirs b/build-aux/update-subdirs
index fadbab84e20..e20e0da6e13 100755
--- a/update-subdirs
+++ b/build-aux/update-subdirs
@@ -1,7 +1,7 @@
#!/bin/sh
# Write into $1/subdirs.el a list of subdirs of directory $1.
-# Copyright (C) 1994-1995, 1997, 1999, 2001-2011
+# Copyright (C) 1994-1995, 1997, 1999, 2001-2012
# Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/config.bat b/config.bat
index aa2a3a4f905..2637fe5e4ec 100644
--- a/config.bat
+++ b/config.bat
@@ -1,9 +1,7 @@
@echo off
rem ----------------------------------------------------------------------
rem Configuration script for MSDOS
-rem Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2001, 2002, 2003
-rem 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation,
-rem Inc.
+rem Copyright (C) 1994-1999, 2001-2012 Free Software Foundation, Inc.
rem This file is part of GNU Emacs.
@@ -163,22 +161,6 @@ if exist config.in sed -f ../msdos/sed2x.inp < config.in > config.tmp
if exist ..\autogen\config.in sed -f ../msdos/sed2x.inp < ..\autogen\config.in > config.tmp
:src4
sed -f ../msdos/sed2v2.inp <config.tmp >config.h2
-Rem See if DECL_ALIGN can be supported with this GCC
-rm -f junk.c junk.o junk junk.exe
-echo struct { int i; char *p; } __attribute__((__aligned__(8))) foo; >junk.c
-rem Two percent signs because it is a special character for COMMAND.COM/CMD
-rem Filter thru Sed because "&" is special for CMD.EXE
-echo int main(void) { return (unsigned long)"&"foo %% 8; } | sed "s/.&./\&/" >>junk.c
-gcc -o junk junk.c
-if not exist junk.exe coff2exe junk
-junk
-If Not ErrorLevel 1 Goto alignOk
-Echo WARNING: Your GCC does not support 8-byte aligned variables.
-Echo WARNING: Therefore Emacs cannot support buffers larger than 128MB.
-rem The following line disables DECL_ALIGN which in turn disables USE_LSB_TAG
-rem For details see lisp.h where it defines USE_LSB_TAG
-echo #define NO_DECL_ALIGN >>config.h2
-:alignOk
Rem See if they have libxml2 later than v2.2.0 installed
Echo Checking whether libxml2 v2.2.1 or later is installed ...
rm -f junk.c junk.o junk junk.exe
@@ -282,14 +264,18 @@ cd lib
Rem Rename files like djtar on plain DOS filesystem would.
If Exist build-aux\snippet\c++defs.h update build-aux/snippet/c++defs.h build-aux/snippet/cxxdefs.h
If Exist alloca.in.h update alloca.in.h alloca.in-h
+If Exist execinfo.in.h update execinfo.in.h execinfo.in-h
If Exist getopt.in.h update getopt.in.h getopt.in-h
+If Exist stdalign.in.h update stdalign.in.h stdalign.in-h
If Exist stdbool.in.h update stdbool.in.h stdbool.in-h
If Exist signal.in.h update signal.in.h signal.in-h
+If Exist stdalign.in.h update stdalign.in.h stdalign.in-h
If Exist stddef.in.h update stddef.in.h stddef.in-h
If Exist stdint.in.h update stdint.in.h stdint.in-h
If Exist stdio.in.h update stdio.in.h stdio.in-h
If Exist stdlib.in.h update stdlib.in.h stdlib.in-h
If Exist sys_stat.in.h update sys_stat.in.h sys_stat.in-h
+If Exist sys_types.in.h update sys_types.in.h sys_types.in-h
If Exist time.in.h update time.in.h time.in-h
If Exist unistd.in.h update unistd.in.h unistd.in-h
If Exist Makefile.in sed -f ../msdos/sedlibcf.inp < Makefile.in > makefile.tmp
@@ -346,4 +332,3 @@ set nodebug=
set djgpp_ver=
set sys_malloc=
set libxml=
-
diff --git a/configure.in b/configure.ac
index 83acc82064e..085ca8341ae 100644
--- a/configure.in
+++ b/configure.ac
@@ -4,7 +4,7 @@ dnl autoconf
dnl in the directory containing this script.
dnl If you changed any AC_DEFINES, also run autoheader.
dnl
-dnl Copyright (C) 1994-1996, 1999-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 1994-1996, 1999-2012 Free Software Foundation, Inc.
dnl
dnl This file is part of GNU Emacs.
dnl
@@ -22,11 +22,12 @@ dnl You should have received a copy of the GNU General Public License
dnl along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
AC_PREREQ(2.65)
-AC_INIT(emacs, 24.0.92)
+AC_INIT(emacs, 24.3.50)
AC_CONFIG_HEADER(src/config.h:src/config.in)
AC_CONFIG_SRCDIR(src/lisp.h)
AC_CONFIG_AUX_DIR(build-aux)
-AM_INIT_AUTOMAKE
+dnl Fairly arbitrary, older versions might work too.
+AM_INIT_AUTOMAKE(1.11)
dnl Support for --program-prefix, --program-suffix and
dnl --program-transform-name options
@@ -37,14 +38,24 @@ dnl hence the single quotes. This is per the GNU coding standards, see
dnl (autoconf) Installation Directory Variables
dnl See also epaths.h below.
lispdir='${datadir}/emacs/${version}/lisp'
+leimdir='${datadir}/emacs/${version}/leim'
+standardlisppath='${lispdir}:${leimdir}'
locallisppath='${datadir}/emacs/${version}/site-lisp:'\
'${datadir}/emacs/site-lisp'
-lisppath='${locallisppath}:${lispdir}:${datadir}/emacs/${version}/leim'
+lisppath='${locallisppath}:${standardlisppath}'
etcdir='${datadir}/emacs/${version}/etc'
archlibdir='${libexecdir}/emacs/${version}/${configuration}'
docdir='${datadir}/emacs/${version}/etc'
gamedir='${localstatedir}/games/emacs'
+dnl Special option to disable the most of other options.
+AC_ARG_WITH(all,
+[AS_HELP_STRING([--without-all],
+ [omit almost all features and build
+ small executable with minimal dependencies])],
+ with_features=$withval,
+ with_features=yes)
+
dnl OPTION_DEFAULT_OFF(NAME, HELP-STRING)
dnl Create a new --with option that defaults to being disabled.
dnl NAME is the base name of the option. The shell variable with_NAME
@@ -60,8 +71,8 @@ AC_DEFUN([OPTION_DEFAULT_OFF], [dnl
])dnl
dnl OPTION_DEFAULT_ON(NAME, HELP-STRING)
-dnl Create a new --with option that defaults to being enabled. NAME
-dnl is the base name of the option. The shell variable with_NAME
+dnl Create a new --with option that defaults to $enable_features.
+dnl NAME is the base name of the option. The shell variable with_NAME
dnl will be set either to 'no' (for a plain --without-NAME) or to
dnl 'yes' (if the option is not specified). Note that the shell
dnl variable name is constructed as autoconf does, by replacing
@@ -69,7 +80,7 @@ dnl non-alphanumeric characters with "_".
dnl HELP-STRING is the help text for the option.
AC_DEFUN([OPTION_DEFAULT_ON], [dnl
AC_ARG_WITH([$1],[AS_HELP_STRING([--without-$1],[$2])],[],[dnl
- m4_bpatsubst([with_$1], [[^0-9a-z]], [_])=yes])dnl
+ m4_bpatsubst([with_$1], [[^0-9a-z]], [_])=$with_features])dnl
])dnl
OPTION_DEFAULT_ON([pop],[don't support POP mail retrieval with movemail])
@@ -117,17 +128,12 @@ AC_ARG_WITH([mailhost],[AS_HELP_STRING([--with-mailhost=HOSTNAME],
OPTION_DEFAULT_ON([sound],[don't compile with sound support])
-OPTION_DEFAULT_ON([sync-input],[process async input synchronously])
-if test "$with_sync_input" = yes; then
- AC_DEFINE(SYNC_INPUT, 1, [Process async input synchronously.])
-fi
-
dnl FIXME currently it is not the last.
dnl This should be the last --with option, because --with-x is
dnl added later on when we find the path of X, and it's best to
dnl keep them together visually.
AC_ARG_WITH([x-toolkit],[AS_HELP_STRING([--with-x-toolkit=KIT],
- [use an X toolkit (KIT one of: yes or gtk, gtk3, lucid or athena, motif, no)])],
+ [use an X toolkit (KIT one of: yes or gtk, gtk2, gtk3, lucid or athena, motif, no)])],
[ case "${withval}" in
y | ye | yes ) val=gtk ;;
n | no ) val=no ;;
@@ -135,11 +141,13 @@ AC_ARG_WITH([x-toolkit],[AS_HELP_STRING([--with-x-toolkit=KIT],
a | at | ath | athe | athen | athena ) val=athena ;;
m | mo | mot | moti | motif ) val=motif ;;
g | gt | gtk ) val=gtk ;;
+ gtk2 ) val=gtk2 ;;
gtk3 ) val=gtk3 ;;
* )
AC_MSG_ERROR([`--with-x-toolkit=$withval' is invalid;
-this option's value should be `yes', `no', `lucid', `athena', `motif', `gtk' or
-`gtk3'. `yes' and `gtk' are synonyms. `athena' and `lucid' are synonyms.])
+this option's value should be `yes', `no', `lucid', `athena', `motif', `gtk',
+`gtk2' or `gtk3'. `yes' and `gtk' are synonyms.
+`athena' and `lucid' are synonyms.])
;;
esac
with_x_toolkit=$val
@@ -169,6 +177,7 @@ OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Motif or Xaw3d scroll bars])
OPTION_DEFAULT_ON([xaw3d],[don't use Xaw3d])
OPTION_DEFAULT_ON([xim],[don't use X11 XIM])
OPTION_DEFAULT_OFF([ns],[use NeXTstep (Cocoa or GNUstep) windowing system])
+OPTION_DEFAULT_OFF([w32], [use native MS Windows GUI])
OPTION_DEFAULT_ON([gpm],[don't use -lgpm for mouse support on a GNU/Linux console])
OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support])
@@ -229,24 +238,6 @@ AC_ARG_ENABLE(ns-self-contained,
EN_NS_SELF_CONTAINED=$enableval,
EN_NS_SELF_CONTAINED=yes)
-AC_ARG_ENABLE(asserts,
-[AS_HELP_STRING([--enable-asserts], [compile code with asserts enabled])],
- USE_XASSERTS=$enableval,
- USE_XASSERTS=no)
-
-AC_ARG_ENABLE(maintainer-mode,
-[AS_HELP_STRING([--disable-maintainer-mode],
- [disable make rules and dependencies not useful (and sometimes
- confusing) to the casual installer])],
- USE_MAINTAINER_MODE=$enableval,
- USE_MAINTAINER_MODE=yes)
-if test $USE_MAINTAINER_MODE = yes; then
- MAINT=
-else
- MAINT=#
-fi
-AC_SUBST(MAINT)
-
AC_ARG_ENABLE(locallisppath,
[AS_HELP_STRING([--enable-locallisppath=PATH],
[directories Emacs should search for lisp files specific
@@ -263,7 +254,7 @@ AC_ARG_ENABLE(checking,
enable only specific categories of checks.
Categories are: all,yes,no.
Flags are: stringbytes, stringoverrun, stringfreelist,
- xmallocoverrun, conslist])],
+ xmallocoverrun, conslist, glyphs])],
[ac_checking_flags="${enableval}"],[])
IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="$IFS,"
for check in $ac_checking_flags
@@ -276,19 +267,22 @@ do
ac_gc_check_string_overrun= ;
ac_gc_check_string_free_list= ;
ac_xmalloc_overrun= ;
- ac_gc_check_cons_list= ;;
+ ac_gc_check_cons_list= ;
+ ac_glyphs_debug= ;;
all) ac_enable_checking=1 ;
ac_gc_check_stringbytes=1 ;
ac_gc_check_string_overrun=1 ;
ac_gc_check_string_free_list=1 ;
ac_xmalloc_overrun=1 ;
- ac_gc_check_cons_list=1 ;;
+ ac_gc_check_cons_list=1 ;
+ ac_glyphs_debug=1 ;;
# these enable particular checks
stringbytes) ac_gc_check_stringbytes=1 ;;
stringoverrun) ac_gc_check_string_overrun=1 ;;
stringfreelist) ac_gc_check_string_free_list=1 ;;
xmallocoverrun) ac_xmalloc_overrun=1 ;;
conslist) ac_gc_check_cons_list=1 ;;
+ glyphs) ac_glyphs_debug=1 ;;
*) AC_MSG_ERROR(unknown check category $check) ;;
esac
done
@@ -296,7 +290,7 @@ IFS="$ac_save_IFS"
if test x$ac_enable_checking != x ; then
AC_DEFINE(ENABLE_CHECKING, 1,
-[Enable expensive run-time checking of data types?])
+[Define to 1 if expensive run-time data type and consistency checks are enabled.])
fi
if test x$ac_gc_check_stringbytes != x ; then
AC_DEFINE(GC_CHECK_STRING_BYTES, 1,
@@ -320,21 +314,30 @@ if test x$ac_gc_check_cons_list != x ; then
AC_DEFINE(GC_CHECK_CONS_LIST, 1,
[Define this to check for errors in cons list.])
fi
+if test x$ac_glyphs_debug != x ; then
+ AC_DEFINE(GLYPH_DEBUG, 1,
+[Define this to enable glyphs debugging code.])
+fi
-AC_ARG_ENABLE(use-lisp-union-type,
-[AS_HELP_STRING([--enable-use-lisp-union-type],
- [use a union for the Lisp_Object data type.
- This is only useful for development for catching certain types of bugs.])],
+AC_ARG_ENABLE(check-lisp-object-type,
+[AS_HELP_STRING([--enable-check-lisp-object-type],
+ [enable compile time checks for the Lisp_Object data type.
+ This is useful for development for catching certain types of bugs.])],
if test "${enableval}" != "no"; then
- AC_DEFINE(USE_LISP_UNION_TYPE, 1,
- [Define this to use a lisp union for the Lisp_Object data type.])
+ AC_DEFINE(CHECK_LISP_OBJECT_TYPE, 1,
+ [Define this to enable compile time checks for the Lisp_Object data type.])
fi)
+dnl The name of this option is unfortunate. It predates, and has no
+dnl relation to, the "sampling-based elisp profiler" added in 24.3.
+dnl Actually, it stops it working.
+dnl http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00393.html
AC_ARG_ENABLE(profiling,
[AS_HELP_STRING([--enable-profiling],
- [build emacs with profiling support.
- This might not work on all platforms])],
+ [build emacs with low-level, gprof profiling support.
+ Mainly useful for debugging Emacs itself. May not work on
+ all platforms. Stops profiler.el working.])],
[ac_enable_profiling="${enableval}"],[])
if test x$ac_enable_profiling != x ; then
PROFILING_CFLAGS="-DPROFILING=1 -pg"
@@ -374,9 +377,6 @@ case "${srcdir}" in
* ) srcdir="`(cd ${srcdir}; pwd)`" ;;
esac
-#### Given the configuration name, set machfile and opsysfile to the
-#### names of the m/*.h and s/*.h files we should use.
-
### Canonicalize the configuration name.
AC_CANONICAL_HOST
@@ -395,13 +395,11 @@ dnl quotation begins
### If you add support for a new configuration, add code to this
### switch statement to recognize your configuration name and select
-### the appropriate operating system and machine description files.
+### the appropriate operating system file.
-### You would hope that you could choose an m/*.h file pretty much
-### based on the machine portion of the configuration name, and an s/*.h
+### You would hope that you could choose an s/*.h
### file based on the operating system portion. However, it turns out
-### that each m/*.h file is pretty manufacturer-specific - for
-### example mips.h is MIPS
+### that each s/*.h file is pretty manufacturer-specific.
### So we basically have to have a special case for each
### configuration name.
###
@@ -411,95 +409,49 @@ dnl quotation begins
### prepared to handle anything reasonably. If version numbers
### matter, be sure /etc/MACHINES says something about it.
-machine='' opsys='' unported=no
+opsys='' unported=no
case "${canonical}" in
## GNU/Linux and similar ports
*-*-linux* )
opsys=gnu-linux
- case ${canonical} in
- alpha*) machine=alpha ;;
- s390x-*) machine=ibms390x ;;
- powerpc*) machine=macppc ;;
- sparc*) machine=sparc ;;
- ia64*) machine=ia64 ;;
- m68k*) machine=m68k ;;
- x86_64*) machine=amdx86-64 ;;
- esac
;;
## FreeBSD ports
*-*-freebsd* )
opsys=freebsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- amd64-*|x86_64-*) machine=amdx86-64 ;;
- ia64-*) machine=ia64 ;;
- i[3456]86-*) machine=intel386 ;;
- powerpc-*) machine=macppc ;;
- sparc-*) machine=sparc ;;
- sparc64-*) machine=sparc ;;
- esac
;;
## FreeBSD kernel + glibc based userland
*-*-kfreebsd*gnu* )
opsys=gnu-kfreebsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- amd64-*|x86_64-*) machine=amdx86-64 ;;
- ia64-*) machine=ia64 ;;
- i[3456]86-*) machine=intel386 ;;
- powerpc-*) machine=macppc ;;
- sparc-*) machine=sparc ;;
- sparc64-*) machine=sparc ;;
- esac
;;
## NetBSD ports
*-*-netbsd* )
opsys=netbsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- x86_64-*) machine=amdx86-64 ;;
- i[3456]86-*) machine=intel386 ;;
- m68k-*) machine=m68k ;;
- powerpc-*) machine=macppc ;;
- sparc*-) machine=sparc ;;
- vax-*) machine=vax ;;
- esac
;;
## OpenBSD ports
*-*-openbsd* )
opsys=openbsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- x86_64-*) machine=amdx86-64 ;;
- i386-*) machine=intel386 ;;
- powerpc-*) machine=macppc ;;
- sparc*) machine=sparc ;;
- vax-*) machine=vax ;;
- esac
;;
## Apple Darwin / Mac OS X
*-apple-darwin* )
case "${canonical}" in
- i[3456]86-* ) machine=intel386 ;;
- powerpc-* ) machine=macppc ;;
- x86_64-* ) machine=amdx86-64 ;;
+ i[3456]86-* ) ;;
+ powerpc-* ) ;;
+ x86_64-* ) ;;
* ) unported=yes ;;
esac
opsys=darwin
- # Define CPP as follows to make autoconf work correctly.
- CPP="${CC-cc} -E -no-cpp-precomp"
- # Use fink packages if available.
- if test -d /sw/include && test -d /sw/lib; then
- GCC_TEST_OPTIONS="-I/sw/include -L/sw/lib"
- CPP="${CPP} ${GCC_TEST_OPTIONS}"
- NON_GCC_TEST_OPTIONS=${GCC_TEST_OPTIONS}
- fi
+ ## Use fink packages if available.
+ ## FIXME find a better way to do this: http://debbugs.gnu.org/11507
+## if test -d /sw/include && test -d /sw/lib; then
+## GCC_TEST_OPTIONS="-I/sw/include -L/sw/lib"
+## NON_GCC_TEST_OPTIONS=${GCC_TEST_OPTIONS}
+## fi
;;
## HP 9000 series 700 and 800, running HP/UX
@@ -513,16 +465,16 @@ case "${canonical}" in
## IBM machines
rs6000-ibm-aix4.[23]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
powerpc-ibm-aix4.[23]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
rs6000-ibm-aix[56]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
powerpc-ibm-aix[56]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
## Silicon Graphics machines
@@ -532,7 +484,6 @@ case "${canonical}" in
# Without defining _LANGUAGE_C, things get masked out in the headers
# so that, for instance, grepping for `free' in stdlib.h fails and
# AC_HEADER_STD_C fails. (MIPSPro 7.2.1.2m compilers, Irix 6.5.3m).
- NON_GNU_CPP="/lib/cpp -D_LANGUAGE_C"
NON_GCC_TEST_OPTIONS="-D_LANGUAGE_C"
;;
@@ -541,26 +492,23 @@ case "${canonical}" in
| i[3456]86-*-solaris2* | i[3456]86-*-sunos5* \
| x86_64-*-solaris2* | x86_64-*-sunos5*)
case "${canonical}" in
- i[3456]86-*-* ) machine=intel386 ;;
- amd64-*-*|x86_64-*-*) machine=amdx86-64 ;;
- sparc* ) machine=sparc ;;
+ i[3456]86-*-* ) ;;
+ amd64-*-*|x86_64-*-*) ;;
+ sparc* ) ;;
* ) unported=yes ;;
esac
case "${canonical}" in
*-sunos5.6* | *-solaris2.6* )
opsys=sol2-6
- NON_GNU_CPP=/usr/ccs/lib/cpp
RANLIB="ar -ts"
;;
*-sunos5.[7-9]* | *-solaris2.[7-9]* )
opsys=sol2-6
emacs_check_sunpro_c=yes
- NON_GNU_CPP=/usr/ccs/lib/cpp
;;
*-sunos5* | *-solaris* )
opsys=sol2-10
emacs_check_sunpro_c=yes
- NON_GNU_CPP=/usr/ccs/lib/cpp
;;
esac
## Watch out for a compiler that we know will not work.
@@ -578,15 +526,12 @@ case "${canonical}" in
## Intel 386 machines where we don't care about the manufacturer.
i[3456]86-*-* )
- machine=intel386
case "${canonical}" in
*-cygwin ) opsys=cygwin ;;
- *-darwin* ) opsys=darwin
- CPP="${CC-cc} -E -no-cpp-precomp"
- ;;
- *-sysv4.2uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
- *-sysv5uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
- *-sysv5OpenUNIX* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
+ *-darwin* ) opsys=darwin ;;
+ *-sysv4.2uw* ) opsys=unixware ;;
+ *-sysv5uw* ) opsys=unixware ;;
+ *-sysv5OpenUNIX* ) opsys=unixware ;;
## Otherwise, we'll fall through to the generic opsys code at the bottom.
esac
;;
@@ -619,151 +564,254 @@ if test $unported = yes; then
Check `etc/MACHINES' for recognized configuration names.])
fi
-if test -n "$machine"; then
- machfile="m/${machine}.h"
-else
- machfile=
-fi
-opsysfile="s/${opsys}.h"
-
#### Choose a compiler.
-test -n "$CC" && cc_specified=yes
-
-# Save the value of CFLAGS that the user specified.
-SPECIFIED_CFLAGS="$CFLAGS"
dnl Sets GCC=yes if using gcc.
AC_PROG_CC
AM_PROG_CC_C_O
-# Initialize gnulib right after verifying that the C compiler works.
+if test x$GCC = xyes; then
+ test "x$GCC_TEST_OPTIONS" != x && CC="$CC $GCC_TEST_OPTIONS"
+else
+ test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS"
+fi
+
+# Avoid gnulib's tests for O_NOATIME and O_NOFOLLOW, as we don't use them.
+AC_DEFUN([gl_FCNTL_O_FLAGS])
+# Avoid gnulib's threadlib module, as we do threads our own way.
+AC_DEFUN([gl_THREADLIB])
+
+# Initialize gnulib right after choosing the compiler.
+dnl Amongst other things, this sets AR and ARFLAGS.
gl_EARLY
-# On Suns, sometimes $CPP names a directory.
-if test -n "$CPP" && test -d "$CPP"; then
- CPP=
+# It's helpful to have C macros available to GDB, so prefer -g3 to -g
+# if -g3 works and the user does not specify CFLAGS.
+# This test must follow gl_EARLY; otherwise AC_LINK_IFELSE complains.
+if test "$ac_test_CFLAGS" != set; then
+ case $CFLAGS in
+ '-g')
+ emacs_g3_CFLAGS='-g3';;
+ '-g -O2')
+ emacs_g3_CFLAGS='-g3 -O2';;
+ *)
+ emacs_g3_CFLAGS='';;
+ esac
+ if test -n "$emacs_g3_CFLAGS"; then
+ emacs_save_CFLAGS=$CFLAGS
+ CFLAGS=$emacs_g3_CFLAGS
+ AC_CACHE_CHECK([whether $CC accepts $emacs_g3_CFLAGS],
+ [emacs_cv_prog_cc_g3],
+ [AC_LINK_IFELSE([AC_LANG_PROGRAM()],
+ [emacs_cv_prog_cc_g3=yes],
+ [emacs_cv_prog_cc_g3=no])])
+ if test $emacs_cv_prog_cc_g3 = yes; then
+ CFLAGS=$emacs_g3_CFLAGS
+ else
+ CFLAGS=$emacs_save_CFLAGS
+ fi
+ fi
fi
-## If not using gcc, and on Solaris, and no CPP specified, see if
-## using a Sun compiler, which needs -Xs to prevent whitespace.
-if test x"$GCC" != xyes && test x"$emacs_check_sunpro_c" = xyes && \
- test x"$CPP" = x; then
- AC_MSG_CHECKING([whether we are using a Sun C compiler])
- AC_CACHE_VAL(emacs_cv_sunpro_c,
- [AC_LINK_IFELSE([AC_LANG_PROGRAM([[]],
-[[#ifndef __SUNPRO_C
-fail;
+AC_ARG_ENABLE([gcc-warnings],
+ [AS_HELP_STRING([--enable-gcc-warnings],
+ [turn on lots of GCC warnings. This is intended for
+ developers, and may generate false alarms when used
+ with older or non-GNU development tools.])],
+ [case $enableval in
+ yes|no) ;;
+ *) AC_MSG_ERROR([bad value $enableval for gcc-warnings option]) ;;
+ esac
+ gl_gcc_warnings=$enableval],
+ [gl_gcc_warnings=no]
+)
+
+AC_ARG_ENABLE(link-time-optimization,
+[AS_HELP_STRING([--enable-link-time-optimization],
+ [build emacs with link-time optimization.
+ This is supported only for GCC since 4.5.0.])],
+if test "${enableval}" != "no"; then
+ AC_MSG_CHECKING([whether link-time optimization is supported])
+ ac_lto_supported=no
+ if test x$GCC = xyes; then
+ CPUS=`getconf _NPROCESSORS_ONLN 2>/dev/null`
+ if test x$CPUS != x; then
+ LTO="-flto=$CPUS"
+ else
+ LTO="-flto"
+ fi
+ old_CFLAGS=$CFLAGS
+ CFLAGS="$CFLAGS $LTO"
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])],
+ [ac_lto_supported=yes], [ac_lto_supported=no])
+ CFLAGS="$old_CFLAGS"
+ fi
+ AC_MSG_RESULT([$ac_lto_supported])
+ if test "$ac_lto_supported" = "yes"; then
+ CFLAGS="$CFLAGS $LTO"
+ fi
+fi)
+
+# gl_GCC_VERSION_IFELSE([major], [minor], [run-if-found], [run-if-not-found])
+# ------------------------------------------------
+# If $CPP is gcc-MAJOR.MINOR or newer, then run RUN-IF-FOUND.
+# Otherwise, run RUN-IF-NOT-FOUND.
+AC_DEFUN([gl_GCC_VERSION_IFELSE],
+ [AC_PREPROC_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[
+#if ($1) < __GNUC__ || (($1) == __GNUC__ && ($2) <= __GNUC_MINOR__)
+/* ok */
+#else
+# error "your version of gcc is older than $1.$2"
#endif
-]])], emacs_cv_sunpro_c=yes, emacs_cv_sunpro_c=no)])
- AC_MSG_RESULT($emacs_cv_sunpro_c)
+ ]]),
+ ], [$3], [$4])
+ ]
+)
+
+# When compiling with GCC, prefer -isystem to -I when including system
+# include files, to avoid generating useless diagnostics for the files.
+if test "$gl_gcc_warnings" != yes; then
+ isystem='-I'
+else
+ isystem='-isystem '
+
+ # This, $nw, is the list of warnings we disable.
+ nw=
+
+ case $with_x_toolkit in
+ lucid | athena | motif)
+ # Old toolkits mishandle 'const'.
+ nw="$nw -Wwrite-strings"
+ ;;
+ *)
+ gl_WARN_ADD([-Werror], [WERROR_CFLAGS])
+ ;;
+ esac
+ AC_SUBST([WERROR_CFLAGS])
+
+ nw="$nw -Waggregate-return" # anachronistic
+ nw="$nw -Wlong-long" # C90 is anachronistic
+ nw="$nw -Wc++-compat" # We don't care about C++ compilers
+ nw="$nw -Wundef" # Warns on '#if GNULIB_FOO' etc in gnulib
+ nw="$nw -Wtraditional" # Warns on #elif which we use often
+ nw="$nw -Wcast-qual" # Too many warnings for now
+ nw="$nw -Wconversion" # Too many warnings for now
+ nw="$nw -Wsystem-headers" # Don't let system headers trigger warnings
+ nw="$nw -Wsign-conversion" # Too many warnings for now
+ nw="$nw -Woverlength-strings" # Not a problem these days
+ nw="$nw -Wtraditional-conversion" # Too many warnings for now
+ nw="$nw -Wunreachable-code" # so buggy that it's now silently ignored
+ nw="$nw -Wpadded" # Our structs are not padded
+ nw="$nw -Wredundant-decls" # we regularly (re)declare functions
+ nw="$nw -Wlogical-op" # any use of fwrite provokes this
+ nw="$nw -Wformat-nonliteral" # we do this a lot
+ nw="$nw -Wvla" # warnings in gettext.h
+ nw="$nw -Wnested-externs" # use of XARGMATCH/verify_function__
+ nw="$nw -Wswitch-enum" # Too many warnings for now
+ nw="$nw -Wswitch-default" # Too many warnings for now
+ nw="$nw -Wfloat-equal" # warns about high-quality code
+ nw="$nw -Winline" # OK to ignore 'inline'
+ nw="$nw -Wjump-misses-init" # We sometimes safely jump over init.
+ nw="$nw -Wstrict-overflow" # OK to optimize assuming that
+ # signed overflow has undefined behavior
+ nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning
+ nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations
+
+ # Emacs doesn't care about shadowing; see
+ # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>.
+ nw="$nw -Wshadow"
+
+ # The following line should be removable at some point.
+ nw="$nw -Wsuggest-attribute=pure"
+
+ AC_MSG_CHECKING([whether to use -Wstack-protector])
+ AC_PREPROC_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#if (1 <= __LONG_MAX__ >> 31 >> 31 \
+ && 4 < __GNUC__ + (7 < __GNUC_MINOR__ + (2 <= __GNUC_PATCHLEVEL__)))
+ /* OK */
+ #else
+ #error "Not GCC, or GCC before 4.7.2, or 'long int' has < 64 bits."
+ #endif
+ ]])],
+ [AC_MSG_RESULT(yes)],
+ [AC_MSG_RESULT(no)
+ nw="$nw -Wstack-protector"])
+
+ gl_MANYWARN_ALL_GCC([ws])
+ gl_MANYWARN_COMPLEMENT([ws], [$ws], [$nw])
+ for w in $ws; do
+ gl_WARN_ADD([$w])
+ done
+ gl_WARN_ADD([-Wno-missing-field-initializers]) # We need this one
+ gl_WARN_ADD([-Wno-sign-compare]) # Too many warnings for now
+ gl_WARN_ADD([-Wno-type-limits]) # Too many warnings for now
+ gl_WARN_ADD([-Wno-switch]) # Too many warnings for now
+ gl_WARN_ADD([-Wno-unused-parameter]) # Too many warnings for now
+ gl_WARN_ADD([-Wno-format-nonliteral])
+
+ # In spite of excluding -Wlogical-op above, it is enabled, as of
+ # gcc 4.5.0 20090517.
+ gl_WARN_ADD([-Wno-logical-op])
+
+ gl_WARN_ADD([-fdiagnostics-show-option])
+ gl_WARN_ADD([-funit-at-a-time])
+
+ AC_DEFINE([lint], [1], [Define to 1 if the compiler is checking for lint.])
+ AH_VERBATIM([FORTIFY_SOURCE],
+ [/* Enable compile-time and run-time bounds-checking, and some warnings,
+ without upsetting glibc 2.15+. */
+ #if !defined _FORTIFY_SOURCE && defined __OPTIMIZE__ && __OPTIMIZE__
+ # define _FORTIFY_SOURCE 2
+ #endif
+ ])
+ AC_DEFINE([GNULIB_PORTCHECK], [1], [enable some gnulib portability checks])
- if test x"$emacs_cv_sunpro_c" = xyes; then
- NON_GNU_CPP="$CC -E -Xs"
- fi
-fi
+ # We use a slightly smaller set of warning options for lib/.
+ # Remove the following and save the result in GNULIB_WARN_CFLAGS.
+ nw=
+ nw="$nw -Wunused-macros"
-#### Some systems specify a CPP to use unless we are using GCC.
-#### Now that we know whether we are using GCC, we can decide whether
-#### to use that one.
-if test "x$NON_GNU_CPP" != x && test x$GCC != xyes && test "x$CPP" = x
-then
- CPP="$NON_GNU_CPP"
+ gl_MANYWARN_COMPLEMENT([GNULIB_WARN_CFLAGS], [$WARN_CFLAGS], [$nw])
+ AC_SUBST([GNULIB_WARN_CFLAGS])
fi
-#### Some systems specify a CC to use unless we are using GCC.
-#### Now that we know whether we are using GCC, we can decide whether
-#### to use that one.
-if test "x$NON_GNU_CC" != x && test x$GCC != xyes &&
- test x$cc_specified != xyes
-then
- CC="$NON_GNU_CC"
-fi
-if test x$GCC = xyes; then
- test "x$GCC_TEST_OPTIONS" != x && CC="$CC $GCC_TEST_OPTIONS"
-else
- test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS"
-fi
-### Use -Wdeclaration-after-statement if the compiler supports it
-AC_MSG_CHECKING([whether gcc understands -Wdeclaration-after-statement])
-SAVE_CFLAGS="$CFLAGS"
-CFLAGS="$CFLAGS -Wdeclaration-after-statement"
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])], has_option=yes, has_option=no)
-if test $has_option = yes; then
- C_WARNINGS_SWITCH="-Wdeclaration-after-statement $C_WARNINGS_SWITCH"
-fi
-AC_MSG_RESULT($has_option)
-CFLAGS="$SAVE_CFLAGS"
-unset has_option
-unset SAVE_CFLAGS
-
-### Use -Wold-style-definition if the compiler supports it
-# This can be removed when conversion to standard C is finished.
-AC_MSG_CHECKING([whether gcc understands -Wold-style-definition])
-SAVE_CFLAGS="$CFLAGS"
-CFLAGS="$CFLAGS -Wold-style-definition"
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])], has_option=yes, has_option=no)
-if test $has_option = yes; then
- C_WARNINGS_SWITCH="-Wold-style-definition $C_WARNINGS_SWITCH"
-fi
-AC_MSG_RESULT($has_option)
-CFLAGS="$SAVE_CFLAGS"
-unset has_option
-unset SAVE_CFLAGS
-
-### Use -Wimplicit-function-declaration if the compiler supports it
-AC_MSG_CHECKING([whether gcc understands -Wimplicit-function-declaration])
-SAVE_CFLAGS="$CFLAGS"
-CFLAGS="$CFLAGS -Wimplicit-function-declaration"
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])], has_option=yes, has_option=no)
-if test $has_option = yes; then
- C_WARNINGS_SWITCH="-Wimplicit-function-declaration $C_WARNINGS_SWITCH"
-fi
-AC_MSG_RESULT($has_option)
-CFLAGS="$SAVE_CFLAGS"
-unset has_option
-unset SAVE_CFLAGS
-
-AC_SUBST(C_WARNINGS_SWITCH)
-
-
-#### Some other nice autoconf tests.
-
-dnl checks for programs
-AC_PROG_CPP
-AC_PROG_INSTALL
-if test "x$RANLIB" = x; then
- AC_PROG_RANLIB
-fi
-
-## Although we're running on an amd64 kernel, we're actually compiling for
-## the x86 architecture. The user should probably have provided an
-## explicit --build to `configure', but if everything else than the kernel
-## is running in i386 mode, we can help them out.
-if test "$machine" = "amdx86-64"; then
- AC_CHECK_DECL([i386])
- if test "$ac_cv_have_decl_i386" = "yes"; then
- canonical=`echo "$canonical" | sed -e 's/^amd64/i386/' -e 's/^x86_64/i386/'`
- machine=intel386
- machfile="m/${machine}.h"
- fi
-fi
-
-AC_PATH_PROG(INSTALL_INFO, install-info)
-AC_PATH_PROG(INSTALL_INFO, install-info,, /usr/sbin)
-AC_PATH_PROG(INSTALL_INFO, install-info,:, /sbin)
+dnl Some other nice autoconf tests.
+dnl These are commented out, since gl_EARLY and/or Autoconf already does them.
+dnl AC_PROG_INSTALL
+dnl AC_PROG_MKDIR_P
+dnl if test "x$RANLIB" = x; then
+dnl AC_PROG_RANLIB
+dnl fi
+AC_PROG_LN_S
+
+AC_PATH_PROG(INSTALL_INFO, install-info, :,
+ $PATH$PATH_SEPARATOR/usr/sbin$PATH_SEPARATOR/sbin)
dnl Don't use GZIP, which is used by gzip for additional parameters.
AC_PATH_PROG(GZIP_PROG, gzip)
+if test $opsys = gnu-linux; then
+ AC_PATH_PROG(PAXCTL, paxctl,,
+ [$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin])
+ if test "X$PAXCTL" != X; then
+ AC_MSG_CHECKING([whether binaries have a PT_PAX_FLAGS header])
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])],
+ [if $PAXCTL -v conftest$EXEEXT >/dev/null 2>&1; then AC_MSG_RESULT(yes)
+ else AC_MSG_RESULT(no); PAXCTL=""; fi])
+ fi
+fi
-## Need makeinfo >= 4.6 (?) to build the manuals.
+## Need makeinfo >= 4.7 (?) to build the manuals.
AC_PATH_PROG(MAKEINFO, makeinfo, no)
dnl By this stage, configure has already checked for egrep and set EGREP,
dnl or exited with an error if no egrep was found.
if test "$MAKEINFO" != "no" && \
- test x"`$MAKEINFO --version 2> /dev/null | $EGREP 'texinfo[[^0-9]]*([[1-4]][[0-9]]+|[[5-9]]|4\.[[6-9]]|4\.[[1-5]][[0-9]]+)'`" = x; then
+ test x"`$MAKEINFO --version 2> /dev/null | $EGREP 'texinfo[[^0-9]]*([[1-4]][[0-9]]+|[[5-9]]|4\.[[7-9]]|4\.[[1-6]][[0-9]]+)'`" = x; then
MAKEINFO=no
fi
@@ -783,7 +831,7 @@ if test "$MAKEINFO" = "no"; then
if test "x${with_makeinfo}" = "xno"; then
HAVE_MAKEINFO=no
elif test ! -e $srcdir/info/emacs; then
- AC_MSG_ERROR( [You do not seem to have makeinfo >= 4.6, and your
+ AC_MSG_ERROR( [You do not seem to have makeinfo >= 4.7, and your
source tree does not seem to have pre-built manuals in the `info' directory.
Either install a suitable version of makeinfo, or re-run configure
with the `--without-makeinfo' option to build without the manuals.] )
@@ -791,6 +839,12 @@ with the `--without-makeinfo' option to build without the manuals.] )
fi
AC_SUBST(HAVE_MAKEINFO)
+dnl Just so that there is only a single place we need to edit.
+INFO_EXT=.info
+INFO_OPTS=--no-split
+AC_SUBST(INFO_EXT)
+AC_SUBST(INFO_OPTS)
+
dnl Add our options to ac_link now, after it is set up.
if test x$GCC = xyes; then
@@ -821,11 +875,6 @@ AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])],
[AC_MSG_RESULT(no)])
-# The value of CPP is a quoted variable reference, so we need to do this
-# to get its actual value...
-CPP=`eval "echo $CPP"`
-
-
dnl The function dump-emacs will not be defined and temacs will do
dnl (load "loadup") automatically unless told otherwise.
test "x$CANNOT_DUMP" = "x" && CANNOT_DUMP=no
@@ -877,7 +926,9 @@ case "$opsys" in
## Let `ld' find image libs and similar things in /usr/local/lib.
## The system compiler, GCC, has apparently been modified to not
## look there, contrary to what a stock GCC would do.
- LD_SWITCH_SYSTEM=-L/usr/local/lib
+### It's not our place to do this. See bug#10313#17.
+### LD_SWITCH_SYSTEM=-L/usr/local/lib
+ :
;;
gnu-linux)
@@ -886,7 +937,9 @@ case "$opsys" in
;;
netbsd)
- LD_SWITCH_SYSTEM="-Wl,-rpath,/usr/pkg/lib -L/usr/pkg/lib -Wl,-rpath,/usr/local/lib -L/usr/local/lib"
+### It's not our place to do this. See bug#10313#17.
+### LD_SWITCH_SYSTEM="-Wl,-rpath,/usr/pkg/lib -L/usr/pkg/lib -Wl,-rpath,/usr/local/lib -L/usr/local/lib"
+ :
;;
openbsd)
@@ -899,7 +952,7 @@ AC_SUBST(LD_SWITCH_SYSTEM)
ac_link="$ac_link $LD_SWITCH_SYSTEM"
-## This setting of LD_SWITCH_SYSTEM references LD_SWITCH_X_SITE_AUX,
+## This setting of LD_SWITCH_SYSTEM references LD_SWITCH_X_SITE_RPATH,
## which has not been defined yet. When this was handled with cpp,
## it was expanded to null when configure sourced the s/*.h file.
## Thus LD_SWITCH_SYSTEM had different values in configure and the Makefiles.
@@ -911,13 +964,13 @@ ac_link="$ac_link $LD_SWITCH_SYSTEM"
## LD_SWITCH_SYSTEM_TEMACS.
case "$opsys" in
netbsd|openbsd)
- ## _AUX_RPATH is like _AUX, but uses -rpath instead of -R.
- LD_SWITCH_SYSTEM="\$(LD_SWITCH_X_SITE_AUX_RPATH) $LD_SWITCH_SYSTEM" ;;
+ LD_SWITCH_SYSTEM="\$(LD_SWITCH_X_SITE_RPATH) $LD_SWITCH_SYSTEM" ;;
esac
C_SWITCH_MACHINE=
-if test "$machine" = "alpha"; then
+case $canonical in
+ alpha*)
AC_CHECK_DECL([__ELF__])
if test "$ac_cv_have_decl___ELF__" = "yes"; then
## With ELF, make sure that all common symbols get allocated to in the
@@ -933,7 +986,8 @@ if test "$machine" = "alpha"; then
else
UNEXEC_OBJ=unexalpha.o
fi
-fi
+ ;;
+esac
AC_SUBST(C_SWITCH_MACHINE)
AC_SUBST(UNEXEC_OBJ)
@@ -979,13 +1033,15 @@ AC_DEFUN([AC_TYPE_SIZE_T])
# Likewise for obsolescent test for uid_t, gid_t; Emacs assumes them.
AC_DEFUN([AC_TYPE_UID_T])
-dnl Do this early because it can frob feature test macros for Unix-98 &c.
-AC_SYS_LARGEFILE
-
LIB_MATH=-lm
LIB_STANDARD=
START_FILES=
+dnl Current possibilities handled by sed (aix4-2 -> aix,
+dnl gnu-linux -> gnu/linux, etc.):
+dnl gnu, gnu/linux, gnu/kfreebsd, aix, cygwin, darwin, hpux, irix.
+dnl And special cases: berkeley-unix, usg-unix-v, ms-dos, windows-nt.
+SYSTEM_TYPE=`echo $opsys | sed -e 's/[[0-9]].*//' -e 's|-|/|'`
dnl NB do not use CRT_DIR unquoted here, since it might not be set yet.
case $opsys in
@@ -999,8 +1055,9 @@ case $opsys in
START_FILES='pre-crt0.o'
;;
freebsd )
- LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtend.o $(CRT_DIR)/crtn.o'
- START_FILES='pre-crt0.o $(CRT_DIR)/crt1.o $(CRT_DIR)/crti.o $(CRT_DIR)/crtbegin.o'
+ LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtn.o'
+ START_FILES='pre-crt0.o $(CRT_DIR)/crt1.o $(CRT_DIR)/crti.o'
+ SYSTEM_TYPE=berkeley-unix
;;
gnu-linux | gnu-kfreebsd )
LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtn.o'
@@ -1014,11 +1071,19 @@ case $opsys in
netbsd | openbsd )
LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtend.o'
START_FILES='pre-crt0.o $(CRT_DIR)/crt0.o $(CRT_DIR)/crtbegin.o'
+ SYSTEM_TYPE=berkeley-unix
+ ;;
+
+ sol2* | unixware )
+ SYSTEM_TYPE=usg-unix-v
;;
+
esac
AC_SUBST(LIB_MATH)
AC_SUBST(START_FILES)
+AC_DEFINE_UNQUOTED(SYSTEM_TYPE, "$SYSTEM_TYPE",
+ [The type of system you are compiling for; sets `system-type'.])
dnl Not all platforms use crtn.o files. Check if the current one does.
crt_files=
@@ -1107,6 +1172,11 @@ case $opsys in
esac
+pre_PKG_CONFIG_CFLAGS=$CFLAGS
+pre_PKG_CONFIG_LIBS=$LIBS
+
+AC_PATH_PROG(PKG_CONFIG, pkg-config, no)
+
dnl This function definition taken from Gnome 2.0
dnl PKG_CHECK_MODULES(GSTUFF, gtk+-2.0 >= 1.3 glib = 1.3.4, action-if, action-not)
dnl defines GSTUFF_LIBS, GSTUFF_CFLAGS, see pkg-config man page
@@ -1114,8 +1184,6 @@ dnl also defines GSTUFF_PKG_ERRORS on error
AC_DEFUN([PKG_CHECK_MODULES], [
succeeded=no
- AC_PATH_PROG(PKG_CONFIG, pkg-config, no)
-
if test "$PKG_CONFIG" = "no" ; then
ifelse([$4], , [AC_MSG_ERROR([
*** The pkg-config script could not be found. Make sure it is in your path, or give the full path to pkg-config with the PKG_CONFIG environment variable or --with-pkg-config-prog. Or see http://www.freedesktop.org/software/pkgconfig to get pkg-config.])], [$4])
@@ -1124,25 +1192,28 @@ AC_DEFUN([PKG_CHECK_MODULES], [
if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
AC_MSG_CHECKING(for $2)
- if $PKG_CONFIG --exists "$2" 2>&AS_MESSAGE_LOG_FD; then
- AC_MSG_RESULT(yes)
+ if $PKG_CONFIG --exists "$2" 2>&AS_MESSAGE_LOG_FD &&
+ $1_CFLAGS=`$PKG_CONFIG --cflags "$2" 2>&AS_MESSAGE_LOG_FD` &&
+ $1_LIBS=`$PKG_CONFIG --libs "$2" 2>&AS_MESSAGE_LOG_FD`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ $1_CFLAGS=`AS_ECHO(["$$1_CFLAGS"]) | sed -e "$edit_cflags"`
+ $1_LIBS=`AS_ECHO(["$$1_LIBS"]) | sed -e 's,///*,/,g'`
+ AC_MSG_RESULT([yes CFLAGS='$$1_CFLAGS' LIBS='$$1_LIBS'])
succeeded=yes
-
- AC_MSG_CHECKING($1_CFLAGS)
- $1_CFLAGS=`$PKG_CONFIG --cflags "$2"|sed -e 's,///*,/,g'`
- AC_MSG_RESULT($$1_CFLAGS)
-
- AC_MSG_CHECKING($1_LIBS)
- $1_LIBS=`$PKG_CONFIG --libs "$2"|sed -e 's,///*,/,g'`
- AC_MSG_RESULT($$1_LIBS)
else
AC_MSG_RESULT(no)
$1_CFLAGS=""
$1_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- $1_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "$2"`
- ifelse([$4], ,echo $$1_PKG_ERRORS,)
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ $1_PKG_ERRORS=`($PKG_CONFIG --print-errors "$2") 2>&1`
+ ifelse([$4], ,echo "$$1_PKG_ERRORS",)
fi
AC_SUBST($1_CFLAGS)
@@ -1214,11 +1285,11 @@ if test "${with_sound}" != "no"; then
fi
dnl checks for header files
-AC_CHECK_HEADERS(sys/select.h sys/time.h unistd.h utime.h \
- linux/version.h sys/systeminfo.h \
- stdio_ext.h fcntl.h coff.h pty.h sys/mman.h \
- sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h \
- sys/utsname.h pwd.h utmp.h dirent.h util.h)
+AC_CHECK_HEADERS_ONCE(
+ linux/version.h sys/systeminfo.h
+ coff.h pty.h
+ sys/vlimit.h sys/resource.h
+ sys/utsname.h pwd.h utmp.h util.h)
AC_MSG_CHECKING(if personality LINUX32 can be set)
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/personality.h>]], [[personality (PER_LINUX32)]])],
@@ -1235,10 +1306,12 @@ dnl On Solaris 8 there's a compilation warning for term.h because
dnl it doesn't define `bool'.
AC_CHECK_HEADERS(term.h, , , -)
AC_HEADER_TIME
-AC_CHECK_DECLS([sys_siglist])
+AC_CHECK_DECLS([sys_siglist], [], [], [[#include <signal.h>
+ ]])
if test $ac_cv_have_decl_sys_siglist != yes; then
# For Tru64, at least:
- AC_CHECK_DECLS([__sys_siglist])
+ AC_CHECK_DECLS([__sys_siglist], [], [], [[#include <signal.h>
+ ]])
if test $ac_cv_have_decl___sys_siglist = yes; then
AC_DEFINE(sys_siglist, __sys_siglist,
[Define to any substitute for sys_siglist.])
@@ -1246,26 +1319,6 @@ if test $ac_cv_have_decl_sys_siglist != yes; then
fi
AC_HEADER_SYS_WAIT
-dnl Some systems have utime.h but don't declare the struct anyplace.
-AC_CACHE_CHECK(for struct utimbuf, emacs_cv_struct_utimbuf,
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
-#endif
-#ifdef HAVE_UTIME_H
-#include <utime.h>
-#endif]], [[static struct utimbuf x; x.actime = x.modtime;]])],
- emacs_cv_struct_utimbuf=yes, emacs_cv_struct_utimbuf=no))
-if test $emacs_cv_struct_utimbuf = yes; then
- AC_DEFINE(HAVE_STRUCT_UTIMBUF, 1, [Define to 1 if `struct utimbuf' is declared by <utime.h>.])
-fi
-
dnl Check for speed_t typedef.
AC_CACHE_CHECK(for speed_t, emacs_cv_speed_t,
[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <termios.h>]], [[speed_t x = 1;]])],
@@ -1275,33 +1328,7 @@ if test $emacs_cv_speed_t = yes; then
[Define to 1 if `speed_t' is declared by <termios.h>.])
fi
-AC_CACHE_CHECK(for struct timeval, emacs_cv_struct_timeval,
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
-#endif]], [[static struct timeval x; x.tv_sec = x.tv_usec;]])],
- emacs_cv_struct_timeval=yes, emacs_cv_struct_timeval=no))
-HAVE_TIMEVAL=$emacs_cv_struct_timeval
-if test $emacs_cv_struct_timeval = yes; then
- AC_DEFINE(HAVE_TIMEVAL, 1, [Define to 1 if `struct timeval' is declared by <sys/time.h>.])
-fi
-
-AC_CACHE_CHECK(for struct exception, emacs_cv_struct_exception,
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <math.h>]],
-[[static struct exception x; x.arg1 = x.arg2 = x.retval; x.name = ""; x.type = 1;]])],
- emacs_cv_struct_exception=yes, emacs_cv_struct_exception=no))
-HAVE_EXCEPTION=$emacs_cv_struct_exception
-if test $emacs_cv_struct_exception != yes; then
- AC_DEFINE(NO_MATHERR, 1, [Define to 1 if you don't have struct exception in math.h.])
-fi
-
-AC_CHECK_HEADERS(sys/socket.h)
+AC_CHECK_HEADERS_ONCE(sys/socket.h)
AC_CHECK_HEADERS(net/if.h, , , [AC_INCLUDES_DEFAULT
#if HAVE_SYS_SOCKET_H
#include <sys/socket.h>
@@ -1314,7 +1341,6 @@ AC_CHECK_HEADERS(net/if_dl.h, , , [AC_INCLUDES_DEFAULT
#if HAVE_SYS_SOCKET_H
#include <sys/socket.h>
#endif])
-AC_CHECK_FUNCS(getifaddrs freeifaddrs)
dnl checks for structure members
AC_CHECK_MEMBERS([struct ifreq.ifr_flags, struct ifreq.ifr_hwaddr,
@@ -1329,45 +1355,11 @@ AC_CHECK_MEMBERS([struct ifreq.ifr_flags, struct ifreq.ifr_hwaddr,
#include <net/if.h>
#endif])
-dnl checks for compiler characteristics
-
-dnl Testing __STDC__ to determine prototype support isn't good enough.
-dnl DEC C, for instance, doesn't define it with default options, and
-dnl is used on 64-bit systems (OSF Alphas). Similarly for volatile
-dnl and void *.
-AC_C_PROTOTYPES
-AC_C_VOLATILE
-AC_C_CONST
-AC_CACHE_CHECK([for void * support], emacs_cv_void_star,
- [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [[void * foo;]])],
- emacs_cv_void_star=yes, emacs_cv_void_star=no)])
-if test $emacs_cv_void_star = yes; then
- AC_DEFINE(POINTER_TYPE, void)
-else
- AC_DEFINE(POINTER_TYPE, char)
-fi
-AH_TEMPLATE(POINTER_TYPE,
- [Define as `void' if your compiler accepts `void *'; otherwise
- define as `char'.])dnl
-
dnl Check for endianness.
-AC_C_BIGENDIAN
-
-AC_CACHE_CHECK([for __attribute__ ((__aligned__ (expr)))],
- [emacs_cv_attribute_aligned],
- [AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM(
- [[char __attribute__ ((__aligned__ (1 << 3))) c;]],
- [[]])],
- [emacs_cv_attribute_aligned=yes],
- [emacs_cv_attribute_aligned=no])])
-if test $emacs_cv_attribute_aligned = yes; then
- AC_DEFINE([HAVE_ATTRIBUTE_ALIGNED], 1,
- [Define to 1 if GCC-style __attribute__ ((__aligned__ (expr))) works.])
-fi
+dnl AC_C_BIGENDIAN is done by gnulib.
dnl check for Make feature
-AC_PROG_MAKE_SET
+dnl AC_PROG_MAKE_SET is done by Automake.
DEPFLAGS=
MKDEPDIR=":"
@@ -1395,10 +1387,8 @@ if test "$GCC" = yes && test "$ac_enable_autodepend" = yes; then
fi
if test $ac_enable_autodepend = yes; then
DEPFLAGS='-MMD -MF ${DEPDIR}/$*.d -MP'
- ## In parallel builds, another make might create depdir between
- ## the first test and mkdir, so stick another test on the end.
- ## Or use install-sh -d? mkdir -p is not portable.
- MKDEPDIR='test -d ${DEPDIR} || mkdir ${DEPDIR} || test -d ${DEPDIR}'
+ ## MKDIR_P is documented (see AC_PROG_MKDIR_P) to be parallel-safe.
+ MKDEPDIR='${MKDIR_P} ${DEPDIR}'
deps_frag=autodeps.mk
fi
fi
@@ -1417,29 +1407,22 @@ AC_SYS_LONG_FILE_NAMES
#### Choose a window system.
+## We leave window_system equal to none if
+## we end up building without one. Any new window system should
+## set window_system to an appropriate value and add objects to
+## window-system-specific substs.
+
+window_system=none
AC_PATH_X
-if test "$no_x" = yes; then
- window_system=none
-else
+if test "$no_x" != yes; then
window_system=x11
fi
-## Workaround for bug in autoconf <= 2.62.
-## http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg01551.html
-## No need to do anything special for these standard directories.
-if test -n "${x_libraries}" && test x"${x_libraries}" != xNONE; then
-
- x_libraries=`echo :${x_libraries}: | sed -e 's|:/usr/lib64:|:|g' -e 's|:/lib64:|:|g' -e 's|^:||' -e 's|:$||'`
-
-fi
-
-LD_SWITCH_X_SITE_AUX=
-LD_SWITCH_X_SITE_AUX_RPATH=
+LD_SWITCH_X_SITE_RPATH=
if test "${x_libraries}" != NONE; then
if test -n "${x_libraries}"; then
LD_SWITCH_X_SITE=-L`echo ${x_libraries} | sed -e "s/:/ -L/g"`
- LD_SWITCH_X_SITE_AUX=-R`echo ${x_libraries} | sed -e "s/:/ -R/g"`
- LD_SWITCH_X_SITE_AUX_RPATH=`echo ${LD_SWITCH_X_SITE_AUX} | sed -e 's/-R/-Wl,-rpath,/'`
+ LD_SWITCH_X_SITE_RPATH=-Wl,-rpath,`echo ${x_libraries} | sed -e "s/:/ -Wl,-rpath,/g"`
fi
x_default_search_path=""
x_search_path=${x_libraries}
@@ -1462,11 +1445,10 @@ ${x_library}/X11/%T/%N%S"
fi
done
fi
-AC_SUBST(LD_SWITCH_X_SITE_AUX)
-AC_SUBST(LD_SWITCH_X_SITE_AUX_RPATH)
+AC_SUBST(LD_SWITCH_X_SITE_RPATH)
if test "${x_includes}" != NONE && test -n "${x_includes}"; then
- C_SWITCH_X_SITE=-I`echo ${x_includes} | sed -e "s/:/ -I/g"`
+ C_SWITCH_X_SITE="$isystem"`echo ${x_includes} | sed -e "s/:/ $isystem/g"`
fi
if test x"${x_includes}" = x; then
@@ -1496,22 +1478,19 @@ CPPFLAGS="$CPPFLAGS -x objective-c"
CFLAGS="$CFLAGS -x objective-c"
TEMACS_LDFLAGS2="\${LDFLAGS}"
GNU_OBJC_CFLAGS=
-dnl I don't think it's especially important, but src/Makefile.in
-dnl (now the only user of ns_appdir) used to go to the trouble of adding a
-dnl trailing "/" to it, so now we do it here.
if test "${with_ns}" != no; then
if test "${opsys}" = darwin; then
NS_IMPL_COCOA=yes
ns_appdir=`pwd`/nextstep/Emacs.app
- ns_appbindir=${ns_appdir}/Contents/MacOS/
+ ns_appbindir=${ns_appdir}/Contents/MacOS
ns_appresdir=${ns_appdir}/Contents/Resources
- ns_appsrc=${srcdir}/nextstep/Cocoa/Emacs.base
+ ns_appsrc=Cocoa/Emacs.base
elif test -f $GNUSTEP_CONFIG_FILE; then
NS_IMPL_GNUSTEP=yes
ns_appdir=`pwd`/nextstep/Emacs.app
- ns_appbindir=${ns_appdir}/
+ ns_appbindir=${ns_appdir}
ns_appresdir=${ns_appdir}/Resources
- ns_appsrc=${srcdir}/nextstep/GNUstep/Emacs.base
+ ns_appsrc=GNUstep/Emacs.base
dnl FIXME sourcing this several times in subshells seems inefficient.
GNUSTEP_SYSTEM_HEADERS="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_SYSTEM_HEADERS)"
GNUSTEP_SYSTEM_LIBRARIES="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_SYSTEM_LIBRARIES)"
@@ -1553,52 +1532,121 @@ fail;
AC_CHECK_HEADER([AppKit/AppKit.h], [HAVE_NS=yes],
[AC_MSG_ERROR([`--with-ns' was specified, but the include
files are missing or cannot be compiled.])])
- NS_HAVE_NSINTEGER=yes
+
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include <AppKit/AppKit.h>],
+ [
+#ifdef MAC_OS_X_VERSION_MAX_ALLOWED
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1040
+ ; /* OK */
+#else
+#error "OSX 10.4 or newer required"
+#endif
+#endif
+ ])],
+ ns_osx_have_104=yes,
+ ns_osx_have_104=no)
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include <Foundation/NSObjCRuntime.h>],
[NSInteger i;])],
ns_have_nsinteger=yes,
ns_have_nsinteger=no)
- if test $ns_have_nsinteger = no; then
- NS_HAVE_NSINTEGER=no
+ if test $ns_osx_have_104 = no; then
+ AC_MSG_ERROR([`OSX 10.4 or newer is required']);
+ fi
+ if test $ns_have_nsinteger = yes; then
+ AC_DEFINE(NS_HAVE_NSINTEGER, 1, [Define to 1 if `NSInteger' is defined.])
fi
fi
+
AC_SUBST(TEMACS_LDFLAGS2)
-ns_frag=/dev/null
+INSTALL_ARCH_INDEP_EXTRA=install-etc
+ns_self_contained=no
NS_OBJ=
NS_OBJC_OBJ=
if test "${HAVE_NS}" = yes; then
+ if test "$with_toolkit_scroll_bars" = "no"; then
+ AC_MSG_ERROR([Non-toolkit scroll bars are not implemented for Nextstep.])
+ fi
+
window_system=nextstep
- with_xft=no
# set up packaging dirs
if test "${EN_NS_SELF_CONTAINED}" = yes; then
+ ns_self_contained=yes
prefix=${ns_appresdir}
exec_prefix=${ns_appbindir}
- libexecdir=${ns_appbindir}/libexec
+ dnl This one isn't really used, only archlibdir is.
+ libexecdir="\${ns_appbindir}/libexec"
+ archlibdir="\${ns_appbindir}/libexec"
+ docdir="\${ns_appresdir}/etc"
+ etcdir="\${ns_appresdir}/etc"
+ dnl FIXME maybe set datarootdir instead.
+ dnl That would also get applications, icons, man.
+ infodir="\${ns_appresdir}/info"
+ mandir="\${ns_appresdir}/man"
+ lispdir="\${ns_appresdir}/lisp"
+ leimdir="\${ns_appresdir}/leim"
+ INSTALL_ARCH_INDEP_EXTRA=
fi
- ns_frag=$srcdir/src/ns.mk
- NS_OBJ="fontset.o fringe.o image.o"
NS_OBJC_OBJ="nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o"
fi
CFLAGS="$tmp_CFLAGS"
CPPFLAGS="$tmp_CPPFLAGS"
+AC_SUBST(INSTALL_ARCH_INDEP_EXTRA)
+AC_SUBST(ns_self_contained)
AC_SUBST(NS_OBJ)
AC_SUBST(NS_OBJC_OBJ)
AC_SUBST(LIB_STANDARD)
-AC_SUBST_FILE(ns_frag)
+
+HAVE_W32=no
+W32_OBJ=
+W32_LIBS=
+if test "${with_w32}" != no; then
+ if test "${opsys}" != "cygwin"; then
+ AC_MSG_ERROR([Using w32 with an autotools build is only supported for Cygwin.])
+ fi
+ AC_CHECK_HEADER([windows.h], [HAVE_W32=yes],
+ [AC_MSG_ERROR([`--with-w32' was specified, but windows.h
+ cannot be found.])])
+ AC_DEFINE(HAVE_NTGUI, 1, [Define to use native MS Windows GUI.])
+ W32_OBJ="w32fns.o w32menu.o w32reg.o w32font.o w32term.o"
+ W32_OBJ="$W32_OBJ w32xfns.o w32select.o w32uniscribe.o"
+ W32_LIBS="$W32_LIBS -lkernel32 -luser32 -lgdi32 -lole32 -lcomdlg32"
+ W32_LIBS="$W32_LIBS -lusp10 -lcomctl32 -lwinspool"
+fi
+AC_SUBST(W32_OBJ)
+AC_SUBST(W32_LIBS)
+
+if test "${HAVE_W32}" = "yes"; then
+ window_system=w32
+ with_xft=no
+fi
+
+## $window_system is now set to the window system we will
+## ultimately use.
+
+term_header=
+HAVE_X_WINDOWS=no
+HAVE_X11=no
+USE_X_TOOLKIT=none
case "${window_system}" in
x11 )
HAVE_X_WINDOWS=yes
HAVE_X11=yes
+ term_header=xterm.h
case "${with_x_toolkit}" in
athena | lucid ) USE_X_TOOLKIT=LUCID ;;
motif ) USE_X_TOOLKIT=MOTIF ;;
gtk ) with_gtk=yes
+ term_header=gtkutil.h
dnl Don't set this for GTK. A lot of tests below assumes Xt when
dnl USE_X_TOOLKIT is set.
USE_X_TOOLKIT=none ;;
+ gtk2 ) with_gtk2=yes
+ term_header=gtkutil.h
+ USE_X_TOOLKIT=none ;;
gtk3 ) with_gtk3=yes
+ term_header=gtkutil.h
USE_X_TOOLKIT=none ;;
no ) USE_X_TOOLKIT=none ;;
dnl If user did not say whether to use a toolkit, make this decision later:
@@ -1606,13 +1654,19 @@ dnl use the toolkit if we have gtk, or X11R5 or newer.
* ) USE_X_TOOLKIT=maybe ;;
esac
;;
- nextstep | none )
- HAVE_X_WINDOWS=no
- HAVE_X11=no
- USE_X_TOOLKIT=none
+ nextstep )
+ term_header=nsterm.h
+ ;;
+ w32 )
+ term_header=w32term.h
;;
esac
+if test -n "${term_header}"; then
+ AC_DEFINE_UNQUOTED(TERM_HEADER, "${term_header}",
+ [Define to the header for the built-in window system.])
+fi
+
if test "$window_system" = none && test "X$with_x" != "Xno"; then
AC_CHECK_PROG(HAVE_XSERVER, X, true, false)
if test "$HAVE_XSERVER" = true ||
@@ -1635,20 +1689,23 @@ case ${HAVE_X11} in
yes ) HAVE_MENUS=yes ;;
esac
-# Do the opsystem or machine files prohibit the use of the GNU malloc?
+# Does the opsystem file prohibit the use of the GNU malloc?
# Assume not, until told otherwise.
GNU_MALLOC=yes
-doug_lea_malloc=yes
-AC_CHECK_FUNC(malloc_get_state, ,doug_lea_malloc=no)
-AC_CHECK_FUNC(malloc_set_state, ,doug_lea_malloc=no)
-AC_CACHE_CHECK(whether __after_morecore_hook exists,
- emacs_cv_var___after_morecore_hook,
-[AC_LINK_IFELSE([AC_LANG_PROGRAM([[extern void (* __after_morecore_hook)();]],[[__after_morecore_hook = 0]])],
- emacs_cv_var___after_morecore_hook=yes,
- emacs_cv_var___after_morecore_hook=no)])
-if test $emacs_cv_var___after_morecore_hook = no; then
- doug_lea_malloc=no
-fi
+
+AC_CACHE_CHECK(
+ [whether malloc is Doug Lea style],
+ [emacs_cv_var_doug_lea_malloc],
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <malloc.h>
+ static void hook (void) {}]],
+ [[malloc_set_state (malloc_get_state ());
+ __after_morecore_hook = hook;
+ __malloc_initialize_hook = hook;]])],
+ [emacs_cv_var_doug_lea_malloc=yes],
+ [emacs_cv_var_doug_lea_malloc=no])])
+doug_lea_malloc=$emacs_cv_var_doug_lea_malloc
dnl See comments in aix4-2.h about maybe using system malloc there.
@@ -1718,7 +1775,7 @@ AC_CHECK_LIB(Xbsd, main, LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -lXbsd")
dnl Check if pthreads is available.
LIB_PTHREAD=
-AC_CHECK_HEADERS(pthread.h)
+AC_CHECK_HEADERS_ONCE(pthread.h)
if test "$ac_cv_header_pthread_h"; then
dnl gmalloc.c uses pthread_atfork, which is not available on older-style
dnl hosts such as MirBSD 10, so test for pthread_atfork instead of merely
@@ -1785,9 +1842,9 @@ if test "${HAVE_X11}" = "yes"; then
CPPFLAGS="$C_SWITCH_X_SITE $CPPFLAGS"
# On Solaris, arrange for LD_RUN_PATH to point to the X libraries for tests.
- # This is handled by LD_SWITCH_X_SITE_AUX during the real build,
- # but it's more convenient here to set LD_RUN_PATH
- # since this also works on hosts that don't understand LD_SWITCH_X_SITE_AUX.
+ # This is handled by LD_SWITCH_X_SITE_RPATH during the real build,
+ # but it's more convenient here to set LD_RUN_PATH since this
+ # also works on hosts that don't understand LD_SWITCH_X_SITE_RPATH.
if test "${x_libraries}" != NONE && test -n "${x_libraries}"; then
LD_RUN_PATH=$x_libraries${LD_RUN_PATH+:}$LD_RUN_PATH
export LD_RUN_PATH
@@ -1841,7 +1898,7 @@ if test "${HAVE_X11}" = "yes"; then
fi
AC_CHECK_FUNCS(XrmSetDatabase XScreenResourceString \
-XScreenNumberOfScreen XSetWMProtocols)
+XScreenNumberOfScreen)
fi
if test "${window_system}" = "x11"; then
@@ -1905,7 +1962,7 @@ if test "${HAVE_X11}" = "yes"; then
AC_DEFINE(HAVE_IMAGEMAGICK, 1, [Define to 1 if using imagemagick.])
CFLAGS="$CFLAGS $IMAGEMAGICK_CFLAGS"
LIBS="$IMAGEMAGICK_LIBS $LIBS"
- AC_CHECK_FUNCS(MagickExportImagePixels)
+ AC_CHECK_FUNCS(MagickExportImagePixels MagickMergeImageLayers)
fi
fi
fi
@@ -1913,33 +1970,42 @@ fi
HAVE_GTK=no
GTK_OBJ=
-if test "${with_gtk3}" = "yes"; then
+check_gtk2=no
+gtk3_pkg_errors=
+if test "${with_gtk3}" = "yes" || test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then
GLIB_REQUIRED=2.28
GTK_REQUIRED=3.0
GTK_MODULES="gtk+-3.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED"
dnl Checks for libraries.
PKG_CHECK_MODULES(GTK, $GTK_MODULES, pkg_check_gtk=yes, pkg_check_gtk=no)
- if test "$pkg_check_gtk" = "no" && test "$USE_X_TOOLKIT" != "maybe"; then
+ if test "$pkg_check_gtk" = "no" && test "$with_gtk3" = "yes"; then
AC_MSG_ERROR($GTK_PKG_ERRORS)
fi
- AC_DEFINE(HAVE_GTK3, 1, [Define to 1 if using GTK 3 or later.])
- GTK_OBJ=emacsgtkfixed.o
+ if test "$pkg_check_gtk" = "yes"; then
+ AC_DEFINE(HAVE_GTK3, 1, [Define to 1 if using GTK 3 or later.])
+ GTK_OBJ=emacsgtkfixed.o
+ term_header=gtkutil.h
+ USE_GTK_TOOLKIT="GTK3"
+ else
+ check_gtk2=yes
+ gtk3_pkg_errors="$GTK_PKG_ERRORS "
+ fi
fi
-if test "$pkg_check_gtk" != "yes"; then
- HAVE_GTK=no
-if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then
+if test "${with_gtk2}" = "yes" || test "$check_gtk2" = "yes"; then
GLIB_REQUIRED=2.10
GTK_REQUIRED=2.10
GTK_MODULES="gtk+-2.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED"
dnl Checks for libraries.
PKG_CHECK_MODULES(GTK, $GTK_MODULES, pkg_check_gtk=yes, pkg_check_gtk=no)
- if test "$pkg_check_gtk" = "no" && test "$USE_X_TOOLKIT" != "maybe"; then
- AC_MSG_ERROR($GTK_PKG_ERRORS)
+ if test "$pkg_check_gtk" = "no" &&
+ { test "$with_gtk" = yes || test "$with_gtk2" = "yes"; }
+ then
+ AC_MSG_ERROR($gtk3_pkg_errors$GTK_PKG_ERRORS)
fi
-fi
+ test "$pkg_check_gtk" = "yes" && USE_GTK_TOOLKIT="GTK2"
fi
if test x"$pkg_check_gtk" = xyes; then
@@ -2003,11 +2069,12 @@ if test "${HAVE_GTK}" = "yes"; then
gtk_widget_get_mapped gtk_adjustment_get_page_size \
gtk_orientable_set_orientation \
gtk_window_set_has_resize_grip)
+
+ term_header=gtkutil.h
fi
dnl D-Bus has been tested under GNU/Linux only. Must be adapted for
-dnl other platforms. Support for higher D-Bus versions than 1.0 is
-dnl also not configured.
+dnl other platforms.
HAVE_DBUS=no
DBUS_OBJ=
if test "${with_dbus}" = "yes"; then
@@ -2015,7 +2082,15 @@ if test "${with_dbus}" = "yes"; then
if test "$HAVE_DBUS" = yes; then
LIBS="$LIBS $DBUS_LIBS"
AC_DEFINE(HAVE_DBUS, 1, [Define to 1 if using D-Bus.])
- AC_CHECK_FUNCS([dbus_watch_get_unix_fd])
+ dnl dbus_watch_get_unix_fd has been introduced in D-Bus 1.1.1.
+ dnl dbus_type_is_valid and dbus_validate_* have been introduced in
+ dnl D-Bus 1.5.12.
+ AC_CHECK_FUNCS(dbus_watch_get_unix_fd \
+ dbus_type_is_valid \
+ dbus_validate_bus_name \
+ dbus_validate_path \
+ dbus_validate_interface \
+ dbus_validate_member)
DBUS_OBJ=dbusbind.o
fi
fi
@@ -2046,6 +2121,11 @@ if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then
fi
if test "$HAVE_GSETTINGS" = "yes" || test "$HAVE_GCONF" = "yes"; then
+ PKG_CHECK_MODULES(GOBJECT, gobject-2.0 >= 2.0, HAVE_GOBJECT=yes, HAVE_GOBJECT=no)
+ if test "$HAVE_GOBJECT" = "yes"; then
+ SETTINGS_CFLAGS="$SETTINGS_CFLAGS $GOBJECT_CFLAGS"
+ SETTINGS_LIBS="$SETTINGS_LIBS $GOBJECT_LIBS"
+ fi
SAVE_CFLAGS="$CFLAGS"
SAVE_LIBS="$LIBS"
CFLAGS="$SETTINGS_CFLAGS $CFLAGS"
@@ -2096,7 +2176,6 @@ HAVE_XAW3D=no
LUCID_LIBW=
if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then
if test "$with_xaw3d" != no; then
- AC_MSG_CHECKING(for xaw3d)
AC_CACHE_VAL(emacs_cv_xaw3d,
[AC_LINK_IFELSE([AC_LANG_PROGRAM([[
#include <X11/Intrinsic.h>
@@ -2109,6 +2188,7 @@ if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then
emacs_cv_xaw3d=no
fi
if test $emacs_cv_xaw3d = yes; then
+ AC_MSG_CHECKING(for xaw3d)
AC_MSG_RESULT([yes; using Lucid toolkit])
USE_X_TOOLKIT=LUCID
HAVE_XAW3D=yes
@@ -2116,6 +2196,7 @@ if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then
AC_DEFINE(HAVE_XAW3D, 1,
[Define to 1 if you have the Xaw3d library (-lXaw3d).])
else
+ AC_MSG_CHECKING(for xaw3d)
AC_MSG_RESULT(no)
AC_MSG_CHECKING(for libXaw)
AC_CACHE_VAL(emacs_cv_xaw,
@@ -2176,6 +2257,7 @@ dnl tranle@intellicorp.com says libXmu.a can need XtMalloc in libXt.a to link.
fi
AC_CHECK_LIB(Xmu, XmuConvertStandardSelection)
test $ac_cv_lib_Xmu_XmuConvertStandardSelection = no && LIBS="$OLDLIBS"
+ dnl ac_cv_lib_Xmu_XmuConvertStandardSelection is also referenced below.
fi
AC_SUBST(LIBXTR6)
@@ -2199,7 +2281,21 @@ fi
LIBXP=
if test "${USE_X_TOOLKIT}" = "MOTIF"; then
- AC_CACHE_CHECK(for Motif version 2.1, emacs_cv_motif_version_2_1,
+ # OpenMotif may be installed in such a way on some GNU/Linux systems.
+ if test -d /usr/include/openmotif; then
+ CPPFLAGS="-I/usr/include/openmotif $CPPFLAGS"
+ emacs_cv_openmotif=yes
+ case "$canonical" in
+ x86_64-*-linux-gnu* | powerpc64-*-linux-gnu* | sparc64-*-linux-gnu*)
+ test -d /usr/lib64/openmotif && LDFLAGS="-L/usr/lib64/openmotif $LDFLAGS"
+ ;;
+ *)
+ test -d /usr/lib/openmotif && LDFLAGS="-L/usr/lib/openmotif $LDFLAGS"
+ esac
+ else
+ emacs_cv_openmotif=no
+ fi
+ AC_CACHE_CHECK(for (Open)Motif version 2.1, emacs_cv_motif_version_2_1,
[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <Xm/Xm.h>]],
[[#if XmVERSION > 2 || (XmVERSION == 2 && XmREVISION >= 1)
int x = 5;
@@ -2209,6 +2305,9 @@ Motif version prior to 2.1.
emacs_cv_motif_version_2_1=yes, emacs_cv_motif_version_2_1=no)])
if test $emacs_cv_motif_version_2_1 = yes; then
AC_CHECK_LIB(Xp, XpCreateContext, LIBXP=-lXp)
+ if test x$emacs_cv_openmotif = xyes; then
+ REAL_CPPFLAGS="-I/usr/include/openmotif $REAL_CPPFLAGS"
+ fi
else
AC_CACHE_CHECK(for LessTif where some systems put it, emacs_cv_lesstif,
# We put this in CFLAGS temporarily to precede other -I options
@@ -2234,6 +2333,8 @@ Motif version prior to 2.1.
CPPFLAGS=$OLD_CPPFLAGS
fi
fi
+ AC_CHECK_HEADER([Xm/BulletinB.h], [],
+ [AC_MSG_ERROR([Motif toolkit requested but requirements not found.])])
fi
dnl Use toolkit scroll bars if configured for GTK or X toolkit and either
@@ -2249,7 +2350,7 @@ if test "${with_toolkit_scroll_bars}" != "no"; then
AC_DEFINE(USE_TOOLKIT_SCROLL_BARS)
HAVE_XAW3D=no
USE_TOOLKIT_SCROLL_BARS=yes
- elif test "${HAVE_XAW3D}" = "yes"; then
+ elif test "${HAVE_XAW3D}" = "yes" || test "${USE_X_TOOLKIT}" = "LUCID"; then
AC_DEFINE(USE_TOOLKIT_SCROLL_BARS)
USE_TOOLKIT_SCROLL_BARS=yes
fi
@@ -2259,6 +2360,9 @@ if test "${with_toolkit_scroll_bars}" != "no"; then
elif test "${HAVE_NS}" = "yes"; then
AC_DEFINE(USE_TOOLKIT_SCROLL_BARS)
USE_TOOLKIT_SCROLL_BARS=yes
+ elif test "${HAVE_W32}" = "yes"; then
+ AC_DEFINE(USE_TOOLKIT_SCROLL_BARS)
+ USE_TOOLKIT_SCROLL_BARS=yes
fi
fi
@@ -2425,6 +2529,41 @@ AC_SUBST(M17N_FLT_LIBS)
### Use -lXpm if available, unless `--with-xpm=no'.
HAVE_XPM=no
LIBXPM=
+
+if test "${HAVE_W32}" = "yes"; then
+ if test "${with_xpm}" != "no"; then
+ SAVE_CPPFLAGS="$CPPFLAGS"
+ SAVE_LDFLAGS="$LDFLAGS"
+ CPPFLAGS="$CPPFLAGS -I/usr/include/noX"
+ LDFLAGS="$LDFLAGS -L/usr/lib/noX"
+ AC_CHECK_HEADER(X11/xpm.h,
+ [AC_CHECK_LIB(Xpm, XpmReadFileToImage, HAVE_XPM=yes)])
+ if test "${HAVE_XPM}" = "yes"; then
+ AC_MSG_CHECKING(for XpmReturnAllocPixels preprocessor define)
+ AC_EGREP_CPP(no_return_alloc_pixels,
+ [#include "X11/xpm.h"
+#ifndef XpmReturnAllocPixels
+no_return_alloc_pixels
+#endif
+ ], HAVE_XPM=no, HAVE_XPM=yes)
+
+ if test "${HAVE_XPM}" = "yes"; then
+ REAL_CPPFLAGS="$REAL_CPPFLAGS -I/usr/include/noX"
+ AC_MSG_RESULT(yes)
+ else
+ AC_MSG_RESULT(no)
+ CPPFLAGS="$SAVE_CPPFLAGS"
+ LDFLAGS="$SAVE_LDFLAGS"
+ fi
+ fi
+ fi
+
+ if test "${HAVE_XPM}" = "yes"; then
+ AC_DEFINE(HAVE_XPM, 1, [Define to 1 if you have the Xpm library (-lXpm).])
+ LIBXPM=-lXpm
+ fi
+fi
+
if test "${HAVE_X11}" = "yes"; then
if test "${with_xpm}" != "no"; then
AC_CHECK_HEADER(X11/xpm.h,
@@ -2451,12 +2590,13 @@ no_return_alloc_pixels
LIBXPM=-lXpm
fi
fi
+
AC_SUBST(LIBXPM)
### Use -ljpeg if available, unless `--with-jpeg=no'.
HAVE_JPEG=no
LIBJPEG=
-if test "${HAVE_X11}" = "yes"; then
+if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then
if test "${with_jpeg}" != "no"; then
dnl Checking for jpeglib.h can lose because of a redefinition of
dnl HAVE_STDLIB_H.
@@ -2484,11 +2624,11 @@ AC_SUBST(LIBJPEG)
### Use -lpng if available, unless `--with-png=no'.
HAVE_PNG=no
LIBPNG=
-if test "${HAVE_X11}" = "yes"; then
+if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then
if test "${with_png}" != "no"; then
# Debian unstable as of July 2003 has multiple libpngs, and puts png.h
# in /usr/include/libpng.
- AC_CHECK_HEADERS(png.h libpng/png.h)
+ AC_CHECK_HEADERS(png.h libpng/png.h, break)
if test "$ac_cv_header_png_h" = yes || test "$ac_cv_header_libpng_png_h" = yes ; then
AC_CHECK_LIB(png, png_get_channels, HAVE_PNG=yes, , -lz -lm)
fi
@@ -2497,6 +2637,19 @@ if test "${HAVE_X11}" = "yes"; then
if test "${HAVE_PNG}" = "yes"; then
AC_DEFINE(HAVE_PNG, 1, [Define to 1 if you have the png library (-lpng).])
LIBPNG="-lpng -lz -lm"
+
+ AC_CHECK_DECL(png_longjmp,
+ [],
+ [AC_DEFINE(PNG_DEPSTRUCT, [],
+ [Define to empty to suppress deprecation warnings when building
+ with --enable-gcc-warnings and with libpng versions before 1.5,
+ which lack png_longjmp.])],
+ [[#ifdef HAVE_LIBPNG_PNG_H
+ # include <libpng/png.h>
+ #else
+ # include <png.h>
+ #endif
+ ]])
fi
fi
AC_SUBST(LIBPNG)
@@ -2504,7 +2657,7 @@ AC_SUBST(LIBPNG)
### Use -ltiff if available, unless `--with-tiff=no'.
HAVE_TIFF=no
LIBTIFF=
-if test "${HAVE_X11}" = "yes"; then
+if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then
if test "${with_tiff}" != "no"; then
AC_CHECK_HEADER(tiffio.h,
[tifflibs="-lz -lm"
@@ -2524,7 +2677,8 @@ AC_SUBST(LIBTIFF)
### Use -lgif or -lungif if available, unless `--with-gif=no'.
HAVE_GIF=no
LIBGIF=
-if test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no"; then
+if test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no" \
+ || test "${HAVE_W32}" = "yes"; then
AC_CHECK_HEADER(gif_lib.h,
# EGifPutExtensionLast only exists from version libungif-4.1.0b1.
# Earlier versions can crash Emacs.
@@ -2584,9 +2738,9 @@ fi
AC_SUBST(LIBGPM)
dnl Check for malloc/malloc.h on darwin
-AC_CHECK_HEADER(malloc/malloc.h, [AC_DEFINE(HAVE_MALLOC_MALLOC_H, 1, [Define to 1 if you have the <malloc/malloc.h> header file.])])
+AC_CHECK_HEADERS_ONCE(malloc/malloc.h)
-C_SWITCH_X_SYSTEM=
+GNUSTEP_CFLAGS=
### Use NeXTstep API to implement GUI.
if test "${HAVE_NS}" = "yes"; then
AC_DEFINE(HAVE_NS, 1, [Define to 1 if you are using the NeXTstep API, either GNUstep or Cocoa on Mac OS X.])
@@ -2597,20 +2751,18 @@ if test "${HAVE_NS}" = "yes"; then
AC_DEFINE(NS_IMPL_GNUSTEP, 1, [Define to 1 if you are using NS windowing under GNUstep.])
# See also .m.o rule in Makefile.in */
# FIXME: are all these flags really needed? Document here why. */
- dnl FIXME this should be renamed to GNUSTEP_CFLAGS, and only
- dnl used in src/Makefile.in.
- C_SWITCH_X_SYSTEM="-D_REENTRANT -fPIC -fno-strict-aliasing -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}"
+ GNUSTEP_CFLAGS="-D_REENTRANT -fPIC -fno-strict-aliasing -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}"
## Extra CFLAGS applied to src/*.m files.
GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -fgnu-runtime -Wno-import -fconstant-string-class=NSConstantString -DGNUSTEP_BASE_LIBRARY=1 -DGNU_GUI_LIBRARY=1 -DGNU_RUNTIME=1 -DGSWARN -DGSDIAGNOSE"
fi
- if test "${NS_HAVE_NSINTEGER}" = "yes"; then
- AC_DEFINE(NS_HAVE_NSINTEGER, 1, [Define to 1 if `NSInteger' is defined.])
- fi
# We also have mouse menus.
HAVE_MENUS=yes
OTHER_FILES=ns-app
fi
+if test "${HAVE_W32}" = "yes"; then
+ HAVE_MENUS=yes
+fi
### Use session management (-lSM -lICE) if available
HAVE_X_SM=no
@@ -2659,8 +2811,8 @@ if test $emacs_cv_netdb_declares_h_errno = yes; then
AC_DEFINE(HAVE_H_ERRNO, 1, [Define to 1 if netdb.h declares h_errno.])
fi
-# fmod, logb, and frexp are found in -lm on most systems.
-# On HPUX 9.01, -lm does not contain logb, so check for sqrt.
+# sqrt and other floating-point functions such as fmod and frexp
+# are found in -lm on most systems.
AC_CHECK_LIB(m, sqrt)
# Check for mail-locking functions in a "mail" library. Probably this should
@@ -2693,8 +2845,7 @@ This probably means that movemail could lose mail.
There may be a `development' package to install containing liblockfile.])
fi
fi
-AC_CHECK_FUNCS(touchlock)
-AC_CHECK_HEADERS(maillock.h)
+AC_CHECK_HEADERS_ONCE(maillock.h)
AC_SUBST(LIBS_MAIL)
## Define MAIL_USE_FLOCK (or LOCKF) if the mailer uses flock (or lockf) to
@@ -2739,17 +2890,30 @@ esac
AC_SUBST(BLESSMAIL_TARGET)
-AC_CHECK_FUNCS(gethostname getdomainname \
-rename closedir mkdir rmdir sysinfo getrusage get_current_dir_name \
-random lrand48 logb frexp fmod rint cbrt ftime setsid \
-strerror fpathconf select euidaccess getpagesize tzset setlocale \
-utimes getrlimit setrlimit setpgid getcwd getwd shutdown getaddrinfo \
-__fpending mblen mbrlen mbsinit strsignal setitimer ualarm \
-sendto recvfrom getsockopt setsockopt getsockname getpeername \
-gai_strerror mkstemp getline getdelim mremap fsync sync \
-difftime mempcpy mblen mbrlen posix_memalign \
+AC_CHECK_FUNCS(gethostname \
+getrusage get_current_dir_name \
+lrand48 \
+select getpagesize setlocale \
+utimes getrlimit setrlimit shutdown getaddrinfo \
+strsignal setitimer \
+sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \
+gai_strerror mkstemp getline getdelim fsync sync \
+difftime posix_memalign \
+getpwent endpwent getgrent endgrent \
+touchlock \
cfmakeraw cfsetspeed copysign __executable_start)
+## Eric Backus <ericb@lsid.hp.com> says, HP-UX 9.x on HP 700 machines
+## has a broken `rint' in some library versions including math library
+## version number A.09.05.
+## You can fix the math library by installing patch number PHSS_4630.
+## But we can fix it more reliably for Emacs by just not using rint.
+## We also skip HAVE_RANDOM - see comments in src/conf_post.h.
+case $opsys in
+ hpux*) : ;;
+ *) AC_CHECK_FUNCS(random rint) ;;
+esac
+
dnl Cannot use AC_CHECK_FUNCS
AC_CACHE_CHECK([for __builtin_unwind_init],
emacs_cv_func___builtin_unwind_init,
@@ -2761,65 +2925,81 @@ if test $emacs_cv_func___builtin_unwind_init = yes; then
[Define to 1 if you have the `__builtin_unwind_init' function.])
fi
-AC_CHECK_HEADERS(sys/un.h)
+AC_CHECK_HEADERS_ONCE(sys/un.h)
AC_FUNC_FSEEKO
-AC_FUNC_GETPGRP
-
# UNIX98 PTYs.
AC_CHECK_FUNCS(grantpt)
# PTY-related GNU extensions.
-AC_CHECK_FUNCS(getpt)
+AC_CHECK_FUNCS(getpt posix_openpt)
# Check this now, so that we will NOT find the above functions in ncurses.
# That is because we have not set up to link ncurses in lib-src.
# It's better to believe a function is not available
# than to expect to find it in ncurses.
# Also we need tputs and friends to be able to build at all.
-have_tputs_et_al=true
+AC_MSG_CHECKING([for library containing tputs])
+# Run a test program that contains a call to tputs, a call that is
+# never executed. This tests whether a pre-'main' dynamic linker
+# works with the library. It's too much trouble to actually call
+# tputs in the test program, due to portability hassles. When
+# cross-compiling, assume the test program will run if it links.
+AC_DEFUN([tputs_link_source], [
+ AC_LANG_SOURCE(
+ [[extern void tputs (const char *, int, int (*)(int));
+ int main (int argc, char **argv)
+ {
+ if (argc == 10000)
+ tputs (argv[0], 0, 0);
+ return 0;
+ }]])
+])
# Maybe curses should be tried earlier?
# See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9736#35
-AC_SEARCH_LIBS(tputs, [ncurses terminfo termcap curses], , have_tputs_et_al=false)
-if test "$have_tputs_et_al" != true; then
+for tputs_library in '' tinfo ncurses terminfo termcap curses; do
+ OLIBS=$LIBS
+ if test -z "$tputs_library"; then
+ LIBS_TERMCAP=
+ msg='none required'
+ else
+ LIBS_TERMCAP=-l$tputs_library
+ msg=$LIBS_TERMCAP
+ LIBS="$LIBS_TERMCAP $LIBS"
+ fi
+ AC_RUN_IFELSE([tputs_link_source], [], [msg=no],
+ [AC_LINK_IFELSE([tputs_link_source], [], [msg=no])])
+ LIBS=$OLIBS
+ if test "X$msg" != Xno; then
+ break
+ fi
+done
+AC_MSG_RESULT([$msg])
+if test "X$msg" = Xno; then
AC_MSG_ERROR([The required function `tputs' was not found in any library.
-These libraries were tried: libncurses, libterminfo, libtermcap, libcurses.
+The following libraries were tried (in order):
+ libtinfo, libncurses, libterminfo, libtermcap, libcurses
Please try installing whichever of these libraries is most appropriate
for your system, together with its header files.
For example, a libncurses-dev(el) or similar package.])
fi
-# Must define this when any termcap library is found.
-AC_DEFINE(HAVE_LIBNCURSES, 1,
- [Define to 1 if you have the `ncurses' library (-lncurses).])
-## FIXME This was the cpp logic, but I am not sure it is right.
-## The above test has not necessarily found libncurses.
-HAVE_LIBNCURSES=yes
-
-## Use terminfo instead of termcap?
-## Note only system files NOT using terminfo are:
-## freebsd < 40000, ms-w32, msdos, netbsd < 599002500, and
-## darwin|gnu without ncurses.
-TERMINFO=no
-LIBS_TERMCAP=
-case "$opsys" in
- ## cygwin: Fewer environment variables to go wrong, more terminal types.
- ## hpux10-20: Use the system provided termcap(3) library.
- ## openbsd: David Mazieres <dm@reeducation-labor.lcs.mit.edu> says this
- ## is necessary. Otherwise Emacs dumps core when run -nw.
- aix4-2|cygwin|hpux*|irix6-5|openbsd|sol2*|unixware) TERMINFO=yes ;;
+## Use termcap instead of terminfo?
+## Only true for: freebsd < 40000, ms-w32, msdos, netbsd < 599002500.
+TERMINFO=yes
+## FIXME? In the cases below where we unconditionally set
+## LIBS_TERMCAP="-lncurses", this overrides LIBS_TERMCAP = -ltinfo,
+## if that was found above to have tputs.
+## Should we use the gnu* logic everywhere?
+case "$opsys" in
## darwin: Prevents crashes when running Emacs in Terminal.app under 10.2.
## The ncurses library has been moved out of the System framework in
## Mac OS X 10.2. So if configure detects it, set the command-line
## option to use it.
- darwin|gnu*)
- ## (HAVE_LIBNCURSES was not always true, but is since 2010-03-18.)
- if test "x$HAVE_LIBNCURSES" = "xyes"; then
- TERMINFO=yes
- LIBS_TERMCAP="-lncurses"
- fi
- ;;
+ darwin) LIBS_TERMCAP="-lncurses" ;;
+
+ gnu*) test -z "$LIBS_TERMCAP" && LIBS_TERMCAP="-lncurses" ;;
freebsd)
AC_MSG_CHECKING([whether FreeBSD is new enough to use terminfo])
@@ -2833,43 +3013,34 @@ fail;
AC_MSG_RESULT($emacs_cv_freebsd_terminfo)
if test $emacs_cv_freebsd_terminfo = yes; then
- TERMINFO=yes
LIBS_TERMCAP="-lncurses"
else
+ TERMINFO=no
LIBS_TERMCAP="-ltermcap"
fi
;;
netbsd)
- if test $ac_cv_search_tputs = -lterminfo; then
- TERMINFO=yes
- LIBS_TERMCAP="-lterminfo"
- else
+ if test "x$LIBS_TERMCAP" != "x-lterminfo"; then
+ TERMINFO=no
LIBS_TERMCAP="-ltermcap"
fi
;;
-esac
+ openbsd) LIBS_TERMCAP="-lncurses" ;;
-case "$opsys" in
## hpux: Make sure we get select from libc rather than from libcurses
## because libcurses on HPUX 10.10 has a broken version of select.
## We used to use -lc -lcurses, but this may be cleaner.
+ ## FIXME? But TERMINFO = yes on hpux (it used to be explicitly
+ # set that way, now it uses the default). Isn't this a contradiction?
hpux*) LIBS_TERMCAP="-ltermcap" ;;
- openbsd) LIBS_TERMCAP="-lncurses" ;;
-
- ## Must use system termcap, if we use any termcap. It does special things.
- sol2*) test "$TERMINFO" != yes && LIBS_TERMCAP="-ltermcap" ;;
esac
TERMCAP_OBJ=tparam.o
if test $TERMINFO = yes; then
AC_DEFINE(TERMINFO, 1, [Define to 1 if you use terminfo instead of termcap.])
-
- ## Default used to be -ltermcap. Add a case above if need something else.
- test "x$LIBS_TERMCAP" = "x" && LIBS_TERMCAP="-lcurses"
-
TERMCAP_OBJ=terminfo.o
fi
AC_SUBST(LIBS_TERMCAP)
@@ -2877,33 +3048,40 @@ AC_SUBST(TERMCAP_OBJ)
# Do we have res_init, for detecting changes in /etc/resolv.conf?
+# On Darwin, res_init appears not to be useful: see bug#562 and
+# http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01467.html
resolv=no
-AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <netinet/in.h>
+
+if test $opsys != darwin; then
+
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <netinet/in.h>
#include <arpa/nameser.h>
#include <resolv.h>]],
[[return res_init();]])],
have_res_init=yes, have_res_init=no)
-if test "$have_res_init" = no; then
- OLIBS="$LIBS"
- LIBS="$LIBS -lresolv"
- AC_MSG_CHECKING(for res_init with -lresolv)
- AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <netinet/in.h>
+ if test "$have_res_init" = no; then
+ OLIBS="$LIBS"
+ LIBS="$LIBS -lresolv"
+ AC_MSG_CHECKING(for res_init with -lresolv)
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <netinet/in.h>
#include <arpa/nameser.h>
#include <resolv.h>]],
- [[return res_init();]])],
- have_res_init=yes, have_res_init=no)
- AC_MSG_RESULT($have_res_init)
- if test "$have_res_init" = yes ; then
- resolv=yes
+ [[return res_init();]])],
+ have_res_init=yes, have_res_init=no)
+ AC_MSG_RESULT($have_res_init)
+ if test "$have_res_init" = yes ; then
+ resolv=yes
+ fi
+ LIBS="$OLIBS"
fi
- LIBS="$OLIBS"
-fi
-if test "$have_res_init" = yes; then
- AC_DEFINE(HAVE_RES_INIT, 1, [Define to 1 if res_init is available.])
-fi
+ if test "$have_res_init" = yes; then
+ AC_DEFINE(HAVE_RES_INIT, 1, [Define to 1 if res_init is available.])
+ fi
+fi dnl !darwin
# Do we need the Hesiod library to provide the support routines?
+dnl FIXME? Should we be skipping this on Darwin too?
LIBHESIOD=
if test "$with_hesiod" != no ; then
# Don't set $LIBS here -- see comments above. FIXME which comments?
@@ -2927,7 +3105,7 @@ fi
AC_SUBST(LIBHESIOD)
# Do we need libresolv (due to res_init or Hesiod)?
-if test "$resolv" = yes ; then
+if test "$resolv" = yes && test $opsys != darwin; then
AC_DEFINE(HAVE_LIBRESOLV, 1,
[Define to 1 if you have the resolv library (-lresolv).])
LIBRESOLV=-lresolv
@@ -3019,6 +3197,7 @@ AC_SUBST(KRB5LIB)
AC_SUBST(DESLIB)
AC_SUBST(KRB4LIB)
+AC_CHECK_FUNCS_ONCE(tzset)
AC_MSG_CHECKING(whether localtime caches TZ)
AC_CACHE_VAL(emacs_cv_localtime_cache,
[if test x$ac_cv_func_tzset = xyes; then
@@ -3056,33 +3235,6 @@ if test $emacs_cv_localtime_cache = yes; then
[Define to 1 if localtime caches TZ.])
fi
-if test "x$HAVE_TIMEVAL" = xyes; then
- AC_CHECK_FUNCS(gettimeofday)
- if test $ac_cv_func_gettimeofday = yes; then
- AC_CACHE_CHECK(whether gettimeofday can accept two arguments,
- emacs_cv_gettimeofday_two_arguments,
- [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
-#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
-#endif]],
- [[struct timeval time;
- gettimeofday (&time, 0);]])],
- emacs_cv_gettimeofday_two_arguments=yes,
- emacs_cv_gettimeofday_two_arguments=no)])
- if test $emacs_cv_gettimeofday_two_arguments = no; then
- AC_DEFINE(GETTIMEOFDAY_ONE_ARGUMENT, 1,
- [Define to 1 if gettimeofday accepts only one argument.])
- fi
- fi
-fi
-
ok_so_far=yes
AC_CHECK_FUNC(socket, , ok_so_far=no)
if test $ok_so_far = yes; then
@@ -3110,6 +3262,14 @@ else
AC_MSG_RESULT(no)
fi
+dnl Check for a Solaris 2.4 vfork bug that Autoconf misses (through 2.69).
+dnl This can be removed once we assume Autoconf 2.70.
+case $canonical in
+ *-solaris2.4 | *-solaris2.4.*)
+ dnl Disable the Autoconf-generated vfork test.
+ : ${ac_cv_func_vfork_works=no};;
+esac
+
AC_FUNC_FORK
AC_CHECK_FUNCS(snprintf)
@@ -3148,6 +3308,681 @@ dnl and macros for terminal control.])
dnl AC_DEFINE(HAVE_TCATTR, 1, [Define to 1 if you have tcgetattr and tcsetattr.])
dnl fi
+dnl Turned on June 1996 supposing nobody will mind it.
+AC_DEFINE(AMPERSAND_FULL_NAME, 1, [Define to use the convention that &
+ in the full name stands for the login id.])
+
+dnl Every platform that uses configure (ie every non-MS platform)
+dnl supports this. There is a create-lockfiles option you can
+dnl customize if you do not want the lock files to be written.
+dnl So it is not clear that this #define still needs to exist.
+AC_DEFINE(CLASH_DETECTION, 1, [Define if you want lock files to be written,
+ so that Emacs can tell instantly when you try to modify a file that
+ someone else has modified in his/her Emacs.])
+
+dnl Everybody supports this, except MS.
+dnl Seems like the kind of thing we should be testing for, though.
+## Note: PTYs are broken on darwin <6. Use at your own risk.
+AC_DEFINE(HAVE_PTYS, 1, [Define if the system supports pty devices.])
+
+dnl Everybody supports this, except MS-DOS.
+dnl Seems like the kind of thing we should be testing for, though.
+dnl Compare with HAVE_INET_SOCKETS (which is unused...) above.
+AC_DEFINE(HAVE_SOCKETS, 1, [Define if the system supports
+ 4.2-compatible sockets.])
+
+AH_TEMPLATE(INTERNAL_TERMINAL, [This is substituted when $TERM is "internal".])
+
+AC_DEFINE(NULL_DEVICE, ["/dev/null"], [Name of the file to open to get
+ a null file, or a data sink.])
+
+AC_DEFINE(SEPCHAR, [':'], [Character that separates PATH elements.])
+
+dnl Everybody supports this, except MS-DOS.
+AC_DEFINE(subprocesses, 1, [Define to enable asynchronous subprocesses.])
+
+AC_DEFINE(USER_FULL_NAME, [pw->pw_gecos], [How to get a user's full name.])
+
+
+AC_DEFINE(DIRECTORY_SEP, ['/'],
+ [Character that separates directories in a file name.])
+
+dnl Only used on MS platforms.
+AH_TEMPLATE(DEVICE_SEP, [Character that separates a device in a file name.])
+
+AC_DEFINE(IS_DEVICE_SEP(_c_), 0,
+ [Returns true if character is a device separator.])
+
+AC_DEFINE(IS_DIRECTORY_SEP(_c_), [((_c_) == DIRECTORY_SEP)],
+ [Returns true if character is a directory separator.])
+
+dnl On MS, this also accepts IS_DEVICE_SEP.
+AC_DEFINE(IS_ANY_SEP(_c_), [(IS_DIRECTORY_SEP (_c_))],
+ [Returns true if character is any form of separator.])
+
+
+AH_TEMPLATE(NO_EDITRES, [Define if XEditRes should not be used.])
+
+case $opsys in
+ aix4-2)
+ dnl Unfortunately without libXmu we cannot support EditRes.
+ if test x$ac_cv_lib_Xmu_XmuConvertStandardSelection != xyes; then
+ AC_DEFINE(NO_EDITRES, 1)
+ fi
+ ;;
+
+ hpux*)
+ dnl Assar Westerlund <assar@sics.se> says this is necessary for
+ dnl HP-UX 10.20, and that it works for HP-UX 0 as well.
+ AC_DEFINE(NO_EDITRES, 1)
+ ;;
+esac
+
+
+case $opsys in
+ irix6-5 | sol2* | unixware )
+ dnl Some SVr4s don't define NSIG in sys/signal.h for ANSI environments;
+ dnl instead, there's a system variable _sys_nsig. Unfortunately, we
+ dnl need the constant to dimension an array. So wire in the appropriate
+ dnl value here.
+ AC_DEFINE(NSIG_MINIMUM, 32, [Minimum value of NSIG.])
+ ;;
+esac
+
+emacs_broken_SIGIO=no
+
+case $opsys in
+ dnl SIGIO exists, but the feature doesn't work in the way Emacs needs.
+ dnl See eg <http://article.gmane.org/gmane.os.openbsd.ports/46831>.
+ hpux* | irix6-5 | openbsd | sol2* | unixware )
+ emacs_broken_SIGIO=yes
+ ;;
+
+ aix4-2)
+ dnl On AIX Emacs uses the gmalloc.c malloc implementation. But given
+ dnl the way this system works, libc functions that return malloced
+ dnl memory use the libc malloc implementation. Calling xfree or
+ dnl xrealloc on the results of such functions results in a crash.
+ dnl
+ dnl One solution for this could be to define SYSTEM_MALLOC in configure,
+ dnl but that does not currently work on this system.
+ dnl
+ dnl It is possible to completely override the malloc implementation on
+ dnl AIX, but that involves putting the malloc functions in a shared
+ dnl library and setting the MALLOCTYPE environment variable to point to
+ dnl that shared library.
+ dnl
+ dnl Emacs currently calls xrealloc on the results of get_current_dir name,
+ dnl to avoid a crash just use the Emacs implementation for that function.
+ dnl
+ dnl FIXME We could change the AC_CHECK_FUNCS call near the start
+ dnl of this file, so that we do not check for get_current_dir_name
+ dnl on AIX. But that might be fragile if something else ends
+ dnl up testing for get_current_dir_name as a dependency.
+ AC_DEFINE(BROKEN_GET_CURRENT_DIR_NAME, 1, [Define if
+ get_current_dir_name should not be used.])
+ ;;
+
+ freebsd)
+ dnl Circumvent a bug in FreeBSD. In the following sequence of
+ dnl writes/reads on a PTY, read(2) returns bogus data:
+ dnl
+ dnl write(2) 1022 bytes
+ dnl write(2) 954 bytes, get EAGAIN
+ dnl read(2) 1024 bytes in process_read_output
+ dnl read(2) 11 bytes in process_read_output
+ dnl
+ dnl That is, read(2) returns more bytes than have ever been written
+ dnl successfully. The 1033 bytes read are the 1022 bytes written
+ dnl successfully after processing (for example with CRs added if the
+ dnl terminal is set up that way which it is here). The same bytes will
+ dnl be seen again in a later read(2), without the CRs.
+ AC_DEFINE(BROKEN_PTY_READ_AFTER_EAGAIN, 1, [Define on FreeBSD to
+ work around an issue when reading from a PTY.])
+ ;;
+esac
+
+case $opsys in
+ gnu-* | sol2-10 )
+ dnl FIXME Can't we test if this exists (eg /proc/$$)?
+ AC_DEFINE(HAVE_PROCFS, 1, [Define if you have the /proc filesystem.])
+ ;;
+esac
+
+case $opsys in
+ darwin | freebsd | netbsd | openbsd )
+ AC_DEFINE(DONT_REOPEN_PTY, 1, [Define if process.c does not need to
+ close a pty to make it a controlling terminal (it is already a
+ controlling terminal of the subprocess, because we did ioctl TIOCSCTTY).])
+ ;;
+esac
+
+dnl FIXME Surely we can test for this rather than hard-code it.
+case $opsys in
+ netbsd | openbsd) sound_device="/dev/audio" ;;
+ *) sound_device="/dev/dsp" ;;
+esac
+
+dnl Used in sound.c
+AC_DEFINE_UNQUOTED(DEFAULT_SOUND_DEVICE, "$sound_device",
+ [Name of the default sound device.])
+
+
+dnl Emacs can read input using SIGIO and buffering characters itself,
+dnl or using CBREAK mode and making C-g cause SIGINT.
+dnl The choice is controlled by the variable interrupt_input.
+dnl
+dnl Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO)
+dnl
+dnl Emacs uses the presence of the USABLE_SIGIO macro
+dnl to indicate whether or not signal-driven I/O is possible. It uses
+dnl INTERRUPT_INPUT to decide whether to use it by default.
+dnl
+dnl SIGIO can be used only on systems that implement it (4.2 and 4.3).
+dnl CBREAK mode has two disadvantages
+dnl 1) At least in 4.2, it is impossible to handle the Meta key properly.
+dnl I hear that in system V this problem does not exist.
+dnl 2) Control-G causes output to be discarded.
+dnl I do not know whether this can be fixed in system V.
+dnl
+dnl Another method of doing input is planned but not implemented.
+dnl It would have Emacs fork off a separate process
+dnl to read the input and send it to the true Emacs process
+dnl through a pipe.
+case $opsys in
+ darwin | gnu-linux | gnu-kfreebsd )
+ AC_DEFINE(INTERRUPT_INPUT, 1, [Define to read input using SIGIO.])
+ ;;
+esac
+
+
+dnl If the system's imake configuration file defines `NeedWidePrototypes'
+dnl as `NO', we must define NARROWPROTO manually. Such a define is
+dnl generated in the Makefile generated by `xmkmf'. If we don't define
+dnl NARROWPROTO, we will see the wrong function prototypes for X functions
+dnl taking float or double parameters.
+case $opsys in
+ cygwin|gnu|gnu-linux|gnu-kfreebsd|irix6-5|freebsd|netbsd|openbsd)
+ AC_DEFINE(NARROWPROTO, 1, [Define if system's imake configuration
+ file defines `NeedWidePrototypes' as `NO'.])
+ ;;
+esac
+
+
+dnl Used in process.c, this must be a loop, even if it only runs once.
+dnl (Except on SGI; see below. Take that, clarity and consistency!)
+AH_TEMPLATE(PTY_ITERATION, [How to iterate over PTYs.])
+dnl Only used if !PTY_ITERATION. Iterate from FIRST_PTY_LETTER to z,
+dnl trying suffixes 0-16.
+AH_TEMPLATE(FIRST_PTY_LETTER, [Letter to use in finding device name of
+ first PTY, if PTYs are supported.])
+AH_TEMPLATE(PTY_OPEN, [How to open a PTY, if non-standard.])
+AH_TEMPLATE(PTY_NAME_SPRINTF, [How to get the device name of the control
+ end of a PTY, if non-standard.])
+AH_TEMPLATE(PTY_TTY_NAME_SPRINTF, [How to get device name of the tty
+ end of a PTY, if non-standard.])
+
+case $opsys in
+ aix4-2 )
+ AC_DEFINE(PTY_ITERATION, [int c; for (c = 0; !c ; c++)])
+ dnl You allocate a pty by opening /dev/ptc to get the master side.
+ dnl To get the name of the slave side, you just ttyname() the master side.
+ AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptc");])
+ AC_DEFINE(PTY_TTY_NAME_SPRINTF, [strcpy (pty_name, ttyname (fd));])
+ ;;
+
+ cygwin )
+ AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)])
+ dnl multi-line AC_DEFINEs are hard. :(
+ AC_DEFINE(PTY_OPEN, [ do { int dummy; sigset_t blocked, procmask; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, &procmask); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; pthread_sigmask (SIG_SETMASK, &procmask, 0); if (fd >= 0) emacs_close (dummy); } while (0)])
+ AC_DEFINE(PTY_NAME_SPRINTF, [])
+ AC_DEFINE(PTY_TTY_NAME_SPRINTF, [])
+ ;;
+
+ dnl FIXME? Maybe use same as freebsd - see bug#12040.
+ darwin )
+ AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)])
+ dnl Not used, because PTY_ITERATION is defined.
+ AC_DEFINE(FIRST_PTY_LETTER, ['p'])
+ dnl Note that openpty may fork via grantpt on Mac OS X 10.4/Darwin 8.
+ dnl But we don't have to block SIGCHLD because it is blocked in the
+ dnl implementation of grantpt.
+ AC_DEFINE(PTY_OPEN, [ do { int slave; if (openpty (&fd, &slave, pty_name, NULL, NULL) == -1) fd = -1; else emacs_close (slave); } while (0)])
+ AC_DEFINE(PTY_NAME_SPRINTF, [])
+ AC_DEFINE(PTY_TTY_NAME_SPRINTF, [])
+ ;;
+
+ gnu | openbsd )
+ AC_DEFINE(FIRST_PTY_LETTER, ['p'])
+ ;;
+
+ gnu-linux | gnu-kfreebsd | freebsd | netbsd )
+ dnl if HAVE_GRANTPT
+ if test "x$ac_cv_func_grantpt" = xyes; then
+ AC_DEFINE(UNIX98_PTYS, 1, [Define if the system has Unix98 PTYs.])
+ AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)])
+ dnl Note that grantpt and unlockpt may fork. We must block SIGCHLD
+ dnl to prevent sigchld_handler from intercepting the child's death.
+ AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }])
+ dnl if HAVE_POSIX_OPENPT
+ if test "x$ac_cv_func_posix_openpt" = xyes; then
+ AC_DEFINE(PTY_OPEN, [fd = posix_openpt (O_RDWR | O_NOCTTY)])
+ AC_DEFINE(PTY_NAME_SPRINTF, [])
+ dnl if HAVE_GETPT
+ elif test "x$ac_cv_func_getpt" = xyes; then
+ AC_DEFINE(PTY_OPEN, [fd = getpt ()])
+ AC_DEFINE(PTY_NAME_SPRINTF, [])
+ else
+ AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptmx");])
+ fi
+ else
+ AC_DEFINE(FIRST_PTY_LETTER, ['p'])
+ fi
+ ;;
+
+ hpux*)
+ AC_DEFINE(FIRST_PTY_LETTER, ['p'])
+ AC_DEFINE(PTY_NAME_SPRINTF, [sprintf (pty_name, "/dev/ptym/pty%c%x", c, i);])
+ AC_DEFINE(PTY_TTY_NAME_SPRINTF, [sprintf (pty_name, "/dev/pty/tty%c%x", c, i);])
+ ;;
+
+ irix6-5 )
+ dnl It looks like this cannot be right, because it is not a loop.
+ dnl However, process.c actually does this:
+ dnl # ifndef __sgi
+ dnl continue;
+ dnl # else
+ dnl return -1;
+ dnl # endif
+ dnl which presumably makes it OK, since irix == sgi (?).
+ dnl FIXME it seems like this special treatment is unnecessary?
+ dnl Why can't irix use a single-trip loop like eg cygwin?
+ AC_DEFINE(PTY_ITERATION, [])
+ dnl Not used, because PTY_ITERATION is defined.
+ AC_DEFINE(FIRST_PTY_LETTER, ['q'])
+ AC_DEFINE(PTY_OPEN, [ { struct sigaction ocstat, cstat; struct stat stb; char * name; sigemptyset(&cstat.sa_mask); cstat.sa_handler = SIG_DFL; cstat.sa_flags = 0; sigaction(SIGCLD, &cstat, &ocstat); name = _getpty (&fd, O_RDWR | O_NDELAY, 0600, 0); sigaction(SIGCLD, &ocstat, (struct sigaction *)0); if (name == 0) return -1; if (fd < 0) return -1; if (fstat (fd, &stb) < 0) return -1; strcpy (pty_name, name); }])
+ dnl No need to get the pty name at all.
+ AC_DEFINE(PTY_NAME_SPRINTF, [])
+ dnl No need to use sprintf to get the tty name--we get that from _getpty.
+ AC_DEFINE(PTY_TTY_NAME_SPRINTF, [])
+ ;;
+
+ sol2* )
+ dnl On SysVr4, grantpt(3) forks a subprocess, so keep sigchld_handler()
+ dnl from intercepting that death. If any child but grantpt's should die
+ dnl within, it should be caught after sigrelse(2).
+ AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }])
+ ;;
+
+ unixware )
+ dnl Comments are as per sol2*.
+ AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, sizeof pty_name, "%s", ptyname); }])
+ ;;
+esac
+
+
+case $opsys in
+ sol2* | unixware )
+ dnl This change means that we don't loop through allocate_pty too
+ dnl many times in the (rare) event of a failure.
+ AC_DEFINE(FIRST_PTY_LETTER, ['z'])
+ AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptmx");])
+ dnl Push various streams modules onto a PTY channel. Used in process.c.
+ AC_DEFINE(SETUP_SLAVE_PTY, [if (ioctl (xforkin, I_PUSH, "ptem") == -1) fatal ("ioctl I_PUSH ptem"); if (ioctl (xforkin, I_PUSH, "ldterm") == -1) fatal ("ioctl I_PUSH ldterm"); if (ioctl (xforkin, I_PUSH, "ttcompat") == -1) fatal ("ioctl I_PUSH ttcompat");], [How to set up a slave PTY, if needed.])
+ ;;
+esac
+
+
+AH_TEMPLATE(SIGNALS_VIA_CHARACTERS, [Make process_send_signal work by
+"typing" a signal character on the pty.])
+
+case $opsys in
+ dnl Perry Smith <pedz@ddivt1.austin.ibm.com> says this is correct for AIX.
+ dnl thomas@mathematik.uni-bremen.de says this is needed for IRIX.
+ aix4-2 | cygwin | gnu | irix6-5 | freebsd | netbsd | openbsd )
+ AC_DEFINE(SIGNALS_VIA_CHARACTERS, 1)
+ ;;
+
+ dnl 21 Jun 06: Eric Hanchrow <offby1@blarg.net> says this works.
+ dnl FIXME Does gnu-kfreebsd have linux/version.h? It seems unlikely...
+ gnu-linux | gnu-kfreebsd )
+
+ AC_MSG_CHECKING([for signals via characters])
+ AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#include <linux/version.h>
+#if LINUX_VERSION_CODE < 0x20400
+# error "Linux version too old"
+#endif
+ ]], [[]])], emacs_signals_via_chars=yes, emacs_signals_via_chars=no)
+
+ AC_MSG_RESULT([$emacs_signals_via_chars])
+ test $emacs_signals_via_chars = yes && AC_DEFINE(SIGNALS_VIA_CHARACTERS, 1)
+ ;;
+esac
+
+
+dnl Used in vm-limit.c
+AH_TEMPLATE(DATA_START, [Address of the start of the data segment.])
+dnl Used in lisp.h, emacs.c, mem-limits.h
+dnl NEWS.18 describes this as "a number which contains
+dnl the high bits to be inclusive or'ed with pointers that are unpacked."
+AH_TEMPLATE(DATA_SEG_BITS, [Extra bits to be or'd in with any pointers
+stored in a Lisp_Object.])
+dnl if Emacs uses fewer than 32 bits for the value field of a LISP_OBJECT.
+
+case $opsys in
+ gnu)
+ dnl libc defines data_start.
+ AC_DEFINE(DATA_START, [({ extern int data_start; (char *) &data_start; })])
+ ;;
+
+ hpux*)
+ dnl The data segment on this machine always starts at address 0x40000000.
+ AC_DEFINE(DATA_START, [0x40000000])
+ AC_DEFINE(DATA_SEG_BITS, [0x40000000])
+ ;;
+ irix6-5)
+ AC_DEFINE(DATA_START, [0x10000000])
+ AC_DEFINE(DATA_SEG_BITS, [0x10000000])
+ ;;
+esac
+
+
+AH_TEMPLATE(ULIMIT_BREAK_VALUE, [Undocumented.])
+AH_TEMPLATE(TAB3, [Undocumented.])
+
+case $opsys in
+ darwin) AC_DEFINE(TAB3, OXTABS) ;;
+
+ gnu | freebsd | netbsd | openbsd )
+ AC_DEFINE(TABDLY, OXTABS, [Undocumented.])
+ AC_DEFINE(TAB3, OXTABS)
+ ;;
+
+ gnu-linux | gnu-kfreebsd )
+ dnl libc-linux/sysdeps/linux/i386/ulimit.c says that due to shared
+ dnl library, we cannot get the maximum address for brk.
+ AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#ifndef __i386__
+# error "not i386"
+#endif
+ ]], [[]])], AC_DEFINE(ULIMIT_BREAK_VALUE, [(32*1024*1024)]), [])
+
+ AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#ifndef __ia64__
+# error "not ia64"
+#endif
+ ]], [[]])], AC_DEFINE(GC_MARK_SECONDARY_STACK(),
+ [do { extern void *__libc_ia64_register_backing_store_base; __builtin_ia64_flushrs (); mark_memory (__libc_ia64_register_backing_store_base, __builtin_ia64_bsp ());} while (0)],
+ [Mark a secondary stack, like the register stack on the ia64.]), [])
+ ;;
+
+ hpux*)
+ AC_DEFINE(RUN_TIME_REMAP, 1, [Define if emacs.c needs to call
+ run_time_remap; for HPUX.])
+ ;;
+
+ irix6-5)
+ dnl Ulimit(UL_GMEMLIM) is busted...
+ AC_DEFINE(ULIMIT_BREAK_VALUE, [0x14000000])
+ ;;
+esac
+
+
+dnl These won't be used automatically yet. We also need to know, at least,
+dnl that the stack is continuous.
+AH_TEMPLATE(GC_SETJMP_WORKS, [Define if setjmp is known to save all
+ registers relevant for conservative garbage collection in the jmp_buf.])
+
+AH_TEMPLATE(GC_MARK_STACK, [Define to GC_USE_GCPROS_AS_BEFORE if
+ conservative garbage collection is not known to work.])
+
+
+case $opsys in
+ aix4-2 | hpux* | unixware)
+ dnl Conservative garbage collection has not been tested, so for now
+ dnl play it safe and stick with the old-fashioned way of marking.
+ AC_DEFINE(GC_MARK_STACK, [GC_USE_GCPROS_AS_BEFORE])
+ ;;
+
+ dnl Not all the architectures are tested, but there are Debian packages
+ dnl for SCM and/or Guile on them, so the technique must work. See also
+ dnl comments in alloc.c concerning setjmp and gcc.
+ dnl Fixme: it's probably safe to just use the GCC conditional below.
+ gnu-linux | gnu-kfreebsd )
+ AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#if defined __i386__ || defined __sparc__ || defined __mc68000__ \
+ || defined __alpha__ || defined __mips__ || defined __s390__ \
+ || defined __arm__ || defined __powerpc__ || defined __amd64__ \
+ || defined __ia64__ || defined __sh__
+/* ok */
+#else
+# error "setjmp not known to work on this arch"
+#endif
+ ]], [[]])], AC_DEFINE(GC_SETJMP_WORKS, 1),
+ AC_DEFINE(GC_MARK_STACK, [GC_USE_GCPROS_AS_BEFORE]) )
+ ;;
+esac
+
+
+if test x$GCC = xyes; then
+ dnl GC_SETJMP_WORKS is nearly always appropriate for GCC.
+ AC_DEFINE(GC_SETJMP_WORKS, 1)
+else
+ case $opsys in
+ dnl irix: Tested on Irix 6.5. SCM worked on earlier versions.
+ freebsd | netbsd | openbsd | irix6-5 | sol2* )
+ AC_DEFINE(GC_SETJMP_WORKS, 1)
+ ;;
+ esac
+fi dnl GCC?
+
+AC_CACHE_CHECK([for _setjmp], [emacs_cv_func__setjmp],
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <setjmp.h>
+ ]],
+ [[jmp_buf j;
+ if (! _setjmp (j))
+ _longjmp (j, 1);]])],
+ [emacs_cv_func__setjmp=yes],
+ [emacs_cv_func__setjmp=no])])
+if test $emacs_cv_func__setjmp = yes; then
+ AC_DEFINE([HAVE__SETJMP], 1, [Define to 1 if _setjmp and _longjmp work.])
+else
+ AC_CACHE_CHECK([for sigsetjmp], [emacs_cv_func_sigsetjmp],
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <setjmp.h>
+ ]],
+ [[sigjmp_buf j;
+ if (! sigsetjmp (j, 1))
+ siglongjmp (j, 1);]])],
+ [emacs_cv_func_sigsetjmp=yes],
+ [emacs_cv_func_sigsetjmp=no])])
+ if test $emacs_cv_func_sigsetjmp = yes; then
+ AC_DEFINE([HAVE_SIGSETJMP], 1,
+ [Define to 1 if sigsetjmp and siglongjmp work.
+ The value of this symbol is irrelevant if HAVE__SETJMP is defined.])
+ fi
+fi
+
+case $opsys in
+ sol2* | unixware )
+ dnl TIOCGPGRP is broken in SysVr4, so we can't send signals to PTY
+ dnl subprocesses the usual way. But TIOCSIGNAL does work for PTYs,
+ dnl and this is all we need.
+ AC_DEFINE(TIOCSIGSEND, TIOCSIGNAL, [Some platforms redefine this.])
+ ;;
+esac
+
+
+case $opsys in
+ hpux* | sol2* )
+ dnl Used in xfaces.c.
+ AC_DEFINE(XOS_NEEDS_TIME_H, 1, [Compensate for a bug in Xos.h on
+ some systems, where it requires time.h.])
+ ;;
+esac
+
+
+dnl Define symbols to identify the version of Unix this is.
+dnl Define all the symbols that apply correctly.
+AH_TEMPLATE(BSD4_2, [Define if the system is compatible with BSD 4.2.])
+AH_TEMPLATE(BSD_SYSTEM, [Define if the system is compatible with BSD 4.2.])
+AH_TEMPLATE(DOS_NT, [Define if the system is MS DOS or MS Windows.])
+AH_TEMPLATE(MSDOS, [Define if the system is MS DOS.])
+AH_TEMPLATE(USG, [Define if the system is compatible with System III.])
+AH_TEMPLATE(USG5, [Define if the system is compatible with System V.])
+AH_TEMPLATE(USG5_4, [Define if the system is compatible with System V Release 4.])
+
+case $opsys in
+ aix4-2)
+ AC_DEFINE(USG, [])
+ AC_DEFINE(USG5, [])
+ dnl This symbol should be defined on AIX Version 3 ???????
+ AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#ifndef _AIX
+# error "_AIX not defined"
+#endif
+ ]], [[]])], [], AC_DEFINE(_AIX, [], [Define if the system is AIX.]))
+ ;;
+
+ cygwin)
+ AC_DEFINE(CYGWIN, 1, [Define if the system is Cygwin.])
+ ;;
+
+ darwin)
+ dnl BSD4_3 and BSD4_4 are already defined in sys/param.h.
+ AC_DEFINE(BSD4_2, [])
+ AC_DEFINE(BSD_SYSTEM, [])
+ dnl More specific than the above two. We cannot use __APPLE__ as this
+ dnl may not be defined on non-OSX Darwin, and we cannot define DARWIN
+ dnl here because Panther and lower CoreFoundation.h uses DARWIN to
+ dnl distinguish OS X from pure Darwin.
+ AC_DEFINE(DARWIN_OS, [], [Define if the system is Darwin.])
+ ;;
+
+ freebsd)
+ AC_DEFINE(BSD4_2, [])
+ dnl Hack to avoid calling AC_PREPROC_IFELSE multiple times.
+ dnl Would not be needed with autoconf >= 2.67, where the
+ dnl preprocessed output is accessible in "conftest.i".
+ AC_DEFINE(BSD_SYSTEM_AHB, 1, [Define if AH_BOTTOM should change BSD_SYSTEM.])
+ ;;
+
+ gnu | netbsd | openbsd )
+ AC_DEFINE(BSD4_2, [])
+ AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#ifndef BSD_SYSTEM
+# error "BSD_SYSTEM not defined"
+#endif
+ ]], [[]])], [], AC_DEFINE(BSD_SYSTEM, 43) )
+ ;;
+
+ gnu-linux | gnu-kfreebsd )
+ AC_DEFINE(USG, [])
+ AC_DEFINE(GNU_LINUX, [], [Define if ths system is compatible with GNU/Linux.])
+ ;;
+
+ hpux*)
+ AC_DEFINE(USG, [])
+ AC_DEFINE(USG5, [])
+ AC_DEFINE(HPUX, [], [Define if the system is HPUX.])
+ ;;
+
+ irix6-5)
+ AC_DEFINE(USG, [])
+ AC_DEFINE(USG5, [])
+ AC_DEFINE(USG5_4, [])
+ AC_DEFINE(IRIX6_5, [], [Define if the system is IRIX.])
+ ;;
+
+ sol2*)
+ AC_DEFINE(USG, [])
+ AC_DEFINE(USG5, [])
+ AC_DEFINE(USG5_4, [])
+ AC_DEFINE(SOLARIS2, [], [Define if the system is Solaris.])
+ ;;
+
+ unixware)
+ AC_DEFINE(USG, [])
+ AC_DEFINE(USG5, [])
+ AC_DEFINE(USG5_4, [])
+ ;;
+esac
+
+AC_CACHE_CHECK([for usable FIONREAD], [emacs_cv_usable_FIONREAD],
+ [case $opsys in
+ aix4-2)
+ dnl BUILD 9008 - FIONREAD problem still exists in X-Windows.
+ emacs_cv_usable_FIONREAD=no
+ ;;
+
+ *)
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[#include <sys/types.h>
+ #include <sys/ioctl.h>
+ #ifdef USG5_4
+ # include <sys/filio.h>
+ #endif
+ ]],
+ [[int foo = ioctl (0, FIONREAD, &foo);]])],
+ [emacs_cv_usable_FIONREAD=yes],
+ [emacs_cv_usable_FIONREAD=no])
+ ;;
+ esac])
+if test $emacs_cv_usable_FIONREAD = yes; then
+ AC_DEFINE([USABLE_FIONREAD], [1], [Define to 1 if FIONREAD is usable.])
+
+ if test $emacs_broken_SIGIO = no; then
+ AC_CACHE_CHECK([for usable SIGIO], [emacs_cv_usable_SIGIO],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[#include <fcntl.h>
+ #include <signal.h>
+ ]],
+ [[int foo = SIGIO | F_SETFL | FASYNC;]])],
+ [emacs_cv_usable_SIGIO=yes],
+ [emacs_cv_usable_SIGIO=no])],
+ [emacs_cv_usable_SIGIO=yes],
+ [emacs_cv_usable_SIGIO=no])
+ if test $emacs_cv_usable_SIGIO = yes; then
+ AC_DEFINE([USABLE_SIGIO], [1], [Define to 1 if SIGIO is usable.])
+ fi
+ fi
+fi
+
+
+case $opsys in
+ dnl Emacs supplies its own malloc, but glib (part of Gtk+) calls
+ dnl memalign and on Cygwin, that becomes the Cygwin-supplied memalign.
+ dnl As malloc is not the Cygwin malloc, the Cygwin memalign always
+ dnl returns ENOSYS. A workaround is to set G_SLICE=always-malloc. */
+ cygwin)
+ AC_DEFINE(G_SLICE_ALWAYS_MALLOC, 1, [Define to set the
+ G_SLICE environment variable to "always-malloc" at startup, if
+ using GTK.])
+ ;;
+
+ hpux11)
+ dnl It works to open the pty's tty in the parent (Emacs), then
+ dnl close and reopen it in the child.
+ AC_DEFINE(USG_SUBTTY_WORKS, 1, [Define for USG systems where it
+ works to open a pty's tty in the parent process, then close and
+ reopen it in the child.])
+ ;;
+
+ irix6-5)
+ AC_DEFINE(PREFER_VSUSP, 1, [Define if process_send_signal should
+ use VSUSP instead of VSWTCH.])
+ ;;
+
+ sol2-10)
+ AC_DEFINE(_STRUCTURED_PROC, 1, [Needed for system_process_attributes
+ on Solaris.])
+ ;;
+esac
+
# Set up the CFLAGS for real compilation, so we can substitute it.
CFLAGS="$REAL_CFLAGS"
CPPFLAGS="$REAL_CPPFLAGS"
@@ -3162,6 +3997,11 @@ fi
version=$PACKAGE_VERSION
+copyright="Copyright (C) 2012 Free Software Foundation, Inc."
+AC_DEFINE_UNQUOTED(COPYRIGHT, ["$copyright"],
+ [Short copyright string for this version of Emacs.])
+AC_SUBST(copyright)
+
### Specify what sort of things we'll be editing into Makefile and config.h.
### Use configuration here uncanonicalized to avoid exceeding size limits.
AC_SUBST(version)
@@ -3178,6 +4018,8 @@ AC_SUBST(libexecdir)
AC_SUBST(mandir)
AC_SUBST(infodir)
AC_SUBST(lispdir)
+AC_SUBST(leimdir)
+AC_SUBST(standardlisppath)
AC_SUBST(locallisppath)
AC_SUBST(lisppath)
AC_SUBST(x_default_search_path)
@@ -3192,18 +4034,10 @@ AC_SUBST(gameuser)
## end of LIBX_BASE, but nothing ever set it.
AC_SUBST(LD_SWITCH_X_SITE)
AC_SUBST(C_SWITCH_X_SITE)
-AC_SUBST(C_SWITCH_X_SYSTEM)
+AC_SUBST(GNUSTEP_CFLAGS)
AC_SUBST(CFLAGS)
## Used in lwlib/Makefile.in.
AC_SUBST(X_TOOLKIT_TYPE)
-if test -n "${machfile}"; then
- M_FILE="\$(srcdir)/${machfile}"
-else
- M_FILE=
-fi
-S_FILE="\$(srcdir)/${opsysfile}"
-AC_SUBST(M_FILE)
-AC_SUBST(S_FILE)
AC_SUBST(ns_appdir)
AC_SUBST(ns_appbindir)
AC_SUBST(ns_appresdir)
@@ -3211,16 +4045,17 @@ AC_SUBST(ns_appsrc)
AC_SUBST(GNU_OBJC_CFLAGS)
AC_SUBST(OTHER_FILES)
+if test -n "${term_header}"; then
+ AC_DEFINE_UNQUOTED(TERM_HEADER, "${term_header}",
+ [Define to the header for the built-in window system.])
+fi
+
AC_DEFINE_UNQUOTED(EMACS_CONFIGURATION, "${canonical}",
[Define to the canonical Emacs configuration name.])
AC_DEFINE_UNQUOTED(EMACS_CONFIG_OPTIONS, "${ac_configure_args}",
[Define to the options passed to configure.])
-if test -n "$machfile"; then
- AC_DEFINE_UNQUOTED(config_machfile, "${machfile}",
- [Define to the used machine dependent file.])
-fi
-AC_DEFINE_UNQUOTED(config_opsysfile, "${opsysfile}",
- [Define to the used os dependent file.])
+AH_TEMPLATE(config_opsysfile, [Some platforms that do not use configure
+ define this to include extra configuration information.])
XMENU_OBJ=
XOBJ=
@@ -3229,7 +4064,7 @@ if test "${HAVE_X_WINDOWS}" = "yes" ; then
AC_DEFINE(HAVE_X_WINDOWS, 1,
[Define to 1 if you want to use the X window system.])
XMENU_OBJ=xmenu.o
- XOBJ="xterm.o xfns.o xselect.o xrdb.o fontset.o xsmfns.o fringe.o image.o xsettings.o xgselect.o"
+ XOBJ="xterm.o xfns.o xselect.o xrdb.o xsmfns.o xsettings.o xgselect.o"
FONT_OBJ=xfont.o
if test "$HAVE_XFT" = "yes"; then
FONT_OBJ="$FONT_OBJ ftfont.o xftfont.o ftxfont.o"
@@ -3357,7 +4192,7 @@ fi
AC_SUBST(RALLOC_OBJ)
if test "$opsys" = "cygwin"; then
- CYGWIN_OBJ="sheap.o"
+ CYGWIN_OBJ="sheap.o cygw32.o"
## Cygwin differs because of its unexec().
PRE_ALLOC_OBJ=
POST_ALLOC_OBJ=lastfile.o
@@ -3370,10 +4205,23 @@ AC_SUBST(CYGWIN_OBJ)
AC_SUBST(PRE_ALLOC_OBJ)
AC_SUBST(POST_ALLOC_OBJ)
-# Configure gnulib here, now that we know LIBS.
+# Configure gnulib. Although this does not affect CFLAGS or LIBS permanently.
+# it temporarily reverts them to their pre-pkg-config values,
+# because gnulib needs to work with both src (which uses the
+# pkg-config stuff) and lib-src (which does not). For example, gnulib
+# may need to determine whether LIB_CLOCK_GETTIME should contain -lrt,
+# and it therefore needs to run in an environment where LIBS does not
+# already contain -lrt merely because 'pkg-config --libs' printed '-lrt'
+# for some package unrelated to lib-src.
+SAVE_CFLAGS=$CFLAGS
+SAVE_LIBS=$LIBS
+CFLAGS=$pre_PKG_CONFIG_CFLAGS
+LIBS="$LIB_PTHREAD $pre_PKG_CONFIG_LIBS"
gl_ASSERT_NO_GNULIB_POSIXCHECK
gl_ASSERT_NO_GNULIB_TESTS
gl_INIT
+CFLAGS=$SAVE_CFLAGS
+LIBS=$SAVE_LIBS
case "$opsys" in
aix4-2) LD_SWITCH_SYSTEM_TEMACS="-Wl,-bnodelcsect" ;;
@@ -3397,8 +4245,7 @@ case "$opsys" in
## #ifndef LD_SWITCH_SYSTEM
## #if !defined (__GNUC__) && ((defined (BSD_SYSTEM) && !defined (COFF)))
## Since all the *bsds define LD_SWITCH_SYSTEM, this simplifies to:
- ## not using gcc, darwin system not on an alpha (ie darwin, since
- ## darwin + alpha does not occur).
+ ## not using gcc, darwin.
## Because this was done in src/Makefile.in, the resulting part of
## LD_SWITCH_SYSTEM was not used in configure (ie, in ac_link).
## It therefore seems cleaner to put this in LD_SWITCH_SYSTEM_TEMACS,
@@ -3407,13 +4254,14 @@ case "$opsys" in
LD_SWITCH_SYSTEM_TEMACS="-X $LD_SWITCH_SYSTEM_TEMACS"
;;
- ## LD_SWITCH_X_SITE_AUX is a -R option saying where to find X at run-time.
- ## When handled by cpp, this was in LD_SWITCH_SYSTEM. However, at
- ## the point where configure sourced the s/*.h file, LD_SWITCH_X_SITE_AUX
+ ## LD_SWITCH_X_SITE_RPATH is a -rpath option saying where to
+ ## find X at run-time.
+ ## When handled by cpp, this was in LD_SWITCH_SYSTEM. However, at the
+ ## point where configure sourced the s/*.h file, LD_SWITCH_X_SITE_RPATH
## had not yet been defined and was expanded to null. Hence LD_SWITCH_SYSTEM
## had different values in configure (in ac_link) and src/Makefile.in.
## It seems clearer therefore to put this piece in LD_SWITCH_SYSTEM_TEMACS.
- gnu-linux) LD_SWITCH_SYSTEM_TEMACS="\$(LD_SWITCH_X_SITE_AUX)" ;;
+ gnu*) LD_SWITCH_SYSTEM_TEMACS="\$(LD_SWITCH_X_SITE_RPATH)" ;;
*) LD_SWITCH_SYSTEM_TEMACS= ;;
esac
@@ -3437,12 +4285,12 @@ case "$opsys" in
## will also work on earlier NetBSD releases.
netbsd|openbsd) LD_FIRSTFLAG="-nostartfiles" ;;
- ## macpcc: NAKAJI Hiroyuki <nakaji@tutrp.tut.ac.jp> says
+ ## powerpc*: NAKAJI Hiroyuki <nakaji@tutrp.tut.ac.jp> says
## MkLinux/LinuxPPC needs this.
- ## ibms390x only supports opsys = gnu-linux so it can be added here.
+ ## s390x-* only supports opsys = gnu-linux so it can be added here.
gnu-*)
- case "$machine" in
- macppc|ibms390x) LD_FIRSTFLAG="-nostdlib" ;;
+ case "$canonical" in
+ powerpc*|s390x-*) LD_FIRSTFLAG="-nostdlib" ;;
esac
;;
esac
@@ -3454,7 +4302,7 @@ if test "x$ORDINARY_LINK" = "xyes"; then
AC_DEFINE(ORDINARY_LINK, 1, [Define if the C compiler is the linker.])
## The system files defining neither ORDINARY_LINK nor LD_FIRSTFLAG are:
-## freebsd, gnu-* not on macppc|ibms390x.
+## freebsd, gnu-* not on powerpc*|s390x*.
elif test "x$GCC" = "xyes" && test "x$LD_FIRSTFLAG" = "x"; then
## Versions of GCC >= 2.0 put their library, libgcc.a, in obscure
@@ -3506,17 +4354,17 @@ if test "x$GCC" = "xyes" && test "x$ORDINARY_LINK" != "xyes"; then
fi dnl if $GCC
AC_SUBST(LIB_GCC)
-
-## If we're using X11/GNUstep, define some consequences.
-if test "$HAVE_X_WINDOWS" = "yes" || test "$HAVE_NS" = "yes"; then
+## Common for all window systems
+if test "$window_system" != "none"; then
AC_DEFINE(HAVE_WINDOW_SYSTEM, 1, [Define if you have a window system.])
- AC_DEFINE(HAVE_MOUSE, 1, [Define if you have mouse support.])
+ WINDOW_SYSTEM_OBJ="fontset.o fringe.o image.o"
fi
+AC_SUBST(WINDOW_SYSTEM_OBJ)
AH_TOP([/* GNU Emacs site configuration template file.
-Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2011
+Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -3542,135 +4390,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define EMACS_CONFIG_H
])dnl
-AH_BOTTOM([
-/* On AIX 3 this must be included before any other include file. */
-#include <alloca.h>
-#if ! HAVE_ALLOCA
-# error "alloca not available on this machine"
-#endif
-
-/* Define AMPERSAND_FULL_NAME if you use the convention
- that & in the full name stands for the login id. */
-/* Turned on June 1996 supposing nobody will mind it. */
-#define AMPERSAND_FULL_NAME
-
-/* `subprocesses' should be defined if you want to
- have code for asynchronous subprocesses
- (as used in M-x compile and M-x shell).
- Only MSDOS does not support this (it overrides
- this in its config_opsysfile below). */
-
-#define subprocesses
-
-/* Include the os and machine dependent files. */
-#include config_opsysfile
-#ifdef config_machfile
-# include config_machfile
-#endif
-
-/* GNUstep needs a bit more pure memory. Of the existing knobs,
- SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems.
- (There is probably a better place to do this, but right now the
- Cocoa side does this in s/darwin.h and we cannot parallel this
- exactly since GNUstep is multi-OS. */
-#if defined HAVE_NS && defined NS_IMPL_GNUSTEP
-# define SYSTEM_PURESIZE_EXTRA 30000
-#endif
-
-#ifdef emacs /* Don't do this for lib-src. */
-/* Tell regex.c to use a type compatible with Emacs. */
-#define RE_TRANSLATE_TYPE Lisp_Object
-#define RE_TRANSLATE(TBL, C) CHAR_TABLE_TRANSLATE (TBL, C)
-#ifdef make_number
-/* If make_number is a macro, use it. */
-#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0)))
-#else
-/* If make_number is a function, avoid it. */
-#define RE_TRANSLATE_P(TBL) (!(INTEGERP (TBL) && XINT (TBL) == 0))
-#endif
-#endif
-
-/* These default definitions are good for almost all machines.
- Any exceptions should override them in m/MACHINE.h.
- They must be usable in preprocessor conditionals. */
-
-#ifndef BITS_PER_CHAR
-#define BITS_PER_CHAR 8
-#endif
-
-#ifndef BITS_PER_SHORT
-#define BITS_PER_SHORT 16
-#endif
-
-#ifndef BITS_PER_INT
-#define BITS_PER_INT 32
-#endif
-
-#ifndef BITS_PER_LONG
-#ifdef _LP64
-#define BITS_PER_LONG 64
-#else
-#define BITS_PER_LONG 32
-#endif
-#endif
-
-#if !defined BITS_PER_LONG_LONG && HAVE_LONG_LONG_INT
-#define BITS_PER_LONG_LONG 64
-#endif
-
-/* Define if the compiler supports function prototypes. It may do so but
- not define __STDC__ (e.g. DEC C by default) or may define it as zero. */
-#undef PROTOTYPES
-
-#include <string.h>
-#include <stdlib.h>
-
-#if defined __GNUC__ && (__GNUC__ > 2 \
- || (__GNUC__ == 2 && __GNUC_MINOR__ >= 5))
-#define NO_RETURN __attribute__ ((__noreturn__))
-#else
-#define NO_RETURN /* nothing */
-#endif
-
-#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */
-#define NO_INLINE __attribute__((noinline))
-#else
-#define NO_INLINE
-#endif
-
-#if (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1))
-#define EXTERNALLY_VISIBLE __attribute__((externally_visible))
-#else
-#define EXTERNALLY_VISIBLE
-#endif
-
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
-# define ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
-#else
-# define ATTRIBUTE_FORMAT(spec) /* empty */
-#endif
-
-#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__gnu_printf__, formatstring_parameter, first_argument))
-#else
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument))
-#endif
-
-/* Some versions of GNU/Linux define noinline in their headers. */
-#ifdef noinline
-#undef noinline
-#endif
-
-/* These won't be used automatically yet. We also need to know, at least,
- that the stack is continuous. */
-#ifdef __GNUC__
-# ifndef GC_SETJMP_WORKS
- /* GC_SETJMP_WORKS is nearly always appropriate for GCC. */
-# define GC_SETJMP_WORKS 1
-# endif
-#endif
+AH_BOTTOM([#include <conf_post.h>
#endif /* EMACS_CONFIG_H */
@@ -3686,20 +4406,13 @@ End:
#### It makes printing result more understandable as using GTK sets
#### toolkit_scroll_bars to yes by default.
if test "${HAVE_GTK}" = "yes"; then
- USE_X_TOOLKIT=GTK
-fi
-
-and_machfile=
-if test -n "$machfile"; then
- and_machfile=" and \`${machfile}'"
+ USE_X_TOOLKIT="$USE_GTK_TOOLKIT"
fi
echo "
Configured for \`${canonical}'.
Where should the build process find the source code? ${srcdir}
- What operating system and machine description files should Emacs use?
- \`${opsysfile}'${and_machfile}
What compiler should emacs be built with? ${CC} ${CFLAGS}
Should Emacs use the GNU version of malloc? ${GNU_MALLOC}${GNU_MALLOC_reason}
Should Emacs use a relocating allocator for buffers? ${REL_ALLOC}
@@ -3750,11 +4463,6 @@ if test -n "${EMACSDOC}"; then
echo " Environment variable EMACSDOC set to: $EMACSDOC"
fi
-if test $USE_XASSERTS = yes; then
- echo " Compiling with asserts turned on."
- CPPFLAGS="$CPPFLAGS -DXASSERTS=1"
-fi
-
echo
if test "$HAVE_NS" = "yes"; then
@@ -3772,6 +4480,13 @@ to run if these resources are not installed."
echo
fi
+if test "${opsys}" = "cygwin"; then
+ case `uname -r` in
+ 1.5.*) AC_MSG_WARN([[building Emacs on Cygwin 1.5 is not supported.]])
+ echo
+ ;;
+ esac
+fi
# Remove any trailing slashes in these variables.
[test "${prefix}" != NONE &&
@@ -3779,6 +4494,16 @@ fi
test "${exec_prefix}" != NONE &&
exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'`]
+if test "$HAVE_NS" = "yes"; then
+ if test "$NS_IMPL_GNUSTEP" = yes; then
+ AC_CONFIG_FILES([nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist:nextstep/templates/Info-gnustep.plist.in \
+ nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop:nextstep/templates/Emacs.desktop.in])
+ else
+ AC_CONFIG_FILES([nextstep/Cocoa/Emacs.base/Contents/Info.plist:nextstep/templates/Info.plist.in \
+ nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:nextstep/templates/InfoPlist.strings.in])
+ fi
+fi
+
dnl Obviously there is duplication here wrt $SUBDIR_MAKEFILES.
dnl You _can_ use that variable in AC_CONFIG_FILES, so long as any directory
dnl using automake (ie lib/) is explicitly listed and not "hidden" in a variable
@@ -3787,12 +4512,12 @@ dnl This will work, but you get a config.status that is not quite right
dnl (see http://lists.gnu.org/archive/html/bug-autoconf/2008-08/msg00028.html).
dnl That doesn't have any obvious consequences for Emacs, but on the whole
dnl it seems better to just live with the duplication.
-SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile"
+SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile nextstep/Makefile"
AC_CONFIG_FILES([Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile \
doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile \
doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile \
- leim/Makefile])
+ leim/Makefile nextstep/Makefile])
dnl test/ is not present in release tarfiles.
opt_makefile=test/automated/Makefile
@@ -3804,6 +4529,16 @@ if test -f $srcdir/${opt_makefile}.in; then
AC_CONFIG_FILES([test/automated/Makefile])
fi
+
+dnl admin/ may or may not be present.
+opt_makefile=admin/unidata/Makefile
+
+if test -f $srcdir/${opt_makefile}.in; then
+ SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES $opt_makefile"
+ AC_CONFIG_FILES([admin/unidata/Makefile])
+fi
+
+
SUBDIR_MAKEFILES_IN=`echo " ${SUBDIR_MAKEFILES}" | sed -e 's| | $(srcdir)/|g' -e 's|Makefile|Makefile.in|g'`
AC_SUBST(SUBDIR_MAKEFILES_IN)
@@ -3825,8 +4560,8 @@ dnl by configure. This also explains the `move-if-change' test and
dnl the use of force in the `epaths-force' rule in Makefile.in.
AC_CONFIG_COMMANDS([epaths], [
echo creating src/epaths.h
-${MAKE-make} epaths-force
-], [GCC="$GCC" NON_GNU_CPP="$NON_GNU_CPP" CPP="$CPP" CPPFLAGS="$CPPFLAGS"])
+${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force
+], [GCC="$GCC" CPPFLAGS="$CPPFLAGS"])
AC_CONFIG_COMMANDS([gdbinit], [
if test ! -f src/.gdbinit && test -f $srcdir/src/.gdbinit; then
@@ -3836,5 +4571,3 @@ fi
])
AC_OUTPUT
-
-dnl configure.in ends here
diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog
index 7857295de92..5c4ae2e1ee0 100644
--- a/doc/emacs/ChangeLog
+++ b/doc/emacs/ChangeLog
@@ -1,7 +1,997 @@
+2012-11-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ * doclicense.texi, gpl.texi: Update to latest version from FSF.
+ These are just minor editorial changes.
+
+2012-11-21 Dani Moncayo <dmoncayo@gmail.com>
+
+ * display.texi (Auto Scrolling): Fix some inaccuracies, plus
+ clarifications (Bug#12865).
+ (Horizontal Scrolling): Clarifications.
+
+2012-11-18 Dani Moncayo <dmoncayo@gmail.com>
+
+ * mark.texi (Disabled Transient Mark): Doc fixes (Bug#12746).
+
+2012-11-16 Eli Zaretskii <eliz@gnu.org>
+
+ * trouble.texi (Crashing): Add information about MS-Windows and
+ the emacs_backtrace.txt file. (Bug#12908)
+
+2012-11-13 Chong Yidong <cyd@gnu.org>
+
+ * building.texi (Multithreaded Debugging): gdb-stopped-hooks is
+ actually named gdb-stopped-functions.
+
+2012-11-13 Glenn Morris <rgm@gnu.org>
+
+ * misc.texi (Single Shell): Mention async-shell-command-buffer.
+
+2012-11-10 Glenn Morris <rgm@gnu.org>
+
+ * misc.texi (Terminal emulator): Rename `term-face' to `term'.
+
+ * emacs.texi (Acknowledgments): Add profiler author.
+ * ack.texi (Acknowledgments): Add some recent contributions.
+
+2012-11-10 Chong Yidong <cyd@gnu.org>
+
+ * files.texi (Diff Mode): Doc fixes for
+ diff-delete-trailing-whitespace (Bug#12831).
+
+ * trouble.texi (Crashing): Copyedits.
+
+2012-11-10 Glenn Morris <rgm@gnu.org>
+
+ * files.texi (Diff Mode): Trailing whitespace updates.
+
+2012-11-10 Chong Yidong <cyd@gnu.org>
+
+ * misc.texi (Terminal emulator): Document Term mode faces.
+
+ * mini.texi (Basic Minibuffer): New node. Document
+ minibuffer-electric-default-mode.
+
+ * display.texi (Visual Line Mode): Fix index entry.
+
+ * buffers.texi (Several Buffers): List Buffer Menu command anmes,
+ and index the keybindings. Document tabulated-list-sort.
+ (Kill Buffer): Capitalize Buffer Menu.
+
+ * trouble.texi (Memory Full): Capitalize Buffer Menu.
+
+2012-11-10 Eli Zaretskii <eliz@gnu.org>
+
+ * display.texi (Auto Scrolling): Clarify that scroll-step is
+ ignored when scroll-conservatively is set to a non-zero value.
+ (Bug#12801)
+
+2012-11-10 Chong Yidong <cyd@gnu.org>
+
+ * dired.texi (Dired Updating): Doc fix (Bug#11744).
+
+2012-10-30 Michael Albinus <michael.albinus@gmx.de>
+
+ * trouble.texi (Known Problems): Mention command `debbugs-gnu-usertags'.
+
+2012-10-29 Chong Yidong <cyd@gnu.org>
+
+ * dired.texi (Shell Commands in Dired): Document changes to the
+ dired-do-async-shell-command.
+
+2012-10-28 Glenn Morris <rgm@gnu.org>
+
+ * ack.texi (Acknowledgments): Mention gv.el.
+
+2012-10-27 Bastien Guerry <bzg@gnu.org>
+
+ * screen.texi (Menu Bar): Fix typo.
+
+2012-10-27 Chong Yidong <cyd@gnu.org>
+
+ * frames.texi (Mouse Avoidance): Mention new variable
+ mouse-avoidance-banish-position.
+
+ * programs.texi (Which Function): Which Function mode now works in
+ all major modes by default.
+
+ * mule.texi (Recognize Coding): Remove an unreferenced vindex.
+
+ * files.texi (Misc File Ops): Symbolic links on Windows only work
+ on Vista and later.
+
+ * building.texi (Compilation): Document compilation-always-kill.
+
+ * search.texi (Symbol Search): New node.
+
+ * package.texi (Package Menu): Document the "new" status.
+
+ * windows.texi (Window Choice): Don't refer to the obsolete
+ special-display feature.
+
+2012-10-24 Chong Yidong <cyd@gnu.org>
+
+ * mule.texi (Text Coding): set-buffer-file-coding-system can now
+ be invoked from the mode line.
+
+ * dired.texi (Dired Deletion, Marks vs Flags): Document Emacs 24.3
+ changes to the mark and unmark commands.
+ (Comparison in Dired): Document chages to dired-diff. Remove M-=,
+ which is no longer bound to dired-backup-diff.
+
+2012-10-23 Bastien Guerry <bzg@gnu.org>
+
+ * text.texi (Org Authoring): Use a comma after @ref to avoid the
+ insertion of a period in the Info output.
+
+2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * custom.texi (Hooks): Clarify that -hooks is deprecated.
+
+2012-10-23 Chong Yidong <cyd@gnu.org>
+
+ * kmacro.texi (Edit Keyboard Macro): Fix typo.
+
+2012-10-18 Dani Moncayo <dmoncayo@gmail.com>
+
+ * mini.texi (Completion Options): Fix off-by-one error. (Bug#12644)
+
+2012-10-17 Glenn Morris <rgm@gnu.org>
+
+ * mini.texi (Repetition): Further copyedit.
+
+2012-10-17 Dani Moncayo <dmoncayo@gmail.com>
+
+ * mini.texi (Repetition): Copyedit.
+
+2012-10-16 Juri Linkov <juri@jurta.org>
+
+ * search.texi (Query Replace): Document multi-buffer replacement
+ keys. (Bug#12655)
+
+ * maintaining.texi (Tags Search): Change link "Replace" to
+ "Query Replace".
+
+2012-10-13 Chong Yidong <cyd@gnu.org>
+
+ * files.texi (File Conveniences): ImageMagick enabled by default.
+
+2012-10-10 Dani Moncayo <dmoncayo@gmail.com>
+
+ * basic.texi (Arguments): Fix typos.
+
+2012-10-08 Glenn Morris <rgm@gnu.org>
+
+ * cal-xtra.texi (Calendar Customizing): Mention calendar-month-header.
+
+ * calendar.texi (Writing Calendar Files): Mention cal-html-holidays.
+
+2012-10-06 Glenn Morris <rgm@gnu.org>
+
+ * calendar.texi (Writing Calendar Files): Tweak week descriptions.
+ Mention cal-tex-cursor-week2-summary.
+
+2012-10-06 Chong Yidong <cyd@gnu.org>
+
+ * mini.texi (Passwords): Fix typo.
+
+2012-10-02 Glenn Morris <rgm@gnu.org>
+
+ * maintaining.texi (VC Directory Commands):
+ Remove duplicate `q' entry. (Bug#12553)
+
+2012-09-30 Chong Yidong <cyd@gnu.org>
+
+ * killing.texi (Rectangles): Document copy-rectangle-as-kill.
+
+ * search.texi (Special Isearch): Document the lax space search
+ feature and M-s SPC.
+ (Regexp Search): Move main search-whitespace-regexp description to
+ Special Isearch.
+ (Replace): Document replace-lax-whitespace.
+
+ * basic.texi (Position Info): Document C-u M-=.
+ (Moving Point): Document move-to-column.
+
+ * display.texi (Useless Whitespace): Add delete-trailing-lines.
+
+ * misc.texi (emacsclient Options): Document the effect of
+ initial-buffer-choice on client frames. Document server-auth-dir.
+ Do not document server-host, which is bad security practice.
+
+ * building.texi (Lisp Libraries): Docstring lookups can trigger
+ autoloading. Document help-enable-auto-load.
+
+ * mini.texi (Yes or No Prompts): New node.
+
+ * ack.texi (Acknowledgments): Remove obsolete packages.
+
+2012-09-27 Glenn Morris <rgm@gnu.org>
+
+ * cal-xtra.texi (Advanced Calendar/Diary Usage):
+ Rename the section to be more general.
+ * emacs.texi: Update menu.
+
+2012-09-23 Chong Yidong <cyd@gnu.org>
+
+ * buffers.texi (Misc Buffer): Replace toggle-read-only with
+ read-only-mode.
+
+ * files.texi (Visiting): Likewise.
+
+2012-09-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * trouble.texi (Crashing): Document ulimit -c.
+
+2012-09-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ * trouble.texi (Crashing): Document addr2line.
+
+2012-09-19 Chong Yidong <cyd@gnu.org>
+
+ * killing.texi (Yanking): Minor clarification (Bug#12469).
+
+2012-09-17 Chong Yidong <cyd@gnu.org>
+
+ * building.texi (GDB User Interface Layout): Remove reference to
+ removed variable gdb-use-separate-io-buffer (Bug#12454).
+
+2012-09-08 Jambunathan K <kjambunathan@gmail.com>
+
+ * regs.texi (Text Registers): `C-x r +' can now be used instead of
+ M-x append-to-register. New option `register-separator'.
+ (Number Registers): Mention that `C-x r +' is polymorphic.
+
+2012-09-07 Chong Yidong <cyd@gnu.org>
+
+ * windows.texi (Window Choice): Don't mention obsolete
+ display-buffer-reuse-frames.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Give more-useful info on a fatal error (Bug#12328).
+ * trouble.texi (Crashing): New section, documenting this.
+
+2012-08-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * cmdargs.texi (General Variables):
+ Setting $DBUS_SESSION_BUS_ADDRESS to a dummy value suppresses
+ connections to the D-Bus session bus. (Bug#12112)
+
+2012-08-14 Eli Zaretskii <eliz@gnu.org>
+
+ * building.texi (Debugger Operation): Correct and improve
+ documentation of the GUD Tooltip mode.
+
+2012-07-31 Chong Yidong <cyd@gnu.org>
+
+ * emacs.texi: Fix ISBN (Bug#12080).
+
+2012-08-05 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Faces): Document frame-background-mode (Bug#7774).
+
+ * custom.texi (Face Customization): Move discussion of face
+ inheritance here, from Faces section.
+
+2012-07-28 Eli Zaretskii <eliz@gnu.org>
+
+ * frames.texi (Mouse Commands): Fix the description of mouse-2.
+ (Bug#11958)
+
+2012-07-19 Chong Yidong <cyd@gnu.org>
+
+ * emacs.texi: Update ISBN.
+
+2012-07-17 Chong Yidong <cyd@gnu.org>
+
+ * basic.texi (Inserting Text): Replace ucs-insert with
+ insert-char. Provide more details of input.
+
+ * mule.texi (International Chars, Input Methods): Likewise.
+
+2012-07-13 Chong Yidong <cyd@gnu.org>
+
+ * custom.texi (Examining): Update C-h v message.
+
+ * buffers.texi (Misc Buffer): Document view-read-only.
+
+2012-07-07 Chong Yidong <cyd@gnu.org>
+
+ * custom.texi (Init File): Index site-lisp (Bug#11435).
+
+2012-07-06 Chong Yidong <cyd@gnu.org>
+
+ * emacs.texi: Re-order top-level menu to correspond to logical
+ order, to avoid makeinfo warnings.
+
+ * ack.texi (Acknowledgments): Note new python.el.
+
+2012-06-29 Chong Yidong <cyd@gnu.org>
+
+ * maintaining.texi (Basic VC Editing, VC Pull, Merging):
+ * basic.texi (Erasing, Basic Undo): Fix markup.
+
+2012-06-29 Glenn Morris <rgm@gnu.org>
+
+ * fixit.texi (Undo): Grammar fixes. (Bug#11779)
+
+2012-06-29 Michael Witten <mfwitten@gmail.com> (tiny change)
+
+ * fixit.texi (Undo): Fix typo. (Bug#11775)
+
+2012-06-27 Glenn Morris <rgm@gnu.org>
+
+ * ack.texi (Acknowledgments): Tiny update.
+
+2012-06-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737)
+
+2012-06-17 Chong Yidong <cyd@gnu.org>
+
+ * emacs.texi: Remove urlcolor setting. Update ISBN and edition number.
+
+ * anti.texi:
+ * building.texi:
+ * cmdargs.texi:
+ * custom.texi:
+ * display.texi:
+ * files.texi:
+ * frames.texi:
+ * glossary.texi:
+ * misc.texi:
+ * mule.texi:
+ * programs.texi:
+ * sending.texi:
+ * text.texi: Copyedits to avoid underfull/overfull in 7x9 manual.
+
+2012-06-06 Michael Albinus <michael.albinus@gmx.de>
+
+ * custom.texi (Directory Variables): Mention enable-remote-dir-locals.
+
+2012-05-28 Glenn Morris <rgm@gnu.org>
+
+ * ack.texi, building.texi, calendar.texi, custom.texi:
+ * maintaining.texi, text.texi: Use @LaTeX rather than La@TeX.
+
+2012-05-27 Glenn Morris <rgm@gnu.org>
+
+ * emacs.texi: Simplify following removal of node pointers.
+
+ * ack.texi, anti.texi, basic.texi, buffers.texi, building.texi:
+ * cmdargs.texi, commands.texi, display.texi, emacs.texi:
+ * entering.texi, files.texi, fixit.texi, frames.texi, glossary.texi:
+ * gnu.texi, help.texi, indent.texi, killing.texi, kmacro.texi:
+ * m-x.texi, macos.texi, maintaining.texi, mark.texi, mini.texi:
+ * misc.texi, modes.texi, msdog.texi, mule.texi, programs.texi:
+ * regs.texi, screen.texi, search.texi, text.texi, trouble.texi:
+ * windows.texi, xresources.texi: Nuke hand-written node pointers.
+
+2012-05-22 Glenn Morris <rgm@gnu.org>
+
+ * emacs.texi (Acknowledgments): Add another contributor.
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MKDIR_P): New, set by configure.
+ (mkinfodir): Use $MKDIR_P.
+
+2012-05-10 Glenn Morris <rgm@gnu.org>
+
+ * mule.texi (Disabling Multibyte): Replace the obsolete "unibyte: t"
+ with "coding: raw-text".
+
+ * files.texi (Interlocking): Mention create-lockfiles option.
+
+2012-05-09 Chong Yidong <cyd@gnu.org>
+
+ * frames.texi (Mouse References, Mouse Commands): Fix index
+ entries (Bug#11362).
+
+2012-05-05 Glenn Morris <rgm@gnu.org>
+
+ * custom.texi (Customization Groups, Custom Themes, Examining):
+ Improve page breaks.
+
+ * rmail.texi (Rmail Display): Use example rather than smallexample.
+
+ * calendar.texi: Convert inforefs to refs.
+
+ * dired.texi (Dired Enter): Improve page break.
+
+ * abbrevs.texi (Abbrev Concepts): Copyedits.
+
+ * maintaining.texi (Registering, Tag Syntax):
+ Tweak line and page breaks.
+
+ * programs.texi (Programs, Electric C): Copyedits.
+ (Program Modes): Add xref to Fortran.
+ (Left Margin Paren): Remove what was (oddly enough) the only use
+ of defvar in the entire Emacs manual.
+ (Hungry Delete): Remove footnote about ancient Emacs version.
+ (Other C Commands): Use example rather than smallexample.
+
+ * text.texi (Pages, Filling, Foldout, Org Mode, HTML Mode)
+ (Nroff Mode, Enriched Indentation, Table Rows and Columns):
+ Tweak line and page breaks.
+
+ * modes.texi (Major Modes, Minor Modes): Reword to improve page-breaks.
+ (Major Modes): Use example rather than smallexample.
+
+ * mule.texi (Output Coding): Reword to improve page-breaks.
+
+ * frames.texi (Fonts): Tweak line and page breaks.
+ Use example rather than smallexample. Change cross-reference.
+ (Text-Only Mouse): Fix xref.
+
+ * buffers.texi (Buffers, Kill Buffer, Several Buffers)
+ (Indirect Buffers): Tweak line- and page-breaks.
+
+ * fixit.texi (Fixit, Undo): Reword to improve page-breaks.
+
+2012-05-04 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (INFO_EXT, INFO_OPTS): New, set by configure.
+ (info, infoclean): Use $INFO_EXT.
+ ($(infodir)/emacs$(INFO_EXT)): Use $INFO_EXT and $INFO_OPT.
+ * makefile.w32-in (INFO_EXT, INFO_OPTS): New.
+ (INFO_TARGETS): Use $INFO_EXT.
+ ($(infodir)/emacs$(INFO_EXT)): Use $INFO_EXT and $INFO_OPT, and -o.
+
+2012-05-02 Glenn Morris <rgm@gnu.org>
+
+ * emacs.texi (@copying): Only print EDITION in the TeX version.
+
+ * search.texi (Regexp Search): Just say "Emacs".
+
+ * display.texi (Auto Scrolling):
+ Reword to avoid repetition and improve page break.
+
+ * xresources.texi (Resources):
+ * mule.texi (Language Environments):
+ * misc.texi (Amusements):
+ * maintaining.texi (VC Change Log):
+ * frames.texi (Fonts):
+ * custom.texi (Specifying File Variables, Minibuffer Maps):
+ * cmdargs.texi (Initial Options):
+ * building.texi (Flymake):
+ Reword to remove/reduce some overly long/short lines.
+
+2012-04-27 Glenn Morris <rgm@gnu.org>
+
+ * emacs.texi: Some fixes for detailed menu.
+
+ * emacs.texi: Add "et al." to authors.
+
+ * ack.texi, basic.texi, buffers.texi, building.texi:
+ * calendar.texi, cmdargs.texi, commands.texi, custom.texi:
+ * dired.texi, display.texi, emerge-xtra.texi, files.texi:
+ * fortran-xtra.texi, help.texi, kmacro.texi, mini.texi, misc.texi:
+ * msdog-xtra.texi, picture-xtra.texi, programs.texi, rmail.texi:
+ * search.texi, trouble.texi, windows.texi:
+ Use Texinfo recommended convention for quotes+punctuation.
+
+2012-04-27 Eli Zaretskii <eliz@gnu.org>
+
+ * mule.texi (Bidirectional Editing): Improve indexing.
+ Minor wording tweaks.
+
+2012-04-15 Chong Yidong <cyd@gnu.org>
+
+ * misc.texi (emacsclient Options): More clarifications.
+
+2012-04-15 Glenn Morris <rgm@gnu.org>
+
+ * msdog.texi (Windows Printing): It doesn't set printer-name.
+
+ * mule.texi (Language Environments): Move font info to "Fontsets".
+ (Fontsets): Move intlfonts etc here from "Language Environments".
+ Copyedits.
+ (Defining Fontsets, Modifying Fontsets, Undisplayable Characters)
+ (Unibyte Mode, Charsets, Bidirectional Editing): Copyedits.
+
+2012-04-15 Chong Yidong <cyd@gnu.org>
+
+ * glossary.texi (Glossary): Standardize on "text terminal"
+ terminology. All callers changed.
+
+ * misc.texi (emacsclient Options): Document "client frame" concept
+ and its effect on C-x C-c more carefully.
+
+2012-04-15 Glenn Morris <rgm@gnu.org>
+
+ * frames.texi (Scroll Bars):
+ * glossary.texi (Glossary): Use consistent case for "X Window System".
+
+ * mule.texi (Select Input Method, Coding Systems):
+ State command names in kbd tables.
+ (Recognize Coding): Add cross-ref.
+ (Output Coding): Don't mention message mode in particular.
+ (Text Coding, Communication Coding, File Name Coding, Terminal Coding):
+ Copyedits.
+
+2012-04-14 Glenn Morris <rgm@gnu.org>
+
+ * mule.texi (Select Input Method, Coding Systems, Recognize Coding):
+ Copyedits.
+ (Coding Systems): Mac OS X apparently uses newlines for EOL.
+ (Recognize Coding): Remove old auto-coding-regexp-alist example.
+ auto-coding-functions does not override coding: tags.
+ Remove rmail-decode-mime-charset; it no longer has any effect.
+
+2012-04-14 Chong Yidong <cyd@gnu.org>
+
+ * custom.texi (Creating Custom Themes): Add reference to Custom
+ Themes node in Lisp manual.
+
+2012-04-14 Glenn Morris <rgm@gnu.org>
+
+ * mule.texi (International): Copyedits.
+ (International Chars): Update C-x = example output.
+ (Disabling Multibyte): Rename from "Enabling Multibyte".
+ Clarify what "unibyte: t" does, and mode-line description.
+ (Unibyte Mode): Update for "Disabling Multibyte" node name change.
+ Use Texinfo recommended convention for quotes+punctuation.
+ (Language Environments): Copyedits.
+ (Input Methods): Copyedits. Use "^" for the postfix example,
+ because it is less confusing inside Info's `quotes'.
+
+ * custom.texi (Specifying File Variables): Fix "unibyte" description.
+ Update for "Disabling Multibyte" node name change.
+ * emacs.texi: Update for "Disabling Multibyte" node name change.
+
+ * abbrevs.texi, arevert-xtra.texi, buffers.texi, building.texi:
+ * cmdargs.texi, custom.texi, entering.texi, files.texi, frames.texi:
+ * glossary.texi, help.texi, macos.texi, maintaining.texi, mini.texi:
+ * misc.texi, package.texi, programs.texi, screen.texi, search.texi:
+ * sending.texi, text.texi, trouble.texi:
+ Use @file for buffers, per the Texinfo manual.
+
+ * entering.texi (Entering Emacs):
+ Do not mention initial-buffer-choice = t.
+
+ * misc.texi (Gnus Startup): Use @env for environment variables.
+
+ * Makefile.in: Replace non-portable use of $< in ordinary rules.
+
+2012-04-12 Glenn Morris <rgm@gnu.org>
+
+ * ack.texi (Acknowledgments): Don't mention obsolete mailpost.el.
+
+2012-04-07 Glenn Morris <rgm@gnu.org>
+
+ * emacsver.texi (EMACSVER): Bump version to 24.1.50.
+
+2012-04-05 Glenn Morris <rgm@gnu.org>
+
+ * glossary.texi (Glossary): Use anchors for internal cross-references.
+
+2012-04-04 Glenn Morris <rgm@gnu.org>
+
+ * glossary.texi (Glossary): Copyedits.
+ Use Texinfo-recommended convention for quotes and punctuation.
+ Comment out a few specialized (Rmail) items.
+ New items: Bidirectional Text, Client, Directory Local Variable,
+ File Local Variable, Package, Server, Theme, Trash Can.
+
+2012-04-03 Chong Yidong <cyd@gnu.org>
+
+ * sending.texi (Mail Misc): Fix an index entry.
+
+2012-04-02 Eli Zaretskii <eliz@gnu.org>
+
+ * msdog.texi (Windows Startup): Add description of emacsclient
+ operation under -c and -t on MS-Windows.
+
+ * misc.texi (emacsclient Options): Add cross-reference to "Windows
+ Startup". (Bug#11091)
+
+2012-04-02 Dani Moncayo <dmoncayo@gmail.com>
+
+ * custom.texi (Changing a Variable): Fix example.
+
+2012-04-01 Eli Zaretskii <eliz@gnu.org>
+
+ * misc.texi (emacsclient Options): More clarifications about -t
+ and -c on MS-Windows. (Bug#11091)
+
+2012-03-31 Eli Zaretskii <eliz@gnu.org>
+
+ * misc.texi (emacsclient Options): Document peculiarities of new
+ frame creation on MS-Windows under -c or -t options. (Bug#11091)
+
+2012-03-30 Chong Yidong <cyd@gnu.org>
+
+ * files.texi (File Conveniences): Clarify Imagemagick discussion.
+
+2012-03-22 Glenn Morris <rgm@gnu.org>
+
+ * dired.texi (Operating on Files): Fix dired-recursive-copies default.
+
+2012-03-17 Chong Yidong <cyd@gnu.org>
+
+ * package.texi (Package Installation): Document use of
+ package-initialize in init file.
+
+2012-03-16 Glenn Morris <rgm@gnu.org>
+
+ * help.texi (Language Help):
+ * mule.texi (International Chars):
+ etc/HELLO is for character demonstration.
+
+2012-03-15 Dani Moncayo <dmoncayo@gmail.com>
+
+ * dired.texi (Shell Commands in Dired): Fix typo.
+
+2012-03-04 Chong Yidong <cyd@gnu.org>
+
+ * killing.texi (Clipboard): Document clipboard manager.
+
+2012-02-29 Glenn Morris <rgm@gnu.org>
+
+ * ack.texi (Acknowledgments): Use @Tex{} in more places.
+
+ * emacs.texi, help.texi, text.texi: Use "" quotes in menus.
+
+ * dired.texi, emacs.texi: Use @code{} in menus when appropriate.
+
+2012-02-28 Glenn Morris <rgm@gnu.org>
+
+ * custom.texi, display.texi, emacs.texi, files.texi:
+ * msdog-xtra.texi, msdog.texi, vc-xtra.texi:
+ Standardize possessive apostrophe usage.
+
+2012-02-25 Jan Djärv <jan.h.d@swipnet.se>
+
+ * macos.texi (Mac / GNUstep Customization): Remove text about
+ ns-find-file and ns-drag-file (Bug#5855, Bug#10050).
+
+2012-02-25 Dani Moncayo <dmoncayo@gmail.com>
+
+ * buffers.texi (Select Buffer): Mention that saving in a new file
+ name can switch to a different major mode.
+
+2012-02-23 Glenn Morris <rgm@gnu.org>
+
+ * mini.texi (Minibuffer File, Completion Options, Repetition):
+ Copyedits.
+ (Completion Example): Other M-x au* commands may be defined.
+ (Completion Styles): Mention emacs21 and completion-category-overrides.
+
+ * msdog.texi (Text and Binary, ls in Lisp, Windows HOME)
+ (Windows Keyboard, Windows Mouse, Windows Processes)
+ (Windows Printing, Windows Misc): Copyedits.
+ (ls in Lisp): Update switches list.
+
+ * msdog-xtra.texi (MS-DOS Display): Update list-colors-display xref.
+ Update dos-mode* function names.
+ (MS-DOS Printing, MS-DOS and MULE): Copyedits.
+ (MS-DOS Processes): Add xref to main ls-lisp section.
+
+ * ack.texi (Acknowledgments): Mention smie.
+
+2012-02-22 Glenn Morris <rgm@gnu.org>
+
+ * macos.texi: Copyedits. Fix @key/@kbd usage.
+ (Mac / GNUstep Basics): Don't mention the panels, since the next
+ section covers them.
+ (Mac / GNUstep Customization): Merge some panel info from previous.
+
+2012-02-21 Glenn Morris <rgm@gnu.org>
+
+ * emerge-xtra.texi (Emerge, Submodes of Emerge, Combining in Emerge):
+ Small fixes.
+
+ * emacs-xtra.texi: Picture mode is no longer a chapter.
+
+ * picture-xtra.texi (Basic Picture): C-a does get remapped.
+
+ * ack.texi (Acknowledgments): Small changes, including resorting,
+ and removal of things no longer distributed.
+
+2012-02-20 Glenn Morris <rgm@gnu.org>
+
+ * emacs.texi (Top, Preface): Small rephrasings.
+ (menu, detailmenu): Update entries, and reformat some descriptions.
+ * building.texi, display.texi, emacs-xtra.texi, files.texi:
+ * frames.texi, kmacro.texi, msdog.texi, programs.texi, text.texi:
+ Reformat some menu descriptions.
+
+ * ack.texi (Acknowledgments): More updates.
+
+ * emacs.texi (Acknowledgments): Add several names from ack.texi,
+ and from Author: headers.
+ (Distrib): Small updates.
+
+2012-02-18 Glenn Morris <rgm@gnu.org>
+
+ * ack.texi (Acknowledgments): Add xref to Org manual.
+
+ * rmail.texi: Copyedits. Use 'mail composition buffer' in place
+ of '*mail*', since Message does not call it that.
+ (Rmail Reply): Rename rmail-dont-reply-to-names.
+ \\`info- no longer handled specially.
+ Update for rmail-enable-mime-composing.
+ Don't mention 'm' for replies.
+ Don't mention rmail-mail-new-frame and cancelling, since it does
+ not work for Message at the moment.
+
+ * cal-xtra.texi: Copyedits.
+
+ * emacs-xtra.texi: Set encoding to ISO-8859-1.
+
+2012-02-17 Glenn Morris <rgm@gnu.org>
+
+ * maintaining.texi (Old Revisions): Fix cross-refs to Ediff manual.
+
+ * ack.texi (Acknowledgments): Mention Gnulib.
+
+ * ack.texi, calendar.texi, cal-xtra.texi: Use "Bahá'í".
+
+ * calendar.texi: Misc small changes, including updating the dates
+ of examples.
+
+2012-02-16 Glenn Morris <rgm@gnu.org>
+
+ * calendar.texi: Misc small changes.
+
+ * vc1-xtra.texi (VC Delete/Rename, CVS Options):
+ * cal-xtra.texi (Diary Display): Fix TeX cross-refs to other manuals.
+
+ * dired-xtra.texi (Subdir Switches): Small fixes.
+
+ * fortran-xtra.texi: Tiny changes and some adjustments to line breaks.
+
+2012-02-15 Glenn Morris <rgm@gnu.org>
+
+ * sending.texi (Mail Sending): smtpmail-auth-credentials was removed.
+
+2012-02-12 Glenn Morris <rgm@gnu.org>
+
+ * ack.texi (Acknowledgments):
+ * emacs.texi (Acknowledgments): Updates for new files in 24.1.
+
+2012-02-10 Glenn Morris <rgm@gnu.org>
+
+ * mini.texi (Minibuffer Edit): Mention minibuffer-inactive-mode.
+
+ * programs.texi (Misc for Programs): Mention electric-layout-mode.
+
+2012-02-09 Glenn Morris <rgm@gnu.org>
+
+ * buffers.texi (Misc Buffer): M-x info does not seem to require a
+ buffer switch after M-x rename-uniquely.
+
+ * trouble.texi (Checklist): Mention C-c m in report-emacs-bug.
+
+2012-02-09 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * text.texi (Org Mode): Fix typo.
+
+2012-02-08 Glenn Morris <rgm@gnu.org>
+
+ * ack.texi (Acknowledgments): Update emacs-lock info.
+
+ * rmail.texi (Rmail Display): Mention rmail-epa-decrypt.
+
+ * text.texi (LaTeX Editing): Mention latex-electric-env-pair-mode.
+
+2012-02-07 Glenn Morris <rgm@gnu.org>
+
+ * files.texi (File Conveniences): Mention ImageMagick images.
+
+2012-02-05 Glenn Morris <rgm@gnu.org>
+
+ * trouble.texi (Checklist): Mention debug-on-event.
+
+ * maintaining.texi (Maintaining): Add cross-ref to ERT.
+
+2012-02-04 Glenn Morris <rgm@gnu.org>
+
+ * macos.texi (Customization options specific to Mac OS / GNUstep):
+ New subsection.
+
+ * display.texi (Colors): Mention list-colors-sort.
+
+ * files.texi (File Conveniences): Mention image animation.
+
+2012-01-31 Chong Yidong <cyd@gnu.org>
+
+ * windows.texi (Split Window): C-mouse-2 doesn't work on GTK+
+ scroll bars (Bug#10666).
+
+2012-01-28 Chong Yidong <cyd@gnu.org>
+
+ * files.texi (Filesets): Fix typos.
+
+ * display.texi (Faces): Add xref to Colors node.
+
+2012-01-27 Dani Moncayo <dmoncayo@gmail.com>
+
+ * buffers.texi (Select Buffer): Clarify explanation of switching
+ to new buffers. Fix description of next-buffer and
+ previous-buffer (Bug#10334).
+ (Misc Buffer): Add xref to View Mode.
+
+ * text.texi (Fill Commands): Fix description of
+ sentence-end-double-space.
+
+2012-01-23 Chong Yidong <cyd@gnu.org>
+
+ * anti.texi (Antinews): Add Emacs 23 antinews.
+
+2012-01-16 Volker Sobek <reklov@live.com> (tiny change)
+
+ * programs.texi (Comment Commands): Typo (bug#10514).
+
+2012-01-15 Chong Yidong <cyd@gnu.org>
+
+ * xresources.texi (X Resources): Describe GTK+ case first.
+ (Resources): Don't use borderWidth as an example, since it doesn't
+ work with GTK+.
+ (Table of Resources): Clarify role of several resources, including
+ the Emacs 24 behavior of cursorBlink etc.
+ (Face Resources): Node deleted. Recommend using Customize
+ instead. Add paragraph to `Table of Resources' node summarizing
+ how to use X resources for changing faces.
+ (Lucid Resources): Rewrite, omitting description of font names,
+ referring to the Fonts node instead.
+ (LessTif Resources): Copyedits.
+ (GTK resources): Rewrite, describing the difference between gtk2
+ and gtk3.
+ (GTK Resource Basics): New node.
+ (GTK Widget Names, GTK Names in Emacs): Rewrite.
+ (GTK styles): Just refer to Fonts node for GTK font format.
+
+ * display.texi (Faces): Document the cursor face.
+
+2012-01-14 Chong Yidong <cyd@gnu.org>
+
+ * cmdargs.texi (Action Arguments): No need to mention EMACSLOADPATH.
+ (General Variables): Add xref to Lisp Libraries.
+ (Initial Options): Copyedits.
+ (Resume Arguments): Node deleted; emacs.bash/csh are obsolete.
+ (Environment): Clarify what getenv does.
+ (General Variables): Clarify EMACSPATH etc. Emacs does not assume
+ light backgrounds on xterms.
+ (Misc Variables): TEMP and TMP are not Windows-specific.
+ (Display X): Copyedits.
+ (Colors X): -bd does nothing for GTK.
+ (Icons X): Gnome 3 doesn't use taskbars.
+
+ * misc.texi (Shell): Document exec-path here.
+
+ * rmail.texi (Movemail): Add xref for exec-path.
+
+2012-01-13 Glenn Morris <rgm@gnu.org>
+
+ * dired.texi (Dired and Find): Clarify find-ls-options.
+
+2012-01-09 Chong Yidong <cyd@gnu.org>
+
+ * custom.texi (Custom Themes): Switch custom-safe-themes to use
+ SHA-256.
+
+2012-01-07 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Useless Whitespace): Add Whitespace mode.
+
+ * custom.texi (Hooks): Discuss how to disable minor modes.
+
+ * files.texi (Diff Mode): Discuss diff-auto-refine-mode
+ (Bug#10309). Discuss use of Whitespace mode (Bug#10300).
+
+ * trouble.texi (Lossage): Refer to Bugs node for problems.
+ (DEL Does Not Delete): Don't use "usual erasure key" teminology.
+ (Screen Garbled): Don't refer to terminal "manufacturers".
+ (Total Frustration): Node deleted. Eliza is documented in
+ Amusements now.
+ (Known Problems): More info about using the bug tracker.
+ Mention debbugs package.
+ (Bug Criteria): Copyedits.
+ (Understanding Bug Reporting): Mention emacs -Q.
+
+2012-01-06 Chong Yidong <cyd@gnu.org>
+
+ * custom.texi (Specifying File Variables): The mode: keyword
+ doesn't have to be first anymore. Add example of specifying minor
+ modes.
+ (Directory Variables): Simplify example. Mention application to
+ non-file buffers.
+ (Disabling): Use "initialization file" terminology.
+ (Init Examples): Fix hook example.
+
+2012-01-06 Eli Zaretskii <eliz@gnu.org>
+
+ * cmdargs.texi (MS-Windows Registry): Shorten the index entry.
+ (Bug#10422)
+ Move the stuff about resources to xresources.texi.
+
+ * xresources.texi (Resources): Move information about setting X
+ resources in the Registry from cmdargs.texi. Make the index entry
+ be similar to the one in cmdargs.texi.
+
+2012-01-05 Chong Yidong <cyd@gnu.org>
+
+ * custom.texi (Customization Groups): Update example.
+ (Browsing Custom): Document the new search field.
+ (Changing a Variable): Update example for Emacs 24 changes.
+ Document Custom-set and Custom-save commands.
+ (Face Customization): Document Emacs 24 changes. De-document
+ modify-face.
+ (Specific Customization): Mention customize-variable.
+ (Custom Themes): Add customize-themes, custom-theme-load-path,
+ custom-theme-directory, and describe-theme.
+ (Creating Custom Themes): New node.
+ (Examining): Mention M-:.
+
+ * package.texi (Packages): Fix typo.
+
+2012-01-03 Chong Yidong <cyd@gnu.org>
+
+ * misc.texi (Single Shell): Don't document Lisp usage of
+ shell-command. Tidy up discussion of synchronicity. Add index
+ entries for async-shell-command.
+ (Interactive Shell): Note that M-x shell uses shell-file-name.
+ Note change in behavior in Emacs 24.
+ (Shell Mode): Shell mode now uses completion-at-point.
+ (Shell Prompts): Emphasize that comint-use-prompt-regexp isn't the
+ default method for recognizing prompts nowadays.
+ (Shell Ring): Add xref to Minibuffer History.
+ (Directory Tracking): Explain Dirtrack mode in more detail.
+ (Term Mode): Fix index entries.
+ (Paging in Term): Merge into Term Mode.
+ (Serial Terminal, Emacs Server, emacsclient Options): Copyedits.
+ (Printing): Fix xref. State default of lpr-switches.
+ (PostScript): Remove obsolete sentence. Omit description of
+ non-interactive behaviors.
+ (Hyperlinking): Improve description.
+ (Browse-URL): Using compose-mail for mailto URLs is the default.
+ Document browse-url-mailto-function.
+ (Goto Address mode): Add index entries. Add xref to Browse-URL.
+ (FFAP): FFAP is not a minor mode.
+ (Amusements): M-x lm was renamed to M-x landmark.
+ Document nato-region.
+
+2012-01-01 Chong Yidong <cyd@gnu.org>
+
+ * misc.texi (Gnus, Buffers of Gnus): Copyedits.
+ (Gnus Startup): Note that the system might not be set up for news.
+ Describe group levels more clearly.
+ (Gnus Group Buffer, Gnus Summary Buffer): New nodes, split from
+ Summary of Gnus.
+ (Document View): Copyedits. Move zoom commads to DocView
+ Navigation node.
+ (DocView Navigation, DocView Searching, DocView Slicing)
+ (DocView Conversion): Nodes renamed from Navigation, etc.
+
+ * sending.texi (Mail Sending): Add message-kill-buffer-on-exit.
+
+2011-12-31 Eli Zaretskii <eliz@gnu.org>
+
+ * basic.texi (Moving Point): Fix the description of C-n and C-p.
+ (Bug#10380)
+
+2011-12-30 Chong Yidong <cyd@gnu.org>
+
+ * sending.texi (Sending Mail): Document initial mail buffer name,
+ and changed multiple mail buffer behavior.
+ (Mail Format): Put the example at the top of the section.
+ (Mail Headers): Move discussion of "From" to the top.
+ (Mail Sending): Document sendmail-query-once.
+ (Citing Mail): Make it less Rmail-specific.
+
+2011-12-29 Chong Yidong <cyd@gnu.org>
+
+ * text.texi (Org Mode): Copyedits. Refer to Outline Format for
+ example. Add index entries.
+ (Org Organizer, Org Authoring): Nodes renamed. Copyedits.
+
2011-12-26 Chong Yidong <cyd@gnu.org>
- * dired.texi (Dired Enter, Misc Dired Features): Document
- dired-use-ls-dired changes. Mention quit-window.
+ * dired.texi (Dired Enter, Misc Dired Features):
+ Document dired-use-ls-dired changes. Mention quit-window.
(Dired Navigation): Add index entries.
(Dired Visiting): Fix View Mode xref.
(Marks vs Flags): Prefer C-/ binding for undo.
@@ -44,8 +1034,8 @@
* vc1-xtra.texi (Version Headers): Note that these are for
Subversion, CVS, etc. only.
- (General VC Options): De-document vc-keep-workfiles. Fix
- RCS-isms.
+ (General VC Options): De-document vc-keep-workfiles.
+ Fix RCS-isms.
2011-12-22 Eli Zaretskii <eliz@gnu.org>
@@ -61,8 +1051,8 @@
* vc1-xtra.texi (Remote Repositories): Update introduction.
(Local Version Control): Node deleted (obsolete with DVCSes).
- (Remote Repositories, Version Backups): Node deleted. Move
- documentation of vc-cvs-stay-local to CVS Options.
+ (Remote Repositories, Version Backups): Node deleted.
+ Move documentation of vc-cvs-stay-local to CVS Options.
(CVS Options): Reduce verbosity of description of obscure CVS
locking feature.
(Making Revision Tags, Revision Tag Caveats): Merge into Revision
@@ -115,11 +1105,11 @@
less CVS-specific.
(VC With A Merging VCS, VC With A Locking VCS): Add xref to
Registering node.
- (Secondary VC Commands): Deleted. Promote subnodes.
+ (Secondary VC Commands): Delete. Promote subnodes.
(Log Buffer): Add command name for C-c C-c. Fix the name of the
log buffer. Add index entries.
- (VCS Changesets, Types of Log File, VC With A Merging VCS): Use
- "commit" terminology.
+ (VCS Changesets, Types of Log File, VC With A Merging VCS):
+ Use "commit" terminology.
(Old Revisions): Move it to just before VC Change Log. "Tag" here
doesn't refer to tags tables. Note other possible forms of the
revision ID. C-x v = does not save.
@@ -144,8 +1134,8 @@
(Lisp Eval): Note that listed commands are available globally.
Explain the meaning of "defun" in the C-M-x context.
(Lisp Interaction): Copyedits.
- (External Lisp): Fix name of inferior Lisp buffer. Mention
- Scheme.
+ (External Lisp): Fix name of inferior Lisp buffer.
+ Mention Scheme.
(Compilation): Define "inferior process".
2011-12-10 Eli Zaretskii <eliz@gnu.org>
@@ -160,8 +1150,8 @@
(Compilation Mode): Add xref for grep, occur, and mouse
references. Define "locus".
(Grep Searching): Use @command.
- (Debuggers, Commands of GUD, GDB Graphical Interface): Clarify
- intro.
+ (Debuggers, Commands of GUD, GDB Graphical Interface):
+ Clarify intro.
(Starting GUD): Clarify how arguments are specified.
(Debugger Operation): Index entry for "GUD interaction buffer",
and move basic description here from Commands of GUD node.
@@ -169,8 +1159,8 @@
(Source Buffers): Remove gdb-find-source-frame, which is not in
gdb-mi.el.
(Other GDB Buffers): Remove gdb-use-separate-io-buffer and
- toggle-gdb-all-registers, which are not in gdb-mi.el. Don't
- re-document GUD interaction buffers.
+ toggle-gdb-all-registers, which are not in gdb-mi.el.
+ Don't re-document GUD interaction buffers.
* programs.texi (Symbol Completion): M-TAB can now use Semantic.
(Semantic): Add cindex entries for Semantic.
@@ -200,8 +1190,8 @@
* programs.texi (Program Modes): Mention modes that are not
included with Emacs. Fix references to other manuals for tex.
- Add index entry for backward-delete-char-untabify. Mention
- prog-mode-hook.
+ Add index entry for backward-delete-char-untabify.
+ Mention prog-mode-hook.
(Which Function): Use "global minor mode" terminology.
(Basic Indent, Multi-line Indent): Refer to previous descriptions
in Indentation chapter to avoid duplication.
@@ -233,12 +1223,12 @@
(TeX Editing): Add xref to documentation for Occur.
(LaTeX Editing): Add xref to Completion node.
(TeX Print): Fix description of tex-directory.
- (Enriched Text): Renamed from Formatted Text. Make this node and
+ (Enriched Text): Rename from Formatted Text. Make this node and
its subnodes less verbose, since text/enriched files are
practically unused.
- (Enriched Mode): Renamed from Requesting Formatted Text.
+ (Enriched Mode): Rename from Requesting Formatted Text.
(Format Colors): Node deleted.
- (Enriched Faces): Renamed from Format Faces. Describe commands
+ (Enriched Faces): Rename from Format Faces. Describe commands
for applying colors too.
(Forcing Enriched Mode): Node deleted; merged into Enriched Mode.
@@ -473,12 +1463,12 @@
2011-10-18 Chong Yidong <cyd@gnu.org>
* display.texi (Faces): Simplify discussion. Move documentation
- of list-faces-display here, from Standard Faces node. Note
- special role of `default' background.
- (Standard Faces): Note special role of `default' background. Note
- that region face may be taken fom GTK. Add xref to Text Display.
- (Text Scale): Rename from "Temporary Face Changes". Callers
- changed. Don't bother documenting variable-pitch-mode.
+ of list-faces-display here, from Standard Faces node.
+ Note special role of `default' background.
+ (Standard Faces): Note special role of `default' background.
+ Note that region face may be taken fom GTK. Add xref to Text Display.
+ (Text Scale): Rename from "Temporary Face Changes".
+ Callers changed. Don't bother documenting variable-pitch-mode.
(Font Lock): Copyedits. Remove font-lock-maximum-size.
(Useless Whitespace): Simplify description of
delete-trailing-whitespace. Note active region case.
@@ -500,8 +1490,8 @@
2011-10-13 Chong Yidong <cyd@stupidchicken.com>
- * killing.texi (Deletion): Add xref to Using Region. Document
- delete-forward-char.
+ * killing.texi (Deletion): Add xref to Using Region.
+ Document delete-forward-char.
(Yanking): Move yank-excluded-properties to Lisp manual. Move C-y
description here. Recommend C-u C-SPC for jumping to mark.
(Kill Ring): Move kill ring variable documentation here.
@@ -521,10 +1511,10 @@
selection changes. Mention that commands like C-y set the mark.
(Marking Objects): Add xref to Words node. Note that mark-word
and mark-sexp also have the "extend region" behavior.
- (Using Region): Mention M-$ in the table. Document
- mark-even-if-inactive here instead of in Mark Ring.
- (Mark Ring): Move mark-even-if-inactive to Using Region. Take
- note of the "Mark Set" behavior.
+ (Using Region): Mention M-$ in the table.
+ Document mark-even-if-inactive here instead of in Mark Ring.
+ (Mark Ring): Move mark-even-if-inactive to Using Region.
+ Take note of the "Mark Set" behavior.
(Disabled Transient Mark): Rename from "Persistent Mark"
(Bug#9688). Callers changed.
@@ -539,8 +1529,8 @@
(Name Help): Remove an over-long joke.
(Apropos): Document prefix args. Remove duplicated descriptions.
(Help Mode): Add C-c C-b to table. Update TAB binding.
- (Package Keywords): Rename from "Library by Keyword". Describe
- new package menu interface.
+ (Package Keywords): Rename from "Library by Keyword".
+ Describe new package menu interface.
(Help Files, Help Echo): Tweak description.
* mini.texi (Completion Options): Add completion-cycle-threshold.
@@ -552,8 +1542,8 @@
2011-10-08 Chong Yidong <cyd@stupidchicken.com>
- * basic.texi (Position Info): Omit page commands. Document
- count-words-region and count-words.
+ * basic.texi (Position Info): Omit page commands.
+ Document count-words-region and count-words.
* text.texi (Pages): Move what-page documentation here.
@@ -576,8 +1566,8 @@
2011-10-07 Chong Yidong <cyd@stupidchicken.com>
- * basic.texi (Inserting Text): Add xref to Completion. Add
- ucs-insert example, and document prefix argument.
+ * basic.texi (Inserting Text): Add xref to Completion.
+ Add ucs-insert example, and document prefix argument.
(Moving Point): Fix introduction; C-f/C-b are no longer equivalent
to left/right. Tweak left-char and right-char descriptions.
M-left and M-right are now bound to left-word/right-word.
@@ -610,7 +1600,6 @@
* custom.texi (Mouse Buttons):
* rmail.texi (Rmail Scrolling):
* search.texi (Isearch Scroll):
-
* display.texi (Scrolling): Replace scroll-up/down with
scroll-up/down-command. Fix scroll-preserve-screen-position
description. Document scroll-error-top-bottom.
@@ -981,8 +1970,8 @@
2011-04-24 Chong Yidong <cyd@stupidchicken.com>
- * maintaining.texi (List Tags): Document next-file. Suggested by
- Uday S Reddy.
+ * maintaining.texi (List Tags): Document next-file.
+ Suggested by Uday S Reddy.
2011-04-23 Juanma Barranquero <lekktu@gmail.com>
@@ -2429,9 +3418,9 @@
* ack.texi (Acknowledgments): General update based on AUTHORS,
including removal of some stuff no longer distributed.
-2008-12-19 Agustin Martin <agustin.martin@hispalinux.es>
+2008-12-19 Agustín Martín <agustin.martin@hispalinux.es>
- * fixit.texi: Mention hunspell
+ * fixit.texi: Mention hunspell.
2008-12-19 Glenn Morris <rgm@gnu.org>
@@ -8683,7 +9672,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1993-1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/doc/emacs/Makefile.in b/doc/emacs/Makefile.in
index 66cd7f1d92e..8f2078192b2 100644
--- a/doc/emacs/Makefile.in
+++ b/doc/emacs/Makefile.in
@@ -1,6 +1,6 @@
#### Makefile for the Emacs Manual
-# Copyright (C) 1994, 1996-2011 Free Software Foundation, Inc.
+# Copyright (C) 1994, 1996-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -31,10 +31,19 @@ version=@version@
## This is a bit funny. Because the info files are in the
## distribution tarfiles, they are always made in $scrdir/../../info,
## even for out-of-tree builds.
-infodir = $(srcdir)/../../info
+buildinfodir = $(srcdir)/../../info
# Directory with the (customized) texinfo.tex file.
texinfodir = $(srcdir)/../misc
+MKDIR_P = @MKDIR_P@
+
+INFO_EXT=@INFO_EXT@
+# Options used only when making info output.
+# --no-split is only needed because of MS-DOS.
+# For a possible alternative, see
+# http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg01182.html
+INFO_OPTS=@INFO_OPTS@
+
# The makeinfo program is part of the Texinfo distribution.
# Use --force so that it generates output even if there are errors.
MAKEINFO = @MAKEINFO@
@@ -111,14 +120,12 @@ EMACSSOURCES= \
$(EMACS_XTRA)
## This seems pointless. The info/ directory exists in both the
-## repository and the release tarfiles. We do not use any
-## equivalent of mkdir -p/install-sh -d, so this is not a general
-## solution anyway. The second test -d is for parallel builds.
-mkinfodir = @test -d ${infodir} || mkdir ${infodir} || test -d ${infodir}
+## repository and the release tarfiles.
+mkinfodir = @${MKDIR_P} ${buildinfodir}
.PHONY: info dvi html pdf ps
-info: $(infodir)/emacs
+info: $(buildinfodir)/emacs$(INFO_EXT)
dvi: emacs.dvi
html: emacs.html
pdf: emacs.pdf
@@ -127,31 +134,31 @@ ps: emacs.ps
# Note that all the Info targets build the Info files in srcdir.
# There is no provision for Info files to exist in the build directory.
# In a distribution of Emacs, the Info files should be up to date.
-
-$(infodir)/emacs: ${EMACSSOURCES}
+# Note: "<" is not portable in ordinary make rules.
+$(buildinfodir)/emacs$(INFO_EXT): ${EMACSSOURCES}
$(mkinfodir)
- $(MAKEINFO) $(MAKEINFO_OPTS) -o $@ $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/emacs.texi
emacs.dvi: ${EMACSSOURCES}
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs.texi
emacs.ps: emacs.dvi
- $(DVIPS) -o $@ $<
+ $(DVIPS) -o $@ emacs.dvi
emacs.pdf: ${EMACSSOURCES}
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs.texi
emacs.html: ${EMACSSOURCES}
- $(MAKEINFO) $(MAKEINFO_OPTS) --html -o $@ $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) --html -o $@ ${srcdir}/emacs.texi
emacs-xtra.dvi: $(EMACS_XTRA)
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-xtra.texi
emacs-xtra.ps: emacs-xtra.dvi
- $(DVIPS) -o $@ $<
+ $(DVIPS) -o $@ emacs-xtra.dvi
emacs-xtra.pdf: $(EMACS_XTRA)
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-xtra.texi
.PHONY: mostlyclean clean distclean maintainer-clean infoclean
@@ -171,7 +178,7 @@ distclean: clean
## In the standalone tarfile, the clean rule runs this.
infoclean:
- -cd $(infodir) && rm -f emacs emacs-[1-9] emacs-[1-9][0-9]
+ -cd $(buildinfodir) && rm -f emacs$(INFO_EXT) emacs$(INFO_EXT)-[1-9] emacs$(INFO_EXT)-[1-9][0-9]
maintainer-clean: distclean infoclean
@@ -185,7 +192,8 @@ dist:
cp ${srcdir}/*.texi ${texinfodir}/texinfo.tex \
${srcdir}/ChangeLog* emacs-manual-${version}/
sed -e 's/@sr[c]dir@/./' -e 's/^\(texinfodir *=\).*/\1 ./' \
- -e 's/^\(infodir *=\).*/\1 ./' -e 's/^\(clean:.*\)/\1 infoclean/' \
+ -e 's/^\(buildinfodir *=\).*/\1 ./' \
+ -e 's/^\(clean:.*\)/\1 infoclean/' \
-e "s/@ver[s]ion@/${version}/" \
${srcdir}/Makefile.in > emacs-manual-${version}/Makefile
tar -cf emacs-manual-${version}.tar emacs-manual-${version}
diff --git a/doc/emacs/abbrevs.texi b/doc/emacs/abbrevs.texi
index 5868010806c..d3c914d92b0 100644
--- a/doc/emacs/abbrevs.texi
+++ b/doc/emacs/abbrevs.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Abbrevs
@@ -37,12 +37,12 @@ Automatic Typing}.
@node Abbrev Concepts
@section Abbrev Concepts
- An @dfn{abbrev} is a word which has been defined to @dfn{expand} into
+ An @dfn{abbrev} is a word that has been defined to @dfn{expand} into
a specified @dfn{expansion}. When you insert a word-separator character
following the abbrev, that expands the abbrev---replacing the abbrev
with its expansion. For example, if @samp{foo} is defined as an abbrev
-expanding to @samp{find outer otter}, then you can insert @samp{find
-outer otter.} into the buffer by typing @kbd{f o o .}.
+expanding to @samp{find outer otter}, then typing @kbd{f o o .} will
+insert @samp{find outer otter.}.
@findex abbrev-mode
@cindex Abbrev mode
@@ -60,10 +60,10 @@ all major modes. The same abbrev can have a global definition and various
mode-specific definitions for different major modes. A mode-specific
definition for the current major mode overrides a global definition.
- You can define abbrevs interactively during the editing session. You
-can also save lists of abbrev definitions in files for use in later
-sessions. Some users keep extensive lists of abbrevs that they load
-in every session.
+ You can define abbrevs interactively during the editing session,
+irrespective of whether Abbrev mode is enabled. You can also save
+lists of abbrev definitions in files, which you can the reload for use
+in later sessions.
@node Defining Abbrevs
@section Defining Abbrevs
@@ -260,12 +260,12 @@ expands to itself, and save it to your abbrev file.
@kbd{M-x edit-abbrevs} allows you to add, change or kill abbrev
definitions by editing a list of them in an Emacs buffer. The list has
the same format described above. The buffer of abbrevs is called
-@samp{*Abbrevs*}, and is in Edit-Abbrevs mode. Type @kbd{C-c C-c} in
+@file{*Abbrevs*}, and is in Edit-Abbrevs mode. Type @kbd{C-c C-c} in
this buffer to install the abbrev definitions as specified in the
buffer---and delete any abbrev definitions not listed.
The command @code{edit-abbrevs} is actually the same as
-@code{list-abbrevs} except that it selects the buffer @samp{*Abbrevs*}
+@code{list-abbrevs} except that it selects the buffer @file{*Abbrevs*}
whereas @code{list-abbrevs} merely displays it in another window.
@node Saving Abbrevs
diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi
index ae6338ce5a6..9fdead70f8a 100644
--- a/doc/emacs/ack.texi
+++ b/doc/emacs/ack.texi
@@ -1,9 +1,9 @@
@c -*- coding: iso-latin-1 -*-
@c This is part of the Emacs manual.
-@c Copyright (C) 1994-1997, 1999-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1994-1997, 1999-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
-@node Acknowledgments, Screen, Concept Index, Top
+@node Acknowledgments
@unnumbered Acknowledgments
Many people have contributed code included in the Free Software
@@ -33,7 +33,7 @@ Per Abrahamsen wrote the customization facilities, as well as
from the keyboard; @file{xt-mouse.el}, which allows mouse commands
through Xterm; @file{gnus-cus.el}, which implements customization
commands for Gnus; @file{gnus-cite.el}, a citation-parsing facility for
-news articles); @file{gnus-score.el}, scoring for Gnus; @file{cpp.el},
+news articles; @file{gnus-score.el}, scoring for Gnus; @file{cpp.el},
which hides or highlights parts of C programs according to preprocessor
conditionals; and the widget library files @file{wid-browse.el},
@file{wid-edit.el}, @file{widget.el}. He also co-wrote
@@ -51,8 +51,9 @@ files.
@item
Michael Albinus wrote @file{dbus.el}, a package that implements the
D-Bus message bus protocol; @file{zeroconf.el}, a mode for browsing
-Avahi services; and @file{xesam.el}, a Xesam-based search engine
-interface. He and Kai Grojohann wrote the Tramp package, which
+Avahi services; @file{xesam.el}, a Xesam-based search engine
+interface; and @file{secrets.el}, an interface to keyring daemons for
+storing confidential data. He and Kai Grojohann wrote the Tramp package, which
provides transparent remote file editing using rcp, ssh, ftp, and
other network protocols. He and Daniel Pittman wrote
@file{tramp-cache.el}.
@@ -67,19 +68,30 @@ Joe Arceneaux wrote the original text property implementation, and
implemented support for X11.
@item
+Emil strm, Milan Zamaza, and Stefan Bruda wrote @file{prolog.el},
+a mode for editing Prolog (and Mercury) code.
+
+@item
Miles Bader wrote @file{image-file.el}, support code for visiting image
files; @file{minibuf-eldef.el}, a minor mode that hides the minibuffer
default value when appropriate; @file{rfn-eshadow.el}, shadowing of
@code{read-file-name} input; @file{mb-depth.el}, display of minibuffer
depth; @file{button.el}, the library that implements clickable buttons;
@file{face-remap.el}, a package for changing the default face in
-individual buffers; and @file{macroexp.el} for macro-expansion.
+individual buffers; and @file{macroexp.el} for macro-expansion. He
+also worked on an early version of the lexical binding code.
@item
David Bakhash wrote @file{strokes.el}, a mode for controlling Emacs by
moving the mouse in particular patterns.
@item
+Juanma Barranquero wrote @file{emacs-lock.el} (based on the original
+version by Tom Wurgler), which makes it harder to exit with valuable
+buffers unsaved. He also made many other contributions to other
+areas, including MS Windows support.
+
+@item
Eli Barzilay wrote @file{calculator.el}, a desktop calculator for
Emacs.
@@ -178,7 +190,8 @@ for editing IDL and WAVE CL.
@item
Bob Chassell wrote @file{texnfo-upd.el}, @file{texinfo.el}, and
@file{makeinfo.el}, modes and utilities for working with Texinfo files;
-and @file{page-ext.el}, commands for extended page handling.
+and @file{page-ext.el}, commands for extended page handling. He also
+wrote the ``Introduction to programming in Emacs Lisp'' manual.
@item
Jihyun Cho wrote @file{hanja-util.el} and @file{hangul.el}, utilities
@@ -189,8 +202,10 @@ Andrew Choi and Yamamoto Mitsuharu wrote the Carbon support, used
prior to Emacs 23 for Mac OS.
@item
-Chong Yidong was the Emacs co-maintainer for Emacs 23. He made many
-improvements to the Emacs display engine.
+Chong Yidong was the Emacs co-maintainer from Emacs 23 onwards. He made many
+improvements to the Emacs display engine. He also wrote
+@file{tabulated-list.el}, a generic major mode for lists of data;
+and improved support for themes and packages.
@item
James Clark wrote SGML mode, a mode for editing SGML documents; and
@@ -209,6 +224,10 @@ Andrew Cohen wrote @file{spam-wash.el}, to decode and clean email before
it is analyzed for spam.
@item
+Edward O'Connor wrote @file{json.el}, a file for parsing and
+generating JSON files.
+
+@item
Georges Brun-Cottan and Stefan Monnier wrote @file{easy-mmode.el}, a
package for easy definition of major and minor modes.
@@ -221,25 +240,19 @@ for compiled Emacs Lisp code.
@item
Mathias Dahl wrote @file{image-dired.el}, a package for viewing image
-files as ``thumbnails.''
+files as ``thumbnails''.
@item
Julien Danjou wrote an implementation of ``Desktop Notifications''
-(@file{notifications.el}).
+(@file{notifications.el}, and related packages for ERC and Gnus);
+and @file{color.el}, a library for general color manipulation.
+He also made various contributions to Gnus.
@item
Vivek Dasmohapatra wrote @file{htmlfontify.el}, to convert a buffer or
source tree to HTML.
@item
-Michael DeCorte wrote @file{emacs.csh}, a C-shell script that starts a
-new Emacs job, or restarts a paused Emacs if one exists.
-
-@item
-Gary Delp wrote @file{mailpost.el}, an interface between RMAIL and the
-@file{/usr/uci/post} mailer.
-
-@item
Matthieu Devin wrote @file{delsel.el}, a package to make newly-typed
text replace the current selection.
@@ -248,16 +261,19 @@ Eric Ding wrote @file{goto-addr.el},
@item
Jan Djrv added support for the GTK+ toolkit and X drag-and-drop.
+He also wrote @file{dynamic-setting.el}.
@item
Carsten Dominik wrote Ref@TeX{}, a package for setting up labels and
-cross-references in La@TeX{} documents; and co-wrote IDLWAVE mode
-(q.v.@:). He was the main author of Org mode, for maintaining notes,
-todo lists, and project planning. Thomas Baumann, Jan Bcker, Lennart
-Borgman, Baoqiu Cui, Daniel German, Bastien Guerry, Tassilo Horn, Philip
-Jackson, Tokuya Kameshima, Ross Patterson, Sebastian Rose, Eric Schulte,
-Paul Sexton, Ulf Stegemann, Andy Stewart, David O'Toole, John Wiegley,
-and Piotr Zielinski also wrote various Org mode components.
+cross-references in @LaTeX{} documents; and co-wrote IDLWAVE mode
+(q.v.@:). He was the original author of Org mode, for maintaining notes,
+todo lists, and project planning. Bastien Guerry subsequently took
+over maintainership. Benjamin Andresen, Thomas Baumann, Joel Boehland, Jan Bcker, Lennart
+Borgman, Baoqiu Cui, Dan Davison, Christian Egli, Eric S.@: Fraga, Daniel German, Chris Gray, Konrad Hinsen, Tassilo Horn, Philip
+Jackson, Martyn Jago, Thorsten Jolitz, Jambunathan K, Tokuya Kameshima, Sergey Litvinov, David Maus, Ross Patterson, Juan Pechiar, Sebastian Rose, Eric Schulte,
+Paul Sexton, Ulf Stegemann, Andy Stewart, Christopher Suckling, David O'Toole, John Wiegley, Zhang Weize,
+Piotr Zielinski, and others also wrote various Org mode components.
+For more information, @pxref{History and Acknowledgments,,, org, The Org Manual}.
@item
Scott Draves wrote @file{tq.el}, help functions for maintaining
@@ -274,7 +290,12 @@ Viktor Dukhovni wrote support for dumping under SunOS version 4.
John Eaton and Kurt Hornik wrote Octave mode.
@item
-Rolf Ebert co-wrote Ada mode.
+Rolf Ebert, Markus Heritsch, and Emmanuel Briot wrote Ada mode.
+
+@item
+Paul Eggert integrated the Gnulib portability library, and made many
+other portability fixes to the C code; as well as his contributions
+to VC and the calendar.
@item
Stephen Eglen wrote @file{mspools.el}, which tells you which Procmail
@@ -344,6 +365,10 @@ Kevin Gallagher rewrote and enhanced the EDT emulation, and wrote
flow control.
@item
+Fabin E. Gallina rewrote @file{python.el}, the major mode for the
+Python programming language used in Emacs 24.3 onwards.
+
+@item
Kevin Gallo added multiple-frame support for Windows NT and wrote
@file{w32-win.el}, support functions for the MS-Windows window system.
@@ -404,7 +429,7 @@ characters used by @TeX{} and net tradition.
@item
Bastien Guerry wrote @file{gnus-bookmark.el}, bookmark support for Gnus;
-as well as contributing to Org mode (q.v.@:).
+as well as helping to maintain Org mode (q.v.@:).
@item
Henry Guillaume wrote @file{find-file.el}, a package to visit files
@@ -428,7 +453,10 @@ non-@acronym{ASCII} text from an @acronym{ASCII} keyboard.
Jesper Harder wrote @file{yenc.el}, for decoding yenc encoded messages.
@item
-K. Shane Hartman wrote @file{chistory.el} and @file{echistory.el},
+Alexandru Harsanyi wrote a library for accessing SOAP web services.
+
+@item
+K.@: Shane Hartman wrote @file{chistory.el} and @file{echistory.el},
packages for browsing command history lists; @file{electric.el} and
@file{helper.el}, which provide an alternative command loop and
appropriate help facilities; @file{emacsbug.el}, a package for
@@ -445,9 +473,6 @@ Jon K Hellan wrote @file{utf7.el}, support for mail-safe transformation
format of Unicode.
@item
-Markus Heritsch co-wrote Ada mode.
-
-@item
Karl Heuer wrote the original blessmail script, implemented the
@code{intangible} text property, and rearranged the structure of the
@code{Lisp_Object} type to allow for more data bits.
@@ -477,15 +502,20 @@ browser to display a URL.
@item
Lars Magne Ingebrigtsen did a major redesign of the Gnus news-reader and
wrote many of its parts. Several of these are now general components of
-Emacs: @file{dns.el} for Domain Name Service lookups;
+Emacs, including: @file{dns.el} for Domain Name Service lookups;
@file{format-spec.el} for formatting arbitrary format strings;
@file{netrc.el} for parsing of @file{.netrc} files; and
-@file{time-date.el} for general date and time handling. Components of
-Gnus have also been written by: Nagy Andras, David Blacka, Scott Byer,
-Kevin Greiner, Kai Grojohann, Joe Hildebrand, Paul Jarc, Sascha
+@file{time-date.el} for general date and time handling.
+He also wrote @file{network-stream.el}, for opening network processes;
+@file{url-queue.el}, for controlling parallel downloads of URLs;
+and implemented libxml2 support.
+Components of Gnus have also been written by: Nagy Andras, David
+Blacka, Scott Byer, Ludovic Courts, Julien Danjou, Kevin Greiner, Kai
+Grojohann, Joe Hildebrand, Paul Jarc, Simon Josefsson, Sascha
Ldecke, David Moore, Jim Radford, Benjamin Rutt, Raymond Scholz,
-Thomas Steffen, Reiner Steib, Didier Verna, Ilja Weis, Katsumi Yamaoka,
-Teodor Zlatanov, and others (@pxref{Contributors,,,gnus, the Gnus Manual}).
+Thomas Steffen, Reiner Steib, Didier Verna, Ilja Weis, Katsumi
+Yamaoka, Teodor Zlatanov, and others (@pxref{Contributors,,,gnus, the
+Gnus Manual}).
@item
Andrew Innes contributed extensively to the MS-Windows support.
@@ -524,7 +554,7 @@ for the Transport Layer Security protocol.
@item
Arne Jrgensen wrote @file{latexenc.el}, a package to
-automatically guess the correct coding system in LaTeX files.
+automatically guess the correct coding system in @LaTeX{} files.
@item
Alexandre Julliard wrote @file{vc-git.el}, support for the Git version
@@ -542,7 +572,7 @@ control system.
Henry Kautz wrote @file{bib-mode.el}, a mode for maintaining
bibliography databases compatible with @code{refer} (the @code{troff}
version) and @code{lookbib}, and @file{refbib.el}, a package to convert
-those databases to the format used by the LaTeX text formatting package.
+those databases to the format used by the @LaTeX{} text formatting package.
@item
Taichi Kawabata added support for Devanagari script and the Indian
@@ -560,7 +590,7 @@ buffers.
@item
Michael Kifer wrote @code{ediff}, an interactive interface to the
@command{diff}, @command{patch}, and @command{merge} programs; and
-Viper, the newest emulation for VI.
+Viper, another emulator of the VI editor.
@item
Richard King wrote the first version of @file{userlock.el} and
@@ -580,8 +610,7 @@ Security-Enhanced Linux context of files on backup and copy.
@item
Shuhei Kobayashi wrote @file{hex-util.el}, for operating on hexadecimal
-strings; support for HMAC (Keyed-Hashing for Message Authentication);
-and a Lisp implementation of the SHA1 Secure Hash Algorithm.
+strings; and support for HMAC (Keyed-Hashing for Message Authentication).
@item
Pavel Kobyakov wrote @file{flymake.el}, a minor mode for performing
@@ -602,23 +631,23 @@ menu support.
@item
Sebastian Kremer wrote @code{dired-mode}, with contributions by Lawrence
R.@: Dodd. He also wrote @file{ls-lisp.el}, a Lisp emulation of the
-@code{ls} command for platforms which don't have @code{ls} as a standard
+@code{ls} command for platforms that don't have @code{ls} as a standard
program.
@item
-Ken Stevens wrote @file{ispell.el}, a spell-checker interface.
-
-@item
David K@ringaccent{a}gedal wrote @file{tempo.el}, providing support for
easy insertion of boilerplate text and other common constructions.
@item
+Igor Kuzmin wrote @file{cconv.el}, providing closure conversion for
+statically scoped Emacs lisp.
+
+@item
Daniel LaLiberte wrote @file{edebug.el}, a source-level debugger for
Emacs Lisp; @file{cl-specs.el}, specifications to help @code{edebug}
-debug code written using David Gillespie's Common Lisp support;
-@file{cust-print.el}, a customizable package for printing lisp
-objects; and @file{isearch.el}, Emacs's incremental search minor mode.
-He also co-wrote @file{hideif.el} (q.v.@:).
+debug code written using David Gillespie's Common Lisp support; and
+@file{isearch.el}, Emacs's incremental search minor mode. He also
+co-wrote @file{hideif.el} (q.v.@:).
@item
Karl Landstrom and Daniel Colascione wrote @file{js.el}, a mode for
@@ -632,8 +661,7 @@ a package for pretty-printing Emacs buffers to PostScript printers;
@file{ebnf2ps.el}, a package that translates EBNF grammar to a syntactic
chart that can be printed to a PostScript printer; and
@file{whitespace.el}, a package that detects and cleans up excess
-whitespace in a file. The previous version of @file{whitespace.el},
-used prior to Emacs 23, was written by Rajesh Vaidheeswarran.
+whitespace in a file (building on an earlier version by Rajesh Vaidheeswarran).
@item
Frederic Lepied wrote @file{expand.el}, which uses the abbrev
@@ -666,8 +694,8 @@ directory-local variables; and the @code{info-finder} feature that
creates a virtual Info manual of package keywords.
@item
-Kroly L@H{o}rentey wrote the ``multi-terminal'' code, which allows Emacs to
-run on graphical and text-only terminals simultaneously.
+Kroly L@H{o}rentey wrote the ``multi-terminal'' code, which allows
+Emacs to run on graphical and text terminals simultaneously.
@item
Martin Lorentzon wrote @file{vc-annotate.el}, support for version
@@ -686,13 +714,13 @@ headers; @file{hl-line.el}, a minor mode for highlighting the line in
the current window on which point is; @file{cap-words.el}, a minor mode
for motion in ``CapitalizedWordIdentifiers''; @file{latin1-disp.el}, a
package that lets you display ISO 8859 characters on Latin-1 terminals
-by setting up appropriate display tables; @file{python.el}, a major mode
-for the Python programming language; @file{smiley.el}, a facility for
-displaying smiley faces; @file{sym-comp.el}, a library for performing
-mode-dependent symbol completion; @file{benchmark.el} for timing code
-execution; and @file{tool-bar.el}, a mode to control the display of
-the Emacs tool bar. With Riccardo Murri he wrote @file{vc-bzr.el},
-support for the Bazaar version control system.
+by setting up appropriate display tables; the version of
+@file{python.el} used prior to Emacs 24.3; @file{smiley.el}, a
+facility for displaying smiley faces; @file{sym-comp.el}, a library
+for performing mode-dependent symbol completion; @file{benchmark.el}
+for timing code execution; and @file{tool-bar.el}, a mode to control
+the display of the Emacs tool bar. With Riccardo Murri he wrote
+@file{vc-bzr.el}, support for the Bazaar version control system.
@item
Eric Ludlam wrote the Speedbar package; @file{checkdoc.el}, for checking
@@ -705,10 +733,25 @@ Development Environment Tools) package. Portions were also written by
Jan Moringen, David Ponce, and Joakim Verona.
@item
+Roland McGrath wrote @file{compile.el} (since updated by Daniel
+Pfeiffer), a package for running compilations in a buffer, and then
+visiting the locations reported in error messages; @file{etags.el}, a
+package for jumping to function definitions and searching or replacing
+in all the files mentioned in a @file{TAGS} file; with Sebastian
+Kremer @file{find-dired.el}, for using @code{dired} commands on output
+from the @code{find} program; @file{grep.el} for running the
+@code{grep} command; @file{map-ynp.el}, a general purpose boolean
+question-asker; @file{autoload.el}, providing semi-automatic
+maintenance of autoload files.
+
+@item
Alan Mackenzie wrote the integrated AWK support in CC Mode, and
maintained CC Mode from Emacs 22 onwards.
@item
+Michael McNamara and Wilson Snyder wrote Verilog mode.
+
+@item
Christopher J.@: Madsen wrote @file{decipher.el}, a package for cracking
simple substitution ciphers.
@@ -748,23 +791,11 @@ mode-sensitive insertion of text into new files.
Yukihiro Matsumoto and Nobuyoshi Nakada wrote Ruby-mode.
@item
-Thomas May wrote @file{blackbox.el}, a version of the traditional
-blackbox game.
-
-@item
-Roland McGrath wrote @file{compile.el} (since updated by Daniel
-Pfeiffer), a package for running compilations in a buffer, and then
-visiting the locations reported in error messages; @file{etags.el}, a
-package for jumping to function definitions and searching or replacing
-in all the files mentioned in a @file{TAGS} file; @file{find-dired.el},
-for using @code{dired} commands on output from the @code{find} program,
-with Sebastian Kremer; @file{grep.el} for running the @code{grep}
-command; @file{map-ynp.el}, a general purpose boolean question-asker;
-@file{autoload.el}, providing semi-automatic maintenance of autoload
-files.
+Tomohiro Matsuyama wrote the native Elisp profiler.
@item
-Michael McNamara and Wilson Snyder wrote Verilog mode.
+Thomas May wrote @file{blackbox.el}, a version of the traditional
+blackbox game.
@item
David Megginson wrote @file{derived.el}, which allows one to define new
@@ -795,7 +826,7 @@ facility. He also wrote @code{ebrowse}, the C@t{++} browser;
and @file{rx.el}, a regular expression constructor.
@item
-Stefan Monnier was the Emacs co-maintainer for Emacs 23. He added
+Stefan Monnier was the Emacs co-maintainer from Emacs 23 onwards. He added
support for Arch and Subversion to VC, re-wrote much of the Emacs server
to use the built-in networking primitives, and re-wrote the abbrev and
minibuffer completion code for Emacs 23. He also wrote @code{PCL-CVS},
@@ -804,27 +835,32 @@ a directory-level front end to the CVS version control system;
text; @file{smerge-mode.el}, a minor mode for resolving @code{diff3}
conflicts; @file{diff-mode.el}, a mode for viewing and editing context
diffs; @file{css-mode.el} for Cascading Style Sheets;
-@file{bibtex-style.el} for BibTeX Style files; and @file{mpc.el}, a
-client for the ``Music Player Daemon''.
+@file{bibtex-style.el} for Bib@TeX{} Style files; @file{mpc.el}, a
+client for the ``Music Player Daemon''; @file{smie.el}, a generic
+indentation engine; and @file{pcase.el}, implementing ML-style pattern
+matching. In Emacs 24, he integrated the lexical binding code,
+cleaned up the CL namespace (making it acceptable to use CL
+functions at runtime), and added generalized variables to core Emacs
+Lisp.
@item
Morioka Tomohiko wrote several packages for MIME support in Gnus and
elsewhere.
@item
-Takahashi Naoto co-wrote @file{quail.el} (q.v.@:), and wrote
-@file{robin.el}, another input method.
-
-@item
Sen Nagata wrote @file{crm.el}, a package for reading multiple strings
with completion, and @file{rfc2368.el}, support for @code{mailto:}
URLs.
@item
Erik Naggum wrote the time-conversion functions. He also wrote
-@file{disp-table.el}, a package for dealing with display tables;
-@file{mailheader.el}, a package for parsing email headers; and
-@file{parse-time.el}, a package for parsing time strings.
+@file{disp-table.el}, for dealing with display tables;
+@file{mailheader.el}, for parsing email headers; and
+@file{parse-time.el}, for parsing time strings.
+
+@item
+Takahashi Naoto co-wrote @file{quail.el} (q.v.@:), and wrote
+@file{robin.el}, another input method.
@item
Thomas Neumann and Eric Raymond wrote @file{make-mode.el},
@@ -835,6 +871,9 @@ Thien-Thi Nguyen and Dan Nicolaescu wrote @file{hideshow.el}, a minor
mode for selectively displaying blocks of text.
@item
+Jurgen Nickelsen wrote @file{ws-mode.el}, providing WordStar emulation.
+
+@item
Dan Nicolaescu added support for running Emacs as a daemon. He also
wrote @file{romanian.el}, support for editing Romanian text;
@file{iris-ansi.el}, support for running Emacs on SGI's @code{xwsh}
@@ -842,9 +881,6 @@ and @code{winterm} terminal emulators; and @file{vc-dir.el}, displaying
the status of version-controlled directories.
@item
-Jurgen Nickelsen wrote @file{ws-mode.el}, providing WordStar emulation.
-
-@item
Hrvoje Niksic wrote @file{savehist.el}, for saving the minibuffer
history between Emacs sessions.
@@ -857,10 +893,6 @@ Andrew Norman wrote @file{ange-ftp.el}, providing transparent FTP
support.
@item
-Edward O'Connor wrote @file{json.el}, a file for parsing and
-generating JSON files.
-
-@item
Kentaro Ohkouchi created the Emacs icons used beginning with Emacs 23.
@item
@@ -973,7 +1005,7 @@ used in Emacs Lisp library files; and code to set and make use of the
which each lisp function loaded into Emacs came.
@item
-Edward M.@: Reingold wrote the extensive calendar and diary support,
+Edward M.@: Reingold wrote the calendar and diary support,
with contributions from Stewart Clamen (@file{cal-mayan.el}), Nachum
Dershowitz (@file{cal-hebrew.el}), Paul Eggert (@file{cal-dst.el}),
Steve Fisk (@file{cal-tex.el}), Michael Kifer (@file{cal-x.el}), Lara
@@ -1005,7 +1037,7 @@ Together with Dmitry Dzhus, he wrote @file{gdb-mi.el}, the successor to
@item
Danny Roozendaal implemented @file{handwrite.el}, which converts text
-into ``handwriting.''
+into ``handwriting''.
@item
Markus Rost wrote @file{cus-test.el}, a testing framework for customize.
@@ -1015,6 +1047,9 @@ Guillermo J.@: Rozas wrote @file{scheme.el}, a mode for editing Scheme and
DSSSL code.
@item
+Martin Rudalics implemented improved display-buffer handling in Emacs 24.
+
+@item
Ivar Rummelhoff wrote @file{winner.el}, which records recent window
configurations so you can move back to them.
@@ -1166,8 +1201,7 @@ Peter Stephenson wrote @file{vcursor.el}, which implements a ``virtual
cursor'' that you can move with the keyboard and use for copying text.
@item
-Ken Stevens wrote the initial version of @file{ispell.el} and maintains
-that package since Ispell 3.1 release.
+Ken Stevens wrote @file{ispell.el}, a spell-checker interface.
@item
Kim F.@: Storm made many improvements to the Emacs display engine,
@@ -1183,7 +1217,7 @@ Martin Stjernholm co-authored CC Mode, a major editing mode for C,
C@t{++}, Objective-C, Java, Pike, CORBA IDL, and AWK code.
@item
-Steve Strassman did not write @file{spook.el}, and even if he did, he
+Steve Strassmann did not write @file{spook.el}, and even if he did, he
really didn't mean for you to use it in an anarchistic way.
@item
@@ -1200,7 +1234,7 @@ the keyboard.
@item
Jean-Philippe Theberge wrote @file{thumbs.el}, a package for viewing
-image files as ``thumbnails.''
+image files as ``thumbnails''.
@item
Spencer Thomas wrote the original @file{dabbrev.el}, providing a command
@@ -1218,11 +1252,9 @@ numbers in the left margin.
@item
Tom Tromey and Chris Lindblad wrote @file{tcl.el}, a mode for editing
Tcl/Tk source files and running a Tcl interpreter as an Emacs
-subprocess.
-
-@item
-Tom Tromey wrote @file{bug-reference.el}, providing clickable links to
-bug reports.
+subprocess. Tom Tromey also wrote @file{bug-reference.el}, providing
+clickable links to bug reports; and the first version of the Emacs
+package system.
@item
Eli Tziperman wrote @file{rmail-spam-filter.el}, a spam filter for RMAIL.
@@ -1231,7 +1263,8 @@ Eli Tziperman wrote @file{rmail-spam-filter.el}, a spam filter for RMAIL.
Daiki Ueno wrote @file{starttls.el}, support for Transport Layer
Security protocol; @file{sasl-cram.el} and @file{sasl-digest.el} (with
Kenichi Okada), and @file{sasl.el}, support for Simple Authentication
-and Security Layer (SASL); and the EasyPG (and its predecessor PGG)
+and Security Layer (SASL); @file{plstore.el} for secure storage of
+property lists; and the EasyPG (and its predecessor PGG)
package, for GnuPG and PGP support.
@item
@@ -1253,6 +1286,9 @@ operations on rectangle regions of text. He also contributed to Gnus
(q.v.@:).
@item
+Joakim Verona implemented ImageMagick support.
+
+@item
Ulrik Vieth implemented @file{meta-mode.el}, for editing MetaFont code.
@item
@@ -1269,15 +1305,14 @@ providing electric accent keys.
Colin Walters wrote Ibuffer, an enhanced buffer menu.
@item
-Barry Warsaw wrote @file{assoc.el}, a set of utility functions for
-working with association lists; @file{cc-mode.el}, a mode for editing
-C, C@t{++}, and Java code, based on earlier work by Dave Detlefs,
-Stewart Clamen, and Richard Stallman; @file{elp.el}, a profiler for
-Emacs Lisp programs; @file{man.el}, a mode for reading Unix manual
-pages; @file{regi.el}, providing an AWK-like functionality for use in
-lisp programs; @file{reporter.el}, providing customizable bug
-reporting for lisp packages; and @file{supercite.el}, a minor mode for
-quoting sections of mail messages and news articles.
+Barry Warsaw wrote @file{cc-mode.el}, a mode for editing C, C@t{++},
+and Java code, based on earlier work by Dave Detlefs, Stewart Clamen,
+and Richard Stallman; @file{elp.el}, a profiler for Emacs Lisp
+programs; @file{man.el}, a mode for reading Unix manual pages;
+@file{regi.el}, providing an AWK-like functionality for use in lisp
+programs; @file{reporter.el}, providing customizable bug reporting for
+lisp packages; and @file{supercite.el}, a minor mode for quoting
+sections of mail messages and news articles.
@item
Christoph Wedler wrote @file{antlr-mode.el}, a major mode for ANTLR
@@ -1311,7 +1346,7 @@ mode for editing VHDL source code.
John Wiegley wrote @file{align.el}, a set of commands for aligning text
according to regular-expression based rules; @file{isearchb.el} for fast
buffer switching; @file{timeclock.el}, a package for keeping track of
-time spent on projects; the Baha'i calendar support;
+time spent on projects; the Bah' calendar support;
@file{pcomplete.el}, a programmable completion facility;
@file{remember.el}, a mode for jotting down things to remember;
@file{eudcb-mab.el}, an address book backend for the Emacs Unified
@@ -1319,9 +1354,8 @@ Directory Client; and @code{eshell}, a command shell implemented
entirely in Emacs Lisp. He also contributed to Org mode (q.v.@:).
@item
-Mike Williams wrote @file{mouse-sel.el}, providing enhanced mouse
-selection; and @file{thingatpt.el}, a library of functions for finding
-the ``thing'' (word, line, s-expression) containing point.
+Mike Williams wrote @file{thingatpt.el}, a library of functions for
+finding the ``thing'' (word, line, s-expression) at point.
@item
Roland Winkler wrote @file{proced.el}, a system process editor.
@@ -1341,12 +1375,9 @@ Francis J.@: Wright wrote @file{woman.el}, a package for browsing
manual pages without the @code{man} command.
@item
-Tom Wurgler wrote @file{emacs-lock.el}, which makes it harder
-to exit with valuable buffers unsaved.
-
-@item
Masatake Yamato wrote @file{ld-script.el}, an editing mode for GNU
-linker scripts, and contributed subword handling in CC mode.
+linker scripts, and contributed subword handling and style
+``guessing'' in CC mode.
@item
Jonathan Yavner wrote @file{testcover.el}, a package for keeping track
@@ -1376,7 +1407,7 @@ zone out in front of Emacs.
Eli Zaretskii made many standard Emacs features work on MS-DOS and
Microsoft Windows. He also wrote @file{tty-colors.el}, which
implements transparent mapping of X colors to tty colors; and
-@file{rxvt.el}.
+@file{rxvt.el}. He implemented support for bidirectional text.
@item
Jamie Zawinski wrote much of the support for faces and X selections.
@@ -1408,6 +1439,11 @@ Neal Ziring and Felix S.@: T.@: Wu wrote @file{vi.el}, an emulation of the
VI text editor.
@item
+Ted Zlatanov (as well as his contributions to the Gnus newsreader)
+wrote an interface to the GnuTLS library, for secure network
+connections; and a futures facility for the URL library.
+
+@item
Detlev Zundel wrote @file{re-builder.el}, a package for building regexps
with visual feedback.
diff --git a/doc/emacs/anti.texi b/doc/emacs/anti.texi
index 1ee93362ae6..62433a5b220 100644
--- a/doc/emacs/anti.texi
+++ b/doc/emacs/anti.texi
@@ -1,137 +1,113 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2005-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2005-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Antinews, Mac OS / GNUstep, X Resources, Top
-@appendix Emacs 22 Antinews
+@node Antinews
+@appendix Emacs 23 Antinews
@c Update the emacs.texi Antinews menu entry with the above version number.
For those users who live backwards in time, here is information
-about downgrading to Emacs version 22.3. We hope you will enjoy the
+about downgrading to Emacs version 23.4. We hope you will enjoy the
greater simplicity that results from the absence of many Emacs
@value{EMACSVER} features.
@itemize @bullet
-
-@item
-We have switched to a character representation specially designed for
-Emacs. Rather than forcing all the widely used scripts into artificial
-alignment, as Unicode does, Emacs treats them all equally, giving
-each one a place in the space of character codes. We have eliminated
-the confusing practice, in Emacs 23, whereby one character can belong
-to multiple character sets. Now each script has its own variant, and
-they all are different as far as Emacs is concerned. For example,
-there's a Latin-1 c-cedilla character, and there's a Latin-2
-c-cedilla; searching a buffer for the Latin-1 variant only finds that
-variant, but not the others.
-
@item
-Emacs now uses its own special internal encoding for non-@acronym{ASCII}
-characters, known as @samp{emacs-mule}. This was imperative to
-support several different variants of the same character, each one
-belonging to its own script: @samp{emacs-mule} marks each character
-with its script, to better discern them from one another.
+Support for displaying and editing ``bidirectional'' text has been
+removed. Text is now always displayed on the screen in a single
+consistent direction---left to right---regardless of the underlying
+script. Similarly, @kbd{C-f} and @kbd{C-b} always move the text
+cursor to the right and left respectively. Also, @key{right} and
+@key{left} are now equivalent to @kbd{C-f} and @kbd{C-b}, as you might
+expect, rather than moving forward or backward based on the underlying
+``paragraph direction''.
-@item
-For simplicity, the functions @code{encode-coding-region} and
-@code{decode-coding-region} no longer accept an argument saying where
-to store the result of their conversions. The result always replaces
-the original, so there's no need to look for it elsewhere.
-
-@item
-Emacs no longer performs font anti-aliasing. If your fonts look ugly,
-try choosing a larger font and increasing the screen resolution.
-Admittedly, this becomes difficult as you go further back in time,
-since available screen resolutions will decrease.
+Users of ``right-to-left'' languages, like Arabic and Hebrew, may
+adapt by reading and/or editing text in left-to-right order.
@item
-The Fontconfig font library is no longer supported. To specify a
-font, you must use an XLFD (X Logical Font Descriptor). The other
-ways of specifying fonts---so-called ``Fontconfig'' and ``GTK'' font
-names---are redundant, so they have been removed.
+The Emacs Lisp package manager has been removed. Instead of using a
+``user interface'' (@kbd{M-x list-packages}), additional Lisp packages
+must now be installed by hand, which is the most flexible and
+``Lispy'' method anyway. Typically, this just involves editing your
+init file to add the package installation directory to the load path
+and defining some autoloads; see each package's commentary section
+and/or README file for details.
@item
-Transient Mark mode is now disabled by default. Furthermore, some
-commands that operate specifically on the region when it is active and
-Transient Mark mode is enabled (such as @code{fill-paragraph}
-@code{ispell-word}, and @code{indent-for-tab-command}), no longer do
-so.
+The option @code{delete-active-region} has been deleted. When the
+region is active, typing @key{DEL} or @key{delete} no longer deletes
+the text in the region; it deletes a single character instead.
@item
-Holding @key{shift} while typing a motion command no longer creates a
-temporarily active region, since that's inconsistent with how Emacs
-normally handles keybindings. The variable @code{shift-select-mode}
-has been deleted. You can, however, still create temporarily active
-regions by dragging the mouse.
+We have reworked how Emacs handles the clipboard and the X primary
+selection. Commands for killing and yanking, like @kbd{C-w} and
+@kbd{C-y}, use the primary selection and not the clipboard, so you can
+use these commands without interfering with ``cutting'' or ``pasting''
+in other programs. The @samp{Cut}/@samp{Copy}/@samp{Paste} menu items
+are bound to separate clipboard commands, not to the same commands as
+@kbd{C-w}/@kbd{M-w}/@kbd{C-y}.
-@item
-The line motion commands, @kbd{C-n} and @kbd{C-p}, now move by logical
-text lines, not screen lines. Even if a long text line is continued
-over multiple screen lines, @kbd{C-n} and @kbd{C-p} treat it as a
-single line, because that's ultimately what it is.
-
-@item
-Visual Line mode, which provides ``word wrap'' functionality, has been
-removed. You can still use Long Lines mode to gain an approximation
-of word wrapping, though this has some drawbacks---for instance,
-syntax highlighting often doesn't work well on wrapped lines.
-
-@item
-@kbd{C-l} now runs @code{recenter} instead of
-@code{recenter-top-bottom}. This always sets the current line at the
-center of the window, instead of cycling through the center, top, and
-bottom of the window on successive invocations. This lets you type
-@kbd{C-l C-l C-l C-l} to be @emph{absolutely sure} that you have
-recentered the line.
+Selecting text by dragging with the mouse now puts the text in the
+kill ring, in addition to the primary selection. But note that
+selecting an active region with @kbd{C-@key{SPC}} does @emph{not}
+alter the kill ring nor the primary selection, even though the text
+highlighting is visually identical.
@item
-The way Emacs generates possible minibuffer completions is now much
-simpler to understand. It matches alternatives to the text before
-point, ignoring the text after point; it also does not attempt to
-perform partial completion if the first completion attempt fails.
+In Isearch, @kbd{C-y} and @kbd{M-y} are no longer bound to
+@code{isearch-yank-kill} and @code{isearch-yank-pop} respectively.
+Instead, @kbd{C-y} yanks the rest of the current line into the search
+string (@code{isearch-yank-line}), whereas @kbd{M-y} does
+@code{isearch-yank-kill}. The mismatch with the usual meanings of
+@kbd{C-y} and @kbd{M-y} is unintended.
@item
-Typing @kbd{M-n} at the start of the minibuffer history list no longer
-attempts to generate guesses of possible minibuffer input. It instead
-does the straightforward thing, by issuing the message @samp{End of
-history; no default available}.
+Various completion features have been simplified. The option
+@code{completion-category-overrides} has been removed, so Emacs uses a
+single consistent scheme to generate completions, instead of using a
+separate scheme for (say) buffer name completion. Several major
+modes, such as Shell mode, now implement their own inline completion
+commands instead of using @code{completion-at-point}.
@item
-Individual buffers can no longer display faces specially. The text
-scaling commands @kbd{C-x C-+}, @kbd{C-x C--}, and @kbd{C-x C-0} have
-been removed, and so has the buffer face menu bound to
-@kbd{S-down-mouse-1}.
+We have removed several options for controlling how windows are used,
+such as @code{display-buffer-base-action},
+@code{display-buffer-alist}, @code{window-combination-limit}, and
+@code{window-combination-resize}.
@item
-VC no longer supports fileset-based operations on distributed version
-control systems (DVCSs) such as Arch, Bazaar, Subversion, Mercurial,
-and Git. For instance, multi-file commits will be performed by
-committing one file at a time. As you go further back in time, we
-will remove DVCS support entirely, so you should migrate your projects
-to CVS.
+The command @kbd{M-x customize-themes} has been removed. Emacs no
+longer comes with pre-defined themes (you can write your own).
@item
-Rmail now uses a special file format, Babyl format, specifically designed
-for storing and editing mail. When you visit a file in Rmail, or get new
-mail, Rmail converts it automatically to Babyl format.
+Emacs no longer adapts various aspects of its display to GTK+
+settings, opting instead for a uniform toolkit-independent look. GTK+
+scroll bars are placed on the left, the same position as non-GTK+ X
+scroll bars. Emacs no longer refers to GTK+ to set the default
+@code{region} face, nor for drawing tooltips.
@item
-Emacs can no longer display frames on X windows and text terminals
-(ttys) simultaneously. If you start Emacs as an X application, it
-can only create X frames; if you start Emacs on a tty, it can only use
-that tty. No more confusion about which type of frame
-@command{emacsclient} will use in any given Emacs session!
+Setting the option @code{delete-by-moving-to-trash} to a
+non-@code{nil} now causes all file deletions to use the system trash,
+even temporary files created by Lisp programs; furthermore, the
+@kbd{M-x delete-file} and @kbd{M-x delete-directory} commands no
+longer accept prefix arguments to force true deletion.
@item
-Emacs can no longer be started as a daemon. You can be sure that if
-you don't see Emacs, then it's not running.
+On GNU/Linux and Unix, the default method for sending mail (as
+specified by @code{send-mail-function}) is to use the
+@command{sendmail} program. Emacs no longer asks for a delivery
+method the first time you try to send mail, trusting instead that the
+system is configured for mail delivery, as it ought to be.
@item
-Emacs has added support for many soon-to-be-non-obsolete platforms,
-including VMS, DECstation, SCO Unix, and systems lacking alloca.
-Support for Sun windows has been added.
+Several VC features have been removed, including the @kbd{C-x v +} and
+@kbd{C-x v m} commands for pulling and merging on distributed version
+control systems, and the ability to view inline log entries in the log
+buffers made by @kbd{C-x v L}.
@item
To keep up with decreasing computer memory capacity and disk space, many
-other functions and files have been eliminated in Emacs 22.3.
+other functions and files have been eliminated in Emacs 23.4.
@end itemize
diff --git a/doc/emacs/arevert-xtra.texi b/doc/emacs/arevert-xtra.texi
index 6a24646b5f7..5a957b02843 100644
--- a/doc/emacs/arevert-xtra.texi
+++ b/doc/emacs/arevert-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2004-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
@@ -93,9 +93,10 @@ deleting or changing marks or flags will mark it modified again.
Remote Dired buffers are not auto-reverted (because it may be slow).
Neither are Dired buffers for which you used shell wildcards or file
-arguments to list only some of the files. @samp{*Find*} and
-@samp{*Locate*} buffers do not auto-revert either.
+arguments to list only some of the files. @file{*Find*} and
+@file{*Locate*} buffers do not auto-revert either.
+@c FIXME? This should be in the elisp manual?
@node Supporting additional buffers
@subsection Adding Support for Auto-Reverting additional Buffers.
@@ -108,6 +109,7 @@ revert-buffer-function,, Reverting, elisp, the Emacs Lisp Reference Manual}.
In addition, it @emph{must} have a @code{buffer-stale-function}.
+@c FIXME only defvar in all of doc/emacs!
@defvar buffer-stale-function
The value of this variable is a function to check whether a non-file
buffer needs reverting. This should be a function with one optional
diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index abb65982873..07060db5af2 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Basic, Minibuffer, Exiting, Top
+@node Basic
@chapter Basic Editing Commands
@kindex C-h t
@@ -97,28 +97,29 @@ To use decimal or hexadecimal instead of octal, set the variable
the letters @kbd{a} to @kbd{f} serve as part of a character code,
just like digits. Case is ignored.
-@findex ucs-insert
+@findex insert-char
@kindex C-x 8 RET
@cindex Unicode characters, inserting
@cindex insert Unicode character
@cindex characters, inserting by name or code-point
- Instead of @kbd{C-q}, you can use the command @kbd{C-x 8 @key{RET}}
-(@code{ucs-insert}). This prompts for the Unicode name or code-point
+ Alternatively, you can use the command @kbd{C-x 8 @key{RET}}
+(@code{insert-char}). This prompts for the Unicode name or code-point
of a character, using the minibuffer. If you enter a name, the
command provides completion (@pxref{Completion}). If you enter a
-code-point, it should be a hexadecimal number (which is the convention
-for Unicode). The command then inserts the corresponding character
-into the buffer. For example, both of the following insert the
-infinity sign (Unicode code-point @code{U+221E}):
+code-point, it should be as a hexadecimal number (the convention for
+Unicode), or a number with a specified radix, e.g.@: @code{#o23072}
+(octal); @xref{Integer Basics,,, elisp, The Emacs Lisp Reference
+Manual}. The command then inserts the corresponding character into
+the buffer. For example, both of the following insert the infinity
+sign (Unicode code-point @code{U+221E}):
@example
@kbd{C-x 8 @key{RET} infinity @key{RET}}
@kbd{C-x 8 @key{RET} 221e @key{RET}}
@end example
- A numeric argument to either @kbd{C-q} or @kbd{C-x 8 @key{RET}}
-specifies how many copies of the character to insert
-(@pxref{Arguments}).
+ A numeric argument to @kbd{C-q} or @kbd{C-x 8 @key{RET}} specifies
+how many copies of the character to insert (@pxref{Arguments}).
@node Moving Point
@section Changing the Location of Point
@@ -130,11 +131,13 @@ specifies how many copies of the character to insert
@cindex moving the cursor
To do more than insert characters, you have to know how to move
point (@pxref{Point}). The keyboard commands @kbd{C-f}, @kbd{C-b},
-@kbd{C-n}, and @kbd{C-p} move point to the right, left, up and down
+@kbd{C-n}, and @kbd{C-p} move point to the right, left, down, and up,
respectively. You can also move point using the @dfn{arrow keys}
present on most keyboards: @kbd{@key{right}}, @kbd{@key{left}},
@kbd{@key{down}}, and @kbd{@key{up}}; however, many Emacs users find
-that it is slower to use the arrow keys than the control keys.
+that it is slower to use the arrow keys than the control keys, because
+you need to move your hand to the area of the keyboard where those
+keys are located.
You can also click the left mouse button to move point to the
position clicked. Emacs also provides a variety of additional
@@ -264,7 +267,8 @@ necessary (@code{scroll-up-command}). @xref{Scrolling}.
Scroll one screen backward, and move point onscreen if necessary
(@code{scroll-down-command}). @xref{Scrolling}.
-@item M-x goto-char
+@item M-g c
+@kindex M-g c
@findex goto-char
Read a number @var{n} and move point to buffer position @var{n}.
Position 1 is the beginning of the buffer.
@@ -282,6 +286,13 @@ also specify @var{n} by giving @kbd{M-g M-g} a numeric prefix argument.
@xref{Select Buffer}, for the behavior of @kbd{M-g M-g} when you give it
a plain prefix argument.
+@item M-g @key{TAB}
+@kindex M-g TAB
+@findex move-to-column
+Read a number @var{n} and move to column @var{n} in the current line.
+Column 0 is the leftmost column. If called with a prefix argument,
+move to the column number specified by the argument's numeric value.
+
@item C-x C-n
@kindex C-x C-n
@findex set-goal-column
@@ -343,7 +354,7 @@ moves down into it.
Delete the character before point, or the region if it is active
(@code{delete-backward-char}).
-@itemx @key{Delete}
+@item @key{Delete}
Delete the character after point, or the region if it is active
(@code{delete-forward-char}).
@@ -370,7 +381,7 @@ the text in the region. @xref{Mark}, for a description of the region.
On most keyboards, @key{DEL} is labeled @key{Backspace}, but we
refer to it as @key{DEL} in this manual. (Do not confuse @key{DEL}
with the @key{Delete} key; we will discuss @key{Delete} momentarily.)
-On some text-only terminals, Emacs may not recognize the @key{DEL} key
+On some text terminals, Emacs may not recognize the @key{DEL} key
properly. @xref{DEL Does Not Delete}, if you encounter this problem.
The @key{delete} (@code{delete-forward-char}) command deletes in the
@@ -401,7 +412,8 @@ commands.
@item C-/
Undo one entry of the undo records---usually, one command worth
(@code{undo}).
-@itemx C-x u
+
+@item C-x u
@itemx C-_
The same.
@end table
@@ -528,7 +540,7 @@ too long to fit in the window, and Emacs displays it as two or more
@dfn{continuation}, and the long logical line is called a
@dfn{continued line}. On a graphical display, Emacs indicates line
wrapping with small bent arrows in the left and right window fringes.
-On a text-only terminal, Emacs indicates line wrapping by displaying a
+On a text terminal, Emacs indicates line wrapping by displaying a
@samp{\} character at the right margin.
Most commands that act on lines act on logical lines, not screen
@@ -543,9 +555,9 @@ and up, respectively, by one screen line (@pxref{Moving Point}).
continuing them. This means that every logical line occupies a single
screen line; if it is longer than the width of the window, the rest of
the line is not displayed. On a graphical display, a truncated line
-is indicated by a small straight arrow in the right fringe; on a
-text-only terminal, it is indicated by a @samp{$} character in the
-right margin. @xref{Line Truncation}.
+is indicated by a small straight arrow in the right fringe; on a text
+terminal, it is indicated by a @samp{$} character in the right margin.
+@xref{Line Truncation}.
By default, continued lines are wrapped at the right window edge.
Since the wrapping may occur in the middle of a word, continued lines
@@ -615,12 +627,16 @@ narrowed region and the line number relative to the whole buffer.
@kindex M-=
@findex count-words-region
-@findex count-words
@kbd{M-=} (@code{count-words-region}) displays a message reporting
-the number of lines, words, and characters in the region. @kbd{M-x
-count-words} displays a similar message for the entire buffer, or for
-the region if the region is @dfn{active}. @xref{Mark}, for an
-explanation of the region.
+the number of lines, words, and characters in the region
+(@pxref{Mark}, for an explanation of the region). With a prefix
+argument, @kbd{C-u M-=}, the command displays a count for the entire
+buffer.
+
+@findex count-words
+ The command @kbd{M-x count-words} does the same job, but with a
+different calling convention. It displays a count for the region if
+the region is active, and for the buffer otherwise.
@kindex C-x =
@findex what-cursor-position
@@ -666,7 +682,7 @@ those two positions are the accessible ones. @xref{Narrowing}.
@cindex arguments to commands
In the terminology of mathematics and computing, @dfn{argument}
-means ``data provided to a function or operation.'' You can give any
+means ``data provided to a function or operation''. You can give any
Emacs command a @dfn{numeric argument} (also called a @dfn{prefix
argument}). Some commands interpret the argument as a repetition
count. For example, giving @kbd{C-f} an argument of ten causes it to
@@ -741,7 +757,8 @@ the character @samp{1}.
value. For example, the command @kbd{M-q} (@code{fill-paragraph})
fills text; with an argument, it justifies the text as well.
(@xref{Filling}, for more information on @kbd{M-q}.) For these
-commands, it is enough to the argument with a single @kbd{C-u}.
+commands, it is enough to specify the argument with a single
+@kbd{C-u}.
Some commands use the value of the argument as a repeat count, but
do something special when there is no argument. For example, the
@@ -760,10 +777,10 @@ described when they come up; they exist to make an individual command
more convenient, and they are documented in that command's
documentation string.
- We use the term ``prefix argument'' as well as ``numeric argument,''
-to emphasize that you type these argument before the command, and to
-distinguish them from minibuffer arguments that come after the
-command.
+ We use the term @dfn{prefix argument} to emphasize that you type
+such arguments before the command, and to distinguish them from
+minibuffer arguments (@pxref{Minibuffer}), which are entered after
+invoking the command.
@node Repeating
@section Repeating a Command
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index 302693aecef..8c6705cc0c9 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Buffers, Windows, Files, Top
+@node Buffers
@chapter Using Multiple Buffers
@cindex buffers
@@ -11,7 +11,7 @@
the file's text. Each time you invoke Dired, a buffer is used to hold
the directory listing. If you send a message with @kbd{C-x m}, a
buffer is used to hold the text of the message. When you ask for a
-command's documentation, that appears in a buffer named @samp{*Help*}.
+command's documentation, that appears in a buffer named @file{*Help*}.
Each buffer has a unique name, which can be of any length. When a
buffer is displayed in a window, its name is shown in the mode line
@@ -19,7 +19,7 @@ buffer is displayed in a window, its name is shown in the mode line
matters in buffer names. Most buffers are made by visiting files, and
their names are derived from the files' names; however, you can also
create an empty buffer with any name you want. A newly started Emacs
-has several buffers, including one named @samp{*scratch*}, which can
+has several buffers, including one named @file{*scratch*}, which can
be used for evaluating Lisp expressions and is not associated with any
file (@pxref{Lisp Interaction}).
@@ -46,7 +46,7 @@ This is because Emacs tracks buffer positions using that data type.
For typical 64-bit machines, this maximum buffer size is @math{2^61 -
2} bytes, or about 2 EiB. For typical 32-bit machines, the maximum is
usually @math{2^29 - 2} bytes, or about 512 MiB. Buffer sizes are
-also limited by the amount of memory present in the system.
+also limited by the amount of memory in the system.
@menu
* Select Buffer:: Creating a new buffer or reselecting an old one.
@@ -90,9 +90,7 @@ selected buffer other than the current buffer.
name using the minibuffer. Then it makes that buffer current, and
displays it in the currently-selected window. An empty input
specifies the buffer that was current most recently among those not
-now displayed in any window. If you specify a buffer that does not
-exist, @kbd{C-x b} creates a new, empty buffer that is not visiting
-any file, and selects it for editing.
+now displayed in any window.
While entering the buffer name, you can use the usual completion and
history commands (@pxref{Minibuffer}). Note that @kbd{C-x b}, and
@@ -102,21 +100,26 @@ completing up to a nonexistent buffer name, Emacs prints
@samp{[Confirm]} and you must type a second @key{RET} to submit that
buffer name. @xref{Completion Exit}, for details.
- One reason to create a new buffer is to use it for making temporary
-notes. If you try to save it, Emacs asks for the file name to use.
-The default value of the variable @code{major-mode} determines the new
-buffer's major mode; the default value is Fundamental mode. @xref{Major
-Modes}.
+ If you specify a buffer that does not exist, @kbd{C-x b} creates a
+new, empty buffer that is not visiting any file, and selects it for
+editing. The default value of the variable @code{major-mode}
+determines the new buffer's major mode; the default value is
+Fundamental mode. @xref{Major Modes}. One reason to create a new
+buffer is to use it for making temporary notes. If you try to save
+it, Emacs asks for the file name to use, and the buffer's major mode
+is re-established taking that file name into account (@pxref{Choosing
+Modes}).
@kindex C-x @key{LEFT}
@kindex C-x @key{RIGHT}
@findex next-buffer
@findex previous-buffer
For conveniently switching between a few buffers, use the commands
-@kbd{C-x @key{LEFT}} and @kbd{C-x @key{RIGHT}}. @kbd{C-x @key{RIGHT}}
-(@code{previous-buffer}) selects the previous buffer (following the order
-of most recent selection in the current frame), while @kbd{C-x @key{LEFT}}
-(@code{next-buffer}) moves through buffers in the reverse direction.
+@kbd{C-x @key{LEFT}} and @kbd{C-x @key{RIGHT}}. @kbd{C-x @key{LEFT}}
+(@code{previous-buffer}) selects the previous buffer (following the
+order of most recent selection in the current frame), while @kbd{C-x
+@key{RIGHT}} (@code{next-buffer}) moves through buffers in the reverse
+direction.
@kindex C-x 4 b
@findex switch-to-buffer-other-window
@@ -177,7 +180,7 @@ buffers that were current most recently come first.
@samp{.} in the first field of a line indicates that the buffer is
current. @samp{%} indicates a read-only buffer. @samp{*} indicates
-that the buffer is ``modified.'' If several buffers are modified, it
+that the buffer is ``modified''. If several buffers are modified, it
may be time to save some with @kbd{C-x s} (@pxref{Save Commands}).
Here is an example of a buffer list:
@@ -195,7 +198,7 @@ CRM Buffer Size Mode File
@end smallexample
@noindent
-The buffer @samp{*Help*} was made by a help request (@pxref{Help}); it
+The buffer @file{*Help*} was made by a help request (@pxref{Help}); it
is not visiting any file. The buffer @code{src} was made by Dired on
the directory @file{~/cvs/emacs/src/}. You can list only buffers that
are visiting files by giving the command a prefix argument, as in
@@ -209,13 +212,13 @@ unless they visit files: such buffers are used internally by Emacs.
@table @kbd
@item C-x C-q
-Toggle read-only status of buffer (@code{toggle-read-only}).
+Toggle read-only status of buffer (@code{read-only-mode}).
@item M-x rename-buffer @key{RET} @var{name} @key{RET}
Change the name of the current buffer.
@item M-x rename-uniquely
Rename the current buffer by adding @samp{<@var{number}>} to the end.
@item M-x view-buffer @key{RET} @var{buffer} @key{RET}
-Scroll through buffer @var{buffer}.
+Scroll through buffer @var{buffer}. @xref{View Mode}.
@end table
@kindex C-x C-q
@@ -228,12 +231,15 @@ buffers are usually made by subsystems such as Dired and Rmail that
have special commands to operate on the text; also by visiting a file
whose access control says you cannot write it.
-@findex toggle-read-only
- The command @kbd{C-x C-q} (@code{toggle-read-only}) makes a read-only
+@findex read-only-mode
+@vindex view-read-only
+ The command @kbd{C-x C-q} (@code{read-only-mode}) makes a read-only
buffer writable, and makes a writable buffer read-only. This works by
setting the variable @code{buffer-read-only}, which has a local value
in each buffer and makes the buffer read-only if its value is
-non-@code{nil}.
+non-@code{nil}. If you change the option @code{view-read-only} to a
+non-@code{nil} value, making the buffer read-only with @kbd{C-x C-q}
+also enables View mode in the buffer (@pxref{View Mode}).
@findex rename-buffer
@kbd{M-x rename-buffer} changes the name of the current buffer. You
@@ -245,19 +251,19 @@ happens and no renaming is done.
@kbd{M-x rename-uniquely} renames the current buffer to a similar
name with a numeric suffix added to make it both different and unique.
This command does not need an argument. It is useful for creating
-multiple shell buffers: if you rename the @samp{*shell*} buffer, then
+multiple shell buffers: if you rename the @file{*shell*} buffer, then
do @kbd{M-x shell} again, it makes a new shell buffer named
-@samp{*shell*}; meanwhile, the old shell buffer continues to exist
+@file{*shell*}; meanwhile, the old shell buffer continues to exist
under its new name. This method is also good for mail buffers,
compilation buffers, and most Emacs features that create special
buffers with particular names. (With some of these features, such as
-@kbd{M-x compile}, @kbd{M-x grep} an @kbd{M-x info}, you need to
-switch to some other buffer before using the command, in order for it
-to make a different buffer.)
+@kbd{M-x compile}, @kbd{M-x grep}, you need to switch to some other
+buffer before using the command again, otherwise it will reuse the
+current buffer despite the name change.)
The commands @kbd{M-x append-to-buffer} and @kbd{M-x insert-buffer}
-can be used to copy text from one buffer to another. @xref{Accumulating
-Text}.
+can also be used to copy text from one buffer to another.
+@xref{Accumulating Text}.
@node Kill Buffer
@section Killing Buffers
@@ -303,7 +309,7 @@ whose names begin with a space, which are used internally by Emacs.
To kill internal buffers as well, call @code{kill-matching-buffers}
with a prefix argument.
- The buffer menu feature is also convenient for killing various
+ The Buffer Menu feature is also convenient for killing various
buffers. @xref{Several Buffers}.
@vindex kill-buffer-hook
@@ -323,8 +329,8 @@ for a mere hour.
@cindex Midnight mode
@vindex midnight-mode
@vindex midnight-hook
- You can also have this buffer purging done for you, every day at
-midnight, by enabling Midnight mode. Midnight mode operates each day
+ You can also have this buffer purging done for you, once a day,
+by enabling Midnight mode. Midnight mode operates each day
at midnight; at that time, it runs @code{clean-buffer-list}, or
whichever functions you have placed in the normal hook
@code{midnight-hook} (@pxref{Hooks}). To enable Midnight mode, use
@@ -333,7 +339,7 @@ the Customization buffer to set the variable @code{midnight-mode} to
@node Several Buffers
@section Operating on Several Buffers
-@cindex buffer menu
+@cindex Buffer Menu
@table @kbd
@item M-x buffer-menu
@@ -342,7 +348,7 @@ Begin editing a buffer listing all Emacs buffers.
Similar, but do it in another window.
@end table
- The @dfn{buffer menu} opened by @kbd{C-x C-b} (@pxref{List Buffers})
+ The @dfn{Buffer Menu} opened by @kbd{C-x C-b} (@pxref{List Buffers})
does not merely list buffers. It also allows you to perform various
operations on buffers, through an interface similar to Dired
(@pxref{Dired}). You can save buffers, kill them (here called
@@ -350,114 +356,177 @@ operations on buffers, through an interface similar to Dired
@findex buffer-menu
@findex buffer-menu-other-window
- To use the buffer menu, type @kbd{C-x C-b} and switch to the window
-displaying the @samp{*Buffer List*} buffer. You can also type
-@kbd{M-x buffer-menu} to open the buffer menu in the selected window.
+ To use the Buffer Menu, type @kbd{C-x C-b} and switch to the window
+displaying the @file{*Buffer List*} buffer. You can also type
+@kbd{M-x buffer-menu} to open the Buffer Menu in the selected window.
Alternatively, the command @kbd{M-x buffer-menu-other-window} opens
-the buffer menu in another window, and selects that window.
+the Buffer Menu in another window, and selects that window.
- The buffer menu is a read-only buffer, and can be changed only
+ The Buffer Menu is a read-only buffer, and can be changed only
through the special commands described in this section. The usual
-Emacs cursor motion commands can be used in this buffer. The
-following commands apply to the buffer described on the current line:
+cursor motion commands can be used in this buffer. The following
+commands apply to the buffer described on the current line:
@table @kbd
@item d
-Request to delete (kill) the buffer, then move down. The request
-shows as a @samp{D} on the line, before the buffer name. Requested
-deletions take place when you type the @kbd{x} command.
+@findex Buffer-menu-delete
+@kindex d @r{(Buffer Menu)}
+Flag the buffer for deletion (killing), then move point to the next
+line (@code{Buffer-menu-delete}). The deletion flag is indicated by
+the character @samp{D} on the line, before the buffer name. The
+deletion occurs only when you type the @kbd{x} command (see below).
+
@item C-d
-Like @kbd{d} but move up afterwards instead of down.
+@findex Buffer-menu-delete-backwards
+@kindex C-d @r{(Buffer Menu)}
+Like @kbd{d}, but move point up instead of down
+(@code{Buffer-menu-delete-backwards}).
+
@item s
-Request to save the buffer. The request shows as an @samp{S} on the
-line. Requested saves take place when you type the @kbd{x} command.
-You may request both saving and deletion for the same buffer.
+@findex Buffer-menu-save
+@kindex s @r{(Buffer Menu)}
+Flag the buffer for saving (@code{Buffer-menu-save}). The save flag
+is indicated by the character @samp{S} on the line, before the buffer
+name. The saving occurs only when you type @kbd{x}. You may request
+both saving and deletion for the same buffer.
+
@item x
-Perform previously requested deletions and saves.
+@findex Buffer-menu-execute
+@kindex x @r{(Buffer Menu)}
+Perform all flagged deletions and saves (@code{Buffer-menu-execute}).
+
@item u
-Remove any request made for the current line, and move down.
+@findex Buffer-menu-unmark
+@kindex u @r{(Buffer Menu)}
+Remove all flags from the current line, and move down
+(@code{Buffer-menu-unmark}).
+
@item @key{DEL}
-Move to previous line and remove any request made for that line.
+@findex Buffer-menu-backup-unmark
+@kindex DEL @r{(Buffer Menu)}
+Move to the previous line and remove all flags on that line
+(@code{Buffer-menu-backup-unmark}).
@end table
- The @kbd{d}, @kbd{C-d}, @kbd{s} and @kbd{u} commands to add or remove
-flags also move down (or up) one line. They accept a numeric argument
-as a repeat count.
+@noindent
+The commands for adding or removing flags, @kbd{d}, @kbd{C-d}, @kbd{s}
+and @kbd{u}, all accept a numeric argument as a repeat count.
- These commands operate immediately on the buffer listed on the current
-line:
+ The following commands operate immediately on the buffer listed on
+the current line. They also accept a numeric argument as a repeat
+count.
@table @kbd
@item ~
-Mark the buffer ``unmodified.'' The command @kbd{~} does this
-immediately when you type it.
+@findex Buffer-menu-not-modified
+@kindex ~ @r{(Buffer Menu)}
+Mark the buffer as unmodified (@code{Buffer-menu-not-modified}).
+@xref{Save Commands}.
+
@item %
-Toggle the buffer's read-only flag. The command @kbd{%} does
-this immediately when you type it.
+@findex Buffer-menu-toggle-read-only
+@kindex % @r{(Buffer Menu)}
+Toggle the buffer's read-only status
+(@code{Buffer-menu-toggle-read-only}). @xref{Misc Buffer}.
+
@item t
-Visit the buffer as a tags table. @xref{Select Tags Table}.
+@findex Buffer-menu-visit-tags-table
+@kindex % @r{(Buffer Menu)}
+Visit the buffer as a tags table
+(@code{Buffer-menu-visit-tags-table}). @xref{Select Tags Table}.
@end table
- There are also commands to select another buffer or buffers:
+ The following commands are used to select another buffer or buffers:
@table @kbd
@item q
-Quit the buffer menu---immediately display the most recent formerly
-visible buffer in its place.
+@findex quit-window
+@kindex q @r{(Buffer Menu)}
+Quit the Buffer Menu (@code{quit-window}). The most recent formerly
+visible buffer is displayed in its place.
+
@item @key{RET}
@itemx f
-Immediately select this line's buffer in place of the @samp{*Buffer
-List*} buffer.
+@findex Buffer-menu-this-window
+@kindex f @r{(Buffer Menu)}
+@kindex RET @r{(Buffer Menu)}
+Select this line's buffer, replacing the @file{*Buffer List*} buffer
+in its window (@code{Buffer-menu-this-window}).
+
@item o
-Immediately select this line's buffer in another window as if by
-@kbd{C-x 4 b}, leaving @samp{*Buffer List*} visible.
+@findex Buffer-menu-other-window
+@kindex o @r{(Buffer Menu)}
+Select this line's buffer in another window, as if by @kbd{C-x 4 b},
+leaving @file{*Buffer List*} visible
+(@code{Buffer-menu-other-window}).
+
@item C-o
-Immediately display this line's buffer in another window, but don't
-select the window.
+@findex Buffer-menu-switch-other-window
+@kindex C-o @r{(Buffer Menu)}
+Display this line's buffer in another window, without selecting it
+(@code{Buffer-menu-switch-other-window}).
+
@item 1
-Immediately select this line's buffer in a full-screen window.
+@findex Buffer-menu-1-window
+@kindex 1 @r{(Buffer Menu)}
+Select this line's buffer in a full-frame window
+(@code{Buffer-menu-1-window}).
+
@item 2
-Immediately set up two windows, with this line's buffer selected in
-one, and the previously current buffer (aside from the buffer
-@samp{*Buffer List*}) displayed in the other.
+@findex Buffer-menu-2-window
+@kindex 2 @r{(Buffer Menu)}
+Set up two windows on the current frame, with this line's buffer
+selected in one, and a previously current buffer (aside from
+@file{*Buffer List*}) in the other (@code{Buffer-menu-2-window}).
+
@item b
-Bury the buffer listed on this line.
+@findex Buffer-menu-bury
+@kindex b @r{(Buffer Menu)}
+Bury this line's buffer (@code{Buffer-menu-bury}).
+
@item m
+@findex Buffer-menu-mark
+@kindex m @r{(Buffer Menu)}
Mark this line's buffer to be displayed in another window if you exit
-with the @kbd{v} command. The request shows as a @samp{>} at the
-beginning of the line. (A single buffer may not have both a delete
-request and a display request.)
+with the @kbd{v} command (@code{Buffer-menu-mark}). The display flag
+is indicated by the character @samp{>} at the beginning of the line.
+(A single buffer may not have both deletion and display flags.)
+
@item v
-Immediately select this line's buffer, and also display in other windows
-any buffers previously marked with the @kbd{m} command. If you have not
-marked any buffers, this command is equivalent to @kbd{1}.
+@findex Buffer-menu-select
+@kindex v @r{(Buffer Menu)}
+Select this line's buffer, and also display in other windows any
+buffers flagged with the @kbd{m} command (@code{Buffer-menu-select}).
+If you have not flagged any buffers, this command is equivalent to
+@kbd{1}.
@end table
- There is also a command that affects the entire buffer list:
+ The following commands affect the entire buffer list:
@table @kbd
+@item S
+@findex tabulated-list-sort
+@kindex S @r{(Buffer Menu)}
+Sort the Buffer Menu entries according to their values in the column
+at point. With a numeric prefix argument @var{n}, sort according to
+the @var{n}-th column (@code{tabulated-list-sort}).
+
@item T
-Delete, or reinsert, lines for non-file buffers. This command toggles
-the inclusion of such buffers in the buffer list.
+@findex Buffer-menu-toggle-files-only
+@kindex T @r{(Buffer Menu)}
+Delete, or reinsert, lines for non-file buffers
+@code{Buffer-menu-toggle-files-only}). This command toggles the
+inclusion of such buffers in the buffer list.
@end table
- What @code{buffer-menu} actually does is create and switch to a
-suitable buffer, and turn on Buffer Menu mode in it. Everything else
-described above is implemented by the special commands provided in
-Buffer Menu mode. One consequence of this is that you can switch from
-the @samp{*Buffer List*} buffer to another Emacs buffer, and edit
-there. You can reselect the @samp{*Buffer List*} buffer later, to
-perform the operations already requested, or you can kill it, or pay
-no further attention to it.
-
- Normally, the buffer @samp{*Buffer List*} is not updated
+ Normally, the buffer @file{*Buffer List*} is not updated
automatically when buffers are created and killed; its contents are
just text. If you have created, deleted or renamed buffers, the way
-to update @samp{*Buffer List*} to show what you have done is to type
+to update @file{*Buffer List*} to show what you have done is to type
@kbd{g} (@code{revert-buffer}). You can make this happen regularly
every @code{auto-revert-interval} seconds if you enable Auto Revert
mode in this buffer, as long as it is not marked modified. Global
-Auto Revert mode applies to the @samp{*Buffer List*} buffer only if
+Auto Revert mode applies to the @file{*Buffer List*} buffer only if
@code{global-auto-revert-non-file-buffers} is non-@code{nil}.
@iftex
@inforef{Autorevert,, emacs-xtra}, for details.
@@ -473,13 +542,13 @@ Auto Revert mode applies to the @samp{*Buffer List*} buffer only if
An @dfn{indirect buffer} shares the text of some other buffer, which
is called the @dfn{base buffer} of the indirect buffer. In some ways it
-is the analogue, for buffers, of a symbolic link between files.
+is a buffer analogue of a symbolic link between files.
@table @kbd
@findex make-indirect-buffer
@item M-x make-indirect-buffer @key{RET} @var{base-buffer} @key{RET} @var{indirect-name} @key{RET}
-Create an indirect buffer named @var{indirect-name} whose base buffer
-is @var{base-buffer}.
+Create an indirect buffer named @var{indirect-name} with base buffer
+@var{base-buffer}.
@findex clone-indirect-buffer
@item M-x clone-indirect-buffer @key{RET}
Create an indirect buffer that is a twin copy of the current buffer.
@@ -517,10 +586,9 @@ buffer in another window. These functions run the hook
@code{clone-indirect-buffer-hook} after creating the indirect buffer.
The more general way to make an indirect buffer is with the command
-@kbd{M-x make-indirect-buffer}. It creates an indirect buffer from
-buffer @var{base-buffer}, under the name @var{indirect-name}. It
-prompts for both @var{base-buffer} and @var{indirect-name} using the
-minibuffer.
+@kbd{M-x make-indirect-buffer}. It creates an indirect buffer
+named @var{indirect-name} from a buffer @var{base-buffer}, prompting for
+both using the minibuffer.
@node Buffer Convenience
@section Convenience Features and Customization of Buffer Handling
@@ -587,7 +655,7 @@ rule or another is easier for you to remember and apply quickly.
Iswitchb global minor mode provides convenient switching between
buffers using substrings of their names. It replaces the normal
definitions of @kbd{C-x b}, @kbd{C-x 4 b}, @kbd{C-x 5 b}, and @kbd{C-x
-4 C-o} with alternative commands that are somewhat ``smarter.''
+4 C-o} with alternative commands that are somewhat ``smarter''.
When one of these commands prompts you for a buffer name, you can
type in just a substring of the name you want to choose. As you enter
@@ -628,7 +696,6 @@ C-b}. To customize this buffer list, use the @code{bs} Custom group
@findex msb-mode
@cindex mode, MSB
@cindex MSB mode
-@cindex buffer menu
@findex mouse-buffer-menu
@kindex C-Down-Mouse-1
MSB global minor mode (``MSB'' stands for ``mouse select buffer'')
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index 963bd510f67..e0ea72902fb 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Building, Maintaining, Programs, Top
+@node Building
@chapter Compiling and Testing Programs
@cindex building programs
@cindex program building
@@ -44,7 +44,7 @@ messages and show you where the errors occurred.
@table @kbd
@item M-x compile
Run a compiler asynchronously under Emacs, with error messages going to
-the @samp{*compilation*} buffer.
+the @file{*compilation*} buffer.
@item M-x recompile
Invoke a compiler with the same command as in the last invocation of
@kbd{M-x compile}.
@@ -57,7 +57,7 @@ Kill the running compilation subprocess.
compile}. This reads a shell command line using the minibuffer, and
then executes the command by running a shell as a subprocess (or
@dfn{inferior process}) of Emacs. The output is inserted in a buffer
-named @samp{*compilation*}. The current buffer's default directory is
+named @file{*compilation*}. The current buffer's default directory is
used as the working directory for the execution of the command;
normally, therefore, compilation takes place in this directory.
@@ -72,19 +72,19 @@ specified is automatically stored in the variable
type @kbd{M-x compile}. A file can also specify a file-local value
for @code{compile-command} (@pxref{File Variables}).
- Starting a compilation displays the @samp{*compilation*} buffer in
+ Starting a compilation displays the @file{*compilation*} buffer in
another window but does not select it. While the compilation is
running, the word @samp{run} is shown in the major mode indicator for
-the @samp{*compilation*} buffer, and the word @samp{Compiling} appears
-in all mode lines. You do not have to keep the @samp{*compilation*}
+the @file{*compilation*} buffer, and the word @samp{Compiling} appears
+in all mode lines. You do not have to keep the @file{*compilation*}
buffer visible while compilation is running; it continues in any case.
When the compilation ends, for whatever reason, the mode line of the
-@samp{*compilation*} buffer changes to say @samp{exit} (followed by
+@file{*compilation*} buffer changes to say @samp{exit} (followed by
the exit code: @samp{[0]} for a normal exit), or @samp{signal} (if a
signal terminated the process).
If you want to watch the compilation transcript as it appears,
-switch to the @samp{*compilation*} buffer and move point to the end of
+switch to the @file{*compilation*} buffer and move point to the end of
the buffer. When point is at the end, new compilation output is
inserted above point, which remains at the end. Otherwise, point
remains fixed while compilation output is added at the end of the
@@ -93,7 +93,7 @@ buffer.
@cindex compilation buffer, keeping point at end
@vindex compilation-scroll-output
If you change the variable @code{compilation-scroll-output} to a
-non-@code{nil} value, the @samp{*compilation*} buffer scrolls
+non-@code{nil} value, the @file{*compilation*} buffer scrolls
automatically to follow the output. If the value is
@code{first-error}, scrolling stops when the first error appears,
leaving point at that error. For any other non-@code{nil} value,
@@ -103,22 +103,25 @@ scrolling continues until there is no more output.
To rerun the last compilation with the same command, type @kbd{M-x
recompile}. This reuses the compilation command from the last
invocation of @kbd{M-x compile}. It also reuses the
-@samp{*compilation*} buffer and starts the compilation in its default
+@file{*compilation*} buffer and starts the compilation in its default
directory, which is the directory in which the previous compilation
was started.
@findex kill-compilation
+@vindex compilation-always-kill
Starting a new compilation also kills any compilation already
-running in @samp{*compilation*}, as the buffer can only handle one
+running in @file{*compilation*}, as the buffer can only handle one
compilation at any time. However, @kbd{M-x compile} asks for
-confirmation before actually killing a compilation that is running.
-You can also kill the compilation process with @kbd{M-x
+confirmation before actually killing a compilation that is running; to
+always automatically kill the compilation without asking, change the
+variable @code{compilation-always-kill} to @code{t}. You can also
+kill a compilation process with the command @kbd{M-x
kill-compilation}.
To run two compilations at once, start the first one, then rename
-the @samp{*compilation*} buffer (perhaps using @code{rename-uniquely};
+the @file{*compilation*} buffer (perhaps using @code{rename-uniquely};
@pxref{Misc Buffer}), then switch buffers and start the other
-compilation. This will create a new @samp{*compilation*} buffer.
+compilation. This will create a new @file{*compilation*} buffer.
@vindex compilation-environment
You can control the environment passed to the compilation command
@@ -133,7 +136,7 @@ variable settings override the usual ones.
@cindex Compilation mode
@cindex mode, Compilation
@cindex locus
- The @samp{*compilation*} buffer uses a major mode called Compilation
+ The @file{*compilation*} buffer uses a major mode called Compilation
mode. Compilation mode turns each error message in the buffer into a
hyperlink; you can move point to it and type @key{RET}, or click on it
with the mouse (@pxref{Mouse References}), to visit the @dfn{locus} of
@@ -145,10 +148,10 @@ position in a file where that error occurred.
If you change the variable
@code{compilation-auto-jump-to-first-error} to a non-@code{nil} value,
Emacs automatically visits the locus of the first error message that
-appears in the @samp{*compilation*} buffer.
+appears in the @file{*compilation*} buffer.
Compilation mode provides the following additional commands. These
-commands can also be used in @samp{*grep*} buffers, where the
+commands can also be used in @file{*grep*} buffers, where the
hyperlinks are search matches rather than error messages (@pxref{Grep
Searching}).
@@ -190,7 +193,7 @@ mode buffer. The first time you invoke it after a compilation, it
visits the locus of the first error message. Each subsequent
@w{@kbd{C-x `}} visits the next error, in a similar fashion. If you
visit a specific error with @key{RET} or a mouse click in the
-@samp{*compilation*} buffer, subsequent @w{@kbd{C-x `}} commands
+@file{*compilation*} buffer, subsequent @w{@kbd{C-x `}} commands
advance from there. When @w{@kbd{C-x `}} finds no more error messages
to visit, it signals an error. @w{@kbd{C-u C-x `}} starts again from
the beginning of the compilation buffer, and visits the first locus.
@@ -199,8 +202,8 @@ the beginning of the compilation buffer, and visits the first locus.
through errors in the opposite direction.
The @code{next-error} and @code{previous-error} commands don't just
-act on the errors or matches listed in @samp{*compilation*} and
-@samp{*grep*} buffers; they also know how to iterate through error or
+act on the errors or matches listed in @file{*compilation*} and
+@file{*grep*} buffers; they also know how to iterate through error or
match lists produced by other commands, such as @kbd{M-x occur}
(@pxref{Other Repeating Search}). If you are already in a buffer
containing error messages or matches, those are the ones that are
@@ -224,16 +227,16 @@ highlights the relevant source line. The duration of this highlight
is determined by the variable @code{next-error-highlight}.
@vindex compilation-context-lines
- If the @samp{*compilation*} buffer is shown in a window with a left
+ If the @file{*compilation*} buffer is shown in a window with a left
fringe (@pxref{Fringes}), the locus-visiting commands put an arrow in
the fringe, pointing to the current error message. If the window has
-no left fringe, such as on a text-only terminal, these commands scroll
-the window so that the current message is at the top of the window.
-If you change the variable @code{compilation-context-lines} to an
-integer value @var{n}, these commands scroll the window so that the
-current error message is @var{n} lines from the top, whether or not
-there is a fringe; the default value, @code{nil}, gives the behavior
-described above.
+no left fringe, such as on a text terminal, these commands scroll the
+window so that the current message is at the top of the window. If
+you change the variable @code{compilation-context-lines} to an integer
+value @var{n}, these commands scroll the window so that the current
+error message is @var{n} lines from the top, whether or not there is a
+fringe; the default value, @code{nil}, gives the behavior described
+above.
@vindex compilation-error-regexp-alist
@vindex grep-regexp-alist
@@ -276,7 +279,7 @@ Names}).
command, but specifies the option for a noninteractive shell. This
means, in particular, that the shell should start with no prompt. If
you find your usual shell prompt making an unsightly appearance in the
-@samp{*compilation*} buffer, it means you have made a mistake in your
+@file{*compilation*} buffer, it means you have made a mistake in your
shell's init file by setting the prompt unconditionally. (This init
file may be named @file{.bashrc}, @file{.profile}, @file{.cshrc},
@file{.shrc}, etc., depending on what shell you use.) The shell init
@@ -331,7 +334,7 @@ you can do anything else in Emacs). @xref{MS-DOS}.
Just as you can run a compiler from Emacs and then visit the lines
with compilation errors, you can also run @command{grep} and then
visit the lines on which matches were found. This works by treating
-the matches reported by @command{grep} as if they were ``errors.''
+the matches reported by @command{grep} as if they were ``errors''.
The output buffer uses Grep mode, which is a variant of Compilation
mode (@pxref{Compilation Mode}).
@@ -339,14 +342,14 @@ mode (@pxref{Compilation Mode}).
@item M-x grep
@itemx M-x lgrep
Run @command{grep} asynchronously under Emacs, listing matching lines in
-the buffer named @samp{*grep*}.
+the buffer named @file{*grep*}.
@item M-x grep-find
@itemx M-x find-grep
@itemx M-x rgrep
Run @command{grep} via @code{find}, and collect output in the
-@samp{*grep*} buffer.
+@file{*grep*} buffer.
@item M-x zrgrep
-Run @code{zgrep} and collect output in the @samp{*grep*} buffer.
+Run @code{zgrep} and collect output in the @file{*grep*} buffer.
@item M-x kill-grep
Kill the running @command{grep} subprocess.
@end table
@@ -369,7 +372,7 @@ can chain @command{grep} commands, like this:
grep -nH -e foo *.el | grep bar | grep toto
@end example
- The output from @command{grep} goes in the @samp{*grep*} buffer. You
+ The output from @command{grep} goes in the @file{*grep*} buffer. You
can find the corresponding lines in the original files using @w{@kbd{C-x
`}}, @key{RET}, and so forth, just like compilation errors.
@@ -416,7 +419,7 @@ by various version control systems.
Flymake mode is a minor mode that performs on-the-fly syntax
checking for many programming and markup languages, including C, C++,
-Perl, HTML, and @TeX{}/La@TeX{}. It is somewhat analogous to Flyspell
+Perl, HTML, and @TeX{}/@LaTeX{}. It is somewhat analogous to Flyspell
mode, which performs spell checking for ordinary human languages in a
similar fashion (@pxref{Spelling}). As you edit a file, Flymake mode
runs an appropriate syntax checking tool in the background, using a
@@ -426,11 +429,11 @@ syntax checking tool used depends on the language; for example, for
C/C++ files this is usually the C compiler. Flymake can also use
build tools such as @code{make} for checking complicated projects.
- To enable Flymake mode, type @kbd{M-x flymake-mode}. You can go to
-the errors found by Flymake mode with @kbd{M-x
-flymake-goto-next-error} and @kbd{M-x flymake-goto-prev-error}. To
-display any error messages associated with the current line, use
-@kbd{M-x flymake-display-err-menu-for-current-line}.
+ To enable Flymake mode, type @kbd{M-x flymake-mode}. You can jump
+to the errors that it finds by using @kbd{M-x flymake-goto-next-error}
+and @kbd{M-x flymake-goto-prev-error}. To display any error messages
+associated with the current line, type @kbd{M-x
+flymake-display-err-menu-for-current-line}.
For more details about using Flymake,
@ifnottex
@@ -471,8 +474,7 @@ Manual}.
* Commands of GUD:: Key bindings for common commands.
* GUD Customization:: Defining your own commands for GUD.
* GDB Graphical Interface:: An enhanced mode that uses GDB features to
- implement a graphical debugging environment through
- Emacs.
+ implement a graphical debugging environment.
@end menu
@node Starting GUD
@@ -573,12 +575,12 @@ for special commands that can be used in the GUD interaction buffer.
As you debug a program, Emacs displays the relevant source files by
visiting them in Emacs buffers, with an arrow in the left fringe
-indicating the current execution line. (On a text-only terminal, the
-arrow appears as @samp{=>}, overlaid on the first two text columns.)
-Moving point in such a buffer does not move the arrow. You are free
-to edit these source files, but note that inserting or deleting lines
-will throw off the arrow's positioning, as Emacs has no way to figure
-out which edited source line corresponds to the line reported by the
+indicating the current execution line. (On a text terminal, the arrow
+appears as @samp{=>}, overlaid on the first two text columns.) Moving
+point in such a buffer does not move the arrow. You are free to edit
+these source files, but note that inserting or deleting lines will
+throw off the arrow's positioning, as Emacs has no way to figure out
+which edited source line corresponds to the line reported by the
debugger subprocess. To update this information, you typically have
to recompile and restart the program.
@@ -589,19 +591,25 @@ to recompile and restart the program.
GUD Tooltip mode is a global minor mode that adds tooltip support to
GUD. To toggle this mode, type @kbd{M-x gud-tooltip-mode}. It is
disabled by default. If enabled, you can move the mouse cursor over a
-variable to show its value in a tooltip (@pxref{Tooltips}); this takes
-effect in the GUD interaction buffer, and in all source buffers with
-major modes listed in the variable @code{gud-tooltip-modes}. If the
-variable @code{gud-tooltip-echo-area} is non-@code{nil}, values are
-shown in the echo area instead of a tooltip.
-
- When using GUD Tooltip mode with @kbd{M-x gud-gdb}, you should note
-that displaying an expression's value in GDB can sometimes expand a
-macro, potentially causing side effects in the debugged program. If
-you use the @kbd{M-x gdb} interface, this problem does not occur, as
-there is special code to avoid side-effects; furthermore, you can
-display macro definitions associated with an identifier when the
-program is not executing.
+variable, a function, or a macro (collectively called
+@dfn{identifiers}) to show their values in tooltips
+(@pxref{Tooltips}). Alternatively, mark an identifier or an
+expression by dragging the mouse over it, then leave the mouse in the
+marked area to have the value of the expression displayed in a
+tooltip. The GUD Tooltip mode takes effect in the GUD interaction
+buffer, and in all source buffers with major modes listed in the
+variable @code{gud-tooltip-modes}. If the variable
+@code{gud-tooltip-echo-area} is non-@code{nil}, or if you turned off
+the tooltip mode, values are shown in the echo area instead of a
+tooltip.
+
+ When using GUD Tooltip mode with @kbd{M-x gud-gdb}, displaying an
+expression's value in GDB can sometimes expand a macro, potentially
+causing side effects in the debugged program. For that reason, using
+tooltips in @code{gud-gdb} is disabled. If you use the @kbd{M-x gdb}
+interface, this problem does not occur, as there is special code to
+avoid side-effects; furthermore, you can display macro definitions
+associated with an identifier when the program is not executing.
@node Commands of GUD
@subsection Commands of GUD
@@ -883,10 +891,6 @@ displays the following frame layout:
@end group
@end smallexample
- However, if @code{gdb-use-separate-io-buffer} is @code{nil}, the I/O
-buffer does not appear and the primary source buffer occupies the full
-width of the frame.
-
@findex gdb-restore-windows
@findex gdb-many-windows
If you ever change the window layout, you can restore the ``many
@@ -937,7 +941,7 @@ already exists there, the click removes it. A @kbd{C-Mouse-1} click
enables or disables an existing breakpoint; a breakpoint that is
disabled, but not unset, is indicated by a gray dot.
- On a text-only terminal, or when fringes are disabled, enabled
+ On a text terminal, or when fringes are disabled, enabled
breakpoints are indicated with a @samp{B} character in the left margin
of the window. Disabled breakpoints are indicated with @samp{b}.
(The margin is only displayed if a breakpoint is present.)
@@ -1080,9 +1084,9 @@ debugger}.
@findex gdb-frames-select
On graphical displays, the selected stack frame is indicated by an
-arrow in the fringe. On text-only terminals, or when fringes are
-disabled, the selected stack frame is displayed in reverse contrast.
-To select a stack frame, move point in its line and type @key{RET}
+arrow in the fringe. On text terminals, or when fringes are disabled,
+the selected stack frame is displayed in reverse contrast. To select
+a stack frame, move point in its line and type @key{RET}
(@code{gdb-frames-select}), or click @kbd{Mouse-2} on it. Doing so
also updates the Locals buffer
@ifnottex
@@ -1240,8 +1244,8 @@ depending on the reason which caused the stop. Customize the variable
@code{gdb-switch-reasons} to select the stop reasons which will cause
a thread switch.
-@vindex gdb-stopped-hooks
- The variable @code{gdb-stopped-hooks} allows you to execute your
+@vindex gdb-stopped-functions
+ The variable @code{gdb-stopped-functions} allows you to execute your
functions whenever some thread stops.
In non-stop mode, you can switch between different modes for GUD
@@ -1392,13 +1396,21 @@ putting a line like this in your init file (@pxref{Init File}):
@end example
@cindex autoload
- Some commands are @dfn{autoloaded}: when you run them, Emacs
+ Some commands are @dfn{autoloaded}; when you run them, Emacs
automatically loads the associated library first. For instance, the
@kbd{M-x compile} command (@pxref{Compilation}) is autoloaded; if you
call it, Emacs automatically loads the @code{compile} library first.
In contrast, the command @kbd{M-x recompile} is not autoloaded, so it
is unavailable until you load the @code{compile} library.
+@vindex help-enable-auto-load
+ Automatic loading can also occur when you look up the documentation
+of an autoloaded command (@pxref{Name Help}), if the documentation
+refers to other functions and variables in its library (loading the
+library lets Emacs properly set up the hyperlinks in the @file{*Help*}
+buffer). To disable this feature, change the variable
+@code{help-enable-auto-load} to @code{nil}.
+
@vindex load-dangerous-libraries
@cindex Lisp files byte-compiled by XEmacs
By default, Emacs refuses to load compiled Lisp files which were
@@ -1496,7 +1508,7 @@ eval-buffer} is similar but evaluates the entire buffer.
@vindex eval-expression-print-level
@vindex eval-expression-print-length
@vindex eval-expression-debug-on-error
- The customizable variables @code{eval-expression-print-level} and
+ The options @code{eval-expression-print-level} and
@code{eval-expression-print-length} control the maximum depth and
length of lists to print in the result of the evaluation commands
before abbreviating them. @code{eval-expression-debug-on-error}
@@ -1507,14 +1519,14 @@ commands are used; its default is @code{t}.
@section Lisp Interaction Buffers
@findex lisp-interaction-mode
- When Emacs starts up, it contains a buffer named @samp{*scratch*},
+ When Emacs starts up, it contains a buffer named @file{*scratch*},
which is provided for evaluating Emacs Lisp expressions interactively.
Its major mode is Lisp Interaction mode. You can also enable Lisp
Interaction mode by typing @kbd{M-x lisp-interaction-mode}.
@findex eval-print-last-sexp
@kindex C-j @r{(Lisp Interaction mode)}
- In the @samp{*scratch*} buffer, and other Lisp Interaction mode
+ In the @file{*scratch*} buffer, and other Lisp Interaction mode
buffers, @kbd{C-j} (@code{eval-print-last-sexp}) evaluates the Lisp
expression before point, and inserts the value at point. Thus, as you
type expressions into the buffer followed by @kbd{C-j} after each
@@ -1523,7 +1535,7 @@ expressions and their values. All other commands in Lisp Interaction
mode are the same as in Emacs Lisp mode.
@vindex initial-scratch-message
- At startup, the @samp{*scratch*} buffer contains a short message, in
+ At startup, the @file{*scratch*} buffer contains a short message, in
the form of a Lisp comment, that explains what it is for. This
message is controlled by the variable @code{initial-scratch-message},
which should be either a string, or @code{nil} (which means to
@@ -1534,7 +1546,7 @@ suppress the message).
interactively is to use Inferior Emacs Lisp mode, which provides an
interface rather like Shell mode (@pxref{Shell Mode}) for evaluating
Emacs Lisp expressions. Type @kbd{M-x ielm} to create an
-@samp{*ielm*} buffer which uses this mode. For more information, see
+@file{*ielm*} buffer which uses this mode. For more information, see
that command's documentation.
@node External Lisp
@@ -1556,13 +1568,13 @@ whose names end in @file{.l}, @file{.lsp}, or @file{.lisp}.
evaluated. To begin an external Lisp session, type @kbd{M-x
run-lisp}. This runs the program named @command{lisp}, and sets it up
so that both input and output go through an Emacs buffer named
-@samp{*inferior-lisp*}. To change the name of the Lisp program run by
+@file{*inferior-lisp*}. To change the name of the Lisp program run by
@kbd{M-x run-lisp}, change the variable @code{inferior-lisp-program}.
- The major mode for the @samp{*lisp*} buffer is Inferior Lisp mode,
+ The major mode for the @file{*lisp*} buffer is Inferior Lisp mode,
which combines the characteristics of Lisp mode and Shell mode
(@pxref{Shell Mode}). To send input to the Lisp session, go to the
-end of the @samp{*lisp*} buffer and type the input, followed by
+end of the @file{*lisp*} buffer and type the input, followed by
@key{RET}. Terminal output from the Lisp session is automatically
inserted in the buffer.
@@ -1573,7 +1585,7 @@ inserted in the buffer.
buffer to a Lisp session that you had started with @kbd{M-x run-lisp}.
The expression sent is the top-level Lisp expression at or following
point. The resulting value goes as usual into the
-@samp{*inferior-lisp*} buffer. Note that the effect of @kbd{C-M-x} in
+@file{*inferior-lisp*} buffer. Note that the effect of @kbd{C-M-x} in
Lisp mode is thus very similar to its effect in Emacs Lisp mode
(@pxref{Lisp Eval}), except that the expression is sent to a different
Lisp environment instead of being evaluated in Emacs.
@@ -1588,4 +1600,4 @@ to a Scheme subprocess, are very similar. Scheme source files are
edited in Scheme mode, which can be explicitly enabled with @kbd{M-x
scheme-mode}. You can initiate a Scheme session by typing @kbd{M-x
run-scheme} (the buffer for interacting with Scheme is named
-@samp{*scheme*}), and send expressions to it by typing @kbd{C-M-x}.
+@file{*scheme*}), and send expressions to it by typing @kbd{C-M-x}.
diff --git a/doc/emacs/cal-xtra.texi b/doc/emacs/cal-xtra.texi
index 2d2b32943f5..09beabc40cb 100644
--- a/doc/emacs/cal-xtra.texi
+++ b/doc/emacs/cal-xtra.texi
@@ -1,5 +1,5 @@
-@c This is part of the Emacs manual.
-@c Copyright (C) 2004-2011 Free Software Foundation, Inc.
+@c This is part of the Emacs manual. -*- coding: iso-latin-1 -*-
+@c Copyright (C) 2004-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
@@ -7,10 +7,12 @@
@c Moved here from the Emacs Lisp Reference Manual, 2005-03-26.
@node Advanced Calendar/Diary Usage
-@section Customizing the Calendar and Diary
+@section More advanced features of the Calendar and Diary
- There are many customizations that you can use to make the calendar and
-diary suit your personal tastes.
+ This section describes some of the more advanced/specialized
+features of the calendar and diary. It starts with some of the
+many ways in which you can customize the calendar and diary to suit
+your personal tastes.
@menu
* Calendar Customizing:: Calendar layout and hooks.
@@ -39,16 +41,21 @@ To display text @emph{between} the months, for example week numbers,
customize the variables @code{calendar-intermonth-header} and
@code{calendar-intermonth-text} as described in their documentation.
+@vindex calendar-month-header
+ The variable @code{calendar-month-header} controls the text that
+appears above each month in the calendar. By default, it shows the
+month and year.
+
@vindex calendar-holiday-marker
@vindex diary-entry-marker
@vindex calendar-today-marker
The variable @code{calendar-holiday-marker} specifies how to mark a
-date as being a holiday. Its value may be a single-character string to
+date that is a holiday. Its value may be a single-character string to
insert next to the date, or a face name to use for displaying the date.
Likewise, the variable @code{diary-entry-marker} specifies how to mark a
-date that has diary entries, and @code{calendar-today-marker} is used by
-the function @code{calendar-mark-today} to mark today's date. By
-default, the calendar uses faces named @code{holiday}, @code{diary}, and
+date that has diary entries. The function @code{calendar-mark-today}
+uses @code{calendar-today-marker} to mark today's date. By default,
+the calendar uses faces named @code{holiday}, @code{diary}, and
@code{calendar-today} for these purposes.
@vindex calendar-load-hook
@@ -65,7 +72,7 @@ display does not run this hook. But if you leave the calendar with the
@vindex calendar-today-visible-hook
@findex calendar-star-date
The variable @code{calendar-today-visible-hook} is a normal hook run
-after the calendar buffer has been prepared with the calendar when the
+after the calendar buffer has been prepared with the calendar, when the
current date is visible in the window. One use of this hook is to
mark today's date; to do that use either of the functions
@code{calendar-mark-today} or @code{calendar-star-date}:
@@ -90,28 +97,27 @@ the current date is @emph{not} visible in the window.
@vindex calendar-holidays
@vindex holiday-oriental-holidays
@vindex holiday-solar-holidays
- Emacs knows about holidays defined by entries on one of several lists.
-The lists of holidays that Emacs uses are for
-general holidays (@code{holiday-general-holidays}),
-local holidays (@code{holiday-local-holidays}),
-sun- and moon-related holidays (@code{holiday-solar-holidays}),
-Baha'i holidays (@code{holiday-bahai-holidays}),
-Christian holidays (@code{holiday-christian-holidays}),
-Hebrew (Jewish) holidays (@code{holiday-hebrew-holidays}),
-Islamic (Muslim) holidays (@code{holiday-islamic-holidays}),
-Oriental holidays (@code{holiday-oriental-holidays}),
-and other holidays (@code{holiday-other-holidays}).
+ There are several variables listing the default holidays that Emacs
+knows about. These are: @code{holiday-general-holidays},
+@code{holiday-local-holidays}, @code{holiday-solar-holidays},
+@code{holiday-bahai-holidays}, @code{holiday-christian-holidays},
+@code{holiday-hebrew-holidays}, @code{holiday-islamic-holidays},
+@code{holiday-oriental-holidays}, and @code{holiday-other-holidays}.
+The names should be self-explanatory; e.g.@: @code{holiday-solar-holidays}
+lists sun- and moon-related holidays.
You can customize these lists of holidays to your own needs, deleting or
adding holidays as described below. Set any of them to @code{nil} to
-eliminate the associated holidays.
+not show the associated holidays.
@vindex holiday-general-holidays
- The general holidays are, by default, holidays common throughout the
-United States.
-
@vindex holiday-local-holidays
- There are no default local holidays, but your site may supply some.
+@vindex holiday-other-holidays
+ The general holidays are, by default, holidays common throughout the
+United States. In contrast, @code{holiday-local-holidays} and
+@code{holiday-other-holidays} are both empty by default. These are
+intended for system-wide settings and your individual use,
+respectively.
@vindex holiday-bahai-holidays
@vindex holiday-christian-holidays
@@ -129,18 +135,13 @@ all) of the variables @code{calendar-bahai-all-holidays-flag},
@code{calendar-hebrew-all-holidays-flag}, or
@code{calendar-islamic-all-holidays-flag} to @code{t}.
-@vindex holiday-other-holidays
- You can set the variable @code{holiday-other-holidays} to any list of
-holidays. This list, normally empty, is intended for individual use.
-
@cindex holiday forms
Each of the holiday variables is a list of @dfn{holiday forms}, each
-form describing a holiday (or sometimes a list of holidays).
-
- Here is a table of the possible kinds of holiday form. Day numbers
-and month numbers count starting from 1, but ``dayname'' numbers
-count Sunday as 0. The element @var{string} is always the
-description of the holiday, as a string.
+form describing a holiday (or sometimes a list of holidays). Here is
+a table of the possible kinds of holiday form. Day numbers and month
+numbers count starting from 1, but ``dayname'' numbers count Sunday as
+0. The argument @var{string} is always the description of the
+holiday, as a string.
@table @code
@item (holiday-fixed @var{month} @var{day} @var{string})
@@ -202,7 +203,7 @@ the month (1 specifies the first occurrence, 2 the second occurrence,
@minus{}1 the last occurrence, @minus{}2 the second-to-last occurrence, and
so on).
- You can specify holidays that occur on fixed days of the Baha'i,
+ You can specify holidays that occur on fixed days of the Bah',
Chinese, Hebrew, Islamic, and Julian calendars too. For example,
@smallexample
@@ -256,15 +257,15 @@ and write an Emacs Lisp function @code{eclipses} that returns a
visible in the calendar window, with descriptive strings, like this:
@smallexample
-(((6 27 1991) "Lunar Eclipse") ((7 11 1991) "Solar Eclipse") ... )
+(((6 4 2012) "Lunar Eclipse") ((11 13 2012) "Solar Eclipse") ... )
@end smallexample
@node Date Display Format
@subsection Date Display Format
@vindex calendar-date-display-form
- You can customize the manner of displaying dates in the diary, in mode
-lines, and in messages by setting @code{calendar-date-display-form}.
+ You can customize the way dates are displayed in the diary, mode
+lines, and messages by setting @code{calendar-date-display-form}.
This variable holds a list of expressions that can involve the variables
@code{month}, @code{day}, and @code{year}, which are all numbers in
string form, and @code{monthname} and @code{dayname}, which are both
@@ -291,7 +292,7 @@ The default ISO date representation is:
@end smallexample
@noindent
-This specifies a typical American format:
+Another typical American format is:
@smallexample
(month "/" day "/" (substring year -2))
@@ -358,7 +359,7 @@ be regular expressions (@pxref{Regular Expressions,,, elisp, the Emacs
Lisp Reference Manual}) or the symbols @code{month}, @code{day},
@code{year}, @code{monthname}, and @code{dayname}. All these elements
serve as patterns that match certain kinds of text in the diary file.
-In order for the date pattern, as a whole, to match, all of its elements
+In order for the date pattern as a whole to match, all of its elements
must match consecutively.
A regular expression in a date pattern matches in its usual fashion,
@@ -387,8 +388,8 @@ provided by @code{diary-american-date-forms}:
@end example
@noindent
-Other default styles are provided by @code{diary-european-date-forms}
-and @code{diary-iso-date-forms}.
+The variables @code{diary-european-date-forms} and
+@code{diary-iso-date-forms} provide other default styles.
The date patterns in the list must be @emph{mutually exclusive} and
must not match any portion of the diary entry itself, just the date and
@@ -419,7 +420,7 @@ the fourth pattern.
@subsection Diary Entries Using non-Gregorian Calendars
As well as entries based on the standard Gregorian calendar, your
-diary can have entries based on Baha'i, Hebrew, or Islamic dates.
+diary can have entries based on Bah', Hebrew, or Islamic dates.
Recognition of such entries can be time-consuming, however, and since
most people don't use them, you must explicitly enable their use. If
you want the diary to recognize Hebrew-date diary entries, for example,
@@ -439,7 +440,7 @@ you must do this:
@end smallexample
@noindent
-Similarly, for Islamic and Baha'i entries, add
+Similarly, for Islamic and Bah' entries, add
@code{diary-islamic-list-entries} and @code{diary-islamic-mark-entries}, or
@code{diary-bahai-list-entries} and @code{diary-bahai-mark-entries}.
@@ -448,7 +449,7 @@ Similarly, for Islamic and Baha'i entries, add
@vindex diary-islamic-entry-symbol
These diary entries have the same formats as Gregorian-date diary
entries; except that @code{diary-bahai-entry-symbol} (default @samp{B})
-must precede a Baha'i date, @code{diary-hebrew-entry-symbol} (default
+must precede a Bah' date, @code{diary-hebrew-entry-symbol} (default
@samp{H}) a Hebrew date, and @code{diary-islamic-entry-symbol} (default
@samp{I}) an Islamic date. Moreover, non-Gregorian month names may not
be abbreviated (because the first three letters are often not unique).
@@ -475,7 +476,7 @@ nonmarking if preceded by @code{diary-nonmarking-symbol} (default
Here is a table of commands used in the calendar to create diary
entries that match the selected date and other dates that are similar in
-the Baha'i, Hebrew, or Islamic calendars:
+the Bah', Hebrew, or Islamic calendars:
@table @kbd
@item i h d
@@ -538,7 +539,13 @@ are no diary entries, even if that day is a holiday. If you want such
days to be shown in the fancy diary buffer, set the variable
@code{diary-list-include-blanks} to @code{t}.@refill
- The fancy diary buffer enables View mode (@pxref{View Mode}).
+ The fancy diary buffer enables View mode
+@iftex
+(@pxref{View Mode,,, emacs, the Emacs Manual}).
+@end iftex
+@ifnottex
+(@pxref{View Mode}).
+@end ifnottex
The alternative display method @code{diary-simple-display} shows the
actual diary buffer, and uses invisible text to hide entries that don't
@@ -569,7 +576,13 @@ display, the other irrelevant entries are really absent, not just
hidden. After preparing the buffer, it runs the hook
@code{diary-print-entries-hook}. The default value of this hook sends
the data directly to the printer with the command @code{lpr-buffer}
-(@pxref{Printing}). If you want to use a different command to do the
+@iftex
+(@pxref{Printing,,, emacs, the Emacs Manual}).
+@end iftex
+@ifnottex
+(@pxref{Printing}).
+@end ifnottex
+If you want to use a different command to do the
printing, just change the value of this hook. Other uses might include,
for example, rearranging the lines into order by day and time.
@@ -615,7 +628,7 @@ of the diary entries, or add items.
variables @code{diary-comment-start} and @code{diary-comment-end} to
strings that delimit comments. The fancy display does not print
comments. You might want to put meta-data for the use of other packages
-(e.g. the appointment package,
+(e.g.@: the appointment package,
@iftex
@pxref{Appointments,,,emacs, the Emacs Manual})
@end iftex
@@ -699,7 +712,7 @@ that have occurred:
@findex diary-cyclic
@smallexample
-%%(diary-cyclic 50 1 1 1990) Renew medication (%d%s time)
+%%(diary-cyclic 50 1 1 2012) Renew medication (%d%s time)
@end smallexample
@noindent
@@ -710,9 +723,9 @@ Renew medication (5th time)
@end smallexample
@noindent
-in the fancy diary display on September 8, 1990.
+in the fancy diary display on September 7, 2012.
- There is an early reminder diary sexp that includes its entry in the
+ There is an ``early reminder'' diary sexp that includes its entry in the
diary not only on the date of occurrence, but also on earlier dates.
For example, if you want a reminder a week before your anniversary, you
can use
@@ -838,7 +851,7 @@ Make a diary entry with today's equivalent Julian calendar date.
@item %%(diary-astro-day-number)
Make a diary entry with today's equivalent astronomical (Julian) day number.
@item %%(diary-bahai-date)
-Make a diary entry with today's equivalent Baha'i calendar date.
+Make a diary entry with today's equivalent Bah' calendar date.
@item %%(diary-chinese-date)
Make a diary entry with today's equivalent Chinese calendar date.
@item %%(diary-coptic-date)
diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi
index 4a09d6e3d9c..d1ddd0dce90 100644
--- a/doc/emacs/calendar.texi
+++ b/doc/emacs/calendar.texi
@@ -1,5 +1,5 @@
-@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c This is part of the Emacs manual. -*- coding: iso-latin-1 -*-
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Calendar/Diary
@@ -26,8 +26,8 @@ the calendar, type @kbd{q}.
@iftex
This chapter describes the basic calendar features.
-@inforef{Advanced Calendar/Diary Usage,, emacs-xtra}, for information
-about more specialized features.
+For more advanced topics,
+@pxref{Advanced Calendar/Diary Usage,,, emacs-xtra, Specialized Emacs Features}.
@end iftex
@menu
@@ -143,8 +143,7 @@ arguments in Calendar mode even without the Meta modifier. For example,
A week (or month, or year) is not just a quantity of days; we think of
weeks (months, years) as starting on particular dates. So Calendar mode
-provides commands to move to the beginning or end of a week, month or
-year:
+provides commands to move to the start or end of a week, month or year:
@table @kbd
@kindex C-a @r{(Calendar mode)}
@@ -246,12 +245,10 @@ Scroll calendar one month forward (@code{calendar-scroll-left}).
Scroll calendar one month backward (@code{calendar-scroll-right}).
@item C-v
@itemx @key{next}
-Scroll calendar three months forward
-(@code{calendar-scroll-left-three-months}).
+Scroll forward by three months (@code{calendar-scroll-left-three-months}).
@item M-v
@itemx @key{prior}
-Scroll calendar three months backward
-(@code{calendar-scroll-right-three-months}).
+Scroll backward by three months (@code{calendar-scroll-right-three-months}).
@end table
@kindex > @r{(Calendar mode)}
@@ -290,7 +287,8 @@ Display the number of days in the current region
@kindex M-= @r{(Calendar mode)}
@findex calendar-count-days-region
- To determine the number of days in the region, type @kbd{M-=}
+ To determine the number of days in a range, set the mark on one
+date using @kbd{C-SPC}, move point to another date, and type @kbd{M-=}
(@code{calendar-count-days-region}). The numbers of days shown is
@emph{inclusive}; that is, it includes the days specified by mark and
point.
@@ -342,18 +340,21 @@ buries all buffers related to the calendar, selecting other buffers.
calendar deletes or iconifies that frame depending on the value of
@code{calendar-remove-frame-by-deleting}.)
+@c FIXME this mentions holidays and diary entries, albeit briefly, so
+@c should it be moved after those sections? Or at least xref them.
@node Writing Calendar Files
@section Writing Calendar Files
- You can write calendars and diary entries to HTML and La@TeX{} files.
+ You can write calendars and diary entries to HTML and @LaTeX{} files.
@cindex calendar and HTML
The Calendar HTML commands produce files of HTML code that contain
-calendar and diary entries. Each file applies to one month, and has a
-name of the format @file{@var{yyyy}-@var{mm}.html}, where @var{yyyy} and
-@var{mm} are the four-digit year and two-digit month, respectively. The
-variable @code{cal-html-directory} specifies the default output
-directory for the HTML files.
+calendar, holiday, and diary entries. Each file applies to one month,
+and has a name of the format @file{@var{yyyy}-@var{mm}.html}, where
+@var{yyyy} and @var{mm} are the four-digit year and two-digit month,
+respectively. The variable @code{cal-html-directory} specifies the
+default output directory for the HTML files. To prevent holidays
+from being shown, customize @code{cal-html-holidays}.
@vindex cal-html-css-default
Diary entries enclosed by @code{<} and @code{>} are interpreted as
@@ -380,8 +381,8 @@ non-@code{nil}, then the monthly calendars show the day-of-the-year
number. The variable @code{cal-html-year-index-cols} specifies the
number of columns in the yearly index page.
-@cindex calendar and La@TeX{}
- The Calendar La@TeX{} commands produce a buffer of La@TeX{} code that
+@cindex calendar and @LaTeX{}
+ The Calendar @LaTeX{} commands produce a buffer of @LaTeX{} code that
prints as a calendar. Depending on the command you use, the printed
calendar covers the day, week, month or year that point is in.
@@ -396,17 +397,20 @@ Generate a sideways-printing one-month calendar
Generate a one-day calendar
(@code{cal-tex-cursor-day}).
@item t w 1
-Generate a one-page calendar for one week
+Generate a one-page calendar for one week, with hours
(@code{cal-tex-cursor-week}).
@item t w 2
-Generate a two-page calendar for one week
+Generate a two-page calendar for one week, with hours
(@code{cal-tex-cursor-week2}).
@item t w 3
-Generate an ISO-style calendar for one week
+Generate an ISO-style calendar for one week, without hours
(@code{cal-tex-cursor-week-iso}).
@item t w 4
-Generate a calendar for one Monday-starting week
+Generate a calendar for one Monday-starting week, with hours
(@code{cal-tex-cursor-week-monday}).
+@item t w W
+Generate a two-page calendar for one week, without hours
+(@code{cal-tex-cursor-week2-summary}).
@item t f w
Generate a Filofax-style two-weeks-at-a-glance calendar
(@code{cal-tex-cursor-filofax-2week}).
@@ -427,7 +431,7 @@ Generate a Filofax-style calendar for one year
Some of these commands print the calendar sideways (in ``landscape
mode''), so it can be wider than it is long. Some of them use Filofax
paper size (3.75in x 6.75in). All of these commands accept a prefix
-argument which specifies how many days, weeks, months or years to print
+argument, which specifies how many days, weeks, months or years to print
(starting always with the selected one).
If the variable @code{cal-tex-holidays} is non-@code{nil} (the default),
@@ -441,7 +445,7 @@ the individual cal-tex functions to see which calendars support which
features.
You can use the variable @code{cal-tex-preamble-extra} to insert extra
-La@TeX{} commands in the preamble of the generated document if you need
+@LaTeX{} commands in the preamble of the generated document if you need
to.
@node Holidays
@@ -452,11 +456,10 @@ to.
and can display them. You can add your own holidays to the default list.
@table @kbd
-@item h
+@item Mouse-3 Holidays
+@itemx h
Display holidays for the selected date
(@code{calendar-cursor-holidays}).
-@item Mouse-3 Holidays
-Display any holidays for the date you click on.
@item x
Mark holidays in the calendar window (@code{calendar-mark-holidays}).
@item u
@@ -490,7 +493,7 @@ window.
calendar, use the @kbd{x} command. This displays the dates that are
holidays in a different face.
@iftex
-@inforef{Calendar Customizing, calendar-holiday-marker, emacs-xtra}.
+@xref{Calendar Customizing,,, emacs-xtra, Specialized Emacs Features}.
@end iftex
@ifnottex
@xref{Calendar Customizing, calendar-holiday-marker}.
@@ -519,7 +522,7 @@ holidays centered around a different month, use @kbd{C-u M-x
holidays}, which prompts for the month and year.
The holidays known to Emacs include United States holidays and the
-major Baha'i, Chinese, Christian, Islamic, and Jewish holidays; also the
+major Bah', Chinese, Christian, Islamic, and Jewish holidays; also the
solstices and equinoxes.
@findex list-holidays
@@ -541,11 +544,10 @@ practice}, not historical fact. For example Veteran's Day began in
times of sunrise and sunset for any date.
@table @kbd
-@item S
+@item Mouse-3 Sunrise/sunset
+@itemx S
Display times of sunrise and sunset for the selected date
(@code{calendar-sunrise-sunset}).
-@item Mouse-3 Sunrise/sunset
-Display times of sunrise and sunset for the date you click on.
@item M-x sunrise-sunset
Display times of sunrise and sunset for today's date.
@item C-u M-x sunrise-sunset
@@ -615,9 +617,8 @@ for how daylight saving time is determined.
As a user, you might find it convenient to set the calendar location
variables for your usual physical location in your @file{.emacs} file.
-And when you install Emacs on a machine, you can create a
-@file{default.el} file which sets them properly for the typical location
-of most users of that machine. @xref{Init File}.
+If you are a system administrator, you may want to set these variables
+for all users in a @file{default.el} file. @xref{Init File}.
@node Lunar Phases
@section Phases of the Moon
@@ -627,7 +628,7 @@ of most users of that machine. @xref{Init File}.
These calendar commands display the dates and times of the phases of
the moon (new moon, first quarter, full moon, last quarter). This
feature is useful for debugging problems that ``depend on the phase of
-the moon.''
+the moon''.
@table @kbd
@item M
@@ -666,8 +667,8 @@ sixteenth century and was not widely used before the eighteenth century;
it did not fully displace the Julian calendar and gain universal
acceptance until the early twentieth century. The Emacs calendar can
display any month since January, year 1 of the current era, but the
-calendar displayed is the Gregorian, even for a date at which the
-Gregorian calendar did not exist.
+calendar displayed is always the Gregorian, even for a date at which
+the Gregorian calendar did not exist.
While Emacs cannot display other calendars, it can convert dates to
and from several other calendars.
@@ -680,11 +681,13 @@ and from several other calendars.
* Mayan Calendar:: Moving to a date specified in a Mayan calendar.
@end menu
+@c FIXME perhaps most of the details should be moved to cal-xtra.
+@c Just list the major supported systems here?
@node Calendar Systems
@subsection Supported Calendar Systems
@cindex ISO commercial calendar
- The ISO commercial calendar is used largely in Europe.
+ The ISO commercial calendar is often used in business.
@cindex Julian calendar
The Julian calendar, named after Julius Caesar, was the one used in Europe
@@ -745,7 +748,8 @@ championed by Birashk, based on a 2,820-year cycle. It differs from
the astronomical Persian calendar, which is based on astronomical
events. As of this writing the first future discrepancy is projected
to occur on March 20, 2025. It is currently not clear what the
-official calendar of Iran will be that far into the future.
+official calendar of Iran will be at that time.
+@c FIXME not so far in the future now.
@cindex Chinese calendar
The Chinese calendar is a complicated system of lunar months arranged
@@ -756,8 +760,8 @@ days are named by combining one of ten ``celestial stems'' with one of
twelve ``terrestrial branches'' for a total of sixty names that are
repeated in a cycle of sixty.
-@cindex Baha'i calendar
- The Baha'i calendar system is based on a solar cycle of 19 months with
+@cindex Bah' calendar
+ The Bah' calendar system is based on a solar cycle of 19 months with
19 days each. The four remaining ``intercalary'' days are placed
between the 18th and 19th months.
@@ -768,11 +772,10 @@ between the 18th and 19th months.
in various other calendar systems:
@table @kbd
-@item Mouse-3 Other calendars
-Display the date that you click on, expressed in various other calendars.
@kindex p @r{(Calendar mode)}
@findex calendar-print-other-dates
-@item p o
+@item Mouse-3 Other calendars
+@itemx p o
Display the selected date in various other calendars.
(@code{calendar-print-other-dates}).
@findex calendar-iso-print-date
@@ -798,7 +801,7 @@ Display French Revolutionary date for selected day
(@code{calendar-french-print-date}).
@findex calendar-bahai-print-date
@item p b
-Display Baha'i date for selected day
+Display Bah' date for selected day
(@code{calendar-bahai-print-date}).
@findex calendar-chinese-print-date
@item p C
@@ -821,18 +824,16 @@ Display Persian date for selected day
Display Mayan date for selected day (@code{calendar-mayan-print-date}).
@end table
- If you are using a graphic display, the easiest way to translate a
-date into other calendars is to click on it with @kbd{Mouse-3}, then
-choose @kbd{Other calendars} from the menu that appears. This displays
-the equivalent forms of the date in all the calendars Emacs understands,
-in the form of a menu. (Choosing an alternative from this menu doesn't
-actually do anything---the menu is used only for display.)
-
Otherwise, move point to the date you want to convert, then type the
appropriate command starting with @kbd{p} from the table above. The
-prefix @kbd{p} is a mnemonic for ``print,'' since Emacs ``prints'' the
+prefix @kbd{p} is a mnemonic for ``print'', since Emacs ``prints'' the
equivalent date in the echo area. @kbd{p o} displays the
-date in all forms known to Emacs.
+date in all forms known to Emacs. You can also use @kbd{Mouse-3} and
+then choose @kbd{Other calendars} from the menu that appears. This
+displays the equivalent forms of the date in all the calendars Emacs
+understands, in the form of a menu. (Choosing an alternative from
+this menu doesn't actually do anything---the menu is used only for
+display.)
@node From Other Calendar
@subsection Converting From Other Calendars
@@ -868,7 +869,7 @@ Move to a date specified in the Julian calendar
Move to a date specified with an astronomical (Julian) day number
(@code{calendar-astro-goto-day-number}).
@item g b
-Move to a date specified in the Baha'i calendar
+Move to a date specified in the Bah' calendar
(@code{calendar-bahai-goto-date}).
@item g h
Move to a date specified in the Hebrew calendar
@@ -903,8 +904,8 @@ Islamic, or French names.
@c FIXME move?
@findex calendar-hebrew-list-yahrzeits
@cindex yahrzeits
- One common question concerning the Hebrew calendar is the computation
-of the anniversary of a date of death, called a ``yahrzeit.'' The Emacs
+ One common issue concerning the Hebrew calendar is the computation
+of the anniversary of a date of death, called a ``yahrzeit''. The Emacs
calendar includes a facility for such calculations. If you are in the
calendar, the command @kbd{M-x calendar-hebrew-list-yahrzeits} asks you for
a range of years and then displays a list of the yahrzeit dates for those
@@ -912,6 +913,7 @@ years for the date given by point. If you are not in the calendar,
this command first asks you for the date of death and the range of
years, and then displays the list of yahrzeit dates.
+@c FIXME move to emacs-xtra.
@node Mayan Calendar
@subsection Converting from the Mayan Calendar
@@ -974,7 +976,7 @@ to go to the next occurrence of a tzolkin date.
@findex calendar-mayan-next-haab-date
@cindex Mayan haab calendar
The Mayan haab calendar is a cycle of 365 days arranged as 18 months
-of 20 days each, followed a 5-day monthless period. Like the tzolkin
+of 20 days each, followed by a 5-day monthless period. Like the tzolkin
cycle, this cycle repeats endlessly, and there are commands to move
backward and forward to the previous or next point in the cycle. Type
@kbd{g m p h} to go to the previous haab date; Emacs asks you for a haab
@@ -1014,7 +1016,7 @@ date.
showing what that file looks like:
@example
-12/22/1988 Twentieth wedding anniversary!!
+12/22/2012 Twentieth wedding anniversary!!
&1/1. Happy New Year!
10/22 Ruth's birthday.
* 21, *: Payday
@@ -1023,15 +1025,15 @@ Tuesday--weekly meeting with grad students at 10am
1/13/89 Friday the thirteenth!!
&thu 4pm squash game with Lloyd.
mar 16 Dad's birthday
-April 15, 1989 Income tax due.
+April 15, 2013 Income tax due.
&* 15 time cards due.
@end example
@noindent
-This format is essentially the same as the one used by the system's
-@command{calendar} utility. This example uses extra spaces to align
-the event descriptions of most of the entries. Such formatting is
-purely a matter of taste.
+This format is essentially the same as the one used by the separate
+@command{calendar} utility that is present on some Unix systems. This
+example uses extra spaces to align the event descriptions of most of
+the entries. Such formatting is purely a matter of taste.
Although you probably will start by creating a diary manually, Emacs
provides a number of commands to let you view, add, and change diary
@@ -1053,11 +1055,10 @@ it. You can also view today's events outside of Calendar mode. In the
following, key bindings refer to the Calendar buffer.
@table @kbd
-@item d
+@item Mouse-3 Diary
+@itemx d
Display all diary entries for the selected date
(@code{diary-view-entries}).
-@item Mouse-3 Diary
-Display all diary entries for the date you click on.
@item s
Display the entire diary file (@code{diary-show-all-entries}).
@item m
@@ -1105,14 +1106,14 @@ current date is visible).
the @kbd{m} command. This marks the dates that have diary entries in
a different face.
@iftex
-@inforef{Calendar Customizing, diary-entry-marker, emacs-xtra}.
+@xref{Calendar Customizing,,, emacs-xtra, Specialized Emacs Features}.
@end iftex
@ifnottex
@xref{Calendar Customizing, diary-entry-marker}.
@end ifnottex
- The command applies both to the currently visible months and to
-other months that subsequently become visible by scrolling. To turn
+ This command applies both to the months that are currently visible
+and to those that subsequently become visible after scrolling. To turn
marking off and erase the current marks, type @kbd{u}, which also
turns off holiday marks (@pxref{Holidays}). If the variable
@code{calendar-mark-diary-entries-flag} is non-@code{nil}, creating or
@@ -1129,20 +1130,20 @@ date, independently of the calendar display, and optionally for the next
few days as well; the variable @code{diary-number-of-entries} specifies
how many days to include.
@iftex
-@inforef{Diary Customizing,, emacs-xtra}.
+@xref{Diary Customizing,,, emacs-xtra, Specialized Emacs Features}.
@end iftex
@ifnottex
@xref{Diary Customizing, diary-number-of-entries}.
@end ifnottex
If you put @code{(diary)} in your @file{.emacs} file, this
-automatically displays a window with the day's diary entries, when you
-enter Emacs.
+automatically displays a window with the day's diary entries when you
+start Emacs.
@findex diary-mail-entries
@vindex diary-mail-days
- Many users like to receive notice of events in their diary as email.
-To send such mail to yourself, use the command @kbd{M-x
+ Some people like to receive email notifications of events in their
+diary. To send such mail to yourself, use the command @kbd{M-x
diary-mail-entries}. A prefix argument specifies how many days
(starting with today) to check; otherwise, the variable
@code{diary-mail-days} says how many days.
@@ -1173,7 +1174,7 @@ consists only of the date or day name (with no following blanks or
punctuation). For example:
@example
-02/11/1989
+02/11/2012
Bill B. visits Princeton today
2pm Cognitive Studies Committee meeting
2:30-5:30 Liz at Lawrenceville
@@ -1198,10 +1199,11 @@ for more than one day's entries.
@vindex diary-nonmarking-symbol
You can inhibit the marking of certain diary entries in the calendar
-window; to do this, insert an ampersand @code{diary-nonmarking-symbol}
-(default @samp{&}) at the beginning of the entry, before the date. This
-has no effect on display of the entry in the diary window; it affects
-only marks on dates in the calendar window. Nonmarking entries are
+window; to do this, insert the string that
+@code{diary-nonmarking-symbol} specifies (default @samp{&}) at the
+beginning of the entry, before the date. This
+has no effect on display of the entry in the diary window; it only
+affects marks on dates in the calendar window. Nonmarking entries are
especially useful for generic entries that would otherwise mark many
different dates.
@@ -1214,14 +1216,14 @@ formatting a date. The examples all show dates in American order
month, year) and ISO order (year, month, day) as options.
@example
-4/20/93 Switch-over to new tabulation system
+4/20/12 Switch-over to new tabulation system
apr. 25 Start tabulating annual results
4/30 Results for April are due
*/25 Monthly cycle finishes
Friday Don't leave without backing up files
@end example
- The first entry appears only once, on April 20, 1993. The second and
+ The first entry appears only once, on April 20, 2012. The second and
third appear every year on the specified dates, and the fourth uses a
wildcard (asterisk) for the month, so it appears on the 25th of every
month. The final entry appears every week on Friday.
@@ -1231,7 +1233,7 @@ month. The final entry appears every week on Friday.
This must be followed by a nondigit. In the date itself, @var{month}
and @var{day} are numbers of one or two digits. The optional @var{year}
is also a number, and may be abbreviated to the last two digits; that
-is, you can use @samp{11/12/1989} or @samp{11/12/89}.
+is, you can use @samp{11/12/2012} or @samp{11/12/12}.
Dates can also have the form @samp{@var{monthname} @var{day}} or
@samp{@var{monthname} @var{day}, @var{year}}, where the month's name can
@@ -1245,7 +1247,7 @@ letters of a name as its abbreviation. Case is not significant.
A date may be @dfn{generic}; that is, partially unspecified. Then the
entry applies to all dates that match the specification. If the date
does not contain a year, it is generic and applies to any year.
-Alternatively, @var{month}, @var{day}, or @var{year} can be a @samp{*};
+Alternatively, @var{month}, @var{day}, or @var{year} can be @samp{*};
this matches any month, day, or year, respectively. Thus, a diary entry
@samp{3/*/*} matches any day in March of any year; so does @samp{march
*}.
@@ -1272,7 +1274,7 @@ entries. The basic commands are listed here; more sophisticated
commands are in the next section (@pxref{Special Diary Entries}).
Entries can also be based on non-Gregorian calendars.
@iftex
-@inforef{Non-Gregorian Diary,, emacs-xtra}.
+@xref{Non-Gregorian Diary,,, emacs-xtra, Specialized Emacs Features}.
@end iftex
@ifnottex
@xref{Non-Gregorian Diary}.
@@ -1311,7 +1313,7 @@ command, and type the rest of the entry. Similarly, you can insert a
yearly diary entry with the @kbd{i y} command.
All of the above commands make marking diary entries by default. To
-make a nonmarking diary entry, give a numeric argument to the command.
+make a nonmarking diary entry, give a prefix argument to the command.
For example, @kbd{C-u i w} makes a nonmarking weekly diary entry.
When you modify the diary file, be sure to save the file before
@@ -1368,15 +1370,15 @@ diary functions can use it to calculate the number of elapsed years.
A @dfn{block} diary entry applies to a specified range of consecutive
dates. Here is a block diary entry that applies to all dates from June
-24, 1990 through July 10, 1990:
+24, 2012 through July 10, 2012:
@findex diary-block
@example
-%%(diary-block 6 24 1990 7 10 1990) Vacation
+%%(diary-block 6 24 2012 7 10 2012) Vacation
@end example
@noindent
-The @samp{6 24 1990} indicates the starting date and the @samp{7 10 1990}
+The @samp{6 24 2012} indicates the starting date and the @samp{7 10 2012}
indicates the stopping date. (Again, if you are using the European or ISO
calendar style, the input order of month, day and year is different.)
@@ -1396,23 +1398,23 @@ which looks like this:
@findex diary-cyclic
@example
-%%(diary-cyclic 50 3 1 1990) Renew medication
+%%(diary-cyclic 50 3 1 2012) Renew medication
@end example
@noindent
-This entry applies to March 1, 1990 and every 50th day following;
-@samp{3 1 1990} specifies the starting date. (If you are using the
+This entry applies to March 1, 2012 and every 50th day following;
+@samp{3 1 2012} specifies the starting date. (If you are using the
European or ISO calendar style, the input order of month, day and year
is different.)
All three of these commands make marking diary entries. To insert a
-nonmarking entry, give a numeric argument to the command. For example,
+nonmarking entry, give a prefix argument to the command. For example,
@kbd{C-u i a} makes a nonmarking anniversary diary entry.
- Marking sexp diary entries in the calendar is @emph{extremely}
-time-consuming, since every date visible in the calendar window must be
-individually checked. So it's a good idea to make sexp diary entries
-nonmarking (with @samp{&}) when possible.
+ Marking sexp diary entries in the calendar can be time-consuming,
+since every date visible in the calendar window must be individually
+checked. So it's a good idea to make sexp diary entries nonmarking
+(with @samp{&}) when possible.
Another sophisticated kind of sexp entry, a @dfn{floating} diary entry,
specifies a regularly occurring event by offsets specified in days,
@@ -1428,8 +1430,8 @@ that applies to the fourth Thursday in November:
@noindent
The 11 specifies November (the eleventh month), the 4 specifies Thursday
(the fourth day of the week, where Sunday is numbered zero), and the
-second 4 specifies the fourth Thursday (1 would mean ``first,'' 2 would
-mean ``second,'' @minus{}2 would mean ``second-to-last,'' and so on).
+second 4 specifies the fourth Thursday (1 would mean ``first'', 2 would
+mean ``second'', @minus{}2 would mean ``second-to-last'', and so on).
The month can be a single month or a list of months. Thus you could change
the 11 above to @samp{'(1 2 3)} and have the entry apply to the last
Thursday of January, February, and March. If the month is @code{t}, the
@@ -1440,7 +1442,7 @@ specifying the name of a face or a single-character string to use when
marking the entry in the calendar. Most generally, sexp diary entries
can perform arbitrary computations to determine when they apply.
@iftex
-@inforef{Sexp Diary Entries,, emacs-xtra}.
+@xref{Sexp Diary Entries,,, emacs-xtra, Specialized Emacs Features}.
@end iftex
@ifnottex
@xref{Sexp Diary Entries}.
@@ -1454,8 +1456,8 @@ can perform arbitrary computations to determine when they apply.
@vindex appt-audible
@vindex appt-display-mode-line
If you have a diary entry for an appointment, and that diary entry
-begins with a recognizable time of day, Emacs can warn you several
-minutes beforehand that that appointment is pending. Emacs alerts you
+begins with a recognizable time of day, Emacs can warn you in advance
+that an appointment is pending. Emacs alerts you
to the appointment by displaying a message in your chosen format, as
specified by the variable @code{appt-display-format}. If the value of
@code{appt-audible} is non-@code{nil}, the warning includes an audible
@@ -1514,7 +1516,7 @@ display the day's diary buffer, unless you set
@code{appt-display-diary} to @code{nil}. The appointments list is
also updated whenever the diary file (or a file it includes; see
@iftex
-@inforef{Fancy Diary Display,, emacs-xtra})
+@ref{Fancy Diary Display,,, emacs-xtra, Specialized Emacs Features})
@end iftex
@ifnottex
@ref{Fancy Diary Display})
@@ -1542,6 +1544,7 @@ diary-from-outlook} to import the entry. You can make this command
recognize additional appointment message formats by customizing the
variable @code{diary-outlook-formats}.
+@c FIXME the name of the RFC is hardly very relevant.
@cindex iCalendar support
The icalendar package allows you to transfer data between your Emacs
diary file and iCalendar files, which are defined in ``RFC
@@ -1556,7 +1559,7 @@ diary file and iCalendar files, which are defined in ``RFC
@findex icalendar-import-buffer
The command @code{icalendar-import-buffer} extracts
-iCalendar data from the current buffer and adds it to your (default)
+iCalendar data from the current buffer and adds it to your
diary file. This function is also suitable for automatic extraction of
iCalendar data; for example with the Rmail mail client one could use:
@@ -1577,7 +1580,7 @@ and adds the results to an Emacs diary file. For example:
You can use an @code{#include} directive to add the import file contents
to the main diary file, if these are different files.
@iftex
-@inforef{Fancy Diary Display,, emacs-xtra}.
+@xref{Fancy Diary Display,,, emacs-xtra, Specialized Emacs Features}.
@end iftex
@ifnottex
@xref{Fancy Diary Display}.
@@ -1588,7 +1591,7 @@ to the main diary file, if these are different files.
Use @code{icalendar-export-file} to interactively export an entire
Emacs diary file to iCalendar format. To export only a part of a diary
file, mark the relevant area, and call @code{icalendar-export-region}.
-In both cases the result is appended to the target file.
+In both cases, Emacs appends the result to the target file.
@node Daylight Saving
@section Daylight Saving Time
@@ -1682,7 +1685,7 @@ timeclock-change}.
Once you've collected data from a number of time intervals, you can use
@kbd{M-x timeclock-workday-remaining} to see how much time is left to
work today (assuming a typical average of 8 hours a day), and @kbd{M-x
-timeclock-when-to-leave} which will calculate when you're ``done.''
+timeclock-when-to-leave} which will calculate when you're ``done''.
@vindex timeclock-modeline-display
@findex timeclock-modeline-display
@@ -1694,7 +1697,7 @@ workday in the mode line, either customize the
@vindex timeclock-ask-before-exiting
Terminating the current Emacs session might or might not mean that
you have stopped working on the project and, by default, Emacs asks
-you. You can, however, set customize the value of the variable
+you. You can, however, customize the value of the variable
@code{timeclock-ask-before-exiting} to @code{nil} to avoid the question;
then, only an explicit @kbd{M-x timeclock-out} or @kbd{M-x
timeclock-change} will tell Emacs that the current interval is over.
diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi
index d9109045570..d4573eed5a8 100644
--- a/doc/emacs/cmdargs.texi
+++ b/doc/emacs/cmdargs.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Emacs Invocation, X Resources, GNU Free Documentation License, Top
+@node Emacs Invocation
@appendix Command Line Arguments for Emacs Invocation
@cindex command line arguments
@cindex arguments (command line)
@@ -65,7 +65,6 @@ arguments.)
and call functions.
* Initial Options:: Arguments that take effect while starting Emacs.
* Command Example:: Examples of using command line arguments.
-* Resume Arguments:: Specifying arguments when you resume a running Emacs.
* Environment:: Environment variables that Emacs uses.
* Display X:: Changing the default display and using remote login.
* Font X:: Choosing a font for text, under X.
@@ -124,10 +123,9 @@ Visit @var{file} using @code{find-file}, then go to line number
@opindex --load
@cindex loading Lisp libraries, command-line argument
Load a Lisp library named @var{file} with the function @code{load}.
-@xref{Lisp Libraries}. If @var{file} is not an absolute file name,
-the library can be found either in the current directory, or in the
-Emacs library search path as specified with @env{EMACSLOADPATH}
-(@pxref{General Variables}).
+If @var{file} is not an absolute file name, Emacs first looks for it
+in the current directory, then in the directories listed in
+@code{load-path} (@pxref{Lisp Libraries}).
@strong{Warning:} If previous command-line arguments have visited
files, the current directory is the directory of the last file
@@ -159,7 +157,7 @@ Evaluate Lisp expression @var{expression}.
@item --insert=@var{file}
@opindex --insert
@cindex insert file contents, command-line argument
-Insert the contents of @var{file} into the @samp{*scratch*} buffer
+Insert the contents of @var{file} into the @file{*scratch*} buffer
(@pxref{Lisp Interaction}). This is like what @kbd{M-x insert-file}
does (@pxref{Misc File Ops}).
@@ -186,11 +184,11 @@ specifically related to the X Window System appear in the following
sections.
Some initial options affect the loading of the initialization file.
-The normal actions of Emacs are to first load @file{site-start.el} if
-it exists, then your own initialization file @file{~/.emacs} if it
-exists, and finally @file{default.el} if it exists. @xref{Init File}.
-Certain options prevent loading of some of these files or substitute
-other files for them.
+Normally, Emacs first loads @file{site-start.el} if it exists, then
+your own initialization file if it exists, and finally the default
+initialization file @file{default.el} if it exists (@pxref{Init
+File}). Certain options prevent loading of some of these files or
+substitute other files for them.
@table @samp
@item -chdir @var{directory}
@@ -207,8 +205,8 @@ stopped. This makes desktop saving and restoring easier.
@itemx --terminal=@var{device}
@opindex --terminal
@cindex device for Emacs terminal I/O
-Use @var{device} as the device for terminal input and output.
-@samp{--terminal} implies @samp{--no-window-system}.
+Use @var{device} as the device for terminal input and output. This
+option implies @samp{--no-window-system}.
@item -d @var{display}
@opindex -d
@@ -252,7 +250,7 @@ terminal's standard input stream (@code{stdin}) instead.
@samp{--batch} implies @samp{-q} (do not load an initialization file),
but @file{site-start.el} is loaded nonetheless. It also causes Emacs
to exit after processing all the command options. In addition, it
-disables auto-saving except in buffers for which it has been
+disables auto-saving except in buffers for which auto-saving is
explicitly requested.
@item --script @var{file}
@@ -270,8 +268,8 @@ Emacs. They can start with this text on the first line
@noindent
which will invoke Emacs with @samp{--script} and supply the name of
-the script file as @var{file}. Emacs Lisp then treats @samp{#!} as a
-comment delimiter.
+the script file as @var{file}. Emacs Lisp then treats the @samp{#!}
+on this first line as a comment delimiter.
@item -q
@opindex -q
@@ -280,11 +278,10 @@ comment delimiter.
@cindex bypassing init and @file{default.el} file
@cindex init file, not loading
@cindex @file{default.el} file, not loading
-Do not load your Emacs initialization file, and do not load the file
-@file{default.el} either (@pxref{Init File}). Regardless of this
-switch, @file{site-start.el} is still loaded. When Emacs is invoked
-like this, the Customize facility does not allow options to be saved
-(@pxref{Easy Customization}).
+Do not load any initialization file (@pxref{Init File}). When Emacs
+is invoked with this option, the Customize facility does not allow
+options to be saved (@pxref{Easy Customization}). This option does
+not disable loading @file{site-start.el}.
@item --no-site-file
@opindex --no-site-file
@@ -311,7 +308,7 @@ in your initialization file (@pxref{Entering Emacs}).
@opindex -Q
@itemx --quick
@opindex --quick
-Start emacs with minimum customizations, similar to using @samp{-q},
+Start emacs with minimum customizations. This is similar to using @samp{-q},
@samp{--no-site-file}, @samp{--no-site-lisp}, and @samp{--no-splash}
together. This also stops Emacs from processing X resources by
setting @code{inhibit-x-resources} to @code{t} (@pxref{Resources}).
@@ -371,45 +368,6 @@ also guarantees there will be no problem redirecting output to
@file{log}, because Emacs will not assume that it has a display terminal
to work with.
-@node Resume Arguments
-@appendixsec Resuming Emacs with Arguments
-
- You can specify action arguments for Emacs when you resume it after
-a suspension. To prepare for this, put the following code in your
-@file{.emacs} file (@pxref{Hooks}):
-
-@c `resume-suspend-hook' is correct. It is the name of a function.
-@example
-(add-hook 'suspend-hook 'resume-suspend-hook)
-(add-hook 'suspend-resume-hook 'resume-process-args)
-@end example
-
- As further preparation, you must execute the shell script
-@file{emacs.csh} (if you use csh as your shell) or @file{emacs.bash}
-(if you use bash as your shell). These scripts define an alias named
-@code{edit}, which will resume Emacs giving it new command line
-arguments such as files to visit. The scripts are found in the
-@file{etc} subdirectory of the Emacs distribution.
-
- Only action arguments work properly when you resume Emacs. Initial
-arguments are not recognized---it's too late to execute them anyway.
-
- Note that resuming Emacs (with or without arguments) must be done from
-within the shell that is the parent of the Emacs job. This is why
-@code{edit} is an alias rather than a program or a shell script. It is
-not possible to implement a resumption command that could be run from
-other subjobs of the shell; there is no way to define a command that could
-be made the value of @env{EDITOR}, for example. Therefore, this feature
-does not take the place of the Emacs Server feature (@pxref{Emacs
-Server}).
-
- The aliases use the Emacs Server feature if you appear to have a
-server Emacs running. However, they cannot determine this with complete
-accuracy. They may think that a server is still running when in
-actuality you have killed that Emacs, because the file
-@file{/tmp/esrv@dots{}} still exists. If this happens, find that
-file and delete it.
-
@node Environment
@appendixsec Environment Variables
@cindex environment variables
@@ -424,19 +382,19 @@ letters only. The values are all text strings.
environment automatically from their parent process. This means you
can set up an environment variable in your login shell, and all the
programs you run (including Emacs) will automatically see it.
-Subprocesses of Emacs (such as shells, compilers, and version-control
-software) inherit the environment from Emacs, too.
+Subprocesses of Emacs (such as shells, compilers, and version control
+programs) inherit the environment from Emacs, too.
@findex setenv
@findex getenv
@vindex initial-environment
- Inside Emacs, the command @kbd{M-x getenv} gets the value of an
-environment variable. @kbd{M-x setenv} sets a variable in the Emacs
-environment, and @kbd{C-u M-x setenv} removes a variable.
-(Environment variable substitutions with @samp{$} work in the value
-just as in file names; see @ref{File Names with $}.) The variable
-@code{initial-environment} stores the initial environment inherited by
-Emacs.
+ Inside Emacs, the command @kbd{M-x getenv} reads the name of an
+environment variable, and prints its value in the echo area. @kbd{M-x
+setenv} sets a variable in the Emacs environment, and @kbd{C-u M-x
+setenv} removes a variable. (Environment variable substitutions with
+@samp{$} work in the value just as in file names; see @ref{File Names
+with $}.) The variable @code{initial-environment} stores the initial
+environment inherited by Emacs.
The way to set environment variables outside of Emacs depends on the
operating system, and especially the shell that you are using. For
@@ -476,29 +434,37 @@ variables to be set, but it uses their values if they are set.
@item CDPATH
Used by the @code{cd} command to search for the directory you specify,
when you specify a relative directory name.
+@item DBUS_SESSION_BUS_ADDRESS
+Used by D-Bus when Emacs is compiled with it. Usually, there is no
+need to change it. Setting it to a dummy address, like
+@samp{unix:path=/tmp/foo}, suppresses connections to the D-Bus session
+bus.
@item EMACSDATA
Directory for the architecture-independent files that come with Emacs.
-This is used to initialize the Lisp variable @code{data-directory}.
+This is used to initialize the variable @code{data-directory}.
@item EMACSDOC
Directory for the documentation string file, which is used to
initialize the Lisp variable @code{doc-directory}.
@item EMACSLOADPATH
-A colon-separated list of directories@footnote{
-Here and below, whenever we say ``colon-separated list of directories,''
-it pertains to Unix and GNU/Linux systems. On MS-DOS and MS-Windows,
-the directories are separated by semi-colons instead, since DOS/Windows
-file names might include a colon after a drive letter.}
-to search for Emacs Lisp files---used to initialize @code{load-path}.
+A colon-separated list of directories@footnote{ Here and below,
+whenever we say ``colon-separated list of directories'', it pertains
+to Unix and GNU/Linux systems. On MS-DOS and MS-Windows, the
+directories are separated by semi-colons instead, since DOS/Windows
+file names might include a colon after a drive letter.} to search for
+Emacs Lisp files. If set, it overrides the usual initial value of the
+@code{load-path} variable (@pxref{Lisp Libraries}).
@item EMACSPATH
-A colon-separated list of directories to search for executable
-files---used to initialize @code{exec-path}.
+A colon-separated list of directories to search for executable files.
+If set, Emacs uses this in addition to @env{PATH} (see below) when
+initializing the variable @code{exec-path} (@pxref{Shell}).
@item EMAIL
@vindex user-mail-address@r{, initialization}
Your email address; used to initialize the Lisp variable
-@code{user-mail-address}, which the Emacs mail interface puts into
-the @samp{From} header of outgoing messages (@pxref{Mail Headers}).
+@code{user-mail-address}, which the Emacs mail interface puts into the
+@samp{From} header of outgoing messages (@pxref{Mail Headers}).
@item ESHELL
-Used for shell-mode to override the @env{SHELL} environment variable.
+Used for shell-mode to override the @env{SHELL} environment variable
+(@pxref{Interactive Shell}).
@item HISTFILE
The name of the file that shell commands are saved in between logins.
This variable defaults to @file{~/.bash_history} if you use Bash, to
@@ -554,23 +520,28 @@ environment and coding system. @xref{Language Environments}.
The user's login name. See also @env{USER}.
@item MAIL
The name of your system mail inbox.
+@ifnottex
@item MH
-Name of setup file for the mh system. (The default is @file{~/.mh_profile}.)
+Name of setup file for the mh system. @xref{Top,,MH-E,mh-e, The Emacs
+Interface to MH}.
+@end ifnottex
@item NAME
-Your real-world name.
+Your real-world name. This is used to initialize the variable
+@code{user-full-name} (@pxref{Mail Headers}).
@item NNTPSERVER
The name of the news server. Used by the mh and Gnus packages.
@item ORGANIZATION
The name of the organization to which you belong. Used for setting the
`Organization:' header in your posts from the Gnus package.
@item PATH
-A colon-separated list of directories in which executables reside. This
-is used to initialize the Emacs Lisp variable @code{exec-path}.
+A colon-separated list of directories containing executable files.
+This is used to initialize the variable @code{exec-path}
+(@pxref{Shell}).
@item PWD
If set, this should be the default directory when Emacs was started.
@item REPLYTO
If set, this specifies an initial value for the variable
-@code{mail-default-reply-to}. @xref{Mail Headers}.
+@code{mail-default-reply-to} (@pxref{Mail Headers}).
@item SAVEDIR
The name of a directory in which news articles are saved by default.
Used by the Gnus package.
@@ -578,23 +549,29 @@ Used by the Gnus package.
The name of an interpreter used to parse and execute programs run from
inside Emacs.
@item SMTPSERVER
-The name of the outgoing mail server. Used by the SMTP library
-(@pxref{Top,,,smtpmail,Sending mail via SMTP}).
+The name of the outgoing mail server. This is used to initialize the
+variable @code{smtpmail-smtp-server} (@pxref{Mail Sending}).
@cindex background mode, on @command{xterm}
@item TERM
The type of the terminal that Emacs is using. This variable must be
set unless Emacs is run in batch mode. On MS-DOS, it defaults to
@samp{internal}, which specifies a built-in terminal emulation that
-handles the machine's own display. If the value of @env{TERM} indicates
-that Emacs runs in non-windowed mode from @command{xterm} or a similar
-terminal emulator, the background mode defaults to @samp{light}, and
-Emacs will choose colors that are appropriate for a light background.
+handles the machine's own display.
@item TERMCAP
The name of the termcap library file describing how to program the
-terminal specified by the @env{TERM} variable. This defaults to
+terminal specified by @env{TERM}. This defaults to
@file{/etc/termcap}.
@item TMPDIR
-Used by the Emerge package as a prefix for temporary files.
+@itemx TMP
+@itemx TEMP
+These environment variables are used to initialize the variable
+@code{temporary-file-directory}, which specifies a directory in which
+to put temporary files (@pxref{Backup}). Emacs tries to use
+@env{TMPDIR} first; if that is unset, it tries @env{TMP}, then
+@env{TEMP}, and finally @file{/tmp}. But on MS-Windows and MS-DOS,
+Emacs tries @env{TEMP}, then @env{TMPDIR}, then @env{TMP}, and finally
+@file{c:/temp}.
+
@item TZ
This specifies the current time zone and possibly also daylight
saving time information. On MS-DOS, if @env{TZ} is not set in the
@@ -605,7 +582,8 @@ does not use @env{TZ} at all.
The user's login name. See also @env{LOGNAME}. On MS-DOS, this
defaults to @samp{root}.
@item VERSION_CONTROL
-Used to initialize the @code{version-control} variable (@pxref{Backup Names}).
+Used to initialize the @code{version-control} variable (@pxref{Backup
+Names}).
@end table
@node Misc Variables
@@ -624,11 +602,6 @@ variable.
On MS-DOS, this variable defaults to the value of the @env{USER}
variable.
-@item TEMP
-@itemx TMP
-On MS-DOS and MS-Windows, these specify the name of the directory for
-storing temporary files in.
-
@item EMACSTEST
On MS-DOS, this specifies a file to use to log the operation of the
internal terminal emulator. This feature is useful for submitting bug
@@ -675,9 +648,9 @@ changing any environment or registry settings.
@node MS-Windows Registry
@appendixsubsec The MS-Windows System Registry
@pindex addpm, MS-Windows installation program
-@cindex registry, setting environment variables and resources on MS-Windows
+@cindex registry, setting environment variables (MS-Windows)
-Under MS-Windows, the installation program @command{addpm.exe} adds
+On MS-Windows, the installation program @command{addpm.exe} adds
values for @env{emacs_dir}, @env{EMACSLOADPATH}, @env{EMACSDATA},
@env{EMACSPATH}, @env{EMACSDOC}, @env{SHELL} and @env{TERM} to the
@file{HKEY_LOCAL_MACHINE} section of the system registry, under
@@ -704,37 +677,27 @@ still cannot determine the values, compiled-in defaults are used.
In addition to the environment variables above, you can also add many
of the settings which on X belong in the @file{.Xdefaults} file
(@pxref{X Resources}) to the @file{/Software/GNU/Emacs} registry key.
-Settings you add to the @file{HKEY_LOCAL_MACHINE} section will affect
-all users of the machine. Settings you add to the
-@file{HKEY_CURRENT_USER} section will only affect you, and will
-override machine wide settings.
@node Display X
@appendixsec Specifying the Display Name
@cindex display name (X Window System)
@cindex @env{DISPLAY} environment variable
- The environment variable @env{DISPLAY} tells all X clients, including
-Emacs, where to display their windows. Its value is set by default
-in ordinary circumstances, when you start an X server and run jobs
-locally. Occasionally you may need to specify the display yourself; for
-example, if you do a remote login and want to run a client program
-remotely, displaying on your local screen.
-
- With Emacs, the main reason people change the default display is to
-let them log into another system, run Emacs on that system, but have the
-window displayed at their local terminal. You might need to log in
-to another system because the files you want to edit are there, or
-because the Emacs executable file you want to run is there.
+ The environment variable @env{DISPLAY} tells all X clients,
+including Emacs, where to display their windows. Its value is set by
+default in ordinary circumstances, when you start an X server and run
+jobs locally. You can specify the display yourself; one reason to do
+this is if you want to log into another system and run Emacs there,
+and have the window displayed at your local terminal.
@env{DISPLAY} has the syntax
@samp{@var{host}:@var{display}.@var{screen}}, where @var{host} is the
host name of the X Window System server machine, @var{display} is an
arbitrarily-assigned number that distinguishes your server (X
terminal) from other servers on the same machine, and @var{screen} is
-a rarely-used field that allows an X server to control multiple
-terminal screens. The period and the @var{screen} field are optional.
-If included, @var{screen} is usually zero.
+a field that allows an X server to control multiple terminal screens.
+The period and the @var{screen} field are optional. If included,
+@var{screen} is usually zero.
For example, if your host is named @samp{glasperle} and your server is
the first (or perhaps the only) server listed in the configuration, your
@@ -748,9 +711,9 @@ by changing the @env{DISPLAY} variable, or with the option @samp{-d
emacs --display=glasperle:0 &
@end smallexample
- You can inhibit the direct use of the window system and GUI with the
-@samp{-nw} option. It tells Emacs to display using ordinary @acronym{ASCII} on
-its controlling terminal. This is also an initial option.
+ You can inhibit the use of the X window system with the @samp{-nw}
+option. Then Emacs uses its controlling text terminal for display.
+@xref{Initial Options}.
Sometimes, security arrangements prevent a program on a remote system
from displaying on your local system. In this case, trying to run Emacs
@@ -782,17 +745,17 @@ font:
Use @var{font} as the default font.
@end table
-When passing a font specification to Emacs on the command line, you
-may need to ``quote'' it, by enclosing it in quotation marks, if it
-contains characters that the shell treats specially (e.g.@: spaces).
-For example:
+When passing a font name to Emacs on the command line, you may need to
+``quote'' it, by enclosing it in quotation marks, if it contains
+characters that the shell treats specially (e.g.@: spaces). For
+example:
@smallexample
emacs -fn "DejaVu Sans Mono-12"
@end smallexample
-@xref{Fonts}, for other ways to specify the default font and font name
-formats.
+@xref{Fonts}, for details about font names and other ways to specify
+the default font.
@node Colors X
@appendixsec Window Color Options
@@ -823,7 +786,8 @@ Specify the background color, overriding the color specified by the
@itemx --border-color=@var{color}
@opindex --border-color
@cindex border color, command-line argument
-Specify the color of the border of the X window.
+Specify the color of the border of the X window. This has no effect
+if Emacs is compiled with GTK+ support.
@item -cr @var{color}
@opindex -cr
@itemx --cursor-color=@var{color}
@@ -848,11 +812,10 @@ Reverse video---swap the foreground and background colors.
@opindex --color
@cindex standard colors on a character terminal
@cindex override character terminal color support
-For a character terminal only, specify the mode of color support.
-This option is intended for overriding the number of supported colors
-that the character terminal advertises in its @code{termcap} or
-@code{terminfo} database. The parameter @var{mode} can be one of the
-following:
+Set the @dfn{color support mode} when Emacs is run on a text terminal.
+This option overrides the number of supported colors that the
+character terminal advertises in its @code{termcap} or @code{terminfo}
+database. The parameter @var{mode} can be one of the following:
@table @samp
@item never
@itemx no
@@ -892,8 +855,8 @@ emacs -ms coral -cr 'slate blue' &
You can reverse the foreground and background colors through the
@samp{-rv} option or with the X resource @samp{reverseVideo}.
- The @samp{-fg}, @samp{-bg}, and @samp{-rv} options function on
-text-only terminals as well as on graphical displays.
+ The @samp{-fg}, @samp{-bg}, and @samp{-rv} options function on text
+terminals as well as on graphical displays.
@node Window Size X
@appendixsec Options for Window Size and Position
@@ -1094,7 +1057,7 @@ Start Emacs in an iconified (``minimized'') state.
@itemx --no-bitmap-icon
@opindex --no-bitmap-icon
@cindex Emacs icon, a gnu
-Do not display the Emacs icon.
+Disable the use of the Emacs icon.
@end table
Most window managers allow you to ``iconify'' (or ``minimize'') an
@@ -1106,10 +1069,11 @@ The text frame doesn't appear until you deiconify (or ``un-minimize'')
it.
By default, Emacs uses an icon containing the Emacs logo. On
-desktop environments such as Gnome, this icon is also displayed on the
-``taskbar''. The @samp{-nbi} or @samp{--no-bitmap-icon} option tells
-Emacs to let the window manager choose what sort of icon to
-use---usually just a small rectangle containing the frame's title.
+desktop environments such as Gnome, this icon is also displayed in
+other contexts, e.g.@: when switching into an Emacs frame. The
+@samp{-nbi} or @samp{--no-bitmap-icon} option tells Emacs to let the
+window manager choose what sort of icon to use---usually just a small
+rectangle containing the frame's title.
@node Misc X
@appendixsec Other Display Options
diff --git a/doc/emacs/commands.texi b/doc/emacs/commands.texi
index 817cfc369d1..e63a98a9722 100644
--- a/doc/emacs/commands.texi
+++ b/doc/emacs/commands.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@iftex
@@ -15,7 +15,7 @@ input.
@raisesections
@end ifnottex
-@node User Input, Keys, Screen, Top
+@node User Input
@section Kinds of User Input
@cindex input with the keyboard
@cindex keyboard input
@@ -62,7 +62,7 @@ starting with @key{ESC}. Thus, you can enter @kbd{M-a} by typing
C-a}. Unlike @key{Meta}, @key{ESC} is entered as a separate
character. You don't hold down @key{ESC} while typing the next
character; instead, press @key{ESC} and release it, then enter the
-next character. This feature is useful on certain text-only terminals
+next character. This feature is useful on certain text terminals
where the @key{Meta} key does not function reliably.
@cindex keys stolen by window manager
@@ -80,7 +80,7 @@ as @dfn{input events}. For details about how Emacs internally handles
input events, see @ref{Input Events,,, elisp, The Emacs Lisp Reference
Manual}.
-@node Keys, Commands, User Input, Top
+@node Keys
@section Keys
Some Emacs commands are invoked by just one input event; for
@@ -133,7 +133,7 @@ exception to this rule is @key{ESC}: @kbd{@key{ESC} C-h} is equivalent
to @kbd{C-M-h}, which does something else entirely. You can, however,
use @key{F1} to display a list of commands starting with @key{ESC}.
-@node Commands, Entering Emacs, Keys, Top
+@node Commands
@section Keys and Commands
@cindex binding
@@ -166,7 +166,7 @@ commands, even though strictly speaking the key is bound to a command.
Usually we state the name of the command which really does the work in
parentheses after mentioning the key that runs it. For example, we
will say that ``The command @kbd{C-n} (@code{next-line}) moves point
-vertically down,'' meaning that the command @code{next-line} moves
+vertically down'', meaning that the command @code{next-line} moves
vertically down, and the key @kbd{C-n} is normally bound to it.
Since we are discussing customization, we should tell you about
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index e807aebdeee..a614126dbc0 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Customization
@@ -30,287 +30,291 @@ Reference Manual}.
* Key Bindings:: The keymaps say what command each key runs.
By changing them, you can "redefine keys".
* Init File:: How to write common customizations in the
- @file{.emacs} file.
+ initialization file.
@end menu
@node Easy Customization
@section Easy Customization Interface
@cindex settings
- Emacs has many @dfn{settings} which have values that you can change.
-Many are documented in this manual. Most settings are @dfn{user
-options}---that is to say, Lisp variables (@pxref{Variables})---and
-their names appear in the Variable Index (@pxref{Variable Index}).
-The other settings are faces and their attributes (@pxref{Faces}).
+@cindex user option
+@cindex customizable variable
+ Emacs has many @dfn{settings} which you can change. Most settings
+are @dfn{customizable variables} (@pxref{Variables}), which are also
+called @dfn{user options}. There is a huge number of customizable
+variables, controlling numerous aspects of Emacs behavior; the
+variables documented in this manual are listed in @ref{Variable
+Index}. A separate class of settings are the @dfn{faces}, which
+determine the fonts, colors, and other attributes of text
+(@pxref{Faces}).
@findex customize
@cindex customization buffer
- You can browse settings and change them using @kbd{M-x customize}.
-This creates a @dfn{customization buffer}, which lets you navigate
-through a logically organized list of settings, edit and set their
-values, and save them permanently in your initialization file
-(@pxref{Init File}).
+ To browse and alter settings (both variables and faces), type
+@kbd{M-x customize}. This creates a @dfn{customization buffer}, which
+lets you navigate through a logically organized list of settings, edit
+and set their values, and save them permanently.
@menu
-* Customization Groups:: How settings are classified in a structure.
+* Customization Groups:: How settings are classified.
* Browsing Custom:: Browsing and searching for settings.
* Changing a Variable:: How to edit an option's value and set the option.
-* Saving Customizations:: Specifying the file for saving customizations.
+* Saving Customizations:: Saving customizations for future Emacs sessions.
* Face Customization:: How to edit the attributes of a face.
-* Specific Customization:: Making a customization buffer for specific
- variables, faces, or groups.
-* Custom Themes:: How to define collections of customized options
- that can be loaded and unloaded together.
+* Specific Customization:: Customizing specific settings or groups.
+* Custom Themes:: Collections of customization settings.
+* Creating Custom Themes:: How to create a new custom theme.
@end menu
@node Customization Groups
@subsection Customization Groups
@cindex customization groups
- For customization purposes, settings are organized into @dfn{groups}
-to help you find them. Groups are collected into bigger groups, all
-the way up to a master group called @code{Emacs}.
+ Customization settings are organized into @dfn{customization
+groups}. These groups are collected into bigger groups, all the way
+up to a master group called @code{Emacs}.
@kbd{M-x customize} creates a customization buffer that shows the
-top-level @code{Emacs} group and the second-level groups immediately
-under it. It looks like this, in part:
+top-level @code{Emacs} group. It looks like this, in part:
@c we want the buffer example to all be on one page, but unfortunately
@c that's quite a bit of text, so force all space to the bottom.
-@page
+@c @page
@smallexample
@group
-/- Emacs group: Customization of the One True Editor. -------------\
- [State]: visible group members are all at standard values.
+To apply changes, use the Save or Set buttons.
+For details, see [Saving Customizations] in the [Emacs manual].
+
+________________________________________ [ Search ]
+
+ Operate on all settings in this buffer:
+ [ Set for current session ] [ Save for future sessions ]
+ [ Undo edits ] [ Reset to saved ] [ Erase customizations ] [ Exit ]
- See also [Manual].
+
+Emacs group: Customization of the One True Editor.
+ [State]: visible group members are all at standard values.
+ See also [Manual].
[Editing] : Basic text editing facilities.
-[External] : Interfacing to external utilities.
+[Convenience] : Convenience features for faster editing.
@var{more second-level groups}
-
-\- Emacs group end ------------------------------------------------/
@end group
@end smallexample
@noindent
-This says that the buffer displays the contents of the @code{Emacs}
-group. The other groups are listed because they are its contents. But
-they are listed differently, without indentation and dashes, because
-@emph{their} contents are not included. Each group has a single-line
-documentation string; the @code{Emacs} group also has a @samp{[State]}
-line.
+The main part of this buffer shows the @samp{Emacs} customization
+group, which contains several other groups (@samp{Editing},
+@samp{Convenience}, etc.). The contents of those groups are not
+listed here, only one line of documentation each.
+
+ The @dfn{state} of the group indicates whether setting in that group
+has been edited, set or saved. @xref{Changing a Variable}.
@cindex editable fields (customization buffer)
@cindex buttons (customization buffer)
@cindex links (customization buffer)
- Most of the text in the customization buffer is read-only, but it
-typically includes some @dfn{editable fields} that you can edit.
-There are also @dfn{buttons} and @dfn{links}, which do something when
-you @dfn{invoke} them. To invoke a button or a link, either click on
-it with @kbd{Mouse-1}, or move point to it and type @key{RET}.
-
- For example, the phrase @samp{[State]} that appears in a
-second-level group is a button. It operates on the same customization
-buffer. Each group name, such as @samp{[Editing]}, is a hypertext
-link to that group; invoking it creates a new customization buffer,
-showing the group and its contents.
-
- The @code{Emacs} group only contains other groups. These groups, in
-turn, can contain settings or still more groups. By browsing the
-hierarchy of groups, you will eventually find the feature you are
-interested in customizing. Then you can use the customization buffer
-to set that feature's settings. You can also go straight to a
-particular group by name, using the command @kbd{M-x customize-group}.
+ Most of the customization buffer is read-only, but it includes some
+@dfn{editable fields} that you can edit. For example, at the top of
+the customization buffer is an editable field for searching for
+settings (@pxref{Browsing Custom}). There are also @dfn{buttons} and
+@dfn{links}, which you can activate by either clicking with the mouse,
+or moving point there and typing @key{RET}. For example, the group
+names like @samp{[Editing]} are links; activating one of these links
+brings up the customization buffer for that group.
+
+@kindex TAB @r{(customization buffer)}
+@kindex S-TAB @r{(customization buffer)}
+@findex widget-forward
+@findex widget-backward
+ In the customizable buffer, you can type @key{TAB}
+(@code{widget-forward}) to move forward to the next button or editable
+field. @kbd{S-@key{TAB}} (@code{widget-backward}) moves back to the
+previous button or editable field.
@node Browsing Custom
-@subsection Browsing and Searching for Options and Faces
+@subsection Browsing and Searching for Settings
@findex customize-browse
+ From the top-level customization buffer created by @kbd{M-x
+customize}, you can follow the links to the subgroups of the
+@samp{Emacs} customization group. These subgroups may contain
+settings for you to customize; they may also contain further subgroups,
+dealing with yet more specialized subsystems of Emacs. As you
+navigate the hierarchy of customization groups, you should find some
+settings that you want to customize.
+
+ If you are interested in customizing a particular setting or
+customization group, you can go straight there with the commands
+@kbd{M-x customize-option}, @kbd{M-x customize-face}, or @kbd{M-x
+customize-group}. @xref{Specific Customization}.
+
+@vindex custom-search-field
+ If you don't know exactly what groups or settings you want to
+customize, you can search for them using the editable search field at
+the top of each customization buffer. Here, you can type in a search
+term---either one or more words separated by spaces, or a regular
+expression (@pxref{Regexps}). Then type @key{RET} in the field, or
+activate the @samp{Search} button next to it, to switch to a
+customization buffer containing groups and settings that match those
+terms. Note, however, that this feature only finds groups and
+settings that are loaded in the current Emacs session.
+
+ If you don't want customization buffers to show the search field,
+change the variable @code{custom-search-field} to @code{nil}.
+
+ The command @kbd{M-x customize-apropos} is similar to using the
+search field, except that it reads the search term(s) using the
+minibuffer. @xref{Specific Customization}.
+
@kbd{M-x customize-browse} is another way to browse the available
settings. This command creates a special customization buffer which
-shows only the names of groups and settings, and puts them in a
-structure.
-
- In this buffer, you can show the contents of a group by invoking the
-@samp{[+]} button. When the group contents are visible, this button
-changes to @samp{[-]}; invoking that hides the group contents again.
-
- Each group or setting in this buffer has a link which says
-@samp{[Group]}, @samp{[Option]} or @samp{[Face]}. Invoking this link
-creates an ordinary customization buffer showing just that group and
-its contents, just that user option, or just that face. This is the
-way to change settings that you find with @kbd{M-x customize-browse}.
-
- If you can guess part of the name of the settings you are interested
-in, @kbd{M-x customize-apropos} is another way to search for settings.
-However, unlike @code{customize} and @code{customize-browse},
-@code{customize-apropos} can only find groups and settings that are
-loaded in the current Emacs session. @xref{Specific Customization,,
-Customizing Specific Items}.
+shows only the names of groups and settings, in a structured layout.
+You can show the contents of a group, in the same buffer, by invoking
+the @samp{[+]} button next to the group name. When the group contents
+are shown, the button changes to @samp{[-]}; invoking that hides the
+group contents again. Each group or setting in this buffer has a link
+which says @samp{[Group]}, @samp{[Option]} or @samp{[Face]}. Invoking
+this link creates an ordinary customization buffer showing just that
+group, option, or face; this is the way to change settings that you
+find with @kbd{M-x customize-browse}.
@node Changing a Variable
@subsection Changing a Variable
- Here is an example of what a variable (a user option) looks like in
+ Here is an example of what a variable, or user option, looks like in
the customization buffer:
@smallexample
-Kill Ring Max: [Hide Value] 60
+[Hide] Kill Ring Max: 60
[State]: STANDARD.
-Maximum length of kill ring before oldest elements are thrown away.
+ Maximum length of kill ring before oldest elements are thrown away.
@end smallexample
- The text following @samp{[Hide Value]}, @samp{60} in this case, indicates
-the current value of the variable. If you see @samp{[Show Value]} instead of
-@samp{[Hide Value]}, it means that the value is hidden; the customization
-buffer initially hides values that take up several lines. Invoke
-@samp{[Show Value]} to show the value.
+ The first line shows that the variable is named
+@code{kill-ring-max}, formatted as @samp{Kill Ring Max} for easier
+viewing. Its value is @samp{60}. The button labeled @samp{[Hide]},
+if activated, hides the variable's value and state; this is useful to
+avoid cluttering up the customization buffer with very long values
+(for this reason, variables that have very long values may start out
+hidden). If you use the @samp{[Hide]} button, it changes to
+@samp{[Show Value]}, which you can activate to reveal the value and
+state. On a graphical display, the @samp{[Hide]} and @samp{[Show
+Value]} buttons are replaced with graphical triangles pointing
+downwards and rightwards respectively.
The line after the variable name indicates the @dfn{customization
-state} of the variable: in the example above, it says you have not
-changed the option yet. The @samp{[State]} button at the beginning of
-this line gives you a menu of various operations for customizing the
+state} of the variable: in this example, @samp{STANDARD} means you
+have not changed the variable, so its value is the default one. The
+@samp{[State]} button gives a menu of operations for customizing the
variable.
- The line after the @samp{[State]} line displays the beginning of the
-variable's documentation string. If there are more lines of
-documentation, this line ends with a @samp{[More]} button; invoke that
-to show the full documentation string.
+ Below the customization state is the documentation for the variable.
+This is the same documentation that would be shown by the @kbd{C-h v}
+command (@pxref{Examining}). If the documentation is more than one
+line long, only one line may be shown. If so, that line ends with a
+@samp{[More]} button; activate this to see the full documentation.
- To enter a new value for @samp{Kill Ring Max}, move point to the
-value and edit it textually. For example, you can type @kbd{M-d},
-then insert another number. As you begin to alter the text, you will
-see the @samp{[State]} line change to say that you have edited the
-value:
+@cindex user options, changing
+@cindex customizing variables
+@cindex variables, changing
+ To enter a new value for @samp{Kill Ring Max}, just move point to
+the value and edit it. For example, type @kbd{M-d} to delete the
+@samp{60} and type in another number. As you begin to alter the text,
+the @samp{[State]} line will change:
@smallexample
-[State]: EDITED, shown value does not take effect until you set or @r{@dots{}}
- save it.
+[State]: EDITED, shown value does not take effect until you
+ set or save it.
@end smallexample
-@cindex user options, how to set
-@cindex variables, how to set
-@cindex settings, how to set
- Editing the value does not actually set the variable. To do that,
-you must @dfn{set} the variable. To do this, invoke the
-@samp{[State]} button and choose @samp{Set for Current Session}.
-
- The state of the variable changes visibly when you set it:
+@noindent
+Editing the value does not make it take effect right away. To do
+that, you must @dfn{set} the variable by activating the @samp{[State]}
+button and choosing @samp{Set for Current Session}. Then the
+variable's state becomes:
@smallexample
[State]: SET for current session only.
@end smallexample
- You don't have to worry about specifying a value that is not valid;
+@noindent
+You don't have to worry about specifying a value that is not valid;
the @samp{Set for Current Session} operation checks for validity and
will not install an unacceptable value.
@kindex M-TAB @r{(customization buffer)}
+@kindex C-M-i @r{(customization buffer)}
@findex widget-complete
- While editing a field that is a file name, directory name,
-command name, or anything else for which completion is defined, you
-can type @kbd{M-@key{TAB}} (@code{widget-complete}) to do completion.
-(@kbd{@key{ESC} @key{TAB}} and @kbd{C-M-i} do the same thing.)
-
- Some variables have a small fixed set of possible legitimate values.
-These variables don't let you edit the value textually. Instead, a
-@samp{[Value Menu]} button appears before the value; invoke this
-button to change the value. For a boolean ``on or off'' value, the
-button says @samp{[Toggle]}, and it changes to the other value.
-@samp{[Value Menu]} and @samp{[Toggle]} simply edit the buffer; the
-changes take real effect when you use the @samp{Set for Current
-Session} operation.
+ While editing certain kinds of values, such as file names, directory
+names, and Emacs command names, you can perform completion with
+@kbd{C-M-i} (@code{widget-complete}), or the equivalent keys
+@kbd{M-@key{TAB}} or @kbd{@key{ESC} @key{TAB}}. This behaves much
+like minibuffer completion (@pxref{Completion}).
+
+ Typing @key{RET} on an editable value field moves point forward to
+the next field or button, like @key{TAB}. You can thus type @key{RET}
+when you are finished editing a field, to move on to the next button
+or field. To insert a newline within an editable field, use @kbd{C-o}
+or @kbd{C-q C-j}.
+
+ For some variables, there is only a fixed set of legitimate values,
+and you are not allowed to edit the value directly. Instead, a
+@samp{[Value Menu]} button appears before the value; activating this
+button presents a choice of values. For a boolean ``on or off''
+value, the button says @samp{[Toggle]}, and flips the value. After
+using the @samp{[Value Menu]} or @samp{[Toggle]} button, you must
+again set the variable to make the chosen value take effect.
Some variables have values with complex structure. For example, the
-value of @code{file-coding-system-alist} is an association list. Here
+value of @code{minibuffer-frame-alist} is an association list. Here
is how it appears in the customization buffer:
@smallexample
-File Coding System Alist: [Hide Value]
-[INS] [DEL] File regexp: \.elc\'
- Choice: [Value Menu] Encoding/decoding pair:
- Decoding: emacs-mule
- Encoding: emacs-mule
-[INS] [DEL] File regexp: \(\`\|/\)loaddefs.el\'
- Choice: [Value Menu] Encoding/decoding pair:
- Decoding: raw-text
- Encoding: raw-text-unix
-[INS] [DEL] File regexp: \.tar\'
- Choice: [Value Menu] Encoding/decoding pair:
- Decoding: no-conversion
- Encoding: no-conversion
-[INS] [DEL] File regexp:
- Choice: [Value Menu] Encoding/decoding pair:
- Decoding: undecided
- Encoding: nil
+[Hide] Minibuffer Frame Alist:
+[INS] [DEL] Parameter: width
+ Value: 80
+[INS] [DEL] Parameter: height
+ Value: 2
[INS]
- [State]: STANDARD.
-Alist to decide a coding system to use for a file I/O @r{@dots{}}
- operation. [Hide Rest]
-The format is ((PATTERN . VAL) ...),
-where PATTERN is a regular expression matching a file name,
-@r{[@dots{}more lines of documentation@dots{}]}
+ [ State ]: STANDARD.
+ Alist of parameters for the initial minibuffer frame. [Hide]
+ @r{[@dots{}more lines of documentation@dots{}]}
@end smallexample
@noindent
-Each association in the list appears on four lines, with several
-editable fields and/or buttons. You can edit the regexps and coding
-systems using ordinary editing commands. You can also invoke
-@samp{[Value Menu]} to switch to a different kind of value---for
-instance, to specify a function instead of a pair of coding systems.
-
-To delete an association from the list, invoke the @samp{[DEL]} button
-for that item. To add an association, invoke @samp{[INS]} at the
-position where you want to add it. There is an @samp{[INS]} button
-between each pair of associations, another at the beginning and another
-at the end, so you can add a new association at any position in the
-list.
-
-@kindex TAB @r{(customization buffer)}
-@kindex S-TAB @r{(customization buffer)}
-@findex widget-forward
-@findex widget-backward
- Two special commands, @key{TAB} and @kbd{S-@key{TAB}}, are useful
-for moving through the customization buffer. @key{TAB}
-(@code{widget-forward}) moves forward to the next button or editable
-field; @kbd{S-@key{TAB}} (@code{widget-backward}) moves backward to
-the previous button or editable field.
-
- Typing @key{RET} on an editable field also moves forward, just like
-@key{TAB}. You can thus type @key{RET} when you are finished editing
-a field, to move on to the next button or field. To insert a newline
-within an editable field, use @kbd{C-o} or @kbd{C-q C-j}.
+In this case, each association in the list consists of two items, one
+labeled @samp{Parameter} and one labeled @samp{Value}; both are
+editable fields. You can delete an association from the list with the
+@samp{[DEL]} button next to it. To add an association, use the
+@samp{[INS]} button at the position where you want to insert it; the
+very last @samp{[INS]} button inserts at the end of the list.
@cindex saving a setting
@cindex settings, how to save
- Setting the variable changes its value in the current Emacs session;
-@dfn{saving} the value changes it for future sessions as well. To
-save the variable, invoke @samp{[State]} and select the @samp{Save for
-Future Sessions} operation. This works by writing code so as to set
-the variable again, each time you start Emacs (@pxref{Saving
-Customizations}).
+ When you set a variable, the new value takes effect only in the
+current Emacs session. To @dfn{save} the value for future sessions,
+use the @samp{[State]} button and select the @samp{Save for Future
+Sessions} operation. @xref{Saving Customizations}.
- You can also restore the variable to its standard value by invoking
-@samp{[State]} and selecting the @samp{Erase Customization} operation.
-There are actually four reset operations:
+ You can also restore the variable to its standard value by using the
+@samp{[State]} button and selecting the @samp{Erase Customization}
+operation. There are actually four reset operations:
@table @samp
@item Undo Edits
-If you have made some modifications and not yet set the variable,
-this restores the text in the customization buffer to match
-the actual value.
+If you have modified but not yet set the variable, this restores the
+text in the customization buffer to match the actual value.
@item Reset to Saved
This restores the value of the variable to the last saved value,
and updates the text accordingly.
@item Erase Customization
-This sets the variable to its standard value, and updates the text
-accordingly. This also eliminates any saved value for the variable,
-so that you will get the standard value in future Emacs sessions.
+This sets the variable to its standard value. Any saved value that
+you have is also eliminated.
@item Set to Backup Value
This sets the variable to a previous value that was set in the
@@ -322,40 +326,51 @@ you can get the discarded value back again with this operation.
@cindex comments on customized settings
Sometimes it is useful to record a comment about a specific
customization. Use the @samp{Add Comment} item from the
-@samp{[State]} menu to create a field for entering the comment. The
-comment you enter will be saved, and displayed again if you again view
-the same variable in a customization buffer, even in another session.
-
- The state of a group indicates whether anything in that group has been
-edited, set or saved.
+@samp{[State]} menu to create a field for entering the comment.
- Near the top of the customization buffer there are two lines of buttons:
+ Near the top of the customization buffer are two lines of buttons:
@smallexample
[Set for Current Session] [Save for Future Sessions]
- [Undo Edits] [Reset to Saved] [Erase Customization] [Finish]
+ [Undo Edits] [Reset to Saved] [Erase Customization] [Exit]
@end smallexample
-@vindex custom-buffer-done-function
@noindent
-Invoking @samp{[Finish]} either buries or kills this customization
-buffer according to the setting of the option
-@code{custom-buffer-done-kill}; the default is to bury the buffer.
-Each of the other buttons performs an operation---set, save or
-reset---on each of the settings in the buffer that could meaningfully
-be set, saved or reset. They do not operate on settings whose values
-are hidden, nor on subgroups which are hidden or not visible in the buffer.
+Each of the first five buttons performs the stated operation---set,
+save, reset, etc.---on all the settings in the buffer that could
+meaningfully be affected. They do not operate on settings that are
+hidden, nor on subgroups that are hidden or not visible in the buffer.
+
+@kindex C-c C-c @r{(customization buffer)}
+@kindex C-x C-c @r{(customization buffer)}
+@findex Custom-set
+@findex Custom-save
+ The command @kbd{C-c C-c} (@code{Custom-set}) is equivalent using to
+the @samp{[Set for Current Session]} button. The command @kbd{C-x
+C-s} (@code{Custom-save}) is like using the @samp{[Save for Future
+Sessions]} button.
+
+@vindex custom-buffer-done-kill
+ The @samp{[Exit]} button switches out of the customization buffer,
+and buries the buffer at the bottom of the buffer list. To make it
+kill the customization buffer instead, change the variable
+@code{custom-buffer-done-kill} to @code{t}.
@node Saving Customizations
@subsection Saving Customizations
-@vindex custom-file
- Saving customizations from the customization buffer works by writing
-code to a file. By reading this code, future sessions can set up the
-customizations again. Normally, the code is saved in your
-initialization file (@pxref{Init File}).
+ In the customization buffer, you can @dfn{save} a customization
+setting by choosing the @samp{Save for Future Sessions} choice from
+its @samp{[State]} button. The @kbd{C-x C-s} (@code{Custom-save})
+command, or the @samp{[Save for Future Sessions]} button at the top of
+the customization buffer, saves all applicable settings in the buffer.
+
+ Saving works by writing code to a file, usually your initialization
+file (@pxref{Init File}). Future Emacs sessions automatically read
+this file at startup, which sets up the customizations again.
- You can choose to save your customizations in a file other than your
+@vindex custom-file
+ You can choose to save customizations somewhere other than your
initialization file. To make this work, you must add a couple of
lines of code to your initialization file, to set the variable
@code{custom-file} to the name of the desired file, and to load that
@@ -366,8 +381,8 @@ file. For example:
(load custom-file)
@end example
- You can use @code{custom-file} to specify different customization
-files for different Emacs versions, like this:
+ You can even specify different customization files for different
+Emacs versions, like this:
@example
(cond ((< emacs-major-version 22)
@@ -393,80 +408,95 @@ customizations you might have on your initialization file.
@node Face Customization
@subsection Customizing Faces
@cindex customizing faces
-@cindex bold font
-@cindex italic font
+@cindex faces, customizing
@cindex fonts and faces
- In addition to variables, some customization groups also include
-faces. When you show the contents of a group, both the variables and
-the faces in the group appear in the customization buffer. Here is an
-example of how a face looks:
+ You can customize faces (@pxref{Faces}), which determine how Emacs
+displays different types of text. Customization groups can contain
+both variables and faces.
+
+ For example, in programming language modes, source code comments are
+shown with @code{font-lock-comment-face} (@pxref{Font Lock}). In a
+customization buffer, that face appears like this:
@smallexample
-Custom Changed Face:(sample) [Hide Face]
- [State]: STANDARD.
-Face used when the customize item has been changed.
-Parent groups: [Custom Magic Faces]
-Attributes: [ ] Font Family: *
- [ ] Width: *
- [ ] Height: *
- [ ] Weight: *
- [ ] Slant: *
- [ ] Underline: *
- [ ] Overline: *
- [ ] Strike-through: *
- [ ] Box around text: *
- [ ] Inverse-video: *
- [X] Foreground: white (sample)
- [X] Background: blue (sample)
- [ ] Stipple: *
- [ ] Inherit: *
+[Hide] Font Lock Comment Face:[sample]
+ [State] : STANDARD.
+ Font Lock mode face used to highlight comments.
+ [ ] Font Family: --
+ [ ] Font Foundry: --
+ [ ] Width: --
+ [ ] Height: --
+ [ ] Weight: --
+ [ ] Slant: --
+ [ ] Underline: --
+ [ ] Overline: --
+ [ ] Strike-through: --
+ [ ] Box around text: --
+ [ ] Inverse-video: --
+ [X] Foreground: Firebrick [Choose] (sample)
+ [ ] Background: --
+ [ ] Stipple: --
+ [ ] Inherit: --
+ [Hide Unused Attributes]
@end smallexample
- Each face attribute has its own line. The @samp{[@var{x}]} button
-before the attribute name indicates whether the attribute is
-@dfn{enabled}; @samp{[X]} means that it's enabled, and @samp{[ ]}
-means that it's disabled. You can enable or disable the attribute by
-clicking that button. When the attribute is enabled, you can change
-the attribute value in the usual ways.
-
- The foreground and background colors can be specified using color
-names or RGB triplets. @xref{Colors}.
+@noindent
+The first three lines show the name, @samp{[State]} button, and
+documentation for the face. Below that is a list of @dfn{face
+attributes}. In front of each attribute is a checkbox. A filled
+checkbox, @samp{[X]}, means that the face specifies a value for this
+attribute; an empty checkbox, @samp{[ ]}, means that the face does not
+specify any special value for the attribute. You can activate a
+checkbox to specify or unspecify its attribute.
+
+ A face does not have to specify every single attribute; in fact,
+most faces only specify a few attributes. In the above example,
+@code{font-lock-comment-face} only specifies the foreground color.
+Any unspecified attribute is taken from the special face named
+@code{default}, whose attributes are all specified. The
+@code{default} face is the face used to display any text that does not
+have an explicitly-assigned face; furthermore, its background color
+attribute serves as the background color of the frame.
+
+ The @samp{Hide Unused Attributes} button, at the end of the
+attribute list, hides the unspecified attributes of the face. When
+attributes are being hidden, the button changes to @samp{[Show All
+Attributes]}, which reveals the entire attribute list. The
+customization buffer may start out with unspecified attributes hidden,
+to avoid cluttering the interface.
+
+ When an attribute is specified, you can change its value in the
+usual ways.
+
+ Foreground and background colors can be specified using either color
+names or RGB triplets (@pxref{Colors}). You can also use the
+@samp{[Choose]} button to switch to a list of color names; select a
+color with @key{RET} in that buffer to put the color name in the value
+field.
Setting, saving and resetting a face work like the same operations for
variables (@pxref{Changing a Variable}).
A face can specify different appearances for different types of
-display. For example, a face can make text red on a color display, but
-use a bold font on a monochrome display. To specify multiple
+displays. For example, a face can make text red on a color display,
+but use a bold font on a monochrome display. To specify multiple
appearances for a face, select @samp{For All Kinds of Displays} in the
menu you get from invoking @samp{[State]}.
-@findex modify-face
- Another more basic way to set the attributes of a specific face is
-with @kbd{M-x modify-face}. This command reads the name of a face, then
-reads the attributes one by one. For the color and stipple attributes,
-the attribute's current value is the default---type just @key{RET} if
-you don't want to change that attribute. Type @samp{none} if you want
-to clear out the attribute.
-
@node Specific Customization
@subsection Customizing Specific Items
- Instead of finding the setting you want to change by navigating the
-structure of groups, here are other ways to specify the settings that
-you want to customize.
-
@table @kbd
@item M-x customize-option @key{RET} @var{option} @key{RET}
-Set up a customization buffer with just one user option variable,
-@var{option}.
+@itemx M-x customize-variable @key{RET} @var{option} @key{RET}
+Set up a customization buffer for just one user option, @var{option}.
@item M-x customize-face @key{RET} @var{face} @key{RET}
-Set up a customization buffer with just one face, @var{face}.
+Set up a customization buffer for just one face, @var{face}.
@item M-x customize-group @key{RET} @var{group} @key{RET}
-Set up a customization buffer with just one group, @var{group}.
+Set up a customization buffer for just one group, @var{group}.
@item M-x customize-apropos @key{RET} @var{regexp} @key{RET}
-Set up a customization buffer with all the settings and groups that
+Set up a customization buffer for all the settings and groups that
match @var{regexp}.
@item M-x customize-changed @key{RET} @var{version} @key{RET}
Set up a customization buffer with all the settings and groups
@@ -480,35 +510,24 @@ set but not saved.
@end table
@findex customize-option
- If you want to alter a particular user option with the customization
-buffer, and you know its name, you can use the command @kbd{M-x
-customize-option} and specify the user option (variable) name. This
-sets up the customization buffer with just one user option---the one
-that you asked for. Editing, setting and saving the value work as
-described above, but only for the specified user option. Minibuffer
-completion is handy if you only know part of the name. However, this
-command can only see options that have been loaded in the current
-Emacs session.
+ If you want to customize a particular user option, type @kbd{M-x
+customize-option}. This reads the variable name, and sets up the
+customization buffer with just that one user option. When entering
+the variable name into the minibuffer, completion is available, but
+only for the names of variables that have been loaded into Emacs.
@findex customize-face
- Likewise, you can modify a specific face, chosen by name, using
-@kbd{M-x customize-face}. By default it operates on the face used
-on the character after point.
-
@findex customize-group
- You can also set up the customization buffer with a specific group,
-using @kbd{M-x customize-group}. The immediate contents of the chosen
-group, including settings (user options and faces), and other groups,
-all appear as well (even if not already loaded). However, the
-subgroups' own contents are not included.
+ Likewise, you can customize a specific face using @kbd{M-x
+customize-face}. You can set up a customization buffer for a specific
+customization group using @kbd{M-x customize-group}.
@findex customize-apropos
- For a more general way of controlling what to customize, you can use
-@kbd{M-x customize-apropos}. You specify a regular expression as
-argument; then all @emph{loaded} settings and groups whose names match
-this regular expression are set up in the customization buffer. If
-you specify an empty regular expression, this includes @emph{all}
-loaded groups and settings---which takes a long time to set up.
+ @kbd{M-x customize-apropos} prompts for a search term---either one
+or more words separated by spaces, or a regular expression---and sets
+up a customization buffer for all @emph{loaded} settings and groups
+with matching names. This is like using the search field at the top
+of the customization buffer (@pxref{Customization Groups}).
@findex customize-changed
When you upgrade to a new Emacs version, you might want to consider
@@ -522,78 +541,158 @@ loading them if necessary.
@findex customize-saved
@findex customize-unsaved
If you change settings and then decide the change was a mistake, you
-can use two special commands to revisit your previous changes. Use
-@kbd{M-x customize-saved} to look at the settings that you have saved.
-Use @kbd{M-x customize-unsaved} to look at the settings that you
-have set but not saved.
+can use two commands to revisit your changes. Use @kbd{M-x
+customize-saved} to customize settings that you have saved. Use
+@kbd{M-x customize-unsaved} to customize settings that you have set
+but not saved.
@node Custom Themes
-@subsection Customization Themes
+@subsection Custom Themes
@cindex custom themes
@dfn{Custom themes} are collections of settings that can be enabled
-or disabled as a unit. You can use Custom themes to switch quickly
-and easily between various collections of settings, and to transfer
-such collections from one computer to another.
+or disabled as a unit. You can use Custom themes to switch easily
+between various collections of settings, and to transfer such
+collections from one computer to another.
-@findex customize-create-theme
- To define a Custom theme, use @kbd{M-x customize-create-theme},
-which brings up a buffer named @samp{*New Custom Theme*}. At the top
-of the buffer is an editable field where you can specify the name of
-the theme. Click on the button labeled @samp{Insert Variable} to add
-a variable to the theme, and click on @samp{Insert Face} to add a
-face. You can edit these values in the @samp{*New Custom Theme*}
-buffer like in an ordinary Customize buffer. To remove an option from
-the theme, click on its @samp{State} button and select @samp{Delete}.
+ A Custom theme is stored an Emacs Lisp source file. If the name of
+the Custom theme is @var{name}, the theme file is named
+@file{@var{name}-theme.el}. @xref{Creating Custom Themes}, for the
+format of a theme file and how to make one.
+@findex customize-themes
@vindex custom-theme-directory
- After adding the desired options, click on @samp{Save Theme} to save
-the Custom theme. This writes the theme definition to a file
-@file{@var{foo}-theme.el} (where @var{foo} is the theme name you
-supplied), in the directory @file{~/.emacs.d/}. You can specify the
-directory by setting @code{custom-theme-directory}.
-
- You can view and edit the settings of a previously-defined theme by
-clicking on @samp{Visit Theme} and specifying the theme name. You can
-also import the variables and faces that you have set using Customize
-by visiting the ``special'' theme named @samp{user}. This theme, which
-records all the options that you set in the ordinary customization
-buffer, is always enabled, and always takes precedence over all other
-enabled Custom themes. Additionally, the @samp{user} theme is
-recorded with code in your @file{.emacs} file, rather than a
-@file{user-theme.el} file.
+@cindex color scheme
+ Type @kbd{M-x customize-themes} to switch to a buffer named
+@file{*Custom Themes*}, which lists the Custom themes that Emacs knows
+about. By default, Emacs looks for theme files in two locations: the
+directory specified by the variable @code{custom-theme-directory}
+(which defaults to @file{~/.emacs.d/}), and a directory named
+@file{etc/themes} in your Emacs installation (see the variable
+@code{data-directory}). The latter contains several Custom themes
+which are distributed with Emacs, which customize Emacs's faces to fit
+various color schemes. (Note, however, that Custom themes need not be
+restricted to this purpose; they can be used to customize variables
+too).
+
+@vindex custom-theme-load-path
+ If you want Emacs to look for Custom themes in some other directory,
+add the directory name to the list variable
+@code{custom-theme-load-path}. Its default value is
+@code{(custom-theme-directory t)}; here, the symbol
+@code{custom-theme-directory} has the special meaning of the value of
+the variable @code{custom-theme-directory}, while @code{t} stands for
+the built-in theme directory @file{etc/themes}. The themes listed in
+the @file{*Custom Themes*} buffer are those found in the directories
+specified by @code{custom-theme-load-path}.
+
+@kindex C-x C-s @r{(Custom Themes buffer)}
+ In the @file{*Custom Themes*} buffer, you can activate the checkbox
+next to a Custom theme to enable or disable the theme for the current
+Emacs session. When a Custom theme is enabled, all of its settings
+(variables and faces) take effect in the Emacs session. To apply the
+choice of theme(s) to future Emacs sessions, type @kbd{C-x C-s}
+(@code{custom-theme-save}) or use the @samp{[Save Theme Settings]}
+button.
+
+@vindex custom-safe-themes
+ When you first enable a Custom theme, Emacs displays the contents of
+the theme file and asks if you really want to load it. Because
+loading a Custom theme can execute arbitrary Lisp code, you should
+only say yes if you know that the theme is safe; in that case, Emacs
+offers to remember in the future that the theme is safe (this is done
+by saving the theme file's SHA-256 hash to the variable
+@code{custom-safe-themes}; if you want to treat all themes as safe,
+change its value to @code{t}). Themes that come with Emacs (in the
+@file{etc/themes} directory) are exempt from this check, and are
+always considered safe.
@vindex custom-enabled-themes
- Once you have defined a Custom theme, you can use it by customizing
-the variable @code{custom-enabled-themes}. This is a list of Custom
-themes that are @dfn{enabled}, or put into effect. If you set
-@code{custom-enabled-themes} using the Customize interface, the theme
-definitions are automatically loaded from the theme files, if they
-aren't already. If you save the value of @code{custom-enabled-themes}
-for future Emacs sessions, those Custom themes will be enabled
-whenever Emacs is started up.
-
- If two enabled themes specify different values for an option, the
-theme occurring earlier in @code{custom-enabled-themes} takes effect.
+ Setting or saving Custom themes actually works by customizing the
+variable @code{custom-enabled-themes}. The value of this variable is
+a list of Custom theme names (as Lisp symbols, e.g.@: @code{tango}).
+Instead of using the @file{*Custom Themes*} buffer to set
+@code{custom-enabled-themes}, you can customize the variable using the
+usual customization interface, e.g.@: with @kbd{M-x customize-option}.
+Note that Custom themes are not allowed to set
+@code{custom-enabled-themes} themselves.
+
+ Any customizations that you make through the customization buffer
+take precedence over theme settings. This lets you easily override
+individual theme settings that you disagree with. If settings from
+two different themes overlap, the theme occurring earlier in
+@code{custom-enabled-themes} takes precedence. In the customization
+buffer, if a setting has been changed from its default by a Custom
+theme, its @samp{State} display shows @samp{THEMED} instead of
+@samp{STANDARD}.
@findex load-theme
@findex enable-theme
@findex disable-theme
- You can temporarily enable a Custom theme with @kbd{M-x
-enable-theme}. This prompts for a theme name in the minibuffer, loads
-the theme from the theme file if necessary, and enables the theme.
-You can @dfn{disable} any enabled theme with the command @kbd{M-x
-disable-theme}; this returns the options specified in the theme to
-their original values. To re-enable the theme, type @kbd{M-x
-enable-theme} again. If a theme file is changed during your Emacs
-session, you can reload it by typing @kbd{M-x load-theme}. (This also
-enables the theme.)
+ You can enable a specific Custom theme in the current Emacs session
+by typing @kbd{M-x load-theme}. This prompts for a theme name, loads
+the theme from the theme file, and enables it. If a theme file
+has been loaded before, you can enable the theme without loading its
+file by typing @kbd{M-x enable-theme}. To disable a Custom theme,
+type @kbd{M-x disable-theme}.
+
+@findex describe-theme
+ To see a description of a Custom theme, type @kbd{?} on its line in
+the @file{*Custom Themes*} buffer; or type @kbd{M-x describe-theme}
+anywhere in Emacs and enter the theme name.
+
+@node Creating Custom Themes
+@subsection Creating Custom Themes
+@cindex custom themes, creating
+
+@findex customize-create-theme
+ You can define a Custom theme using an interface similar to the
+customization buffer, by typing @kbd{M-x customize-create-theme}.
+This switches to a buffer named @file{*Custom Theme*}. It also offers
+to insert some common Emacs faces into the theme (a convenience, since
+Custom themes are often used to customize faces). If you answer no,
+the theme will initially contain no settings.
+
+ Near the top of the @file{*Custom Theme*} buffer are editable fields
+where you can enter the theme's name and description. The name can be
+anything except @samp{user}. The description is the one that will be
+shown when you invoke @kbd{M-x describe-theme} for the theme. Its
+first line should be a brief one-sentence summary; in the buffer made
+by @kbd{M-x customize-themes}, this sentence is displayed next to the
+theme name.
+
+ To add a new setting to the theme, use the @samp{[Insert Additional
+Face]} or @samp{[Insert Additional Variable]} buttons. Each button
+reads a face or variable name using the minibuffer, with completion,
+and inserts a customization entry for the face or variable. You can
+edit the variable values or face attributes in the same way as in a
+normal customization buffer. To remove a face or variable from the
+theme, uncheck the checkbox next to its name.
+
+@vindex custom-theme-directory
+ After specifying the Custom theme's faces and variables, type
+@kbd{C-x C-s} (@code{custom-theme-write}) or use the buffer's
+@samp{[Save Theme]} button. This saves the theme file, named
+@file{@var{name}-theme.el} where @var{name} is the theme name, in the
+directory named by @code{custom-theme-directory}.
+
+ From the @file{*Custom Theme*} buffer, you can view and edit an
+existing Custom theme by activating the @samp{[Visit Theme]} button
+and specifying the theme name. You can also add the settings of
+another theme into the buffer, using the @samp{[Merge Theme]} button.
+You can import your non-theme settings into a Custom theme by using
+the @samp{[Merge Theme]} button and specifying the special theme named
+@samp{user}.
+
+ A theme file is simply an Emacs Lisp source file, and loading the
+Custom theme works by loading the Lisp file. Therefore, you can edit
+a theme file directly instead of using the @file{*Custom Theme*}
+buffer. @xref{Custom Themes,,, elisp, The Emacs Lisp Reference
+Manual}, for details.
@node Variables
@section Variables
@cindex variable
-@cindex option, user
-@cindex user option
A @dfn{variable} is a Lisp symbol which has a value. The symbol's
name is also called the @dfn{variable name}. A variable name can
@@ -609,10 +708,10 @@ using the help command @kbd{C-h v} (@code{describe-variable}).
Emacs uses many Lisp variables for internal record keeping, but the
most interesting variables for a non-programmer user are those meant
-for users to change---these are called @dfn{user options}. @xref{Easy
-Customization}, for information about using the Customize facility to
-set user options. In the following sections, we will describe other
-aspects of Emacs variables, such as how to set them outside Customize.
+for users to change---these are called @dfn{customizable variables} or
+@dfn{user options} (@pxref{Easy Customization}). In the following
+sections, we will describe other aspects of Emacs variables, such as
+how to set them outside Customize.
Emacs Lisp allows any variable (with a few exceptions) to have any
kind of value. However, many variables are meaningful only if
@@ -654,9 +753,9 @@ Display the value and documentation of variable @var{var}
Change the value of variable @var{var} to @var{value}.
@end table
- To examine the value of a single variable, use @kbd{C-h v}
-(@code{describe-variable}), which reads a variable name using the
-minibuffer, with completion. It displays both the value and the
+ To examine the value of a variable, use @kbd{C-h v}
+(@code{describe-variable}). This reads a variable name using the
+minibuffer, with completion, and displays both the value and the
documentation of the variable. For example,
@example
@@ -666,30 +765,28 @@ C-h v fill-column @key{RET}
@noindent
displays something like this:
-@smallexample
+@example
fill-column is a variable defined in `C source code'.
fill-column's value is 70
-Local in buffer custom.texi; global value is 70
-Automatically becomes buffer-local when set in any fashion.
- Automatically becomes buffer-local when set in any fashion.
- This variable is safe as a file local variable if its value
- satisfies the predicate `integerp'.
+Automatically becomes buffer-local when set.
+This variable is safe as a file local variable if its value
+satisfies the predicate `integerp'.
Documentation:
-*Column beyond which automatic line-wrapping should happen.
-Interactively, you can set the buffer local value using C-x f.
+Column beyond which automatic line-wrapping should happen.
+Interactively, you can set the local value with C-x f.
You can customize this variable.
-@end smallexample
+@end example
@noindent
The line that says ``You can customize the variable'' indicates that
this variable is a user option. @kbd{C-h v} is not restricted to user
-options; it allows any variable name.
+options; it allows non-customizable variables too.
@findex set-variable
- The most convenient way to set a specific user option variable is
+ The most convenient way to set a specific customizable variable is
with @kbd{M-x set-variable}. This reads the variable name with the
minibuffer (with completion), and then reads a Lisp expression for the
new value using the minibuffer a second time (you can insert the old
@@ -702,22 +799,23 @@ M-x set-variable @key{RET} fill-column @key{RET} 75 @key{RET}
@noindent
sets @code{fill-column} to 75.
- @kbd{M-x set-variable} is limited to user option variables, but you can
-set any variable with a Lisp expression, using the function @code{setq}.
-Here is a @code{setq} expression to set @code{fill-column}:
+ @kbd{M-x set-variable} is limited to customizable variables, but you
+can set any variable with a Lisp expression like this:
@example
(setq fill-column 75)
@end example
- To execute an expression like this one, go to the @samp{*scratch*}
-buffer, type in the expression, and then type @kbd{C-j}. @xref{Lisp
-Interaction}.
+@noindent
+To execute such an expression, type @kbd{M-:} (@code{eval-expression})
+and enter the expression in the minibuffer (@pxref{Lisp Eval}).
+Alternatively, go to the @file{*scratch*} buffer, type in the
+expression, and then type @kbd{C-j} (@pxref{Lisp Interaction}).
Setting variables, like all means of customizing Emacs except where
otherwise stated, affects only the current Emacs session. The only
way to alter the variable in future sessions is to put something in
-your initialization file to set it those sessions (@pxref{Init File}).
+your initialization file (@pxref{Init File}).
@node Hooks
@subsection Hooks
@@ -740,7 +838,8 @@ is a normal hook.
@cindex abnormal hook
A few hooks are @dfn{abnormal hooks}. Their names end in
-@samp{-hooks} or @samp{-functions}, instead of @samp{-hook}. What
+@samp{-functions}, instead of @samp{-hook} (some old code may also use
+the deprecated suffix @samp{-hooks}). What
makes these hooks abnormal is the way its functions are
called---perhaps they are given arguments, or perhaps the values they
return are used in some way. For example,
@@ -759,17 +858,34 @@ Manual}, for details.
Most major modes run one or more @dfn{mode hooks} as the last step
of initialization. Mode hooks are a convenient way to customize the
behavior of individual modes; they are always normal. For example,
-here's how to set up a hook to turn on Auto Fill mode when entering
-Text mode and other modes based on Text mode:
+here's how to set up a hook to turn on Auto Fill mode in Text mode and
+other modes based on Text mode:
@example
(add-hook 'text-mode-hook 'auto-fill-mode)
@end example
- Here is another example, showing how to use a hook to customize the
-indentation of C code. The hook function uses an anonymous lambda
-expression (@pxref{Lambda Expressions,,, elisp, The Emacs Lisp
-Reference Manual}).
+@noindent
+This works by calling @code{auto-fill-mode}, which enables the minor
+mode when no argument is supplied (@pxref{Minor Modes}). Next,
+suppose you don't want Auto Fill mode turned on in @LaTeX{} mode,
+which is one of the modes based on Text mode. You can do this with
+the following additional line:
+
+@example
+(add-hook 'latex-mode-hook (lambda () (auto-fill-mode -1)))
+@end example
+
+@noindent
+Here we have used the special macro @code{lambda} to construct an
+anonymous function (@pxref{Lambda Expressions,,, elisp, The Emacs Lisp
+Reference Manual}), which calls @code{auto-fill-mode} with an argument
+of @code{-1} to disable the minor mode. Because @LaTeX{} mode runs
+@code{latex-mode-hook} after running @code{text-mode-hook}, the result
+leaves Auto Fill mode disabled.
+
+ Here is a more complex example, showing how to use a hook to
+customize the indentation of C code:
@example
@group
@@ -792,8 +908,8 @@ Reference Manual}).
@cindex program editing
Major mode hooks also apply to other major modes @dfn{derived} from
the original mode (@pxref{Derived Modes,,, elisp, The Emacs Lisp
-Reference Manual}). For instance, HTML mode (@pxref{HTML Mode})
-inherits from Text mode; when HTML mode is enabled, it runs
+Reference Manual}). For instance, HTML mode is derived from Text mode
+(@pxref{HTML Mode}); when HTML mode is enabled, it runs
@code{text-mode-hook} before running @code{html-mode-hook}. This
provides a convenient way to use a single hook to affect several
related modes. In particular, if you want to apply a hook function to
@@ -910,7 +1026,7 @@ explicitly. For example, here's how to obtain the default value of
@cindex local variables in files
@cindex file local variables
- A file can specify local variable values for use when you edit the
+ A file can specify local variable values to use when editing the
file with Emacs. Visiting the file checks for local variable
specifications; it automatically makes these variables local to the
buffer, and sets them to the values specified in the file.
@@ -933,21 +1049,21 @@ first line:
@noindent
You can specify any number of variable/value pairs in this way, each
-pair with a colon and semicolon as shown above. The special
-variable/value pair @code{mode: @var{modename};}, if present,
-specifies a major mode, and should come first in the line. The
+pair with a colon and semicolon. The special variable/value pair
+@code{mode: @var{modename};}, if present, specifies a major mode. The
@var{value}s are used literally, and not evaluated.
@findex add-file-local-variable-prop-line
@findex delete-file-local-variable-prop-line
@findex copy-dir-locals-to-file-locals-prop-line
- You can use the command @code{add-file-local-variable-prop-line}
-instead of adding entries by hand. It prompts for a variable
-and value, and adds them to the first line in the appropriate way.
-The command @code{delete-file-local-variable-prop-line} deletes a
-variable from the line. The command
-@code{copy-dir-locals-to-file-locals-prop-line} copies directory-local
-variables (@pxref{Directory Variables}) to the first line.
+ You can use @kbd{M-x add-file-local-variable-prop-line} instead of
+adding entries by hand. This command prompts for a variable and
+value, and adds them to the first line in the appropriate way.
+@kbd{M-x delete-file-local-variable-prop-line} prompts for a variable,
+and deletes its entry from the line. The command @kbd{M-x
+copy-dir-locals-to-file-locals-prop-line} copies the current
+directory-local variables to the first line (@pxref{Directory
+Variables}).
Here is an example first line that specifies Lisp mode and sets two
variables with numeric values:
@@ -971,7 +1087,7 @@ same is true for man pages which start with the magic string
@samp{'\"} to specify a list of troff preprocessors (not all do,
however).
- Instead of using a @samp{-*-} line, you can define file local
+ Apart from using a @samp{-*-} line, you can define file local
variables using a @dfn{local variables list} near the end of the file.
The start of the local variables list should be no more than 3000
characters from the end of the file, and must be on the last page if
@@ -990,10 +1106,10 @@ part of their initialization.
per line, like this:
@example
-/* Local Variables: */
-/* mode:c */
-/* comment-column:0 */
-/* End: */
+/* Local Variables: */
+/* mode: c */
+/* comment-column: 0 */
+/* End: */
@end example
@noindent
@@ -1004,23 +1120,23 @@ the first line of the list; it then automatically discards them from
the other lines of the list. The usual reason for using a prefix
and/or suffix is to embed the local variables list in a comment, so it
won't confuse other programs that the file is intended for. The
-example above is for the C programming language, where comment lines
-start with @samp{/*} and end with @samp{*/}.
+example above is for the C programming language, where comments start
+with @samp{/*} and end with @samp{*/}.
@findex add-file-local-variable
@findex delete-file-local-variable
@findex copy-dir-locals-to-file-locals
- You can construct the local variables list yourself, or use the
-command @code{add-file-local-variable}. This prompts for a variable
-and value, and adds them to the list. If necessary, it also adds the
-start and end markers. The command @code{delete-file-local-variable}
-deletes a variable from the list. The command
-@code{copy-dir-locals-to-file-locals} copies directory-local variables
-(@pxref{Directory Variables}) to the list.
+ Instead of typing in the local variables list directly, you can use
+the command @kbd{M-x add-file-local-variable}. This prompts for a
+variable and value, and adds them to the list, adding the @samp{Local
+Variables:} string and start and end markers as necessary. The
+command @kbd{M-x delete-file-local-variable} deletes a variable from
+the list. @kbd{M-x copy-dir-locals-to-file-locals} copies
+directory-local variables to the list (@pxref{Directory Variables}).
As with the @samp{-*-} line, the variables in a local variables list
are used literally, and are not evaluated first. If you want to split
-a long string across multiple lines of the file, you can use
+a long string value across multiple lines of the file, you can use
backslash-newline, which is ignored in Lisp string constants; you
should put the prefix and suffix on each line, even lines that start
or end within the string, as they will be stripped off when processing
@@ -1049,29 +1165,40 @@ returned by that expression is ignored).
conversion of this file. @xref{Coding Systems}.
@item
-@code{unibyte} says to visit the file in a unibyte buffer, if the
-value is @code{t}. @xref{Enabling Multibyte}.
+@code{unibyte} says to load or compile a file of Emacs Lisp in unibyte
+mode, if the value is @code{t}. @xref{Disabling Multibyte}.
@end itemize
@noindent
-These four ``variables'' are not really variables; setting them in any
+These four keywords are not really variables; setting them in any
other context has no special meaning.
- You can use the @code{mode} ``variable'' to enable minor modes as
-well as the major modes; in fact, you can use it more than once, first
-to set the major mode and then to enable minor modes which are
-specific to particular buffers. Using @code{mode} for minor modes
-is deprecated, though---instead, use @code{eval: (minor-mode 1)}.
-
- Often, however, it is a mistake to enable minor modes in file local
-variables. Most minor modes, like Auto Fill mode, represent individual user
-preferences. If you want to use a minor mode, it is better to set up
-major mode hooks with your init file to turn that minor mode on for
-yourself alone (@pxref{Init File}), instead of using a local variable
-list to impose your taste on everyone.
-
- Use the command @code{normal-mode} to reset the local variables and
-major mode of a buffer according to the file name and contents,
+ Do not use the @code{mode} keyword for minor modes. To enable or
+disable a minor mode in a local variables list, use the @code{eval}
+keyword with a Lisp expression that runs the mode command
+(@pxref{Minor Modes}). For example, the following local variables
+list enables Eldoc mode (@pxref{Lisp Doc}) by calling
+@code{eldoc-mode} with no argument (calling it with an argument of 1
+would do the same), and disables Font Lock mode (@pxref{Font Lock}) by
+calling @code{font-lock-mode} with an argument of -1.
+
+@example
+;; Local Variables:
+;; eval: (eldoc-mode)
+;; eval: (font-lock-mode -1)
+;; End:
+@end example
+
+@noindent
+Note, however, that it is often a mistake to specify minor modes this
+way. Minor modes represent individual user preferences, and it may be
+inappropriate to impose your preferences on another user who might
+edit the file. If you wish to automatically enable or disable a minor
+mode in a situation-dependent way, it is often better to do it in a
+major mode hook (@pxref{Hooks}).
+
+ Use the command @kbd{M-x normal-mode} to reset the local variables
+and major mode of a buffer according to the file name and contents,
including the local variables list if any. @xref{Choosing Modes}.
@node Safe File Variables
@@ -1139,85 +1266,83 @@ confirmation about processing @code{eval} variables.
@node Directory Variables
@subsection Per-Directory Local Variables
@cindex local variables, for all files in a directory
-@cindex directory local variables
+@cindex directory-local variables
@cindex per-directory local variables
- A @dfn{project} is a collection of files on which you work together.
-Usually, the project's files are kept in one or more directories.
-Occasionally, you may wish to define Emacs settings that are common to
-all the files that belong to the project.
-
- Emacs provides two ways to specify settings that are applicable to
-files in a specific directory: you can put a special file in that
-directory, or you can define a @dfn{project class} for that directory.
+ Sometimes, you may wish to define the same set of local variables to
+all the files in a certain directory and its subdirectories, such as
+the directory tree of a large software project. This can be
+accomplished with @dfn{directory-local variables}.
@cindex @file{.dir-locals.el} file
- If you put a file with a special name @file{.dir-locals.el}@footnote{
-On MS-DOS, the name of this file should be @file{_dir-locals.el}, due
-to limitations of the DOS filesystems. If the filesystem is limited
-to 8+3 file names, the name of the file will be truncated by the OS to
-@file{_dir-loc.el}.
-} in a directory, Emacs will read it when it visits any file in that
-directory or any of its subdirectories, and apply the settings it
-specifies to the file's buffer. Emacs searches for
-@file{.dir-locals.el} starting in the directory of the visited file,
-and moving up the directory tree. (To avoid slowdown, this search is
-skipped for remote files.)
+ The usual way to define directory-local variables is to put a file
+named @file{.dir-locals.el}@footnote{ On MS-DOS, the name of this file
+should be @file{_dir-locals.el}, due to limitations of the DOS
+filesystems. If the filesystem is limited to 8+3 file names, the name
+of the file will be truncated by the OS to @file{_dir-loc.el}. } in a
+directory. Whenever Emacs visits any file in that directory or any of
+its subdirectories, it will apply the directory-local variables
+specified in @file{.dir-locals.el}, as though they had been defined as
+file-local variables for that file (@pxref{File Variables}). Emacs
+searches for @file{.dir-locals.el} starting in the directory of the
+visited file, and moving up the directory tree. To avoid slowdown,
+this search is skipped for remote files. If needed, the search can be
+extended for remote files by setting the variable
+@code{enable-remote-dir-locals} to @code{t}.
The @file{.dir-locals.el} file should hold a specially-constructed
-list. This list maps Emacs mode names (symbols) to alists; each alist
-specifies values for variables to use when the respective mode is
-turned on. The special mode name @samp{nil} means that its alist
-applies to any mode. Instead of a mode name, you can specify a string
-that is a name of a subdirectory of the project's directory; then the
-corresponding alist applies to all the files in that subdirectory.
+list, which maps major mode names (symbols) to alists
+(@pxref{Association Lists,,, elisp, The Emacs Lisp Reference Manual}).
+Each alist entry consists of a variable name and the directory-local
+value to assign to that variable, when the specified major mode is
+enabled. Instead of a mode name, you can specify @samp{nil}, which
+means that the alist applies to any mode; or you can specify a
+subdirectory name (a string), in which case the alist applies to all
+files in that subdirectory.
Here's an example of a @file{.dir-locals.el} file:
@example
((nil . ((indent-tabs-mode . t)
- (tab-width . 4)
(fill-column . 80)))
(c-mode . ((c-file-style . "BSD")))
- (java-mode . ((c-file-style . "BSD")
- (subdirs . nil)))
+ (subdirs . nil)))
("src/imported"
- . ((nil . ((change-log-default-name .
- "ChangeLog.local"))))))
+ . ((nil . ((change-log-default-name
+ . "ChangeLog.local"))))))
@end example
@noindent
-This example shows some settings for a hypothetical project. It sets
-@samp{indent-tabs-mode}, @code{tab-width}, and @code{fill-column} for
-any file in the project's directory tree, and it sets the indentation
-style for any C or Java source file. The special @code{subdirs} element
-indicates that the Java mode settings are only to be applied in the
-current directory, not in any subdirectories. Finally, it specifies a
-different @file{ChangeLog} file name for any file in the @file{src/imported}
-subdirectory of the directory where you put the @file{.dir-locals.el}
-file.
+This sets @samp{indent-tabs-mode} and @code{fill-column} for any file
+in the directory tree, and the indentation style for any C source
+file. The special @code{subdirs} element is not a variable, but a
+special keyword which indicates that the C mode settings are only to
+be applied in the current directory, not in any subdirectories.
+Finally, it specifies a different @file{ChangeLog} file name for any
+file in the @file{src/imported} subdirectory.
@findex add-dir-local-variable
@findex delete-dir-local-variable
@findex copy-file-locals-to-dir-locals
- You can edit the @file{.dir-locals.el} file by hand, or use the
-command @code{add-dir-local-variable}. This prompts for a mode (or
-subdirectory), variable and value, and adds an entry to the file.
-The command @code{delete-dir-local-variable} deletes an entry. The
-command @code{copy-file-locals-to-dir-locals} copies file local
-variables (@pxref{File Variables}) to the @file{.dir-locals.el} file.
+ Instead of editing the @file{.dir-locals.el} file by hand, you can
+use the command @kbd{M-x add-dir-local-variable}. This prompts for a
+mode or subdirectory name, and for variable and value, and adds the
+entry defining the directory-local variable. @kbd{M-x
+delete-dir-local-variable} deletes an entry. @kbd{M-x
+copy-file-locals-to-dir-locals} copies the file-local variables in the
+current file into @file{.dir-locals.el}.
@findex dir-locals-set-class-variables
@findex dir-locals-set-directory-class
- Another method of specifying directory-local variables is to explicitly
-define a project class using @code{dir-locals-set-class-variables}, and
-then tell Emacs which directories correspond to that class, using
-@code{dir-locals-set-directory-class}. You can put calls to these functions
-in your @file{~/.emacs} init file; this can be useful when you can't put
-@file{.dir-locals.el} in the directory for some reason, or if you want
-to keep in a single place settings for several directories that don't
-have a common parent. For example, you could apply settings to an
-unwritable directory this way:
+ Another method of specifying directory-local variables is to define
+a group of variables/value pairs in a @dfn{directory class}, using the
+@code{dir-locals-set-class-variables} function; then, tell Emacs which
+directories correspond to the class by using the
+@code{dir-locals-set-directory-class} function. These function calls
+normally go in your initialization file (@pxref{Init File}). This
+method is useful when you can't put @file{.dir-locals.el} in a
+directory for some reason. For example, you could apply settings to
+an unwritable directory this way:
@example
(dir-locals-set-class-variables 'unwritable-directory
@@ -1227,8 +1352,14 @@ unwritable directory this way:
"/usr/include/" 'unwritable-directory)
@end example
- Unsafe directory-local variables are handled in the same way as
-unsafe file-local variables (@pxref{Safe File Variables}).
+ If a variable has both a directory-local and file-local value
+specified, the file-local value takes effect. Unsafe directory-local
+variables are handled in the same way as unsafe file-local variables
+(@pxref{Safe File Variables}).
+
+ Directory-local variables also take effect in certain buffers that
+do not visit a file directly but perform work within a directory, such
+as Dired buffers (@pxref{Dired}).
@node Key Bindings
@section Customizing Key Bindings
@@ -1245,7 +1376,7 @@ init file (@pxref{Init Rebinding}).
* Local Keymaps:: Major and minor modes have their own keymaps.
* Minibuffer Maps:: The minibuffer uses its own local keymaps.
* Rebinding:: How to redefine one key's meaning conveniently.
-* Init Rebinding:: Rebinding keys with your init file, @file{.emacs}.
+* Init Rebinding:: Rebinding keys with your initialization file.
* Modifier Keys:: Using modifier keys in key bindings.
* Function Keys:: Rebinding terminal function keys.
* Named ASCII Chars:: Distinguishing @key{TAB} from @kbd{C-i}, and so on.
@@ -1396,7 +1527,7 @@ circumstances.
@vindex minibuffer-local-completion-map
@vindex minibuffer-local-must-match-map
@vindex minibuffer-local-filename-completion-map
-@vindex minibuffer-local-must-match-filename-map
+@vindex minibuffer-local-filename-must-match-map
The minibuffer has its own set of local keymaps; they contain various
completion and exit commands.
@@ -1413,7 +1544,7 @@ just like @key{RET}.
for cautious completion.
@item
@code{minibuffer-local-filename-completion-map} and
-@code{minibuffer-local-must-match-filename-map} are like the two
+@code{minibuffer-local-filename-must-match-map} are like the two
previous ones, but they are specifically for file name completion.
They do not bind @key{SPC}.
@end itemize
@@ -1605,11 +1736,11 @@ and @kbd{C-c p} in Texinfo mode:
@example
(add-hook 'texinfo-mode-hook
- '(lambda ()
- (define-key texinfo-mode-map "\C-cp"
- 'backward-paragraph)
- (define-key texinfo-mode-map "\C-cn"
- 'forward-paragraph)))
+ (lambda ()
+ (define-key texinfo-mode-map "\C-cp"
+ 'backward-paragraph)
+ (define-key texinfo-mode-map "\C-cn"
+ 'forward-paragraph)))
@end example
@node Modifier Keys
@@ -1796,7 +1927,7 @@ single click definition has run when the first click was received.
This constrains what you can do with double clicks, but user interface
designers say that this constraint ought to be followed in any case. A
double click should do something similar to the single click, only
-``more so.'' The command for the double-click event should perform the
+``more so''. The command for the double-click event should perform the
extra work for the double click.
If a double-click event has no binding, it changes to the
@@ -1844,7 +1975,7 @@ or @samp{triple-}, which always precede @samp{drag-} or @samp{down-}.
A frame includes areas that don't show text from the buffer, such as
the mode line and the scroll bar. You can tell whether a mouse button
comes from a special area of the screen by means of dummy ``prefix
-keys.'' For example, if you click the mouse in the mode line, you get
+keys''. For example, if you click the mouse in the mode line, you get
the prefix key @code{mode-line} before the ordinary mouse-button symbol.
Thus, here is how to define the command for clicking the first button in
a mode line to run @code{scroll-up-command}:
@@ -1895,7 +2026,7 @@ input saying whether to execute the command as requested, enable it
and execute it, or cancel. If you decide to enable the command, you
must then answer another question---whether to do this permanently, or
just for the current session. (Enabling permanently works by
-automatically editing your @file{.emacs} file.) You can also type
+automatically editing your initialization file.) You can also type
@kbd{!} to enable @emph{all} commands, for the current session only.
The direct mechanism for disabling a command is to put a
@@ -1916,15 +2047,16 @@ is included in the message displayed when the command is used:
@findex disable-command
@findex enable-command
- You can make a command disabled either by editing the @file{.emacs}
-file directly, or with the command @kbd{M-x disable-command}, which edits
-the @file{.emacs} file for you. Likewise, @kbd{M-x enable-command}
-edits @file{.emacs} to enable a command permanently. @xref{Init File}.
+ You can make a command disabled either by editing the initialization
+file directly, or with the command @kbd{M-x disable-command}, which
+edits the initialization file for you. Likewise, @kbd{M-x
+enable-command} edits the initialization file to enable a command
+permanently. @xref{Init File}.
If Emacs was invoked with the @option{-q} or @option{--no-init-file}
options (@pxref{Initial Options}), it will not edit your
-@file{~/.emacs} init file. Doing so could lose information
-because Emacs has not read your init file.
+initialization file. Doing so could lose information because Emacs
+has not read your initialization file.
Whether a command is disabled is independent of what key is used to
invoke it; disabling also applies if the command is invoked using
@@ -1932,7 +2064,7 @@ invoke it; disabling also applies if the command is invoked using
as a function from Lisp programs.
@node Init File
-@section The Init File, @file{~/.emacs}
+@section The Emacs Initialization File
@cindex init file
@cindex .emacs file
@cindex ~/.emacs file
@@ -1975,11 +2107,12 @@ loading of this library, use the option @samp{--no-site-file}.
better to put them in @file{default.el}, so that users can more easily
override them.
+@cindex site-lisp directories
You can place @file{default.el} and @file{site-start.el} in any of
the directories which Emacs searches for Lisp libraries. The variable
@code{load-path} (@pxref{Lisp Libraries}) specifies these directories.
-Many sites put these files in the @file{site-lisp} subdirectory of the
-Emacs installation directory, typically
+Many sites put these files in a subdirectory named @file{site-lisp} in
+the Emacs installation directory, such as
@file{/usr/local/share/emacs/site-lisp}.
Byte-compiling your init file is not recommended (@pxref{Byte
@@ -2164,21 +2297,13 @@ Turn off Line Number mode, a global minor mode.
@need 1500
@item
-Turn on Auto Fill mode automatically in Text mode and related modes.
+Turn on Auto Fill mode automatically in Text mode and related modes
+(@pxref{Hooks}).
@example
(add-hook 'text-mode-hook 'auto-fill-mode)
@end example
-This shows how to add a hook function to a normal hook variable
-(@pxref{Hooks}). The function we supply is a list starting with
-@code{lambda}, with a single-quote in front of it to make it a list
-constant rather than an expression.
-
-It's beyond the scope of this manual to explain Lisp functions, but
-for this example it is enough to know that the effect is to execute
-the @code{auto-fill-mode} function when Text mode is entered.
-
@item
Load the installed Lisp library named @file{foo} (actually a file
@file{foo.elc} or @file{foo.el} in a standard Emacs directory).
@@ -2198,7 +2323,7 @@ Load the compiled Lisp file @file{foo.elc} from your home directory.
(load "~/foo.elc")
@end example
-Here an absolute file name is used, so no searching is done.
+Here a full file name is used, so no searching is done.
@item
@cindex loading Lisp libraries automatically
diff --git a/doc/emacs/dired-xtra.texi b/doc/emacs/dired-xtra.texi
index 52ccccce58c..81de9a800f9 100644
--- a/doc/emacs/dired-xtra.texi
+++ b/doc/emacs/dired-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2004-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
@@ -9,12 +9,19 @@
You can insert subdirectories with specified @command{ls} switches in
Dired buffers using @kbd{C-u i}. You can change the @command{ls}
-switches of an already inserted subdirectory using @kbd{C-u l}.
+switches of an already inserted subdirectory at point using @kbd{C-u l}.
Dired preserves the switches if you revert the buffer. Deleting a
subdirectory forgets about its switches.
-Using @code{dired-undo} (@pxref{Marks vs Flags}) to reinsert or delete
+Using @code{dired-undo}
+@iftex
+(@pxref{Marks vs Flags,,, emacs, the Emacs Manual})
+@end iftex
+@ifnottex
+(@pxref{Marks vs Flags})
+@end ifnottex
+to reinsert or delete
subdirectories that were inserted with explicit switches can bypass
Dired's machinery for remembering (or forgetting) switches. Deleting
a subdirectory using @code{dired-undo} does not forget its switches.
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 5097565830e..69b72b2c73a 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Dired
@@ -14,7 +14,7 @@ optionally some of its subdirectories as well. You can use the normal
Emacs commands to move around in this buffer, and special Dired
commands to operate on the listed files.
- The Dired buffer is ``read-only,'' and inserting text in it is not
+ The Dired buffer is ``read-only'', and inserting text in it is not
allowed. Ordinary printing characters such as @kbd{d} and @kbd{x} are
redefined for special Dired commands. Some Dired commands @dfn{mark}
or @dfn{flag} the @dfn{current file} (that is, the file on the current
@@ -40,7 +40,7 @@ you to operate on the listed files. @xref{Directories}.
either one file or several files.
* Shell Commands in Dired:: Running a shell command on the marked files.
* Transforming File Names:: Using patterns to rename multiple files.
-* Comparison in Dired:: Running `diff' by way of Dired.
+* Comparison in Dired:: Running @code{diff} by way of Dired.
* Subdirectories in Dired:: Adding subdirectories to the Dired buffer.
@ifnottex
* Subdir Switches:: Subdirectory switches in Dired.
@@ -48,7 +48,7 @@ you to operate on the listed files. @xref{Directories}.
* Subdirectory Motion:: Moving across subdirectories, and up and down.
* Hiding Subdirectories:: Making subdirectories visible or invisible.
* Updating: Dired Updating. Discarding lines for files of no interest.
-* Find: Dired and Find. Using `find' to choose the files for Dired.
+* Find: Dired and Find. Using @code{find} to choose the files for Dired.
* Wdired:: Operating on files by editing the Dired buffer.
* Image-Dired:: Viewing image thumbnails in Dired.
* Misc: Misc Dired Features. Various other features.
@@ -104,7 +104,7 @@ use the @samp{--dired} option.
@findex dired-other-frame
@kindex C-x 5 d
To display the Dired buffer in another window, use @kbd{C-x 4 d}
-(@code{dired-other-window}) instead of @kbd{C-x d}. @kbd{C-x 5 d}
+(@code{dired-other-window}). @kbd{C-x 5 d}
(@code{dired-other-frame}) displays the Dired buffer in a separate
frame.
@@ -167,13 +167,14 @@ deletion, then delete the files that were flagged.
@table @kbd
@item d
-Flag this file for deletion.
+Flag this file for deletion (@code{dired-flag-file-deletion}).
@item u
-Remove deletion flag on this line.
+Remove the deletion flag (@code{dired-unmark}).
@item @key{DEL}
-Move point to previous line and remove the deletion flag on that line.
+Move point to previous line and remove the deletion flag on that line
+(@code{dired-unmark-backward}).
@item x
-Delete the files that are flagged for deletion.
+Delete files flagged for deletion (@code{dired-do-flagged-delete}).
@end table
@kindex d @r{(Dired)}
@@ -182,8 +183,12 @@ Delete the files that are flagged for deletion.
the file and typing @kbd{d} (@code{dired-flag-file-deletion}). The
deletion flag is visible as a @samp{D} at the beginning of the line.
This command moves point to the next line, so that repeated @kbd{d}
-commands flag successive files. A numeric argument serves as a repeat
-count.
+commands flag successive files. A numeric prefix argument serves as a
+repeat count; a negative count means to flag preceding files.
+
+ If the region is active, the @kbd{d} command flags all files in the
+region for deletion; in this case, the command does not move point,
+and ignores any prefix argument.
@kindex u @r{(Dired deletion)}
@kindex DEL @r{(Dired)}
@@ -194,14 +199,17 @@ can remove deletion flags using the commands @kbd{u} and @key{DEL}.
@kbd{u} (@code{dired-unmark}) works just like @kbd{d}, but removes
flags rather than making flags. @key{DEL}
(@code{dired-unmark-backward}) moves upward, removing flags; it is
-like @kbd{u} with argument @minus{}1.
+like @kbd{u} with argument @minus{}1. A numeric prefix argument to
+either command serves as a repeat count, with a negative count meaning
+to unflag in the opposite direction. If the region is active, these
+commands instead unflag all files in the region, without moving point.
@kindex x @r{(Dired)}
@findex dired-do-flagged-delete
- To delete the flagged files, type @kbd{x}
-(@code{dired-do-flagged-delete}). This command first displays a list
-of all the file names flagged for deletion, and requests confirmation
-with @kbd{yes}. If you confirm, Dired deletes the flagged files, then
+ To delete flagged files, type @kbd{x}
+(@code{dired-do-flagged-delete}). This command displays a list of all
+the file names flagged for deletion, and requests confirmation with
+@kbd{yes}. If you confirm, Dired deletes the flagged files, then
deletes their lines from the text of the Dired buffer. The Dired
buffer, with somewhat fewer lines, remains selected.
@@ -387,10 +395,11 @@ and unflag files.)
@kindex m @r{(Dired)}
@kindex * m @r{(Dired)}
@findex dired-mark
-Mark the current file with @samp{*} (@code{dired-mark}). With a numeric
-argument @var{n}, mark the next @var{n} files starting with the current
-file. (If @var{n} is negative, mark the previous @minus{}@var{n}
-files.)
+Mark the current file with @samp{*} (@code{dired-mark}). If the
+region is active, mark all files in the region instead; otherwise, if
+a numeric argument @var{n} is supplied, mark the next @var{n} files
+instead, starting with the current file (if @var{n} is negative, mark
+the previous @minus{}@var{n} files).
@item * *
@kindex * * @r{(Dired)}
@@ -426,7 +435,11 @@ and @file{..} (@code{dired-mark-subdir-files}).
@kindex u @r{(Dired)}
@kindex * u @r{(Dired)}
@findex dired-unmark
-Remove any mark on this line (@code{dired-unmark}).
+Remove any mark on this line (@code{dired-unmark}). If the region is
+active, unmark all files in the region instead; otherwise, if a
+numeric argument @var{n} is supplied, unmark the next @var{n} files
+instead, starting with the current file (if @var{n} is negative,
+unmark the previous @minus{}@var{n} files).
@item @key{DEL}
@itemx * @key{DEL}
@@ -434,7 +447,11 @@ Remove any mark on this line (@code{dired-unmark}).
@findex dired-unmark-backward
@cindex unmarking files (in Dired)
Move point to previous line and remove any mark on that line
-(@code{dired-unmark-backward}).
+(@code{dired-unmark-backward}). If the region is active, unmark all
+files in the region instead; otherwise, if a numeric argument @var{n}
+is supplied, unmark the @var{n} preceding files instead, starting with
+the current file (if @var{n} is negative, unmark the next
+@minus{}@var{n} files).
@item * !
@itemx U
@@ -610,7 +627,7 @@ the copy, like @samp{cp -p}.
@cindex recursive copying
The variable @code{dired-recursive-copies} controls whether to copy
directories recursively (like @samp{cp -r}). The default is
-@code{nil}, which means that directories cannot be copied.
+@code{top}, which means to ask before recursively copying a directory.
@item D
@findex dired-do-delete
@@ -782,15 +799,20 @@ more matches. @xref{Tags Search}.
@kindex ! @r{(Dired)}
@kindex X @r{(Dired)}
The Dired command @kbd{!} (@code{dired-do-shell-command}) reads a
-shell command string in the minibuffer and runs that shell command on
+shell command string in the minibuffer, and runs that shell command on
one or more files. The files that the shell command operates on are
determined in the usual way for Dired commands (@pxref{Operating on
Files}). The command @kbd{X} is a synonym for @kbd{!}.
The command @kbd{&} (@code{dired-do-async-shell-command}) does the
-same, except that it runs the shell command asynchronously. You can
+same, except that it runs the shell command asynchronously. (You can
also do this with @kbd{!}, by appending a @samp{&} character to the
-end of the shell command.
+end of the shell command.) When the command operates on more than one
+file, it runs multiple parallel copies of the specified shell command,
+one for each file. As an exception, if the specified shell command
+ends in @samp{;} or @samp{;&}, the shell command is run in the
+background on each file sequentially; Emacs waits for each invoked
+shell command to terminate before running the next one.
For both @kbd{!} and @kbd{&}, the working directory for the shell
command is the top-level directory of the Dired buffer.
@@ -823,9 +845,9 @@ replaces each occurrence.
@item
If the command string contains neither @samp{*} nor @samp{?}, Emacs
-runs the shell command once for each file, adding the file name is
-added at the end. For example, @kbd{! uudecode @key{RET}} runs
-@code{uudecode} on each file.
+runs the shell command once for each file, adding the file name at the
+end. For example, @kbd{! uudecode @key{RET}} runs @code{uudecode} on
+each file.
@end itemize
To iterate over the file names in a more complicated fashion, use an
@@ -936,32 +958,19 @@ default.
@cindex file comparison (in Dired)
@cindex compare files (in Dired)
- Here are two Dired commands that compare specified files using
-@code{diff}. They show the output in a buffer using Diff mode
-(@pxref{Comparing Files}).
-
-@table @kbd
-@item =
@findex dired-diff
@kindex = @r{(Dired)}
-Compare the current file (the file at point) with another file (the
-file at the mark) using the @code{diff} program (@code{dired-diff}).
-The file at the mark is the first argument of @code{diff}, and the
-file at point is the second argument. This refers to the ordinary
-Emacs mark, not Dired marks; use @kbd{C-@key{SPC}}
-(@code{set-mark-command}) to set the mark at the first file's line
-(@pxref{Setting Mark}).
-
-@findex dired-backup-diff
-@kindex M-= @r{(Dired)}
-@item M-=
-Compare the current file with its latest backup file
-(@code{dired-backup-diff}). If the current file is itself a backup,
-compare it with the file it is a backup of; this way, you can compare
-a file with any one of its backups.
-
-The backup file is the first file given to @code{diff}.
-@end table
+ The @kbd{=} (@code{dired-diff}) command compares the current file
+(the file at point) with another file (read using the minibuffer)
+using the @command{diff} program. The file specified with the
+minibuffer is the first argument of @command{diff}, and file at point
+is the second argument. The output of the @command{diff} program is
+shown in a buffer using Diff mode (@pxref{Comparing Files}).
+
+ If the region is active, the default for the file read using the
+minibuffer is the file at the mark (i.e.@: the ordinary Emacs mark,
+not a Dired mark; @pxref{Setting Mark}). Otherwise, if the file at
+point has a backup file (@pxref{Backup}), that is the default.
@node Subdirectories in Dired
@section Subdirectories in Dired
@@ -1161,17 +1170,17 @@ automatically when you revisit it, by setting the variable
@kindex k @r{(Dired)}
@findex dired-do-kill-lines
- To delete the specified @emph{file lines} from the buffer---not
-delete the files---type @kbd{k} (@code{dired-do-kill-lines}). Like
+ To delete @emph{file lines} from the buffer---without actually
+deleting the files---type @kbd{k} (@code{dired-do-kill-lines}). Like
the file-operating commands, this command operates on the next @var{n}
-files, or on the marked files if any; but it does not operate on the
-current file as a last resort.
+files, or on the marked files if any. However, it does not operate on
+the current file, since otherwise mistyping @kbd{k} could be annoying.
- If you use @kbd{k} with a numeric prefix argument to kill the line
-for a file that is a directory, which you have inserted in the Dired
-buffer as a subdirectory, it removed that subdirectory line from the
-buffer as well. Typing @kbd{C-u k} on the header line for a
-subdirectory also removes the subdirectory line from the Dired buffer.
+ If you use @kbd{k} to kill the line for a directory file which you
+had inserted in the Dired buffer as a subdirectory
+(@pxref{Subdirectories in Dired}), it removes the subdirectory listing
+as well. Typing @kbd{C-u k} on the header line for a subdirectory
+also removes the subdirectory line from the Dired buffer.
The @kbd{g} command brings back any individual lines that you have
killed in this way, but not subdirectories---you must use @kbd{i} to
@@ -1228,9 +1237,9 @@ need to know how to use @command{find}.
@vindex find-ls-option
The format of listing produced by these commands is controlled by
-the variable @code{find-ls-option}, whose default value specifies
-using options @samp{-ld} for @command{ls}. If your listings are
-corrupted, you may need to change the value of this variable.
+the variable @code{find-ls-option}. This is a pair of options; the
+first specifying how to call @command{find} to produce the file listing,
+and the second telling Dired to parse the output.
@findex locate
@findex locate-with-filter
@@ -1252,7 +1261,7 @@ and erases all flags and marks.
@findex wdired-change-to-wdired-mode
Wdired is a special mode that allows you to perform file operations
by editing the Dired buffer directly (the ``W'' in ``Wdired'' stands
-for ``writable.'') To enter Wdired mode, type @kbd{C-x C-q}
+for ``writable''.) To enter Wdired mode, type @kbd{C-x C-q}
(@code{dired-toggle-read-only}) while in a Dired buffer.
Alternatively, use the @samp{Immediate / Edit File Names} menu item.
@@ -1297,7 +1306,7 @@ buffer containing image-dired, corresponding to the marked files.
You can also enter Image-Dired directly by typing @kbd{M-x
image-dired}. This prompts for a directory; specify one that has
image files. This creates thumbnails for all the images in that
-directory, and displays them all in the ``thumbnail buffer.'' This
+directory, and displays them all in the ``thumbnail buffer''. This
takes a long time if the directory contains many image files, and it
asks for confirmation if the number of image files exceeds
@code{image-dired-show-all-from-dir-max-files}.
@@ -1408,7 +1417,7 @@ the current buffer.
The default comparison method (used if you type @key{RET} at the
prompt) is to compare just the file names---each file name that does
-not appear in the other directory is ``different.'' You can specify
+not appear in the other directory is ``different''. You can specify
more stringent comparisons by entering a Lisp expression, which can
refer to the variables @code{size1} and @code{size2}, the respective
file sizes; @code{mtime1} and @code{mtime2}, the last modification
@@ -1416,7 +1425,7 @@ times in seconds, as floating point numbers; and @code{fa1} and
@code{fa2}, the respective file attribute lists (as returned by the
function @code{file-attributes}). This expression is evaluated for
each pair of like-named files, and if the expression's value is
-non-@code{nil}, those files are considered ``different.''
+non-@code{nil}, those files are considered ``different''.
For instance, the sequence @code{M-x dired-compare-directories
@key{RET} (> mtime1 mtime2) @key{RET}} marks files newer in this
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index ea9bd95b8ee..876c46bdf1a 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -1,9 +1,9 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Display, Search, Registers, Top
+@node Display
@chapter Controlling the Display
Since only part of a large buffer fits in the window, Emacs has to
@@ -22,13 +22,13 @@ the text is displayed.
* Follow Mode:: Follow mode lets two windows scroll as one.
* Faces:: How to change the display style using faces.
* Colors:: Specifying colors for faces.
-* Standard Faces:: Emacs' predefined faces.
+* Standard Faces:: The main predefined faces.
* Text Scale:: Increasing or decreasing text size in a buffer.
* Font Lock:: Minor mode for syntactic highlighting using faces.
* Highlight Interactively:: Tell Emacs what text to highlight.
* Fringes:: Enabling or disabling window fringes.
* Displaying Boundaries:: Displaying top and bottom of the buffer.
-* Useless Whitespace:: Showing possibly-spurious trailing whitespace.
+* Useless Whitespace:: Showing possibly spurious trailing whitespace.
* Selective Display:: Hiding lines with lots of indentation.
* Optional Mode Line:: Optional mode line display features.
* Text Display:: How text characters are normally displayed.
@@ -213,61 +213,68 @@ entire current defun onto the screen if possible.
@node Auto Scrolling
@section Automatic Scrolling
+@cindex automatic scrolling
Emacs performs @dfn{automatic scrolling} when point moves out of the
-visible portion of the text.
+visible portion of the text. Normally, automatic scrolling centers
+point vertically in the window, but there are several ways to alter
+this behavior.
@vindex scroll-conservatively
- Normally, this centers point vertically within the window. However,
-if you set @code{scroll-conservatively} to a small number @var{n},
-then if you move point just a little off the screen (less than @var{n}
-lines), Emacs scrolls the text just far enough to bring point back on
-screen. By default, @code{scroll-conservatively} is@tie{}0. If you
-set @code{scroll-conservatively} to a large number (larger than 100),
-Emacs will never center point as result of scrolling, even if point
-moves far away from the text previously displayed in the window. With
-such a large value, Emacs will always scroll text just enough for
-bringing point into view, so point will end up at the top or bottom of
-the window, depending on the scroll direction.
+ If you set @code{scroll-conservatively} to a small number @var{n},
+then moving point just a little off the screen (no more than @var{n}
+lines) causes Emacs to scroll just enough to bring point back on
+screen; if doing so fails to make point visible, Emacs scrolls just
+far enough to center point in the window. If you set
+@code{scroll-conservatively} to a large number (larger than 100),
+automatic scrolling never centers point, no matter how far point
+moves; Emacs always scrolls text just enough to bring point into view,
+either at the top or bottom of the window depending on the scroll
+direction. By default, @code{scroll-conservatively} is@tie{}0, which
+means to always center point in the window.
@vindex scroll-step
- The variable @code{scroll-step} determines how many lines to scroll
-the window when point moves off the screen. If moving by that number
-of lines fails to bring point back into view, point is centered
-instead. The default value is zero, which causes point to always be
-centered after scrolling.
+ Another way to control automatic scrolling is to customize the
+variable @code{scroll-step}. Its value determines the number of lines
+by which to automatically scroll, when point moves off the screen. If
+scrolling by that number of lines fails to bring point back into view,
+point is centered instead. The default value is zero, which (by
+default) causes point to always be centered after scrolling.
@cindex aggressive scrolling
@vindex scroll-up-aggressively
@vindex scroll-down-aggressively
- When the window does scroll by a distance longer than
-@code{scroll-step}, you can control how aggressively it scrolls by
-setting the variables @code{scroll-up-aggressively} and
-@code{scroll-down-aggressively}. The value of
-@code{scroll-up-aggressively} should be either @code{nil}, or a
-fraction @var{f} between 0 and 1. A fraction specifies where on the
-screen to put point when scrolling upward, i.e.@: forward. When point
-goes off the window end, the new start position is chosen to put point
-@var{f} parts of the window height from the bottom margin. Thus,
-larger @var{f} means more aggressive scrolling: more new text is
-brought into view. The default value, @code{nil}, is equivalent to
-0.5.
-
- Likewise, @code{scroll-down-aggressively} is used for scrolling
-down, i.e.@: backward. The value specifies how far point should be
-placed from the top margin of the window; thus, as with
-@code{scroll-up-aggressively}, a larger value is more aggressive.
-
- These two variables are ignored if either @code{scroll-step} or
-@code{scroll-conservatively} are set to a non-zero value.
-
- Note that @code{scroll-margin}, described below, limits the amount
-of scrolling so as to put point outside of the top or bottom margin,
-even if aggressive scrolling specifies a fraction @var{f} that is
-larger than the window portion between the top and the bottom margins.
+ A third way to control automatic scrolling is to customize the
+variables @code{scroll-up-aggressively} and
+@code{scroll-down-aggressively}, which directly specify the vertical
+position of point after scrolling. The value of
+@code{scroll-up-aggressively} should be either @code{nil} (the
+default), or a floating point number @var{f} between 0 and 1. The
+latter means that when point goes below the bottom window edge (i.e.@:
+scrolling forward), Emacs scrolls the window so that point is @var{f}
+parts of the window height from the bottom window edge. Thus, larger
+@var{f} means more aggressive scrolling: more new text is brought into
+view. The default value, @code{nil}, is equivalent to 0.5.
+
+ Likewise, @code{scroll-down-aggressively} is used when point goes
+above the bottom window edge (i.e.@: scrolling backward). The value
+specifies how far point should be from the top margin of the window
+after scrolling. Thus, as with @code{scroll-up-aggressively}, a
+larger value is more aggressive.
+
+ Note that the variables @code{scroll-conservatively},
+@code{scroll-step}, and @code{scroll-up-aggressively} /
+@code{scroll-down-aggressively} control automatic scrolling in
+contradictory ways. Therefore, you should pick no more than one of
+these methods to customize automatic scrolling. In case you customize
+multiple variables, the order of priority is:
+@code{scroll-conservatively}, then @code{scroll-step}, and finally
+@code{scroll-up-aggressively} / @code{scroll-down-aggressively}.
@vindex scroll-margin
The variable @code{scroll-margin} restricts how close point can come
-to the top or bottom of a window. Its value is a number of screen
+to the top or bottom of a window (even if aggressive scrolling
+specifies a fraction @var{f} that is larger than the window portion
+between the top and the bottom margins). Its value is a number of screen
lines; if point comes within that many lines of the top or bottom of
the window, Emacs performs automatic scrolling. By default,
@code{scroll-margin} is 0.
@@ -286,15 +293,15 @@ scrolling whenever point moves off the left or right edge of the
screen. To disable automatic horizontal scrolling, set the variable
@code{auto-hscroll-mode} to @code{nil}. Note that when the automatic
horizontal scrolling is turned off, if point moves off the edge of the
-screen, the cursor disappears to indicate that. (On text-only
-terminals, the cursor is left at the edge instead.)
+screen, the cursor disappears to indicate that. (On text terminals,
+the cursor is left at the edge instead.)
@vindex hscroll-margin
The variable @code{hscroll-margin} controls how close point can get
-to the window's edges before automatic scrolling occurs. It is
-measured in columns. For example, if the value is 5, then moving
-point within 5 columns of an edge causes horizontal scrolling away
-from that edge.
+to the window's left and right edges before automatic scrolling
+occurs. It is measured in columns. For example, if the value is 5,
+then moving point within 5 columns of an edge causes horizontal
+scrolling away from that edge.
@vindex hscroll-step
The variable @code{hscroll-step} determines how many columns to
@@ -448,7 +455,7 @@ and visits it with View mode enabled.
@cindex synchronizing windows
@dfn{Follow mode} is a minor mode that makes two windows, both
-showing the same buffer, scroll as a single tall ``virtual window.''
+showing the same buffer, scroll as a single tall ``virtual window''.
To use Follow mode, go to a frame with just one window, split it into
two side-by-side windows using @kbd{C-x 3}, and then type @kbd{M-x
follow-mode}. From then on, you can edit the buffer in either of the
@@ -478,21 +485,39 @@ type @kbd{M-x list-faces-display}. With a prefix argument, this
prompts for a regular expression, and displays only faces with names
matching that regular expression (@pxref{Regexps}).
+@vindex frame-background-mode
It's possible for a given face to look different in different
-frames. For instance, some text-only terminals do not support all
-face attributes, particularly font, height, and width, and some
-support a limited range of colors.
+frames. For instance, some text terminals do not support all face
+attributes, particularly font, height, and width, and some support a
+limited range of colors. In addition, most Emacs faces are defined so
+that their attributes are different on light and dark frame
+backgrounds, for reasons of legibility. By default, Emacs
+automatically chooses which set of face attributes to display on each
+frame, based on the frame's current background color. However, you
+can override this by giving the variable @code{frame-background-mode}
+a non-@code{nil} value. A value of @code{dark} makes Emacs treat all
+frames as if they have a dark background, whereas a value of
+@code{light} makes it treat all frames as if they have a light
+background.
@cindex background color
@cindex default face
- You can customize a face to alter its appearance, and save those
-changes for future Emacs sessions. @xref{Face Customization}. A face
-does not have to specify every single attribute; often it inherits
-most attributes from another face. Any ultimately unspecified
-attribute is taken from a face named @code{default}, whose attributes
-are all specified. The @code{default} face is the default for
-displaying text, and its background color is also used as the frame's
-background color.
+ You can customize a face to alter its attributes, and save those
+customizations for future Emacs sessions. @xref{Face Customization},
+for details.
+
+ The @code{default} face is the default for displaying text, and all
+of its attributes are specified. Its background color is also used as
+the frame's background color. @xref{Colors}.
+
+@cindex cursor face
+ Another special face is the @code{cursor} face. On graphical
+displays, the background color of this face is used to draw the text
+cursor. None of the other attributes of this face have any effect;
+the foreground color for text under the cursor is taken from the
+background color of the underlying text. On text terminals, the
+appearance of the text cursor is determined by the terminal, not by
+the @code{cursor} face.
You can also use X resources to specify attributes of any particular
face. @xref{Resources}.
@@ -514,16 +539,18 @@ specify a color for a face---for instance, when customizing the face
or an @dfn{RGB triplet}.
@findex list-colors-display
+@vindex list-colors-sort
A color name is a pre-defined name, such as @samp{dark orange} or
@samp{medium sea green}. To view a list of color names, type @kbd{M-x
-list-colors-display}. If you run this command on a graphical display,
-it shows the full range of color names known to Emacs (these are the
-standard X11 color names, defined in X's @file{rgb.txt} file). If you
-run the command on a text-only terminal, it shows only a small subset
-of colors that can be safely displayed on such terminals. However,
-Emacs understands X11 color names even on text-only terminals; if a
-face is given a color specified by an X11 color name, it is displayed
-using the closest-matching terminal color.
+list-colors-display}. To control the order in which colors are shown,
+customize @code{list-colors-sort}. If you run this command on a
+graphical display, it shows the full range of color names known to
+Emacs (these are the standard X11 color names, defined in X's
+@file{rgb.txt} file). If you run the command on a text terminal, it
+shows only a small subset of colors that can be safely displayed on
+such terminals. However, Emacs understands X11 color names even on
+text terminals; if a face is given a color specified by an X11 color
+name, it is displayed using the closest-matching terminal color.
An RGB triplet is a string of the form @samp{#RRGGBB}. Each of the
R, G, and B components is a hexadecimal number specifying the
@@ -639,8 +666,8 @@ at the top of a window just as the mode line appears at the bottom.
Most windows do not have a header line---only some special modes, such
Info mode, create one.
@item vertical-border
-This face is used for the vertical divider between windows on
-text-only terminals.
+This face is used for the vertical divider between windows on text
+terminals.
@item minibuffer-prompt
@cindex @code{minibuffer-prompt} face
@vindex minibuffer-prompt-properties
@@ -667,9 +694,9 @@ This face determines the color of the mouse pointer.
@end table
The following faces likewise control the appearance of parts of the
-Emacs frame, but only on text-only terminals, or when Emacs is built
-on X with no toolkit support. (For all other cases, the appearance of
-the respective frame elements is determined by system-wide settings.)
+Emacs frame, but only on text terminals, or when Emacs is built on X
+with no toolkit support. (For all other cases, the appearance of the
+respective frame elements is determined by system-wide settings.)
@table @code
@item scroll-bar
@@ -750,11 +777,10 @@ argument disables it.
@findex global-font-lock-mode
@vindex global-font-lock-mode
- To toggle Font Lock mode in all buffers, type @kbd{M-x
-global-font-lock-mode}. To impose this setting for future Emacs
-sessions, customize the variable @code{global-font-lock-mode}
-(@pxref{Easy Customization}), or add the following line to your init
-file:
+ Type @kbd{M-x global-font-lock-mode} to toggle Font Lock mode in all
+buffers. To impose this setting for future Emacs sessions, customize
+the variable @code{global-font-lock-mode} (@pxref{Easy
+Customization}), or add the following line to your init file:
@example
(global-font-lock-mode 0)
@@ -970,15 +996,15 @@ fringes on the selected frame only, use @kbd{M-x set-fringe-style}.
line (@pxref{Continuation Lines}). When one line of text is split
into multiple screen lines, the left fringe shows a curving arrow for
each screen line except the first, indicating that ``this is not the
-real beginning.'' The right fringe shows a curving arrow for each
+real beginning''. The right fringe shows a curving arrow for each
screen line except the last, indicating that ``this is not the real
-end.'' If the line's direction is right-to-left (@pxref{Bidirectional
+end''. If the line's direction is right-to-left (@pxref{Bidirectional
Editing}), the meanings of the curving arrows in the fringes are
swapped.
The fringes indicate line truncation with short horizontal arrows
meaning ``there's more text on this line which is scrolled
-horizontally out of view.'' Clicking the mouse on one of the arrows
+horizontally out of view''. Clicking the mouse on one of the arrows
scrolls the display horizontally in the direction of the arrow.
The fringes can also indicate other things, such as buffer
@@ -1028,9 +1054,9 @@ the left fringe, but no arrow bitmaps, use @code{((top . left)
@cindex whitespace, trailing
@vindex show-trailing-whitespace
It is easy to leave unnecessary spaces at the end of a line, or
-empty lines at the end of a file, without realizing it. In most
-cases, this @dfn{trailing whitespace} has no effect, but there are
-special circumstances where it matters, and it can be a nuisance.
+empty lines at the end of a buffer, without realizing it. In most
+cases, this @dfn{trailing whitespace} has no effect, but sometimes it
+can be a nuisance.
You can make trailing whitespace at the end of a line visible by
setting the buffer-local variable @code{show-trailing-whitespace} to
@@ -1045,9 +1071,13 @@ the location of point is enough to show you that the spaces are
present.
@findex delete-trailing-whitespace
+@vindex delete-trailing-lines
Type @kbd{M-x delete-trailing-whitespace} to delete all trailing
-whitespace within the buffer. If the region is active, it deletes all
-trailing whitespace in the region instead.
+whitespace. This command deletes all extra spaces at the end of each
+line in the buffer, and all empty lines at the end of the buffer; to
+ignore the latter, change the variable @code{delete-trailing-lines} to
+@code{nil}. If the region is active, the command instead deletes
+extra spaces at the end of each line in the region.
@vindex indicate-empty-lines
@cindex unused lines
@@ -1062,6 +1092,56 @@ can enable or disable this feature for all new buffers by setting the
default value of this variable, e.g.@: @code{(setq-default
indicate-empty-lines t)}.
+@cindex Whitespace mode
+@cindex mode, Whitespace
+@findex whitespace-mode
+@vindex whitespace-style
+ Whitespace mode is a buffer-local minor mode that lets you
+``visualize'' many kinds of whitespace in the buffer, by either
+drawing the whitespace characters with a special face or displaying
+them as special glyphs. To toggle this mode, type @kbd{M-x
+whitespace-mode}. The kinds of whitespace visualized are determined
+by the list variable @code{whitespace-style}. Here is a partial list
+of possible elements (see the variable's documentation for the full
+list):
+
+@table @code
+@item face
+Enable all visualizations which use special faces. This element has a
+special meaning: if it is absent from the list, none of the other
+visualizations take effect except @code{space-mark}, @code{tab-mark},
+and @code{newline-mark}.
+
+@item trailing
+Highlight trailing whitespace.
+
+@item tabs
+Highlight tab characters.
+
+@item spaces
+Highlight space and non-breaking space characters.
+
+@item lines
+@vindex whitespace-line-column
+Highlight lines longer than 80 lines. To change the column limit,
+customize the variable @code{whitespace-line-column}.
+
+@item newline
+Highlight newlines.
+
+@item empty
+Highlight empty lines.
+
+@item space-mark
+Draw space and non-breaking characters with a special glyph.
+
+@item tab-mark
+Draw tab characters with a special glyph.
+
+@item newline-mark
+Draw newline characters with a special glyph.
+@end table
+
@node Selective Display
@section Selective Display
@cindex selective display
@@ -1391,9 +1471,9 @@ global-hl-line-mode} enables or disables the same mode globally.
Emacs can display long lines by @dfn{truncation}. This means that all
the characters that do not fit in the width of the screen or window do
not appear at all. On graphical displays, a small straight arrow in
-the fringe indicates truncation at either end of the line. On
-text-only terminals, this is indicated with @samp{$} signs in the
-leftmost and/or rightmost columns.
+the fringe indicates truncation at either end of the line. On text
+terminals, this is indicated with @samp{$} signs in the leftmost
+and/or rightmost columns.
@vindex truncate-lines
@findex toggle-truncate-lines
@@ -1423,6 +1503,7 @@ attempts to wrap the line at word boundaries near the right window
edge. This makes the text easier to read, as wrapping does not occur
in the middle of words.
+@cindex mode, Visual Line
@cindex Visual Line mode
@findex visual-line-mode
@findex global-visual-line-mode
@@ -1515,7 +1596,7 @@ of an overline above the text, including the height of the overline
itself, in pixels; the default is 2.
@findex tty-suppress-bold-inverse-default-colors
- On some text-only terminals, bold face and inverse video together
-result in text that is hard to read. Call the function
+ On some text terminals, bold face and inverse video together result
+in text that is hard to read. Call the function
@code{tty-suppress-bold-inverse-default-colors} with a non-@code{nil}
argument to suppress the effect of bold-face in this case.
diff --git a/doc/emacs/doclicense.texi b/doc/emacs/doclicense.texi
index 51342e96d60..cb71f05a175 100644
--- a/doc/emacs/doclicense.texi
+++ b/doc/emacs/doclicense.texi
@@ -1,4 +1,3 @@
-@c -*-texinfo-*-
@c The GNU Free Documentation License.
@center Version 1.3, 3 November 2008
@@ -6,7 +5,7 @@
@c hence no sectioning command or @node.
@display
-Copyright @copyright{} 2000, 2001, 2002, 2007, 2008, 2009 Free Software Foundation, Inc.
+Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
@uref{http://fsf.org/}
Everyone is permitted to copy and distribute verbatim copies
@@ -93,16 +92,16 @@ An image format is not Transparent if used for any substantial amount
of text. A copy that is not ``Transparent'' is called ``Opaque''.
Examples of suitable formats for Transparent copies include plain
-@sc{ascii} without markup, Texinfo input format, La@TeX{} input
-format, @acronym{SGML} or @acronym{XML} using a publicly available
-@acronym{DTD}, and standard-conforming simple @acronym{HTML},
-PostScript or @acronym{PDF} designed for human modification. Examples
-of transparent image formats include @acronym{PNG}, @acronym{XCF} and
-@acronym{JPG}. Opaque formats include proprietary formats that can be
-read and edited only by proprietary word processors, @acronym{SGML} or
-@acronym{XML} for which the @acronym{DTD} and/or processing tools are
-not generally available, and the machine-generated @acronym{HTML},
-PostScript or @acronym{PDF} produced by some word processors for
+ASCII without markup, Texinfo input format, La@TeX{} input
+format, SGML or XML using a publicly available
+DTD, and standard-conforming simple HTML,
+PostScript or PDF designed for human modification. Examples
+of transparent image formats include PNG, XCF and
+JPG. Opaque formats include proprietary formats that can be
+read and edited only by proprietary word processors, SGML or
+XML for which the DTD and/or processing tools are
+not generally available, and the machine-generated HTML,
+PostScript or PDF produced by some word processors for
output purposes only.
The ``Title Page'' means, for a printed book, the title page itself,
@@ -482,7 +481,7 @@ license notices just after the title page:
@end smallexample
If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts,
-replace the ``with@dots{}Texts.'' line with this:
+replace the ``with@dots{}Texts.''@: line with this:
@smallexample
@group
@@ -501,8 +500,6 @@ recommend releasing these examples in parallel under your choice of
free software license, such as the GNU General Public License,
to permit their use in free software.
-
@c Local Variables:
@c ispell-local-pdict: "ispell-dict"
@c End:
-
diff --git a/doc/emacs/emacs-xtra.texi b/doc/emacs/emacs-xtra.texi
index f9d1c27fe55..78cac7d8a10 100644
--- a/doc/emacs/emacs-xtra.texi
+++ b/doc/emacs/emacs-xtra.texi
@@ -11,8 +11,7 @@
@copying
This manual describes specialized features of Emacs.
-Copyright @copyright{} 2004-2011
-Free Software Foundation, Inc.
+Copyright @copyright{} 2004-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -34,6 +33,8 @@ license to the document, as described in section 6 of the license.
@end quotation
@end copying
+@documentencoding ISO-8859-1
+
@dircategory Emacs
@direntry
* Emacs-Xtra: (emacs-xtra). Specialized Emacs features.
@@ -68,7 +69,7 @@ license to the document, as described in section 6 of the license.
* Emerge:: A convenient way of merging two versions of a program.
* Advanced VC Usage:: Advanced VC (version control) features.
* Fortran:: Fortran mode and its special features.
-* MS-DOS:: Using Emacs on MS-DOS (otherwise known as @dfn{MS-DOG}).
+* MS-DOS:: Using Emacs on MS-DOS.
@end iftex
* Index::
@end menu
@@ -109,10 +110,10 @@ style of the Elisp manual. Other sections should follow the style of
the Emacs manual.
@iftex
-@c ``Picture Mode'' is a chapter, not a section, so it's outside @raisesections.
-@include picture-xtra.texi
@raisesections
+@include picture-xtra.texi
+
@include arevert-xtra.texi
@include dired-xtra.texi
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 7f703fbaad0..005215de645 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -3,15 +3,30 @@
@setfilename ../../info/emacs
@settitle GNU Emacs Manual
-@c The edition number appears in several places in this file
-@set EDITION Sixteenth
+@c The edition number appears in more than one place in this file
+@c I don't really know what it means...
+@c For example, it has said "Sixteenth" since sometime in the Emacs 22
+@c series, all through 23, and into 24. So it is not very useful IMO,
+@c and offers nothing that EMACSVER does not. I guess it relates
+@c mainly to the published book sold by the FSF. Hence no longer
+@c bother including it except iftex. Really, I think it should not be
+@c here at all (since anyone can make a pdf version), but should just
+@c be something added by the FSF during the publishing process.
+@c Also, the lispref uses a float (3.0), whereas this uses an ordinal,
+@c so the format is not even consistent.
+@set EDITION Seventeenth
@include emacsver.texi
@copying
+@iftex
This is the @value{EDITION} edition of the @cite{GNU Emacs Manual},@*
+@end iftex
+@ifnottex
+This is the @cite{GNU Emacs Manual},
+@end ifnottex
updated for Emacs version @value{EMACSVER}.
-Copyright @copyright{} 1985-1987, 1993-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1985-1987, 1993-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -39,7 +54,7 @@ developing GNU and promoting software freedom.''
@c in general, keep the following line commented out, unless doing a
@c copy of this manual that will be published. The manual should go
@c onto the distribution in the full, 8.5 x 11" size.
-@c @smallbook
+@c @set smallbook
@ifset smallbook
@smallbook
@@ -51,8 +66,6 @@ developing GNU and promoting software freedom.''
@tex
@ifset smallbook
@fonttextsize 10
-\global\let\urlcolor=\Black % don't print links in grayscale
-\global\let\linkcolor=\Black
@end ifset
\global\hbadness=6666 % don't worry about not-too-underfull boxes
@end tex
@@ -72,7 +85,7 @@ developing GNU and promoting software freedom.''
@sp 4
@center @value{EDITION} Edition, Updated for Emacs Version @value{EMACSVER}.
@sp 5
-@center Richard Stallman
+@center Richard Stallman et al.
@page
@vskip 0pt plus 1filll
@insertcopying
@@ -81,10 +94,10 @@ developing GNU and promoting software freedom.''
Published by the Free Software Foundation @*
51 Franklin Street, Fifth Floor @*
Boston, MA 02110-1301 USA @*
-ISBN 1-882114-86-8
+ISBN 978-0-9831592-4-7
@sp 2
-Cover art by Etienne Suvasa.
+Cover art by Etienne Suvasa; cover design by Matt Lee.
@end titlepage
@@ -94,17 +107,17 @@ Cover art by Etienne Suvasa.
@ifnottex
-@node Top, Distrib, (dir), (dir)
+@node Top
@top The Emacs Editor
Emacs is the extensible, customizable, self-documenting real-time
display editor. This Info file describes how to edit with Emacs and
-some of how to customize it; it corresponds to GNU Emacs version
+some of the ways to customize it; it corresponds to GNU Emacs version
@value{EMACSVER}.
@ifinfo
-To learn more about the Info documentation system, type @kbd{h},
-to visit a programmed instruction sequence for the Info commands.
+If you are reading this in Emacs, type @kbd{h} to read a basic
+introduction to the Info documentation system.
@end ifinfo
For information on extending Emacs, see @ref{Top, Emacs Lisp,, elisp, The
@@ -113,20 +126,11 @@ Emacs Lisp Reference Manual}.
@insertcopying
@end ifnottex
+@c Note that the TeX version generates its own TOC, so the ifnottex's
+@c here are not really necessary.
@menu
* Distrib:: How to get the latest Emacs distribution.
* Intro:: An introduction to Emacs concepts.
-@c Note that in the printed manual, the glossary and indices come last.
-* Glossary:: Terms used in this manual.
-
-Indexes (each index contains a large menu)
-* Key Index:: An item for each standard Emacs key sequence.
-* Option Index:: An item for every command-line option.
-* Command Index:: An item for each command name.
-* Variable Index:: An item for each documented variable.
-* Concept Index:: An item for each concept.
-
-* Acknowledgments:: Major contributors to GNU Emacs.
Important General Concepts
* Screen:: How to interpret what you see on the screen.
@@ -146,12 +150,7 @@ Fundamental Editing Commands
Important Text-Changing Commands
* Mark:: The mark: how to delimit a "region" of text.
-* Killing:: Killing (cutting) text.
-* Yanking:: Recovering killed text. Moving text. (Pasting.)
-* Cut and Paste:: Clipboard and selections on graphical displays.
-* Accumulating Text:: Other ways of copying text.
-* Rectangles:: Operating on text in rectangular areas.
-* CUA Bindings:: Using @kbd{C-x}, @kbd{C-c}, @kbd{C-v} to kill and yank.
+* Killing:: Killing (cutting) and yanking (copying) text.
* Registers:: Saving a text string or a location in the buffer.
* Display:: Controlling what text is displayed.
* Search:: Finding or replacing occurrences of a string.
@@ -161,19 +160,18 @@ Important Text-Changing Commands
Major Structures of Emacs
* Files:: All about handling files.
* Buffers:: Multiple buffers; editing several files at once.
-* Windows:: Viewing two pieces of text at once.
-* Frames:: Running the same Emacs session in multiple X windows.
+* Windows:: Viewing multiple pieces of text in one frame.
+* Frames:: Using multiple "windows" on your display.
* International:: Using non-@acronym{ASCII} character sets.
Advanced Features
-* Modes:: Major and minor modes alter Emacs' basic behavior.
+* Modes:: Major and minor modes alter Emacs's basic behavior.
* Indentation:: Editing the white space at the beginnings of lines.
* Text:: Commands and modes for editing human languages.
* Programs:: Commands and modes for editing programs.
* Building:: Compiling, running and debugging programs.
* Maintaining:: Features for maintaining large programs.
-* Abbrevs:: Defining text abbreviations to reduce
- the number of characters you must type.
+* Abbrevs:: Defining text abbreviations to reduce typing.
* Dired:: Directory and file manager.
* Calendar/Diary:: Calendar and diary facilities.
* Sending Mail:: Sending mail in Emacs.
@@ -187,7 +185,7 @@ Advanced Features
@ifnottex
* Picture Mode:: Editing pictures made up of text characters.
@end ifnottex
-* Editing Binary Files:: Editing binary files with Hexl mode.
+* Editing Binary Files:: Editing binary files with Hexl mode.
* Saving Emacs Sessions:: Saving Emacs state from one session to the next.
* Recursive Edit:: Performing edits while "within another command".
* Emulation:: Emulating some other editors with Emacs.
@@ -210,11 +208,23 @@ Appendices
* GNU Free Documentation License:: The license for this documentation.
* Emacs Invocation:: Hairy startup options.
* X Resources:: X resources for customizing Emacs.
-* Antinews:: Information about Emacs version 22.
+* Antinews:: Information about Emacs version 23.
* Mac OS / GNUstep:: Using Emacs under Mac OS and GNUstep.
* Microsoft Windows:: Using Emacs on Microsoft Windows and MS-DOS.
* Manifesto:: What's GNU? Gnu's Not Unix!
+* Glossary:: Terms used in this manual.
+@ifnottex
+* Acknowledgments:: Major contributors to GNU Emacs.
+@end ifnottex
+
+Indexes (each index contains a large menu)
+* Key Index:: An item for each standard Emacs key sequence.
+* Option Index:: An item for every command-line option.
+* Command Index:: An item for each command name.
+* Variable Index:: An item for each documented variable.
+* Concept Index:: An item for each concept.
+
@c Do NOT modify the following 3 lines! They must have this form to
@c be correctly identified by `texinfo-multiple-files-update'. In
@c particular, the detailed menu header line MUST be identical to the
@@ -251,12 +261,14 @@ Basic Editing Commands
The Minibuffer
+* Basic Minibuffer:: Basic usage of the minibuffer.
* Minibuffer File:: Entering file names with the minibuffer.
* Minibuffer Edit:: How to edit in the minibuffer.
* Completion:: An abbreviation facility for minibuffer input.
* Minibuffer History:: Reusing recent minibuffer arguments.
* Repetition:: Re-executing commands that used the minibuffer.
* Passwords:: Entering passwords in the echo area.
+* Yes or No Prompts:: Replying yes or no in the echo area.
Completion
@@ -277,7 +289,7 @@ Help
* Language Help:: Help relating to international language support.
* Misc Help:: Other help commands.
* Help Files:: Commands to display auxiliary help files.
-* Help Echo:: Help on active text and tooltips (`balloon help').
+* Help Echo:: Help on active text and tooltips ("balloon help").
The Mark and the Region
@@ -291,6 +303,15 @@ The Mark and the Region
Killing and Moving Text
+* Deletion and Killing:: Commands that remove text.
+* Yanking:: Commands that insert text.
+* Cut and Paste:: Clipboard and selections on graphical displays.
+* Accumulating Text:: Other methods to add text to the buffer.
+* Rectangles:: Operating on text in rectangular areas.
+* CUA Bindings:: Using @kbd{C-x}/@kbd{C-c}/@kbd{C-v} to kill and yank.
+
+Deletion and Killing
+
* Deletion:: Commands for deleting small amounts of text and
blank areas.
* Killing by Lines:: How to kill entire lines of text at one time.
@@ -304,9 +325,9 @@ Yanking
* Earlier Kills:: Yanking something killed some time ago.
* Appending Kills:: Several kills in a row all yank together.
-Killing and Yanking on Graphical Displays
+"Cut and Paste" Operations on Graphical Displays
-* Clipboard:: How Emacs interacts with the system clipboard.
+* Clipboard:: How Emacs uses the system clipboard.
* Primary Selection:: The temporarily selected text selection.
* Secondary Selection:: Cutting without altering point and mark.
@@ -323,7 +344,7 @@ Registers
Controlling the Display
* Scrolling:: Commands to move text up and down in a window.
-* Recentering:: A scrolling command that centers the current line.
+* Recentering:: A scroll command that centers the current line.
* Auto Scrolling:: Redisplay scrolls text automatically when needed.
* Horizontal Scrolling:: Moving text left and right in a window.
* Narrowing:: Restricting display and editing to a portion
@@ -332,13 +353,13 @@ Controlling the Display
* Follow Mode:: Follow mode lets two windows scroll as one.
* Faces:: How to change the display style using faces.
* Colors:: Specifying colors for faces.
-* Standard Faces:: Emacs' predefined faces.
+* Standard Faces:: The main predefined faces.
* Text Scale:: Increasing or decreasing text size in a buffer.
* Font Lock:: Minor mode for syntactic highlighting using faces.
* Highlight Interactively:: Tell Emacs what text to highlight.
* Fringes:: Enabling or disabling window fringes.
* Displaying Boundaries:: Displaying top and bottom of the buffer.
-* Useless Whitespace:: Showing possibly-spurious trailing whitespace.
+* Useless Whitespace:: Showing possibly spurious trailing whitespace.
* Selective Display:: Hiding lines with lots of indentation.
* Optional Mode Line:: Optional mode line display features.
* Text Display:: How text characters are normally displayed.
@@ -353,6 +374,7 @@ Searching and Replacement
* Incremental Search:: Search happens as you type the string.
* Nonincremental Search:: Specify entire string and then search.
* Word Search:: Search for sequence of words.
+* Symbol Search:: Search for a source code symbol.
* Regexp Search:: Search for match for a regexp.
* Regexps:: Syntax of regular expressions.
* Regexp Backslash:: Regular expression constructs starting with `\'.
@@ -391,8 +413,10 @@ Keyboard Macros
* Basic Keyboard Macro:: Defining and running keyboard macros.
* Keyboard Macro Ring:: Where previous keyboard macros are saved.
* Keyboard Macro Counter:: Inserting incrementing numbers in macros.
-* Keyboard Macro Query:: Making keyboard macros do different things each time.
-* Save Keyboard Macro:: Giving keyboard macros names; saving them in files.
+* Keyboard Macro Query:: Making keyboard macros do different things each
+ time.
+* Save Keyboard Macro:: Giving keyboard macros names; saving them in
+ files.
* Edit Keyboard Macro:: Editing keyboard macros.
* Keyboard Macro Step-Edit:: Interactively executing and editing a keyboard
macro.
@@ -403,7 +427,9 @@ File Handling
* Visiting:: Visiting a file prepares Emacs to edit the file.
* Saving:: Saving makes your changes permanent.
* Reverting:: Reverting cancels all the changes not saved.
+@ifnottex
* Autorevert:: Auto Reverting non-file buffers.
+@end ifnottex
* Auto Save:: Auto Save periodically protects against loss of data.
* File Aliases:: Handling multiple names for one file.
* Directories:: Creating, deleting, and listing file directories.
@@ -412,7 +438,7 @@ File Handling
* Misc File Ops:: Other things you can do on files.
* Compressed Files:: Accessing compressed files.
* File Archives:: Operating on tar, zip, jar etc. archive files.
-* Remote Files:: Accessing files on other sites.
+* Remote Files:: Accessing files on other machines.
* Quoted File Names:: Quoting special characters in file names.
* File Name Cache:: Completion against a list of files you often use.
* File Conveniences:: Convenience Features for Finding Files.
@@ -434,11 +460,13 @@ Backup Files
* Backup Deletion:: Emacs deletes excess numbered backups.
* Backup Copying:: Backups can be made by copying or renaming.
+@ifnottex
Auto Reverting Non-File Buffers
* Auto Reverting the Buffer Menu:: Auto Revert of the Buffer Menu.
* Auto Reverting Dired:: Auto Revert of Dired buffers.
* Supporting additional buffers:: How to add more Auto Revert support.
+@end ifnottex
Auto-Saving: Protection Against Disasters
@@ -475,6 +503,10 @@ Multiple Windows
* Displaying Buffers:: How Emacs picks a window for displaying a buffer.
* Window Convenience:: Convenience functions for window handling.
+Displaying a Buffer in a Window
+
+* Window Choice:: How @code{display-buffer} works.
+
Frames and Graphical Displays
* Mouse Commands:: Moving, cutting, and pasting, with the mouse.
@@ -486,7 +518,7 @@ Frames and Graphical Displays
* Frame Commands:: Iconifying, deleting, and switching frames.
* Fonts:: Changing the frame font.
* Speedbar:: How to make and use a speedbar frame.
-* Multiple Displays:: How one Emacs job can talk to several displays.
+* Multiple Displays:: How one Emacs instance can talk to several displays.
* Frame Parameters:: Changing the colors and other modes of frames.
* Scroll Bars:: How to enable and disable scroll bars; how to use them.
* Drag and Drop:: Using drag and drop to open files and insert text.
@@ -494,14 +526,14 @@ Frames and Graphical Displays
* Tool Bars:: Enabling and disabling the tool bar.
* Dialog Boxes:: Controlling use of dialog boxes.
* Tooltips:: Displaying information at the current mouse position.
-* Mouse Avoidance:: Moving the mouse pointer out of the way.
+* Mouse Avoidance:: Preventing the mouse pointer from obscuring text.
* Non-Window Terminals:: Multiple frames on terminals that show only one.
-* Text-Only Mouse:: Using the mouse in text-only terminals.
+* Text-Only Mouse:: Using the mouse in text terminals.
International Character Set Support
* International Chars:: Basic concepts of multibyte characters.
-* Enabling Multibyte:: Controlling whether to use multibyte characters.
+* Disabling Multibyte:: Controlling whether to use multibyte characters.
* Language Environments:: Setting things up for the language you use.
* Input Methods:: Entering text characters not on your keyboard.
* Select Input Method:: Specifying your choice of input methods.
@@ -523,8 +555,9 @@ International Character Set Support
* Unibyte Mode:: You can pick one European character set
to use without multibyte characters.
* Charsets:: How Emacs groups its internal character codes.
+* Bidirectional Editing:: Support for right-to-left scripts.
-Modes
+Major and Minor Modes
* Major Modes:: Text mode vs. Lisp mode vs. C mode...
* Minor Modes:: Each minor mode is a feature you can turn on
@@ -548,10 +581,11 @@ Commands for Human Languages
* Case:: Changing the case of text.
* Text Mode:: The major modes for editing text files.
* Outline Mode:: Editing outlines.
-* TeX Mode:: Editing input to the formatter TeX.
+* Org Mode:: The Emacs organizer.
+* TeX Mode:: Editing TeX and LaTeX files.
* HTML Mode:: Editing HTML and SGML files.
-* Nroff Mode:: Editing input to the formatter nroff.
-* Enriched Text:: Editing text ``enriched'' with fonts, colors, etc.
+* Nroff Mode:: Editing input to the nroff formatter.
+* Enriched Text:: Editing text "enriched" with fonts, colors, etc.
* Text Based Tables:: Commands for editing text-based tables.
* Two-Column:: Splitting text columns into separate windows.
@@ -566,12 +600,16 @@ Filling Text
Outline Mode
* Outline Format:: What the text of an outline looks like.
-* Outline Motion:: Special commands for moving through
- outlines.
+* Outline Motion:: Special commands for moving through outlines.
* Outline Visibility:: Commands to control what is visible.
* Outline Views:: Outlines and multiple views.
* Foldout:: Folding means zooming in on outlines.
+Org Mode
+
+* Org Organizer:: Managing TODO lists and agendas.
+* Org Authoring:: Exporting Org buffers to various formats.
+
@TeX{} Mode
* TeX Editing:: Special commands for editing in TeX mode.
@@ -579,7 +617,7 @@ Outline Mode
* TeX Print:: Commands for printing part of a file with TeX.
* TeX Misc:: Customization of TeX mode, and related features.
-Editing Enriched Text
+Enriched Text
* Enriched Mode:: Entering and exiting Enriched mode.
* Hard and Soft Newlines:: There are two different kinds of newlines.
@@ -621,9 +659,11 @@ Editing Programs
* Semantic:: Suite of editing tools based on source code parsing.
* Misc for Programs:: Other Emacs features useful for editing programs.
* C Modes:: Special commands of C, C++, Objective-C,
- Java, and Pike modes.
+ Java, IDL, Pike and AWK modes.
* Asm Mode:: Asm mode and its special features.
+@ifnottex
* Fortran:: Fortran mode and its special features.
+@end ifnottex
Top-Level Definitions, or Defuns
@@ -656,10 +696,9 @@ Manipulating Comments
Documentation Lookup
-* Info Lookup:: Looking up library functions and commands
- in Info files.
-* Man Page:: Looking up man pages of library functions and commands.
-* Lisp Doc:: Looking up Emacs Lisp functions, etc.
+* Info Lookup:: Looking up library functions and commands in Info files.
+* Man Page:: Looking up man pages of library functions and commands.
+* Lisp Doc:: Looking up Emacs Lisp functions, etc.
C and Related Modes
@@ -669,6 +708,7 @@ C and Related Modes
* Other C Commands:: Filling comments, viewing expansion of macros,
and other neat features.
+@ifnottex
Fortran Mode
* Fortran Motion:: Moving point by statements or subprograms.
@@ -685,6 +725,7 @@ Fortran Indentation
* ForIndent Num:: How line numbers auto-indent.
* ForIndent Conv:: Conventions you must obey to avoid trouble.
* ForIndent Vars:: Variables controlling Fortran indent style.
+@end ifnottex
Compiling and Testing Programs
@@ -711,8 +752,7 @@ Running Debuggers Under Emacs
* Commands of GUD:: Key bindings for common commands.
* GUD Customization:: Defining your own commands for GUD.
* GDB Graphical Interface:: An enhanced mode that uses GDB features to
- implement a graphical debugging environment through
- Emacs.
+ implement a graphical debugging environment.
GDB Graphical Interface
@@ -733,7 +773,9 @@ Maintaining Large Programs
* Tags:: Go directly to any function in your program in one
command. Tags remembers which file it is in.
* EDE:: An integrated development environment for Emacs.
+@ifnottex
* Emerge:: A convenient way of merging two versions of a program.
+@end ifnottex
Version Control
@@ -747,9 +789,10 @@ Version Control
* VC Undo:: Canceling changes before or after committing.
* VC Directory Mode:: Listing files managed by version control.
* Branches:: Multiple lines of development.
-* Revision Tags:: Symbolic names for revisions.
+@ifnottex
* Miscellaneous VC:: Various other commands and features of VC.
* Customizing VC:: Variables that change VC's behavior.
+@end ifnottex
Introduction to Version Control
@@ -757,7 +800,7 @@ Introduction to Version Control
* Version Control Systems:: Supported version control back-end systems.
* VCS Concepts:: Words and concepts related to version control.
* VCS Merging:: How file conflicts are handled.
-* VCS Changesets:: Changesets in version control.
+* VCS Changesets:: How changes are grouped.
* VCS Repositories:: Where version control repositories are stored.
* Types of Log File:: The VCS log in contrast to the ChangeLog.
@@ -772,13 +815,14 @@ VC Directory Mode
* VC Directory Buffer:: What the buffer looks like and means.
* VC Directory Commands:: Commands to use in a VC directory buffer.
-Multiple Branches of a File
+Version Control Branches
* Switching Branches:: How to get to another existing branch.
-* VC Pull:: Updating a branch from another branch.
+* VC Pull:: Updating the contents of a branch.
* Merging:: Transferring changes between branches.
* Creating Branches:: How to start a new branch.
+@ifnottex
Miscellaneous Commands and Features of VC
* Change Logs and VC:: Generating a change log file from log entries.
@@ -791,6 +835,7 @@ Customizing VC
* General VC Options:: Options that apply to multiple back ends.
* RCS and SCCS:: Options for RCS and SCCS.
* CVS Options:: Options for CVS.
+@end ifnottex
Change Logs
@@ -800,13 +845,14 @@ Change Logs
Tags Tables
* Tag Syntax:: Tag syntax for various types of code and text files.
-* Create Tags Table:: Creating a tags table with @code{etags}.
+* Create Tags Table:: Creating a tags table with @command{etags}.
* Etags Regexps:: Create arbitrary tags using regular expressions.
* Select Tags Table:: How to visit a tags table.
* Find Tag:: Commands to find the definition of a specific tag.
* Tags Search:: Using a tags table for searching and replacing.
-* List Tags:: Listing and finding tags defined in a file.
+* List Tags:: Using tags for completion, and listing them.
+@ifnottex
Merging Files with Emerge
* Overview of Emerge:: How to start Emerge. Basic concepts.
@@ -819,6 +865,7 @@ Merging Files with Emerge
* Exiting Emerge:: What to do when you've finished the merge.
* Combining in Emerge:: How to keep both alternatives for a difference.
* Fine Points of Emerge:: Miscellaneous issues.
+@end ifnottex
Abbrevs
@@ -852,13 +899,15 @@ Dired, the Directory Editor
either one file or several files.
* Shell Commands in Dired:: Running a shell command on the marked files.
* Transforming File Names:: Using patterns to rename multiple files.
-* Comparison in Dired:: Running `diff' by way of Dired.
+* Comparison in Dired:: Running @code{diff} by way of Dired.
* Subdirectories in Dired:: Adding subdirectories to the Dired buffer.
+@ifnottex
* Subdir Switches:: Subdirectory switches in Dired.
+@end ifnottex
* Subdirectory Motion:: Moving across subdirectories, and up and down.
* Hiding Subdirectories:: Making subdirectories visible or invisible.
* Dired Updating:: Discarding lines for files of no interest.
-* Dired and Find:: Using `find' to choose the files for Dired.
+* Dired and Find:: Using @code{find} to choose the files for Dired.
* Wdired:: Operating on files by editing the Dired buffer.
* Image-Dired:: Viewing image thumbnails in Dired.
* Misc Dired Features:: Various other features.
@@ -877,9 +926,11 @@ The Calendar and the Diary
* Diary:: Displaying events from your diary.
* Appointments:: Reminders when it's time to do something.
* Importing Diary:: Converting diary events to/from other formats.
-* Daylight Saving:: How to specify when daylight saving time is active.
+* Daylight Saving:: How to specify when daylight saving time is active.
* Time Intervals:: Keeping track of time intervals.
+@ifnottex
* Advanced Calendar/Diary Usage:: Advanced Calendar/Diary customization.
+@end ifnottex
Movement in the Calendar
@@ -904,7 +955,8 @@ The Diary
* Adding to Diary:: Commands to create diary entries.
* Special Diary Entries:: Anniversaries, blocks of dates, cyclic entries, etc.
-Customizing the Calendar and Diary
+@ifnottex
+More advanced features of the Calendar and Diary
* Calendar Customizing:: Calendar layout and hooks.
* Holiday Customizing:: Defining your own holidays.
@@ -915,17 +967,11 @@ Customizing the Calendar and Diary
* Diary Display:: A choice of ways to display the diary.
* Fancy Diary Display:: Sorting diary entries, using included diary files.
* Sexp Diary Entries:: More flexible diary entries.
-
-Document Viewing
-
-* Navigation:: Navigation inside DocView buffers.
-* Searching:: Searching inside documents.
-* Slicing:: Specifying which part of pages should be displayed.
-* Conversion:: Influencing and triggering conversion.
+@end ifnottex
Sending Mail
-* Mail Format:: Format of the mail being composed.
+* Mail Format:: Format of a mail message.
* Mail Headers:: Details of some standard mail header fields.
* Mail Aliases:: Abbreviating and grouping mail addresses.
* Mail Commands:: Special commands for editing mail being composed.
@@ -966,14 +1012,22 @@ Reading Mail with Rmail
Rmail Summaries
-* Rmail Make Summary:: Making various sorts of summaries.
-* Rmail Summary Edit:: Manipulating messages from the summary.
+* Rmail Make Summary:: Making various sorts of summaries.
+* Rmail Summary Edit:: Manipulating messages from the summary.
Gnus
* Buffers of Gnus:: The group, summary, and article buffers.
* Gnus Startup:: What you should know about starting Gnus.
-* Summary of Gnus:: A short description of the basic Gnus commands.
+* Gnus Group Buffer:: A short description of Gnus group commands.
+* Gnus Summary Buffer:: A short description of Gnus summary commands.
+
+Document Viewing
+
+* DocView Navigation:: Navigating DocView buffers.
+* DocView Searching:: Searching inside documents.
+* DocView Slicing:: Specifying which part of a page is displayed.
+* DocView Conversion:: Influencing and triggering conversion.
Running Shell Commands from Emacs
@@ -986,7 +1040,6 @@ Running Shell Commands from Emacs
* Shell Options:: Options for customizing Shell mode.
* Terminal emulator:: An Emacs window as a terminal emulator.
* Term Mode:: Special Emacs commands used in Term mode.
-* Paging in Term:: Paging in the terminal emulator.
* Remote Host:: Connecting to another computer.
* Serial Terminal:: Connecting to a serial port.
@@ -1025,22 +1078,21 @@ Customization
* Variables:: Many Emacs commands examine Emacs variables
to decide what to do; by setting variables,
you can control their functioning.
-* Key Bindings:: Keymaps say what command each key runs.
+* Key Bindings:: The keymaps say what command each key runs.
By changing them, you can "redefine" keys.
* Init File:: How to write common customizations in the
- @file{.emacs} file.
+ initialization file.
Easy Customization Interface
-* Customization Groups:: How settings are classified in a structure.
+* Customization Groups:: How settings are classified.
* Browsing Custom:: Browsing and searching for settings.
* Changing a Variable:: How to edit an option's value and set the option.
-* Saving Customizations:: Specifying the file for saving customizations.
+* Saving Customizations:: Saving customizations for future Emacs sessions.
* Face Customization:: How to edit the attributes of a face.
-* Specific Customization:: Making a customization buffer for specific
- variables, faces, or groups.
-* Custom Themes:: How to define collections of customized options
- that can be loaded and unloaded together.
+* Specific Customization:: Customizing specific settings or groups.
+* Custom Themes:: Collections of customization settings.
+* Creating Custom Themes:: How to create a new custom theme.
Variables
@@ -1063,7 +1115,7 @@ Customizing Key Bindings
* Local Keymaps:: Major and minor modes have their own keymaps.
* Minibuffer Maps:: The minibuffer uses its own local keymaps.
* Rebinding:: How to redefine one key's meaning conveniently.
-* Init Rebinding:: Rebinding keys with your init file, @file{.emacs}.
+* Init Rebinding:: Rebinding keys with your initialization file.
* Modifier Keys:: Using modifier keys in key bindings.
* Function Keys:: Rebinding terminal function keys.
* Named ASCII Chars:: Distinguishing @key{TAB} from @kbd{C-i}, and so on.
@@ -1072,7 +1124,7 @@ Customizing Key Bindings
before it can be executed. This is done to protect
beginners from surprises.
-The Init File, @file{~/.emacs}
+The Emacs Initialization File
* Init Syntax:: Syntax of constants in Emacs Lisp.
* Init Examples:: How to do some things with an init file.
@@ -1087,10 +1139,9 @@ Dealing with Emacs Trouble
* Screen Garbled:: Garbage on the screen.
* Text Garbled:: Garbage in the text.
* Memory Full:: How to cope when you run out of memory.
+* Crashing:: What Emacs does when it crashes.
* After a Crash:: Recovering editing in an Emacs session that crashed.
-* Emergency Escape:: Emergency escape---
- What to do if Emacs stops responding.
-* Total Frustration:: When you are at your wits' end.
+* Emergency Escape:: What to do if Emacs stops responding.
Reporting Bugs
@@ -1106,7 +1157,6 @@ Command Line Arguments for Emacs Invocation
and call functions.
* Initial Options:: Arguments that take effect while starting Emacs.
* Command Example:: Examples of using command line arguments.
-* Resume Arguments:: Specifying arguments when you resume a running Emacs.
* Environment:: Environment variables that Emacs uses.
* Display X:: Changing the default display and using remote login.
* Font X:: Choosing a font for text, under X.
@@ -1127,15 +1177,15 @@ X Options and Resources
* Resources:: Using X resources with Emacs (in general).
* Table of Resources:: Table of specific X resources that affect Emacs.
-* Face Resources:: X resources for customizing faces.
* Lucid Resources:: X resources for Lucid menus.
* LessTif Resources:: X resources for LessTif and Motif menus.
* GTK resources:: Resources for GTK widgets.
GTK resources
-* GTK widget names:: How widgets in GTK are named in general.
-* GTK Names in Emacs:: GTK widget names in Emacs.
+* GTK Resource Basics:: Basic usage of GTK+ resources.
+* GTK Widget Names:: How GTK+ widgets are named.
+* GTK Names in Emacs:: GTK widgets used by Emacs.
* GTK styles:: What can be customized in a GTK widget.
Emacs and Mac OS / GNUstep
@@ -1151,14 +1201,16 @@ Emacs and Microsoft Windows/MS-DOS
* Text and Binary:: Text files use CRLF to terminate lines.
* Windows Files:: File-name conventions on Windows.
* ls in Lisp:: Emulation of @code{ls} for Dired.
-* Windows HOME:: Where Emacs looks for your @file{.emacs}.
+* Windows HOME:: Where Emacs looks for your @file{.emacs} and
+ where it starts up.
* Windows Keyboard:: Windows-specific keyboard features.
* Windows Mouse:: Windows-specific mouse features.
* Windows Processes:: Running subprocesses on Windows.
* Windows Printing:: How to specify the printer on MS-Windows.
* Windows Fonts:: Specifying fonts on MS-Windows.
* Windows Misc:: Miscellaneous Windows features.
-* MS-DOS:: Using Emacs on MS-DOS (otherwise known as @dfn{MS-DOG}).
+@ifnottex
+* MS-DOS:: Using Emacs on MS-DOS.
Emacs and MS-DOS
@@ -1169,6 +1221,7 @@ Emacs and MS-DOS
* MS-DOS Printing:: Printing specifics on MS-DOS.
* MS-DOS and MULE:: Support for internationalization on MS-DOS.
* MS-DOS Processes:: Running subprocesses on MS-DOS.
+@end ifnottex
@end detailmenu
@end menu
@@ -1186,7 +1239,7 @@ primer. If you are new to Emacs, we recommend you start with
the integrated, learn-by-doing tutorial, before reading the manual. To
run the tutorial, start Emacs and type @kbd{C-h t}. The tutorial
describes commands, tells you when to try them, and explains the
-results.
+results. The tutorial is available in several languages.
On first reading, just skim chapters 1 and 2, which describe the
notational conventions of the manual and the general appearance of the
@@ -1204,20 +1257,19 @@ need them.
Read the Common Problems chapter if Emacs does not seem to be
working properly. It explains how to cope with several common
-problems (@pxref{Lossage}), as well as when and how to report Emacs
-bugs (@pxref{Bugs}).
+problems (@pxref{Lossage,, Dealing with Emacs Trouble}), as well as
+when and how to report Emacs bugs (@pxref{Bugs}).
To find the documentation of a particular command, look in the index.
Keys (character commands) and command names have separate indexes.
There is also a glossary, with a cross reference for each term.
This manual is available as a printed book and also as an Info file.
-The Info file is for use with the Info program, which is the principal
-means of accessing on-line documentation in the GNU system. Both the
-Emacs Info file and an Info reader are included with GNU Emacs. The
-Info file and the printed book contain substantially the same text and
-are generated from the same source files, which are also distributed
-with GNU Emacs.
+The Info file is for reading from Emacs itself, or with the Info program.
+Info is the principal format for documentation in the GNU system.
+The Info file and the printed book contain substantially the same text
+and are generated from the same source files, which are also
+distributed with GNU Emacs.
GNU Emacs is a member of the Emacs editor family. There are many
Emacs editors, all sharing common principles of organization. For
@@ -1226,21 +1278,22 @@ learned from its development, see @cite{Emacs, the Extensible,
Customizable Self-Documenting Display Editor}, available from
@url{ftp://publications.ai.mit.edu/ai-publications/pdf/AIM-519A.pdf}.
-This edition of the manual is intended for use with GNU Emacs
+This version of the manual is mainly intended for use with GNU Emacs
installed on GNU and Unix systems. GNU Emacs can also be used on
-MS-DOS (also called MS-DOG), Microsoft Windows, and Macintosh systems.
-Those systems use different file name syntax; in addition
-MS-DOS does not support all GNU Emacs features. @xref{Microsoft
-Windows}, for information about using Emacs on Windows.
-@xref{Mac OS / GNUstep}, for information about using Emacs on
-Macintosh (and GNUstep).
+MS-DOS, Microsoft Windows, and Macintosh systems. The Info file
+version of this manual contains some more information about using
+Emacs on those systems. Those systems use different file name syntax;
+in addition MS-DOS does not support all GNU Emacs features.
+@xref{Microsoft Windows}, for information about using Emacs on
+Windows. @xref{Mac OS / GNUstep}, for information about using Emacs
+on Macintosh (and GNUstep).
@end iftex
-@node Distrib, Intro, Top, Top
+@node Distrib
@unnumbered Distribution
GNU Emacs is @dfn{free software}; this means that everyone is free to
-use it and free to redistribute it on certain conditions. GNU Emacs
+use it and free to redistribute it under certain conditions. GNU Emacs
is not in the public domain; it is copyrighted and there are
restrictions on its distribution, but these restrictions are designed
to permit everything that a good cooperating citizen would want to do.
@@ -1248,11 +1301,10 @@ What is not allowed is to try to prevent others from further sharing
any version of GNU Emacs that they might get from you. The precise
conditions are found in the GNU General Public License that comes with
Emacs and also appears in this manual@footnote{This manual is itself
-covered by the GNU Free Documentation License (see the reverse title
-page in the printed manual or view the full source for online formats
-to see the precise conditions). This license is similar in spirit to
-the General Public License, but is more suitable for documentation.
-@xref{GNU Free Documentation License}.}. @xref{Copying}.
+covered by the GNU Free Documentation License. This license is
+similar in spirit to the General Public License, but is more suitable
+for documentation. @xref{GNU Free Documentation License}.}.
+@xref{Copying}.
One way to get a copy of GNU Emacs is from someone else who has it.
You need not ask for our permission to do so, or tell any one else;
@@ -1269,14 +1321,22 @@ redistribute the GNU Emacs received from them under the usual terms of the
General Public License. In other words, the program must be free for you
when you get it, not just free for the manufacturer.
-@c FIXME no longer true?
-You can also order copies of GNU Emacs from the Free Software
-Foundation. This is a convenient and reliable way to get a copy; it is
-also a good way to help fund our work. We also sell hardcopy versions
-of this manual and @cite{An Introduction to Programming in Emacs Lisp},
-by Robert J. Chassell. You can visit our online store at
-@url{http://shop.fsf.org/}. For further information,
-write to
+If you find GNU Emacs useful, please @strong{send a donation} to the
+Free Software Foundation to support our work. Donations to the Free
+Software Foundation are tax deductible in the US. If you use GNU Emacs
+at your workplace, please suggest that the company make a donation.
+For more information on how you can help, see
+@url{http://www.gnu.org/help/help.html}.
+
+We also sell hardcopy versions of this manual and @cite{An
+Introduction to Programming in Emacs Lisp}, by Robert J.@: Chassell.
+You can visit our online store at @url{http://shop.fsf.org/}.
+The income from sales goes to support the foundation's purpose: the
+development of new free software, and improvements to our existing
+programs including GNU Emacs.
+
+If you need to contact the Free Software Foundation, see
+@url{http://www.fsf.org/about/contact/}, or write to
@display
Free Software Foundation
@@ -1285,108 +1345,115 @@ Boston, MA 02110-1301
USA
@end display
-The income from sales goes to support the foundation's purpose: the
-development of new free software, and improvements to our existing
-programs including GNU Emacs.
-
-@c FIXME you can't order a CD any more.
-If you find GNU Emacs useful, please @strong{send a donation} to the
-Free Software Foundation to support our work. Donations to the Free
-Software Foundation are tax deductible in the US. If you use GNU Emacs
-at your workplace, please suggest that the company make a donation. If
-company policy is unsympathetic to the idea of donating to charity, you
-might instead suggest ordering a CD-ROM from the Foundation
-occasionally, or subscribing to periodic updates.
-
@iftex
-@node Acknowledgments, Intro, Distrib, Top
+@node Acknowledgments
@unnumberedsec Acknowledgments
Contributors to GNU Emacs include Jari Aalto, Per Abrahamsen, Tomas
-Abrahamsson, Jay K.@: Adams, Michael Albinus, Nagy Andras, Ralf Angeli,
-Joe Arceneaux, Miles Bader, David Bakhash, Juanma Barranquero, Eli
-Barzilay, Thomas Baumann, Steven L.@: Baur, Jay Belanger, Alexander L.@:
-Belikoff, Boaz Ben-Zvi, Karl Berry, Anna M.@: Bigatti, Ray Blaak, Jim
-Blandy, Johan Bockgrd, Jan Bcker, Lennart Borgman, Per Bothner,
+Abrahamsson, Jay K.@: Adams, Alon Albert, Michael Albinus, Nagy
+Andras, Benjamin Andresen, Ralf Angeli, Dmitry Antipov, Joe Arceneaux, Emil strm,
+Miles Bader, David Bakhash, Juanma Barranquero, Eli Barzilay, Thomas
+Baumann, Steven L.@: Baur, Jay Belanger, Alexander L.@: Belikoff,
+Thomas Bellman, Scott Bender, Boaz Ben-Zvi, Sergey Berezin, Karl
+Berry, Anna M.@: Bigatti, Ray Blaak, Martin Blais, Jim Blandy, Johan
+Bockgrd, Jan Bcker, Joel Boehland, Lennart Borgman, Per Bothner,
Terrence Brannon, Frank Bresz, Peter Breton, Emmanuel Briot, Kevin
-Broadey, Vincent Broman, David M.@: Brown, Georges Brun-Cottan, Joe
-Buehler, W@l{}odek Bzyl, Bill Carpenter, Per Cederqvist, Hans Chalupsky,
-Chong Yidong, Chris Chase, Bob Chassell, Andrew Choi, Sacha Chua, James
-Clark, Mike Clarkson, Glynn Clements, Daniel Colascione, Andrew Csillag,
-Baoqiu Cui, Doug Cutting, Mathias Dahl, Julien Danjou, Satyaki Das,
-Vivek Dasmohapatra, Michael DeCorte, Gary Delp, Matthieu Devin, Eri
-Ding, Jan Djrv, Carsten Dominik, Scott Draves, Benjamin Drieu,
-Viktor Dukhovni, Dmitry Dzhus, John Eaton, Rolf Ebert, Paul Eggert,
-Stephen Eglen, Torbjrn Einarsson, Tsugutomo Enami, Hans Henrik
-Eriksen, Michael Ernst, Ata Etemadi, Frederick Farnbach, Oscar
-Figueiredo, Fred Fish, Karl Fogel, Gary Foster, Romain Francoise, Noah
-Friedman, Andreas Fuchs, Hallvard Furuseth, Keith Gabryelski, Peter S.@:
-Galbraith, Kevin Gallagher, Kevin Gallo, Juan Len Lahoz
-Garca, Howard Gayle, Daniel German, Stephen Gildea,
-Julien Gilles, David Gillespie, Bob Glickstein, Deepak Goel, Boris
-Goldowsky, Michelangelo Grigni, Odd Gripenstam, Kai Grojohann,
-Michael Gschwind, Bastien Guerry, Henry Guillaume, Doug Gwyn, Ken'ichi
-Handa, Lars Hansen, Chris Hanson, K. Shane Hartman, John Heidemann, Jon
-K.@: Hellan, Jesper Harder, Magnus Henoch, Markus Heritsch, Karl Heuer,
-Manabu Higashida, Anders Holst, Jeffrey C.@: Honig, Tassilo Horn, Kurt
-Hornik, Tom Houlder, Joakim Hove, Denis Howe, Lars Ingebrigtsen, Andrew
-Innes, Seiichiro Inoue, Philip Jackson, Pavel Janik, Paul Jarc, Ulf
-Jasper, Michael K. Johnson, Kyle Jones, Terry Jones, Simon Josefsson,
-Arne Jrgensen, Tomoji Kagatani, Brewster Kahle, Tokuya Kameshima,
-Lute Kamstra, David Kastrup, David Kaufman, Henry Kautz, Taichi
-Kawabata, Howard Kaye, Michael Kifer, Richard King, Peter Kleiweg, Karel
-Kl@v{c}, Shuhei Kobayashi, Pavel Kobiakov, Larry K.@:
-Kolodney, David M.@: Koppelman, Koseki Yoshinori, Robert Krawitz,
-Sebastian Kremer, Ryszard Kubiak, David Kgedal, Daniel LaLiberte,
-Karl Landstrom, Mario Lang, Aaron Larson, James R.@: Larus, Vinicius
-Jose Latorre, Werner Lemberg, Frederic Lepied, Peter Liljenberg, Lars
-Lindberg, Chris Lindblad, Anders Lindgren, Thomas Link, Juri Linkov,
-Francis Litterio, Emilio C. Lopes, Kroly L@H{o}rentey, Dave Love,
-Sascha Ldecke, Eric Ludlam, Alan Mackenzie, Christopher J.@:
-Madsen, Neil M.@: Mager, Ken Manheimer, Bill Mann, Brian Marick, Simon
-Marshall, Bengt Martensson, Charlie Martin, Thomas May, Roland McGrath,
-Will Mengarini, David Megginson, Ben A. Mesander, Wayne Mesard, Brad
+Broadey, Vincent Broman, Michael Brouwer, David M.@: Brown, Stefan Bruda,
+Georges Brun-Cottan, Joe Buehler, Scott Byer, W@l{}odek Bzyl,
+Bill Carpenter, Per Cederqvist, Hans Chalupsky, Chris Chase, Bob
+Chassell, Andrew Choi, Chong Yidong, Sacha Chua, Stewart Clamen, James
+Clark, Mike Clarkson, Glynn Clements, Andrew Cohen, Daniel Colascione,
+Edward O'Connor, Christoph Conrad, Ludovic Courts, Andrew Csillag,
+Toby Cubitt, Baoqiu Cui, Doug Cutting, Mathias Dahl, Julien Danjou, Satyaki
+Das, Vivek Dasmohapatra, Dan Davison, Michael DeCorte, Gary Delp, Nachum
+Dershowitz, Dave Detlefs, Matthieu Devin, Christophe de Dinechin, Eri
+Ding, Jan Djrv, Lawrence R.@: Dodd, Carsten Dominik, Scott Draves,
+Benjamin Drieu, Viktor Dukhovni, Jacques Duthen, Dmitry Dzhus, John
+Eaton, Rolf Ebert, Carl Edman, David Edmondson, Paul Eggert, Stephen
+Eglen, Christian Egli, Torbjrn Einarsson, Tsugutomo Enami, David
+Engster, Hans Henrik Eriksen, Michael Ernst, Ata Etemadi, Frederick
+Farnbach, Oscar Figueiredo, Fred Fish, Steve Fisk, Karl Fogel, Gary
+Foster, Eric S.@: Fraga, Romain Francoise, Noah Friedman, Andreas
+Fuchs, Shigeru Fukaya, Hallvard Furuseth, Keith Gabryelski, Peter S.@:
+Galbraith, Kevin Gallagher, Kevin Gallo, Juan Len Lahoz Garca,
+Howard Gayle, Daniel German, Stephen Gildea, Julien Gilles, David
+Gillespie, Bob Glickstein, Deepak Goel, David De La Harpe Golden, Boris
+Goldowsky, David Goodger, Chris Gray, Kevin Greiner, Michelangelo Grigni, Odd
+Gripenstam, Kai Grojohann, Michael Gschwind, Bastien Guerry, Henry
+Guillaume, Doug Gwyn, Bruno Haible, Ken'ichi Handa, Lars Hansen, Chris
+Hanson, Jesper Harder, Alexandru Harsanyi, K.@: Shane Hartman, John
+Heidemann, Jon K.@: Hellan, Magnus Henoch, Markus Heritsch, Dirk
+Herrmann, Karl Heuer, Manabu Higashida, Konrad Hinsen, Anders Holst,
+Jeffrey C.@: Honig, Tassilo Horn, Kurt Hornik, Tom Houlder, Joakim
+Hove, Denis Howe, Lars Ingebrigtsen, Andrew Innes, Seiichiro Inoue,
+Philip Jackson, Martyn Jago, Pavel Janik, Paul Jarc, Ulf Jasper,
+Thorsten Jolitz, Michael K.@: Johnson, Kyle Jones, Terry Jones, Simon
+Josefsson, Alexandre Julliard, Arne Jrgensen, Tomoji Kagatani,
+Brewster Kahle, Tokuya Kameshima, Lute Kamstra, Ivan Kanis, David
+Kastrup, David Kaufman, Henry Kautz, Taichi Kawabata, Taro Kawagishi,
+Howard Kaye, Michael Kifer, Richard King, Peter Kleiweg, Karel
+Kl@v{c}, Shuhei Kobayashi, Pavel Kobyakov, Larry K.@: Kolodney, David
+M.@: Koppelman, Koseki Yoshinori, Robert Krawitz, Sebastian Kremer,
+Ryszard Kubiak, Igor Kuzmin, David Kgedal, Daniel LaLiberte, Karl
+Landstrom, Mario Lang, Aaron Larson, James R.@: Larus, Vinicius Jose
+Latorre, Werner Lemberg, Frederic Lepied, Peter Liljenberg, Christian
+Limpach, Lars Lindberg, Chris Lindblad, Anders Lindgren, Thomas Link,
+Juri Linkov, Francis Litterio, Sergey Litvinov, Emilio C.@: Lopes,
+Martin Lorentzon, Dave Love, Eric Ludlam, Kroly L@H{o}rentey, Sascha
+Ldecke, Greg McGary, Roland McGrath, Michael McNamara, Alan Mackenzie,
+Christopher J.@: Madsen, Neil M.@: Mager, Ken Manheimer, Bill Mann,
+Brian Marick, Simon Marshall, Bengt Martensson, Charlie Martin,
+Yukihiro Matsumoto, Tomohiro Matsuyama, David Maus, Thomas May, Will Mengarini, David
+Megginson, Stefan Merten, Ben A.@: Mesander, Wayne Mesard, Brad
Miller, Lawrence Mitchell, Richard Mlynarik, Gerd Moellmann, Stefan
-Monnier, Morioka Tomohiko, Keith Moore, Jan Moringen, Glenn Morris,
-Diane Murray, Sen Nagata, Erik Naggum, Thomas Neumann, Thien-Thi Nguyen,
-Mike Newton, Jurgen Nickelsen, Dan Nicolaescu, Hrvoje Niksic, Jeff
-Norden, Andrew Norman, Christian Ohler, Alexandre Oliva, Bob Olson,
-Michael Olson, Takaaki Ota, Pieter E.@: J.@: Pareit, Ross Patterson,
-David Pearson, Jeff Peck, Damon Anton Permezel, Tom Perrine, William
-M.@: Perry, Per Persson, Jens Petersen, Daniel Pfeiffer, Richard L.@:
-Pieri, Fred Pierresteguy, Christian Plaunt, David Ponce, Francesco A.@:
-Potorti, Michael D. Prange, Mukesh Prasad, Ken Raeburn, Marko Rahamaa,
-Ashwin Ram, Eric S. Raymond, Paul Reilly, Edward M. Reingold, Alex
-Rezinsky, Rob Riepel, David Reitter, Adrian Robert, Nick Roberts, Roland
-B.@: Roberts, John Robinson, Danny Roozendaal, Sebastian Rose, William
-Rosenblatt, Guillermo J.@: Rozas, Martin Rudalics, Ivar Rummelhoff,
-Jason Rumney, Wolfgang Rupprecht, Kevin Ryde, James B. Salem, Masahiko
-Sato, Jorgen Schaefer, Holger Schauer, William Schelter, Ralph
-Schleicher, Gregor Schmid, Michael Schmidt, Ronald S. Schnell, Philippe
-Schnoebelen, Jan Schormann, Alex Schroeder, Stephen Schoef, Raymond
-Scholz, Eric Schulte, Andreas Schwab, Randal Schwartz, Oliver Seidel,
-Manuel Serrano, Paul Sexton, Hovav Shacham, Stanislav Shalunov, Marc
-Shapiro, Richard Sharman, Olin Shivers, Espen Skoglund, Rick Sladkey,
-Lynn Slater, Chris Smith, David Smith, Paul D.@: Smith, William
-Sommerfeld, Andre Spiegel, Michael Staats, Ulf Stegemann, Reiner Steib,
-Sam Steingold, Ake Stenhoff, Peter Stephenson, Ken Stevens, Andy Stewart,
-Jonathan Stigelman, Martin Stjernholm, Kim F.@: Storm, Steve Strassman,
-Olaf Sylvester, Naoto Takahashi, Steven Tamm, Jean-Philippe Theberge,
-Jens T.@: Berger Thielemann, Spencer Thomas, Jim Thompson, Luc
-Teirlinck, David O'Toole, Tom Tromey, Enami Tsugutomo, Eli Tziperman,
-Daiki Ueno, Masanobu Umeda, Rajesh Vaidheeswarran, Neil W.@: Van Dyke,
-Didier Verna, Joakim Verona, Ulrik Vieth, Geoffrey Voelker, Johan
-Vromans, Inge Wallin, John Paul Wallington, Colin Walters, Barry Warsaw,
-Morten Welinder, Joseph Brian Wells, Rodney Whitby, John Wiegley, Ed
-Wilkinson, Mike Williams, Bill Wohler, Steven A. Wood, Dale R.@: Worley,
-Francis J.@: Wright, Felix S. T. Wu, Tom Wurgler, Katsumi Yamaoka,
-Yamamoto Mitsuharu, Masatake Yamato, Jonathan Yavner, Ryan Yeske, Ilya
-Zakharevich, Milan Zamazal, Victor Zandy, Eli Zaretskii, Jamie Zawinski,
+Monnier, Keith Moore, Jan Moringen, Morioka Tomohiko, Glenn Morris,
+Don Morrison, Diane Murray, Riccardo Murri, Sen Nagata, Erik Naggum,
+Gergely Nagy, Nobuyoshi Nakada, Thomas Neumann, Mike Newton, Thien-Thi Nguyen,
+Jurgen Nickelsen, Dan Nicolaescu, Hrvoje Niksic, Jeff Norden,
+Andrew Norman, Kentaro Ohkouchi, Christian Ohler,
+Kenichi Okada, Alexandre Oliva, Bob Olson, Michael Olson, Takaaki Ota,
+Pieter E.@: J.@: Pareit, Ross Patterson, David Pearson, Juan Pechiar,
+Jeff Peck, Damon Anton Permezel, Tom Perrine, William M.@: Perry, Per
+Persson, Jens Petersen, Daniel Pfeiffer, Justus Piater, Richard L.@:
+Pieri, Fred Pierresteguy, Franois Pinard, Daniel Pittman, Christian
+Plaunt, Alexander Pohoyda, David Ponce, Francesco A.@: Potorti,
+Michael D.@: Prange, Mukesh Prasad, Ken Raeburn, Marko Rahamaa, Ashwin
+Ram, Eric S.@: Raymond, Paul Reilly, Edward M.@: Reingold, David
+Reitter, Alex Rezinsky, Rob Riepel, Lara Rios, Adrian Robert, Nick
+Roberts, Roland B.@: Roberts, John Robinson, Denis B.@: Roegel, Danny
+Roozendaal, Sebastian Rose, William Rosenblatt, Markus Rost, Guillermo
+J.@: Rozas, Martin Rudalics, Ivar Rummelhoff, Jason Rumney, Wolfgang
+Rupprecht, Benjamin Rutt, Kevin Ryde, James B.@: Salem, Masahiko Sato,
+Timo Savola, Jorgen Schaefer, Holger Schauer, William Schelter, Ralph
+Schleicher, Gregor Schmid, Michael Schmidt, Ronald S.@: Schnell,
+Philippe Schnoebelen, Jan Schormann, Alex Schroeder, Stefan Schoef,
+Rainer Schoepf, Raymond Scholz, Eric Schulte, Andreas Schwab, Randal
+Schwartz, Oliver Seidel, Manuel Serrano, Paul Sexton, Hovav Shacham,
+Stanislav Shalunov, Marc Shapiro, Richard Sharman, Olin Shivers, Tibor
+@v{S}imko, Espen Skoglund, Rick Sladkey, Lynn Slater, Chris Smith,
+David Smith, Paul D.@: Smith, Wilson Snyder, William Sommerfeld, Simon
+South, Andre Spiegel, Michael Staats, Thomas Steffen, Ulf Stegemann,
+Reiner Steib, Sam Steingold, Ake Stenhoff, Peter Stephenson, Ken
+Stevens, Andy Stewart, Jonathan Stigelman, Martin Stjernholm, Kim F.@:
+Storm, Steve Strassmann, Christopher Suckling, Olaf Sylvester, Naoto
+Takahashi, Steven Tamm, Luc Teirlinck, Jean-Philippe Theberge, Jens
+T.@: Berger Thielemann, Spencer Thomas, Jim Thompson, Toru Tomabechi,
+David O'Toole, Markus Triska, Tom Tromey, Enami Tsugutomo, Eli
+Tziperman, Daiki Ueno, Masanobu Umeda, Rajesh Vaidheeswarran, Neil
+W.@: Van Dyke, Didier Verna, Joakim Verona, Ulrik Vieth, Geoffrey
+Voelker, Johan Vromans, Inge Wallin, John Paul Wallington, Colin
+Walters, Barry Warsaw, Christoph Wedler, Ilja Weis, Zhang Weize,
+Morten Welinder, Joseph Brian Wells, Rodney Whitby, John Wiegley,
+Sascha Wilde, Ed Wilkinson, Mike Williams, Roland Winkler, Bill
+Wohler, Steven A.@: Wood, Dale R.@: Worley, Francis J.@: Wright, Felix
+S.@: T.@: Wu, Tom Wurgler, Yamamoto Mitsuharu, Katsumi Yamaoka,
+Masatake Yamato, Jonathan Yavner, Ryan Yeske, Ilya Zakharevich, Milan
+Zamazal, Victor Zandy, Eli Zaretskii, Jamie Zawinski, Andrew Zhilin,
Shenghuo Zhu, Piotr Zielinski, Ian T.@: Zimmermann, Reto Zimmermann,
Neal Ziring, Teodor Zlatanov, and Detlev Zundel.
@end iftex
-@node Intro, Glossary, Distrib, Top
+@node Intro
@unnumbered Introduction
You are reading about GNU Emacs, the GNU incarnation of the
@@ -1467,11 +1534,11 @@ Lisp programming.
@include custom.texi
@include trouble.texi
-@node Copying, GNU Free Documentation License, Service, Top
+@node Copying
@appendix GNU GENERAL PUBLIC LICENSE
@include gpl.texi
-@node GNU Free Documentation License, Emacs Invocation, Copying, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
@@ -1491,43 +1558,26 @@ Lisp programming.
@c The Option Index is produced only in the on-line version,
@c because the index entries related to command-line options
@c tend to point to the same pages and all begin with a dash.
-@c This, and the need to keep the node links consistent, are
-@c the reasons for the funky @iftex/@ifnottex dance below.
-@c The Option Index is _not_ before Key Index, because that
-@c would require changes in the glossary.texi's @node line.
-@c It is not after Concept Index for similar reasons.
-@iftex
-@node Key Index, Command Index, Glossary, Top
+@node Key Index
@unnumbered Key (Character) Index
@printindex ky
-@end iftex
@ifnottex
-@node Key Index, Option Index, Glossary, Top
-@unnumbered Key (Character) Index
-@printindex ky
-
-@node Option Index, Command Index, Key Index, Top
+@node Option Index
@unnumbered Command-Line Options Index
@printindex op
-
-@node Command Index, Variable Index, Option Index, Top
-@unnumbered Command and Function Index
-@printindex fn
@end ifnottex
-@iftex
-@node Command Index, Variable Index, Key Index, Top
+@node Command Index
@unnumbered Command and Function Index
@printindex fn
-@end iftex
-@node Variable Index, Concept Index, Command Index, Top
+@node Variable Index
@unnumbered Variable Index
@printindex vr
-@node Concept Index, Acknowledgments, Variable Index, Top
+@node Concept Index
@unnumbered Concept Index
@printindex cp
diff --git a/doc/emacs/emacsver.texi b/doc/emacs/emacsver.texi
index cb3f3f39778..408d6612d58 100644
--- a/doc/emacs/emacsver.texi
+++ b/doc/emacs/emacsver.texi
@@ -1,4 +1,4 @@
@c It would be nicer to generate this using configure and @version@.
@c However, that would mean emacsver.texi would always be newer
@c then the info files in release tarfiles.
-@set EMACSVER 24.0.92
+@set EMACSVER 24.3.50
diff --git a/doc/emacs/emerge-xtra.texi b/doc/emacs/emerge-xtra.texi
index b46868cf52b..552580ef851 100644
--- a/doc/emacs/emerge-xtra.texi
+++ b/doc/emacs/emerge-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2004-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
@@ -19,7 +19,7 @@ easier. For other ways to compare files, see
@ifnottex
@ref{Comparing Files},
@end ifnottex
-and @ref{Top, Ediff,, ediff, The Ediff Manual}.
+and @ref{Top,, Ediff, ediff, The Ediff Manual}.
@menu
* Overview of Emerge:: How to start Emerge. Basic concepts.
@@ -151,17 +151,17 @@ input. The mode line indicates Auto Advance mode with @samp{A}.
If Skip Prefers mode is in effect, the @kbd{n} and @kbd{p} commands
skip over differences in states ``prefer-A'' and ``prefer-B''
(@pxref{State of Difference}). Thus you see only differences for
-which neither version is presumed ``correct.'' The mode line
+which neither version is presumed ``correct''. The mode line
indicates Skip Prefers mode with @samp{S}. This mode is only relevant
when there is an ancestor.
-@findex emerge-auto-advance-mode
-@findex emerge-skip-prefers-mode
- Use the command @kbd{s a} (@code{emerge-auto-advance-mode}) to set or
-clear Auto Advance mode. Use @kbd{s s}
-(@code{emerge-skip-prefers-mode}) to set or clear Skip Prefers mode.
-These commands turn on the mode with a positive argument, turn it off
-with a negative or zero argument, and toggle the mode with no argument.
+@findex emerge-auto-advance
+@findex emerge-skip-prefers
+ Use the command @kbd{s a} (@code{emerge-auto-advance}) to set or clear
+Auto Advance mode. Use @kbd{s s} (@code{emerge-skip-prefers}) to set or
+clear Skip Prefers mode. These commands turn on the mode with a
+positive argument, turn it off with a negative or zero argument, and
+toggle the mode with no argument.
@node State of Difference
@subsection State of a Difference
@@ -362,9 +362,9 @@ like this:
@example
@group
#ifdef NEW
-@var{version from A buffer}
-#else /* not NEW */
@var{version from B buffer}
+#else /* not NEW */
+@var{version from A buffer}
#endif /* not NEW */
@end group
@end example
@@ -380,7 +380,7 @@ produces the results shown above, looks like this:
@example
@group
-"#ifdef NEW\n%a#else /* not NEW */\n%b#endif /* not NEW */\n"
+"#ifdef NEW\n%b#else /* not NEW */\n%a#endif /* not NEW */\n"
@end group
@end example
diff --git a/doc/emacs/entering.texi b/doc/emacs/entering.texi
index 4a76f206aed..224ab356d08 100644
--- a/doc/emacs/entering.texi
+++ b/doc/emacs/entering.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 2001-2011
+@c Copyright (C) 1985-1987, 1993-1995, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@iftex
@@ -12,7 +12,7 @@
@raisesections
@end ifnottex
-@node Entering Emacs, Exiting, Commands, Top
+@node Entering Emacs
@section Entering Emacs
@cindex entering Emacs
@cindex starting Emacs
@@ -63,7 +63,7 @@ certain Lisp files, where to put the initial frame, and so forth.
If the variable @code{inhibit-startup-screen} is non-@code{nil},
Emacs does not display the startup screen. In that case, if one or
more files were specified on the command line, Emacs simply displays
-those files; otherwise, it displays a buffer named @samp{*scratch*},
+those files; otherwise, it displays a buffer named @file{*scratch*},
which can be used to evaluate Emacs Lisp expressions interactively.
@xref{Lisp Interaction}. You can set the variable
@code{inhibit-startup-screen} using the Customize facility
@@ -77,11 +77,10 @@ information about @file{site-start.el}.}
by setting the variable @code{initial-buffer-choice} to a
non-@code{nil} value. (In that case, even if you specify one or more
files on the command line, Emacs opens but does not display them.)
-The value of @code{initial-buffer-choice} can be either the name of
-the desired file or directory, or @code{t}, which means to display the
-@samp{*scratch*} buffer.
+The value of @code{initial-buffer-choice} should be the name of
+the desired file or directory.
-@node Exiting, Basic, Entering Emacs, Top
+@node Exiting
@section Exiting Emacs
@cindex exiting
@cindex killing Emacs
@@ -144,14 +143,14 @@ stopping the program temporarily and returning control to the parent
process (usually a shell); in most shells, you can resume Emacs after
suspending it with the shell command @command{%emacs}.
- Text-only terminals usually listen for certain special characters
-whose meaning is to kill or suspend the program you are running.
-@b{This terminal feature is turned off while you are in Emacs.} The
-meanings of @kbd{C-z} and @kbd{C-x C-c} as keys in Emacs were inspired
-by the use of @kbd{C-z} and @kbd{C-c} on several operating systems as
-the characters for stopping or killing a program, but that is their
-only relationship with the operating system. You can customize these
-keys to run any commands of your choice (@pxref{Keymaps}).
+ Text terminals usually listen for certain special characters whose
+meaning is to kill or suspend the program you are running. @b{This
+terminal feature is turned off while you are in Emacs.} The meanings
+of @kbd{C-z} and @kbd{C-x C-c} as keys in Emacs were inspired by the
+use of @kbd{C-z} and @kbd{C-c} on several operating systems as the
+characters for stopping or killing a program, but that is their only
+relationship with the operating system. You can customize these keys
+to run any commands of your choice (@pxref{Keymaps}).
@ifnottex
@lowersections
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 9b2322e1850..8b609891caf 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Files, Buffers, Keyboard Macros, Top
+@node Files
@chapter File Handling
@cindex files
@@ -36,7 +36,7 @@ on file directories.
* Misc File Ops:: Other things you can do on files.
* Compressed Files:: Accessing compressed files.
* File Archives:: Operating on tar, zip, jar etc. archive files.
-* Remote Files:: Accessing files on other sites.
+* Remote Files:: Accessing files on other machines.
* Quoted File Names:: Quoting special characters in file names.
* File Name Cache:: Completion against a list of files you often use.
* File Conveniences:: Convenience Features for Finding Files.
@@ -97,7 +97,7 @@ minibuffer, with a directory omitted, specifies the file
When typing a file name into the minibuffer, you can make use of a
couple of shortcuts: a double slash is interpreted as ``ignore
-everything before the second slash in the pair,'' and @samp{~/} is
+everything before the second slash in the pair'', and @samp{~/} is
interpreted as your home directory. @xref{Minibuffer File}.
@cindex environment variables in file names
@@ -246,7 +246,7 @@ Archives}, for more about these features.
or that is marked read-only, Emacs makes the buffer read-only too, so
that you won't go ahead and make changes that you'll have trouble
saving afterward. You can make the buffer writable with @kbd{C-x C-q}
-(@code{toggle-read-only}). @xref{Misc Buffer}.
+(@code{read-only-mode}). @xref{Misc Buffer}.
@kindex C-x C-r
@findex find-file-read-only
@@ -288,7 +288,7 @@ see @ref{Drag and Drop}, and @ref{Misc Dired Features}.
Each time you visit a file, Emacs automatically scans its contents
to detect what character encoding and end-of-line convention it uses,
-and converts these to Emacs' internal encoding and end-of-line
+and converts these to Emacs's internal encoding and end-of-line
convention within the buffer. When you save the buffer, Emacs
performs the inverse conversion, writing the file to disk with its
original encoding and end-of-line convention. @xref{Coding Systems}.
@@ -739,6 +739,11 @@ directory.) Emacs removes the lock when you save the changes. The
idea is that the file is locked whenever an Emacs buffer visiting it
has unsaved changes.
+@vindex create-lockfiles
+ You can prevent the creation of lock files by setting the variable
+@code{create-lockfiles} to @code{nil}. @strong{Caution:} by
+doing so you will lose the benefits that this feature provides.
+
@cindex collision
If you begin to modify the buffer while the visited file is locked by
someone else, this constitutes a @dfn{collision}. When Emacs detects a
@@ -976,7 +981,7 @@ are not visiting files are auto-saved only if you request it explicitly;
when they are auto-saved, the auto-save file name is made by appending
@samp{#} to the front and rear of buffer name, then
adding digits and letters at the end for uniqueness. For
-example, the @samp{*mail*} buffer in which you compose messages to be
+example, the @file{*mail*} buffer in which you compose messages to be
sent might be auto-saved in a file named @file{#*mail*#704juu}. Auto-save file
names are made this way unless you reprogram parts of Emacs to do
something different (the functions @code{make-auto-save-file-name} and
@@ -1096,11 +1101,11 @@ recover are present in Emacs buffers. You should then save them. Only
this---saving them---updates the files themselves.
@vindex auto-save-list-file-prefix
- Emacs records information about interrupted sessions for later
-recovery in files named @file{.saves-@var{pid}-@var{hostname}} in the
-directory @file{~/.emacs.d/auto-save-list/}. This directory is
-determined by the variable @code{auto-save-list-file-prefix}. If you
-set @code{auto-save-list-file-prefix} to @code{nil}, sessions are not
+ Emacs records information about interrupted sessions in files named
+@file{.saves-@var{pid}-@var{hostname}} in the directory
+@file{~/.emacs.d/auto-save-list/}. This directory is determined by
+the variable @code{auto-save-list-file-prefix}. If you set
+@code{auto-save-list-file-prefix} to @code{nil}, sessions are not
recorded for recovery.
@node File Aliases
@@ -1245,7 +1250,7 @@ for more information about using the Trash.
@vindex diff-switches
The command @kbd{M-x diff} prompts for two file names, using the
minibuffer, and displays the differences between the two files in a
-buffer named @samp{*diff*}. This works by running the @command{diff}
+buffer named @file{*diff*}. This works by running the @command{diff}
program, using options taken from the variable @code{diff-switches}.
The value of @code{diff-switches} should be a string; the default is
@code{"-c"} to specify a context diff. @xref{Top,, Diff, diff,
@@ -1336,11 +1341,11 @@ contents of the hunk.
You can edit a Diff mode buffer like any other buffer. (If it is
read-only, you need to make it writable first. @xref{Misc Buffer}.)
Whenever you change a hunk, Diff mode attempts to automatically
-correct the line numbers in the hunk headers, to ensure that the diff
+correct the line numbers in the hunk headers, to ensure that the patch
remains ``correct''. To disable automatic line number correction,
change the variable @code{diff-update-on-the-fly} to @code{nil}.
- Diff mode treats each hunk as an ``error message,'' similar to
+ Diff mode treats each hunk as an ``error message'', similar to
Compilation mode. Thus, you can use commands such as @kbd{C-x '} to
visit the corresponding source locations. @xref{Compilation Mode}.
@@ -1352,9 +1357,25 @@ manipulate and apply parts of patches:
@findex diff-hunk-next
Move to the next hunk-start (@code{diff-hunk-next}).
+@findex diff-auto-refine-mode
+@cindex mode, Diff Auto-Refine
+@cindex Diff Auto-Refine mode
+This command has a side effect: it @dfn{refines} the hunk you move to,
+highlighting its changes with better granularity. To disable this
+feature, type @kbd{M-x diff-auto-refine-mode} to toggle off the minor
+mode Diff Auto-Refine mode. To disable Diff Auto Refine mode by
+default, add this to your init file (@pxref{Hooks}):
+
+@example
+(add-hook 'diff-mode-hook
+ (lambda () (diff-auto-refine-mode -1)))
+@end example
+
@item M-p
@findex diff-hunk-prev
-Move to the previous hunk-start (@code{diff-hunk-prev}).
+Move to the previous hunk-start (@code{diff-hunk-prev}). Like
+@kbd{M-n}, this has the side-effect of refining the hunk you move to,
+unless you disable Diff Auto-Refine mode.
@item M-@}
@findex diff-file-next
@@ -1447,13 +1468,24 @@ descriptions of the changes. @kbd{C-x 4 a} itself in Diff mode
operates on behalf of the current hunk's file, but gets the function
name from the patch itself. This is useful for making log entries for
functions that are deleted by the patch.
-
-@item M-x diff-show-trailing-whitespaces RET
-@findex diff-show-trailing-whitespaces
-Highlight trailing whitespace characters, except for those used by the
-patch syntax (@pxref{Useless Whitespace}).
@end table
+@c Trailing whitespace is NOT shown by default.
+@c Emacs's dir-locals file enables this (for some reason).
+@cindex trailing whitespace, in patches
+@findex diff-delete-trailing-whitespace
+ Patches sometimes include trailing whitespace on modified lines, as
+an unintentional and undesired change. There are two ways to deal
+with this problem. Firstly, if you enable Whitespace mode in a Diff
+buffer (@pxref{Useless Whitespace}), it automatically highlights
+trailing whitespace in modified lines. Secondly, you can use the
+command @kbd{M-x diff-delete-trailing-whitespace}, which searches for
+trailing whitespace in the lines modified by the patch, and removes
+that whitespace in both the patch and the patched source file(s).
+This command does not save the modifications that it makes, so you can
+decide whether to save the changes (the list of modified files is
+displayed in the echo area). With a prefix argument, it tries to
+modify the original source files rather than the patched source files.
@node Misc File Ops
@section Miscellaneous File Operations
@@ -1543,9 +1575,8 @@ open file @var{linkname} will refer to whatever file is named
@var{target} at the time the opening is done, or will get an error if
the name @var{target} is nonexistent at that time. This command does
not expand the argument @var{target}, so that it allows you to specify
-a relative name as the target of the link. Not all systems support
-symbolic links; on systems that don't support them, this command is
-not defined.
+a relative name as the target of the link. On MS-Windows, this
+command works only on MS Windows Vista and later.
@kindex C-x i
@findex insert-file
@@ -1837,7 +1868,7 @@ When typing a file name in the minibuffer, @kbd{C-@key{tab}}
(@code{file-cache-minibuffer-complete}) completes it using the file
name cache. If you repeat @kbd{C-@key{tab}}, that cycles through the
possible completions of what you had originally typed. (However, note
-that the @kbd{C-@key{tab}} character cannot be typed on most text-only
+that the @kbd{C-@key{tab}} character cannot be typed on most text
terminals.)
The file name cache does not fill up automatically. Instead, you
@@ -1855,10 +1886,9 @@ Add each file name in @var{directory} and all of its nested
subdirectories to the file name cache, using @command{locate} to find
them all.
@item M-x file-cache-add-directory-list @key{RET} @var{variable} @key{RET}
-Add each file name in each directory listed in @var{variable}
-to the file name cache. @var{variable} should be a Lisp variable
-such as @code{load-path} or @code{exec-path}, whose value is a list
-of directory names.
+Add each file name in each directory listed in @var{variable} to the
+file name cache. @var{variable} should be a Lisp variable whose value
+is a list of directory names, like @code{load-path}.
@item M-x file-cache-clear-cache @key{RET}
Clear the cache; that is, remove all file names from it.
@end table
@@ -1892,20 +1922,46 @@ point. Partial Completion mode offers other features extending
@findex image-mode
@findex image-toggle-display
+@findex image-toggle-animation
@cindex images, viewing
- Visiting image files automatically selects Image mode. This major
-mode allows you to toggle between displaying the file as an image in
-the Emacs buffer, and displaying its underlying text representation,
-using the command @kbd{C-c C-c} (@code{image-toggle-display}). This
-works only when Emacs can display the specific image type. If the
-displayed image is wider or taller than the frame, the usual point
-motion keys (@kbd{C-f}, @kbd{C-p}, and so forth) cause different parts
-of the image to be displayed.
+@cindex image animation
+@cindex animated images
+ Visiting image files automatically selects Image mode. In this
+major mode, you can type @kbd{C-c C-c} (@code{image-toggle-display})
+to toggle between displaying the file as an image in the Emacs buffer,
+and displaying its underlying text (or raw byte) representation.
+Displaying the file as an image works only if Emacs is compiled with
+support for displaying such images. If the displayed image is wider
+or taller than the frame, the usual point motion keys (@kbd{C-f},
+@kbd{C-p}, and so forth) cause different parts of the image to be
+displayed. If the image can be animated, the command @kbd{RET}
+(@code{image-toggle-animation}) starts or stops the animation.
+Animation plays once, unless the option @code{image-animate-loop} is
+non-@code{nil}. Currently, Emacs only supports animation in GIF
+files.
+
+@cindex ImageMagick support
+@vindex imagemagick-enabled-types
+@vindex imagemagick-types-inhibit
+ If Emacs was compiled with support for the ImageMagick library, it
+can use ImageMagick to render a wide variety of images. The variable
+@code{imagemagick-enabled-types} lists the image types that Emacs may
+render using ImageMagick; each element in the list should be an
+internal ImageMagick name for an image type, as a symbol or an
+equivalent string (e.g.@: @code{BMP} for @file{.bmp} images). To
+enable ImageMagick for all possible image types, change
+@code{imagemagick-enabled-types} to @code{t}. The variable
+@code{imagemagick-types-inhibit} lists the image types which should
+never be rendered using ImageMagick, regardless of the value of
+@code{imagemagick-enabled-types} (the default list includes types like
+@code{C} and @code{HTML}, which ImageMagick can render as an ``image''
+but Emacs should not). To disable ImageMagick entirely, change
+@code{imagemagick-types-inhibit} to @code{t}.
@findex thumbs-mode
@findex mode, thumbs
- See also the Image-Dired package (@pxref{Image-Dired}) for viewing
-images as thumbnails.
+ The Image-Dired package can also be used to view images as
+thumbnails. @xref{Image-Dired}.
@node Filesets
@section Filesets
@@ -1921,20 +1977,20 @@ adds a @samp{Filesets} menu to the menu bar.
@findex filesets-add-buffer
@findex filesets-remove-buffer
- The simplest way to define a fileset is by adding files to it one
-at a time. To add a file to fileset @var{name}, visit the file and
-type @kbd{M-x filesets-add-buffer @kbd{RET} @var{name} @kbd{RET}}. If
+ The simplest way to define a fileset is by adding files to it one at
+a time. To add a file to fileset @var{name}, visit the file and type
+@kbd{M-x filesets-add-buffer @kbd{RET} @var{name} @kbd{RET}}. If
there is no fileset @var{name}, this creates a new one, which
-initially creates only the current file. The command @kbd{M-x
+initially contains only the current file. The command @kbd{M-x
filesets-remove-buffer} removes the current file from a fileset.
You can also edit the list of filesets directly, with @kbd{M-x
filesets-edit} (or by choosing @samp{Edit Filesets} from the
@samp{Filesets} menu). The editing is performed in a Customize buffer
-(@pxref{Easy Customization}). Filesets need not be a simple list of
-files---you can also define filesets using regular expression matching
-file names. Some examples of these more complicated filesets are
-shown in the Customize buffer. Remember to select @samp{Save for
+(@pxref{Easy Customization}). Normally, a fileset is a simple list of
+files, but you can also define a fileset as a regular expression
+matching file names. Some examples of these more complicated filesets
+are shown in the Customize buffer. Remember to select @samp{Save for
future sessions} if you want to use the same filesets in future Emacs
sessions.
diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi
index bae78d94744..b9199eba553 100644
--- a/doc/emacs/fixit.texi
+++ b/doc/emacs/fixit.texi
@@ -1,16 +1,16 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Fixit, Keyboard Macros, Search, Top
+@node Fixit
@chapter Commands for Fixing Typos
@cindex typos, fixing
@cindex mistakes, correcting
In this chapter we describe commands that are useful when you catch
-a mistake while editing. The most fundamental command for correcting
-erroneous editing is the undo command @kbd{C-/} (which is also bound
-to @kbd{C-x u} and @kbd{C-_}). This undoes a single command, or a
+a mistake while editing. The most fundamental of these commands is
+the undo command @kbd{C-/} (also bound to @kbd{C-x u} and @kbd{C-_}).
+This undoes a single command, or a
part of a command (as in the case of @code{query-replace}), or several
consecutive character insertions. Consecutive repetitions of
@kbd{C-/} undo earlier and earlier changes, back to the limit of the
@@ -35,7 +35,7 @@ These were described earlier in this manual. @xref{Erasing}.
The @dfn{undo} command reverses recent changes in the buffer's text.
Each buffer records changes individually, and the undo command always
applies to the current buffer. You can undo all the changes in a
-buffer for as far as back its records go. Usually, each editing
+buffer for as far back as the buffer's records go. Usually, each editing
command makes a separate entry in the undo records, but some commands
such as @code{query-replace} divide their changes into multiple
entries for flexibility in undoing. Consecutive character insertion
@@ -57,10 +57,9 @@ Undo one entry in the current buffer's undo records (@code{undo}).
@kbd{C-x u})@footnote{Aside from @kbd{C-/}, the @code{undo} command is
also bound to @kbd{C-x u} because that is more straightforward for
beginners to remember: @samp{u} stands for ``undo''. It is also bound
-to @kbd{C-_} because typing @kbd{C-/} on some text-only terminals
-actually enters @kbd{C-_}.}. This undoes the most recent change in
-the buffer, and moves point back to where it was before that change.
-
+to @kbd{C-_} because typing @kbd{C-/} on some text terminals actually
+enters @kbd{C-_}.}. This undoes the most recent change in the buffer,
+and moves point back to where it was before that change.
Consecutive repetitions of @kbd{C-/} (or its aliases) undo earlier
and earlier changes in the current buffer. If all the recorded
changes have already been undone, the undo command signals an error.
@@ -75,7 +74,7 @@ changes you have undone, type @kbd{C-f} or any other command that
harmlessly breaks the sequence of undoing; then type @kbd{C-/} to undo
the undo command.
- On the other hand, if you want to resume undoing, without redoing
+ Alternatively, if you want to resume undoing, without redoing
previous undo commands, use @kbd{M-x undo-only}. This is like
@code{undo}, but will not redo changes you have just undone.
@@ -110,9 +109,9 @@ Emacs to hold text that users don't normally look at or edit.
@vindex undo-strong-limit
@vindex undo-outer-limit
@cindex undo limit
- When the undo records for a buffer becomes too large, Emacs discards
-the oldest undo records from time to time (during @dfn{garbage
-collection}). You can specify how much undo records to keep by
+ When the undo information for a buffer becomes too large, Emacs discards
+the oldest records from time to time (during @dfn{garbage
+collection}). You can specify how much undo information to keep by
setting the variables @code{undo-limit}, @code{undo-strong-limit}, and
@code{undo-outer-limit}. Their values are expressed in bytes.
@@ -356,7 +355,7 @@ Show the list of options.
In Text mode and related modes, @kbd{M-@key{TAB}}
(@code{ispell-complete-word}) performs in-buffer completion based on
spelling correction. Insert the beginning of a word, and then type
-@kbd{M-@key{TAB}}; this shows shows a list of completions. (If your
+@kbd{M-@key{TAB}}; this shows a list of completions. (If your
window manager intercepts @kbd{M-@key{TAB}}, type @kbd{@key{ESC}
@key{TAB}} or @kbd{C-M-i}.) Each completion is listed with a digit or
character; type that digit or character to choose it.
diff --git a/doc/emacs/fortran-xtra.texi b/doc/emacs/fortran-xtra.texi
index e5853a17dd0..43e2e63863e 100644
--- a/doc/emacs/fortran-xtra.texi
+++ b/doc/emacs/fortran-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2004-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
@@ -22,7 +22,7 @@ extensions @samp{.f90}, @samp{.f95}, @samp{.f03} and @samp{.f08}.
Customize @code{auto-mode-alist} to add more extensions. GNU Fortran
supports both free and fixed form. This manual mainly documents Fortran
mode, but the corresponding F90 mode features are mentioned when
-revelant.
+relevant.
Fortran mode provides special motion commands for Fortran statements
and subprograms, and indentation commands that understand Fortran
@@ -70,11 +70,10 @@ command runs the hook @code{fortran-mode-hook}.
@subsection Motion Commands
In addition to the normal commands for moving by and operating on
-``defuns'' (Fortran subprograms---functions and subroutines, using the
-commands @code{fortran-beginning-of-subprogram} and
-@code{fortran-end-of-subprogram}; as well as modules for F90 mode),
-Fortran mode provides special commands to move by statements and other
-program units.
+``defuns'' (Fortran subprograms---functions and subroutines, as well
+as modules for F90 mode, using the commands @code{fortran-end-of-subprogram}
+and @code{fortran-beginning-of-subprogram}), Fortran mode provides
+special commands to move by statements and other program units.
@table @kbd
@kindex C-c C-n @r{(Fortran mode)}
@@ -97,16 +96,15 @@ statement in the buffer), move to the start of the buffer.
@findex f90-next-block
@item C-c C-e
Move point forward to the start of the next code block, or the end of
-the current block, whichever is encountered first.
-(@code{f90-next-block}). A code block is a subroutine,
-@code{if}--@code{endif} statement, and so forth. This command exists
-for F90 mode only, not Fortran mode. With a numeric argument, this
-moves forward that many blocks.
+the current one, whichever comes first (@code{f90-next-block}).
+A code block is a subroutine, @code{if}--@code{endif} statement, and
+so forth. This command exists for F90 mode only, not Fortran mode.
+With a numeric argument, it moves forward that many blocks.
@kindex C-c C-a @r{(F90 mode)}
@findex f90-previous-block
@item C-c C-a
-Move point backward to the previous code block
+Move point backward to the previous block
(@code{f90-previous-block}). This is like @code{f90-next-block}, but
moves backwards.
@@ -163,7 +161,7 @@ Break the current line at point and set up a continuation line
@item M-^
Join this line to the previous line (@code{fortran-join-line}).
@item C-M-q
-Indent all the lines of the subprogram point is in
+Indent all the lines of the subprogram that point is in
(@code{fortran-indent-subprogram}).
@item M-q
Fill a comment block or statement (using @code{fortran-fill-paragraph}
@@ -209,7 +207,7 @@ the Fortran standard counts from 1.) The variable
@code{fortran-continuation-string} specifies what character to put in
column 5. A line that starts with a tab character followed by any digit
except @samp{0} is also a continuation line. We call this style of
-continuation @dfn{tab format}. (Fortran 90 introduced ``free form,''
+continuation @dfn{tab format}. (Fortran 90 introduced ``free form'',
with another style of continuation lines).
@vindex indent-tabs-mode @r{(Fortran mode)}
@@ -239,17 +237,17 @@ to the continuation style.
The setting of continuation style affects several other aspects of
editing in Fortran mode. In fixed form mode, the minimum column
number for the body of a statement is 6. Lines inside of Fortran
-blocks that are indented to larger column numbers always use only the
+blocks that are indented to larger column numbers must use only the
space character for whitespace. In tab format mode, the minimum
column number for the statement body is 8, and the whitespace before
-column 8 must always consist of one tab character.
+column 8 must consist of one tab character.
@node ForIndent Num
@subsubsection Line Numbers
If a number is the first non-whitespace in the line, Fortran
indentation assumes it is a line number and moves it to columns 0
-through 4. (Columns always count from 0 in GNU Emacs.)
+through 4. (Columns always count from 0 in Emacs.)
@vindex fortran-line-number-indent
Line numbers of four digits or less are normally indented one space.
@@ -329,7 +327,7 @@ non-@code{nil} value, indenting any numbered statement must check for a
@samp{do} that ends there. If you always end @samp{do} statements with
a @samp{continue} line (or if you use the more modern @samp{enddo}),
then you can speed up indentation by setting this variable to
-@code{nil}. The default is @code{nil}.
+@code{nil} (the default).
@item fortran-blink-matching-if
If this is @code{t}, indenting an @samp{endif} (or @samp{enddo}
@@ -338,17 +336,17 @@ statement moves the cursor momentarily to the matching @samp{if} (or
@item fortran-minimum-statement-indent-fixed
Minimum indentation for Fortran statements when using fixed form
-continuation line style. Statement bodies are never indented less than
-this much. The default is 6.
+continuation line style. Statement bodies are never indented by less than
+this. The default is 6.
@item fortran-minimum-statement-indent-tab
Minimum indentation for Fortran statements for tab format continuation line
-style. Statement bodies are never indented less than this much. The
+style. Statement bodies are never indented by less than this. The
default is 8.
@end table
-The variables controlling the indentation of comments are described in
-the following section.
+The following section describes the variables controlling the
+indentation of comments.
@node Fortran Comments
@subsection Fortran Comments
@@ -364,7 +362,7 @@ comments start with @samp{!} and can follow other text. Because only
some Fortran 77 compilers accept this syntax, Fortran mode will not
insert such comments unless you have said in advance to do so. To do
this, set the variable @code{fortran-comment-line-start} to @samp{"!"}.
-If you use an unusual value, you may also need to adjust
+If you use an unusual value, you may need to change
@code{fortran-comment-line-start-skip}.
@@ -373,7 +371,7 @@ If you use an unusual value, you may also need to adjust
Align comment or insert new comment (@code{comment-dwim}).
@item C-x ;
-Applies to nonstandard @samp{!} comments only.
+Applies to nonstandard @samp{!} comments only (@code{comment-set-column}).
@item C-c ;
Turn all lines of the region into comments, or (with argument) turn them back
@@ -406,10 +404,10 @@ Align the text at a fixed column, which is the sum of
@code{fortran-comment-line-extra-indent} and the minimum statement
indentation. This is the default.
-The minimum statement indentation is
-@code{fortran-minimum-statement-indent-fixed} for fixed form
-continuation line style and @code{fortran-minimum-statement-indent-tab}
-for tab format style.
+The minimum indentation is
+@code{fortran-minimum-statement-indent-tab} for tab format
+continuation line style and @code{fortran-minimum-statement-indent-fixed}
+for fixed form style.
@item relative
Align the text as if it were a line of code, but with an additional
@@ -434,17 +432,17 @@ never be indented at all, no matter what the value of
lines are directives. Matching lines are never indented, and receive
distinctive font-locking.
- The normal Emacs comment command @kbd{C-x ;} has not been redefined. If
-you use @samp{!} comments, this command can be used with them. Otherwise
-it is useless in Fortran mode.
+ The normal Emacs comment command @kbd{C-x ;} (@code{comment-set-column})
+has not been redefined. If you use @samp{!} comments, this command
+can be used with them. Otherwise it is useless in Fortran mode.
@kindex C-c ; @r{(Fortran mode)}
@findex fortran-comment-region
@vindex fortran-comment-region
The command @kbd{C-c ;} (@code{fortran-comment-region}) turns all the
-lines of the region into comments by inserting the string @samp{C$$$} at
+lines of the region into comments by inserting the string @samp{c$$$} at
the front of each one. With a numeric argument, it turns the region
-back into live code by deleting @samp{C$$$} from the front of each line
+back into live code by deleting @samp{c$$$} from the front of each line
in it. The string used for these comments can be controlled by setting
the variable @code{fortran-comment-region}. Note that here we have an
example of a command and a variable with the same name; these two uses
@@ -507,8 +505,7 @@ Display a ``column ruler'' momentarily above the current line
Split the current window horizontally temporarily so that it is
@code{fortran-line-length} columns wide
(@code{fortran-window-create-momentarily}). This may help you avoid
-making lines longer than the character limit imposed by your Fortran
-compiler.
+making lines longer than the limit imposed by your Fortran compiler.
@item C-u C-c C-w
Split the current window horizontally so that it is
@code{fortran-line-length} columns wide (@code{fortran-window-create}).
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index dec5aa771ea..0ce5c64c0eb 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Frames, International, Windows, Top
+@node Frames
@chapter Frames and Graphical Displays
@cindex frames
@@ -27,13 +27,12 @@ displays (@pxref{Exiting}). To close just the selected frame, type
This chapter describes Emacs features specific to graphical displays
(particularly mouse commands), and features for managing multiple
-frames. On text-only terminals, many of these features are
-unavailable. However, it is still possible to create multiple
-``frames'' on text-only terminals; such frames are displayed one at a
-time, filling the entire terminal screen (@pxref{Non-Window
-Terminals}). It is also possible to use the mouse on some text-only
-terminals (@pxref{Text-Only Mouse}, for doing so on GNU and Unix
-systems; and
+frames. On text terminals, many of these features are unavailable.
+However, it is still possible to create multiple ``frames'' on text
+terminals; such frames are displayed one at a time, filling the entire
+terminal screen (@pxref{Non-Window Terminals}). It is also possible
+to use the mouse on some text terminals (@pxref{Text-Only Mouse}, for
+doing so on GNU and Unix systems; and
@iftex
@pxref{MS-DOS Mouse,,,emacs-xtra,Specialized Emacs Features},
@end iftex
@@ -52,7 +51,7 @@ for doing so on MS-DOS).
* Frame Commands:: Iconifying, deleting, and switching frames.
* Fonts:: Changing the frame font.
* Speedbar:: How to make and use a speedbar frame.
-* Multiple Displays:: How one Emacs job can talk to several displays.
+* Multiple Displays:: How one Emacs instance can talk to several displays.
* Frame Parameters:: Changing the colors and other modes of frames.
* Scroll Bars:: How to enable and disable scroll bars; how to use them.
* Drag and Drop:: Using drag and drop to open files and insert text.
@@ -62,12 +61,13 @@ for doing so on MS-DOS).
* Tooltips:: Displaying information at the current mouse position.
* Mouse Avoidance:: Preventing the mouse pointer from obscuring text.
* Non-Window Terminals:: Multiple frames on terminals that show only one.
-* Text-Only Mouse:: Using the mouse in text-only terminals.
+* Text-Only Mouse:: Using the mouse in text terminals.
@end menu
@node Mouse Commands
@section Mouse Commands for Editing
@cindex mouse buttons (what they do)
+@cindex mouse, selecting text using
@kindex Mouse-1
@kindex Mouse-2
@@ -81,8 +81,8 @@ Activate the region around the text selected by dragging, and copy it
to the kill ring (@code{mouse-set-region}).
@item Mouse-2
-Yank the last killed text at the click position
-(@code{mouse-yank-at-click}).
+Move point to where you click, and insert the contents of the primary
+selection there (@code{mouse-yank-primary}).
@item Mouse-3
If the region is active, move the nearer end of the region to the
@@ -107,6 +107,7 @@ setting the variable @code{x-mouse-click-focus-ignore-position} to
selects the frame, without doing anything else; clicking again selects
the window and sets the cursor position.
+@cindex mouse, dragging
@findex mouse-set-region
Holding down @kbd{Mouse-1} and ``dragging'' the mouse over a stretch
of text activates the region around that text
@@ -236,8 +237,8 @@ Select the text you drag across, in the form of whole lines.
@node Mouse References
@section Following References with the Mouse
-@kindex Mouse-1 @r{(selection)}
-@kindex Mouse-2 @r{(selection)}
+@kindex Mouse-1 @r{(on buttons)}
+@kindex Mouse-2 @r{(on buttons)}
@cindex hyperlinks
@cindex links
@cindex text buttons
@@ -257,7 +258,7 @@ highlighting.
@key{RET}, or by clicking either @kbd{Mouse-1} or @kbd{Mouse-2} on the
button. For example, in a Dired buffer, each file name is a button;
activating it causes Emacs to visit that file (@pxref{Dired}). In a
-@samp{*Compilation*} buffer, each error message is a button, and
+@file{*Compilation*} buffer, each error message is a button, and
activating it visits the source code for that error
(@pxref{Compilation}).
@@ -370,7 +371,6 @@ side-by-side windows with the boundary running through the click
position (@pxref{Split Window}).
@end table
-@kindex C-Mouse-2 @r{(scroll bar)}
@kindex Mouse-1 @r{(scroll bar)}
Furthermore, by clicking and dragging @kbd{Mouse-1} on the divider
between two side-by-side mode lines, you can move the vertical
@@ -466,9 +466,9 @@ the ordinary, interactive frames are deleted. In this case, @kbd{C-x
The @kbd{C-x 5 1} (@code{delete-other-frames}) command deletes all
other frames on the current terminal (this terminal refers to either a
-graphical display, or a text-only terminal; @pxref{Non-Window
-Terminals}). If the Emacs session has frames open on other graphical
-displays or text terminals, those are not deleted.
+graphical display, or a text terminal; @pxref{Non-Window Terminals}).
+If the Emacs session has frames open on other graphical displays or
+text terminals, those are not deleted.
@vindex focus-follows-mouse
The @kbd{C-x 5 o} (@code{other-frame}) command selects the next
@@ -494,13 +494,14 @@ this for future sessions, click on @samp{Save Options} in the
@samp{Options} menu.
@item
-Add a line to your init file (@pxref{Init File}), modifying the
-variable @code{default-frame-alist} to specify the @code{font}
-parameter (@pxref{Creating Frames}), like this:
+Add a line to your init file, modifying the variable
+@code{default-frame-alist} to specify the @code{font} parameter
+(@pxref{Frame Parameters}), like this:
-@smallexample
-(add-to-list 'default-frame-alist '(font . "DejaVu Sans Mono-10"))
-@end smallexample
+@example
+(add-to-list 'default-frame-alist
+ '(font . "DejaVu Sans Mono-10"))
+@end example
@cindex X defaults file
@cindex X resources file
@@ -508,14 +509,14 @@ parameter (@pxref{Creating Frames}), like this:
Add an @samp{emacs.font} X resource setting to your X resource file,
like this:
-@smallexample
+@example
emacs.font: DejaVu Sans Mono-12
-@end smallexample
+@end example
@noindent
You must restart X, or use the @command{xrdb} command, for the X
-resources file to take effect. @xref{Resources}. When specifying a
-font in your X resources file, you should not quote it.
+resources file to take effect. @xref{Resources}. Do not quote
+font names in X resource files.
@item
If you are running Emacs on the GNOME desktop, you can tell Emacs to
@@ -537,9 +538,9 @@ names the font that it's rendered in.
first is to use a @dfn{Fontconfig pattern}. Fontconfig patterns have
the following form:
-@smallexample
+@example
@var{fontname}[-@var{fontsize}][:@var{name1}=@var{values1}][:@var{name2}=@var{values2}]...
-@end smallexample
+@end example
@noindent
Within this format, any of the elements in braces may be omitted.
@@ -579,13 +580,13 @@ One of @samp{monospace}, @samp{proportional}, @samp{dual-width}, or
@noindent
Here are some examples of Fontconfig patterns:
-@smallexample
+@example
Monospace
Monospace-12
Monospace-12:bold
DejaVu Sans Mono:bold:italic
Monospace-12:weight=bold:slant=italic
-@end smallexample
+@end example
For a more detailed description of Fontconfig patterns, see the
Fontconfig manual, which is distributed with Fontconfig and available
@@ -595,9 +596,9 @@ online at @url{http://fontconfig.org/fontconfig-user.html}.
The second way to specify a font is to use a @dfn{GTK font pattern}.
These have the syntax
-@smallexample
+@example
@var{fontname} [@var{properties}] [@var{fontsize}]
-@end smallexample
+@end example
@noindent
where @var{fontname} is the family name, @var{properties} is a list of
@@ -621,10 +622,10 @@ omitted, a default width is used.
@noindent
Here are some examples of GTK font patterns:
-@smallexample
+@example
Monospace 12
Monospace Bold Italic 12
-@end smallexample
+@end example
@cindex XLFD
@cindex X Logical Font Description
@@ -633,9 +634,9 @@ Logical Font Description}). This is the traditional method for
specifying fonts under X. Each XLFD consists of fourteen words or
numbers, separated by dashes, like this:
-@smallexample
+@example
-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1
-@end smallexample
+@end example
@noindent
A wildcard character (@samp{*}) in an XLFD matches any sequence of
@@ -646,10 +647,10 @@ results, supply all 14 dashes and use wildcards only within a field.
Case is insignificant in an XLFD. The syntax for an XLFD is as
follows:
-@smallexample
+@example
-@var{maker}-@var{family}-@var{weight}-@var{slant}-@var{widthtype}-@var{style}@dots{}
@dots{}-@var{pixels}-@var{height}-@var{horiz}-@var{vert}-@var{spacing}-@var{width}-@var{registry}-@var{encoding}
-@end smallexample
+@end example
@noindent
The entries have the following meanings:
@@ -668,8 +669,8 @@ The font slant---normally @samp{r} (roman), @samp{i} (italic),
Some font names support other values.
@item widthtype
The font width---normally @samp{normal}, @samp{condensed},
-@samp{extended}, or @samp{semicondensed} (some font names support
-other values).
+@samp{semicondensed}, or @samp{extended}. Some font names support
+other values.
@item style
An optional additional style name. Usually it is empty---most XLFDs
have two hyphens in a row at this point.
@@ -708,9 +709,9 @@ nickname''. Certain fonts have shorter nicknames, which you can use
instead of a normal font specification. For instance, @samp{6x13} is
equivalent to
-@smallexample
+@example
-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1
-@end smallexample
+@end example
@cindex client-side fonts
@cindex server-side fonts
@@ -909,7 +910,7 @@ scroll bars on the right side of windows), @code{left} (put them on
the left), or @code{nil} (disable scroll bars). By default, Emacs
puts scroll bars on the right if it was compiled with GTK+ support on
the X Window System, and on MS-Windows or Mac OS; Emacs puts scroll
-bars on the left if compiled on the X Window system without GTK+
+bars on the left if compiled on the X Window System without GTK+
support (following the old convention for X applications).
@vindex scroll-bar-width
@@ -954,7 +955,7 @@ the use of menu bars at startup, customize the variable
@code{menu-bar-mode}.
@kindex C-Mouse-3 @r{(when menu bar is disabled)}
- Expert users often turn off the menu bar, especially on text-only
+ Expert users often turn off the menu bar, especially on text
terminals, where this makes one additional line available for text.
If the menu bar is off, you can still pop up a menu of its contents
with @kbd{C-Mouse-3} on a display which supports pop-up menus.
@@ -1091,17 +1092,19 @@ to various values to move the mouse in several ways:
@table @code
@item banish
-Move the mouse to the upper-right corner on any key-press;
+Move the pointer to a corner of the frame on any key-press. You can
+customize the variable @code{mouse-avoidance-banish-position} to
+specify where the pointer goes when it is banished.
@item exile
-Move the mouse to the corner only if the cursor gets too close,
-and allow it to return once the cursor is out of the way;
+Banish the pointer only if the cursor gets too close, and allow it to
+return once the cursor is out of the way.
@item jump
-If the cursor gets too close to the mouse, displace the mouse
-a random distance & direction;
+If the cursor gets too close to the pointer, displace the pointer by a
+random distance and direction.
@item animate
-As @code{jump}, but shows steps along the way for illusion of motion;
+As @code{jump}, but shows steps along the way for illusion of motion.
@item cat-and-mouse
-The same as @code{animate};
+The same as @code{animate}.
@item proteus
As @code{animate}, but changes the shape of the mouse pointer too.
@end table
@@ -1113,9 +1116,9 @@ raises the frame.
@node Non-Window Terminals
@section Non-Window Terminals
-@cindex text-only terminal
+@cindex text terminal
- On a text-only terminal, Emacs can display only one Emacs frame at a
+ On a text terminal, Emacs can display only one Emacs frame at a
time. However, you can still create multiple Emacs frames, and switch
between them. Switching frames on these terminals is much like
switching between different window configurations.
@@ -1140,11 +1143,11 @@ to select a frame according to its name. The name you specify appears
in the mode line when the frame is selected.
@node Text-Only Mouse
-@section Using a Mouse in Text-only Terminals
+@section Using a Mouse in Text Terminals
@cindex mouse support
@cindex terminal emulators, mouse support
-Some text-only terminals support mouse clicks in the terminal window.
+Some text terminals support mouse clicks in the terminal window.
@cindex xterm
In a terminal emulator which is compatible with @command{xterm}, you
@@ -1162,9 +1165,9 @@ enable mouse support. You must have the gpm server installed and
running on your system in order for this to work.
@iftex
-@pxref{MS-DOS Mouse,,,emacs-xtra,Specialized Emacs Features},
+@xref{MS-DOS Mouse,,,emacs-xtra,Specialized Emacs Features},
@end iftex
@ifnottex
-@pxref{MS-DOS Mouse},
+@xref{MS-DOS Mouse},
@end ifnottex
for information about mouse support on MS-DOS.
diff --git a/doc/emacs/glossary.texi b/doc/emacs/glossary.texi
index 3af75245e69..0912cfe5311 100644
--- a/doc/emacs/glossary.texi
+++ b/doc/emacs/glossary.texi
@@ -1,13 +1,14 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Glossary, Key Index, Intro, Top
+@node Glossary
@unnumbered Glossary
@table @asis
+@anchor{Glossary - Abbrev}
@item Abbrev
-An abbrev is a text string which expands into a different text string
+An abbrev is a text string that expands into a different text string
when present in the buffer. For example, you might define a few letters
as an abbrev for a long phrase that you want to insert frequently.
@xref{Abbrevs}.
@@ -17,6 +18,8 @@ Aborting means getting out of a recursive edit (q.v.@:). The
commands @kbd{C-]} and @kbd{M-x top-level} are used for this.
@xref{Quitting}.
+@c FIXME? Active Region
+
@item Alt
Alt is the name of a modifier bit that a keyboard input character may
have. To make a character Alt, type it while holding down the @key{ALT}
@@ -26,7 +29,7 @@ key labeled @key{ALT} that is really a @key{META} key.) @xref{User
Input, Alt}.
@item Argument
-See `numeric argument.'
+@xref{Glossary - Numeric Argument}.
@item @acronym{ASCII} character
An @acronym{ASCII} character is either an @acronym{ASCII} control
@@ -37,8 +40,8 @@ An @acronym{ASCII} control character is the Control version of an upper-case
letter, or the Control version of one of the characters @samp{@@[\]^_?}.
@item @acronym{ASCII} printing character
-@acronym{ASCII} printing characters include letters, digits, space, and these
-punctuation characters: @samp{!@@#$%^& *()_-+=|\~` @{@}[]:;"' <>,.?/}.
+@acronym{ASCII} letters, digits, space, and the following punctuation
+characters: @samp{!@@#$%^&*()_-+=|\~`@{@}[]:;"'<>,.?/}.
@item Auto Fill Mode
Auto Fill mode is a minor mode (q.v.@:) in which text that you insert is
@@ -53,14 +56,15 @@ be preserved if the buffer is lost due to a system error or user error.
@item Autoloading
Emacs can automatically load Lisp libraries when a Lisp program requests a
-function from those libraries. This is called `autoloading.'
+function from those libraries. This is called `autoloading'.
@xref{Lisp Libraries}.
@item Backtrace
A backtrace is a trace of a series of function calls showing how a
program arrived at a certain point. It is used mainly for finding and
correcting bugs (q.v.@:). Emacs can display a backtrace when it signals
-an error or when you type @kbd{C-g} (see `quitting'). @xref{Checklist}.
+an error or when you type @kbd{C-g} (@pxref{Glossary - Quitting}).
+@xref{Checklist}.
@item Backup File
A backup file records the contents that a file had before the current
@@ -72,25 +76,33 @@ Emacs can balance parentheses (or other matching delimiters) either
manually or automatically. You do manual balancing with the commands
to move over parenthetical groupings (@pxref{Moving by Parens}).
Automatic balancing works by blinking or highlighting the delimiter
-that matches the one you just inserted (@pxref{Matching,,Matching
-Parens}).
+that matches the one you just inserted, or inserting the matching
+delimiter for you (@pxref{Matching,,Matching Parens}).
+@anchor{Glossary - Balanced Expression}
@item Balanced Expressions
A balanced expression is a syntactically recognizable expression, such
as a symbol, number, string constant, block, or parenthesized expression
in C. @xref{Expressions,Balanced Expressions}.
@item Balloon Help
-See `tooltips.'
+@xref{Glossary - Tooltips}.
@item Base Buffer
A base buffer is a buffer whose text is shared by an indirect buffer
(q.v.@:).
+@item Bidirectional Text
+Some human languages, such as English, are written from left to right.
+Others, such as Arabic, are written from right to left. Emacs
+supports both of these forms, as well as any mixture of them---this
+is `bidirectional text'. @xref{Bidirectional Editing}.
+
@item Bind
To bind a key sequence means to give it a binding (q.v.@:).
@xref{Rebinding}.
+@anchor{Glossary - Binding}
@item Binding
A key sequence gets its meaning in Emacs by having a binding, which is a
command (q.v.@:), a Lisp function that is run when you type that
@@ -100,12 +112,12 @@ all key sequences are recorded in the keymaps (q.v.@:). @xref{Keymaps}.
@item Blank Lines
Blank lines are lines that contain only whitespace. Emacs has several
-commands for operating on the blank lines in the buffer.
+commands for operating on the blank lines in the buffer. @xref{Blank Lines}.
@item Bookmark
Bookmarks are akin to registers (q.v.@:) in that they record positions
in buffers to which you can return later. Unlike registers, bookmarks
-persist between Emacs sessions.
+persist between Emacs sessions. @xref{Bookmarks}.
@item Border
A border is a thin space along the edge of the frame, used just for
@@ -118,13 +130,13 @@ X}). Borders are not the same as fringes (q.v.@:).
@item Buffer
The buffer is the basic editing unit; one buffer corresponds to one text
-being edited. You can have several buffers, but at any time you are
-editing only one, the `current buffer,' though several can be visible
+being edited. You normally have several buffers, but at any time you are
+editing only one, the `current buffer', though several can be visible
when you are using multiple windows or frames (q.v.@:). Most buffers
are visiting (q.v.@:) some file. @xref{Buffers}.
@item Buffer Selection History
-Emacs keeps a buffer selection history which records how recently each
+Emacs keeps a buffer selection history that records how recently each
Emacs buffer has been selected. This is used for choosing a buffer to
select. @xref{Buffers}.
@@ -139,11 +151,12 @@ A button down event is the kind of input event (q.v.@:) generated
right away when you press down on a mouse button. @xref{Mouse Buttons}.
@item By Default
-See `default.'
+@xref{Glossary - Default}.
@item Byte Compilation
-See `compilation.'
+@xref{Glossary - Compilation}.
+@anchor{Glossary - C-}
@item @kbd{C-}
@kbd{C-} in the name of a character is an abbreviation for Control.
@xref{User Input,C-}.
@@ -156,7 +169,7 @@ corresponding Control character. @xref{User Input,C-M-}.
@item Case Conversion
Case conversion means changing text from upper case to lower case or
-vice versa. @xref{Case}, for the commands for case conversion.
+vice versa. @xref{Case}.
@item Character
Characters form the contents of an Emacs buffer. Also, key sequences
@@ -168,16 +181,19 @@ Emacs supports a number of character sets, each of which represents a
particular alphabet or script. @xref{International}.
@item Character Terminal
-See `text-only terminal.'
+@xref{Glossary - Text Terminal}.
@item Click Event
A click event is the kind of input event (q.v.@:) generated when you
press a mouse button and release it without moving the mouse.
@xref{Mouse Buttons}.
+@item Client
+@xref{Glossary - Server}.
+
@item Clipboard
A clipboard is a buffer provided by the window system for transferring
-text between applications. On the X Window system, the clipboard is
+text between applications. On the X Window System, the clipboard is
provided in addition to the primary selection (q.v.@:); on MS-Windows and Mac,
the clipboard is used @emph{instead} of the primary selection.
@xref{Clipboard}.
@@ -195,10 +211,10 @@ binding (q.v.@:) is looked up in the relevant keymaps (q.v.@:) to find
the command to run. @xref{Commands}.
@item Command History
-See `minibuffer history.'
+@xref{Glossary - Minibuffer History}.
@item Command Name
-A command name is the name of a Lisp symbol which is a command
+A command name is the name of a Lisp symbol that is a command
(@pxref{Commands}). You can invoke any command by its name using
@kbd{M-x} (@pxref{M-x,M-x,Running Commands by Name}).
@@ -213,6 +229,7 @@ Common Lisp is a dialect of Lisp (q.v.@:) much larger and more powerful
than Emacs Lisp. Emacs provides a subset of Common Lisp in the CL
package. @xref{Top, Common Lisp, Overview, cl, Common Lisp Extensions}.
+@anchor{Glossary - Compilation}
@item Compilation
Compilation is the process of creating an executable program from source
code. Emacs has commands for compiling files of Emacs Lisp code
@@ -221,7 +238,7 @@ Reference Manual}) and programs in C and other languages
(@pxref{Compilation}).
@item Complete Key
-A complete key is a key sequence which fully specifies one action to be
+A complete key is a key sequence that fully specifies one action to be
performed by Emacs. For example, @kbd{X} and @kbd{C-f} and @kbd{C-x m}
are complete keys. Complete keys derive their meanings from being bound
(q.v.@:) to commands (q.v.@:). Thus, @kbd{X} is conventionally bound to
@@ -237,10 +254,11 @@ is known; for example, on command names, buffer names, and
file names. Completion usually occurs when @key{TAB}, @key{SPC} or
@key{RET} is typed. @xref{Completion}.@refill
+@anchor{Glossary - Continuation Line}
@item Continuation Line
When a line of text is longer than the width of the window, it
-normally (but see `Truncation') takes up more than one screen line
-when displayed. We say that the text line is continued, and all
+normally (but see @ref{Glossary - Truncation}) takes up more than one
+screen line when displayed. We say that the text line is continued, and all
screen lines used for it after the first are called continuation
lines. @xref{Continuation Lines}. A related Emacs feature is
`filling' (q.v.@:).
@@ -264,7 +282,7 @@ GNU General Public License. @xref{Copying}.
@item @key{CTRL}
The @key{CTRL} or ``control'' key is what you hold down
-in order to enter a control character (q.v.). See also `@kbd{C-}.'
+in order to enter a control character (q.v.). @xref{Glossary - C-}.
@item Current Buffer
The current buffer in Emacs is the Emacs buffer on which most editing
@@ -289,7 +307,7 @@ The cursor is the rectangle on the screen which indicates the position
(called point; q.v.@:) at which insertion and deletion takes place.
The cursor is on or under the character that follows point. Often
people speak of `the cursor' when, strictly speaking, they mean
-`point.' @xref{Point,Cursor}.
+`point'. @xref{Point,Cursor}.
@item Customization
Customization is making minor changes in the way Emacs works, to
@@ -299,8 +317,9 @@ or by rebinding key sequences (@pxref{Keymaps}).
@cindex cut and paste
@item Cut and Paste
-See `killing' and `yanking.'
+@xref{Glossary - Killing}, and @ref{Glossary - Yanking}.
+@anchor{Glossary - Daemon}
@item Daemon
A daemon is a standard term for a system-level process that runs in the
background. Daemons are often started when the system first starts up.
@@ -314,14 +333,15 @@ do not specify one. When the minibuffer is used to read an argument,
the default argument is used if you just type @key{RET}.
@xref{Minibuffer}.
+@anchor{Glossary - Default}
@item Default
-A default is the value that is used for a certain purpose if and when
-you do not specify a value to use.
+A default is the value that is used for a certain purpose when
+you do not explicitly specify a value to use.
@item Default Directory
When you specify a file name that does not start with @samp{/} or @samp{~},
it is interpreted relative to the current buffer's default directory.
-(On MS-Windows and MS-DOS, file names which start with a drive letter
+(On MS systems, file names that start with a drive letter
@samp{@var{x}:} are treated as absolute, not relative.)
@xref{Minibuffer File,Default Directory}.
@@ -340,6 +360,7 @@ key or the @key{BACKSPACE} key, whichever one is easy to type.
Deletion means erasing text without copying it into the kill ring
(q.v.@:). The alternative is killing (q.v.@:). @xref{Killing,Deletion}.
+@anchor{Glossary - Deletion of Files}
@item Deletion of Files
Deleting a file means erasing it from the file system.
(Note that some systems use the concept of a ``trash can'', or ``recycle
@@ -361,11 +382,17 @@ old if you wish. @xref{Windows}.
@item Directory
File directories are named collections in the file system, within which
you can place individual files or subdirectories. They are sometimes
-referred to as ``folders.'' @xref{Directories}.
+referred to as ``folders''. @xref{Directories}.
+
+@anchor{Glossary - Directory Local Variable}
+@item Directory Local Variable
+A directory local variable is a local variable (q.v.@:) that applies
+to all the files within a certain directory. @xref{Directory
+Variables}.
@item Dired
Dired is the Emacs facility that displays the contents of a file
-directory and allows you to ``edit the directory,'' performing
+directory and allows you to ``edit the directory'', performing
operations on the files in the directory. @xref{Dired}.
@item Disabled Command
@@ -387,11 +414,14 @@ you type on the keyboard. Dribble files can be used to make a record
for debugging Emacs bugs. Emacs does not make a dribble file unless you
tell it to. @xref{Bugs}.
+@c TODO? Not really appropriate for the user manual I think.
+@c Dynamic Binding
+
@item Echo Area
The echo area is the bottom line of the screen, used for echoing the
arguments to commands, for asking questions, and showing brief messages
(including error messages). The messages are stored in the buffer
-@samp{*Messages*} so you can review them later. @xref{Echo Area}.
+@file{*Messages*} so you can review them later. @xref{Echo Area}.
@item Echoing
Echoing is acknowledging the receipt of input events by displaying
@@ -406,6 +436,7 @@ else as well. For example, some programming language major modes define
particular delimiter characters to reindent the line, or insert one or
more newlines in addition to self-insertion.
+@anchor{Glossary - End Of Line}
@item End Of Line
End of line is a character or a sequence of characters that indicate
the end of a text line. On GNU and Unix systems, this is a newline
@@ -421,7 +452,7 @@ variables in the environment it passes to programs it invokes.
@xref{Environment}.
@item EOL
-See `end of line.'
+@xref{Glossary - End Of Line}.
@item Error
An error occurs when an Emacs command cannot execute in the current
@@ -446,7 +477,7 @@ typed), you press the @key{ESC} key as you would press a letter key, and
it applies to the next character you type.
@item Expression
-See `balanced expression.'
+@xref{Glossary - Balanced Expression}.
@item Expunging
Expunging an Rmail, Gnus newsgroup, or Dired buffer is an operation
@@ -461,11 +492,18 @@ features to associate specific faces with portions of buffer text, in
order to display that text as specified by the face attributes.
@xref{Faces}.
+@item File Local Variable
+A file local variable is a local variable (q.v.@:) specified in a
+given file. @xref{File Variables}, and @ref{Glossary - Directory
+Local Variable}.
+
+@anchor{Glossary - File Locking}
@item File Locking
Emacs uses file locking to notice when two different users
start to edit one file at the same time. @xref{Interlocking}.
@item File Name
+@c This is fairly tautological...
A file name is a name that refers to a file. File names may be relative
or absolute; the meaning of a relative file name depends on the current
directory, but an absolute file name refers to the same file regardless
@@ -492,15 +530,18 @@ The fill prefix is a string that should be expected at the beginning
of each line when filling is done. It is not regarded as part of the
text to be filled. @xref{Filling}.
+@anchor{Glossary - Filling}
@item Filling
Filling text means adjusting the position of line-breaks to shift text
between consecutive lines, so that all the lines are approximately the
same length. @xref{Filling}. Some other editors call this feature
-`line wrapping.'
+``line wrapping''.
+@anchor{Glossary - Font Lock}
@item Font Lock
Font Lock is a mode that highlights parts of buffer text in different
-faces, according to the syntax. For example, all comments (q.v.@:)
+faces, according to the syntax. Some other editors refer to this as
+``syntax highlighting''. For example, all comments (q.v.@:)
might be colored red. @xref{Font Lock}.
@item Fontset
@@ -510,7 +551,7 @@ make it easy to change several fonts at once by specifying the name of a
fontset, rather than changing each font separately. @xref{Fontsets}.
@item Formfeed Character
-See `page.'
+@xref{Glossary - Page}.
@item Frame
A frame is a rectangular cluster of Emacs windows. Emacs starts out
@@ -526,6 +567,7 @@ and modify it. Emacs is free software, part of the GNU project
(q.v.@:), and distributed under a copyleft (q.v.@:) license called the
GNU General Public License. @xref{Copying}.
+@anchor{Glossary - Free Software Foundation}
@item Free Software Foundation
The Free Software Foundation (FSF) is a charitable foundation
dedicated to promoting the development of free software (q.v.@:).
@@ -534,12 +576,12 @@ For more information, see @uref{http://fsf.org/, the FSF website}.
@item Fringe
On a graphical display (q.v.@:), there's a narrow portion of the frame
(q.v.@:) between the text area and the window's border. These
-`fringes' are used to display symbols that provide information about
+``fringes'' are used to display symbols that provide information about
the buffer text (@pxref{Fringes}). Emacs displays the fringe using a
special face (q.v.@:) called @code{fringe}. @xref{Faces,fringe}.
@item FSF
-See `Free Software Foundation.'
+@xref{Glossary - Free Software Foundation}.
@item FTP
FTP is an acronym for File Transfer Protocol. This is one standard
@@ -551,7 +593,7 @@ correspond to any character. @xref{Function Keys}.
@item Global
Global means ``independent of the current environment; in effect
-throughout Emacs.'' It is the opposite of local (q.v.@:). Particular
+throughout Emacs''. It is the opposite of local (q.v.@:). Particular
examples of the use of `global' appear below.
@item Global Abbrev
@@ -568,8 +610,9 @@ mode's local keymap (q.v.@:). @xref{Keymaps}.
The global mark ring records the series of buffers you have recently
set a mark (q.v.@:) in. In many cases you can use this to backtrack
through buffers you have been editing, or in which you have found
-tags (see `tags table'). @xref{Global Mark Ring}.
+tags (@pxref{Glossary - Tags Table}). @xref{Global Mark Ring}.
+@anchor{Glossary - Global Substitution}
@item Global Substitution
Global substitution means replacing each occurrence of one string by
another string throughout a large amount of text. @xref{Replace}.
@@ -605,7 +648,7 @@ buffer.
Emacs uses highlighting in several ways. It highlights the region
whenever it is active (@pxref{Mark}). Incremental search also
-highlights matches (@pxref{Incremental Search}). See also `font lock.'
+highlights matches (@pxref{Incremental Search}). @xref{Glossary - Font Lock}.
@item Hardcopy
Hardcopy means printed output. Emacs has various commands for
@@ -613,14 +656,14 @@ printing the contents of Emacs buffers. @xref{Printing}.
@item @key{HELP}
@key{HELP} is the Emacs name for @kbd{C-h} or @key{F1}. You can type
-@key{HELP} at any time to ask what options you have, or to ask what any
+@key{HELP} at any time to ask what options you have, or to ask what a
command does. @xref{Help}.
@item Help Echo
Help echo is a short message displayed in the echo area (q.v.@:) when
the mouse pointer is located on portions of display that require some
explanations. Emacs displays help echo for menu items, parts of the
-mode line, tool-bar buttons, etc. On graphics displays, the messages
+mode line, tool-bar buttons, etc. On graphical displays, the messages
can be displayed as tooltips (q.v.@:). @xref{Tooltips}.
@item Home Directory
@@ -644,16 +687,17 @@ have. To make a character Hyper, type it while holding down the
@kbd{Hyper-} (usually written @kbd{H-} for short). @xref{User Input}.
@item Iff
-``Iff'' means ``if and only if.'' This terminology comes from
+``Iff'' means ``if and only if''. This terminology comes from
mathematics. Try to avoid using this term in documentation, since
many are unfamiliar with it and mistake it for a typo.
@item Inbox
An inbox is a file in which mail is delivered by the operating system.
-Rmail transfers mail from inboxes to Rmail files (q.v.@:) in which the
+Rmail transfers mail from inboxes to Rmail files in which the
mail is then stored permanently or until explicitly deleted.
@xref{Rmail Inbox}.
+@anchor{Glossary - Incremental Search}
@item Incremental Search
Emacs provides an incremental search facility, whereby Emacs begins
searching for a string as soon as you type the first character.
@@ -689,19 +733,17 @@ Insertion means adding text into the buffer, either from the keyboard
or from some other place in Emacs.
@item Interlocking
-Interlocking is a feature for warning when you start to alter a file
-that someone else is already editing.
-@xref{Interlocking,Interlocking,Simultaneous Editing}.
+@xref{Glossary - File Locking}.
@item Isearch
-See `incremental search.'
+@xref{Glossary - Incremental Search}.
@item Justification
Justification means adding extra spaces within lines of text in order
to adjust the position of the text edges. @xref{Fill Commands}.
@item Key Binding
-See `binding.'
+@xref{Glossary - Binding}.
@item Keyboard Macro
Keyboard macros are a way of defining new Emacs commands from
@@ -712,9 +754,9 @@ play them back as many times as you like.
@cindex keyboard shortcuts
@item Keyboard Shortcut
-A keyboard shortcut is a key sequence (q.v.@:) which invokes a
-command. What some programs call ``assigning a keyboard shortcut,''
-Emacs calls ``binding a key sequence.'' See `binding.'
+A keyboard shortcut is a key sequence (q.v.@:) that invokes a
+command. What some programs call ``assigning a keyboard shortcut'',
+Emacs calls ``binding a key sequence''. @xref{Glossary - Binding}.
@item Key Sequence
A key sequence (key, for short) is a sequence of input events (q.v.@:)
@@ -734,13 +776,14 @@ codes that come from the terminal into the character codes that make up
key sequences.
@item Kill Ring
-The kill ring is where all text you have killed recently is saved.
-You can reinsert any of the killed text still in the ring; this is
-called yanking (q.v.@:). @xref{Yanking}.
+The kill ring is where all text you have killed (@pxref{Glossary - Killing})
+recently is saved. You can reinsert any of the killed text still in
+the ring; this is called yanking (q.v.@:). @xref{Yanking}.
+@anchor{Glossary - Killing}
@item Killing
Killing means erasing text and saving it on the kill ring so it can be
-yanked (q.v.@:) later. Some other systems call this ``cutting.''
+yanked (q.v.@:) later. Some other systems call this ``cutting''.
Most Emacs commands that erase text perform killing, as opposed to
deletion (q.v.@:). @xref{Killing}.
@@ -755,8 +798,11 @@ method (q.v.@:) and coding system (q.v.@:). @xref{Language
Environments}. These defaults are relevant if you edit
non-@acronym{ASCII} text (@pxref{International}).
+@c TODO? Not really appropriate for the user manual I think.
+@c Lexical Binding
+
@item Line Wrapping
-See `filling.'
+@xref{Glossary - Filling}.
@item Lisp
Lisp is a programming language. Most of Emacs is written in a dialect
@@ -805,6 +851,7 @@ Control-Meta; it means the same thing as `@kbd{C-M-}' (q.v.@:).
name. This is how you run commands that are not bound to key sequences.
@xref{M-x,M-x,Running Commands by Name}.
+@anchor{Glossary - Mail}
@item Mail
Mail means messages sent from one user to another through the computer
system, to be read at the recipient's convenience. Emacs has commands for
@@ -834,7 +881,7 @@ all the text from point to the mark. Each buffer has its own mark.
@item Mark Ring
The mark ring is used to hold several recent previous locations of the
-mark, just in case you want to move back to them. Each buffer has its
+mark, in case you want to move back to them. Each buffer has its
own mark ring; in addition, there is a single global mark ring (q.v.@:).
@xref{Mark Ring}.
@@ -844,7 +891,7 @@ words you can click on with the mouse to bring up menus, or you can use
a keyboard interface to navigate it. @xref{Menu Bars}.
@item Message
-See `mail.'
+@xref{Glossary - Mail}.
@item Meta
Meta is the name of a modifier bit which you can use in a command
@@ -867,13 +914,14 @@ The minibuffer is the window that appears when necessary inside the
echo area (q.v.@:), used for reading arguments to commands.
@xref{Minibuffer}.
+@anchor{Glossary - Minibuffer History}
@item Minibuffer History
The minibuffer history records the text you have specified in the past
for minibuffer arguments, so you can conveniently use the same text
again. @xref{Minibuffer History}.
@item Minor Mode
-A minor mode is an optional feature of Emacs which can be switched on
+A minor mode is an optional feature of Emacs, which can be switched on
or off independently of all other features. Each minor mode has a
command to turn it on or off. Some minor modes are global (q.v.@:),
and some are local (q.v.@:). @xref{Minor Modes}.
@@ -911,7 +959,7 @@ since the number of non-@acronym{ASCII} characters is much more than 256.
@xref{International Chars, International Characters}.
@item Named Mark
-A named mark is a register (q.v.@:) in its role of recording a
+A named mark is a register (q.v.@:), in its role of recording a
location in text so that you can move point to that location.
@xref{Registers}.
@@ -924,14 +972,15 @@ all. @xref{Narrowing}.
@item Newline
Control-J characters in the buffer terminate lines of text and are
-therefore also called newlines. See `End of Line.'
+therefore also called newlines. @xref{Glossary - End Of Line}.
@cindex nil
@cindex t
@item @code{nil}
-@code{nil} is a value usually interpreted as a logical ``false.'' Its
-opposite is @code{t}, interpreted as ``true.''
+@code{nil} is a value usually interpreted as a logical ``false''. Its
+opposite is @code{t}, interpreted as ``true''.
+@anchor{Glossary - Numeric Argument}
@item Numeric Argument
A numeric argument is a number, specified before a command, to change
the effect of the command. Often the numeric argument serves as a
@@ -940,11 +989,17 @@ repeat count. @xref{Arguments}.
@item Overwrite Mode
Overwrite mode is a minor mode. When it is enabled, ordinary text
characters replace the existing text after point rather than pushing
-it to the right. @xref{Minor Modes}.
+it to one side. @xref{Minor Modes}.
+
+@item Package
+A package is a collection of Lisp code that you download and
+automatically install from within Emacs. Packages provide a
+convenient way to add new features. @xref{Packages}.
+@anchor{Glossary - Page}
@item Page
A page is a unit of text, delimited by formfeed characters (@acronym{ASCII}
-control-L, code 014) coming at the beginning of a line. Some Emacs
+control-L, code 014) at the beginning of a line. Some Emacs
commands are provided for moving over and operating on pages.
@xref{Pages}.
@@ -965,7 +1020,7 @@ character. The terminal's cursor (q.v.@:) indicates the location of
point. @xref{Point}.
@item Prefix Argument
-See `numeric argument.'
+@xref{Glossary - Numeric Argument}.
@item Prefix Key
A prefix key is a key sequence (q.v.@:) whose sole function is to
@@ -973,10 +1028,13 @@ introduce a set of longer key sequences. @kbd{C-x} is an example of
prefix key; any two-character sequence starting with @kbd{C-x} is
therefore a legitimate key sequence. @xref{Keys}.
+@c I don't think this kind of thing needs to be here.
+@ignore
@item Primary Rmail File
Your primary Rmail file is the file named @samp{RMAIL} in your home
directory. That's where Rmail stores your incoming mail, unless you
specify a different file name. @xref{Rmail}.
+@end ignore
@item Primary Selection
The primary selection is one particular X selection (q.v.@:); it is the
@@ -998,6 +1056,7 @@ a kind of prompting (@pxref{Echo Area}).
Query-replace is an interactive string replacement feature provided by
Emacs. @xref{Query Replace}.
+@anchor{Glossary - Quitting}
@item Quitting
Quitting means canceling a partially typed command or a running
command, using @kbd{C-g} (or @kbd{C-@key{BREAK}} on MS-DOS). @xref{Quitting}.
@@ -1042,7 +1101,7 @@ correspond to changes that have been made in the text being edited.
@xref{Screen,Redisplay}.
@item Regexp
-See `regular expression.'
+@xref{Glossary - Regular Expression}.
@item Region
The region is the text between point (q.v.@:) and the mark (q.v.@:).
@@ -1053,6 +1112,7 @@ Registers are named slots in which text, buffer positions, or
rectangles can be saved for later use. @xref{Registers}. A related
Emacs feature is `bookmarks' (q.v.@:).
+@anchor{Glossary - Regular Expression}
@item Regular Expression
A regular expression is a pattern that can match various text strings;
for example, @samp{a[0-9]+} matches @samp{a} followed by one or more
@@ -1066,10 +1126,10 @@ you have a supported method to gain access to those files.
@xref{Remote Files}.
@item Repeat Count
-See `numeric argument.'
+@xref{Glossary - Numeric Argument}.
@item Replacement
-See `global substitution.'
+@xref{Glossary - Global Substitution}.
@item Restriction
A buffer's restriction is the amount of text, at the beginning or the
@@ -1086,9 +1146,13 @@ read in the minibuffer (q.v.@:). @xref{User Input,Return}.
Reverting means returning to the original state. Emacs lets you
revert a buffer by re-reading its file from disk. @xref{Reverting}.
+@c Seems too obvious, also there is nothing special about the format
+@c these days.
+@ignore
@item Rmail File
An Rmail file is a file containing text in the format used by
Rmail for storing mail. @xref{Rmail}.
+@end ignore
@item Saving
Saving a buffer means copying its text into the file that was visited
@@ -1156,6 +1220,21 @@ are self-inserting in Emacs, except in certain special major modes.
Emacs has commands for moving by or killing by sentences.
@xref{Sentences}.
+@anchor{Glossary - Server}
+@item Server
+Within Emacs, you can start a `server' process, which listens for
+connections from `clients'. This offers a faster alternative to
+starting several Emacs instances. @xref{Emacs Server}, and
+@ref{Glossary - Daemon}.
+
+@c This is only covered in the lispref, not the user manual.
+@ignore
+@item Session Manager
+Some window systems (q.v.@:) provide a tool called a `session manager'.
+This offers the ability to save your windows when you log off,
+and restore them after you log in again.
+@end ignore
+
@item Sexp
A sexp (short for ``s-expression'') is the basic syntactic unit of
Lisp in its textual form: either a list, or Lisp atom. Sexps are also
@@ -1186,7 +1265,7 @@ spelling-checker programs to check the spelling of parts of a buffer
via a convenient user interface. @xref{Spelling}.
@item String
-A string is a kind of Lisp data object which contains a sequence of
+A string is a kind of Lisp data object that contains a sequence of
characters. Many Emacs variables are intended to have strings as
values. The Lisp syntax for a string consists of the characters in the
string with a @samp{"} before and another @samp{"} after. A @samp{"}
@@ -1198,10 +1277,10 @@ inside the string; however, backslash sequences as in C, such as
allowed as well.
@item String Substitution
-See `global substitution.'
+@xref{Glossary - Global Substitution}.
@item Syntax Highlighting
-See `font lock.'
+@xref{Glossary - Font Lock}.
@item Syntax Table
The syntax table tells Emacs which characters are part of a word,
@@ -1225,6 +1304,7 @@ your buffers, unsaved edits, undo history, etc. @xref{Exiting}.
@key{TAB} is the tab character. In Emacs it is typically used for
indentation or completion.
+@anchor{Glossary - Tags Table}
@item Tags Table
A tags table is a file that serves as an index to the function
definitions in one or more other files. @xref{Tags}.
@@ -1249,23 +1329,30 @@ Data consisting of written human language (as opposed to programs),
or following the stylistic conventions of human language.
@end itemize
-@item Text-only Terminal
-A text-only terminal is a display that is limited to displaying text in
-character units. Such a terminal cannot control individual pixels it
-displays. Emacs supports a subset of display features on text-only
-terminals.
+@anchor{Glossary - Text Terminal}
+@item Text Terminal
+A text terminal, or character terminal, is a display that is limited
+to displaying text in character units. Such a terminal cannot control
+individual pixels it displays. Emacs supports a subset of display
+features on text terminals.
@item Text Properties
Text properties are annotations recorded for particular characters in
the buffer. Images in the buffer are recorded as text properties;
they also specify formatting information. @xref{Editing Format Info}.
+@item Theme
+A theme is a set of customizations (q.v.@:) that give Emacs a
+particular appearance or behavior. For example, you might use a theme
+for your favorite set of faces (q.v.@:).
+
@item Tool Bar
The tool bar is a line (sometimes multiple lines) of icons at the top
of an Emacs frame. Clicking on one of these icons executes a command.
You can think of this as a graphical relative of the menu bar (q.v.@:).
@xref{Tool Bars}.
+@anchor{Glossary - Tooltips}
@item Tooltips
Tooltips are small windows displaying a help echo (q.v.@:) text, which
explains parts of the display, lists useful options available via mouse
@@ -1278,20 +1365,26 @@ are not in a recursive editing level (q.v.@:) or the minibuffer
(q.v.@:), and not in the middle of a command. You can get back to top
level by aborting (q.v.@:) and quitting (q.v.@:). @xref{Quitting}.
+@c FIXME? Transient Mark Mode
+
@item Transposition
Transposing two units of text means putting each one into the place
formerly occupied by the other. There are Emacs commands to transpose
two adjacent characters, words, balanced expressions (q.v.@:) or lines
(@pxref{Transpose}).
+@item Trash Can
+@xref{Glossary - Deletion of Files}.
+
+@anchor{Glossary - Truncation}
@item Truncation
Truncating text lines in the display means leaving out any text on a
line that does not fit within the right margin of the window
-displaying it. See also `continuation line.'
-@xref{Continuation Lines,Truncation}.
+displaying it. @xref{Continuation Lines,Truncation}, and
+@ref{Glossary - Continuation Line}.
@item TTY
-See `text-only terminal.'
+@xref{Glossary - Text Terminal}.
@item Undoing
Undoing means making your previous editing go in reverse, bringing
@@ -1350,14 +1443,15 @@ have their] own windows at the same time. All modern operating systems
include a window system.
@item Word Abbrev
-See `abbrev.'
+@xref{Glossary - Abbrev}.
@item Word Search
Word search is searching for a sequence of words, considering the
punctuation between them as insignificant. @xref{Word Search}.
+@anchor{Glossary - Yanking}
@item Yanking
Yanking means reinserting text previously killed (q.v.@:). It can be
used to undo a mistaken kill, or for copying or moving text. Some
-other systems call this ``pasting.'' @xref{Yanking}.
+other systems call this ``pasting''. @xref{Yanking}.
@end table
diff --git a/doc/emacs/gnu.texi b/doc/emacs/gnu.texi
index dfdeedd65ec..0f21dd635db 100644
--- a/doc/emacs/gnu.texi
+++ b/doc/emacs/gnu.texi
@@ -1,4 +1,4 @@
-@c Copyright (C) 1985-1987, 1993, 1995, 2001-2011
+@c Copyright (C) 1985-1987, 1993, 1995, 2001-2012
@c Free Software Foundation, Inc.
@c
@c Permission is granted to anyone to make or distribute verbatim copies
@@ -10,7 +10,7 @@
@c Modified versions may not be made.
@ifclear justgnu
-@node Manifesto,, Microsoft Windows, Top
+@node Manifesto
@unnumbered The GNU Manifesto
@end ifclear
@ifset justgnu
diff --git a/doc/emacs/gpl.texi b/doc/emacs/gpl.texi
index 1908d1f8f98..97a17e1914e 100644
--- a/doc/emacs/gpl.texi
+++ b/doc/emacs/gpl.texi
@@ -2,7 +2,7 @@
@center Version 3, 29 June 2007
@c This file is intended to be included within another document,
-@c hence no sectioning command or @node.
+@c hence no sectioning command or @node.
@display
Copyright @copyright{} 2007 Free Software Foundation, Inc. @url{http://fsf.org/}
@@ -222,7 +222,7 @@ terms of section 4, provided that you also meet all of these
conditions:
@enumerate a
-@item
+@item
The work must carry prominent notices stating that you modified it,
and giving a relevant date.
@@ -670,7 +670,7 @@ state the exclusion of warranty; and each file should have at least
the ``copyright'' line and a pointer to where the full notice is found.
@smallexample
-@var{one line to give the program's name and a brief idea of what it does.}
+@var{one line to give the program's name and a brief idea of what it does.}
Copyright (C) @var{year} @var{name of author}
This program is free software: you can redistribute it and/or modify
@@ -693,7 +693,7 @@ If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
@smallexample
-@var{program} Copyright (C) @var{year} @var{name of author}
+@var{program} Copyright (C) @var{year} @var{name of author}
This program comes with ABSOLUTELY NO WARRANTY; for details type @samp{show w}.
This is free software, and you are welcome to redistribute it
under certain conditions; type @samp{show c} for details.
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index c024d428511..050ecd150ab 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Help, Mark, M-x, Top
+@node Help
@chapter Help
@kindex Help
@cindex help
@@ -71,7 +71,7 @@ meanings for it, but they all support @key{F1} for help.)
* Language Help:: Help relating to international language support.
* Misc Help:: Other help commands.
* Help Files:: Commands to display auxiliary help files.
-* Help Echo:: Help on active text and tooltips (`balloon help').
+* Help Echo:: Help on active text and tooltips ("balloon help").
@end menu
@iftex
@@ -96,13 +96,13 @@ of the major mode, then global bindings (@code{describe-bindings}).
@item C-h c @var{key}
Show the name of the command that the key sequence @var{key} is bound
to (@code{describe-key-briefly}). Here @kbd{c} stands for
-``character.'' For more extensive information on @var{key}, use
+``character''. For more extensive information on @var{key}, use
@kbd{C-h k}.
@item C-h d @var{topics} @key{RET}
Display the commands and variables whose documentation matches
@var{topics} (@code{apropos-documentation}).
@item C-h e
-Display the @code{*Messages*} buffer
+Display the @file{*Messages*} buffer
(@code{view-echo-area-messages}).
@item C-h f @var{function} @key{RET}
Display documentation on the Lisp function named @var{function}
@@ -168,7 +168,7 @@ programming language you are editing (@code{info-lookup-symbol}).
@item C-h .
Display the help message for a special text area, if point is in one
(@code{display-local-help}). (These include, for example, links in
-@samp{*Help*} buffers.)
+@file{*Help*} buffers.)
@end table
@node Key Help
@@ -243,7 +243,7 @@ by the innermost Lisp expression in the buffer around point,
(That name appears as the default while you enter the argument.) For
example, if point is located following the text @samp{(make-vector
(car x)}, the innermost list containing point is the one that starts
-with @samp{(make-vector}, so @kbd{C-h f @key{RET}} will describe the
+with @samp{(make-vector}, so @kbd{C-h f @key{RET}} describes the
function @code{make-vector}.
@kbd{C-h f} is also useful just to verify that you spelled a
@@ -464,7 +464,8 @@ listing the associated character sets, coding systems, and input
methods, as well as some sample text for that language environment.
The command @kbd{C-h h} (@code{view-hello-file}) displays the file
-@file{etc/HELLO}, which shows how to say ``hello'' in many languages.
+@file{etc/HELLO}, which demonstrates various character sets by showing
+how to say ``hello'' in many languages.
The command @kbd{C-h I} (@code{describe-input-method}) describes an
input method---either a specified input method, or by default the
@@ -518,7 +519,7 @@ use @kbd{C-h c} to find out what they do.
@findex view-echo-area-messages
To review recent echo area messages, use @kbd{C-h e}
(@code{view-echo-area-messages}). This displays the buffer
-@code{*Messages*}, where those messages are kept.
+@file{*Messages*}, where those messages are kept.
@kindex C-h m
@findex describe-mode
diff --git a/doc/emacs/indent.texi b/doc/emacs/indent.texi
index f99e3519710..08914d20340 100644
--- a/doc/emacs/indent.texi
+++ b/doc/emacs/indent.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Indentation, Text, Modes, Top
+@node Indentation
@chapter Indentation
@cindex indentation
@cindex tabs
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 1443ad019bb..5510816b067 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -1,9 +1,9 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Killing, Registers, Mark, Top
+@node Killing
@chapter Killing and Moving Text
In Emacs, @dfn{killing} means erasing text and copying it into the
@@ -289,7 +289,7 @@ e.g. @kbd{C-u 4 C-y} reinserts the fourth most recent kill.
On graphical displays, @kbd{C-y} first checks if another application
has placed any text in the system clipboard more recently than the
-last Emacs kill. If so, it inserts the text in the clipboard instead.
+last Emacs kill. If so, it inserts the clipboard's text instead.
Thus, Emacs effectively treats ``cut'' or ``copy'' clipboard
operations performed in other applications like Emacs kills, except
that they are not recorded in the kill ring. @xref{Cut and Paste},
@@ -490,6 +490,17 @@ new yank to the clipboard.
To prevent kill and yank commands from accessing the clipboard,
change the variable @code{x-select-enable-clipboard} to @code{nil}.
+@cindex clipboard manager
+@vindex x-select-enable-clipboard-manager
+ Many X desktop environments support a feature called the
+@dfn{clipboard manager}. If you exit Emacs while it is the current
+``owner'' of the clipboard data, and there is a clipboard manager
+running, Emacs transfers the clipboard data to the clipboard manager
+so that it is not lost. In some circumstances, this may cause a delay
+when exiting Emacs; if you wish to prevent Emacs from transferring
+data to the clipboard manager, change the variable
+@code{x-select-enable-clipboard-manager} to @code{nil}.
+
@vindex x-select-enable-primary
@findex clipboard-kill-region
@findex clipboard-kill-ring-save
@@ -698,6 +709,9 @@ rectangle, depending on the command that uses them.
@item C-x r k
Kill the text of the region-rectangle, saving its contents as the
``last killed rectangle'' (@code{kill-rectangle}).
+@item C-x r M-w
+Save the text of the region-rectangle as the ``last killed rectangle''
+(@code{copy-rectangle-as-kill}).
@item C-x r d
Delete the text of the region-rectangle (@code{delete-rectangle}).
@item C-x r y
@@ -746,6 +760,12 @@ yanking a rectangle is so different from yanking linear text that
different yank commands have to be used. Yank-popping is not defined
for rectangles.
+@kindex C-x r M-w
+@findex copy-rectangle-as-kill
+ @kbd{C-x r M-w} (@code{copy-rectangle-as-kill}) is the equivalent of
+@kbd{M-w} for rectangles: it records the rectangle as the ``last
+killed rectangle'', without deleting the text from the buffer.
+
@kindex C-x r y
@findex yank-rectangle
To yank the last killed rectangle, type @kbd{C-x r y}
diff --git a/doc/emacs/kmacro.texi b/doc/emacs/kmacro.texi
index 4676983fc67..3b83d24e405 100644
--- a/doc/emacs/kmacro.texi
+++ b/doc/emacs/kmacro.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Keyboard Macros, Files, Fixit, Top
+@node Keyboard Macros
@chapter Keyboard Macros
@cindex defining keyboard macros
@cindex keyboard macro
@@ -35,8 +35,10 @@ intelligent or general. For such things, Lisp must be used.
* Basic Keyboard Macro:: Defining and running keyboard macros.
* Keyboard Macro Ring:: Where previous keyboard macros are saved.
* Keyboard Macro Counter:: Inserting incrementing numbers in macros.
-* Keyboard Macro Query:: Making keyboard macros do different things each time.
-* Save Keyboard Macro:: Giving keyboard macros names; saving them in files.
+* Keyboard Macro Query:: Making keyboard macros do different things each
+ time.
+* Save Keyboard Macro:: Giving keyboard macros names; saving them in
+ files.
* Edit Keyboard Macro:: Editing keyboard macros.
* Keyboard Macro Step-Edit:: Interactively executing and editing a keyboard
macro.
@@ -223,7 +225,7 @@ desired macro is at the head of the ring. To execute the new macro
ring head immediately, just type @kbd{C-k}.
Note that Emacs treats the head of the macro ring as the ``last
-defined keyboard macro.'' For instance, @key{F4} will execute that
+defined keyboard macro''. For instance, @key{F4} will execute that
macro, and @kbd{C-x C-k n} will give it a name.
@vindex kmacro-ring-max
@@ -480,10 +482,11 @@ Edit the last 300 keystrokes as a keyboard macro
@kindex C-x C-k C-e
@kindex C-x C-k RET
You can edit the last keyboard macro by typing @kbd{C-x C-k C-e} or
-@kbd{C-x C-k RET} (@code{kmacro-edit-macro}). This formats the macro
-definition in a buffer and enters a specialized major mode for editing
-it. Type @kbd{C-h m} once in that buffer to display details of how to
-edit the macro. When you are finished editing, type @kbd{C-c C-c}.
+@kbd{C-x C-k @key{RET}} (@code{kmacro-edit-macro}). This formats the
+macro definition in a buffer and enters a specialized major mode for
+editing it. Type @kbd{C-h m} once in that buffer to display details
+of how to edit the macro. When you are finished editing, type
+@kbd{C-c C-c}.
@findex edit-kbd-macro
@kindex C-x C-k e
diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi
index cf55631e14e..5412c88af92 100644
--- a/doc/emacs/m-x.texi
+++ b/doc/emacs/m-x.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node M-x, Help, Minibuffer, Top
+@node M-x
@chapter Running Commands by Name
Every Emacs command has a name that you can use to run it. For
diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi
index 3e1e67fecd8..14c5fcae0ce 100644
--- a/doc/emacs/macos.texi
+++ b/doc/emacs/macos.texi
@@ -1,7 +1,7 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2000-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2000-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Mac OS / GNUstep, Microsoft Windows, Antinews, Top
+@node Mac OS / GNUstep
@appendix Emacs and Mac OS / GNUstep
@cindex Mac OS X
@cindex Macintosh
@@ -11,8 +11,8 @@
the GNUstep libraries on GNU/Linux or other operating systems, or on
Mac OS X with native window system support. On Mac OS X, Emacs can be
built either without window system support, with X11, or with the
-Cocoa interface; this section only applies to the Cocoa build. Emacs
-does not support earlier versions of Mac OS.
+Cocoa interface; this section only applies to the Cocoa build. This
+does not support versions of Mac OS X earlier than 10.4.
For various historical and technical reasons, Emacs uses the term
@samp{Nextstep} internally, instead of ``Cocoa'' or ``Mac OS X''; for
@@ -21,7 +21,7 @@ begin with @samp{ns-}, which is short for @samp{Nextstep}. NeXTstep
was an application interface released by NeXT Inc during the 1980s, of
which Cocoa is a direct descendant. Apart from Cocoa, there is
another NeXTstep-style system: GNUstep, which is free software. As of
-this writing, the GNUstep support is alpha status (@pxref{GNUstep
+this writing, Emacs GNUstep support is alpha status (@pxref{GNUstep
Support}), but we hope to improve it in the future.
@menu
@@ -31,7 +31,7 @@ Support}), but we hope to improve it in the future.
* GNUstep Support:: Details on status of GNUstep support.
@end menu
-@node Mac / GNUstep Basics, Mac / GNUstep Customization, , Mac OS / GNUstep
+@node Mac / GNUstep Basics
@section Basic Emacs usage under Mac OS and GNUstep
By default, the @key{alt} and @key{option} keys are the same as
@@ -40,6 +40,7 @@ Emacs provides a set of key bindings using this modifier key that mimic
other Mac / GNUstep applications (@pxref{Mac / GNUstep Events}). You
can change these bindings in the usual way (@pxref{Key Bindings}).
+@c FIXME mention ns-alternate-modifier?
The variable @code{ns-right-alternate-modifier} controls the
behavior of the right @key{alt} and @key{option} keys. These keys
behave like the left-hand keys if the value is @code{left} (the
@@ -47,30 +48,22 @@ default). A value of @code{control}, @code{meta}, @code{alt},
@code{super}, or @code{hyper} makes them behave like the corresponding
modifier keys; a value of @code{none} tells Emacs to ignore them.
- The standard Mac / GNUstep font and color panels are accessible via
-Lisp commands. To use the color panel, drag from it to an Emacs frame
-to change the foreground color of the face at that position (if the
-@key{shift} key is held down, it changes the background color
-instead). To discard the settings, create a new frame and close the
-altered one.
-
- @key{S-Mouse-1} (i.e., clicking the left mouse button while holding
-down the @key{Shift} key) adjusts the region to the click position,
-just like @key{Mouse-3} (@code{mouse-save-then-kill}); it does not pop
-up a menu for changing the default face, as @key{S-Mouse-1} normally
+ @kbd{S-Mouse-1} adjusts the region to the click position,
+just like @kbd{Mouse-3} (@code{mouse-save-then-kill}); it does not pop
+up a menu for changing the default face, as @kbd{S-Mouse-1} normally
does (@pxref{Text Scale}). This change makes Emacs behave more like
other Mac / GNUstep applications.
When you open or save files using the menus, or using the
-@key{Cmd-o} and @key{Cmd-S} bindings, Emacs uses graphical file
+@kbd{Cmd-o} and @kbd{Cmd-S} bindings, Emacs uses graphical file
dialogs to read file names. However, if you use the regular Emacs key
-sequences, such as @key{C-x C-f}, Emacs uses the minibuffer to read
+sequences, such as @kbd{C-x C-f}, Emacs uses the minibuffer to read
file names.
- On GNUstep, in an X-windows environment you need to use @key{Cmd-c}
-instead of one of the @key{C-w} or @key{M-w} commands to transfer text
+ On GNUstep, in an X-windows environment you need to use @kbd{Cmd-c}
+instead of one of the @kbd{C-w} or @kbd{M-w} commands to transfer text
to the X primary selection; otherwise, Emacs will use the
-``clipboard'' selection. Likewise, @key{Cmd-y} (instead of @key{C-y})
+``clipboard'' selection. Likewise, @kbd{Cmd-y} (instead of @kbd{C-y})
yanks from the X primary selection instead of the kill-ring or
clipboard.
@@ -91,7 +84,7 @@ For the PATH and MANPATH variables, a system-wide method
of setting PATH is recommended on Mac OS X 10.5 and later, using the
@file{/etc/paths} files and the @file{/etc/paths.d} directory.
-@node Mac / GNUstep Customization, Mac / GNUstep Events, Mac / GNUstep Basics, Mac OS / GNUstep
+@node Mac / GNUstep Customization
@section Mac / GNUstep Customization
Emacs can be customized in several ways in addition to the standard
@@ -100,37 +93,39 @@ customization buffers and the Options menu.
@subsection Font and Color Panels
-The Font Panel may be accessed with M-x ns-popup-font-panel. It
-will set the default font in the frame most recently used or clicked
-on.
+The standard Mac / GNUstep font and color panels are accessible via
+Lisp commands. The Font Panel may be accessed with @kbd{M-x
+ns-popup-font-panel}. It will set the default font in the frame most
+recently used or clicked on.
@c To make the setting permanent, use @samp{Save Options} in the
@c Options menu, or run @code{menu-bar-options-save}.
-You can bring up a color panel with M-x ns-popup-color-panel. and
-drag the color you want over the emacs face you want to change. Normal
+You can bring up a color panel with @kbd{M-x ns-popup-color-panel} and
+drag the color you want over the Emacs face you want to change. Normal
dragging will alter the foreground color. Shift dragging will alter the
-background color.
+background color. To discard the settings, create a new frame and
+close the altered one.
@c To make the changes permanent select the "Save Options"
@c item in the "Options" menu, or run @code{menu-bar-options-save}.
-Useful in this context is the listing of all faces obtained by @key{M-x}
-@code{list-faces-display}.
+Useful in this context is the listing of all faces obtained by
+@kbd{M-x list-faces-display}.
-@subsection Open files by dragging to an Emacs window
+@subsection Customization options specific to Mac OS / GNUstep
-The default behavior when a user drags files from another application
-into an Emacs frame is to insert the contents of all the dragged files
-into the current buffer. To remap the @code{ns-drag-file} event to
-open the dragged files in the current frame use the following line:
+The following customization options are specific to the Nextstep port.
-@lisp
-(define-key global-map [ns-drag-file] 'ns-find-file)
-@end lisp
+@table @code
+@item ns-auto-hide-menu-bar
+Non-nil means the menu-bar is hidden by default, but appears if you
+move the mouse pointer over it. (Requires Mac OS X 10.6 or later.)
+
+@end table
-@node Mac / GNUstep Events, GNUstep Support, Mac / GNUstep Customization, Mac OS / GNUstep
+@node Mac / GNUstep Events
@section Windowing System Events under Mac OS / GNUstep
Nextstep applications receive a number of special events which have
@@ -147,12 +142,12 @@ Emacs open a file. A typical reason for this would be a user
double-clicking a file in the Finder application. By default, Emacs
responds to this event by opening a new frame and visiting the file in
that frame (@code{ns-find-file}). As an exception, if the selected
-buffer is the @samp{*scratch*} buffer, Emacs visits the file in the
+buffer is the @file{*scratch*} buffer, Emacs visits the file in the
selected frame.
-You can change how Emacs responds to @key{ns-open-file} by changing
-the variable @code{ns-pop-up-frames}. Its default value,
-@code{'fresh}, is what we have just described. A value of @code{t}
+You can change how Emacs responds to a @code{ns-open-file} event by
+changing the variable @code{ns-pop-up-frames}. Its default value,
+@samp{fresh}, is what we have just described. A value of @code{t}
means to always visit the file in a new frame. A value of @code{nil}
means to always visit the file in an existing frame.
@@ -199,7 +194,7 @@ The default behavior is to save all file-visiting buffers.
Emacs also allows users to make use of Nextstep services, via a set
of commands whose names begin with @samp{ns-service-} and end with the
-name of the service. Type @kbd{M-x ns-service-@key{TAB}@key{TAB}} to
+name of the service. Type @kbd{M-x ns-service-@key{TAB}} to
see a list of these commands. These functions either operate on
marked text (replacing it with the result) or take a string argument
and return the result as a string. You can also use the Lisp function
@@ -207,9 +202,9 @@ and return the result as a string. You can also use the Lisp function
services and receive the results back. Note that you may need to
restart Emacs to access newly-available services.
-@node GNUstep Support, , Mac / GNUstep Events, Mac OS / GNUstep
+@node GNUstep Support
@section GNUstep Support
-Emacs can be built and run under GNUstep, but there are still some
+Emacs can be built and run under GNUstep, but there are still
issues to be addressed. Interested developers should contact
@email{emacs-devel@@gnu.org}.
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 6ce298c1795..67214bde22c 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1,12 +1,15 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Maintaining, Abbrevs, Building, Top
+@node Maintaining
@chapter Maintaining Large Programs
This chapter describes Emacs features for maintaining large
-programs.
+programs. If you are maintaining a large Lisp program, then in
+addition to the features described here, you may find
+the @file{ERT} (``Emacs Lisp Regression Testing'') library useful
+(@pxref{Top,,ERT,ert, Emacs Lisp Regression Testing}).
@menu
* Version Control:: Using version control systems.
@@ -423,7 +426,7 @@ VC fileset is handled individually; for example, a commit generates
one revision for each changed file.
@table @kbd
-@itemx C-x v v
+@item C-x v v
Perform the next appropriate version control operation on the current
VC fileset.
@end table
@@ -474,7 +477,7 @@ If every work file in the VC fileset is unchanged, do nothing.
@item
If every work file in the VC fileset has been modified, commit the
-changes. To do this, Emacs pops up a @samp{*vc-log*} buffer; type the
+changes. To do this, Emacs pops up a @file{*vc-log*} buffer; type the
desired log entry for the new revision, followed by @kbd{C-c C-c} to
commit. @xref{Log Buffer}.
@@ -527,7 +530,7 @@ so that you can begin to edit it.
@item
If each file is locked by you and contains changes, commit the
-changes. To do this, Emacs pops up a @samp{*vc-log*} buffer; type the
+changes. To do this, Emacs pops up a @file{*vc-log*} buffer; type the
desired log entry for the new revision, followed by @kbd{C-c C-c} to
commit (@pxref{Log Buffer}).
@@ -585,7 +588,7 @@ they use the concept of ``checking out'' individual files.
@cindex C-c C-c @r{(Log Edit mode)}
@findex log-edit-done
When you tell VC to commit a change, it pops up a buffer named
-@samp{*vc-log*}. In this buffer, you should write a @dfn{log entry}
+@file{*vc-log*}. In this buffer, you should write a @dfn{log entry}
describing the changes you have made (@pxref{Why Version Control?}).
After you are done, type @kbd{C-c C-c} (@code{log-edit-done}) to exit
the buffer and commit the change, together with your log entry.
@@ -593,12 +596,12 @@ the buffer and commit the change, together with your log entry.
@cindex Log Edit mode
@cindex mode, Log Edit
@vindex vc-log-mode-hook
- The major mode for the @samp{*vc-log*} buffer is Log Edit mode, a
+ The major mode for the @file{*vc-log*} buffer is Log Edit mode, a
variant of Text mode (@pxref{Text Mode}). On entering Log Edit mode,
Emacs runs the hooks @code{text-mode-hook} and @code{vc-log-mode-hook}
(@pxref{Hooks}).
- In the @samp{*vc-log*} buffer, you can write one or more @dfn{header
+ In the @file{*vc-log*} buffer, you can write one or more @dfn{header
lines}, specifying additional information to be supplied to the
version control system. Each header line must occupy a single line at
the top of the buffer; the first line that is not a header line is
@@ -623,7 +626,7 @@ support it, the header is treated as part of the log entry.
@findex log-edit-show-files
@kindex C-c C-d @r{(Log Edit mode)}
@findex log-edit-show-diff
- While in the @samp{*vc-log*} buffer, the ``current VC fileset'' is
+ While in the @file{*vc-log*} buffer, the ``current VC fileset'' is
considered to be the fileset that will be committed if you type
@w{@kbd{C-c C-c}}. To view a list of the files in the VC fileset,
type @w{@kbd{C-c C-f}} (@code{log-edit-show-files}). To view a diff
@@ -636,7 +639,7 @@ started editing (@pxref{Old Revisions}), type @kbd{C-c C-d}
If the VC fileset includes one or more @file{ChangeLog} files
(@pxref{Change Log}), type @kbd{C-c C-a}
(@code{log-edit-insert-changelog}) to pull the relevant entries into
-the @samp{*vc-log*} buffer. If the topmost item in each
+the @file{*vc-log*} buffer. If the topmost item in each
@file{ChangeLog} was made under your user name on the current date,
this command searches that item for entries matching the file(s) to be
committed, and inserts them.
@@ -649,7 +652,7 @@ Edit buffer.
To abort a commit, just @strong{don't} type @kbd{C-c C-c} in that
buffer. You can switch buffers and do other editing. As long as you
don't try to make another commit, the entry you were editing remains
-in the @samp{*vc-log*} buffer, and you can go back to that buffer at
+in the @file{*vc-log*} buffer, and you can go back to that buffer at
any time to complete the commit.
@kindex M-n @r{(Log Edit mode)}
@@ -708,7 +711,7 @@ commit can include both file additions and edits to existing files.
On a locking-based version control system (@pxref{VCS Merging}),
registering a file leaves it unlocked and read-only. Type @kbd{C-x v
-v} if you wish to start editing it.
+v} to start editing it.
@node Old Revisions
@subsection Examining And Comparing Old Revisions
@@ -722,7 +725,7 @@ call this command from a Dired buffer (@pxref{Dired}).
@ifnottex
@item M-x vc-ediff
-Like @kbd{C-x v =}, but using Ediff. @xref{Top, Ediff, ediff, The
+Like @kbd{C-x v =}, but using Ediff. @xref{Top,, Ediff, ediff, The
Ediff Manual}.
@end ifnottex
@@ -774,7 +777,7 @@ current VC fileset.
@ifnottex
@findex vc-ediff
@kbd{M-x vc-ediff} works like @kbd{C-x v =}, except that it uses an
-Ediff session. @xref{Top, Ediff, ediff, The Ediff Manual}.
+Ediff session. @xref{Top,, Ediff, ediff, The Ediff Manual}.
@end ifnottex
@findex vc-root-diff
@@ -890,7 +893,7 @@ Display the change history for the current repository
(@code{vc-print-root-log}).
@item C-x v I
-Display the changes that will be received with a pull operation
+Display the changes that a pull operation will retrieve
(@code{vc-log-incoming}).
@item C-x v O
@@ -900,11 +903,11 @@ Display the changes that will be sent by the next push operation
@kindex C-x v l
@findex vc-print-log
- The command @kbd{C-x v l} (@code{vc-print-log}) displays a buffer
-named @samp{*vc-change-log*}, showing the history of changes made to
-the current file, including who made the changes, the dates, and the
-log entry for each change (these are the same log entries you would
-enter via the @samp{*vc-log*} buffer; @pxref{Log Buffer}). Point is
+ @kbd{C-x v l} (@code{vc-print-log}) displays a buffer named
+@file{*vc-change-log*}, showing the history of changes made to the
+current file, including who made the changes, the dates, and the log
+entry for each change (these are the same log entries you would enter
+via the @file{*vc-log*} buffer; @pxref{Log Buffer}). Point is
centered at the revision of the file currently being visited. With a
prefix argument, the command prompts for the revision to center on,
and the maximum number of revisions to display.
@@ -916,7 +919,7 @@ file listed on the current line.
@findex vc-print-root-log
@findex log-view-toggle-entry-display
@kbd{C-x v L} (@code{vc-print-root-log}) displays a
-@samp{*vc-change-log*} buffer showing the history of the entire
+@file{*vc-change-log*} buffer showing the history of the entire
version-controlled directory tree (RCS, SCCS, and CVS do not support
this feature). With a prefix argument, the command prompts for the
maximum number of revisions to display.
@@ -924,7 +927,7 @@ maximum number of revisions to display.
The @kbd{C-x v L} history is shown in a compact form, usually
showing only the first line of each log entry. However, you can type
@key{RET} (@code{log-view-toggle-entry-display}) in the
-@samp{*vc-change-log*} buffer to reveal the entire log entry for the
+@file{*vc-change-log*} buffer to reveal the entire log entry for the
revision at point. A second @key{RET} hides it again.
On a decentralized version control system, the @kbd{C-x v I}
@@ -939,7 +942,7 @@ specific repository. Similarly, @kbd{C-x v O}
another repository, the next time you run the ``push'' command; with a
prefix argument, it prompts for a specific destination repository.
- In the @samp{*vc-change-log*} buffer, you can use the following keys
+ In the @file{*vc-change-log*} buffer, you can use the following keys
to move between the logs of revisions and of files, and to examine and
compare past revisions (@pxref{Old Revisions}):
@@ -990,11 +993,11 @@ revision at point.
@vindex vc-log-show-limit
Because fetching many log entries can be slow, the
-@samp{*vc-change-log*} buffer displays no more than 2000 revisions by
+@file{*vc-change-log*} buffer displays no more than 2000 revisions by
default. The variable @code{vc-log-show-limit} specifies this limit;
if you set the value to zero, that removes the limit. You can also
increase the number of revisions shown in an existing
-@samp{*vc-change-log*} buffer by clicking on the @samp{Show 2X
+@file{*vc-change-log*} buffer by clicking on the @samp{Show 2X
entries} or @samp{Show unlimited entries} buttons at the end of the
buffer. However, RCS, SCCS, and CVS do not support this feature.
@@ -1042,7 +1045,7 @@ it is used to specify multi-file VC filesets for commands like
To use the VC Directory buffer, type @kbd{C-x v d} (@code{vc-dir}).
This reads a directory name using the minibuffer, and switches to a VC
Directory buffer for that directory. By default, the buffer is named
-@samp{*vc-dir*}. Its contents are described
+@file{*vc-dir*}. Its contents are described
@iftex
below.
@end iftex
@@ -1183,11 +1186,8 @@ point is on a directory entry, mark all files in that directory tree
(@code{vc-dir-mark-all-files}). With a prefix argument, mark all
listed files and directories.
-@kindex q @r{(VC Directory)}
-@findex quit-window
@item q
-Bury the VC Directory buffer, and delete its window if the window was
-created just for that buffer.
+Quit the VC Directory buffer, and bury it (@code{quit-window}).
@item u
Unmark the file or directory on the current line. If the region is
@@ -1202,9 +1202,6 @@ files and directories.
@item x
Hide files with @samp{up-to-date} status
(@code{vc-dir-hide-up-to-date}).
-
-@item q
-Quit the VC Directory buffer, and bury it (@code{quit-window}).
@end table
@findex vc-dir-mark
@@ -1323,7 +1320,7 @@ commit will be committed to that specific branch.
@subsubsection Pulling Changes into a Branch
@table @kbd
-@itemx C-x v +
+@item C-x v +
On a decentralized version control system, update the current branch
by ``pulling in'' changes from another location.
@@ -1363,7 +1360,7 @@ updates the current VC fileset from the repository.
@cindex merging changes
@table @kbd
-@itemx C-x v m
+@item C-x v m
On a decentralized version control system, merge changes from another
branch into the current one.
@@ -1656,7 +1653,7 @@ Tags for variables and functions in classes are named
@samp{@var{class}.@var{variable}} and @samp{@var{class}.@var{function}}.
@item
-In La@TeX{} documents, the arguments for @code{\chapter},
+In @LaTeX{} documents, the arguments for @code{\chapter},
@code{\section}, @code{\subsection}, @code{\subsubsection},
@code{\eqno}, @code{\label}, @code{\ref}, @code{\cite},
@code{\bibitem}, @code{\part}, @code{\appendix}, @code{\entry},
@@ -1726,7 +1723,7 @@ find-tag @key{RET} bidule @key{RET}} will just search for any tag
@code{bidule}.
@item
-In assembler code, labels appearing at the beginning of a line,
+In assembler code, labels appearing at the start of a line,
followed by a colon, are tags.
@item
@@ -2224,7 +2221,7 @@ the current buffer, followed by the remaining files of the tags table.
reads a regexp to search for and a string to replace with, just like
ordinary @kbd{M-x query-replace-regexp}. It searches much like @kbd{M-x
tags-search}, but repeatedly, processing matches according to your
-input. @xref{Replace}, for more information on query replace.
+input. @xref{Query Replace}, for more information on query replace.
@vindex tags-case-fold-search
@cindex case-sensitivity and tags search
diff --git a/doc/emacs/makefile.w32-in b/doc/emacs/makefile.w32-in
index e128a50ebd3..4ccecbb7ddf 100644
--- a/doc/emacs/makefile.w32-in
+++ b/doc/emacs/makefile.w32-in
@@ -1,6 +1,6 @@
#### -*- Makefile -*- for the Emacs Manual
-# Copyright (C) 2003-2011 Free Software Foundation, Inc.
+# Copyright (C) 2003-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -30,7 +30,9 @@ infodir = $(srcdir)/../../info
MAKEINFO = makeinfo
MAKEINFO_OPTS = --force --enable-encoding -I$(srcdir)
MULTI_INSTALL_INFO = $(srcdir)\..\..\nt\multi-install-info.bat
-INFO_TARGETS = $(infodir)/emacs
+INFO_EXT=.info
+INFO_OPTS=--no-split
+INFO_TARGETS = $(infodir)/emacs$(INFO_EXT)
DVI_TARGETS = emacs.dvi
INFOSOURCES = info.texi
@@ -114,8 +116,8 @@ dvi: $(DVI_TARGETS)
$(infodir)/dir:
$(MULTI_INSTALL_INFO) --info-dir=$(infodir) $(INFO_TARGETS)
-$(infodir)/emacs: $(EMACSSOURCES)
- $(MAKEINFO) $(MAKEINFO_OPTS) emacs.texi
+$(infodir)/emacs$(INFO_EXT): $(EMACSSOURCES)
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ emacs.texi
emacs.dvi: $(EMACSSOURCES)
$(ENVADD) $(TEXI2DVI) $(srcdir)/emacs.texi
@@ -129,6 +131,7 @@ emacs-xtra.dvi: emacs-xtra.texi $(EMACS_XTRA)
mostlyclean:
- $(DEL) *.log *.cp *.fn *.ky *.pg *.vr core *.tp *.core gnustmp.*
+## FIXME $(infodir)/emacs* deletes too much, eg emacs-mime.
clean: mostlyclean
- $(DEL) *.dvi
- $(DEL) $(infodir)/emacs*
diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi
index 7d65719e5f0..db191eb175c 100644
--- a/doc/emacs/mark.texi
+++ b/doc/emacs/mark.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Mark, Killing, Help, Top
+@node Mark
@chapter The Mark and the Region
@cindex mark
@cindex setting a mark
@@ -430,10 +430,6 @@ mark is by using @kbd{C-x C-x}, which exchanges the positions of the
point and the mark (@pxref{Setting Mark}).
@item
-Many commands that move point long distances, like @kbd{M-<} and
-@kbd{C-s}, first set the mark where point was.
-
-@item
Some commands, which ordinarily act on the region when the mark is
active, no longer do so. For example, normally @kbd{M-%}
(@code{query-replace}) performs replacements within the region, if the
@@ -455,9 +451,10 @@ command twice.)
@item C-u C-x C-x
@kindex C-u C-x C-x
-Activate the mark and enable Transient Mark mode temporarily, until
-the mark is next deactivated. (This is the @kbd{C-x C-x} command,
-@code{exchange-point-and-mark}, with a prefix argument.)
+Exchange point and mark, activate the mark and enable Transient Mark
+mode temporarily, until the mark is next deactivated. (This is the
+@kbd{C-x C-x} command, @code{exchange-point-and-mark}, with a prefix
+argument.)
@end table
These commands set or activate the mark, and enable Transient Mark
diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index bbe42551345..ebccedacc05 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Minibuffer, M-x, Basic, Top
+@node Minibuffer
@chapter The Minibuffer
@cindex minibuffer
@@ -13,24 +13,54 @@ special-purpose buffer with a small amount of screen space. You can
use the usual Emacs editing commands in the minibuffer to edit the
argument text.
+@menu
+* Basic Minibuffer:: Basic usage of the minibuffer.
+* Minibuffer File:: Entering file names with the minibuffer.
+* Minibuffer Edit:: How to edit in the minibuffer.
+* Completion:: An abbreviation facility for minibuffer input.
+* Minibuffer History:: Reusing recent minibuffer arguments.
+* Repetition:: Re-executing commands that used the minibuffer.
+* Passwords:: Entering passwords in the echo area.
+* Yes or No Prompts:: Replying yes or no in the echo area.
+@end menu
+
+@node Basic Minibuffer
+@section Using the Minibuffer
+
@cindex prompt
When the minibuffer is in use, it appears in the echo area, with a
-cursor. The minibuffer starts with a @dfn{prompt} in a distinct
-color, usually ending with a colon. The prompt states what kind of
-input is expected, and how it will be used.
+cursor. The minibuffer starts with a @dfn{prompt}, usually ending
+with a colon. The prompt states what kind of input is expected, and
+how it will be used. The prompt is highlighted using the
+@code{minibuffer-prompt} face (@pxref{Faces}).
The simplest way to enter a minibuffer argument is to type the text,
-then @key{RET} to submit the argument and exit the minibuffer. You
-can cancel the minibuffer, and the command that wants the argument, by
-typing @kbd{C-g}.
+then @key{RET} to submit the argument and exit the minibuffer.
+Alternatively, you can type @kbd{C-g} to exit the minibuffer by
+cancelling the command asking for the argument (@pxref{Quitting}).
@cindex default argument
- Sometimes, a @dfn{default argument} appears in the prompt, inside
+ Sometimes, the prompt shows a @dfn{default argument}, inside
parentheses before the colon. This default will be used as the
argument if you just type @key{RET}. For example, commands that read
buffer names usually show a buffer name as the default; you can type
@key{RET} to operate on that default buffer.
+@cindex Minibuffer Electric Default mode
+@cindex mode, Minibuffer Electric Default
+@findex minibuffer-electric-default-mode
+@vindex minibuffer-eldef-shorten-default
+ If you enable Minibuffer Electric Default mode, a global minor mode,
+Emacs hides the default argument as soon as you modify the contents of
+the minibuffer (since typing @key{RET} would no longer submit that
+default). If you ever bring back the original minibuffer text, the
+prompt again shows the default. Furthermore, if you change the
+variable @code{minibuffer-eldef-shorten-default} to a non-@code{nil}
+value, the default argument is displayed as @samp{[@var{default}]}
+instead of @samp{(default @var{default})}, saving some screen space.
+To enable this minor mode, type @kbd{M-x
+minibuffer-electric-default-mode}.
+
Since the minibuffer appears in the echo area, it can conflict with
other uses of the echo area. If an error message or an informative
message is emitted while the minibuffer is active, the message hides
@@ -38,15 +68,6 @@ the minibuffer for a few seconds, or until you type something; then
the minibuffer comes back. While the minibuffer is in use, keystrokes
do not echo.
-@menu
-* Minibuffer File:: Entering file names with the minibuffer.
-* Minibuffer Edit:: How to edit in the minibuffer.
-* Completion:: An abbreviation facility for minibuffer input.
-* Minibuffer History:: Reusing recent minibuffer arguments.
-* Repetition:: Re-executing commands that used the minibuffer.
-* Passwords:: Entering passwords in the echo area.
-@end menu
-
@node Minibuffer File
@section Minibuffers for File Names
@@ -58,11 +79,11 @@ some initial text ending in a slash. This is the @dfn{default
directory}. For example, it may start out like this:
@example
-Find File: /u2/emacs/src/
+Find file: /u2/emacs/src/
@end example
@noindent
-Here, @samp{Find File:@: } is the prompt and @samp{/u2/emacs/src/} is
+Here, @samp{Find file:@: } is the prompt and @samp{/u2/emacs/src/} is
the default directory. If you now type @kbd{buffer.c} as input, that
specifies the file @file{/u2/emacs/src/buffer.c}. @xref{File Names},
for information about the default directory.
@@ -79,7 +100,7 @@ name starting with a slash or a tilde after the default directory.
For example, you can specify @file{/etc/termcap} as follows:
@example
-Find File: /u2/emacs/src//etc/termcap
+Find file: /u2/emacs/src//etc/termcap
@end example
@noindent
@@ -88,7 +109,7 @@ Find File: /u2/emacs/src//etc/termcap
@cindex slashes repeated in file name
@findex file-name-shadow-mode
Emacs interprets a double slash as ``ignore everything before the
-second slash in the pair.'' In the example above,
+second slash in the pair''. In the example above,
@file{/u2/emacs/src/} is ignored, so the argument you supplied is
@file{/etc/termcap}. The ignored part of the file name is dimmed if
the terminal allows it. (To disable this dimming, turn off File Name
@@ -195,6 +216,12 @@ possible completions. @xref{Other Window}.
the minibuffer is active. To allow such commands in the minibuffer,
set the variable @code{enable-recursive-minibuffers} to @code{t}.
+@findex minibuffer-inactive-mode
+ When not active, the minibuffer is in @code{minibuffer-inactive-mode},
+and clicking @kbd{Mouse-1} there shows the @file{*Messages*} buffer.
+If you use a dedicated frame for minibuffers, Emacs also recognizes
+certain keys there, for example @kbd{n} to make a new frame.
+
@node Completion
@section Completion
@c This node is referenced in the tutorial. When renaming or deleting
@@ -241,7 +268,10 @@ completion.
completion alternatives (in this case, command names) that start with
@samp{au}. There are several, including @code{auto-fill-mode} and
@code{autoconf-mode}, but they all begin with @code{auto}, so the
-@samp{au} in the minibuffer completes to @samp{auto}.
+@samp{au} in the minibuffer completes to @samp{auto}. (More commands
+may be defined in your Emacs session. For example, if a command
+called @code{authorize-me} was defined, Emacs could only complete
+as far as @samp{aut}.)
If you type @key{TAB} again immediately, it cannot determine the
next character; it could be @samp{-}, @samp{a}, or @samp{c}. So it
@@ -379,7 +409,7 @@ it just submits the argument as you have entered it.
@item
@dfn{Permissive completion with confirmation} is like permissive
completion, with an exception: if you typed @key{TAB} and this
-completed the text up to some intermediate state (i.e. one that is not
+completed the text up to some intermediate state (i.e., one that is not
yet an exact completion match), typing @key{RET} right afterward does
not submit the argument. Instead, Emacs asks for confirmation by
momentarily displaying @samp{[Confirm]} after the text; type @key{RET}
@@ -444,8 +474,7 @@ position in the completion alternative.
@item emacs22
This completion style is similar to @code{basic}, except that it
ignores the text in the minibuffer after point. It is so-named
-because it corresponds to the completion behavior in Emacs 22 and
-earlier.
+because it corresponds to the completion behavior in Emacs 22.
@end table
@noindent
@@ -470,6 +499,18 @@ and initialisms. For example, when completing command names, it
matches @samp{lch} to @samp{list-command-history}.
@end table
+@noindent
+There is also a very simple completion style called @code{emacs21}.
+In this style, if the text in the minibuffer is @samp{foobar},
+only matches starting with @samp{foobar} are considered.
+
+@vindex completion-category-overrides
+You can use different completion styles in different situations,
+by setting the variable @code{completion-category-overrides}.
+For example, the default setting says to use only @code{basic}
+and @code{substring} completion for buffer names.
+
+
@node Completion Options
@subsection Completion Options
@@ -515,7 +556,7 @@ commands never display the completion list buffer; you must type
@kbd{?} to display the list. If the value is @code{lazy}, Emacs only
shows the completion list buffer on the second attempt to complete.
In other words, if there is nothing to complete, the first @key{TAB}
-echoes @samp{Next char not unique}; the second @key{TAB} does the
+echoes @samp{Next char not unique}; the second @key{TAB} shows the
completion list buffer.
@vindex completion-cycle-threshold
@@ -529,7 +570,7 @@ those completion alternatives; each subsequent invocation of the
completion command replaces that with the next completion alternative,
in a cyclic manner. If you give @code{completion-cycle-threshold} a
numeric value @var{n}, completion commands switch to this cycling
-behavior only when there are fewer than @var{n} alternatives.
+behavior only when there are @var{n} or fewer alternatives.
@cindex Icomplete mode
@findex icomplete-mode
@@ -662,13 +703,13 @@ the text for that expression. Even if you don't know Lisp, it will
probably be obvious which command is displayed for repetition. If you
type just @key{RET}, that repeats the command unchanged. You can also
change the command by editing the Lisp expression before you execute
-it. The repeated command is added to the front of the command history
+it. The executed command is added to the front of the command history
unless it is identical to the most recent item.
Once inside the minibuffer for @kbd{C-x @key{ESC} @key{ESC}}, you
can use the usual minibuffer history commands (@pxref{Minibuffer
History}) to move through the history list. After finding the desired
-previous command, you can edit its expression as usual and then repeat
+previous command, you can edit its expression as usual and then execute
it by typing @key{RET}.
@vindex isearch-resume-in-command-history
@@ -682,7 +723,7 @@ value. @xref{Incremental Search}.
@vindex command-history
The list of previous minibuffer-using commands is stored as a Lisp
list in the variable @code{command-history}. Each element is a Lisp
-expression which describes one command and its arguments. Lisp programs
+expression that describes one command and its arguments. Lisp programs
can re-execute a command by calling @code{eval} with the
@code{command-history} element.
@@ -706,10 +747,60 @@ completion, and you cannot change windows or perform any other action
with Emacs until you have submitted the password.
While you are typing the password, you may press @key{DEL} to delete
-backwards, removing the last character entered. @key{C-u} deletes
+backwards, removing the last character entered. @kbd{C-u} deletes
everything you have typed so far. @kbd{C-g} quits the password prompt
(@pxref{Quitting}). @kbd{C-y} inserts the current kill into the
password (@pxref{Killing}). You may type either @key{RET} or
@key{ESC} to submit the password. Any other self-inserting character
key inserts the associated character into the password, and all other
input is ignored.
+
+@node Yes or No Prompts
+@section Yes or No Prompts
+
+ An Emacs command may require you to answer a ``yes or no'' question
+during the course of its execution. Such queries come in two main
+varieties.
+
+@cindex y or n prompt
+ For the first type of ``yes or no'' query, the prompt ends with
+@samp{(y or n)}. Such a query does not actually use the minibuffer;
+the prompt appears in the echo area, and you answer by typing either
+@samp{y} or @samp{n}, which immediately delivers the response. For
+example, if you type @kbd{C-x C-w} (@kbd{write-file}) to save a
+buffer, and enter the name of an existing file, Emacs issues a prompt
+like this:
+
+@smallexample
+File `foo.el' exists; overwrite? (y or n)
+@end smallexample
+
+@noindent
+Because this query does not actually use the minibuffer, the usual
+minibuffer editing commands cannot be used. However, you can perform
+some window scrolling operations while the query is active: @kbd{C-l}
+recenters the selected window; @kbd{M-v} (or @key{PageDown} or
+@key{next}) scrolls forward; @kbd{C-v} (or @key{PageUp}, or
+@key{prior}) scrolls backward; @kbd{C-M-v} scrolls forward in the next
+window; and @kbd{C-M-S-v} scrolls backward in the next window. Typing
+@kbd{C-g} dismisses the query, and quits the command that issued it
+(@pxref{Quitting}).
+
+@cindex yes or no prompt
+ The second type of ``yes or no'' query is typically employed if
+giving the wrong answer would have serious consequences; it uses the
+minibuffer, and features a prompt ending with @samp{(yes or no)}. For
+example, if you invoke @kbd{C-x k} (@code{kill-buffer}) on a
+file-visiting buffer with unsaved changes, Emacs activates the
+minibuffer with a prompt like this:
+
+@smallexample
+Buffer foo.el modified; kill anyway? (yes or no)
+@end smallexample
+
+@noindent
+To answer, you must type @samp{yes} or @samp{no} into the minibuffer,
+followed by @key{RET}. The minibuffer behaves as described in the
+previous sections; you can switch to another window with @kbd{C-x o},
+use the history commands @kbd{M-p} and @kbd{M-f}, etc. Type @kbd{C-g}
+to quit the minibuffer and the querying command.
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 714e7f3441c..1836c1982e6 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -1,12 +1,12 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@iftex
@chapter Miscellaneous Commands
This chapter contains several brief topics that do not fit anywhere
-else: viewing ``document files'', reading netnews, running shell
+else: viewing ``document files'', reading Usenet news, running shell
commands and shell subprocesses, using a single shared Emacs for
utilities that expect to run an editor as a subprocess, printing
hardcopy, sorting text, narrowing display to part of the buffer,
@@ -23,12 +23,13 @@ various diversions and amusements.
@node Gnus
@section Gnus
@cindex Gnus
-@cindex reading netnews
+@cindex Usenet news
+@cindex newsreader
-Gnus is an Emacs package primarily designed for reading and posting
-Usenet news. It can also be used to read and respond to messages from a
-number of other sources---mail, remote directories, digests, and so on.
-Here we introduce Gnus and describe several basic features.
+ Gnus is an Emacs package primarily designed for reading and posting
+Usenet news. It can also be used to read and respond to messages from
+a number of other sources---email, remote directories, digests, and so
+on. Here we introduce Gnus and describe several basic features.
@ifnottex
For full details, see @ref{Top, Gnus,, gnus, The Gnus Manual}.
@end ifnottex
@@ -37,198 +38,216 @@ For full details on Gnus, type @kbd{C-h i} and then select the Gnus
manual.
@end iftex
-@findex gnus
-To start Gnus, type @kbd{M-x gnus @key{RET}}.
-
@menu
* Buffers of Gnus:: The group, summary, and article buffers.
* Gnus Startup:: What you should know about starting Gnus.
-* Summary of Gnus:: A short description of the basic Gnus commands.
+* Gnus Group Buffer:: A short description of Gnus group commands.
+* Gnus Summary Buffer:: A short description of Gnus summary commands.
@end menu
@node Buffers of Gnus
@subsection Gnus Buffers
-Unlike most Emacs packages, Gnus uses several buffers to display
-information and to receive commands. The three Gnus buffers users use
-most are the @dfn{group buffer}, the @dfn{summary buffer} and the
-@dfn{article buffer}.
-
-The @dfn{group buffer} contains a list of newsgroups. This is the
-first buffer Gnus displays when it starts up. It normally displays
-only the groups to which you subscribe and that contain unread
-articles. Use this buffer to select a specific group.
-
-The @dfn{summary buffer} lists one line for each article in a single
-group. By default, the author, the subject and the line number are
-displayed for each article, but this is customizable, like most aspects
-of Gnus display. The summary buffer is created when you select a group
-in the group buffer, and is killed when you exit the group. Use this
-buffer to select an article.
-
-The @dfn{article buffer} displays the article. In normal Gnus usage,
-you see this buffer but you don't select it---all useful
-article-oriented commands work in the summary buffer. But you can
-select the article buffer, and execute all Gnus commands from that
-buffer, if you want to.
+ Gnus uses several buffers to display information and to receive
+commands. The three most commonly-used Gnus buffers are the
+@dfn{group buffer}, the @dfn{summary buffer} and the @dfn{article
+buffer}.
+
+ The @dfn{group buffer} contains a list of article sources (e.g.@:
+newsgroups and email inboxes), which are collectively referred to as
+@dfn{groups}. This is the first buffer Gnus displays when it starts
+up. It normally displays only the groups to which you subscribe and
+that contain unread articles. From this buffer, you can select a
+group to read.
+
+ The @dfn{summary buffer} lists the articles in a single group,
+showing one article per line. By default, it displays each article's
+author, subject, and line
+@iftex
+number.
+@end iftex
+@ifnottex
+number, but this is customizable; @xref{Summary Buffer Format,,, gnus,
+The Gnus Manual}.
+@end ifnottex
+The summary buffer is created when you select a group in the group
+buffer, and is killed when you exit the group.
+
+ From the summary buffer, you can choose an article to view. The
+article is displayed in the @dfn{article buffer}. In normal Gnus
+usage, you view this buffer but do not select it---all useful Gnus
+commands can be invoked from the summary buffer. But you can select
+the article buffer, and execute Gnus commands from it, if you wish.
@node Gnus Startup
@subsection When Gnus Starts Up
-At startup, Gnus reads your @file{.newsrc} news initialization file
-and attempts to communicate with the local news server, which is a
-repository of news articles. The news server need not be the same
-computer you are logged in on.
-
-If you start Gnus and connect to the server, but do not see any
-newsgroups listed in the group buffer, type @kbd{L} or @kbd{A k} to get
-a listing of all the groups. Then type @kbd{u} to toggle
-subscription to groups.
-
-The first time you start Gnus, Gnus subscribes you to a few selected
-groups. All other groups start out as @dfn{killed groups} for you; you
-can list them with @kbd{A k}. All new groups that subsequently come to
-exist at the news server become @dfn{zombie groups} for you; type @kbd{A
-z} to list them. You can subscribe to a group shown in these lists
-using the @kbd{u} command.
-
-When you quit Gnus with @kbd{q}, it automatically records in your
-@file{.newsrc} and @file{.newsrc.eld} initialization files the
-subscribed or unsubscribed status of all groups. You should normally
-not edit these files manually, but you may if you know how.
+@findex gnus
+@cindex @file{.newsrc} file
+ If your system has been set up for reading Usenet news, getting
+started with Gnus is easy---just type @kbd{M-x gnus}.
+
+ On starting up, Gnus reads your @dfn{news initialization file}: a
+file named @file{.newsrc} in your home directory which lists your
+Usenet newsgroups and subscriptions (this file is not unique to Gnus;
+it is used by many other newsreader programs). It then tries to
+contact the system's default news server, which is typically specified
+by the @env{NNTPSERVER} environment variable.
+
+ If your system does not have a default news server, or if you wish
+to use Gnus for reading email, then before invoking @kbd{M-x gnus} you
+need to tell Gnus where to get news and/or mail. To do this,
+customize the variables @code{gnus-select-method} and/or
+@code{gnus-secondary-select-methods}.
+@iftex
+See the Gnus manual for details.
+@end iftex
+@ifnottex
+@xref{Finding the News,,, gnus, The Gnus Manual}.
+@end ifnottex
-@node Summary of Gnus
-@subsection Summary of Gnus Commands
+ Once Gnus has started up, it displays the group buffer. By default,
+the group buffer shows only a small number of @dfn{subscribed groups}.
+Groups with other statuses---@dfn{unsubscribed}, @dfn{killed}, or
+@dfn{zombie}---are hidden. The first time you start Gnus, any group
+to which you are not subscribed is made into a killed group; any group
+that subsequently appears on the news server becomes a zombie group.
-Reading news is a two-step process:
+ To proceed, you must select a group in the group buffer to open the
+summary buffer for that group; then, select an article in the summary
+buffer to view its article buffer in a separate window. The following
+sections explain how to use the group and summary buffers to do this.
-@enumerate
-@item
-Choose a group in the group buffer.
+ To quit Gnus, type @kbd{q} in the group buffer. This automatically
+records your group statuses in the files @file{.newsrc} and
+@file{.newsrc.eld}, so that they take effect in subsequent Gnus
+sessions.
-@item
-Select articles from the summary buffer. Each article selected is
-displayed in the article buffer in a large window, below the summary
-buffer in its small window.
-@end enumerate
+@node Gnus Group Buffer
+@subsection Using the Gnus Group Buffer
- Each Gnus buffer has its own special commands; the meanings of any
-given key in the various Gnus buffers are usually analogous, even if
-not identical. Here are commands for the group and summary buffers:
+ The following commands are available in the Gnus group buffer:
@table @kbd
-@kindex q @r{(Gnus Group mode)}
-@findex gnus-group-exit
-@item q
-In the group buffer, update your @file{.newsrc} initialization file
-and quit Gnus.
+@kindex SPC @r{(Gnus Group mode)}
+@findex gnus-group-read-group
+@item @key{SPC}
+Switch to the summary buffer for the group on the current line.
-In the summary buffer, exit the current group and return to the
-group buffer. Thus, typing @kbd{q} twice quits Gnus.
+@kindex l @r{(Gnus Group mode)}
+@kindex A s @r{(Gnus Group mode)}
+@findex gnus-group-list-groups
+@item l
+@itemx A s
+In the group buffer, list only the groups to which you subscribe and
+which contain unread articles (this is the default listing).
@kindex L @r{(Gnus Group mode)}
+@kindex A u @r{(Gnus Group mode)}
@findex gnus-group-list-all-groups
@item L
-In the group buffer, list all the groups available on your news
-server (except those you have killed). This may be a long list!
+@itemx A u
+List all subscribed and unsubscribed groups, but not killed or zombie
+groups.
-@kindex l @r{(Gnus Group mode)}
-@findex gnus-group-list-groups
-@item l
-In the group buffer, list only the groups to which you subscribe and
-which contain unread articles.
+@kindex A k @r{(Gnus Group mode)}
+@findex gnus-group-list-all-groups
+@item A k
+List killed groups.
+
+@kindex A z @r{(Gnus Group mode)}
+@findex gnus-group-list-all-groups
+@item A z
+List zombie groups.
@kindex u @r{(Gnus Group mode)}
@findex gnus-group-unsubscribe-current-group
@cindex subscribe groups
@cindex unsubscribe groups
@item u
-In the group buffer, unsubscribe from (or subscribe to) the group listed
-in the line that point is on. When you quit Gnus by typing @kbd{q},
-Gnus lists in your @file{.newsrc} file which groups you have subscribed
-to. The next time you start Gnus, you won't see this group,
-because Gnus normally displays only subscribed-to groups.
+Toggle the subscription status of the group on the current line
+(i.e.@: turn a subscribed group into an unsubscribed group, or vice
+versa). Invoking this on a killed or zombie group turns it into an
+unsubscribed group.
-@kindex C-k @r{(Gnus)}
+@kindex C-k @r{(Gnus Group mode)}
@findex gnus-group-kill-group
@item C-k
-In the group buffer, ``kill'' the current line's group---don't
-even list it in @file{.newsrc} from now on. This affects future
-Gnus sessions as well as the present session.
+Kill the group on the current line. Killed groups are not recorded in
+the @file{.newsrc} file, and they are not shown in the @kbd{l} or
+@kbd{L} listings.
-When you quit Gnus by typing @kbd{q}, Gnus writes information
-in the file @file{.newsrc} describing all newsgroups except those you
-have ``killed.''
+@kindex DEL @r{(Gnus Group mode)}
+@item @key{DEL}
+Move point to the previous group containing unread articles.
-@kindex SPC @r{(Gnus)}
-@findex gnus-group-read-group
-@item @key{SPC}
-In the group buffer, select the group on the line under the cursor
-and display the first unread article in that group.
+@kindex n @r{(Gnus Group mode)}
+@findex gnus-group-next-unread-group
+@findex gnus-summary-next-unread-article
+@item n
+Move point to the next unread group.
-@need 1000
-In the summary buffer,
+@kindex p @r{(Gnus Group mode)}
+@findex gnus-group-prev-unread-group
+@findex gnus-summary-prev-unread-article
+@item p
+Move point to the previous unread group.
-@itemize @bullet
-@item
-Select the article on the line under the cursor if none is selected.
+@kindex q @r{(Gnus Group mode)}
+@findex gnus-group-exit
+@item q
+Update your Gnus settings, and quit Gnus.
+@end table
-@item
-Scroll the text of the selected article (if there is one).
+@node Gnus Summary Buffer
+@subsection Using the Gnus Summary Buffer
-@item
-Select the next unread article if at the end of the current article.
-@end itemize
+ The following commands are available in the Gnus summary buffer:
-Thus, you can move through all the articles by repeatedly typing @key{SPC}.
+@table @kbd
+@kindex SPC @r{(Gnus Summary mode)}
+@findex gnus-group-read-group
+@item @key{SPC}
+If there is no article selected, select the article on the current
+line and display its article buffer. Otherwise, try scrolling the
+selected article buffer in its window; on reaching the end of the
+buffer, select the next unread article.
-@kindex DEL @r{(Gnus)}
-@item @key{DEL}
-In the group buffer, move point to the previous group containing
-unread articles.
+Thus, you can read through all articles by repeatedly typing
+@key{SPC}.
+@kindex DEL @r{(Gnus Summary mode)}
@findex gnus-summary-prev-page
-In the summary buffer, scroll the text of the article backwards.
+@item @key{DEL}
+Scroll the text of the article backwards.
-@kindex n @r{(Gnus)}
+@kindex n @r{(Gnus Summary mode)}
@findex gnus-group-next-unread-group
@findex gnus-summary-next-unread-article
@item n
-Move point to the next unread group, or select the next unread article.
+Select the next unread article.
-@kindex p @r{(Gnus)}
+@kindex p @r{(Gnus Summary mode)}
@findex gnus-group-prev-unread-group
@findex gnus-summary-prev-unread-article
@item p
-Move point to the previous unread group, or select the previous
-unread article.
-
-@kindex C-n @r{(Gnus Group mode)}
-@findex gnus-group-next-group
-@kindex C-p @r{(Gnus Group mode)}
-@findex gnus-group-prev-group
-@kindex C-n @r{(Gnus Summary mode)}
-@findex gnus-summary-next-subject
-@kindex C-p @r{(Gnus Summary mode)}
-@findex gnus-summary-prev-subject
-@item C-n
-@itemx C-p
-Move point to the next or previous item, even if it is marked as read.
-This does not select the article or group on that line.
+Select the previous unread article.
@kindex s @r{(Gnus Summary mode)}
@findex gnus-summary-isearch-article
@item s
-In the summary buffer, do an incremental search of the current text in
-the article buffer, just as if you switched to the article buffer and
-typed @kbd{C-s}.
+Do an incremental search on the selected article buffer, as if you
+switched to the buffer and typed @kbd{C-s} (@pxref{Incremental
+Search}).
@kindex M-s @r{(Gnus Summary mode)}
@findex gnus-summary-search-article-forward
@item M-s @var{regexp} @key{RET}
-In the summary buffer, search forward for articles containing a match
-for @var{regexp}.
+Search forward for articles containing a match for @var{regexp}.
+@kindex q @r{(Gnus Summary mode)}
+@item q
+Exit the summary buffer and return to the group buffer.
@end table
@node Document View
@@ -244,64 +263,54 @@ for @var{regexp}.
@cindex document viewer (DocView)
@findex doc-view-mode
-DocView mode (@code{doc-view-mode}) is a viewer for DVI, PostScript
-(PS), PDF, OpenDocument, and Microsoft Office documents. It provides
-features such as slicing, zooming, and searching inside documents. It
-works by converting the document to a set of images using the
-@command{gs} (GhostScript) command and other external tools
-@footnote{@code{gs} is a hard requirement. For DVI files,
-@code{dvipdf} or @code{dvipdfm} is needed. For OpenDocument and
-Microsoft Office documents, the @code{unoconv} tool is needed.}, and
-displaying those images.
+ DocView mode is a major mode for viewing DVI, PostScript (PS), PDF,
+OpenDocument, and Microsoft Office documents. It provides features
+such as slicing, zooming, and searching inside documents. It works by
+converting the document to a set of images using the @command{gs}
+(GhostScript) command and other external tools @footnote{@code{gs} is
+a hard requirement. For DVI files, @code{dvipdf} or @code{dvipdfm} is
+needed. For OpenDocument and Microsoft Office documents, the
+@code{unoconv} tool is needed.}, and displaying those images.
@findex doc-view-toggle-display
@findex doc-view-toggle-display
@cindex doc-view-minor-mode
- When you visit a document file with the exception of PostScript
-files, Emacs automatically switches to DocView mode if possible
-@footnote{The needed external tools for this document type have to be
-available, emacs needs to run in a graphical frame, and PNG image
-support has to be compiled into emacs. If any of these requirements
-is not fulfilled, DocView falls back to an appropriate mode.}. When
-you visit a PostScript file, Emacs switches to PS mode, a major mode
-for editing PostScript files as text; however, it also enables DocView
-minor mode, so you can type @kbd{C-c C-c} to view the document with
-DocView. (PDF and DVI files, unlike PostScript files, are not usually
-human-editable.) In either case, repeating @kbd{C-c C-c}
-(@code{doc-view-toggle-display}) toggles between DocView and the file
-text.
-
- You can explicitly toggle DocView mode with the command @code{M-x
-doc-view-mode}, and DocView minor mode with the command @code{M-x
+ When you visit a document file that can be displayed with DocView
+mode, Emacs automatically uses DocView mode @footnote{The needed
+external tools for the document type must be available, and Emacs must
+be running in a graphical frame and have PNG image support. If any of
+these requirements is not fulfilled, Emacs falls back to another major
+mode.}. As an exception, when you visit a PostScript file, Emacs
+switches to PS mode, a major mode for editing PostScript files as
+text; however, it also enables DocView minor mode, so you can type
+@kbd{C-c C-c} to view the document with DocView. In either DocView
+mode or DocView minor mode, repeating @kbd{C-c C-c}
+(@code{doc-view-toggle-display}) toggles between DocView and the
+underlying file contents.
+
+ You can explicitly enable DocView mode with the command @code{M-x
+doc-view-mode}. You can toggle DocView minor mode with @code{M-x
doc-view-minor-mode}.
When DocView mode starts, it displays a welcome screen and begins
formatting the file, page by page. It displays the first page once
that has been formatted.
-@findex doc-view-enlarge
-@findex doc-view-shrink
-@vindex doc-view-resolution
- When in DocView mode, you can enlarge or shrink the document with
-@kbd{+} (@code{doc-view-enlarge}) and @kbd{-}
-(@code{doc-view-shrink}). To specify the default size for DocView,
-set or customize the variable @code{doc-view-resolution}.
-
To kill the DocView buffer, type @kbd{k}
(@code{doc-view-kill-proc-and-buffer}). To bury it, type @kbd{q}
(@code{quit-window}).
@menu
-* Navigation:: Navigation inside DocView buffers.
-* Searching:: Searching inside documents.
-* Slicing:: Specifying which part of pages should be displayed.
-* Conversion:: Influencing and triggering conversion.
+* Navigation: DocView Navigation. Navigating DocView buffers.
+* Searching: DocView Searching. Searching inside documents.
+* Slicing: DocView Slicing. Specifying which part of a page is displayed.
+* Conversion: DocView Conversion. Influencing and triggering conversion.
@end menu
-@node Navigation
-@subsection Navigation
+@node DocView Navigation
+@subsection DocView Navigation
-When in DocView mode, you can scroll the current page using the usual
+ In DocView mode, you can scroll the current page using the usual
Emacs movement keys: @kbd{C-p}, @kbd{C-n}, @kbd{C-b}, @kbd{C-f}, and
the arrow keys.
@@ -315,6 +324,10 @@ displays the next page if you are at the end of the current page.
@findex doc-view-next-page
@findex doc-view-previous-page
+@kindex n @r{(DocView mode)}
+@kindex p @r{(DocView mode)}
+@kindex C-x ] @r{(DocView mode)}
+@kindex C-x [ @r{(DocView mode)}
You can also display the next page by typing @kbd{n}, @key{next} or
@kbd{C-x ]} (@code{doc-view-next-page}). To display the previous
page, type @kbd{p}, @key{prior} or @kbd{C-x [}
@@ -322,23 +335,38 @@ page, type @kbd{p}, @key{prior} or @kbd{C-x [}
@findex doc-view-scroll-up-or-next-page
@findex doc-view-scroll-down-or-previous-page
- The @key{SPC} (@code{doc-view-scroll-up-or-next-page}) key is a
-convenient way to advance through the document. It scrolls within the
-current page or advances to the next. @key{DEL} moves backwards in a
-similar way (@code{doc-view-scroll-down-or-previous-page}).
+@kindex SPC @r{(DocView mode)}
+@kindex DEL @r{(DocView mode)}
+ @key{SPC} (@code{doc-view-scroll-up-or-next-page}) is a convenient
+way to advance through the document. It scrolls within the current
+page or advances to the next. @key{DEL} moves backwards in a similar
+way (@code{doc-view-scroll-down-or-previous-page}).
@findex doc-view-first-page
@findex doc-view-last-page
@findex doc-view-goto-page
+@kindex M-< @r{(DocView mode)}
+@kindex M-> @r{(DocView mode)}
To go to the first page, type @kbd{M-<}
(@code{doc-view-first-page}); to go to the last one, type @kbd{M->}
(@code{doc-view-last-page}). To jump to a page by its number, type
@kbd{M-g M-g} or @kbd{M-g g} (@code{doc-view-goto-page}).
-@node Searching
-@subsection Searching
-
-While in DocView mode, you can search the file's text for a regular
+@findex doc-view-enlarge
+@findex doc-view-shrink
+@vindex doc-view-resolution
+@kindex + @r{(DocView mode)}
+@kindex - @r{(DocView mode)}
+ You can enlarge or shrink the document with @kbd{+}
+(@code{doc-view-enlarge}) and @kbd{-} (@code{doc-view-shrink}). These
+commands work by reconverting the document at the new size. To
+specify the default size for DocView, customize the variable
+@code{doc-view-resolution}.
+
+@node DocView Searching
+@subsection DocView Searching
+
+ In DocView mode, you can search the file's text for a regular
expression (@pxref{Regexps}). The interface for searching is inspired
by @code{isearch} (@pxref{Incremental Search}).
@@ -359,8 +387,8 @@ To force display of this tooltip, type @kbd{C-t}
argument; i.e., @kbd{C-u C-s} for a forward search or @kbd{C-u C-r}
for a backward search.
-@node Slicing
-@subsection Slicing
+@node DocView Slicing
+@subsection DocView Slicing
Documents often have wide margins for printing. They are annoying
when reading the document on the screen, because they use up screen
@@ -383,67 +411,81 @@ m} (@code{doc-view-set-slice-using-mouse}), where you use the mouse to
select the slice.
@c ??? How does this work?
+ The most convenient way is to set the optimal slice by using
+BoundingBox information automatically determined from the document by
+typing @kbd{s b} (@code{doc-view-set-slice-using-mouse}).
+
@findex doc-view-reset-slice
To cancel the selected slice, type @kbd{s r}
(@code{doc-view-reset-slice}). Then DocView shows the entire page
including its entire margins.
-@node Conversion
-@subsection Conversion
+@node DocView Conversion
+@subsection DocView Conversion
@vindex doc-view-cache-directory
@findex doc-view-clear-cache
-For efficiency, DocView caches the images produced by @command{gs}.
+ For efficiency, DocView caches the images produced by @command{gs}.
The name of this directory is given by the variable
@code{doc-view-cache-directory}. You can clear the cache directory by
typing @code{M-x doc-view-clear-cache}.
@findex doc-view-kill-proc
@findex doc-view-kill-proc-and-buffer
- To force a reconversion of the currently viewed document, type
-@kbd{r} or @kbd{g} (@code{revert-buffer}). To kill the converter
-process associated with the current buffer, type @kbd{K}
+ To force reconversion of the currently viewed document, type @kbd{r}
+or @kbd{g} (@code{revert-buffer}). To kill the converter process
+associated with the current buffer, type @kbd{K}
(@code{doc-view-kill-proc}). The command @kbd{k}
(@code{doc-view-kill-proc-and-buffer}) kills the converter process and
the DocView buffer.
- The zoom commands @kbd{+} (@code{doc-view-enlarge}) and @kbd{-}
-(@code{doc-view-shrink}) need to reconvert the document at the new
-size. The current page is converted first.
-
@node Shell
@section Running Shell Commands from Emacs
@cindex subshell
@cindex shell commands
- Emacs has commands for passing single command lines to inferior shell
-processes; it can also run a shell interactively with input and output
-to an Emacs buffer named @samp{*shell*} or run a shell inside a terminal
+ Emacs has commands for passing single command lines to shell
+subprocesses, and for running a shell interactively with input and
+output to an Emacs buffer, and for running a shell in a terminal
emulator window.
@table @kbd
@item M-! @var{cmd} @key{RET}
-Run the shell command line @var{cmd} and display the output
+Run the shell command @var{cmd} and display the output
(@code{shell-command}).
@item M-| @var{cmd} @key{RET}
-Run the shell command line @var{cmd} with region contents as input;
+Run the shell command @var{cmd} with region contents as input;
optionally replace the region with the output
(@code{shell-command-on-region}).
@item M-& @var{cmd} @key{RET}
-Run the shell command line @var{cmd} asynchronously, and display the
-output (@code{async-shell-command}).
+Run the shell command @var{cmd} asynchronously, and display the output
+(@code{async-shell-command}).
@item M-x shell
-Run a subshell with input and output through an Emacs buffer.
-You can then give commands interactively.
+Run a subshell with input and output through an Emacs buffer. You can
+then give commands interactively.
@item M-x term
-Run a subshell with input and output through an Emacs buffer.
-You can then give commands interactively.
-Full terminal emulation is available.
+Run a subshell with input and output through an Emacs buffer. You can
+then give commands interactively. Full terminal emulation is
+available.
@end table
+@vindex exec-path
+ Whenever you specify a relative file name for an executable program
+(either in the @var{cmd} argument to one of the above commands, or in
+other contexts), Emacs searches for the program in the directories
+specified by the variable @code{exec-path}. The value of this
+variable must be a list of directory names; the default value is
+initialized from the environment variable @env{PATH} when Emacs is
+started (@pxref{General Variables}).
+
@kbd{M-x eshell} invokes a shell implemented entirely in Emacs. It
-is documented in a separate manual. @xref{Top,Eshell,Eshell, eshell,
-Eshell: The Emacs Shell}.
+is documented in its own manual.
+@ifnottex
+@xref{Top,Eshell,Eshell, eshell, Eshell: The Emacs Shell}.
+@end ifnottex
+@iftex
+See the Eshell Info manual, which is distributed with Emacs.
+@end iftex
@menu
* Single Shell:: How to run one shell command and return.
@@ -455,7 +497,6 @@ Eshell: The Emacs Shell}.
* Options: Shell Options. Options for customizing Shell mode.
* Terminal emulator:: An Emacs window as a terminal emulator.
* Term Mode:: Special Emacs commands used in Term mode.
-* Paging in Term:: Paging in the terminal emulator.
* Remote Host:: Connecting to another computer.
* Serial Terminal:: Connecting to a serial port.
@end menu
@@ -466,135 +507,133 @@ Eshell: The Emacs Shell}.
@kindex M-!
@findex shell-command
@kbd{M-!} (@code{shell-command}) reads a line of text using the
-minibuffer and executes it as a shell command in a subshell made just
+minibuffer and executes it as a shell command, in a subshell made just
for that command. Standard input for the command comes from the null
device. If the shell command produces any output, the output appears
either in the echo area (if it is short), or in an Emacs buffer named
-@samp{*Shell Command Output*}, which is displayed in another window
-but not selected (if the output is long).
-
- For instance, one way to decompress a file @file{foo.gz} from Emacs
-is to type @kbd{M-! gunzip foo.gz @key{RET}}. That shell command
-normally creates the file @file{foo} and produces no terminal output.
-
- A numeric argument, as in @kbd{M-1 M-!}, says to insert terminal
-output into the current buffer instead of a separate buffer. It puts
-point before the output, and sets the mark after the output. For
-instance, @kbd{M-1 M-! gunzip < foo.gz @key{RET}} would insert the
-uncompressed equivalent of @file{foo.gz} into the current buffer.
-
- If the shell command line ends in @samp{&}, it runs asynchronously.
-For a synchronous shell command, @code{shell-command} returns the
-command's exit status (0 means success), when it is called from a Lisp
-program. You do not get any status information for an asynchronous
-command, since it hasn't finished yet when @code{shell-command} returns.
-
- You can also type @kbd{M-&} (@code{async-shell-command}) to execute
-a shell command asynchronously. This behaves exactly like calling
-@code{shell-command} with @samp{&}, except that you do not need to add
-the @samp{&} to the shell command line.
+@file{*Shell Command Output*}, displayed in another window (if the
+output is long).
+
+ For instance, one way to decompress a file named @file{foo.gz} is to
+type @kbd{M-! gunzip foo.gz @key{RET}}. That shell command normally
+creates the file @file{foo} and produces no terminal output.
+
+ A numeric argument to @code{shell-command}, e.g.@: @kbd{M-1 M-!},
+causes it to insert terminal output into the current buffer instead of
+a separate buffer. It puts point before the output, and sets the mark
+after the output. For instance, @kbd{M-1 M-! gunzip < foo.gz
+@key{RET}} would insert the uncompressed form of the file
+@file{foo.gz} into the current buffer.
+
+ Provided the specified shell command does not end with @samp{&}, it
+runs @dfn{synchronously}, and you must wait for it to exit before
+continuing to use Emacs. To stop waiting, type @kbd{C-g} to quit;
+this sends a @code{SIGINT} signal to terminate the shell command (this
+is the same signal that @kbd{C-c} normally generates in the shell).
+Emacs then waits until the command actually terminates. If the shell
+command doesn't stop (because it ignores the @code{SIGINT} signal),
+type @kbd{C-g} again; this sends the command a @code{SIGKILL} signal,
+which is impossible to ignore.
+
+@kindex M-&
+@findex async-shell-command
+ A shell command that ends in @samp{&} is executed
+@dfn{asynchronously}, and you can continue to use Emacs as it runs.
+You can also type @kbd{M-&} (@code{async-shell-command}) to execute a
+shell command asynchronously; this is exactly like calling @kbd{M-!}
+with a trailing @samp{&}, except that you do not need the @samp{&}.
+The default output buffer for asynchronous shell commands is named
+@samp{*Async Shell Command*}. Emacs inserts the output into this
+buffer as it comes in, whether or not the buffer is visible in a
+window.
+
+@vindex async-shell-command-buffer
+ If you want to run more than one asynchronous shell command at the
+same time, they could end up competing for the output buffer. The
+option @code{async-shell-command-buffer} specifies what to do about
+this; e.g., whether to rename the pre-existing output buffer, or to
+use a different buffer for the new command. Consult the variable's
+documentation for more possibilities.
@kindex M-|
@findex shell-command-on-region
- @kbd{M-|} (@code{shell-command-on-region}) is like @kbd{M-!} but
+ @kbd{M-|} (@code{shell-command-on-region}) is like @kbd{M-!}, but
passes the contents of the region as the standard input to the shell
-command, instead of no input. With a numeric argument, meaning insert
-the output in the current buffer, it deletes the old region and the
-output replaces it as the contents of the region. It returns the
-command's exit status, like @kbd{M-!}.
-
- One use for @kbd{M-|} is to run @code{gpg} to see what keys are in
-the buffer. For instance, if the buffer contains a GPG key, type
-@kbd{C-x h M-| gpg @key{RET}} to feed the entire buffer contents to
-the @code{gpg} program. That program will ignore everything except
-the encoded keys, and will output a list of the keys the buffer
-contains.
+command, instead of no input. With a numeric argument, it deletes the
+old region and replaces it with the output from the shell command.
+
+ For example, you can use @kbd{M-|} with the @command{gpg} program to
+see what keys are in the buffer. If the buffer contains a GnuPG key,
+type @kbd{C-x h M-| gpg @key{RET}} to feed the entire buffer contents
+to @command{gpg}. This will output the list of keys to the
+@file{*Shell Command Output*} buffer.
@vindex shell-file-name
- Both @kbd{M-!} and @kbd{M-|} use @code{shell-file-name} to specify
-the shell to use. This variable is initialized based on your
+ The above commands use the shell specified by the variable
+@code{shell-file-name}. Its default value is determined by the
@env{SHELL} environment variable when Emacs is started. If the file
-name is relative, Emacs searches the directories in the list
-@code{exec-path}; this list is initialized based on the environment
-variable @env{PATH} when Emacs is started. Your init file can
-override either or both of these default initializations (@pxref{Init
-File}).
-
- Both @kbd{M-!} and @kbd{M-|} wait for the shell command to complete,
-unless you end the command with @samp{&} to make it asynchronous. To
-stop waiting, type @kbd{C-g} to quit; that terminates the shell
-command with the signal @code{SIGINT}---the same signal that @kbd{C-c}
-normally generates in the shell. Emacs then waits until the command
-actually terminates. If the shell command doesn't stop (because it
-ignores the @code{SIGINT} signal), type @kbd{C-g} again; this sends
-the command a @code{SIGKILL} signal which is impossible to ignore.
-
- Asynchronous commands ending in @samp{&} feed their output into
-the buffer @samp{*Async Shell Command*}. Output arrives in that
-buffer regardless of whether it is visible in a window.
+name is relative, Emacs searches the directories listed in
+@code{exec-path} (@pxref{Shell}).
To specify a coding system for @kbd{M-!} or @kbd{M-|}, use the command
@kbd{C-x @key{RET} c} immediately beforehand. @xref{Communication Coding}.
@vindex shell-command-default-error-buffer
- Error output from these commands is normally intermixed with the
-regular output. But if the variable
-@code{shell-command-default-error-buffer} has a string as value, and
-it's the name of a buffer, @kbd{M-!} and @kbd{M-|} insert error output
-before point in that buffer.
+ By default, error output is intermixed with the regular output in
+the output buffer. But if you change the value of the variable
+@code{shell-command-default-error-buffer} to a string, error output is
+inserted into a buffer of that name.
@node Interactive Shell
-@subsection Interactive Inferior Shell
+@subsection Interactive Subshell
@findex shell
- To run a subshell interactively, use @kbd{M-x shell}. This creates
-(or reuses) a buffer named @samp{*shell*} and runs a subshell with
-input coming from and output going to that buffer. That is to say,
-any ``terminal output'' from the subshell goes into the buffer,
-advancing point, and any ``terminal input'' for the subshell comes
-from text in the buffer. To give input to the subshell, go to the end
-of the buffer and type the input, terminated by @key{RET}.
-
- Emacs does not wait for the subshell to do anything. You can switch
-windows or buffers and edit them while the shell is waiting, or while it is
-running a command. Output from the subshell waits until Emacs has time to
-process it; this happens whenever Emacs is waiting for keyboard input or
-for time to elapse.
+ To run a subshell interactively, type @kbd{M-x shell}. This creates
+(or reuses) a buffer named @file{*shell*}, and runs a shell subprocess
+with input coming from and output going to that buffer. That is to
+say, any terminal output from the subshell goes into the buffer,
+advancing point, and any terminal input for the subshell comes from
+text in the buffer. To give input to the subshell, go to the end of
+the buffer and type the input, terminated by @key{RET}.
+
+ While the subshell is waiting or running a command, you can switch
+windows or buffers and perform other editing in Emacs. Emacs inserts
+the output from the subshell into the Shell buffer whenever it has
+time to process it (e.g.@: while waiting for keyboard input).
@cindex @code{comint-highlight-input} face
@cindex @code{comint-highlight-prompt} face
- Input lines, once you submit them, are displayed using the face
-@code{comint-highlight-input}, and prompts are displayed using the
-face @code{comint-highlight-prompt}. This makes it easier to see
-previous input lines in the buffer. @xref{Faces}.
-
- To make multiple subshells, you can invoke @kbd{M-x shell} with a
-prefix argument (e.g. @kbd{C-u M-x shell}), which will read a buffer
-name and create (or reuse) a subshell in that buffer. You can also
-rename the @samp{*shell*} buffer using @kbd{M-x rename-uniquely}, then
-create a new @samp{*shell*} buffer using plain @kbd{M-x shell}.
+ In the Shell buffer, prompts are displayed with the face
+@code{comint-highlight-prompt}, and submitted input lines are
+displayed with the face @code{comint-highlight-input}. This makes it
+easier to distinguish input lines from the shell output.
+@xref{Faces}.
+
+ To make multiple subshells, invoke @kbd{M-x shell} with a prefix
+argument (e.g. @kbd{C-u M-x shell}). Then the command will read a
+buffer name, and create (or reuse) a subshell in that buffer. You can
+also rename the @file{*shell*} buffer using @kbd{M-x rename-uniquely},
+then create a new @file{*shell*} buffer using plain @kbd{M-x shell}.
Subshells in different buffers run independently and in parallel.
@vindex explicit-shell-file-name
@cindex environment variables for subshells
@cindex @env{ESHELL} environment variable
@cindex @env{SHELL} environment variable
- The file name used to load the subshell is the value of the variable
-@code{explicit-shell-file-name}, if that is non-@code{nil}.
-Otherwise, the environment variable @env{ESHELL} is used, or the
-environment variable @env{SHELL} if there is no @env{ESHELL}. If the
-file name specified is relative, the directories in the list
-@code{exec-path} are searched; this list is initialized based on the
-environment variable @env{PATH} when Emacs is started. Your init file
-can override either or both of these default initializations.
-(@pxref{Init File}).
+ To specify the shell file name used by @kbd{M-x shell}, customize
+the variable @code{explicit-shell-file-name}. If this is @code{nil}
+(the default), Emacs uses the environment variable @env{ESHELL} if it
+exists. Otherwise, it usually uses the variable
+@code{shell-file-name} (@pxref{Single Shell}); but if the default
+directory is remote (@pxref{Remote Files}), it prompts you for the
+shell file name.
Emacs sends the new shell the contents of the file
@file{~/.emacs_@var{shellname}} as input, if it exists, where
@var{shellname} is the name of the file that the shell was loaded
from. For example, if you use bash, the file sent to it is
-@file{~/.emacs_bash}. If this file is not found, Emacs tries to fallback
-on @file{~/.emacs.d/init_@var{shellname}.sh}.
+@file{~/.emacs_bash}. If this file is not found, Emacs tries with
+@file{~/.emacs.d/init_@var{shellname}.sh}.
To specify a coding system for the shell, you can use the command
@kbd{C-x @key{RET} c} immediately before @kbd{M-x shell}. You can
@@ -603,44 +642,46 @@ also change the coding system for a running subshell by typing
Coding}.
@cindex @env{INSIDE_EMACS} environment variable
- Emacs sets the environment variable @env{INSIDE_EMACS} in the
-subshell to a comma-separated list including the Emacs version.
-Programs can check this variable to determine whether they are running
-inside an Emacs subshell.
-
@cindex @env{EMACS} environment variable
- Emacs also sets the @env{EMACS} environment variable (to @code{t}) if
-it is not already defined. @strong{Warning:} This environment
-variable is deprecated. Programs that check this variable should be
-changed to check @env{INSIDE_EMACS} instead.
+ Emacs sets the environment variable @env{INSIDE_EMACS} in the
+subshell to @samp{@var{version},comint}, where @var{version} is the
+Emacs version (e.g.@: @samp{24.1}). Programs can check this variable
+to determine whether they are running inside an Emacs subshell. (It
+also sets the @env{EMACS} environment variable to @code{t}, if that
+environment variable is not already defined. However, this
+environment variable is deprecated; programs that use it should switch
+to using @env{INSIDE_EMACS} instead.)
@node Shell Mode
@subsection Shell Mode
@cindex Shell mode
@cindex mode, Shell
- Shell buffers use Shell mode, which defines several special keys
-attached to the @kbd{C-c} prefix. They are chosen to resemble the usual
-editing and job control characters present in shells that are not under
-Emacs, except that you must type @kbd{C-c} first. Here is a complete list
-of the special key bindings of Shell mode:
+ The major mode for Shell buffers is Shell mode. Many of its special
+commands are bound to the @kbd{C-c} prefix, and resemble the usual
+editing and job control characters present in ordinary shells, except
+that you must type @kbd{C-c} first. Here is a list of Shell mode
+commands:
@table @kbd
@item @key{RET}
@kindex RET @r{(Shell mode)}
@findex comint-send-input
-At end of buffer send line as input; otherwise, copy current line to
-end of buffer and send it (@code{comint-send-input}). Copying a line
-in this way omits any prompt at the beginning of the line (text output
-by programs preceding your input). @xref{Shell Prompts}, for how
-Shell mode recognizes prompts.
+Send the current line as input to the subshell
+(@code{comint-send-input}). Any shell prompt at the beginning of the
+line is omitted (@pxref{Shell Prompts}). If point is at the end of
+buffer, this is like submitting the command line in an ordinary
+interactive shell. However, you can also invoke @key{RET} elsewhere
+in the shell buffer to submit the current line as input.
@item @key{TAB}
@kindex TAB @r{(Shell mode)}
-@findex comint-dynamic-complete
-Complete the command name or file name before point in the shell buffer
-(@code{comint-dynamic-complete}). @key{TAB} also completes history
-references (@pxref{History References}) and environment variable names.
+@findex completion-at-point
+Complete the command name or file name before point in the shell
+buffer (@code{completion-at-point}). This uses the usual Emacs
+completion rules (@pxref{Completion}), with the completion
+alternatives being file names, environment variable names, the shell
+command history, and history references (@pxref{History References}).
@vindex shell-completion-fignore
@vindex comint-completion-fignore
@@ -654,17 +695,16 @@ instead.
@item M-?
@kindex M-? @r{(Shell mode)}
@findex comint-dynamic-list-filename@dots{}
-Display temporarily a list of the possible completions of the file name
-before point in the shell buffer
-(@code{comint-dynamic-list-filename-completions}).
+Display temporarily a list of the possible completions of the file
+name before point (@code{comint-dynamic-list-filename-completions}).
@item C-d
@kindex C-d @r{(Shell mode)}
@findex comint-delchar-or-maybe-eof
Either delete a character or send @acronym{EOF}
(@code{comint-delchar-or-maybe-eof}). Typed at the end of the shell
-buffer, @kbd{C-d} sends @acronym{EOF} to the subshell. Typed at any other
-position in the buffer, @kbd{C-d} deletes a character as usual.
+buffer, this sends @acronym{EOF} to the subshell. Typed at any other
+position in the buffer, this deletes a character as usual.
@item C-c C-a
@kindex C-c C-a @r{(Shell mode)}
@@ -760,8 +800,8 @@ Move backward across one shell command, but not beyond the current line
(@code{shell-backward-command}).
@item M-x dirs
-Ask the shell what its current directory is, so that Emacs can agree
-with the shell.
+Ask the shell for its working directory, and update the Shell buffer's
+default directory. @xref{Directory Tracking}.
@item M-x send-invisible @key{RET} @var{text} @key{RET}
@findex send-invisible
@@ -830,41 +870,38 @@ specializations of Shell mode.
@node Shell Prompts
@subsection Shell Prompts
-@vindex shell-prompt-pattern
-@vindex comint-prompt-regexp
-@vindex comint-use-prompt-regexp
@cindex prompt, shell
A prompt is text output by a program to show that it is ready to
accept new user input. Normally, Comint mode (and thus Shell mode)
-considers the prompt to be any text output by a program at the
-beginning of an input line. However, if the variable
-@code{comint-use-prompt-regexp} is non-@code{nil}, then Comint mode
-uses a regular expression to recognize prompts. In Shell mode,
-@code{shell-prompt-pattern} specifies the regular expression.
-
- The value of @code{comint-use-prompt-regexp} also affects many
-motion and paragraph commands. If the value is non-@code{nil}, the
-general Emacs motion commands behave as they normally do in buffers
-without special text properties. However, if the value is @code{nil},
-the default, then Comint mode divides the buffer into two types of
-``fields'' (ranges of consecutive characters having the same
-@code{field} text property): input and output. Prompts are part of
-the output. Most Emacs motion commands do not cross field boundaries,
-unless they move over multiple lines. For instance, when point is in
-input on the same line as a prompt, @kbd{C-a} puts point at the
-beginning of the input if @code{comint-use-prompt-regexp} is
-@code{nil} and at the beginning of the line otherwise.
-
- In Shell mode, only shell prompts start new paragraphs. Thus, a
-paragraph consists of a prompt and the input and output that follow
-it. However, if @code{comint-use-prompt-regexp} is @code{nil}, the
-default, most paragraph commands do not cross field boundaries. This
-means that prompts, ranges of input, and ranges of non-prompt output
-behave mostly like separate paragraphs; with this setting, numeric
-arguments to most paragraph commands yield essentially undefined
-behavior. For the purpose of finding paragraph boundaries, Shell mode
-uses @code{shell-prompt-pattern}, regardless of
-@code{comint-use-prompt-regexp}.
+automatically figures out part of the buffer is a prompt, based on the
+output of the subprocess. (Specifically, it assumes that any received
+output line which doesn't end with a newline is a prompt.)
+
+ Comint mode divides the buffer into two types of @dfn{fields}: input
+fields (where user input is typed) and output fields (everywhere
+else). Prompts are part of the output fields. Most Emacs motion
+commands do not cross field boundaries, unless they move over multiple
+lines. For instance, when point is in the input field on a shell
+command line, @kbd{C-a} puts point at the beginning of the input
+field, after the prompt. Internally, the fields are implemented using
+the @code{field} text property (@pxref{Text Properties,,, elisp, the
+Emacs Lisp Reference Manual}).
+
+@vindex comint-use-prompt-regexp
+@vindex shell-prompt-pattern
+ If you change the variable @code{comint-use-prompt-regexp} to a
+non-@code{nil} value, then Comint mode recognize prompts using a
+regular expression (@pxref{Regexps}). In Shell mode, the regular
+expression is specified by the variable @code{shell-prompt-pattern}.
+The default value of @code{comint-use-prompt-regexp} is @code{nil},
+because this method for recognizing prompts is unreliable, but you may
+want to set it to a non-@code{nil} value in unusual circumstances. In
+that case, Emacs does not divide the Comint buffer into fields, so the
+general motion commands behave as they normally do in buffers without
+special text properties. However, you can use the paragraph motion
+commands to conveniently navigate the buffer (@pxref{Paragraphs}); in
+Shell mode, Emacs uses @code{shell-prompt-pattern} as paragraph
+boundaries.
@node Shell History
@subsection Shell Command History
@@ -921,11 +958,12 @@ Display the buffer's history of shell commands in another window
(@code{comint-dynamic-list-input-ring}).
@end table
- Shell buffers provide a history of previously entered shell commands. To
-reuse shell commands from the history, use the editing commands @kbd{M-p},
-@kbd{M-n}, @kbd{M-r} and @kbd{M-s}. These work just like the minibuffer
-history commands except that they operate on the text at the end of the
-shell buffer, where you would normally insert text to send to the shell.
+ Shell buffers provide a history of previously entered shell
+commands. To reuse shell commands from the history, use the editing
+commands @kbd{M-p}, @kbd{M-n}, @kbd{M-r} and @kbd{M-s}. These work
+just like the minibuffer history commands (@pxref{Minibuffer
+History}), except that they operate within the Shell buffer rather
+than the minibuffer.
@kbd{M-p} fetches an earlier shell command to the end of the shell
buffer. Successive use of @kbd{M-p} fetches successively earlier
@@ -1052,39 +1090,40 @@ command @code{comint-magic-space}.
@vindex shell-popd-regexp
@vindex shell-cd-regexp
Shell mode keeps track of @samp{cd}, @samp{pushd} and @samp{popd}
-commands given to the inferior shell, so it can keep the
-@samp{*shell*} buffer's default directory the same as the shell's
-working directory. It recognizes these commands syntactically, by
-examining lines of input that are sent.
+commands given to the subshell, in order to keep the Shell buffer's
+default directory (@pxref{File Names}) the same as the shell's working
+directory. It recognizes these commands by examining lines of input
+that you send.
If you use aliases for these commands, you can tell Emacs to
-recognize them also. For example, if the value of the variable
-@code{shell-pushd-regexp} matches the beginning of a shell command
-line, that line is regarded as a @code{pushd} command. Change this
-variable when you add aliases for @samp{pushd}. Likewise,
-@code{shell-popd-regexp} and @code{shell-cd-regexp} are used to
-recognize commands with the meaning of @samp{popd} and @samp{cd}.
-These commands are recognized only at the beginning of a shell command
-line.
-
-@ignore @c This seems to have been deleted long ago.
-@vindex shell-set-directory-error-hook
- If Emacs gets an error while trying to handle what it believes is a
-@samp{cd}, @samp{pushd} or @samp{popd} command, it runs the hook
-@code{shell-set-directory-error-hook} (@pxref{Hooks}).
-@end ignore
+recognize them also, by setting the variables
+@code{shell-pushd-regexp}, @code{shell-popd-regexp}, and
+@code{shell-cd-regexp} to the appropriate regular expressions
+(@pxref{Regexps}). For example, if @code{shell-pushd-regexp} matches
+the beginning of a shell command line, that line is regarded as a
+@code{pushd} command. These commands are recognized only at the
+beginning of a shell command line.
@findex dirs
- If Emacs gets confused about changes in the current directory of the
-subshell, use the command @kbd{M-x dirs} to ask the shell what its
-current directory is. This command works for shells that support the
-most common command syntax; it may not work for unusual shells.
+ If Emacs gets confused about changes in the working directory of the
+subshell, type @kbd{M-x dirs}. This command asks the shell for its
+working directory and updates the default directory accordingly. It
+works for shells that support the most common command syntax, but may
+not work for unusual shells.
@findex dirtrack-mode
- You can also use @kbd{M-x dirtrack-mode} to enable (or disable) an
-alternative method of tracking changes in the current directory. This
-method relies on your shell prompt containing the full current working
-directory at all times.
+@cindex Dirtrack mode
+@cindex mode, Dirtrack
+@vindex dirtrack-list
+ You can also use Dirtrack mode, a buffer-local minor mode that
+implements an alternative method of tracking the shell's working
+directory. To use this method, your shell prompt must contain the
+working directory at all times, and you must supply a regular
+expression for recognizing which part of the prompt contains the
+working directory; see the documentation of the variable
+@code{dirtrack-list} for details. To use Dirtrack mode, type @kbd{M-x
+dirtrack-mode} in the Shell buffer, or add @code{dirtrack-mode} to
+@code{shell-mode-hook} (@pxref{Hooks}).
@node Shell Options
@subsection Shell Mode Options
@@ -1155,37 +1194,46 @@ underlying shell, of course.
@subsection Emacs Terminal Emulator
@findex term
- To run a subshell in a terminal emulator, use @kbd{M-x term}. This
-creates (or reuses) a buffer named @samp{*terminal*}, and runs a
+ To run a subshell in a text terminal emulator, use @kbd{M-x term}.
+This creates (or reuses) a buffer named @file{*terminal*}, and runs a
subshell with input coming from your keyboard, and output going to
that buffer.
+@cindex line mode @r{(terminal emulator)}
+@cindex char mode @r{(terminal emulator)}
The terminal emulator uses Term mode, which has two input modes. In
-line mode, Term basically acts like Shell mode; see @ref{Shell Mode}.
-
- In char mode, each character is sent directly to the inferior
-subshell, as ``terminal input.'' Any ``echoing'' of your input is the
-responsibility of the subshell. The sole exception is the terminal
-escape character, which by default is @kbd{C-c} (@pxref{Term Mode}).
-Any ``terminal output'' from the subshell goes into the buffer,
-advancing point.
+@dfn{line mode}, Term basically acts like Shell mode (@pxref{Shell
+Mode}). In @dfn{char mode}, each character is sent directly to the
+subshell, as terminal input; the sole exception is the terminal escape
+character, which by default is @kbd{C-c} (@pxref{Term Mode}). Any
+echoing of your input is the responsibility of the subshell; any
+terminal output from the subshell goes into the buffer, advancing
+point.
Some programs (such as Emacs itself) need to control the appearance
-on the terminal screen in detail. They do this by sending special
-control codes. The exact control codes needed vary from terminal to
-terminal, but nowadays most terminals and terminal emulators
-(including @code{xterm}) understand the ANSI-standard (VT100-style)
-escape sequences. Term mode recognizes these escape sequences, and
-handles each one appropriately, changing the buffer so that the
-appearance of the window matches what it would be on a real terminal.
-You can actually run Emacs inside an Emacs Term window.
-
- You can use Term mode to communicate with a device connected to a
-serial port of your computer. @xref{Serial Terminal}.
+of the terminal screen in detail. They do this by emitting special
+control codes. Term mode recognizes and handles ANSI-standard
+VT100-style escape sequences, which are accepted by most modern
+terminals, including @command{xterm}. (Hence, you can actually run
+Emacs inside an Emacs Term window.)
+
+ The @code{term} face specifies the default appearance of text
+in the terminal emulator (the default is the same appearance as the
+@code{default} face). When terminal control codes are used to change
+the appearance of text, these are represented in the terminal emulator
+by the faces @code{term-color-black}, @code{term-color-red},
+@code{term-color-green}, @code{term-color-yellow}
+@code{term-color-blue}, @code{term-color-magenta},
+@code{term-color-cyan}, @code{term-color-white},
+@code{term-color-underline}, and @code{term-color-bold}.
+@xref{Faces}.
+
+ You can also Term mode to communicate with a device connected to a
+serial port. @xref{Serial Terminal}.
The file name used to load the subshell is determined the same way
as for Shell mode. To make multiple terminal emulators, rename the
-buffer @samp{*terminal*} to something different using @kbd{M-x
+buffer @file{*terminal*} to something different using @kbd{M-x
rename-uniquely}, just as with Shell mode.
Unlike Shell mode, Term mode does not track the current directory by
@@ -1193,28 +1241,33 @@ examining your input. But some shells can tell Term what the current
directory is. This is done automatically by @code{bash} version 1.15
and later.
+
+
+
@node Term Mode
@subsection Term Mode
@cindex Term mode
@cindex mode, Term
The terminal emulator uses Term mode, which has two input modes. In
-line mode, Term basically acts like Shell mode; see @ref{Shell Mode}.
-In char mode, each character is sent directly to the inferior
-subshell, except for the Term escape character, normally @kbd{C-c}.
+line mode, Term basically acts like Shell mode (@pxref{Shell Mode}).
+In char mode, each character is sent directly to the subshell, except
+for the Term escape character, normally @kbd{C-c}.
To switch between line and char mode, use these commands:
@table @kbd
@kindex C-c C-j @r{(Term mode)}
-@findex term-char-mode
+@findex term-line-mode
@item C-c C-j
-Switch to line mode. Do nothing if already in line mode.
+Switch to line mode (@code{term-line-mode}). Do nothing if already in
+line mode.
@kindex C-c C-k @r{(Term mode)}
-@findex term-line-mode
+@findex term-char-mode
@item C-c C-k
-Switch to char mode. Do nothing if already in char mode.
+Switch to char mode (@code{term-char-mode}). Do nothing if already in
+char mode.
@end table
The following commands are only available in char mode:
@@ -1229,28 +1282,23 @@ example, @kbd{C-c o} invokes the global binding of @kbd{C-x o}, which
is normally @samp{other-window}.
@end table
-@node Paging in Term
-@subsection Page-At-A-Time Output
-@cindex page-at-a-time
-
- Term mode has a page-at-a-time feature. When enabled it makes
-output pause at the end of each screenful.
+@cindex paging in Term mode
+ Term mode has a page-at-a-time feature. When enabled, it makes
+output pause at the end of each screenful:
@table @kbd
@kindex C-c C-q @r{(Term mode)}
@findex term-pager-toggle
@item C-c C-q
Toggle the page-at-a-time feature. This command works in both line
-and char modes. When page-at-a-time is enabled, the mode-line
-displays the word @samp{page}.
+and char modes. When the feature is enabled, the mode-line displays
+the word @samp{page}, and each time Term receives more than a
+screenful of output, it pauses and displays @samp{**MORE**} in the
+mode-line. Type @key{SPC} to display the next screenful of output, or
+@kbd{?} to see your other options. The interface is similar to the
+@code{more} program.
@end table
- With page-at-a-time enabled, whenever Term receives more than a
-screenful of output since your last input, it pauses, displaying
-@samp{**MORE**} in the mode-line. Type @key{SPC} to display the next
-screenful of output. Type @kbd{?} to see your other options. The
-interface is similar to the @code{more} program.
-
@node Remote Host
@subsection Remote Host Shell
@cindex remote host
@@ -1273,71 +1321,8 @@ happens automatically; there is no special password processing.)
of terminal you're using, by setting the @env{TERM} environment
variable in the environment for the remote login command. (If you use
bash, you do that by writing the variable assignment before the remote
-login command, without separating comma.) Terminal types @samp{ansi}
-or @samp{vt100} will work on most systems.
-
-@c If you are talking to a Bourne-compatible
-@c shell, and your system understands the @env{TERMCAP} variable,
-@c you can use the command @kbd{M-x shell-send-termcap}, which
-@c sends a string specifying the terminal type and size.
-@c (This command is also useful after the window has changed size.)
-
-@c You can of course run @samp{gdb} on that remote computer. One useful
-@c trick: If you invoke gdb with the @code{--fullname} option,
-@c it will send special commands to Emacs that will cause Emacs to
-@c pop up the source files you're debugging. This will work
-@c whether or not gdb is running on a different computer than Emacs,
-@c as long as Emacs can access the source files specified by gdb.
-
-@ignore
- You cannot log in to a remote computer using the Shell mode.
-@c (This will change when Shell is re-written to use Term.)
-Instead, Emacs provides two commands for logging in to another computer
-and communicating with it through an Emacs buffer using Comint mode:
-
-@table @kbd
-@item M-x telnet @key{RET} @var{hostname} @key{RET}
-Set up a Telnet connection to the computer named @var{hostname}.
-@item M-x rlogin @key{RET} @var{hostname} @key{RET}
-Set up an Rlogin connection to the computer named @var{hostname}.
-@end table
-
-@findex telnet
- Use @kbd{M-x telnet} to set up a Telnet connection to another
-computer. (Telnet is the standard Internet protocol for remote login.)
-It reads the host name of the other computer as an argument with the
-minibuffer. Once the connection is established, talking to the other
-computer works like talking to a subshell: you can edit input with the
-usual Emacs commands, and send it a line at a time by typing @key{RET}.
-The output is inserted in the Telnet buffer interspersed with the input.
-
-@findex rlogin
-@vindex rlogin-explicit-args
- Use @kbd{M-x rlogin} to set up an Rlogin connection. Rlogin is
-another remote login communication protocol, essentially much like the
-Telnet protocol but incompatible with it, and supported only by certain
-systems. Rlogin's advantages are that you can arrange not to have to
-give your user name and password when communicating between two machines
-you frequently use, and that you can make an 8-bit-clean connection.
-(To do that in Emacs, set @code{rlogin-explicit-args} to @code{("-8")}
-before you run Rlogin.)
-
- @kbd{M-x rlogin} sets up the default file directory of the Emacs
-buffer to access the remote host via FTP (@pxref{File Names}), and it
-tracks the shell commands that change the current directory, just like
-Shell mode.
-
-@findex rlogin-directory-tracking-mode
- There are two ways of doing directory tracking in an Rlogin
-buffer---either with remote directory names
-@file{/@var{host}:@var{dir}/} or with local names (that works if the
-``remote'' machine shares file systems with your machine of origin).
-You can use the command @code{rlogin-directory-tracking-mode} to switch
-modes. No argument means use remote directory names, a positive
-argument means use local names, and a negative argument means turn
-off directory tracking.
-
-@end ignore
+login command, without a separating comma.) Terminal types
+@samp{ansi} or @samp{vt100} will work on most systems.
@node Serial Terminal
@subsection Serial Terminal
@@ -1345,9 +1330,10 @@ off directory tracking.
@findex serial-term
If you have a device connected to a serial port of your computer,
-you can use Emacs to communicate with it. @kbd{M-x serial-term} will
-ask you for a serial port name and speed and will then open a new
-window in @ref{Term Mode}.
+you can communicate with it by typing @kbd{M-x serial-term}. This
+command asks for a serial port name and speed, and switches to a new
+Term mode buffer. Emacs communicates with the serial device through
+this buffer just like it does with a terminal in ordinary Term mode.
The speed of the serial port is measured in bits per second. The
most common speed is 9600 bits per second. You can change the speed
@@ -1358,27 +1344,25 @@ the mode line. By default, a serial port is configured as ``8N1'',
which means that each byte consists of 8 data bits, No parity check
bit, and 1 stopbit.
- When you have opened the serial port connection, you will see output
-from the device in the window. Also, what you type in the window is
-sent to the device.
-
If the speed or the configuration is wrong, you cannot communicate
with your device and will probably only see garbage output in the
window.
-@node Emacs Server, Printing, Shell, Top
+@node Emacs Server
@section Using Emacs as a Server
@pindex emacsclient
@cindex Emacs as a server
@cindex server, using Emacs as
@cindex @env{EDITOR} environment variable
- Various programs such as @command{mail} can invoke your choice of
-editor to edit a particular piece of text, such as a message that you
-are sending. By convention, most of these programs use the
-environment variable @env{EDITOR} to specify which editor to run. If
-you set @env{EDITOR} to @samp{emacs}, they invoke Emacs---but in an
-inconvenient way, by starting a new Emacs process. This is
+ Various programs can invoke your choice of editor to edit a
+particular piece of text. For instance, version control programs
+invoke an editor to enter version control logs (@pxref{Version
+Control}), and the Unix @command{mail} utility invokes an editor to
+enter a message to send. By convention, your choice of editor is
+specified by the environment variable @env{EDITOR}. If you set
+@env{EDITOR} to @samp{emacs}, Emacs would be invoked, but in an
+inconvenient way---by starting a new Emacs process. This is
inconvenient because the new Emacs process doesn't share buffers, a
command history, or other kinds of information with any existing Emacs
process.
@@ -1387,30 +1371,33 @@ process.
server}, so that it ``listens'' for external edit requests and acts
accordingly. There are two ways to start an Emacs server:
+@itemize
@findex server-start
- The first is to run the command @code{server-start} in an existing
-Emacs process: either type @kbd{M-x server-start}, or put the
-expression @code{(server-start)} in your initialization file
-(@pxref{Init File}). The existing Emacs process is the server; when
-you exit Emacs, the server dies with the Emacs process.
+@item
+Run the command @code{server-start} in an existing Emacs process:
+either type @kbd{M-x server-start}, or put the expression
+@code{(server-start)} in your init file (@pxref{Init File}). The
+existing Emacs process is the server; when you exit Emacs, the server
+dies with the Emacs process.
@cindex daemon, Emacs
- The second way to start an Emacs server is to run Emacs as a
-@dfn{daemon}, using the @samp{--daemon} command-line option.
-@xref{Initial Options}. When Emacs is started this way, it calls
-@code{server-start} after initialization, and returns control to the
-calling terminal instead of opening an initial frame; it then waits in
-the background, listening for edit requests.
+@item
+Run Emacs as a @dfn{daemon}, using the @samp{--daemon} command-line
+option. @xref{Initial Options}. When Emacs is started this way, it
+calls @code{server-start} after initialization, and returns control to
+the calling terminal instead of opening an initial frame; it then
+waits in the background, listening for edit requests.
+@end itemize
@cindex @env{TEXEDIT} environment variable
- Once an Emacs server is set up, you can use a shell command called
-@command{emacsclient} to connect to the existing Emacs process and
-tell it to visit a file. If you set the @env{EDITOR} environment
-variable to @samp{emacsclient}, programs such as @command{mail} will
-use the existing Emacs process for editing.@footnote{Some programs use
-a different environment variable; for example, to make @TeX{} use
-@samp{emacsclient}, set the @env{TEXEDIT} environment variable to
-@samp{emacsclient +%d %s}.}
+ Either way, once an Emacs server is started, you can use a shell
+command called @command{emacsclient} to connect to the Emacs process
+and tell it to visit a file. You can then set the @env{EDITOR}
+environment variable to @samp{emacsclient}, so that external programs
+will use the existing Emacs process for editing.@footnote{Some
+programs use a different environment variable; for example, to make
+@TeX{} use @samp{emacsclient}, set the @env{TEXEDIT} environment
+variable to @samp{emacsclient +%d %s}.}
@vindex server-name
You can run multiple Emacs servers on the same machine by giving
@@ -1421,13 +1408,13 @@ server-name @key{RET} foo @key{RET}} sets the server name to
name, using the @samp{-s} option (@pxref{emacsclient Options}).
@findex server-eval-at
- If you have defined a server by a unique server name, you can
-connect to this server from other Emacs instances and evaluate forms
-on it by using the @code{server-eval-at} function.
-
-@code{(server-eval-at "foo" '(+ 1 2))} gives the result @code{3}, if
-there's a server with that name that is listening. If not, an error
-will be signaled.
+ If you have defined a server by a unique server name, it is possible
+to connect to the server from another Emacs instance and evaluate Lisp
+expressions on the server, using the @code{server-eval-at} function.
+For instance, @code{(server-eval-at "foo" '(+ 1 2))} evaluates the
+expression @code{(+ 1 2)} on the @samp{foo} server, and returns
+@code{3}. (If there is no server with that name, an error is
+signaled.) Currently, this feature is mainly useful for developers.
@menu
* Invoking emacsclient:: Connecting to the Emacs server.
@@ -1442,7 +1429,7 @@ will be signaled.
the shell command @samp{emacsclient @var{file}}, where @var{file} is a
file name. This connects to an Emacs server, and tells that Emacs
process to visit @var{file} in one of its existing frames---either a
-graphical frame, or one in a text-only terminal (@pxref{Frames}). You
+graphical frame, or one in a text terminal (@pxref{Frames}). You
can then select that frame to begin editing.
If there is no Emacs server, the @command{emacsclient} program halts
@@ -1452,12 +1439,12 @@ Server})---then Emacs opens a frame on the terminal in which you
called @command{emacsclient}.
You can also force @command{emacsclient} to open a new frame on a
-graphical display, or on a text-only terminal, using the @samp{-c} and
+graphical display, or on a text terminal, using the @samp{-c} and
@samp{-t} options. @xref{emacsclient Options}.
- If you are running on a single text-only terminal, you can switch
-between @command{emacsclient}'s shell and the Emacs server using one
-of two methods: (i) run the Emacs server and @command{emacsclient} on
+ If you are running on a single text terminal, you can switch between
+@command{emacsclient}'s shell and the Emacs server using one of two
+methods: (i) run the Emacs server and @command{emacsclient} on
different virtual terminals, and switch to the Emacs server's virtual
terminal after calling @command{emacsclient}; or (ii) call
@command{emacsclient} from within the Emacs server itself, using Shell
@@ -1539,16 +1526,27 @@ The environment variable @env{ALTERNATE_EDITOR} has the same effect as
the @samp{-a} option. If both are present, the latter takes
precedence.
+@cindex client frame
@item -c
-Create a new graphical frame, instead of using an existing Emacs
-frame. Emacs 23 can create a graphical frame even if it was started
-in a text-only terminal, provided it is able to connect to a graphical
-display. If no graphical display is available, Emacs creates a new
-text-only terminal frame (@pxref{Frames}). If you omit a filename
-argument while supplying the @samp{-c} option, the new frame displays
-the @samp{*scratch*} buffer (@pxref{Buffers}).
-
-@item -F
+Create a new graphical @dfn{client frame}, instead of using an
+existing Emacs frame. See below for the special behavior of @kbd{C-x
+C-c} in a client frame. If Emacs cannot create a new graphical frame
+(e.g.@: if it cannot connect to the X server), it tries to create a
+text terminal client frame, as though you had supplied the @samp{-t}
+option instead.
+
+On MS-Windows, a single Emacs session cannot display frames on both
+graphical and text terminals, nor on multiple text terminals. Thus,
+if the Emacs server is running on a text terminal, the @samp{-c}
+option, like the @samp{-t} option, creates a new frame in the server's
+current text terminal. @xref{Windows Startup}.
+
+If you omit a filename argument while supplying the @samp{-c} option,
+the new frame displays the @file{*scratch*} buffer by default. If
+@code{initial-buffer-choice} is a string (@pxref{Entering Emacs}), the
+new frame displays that file or directory instead.
+
+@item -F @var{alist}
@itemx --frame-parameters=@var{alist}
Set the parameters for a newly-created graphical frame
(@pxref{Frame Parameters}).
@@ -1568,38 +1566,24 @@ evaluate, @emph{not} as a list of files to visit.
@item -f @var{server-file}
@itemx --server-file=@var{server-file}
@cindex @env{EMACS_SERVER_FILE} environment variable
-@cindex server file
-@vindex server-use-tcp
-@vindex server-host
Specify a @dfn{server file} for connecting to an Emacs server via TCP.
An Emacs server usually uses an operating system feature called a
``local socket'' to listen for connections. Some operating systems,
such as Microsoft Windows, do not support local sockets; in that case,
-Emacs uses TCP instead. When you start the Emacs server, Emacs
-creates a server file containing some TCP information that
-@command{emacsclient} needs for making the connection. By default,
-the server file is in @file{~/.emacs.d/server/}. On Microsoft
-Windows, if @command{emacsclient} does not find the server file there,
-it looks in the @file{.emacs.d/server/} subdirectory of the directory
-pointed to by the @env{APPDATA} environment variable. You can tell
-@command{emacsclient} to use a specific server file with the @samp{-f}
-or @samp{--server-file} option, or by setting the
-@env{EMACS_SERVER_FILE} environment variable.
-
-Even if local sockets are available, you can tell Emacs to use TCP by
-setting the variable @code{server-use-tcp} to @code{t}. One advantage
-of TCP is that the server can accept connections from remote machines.
-For this to work, you must (i) set the variable @code{server-host} to
-the hostname or IP address of the machine on which the Emacs server
-runs, and (ii) provide @command{emacsclient} with the server file.
-(One convenient way to do the latter is to put the server file on a
-networked file system such as NFS.)
+the server communicates with @command{emacsclient} via TCP.
+@vindex server-auth-dir
+@cindex server file
@vindex server-port
- When the Emacs server is using TCP, the variable @code{server-port}
-determines the port number to listen on; the default value,
-@code{nil}, means to choose a random port when the server starts.
+When you start a TCP Emacs server, Emacs creates a @dfn{server file}
+containing the TCP information to be used by @command{emacsclient} to
+connect to the server. The variable @code{server-auth-dir} specifies
+the directory containing the server file; by default, this is
+@file{~/.emacs.d/server/}. To tell @command{emacsclient} to connect
+to the server over TCP with a specific server file, use the @samp{-f}
+or @samp{--server-file} option, or set the @env{EMACS_SERVER_FILE}
+environment variable.
@item -n
@itemx --no-wait
@@ -1628,48 +1612,64 @@ server it finds. (This option is not supported on MS-Windows.)
@item -t
@itemx --tty
@itemx -nw
-Create a new Emacs frame on the current text-only terminal, instead of
-using an existing Emacs frame. Emacs 23 can open a text-only terminal
-even if it was started in another text-only terminal, or on a
-graphical display. If you omit a filename argument while supplying
-this option, the new frame displays the @samp{*scratch*} buffer.
-@xref{Buffers}.
+Create a new client frame on the current text terminal, instead of
+using an existing Emacs frame. This behaves just like the @samp{-c}
+option, described above, except that it creates a text terminal frame
+(@pxref{Non-Window Terminals}).
+
+On MS-Windows, @samp{-t} behaves just like @samp{-c} if the Emacs
+server is using the graphical display, but if the Emacs server is
+running on a text terminal, it creates a new frame in the current text
+terminal.
@end table
- If you type @kbd{C-x C-c} (@code{save-buffers-kill-terminal}) in an
-Emacs frame created with @command{emacsclient}, via the @samp{-c} or
-@samp{-t} options, Emacs deletes the frame instead of killing the
-Emacs process itself. On a text-only terminal frame created with the
-@samp{-t} option, this returns control to the terminal. Emacs also
-marks all the server buffers for the client as finished, as though you
-had typed @kbd{C-x #} in all of them.
-
- When Emacs is started as a daemon, all frames are considered client
-frames, so @kbd{C-x C-c} will never kill Emacs. To kill the Emacs
-process, type @kbd{M-x kill-emacs}.
-
-@node Printing, Sorting, Emacs Server, Top
+ The new graphical or text terminal frames created by the @samp{-c}
+or @samp{-t} options are considered @dfn{client frames}. Any new
+frame that you create from a client frame is also considered a client
+frame. If you type @kbd{C-x C-c} (@code{save-buffers-kill-terminal})
+in a client frame, that command does not kill the Emacs session as it
+normally does (@pxref{Exiting}). Instead, Emacs deletes the client
+frame; furthermore, if the client frame has an @command{emacsclient}
+waiting to regain control (i.e.@: if you did not supply the @samp{-n}
+option), Emacs deletes all other frames of the same client, and marks
+the client's server buffers as finished, as though you had typed
+@kbd{C-x #} in all of them. If it so happens that there are no
+remaining frames after the client frame(s) are deleted, the Emacs
+session exits.
+
+ As an exception, when Emacs is started as a daemon, all frames are
+considered client frames, and @kbd{C-x C-c} never kills Emacs. To
+kill a daemon session, type @kbd{M-x kill-emacs}.
+
+ Note that the @samp{-t} and @samp{-n} options are contradictory:
+@samp{-t} says to take control of the current text terminal to create
+a new client frame, while @samp{-n} says not to take control of the
+text terminal. If you supply both options, Emacs visits the specified
+files(s) in an existing frame rather than a new client frame, negating
+the effect of @samp{-t}.
+
+@node Printing
@section Printing Hard Copies
@cindex hardcopy
@cindex printing
- Emacs provides commands for printing hard copies of either an entire
-buffer or just part of one, with or without page headers. You can
-invoke the printing commands directly, as detailed in the following
-section, or using the @samp{File} menu on the menu bar.
+ Emacs provides commands for printing hardcopies of either an entire
+buffer or part of one. You can invoke the printing commands directly,
+as detailed below, or using the @samp{File} menu on the menu bar.
@findex htmlfontify-buffer
Aside from the commands described in this section, you can also
-``print'' an Emacs buffer to HTML with @kbd{M-x htmlfontify-buffer}.
-This command converts the current buffer to a HTML file, replacing
-Emacs faces with CSS-based markup. In addition, see the hardcopy
-commands of Dired (@pxref{Misc File Ops}) and the diary
-(@pxref{Displaying the Diary}).
+print hardcopies from Dired (@pxref{Operating on Files}) and the diary
+(@pxref{Displaying the Diary}). You can also ``print'' an Emacs
+buffer to HTML with the command @kbd{M-x htmlfontify-buffer}, which
+converts the current buffer to a HTML file, replacing Emacs faces with
+CSS-based markup. Furthermore, Org mode allows you to ``print'' Org
+files to a variety of formats, such as PDF (@pxref{Org Mode}).
@table @kbd
@item M-x print-buffer
-Print hardcopy of current buffer with page headings containing the file
-name and page number.
+Print hardcopy of current buffer with page headings containing the
+file name and page number.
@item M-x lpr-buffer
Print hardcopy of current buffer without page headings.
@item M-x print-region
@@ -1683,33 +1683,32 @@ Like @code{lpr-buffer} but print only the current region.
@findex lpr-buffer
@findex lpr-region
@vindex lpr-switches
- The hardcopy commands (aside from the PostScript commands) pass extra
-switches to the @code{lpr} program based on the value of the variable
-@code{lpr-switches}. Its value should be a list of strings, each string
-an option starting with @samp{-}. For example, to specify a line width
-of 80 columns for all the printing you do in Emacs, set
-@code{lpr-switches} like this:
-
-@example
-(setq lpr-switches '("-w80"))
-@end example
+@vindex lpr-commands
+ On most operating system, the above hardcopy commands submit files
+for printing by calling the @command{lpr} program. To change the
+printer program, customize the variable @code{lpr-command}. To
+specify extra switches to give the printer program, customize the list
+variable @code{lpr-switches}. Its value should be a list of option
+strings, each of which should start with @samp{-} (e.g.@: the option
+string @code{"-w80"} specifies a line width of 80 columns). The
+default is the empty list, @code{nil}.
@vindex printer-name
- You can specify the printer to use by setting the variable
-@code{printer-name}.
+@vindex lpr-printer-switch
+ To specify the printer to use, set the variable @code{printer-name}.
+The default, @code{nil}, specifies the default printer. If you set it
+to a printer name (a string), that name is passed to @command{lpr}
+with the @samp{-P} switch; if you are not using @command{lpr}, you
+should specify the switch with @code{lpr-printer-switch}.
@vindex lpr-headers-switches
-@vindex lpr-commands
@vindex lpr-add-switches
- The variable @code{lpr-command} specifies the name of the printer
-program to run; the default value depends on your operating system type.
-On most systems, the default is @code{"lpr"}. The variable
-@code{lpr-headers-switches} similarly specifies the extra switches to
-use to make page headers. The variable @code{lpr-add-switches} controls
-whether to supply @samp{-T} and @samp{-J} options (suitable for
-@code{lpr}) to the printer program: @code{nil} means don't add them.
-@code{lpr-add-switches} should be @code{nil} if your printer program is
-not compatible with @code{lpr}.
+ The variable @code{lpr-headers-switches} similarly specifies the
+extra switches to use to make page headers. The variable
+@code{lpr-add-switches} controls whether to supply @samp{-T} and
+@samp{-J} options (suitable for @command{lpr}) to the printer program:
+@code{nil} means don't add them (this should be the value if your
+printer program is not compatible with @command{lpr}).
@menu
* PostScript:: Printing buffers or regions as PostScript.
@@ -1717,7 +1716,7 @@ not compatible with @code{lpr}.
* Printing Package:: An optional advanced printing interface.
@end menu
-@node PostScript, PostScript Variables,, Printing
+@node PostScript
@subsection PostScript Hardcopy
These commands convert buffer contents to PostScript,
@@ -1752,28 +1751,17 @@ Generate/print PostScript for the current buffer as if handwritten.
@findex ps-print-buffer
@findex ps-print-region-with-faces
@findex ps-print-buffer-with-faces
- The PostScript commands, @code{ps-print-buffer} and
-@code{ps-print-region}, print buffer contents in PostScript form. One
-command prints the entire buffer; the other, just the region. The
-corresponding @samp{-with-faces} commands,
-@code{ps-print-buffer-with-faces} and @code{ps-print-region-with-faces},
-use PostScript features to show the faces (fonts and colors) in the text
-properties of the text being printed. The @samp{-with-faces} commands only
-work if they are used in a window system, so it has a way to determine color
-values.
+ The @code{ps-print-buffer} and @code{ps-print-region} commands print
+buffer contents in PostScript form. One command prints the entire
+buffer; the other, just the region. The commands
+@code{ps-print-buffer-with-faces} and
+@code{ps-print-region-with-faces} behave similarly, but use PostScript
+features to show the faces (fonts and colors) of the buffer text.
Interactively, when you use a prefix argument (@kbd{C-u}), the command
prompts the user for a file name, and saves the PostScript image in that file
instead of sending it to the printer.
- Noninteractively, the argument @var{filename} is treated as follows: if it is
-@code{nil}, send the image to the printer. If @var{filename} is a string, save
-the PostScript image in a file with that name.
-
- If you are using a color display, you can print a buffer of program
-code with color highlighting by turning on Font-Lock mode in that
-buffer, and using @code{ps-print-buffer-with-faces}.
-
@findex ps-spool-region
@findex ps-spool-buffer
@findex ps-spool-region-with-faces
@@ -1782,32 +1770,22 @@ buffer, and using @code{ps-print-buffer-with-faces}.
generate the PostScript output in an Emacs buffer instead of sending
it to the printer.
- Use the command @code{ps-despool} to send the spooled images to the printer.
-
@findex ps-despool
- This command sends the PostScript generated by @samp{-spool-} commands (see
-commands above) to the printer.
-
- Interactively, when you use a prefix argument (@kbd{C-u}), the command
-prompts the user for a file name, and saves the spooled PostScript image in
-that file instead of sending it to the printer.
-
- Noninteractively, the argument @var{filename} is treated as follows: if it is
-@code{nil}, send the image to the printer. If @var{filename} is a string, save
-the PostScript image in a file with that name.
+ Use the command @code{ps-despool} to send the spooled images to the
+printer. This command sends the PostScript generated by
+@samp{-spool-} commands (see commands above) to the printer. With a
+prefix argument (@kbd{C-u}), it prompts for a file name, and saves the
+spooled PostScript image in that file instead of sending it to the
+printer.
@findex handwrite
@cindex handwriting
-@kbd{M-x handwrite} is more frivolous. It generates a PostScript
+ @kbd{M-x handwrite} is more frivolous. It generates a PostScript
rendition of the current buffer as a cursive handwritten document. It
can be customized in group @code{handwrite}. This function only
supports ISO 8859-1 characters.
-@ifnottex
- The following section describes variables for customizing these commands.
-@end ifnottex
-
-@node PostScript Variables, Printing Package, PostScript, Printing
+@node PostScript Variables
@subsection Variables for PostScript Hardcopy
@vindex ps-lpr-command
@@ -1902,7 +1880,7 @@ includes a single directory @file{/usr/local/share/emacs/fonts/bdf}.
Many other customization variables for these commands are defined and
described in the Lisp files @file{ps-print.el} and @file{ps-mule.el}.
-@node Printing Package,, PostScript Variables, Printing
+@node Printing Package
@subsection Printing Package
@cindex Printing package
@@ -1922,7 +1900,7 @@ init file (@pxref{Init File}), followed by @code{(pr-update-menus)}.
This function replaces the usual printing commands in the menu bar
with a @samp{Printing} submenu that contains various printing options.
You can also type @kbd{M-x pr-interface RET}; this creates a
-@samp{*Printing Interface*} buffer, similar to a customization buffer,
+@file{*Printing Interface*} buffer, similar to a customization buffer,
where you can set the printing options. After selecting what and how
to print, you start the print job using the @samp{Print} button (click
@kbd{mouse-2} on it, or move point over it and type @kbd{RET}). For
@@ -2104,10 +2082,10 @@ Insert a byte with a code typed in octal.
Insert a byte with a code typed in hex.
@item C-x [
-Move to the beginning of a 1k-byte ``page.''
+Move to the beginning of a 1k-byte ``page''.
@item C-x ]
-Move to the end of a 1k-byte ``page.''
+Move to the end of a 1k-byte ``page''.
@item M-g
Move to an address specified in hex.
@@ -2126,7 +2104,7 @@ bytes, move by @code{short}s or @code{int}s, etc.; type @kbd{C-h a
hexl-@key{RET}} for details.
-@node Saving Emacs Sessions, Recursive Edit, Editing Binary Files, Top
+@node Saving Emacs Sessions
@section Saving Emacs Sessions
@cindex saving sessions
@cindex restore session
@@ -2177,7 +2155,7 @@ usually turned on.
However, this may be slow if there are a lot of buffers in the
desktop. You can specify the maximum number of buffers to restore
immediately with the variable @code{desktop-restore-eager}; the
-remaining buffers are restored ``lazily,'' when Emacs is idle.
+remaining buffers are restored ``lazily'', when Emacs is idle.
@findex desktop-clear
@vindex desktop-globals-to-clear
@@ -2192,7 +2170,7 @@ expression matching the names of buffers not to kill.
If you want to save minibuffer history from one session to
another, use the @code{savehist} library.
-@node Recursive Edit, Emulation, Saving Emacs Sessions, Top
+@node Recursive Edit
@section Recursive Editing Levels
@cindex recursive editing level
@cindex editing level, recursive
@@ -2260,7 +2238,7 @@ new major mode which provides a command to switch back. These
approaches give you more flexibility to go back to unfinished tasks in
the order you choose.
-@node Emulation, Hyperlinking, Recursive Edit, Top
+@node Emulation
@section Emulation
@cindex emulating other editors
@cindex other editors
@@ -2285,18 +2263,18 @@ editors. Standard facilities can emulate these:
@cindex Brief emulation
@cindex emulation of Brief
@cindex mode, CRiSP
-You can turn on key bindings to emulate the CRiSP/Brief editor with
-@kbd{M-x crisp-mode}. Note that this rebinds @kbd{M-x} to exit Emacs
-unless you set the variable @code{crisp-override-meta-x}. You can
-also use the command @kbd{M-x scroll-all-mode} or set the variable
+@kbd{M-x crisp-mode} enables key bindings to emulate the CRiSP/Brief
+editor. Note that this rebinds @kbd{M-x} to exit Emacs unless you set
+the variable @code{crisp-override-meta-x}. You can also use the
+command @kbd{M-x scroll-all-mode} or set the variable
@code{crisp-load-scroll-all} to emulate CRiSP's scroll-all feature
(scrolling all windows together).
@item EDT (DEC VMS editor)
@findex edt-emulation-on
@findex edt-emulation-off
-Turn on EDT emulation @kbd{M-x edt-emulation-on}; use @kbd{M-x
-edt-emulation-off} to restore normal Emacs command bindings.
+Turn on EDT emulation with @kbd{M-x edt-emulation-on}; restore normal
+command bindings with @kbd{M-x edt-emulation-off}.
Most of the EDT emulation commands are keypad keys, and most standard
Emacs key bindings are still available. The EDT emulation rebindings
@@ -2352,29 +2330,11 @@ not use it.
key bindings.
@end table
-@node Hyperlinking, Amusements, Emulation, Top
+@node Hyperlinking
@section Hyperlinking and Navigation Features
-@cindex hyperlinking
-@cindex navigation
- Various modes documented elsewhere have hypertext features so that
-you can follow links, usually by clicking @kbd{Mouse-2} on the link or
-typing @key{RET} while point is on the link. Clicking @kbd{Mouse-1}
-quickly on the link also follows it. (Hold @kbd{Mouse-1} for longer
-if you want to set point instead.)
-
- Info mode, Help mode and the Dired-like modes are examples of modes
-that have links in the buffer. The Tags facility links between uses
-and definitions in source files, see @ref{Tags}. Imenu provides
-navigation amongst items indexed in the current buffer, see
-@ref{Imenu}. Info-lookup provides mode-specific lookup of definitions
-in Info indexes, see @ref{Documentation}. Speedbar maintains a frame
-in which links to files, and locations in files are displayed, see
-@ref{Speedbar}.
-
- Other non-mode-specific facilities described in this section enable
-following links from the current buffer in a context-sensitive
-fashion.
+ The following subsections describe convenience features for handling
+URLs and other types of links occurring in Emacs buffer text.
@menu
* Browse-URL:: Following URLs.
@@ -2397,31 +2357,31 @@ fashion.
Load a URL into a Web browser.
@end table
-The Browse-URL package provides facilities for following URLs specifying
-links on the World Wide Web. Usually this works by invoking a web
-browser, but you can, for instance, arrange to invoke @code{compose-mail}
-from @samp{mailto:} URLs.
+ The Browse-URL package allows you to easily follow URLs from within
+Emacs. Most URLs are followed by invoking a web browser;
+@samp{mailto:} URLs are followed by invoking the @code{compose-mail}
+Emacs command to send mail to the specified address (@pxref{Sending
+Mail}).
- The general way to use this feature is to type @kbd{M-x browse-url},
-which displays a specified URL. If point is located near a plausible
-URL, that URL is used as the default. Other commands are available
-which you might like to bind to keys, such as
-@code{browse-url-at-point} and @code{browse-url-at-mouse}.
+ The command @kbd{M-x browse-url} prompts for a URL, and follows it.
+If point is located near a plausible URL, that URL is offered as the
+default. The Browse-URL package also provides other commands which
+you might like to bind to keys, such as @code{browse-url-at-point} and
+@code{browse-url-at-mouse}.
+@vindex browse-url-mailto-function
@vindex browse-url-browser-function
You can customize Browse-URL's behavior via various options in the
-@code{browse-url} Customize group, particularly
-@code{browse-url-browser-function}. You can invoke actions dependent
-on the type of URL by defining @code{browse-url-browser-function} as
-an association list. The package's commentary available via @kbd{C-h
-p} under the @samp{hypermedia} keyword provides more information.
-Packages with facilities for following URLs should always go through
-Browse-URL, so that the customization options for Browse-URL will
-affect all browsing in Emacs.
+@code{browse-url} Customize group. In particular, the option
+@code{browse-url-mailto-function} lets you define how to follow
+@samp{mailto:} URLs, while @code{browse-url-browser-function} lets you
+define how to follow other types of URLs. For more information, view
+the package commentary by typing @kbd{C-h P browse-url @key{RET}}.
@node Goto Address mode
@subsection Activating URLs
@findex goto-address-mode
+@cindex mode, Goto Address
@cindex Goto Address mode
@cindex URLs, activating
@@ -2430,20 +2390,23 @@ affect all browsing in Emacs.
Activate URLs and e-mail addresses in the current buffer.
@end table
- You can make URLs in the current buffer active with @kbd{M-x
-goto-address-mode}. This minor mode finds all the URLs in the buffer,
-highlights them, and turns them into @dfn{buttons}: if you click on a
-URL with @kbd{Mouse-1} or @kbd{Mouse-2} (@pxref{Mouse References}), or
-move to the URL and type @kbd{C-c @key{RET}}, that displays the web
-page that the URL specifies. For a @samp{mailto} URL, it sends mail
-instead, using your selected mail-composition method (@pxref{Mail
-Methods}).
+@kindex C-c RET @r{(Goto Address mode)}
+@findex goto-address-at-point
+ You can make Emacs mark out URLs specially in the current buffer, by
+typing @kbd{M-x goto-address-mode}. When this buffer-local minor mode
+is enabled, it finds all the URLs in the buffer, highlights them, and
+turns them into clickable buttons. You can follow the URL by typing
+@kbd{C-c @key{RET}} (@code{goto-address-at-point}) while point is on
+its text; or by clicking with @kbd{Mouse-2}, or by clicking
+@kbd{Mouse-1} quickly (@pxref{Mouse References}). Following a URL is
+done by calling @code{browse-url} as a subroutine
+(@pxref{Browse-URL}).
It can be useful to add @code{goto-address-mode} to mode hooks and
-the hooks used to display an incoming message (e.g.,
-@code{rmail-show-message-hook} for Rmail, and @code{mh-show-mode-hook}
-for MH-E). This is not needed for Gnus, which has a similar feature
-of its own.
+hooks for displaying an incoming message
+(e.g.@: @code{rmail-show-message-hook} for Rmail, and
+@code{mh-show-mode-hook} for MH-E). This is not needed for Gnus,
+which has a similar feature of its own.
@node FFAP
@subsection Finding Files and URLs at Point
@@ -2454,24 +2417,24 @@ of its own.
@findex ffap-menu
@cindex finding file at point
- FFAP mode replaces certain key bindings for finding files, including
-@kbd{C-x C-f}, with commands that provide more sensitive defaults.
-These commands behave like the ordinary ones when given a prefix
-argument. Otherwise, they get the default file name or URL from the
-text around point. If what is found in the buffer has the form of a
-URL rather than a file name, the commands use @code{browse-url} to
-view it.
+ The FFAP package replaces certain key bindings for finding files,
+such as @kbd{C-x C-f}, with commands that provide more sensitive
+defaults. These commands behave like the ordinary ones when given a
+prefix argument. Otherwise, they get the default file name or URL
+from the text around point. If what is found in the buffer has the
+form of a URL rather than a file name, the commands use
+@code{browse-url} to view it (@pxref{Browse-URL}).
This feature is useful for following references in mail or news
-buffers, @file{README} files, @file{MANIFEST} files, and so on. The
-@samp{ffap} package's commentary available via @kbd{C-h p} under the
-@samp{files} keyword and the @code{ffap} Custom group provide details.
+buffers, @file{README} files, @file{MANIFEST} files, and so on. For
+more information, view the package commentary by typing @kbd{C-h P
+ffap @key{RET}}.
@cindex FFAP minor mode
@findex ffap-mode
- You can turn on FFAP minor mode by calling @code{ffap-bindings} to
-make the following key bindings and to install hooks for using
-@code{ffap} in Rmail, Gnus and VM article buffers.
+ To enable FFAP, type @kbd{M-x ffap-bindings}. This makes the
+following key bindings, and also installs hooks for additional FFAP
+functionality in Rmail, Gnus and VM article buffers.
@table @kbd
@item C-x C-f @var{filename} @key{RET}
@@ -2497,7 +2460,7 @@ point (@code{dired-at-point}).
@code{ffap-read-only-other-window}, analogous to
@code{find-file-read-only-other-window}.
@item C-x 4 d
-@code{ffap-dired-other-window}, analogous to @code{dired-other-window}.
+@code{ffap-dired-other-window}, like @code{dired-other-window}.
@item C-x 5 f
@kindex C-x 5 f @r{(FFAP)}
@code{ffap-other-frame}, analogous to @code{find-file-other-frame}.
@@ -2518,14 +2481,14 @@ Display a menu of files and URLs mentioned in current buffer, then
find the one you select (@code{ffap-menu}).
@end table
-@node Amusements, Packages, Hyperlinking, Top
+@node Amusements
@section Other Amusements
@cindex boredom
@findex animate-birthday-present
@cindex animate
- The @code{animate} package makes text dance. For an example, try
-@kbd{M-x animate-birthday-present}.
+ The @code{animate} package makes text dance (e.g. @kbd{M-x
+animate-birthday-present}).
@findex blackbox
@findex mpuz
@@ -2551,7 +2514,7 @@ encrypted in a simple monoalphabetic substitution cipher.
@findex dissociated-press
@kbd{M-x dissociated-press} scrambles the text in the current Emacs
buffer, word by word or character by character, writing its output to
-a buffer named @samp{*Dissociation*}. A positive argument tells it to
+a buffer named @file{*Dissociation*}. A positive argument tells it to
operate character by character, and specifies the number of overlap
characters. A negative argument tells it to operate word by word, and
specifies the number of overlap words. Dissociated Press produces
@@ -2580,18 +2543,22 @@ bored, try an argument of 9. Sit back and watch.
@cindex Life
@kbd{M-x life} runs Conway's ``Life'' cellular automaton.
-@findex lm
+@findex landmark
@cindex landmark game
- @kbd{M-x lm} runs a relatively non-participatory game in which a
-robot attempts to maneuver towards a tree at the center of the window
-based on unique olfactory cues from each of the four directions.
+ @kbd{M-x landmark} runs a relatively non-participatory game in which
+a robot attempts to maneuver towards a tree at the center of the
+window based on unique olfactory cues from each of the four
+directions.
@findex morse-region
@findex unmorse-region
+@findex nato-region
@cindex Morse code
@cindex --/---/.-./.../.
- @kbd{M-x morse-region} converts text in a region to Morse code and
-@kbd{M-x unmorse-region} converts it back. No cause for remorse.
+ @kbd{M-x morse-region} converts the text in the region to Morse
+code; @kbd{M-x unmorse-region} converts it back. @kbd{M-x
+nato-region} converts the text in the region to NATO phonetic
+alphabet; @kbd{M-x denato-region} converts it back.
@findex pong
@cindex Pong game
@@ -2611,9 +2578,11 @@ across other pegs.
The command @kbd{M-x zone} plays games with the display when Emacs
is idle.
- Finally, if you find yourself frustrated, try the famous Eliza
-program. Just do @kbd{M-x doctor}. End each input by typing
-@key{RET} twice.
+@findex doctor
+@cindex Eliza
+ Finally, if you find yourself frustrated, try describing your
+problems to the famous psychotherapist Eliza. Just do @kbd{M-x
+doctor}. End each input by typing @key{RET} twice.
@ifnottex
@lowersections
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
index 4d574242c8d..c619b1eb47e 100644
--- a/doc/emacs/modes.texi
+++ b/doc/emacs/modes.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Modes, Indentation, International, Top
+@node Modes
@chapter Major and Minor Modes
Emacs contains many @dfn{editing modes} that alter its basic
@@ -65,8 +65,7 @@ process (@pxref{Interactive Shell}).
first visit a file or create a buffer (@pxref{Choosing Modes}). You
can explicitly select a new major mode by using an @kbd{M-x} command.
Take the name of the mode and add @code{-mode} to get the name of the
-command to select that mode. Thus, you can enter Lisp mode with
-@kbd{M-x lisp-mode}.
+command to select that mode (e.g., @kbd{M-x lisp-mode} enters Lisp mode).
@vindex major-mode
The value of the buffer-local variable @code{major-mode} is a symbol
@@ -81,9 +80,9 @@ change this default value via the Customization interface (@pxref{Easy
Customization}), or by adding a line like this to your init file
(@pxref{Init File}):
-@smallexample
+@example
(setq-default major-mode 'text-mode)
-@end smallexample
+@end example
@noindent
If the default value of @code{major-mode} is @code{nil}, the major
@@ -96,7 +95,7 @@ the rules of the language (@pxref{Indentation}). The keys that are
commonly changed are @key{TAB}, @key{DEL}, and @kbd{C-j}. Many modes
also define special commands of their own, usually bound in the prefix
key @kbd{C-c}. Major modes can also alter user options and variables;
-for instance, programming language modes typicaly set a buffer-local
+for instance, programming language modes typically set a buffer-local
value for the variable @code{comment-start}, which determines how
source code comments are delimited (@pxref{Comments}).
@@ -216,8 +215,7 @@ in individual buffers. @xref{Faces}.
@findex linum-mode
@cindex Linum mode
@item
-Linum mode displays each line's line number in the window's left
-margin. Its mode command is @code{linum-mode}.
+Linum mode displays each line's line number in the window's left margin.
@item
Outline minor mode provides similar facilities to the major mode
diff --git a/doc/emacs/msdog-xtra.texi b/doc/emacs/msdog-xtra.texi
index 095a0cdacbf..0d05c8ac9c6 100644
--- a/doc/emacs/msdog-xtra.texi
+++ b/doc/emacs/msdog-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2004-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
@@ -33,7 +33,7 @@ you use an Emacs that was built for MS-DOS.
@ifnottex
@xref{Text and Binary}, for information
@end ifnottex
-about Emacs' special handling of text files under MS-DOS (and Windows).
+about Emacs's special handling of text files under MS-DOS (and Windows).
@menu
* Keyboard: MS-DOS Keyboard. Keyboard conventions on MS-DOS.
@@ -199,10 +199,10 @@ of Emacs packages that use fonts (such as @code{font-lock}, Enriched
Text mode, and others) by defining the relevant faces to use different
colors. Use the @code{list-colors-display} command
@iftex
-(@pxref{Frame Parameters,,,emacs, the Emacs Manual})
+(@pxref{Colors,,,emacs, the Emacs Manual})
@end iftex
@ifnottex
-(@pxref{Frame Parameters})
+(@pxref{Colors})
@end ifnottex
and the @code{list-faces-display} command
@iftex
@@ -247,7 +247,7 @@ begins at the top of the character cell.
@cindex frames on MS-DOS
The MS-DOS terminal can only display a single frame at a time. The
-Emacs frame facilities work on MS-DOS much as they do on text-only
+Emacs frame facilities work on MS-DOS much as they do on text
terminals
@iftex
(@pxref{Frames,,,emacs, the Emacs Manual}).
@@ -260,10 +260,10 @@ visible frame smaller than the full screen, but Emacs still cannot
display more than a single frame at a time.
@cindex frame size under MS-DOS
-@findex mode4350
-@findex mode25
- The @code{mode4350} command switches the display to 43 or 50
-lines, depending on your hardware; the @code{mode25} command switches
+@findex dos-mode4350
+@findex dos-mode25
+ The @code{dos-mode4350} command switches the display to 43 or 50
+lines, depending on your hardware; the @code{dos-mode25} command switches
to the default 80x25 screen size.
By default, Emacs only knows how to set screen sizes of 80 columns by
@@ -394,7 +394,7 @@ different default values on MS-DOS.
for details about setting up printing to a networked printer.
Some printers expect DOS codepage encoding of non-@acronym{ASCII} text, even
-though they are connected to a Windows machine which uses a different
+though they are connected to a Windows machine that uses a different
encoding for the same locale. For example, in the Latin-1 locale, DOS
uses codepage 850 whereas Windows uses codepage 1252. @xref{MS-DOS and
MULE}. When you print to such printers from Windows, you can use the
@@ -483,7 +483,7 @@ appropriate terminal coding system that is supported by the codepage.
The special features described in the rest of this section mostly
pertain to codepages that encode ISO 8859 character sets.
- For the codepages which correspond to one of the ISO character sets,
+ For the codepages that correspond to one of the ISO character sets,
Emacs knows the character set based on the codepage number. Emacs
automatically creates a coding system to support reading and writing
files that use the current codepage, and uses this coding system by
@@ -548,7 +548,7 @@ when invoked with the @samp{-nw} option.
@cindex inferior processes under MS-DOS
@findex compile @r{(MS-DOS)}
@findex grep @r{(MS-DOS)}
- Because MS-DOS is a single-process ``operating system,''
+ Because MS-DOS is a single-process ``operating system'',
asynchronous subprocesses are not available. In particular, Shell
mode and its variants do not work. Most Emacs features that use
asynchronous subprocesses also don't work on MS-DOS, including
@@ -607,9 +607,14 @@ MS-DOS with some network redirector.
@cindex directory listing on MS-DOS
@vindex dired-listing-switches @r{(MS-DOS)}
- Dired on MS-DOS uses the @code{ls-lisp} package where other
-platforms use the system @code{ls} command. Therefore, Dired on
-MS-DOS supports only some of the possible options you can mention in
-the @code{dired-listing-switches} variable. The options that work are
-@samp{-A}, @samp{-a}, @samp{-c}, @samp{-i}, @samp{-r}, @samp{-S},
-@samp{-s}, @samp{-t}, and @samp{-u}.
+ Dired on MS-DOS uses the @code{ls-lisp} package
+@iftex
+(@pxref{ls in Lisp,,,emacs, the Emacs Manual}).
+@end iftex
+@ifnottex
+(@pxref{ls in Lisp}).
+@end ifnottex
+Therefore, Dired on MS-DOS supports only some of the possible options
+you can mention in the @code{dired-listing-switches} variable. The
+options that work are @samp{-A}, @samp{-a}, @samp{-c}, @samp{-i},
+@samp{-r}, @samp{-S}, @samp{-s}, @samp{-t}, and @samp{-u}.
diff --git a/doc/emacs/msdog.texi b/doc/emacs/msdog.texi
index 547d8cbadd9..d8f9bb6961d 100644
--- a/doc/emacs/msdog.texi
+++ b/doc/emacs/msdog.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Microsoft Windows, Manifesto, Mac OS / GNUstep, Top
+@node Microsoft Windows
@appendix Emacs and Microsoft Windows/MS-DOS
@cindex Microsoft Windows
@cindex MS-Windows, Emacs peculiarities
@@ -40,7 +40,7 @@ here.
* Windows Fonts:: Specifying fonts on MS-Windows.
* Windows Misc:: Miscellaneous Windows features.
@ifnottex
-* MS-DOS:: Using Emacs on MS-DOS (otherwise known as @dfn{MS-DOG}).
+* MS-DOS:: Using Emacs on MS-DOS.
@end ifnottex
@end menu
@@ -109,6 +109,21 @@ invoked---that will always give you an editor. When invoked via
the program that invoked @command{emacsclient}.
@end enumerate
+@cindex emacsclient, on MS-Windows
+Note that, due to limitations of MS-Windows, Emacs cannot have both
+GUI and text-mode frames in the same session. It also cannot open
+text-mode frames on more than a single @dfn{Command Prompt} window,
+because each Windows program can have only one console at any given
+time. For these reasons, if you invoke @command{emacsclient} with the
+@option{-c} option, and the Emacs server runs in a text-mode session,
+Emacs will always create a new text-mode frame in the same
+@dfn{Command Prompt} window where it was started; a GUI frame will be
+created only if the server runs in a GUI session. Similarly, if you
+invoke @command{emacsclient} with the @option{-t} option, Emacs will
+create a GUI frame if the server runs in a GUI session, or a text-mode
+frame when the session runs in text mode in a @dfn{Command Prompt}
+window. @xref{emacsclient Options}.
+
@node Text and Binary
@section Text Files and Binary Files
@cindex text and binary files on MS-DOS/MS-Windows
@@ -159,7 +174,8 @@ save a buffer in a specified EOL format with the @kbd{C-x @key{RET} f}
command. For example, to save a buffer with Unix EOL format, type
@kbd{C-x @key{RET} f unix @key{RET} C-x C-s}. If you visit a file
with DOS EOL conversion, then save it with Unix EOL format, that
-effectively converts the file to Unix EOL style, like @code{dos2unix}.
+effectively converts the file to Unix EOL style, like the
+@code{dos2unix} program.
@cindex untranslated file system
@findex add-untranslated-filesystem
@@ -221,7 +237,7 @@ for files which are known to be Windows-style text files with
carriage-return linefeed EOL format, such as @file{CONFIG.SYS}; Emacs
always writes those files with Windows-style EOLs.
- If a file which belongs to an untranslated file system matches one of
+ If a file that belongs to an untranslated file system matches one of
the file-name patterns in @code{file-name-buffer-file-type-alist}, the
EOL conversion is determined by @code{file-name-buffer-file-type-alist}.
@@ -263,8 +279,8 @@ FAT32, and XFAT volumes.
@cindex Dired, and MS-Windows/MS-DOS
@cindex @code{ls} emulation
- Dired normally uses the external program @code{ls} (or its close
-work-alike) to produce the directory listing displayed in Dired
+ Dired normally uses the external program @code{ls}
+to produce the directory listing displayed in Dired
buffers (@pxref{Dired}). However, MS-Windows and MS-DOS systems don't
come with such a program, although several ports of @sc{gnu} @code{ls}
are available. Therefore, Emacs on those systems @emph{emulates}
@@ -281,8 +297,8 @@ they are described in this section.
The @code{ls} emulation supports many of the @code{ls} switches, but
it doesn't support all of them. Here's the list of the switches it
does support: @option{-A}, @option{-a}, @option{-B}, @option{-C},
-@option{-c}, @option{-i}, @option{-G}, @option{-g}, @option{-R},
-@option{-r}, @option{-S}, @option{-s}, @option{-t}, @option{-U},
+@option{-c}, @option{-G}, @option{-g}, @option{-h}, @option{-i}, @option{-n},
+@option{-R}, @option{-r}, @option{-S}, @option{-s}, @option{-t}, @option{-U},
@option{-u}, and @option{-X}. The @option{-F} switch is partially
supported (it appends the character that classifies the file, but does
not prevent symlink following).
@@ -399,23 +415,22 @@ names, which might cause misalignment of columns in Dired display.
@section HOME and Startup Directories on MS-Windows
@cindex @code{HOME} directory on MS-Windows
- The Windows equivalent of the @code{HOME} directory is the
-@dfn{user-specific application data directory}. The actual location
-depends on the Windows version; typical values are @file{C:\Documents
-and Settings\@var{username}\Application Data} on Windows 2K/XP/2K3,
-@file{C:\Users\@var{username}\AppData\Roaming} on Windows Vista/7/2K8,
-and either @file{C:\WINDOWS\Application Data} or
-@file{C:\WINDOWS\Profiles\@var{username}\Application Data} on the
-older Windows 9X/ME systems. If this directory does not exist or
-cannot be accessed, Emacs falls back to @file{C:\} as the default
-value of @code{HOME}.
+ The Windows equivalent of @code{HOME} is the @dfn{user-specific
+application data directory}. The actual location depends on the
+Windows version; typical values are @file{C:\Documents and
+Settings\@var{username}\Application Data} on Windows 2000/XP/2K3,
+@file{C:\Users\@var{username}\AppData\Roaming} on Windows
+Vista/7/2008, and either @file{C:\WINDOWS\Application Data} or
+@file{C:\WINDOWS\Profiles\@var{username}\Application Data} on Windows
+9X/ME. If this directory does not exist or cannot be accessed, Emacs
+falls back to @file{C:\} as the default value of @code{HOME}.
You can override this default value of @code{HOME} by explicitly
setting the environment variable @env{HOME} to point to any directory
on your system. @env{HOME} can be set either from the command shell
-prompt or from the @samp{My Computer}s @samp{Properties} dialog.
-@code{HOME} can also be set in the system registry, for details see
-@ref{MS-Windows Registry}.
+prompt or from @samp{Properties} dialog of @samp{My Computer}.
+@code{HOME} can also be set in the system registry,
+@pxref{MS-Windows Registry}.
For compatibility with older versions of Emacs@footnote{
Older versions of Emacs didn't check the application data directory.
@@ -431,9 +446,9 @@ deprecated.
Whatever the final place is, Emacs sets the internal value of the
@env{HOME} environment variable to point to it, and it will use that
location for other files and directories it normally looks for or
-creates in the user's home directory.
+creates in your home directory.
- You can always find out where Emacs thinks is your home directory's
+ You can always find out what Emacs thinks is your home directory's
location by typing @kbd{C-x d ~/ @key{RET}}. This should present the
list of files in the home directory, and show its full name on the
first line. Likewise, to visit your init file, type @kbd{C-x C-f
@@ -510,7 +525,7 @@ otherwise it returns @code{nil}.
@cindex @kbd{M-@key{TAB}} vs @kbd{Alt-@key{TAB}} (MS-Windows)
@cindex @kbd{Alt-@key{TAB}} vs @kbd{M-@key{TAB}} (MS-Windows)
For example, @code{(w32-register-hot-key [M-tab])} lets you use
-@kbd{M-TAB} normally in Emacs, for instance, to complete the word or
+@kbd{M-TAB} normally in Emacs; for instance, to complete the word or
symbol at point at top level, or to complete the current search string
against previously sought strings during incremental search.
@@ -573,7 +588,7 @@ then change their minds; if this has the effect of bringing up the
Windows menu, it alters the meaning of subsequent commands. Many
users find this frustrating.
- You can re-enable Windows' default handling of tapping the @key{ALT}
+ You can re-enable Windows's default handling of tapping the @key{ALT}
key by setting @code{w32-pass-alt-to-system} to a non-@code{nil}
value.
@@ -589,7 +604,7 @@ of these variables. Passing each of these keys to Windows produces
its normal effect: for example, @kbd{@key{Lwindow}} opens the
@code{Start} menu, etc.@footnote{
Some combinations of the ``Windows'' keys with other keys are caught
-by Windows at low level in a way that Emacs currently cannot prevent.
+by Windows at a low level in a way that Emacs currently cannot prevent.
For example, @kbd{@key{Lwindow} r} always pops up the Windows
@samp{Run} dialog. Customizing the value of
@code{w32-phantom-key-code} might help in some cases, though.}
@@ -612,7 +627,7 @@ modifiers.
@cindex mouse, and MS-Windows
This section describes the Windows-specific variables related to
-mouse.
+the mouse.
@vindex w32-mouse-button-tolerance
@cindex simulation of middle mouse button
@@ -689,8 +704,8 @@ to do its job.
@vindex w32-quote-process-args
The variable @code{w32-quote-process-args} controls how Emacs quotes
the process arguments. Non-@code{nil} means quote with the @code{"}
-character. If the value is a character, use that character to escape
-any quote characters that appear; otherwise chose a suitable escape
+character. If the value is a character, Emacs uses that character to escape
+any quote characters that appear; otherwise it chooses a suitable escape
character based on the type of the program.
@ifnottex
@@ -713,9 +728,9 @@ Posix-style @code{lpr} program is unavailable. The same Emacs
variables control printing on all systems, but in some cases they have
different default values on MS-DOS and MS-Windows.
- Emacs on Windows automatically determines your default printer and
-sets the variable @code{printer-name} to that printer's name. But in
-some rare cases this can fail, or you may wish to use a different
+ Emacs on MS Windows attempts to determine your default printer
+automatically (using the function @code{default-printer-name}).
+But in some rare cases this can fail, or you may wish to use a different
printer from within Emacs. The rest of this section explains how to
tell Emacs which printer to use.
@@ -723,7 +738,7 @@ tell Emacs which printer to use.
If you want to use your local printer, then set the Lisp variable
@code{lpr-command} to @code{""} (its default value on Windows) and
@code{printer-name} to the name of the printer port---for example,
-@code{"PRN"}, the usual local printer port or @code{"LPT2"}, or
+@code{"PRN"}, the usual local printer port, or @code{"LPT2"}, or
@code{"COM1"} for a serial printer. You can also set
@code{printer-name} to a file name, in which case ``printed'' output
is actually appended to that file. If you set @code{printer-name} to
@@ -738,7 +753,7 @@ printers, run the command @samp{net view} from the command prompt to
obtain a list of servers, and @samp{net view @var{server-name}} to see
the names of printers (and directories) shared by that server.
Alternatively, click the @samp{Network Neighborhood} icon on your
-desktop, and look for machines which share their printers via the
+desktop, and look for machines that share their printers via the
network.
@cindex @samp{net use}, and printing on MS-Windows
@@ -797,8 +812,8 @@ specified by @code{printer-name}.
Finally, if you do have an @code{lpr} work-alike, you can set the
variable @code{lpr-command} to @code{"lpr"}. Then Emacs will use
@code{lpr} for printing, as on other systems. (If the name of the
-program isn't @code{lpr}, set @code{lpr-command} to specify where to
-find it.) The variable @code{lpr-switches} has its standard meaning
+program isn't @code{lpr}, set @code{lpr-command} to the appropriate value.)
+The variable @code{lpr-switches} has its standard meaning
when @code{lpr-command} is not @code{""}. If the variable
@code{printer-name} has a string value, it is used as the value for the
@code{-P} option to @code{lpr}, as on Unix.
@@ -822,7 +837,7 @@ ports, and only one of them is a PostScript printer.)
@cindex Ghostscript, use for PostScript printing
The default value of the variable @code{ps-lpr-command} is @code{""},
which causes PostScript output to be sent to the printer port specified
-by @code{ps-printer-name}, but @code{ps-lpr-command} can also be set to
+by @code{ps-printer-name}; but @code{ps-lpr-command} can also be set to
the name of a program which will accept PostScript files. Thus, if you
have a non-PostScript printer, you can set this variable to the name of
a PostScript interpreter program (such as Ghostscript). Any switches
@@ -980,7 +995,7 @@ the system default antialiasing.
determines whether to make the system caret visible. The default when
no screen reader software is in use is @code{nil}, which means Emacs
draws its own cursor to indicate the position of point. A
-non-@code{nil} value means Emacs will indicate point location by the
+non-@code{nil} value means Emacs will indicate point location with the
system caret; this facilitates use of screen reader software, and is
the default when such software is detected when running Emacs.
When this variable is non-@code{nil}, other variables affecting the
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index f676f0b96ce..ff0d43c566a 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -1,7 +1,7 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1997, 1999-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1997, 1999-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node International, Modes, Frames, Top
+@node International
@chapter International Character Set Support
@c This node is referenced in the tutorial. When renaming or deleting
@c it, the tutorial needs to be adjusted. (TUTORIAL.de)
@@ -41,7 +41,7 @@ including European and Vietnamese variants of the Latin alphabet, as
well as Cyrillic, Devanagari (for Hindi and Marathi), Ethiopic, Greek,
Han (for Chinese and Japanese), Hangul (for Korean), Hebrew, IPA,
Kannada, Lao, Malayalam, Tamil, Thai, Tibetan, and Vietnamese scripts.
-Emacs also supports various encodings of these characters used by
+Emacs also supports various encodings of these characters that are used by
other internationalized software, such as word processors and mailers.
Emacs allows editing text with international characters by supporting
@@ -60,7 +60,7 @@ for each command; see @ref{Text Coding}.
@item
You can display non-@acronym{ASCII} characters encoded by the various
scripts. This works by using appropriate fonts on graphics displays
-(@pxref{Defining Fontsets}), and by sending special codes to text-only
+(@pxref{Defining Fontsets}), and by sending special codes to text
displays (@pxref{Terminal Coding}). If some characters are displayed
incorrectly, refer to @ref{Undisplayable Characters}, which describes
possible problems and explains how to solve them.
@@ -74,14 +74,14 @@ others.
@item
You can insert non-@acronym{ASCII} characters or search for them. To do that,
you can specify an input method (@pxref{Select Input Method}) suitable
-for your language, or use the default input method set up when you set
+for your language, or use the default input method set up when you chose
your language environment. If
your keyboard can produce non-@acronym{ASCII} characters, you can select an
appropriate keyboard coding system (@pxref{Terminal Coding}), and Emacs
will accept those characters. Latin-1 characters can also be input by
using the @kbd{C-x 8} prefix, see @ref{Unibyte Mode}.
-On the X Window System, your locale should be set to an appropriate
+With the X Window System, your locale should be set to an appropriate
value to make sure Emacs interprets keyboard input correctly; see
@ref{Language Environments, locales}.
@end itemize
@@ -90,7 +90,7 @@ value to make sure Emacs interprets keyboard input correctly; see
@menu
* International Chars:: Basic concepts of multibyte characters.
-* Enabling Multibyte:: Controlling whether to use multibyte characters.
+* Disabling Multibyte:: Controlling whether to use multibyte characters.
* Language Environments:: Setting things up for the language you use.
* Input Methods:: Entering text characters not on your keyboard.
* Select Input Method:: Specifying your choice of input methods.
@@ -137,8 +137,8 @@ writing files, and when exchanging data with subprocesses.
@cindex undisplayable characters
@cindex @samp{?} in display
The command @kbd{C-h h} (@code{view-hello-file}) displays the file
-@file{etc/HELLO}, which shows how to say ``hello'' in many languages.
-This illustrates various scripts. If some characters can't be
+@file{etc/HELLO}, which illustrates various scripts by showing
+how to say ``hello'' in many languages. If some characters can't be
displayed on your terminal, they appear as @samp{?} or as hollow boxes
(@pxref{Undisplayable Characters}).
@@ -146,7 +146,7 @@ displayed on your terminal, they appear as @samp{?} or as hollow boxes
used, generally don't have keys for all the characters in them. You
can insert characters that your keyboard does not support, using
@kbd{C-q} (@code{quoted-insert}) or @kbd{C-x 8 @key{RET}}
-(@code{ucs-insert}). @xref{Inserting Text}. Emacs also supports
+(@code{insert-char}). @xref{Inserting Text}. Emacs also supports
various @dfn{input methods}, typically one for each script or
language, which make it easier to type characters in the script.
@xref{Input Methods}.
@@ -210,7 +210,7 @@ What keys to type to input the character in the current input method
@item
If you are running Emacs on a graphical display, the font name and
-glyph code for the character. If you are running Emacs on a text-only
+glyph code for the character. If you are running Emacs on a text
terminal, the code(s) sent to the terminal.
@item
@@ -224,29 +224,30 @@ faces used to display the character, and any overlays containing it
in a buffer whose coding system is @code{utf-8-unix}:
@smallexample
- character: @`A (192, #o300, #xc0)
-preferred charset: unicode (Unicode (ISO10646))
- code point: 0xC0
- syntax: w which means: word
- category: j:Japanese l:Latin v:Vietnamese
- buffer code: #xC3 #x80
- file code: not encodable by coding system undecided-unix
- display: by this font (glyph code)
+ position: 1 of 1 (0%), column: 0
+ character: @`A (displayed as @`A) (codepoint 192, #o300, #xc0)
+ preferred charset: unicode (Unicode (ISO10646))
+code point in charset: 0xC0
+ syntax: w which means: word
+ category: .:Base, L:Left-to-right (strong),
+ j:Japanese, l:Latin, v:Viet
+ buffer code: #xC3 #x80
+ file code: not encodable by coding system undecided-unix
+ display: by this font (glyph code)
xft:-unknown-DejaVu Sans Mono-normal-normal-
normal-*-13-*-*-*-m-0-iso10646-1 (#x82)
Character code properties: customize what to show
name: LATIN CAPITAL LETTER A WITH GRAVE
+ old-name: LATIN CAPITAL LETTER A GRAVE
general-category: Lu (Letter, Uppercase)
decomposition: (65 768) ('A' '`')
- old-name: LATIN CAPITAL LETTER A GRAVE
-
-There are text properties here:
- auto-composed t
@end smallexample
-@node Enabling Multibyte
-@section Enabling Multibyte Characters
+@c FIXME? Does this section even belong in the user manual?
+@c Seems more appropriate to the lispref?
+@node Disabling Multibyte
+@section Disabling Multibyte Characters
By default, Emacs starts in multibyte mode: it stores the contents
of buffers and strings using an internal encoding that represents
@@ -275,32 +276,45 @@ Coding}. Unlike @code{find-file-literally}, finding a file as
@samp{raw-text} doesn't disable format conversion, uncompression, or
auto mode selection.
+@c Not a single file in Emacs uses this feature. Is it really worth
+@c mentioning in the _user_ manual? Also, this duplicates somewhat
+@c "Loading Non-ASCII" from the lispref.
@cindex Lisp files, and multibyte operation
@cindex multibyte operation, and Lisp files
@cindex unibyte operation, and Lisp files
@cindex init file, and non-@acronym{ASCII} characters
Emacs normally loads Lisp files as multibyte.
This includes the Emacs initialization
-file, @file{.emacs}, and the initialization files of Emacs packages
+file, @file{.emacs}, and the initialization files of packages
such as Gnus. However, you can specify unibyte loading for a
-particular Lisp file, by putting @w{@samp{-*-unibyte: t;-*-}} in a
-comment on the first line (@pxref{File Variables}). Then that file is
-always loaded as unibyte text. The motivation for these conventions
-is that it is more reliable to always load any particular Lisp file in
-the same way. However, you can load a Lisp file as unibyte, on any
-one occasion, by typing @kbd{C-x @key{RET} c raw-text @key{RET}}
-immediately before loading it.
-
- The mode line indicates whether multibyte character support is
-enabled in the current buffer. If it is, there are two or more
-characters (most often two dashes) near the beginning of the mode
-line, before the indication of the visited file's end-of-line
-convention (colon, backslash, etc.). When multibyte characters
-are not enabled, nothing precedes the colon except a single dash.
-@xref{Mode Line}, for more details about this.
+particular Lisp file, by adding an entry @samp{coding: raw-text} in a file
+local variables section. @xref{Specify Coding}.
+Then that file is always loaded as unibyte text.
+@ignore
+@c I don't see the point of this statement:
+The motivation for these conventions is that it is more reliable to
+always load any particular Lisp file in the same way.
+@end ignore
+You can also load a Lisp file as unibyte, on any one occasion, by
+typing @kbd{C-x @key{RET} c raw-text @key{RET}} immediately before
+loading it.
+
+@c See http://debbugs.gnu.org/11226 for lack of unibyte tooltip.
+@vindex enable-multibyte-characters
+The buffer-local variable @code{enable-multibyte-characters} is
+non-@code{nil} in multibyte buffers, and @code{nil} in unibyte ones.
+The mode line also indicates whether a buffer is multibyte or not.
+@xref{Mode Line}. With a graphical display, in a multibyte buffer,
+the portion of the mode line that indicates the character set has a
+tooltip that (amongst other things) says that the buffer is multibyte.
+In a unibyte buffer, the character set indicator is absent. Thus, in
+a unibyte buffer (when using a graphical display) there is normally
+nothing before the indication of the visited file's end-of-line
+convention (colon, backslash, etc.), unless you are using an input
+method.
@findex toggle-enable-multibyte-characters
-You can turn on multibyte support in a specific buffer by invoking the
+You can turn off multibyte support in a specific buffer by invoking the
command @code{toggle-enable-multibyte-characters} in that buffer.
@node Language Environments
@@ -309,8 +323,8 @@ command @code{toggle-enable-multibyte-characters} in that buffer.
All supported character sets are supported in Emacs buffers whenever
multibyte characters are enabled; there is no need to select a
-particular language in order to display its characters in an Emacs
-buffer. However, it is important to select a @dfn{language
+particular language in order to display its characters.
+However, it is important to select a @dfn{language
environment} in order to set various defaults. Roughly speaking, the
language environment represents a choice of preferred script rather
than a choice of language.
@@ -327,12 +341,13 @@ language environment also specifies a default input method.
@code{current-language-environment} or use the command @kbd{M-x
set-language-environment}. It makes no difference which buffer is
current when you use this command, because the effects apply globally
-to the Emacs session. The supported language environments include:
+to the Emacs session. The supported language environments
+(see the variable @code{language-info-alist}) include:
@cindex Euro sign
@cindex UTF-8
@quotation
-ASCII, Belarusian, Bengali, Brazilian Portuguese, Bulgarian,
+ASCII, Belarusian, Bengali, Brazilian Portuguese, Bulgarian, Cham,
Chinese-BIG5, Chinese-CNS, Chinese-EUC-TW, Chinese-GB, Chinese-GBK,
Chinese-GB18030, Croatian, Cyrillic-ALT, Cyrillic-ISO, Cyrillic-KOI8,
Czech, Devanagari, Dutch, English, Esperanto, Ethiopic, French,
@@ -347,21 +362,8 @@ UTF-8), Ukrainian, Vietnamese, Welsh, and Windows-1255 (for a setup
which prefers Cyrillic characters and files encoded in Windows-1255).
@end quotation
-@cindex fonts for various scripts
-@cindex Intlfonts package, installation
To display the script(s) used by your language environment on a
-graphical display, you need to have a suitable font. If some of the
-characters appear as empty boxes or hex codes, you should install the
-GNU Intlfonts package, which includes fonts for most supported
-scripts.@footnote{If you run Emacs on X, you need to inform the X
-server about the location of the newly installed fonts with the
-following commands:
-
-@example
- xset fp+ /usr/local/share/emacs/fonts
- xset fp rehash
-@end example
-}
+graphical display, you need to have suitable fonts.
@xref{Fontsets}, for more details about setting up your fonts.
@findex set-locale-environment
@@ -370,22 +372,25 @@ following commands:
@cindex locales
Some operating systems let you specify the character-set locale you
are using by setting the locale environment variables @env{LC_ALL},
-@env{LC_CTYPE}, or @env{LANG}.@footnote{If more than one of these is
+@env{LC_CTYPE}, or @env{LANG}. (If more than one of these is
set, the first one that is nonempty specifies your locale for this
-purpose.} During startup, Emacs looks up your character-set locale's
+purpose.) During startup, Emacs looks up your character-set locale's
name in the system locale alias table, matches its canonical name
against entries in the value of the variables
-@code{locale-charset-language-names} and @code{locale-language-names},
+@code{locale-charset-language-names} and @code{locale-language-names}
+(the former overrides the latter),
and selects the corresponding language environment if a match is found.
-(The former variable overrides the latter.) It also adjusts the display
+It also adjusts the display
table and terminal coding system, the locale coding system, the
preferred coding system as needed for the locale, and---last but not
least---the way Emacs decodes non-@acronym{ASCII} characters sent by your keyboard.
+@c This seems unlikely, doesn't it?
If you modify the @env{LC_ALL}, @env{LC_CTYPE}, or @env{LANG}
-environment variables while running Emacs, you may want to invoke the
-@code{set-locale-environment} function afterwards to readjust the
-language environment from the new locale.
+environment variables while running Emacs (by using @kbd{M-x setenv}),
+you may want to invoke the @code{set-locale-environment}
+function afterwards to readjust the language environment from the new
+locale.
@vindex locale-preferred-coding-systems
The @code{set-locale-environment} function normally uses the preferred
@@ -421,7 +426,7 @@ this command describes the chosen language environment.
language environment. The hook functions can test for a specific
language environment by checking the variable
@code{current-language-environment}. This hook is where you should
-put non-default settings for specific language environment, such as
+put non-default settings for specific language environments, such as
coding systems for keyboard input and terminal output, the default
input method, etc.
@@ -441,7 +446,7 @@ for that key.
@cindex input methods
An @dfn{input method} is a kind of character conversion designed
specifically for interactive input. In Emacs, typically each language
-has its own input method; sometimes several languages which use the same
+has its own input method; sometimes several languages that use the same
characters can share one input method. A few languages support several
input methods.
@@ -454,14 +459,14 @@ work this way.
characters into one letter. Many European input methods use composition
to produce a single non-@acronym{ASCII} letter from a sequence that consists of a
letter followed by accent characters (or vice versa). For example, some
-methods convert the sequence @kbd{a'} into a single accented letter.
+methods convert the sequence @kbd{o ^} into a single accented letter.
These input methods have no special commands of their own; all they do
is compose sequences of printing characters.
The input methods for syllabic scripts typically use mapping followed
by composition. The input methods for Thai and Korean work this way.
First, letters are mapped into symbols for particular sounds or tone
-marks; then, sequences of these which make up a whole syllable are
+marks; then, sequences of these that make up a whole syllable are
mapped into one syllable sign.
Chinese and Japanese require more complex methods. In Chinese input
@@ -471,7 +476,8 @@ portions of the character (input methods @code{chinese-4corner} and
@code{chinese-sw}, and others). One input sequence typically
corresponds to many possible Chinese characters. You select the one
you mean using keys such as @kbd{C-f}, @kbd{C-b}, @kbd{C-n},
-@kbd{C-p}, and digits, which have special meanings in this situation.
+@kbd{C-p} (or the arrow keys), and digits, which have special meanings
+in this situation.
The possible characters are conceptually arranged in several rows,
with each row holding up to 10 alternatives. Normally, Emacs displays
@@ -485,8 +491,8 @@ the alternatives in the current row. As you do this, Emacs highlights
the current alternative with a special color; type @code{C-@key{SPC}}
to select the current alternative and use it as input. The
alternatives in the row are also numbered; the number appears before
-the alternative. Typing a digit @var{n} selects the @var{n}th
-alternative of the current row and uses it as input.
+the alternative. Typing a number selects the associated alternative
+of the current row and uses it as input.
@key{TAB} in these Chinese input methods displays a buffer showing
all the possible characters at once; then clicking @kbd{Mouse-2} on
@@ -505,15 +511,15 @@ the alternatives.
Sometimes it is useful to cut off input method processing so that the
characters you have just entered will not combine with subsequent
characters. For example, in input method @code{latin-1-postfix}, the
-sequence @kbd{e '} combines to form an @samp{e} with an accent. What if
+sequence @kbd{o ^} combines to form an @samp{o} with an accent. What if
you want to enter them as separate characters?
One way is to type the accent twice; this is a special feature for
-entering the separate letter and accent. For example, @kbd{e ' '} gives
-you the two characters @samp{e'}. Another way is to type another letter
-after the @kbd{e}---something that won't combine with that---and
-immediately delete it. For example, you could type @kbd{e e @key{DEL}
-'} to get separate @samp{e} and @samp{'}.
+entering the separate letter and accent. For example, @kbd{o ^ ^} gives
+you the two characters @samp{o^}. Another way is to type another letter
+after the @kbd{o}---something that won't combine with that---and
+immediately delete it. For example, you could type @kbd{o o @key{DEL}
+^} to get separate @samp{o} and @samp{^}.
Another method, more general but not quite as easy to type, is to use
@kbd{C-\ C-\} between two characters to stop them from combining. This
@@ -542,7 +548,7 @@ possible characters to type next is displayed in the echo area (but
not when you are in the minibuffer).
Another facility for typing characters not on your keyboard is by
-using the @kbd{C-x 8 @key{RET}} (@code{ucs-insert}) to insert a single
+using @kbd{C-x 8 @key{RET}} (@code{insert-char}) to insert a single
character based on its Unicode name or code-point; see @ref{Inserting
Text}.
@@ -551,10 +557,10 @@ Text}.
@table @kbd
@item C-\
-Enable or disable use of the selected input method.
+Enable or disable use of the selected input method (@code{toggle-input-method}).
@item C-x @key{RET} C-\ @var{method} @key{RET}
-Select a new input method for the current buffer.
+Select a new input method for the current buffer (@code{set-input-method}).
@item C-h I @var{method} @key{RET}
@itemx C-h C-\ @var{method} @key{RET}
@@ -588,7 +594,7 @@ turn off the input method temporarily. To do this, type @kbd{C-\}
@kbd{C-\} again.
If you type @kbd{C-\} and you have not yet selected an input method,
-it prompts for you to specify one. This has the same effect as using
+it prompts you to specify one. This has the same effect as using
@kbd{C-x @key{RET} C-\} to specify an input method.
When invoked with a numeric argument, as in @kbd{C-u C-\},
@@ -631,7 +637,7 @@ automatically. For example:
@end lisp
@noindent
-This activates the input method ``german-prefix'' automatically in the
+This automatically activates the input method ``german-prefix'' in
Text mode.
@findex quail-set-keyboard-layout
@@ -645,7 +651,7 @@ the command @kbd{M-x quail-set-keyboard-layout}.
You can use the command @kbd{M-x quail-show-key} to show what key (or
key sequence) to type in order to input the character following point,
using the selected keyboard layout. The command @kbd{C-u C-x =} also
-shows that information in addition to the other information about the
+shows that information, in addition to other information about the
character.
@findex list-input-methods
@@ -685,11 +691,12 @@ system; for example, to visit a file encoded in codepage 850, type
In addition to converting various representations of non-@acronym{ASCII}
characters, a coding system can perform end-of-line conversion. Emacs
handles three different conventions for how to separate lines in a file:
-newline, carriage-return linefeed, and just carriage-return.
+newline (``unix''), carriage-return linefeed (``dos''), and just
+carriage-return (``mac'').
@table @kbd
@item C-h C @var{coding} @key{RET}
-Describe coding system @var{coding}.
+Describe coding system @var{coding} (@code{describe-coding-system}).
@item C-h C @key{RET}
Describe the coding systems currently in use.
@@ -725,27 +732,27 @@ end-of-line conversion to be decided based on the contents of each file.
For example, if the file appears to use the sequence carriage-return
linefeed to separate lines, DOS end-of-line conversion will be used.
- Each of the listed coding systems has three variants which specify
+ Each of the listed coding systems has three variants, which specify
exactly what to do for end-of-line conversion:
@table @code
@item @dots{}-unix
Don't do any end-of-line conversion; assume the file uses
newline to separate lines. (This is the convention normally used
-on Unix and GNU systems.)
+on Unix and GNU systems, and Mac OS X.)
@item @dots{}-dos
Assume the file uses carriage-return linefeed to separate lines, and do
the appropriate conversion. (This is the convention normally used on
Microsoft systems.@footnote{It is also specified for MIME @samp{text/*}
bodies and in other network transport contexts. It is different
-from the SGML reference syntax record-start/record-end format which
+from the SGML reference syntax record-start/record-end format, which
Emacs doesn't support directly.})
@item @dots{}-mac
Assume the file uses carriage-return to separate lines, and do the
-appropriate conversion. (This is the convention normally used on the
-Macintosh system.)
+appropriate conversion. (This was the convention used on the
+Macintosh system prior to OS X.)
@end table
These variant coding systems are omitted from the
@@ -763,7 +770,7 @@ be deduced from the text itself.
@cindex @code{raw-text}, coding system
The coding system @code{raw-text} is good for a file which is mainly
-@acronym{ASCII} text, but may contain byte values above 127 which are
+@acronym{ASCII} text, but may contain byte values above 127 that are
not meant to encode non-@acronym{ASCII} characters. With
@code{raw-text}, Emacs copies those byte values unchanged, and sets
@code{enable-multibyte-characters} to @code{nil} in the current buffer
@@ -880,37 +887,46 @@ the buffer.
The default value of @code{inhibit-iso-escape-detection} is
@code{nil}. We recommend that you not change it permanently, only for
-one specific operation. That's because many Emacs Lisp source files
+one specific operation. That's because some Emacs Lisp source files
in the Emacs distribution contain non-@acronym{ASCII} characters encoded in the
coding system @code{iso-2022-7bit}, and they won't be
decoded correctly when you visit those files if you suppress the
escape sequence detection.
+@c I count a grand total of 3 such files, so is the above really true?
@vindex auto-coding-alist
@vindex auto-coding-regexp-alist
-@vindex auto-coding-functions
- The variables @code{auto-coding-alist},
-@code{auto-coding-regexp-alist} and @code{auto-coding-functions} are
+ The variables @code{auto-coding-alist} and
+@code{auto-coding-regexp-alist} are
the strongest way to specify the coding system for certain patterns of
-file names, or for files containing certain patterns; these variables
-even override @samp{-*-coding:-*-} tags in the file itself. Emacs
+file names, or for files containing certain patterns, respectively.
+These variables even override @samp{-*-coding:-*-} tags in the file
+itself (@pxref{Specify Coding}). For example, Emacs
uses @code{auto-coding-alist} for tar and archive files, to prevent it
from being confused by a @samp{-*-coding:-*-} tag in a member of the
archive and thinking it applies to the archive file as a whole.
+@ignore
+@c This describes old-style BABYL files, which are no longer relevant.
Likewise, Emacs uses @code{auto-coding-regexp-alist} to ensure that
RMAIL files, whose names in general don't match any particular
-pattern, are decoded correctly. One of the builtin
+pattern, are decoded correctly.
+@end ignore
+
+@vindex auto-coding-functions
+ Another way to specify a coding system is with the variable
+@code{auto-coding-functions}. For example, one of the builtin
@code{auto-coding-functions} detects the encoding for XML files.
+Unlike the previous two, this variable does not override any
+@samp{-*-coding:-*-} tag.
-@vindex rmail-decode-mime-charset
+@c FIXME? This seems somewhat out of place. Move to the Rmail section?
@vindex rmail-file-coding-system
When you get new mail in Rmail, each message is translated
automatically from the coding system it is written in, as if it were a
separate file. This uses the priority list of coding systems that you
have specified. If a MIME message specifies a character set, Rmail
-obeys that specification, unless @code{rmail-decode-mime-charset} is
-@code{nil}. For reading and saving Rmail files themselves, Emacs uses
-the coding system specified by the variable
+obeys that specification. For reading and saving Rmail files
+themselves, Emacs uses the coding system specified by the variable
@code{rmail-file-coding-system}. The default value is @code{nil},
which means that Rmail files are not translated (they are read and
written in the Emacs internal character code).
@@ -969,25 +985,30 @@ and asks you to choose one of those coding systems.
If you insert the unsuitable characters in a mail message, Emacs
behaves a bit differently. It additionally checks whether the
+@c What determines this?
most-preferred coding system is recommended for use in MIME messages;
-if not, Emacs tells you that the most-preferred coding system is not
-recommended and prompts you for another coding system. This is so you
-won't inadvertently send a message encoded in a way that your
-recipient's mail software will have difficulty decoding. (You can
-still use an unsuitable coding system if you type its name in response
-to the question.)
-
+if not, it informs you of this fact and prompts you for another coding
+system. This is so you won't inadvertently send a message encoded in
+a way that your recipient's mail software will have difficulty
+decoding. (You can still use an unsuitable coding system if you enter
+its name at the prompt.)
+
+@c It seems that select-message-coding-system does this.
+@c Both sendmail.el and smptmail.el call it; i.e. smtpmail.el still
+@c obeys sendmail-coding-system.
@vindex sendmail-coding-system
- When you send a message with Message mode (@pxref{Sending Mail}),
+ When you send a mail message (@pxref{Sending Mail}),
Emacs has four different ways to determine the coding system to use
for encoding the message text. It tries the buffer's own value of
@code{buffer-file-coding-system}, if that is non-@code{nil}.
Otherwise, it uses the value of @code{sendmail-coding-system}, if that
is non-@code{nil}. The third way is to use the default coding system
for new files, which is controlled by your choice of language
+@c i.e., default-sendmail-coding-system
environment, if that is non-@code{nil}. If all of these three values
are @code{nil}, Emacs encodes outgoing mail using the Latin-1 coding
system.
+@c FIXME? Where does the Latin-1 default come in?
@node Text Coding
@section Specifying a Coding System for File Text
@@ -998,8 +1019,8 @@ one:
@table @kbd
@item C-x @key{RET} f @var{coding} @key{RET}
-Use coding system @var{coding} to save or revisit the visited file in
-the current buffer (@code{set-buffer-file-coding-system})
+Use coding system @var{coding} to save or revisit the file in
+the current buffer (@code{set-buffer-file-coding-system}).
@item C-x @key{RET} c @var{coding} @key{RET}
Specify coding system @var{coding} for the immediately following
@@ -1018,19 +1039,23 @@ decoding it using coding system @var{right} instead.
@findex set-buffer-file-coding-system
The command @kbd{C-x @key{RET} f}
(@code{set-buffer-file-coding-system}) sets the file coding system for
-the current buffer---in other words, it says which coding system to
-use when saving or reverting the visited file. You specify which
-coding system using the minibuffer. If you specify a coding system
-that cannot handle all of the characters in the buffer, Emacs warns
-you about the troublesome characters when you actually save the
-buffer.
+the current buffer (i.e.@: the coding system to use when saving or
+reverting the file). You specify which coding system using the
+minibuffer. You can also invoke this command by clicking with
+@kbd{Mouse-3} on the coding system indicator in the mode line
+(@pxref{Mode Line}).
+
+ If you specify a coding system that cannot handle all the characters
+in the buffer, Emacs will warn you about the troublesome characters,
+and ask you to choose another coding system, when you try to save the
+buffer (@pxref{Output Coding}).
@cindex specify end-of-line conversion
You can also use this command to specify the end-of-line conversion
(@pxref{Coding Systems, end-of-line conversion}) for encoding the
current buffer. For example, @kbd{C-x @key{RET} f dos @key{RET}} will
-cause Emacs to save the current buffer's text with DOS-style CRLF line
-endings.
+cause Emacs to save the current buffer's text with DOS-style
+carriage-return linefeed line endings.
@kindex C-x RET c
@findex universal-coding-system-argument
@@ -1089,11 +1114,11 @@ in communication with other processes.
@table @kbd
@item C-x @key{RET} x @var{coding} @key{RET}
Use coding system @var{coding} for transferring selections to and from
-other window-based applications (@code{set-selection-coding-system}).
+other graphical applications (@code{set-selection-coding-system}).
@item C-x @key{RET} X @var{coding} @key{RET}
Use coding system @var{coding} for transferring @emph{one}
-selection---the next one---to or from another window-based application
+selection---the next one---to or from another graphical application
(@code{set-next-selection-coding-system}).
@item C-x @key{RET} p @var{input-coding} @key{RET} @var{output-coding} @key{RET}
@@ -1118,7 +1143,7 @@ coding system for the next selection made in Emacs or read by Emacs.
The variable @code{x-select-request-type} specifies the data type to
request from the X Window System for receiving text selections from
other applications. If the value is @code{nil} (the default), Emacs
-tries @code{COMPOUND_TEXT} and @code{UTF8_STRING}, in this order, and
+tries @code{UTF8_STRING} and @code{COMPOUND_TEXT}, in this order, and
uses various heuristics to choose the more appropriate of the two
results; if none of these succeed, Emacs falls back on @code{STRING}.
If the value of @code{x-select-request-type} is one of the symbols
@@ -1150,8 +1175,8 @@ current language environment.
The variable @code{locale-coding-system} specifies a coding system
to use when encoding and decoding system strings such as system error
messages and @code{format-time-string} formats and time stamps. That
-coding system is also used for decoding non-@acronym{ASCII} keyboard input on X
-Window systems. You should choose a coding system that is compatible
+coding system is also used for decoding non-@acronym{ASCII} keyboard
+input on the X Window System. You should choose a coding system that is compatible
with the underlying system's text representation, which is normally
specified by one of the environment variables @env{LC_ALL},
@env{LC_CTYPE}, and @env{LANG}. (The first one, in the order
@@ -1164,27 +1189,29 @@ the text representation.)
@table @kbd
@item C-x @key{RET} F @var{coding} @key{RET}
Use coding system @var{coding} for encoding and decoding file
-@emph{names} (@code{set-file-name-coding-system}).
+names (@code{set-file-name-coding-system}).
@end table
-@vindex file-name-coding-system
-@cindex file names with non-@acronym{ASCII} characters
- The variable @code{file-name-coding-system} specifies a coding
-system to use for encoding file names. It has no effect on reading
-and writing the @emph{contents} of files.
-
@findex set-file-name-coding-system
@kindex C-x @key{RET} F
- If you set the variable to a coding system name (as a Lisp symbol or
-a string), Emacs encodes file names using that coding system for all
-file operations. This makes it possible to use non-@acronym{ASCII}
-characters in file names---or, at least, those non-@acronym{ASCII}
-characters which the specified coding system can encode. Use @kbd{C-x
-@key{RET} F} (@code{set-file-name-coding-system}) to specify this
-interactively.
+@cindex file names with non-@acronym{ASCII} characters
+ The command @kbd{C-x @key{RET} F} (@code{set-file-name-coding-system})
+specifies a coding system to use for encoding file @emph{names}. It
+has no effect on reading and writing the @emph{contents} of files.
+
+@vindex file-name-coding-system
+ In fact, all this command does is set the value of the variable
+@code{file-name-coding-system}. If you set the variable to a coding
+system name (as a Lisp symbol or a string), Emacs encodes file names
+using that coding system for all file operations. This makes it
+possible to use non-@acronym{ASCII} characters in file names---or, at
+least, those non-@acronym{ASCII} characters that the specified coding
+system can encode.
If @code{file-name-coding-system} is @code{nil}, Emacs uses a
-default coding system determined by the selected language environment.
+default coding system determined by the selected language environment,
+and stored in the @code{default-file-name-coding-system} variable.
+@c FIXME? Is this correct? What is the "default language environment"?
In the default language environment, non-@acronym{ASCII} characters in
file names are not encoded specially; they appear in the file system
using the internal Emacs representation.
@@ -1195,7 +1222,7 @@ result if you have already visited files whose names were encoded using
the earlier coding system and cannot be encoded (or are encoded
differently) under the new coding system. If you try to save one of
these buffers under the visited file name, saving may use the wrong file
-name, or it may get an error. If such a problem happens, use @kbd{C-x
+name, or it may encounter an error. If such a problem happens, use @kbd{C-x
C-w} to specify a new file name for that buffer.
@findex recode-file-name
@@ -1208,13 +1235,13 @@ system, and the coding system to which you wish to convert.
@section Coding Systems for Terminal I/O
@table @kbd
-@item C-x @key{RET} k @var{coding} @key{RET}
-Use coding system @var{coding} for keyboard input
-(@code{set-keyboard-coding-system}).
-
@item C-x @key{RET} t @var{coding} @key{RET}
Use coding system @var{coding} for terminal output
(@code{set-terminal-coding-system}).
+
+@item C-x @key{RET} k @var{coding} @key{RET}
+Use coding system @var{coding} for keyboard input
+(@code{set-keyboard-coding-system}).
@end table
@kindex C-x RET t
@@ -1237,8 +1264,8 @@ your locale specification (@pxref{Language Environments}).
@kindex C-x RET k
@findex set-keyboard-coding-system
@vindex keyboard-coding-system
- The command @kbd{C-x @key{RET} k} (@code{set-keyboard-coding-system})
-or the variable @code{keyboard-coding-system} specifies the coding
+ The command @kbd{C-x @key{RET} k} (@code{set-keyboard-coding-system}),
+or the variable @code{keyboard-coding-system}, specifies the coding
system for keyboard input. Character-code translation of keyboard
input is useful for terminals with keys that send non-@acronym{ASCII}
graphic characters---for example, some terminals designed for ISO
@@ -1273,30 +1300,50 @@ non-graphic characters.
A font typically defines shapes for a single alphabet or script.
Therefore, displaying the entire range of scripts that Emacs supports
requires a collection of many fonts. In Emacs, such a collection is
-called a @dfn{fontset}. A fontset is defined by a list of font specs,
+called a @dfn{fontset}. A fontset is defined by a list of font specifications,
each assigned to handle a range of character codes, and may fall back
-on another fontset for characters which are not covered by the fonts
+on another fontset for characters that are not covered by the fonts
it specifies.
+@cindex fonts for various scripts
+@cindex Intlfonts package, installation
Each fontset has a name, like a font. However, while fonts are
stored in the system and the available font names are defined by the
system, fontsets are defined within Emacs itself. Once you have
defined a fontset, you can use it within Emacs by specifying its name,
anywhere that you could use a single font. Of course, Emacs fontsets
-can use only the fonts that the system supports; if certain characters
-appear on the screen as hollow boxes, this means that the fontset in
-use for them has no font for those characters.@footnote{The Emacs
-installation instructions have information on additional font
-support.}
+can use only the fonts that the system supports. If some characters
+appear on the screen as empty boxes or hex codes, this means that the
+fontset in use for them has no font for those characters. In this
+case, or if the characters are shown, but not as well as you would
+like, you may need to install extra fonts. Your operating system may
+have optional fonts that you can install; or you can install the GNU
+Intlfonts package, which includes fonts for most supported
+scripts.@footnote{If you run Emacs on X, you may need to inform the X
+server about the location of the newly installed fonts with commands
+such as:
+@c FIXME? I feel like this may be out of date.
+@c Eg the intlfonts tarfile is ~ 10 years old.
+
+@example
+ xset fp+ /usr/local/share/emacs/fonts
+ xset fp rehash
+@end example
+}
Emacs creates three fontsets automatically: the @dfn{standard
fontset}, the @dfn{startup fontset} and the @dfn{default fontset}.
+@c FIXME? The doc of *standard*-fontset-spec says:
+@c "You have the biggest chance to display international characters
+@c with correct glyphs by using the *standard* fontset." (my emphasis)
+@c See http://lists.gnu.org/archive/html/emacs-devel/2012-04/msg00430.html
The default fontset is most likely to have fonts for a wide variety of
-non-@acronym{ASCII} characters and is the default fallback for the
+non-@acronym{ASCII} characters, and is the default fallback for the
other two fontsets, and if you set a default font rather than fontset.
-However it does not specify font family names, so results can be
+However, it does not specify font family names, so results can be
somewhat random if you use it directly. You can specify use of a
-specific fontset with the @samp{-fn} option. For example,
+particular fontset by starting Emacs with the @samp{-fn} option.
+For example,
@example
emacs -fn fontset-standard
@@ -1335,10 +1382,12 @@ of @code{standard-fontset-spec}. This fontset's name is
@noindent
or just @samp{fontset-standard} for short.
- On GNUstep and Mac, fontset-standard is created using the value of
-@code{ns-standard-fontset-spec}, and on Windows it is
+ On GNUstep and Mac OS X, the standard fontset is created using the value of
+@code{ns-standard-fontset-spec}, and on MS Windows it is
created using the value of @code{w32-standard-fontset-spec}.
+@c FIXME? How does one access these, or do anything with them?
+@c Does it matter?
Bold, italic, and bold-italic variants of the standard fontset are
created automatically. Their names have @samp{bold} instead of
@samp{medium}, or @samp{i} instead of @samp{r}, or both.
@@ -1353,8 +1402,15 @@ started. This is the @dfn{startup fontset} and its name is
@var{charset_encoding} field with @samp{startup}, then using the
resulting string to specify a fontset.
- For instance, if you start Emacs this way,
+ For instance, if you start Emacs with a font of this form,
+@c FIXME? I think this is a little misleading, because you cannot (?)
+@c actually specify a font with wildcards, it has to be a complete spec.
+@c Also, an X font specification of this form hasn't (?) been
+@c mentioned before now, and is somewhat obsolete these days.
+@c People are more likely to use a form like
+@c emacs -fn "DejaVu Sans Mono-12"
+@c How does any of this apply in that case?
@example
emacs -fn "*courier-medium-r-normal--14-140-*-iso8859-1"
@end example
@@ -1367,8 +1423,8 @@ window frame:
-*-courier-medium-r-normal-*-14-140-*-*-*-*-fontset-startup
@end example
- The startup fontset will use the font that you specify or a variant
-with a different registry and encoding for all the characters which
+ The startup fontset will use the font that you specify, or a variant
+with a different registry and encoding, for all the characters that
are supported by that font, and fallback on @samp{fontset-default} for
other characters.
@@ -1376,7 +1432,8 @@ other characters.
just like an actual font name. But be careful not to specify a fontset
name in a wildcard resource like @samp{Emacs*Font}---that wildcard
specification matches various other resources, such as for menus, and
-menus cannot handle fontsets.
+@c FIXME is this still true?
+menus cannot handle fontsets. @xref{X Resources}.
You can specify additional fontsets using X resources named
@samp{Fontset-@var{n}}, where @var{n} is an integer starting from 0.
@@ -1387,7 +1444,8 @@ The resource value should have this form:
@end smallexample
@noindent
-@var{fontpattern} should have the form of a standard X font name, except
+@var{fontpattern} should have the form of a standard X font name (see
+the previous fontset-startup example), except
for the last two fields. They should have the form
@samp{fontset-@var{alias}}.
@@ -1409,7 +1467,7 @@ that describe the character set. For the @acronym{ASCII} character font,
In addition, when several consecutive fields are wildcards, Emacs
collapses them into a single wildcard. This is to prevent use of
auto-scaled fonts. Fonts made by scaling larger fonts are not usable
-for editing, and scaling a smaller font is not useful because it is
+for editing, and scaling a smaller font is not also useful, because it is
better to use the smaller font in its own size, which is what Emacs
does.
@@ -1435,8 +1493,8 @@ and the font specification for Chinese GB2312 characters would be this:
You may not have any Chinese font matching the above font
specification. Most X distributions include only Chinese fonts that
-have @samp{song ti} or @samp{fangsong ti} in @var{family} field. In
-such a case, @samp{Fontset-@var{n}} can be specified as below:
+have @samp{song ti} or @samp{fangsong ti} in the @var{family} field. In
+such a case, @samp{Fontset-@var{n}} can be specified as:
@smallexample
Emacs.Fontset-0: -*-fixed-medium-r-normal-*-24-*-*-*-*-*-fontset-24,\
@@ -1470,8 +1528,8 @@ script.
Fontsets can be modified using the function @code{set-fontset-font},
specifying a character, a charset, a script, or a range of characters
-to modify the font for, and a font-spec for the font to be used. Some
-examples are:
+to modify the font for, and a font specification for the font to be
+used. Some examples are:
@example
;; Use Liberation Mono for latin-3 charset.
@@ -1498,10 +1556,10 @@ examples are:
@node Undisplayable Characters
@section Undisplayable Characters
- There may be a some non-@acronym{ASCII} characters that your terminal cannot
-display. Most text-only terminals support just a single character
-set (use the variable @code{default-terminal-coding-system}
-(@pxref{Terminal Coding}) to tell Emacs which one); characters which
+ There may be some non-@acronym{ASCII} characters that your
+terminal cannot display. Most text terminals support just a single
+character set (use the variable @code{default-terminal-coding-system}
+to tell Emacs which one, @ref{Terminal Coding}); characters that
can't be encoded in that coding system are displayed as @samp{?} by
default.
@@ -1533,17 +1591,15 @@ the range 0240 to 0377 octal (160 to 255 decimal) to handle the
accented letters and punctuation needed by various European languages
(and some non-European ones). Note that Emacs considers bytes with
codes in this range as raw bytes, not as characters, even in a unibyte
-session, i.e.@: if you disable multibyte characters. However, Emacs
+buffer, i.e.@: if you disable multibyte characters. However, Emacs
can still handle these character codes as if they belonged to
@emph{one} of the single-byte character sets at a time. To specify
@emph{which} of these codes to use, invoke @kbd{M-x
set-language-environment} and specify a suitable language environment
such as @samp{Latin-@var{n}}.
- For more information about unibyte operation, see @ref{Enabling
-Multibyte}. Note particularly that you probably want to ensure that
-your initialization files are read as unibyte if they contain
-non-@acronym{ASCII} characters.
+ For more information about unibyte operation, see
+@ref{Disabling Multibyte}.
@vindex unibyte-display-via-language-environment
Emacs can also display bytes in the range 160 to 255 as readable
@@ -1562,8 +1618,8 @@ them as raw bytes, not as characters.
set, Emacs can display these characters as @acronym{ASCII} sequences which at
least give you a clear idea of what the characters are. To do this,
load the library @code{iso-ascii}. Similar libraries for other
-Latin-@var{n} character sets could be implemented, but we don't have
-them yet.
+Latin-@var{n} character sets could be implemented, but have not been
+so far.
@findex standard-display-8bit
@cindex 8-bit display
@@ -1587,9 +1643,9 @@ If your keyboard can generate character codes 128 (decimal) and up,
representing non-@acronym{ASCII} characters, you can type those character codes
directly.
-On a graphical display, you should not need to do anything special to use
-these keys; they should simply work. On a text-only terminal, you
-should use the command @code{M-x set-keyboard-coding-system} or the
+On a graphical display, you should not need to do anything special to
+use these keys; they should simply work. On a text terminal, you
+should use the command @code{M-x set-keyboard-coding-system} or customize the
variable @code{keyboard-coding-system} to specify which coding system
your keyboard uses (@pxref{Terminal Coding}). Enabling this feature
will probably require you to use @kbd{ESC} to type Meta characters;
@@ -1613,7 +1669,7 @@ a key sequence is allowed.
library is loaded, the @key{ALT} modifier key, if the keyboard has
one, serves the same purpose as @kbd{C-x 8}: use @key{ALT} together
with an accent character to modify the following letter. In addition,
-if the keyboard has keys for the Latin-1 ``dead accent characters,''
+if the keyboard has keys for the Latin-1 ``dead accent characters'',
they too are defined to compose with the following character, once
@code{iso-transl} is loaded.
@@ -1657,8 +1713,9 @@ internal representation within Emacs.
@findex list-character-sets
@kbd{M-x list-character-sets} displays a list of all supported
charsets. The list gives the names of charsets and additional
-information to identity each charset (see
-@url{http://www.itscj.ipsj.or.jp/ISO-IR/} for details). In this list,
+information to identity each charset; see the
+@url{http://www.itscj.ipsj.or.jp/ISO-IR/, International Register of
+Coded Character Sets} for more details. In this list,
charsets are divided into two categories: @dfn{normal charsets} are
listed first, followed by @dfn{supplementary charsets}. A
supplementary charset is one that is used to define another charset
@@ -1678,8 +1735,8 @@ Chars}).
Hebrew, whose natural ordering of horizontal text for display is from
right to left. However, digits and Latin text embedded in these
scripts are still displayed left to right. It is also not uncommon to
-have small portions of text in Arabic or Hebrew embedded in otherwise
-Latin document, e.g., as comments and strings in a program source
+have small portions of text in Arabic or Hebrew embedded in an otherwise
+Latin document; e.g., as comments and strings in a program source
file. For these reasons, text that uses these scripts is actually
@dfn{bidirectional}: a mixture of runs of left-to-right and
right-to-left characters.
@@ -1705,14 +1762,17 @@ non-@code{nil}, Emacs reorders characters that have right-to-left
directionality when they are displayed. The default value is
@code{t}.
+@cindex base direction of paragraphs
+@cindex paragraph, base direction
Each paragraph of bidirectional text can have its own @dfn{base
direction}, either right-to-left or left-to-right. (Paragraph
+@c paragraph-separate etc have no influence on this?
boundaries are empty lines, i.e.@: lines consisting entirely of
-whitespace characters.) Text in left-to-right paragraphs begins at
-the left margin of the window and is truncated or continued when it
-reaches the right margin. By contrast, text in right-to-left
-paragraphs begins at the right margin and is continued or truncated at
-the left margin.
+whitespace characters.) Text in left-to-right paragraphs begins on
+the screen at the left margin of the window and is truncated or
+continued when it reaches the right margin. By contrast, text in
+right-to-left paragraphs is displayed starting at the right margin and
+is continued or truncated at the left margin.
@vindex bidi-paragraph-direction
Emacs determines the base direction of each paragraph dynamically,
@@ -1743,5 +1803,5 @@ commands move point in the logical order, so the cursor will sometimes
jump when point traverses reordered bidirectional text. Similarly, a
highlighted region covering a contiguous range of character positions
may look discontinuous if the region spans reordered text. This is
-normal and similar to behavior of other programs that support
+normal and similar to the behavior of other programs that support
bidirectional text.
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index b342cbbf18c..df87cf9cb23 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Packages
@@ -14,13 +14,13 @@ Emacs includes a facility that lets you easily download and install
separate Emacs Lisp program, sometimes including other components such
as an Info manual.
- @kbd{M-x list-packages} brings up a buffer named @samp{*Packages*}
+ @kbd{M-x list-packages} brings up a buffer named @file{*Packages*}
with a list of all packages. You can install or uninstall packages
via this buffer. @xref{Package Menu}.
@findex describe-package
The command @kbd{C-h P} (@code{describe-package}) prompts for the
-name of a package, and displays a help buffer describing that
+name of a package, and displays a help buffer describing the
attributes of the package and the features that it implements.
By default, Emacs downloads packages from a @dfn{package archive}
@@ -62,8 +62,12 @@ The package's status---normally one of @samp{available} (can be
downloaded from the package archive), @samp{installed}, or
@samp{built-in} (included in Emacs by default).
-In some instances, the status can be @samp{held}, @samp{disabled}, or
-@samp{obsolete}. @xref{Package Installation}.
+The status can also be @samp{new}. This is equivalent to
+@samp{available}, except that it means the package became newly
+available on the package archive after your last invocation of
+@kbd{M-x list-packages}. In other instances, a package may have the
+status @samp{held}, @samp{disabled}, or @samp{obsolete}.
+@xref{Package Installation}.
@item
A short description of the package.
@@ -119,9 +123,9 @@ dependencies; also, delete all packages marked with @kbd{d}
(@code{package-menu-execute}). This also removes the marks.
@item r
-Refresh the package list (@code{package-menu-refresh}). This also
-retrieves the list of available packages from the package archive
-again.
+Refresh the package list (@code{package-menu-refresh}). This fetches
+the list of available packages from the package archive again, and
+recomputes the package list.
@end table
@noindent
@@ -157,25 +161,38 @@ directory name of the package archive. You can alter this list if you
wish to use third party package archives---but do so at your own risk,
and use only third parties that you think you can trust!
- Once a package is downloaded and installed, it takes effect in the
-current Emacs session. What ``taking effect'' means depends on the
-package; most packages just make some new commands available, while
-others have more wide-ranging effects on the Emacs session. For such
-information, consult the package's help buffer.
+ Once a package is downloaded and installed, it is @dfn{loaded} into
+the current Emacs session. Loading a package is not quite the same as
+loading a Lisp library (@pxref{Lisp Libraries}); its effect varies
+from package to package. Most packages just make some new commands
+available, while others have more wide-ranging effects on the Emacs
+session. For such information, consult the package's help buffer.
- By default, Emacs also automatically loads all installed packages
-(causing them to ``take effect'') in subsequent Emacs sessions. This
-happens at startup, after processing the init file (@pxref{Init
-File}). As an exception, Emacs does not load packages at startup if
-invoked with the @samp{-q} or @samp{--no-init-file} options
-(@pxref{Initial Options}).
+ By default, Emacs also automatically loads all installed packages in
+subsequent Emacs sessions. This happens at startup, after processing
+the init file (@pxref{Init File}). As an exception, Emacs does not
+load packages at startup if invoked with the @samp{-q} or
+@samp{--no-init-file} options (@pxref{Initial Options}).
@vindex package-enable-at-startup
-@findex package-initialize
To disable automatic package loading, change the variable
-@code{package-enable-at-startup} to @code{nil}. If you do this, you
-can use the command @kbd{M-x package-initialize} to load your
-packages.
+@code{package-enable-at-startup} to @code{nil}.
+
+@findex package-initialize
+ The reason automatic package loading occurs after loading the init
+file is that user options only receive their customized values after
+loading the init file, including user options which affect the
+packaging system. In some circumstances, you may want to load
+packages explicitly in your init file (usually because some other code
+in your init file depends on a package). In that case, your init file
+should call the function @code{package-initialize}. It is up to you
+to ensure that relevant user options, such as @code{package-load-list}
+(see below), are set up prior to the @code{package-initialize} call.
+You should also set @code{package-enable-at-startup} to @code{nil}, to
+avoid loading the packages again after processing the init file.
+Alternatively, you may choose to completely inhibit package loading at
+startup, and invoke the command @kbd{M-x package-initialize} to load
+your packages manually.
@vindex package-load-list
For finer control over package loading, you can use the variable
diff --git a/doc/emacs/picture-xtra.texi b/doc/emacs/picture-xtra.texi
index 43a2dbc4704..edf75f078d5 100644
--- a/doc/emacs/picture-xtra.texi
+++ b/doc/emacs/picture-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2004-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
@@ -78,9 +78,10 @@ column, converting a tab to multiple spaces if necessary. @kbd{C-n} and
@code{picture-move-up}, which can either insert spaces or convert tabs
as necessary to make sure that point stays in exactly the same column.
@kbd{C-e} runs @code{picture-end-of-line}, which moves to after the last
-nonblank character on the line. There is no need to change @kbd{C-a},
-as the choice of screen model does not affect beginnings of
-lines.
+nonblank character on the line. @kbd{C-a} runs
+@code{picture-beginning-of-line}. (The choice of screen model does not
+affect beginnings of lines; the only extra thing this command does is
+update the current picture column to 0.)
@findex picture-newline
Insertion of text is adapted to the quarter-plane screen model
@@ -198,7 +199,7 @@ C-b} (@code{picture-motion-reverse}) moves in the opposite direction.
With no argument, it moves to a point underneath the next
``interesting'' character that follows whitespace in the previous
nonblank line. ``Next'' here means ``appearing at a horizontal position
-greater than the one point starts out at.'' With an argument, as in
+greater than the one point starts out at''. With an argument, as in
@kbd{C-u M-@key{TAB}}, this command moves to the next such interesting
character in the current line. @kbd{M-@key{TAB}} does not change the
text; it only moves point. ``Interesting'' characters are defined by
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 7301ecfea8a..b5bb33ad666 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -1,15 +1,15 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Programs, Building, Text, Top
+@node Programs
@chapter Editing Programs
@cindex Lisp editing
@cindex C editing
@cindex program editing
This chapter describes Emacs features for facilitating editing
-programs. Some of these features can:
+programs. Some of the things these features can do are:
@itemize @bullet
@item
@@ -128,8 +128,7 @@ IDL/Pike/AWK (@pxref{Top, , CC Mode, ccmode, CC Mode}), and IDLWAVE
@ifnotinfo
The Emacs distribution contains Info manuals for the major modes for
Ada, C/C++/Objective C/Java/Corba IDL/Pike/AWK, and IDLWAVE. For
-Fortran mode, see the ``Fortran'' section in the Info version of the
-Emacs manual, which is not included in this printed version.
+Fortran mode, @pxref{Fortran,,, emacs-xtra, Specialized Emacs Features}.
@end ifnotinfo
@node Defuns
@@ -186,15 +185,13 @@ delimiter from starting a defun. Here's an example:
highlights confusing opening delimiters (those that ought to be
quoted) in bold red.
+@vindex open-paren-in-column-0-is-defun-start
If you need to override this convention, you can do so by setting
-this user option:
-
-@defvar open-paren-in-column-0-is-defun-start
+the variable @code{open-paren-in-column-0-is-defun-start}.
If this user option is set to @code{t} (the default), opening
-parentheses or braces at column zero always start defuns. When it's
+parentheses or braces at column zero always start defuns. When it is
@code{nil}, defuns are found by searching for parens or braces at the
outermost level.
-@end defvar
Usually, you should leave this option at its default value of
@code{t}. If your buffer contains parentheses or braces in column
@@ -329,12 +326,13 @@ as you move around in a buffer.
@findex which-function-mode
@vindex which-func-modes
To either enable or disable Which Function mode, use the command
-@kbd{M-x which-function-mode}. Although Which Function mode is a
-global minor mode, it takes effect only in certain major modes: those
-listed in the variable @code{which-func-modes}. If the value of
-@code{which-func-modes} is @code{t} rather than a list of modes, then
-Which Function mode applies to all major modes that know how to
-support it---in other words, all the major modes that support Imenu.
+@kbd{M-x which-function-mode}. Which Function mode is a global minor
+mode. By default, it takes effect in all major modes major modes that
+know how to support it (i.e.@: all the major modes that support
+Imenu). You can restrict it to a specific list of major modes by
+changing the value of the variable @code{which-func-modes} from
+@code{t} (which means to support all available major modes) to a list
+of major mode names.
@node Program Indent
@section Indentation for Programs
@@ -952,7 +950,7 @@ comment text.
comment on the current line, along with the whitespace before it.
Since the comment is saved to the kill ring, you can reinsert it on
another line by moving to the end of that line, doing @kbd{C-y}, and
-then @kbd{M-;} to realign the command. You can achieve the same
+then @kbd{M-;} to realign the comment. You can achieve the same
effect as @kbd{C-u M-;} by typing @kbd{M-x comment-kill}
(@code{comment-dwim} actually calls @code{comment-kill} as a
subroutine when it is given a prefix argument).
@@ -1084,8 +1082,7 @@ documentation of functions, variables and commands that you plan to
use in your program.
@menu
-* Info Lookup:: Looking up library functions and commands
- in Info files.
+* Info Lookup:: Looking up library functions and commands in Info files.
* Man Page:: Looking up man pages of library functions and commands.
* Lisp Doc:: Looking up Emacs Lisp functions, etc.
@end menu
@@ -1110,7 +1107,7 @@ You can also use @kbd{M-x info-lookup-file} to look for documentation
for a file name.
If you use @kbd{C-h S} in a major mode that does not support it,
-it asks you to specify the ``symbol help mode.'' You should enter
+it asks you to specify the ``symbol help mode''. You should enter
a command such as @code{c-mode} that would select a major
mode which @kbd{C-h S} does support.
@@ -1131,7 +1128,7 @@ prompts for a topic, with completion (@pxref{Completion}), and runs
the @command{man} program to format the corresponding man page. If
the system permits, it runs @command{man} asynchronously, so that you
can keep on editing while the page is being formatted. The result
-goes in a buffer named @samp{*Man @var{topic}*}. These buffers use a
+goes in a buffer named @file{*Man @var{topic}*}. These buffers use a
special major mode, Man mode, that facilitates scrolling and jumping
to other manual pages. For details, type @kbd{C-h m} while in a Man
mode buffer.
@@ -1166,7 +1163,7 @@ command. Unlike @kbd{M-x man}, it does not run any external programs
to format and display the man pages; the formatting is done by Emacs,
so it works on systems such as MS-Windows where the @command{man}
program may be unavailable. It prompts for a man page, and displays
-it in a buffer named @samp{*WoMan @var{section} @var{topic}}.
+it in a buffer named @file{*WoMan @var{section} @var{topic}}.
@kbd{M-x woman} computes the completion list for manpages the first
time you invoke the command. With a numeric argument, it recomputes
@@ -1415,6 +1412,12 @@ paragraph commands to work on. Auto Fill mode, if enabled in a
programming language major mode, indents the new lines which it
creates.
+@findex electric-layout-mode
+ Electric Layout mode (@kbd{M-x electric-layout-mode}) is a global
+minor mode that automatically inserts newlines when you type certain
+characters; for example, @samp{@{}, @samp{@}} and @samp{;} in Javascript
+mode.
+
Apart from Hideshow mode (@pxref{Hideshow}), another way to
selectively display parts of a program is to use the selective display
feature (@pxref{Selective Display}). Programming modes often also
@@ -1446,7 +1449,7 @@ with the Foldout package (@pxref{Foldout}).
This section gives a brief description of the special features
available in C, C++, Objective-C, Java, CORBA IDL, Pike and AWK modes.
-(These are called ``C mode and related modes.'')
+(These are called ``C mode and related modes''.)
@ifinfo
@xref{Top,, CC Mode, ccmode, CC Mode}, for more details.
@end ifinfo
@@ -1548,8 +1551,8 @@ after the mode name:
@kindex C-c C-l @r{(C mode)}
@findex c-toggle-electric-state
Toggle electric action (@code{c-toggle-electric-state}). With a
-prefix argument, this command enables electric action if the argument
-is positive, disables it if it is negative.
+positive prefix argument, this command enables electric action, with a
+negative one it disables it.
@end table
Electric characters insert newlines only when, in addition to the
@@ -1586,8 +1589,7 @@ preprocessor commands.
@findex c-hungry-delete-backwards
@kindex C-c C-@key{DEL} (C Mode)
@kindex C-c @key{DEL} (C Mode)
-@code{c-hungry-delete-backwards}---Delete the entire block of whitespace
-preceding point.
+Delete the entire block of whitespace preceding point (@code{c-hungry-delete-backwards}).
@item C-c C-d
@itemx C-c C-@key{DELETE}
@@ -1596,8 +1598,7 @@ preceding point.
@kindex C-c C-d (C Mode)
@kindex C-c C-@key{DELETE} (C Mode)
@kindex C-c @key{DELETE} (C Mode)
-@code{c-hungry-delete-forward}---Delete the entire block of whitespace
-following point.
+Delete the entire block of whitespace after point (@code{c-hungry-delete-forward}).
@end table
As an alternative to the above commands, you can enable @dfn{hungry
@@ -1610,9 +1611,7 @@ preceding whitespace, not just one space, and a single @kbd{C-c C-d}
@item M-x c-toggle-hungry-state
@findex c-toggle-hungry-state
Toggle the hungry-delete feature
-(@code{c-toggle-hungry-state})@footnote{This command had the binding
-@kbd{C-c C-d} in earlier versions of Emacs. @kbd{C-c C-d} is now
-bound to @code{c-hungry-delete-forward}.}. With a prefix argument,
+(@code{c-toggle-hungry-state}). With a prefix argument,
this command turns the hungry-delete feature on if the argument is
positive, and off if it is negative.
@end table
@@ -1651,11 +1650,12 @@ needs a binding to be useful. The following code will bind it to
@kbd{C-j}. We use @code{c-initialization-hook} here to make sure
the keymap is loaded before we try to change it.
-@smallexample
+@example
(defun my-bind-clb ()
- (define-key c-mode-base-map "\C-j" 'c-context-line-break))
+ (define-key c-mode-base-map "\C-j"
+ 'c-context-line-break))
(add-hook 'c-initialization-hook 'my-bind-clb)
-@end smallexample
+@end example
@item C-M-h
Put mark at the end of a function definition, and put point at the
@@ -1700,7 +1700,7 @@ inserted on that line, and any @samp{\} there is deleted.
@cindex preprocessor highlighting
@findex cpp-highlight-buffer
Highlight parts of the text according to its preprocessor conditionals.
-This command displays another buffer named @samp{*CPP Edit*}, which
+This command displays another buffer named @file{*CPP Edit*}, which
serves as a graphic menu for selecting how to display particular kinds
of conditionals and their contents. After changing various settings,
click on @samp{[A]pply these settings} (or go to that buffer and type
diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi
index f7fd52bd28d..0a83c0bdddd 100644
--- a/doc/emacs/regs.texi
+++ b/doc/emacs/regs.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Registers, Display, Killing, Top
+@node Registers
@chapter Registers
@cindex registers
@@ -92,6 +92,13 @@ Copy region into register @var{r} (@code{copy-to-register}).
Insert text from register @var{r} (@code{insert-register}).
@item M-x append-to-register @key{RET} @var{r}
Append region to text in register @var{r}.
+
+@kindex C-x r +
+When register @var{r} contains text, you can use @kbd{C-x r +}
+(@code{increment-register}) to append to that register. Note that
+command @kbd{C-x r +} behaves differently if @var{r} contains a
+number. @xref{Number Registers}.
+
@item M-x prepend-to-register @key{RET} @var{r}
Prepend region to text in register @var{r}.
@end table
@@ -116,6 +123,19 @@ region after appending it to the register. The command
the region text to the text in the register instead of
@emph{appending} it.
+@vindex register-separator
+ When you are collecting text using @code{append-to-register} and
+@code{prepend-to-register}, you may want to separate individual
+collected pieces using a separator. In that case, configure a
+@code{register-separator} and store the separator text in to that
+register. For example, to get double newlines as text separator
+during the collection process, you can use the following setting.
+
+@example
+(setq register-separator ?+)
+(set-register register-separator "\n\n")
+@end example
+
@kindex C-x r i
@findex insert-register
@kbd{C-x r i @var{r}} inserts in the buffer the text from register
@@ -191,8 +211,10 @@ Store @var{number} into register @var{r} (@code{number-to-register}).
@item C-u @var{number} C-x r + @var{r}
@kindex C-x r +
@findex increment-register
-Increment the number in register @var{r} by @var{number}
-(@code{increment-register}).
+If @var{r} contains a number, increment the number in that register by
+@var{number}. Note that command @kbd{C-x r +}
+(@code{increment-register}) behaves differently if @var{r} contains
+text. @xref{Text Registers}.
@item C-x r i @var{r}
Insert the number from register @var{r} into the buffer.
@end table
diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi
index d05af468fa1..3938712a5e9 100644
--- a/doc/emacs/rmail.texi
+++ b/doc/emacs/rmail.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Rmail
@@ -87,8 +87,7 @@ other buffers, and never switch back, you have exited. Just make sure
to save the Rmail file eventually (like any other file you have
changed). @kbd{C-x s} is a suitable way to do this (@pxref{Save
Commands}). The Rmail command @kbd{b}, @code{rmail-bury}, buries the
-Rmail buffer and its summary buffer without expunging and saving the
-Rmail file.
+Rmail buffer and its summary without expunging and saving the Rmail file.
@node Rmail Scrolling
@section Scrolling Within a Message
@@ -276,7 +275,7 @@ Expunge the Rmail file (@code{rmail-expunge}).
@findex rmail-delete-forward
@findex rmail-delete-backward
There are two Rmail commands for deleting messages. Both delete the
-current message and select another message. @kbd{d}
+current message and select another. @kbd{d}
(@code{rmail-delete-forward}) moves to the following message, skipping
messages already deleted, while @kbd{C-d} (@code{rmail-delete-backward})
moves to the previous nondeleted message. If there is no nondeleted
@@ -337,7 +336,7 @@ any time in Rmail by typing @kbd{g}.
@vindex rmail-primary-inbox-list
@cindex @env{MAIL} environment variable
The variable @code{rmail-primary-inbox-list} contains a list of the
-files which are inboxes for your primary Rmail file. If you don't set
+files that are inboxes for your primary Rmail file. If you don't set
this variable explicitly, Rmail uses the @env{MAIL} environment
variable, or, as a last resort, a default inbox based on
@code{rmail-spool-directory}. The default inbox file depends on your
@@ -367,6 +366,7 @@ all into a separate Rmail file avoids the need for interlocking in all
the rest of Rmail, since only Rmail operates on the Rmail file.
@end enumerate
+@c FIXME remove this in Emacs 25; won't be relevant any more.
Rmail was originally written to use the Babyl format as its internal
format. Since then, we have recognized that the usual inbox format
(@samp{mbox}) on Unix and GNU systems is adequate for the job, and so
@@ -454,6 +454,7 @@ second says which files in that directory to offer (all those that match
the regular expression). If no files match, you cannot select this menu
item. These variables also apply to choosing a file for output
(@pxref{Rmail Output}).
+@c FIXME matches only checked when Rmail file first visited?
@ignore
@findex set-rmail-inbox-list
@@ -516,6 +517,7 @@ currently displayed and no more. @xref{Rmail Display}. In addition,
@kbd{o} converts the message to Babyl format (used by Rmail in Emacs
version 22 and before) if the file is in Babyl format; @kbd{C-o}
cannot output to Babyl files at all.
+@c FIXME remove BABYL mention in Emacs 25?
If the output file is currently visited in an Emacs buffer, the
output commands append the message to that buffer. It is up to you to
@@ -727,7 +729,7 @@ Try sending a bounced message a second time (@code{rmail-retry-failure}).
@cindex reply to a message
The most common reason to send a message while in Rmail is to reply
to the message you are reading. To do this, type @kbd{r}
-(@code{rmail-reply}). This displays the @samp{*mail*} buffer in
+(@code{rmail-reply}). This displays a mail composition buffer in
another window, much like @kbd{C-x 4 m}, but preinitializes the
@samp{Subject}, @samp{To}, @samp{CC}, @samp{In-reply-to} and
@samp{References} header fields based on the message you are replying
@@ -735,23 +737,20 @@ to. The @samp{To} field starts out as the address of the person who
sent the message you received, and the @samp{CC} field starts out with
all the other recipients of that message.
-@vindex rmail-dont-reply-to-names
+@vindex mail-dont-reply-to-names
You can exclude certain recipients from being included automatically
-in replies, using the variable @code{rmail-dont-reply-to-names}. Its
+in replies, using the variable @code{mail-dont-reply-to-names}. Its
value should be a regular expression; any recipients that match are
excluded from the @samp{CC} field. They are also excluded from the
@samp{To} field, unless this would leave the field empty. If this
variable is nil, then the first time you compose a reply it is
-initialized to a default value that matches your own address, and any
-name starting with @samp{info-}. (Those names are excluded because
-there is a convention of using them for large mailing lists to broadcast
-announcements.)
+initialized to a default value that matches your own address.
To omit the @samp{CC} field completely for a particular reply, enter
the reply command with a numeric argument: @kbd{C-u r} or @kbd{1 r}.
This means to reply only to the sender of the original message.
- Once the @samp{*mail*} buffer has been initialized, editing and
+ Once the mail composition buffer has been initialized, editing and
sending the mail goes as usual (@pxref{Sending Mail}). You can edit
the presupplied header fields if they are not what you want. You can
also use commands such as @kbd{C-c C-y}, which yanks in the message
@@ -767,7 +766,7 @@ and yank the new current message.
send the failed message back to you, enclosed in a @dfn{failure
message}. The Rmail command @kbd{M-m} (@code{rmail-retry-failure})
prepares to send the same message a second time: it sets up a
-@samp{*mail*} buffer with the same text and header fields as before. If
+mail composition buffer with the same text and header fields as before. If
you type @kbd{C-c C-c} right away, you send the message again exactly
the same as the first time. Alternatively, you can edit the text or
headers and then send it. The variable
@@ -780,23 +779,31 @@ headers are stripped from the failed message when retrying it.
@cindex forwarding a message
Another frequent reason to send mail in Rmail is to @dfn{forward} the
current message to other users. @kbd{f} (@code{rmail-forward}) makes
-this easy by preinitializing the @samp{*mail*} buffer with the current
-message as the text, and a subject designating a forwarded message. All
-you have to do is fill in the recipients and send. When you forward a
-message, recipients get a message which is ``from'' you, and which has
-the original message in its contents.
-
+this easy by preinitializing the mail composition buffer with the current
+message as the text, and a subject of the form @code{[@var{from}:
+@var{subject}]}, where @var{from} and @var{subject} are the sender and
+subject of the original message. All you have to do is fill in the
+recipients and send. When you forward a message, recipients get a
+message which is ``from'' you, and which has the original message in
+its contents.
+
+@vindex rmail-enable-mime-composing
@findex unforward-rmail-message
- Forwarding a message encloses it between two delimiter lines. It also
-modifies every line that starts with a dash, by inserting @w{@samp{- }}
-at the start of the line. When you receive a forwarded message, if it
+ Rmail offers two formats for forwarded messages. The default is to
+use MIME (@pxref{Rmail Display}) format. This includes the original
+message as a separate part. You can use a simpler format if you
+prefer, by setting the variable @code{rmail-enable-mime-composing} to
+@code{nil}. In this case, Rmail just includes the original message
+enclosed between two delimiter lines. It also modifies every line
+that starts with a dash, by inserting @w{@samp{- }} at the start of
+the line. When you receive a forwarded message in this format, if it
contains something besides ordinary text---for example, program source
-code---you might find it useful to undo that transformation. You can do
-this by selecting the forwarded message and typing @kbd{M-x
-unforward-rmail-message}. This command extracts the original forwarded
-message, deleting the inserted @w{@samp{- }} strings, and inserts it
-into the Rmail file as a separate message immediately following the
-current one.
+code---you might find it useful to undo that transformation. You can
+do this by selecting the forwarded message and typing @kbd{M-x
+unforward-rmail-message}. This command extracts the original
+forwarded message, deleting the inserted @w{@samp{- }} strings, and
+inserts it into the Rmail file as a separate message immediately
+following the current one.
@findex rmail-resend
@dfn{Resending} is an alternative similar to forwarding; the
@@ -812,22 +819,28 @@ numeric argument.)
Use the @kbd{m} (@code{rmail-mail}) command to start editing an
outgoing message that is not a reply. It leaves the header fields empty.
Its only difference from @kbd{C-x 4 m} is that it makes the Rmail buffer
-accessible for @kbd{C-c C-y}, just as @kbd{r} does. Thus, @kbd{m} can be
-used to reply to or forward a message; it can do anything @kbd{r} or @kbd{f}
-can do.
+accessible for @kbd{C-c C-y}, just as @kbd{r} does.
+@ignore
+@c Not a good idea, because it does not include Reply-To etc.
+Thus, @kbd{m} can be used to reply to or forward a message; it can do
+anything @kbd{r} or @kbd{f} can do.
+@end ignore
@kindex c @r{(Rmail)}
@findex rmail-continue
The @kbd{c} (@code{rmail-continue}) command resumes editing the
-@samp{*mail*} buffer, to finish editing an outgoing message you were
+mail composition buffer, to finish editing an outgoing message you were
already composing, or to alter a message you have sent.
@vindex rmail-mail-new-frame
If you set the variable @code{rmail-mail-new-frame} to a
non-@code{nil} value, then all the Rmail commands to start sending a
message create a new frame to edit it in. This frame is deleted when
-you send the message, or when you use the @samp{Cancel} item in the
-@samp{Mail} menu.
+you send the message.
+@ignore
+@c FIXME does not work with Message -> Kill Message
+, or when you use the @samp{Cancel} item in the @samp{Mail} menu.
+@end ignore
All the Rmail commands to send a message use the mail-composition
method that you have chosen (@pxref{Mail Methods}).
@@ -905,8 +918,8 @@ commas.
makes a partial summary mentioning only the messages that have one or
more recipients matching the regular expression @var{rcpts}. You can
use commas to separate multiple regular expressions. These are matched
-against the @samp{To}, @samp{From}, and @samp{CC} headers (with a prefix
-argument, this header is not included).
+against the @samp{To}, @samp{From}, and @samp{CC} headers (supply a prefix
+argument to exclude this header).
@kindex C-M-t @r{(Rmail)}
@findex rmail-summary-by-topic
@@ -1118,7 +1131,7 @@ buffer before sorting it.
@section Display of Messages
This section describes how Rmail displays mail headers,
-@acronym{MIME} sections and attachments, and URLs.
+@acronym{MIME} sections and attachments, URLs, and encrypted messages.
@table @kbd
@item t
@@ -1178,7 +1191,7 @@ Move point to the next @acronym{MIME} tagline button.
(@code{rmail-mime-next-item}).
@findex rmail-mime-previous-item
-@item @key{BackTab}
+@item S-@key{TAB}
Move point to the previous @acronym{MIME} part
(@code{rmail-mime-previous-item}).
@@ -1195,7 +1208,7 @@ immediately after its tagline, as part of the Rmail buffer, while
taglines, with their actual contents hidden. In either case, you can
toggle a @acronym{MIME} part between its ``displayed'' and ``hidden''
states by typing @key{RET} anywhere in the part---or anywhere in its
-tagline, apart from a tagline button for some other action. Type
+tagline (except for buttons for other actions, if there are any). Type
@key{RET} (or click with the mouse) to activate a tagline button, and
@key{TAB} to cycle point between tagline buttons.
@@ -1209,13 +1222,19 @@ variable @code{rmail-enable-mime} to @code{nil}. When this is the
case, the @kbd{v} (@code{rmail-mime}) command instead creates a
temporary buffer to display the current @acronym{MIME} message.
+@findex rmail-epa-decrypt
+@cindex encrypted mails (reading in Rmail)
+ If the current message is an encrypted one, use the command @kbd{M-x
+rmail-epa-decrypt} to decrypt it, using the EasyPG library
+(@pxref{Top,, EasyPG, epa, EasyPG Assistant User's Manual}).
+
You can highlight and activate URLs in the Rmail buffer using Goto
Address mode:
@c FIXME goto-addr.el commentary says to use goto-address instead.
-@smallexample
+@example
(add-hook 'rmail-show-message-hook 'goto-address-mode)
-@end smallexample
+@end example
@noindent
Then you can browse these URLs by clicking on them with @kbd{Mouse-2}
@@ -1294,13 +1313,13 @@ the message, if you have made any changes in it.
@cindex undigestify
A @dfn{digest message} is a message which exists to contain and carry
-several other messages. Digests are used on some moderated mailing
+several other messages. Digests are used on some mailing
lists; all the messages that arrive for the list during a period of time
such as one day are put inside a single digest which is then sent to the
-subscribers. Transmitting the single digest uses much less computer
+subscribers. Transmitting the single digest uses less computer
time than transmitting the individual messages even though the total
-size is the same, because the per-message overhead in network mail
-transmission is considerable.
+size is the same, because of the per-message overhead in network mail
+transmission.
@findex undigestify-rmail-message
When you receive a digest message, the most convenient way to read it is
@@ -1315,14 +1334,15 @@ message itself is flagged as deleted.
@section Reading Rot13 Messages
@cindex rot13 code
- Mailing list messages that might offend some readers are sometimes
+ Mailing list messages that might offend or annoy some readers are sometimes
encoded in a simple code called @dfn{rot13}---so named because it
rotates the alphabet by 13 letters. This code is not for secrecy, as it
-provides none; rather, it enables those who might be offended to avoid
-seeing the real text of the message.
+provides none; rather, it enables those who wish to to avoid
+seeing the real text of the message. For example, a review of a film
+might use rot13 to hide important plot points.
@findex rot13-other-window
- To view a buffer which uses the rot13 code, use the command @kbd{M-x
+ To view a buffer that uses the rot13 code, use the command @kbd{M-x
rot13-other-window}. This displays the current buffer in another window
which applies the code when displaying the text.
@@ -1335,7 +1355,7 @@ your Rmail file (@pxref{Rmail Inbox}). When loaded for the first time,
Rmail attempts to locate the @code{movemail} program and determine its
version. There are two versions of the @code{movemail} program: the
native one, shipped with GNU Emacs (the ``emacs version'') and the one
-included in GNU mailutils (the ``mailutils version,''
+included in GNU mailutils (the ``mailutils version'',
@pxref{movemail,,,mailutils,GNU mailutils}). They support the same
command line syntax and the same basic subset of options. However, the
Mailutils version offers additional features.
@@ -1428,8 +1448,8 @@ This is equivalent to specifying the @samp{file} protocol:
@code{movemail} to use. If that is a string, it specifies the
absolute file name of the @code{movemail} executable. If it is
@code{nil}, Rmail searches for @code{movemail} in the directories
-listed in @code{rmail-movemail-search-path} and @code{exec-path}, then
-in @code{exec-directory}.
+listed in @code{rmail-movemail-search-path}, then in @code{exec-path}
+(@pxref{Shell}), then in @code{exec-directory}.
@node Remote Mailboxes
@section Retrieving Mail from Remote Mailboxes
diff --git a/doc/emacs/screen.texi b/doc/emacs/screen.texi
index fcc31e30988..2b8edaf9375 100644
--- a/doc/emacs/screen.texi
+++ b/doc/emacs/screen.texi
@@ -1,19 +1,19 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Screen, User Input, Acknowledgments, Top
+@node Screen
@chapter The Organization of the Screen
@cindex screen
@cindex frame
On a graphical display, such as on GNU/Linux using the X Window
-System, Emacs occupies a ``graphical window''. On a text-only
-terminal, Emacs occupies the entire terminal screen. We will use the
-term @dfn{frame} to mean a graphical window or terminal screen
-occupied by Emacs. Emacs behaves very similarly on both kinds of
-frames. It normally starts out with just one frame, but you can
-create additional frames if you wish (@pxref{Frames}).
+System, Emacs occupies a ``graphical window''. On a text terminal,
+Emacs occupies the entire terminal screen. We will use the term
+@dfn{frame} to mean a graphical window or terminal screen occupied by
+Emacs. Emacs behaves very similarly on both kinds of frames. It
+normally starts out with just one frame, but you can create additional
+frames if you wish (@pxref{Frames}).
Each frame consists of several distinct regions. At the top of the
frame is a @dfn{menu bar}, which allows you to access commands via a
@@ -131,15 +131,15 @@ Commands that take a long time often display messages ending in
progress has been made, as a percentage), and add @samp{done} when
they are finished.
-@cindex @samp{*Messages*} buffer
+@cindex @file{*Messages*} buffer
@cindex saved echo area messages
@cindex messages saved from echo area
@vindex message-log-max
Informative echo area messages are saved in a special buffer named
-@samp{*Messages*}. (We have not explained buffers yet; see
+@file{*Messages*}. (We have not explained buffers yet; see
@ref{Buffers}, for more information about them.) If you miss a
message that appeared briefly on the screen, you can switch to the
-@samp{*Messages*} buffer to see it again. The @samp{*Messages*}
+@file{*Messages*} buffer to see it again. The @file{*Messages*}
buffer is limited to a certain number of lines, specified by the
variable @code{message-log-max}. (We have not explained variables
either; see @ref{Variables}, for more information about them.) Beyond
@@ -178,7 +178,7 @@ unselected windows, in order to make it stand out.
@end example
@noindent
-On a text-only terminal, this text is followed by a series of dashes
+On a text terminal, this text is followed by a series of dashes
extending to the right edge of the window. These dashes are omitted
on a graphical display.
@@ -195,7 +195,7 @@ means no conversion whatsoever, and is usually used for files
containing non-textual data. Other characters represent various
@dfn{coding systems}---for example, @samp{1} represents ISO Latin-1.
- On a text-only terminal, @var{cs} is preceded by two additional
+ On a text terminal, @var{cs} is preceded by two additional
characters that describe the coding systems for keyboard input and
terminal output. Furthermore, if you are using an input method,
@var{cs} is preceded by a string that identifies the input method
@@ -228,7 +228,7 @@ However, if the default-directory for the current buffer is on a
remote machine, @samp{@@} is displayed instead (@pxref{File Names}).
@var{fr} gives the selected frame name (@pxref{Frames}). It appears
-only on text-only terminals. The initial frame's name is @samp{F1}.
+only on text terminals. The initial frame's name is @samp{F1}.
@var{buf} is the name of the buffer displayed in the window.
Usually, this is the same as the name of a file you are editing.
@@ -307,13 +307,12 @@ You can then navigate the menus with the arrow keys. To activate a
selected menu item, press @key{RET}; to cancel menu navigation, press
@key{ESC}.
- On a text-only terminal, you can use the menu bar by typing
-@kbd{M-`} or @key{F10} (these run the command @code{tmm-menubar}).
-This lets you select a menu item with the keyboard. A provisional
-choice appears in the echo area. You can use the up and down arrow
-keys to move through the menu to different items, and then you can
-type @key{RET} to select the item. Each menu item is also designated
-by a letter or digit (usually the initial of some word in the item's
-name). This letter or digit is separated from the item name by
-@samp{=>}. You can type the item's letter or digit to select the
-item.
+ On a text terminal, you can use the menu bar by typing @kbd{M-`} or
+@key{F10} (these run the command @code{tmm-menubar}). This lets you
+select a menu item with the keyboard. A provisional choice appears in
+the echo area. You can use the up and down arrow keys to move through
+the menu to different items, and then you can type @key{RET} to select
+the item. Each menu item is also designated by a letter or digit
+(usually the initial of some word in the item's name). This letter or
+digit is separated from the item name by @samp{==>}. You can type the
+item's letter or digit to select the item.
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index c6747042df5..7dc5855cdfc 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Search, Fixit, Display, Top
+@node Search
@chapter Searching and Replacement
@cindex searching
@cindex finding strings within text
@@ -17,11 +17,11 @@ thing, but search for patterns instead of fixed strings.
(@pxref{Operating on Files}), or ask the @code{grep} program to do it
(@pxref{Grep Searching}).
-
@menu
* Incremental Search:: Search happens as you type the string.
* Nonincremental Search:: Specify entire string and then search.
* Word Search:: Search for sequence of words.
+* Symbol Search:: Search for a source code symbol.
* Regexp Search:: Search for match for a regexp.
* Regexps:: Syntax of regular expressions.
* Regexp Backslash:: Regular expression constructs starting with `\'.
@@ -146,7 +146,7 @@ you don't like this feature, you can disable it by setting
After exiting a search, you can search for the same string again by
typing just @kbd{C-s C-s}. The first @kbd{C-s} is the key that
invokes incremental search, and the second @kbd{C-s} means ``search
-again.'' Similarly, @kbd{C-r C-r} searches backward for the last
+again''. Similarly, @kbd{C-r C-r} searches backward for the last
search string. In determining the last search string, it doesn't
matter whether the string was searched for with @kbd{C-s} or
@kbd{C-r}.
@@ -218,6 +218,24 @@ search.
Some of the characters you type during incremental search have
special effects.
+@cindex lax space matching
+@kindex M-s SPC @r{(Incremental search)}
+@kindex SPC @r{(Incremental search)}
+@findex isearch-toggle-lax-whitespace
+@vindex search-whitespace-regexp
+ By default, incremental search performs @dfn{lax space matching}:
+each space, or sequence of spaces, matches any sequence of one or more
+spaces in the text. Hence, @samp{foo bar} matches @samp{foo bar},
+@samp{foo bar}, @samp{foo bar}, and so on (but not @samp{foobar}).
+More precisely, Emacs matches each sequence of space characters in the
+search string to a regular expression specified by the variable
+@code{search-whitespace-regexp}. For example, set it to
+@samp{"[[:space:]\n]+"} to make spaces match sequences of newlines as
+well as spaces. To toggle lax space matching, type @kbd{M-s SPC}
+(@code{isearch-toggle-lax-whitespace}). To disable this feature
+entirely, change @code{search-whitespace-regexp} to @code{nil}; then
+each space in the search string matches exactly one space
+
If the search string you entered contains only lower-case letters,
the search is case-insensitive; as long as an upper-case letter exists
in the search string, the search becomes case-sensitive. If you
@@ -450,13 +468,54 @@ the search string can match part of a word, so that the matching
proceeds incrementally as you type. This additional laxity does not
apply to the lazy highlight, which always matches whole words.
+@node Symbol Search
+@section Symbol Search
+@cindex symbol search
+
+ A @dfn{symbol search} is much like an ordinary search, except that
+the boundaries of the search must match the boundaries of a symbol.
+The meaning of @dfn{symbol} in this context depends on the major mode,
+and usually refers to a source code token, such as a Lisp symbol in
+Emacs Lisp mode. For instance, if you perform an incremental symbol
+search for the Lisp symbol @code{forward-word}, it would not match
+@code{isearch-forward-word}. This feature is thus mainly useful for
+searching source code.
+
+@table @kbd
+@item M-s _
+If incremental search is active, toggle symbol search mode
+(@code{isearch-toggle-symbol}); otherwise, begin an incremental
+forward symbol search (@code{isearch-forward-symbol}).
+@item M-s _ @key{RET} @var{symbol} @key{RET}
+Search forward for @var{symbol}, nonincrementally.
+@item M-s _ C-r @key{RET} @var{symbol} @key{RET}
+Search backward for @var{symbol}, nonincrementally.
+@end table
+
+@kindex M-s _
+@findex isearch-forward-symbol
+ To begin a forward incremental symbol search, type @kbd{M-s _}. If
+incremental search is not already active, this runs the command
+@code{isearch-forward-symbol}. If incremental search is already
+active, @kbd{M-s _} switches to a symbol search, preserving the
+direction of the search and the current search string; you can disable
+symbol search by typing @kbd{M-s _} again. In incremental symbol
+search, only the beginning of the search string is required to match
+the beginning of a symbol.
+
+ To begin a nonincremental symbol search, type @kbd{M-s _ @key{RET}}
+for a forward search, or @kbd{M-s _ C-r @key{RET}} or a backward
+search. In nonincremental symbol searches, the beginning and end of
+the search string are required to match the beginning and end of a
+symbol, respectively.
+
@node Regexp Search
@section Regular Expression Search
@cindex regexp search
@cindex search for a regular expression
A @dfn{regular expression} (or @dfn{regexp} for short) is a pattern
-that denotes a class of alternative strings to match. GNU Emacs
+that denotes a class of alternative strings to match. Emacs
provides both incremental and nonincremental ways to search for a
match for a regexp. The syntax of regular expressions is explained in
the next section.
@@ -492,12 +551,12 @@ Incremental regexp and non-regexp searches have independent defaults.
They also have separate search rings, which you can access with
@kbd{M-p} and @kbd{M-n}.
-@vindex search-whitespace-regexp
- If you type @key{SPC} in incremental regexp search, it matches any
-sequence of whitespace characters, including newlines. If you want to
-match just a space, type @kbd{C-q @key{SPC}}. You can control what a
-bare space matches by setting the variable
-@code{search-whitespace-regexp} to the desired regexp.
+ Just as in ordinary incremental search, any @key{SPC} typed in
+incremental regexp search matches any sequence of one or more
+whitespace characters. The variable @code{search-whitespace-regexp}
+specifies the regexp for the lax space matching, and @kbd{M-s SPC}
+(@code{isearch-toggle-lax-whitespace}) toggles the feature.
+@xref{Special Isearch}.
In some cases, adding characters to the regexp in an incremental
regexp search can make the cursor move back and start again. For
@@ -552,7 +611,7 @@ therefore @samp{f} is a regular expression that matches the string
@samp{ff}.) Likewise, @samp{o} is a regular expression that matches
only @samp{o}. (When case distinctions are being ignored, these regexps
also match @samp{F} and @samp{O}, but we consider this a generalization
-of ``the same string,'' rather than an exception.)
+of ``the same string'', rather than an exception.)
Any two regular expressions @var{a} and @var{b} can be concatenated.
The result is a regular expression which matches a string if @var{a}
@@ -801,7 +860,7 @@ After the end of a @samp{\( @dots{} \)} construct, the matcher remembers
the beginning and end of the text matched by that construct. Then,
later on in the regular expression, you can use @samp{\} followed by the
digit @var{d} to mean ``match the same text matched the @var{d}th time
-by the @samp{\( @dots{} \)} construct.''
+by the @samp{\( @dots{} \)} construct''.
The strings matching the first nine @samp{\( @dots{} \)} constructs
appearing in a regular expression are assigned numbers 1 through 9 in
@@ -974,6 +1033,13 @@ instead (@pxref{Mark}). The basic replace commands replace one
is possible to perform several replacements in parallel, using the
command @code{expand-region-abbrevs} (@pxref{Expanding Abbrevs}).
+@vindex replace-lax-whitespace
+ Unlike incremental search, the replacement commands do not use lax
+space matching (@pxref{Special Isearch}) by default. To enable lax
+space matching for replacement, change the variable
+@code{replace-lax-whitespace} to @code{t}. (This only affects how
+Emacs finds the text to replace, not the replacement text.)
+
@menu
* Unconditional Replace:: Replacing all matches for a string.
* Regexp Replace:: Replacing all matches for a regexp.
@@ -981,7 +1047,7 @@ command @code{expand-region-abbrevs} (@pxref{Expanding Abbrevs}).
* Query Replace:: How to use querying.
@end menu
-@node Unconditional Replace, Regexp Replace, Replace, Replace
+@node Unconditional Replace
@subsection Unconditional Replacement
@findex replace-string
@@ -1011,7 +1077,7 @@ surrounded by word boundaries.
@xref{Replacement and Case}, for details about case-sensitivity in
replace commands.
-@node Regexp Replace, Replacement and Case, Unconditional Replace, Replace
+@node Regexp Replace
@subsection Regexp Replacement
@findex replace-regexp
@@ -1030,7 +1096,7 @@ it can refer to all or part of what is matched by the @var{regexp}.
@samp{\&} in @var{newstring} stands for the entire match being
replaced. @samp{\@var{d}} in @var{newstring}, where @var{d} is a
digit, stands for whatever matched the @var{d}th parenthesized
-grouping in @var{regexp}. (This is called a ``back reference.'')
+grouping in @var{regexp}. (This is called a ``back reference''.)
@samp{\#} refers to the count of replacements already made in this
command, as a decimal number. In the first replacement, @samp{\#}
stands for @samp{0}; in the second, for @samp{1}; and so on. For
@@ -1098,7 +1164,7 @@ M-x replace-regexp @key{RET} ^.\@{0,72\@}$ @key{RET}
\,(format "%-72sABC%05d" \& \#) @key{RET}
@end example
-@node Replacement and Case, Query Replace, Regexp Replace, Replace
+@node Replacement and Case
@subsection Replace Commands and Case
If the first argument of a replace command is all lower case, the
@@ -1130,7 +1196,7 @@ exactly as given, with no case conversion. Likewise, if either
@code{case-replace} or @code{case-fold-search} is set to @code{nil},
replacement is done without case conversion.
-@node Query Replace,, Replacement and Case, Replace
+@node Query Replace
@subsection Query Replace
@cindex query replace
@@ -1215,6 +1281,19 @@ occurrences.
@item !
to replace all remaining occurrences without asking again.
+@item Y @r{(Upper-case)}
+to replace all remaining occurrences in all remaining buffers in
+multi-buffer replacements (like the Dired `Q' command which performs
+query replace on selected files). It answers this question and all
+subsequent questions in the series with "yes", without further
+user interaction.
+
+@item N @r{(Upper-case)}
+to skip to the next buffer in multi-buffer replacements without
+replacing remaining occurrences in the current buffer. It answers
+this question "no", gives up on the questions for the current buffer,
+and continues to the next buffer in the sequence.
+
@item ^
to go back to the position of the previous occurrence (or what used to
be an occurrence), in case you changed it by mistake or want to
@@ -1308,7 +1387,7 @@ displayed before and after each matching line.
@kindex RET @r{(Occur mode)}
@kindex o @r{(Occur mode)}
@kindex C-o @r{(Occur mode)}
-In the @samp{*Occur*} buffer, you can click on each entry, or move
+In the @file{*Occur*} buffer, you can click on each entry, or move
point there and type @key{RET}, to visit the corresponding position in
the buffer that was searched. @kbd{o} and @kbd{C-o} display the match
in another window; @kbd{C-o} does not select it. Alternatively, you
@@ -1317,7 +1396,7 @@ occurrences one by one (@pxref{Compilation Mode}).
@cindex Occur Edit mode
@cindex mode, Occur Edit
-Typing @kbd{e} in the @samp{*Occur*} buffer switches to Occur Edit
+Typing @kbd{e} in the @file{*Occur*} buffer switches to Occur Edit
mode, in which edits made to the entries are also applied to the text
in the originating buffer. Type @kbd{C-c C-c} to return to Occur
mode.
diff --git a/doc/emacs/sending.texi b/doc/emacs/sending.texi
index 50ec852d740..8802e5392d7 100644
--- a/doc/emacs/sending.texi
+++ b/doc/emacs/sending.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Sending Mail
@@ -11,10 +11,10 @@
@kindex C-x m
@findex compose-mail
- To send an @dfn{e-mail} message in Emacs, type @kbd{C-x m}. This
-selects and initializes a buffer named @samp{*mail*}, where you can
-edit the text and headers of the message. Finally, type @kbd{C-c C-s}
-or @kbd{C-c C-c} to send the message.
+ To send an email message from Emacs, type @kbd{C-x m}. This
+switches to a buffer named @file{*unsent mail*}, where you can edit
+the text and headers of the message. When done, type @kbd{C-c C-s} or
+@kbd{C-c C-c} to send it.
@table @kbd
@item C-x m
@@ -30,37 +30,28 @@ In the mail buffer, send the message and bury the buffer
(@code{message-send-and-exit}).
@end table
+ The mail buffer is an ordinary Emacs buffer, so you can switch to
+other buffers while composing the mail. If you want to send another
+mail before finishing the current one, type @kbd{C-x m} again to open
+a new mail buffer whose name has a different numeric suffix
+(@pxref{Misc Buffer}). If you invoke the command with a prefix
+argument, @w{@kbd{C-u C-x m}}, Emacs switches back to the last mail
+buffer, and asks if you want to erase the message in that buffer; if
+you answer no, this lets you pick up editing the message where you
+left off.
+
@kindex C-x 4 m
@findex compose-mail-other-window
@kindex C-x 5 m
@findex compose-mail-other-frame
-@noindent
-The command @kbd{C-x 4 m} (@code{compose-mail-other-window}) does the
-same as @kbd{C-x m}, except it displays the mail buffer in a different
-window. The command @kbd{C-x 5 m} (@code{compose-mail-other-frame})
-creates a new frame for the mail buffer.
-
- Because the mail buffer is an ordinary Emacs buffer, you can switch
-to other buffers while in the middle of composing mail, and switch
-back later (or never). If you type @kbd{C-x m} again when you have
-been composing another message but have not sent it, Emacs asks for
-confirmation before erasing the old message. If you answer @kbd{n},
-Emacs selects the mail buffer with its old contents, so you can finish
-the old message and send it. @kbd{C-u C-x m} is another way to do
-this. Sending the message marks the mail buffer ``unmodified,'' which
-avoids the need for confirmation when @kbd{C-x m} is next used.
-
- If you want to send another message before finishing the current
-message, use the command @kbd{M-x rename-uniquely} to rename the
-current mail buffer (@pxref{Misc Buffer}). Then you can use @kbd{C-x
-m} to make a new mail buffer, and work with each mail buffer
-independently.
-
- Before using Emacs to send mail, you may need to customize the
-variable @code{send-mail-function} if your system is not set up to
-deliver mail directly via SMTP (@pxref{Mail Sending}). In addition,
-you may need to customize @code{user-mail-address} if the system
-cannot receive mail via SMTP (@pxref{Mail Headers}).
+ The command @kbd{C-x 4 m} (@code{compose-mail-other-window}) does
+the same as @kbd{C-x m}, except it displays the mail buffer in a
+different window. The command @kbd{C-x 5 m}
+(@code{compose-mail-other-frame}) does it in a new frame.
+
+ When you type @kbd{C-c C-c} or @kbd{C-c C-s} to send the mail, Emacs
+may ask you how it should deliver the mail---either directly via SMTP,
+or using some other method. @xref{Mail Sending}, for details.
@menu
* Format: Mail Format. Format of a mail message.
@@ -75,77 +66,91 @@ cannot receive mail via SMTP (@pxref{Mail Headers}).
@node Mail Format
@section The Format of the Mail Buffer
- An email message must contain certain pieces of information, called
-@dfn{headers}, which specify the message's sender, recipient(s), and
-so on.
-
- At the top of the mail buffer is a set of @dfn{header fields}, where
-you can enter this information. You can insert and edit header fields
-using ordinary editing commands. @xref{Header Editing}, for commands
-specific to editing header fields.
-
- Some header fields are automatically pre-initialized in the buffer,
-when appropriate; other headers, such as @samp{Date} and
-@samp{Message-Id}, are normally omitted from the mail buffer and
-created automatically when the message is sent.
-
-@vindex mail-header-separator
- The line in the buffer that says
-
-@smallexample
---text follows this line--
-@end smallexample
-
-@noindent
-separates the header fields from the @dfn{body} (or @dfn{text}) of the
-message. Everything above this line is treated as part of the
-headers; everything below it is treated as the body. The delimiter
-line itself does not appear in the message actually sent. The text
-used for the delimiter line is controlled by the variable
-@code{mail-header-separator}.
-
- Here is an example of what the headers and text in the mail buffer
-might look like.
+ Here is an example of the contents of a mail buffer:
@example
-To: gnu@@example.org
-CC: lungfish@@example.com, byob@@example.net
-Subject: The Emacs Manual
+To: subotai@@example.org
+CC: mongol.soldier@@example.net, rms@@gnu.org
+Subject: Re: What is best in life?
+From: conan@@example.org
--text follows this line--
-Please ignore this message.
+To crush your enemies, see them driven before you, and to
+hear the lamentation of their women.
@end example
+@noindent
+At the top of the mail buffer is a set of @dfn{header fields}, which
+are used for specifying information about the email's recipient(s),
+subject, and so on. The above buffer contains header fields for
+@samp{To}, @samp{Cc}, @samp{Subject}, and @samp{From}. Some header
+fields are automatically pre-initialized in the mail buffer, when
+appropriate.
+
+ The line that says @samp{--text follows this line--} separates the
+header fields from the @dfn{body} (or @dfn{text}) of the message.
+Everything above that line is treated as part of the headers;
+everything below it is treated as the body. The delimiter line itself
+does not appear in the message actually sent.
+
+ You can insert and edit header fields using ordinary editing
+commands. @xref{Header Editing}, for commands specific to editing
+header fields. Certain headers, such as @samp{Date} and
+@samp{Message-Id}, are normally omitted from the mail buffer and are
+created automatically when the message is sent.
+
@node Mail Headers
@section Mail Header Fields
@cindex headers (of mail message)
A header field in the mail buffer starts with a field name at the
beginning of a line, terminated by a colon. Upper and lower case are
-equivalent in field names (and in mailing addresses also). After the
-colon and optional whitespace comes the contents of the field.
+equivalent in field names. After the colon and optional whitespace
+comes the contents of the field.
You can use any name you like for a header field, but normally
-people use only standard field names with accepted meanings. Here is
-a table of commonly-used fields. Emacs pre-initializes some of these,
-depending on various options you can set. You can delete or alter any
-header field before you send the message, if you wish.
+people use only standard field names with accepted meanings.
-@table @samp
-@item From
+@vindex user-full-name
@vindex user-mail-address
-The address of the sender (you). This should be a valid mailing
-address, as replies will normally go there. Emacs initializes this
-field using the variables @code{user-full-name} and
-@code{user-mail-address}; see below.
+ The @samp{From} header field identifies the person sending the email
+(i.e.@: you). This should be a valid mailing address, as replies are
+normally sent there. The default contents of this header field are
+computed from the variables @code{user-full-name} (which specifies
+your full name) and @code{user-mail-address} (your email address). On
+some operating systems, Emacs initializes these two variables using
+environment variables (@pxref{General Variables}). If this
+information is unavailable or wrong, you should customize the
+variables yourself (@pxref{Easy Customization}).
+
+@vindex mail-from-style
+ The value of the variable @code{mail-from-style} specifies how to
+format the contents of the @samp{From} field:
+
+@table @asis
+@item @code{nil}
+Use just the address, as in @samp{king@@grassland.com}.
+@item @code{parens}
+Use both address and full name, as in:@*
+@samp{king@@grassland.com (Elvis Parsley)}.
+@item @code{angles}
+Use both address and full name, as in:@*
+@samp{Elvis Parsley <king@@grassland.com>}.
+@item any other value
+Use @code{angles} normally. But if the address must be ``quoted'' to
+remain syntactically valid under the @code{angles} format but not
+under the @code{parens} format, use @code{parens} instead. This is
+the default.
+@end table
+
+ Apart from @samp{From}, here is a table of commonly-used fields:
+@table @samp
@item To
The mailing address(es) to which the message is addressed. To list
-more than one address, use commas (not spaces) to separate them.
+more than one address, use commas to separate them.
@item Subject
-A piece of text saying what the message is about. Most mail-reading
-programs can display a summary of messages, listing the subject of
-each message but not its text.
+The subject of the message.
@item CC
Additional mailing address(es) to send the message to. This is like
@@ -158,47 +163,38 @@ not appear in the header of the message actually sent. ``BCC'' stands
for @dfn{blind carbon copies}.
@item FCC
-The name of one file, to which a copy of the sent message should be
+The name of a file, to which a copy of the sent message should be
appended. Emacs writes the message in mbox format, unless the file is
in Babyl format (used by Rmail before Emacs 23), in which case Emacs
-writes Babyl. If an Rmail buffer is visiting the file, Emacs updates
-it accordingly. To specify more than one file, use several @samp{FCC}
-fields, with one file name in each field.
+writes in Babyl format. If an Rmail buffer is visiting the file,
+Emacs updates it accordingly. To specify more than one file, use
+several @samp{FCC} fields, with one file name in each field.
@item Reply-to
An address to which replies should be sent, instead of @samp{From}.
-You can use this header if, for some reason, your @samp{From} address
-is unable to receive replies.
+This is used if, for some reason, your @samp{From} address cannot
+receive replies.
@item Mail-reply-to
- This field takes precedence over @samp{Reply-to}. It is used because
-some mailing lists set the @samp{Reply-to} field for their own purposes
-(a somewhat controversial practice).
+This field takes precedence over @samp{Reply-to}. It is used because
+some mailing lists set the @samp{Reply-to} field for their own
+purposes (a somewhat controversial practice).
@item Mail-followup-to
- This field contains one or more addresses. It is typically used when
-you reply to a message from a mailing list that you are subscribed to.
-It usually indicates that you want replies to go to the list, and that
-you do not need an extra copy sent directly to you.
-
-@c Message mode handles this differently...
-@c @vindex mail-mailing-lists
-@c The variable @code{mail-mailing-lists} holds a list of mailing list
-@c addresses that you are subscribed to. If it is non-@code{nil}, Emacs
-@c inserts an appropriate @samp{Mail-followup-to} header when sending mail
-@c to a mailing list.
+One of more address(es) to use as default recipient(s) for follow-up
+messages. This is typically used when you reply to a message from a
+mailing list that you are subscribed to, and want replies to go to the
+list without sending an extra copy to you.
@item In-reply-to
-A piece of text describing the message you are replying to. Some mail
-systems can use this information to correlate related pieces of mail.
-Normally, you never need to think about this, because it is filled in
-automatically when you reply to a message in Rmail (or any other mail
-program built into Emacs).
+An identifier for the message you are replying to. Most mail readers
+use this information to group related messages together. Normally,
+this header is filled in automatically when you reply to a message in
+any mail program built into Emacs.
@item References
-The Message-Ids of previous related messages (a Message-Id is a unique
-identifier generated when a message is sent). Like
-@samp{In-reply-to}, this is normally set up automatically for you.
+Identifiers for previous related messages. Like @samp{In-reply-to},
+this is normally filled in automatically for you.
@end table
@noindent
@@ -217,35 +213,6 @@ To: foo@@example.net, this@@example.net,
@end group
@end example
-@vindex user-full-name
-@vindex user-mail-address
- The default contents of the @samp{From} header field are computed
-from the variables @code{user-full-name} and @code{user-mail-address}.
-On some operating systems, Emacs initializes these two variables using
-environment variables (@pxref{General Variables}). If this
-information is unavailable or wrong, you can customize the variables
-yourself (@pxref{Easy Customization}).
-
-@vindex mail-from-style
- The value of the variable @code{mail-from-style} specifies how to
-format the address in the @samp{From} field:
-
-@table @asis
-@item @code{nil}
-Use just the address, as in @samp{king@@grassland.com}.
-@item @code{parens}
-Use both address and full name, as in:@*
-@samp{king@@grassland.com (Elvis Parsley)}.
-@item @code{angles}
-Use both address and full name, as in:@*
-@samp{Elvis Parsley <king@@grassland.com>}.
-@item any other value
-Use @code{angles} for most addresses. However, if the address must be
-``quoted'' to remain syntactically-valid under the @code{angles}
-format but not under the @code{parens} format, use @code{parens}
-instead. This is the default.
-@end table
-
@c There is also mail-specify-envelope-from and mail-envelope-from, but
@c these are probably not topics for the Emacs manual.
@@ -273,13 +240,12 @@ particular message, edit them as necessary before sending the message.
@vindex mail-personal-alias-file
You can define @dfn{mail aliases}, which are short mnemonic names
-that stand for mail addresses or groups of mail addresses. By
-default, mail aliases are defined in the file @file{~/.mailrc}. You
-can specify a different file name to use, by setting the variable
+that stand for one or more mailing addresses. By default, mail
+aliases are defined in the file @file{~/.mailrc}. You can specify a
+different file name to use, by setting the variable
@code{mail-personal-alias-file}.
- To define an alias in @file{.mailrc}, write a line in the following
-format:
+ To define an alias in @file{.mailrc}, write a line like this:
@example
alias @var{nick} @var{fulladdresses}
@@ -340,7 +306,7 @@ completion, and inserts its definition at point.
@cindex Message mode
@cindex mode, Message
- The default major mode for the @samp{*mail*} buffer is called
+ The default major mode for the @file{*mail*} buffer is called
Message mode. It behaves like Text mode in many ways, but provides
several additional commands on the @kbd{C-c} prefix, which make
editing a message more convenient.
@@ -362,11 +328,9 @@ in greater detail. @xref{Top,,Message, message, Message}.
@node Mail Sending
@subsection Mail Sending
- There are two commands to send a message you have been editing:
-
@table @kbd
@item C-c C-c
-Send the message, and deselect the mail buffer (@code{message-send-and-exit}).
+Send the message, and bury the mail buffer (@code{message-send-and-exit}).
@item C-c C-s
Send the message, and leave the mail buffer selected (@code{message-send}).
@end table
@@ -374,70 +338,75 @@ Send the message, and leave the mail buffer selected (@code{message-send}).
@kindex C-c C-s @r{(Message mode)}
@kindex C-c C-c @r{(Message mode)}
@findex message-send
- If you want to send a message and be done with it, type @kbd{C-c
-C-c} (@code{mail-send-and-exit}). This sends the message and then
-either deletes the window or switches to another buffer. It also
+@vindex message-kill-buffer-on-exit
+ The usual command to send a message is @kbd{C-c C-c}
+(@code{mail-send-and-exit}). This sends the message and then
``buries'' the mail buffer, putting it at the lowest priority for
-reselection. This is the usual command for sending a message.
+reselection. If you want it to kill the mail buffer instead, change
+the variable @code{message-kill-buffer-on-exit} to @code{t}.
@findex message-send-and-exit
The command @kbd{C-c C-s} (@code{message-send}) sends the message
-and marks the mail buffer unmodified, but leaves the buffer selected.
-Use this command if you want to modify the message (perhaps with new
-recipients) and send it again.
+and leaves the buffer selected. Use this command if you want to
+modify the message (perhaps with new recipients) and send it again.
@vindex message-send-hook
- Sending a message runs the hook @code{message-send-hook}.
-
- In a file-visiting buffer, sending the message does not clear the
-modified flag, because only saving the file should do that. Also, you
-don't get a warning if you try to send the same message twice.
-
-@vindex sendmail-coding-system
- When you send a message containing non-@acronym{ASCII} characters,
-they need to be encoded with a coding system (@pxref{Coding Systems}).
-Usually the coding system is specified automatically by your chosen
-language environment (@pxref{Language Environments}). You can
-explicitly specify the coding system for outgoing mail by setting the
-variable @code{sendmail-coding-system} (@pxref{Recognize Coding}). If
-the coding system thus determined does not handle the characters in a
-particular message, Emacs asks you to select the coding system to use,
-showing a list of possible coding systems.
+ Sending a message runs the hook @code{message-send-hook}. It also
+marks the mail buffer as unmodified, except if the mail buffer is also
+a file-visiting buffer (in that case, only saving the file does that,
+and you don't get a warning if you try to send the same message
+twice).
@cindex SMTP
@cindex Feedmail
@cindex Sendmail
@cindex Mailclient
@vindex send-mail-function
- The variable @code{send-mail-function} controls how the default mail
-user agent sends mail. Its value should be a function, which can be
-one of the following:
+ The variable @code{send-mail-function} controls how the message is
+delivered. Its value should be one of the following functions:
@table @code
-@item sendmail-send-it
-Send mail using the system's default @command{sendmail} (or
-@command{sendmail}-compatible) program. This is the default on Unix
-and GNU, and works provided the system is a valid @dfn{mail host}
-(that is, provided it can deliver mail via SMTP).
-
-@item mailclient-send-it
-Pass the mail buffer on to the system's designated mail client (see
-@file{mailclient.el}). This is the default on Mac OS X and
-MS-Windows.
+@item sendmail-query-once
+Query for a delivery method (one of the other entries in this list),
+and use that method for this message; then save the method to
+@code{send-mail-function}, so that it is used for future deliveries.
+This is the default, unless you have already set the variables for
+sending mail via @code{smtpmail-send-it} (see below).
@item smtpmail-send-it
-Send mail through an external mail host (e.g., your Internet service
-provider's SMTP server). You will need to tell Emacs how to contact
-the SMTP server, by customizing the variables
-@code{smtpmail-smtp-server} and @code{smtpmail-auth-credentials}.
+Send mail using the through an external mail host, such as your
+Internet service provider's outgoing SMTP mail server. If you have
+not told Emacs how to contact the SMTP server, it prompts for this
+information, which is saved in the @code{smtpmail-smtp-server} variable
+and the file @file{~/.authinfo}.
@xref{Top,,Emacs SMTP Library, smtpmail, Sending mail via SMTP}.
+@item sendmail-send-it
+Send mail using the system's default @command{sendmail} program, or
+equivalent. This requires the system to be set up for delivering mail
+directly via SMTP.
+
+@item mailclient-send-it
+Pass the mail buffer on to the system's designated mail client. See
+the commentary section in the file @file{mailclient.el} for details.
+
@item feedmail-send-it
This is similar to @code{sendmail-send-it}, but allows you to queue
messages for later sending. See the commentary section in the file
-@file{feedmail.el} for more information.
+@file{feedmail.el} for details.
@end table
+@vindex sendmail-coding-system
+ When you send a message containing non-@acronym{ASCII} characters,
+they need to be encoded with a coding system (@pxref{Coding Systems}).
+Usually the coding system is specified automatically by your chosen
+language environment (@pxref{Language Environments}). You can
+explicitly specify the coding system for outgoing mail by setting the
+variable @code{sendmail-coding-system} (@pxref{Recognize Coding}). If
+the coding system thus determined does not handle the characters in a
+particular message, Emacs asks you to select the coding system to use,
+showing a list of possible coding systems.
+
@node Header Editing
@subsection Mail Header Editing
@@ -511,7 +480,8 @@ just inserts a tab character.
@table @kbd
@item C-c C-y
-Yank the selected message from Rmail (@code{message-yank-original}).
+Yank the selected message from the mail reader, as a citation
+(@code{message-yank-original}).
@item C-c C-q
Fill each paragraph cited from another message
(@code{message-fill-yanked-message}).
@@ -522,9 +492,9 @@ Fill each paragraph cited from another message
@findex message-yank-prefix
You can use the command @kbd{C-c C-y} (@code{message-yank-original})
to @dfn{cite} a message that you are replying to. This inserts the
-text of that message into the mail buffer. This command is active
-only when the mail buffer is invoked from a mail program running in
-Emacs, such as Rmail.
+text of that message into the mail buffer. This command works only if
+the mail buffer is invoked from a mail reader running in Emacs, such
+as Rmail.
By default, Emacs inserts the string @samp{>} in front of each line
of the cited text; this prefix string is specified by the variable
@@ -551,7 +521,7 @@ package, which provides more flexible citation
@subsection Mail Miscellany
@kindex C-c C-a @r{(Message mode)}
-@findex mail-attach-file
+@findex mml-attach-file
@cindex MIME
@cindex Multipurpose Internet Mail Extensions
You can @dfn{attach} a file to an outgoing message by typing
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index 37a85a89ea2..6e895d3ac3c 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Text, Programs, Indentation, Top
+@node Text
@chapter Commands for Human Languages
@cindex text
@cindex manipulating text
@@ -34,7 +34,7 @@ publish them in many formats.
@cindex mode, nXML
@findex nxml-mode
Emacs has other major modes for text which contains ``embedded''
-commands, such as @TeX{} and La@TeX{} (@pxref{TeX Mode}); HTML and
+commands, such as @TeX{} and @LaTeX{} (@pxref{TeX Mode}); HTML and
SGML (@pxref{HTML Mode}); XML
@ifinfo
(@pxref{Top,The nXML Mode Manual,,nxml-mode, nXML Mode});
@@ -74,10 +74,10 @@ for editing such pictures.
* Text Mode:: The major modes for editing text files.
* Outline Mode:: Editing outlines.
* Org Mode:: The Emacs organizer.
-* TeX Mode:: Editing input to the formatter TeX.
+* TeX Mode:: Editing TeX and LaTeX files.
* HTML Mode:: Editing HTML and SGML files.
-* Nroff Mode:: Editing input to the formatter nroff.
-* Enriched Text:: Editing text ``enriched'' with fonts, colors, etc.
+* Nroff Mode:: Editing input to the nroff formatter.
+* Enriched Text:: Editing text "enriched" with fonts, colors, etc.
* Text Based Tables:: Commands for editing text-based tables.
* Two-Column:: Splitting text columns into separate windows.
@end menu
@@ -379,8 +379,8 @@ delimited once again. The reason @kbd{C-x C-p} includes only the
following page delimiter in the region is to ensure that.
A numeric argument to @kbd{C-x C-p} specifies which page to go to,
-relative to the current one. Zero means the current page. One means
-the next page, and @minus{}1 means the previous one.
+relative to the current one. Zero means the current page, one
+the next page, and @minus{}1 the previous one.
@kindex C-x l
@findex count-lines-page
@@ -412,7 +412,7 @@ beginning of a line.
specified width. Emacs does filling in two ways. In Auto Fill mode,
inserting text with self-inserting characters also automatically fills
it. There are also explicit fill commands that you can use when editing
-text leaves it unfilled.
+text.
@menu
* Auto Fill:: Auto Fill mode breaks long lines automatically.
@@ -546,11 +546,11 @@ made by Text mode and is available only in that and related modes
newline as the end of a sentence; a period followed by just one space
indicates an abbreviation, not the end of a sentence. Accordingly,
the fill commands will not break a line after a period followed by
-just one space. If you change the variable
-@code{sentence-end-double-space} to a non-@code{nil} value, the fill
-commands will break a line after a period followed by one space, and
-put just one space after each period. @xref{Sentences}, for other
-effects and possible drawbacks of this.
+just one space. If you set the variable
+@code{sentence-end-double-space} to @code{nil}, the fill commands will
+break a line after a period followed by one space, and put just one
+space after each period. @xref{Sentences}, for other effects and
+possible drawbacks of this.
@vindex colon-double-space
If the variable @code{colon-double-space} is non-@code{nil}, the
@@ -1015,11 +1015,11 @@ Both accept numeric arguments as repeat counts.
@kindex C-c C-f @r{(Outline mode)}
@kindex C-c C-b @r{(Outline mode)}
@kindex C-c C-u @r{(Outline mode)}
- The commands @kbd{C-c C-f} (@code{outline-forward-same-level}) and
-@kbd{C-c C-b} (@code{outline-backward-same-level}) move from one
-heading line to another visible heading at the same depth in the
-outline. @kbd{C-c C-u} (@code{outline-up-heading}) moves backward to
-another heading that is less deeply nested.
+ @kbd{C-c C-f} (@code{outline-forward-same-level}) and @kbd{C-c C-b}
+(@code{outline-backward-same-level}) move from one heading line to
+another visible heading at the same depth in the outline. @kbd{C-c
+C-u} (@code{outline-up-heading}) moves backward to another heading
+that is less deeply nested.
@node Outline Visibility
@subsection Outline Visibility Commands
@@ -1240,6 +1240,7 @@ quad click: exit all folds and hide text.
@end itemize
@end table
+@c FIXME not marked as a user variable
@vindex foldout-mouse-modifiers
You can specify different modifier keys (instead of
@kbd{Control-Meta-}) by setting @code{foldout-mouse-modifiers}; but if
@@ -1248,7 +1249,7 @@ it in order for this to take effect.
To use the Foldout package, you can type @kbd{M-x load-library
@key{RET} foldout @key{RET}}; or you can arrange for to do that
-automatically by putting this in your init file (@pxref{Init File}):
+automatically by putting the following in your init file:
@example
(eval-after-load "outline" '(require 'foldout))
@@ -1256,117 +1257,139 @@ automatically by putting this in your init file (@pxref{Init File}):
@node Org Mode
@section Org Mode
-@kindex TAB @r{(Org Mode)}
-@kindex S-TAB @r{(Org Mode)}
@cindex organizer
@cindex planner
-@findex org-mode
-@cindex fold
-@cindex headline
-@kindex M-<up> @r{(Org Mode)}
-@kindex M-<down> @r{(Org Mode)}
-@kindex M-<left> @r{(Org Mode)}
-@kindex M-<right> @r{(Org Mode)}
-@kindex S-M-<up> @r{(Org Mode)}
-@kindex S-M-<down> @r{(Org Mode)}
-@kindex S-M-<left> @r{(Org Mode)}
-@kindex S-M-<right> @r{(Org Mode)}
-
-Org mode extends Outline mode to turn Emacs into an organizer and an
-authoring system.
-
-When editing a file ending with the @file{.org} extension, Emacs
-automatically uses @code{org-mode} as the major mode. In this mode,
-headlines start with one (or more) leading star(s) and comments start
-with the @code{#} character at the beginning of a line.
-
-@example
-* This is the first headline
-** This is a first sub-headline
-* This is the second headline
+@findex Org mode
+@findex mode, Org
-Some content here.
+@findex org-mode
+ Org mode is a variant of Outline mode for using Emacs as an
+organizer and/or authoring system. Files with names ending in the
+extension @file{.org} are opened in Org mode (@pxref{Choosing Modes}).
+To explicitly switch to Org mode, type @kbd{M-x org-mode}.
-# Some comment here.
-@end example
+ In Org mode, as in Outline mode, each entry has a heading line that
+starts with one or more @samp{*} characters. @xref{Outline Format}.
+In addition, any line that begins with the @samp{#} character is
+treated as a comment.
-From here, you can use Org mode as a simple outliner: @key{TAB} on a
-headline will cycle through the various folding states of a subtree,
-and @key{S-TAB} anywhere in the buffer will (un)fold the whole
-structure.
+@kindex TAB @r{(Org Mode)}
+@findex org-cycle
+ Org mode provides commands for easily viewing and manipulating the
+outline structure. The simplest of these commands is @key{TAB}
+(@code{org-cycle}). If invoked on a heading line, it cycles through
+the different visibility states of the subtree: (i) showing only that
+heading line, (ii) showing only the heading line and the heading lines
+of its direct children, if any, and (iii) showing the entire subtree.
+If invoked in a body line, the global binding for @key{TAB} is
+executed.
-You can also manipulate the structure of your document by moving a
-headline up and down with @key{M-<up>} and @key{M-<down>}, or by
-promoting and demoting a headline with @key{M-<left>} and
-@key{M-<left>}. If you want to act on the whole subtree (i.e. the
-headline and its content, including other headlines), simply add the
-@kbd{Shift} key and use @key{S-M-<up>}, @key{S-M-<down>},
-@key{S-M-<left>} and @key{S-M-<right>}.
+@kindex S-TAB @r{(Org Mode)}
+@findex org-shifttab
+ Typing @key{S-TAB} (@code{org-shifttab}) anywhere in an Org mode
+buffer cycles the visibility of the entire outline structure, between
+(i) showing only top-level heading lines, (ii) showing all heading
+lines but no body lines, and (iii) showing everything.
-For further details, see @ref{Document Structure,,,org, The Org Manual}.
+@kindex M-<up> @r{(Org Mode)}
+@kindex M-<down> @r{(Org Mode)}
+@kindex M-<left> @r{(Org Mode)}
+@kindex M-<right> @r{(Org Mode)}
+@findex org-metaup
+@findex org-metadown
+@findex org-metaleft
+@findex org-metaright
+ You can move an entire entry up or down in the buffer, including its
+body lines and subtree (if any), by typing @kbd{M-<up>}
+(@code{org-metaup}) or @kbd{M-<down>} (@code{org-metadown}) on the
+heading line. Similarly, you can promote or demote a heading line
+with @kbd{M-<left>} (@code{org-metaleft}) and @kbd{M-<right>}
+(@code{org-metaright}). These commands execute their global bindings
+if invoked on a body line.
+
+ The following subsections give basic instructions for using Org mode
+as an organizer and as an authoring system. For details, @pxref{Top,
+The Org Mode Manual, Introduction, org, The Org Manual}.
@menu
-* Org as an organizer:: Manage TODO lists and agendas
-* Org as an authoring system:: Export to various formats
+* Org Organizer:: Managing TODO lists and agendas.
+* Org Authoring:: Exporting Org buffers to various formats.
@end menu
-@node Org as an organizer
+@node Org Organizer
@subsection Org as an organizer
+@cindex TODO item
+@cindex Org agenda
-@cindex TODO keywords
@kindex C-c C-t @r{(Org Mode)}
+@findex org-todo
+@vindex org-todo-keywords
+ You can tag an Org entry as a @dfn{TODO} item by typing @kbd{C-c
+C-t} (@code{org-todo}) anywhere in the entry. This adds the keyword
+@samp{TODO} to the heading line. Typing @kbd{C-c C-t} again switches
+the keyword to @samp{DONE}; another @kbd{C-c C-t} removes the keyword
+entirely, and so forth. You can customize the keywords used by
+@kbd{C-c C-t} via the variable @code{org-todo-keywords}.
+
@kindex C-c C-s @r{(Org Mode)}
@kindex C-c C-d @r{(Org Mode)}
-@vindex org-todo-keywords
-@findex org-todo
+@findex org-schedule
+@findex org-deadline
+ Apart from marking an entry as TODO, you can attach a date to it, by
+typing @kbd{C-c C-s} (@code{org-schedule}) in the entry. This prompts
+for a date by popping up the Emacs Calendar (@pxref{Calendar/Diary}),
+and then adds the tag @samp{SCHEDULED}, together with the selected
+date, beneath the heading line. The command @kbd{C-c C-d}
+(@code{org-deadline}) has the same effect, except that it uses the tag
+@code{DEADLINE}.
+
+@kindex C-c [ @r{(Org Mode)}
+@findex org-agenda-file-to-front
+@vindex org-agenda-files
+ Once you have some TODO items planned in an Org file, you can add
+that file to the list of @dfn{agenda files} by typing @kbd{C-c [}
+(@code{org-agenda-file-to-front}). Org mode is designed to let you
+easily maintain multiple agenda files, e.g.@: for organizing different
+aspects of your life. The list of agenda files is stored in the
+variable @code{org-agenda-files}.
+
@findex org-agenda
-@cindex scheduled
-@cindex deadline
-@cindex agenda
-
-Each headline can be turned into a TODO item calling @code{org-todo}
-with @key{C-c C-t} anywhere on it. This will add the TODO keyword
-@code{TODO}. Hit @key{C-c C-t} to cycle through the list of available
-TODO keywords: you can configure the variable @code{org-todo-keywords}
-to use your own list of keywords.
-
-Now that you have something to do, let's add a date to it: pressing
-@key{C-c C-s} on a headline will add @code{SCHEDULED} below it, and
-you will be prompted for a date through the calendar. @key{C-c C-d}
-has the same effect, except that the item will have a @code{DEADLINE}
-instead.
-
-Now that some TODO items are planned in the current file, add it to
-the list of agenda files with @key{C-c [}. Calling the interactive
-command @code{org-agenda} will prompt you for what you want to see: a
-list of things to do this week, a list of TODO items with specific
-keywords, etc.
-
-For further details, see @ref{TODO items,,,org, The Org Manual} and
-@ref{Dates and times,,,org, The Org Manual}.
-
-@node Org as an authoring system
+ To view items coming from your agenda files, type @kbd{M-x
+org-agenda}. This command prompts for what you want to see: a list of
+things to do this week, a list of TODO items with specific keywords,
+etc.
+@ifnottex
+@xref{Agenda Views,,,org, The Org Manual}, for details.
+@end ifnottex
+
+@node Org Authoring
@subsection Org as an authoring system
-@cindex export
-@findex org-export
-@cindex publish
-@cindex code block
-@cindex quote
+@cindex Org exporting
-You may want to format your Org notes nicely and to prepare them for
-export and publication. Org supports simple text formatting:
+@findex org-export
+@kindex C-c C-e @r{(Org mode)}
+ You may want to format your Org notes nicely and to prepare them for
+export and publication. To export the current buffer, type @kbd{C-c
+C-e} (@code{org-export}) anywhere in an Org buffer. This command
+prompts for an export format; currently supported formats include
+HTML, @LaTeX{}, OpenDocument (@file{.odt}), and PDF. Some formats,
+such as PDF, require certain system tools to be installed.
+
+@vindex org-publish-project-alist
+ To export several files at once to a specific directory, either
+locally or over the network, you must define a list of projects
+through the variable @code{org-publish-project-alist}. See its
+documentation for details.
+
+ Org supports a simple markup scheme for applying text formatting to
+exported documents:
@example
- This text is /emphasized/
-- This item uses *a bold font*
+- This text is *in bold*
- This text is _underlined_
- This text uses =a teletype font=
-@end example
-If a paragraph is a quote or an example, you can use specific
-environments:
-
-@example
#+begin_quote
``This is a quote.''
#+end_quote
@@ -1376,29 +1399,17 @@ This is an example.
#+end_example
@end example
-These environments will be displayed in a specific way with respect
-to the selected export/publish backend.
-
-To export the current buffer, press the @key{C-c C-e} key anywhere in
-an Org buffer. Supported export formats include @code{HTML}, La@TeX{}
-and @file{.odt} (OpenDocument format.) Depending on your system
-installation, you can also directly export to @code{pdf}.
-
-To export several files at once to a specific directory either locally
-or on the Internet, you will need to define a list of projects through
-the variable @code{org-publish-project-alist}.
-
-For further details, see @ref{Exporting,,,org, The Org Manual} and
+ For further details, @ref{Exporting,,,org, The Org Manual}, and
@ref{Publishing,,,org, The Org Manual}.
@node TeX Mode
@section @TeX{} Mode
@cindex @TeX{} mode
-@cindex La@TeX{} mode
+@cindex @LaTeX{} mode
@cindex Sli@TeX{} mode
@cindex Doc@TeX{} mode
@cindex mode, @TeX{}
-@cindex mode, La@TeX{}
+@cindex mode, @LaTeX{}
@cindex mode, Sli@TeX{}
@cindex mode, Doc@TeX{}
@findex tex-mode
@@ -1411,15 +1422,15 @@ For further details, see @ref{Exporting,,,org, The Org Manual} and
Emacs provides special major modes for editing files written in
@TeX{} and its related formats. @TeX{} is a powerful text formatter
written by Donald Knuth; like GNU Emacs, it is free software.
-La@TeX{} is a simplified input format for @TeX{}, implemented using
+@LaTeX{} is a simplified input format for @TeX{}, implemented using
@TeX{} macros. Doc@TeX{} is a special file format in which the
-La@TeX{} sources are written, combining sources with documentation.
-Sli@TeX{} is an obsolete special form of La@TeX{}.@footnote{It has
+@LaTeX{} sources are written, combining sources with documentation.
+Sli@TeX{} is an obsolete special form of @LaTeX{}.@footnote{It has
been replaced by the @samp{slides} document class, which comes with
-La@TeX{}.}
+@LaTeX{}.}
@vindex tex-default-mode
- @TeX{} mode has four variants: Plain @TeX{} mode, La@TeX{} mode,
+ @TeX{} mode has four variants: Plain @TeX{} mode, @LaTeX{} mode,
Doc@TeX{} mode, and Sli@TeX{} mode. These distinct major modes differ
only slightly, and are designed for editing the four different
formats. Emacs selects the appropriate mode by looking at the
@@ -1439,13 +1450,13 @@ which are not documented in this manual:
@itemize @bullet
@item
Bib@TeX{} mode is a major mode for Bib@TeX{} files, which are commonly
-used for keeping bibliographic references for La@TeX{} documents. For
+used for keeping bibliographic references for @LaTeX{} documents. For
more information, see the documentation string for the command
@code{bibtex-mode}.
@item
The Ref@TeX{} package provides a minor mode which can be used with
-La@TeX{} mode to manage bibliographic references.
+@LaTeX{} mode to manage bibliographic references.
@ifinfo
@xref{Top,The Ref@TeX{} Manual,,reftex}.
@end ifinfo
@@ -1538,7 +1549,7 @@ text that belongs inside. Afterward, use the command @kbd{C-c @}}
point, and inserts two newlines to start a new paragraph. It outputs
a message in the echo area if any mismatch is found. @kbd{M-x
tex-validate-region} checks a region, paragraph by paragraph. The
-errors are listed in an @samp{*Occur*} buffer; you can use the usual
+errors are listed in an @file{*Occur*} buffer; you can use the usual
Occur mode commands in that buffer, such as @kbd{C-c C-c}, to visit a
particular mismatch (@pxref{Other Repeating Search}).
@@ -1550,23 +1561,23 @@ is useful for the various motion commands and automatic match display
to work with them.
@node LaTeX Editing
-@subsection La@TeX{} Editing Commands
+@subsection @LaTeX{} Editing Commands
- La@TeX{} mode provides a few extra features not applicable to plain
+ @LaTeX{} mode provides a few extra features not applicable to plain
@TeX{}:
@table @kbd
@item C-c C-o
-Insert @samp{\begin} and @samp{\end} for La@TeX{} block and position
+Insert @samp{\begin} and @samp{\end} for @LaTeX{} block and position
point on a line between them (@code{tex-latex-block}).
@item C-c C-e
-Close the innermost La@TeX{} block not yet closed
+Close the innermost @LaTeX{} block not yet closed
(@code{tex-close-latex-block}).
@end table
@findex tex-latex-block
-@kindex C-c C-o @r{(La@TeX{} mode)}
- In La@TeX{} input, @samp{\begin} and @samp{\end} tags are used to
+@kindex C-c C-o @r{(@LaTeX{} mode)}
+ In @LaTeX{} input, @samp{\begin} and @samp{\end} tags are used to
group blocks of text. To insert a block, type @kbd{C-c C-o}
(@code{tex-latex-block}). This prompts for a block type, and inserts
the appropriate matching @samp{\begin} and @samp{\end} tags, leaving a
@@ -1575,18 +1586,21 @@ blank line between the two and moving point there.
@vindex latex-block-names
When entering the block type argument to @kbd{C-c C-o}, you can use
the usual completion commands (@pxref{Completion}). The default
-completion list contains the standard La@TeX{} block types. If you
+completion list contains the standard @LaTeX{} block types. If you
want additional block types for completion, customize the list
variable @code{latex-block-names}.
@findex tex-close-latex-block
-@kindex C-c C-e @r{(La@TeX{} mode)}
- In La@TeX{} input, @samp{\begin} and @samp{\end} tags must balance.
+@kindex C-c C-e @r{(@LaTeX{} mode)}
+@findex latex-electric-env-pair-mode
+ In @LaTeX{} input, @samp{\begin} and @samp{\end} tags must balance.
You can use @kbd{C-c C-e} (@code{tex-close-latex-block}) to insert an
@samp{\end} tag which matches the last unmatched @samp{\begin}. It
also indents the @samp{\end} to match the corresponding @samp{\begin},
and inserts a newline after the @samp{\end} tag if point is at the
-beginning of a line.
+beginning of a line. The minor mode @code{latex-electric-env-pair-mode}
+automatically inserts an @samp{\end} or @samp{\begin} tag for you
+when you type the corresponding one.
@node TeX Print
@subsection @TeX{} Printing Commands
@@ -1656,7 +1670,7 @@ such as @code{"/tmp"}.
The buffer's @TeX{} variant determines what shell command @kbd{C-c
C-b} actually runs. In Plain @TeX{} mode, it is specified by the
variable @code{tex-run-command}, which defaults to @code{"tex"}. In
-La@TeX{} mode, it is specified by @code{latex-run-command}, which
+@LaTeX{} mode, it is specified by @code{latex-run-command}, which
defaults to @code{"latex"}. The shell command that @kbd{C-c C-v} runs
to view the @file{.dvi} output is determined by the variable
@code{tex-dvi-view-command}, regardless of the @TeX{} variant. The
@@ -1681,7 +1695,7 @@ name with @samp{*} in the command string. For example,
@findex tex-recenter-output-buffer
@kindex C-c C-l @r{(@TeX{} mode)}
The terminal output from @TeX{}, including any error messages,
-appears in a buffer called @samp{*tex-shell*}. If @TeX{} gets an
+appears in a buffer called @file{*tex-shell*}. If @TeX{} gets an
error, you can switch to this buffer and feed it input (this works as
in Shell mode; @pxref{Interactive Shell}). Without switching to this
buffer you can scroll it so that its last line is visible by typing
@@ -1711,9 +1725,9 @@ after. The lines containing the two strings are included in the header.
If @samp{%**start of header} does not appear within the first 100 lines of
the buffer, @kbd{C-c C-r} assumes that there is no header.
- In La@TeX{} mode, the header begins with @samp{\documentclass} or
+ In @LaTeX{} mode, the header begins with @samp{\documentclass} or
@samp{\documentstyle} and ends with @samp{\begin@{document@}}. These
-are commands that La@TeX{} requires you to use in any case, so nothing
+are commands that @LaTeX{} requires you to use in any case, so nothing
special needs to be done to identify the header.
@findex tex-file
@@ -1755,7 +1769,7 @@ Variables}.
@findex tex-bibtex-file
@kindex C-c TAB @r{(@TeX{} mode)}
@vindex tex-bibtex-command
- For La@TeX{} files, you can use Bib@TeX{} to process the auxiliary
+ For @LaTeX{} files, you can use Bib@TeX{} to process the auxiliary
file for the current buffer's file. Bib@TeX{} looks up bibliographic
citations in a data base and prepares the cited references for the
bibliography section. The command @kbd{C-c @key{TAB}}
@@ -1873,8 +1887,8 @@ the tag at point.
@kindex C-c / @r{(SGML mode)}
@findex sgml-close-tag
Insert a close tag for the innermost unterminated tag
-(@code{sgml-close-tag}). If called from within a tag or a comment,
-close this element instead of inserting a close tag.
+(@code{sgml-close-tag}). If called within a tag or a comment,
+close it instead of inserting a close tag.
@item C-c 8
@kindex C-c 8 @r{(SGML mode)}
@@ -1935,10 +1949,10 @@ always insert explicit closing tags as well.
@cindex nroff
@findex nroff-mode
@vindex nroff-mode-hook
- Nroff mode is a major mode derived from Text mode, which is
+ Nroff mode, a major mode derived from Text mode, is
specialized for editing nroff files (e.g.@: Unix man pages). Type
@kbd{M-x nroff-mode} to enter this mode. Entering Nroff mode runs the
-hook @code{text-mode-hook}, followed by @code{nroff-mode-hook}
+hook @code{text-mode-hook}, then @code{nroff-mode-hook}
(@pxref{Hooks}).
In Nroff mode, nroff command lines are treated as paragraph
@@ -2196,7 +2210,7 @@ for the right or left margin of a paragraph or a part of a paragraph.
These margins also affect fill commands such as @kbd{M-q}
(@pxref{Filling}).
- The Indentation submenu of Text Properties provides four commands
+ The Indentation submenu of Text Properties offers commands
for specifying indentation:
@table @code
@@ -2279,10 +2293,9 @@ commands do nothing on text with this setting. You can, however,
still indent the left margin.
@end table
+@vindex default-justification
You can also specify justification styles using the Justification
submenu in the Text Properties menu.
-
-@vindex default-justification
The default justification style is specified by the per-buffer
variable @code{default-justification}. Its value should be one of the
symbols @code{left}, @code{right}, @code{full}, @code{center}, or
@@ -2298,8 +2311,7 @@ hides text), and @code{intangible} (which disallows moving point
within the text). The @samp{Remove Special} menu item removes all of
these special properties from the text in the region.
- The @code{invisible} and @code{intangible} properties are not saved
-in the @samp{text/enriched} format.
+ The @code{invisible} and @code{intangible} properties are not saved.
@node Text Based Tables
@section Editing Text-based Tables
@@ -2332,8 +2344,8 @@ large to fit in the cell. You can use the commands defined in the
following sections for navigating and editing the table layout.
@findex table-fixed-width-mode
- To toggle the automatic table resizing feature, type @kbd{M-x
-table-fixed-width-mode}.
+ Type @kbd{M-x table-fixed-width-mode} to toggle the automatic table
+resizing feature.
@menu
* Table Definition:: What is a text based table.
@@ -2493,15 +2505,16 @@ result in an illegitimate cell layout.
@cindex text-based tables, splitting cells
@cindex splitting table cells
@kbd{M-x table-split-cell} splits the current cell vertically or
-horizontally, prompting for the direction with the minibuffer. The
-commands @kbd{M-x table-split-cell-vertically} and @kbd{M-x
-table-split-cell-horizontally} split in a specific direction. When
-splitting vertically, the old cell contents are automatically split
-between the two new cells. When splitting horizontally, you are
-prompted for how to divide the cell contents, if the cell is
-non-empty; the options are @samp{split} (divide the contents at
-point), @samp{left} (put all the contents in the left cell), and
-@samp{right} (put all the contents in the right cell).
+horizontally, prompting for the direction with the minibuffer. To
+split in a specific direction, use @kbd{M-x
+table-split-cell-vertically} and @kbd{M-x
+table-split-cell-horizontally}. When splitting vertically, the old
+cell contents are automatically split between the two new cells. When
+splitting horizontally, you are prompted for how to divide the cell
+contents, if the cell is non-empty; the options are @samp{split}
+(divide the contents at point), @samp{left} (put all the contents in
+the left cell), and @samp{right} (put all the contents in the right
+cell).
The following commands enlarge or shrink a cell. By default, they
resize by one row or column; if a numeric argument is supplied, that
@@ -2565,10 +2578,12 @@ to @code{nil}.
@findex table-insert-row
@kbd{M-x table-insert-row} inserts a row of cells before the current
table row. The current row, together with point, is pushed down past
-the new row. To insert rows after the last row at the bottom of a
+the new row. To insert a row after the last row at the bottom of a
table, invoke this command with point below the table, just below the
-bottom edge. A numeric prefix argument specifies the number of rows
-to insert.
+bottom edge. You can insert more than one row at a time by using a
+numeric prefix argument.
+
+@c A numeric prefix argument specifies the number of rows to insert.
@findex table-insert-column
Similarly, @kbd{M-x table-insert-column} inserts a column of cells
diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi
index ae7550d0fae..705cd5a4bbe 100644
--- a/doc/emacs/trouble.texi
+++ b/doc/emacs/trouble.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@iftex
@@ -40,8 +40,8 @@ Cancel a previously made change in the buffer contents (@code{undo}).
@dfn{quitting} with @kbd{C-g}, and @dfn{aborting} with @kbd{C-]} or
@kbd{M-x top-level}. Quitting cancels a partially typed command, or
one which is still running. Aborting exits a recursive editing level
-and cancels the command that invoked the recursive edit.
-(@xref{Recursive Edit}.)
+and cancels the command that invoked the recursive edit
+(@pxref{Recursive Edit}).
@cindex quitting
@kindex C-g
@@ -54,7 +54,7 @@ a kill command that is taking a long time, either your text will
kill ring, or maybe both. If the region is active, @kbd{C-g}
deactivates the mark, unless Transient Mark mode is off
(@pxref{Disabled Transient Mark}). If you are in the middle of an
-incremental search, @kbd{C-g} does special things; it may take two
+incremental search, @kbd{C-g} behaves specially; it may take two
successive @kbd{C-g} characters to get out of a search.
@xref{Incremental Search}, for details.
@@ -133,15 +133,15 @@ a command, but you can think of it as canceling a command that already
finished executing. @xref{Undo}, for more information about the undo
facility.
-@node Lossage, Bugs, Quitting, Top
+@node Lossage
@section Dealing with Emacs Trouble
- This section describes various conditions in which Emacs fails to work
-normally, and how to recognize them and correct them. For a list of
-additional problems you might encounter, see @ref{Bugs and problems, ,
-Bugs and problems, efaq, GNU Emacs FAQ}, and the file @file{etc/PROBLEMS}
-in the Emacs distribution. Type @kbd{C-h C-f} to read the FAQ; type
-@kbd{C-h C-p} to read the @file{PROBLEMS} file.
+ This section describes how to recognize and deal with situations in
+which Emacs does not work as you expect, such as keyboard code mixups,
+garbled displays, running out of memory, and crashes and hangs.
+
+ @xref{Bugs}, for what to do when you think you have found a bug in
+Emacs.
@menu
* DEL Does Not Delete:: What to do if @key{DEL} doesn't delete.
@@ -149,56 +149,48 @@ in the Emacs distribution. Type @kbd{C-h C-f} to read the FAQ; type
* Screen Garbled:: Garbage on the screen.
* Text Garbled:: Garbage in the text.
* Memory Full:: How to cope when you run out of memory.
+* Crashing:: What Emacs does when it crashes.
* After a Crash:: Recovering editing in an Emacs session that crashed.
-* Emergency Escape:: Emergency escape---
- What to do if Emacs stops responding.
-* Total Frustration:: When you are at your wits' end.
+* Emergency Escape:: What to do if Emacs stops responding.
@end menu
@node DEL Does Not Delete
@subsection If @key{DEL} Fails to Delete
@cindex @key{DEL} vs @key{BACKSPACE}
@cindex @key{BACKSPACE} vs @key{DEL}
-@cindex usual erasure key
Every keyboard has a large key, usually labeled @key{Backspace},
which is ordinarily used to erase the last character that you typed.
-We call this key @dfn{the usual erasure key}. In Emacs, it is
-supposed to be equivalent to @key{DEL}.
+In Emacs, this key is supposed to be equivalent to @key{DEL}.
When Emacs starts up on a graphical display, it determines
automatically which key should be @key{DEL}. In some unusual cases,
-Emacs gets the wrong information from the system. If the usual
-erasure key deletes forwards instead of backwards, that is probably
-what happened---Emacs ought to be treating the @key{Backspace} key as
-@key{DEL}, but it isn't.
+Emacs gets the wrong information from the system, and @key{Backspace}
+ends up deleting forwards instead of backwards.
Some keyboards also have a @key{Delete} key, which is ordinarily
used to delete forwards. If this key deletes backward in Emacs, that
too suggests Emacs got the wrong information---but in the opposite
sense.
- On a text-only terminal, if you find the usual erasure key prompts
-for a Help command, like @kbd{Control-h}, instead of deleting a
-character, it means that key is actually sending the @key{BS}
-character. Emacs ought to be treating @key{BS} as @key{DEL}, but it
-isn't.
+ On a text terminal, if you find that @key{Backspace} prompts for a
+Help command, like @kbd{Control-h}, instead of deleting a character,
+it means that key is actually sending the @key{BS} character. Emacs
+ought to be treating @key{BS} as @key{DEL}, but it isn't.
+@findex normal-erase-is-backspace-mode
In all of those cases, the immediate remedy is the same: use the
command @kbd{M-x normal-erase-is-backspace-mode}. This toggles
between the two modes that Emacs supports for handling @key{DEL}, so
if Emacs starts in the wrong mode, this should switch to the right
-mode. On a text-only terminal, if you want to ask for help when
-@key{BS} is treated as @key{DEL}, use @key{F1}; @kbd{C-?} may also
-work, if it sends character code 127.
+mode. On a text terminal, if you want to ask for help when @key{BS}
+is treated as @key{DEL}, use @key{F1}; @kbd{C-?} may also work, if it
+sends character code 127.
-@findex normal-erase-is-backspace-mode
- To fix the problem automatically for every Emacs session, you can
-put one of the following lines into your @file{.emacs} file
-(@pxref{Init File}). For the first case above, where @key{Backspace}
-deletes forwards instead of backwards, use this line to make
-@key{Backspace} act as @key{DEL} (resulting in behavior compatible
-with Emacs 20 and previous versions):
+ To fix the problem in every Emacs session, put one of the following
+lines into your initialization file (@pxref{Init File}). For the
+first case above, where @key{Backspace} deletes forwards instead of
+backwards, use this line to make @key{Backspace} act as @key{DEL}:
@lisp
(normal-erase-is-backspace-mode 0)
@@ -224,12 +216,12 @@ Customization}.
Recursive editing levels are important and useful features of Emacs, but
they can seem like malfunctions if you do not understand them.
- If the mode line has square brackets @samp{[@dots{}]} around the parentheses
-that contain the names of the major and minor modes, you have entered a
-recursive editing level. If you did not do this on purpose, or if you
-don't understand what that means, you should just get out of the recursive
-editing level. To do so, type @kbd{M-x top-level}. This is called getting
-back to top level. @xref{Recursive Edit}.
+ If the mode line has square brackets @samp{[@dots{}]} around the
+parentheses that contain the names of the major and minor modes, you
+have entered a recursive editing level. If you did not do this on
+purpose, or if you don't understand what that means, you should just
+get out of the recursive editing level. To do so, type @kbd{M-x
+top-level}. @xref{Recursive Edit}.
@node Screen Garbled
@subsection Garbage on the Screen
@@ -244,12 +236,9 @@ the following section.)
entry for the terminal you are using. The file @file{etc/TERMS} in
the Emacs distribution gives the fixes for known problems of this
sort. @file{INSTALL} contains general advice for these problems in
-one of its sections. To investigate the possibility that you have
-this sort of problem, try Emacs on another terminal made by a
-different manufacturer. If problems happen frequently on one kind of
-terminal but not another kind, it is likely to be a bad terminfo entry,
-though it could also be due to a bug in Emacs that appears for
-terminals that have or that lack specific features.
+one of its sections. If you seem to be using the right terminfo
+entry, it is possible that there is a bug in the terminfo entry, or a
+bug in Emacs that appears for certain terminal types.
@node Text Garbled
@subsection Garbage in the Text
@@ -286,9 +275,75 @@ will disappear from the mode line. That means you can safely go on
editing in the same Emacs session.
Do not use @kbd{M-x buffer-menu} to save or kill buffers when you run
-out of memory, because the buffer menu needs a fair amount of memory
+out of memory, because the Buffer Menu needs a fair amount of memory
itself, and the reserve supply may not be enough.
+@node Crashing
+@subsection When Emacs Crashes
+
+@cindex crash report
+@cindex backtrace
+@cindex @file{emacs_backtrace.txt} file, MS-Windows
+ Emacs is not supposed to crash, but if it does, it produces a
+@dfn{crash report} prior to exiting. The crash report is printed to
+the standard error stream. If Emacs was started from a graphical
+desktop on a GNU or Unix system, the standard error stream is commonly
+redirected to a file such as @file{~/.xsession-errors}, so you can
+look for the crash report there. On MS-Windows, the crash report is
+written to a file named @file{emacs_backtrace.txt} in the current
+directory of the Emacs process, in addition to the standard error
+stream.
+
+ The format of the crash report depends on the platform. On some
+platforms, such as those using the GNU C Library, the crash report
+includes a @dfn{backtrace} describing the execution state prior to
+crashing, which can be used to help debug the crash. Here is an
+example for a GNU system:
+
+@example
+Fatal error 11: Segmentation fault
+Backtrace:
+emacs[0x5094e4]
+emacs[0x4ed3e6]
+emacs[0x4ed504]
+/lib64/libpthread.so.0[0x375220efe0]
+/lib64/libpthread.so.0(read+0xe)[0x375220e08e]
+emacs[0x509af6]
+emacs[0x5acc26]
+@dots{}
+@end example
+
+@noindent
+The number @samp{11} is the system signal number corresponding to the
+crash---in this case a segmentation fault. The hexadecimal numbers
+are program addresses, which can be associated with source code lines
+using a debugging tool. For example, the GDB command
+@samp{list *0x509af6} prints the source-code lines corresponding to
+the @samp{emacs[0x509af6]} entry. If your system has the
+@command{addr2line} utility, the following shell command outputs a
+backtrace with source-code line numbers:
+
+@example
+sed -n 's/.*\[\(.*\)]$/\1/p' @var{backtrace} |
+ addr2line -Cfip -e @var{bindir}/@var{emacs-binary}
+@end example
+
+@noindent
+Here, @var{backtrace} is the name of a text file containing a copy of
+the backtrace, @var{bindir} is the name of the directory that
+contains the Emacs executable, and @var{emacs-binary} is the name of
+the Emacs executable file, normally @file{emacs} on GNU and Unix
+systems and @file{emacs.exe} on MS-Windows and MS-DOS.
+
+@cindex core dump
+ Optionally, Emacs can generate a @dfn{core dump} when it crashes, on
+systems that support core files. A core dump is a file containing
+voluminous data about the state of the program prior to the crash,
+usually examined by loading it into a debugger such as GDB. On many
+platforms, core dumps are disabled by default, and you must explicitly
+enable them by running the shell command @samp{ulimit -c unlimited}
+(e.g.@: in your shell startup script).
+
@node After a Crash
@subsection Recovery After a Crash
@@ -338,8 +393,8 @@ not make a backup of its old contents.
@node Emergency Escape
@subsection Emergency Escape
- On text-only terminals, the @dfn{emergency escape} feature suspends
-Emacs immediately if you type @kbd{C-g} a second time before Emacs can
+ On text terminals, the @dfn{emergency escape} feature suspends Emacs
+immediately if you type @kbd{C-g} a second time before Emacs can
actually respond to the first one by quitting. This is so you can
always get out of GNU Emacs no matter how badly it might be hung.
When things are working properly, Emacs recognizes and handles the
@@ -385,26 +440,7 @@ program.
emergency escape---but there are cases where it won't work, when
system call hangs or when Emacs is stuck in a tight loop in C code.
-@node Total Frustration
-@subsection Help for Total Frustration
-@cindex Eliza
-@cindex doctor
-
- If using Emacs (or something else) becomes terribly frustrating and none
-of the techniques described above solve the problem, Emacs can still help
-you.
-
- First, if the Emacs you are using is not responding to commands, type
-@kbd{C-g C-g} to get out of it and then start a new one.
-
-@findex doctor
- Second, type @kbd{M-x doctor @key{RET}}.
-
- The Emacs psychotherapist will help you feel better. Each time you
-say something to the psychotherapist, you must end it by typing
-@key{RET} @key{RET}. This indicates you are finished typing.
-
-@node Bugs, Contributing, Lossage, Top
+@node Bugs
@section Reporting Bugs
@cindex bugs
@@ -432,41 +468,52 @@ of the main places you can read about known issues:
@itemize
@item
-The @file{etc/PROBLEMS} file in the Emacs distribution; type @kbd{C-h
-C-p} to read it. This file contains a list of particularly well-known
-issues that have been encountered in compiling, installing and running
-Emacs. Often, there are suggestions for workarounds and solutions.
+The @file{etc/PROBLEMS} file; type @kbd{C-h C-p} to read it. This
+file contains a list of particularly well-known issues that have been
+encountered in compiling, installing and running Emacs. Often, there
+are suggestions for workarounds and solutions.
@item
Some additional user-level problems can be found in @ref{Bugs and
problems, , Bugs and problems, efaq, GNU Emacs FAQ}.
+@cindex bug tracker
+@item
+The GNU Bug Tracker at @url{http://debbugs.gnu.org}. Emacs bugs are
+filed in the tracker under the @samp{emacs} package. The tracker
+records information about the status of each bug, the initial bug
+report, and the follow-up messages by the bug reporter and Emacs
+developers. You can search for bugs by subject, severity, and other
+criteria.
+
+@cindex debbugs package
+Instead of browsing the bug tracker as a webpage, you can browse it
+from Emacs using the @code{debbugs} package, which can be downloaded
+via the Package Menu (@pxref{Packages}). This package provides the
+command @kbd{M-x debbugs-gnu} to list bugs, and @kbd{M-x
+debbugs-gnu-search} to search for a specific bug. User tags, applied
+by the Emacs maintainers, are shown by @kbd{M-x debbugs-gnu-usertags}.
+
@item
The @samp{bug-gnu-emacs} mailing list (also available as the newsgroup
@samp{gnu.emacs.bug}). You can read the list archives at
-@url{http://lists.gnu.org/mailman/listinfo/bug-gnu-emacs}. If you
-like, you can also subscribe to the list. Be aware that the sole
-purpose of this list is to provide the Emacs maintainers with
-information about bugs and feature requests. Reports may contain
-fairly large amounts of data; spectators should not complain about
-this.
+@url{http://lists.gnu.org/mailman/listinfo/bug-gnu-emacs}. This list
+works as a ``mirror'' of the Emacs bug reports and follow-up messages
+which are sent to the bug tracker. It also contains old bug reports
+from before the bug tracker was introduced (in early 2008).
-@item
-The bug tracker at @url{http://debbugs.gnu.org}. From early 2008,
-reports from the @samp{bug-gnu-emacs} list have also been sent here.
-The tracker contains the same information as the mailing list, just in
-a different format. You may prefer to browse and read reports using
-the tracker.
+If you like, you can subscribe to the list. Be aware that its purpose
+is to provide the Emacs maintainers with information about bugs and
+feature requests, so reports may contain fairly large amounts of data;
+spectators should not complain about this.
@item
The @samp{emacs-pretest-bug} mailing list. This list is no longer
used, and is mainly of historical interest. At one time, it was used
for bug reports in development (i.e., not yet released) versions of
Emacs. You can read the archives for 2003 to mid 2007 at
-@url{http://lists.gnu.org/archive/html/emacs-pretest-bug/}. From
-late 2007 to mid 2008, the address was an alias for the
-@samp{emacs-devel} mailing list. From mid 2008 onwards, it has been
-an alias for @samp{bug-gnu-emacs}.
+@url{http://lists.gnu.org/archive/html/emacs-pretest-bug/}. Nowadays,
+it is an alias for @samp{bug-gnu-emacs}.
@item
The @samp{emacs-devel} mailing list. Sometimes people report bugs to
@@ -485,33 +532,32 @@ fault''), or exits with an operating system error message that
indicates a problem in the program (as opposed to something like
``disk full''), then it is certainly a bug.
- If Emacs updates the display in a way that does not correspond to what is
-in the buffer, then it is certainly a bug. If a command seems to do the
-wrong thing but the problem corrects itself if you type @kbd{C-l}, it is a
-case of incorrect display updating.
+ If the Emacs display does not correspond properly to the contents of
+the buffer, then it is a bug. But you should check that features like
+buffer narrowing (@pxref{Narrowing}), which can hide parts of the
+buffer or change how it is displayed, are not responsible.
Taking forever to complete a command can be a bug, but you must make
-certain that it was really Emacs's fault. Some commands simply take a
-long time. Type @kbd{C-g} (@kbd{C-@key{BREAK}} on MS-DOS) and then @kbd{C-h l}
-to see whether the input Emacs received was what you intended to type;
-if the input was such that you @emph{know} it should have been processed
-quickly, report a bug. If you don't know whether the command should
-take a long time, find out by looking in the manual or by asking for
-assistance.
+sure that it is really Emacs's fault. Some commands simply take a
+long time. Type @kbd{C-g} (@kbd{C-@key{BREAK}} on MS-DOS) and then
+@kbd{C-h l} to see whether the input Emacs received was what you
+intended to type; if the input was such that you @emph{know} it should
+have been processed quickly, report a bug. If you don't know whether
+the command should take a long time, find out by looking in the manual
+or by asking for assistance.
If a command you are familiar with causes an Emacs error message in a
case where its usual definition ought to be reasonable, it is probably a
bug.
- If a command does the wrong thing, that is a bug. But be sure you know
-for certain what it ought to have done. If you aren't familiar with the
-command, or don't know for certain how the command is supposed to work,
-then it might actually be working right. Rather than jumping to
-conclusions, show the problem to someone who knows for certain.
+ If a command does the wrong thing, that is a bug. But be sure you
+know for certain what it ought to have done. If you aren't familiar
+with the command, it might actually be working right. If in doubt,
+read the command's documentation (@pxref{Name Help}).
- Finally, a command's intended definition may not be the best
-possible definition for editing with. This is a very important sort
-of problem, but it is also a matter of judgment. Also, it is easy to
+ A command's intended definition may not be the best possible
+definition for editing with. This is a very important sort of
+problem, but it is also a matter of judgment. Also, it is easy to
come to such a conclusion out of ignorance of some of the existing
features. It is probably best not to complain about such a problem
until you have checked the documentation in the usual ways, feel
@@ -527,59 +573,61 @@ you should report. The manual's job is to make everything clear to
people who are not Emacs experts---including you. It is just as
important to report documentation bugs as program bugs.
- If the on-line documentation string of a function or variable disagrees
+ If the built-in documentation for a function or variable disagrees
with the manual, one of them must be wrong; that is a bug.
@node Understanding Bug Reporting
@subsection Understanding Bug Reporting
@findex emacs-version
- When you decide that there is a bug, it is important to report it and to
-report it in a way which is useful. What is most useful is an exact
-description of what commands you type, starting with the shell command to
-run Emacs, until the problem happens.
+ When you decide that there is a bug, it is important to report it
+and to report it in a way which is useful. What is most useful is an
+exact description of what commands you type, starting with the shell
+command to run Emacs, until the problem happens.
The most important principle in reporting a bug is to report
-@emph{facts}. Hypotheses and verbal descriptions are no substitute for
-the detailed raw data. Reporting the facts is straightforward, but many
-people strain to posit explanations and report them instead of the
-facts. If the explanations are based on guesses about how Emacs is
-implemented, they will be useless; meanwhile, lacking the facts, we will
-have no real information about the bug.
+@emph{facts}. Hypotheses and verbal descriptions are no substitute
+for the detailed raw data. Reporting the facts is straightforward,
+but many people strain to posit explanations and report them instead
+of the facts. If the explanations are based on guesses about how
+Emacs is implemented, they will be useless; meanwhile, lacking the
+facts, we will have no real information about the bug. If you want to
+actually @emph{debug} the problem, and report explanations that are
+more than guesses, that is useful---but please include the raw facts
+as well.
For example, suppose that you type @kbd{C-x C-f /glorp/baz.ugh
@key{RET}}, visiting a file which (you know) happens to be rather
-large, and Emacs displays @samp{I feel pretty today}. The best way to
-report the bug is with a sentence like the preceding one, because it
-gives all the facts.
-
- A bad way would be to assume that the problem is due to the size of
-the file and say, ``I visited a large file, and Emacs displayed @samp{I
-feel pretty today}.'' This is what we mean by ``guessing
-explanations.'' The problem is just as likely to be due to the fact
-that there is a @samp{z} in the file name. If this is so, then when we
-got your report, we would try out the problem with some ``large file,''
-probably with no @samp{z} in its name, and not see any problem. There
-is no way in the world that we could guess that we should try visiting a
+large, and Emacs displays @samp{I feel pretty today}. The bug report
+would need to provide all that information. You should not assume
+that the problem is due to the size of the file and say, ``I visited a
+large file, and Emacs displayed @samp{I feel pretty today}.'' This is
+what we mean by ``guessing explanations''. The problem might be due
+to the fact that there is a @samp{z} in the file name. If this is so,
+then when we got your report, we would try out the problem with some
+``large file'', probably with no @samp{z} in its name, and not see any
+problem. There is no way we could guess that we should try visiting a
file with a @samp{z} in its name.
- Alternatively, the problem might be due to the fact that the file starts
-with exactly 25 spaces. For this reason, you should make sure that you
-inform us of the exact contents of any file that is needed to reproduce the
-bug. What if the problem only occurs when you have typed the @kbd{C-x C-a}
-command previously? This is why we ask you to give the exact sequence of
-characters you typed since starting the Emacs session.
-
- You should not even say ``visit a file'' instead of @kbd{C-x C-f} unless
-you @emph{know} that it makes no difference which visiting command is used.
-Similarly, rather than saying ``if I have three characters on the line,''
-say ``after I type @kbd{@key{RET} A B C @key{RET} C-p},'' if that is
-the way you entered the text.
-
- So please don't guess any explanations when you report a bug. If you
-want to actually @emph{debug} the problem, and report explanations that
-are more than guesses, that is useful---but please include the facts as
-well.
+ You should not even say ``visit a file'' instead of @kbd{C-x C-f}.
+Similarly, rather than saying ``if I have three characters on the
+line'', say ``after I type @kbd{@key{RET} A B C @key{RET} C-p}'', if
+that is the way you entered the text.
+
+ If possible, try quickly to reproduce the bug by invoking Emacs with
+@command{emacs -Q} (so that Emacs starts with no initial
+customizations; @pxref{Initial Options}), and repeating the steps that
+you took to trigger the bug. If you can reproduce the bug this way,
+that rules out bugs in your personal customizations. Then your bug
+report should begin by stating that you started Emacs with
+@command{emacs -Q}, followed by the exact sequence of steps for
+reproducing the bug. If possible, inform us of the exact contents of
+any file that is needed to reproduce the bug.
+
+ Some bugs are not reproducible from @command{emacs -Q}; some are not
+easily reproducible at all. In that case, you should report what you
+have---but, as before, please stick to the raw facts about what you
+did to trigger the bug the first time.
@node Checklist
@subsection Checklist for Bug Reports
@@ -611,20 +659,20 @@ When you have finished writing your report, type @kbd{C-c C-c} and it
will be sent to the Emacs maintainers at @email{bug-gnu-emacs@@gnu.org}.
(If you want to suggest an improvement or new feature, use the same
address.) If you cannot send mail from inside Emacs, you can copy the
-text of your report to your normal mail client and send it to that
-address. Or you can simply send an email to that address describing
-the problem.
+text of your report to your normal mail client (if your system
+supports it, you can type @kbd{C-c m} to have Emacs do this for you)
+and send it to that address. Or you can simply send an email to that
+address describing the problem.
Your report will be sent to the @samp{bug-gnu-emacs} mailing list, and
-stored in the tracker at @url{http://debbugs.gnu.org}. Please try to
+stored in the GNU Bug Tracker at @url{http://debbugs.gnu.org}. Please
include a valid reply email address, in case we need to ask you for
more information about your report. Submissions are moderated, so
there may be a delay before your report appears.
-You do not need to know how the @url{http://debbugs.gnu.org} bug
-tracker works in order to report a bug, but if you want to, you can
-read the tracker's online documentation to see the various features
-you can use.
+You do not need to know how the Gnu Bug Tracker works in order to
+report a bug, but if you want to, you can read the tracker's online
+documentation to see the various features you can use.
All mail sent to the @samp{bug-gnu-emacs} mailing list is also
gatewayed to the @samp{gnu.emacs.bug} newsgroup. The reverse is also
@@ -655,7 +703,7 @@ Emacs, so you will have to report the bug somewhere else.
The type of machine you are using, and the operating system name and
version number (again, automatically included by @kbd{M-x
report-emacs-bug}). @kbd{M-x emacs-version @key{RET}} provides this
-information too. Copy its output from the @samp{*Messages*} buffer,
+information too. Copy its output from the @file{*Messages*} buffer,
so that you get it all and get it accurately.
@item
@@ -689,10 +737,10 @@ newline after the last line in the buffer (nothing ought to care whether
the last line is terminated, but try telling the bugs that).
@item
-The precise commands we need to type to reproduce the bug.
-If at all possible, give a full recipe for an Emacs started with the
-@samp{-Q} option (@pxref{Initial Options}). This bypasses your
-@file{.emacs} customizations.
+The precise commands we need to type to reproduce the bug. If at all
+possible, give a full recipe for an Emacs started with the @samp{-Q}
+option (@pxref{Initial Options}). This bypasses your personal
+customizations.
@findex open-dribble-file
@cindex dribble file
@@ -718,12 +766,12 @@ The way to collect the terminal output is to execute the Lisp expression
@end example
@noindent
-using @kbd{M-:} or from the @samp{*scratch*} buffer just after
+using @kbd{M-:} or from the @file{*scratch*} buffer just after
starting Emacs. From then on, Emacs copies all terminal output to the
specified termscript file as well, until the Emacs process is killed.
If the problem happens when Emacs starts up, put this expression into
-your @file{.emacs} file so that the termscript file will be open when
-Emacs displays the screen for the first time.
+your Emacs initialization file so that the termscript file will be
+open when Emacs displays the screen for the first time.
Be warned: it is often difficult, and sometimes impossible, to fix a
terminal-dependent bug without access to a terminal of the type that
@@ -744,14 +792,14 @@ Alternatively, use the @command{locale} command, if your system has it,
to display your locale settings.
You can use the @kbd{M-!} command to execute these commands from
-Emacs, and then copy the output from the @samp{*Messages*} buffer into
+Emacs, and then copy the output from the @file{*Messages*} buffer into
the bug report. Alternatively, @kbd{M-x getenv @key{RET} LC_ALL
@key{RET}} will display the value of @code{LC_ALL} in the echo area, and
-you can copy its output from the @samp{*Messages*} buffer.
+you can copy its output from the @file{*Messages*} buffer.
@item
A description of what behavior you observe that you believe is
-incorrect. For example, ``The Emacs process gets a fatal signal,'' or,
+incorrect. For example, ``The Emacs process gets a fatal signal'', or,
``The resulting text is as follows, which I think is wrong.''
Of course, if the bug is that Emacs gets a fatal signal, then one can't
@@ -780,7 +828,7 @@ important to report the precise text of the error message, and a
backtrace showing how the Lisp program in Emacs arrived at the error.
To get the error message text accurately, copy it from the
-@samp{*Messages*} buffer into the bug report. Copy all of it, not just
+@file{*Messages*} buffer into the bug report. Copy all of it, not just
part.
@findex toggle-debug-on-error
@@ -804,15 +852,21 @@ non-@code{nil} will start the Lisp debugger and show a backtrace.
This backtrace is useful for debugging such long loops, so if you can
produce it, copy it into the bug report.
+@vindex debug-on-event
+If you cannot get Emacs to respond to @kbd{C-g} (e.g., because
+@code{inhibit-quit} is set), then you can try sending the signal
+specified by @code{debug-on-event} (default SIGUSR2) from outside
+Emacs to cause it to enter the debugger.
+
@item
Check whether any programs you have loaded into the Lisp world,
-including your @file{.emacs} file, set any variables that may affect the
-functioning of Emacs. Also, see whether the problem happens in a
-freshly started Emacs without loading your @file{.emacs} file (start
-Emacs with the @code{-Q} switch to prevent loading the init files). If
-the problem does @emph{not} occur then, you must report the precise
-contents of any programs that you must load into the Lisp world in order
-to cause the problem to occur.
+including your initialization file, set any variables that may affect
+the functioning of Emacs. Also, see whether the problem happens in a
+freshly started Emacs without loading your initialization file (start
+Emacs with the @code{-Q} switch to prevent loading the init files).
+If the problem does @emph{not} occur then, you must report the precise
+contents of any programs that you must load into the Lisp world in
+order to cause the problem to occur.
@item
If the problem does depend on an init file or other Lisp programs that
@@ -886,7 +940,7 @@ More detailed advice and other useful techniques for debugging Emacs
are available in the file @file{etc/DEBUG} in the Emacs distribution.
That file also includes instructions for investigating problems
whereby Emacs stops responding (many people assume that Emacs is
-``hung,'' whereas in fact it might be in an infinite loop).
+``hung'', whereas in fact it might be in an infinite loop).
To find the file @file{etc/DEBUG} in your Emacs installation, use the
directory name stored in the variable @code{data-directory}.
@@ -983,8 +1037,8 @@ your best to help.
Send an explanation with your changes of what problem they fix or what
improvement they bring about. For a fix for an existing bug, it is
best to reply to the relevant discussion on the @samp{bug-gnu-emacs}
-list, or item in the @url{http://debbugs.gnu.org} tracker. Explain
-why your change fixes the bug.
+list, or the bug entry in the GNU Bug Tracker at
+@url{http://debbugs.gnu.org}. Explain why your change fixes the bug.
@item
Always include a proper bug report for the problem you think you have
@@ -1078,7 +1132,7 @@ Please help us keep up with the workload by designing the patch in a
form that is clearly safe to install.
@end itemize
-@node Contributing, Service, Bugs, Top
+@node Contributing
@section Contributing to Emacs Development
@cindex contributing to Emacs
@@ -1103,7 +1157,7 @@ See the Emacs project page
For more information on how to contribute, see the @file{etc/CONTRIBUTE}
file in the Emacs distribution.
-@node Service, Copying, Contributing, Top
+@node Service
@section How To Get Help with GNU Emacs
If you need help installing, using or changing GNU Emacs, there are two
diff --git a/doc/emacs/vc-xtra.texi b/doc/emacs/vc-xtra.texi
index 978a2a31a2e..f04f939cced 100644
--- a/doc/emacs/vc-xtra.texi
+++ b/doc/emacs/vc-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2004-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included in emacs-xtra.texi when producing the printed
@@ -8,7 +8,7 @@
@node Advanced VC Usage
@section Advanced VC Usage
- Commonly used features of Emacs' version control (VC) support are
+ Commonly used features of Emacs's version control (VC) support are
described in the main Emacs manual (@pxref{Version Control,,,emacs,
the Emacs Manual}). This chapter describes more advanced VC usage.
diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi
index b65e6f96a6e..cd5ed206dd6 100644
--- a/doc/emacs/vc1-xtra.texi
+++ b/doc/emacs/vc1-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2004-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in vc-xtra.texi (when producing the
@@ -123,7 +123,7 @@ working tree, and schedule the renaming for committing.
it via the version control system. The file is removed from the
working tree, and in the VC Directory buffer
@iftex
-(@pxref{VC Directory Mode}),
+(@pxref{VC Directory Mode,,, emacs, the Emacs Manual}),
@end iftex
@ifnottex
(@pxref{VC Directory Mode}),
@@ -438,4 +438,10 @@ difference is that the ``manual'' version backups made by @kbd{C-x v
locking-like behavior using its @env{CVSREAD} or @dfn{watch} feature;
see the CVS documentation for details. If that case, you can use
@kbd{C-x v v} in Emacs to toggle locking, as you would for a
-locking-based version control system (@pxref{VC With A Locking VCS}).
+locking-based version control system
+@iftex
+(@pxref{VC With A Locking VCS,,,emacs, the Emacs Manual}).
+@end iftex
+@ifnottex
+(@pxref{VC With A Locking VCS}).
+@end ifnottex
diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi
index 6a6f7b1a4d7..f87da5f3913 100644
--- a/doc/emacs/windows.texi
+++ b/doc/emacs/windows.texi
@@ -1,8 +1,8 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2011
+@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Windows, Frames, Buffers, Top
+@node Windows
@chapter Multiple Windows
@cindex windows in Emacs
@cindex multiple windows in Emacs
@@ -36,8 +36,8 @@ has its own value of point.
At any time, one Emacs window is the @dfn{selected window}; the
buffer this window is displaying is the current buffer. On graphical
displays, the point is indicated by a solid blinking cursor in the
-selected window, and by a hollow box in non-selected windows. On
-text-only terminals, the cursor is drawn only in the selected window.
+selected window, and by a hollow box in non-selected windows. On text
+terminals, the cursor is drawn only in the selected window.
@xref{Cursor Display}.
Commands to move point affect the value of point for the selected
@@ -72,7 +72,7 @@ Split the selected window into two windows, one above the other
Split the selected window into two windows, positioned side by side
(@code{split-window-right}).
@item C-Mouse-2
-In the mode line or scroll bar of a window, split that window.
+In the mode line of a window, split that window.
@end table
@kindex C-x 2
@@ -125,11 +125,14 @@ lines in every partial-width window regardless of its width.
On text terminals, side-by-side windows are separated by a vertical
divider which is drawn using the @code{vertical-border} face.
+@kindex C-Mouse-2 @r{(mode line)}
@kindex C-Mouse-2 @r{(scroll bar)}
- You can also split a window horizontally or vertically by clicking
-@kbd{C-Mouse-2} in the mode line or the scroll bar. If you click on
-the mode line, that puts the vertical divider where you click; if you
-click in the scroll bar, that puts the new mode-line where you click.
+ If you click @kbd{C-Mouse-2} in the mode line of a window, that
+splits the window, putting a vertical divider where you click.
+Depending on how Emacs is compiled, you can also split a window by
+clicking @kbd{C-Mouse-2} in the scroll bar, which puts a horizontal
+divider where you click (this feature does not work when Emacs uses
+GTK+ scroll bars).
@node Other Window
@section Using Other Windows
@@ -148,7 +151,7 @@ selects the window without moving point in it.
@kindex C-x o
@findex other-window
With the keyboard, you can switch windows by typing @kbd{C-x o}
-(@code{other-window}). That is an @kbd{o}, for ``other,'' not a zero.
+(@code{other-window}). That is an @kbd{o}, for ``other'', not a zero.
When there are more than two windows, this command moves through all the
windows in a cyclic order, generally top to bottom and left to right.
After the rightmost and bottommost window, it goes back to the one at
@@ -375,20 +378,12 @@ adding the desired buffer's name to the list
expression to the list @code{same-window-regexps}. By default, these
variables are @code{nil}, so this step is skipped.
-@vindex display-buffer-reuse-frames
@item
Otherwise, if the buffer is already displayed in an existing window,
``reuse'' that window. Normally, only windows on the selected frame
are considered, but windows on other frames are also reusable if you
-change @code{display-buffer-reuse-frames} to @code{t}, or if you
change @code{pop-up-frames} (see below) to @code{t}.
-@item
-Otherwise, if you specified that the buffer should be displayed in a
-special frame by customizing @code{special-display-buffer-names} or
-@code{special-display-regexps}, do so. @xref{Choosing Window
-Options,,, elisp, The Emacs Lisp Reference Manual}.
-
@vindex pop-up-frames
@item
Otherwise, optionally create a new frame and display the buffer there.
@@ -449,7 +444,7 @@ buffer. @xref{Follow Mode}.
The Windmove package defines commands for moving directionally
between neighboring windows in a frame. @kbd{M-x windmove-right}
selects the window immediately to the right of the currently selected
-one, and similarly for the ``left,'' ``up,'' and ``down''
+one, and similarly for the ``left'', ``up'', and ``down''
counterparts. @kbd{M-x windmove-default-keybindings} binds these
commands to @kbd{S-right} etc.; doing so disables shift selection for
those keys (@pxref{Shift Selection}).
diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi
index b32b3d905e4..5bdf734804b 100644
--- a/doc/emacs/xresources.texi
+++ b/doc/emacs/xresources.texi
@@ -1,36 +1,31 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1987, 1993-1995, 1997, 2001-2011
+@c Copyright (C) 1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node X Resources, Antinews, Emacs Invocation, Top
+@node X Resources
@appendix X Options and Resources
You can customize some X-related aspects of Emacs behavior using X
-resources, as is usual for programs that use X. On MS-Windows, you
-can customize some of the same aspects using the system registry.
-@xref{MS-Windows Registry}.
-
- When Emacs is built using an ``X toolkit'', such as Lucid or
-LessTif, you need to use X resources to customize the appearance of
-the widgets, including the menu-bar, scroll-bar, and dialog boxes.
-This is because the libraries that implement these don't provide for
-customization through Emacs. GTK+ widgets use a separate system of
+resources, as is usual for programs that use X.
+
+ When Emacs is compiled with GTK+ support, the appearance of various
+graphical widgets, such as the menu-bar, scroll-bar, and dialog boxes,
+is determined by
@ifnottex
``GTK resources'', which we will also describe.
@end ifnottex
@iftex
-``GTK resources.'' In this chapter we describe the most commonly used
-resource specifications. For full documentation, see the online
-manual.
-
-@c Add xref for LessTif/Motif menu resources.
+``GTK resources''.
@end iftex
+When Emacs is built without GTK+ support, the appearance of these
+widgets is determined by additional X resources.
+ On MS-Windows, you can customize some of the same aspects using the
+system registry (@pxref{MS-Windows Registry}).
@menu
* Resources:: Using X resources with Emacs (in general).
* Table of Resources:: Table of specific X resources that affect Emacs.
-* Face Resources:: X resources for customizing faces.
* Lucid Resources:: X resources for Lucid menus.
* LessTif Resources:: X resources for LessTif and Motif menus.
* GTK resources:: Resources for GTK widgets.
@@ -51,71 +46,53 @@ this file do not take effect immediately, because the X server stores
its own list of resources; to update it, use the command
@command{xrdb}---for instance, @samp{xrdb ~/.Xdefaults}.
-@cindex Registry (MS-Windows)
- (MS-Windows systems do not support X resource files; on Windows,
+@cindex registry, setting resources (MS-Windows)
+ (MS-Windows systems do not support X resource files; on such systems,
Emacs looks for X resources in the Windows Registry, first under the
-key @samp{HKEY_CURRENT_USER\SOFTWARE\GNU\Emacs} and then under the key
-@samp{HKEY_LOCAL_MACHINE\SOFTWARE\GNU\Emacs}. The menu and scroll
-bars are native widgets on MS-Windows, so they are only customizable
-via the system-wide settings in the Display Control Panel. You can
-also set resources using the @samp{-xrm} command line option, as
-explained below.)
+key @samp{HKEY_CURRENT_USER\SOFTWARE\GNU\Emacs}, which affects only
+the current user and override the system-wide settings, and then under
+the key @samp{HKEY_LOCAL_MACHINE\SOFTWARE\GNU\Emacs}, which affects
+all users of the system. The menu and scroll bars are native widgets
+on MS-Windows, so they are only customizable via the system-wide
+settings in the Display Control Panel. You can also set resources
+using the @samp{-xrm} command line option, as explained below.)
Each line in the X resource file specifies a value for one option or
-for a collection of related options. Each resource specification
+for a collection of related options. The order in which the lines
+appear in the file does not matter. Each resource specification
consists of a @dfn{program name} and a @dfn{resource name}. Case
distinctions are significant in each of these names. Here is an
example:
@example
-emacs.borderWidth: 2
+emacs.cursorColor: dark green
@end example
-@ifnottex
The program name is the name of the executable file to which the
resource applies. For Emacs, this is normally @samp{emacs}. To
specify a definition that applies to all instances of Emacs,
regardless of the name of the Emacs executable, use @samp{Emacs}.
The resource name is the name of a program setting. For instance,
-Emacs recognizes a @samp{borderWidth} resource that controls the width
-of the external border for graphical frames.
+Emacs recognizes a @samp{cursorColor} resource that controls the color
+of the text cursor.
Resources are grouped into named classes. For instance, the
-@samp{BorderWidth} class contains both the @samp{borderWidth} resource
-(which we just described), as well as the @samp{internalBorder}
-resource, which controls the width of the internal border for
-graphical frames. Instead of using a resource name, you can use a
-class name to specify the same value for all resources in that class.
-Here's an example:
-
-@example
-emacs.BorderWidth: 2
-@end example
-
- If you specify a value for a class, it becomes the default for all
-resources in that class. You can specify values for individual
-resources as well; these override the class value, for those
-particular resources. The following example specifies 2 as the
-default width for all borders, but overrides this value with 4 for the
-external border:
+@samp{Foreground} class contains the @samp{cursorColor},
+@samp{foreground} and @samp{pointerColor} resources (@pxref{Table of
+Resources}). Instead of using a resource name, you can use a class
+name to specify the default value for all resources in that class,
+like this:
@example
-emacs.BorderWidth: 2
-emacs.borderWidth: 4
+emacs.Foreground: dark green
@end example
-@end ifnottex
-
- The order in which the lines appear in the file does not matter.
-One way to experiment with the effect of different resource settings
-is to use the @code{editres} program. See the @code{editres} man page
-for more details.
Emacs does not process X resources at all if you set the variable
-@code{inhibit-x-resources} to a non-@code{nil} value, or if you
-specify the @samp{-Q} (or @samp{--quick}) command-line argument
-(@pxref{Initial Options}). (The @samp{-Q} argument automatically sets
-@code{inhibit-x-resources} to @code{t}.)
+@code{inhibit-x-resources} to a non-@code{nil} value. If you invoke
+Emacs with the @samp{-Q} (or @samp{--quick}) command-line option,
+@code{inhibit-x-resources} is automatically set to @code{t}
+(@pxref{Initial Options}).
@ifnottex
In addition, you can use the following command-line options to
@@ -161,98 +138,93 @@ other resource specifications.
@node Table of Resources
@appendixsec Table of X Resources for Emacs
- This table lists the resource names that designate options for
-Emacs, not counting those for the appearance of the menu bar, each
-with the class that it belongs to:
+ This table lists the X resource names that Emacs recognizes,
+excluding those that control the appearance of graphical widgets like
+the menu bar:
@table @asis
@item @code{background} (class @code{Background})
-Background color name.
+Background color (@pxref{Colors}).
@item @code{bitmapIcon} (class @code{BitmapIcon})
Tell the window manager to display the Emacs icon if @samp{on}; don't
-do so if @samp{off}. (The icon is usually shown in the ``taskbar'' on
-a graphical desktop.)
+do so if @samp{off}. @xref{Icons X}, for a description of the icon.
+@ifnottex
@item @code{borderColor} (class @code{BorderColor})
-Color name for the external border.
+Color of the frame's external border. This has no effect if Emacs is
+compiled with GTK+ support.
-@ifnottex
@item @code{borderWidth} (class @code{BorderWidth})
-Width in pixels of the external border.
+Width of the frame's external border, in pixels. This has no effect
+if Emacs is compiled with GTK+ support.
@end ifnottex
@item @code{cursorColor} (class @code{Foreground})
-Color name for text cursor (point).
+Text cursor color. If this resource is specified when Emacs starts
+up, Emacs sets its value as the background color of the @code{cursor}
+face (@pxref{Faces}).
-@ifnottex
@item @code{cursorBlink} (class @code{CursorBlink})
-Specifies whether to make the cursor blink. The default is @samp{on}. Use
-@samp{off} or @samp{false} to turn cursor blinking off.
-@end ifnottex
+If the value of this resource is @samp{off} or @samp{false} or
+@samp{0} at startup, Emacs disables Blink Cursor mode (@pxref{Cursor
+Display}).
@item @code{font} (class @code{Font})
-Font name for the @code{default} font. @xref{Fonts}. You can also
+Font name for the @code{default} face (@pxref{Fonts}). You can also
specify a fontset name (@pxref{Fontsets}).
@item @code{fontBackend} (class @code{FontBackend})
-The backend(s) to use for drawing fonts; if multiple backends are
-specified, they must be comma-delimited and given in order of
-precedence. On X, for instance, the value @samp{x,xft} tells Emacs to
+Comma-delimited list of backend(s) to use for drawing fonts, in order
+of precedence. For instance, the value @samp{x,xft} tells Emacs to
draw fonts using the X core font driver, falling back on the Xft font
-driver if that fails. Normally, you can leave this resource unset, in
-which case Emacs tries using all font backends available on your
-graphical device.
+driver if that fails. Normally, you should leave this resource unset,
+in which case Emacs tries using all available font backends.
@item @code{foreground} (class @code{Foreground})
-Color name for text.
+Default foreground color for text.
@item @code{geometry} (class @code{Geometry})
-Window size and position. Be careful not to specify this resource as
-@samp{emacs*geometry}, because that may affect individual menus as well
-as the Emacs frame itself.
+Window size and position. The value should be a size and position
+specification, of the same form as in the @samp{-g} or
+@samp{--geometry} command-line option (@pxref{Window Size X}).
-If this resource specifies a position, that position applies only to the
-initial Emacs frame (or, in the case of a resource for a specific frame
-name, only that frame). However, the size, if specified here, applies to
-all frames.
+The size applies to all frames in the Emacs session, but the position
+applies only to the initial Emacs frame (or, in the case of a resource
+for a specific frame name, only that frame).
+
+
+Be careful not to specify this resource as @samp{emacs*geometry}, as
+that may affect individual menus as well as the main Emacs frame.
-@ifnottex
@item @code{fullscreen} (class @code{Fullscreen})
The desired fullscreen size. The value can be one of @code{fullboth},
-@code{maximized}, @code{fullwidth} or @code{fullheight}, which correspond to
-the command-line options @samp{-fs}, @samp{-mm}, @samp{-fw}, and @samp{-fh}
-(@pxref{Window Size X}).
-
-Note that this applies to the initial frame only.
-@end ifnottex
+@code{maximized}, @code{fullwidth} or @code{fullheight}, which
+correspond to the command-line options @samp{-fs}, @samp{-mm},
+@samp{-fw}, and @samp{-fh} (@pxref{Window Size X}). Note that this
+applies to the initial frame only.
+@ifnottex
@item @code{iconName} (class @code{Title})
Name to display in the icon.
@item @code{internalBorder} (class @code{BorderWidth})
-Width in pixels of the internal border.
+Width of the internal frame border, in pixels.
+@end ifnottex
@item @code{lineSpacing} (class @code{LineSpacing})
@cindex line spacing
-@cindex leading
-Additional space (@dfn{leading}) between lines, in pixels.
+Additional space between lines, in pixels.
@item @code{menuBar} (class @code{MenuBar})
@cindex menu bar
-Give frames menu bars if @samp{on}; don't have menu bars if @samp{off}.
-@ifnottex
-@xref{Lucid Resources}, and @ref{LessTif Resources},
-@end ifnottex
-@iftex
-@xref{Lucid Resources},
-@end iftex
-for how to control the appearance of the menu bar if you have one.
+If the value of this resource is @samp{off} or @samp{false} or
+@samp{0}, Emacs disables Menu Bar mode at startup (@pxref{Menu Bars}).
@ifnottex
@item @code{minibuffer} (class @code{Minibuffer})
-If @samp{none}, don't make a minibuffer in this frame.
-It will use a separate minibuffer frame instead.
+If @samp{none}, Emacs will not make a minibuffer in this frame; it
+will use a separate minibuffer frame instead.
@item @code{paneFont} (class @code{Font})
@cindex font for menus
@@ -260,7 +232,9 @@ Font name for menu pane titles, in non-toolkit versions of Emacs.
@end ifnottex
@item @code{pointerColor} (class @code{Foreground})
-Color of the mouse cursor.
+Color of the mouse cursor. This has no effect in many graphical
+desktop environments, as they do not let Emacs change the mouse cursor
+this way.
@ifnottex
@item @code{privateColormap} (class @code{PrivateColormap})
@@ -270,7 +244,6 @@ visual'' of class PseudoColor and Emacs is using it.
@item @code{reverseVideo} (class @code{ReverseVideo})
Switch foreground and background default colors if @samp{on}, use colors as
specified if @samp{off}.
-@end ifnottex
@item @code{screenGamma} (class @code{ScreenGamma})
@cindex gamma correction
@@ -280,7 +253,9 @@ Gamma correction for colors, equivalent to the frame parameter
@item @code{scrollBarWidth} (class @code{ScrollBarWidth})
@cindex scrollbar width
The scroll bar width in pixels, equivalent to the frame parameter
-@code{scroll-bar-width}.
+@code{scroll-bar-width}. Do not set this resource if Emacs is
+compiled with GTK+ support.
+@end ifnottex
@ifnottex
@item @code{selectionFont} (class @code{SelectionFont})
@@ -305,24 +280,16 @@ Name to display in the title bar of the initial Emacs frame.
@item @code{toolBar} (class @code{ToolBar})
@cindex tool bar
-Number of lines to reserve for the tool bar. A zero value suppresses
-the tool bar. For the Emacs tool bar (i.e.@: not Gtk+), if the value
-is non-zero and @code{auto-resize-tool-bars} is non-@code{nil}, the
-tool bar's size will be changed automatically so that all tool bar
-items are visible. If the value of @code{auto-resize-tool-bars} is
-@code{grow-only}, the tool bar expands automatically, but does not
-contract automatically. To contract the tool bar, you must redraw the
-frame by entering @kbd{C-l}. For the Gtk+ tool bar, any non-zero
-value means on and @code{auto-resize-tool-bars} has no effect.
+If the value of this resource is @samp{off} or @samp{false} or
+@samp{0}, Emacs disables Tool Bar mode at startup (@pxref{Tool Bars}).
@item @code{useXIM} (class @code{UseXIM})
@cindex XIM
@cindex X input methods
@cindex input methods, X
-Turn off use of X input methods (XIM) if @samp{false} or @samp{off}.
-This is only relevant if your Emacs is actually built with XIM
-support. It is potentially useful to turn off XIM for efficiency,
-especially slow X client/server links.
+Disable use of X input methods (XIM) if @samp{false} or @samp{off}.
+This is only relevant if your Emacs is built with XIM support. It
+might be useful to turn off XIM on slow X client/server links.
@item @code{verticalScrollBars} (class @code{ScrollBars})
Give frames scroll bars if @samp{on}; don't have scroll bars if
@@ -330,143 +297,51 @@ Give frames scroll bars if @samp{on}; don't have scroll bars if
@ifnottex
@item @code{visualClass} (class @code{VisualClass})
-Specify the ``visual'' that X should use. This tells X how to handle
-colors.
-
-The value should start with one of @samp{TrueColor},
-@samp{PseudoColor}, @samp{DirectColor}, @samp{StaticColor},
-@samp{GrayScale}, and @samp{StaticGray}, followed by
-@samp{-@var{depth}}, where @var{depth} is the number of color planes.
-Most terminals only allow a few ``visuals,'' and the @samp{dpyinfo}
-program outputs information saying which ones.
+The @dfn{visual class} for X color display. If specified, the value
+should start with one of @samp{TrueColor}, @samp{PseudoColor},
+@samp{DirectColor}, @samp{StaticColor}, @samp{GrayScale}, and
+@samp{StaticGray}, followed by @samp{-@var{depth}}, where @var{depth}
+is the number of color planes.
@end ifnottex
@end table
-@node Face Resources
-@appendixsec X Resources for Faces
-
- You can use resources to customize the appearance of particular
-faces (@pxref{Faces}):
-
-@table @code
-@item @var{face}.attributeForeground
-Foreground color for face @var{face}.
-@item @var{face}.attributeBackground
-Background color for face @var{face}.
-@item @var{face}.attributeUnderline
-Underline flag for face @var{face}. Use @samp{on} or @samp{true} for
-yes.
-@item @var{face}.attributeStrikeThrough
-@itemx @var{face}.attributeOverline
-@itemx @var{face}.attributeBox
-@itemx @var{face}.attributeInverse
-Likewise, for other boolean font attributes.
-@item @var{face}.attributeStipple
-The name of a pixmap data file to use for the stipple pattern, or
-@code{false} to not use stipple for the face @var{face}.
-@item @var{face}.attributeBackgroundPixmap
-The background pixmap for the face @var{face}. Should be a name of a
-pixmap file or @code{false}.
-@item @var{face}.attributeFont
-Font name (full XFD name or valid X abbreviation) for face @var{face}.
-Instead of this, you can specify the font through separate attributes.
-@end table
-
- Instead of using @code{attributeFont} to specify a font name, you can
-select a font through these separate attributes:
-
-@table @code
-@item @var{face}.attributeFamily
-Font family for face @var{face}.
-@item @var{face}.attributeHeight
-Height of the font to use for face @var{face}: either an integer
-specifying the height in units of 1/10@dmn{pt}, or a floating point
-number that specifies a scale factor to scale the underlying face's
-default font, or a function to be called with the default height which
-will return a new height.
-@item @var{face}.attributeWidth
-@itemx @var{face}.attributeWeight
-@itemx @var{face}.attributeSlant
-Each of these resources corresponds to a like-named font attribute,
-and you write the resource value the same as the symbol you would use
-for the font attribute value.
-@item @var{face}.attributeBold
-Bold flag for face @var{face}---instead of @code{attributeWeight}. Use @samp{on} or @samp{true} for
-yes.
-@item @var{face}.attributeItalic
-Italic flag for face @var{face}---instead of @code{attributeSlant}.
-@end table
+ You can also use X resources to customize individual Emacs faces
+(@pxref{Faces}). For example, setting the resource
+@samp{@var{face}.attributeForeground} is equivalent to customizing the
+@samp{foreground} attribute of the face @var{face}. However, we
+recommend customizing faces from within Emacs, instead of using X
+resources. @xref{Face Customization}.
+@ifnottex
@node Lucid Resources
@appendixsec Lucid Menu And Dialog X Resources
@cindex Menu X Resources (Lucid widgets)
@cindex Dialog X Resources (Lucid widgets)
@cindex Lucid Widget X Resources
-@ifnottex
- If the Emacs installed at your site was built to use the X toolkit
-with the Lucid menu widgets, then the menu bar is a separate widget and
-has its own resources. The resource names contain @samp{pane.menubar}
-(following, as always, the name of the Emacs invocation, or @samp{Emacs},
-which stands for all Emacs invocations). Specify them like this:
-
-@example
-Emacs.pane.menubar.@var{resource}: @var{value}
-@end example
-
-@noindent
-For example, to specify the font @samp{Courier-12} for the menu-bar items,
-write this:
-@end ifnottex
-@iftex
- If the Emacs installed at your site was built to use the X toolkit
-with the Lucid menu widgets, then the menu bar is a separate widget
-and has its own resources. The resource specifications start with
-@samp{Emacs.pane.menubar}---for instance, to specify the font
-@samp{Courier-12} for the menu-bar items, write this:
-@end iftex
+ If Emacs is compiled with the X toolkit support using Lucid widgets,
+you can use X resources to customize the appearance of the menu bar,
+pop-up menus, and dialog boxes. The resources for the menu bar fall
+in the @samp{pane.menubar} class (following, as always, either the
+name of the Emacs executable or @samp{Emacs} for all Emacs
+invocations). The resources for the pop-up menu are in the
+@samp{menu*} class. The resources for dialog boxes are in the
+@samp{dialog*} class.
-@example
-Emacs.pane.menubar.font: Courier-12
-@end example
-
-@noindent
-To specify a font, use fontconfig font names as values to the @code{font}
-resource, or old style names:
+ For example, to display menu bar entries with the @samp{Courier-12}
+font (@pxref{Fonts}), write this:
@example
-Emacs.pane.menubar.font: lucidasanstypewriter-10
+Emacs.pane.menubar.font: Courier-12
@end example
@noindent
-Emacs first tries to open the font as an old style font, and if that fails
-as an fontconfig font. In rare cases, Emacs might do the wrong thing.
-
-@noindent
-The Lucid menus can display multilingual text in your locale with old style
-fonts. For more information about fontsets see the man page for
-@code{XCreateFontSet}. To enable multilingual menu text you specify a
-@code{fontSet} resource instead of the font resource. If both
-@code{font} and @code{fontSet} resources are specified, the
-@code{fontSet} resource is used.
+Lucid widgets can display multilingual text in your locale. To enable
+this, specify a @code{fontSet} resource instead of a @code{font}
+resource. @xref{Fontsets}. If both @code{font} and @code{fontSet}
+resources are specified, the @code{fontSet} resource is used.
-@noindent
-Resources for @emph{non-menubar} toolkit pop-up menus have
-@samp{menu*} instead of @samp{pane.menubar}. For example, to specify
-the font @samp{8x16} for the pop-up menu items, write this:
-
-@example
-Emacs.menu*.font: 8x16
-@end example
-
-@noindent
-For dialog boxes, use @samp{dialog*}:
-
-@example
-Emacs.dialog*.font: Sans-12
-@end example
-
- Here is a list of the specific resources for menu bars and pop-up menus:
+Here is a list of resources for menu bars, pop-up menus, and dialogs:
@table @code
@item font
@@ -474,11 +349,11 @@ Font for menu item text.
@item fontSet
Fontset for menu item text.
@item foreground
-Color of the foreground.
+Foreground color.
@item background
-Color of the background.
+Background color.
@item buttonForeground
-In the menu bar, the color of the foreground for a selected item.
+Foreground color for a selected item.
@ifnottex
@item horizontalSpacing
Horizontal spacing in pixels between items. Default is 3.
@@ -488,59 +363,51 @@ Vertical spacing in pixels between items. Default is 2.
Horizontal spacing between the arrow (which indicates a submenu) and
the associated text. Default is 10.
@item shadowThickness
-Thickness of shadow line around the widget. Default is 1.
-
-Also determines the thickness of shadow lines around other objects,
-for instance 3D buttons and arrows. If you have the impression that
-the arrows in the menus do not stand out clearly enough or that the
-difference between ``in'' and ``out'' buttons is difficult to see, set
-this to 2. If you have no problems with visibility, the default
-probably looks better. The background color may also have some effect
-on the contrast.
+Thickness of shadow lines for 3D buttons, arrows, and other graphical
+elements. Default is 1.
@end ifnottex
@item margin
-The margin of the menu bar, in characters. Default is 1.
+Margin of the menu bar, in characters. Default is 1.
@end table
-@ifnottex
@node LessTif Resources
@appendixsec LessTif Menu X Resources
@cindex Menu X Resources (LessTif widgets)
@cindex LessTif Widget X Resources
- If the Emacs installed at your site was built to use the X toolkit
-with the LessTif or Motif widgets, then the menu bar, the dialog
-boxes, the pop-up menus, and the file-selection box are separate
-widgets and have their own resources.
+ If Emacs is compiled with the X toolkit support using LessTif or
+Motif widgets, you can use X resources to customize the appearance of
+the menu bar, pop-up menus, and dialog boxes. However, the resources
+are organized differently from Lucid widgets.
- The resource names for the menu bar contain @samp{pane.menubar}
-(following, as always, the name of the Emacs invocation, or
-@samp{Emacs}, which stands for all Emacs invocations). Specify them
-like this:
+ The resource names for the menu bar are in the @samp{pane.menubar}
+class, and they must be specified in this form:
@smallexample
Emacs.pane.menubar.@var{subwidget}.@var{resource}: @var{value}
@end smallexample
- Each individual string in the menu bar is a subwidget; the subwidget's
-name is the same as the menu item string. For example, the word
-@samp{File} in the menu bar is part of a subwidget named
-@samp{emacs.pane.menubar.File}. Most likely, you want to specify the
-same resources for the whole menu bar. To do this, use @samp{*} instead
-of a specific subwidget name. For example, to specify the font
-@samp{8x16} for the menu-bar items, write this:
+@noindent
+For pop-up menus, the resources are in the @samp{menu*} class, instead
+of @samp{pane.menubar}. For dialog boxes, they are in @samp{dialog}.
+In each case, each individual menu string is a subwidget; the
+subwidget's name is the same as the menu item string. For example,
+the @samp{File} menu in the menu bar is a subwidget named
+@samp{emacs.pane.menubar.File}.
+
+ Typically, you want to specify the same resources for the whole menu
+bar. To do this, use @samp{*} instead of a specific subwidget name.
+For example, to specify the font @samp{8x16} for all menu bar items,
+including submenus, write this:
@smallexample
Emacs.pane.menubar.*.fontList: 8x16
@end smallexample
-@noindent
-This also specifies the resource value for submenus.
-
- Each item in a submenu in the menu bar also has its own name for X
-resources; for example, the @samp{File} submenu has an item named
-@samp{Save (current buffer)}. A resource specification for a submenu
-item looks like this:
+ Each item in a submenu also has its own name for X resources; for
+example, the @samp{File} submenu has an item named @samp{Save (current
+buffer)}. A resource specification for a submenu item looks like
+this:
@smallexample
Emacs.pane.menubar.popup_*.@var{menu}.@var{item}.@var{resource}: @var{value}
@@ -573,46 +440,23 @@ Emacs.pane.menubar.popup_*.popup_*.Spell Checking.Complete Word: @var{value}
@noindent
(This should be one long line.)
- It's impossible to specify a resource for all the menu-bar items
-without also specifying it for the submenus as well. So if you want the
-submenu items to look different from the menu bar itself, you must ask
-for that in two steps. First, specify the resource for all of them;
-then, override the value for submenus alone. Here is an example:
+ If you want the submenu items to look different from the menu bar
+itself, you must first specify the resource for all of them, then
+override the value for submenus alone. Here is an example:
@smallexample
Emacs.pane.menubar.*.fontList: 8x16
Emacs.pane.menubar.popup_*.fontList: 8x16
@end smallexample
-@noindent
-For LessTif pop-up menus, use @samp{menu*} instead of
-@samp{pane.menubar}. For example, to specify the font @samp{8x16} for
-the pop-up menu items, write this:
-
-@smallexample
-Emacs.menu*.fontList: 8x16
-@end smallexample
-
-@noindent
-For LessTif dialog boxes, use @samp{dialog} instead of @samp{menu}:
-
-@example
-Emacs.dialog*.fontList: 8x16
-Emacs.dialog*.foreground: hotpink
-@end example
-
-To specify resources for the LessTif file-selection box, use
+ To specify resources for the LessTif file-selection box, use
@samp{fsb*}, like this:
@example
Emacs.fsb*.fontList: 8x16
@end example
-@iftex
-@medbreak
-@end iftex
- Here is a list of the specific resources for LessTif menu bars and
-pop-up menus:
+ Here is a list of resources for LessTif menu bars and pop-up menus:
@table @code
@item armColor
@@ -637,128 +481,92 @@ The color for the border shadow, on the top and the left.
@end table
@end ifnottex
-
@node GTK resources
@appendixsec GTK resources
-@iftex
- The most common way to customize the GTK widgets Emacs uses (menus,
-dialogs tool bars and scroll bars) is by choosing an appropriate
-theme, for example with the GNOME theme selector.
-
-You can also do Emacs specific customization by inserting GTK style
-directives in the file @file{~/.emacs.d/gtkrc}, but only if you have a
-Gtk+ version earlier than 3 (i.e.@: 2). Some GTK themes ignore
-customizations in @file{~/.emacs.d/gtkrc} so not everything works with
-all themes. To customize Emacs font, background, faces, etc., use the
-normal X resources (@pxref{Resources}). We will present some examples
-of customizations here, but for a more detailed description, see the
-online manual
-
- The first example is just one line. It changes the font on all GTK widgets
-to courier with size 12:
-
-@smallexample
-gtk-font-name = "courier 12"
-@end smallexample
-
- The thing to note is that the font name is not an X font name, but a
-Pango font name. A Pango font name is basically of the format "family
-style size", where the style is optional as in the case above. A name
-with a style could be for example:
+@cindex GTK+ resources
+@cindex resource files for GTK
+@cindex @file{~/.gtkrc-2.0} file
+@cindex @file{~/.emacs.d/gtkrc} file
-@smallexample
-gtk-font-name = "helvetica bold 10"
-@end smallexample
+ If Emacs is compiled with GTK+ toolkit support, the simplest way to
+customize its GTK+ widgets (e.g.@: menus, dialogs, tool bars and
+scroll bars) is to choose an appropriate GTK+ theme, for example with
+the GNOME theme selector.
+
+ In GTK+ version 2, you can also use @dfn{GTK+ resources} to
+customize the appearance of GTK+ widgets used by Emacs. These
+resources are specified in either the file @file{~/.emacs.d/gtkrc}
+(for Emacs-specific GTK+ resources), or @file{~/.gtkrc-2.0} (for
+general GTK+ resources). We recommend using @file{~/.emacs.d/gtkrc},
+since GTK+ seems to ignore @file{~/.gtkrc-2.0} when running GConf with
+GNOME. Note, however, that some GTK themes may override
+customizations in @file{~/.emacs.d/gtkrc}; there is nothing we can do
+about this. GTK+ resources do not affect aspects of Emacs unrelated
+to GTK+ widgets, such as fonts and colors in the main Emacs window;
+those are governed by normal X resources (@pxref{Resources}).
+
+ The following sections describe how to customize GTK+ resources for
+Emacs. For details about GTK+ resources, see the GTK+ API document at
+@uref{http://developer.gnome.org/doc/API/2.0/gtk/gtk-Resource-Files.html}.
- To customize widgets you first define a style and then apply the style to
-the widgets. Here is an example that sets the font for menus, but not
-for other widgets:
+ In GTK+ version 3, GTK+ resources have been replaced by a completely
+different system. The appearance of GTK+ widgets is now determined by
+CSS-like style files: @file{gtk-3.0/gtk.css} in the GTK+ installation
+directory, and @file{~/.themes/@var{theme}/gtk-3.0/gtk.css} for local
+style settings (where @var{theme} is the name of the current GTK+
+theme). Therefore, the description of GTK+ resources in this section
+does not apply to GTK+ 3. For details about the GTK+ 3 styling
+system, see
+@uref{http://developer.gnome.org/gtk3/3.0/GtkCssProvider.html}.
-@smallexample
-# @r{Define the style @samp{menufont}.}
-style "menufont"
-@{
- font_name = "helvetica bold 14" # This is a Pango font name
-@}
+@menu
+* GTK Resource Basics:: Basic usage of GTK+ resources.
+* GTK Widget Names:: How GTK+ widgets are named.
+* GTK Names in Emacs:: GTK widgets used by Emacs.
+* GTK styles:: What can be customized in a GTK widget.
+@end menu
-# @r{Specify that widget type @samp{*emacs-menuitem*} uses @samp{menufont}.}
-widget "*emacs-menuitem*" style "menufont"
-@end smallexample
+@node GTK Resource Basics
+@appendixsubsec GTK Resource Basics
-The widget name in this example contains wildcards, so the style will be
-applied to all widgets that match "*emacs-menuitem*". The widgets are
-named by the way they are contained, from the outer widget to the inner widget.
-So to apply the style "my_style" (not shown) with the full, absolute name, for
-the menubar and the scroll bar in Emacs we use:
+ In a GTK+ 2 resource file (usually @file{~/.emacs.d/gtkrc}), the
+simplest kinds of resource settings simply assign a value to a
+variable. For example, putting the following line in the resource
+file changes the font on all GTK+ widgets to @samp{courier-12}:
@smallexample
-widget "Emacs.pane.menubar" style "my_style"
-widget "Emacs.pane.emacs.verticalScrollBar" style "my_style"
+gtk-font-name = "courier 12"
@end smallexample
-But to avoid having to type it all, wildcards are often used. @samp{*}
-matches zero or more characters and @samp{?} matches one character. So "*"
-matches all widgets.
+@noindent
+Note that in this case the font name must be supplied as a GTK font
+pattern (also called a @dfn{Pango font name}), not as a
+Fontconfig-style font name or XLFD. @xref{Fonts}.
- Each widget has a class (for example GtkMenuItem) and a name (emacs-menuitem).
-You can assign styles by name or by class. In this example we have used the
-class:
+ To customize widgets you first define a @dfn{style}, and then apply
+the style to the widgets. Here is an example that sets the font for
+menus (@samp{#} characters indicate comments):
@smallexample
-style "menufont"
+# @r{Define the style @samp{my_style}.}
+style "my_style"
@{
font_name = "helvetica bold 14"
@}
-widget_class "*GtkMenuBar" style "menufont"
+# @r{Specify that widget type @samp{*emacs-menuitem*} uses @samp{my_style}.}
+widget "*emacs-menuitem*" style "my_style"
@end smallexample
@noindent
-The names and classes for the GTK widgets Emacs uses are:
-
-@multitable {@code{verticalScrollbar plus}} {@code{GtkFileSelection} and some}
-@item @code{emacs-filedialog}
-@tab @code{GtkFileSelection}
-@item @code{emacs-dialog}
-@tab @code{GtkDialog}
-@item @code{Emacs}
-@tab @code{GtkWindow}
-@item @code{pane}
-@tab @code{GtkVHbox}
-@item @code{emacs}
-@tab @code{GtkFixed}
-@item @code{verticalScrollBar}
-@tab @code{GtkVScrollbar}
-@item @code{emacs-toolbar}
-@tab @code{GtkToolbar}
-@item @code{menubar}
-@tab @code{GtkMenuBar}
-@item @code{emacs-menuitem}
-@tab anything in menus
-@end multitable
-
- GTK absolute names are quite strange when it comes to menus
-and dialogs. The names do not start with @samp{Emacs}, as they are
-free-standing windows and not contained (in the GTK sense) by the
-Emacs GtkWindow. To customize the dialogs and menus, use wildcards like this:
-
-@smallexample
-widget "*emacs-dialog*" style "my_dialog_style"
-widget "*emacs-filedialog* style "my_file_style"
-widget "*emacs-menuitem* style "my_menu_style"
-@end smallexample
-
- If you specify a customization in @file{~/.emacs.d/gtkrc}, then it
-automatically applies only to Emacs, since other programs don't read
-that file. For example, the drop down menu in the file dialog can not
-be customized by any absolute widget name, only by an absolute class
-name. This is because the widgets in the drop down menu do not
-have names and the menu is not contained in the Emacs GtkWindow. To
-have all menus in Emacs look the same, use this in
-@file{~/.emacs.d/gtkrc}:
+The widget name in this example contains wildcards, so the style is
+applied to all widgets matching @samp{*emacs-menuitem*}. The widgets
+are named by the way they are contained, from the outer widget to the
+inner widget. Here is another example that applies @samp{my_style}
+specifically to the Emacs menu bar:
@smallexample
-widget_class "*Menu*" style "my_menu_style"
+widget "Emacs.pane.menubar.*" style "my_style"
@end smallexample
Here is a more elaborate example, showing how to change the parts of
@@ -767,97 +575,24 @@ the scroll bar:
@smallexample
style "scroll"
@{
- fg[NORMAL] = "red"@ @ @ @ @ # @r{The arrow color.}
- bg[NORMAL] = "yellow"@ @ # @r{The thumb and background around the arrow.}
- bg[ACTIVE] = "blue"@ @ @ @ # @r{The trough color.}
- bg[PRELIGHT] = "white"@ # @r{The thumb color when the mouse is over it.}
+ fg[NORMAL] = "red"@ @ @ @ @ # @r{Arrow color.}
+ bg[NORMAL] = "yellow"@ @ # @r{Thumb and background around arrow.}
+ bg[ACTIVE] = "blue"@ @ @ @ # @r{Trough color.}
+ bg[PRELIGHT] = "white"@ # @r{Thumb color when the mouse is over it.}
@}
widget "*verticalScrollBar*" style "scroll"
@end smallexample
-@end iftex
-
-@ifnottex
-@cindex GTK resources and customization
-@cindex resource files for GTK
-@cindex @file{~/.gtkrc-2.0} file
-@cindex @file{~/.emacs.d/gtkrc} file
-
- If Emacs was built to use the GTK widget set, then the menu bar, tool bar,
-scroll bar and the dialogs are customized with the standard GTK
-customization file, @file{~/.gtkrc-2.0}, or with the Emacs specific
-file @file{~/.emacs.d/gtkrc}. We recommend that you use
-@file{~/.emacs.d/gtkrc} for customizations, since @file{~/.gtkrc-2.0}
-seems to be ignored when running GConf with GNOME. These files apply
-only to GTK widget features. To customize Emacs font, background,
-faces, etc., use the normal X resources (@pxref{Resources}).
-
- Some GTK themes override these mechanisms, which means that using
-these mechanisms will not work to customize them.
-
- In these files you first define a style and say what it means; then
-you specify to apply the style to various widget types (@pxref{GTK
-widget names}). Here is an example of how to change the font for
-Emacs menus:
-
-@smallexample
-# @r{Define the style @samp{menufont}.}
-style "menufont"
-@{
- font_name = "helvetica bold 14" # This is a Pango font name
-@}
-
-# @r{Specify that widget type @samp{*emacs-menuitem*} uses @samp{menufont}.}
-widget "*emacs-menuitem*" style "menufont"
-@end smallexample
-
- Here is a more elaborate example, showing how to change the parts of
-the scroll bar:
-
-@smallexample
-style "scroll"
-@{
- fg[NORMAL] = "red"@ @ @ @ @ # @r{The arrow color.}
- bg[NORMAL] = "yellow"@ @ # @r{The thumb and background around the arrow.}
- bg[ACTIVE] = "blue"@ @ @ @ # @r{The trough color.}
- bg[PRELIGHT] = "white"@ # @r{The thumb color when the mouse is over it.}
-@}
-widget "*verticalScrollBar*" style "scroll"
-@end smallexample
-
- There are also parameters that affect GTK as a whole. For example,
-the property @code{gtk-font-name} sets the default font for GTK. You
-must use Pango font names (@pxref{GTK styles}). A GTK resources file
-that just sets a default font looks like this:
-
-@smallexample
-gtk-font-name = "courier 12"
-@end smallexample
-
- The GTK resources file is fully described in the GTK API document.
-This can be found in
-@file{@var{prefix}/share/gtk-doc/html/gtk/gtk-resource-files.html},
-where @file{prefix} is the directory in which the GTK libraries were
-installed (usually @file{/usr} or @file{/usr/local}). You can also
-find the document online, at
-@uref{http://developer.gnome.org/doc/API/2.0/gtk/gtk-Resource-Files.html}.
-
-@menu
-* GTK widget names:: How widgets in GTK are named in general.
-* GTK Names in Emacs:: GTK widget names in Emacs.
-* GTK styles:: What can be customized in a GTK widget.
-@end menu
-
-@node GTK widget names
+@node GTK Widget Names
@appendixsubsec GTK widget names
@cindex GTK widget names
- A GTK widget is specified by its @dfn{widget class} and
-@dfn{widget name}. The widget class is the type of the widget: for
-example, @code{GtkMenuBar}. The widget name is the name given to a
-specific widget. A widget always has a class, but need not have a
-name.
+ A GTK+ widget is specified by a @dfn{widget name} and a @dfn{widget
+class}. The widget name refers to a specific widget
+(e.g.@: @samp{emacs-menuitem}), while the widget class refers to a
+collection of similar widgets (e.g.@: @samp{GtkMenuItem}). A widget
+always has a class, but need not have a name.
@dfn{Absolute names} are sequences of widget names or widget
classes, corresponding to hierarchies of widgets embedded within
@@ -867,55 +602,31 @@ a @code{GtkMenuBar} called @code{menubar}, the absolute class name
of the menu-bar widget is @code{GtkWindow.GtkVBox.GtkMenuBar}, and
its absolute widget name is @code{top.box.menubar}.
- When assigning a style to a widget, you can use the absolute class
-name or the absolute widget name.
-
- There are two commands to specify changes for widgets:
+ GTK+ resource files can contain two types of commands for specifying
+widget appearances:
-@table @asis
-@item @code{widget_class}
-specifies a style for widgets based on the absolute class name.
+@table @code
+@item widget
+specifies a style for widgets based on the class name, or just the
+class.
-@item @code{widget}
-specifies a style for widgets based on the absolute class name,
-or just the class.
+@item widget_class
+specifies a style for widgets based on the class name.
@end table
@noindent
-You must specify the class and the style in double-quotes, and put
-these commands at the top level in the GTK customization file, like
-this:
+See the previous subsection for examples of using the @code{widget}
+command; the @code{widget_class} command is used similarly. Note that
+the widget name/class and the style must be enclosed in double-quotes,
+and these commands must be at the top level in the GTK+ resource file.
-@smallexample
-style "menufont"
-@{
- font_name = "helvetica bold 14"
-@}
-
-widget "top.box.menubar" style "menufont"
-widget_class "GtkWindow.GtkVBox.GtkMenuBar" style "menufont"
-@end smallexample
-
- Matching of absolute names uses shell wildcard syntax: @samp{*}
-matches zero or more characters and @samp{?} matches one character.
-This example assigns @code{base_style} to all widgets:
+ As previously noted, you may specify a widget name or class with
+shell wildcard syntax: @samp{*} matches zero or more characters and
+@samp{?} matches one character. This example assigns a style to all
+widgets:
@smallexample
-widget "*" style "base_style"
-@end smallexample
-
- Given the absolute class name @code{GtkWindow.GtkVBox.GtkMenuBar}
-and the corresponding absolute widget name @code{top.box.menubar}, all
-these examples specify @code{my_style} for the menu bar:
-
-@smallexample
-widget_class "GtkWindow.GtkVBox.GtkMenuBar" style "my_style"
-widget_class "GtkWindow.*.GtkMenuBar" style "my_style"
-widget_class "*GtkMenuBar" style "my_style"
-widget "top.box.menubar" style "my_style"
-widget "*box*menubar" style "my_style"
-widget "*menubar" style "my_style"
-widget "*menu*" style "my_style"
+widget "*" style "my_style"
@end smallexample
@node GTK Names in Emacs
@@ -923,68 +634,52 @@ widget "*menu*" style "my_style"
@cindex GTK widget names
@cindex GTK widget classes
- In Emacs, the top level widget for a frame is a @code{GtkWindow}
-that contains a @code{GtkVBox}. The @code{GtkVBox} contains the
-@code{GtkMenuBar} and a @code{GtkFixed} widget. The vertical scroll
-bars, @code{GtkVScrollbar}, are contained in the @code{GtkFixed}
-widget. The text you write in Emacs is drawn in the @code{GtkFixed}
-widget.
+ The GTK+ widgets used by an Emacs frame are listed below:
- Dialogs in Emacs are @code{GtkDialog} widgets. The file dialog is a
-@code{GtkFileSelection} widget.
+@table @asis
+@item @code{Emacs} (class @code{GtkWindow})
+@table @asis
+@item @code{pane} (class @code{GtkVBox})
+@table @asis
+@item @code{menubar} (class @code{GtkMenuBar})
+@table @asis
+@item [menu item widgets]
+@end table
+@item [unnamed widget] (class @code{GtkHandleBox})
+@table @asis
+@item @code{emacs-toolbar} (class @code{GtkToolbar})
+@table @asis
+@item [tool bar item widgets]
+@end table
+@end table
+@item @code{emacs} (class @code{GtkFixed})
+@table @asis
+@item @code{verticalScrollBar} (class @code{GtkVScrollbar})
+@end table
+@end table
+@end table
+@end table
@noindent
-To set a style for the menu bar using the absolute class name, use:
+The contents of Emacs windows are drawn in the @code{emacs} widget.
+Note that even if there are multiple Emacs windows, each scroll bar
+widget is named @code{verticalScrollBar}.
-@smallexample
-widget_class "GtkWindow.GtkVBox.GtkMenuBar" style "my_style"
-@end smallexample
-
-@noindent
-For the scroll bar, the absolute class name is:
+ For example, here are two different ways to set the menu bar style:
@smallexample
-widget_class
- "GtkWindow.GtkVBox.GtkFixed.GtkVScrollbar"
- style "my_style"
+widget "Emacs.pane.menubar.*" style "my_style"
+widget_class "GtkWindow.GtkVBox.GtkMenuBar.*" style "my_style"
@end smallexample
-@noindent
-The names for the emacs widgets, and their classes, are:
-
-@multitable {@code{verticalScrollbar plus}} {@code{GtkFileSelection} and some}
-@item @code{emacs-filedialog}
-@tab @code{GtkFileSelection}
-@item @code{emacs-dialog}
-@tab @code{GtkDialog}
-@item @code{Emacs}
-@tab @code{GtkWindow}
-@item @code{pane}
-@tab @code{GtkVHbox}
-@item @code{emacs}
-@tab @code{GtkFixed}
-@item @code{verticalScrollBar}
-@tab @code{GtkVScrollbar}
-@item @code{emacs-toolbar}
-@tab @code{GtkToolbar}
-@item @code{menubar}
-@tab @code{GtkMenuBar}
-@item @code{emacs-menuitem}
-@tab anything in menus
-@end multitable
-
-@noindent
-Thus, for Emacs you can write the two examples above as:
-
-@smallexample
-widget "Emacs.pane.menubar" style "my_style"
-widget "Emacs.pane.emacs.verticalScrollBar" style "my_style"
-@end smallexample
+ For GTK+ dialogs, Emacs uses a widget named @code{emacs-dialog}, of
+class @code{GtkDialog}. For file selection, Emacs uses a widget named
+@code{emacs-filedialog}, of class @code{GtkFileSelection}.
- GTK absolute names are quite strange when it comes to menus
-and dialogs. The names do not start with @samp{Emacs}, as they are
-free-standing windows and not contained (in the GTK sense) by the
-Emacs GtkWindow. To customize the dialogs and menus, use wildcards like this:
+ Because the widgets for pop-up menus and dialogs are free-standing
+windows and not ``contained'' in the @code{Emacs} widget, their GTK+
+absolute names do not start with @samp{Emacs}. To customize these
+widgets, use wildcards like this:
@smallexample
widget "*emacs-dialog*" style "my_dialog_style"
@@ -992,14 +687,7 @@ widget "*emacs-filedialog* style "my_file_style"
widget "*emacs-menuitem* style "my_menu_style"
@end smallexample
- If you specify a customization in @file{~/.emacs.d/gtkrc}, then it
-automatically applies only to Emacs, since other programs don't read
-that file. For example, the drop down menu in the file dialog can not
-be customized by any absolute widget name, only by an absolute class
-name. This is because the widgets in the drop down menu do not
-have names and the menu is not contained in the Emacs GtkWindow. To
-have all menus in Emacs look the same, use this in
-@file{~/.emacs.d/gtkrc}:
+ If you want to apply a style to all menus in Emacs, use this:
@smallexample
widget_class "*Menu*" style "my_menu_style"
@@ -1009,15 +697,7 @@ widget_class "*Menu*" style "my_menu_style"
@appendixsubsec GTK styles
@cindex GTK styles
- In a GTK style you specify the appearance widgets shall have. You
-can specify foreground and background color, background pixmap and
-font. The edit widget (where you edit the text) in Emacs is a GTK
-widget, but trying to specify a style for the edit widget will have no
-effect. This is so that Emacs compiled for GTK is compatible with
-Emacs compiled for other X toolkits. The settings for foreground,
-background and font for the edit widget is taken from the X resources;
-@pxref{Resources}. Here is an example of two style declarations,
-@samp{default} and @samp{ruler}:
+ Here is an example of two GTK+ style declarations:
@smallexample
pixmap_path "/usr/share/pixmaps:/usr/include/X11/pixmaps"
@@ -1127,9 +807,8 @@ text fields in the file dialog.
@item font_name = "@var{font}"
This specifies the font for text in the widget. @var{font} is a
-Pango font name, for example @samp{Sans Italic 10}, @samp{Helvetica
-Bold 12}, @samp{Courier 14}, @samp{Times 18}. See below for exact
-syntax. The names are case insensitive.
+GTK-style (or Pango) font name, like @samp{Sans Italic 10}.
+@xref{Fonts}. The names are case insensitive.
@end table
There are three ways to specify a color: a color name, an RGB
@@ -1137,60 +816,6 @@ triplet, or a GTK-style RGB triplet. @xref{Colors}, for a description
of color names and RGB triplets. Color names should be enclosed with
double quotes, e.g.@: @samp{"red"}. RGB triplets should be written
without double quotes, e.g.@: @samp{#ff0000}. GTK-style RGB triplets
-have the form
-
-@smallexample
-@code{@{ @var{r}, @var{g}, @var{b} @}}
-@end smallexample
-
-@noindent
-where @var{r}, @var{g} and @var{b} are either integers in the range
-0-65535 or floats in the range 0.0-1.0.
-
- Pango font names have the form ``@var{family-list} @var{style-options}
-@var{size}.''
-@cindex Pango font name
-@noindent
-@var{family-list} is a comma separated list of font families optionally
-terminated by a comma. This way you can specify several families and the
-first one found will be used. @var{family} corresponds to the second part in
-an X font name, for example in
-
-@smallexample
--adobe-times-medium-r-normal--12-120-75-75-p-64-iso10646-1
-@end smallexample
-
-@noindent
-the family name is @samp{times}.
-
-@noindent
-@var{style-options} is a whitespace separated list of words where each word
-is a style, variant, weight, or stretch. The default value for all of
-these is @code{normal}.
-
-@noindent
-A `style' corresponds to the fourth part of an X font name. In X font
-names it is the character @samp{r}, @samp{i} or @samp{o}; in Pango
-font names the corresponding values are @code{normal}, @code{italic},
-or @code{oblique}.
-
-@noindent
-A `variant' is either @code{normal} or @code{small-caps}.
-Small caps is a font with the lower case characters replaced by
-smaller variants of the capital characters.
-
-@noindent
-Weight describes the ``boldness'' of a font. It corresponds to the third
-part of an X font name. It is one of @code{ultra-light}, @code{light},
-@code{normal}, @code{bold}, @code{ultra-bold}, or @code{heavy}.
-
-@noindent
-Stretch gives the width of the font relative to other designs within a
-family. It corresponds to the fifth part of an X font name. It is one of
-@code{ultra-condensed}, @code{extra-condensed}, @code{condensed},
-@code{semi-condensed}, @code{normal}, @code{semi-expanded},
-@code{expanded}, @code{extra-expanded}, or @code{ultra-expanded}.
-
-@noindent
-@var{size} is a decimal number that describes the font size in points.
-@end ifnottex
+have the form @w{@code{@{ @var{r}, @var{g}, @var{b} @}}}, where
+@var{r}, @var{g} and @var{b} are either integers in the range 0-65535
+or floats in the range 0.0-1.0.
diff --git a/doc/lispintro/ChangeLog b/doc/lispintro/ChangeLog
index 6cede6375f2..5402504448a 100644
--- a/doc/lispintro/ChangeLog
+++ b/doc/lispintro/ChangeLog
@@ -1,3 +1,81 @@
+2012-11-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ * doclicense.texi: Update to latest version from FSF.
+ These are just minor editorial changes.
+
+2012-10-24 Paul Eggert <eggert@penguin.cs.ucla.edu>
+
+ * emacs-lisp-intro.texi (Files List):
+ Update manual for new time stamp format (Bug#12706).
+
+2012-10-17 Gregor Zattler <grfz@gmx.de> (tiny change)
+
+ * emacs-lisp-intro.texi (Narrowing advantages):
+ Minor update for changed what-line implementation. (Bug#12629)
+
+2012-06-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737)
+
+2012-05-29 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp-intro.texi: Nuke hand-written node pointers.
+ (dolist, dotimes): Fix sectioning.
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MKDIR_P): New, set by configure.
+ (mkinfodir): Use $MKDIR_P.
+
+2012-05-05 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp-intro.texi (Making Errors): Don't mention Emacs 20.
+ (Void Function, Wrong Type of Argument, Recursion with list)
+ (Simple Extension): Assume a non-ancient Emacs.
+ (Void Variable, Switching Buffers): Improve page breaks.
+
+ * emacs-lisp-intro.texi: Update GNU Press contact details.
+
+2012-05-04 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (INFO_EXT, INFO_OPTS): New, set by configure.
+ (info, infoclean): Use $INFO_EXT.
+ (${infodir}/eintr$(INFO_EXT)): Use $INFO_EXT and $INFO_OPT.
+ * makefile.w32-in (INFO_EXT, INFO_OPTS): New.
+ (INFO_TARGETS, clean): Use $INFO_EXT.
+ ($(infodir)/eintr$(INFO_EXT)): Use $INFO_EXT and $INFO_OPT.
+
+2012-05-02 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp-intro.texi (Syntax): Reword to avoid underfull hbox.
+
+2012-04-14 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: Replace non-portable use of $< in ordinary rules.
+
+2012-02-28 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp-intro.texi: Standardize possessive apostrophe usage.
+
+2012-02-17 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp-intro.texi (Design @value{COUNT-WORDS}, Syntax)
+ (count-words-in-defun): Fix cross-refs to Emacs manual.
+
+2012-01-28 Andreas Schwab <schwab@linux-m68k.org>
+
+ * emacs-lisp-intro.texi (Top): Move setting of COUNT-WORDS outside
+ of @menu. (Bug#10628)
+
+2012-01-19 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp-intro.texi (count-words-in-defun):
+ Add missing parenthesis (bug#10544).
+
+2012-01-17 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp-intro.texi (re-search-forward): Fix typo.
+
2011-11-24 Juanma Barranquero <lekktu@gmail.com>
* makefile.w32-in: Update dependencies.
@@ -326,7 +404,7 @@
`named' to `selected'.
(lengths-list-file): Remove extraneous parenthesis from reference.
(lengths-list-many-files): Explain `expand-file-name' better.
- (Files List): Rephrase sentence regarding Lisp sources directory
+ (Files List): Rephrase sentence regarding Lisp sources directory.
2006-11-04 Robert J. Chassell <bob@rattlesnake.com>
@@ -471,7 +549,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/doc/lispintro/Makefile.in b/doc/lispintro/Makefile.in
index df356f1b132..3f2fe1f9526 100644
--- a/doc/lispintro/Makefile.in
+++ b/doc/lispintro/Makefile.in
@@ -1,6 +1,6 @@
#### Makefile for the Emacs Lisp Introduction manual
-# Copyright (C) 1994-1999, 2001-2011 Free Software Foundation, Inc.
+# Copyright (C) 1994-1999, 2001-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -22,10 +22,16 @@ SHELL = /bin/sh
srcdir = @srcdir@
version=@version@
-infodir = $(srcdir)/../../info
+buildinfodir = $(srcdir)/../../info
# Directory with the (customized) texinfo.tex file.
texinfodir = $(srcdir)/../misc
+MKDIR_P = @MKDIR_P@
+
+INFO_EXT=@INFO_EXT@
+# Options used only when making info output.
+INFO_OPTS=@INFO_OPTS@
+
MAKEINFO = @MAKEINFO@
MAKEINFO_OPTS = --force -I $(srcdir)
TEXI2DVI = texi2dvi
@@ -35,11 +41,11 @@ DVIPS = dvips
ENVADD = TEXINPUTS="$(srcdir):$(texinfodir):$(TEXINPUTS)" \
MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)"
-mkinfodir = @test -d ${infodir} || mkdir ${infodir} || test -d ${infodir}
+mkinfodir = @${MKDIR_P} ${buildinfodir}
.PHONY: info dvi html pdf ps
-info: ${infodir}/eintr
+info: ${buildinfodir}/eintr$(INFO_EXT)
dvi: emacs-lisp-intro.dvi
html: emacs-lisp-intro.html
@@ -48,21 +54,22 @@ ps: emacs-lisp-intro.ps
# The file name eintr must fit within 5 characters, to allow for
# -NN extensions to fit into DOS 8+3 limits without clashing.
-${infodir}/eintr: ${srcdir}/emacs-lisp-intro.texi
+# Note: "<" is not portable in ordinary make rules.
+${buildinfodir}/eintr$(INFO_EXT): ${srcdir}/emacs-lisp-intro.texi
$(mkinfodir)
- $(MAKEINFO) $(MAKEINFO_OPTS) -o $@ $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/emacs-lisp-intro.texi
emacs-lisp-intro.dvi: ${srcdir}/emacs-lisp-intro.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-lisp-intro.texi
emacs-lisp-intro.ps: emacs-lisp-intro.dvi
- $(DVIPS) -o $@ $<
+ $(DVIPS) -o $@ emacs-lisp-intro.dvi
emacs-lisp-intro.pdf: ${srcdir}/emacs-lisp-intro.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-lisp-intro.texi
emacs-lisp-intro.html: ${srcdir}/emacs-lisp-intro.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) --html -o $@ $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) --html -o $@ ${srcdir}/emacs-lisp-intro.texi
.PHONY: mostlyclean clean distclean maintainer-clean infoclean
@@ -78,7 +85,7 @@ clean: mostlyclean
distclean: clean
infoclean:
- -cd $(infodir) && rm -f eintr eintr-[1-9]
+ -cd $(buildinfodir) && rm -f eintr$(INFO_EXT) eintr$(INFO_EXT)-[1-9]
maintainer-clean: distclean infoclean
@@ -91,7 +98,8 @@ dist:
${texinfodir}/texinfo.tex \
${srcdir}/ChangeLog* ${srcdir}/README emacs-lispintro-${version}/
sed -e 's/@sr[c]dir@/./' -e 's/^\(texinfodir *=\).*/\1 ./' \
- -e 's/^\(infodir *=\).*/\1 ./' -e 's/^\(clean:.*\)/\1 infoclean/' \
+ -e 's/^\(buildinfodir *=\).*/\1 ./' \
+ -e 's/^\(clean:.*\)/\1 infoclean/' \
-e "s/@ver[s]ion@/${version}/" \
${srcdir}/Makefile.in > emacs-lispintro-${version}/Makefile
tar -cf emacs-lispintro-${version}.tar emacs-lispintro-${version}
diff --git a/doc/lispintro/README b/doc/lispintro/README
index ba4e727cc8e..d81a6bc2a3a 100644
--- a/doc/lispintro/README
+++ b/doc/lispintro/README
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/doc/lispintro/cons-1.eps b/doc/lispintro/cons-1.eps
index a1fb08463b4..d17082f5ac7 100644
--- a/doc/lispintro/cons-1.eps
+++ b/doc/lispintro/cons-1.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:26:58 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/cons-2.eps b/doc/lispintro/cons-2.eps
index a711b66ca2e..bd227a14c03 100644
--- a/doc/lispintro/cons-2.eps
+++ b/doc/lispintro/cons-2.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:26:39 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/cons-2a.eps b/doc/lispintro/cons-2a.eps
index 5612caa0717..676030d780f 100644
--- a/doc/lispintro/cons-2a.eps
+++ b/doc/lispintro/cons-2a.eps
@@ -4,7 +4,7 @@
%%CreationDate: Tue Mar 14 15:09:30 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/cons-3.eps b/doc/lispintro/cons-3.eps
index a1de449373f..329c751b856 100644
--- a/doc/lispintro/cons-3.eps
+++ b/doc/lispintro/cons-3.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:25:41 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/cons-4.eps b/doc/lispintro/cons-4.eps
index 45882e815a7..fe28852a872 100644
--- a/doc/lispintro/cons-4.eps
+++ b/doc/lispintro/cons-4.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:25:06 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/cons-5.eps b/doc/lispintro/cons-5.eps
index b8bff1da573..214c4059e32 100644
--- a/doc/lispintro/cons-5.eps
+++ b/doc/lispintro/cons-5.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:27:28 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/doclicense.texi b/doc/lispintro/doclicense.texi
index 51342e96d60..cb71f05a175 100644
--- a/doc/lispintro/doclicense.texi
+++ b/doc/lispintro/doclicense.texi
@@ -1,4 +1,3 @@
-@c -*-texinfo-*-
@c The GNU Free Documentation License.
@center Version 1.3, 3 November 2008
@@ -6,7 +5,7 @@
@c hence no sectioning command or @node.
@display
-Copyright @copyright{} 2000, 2001, 2002, 2007, 2008, 2009 Free Software Foundation, Inc.
+Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
@uref{http://fsf.org/}
Everyone is permitted to copy and distribute verbatim copies
@@ -93,16 +92,16 @@ An image format is not Transparent if used for any substantial amount
of text. A copy that is not ``Transparent'' is called ``Opaque''.
Examples of suitable formats for Transparent copies include plain
-@sc{ascii} without markup, Texinfo input format, La@TeX{} input
-format, @acronym{SGML} or @acronym{XML} using a publicly available
-@acronym{DTD}, and standard-conforming simple @acronym{HTML},
-PostScript or @acronym{PDF} designed for human modification. Examples
-of transparent image formats include @acronym{PNG}, @acronym{XCF} and
-@acronym{JPG}. Opaque formats include proprietary formats that can be
-read and edited only by proprietary word processors, @acronym{SGML} or
-@acronym{XML} for which the @acronym{DTD} and/or processing tools are
-not generally available, and the machine-generated @acronym{HTML},
-PostScript or @acronym{PDF} produced by some word processors for
+ASCII without markup, Texinfo input format, La@TeX{} input
+format, SGML or XML using a publicly available
+DTD, and standard-conforming simple HTML,
+PostScript or PDF designed for human modification. Examples
+of transparent image formats include PNG, XCF and
+JPG. Opaque formats include proprietary formats that can be
+read and edited only by proprietary word processors, SGML or
+XML for which the DTD and/or processing tools are
+not generally available, and the machine-generated HTML,
+PostScript or PDF produced by some word processors for
output purposes only.
The ``Title Page'' means, for a printed book, the title page itself,
@@ -482,7 +481,7 @@ license notices just after the title page:
@end smallexample
If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts,
-replace the ``with@dots{}Texts.'' line with this:
+replace the ``with@dots{}Texts.''@: line with this:
@smallexample
@group
@@ -501,8 +500,6 @@ recommend releasing these examples in parallel under your choice of
free software license, such as the GNU General Public License,
to permit their use in free software.
-
@c Local Variables:
@c ispell-local-pdict: "ispell-dict"
@c End:
-
diff --git a/doc/lispintro/drawers.eps b/doc/lispintro/drawers.eps
index 99e3581f38e..2c066fc708a 100644
--- a/doc/lispintro/drawers.eps
+++ b/doc/lispintro/drawers.eps
@@ -9,7 +9,7 @@
%%EndComments
%%BeginProlog
-% Copyright (C) 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 2001-2012 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi
index 23d0d5a8f34..f885d6c15e8 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -228,33 +228,33 @@ people who are not programmers.
@sp 1
Edition @value{edition-number}, @value{update-date}
@sp 1
-Copyright @copyright{} 1990-1995, 1997, 2001-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1990-1995, 1997, 2001-2012 Free Software Foundation, Inc.
@sp 1
@iftex
Published by the:@*
-GNU Press, @hfill @uref{http://www.gnupress.org}@*
-a division of the @hfill General: @email{press@@gnu.org}@*
-Free Software Foundation, Inc. @hfill Orders:@w{ } @email{sales@@gnu.org}@*
-51 Franklin Street, Fifth Floor @hfill Tel: +1 (617) 542-5942@*
-Boston, MA 02110-1301 USA @hfill Fax: +1 (617) 542-2652@*
+GNU Press, @hfill @uref{http://www.fsf.org/campaigns/gnu-press/}@*
+a division of the @hfill email: @email{sales@@fsf.org}@*
+Free Software Foundation, Inc. @hfill Tel: +1 (617) 542-5942@*
+51 Franklin Street, Fifth Floor @hfill Fax: +1 (617) 542-2652@*
+Boston, MA 02110-1301 USA
@end iftex
@ifnottex
Published by the:
@example
-GNU Press, Website: http://www.gnupress.org
-a division of the General: press@@gnu.org
-Free Software Foundation, Inc. Orders: sales@@gnu.org
-51 Franklin Street, Fifth Floor Tel: +1 (617) 542-5942
-Boston, MA 02110-1301 USA Fax: +1 (617) 542-2652
+GNU Press, http://www.fsf.org/campaigns/gnu-press/
+a division of the email: sales@@fsf.org
+Free Software Foundation, Inc. Tel: +1 (617) 542-5942
+51 Franklin Street, Fifth Floor Fax: +1 (617) 542-2652
+Boston, MA 02110-1301 USA
@end example
@end ifnottex
@sp 1
-@c Printed copies are available for $30 each.@*
+@c Printed copies are available from @uref{http://shop.fsf.org/} for $35 each.@*
ISBN 1-882114-43-4
Permission is granted to copy, distribute and/or modify this document
@@ -315,7 +315,7 @@ supports it in developing GNU and promoting software freedom.''
@contents
@ifnottex
-@node Top, Preface, (dir), (dir)
+@node Top
@top An Introduction to Programming in Emacs Lisp
@insertcopying
@@ -334,6 +334,9 @@ every node in every chapter.
@c global@pageno = -11
@c end iftex
+@set COUNT-WORDS count-words-example
+@c Length of variable name chosen so that things still line up when expanded.
+
@menu
* Preface:: What to look for.
* List Processing:: What is Lisp?
@@ -702,8 +705,6 @@ Regular Expression Searches
* fwd-para while:: The forward motion @code{while} loop.
Counting: Repetition and Regexps
-@set COUNT-WORDS count-words-example
-@c Length of variable name chosen so that things still line up when expanded.
* Why Count Words::
* @value{COUNT-WORDS}:: Use a regexp, but find a problem.
@@ -828,8 +829,7 @@ Printing the Whole Graph
@end detailmenu
@end menu
-@node Preface, List Processing, Top, Top
-@comment node-name, next, previous, up
+@node Preface
@unnumbered Preface
Most of the GNU Emacs integrated environment is written in the programming
@@ -857,8 +857,8 @@ editing in the most general sense of the word.)
* Thank You::
@end menu
-@node Why, On Reading this Text, Preface, Preface
@ifnottex
+@node Why
@unnumberedsec Why Study Emacs Lisp?
@end ifnottex
@@ -872,8 +872,7 @@ Emacs Lisp is designed to get you started: to guide you in learning the
fundamentals of programming, and more importantly, to show you how you
can teach yourself to go further.
-@node On Reading this Text, Who You Are, Why, Preface
-@comment node-name, next, previous, up
+@node On Reading this Text
@unnumberedsec On Reading this Text
All through this document, you will see little sample programs you can
@@ -923,8 +922,7 @@ Emacs to help you understand what puzzles you or to find out how to do
something new. This self-reliance is not only a pleasure, but an
advantage.
-@node Who You Are, Lisp History, On Reading this Text, Preface
-@comment node-name, next, previous, up
+@node Who You Are
@unnumberedsec For Whom This is Written
This text is written as an elementary introduction for people who are
@@ -986,7 +984,7 @@ quoted above. And, of course, after you have read this
@cite{Introduction}, you will find the @cite{Reference Manual} useful
when you are writing your own programs.
-@node Lisp History, Note for Novices, Who You Are, Preface
+@node Lisp History
@unnumberedsec Lisp History
@cindex Lisp history
@@ -1003,8 +1001,7 @@ standard in the 1980s. However, Emacs Lisp is much simpler than Common
Lisp. (The standard Emacs distribution contains an optional extensions
file, @file{cl.el}, that adds many Common Lisp features to Emacs Lisp.)
-@node Note for Novices, Thank You, Lisp History, Preface
-@comment node-name, next, previous, up
+@node Note for Novices
@unnumberedsec A Note for Novices
If you don't know GNU Emacs, you can still read this document
@@ -1014,7 +1011,7 @@ Emacs with the on-line tutorial. To use it, type @kbd{C-h t}. (This
means you press and release the @key{CTRL} key and the @kbd{h} at the
same time, and then press and release @kbd{t}.)
-Also, I often refer to one of Emacs' standard commands by listing the
+Also, I often refer to one of Emacs's standard commands by listing the
keys which you press to invoke the command and then giving the name of
the command in parentheses, like this: @kbd{M-C-\}
(@code{indent-region}). What this means is that the
@@ -1051,8 +1048,7 @@ A note on terminology: when I use the word Lisp alone, I often am
referring to the various dialects of Lisp in general, but when I speak
of Emacs Lisp, I am referring to GNU Emacs Lisp in particular.
-@node Thank You, , Note for Novices, Preface
-@comment node-name, next, previous, up
+@node Thank You
@unnumberedsec Thank You
My thanks to all who helped me with this book. My especial thanks to
@@ -1083,6 +1079,14 @@ Robert J. Chassell
\fi
@end tex
+@c Note: this resetting of the page number back to 1 causes TeX to gripe
+@c about already having seen page numbers 1-4 before (in the preface):
+@c pdfTeX warning (ext4): destination with the same identifier (name{1})
+@c has been already used, duplicate ignored
+@c I guess that is harmless (what happens if a later part of the text
+@c makes a link to something in the first 4 pages though?).
+@c Note that eg the Emacs manual has a preface, but does not bother
+@c resetting the page numbers back to 1 after that.
@iftex
@headings off
@evenheading @thispage @| @| @thischapter
@@ -1090,8 +1094,7 @@ Robert J. Chassell
@global@pageno = 1
@end iftex
-@node List Processing, Practicing Evaluation, Preface, Top
-@comment node-name, next, previous, up
+@node List Processing
@chapter List Processing
To the untutored eye, Lisp is a strange programming language. In Lisp
@@ -1120,8 +1123,7 @@ Errors, , Generate an Error Message}.} Lists are the basis of Lisp.
* Error Message Exercises::
@end menu
-@node Lisp Lists, Run a Program, List Processing, List Processing
-@comment node-name, next, previous, up
+@node Lisp Lists
@section Lisp Lists
@cindex Lisp Lists
@@ -1152,8 +1154,8 @@ like flowers in a field with a stone wall around them.
* Typing Lists:: How GNU Emacs helps you type lists.
@end menu
-@node Numbers Lists, Lisp Atoms, Lisp Lists, Lisp Lists
@ifnottex
+@node Numbers Lists
@unnumberedsubsec Numbers, Lists inside of Lists
@end ifnottex
@@ -1181,8 +1183,7 @@ The components of this list are the words @samp{this}, @samp{list},
list is made up of the words @samp{a}, @samp{list}, @samp{inside},
@samp{of}, @samp{it}.
-@node Lisp Atoms, Whitespace in Lists, Numbers Lists, Lisp Lists
-@comment node-name, next, previous, up
+@node Lisp Atoms
@subsection Lisp Atoms
@cindex Lisp Atoms
@@ -1262,8 +1263,7 @@ is used for messages that a computer can print for a human to read.
Strings are a different kind of atom than numbers or symbols and are
used differently.
-@node Whitespace in Lists, Typing Lists, Lisp Atoms, Lisp Lists
-@comment node-name, next, previous, up
+@node Whitespace in Lists
@subsection Whitespace in Lists
@cindex Whitespace in lists
@@ -1303,8 +1303,7 @@ marks, a symbol looks like a word, and a number looks like a number.
(For certain situations, square brackets, dots and a few other special
characters may be used; however, we will go quite far without them.)
-@node Typing Lists, , Whitespace in Lists, Lisp Lists
-@comment node-name, next, previous, up
+@node Typing Lists
@subsection GNU Emacs Helps You Type Lists
@cindex Help typing lists
@cindex Formatting help
@@ -1324,10 +1323,9 @@ jumps the cursor back to the matching opening parenthesis, so you can
see which one it is. This is very useful, since every list you type
in Lisp must have its closing parenthesis match its opening
parenthesis. (@xref{Major Modes, , Major Modes, emacs, The GNU Emacs
-Manual}, for more information about Emacs' modes.)
+Manual}, for more information about Emacs's modes.)
-@node Run a Program, Making Errors, Lisp Lists, List Processing
-@comment node-name, next, previous, up
+@node Run a Program
@section Run a Program
@cindex Run a program
@cindex Program, running one
@@ -1389,8 +1387,7 @@ from the humanly readable expression to the language of the computer.
But before discussing this (@pxref{Variables}), we will discuss what the
Lisp interpreter does when you make an error.
-@node Making Errors, Names & Definitions, Run a Program, List Processing
-@comment node-name, next, previous, up
+@node Making Errors
@section Generate an Error Message
@cindex Generate an error message
@cindex Error message generation
@@ -1417,6 +1414,7 @@ C-e}:
(this is an unquoted list)
@end smallexample
+@ignore
@noindent
What you see depends on which version of Emacs you are running. GNU
Emacs version 22 provides more information than version 20 and before.
@@ -1427,6 +1425,10 @@ earlier, version 20 result.
@noindent
In GNU Emacs version 22, a @file{*Backtrace*} window will open up and
you will see the following in it:
+@end ignore
+
+A @file{*Backtrace*} window will open up and you should see the
+following in it:
@smallexample
@group
@@ -1505,19 +1507,24 @@ evaluating @code{(+ 2 2)}, we can infer that the symbol @code{+} must
have a set of instructions for the computer to obey and those
instructions must be to add the numbers that follow the @code{+}.
-@need 1250
-In GNU Emacs version 20, and in earlier versions, you will see only
-one line of error message; it will appear in the echo area and look
-like this:
+It is possible to prevent Emacs entering the debugger in cases like
+this. We do not explain how to do that here, but we will mention what
+the result looks like, because you may encounter a similar situation
+if there is a bug in some Emacs code that you are using. In such
+cases, you will see only one line of error message; it will appear in
+the echo area and look like this:
@smallexample
Symbol's function definition is void:@: this
@end smallexample
@noindent
+@ignore
(Also, your terminal may beep at you---some do, some don't; and others
-blink. This is just a device to get your attention.) The message goes
-away as soon as you type another key, even just to move the cursor.
+blink. This is just a device to get your attention.)
+@end ignore
+The message goes away as soon as you type a key, even just to
+move the cursor.
We know the meaning of the word @samp{Symbol}. It refers to the first
atom of the list, the word @samp{this}. The word @samp{function}
@@ -1530,8 +1537,7 @@ The error message can be understood: @samp{Symbol's function
definition is void:@: this}. The symbol (that is, the word
@samp{this}) lacks instructions for the computer to carry out.
-@node Names & Definitions, Lisp Interpreter, Making Errors, List Processing
-@comment node-name, next, previous, up
+@node Names & Definitions
@section Symbol Names and Function Definitions
@cindex Symbol names
@@ -1565,8 +1571,7 @@ Thus, all the names for functions that deal with Texinfo start with
@samp{texinfo-} and those for functions that deal with reading mail
start with @samp{rmail-}.
-@node Lisp Interpreter, Evaluation, Names & Definitions, List Processing
-@comment node-name, next, previous, up
+@node Lisp Interpreter
@section The Lisp Interpreter
@cindex Lisp interpreter, what it does
@cindex Interpreter, what it does
@@ -1591,8 +1596,8 @@ yourself or the computer.
* Byte Compiling:: Specially processing code for speed.
@end menu
-@node Complications, Byte Compiling, Lisp Interpreter, Lisp Interpreter
@ifnottex
+@node Complications
@unnumberedsubsec Complications
@end ifnottex
@@ -1623,7 +1628,7 @@ used by the enclosing expression.
Otherwise, the interpreter works left to right, from one expression to
the next.
-@node Byte Compiling, , Complications, Lisp Interpreter
+@node Byte Compiling
@subsection Byte Compiling
@cindex Byte compiling
@@ -1646,8 +1651,7 @@ the topic here. @xref{Byte Compilation, , Byte Compilation, elisp,
The GNU Emacs Lisp Reference Manual}, for a full description of byte
compilation.
-@node Evaluation, Variables, Lisp Interpreter, List Processing
-@comment node-name, next, previous, up
+@node Evaluation
@section Evaluation
@cindex Evaluation
@@ -1663,8 +1667,8 @@ Collegiate Dictionary}.
* Evaluating Inner Lists:: Lists within lists...
@end menu
-@node How the Interpreter Acts, Evaluating Inner Lists, Evaluation, Evaluation
@ifnottex
+@node How the Interpreter Acts
@unnumberedsubsec How the Lisp Interpreter Acts
@end ifnottex
@@ -1690,8 +1694,7 @@ In summary, evaluating a symbolic expression most commonly causes the
Lisp interpreter to return a value and perhaps carry out a side effect;
or else produce an error.
-@node Evaluating Inner Lists, , How the Interpreter Acts, Evaluation
-@comment node-name, next, previous, up
+@node Evaluating Inner Lists
@subsection Evaluating Inner Lists
@cindex Inner list evaluation
@cindex Evaluating inner lists
@@ -1754,8 +1757,7 @@ instructions in the function definition attached to that name. If a
symbol by itself is evaluated, something different happens, as we will
see in the next section.
-@node Variables, Arguments, Evaluation, List Processing
-@comment node-name, next, previous, up
+@node Variables
@section Variables
@cindex Variables
@@ -1794,8 +1796,8 @@ function definition, and vice-verse.
* Void Variable:: The error message for a symbol without a value.
@end menu
-@node fill-column Example, Void Function, Variables, Variables
@ifnottex
+@node fill-column Example
@unnumberedsubsec @code{fill-column}, an Example Variable
@end ifnottex
@@ -1832,8 +1834,7 @@ A symbol can be bound to a value in several ways. @xref{set & setq, ,
Setting the Value of a Variable}, for information about one way to do
this.
-@node Void Function, Void Variable, fill-column Example, Variables
-@comment node-name, next, previous, up
+@node Void Function
@subsection Error Message for a Symbol Without a Function
@cindex Symbol without function error
@cindex Error for symbol without function
@@ -1853,8 +1854,7 @@ Try evaluating this:
@need 1250
@noindent
-In GNU Emacs version 22, you will create a @file{*Backtrace*} buffer
-that says:
+You will create a @file{*Backtrace*} buffer that says:
@smallexample
@group
@@ -1886,8 +1886,7 @@ Symbol's function definition is void:@: fill-column
another key.)
@end ignore
-@node Void Variable, , Void Function, Variables
-@comment node-name, next, previous, up
+@node Void Variable
@subsection Error Message for a Symbol Without a Value
@cindex Symbol without value error
@cindex Error for symbol without value
@@ -1920,7 +1919,7 @@ Debugger entered--Lisp error: (void-variable +)
@end smallexample
@noindent
-(As with the other times we entered the debugger, you can quit by
+(Again, you can quit the debugger by
typing @kbd{q} in the @file{*Backtrace*} buffer.)
This backtrace is different from the very first error message we saw,
@@ -1934,7 +1933,7 @@ interpreter to evaluate the @code{+} and look for the value of the
variable instead of the function definition. We did this by placing the
cursor right after the symbol rather than after the parenthesis of the
enclosing list as we did before. As a consequence, the Lisp interpreter
-evaluated the preceding s-expression, which in this case was the
+evaluated the preceding s-expression, which in this case was
@code{+} by itself.
Since @code{+} does not have a value bound to it, just the function
@@ -1953,8 +1952,7 @@ Symbol's value as variable is void:@: +
The meaning is the same as in GNU Emacs 22.
@end ignore
-@node Arguments, set & setq, Variables, List Processing
-@comment node-name, next, previous, up
+@node Arguments
@section Arguments
@cindex Arguments
@cindex Passing information to functions
@@ -2007,8 +2005,7 @@ have two different function definitions at the same time.)}
* message:: A useful function for sending messages.
@end menu
-@node Data types, Args as Variable or List, Arguments, Arguments
-@comment node-name, next, previous, up
+@node Data types
@subsection Arguments' Data Types
@cindex Data types
@cindex Types of data
@@ -2062,8 +2059,7 @@ and extracts a part. However, @code{substring} is only able to extract
a substring from an argument that is a string, not from another type of
atom such as a number or symbol.
-@node Args as Variable or List, Variable Number of Arguments, Data types, Arguments
-@comment node-name, next, previous, up
+@node Args as Variable or List
@subsection An Argument as the Value of a Variable or List
An argument can be a symbol that returns a value when it is evaluated.
@@ -2104,8 +2100,7 @@ the final string. The function @code{number-to-string} converts the
integer that the addition function returns to a string.
@code{number-to-string} is also known as @code{int-to-string}.)
-@node Variable Number of Arguments, Wrong Type of Argument, Args as Variable or List, Arguments
-@comment node-name, next, previous, up
+@node Variable Number of Arguments
@subsection Variable Number of Arguments
@cindex Variable number of arguments
@cindex Arguments, variable number of
@@ -2149,8 +2144,7 @@ In this set, the functions have three arguments each:
@end group
@end smallexample
-@node Wrong Type of Argument, message, Variable Number of Arguments, Arguments
-@comment node-name, next, previous, up
+@node Wrong Type of Argument
@subsection Using the Wrong Type Object as an Argument
@cindex Wrong type of argument
@cindex Argument, wrong type of
@@ -2174,8 +2168,7 @@ is that @code{+} has tried to add the 2 to the value returned by
could not carry out its addition.
@need 1250
-In GNU Emacs version 22, you will create and enter a
-@file{*Backtrace*} buffer that says:
+You will create and enter a @file{*Backtrace*} buffer that says:
@noindent
@smallexample
@@ -2245,8 +2238,7 @@ This says, in different words, the same as the top line of the
@file{*Backtrace*} buffer.
@end ignore
-@node message, , Wrong Type of Argument, Arguments
-@comment node-name, next, previous, up
+@node message
@subsection The @code{message} Function
@findex message
@@ -2358,8 +2350,7 @@ When your fill column is 70 and you evaluate the expression, the
message @code{"He saw 38 red foxes leaping."} appears in your echo
area.
-@node set & setq, Summary, Arguments, List Processing
-@comment node-name, next, previous, up
+@node set & setq
@section Setting the Value of a Variable
@cindex Variable, setting value
@cindex Setting value of variable
@@ -2379,8 +2370,7 @@ work but also illustrate how arguments are passed.
* Counting:: Using @code{setq} to count.
@end menu
-@node Using set, Using setq, set & setq, set & setq
-@comment node-name, next, previous, up
+@node Using set
@subsection Using @code{set}
@findex set
@@ -2436,8 +2426,7 @@ a value after it was evaluated, the @code{set} would attempt to set
the value that was returned. There are situations where this is the
right thing for the function to do; but such situations are rare.)
-@node Using setq, Counting, Using set, set & setq
-@comment node-name, next, previous, up
+@node Using setq
@subsection Using @code{setq}
@findex setq
@@ -2497,8 +2486,7 @@ part of its name. The name is chosen because the symbol has a value,
specifically a list, attached to it; or, expressed another way,
the symbol is set to ``point'' to the list.
-@node Counting, , Using setq, set & setq
-@comment node-name, next, previous, up
+@node Counting
@subsection Counting
@cindex Counting
@@ -2544,8 +2532,7 @@ is then returned as the value of the inner list and passed to the
@code{setq} which sets the variable @code{counter} to this new value.
Thus, the value of the variable, @code{counter}, is changed.
-@node Summary, Error Message Exercises, set & setq, List Processing
-@comment node-name, next, previous, up
+@node Summary
@section Summary
Learning Lisp is like climbing a hill in which the first part is the
@@ -2607,8 +2594,7 @@ an error); in addition, it may also carry out some action called a
create a side effect.
@end itemize
-@node Error Message Exercises, , Summary, List Processing
-@comment node-name, next, previous, up
+@node Error Message Exercises
@section Exercises
A few simple exercises:
@@ -2630,8 +2616,7 @@ Write an expression that prints a message in the echo area when
evaluated.
@end itemize
-@node Practicing Evaluation, Writing Defuns, List Processing, Top
-@comment node-name, next, previous, up
+@node Practicing Evaluation
@chapter Practicing Evaluation
@cindex Practicing evaluation
@cindex Evaluation practice
@@ -2656,8 +2641,8 @@ buffer-related functions, to see how they were written.
* Evaluation Exercise::
@end menu
-@node How to Evaluate, Buffer Names, Practicing Evaluation, Practicing Evaluation
@ifnottex
+@node How to Evaluate
@unnumberedsec How to Evaluate
@end ifnottex
@@ -2688,8 +2673,7 @@ next few sections are important in their own right. A study of these
functions makes clear the distinction between buffers and files, how to
switch to a buffer, and how to determine a location within it.
-@node Buffer Names, Getting Buffers, How to Evaluate, Practicing Evaluation
-@comment node-name, next, previous, up
+@node Buffer Names
@section Buffer Names
@findex buffer-name
@findex buffer-file-name
@@ -2814,8 +2798,7 @@ you to change the contents of the buffer. But you can do this in any
buffer you can edit; and when you write code or documentation (such as
this book), this feature is very useful.
-@node Getting Buffers, Switching Buffers, Buffer Names, Practicing Evaluation
-@comment node-name, next, previous, up
+@node Getting Buffers
@section Getting Buffers
@findex current-buffer
@findex other-buffer
@@ -2883,8 +2866,7 @@ just switched is visible to you in another window, @code{other-buffer}
will choose the most recent buffer that you cannot see; this is a
subtlety that I often forget.}.
-@node Switching Buffers, Buffer Size & Locations, Getting Buffers, Practicing Evaluation
-@comment node-name, next, previous, up
+@node Switching Buffers
@section Switching Buffers
@findex switch-to-buffer
@findex set-buffer
@@ -2903,7 +2885,7 @@ rather, to save typing, you probably only typed @kbd{RET} if the
default buffer was @file{*scratch*}, or if it was different, then you
typed just part of the name, such as @code{*sc}, pressed your
@kbd{TAB} key to cause it to expand to the full name, and then typed
-your @kbd{RET} key.} when prompted in the minibuffer for the name of
+@kbd{RET}.} when prompted in the minibuffer for the name of
the buffer to which you wanted to switch. The keystrokes, @kbd{C-x
b}, cause the Lisp interpreter to evaluate the interactive function
@code{switch-to-buffer}. As we said before, this is how Emacs works:
@@ -2913,10 +2895,7 @@ different keystrokes call or run different functions. For example,
By writing @code{switch-to-buffer} in an expression, and giving it a
buffer to switch to, we can switch buffers just the way @kbd{C-x b}
-does.
-
-@need 1000
-Here is the Lisp expression:
+does:
@smallexample
(switch-to-buffer (other-buffer))
@@ -2961,7 +2940,7 @@ have eyes. When a computer program works on a buffer, that buffer does
not need to be visible on the screen.
@code{switch-to-buffer} is designed for humans and does two different
-things: it switches the buffer to which Emacs' attention is directed; and
+things: it switches the buffer to which Emacs's attention is directed; and
it switches the buffer displayed in the window to the new buffer.
@code{set-buffer}, on the other hand, does only one thing: it switches
the attention of the computer program to a different buffer. The buffer
@@ -2976,8 +2955,7 @@ the function as an entity that can do something for you if you `call'
it---just as a plumber is an entity who can fix a leak if you call him
or her.
-@node Buffer Size & Locations, Evaluation Exercise, Switching Buffers, Practicing Evaluation
-@comment node-name, next, previous, up
+@node Buffer Size & Locations
@section Buffer Size and the Location of Point
@cindex Size of buffer
@cindex Buffer size
@@ -3044,14 +3022,13 @@ or a program, to operations on just a part of a buffer.
function @code{point-max} returns the value of the maximum permissible
value of point in the current buffer.
-@node Evaluation Exercise, , Buffer Size & Locations, Practicing Evaluation
+@node Evaluation Exercise
@section Exercise
Find a file with which you are working and move towards its middle.
Find its buffer name, file name, length, and your position in the file.
-@node Writing Defuns, Buffer Walk Through, Practicing Evaluation, Top
-@comment node-name, next, previous, up
+@node Writing Defuns
@chapter How To Write Function Definitions
@cindex Definition writing
@cindex Function definition writing
@@ -3081,8 +3058,8 @@ symbol refers to it.)
* defun Exercises::
@end menu
-@node Primitive Functions, defun, Writing Defuns, Writing Defuns
@ifnottex
+@node Primitive Functions
@unnumberedsec An Aside about Primitive Functions
@end ifnottex
@cindex Primitive functions
@@ -3107,8 +3084,7 @@ mention the distinction only because it is interesting to know. Indeed,
unless you investigate, you won't know whether an already-written
function is written in Emacs Lisp or C.
-@node defun, Install, Primitive Functions, Writing Defuns
-@comment node-name, next, previous, up
+@node defun
@section The @code{defun} Special Form
@findex defun
@cindex Special form of @code{defun}
@@ -3280,8 +3256,7 @@ Installing a function is the process that tells the Lisp interpreter the
definition of the function. Installation is described in the next
section.
-@node Install, Interactive, defun, Writing Defuns
-@comment node-name, next, previous, up
+@node Install
@section Install a Function Definition
@cindex Install a Function Definition
@cindex Definition installation
@@ -3318,8 +3293,8 @@ Emacs. To reload code automatically whenever you start Emacs, see
* Change a defun:: How to change a function definition.
@end menu
-@node Effect of installation, Change a defun, Install, Install
@ifnottex
+@node Effect of installation
@unnumberedsubsec The effect of installation
@end ifnottex
@@ -3349,8 +3324,7 @@ Multiply NUMBER by seven.
@noindent
(To return to a single window on your screen, type @kbd{C-x 1}.)
-@node Change a defun, , Effect of installation, Install
-@comment node-name, next, previous, up
+@node Change a defun
@subsection Change a Function Definition
@cindex Changing a function definition
@cindex Function definition, how to change
@@ -3395,8 +3369,7 @@ In summary, this is how you write code in Emacs Lisp: you write a
function; install it; test it; and then make fixes or enhancements and
install it again.
-@node Interactive, Interactive Options, Install, Writing Defuns
-@comment node-name, next, previous, up
+@node Interactive
@section Make a Function Interactive
@cindex Interactive functions
@findex interactive
@@ -3420,8 +3393,8 @@ each time you typed a key, it would be very distracting.
* multiply-by-seven in detail:: The interactive version.
@end menu
-@node Interactive multiply-by-seven, multiply-by-seven in detail, Interactive, Interactive
@ifnottex
+@node Interactive multiply-by-seven
@unnumberedsubsec An Interactive @code{multiply-by-seven}, An Overview
@end ifnottex
@@ -3476,8 +3449,7 @@ A prefix argument is passed to an interactive function by typing the
typing @kbd{C-u} and then a number, for example, @kbd{C-u 3 M-e} (if you
type @kbd{C-u} without a number, it defaults to 4).
-@node multiply-by-seven in detail, , Interactive multiply-by-seven, Interactive
-@comment node-name, next, previous, up
+@node multiply-by-seven in detail
@subsection An Interactive @code{multiply-by-seven}
Let's look at the use of the special form @code{interactive} and then at
@@ -3546,8 +3518,7 @@ expression whose first element is @code{message}; but when embedded in a
function, @code{message} prints the text as a side effect without
quotes.)
-@node Interactive Options, Permanent Installation, Interactive, Writing Defuns
-@comment node-name, next, previous, up
+@node Interactive Options
@section Different Options for @code{interactive}
@cindex Options for @code{interactive}
@cindex Interactive options
@@ -3625,8 +3596,7 @@ for an example. @xref{Using Interactive, , Using @code{Interactive},
elisp, The GNU Emacs Lisp Reference Manual}, for a more complete
explanation about this technique.
-@node Permanent Installation, let, Interactive Options, Writing Defuns
-@comment node-name, next, previous, up
+@node Permanent Installation
@section Install Code Permanently
@cindex Install code permanently
@cindex Permanent code installation
@@ -3674,8 +3644,7 @@ the Free Software Foundation, and properly protect yourself and
others, it may be included in the next release of Emacs. In large
part, this is how Emacs has grown over the past years, by donations.
-@node let, if, Permanent Installation, Writing Defuns
-@comment node-name, next, previous, up
+@node let
@section @code{let}
@findex let
@@ -3707,8 +3676,8 @@ and the two are not intended to refer to the same value. The
* Uninitialized let Variables::
@end menu
-@node Prevent confusion, Parts of let Expression, let, let
@ifnottex
+@node Prevent confusion
@unnumberedsubsec @code{let} Prevents Confusion
@end ifnottex
@@ -3746,8 +3715,7 @@ meaning `to give practical effect to' (@cite{Oxford English
Dictionary}). Since you evaluate an expression to perform an action,
`execute' has evolved as a synonym to `evaluate'.)
-@node Parts of let Expression, Sample let Expression, Prevent confusion, let
-@comment node-name, next, previous, up
+@node Parts of let Expression
@subsection The Parts of a @code{let} Expression
@cindex @code{let} expression, parts of
@cindex Parts of @code{let} expression
@@ -3795,8 +3763,7 @@ the template for the @code{let} expression looks like this:
@end group
@end smallexample
-@node Sample let Expression, Uninitialized let Variables, Parts of let Expression, let
-@comment node-name, next, previous, up
+@node Sample let Expression
@subsection Sample @code{let} Expression
@cindex Sample @code{let} expression
@cindex @code{let} expression sample
@@ -3846,8 +3813,7 @@ argument, except for @samp{%s}. In this example, the value of the variable
value of the variable @code{tiger} is printed at the location of the
second @samp{%s}.
-@node Uninitialized let Variables, , Sample let Expression, let
-@comment node-name, next, previous, up
+@node Uninitialized let Variables
@subsection Uninitialized Variables in a @code{let} Statement
@cindex Uninitialized @code{let} variables
@cindex @code{let} variables uninitialized
@@ -3895,8 +3861,7 @@ number is printed in the message using a @samp{%d} rather than a
@samp{%s}.) The four variables as a group are put into a list to
delimit them from the body of the @code{let}.
-@node if, else, let, Writing Defuns
-@comment node-name, next, previous, up
+@node if
@section The @code{if} Special Form
@findex if
@cindex Conditional with @code{if}
@@ -3918,8 +3883,8 @@ such as, ``if it is warm and sunny, then go to the beach!''
* type-of-animal in detail:: An example of an @code{if} expression.
@end menu
-@node if in more detail, type-of-animal in detail, if, if
@ifnottex
+@node if in more detail
@unnumberedsubsec @code{if} in more detail
@end ifnottex
@@ -4009,8 +3974,7 @@ following message printed in the echo area: @code{"It's a tiger!"}; and
when you evaluate @code{(type-of-animal 'zebra)} you will see @code{nil}
printed in the echo area.
-@node type-of-animal in detail, , if in more detail, if
-@comment node-name, next, previous, up
+@node type-of-animal in detail
@subsection The @code{type-of-animal} Function in Detail
Let's look at the @code{type-of-animal} function in detail.
@@ -4097,8 +4061,7 @@ argument @code{zebra} is passed to @code{type-of-animal}. @code{zebra}
is not equal to @code{fierce}, so the then-part is not evaluated and
@code{nil} is returned by the @code{if} expression.
-@node else, Truth & Falsehood, if, Writing Defuns
-@comment node-name, next, previous, up
+@node else
@section If--then--else Expressions
@cindex Else
@@ -4186,8 +4149,7 @@ misleading! When you write code, you need to take into account the
possibility that some such argument will be tested by the @code{if}
and write your program accordingly.)
-@node Truth & Falsehood, save-excursion, else, Writing Defuns
-@comment node-name, next, previous, up
+@node Truth & Falsehood
@section Truth and Falsehood in Emacs Lisp
@cindex Truth and falsehood in Emacs Lisp
@cindex Falsehood and truth in Emacs Lisp
@@ -4210,8 +4172,8 @@ long as it is not empty), or even a buffer!
* nil explained:: @code{nil} has two meanings.
@end menu
-@node nil explained, , Truth & Falsehood, Truth & Falsehood
@ifnottex
+@node nil explained
@unnumberedsubsec An explanation of @code{nil}
@end ifnottex
@@ -4274,8 +4236,7 @@ On the other hand, this function returns @code{nil} if the test is false.
(> 4 5)
@end smallexample
-@node save-excursion, Review, Truth & Falsehood, Writing Defuns
-@comment node-name, next, previous, up
+@node save-excursion
@section @code{save-excursion}
@findex save-excursion
@cindex Region, what it is
@@ -4299,8 +4260,8 @@ unexpected movement of point or mark.
* Template for save-excursion::
@end menu
-@node Point and mark, Template for save-excursion, save-excursion, save-excursion
@ifnottex
+@node Point and mark
@unnumberedsubsec Point and Mark
@end ifnottex
@@ -4357,8 +4318,7 @@ have @code{save-excursion} switch you back to the original buffer.
This is how @code{save-excursion} is used in @code{append-to-buffer}.
(@xref{append-to-buffer, , The Definition of @code{append-to-buffer}}.)
-@node Template for save-excursion, , Point and mark, save-excursion
-@comment node-name, next, previous, up
+@node Template for save-excursion
@subsection Template for a @code{save-excursion} Expression
@need 800
@@ -4409,8 +4369,7 @@ within the body of a @code{let} expression. It looks like this:
@end group
@end smallexample
-@node Review, defun Exercises, save-excursion, Writing Defuns
-@comment node-name, next, previous, up
+@node Review
@section Review
In the last few chapters we have introduced a fair number of functions
@@ -4641,7 +4600,7 @@ Select a buffer for Emacs to be active in and display it in the current
window so users can look at it. Usually bound to @kbd{C-x b}.
@item set-buffer
-Switch Emacs' attention to a buffer on which programs will run. Don't
+Switch Emacs's attention to a buffer on which programs will run. Don't
alter what the window is showing.
@item buffer-size
@@ -4663,7 +4622,7 @@ effect.
@end table
@need 1500
-@node defun Exercises, , Review, Writing Defuns
+@node defun Exercises
@section Exercises
@itemize @bullet
@@ -4677,8 +4636,7 @@ Write a function that tests whether the current value of
and if so, prints an appropriate message.
@end itemize
-@node Buffer Walk Through, More Complex, Writing Defuns, Top
-@comment node-name, next, previous, up
+@node Buffer Walk Through
@chapter A Few Buffer--Related Functions
In this chapter we study in detail several of the functions used in GNU
@@ -4700,7 +4658,7 @@ buffers. Later, we will study other functions.
* Buffer Exercises::
@end menu
-@node Finding More, simplified-beginning-of-buffer, Buffer Walk Through, Buffer Walk Through
+@node Finding More
@section Finding More Information
@findex describe-function, @r{introduced}
@@ -4796,8 +4754,7 @@ In @cite{The GNU Emacs Manual}, you will see sentences such as ``The
@kbd{C-h p} command lets you search the standard Emacs Lisp libraries
by topic keywords.''
-@node simplified-beginning-of-buffer, mark-whole-buffer, Finding More, Buffer Walk Through
-@comment node-name, next, previous, up
+@node simplified-beginning-of-buffer
@section A Simplified @code{beginning-of-buffer} Definition
@findex simplified-beginning-of-buffer
@@ -4925,8 +4882,7 @@ the @code{beginning-of-buffer} definition except that the body of the
function contains the expression @code{(goto-char (point-max))} in place
of @code{(goto-char (point-min))}.
-@node mark-whole-buffer, append-to-buffer, simplified-beginning-of-buffer, Buffer Walk Through
-@comment node-name, next, previous, up
+@node mark-whole-buffer
@section The Definition of @code{mark-whole-buffer}
@findex mark-whole-buffer
@@ -4945,8 +4901,8 @@ h}.
* Body of mark-whole-buffer:: Only three lines of code.
@end menu
-@node mark-whole-buffer overview, Body of mark-whole-buffer, mark-whole-buffer, mark-whole-buffer
@ifnottex
+@node mark-whole-buffer overview
@unnumberedsubsec An overview of @code{mark-whole-buffer}
@end ifnottex
@@ -4992,8 +4948,7 @@ to the @code{simplified-beginning-of-buffer} function described in the
previous section.
@need 1250
-@node Body of mark-whole-buffer, , mark-whole-buffer overview, mark-whole-buffer
-@comment node-name, next, previous, up
+@node Body of mark-whole-buffer
@subsection Body of @code{mark-whole-buffer}
The body of the @code{mark-whole-buffer} function consists of three
@@ -5066,8 +5021,7 @@ result of this, point is placed at the beginning of the buffer and mark
is set at the end of the buffer. The whole buffer is, therefore, the
region.
-@node append-to-buffer, Buffer Related Review, mark-whole-buffer, Buffer Walk Through
-@comment node-name, next, previous, up
+@node append-to-buffer
@section The Definition of @code{append-to-buffer}
@findex append-to-buffer
@@ -5083,8 +5037,8 @@ current buffer to a specified buffer.
* append save-excursion:: How the @code{save-excursion} works.
@end menu
-@node append-to-buffer overview, append interactive, append-to-buffer, append-to-buffer
@ifnottex
+@node append-to-buffer overview
@unnumberedsubsec An Overview of @code{append-to-buffer}
@end ifnottex
@@ -5164,8 +5118,7 @@ described in the same order as in the argument list.
Note that the documentation distinguishes between a buffer and its
name. (The function can handle either.)
-@node append interactive, append-to-buffer body, append-to-buffer overview, append-to-buffer
-@comment node-name, next, previous, up
+@node append interactive
@subsection The @code{append-to-buffer} Interactive Expression
Since the @code{append-to-buffer} function will be used interactively,
@@ -5233,8 +5186,7 @@ two arguments that follow the symbol @code{buffer} in the function's
argument list (that is, @code{start} and @code{end}) to the values of
point and mark. That argument worked fine.)
-@node append-to-buffer body, append save-excursion, append interactive, append-to-buffer
-@comment node-name, next, previous, up
+@node append-to-buffer body
@subsection The Body of @code{append-to-buffer}
@ignore
@@ -5333,8 +5285,7 @@ not realize that the first parenthesis before @code{oldbuf} marks the
boundary of the varlist and the second parenthesis marks the beginning
of the two-element list, @code{(oldbuf (current-buffer))}.
-@node append save-excursion, , append-to-buffer body, append-to-buffer
-@comment node-name, next, previous, up
+@node append save-excursion
@subsection @code{save-excursion} in @code{append-to-buffer}
The body of the @code{let} expression in @code{append-to-buffer}
@@ -5500,7 +5451,7 @@ Written in skeletal form, the workings of the body look like this:
In summary, @code{append-to-buffer} works as follows: it saves the
value of the current buffer in the variable called @code{oldbuf}. It
-gets the new buffer (creating one if need be) and switches Emacs'
+gets the new buffer (creating one if need be) and switches Emacs's
attention to it. Using the value of @code{oldbuf}, it inserts the
region of text from the old buffer into the new buffer; and then using
@code{save-excursion}, it brings you back to your original buffer.
@@ -5511,8 +5462,7 @@ complex function. It shows how to use @code{let} and
buffer. Many function definitions use @code{let},
@code{save-excursion}, and @code{set-buffer} this way.
-@node Buffer Related Review, Buffer Exercises, append-to-buffer, Buffer Walk Through
-@comment node-name, next, previous, up
+@node Buffer Related Review
@section Review
Here is a brief summary of the various functions discussed in this chapter.
@@ -5564,7 +5514,7 @@ buffer does not exist.
@end table
@need 1500
-@node Buffer Exercises, , Buffer Related Review, Buffer Walk Through
+@node Buffer Exercises
@section Exercises
@itemize @bullet
@@ -5581,8 +5531,7 @@ Using @code{find-tag}, find the source for the @code{copy-to-buffer}
function.
@end itemize
-@node More Complex, Narrowing & Widening, Buffer Walk Through, Top
-@comment node-name, next, previous, up
+@node More Complex
@chapter A Few More Complex Functions
In this chapter, we build on what we have learned in previous chapters
@@ -5602,8 +5551,7 @@ to which the name refers.
* optional Exercise::
@end menu
-@node copy-to-buffer, insert-buffer, More Complex, More Complex
-@comment node-name, next, previous, up
+@node copy-to-buffer
@section The Definition of @code{copy-to-buffer}
@findex copy-to-buffer
@@ -5681,8 +5629,7 @@ In outline, the body of @code{copy-to-buffer} looks like this:
@end group
@end smallexample
-@node insert-buffer, beginning-of-buffer, copy-to-buffer, More Complex
-@comment node-name, next, previous, up
+@node insert-buffer
@section The Definition of @code{insert-buffer}
@findex insert-buffer
@@ -5711,8 +5658,8 @@ between the name of an object and the object actually referred to.
* New insert-buffer::
@end menu
-@node insert-buffer code, insert-buffer interactive, insert-buffer, insert-buffer
@ifnottex
+@node insert-buffer code
@unnumberedsubsec The Code for @code{insert-buffer}
@end ifnottex
@@ -5756,8 +5703,7 @@ outline of the function:
@end group
@end smallexample
-@node insert-buffer interactive, insert-buffer body, insert-buffer code, insert-buffer
-@comment node-name, next, previous, up
+@node insert-buffer interactive
@subsection The Interactive Expression in @code{insert-buffer}
@findex interactive, @r{example use of}
@@ -5770,8 +5716,7 @@ buffer:@: }.
* b for interactive:: An existing buffer or else its name.
@end menu
-@node Read-only buffer, b for interactive, insert-buffer interactive, insert-buffer interactive
-@comment node-name, next, previous, up
+@node Read-only buffer
@unnumberedsubsubsec A Read-only Buffer
@cindex Read-only buffer
@cindex Asterisk for read-only buffer
@@ -5785,8 +5730,7 @@ may beep or blink at you; you will not be permitted to insert anything
into current buffer. The asterisk does not need to be followed by a
newline to separate it from the next argument.
-@node b for interactive, , Read-only buffer, insert-buffer interactive
-@comment node-name, next, previous, up
+@node b for interactive
@unnumberedsubsubsec @samp{b} in an Interactive Expression
The next argument in the interactive expression starts with a lower
@@ -5806,8 +5750,7 @@ It uses the @code{barf-if-buffer-read-only} and @code{read-buffer}
functions with which we are already familiar and the @code{progn}
special form with which we are not. (It will be described later.)
-@node insert-buffer body, if & or, insert-buffer interactive, insert-buffer
-@comment node-name, next, previous, up
+@node insert-buffer body
@subsection The Body of the @code{insert-buffer} Function
The body of the @code{insert-buffer} function has two major parts: an
@@ -5842,8 +5785,7 @@ is first necessary to understand the @code{or} function.
Before doing this, let me rewrite this part of the function using
@code{if} so that you can see what is done in a manner that will be familiar.
-@node if & or, Insert or, insert-buffer body, insert-buffer
-@comment node-name, next, previous, up
+@node if & or
@subsection @code{insert-buffer} With an @code{if} Instead of an @code{or}
The job to be done is to make sure the value of @code{buffer} is a
@@ -5923,8 +5865,7 @@ buffer itself, given its name. The @code{setq} then sets the variable
@code{buffer} to the value of the buffer itself, replacing its previous
value (which was the name of the buffer).
-@node Insert or, Insert let, if & or, insert-buffer
-@comment node-name, next, previous, up
+@node Insert or
@subsection The @code{or} in the Body
The purpose of the @code{or} expression in the @code{insert-buffer}
@@ -5982,8 +5923,7 @@ written like this:
(or (holding-on-to-guest) (find-and-take-arm-of-guest))
@end smallexample
-@node Insert let, New insert-buffer, Insert or, insert-buffer
-@comment node-name, next, previous, up
+@node Insert let
@subsection The @code{let} Expression in @code{insert-buffer}
After ensuring that the variable @code{buffer} refers to a buffer itself
@@ -6008,7 +5948,7 @@ expression in detail. The expression looks like this:
@end smallexample
@noindent
-The expression @code{(set-buffer buffer)} changes Emacs' attention
+The expression @code{(set-buffer buffer)} changes Emacs's attention
from the current buffer to the one from which the text will copied.
In that buffer, the variables @code{start} and @code{end} are set to
the beginning and end of the buffer, using the commands
@@ -6081,8 +6021,7 @@ function uses @code{let}, @code{save-excursion}, and
use @code{or}. All these functions are building blocks that we will
find and use again and again.
-@node New insert-buffer, , Insert let, insert-buffer
-@comment node-name, next, previous, up
+@node New insert-buffer
@subsection New Body for @code{insert-buffer}
@findex insert-buffer, new version body
@findex new version body for insert-buffer
@@ -6120,8 +6059,7 @@ its last command. Put another way, the @code{insert-buffer} function
exists only to produce a side effect, inserting another buffer, not to
return any value.
-@node beginning-of-buffer, Second Buffer Related Review, insert-buffer, More Complex
-@comment node-name, next, previous, up
+@node beginning-of-buffer
@section Complete Definition of @code{beginning-of-buffer}
@findex beginning-of-buffer
@@ -6153,7 +6091,7 @@ argument. The use of the argument is optional.
* beginning-of-buffer complete::
@end menu
-@node Optional Arguments, beginning-of-buffer opt arg, beginning-of-buffer, beginning-of-buffer
+@node Optional Arguments
@subsection Optional Arguments
Unless told otherwise, Lisp expects that a function with an argument in
@@ -6236,7 +6174,7 @@ simply @code{point-min}, and when this is the outcome, the whole
is how we saw the @code{beginning-of-buffer} function in its
simplified form.
-@node beginning-of-buffer opt arg, beginning-of-buffer complete, Optional Arguments, beginning-of-buffer
+@node beginning-of-buffer opt arg
@subsection @code{beginning-of-buffer} with an Argument
When @code{beginning-of-buffer} is called with an argument, an
@@ -6264,8 +6202,8 @@ like this:
* Small buffer case::
@end menu
-@node Disentangle beginning-of-buffer, Large buffer case, beginning-of-buffer opt arg, beginning-of-buffer opt arg
@ifnottex
+@node Disentangle beginning-of-buffer
@unnumberedsubsubsec Disentangle @code{beginning-of-buffer}
@end ifnottex
@@ -6294,8 +6232,7 @@ that are far, far larger than ever before.
There are two cases: if the buffer is large and if it is not.
-@node Large buffer case, Small buffer case, Disentangle beginning-of-buffer, beginning-of-buffer opt arg
-@comment node-name, next, previous, up
+@node Large buffer case
@unnumberedsubsubsec What happens in a large buffer
In @code{beginning-of-buffer}, the inner @code{if} expression tests
@@ -6378,8 +6315,7 @@ is large, the @code{goto-char} expression reads like this:
This puts the cursor where we want it.
-@node Small buffer case, , Large buffer case, beginning-of-buffer opt arg
-@comment node-name, next, previous, up
+@node Small buffer case
@unnumberedsubsubsec What happens in a small buffer
If the buffer contains fewer than 10,000 characters, a slightly
@@ -6436,8 +6372,7 @@ The number that results from all this is passed to @code{goto-char} and
the cursor is moved to that point.
@need 1500
-@node beginning-of-buffer complete, , beginning-of-buffer opt arg, beginning-of-buffer
-@comment node-name, next, previous, up
+@node beginning-of-buffer complete
@subsection The Complete @code{beginning-of-buffer}
@need 1000
@@ -6565,8 +6500,7 @@ beginning of the second line @dots{} I don't know whether this is
intended or whether no one has dealt with the code to avoid this
happening.
-@node Second Buffer Related Review, optional Exercise, beginning-of-buffer, More Complex
-@comment node-name, next, previous, up
+@node Second Buffer Related Review
@section Review
Here is a brief summary of some of the topics covered in this chapter.
@@ -6609,7 +6543,7 @@ Delete the entire contents of the current buffer.
Return @code{t} if its argument is a buffer; otherwise return @code{nil}.
@end table
-@node optional Exercise, , Second Buffer Related Review, More Complex
+@node optional Exercise
@section @code{optional} Argument Exercise
Write an interactive function with an optional argument that tests
@@ -6618,8 +6552,7 @@ less than the value of @code{fill-column}, and tells you which, in a
message. However, if you do not pass an argument to the function, use
56 as a default value.
-@node Narrowing & Widening, car cdr & cons, More Complex, Top
-@comment node-name, next, previous, up
+@node Narrowing & Widening
@chapter Narrowing and Widening
@cindex Focusing attention (narrowing)
@cindex Narrowing
@@ -6637,8 +6570,8 @@ novices.
* narrow Exercise::
@end menu
-@node Narrowing advantages, save-restriction, Narrowing & Widening, Narrowing & Widening
@ifnottex
+@node Narrowing advantages
@unnumberedsec The Advantages of Narrowing
@end ifnottex
@@ -6667,13 +6600,12 @@ buffer; or conversely, an Emacs Lisp function needs to work on all of a
buffer that has been narrowed. The @code{what-line} function, for
example, removes the narrowing from a buffer, if it has any narrowing
and when it has finished its job, restores the narrowing to what it was.
-On the other hand, the @code{count-lines} function, which is called by
-@code{what-line}, uses narrowing to restrict itself to just that portion
+On the other hand, the @code{count-lines} function
+uses narrowing to restrict itself to just that portion
of the buffer in which it is interested and then restores the previous
situation.
-@node save-restriction, what-line, Narrowing advantages, Narrowing & Widening
-@comment node-name, next, previous, up
+@node save-restriction
@section The @code{save-restriction} Special Form
@findex save-restriction
@@ -6790,8 +6722,7 @@ and the greater of them is not at the start of a line."
(- (buffer-size) (forward-line (buffer-size)))))))
@end ignore
-@node what-line, narrow Exercise, save-restriction, Narrowing & Widening
-@comment node-name, next, previous, up
+@node what-line
@section @code{what-line}
@findex what-line
@cindex Widening, example of
@@ -6924,7 +6855,7 @@ printed in the echo area, the @code{save-excursion} restores point and
mark to their original positions; and @code{save-restriction} restores
the original narrowing, if any.
-@node narrow Exercise, , what-line, Narrowing & Widening
+@node narrow Exercise
@section Exercise with Narrowing
Write a function that will display the first 60 characters of the
@@ -6947,8 +6878,7 @@ Manual}.)
Additionally, do you really need @code{goto-char} or @code{point-min}?
Or can you write the function without them?
-@node car cdr & cons, Cutting & Storing Text, Narrowing & Widening, Top
-@comment node-name, next, previous, up
+@node car cdr & cons
@chapter @code{car}, @code{cdr}, @code{cons}: Fundamental Functions
@findex car, @r{introduced}
@findex cdr, @r{introduced}
@@ -6972,8 +6902,8 @@ namely, @code{setcdr} and @code{nthcdr}. (@xref{copy-region-as-kill}.)
* cons Exercise::
@end menu
-@node Strange Names, car & cdr, car cdr & cons, car cdr & cons
@ifnottex
+@node Strange Names
@unnumberedsec Strange Names
@end ifnottex
@@ -6992,8 +6922,7 @@ functions, the old terms are still in use. In particular, since the
terms are used in the Emacs Lisp source code, we will use them in this
introduction.
-@node car & cdr, cons, Strange Names, car cdr & cons
-@comment node-name, next, previous, up
+@node car & cdr
@section @code{car} and @code{cdr}
The @sc{car} of a list is, quite simply, the first item in the list.
@@ -7115,8 +7044,7 @@ together or construct a list, but not an array. (Arrays are handled
by array-specific functions. @xref{Arrays, , Arrays, elisp, The GNU
Emacs Lisp Reference Manual}.)
-@node cons, nthcdr, car & cdr, car cdr & cons
-@comment node-name, next, previous, up
+@node cons
@section @code{cons}
@findex cons, @r{introduced}
@@ -7153,8 +7081,8 @@ Like @code{car} and @code{cdr}, @code{cons} is non-destructive.
* length:: How to find the length of a list.
@end menu
-@node Build a list, length, cons, cons
@ifnottex
+@node Build a list
@unnumberedsubsec Build a list
@end ifnottex
@@ -7204,8 +7132,7 @@ two element list by putting @code{daisy} in front of @code{buttercup};
and the third example constructs a three element list by putting
@code{violet} in front of @code{daisy} and @code{buttercup}.
-@node length, , Build a list, cons
-@comment node-name, next, previous, up
+@node length
@subsection Find the Length of a List: @code{length}
@findex length
@@ -7286,8 +7213,7 @@ In an earlier version:
about subroutines.
@end ignore
-@node nthcdr, nth, cons, car cdr & cons
-@comment node-name, next, previous, up
+@node nthcdr
@section @code{nthcdr}
@findex nthcdr
@@ -7411,8 +7337,7 @@ and 5:
@end group
@end smallexample
-@node nth, setcar, nthcdr, car cdr & cons
-@comment node-name, next, previous, up
+@node nth
@section @code{nth}
@findex nth
@@ -7464,8 +7389,7 @@ It is worth mentioning that @code{nth}, like @code{nthcdr} and
non-destructive. This is in sharp contrast to the @code{setcar} and
@code{setcdr} functions.
-@node setcar, setcdr, nth, car cdr & cons
-@comment node-name, next, previous, up
+@node setcar
@section @code{setcar}
@findex setcar
@@ -7540,8 +7464,7 @@ So we can see that @code{setcar} did not add a new element to the list
as @code{cons} would have; it replaced @code{antelope} with
@code{hippopotamus}; it @emph{changed} the list.
-@node setcdr, cons Exercise, setcar, car cdr & cons
-@comment node-name, next, previous, up
+@node setcdr
@section @code{setcdr}
@findex setcdr
@@ -7600,7 +7523,7 @@ Indeed, the list is changed from @code{(horse cow sheep goat)} to
@code{(horse cat dog)}. The @sc{cdr} of the list is changed from
@code{(cow sheep goat)} to @code{(cat dog)}.
-@node cons Exercise, , setcdr, car cdr & cons
+@node cons Exercise
@section Exercise
Construct a list of four birds by evaluating several expressions with
@@ -7608,8 +7531,7 @@ Construct a list of four birds by evaluating several expressions with
itself. Replace the first element of the list of four birds with a
fish. Replace the rest of that list with a list of other fish.
-@node Cutting & Storing Text, List Implementation, car cdr & cons, Top
-@comment node-name, next, previous, up
+@node Cutting & Storing Text
@chapter Cutting and Storing Text
@cindex Cutting and storing text
@cindex Storing and cutting text
@@ -7641,8 +7563,8 @@ sources with `clip' and all occurrences of `killed' with `clipped'.)
* search Exercises::
@end menu
-@node Storing Text, zap-to-char, Cutting & Storing Text, Cutting & Storing Text
@ifnottex
+@node Storing Text
@unnumberedsec Storing Text in a List
@end ifnottex
@@ -7708,11 +7630,11 @@ climb the foothills.
A subsequent chapter describes how text that is cut from the buffer is
retrieved. @xref{Yanking, , Yanking Text Back}.
-@node zap-to-char, kill-region, Storing Text, Cutting & Storing Text
-@comment node-name, next, previous, up
+@node zap-to-char
@section @code{zap-to-char}
@findex zap-to-char
+@c FIXME remove obsolete stuff
The @code{zap-to-char} function changed little between GNU Emacs
version 19 and GNU Emacs version 22. However, @code{zap-to-char}
calls another function, @code{kill-region}, which enjoyed a major
@@ -7736,8 +7658,8 @@ But first, let us look at the interactive @code{zap-to-char} function.
* Summing up zap-to-char:: Using @code{point} and @code{search-forward}.
@end menu
-@node Complete zap-to-char, zap-to-char interactive, zap-to-char, zap-to-char
@ifnottex
+@node Complete zap-to-char
@unnumberedsubsec The Complete @code{zap-to-char} Implementation
@end ifnottex
@@ -7797,8 +7719,7 @@ Goes backward if ARG is negative; error if CHAR not found."
The documentation is thorough. You do need to know the jargon meaning
of the word `kill'.
-@node zap-to-char interactive, zap-to-char body, Complete zap-to-char, zap-to-char
-@comment node-name, next, previous, up
+@node zap-to-char interactive
@subsection The @code{interactive} Expression
@need 800
@@ -7833,8 +7754,7 @@ to the kill ring, but does not remove it. The echo area displays a
message saying that the buffer is read-only. Also, the terminal may
beep or blink at you.
-@node zap-to-char body, search-forward, zap-to-char interactive, zap-to-char
-@comment node-name, next, previous, up
+@node zap-to-char body
@subsection The Body of @code{zap-to-char}
The body of the @code{zap-to-char} function contains the code that
@@ -7872,8 +7792,7 @@ It is easier to understand how @code{progn} works after learning about
@code{search-forward}, so we will look at @code{search-forward} and
then at @code{progn}.
-@node search-forward, progn, zap-to-char body, zap-to-char
-@comment node-name, next, previous, up
+@node search-forward
@subsection The @code{search-forward} Function
@findex search-forward
@@ -7948,8 +7867,7 @@ In template form, a @code{search-forward} expression looks like this:
We will look at @code{progn} next.
-@node progn, Summing up zap-to-char, search-forward, zap-to-char
-@comment node-name, next, previous, up
+@node progn
@subsection The @code{progn} Special Form
@findex progn
@@ -7989,8 +7907,7 @@ ever a part of the distributed source.) The value of @code{point} is
returned by the @code{progn} expression and is passed to
@code{kill-region} as @code{kill-region}'s second argument.
-@node Summing up zap-to-char, , progn, zap-to-char
-@comment node-name, next, previous, up
+@node Summing up zap-to-char
@subsection Summing up @code{zap-to-char}
Now that we have seen how @code{search-forward} and @code{progn} work,
@@ -8011,8 +7928,7 @@ sequence as two additional arguments. The @code{progn} expression is
a single argument to @code{kill-region} and returns the one value that
@code{kill-region} needs for its second argument.
-@node kill-region, copy-region-as-kill, zap-to-char, Cutting & Storing Text
-@comment node-name, next, previous, up
+@node kill-region
@section @code{kill-region}
@findex kill-region
@@ -8096,8 +8012,8 @@ contains the code that is called in the event of an error.
* Lisp macro::
@end menu
-@node Complete kill-region, condition-case, kill-region, kill-region
@ifnottex
+@node Complete kill-region
@unnumberedsubsec The Complete @code{kill-region} Definition
@end ifnottex
@@ -8284,8 +8200,7 @@ The text is deleted but saved in the kill ring."
@end smallexample
@end ignore
-@node condition-case, Lisp macro, Complete kill-region, kill-region
-@comment node-name, next, previous, up
+@node condition-case
@subsection @code{condition-case}
@findex condition-case
@@ -8371,8 +8286,7 @@ this is line 8054
Initializing a Variable with @code{defvar} includes line 8350
@end ignore
-@node Lisp macro, , condition-case, kill-region
-@comment node-name, next, previous, up
+@node Lisp macro
@subsection Lisp macro
@cindex Macro, lisp
@cindex Lisp macro
@@ -8443,8 +8357,7 @@ whether the previous command was @code{kill-region}. If it was,
concatenates a copy of the newly clipped text to the just previously
clipped text in the kill ring.
-@node copy-region-as-kill, Digression into C, kill-region, Cutting & Storing Text
-@comment node-name, next, previous, up
+@node copy-region-as-kill
@section @code{copy-region-as-kill}
@findex copy-region-as-kill
@findex nthcdr
@@ -8465,8 +8378,8 @@ the function copies the text into a separate entry in the kill ring.
* copy-region-as-kill body:: The body of @code{copy-region-as-kill}.
@end menu
-@node Complete copy-region-as-kill, copy-region-as-kill body, copy-region-as-kill, copy-region-as-kill
@ifnottex
+@node Complete copy-region-as-kill
@unnumberedsubsec The complete @code{copy-region-as-kill} function definition
@end ifnottex
@@ -8544,8 +8457,7 @@ if Transient Mark mode is turned on.
The body of @code{copy-region-as-kill} merits discussion in detail.
-@node copy-region-as-kill body, , Complete copy-region-as-kill, copy-region-as-kill
-@comment node-name, next, previous, up
+@node copy-region-as-kill body
@subsection The Body of @code{copy-region-as-kill}
The @code{copy-region-as-kill} function works in much the same way as
@@ -8568,8 +8480,8 @@ previous Emacs command.
* kill-new function::
@end menu
-@node last-command & this-command, kill-append function, copy-region-as-kill body, copy-region-as-kill body
@ifnottex
+@node last-command & this-command
@unnumberedsubsubsec @code{last-command} and @code{this-command}
@end ifnottex
@@ -8624,7 +8536,7 @@ expressions are the same.
If the previous command was @code{kill-region}, then the Emacs Lisp
interpreter calls the @code{kill-append} function
-@node kill-append function, kill-new function, last-command & this-command, copy-region-as-kill body
+@node kill-append function
@unnumberedsubsubsec The @code{kill-append} function
@findex kill-append
@@ -8756,7 +8668,7 @@ of the kill ring. The kill ring is a list, each element of which is
saved text. The @code{kill-append} function uses the @code{kill-new}
function which in turn uses the @code{setcar} function.
-@node kill-new function, , kill-append function, copy-region-as-kill body
+@node kill-new function
@unnumberedsubsubsec The @code{kill-new} function
@findex kill-new
@@ -9185,8 +9097,7 @@ delete-and-extract-region is written in C.
see Initializing a Variable with @code{defvar}
@end ignore
-@node Digression into C, defvar, copy-region-as-kill, Cutting & Storing Text
-@comment node-name, next, previous, up
+@node Digression into C
@section Digression into C
@findex delete-and-extract-region
@cindex C, a digression into
@@ -9351,8 +9262,7 @@ From the point of view of the person writing Lisp, Emacs is all very
simple; but hidden underneath is a great deal of complexity to make it
all work.
-@node defvar, cons & search-fwd Review, Digression into C, Cutting & Storing Text
-@comment node-name, next, previous, up
+@node defvar
@section Initializing a Variable with @code{defvar}
@findex defvar
@cindex Initializing a variable
@@ -9401,8 +9311,8 @@ that people customize. It has more features than @code{defvar}.
* defvar and asterisk::
@end menu
-@node See variable current value, defvar and asterisk, defvar, defvar
@ifnottex
+@node See variable current value
@unnumberedsubsec Seeing the Current Value of a Variable
@end ifnottex
@@ -9453,7 +9363,7 @@ like @code{apropos}, print only the first line of documentation.
Succeeding lines should not be indented; otherwise they look odd when
you use @kbd{C-h v} (@code{describe-variable}).
-@node defvar and asterisk, , See variable current value, defvar
+@node defvar and asterisk
@subsection @code{defvar} and an asterisk
@findex defvar @r{for a user customizable variable}
@findex defvar @r{with an asterisk}
@@ -9499,8 +9409,7 @@ readily. Fortunately, you can press @key{TAB} after calling the
The GNU Emacs Manual}.)
@need 1250
-@node cons & search-fwd Review, search Exercises, defvar, Cutting & Storing Text
-@comment node-name, next, previous, up
+@node cons & search-fwd Review
@section Review
Here is a brief summary of some recently introduced functions.
@@ -9649,7 +9558,7 @@ mark from the buffer and throws it away. You cannot get it back.
(This is not an interactive command.)
@need 1500
-@node search Exercises, , cons & search-fwd Review, Cutting & Storing Text
+@node search Exercises
@section Searching Exercises
@itemize @bullet
@@ -9667,8 +9576,7 @@ echo area, if any; if the kill ring does not contain a third element,
print an appropriate message.
@end itemize
-@node List Implementation, Yanking, Cutting & Storing Text, Top
-@comment node-name, next, previous, up
+@node List Implementation
@chapter How Lists are Implemented
@cindex Lists in a computer
@@ -9692,8 +9600,8 @@ pointed to. Hence, a list is kept as a series of electronic addresses.
* List Exercise::
@end menu
-@node Lists diagrammed, Symbols as Chest, List Implementation, List Implementation
@ifnottex
+@node Lists diagrammed
@unnumberedsec Lists diagrammed
@end ifnottex
@@ -10032,7 +9940,7 @@ is the address of the empty list, of @code{nil}.
In summary, when a Lisp variable is set to a value, it is provided with
the address of the list to which the variable refers.
-@node Symbols as Chest, List Exercise, Lists diagrammed, List Implementation
+@node Symbols as Chest
@section Symbols as a Chest of Drawers
@cindex Symbols as a Chest of Drawers
@cindex Chest of Drawers, metaphor for a symbol
@@ -10133,7 +10041,7 @@ Here is a fanciful representation:
@end iftex
@end ifclear
-@node List Exercise, , Symbols as Chest, List Implementation
+@node List Exercise
@section Exercise
Set @code{flowers} to @code{violet} and @code{buttercup}. Cons two
@@ -10141,8 +10049,7 @@ more flowers on to this list and set this new list to
@code{more-flowers}. Set the @sc{car} of @code{flowers} to a fish.
What does the @code{more-flowers} list now contain?
-@node Yanking, Loops & Recursion, List Implementation, Top
-@comment node-name, next, previous, up
+@node Yanking
@chapter Yanking Text Back
@findex yank
@cindex Text retrieval
@@ -10173,8 +10080,7 @@ list is handled as a ring.)
* yank nthcdr Exercises:: The @code{kill-ring-yank-pointer} variable.
@end menu
-@node Kill Ring Overview, kill-ring-yank-pointer, Yanking, Yanking
-@comment node-name, next, previous, up
+@node Kill Ring Overview
@section Kill Ring Overview
@cindex Kill ring overview
@@ -10217,8 +10123,7 @@ is easier to understand.)
To begin to understand how @code{yank} and @code{yank-pop} work, it is
first necessary to look at the @code{kill-ring-yank-pointer} variable.
-@node kill-ring-yank-pointer, yank nthcdr Exercises, Kill Ring Overview, Yanking
-@comment node-name, next, previous, up
+@node kill-ring-yank-pointer
@section The @code{kill-ring-yank-pointer} Variable
@code{kill-ring-yank-pointer} is a variable, just as @code{kill-ring} is
@@ -10357,7 +10262,7 @@ yanking point; just return the Nth kill forward."
@end ignore
@need 1500
-@node yank nthcdr Exercises, , kill-ring-yank-pointer, Yanking
+@node yank nthcdr Exercises
@section Exercises with @code{yank} and @code{nthcdr}
@itemize @bullet
@@ -10374,8 +10279,7 @@ Using @code{nthcdr} and @code{car}, construct a series of expressions
to return the first, second, third, and fourth elements of a list.
@end itemize
-@node Loops & Recursion, Regexp Search, Yanking, Top
-@comment node-name, next, previous, up
+@node Loops & Recursion
@chapter Loops and Recursion
@cindex Loops and recursion
@cindex Recursion and loops
@@ -10411,8 +10315,7 @@ increase the values of @code{max-specpdl-size} and
* Looping exercise::
@end menu
-@node while, dolist dotimes, Loops & Recursion, Loops & Recursion
-@comment node-name, next, previous, up
+@node while
@section @code{while}
@cindex Loops
@findex while
@@ -10450,8 +10353,8 @@ The template for a @code{while} expression looks like this:
* Decrementing Loop:: A loop with a decrementing counter.
@end menu
-@node Looping with while, Loop Example, while, while
@ifnottex
+@node Looping with while
@unnumberedsubsec Looping with @code{while}
@end ifnottex
@@ -10484,8 +10387,7 @@ This makes sense. It is not the mere act of looping that is desired,
but the consequences of what happens when the expressions in the loop
are repeatedly evaluated.
-@node Loop Example, print-elements-of-list, Looping with while, while
-@comment node-name, next, previous, up
+@node Loop Example
@subsection A @code{while} Loop and a List
A common way to control a @code{while} loop is to test whether a list
@@ -10589,7 +10491,7 @@ This test and use of @code{cdr} can be put together in a function that
goes through a list and prints each element of the list on a line of its
own.
-@node print-elements-of-list, Incrementing Loop, Loop Example, while
+@node print-elements-of-list
@subsection An Example: @code{print-elements-of-list}
@findex print-elements-of-list
@@ -10668,8 +10570,7 @@ function is printed. Since the last expression in the function is the
@code{while} loop, and since @code{while} loops always return
@code{nil}, a @code{nil} is printed after the last element of the list.
-@node Incrementing Loop, Incrementing Loop Details, print-elements-of-list, while
-@comment node-name, next, previous, up
+@node Incrementing Loop
@subsection A Loop with an Incrementing Counter
A loop is not useful unless it stops when it ought. Besides
@@ -10679,8 +10580,8 @@ number of repetitions are complete. This means that the loop must
have a counter---an expression that counts how many times the loop
repeats itself.
-@node Incrementing Loop Details, Decrementing Loop, Incrementing Loop, while
@ifnottex
+@node Incrementing Loop Details
@unnumberedsubsec Details of an Incrementing Loop
@end ifnottex
@@ -10718,7 +10619,7 @@ is set to 1.
* Inc Example altogether:: Putting the function definition together.
@end menu
-@node Incrementing Example, Inc Example parts, Incrementing Loop Details, Incrementing Loop Details
+@node Incrementing Example
@unnumberedsubsubsec Example with incrementing counter
Suppose you are playing on the beach and decide to make a triangle of
@@ -10785,7 +10686,7 @@ row has been added to the total of all the preceding rows. In a more
complex loop the repetitive action might not be so simple, but it will
be simpler than doing everything all at once.
-@node Inc Example parts, Inc Example altogether, Incrementing Example, Incrementing Loop Details
+@node Inc Example parts
@unnumberedsubsubsec The parts of the function definition
The preceding analysis gives us the bones of our function definition:
@@ -10879,7 +10780,7 @@ The built-in Emacs Lisp function @code{1+} adds 1 to a number, so the
(setq row-number (1+ row-number))
@end smallexample
-@node Inc Example altogether, , Inc Example parts, Incrementing Loop Details
+@node Inc Example altogether
@unnumberedsubsubsec Putting the function definition together
We have created the parts for the function definition; now we need to
@@ -10989,8 +10890,7 @@ can try it out. Here are two examples:
The sum of the first four numbers is 10 and the sum of the first seven
numbers is 28.
-@node Decrementing Loop, , Incrementing Loop Details, while
-@comment node-name, next, previous, up
+@node Decrementing Loop
@subsection Loop with a Decrementing Counter
Another common way to write a @code{while} loop is to write the test
@@ -11026,7 +10926,7 @@ The template for a decrementing @code{while} loop looks like this:
* Dec Example altogether:: Putting the function definition together.
@end menu
-@node Decrementing Example, Dec Example parts, Decrementing Loop, Decrementing Loop
+@node Decrementing Example
@unnumberedsubsubsec Example with decrementing counter
To illustrate a loop with a decrementing counter, we will rewrite the
@@ -11053,7 +10953,7 @@ rows, the number of pebbles in the last row is 7. Likewise, we know how
many pebbles are in the preceding row: it is one less than the number in
the row.
-@node Dec Example parts, Dec Example altogether, Decrementing Example, Decrementing Loop
+@node Dec Example parts
@unnumberedsubsubsec The parts of the function definition
We start with three variables: the total number of rows in the
@@ -11115,7 +11015,7 @@ the @code{while} loop is simply:
(while (> number-of-pebbles-in-row 0)
@end smallexample
-@node Dec Example altogether, , Dec Example parts, Decrementing Loop
+@node Dec Example altogether
@unnumberedsubsubsec Putting the function definition together
We can put these expressions together to create a function definition
@@ -11186,8 +11086,7 @@ that the test returns false after the loop has repeated itself the right
number of times.
@end enumerate
-@node dolist dotimes, Recursion, while, Loops & Recursion
-@comment node-name, next, previous, up
+@node dolist dotimes
@section Save your time: @code{dolist} and @code{dotimes}
In addition to @code{while}, both @code{dolist} and @code{dotimes}
@@ -11207,8 +11106,8 @@ each shorter version of the list to the first of its arguments.
* dotimes::
@end menu
-@node dolist, dotimes, dolist dotimes, dolist dotimes
-@unnumberedsubsubsec The @code{dolist} Macro
+@node dolist
+@unnumberedsubsec The @code{dolist} Macro
@findex dolist
Suppose, for example, you want to reverse a list, so that
@@ -11311,8 +11210,8 @@ version of the list to @code{element} and then evaluates the body of
the expression; and repeats the loop. The result is returned in
@code{value}.
-@node dotimes, , dolist, dolist dotimes
-@unnumberedsubsubsec The @code{dotimes} Macro
+@node dotimes
+@unnumberedsubsec The @code{dotimes} Macro
@findex dotimes
The @code{dotimes} macro is similar to @code{dolist}, except that it
@@ -11361,8 +11260,7 @@ up the number of pebbles in a triangle.
@end group
@end smallexample
-@node Recursion, Looping exercise, dolist dotimes, Loops & Recursion
-@comment node-name, next, previous, up
+@node Recursion
@section Recursion
@cindex Recursion
@@ -11388,8 +11286,7 @@ arguments that the final instance will stop.
* No deferment solution::
@end menu
-@node Building Robots, Recursive Definition Parts, Recursion, Recursion
-@comment node-name, next, previous, up
+@node Building Robots
@subsection Building Robots: Extending the Metaphor
@cindex Building robots
@cindex Robots, building
@@ -11426,8 +11323,7 @@ does the same job as the first, but with different arguments.
It is important that the arguments differ from one instance to the
next; otherwise, the process will never stop.
-@node Recursive Definition Parts, Recursion with list, Building Robots, Recursion
-@comment node-name, next, previous, up
+@node Recursive Definition Parts
@subsection The Parts of a Recursive Definition
@cindex Parts of a Recursive Definition
@cindex Recursive Definition Parts
@@ -11491,17 +11387,17 @@ false when the function should no longer be repeated.
The do-again-test is sometimes called the @dfn{stop condition},
since it stops the repetitions when it tests false.
-@node Recursion with list, Recursive triangle function, Recursive Definition Parts, Recursion
-@comment node-name, next, previous, up
+@node Recursion with list
@subsection Recursion with a List
The example of a @code{while} loop that printed the elements of a list
of numbers can be written recursively. Here is the code, including
an expression to set the value of the variable @code{animals} to a list.
-If you are using GNU Emacs 20 or before, this example must be copied
-to the @file{*scratch*} buffer and each expression must be evaluated
-there. Use @kbd{C-u C-x C-e} to evaluate the
+If you are reading this in Info in Emacs, you can evaluate this
+expression directly in Info. Otherwise, you must copy the example
+to the @file{*scratch*} buffer and evaluate each expression there.
+Use @kbd{C-u C-x C-e} to evaluate the
@code{(print-elements-recursively animals)} expression so that the
results are printed in the buffer; otherwise the Lisp interpreter will
try to squeeze the results into the one line of the echo area.
@@ -11510,9 +11406,6 @@ Also, place your cursor immediately after the last closing parenthesis
of the @code{print-elements-recursively} function, before the comment.
Otherwise, the Lisp interpreter will try to evaluate the comment.
-If you are using a more recent version of Emacs, you can evaluate this
-expression directly in Info.
-
@findex print-elements-recursively
@smallexample
@group
@@ -11586,8 +11479,7 @@ nil
@end smallexample
@need 2000
-@node Recursive triangle function, Recursion with cond, Recursion with list, Recursion
-@comment node-name, next, previous, up
+@node Recursive triangle function
@subsection Recursion in Place of a Counter
@findex triangle-recursively
@@ -11625,8 +11517,8 @@ its argument.
* Recursive Example arg of 3 or 4::
@end menu
-@node Recursive Example arg of 1 or 2, Recursive Example arg of 3 or 4, Recursive triangle function, Recursive triangle function
@ifnottex
+@node Recursive Example arg of 1 or 2
@unnumberedsubsubsec An argument of 1 or 2
@end ifnottex
@@ -11688,7 +11580,7 @@ returned, which is correct. A triangle with two rows has three
pebbles in it.
@end table
-@node Recursive Example arg of 3 or 4, , Recursive Example arg of 1 or 2, Recursive triangle function
+@node Recursive Example arg of 3 or 4
@unnumberedsubsubsec An argument of 3 or 4
Suppose that @code{triangle-recursively} is called with an argument of
@@ -11778,8 +11670,7 @@ on.
There is a way around this kind of waiting, which we will discuss in
@ref{No Deferment, , Recursion without Deferments}.
-@node Recursion with cond, Recursive Patterns, Recursive triangle function, Recursion
-@comment node-name, next, previous, up
+@node Recursion with cond
@subsection Recursion Example Using @code{cond}
@findex cond
@@ -11855,8 +11746,7 @@ equal to 0, it returns 1 if the number is 1 and it evaluates @code{(+
number (triangle-using-cond (1- number)))} if the number is greater than
1.
-@node Recursive Patterns, No Deferment, Recursion with cond, Recursion
-@comment node-name, next, previous, up
+@node Recursive Patterns
@subsection Recursive Patterns
@cindex Recursive Patterns
@@ -11870,8 +11760,7 @@ and this provides a sense of its primal capabilities.
* Keep::
@end menu
-@node Every, Accumulate, Recursive Patterns, Recursive Patterns
-@comment node-name, next, previous, up
+@node Every
@unnumberedsubsubsec Recursive Pattern: @emph{every}
@cindex Every, type of recursive pattern
@cindex Recursive pattern: every
@@ -11970,8 +11859,7 @@ But when the list has at least one element,
@end itemize
@end itemize
-@node Accumulate, Keep, Every, Recursive Patterns
-@comment node-name, next, previous, up
+@node Accumulate
@unnumberedsubsubsec Recursive Pattern: @emph{accumulate}
@cindex Accumulate, type of recursive pattern
@cindex Recursive pattern: accumulate
@@ -12022,8 +11910,7 @@ Here is an example:
@xref{Files List, , Making a List of Files}, for an example of the
accumulate pattern.
-@node Keep, , Accumulate, Recursive Patterns
-@comment node-name, next, previous, up
+@node Keep
@unnumberedsubsubsec Recursive Pattern: @emph{keep}
@cindex Keep, type of recursive pattern
@cindex Recursive pattern: keep
@@ -12092,7 +11979,7 @@ Here is an example that uses @code{cond}:
It goes without saying that you need not use @code{nil} as the test for
when to stop; and you can, of course, combine these patterns.
-@node No Deferment, No deferment solution, Recursive Patterns, Recursion
+@node No Deferment
@subsection Recursion without Deferments
@cindex Deferment in recursion
@cindex Recursion without Deferments
@@ -12175,7 +12062,7 @@ is being waited on. This is not a problem when there are only a few
steps, as in this example. But it can be a problem when there are
more steps.
-@node No deferment solution, , No Deferment, Recursion
+@node No deferment solution
@subsection No Deferment Solution
@cindex No deferment solution
@cindex Defermentless solution
@@ -12339,7 +12226,7 @@ This kind of pattern helps when you are writing functions that can use
many resources in a computer.
@need 1500
-@node Looping exercise, , Recursion, Loops & Recursion
+@node Looping exercise
@section Looping Exercise
@itemize @bullet
@@ -12386,8 +12273,7 @@ Documentation Format}.
@end iftex
@end itemize
-@node Regexp Search, Counting Words, Loops & Recursion, Top
-@comment node-name, next, previous, up
+@node Regexp Search
@chapter Regular Expression Searches
@cindex Searches, illustrating
@cindex Regular expression searches
@@ -12433,8 +12319,7 @@ introduces several new features.
* re-search Exercises::
@end menu
-@node sentence-end, re-search-forward, Regexp Search, Regexp Search
-@comment node-name, next, previous, up
+@node sentence-end
@section The Regular Expression for @code{sentence-end}
@findex sentence-end
@@ -12585,8 +12470,7 @@ return between square brackets but here it is shown as @key{RET}.
@end table
@end ignore
-@node re-search-forward, forward-sentence, sentence-end, Regexp Search
-@comment node-name, next, previous, up
+@node re-search-forward
@section The @code{re-search-forward} Function
@findex re-search-forward
@@ -12607,7 +12491,7 @@ four arguments:
@enumerate
@item
The first argument is the regular expression that the function searches
-for. The regular expression will be a string between quotations marks.
+for. The regular expression will be a string between quotation marks.
@item
The optional second argument limits how far the function will search; it is a
@@ -12660,8 +12544,7 @@ sentence cannot go beyond a paragraph). If the search fails, the
function will return @code{nil}; and the repeat count will be provided
by the argument to the @code{forward-sentence} function.
-@node forward-sentence, forward-paragraph, re-search-forward, Regexp Search
-@comment node-name, next, previous, up
+@node forward-sentence
@section @code{forward-sentence}
@findex forward-sentence
@@ -12678,8 +12561,8 @@ bound to the key command @kbd{M-e}.
* fwd-sentence re-search:: A regular expression search.
@end menu
-@node Complete forward-sentence, fwd-sentence while loops, forward-sentence, forward-sentence
@ifnottex
+@node Complete forward-sentence
@unnumberedsubsec Complete @code{forward-sentence} function definition
@end ifnottex
@@ -12805,7 +12688,7 @@ point, from before the search, is used in the
equivalents. The @code{sentence-end} variable is set by the
@code{sentence-end} function.
-@node fwd-sentence while loops, fwd-sentence re-search, Complete forward-sentence, forward-sentence
+@node fwd-sentence while loops
@unnumberedsubsec The @code{while} loops
Two @code{while} loops follow. The first @code{while} has a
@@ -12906,7 +12789,7 @@ It may seem odd to have what looks like the `real work' of
the @code{forward-sentence} function buried here, but this is a common
way this kind of operation is carried out in Lisp.
-@node fwd-sentence re-search, , fwd-sentence while loops, forward-sentence
+@node fwd-sentence re-search
@unnumberedsubsec The regular expression search
The @code{re-search-forward} function searches for the end of the
@@ -12954,8 +12837,7 @@ illustrated by @code{re-search-forward}, in which the search is the
test of an @code{if} expression, is handy. You will see or write code
incorporating this pattern often.
-@node forward-paragraph, etags, forward-sentence, Regexp Search
-@comment node-name, next, previous, up
+@node forward-paragraph
@section @code{forward-paragraph}: a Goldmine of Functions
@findex forward-paragraph
@@ -13138,8 +13020,8 @@ This is an added complication.
* fwd-para while:: The forward motion @code{while} loop.
@end menu
-@node forward-paragraph in brief, fwd-para let, forward-paragraph, forward-paragraph
@ifnottex
+@node forward-paragraph in brief
@unnumberedsubsec Shortened @code{forward-paragraph} function definition
@end ifnottex
@@ -13178,7 +13060,7 @@ This case was described earlier. (@xref{forward-sentence, The
@code{forward-sentence} function}.) Now we reach the end of the
familiar part of this function.
-@node fwd-para let, fwd-para while, forward-paragraph in brief, forward-paragraph
+@node fwd-para let
@unnumberedsubsec The @code{let*} expression
The next line of the @code{forward-paragraph} function begins a
@@ -13310,7 +13192,7 @@ of the @code{let*} deals with the case when the function is given a
negative argument and is therefore moving backwards. We will skip this
section.
-@node fwd-para while, , fwd-para let, forward-paragraph
+@node fwd-para while
@unnumberedsubsec The forward motion @code{while} loop
The second part of the body of the @code{let*} deals with forward
@@ -13583,7 +13465,7 @@ key; you will be taken directly to the source. (Be sure to install
your sources! Without them, you are like a person who tries to drive
a car with his eyes shut!)
-@node etags, Regexp Review, forward-paragraph, Regexp Search
+@node etags
@section Create Your Own @file{TAGS} File
@findex etags
@cindex @file{TAGS} file, create own
@@ -13707,8 +13589,7 @@ as well as with some other source packages.)
For more information, see @ref{Tags, , Tag Tables, emacs, The GNU Emacs
Manual}.
-@node Regexp Review, re-search Exercises, etags, Regexp Search
-@comment node-name, next, previous, up
+@node Regexp Review
@section Review
Here is a brief summary of some recently introduced functions.
@@ -13799,7 +13680,7 @@ the buffer is narrowed.
@end table
@need 1500
-@node re-search Exercises, , Regexp Review, Regexp Search
+@node re-search Exercises
@section Exercises with @code{re-search-forward}
@itemize @bullet
@@ -13817,7 +13698,7 @@ The function I use is described in an appendix, along with several
regexps. @xref{the-the, , @code{the-the} Duplicated Words Function}.
@end itemize
-@node Counting Words, Words in a defun, Regexp Search, Top
+@node Counting Words
@chapter Counting: Repetition and Regexps
@cindex Repetition for word counting
@cindex Regular expressions for word counting
@@ -13834,8 +13715,8 @@ word count commands using @code{while} loops and recursion.
* Counting Exercise::
@end menu
-@node Why Count Words, @value{COUNT-WORDS}, Counting Words, Counting Words
@ifnottex
+@node Why Count Words
@unnumberedsec Counting words
@end ifnottex
@@ -13856,8 +13737,7 @@ There are many ways to implement a command to count words. Here are
some examples, which you may wish to compare with the standard Emacs
command, @code{count-words-region}.
-@node @value{COUNT-WORDS}, recursive-count-words, Why Count Words, Counting Words
-@comment node-name, next, previous, up
+@node @value{COUNT-WORDS}
@section The @code{@value{COUNT-WORDS}} Function
@findex @value{COUNT-WORDS}
@@ -13882,8 +13762,8 @@ or to a @code{while} loop.
* Whitespace Bug:: The Whitespace Bug in @code{@value{COUNT-WORDS}}.
@end menu
-@node Design @value{COUNT-WORDS}, Whitespace Bug, @value{COUNT-WORDS}, @value{COUNT-WORDS}
@ifnottex
+@node Design @value{COUNT-WORDS}
@unnumberedsubsec Designing @code{@value{COUNT-WORDS}}
@end ifnottex
@@ -13971,10 +13851,9 @@ this is:
@noindent
The buffer's syntax table determines which characters are and are not
-word constituents. (@xref{Syntax, , What Constitutes a Word or
-Symbol?}, for more about syntax. Also, see @ref{Syntax, Syntax, The
-Syntax Table, emacs, The GNU Emacs Manual}, and @ref{Syntax Tables, ,
-Syntax Tables, elisp, The GNU Emacs Lisp Reference Manual}.)
+word constituents. For more information about syntax,
+@pxref{Syntax Tables, , Syntax Tables, elisp, The GNU Emacs Lisp
+Reference Manual}.
@need 800
The search expression looks like this:
@@ -14060,8 +13939,7 @@ table determines which characters these are."
@noindent
As written, the function works, but not in all circumstances.
-@node Whitespace Bug, , Design @value{COUNT-WORDS}, @value{COUNT-WORDS}
-@comment node-name, next, previous, up
+@node Whitespace Bug
@subsection The Whitespace Bug in @code{@value{COUNT-WORDS}}
The @code{@value{COUNT-WORDS}} command described in the preceding
@@ -14313,8 +14191,7 @@ Here is what it looks like:
@end group
@end smallexample
-@node recursive-count-words, Counting Exercise, @value{COUNT-WORDS}, Counting Words
-@comment node-name, next, previous, up
+@node recursive-count-words
@section Count Words Recursively
@cindex Count words recursively
@cindex Recursively counting words
@@ -14692,14 +14569,14 @@ determines which characters these are."
@end group
@end smallexample
-@node Counting Exercise, , recursive-count-words, Counting Words
+@node Counting Exercise
@section Exercise: Counting Punctuation
Using a @code{while} loop, write a function to count the number of
punctuation marks in a region---period, comma, semicolon, colon,
exclamation mark, and question mark. Do the same using recursion.
-@node Words in a defun, Readying a Graph, Counting Words, Top
+@node Words in a defun
@chapter Counting Words in a @code{defun}
@cindex Counting words in a @code{defun}
@cindex Word counting in a @code{defun}
@@ -14732,8 +14609,8 @@ and this will tell.
* Prepare the data:: Prepare the data for display in a graph.
@end menu
-@node Divide and Conquer, Words and Symbols, Words in a defun, Words in a defun
@ifnottex
+@node Divide and Conquer
@unnumberedsec Divide and Conquer
@end ifnottex
@@ -14770,7 +14647,7 @@ Fifth, write a function to print the results as a graph.
This is quite a project! But if we take each step slowly, it will not
be difficult.
-@node Words and Symbols, Syntax, Divide and Conquer, Words in a defun
+@node Words and Symbols
@section What to Count?
@cindex Words and symbols in defun
@@ -14824,7 +14701,7 @@ that are not word constituents. What is meant by `word constituent
characters' brings us to the issue of syntax, which is worth a section
of its own.
-@node Syntax, count-words-in-defun, Words and Symbols, Words in a defun
+@node Syntax
@section What Constitutes a Word or Symbol?
@cindex Syntax categories and tables
@@ -14835,8 +14712,7 @@ constituent} characters. Word constituent characters are members of
one syntax category. Other syntax categories include the class of
punctuation characters, such as the period and the comma, and the
class of whitespace characters, such as the blank space and the tab
-character. (For more information, see @ref{Syntax, Syntax, The Syntax
-Table, emacs, The GNU Emacs Manual}, and @ref{Syntax Tables, , Syntax
+character. (For more information, @pxref{Syntax Tables, , Syntax
Tables, elisp, The GNU Emacs Lisp Reference Manual}.)
Syntax tables specify which characters belong to which categories.
@@ -14856,7 +14732,7 @@ action would serve our purpose, except that a hyphen is merely the
most common character within symbols that is not typically a word
constituent character; there are others, too.
-Alternatively, we can redefine the regular expression used in the
+Alternatively, we can redefine the regexp used in the
@code{@value{COUNT-WORDS}} definition so as to include symbols. This
procedure has the merit of clarity, but the task is a little tricky.
@@ -14909,7 +14785,7 @@ Here is the full regular expression:
"\\(\\w\\|\\s_\\)+[^ \t\n]*[ \t\n]*"
@end smallexample
-@node count-words-in-defun, Several defuns, Syntax, Words in a defun
+@node count-words-in-defun
@section The @code{count-words-in-defun} Function
@cindex Counting words in a @code{defun}
@@ -15006,13 +14882,13 @@ word and symbol by symbol, and another expression that counts the
jumps. The true-or-false-test for the @code{while} loop should test
true so long as point should jump forward, and false when point is at
the end of the definition. We have already redefined the regular
-expression for this (@pxref{Syntax}), so the loop is straightforward:
+expression for this, so the loop is straightforward:
@smallexample
@group
(while (and (< (point) end)
(re-search-forward
- "\\(\\w\\|\\s_\\)+[^ \t\n]*[ \t\n]*" end t)
+ "\\(\\w\\|\\s_\\)+[^ \t\n]*[ \t\n]*" end t))
(setq count (1+ count)))
@end group
@end smallexample
@@ -15103,7 +14979,7 @@ Success! The definition has 10 words and symbols.
The next problem is to count the numbers of words and symbols in
several definitions within a single file.
-@node Several defuns, Find a File, count-words-in-defun, Words in a defun
+@node Several defuns
@section Count Several @code{defuns} Within a File
A file such as @file{simple.el} may have a hundred or more function
@@ -15158,8 +15034,7 @@ switched back and forth to some other buffer, such as the
Finding a file is a new process that we have not yet discussed.
-@node Find a File, lengths-list-file, Several defuns, Words in a defun
-@comment node-name, next, previous, up
+@node Find a File
@section Find a File
@cindex Find a File
@@ -15242,7 +15117,7 @@ our own expression.
The task is easy: use @code{find-file-noselect} and @code{set-buffer}.
-@node lengths-list-file, Several files, Find a File, Words in a defun
+@node lengths-list-file
@section @code{lengths-list-file} in Detail
The core of the @code{lengths-list-file} function is a @code{while}
@@ -15285,7 +15160,7 @@ specification. Since people worry that a computer is broken if they
don't see anything going on, the first line of the body is a
message.
-The next line contains a @code{save-excursion} that returns Emacs'
+The next line contains a @code{save-excursion} that returns Emacs's
attention to the current buffer when the function completes. This is
useful in case you embed this function in another function that
presumes point is restored to the original buffer.
@@ -15383,7 +15258,7 @@ earlier one; and my new machine is much faster than the old one.)
Note that the length of the last definition in the file is first in
the list.
-@node Several files, Several files recursively, lengths-list-file, Words in a defun
+@node Several files
@section Count Words in @code{defuns} in Different Files
In the previous section, we created a function that returns a list of
@@ -15399,8 +15274,8 @@ either a @code{while} loop or recursion.
* append:: Attach one list to another.
@end menu
-@node lengths-list-many-files, append, Several files, Several files
@ifnottex
+@node lengths-list-many-files
@unnumberedsubsec Determine the lengths of @code{defuns}
@end ifnottex
@@ -15496,7 +15371,7 @@ The only other new element of this function definition is the as yet
unstudied function @code{append}, which merits a short section for
itself.
-@node append, , lengths-list-many-files, Several files
+@node append
@subsection The @code{append} Function
@need 800
@@ -15531,7 +15406,7 @@ becomes the first element of the new list:
((1 2 3 4) 5 6 7 8)
@end smallexample
-@node Several files recursively, Prepare the data, Several files, Words in a defun
+@node Several files recursively
@section Recursively Count Words in Different Files
Besides a @code{while} loop, you can work on each of a list of files
@@ -15614,7 +15489,7 @@ output we want.
The next step is to prepare the data in the list for display in a graph.
-@node Prepare the data, , Several files recursively, Words in a defun
+@node Prepare the data
@section Prepare the Data for Display in a Graph
The @code{recursive-lengths-list-many-files} function returns a list
@@ -15637,8 +15512,8 @@ numbers.
* Counting function definitions::
@end menu
-@node Data for Display in Detail, Sorting, Prepare the data, Prepare the data
@ifnottex
+@node Data for Display in Detail
@unnumberedsubsec The Data for Display in Detail
@end ifnottex
@@ -15656,7 +15531,7 @@ inspecting a sorted list, we can discover the highest and lowest
number, and thereby determine the largest and smallest length range
that we will need.
-@node Sorting, Files List, Data for Display in Detail, Prepare the data
+@node Sorting
@subsection Sorting Lists
@findex sort
@@ -15735,7 +15610,7 @@ which produces:
quoted, since the expression must be evaluated so as to produce the
list that is passed to @code{sort}.)
-@node Files List, Counting function definitions, Sorting, Prepare the data
+@node Files List
@subsection Making a List of Files
The @code{recursive-lengths-list-many-files} function requires a list
@@ -15805,11 +15680,11 @@ nil
100
@end group
@group
-(17733 259)
-(17491 28834)
-(17596 62124)
-13157
-"-rw-rw-r--"
+(20615 27034 579989 697000)
+(17905 55681 0 0)
+(20615 26327 734791 805000)
+13188
+"-rw-r--r--"
@end group
@group
nil
@@ -15996,7 +15871,7 @@ like this:
(insert (format "%s" (current-time-string))))
@end ignore
-@node Counting function definitions, , Files List, Prepare the data
+@node Counting function definitions
@subsection Counting function definitions
Our immediate goal is to generate a list that tells us how many
@@ -16300,7 +16175,7 @@ between 120 and 129, and so on. There are four elements with a value
of 200 or larger.
@c The next step is to turn this numbers' list into a graph.
-@node Readying a Graph, Emacs Initialization, Words in a defun, Top
+@node Readying a Graph
@chapter Readying a Graph
@cindex Readying a graph
@cindex Graph prototype
@@ -16332,8 +16207,8 @@ the function to label the axes automatically.
* Line Graph Exercise::
@end menu
-@node Columns of a graph, graph-body-print, Readying a Graph, Readying a Graph
@ifnottex
+@node Columns of a graph
@unnumberedsec Printing the Columns of a Graph
@end ifnottex
@@ -16705,7 +16580,7 @@ Now, finally, we come to our first actual graph printing function.
This prints the body of a graph, not the labels for the vertical and
horizontal axes, so we can call this @code{graph-body-print}.
-@node graph-body-print, recursive-graph-body-print, Columns of a graph, Readying a Graph
+@node graph-body-print
@section The @code{graph-body-print} Function
@findex graph-body-print
@@ -16864,7 +16739,7 @@ Emacs will print a graph like this:
@end group
@end smallexample
-@node recursive-graph-body-print, Printed Axes, graph-body-print, Readying a Graph
+@node recursive-graph-body-print
@section The @code{recursive-graph-body-print} Function
@findex recursive-graph-body-print
@@ -16951,11 +16826,11 @@ Here is what @code{recursive-graph-body-print} produces:
Either of these two functions, @code{graph-body-print} or
@code{recursive-graph-body-print}, create the body of a graph.
-@node Printed Axes, Line Graph Exercise, recursive-graph-body-print, Readying a Graph
+@node Printed Axes
@section Need for Printed Axes
A graph needs printed axes, so you can orient yourself. For a do-once
-project, it may be reasonable to draw the axes by hand using Emacs'
+project, it may be reasonable to draw the axes by hand using Emacs's
Picture mode; but a graph drawing function may be used more than once.
For this reason, I have written enhancements to the basic
@@ -16964,12 +16839,12 @@ the horizontal and vertical axes. Since the label printing functions
do not contain much new material, I have placed their description in
an appendix. @xref{Full Graph, , A Graph with Labeled Axes}.
-@node Line Graph Exercise, , Printed Axes, Readying a Graph
+@node Line Graph Exercise
@section Exercise
Write a line graph version of the graph printing functions.
-@node Emacs Initialization, Debugging, Readying a Graph, Top
+@node Emacs Initialization
@chapter Your @file{.emacs} File
@cindex @file{.emacs} file
@cindex Customizing your @file{.emacs} file
@@ -17001,12 +16876,12 @@ expressions in Emacs Lisp you can change or extend Emacs.
* Mode Line:: How to customize your mode line.
@end menu
-@node Default Configuration, Site-wide Init, Emacs Initialization, Emacs Initialization
@ifnottex
-@unnumberedsec Emacs' Default Configuration
+@node Default Configuration
+@unnumberedsec Emacs's Default Configuration
@end ifnottex
-There are those who appreciate Emacs' default configuration. After
+There are those who appreciate Emacs's default configuration. After
all, Emacs starts you in C mode when you edit a C file, starts you in
Fortran mode when you edit a Fortran file, and starts you in
Fundamental mode when you edit an unadorned file. This all makes
@@ -17034,7 +16909,7 @@ you may. The new format is consistent with the Emacs Lisp file
naming conventions; the old format saves typing.}
A @file{~/.emacs} file contains Emacs Lisp code. You can write this
-code yourself; or you can use Emacs' @code{customize} feature to write
+code yourself; or you can use Emacs's @code{customize} feature to write
the code for you. You can combine your own expressions and
auto-written Customize expressions in your @file{.emacs} file.
@@ -17048,7 +16923,7 @@ describes a simple @file{.emacs} file; for more information, see
@ref{Init File, , The Init File, elisp, The GNU Emacs Lisp Reference
Manual}.
-@node Site-wide Init, defcustom, Default Configuration, Emacs Initialization
+@node Site-wide Init
@section Site-wide Initialization Files
@cindex @file{default.el} init file
@@ -17094,12 +16969,12 @@ The @file{loaddefs.el} file contains a good many suggestions as to
what to put into your own @file{.emacs} file, or into a site-wide
initialization file.
-@node defcustom, Beginning a .emacs File, Site-wide Init, Emacs Initialization
+@node defcustom
@section Specifying Variables using @code{defcustom}
@findex defcustom
You can specify variables using @code{defcustom} so that you and
-others can then use Emacs' @code{customize} feature to set their
+others can then use Emacs's @code{customize} feature to set their
values. (You cannot use @code{customize} to write function
definitions; but you can write @code{defuns} in your @file{.emacs}
file. Indeed, you can write any Lisp expression in your @file{.emacs}
@@ -17259,7 +17134,7 @@ intent is that neither programs nor users should ever change a value
set by @code{defconst}. (You can change it; the value set is a
variable; but please do not.)
-@node Beginning a .emacs File, Text and Auto-fill, defcustom, Emacs Initialization
+@node Beginning a .emacs File
@section Beginning a @file{.emacs} File
@cindex @file{.emacs} file, beginning of
@@ -17342,7 +17217,7 @@ Of course, you don't need to include comments like these in your
about Mode help or the conventions for comments---but I was able to
remember to look here to remind myself.
-@node Text and Auto-fill, Mail Aliases, Beginning a .emacs File, Emacs Initialization
+@node Text and Auto-fill
@section Text and Auto Fill Mode
Now we come to the part that `turns on' Text mode and
@@ -17464,7 +17339,7 @@ fill commands to insert two spaces after a colon:
(setq colon-double-space t)
@end smallexample
-@node Mail Aliases, Indent Tabs Mode, Text and Auto-fill, Emacs Initialization
+@node Mail Aliases
@section Mail Aliases
Here is a @code{setq} that `turns on' mail aliases, along with more
@@ -17498,7 +17373,7 @@ alias geo george@@foobar.wiz.edu
When you write a message to George, address it to @samp{geo}; the
mailer will automatically expand @samp{geo} to the full address.
-@node Indent Tabs Mode, Keybindings, Mail Aliases, Emacs Initialization
+@node Indent Tabs Mode
@section Indent Tabs Mode
@cindex Tabs, preventing
@findex indent-tabs-mode
@@ -17536,7 +17411,7 @@ Files'' in @cite{The GNU Emacs Manual}.
@end iftex
@need 1700
-@node Keybindings, Keymaps, Indent Tabs Mode, Emacs Initialization
+@node Keybindings
@section Some Keybindings
Now for some personal keybindings:
@@ -17649,7 +17524,7 @@ window, I prefer the @code{buffer-menu}
command, which not only lists the buffers,
but moves point into that window.
-@node Keymaps, Loading Files, Keybindings, Emacs Initialization
+@node Keymaps
@section Keymaps
@cindex Keymaps
@cindex Rebinding keys
@@ -17717,7 +17592,7 @@ You will see numerous @code{define-key} expressions in
Manual}, and @ref{Keymaps, , Keymaps, elisp, The GNU Emacs Lisp
Reference Manual}, for more information about keymaps.
-@node Loading Files, Autoload, Keymaps, Emacs Initialization
+@node Loading Files
@section Loading Files
@cindex Loading files
@c findex load
@@ -17766,7 +17641,7 @@ the keys to @code{split-window-quietly}, like this:
@vindex load-path
If you load many extensions, as I do, then instead of specifying the
exact location of the extension file, as shown above, you can specify
-that directory as part of Emacs' @code{load-path}. Then, when Emacs
+that directory as part of Emacs's @code{load-path}. Then, when Emacs
loads a file, it will search that directory as well as its default
list of directories. (The default list is specified in @file{paths.h}
when Emacs is built.)
@@ -17809,7 +17684,7 @@ Another interactive command that does a slightly different job is
Emacs, emacs, The GNU Emacs Manual}, for information on the
distinction between @code{load-library} and this command.
-@node Autoload, Simple Extension, Loading Files, Emacs Initialization
+@node Autoload
@section Autoloading
@findex autoload
@@ -17878,7 +17753,7 @@ documentation is not available.)
@xref{Autoload, , Autoload, elisp, The GNU Emacs Lisp Reference
Manual}, for more information.
-@node Simple Extension, X11 Colors, Autoload, Emacs Initialization
+@node Simple Extension
@section A Simple Extension: @code{line-to-top-of-window}
@findex line-to-top-of-window
@cindex Simple extension in @file{.emacs} file
@@ -17942,7 +17817,7 @@ the following conditional:
@end group
@end smallexample
-For example, in contrast to version 20, more recent versions blink
+For example, recent versions blink
their cursors by default. I hate such blinking, as well as other
features, so I placed the following in my @file{.emacs}
file@footnote{When I start instances of Emacs that do not load my
@@ -17990,7 +17865,7 @@ emacs -Q - D
@end group
@end smallexample
-@node X11 Colors, Miscellaneous, Simple Extension, Emacs Initialization
+@node X11 Colors
@section X11 Colors
You can specify colors when you use Emacs with the MIT X Windowing
@@ -18034,10 +17909,10 @@ file that set values:
@group
;; Set calendar highlighting colors
(setq calendar-load-hook
- '(lambda ()
- (set-face-foreground 'diary-face "skyblue")
- (set-face-background 'holiday-face "slate blue")
- (set-face-foreground 'holiday-face "white")))
+ (lambda ()
+ (set-face-foreground 'diary-face "skyblue")
+ (set-face-background 'holiday-face "slate blue")
+ (set-face-foreground 'holiday-face "white")))
@end group
@end smallexample
@@ -18068,7 +17943,7 @@ xsetroot -solid Navy -fg white &
@end smallexample
@need 1700
-@node Miscellaneous, Mode Line, X11 Colors, Emacs Initialization
+@node Miscellaneous
@section Miscellaneous Settings for a @file{.emacs} File
@need 1250
@@ -18260,7 +18135,7 @@ xmodmap -e "keysym Alt_L = Meta_L Alt_L"
@end smallexample
@need 1700
-@node Mode Line, , Miscellaneous, Emacs Initialization
+@node Mode Line
@section A Modified Mode Line
@vindex mode-line-format
@cindex Mode line format
@@ -18423,7 +18298,7 @@ This will start an Emacs that does @emph{not} load your
@file{~/.emacs} initialization file. A plain, default Emacs. Nothing
more.
-@node Debugging, Conclusion, Emacs Initialization, Top
+@node Debugging
@chapter Debugging
@cindex debugging
@@ -18443,7 +18318,7 @@ In this chapter, I will walk through a short example of each.
* Debugging Exercises::
@end menu
-@node debug, debug-on-entry, Debugging, Debugging
+@node debug
@section @code{debug}
@findex debug
@@ -18570,7 +18445,7 @@ Debugger entered--Lisp error: (void-function 1=)
You can correct the mistake, re-evaluate the function definition, and
then run your test again.
-@node debug-on-entry, debug-on-quit, debug, Debugging
+@node debug-on-entry
@section @code{debug-on-entry}
@findex debug-on-entry
@@ -18709,7 +18584,7 @@ M-x cancel-debug-on-entry RET triangle-bugged RET
@noindent
(If you are reading this in Info, cancel @code{debug-on-entry} now.)
-@node debug-on-quit, edebug, debug-on-entry, Debugging
+@node debug-on-quit
@section @code{debug-on-quit} and @code{(debug)}
In addition to setting @code{debug-on-error} or calling @code{debug-on-entry},
@@ -18741,7 +18616,7 @@ where you want the debugger to start, like this:
The @code{debug} function is described in detail in @ref{Debugger, ,
The Lisp Debugger, elisp, The GNU Emacs Lisp Reference Manual}.
-@node edebug, Debugging Exercises, debug-on-quit, Debugging
+@node edebug
@section The @code{edebug} Source Level Debugger
@cindex Source level debugger
@findex edebug
@@ -18884,7 +18759,7 @@ Edebug is described in @ref{edebug, , Edebug, elisp, The GNU Emacs
Lisp Reference Manual}.
@need 1500
-@node Debugging Exercises, , edebug, Debugging
+@node Debugging Exercises
@section Debugging Exercises
@itemize @bullet
@@ -18929,7 +18804,7 @@ Set a breakpoint, then run Edebug in Trace mode until it reaches the
stopping point.
@end itemize
-@node Conclusion, the-the, Debugging, Top
+@node Conclusion
@chapter Conclusion
We have now reached the end of this Introduction. You have now
@@ -19049,7 +18924,7 @@ beginning.
@c ================ Appendix ================
-@node the-the, Kill Ring, Conclusion, Top
+@node the-the
@appendix The @code{the-the} Function
@findex the-the
@cindex Duplicated words function
@@ -19146,7 +19021,7 @@ five six seven
You can substitute the other regular expressions shown above in the
function definition and try each of them on this list.
-@node Kill Ring, Full Graph, the-the, Top
+@node Kill Ring
@appendix Handling the Kill Ring
@cindex Kill ring handling
@cindex Handling the kill ring
@@ -19168,8 +19043,8 @@ consider the workings of the kill ring.
* ring file::
@end menu
-@node What the Kill Ring Does, current-kill, Kill Ring, Kill Ring
@ifnottex
+@node What the Kill Ring Does
@unnumberedsec What the Kill Ring Does
@end ifnottex
@@ -19243,8 +19118,7 @@ To return to the old value for the length of the kill ring, evaluate:
(setq kill-ring-max old-kill-ring-max)
@end smallexample
-@node current-kill, yank, What the Kill Ring Does, Kill Ring
-@comment node-name, next, previous, up
+@node current-kill
@appendixsec The @code{current-kill} Function
@findex current-kill
@@ -19261,8 +19135,8 @@ and @code{kill-region}.)
* Understanding current-kill::
@end menu
-@node Code for current-kill, Understanding current-kill, current-kill, current-kill
@ifnottex
+@node Code for current-kill
@unnumberedsubsec The code for @code{current-kill}
@end ifnottex
@@ -19322,8 +19196,8 @@ Here is the line in @code{kill-new}, which is explained in
(setq kill-ring-yank-pointer kill-ring)
@end smallexample
-@node Understanding current-kill, , Code for current-kill, current-kill
@ifnottex
+@node Understanding current-kill
@unnumberedsubsec @code{current-kill} in Outline
@end ifnottex
@@ -19349,8 +19223,8 @@ documentation string. It is @emph{not} interactive.
* Determining the Element::
@end menu
-@node Body of current-kill, Digression concerning error, Understanding current-kill, Understanding current-kill
@ifnottex
+@node Body of current-kill
@unnumberedsubsubsec The Body of @code{current-kill}
@end ifnottex
@@ -19432,8 +19306,8 @@ current value of @code{kill-ring-yank-pointer} is set to point to the
list. Finally, another expression returns the first element of the
list even if the @code{do-not-move} argument is true.
-@node Digression concerning error, Determining the Element, Body of current-kill, Understanding current-kill
@ifnottex
+@node Digression concerning error
@unnumberedsubsubsec Digression about the word `error'
@end ifnottex
@@ -19454,8 +19328,8 @@ environment, is making an error. This is bad. Even though the computer
takes the same steps as it does when there is an `error', a term such as
`cancel' would have a clearer connotation.
-@node Determining the Element, , Digression concerning error, Understanding current-kill
@ifnottex
+@node Determining the Element
@unnumberedsubsubsec Determining the Element
@end ifnottex
@@ -19592,8 +19466,7 @@ them in an argument list (and within expressions called by them).
@ref{defun, , The @code{defun} Special Form}.)
@end ignore
-@node yank, yank-pop, current-kill, Kill Ring
-@comment node-name, next, previous, up
+@node yank
@appendixsec @code{yank}
@findex yank
@@ -19678,8 +19551,7 @@ function.)
The last part of the function tells what to do when it succeeds.
-@node yank-pop, ring file, yank, Kill Ring
-@comment node-name, next, previous, up
+@node yank-pop
@appendixsec @code{yank-pop}
@findex yank-pop
@@ -19749,8 +19621,7 @@ positions of point and mark set by the preceding @code{yank} command.
There is more, but that is the hardest part.
-@node ring file, , yank-pop, Kill Ring
-@comment node-name, next, previous, up
+@node ring file
@appendixsec The @file{ring.el} File
@cindex @file{ring.el} file
@@ -19759,7 +19630,7 @@ provides many of the features we just discussed. But functions such
as @code{kill-ring-yank-pointer} do not use this library, possibly
because they were written earlier.
-@node Full Graph, Free Software and Free Manuals, Kill Ring, Top
+@node Full Graph
@appendix A Graph with Labeled Axes
Printed axes help you understand a graph. They convey scale. In an
@@ -19776,8 +19647,8 @@ body itself.
* Print Whole Graph:: The function to print a complete graph.
@end menu
-@node Labeled Example, print-graph Varlist, Full Graph, Full Graph
@ifnottex
+@node Labeled Example
@unnumberedsec Labeled Example Graph
@end ifnottex
@@ -19864,8 +19735,7 @@ These considerations suggest the following outline for the
We can work on each part of the @code{print-graph} function definition
in turn.
-@node print-graph Varlist, print-Y-axis, Labeled Example, Full Graph
-@comment node-name, next, previous, up
+@node print-graph Varlist
@appendixsec The @code{print-graph} Varlist
@cindex @code{print-graph} varlist
@@ -19906,8 +19776,7 @@ in the @code{let} for @code{print-graph}:
As we shall see, this expression is not quite right.
@need 2000
-@node print-Y-axis, print-X-axis, print-graph Varlist, Full Graph
-@comment node-name, next, previous, up
+@node print-Y-axis
@appendixsec The @code{print-Y-axis} Function
@cindex Axis, print vertical
@cindex Y axis printing
@@ -19945,8 +19814,8 @@ construct and insert the appropriate numbers and marks.
* print-Y-axis Penultimate:: A not quite final version.
@end menu
-@node print-Y-axis in Detail, Height of label, print-Y-axis, print-Y-axis
@ifnottex
+@node print-Y-axis in Detail
@unnumberedsubsec The @code{print-Y-axis} Function in Detail
@end ifnottex
@@ -19961,8 +19830,8 @@ the base line (number 1) and then that we want a number and a tic on
the fifth line from the bottom and on every line that is a multiple of
five.
-@node Height of label, Compute a Remainder, print-Y-axis in Detail, print-Y-axis
@ifnottex
+@node Height of label
@unnumberedsubsec What height should the label be?
@end ifnottex
@@ -19999,7 +19868,7 @@ language, more reminiscent of the classroom, five goes into seven
once, with a remainder of two. However, five goes into ten twice,
with no remainder: ten is an integral multiple of five.
-@node Compute a Remainder, Y Axis Element, Height of label, print-Y-axis
+@node Compute a Remainder
@appendixsubsec Side Trip: Compute a Remainder
@findex % @r{(remainder function)}
@@ -20133,7 +20002,7 @@ then the resulting value of @code{height} is used to compute its
final value. @xref{fwd-para let, , The @code{let*} expression}, for
more about @code{let*}.)
-@node Y Axis Element, Y-axis-column, Compute a Remainder, print-Y-axis
+@node Y Axis Element
@appendixsubsec Construct a Y Axis Element
When we print the vertical axis, we want to insert strings such as
@@ -20239,7 +20108,7 @@ The @code{number-to-string} function is used in the concatenation
expression, to convert the number to a string that is concatenated
with the leading spaces and the tic mark.
-@node Y-axis-column, print-Y-axis Penultimate, Y Axis Element, print-Y-axis
+@node Y-axis-column
@appendixsubsec Create a Y Axis Column
The preceding functions provide all the tools needed to construct a
@@ -20286,7 +20155,7 @@ blank label using the @code{make-string} function. The base line
consists of the number one followed by a tic mark.
@need 2000
-@node print-Y-axis Penultimate, , Y-axis-column, print-Y-axis
+@node print-Y-axis Penultimate
@appendixsubsec The Not Quite Final Version of @code{print-Y-axis}
The list constructed by the @code{Y-axis-column} function is passed to
@@ -20362,7 +20231,7 @@ Emacs will print labels vertically, the top one being @w{@samp{10 -@w{
thereby getting rid of what might appear as a bug.)
@need 2000
-@node print-X-axis, Print Whole Graph, print-Y-axis, Full Graph
+@node print-X-axis
@appendixsec The @code{print-X-axis} Function
@cindex Axis, print horizontal
@cindex X axis printing
@@ -20398,8 +20267,8 @@ graph without changing the ways the graph is labeled.
* X Axis Tic Marks:: Create tic marks for the horizontal axis.
@end menu
-@node Similarities differences, X Axis Tic Marks, print-X-axis, print-X-axis
@ifnottex
+@node Similarities differences
@unnumberedsubsec Similarities and differences
@end ifnottex
@@ -20424,7 +20293,7 @@ using @code{print-X-axis-tic-line} and
@code{print-X-axis-numbered-line}.
@end enumerate
-@node X Axis Tic Marks, , Similarities differences, print-X-axis
+@node X Axis Tic Marks
@appendixsubsec X Axis Tic Marks
The first function should print the X axis tic marks. We must specify
@@ -20713,7 +20582,7 @@ Emacs will print the horizontal axis like this:
@end group
@end smallexample
-@node Print Whole Graph, , print-X-axis, Full Graph
+@node Print Whole Graph
@appendixsec Printing the Whole Graph
@cindex Printing the whole graph
@cindex Whole graph printing
@@ -20752,8 +20621,8 @@ Here is the outline:
* Final printed graph:: The graph itself!
@end menu
-@node The final version, Test print-graph, Print Whole Graph, Print Whole Graph
@ifnottex
+@node The final version
@unnumberedsubsec Changes for the Final Version
@end ifnottex
@@ -20904,7 +20773,7 @@ each row is five units."
@end group
@end smallexample
-@node Test print-graph, Graphing words in defuns, The final version, Print Whole Graph
+@node Test print-graph
@appendixsubsec Testing @code{print-graph}
@need 1250
@@ -20994,7 +20863,7 @@ The graph looks like this:
feature? If you think it is a bug, and should be a `1' instead, (or
even a `0'), you can modify the sources.)
-@node Graphing words in defuns, lambda, Test print-graph, Print Whole Graph
+@node Graphing words in defuns
@appendixsubsec Graphing Numbers of Words and Symbols
Now for the graph for which all this code was written: a graph that
@@ -21078,11 +20947,11 @@ not yet seen, @code{mapcar} and @code{lambda}.
@group
(defun one-fiftieth (full-range)
"Return list, each number one-fiftieth of previous."
- (mapcar '(lambda (arg) (/ arg 50)) full-range))
+ (mapcar (lambda (arg) (/ arg 50)) full-range))
@end group
@end smallexample
-@node lambda, mapcar, Graphing words in defuns, Print Whole Graph
+@node lambda
@appendixsubsec A @code{lambda} Expression: Useful Anonymity
@cindex Anonymous function
@findex lambda
@@ -21248,7 +21117,7 @@ divides that number by 50.
Lisp Reference Manual}, for more about @code{lambda}. Lisp and lambda
expressions derive from the Lambda Calculus.
-@node mapcar, Another Bug, lambda, Print Whole Graph
+@node mapcar
@appendixsubsec The @code{mapcar} Function
@findex mapcar
@@ -21299,7 +21168,7 @@ and the second argument is @code{full-range}, which will be bound to
The whole expression looks like this:
@smallexample
-(mapcar '(lambda (arg) (/ arg 50)) full-range))
+(mapcar (lambda (arg) (/ arg 50)) full-range))
@end smallexample
@xref{Mapping Functions, , Mapping Functions, elisp, The GNU Emacs
@@ -21332,7 +21201,7 @@ information: many of the higher ranges are 0, meaning that fewer than
50 defuns had that many words or symbols---but not necessarily meaning
that none had that many words or symbols.)
-@node Another Bug, Final printed graph, mapcar, Print Whole Graph
+@node Another Bug
@appendixsubsec Another Bug @dots{} Most Insidious
@cindex Bug, most insidious type
@cindex Insidious type of bug
@@ -21971,7 +21840,7 @@ each column."
@group
(defun one-fiftieth (full-range)
"Return list, each number of which is 1/50th previous."
- (mapcar '(lambda (arg) (/ arg 50)) full-range))
+ (mapcar (lambda (arg) (/ arg 50)) full-range))
@end group
@end smallexample
@@ -22029,7 +21898,7 @@ each column."
@end ignore
@page
-@node Final printed graph, , Another Bug, Print Whole Graph
+@node Final printed graph
@appendixsubsec The Printed Graph
When made and installed, you can call the @code{print-graph} command
@@ -22079,7 +21948,7 @@ Here is the graph:
@noindent
The largest group of functions contain 10 -- 19 words and symbols each.
-@node Free Software and Free Manuals, GNU Free Documentation License, Full Graph, Top
+@node Free Software and Free Manuals
@appendix Free Software and Free Manuals
@strong{by Richard M. Stallman}
@@ -22199,14 +22068,13 @@ Note: The Free Software Foundation maintains a page on its Web site
that lists free books available from other publishers:@*
@uref{http://www.gnu.org/doc/other-free-books.html}
-@node GNU Free Documentation License, Index, Free Software and Free Manuals, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@cindex FDL, GNU Free Documentation License
@include doclicense.texi
-@node Index, About the Author, GNU Free Documentation License, Top
-@comment node-name, next, previous, up
+@node Index
@unnumbered Index
@ignore
@@ -22245,7 +22113,7 @@ MENU ENTRY: NODE NAME.
@end iftex
@ifnottex
-@node About the Author, , Index, Top
+@node About the Author
@unnumbered About the Author
@end ifnottex
diff --git a/doc/lispintro/lambda-1.eps b/doc/lispintro/lambda-1.eps
index a9c3c530646..42f8d54264c 100644
--- a/doc/lispintro/lambda-1.eps
+++ b/doc/lispintro/lambda-1.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:31:53 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/lambda-2.eps b/doc/lispintro/lambda-2.eps
index 44238a1ad7d..ab9e8a85820 100644
--- a/doc/lispintro/lambda-2.eps
+++ b/doc/lispintro/lambda-2.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:33:09 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/lambda-3.eps b/doc/lispintro/lambda-3.eps
index 1c5cda046e0..8269650e0ec 100644
--- a/doc/lispintro/lambda-3.eps
+++ b/doc/lispintro/lambda-3.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:33:49 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/makefile.w32-in b/doc/lispintro/makefile.w32-in
index 06641cc2222..ea9b04b87ca 100644
--- a/doc/lispintro/makefile.w32-in
+++ b/doc/lispintro/makefile.w32-in
@@ -1,6 +1,6 @@
#### -*- Makefile -*- for the Emacs Lisp Introduction manual.
-# Copyright (C) 2003-2011 Free Software Foundation, Inc.
+# Copyright (C) 2003-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -24,10 +24,12 @@ infodir = $(srcdir)/../../info
# Directory with the (customized) texinfo.tex file.
texinfodir = $(srcdir)/../misc
+INFO_EXT=.info
+INFO_OPTS=--no-split
INFO_SOURCES = $(srcdir)/emacs-lisp-intro.texi $(srcdir)/doclicense.texi
# The file name eintr must fit within 5 characters, to allow for
# -NN extensions to fit into DOS 8+3 limits without clashing
-INFO_TARGETS = $(infodir)/eintr
+INFO_TARGETS = $(infodir)/eintr$(INFO_EXT)
DVI_TARGETS = emacs-lisp-intro.dvi
MAKEINFO = makeinfo
@@ -47,8 +49,8 @@ $(infodir)/dir:
dvi: $(DVI_TARGETS)
-$(infodir)/eintr: $(INFO_SOURCES)
- $(MAKEINFO) -o $@ $(srcdir)/emacs-lisp-intro.texi
+$(infodir)/eintr$(INFO_EXT): $(INFO_SOURCES)
+ $(MAKEINFO) $(INFO_OPTS) -o $@ $(srcdir)/emacs-lisp-intro.texi
emacs-lisp-intro.dvi: $(INFO_SOURCES)
$(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-lisp-intro.texi
@@ -66,7 +68,7 @@ mostlyclean:
- $(DEL) *.log *.cp *.fn *.ky *.pg *.vr *.tp
clean: mostlyclean
- - $(DEL) *.dvi $(infodir)/eintr*
+ - $(DEL) *.dvi $(infodir)/eintr$(INFO_EXT)*
distclean: clean
- $(DEL) makefile
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 5b90c2a1f9f..a0710723ea2 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,2013 @@
+2012-11-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ * doclicense.texi: Update to latest version from FSF.
+ These are just minor editorial changes.
+ * elisp.texi (GNU Free Documentation License)
+ (GNU General Public Licens):
+ Provide sectioning, since doclicense.texi no longer does that.
+
+ * loading.texi (Named Features): @ -> @@ to fix typo.
+
+2012-11-24 Martin Rudalics <rudalics@gmx.at>
+
+ * windows.texi (Basic Windows): Fix typo.
+ (Windows and Frames): Fix example. Move description of
+ window-in-direction here.
+ (Recombining Windows): Fix example.
+ (Buffers and Windows): Fix description of
+ replace-buffer-in-windows.
+ (Switching Buffers): Reword.
+ (Display Action Functions): Minor adjustments.
+ (Choosing Window Options): Minor fixes.
+ (Window History): Minor rewording.
+ (Dedicated Windows): Correct and reword part describing how
+ dedicatedness affects functions removing buffers or windows.
+ * buffers.texi (The Buffer List): Fix description of
+ bury-buffer.
+
+2012-11-24 Chong Yidong <cyd@gnu.org>
+
+ * modes.texi (%-Constructs): Fix statement about mode construct
+ padding (Bug#12866).
+
+2012-11-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * debugging.texi (Profiling): Make it more clear
+ that --enable-profiling is about profiling the C code.
+
+2012-11-21 Glenn Morris <rgm@gnu.org>
+
+ * display.texi (Attribute Functions):
+ Update for set-face-* name changes.
+ Add new "inherit" argument for face-bold-p etc.
+ Move description of this argument to a common section, like "frame".
+
+ * debugging.texi (Profiling): New section.
+ (Debugging): Mention profiling in the introduction.
+ * tips.texi (Compilation Tips): Move profiling to separate section.
+ * elisp.texi: Add Profiling to detailed menu.
+
+2012-11-21 Martin Rudalics <rudalics@gmx.at>
+
+ * windows.texi (Display Action Functions): Fix recently added
+ example. Suggested by Michael Heerdegen.
+
+2012-11-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor cleanup for times as lists of four integers.
+ * os.texi (Time Parsing): Time values can now be four integers.
+
+2012-11-18 Glenn Morris <rgm@gnu.org>
+
+ * loading.texi (How Programs Do Loading): Add eager macro expansion.
+ * macros.texi (Expansion): Mention eager macro expansion.
+
+ * minibuf.texi (Basic Completion): Mention misc completion-table funcs.
+
+2012-11-18 Leo Liu <sdl.web@gmail.com>
+
+ * minibuf.texi (Programmed Completion): Doc fix for metadata
+ request (Bug#12850).
+
+2012-11-18 Glenn Morris <rgm@gnu.org>
+
+ * display.texi (Temporary Displays): Document with-temp-buffer-window.
+
+ * frames.texi (Size and Position): Add fit-frame-to-buffer command.
+ * windows.texi (Resizing Windows): Add fit-frame-to-buffer option.
+ (Window Sizes): Add vindex for window-min-height, window-min-width.
+ (Display Action Functions): Mention pop-up-frame-parameters.
+
+2012-11-16 Martin Rudalics <rudalics@gmx.at>
+
+ * windows.texi (Choosing Window): Rewrite description of
+ display-buffer-alist (Bug#12167).
+ (Display Action Functions): Mention inhibit-switch-frame. Fix
+ description of display-buffer-below-selected. Reorder actions.
+ Add example (Bug#12848).
+
+2012-11-16 Glenn Morris <rgm@gnu.org>
+
+ * display.texi (Face Attributes): Fix :underline COLOR description.
+ (Attribute Functions): Update for set-face-underline rename.
+ Tweak descriptions of face-underline-p, face-inverse-video-p.
+
+ * keymaps.texi (Searching Keymaps, Tool Bar): Untabify examples,
+ so they align better in info.
+ (Active Keymaps, Searching Keymaps, Controlling Active Maps):
+ Document set-temporary-overlay-map.
+
+2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * keymaps.texi (Translation Keymaps): Add a subsection "Interaction
+ with normal keymaps".
+
+2012-11-15 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * internals.texi (Garbage Collection): Update descriptions
+ of vectorlike_header, garbage-collect and gc-cons-threshold.
+ (Object Internals): Explain Lisp_Object layout and the basics
+ of an internal type system.
+ (Buffer Internals): Update description of struct buffer.
+
+2012-11-13 Glenn Morris <rgm@gnu.org>
+
+ * variables.texi (Adding Generalized Variables):
+ At least mention gv-define-expander and gv-letplace.
+
+ * debugging.texi (Error Debugging): Mention debug-on-message.
+ (Using Debugger): Mention debugger-bury-or-kill.
+
+ * control.texi (Signaling Errors):
+ * debugging.texi (Error Debugging):
+ * errors.texi (Standard Errors): Add user-error.
+
+ * variables.texi (Adding Generalized Variables):
+ Use standard formatting for common lisp note about setf functions.
+
+2012-11-10 Martin Rudalics <rudalics@gmx.at>
+
+ * elisp.texi (Top): Add Recombining Windows to menu.
+ * windows.texi (Recombining Windows): New subsection.
+ (Splitting Windows): Rewrite text on handling of window
+ combinations and move it to new subsection.
+
+2012-11-10 Chong Yidong <cyd@gnu.org>
+
+ * searching.texi (Replacing Match): Document \? in replace-match.
+
+ * variables.texi (Creating Buffer-Local): Document setq-local and
+ defvar-local.
+ (Setting Generalized Variables): Arrange table alphabetically.
+
+ * lists.texi (List Elements, List Variables): Clarify descriptions
+ of push and pop for generalized variables.
+
+ * edebug.texi (Specification List): setf is no longer CL-only.
+
+2012-11-10 Glenn Morris <rgm@gnu.org>
+
+ * variables.texi (Adding Generalized Variables):
+ Update description of FIX-RETURN expansion.
+
+ * variables.texi (Setting Generalized Variables):
+ Split most of previous contents into this subsection.
+ (Adding Generalized Variables): New subsection.
+ Move note on lack of setf functions here from misc/cl.texi.
+
+ * elisp.texi: Add Generalized Variables subsections to detailed menu.
+
+2012-11-10 Chong Yidong <cyd@gnu.org>
+
+ * frames.texi (Initial Parameters): Doc fix (Bug#12144).
+
+2012-11-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * os.texi (Notifications): Update descriptions of
+ notifications-notify, notifications-close-notification and
+ notifications-get-capabilities according to latest code changes.
+ Add notifications-get-server-information.
+
+2012-11-03 Chong Yidong <cyd@gnu.org>
+
+ * objects.texi (General Escape Syntax): Clarify the explanation of
+ escape sequences.
+ (Non-ASCII in Strings): Clarify when a string is unibyte vs
+ multibyte. Hex escapes do not automatically make a string
+ multibyte.
+
+2012-11-03 Martin Rudalics <rudalics@gmx.at>
+
+ * windows.texi (Switching Buffers): Document option
+ switch-to-buffer-preserve-window-point.
+ (Display Action Functions): Document window-height and
+ window-width alist entries.
+ (Display Action Functions): Document
+ display-buffer-below-selected and
+ display-buffer-in-previous-window.
+ (Quitting Windows): Document quit-restore-window. Rewrite
+ section.
+ (Window Configurations): In window-state-get mention that
+ argument window must be valid.
+ (Window Parameters): Document quit-restore window parameter
+ (Bug#12158).
+
+2012-10-31 Glenn Morris <rgm@gnu.org>
+
+ * control.texi (Catch and Throw): Add xref to cl.texi.
+
+ * lists.texi (Sets And Lists): Point xref to better location.
+
+ * errors.texi (Standard Errors):
+ * loading.texi (Autoload): Update for cl-lib namespace changes.
+
+ * modes.texi (Defining Minor Modes): "Generalized Variables"
+ section is now in this manual rather than cl.texi.
+
+ * eval.texi (Special Forms): No longer special forms: defmacro,
+ defun, save-window-excursion, with-output-to-temp-buffer.
+ * functions.texi (Defining Functions): Defun is now a macro.
+ Defalias is a function.
+
+2012-10-30 Glenn Morris <rgm@gnu.org>
+
+ * variables.texi (Generalized Variables): Fix typo.
+
+2012-10-30 Chong Yidong <cyd@gnu.org>
+
+ * symbols.texi (Symbol Plists): Document function-get.
+
+ * loading.texi (Autoload): Document autoloadp, autoload-do-load.
+
+ * frames.texi (Visibility of Frames): Document tty-top-frame.
+
+2012-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * keymaps.texi (Format of Keymaps): Document the multiple
+ inheritance format.
+
+2012-10-28 Martin Rudalics <rudalics@gmx.at>
+
+ * windows.texi (Basic Windows): Reformulate description of live,
+ internal and valid windows.
+ (Cyclic Window Ordering): Describe new argument of
+ get-lru-window and get-largest-window. Add description of
+ window-in-direction.
+
+2012-10-27 Glenn Morris <rgm@gnu.org>
+
+ * variables.texi (Generalized Variables): New section,
+ adapted from misc/cl.texi.
+ * elisp.texi (Top): Add Generalized Variables to menu.
+ * lists.texi (List Elements, List Variables):
+ Mention generalized variables.
+
+ * lists.texi (List Elements): Typo fix.
+
+2012-10-27 Chong Yidong <cyd@gnu.org>
+
+ * minibuf.texi (High-Level Completion): Don't mention removed
+ function iswitchb-read-buffer.
+
+ * commands.texi (Event Input Misc): Remove last-input-char.
+ (Command Loop Info): Remove last-command-char.
+
+ * frames.texi (Initial Parameters): Don't mention the obsolete
+ special-display feature.
+
+ * windows.texi (Choosing Window): Don't mention the obsolete
+ special display feature.
+ (Choosing Window Options): Remove obsolete special-display
+ variables, and the functions special-display-p and
+ special-display-popup-frame.
+
+ * display.texi (Fringe Bitmaps): Add exclamation-mark bitmap.
+
+ * hooks.texi (Standard Hooks): Remove obsolete hooks.
+
+ * markers.texi (Information from Markers): Remove obsolete
+ function buffer-has-markers-at.
+
+ * text.texi (Yanking): Document yank-handled-properties.
+
+2012-10-24 Paul Eggert <eggert@penguin.cs.ucla.edu>
+
+ Update manual for new time stamp format (Bug#12706).
+ * buffers.texi (Modification Time):
+ * files.texi (Testing Accessibility, File Attributes):
+ * intro.texi (Version Info):
+ * os.texi (Time of Day):
+ Update for new time stamp format (HIGH LOW MICROSEC PICOSEC).
+ These instances were missed the first time around.
+ Problem reported by Glenn Morris in <http://bugs.gnu.org/12706#25>.
+
+2012-10-24 Chong Yidong <cyd@gnu.org>
+
+ * minibuf.texi (Text from Minibuffer): Document read-regexp
+ changes.
+
+ * nonascii.texi (Selecting a Representation): Document
+ set-buffer-multibyte changes.
+
+ * keymaps.texi (Toolkit Differences): Node deleted.
+ (Easy Menu): New node.
+
+2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * hooks.texi (Standard Hooks): Clarify that -hooks is deprecated.
+
+2012-10-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix outdated timestamp documentation in Elisp manual (bug#12706).
+ * files.texi (File Attributes):
+ * text.texi (Undo):
+ Time stamp resolution is now 1 picosecond, not 1 second.
+
+2012-10-23 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Font Lookup): Remove font-list-limit.
+
+ * keymaps.texi (Key Sequences): Avoid referring to Edit Macro mode
+ (Bug#12529).
+
+2012-10-22 Glenn Morris <rgm@gnu.org>
+
+ * os.texi (Recording Input): Tiny fix.
+
+ * intro.texi (Lisp History):
+ * lists.texi (Sets And Lists): Refer to cl-lib rather than cl.
+ * tips.texi (Coding Conventions): Recommend cl-lib over cl.
+
+2012-10-15 Chong Yidong <cyd@gnu.org>
+
+ * macros.texi (Defining Macros): defmacro is now a macro.
+ Explicitly list the docstring and declare arguments.
+
+ * functions.texi (Anonymous Functions): Explicitly list the
+ docstring, declare, and interactive arguments to lambda.
+ (Defining Functions): Likewise for defun.
+ (Inline Functions): Likewise for defsubst.
+ (Declare Form): Tweak description.
+
+2012-10-13 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (ImageMagick Images): ImageMagick enabled by default.
+
+2012-10-05 Chong Yidong <cyd@gnu.org>
+
+ * minibuf.texi (Basic Completion): Clarify list form of completion
+ table (Bug#12564).
+
+2012-10-05 Bruno Félix Rezende Ribeiro <oitofelix@gmail.com> (tiny change)
+
+ * functions.texi (Function Safety): Copyedit. (Bug#12562)
+
+2012-10-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Revert the FOLLOW-SYMLINKS change for file-attributes.
+ * files.texi (File Attributes, Magic File Names): Undo last change.
+
+2012-09-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ file-attributes has a new optional arg FOLLOW-SYMLINKS.
+ * files.texi (File Attributes): Describe it.
+ (Magic File Names): Use it.
+
+2012-09-30 Chong Yidong <cyd@gnu.org>
+
+ * commands.texi (Click Events): Define "mouse position list".
+ Remove mention of unimplemented horizontal scroll bars.
+ (Drag Events, Motion Events): Refer to "mouse position list".
+ (Accessing Mouse): Document posnp.
+
+ * errors.texi (Standard Errors): Tweak arith-error description.
+ Tweak markup. Remove domain-error and friends, which seem to be
+ unused after the floating-point code revamp.
+
+ * functions.texi (Obsolete Functions): Obsolescence also affects
+ documentation commands. Various clarifications.
+ (Declare Form): New node.
+
+ * strings.texi (String Basics): Copyedits.
+
+ * os.texi (Idle Timers): Minor clarifications.
+ (User Identification): Add system-users and system-groups.
+
+ * macros.texi (Defining Macros): Move description of `declare' to
+ Declare Form node.
+
+ * loading.texi (Autoload):
+ * help.texi (Documentation Basics): The special sequences can
+ trigger autoloading.
+
+ * numbers.texi (Integer Basics): Copyedits.
+ (Float Basics): Consider IEEE floating point always available.
+ (Random Numbers): Document actual limits.
+ (Arithmetic Operations): Clarify division by zero. Don't mention
+ the machine-independence of negative division since it does not
+ happen in practice.
+
+2012-09-28 Chong Yidong <cyd@gnu.org>
+
+ * os.texi (Startup Summary): Document leim-list.el change.
+
+2012-09-25 Chong Yidong <cyd@gnu.org>
+
+ * functions.texi (Defining Functions): defun is now a macro.
+
+2012-09-28 Leo Liu <sdl.web@gmail.com>
+
+ * files.texi (Files): Fix typo.
+
+2012-09-23 Chong Yidong <cyd@gnu.org>
+
+ * buffers.texi (Read Only Buffers): Document read-only-mode.
+
+ * keymaps.texi (Alias Menu Items): Replace toggle-read-only with
+ read-only-mode.
+
+ * backups.texi (Auto-Saving): Refer to Minor Mode Conventions for
+ calling conventions.
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * searching.texi (Replacing Match): Minor clarification.
+
+2012-09-22 Eli Zaretskii <eliz@gnu.org>
+
+ * edebug.texi (Instrumenting): Improve indexing.
+
+ * os.texi (Idle Timers): Warn against reinvoking an idle timer
+ from within its own timer action. (Bug#12447)
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * frames.texi (Pop-Up Menus): Minor clarification (Bug#11148).
+
+2012-09-21 Glenn Morris <rgm@gnu.org>
+
+ * debugging.texi (Using Debugger): Fix typo.
+
+2012-09-18 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Faces): Discuss anonymous faces.
+ (Face Attributes): Tweak intro.
+ (Defining Faces): Move after the Face Attributes node. Copyedits.
+ (Displaying Faces): Describe role of inheritance.
+
+ * customize.texi (Customization): Define customization more
+ carefully (Bug#11440).
+ (Common Keywords): Add xref to Constant Variables.
+
+ * variables.texi (Defining Variables): Link to defcustom's node
+ instead of the higher-level Customization chapter.
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify, document, and port floating-point (Bug#12381).
+ * numbers.texi (Float Basics, Arithmetic Operations, Math Functions):
+ Document that / and mod (with floating point arguments), along
+ with asin, acos, log, log10, expt and sqrt, return special values
+ instead of signaling exceptions.
+ (Float Basics): Document that logb operates on the absolute value
+ of its argument.
+ (Math Functions): Document that (log ARG BASE) also returns NaN if
+ BASE is negative. Document that (expt X Y) returns NaN if X is a
+ finite negative number and Y a finite non-integer.
+
+2012-09-09 Chong Yidong <cyd@gnu.org>
+
+ * lists.texi (Sets And Lists): Explain that the return value for
+ delete should be used, like for delq.
+
+ * minibuf.texi (Yes-or-No Queries): Document recentering and
+ scrolling in y-or-n-p. Remove gratuitous example.
+
+ * searching.texi (Search and Replace): Document window scrolling
+ entries in query-replace-map.
+
+2012-09-08 Chong Yidong <cyd@gnu.org>
+
+ * syntax.texi (Syntax Table Internals): Define "raw syntax
+ descriptor" terminology (Bug#12383).
+ (Syntax Descriptors): Mention raw syntax descriptors.
+
+2012-09-07 Chong Yidong <cyd@gnu.org>
+
+ * variables.texi (Creating Buffer-Local): Fix description of
+ local-variable-if-set-p (Bug#10713).
+
+ * eval.texi (Intro Eval): Add index entry for sexp (Bug#12233).
+
+ * windows.texi (Display Action Functions)
+ (Choosing Window Options): Remove obsolete variable
+ display-buffer-reuse-frames.
+ (Switching Buffers): Minor doc tweak for switch-to-buffer.
+
+ * positions.texi (Narrowing): Document buffer-narrowed-p.
+
+ * markers.texi (Moving Markers): Add xref to Point (Bug#7151).
+
+ * syntax.texi (Low-Level Parsing): Add xref to Parser State
+ (Bug#12269).
+
+2012-09-04 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * debugging.texi (Explicit Debug): Document `debug-on-message'.
+
+2012-09-02 Chong Yidong <cyd@gnu.org>
+
+ * windows.texi (Window Configurations): Recommend against using
+ save-window-excursion (Bug#12075).
+
+ * control.texi (Catch and Throw):
+ * positions.texi (Excursions): Don't mention it.
+
+2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better seed support for (random).
+ * numbers.texi (Random Numbers): Document new behavior of
+ the calls (random) and (random STRING).
+
+2012-08-21 Martin Rudalics <rudalics@gmx.at>
+
+ * windows.texi (Window Point): Document recent changes in
+ window-point and set-window-point.
+ (Selecting Windows): Document recent change in select-window.
+
+2012-08-06 Eli Zaretskii <eliz@gnu.org>
+
+ * functions.texi (Closures): Put the main index entry for
+ "closures" here. (Bug#12138)
+
+ * variables.texi (Lexical Binding): Disambiguate the index entry
+ for "closures".
+
+2012-08-05 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Defining Faces): Move documentation of
+ frame-background-mode to the Emacs manual (Bug#7774).
+
+2012-08-04 Chong Yidong <cyd@gnu.org>
+
+ * syntax.texi (Syntax Basics): Rearrange the text for clarity.
+ Fix description of syntax table inheritance.
+ (Syntax Table Functions): Don't refer to internal contents of
+ syntax table, since that is not explained yet. Copyedits.
+ (Standard Syntax Tables): Node deleted.
+ (Syntax Table Internals): Misc clarifications. Improve table
+ formatting.
+
+ * keymaps.texi (Inheritance and Keymaps):
+ * text.texi (Sticky Properties): Tweak index entry.
+
+2012-07-28 Eli Zaretskii <eliz@gnu.org>
+
+ * nonascii.texi (Character Sets): Fix a typo. (Bug#12062)
+
+2012-07-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer typical American spelling for "acknowledgment".
+ * intro.texi (Acknowledgments): Rename from Acknowledgements.
+
+2012-07-21 Eli Zaretskii <eliz@gnu.org>
+
+ * commands.texi (Special Events): Mention language-change event.
+ (Input Events, Interactive Codes):
+ * keymaps.texi (Key Sequences): Mention events that are
+ non-keyboard but also non-mouse events.
+
+2012-07-17 Chong Yidong <cyd@gnu.org>
+
+ * text.texi (Insertion): Document insert-char changes.
+
+2012-07-15 Leo Liu <sdl.web@gmail.com>
+
+ * display.texi (Fringe Bitmaps): Add exclamation-mark.
+
+2012-07-13 Chong Yidong <cyd@gnu.org>
+
+ * buffers.texi (Read Only Buffers): Document toggle-read-only
+ changes. Reword to account for the fact that read-only is
+ currently not supported in overlay properties.
+
+2012-07-07 Chong Yidong <cyd@gnu.org>
+
+ * loading.texi (Library Search): Index site-lisp directories.
+
+2012-07-06 Chong Yidong <cyd@gnu.org>
+
+ * intro.texi (A Sample Function Description): Fix incorrect
+ markup, undoing previous change.
+ (A Sample Variable Description): Minor clarifications and markup
+ improvements.
+
+ * elisp.texi (Top):
+ * text.texi (Text): Fix menu order.
+
+2012-07-06 Richard Stallman <rms@gnu.org>
+
+ * intro.texi (Evaluation Notation, A Sample Function Description):
+ (A Sample Variable Description): Improve/undo previous changes.
+
+2012-07-05 Glenn Morris <rgm@gnu.org>
+
+ * intro.texi (A Sample Function Description): Fix cross-refs.
+
+2012-07-05 Michael Witten <mfwitten@gmail.com> (tiny change)
+
+ * intro.texi (Evaluation Notation, A Sample Function Description)
+ (A Sample Variable Description, Version Info): Copy edits (bug#11862).
+
+2012-06-27 Chong Yidong <cyd@gnu.org>
+
+ * processes.texi (Asynchronous Processes, Input to Processes):
+ * internals.texi (Process Internals): Don't capitalize "pty".
+
+2012-06-24 Thien-Thi Nguyen <ttn@gnuvola.org>
+
+ * processes.texi (Asynchronous Processes): Make the pty vs pipe
+ discussion more prominent.
+
+2012-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ * commands.texi (Misc Events): Document the language-change event.
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+ * os.texi (Time of Day, Time Parsing, Processor Run Time, Idle Timers):
+ * processes.texi (System Processes):
+ Time stamp resolution is now picosecond, not microsecond.
+
+2012-06-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737)
+
+2012-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * functions.texi (Defining Functions):
+ * macros.texi (Defining Macros): Un-define the return value of `defun',
+ `defmacro' and `defalias'.
+
+2012-06-17 Chong Yidong <cyd@gnu.org>
+
+ * elisp.texi: Remove urlcolor setting.
+
+2012-06-17 Glenn Morris <rgm@gnu.org>
+
+ * display.texi (Face Attributes): Copyedits. Add a few cindex entries.
+ Overlining no longer behaves exactly like underlining.
+
+2012-06-16 Aurelien Aptel <aurelien.aptel@gmail.com>
+
+ * display.texi (Face Attributes):
+ Document wave-style underline face attribute.
+
+2012-06-11 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (ImageMagick Images): ImageMagick now supports the
+ :background property.
+
+2012-06-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * internals.texi (Garbage Collection): Typo fix.
+
+2012-06-09 Chong Yidong <cyd@gnu.org>
+
+ * text.texi (Special Properties): Clarify the meaning of a list of
+ faces in the `face' property.
+
+ * display.texi (Face Remapping): Minor clarification.
+
+2012-06-08 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Face Attributes): Font family does not accept
+ wildcards. De-document obsolete :bold and :italic attributes.
+ (Defining Faces): Use new-style face spec format.
+
+2012-06-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * internals.texi (Garbage Collection): Document new
+ vector management code and vectorlike_header structure.
+
+2012-06-03 Chong Yidong <cyd@gnu.org>
+
+ * modes.texi (Mode Line Data): Use "mode line construct"
+ terminology for consistency.
+
+2012-05-27 Glenn Morris <rgm@gnu.org>
+
+ * abbrevs.texi, advice.texi, anti.texi, backups.texi:
+ * buffers.texi, commands.texi, compile.texi, control.texi:
+ * customize.texi, debugging.texi, display.texi, doclicense.texi:
+ * edebug.texi, elisp.texi, errors.texi, eval.texi, files.texi:
+ * frames.texi, functions.texi, gpl.texi, hash.texi, help.texi:
+ * hooks.texi, index.texi, internals.texi, intro.texi, keymaps.texi:
+ * lists.texi, loading.texi, macros.texi, maps.texi, markers.texi:
+ * minibuf.texi, modes.texi, nonascii.texi, numbers.texi:
+ * objects.texi, os.texi, package.texi, positions.texi:
+ * processes.texi, searching.texi, sequences.texi, streams.texi:
+ * strings.texi, symbols.texi, syntax.texi, text.texi, tips.texi:
+ * variables.texi, windows.texi: Nuke hand-written node pointers.
+
+2012-05-27 Chong Yidong <cyd@gnu.org>
+
+ * functions.texi (Obsolete Functions):
+ Fix doc for set-advertised-calling-convention.
+
+ * modes.texi (Mode Help): Fix describe-mode.
+
+ * display.texi (Face Functions): Fix define-obsolete-face-alias.
+
+ * variables.texi (Variable Aliases): Fix make-obsolete-variable.
+
+2012-05-27 Martin Rudalics <rudalics@gmx.at>
+
+ * commands.texi (Recursive Editing): recursive-edit is a command.
+
+ * compile.texi (Docs and Compilation):
+ byte-compile-dynamic-docstrings is an option.
+
+ * debugging.texi (Invoking the Debugger): debug is a command.
+
+ * display.texi (Progress): progress-reporter-update and
+ progress-reporter-force-update have VALUE argument optional.
+ (Animated Images): Use non-@code{nil} instead of non-nil.
+
+ * files.texi (Format Conversion Round-Trip):
+ Use non-@code{nil} instead of non-nil.
+
+ * frames.texi (Creating Frames): make-frame is a command.
+ (Input Focus): select-frame is a command.
+ (Pointer Shape): void-text-area-pointer is an option.
+
+ * help.texi (Describing Characters): read-kbd-macro is a command.
+ (Help Functions): describe-prefix-bindings is a command.
+
+ * markers.texi (Creating Markers): Both arguments of copy-marker
+ are optional.
+
+ * minibuf.texi (Reading File Names): Use @kbd instead of @code.
+
+ * modes.texi (Mode Line Variables): mode-line-remote and
+ mode-line-client are not options.
+ (Imenu): imenu-add-to-menubar is a command.
+ (SMIE Indentation Helpers): Use non-@code{nil} instead of non-nil.
+
+ * os.texi (Sound Output): play-sound-file is a command.
+
+ * package.texi (Package Archives): Use @key{RET} instead of @kbd{RET}.
+
+ * processes.texi (Signals to Processes):
+ Use @key{RET} instead of @code{RET}.
+ (Signals to Processes): signal-process is a command.
+
+ * text.texi (Clickable Text): Use @key{RET} instead of @kbd{RET}.
+ (Base 64): base64-encode-string is not a command while
+ base64-decode-region is.
+
+ * windows.texi (Switching Buffers): pop-to-buffer is a command.
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MKDIR_P): New, set by configure.
+ (mkinfodir): Use $MKDIR_P.
+
+2012-05-10 Glenn Morris <rgm@gnu.org>
+
+ * loading.texi (Loading Non-ASCII): Replace the obsolete "unibyte: t"
+ with "coding: raw-text".
+ Concept of multibyte sessions no longer exists.
+
+ * files.texi (File Locks): Mention create-lockfiles option.
+
+2012-05-09 Glenn Morris <rgm@gnu.org>
+
+ * vol1.texi, vol2.texi: Remove files.
+ * elisp.texi: Add VOL1,2 conditionals equivalent to vol1,2.texi
+ * two-volume.make: Use elisp.texi as input rather than vol1,2.texi.
+
+ * Makefile.in (clean, mostlyclean): Add some more vol1/2 items.
+
+ * two-volume.make (emacsdir): New.
+ (tex): Add directory with emacsver.texi to TEXINPUTS.
+
+ * minibuf.texi (Minibuffer History, Basic Completion):
+ Tweak page breaks.
+
+ * internals.texi (Garbage Collection, Memory Usage)
+ (Writing Emacs Primitives): Tweak page breaks.
+
+ * streams.texi (Output Variables): Improve page break.
+
+ * edebug.texi (Edebug Display Update): Improve page break.
+
+ * compile.texi (Disassembly): Condense the examples.
+
+ * eval.texi, functions.texi, loading.texi, macros.texi:
+ Where possible, use example rather than smallexample.
+
+ * symbols.texi: Where possible, use example rather than smallexample.
+ (Symbol Components): Fix typo.
+ (Other Plists): Tweak page break.
+
+ * sequences.texi (Arrays): Tweak page breaks.
+
+ * customize.texi: Where possible, use example rather than smallexample.
+ (Common Keywords, Variable Definitions, Applying Customizations)
+ (Custom Themes): Tweak page breaks.
+
+ * control.texi: Where possible, use example rather than smallexample.
+ (Sequencing, Conditionals, Signaling Errors, Handling Errors):
+ Tweak page breaks.
+
+2012-05-08 Glenn Morris <rgm@gnu.org>
+
+ * two.el: Remove; unused since creation of two-volume.make.
+
+ * vol1.texi, vol2.texi: No need to keep menus in these files.
+
+2012-05-05 Glenn Morris <rgm@gnu.org>
+
+ * objects.texi (Process Type, Overlay Type): Tweak page-breaks.
+
+ * intro.texi (Caveats): Copyedit.
+ (Lisp History): Convert inforef to xref.
+ (Lisp History, Printing Notation, Version Info): Improve page-breaks.
+
+ * text.texi (Auto Filling): Don't mention Emacs 19.
+
+ * commands.texi (Event Input Misc): Don't mention unread-command-char.
+ * numbers.texi (Predicates on Numbers): Don't mention Emacs 18.
+
+ * elisp.texi (DATE): Forgot to change the month in 2012-04-21 change.
+
+ * lists.texi (List-related Predicates, List Variables):
+ Tweak page-breaks.
+ (Sets And Lists): Convert inforef to xref.
+
+2012-05-04 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (INFO_EXT, INFO_OPTS): New, set by configure.
+ (info, infoclean): Use $INFO_EXT.
+ ($(infodir)/elisp$(INFO_EXT)): Use $INFO_EXT and $INFO_OPT.
+ * makefile.w32-in (INFO_EXT, INFO_OPTS): New.
+ (info, maintainer-clean): Use $INFO_EXT.
+ ($(infodir)/elisp$(INFO_EXT)): Use $INFO_EXT and $INFO_OPT.
+
+2012-05-04 Chong Yidong <cyd@gnu.org>
+
+ * os.texi (Timers): Use defopt for timer-max-repeats.
+
+2012-05-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * os.texi (Time of Day): Do not limit current-time-string
+ to years 1000..9999.
+
+2012-05-02 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Font Lookup):
+ * frames.texi (Pointer Shape):
+ * processes.texi (Subprocess Creation): Use defopt for options.
+
+2012-05-02 Glenn Morris <rgm@gnu.org>
+
+ * elisp.texi (@copying):
+ * intro.texi (Introduction): Only print VERSION in the TeX version.
+
+2012-05-02 Chong Yidong <cyd@gnu.org>
+
+ * text.texi (Change Hooks): Minor fix for after-change-functions.
+
+2012-05-02 Glenn Morris <rgm@gnu.org>
+
+ * package.texi (Packaging Basics):
+ * loading.texi (Autoload):
+ * files.texi (Magic File Names):
+ Reword to remove/reduce some overly long/short lines.
+
+2012-04-27 Glenn Morris <rgm@gnu.org>
+
+ * elisp.texi, vol1.texi, vol2.texi: Some fixes for detailed menu.
+ * modes.texi (Major Modes, Auto-Indentation):
+ * buffers.texi (Buffers): Some fixes for menu descriptions.
+
+2012-04-27 Stefan Monnier <monnier@iro.umontreal.ca>
+ * functions.texi (Simple Lambda, Argument List):
+ * eval.texi (Function Indirection): Avoid deprecated form.
+
+2012-04-27 Glenn Morris <rgm@gnu.org>
+
+ * book-spine.texi, elisp.texi, vol1.texi, vol2.texi:
+ Add "et al." to authors.
+
+ * buffers.texi, commands.texi, compile.texi, control.texi:
+ * customize.texi, display.texi, eval.texi, files.texi, frames.texi:
+ * hash.texi, help.texi, intro.texi, keymaps.texi, lists.texi:
+ * modes.texi, numbers.texi, objects.texi, streams.texi:
+ * symbols.texi, syntax.texi, text.texi, tips.texi, variables.texi:
+ Use Texinfo recommended convention for quotes+punctuation.
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * keymaps.texi (Scanning Keymaps): Fix description of NO-REMAP arg
+ to where-is-internal (Bug#10872).
+
+2012-04-27 Glenn Morris <rgm@gnu.org>
+
+ * macros.texi (Indenting Macros): Fix typo.
+
+ * windows.texi (Basic Windows, Windows and Frames, Window Sizes)
+ (Resizing Windows, Deleting Windows, Selecting Windows)
+ (Choosing Window Options, Horizontal Scrolling)
+ (Cyclic Window Ordering, Window History, Dedicated Windows)
+ (Quitting Windows, Window Configurations, Textual Scrolling):
+ (Coordinates and Windows, Window Configurations)
+ (Window Parameters, Window Hooks): Copyedits.
+ (Splitting Windows, Deleting Windows):
+ Fix ignore-window-parameters logic.
+ (Selecting Windows, Choosing Window Options): Markup fixes.
+ (Window Start and End): Remove pointless example.
+ Remove cross-reference to deleted count-lines content.
+ (Textual Scrolling): Mention recenter-redisplay, recenter-top-bottom,
+ and recenter-positions. Remove recenter example.
+
+ * elisp.texi, vol1.texi, vol2.texi: Bump VERSION and DATE.
+
+ * minibuf.texi (Intro to Minibuffers):
+ Tweak discussion of resizing minibuffer window.
+
+2012-04-26 Glenn Morris <rgm@gnu.org>
+
+ * elisp-covers.texi, front-cover-1.texi: Remove files.
+
+ * tindex.pl: Remove file.
+
+ * makefile.w32-in (srcs):
+ * Makefile.in (srcs): Remove back.texi (which is unused).
+
+2012-04-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * os.texi (Notifications): Extend possible notification hints.
+ Add notifications-get-capabilities.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * processes.texi (Asynchronous Processes): Mention nil argument to
+ start-process.
+
+2012-04-20 Glenn Morris <rgm@gnu.org>
+
+ * minibuf.texi (Basic Completion): No need to describe obarrays here.
+ Don't mention obsolete `nospace' argument of all-completions.
+ (Minibuffer Completion, Completion Commands, Reading File Names)
+ (Completion Variables): Copyedits.
+ (Completion Commands): Mention parent keymaps.
+ Remove obsolete minibuffer-local-filename-must-match-map.
+ (High-Level Completion): Remove read-variable's almost
+ word-for-word duplication of read-command.
+ * elisp.texi, vol1.texi, vol2.texi, minibuf.texi (Completion):
+ Update "High-Level Completion" description.
+
+ * minibuf.texi (Minibuffers):
+ * elisp.texi, vol1.texi, vol2.texi: Fix minibuffer subsection order.
+
+ * minibuf.texi: Standardize metasyntactic variables ("history", etc).
+ Use Texinfo-recommended form of quote+punctuation.
+ (Intro to Minibuffers): First minibuffer is #1, not #0.
+ Mention minibuffer-inactive-mode.
+ (Text from Minibuffer): Copyedits.
+ (Minibuffer History, Programmed Completion): Fix @var usage.
+ (Object from Minibuffer): Remove overly pedantic para.
+ (Minibuffer History): Copyedits. Add face-name-history.
+ (Initial Input, Yes-or-No Queries, Multiple Queries)
+ (Minibuffer Windows, Minibuffer Misc): Copyedits.
+ (Yes-or-No Queries): Tweak example.
+ (Minibuffer Commands): Add next-complete-history-element.
+ (Minibuffer Misc): Mention minibuffer-message-timeout, and
+ minibuffer-inactive-mode.
+
+ * processes.texi (Serial Ports, Byte Packing, Bindat Spec)
+ (Bindat Functions): Copyedits.
+
+2012-04-20 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * files.texi (Saving Buffers): Document `visit and `visit-save'
+ values of require-final-newline.
+
+2012-04-20 Glenn Morris <rgm@gnu.org>
+
+ * processes.texi (Output from Processes, Filter Functions):
+ Mention waiting-for-user-input-p.
+ (Sentinels, Query Before Exit, System Processes, Transaction Queues):
+ (Network Servers, Datagrams, Network Processes, Network Options)
+ (Network Feature Testing, Serial Ports): Copyedits.
+ (Network): Add encrypted network overview paragraph.
+ Cross-reference the Emacs-GnuTLS manual. Use @acronym.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * help.texi (Keys in Documentation): Mention :advertised-binding.
+
+ * keymaps.texi (Menu Bar): Move most of the :advertised-binding
+ description to help.texi.
+
+2012-04-20 Glenn Morris <rgm@gnu.org>
+
+ * processes.texi (Process Information, Input to Processes)
+ (Signals to Processes, Output from Processes, Process Buffers)
+ (Filter Functions, Decoding Output): Copyedits.
+ (Accepting Output): Discourage use of `millisec' argument.
+
+2012-04-15 Glenn Morris <rgm@gnu.org>
+
+ * processes.texi (Processes, Subprocess Creation, Shell Arguments):
+ (Synchronous Processes, Asynchronous Processes, Deleting Processes):
+ Copyedits.
+ (Subprocess Creation): Discourage modifying exec-path directly.
+ (Synchronous Processes, Asynchronous Processes):
+ Update some example output.
+ (Process Information): Fix typo.
+ (Bindat Spec): Use Texinfo-recommended form of quote+punctuation.
+
+2012-04-15 Glenn Morris <rgm@gnu.org>
+
+ * anti.texi (Antinews): Copyedits. Don't @dfn anything here.
+ open-network-stream does exist in Emacs 23, but is simpler.
+
+2012-04-15 Chong Yidong <cyd@gnu.org>
+
+ * customize.texi (Custom Themes): Also document load-theme etc.
+
+2012-04-14 Chong Yidong <cyd@gnu.org>
+
+ * customize.texi (Applying Customizations):
+ (Custom Themes): New nodes.
+
+ * display.texi (Defining Faces): Reference custom-set-faces.
+
+ * modes.texi (Defining Minor Modes, Defining Minor Modes):
+ * os.texi (Startup Summary): Copyedits.
+
+2012-04-14 Glenn Morris <rgm@gnu.org>
+
+ * loading.texi (Loading Non-ASCII): "unibyte:" can also be at the end.
+
+ * strings.texi (Case Tables):
+ * objects.texi (General Escape Syntax):
+ * keymaps.texi (Key Sequences): Use @acronym with "ASCII".
+
+ * buffers.texi, compile.texi, customize.texi, debugging.texi:
+ * display.texi, edebug.texi, eval.texi, help.texi, intro.texi:
+ * keymaps.texi, minibuf.texi, modes.texi, os.texi, processes.texi:
+ * text.texi: Use @file for buffers, per the Texinfo manual.
+
+ * compile.texi (Compiler Errors): Add missing space in buffer name.
+
+2012-04-14 Chong Yidong <cyd@gnu.org>
+
+ * processes.texi (Query Before Exit): Remove obsolete function
+ process-kill-without-query (Bug#11190).
+
+2012-04-14 Glenn Morris <rgm@gnu.org>
+
+ * files.texi, frames.texi, loading.texi, os.texi, processes.texi:
+ Use @env for environment variables.
+
+ * Makefile.in: Replace non-portable use of $< in ordinary rules.
+
+2012-04-12 Jari Aalto <jari.aalto@cante.net>
+
+ * processes.texi (Synchronous Processes): Mention
+ `default-directory' (bug#7515).
+
+2012-04-09 Chong Yidong <cyd@gnu.org>
+
+ * customize.texi (Variable Definitions): Remove user-variable-p.
+
+ * commands.texi (Interactive Codes):
+ * help.texi (Accessing Documentation):
+ * minibuf.texi (High-Level Completion): Callers changed.
+
+2012-04-06 Chong Yidong <cyd@gnu.org>
+
+ * minibuf.texi (Programmed Completion): Document metadata method.
+ (Completion Variables): Document completion-category-overrides.
+
+2012-04-05 Chong Yidong <cyd@gnu.org>
+
+ * anti.texi (Antinews): Rewrite for Emacs 23.
+
+2012-04-04 Chong Yidong <cyd@gnu.org>
+
+ * minibuf.texi (Programmed Completion): Remove obsolete variable
+ completion-annotate-function.
+ (Completion Variables): Rename from Completion Styles. Document
+ completion-extra-properties. Document completion-styles-alist
+ change.
+ (Reading File Names): minibuffer-local-filename-must-match-map is
+ not used anymore.
+ (Minibuffer Completion): Document completing-read-function.
+ (Completion in Buffers): completion-at-point-functions can return
+ properties recognized in completion-extra-properties.
+
+ * display.texi (Delayed Warnings): New node.
+
+ * os.texi (Notifications): Copyedits.
+
+2012-04-04 Glenn Morris <rgm@gnu.org>
+
+ * os.texi (Notifications): Copyedits.
+
+2012-04-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * os.texi (Terminal-Specific): Fix typo.
+ (Notifications): New section.
+
+ * elisp.texi (Top):
+ * vol1.texi (Top):
+ * vol2.texi (Top): Add "Notifications" and "Dynamic Libraries"
+ menu entries.
+
+2012-04-01 Chong Yidong <cyd@gnu.org>
+
+ * files.texi (Kinds of Files): file-subdir-of-p renamed to
+ file-in-directory-p.
+
+2012-03-31 Glenn Morris <rgm@gnu.org>
+
+ * edebug.texi (Instrumenting Macro Calls):
+ Mention defining macros at instrumentation time.
+ (Edebug Options): Mention edebug-unwrap-results.
+
+2012-03-31 Eli Zaretskii <eliz@gnu.org>
+
+ * text.texi (Special Properties): Clarify the description of the
+ effect of integer values of the 'cursor' property on cursor
+ position. See the discussions in bug#11068 for more details and
+ context.
+
+2012-03-31 Glenn Morris <rgm@gnu.org>
+
+ * edebug.texi (Edebug Eval, Specification List, Edebug Options):
+ Copyedits.
+
+2012-03-30 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Image Formats): Add imagemagick type.
+ (Image Descriptors): Mention how they are used.
+ (ImageMagick Images): Clarify role of imagemagick-register-types.
+ (Character Display): Don't mention glyph tables.
+ (Display Tables): Use make-glyph-code in example.
+ (Glyphs): Avoid "simple glyph code" terminology. Note that glyph
+ tables are semi-obsolete. De-document create-glyph.
+ (Glyphless Chars): Note that display tables override this.
+ (Bidirectional Display): Copyedits. Introduce "bidirectional
+ reordering" terminology, and use it.
+
+2012-03-30 Glenn Morris <rgm@gnu.org>
+
+ * edebug.texi (Jumping): Give name of `i' binding.
+
+2012-03-28 Glenn Morris <rgm@gnu.org>
+
+ * searching.texi (Regular Expressions, Regexp Special):
+ (Regexp Backslash, Regexp Example, Regexp Functions, Regexp Search):
+ (Simple Match Data, Saving Match Data, Standard Regexps): Copyedits.
+ (Regexp Special): Mention collation.
+ Clarify char classes with an example.
+ (Regexp Functions): Mention regexp-opt is not guaranteed.
+ Mention regexp-opt-charset.
+ (Regexp Search): Recommend against looking-back.
+ (Search and Replace): Use Texinfo recommended quote convention.
+ Add more query-replace-map items. List multi-query-replace-map items.
+
+2012-03-27 Martin Rudalics <rudalics@gmx.at>
+
+ * windows.texi (Window History): Describe new option
+ switch-to-visible-buffer.
+
+2012-03-27 Glenn Morris <rgm@gnu.org>
+
+ * searching.texi (String Search): Add xref to Emacs manual.
+ Copyedits. Mention the function word-search-regexp.
+ (Searching and Case): Add xref to Emacs manual. Copyedits.
+
+ * processes.texi (Network Servers): Standardize apostrophe usage.
+
+ * os.texi (System Environment): Copyedits. Remove some examples
+ that do not seem useful. Mention setenv third arg.
+ tty-erase-char does not seem to be nil under a window-system.
+ (User Identification): Copyedits.
+ Remove some examples that do not seem useful.
+
+2012-03-26 Glenn Morris <rgm@gnu.org>
+
+ * os.texi (Startup Summary): Copyedits. Fix startup screen logic.
+ (Init File): Copyedits.
+ (Command-Line Arguments): Copyedits. Do not mention argv alias.
+ (Killing Emacs): Copyedits.
+ (Suspending Emacs): Copyedits. Mention not very relevant with GUIs.
+ Shorten the example, use more standard shell prompts.
+
+2012-03-25 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Fringes): Note that fringes are shown on graphical
+ displays only.
+ (Fringe Size/Pos, Fringe Bitmaps, Making Buttons): Clarifications.
+ (Replacing Specs): Clarify example.
+ (Manipulating Buttons): Note that button-at can return a marker.
+ (Buttons): Minor rewrite.
+ (Character Display): New node. Consolidate all character display
+ related nodes into its subsections.
+ (Usual Display): Character 127 is also affected by ctl-arrow.
+ (Display Tables): Improve example.
+
+2012-03-22 Glenn Morris <rgm@gnu.org>
+
+ * strings.texi (Text Comparison): Mention string-prefix-p.
+
+2012-03-21 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (The Echo Area): Add xref to Output Streams.
+ (Displaying Messages): Improve doc of message.
+ (Echo Area Customization, Invisible Text): Copyedits.
+ (Invisible Text): Mention that spec comparison is done with eq.
+ (Width): Improve doc of char-width.
+ (Faces): Recommend using symbol instead of string for face name.
+ Minor clarifications.
+ (Defining Faces): Copyedits. Update face example.
+ (Attribute Functions): Mark set-face-foreground etc as commands.
+ (Face Remapping): Mention text-scale-adjust. Clarify
+ face-remapping-alist and related docs.
+ (Face Functions): Don't document make-face or copy-face.
+
+2012-03-20 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Forcing Redisplay): Various rewrites to reflect
+ new value of redisplay-dont-pause.
+ (Truncation): Copyedits.
+
+2012-03-20 Glenn Morris <rgm@gnu.org>
+
+ * os.texi (Startup Summary): Don't mention initial-buffer-choice = t.
+ Add summary table of some relevant command-line options.
+
+2012-03-18 Chong Yidong <cyd@gnu.org>
+
+ * internals.texi (Building Emacs, Garbage Collection): Copyedits.
+ (Writing Emacs Primitives): Re-organize discussion of functions
+ with variable Lisp arguments are handled. Delete an obsolete
+ remark, previously tagged as FIXME.
+
+ * os.texi (Idle Timers): Minor clarification.
+ (Idle Timers): Link to Time of Day for description of time list.
+
+2012-03-18 Glenn Morris <rgm@gnu.org>
+
+ * os.texi (System Interface): Flow control was removed.
+ (Startup Summary): General update.
+ (Init File): Don't mention compiling it.
+
+2012-03-17 Chong Yidong <cyd@gnu.org>
+
+ * os.texi (Startup Summary): Mention package loading.
+ (Init File): Don't refer to .emacs in section title. Copyedits.
+ (Terminal-Specific): Give a realistic example.
+ (Command-Line Arguments): Reference Entering Emacs instead of
+ repeating the spiel about not restarting Emacs.
+ (Time of Day): Discuss time representation at beginning of node.
+ (Sound Output): Copyedits.
+
+ * package.texi (Packaging Basics): Document package-initialize.
+
+2012-03-17 Eli Zaretskii <eliz@gnu.org>
+
+ * frames.texi (Initial Parameters): Add an index entry for
+ minibuffer-only frame.
+
+2012-03-16 Glenn Morris <rgm@gnu.org>
+
+ * modes.texi (Major Mode Conventions): Mention the strange
+ relationship between View mode and special modes. (Bug#10650)
+
+2012-03-11 Chong Yidong <cyd@gnu.org>
+
+ * windows.texi (Window Configurations): save-window-excursion is
+ now a macro.
+
+ * display.texi (Temporary Displays): with-output-to-temp-buffer is
+ now a macro.
+
+ * text.texi (Fields): Minor copyedit.
+
+2012-03-10 Eli Zaretskii <eliz@gnu.org>
+
+ * strings.texi (String Basics):
+ * sequences.texi (Sequence Functions): Mention that `length' is
+ not appropriate for computing the string width on display; add a
+ cross-reference to the description of `string-width'. (Bug#10978)
+
+ * eval.texi (Autoloading): Minor change of wording.
+
+2012-03-10 Chong Yidong <cyd@gnu.org>
+
+ * loading.texi (Autoload): Explicitly state which forms are
+ processed specially (Bug#7783).
+
+ * keymaps.texi (Mouse Menus): Describe non-toolkit behavior as the
+ non-default situation. Describe one-submenu exception (Bug#7695).
+
+ * nonascii.texi (Character Properties): Copyedits.
+
+2012-03-08 Chong Yidong <cyd@gnu.org>
+
+ * text.texi (Mode-Specific Indent): Document new behavior of
+ indent-for-tab-command. Document tab-always-indent.
+ (Special Properties): Copyedits.
+ (Checksum/Hash): Improve secure-hash doc. Do not recommend MD5.
+ (Parsing HTML/XML): Rename from Parsing HTML. Update doc of
+ libxml-parse-html-region.
+
+2012-03-07 Glenn Morris <rgm@gnu.org>
+
+ * markers.texi (The Region): Briefly mention use-empty-active-region
+ and region-active-p.
+ (Overview of Markers): Reword garbage collection, add cross-ref.
+ (The Mark): Tiny clarification re command loop and activate-mark-hook.
+
+2012-03-07 Chong Yidong <cyd@gnu.org>
+
+ * text.texi (Buffer Contents): Don't duplicate explanation of
+ region arguments from Text node. Put doc of obsolete var
+ buffer-substring-filters back, since it is referred to.
+ (Low-Level Kill Ring): Yank now uses clipboard instead of primary
+ selection by default.
+
+ * markers.texi (The Mark): Fix typo.
+ (The Region): Copyedits.
+
+2012-03-07 Glenn Morris <rgm@gnu.org>
+
+ * markers.texi (Overview of Markers): Copyedits.
+ (Creating Markers): Update approximate example buffer size.
+ (The Mark): Don't mention uninteresting return values.
+
+2012-03-05 Chong Yidong <cyd@gnu.org>
+
+ * positions.texi (Text Lines): Document count-words.
+
+2012-03-04 Chong Yidong <cyd@gnu.org>
+
+ * frames.texi (Frames): Remove little-used "terminal frame" and
+ "window frame" terminology.
+ (Frame Parameters, Font and Color Parameters, Initial Parameters)
+ (Size and Position, Visibility of Frames): Callers changed.
+ (Frames): Clarify which terminals in framep are graphical.
+ (Initial Parameters): --geometry is not the only option which adds
+ to initial-frame-alist.
+ (Position Parameters): Note that icon-left and icon-top are for
+ old window managers only.
+ (Size Parameters): Sizes are in characters even on graphical
+ displays.
+ (Management Parameters): Note that window-id and outer-window-id
+ can't really be changed, and that auto-raise isn't always obeyed.
+ (Cursor Parameters): Document cursor-type explicitly.
+ (Size and Position): The aliases set-screen-height and
+ set-screen-width have been deleted.
+ (Visibility of Frames): Mention "minimization".
+
+ * os.texi (Startup Summary): Minor clarifications.
+ (Startup Summary, Suspending Emacs): Standardize on "text
+ terminal" terminology.
+
+ * windows.texi (Basic Windows, Coordinates and Windows)
+ (Coordinates and Windows):
+ * display.texi (Refresh Screen, Line Height, Face Attributes)
+ (Overlay Arrow, Beeping, Glyphless Chars): Likewise.
+
+2012-03-04 Glenn Morris <rgm@gnu.org>
+
+ * abbrevs.texi: Small copyedits throughout.
+ (Abbrev Mode): Remove this section, folding it into the top-level.
+ (Abbrev Tables): Don't mention irrelevant return values.
+ (Abbrev Expansion): Add cross-ref for wrapper hooks.
+ (Standard Abbrev Tables): Emacs Lisp mode now has its own table.
+ (Abbrev Table Properties): Update nil :regexp description.
+
+2012-03-03 Glenn Morris <rgm@gnu.org>
+
+ * internals.texi: Change @appendix section commands to @section.
+ (Building Emacs): Say less about CANNOT_DUMP platforms.
+ Replace deleted eval-at-startup with custom-initialize-delay.
+ (Pure Storage): Small changes.
+ (Memory Usage): Copyedit.
+ (Writing Emacs Primitives): Update Fcoordinates_in_window_p and For
+ example definitions. Give examples of things with non-nil
+ interactive args. Mention eval_sub. Remove old info about
+ strings and GCPRO. Mention cus-start.el.
+ (Buffer Internals, Window Internals, Process Internals):
+ Misc small updates and fixes for fields.
+
+ * tips.texi: Copyedits.
+ (Coding Conventions): Mention autoloads.
+ Combine partially duplicated macro items. Fix xref.
+ Refer to Library Headers for copyright notice.
+ (Programming Tips): edit-options is long-obsolete.
+ (Compilation Tips): Mention loading bytecomp for byte-compile props.
+ (Warning Tips): Mention declare-function.
+ (Documentation Tips): Remove old info.
+ (Comment Tips): Mention comment-dwim, not indent-for-comment.
+ (Library Headers): General update.
+
+2012-03-02 Glenn Morris <rgm@gnu.org>
+
+ * backups.texi (Reverting): Un-duplicate revert-buffer-in-progress-p,
+ and relocate entry. Mention buffer-stale-function.
+
+ * elisp.texi, vol1.texi, vol2.texi: Standardize some menu entries.
+
+ * hooks.texi (Standard Hooks): General update.
+ Put related hooks together. Add and remove items.
+ * commands.texi (Keyboard Macros): Remove cross-ref to Standard Hooks.
+ * modes.texi (Hooks): Tweak cross-ref description.
+
+2012-03-01 Michael Albinus <michael.albinus@gmx.de>
+
+ * files.texi (Kinds of Files): The return value of file-equal-p is
+ unspecified, if FILE1 or FILE2 does not exist.
+
+2012-03-01 Glenn Morris <rgm@gnu.org>
+
+ * hooks.texi (Standard Hooks): Remove mode-specific hooks.
+
+ * maps.texi (Standard Keymaps): General update.
+ Remove mode-specific maps, talk about the more general keymaps.
+ * help.texi (Help Functions): Add vindex for Helper-help-map.
+ * keymaps.texi (Active Keymaps): Minor rephrasing.
+
+2012-02-29 Glenn Morris <rgm@gnu.org>
+
+ * elisp.texi, vol1.texi, vol2.texi: Use "" quotes in menus.
+
+2012-02-28 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * files.texi (Kinds of Files): Rename files-equal-p to file-equal-p.
+ Update changed behavior of file-subdir-of-p.
+
+2012-02-28 Glenn Morris <rgm@gnu.org>
+
+ * advice.texi, anti.texi, display.texi, elisp.texi:
+ * processes.texi, variables.texi, vol1.texi, vol2.texi:
+ Standardize possessive apostrophe usage.
+
+ * locals.texi: Remove file.
+ * elisp.texi, vol1.texi, vol2.texi: Don't include locals.texi.
+ Remove menu entry.
+ * errors.texi, maps.texi: Adjust node pointers.
+ * internals.texi (Buffer Internals): Remove cross-refs to locals.texi.
+ * makefile.w32-in (srcs):
+ * Makefile.in (srcs): Remove locals.texi.
+
+ * frames.texi (Mouse Position): Fix cross-ref.
+
+2012-02-27 Chong Yidong <cyd@gnu.org>
+
+ * buffers.texi (Creating Buffers): Clarify that
+ generate-new-buffer uses generate-new-buffer-names.
+ (Killing Buffers): Remove bogus example duplicating buffer-live-p.
+
+ * files.texi (Directory Names): Index entry for file name abbreviations.
+ (Relative File Names, File Name Expansion): Refer to it.
+ (Locating Files): Move locate-user-emacs-file documentation to
+ Standard File Names.
+ (Standard File Names): Add locate-user-emacs-file; update examples.
+
+2012-02-26 Michael Albinus <michael.albinus@gmx.de>
+
+ * files.texi (Magic File Names): Add files-equal-p and file-subdir-of-p.
+
+2012-02-26 Chong Yidong <cyd@gnu.org>
+
+ * files.texi (Kinds of Files): Improve documentation of
+ files-equal-p and file-subdir-of-p.
+
+2012-02-26 Glenn Morris <rgm@gnu.org>
+
+ * intro.texi (Acknowledgements): Small changes.
+
+2012-02-25 Glenn Morris <rgm@gnu.org>
+
+ * errors.texi: Don't try to list _all_ the error symbols.
+ Add circular-list, cl-assertion-failed, compression-error.
+ * elisp.texi, vol1.texi, vol2.texi:
+ * control.texi (Error Symbols): Tweak "Standard Errors" description.
+
+2012-02-25 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * files.texi (files-equal-p, file-subdir-of-p): New,
+ add initial documentation.
+
+2012-02-25 Chong Yidong <cyd@gnu.org>
+
+ * files.texi (File Attributes): Document file-selinux-context.
+ (Changing Files): Link to it.
+ (Changing Files): Document set-file-selinux-context.
+
+ * backups.texi (Making Backups): Return value of backup-buffer is
+ changed. Mention default value of backup-directory-alist.
+ (Rename or Copy): Note that backup-by-copying-when-mismatch is t.
+ (Auto-Saving): New minor mode behavior for auto-save-mode.
+ (Reverting): Add defvar for revert-buffer-in-progress-p.
+
+ * searching.texi (Regexp Backslash): Add index entry (Bug#10869).
+
+2012-02-24 Glenn Morris <rgm@gnu.org>
+
+ * errors.texi (Standard Errors): Mention dbus-error.
+ For arith-error sub-classes, just use one cross-ref.
+
+2012-02-23 Alan Mackenzie <acm@muc.de>
+
+ * modes.texi (Defining Minor Modes): Document the new keyword
+ :after-hook.
+
+2012-02-21 Chong Yidong <cyd@gnu.org>
+
+ * files.texi (Files): Mention magic file names as arguments.
+ (Reading from Files): Copyedits.
+ (File Attributes): Mention how to change file modes.
+ (Changing Files): Use standard "file permissions" terminology.
+ Add xref to File Attributes node.
+ (Locating Files): Document locate-user-emacs-file.
+ (Unique File Names): Recommend against using make-temp-name.
+
+2012-02-19 Chong Yidong <cyd@gnu.org>
+
+ * help.texi (Documentation, Documentation Basics, Help Functions):
+ Minor clarifications.
+ (Accessing Documentation): Clarify what documentation-property is
+ for. Add xref to Keys in Documentation.
+
+ * tips.texi (Documentation Tips): Don't recommend using * in
+ docstrings.
+
+ * macros.texi (Defining Macros):
+ * modes.texi (Derived Modes): Say "documentation string" instead
+ of docstring.
+
+2012-02-18 Chong Yidong <cyd@gnu.org>
+
+ * modes.texi (Tabulated List Mode): New node.
+ (Basic Major Modes): Add xref to it.
+
+ * processes.texi (Process Information): Mention Process Menu mode.
+
+2012-02-17 Chong Yidong <cyd@gnu.org>
+
+ * syntax.texi (Motion via Parsing): Doc fix for scan-lists.
+
+2012-02-17 Glenn Morris <rgm@gnu.org>
+
+ * hooks.texi (Standard Hooks): Fix cross-ref to Emacs manual.
+
+2012-02-16 Chong Yidong <cyd@gnu.org>
+
+ * syntax.texi (Syntax Tables, Syntax Descriptors)
+ (Syntax Table Functions): Copyedits.
+ (Syntax Basics): Don't repeat the material in the preceding node.
+ (Syntax Class Table): Use a table.
+ (Syntax Properties): Document syntax-propertize-function and
+ syntax-propertize-extend-region-functions.
+ (Motion via Parsing): Clarify scan-lists. Fix indentation.
+ (Parser State): Update for the new "c" comment style. Fix
+ description of item 7 (comment style).
+
+ * modes.texi (Minor Modes): Update how mode commands should treat
+ arguments now.
+ (Mode Line Basics): Clarify force-mode-line-update.
+ (Mode Line Top): Note that the example is not realistic.
+ (Mode Line Variables, Mode Line Data, %-Constructs, Header Lines)
+ (Emulating Mode Line): Use "mode line" instead of "mode-line", and
+ "mode line construct" instead of "mode line specification".
+ (Syntactic Font Lock): Remove mention of obsolete variable
+ font-lock-syntactic-keywords.
+ (Setting Syntax Properties): Node deleted.
+ (Font Lock Mode): Note that Font Lock mode is a minor mode.
+ (Font Lock Basics): Note that syntactic fontification falls back
+ on `syntax-table'.
+ (Search-based Fontification): Emphasize that font-lock-keywords
+ should not be set directly.
+ (Faces for Font Lock): Avoid some confusing terminology.
+ (Syntactic Font Lock): Minor clarifications. Add xref to
+ Syntactic Font Lock node.
+
+2012-02-15 Chong Yidong <cyd@gnu.org>
+
+ * minibuf.texi (Basic Completion): Define "completion table".
+ Move completion-in-region to Completion in Buffers node.
+ (Completion Commands): Use "completion table" terminology.
+ (Completion in Buffers): New node.
+
+ * modes.texi (Hooks): add-hook can be used for abnormal hooks too.
+ (Setting Hooks): Update minor mode usage example.
+ (Major Mode Conventions): Note that completion-at-point-functions
+ should be altered locally. Add xref to Completion in Buffers.
+ Remove duplicate tip about auto-mode-alist.
+ (Minor Modes): Rewrite introduction.
+ (Minor Mode Conventions): Copyedits. Don't recommend
+ variable-only minor modes since few minor modes are like that.
+
+2012-02-15 Glenn Morris <rgm@gnu.org>
+
+ * processes.texi (Network): Document open-network-stream :parameters.
+
+2012-02-14 Chong Yidong <cyd@gnu.org>
+
+ * keymaps.texi (Format of Keymaps): The CACHE component of keymaps
+ was removed on 2009-09-10. Update lisp-mode-map example.
+ (Inheritance and Keymaps): Minor clarification.
+ (Searching Keymaps): Remove out-of-place enumeration.
+ (Key Lookup): Remove unnecessary example (one was already given in
+ Format of Keymaps).
+ (Changing Key Bindings): Update suppress-keymap example.
+ (Menu Bar, Tool Bar): Copyedits.
+ (Tool Bar): Update tool-bar-map example.
+
+2012-02-12 Chong Yidong <cyd@gnu.org>
+
+ * debugging.texi (Debugger Commands): Continuing is now allowed
+ for errors.
+
+2012-02-11 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Fringe Indicators): Add xref to Fringe Bitmaps.
+ Move the list of standard bitmaps there.
+ (Fringe Cursors): Rewrite for clarity.
+ (Fringe Bitmaps): Consolidate the list of standard bitmaps here.
+
+ * commands.texi (Command Overview): Mention read-key.
+ (Using Interactive, Interactive Call): Minor clarifications.
+ (Function Keys, Click Events): Avoid "input stream" terminology.
+ (Click Events): Add xref to Window Sizes and Accessing Mouse.
+ Clarify column and row components.
+ (Accessing Mouse): Add xref to Click Events. Minor fixes.
+ (Special Events): Copyedits.
+
+ * streams.texi (Input Streams): De-document get-file-char.
+ (Output Variables): Don't refer to old backquote syntax.
+
+ * debugging.texi (Debugging): Copyedits. Describe testcover, ERT.
+ (Error Debugging): Note that debug-ignored-errors overrides list
+ values of debug-on-error too. Add xref to Signaling Errors. Note
+ that debug-on-signal is not customizable. Mention
+ condition-case-unless-debug.
+ (Compilation Errors): Node deleted.
+
+ * compile.texi (Compiler Errors): Move a paragraph here from
+ deleted node Compilation Errors.
+
+2012-02-10 Leo Liu <sdl.web@gmail.com>
+
+ * control.texi (Handling Errors): Change condition-case-no-debug
+ to condition-case-unless-debug.
+
+2012-02-10 Chong Yidong <cyd@gnu.org>
+
+ * advice.texi (Defining Advice): Clarify ad-unadvise.
+ (Activation of Advice): Specifying the ACTIVATE flag in defadvice
+ is not abnormal.
+ (Advising Primitives): Node deleted; ad-define-subr-args has been
+ removed.
+
+ * compile.texi (Speed of Byte-Code): Use float-time in example.
+ (Compilation Functions): Note that the log uses Compilation mode.
+ Don't discuss the contents of byte-code function object here.
+ (Compilation Functions): De-document internal function byte-code.
+ (Docs and Compilation): Minor clarifications.
+
+ * objects.texi (Byte-Code Type): Add xref to Byte-Code Function
+ Objects.
+
+2012-02-10 Glenn Morris <rgm@gnu.org>
+
+ * text.texi (Checksum/Hash): Rename node from MD5 Checksum.
+ Mention secure-hash.
+ * elisp.texi, vol1.texi, vol2.texi: Update menu entry.
+
+2012-02-10 Chong Yidong <cyd@gnu.org>
+
+ * loading.texi (Loading): Don't emphasize "library" terminology.
+ (Library Search): load-path is not a user option. Mention role of
+ -L option and packages. Improve examples.
+ (Loading Non-ASCII): Don't mention unibyte Emacs, which is
+ obsolete.
+ (Autoload): Minor clarifications.
+
+2012-02-10 Glenn Morris <rgm@gnu.org>
+
+ * files.texi (Magic File Names): Tweak remote-file-name-inhibit-cache.
+
+ * modes.texi (Basic Major Modes): Mention tabulated-list-mode.
+
+2012-02-08 Glenn Morris <rgm@gnu.org>
+
+ * loading.texi (Named Features): Update the require example.
+
+2012-02-07 Glenn Morris <rgm@gnu.org>
+
+ * modes.texi (Defining Minor Modes):
+ Expand on args of defined minor modes.
+
+2012-02-07 Chong Yidong <cyd@gnu.org>
+
+ * variables.texi (Creating Buffer-Local): Minor clarification
+ to buffer-local-variables doc (Bug#10715).
+
+2012-02-07 Glenn Morris <rgm@gnu.org>
+
+ * display.texi (ImageMagick Images): General update.
+ Move most details of imagemagick-render-type to the variable's doc.
+
+2012-02-06 Glenn Morris <rgm@gnu.org>
+
+ * keymaps.texi (Tool Bar): Mention separators.
+ (Inheritance and Keymaps):
+ Mention make-composed-keymap and multiple inheritance.
+
+ * modes.texi (Running Hooks): Mention run-hook-wrapped.
+
+ * control.texi (Handling Errors):
+ Mention condition-case-no-debug and with-demoted-errors.
+
+2012-02-05 Chong Yidong <cyd@gnu.org>
+
+ * customize.texi (Common Keywords): Minor clarifications.
+ Document custom-unlispify-remove-prefixes.
+ (Variable Definitions): Backquotes in defcustom seem to work fine
+ now. Various other copyedits.
+ (Simple Types): Copyedits. Document color selector.
+ (Composite Types): Copyedits.
+ (Splicing into Lists): Clarifications.
+
+ * eval.texi (Backquote): Move from macros.texi.
+
+ * macros.texi (Expansion): Minor clarification.
+ (Backquote): Move node to eval.texi.
+ (Defining Macros): Move an example from Backquote node.
+ (Argument Evaluation): No need to mention Pascal.
+ (Indenting Macros): Add xref to Defining Macros.
+
+2012-02-05 Glenn Morris <rgm@gnu.org>
+
+ * debugging.texi (Error Debugging): Mention debug-on-event default.
+
+2012-02-04 Glenn Morris <rgm@gnu.org>
+
+ * backups.texi (Reverting): Mention revert-buffer-in-progress-p.
+
+ * debugging.texi (Error Debugging): Mention debug-on-event.
+ * commands.texi (Misc Events): Mention sigusr1,2 and debugging.
+
+ * modes.texi (Running Hooks): Try to clarify with-wrapper-hook.
+
+ * text.texi (Buffer Contents):
+ Update filter-buffer-substring description.
+
+2012-02-04 Chong Yidong <cyd@gnu.org>
+
+ * functions.texi (What Is a Function): Add closures. Mention
+ "return value" terminology. Add xref for command-execute. Remove
+ unused "keystroke command" terminology.
+ (Lambda Expressions): Give a different example than in the
+ following subsection. Add xref to Anonymous Functions.
+ (Function Documentation): Remove gratuitous markup.
+ (Function Names): Move introductory text to `What Is a Function'.
+ (Defining Functions): Fix defun argument spec.
+ (Anonymous Functions): Document lambda macro explicitly. Mention
+ effects on lexical binding.
+ (Function Cells): Downplay direct usage of fset.
+ (Closures): New node.
+ (Inline Functions): Remove "open-code" terminology.
+ (Declaring Functions): Minor tweak; .m is not C code.
+
+ * variables.texi (Variables): Don't refer to "global value".
+ (Local Variables, Void Variables): Copyedits.
+ (Lexical Binding): Minor clarification of example.
+ (File Local Variables): Mention :safe and :risky defcustom args.
+ (Lexical Binding): Add xref to Closures node.
+
+2012-02-04 Glenn Morris <rgm@gnu.org>
+
+ * minibuf.texi (High-Level Completion): Updates for read-color.
+
+2012-02-03 Glenn Morris <rgm@gnu.org>
+
+ * display.texi (GIF Images): Mention animation.
+ Remove commented-out old example of animation.
+ (Animated Images): New subsection.
+ * elisp.texi (Top):
+ * vol1.texi (Top):
+ * vol2.texi (Top): Add Animated Images menu entry.
+
+ * display.texi (Image Formats): Remove oddly specific information
+ on versions of image libraries.
+ (GIF Images, TIFF Images): Minor rephrasing.
+
+2012-02-02 Glenn Morris <rgm@gnu.org>
+
+ * processes.texi (Synchronous Processes):
+ Mention call-process's :file gets overwritten.
+
+ * commands.texi (Reading One Event):
+ * help.texi (Help Functions): Document read-char-choice.
+
+ * hooks.texi (Standard Hooks):
+ * modes.texi (Keymaps and Minor Modes):
+ * text.texi (Commands for Insertion): Document post-self-insert-hook.
+
+ * hooks.texi (Standard Hooks): Add prog-mode-hook.
+
+ * hooks.texi (Standard Hooks):
+ * modes.texi (Major Mode Conventions, Mode Hooks):
+ Document change-major-mode-after-body-hook.
+
+2012-02-01 Glenn Morris <rgm@gnu.org>
+
+ * modes.texi (Defining Minor Modes):
+ Mention disabling global minor modes on a per-major-mode basis.
+
+2012-01-31 Chong Yidong <cyd@gnu.org>
+
+ * syntax.texi (Parsing Expressions): Clarify intro (Bug#10657).
+ (Parser State): Remove unnecessary statement (Bug#10661).
+
+ * eval.texi (Intro Eval): Add footnote about "sexp" terminology.
+
+2012-01-31 Glenn Morris <rgm@gnu.org>
+
+ * modes.texi (Defining Minor Modes):
+ Document define-minor-mode's new :variable keyword.
+
+2012-01-29 Chong Yidong <cyd@gnu.org>
+
+ * syntax.texi (Syntax Class Table): Tweak description of newline
+ char syntax (Bug#9619).
+
+ * numbers.texi (Predicates on Numbers): Fix wholenump/natnump
+ description (Bug#10189).
+
+2012-01-29 Glenn Morris <rgm@gnu.org>
+
+ * files.texi (Changing Files): Document SELinux support.
+
+ * windows.texi (Window Sizes): Fix typo.
+
+2012-01-28 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Fringe Indicators): Clarify fringe-indicator-alist
+ doc (Bug#8568).
+
+ * frames.texi (Input Focus): Add NORECORD arg to
+ select-frame-set-input-focus. Clarify its role in select-frame.
+
+ * text.texi (Transposition): We don't use transpose-region as an
+ internal subroutine (Bug#3249).
+
+ * modes.texi (Example Major Modes): Update Lisp example code to
+ current sources. Delete the old non-derived-major-mode example,
+ which has diverged badly from current sources.
+
+2012-01-27 Glenn Morris <rgm@gnu.org>
+
+ * makefile.w32-in (texinputdir): Fix (presumed) typo.
+ (VERSION, manual): Remove, unused.
+
+2012-01-27 Chong Yidong <cyd@gnu.org>
+
+ * commands.texi (Command Overview): Minor clarification (Bug#10384).
+
+2012-01-26 Chong Yidong <cyd@gnu.org>
+
+ * searching.texi (String Search): Document negative repeat count
+ (Bug#10507).
+
+2012-01-26 Glenn Morris <rgm@gnu.org>
+
+ * variables.texi (Using Lexical Binding):
+ Mention that lexical-binding should be set in the first line.
+
+2012-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * macros.texi (Defining Macros): Don't claim that `declare' only
+ affects Edebug and indentation.
+
+2012-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * macros.texi (Defining Macros): Slight `declare' fixup.
+
+2012-01-25 Glenn Morris <rgm@gnu.org>
+
+ * makefile.w32-in (texinputdir):
+ * Makefile.in (ENVADD): Add $emacsdir. (Bug#10603)
+
+2012-01-24 Chong Yidong <cyd@gnu.org>
+
+ * variables.texi (Variables, Local Variables, Void Variables):
+ Edit to make the descriptions less specific to dynamic binding.
+ (Local Variables): Default max-specpdl-size is now 1300.
+ (Defining Variables): Edits for lexical scoping. Delete
+ information about starting docstrings with *. De-document
+ user-variable-p.
+ (Tips for Defining): Remove an unimportant discussion of quitting
+ in the middle of a load.
+ (Accessing Variables, Setting Variables): Discuss lexical binding.
+ (Variable Scoping): Rewrite.
+ (Scope, Extent, Impl of Scope): Nodes deleted.
+ (Dynamic Binding): New node, with material from Scope, Extent, and
+ Impl of Scope nodes.
+ (Dynamic Binding Tips): Rename from Using Scoping.
+ (Lexical Binding): Rewrite.
+ (Using Lexical Binding): Rename from Converting to Lexical
+ Binding. Convert to subsection.
+
+ * customize.texi (Variable Definitions): Add custom-variable-p.
+ Move user-variable-p documentation here.
+
+2012-01-23 Chong Yidong <cyd@gnu.org>
+
+ * strings.texi (Text Comparison): Minor qualification.
+
+ * lists.texi (Cons Cells): Copyedits.
+ (List Elements): Mention push.
+ (List Variables): Mention pop.
+ (Rings): Move to sequences.texi.
+
+ * sequences.texi (Sequence Functions): Don't repeat the
+ introduction already given in the parent.
+ (Vectors): Copyedits.
+ (Rings): Move from lists.texi. Note that this is specific to the
+ ring package.
+
+ * symbols.texi (Definitions, Symbol Components): Mention variable
+ scoping issues.
+ (Plists and Alists): Copyedits.
+
+ * eval.texi (Intro Eval, Symbol Forms): Minor tweaks for
+ correctness with lexical scoping.
+ (Eval): Copyedits.
+
+2012-01-21 Chong Yidong <cyd@gnu.org>
+
+ * intro.texi (A Sample Function Description): Special notation
+ used for macros too.
+
+ * objects.texi (Ctl-Char Syntax, Other Char Bits): Copyedits.
+ (Symbol Type): Add xref for keyword symbols.
+ (Sequence Type): Clarify differences between sequence types.
+ (Cons Cell Type): Add "linked list" index entry.
+ (Non-ASCII in Strings): Copyedits.
+ (Equality Predicates): Symbols with same name need not be eq.
+
+ * numbers.texi (Float Basics): Document isnan, copysign, frexp and
+ ldexp. Move float-e and float-pi to Math Functions node.
+
+2012-01-21 Glenn Morris <rgm@gnu.org>
+
+ * modes.texi (Auto Major Mode):
+ * variables.texi (File Local Variables):
+ Mention inhibit-local-variables-regexps.
+
+2012-01-19 Martin Rudalics <rudalics@gmx.at>
+
+ * windows.texi (Window Configurations): Rewrite references to
+ persistent window parameters.
+ (Window Parameters): Fix description of persistent window
+ parameters.
+
+2012-01-16 Juanma Barranquero <lekktu@gmail.com>
+
+ * windows.texi (Window Parameters): Use @pxref.
+
+2012-01-16 Martin Rudalics <rudalics@gmx.at>
+
+ * windows.texi (Window Configurations, Window Parameters):
+ Describe persistent window parameters.
+
+2011-12-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * variables.texi (Creating Buffer-Local): Warn against misuses of
+ make-variable-buffer-local (bug#10258).
+
+2012-01-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * macros.texi (Defining Macros): Document `doc-string' (bug#9668).
+
+2012-01-06 Chong Yidong <cyd@gnu.org>
+
+ * variables.texi (Directory Local Variables): Document
+ hack-dir-local-variables-non-file-buffer.
+
+2012-01-06 Glenn Morris <rgm@gnu.org>
+
+ * maps.texi (Standard Keymaps): Refer to Info-edit by name
+ rather than by keybinding.
+
+2011-12-29 Juanma Barranquero <lekktu@gmail.com>
+
+ * frames.texi (Font and Color Parameters): Add @pxref.
+
+2011-12-29 Daniel Colascione <dan.colascione@gmail.com>
+
+ * frames.texi (Font and Color Parameters):
+ Document w32 font backends (bug#10399).
+
+2011-12-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ * files.texi (File Attributes, Changing Files):
+ Use a more-natural notation for octal numbers.
+
2011-12-23 Juanma Barranquero <lekktu@gmail.com>
* variables.texi (Variables with Restricted Values):
@@ -303,7 +2313,7 @@
* numbers.texi (Integer Basics): Add indexing for
most-positive-fixnum and most-negative-fixnum. (Bug#9525)
-2011-09-14 Dani Moncayo <dmoncayo@gmail.com> (tiny change)
+2011-09-14 Dani Moncayo <dmoncayo@gmail.com>
* lists.texi (Sets And Lists): Fix typo. (Bug#9393)
@@ -312,7 +2322,7 @@
* processes.texi (Network Servers): Clarify what the process
buffer is used for (bug#9233).
-2011-08-30 Dani Moncayo <dmoncayo@gmail.com> (tiny change)
+2011-08-30 Dani Moncayo <dmoncayo@gmail.com>
* lists.texi (Building Lists): Fix typo.
@@ -2562,7 +4572,7 @@
* functions.texi (Function Safety): Texinfo usage fix.
-2009-01-04 Eduard Wiebe <usenet@pusto.de> (tiny patch)
+2009-01-04 Eduard Wiebe <usenet@pusto.de> (tiny change)
* objects.texi (General Escape Syntax): Fix typo.
@@ -9473,8 +11483,8 @@
(Recording Input): Document that clear-this-command-keys clears
the vector to be returned by recent-keys.
- * keymaps.texi (Scanning Keymaps) <where-is-internal>: The
- argument keymap can be a list.
+ * keymaps.texi (Scanning Keymaps) <where-is-internal>:
+ The argument keymap can be a list.
* nonascii.texi (User-Chosen Coding Systems)
<select-safe-coding-system>: Document the new argument
@@ -9719,7 +11729,7 @@
* Makefile (dist): Don't bother excluding autosave files; they'll
never make it into the temp directory anyway, and the hash marks
in the name are problematic for make and the Bourne shell.
- (srcs):
+ (srcs): ???
1993-02-12 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
@@ -9794,7 +11804,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1998-2011 Free Software Foundation, Inc.
+ Copyright (C) 1998-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in
index 75fa884224b..32a241e2a2d 100644
--- a/doc/lispref/Makefile.in
+++ b/doc/lispref/Makefile.in
@@ -1,6 +1,6 @@
# Makefile for the GNU Emacs Lisp Reference Manual.
-# Copyright (C) 1990-1996, 1998-2011 Free Software Foundation, Inc.
+# Copyright (C) 1990-1996, 1998-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -24,19 +24,25 @@ srcdir = @srcdir@
version=@version@
-infodir = $(srcdir)/../../info
+buildinfodir = $(srcdir)/../../info
# Directory with the (customized) texinfo.tex file.
texinfodir = $(srcdir)/../misc
# Directory with emacsver.texi.
emacsdir = $(srcdir)/../emacs
+MKDIR_P = @MKDIR_P@
+
+INFO_EXT=@INFO_EXT@
+# Options used only when making info output.
+INFO_OPTS=@INFO_OPTS@
+
MAKEINFO = @MAKEINFO@
MAKEINFO_OPTS = --force --enable-encoding -I $(emacsdir) -I $(srcdir)
TEXI2DVI = texi2dvi
TEXI2PDF = texi2pdf
DVIPS = dvips
-ENVADD = TEXINPUTS="$(srcdir):$(texinfodir):$(TEXINPUTS)" \
+ENVADD = TEXINPUTS="$(srcdir):$(texinfodir):$(emacsdir):$(TEXINPUTS)" \
MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)"
# List of all the texinfo files in the manual:
@@ -47,7 +53,6 @@ srcs = \
$(srcdir)/abbrevs.texi \
$(srcdir)/advice.texi \
$(srcdir)/anti.texi \
- $(srcdir)/back.texi \
$(srcdir)/backups.texi \
$(srcdir)/buffers.texi \
$(srcdir)/commands.texi \
@@ -70,7 +75,6 @@ srcs = \
$(srcdir)/keymaps.texi \
$(srcdir)/lists.texi \
$(srcdir)/loading.texi \
- $(srcdir)/locals.texi \
$(srcdir)/macros.texi \
$(srcdir)/maps.texi \
$(srcdir)/markers.texi \
@@ -97,31 +101,32 @@ srcs = \
$(srcdir)/gpl.texi \
$(srcdir)/doclicense.texi
-mkinfodir = @test -d ${infodir} || mkdir ${infodir} || test -d ${infodir}
+mkinfodir = @${MKDIR_P} ${buildinfodir}
.PHONY: info dvi pdf ps
-info: $(infodir)/elisp
+info: $(buildinfodir)/elisp$(INFO_EXT)
dvi: elisp.dvi
html: elisp.html
pdf: elisp.pdf
ps: elisp.ps
-$(infodir)/elisp: $(srcs)
+## Note: "<" is not portable in ordinary make rules.
+$(buildinfodir)/elisp$(INFO_EXT): $(srcs)
$(mkinfodir)
- $(MAKEINFO) $(MAKEINFO_OPTS) -o $@ $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ $(srcdir)/elisp.texi
elisp.dvi: $(srcs)
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) $(srcdir)/elisp.texi
elisp.html: $(srcs)
- $(MAKEINFO) $(MAKEINFO_OPTS) --html -o $@ $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) --html -o $@ $(srcdir)/elisp.texi
elisp.ps: elisp.dvi
- $(DVIPS) -o $@ $<
+ $(DVIPS) -o $@ elisp.dvi
elisp.pdf: $(srcs)
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) $(srcdir)/elisp.texi
.PHONY: mostlyclean clean distclean maintainer-clean infoclean
@@ -129,17 +134,18 @@ elisp.pdf: $(srcs)
mostlyclean:
rm -f *.aux *.log *.toc *.cp *.cps *.fn *.fns *.ky *.kys \
*.op *.ops *.pg *.pgs *.tp *.tps *.vr *.vrs
- rm -f elisp[12]*
+ rm -f elisp[12]* vol[12].tmp
clean: mostlyclean
- rm -f elisp.dvi elisp.pdf elisp.ps vol[12].pdf
+ rm -f elisp.dvi elisp.pdf elisp.ps
+ rm -f vol[12].dvi vol[12].pdf vol[12].ps
rm -rf elisp.html
rm -f emacs-lispref-${version}.tar*
distclean: clean
infoclean:
- -cd $(infodir) && rm -f elisp elisp-[1-9] elisp-[1-9][0-9]
+ -cd $(buildinfodir) && rm -f elisp$(INFO_EXT) elisp$(INFO_EXT)-[1-9] elisp$(INFO_EXT)-[1-9][0-9]
maintainer-clean: distclean infoclean
@@ -154,7 +160,8 @@ dist:
${srcdir}/README emacs-lispref-${version}/
sed -e 's/@sr[c]dir@/./' -e 's/^\(texinfodir *=\).*/\1 ./' \
-e 's/^\(emacsdir *=\).*/\1 ./' \
- -e 's/^\(infodir *=\).*/\1 ./' -e 's/^\(clean:.*\)/\1 infoclean/' \
+ -e 's/^\(buildinfodir *=\).*/\1 ./' \
+ -e 's/^\(clean:.*\)/\1 infoclean/' \
-e "s/@ver[s]ion@/${version}/" \
${srcdir}/Makefile.in > emacs-lispref-${version}/Makefile
tar -cf emacs-lispref-${version}.tar emacs-lispref-${version}
diff --git a/doc/lispref/README b/doc/lispref/README
index a9c0922640b..0230f4718c8 100644
--- a/doc/lispref/README
+++ b/doc/lispref/README
@@ -1,37 +1,36 @@
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc. -*- outline -*-
See the end of the file for license conditions.
-README for Edition 3.0 of the Emacs Lisp Reference Manual.
+README for the Emacs Lisp Reference Manual.
* This directory contains the texinfo source files for the Emacs Lisp
Reference Manual.
-* Report bugs in the Lisp Manual or in Emacs using M-x report-emacs-bug.
-To ask questions, use the newsgroup gnu.emacs.help.
+* Report bugs in the Lisp Manual (or in Emacs) using M-x report-emacs-bug.
+To ask questions, use the help-gnu-emacs mailing list.
* The Emacs Lisp Reference Manual is quite large. It totals around
1100 pages in smallbook format; the info files total around 3.0 megabytes.
-* You can format this manual either for Info or for printing hardcopy
-using TeX.
+* You can format this manual for Info, for printing hardcopy using TeX,
+or for HTML.
* You can buy nicely printed copies from the Free Software Foundation.
Buying a manual from the Free Software Foundation helps support our GNU
development work. See <http://shop.fsf.org/>.
+(At time of writing, this manual is out of print.)
-* The master file for formatting this manual for Tex is called
-`elisp.texi'. It contains @include commands to include all the
-chapters that make up the manual. In addition, `elisp.texi' has
-the title page in a new format designed by Karl Berry, using the
-@titlespec command.
+* The master file for formatting this manual for Tex is called `elisp.texi'.
+It contains @include commands to include all the chapters that make up
+the manual.
* This distribution contains a Makefile that you can use with GNU Make.
-** To create a DVI file with a sorted index, run `make elisp.dvi'.
-
** To make an Info file, you need to install Texinfo, then run `make info'.
+** Use `make elisp.pdf' or `make elisp.html' to create PDF or HTML versions.
+
This file is part of GNU Emacs.
diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi
index 57030559d0b..65a83ef5b84 100644
--- a/doc/lispref/abbrevs.texi
+++ b/doc/lispref/abbrevs.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1994, 1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1994, 1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/abbrevs
-@node Abbrevs, Processes, Syntax Tables, Top
+@node Abbrevs
@chapter Abbrevs and Abbrev Expansion
@cindex abbrev
@c @cindex abbrev table Redundant with "abbrev".
@@ -37,14 +36,15 @@ When abbrevs are saved to an abbrev file, system abbrevs are omitted.
Because the symbols used for abbrevs are not interned in the usual
obarray, they will never appear as the result of reading a Lisp
expression; in fact, normally they are never used except by the code
-that handles abbrevs. Therefore, it is safe to use them in an
-extremely nonstandard way.
+that handles abbrevs. Therefore, it is safe to use them in a
+nonstandard way.
- For the user-level commands for abbrevs, see @ref{Abbrevs,, Abbrev
-Mode, emacs, The GNU Emacs Manual}.
+ If the minor mode Abbrev mode is enabled, the buffer-local variable
+@code{abbrev-mode} is non-@code{nil}, and abbrevs are automatically
+expanded in the buffer. For the user-level commands for abbrevs, see
+@ref{Abbrevs,, Abbrev Mode, emacs, The GNU Emacs Manual}.
@menu
-* Abbrev Mode:: Setting up Emacs for abbreviation.
* Tables: Abbrev Tables. Creating and working with abbrev tables.
* Defining Abbrevs:: Specifying abbreviations and their expansions.
* Files: Abbrev Files. Saving abbrevs in files.
@@ -56,22 +56,7 @@ Mode, emacs, The GNU Emacs Manual}.
Which properties have which effect.
@end menu
-@node Abbrev Mode, Abbrev Tables, Abbrevs, Abbrevs
-@comment node-name, next, previous, up
-@section Setting Up Abbrev Mode
-
- Abbrev mode is a minor mode controlled by the variable
-@code{abbrev-mode}.
-
-@defopt abbrev-mode
-If this variable is non-@code{nil}, abbrevs are automatically expanded
-in the buffer. If the value is @code{nil}, abbrevs may be defined,
-but they are not expanded automatically.
-
-This variable automatically becomes buffer-local when set in any fashion.
-@end defopt
-
-@node Abbrev Tables, Defining Abbrevs, Abbrev Mode, Abbrevs
+@node Abbrev Tables
@section Abbrev Tables
This section describes how to create and manipulate abbrev tables.
@@ -90,14 +75,15 @@ abbrev table.
@defun clear-abbrev-table abbrev-table
This function undefines all the abbrevs in @var{abbrev-table}, leaving
-it empty. It always returns @code{nil}.
+it empty.
+@c Don't see why this needs saying.
+@c It always returns @code{nil}.
@end defun
@defun copy-abbrev-table abbrev-table
This function returns a copy of @var{abbrev-table}---a new abbrev
-table containing the same abbrev definitions. There is one difference
-between the contents of @var{abbrev-table} and the returned copy: all
-abbrevs in the latter have their property lists set to @code{nil}.
+table containing the same abbrev definitions. It does @emph{not} copy
+any property lists; only the names, values, and functions.
@end defun
@defun define-abbrev-table tabname definitions &optional docstring &rest props
@@ -106,8 +92,7 @@ name, i.e., as a variable whose value is an abbrev table. It defines
abbrevs in the table according to @var{definitions}, a list of
elements of the form @code{(@var{abbrevname} @var{expansion}
[@var{hook}] [@var{props}...])}. These elements are passed as
-arguments to @code{define-abbrev}. The return value is always
-@code{nil}.
+arguments to @code{define-abbrev}. @c The return value is always @code{nil}.
The optional string @var{docstring} is the documentation string of the
variable @var{tabname}. The property list @var{props} is applied to
@@ -115,7 +100,7 @@ the abbrev table (@pxref{Abbrev Table Properties}).
If this function is called more than once for the same @var{tabname},
subsequent calls add the definitions in @var{definitions} to
-@var{tabname}, rather than overriding the entire original contents.
+@var{tabname}, rather than overwriting the entire original contents.
(A subsequent call only overrides abbrevs explicitly redefined or
undefined in @var{definitions}.)
@end defun
@@ -128,7 +113,7 @@ This is a list of symbols whose values are abbrev tables.
@defun insert-abbrev-table-description name &optional human
This function inserts before point a description of the abbrev table
named @var{name}. The argument @var{name} is a symbol whose value is an
-abbrev table. The return value is always @code{nil}.
+abbrev table. @c The return value is always @code{nil}.
If @var{human} is non-@code{nil}, the description is human-oriented.
System abbrevs are listed and identified as such. Otherwise the
@@ -138,15 +123,14 @@ the system abbrevs. (The mode or package using @var{name} is supposed
to add these to @var{name} separately.)
@end defun
-@node Defining Abbrevs, Abbrev Files, Abbrev Tables, Abbrevs
-@comment node-name, next, previous, up
+@node Defining Abbrevs
@section Defining Abbrevs
@code{define-abbrev} is the low-level basic function for defining an
abbrev in an abbrev table.
When a major mode defines a system abbrev, it should call
-@code{define-abbrev} and specify a @code{t} for the @code{:system}
+@code{define-abbrev} and specify @code{t} for the @code{:system}
property. Be aware that any saved non-``system'' abbrevs are restored
at startup, i.e. before some major modes are loaded. Therefore, major
modes should not assume that their abbrev tables are empty when they
@@ -177,12 +161,12 @@ property is non-@code{nil}, @var{hook} can explicitly control whether
to insert the self-inserting input character that triggered the
expansion. If @var{hook} returns non-@code{nil} in this case, that
inhibits insertion of the character. By contrast, if @var{hook}
-returns @code{nil}, @code{expand-abbrev} also returns @code{nil}, as
-if expansion had not really occurred.
+returns @code{nil}, @code{expand-abbrev} (or @code{abbrev-insert})
+also returns @code{nil}, as if expansion had not really occurred.
Normally, @code{define-abbrev} sets the variable
@code{abbrevs-changed} to @code{t}, if it actually changes the abbrev.
-(This is so that some commands will offer to save the abbrevs.) It
+This is so that some commands will offer to save the abbrevs. It
does not do this for a system abbrev, since those aren't saved anyway.
@end defun
@@ -194,7 +178,7 @@ behavior of the functions in this section; it is examined by their
callers.
@end defopt
-@node Abbrev Files, Abbrev Expansion, Defining Abbrevs, Abbrevs
+@node Abbrev Files
@section Saving Abbrevs in Files
A file of saved abbrev definitions is actually a file of Lisp code.
@@ -202,7 +186,8 @@ The abbrevs are saved in the form of a Lisp program to define the same
abbrev tables with the same contents. Therefore, you can load the file
with @code{load} (@pxref{How Programs Do Loading}). However, the
function @code{quietly-read-abbrev-file} is provided as a more
-convenient interface.
+convenient interface. Emacs automatically calls this function at
+startup.
User-level facilities such as @code{save-some-buffers} can save
abbrevs in a file automatically, under the control of variables
@@ -216,17 +201,18 @@ This is the default file name for reading and saving abbrevs.
This function reads abbrev definitions from a file named @var{filename},
previously written with @code{write-abbrev-file}. If @var{filename} is
omitted or @code{nil}, the file specified in @code{abbrev-file-name} is
-used. @code{save-abbrevs} is set to @code{t} so that changes will be
-saved.
+used.
-This function does not display any messages. It returns @code{nil}.
+As the name implies, this function does not display any messages.
+@c It returns @code{nil}.
@end defun
@defopt save-abbrevs
A non-@code{nil} value for @code{save-abbrevs} means that Emacs should
-offer the user to save abbrevs when files are saved. If the value is
-@code{silently}, Emacs saves the abbrevs without asking the user.
-@code{abbrev-file-name} specifies the file to save the abbrevs in.
+offer to save abbrevs (if any have changed) when files are saved. If
+the value is @code{silently}, Emacs saves the abbrevs without asking
+the user. @code{abbrev-file-name} specifies the file to save the
+abbrevs in.
@end defopt
@defvar abbrevs-changed
@@ -243,8 +229,7 @@ define the same abbrevs. If @var{filename} is @code{nil} or omitted,
@code{abbrev-file-name} is used. This function returns @code{nil}.
@end deffn
-@node Abbrev Expansion, Standard Abbrev Tables, Abbrev Files, Abbrevs
-@comment node-name, next, previous, up
+@node Abbrev Expansion
@section Looking Up and Expanding Abbreviations
Abbrevs are usually expanded by certain interactive commands,
@@ -254,7 +239,7 @@ use for communication.
@defun abbrev-symbol abbrev &optional table
This function returns the symbol representing the abbrev named
-@var{abbrev}. The value returned is @code{nil} if that abbrev is not
+@var{abbrev}. It returns @code{nil} if that abbrev is not
defined. The optional second argument @var{table} is the abbrev table
in which to look it up. If @var{table} is @code{nil}, this function
tries first the current buffer's local abbrev table, and second the
@@ -263,8 +248,8 @@ global abbrev table.
@defun abbrev-expansion abbrev &optional table
This function returns the string that @var{abbrev} would expand into (as
-defined by the abbrev tables used for the current buffer). If
-@var{abbrev} is not a valid abbrev, the function returns @code{nil}.
+defined by the abbrev tables used for the current buffer). It returns
+@code{nil} if @var{abbrev} is not a valid abbrev.
The optional argument @var{table} specifies the abbrev table to use,
as in @code{abbrev-symbol}.
@end defun
@@ -274,7 +259,7 @@ This command expands the abbrev before point, if any. If point does not
follow an abbrev, this command does nothing. The command returns the
abbrev symbol if it did expansion, @code{nil} otherwise.
-If the abbrev symbol has a hook function which is a symbol whose
+If the abbrev symbol has a hook function that is a symbol whose
@code{no-self-insert} property is non-@code{nil}, and if the hook
function returns @code{nil} as its value, then @code{expand-abbrev}
returns @code{nil} even though expansion did occur.
@@ -346,14 +331,14 @@ has already been unexpanded. This contains information left by
@end defvar
@defvar abbrev-expand-functions
-This is a special hook run @emph{around} the @code{expand-abbrev}
-function. Each function on this hook is called with a single
-argument: a function that performs the normal abbrev expansion. The
-hook function can hence do anything it wants before and after
-performing the expansion. It can also choose not to call its
-argument, thus overriding the default behavior; or it may even call it
-several times. The function should return the abbrev symbol if
-expansion took place.
+This is a wrapper hook (@pxref{Running Hooks}) run around the
+@code{expand-abbrev} function. Each function on this hook is called
+with a single argument: a function that performs the normal abbrev
+expansion. The hook function can hence do anything it wants before
+and after performing the expansion. It can also choose not to call
+its argument, thus overriding the default behavior; or it may even
+call it several times. The function should return the abbrev symbol
+if expansion took place.
@end defvar
The following sample code shows a simple use of
@@ -361,8 +346,7 @@ expansion took place.
mode for editing certain files in which lines that start with @samp{#}
are comments. You want to use Text mode abbrevs for those lines. The
regular local abbrev table, @code{foo-mode-abbrev-table} is
-appropriate for all other lines. Then you can put the following code
-in your @file{.emacs} file. @xref{Standard Abbrev Tables}, for the
+appropriate for all other lines. @xref{Standard Abbrev Tables}, for the
definitions of @code{local-abbrev-table} and @code{text-mode-abbrev-table}.
@smallexample
@@ -381,8 +365,7 @@ definitions of @code{local-abbrev-table} and @code{text-mode-abbrev-table}.
nil t)))
@end smallexample
-@node Standard Abbrev Tables, Abbrev Properties, Abbrev Expansion, Abbrevs
-@comment node-name, next, previous, up
+@node Standard Abbrev Tables
@section Standard Abbrev Tables
Here we list the variables that hold the abbrev tables for the
@@ -419,14 +402,16 @@ This is the local abbrev table used in Text mode.
@end defvar
@defvar lisp-mode-abbrev-table
-This is the local abbrev table used in Lisp mode and Emacs Lisp mode.
+This is the local abbrev table used in Lisp mode. It is the parent
+of the local abbrev table used in Emacs Lisp mode. @xref{Abbrev Table
+Properties}.
@end defvar
-@node Abbrev Properties, Abbrev Table Properties, Standard Abbrev Tables, Abbrevs
+@node Abbrev Properties
@section Abbrev Properties
Abbrevs have properties, some of which influence the way they work.
-You can provide them as arguments to @code{define-abbrev} and you can
+You can provide them as arguments to @code{define-abbrev}, and
manipulate them with the following functions:
@defun abbrev-put abbrev prop val
@@ -462,13 +447,12 @@ same pattern of capitalization. It also disables the code that
modifies the capitalization of the expansion.
@end table
-@node Abbrev Table Properties, , Abbrev Properties, Abbrevs
+@node Abbrev Table Properties
@section Abbrev Table Properties
Like abbrevs, abbrev tables have properties, some of which influence
the way they work. You can provide them as arguments to
-@code{define-abbrev-table} and you can manipulate them with the
-functions:
+@code{define-abbrev-table}, and manipulate them with the functions:
@defun abbrev-table-put table prop val
Set the property @var{prop} of abbrev table @var{table} to value @var{val}.
@@ -484,8 +468,8 @@ The following properties have special meaning:
@table @code
@item :enable-function
This is like the @code{:enable-function} abbrev property except that
-it applies to all abbrevs in the table and is used even before trying
-to find the abbrev before point so it can dynamically modify the
+it applies to all abbrevs in the table. It is used before even trying
+to find the abbrev before point, so it can dynamically modify the
abbrev table.
@item :case-fixed
@@ -494,15 +478,16 @@ applies to all abbrevs in the table.
@item :regexp
If non-@code{nil}, this property is a regular expression that
-indicates how to extract the name of the abbrev before point before
+indicates how to extract the name of the abbrev before point, before
looking it up in the table. When the regular expression matches
before point, the abbrev name is expected to be in submatch 1.
-If this property is @code{nil}, @code{expand-function} defaults to
-@code{"\\<\\(\\w+\\)\\W"}. This property allows the use of abbrevs
-whose name contains characters of non-word syntax.
+If this property is @code{nil}, the default is to use
+@code{backward-word} and @code{forward-word} to find the name. This
+property allows the use of abbrevs whose name contains characters of
+non-word syntax.
@item :parents
-This property holds the list of tables from which to inherit
+This property holds a list of tables from which to inherit
other abbrevs.
@item :abbrev-table-modiff
diff --git a/doc/lispref/advice.texi b/doc/lispref/advice.texi
index 29356381229..7b18852b1a1 100644
--- a/doc/lispref/advice.texi
+++ b/doc/lispref/advice.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1998-1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/advising
-@node Advising Functions, Debugging, Byte Compilation, Top
+@node Advising Functions
@chapter Advising Emacs Lisp Functions
@cindex advising functions
@@ -13,30 +12,35 @@ for a library to customize functions defined within Emacs---cleaner
than redefining the whole function.
@cindex piece of advice
- Each function can have multiple @dfn{pieces of advice}, separately
-defined. Each defined piece of advice can be @dfn{enabled} or
-@dfn{disabled} explicitly. All the enabled pieces of advice for any given
-function actually take effect when you @dfn{activate} advice for that
+ Each function can have multiple @dfn{pieces of advice}, each of
+which can be separately defined and then @dfn{enabled} or
+@dfn{disabled}. All the enabled pieces of advice for any given
+function actually take effect when you @dfn{activate advice} for that
function, or when you define or redefine the function. Note that
-enabling a piece of advice and activating advice for a function
-are not the same thing.
-
- @strong{Usage Note:} Advice is useful for altering the behavior of
-existing calls to an existing function. If you want the new behavior
-for new calls, or for key bindings, you should define a new function
-(or a new command) which uses the existing function.
-
- @strong{Usage note:} Advising a function can cause confusion in
-debugging, since people who debug calls to the original function may
-not notice that it has been modified with advice. Therefore, if you
-have the possibility to change the code of that function (or ask
-someone to do so) to run a hook, please solve the problem that way.
-Advice should be reserved for the cases where you cannot get the
-function changed.
-
- In particular, this means that a file in Emacs should not put advice
-on a function in Emacs. There are currently a few exceptions to this
-convention, but we aim to correct them.
+enabling a piece of advice and activating advice for a function are
+not the same thing.
+
+ Advice is useful for altering the behavior of existing calls to an
+existing function. If you want the new behavior for new function
+calls or new key bindings, you should define a new function or
+command, and have it use the existing function as a subroutine.
+
+ Advising a function can cause confusion in debugging, since people
+who debug calls to the original function may not notice that it has
+been modified with advice. Therefore, if you have the possibility to
+change the code of that function to run a hook, please solve the
+problem that way. Advice should be reserved for the cases where you
+cannot get the function changed. In particular, Emacs's own source
+files should not put advice on functions in Emacs. There are
+currently a few exceptions to this convention, but we aim to correct
+them.
+
+ Unless you know what you are doing, do @emph{not} advise a primitive
+(@pxref{What Is a Function}). Some primitives are used by the advice
+mechanism; advising them could cause an infinite recursion. Also,
+many primitives are called directly from C code. Calls to the
+primitive from Lisp code will take note of the advice, but calls from
+C code will ignore the advice.
@menu
* Simple Advice:: A simple example to explain the basics of advice.
@@ -48,7 +52,6 @@ convention, but we aim to correct them.
* Preactivation:: Preactivation is a way of speeding up the
loading of compiled advice.
* Argument Access in Advice:: How advice can access the function's arguments.
-* Advising Primitives:: Accessing arguments when advising a primitive.
* Combined Definition:: How advice is implemented.
@end menu
@@ -258,7 +261,7 @@ All subroutines used by the advice need to be available when the byte
compiler expands the macro.
@deffn Command ad-unadvise function
-This command deletes the advice from @var{function}.
+This command deletes all pieces of advice from @var{function}.
@end deffn
@deffn Command ad-unadvise-all
@@ -355,13 +358,13 @@ replaced with the new one.
@cindex advice, activating
By default, advice does not take effect when you define it---only when
-you @dfn{activate} advice for the function that was advised. However,
-the advice will be activated automatically if you define or redefine
-the function later. You can request the activation of advice for a
-function when you define the advice, by specifying the @code{activate}
-flag in the @code{defadvice}. But normally you activate the advice
-for a function by calling the function @code{ad-activate} or one of
-the other activation commands listed below.
+you @dfn{activate} advice for the function. However, the advice will
+be activated automatically if you define or redefine the function
+later. You can request the activation of advice for a function when
+you define the advice, by specifying the @code{activate} flag in the
+@code{defadvice}; or you can activate the advice separately by calling
+the function @code{ad-activate} or one of the other activation
+commands listed below.
Separating the activation of advice from the act of defining it permits
you to add several pieces of advice to one function efficiently, without
@@ -680,39 +683,6 @@ will be 3, and @var{r} will be @code{(2 1 0)} inside the body of
These argument constructs are not really implemented as Lisp macros.
Instead they are implemented specially by the advice mechanism.
-@node Advising Primitives
-@section Advising Primitives
-@cindex advising primitives
-
- Advising a primitive function (@pxref{What Is a Function}) is risky.
-Some primitive functions are used by the advice mechanism; advising
-them could cause an infinite recursion. Also, many primitive
-functions are called directly from C code. Calls to the primitive
-from Lisp code will take note of the advice, but calls from C code
-will ignore the advice.
-
-When the advice facility constructs the combined definition, it needs
-to know the argument list of the original function. This is not
-always possible for primitive functions. When advice cannot determine
-the argument list, it uses @code{(&rest ad-subr-args)}, which always
-works but is inefficient because it constructs a list of the argument
-values. You can use @code{ad-define-subr-args} to declare the proper
-argument names for a primitive function:
-
-@defun ad-define-subr-args function arglist
-This function specifies that @var{arglist} should be used as the
-argument list for function @var{function}.
-@end defun
-
-For example,
-
-@example
-(ad-define-subr-args 'fset '(sym newdef))
-@end example
-
-@noindent
-specifies the argument list for the function @code{fset}.
-
@node Combined Definition
@section The Combined Definition
diff --git a/doc/lispref/anti.texi b/doc/lispref/anti.texi
index bb1e42c9309..6ece2149733 100644
--- a/doc/lispref/anti.texi
+++ b/doc/lispref/anti.texi
@@ -1,155 +1,139 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1999, 2002-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1999, 2002-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@c This node must have no pointers.
-@node Antinews, GNU Free Documentation License, Packaging, Top
-@appendix Emacs 22 Antinews
-@c Update the elisp.texi, vol1.texi, vol2.texi Antinews menu entries
-@c with the above version number.
+@node Antinews
+@appendix Emacs 23 Antinews
+@c Update the elisp.texi Antinews menu entry with the above version number.
For those users who live backwards in time, here is information about
-downgrading to Emacs version 22.3. We hope you will enjoy the greater
+downgrading to Emacs version 23.4. We hope you will enjoy the greater
simplicity that results from the absence of many Emacs @value{EMACSVER}
features.
-@section Old Lisp Features in Emacs 22
+@section Old Lisp Features in Emacs 23
@itemize @bullet
@item
-The internal character representation used by Emacs is not longer
-based on Unicode. In this representation, called @code{emacs-mule},
-each character belongs to one and only one script. Emacs makes no
-attempt to distinguish between ``similar'' characters occurring in
-different scripts.
+Support for lexical scoping has been removed; all variables are
+dynamically scoped. The @code{lexical-binding} variable has been
+removed, and so has the @var{lexical} argument to @code{eval}. The
+@code{defvar} and @code{defconst} forms no longer mark variables as
+dynamic, since all variables are dynamic.
-@item
-The @code{^} interactive spec code, the function
-@code{handle-shift-selection}, and the variable
-@code{this-command-keys-shift-translated} have all been removed.
-Shift-translated keys are no longer treated specially, making Emacs'
-handling of keybindings much more consistent.
-
-@item
-Temporarily-active regions are not created by giving the variable
-@code{transient-mark-mode} values of the form @code{(only
-. @var{oldvar})}. We instead use a more complicated scheme:
-setting @code{transient-mark-mode} to @code{only} enables Transient
-Mark mode for the following command only, during which the value of
-@code{transient-mark-mode} is set to @code{identity}; if it is still
-@code{identity} at the end of the command, Transient Mark mode is
-disabled.
-
-@item
-Many minibuffer functions, such as @code{read-file-name} and
-@code{minibuffer-complete}, have been rewritten in C for greater
-speed. The completion code has been considerably simplified; the
-completion style can no longer be changed via
-@code{completion-styles-alist}, and @code{completing-read} no longer
-recognizes the special values @code{confirm-only} and
-@code{confirm-after-completion} for its @var{require-match} argument.
-
-@item
-Emacs no longer supports explicitly-numbered groups in regular
-expressions.
+Having only dynamic binding follows the spirit of Emacs extensibility,
+for it allows any Emacs code to access any defined variable with a
+minimum of fuss. But @xref{Dynamic Binding Tips}, for tips to avoid
+making your programs hard to understand.
@item
-The @code{permanent-local-hook} function property has no special
-meaning.
+Calling a minor mode function from Lisp with a nil or omitted argument
+does not enable the minor mode unconditionally; instead, it toggles
+the minor mode---which is the straightforward thing to do, since that
+is the behavior when invoked interactively. One downside is that it
+is more troublesome to enable minor modes from hooks; you have to do
+something like
-@item
-The @code{functionp} function now returns @code{t} for special forms.
+@example
+(add-hook 'foo-hook (lambda () (bar-mode 1)))
+@end example
-@item
-The @code{interactive-form} symbol property has no special meaning.
-Once you supply a function with an interactive form, the only way to
-change it is to redefine the function.
+@noindent
+or define @code{turn-on-bar-mode} and call that from the hook.
@item
-The @code{ignore-errors} macro has been moved into the @code{cl}
-package.
+The @code{prog-mode} dummy major mode has been removed. Instead of
+using it as a crutch to meet programming mode conventions, you should
+explicitly ensure that your mode follows those conventions.
+@xref{Major Mode Conventions}.
@item
-Variables can now be both buffer-local and frame-local; buffer-local
-bindings take precedence over frame-local bindings.
+Emacs no longer supports bidirectional display and editing. Since
+there is no need to worry about the insertion of right-to-left text
+messing up how lines and paragraphs are displayed, the function
+@code{bidi-string-mark-left-to-right} has been removed; so have many
+other functions and variables related to bidirectional display.
+Unicode directionality characters like @code{U+200E} ("left-to-right
+mark") have no special effect on display.
@item
-Faces can no longer be remapped.
+Emacs windows now have most of their internal state hidden from Lisp.
+Internal windows are no longer visible to Lisp; functions such as
+@code{window-parent}, window parameters related to window arrangement,
+and window-local buffer lists have all been removed. Functions for
+resizing windows can delete windows if they become too small.
-@item
-Lisp programs now specify fonts by their names, which are strings
-following the XLFD (X logical font descriptor) format. Fonts are no
-longer represented using a special set of ``font'' data types. The
-various functions that act on these data types, such as @code{fontp},
-@code{font-spec}, and @code{list-fonts}, have all been deleted.
+The ``action function'' feature for controlling buffer display has
+been removed, including @code{display-buffer-overriding-action} and
+related variables, as well as the @var{action} argument to
+@code{display-buffer} and other functions. The way to
+programmatically control how Emacs chooses a window to display a
+buffer is to bind the right combination of @code{pop-up-frames} and
+other variables.
@item
-Emacs does not recognize the @code{FontBackend} X resource and the
-@code{font-backend} frame parameter. On the X Window System, fonts
-are always drawn using the X core font driver.
+The standard completion interface has been simplified, eliminating the
+@code{completion-extra-properties} variable, the @code{metadata}
+action flag for completion functions, and the concept of
+``completion categories''. Lisp programmers may now find the choice
+of methods for tuning completion less bewildering, but if a package
+finds the streamlined interface insufficient for its needs, it must
+implement its own specialized completion feature.
@item
-Display terminals are no longer represented using a ``terminal'' data
-type; this is not necessary, because we have removed the ability to
-display on graphical and text-only terminals simultaneously. For the
-same reason, the @code{window-system} variable is no longer
-frame-local, and the @code{window-system} function has been removed.
+@code{copy-directory} now behaves the same whether or not the
+destination is an existing directory: if the destination exists, the
+@emph{contents} of the first directory are copied into it (with
+subdirectories handled recursively), rather than copying the first
+directory into a subdirectory.
@item
-The functions @code{list-system-processes} and
-@code{process-attributes} have been removed. To get information about
-system processes, call an external program, such as @command{ps}.
+The @var{trash} arguments for @code{delete-file} and
+@code{delete-directory} have been removed. The variable
+@code{delete-by-moving-to-trash} must now be used with care; whenever
+it is non-@code{nil}, all calls to @code{delete-file} or
+@code{delete-directory} use the trash.
@item
-The function @code{locate-user-emacs-file} and the variable
-@code{user-emacs-directory} have been removed. Instead, use
-hard-coded values pointing to @file{~/.emacs.d}.
+Because Emacs no longer supports SELinux file contexts, the
+@var{preserve-selinux-context} argument to @code{copy-file} has been
+removed. The return value of @code{backup-buffer} no longer has an
+entry for the SELinux file context.
@item
-@code{vertical-motion} can no longer be told to move to a specific
-column; it always puts point on the first column of a line.
+For mouse click input events in the text area, the Y pixel coordinate
+in the @var{position} list (@pxref{Click Events}) now counts from the
+top of the header line, if there is one, rather than the top of the
+text area.
@item
-Windows no longer have parameters.
+Bindings in menu keymaps (@pxref{Format of Keymaps}) now sometimes get
+an additional @var{cache} entry in their definitions, like this:
-@item
-The @code{display-buffer} function has been rewritten in C. Its
-window-splitting heuristics are a little less sophisticated, and a
-little less documented. Window-splitting is handled internally,
-instead of using @code{split-window-preferred-function} (which has
-been removed). Windows are never split horizontally; the variable
-@code{split-width-threshold} has been removed.
+@example
+(@var{type} @var{item-name} @var{cache} . @var{binding})
+@end example
-@item
-The @code{mode-name} variable now accepts only string values, and
-cannot take the form of a mode-line construct.
-
-@item
-The behavior of @code{map-char-table} has changed. It calls the
-mapping function for every single character in the table, instead of
-using cons cells to represent contiguous character code ranges.
+@noindent
+The @var{cache} entry is used internally by Emacs to record equivalent
+keyboard key sequences for invoking the same command; Lisp programs
+should never use it.
+@c Not really NEWS-worthy then...
@item
-Several keymaps have been eliminated: @code{input-decode-map},
-@code{local-function-key-map}, @code{search-map},
-@code{multi-query-replace-map}, and
-@code{minibuffer-local-shell-command-map}.
+The @code{gnutls} library has been removed, and the function
+@code{open-network-stream} correspondingly simplified.
+Lisp programs that want an encrypted network connection must now call
+external utilities such as @command{starttls} or @command{gnutls-cli}.
@item
-Many functions have been removed, including: @code{buffer-swap-text},
-@code{emacs-init-time}, @code{emacs-uptime}, @code{use-region-p},
-@code{region-active-p}, @code{start-file-process},
-@code{process-lines}, @code{image-refresh},
-@code{match-substitute-replacement}, @code{word-search-forward-lax},
-and @code{word-search-backward-lax}.
+Tool bars can no longer display separators, which frees up several
+pixels of space on each graphical frame.
@item
-Many variables have been removed, including @code{read-circle},
-@code{after-init-time} and @code{before-init-time},
-@code{generate-autoload-cookie}, @code{file-local-variables-alist},
-@code{replace-search-function} and @code{replace-re-search-function},
-@code{inhibit-changing-match-data}, @code{wrap-prefix}, and
-@code{line-prefix},
+As part of the ongoing quest for simplicity, many other functions and
+variables have been eliminated.
@end itemize
diff --git a/doc/lispref/back.texi b/doc/lispref/back.texi
index 3add7b174d2..75c244ae1dd 100644
--- a/doc/lispref/back.texi
+++ b/doc/lispref/back.texi
@@ -1,6 +1,6 @@
\input texinfo @c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@c
@c %**start of header
diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi
index aad0cbc146a..935a49116cd 100644
--- a/doc/lispref/backups.texi
+++ b/doc/lispref/backups.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/backups
-@node Backups and Auto-Saving, Buffers, Files, Top
+@node Backups and Auto-Saving
@chapter Backups and Auto-Saving
@cindex backups and auto-saving
@@ -57,12 +56,13 @@ buffer, if appropriate. It is called by @code{save-buffer} before
saving the buffer the first time.
If a backup was made by renaming, the return value is a cons cell of
-the form (@var{modes} . @var{backupname}), where @var{modes} are the
-mode bits of the original file, as returned by @code{file-modes}
-(@pxref{File Attributes,, Other Information about Files}), and
-@var{backupname} is the name of the backup. In all other cases, that
-is, if a backup was made by copying or if no backup was made, this
-function returns @code{nil}.
+the form (@var{modes} @var{context} @var{backupname}), where
+@var{modes} are the mode bits of the original file, as returned by
+@code{file-modes} (@pxref{File Attributes,, Other Information about
+Files}), @var{context} is a list describing the original file's
+SELinux context (@pxref{File Attributes}), and @var{backupname} is the
+name of the backup. In all other cases, that is, if a backup was made
+by copying or if no backup was made, this function returns @code{nil}.
@end defun
@defvar buffer-backed-up
@@ -139,8 +139,8 @@ For the common case of all backups going into one directory, the alist
should contain a single element pairing @samp{"."} with the appropriate
directory name.
-If this variable is @code{nil}, or it fails to match a filename, the
-backup is made in the original file's directory.
+If this variable is @code{nil} (the default), or it fails to match a
+filename, the backup is made in the original file's directory.
On MS-DOS filesystems without long names this variable is always
ignored.
@@ -191,7 +191,7 @@ significance). @xref{Saving Buffers}.
@defopt backup-by-copying
If this variable is non-@code{nil}, Emacs always makes backup files by
-copying.
+copying. The default is @code{nil}.
@end defopt
The following three variables, when non-@code{nil}, cause the second
@@ -200,7 +200,7 @@ treatment of files that don't fall into the special cases.
@defopt backup-by-copying-when-linked
If this variable is non-@code{nil}, Emacs makes backups by copying for
-files with multiple names (hard links).
+files with multiple names (hard links). The default is @code{nil}.
This variable is significant only if @code{backup-by-copying} is
@code{nil}, since copying is always used when that variable is
@@ -208,8 +208,9 @@ non-@code{nil}.
@end defopt
@defopt backup-by-copying-when-mismatch
-If this variable is non-@code{nil}, Emacs makes backups by copying in cases
-where renaming would change either the owner or the group of the file.
+If this variable is non-@code{nil} (the default), Emacs makes backups
+by copying in cases where renaming would change either the owner or
+the group of the file.
The value has no effect when renaming would not alter the owner or
group of the file; that is, for files which are owned by the user and
@@ -440,11 +441,14 @@ buffer-auto-save-file-name
@end defvar
@deffn Command auto-save-mode arg
-When used interactively without an argument, this command is a toggle
-switch: it turns on auto-saving of the current buffer if it is off, and
-vice versa. With an argument @var{arg}, the command turns auto-saving
-on if the value of @var{arg} is @code{t}, a nonempty list, or a positive
-integer. Otherwise, it turns auto-saving off.
+This is the mode command for Auto Save mode, a buffer-local minor
+mode. When Auto Save mode is enabled, auto-saving is enabled in the
+buffer. The calling convention is the same as for other minor mode
+commands (@pxref{Minor Mode Conventions}).
+
+Unlike most minor modes, there is no @code{auto-save-mode} variable.
+Auto Save mode is enabled if @code{buffer-auto-save-file-name} is
+non-@code{nil} and @code{buffer-saved-size} (see below) is non-zero.
@end deffn
@defun auto-save-file-name-p filename
@@ -698,6 +702,11 @@ the markers in the unchanged text (if any) at the beginning and end of
the buffer. Preserving any additional markers would be problematical.
@end deffn
+@defvar revert-buffer-in-progress-p
+@code{revert-buffer} binds this variable to a non-@code{nil} value
+while it is working.
+@end defvar
+
You can customize how @code{revert-buffer} does its work by setting
the variables described in the rest of this section.
@@ -751,3 +760,16 @@ This normal hook is run by @code{revert-buffer} after inserting
the modified contents---but only if @code{revert-buffer-function} is
@code{nil}.
@end defvar
+
+@c FIXME? Move this section from arevert-xtra to here?
+@defvar buffer-stale-function
+The value of this variable, if non-@code{nil}, specifies a function
+to call to check whether a non-file buffer needs reverting
+@iftex
+(@pxref{Supporting additional buffers,,, emacs-xtra, Specialized Emacs Features}).
+@end iftex
+@ifnottex
+(@pxref{Supporting additional buffers,,, emacs}).
+@end ifnottex
+@end defvar
+
diff --git a/doc/lispref/book-spine.texi b/doc/lispref/book-spine.texi
index 270def6d8b3..721416316d2 100644
--- a/doc/lispref/book-spine.texi
+++ b/doc/lispref/book-spine.texi
@@ -20,8 +20,8 @@
@center by
@center Bil Lewis,
@center Dan LaLiberte,
-@center and the
-@center GNU Manual Group
+@center the GNU Manual Group,
+@center et al.
@sp 5
@center Free Software Foundation
@bye
diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi
index ee2ce2e2001..6462788b34e 100644
--- a/doc/lispref/buffers.texi
+++ b/doc/lispref/buffers.texi
@@ -1,10 +1,9 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/buffers
-@node Buffers, Windows, Backups and Auto-Saving, Top
+@node Buffers
@chapter Buffers
@cindex buffer
@@ -24,7 +23,7 @@ not be displayed in any windows.
* Buffer File Name:: The buffer file name indicates which file is visited.
* Buffer Modification:: A buffer is @dfn{modified} if it needs to be saved.
* Modification Time:: Determining whether the visited file was changed
- ``behind Emacs's back''.
+ "behind Emacs's back".
* Read Only Buffers:: Modifying text is not allowed in a read-only buffer.
* The Buffer List:: How to look at all the existing buffers.
* Creating Buffers:: Functions that create buffers.
@@ -35,7 +34,6 @@ not be displayed in any windows.
@end menu
@node Buffer Basics
-@comment node-name, next, previous, up
@section Buffer Basics
@ifnottex
@@ -417,7 +415,7 @@ This buffer-local variable holds the abbreviated truename of the file
visited in the current buffer, or @code{nil} if no file is visited.
It is a permanent local, unaffected by
@code{kill-all-local-variables}. @xref{Truenames}, and
-@ref{Definition of abbreviate-file-name}.
+@ref{abbreviate-file-name}.
@end defvar
@defvar buffer-file-number
@@ -482,7 +480,7 @@ correspond to the new file name, unless the new name is already in
use.
If @var{filename} is @code{nil} or the empty string, that stands for
-``no visited file.'' In this case, @code{set-visited-file-name} marks
+``no visited file''. In this case, @code{set-visited-file-name} marks
the buffer as having no visited file, without changing the buffer's
modified flag.
@@ -502,9 +500,8 @@ buffer's recorded last file modification time as reported by
last file modification time, after which @code{visited-file-modtime}
returns zero.
-@c Wordy to avoid overfull hbox. --rjc 16mar92
-When the function @code{set-visited-file-name} is called interactively, it
-prompts for @var{filename} in the minibuffer.
+When the function @code{set-visited-file-name} is called
+interactively, it prompts for @var{filename} in the minibuffer.
@end deffn
@defvar list-buffers-directory
@@ -590,7 +587,6 @@ current buffer is used.
@end defun
@node Modification Time
-@comment node-name, next, previous, up
@section Buffer Modification Time
@cindex comparing file modification time
@cindex modification time of buffer
@@ -638,7 +634,8 @@ file should not be done.
@c Emacs 19 feature
@defun visited-file-modtime
This function returns the current buffer's recorded last file
-modification time, as a list of the form @code{(@var{high} @var{low})}.
+modification time, as a list of the form @code{(@var{high} @var{low}
+@var{microsec} @var{picosec})}.
(This is the same format that @code{file-attributes} uses to return
time values; see @ref{File Attributes}.)
@@ -668,9 +665,8 @@ is not @code{nil}, and otherwise to the last modification time of the
visited file.
If @var{time} is neither @code{nil} nor zero, it should have the form
-@code{(@var{high} . @var{low})} or @code{(@var{high} @var{low})}, in
-either case containing two integers, each of which holds 16 bits of the
-time.
+@code{(@var{high} @var{low} @var{microsec} @var{picosec})},
+the format used by @code{current-time} (@pxref{Time of Day}).
This function is useful if the buffer was not read from the file
normally, or if the file itself has been changed for some known benign
@@ -734,11 +730,9 @@ The buffer is read-only if this variable is non-@code{nil}.
@defvar inhibit-read-only
If this variable is non-@code{nil}, then read-only buffers and,
depending on the actual value, some or all read-only characters may be
-modified. Read-only characters in a buffer are those that have
-non-@code{nil} @code{read-only} properties (either text properties or
-overlay properties). @xref{Special Properties}, for more information
-about text properties. @xref{Overlays}, for more information about
-overlays and their properties.
+modified. Read-only characters in a buffer are those that have a
+non-@code{nil} @code{read-only} text property. @xref{Special
+Properties}, for more information about text properties.
If @code{inhibit-read-only} is @code{t}, all @code{read-only} character
properties have no effect. If @code{inhibit-read-only} is a list, then
@@ -746,18 +740,25 @@ properties have no effect. If @code{inhibit-read-only} is a list, then
of the list (comparison is done with @code{eq}).
@end defvar
-@deffn Command toggle-read-only &optional arg
-This command toggles whether the current buffer is read-only. It is
-intended for interactive use; do not use it in programs (it may have
-side-effects, such as enabling View mode, and does not affect
-read-only text properties). To change the read-only state of a buffer in
-a program, explicitly set @code{buffer-read-only} to the proper value.
-To temporarily ignore a read-only state, bind @code{inhibit-read-only}.
-
-If @var{arg} is non-@code{nil}, it should be a raw prefix argument.
-@code{toggle-read-only} sets @code{buffer-read-only} to @code{t} if
-the numeric value of that prefix argument is positive and to
-@code{nil} otherwise. @xref{Prefix Command Arguments}.
+@deffn Command read-only-mode &optional arg
+This is the mode command for Read Only minor mode, a buffer-local
+minor mode. When the mode is enabled, @code{buffer-read-only} is
+non-@code{nil} in the buffer; when disabled, @code{buffer-read-only}
+is @code{nil} in the buffer. The calling convention is the same as
+for other minor mode commands (@pxref{Minor Mode Conventions}).
+
+This minor mode mainly serves as a wrapper for
+@code{buffer-read-only}; unlike most minor modes, there is no separate
+@code{read-only-mode} variable. Even when Read Only mode is disabled,
+characters with non-@code{nil} @code{read-only} text properties remain
+read-only. To temporarily ignore all read-only states, bind
+@code{inhibit-read-only}, as described above.
+
+When enabling Read Only mode, this mode command also enables View mode
+if the option @code{view-read-only} is non-@code{nil}. @xref{Misc
+Buffer,,Miscellaneous Buffer Operations, emacs, The GNU Emacs Manual}.
+When disabling Read Only mode, it disables View mode if View mode was
+enabled.
@end deffn
@defun barf-if-buffer-read-only
@@ -864,7 +865,7 @@ a buffer visible in any window on any visible frame, except as a last
resort. If @var{visible-ok} is non-@code{nil}, then it does not matter
whether a buffer is displayed somewhere or not.
-If no suitable buffer exists, the buffer @samp{*scratch*} is returned
+If no suitable buffer exists, the buffer @file{*scratch*} is returned
(and created, if necessary).
@end defun
@@ -875,7 +876,7 @@ selected frame's buffer list.
The argument @var{visible-ok} is handled as with @code{other-buffer},
see above. If no suitable buffer can be found, the buffer
-@samp{*scratch*} is returned.
+@file{*scratch*} is returned.
@end defun
@deffn Command bury-buffer &optional buffer-or-name
@@ -885,7 +886,7 @@ This buffer therefore becomes the least desirable candidate for
@code{other-buffer} to return. The argument can be either a buffer
itself or the name of one.
-This functions operates on each frame's @code{buffer-list} parameter as
+This function operates on each frame's @code{buffer-list} parameter as
well as the fundamental buffer list; therefore, the buffer that you bury
will come last in the value of @code{(buffer-list @var{frame})} and in
the value of @code{(buffer-list)}. In addition, it also puts the buffer
@@ -895,15 +896,15 @@ History}) provided it is shown in that window.
If @var{buffer-or-name} is @code{nil} or omitted, this means to bury the
current buffer. In addition, if the current buffer is displayed in the
selected window, this makes sure that the window is either deleted or
-another buffer is shown in it. More precisely, if the window is
-dedicated (@pxref{Dedicated Windows}) and there are other windows on its
-frame, the window is deleted. If the window is both dedicated and the
-only window on its frame's terminal, the function specified by
-@code{frame-auto-hide-function} (@pxref{Quitting Windows}) will deal
-with the window. If the window is not dedicated to its buffer, it calls
-@code{switch-to-prev-buffer} (@pxref{Window History}) to show another
-buffer in that window. If @var{buffer-or-name} is displayed in some
-other window, it remains displayed there.
+another buffer is shown in it. More precisely, if the selected window
+is dedicated (@pxref{Dedicated Windows}) and there are other windows on
+its frame, the window is deleted. If it is the only window on its frame
+and that frame is not the only frame on its terminal, the frame is
+``dismissed'' by calling the function specified by
+@code{frame-auto-hide-function} (@pxref{Quitting Windows}). Otherwise,
+it calls @code{switch-to-prev-buffer} (@pxref{Window History}) to show
+another buffer in that window. If @var{buffer-or-name} is displayed in
+some other window, it remains displayed there.
To replace a buffer in all the windows that display it, use
@code{replace-buffer-in-windows}, @xref{Buffers and Windows}.
@@ -913,7 +914,7 @@ To replace a buffer in all the windows that display it, use
This command switches to the last buffer in the local buffer list of
the selected frame. More precisely, it calls the function
@code{switch-to-buffer} (@pxref{Switching Buffers}), to display the
-buffer returned by @code{last-buffer}, see above, in the selected
+buffer returned by @code{last-buffer} (see above), in the selected
window.
@end deffn
@@ -959,11 +960,12 @@ buffer initially disables undo information recording (@pxref{Undo}).
@defun generate-new-buffer name
This function returns a newly created, empty buffer, but does not make
-it current. If there is no buffer named @var{name}, then that is the
-name of the new buffer. If that name is in use, this function adds
-suffixes of the form @samp{<@var{n}>} to @var{name}, where @var{n} is an
-integer. It tries successive integers starting with 2 until it finds an
-available name.
+it current. The name of the buffer is generated by passing @var{name}
+to the function @code{generate-new-buffer-name} (@pxref{Buffer
+Names}). Thus, if there is no buffer named @var{name}, then that is
+the name of the new buffer; if that name is in use, a suffix of the
+form @samp{<@var{n}>}, where @var{n} is an integer, is appended to
+@var{name}.
An error is signaled if @var{name} is not a string.
@@ -985,9 +987,6 @@ An error is signaled if @var{name} is not a string.
The major mode for the new buffer is set to Fundamental mode. The default
value of the variable @code{major-mode} is handled at a higher level.
@xref{Auto Major Mode}.
-
-See the related function @code{generate-new-buffer-name} in @ref{Buffer
-Names}.
@end defun
@node Killing Buffers
@@ -1005,25 +1004,26 @@ their identity, however; if you kill two distinct buffers, they remain
distinct according to @code{eq} although both are dead.
If you kill a buffer that is current or displayed in a window, Emacs
-automatically selects or displays some other buffer instead. This means
-that killing a buffer can in general change the current buffer.
-Therefore, when you kill a buffer, you should also take the precautions
+automatically selects or displays some other buffer instead. This
+means that killing a buffer can change the current buffer. Therefore,
+when you kill a buffer, you should also take the precautions
associated with changing the current buffer (unless you happen to know
that the buffer being killed isn't current). @xref{Current Buffer}.
If you kill a buffer that is the base buffer of one or more indirect
-buffers, the indirect buffers are automatically killed as well.
+@iftex
+buffers,
+@end iftex
+@ifnottex
+buffers (@pxref{Indirect Buffers}),
+@end ifnottex
+the indirect buffers are automatically killed as well.
- The @code{buffer-name} of a killed buffer is @code{nil}. You can use
-this feature to test whether a buffer has been killed:
-
-@example
-@group
-(defun buffer-killed-p (buffer)
- "Return t if BUFFER is killed."
- (not (buffer-name buffer)))
-@end group
-@end example
+@cindex live buffer
+ The @code{buffer-name} of a buffer is @code{nil} if, and only if,
+the buffer is killed. A buffer that has not been killed is called a
+@dfn{live} buffer. To test whether a buffer is live or killed, use
+the function @code{buffer-live-p} (see below).
@deffn Command kill-buffer &optional buffer-or-name
This function kills the buffer @var{buffer-or-name}, freeing all its
@@ -1032,9 +1032,8 @@ memory for other uses or to be returned to the operating system. If
buffer.
Any processes that have this buffer as the @code{process-buffer} are
-sent the @code{SIGHUP} signal, which normally causes them to terminate.
-(The basic meaning of @code{SIGHUP} is that a dialup line has been
-disconnected.) @xref{Signals to Processes}.
+sent the @code{SIGHUP} (``hangup'') signal, which normally causes them
+to terminate. @xref{Signals to Processes}.
If the buffer is visiting a file and contains unsaved changes,
@code{kill-buffer} asks the user to confirm before the buffer is killed.
@@ -1099,8 +1098,8 @@ automatically becomes buffer-local when set for any reason.
@end defvar
@defun buffer-live-p object
-This function returns @code{t} if @var{object} is a buffer which has
-not been killed, @code{nil} otherwise.
+This function returns @code{t} if @var{object} is a live buffer (a
+buffer which has not been killed), @code{nil} otherwise.
@end defun
@node Indirect Buffers
@@ -1238,4 +1237,3 @@ This function returns the current gap position in the current buffer.
@defun gap-size
This function returns the current gap size of the current buffer.
@end defun
-
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 41392273fbd..c42e4b3b6dc 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -1,10 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
-@c Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/commands
-@node Command Loop, Keymaps, Minibuffers, Top
+@node Command Loop
@chapter Command Loop
@cindex editor command loop
@cindex command loop
@@ -37,13 +35,13 @@ are done, and the subroutines that allow Lisp programs to do them.
@node Command Overview
@section Command Loop Overview
- The first thing the command loop must do is read a key sequence, which
-is a sequence of events that translates into a command. It does this by
-calling the function @code{read-key-sequence}. Your Lisp code can also
-call this function (@pxref{Key Sequence Input}). Lisp programs can also
-do input at a lower level with @code{read-event} (@pxref{Reading One
-Event}) or discard pending input with @code{discard-input}
-(@pxref{Event Input Misc}).
+ The first thing the command loop must do is read a key sequence,
+which is a sequence of input events that translates into a command.
+It does this by calling the function @code{read-key-sequence}. Lisp
+programs can also call this function (@pxref{Key Sequence Input}).
+They can also read input at a lower level with @code{read-key} or
+@code{read-event} (@pxref{Reading One Event}), or discard pending
+input with @code{discard-input} (@pxref{Event Input Misc}).
The key sequence is translated into a command through the currently
active keymaps. @xref{Key Lookup}, for information on how this is done.
@@ -67,26 +65,27 @@ use the minibuffer, so if you call @code{find-file} as a function from
Lisp code, you must supply the file name string as an ordinary Lisp
function argument.
- If the command is a string or vector (i.e., a keyboard macro) then
-@code{execute-kbd-macro} is used to execute it. You can call this
-function yourself (@pxref{Keyboard Macros}).
-
- To terminate the execution of a running command, type @kbd{C-g}. This
-character causes @dfn{quitting} (@pxref{Quitting}).
+ If the command is a keyboard macro (i.e.@: a string or vector),
+Emacs executes it using @code{execute-kbd-macro} (@pxref{Keyboard
+Macros}).
@defvar pre-command-hook
-The editor command loop runs this normal hook before each command. At
-that time, @code{this-command} contains the command that is about to
-run, and @code{last-command} describes the previous command.
-@xref{Command Loop Info}.
+This normal hook is run by the editor command loop before it executes
+each command. At that time, @code{this-command} contains the command
+that is about to run, and @code{last-command} describes the previous
+command. @xref{Command Loop Info}.
@end defvar
@defvar post-command-hook
-The editor command loop runs this normal hook after each command
-(including commands terminated prematurely by quitting or by errors),
-and also when the command loop is first entered. At that time,
-@code{this-command} refers to the command that just ran, and
-@code{last-command} refers to the command before that.
+This normal hook is run by the editor command loop after it executes
+each command (including commands terminated prematurely by quitting or
+by errors). At that time, @code{this-command} refers to the command
+that just ran, and @code{last-command} refers to the command before
+that.
+
+This hook is also run when Emacs first enters the command loop (at
+which point @code{this-command} and @code{last-command} are both
+@code{nil}).
@end defvar
Quitting is suppressed while running @code{pre-command-hook} and
@@ -171,8 +170,8 @@ or more arguments.
@item
It may be a string; its contents are a sequence of elements separated
-by newlines, one for each parameter@footnote{Some elements actually
-supply two parameters.}. Each element consists of a code character
+by newlines, one for each argument@footnote{Some elements actually
+supply two arguments.}. Each element consists of a code character
(@pxref{Interactive Codes}) optionally followed by a prompt (which
some code characters use and some ignore). Here is an example:
@@ -187,7 +186,6 @@ buffer: } prompts the user with @samp{Frobnicate buffer: } to enter
the name of an existing buffer, which becomes the second and final
argument.
-@c Emacs 19 feature
The prompt string can use @samp{%} to include previous argument values
(starting with the first argument) in the prompt. This is done using
@code{format} (@pxref{Formatting Strings}). For example, here is how
@@ -206,7 +204,6 @@ If @samp{*} appears at the beginning of the string, then an error is
signaled if the buffer is read-only.
@cindex @samp{@@} in @code{interactive}
-@c Emacs 19 feature
If @samp{@@} appears at the beginning of the string, and if the key
sequence used to invoke the command includes any mouse events, then
the window associated with the first of those events is selected
@@ -287,7 +284,6 @@ used.
@end defun
@node Interactive Codes
-@comment node-name, next, previous, up
@subsection Code Characters for @code{interactive}
@cindex interactive code description
@cindex description for interactive codes
@@ -381,9 +377,14 @@ current buffer, @code{default-directory} (@pxref{File Name Expansion}).
Existing, Completion, Default, Prompt.
@item e
-The first or next mouse event in the key sequence that invoked the command.
-More precisely, @samp{e} gets events that are lists, so you can look at
-the data in the lists. @xref{Input Events}. No I/O.
+The first or next non-keyboard event in the key sequence that invoked
+the command. More precisely, @samp{e} gets events that are lists, so
+you can look at the data in the lists. @xref{Input Events}. No I/O.
+
+You use @samp{e} for mouse events and for special system events
+(@pxref{Misc Events}). The event list that the command receives
+depends on the event. @xref{Input Events}, which describes the forms
+of the list for each event in the corresponding subsections.
You can use @samp{e} more than once in a single command's interactive
specification. If the key sequence that invoked the command has
@@ -482,7 +483,7 @@ discarded, @samp{U} provides @code{nil} as the argument. No I/O.
@item v
A variable declared to be a user option (i.e., satisfying the
-predicate @code{user-variable-p}). This reads the variable using
+predicate @code{custom-variable-p}). This reads the variable using
@code{read-variable}. @xref{Definition of read-variable}. Existing,
Completion, Prompt.
@@ -509,7 +510,6 @@ argument value. Completion, Existing, Prompt.
@end table
@node Interactive Examples
-@comment node-name, next, previous, up
@subsection Examples of Using @code{interactive}
@cindex examples of using @code{interactive}
@cindex @code{interactive}, examples of using
@@ -571,21 +571,24 @@ the command is a function, @code{command-execute} calls
@code{call-interactively}, which reads the arguments and calls the
command. You can also call these functions yourself.
-@defun commandp object &optional for-call-interactively
-Returns @code{t} if @var{object} is suitable for calling interactively;
-that is, if @var{object} is a command. Otherwise, returns @code{nil}.
-
-Interactively-callable objects include strings and vectors (which are
-treated as keyboard macros), lambda expressions that contain a
-top-level @code{interactive} form (@pxref{Using Interactive}),
-byte-code function objects made from such lambda expressions, autoload
-objects that are declared as interactive (non-@code{nil} fourth
-argument to @code{autoload}), and some primitive functions.
+ Note that the term ``command'', in this context, refers to an
+interactively callable function (or function-like object), or a
+keyboard macro. It does not refer to the key sequence used to invoke
+a command (@pxref{Keymaps}).
-A symbol satisfies @code{commandp} if it has a non-@code{nil}
+@defun commandp object &optional for-call-interactively
+This function returns @code{t} if @var{object} is a command.
+Otherwise, it returns @code{nil}.
+
+Commands include strings and vectors (which are treated as keyboard
+macros), lambda expressions that contain a top-level
+@code{interactive} form (@pxref{Using Interactive}), byte-code
+function objects made from such lambda expressions, autoload objects
+that are declared as interactive (non-@code{nil} fourth argument to
+@code{autoload}), and some primitive functions. Also, a symbol is
+considered a command if it has a non-@code{nil}
@code{interactive-form} property, or if its function definition
-satisfies @code{commandp}. Keys and keymaps are not commands.
-Rather, they are used to look up commands (@pxref{Keymaps}).
+satisfies @code{commandp}.
If @var{for-call-interactively} is non-@code{nil}, then
@code{commandp} returns @code{t} only for objects that
@@ -645,14 +648,14 @@ callable function or a keyboard macro.
A string or vector as @var{command} is executed with
@code{execute-kbd-macro}. A function is passed to
-@code{call-interactively}, along with the optional @var{record-flag}
-and @var{keys}.
+@code{call-interactively} (see above), along with the
+@var{record-flag} and @var{keys} arguments.
-A symbol is handled by using its function definition in its place. A
-symbol with an @code{autoload} definition counts as a command if it was
-declared to stand for an interactively callable function. Such a
-definition is handled by loading the specified library and then
-rechecking the definition of the symbol.
+If @var{command} is a symbol, its function definition is used in its
+place. A symbol with an @code{autoload} definition counts as a
+command if it was declared to stand for an interactively callable
+function. Such a definition is handled by loading the specified
+library and then rechecking the definition of the symbol.
The argument @var{special}, if given, means to ignore the prefix
argument and not clear it. This is used for executing special events
@@ -716,7 +719,7 @@ We use @code{"p"} because the numeric prefix argument is never
message when called from a keyboard macro.
The above method with the additional argument is usually best,
-because it allows callers to say ``treat this call as interactive.''
+because it allows callers to say ``treat this call as interactive''.
But you can also do the job by testing @code{called-interactively-p}.
@defun called-interactively-p kind
@@ -781,7 +784,6 @@ Here is another example that contrasts direct and indirect calls to
@end example
@node Command Loop Info
-@comment node-name, next, previous, up
@section Information from the Command Loop
The editor command loop sets several Lisp variables to keep status
@@ -906,7 +908,6 @@ up a menu. It is also used internally by @code{y-or-n-p}
@end defvar
@defvar last-command-event
-@defvarx last-command-char
This variable is set to the last input event that was read by the
command loop as part of a command. The principal use of this variable
is in @code{self-insert-command}, which uses it to decide which
@@ -922,11 +923,8 @@ last-command-event
@noindent
The value is 5 because that is the @acronym{ASCII} code for @kbd{C-e}.
-
-The alias @code{last-command-char} is obsolete.
@end defvar
-@c Emacs 19 feature
@defvar last-event-frame
This variable records which frame the last input event was directed to.
Usually this is the frame that was selected when the event was
@@ -973,9 +971,10 @@ moving point out of these sequences is completely turned off.
@cindex input events
The Emacs command loop reads a sequence of @dfn{input events} that
-represent keyboard or mouse activity. The events for keyboard activity
-are characters or symbols; mouse events are always lists. This section
-describes the representation and meaning of input events in detail.
+represent keyboard or mouse activity, or system events sent to Emacs.
+The events for keyboard activity are characters or symbols; other
+events are always lists. This section describes the representation
+and meaning of input events in detail.
@defun eventp object
This function returns non-@code{nil} if @var{object} is an input event
@@ -1127,9 +1126,9 @@ The
@ifnottex
2**22
@end ifnottex
-bit in the character code indicates a character typed with
-the alt key held down. (On some terminals, the key labeled @key{ALT}
-is actually the meta key.)
+bit in the character code indicates a character typed with the alt key
+held down. (The key labeled @key{Alt} on most keyboards is actually
+treated as the meta key, not this.)
@end table
It is best to avoid mentioning specific bit numbers in your program.
@@ -1147,10 +1146,10 @@ specify the characters (@pxref{Changing Key Bindings}). The function
@cindex function keys
Most keyboards also have @dfn{function keys}---keys that have names or
-symbols that are not characters. Function keys are represented in Emacs
-Lisp as symbols; the symbol's name is the function key's label, in lower
-case. For example, pressing a key labeled @key{F1} places the symbol
-@code{f1} in the input stream.
+symbols that are not characters. Function keys are represented in
+Emacs Lisp as symbols; the symbol's name is the function key's label,
+in lower case. For example, pressing a key labeled @key{F1} generates
+an input event represented by the symbol @code{f1}.
The event type of a function key event is the event symbol itself.
@xref{Classifying Events}.
@@ -1270,12 +1269,21 @@ describe events by their types; thus, if there is a key binding for
@var{event-type} is @code{mouse-1}.
@item @var{position}
-This is the position where the mouse click occurred. The actual
-format of @var{position} depends on what part of a window was clicked
-on.
+@cindex mouse position list
+This is a @dfn{mouse position list} specifying where the mouse click
+occurred; see below for details.
-For mouse click events in the text area, mode line, header line, or in
-the marginal areas, @var{position} has this form:
+@item @var{click-count}
+This is the number of rapid repeated presses so far of the same mouse
+button. @xref{Repeat Events}.
+@end table
+
+ To access the contents of a mouse position list in the
+@var{position} slot of a click event, you should typically use the
+functions documented in @ref{Accessing Mouse}. The explicit format of
+the list depends on where the click occurred. For clicks in the text
+area, mode line, header line, or in the fringe or marginal areas, the
+mouse position list has the form
@example
(@var{window} @var{pos-or-area} (@var{x} . @var{y}) @var{timestamp}
@@ -1283,50 +1291,51 @@ the marginal areas, @var{position} has this form:
@var{image} (@var{dx} . @var{dy}) (@var{width} . @var{height}))
@end example
+@noindent
+The meanings of these list elements are as follows:
+
@table @asis
@item @var{window}
-This is the window in which the click occurred.
+The window in which the click occurred.
@item @var{pos-or-area}
-This is the buffer position of the character clicked on in the text
-area, or if clicked outside the text area, it is the window area in
-which the click occurred. It is one of the symbols @code{mode-line},
+The buffer position of the character clicked on in the text area; or,
+if the click was outside the text area, the window area where it
+occurred. It is one of the symbols @code{mode-line},
@code{header-line}, @code{vertical-line}, @code{left-margin},
@code{right-margin}, @code{left-fringe}, or @code{right-fringe}.
-In one special case, @var{pos-or-area} is a list containing a symbol (one
-of the symbols listed above) instead of just the symbol. This happens
-after the imaginary prefix keys for the event are inserted into the
-input stream. @xref{Key Sequence Input}.
-
+In one special case, @var{pos-or-area} is a list containing a symbol
+(one of the symbols listed above) instead of just the symbol. This
+happens after the imaginary prefix keys for the event are registered
+by Emacs. @xref{Key Sequence Input}.
@item @var{x}, @var{y}
-These are the pixel coordinates of the click, relative to
-the top left corner of @var{window}, which is @code{(0 . 0)}.
-For a click on text, these are relative to the top left corner of
-the window's text area. For the mode or header line, they are
-relative to the top left window edge. For fringes, margins, and the
+The relative pixel coordinates of the click. For clicks in the text
+area of a window, the coordinate origin @code{(0 . 0)} is taken to be
+the top left corner of the text area. @xref{Window Sizes}. For
+clicks in a mode line or header line, the coordinate origin is the top
+left corner of the window itself. For fringes, margins, and the
vertical border, @var{x} does not have meaningful data. For fringes
and margins, @var{y} is relative to the bottom edge of the header
-line.
+line. In all cases, the @var{x} and @var{y} coordinates increase
+rightward and downward respectively.
@item @var{timestamp}
-This is the time at which the event occurred, in milliseconds.
+The time at which the event occurred, as an integer number of
+milliseconds since a system-dependent initial time.
@item @var{object}
-This is the object on which the click occurred. It is either
-@code{nil} if there is no string property, or it has the form
-(@var{string} . @var{string-pos}) when there is a string-type text
-property at the click position.
+Either @code{nil} if there is no string-type text property at the
+click position, or a cons cell of the form (@var{string}
+. @var{string-pos}) if there is one:
@table @asis
@item @var{string}
-This is the string on which the click occurred, including any
-properties.
+The string which was clicked on, including any properties.
@item @var{string-pos}
-This is the position in the string on which the click occurred,
-relevant if properties at the click need to be looked up.
+The position in the string where the click occurred.
@end table
@item @var{text-pos}
@@ -1336,14 +1345,17 @@ the window. For other events, it is the current buffer position in
the window.
@item @var{col}, @var{row}
-These are the actual coordinates of the glyph under the @var{x},
-@var{y} position, possibly padded with default character width
-glyphs if @var{x} is beyond the last glyph on the line. For clicks on
-the header or mode line, these are measured from the top left edge of
-the header or mode line. For clicks on the fringes and on the
-vertical border, these have no meaningful data. For clicks on the
-margins, @var{col} is measured from the left edge of the margin area
-and @var{row} is measured from the top of the margin area.
+These are the actual column and row coordinate numbers of the glyph
+under the @var{x}, @var{y} position. If @var{x} lies beyond the last
+column of actual text on its line, @var{col} is reported by adding
+fictional extra columns that have the default character width. Row 0
+is taken to be the header line if the window has one, or the topmost
+row of the text area otherwise. Column 0 is taken to be the leftmost
+column of the text area for clicks on a window text area, or the
+leftmost mode line or header line column for clicks there. For clicks
+on fringes or vertical borders, these have no meaningful data. For
+clicks on margins, @var{col} is measured from the left edge of the
+margin area and @var{row} is measured from the top of the margin area.
@item @var{image}
This is the image object on which the click occurred. It is either
@@ -1361,8 +1373,7 @@ These are the pixel width and height of @var{object} or, if this is
@code{nil}, those of the character glyph clicked on.
@end table
-@sp 1
-For mouse clicks on a scroll-bar, @var{position} has this form:
+For clicks on a scroll bar, @var{position} has this form:
@example
(@var{window} @var{area} (@var{portion} . @var{whole}) @var{timestamp} @var{part})
@@ -1370,32 +1381,35 @@ For mouse clicks on a scroll-bar, @var{position} has this form:
@table @asis
@item @var{window}
-This is the window whose scroll-bar was clicked on.
+The window whose scroll bar was clicked on.
@item @var{area}
-This is the scroll bar where the click occurred. It is one of the
-symbols @code{vertical-scroll-bar} or @code{horizontal-scroll-bar}.
+This is the symbol @code{vertical-scroll-bar}.
@item @var{portion}
-This is the distance of the click from the top or left end of
-the scroll bar.
+The number of pixels from the top of the scroll bar to the click
+position. On some toolkits, including GTK+, Emacs cannot extract this
+data, so the value is always @code{0}.
@item @var{whole}
-This is the length of the entire scroll bar.
+The total length, in pixels, of the scroll bar. On some toolkits,
+including GTK+, Emacs cannot extract this data, so the value is always
+@code{0}.
@item @var{timestamp}
-This is the time at which the event occurred, in milliseconds.
+The time at which the event occurred, in milliseconds. On some
+toolkits, including GTK+, Emacs cannot extract this data, so the value
+is always @code{0}.
@item @var{part}
-This is the part of the scroll-bar which was clicked on. It is one
-of the symbols @code{above-handle}, @code{handle}, @code{below-handle},
-@code{up}, @code{down}, @code{top}, @code{bottom}, and @code{end-scroll}.
+The part of the scroll bar on which the click occurred. It is one of
+the symbols @code{handle} (the scroll bar handle), @code{above-handle}
+(the area above the handle), @code{below-handle} (the area below the
+handle), @code{up} (the up arrow at one end of the scroll bar), or
+@code{down} (the down arrow at one end of the scroll bar).
+@c The `top', `bottom', and `end-scroll' codes don't seem to be used.
@end table
-@item @var{click-count}
-This is the number of rapid repeated presses so far of the same mouse
-button. @xref{Repeat Events}.
-@end table
@node Drag Events
@subsection Drag Events
@@ -1419,10 +1433,9 @@ For a drag event, the name of the symbol @var{event-type} contains the
prefix @samp{drag-}. For example, dragging the mouse with button 2
held down generates a @code{drag-mouse-2} event. The second and third
elements of the event give the starting and ending position of the
-drag. They have the same form as @var{position} in a click event
-(@pxref{Click Events}) that is not on the scroll bar part of the
-window. You can access the second element of any mouse event in the
-same way, with no need to distinguish drag events from others.
+drag, as mouse position lists (@pxref{Click Events}). You can access
+the second element of any mouse event in the same way, with no need to
+distinguish drag events from others.
The @samp{drag-} prefix follows the modifier key prefixes such as
@samp{C-} and @samp{M-}.
@@ -1565,13 +1578,14 @@ represented by lists that look like this:
(mouse-movement POSITION)
@end example
-The second element of the list describes the current position of the
-mouse, just as in a click event (@pxref{Click Events}).
+@noindent
+@var{position} is a mouse position list (@pxref{Click Events}),
+specifying the current position of the mouse cursor.
-The special form @code{track-mouse} enables generation of motion events
-within its body. Outside of @code{track-mouse} forms, Emacs does not
-generate events for mere motion of the mouse, and these events do not
-appear. @xref{Mouse Tracking}.
+The special form @code{track-mouse} enables generation of motion
+events within its body. Outside of @code{track-mouse} forms, Emacs
+does not generate events for mere motion of the mouse, and these
+events do not appear. @xref{Mouse Tracking}.
@node Focus Events
@subsection Focus Events
@@ -1638,13 +1652,11 @@ frame has already been made visible, Emacs has no work to do.
@cindex @code{wheel-up} event
@cindex @code{wheel-down} event
@item (wheel-up @var{position})
-@item (wheel-down @var{position})
-These kinds of event are generated by moving a mouse wheel. Their
-usual meaning is a kind of scroll or zoom.
-
-The element @var{position} is a list describing the position of the
-event, in the same format as used in a mouse-click event (@pxref{Click
-Events}).
+@itemx (wheel-down @var{position})
+These kinds of event are generated by moving a mouse wheel. The
+@var{position} element is a mouse position list (@pxref{Click
+Events}), specifying the position of the mouse cursor when the event
+occurred.
@vindex mouse-wheel-up-event
@vindex mouse-wheel-down-event
@@ -1692,6 +1704,7 @@ parameters are used to display the help-echo text are described in
These events are generated when the Emacs process receives
the signals @code{SIGUSR1} and @code{SIGUSR2}. They contain no
additional data because signals do not carry additional information.
+They can be useful for debugging (@pxref{Error Debugging}).
To catch a user signal, bind the corresponding event to an interactive
command in the @code{special-event-map} (@pxref{Active Keymaps}).
@@ -1711,6 +1724,38 @@ To test the signal handler, you can make Emacs send a signal to itself:
@smallexample
(signal-process (emacs-pid) 'sigusr1)
@end smallexample
+
+@cindex @code{language-change} event
+@item language-change
+This kind of event is generated on MS-Windows when the input language
+has changed. This typically means that the keyboard keys will send to
+Emacs characters from a different language. The generated event has
+this form:
+
+@smallexample
+(language-change @var{frame} @var{codepage} @var{language-id})
+@end smallexample
+
+@noindent
+Here @var{frame} is the frame which was current when the input
+language changed; @var{codepage} is the new codepage number; and
+@var{language-id} is the numerical ID of the new input language. The
+coding-system (@pxref{Coding Systems}) that corresponds to
+@var{codepage} is @code{cp@var{codepage}} or
+@code{windows-@var{codepage}}. To convert @var{language-id} to a
+string (e.g., to use it for various language-dependent features, such
+as @code{set-language-environment}), use the
+@code{w32-get-locale-info} function, like this:
+
+@smallexample
+;; Get the abbreviated language name, such as "ENU" for English
+(w32-get-locale-info language-id)
+;; Get the full English name of the language,
+;; such as "English (United States)"
+(w32-get-locale-info language-id 4097)
+;; Get the full localized name of the language
+(w32-get-locale-info language-id t)
+@end smallexample
@end table
If one of these events arrives in the middle of a key sequence---that
@@ -1879,14 +1924,8 @@ must be the last element of the list. For example,
This section describes convenient functions for accessing the data in
a mouse button or motion event.
- These two functions return the starting or ending position of a
-mouse-button event, as a list of this form:
-
-@example
-(@var{window} @var{pos-or-area} (@var{x} . @var{y}) @var{timestamp}
- @var{object} @var{text-pos} (@var{col} . @var{row})
- @var{image} (@var{dx} . @var{dy}) (@var{width} . @var{height}))
-@end example
+ The following two functions return a mouse position list
+(@pxref{Click Events}), specifying the position of a mouse event.
@defun event-start event
This returns the starting position of @var{event}.
@@ -1905,9 +1944,15 @@ event, the value is actually the starting position, which is the only
position such events have.
@end defun
+@defun posnp object
+This function returns non-@code{nil} if @var{object} is a mouse
+position list, in either of the formats documented in @ref{Click
+Events}); and @code{nil} otherwise.
+@end defun
+
@cindex mouse position list, accessing
- These functions take a position list as described above, and
-return various parts of it.
+ These functions take a mouse position list as argument, and return
+various parts of it:
@defun posn-window position
Return the window that @var{position} is in.
@@ -1931,12 +1976,13 @@ Return the pixel-based x and y coordinates in @var{position}, as a
cons cell @code{(@var{x} . @var{y})}. These coordinates are relative
to the window given by @code{posn-window}.
-This example shows how to convert these window-relative coordinates
-into frame-relative coordinates:
+This example shows how to convert the window-relative coordinates in
+the text area of a window into frame-relative coordinates:
@example
(defun frame-relative-coordinates (position)
- "Return frame-relative coordinates from POSITION."
+ "Return frame-relative coordinates from POSITION.
+POSITION is assumed to lie in a window text area."
(let* ((x-y (posn-x-y position))
(window (posn-window position))
(edges (window-inside-pixel-edges window)))
@@ -1961,10 +2007,10 @@ window possesses a header line (@pxref{Header Lines}), it is
@defun posn-actual-col-row position
Return the actual row and column in @var{position}, as a cons cell
-@code{(@var{col} . @var{row})}. The values are the actual row number
-in the window, and the actual character number in that row. It returns
-@code{nil} if @var{position} does not include actual positions values.
-You can use @code{posn-col-row} to get approximate values.
+@code{(@var{col} . @var{row})}. The values are the actual row and
+column numbers in the window. @xref{Click Events}, for details. It
+returns @code{nil} if @var{position} does not include actual positions
+values.
@end defun
@defun posn-string position
@@ -2316,7 +2362,7 @@ same symbol that would normally represent that combination of mouse
button and modifier keys. The information about the window part is kept
elsewhere in the event---in the coordinates. But
@code{read-key-sequence} translates this information into imaginary
-``prefix keys,'' all of which are symbols: @code{header-line},
+``prefix keys'', all of which are symbols: @code{header-line},
@code{horizontal-scroll-bar}, @code{menu-bar}, @code{mode-line},
@code{vertical-line}, and @code{vertical-scroll-bar}. You can define
meanings for mouse clicks in special window parts by defining key
@@ -2334,7 +2380,6 @@ mouse on the window's mode line, you get two events, like this:
@end example
@defvar num-input-keys
-@c Emacs 19 feature
This variable's value is the number of key sequences processed so far in
this Emacs session. This includes key sequences read from the terminal
and key sequences read from keyboard macros being executed.
@@ -2468,6 +2513,17 @@ The argument @var{prompt} is either a string to be displayed in the
echo area as a prompt, or @code{nil}, meaning not to display a prompt.
@end defun
+@defun read-char-choice prompt chars &optional inhibit-quit
+This function uses @code{read-key} to read and return a single
+character. It ignores any input that is not a member of @var{chars},
+a list of accepted characters. Optionally, it will also ignore
+keyboard-quit events while it is waiting for valid input. If you bind
+@code{help-form} (@pxref{Help Functions}) to a non-@code{nil} value
+while calling @code{read-char-choice}, then pressing @code{help-char}
+causes it to evaluate @code{help-form} and display the result. It
+then continues to wait for a valid input character, or keyboard-quit.
+@end defun
+
@node Event Mod
@subsection Modifying and Translating Input Events
@@ -2476,7 +2532,6 @@ echo area as a prompt, or @code{nil}, meaning not to display a prompt.
@code{keyboard-translate-table} (if applicable), before returning it
from @code{read-event}.
-@c Emacs 19 feature
@defvar extra-keyboard-modifiers
This variable lets Lisp programs ``press'' the modifier keys on the
keyboard. The value is a character. Only the modifiers of the
@@ -2664,9 +2719,9 @@ Likewise, incremental search uses this feature to unread events with no
special meaning in a search, because these events should exit the search
and then execute normally.
-The reliable and easy way to extract events from a key sequence so as to
-put them in @code{unread-command-events} is to use
-@code{listify-key-sequence} (@pxref{Strings of Events}).
+The reliable and easy way to extract events from a key sequence so as
+to put them in @code{unread-command-events} is to use
+@code{listify-key-sequence} (see below).
Normally you add events to the front of this list, so that the events
most recently unread will be reread first.
@@ -2683,15 +2738,6 @@ This function converts the string or vector @var{key} to a list of
individual events, which you can put in @code{unread-command-events}.
@end defun
-@defvar unread-command-char
-This variable holds a character to be read as command input.
-A value of -1 means ``empty.''
-
-This variable is mostly obsolete now that you can use
-@code{unread-command-events} instead; it exists only to support programs
-written for Emacs versions 18 and earlier.
-@end defvar
-
@defun input-pending-p
@cindex waiting for command key input
This function determines whether any command input is currently
@@ -2701,7 +2747,6 @@ may return @code{t} when no input is available.
@end defun
@defvar last-input-event
-@defvarx last-input-char
This variable records the last terminal input event read, whether
as part of a command or explicitly by a Lisp program.
@@ -2720,8 +2765,6 @@ this expression) remains the value of @code{last-command-event}.
@result{} 49
@end group
@end example
-
-The alias @code{last-input-char} is obsolete.
@end defvar
@defmac while-no-input body@dots{}
@@ -2771,28 +2814,29 @@ during the sleep.
@section Special Events
@cindex special events
-Special events are handled at a very low level---as soon as they are
-read. The @code{read-event} function processes these events itself, and
-never returns them. Instead, it keeps waiting for the first event
-that is not special and returns that one.
+Certain @dfn{special events} are handled at a very low level---as soon
+as they are read. The @code{read-event} function processes these
+events itself, and never returns them. Instead, it keeps waiting for
+the first event that is not special and returns that one.
-Events that are handled in this way do not echo, they are never grouped
-into key sequences, and they never appear in the value of
+ Special events do not echo, they are never grouped into key
+sequences, and they never appear in the value of
@code{last-command-event} or @code{(this-command-keys)}. They do not
discard a numeric argument, they cannot be unread with
@code{unread-command-events}, they may not appear in a keyboard macro,
and they are not recorded in a keyboard macro while you are defining
one.
-These events do, however, appear in @code{last-input-event} immediately
-after they are read, and this is the way for the event's definition to
-find the actual event.
+ Special events do, however, appear in @code{last-input-event}
+immediately after they are read, and this is the way for the event's
+definition to find the actual event.
-The events types @code{iconify-frame}, @code{make-frame-visible},
-@code{delete-frame}, @code{drag-n-drop}, and user signals like
-@code{sigusr1} are normally handled in this way. The keymap which
-defines how to handle special events---and which events are special---is
-in the variable @code{special-event-map} (@pxref{Active Keymaps}).
+ The events types @code{iconify-frame}, @code{make-frame-visible},
+@code{delete-frame}, @code{drag-n-drop}, @code{language-change}, and
+user signals like @code{sigusr1} are normally handled in this way.
+The keymap which defines how to handle special events---and which
+events are special---is in the variable @code{special-event-map}
+(@pxref{Active Keymaps}).
@node Waiting
@section Waiting for Elapsed Time or Input
@@ -3174,7 +3218,7 @@ using the minibuffer. Usually it is more convenient for the user if you
change the major mode of the current buffer temporarily to a special
major mode, which should have a command to go back to the previous mode.
(The @kbd{e} command in Rmail uses this technique.) Or, if you wish to
-give the user different text to edit ``recursively,'' create and select
+give the user different text to edit ``recursively'', create and select
a new buffer in a special mode. In this mode, define a command to
complete the processing and go back to the previous buffer. (The
@kbd{m} command in Rmail does this.)
@@ -3187,7 +3231,7 @@ a recursive edit but also provides the other features of the debugger.
Recursive editing levels are also used when you type @kbd{C-r} in
@code{query-replace} or use @kbd{C-x q} (@code{kbd-macro-query}).
-@defun recursive-edit
+@deffn Command recursive-edit
@cindex suspend evaluation
This function invokes the editor command loop. It is called
automatically by the initialization of Emacs, to let the user begin
@@ -3214,7 +3258,7 @@ then type @kbd{C-M-c} to exit and continue executing @code{simple-rec}.
(simple-rec)
@result{} nil
@end example
-@end defun
+@end deffn
@deffn Command exit-recursive-edit
This function exits from the innermost recursive edit (including
@@ -3407,7 +3451,7 @@ buffer-local. @xref{Multiple Terminals}.
@end defvar
@defvar kbd-macro-termination-hook
-This normal hook (@pxref{Standard Hooks}) is run when a keyboard
-macro terminates, regardless of what caused it to terminate (reaching
-the macro end or an error which ended the macro prematurely).
+This normal hook is run when a keyboard macro terminates, regardless
+of what caused it to terminate (reaching the macro end or an error
+which ended the macro prematurely).
@end defvar
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index 372c041ab7a..f088934f5f1 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1994, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1994, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/compile
-@node Byte Compilation, Advising Functions, Loading, Top
+@node Byte Compilation
@chapter Byte Compilation
@cindex byte compilation
@cindex byte-code
@@ -32,9 +31,6 @@ variable binding for @code{no-byte-compile} into it, like this:
;; -*-no-byte-compile: t; -*-
@end example
- @xref{Compilation Errors}, for how to investigate errors occurring in
-byte compilation.
-
@menu
* Speed of Byte-Code:: An example of speedup from byte compilation.
* Compilation Functions:: Byte compilation functions.
@@ -56,18 +52,16 @@ Here is an example:
@example
@group
(defun silly-loop (n)
- "Return time before and after N iterations of a loop."
- (let ((t1 (current-time-string)))
- (while (> (setq n (1- n))
- 0))
- (list t1 (current-time-string))))
+ "Return the time, in seconds, to run N iterations of a loop."
+ (let ((t1 (float-time)))
+ (while (> (setq n (1- n)) 0))
+ (- (float-time) t1)))
@result{} silly-loop
@end group
@group
(silly-loop 50000000)
-@result{} ("Wed Mar 11 21:10:19 2009"
- "Wed Mar 11 21:10:41 2009") ; @r{22 seconds}
+@result{} 10.235304117202759
@end group
@group
@@ -77,18 +71,16 @@ Here is an example:
@group
(silly-loop 50000000)
-@result{} ("Wed Mar 11 21:12:26 2009"
- "Wed Mar 11 21:12:32 2009") ; @r{6 seconds}
+@result{} 3.705854892730713
@end group
@end example
- In this example, the interpreted code required 22 seconds to run,
-whereas the byte-compiled code required 6 seconds. These results are
-representative, but actual results will vary greatly.
+ In this example, the interpreted code required 10 seconds to run,
+whereas the byte-compiled code required less than 4 seconds. These
+results are representative, but actual results may vary.
@node Compilation Functions
-@comment node-name, next, previous, up
-@section The Compilation Functions
+@section Byte-Compilation Functions
@cindex compilation functions
You can byte-compile an individual function or macro definition with
@@ -96,43 +88,36 @@ the @code{byte-compile} function. You can compile a whole file with
@code{byte-compile-file}, or several files with
@code{byte-recompile-directory} or @code{batch-byte-compile}.
- The byte compiler produces error messages and warnings about each file
-in a buffer called @samp{*Compile-Log*}. These report things in your
-program that suggest a problem but are not necessarily erroneous.
+ Sometimes, the byte compiler produces warning and/or error messages
+(@pxref{Compiler Errors}, for details). These messages are recorded
+in a buffer called @file{*Compile-Log*}, which uses Compilation mode.
+@xref{Compilation Mode,,,emacs, The GNU Emacs Manual}.
@cindex macro compilation
- Be careful when writing macro calls in files that you may someday
-byte-compile. Macro calls are expanded when they are compiled, so the
-macros must already be defined for proper compilation. For more
-details, see @ref{Compiling Macros}. If a program does not work the
-same way when compiled as it does when interpreted, erroneous macro
-definitions are one likely cause (@pxref{Problems with Macros}).
-Inline (@code{defsubst}) functions are less troublesome; if you
+ Be careful when writing macro calls in files that you intend to
+byte-compile. Since macro calls are expanded when they are compiled,
+the macros need to be loaded into Emacs or the byte compiler will not
+do the right thing. The usual way to handle this is with
+@code{require} forms which specify the files containing the needed
+macro definitions (@pxref{Named Features}). Normally, the
+byte compiler does not evaluate the code that it is compiling, but it
+handles @code{require} forms specially, by loading the specified
+libraries. To avoid loading the macro definition files when someone
+@emph{runs} the compiled program, write @code{eval-when-compile}
+around the @code{require} calls (@pxref{Eval During Compile}). For
+more details, @xref{Compiling Macros}.
+
+ Inline (@code{defsubst}) functions are less troublesome; if you
compile a call to such a function before its definition is known, the
call will still work right, it will just run slower.
- Normally, compiling a file does not evaluate the file's contents or
-load the file. But it does execute any @code{require} calls at top
-level in the file. One way to ensure that necessary macro definitions
-are available during compilation is to require the file that defines
-them (@pxref{Named Features}). To avoid loading the macro definition files
-when someone @emph{runs} the compiled program, write
-@code{eval-when-compile} around the @code{require} calls (@pxref{Eval
-During Compile}).
-
@defun byte-compile symbol
This function byte-compiles the function definition of @var{symbol},
replacing the previous definition with the compiled one. The function
definition of @var{symbol} must be the actual code for the function;
-i.e., the compiler does not follow indirection to another symbol.
-@code{byte-compile} returns the new, compiled definition of
-@var{symbol}.
-
- If @var{symbol}'s definition is a byte-code function object,
-@code{byte-compile} does nothing and returns @code{nil}. Lisp records
-only one function definition for any symbol, and if that is already
-compiled, non-compiled code is not available anywhere. So there is no
-way to ``compile the same definition again.''
+@code{byte-compile} does not handle function indirection. The return
+value is the byte-code function object which is the compiled
+definition of @var{symbol} (@pxref{Byte-Code Objects}).
@example
@group
@@ -153,16 +138,15 @@ way to ``compile the same definition again.''
@end group
@end example
-@noindent
-The result is a byte-code function object. The string it contains is
-the actual byte-code; each character in it is an instruction or an
-operand of an instruction. The vector contains all the constants,
-variable names and function names used by the function, except for
-certain primitives that are coded as special instructions.
-
-If the argument to @code{byte-compile} is a @code{lambda} expression,
-it returns the corresponding compiled code, but does not store
-it anywhere.
+If @var{symbol}'s definition is a byte-code function object,
+@code{byte-compile} does nothing and returns @code{nil}. It does not
+``compile the symbol's definition again'', since the original
+(non-compiled) code has already been replaced in the symbol's function
+cell by the byte-compiled code.
+
+The argument to @code{byte-compile} can also be a @code{lambda}
+expression. In that case, the function returns the corresponding
+compiled code but does not store it anywhere.
@end defun
@deffn Command compile-defun &optional arg
@@ -252,19 +236,6 @@ files that have an up-to-date @samp{.elc} file.
@end example
@end defun
-@defun byte-code code-string data-vector max-stack
-@cindex byte-code interpreter
-This function actually interprets byte-code. A byte-compiled function
-is actually defined with a body that calls @code{byte-code}. Don't call
-this function yourself---only the byte compiler knows how to generate
-valid calls to this function.
-
-In Emacs version 18, byte-code was always executed by way of a call to
-the function @code{byte-code}. Nowadays, byte-code is usually executed
-as part of a byte-code function object, and only rarely through an
-explicit call to @code{byte-code}.
-@end defun
-
@node Docs and Compilation
@section Documentation Strings and Compilation
@cindex dynamic loading of documentation
@@ -290,33 +261,11 @@ then further access to documentation strings in this file will
probably give nonsense results.
@end itemize
- If your site installs Emacs following the usual procedures, these
-problems will never normally occur. Installing a new version uses a new
-directory with a different name; as long as the old version remains
-installed, its files will remain unmodified in the places where they are
-expected to be.
-
- However, if you have built Emacs yourself and use it from the
-directory where you built it, you will experience this problem
-occasionally if you edit and recompile Lisp files. When it happens, you
-can cure the problem by reloading the file after recompiling it.
-
- You can turn off this feature at compile time by setting
-@code{byte-compile-dynamic-docstrings} to @code{nil}; this is useful
-mainly if you expect to change the file, and you want Emacs processes
-that have already loaded it to keep working when the file changes.
-You can do this globally, or for one source file by specifying a
-file-local binding for the variable. One way to do that is by adding
-this string to the file's first line:
-
-@example
--*-byte-compile-dynamic-docstrings: nil;-*-
-@end example
-
-@defvar byte-compile-dynamic-docstrings
-If this is non-@code{nil}, the byte compiler generates compiled files
-that are set up for dynamic loading of documentation strings.
-@end defvar
+@noindent
+These problems normally occur only if you build Emacs yourself and use
+it from the directory where you built it, and you happen to edit
+and/or recompile the Lisp source files. They can be easily cured by
+reloading each file after recompiling it.
@cindex @samp{#@@@var{count}}
@cindex @samp{#$}
@@ -324,10 +273,27 @@ that are set up for dynamic loading of documentation strings.
use a special Lisp reader construct, @samp{#@@@var{count}}. This
construct skips the next @var{count} characters. It also uses the
@samp{#$} construct, which stands for ``the name of this file, as a
-string.'' It is usually best not to use these constructs in Lisp source
+string''. It is usually best not to use these constructs in Lisp source
files, since they are not designed to be clear to humans reading the
file.
+ You can disable the dynamic documentation string feature at compile
+time by setting @code{byte-compile-dynamic-docstrings} to @code{nil};
+this is useful mainly if you expect to change the file, and you want
+Emacs processes that have already loaded it to keep working when the
+file changes. You can do this globally, or for one source file by
+specifying a file-local binding for the variable. One way to do that
+is by adding this string to the file's first line:
+
+@example
+-*-byte-compile-dynamic-docstrings: nil;-*-
+@end example
+
+@defopt byte-compile-dynamic-docstrings
+If this is non-@code{nil}, the byte compiler generates compiled files
+that are set up for dynamic loading of documentation strings.
+@end defopt
+
@node Dynamic Loading
@section Dynamic Loading of Individual Functions
@@ -475,15 +441,24 @@ to what @code{eval-when-compile} does.
@cindex compiler errors
Byte compilation outputs all errors and warnings into the buffer
-@samp{*Compile-Log*}. The messages include file names and line
+@file{*Compile-Log*}. The messages include file names and line
numbers that identify the location of the problem. The usual Emacs
-commands for operating on compiler diagnostics work properly on
-these messages.
-
- However, the warnings about functions that were used but not
-defined are always ``located'' at the end of the file, so these
-commands won't find the places they are really used. To do that,
-you must search for the function names.
+commands for operating on compiler diagnostics work properly on these
+messages.
+
+ When an error is due to invalid syntax in the program, the byte
+compiler might get confused about the errors' exact location. One way
+to investigate is to switch to the buffer @w{@file{ *Compiler Input*}}.
+(This buffer name starts with a space, so it does not show up in
+@kbd{M-x list-buffers}.) This buffer contains the program being
+compiled, and point shows how far the byte compiler was able to read;
+the cause of the error might be nearby. @xref{Syntax Errors}, for
+some tips for locating syntax errors.
+
+ When the byte compiler warns about functions that were used but not
+defined, it always reports the line number for the end of the file,
+not the locations where the missing functions were called. To find
+the latter, you must search for the function names.
You can suppress the compiler warning for calling an undefined
function @var{func} by conditionalizing the function call on an
@@ -541,17 +516,16 @@ one you intend to suppress.
@cindex byte-code function
Byte-compiled functions have a special data type: they are
-@dfn{byte-code function objects}.
+@dfn{byte-code function objects}. Whenever such an object appears as
+a function to be called, Emacs uses the byte-code interpreter to
+execute the byte-code.
- Internally, a byte-code function object is much like a vector;
-however, the evaluator handles this data type specially when it appears
-as a function to be called. The printed representation for a byte-code
-function object is like that for a vector, with an additional @samp{#}
-before the opening @samp{[}.
-
- A byte-code function object must have at least four elements; there is
-no maximum number, but only the first six elements have any normal use.
-They are:
+ Internally, a byte-code function object is much like a vector; its
+elements can be accessed using @code{aref}. Its printed
+representation is like that for a vector, with an additional @samp{#}
+before the opening @samp{[}. It must have at least four elements;
+there is no maximum number, but only the first six elements have any
+normal use. They are:
@table @var
@item arglist
@@ -588,7 +562,7 @@ representation. It is the definition of the command
[arg 1 forward-sexp]
2
254435
- "p"]
+ "^p"]
@end example
The primitive way to create a byte-code object is with
@@ -604,10 +578,6 @@ function yourself, because if they are inconsistent, Emacs may crash
when you call the function. Always leave it to the byte compiler to
create these objects; it makes the elements consistent (we hope).
- You can access the elements of a byte-code object using @code{aref};
-you can also use @code{vconcat} to create a vector with the same
-elements.
-
@node Disassembly
@section Disassembled Byte-Code
@cindex disassembled byte-code
@@ -630,7 +600,7 @@ the stack.
@deffn Command disassemble object &optional buffer-or-name
This command displays the disassembled code for @var{object}. In
interactive use, or if @var{buffer-or-name} is @code{nil} or omitted,
-the output goes in a buffer named @samp{*Disassemble*}. If
+the output goes in a buffer named @file{*Disassemble*}. If
@var{buffer-or-name} is non-@code{nil}, it must be a buffer or the
name of an existing buffer. Then the output goes there, at point, and
point is left before the output.
@@ -666,41 +636,34 @@ Lisp source; these do not appear in the output of @code{disassemble}.
@end group
@group
-0 varref integer ; @r{Get the value of @code{integer}}
- ; @r{and push it onto the stack.}
-1 constant 1 ; @r{Push 1 onto stack.}
+0 varref integer ; @r{Get the value of @code{integer} and}
+ ; @r{push it onto the stack.}
+1 constant 1 ; @r{Push 1 onto stack.}
@end group
-
@group
-2 eqlsign ; @r{Pop top two values off stack, compare}
- ; @r{them, and push result onto stack.}
+2 eqlsign ; @r{Pop top two values off stack, compare}
+ ; @r{them, and push result onto stack.}
@end group
-
@group
-3 goto-if-nil 1 ; @r{Pop and test top of stack;}
- ; @r{if @code{nil}, go to 1,}
- ; @r{else continue.}
-6 constant 1 ; @r{Push 1 onto top of stack.}
-7 return ; @r{Return the top element}
- ; @r{of the stack.}
+3 goto-if-nil 1 ; @r{Pop and test top of stack;}
+ ; @r{if @code{nil}, go to 1, else continue.}
+6 constant 1 ; @r{Push 1 onto top of stack.}
+7 return ; @r{Return the top element of the stack.}
@end group
-
@group
-8:1 varref integer ; @r{Push value of @code{integer} onto stack.}
-9 constant factorial ; @r{Push @code{factorial} onto stack.}
-10 varref integer ; @r{Push value of @code{integer} onto stack.}
-11 sub1 ; @r{Pop @code{integer}, decrement value,}
- ; @r{push new value onto stack.}
-12 call 1 ; @r{Call function @code{factorial} using}
- ; @r{the first (i.e., the top) element}
- ; @r{of the stack as the argument;}
- ; @r{push returned value onto stack.}
+8:1 varref integer ; @r{Push value of @code{integer} onto stack.}
+9 constant factorial ; @r{Push @code{factorial} onto stack.}
+10 varref integer ; @r{Push value of @code{integer} onto stack.}
+11 sub1 ; @r{Pop @code{integer}, decrement value,}
+ ; @r{push new value onto stack.}
+12 call 1 ; @r{Call function @code{factorial} using first}
+ ; @r{(i.e. top) stack element as argument;}
+ ; @r{push returned value onto stack.}
@end group
-
@group
-13 mult ; @r{Pop top two values off stack, multiply}
- ; @r{them, and push result onto stack.}
-14 return ; @r{Return the top element of stack.}
+13 mult ; @r{Pop top two values off stack, multiply}
+ ; @r{them, and push result onto stack.}
+14 return ; @r{Return the top element of the stack.}
@end group
@end example
@@ -722,70 +685,56 @@ The @code{silly-loop} function is somewhat more complex:
@print{} byte-code for silly-loop:
doc: Return time before and after N iterations of a loop.
args: (n)
+@end group
-0 constant current-time-string ; @r{Push}
- ; @r{@code{current-time-string}}
+@group
+0 constant current-time-string ; @r{Push @code{current-time-string}}
; @r{onto top of stack.}
@end group
-
@group
-1 call 0 ; @r{Call @code{current-time-string}}
- ; @r{with no argument,}
- ; @r{pushing result onto stack.}
+1 call 0 ; @r{Call @code{current-time-string} with no}
+ ; @r{argument, push result onto stack.}
@end group
-
@group
-2 varbind t1 ; @r{Pop stack and bind @code{t1}}
- ; @r{to popped value.}
+2 varbind t1 ; @r{Pop stack and bind @code{t1} to popped value.}
@end group
-
@group
-3:1 varref n ; @r{Get value of @code{n} from}
- ; @r{the environment and push}
- ; @r{the value onto the stack.}
-4 sub1 ; @r{Subtract 1 from top of stack.}
+3:1 varref n ; @r{Get value of @code{n} from the environment}
+ ; @r{and push the value on the stack.}
+4 sub1 ; @r{Subtract 1 from top of stack.}
@end group
-
@group
-5 dup ; @r{Duplicate the top of the stack;}
- ; @r{i.e., copy the top of}
- ; @r{the stack and push the}
- ; @r{copy onto the stack.}
-6 varset n ; @r{Pop the top of the stack,}
- ; @r{and bind @code{n} to the value.}
-
- ; @r{In effect, the sequence @code{dup varset}}
- ; @r{copies the top of the stack}
- ; @r{into the value of @code{n}}
- ; @r{without popping it.}
+5 dup ; @r{Duplicate top of stack; i.e. copy the top}
+ ; @r{of the stack and push copy onto stack.}
+6 varset n ; @r{Pop the top of the stack,}
+ ; @r{and bind @code{n} to the value.}
+
+;; @r{(In effect, the sequence @code{dup varset} copies the top of the stack}
+;; @r{into the value of @code{n} without popping it.)}
@end group
@group
-7 constant 0 ; @r{Push 0 onto stack.}
-8 gtr ; @r{Pop top two values off stack,}
- ; @r{test if @var{n} is greater than 0}
- ; @r{and push result onto stack.}
+7 constant 0 ; @r{Push 0 onto stack.}
+8 gtr ; @r{Pop top two values off stack,}
+ ; @r{test if @var{n} is greater than 0}
+ ; @r{and push result onto stack.}
@end group
-
@group
-9 goto-if-not-nil 1 ; @r{Goto 1 if @code{n} > 0}
- ; @r{(this continues the while loop)}
- ; @r{else continue.}
+9 goto-if-not-nil 1 ; @r{Goto 1 if @code{n} > 0}
+ ; @r{(this continues the while loop)}
+ ; @r{else continue.}
@end group
-
@group
-12 varref t1 ; @r{Push value of @code{t1} onto stack.}
+12 varref t1 ; @r{Push value of @code{t1} onto stack.}
13 constant current-time-string ; @r{Push @code{current-time-string}}
- ; @r{onto top of stack.}
-14 call 0 ; @r{Call @code{current-time-string} again.}
+ ; @r{onto the top of the stack.}
+14 call 0 ; @r{Call @code{current-time-string} again.}
@end group
-
@group
-15 unbind 1 ; @r{Unbind @code{t1} in local environment.}
-16 list2 ; @r{Pop top two elements off stack,}
- ; @r{create a list of them,}
- ; @r{and push list onto stack.}
-17 return ; @r{Return value of the top of stack.}
+15 unbind 1 ; @r{Unbind @code{t1} in local environment.}
+16 list2 ; @r{Pop top two elements off stack, create a}
+ ; @r{list of them, and push it onto stack.}
+17 return ; @r{Return value of the top of stack.}
@end group
@end example
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 875c23658b9..489e5cc5b22 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -1,18 +1,17 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/control
-@node Control Structures, Variables, Evaluation, Top
+@node Control Structures
@chapter Control Structures
@cindex special forms for control structures
@cindex control structures
- A Lisp program consists of expressions or @dfn{forms} (@pxref{Forms}).
-We control the order of execution of these forms by enclosing them in
-@dfn{control structures}. Control structures are special forms which
-control when, whether, or how many times to execute the forms they
-contain.
+ A Lisp program consists of a set of @dfn{expressions}, or
+@dfn{forms} (@pxref{Forms}). We control the order of execution of
+these forms by enclosing them in @dfn{control structures}. Control
+structures are special forms which control when, whether, or how many
+times to execute the forms they contain.
@cindex textual order
The simplest order of execution is sequential execution: first form
@@ -94,8 +93,8 @@ order, returning the result of the final form.
@end example
@end defspec
- Two other control constructs likewise evaluate a series of forms but return
-a different value:
+ Two other constructs likewise evaluate a series of forms but return
+different values:
@defspec prog1 form1 forms@dots{}
This special form evaluates @var{form1} and all of the @var{forms}, in
@@ -160,8 +159,8 @@ If @var{condition} has the value @code{nil}, and no @var{else-forms} are
given, @code{if} returns @code{nil}.
@code{if} is a special form because the branch that is not selected is
-never evaluated---it is ignored. Thus, in the example below,
-@code{true} is not printed because @code{print} is never called.
+never evaluated---it is ignored. Thus, in this example,
+@code{true} is not printed because @code{print} is never called:
@example
@group
@@ -221,7 +220,7 @@ non-@code{nil}, the clause ``succeeds''; then @code{cond} evaluates its
@var{body-forms}, and the value of the last of @var{body-forms} becomes
the value of the @code{cond}. The remaining clauses are ignored.
-If the value of @var{condition} is @code{nil}, the clause ``fails,'' so
+If the value of @var{condition} is @code{nil}, the clause ``fails'', so
the @code{cond} moves on to the following clause, trying its
@var{condition}.
@@ -258,9 +257,7 @@ clauses was successful. To do this, we use @code{t} as the
@var{condition} of the last clause, like this: @code{(t
@var{body-forms})}. The form @code{t} evaluates to @code{t}, which is
never @code{nil}, so this clause never fails, provided the @code{cond}
-gets to it at all.
-
-For example,
+gets to it at all. For example:
@example
@group
@@ -559,16 +556,14 @@ the @code{catch} in @code{foo-outer} specifies the same symbol, so that
@code{catch} in between).
Executing @code{throw} exits all Lisp constructs up to the matching
-@code{catch}, including function calls. When binding constructs such as
-@code{let} or function calls are exited in this way, the bindings are
-unbound, just as they are when these constructs exit normally
+@code{catch}, including function calls. When binding constructs such
+as @code{let} or function calls are exited in this way, the bindings
+are unbound, just as they are when these constructs exit normally
(@pxref{Local Variables}). Likewise, @code{throw} restores the buffer
and position saved by @code{save-excursion} (@pxref{Excursions}), and
-the narrowing status saved by @code{save-restriction} and the window
-selection saved by @code{save-window-excursion} (@pxref{Window
-Configurations}). It also runs any cleanups established with the
-@code{unwind-protect} special form when it exits that form
-(@pxref{Cleanups}).
+the narrowing status saved by @code{save-restriction}. It also runs
+any cleanups established with the @code{unwind-protect} special form
+when it exits that form (@pxref{Cleanups}).
The @code{throw} need not appear lexically within the @code{catch}
that it jumps to. It can equally well be called from another function
@@ -583,7 +578,8 @@ that throw back to the editor command loop (@pxref{Recursive Editing}).
@b{Common Lisp note:} Most other versions of Lisp, including Common Lisp,
have several ways of transferring control nonsequentially: @code{return},
@code{return-from}, and @code{go}, for example. Emacs Lisp has only
-@code{throw}.
+@code{throw}. The @file{cl-lib} library provides versions of some of
+these. @xref{Blocks and Exits,,,cl,Common Lisp Extensions}.
@end quotation
@defspec catch tag body@dots{}
@@ -623,7 +619,7 @@ error is signaled with data @code{(@var{tag} @var{value})}.
@subsection Examples of @code{catch} and @code{throw}
One way to use @code{catch} and @code{throw} is to exit from a doubly
-nested loop. (In most languages, this would be done with a ``goto.'')
+nested loop. (In most languages, this would be done with a ``goto''.)
Here we compute @code{(foo @var{i} @var{j})} for @var{i} and @var{j}
varying from 0 to 9:
@@ -812,10 +808,10 @@ handlers that handle the error: @code{condition-case} binds a local
variable to a list of the form @code{(@var{error-symbol} .@:
@var{data})} (@pxref{Handling Errors}).
-The function @code{signal} never returns (though in older Emacs versions
-it could sometimes return).
+The function @code{signal} never returns.
+@c (though in older Emacs versions it sometimes could).
-@smallexample
+@example
@group
(signal 'wrong-number-of-arguments '(x y))
@error{} Wrong number of arguments: x, y
@@ -825,7 +821,20 @@ it could sometimes return).
(signal 'no-such-error '("My unknown error condition"))
@error{} peculiar error: "My unknown error condition"
@end group
-@end smallexample
+@end example
+@end defun
+
+@cindex user errors, signaling
+@defun user-error format-string &rest args
+This function behaves exactly like @code{error}, except that it uses
+the error symbol @code{user-error} rather than @code{error}. As the
+name suggests, this is intended to report errors on the part of the
+user, rather than errors in the code itself. For example,
+if you try to use the command @code{Info-history-back} (@kbd{l}) to
+move back beyond the start of your Info browsing history, Emacs
+signals a @code{user-error}. Such errors do not cause entry to the
+debugger, even when @code{debug-on-error} is non-@code{nil}.
+@xref{Error Debugging}.
@end defun
@cindex CL note---no continuable errors
@@ -891,9 +900,8 @@ establishing an error handler, with the special form
@noindent
This deletes the file named @var{filename}, catching any error and
-returning @code{nil} if an error occurs@footnote{
-Actually, you should use @code{ignore-errors} in such a simple case;
-see below.}.
+returning @code{nil} if an error occurs. (You can use the macro
+@code{ignore-errors} for a simple case like this; see below.)
The @code{condition-case} construct is often used to trap errors that
are predictable, such as failure to open a file in a call to
@@ -949,6 +957,13 @@ The effect of @code{debug} here is only to prevent
given error will invoke the debugger only if @code{debug-on-error} and
the other usual filtering mechanisms say it should. @xref{Error Debugging}.
+@defmac condition-case-unless-debug var protected-form handlers@dots{}
+The macro @code{condition-case-unless-debug} provides another way to
+handle debugging of such forms. It behaves exactly like
+@code{condition-case}, unless the variable @code{debug-on-error} is
+non-@code{nil}, in which case it does not handle any errors at all.
+@end defmac
+
Once Emacs decides that a certain handler handles the error, it
returns control to that handler. To do so, Emacs unbinds all variable
bindings made by binding constructs that are being exited, and
@@ -985,7 +1000,7 @@ to allow the debugger to run before the handler); @var{body} is one or more
Lisp expressions to be executed when this handler handles an error.
Here are examples of handlers:
-@smallexample
+@example
@group
(error nil)
@@ -995,7 +1010,7 @@ Here are examples of handlers:
(message
"Either division by zero or failure to open a file"))
@end group
-@end smallexample
+@end example
Each error that occurs has an @dfn{error symbol} that describes what
kind of error it is. The @code{error-conditions} property of this
@@ -1028,9 +1043,9 @@ Sometimes it is necessary to re-throw a signal caught by
@code{condition-case}, for some outer-level handler to catch. Here's
how to do that:
-@smallexample
+@example
(signal (car err) (cdr err))
-@end smallexample
+@end example
@noindent
where @code{err} is the error description variable, the first argument
@@ -1049,7 +1064,7 @@ Here is an example of using @code{condition-case} to handle the error
that results from dividing by zero. The handler displays the error
message (but without a beep), then returns a very large number.
-@smallexample
+@example
@group
(defun safe-divide (dividend divisor)
(condition-case err
@@ -1070,22 +1085,24 @@ message (but without a beep), then returns a very large number.
@print{} Arithmetic error: (arith-error)
@result{} 1000000
@end group
-@end smallexample
+@end example
@noindent
-The handler specifies condition name @code{arith-error} so that it will handle only division-by-zero errors. Other kinds of errors will not be handled, at least not by this @code{condition-case}. Thus,
+The handler specifies condition name @code{arith-error} so that it
+will handle only division-by-zero errors. Other kinds of errors will
+not be handled (by this @code{condition-case}). Thus:
-@smallexample
+@example
@group
(safe-divide nil 3)
@error{} Wrong type argument: number-or-marker-p, nil
@end group
-@end smallexample
+@end example
Here is a @code{condition-case} that catches all kinds of errors,
-including those signaled with @code{error}:
+including those from @code{error}:
-@smallexample
+@example
@group
(setq baz 34)
@result{} 34
@@ -1103,7 +1120,7 @@ including those signaled with @code{error}:
@print{} The error was: (error "Rats! The variable baz was 34, not 35")
@result{} 2
@end group
-@end smallexample
+@end example
@defmac ignore-errors body@dots{}
This construct executes @var{body}, ignoring any errors that occur
@@ -1114,14 +1131,21 @@ otherwise, it returns @code{nil}.
Here's the example at the beginning of this subsection rewritten using
@code{ignore-errors}:
-@smallexample
+@example
@group
(ignore-errors
(delete-file filename))
@end group
-@end smallexample
+@end example
@end defmac
+@defmac with-demoted-errors body@dots{}
+This macro is like a milder version of @code{ignore-errors}. Rather
+than suppressing errors altogether, it converts them into messages.
+Use this form around code that is not expected to signal errors, but
+should be robust if one does occur. Note that this macro uses
+@code{condition-case-unless-debug} rather than @code{condition-case}.
+@end defmac
@node Error Symbols
@subsubsection Error Symbols and Condition Names
@@ -1221,7 +1245,7 @@ make it possible to categorize errors at various levels of generality
when you write an error handler. Using error symbols alone would
eliminate all but the narrowest level of classification.
- @xref{Standard Errors}, for a list of all the standard error symbols
+ @xref{Standard Errors}, for a list of the main error symbols
and their conditions.
@node Cleanups
@@ -1267,7 +1291,7 @@ Variables}).
For example, here we make an invisible buffer for temporary use, and
make sure to kill it before finishing:
-@smallexample
+@example
@group
(let ((buffer (get-buffer-create " *temp*")))
(with-current-buffer buffer
@@ -1275,7 +1299,7 @@ make sure to kill it before finishing:
@var{body-form}
(kill-buffer buffer))))
@end group
-@end smallexample
+@end example
@noindent
You might think that we could just as well write @code{(kill-buffer
@@ -1300,7 +1324,7 @@ is protected with a form that guarantees deletion of the process in the
event of failure. Otherwise, Emacs might fill up with useless
subprocesses.
-@smallexample
+@example
@group
(let ((win nil))
(unwind-protect
@@ -1311,7 +1335,7 @@ subprocesses.
(error "Ftp login failed")))
(or win (and process (delete-process process)))))
@end group
-@end smallexample
+@end example
This example has a small bug: if the user types @kbd{C-g} to
quit, and the quit happens immediately after the function
diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi
index 868edaa5bd4..c9d22851ed2 100644
--- a/doc/lispref/customize.texi
+++ b/doc/lispref/customize.texi
@@ -1,32 +1,55 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1997-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1997-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/customize
-@node Customization, Loading, Macros, Top
-@chapter Writing Customization Definitions
-
-@cindex customization definitions
- This chapter describes how to declare user options for customization,
-and also customization groups for classifying them. We use the term
-@dfn{customization item} to include both kinds of customization
-definitions---as well as face definitions (@pxref{Defining Faces}).
+@node Customization
+@chapter Customization Settings
+
+@cindex customization item
+ Users of Emacs can customize variables and faces without writing
+Lisp code, by using the Customize interface. @xref{Easy
+Customization,,, emacs, The GNU Emacs Manual}. This chapter describes
+how to define @dfn{customization items} that users can interact with
+through the Customize interface.
+
+ Customization items include customizable variables, which are
+defined with the
+@ifinfo
+@code{defcustom} macro (@pxref{Variable Definitions});
+@end ifinfo
+@ifnotinfo
+@code{defcustom} macro;
+@end ifnotinfo
+customizable faces, which are defined with @code{defface} (described
+separately in @ref{Defining Faces}); and @dfn{customization groups},
+defined with
+@ifinfo
+@code{defgroup} (@pxref{Group Definitions}),
+@end ifinfo
+@ifnotinfo
+@code{defgroup},
+@end ifnotinfo
+which act as containers for groups of related customization items.
@menu
-* Common Keywords:: Common keyword arguments for all kinds of
- customization declarations.
-* Group Definitions:: Writing customization group definitions.
-* Variable Definitions:: Declaring user options.
-* Customization Types:: Specifying the type of a user option.
+* Common Keywords:: Common keyword arguments for all kinds of
+ customization declarations.
+* Group Definitions:: Writing customization group definitions.
+* Variable Definitions:: Declaring user options.
+* Customization Types:: Specifying the type of a user option.
+* Applying Customizations:: Functions to apply customization settings.
+* Custom Themes:: Writing Custom themes.
@end menu
@node Common Keywords
@section Common Item Keywords
@cindex customization keywords
- All kinds of customization declarations (for variables and groups, and
-for faces) accept keyword arguments for specifying various information.
-This section describes some keywords that apply to all kinds.
+ The customization declarations that we will describe in the next few
+sections---@code{defcustom}, @code{defgroup}, etc.---all accept
+keyword arguments (@pxref{Constant Variables}) for specifying various
+information. This section describes keywords that apply to all types
+of customization declarations.
All of these keywords, except @code{:tag}, can be used more than once
in a given item. Each use of the keyword has an independent effect.
@@ -108,8 +131,7 @@ You can specify the text to use in the customization buffer by adding
for example, @code{(info-link :tag "foo" "(emacs)Top")} makes a link to
the Emacs manual which appears in the buffer as @samp{foo}.
-An item can have more than one external link; however, most items have
-none at all.
+You can use this keyword more than once, to add multiple links.
@item :load @var{file}
@kindex load@r{, customization keyword}
@@ -136,14 +158,13 @@ version. The value @var{version} must be a string.
@kindex package-version@r{, customization keyword}
This keyword specifies that the item was first introduced in
@var{package} version @var{version}, or that its meaning or default
-value was changed in that version. The value of @var{package} is a
-symbol and @var{version} is a string.
-
-This keyword takes priority over @code{:version}.
+value was changed in that version. This keyword takes priority over
+@code{:version}.
-@var{package} should be the official name of the package, such as MH-E
-or Gnus. If the package @var{package} is released as part of Emacs,
-@var{package} and @var{version} should appear in the value of
+@var{package} should be the official name of the package, as a symbol
+(e.g.@: @code{MH-E}). @var{version} should be a string. If the
+package @var{package} is released as part of Emacs, @var{package} and
+@var{version} should appear in the value of
@code{customize-package-emacs-version-alist}.
@end table
@@ -154,7 +175,7 @@ Packages distributed as part of Emacs that use the
@defvar customize-package-emacs-version-alist
This alist provides a mapping for the versions of Emacs that are
associated with versions of a package listed in the
-@code{:package-version} keyword. Its elements look like this:
+@code{:package-version} keyword. Its elements are:
@example
(@var{package} (@var{pversion} . @var{eversion})@dots{})
@@ -165,6 +186,8 @@ elements that contain a package version @var{pversion} with an
associated Emacs version @var{eversion}. These versions are strings.
For example, the MH-E package updates this alist with the following:
+@c Must be small else too wide.
+@c FIXME obviously this is out of date (in the code).
@smallexample
(add-to-list 'customize-package-emacs-version-alist
'(MH-E ("6.0" . "22.1") ("6.1" . "22.1") ("7.0" . "22.1")
@@ -183,14 +206,14 @@ choice is the official name of the package, such as MH-E or Gnus.
@cindex define customization group
@cindex customization groups, defining
- Each Emacs Lisp package should have one main customization group which
-contains all the options, faces and other groups in the package. If the
-package has a small number of options and faces, use just one group and
-put everything in it. When there are more than twelve or so options and
-faces, then you should structure them into subgroups, and put the
-subgroups under the package's main customization group. It is OK to
-put some of the options and faces in the package's main group alongside
-the subgroups.
+ Each Emacs Lisp package should have one main customization group
+which contains all the options, faces and other groups in the package.
+If the package has a small number of options and faces, use just one
+group and put everything in it. When there are more than twenty or so
+options and faces, then you should structure them into subgroups, and
+put the subgroups under the package's main customization group. It is
+OK to put some of the options and faces in the package's main group
+alongside the subgroups.
The package's main or only group should be a member of one or more of
the standard customization groups. (To display the full list of them,
@@ -226,47 +249,41 @@ also use this keyword in @code{defgroup}:
@table @code
@item :prefix @var{prefix}
@kindex prefix@r{, @code{defgroup} keyword}
-If the name of an item in the group starts with @var{prefix}, then the
-tag for that item is constructed (by default) by omitting @var{prefix}.
-
-One group can have any number of prefixes.
+If the name of an item in the group starts with @var{prefix}, and the
+customizable variable @code{custom-unlispify-remove-prefixes} is
+non-@code{nil}, the item's tag will omit @var{prefix}. A group can
+have any number of prefixes.
@end table
@end defmac
- The prefix-discarding feature is currently turned off, which means
-that @code{:prefix} currently has no effect. We did this because we
-found that discarding the specified prefixes often led to confusing
-names for options. This happened because the people who wrote the
-@code{defgroup} definitions for various groups added @code{:prefix}
-keywords whenever they make logical sense---that is, whenever the
-variables in the library have a common prefix.
+@defopt custom-unlispify-remove-prefixes
+If this variable is non-@code{nil}, the prefixes specified by a
+group's @code{:prefix} keyword are omitted from tag names, whenever
+the user customizes the group.
- In order to obtain good results with @code{:prefix}, it would be
-necessary to check the specific effects of discarding a particular
-prefix, given the specific items in a group and their names and
-documentation. If the resulting text is not clear, then @code{:prefix}
-should not be used in that case.
-
- It should be possible to recheck all the customization groups, delete
-the @code{:prefix} specifications which give unclear results, and then
-turn this feature back on, if someone would like to do the work.
+The default value is @code{nil}, i.e.@: the prefix-discarding feature
+is disabled. This is because discarding prefixes often leads to
+confusing names for options and faces.
+@end defopt
@node Variable Definitions
@section Defining Customization Variables
@cindex define customization options
-@cindex customization variables, how to define
-
- Use @code{defcustom} to declare user-customizable variables.
+@cindex customizable variables, how to define
+@cindex user options, how to define
+
+ @dfn{Customizable variables}, also called @dfn{user options}, are
+global Lisp variables whose values can be set through the Customize
+interface. Unlike other global variables, which are defined with
+@code{defvar} (@pxref{Defining Variables}), customizable variables are
+defined using the @code{defcustom} macro. In addition to calling
+@code{defvar} as a subroutine, @code{defcustom} states how the
+variable should be displayed in the Customize interface, the values it
+is allowed to take, etc.
@defmac defcustom option standard doc [keyword value]@dots{}
-This macro declares @var{option} as a customizable @dfn{user option}.
-You should not quote @var{option}.
-
-This causes the function @code{user-variable-p} to return @code{t}
-when given @var{option} as an argument. @xref{Defining Variables}.
-The argument @var{doc} specifies the documentation string for the
-variable. (Note that there is no need to start @var{doc} with a
-@samp{*}.)
+This macro declares @var{option} as a user option (i.e.@: a
+customizable variable). You should not quote @var{option}.
The argument @var{standard} is an expression that specifies the
standard value for @var{option}. Evaluating the @code{defcustom} form
@@ -281,16 +298,12 @@ cases applies, @code{defcustom} installs the result of evaluating
The expression @var{standard} can be evaluated at various other times,
too---whenever the customization facility needs to know @var{option}'s
standard value. So be sure to use an expression which is harmless to
-evaluate at any time. We recommend avoiding backquotes in
-@var{standard}, because they are not expanded when editing the value,
-so list values will appear to have the wrong structure.
+evaluate at any time.
-Every @code{defcustom} should specify @code{:group} at least once.
+The argument @var{doc} specifies the documentation string for the
+variable.
-If you specify the @code{:set} keyword, to make the variable take other
-special actions when set through the customization buffer, the
-variable's documentation string should tell the user specifically how
-to do the same job in hand-written Lisp code.
+Every @code{defcustom} should specify @code{:group} at least once.
When you evaluate a @code{defcustom} form with @kbd{C-M-x} in Emacs Lisp
mode (@code{eval-defun}), a special feature of @code{eval-defun}
@@ -298,20 +311,22 @@ arranges to set the variable unconditionally, without testing whether
its value is void. (The same feature applies to @code{defvar}.)
@xref{Defining Variables}.
-If you put a @code{defcustom} in a file that is preloaded at dump time
-(@pxref{Building Emacs}), and the standard value installed for the
-variable at that time might not be correct, use
+If you put a @code{defcustom} in a pre-loaded Emacs Lisp file
+(@pxref{Building Emacs}), the standard value installed at dump time
+might be incorrect, e.g.@: because another variable that it depends on
+has not been assigned the right value yet. In that case, use
@code{custom-reevaluate-setting}, described below, to re-evaluate the
-standard value during or after Emacs startup.
+standard value after Emacs starts up.
@end defmac
- @code{defcustom} accepts the following additional keywords:
+ In addition to the keywords listed in @ref{Common Keywords}, this
+macro accepts the following keywords:
@table @code
@item :type @var{type}
Use @var{type} as the data type for this option. It specifies which
-values are legitimate, and how to display the value.
-@xref{Customization Types}, for more information.
+values are legitimate, and how to display the value
+(@pxref{Customization Types}).
@item :options @var{value-list}
@kindex options@r{, @code{defcustom} keyword}
@@ -326,13 +341,16 @@ individual types for a description of how to use @code{:options}.
@item :set @var{setfunction}
@kindex set@r{, @code{defcustom} keyword}
Specify @var{setfunction} as the way to change the value of this
-option when using the Customize user interface. The function
+option when using the Customize interface. The function
@var{setfunction} should take two arguments, a symbol (the option
name) and the new value, and should do whatever is necessary to update
the value properly for this option (which may not mean simply setting
the option as a Lisp variable). The default for @var{setfunction} is
@code{set-default}.
+If you specify this keyword, the variable's documentation string
+should describe how to do the same job in hand-written Lisp code.
+
@item :get @var{getfunction}
@kindex get@r{, @code{defcustom} keyword}
Specify @var{getfunction} as the way to extract the value of this
@@ -344,7 +362,7 @@ value). The default is @code{default-value}.
You have to really understand the workings of Custom to use
@code{:get} correctly. It is meant for values that are treated in
Custom as variables but are not actually stored in Lisp variables. It
-is almost surely a mistake to specify @code{getfunction} for a value
+is almost surely a mistake to specify @var{getfunction} for a value
that really is stored in a Lisp variable.
@item :initialize @var{function}
@@ -383,16 +401,15 @@ already set or has been customized; otherwise, just use
These functions behave like @code{custom-initialize-set}
(@code{custom-initialize-default}, respectively), but catch errors.
If an error occurs during initialization, they set the variable to
-@code{nil} using @code{set-default}, and throw no error.
-
-These two functions are only meant for options defined in pre-loaded
-files, where some variables or functions used to compute the option's
-value may not yet be defined. The option normally gets updated in
-@file{startup.el}, ignoring the previously computed value. Because of
-this typical usage, the value which these two functions compute
-normally only matters when, after startup, one unsets the option's
-value and then reevaluates the defcustom. By that time, the necessary
-variables and functions will be defined, so there will not be an error.
+@code{nil} using @code{set-default}, and signal no error.
+
+These functions are meant for options defined in pre-loaded files,
+where the @var{standard} expression may signal an error because some
+required variable or function is not yet defined. The value normally
+gets updated in @file{startup.el}, ignoring the value computed by
+@code{defcustom}. After startup, if one unsets the value and
+reevaluates the @code{defcustom}, the @var{standard} expression can be
+evaluated without error.
@end table
@item :risky @var{value}
@@ -408,7 +425,7 @@ Set the variable's @code{safe-local-variable} property to
@item :set-after @var{variables}
@kindex set-after@r{, @code{defcustom} keyword}
When setting variables according to saved customizations, make sure to
-set the variables @var{variables} before this one; in other words, delay
+set the variables @var{variables} before this one; i.e., delay
setting this variable until after those others have been handled. Use
@code{:set-after} if setting this variable won't work properly unless
those other variables already have their intended values.
@@ -460,18 +477,24 @@ is an expression that evaluates to the value.
@defun custom-reevaluate-setting symbol
This function re-evaluates the standard value of @var{symbol}, which
-should be a user option declared via @code{defcustom}. (If the
+should be a user option declared via @code{defcustom}. If the
variable was customized, this function re-evaluates the saved value
-instead.) This is useful for customizable options that are defined
-before their value could be computed correctly, such as variables
-defined in packages that are loaded at dump time, but depend on the
-run-time information. For example, the value could be a file whose
-precise name depends on the hierarchy of files when Emacs runs, or a
-name of a program that needs to be searched at run time.
-
-A good place to put calls to this function is in the function
-@code{command-line} that is run during startup (@pxref{Startup Summary})
-or in the various hooks it calls.
+instead. Then it sets the user option to that value (using the
+option's @code{:set} property if that is defined).
+
+This is useful for customizable options that are defined before their
+value could be computed correctly. For example, during startup Emacs
+calls this function for some user options that were defined in
+pre-loaded Emacs Lisp files, but whose initial values depend on
+information available only at run-time.
+@end defun
+
+@defun custom-variable-p arg
+This function returns non-@code{nil} if @var{arg} is a customizable
+variable. A customizable variable is either a variable that has a
+@code{standard-value} or @code{custom-autoload} property (usually
+meaning it was declared with @code{defcustom}), or an alias for
+another customizable variable.
@end defun
@node Customization Types
@@ -523,30 +546,28 @@ Introduction, widget, The Emacs Widget Library}, for details.
@node Simple Types
@subsection Simple Types
- This section describes all the simple customization types.
+ This section describes all the simple customization types. For
+several of these customization types, the customization widget
+provides inline completion with @kbd{C-M-i} or @kbd{M-@key{TAB}}.
@table @code
@item sexp
-The value may be any Lisp object that can be printed and read back. You
-can use @code{sexp} as a fall-back for any option, if you don't want to
-take the time to work out a more specific type to use.
+The value may be any Lisp object that can be printed and read back.
+You can use @code{sexp} as a fall-back for any option, if you don't
+want to take the time to work out a more specific type to use.
@item integer
-The value must be an integer, and is represented textually
-in the customization buffer.
+The value must be an integer.
@item number
-The value must be a number (floating point or integer), and is
-represented textually in the customization buffer.
+The value must be a number (floating point or integer).
@item float
-The value must be a floating point number, and is represented
-textually in the customization buffer.
+The value must be a floating point number.
@item string
-The value must be a string, and the customization buffer shows just the
-contents, with no delimiting @samp{"} characters and no quoting with
-@samp{\}.
+The value must be a string. The customization buffer shows the string
+without delimiting @samp{"} characters or @samp{\} quotes.
@item regexp
Like @code{string} except that the string must be a valid regular
@@ -558,39 +579,35 @@ integer, but this type shows the value by inserting the character in the
buffer, rather than by showing the number.
@item file
-The value must be a file name, and you can do completion with
-@kbd{M-@key{TAB}}.
+The value must be a file name. The widget provides completion.
@item (file :must-match t)
-The value must be a file name for an existing file, and you can do
-completion with @kbd{M-@key{TAB}}.
+The value must be a file name for an existing file. The widget
+provides completion.
@item directory
-The value must be a directory name, and you can do completion with
-@kbd{M-@key{TAB}}.
+The value must be a directory name. The widget provides completion.
@item hook
-The value must be a list of functions (or a single function, but that is
-obsolete usage). This customization type is used for hook variables.
-You can use the @code{:options} keyword in a hook variable's
-@code{defcustom} to specify a list of functions recommended for use in
-the hook; see @ref{Variable Definitions}.
+The value must be a list of functions. This customization type is
+used for hook variables. You can use the @code{:options} keyword in a
+hook variable's @code{defcustom} to specify a list of functions
+recommended for use in the hook; @xref{Variable Definitions}.
@item symbol
The value must be a symbol. It appears in the customization buffer as
-the name of the symbol.
+the symbol name. The widget provides completion.
@item function
-The value must be either a lambda expression or a function name. When
-it is a function name, you can do completion with @kbd{M-@key{TAB}}.
+The value must be either a lambda expression or a function name. The
+widget provides completion for function names.
@item variable
-The value must be a variable name, and you can do completion with
-@kbd{M-@key{TAB}}.
+The value must be a variable name. The widget provides completion.
@item face
-The value must be a symbol which is a face name, and you can do
-completion with @kbd{M-@key{TAB}}.
+The value must be a symbol which is a face name. The widget provides
+completion.
@item boolean
The value is boolean---either @code{nil} or @code{t}. Note that by
@@ -604,8 +621,10 @@ The value must be a coding-system name, and you can do completion with
@kbd{M-@key{TAB}}.
@item color
-The value must be a valid color name, and you can do completion with
-@kbd{M-@key{TAB}}. A sample is provided.
+The value must be a valid color name. The widget provides completion
+for color names, as well as a sample and a button for selecting a
+color name from a list of color names shown in a @file{*Colors*}
+buffer.
@end table
@node Composite Types
@@ -639,9 +658,8 @@ its @sc{cdr} must fit @var{cdr-type}. For example, @code{(cons string
symbol)} is a customization type which matches values such as
@code{("foo" . foo)}.
-In the customization buffer, the @sc{car} and the @sc{cdr} are
-displayed and edited separately, each according to the type
-that you specify for it.
+In the customization buffer, the @sc{car} and @sc{cdr} are displayed
+and edited separately, each according to their specified type.
@item (list @var{element-types}@dots{})
The value must be a list with exactly as many elements as the
@@ -684,11 +702,11 @@ specified by the @code{:options} keyword argument.
The argument to the @code{:options} keywords should be a list of
specifications for reasonable keys in the alist. Ordinarily, they are
-simply atoms, which stand for themselves as. For example:
+simply atoms, which stand for themselves. For example:
-@smallexample
+@example
:options '("foo" "bar" "baz")
-@end smallexample
+@end example
@noindent
specifies that there are three ``known'' keys, namely @code{"foo"},
@@ -700,9 +718,9 @@ integer. You can specify this by using a list instead of an atom in
the list. The first element will specify the key, like before, while
the second element will specify the value type. For example:
-@smallexample
+@example
:options '("foo" ("bar" integer) "baz")
-@end smallexample
+@end example
Finally, you may want to change how the key is presented. By default,
the key is simply shown as a @code{const}, since the user cannot change
@@ -712,37 +730,40 @@ you may want to use a more specialized type for presenting the key, like
This is done by using a customization type specification instead of a
symbol for the key.
-@smallexample
-:options '("foo" ((function-item some-function) integer)
+@example
+:options '("foo"
+ ((function-item some-function) integer)
"baz")
-@end smallexample
+@end example
Many alists use lists with two elements, instead of cons cells. For
example,
-@smallexample
-(defcustom list-alist '(("foo" 1) ("bar" 2) ("baz" 3))
+@example
+(defcustom list-alist
+ '(("foo" 1) ("bar" 2) ("baz" 3))
"Each element is a list of the form (KEY VALUE).")
-@end smallexample
+@end example
@noindent
instead of
-@smallexample
-(defcustom cons-alist '(("foo" . 1) ("bar" . 2) ("baz" . 3))
+@example
+(defcustom cons-alist
+ '(("foo" . 1) ("bar" . 2) ("baz" . 3))
"Each element is a cons-cell (KEY . VALUE).")
-@end smallexample
+@end example
Because of the way lists are implemented on top of cons cells, you can
treat @code{list-alist} in the example above as a cons cell alist, where
the value type is a list with a single element containing the real
value.
-@smallexample
+@example
(defcustom list-alist '(("foo" 1) ("bar" 2) ("baz" 3))
"Each element is a list of the form (KEY VALUE)."
:type '(alist :value-type (group integer)))
-@end smallexample
+@end example
The @code{group} widget is used here instead of @code{list} only because
the formatting is better suited for the purpose.
@@ -750,22 +771,14 @@ the formatting is better suited for the purpose.
Similarly, you can have alists with more values associated with each
key, using variations of this trick:
-@smallexample
+@example
(defcustom person-data '(("brian" 50 t)
("dorith" 55 nil)
("ken" 52 t))
"Alist of basic info about people.
Each element has the form (NAME AGE MALE-FLAG)."
:type '(alist :value-type (group integer boolean)))
-
-(defcustom pets '(("brian")
- ("dorith" "dog" "guppy")
- ("ken" "cat"))
- "Alist of people's pets.
-In an element (KEY . VALUE), KEY is the person's name,
-and the VALUE is a list of that person's pets."
- :type '(alist :value-type (repeat string)))
-@end smallexample
+@end example
@item (plist :key-type @var{key-type} :value-type @var{value-type})
This customization type is similar to @code{alist} (see above), except
@@ -774,9 +787,8 @@ that (i) the information is stored as a property list,
defaults to @code{symbol} rather than @code{sexp}.
@item (choice @var{alternative-types}@dots{})
-The value must fit at least one of @var{alternative-types}.
-For example, @code{(choice integer string)} allows either an
-integer or a string.
+The value must fit one of @var{alternative-types}. For example,
+@code{(choice integer string)} allows either an integer or a string.
In the customization buffer, the user selects an alternative
using a menu, and can then edit the value in the usual way for that
@@ -839,7 +851,7 @@ For example,
@noindent
describes a variable for which @code{t} means yes, @code{nil} means no,
-and @code{foo} means ``ask.''
+and @code{foo} means ``ask''.
@item (other @var{value})
This alternative can match any Lisp value, but if the user chooses this
@@ -856,7 +868,7 @@ For example,
@noindent
describes a variable for which @code{t} means yes, @code{nil} means no,
-and anything else means ``ask.'' If the user chooses @samp{Ask} from
+and anything else means ``ask''. If the user chooses @samp{Ask} from
the menu of alternatives, that specifies the value @code{foo}; but any
other value (not @code{t}, @code{nil} or @code{foo}) displays as
@samp{Ask}, just like @code{foo}.
@@ -968,20 +980,18 @@ whatever follows the last keyword-value pair.
@subsection Splicing into Lists
The @code{:inline} feature lets you splice a variable number of
-elements into the middle of a list or vector. You use it in a
-@code{set}, @code{choice} or @code{repeat} type which appears among the
-element-types of a @code{list} or @code{vector}.
-
- Normally, each of the element-types in a @code{list} or @code{vector}
-describes one and only one element of the list or vector. Thus, if an
-element-type is a @code{repeat}, that specifies a list of unspecified
-length which appears as one element.
-
- But when the element-type uses @code{:inline}, the value it matches is
-merged directly into the containing sequence. For example, if it
-matches a list with three elements, those become three elements of the
-overall sequence. This is analogous to using @samp{,@@} in the backquote
-construct.
+elements into the middle of a @code{list} or @code{vector}
+customization type. You use it by adding @code{:inline t} to a type
+specification which is contained in a @code{list} or @code{vector}
+specification.
+
+ Normally, each entry in a @code{list} or @code{vector} type
+specification describes a single element type. But when an entry
+contains @code{:inline t}, the value it matches is merged directly
+into the containing sequence. For example, if the entry matches a
+list with three elements, those become three elements of the overall
+sequence. This is analogous to @samp{,@@} in a backquote construct
+(@pxref{Backquote}).
For example, to specify a list whose first element must be @code{baz}
and whose remaining arguments should be zero or more of @code{foo} and
@@ -1270,3 +1280,164 @@ the inferior widgets will convert @emph{their} inferior widgets. If
the data structure is itself recursive, this conversion is an infinite
recursion. The @code{lazy} widget prevents the recursion: it convert
its @code{:type} argument only when needed.
+
+@node Applying Customizations
+@section Applying Customizations
+
+The following functions are responsible for installing the user's
+customization settings for variables and faces, respectively. When
+the user invokes @samp{Save for future sessions} in the Customize
+interface, that takes effect by writing a @code{custom-set-variables}
+and/or a @code{custom-set-faces} form into the custom file, to be
+evaluated the next time Emacs starts.
+
+@defun custom-set-variables &rest args
+This function installs the variable customizations specified by
+@var{args}. Each argument in @var{args} should have the form
+
+@example
+(@var{var} @var{expression} [@var{now} [@var{request} [@var{comment}]]])
+@end example
+
+@noindent
+@var{var} is a variable name (a symbol), and @var{expression} is an
+expression which evaluates to the desired customized value.
+
+If the @code{defcustom} form for @var{var} has been evaluated prior to
+this @code{custom-set-variables} call, @var{expression} is immediately
+evaluated, and the variable's value is set to the result. Otherwise,
+@var{expression} is stored into the variable's @code{saved-value}
+property, to be evaluated when the relevant @code{defcustom} is called
+(usually when the library defining that variable is loaded into
+Emacs).
+
+The @var{now}, @var{request}, and @var{comment} entries are for
+internal use only, and may be omitted. @var{now}, if non-@code{nil},
+means to set the variable's value now, even if the variable's
+@code{defcustom} form has not been evaluated. @var{request} is a list
+of features to be loaded immediately (@pxref{Named Features}).
+@var{comment} is a string describing the customization.
+@end defun
+
+@defun custom-set-faces &rest args
+This function installs the face customizations specified by
+@var{args}. Each argument in @var{args} should have the form
+
+@example
+(@var{face} @var{spec} [@var{now} [@var{comment}]])
+@end example
+
+@noindent
+@var{face} is a face name (a symbol), and @var{spec} is the customized
+face specification for that face (@pxref{Defining Faces}).
+
+The @var{now} and @var{comment} entries are for internal use only, and
+may be omitted. @var{now}, if non-@code{nil}, means to install the
+face specification now, even if the @code{defface} form has not been
+evaluated. @var{comment} is a string describing the customization.
+@end defun
+
+@node Custom Themes
+@section Custom Themes
+
+ @dfn{Custom themes} are collections of settings that can be enabled
+or disabled as a unit. @xref{Custom Themes,,, emacs, The GNU Emacs
+Manual}. Each Custom theme is defined by an Emacs Lisp source file,
+which should follow the conventions described in this section.
+(Instead of writing a Custom theme by hand, you can also create one
+using a Customize-like interface; @pxref{Creating Custom Themes,,,
+emacs, The GNU Emacs Manual}.)
+
+ A Custom theme file should be named @file{@var{foo}-theme.el}, where
+@var{foo} is the theme name. The first Lisp form in the file should
+be a call to @code{deftheme}, and the last form should be a call to
+@code{provide-theme}.
+
+@defmac deftheme theme &optional doc
+This macro declares @var{theme} (a symbol) as the name of a Custom
+theme. The optional argument @var{doc} should be a string describing
+the theme; this is the description shown when the user invokes the
+@code{describe-theme} command or types @kbd{?} in the @samp{*Custom
+Themes*} buffer.
+
+Two special theme names are disallowed (using them causes an error):
+@code{user} is a ``dummy'' theme that stores the user's direct
+customization settings, and @code{changed} is a ``dummy'' theme that
+stores changes made outside of the Customize system.
+@end defmac
+
+@defmac provide-theme theme
+This macro declares that the theme named @var{theme} has been fully
+specified.
+@end defmac
+
+ In between @code{deftheme} and @code{provide-theme} are Lisp forms
+specifying the theme settings: usually a call to
+@code{custom-theme-set-variables} and/or a call to
+@code{custom-theme-set-faces}.
+
+@defun custom-theme-set-variables theme &rest args
+This function specifies the Custom theme @var{theme}'s variable
+settings. @var{theme} should be a symbol. Each argument in
+@var{args} should be a list of the form
+
+@example
+(@var{var} @var{expression} [@var{now} [@var{request} [@var{comment}]]])
+@end example
+
+@noindent
+where the list entries have the same meanings as in
+@code{custom-set-variables}. @xref{Applying Customizations}.
+@end defun
+
+@defun custom-theme-set-faces theme &rest args
+This function specifies the Custom theme @var{theme}'s face settings.
+@var{theme} should be a symbol. Each argument in @var{args} should be
+a list of the form
+
+@example
+(@var{face} @var{spec} [@var{now} [@var{comment}]])
+@end example
+
+@noindent
+where the list entries have the same meanings as in
+@code{custom-set-faces}. @xref{Applying Customizations}.
+@end defun
+
+ In theory, a theme file can also contain other Lisp forms, which
+would be evaluated when loading the theme, but that is ``bad form''.
+To protect against loading themes containing malicious code, Emacs
+displays the source file and asks for confirmation from the user
+before loading any non-built-in theme for the first time.
+
+ The following functions are useful for programmatically enabling and
+disabling themes:
+
+@defun custom-theme-p theme
+This function return a non-@code{nil} value if @var{theme} (a symbol)
+is the name of a Custom theme (i.e.@: a Custom theme which has been
+loaded into Emacs, whether or not the theme is enabled). Otherwise,
+it returns @code{nil}.
+@end defun
+
+@deffn Command load-theme theme &optional no-confirm no-enable
+This function loads the Custom theme named @var{theme} from its source
+file, looking for the source file in the directories specified by the
+variable @code{custom-theme-load-path}. @xref{Custom Themes,,, emacs,
+The GNU Emacs Manual}. It also @dfn{enables} the theme (unless the
+optional argument @var{no-enable} is non-@code{nil}), causing its
+variable and face settings to take effect. It prompts the user for
+confirmation before loading the theme, unless the optional argument
+@var{no-confirm} is non-@code{nil}.
+@end deffn
+
+@deffn Command enable-theme theme
+This function enables the Custom theme named @var{theme}. It signals
+an error if no such theme has been loaded.
+@end deffn
+
+@deffn Command disable-theme theme
+This function disables the Custom theme named @var{theme}. The theme
+remains loaded, so that a subsequent call to @code{enable-theme} will
+re-enable it.
+@end deffn
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 757906f286e..6e4f6628637 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -1,46 +1,54 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1994, 1998-1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1994, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/debugging
-@node Debugging, Read and Print, Advising Functions, Top
+@node Debugging
@chapter Debugging Lisp Programs
- There are three ways to investigate a problem in an Emacs Lisp program,
-depending on what you are doing with the program when the problem appears.
+ There are several ways to find and investigate problems in an Emacs
+Lisp program.
@itemize @bullet
@item
-If the problem occurs when you run the program, you can use a Lisp
-debugger to investigate what is happening during execution. In addition
-to the ordinary debugger, Emacs comes with a source-level debugger,
-Edebug. This chapter describes both of them.
+If a problem occurs when you run the program, you can use the built-in
+Emacs Lisp debugger to suspend the Lisp evaluator, and examine and/or
+alter its internal state.
@item
-If the problem is syntactic, so that Lisp cannot even read the program,
-you can use the Emacs facilities for editing Lisp to localize it.
+You can use Edebug, a source-level debugger for Emacs Lisp.
@item
-If the problem occurs when trying to compile the program with the byte
-compiler, you need to know how to examine the compiler's input buffer.
+If a syntactic problem is preventing Lisp from even reading the
+program, you can locate it using Lisp editing commands.
+
+@item
+You can look at the error and warning messages produced by the byte
+compiler when it compiles the program. @xref{Compiler Errors}.
+
+@item
+You can use the Testcover package to perform coverage testing on the
+program.
+
+@item
+You can use the ERT package to write regression tests for the program.
+@xref{Top,the ERT manual,, ERT, ERT: Emacs Lisp Regression Testing}.
+
+@item
+You can profile the program to get hints about how to make it more efficient.
@end itemize
+ Other useful tools for debugging input and output problems are the
+dribble file (@pxref{Terminal Input}) and the @code{open-termscript}
+function (@pxref{Terminal Output}).
+
@menu
-* Debugger:: How the Emacs Lisp debugger is implemented.
+* Debugger:: A debugger for the Emacs Lisp evaluator.
* Edebug:: A source-level Emacs Lisp debugger.
* Syntax Errors:: How to find syntax errors.
* Test Coverage:: Ensuring you have tested all branches in your code.
-* Compilation Errors:: How to find errors that show up in byte compilation.
+* Profiling:: Measuring the resources that your code uses.
@end menu
- Another useful debugging tool is the dribble file. When a dribble
-file is open, Emacs copies all keyboard input characters to that file.
-Afterward, you can examine the file to find out what input was used.
-@xref{Terminal Input}.
-
- For debugging problems in terminal descriptions, the
-@code{open-termscript} function can be useful. @xref{Terminal Output}.
-
@node Debugger
@section The Lisp Debugger
@cindex debugger for Emacs Lisp
@@ -76,25 +84,29 @@ happens. This allows you to investigate the immediate causes of the
error.
However, entry to the debugger is not a normal consequence of an
-error. Many commands frequently cause Lisp errors when invoked
-inappropriately, and during ordinary editing it would be very
-inconvenient to enter the debugger each time this happens. So if you
-want errors to enter the debugger, set the variable
-@code{debug-on-error} to non-@code{nil}. (The command
-@code{toggle-debug-on-error} provides an easy way to do this.)
+error. Many commands signal Lisp errors when invoked inappropriately,
+and during ordinary editing it would be very inconvenient to enter the
+debugger each time this happens. So if you want errors to enter the
+debugger, set the variable @code{debug-on-error} to non-@code{nil}.
+(The command @code{toggle-debug-on-error} provides an easy way to do
+this.)
@defopt debug-on-error
This variable determines whether the debugger is called when an error
is signaled and not handled. If @code{debug-on-error} is @code{t},
all kinds of errors call the debugger, except those listed in
@code{debug-ignored-errors} (see below). If it is @code{nil}, none
-call the debugger. (Note that @code{eval-expression-debug-on-error}
-affects the setting of this variable in some cases; see below.)
+call the debugger.
+
+The value can also be a list of error conditions (@pxref{Signaling
+Errors}). Then the debugger is called only for error conditions in
+this list (except those also listed in @code{debug-ignored-errors}).
+For example, if you set @code{debug-on-error} to the list
+@code{(void-variable)}, the debugger is only called for errors about a
+variable that has no value.
-The value can also be a list of error conditions that should call the
-debugger. For example, if you set it to the list
-@code{(void-variable)}, then only errors about a variable that has no
-value invoke the debugger.
+Note that @code{eval-expression-debug-on-error} overrides this
+variable in some cases; see below.
When this variable is non-@code{nil}, Emacs does not create an error
handler around process filter functions and sentinels. Therefore,
@@ -102,52 +114,67 @@ errors in these functions also invoke the debugger. @xref{Processes}.
@end defopt
@defopt debug-ignored-errors
-This variable specifies certain kinds of errors that should not enter
-the debugger. Its value is a list of error condition symbols and/or
-regular expressions. If the error has any of those condition symbols,
-or if the error message matches any of the regular expressions, then
-that error does not enter the debugger, regardless of the value of
-@code{debug-on-error}.
-
-The normal value of this variable lists several errors that happen often
-during editing but rarely result from bugs in Lisp programs. However,
-``rarely'' is not ``never''; if your program fails with an error that
-matches this list, you will need to change this list in order to debug
-the error. The easiest way is usually to set
-@code{debug-ignored-errors} to @code{nil}.
+This variable specifies errors which should not enter the debugger,
+regardless of the value of @code{debug-on-error}. Its value is a list
+of error condition symbols and/or regular expressions. If the error
+has any of those condition symbols, or if the error message matches
+any of the regular expressions, then that error does not enter the
+debugger.
+
+The normal value of this variable includes @code{user-error}, as well
+as several errors that happen often during editing but rarely result
+from bugs in Lisp programs. However, ``rarely'' is not ``never''; if
+your program fails with an error that matches this list, you may try
+changing this list to debug the error. The easiest way is usually to
+set @code{debug-ignored-errors} to @code{nil}.
@end defopt
@defopt eval-expression-debug-on-error
-If this variable has a non-@code{nil} value, then
-@code{debug-on-error} is set to @code{t} when evaluating with the
-command @code{eval-expression}. If
-@code{eval-expression-debug-on-error} is @code{nil}, then the value of
-@code{debug-on-error} is not changed. @xref{Lisp Eval,, Evaluating
+If this variable has a non-@code{nil} value (the default), running the
+command @code{eval-expression} causes @code{debug-on-error} to be
+temporarily bound to to @code{t}. @xref{Lisp Eval,, Evaluating
Emacs-Lisp Expressions, emacs, The GNU Emacs Manual}.
+
+If @code{eval-expression-debug-on-error} is @code{nil}, then the value
+of @code{debug-on-error} is not changed during @code{eval-expression}.
@end defopt
-@defopt debug-on-signal
-Normally, errors that are caught by @code{condition-case} never run the
-debugger, even if @code{debug-on-error} is non-@code{nil}. In other
-words, @code{condition-case} gets a chance to handle the error before
-the debugger gets a chance.
-
-If you set @code{debug-on-signal} to a non-@code{nil} value, then the
-debugger gets the first chance at every error; an error will invoke the
-debugger regardless of any @code{condition-case}, if it fits the
-criteria specified by the values of @code{debug-on-error} and
-@code{debug-ignored-errors}.
-
-@strong{Warning:} This variable is strong medicine! Various parts of
-Emacs handle errors in the normal course of affairs, and you may not
-even realize that errors happen there. If you set
-@code{debug-on-signal} to a non-@code{nil} value, those errors will
-enter the debugger.
-
-@strong{Warning:} @code{debug-on-signal} has no effect when
-@code{debug-on-error} is @code{nil}.
+@defvar debug-on-signal
+Normally, errors caught by @code{condition-case} never invoke the
+debugger. The @code{condition-case} gets a chance to handle the error
+before the debugger gets a chance.
+
+If you change @code{debug-on-signal} to a non-@code{nil} value, the
+debugger gets the first chance at every error, regardless of the
+presence of @code{condition-case}. (To invoke the debugger, the error
+must still fulfill the criteria specified by @code{debug-on-error} and
+@code{debug-ignored-errors}.)
+
+@strong{Warning:} Setting this variable to non-@code{nil} may have
+annoying effects. Various parts of Emacs catch errors in the normal
+course of affairs, and you may not even realize that errors happen
+there. If you need to debug code wrapped in @code{condition-case},
+consider using @code{condition-case-unless-debug} (@pxref{Handling
+Errors}).
+@end defvar
+
+@defopt debug-on-event
+If you set @code{debug-on-event} to a special event (@pxref{Special
+Events}), Emacs will try to enter the debugger as soon as it receives
+this event, bypassing @code{special-event-map}. At present, the only
+supported values correspond to the signals @code{SIGUSR1} and
+@code{SIGUSR2} (this is the default). This can be helpful when
+@code{inhibit-quit} is set and Emacs is not otherwise responding.
@end defopt
+@cindex message, finding what causes a particular message
+@defvar debug-on-message
+If you set @code{debug-on-message} to a regular expression,
+Emacs will enter the debugger if it displays a matching message in the
+echo area. For example, this can be useful when trying to find the
+cause of a particular message.
+@end defvar
+
To debug an error that happens during loading of the init
file, use the option @samp{--debug-init}. This binds
@code{debug-on-error} to @code{t} while loading the init file, and
@@ -162,27 +189,26 @@ init file.
@cindex stopping an infinite loop
When a program loops infinitely and fails to return, your first
-problem is to stop the loop. On most operating systems, you can do this
-with @kbd{C-g}, which causes a @dfn{quit}.
+problem is to stop the loop. On most operating systems, you can do
+this with @kbd{C-g}, which causes a @dfn{quit}. @xref{Quitting}.
Ordinary quitting gives no information about why the program was
looping. To get more information, you can set the variable
-@code{debug-on-quit} to non-@code{nil}. Quitting with @kbd{C-g} is not
-considered an error, and @code{debug-on-error} has no effect on the
-handling of @kbd{C-g}. Likewise, @code{debug-on-quit} has no effect on
-errors.
+@code{debug-on-quit} to non-@code{nil}. Once you have the debugger
+running in the middle of the infinite loop, you can proceed from the
+debugger using the stepping commands. If you step through the entire
+loop, you may get enough information to solve the problem.
- Once you have the debugger running in the middle of the infinite loop,
-you can proceed from the debugger using the stepping commands. If you
-step through the entire loop, you will probably get enough information
-to solve the problem.
+ Quitting with @kbd{C-g} is not considered an error, and
+@code{debug-on-error} has no effect on the handling of @kbd{C-g}.
+Likewise, @code{debug-on-quit} has no effect on errors.
@defopt debug-on-quit
-This variable determines whether the debugger is called when @code{quit}
-is signaled and not handled. If @code{debug-on-quit} is non-@code{nil},
-then the debugger is called whenever you quit (that is, type @kbd{C-g}).
-If @code{debug-on-quit} is @code{nil}, then the debugger is not called
-when you quit. @xref{Quitting}.
+This variable determines whether the debugger is called when
+@code{quit} is signaled and not handled. If @code{debug-on-quit} is
+non-@code{nil}, then the debugger is called whenever you quit (that
+is, type @kbd{C-g}). If @code{debug-on-quit} is @code{nil} (the
+default), then the debugger is not called when you quit.
@end defopt
@node Function Debugging
@@ -284,17 +310,23 @@ of @code{(debug)} isn't ignored, it will alter the execution of the
program!) The most common suitable places are inside a @code{progn} or
an implicit @code{progn} (@pxref{Sequencing}).
+ If you don't know exactly where in the source code you want to put
+the debug statement, but you want to display a backtrace when a
+certain message is displayed, you can set @code{debug-on-message} to a
+regular expression matching the desired message.
+
@node Using Debugger
@subsection Using the Debugger
When the debugger is entered, it displays the previously selected
-buffer in one window and a buffer named @samp{*Backtrace*} in another
+buffer in one window and a buffer named @file{*Backtrace*} in another
window. The backtrace buffer contains one line for each level of Lisp
function execution currently going on. At the beginning of this buffer
is a message describing the reason that the debugger was invoked (such
as the error message and associated data, if it was invoked due to an
error).
+@vindex debugger-bury-or-kill
The backtrace buffer is read-only and uses a special major mode,
Debugger mode, in which letters are defined as debugger commands. The
usual Emacs editing commands are available; thus, you can switch windows
@@ -303,8 +335,12 @@ switch buffers, visit files, or do any other sort of editing. However,
the debugger is a recursive editing level (@pxref{Recursive Editing})
and it is wise to go back to the backtrace buffer and exit the debugger
(with the @kbd{q} command) when you are finished with it. Exiting
-the debugger gets out of the recursive edit and kills the backtrace
-buffer.
+the debugger gets out of the recursive edit and buries the backtrace
+buffer. (You can customize what the @kbd{q} command does with the
+backtrace buffer by setting the variable @code{debugger-bury-or-kill}.
+For example, set it to @code{kill} if you prefer to kill the buffer
+rather than bury it. Consult the variable's documentation for more
+possibilities.)
When the debugger has been entered, the @code{debug-on-error}
variable is temporarily set according to
@@ -312,7 +348,7 @@ variable is temporarily set according to
non-@code{nil}, @code{debug-on-error} will temporarily be set to
@code{t}. This means that any further errors that occur while doing a
debugging session will (by default) trigger another backtrace. If
-this is not want you want, you can either set
+this is not what you want, you can either set
@code{eval-expression-debug-on-error} to @code{nil}, or set
@code{debug-on-error} to @code{nil} in @code{debugger-mode-hook}.
@@ -328,8 +364,8 @@ that exiting that frame will call the debugger again. This is useful
for examining the return value of a function.
If a function name is underlined, that means the debugger knows
-where its source code is located. You can click @kbd{Mouse-2} on that
-name, or move to it and type @key{RET}, to visit the source code.
+where its source code is located. You can click with the mouse on
+that name, or move to it and type @key{RET}, to visit the source code.
The debugger itself must be run byte-compiled, since it makes
assumptions about how many stack frames are used for the debugger
@@ -355,14 +391,10 @@ to step through a primitive function.
@table @kbd
@item c
-Exit the debugger and continue execution. When continuing is possible,
-it resumes execution of the program as if the debugger had never been
-entered (aside from any side-effects that you caused by changing
-variable values or data structures while inside the debugger).
-
-Continuing is possible after entry to the debugger due to function entry
-or exit, explicit invocation, or quitting. You cannot continue if the
-debugger was entered because of an error.
+Exit the debugger and continue execution. This resumes execution of
+the program as if the debugger had never been entered (aside from any
+side-effects that you caused by changing variable values or data
+structures while inside the debugger).
@item d
Continue execution, but enter the debugger the next time any Lisp
@@ -401,7 +433,7 @@ the variable values within the debugger.
@item R
Like @kbd{e}, but also save the result of evaluation in the
-buffer @samp{*Debugger-record*}.
+buffer @file{*Debugger-record*}.
@item q
Terminate the program being debugged; return to top-level Emacs
@@ -437,9 +469,9 @@ erroneously show up in this list.
Here we describe in full detail the function @code{debug} that is used
to invoke the debugger.
-@defun debug &rest debugger-args
+@deffn Command debug &rest debugger-args
This function enters the debugger. It switches buffers to a buffer
-named @samp{*Backtrace*} (or @samp{*Backtrace*<2>} if it is the second
+named @file{*Backtrace*} (or @file{*Backtrace*<2>} if it is the second
recursive entry to the debugger, etc.), and fills it with information
about the stack of Lisp function calls. It then enters a recursive
edit, showing the backtrace buffer in Debugger mode.
@@ -450,7 +482,7 @@ buffer and returns to whatever called @code{debug}. This is the only
way the function @code{debug} can return to its caller.
The use of the @var{debugger-args} is that @code{debug} displays the
-rest of its arguments at the top of the @samp{*Backtrace*} buffer, so
+rest of its arguments at the top of the @file{*Backtrace*} buffer, so
that the user can see them. Except as described below, this is the
@emph{only} way these arguments are used.
@@ -524,7 +556,7 @@ are printed on the top line of the buffer. You can use this feature to
display messages---for example, to remind yourself of the conditions
under which @code{debug} is called.
@end table
-@end defun
+@end deffn
@node Internals of Debugger
@subsection Internals of the Debugger
@@ -549,7 +581,7 @@ of @code{debug} (@pxref{Invoking the Debugger}).
@cindex call stack
This function prints a trace of Lisp function calls currently active.
This is the function used by @code{debug} to fill up the
-@samp{*Backtrace*} buffer. It is written in C, since it must have access
+@file{*Backtrace*} buffer. It is written in C, since it must have access
to the stack to determine which function calls are active. The return
value is always @code{nil}.
@@ -782,28 +814,62 @@ never return. If it ever does return, you get a run-time error.
Testing}). These features partly duplicate each other, and it would
be cleaner to combine them.
-@node Compilation Errors
-@section Debugging Problems in Compilation
-@cindex debugging byte compilation problems
-
- When an error happens during byte compilation, it is normally due to
-invalid syntax in the program you are compiling. The compiler prints a
-suitable error message in the @samp{*Compile-Log*} buffer, and then
-stops. The message may state a function name in which the error was
-found, or it may not. Either way, here is how to find out where in the
-file the error occurred.
-
- What you should do is switch to the buffer @w{@samp{ *Compiler Input*}}.
-(Note that the buffer name starts with a space, so it does not show
-up in @kbd{M-x list-buffers}.) This buffer contains the program being
-compiled, and point shows how far the byte compiler was able to read.
-
- If the error was due to invalid Lisp syntax, point shows exactly where
-the invalid syntax was @emph{detected}. The cause of the error is not
-necessarily near by! Use the techniques in the previous section to find
-the error.
-
- If the error was detected while compiling a form that had been read
-successfully, then point is located at the end of the form. In this
-case, this technique can't localize the error precisely, but can still
-show you which function to check.
+
+@node Profiling
+@section Profiling
+@cindex profiling
+@cindex measuring resource usage
+@cindex memory usage
+
+If your program is working correctly, but you want to make it run more
+quickly or efficiently, the first thing to do is @dfn{profile} your
+code so that you know how it is using resources. If you find that one
+particular function is responsible for a significant portion of the
+runtime, you can start looking for ways to optimize that piece.
+
+Emacs has built-in support for this. To begin profiling, type
+@kbd{M-x profiler-start}. You can choose to profile by processor
+usage, memory usage, or both. After doing some work, type
+@kbd{M-x profiler-report} to display a summary buffer for each
+resource that you chose to profile. The names of the report buffers
+include the times at which the reports were generated, so you can
+generate another report later on without erasing previous results.
+When you have finished profiling, type @kbd{M-x profiler-stop} (there
+is a small overhead associated with profiling).
+
+The profiler report buffer shows, on each line, a function that was
+called, followed by how much resource (processor or memory) it used in
+absolute and percentage times since profiling started. If a given
+line has a @samp{+} symbol at the left-hand side, you can expand that
+line by typing @key{RET}, in order to see the function(s) called by
+the higher-level function. Pressing @key{RET} again will collapse
+back to the original state.
+
+Press @kbd{j} or @kbd{mouse-2} to jump to the definition of a function.
+Press @kbd{d} to view a function's documentation.
+You can save a profile to a file using @kbd{C-x C-w}.
+You can compare two profiles using @kbd{=}.
+
+@c FIXME reversed calltree?
+
+@cindex @file{elp.el}
+@cindex timing programs
+The @file{elp} library offers an alternative approach. See the file
+@file{elp.el} for instructions.
+
+@cindex @file{benchmark.el}
+@cindex benchmarking
+You can check the speed of individual Emacs Lisp forms using the
+@file{benchmark} library. See the functions @code{benchmark-run} and
+@code{benchmark-run-compiled} in @file{benchmark.el}.
+
+@c Not worth putting in the printed manual.
+@ifnottex
+@cindex --enable-profiling option of configure
+To profile Emacs at the level of its C code, you can build it using the
+@option{--enable-profiling} option of @command{configure}. When Emacs
+exits, it generates a file @file{gmon.out} that you can examine using
+the @command{gprof} utility. This feature is mainly useful for
+debugging Emacs. It actually stops the Lisp-level @kbd{M-x
+profiler-@dots{}} commands described above from working.
+@end ifnottex
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index a9921d7443d..5148c6ec22e 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/display
-@node Display, System Interface, Processes, Top
+@node Display
@chapter Emacs Display
This chapter describes a number of features related to the display
@@ -28,15 +27,13 @@ that Emacs presents to the user.
* Display Property:: Enabling special display features.
* Images:: Displaying images in Emacs buffers.
* Buttons:: Adding clickable buttons to Emacs buffers.
-* Abstract Display:: Emacs' Widget for Object Collections.
+* Abstract Display:: Emacs's Widget for Object Collections.
* Blinking:: How Emacs shows the matching open parenthesis.
-* Usual Display:: The usual conventions for displaying nonprinting chars.
-* Display Tables:: How to specify other conventions.
+* Character Display:: How Emacs displays individual characters.
* Beeping:: Audible signal to the user.
* Window Systems:: Which window system is being used.
* Bidirectional Display:: Display of bidirectional scripts, such as
Arabic and Farsi.
-* Glyphless Chars:: How glyphless characters are drawn.
@end menu
@node Refresh Screen
@@ -46,7 +43,6 @@ that Emacs presents to the user.
contents of a given frame (@pxref{Frames}). This is useful if the
screen is corrupted.
-@c Emacs 19 feature
@defun redraw-frame frame
This function clears and redisplays frame @var{frame}.
@end defun
@@ -62,7 +58,7 @@ you call these functions when input is available, they don't redisplay
immediately, but the requested redisplay does happen
eventually---after all the input has been processed.
- On text-only terminals, suspending and resuming Emacs normally also
+ On text terminals, suspending and resuming Emacs normally also
refreshes the screen. Some terminal emulators record separate
contents for display-oriented programs such as Emacs and for ordinary
sequential display. If you are using such a terminal, you might want
@@ -86,59 +82,57 @@ attempt to redisplay, in the middle of Lisp code, without actually
waiting for input.
@defun redisplay &optional force
-This function tries immediately to redisplay, provided there are no
-pending input events.
-
-If the optional argument @var{force} is non-@code{nil}, it does all
-pending redisplay work even if input is available, with no
-pre-emption.
+This function tries immediately to redisplay. The optional argument
+@var{force}, if non-@code{nil}, forces the redisplay to be performed,
+instead of being preempted, even if input is pending and the variable
+@code{redisplay-dont-pause} is @code{nil} (see below). If
+@code{redisplay-dont-pause} is non-@code{nil} (the default), this
+function redisplays in any case, i.e.@: @var{force} does nothing.
The function returns @code{t} if it actually tried to redisplay, and
@code{nil} otherwise. A value of @code{t} does not mean that
-redisplay proceeded to completion; it could have been pre-empted by
-newly arriving terminal input.
-@end defun
-
- @code{redisplay} with no argument tries immediately to redisplay,
-but has no effect on the usual rules for what parts of the screen to
-redisplay. By contrast, the following function adds certain windows
-to the pending redisplay work (as if their contents had completely
-changed), but doesn't immediately try to do any redisplay work.
-
-@defun force-window-update &optional object
-This function forces some or all windows to be updated on next
-redisplay. If @var{object} is a window, it requires eventual
-redisplay of that window. If @var{object} is a buffer or buffer name,
-it requires eventual redisplay of all windows displaying that buffer.
-If @var{object} is @code{nil} (or omitted), it requires eventual
-redisplay of all windows.
+redisplay proceeded to completion; it could have been preempted by
+newly arriving input.
@end defun
- @code{force-window-update} does not do a redisplay immediately.
-(Emacs will do that when it waits for input.) Rather, its effect is
-to put more work on the queue to be done by redisplay whenever there
-is a chance.
-
@defvar redisplay-dont-pause
-If this variable is non-@code{nil}, pending input does not prevent or
-halt redisplay; redisplay occurs, and finishes, regardless of whether
-input is available. If it is @code{nil}, Emacs redisplay stops if
-input arrives, and does not happen at all if input is available before
-it starts. The default is @code{t}.
+If this variable is @code{nil}, arriving input events preempt
+redisplay; Emacs avoids starting a redisplay, and stops any redisplay
+that is in progress, until the input has been processed. In
+particular, @code{(redisplay)} returns @code{nil} without actually
+redisplaying, if there is pending input.
+
+The default value is @code{t}, which means that pending input does not
+preempt redisplay.
@end defvar
@defvar redisplay-preemption-period
-This variable specifies how many seconds Emacs waits between checks
-for new input during redisplay. (The default is 0.1 seconds.) If
-input has arrived when Emacs checks, it pre-empts redisplay and
-processes the available input before trying again to redisplay.
+If @code{redisplay-dont-pause} is @code{nil}, this variable specifies
+how many seconds Emacs waits between checks for new input during
+redisplay; if input arrives during this interval, redisplay stops and
+the input is processed. The default value is 0.1; if the value is
+@code{nil}, Emacs does not check for input during redisplay.
+
+This variable has no effect when @code{redisplay-dont-pause} is
+non-@code{nil} (the default).
+@end defvar
-If this variable is @code{nil}, Emacs does not check for input during
-redisplay, and redisplay cannot be preempted by input.
+ Although @code{redisplay} tries immediately to redisplay, it does
+not change how Emacs decides which parts of its frame(s) to redisplay.
+By contrast, the following function adds certain windows to the
+pending redisplay work (as if their contents had completely changed),
+but does not immediately try to perform redisplay.
-This variable is only obeyed on graphical terminals. For
-text terminals, see @ref{Terminal Output}.
-@end defvar
+@defun force-window-update &optional object
+This function forces some or all windows to be updated the next time
+Emacs does a redisplay. If @var{object} is a window, that window is
+to be updated. If @var{object} is a buffer or buffer name, all
+windows displaying that buffer are to be updated. If @var{object} is
+@code{nil} (or omitted), all windows are to be updated.
+
+This function does not do a redisplay immediately; Emacs does that as
+it waits for input, or when the function @code{redisplay} is called.
+@end defun
@node Truncation
@section Truncation
@@ -161,7 +155,7 @@ boundary. @xref{Filling}.
indicate truncated and continued lines (@pxref{Fringes}). On a text
terminal, a @samp{$} in the rightmost column of the window indicates
truncation; a @samp{\} on the rightmost column indicates a line that
-``wraps.'' (The display table can specify alternate characters to use
+``wraps''. (The display table can specify alternate characters to use
for this; @pxref{Display Tables}).
@defopt truncate-lines
@@ -169,7 +163,7 @@ If this buffer-local variable is non-@code{nil}, lines that extend
beyond the right edge of the window are truncated; otherwise, they are
continued. As a special exception, the variable
@code{truncate-partial-width-windows} takes precedence in
-@dfn{partial-width} windows (i.e., windows that do not occupy the
+@dfn{partial-width} windows (i.e.@: windows that do not occupy the
entire frame width).
@end defopt
@@ -192,37 +186,37 @@ a window, that forces truncation.
@defvar wrap-prefix
If this buffer-local variable is non-@code{nil}, it defines a
-``prefix'' that is prepended to every continuation line at
-display time. (If lines are truncated, the wrap-prefix is never
-used.) It may be a string or an image (@pxref{Other Display Specs}),
-or a stretch of whitespace such as specified by the @code{:width} or
-@code{:align-to} display properties (@pxref{Specified Space}). The
-value is interpreted in the same way as a @code{display} text
-property. @xref{Display Property}.
-
-A wrap-prefix may also be specified for regions of text, using the
+@dfn{wrap prefix} which Emacs displays at the start of every
+continuation line. (If lines are truncated, @code{wrap-prefix} is
+never used.) Its value may be a string or an image (@pxref{Other
+Display Specs}), or a stretch of whitespace such as specified by the
+@code{:width} or @code{:align-to} display properties (@pxref{Specified
+Space}). The value is interpreted in the same way as a @code{display}
+text property. @xref{Display Property}.
+
+A wrap prefix may also be specified for regions of text, using the
@code{wrap-prefix} text or overlay property. This takes precedence
over the @code{wrap-prefix} variable. @xref{Special Properties}.
@end defvar
@defvar line-prefix
If this buffer-local variable is non-@code{nil}, it defines a
-``prefix'' that is prepended to every non-continuation line at
-display time. It may be a string or an image (@pxref{Other Display
-Specs}), or a stretch of whitespace such as specified by the
-@code{:width} or @code{:align-to} display properties (@pxref{Specified
-Space}). The value is interpreted in the same way as a @code{display}
-text property. @xref{Display Property}.
-
-A line-prefix may also be specified for regions of text using the
+@dfn{line prefix} which Emacs displays at the start of every
+non-continuation line. Its value may be a string or an image
+(@pxref{Other Display Specs}), or a stretch of whitespace such as
+specified by the @code{:width} or @code{:align-to} display properties
+(@pxref{Specified Space}). The value is interpreted in the same way
+as a @code{display} text property. @xref{Display Property}.
+
+A line prefix may also be specified for regions of text using the
@code{line-prefix} text or overlay property. This takes precedence
over the @code{line-prefix} variable. @xref{Special Properties}.
@end defvar
If your buffer contains @emph{very} long lines, and you use
continuation to display them, computing the continuation lines can
-make Emacs redisplay slow. The column computation and indentation
-functions also become slow. Then you might find it advisable to set
+make redisplay slow. The column computation and indentation functions
+also become slow. Then you might find it advisable to set
@code{cache-long-line-scans} to @code{t}.
@defvar cache-long-line-scans
@@ -245,14 +239,12 @@ This variable is automatically buffer-local in every buffer.
(@pxref{Errors}), for messages made with the @code{message} primitive,
and for echoing keystrokes. It is not the same as the minibuffer,
despite the fact that the minibuffer appears (when active) in the same
-place on the screen as the echo area. The @cite{GNU Emacs Manual}
-specifies the rules for resolving conflicts between the echo area and
-the minibuffer for use of that screen space (@pxref{Minibuffer,, The
-Minibuffer, emacs, The GNU Emacs Manual}).
+place on the screen as the echo area. @xref{Minibuffer,, The
+Minibuffer, emacs, The GNU Emacs Manual}.
- You can write output in the echo area by using the Lisp printing
-functions with @code{t} as the stream (@pxref{Output Functions}), or
-explicitly.
+ Apart from the functions documented in this section, you can print
+Lisp objects to the echo area by specifying @code{t} as the output
+stream. @xref{Output Streams}.
@menu
* Displaying Messages:: Explicitly displaying text in the echo area.
@@ -265,27 +257,26 @@ explicitly.
@subsection Displaying Messages in the Echo Area
@cindex display message in echo area
- This section describes the functions for explicitly producing echo
-area messages. Many other Emacs features display messages there, too.
+ This section describes the standard functions for displaying
+messages in the echo area.
@defun message format-string &rest arguments
-This function displays a message in the echo area. The argument
-@var{format-string} is similar to a C language @code{printf} format
-string. See @code{format} in @ref{Formatting Strings}, for the details
-on the conversion specifications. @code{message} returns the
-constructed string.
+This function displays a message in the echo area.
+@var{format-string} is a format string, and @var{arguments} are the
+objects for its format specifications, like in the @code{format}
+function (@pxref{Formatting Strings}). The resulting formatted string
+is displayed in the echo area; if it contains @code{face} text
+properties, it is displayed with the specified faces (@pxref{Faces}).
+The string is also added to the @file{*Messages*} buffer, but without
+text properties (@pxref{Logging Messages}).
+
+In batch mode, the message is printed to the standard error stream,
+followed by a newline.
-In batch mode, @code{message} prints the message text on the standard
-error stream, followed by a newline.
-
-If @var{format-string}, or strings among the @var{arguments}, have
-@code{face} text properties, these affect the way the message is displayed.
-
-@c Emacs 19 feature
If @var{format-string} is @code{nil} or the empty string,
@code{message} clears the echo area; if the echo area has been
-expanded automatically, this brings it back to its normal size.
-If the minibuffer is active, this brings the minibuffer contents back
+expanded automatically, this brings it back to its normal size. If
+the minibuffer is active, this brings the minibuffer contents back
onto the screen immediately.
@example
@@ -349,7 +340,7 @@ buffer is used, the window used to display it.
If @var{message} is a string, then the optional argument
@var{buffer-name} is the name of the buffer used to display it when a
-pop-up buffer is used, defaulting to @samp{*Message*}. In the case
+pop-up buffer is used, defaulting to @file{*Message*}. In the case
where @var{message} is a string and displayed in the echo area, it is
not specified whether the contents are inserted into the buffer anyway.
@@ -422,7 +413,7 @@ This function calls @code{progress-reporter-update}, so the first
message is printed immediately.
@end defun
-@defun progress-reporter-update reporter value
+@defun progress-reporter-update reporter &optional value
This function does the main work of reporting progress of your
operation. It displays the message of @var{reporter}, followed by
progress percentage determined by @var{value}. If percentage is zero,
@@ -443,7 +434,7 @@ try to reduce the number of calls to it: resulting overhead will most
likely negate your effort.
@end defun
-@defun progress-reporter-force-update reporter value &optional new-message
+@defun progress-reporter-force-update reporter &optional value new-message
This function is similar to @code{progress-reporter-update} except
that it prints a message in the echo area unconditionally.
@@ -460,7 +451,7 @@ prints the message of @var{reporter} followed by word ``done'' in the
echo area.
You should always call this function and not hope for
-@code{progress-reporter-update} to print ``100%.'' Firstly, it may
+@code{progress-reporter-update} to print ``100%''. Firstly, it may
never print it, there are many good reasons for this not to happen.
Secondly, ``done'' is more explicit.
@end defun
@@ -482,16 +473,16 @@ this macro this way:
@end defmac
@node Logging Messages
-@subsection Logging Messages in @samp{*Messages*}
+@subsection Logging Messages in @file{*Messages*}
@cindex logging echo-area messages
Almost all the messages displayed in the echo area are also recorded
-in the @samp{*Messages*} buffer so that the user can refer back to
+in the @file{*Messages*} buffer so that the user can refer back to
them. This includes all the messages that are output with
@code{message}.
@defopt message-log-max
-This variable specifies how many lines to keep in the @samp{*Messages*}
+This variable specifies how many lines to keep in the @file{*Messages*}
buffer. The value @code{t} means there is no limit on how many lines to
keep. The value @code{nil} disables message logging entirely. Here's
how to display a message and prevent it from being logged:
@@ -502,7 +493,7 @@ how to display a message and prevent it from being logged:
@end example
@end defopt
- To make @samp{*Messages*} more convenient for the user, the logging
+ To make @file{*Messages*} more convenient for the user, the logging
facility combines successive identical messages. It also combines
successive related messages for the sake of two cases: question
followed by answer, and a series of progress messages.
@@ -561,13 +552,13 @@ If the value is zero, then command input is not echoed.
Normally, displaying a long message resizes the echo area to display
the entire message. But if the variable @code{message-truncate-lines}
is non-@code{nil}, the echo area does not resize, and the message is
-truncated to fit it, as in Emacs 20 and before.
+truncated to fit it.
@end defvar
The variable @code{max-mini-window-height}, which specifies the
maximum height for resizing minibuffer windows, also applies to the
-echo area (which is really a special use of the minibuffer window.
-@xref{Minibuffer Misc}.).
+echo area (which is really a special use of the minibuffer window;
+@pxref{Minibuffer Misc}).
@node Warnings
@section Reporting Warnings
@@ -580,6 +571,7 @@ possible problem, but continue running.
* Warning Basics:: Warnings concepts and functions to report them.
* Warning Variables:: Variables programs bind to customize their warnings.
* Warning Options:: Variables users set to control display of warnings.
+* Delayed Warnings:: Deferring a warning until the end of a command.
@end menu
@node Warning Basics
@@ -631,7 +623,7 @@ and @var{type} as the warning type. @var{level} should be the
severity level, with @code{:warning} being the default.
@var{buffer-name}, if non-@code{nil}, specifies the name of the buffer
-for logging the warning. By default, it is @samp{*Warnings*}.
+for logging the warning. By default, it is @file{*Warnings*}.
@end defun
@defun lwarn type level message &rest args
@@ -758,16 +750,64 @@ symbols. If it matches the first few elements in a warning type, then
that warning is not logged.
@end defopt
+@node Delayed Warnings
+@subsection Delayed Warnings
+
+Sometimes, you may wish to avoid showing a warning while a command is
+running, and only show it only after the end of the command. You can
+use the variable @code{delayed-warnings-list} for this.
+
+@defvar delayed-warnings-list
+The value of this variable is a list of warnings to be displayed after
+the current command has finished. Each element must be a list
+
+@smallexample
+(@var{type} @var{message} [@var{level} [@var{buffer-name}]])
+@end smallexample
+
+@noindent
+with the same form, and the same meanings, as the argument list of
+@code{display-warning} (@pxref{Warning Basics}). Immediately after
+running @code{post-command-hook} (@pxref{Command Overview}), the Emacs
+command loop displays all the warnings specified by this variable,
+then resets it to @code{nil}.
+@end defvar
+
+ Programs which need to further customize the delayed warnings
+mechanism can change the variable @code{delayed-warnings-hook}:
+
+@defvar delayed-warnings-hook
+This is a normal hook which is run by the Emacs command loop, after
+@code{post-command-hook}, in order to to process and display delayed
+warnings.
+
+Its default value is a list of two functions:
+
+@smallexample
+(collapse-delayed-warnings display-delayed-warnings)
+@end smallexample
+
+@findex collapse-delayed-warnings
+@findex display-delayed-warnings
+@noindent
+The function @code{collapse-delayed-warnings} removes repeated entries
+from @code{delayed-warnings-list}. The function
+@code{display-delayed-warnings} calls @code{display-warning} on each
+of the entries in @code{delayed-warnings-list}, in turn, and then sets
+@code{delayed-warnings-list} to @code{nil}.
+@end defvar
+
@node Invisible Text
@section Invisible Text
@cindex invisible text
You can make characters @dfn{invisible}, so that they do not appear on
the screen, with the @code{invisible} property. This can be either a
-text property (@pxref{Text Properties}) or a property of an overlay
+text property (@pxref{Text Properties}) or an overlay property
(@pxref{Overlays}). Cursor motion also partly ignores these
-characters; if the command loop finds point within them, it moves
-point to the other side of them.
+characters; if the command loop finds that point is inside a range of
+invisible text after a command, it relocates point to the other side
+of the text.
In the simplest case, any non-@code{nil} @code{invisible} property makes
a character invisible. This is the default case---if you don't alter
@@ -807,13 +847,15 @@ the character is invisible. The list can have two kinds of elements:
@table @code
@item @var{atom}
-A character is invisible if its @code{invisible} property value
-is @var{atom} or if it is a list with @var{atom} as a member.
+A character is invisible if its @code{invisible} property value is
+@var{atom} or if it is a list with @var{atom} as a member; comparison
+is done with @code{eq}.
@item (@var{atom} . t)
A character is invisible if its @code{invisible} property value is
-@var{atom} or if it is a list with @var{atom} as a member. Moreover,
-a sequence of such characters displays as an ellipsis.
+@var{atom} or if it is a list with @var{atom} as a member; comparison
+is done with @code{eq}. Moreover, a sequence of such characters
+displays as an ellipsis.
@end table
@end table
@end defvar
@@ -848,7 +890,7 @@ major mode should use the mode's own name as an element of
(overlay-put (make-overlay beginning end)
'invisible 'my-symbol)
-;; @r{When done with the overlays:}
+;; @r{When done with the invisibility:}
(remove-from-invisibility-spec '(my-symbol . t))
;; @r{Or respectively:}
(remove-from-invisibility-spec 'my-symbol)
@@ -874,15 +916,16 @@ ignore invisible newlines if @code{line-move-ignore-invisible} is
non-@code{nil} (the default), but only because they are explicitly
programmed to do so.
- However, if a command ends with point inside or at the boundary of invisible
-text, the main editing loop moves point to one of the two ends of the invisible
-text. Which end to move to is chosen based on the following factors: make sure
-that the overall movement of the command is still in the same direction, and
-prefer a position where an inserted char would not inherit the @code{invisible}
-property. Additionally, if the text is not replaced by an ellipsis and the
-command only moved within the invisible text, then point is moved one extra
-character so as to try and reflect the command's movement by a visible movement
-of the cursor.
+ However, if a command ends with point inside or at the boundary of
+invisible text, the main editing loop relocates point to one of the
+two ends of the invisible text. Emacs chooses the direction of
+relocation so that it is the same as the overall movement direction of
+the command; if in doubt, it prefers a position where an inserted char
+would not inherit the @code{invisible} property. Additionally, if the
+text is not replaced by an ellipsis and the command only moved within
+the invisible text, then point is moved one extra character so as to
+try and reflect the command's movement by a visible movement of the
+cursor.
Thus, if the command moved point back to an invisible range (with the usual
stickiness), Emacs moves point back to the beginning of that range. If the
@@ -1031,11 +1074,12 @@ You can use a display table to substitute other text for the ellipsis
buffer and then present it to the user for perusal rather than for
editing. Many help commands use this feature.
-@defspec with-output-to-temp-buffer buffer-name forms@dots{}
+@defmac with-output-to-temp-buffer buffer-name forms@dots{}
This function executes @var{forms} while arranging to insert any output
they print into the buffer named @var{buffer-name}, which is first
created if necessary, and put into Help mode. Finally, the buffer is
-displayed in some window, but not selected.
+displayed in some window, but not selected. (See the similar
+form @code{with-temp-buffer-window} below.)
If the @var{forms} do not change the major mode in the output buffer,
so that it is still Help mode at the end of their execution, then
@@ -1083,7 +1127,7 @@ The value of the last form in @var{forms} is returned.
---------- Buffer: foo ----------
@end group
@end example
-@end defspec
+@end defmac
@defopt temp-buffer-show-function
If this variable is non-@code{nil}, @code{with-output-to-temp-buffer}
@@ -1109,6 +1153,37 @@ displaying the temporary buffer. When the hook runs, the temporary buffer
is current, and the window it was displayed in is selected.
@end defvar
+@defmac with-temp-buffer-window buffer-or-name action quit-function forms@dots{}
+This macro is similar to @code{with-output-to-temp-buffer}.
+Like that construct, it executes @var{forms} while arranging to insert
+any output they print into the buffer named @var{buffer-or-name}.
+Finally, the buffer is displayed in some window, but not selected.
+Unlike @code{with-output-to-temp-buffer}, this does not switch to Help
+mode.
+
+The argument @var{buffer-or-name} specifies the temporary buffer.
+It can be either a buffer, which must already exist, or a string,
+in which case a buffer of that name is created if necessary.
+The buffer is marked as unmodified and read-only when
+@code{with-temp-buffer-window} exits.
+
+This macro does not call @code{temp-buffer-show-function}. Rather, it
+passes the @var{action} argument to @code{display-buffer} in order to
+display the buffer.
+
+The value of the last form in @var{forms} is returned, unless the
+argument @var{quit-function} is specified. In that case,
+it is called with two arguments: the window showing the buffer
+and the result of @var{forms}. The final return value is then
+whatever @var{quit-function} returns.
+
+@vindex temp-buffer-window-setup-hook
+@vindex temp-buffer-window-show-hook
+This macro uses the normal hooks @code{temp-buffer-window-setup-hook}
+and @code{temp-buffer-window-show-hook} in place of the analogous hooks
+run by @code{with-output-to-temp-buffer}.
+@end defmac
+
@defun momentary-string-display string position &optional char message
This function momentarily displays @var{string} in the current buffer at
@var{position}. It has no effect on the undo list or on the buffer's
@@ -1265,7 +1340,7 @@ The return value is @var{overlay}.
This is the only valid way to change the endpoints of an overlay. Do
not try modifying the markers in the overlay by hand, as that fails to
update other vital data structures and can cause some overlays to be
-``lost.''
+``lost''.
@end defun
@defun remove-overlays &optional start end name value
@@ -1342,7 +1417,7 @@ foo
@end example
Emacs stores the overlays of each buffer in two lists, divided
-around an arbitrary ``center position.'' One list extends backwards
+around an arbitrary ``center position''. One list extends backwards
through the buffer from that center position, and the other extends
forwards from that center position. The center position can be anywhere
in the buffer.
@@ -1406,7 +1481,7 @@ of them:
@table @code
@item priority
@kindex priority @r{(overlay property)}
-This property's value (which should be a nonnegative integer number)
+This property's value (which should be a non-negative integer number)
determines the priority of the overlay. No priority, or @code{nil},
means zero.
@@ -1561,7 +1636,7 @@ sense---only on the screen.
This property specifies a display spec to prepend to each
non-continuation line at display-time. @xref{Truncation}.
-@itemx wrap-prefix
+@item wrap-prefix
This property specifies a display spec to prepend to each continuation
line at display-time. @xref{Truncation}.
@@ -1668,8 +1743,11 @@ check the width of a character. @xref{Primitive Indent}, and
@ref{Screen Lines}, for related functions.
@defun char-width char
-This function returns the width in columns of the character @var{char},
-if it were displayed in the current buffer and the selected window.
+This function returns the width in columns of the character
+@var{char}, if it were displayed in the current buffer (i.e.@: taking
+into account the buffer's display table, if any; @pxref{Display
+Tables}). The width of a tab character is usually @code{tab-width}
+(@pxref{Usual Display}).
@end defun
@defun string-width string
@@ -1809,36 +1887,53 @@ into a Lisp value as described above. However, in this case the
numeric height value specifies the line spacing, rather than the line
height.
- On text-only terminals, the line spacing cannot be altered.
+ On text terminals, the line spacing cannot be altered.
@node Faces
@section Faces
@cindex faces
- A @dfn{face} is a collection of graphical attributes for displaying
-text: font, foreground color, background color, optional underlining,
-and so on. Faces control how buffer text is displayed, and how some
-parts of the frame, such as the mode-line, are displayed.
-@xref{Standard Faces,,, emacs, The GNU Emacs Manual}, for the list of
-faces Emacs normally comes with.
-
-@cindex face id
- For most purposes, you refer to a face in Lisp programs using its
-@dfn{face name}. This is either a string or (equivalently) a Lisp
-symbol whose name is equal to that string.
+ A @dfn{face} is a collection of graphical @dfn{attributes} for
+displaying text: font, foreground color, background color, optional
+underlining, etc. Faces control how Emacs displays text in buffers,
+as well as other parts of the frame such as the mode line.
+
+@cindex anonymous face
+ One way to represent a face is as a property list of attributes,
+like @code{(:foreground "red" :weight bold)}. For example, you can
+assign such an @dfn{anonymous face} as the value of the @code{face}
+text property; this causes Emacs to display the underlying text with
+the specified attributes. @xref{Special Properties}.
+
+@cindex face name
+ More commonly, a face is referred to via a @dfn{face name}: a Lisp
+symbol which is associated with a set of face attributes. Named faces
+are defined using the @code{defface} macro (@pxref{Defining Faces}).
+Emacs defines several standard named faces; @xref{Standard Faces,,,
+emacs, The GNU Emacs Manual}.
+
+ Many parts of Emacs require named faces, and do not accept anonymous
+faces. These include the functions documented in @ref{Attribute
+Functions}, and the variable @code{font-lock-keywords}
+(@pxref{Search-based Fontification}). Unless otherwise stated, we
+will use the term @dfn{face} to refer only to named faces.
+
+ For backward compatibility, you can also use a string to specify a
+face name; that is equivalent to a Lisp symbol with the same name.
@defun facep object
-This function returns a non-@code{nil} value if @var{object} is a Lisp
-symbol or string that names a face. Otherwise, it returns @code{nil}.
+This function returns a non-@code{nil} value if @var{object} is a
+named face: a Lisp symbol or string which serves as a face name.
+Otherwise, it returns @code{nil}.
@end defun
- Each face name is meaningful for all frames, and by default it has
-the same meaning in all frames. But you can arrange to give a
-particular face name a special meaning in one frame if you wish.
+ By default, each face name corresponds to the same set of attributes
+in all frames. But you can also assign a face name a special set of
+attributes in one frame (@pxref{Attribute Functions}).
@menu
-* Defining Faces:: How to define a face with @code{defface}.
* Face Attributes:: What is in a face?
+* Defining Faces:: How to define a face.
* Attribute Functions:: Functions to examine and set face attributes.
* Displaying Faces:: How Emacs combines the faces specified for a character.
* Face Remapping:: Remapping faces to alternative definitions.
@@ -1853,198 +1948,51 @@ particular face name a special meaning in one frame if you wish.
* Low-Level Font:: Lisp representation for character display fonts.
@end menu
-@node Defining Faces
-@subsection Defining Faces
-
- The way to define a new face is with @code{defface}. This creates a
-kind of customization item (@pxref{Customization}) which the user can
-customize using the Customization buffer (@pxref{Easy Customization,,,
-emacs, The GNU Emacs Manual}).
-
- People are sometimes tempted to create variables whose values specify
-which faces to use (for example, Font-Lock does this). In the vast
-majority of cases, this is not necessary, and simply using faces
-directly is preferable.
-
-@defmac defface face spec doc [keyword value]@dots{}
-This declares @var{face} as a customizable face whose default
-attributes are given by @var{spec}. You should not quote the symbol
-@var{face}, and it should not end in @samp{-face} (that would be
-redundant). The argument @var{doc} specifies the face documentation.
-The keywords you can use in @code{defface} are the same as in
-@code{defgroup} and @code{defcustom} (@pxref{Common Keywords}).
-
-When @code{defface} executes, it defines the face according to
-@var{spec}, then uses any customizations that were read from the
-init file (@pxref{Init File}) to override that specification.
-
-When you evaluate a @code{defface} form with @kbd{C-M-x} in Emacs
-Lisp mode (@code{eval-defun}), a special feature of @code{eval-defun}
-overrides any customizations of the face. This way, the face reflects
-exactly what the @code{defface} says.
-
-The purpose of @var{spec} is to specify how the face should appear on
-different kinds of terminals. It should be an alist whose elements
-have the form @code{(@var{display} @var{atts})}. Each element's
-@sc{car}, @var{display}, specifies a class of terminals. (The first
-element, if its @sc{car} is @code{default}, is special---it specifies
-defaults for the remaining elements). The element's @sc{cadr},
-@var{atts}, is a list of face attributes and their values; it
-specifies what the face should look like on that kind of terminal.
-The possible attributes are defined in the value of
-@code{custom-face-attributes}.
-
-The @var{display} part of an element of @var{spec} determines which
-frames the element matches. If more than one element of @var{spec}
-matches a given frame, the first element that matches is the one used
-for that frame. There are three possibilities for @var{display}:
-
-@table @asis
-@item @code{default}
-This element of @var{spec} doesn't match any frames; instead, it
-specifies defaults that apply to all frames. This kind of element, if
-used, must be the first element of @var{spec}. Each of the following
-elements can override any or all of these defaults.
-
-@item @code{t}
-This element of @var{spec} matches all frames. Therefore, any
-subsequent elements of @var{spec} are never used. Normally
-@code{t} is used in the last (or only) element of @var{spec}.
-
-@item a list
-If @var{display} is a list, each element should have the form
-@code{(@var{characteristic} @var{value}@dots{})}. Here
-@var{characteristic} specifies a way of classifying frames, and the
-@var{value}s are possible classifications which @var{display} should
-apply to. Here are the possible values of @var{characteristic}:
-
-@table @code
-@item type
-The kind of window system the frame uses---either @code{graphic} (any
-graphics-capable display), @code{x}, @code{pc} (for the MS-DOS console),
-@code{w32} (for MS Windows 9X/NT/2K/XP), or @code{tty}
-(a non-graphics-capable display).
-@xref{Window Systems, window-system}.
-
-@item class
-What kinds of colors the frame supports---either @code{color},
-@code{grayscale}, or @code{mono}.
-
-@item background
-The kind of background---either @code{light} or @code{dark}.
-
-@item min-colors
-An integer that represents the minimum number of colors the frame
-should support. This matches a frame if its
-@code{display-color-cells} value is at least the specified integer.
-
-@item supports
-Whether or not the frame can display the face attributes given in
-@var{value}@dots{} (@pxref{Face Attributes}). @xref{Display Face
-Attribute Testing}, for more information on exactly how this testing
-is done.
-@end table
-
-If an element of @var{display} specifies more than one @var{value} for a
-given @var{characteristic}, any of those values is acceptable. If
-@var{display} has more than one element, each element should specify a
-different @var{characteristic}; then @emph{each} characteristic of the
-frame must match one of the @var{value}s specified for it in
-@var{display}.
-@end table
-@end defmac
-
- Here's how the standard face @code{region} is defined:
-
-@example
-@group
-(defface region
- '((((class color) (min-colors 88) (background dark))
- :background "blue3")
-@end group
- (((class color) (min-colors 88) (background light))
- :background "lightgoldenrod2")
- (((class color) (min-colors 16) (background dark))
- :background "blue3")
- (((class color) (min-colors 16) (background light))
- :background "lightgoldenrod2")
- (((class color) (min-colors 8))
- :background "blue" :foreground "white")
- (((type tty) (class mono))
- :inverse-video t)
- (t :background "gray"))
-@group
- "Basic face for highlighting the region."
- :group 'basic-faces)
-@end group
-@end example
-
- Internally, @code{defface} uses the symbol property
-@code{face-defface-spec} to record the specified face attributes. The
-attributes saved by the user with the customization buffer are
-recorded in the symbol property @code{saved-face}; the attributes
-customized by the user for the current session, but not saved, are
-recorded in the symbol property @code{customized-face}. The
-documentation string is recorded in the symbol property
-@code{face-documentation}.
-
-@defopt frame-background-mode
-This option, if non-@code{nil}, specifies the background type to use for
-interpreting face definitions. If it is @code{dark}, then Emacs treats
-all frames as if they had a dark background, regardless of their actual
-background colors. If it is @code{light}, then Emacs treats all frames
-as if they had a light background.
-@end defopt
-
@node Face Attributes
@subsection Face Attributes
@cindex face attributes
- The effect of using a face is determined by a fixed set of @dfn{face
-attributes}. This table lists all the face attributes, their possible
-values, and their effects. You can specify more than one face for a
-given piece of text; Emacs merges the attributes of all the faces to
-determine how to display the text. @xref{Displaying Faces}.
+ @dfn{Face attributes} determine the visual appearance of a face.
+The following table lists all the face attributes, their possible
+values, and their effects.
- In addition to the values given below, each face attribute can also
-have the value @code{unspecified}. This special value means the face
-doesn't specify that attribute. In face merging, when the first face
-fails to specify a particular attribute, the next face gets a chance.
-However, the @code{default} face must specify all attributes.
+ Apart from the values given below, each face attribute can have the
+value @code{unspecified}. This special value means that the face
+doesn't specify that attribute directly. An @code{unspecified}
+attribute tells Emacs to refer instead to a parent face (see the
+description @code{:inherit} attribute below); or, failing that, to an
+underlying face (@pxref{Displaying Faces}). The @code{default} face
+must specify all attributes.
- Some of these font attributes are meaningful only on certain kinds
-of displays. If your display cannot handle a certain attribute, the
+ Some of these attributes are meaningful only on certain kinds of
+displays. If your display cannot handle a certain attribute, the
attribute is ignored.
@table @code
@item :family
Font family or fontset (a string). @xref{Fonts,,, emacs, The GNU
-Emacs Manual}. If you specify a font family name, the wild-card
-characters @samp{*} and @samp{?} are allowed. The function
-@code{font-family-list}, described below, returns a list of available
-family names. @xref{Fontsets}, for information about fontsets.
+Emacs Manual}, for more information about font families. The function
+@code{font-family-list} (see below) returns a list of available family
+names. @xref{Fontsets}, for information about fontsets.
@item :foundry
The name of the @dfn{font foundry} for the font family specified by
-the @code{:family} attribute (a string). The wild-card characters
-@samp{*} and @samp{?} are allowed. @xref{Fonts,,, emacs, The GNU
-Emacs Manual}.
+the @code{:family} attribute (a string). @xref{Fonts,,, emacs, The
+GNU Emacs Manual}.
@item :width
-Relative proportionate character width, also known as the character
-set width. This should be one of the symbols @code{ultra-condensed},
-@code{extra-condensed}, @code{condensed}, @code{semi-condensed},
-@code{normal}, @code{semi-expanded}, @code{expanded},
-@code{extra-expanded}, or @code{ultra-expanded}.
+Relative character width. This should be one of the symbols
+@code{ultra-condensed}, @code{extra-condensed}, @code{condensed},
+@code{semi-condensed}, @code{normal}, @code{semi-expanded},
+@code{expanded}, @code{extra-expanded}, or @code{ultra-expanded}.
@item :height
The height of the font. In the simplest case, this is an integer in
units of 1/10 point.
The value can also be a floating point number or a function, which
-specifies the height relative to an @dfn{underlying face} (i.e., a
-face that has a lower priority in the list described in
-@ref{Displaying Faces}). If the value is a floating point number,
+specifies the height relative to an @dfn{underlying face}
+(@pxref{Displaying Faces}). If the value is a floating point number,
that specifies the amount by which to scale the height of the
underlying face. If the value is a function, that function is called
with one argument, the height of the underlying face, and returns the
@@ -2058,16 +2006,17 @@ floating point and function values are not allowed.
Font weight---one of the symbols (from densest to faintest)
@code{ultra-bold}, @code{extra-bold}, @code{bold}, @code{semi-bold},
@code{normal}, @code{semi-light}, @code{light}, @code{extra-light}, or
-@code{ultra-light}. On text-only terminals that support
+@code{ultra-light}. On text terminals which support
variable-brightness text, any weight greater than normal is displayed
as extra bright, and any weight less than normal is displayed as
half-bright.
+@cindex italic text
@item :slant
Font slant---one of the symbols @code{italic}, @code{oblique},
@code{normal}, @code{reverse-italic}, or @code{reverse-oblique}. On
-text-only terminals that support variable-brightness text, slanted
-text is displayed as half-bright.
+text terminals that support variable-brightness text, slanted text is
+displayed as half-bright.
@item :foreground
Foreground color, a string. The value can be a system-defined color
@@ -2079,19 +2028,41 @@ stipple patterns.
Background color, a string. The value can be a system-defined color
name, or a hexadecimal color specification. @xref{Color Names}.
+@cindex underlined text
@item :underline
-Whether or not characters should be underlined, and in what color. If
-the value is @code{t}, underlining uses the foreground color of the
-face. If the value is a string, underlining uses that color. The
-value @code{nil} means do not underline.
+Whether or not characters should be underlined, and in what
+way. The possible values of the @code{:underline} attribute are:
+
+@table @asis
+@item @code{nil}
+Don't underline.
+@item @code{t}
+Underline with the foreground color of the face.
+
+@item @var{color}
+Underline in color @var{color}, a string specifying a color.
+
+@item @code{(:color @var{color} :style @var{style})}
+@var{color} is either a string, or the symbol @code{foreground-color},
+meaning the foreground color of the face. Omitting the attribute
+@code{:color} means to use the foreground color of the face.
+@var{style} should be a symbol @code{line} or @code{wave}, meaning to
+use a straight or wavy line. Omitting the attribute @code{:style}
+means to use a straight line.
+@end table
+
+@cindex overlined text
@item :overline
Whether or not characters should be overlined, and in what color.
-The value is used like that of @code{:underline}.
+If the value is @code{t}, overlining uses the foreground color of the
+face. If the value is a string, overlining uses that color. The
+value @code{nil} means do not overline.
+@cindex strike-through text
@item :strike-through
Whether or not characters should be strike-through, and in what
-color. The value is used like that of @code{:underline}.
+color. The value is used like that of @code{:overline}.
@item :box
Whether or not a box should be drawn around characters, its color, the
@@ -2174,16 +2145,6 @@ attributes from faces earlier in the list override those from later
faces.
@end table
-For compatibility with Emacs 20, you can also specify values for two
-``fake'' face attributes: @code{:bold} and @code{:italic}. Their
-values must be either @code{t} or @code{nil}; a value of
-@code{unspecified} is not allowed. Setting @code{:bold} to @code{t}
-is equivalent to setting the @code{:weight} attribute to @code{bold},
-and setting it to @code{nil} is equivalent to setting @code{:weight}
-to @code{normal}. Setting @code{:italic} to @code{t} is equivalent to
-setting the @code{:slant} attribute to @code{italic}, and setting it
-to @code{nil} is equivalent to setting @code{:slant} to @code{normal}.
-
@defun font-family-list &optional frame
This function returns a list of available font family names. The
optional argument @var{frame} specifies the frame on which the text is
@@ -2206,11 +2167,147 @@ suitable for use with @code{:stipple} (see above). It returns
@code{nil} otherwise.
@end defun
+@node Defining Faces
+@subsection Defining Faces
+
+ The usual way to define a face is through the @code{defface} macro.
+This macro defines a face name, and associates that name with a set of
+face attributes. It also sets up the face so that the user can
+customize it via the Customize interface (@pxref{Customization}).
+
+@defmac defface face spec doc [keyword value]@dots{}
+This macro declares @var{face} as a customizable face whose default
+attributes are given by @var{spec}. You should not quote the symbol
+@var{face}, and it should not end in @samp{-face} (that would be
+redundant). The argument @var{doc} is a documentation string for the
+face. The additional @var{keyword} arguments have the same meanings
+as in @code{defgroup} and @code{defcustom} (@pxref{Common Keywords}).
+
+When @code{defface} executes, it defines the face according to
+@var{spec}, then uses any customizations that were read from the
+init file (@pxref{Init File}) to override that specification.
+
+When you evaluate a @code{defface} form with @kbd{C-M-x} in Emacs
+Lisp mode (@code{eval-defun}), a special feature of @code{eval-defun}
+overrides any customizations of the face. This way, the face reflects
+exactly what the @code{defface} says.
+
+@cindex face specification
+The @var{spec} argument is a @dfn{face specification}, which states
+how the face should appear on different kinds of terminals. It should
+be an alist whose elements each have the form
+
+@example
+(@var{display} . @var{plist})
+@end example
+
+@noindent
+@var{display} specifies a class of terminals (see below). @var{plist}
+is a property list of face attributes and their values, specifying how
+the face appears on such terminals. For backward compatibility, you
+can also write an element as @code{(@var{display} @var{plist})}.
+
+The @var{display} part of an element of @var{spec} determines which
+terminals the element matches. If more than one element of @var{spec}
+matches a given terminal, the first element that matches is the one
+used for that terminal. There are three possibilities for
+@var{display}:
+
+@table @asis
+@item @code{default}
+This element of @var{spec} doesn't match any terminal; instead, it
+specifies defaults that apply to all terminals. This element, if
+used, must be the first element of @var{spec}. Each of the following
+elements can override any or all of these defaults.
+
+@item @code{t}
+This element of @var{spec} matches all terminals. Therefore, any
+subsequent elements of @var{spec} are never used. Normally @code{t}
+is used in the last (or only) element of @var{spec}.
+
+@item a list
+If @var{display} is a list, each element should have the form
+@code{(@var{characteristic} @var{value}@dots{})}. Here
+@var{characteristic} specifies a way of classifying terminals, and the
+@var{value}s are possible classifications which @var{display} should
+apply to. Here are the possible values of @var{characteristic}:
+
+@table @code
+@item type
+The kind of window system the terminal uses---either @code{graphic}
+(any graphics-capable display), @code{x}, @code{pc} (for the MS-DOS
+console), @code{w32} (for MS Windows 9X/NT/2K/XP), or @code{tty} (a
+non-graphics-capable display). @xref{Window Systems, window-system}.
+
+@item class
+What kinds of colors the terminal supports---either @code{color},
+@code{grayscale}, or @code{mono}.
+
+@item background
+The kind of background---either @code{light} or @code{dark}.
+
+@item min-colors
+An integer that represents the minimum number of colors the terminal
+should support. This matches a terminal if its
+@code{display-color-cells} value is at least the specified integer.
+
+@item supports
+Whether or not the terminal can display the face attributes given in
+@var{value}@dots{} (@pxref{Face Attributes}). @xref{Display Face
+Attribute Testing}, for more information on exactly how this testing
+is done.
+@end table
+
+If an element of @var{display} specifies more than one @var{value} for
+a given @var{characteristic}, any of those values is acceptable. If
+@var{display} has more than one element, each element should specify a
+different @var{characteristic}; then @emph{each} characteristic of the
+terminal must match one of the @var{value}s specified for it in
+@var{display}.
+@end table
+@end defmac
+
+ Here's how the standard face @code{highlight} is defined:
+
+@example
+(defface highlight
+ '((((class color) (min-colors 88) (background light))
+ :background "darkseagreen2")
+ (((class color) (min-colors 88) (background dark))
+ :background "darkolivegreen")
+ (((class color) (min-colors 16) (background light))
+ :background "darkseagreen2")
+ (((class color) (min-colors 16) (background dark))
+ :background "darkolivegreen")
+ (((class color) (min-colors 8))
+ :background "green" :foreground "black")
+ (t :inverse-video t))
+ "Basic face for highlighting."
+ :group 'basic-faces)
+@end example
+
+ Internally, Emacs stores the face's default specification in its
+@code{face-defface-spec} symbol property (@pxref{Property Lists}).
+The @code{saved-face} property stores the face specification saved by
+the user, using the customization buffer; the @code{customized-face}
+property stores the face specification customized for the current
+session, but not saved; and the @code{theme-face} property stores an
+alist associating the active customization settings and Custom themes
+with their specifications for that face. The face's documentation
+string is stored in the @code{face-documentation} property. But
+normally you should not try to set any of these properties directly.
+@xref{Applying Customizations}, for the @code{custom-set-faces}
+function, which is used to apply customized face settings.
+
+ People are sometimes tempted to create variables whose values
+specify a face to use. In the vast majority of cases, this is not
+necessary; it is preferable to simply use faces directly.
+
@node Attribute Functions
@subsection Face Attribute Functions
This section describes the functions for accessing and modifying the
-attributes of an existing face.
+attributes of an existing named face.
@defun set-face-attribute face frame &rest arguments
This function sets one or more attributes of @var{face} for
@@ -2218,20 +2315,18 @@ This function sets one or more attributes of @var{face} for
the @code{defface} says.
The extra arguments @var{arguments} specify the attributes to set, and
-the values for them. They should consist of alternating attribute names
-(such as @code{:family} or @code{:underline}) and corresponding values.
-Thus,
+the values for them. They should consist of alternating attribute
+names (such as @code{:family} or @code{:underline}) and values. Thus,
@example
(set-face-attribute 'foo nil
:width 'extended
- :weight 'bold
- :underline "red")
+ :weight 'bold)
@end example
@noindent
-sets the attributes @code{:width}, @code{:weight} and @code{:underline}
-to the corresponding values.
+sets the attribute @code{:width} to @code{extended} and the attribute
+@code{:weight} to @code{bold}.
If @var{frame} is @code{t}, this function sets the default attributes
for new frames. Default attribute values specified this way override
@@ -2308,117 +2403,111 @@ If @var{value1} is a relative value for the face attribute
face attribute @var{attribute}, returns @var{value1} unchanged.
@end defun
- The following functions provide compatibility with Emacs 20 and
-below. They work by calling @code{set-face-attribute}. Values of
-@code{t} and @code{nil} for their @var{frame} argument are handled
-just like @code{set-face-attribute} and @code{face-attribute}.
+ The following commands and functions mostly provide compatibility
+with old versions of Emacs. They work by calling
+@code{set-face-attribute}. Values of @code{t} and @code{nil} for
+their @var{frame} argument are handled just like
+@code{set-face-attribute} and @code{face-attribute}. The commands
+read their arguments using the minibuffer, if called interactively.
-@defun set-face-foreground face color &optional frame
-@defunx set-face-background face color &optional frame
-These functions set the @code{:foreground} attribute (or
-@code{:background} attribute, respectively) of @var{face} to
-@var{color}.
-@end defun
+@deffn Command set-face-foreground face color &optional frame
+@deffnx Command set-face-background face color &optional frame
+These set the @code{:foreground} attribute (or @code{:background}
+attribute, respectively) of @var{face} to @var{color}.
+@end deffn
-@defun set-face-stipple face pattern &optional frame
-This function sets the @code{:stipple} attribute of @var{face} to
+@deffn Command set-face-stipple face pattern &optional frame
+This sets the @code{:stipple} attribute of @var{face} to
@var{pattern}.
-@end defun
+@end deffn
-@defun set-face-font face font &optional frame
-This function sets the @code{:font} attribute of @var{face} to
-@var{font}.
-@end defun
+@deffn Command set-face-font face font &optional frame
+This sets the @code{:font} attribute of @var{face} to @var{font}.
+@end deffn
-@defun set-face-bold-p face bold-p &optional frame
-This function sets the @code{:weight} attribute of @var{face} to
-@var{normal} if @var{bold-p} is @code{nil}, and to @var{bold}
-otherwise.
+@defun set-face-bold face bold-p &optional frame
+This sets the @code{:weight} attribute of @var{face} to @var{normal}
+if @var{bold-p} is @code{nil}, and to @var{bold} otherwise.
@end defun
-@defun set-face-italic-p face italic-p &optional frame
-This function sets the @code{:slant} attribute of @var{face} to
-@var{normal} if @var{italic-p} is @code{nil}, and to @var{italic}
-otherwise.
+@defun set-face-italic face italic-p &optional frame
+This sets the @code{:slant} attribute of @var{face} to @var{normal} if
+@var{italic-p} is @code{nil}, and to @var{italic} otherwise.
@end defun
-@defun set-face-underline-p face underline &optional frame
-This function sets the @code{:underline} attribute of @var{face} to
+@defun set-face-underline face underline &optional frame
+This sets the @code{:underline} attribute of @var{face} to
@var{underline}.
@end defun
-@defun set-face-inverse-video-p face inverse-video-p &optional frame
-This function sets the @code{:inverse-video} attribute of @var{face}
-to @var{inverse-video-p}.
+@defun set-face-inverse-video face inverse-video-p &optional frame
+This sets the @code{:inverse-video} attribute of @var{face} to
+@var{inverse-video-p}.
@end defun
-@defun invert-face face &optional frame
-This function swaps the foreground and background colors of face
-@var{face}.
-@end defun
+@deffn Command invert-face face &optional frame
+This swaps the foreground and background colors of face @var{face}.
+@end deffn
The following functions examine the attributes of a face. If you
don't specify @var{frame}, they refer to the selected frame; @code{t}
refers to the default data for new frames. They return the symbol
@code{unspecified} if the face doesn't define any value for that
-attribute.
+attribute. If @var{inherit} is @code{nil}, only an attribute directly
+defined by the face is returned. If @var{inherit} is non-@code{nil},
+any faces specified by its @code{:inherit} attribute are considered as
+well, and if @var{inherit} is a face or a list of faces, then they are
+also considered, until a specified attribute is found. To ensure that
+the return value is always specified, use a value of @code{default} for
+@var{inherit}.
+
+@defun face-font face &optional frame
+This function returns the name of the font of face @var{face}.
+@end defun
@defun face-foreground face &optional frame inherit
@defunx face-background face &optional frame inherit
These functions return the foreground color (or background color,
respectively) of face @var{face}, as a string.
-
-If @var{inherit} is @code{nil}, only a color directly defined by the face is
-returned. If @var{inherit} is non-@code{nil}, any faces specified by its
-@code{:inherit} attribute are considered as well, and if @var{inherit}
-is a face or a list of faces, then they are also considered, until a
-specified color is found. To ensure that the return value is always
-specified, use a value of @code{default} for @var{inherit}.
@end defun
@defun face-stipple face &optional frame inherit
This function returns the name of the background stipple pattern of face
@var{face}, or @code{nil} if it doesn't have one.
-
-If @var{inherit} is @code{nil}, only a stipple directly defined by the
-face is returned. If @var{inherit} is non-@code{nil}, any faces
-specified by its @code{:inherit} attribute are considered as well, and
-if @var{inherit} is a face or a list of faces, then they are also
-considered, until a specified stipple is found. To ensure that the
-return value is always specified, use a value of @code{default} for
-@var{inherit}.
-@end defun
-
-@defun face-font face &optional frame
-This function returns the name of the font of face @var{face}.
@end defun
-@defun face-bold-p face &optional frame
+@defun face-bold-p face &optional frame inherit
This function returns a non-@code{nil} value if the @code{:weight}
attribute of @var{face} is bolder than normal (i.e., one of
@code{semi-bold}, @code{bold}, @code{extra-bold}, or
@code{ultra-bold}). Otherwise, it returns @code{nil}.
@end defun
-@defun face-italic-p face &optional frame
+@defun face-italic-p face &optional frame inherit
This function returns a non-@code{nil} value if the @code{:slant}
attribute of @var{face} is @code{italic} or @code{oblique}, and
@code{nil} otherwise.
@end defun
-@defun face-underline-p face &optional frame
-This function returns the @code{:underline} attribute of face @var{face}.
+@defun face-underline-p face &optional frame inherit
+This function returns non-@code{nil} if face @var{face} specifies
+a non-@code{nil} @code{:underline} attribute.
@end defun
-@defun face-inverse-video-p face &optional frame
-This function returns the @code{:inverse-video} attribute of face @var{face}.
+@defun face-inverse-video-p face &optional frame inherit
+This function returns non-@code{nil} if face @var{face} specifies
+a non-@code{nil} @code{:inverse-video} attribute.
@end defun
@node Displaying Faces
@subsection Displaying Faces
- Here is how Emacs determines the face to use for displaying any
-given piece of text:
+ When Emacs displays a given piece of text, the visual appearance of
+the text may be determined by faces drawn from different sources. If
+these various sources together specify more than one face for a
+particular character, Emacs merges the attributes of the various
+faces. Here is the order in which Emacs merges the faces, from
+highest to lowest priority:
@itemize @bullet
@item
@@ -2432,11 +2521,11 @@ Manual}.
@item
If the text lies within an overlay with a non-@code{nil} @code{face}
-property, Emacs applies the face or face attributes specified by that
-property. If the overlay has a @code{mouse-face} property and the
-mouse is ``near enough'' to the overlay, Emacs applies the face or
-face attributes specified by the @code{mouse-face} property instead.
-@xref{Overlay Properties}.
+property, Emacs applies the face(s) specified by that property. If
+the overlay has a @code{mouse-face} property and the mouse is ``near
+enough'' to the overlay, Emacs applies the face or face attributes
+specified by the @code{mouse-face} property instead. @xref{Overlay
+Properties}.
When multiple overlays cover one character, an overlay with higher
priority overrides those with lower priority. @xref{Overlays}.
@@ -2458,138 +2547,121 @@ If any given attribute has not been specified during the preceding
steps, Emacs applies the attribute of the @code{default} face.
@end itemize
- If these various sources together specify more than one face for a
-particular character, Emacs merges the attributes of the various faces
-specified. For each attribute, Emacs tries using the above order
-(i.e., first the face of any special glyph; then the face for region
-highlighting, if appropriate; then faces specified by overlays, then
-faces specified by text properties, then the @code{mode-line} or
-@code{mode-line-inactive} or @code{header-line} face, if appropriate,
-and finally the @code{default} face).
+ At each stage, if a face has a valid @code{:inherit} attribute,
+Emacs treats any attribute with an @code{unspecified} value as having
+the corresponding value drawn from the parent face(s). @pxref{Face
+Attributes}. Note that the parent face(s) may also leave the
+attribute unspecified; in that case, the attribute remains unspecified
+at the next level of face merging.
@node Face Remapping
@subsection Face Remapping
The variable @code{face-remapping-alist} is used for buffer-local or
-global changes in the appearance of a face. For instance, it can be
-used to make the @code{default} face a variable-pitch face within a
-particular buffer.
+global changes in the appearance of a face. For instance, it is used
+to implement the @code{text-scale-adjust} command (@pxref{Text
+Scale,,, emacs, The GNU Emacs Manual}).
@defvar face-remapping-alist
-An alist whose elements have the form @code{(@var{face}
-@var{remapping...})}. This causes Emacs to display text using the
-face @var{face} using @var{remapping...} instead of @var{face}'s
-ordinary definition. @var{remapping...} may be any face specification
-suitable for a @code{face} text property: either a face name, or a
-property list of attribute/value pairs. @xref{Special Properties}.
+The value of this variable is an alist whose elements have the form
+@code{(@var{face} . @var{remapping})}. This causes Emacs to display
+any text having the face @var{face} with @var{remapping}, rather than
+the ordinary definition of @var{face}.
+
+@var{remapping} may be any face specification suitable for a
+@code{face} text property: either a face (i.e.@: a face name or a
+property list of attribute/value pairs), or a list of faces. For
+details, see the description of the @code{face} text property in
+@ref{Special Properties}. @var{remapping} serves as the complete
+specification for the remapped face---it replaces the normal
+definition of @var{face}, instead of modifying it.
If @code{face-remapping-alist} is buffer-local, its local value takes
effect only within that buffer.
-Two points bear emphasizing:
+Note: face remapping is non-recursive. If @var{remapping} references
+the same face name @var{face}, either directly or via the
+@code{:inherit} attribute of some other face in @var{remapping}, that
+reference uses the normal definition of @var{face}. For instance, if
+the @code{mode-line} face is remapped using this entry in
+@code{face-remapping-alist}:
-@enumerate
-@item
-The new definition @var{remapping...} is the complete
-specification of how to display @var{face}---it entirely replaces,
-rather than augmenting or modifying, the normal definition of that
-face.
-
-@item
-If @var{remapping...} recursively references the same face name
-@var{face}, either directly remapping entry, or via the
-@code{:inherit} attribute of some other face in @var{remapping...},
-then that reference uses the normal definition of @var{face} in the
-selected frame, instead of the ``remapped'' definition.
-
-For instance, if the @code{mode-line} face is remapped using this
-entry in @code{face-remapping-alist}:
@example
(mode-line italic mode-line)
@end example
+
@noindent
then the new definition of the @code{mode-line} face inherits from the
@code{italic} face, and the @emph{normal} (non-remapped) definition of
@code{mode-line} face.
-@end enumerate
@end defvar
- A typical use of the @code{face-remapping-alist} is to change a
-buffer's @code{default} face; for example, the following changes a
-buffer's @code{default} face to use the @code{variable-pitch} face,
-with the height doubled:
-
-@example
-(set (make-local-variable 'face-remapping-alist)
- '((default variable-pitch :height 2.0)))
-@end example
-
The following functions implement a higher-level interface to
-@code{face-remapping-alist}, making it easier to use
-``cooperatively''. They are mainly intended for buffer-local use, and
-so all make @code{face-remapping-alist} variable buffer-local as a
-side-effect. They use entries in @code{face-remapping-alist} which
-have the general form:
+@code{face-remapping-alist}. Most Lisp code should use these
+functions instead of setting @code{face-remapping-alist} directly, to
+avoid trampling on remappings applied elsewhere. These functions are
+intended for buffer-local remappings, so they all make
+@code{face-remapping-alist} buffer-local as a side-effect. They manage
+@code{face-remapping-alist} entries of the form
@example
- (@var{face} @var{relative_specs_1} @var{relative_specs_2} @var{...} @var{base_specs})
+ (@var{face} @var{relative-spec-1} @var{relative-spec-2} @var{...} @var{base-spec})
@end example
-Everything except @var{face} is a ``face spec'': a list of face names
-or face attribute-value pairs. All face specs are merged together,
-with earlier values taking precedence.
-
-The @var{relative_specs_}n values are ``relative specs'', and are
-added by @code{face-remap-add-relative} (and removed by
-@code{face-remap-remove-relative}. These are intended for face
-modifications (such as increasing the size). Typical users of these
-relative specs would be minor modes.
-
-@var{base_specs} is the lowest-priority value, and by default is just the
-face name, which causes the global definition of that face to be used.
-
-A non-default value of @var{base_specs} may also be set using
-@code{face-remap-set-base}. Because this @emph{overwrites} the
-default base-spec value (which inherits the global face definition),
-it is up to the caller of @code{face-remap-set-base} to add such
-inheritance if it is desired. A typical use of
-@code{face-remap-set-base} would be a major mode adding a face
-remappings, e.g., of the default face.
-
+@noindent
+where, as explained above, each of the @var{relative-spec-N} and
+@var{base-spec} is either a face name, or a property list of
+attribute/value pairs. Each of the @dfn{relative remapping} entries,
+@var{relative-spec-N}, is managed by the
+@code{face-remap-add-relative} and @code{face-remap-remove-relative}
+functions; these are intended for simple modifications like changing
+the text size. The @dfn{base remapping} entry, @var{base-spec}, has
+the lowest priority and is managed by the @code{face-remap-set-base}
+and @code{face-remap-reset-base} functions; it is intended for major
+modes to remap faces in the buffers they control.
@defun face-remap-add-relative face &rest specs
-This functions adds a face remapping entry of @var{face} to @var{specs}
-in the current buffer.
+This functions adds the face specifications in @var{specs} as relative
+remappings for face @var{face} in the current buffer. The remaining
+arguments, @var{specs}, should form either a list of face names, or a
+property list of attribute/value pairs.
-It returns a ``cookie'' which can be used to later delete the remapping with
-@code{face-remap-remove-relative}.
+The return value is a Lisp object that serves as a ``cookie''; you can
+pass this object as an argument to @code{face-remap-remove-relative}
+if you need to remove the remapping later.
-@var{specs} can be any value suitable for the @code{face} text
-property, including a face name, a list of face names, or a
-face-attribute property list. The attributes given by @var{specs}
-will be merged with any other currently active face remappings of
-@var{face}, and with the global definition of @var{face} (by default;
-this may be changed using @code{face-remap-set-base}), with the most
-recently added relative remapping taking precedence.
+@example
+;; Remap the `escape-glyph' face into a combination
+;; of the `highlight' and `italic' faces:
+(face-remap-add-relative 'escape-glyph 'highlight 'italic)
+
+;; Increase the size of the `default' face by 50%:
+(face-remap-add-relative 'default :height 1.5)
+@end example
@end defun
@defun face-remap-remove-relative cookie
-This function removes a face remapping previously added by
-@code{face-remap-add-relative}. @var{cookie} should be a return value
-from that function.
+This function removes a relative remapping previously added by
+@code{face-remap-add-relative}. @var{cookie} should be the Lisp
+object returned by @code{face-remap-add-relative} when the remapping
+was added.
@end defun
@defun face-remap-set-base face &rest specs
-This function sets the ``base remapping'' of @var{face} in the current
+This function sets the base remapping of @var{face} in the current
buffer to @var{specs}. If @var{specs} is empty, the default base
-remapping is restored, which inherits from the global definition of
-@var{face}; note that this is different from @var{specs} containing a
+remapping is restored, similar to calling @code{face-remap-reset-base}
+(see below); note that this is different from @var{specs} containing a
single value @code{nil}, which has the opposite result (the global
definition of @var{face} is ignored).
+
+This overwrites the default @var{base-spec}, which inherits the global
+face definition, so it is up to the caller to add such inheritance if
+so desired.
@end defun
@defun face-remap-reset-base face
-This function sets the ``base remapping'' of @var{face} to its default
+This function sets the base remapping of @var{face} to its default
value, which inherits from @var{face}'s global definition.
@end defun
@@ -2598,29 +2670,8 @@ value, which inherits from @var{face}'s global definition.
Here are additional functions for creating and working with faces.
-@defun make-face name
-This function defines a new face named @var{name}, initially with all
-attributes @code{nil}. It does nothing if there is already a face named
-@var{name}.
-@end defun
-
@defun face-list
-This function returns a list of all defined faces.
-@end defun
-
-@defun copy-face old-face new-name &optional frame new-frame
-This function defines a face named @var{new-name} as a copy of the existing
-face named @var{old-face}. It creates the face @var{new-name} if that
-doesn't already exist.
-
-If the optional argument @var{frame} is given, this function applies
-only to that frame. Otherwise it applies to each frame individually,
-copying attributes from @var{old-face} in each frame to @var{new-face}
-in the same frame.
-
-If the optional argument @var{new-frame} is given, then @code{copy-face}
-copies the attributes of @var{old-face} in @var{frame} to @var{new-name}
-in @var{new-frame}.
+This function returns a list of all defined face names.
@end defun
@defun face-id face
@@ -2654,11 +2705,13 @@ makes @code{modeline} an alias for the @code{mode-line} face.
(put 'modeline 'face-alias 'mode-line)
@end example
-@defun define-obsolete-face-alias obsolete-face current-face &optional when
-This function defines a face alias and marks it as obsolete, indicating
-that it may be removed in future. The optional string @var{when}
-indicates when the face was made obsolete (for example, a release number).
-@end defun
+@defmac define-obsolete-face-alias obsolete-face current-face when
+This macro defines @code{obsolete-face} as an alias for
+@var{current-face}, and also marks it as obsolete, indicating that it
+may be removed in future. @var{when} should be a string indicating
+when @code{obsolete-face} was made obsolete (usually a version number
+string).
+@end defmac
@node Auto Faces
@subsection Automatic Face Assignment
@@ -2748,13 +2801,13 @@ For text matching a search command.
@itemx warning
@itemx success
For text concerning errors, warnings, or successes. For example,
-these are used for messages in @samp{*Compilation*} buffers.
+these are used for messages in @file{*Compilation*} buffers.
@end table
@node Font Selection
@subsection Font Selection
- Before Emacs can draw a character on a particular display, it must
+ Before Emacs can draw a character on a graphical display, it must
select a @dfn{font} for that character@footnote{In this context, the
term @dfn{font} has nothing to do with Font Lock (@pxref{Font Lock
Mode}).}. @xref{Fonts,,, emacs, The GNU Emacs Manual}. Normally,
@@ -2915,14 +2968,6 @@ The last three elements give additional information about the font.
encoding of the font.
@end defun
-@defvar font-list-limit
-This variable specifies maximum number of fonts to consider in font
-matching. The function @code{x-family-fonts} will not return more than
-that many fonts, and font selection will consider only that many fonts
-when searching a matching font for face attributes. The default is
-currently 100.
-@end defvar
-
@node Fontsets
@subsection Fontsets
@@ -3247,9 +3292,9 @@ consecutive wildcards in the XLFD are folded into one.
@section Fringes
@cindex fringes
- The @dfn{fringes} of a window are thin vertical strips down the
-sides that are used for displaying bitmaps that indicate truncation,
-continuation, horizontal scrolling, and the overlay arrow.
+ On graphical displays, Emacs draws @dfn{fringes} next to each
+window: thin vertical strips down the sides which can display bitmaps
+indicating truncation, continuation, horizontal scrolling, and so on.
@menu
* Fringe Size/Pos:: Specifying where to put the window fringes.
@@ -3264,7 +3309,7 @@ continuation, horizontal scrolling, and the overlay arrow.
@subsection Fringe Size and Position
The following buffer-local variables control the position and width
-of the window fringes.
+of fringes in windows showing that buffer.
@defvar fringes-outside-margins
The fringes normally appear between the display margins and the window
@@ -3284,12 +3329,17 @@ fringe in pixels. A value of @code{nil} means to use the right fringe
width from the window's frame.
@end defvar
- The values of these variables take effect when you display the
-buffer in a window. If you change them while the buffer is visible,
-you can call @code{set-window-buffer} to display it once again in the
-same window, to make the changes take effect. A buffer that does not
-specify values for these variables will use the default values
-specified for the frame; see @ref{Layout Parameters}.
+ Any buffer which does not specify values for these variables uses
+the values specified by the @code{left-fringe} and @code{right-fringe}
+frame parameters (@pxref{Layout Parameters}).
+
+ The above variables actually take effect via the function
+@code{set-window-buffer} (@pxref{Buffers and Windows}), which calls
+@code{set-window-fringes} as a subroutine. If you change one of these
+variables, the fringe display is not updated in existing windows
+showing the buffer, unless you call @code{set-window-buffer} again in
+each affected window. You can also use @code{set-window-fringes} to
+control the fringe display in individual windows.
@defun set-window-fringes window left &optional right outside-margins
This function sets the fringe widths of window @var{window}.
@@ -3315,9 +3365,9 @@ window is used. The value has the form @code{(@var{left-width}
@cindex fringe indicators
@cindex indicators, fringe
- The @dfn{fringe indicators} are tiny icons Emacs displays in the
-window fringe (on a graphic display) to indicate truncated or
-continued lines, buffer boundaries, overlay arrow, etc.
+ @dfn{Fringe indicators} are tiny icons displayed in the window
+fringe to indicate truncated or continued lines, buffer boundaries,
+etc.
@defopt indicate-empty-lines
@cindex fringes, and empty line indication
@@ -3367,67 +3417,55 @@ fringe, and no arrow bitmaps, use @code{((top . left) (bottom . left))}.
@defvar fringe-indicator-alist
This buffer-local variable specifies the mapping from logical fringe
-indicators to the actual bitmaps displayed in the window fringes.
+indicators to the actual bitmaps displayed in the window fringes. The
+value is an alist of elements @code{(@var{indicator}
+. @var{bitmaps})}, where @var{indicator} specifies a logical indicator
+type and @var{bitmaps} specifies the fringe bitmaps to use for that
+indicator.
-These symbols identify the logical fringe indicators:
+ Each @var{indicator} should be one of the following symbols:
@table @asis
-@item Truncation and continuation line indicators:
-@code{truncation}, @code{continuation}.
-
-@item Buffer position indicators:
-@code{up}, @code{down},
-@code{top}, @code{bottom},
-@code{top-bottom}.
-
-@item Empty line indicator:
-@code{empty-line}.
-
-@item Overlay arrow indicator:
-@code{overlay-arrow}.
-
-@item Unknown bitmap indicator:
-@code{unknown}.
+@item @code{truncation}, @code{continuation}.
+Used for truncation and continuation lines.
+
+@item @code{up}, @code{down}, @code{top}, @code{bottom}, @code{top-bottom}
+Used when @code{indicate-buffer-boundaries} is non-@code{nil}:
+@code{up} and @code{down} indicate a buffer boundary lying above or
+below the window edge; @code{top} and @code{bottom} indicate the
+topmost and bottommost buffer text line; and @code{top-bottom}
+indicates where there is just one line of text in the buffer.
+
+@item @code{empty-line}
+Used to indicate empty lines when @code{indicate-empty-lines} is
+non-@code{nil}.
+
+@item @code{overlay-arrow}
+Used for overlay arrows (@pxref{Overlay Arrow}).
+@c Is this used anywhere?
+@c @item Unknown bitmap indicator:
+@c @code{unknown}.
@end table
- The value is an alist where each element @code{(@var{indicator} . @var{bitmaps})}
-specifies the fringe bitmaps used to display a specific logical
-fringe indicator.
-
-Here, @var{indicator} specifies the logical indicator type, and
-@var{bitmaps} is list of symbols @code{(@var{left} @var{right}
-[@var{left1} @var{right1}])} which specifies the actual bitmap shown
-in the left or right fringe for the logical indicator.
-
-The @var{left} and @var{right} symbols specify the bitmaps shown in
-the left and/or right fringe for the specific indicator. The
-@var{left1} or @var{right1} bitmaps are used only for the `bottom' and
-`top-bottom indicators when the last (only) line in has no final
-newline. Alternatively, @var{bitmaps} may be a single symbol which is
-used in both left and right fringes.
-
-When @code{fringe-indicator-alist} has a buffer-local value, and there
-is no bitmap defined for a logical indicator, or the bitmap is
+ Each @var{bitmaps} value may be a list of symbols @code{(@var{left}
+@var{right} [@var{left1} @var{right1}])}. The @var{left} and
+@var{right} symbols specify the bitmaps shown in the left and/or right
+fringe, for the specific indicator. @var{left1} and @var{right1} are
+specific to the @code{bottom} and @code{top-bottom} indicators, and
+are used to indicate that the last text line has no final newline.
+Alternatively, @var{bitmaps} may be a single symbol which is used in
+both left and right fringes.
+
+ @xref{Fringe Bitmaps}, for a list of standard bitmap symbols and how
+to define your own. In addition, @code{nil} represents the empty
+bitmap (i.e.@: an indicator that is not shown).
+
+ When @code{fringe-indicator-alist} has a buffer-local value, and
+there is no bitmap defined for a logical indicator, or the bitmap is
@code{t}, the corresponding value from the default value of
@code{fringe-indicator-alist} is used.
-
-To completely hide a specific indicator, set the bitmap to @code{nil}.
@end defvar
-Standard fringe bitmaps for indicators:
-@example
-left-arrow right-arrow up-arrow down-arrow
-left-curly-arrow right-curly-arrow
-left-triangle right-triangle
-top-left-angle top-right-angle
-bottom-left-angle bottom-right-angle
-left-bracket right-bracket
-filled-rectangle hollow-rectangle
-filled-square hollow-square
-vertical-bar horizontal-bar
-empty-line question-mark
-@end example
-
@node Fringe Cursors
@subsection Fringe Cursors
@cindex fringe cursors
@@ -3438,16 +3476,6 @@ cursor in the right fringe instead of using two lines. Different
bitmaps are used to represent the cursor in the fringe depending on
the current buffer's cursor type.
-@table @asis
-@item Logical cursor types:
-@code{box} , @code{hollow}, @code{bar},
-@code{hbar}, @code{hollow-small}.
-@end table
-
-The @code{hollow-small} type is used instead of @code{hollow} when the
-normal @code{hollow-rectangle} bitmap is too tall to fit on a specific
-display line.
-
@defopt overflow-newline-into-fringe
If this is non-@code{nil}, lines exactly as wide as the window (not
counting the final newline character) are not continued. Instead,
@@ -3458,24 +3486,31 @@ fringe.
@defvar fringe-cursor-alist
This variable specifies the mapping from logical cursor type to the
actual fringe bitmaps displayed in the right fringe. The value is an
-alist where each element @code{(@var{cursor} . @var{bitmap})} specifies
-the fringe bitmaps used to display a specific logical cursor type in
-the fringe. Here, @var{cursor} specifies the logical cursor type and
-@var{bitmap} is a symbol specifying the fringe bitmap to be displayed
-for that logical cursor type.
+alist where each element has the form @code{(@var{cursor-type}
+. @var{bitmap})}, which means to use the fringe bitmap @var{bitmap} to
+display cursors of type @var{cursor-type}.
+
+Each @var{cursor-type} should be one of @code{box}, @code{hollow},
+@code{bar}, @code{hbar}, or @code{hollow-small}. The first four have
+the same meanings as in the @code{cursor-type} frame parameter
+(@pxref{Cursor Parameters}). The @code{hollow-small} type is used
+instead of @code{hollow} when the normal @code{hollow-rectangle}
+bitmap is too tall to fit on a specific display line.
+
+Each @var{bitmap} should be a symbol specifying the fringe bitmap to
+be displayed for that logical cursor type.
+@iftex
+See the next subsection for details.
+@end iftex
+@ifnottex
+@xref{Fringe Bitmaps}.
+@end ifnottex
When @code{fringe-cursor-alist} has a buffer-local value, and there is
no bitmap defined for a cursor type, the corresponding value from the
default value of @code{fringes-indicator-alist} is used.
@end defvar
-Standard bitmaps for displaying the cursor in right fringe:
-@example
-filled-rectangle hollow-rectangle filled-square hollow-square
-vertical-bar horizontal-bar
-@end example
-
-
@node Fringe Bitmaps
@subsection Fringe Bitmaps
@cindex fringe bitmaps
@@ -3483,22 +3518,68 @@ vertical-bar horizontal-bar
The @dfn{fringe bitmaps} are the actual bitmaps which represent the
logical fringe indicators for truncated or continued lines, buffer
-boundaries, overlay arrow, etc. Fringe bitmap symbols have their own
-name space. The fringe bitmaps are shared by all frames and windows.
-You can redefine the built-in fringe bitmaps, and you can define new
-fringe bitmaps.
-
- The way to display a bitmap in the left or right fringes for a given
-line in a window is by specifying the @code{display} property for one
-of the characters that appears in it. Use a display specification of
-the form @code{(left-fringe @var{bitmap} [@var{face}])} or
-@code{(right-fringe @var{bitmap} [@var{face}])} (@pxref{Display
-Property}). Here, @var{bitmap} is a symbol identifying the bitmap you
-want, and @var{face} (which is optional) is the name of the face whose
-colors should be used for displaying the bitmap, instead of the
-default @code{fringe} face. @var{face} is automatically merged with
-the @code{fringe} face, so normally @var{face} need only specify the
-foreground color for the bitmap.
+boundaries, overlay arrows, etc. Each bitmap is represented by a
+symbol.
+@iftex
+These symbols are referred to by the variables
+@code{fringe-indicator-alist} and @code{fringe-cursor-alist},
+described in the previous subsections.
+@end iftex
+@ifnottex
+These symbols are referred to by the variable
+@code{fringe-indicator-alist}, which maps fringe indicators to bitmaps
+(@pxref{Fringe Indicators}), and the variable
+@code{fringe-cursor-alist}, which maps fringe cursors to bitmaps
+(@pxref{Fringe Cursors}).
+@end ifnottex
+
+ Lisp programs can also directly display a bitmap in the left or
+right fringe, by using a @code{display} property for one of the
+characters appearing in the line (@pxref{Other Display Specs}). Such
+a display specification has the form
+
+@example
+(@var{fringe} @var{bitmap} [@var{face}])
+@end example
+
+@noindent
+@var{fringe} is either the symbol @code{left-fringe} or
+@code{right-fringe}. @var{bitmap} is a symbol identifying the bitmap
+to display. The optional @var{face} names a face whose foreground
+color is used to display the bitmap; this face is automatically merged
+with the @code{fringe} face.
+
+ Here is a list of the standard fringe bitmaps defined in Emacs, and
+how they are currently used in Emacs (via
+@code{fringe-indicator-alist} and @code{fringe-cursor-alist}):
+
+@table @asis
+@item @code{left-arrow}, @code{right-arrow}
+Used to indicate truncated lines.
+
+@item @code{left-curly-arrow}, @code{right-curly-arrow}
+Used to indicate continued lines.
+
+@item @code{right-triangle}, @code{left-triangle}
+The former is used by overlay arrows. The latter is unused.
+
+@item @code{up-arrow}, @code{down-arrow}, @code{top-left-angle} @code{top-right-angle}
+@itemx @code{bottom-left-angle}, @code{bottom-right-angle}
+@itemx @code{top-right-angle}, @code{top-left-angle}
+@itemx @code{left-bracket}, @code{right-bracket}, @code{top-right-angle}, @code{top-left-angle}
+Used to indicate buffer boundaries.
+
+@item @code{filled-rectangle}, @code{hollow-rectangle}
+@itemx @code{filled-square}, @code{hollow-square}
+@itemx @code{vertical-bar}, @code{horizontal-bar}
+Used for different types of fringe cursors.
+
+@item @code{empty-line}, @code{exclamation-mark}, @code{question-mark}, @code{exclamation-mark}
+Not used by core Emacs features.
+@end table
+
+@noindent
+The next subsection describes how to define your own fringe bitmaps.
@defun fringe-bitmaps-at-pos &optional pos window
This function returns the fringe bitmaps of the display line
@@ -3612,9 +3693,9 @@ this list.
Each variable on this list can have properties
@code{overlay-arrow-string} and @code{overlay-arrow-bitmap} that
-specify an overlay arrow string (for text-only terminals) or fringe
-bitmap (for graphical terminals) to display at the corresponding
-overlay arrow position. If either property is not set, the default
+specify an overlay arrow string (for text terminals) or fringe bitmap
+(for graphical terminals) to display at the corresponding overlay
+arrow position. If either property is not set, the default
@code{overlay-arrow-string} or @code{overlay-arrow} fringe indicator
is used.
@@ -3714,7 +3795,7 @@ to use the value specified by the frame.
@kindex display @r{(text property)}
The @code{display} text property (or overlay property) is used to
-insert images into text, and also control other aspects of how text
+insert images into text, and to control other aspects of how text
displays. The value of the @code{display} property should be a
display specification, or a list or vector containing several display
specifications. Display specifications in the same @code{display}
@@ -3740,8 +3821,8 @@ display specifications and what they mean.
@node Replacing Specs
@subsection Display Specs That Replace The Text
- Some kinds of @code{display} specifications specify something to
-display instead of the text that has the property. These are called
+ Some kinds of display specifications specify something to display
+instead of the text that has the property. These are called
@dfn{replacing} display specifications. Emacs does not allow the user
to interactively move point into the middle of buffer text that is
replaced in this way.
@@ -3754,47 +3835,34 @@ irrelevant, since those don't apply to the replacement.
For replacing display specifications, ``the text that has the
property'' means all the consecutive characters that have the same
Lisp object as their @code{display} property; these characters are
-replaced as a single unit. By contrast, characters that have similar
-but distinct Lisp objects as their @code{display} properties are
-handled separately. Here's a function that illustrates this point:
+replaced as a single unit. If two characters have different Lisp
+objects as their @code{display} properties (i.e.@: objects which are
+not @code{eq}), they are handled separately.
-@smallexample
-(defun foo ()
- (goto-char (point-min))
- (dotimes (i 5)
- (let ((string (concat "A")))
- (put-text-property (point) (1+ (point)) 'display string)
- (forward-char 1)
- (put-text-property (point) (1+ (point)) 'display string)
- (forward-char 1))))
-@end smallexample
-
-@noindent
-It gives each of the first ten characters in the buffer string
-@code{"A"} as the @code{display} property, but they don't all get the
-same string. The first two characters get the same string, so they
-together are replaced with one @samp{A}. The next two characters get
-a second string, so they together are replaced with one @samp{A}.
-Likewise for each following pair of characters. Thus, the ten
-characters appear as five A's. This function would have the same
-results:
+ Here is an example which illustrates this point. A string serves as
+a replacing display specification, which replaces the text that has
+the property with the specified string (@pxref{Other Display Specs}).
+Consider the following function:
@smallexample
(defun foo ()
- (goto-char (point-min))
(dotimes (i 5)
- (let ((string (concat "A")))
- (put-text-property (point) (+ 2 (point)) 'display string)
- (put-text-property (point) (1+ (point)) 'display string)
- (forward-char 2))))
+ (let ((string (concat "A"))
+ (start (+ i i (point-min))))
+ (put-text-property start (1+ start) 'display string)
+ (put-text-property start (+ 2 start) 'display string))))
@end smallexample
@noindent
-This illustrates that what matters is the property value for
-each character. If two consecutive characters have the same
-object as the @code{display} property value, it's irrelevant
-whether they got this property from a single call to
-@code{put-text-property} or from two different calls.
+This function gives each of the first ten characters in the buffer a
+@code{display} property which is a string @code{"A"}, but they don't
+all get the same string object. The first two characters get the same
+string object, so they are replaced with one @samp{A}; the fact that
+the display property was assigned in two separate calls to
+@code{put-text-property} is irrelevant. Similarly, the next two
+characters get a second string (@code{concat} creates a new string
+object), so they are replaced with one @samp{A}; and so on. Thus, the
+ten characters appear as five A's.
@node Specified Space
@subsection Specified Spaces
@@ -4130,6 +4198,7 @@ displayed (@pxref{Display Feature Testing}).
* Other Image Types:: Various other formats are supported.
* Defining Images:: Convenient ways to define an image for later use.
* Showing Images:: Convenient ways to display an image once it is defined.
+* Animated Images:: Some image formats can be animated.
* Image Cache:: Internal mechanisms of image display.
@end menu
@@ -4138,97 +4207,103 @@ displayed (@pxref{Display Feature Testing}).
@cindex image formats
@cindex image types
- Emacs can display a number of different image formats; some of them
-are supported only if particular support libraries are installed on
-your machine. In some environments, Emacs can load support libraries
-on demand; if so, the variable @code{dynamic-library-alist}
-(@pxref{Dynamic Libraries}) can be used to modify the set of known
-names for these dynamic libraries (though it is not possible to add
-new image formats). Note that image types @code{pbm} and @code{xbm}
-do not depend on external libraries and are always available in Emacs.
-
- The supported image formats include XBM, XPM (this requires the
-libraries @code{libXpm} version 3.4k and @code{libz}), GIF (requiring
-@code{libungif} 4.1.0), PostScript, PBM, JPEG (requiring the
-@code{libjpeg} library version v6a), TIFF (requiring @code{libtiff}
-v3.4), PNG (requiring @code{libpng} 1.0.2), and SVG (requiring
-@code{librsvg} 2.0.0).
-
- You specify one of these formats with an image type symbol. The image
-type symbols are @code{xbm}, @code{xpm}, @code{gif}, @code{postscript},
-@code{pbm}, @code{jpeg}, @code{tiff}, @code{png}, and @code{svg}.
+ Emacs can display a number of different image formats. Some of
+these image formats are supported only if particular support libraries
+are installed. On some platforms, Emacs can load support libraries on
+demand; if so, the variable @code{dynamic-library-alist} can be used
+to modify the set of known names for these dynamic libraries.
+@xref{Dynamic Libraries}.
+
+ Supported image formats (and the required support libraries) include
+PBM and XBM (which do not depend on support libraries and are always
+available), XPM (@code{libXpm}), GIF (@code{libgif} or
+@code{libungif}), PostScript (@code{gs}), JPEG (@code{libjpeg}), TIFF
+(@code{libtiff}), PNG (@code{libpng}), and SVG (@code{librsvg}).
+
+ Each of these image formats is associated with an @dfn{image type
+symbol}. The symbols for the above formats are, respectively,
+@code{pbm}, @code{xbm}, @code{xpm}, @code{gif}, @code{postscript},
+@code{jpeg}, @code{tiff}, @code{png}, and @code{svg}.
+
+ Furthermore, if you build Emacs with ImageMagick
+(@code{libMagickWand}) support, Emacs can display any image format
+that ImageMagick can. @xref{ImageMagick Images}. All images
+displayed via ImageMagick have type symbol @code{imagemagick}.
@defvar image-types
-This variable contains a list of those image type symbols that are
-potentially supported in the current configuration.
-@emph{Potentially} here means that Emacs knows about the image types,
-not necessarily that they can be loaded (they could depend on
-unavailable dynamic libraries, for example).
-
-To know which image types are really available, use
-@code{image-type-available-p}.
+This variable contains a list of type symbols for image formats which
+are potentially supported in the current configuration.
+
+``Potentially'' means that Emacs knows about the image types, not
+necessarily that they can be used (for example, they could depend on
+unavailable dynamic libraries). To know which image types are really
+available, use @code{image-type-available-p}.
@end defvar
@defun image-type-available-p type
-This function returns non-@code{nil} if image type @var{type} is
-available, i.e., if images of this type can be loaded and displayed in
-Emacs. @var{type} should be one of the types contained in
-@code{image-types}.
+This function returns non-@code{nil} if images of type @var{type} can
+be loaded and displayed. @var{type} must be an image type symbol.
For image types whose support libraries are statically linked, this
-function always returns @code{t}; for other image types, it returns
-@code{t} if the dynamic library could be loaded, @code{nil} otherwise.
+function always returns @code{t}. For image types whose support
+libraries are dynamically loaded, it returns @code{t} if the library
+could be loaded and @code{nil} otherwise.
@end defun
@node Image Descriptors
@subsection Image Descriptors
@cindex image descriptor
- An image description is a list of the form @code{(image . @var{props})},
-where @var{props} is a property list containing alternating keyword
-symbols (symbols whose names start with a colon) and their values.
-You can use any Lisp object as a property, but the only properties
-that have any special meaning are certain symbols, all of them keywords.
+ An @dfn{image descriptor} is a list which specifies the underlying
+data for an image, and how to display it. It is typically used as the
+value of a @code{display} overlay or text property (@pxref{Other
+Display Specs}); but @xref{Showing Images}, for convenient helper
+functions to insert images into buffers.
- Every image descriptor must contain the property @code{:type
-@var{type}} to specify the format of the image. The value of @var{type}
-should be an image type symbol; for example, @code{xpm} for an image in
-XPM format.
+ Each image descriptor has the form @code{(image . @var{props})},
+where @var{props} is a property list of alternating keyword symbols
+and values, including at least the pair @code{:type @var{TYPE}} which
+specifies the image type.
- Here is a list of other properties that are meaningful for all image
-types:
+ The following is a list of properties that are meaningful for all
+image types (there are also properties which are meaningful only for
+certain image types, as documented in the following subsections):
@table @code
+@item :type @var{type}
+The image type.
+@ifnottex
+@xref{Image Formats}.
+@end ifnottex
+Every image descriptor must include this property.
+
@item :file @var{file}
-The @code{:file} property says to load the image from file
-@var{file}. If @var{file} is not an absolute file name, it is expanded
-in @code{data-directory}.
+This says to load the image from file @var{file}. If @var{file} is
+not an absolute file name, it is expanded in @code{data-directory}.
@item :data @var{data}
-The @code{:data} property says the actual contents of the image.
-Each image must use either @code{:data} or @code{:file}, but not both.
-For most image types, the value of the @code{:data} property should be a
-string containing the image data; we recommend using a unibyte string.
+This specifies the raw image data. Each image descriptor must have
+either @code{:data} or @code{:file}, but not both.
-Before using @code{:data}, look for further information in the section
-below describing the specific image format. For some image types,
-@code{:data} may not be supported; for some, it allows other data types;
-for some, @code{:data} alone is not enough, so you need to use other
-image properties along with @code{:data}.
+For most image types, the value of a @code{:data} property should be a
+string containing the image data. Some image types do not support
+@code{:data}; for some others, @code{:data} alone is not enough, so
+you need to use other image properties along with @code{:data}. See
+the following subsections for details.
@item :margin @var{margin}
-The @code{:margin} property specifies how many pixels to add as an
-extra margin around the image. The value, @var{margin}, must be a
-non-negative number, or a pair @code{(@var{x} . @var{y})} of such
-numbers. If it is a pair, @var{x} specifies how many pixels to add
-horizontally, and @var{y} specifies how many pixels to add vertically.
-If @code{:margin} is not specified, the default is zero.
+This specifies how many pixels to add as an extra margin around the
+image. The value, @var{margin}, must be a non-negative number, or a
+pair @code{(@var{x} . @var{y})} of such numbers. If it is a pair,
+@var{x} specifies how many pixels to add horizontally, and @var{y}
+specifies how many pixels to add vertically. If @code{:margin} is not
+specified, the default is zero.
@item :ascent @var{ascent}
-The @code{:ascent} property specifies the amount of the image's
-height to use for its ascent---that is, the part above the baseline.
-The value, @var{ascent}, must be a number in the range 0 to 100, or
-the symbol @code{center}.
+This specifies the amount of the image's height to use for its
+ascent---that is, the part above the baseline. The value,
+@var{ascent}, must be a number in the range 0 to 100, or the symbol
+@code{center}.
If @var{ascent} is a number, that percentage of the image's height is
used for its ascent.
@@ -4241,16 +4316,15 @@ properties and overlays that apply to the image.
If this property is omitted, it defaults to 50.
@item :relief @var{relief}
-The @code{:relief} property, if non-@code{nil}, adds a shadow rectangle
-around the image. The value, @var{relief}, specifies the width of the
-shadow lines, in pixels. If @var{relief} is negative, shadows are drawn
-so that the image appears as a pressed button; otherwise, it appears as
-an unpressed button.
+This adds a shadow rectangle around the image. The value,
+@var{relief}, specifies the width of the shadow lines, in pixels. If
+@var{relief} is negative, shadows are drawn so that the image appears
+as a pressed button; otherwise, it appears as an unpressed button.
@item :conversion @var{algorithm}
-The @code{:conversion} property, if non-@code{nil}, specifies a
-conversion algorithm that should be applied to the image before it is
-displayed; the value, @var{algorithm}, specifies which algorithm.
+This specifies a conversion algorithm that should be applied to the
+image before it is displayed; the value, @var{algorithm}, specifies
+which algorithm.
@table @code
@item laplace
@@ -4322,7 +4396,7 @@ $$\pmatrix{ 2 & -1 & 0 \cr
@end ifnottex
@item disabled
-Specifies transforming the image so that it looks ``disabled.''
+Specifies transforming the image so that it looks ``disabled''.
@end table
@item :mask @var{mask}
@@ -4467,33 +4541,13 @@ specifies the actual color to use for displaying that name.
@table @code
@item :index @var{index}
-You can use @code{:index} to specify one image from a GIF file that
-contains more than one image. This property specifies use of image
-number @var{index} from the file. If the GIF file doesn't contain an
-image with index @var{index}, the image displays as a hollow box.
+You can use @code{:index} to specify image number @var{index} from a
+GIF file that contains more than one image. If the GIF file doesn't
+contain an image with the specified index, the image displays as a
+hollow box. GIF files with more than one image can be animated,
+@pxref{Animated Images}.
@end table
-@ignore
-This could be used to implement limited support for animated GIFs.
-For example, the following function displays a multi-image GIF file
-at point-min in the current buffer, switching between sub-images
-every 0.1 seconds.
-
-(defun show-anim (file max)
- "Display multi-image GIF file FILE which contains MAX subimages."
- (display-anim (current-buffer) file 0 max t))
-
-(defun display-anim (buffer file idx max first-time)
- (when (= idx max)
- (setq idx 0))
- (let ((img (create-image file nil :image idx)))
- (with-current-buffer buffer
- (goto-char (point-min))
- (unless first-time (delete-char 1))
- (insert-image img))
- (run-with-timer 0.1 nil 'display-anim buffer file (1+ idx) max nil)))
-@end ignore
-
@node TIFF Images
@subsection TIFF Images
@cindex TIFF
@@ -4502,10 +4556,10 @@ every 0.1 seconds.
@table @code
@item :index @var{index}
-You can use @code{:index} to specify one image from a TIFF file that
-contains more than one image. This property specifies use of image
-number @var{index} from the file. If the TIFF file doesn't contain an
-image with index @var{index}, the image displays as a hollow box.
+You can use @code{:index} to specify image number @var{index} from a
+TIFF file that contains more than one image. If the TIFF file doesn't
+contain an image with the specified index, the image displays as a
+hollow box.
@end table
@node PostScript Images
@@ -4540,38 +4594,46 @@ specifying the bounding box of the PostScript image, analogous to the
@cindex ImageMagick images
@cindex images, support for more formats
- If you build Emacs with ImageMagick (@url{http://www.imagemagick.org})
-support, you can use the ImageMagick library to load many image formats.
-
-@findex imagemagick-types
-The function @code{imagemagick-types} returns a list of image file
-extensions that your installation of ImageMagick supports. To enable
-support, you must call the function @code{imagemagick-register-types}.
-
-@vindex imagemagick-types-inhibit
-The variable @code{imagemagick-types-inhibit} specifies a list of
-image types that you do @emph{not} want ImageMagick to handle. There
-may be overlap between image loaders in your Emacs installation, and
-you may prefer to use a different one for a given image type (which
-@c FIXME how is this priority determined?
-loader will be used in practice depends on the priority of the loaders).
-@c FIXME why are these uppercase when image-types is lower-case?
-@c FIXME what are the possible options? Are these actually file extensions?
-For example, if you never want to use the ImageMagick loader to use
-JPEG files, add @code{JPG} to this list.
-
-@vindex imagemagick-render-type
-You can set the variable @code{imagemagick-render-type} to choose
-between screen render methods for the ImageMagick loader. The options
-are: @code{0}, a conservative method which works with older
-@c FIXME details of this "newer method"?
-@c Presumably it is faster but may be less "robust"?
-ImageMagick versions (it is a bit slow, but robust); and @code{1},
-a newer ImageMagick method.
-
-Images loaded with ImageMagick support a few new display specifications:
+ If you build Emacs with ImageMagick support, you can use the
+ImageMagick library to load many image formats (@pxref{File
+Conveniences,,, emacs, The GNU Emacs Manual}). The image type symbol
+for images loaded via ImageMagick is @code{imagemagick}, regardless of
+the actual underlying image format.
+
+@defun imagemagick-types
+This function returns a list of image file extensions supported by the
+current ImageMagick installation. Each list element is a symbol
+representing an internal ImageMagick name for an image type, such as
+@code{BMP} for @file{.bmp} images.
+@end defun
+
+@defopt imagemagick-enabled-types
+The value of this variable is a list of ImageMagick image types which
+Emacs may attempt to render using ImageMagick. Each list element
+should be one of the symbols in the list returned by
+@code{imagemagick-types}, or an equivalent string. Alternatively, a
+value of @code{t} enables ImageMagick for all possible image types.
+Regardless of the value of this variable,
+@code{imagemagick-types-inhibit} (see below) takes precedence.
+@end defopt
+
+@defopt imagemagick-types-inhibit
+The value of this variable lists the ImageMagick image types which
+should never be rendered using ImageMagick, regardless of the value of
+@code{imagemagick-enabled-types}. A value of @code{t} disables
+ImageMagick entirely.
+@end defopt
+
+ Images loaded with ImageMagick support the following additional
+image descriptor properties:
@table @code
+@item :background @var{background}
+@var{background}, if non-@code{nil}, should be a string specifying a
+color, which is used as the image's background color if the image
+supports transparency. If the value is @code{nil}, it defaults to the
+frame's background color.
+
@item :width, :height
The @code{:width} and @code{:height} keywords are used for scaling the
image. If only one of them is specified, the other one will be
@@ -4582,13 +4644,13 @@ aspect ratio may not be preserved.
Specifies a rotation angle in degrees.
@item :index
-Specifies which image to view inside an image bundle file format, such
-as TIFF or DJVM. You can use the @code{image-metadata} function to
-retrieve the total number of images in an image bundle (this is
-similar to how GIF files work).
+@c Doesn't work: http://debbugs.gnu.org/7978
+This has the same meaning as it does for GIF images (@pxref{GIF Images}),
+i.e. it specifies which image to view inside an image bundle file format
+such as DJVM. You can use the @code{image-metadata} function to
+retrieve the total number of images in an image bundle.
@end table
-
@node Other Image Types
@subsection Other Image Types
@cindex PBM
@@ -4787,10 +4849,10 @@ This function inserts @var{image} in the current buffer at point, like
@code{insert-image}, but splits the image into @var{rows}x@var{cols}
equally sized slices.
-If an image is inserted ``sliced'', then the Emacs display engine will
-treat each slice as a separate image, and allow more intuitive
-scrolling up/down, instead of jumping up/down the entire image when
-paging through a buffer that displays (large) images.
+If an image is inserted ``sliced'', Emacs displays each slice as a
+separate image, and allow more intuitive scrolling up/down, instead of
+jumping up/down the entire image when paging through a buffer that
+displays (large) images.
@end defun
@defun put-image image pos &optional string area
@@ -4853,6 +4915,39 @@ cache, it can always be displayed, even if the value of
@var{max-image-size} is subsequently changed (@pxref{Image Cache}).
@end defvar
+@node Animated Images
+@subsection Animated Images
+
+@cindex animation
+@cindex image animation
+Some image files can contain more than one image. This can be used to
+create animation. Currently, Emacs only supports animated GIF files.
+The following functions related to animated images are available.
+
+@defun image-animated-p image
+This function returns non-@code{nil} if @var{image} can be animated.
+The actual return value is a cons @code{(@var{nimages} . @var{delay})},
+where @var{nimages} is the number of frames and @var{delay} is the
+delay in seconds between them.
+@end defun
+
+@defun image-animate image &optional index limit
+This function animates @var{image}. The optional integer @var{index}
+specifies the frame from which to start (default 0). The optional
+argument @var{limit} controls the length of the animation. If omitted
+or @code{nil}, the image animates once only; if @code{t} it loops
+forever; if a number animation stops after that many seconds.
+@end defun
+
+@noindent Animation operates by means of a timer. Note that Emacs imposes a
+minimum frame delay of 0.01 seconds.
+
+@defun image-animate-timer image
+This function returns the timer responsible for animating @var{image},
+if there is one.
+@end defun
+
+
@node Image Cache
@subsection Image Cache
@cindex image cache
@@ -4870,7 +4965,7 @@ using @code{equal}. If @var{frame} is @code{nil}, it defaults to the
selected frame. If @var{frame} is @code{t}, the image is flushed on
all existing frames.
-In Emacs' current implementation, each graphical terminal possesses an
+In Emacs's current implementation, each graphical terminal possesses an
image cache, which is shared by all the frames on that terminal
(@pxref{Multiple Terminals}). Thus, refreshing an image in one frame
also refreshes it in all other frames on the same terminal.
@@ -4922,29 +5017,24 @@ debugging.
@cindex buttons in buffers
@cindex clickable buttons in buffers
- The @emph{button} package defines functions for inserting and
-manipulating clickable (with the mouse, or via keyboard commands)
-buttons in Emacs buffers, such as might be used for help hyper-links,
-etc. Emacs uses buttons for the hyper-links in help text and the like.
-
- A button is essentially a set of properties attached (via text
-properties or overlays) to a region of text in an Emacs buffer. These
-properties are called @dfn{button properties}.
-
- One of these properties (@code{action}) is a function, which will
-be called when the user invokes it using the keyboard or the mouse.
-The invoked function may then examine the button and use its other
-properties as desired.
-
- In some ways the Emacs button package duplicates functionality offered
-by the widget package (@pxref{Top, , Introduction, widget, The Emacs
-Widget Library}), but the button package has the advantage that it is
-much faster, much smaller, and much simpler to use (for elisp
-programmers---for users, the result is about the same). The extra
-speed and space savings are useful mainly if you need to create many
-buttons in a buffer (for instance an @code{*Apropos*} buffer uses
-buttons to make entries clickable, and may contain many thousands of
-entries).
+ The Button package defines functions for inserting and manipulating
+@dfn{buttons} that can be activated with the mouse or via keyboard
+commands. These buttons are typically used for various kinds of
+hyperlinks.
+
+ A button is essentially a set of text or overlay properties,
+attached to a stretch of text in a buffer. These properties are
+called @dfn{button properties}. One of these properties, the
+@dfn{action property}, specifies a function which is called when the
+user invokes the button using the keyboard or the mouse. The action
+function may examine the button and use its other properties as
+desired.
+
+ In some ways, the Button package duplicates the functionality in the
+Widget package. @xref{Top, , Introduction, widget, The Emacs Widget
+Library}. The advantage of the Button package is that it is faster,
+smaller, and simpler to program. From the point of view of the user,
+the interfaces produced by the two packages are very similar.
@menu
* Button Properties:: Button properties with special meanings.
@@ -4958,10 +5048,10 @@ entries).
@subsection Button Properties
@cindex button properties
- Buttons have an associated list of properties defining their
+ Each button has an associated list of properties defining its
appearance and behavior, and other arbitrary properties may be used
-for application specific purposes. Some properties that have special
-meaning to the button package include:
+for application specific purposes. The following properties have
+special meaning to the Button package:
@table @code
@item action
@@ -4997,9 +5087,7 @@ in the variable @code{button-map}, which defines @key{RET} and
@item type
@kindex type @r{(button property)}
-The button-type of the button. When creating a button, this is
-usually specified using the @code{:type} keyword argument.
-@xref{Button Types}.
+The button type. @xref{Button Types}.
@item help-echo
@kindex help-index @r{(button property)}
@@ -5025,7 +5113,7 @@ button, but these are not generally interesting for typical uses.
@subsection Button Types
@cindex button types
- Every button has a button @emph{type}, which defines default values
+ Every button has a @dfn{button type}, which defines default values
for the button's properties. Button types are arranged in a
hierarchy, with specialized types inheriting from more general types,
so that it's easy to define special-purpose types of buttons for
@@ -5090,18 +5178,17 @@ This insert a button with the label @var{label} at point,
and returns it.
@end defun
- The following functions are similar, but use Emacs text properties
-(@pxref{Text Properties}) to hold the button properties, making the
-button actually part of the text instead of being a property of the
-buffer. Buttons using text properties do not create markers into the
-buffer, which is important for speed when you use extremely large
-numbers of buttons. (However, if there is an existing face text
-property at the site of the button, the button face may not be visible.)
-Both functions return the position of the start of the new button:
+ The following functions are similar, but using text properties
+(@pxref{Text Properties}) to hold the button properties. Such buttons
+do not add markers to the buffer, so editing in the buffer does not
+slow down if there is an extremely large numbers of buttons. However,
+if there is an existing face text property on the text (e.g.@: a face
+assigned by Font Lock mode), the button face may not be visible. Both
+of these functions return the starting position of the new button.
@defun make-text-button beg end &rest properties
-This makes a button from @var{beg} to @var{end} in the current buffer, using
-text properties.
+This makes a button from @var{beg} to @var{end} in the current buffer,
+using text properties.
@end defun
@defun insert-text-button label &rest properties
@@ -5160,7 +5247,9 @@ Return @code{t} if @var{button} has button-type @var{type}, or one of
@end defun
@defun button-at pos
-Return the button at position @var{pos} in the current buffer, or @code{nil}.
+Return the button at position @var{pos} in the current buffer, or
+@code{nil}. If the button at @var{pos} is a text property button, the
+return value is a marker pointing to @var{pos}.
@end defun
@defun button-type-put type prop val
@@ -5184,12 +5273,12 @@ buttons in an Emacs buffer.
@code{push-button} is the command that a user uses to actually `push'
a button, and is bound by default in the button itself to @key{RET}
-and to @key{mouse-2} using a region-specific keymap. Commands
-that are useful outside the buttons itself, such as
-@code{forward-button} and @code{backward-button} are additionally
-available in the keymap stored in @code{button-buffer-map}; a mode
-which uses buttons may want to use @code{button-buffer-map} as a
-parent keymap for its keymap.
+and to @key{mouse-2} using a local keymap in the button's overlay or
+text properties. Commands that are useful outside the buttons itself,
+such as @code{forward-button} and @code{backward-button} are
+additionally available in the keymap stored in
+@code{button-buffer-map}; a mode which uses buttons may want to use
+@code{button-buffer-map} as a parent keymap for its keymap.
If the button has a non-@code{nil} @code{follow-link} property, and
@var{mouse-1-click-follows-link} is set, a quick @key{Mouse-1} click
@@ -5463,7 +5552,7 @@ Any @var{args} are passed to @var{map-function}.
@subsection Abstract Display Example
Here is a simple example using functions of the ewoc package to
-implement a ``color components display,'' an area in a buffer that
+implement a ``color components display'', an area in a buffer that
represents a vector of three integers (itself representing a 24-bit RGB
value) in various ways.
@@ -5617,9 +5706,6 @@ Here is an example of calling this function explicitly.
@smallexample
@group
(defun interactive-blink-matching-open ()
-@c Do not break this line! -- rms.
-@c The first line of a doc string
-@c must stand alone.
"Indicate momentarily the start of sexp before point."
(interactive)
@end group
@@ -5632,70 +5718,106 @@ Here is an example of calling this function explicitly.
@end smallexample
@end deffn
+@node Character Display
+@section Character Display
+
+ This section describes how characters are actually displayed by
+Emacs. Typically, a character is displayed as a @dfn{glyph} (a
+graphical symbol which occupies one character position on the screen),
+whose appearance corresponds to the character itself. For example,
+the character @samp{a} (character code 97) is displayed as @samp{a}.
+Some characters, however, are displayed specially. For example, the
+formfeed character (character code 12) is usually displayed as a
+sequence of two glyphs, @samp{^L}, while the newline character
+(character code 10) starts a new screen line.
+
+ You can modify how each character is displayed by defining a
+@dfn{display table}, which maps each character code into a sequence of
+glyphs. @xref{Display Tables}.
+
+@menu
+* Usual Display:: The usual conventions for displaying characters.
+* Display Tables:: What a display table consists of.
+* Active Display Table:: How Emacs selects a display table to use.
+* Glyphs:: How to define a glyph, and what glyphs mean.
+* Glyphless Chars:: How glyphless characters are drawn.
+@end menu
+
@node Usual Display
-@section Usual Display Conventions
+@subsection Usual Display Conventions
- The usual display conventions define how to display each character
-code. You can override these conventions by setting up a display table
-(@pxref{Display Tables}). Here are the usual display conventions:
+ Here are the conventions for displaying each character code (in the
+absence of a display table, which can override these
+@iftex
+conventions).
+@end iftex
+@ifnottex
+conventions; @pxref{Display Tables}).
+@end ifnottex
+@cindex printable ASCII characters
@itemize @bullet
@item
-Character codes 32 through 126 map to glyph codes 32 through 126.
-Normally this means they display as themselves, but a display table
-can change that.
+The @dfn{printable @acronym{ASCII} characters}, character codes 32
+through 126 (consisting of numerals, English letters, and symbols like
+@samp{#}) are displayed literally.
@item
-Character code 9 is a horizontal tab. It displays as whitespace
-up to a position determined by @code{tab-width}.
+The tab character (character code 9) displays as whitespace stretching
+up to the next tab stop column. @xref{Text Display,,, emacs, The GNU
+Emacs Manual}. The variable @code{tab-width} controls the number of
+spaces per tab stop (see below).
@item
-Character code 10 is a newline. It is normally invisible on display,
-and has the effect of ending the preceding line and starting a new
-line.
+The newline character (character code 10) has a special effect: it
+ends the preceding line and starts a new line.
+@cindex ASCII control characters
@item
-All other codes in the range 0 through 31 display in one of two ways
-according to the value of @code{ctl-arrow}. If it is non-@code{nil},
-these codes map to sequences of two glyphs, where the first glyph is
-the @acronym{ASCII} code for @samp{^}. (A display table can specify a
-glyph to use instead of @samp{^}.) Otherwise, these codes map just
-like the raw bytes in the range 128 to 255 (described below).
+The non-printable @dfn{@acronym{ASCII} control characters}---character
+codes 0 through 31, as well as the @key{DEL} character (character code
+127)---display in one of two ways according to the variable
+@code{ctl-arrow}. If this variable is non-@code{nil} (the default),
+these characters are displayed as sequences of two glyphs, where the
+first glyph is @samp{^} (a display table can specify a glyph to use
+instead of @samp{^}); e.g.@: the @key{DEL} character is displayed as
+@samp{^?}.
+
+If @code{ctl-arrow} is @code{nil}, these characters are displayed as
+octal escapes (see below).
+
+This rule also applies to carriage return (character code 13), if that
+character appears in the buffer. But carriage returns usually do not
+appear in buffer text; they are eliminated as part of end-of-line
+conversion (@pxref{Coding System Basics}).
@cindex octal escapes
@item
-Raw bytes (@pxref{Text Representations}) with codes 128 through 255,
-and the @acronym{ASCII} control character with code 127, display as
-sequences of four glyphs, where the first glyph is the @acronym{ASCII}
-code for @samp{\}, and the others are digit characters representing
-the character code in octal. (A display table can specify a glyph to
-use instead of @samp{\}.) This is known as the @dfn{octal escape}
-display.
+@dfn{Raw bytes} are non-@acronym{ASCII} characters with codes 128
+through 255 (@pxref{Text Representations}). These characters display
+as @dfn{octal escapes}: sequences of four glyphs, where the first
+glyph is the @acronym{ASCII} code for @samp{\}, and the others are
+digit characters representing the character code in octal. (A display
+table can specify a glyph to use instead of @samp{\}.)
@item
-Non-@acronym{ASCII} character codes above 127 are displayed as
-themselves, if the terminal and the available fonts support them.
-Characters that are not supported by the terminal, or (on window
-systems) have no fonts available for them, are displayed as a question
-mark or a hex code or an empty box. @xref{Glyphless Chars}, for how
-to control display of the characters not supported by the terminal or
-fonts. Display tables can change how a character is displayed, even
-if it is supported.
+Each non-@acronym{ASCII} character with code above 255 is displayed
+literally, if the terminal supports it. If the terminal does not
+support it, the character is said to be @dfn{glyphless}, and it is
+usually displayed using a placeholder glyph. For example, if a
+graphical terminal has no font for a character, Emacs usually displays
+a box containing the character code in hexadecimal. @xref{Glyphless
+Chars}.
@end itemize
- The usual display conventions apply even when there is a display
+ The above display conventions apply even when there is a display
table, for any character whose entry in the active display table is
@code{nil}. Thus, when you set up a display table, you need only
specify the characters for which you want special behavior.
- These display rules apply to carriage return (character code 13), when
-it appears in the buffer. But that character may not appear in the
-buffer where you expect it, if it was eliminated as part of end-of-line
-conversion (@pxref{Coding System Basics}).
-
- These variables affect the way certain characters are displayed on the
-screen. Since they change the number of columns the characters occupy,
-they also affect the indentation functions. These variables also affect
+ The following variables affect how certain characters are displayed
+on the screen. Since they change the number of columns the characters
+occupy, they also affect the indentation functions. They also affect
how the mode line is displayed; if you want to force redisplay of the
mode line using the new values, call the function
@code{force-mode-line-update} (@pxref{Mode Line Format}).
@@ -5718,34 +5840,14 @@ command @code{tab-to-tab-stop}. @xref{Indent Tabs}.
@end defopt
@node Display Tables
-@section Display Tables
+@subsection Display Tables
@cindex display table
-You can use the @dfn{display table} feature to control how all possible
-character codes display on the screen. This is useful for displaying
-European languages that have letters not in the @acronym{ASCII} character
-set.
-
-The display table maps each character code into a sequence of
-@dfn{glyphs}, each glyph being a graphic that takes up one character
-position on the screen. You can also define how to display each glyph
-on your terminal, using the @dfn{glyph table}.
-
-Display tables affect how the mode line is displayed; if you want to
-force redisplay of the mode line using a new display table, call
-@code{force-mode-line-update} (@pxref{Mode Line Format}).
-
-@menu
-* Display Table Format:: What a display table consists of.
-* Active Display Table:: How Emacs selects a display table to use.
-* Glyphs:: How to define a glyph, and what glyphs mean.
-@end menu
-
-@node Display Table Format
-@subsection Display Table Format
-
- A display table is actually a char-table (@pxref{Char-Tables}) with
-@code{display-table} as its subtype.
+ A display table is a special-purpose char-table
+(@pxref{Char-Tables}), with @code{display-table} as its subtype, which
+is used to override the usual character display conventions. This
+section describes how to make, inspect, and assign elements to a
+display table object.
@defun make-display-table
This creates and returns a display table. The table initially has
@@ -5754,14 +5856,14 @@ This creates and returns a display table. The table initially has
The ordinary elements of the display table are indexed by character
codes; the element at index @var{c} says how to display the character
-code @var{c}. The value should be @code{nil} or a vector of the
-glyphs to be output (@pxref{Glyphs}). @code{nil} says to display the
-character @var{c} according to the usual display conventions
-(@pxref{Usual Display}).
+code @var{c}. The value should be @code{nil} (which means to display
+the character @var{c} according to the usual display conventions;
+@pxref{Usual Display}), or a vector of glyph codes (which means to
+display the character @var{c} as those glyphs; @pxref{Glyphs}).
@strong{Warning:} if you use the display table to change the display
of newline characters, the whole buffer will be displayed as one long
-``line.''
+``line''.
The display table also has six ``extra slots'' which serve special
purposes. Here is a table of their meanings; @code{nil} in any slot
@@ -5797,17 +5899,21 @@ when there are no scroll bars; if scroll bars are supported and in use,
a scroll bar separates the two windows.
@end table
- For example, here is how to construct a display table that mimics the
-effect of setting @code{ctl-arrow} to a non-@code{nil} value:
+ For example, here is how to construct a display table that mimics
+the effect of setting @code{ctl-arrow} to a non-@code{nil} value
+(@pxref{Glyphs}, for the function @code{make-glyph-code}):
@example
(setq disptab (make-display-table))
-(let ((i 0))
- (while (< i 32)
- (or (= i ?\t) (= i ?\n)
- (aset disptab i (vector ?^ (+ i 64))))
- (setq i (1+ i)))
- (aset disptab 127 (vector ?^ ??)))
+(dotimes (i 32)
+ (or (= i ?\t)
+ (= i ?\n)
+ (aset disptab i
+ (vector (make-glyph-code ?^ 'escape-glyph)
+ (make-glyph-code (+ i 64) 'escape-glyph)))))
+(aset disptab 127
+ (vector (make-glyph-code ?^ 'escape-glyph)
+ (make-glyph-code ?? 'escape-glyph)))))
@end example
@defun display-table-slot display-table slot
@@ -5840,17 +5946,19 @@ help buffer.
@subsection Active Display Table
@cindex active display table
- Each window can specify a display table, and so can each buffer. When
-a buffer @var{b} is displayed in window @var{w}, display uses the
-display table for window @var{w} if it has one; otherwise, the display
-table for buffer @var{b} if it has one; otherwise, the standard display
-table if any. The display table chosen is called the @dfn{active}
-display table.
+ Each window can specify a display table, and so can each buffer.
+The window's display table, if there is one, takes precedence over the
+buffer's display table. If neither exists, Emacs tries to use the
+standard display table; if that is @code{nil}, Emacs uses the usual
+character display conventions (@pxref{Usual Display}).
+
+ Note that display tables affect how the mode line is displayed, so
+if you want to force redisplay of the mode line using a new display
+table, call @code{force-mode-line-update} (@pxref{Mode Line Format}).
@defun window-display-table &optional window
-This function returns @var{window}'s display table, or @code{nil}
-if @var{window} does not have an assigned display table. The default
-for @var{window} is the selected window.
+This function returns @var{window}'s display table, or @code{nil} if
+there is none. The default for @var{window} is the selected window.
@end defun
@defun set-window-display-table window table
@@ -5860,104 +5968,190 @@ The argument @var{table} should be either a display table or
@end defun
@defvar buffer-display-table
-This variable is automatically buffer-local in all buffers; its value in
-a particular buffer specifies the display table for that buffer. If it
-is @code{nil}, that means the buffer does not have an assigned display
-table.
+This variable is automatically buffer-local in all buffers; its value
+specifies the buffer's display table. If it is @code{nil}, there is
+no buffer display table.
@end defvar
@defvar standard-display-table
-This variable's value is the default display table, used whenever a
-window has no display table and neither does the buffer displayed in
-that window. This variable is @code{nil} by default.
+The value of this variable is the standard display table, which is
+used when Emacs is displaying a buffer in a window with neither a
+window display table nor a buffer display table defined. Its default
+is @code{nil}.
@end defvar
- If there is no display table to use for a particular window---that is,
-if the window specifies none, its buffer specifies none, and
-@code{standard-display-table} is @code{nil}---then Emacs uses the usual
-display conventions for all character codes in that window. @xref{Usual
-Display}.
-
-A number of functions for changing the standard display table
-are defined in the library @file{disp-table}.
+The @file{disp-table} library defines several functions for changing
+the standard display table.
@node Glyphs
@subsection Glyphs
-
@cindex glyph
- A @dfn{glyph} is a generalization of a character; it stands for an
-image that takes up a single character position on the screen. Normally
-glyphs come from vectors in the display table (@pxref{Display Tables}).
- A glyph is represented in Lisp as a @dfn{glyph code}. A glyph code
-can be @dfn{simple} or it can be defined by the @dfn{glyph table}. A
-simple glyph code is just a way of specifying a character and a face
-to output it in. @xref{Faces}.
-
- The following functions are used to manipulate simple glyph codes:
+ A @dfn{glyph} is a graphical symbol which occupies a single
+character position on the screen. Each glyph is represented in Lisp
+as a @dfn{glyph code}, which specifies a character and optionally a
+face to display it in (@pxref{Faces}). The main use of glyph codes is
+as the entries of display tables (@pxref{Display Tables}). The
+following functions are used to manipulate glyph codes:
@defun make-glyph-code char &optional face
-This function returns a simple glyph code representing char @var{char}
-with face @var{face}.
+This function returns a glyph code representing char @var{char} with
+face @var{face}. If @var{face} is omitted or @code{nil}, the glyph
+uses the default face; in that case, the glyph code is an integer. If
+@var{face} is non-@code{nil}, the glyph code is not necessarily an
+integer object.
@end defun
@defun glyph-char glyph
-This function returns the character of simple glyph code @var{glyph}.
+This function returns the character of glyph code @var{glyph}.
@end defun
@defun glyph-face glyph
-This function returns face of simple glyph code @var{glyph}, or
-@code{nil} if @var{glyph} has the default face (face-id 0).
-@xref{Face Functions}.
+This function returns face of glyph code @var{glyph}, or @code{nil} if
+@var{glyph} uses the default face.
@end defun
- On character terminals, you can set up a @dfn{glyph table} to define
-the meaning of glyph codes (represented as small integers).
+@ifnottex
+ You can set up a @dfn{glyph table} to change how glyph codes are
+actually displayed on text terminals. This feature is semi-obsolete;
+use @code{glyphless-char-display} instead (@pxref{Glyphless Chars}).
@defvar glyph-table
-The value of this variable is the current glyph table. It should be
-@code{nil} or a vector whose @var{g}th element defines glyph code
-@var{g}.
+The value of this variable, if non-@code{nil}, is the current glyph
+table. It takes effect only on character terminals; on graphical
+displays, all glyphs are displayed literally. The glyph table should
+be a vector whose @var{g}th element specifies how to display glyph
+code @var{g}, where @var{g} is the glyph code for a glyph whose face
+is unspecified. Each element should be one of the following:
+
+@table @asis
+@item @code{nil}
+Display this glyph literally.
+
+@item a string
+Display this glyph by sending the specified string to the terminal.
-If a glyph code is greater than or equal to the length of the glyph
-table, that code is automatically simple. If @code{glyph-table} is
-@code{nil} then all glyph codes are simple.
+@item a glyph code
+Display the specified glyph code instead.
+@end table
-The glyph table is used only on character terminals. On graphical
-displays, all glyph codes are simple.
+Any integer glyph code greater than or equal to the length of the
+glyph table is displayed literally.
@end defvar
+@end ifnottex
- Here are the meaningful types of elements in the glyph table:
+@node Glyphless Chars
+@subsection Glyphless Character Display
+@cindex glyphless characters
-@table @asis
-@item @var{string}
-Send the characters in @var{string} to the terminal to output
-this glyph code.
+ @dfn{Glyphless characters} are characters which are displayed in a
+special way, e.g.@: as a box containing a hexadecimal code, instead of
+being displayed literally. These include characters which are
+explicitly defined to be glyphless, as well as characters for which
+there is no available font (on a graphical display), and characters
+which cannot be encoded by the terminal's coding system (on a text
+terminal).
-@item @var{code}
-Define this glyph code as an alias for glyph code @var{code} created
-by @code{make-glyph-code}. You can use such an alias to define a
-small-numbered glyph code which specifies a character with a face.
+@defvar glyphless-char-display
+The value of this variable is a char-table which defines glyphless
+characters and how they are displayed. Each entry must be one of the
+following display methods:
+@table @asis
@item @code{nil}
-This glyph code is simple.
+Display the character in the usual way.
+
+@item @code{zero-width}
+Don't display the character.
+
+@item @code{thin-space}
+Display a thin space, 1-pixel wide on graphical displays, or
+1-character wide on text terminals.
+
+@item @code{empty-box}
+Display an empty box.
+
+@item @code{hex-code}
+Display a box containing the Unicode codepoint of the character, in
+hexadecimal notation.
+
+@item an @acronym{ASCII} string
+Display a box containing that string.
+
+@item a cons cell @code{(@var{graphical} . @var{text})}
+Display with @var{graphical} on graphical displays, and with
+@var{text} on text terminals. Both @var{graphical} and @var{text}
+must be one of the display methods described above.
@end table
-@defun create-glyph string
-This function returns a newly-allocated glyph code which is set up to
-display by sending @var{string} to the terminal.
-@end defun
+@noindent
+The @code{thin-space}, @code{empty-box}, @code{hex-code}, and
+@acronym{ASCII} string display methods are drawn with the
+@code{glyphless-char} face.
+
+The char-table has one extra slot, which determines how to display any
+character that cannot be displayed with any available font, or cannot
+be encoded by the terminal's coding system. Its value should be one
+of the above display methods, except @code{zero-width} or a cons cell.
+
+If a character has a non-@code{nil} entry in an active display table,
+the display table takes effect; in this case, Emacs does not consult
+@code{glyphless-char-display} at all.
+@end defvar
+
+@defopt glyphless-char-display-control
+This user option provides a convenient way to set
+@code{glyphless-char-display} for groups of similar characters. Do
+not set its value directly from Lisp code; the value takes effect only
+via a custom @code{:set} function (@pxref{Variable Definitions}),
+which updates @code{glyphless-char-display}.
+
+Its value should be an alist of elements @code{(@var{group}
+. @var{method})}, where @var{group} is a symbol specifying a group of
+characters, and @var{method} is a symbol specifying how to display
+them.
+
+@var{group} should be one of the following:
+
+@table @code
+@item c0-control
+@acronym{ASCII} control characters @code{U+0000} to @code{U+001F},
+excluding the newline and tab characters (normally displayed as escape
+sequences like @samp{^A}; @pxref{Text Display,, How Text Is Displayed,
+emacs, The GNU Emacs Manual}).
+
+@item c1-control
+Non-@acronym{ASCII}, non-printing characters @code{U+0080} to
+@code{U+009F} (normally displayed as octal escape sequences like
+@samp{\230}).
+
+@item format-control
+Characters of Unicode General Category `Cf', such as @samp{U+200E}
+(Left-to-Right Mark), but excluding characters that have graphic
+images, such as @samp{U+00AD} (Soft Hyphen).
+
+@item no-font
+Characters for there is no suitable font, or which cannot be encoded
+by the terminal's coding system.
+@end table
+
+@c FIXME: this can also be `acronym', but that's not currently
+@c completely implemented; it applies only to the format-control
+@c group, and only works if the acronym is in `char-acronym-table'.
+The @var{method} symbol should be one of @code{zero-width},
+@code{thin-space}, @code{empty-box}, or @code{hex-code}. These have
+the same meanings as in @code{glyphless-char-display}, above.
+@end defopt
@node Beeping
@section Beeping
-@c @cindex beeping "beep" is adjacent
@cindex bell
This section describes how to make Emacs ring the bell (or blink the
screen) to attract the user's attention. Be conservative about how
often you do this; frequent bells can become irritating. Also be
careful not to use just beeping when signaling an error is more
-appropriate. (@xref{Errors}.)
+appropriate (@pxref{Errors}).
@defun ding &optional do-not-terminate
@cindex keyboard macro termination
@@ -5972,15 +6166,15 @@ This is a synonym for @code{ding}.
@defopt visible-bell
This variable determines whether Emacs should flash the screen to
-represent a bell. Non-@code{nil} means yes, @code{nil} means no. This
-is effective on graphical displays, and on text-only terminals
+represent a bell. Non-@code{nil} means yes, @code{nil} means no.
+This is effective on graphical displays, and on text terminals
provided the terminal's Termcap entry defines the visible bell
capability (@samp{vb}).
@end defopt
@defvar ring-bell-function
If this is non-@code{nil}, it specifies how Emacs should ``ring the
-bell.'' Its value should be a function of no arguments. If this is
+bell''. Its value should be a function of no arguments. If this is
non-@code{nil}, it takes precedence over the @code{visible-bell}
variable.
@end defvar
@@ -5989,7 +6183,7 @@ variable.
@section Window Systems
Emacs works with several window systems, most notably the X Window
-System. Both Emacs and X use the term ``window,'' but use it
+System. Both Emacs and X use the term ``window'', but use it
differently. An Emacs frame is a single window as far as X is
concerned; the individual Emacs windows are not known to X at all.
@@ -6054,61 +6248,56 @@ interfere with it.
@cindex right-to-left text
Emacs can display text written in scripts, such as Arabic, Farsi,
-and Hebrew, whose natural ordering of horizontal text for display is
-from right to left. However, digits and Latin text embedded in these
-scripts are still displayed left to right. It is also not uncommon to
-have small portions of text in Arabic or Hebrew embedded in otherwise
-Latin document, e.g., as comments and strings in a program source
-file. Likewise, small portions of Latin text can be embedded in an
-Arabic or Farsi document. For these reasons, text that uses these
-scripts is actually @dfn{bidirectional}: a mixture of runs of
-left-to-right and right-to-left characters.
-
- This section describes the facilities and options provided by Emacs
-for editing and displaying bidirectional text.
+and Hebrew, whose natural ordering for horizontal text display runs
+from right to left. Furthermore, segments of Latin script and digits
+embedded in right-to-left text are displayed left-to-right, while
+segments of right-to-left script embedded in left-to-right text
+(e.g.@: Arabic or Hebrew text in comments or strings in a program
+source file) are appropriately displayed right-to-left. We call such
+mixtures of left-to-right and right-to-left text @dfn{bidirectional
+text}. This section describes the facilities and options for editing
+and displaying bidirectional text.
@cindex logical order
@cindex reading order
@cindex visual order
@cindex unicode bidirectional algorithm
- Emacs stores right-to-left and bidirectional text in the so-called
-@dfn{logical} (or @dfn{reading}) order: the buffer or string position
-of the first character you read precedes that of the next character.
-Reordering of bidirectional text into the @dfn{visual} order happens
-at display time. As result, character positions no longer increase
-monotonically with their positions on display. Emacs implements the
-Unicode Bidirectional Algorithm (a.k.a.@: @acronym{UBA}) described in
-the Unicode Standard Annex #9, for reordering of bidirectional text
-for display. Reordering of bidirectional text for display in Emacs is
-a ``Full bidirectionality'' class implementation of the @acronym{UBA}.
+@cindex bidirectional reordering
+ Text is stored in Emacs buffers and strings in @dfn{logical} (or
+@dfn{reading}) order, i.e.@: the order in which a human would read
+each character. In right-to-left and bidirectional text, the order in
+which characters are displayed on the screen (called @dfn{visual
+order}) is not the same as logical order; the characters' screen
+positions do not increase monotonically with string or buffer
+position. In performing this @dfn{bidirectional reordering}, Emacs
+follows the Unicode Bidirectional Algorithm (a.k.a.@: @acronym{UBA}),
+which is described in Annex #9 of the Unicode standard
+(@url{http://www.unicode.org/reports/tr9/}). Emacs provides a ``Full
+Bidirectionality'' class implementation of the @acronym{UBA}.
@defvar bidi-display-reordering
- This buffer-local variable controls whether text in the buffer is
-reordered for display. If its value is non-@code{nil}, Emacs reorders
-characters that have right-to-left directionality when they are
-displayed. The default value is @code{t}. Text in overlay strings
-(@pxref{Overlay Properties,,before-string}), display strings
-(@pxref{Overlay Properties,,display}), and @code{display} text
-properties (@pxref{Display Property}) is also reordered for display if
-the buffer whose text includes these strings is reordered. Turning
-off @code{bidi-display-reordering} for a buffer turns off reordering
-of all the overlay and display strings in that buffer.
-
- Reordering of strings that are unrelated to any buffer, such as text
-displayed on the mode line (@pxref{Mode Line Format}) or header line
-(@pxref{Header Lines}), is controlled by the default value of
-@code{bidi-display-reordering}.
+If the value of this buffer-local variable is non-@code{nil} (the
+default), Emacs performs bidirectional reordering for display. The
+reordering affects buffer text, as well as display strings and overlay
+strings from text and overlay properties in the buffer (@pxref{Overlay
+Properties}, and @pxref{Display Property}). If the value is
+@code{nil}, Emacs does not perform bidirectional reordering in the
+buffer.
+
+The default value of @code{bidi-display-reordering} controls the
+reordering of strings which are not directly supplied by a buffer,
+including the text displayed in mode lines (@pxref{Mode Line Format})
+and header lines (@pxref{Header Lines}).
@end defvar
@cindex unibyte buffers, and bidi reordering
- Emacs does not reorder text in unibyte buffers, even if
-@code{bidi-display-reordering} is non-@code{nil} in such a buffer.
-This is because unibyte buffers contain raw bytes, not characters, and
-thus don't have bidirectional properties defined for them which are
-required for correct reordering. Therefore, to test whether text in a
-buffer will be reordered for display, it is not enough to test the
-value of @code{bidi-display-reordering} alone. The correct test is
-this:
+ Emacs never reorders the text of a unibyte buffer, even if
+@code{bidi-display-reordering} is non-@code{nil} in the buffer. This
+is because unibyte buffers contain raw bytes, not characters, and thus
+lack the directionality properties required for reordering.
+Therefore, to test whether text in a buffer will be reordered for
+display, it is not enough to test the value of
+@code{bidi-display-reordering} alone. The correct test is this:
@example
(if (and enable-multibyte-characters
@@ -6117,12 +6306,11 @@ this:
)
@end example
- In contrast to unibyte buffers, unibyte display and overlay strings
-@emph{are} reordered, if their parent buffer is reordered. This is
-because plain-@sc{ascii} strings are stored by Emacs as unibyte
-strings. If a unibyte display or overlay string includes
-non-@sc{ascii} characters, these characters are assumed to have
-left-to-right direction.
+ However, unibyte display and overlay strings @emph{are} reordered if
+their parent buffer is reordered. This is because plain-@sc{ascii}
+strings are stored by Emacs as unibyte strings. If a unibyte display
+or overlay string includes non-@sc{ascii} characters, these characters
+are assumed to have left-to-right direction.
@cindex display properties, and bidi reordering of text
Text covered by @code{display} text properties, by overlays with
@@ -6130,7 +6318,7 @@ left-to-right direction.
properties that replace buffer text, is treated as a single unit when
it is reordered for display. That is, the entire chunk of text
covered by these properties is reordered together. Moreover, the
-bidirectional properties of the characters in this chunk of text are
+bidirectional properties of the characters in such a chunk of text are
ignored, and Emacs reorders them as if they were replaced with a
single character @code{U+FFFC}, known as the @dfn{Object Replacement
Character}. This means that placing a display property over a portion
@@ -6140,36 +6328,34 @@ properties on text whose directionality is identical with text that
surrounds it.
@cindex base direction of a paragraph
- Each paragraph of bidirectional text can have its own @dfn{base
-direction}, either right-to-left or left-to-right. Text in
-left-to-right paragraphs is displayed beginning at the left margin of
-the window and is truncated or continued when it reaches the right
-margin. By contrast, display of text in right-to-left paragraphs
-begins at the right margin and is continued or truncated at the left
-margin.
+ Each paragraph of bidirectional text has a @dfn{base direction},
+either right-to-left or left-to-right. Left-to-right paragraphs are
+displayed beginning at the left margin of the window, and are
+truncated or continued when the text reaches the right margin.
+Right-to-left paragraphs are displayed beginning at the right margin,
+and are continued or truncated at the left margin.
+
+ By default, Emacs determines the base direction of each paragraph by
+looking at the text at its beginning. The precise method of
+determining the base direction is specified by the @acronym{UBA}; in a
+nutshell, the first character in a paragraph that has an explicit
+directionality determines the base direction of the paragraph.
+However, sometimes a buffer may need to force a certain base direction
+for its paragraphs. For example, buffers containing program source
+code should force all paragraphs to be displayed left-to-right. You
+can use following variable to do this:
@defvar bidi-paragraph-direction
- By default, Emacs determines the base direction of each paragraph
-dynamically, based on the text at the beginning of the paragraph. The
-precise method of determining the base direction is specified by the
-@acronym{UBA}; in a nutshell, the first character in a paragraph that
-has an explicit directionality determines the base direction of the
-paragraph. However, sometimes a buffer may need to force a certain
-base direction for its paragraphs. For example, a buffer that visits
-a source code of a program should force all its paragraphs to be
-displayed left to right. The variable
-@code{bidi-paragraph-direction}, if non-@code{nil}, disables the
-dynamic determination of the base direction, and instead forces all
-paragraphs in the buffer to have the direction specified by its
-buffer-local value. The value can be either @code{right-to-left} or
-@code{left-to-right}. Any other value is interpreted as @code{nil}.
-The default is @code{nil}.
+If the value of this buffer-local variable is the symbol
+@code{right-to-left} or @code{left-to-right}, all paragraphs in the
+buffer are assumed to have that specified direction. Any other value
+is equivalent to @code{nil} (the default), which means to determine
+the base direction of each paragraph from its contents.
@cindex @code{prog-mode}, and @code{bidi-paragraph-direction}
-Modes that are meant to display program source code should force a
-@code{left-to-right} paragraph direction. The easiest way of doing so
-is to derive the mode from Prog Mode, which already sets
-@code{bidi-paragraph-direction} to that value.
+Modes for program source code should set this to @code{left-to-right}.
+Prog mode does this by default, so modes derived from Prog mode do not
+need to set this explicitly (@pxref{Basic Major Modes}).
@end defvar
@defun current-bidi-paragraph-direction &optional buffer
@@ -6188,22 +6374,18 @@ buffers, this function always returns @code{left-to-right}.
@cindex layout on display, and bidirectional text
@cindex jumbled display of bidirectional text
@cindex concatenating bidirectional strings
- Reordering of bidirectional text for display can have surprising and
-unpleasant effects when two strings with bidirectional content are
-juxtaposed in a buffer, or otherwise programmatically concatenated
-into a string of text. A typical example is a buffer whose lines are
-actually sequences of items, or fields, separated by whitespace or
-punctuation characters. This is used in specialized modes such as
-Buffer-menu Mode or various email summary modes, like Rmail Summary
-Mode. Because these separator characters are @dfn{weak}, i.e.@: have
-no strong directionality, they take on the directionality of
-surrounding text. As result, a numeric field that follows a field
-with bidirectional content can be displayed @emph{to the left} of the
-preceding field, producing a jumbled display and messing up the
-expected layout.
-
- To countermand this, we recommend that you use one of the following
-techniques for forcing correct order of fields on display:
+ Bidirectional reordering can have surprising and unpleasant effects
+when two strings with bidirectional content are juxtaposed in a
+buffer, or otherwise programmatically concatenated into a string of
+text. A typical problematic case is when a buffer consists of
+sequences of text ``fields'' separated by whitespace or punctuation
+characters, like Buffer Menu mode or Rmail Summary Mode. Because the
+punctuation characters used as separators have @dfn{weak
+directionality}, they take on the directionality of surrounding text.
+As result, a numeric field that follows a field with bidirectional
+content can be displayed @emph{to the left} of the preceding field,
+messing up the expected layout. There are several ways to avoid this
+problem:
@itemize @minus
@item
@@ -6213,28 +6395,23 @@ content, or prepend it to the beginning of the following field. The
function @code{bidi-string-mark-left-to-right}, described below, comes
in handy for this purpose. (In a right-to-left paragraph, use
@code{U+200F}, RIGHT-TO-LEFT MARK, or @acronym{RLM}, instead.) This
-is one of the solutions recommended by
-@uref{http://www.unicode.org/reports/tr9/#Separators, the
-@acronym{UBA}}.
+is one of the solutions recommended by the UBA.
@item
Include the tab character in the field separator. The tab character
-plays the role of @dfn{segment separator} in the @acronym{UBA}
-reordering, whose effect is to make each field a separate segment, and
-thus reorder them separately.
+plays the role of @dfn{segment separator} in bidirectional reordering,
+causing the text on either side to be reordered separately.
@cindex @code{space} display spec, and bidirectional text
@item
-Separate fields with a @code{display} property or overlay with the
+Separate fields with a @code{display} property or overlay with a
property value of the form @code{(space . PROPS)} (@pxref{Specified
-Space}). This display specification is treated by Emacs as a
-@dfn{paragraph separator}; the text before and after the separator is
-reordered separately, which avoids the influence of any field on its
-neighboring fields.
+Space}). Emacs treats this display specification as a @dfn{paragraph
+separator}, and reorders the text on either side separately.
@end itemize
@defun bidi-string-mark-left-to-right string
-This subroutine returns its argument @var{string}, possibly modified,
+This function returns its argument @var{string}, possibly modified,
such that the result can be safely concatenated with another string,
or juxtaposed with another string in a buffer, without disrupting the
relative layout of this string and the next one on display. If the
@@ -6244,7 +6421,8 @@ of the text that follows it. The function works by examining the
characters of its argument, and if any of those characters could cause
reordering on display, the function appends the @acronym{LRM}
character to the string. The appended @acronym{LRM} character is made
-@emph{invisible} (@pxref{Invisible Text}), to hide it on display.
+invisible by giving it an @code{invisible} text property of @code{t}
+(@pxref{Invisible Text}).
@end defun
The reordering algorithm uses the bidirectional properties of the
@@ -6260,96 +6438,3 @@ affect all Emacs frames and windows.
appropriate mirrored character in the reordered text. Lisp programs
can affect the mirrored display by changing this property. Again, any
such changes affect all of Emacs display.
-
-@node Glyphless Chars
-@section Glyphless Character Display
-@cindex glyphless characters
-
- @dfn{Glyphless characters} are not displayed in the usual way when
-they appear in a buffer, but in some special way (e.g. as a box
-containing a hexadecimal code). These include characters that cannot
-be displayed with any available font (on a graphical display), or that
-cannot be encoded by the terminal's coding system (on a text-only
-terminal). Specific characters can also be defined to be glyphless.
-
-@defvar glyphless-char-display
-The value of this variable is a char-table that defines glyphless
-characters and how they are displayed. If an entry is @code{nil}, the
-corresponding character is displayed in its usual way. Otherwise, an
-entry should be one of the following display methods:
-
-@table @asis
-@item @code{zero-width}
-Don't display the character.
-
-@item @code{thin-space}
-Display a thin space, 1-pixel wide on graphical displays, or
-1-character wide on text-only terminals.
-
-@item @code{empty-box}
-Display an empty box.
-
-@item @code{hex-code}
-Display a box containing the Unicode codepoint of the character, in
-hexadecimal notation.
-
-@item an @acronym{ASCII} string
-Display a box containing that string.
-@end table
-
-@noindent
-Except for @code{zero-width}, these methods display using the
-@code{glyphless-char} face.
-
-An entry can also be a cons cell @code{(@var{graphical}
-. @var{text})}, where @var{graphical} and @var{text} are the display
-methods on graphical displays and text-only terminals respectively.
-
-The char-table has one extra slot, which determines how to display any
-character that cannot be displayed with any available font, or cannot
-be encoded by the terminal's coding system. Its value should be one
-of the above display methods, except @code{zero-width} or a cons cell.
-@end defvar
-
-@defopt glyphless-char-display-control
-This user option provides a convenient way to set
-@code{glyphless-char-display} for groups of similar characters. It
-takes effect via a custom @code{:set} function (@pxref{Variable
-Definitions}), which update @code{glyphless-char-display}.
-
-Its value should be an alist of elements @code{(@var{group}
-. @var{method})}, where @var{group} is a symbol specifying a group of
-characters, and @var{method} is a symbol specifying how to display
-them.
-
-@var{group} should be one of the following:
-
-@table @code
-@item c0-control
-@acronym{ASCII} control characters @code{U+0000} to @code{U+001F},
-excluding the newline and tab characters (normally displayed as escape
-sequences like @samp{^A}; @pxref{Text Display,, How Text Is Displayed,
-emacs, The GNU Emacs Manual}).
-
-@item c1-control
-Non-@acronym{ASCII}, non-printing characters @code{U+0080} to
-@code{U+009F} (normally displayed as octal escape sequences like
-@samp{\230}).
-
-@item format-control
-Characters of Unicode General Category `Cf', such as @samp{U+200E}
-(Left-to-Right Mark), but excluding characters that have graphic
-images, such as @samp{U+00AD} (Soft Hyphen).
-
-@item no-font
-Characters for there is no suitable font, or which cannot be encoded
-by the terminal's coding system.
-@end table
-
-@c FIXME: this can also be `acronym', but that's not currently
-@c completely implemented; it applies only to the format-control
-@c group, and only works if the acronym is in `char-acronym-table'.
-The @var{method} symbol should be one of @code{zero-width},
-@code{thin-space}, @code{empty-box}, or @code{hex-code}. These have
-the same meanings as in @code{glyphless-char-display}, above.
-@end defopt
diff --git a/doc/lispref/doclicense.texi b/doc/lispref/doclicense.texi
index 0c2d47827a9..cb71f05a175 100644
--- a/doc/lispref/doclicense.texi
+++ b/doc/lispref/doclicense.texi
@@ -1,15 +1,11 @@
-@c -*-texinfo-*-
@c The GNU Free Documentation License.
-@node GNU Free Documentation License, GPL, Antinews, Top
-
-@appendix GNU Free Documentation License
@center Version 1.3, 3 November 2008
@c This file is intended to be included within another document,
@c hence no sectioning command or @node.
@display
-Copyright @copyright{} 2000, 2001, 2002, 2007, 2008, 2009 Free Software Foundation, Inc.
+Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
@uref{http://fsf.org/}
Everyone is permitted to copy and distribute verbatim copies
@@ -96,16 +92,16 @@ An image format is not Transparent if used for any substantial amount
of text. A copy that is not ``Transparent'' is called ``Opaque''.
Examples of suitable formats for Transparent copies include plain
-@sc{ascii} without markup, Texinfo input format, La@TeX{} input
-format, @acronym{SGML} or @acronym{XML} using a publicly available
-@acronym{DTD}, and standard-conforming simple @acronym{HTML},
-PostScript or @acronym{PDF} designed for human modification. Examples
-of transparent image formats include @acronym{PNG}, @acronym{XCF} and
-@acronym{JPG}. Opaque formats include proprietary formats that can be
-read and edited only by proprietary word processors, @acronym{SGML} or
-@acronym{XML} for which the @acronym{DTD} and/or processing tools are
-not generally available, and the machine-generated @acronym{HTML},
-PostScript or @acronym{PDF} produced by some word processors for
+ASCII without markup, Texinfo input format, La@TeX{} input
+format, SGML or XML using a publicly available
+DTD, and standard-conforming simple HTML,
+PostScript or PDF designed for human modification. Examples
+of transparent image formats include PNG, XCF and
+JPG. Opaque formats include proprietary formats that can be
+read and edited only by proprietary word processors, SGML or
+XML for which the DTD and/or processing tools are
+not generally available, and the machine-generated HTML,
+PostScript or PDF produced by some word processors for
output purposes only.
The ``Title Page'' means, for a printed book, the title page itself,
@@ -485,7 +481,7 @@ license notices just after the title page:
@end smallexample
If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts,
-replace the ``with@dots{}Texts.'' line with this:
+replace the ``with@dots{}Texts.''@: line with this:
@smallexample
@group
@@ -504,7 +500,6 @@ recommend releasing these examples in parallel under your choice of
free software license, such as the GNU General Public License,
to permit their use in free software.
-
@c Local Variables:
@c ispell-local-pdict: "ispell-dict"
@c End:
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 391c22ba098..b5edda06bad 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -1,6 +1,6 @@
@comment -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1992-1994, 1998-1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1992-1994, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@c This file can also be used by an independent Edebug User
@@ -9,7 +9,7 @@
@c , Bugs and Todo List, Top, Top
-@node Edebug, Syntax Errors, Debugger, Debugging
+@node Edebug
@section Edebug
@cindex Edebug debugging facility
@@ -150,6 +150,7 @@ display a list of all Edebug commands.
@node Instrumenting
@subsection Instrumenting for Edebug
+@cindex instrumenting for Edebug
In order to use Edebug to debug Lisp code, you must first
@dfn{instrument} the code. Instrumenting code inserts additional code
@@ -179,9 +180,11 @@ to loading or evaluations in the minibuffer. The command @kbd{M-x
edebug-all-forms} toggles this option.
@findex edebug-eval-top-level-form
+@findex edebug-defun
Another command, @kbd{M-x edebug-eval-top-level-form}, is available to
instrument any top-level form regardless of the values of
@code{edebug-all-defs} and @code{edebug-all-forms}.
+@code{edebug-defun} is an alias for @code{edebug-eval-top-level-form}.
While Edebug is active, the command @kbd{I}
(@code{edebug-instrument-callee}) instruments the definition of the
@@ -214,6 +217,7 @@ evaluating forms that never instrument them: from a file with
If Edebug detects a syntax error while instrumenting, it leaves point
at the erroneous code and signals an @code{invalid-read-syntax} error.
+@c FIXME? I can't see that it "leaves point at the erroneous code".
@xref{Edebug Eval}, for other evaluation functions available
inside of Edebug.
@@ -239,6 +243,7 @@ least for a certain distance.
@item S
Stop: don't execute any more of the program, but wait for more
Edebug commands (@code{edebug-stop}).
+@c FIXME Does not work. http://debbugs.gnu.org/9764
@item @key{SPC}
Step: stop at the next stop point encountered (@code{edebug-step-mode}).
@@ -331,7 +336,8 @@ Run the program for one expression
Run the program until the end of the containing sexp (@code{edebug-step-out}).
@item i
-Step into the function or macro called by the form after point.
+Step into the function or macro called by the form after point
+(@code{edebug-step-in}).
@end table
The @kbd{h} command proceeds to the stop point at or after the current
@@ -619,14 +625,14 @@ back to the stop point in the source code buffer from any buffer using
saved outside window configuration---so that even if you turn saving
back @emph{on}, the current window configuration remains unchanged when
you next exit Edebug (by continuing the program). However, the
-automatic redisplay of @samp{*edebug*} and @samp{*edebug-trace*} may
+automatic redisplay of @file{*edebug*} and @file{*edebug-trace*} may
conflict with the buffers you wish to see unless you have enough windows
open.
@node Edebug Eval
@subsection Evaluation
- While within Edebug, you can evaluate expressions ``as if'' Edebug
+ While within Edebug, you can evaluate expressions as if Edebug
were not running. Edebug tries to be invisible to the expression's
evaluation and printing. Evaluation of expressions that cause side
effects will work as expected, except for changes to data that Edebug
@@ -653,22 +659,23 @@ Evaluate the expression before point, in the context outside of Edebug
lexically bound symbols created by the following constructs in
@file{cl.el}: @code{lexical-let}, @code{macrolet}, and
@code{symbol-macrolet}.
+@c FIXME? What about lexical-binding = t?
@node Eval List
@subsection Evaluation List Buffer
- You can use the @dfn{evaluation list buffer}, called @samp{*edebug*}, to
+ You can use the @dfn{evaluation list buffer}, called @file{*edebug*}, to
evaluate expressions interactively. You can also set up the
@dfn{evaluation list} of expressions to be evaluated automatically each
time Edebug updates the display.
@table @kbd
@item E
-Switch to the evaluation list buffer @samp{*edebug*}
+Switch to the evaluation list buffer @file{*edebug*}
(@code{edebug-visit-eval-list}).
@end table
- In the @samp{*edebug*} buffer you can use the commands of Lisp
+ In the @file{*edebug*} buffer you can use the commands of Lisp
Interaction mode (@pxref{Lisp Interaction,,, emacs, The GNU Emacs
Manual}) as well as these special commands:
@@ -695,7 +702,7 @@ Switch back to the source code buffer at the current stop point
@end table
You can evaluate expressions in the evaluation list window with
-@kbd{C-j} or @kbd{C-x C-e}, just as you would in @samp{*scratch*};
+@kbd{C-j} or @kbd{C-x C-e}, just as you would in @file{*scratch*};
but they are evaluated in the context outside of Edebug.
The expressions you enter interactively (and their results) are lost
@@ -754,8 +761,8 @@ the expression at a suitable place, insert a new comment line, then type
@kbd{C-c C-u}. You need not insert dashes in the comment line---its
contents don't matter.
-After selecting @samp{*edebug*}, you can return to the source code
-buffer with @kbd{C-c C-w}. The @samp{*edebug*} buffer is killed when
+After selecting @file{*edebug*}, you can return to the source code
+buffer with @kbd{C-c C-w}. The @file{*edebug*} buffer is killed when
you continue execution, and recreated next time it is needed.
@node Printing in Edebug
@@ -815,7 +822,7 @@ for details.
@cindex trace buffer
Edebug can record an execution trace, storing it in a buffer named
-@samp{*edebug-trace*}. This is a log of function calls and returns,
+@file{*edebug-trace*}. This is a log of function calls and returns,
showing the function names and their arguments and values. To enable
trace recording, set @code{edebug-trace} to a non-@code{nil} value.
@@ -971,8 +978,8 @@ unless @code{edebug-continue-kbd-macro} is non-@code{nil}.
@c needs an xref to be on just one line.
When Edebug needs to display something (e.g., in trace mode), it saves
the current window configuration from ``outside'' Edebug
-(@pxref{Window Configurations}). When you exit Edebug (by continuing
-the program), it restores the previous window configuration.
+(@pxref{Window Configurations}). When you exit Edebug, it restores
+the previous window configuration.
Emacs redisplays only when it pauses. Usually, when you continue
execution, the program re-enters Edebug at a breakpoint or after
@@ -1031,10 +1038,10 @@ The current match data. @xref{Match Data}.
@item
The variables @code{last-command}, @code{this-command},
-@code{last-input-event}, @code{last-command-event},
+@code{last-command-event}, @code{last-input-event},
@code{last-event-frame}, @code{last-nonmenu-event}, and
-@code{track-mouse}. Commands used within Edebug do not affect these
-variables outside of Edebug.
+@code{track-mouse}. Commands in Edebug do not affect these variables
+outside of Edebug.
Executing commands within Edebug can change the key sequence that
would be returned by @code{this-command-keys}, and there is no way to
@@ -1109,6 +1116,15 @@ definition, but specifications are much more general than macro
arguments. @xref{Defining Macros}, for more explanation of
the @code{declare} form.
+@c See eg http://debbugs.gnu.org/10577
+@c FIXME Maybe there should be an Edebug option to get it to
+@c automatically load the entire source file containing the function
+@c being instrumented. That would avoid this.
+ Take care to ensure that the specifications are known to Edebug when
+you instrument code. If you are instrumenting a function from a file
+that uses @code{eval-when-compile} to require another file containing
+macro definitions, you may need to explicitly load that file.
+
You can also define an edebug specification for a macro separately
from the macro definition with @code{def-edebug-spec}. Adding
@code{debug} declarations is preferred, and more convenient, for macro
@@ -1167,7 +1183,7 @@ modify the processing of all following elements. The latter, called
@dfn{specification keywords}, are symbols beginning with @samp{&} (such
as @code{&optional}).
-A specification list may contain sublists which match arguments that are
+A specification list may contain sublists, which match arguments that are
themselves lists, or it may contain vectors used for grouping. Sublists
and groups thus subdivide the specification list into a hierarchy of
levels. Specification keywords apply only to the remainder of the
@@ -1195,9 +1211,7 @@ A single unevaluated Lisp object, which is not instrumented.
A single evaluated expression, which is instrumented.
@item place
-@c I can't see that this index entry is useful without any explanation.
-@c @findex edebug-unwrap
-A place to store a value, as in the Common Lisp @code{setf} construct.
+A generalized variable. @xref{Generalized Variables}.
@item body
Short for @code{&rest form}. See @code{&rest} below.
@@ -1218,7 +1232,7 @@ A lambda expression with no quoting.
All following elements in the specification list are optional; as soon
as one does not match, Edebug stops matching at this level.
-To make just a few elements optional followed by non-optional elements,
+To make just a few elements optional, followed by non-optional elements,
use @code{[&optional @var{specs}@dots{}]}. To specify that several
elements must all match or none, use @code{&optional
[@var{specs}@dots{}]}. See the @code{defun} example.
@@ -1251,6 +1265,8 @@ Each of the following elements is matched as alternatives as if by using
of them match, nothing is matched, but the @code{&not} specification
succeeds.
+@c FIXME &key?
+
@item &define
@c @kindex &define @r{(Edebug)}
Indicates that the specification is for a defining form. The defining
@@ -1283,8 +1299,8 @@ arguments. The specification may be defined with @code{def-edebug-spec}
just as for macros. See the @code{defun} example.
Otherwise, the symbol should be a predicate. The predicate is called
-with the argument and the specification fails if the predicate returns
-@code{nil}, and the argument is not instrumented.
+with the argument, and if the predicate returns @code{nil}, the
+specification fails and the argument is not instrumented.
Some suitable predicates include @code{symbolp}, @code{integerp},
@code{stringp}, @code{vectorp}, and @code{atom}.
@@ -1418,7 +1434,15 @@ of the bindings is either a symbol or a sublist with a symbol and
optional expression. In the specification below, notice the @code{gate}
inside of the sublist to prevent backtracking once a sublist is found.
-@c FIXME? The actual definition in edebug.el does not have a gate.
+@ignore
+@c FIXME? The actual definition in edebug.el looks like this (and always
+@c has AFAICS). In fact, nothing in edebug.el uses gate. So maybe
+@c this is just an example for illustration?
+(def-edebug-spec let
+ ((&rest
+ &or (symbolp &optional form) symbolp)
+ body))
+@end ignore
@example
(def-edebug-spec let
((&rest
@@ -1479,8 +1503,8 @@ could fail.)
@defopt edebug-setup-hook
Functions to call before Edebug is used. Each time it is set to a new
value, Edebug will call those functions once and then
-@code{edebug-setup-hook} is reset to @code{nil}. You could use this to
-load up Edebug specifications associated with a package you are using
+reset @code{edebug-setup-hook} to @code{nil}. You could use this to
+load up Edebug specifications associated with a package you are using,
but only when you also use Edebug.
@xref{Instrumenting}.
@end defopt
@@ -1544,7 +1568,7 @@ The default value is @code{step}.
@defopt edebug-trace
If this is non-@code{nil}, trace each function entry and exit.
-Tracing output is displayed in a buffer named @samp{*edebug-trace*}, one
+Tracing output is displayed in a buffer named @file{*edebug-trace*}, one
function entry or exit per line, indented by the recursion level.
Also see @code{edebug-tracing}, in @ref{Trace Buffer}.
@@ -1562,7 +1586,28 @@ debugged.
@xref{Edebug Execution Modes}.
@end defopt
-@c FIXME edebug-unwrap-results
+@defopt edebug-unwrap-results
+If non-@code{nil}, Edebug tries to remove any of its own
+instrumentation when showing the results of expressions. This is
+relevant when debugging macros where the results of expressions are
+themselves instrumented expressions. As a very artificial example,
+suppose that the example function @code{fac} has been instrumented,
+and consider a macro of the form:
+
+@c FIXME find a less silly example.
+@smallexample
+(defmacro test () "Edebug example."
+ (if (symbol-function 'fac)
+ @dots{}))
+@end smallexample
+
+If you instrument the @code{test} macro and step through it, then by
+default the result of the @code{symbol-function} call has numerous
+@code{edebug-after} and @code{edebug-before} forms, which can make it
+difficult to see the ``actual'' result. If
+@code{edebug-unwrap-results} is non-@code{nil}, Edebug tries to remove
+these forms from the result.
+@end defopt
@defopt edebug-on-error
Edebug binds @code{debug-on-error} to this value, if
diff --git a/doc/lispref/elisp-covers.texi b/doc/lispref/elisp-covers.texi
deleted file mode 100644
index 92dfb7a074f..00000000000
--- a/doc/lispref/elisp-covers.texi
+++ /dev/null
@@ -1,252 +0,0 @@
-\input texinfo @c -*-texinfo-*-
-@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 2001-2011 Free Software Foundation, Inc.
-@c See the file elisp.texi for copying conditions.
-@c
-@comment %**start of header
-@setfilename covers.info
-@settitle GNU Emacs Lisp Reference Manual
-@comment %**end of header
-
-@titlepage
-@c ================ Volume 1 ================
-@w{ }
-@sp 2
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 1}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-@page
-@c ================ Volume 2 ================
-@w{ }
-@sp 5
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 2}
-@sp 2
-@center by Bil Lewis,
-@center Dan LaLiberte, and
-@center the GNU Manual Group
-
-@page
-@c ================ Volume 1 with baseline skip 16pt ================
-
-@tex
-\global\baselineskip = 16pt
-@end tex
-
-16 pts baseline skip:
-
-@w{ }
-@sp 2
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 1}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-@page
-@c ================ Volume 1 with baseline skip 18pt ================
-
-@tex
-\global\baselineskip = 18pt
-@end tex
-
-18 pts baseline skip, with 15pts between sections
-
-@w{ }
-@sp 2
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@tex
-\global\baselineskip = 15pt
-@end tex
-
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 1}
-@sp 2
-@center by Bil Lewis,
-@center Dan LaLiberte, and
-@center the GNU Manual Group
-
-@page
-@c ================ Volume 1 with more baseline skip 24 pts ================
-
-@tex
-\global\baselineskip = 24pt
-@end tex
-
-24 pts baseline skip:
-
-@w{ }
-@sp 2
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 1}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-@page
-@c ================ Volume 2 with more baseline skip 18 pts ================
-
-@tex
-\global\baselineskip = 18pt
-@end tex
-
-18 pts baseline skip:
-
-@w{ }
-@sp 5
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 2}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-@page
-@c ================ Volume 2 with more baseline skip 24 pts ================
-
-@tex
-\global\baselineskip = 24pt
-@end tex
-
-24 pts baseline skip:
-
-@w{ }
-@sp 5
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 2}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-
-@page
-@c ================ Spine 1 ================
-
-@w{@titlefont{The GNU Emacs Lisp Reference Manual --- Vol. 1}}
-@sp 4
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 4
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-@sp 4
-@author The GNU Emacs Lisp Reference Manual --- Vol. 1
-@sp 3
-@author FSF
-
-@author
-
-@page
-@c ================ Spine 2 ================
-
-@w{@titlefont{The GNU Emacs Lisp Reference Manual --- Vol. 2}}
-@sp 4
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 4
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-
-@sp 4
-@author The GNU Emacs Lisp Reference Manual --- Vol. 2
-@sp 3
-@author FSF
-
-@end titlepage
-@bye
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index 98eaf1f8ade..371593f7203 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -1,20 +1,71 @@
\input texinfo @c -*-texinfo-*-
@c %**start of header
@setfilename elisp
+
+@ifset VOL1
+@set volflag
+@set voltitle Volume 1
+@end ifset
+
+@ifset VOL2
+@set volflag
+@set voltitle Volume 2
+@end ifset
+
+@ifset volflag
+@settitle GNU Emacs Lisp Reference Manual: @value{voltitle}
+@end ifset
+@ifclear volflag
@settitle GNU Emacs Lisp Reference Manual
+@end ifclear
+
@c %**end of header
+@c See two-volume-cross-refs.txt.
+@tex
+@ifset VOL1
+\message{Formatting for two volume edition...Volume 1...}
+%
+% Read special toc file, set up in two-volume.make.
+\gdef\tocreadfilename{elisp1-toc-ready.toc}
+%
+% Don't make outlines, they're not needed and \readdatafile can't pay
+% attention to the special definition above.
+\global\let\pdfmakeoutlines=\relax
+%
+% Start volume 1 chapter numbering at 1; this must be listed as chapno0.
+\global\chapno=0
+@end ifset
+@ifset VOL2
+\message{Formatting for two volume edition...Volume 2...}
+%
+% Read special toc file, set up in two-volume.make.
+\gdef\tocreadfilename{elisp2-toc-ready.toc}
+%
+% Don't make outlines, they're not needed and \readdatafile can't pay
+% attention to the special definition above.
+\global\let\pdfmakeoutlines=\relax
+%
+% Start volume 2 chapter numbering at 27; this must be listed as chapno26
+\global\chapno=26
+@end ifset
+@end tex
+
+
@c Version of the manual and of Emacs.
-@c Please remember to update the edition number in README as well.
-@c And also the copies in vol1.texi and vol2.texi.
-@set VERSION 3.0
+@c (See comments for EDITION in emacs.texi)
+@set VERSION 3.1
@include emacsver.texi
-@set DATE July 2009
+@set DATE May 2012
@c in general, keep the following line commented out, unless doing a
@c copy of this manual that will be published. The manual should go
@c onto the distribution in the full, 8.5 x 11" size.
-@c @smallbook
+@c @set smallbook
+
+@ifset volflag
+@smallbook
+@end ifset
@ifset smallbook
@smallbook
@@ -26,8 +77,6 @@
@tex
@ifset smallbook
@fonttextsize 10
-\global\let\urlcolor=\Black % don't print links in grayscale
-\global\let\linkcolor=\Black
@end ifset
\global\hbadness=6666 % don't worry about not-too-underfull boxes
@end tex
@@ -41,11 +90,15 @@
@c @syncodeindex tp fn
@copying
-This is edition @value{VERSION} of the GNU Emacs Lisp Reference Manual,@*
+@iftex
+This is edition @value{VERSION} of the @cite{GNU Emacs Lisp Reference Manual},@*
+@end iftex
+@ifnottex
+This is the @cite{GNU Emacs Lisp Reference Manual}
+@end ifnottex
corresponding to Emacs version @value{EMACSVER}.
-Copyright @copyright{} 1990-1996, 1998-2011 Free Software
-Foundation, Inc.
+Copyright @copyright{} 1990-1996, 1998-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -71,11 +124,14 @@ developing GNU and promoting software freedom.''
@titlepage
@title GNU Emacs Lisp Reference Manual
+@ifset volflag
+@subtitle @value{voltitle}
+@end ifset
@subtitle For Emacs Version @value{EMACSVER}
@subtitle Revision @value{VERSION}, @value{DATE}
-@author by Bil Lewis, Dan LaLiberte, Richard Stallman
-@author and the GNU Manual Group
+@author by Bil Lewis, Dan LaLiberte, Richard Stallman,
+@author the GNU Manual Group, et al.
@page
@vskip 0pt plus 1filll
@insertcopying
@@ -98,13 +154,12 @@ Cover art by Etienne Suvasa.
@ifnottex
-@node Top, Introduction, (dir), (dir)
+@node Top
@top Emacs Lisp
@insertcopying
@end ifnottex
-@c Copy any updates to vol1.texi and vol2.texi.
@menu
* Introduction:: Introduction and conventions used.
@@ -124,7 +179,7 @@ Cover art by Etienne Suvasa.
* Functions:: A function is a Lisp program
that can be invoked from other functions.
* Macros:: Macros are a way to extend the Lisp language.
-* Customization:: Writing customization declarations.
+* Customization:: Making variables and faces customizable.
* Loading:: Reading files of Lisp code into Lisp.
* Byte Compilation:: Compilation makes programs run faster.
@@ -164,17 +219,15 @@ Cover art by Etienne Suvasa.
Appendices
-* Antinews:: Info for users downgrading to Emacs 22.
+* Antinews:: Info for users downgrading to Emacs 23.
* GNU Free Documentation License:: The license for this documentation.
* GPL:: Conditions for copying and changing GNU Emacs.
* Tips:: Advice and coding conventions for Emacs Lisp.
* GNU Emacs Internals:: Building and dumping Emacs;
internal data structures.
-* Standard Errors:: List of all error symbols.
-* Standard Buffer-Local Variables::
- List of variables buffer-local in all buffers.
-* Standard Keymaps:: List of standard keymaps.
-* Standard Hooks:: List of standard hook variables.
+* Standard Errors:: List of some standard error symbols.
+* Standard Keymaps:: List of some standard keymaps.
+* Standard Hooks:: List of some standard hook variables.
* Index:: Index including concepts, functions, variables,
and other terms.
@@ -187,7 +240,6 @@ Appendices
@c be correctly identified by `texinfo-multiple-files-update'. In
@c particular, the detailed menu header line MUST be identical to the
@c value of `texinfo-master-menu-header'. See texnfo-upd.el.
-@c Copy any updates to vol1.texi and vol2.texi.
@detailmenu
--- The Detailed Node Listing ---
@@ -202,7 +254,7 @@ Introduction
* Lisp History:: Emacs Lisp is descended from Maclisp.
* Conventions:: How the manual is formatted.
* Version Info:: Which Emacs version is running?
-* Acknowledgements:: The authors, editors, and sponsors of this manual.
+* Acknowledgments:: The authors, editors, and sponsors of this manual.
Conventions
@@ -326,7 +378,6 @@ Lists
* Modifying Lists:: Storing new pieces into an existing list.
* Sets And Lists:: A list can represent a finite mathematical set.
* Association Lists:: A list can represent a finite relation or mapping.
-* Rings:: Managing a fixed-size ring of objects.
Modifying Existing List Structure
@@ -344,6 +395,7 @@ Sequences, Arrays, and Vectors
* Vector Functions:: Functions specifically for vectors.
* Char-Tables:: How to work with char-tables.
* Bool-Vectors:: How to work with bool-vectors.
+* Rings:: Managing a fixed-size ring of objects.
Hash Tables
@@ -374,6 +426,7 @@ Evaluation
* Forms:: How various sorts of objects are evaluated.
* Quoting:: Avoiding evaluation (to put constants in
the program).
+* Backquote:: Easier construction of list structure.
* Eval:: How to invoke the Lisp interpreter explicitly.
Kinds of Forms
@@ -433,15 +486,14 @@ Variables
* Variable Aliases:: Variables that are aliases for other variables.
* Variables with Restricted Values:: Non-constant variables whose value can
@emph{not} be an arbitrary Lisp object.
+* Generalized Variables:: Extending the concept of variables.
Scoping Rules for Variable Bindings
-* Scope:: Scope means where in the program a value
- is visible. Comparison with other languages.
-* Extent:: Extent means how long in time a value exists.
-* Impl of Scope:: Two ways to implement dynamic scoping.
-* Using Scoping:: How to use dynamic scoping carefully and
- avoid problems.
+* Dynamic Binding:: The default for binding local variables in Emacs.
+* Dynamic Binding Tips:: Avoiding problems with dynamic binding.
+* Lexical Binding:: A different type of local variable binding.
+* Using Lexical Binding:: How to enable lexical binding.
Buffer-Local Variables
@@ -450,6 +502,11 @@ Buffer-Local Variables
* Default Value:: The default value is seen in buffers
that don't have their own buffer-local values.
+Generalized Variables
+
+* Setting Generalized Variables:: The @code{setf} macro.
+* Adding Generalized Variables:: Defining new @code{setf} forms.
+
Functions
* What Is a Function:: Lisp functions vs. primitives; terminology.
@@ -461,9 +518,11 @@ Functions
* Anonymous Functions:: Lambda expressions are functions with no names.
* Function Cells:: Accessing or setting the function definition
of a symbol.
+* Closures:: Functions that enclose a lexical environment.
* Obsolete Functions:: Declaring functions obsolete.
* Inline Functions:: Defining functions that the compiler
- will open code.
+ will expand inline.
+* Declare Form:: Adding additional information about a function.
* Declaring Functions:: Telling the compiler that a function is defined.
* Function Safety:: Determining whether a function is safe to call.
* Related Topics:: Cross-references to specific Lisp primitives
@@ -483,7 +542,6 @@ Macros
* Expansion:: How, when and why macros are expanded.
* Compiling Macros:: How macros are expanded by the compiler.
* Defining Macros:: How to write a macro definition.
-* Backquote:: Easier construction of list structure.
* Problems with Macros:: Don't evaluate the macro arguments too many times.
Don't hide the user's variables.
* Indenting Macros:: Specifying how to indent macro calls.
@@ -497,13 +555,15 @@ Common Problems Using Macros
* Eval During Expansion:: Don't evaluate them; put them in the expansion.
* Repeated Expansion:: Avoid depending on how many times expansion is done.
-Writing Customization Definitions
+Customization Settings
* Common Keywords:: Common keyword arguments for all kinds of
customization declarations.
* Group Definitions:: Writing customization group definitions.
* Variable Definitions:: Declaring user options.
* Customization Types:: Specifying the type of a user option.
+* Applying Customizations:: Functions to apply customization settings.
+* Custom Themes:: Writing Custom themes.
Customization Types
@@ -549,17 +609,15 @@ Advising Emacs Lisp Functions
* Preactivation:: Preactivation is a way of speeding up the
loading of compiled advice.
* Argument Access in Advice:: How advice can access the function's arguments.
-* Advising Primitives:: Accessing arguments when advising a primitive.
* Combined Definition:: How advice is implemented.
Debugging Lisp Programs
-* Debugger:: How the Emacs Lisp debugger is implemented.
+* Debugger:: A debugger for the Emacs Lisp evaluator.
* Edebug:: A source-level Emacs Lisp debugger.
* Syntax Errors:: How to find syntax errors.
* Test Coverage:: Ensuring you have tested all branches in your code.
-* Compilation Errors:: How to find errors that show up in
- byte compilation.
+* Profiling:: Measuring the resources that your code uses.
The Lisp Debugger
@@ -642,8 +700,8 @@ Minibuffers
* Multiple Queries:: Asking a series of similar questions.
* Reading a Password:: Reading a password from the terminal.
* Minibuffer Commands:: Commands used as key bindings in minibuffers.
-* Minibuffer Contents:: How such commands access the minibuffer text.
* Minibuffer Windows:: Operating on the special minibuffer windows.
+* Minibuffer Contents:: How such commands access the minibuffer text.
* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
* Minibuffer Misc:: Various customization hooks and variables.
@@ -653,11 +711,12 @@ Completion
* Minibuffer Completion:: Invoking the minibuffer with completion.
* Completion Commands:: Minibuffer commands that do completion.
* High-Level Completion:: Convenient special cases of completion
- (reading buffer name, file name, etc.).
+ (reading buffer names, variable names, etc.).
* Reading File Names:: Using completion to read file names and
shell commands.
-* Completion Styles:: Specifying rules for performing completion.
-* Programmed Completion:: Writing your own completion-function.
+* Completion Variables:: Variables controlling completion behavior.
+* Programmed Completion:: Writing your own completion function.
+* Completion in Buffers:: Completing text in ordinary buffers.
Command Loop
@@ -748,14 +807,12 @@ Menu Keymaps
* Menu Bar:: How to customize the menu bar.
* Tool Bar:: A tool bar is a row of images.
* Modifying Menus:: How to add new items to a menu.
+* Easy Menu:: A convenience macro for defining menus.
Defining Menus
-* Simple Menu Items:: A simple kind of menu key binding,
- limited in capabilities.
-* Extended Menu Items:: More powerful menu item definitions
- let you specify keywords to enable
- various features.
+* Simple Menu Items:: A simple kind of menu key binding.
+* Extended Menu Items:: More complex menu item definitions.
* Menu Separators:: Drawing a horizontal line through a menu.
* Alias Menu Items:: Using command aliases in menu items.
@@ -767,6 +824,7 @@ Major and Minor Modes
* Mode Line Format:: Customizing the text that appears in the mode line.
* Imenu:: Providing a menu of definitions made in a buffer.
* Font Lock Mode:: How modes can highlight text according to syntax.
+* Auto-Indentation:: How to teach Emacs to indent for a major mode.
* Desktop Save Mode:: How modes can have buffer state saved between
Emacs sessions.
@@ -783,9 +841,10 @@ Major Modes
* Derived Modes:: Defining a new major mode based on another major
mode.
* Basic Major Modes:: Modes that other modes are often derived from.
+* Mode Hooks:: Hooks run at the end of major mode functions.
+* Tabulated List Mode:: Parent mode for buffers containing tabulated data.
* Generic Modes:: Defining a simple major mode that supports
comment syntax and Font Lock mode.
-* Mode Hooks:: Hooks run at the end of major mode functions.
* Example Major Modes:: Text mode and Lisp modes.
Minor Modes
@@ -817,8 +876,6 @@ Font Lock Mode
contents can also specify how to fontify it.
* Faces for Font Lock:: Special faces specifically for Font Lock.
* Syntactic Font Lock:: Fontification based on syntax tables.
-* Setting Syntax Properties:: Defining character syntax based on context
- using the Font Lock mechanism.
* Multiline Font Lock:: How to coerce Font Lock into properly
highlighting multiline constructs.
@@ -828,10 +885,24 @@ Multiline Font Lock Constructs
* Region to Refontify:: Controlling which region gets refontified
after a buffer change.
+Automatic Indentation of code
+
+* SMIE:: A simple minded indentation engine.
+
+Simple Minded Indentation Engine
+
+* SMIE setup:: SMIE setup and features.
+* Operator Precedence Grammars:: A very simple parsing technique.
+* SMIE Grammar:: Defining the grammar of a language.
+* SMIE Lexer:: Defining tokens.
+* SMIE Tricks:: Working around the parser's limitations.
+* SMIE Indentation:: Specifying indentation rules.
+* SMIE Indentation Helpers:: Helper functions for indentation rules.
+* SMIE Indentation Example:: Sample indentation rules.
+
Documentation
-* Documentation Basics:: Good style for doc strings.
- Where to put them. How Emacs stores them.
+* Documentation Basics:: Where doc strings are defined and stored.
* Accessing Documentation:: How Lisp programs can access doc strings.
* Keys in Documentation:: Substituting current key bindings.
* Describing Characters:: Making printable descriptions of
@@ -847,12 +918,11 @@ Files
* File Locks:: Locking and unlocking files, to prevent
simultaneous editing by two people.
* Information about Files:: Testing existence, accessibility, size of files.
-* Changing Files:: Renaming files, changing protection, etc.
+* Changing Files:: Renaming files, changing permissions, etc.
* File Names:: Decomposing and expanding file names.
* Contents of Directories:: Getting a list of the files in a directory.
* Create/Delete Dirs:: Creating and Deleting Directories.
-* Magic File Names:: Defining "magic" special handling
- for certain file names.
+* Magic File Names:: Special handling for certain file names.
* Format Conversion:: Conversion to and from various file formats.
Visiting Files
@@ -913,7 +983,7 @@ Buffers
is visited.
* Buffer Modification:: A buffer is @dfn{modified} if it needs to be saved.
* Modification Time:: Determining whether the visited file was changed
- ``behind Emacs's back''.
+ "behind Emacs's back".
* Read Only Buffers:: Modifying text is not allowed in a
read-only buffer.
* The Buffer List:: How to look at all the existing buffers.
@@ -932,6 +1002,8 @@ Windows
* Resizing Windows:: Changing the sizes of windows.
* Splitting Windows:: Splitting one window into two windows.
* Deleting Windows:: Deleting a window gives its space to other windows.
+* Recombining Windows:: Preserving the frame layout when splitting and
+ deleting windows.
* Selecting Windows:: The selected window is the one that you edit in.
* Cyclic Window Ordering:: Moving around the existing windows.
* Buffers and Windows:: Each window displays the contents of a buffer.
@@ -980,7 +1052,7 @@ Frames
* Window System Selections::Transferring text to and from other X clients.
* Drag and Drop:: Internals of Drag-and-Drop implementation.
* Color Names:: Getting the definitions of color names.
-* Text Terminal Colors:: Defining colors for text-only terminals.
+* Text Terminal Colors:: Defining colors for text terminals.
* Resources:: Getting resource values from the server.
* Display Feature Testing:: Determining the features of a terminal.
@@ -1058,11 +1130,12 @@ Text
* Case Changes:: Case conversion of parts of the buffer.
* Text Properties:: Assigning Lisp property lists to text characters.
* Substitution:: Replacing a given character wherever it appears.
-* Transposition:: Swapping two portions of a buffer.
* Registers:: How registers are implemented. Accessing
the text or position stored in a register.
+* Transposition:: Swapping two portions of a buffer.
* Base 64:: Conversion to or from base 64 encoding.
-* MD5 Checksum:: Compute the MD5 "message digest"/"checksum".
+* Checksum/Hash:: Computing cryptographic hashes.
+* Parsing HTML/XML:: Parsing HTML and XML.
* Atomic Changes:: Installing several buffer changes "atomically".
* Change Hooks:: Supplying functions to be run when text is changed.
@@ -1175,7 +1248,6 @@ Syntax Tables
* Motion and Syntax:: Moving over characters with certain syntaxes.
* Parsing Expressions:: Parsing balanced expressions
using the syntax table.
-* Standard Syntax Tables:: Syntax tables used by various major modes.
* Syntax Table Internals:: How syntax table information is stored.
* Categories:: Another way of classifying character syntax.
@@ -1194,7 +1266,6 @@ Parsing Expressions
Abbrevs and Abbrev Expansion
-* Abbrev Mode:: Setting up Emacs for abbreviation.
* Abbrev Tables:: Creating and working with abbrev tables.
* Defining Abbrevs:: Specifying abbreviations and their expansions.
* Abbrev Files:: Saving abbrevs in files.
@@ -1226,8 +1297,7 @@ Processes
* Datagrams:: UDP network connections.
* Low-Level Network:: Lower-level but more general function
to create connections and servers.
-* Misc Network:: Additional relevant functions for
- network connections.
+* Misc Network:: Additional relevant functions for net connections.
* Serial Ports:: Communicating with serial ports.
* Byte Packing:: Using bindat to pack and unpack binary data.
@@ -1271,16 +1341,13 @@ Emacs Display
* Display Property:: Enabling special display features.
* Images:: Displaying images in Emacs buffers.
* Buttons:: Adding clickable buttons to Emacs buffers.
-* Abstract Display:: Emacs' Widget for Object Collections.
+* Abstract Display:: Emacs's Widget for Object Collections.
* Blinking:: How Emacs shows the matching open parenthesis.
-* Usual Display:: The usual conventions for displaying
- nonprinting chars.
-* Display Tables:: How to specify other conventions.
+* Character Display:: How Emacs displays individual characters.
* Beeping:: Audible signal to the user.
* Window Systems:: Which window system is being used.
* Bidirectional Display:: Display of bidirectional scripts, such as
Arabic and Farsi.
-* Glyphless Chars:: How glyphless characters are drawn.
The Echo Area
@@ -1295,6 +1362,7 @@ Reporting Warnings
* Warning Variables:: Variables programs bind to customize
their warnings.
* Warning Options:: Variables users set to control display of warnings.
+* Delayed Warnings:: Deferring a warning until the end of a command.
Overlays
@@ -1305,8 +1373,8 @@ Overlays
Faces
-* Defining Faces:: How to define a face with @code{defface}.
* Face Attributes:: What is in a face?
+* Defining Faces:: How to define a face.
* Attribute Functions:: Functions to examine and set face attributes.
* Displaying Faces:: How Emacs combines the faces specified for
a character.
@@ -1349,10 +1417,12 @@ Images
* GIF Images:: Special features for GIF format.
* TIFF Images:: Special features for TIFF format.
* PostScript Images:: Special features for PostScript format.
+* ImageMagick Images:: Special features available through ImageMagick.
* Other Image Types:: Various other formats are supported.
* Defining Images:: Convenient ways to define an image for later use.
* Showing Images:: Convenient ways to display an image once
it is defined.
+* Animated Images:: Some image formats can be animated.
* Image Cache:: Internal mechanisms of image display.
Buttons
@@ -1368,11 +1438,13 @@ Abstract Display
* Abstract Display Functions:: Functions in the Ewoc package.
* Abstract Display Example:: Example of using Ewoc.
-Display Tables
+Character Display
-* Display Table Format:: What a display table consists of.
-* Active Display Table:: How Emacs selects a display table to use.
-* Glyphs:: How to define a glyph, and what glyphs mean.
+* Usual Display:: The usual conventions for displaying characters.
+* Display Tables:: What a display table consists of.
+* Active Display Table:: How Emacs selects a display table to use.
+* Glyphs:: How to define a glyph, and what glyphs mean.
+* Glyphless Chars:: How glyphless characters are drawn.
Operating System Interface
@@ -1398,13 +1470,8 @@ Operating System Interface
* Batch Mode:: Running Emacs without terminal interaction.
* Session Management:: Saving and restoring state with
X Session Management.
-
-Preparing Lisp code for distribution
-
-* Packaging Basics:: The basic concepts of Emacs Lisp packages.
-* Simple Packages:: How to package a single .el file.
-* Multi-file Packages:: How to package multiple files.
-* Package Archives:: Maintaining package archives.
+* Notifications:: Desktop notifications.
+* Dynamic Libraries:: On-demand loading of support libraries.
Starting Up Emacs
@@ -1424,6 +1491,13 @@ Terminal Input
* Input Modes:: Options for how input is processed.
* Recording Input:: Saving histories of recent or all input events.
+Preparing Lisp code for distribution
+
+* Packaging Basics:: The basic concepts of Emacs Lisp packages.
+* Simple Packages:: How to package a single .el file.
+* Multi-file Packages:: How to package multiple files.
+* Package Archives:: Maintaining package archives.
+
Tips and Conventions
* Coding Conventions:: Conventions for clean and robust programs.
@@ -1452,6 +1526,7 @@ Object Internals
@end detailmenu
@end menu
+@ifclear VOL2
@include intro.texi
@include objects.texi
@include numbers.texi
@@ -1485,6 +1560,12 @@ Object Internals
@include files.texi
@include backups.texi
+
+@end ifclear
+
+@c ================ Beginning of Volume 2 ================
+@ifclear VOL1
+
@include buffers.texi
@include windows.texi
@include frames.texi
@@ -1504,26 +1585,27 @@ Object Internals
@include package.texi
-@c MOVE to Emacs Manual: include misc-modes.texi
-
@c appendices
-@c REMOVE this: include non-hacker.texi
-
@include anti.texi
+@node GNU Free Documentation License
+@appendix GNU Free Documentation License
@include doclicense.texi
+@node GPL
+@appendix GNU General Public License
@include gpl.texi
@include tips.texi
@include internals.texi
@include errors.texi
-@include locals.texi
@include maps.texi
@include hooks.texi
@include index.texi
+@end ifclear
+
@ignore
-@node New Symbols, , Index, Top
+@node New Symbols
@unnumbered New Symbols Since the Previous Edition
@printindex tp
diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index 98967b708b3..b92fd9ed665 100644
--- a/doc/lispref/errors.texi
+++ b/doc/lispref/errors.texi
@@ -1,13 +1,12 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1993, 1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1993, 1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/errors
-@node Standard Errors, Standard Buffer-Local Variables, GNU Emacs Internals, Top
+@node Standard Errors
@appendix Standard Errors
@cindex standard errors
- Here is the complete list of the error symbols in standard Emacs,
+ Here is a list of the more important error symbols in standard Emacs,
grouped by concept. The list includes each symbol's message (on the
@code{error-message} property of the symbol) and a cross reference to a
description of how the error can occur.
@@ -24,67 +23,83 @@ conditions, that means it has none.
As a special exception, the error symbol @code{quit} does not have the
condition @code{error}, because quitting is not considered an error.
+@c You can grep for "(put 'foo 'error-conditions ...) to find
+@c examples defined in Lisp. Eg soap-client.el, sasl.el.
+ Most of these error symbols are defined in C (mainly @file{data.c}),
+but some are defined in Lisp. For example, the file @file{userlock.el}
+defines the @code{file-locked} and @code{file-supersession} errors.
+Several of the specialized Lisp libraries distributed with Emacs
+define their own error symbols. We do not attempt to list of all
+those here.
+
@xref{Errors}, for an explanation of how errors are generated and
handled.
@table @code
@item error
-@code{"error"}@*
-@xref{Errors}.
+The message is @samp{error}. @xref{Errors}.
@item quit
-@code{"Quit"}@*
-@xref{Quitting}.
+The message is @samp{Quit}. @xref{Quitting}.
@item args-out-of-range
-@code{"Args out of range"}@*
-This happens when trying to access an element beyond the range of a
-sequence or buffer.@*
-@xref{Sequences Arrays Vectors}, @xref{Text}.
+The message is @samp{Args out of range}. This happens when trying to
+access an element beyond the range of a sequence, buffer, or other
+container-like object. @xref{Sequences Arrays Vectors}, and
+@xref{Text}.
@item arith-error
-@code{"Arithmetic error"}@*
+The message is @samp{Arithmetic error}. This occurs when trying to
+perform integer division by zero. @xref{Numeric Conversions}, and
@xref{Arithmetic Operations}.
@item beginning-of-buffer
-@code{"Beginning of buffer"}@*
-@xref{Character Motion}.
+The message is @samp{Beginning of buffer}. @xref{Character Motion}.
@item buffer-read-only
-@code{"Buffer is read-only"}@*
-@xref{Read Only Buffers}.
+The message is @samp{Buffer is read-only}. @xref{Read Only Buffers}.
+
+@item circular-list
+The message is @samp{List contains a loop}. This happens when a
+circular structure is encountered. @xref{Circular Objects}.
+
+@item cl-assertion-failed
+The message is @samp{Assertion failed}. This happens when the
+@code{cl-assert} macro fails a test. @xref{Assertions,,, cl, Common Lisp
+Extensions}.
@item coding-system-error
-@code{"Invalid coding system"}@*
-@xref{Lisp and Coding Systems}.
+The message is @samp{Invalid coding system}. @xref{Lisp and Coding
+Systems}.
@item cyclic-function-indirection
-@code{"Symbol's chain of function indirections contains a loop"}@*
-@xref{Function Indirection}.
+The message is @samp{Symbol's chain of function indirections contains
+a loop}. @xref{Function Indirection}.
@item cyclic-variable-indirection
-@code{"Symbol's chain of variable indirections contains a loop"}@*
-@xref{Variable Aliases}.
+The message is @samp{Symbol's chain of variable indirections contains
+a loop}. @xref{Variable Aliases}.
+
+@item dbus-error
+The message is @samp{D-Bus error}. This is only defined if Emacs was
+compiled with D-Bus support. @xref{Errors and Events,,, dbus, D-Bus
+integration in Emacs}.
@item end-of-buffer
-@code{"End of buffer"}@*
-@xref{Character Motion}.
+The message is @samp{End of buffer}. @xref{Character Motion}.
@item end-of-file
-@code{"End of file during parsing"}@*
-Note that this is not a subcategory of @code{file-error},
-because it pertains to the Lisp reader, not to file I/O.@*
-@xref{Input Functions}.
+The message is @samp{End of file during parsing}. Note that this is
+not a subcategory of @code{file-error}, because it pertains to the
+Lisp reader, not to file I/O. @xref{Input Functions}.
@item file-already-exists
-This is a subcategory of @code{file-error}.@*
-@xref{Writing to Files}.
+This is a subcategory of @code{file-error}. @xref{Writing to Files}.
@item file-date-error
This is a subcategory of @code{file-error}. It occurs when
@code{copy-file} tries and fails to set the last-modification time of
-the output file.@*
-@xref{Changing Files}.
+the output file. @xref{Changing Files}.
@item file-error
We do not list the error-strings of this error and its subcategories,
@@ -92,110 +107,112 @@ because the error message is normally constructed from the data items
alone when the error condition @code{file-error} is present. Thus,
the error-strings are not very relevant. However, these error symbols
do have @code{error-message} properties, and if no data is provided,
-the @code{error-message} property @emph{is} used.@*
-@xref{Files}.
+the @code{error-message} property @emph{is} used. @xref{Files}.
+@c jka-compr.el
+@item compression-error
+This is a subcategory of @code{file-error}, which results from
+problems handling a compressed file. @xref{How Programs Do Loading}.
+
+@c userlock.el
@item file-locked
-This is a subcategory of @code{file-error}.@*
-@xref{File Locks}.
+This is a subcategory of @code{file-error}. @xref{File Locks}.
+@c userlock.el
@item file-supersession
-This is a subcategory of @code{file-error}.@*
-@xref{Modification Time}.
+This is a subcategory of @code{file-error}. @xref{Modification Time}.
+@c net/ange-ftp.el
@item ftp-error
-This is a subcategory of @code{file-error}, which results from problems
-in accessing a remote file using ftp.@*
-@xref{Remote Files,,, emacs, The GNU Emacs Manual}.
+This is a subcategory of @code{file-error}, which results from
+problems in accessing a remote file using ftp. @xref{Remote Files,,,
+emacs, The GNU Emacs Manual}.
@item invalid-function
-@code{"Invalid function"}@*
-@xref{Function Indirection}.
+The message is @samp{Invalid function}. @xref{Function Indirection}.
@item invalid-read-syntax
-@code{"Invalid read syntax"}@*
-@xref{Printed Representation}.
+The message is @samp{Invalid read syntax}. @xref{Printed
+Representation}.
@item invalid-regexp
-@code{"Invalid regexp"}@*
-@xref{Regular Expressions}.
+The message is @samp{Invalid regexp}. @xref{Regular Expressions}.
+@c simple.el
@item mark-inactive
-@code{"The mark is not active now"}@*
-@xref{The Mark}.
+The message is @samp{The mark is not active now}. @xref{The Mark}.
@item no-catch
-@code{"No catch for tag"}@*
-@xref{Catch and Throw}.
+The message is @samp{No catch for tag}. @xref{Catch and Throw}.
+
+@ignore
+@c Not actually used for anything? Probably definition should be removed.
+@item protected-field
+The message is @samp{Attempt to modify a protected file}.
+@end ignore
@item scan-error
-@code{"Scan error"}@*
-This happens when certain syntax-parsing functions
-find invalid syntax or mismatched parentheses.@*
-@xref{List Motion}, and @ref{Parsing Expressions}.
+The message is @samp{Scan error}. This happens when certain
+syntax-parsing functions find invalid syntax or mismatched
+parentheses. @xref{List Motion}, and @xref{Parsing Expressions}.
@item search-failed
-@code{"Search failed"}@*
-@xref{Searching and Matching}.
+The message is @samp{Search failed}. @xref{Searching and Matching}.
@item setting-constant
-@code{"Attempt to set a constant symbol"}@*
-The values of the symbols @code{nil} and @code{t},
-and any symbols that start with @samp{:},
-may not be changed.@*
-@xref{Constant Variables, , Variables that Never Change}.
+The message is @samp{Attempt to set a constant symbol}. This happens
+when attempting to assign values to @code{nil}, @code{t}, and keyword
+symbols. @xref{Constant Variables}.
+@c simple.el
@item text-read-only
-@code{"Text is read-only"}@*
-This is a subcategory of @code{buffer-read-only}.@*
-@xref{Special Properties}.
+The message is @samp{Text is read-only}. This is a subcategory of
+@code{buffer-read-only}. @xref{Special Properties}.
@item undefined-color
-@code{"Undefined color"}@*
-@xref{Color Names}.
+The message is @samp{Undefined color}. @xref{Color Names}.
+
+@item user-error
+The message is the empty string. @xref{Signaling Errors}.
@item void-function
-@code{"Symbol's function definition is void"}@*
+The message is @samp{Symbol's function definition is void}.
@xref{Function Cells}.
@item void-variable
-@code{"Symbol's value as variable is void"}@*
+The message is @samp{Symbol's value as variable is void}.
@xref{Accessing Variables}.
@item wrong-number-of-arguments
-@code{"Wrong number of arguments"}@*
-@xref{Classifying Lists}.
+The message is @samp{Wrong number of arguments}. @xref{Classifying
+Lists}.
@item wrong-type-argument
-@code{"Wrong type argument"}@*
-@xref{Type Predicates}.
+The message is @samp{Wrong type argument}. @xref{Type Predicates}.
@end table
- These kinds of error, which are classified as special cases of
+@ignore The following seem to be unused now.
+ The following kinds of error, which are classified as special cases of
@code{arith-error}, can occur on certain systems for invalid use of
-mathematical functions.
+mathematical functions. @xref{Math Functions}.
@table @code
@item domain-error
-@code{"Arithmetic domain error"}@*
-@xref{Math Functions}.
+The message is @samp{Arithmetic domain error}.
@item overflow-error
-@code{"Arithmetic overflow error"}@*
-This is a subcategory of @code{domain-error}.@*
-@xref{Math Functions}.
+The message is @samp{Arithmetic overflow error}. This is a subcategory
+of @code{domain-error}.
@item range-error
-@code{"Arithmetic range error"}@*
-@xref{Math Functions}.
+The message is @code{Arithmetic range error}.
@item singularity-error
-@code{"Arithmetic singularity error"}@*
-This is a subcategory of @code{domain-error}.@*
-@xref{Math Functions}.
+The message is @samp{Arithmetic singularity error}. This is a
+subcategory of @code{domain-error}.
@item underflow-error
-@code{"Arithmetic underflow error"}@*
-This is a subcategory of @code{domain-error}.@*
-@xref{Math Functions}.
+The message is @samp{Arithmetic underflow error}. This is a
+subcategory of @code{domain-error}.
@end table
+@end ignore
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index 74f3d9c48b9..670b293bea6 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1994, 1998, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1994, 1998, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/eval
-@node Evaluation, Control Structures, Symbols, Top
+@node Evaluation
@chapter Evaluation
@cindex evaluation
@cindex interpreter
@@ -23,6 +22,7 @@ function @code{eval}.
* Intro Eval:: Evaluation in the scheme of things.
* Forms:: How various sorts of objects are evaluated.
* Quoting:: Avoiding evaluation (to put constants in the program).
+* Backquote:: Easier construction of list structure.
* Eval:: How to invoke the Lisp interpreter explicitly.
@end menu
@@ -39,12 +39,16 @@ interpreter.
@cindex form
@cindex expression
- A Lisp object that is intended for evaluation is called an
-@dfn{expression} or a @dfn{form}. The fact that forms are data
-objects and not merely text is one of the fundamental differences
-between Lisp-like languages and typical programming languages. Any
-object can be evaluated, but in practice only numbers, symbols, lists
-and strings are evaluated very often.
+@cindex S-expression
+@cindex sexp
+ A Lisp object that is intended for evaluation is called a @dfn{form}
+or @dfn{expression}@footnote{It is sometimes also referred to as an
+@dfn{S-expression} or @dfn{sexp}, but we generally do not use this
+terminology in this manual.}. The fact that forms are data objects
+and not merely text is one of the fundamental differences between
+Lisp-like languages and typical programming languages. Any object can
+be evaluated, but in practice only numbers, symbols, lists and strings
+are evaluated very often.
In subsequent sections, we will describe the details of what
evaluation means for each kind of form.
@@ -64,8 +68,8 @@ evaluate a @dfn{function call} form such as @code{(car x)}, Emacs
first evaluates the argument (the subform @code{x}). After evaluating
the argument, Emacs @dfn{executes} the function (@code{car}), and if
the function is written in Lisp, execution works by evaluating the
-@dfn{body} of the function. (In this example, however, @code{car} is
-not a Lisp function; it is a primitive function implemented in C.)
+@dfn{body} of the function (in this example, however, @code{car} is
+not a Lisp function; it is a primitive function implemented in C).
@xref{Functions}, for more information about functions and function
calls.
@@ -77,9 +81,8 @@ variables (@pxref{Variables}).@footnote{This definition of
that can affect the result of a program.} Whenever a form refers to a
variable without creating a new binding for it, the variable evaluates
to the value given by the current environment. Evaluating a form may
-create a new environment for recursive evaluation, by binding
-variables (@pxref{Local Variables}). Such environments are temporary,
-and vanish when the evaluation of the form is complete.
+also temporarily alter the environment by binding variables
+(@pxref{Local Variables}).
@cindex side effect
Evaluating a form may also make changes that persist; these changes
@@ -97,12 +100,12 @@ interpretation. @xref{Command Loop}.
@node Forms
@section Kinds of Forms
- A Lisp object that is intended to be evaluated is called a @dfn{form}.
-How Emacs evaluates a form depends on its data type. Emacs has three
-different kinds of form that are evaluated differently: symbols, lists,
-and ``all other types.'' This section describes all three kinds, one by
-one, starting with the ``all other types'' which are self-evaluating
-forms.
+ A Lisp object that is intended to be evaluated is called a
+@dfn{form} (or an @dfn{expression}). How Emacs evaluates a form
+depends on its data type. Emacs has three different kinds of form
+that are evaluated differently: symbols, lists, and ``all other
+types''. This section describes all three kinds, one by one, starting
+with the ``all other types'' which are self-evaluating forms.
@menu
* Self-Evaluating Forms:: Forms that evaluate to themselves.
@@ -177,9 +180,9 @@ program. Here is an example:
@cindex symbol evaluation
When a symbol is evaluated, it is treated as a variable. The result
-is the variable's value, if it has one. If it has none (if its value
-cell is void), an error is signaled. For more information on the use of
-variables, see @ref{Variables}.
+is the variable's value, if it has one. If the symbol has no value as
+a variable, the Lisp interpreter signals an error. For more
+information on the use of variables, see @ref{Variables}.
In the following example, we set the value of a symbol with
@code{setq}. Then we evaluate the symbol, and get back the value that
@@ -258,16 +261,13 @@ use @code{fset} to set the function cell of a symbol and
into the function cell of @code{first}, and the symbol @code{first} into
the function cell of @code{erste}.
-@smallexample
+@example
@group
;; @r{Build this function cell linkage:}
;; ------------- ----- ------- -------
;; | #<subr car> | <-- | car | <-- | first | <-- | erste |
;; ------------- ----- ------- -------
@end group
-@end smallexample
-
-@smallexample
@group
(symbol-function 'car)
@result{} #<subr car>
@@ -284,24 +284,40 @@ the function cell of @code{erste}.
(erste '(1 2 3)) ; @r{Call the function referenced by @code{erste}.}
@result{} 1
@end group
-@end smallexample
+@end example
By contrast, the following example calls a function without any symbol
function indirection, because the first element is an anonymous Lisp
function, not a symbol.
-@smallexample
+@example
@group
((lambda (arg) (erste arg))
'(1 2 3))
@result{} 1
@end group
-@end smallexample
+@end example
@noindent
Executing the function itself evaluates its body; this does involve
symbol function indirection when calling @code{erste}.
+ This form is rarely used and is now deprecated. Instead, you should write it
+as:
+
+@example
+@group
+(funcall (lambda (arg) (erste arg))
+ '(1 2 3))
+@end group
+@end example
+or just
+@example
+@group
+(let ((arg '(1 2 3))) (erste arg))
+@end group
+@end example
+
The built-in function @code{indirect-function} provides an easy way to
perform symbol function indirection explicitly.
@@ -323,12 +339,12 @@ loop in the chain of symbols.
Here is how you could define @code{indirect-function} in Lisp:
-@smallexample
+@example
(defun indirect-function (function)
(if (symbolp function)
(indirect-function (symbol-function function))
function))
-@end smallexample
+@end example
@end defun
@node Function Forms
@@ -434,12 +450,6 @@ Emacs Lisp with a reference to where each is described.
@item defconst
@pxref{Defining Variables}
-@item defmacro
-@pxref{Defining Macros}
-
-@item defun
-@pxref{Defining Functions}
-
@item defvar
@pxref{Defining Variables}
@@ -476,9 +486,6 @@ Emacs Lisp with a reference to where each is described.
@item save-restriction
@pxref{Narrowing}
-@item save-window-excursion
-@pxref{Window Configurations}
-
@item setq
@pxref{Setting Variables}
@@ -493,9 +500,6 @@ Emacs Lisp with a reference to where each is described.
@item while
@pxref{Iteration}
-
-@item with-output-to-temp-buffer
-@pxref{Temporary Displays}
@end table
@cindex CL note---special forms compared
@@ -503,8 +507,7 @@ Emacs Lisp with a reference to where each is described.
@b{Common Lisp note:} Here are some comparisons of special forms in
GNU Emacs Lisp and Common Lisp. @code{setq}, @code{if}, and
@code{catch} are special forms in both Emacs Lisp and Common Lisp.
-@code{defun} is a special form in Emacs Lisp, but a macro in Common
-Lisp. @code{save-excursion} is a special form in Emacs Lisp, but
+@code{save-excursion} is a special form in Emacs Lisp, but
doesn't exist in Common Lisp. @code{throw} is a special form in
Common Lisp (because it must be able to throw multiple values), but it
is a function in Emacs Lisp (which doesn't have multiple
@@ -518,8 +521,10 @@ values).@refill
whose function definition has not yet been loaded into Emacs. It
specifies which file contains the definition. When an autoload object
appears as a symbol's function definition, calling that symbol as a
-function automatically loads the specified file; then it calls the real
-definition loaded from that file. @xref{Autoload}.
+function automatically loads the specified file; then it calls the
+real definition loaded from that file. The way to arrange for an
+autoload object to appear as a symbol's function definition is
+described in @ref{Autoload}.
@node Quoting
@section Quoting
@@ -577,6 +582,96 @@ Functions}), which causes an anonymous lambda expression written in Lisp
to be compiled, and @samp{`} (@pxref{Backquote}), which is used to quote
only part of a list, while computing and substituting other parts.
+@node Backquote
+@section Backquote
+@cindex backquote (list substitution)
+@cindex ` (list substitution)
+@findex `
+
+ @dfn{Backquote constructs} allow you to quote a list, but
+selectively evaluate elements of that list. In the simplest case, it
+is identical to the special form @code{quote}
+@iftex
+@end iftex
+@ifnottex
+(described in the previous section; @pxref{Quoting}).
+@end ifnottex
+For example, these two forms yield identical results:
+
+@example
+@group
+`(a list of (+ 2 3) elements)
+ @result{} (a list of (+ 2 3) elements)
+@end group
+@group
+'(a list of (+ 2 3) elements)
+ @result{} (a list of (+ 2 3) elements)
+@end group
+@end example
+
+@findex , @r{(with backquote)}
+ The special marker @samp{,} inside of the argument to backquote
+indicates a value that isn't constant. The Emacs Lisp evaluator
+evaluates the argument of @samp{,}, and puts the value in the list
+structure:
+
+@example
+@group
+`(a list of ,(+ 2 3) elements)
+ @result{} (a list of 5 elements)
+@end group
+@end example
+
+@noindent
+Substitution with @samp{,} is allowed at deeper levels of the list
+structure also. For example:
+
+@example
+@group
+`(1 2 (3 ,(+ 4 5)))
+ @result{} (1 2 (3 9))
+@end group
+@end example
+
+@findex ,@@ @r{(with backquote)}
+@cindex splicing (with backquote)
+ You can also @dfn{splice} an evaluated value into the resulting list,
+using the special marker @samp{,@@}. The elements of the spliced list
+become elements at the same level as the other elements of the resulting
+list. The equivalent code without using @samp{`} is often unreadable.
+Here are some examples:
+
+@example
+@group
+(setq some-list '(2 3))
+ @result{} (2 3)
+@end group
+@group
+(cons 1 (append some-list '(4) some-list))
+ @result{} (1 2 3 4 2 3)
+@end group
+@group
+`(1 ,@@some-list 4 ,@@some-list)
+ @result{} (1 2 3 4 2 3)
+@end group
+
+@group
+(setq list '(hack foo bar))
+ @result{} (hack foo bar)
+@end group
+@group
+(cons 'use
+ (cons 'the
+ (cons 'words (append (cdr list) '(as elements)))))
+ @result{} (use the words foo bar as elements)
+@end group
+@group
+`(use the words ,@@(cdr list) as elements)
+ @result{} (use the words foo bar as elements)
+@end group
+@end example
+
+
@node Eval
@section Eval
@@ -602,12 +697,13 @@ functions provides the ability to pass information to them as
arguments.
@defun eval form &optional lexical
-This is the basic function evaluating an expression. It evaluates
+This is the basic function for evaluating an expression. It evaluates
@var{form} in the current environment and returns the result. How the
evaluation proceeds depends on the type of the object (@pxref{Forms}).
-@var{lexical} if non-nil means to evaluate @var{form} using lexical scoping
-rules (@pxref{Lexical Binding}) instead of the default dynamic scoping used
-historically in Emacs Lisp.
+
+The argument @var{lexical}, if non-@code{nil}, means to evaluate
+@var{form} using lexical scoping rules for variables, instead of the
+default dynamic scoping rules. @xref{Lexical Binding}.
Since @code{eval} is a function, the argument expression that appears
in a call to @code{eval} is evaluated twice: once as preparation before
@@ -711,7 +807,7 @@ The value of this variable is a list of the values returned by all the
expressions that were read, evaluated, and printed from buffers
(including the minibuffer) by the standard Emacs commands which do
this. (Note that this does @emph{not} include evaluation in
-@samp{*ielm*} buffers, nor evaluation using @kbd{C-j} in
+@file{*ielm*} buffers, nor evaluation using @kbd{C-j} in
@code{lisp-interaction-mode}.) The elements are ordered most recent
first.
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 86ecfd122ef..a5710c789e9 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -1,16 +1,14 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/files
-@node Files, Backups and Auto-Saving, Documentation, Top
-@comment node-name, next, previous, up
+@node Files
@chapter Files
- In Emacs, you can find, create, view, save, and otherwise work with
-files and file directories. This chapter describes most of the
-file-related functions of Emacs Lisp, but a few others are described in
+ This chapter describes the Emacs Lisp functions and variables to
+find, create, view, save, and otherwise work with files and file
+directories. A few other file-related functions are described in
@ref{Buffers}, and those related to backups and auto-saving are
described in @ref{Backups and Auto-Saving}.
@@ -18,13 +16,20 @@ described in @ref{Backups and Auto-Saving}.
names. A file name is actually a string. Most of these functions
expand file name arguments by calling @code{expand-file-name}, so that
@file{~} is handled correctly, as are relative file names (including
-@samp{../}). These functions don't recognize environment variable
-substitutions such as @samp{$HOME}. @xref{File Name Expansion}.
+@samp{../}). @xref{File Name Expansion}.
+
+ In addition, certain @dfn{magic} file names are handled specially.
+For example, when a remote file name is specified, Emacs accesses the
+file over the network via an appropriate protocol (@pxref{Remote
+Files,, Remote Files, emacs, The GNU Emacs Manual}). This handling is
+done at a very low level, so you may assume that all the functions
+described in this chapter accept magic file names as file name
+arguments, except where noted. @xref{Magic File Names}, for details.
When file I/O functions signal Lisp errors, they usually use the
condition @code{file-error} (@pxref{Handling Errors}). The error
message is in most cases obtained from the operating system, according
-to locale @code{system-message-locale}, and decoded using coding system
+to locale @code{system-messages-locale}, and decoded using coding system
@code{locale-coding-system} (@pxref{Locales}).
@menu
@@ -35,12 +40,11 @@ to locale @code{system-message-locale}, and decoded using coding system
* File Locks:: Locking and unlocking files, to prevent
simultaneous editing by two people.
* Information about Files:: Testing existence, accessibility, size of files.
-* Changing Files:: Renaming files, changing protection, etc.
+* Changing Files:: Renaming files, changing permissions, etc.
* File Names:: Decomposing and expanding file names.
* Contents of Directories:: Getting a list of the files in a directory.
* Create/Delete Dirs:: Creating and Deleting Directories.
-* Magic File Names:: Defining "magic" special handling
- for certain file names.
+* Magic File Names:: Special handling for certain file names.
* Format Conversion:: Conversion to and from various file formats.
@end menu
@@ -66,8 +70,8 @@ back into the file.
In spite of the distinction between files and buffers, people often
refer to a file when they mean a buffer and vice-versa. Indeed, we say,
-``I am editing a file,'' rather than, ``I am editing a buffer that I
-will soon save as a file of the same name.'' Humans do not usually need
+``I am editing a file'', rather than, ``I am editing a buffer that I
+will soon save as a file of the same name''. Humans do not usually need
to make the distinction explicit. When dealing with a computer program,
however, it is good to keep the distinction in mind.
@@ -245,7 +249,6 @@ is permanent local, so it is unaffected by changes of major modes.
@end defvar
@node Subroutines of Visiting
-@comment node-name, next, previous, up
@subsection Subroutines of Visiting
The @code{find-file-noselect} function uses two important subroutines
@@ -484,11 +487,13 @@ in particular buffers.
@defopt require-final-newline
This variable determines whether files may be written out that do
@emph{not} end with a newline. If the value of the variable is
-@code{t}, then @code{save-buffer} silently adds a newline at the end of
-the file whenever the buffer being saved does not already end in one.
-If the value of the variable is non-@code{nil}, but not @code{t}, then
-@code{save-buffer} asks the user whether to add a newline each time the
-case arises.
+@code{t}, then @code{save-buffer} silently adds a newline at the end
+of the buffer whenever it does not already end in one. If the value
+is @code{visit}, Emacs adds a missing newline just after it visits the
+file. If the value is @code{visit-save}, Emacs adds a missing newline
+both on visiting and on saving. For any other non-@code{nil} value,
+@code{save-buffer} asks the user whether to add a newline each time
+the case arises.
If the value of the variable is @code{nil}, then @code{save-buffer}
doesn't add newlines at all. @code{nil} is the default value, but a few
@@ -499,7 +504,6 @@ major modes set it to @code{t} in particular buffers.
Name}).
@node Reading from Files
-@comment node-name, next, previous, up
@section Reading from Files
@cindex reading from files
@@ -513,17 +517,15 @@ current buffer after point. It returns a list of the absolute file name
and the length of the data inserted. An error is signaled if
@var{filename} is not the name of a file that can be read.
-The function @code{insert-file-contents} checks the file contents
-against the defined file formats, and converts the file contents if
-appropriate and also calls the functions in
-the list @code{after-insert-file-functions}. @xref{Format Conversion}.
-Normally, one of the functions in the
+This function checks the file contents against the defined file
+formats, and converts the file contents if appropriate and also calls
+the functions in the list @code{after-insert-file-functions}.
+@xref{Format Conversion}. Normally, one of the functions in the
@code{after-insert-file-functions} list determines the coding system
(@pxref{Coding Systems}) used for decoding the file's contents,
including end-of-line conversion. However, if the file contains null
-bytes, it is by default visited without any code conversions; see
-@ref{Lisp and Coding Systems, inhibit-null-byte-detection}, for how to
-control this behavior.
+bytes, it is by default visited without any code conversions.
+@xref{Lisp and Coding Systems, inhibit-null-byte-detection}.
If @var{visit} is non-@code{nil}, this function additionally marks the
buffer as unmodified and sets up various fields in the buffer so that it
@@ -554,11 +556,9 @@ with @code{insert-file-contents}, as long as @var{replace} and
@end defun
@defun insert-file-contents-literally filename &optional visit beg end replace
-This function works like @code{insert-file-contents} except that it does
-not do format decoding (@pxref{Format Conversion}), does not do
-character code conversion (@pxref{Coding Systems}), does not run
-@code{find-file-hook}, does not perform automatic uncompression, and so
-on.
+This function works like @code{insert-file-contents} except that it
+does not run @code{find-file-hook}, and does not do format decoding,
+character code conversion, automatic uncompression, and so on.
@end defun
If you want to pass a file name to another process so that another
@@ -566,7 +566,6 @@ program can read the file, use the function @code{file-local-copy}; see
@ref{Magic File Names}.
@node Writing to Files
-@comment node-name, next, previous, up
@section Writing to Files
@cindex writing to files
@@ -685,7 +684,7 @@ The file lock is really a file, a symbolic link with a special name,
stored in the same directory as the file you are editing.
When you access files using NFS, there may be a small probability that
-you and another user will both lock the same file ``simultaneously.''
+you and another user will both lock the same file ``simultaneously''.
If this happens, it is possible for the two users to make changes
simultaneously, but Emacs will still warn the user who saves second.
Also, the detection of modification of a buffer visiting a file changed
@@ -723,7 +722,12 @@ system does not support locking.
File locking is not supported on some systems. On systems that do not
support it, the functions @code{lock-buffer}, @code{unlock-buffer} and
-@code{file-locked-p} do nothing and return @code{nil}.
+@code{file-locked-p} do nothing and return @code{nil}. It is also
+possible to disable locking, by setting the variable @code{create-lockfiles}.
+
+@defopt create-lockfiles
+If this variable is @code{nil}, Emacs does not lock files.
+@end defopt
@defun ask-user-about-lock file other-user
This function is called when the user tries to modify @var{file}, but it
@@ -781,7 +785,6 @@ otherwise noted.
@end menu
@node Testing Accessibility
-@comment node-name, next, previous, up
@subsection Testing Accessibility
@cindex accessibility of a file
@cindex file accessibility
@@ -796,7 +799,7 @@ This function returns @code{t} if a file named @var{filename} appears
to exist. This does not mean you can necessarily read the file, only
that you can find out its attributes. (On Unix and GNU/Linux, this is
true if the file exists and you have execute permission on the
-containing directories, regardless of the protection of the file
+containing directories, regardless of the permissions of the file
itself.)
If the file does not exist, or if fascist access control policies
@@ -935,11 +938,10 @@ on the 19th, @file{aug-20} was written on the 20th, and the file
@end example
You can use @code{file-attributes} to get a file's last modification
-time as a list of two numbers. @xref{File Attributes}.
+time as a list of four integers. @xref{File Attributes}.
@end defun
@node Kinds of Files
-@comment node-name, next, previous, up
@subsection Distinguishing Kinds of Files
This section describes how to distinguish various kinds of files, such
@@ -1016,11 +1018,25 @@ a regular file (not a directory, named pipe, terminal, or
other I/O device).
@end defun
+@defun file-equal-p file1 file2
+This function returns @code{t} if the files @var{file1} and
+@var{file2} name the same file. If @var{file1} or @var{file2} does
+not exist, the return value is unspecified.
+@end defun
+
+@defun file-in-directory-p file dir
+This function returns @code{t} if @var{file} is a file in directory
+@var{dir}, or in a subdirectory of @var{dir}. It also returns
+@code{t} if @var{file} and @var{dir} are the same directory. It
+compares the @code{file-truename} values of the two directories
+(@pxref{Truenames}). If @var{dir} does not name an existing
+directory, the return value is @code{nil}.
+@end defun
+
@node Truenames
@subsection Truenames
@cindex truename (of file)
-@c Emacs 19 features
The @dfn{truename} of a file is the name that you get by following
symbolic links at all levels until none remain, then simplifying away
@samp{.}@: and @samp{..}@: appearing as name components. This results
@@ -1030,9 +1046,9 @@ the number of hard links to the file. However, truenames are useful
because they eliminate symbolic links as a cause of name variation.
@defun file-truename filename
-The function @code{file-truename} returns the truename of the file
-@var{filename}. If the argument is not an absolute file name,
-this function first expands it against @code{default-directory}.
+This function returns the truename of the file @var{filename}. If the
+argument is not an absolute file name, this function first expands it
+against @code{default-directory}.
This function does not expand environment variables. Only
@code{substitute-in-file-name} does that. @xref{Definition of
@@ -1078,31 +1094,31 @@ we would have:
@xref{Buffer File Name}, for related information.
@node File Attributes
-@comment node-name, next, previous, up
@subsection Other Information about Files
- This section describes the functions for getting detailed information
-about a file, other than its contents. This information includes the
-mode bits that control access permission, the owner and group numbers,
-the number of names, the inode number, the size, and the times of access
-and modification.
+ This section describes the functions for getting detailed
+information about a file, other than its contents. This information
+includes the mode bits that control access permissions, the owner and
+group numbers, the number of names, the inode number, the size, and
+the times of access and modification.
@defun file-modes filename
-@cindex permission
+@cindex file permissions
+@cindex permissions, file
@cindex file attributes
-This function returns the mode bits of @var{filename}, as an integer.
-The mode bits are also called the file permissions, and they specify
-access control in the usual Unix fashion. If the low-order bit is 1,
-then the file is executable by all users, if the second-lowest-order bit
-is 1, then the file is writable by all users, etc.
-
-The highest value returnable is 4095 (7777 octal), meaning that
-everyone has read, write, and execute permission, that the @acronym{SUID} bit
-is set for both others and group, and that the sticky bit is set.
-
-If @var{filename} does not exist, @code{file-modes} returns @code{nil}.
-
-This function recursively follows symbolic links at all levels.
+@cindex file modes
+This function returns the @dfn{mode bits} describing the @dfn{file
+permissions} of @var{filename}, as an integer. It recursively follows
+symbolic links in @var{filename} at all levels. If @var{filename}
+does not exist, the return value is @code{nil}.
+
+@xref{File Permissions,,, coreutils, The @sc{gnu} @code{Coreutils}
+Manual}, for a description of mode bits. If the low-order bit is 1,
+then the file is executable by all users, if the second-lowest-order
+bit is 1, then the file is writable by all users, etc. The highest
+value returnable is 4095 (7777 octal), meaning that everyone has read,
+write, and execute permission, that the @acronym{SUID} bit is set for
+both others and group, and that the sticky bit is set.
@example
@group
@@ -1115,26 +1131,36 @@ This function recursively follows symbolic links at all levels.
@end group
@group
-(set-file-modes "~/junk/diffs" 438)
+(set-file-modes "~/junk/diffs" #o666)
@result{} nil
@end group
@group
-(format "%o" 438)
- @result{} "666" ; @r{Convert to octal.}
-@end group
-
-@group
% ls -l diffs
-rw-rw-rw- 1 lewis 0 3063 Oct 30 16:00 diffs
@end group
@end example
+
+@xref{Changing Files}, for functions that change file permissions,
+such as @code{set-file-modes}.
+
+@cindex MS-DOS and file modes
+@cindex file modes and MS-DOS
+@strong{MS-DOS note:} On MS-DOS, there is no such thing as an
+``executable'' file mode bit. So @code{file-modes} considers a file
+executable if its name ends in one of the standard executable
+extensions, such as @file{.com}, @file{.bat}, @file{.exe}, and some
+others. Files that begin with the Unix-standard @samp{#!} signature,
+such as shell and Perl scripts, are also considered executable.
+Directories are also reported as executable, for compatibility with
+Unix. These conventions are also followed by @code{file-attributes},
+below.
@end defun
-If the @var{filename} argument to the next two functions is a symbolic
-link, then these function do @emph{not} replace it with its target.
-However, they both recursively follow symbolic links at all levels of
-parent directories.
+ If the @var{filename} argument to the next two functions is a
+symbolic link, then these function do @emph{not} replace it with its
+target. However, they both recursively follow symbolic links at all
+levels of parent directories.
@defun file-nlinks filename
This functions returns the number of names (i.e., hard links) that
@@ -1194,20 +1220,19 @@ point number.
The file's @acronym{GID}, likewise.
@item
-The time of last access, as a list of two integers.
-The first integer has the high-order 16 bits of time,
-the second has the low 16 bits. (This is similar to the
+The time of last access, as a list of four integers @code{(@var{sec-high}
+@var{sec-low} @var{microsec} @var{picosec})}. (This is similar to the
value of @code{current-time}; see @ref{Time of Day}.) Note that on
some FAT-based filesystems, only the date of last access is recorded,
so this time will always hold the midnight of the day of last access.
@cindex modification time of file
@item
-The time of last modification as a list of two integers (as above).
+The time of last modification as a list of four integers (as above).
This is the last time when the file's contents were modified.
@item
-The time of last status change as a list of two integers (as above).
+The time of last status change as a list of four integers (as above).
This is the time of the last change to the file's access mode bits,
its owner and group, and other information recorded in the filesystem
for the file, beyond the file's contents.
@@ -1250,9 +1275,9 @@ For example, here are the file attributes for @file{files.texi}:
@group
(file-attributes "files.texi" 'string)
@result{} (nil 1 "lh" "users"
- (19145 42977)
- (19141 59576)
- (18340 17300)
+ (20614 64019 50040 152000)
+ (20000 23 0 0)
+ (20614 64555 902289 872000)
122295 "-rw-rw-rw-"
nil (5888 2 . 43978)
(15479 . 46724))
@@ -1276,14 +1301,14 @@ is owned by the user with name "lh".
@item "users"
is in the group with name "users".
-@item (19145 42977)
-was last accessed on Oct 5 2009, at 10:01:37.
+@item (20614 64019 50040 152000)
+was last accessed on October 23, 2012, at 20:12:03.050040152 UTC.
-@item (19141 59576)
-last had its contents modified on Oct 2 2009, at 13:49:12.
+@item (20000 23 0 0)
+was last modified on July 15, 2001, at 08:53:43 UTC.
-@item (18340 17300)
-last had its status changed on Feb 2 2008, at 12:19:00.
+@item (20614 64555 902289 872000)
+last had its status changed on October 23, 2012, at 20:20:59.902289872 UTC.
@item 122295
is 122295 bytes long. (It may not contain 122295 characters, though,
@@ -1304,16 +1329,26 @@ is on the file-system device whose number is 1014478468.
@end table
@end defun
-@cindex MS-DOS and file modes
-@cindex file modes and MS-DOS
- On MS-DOS, there is no such thing as an ``executable'' file mode bit.
-So Emacs considers a file executable if its name ends in one of the
-standard executable extensions, such as @file{.com}, @file{.bat},
-@file{.exe}, and some others. Files that begin with the Unix-standard
-@samp{#!} signature, such as shell and Perl scripts, are also considered
-as executable files. This is reflected in the values returned by
-@code{file-modes} and @code{file-attributes}. Directories are also
-reported with executable bit set, for compatibility with Unix.
+@cindex SELinux context
+ SELinux is a Linux kernel feature which provides more sophisticated
+file access controls than ordinary ``Unix-style'' file permissions.
+If Emacs has been compiled with SELinux support on a system with
+SELinux enabled, you can use the function @code{file-selinux-context}
+to retrieve a file's SELinux security context. For the function
+@code{set-file-selinux-context}, see @ref{Changing Files}.
+
+@defun file-selinux-context filename
+This function returns the SELinux security context of the file
+@var{filename}. This return value is a list of the form
+@code{(@var{user} @var{role} @var{type} @var{range})}, whose elements
+are the context's user, role, type, and range respectively, as Lisp
+strings. See the SELinux documentation for details about what these
+actually mean.
+
+If the file does not exist or is inaccessible, or if the system does
+not support SELinux, or if Emacs was not compiled with SELinux
+support, then the return value is @code{(nil nil nil nil)}.
+@end defun
@node Locating Files
@subsection How to Locate Files in Standard Places
@@ -1321,20 +1356,18 @@ reported with executable bit set, for compatibility with Unix.
@cindex find file in path
This section explains how to search for a file in a list of
-directories (a @dfn{path}). One example is when you need to look for
-a program's executable file, e.g., to find out whether a given program
-is installed on the user's system. Another example is the search for
-Lisp libraries (@pxref{Library Search}). Such searches generally need
-to try various possible file name extensions, in addition to various
-possible directories. Emacs provides a function for such a
-generalized search for a file.
+directories (a @dfn{path}), or for an executable file in the standard
+list of executable file directories.
+
+ To search for a user-specific configuration file, @xref{Standard
+File Names}, for the @code{locate-user-emacs-file} function.
@defun locate-file filename path &optional suffixes predicate
This function searches for a file whose name is @var{filename} in a
list of directories given by @var{path}, trying the suffixes in
-@var{suffixes}. If it finds such a file, it returns the full
-@dfn{absolute file name} of the file (@pxref{Relative File Names});
-otherwise it returns @code{nil}.
+@var{suffixes}. If it finds such a file, it returns the file's
+absolute file name (@pxref{Relative File Names}); otherwise it returns
+@code{nil}.
The optional argument @var{suffixes} gives the list of file-name
suffixes to append to @var{filename} when searching.
@@ -1342,24 +1375,23 @@ suffixes to append to @var{filename} when searching.
suffixes. If @var{suffixes} is @code{nil}, or @code{("")}, then there
are no suffixes, and @var{filename} is used only as-is. Typical
values of @var{suffixes} are @code{exec-suffixes} (@pxref{Subprocess
-Creation, exec-suffixes}), @code{load-suffixes},
-@code{load-file-rep-suffixes} and the return value of the function
-@code{get-load-suffixes} (@pxref{Load Suffixes}).
+Creation}), @code{load-suffixes}, @code{load-file-rep-suffixes} and
+the return value of the function @code{get-load-suffixes} (@pxref{Load
+Suffixes}).
Typical values for @var{path} are @code{exec-path} (@pxref{Subprocess
-Creation, exec-path}) when looking for executable programs or
-@code{load-path} (@pxref{Library Search, load-path}) when looking for
-Lisp files. If @var{filename} is absolute, @var{path} has no effect,
-but the suffixes in @var{suffixes} are still tried.
-
-The optional argument @var{predicate}, if non-@code{nil}, specifies
-the predicate function to use for testing whether a candidate file is
-suitable. The predicate function is passed the candidate file name as
-its single argument. If @var{predicate} is @code{nil} or unspecified,
-@code{locate-file} uses @code{file-readable-p} as the default
-predicate. Useful non-default predicates include
-@code{file-executable-p}, @code{file-directory-p}, and other
-predicates described in @ref{Kinds of Files}.
+Creation}) when looking for executable programs, or @code{load-path}
+(@pxref{Library Search}) when looking for Lisp files. If
+@var{filename} is absolute, @var{path} has no effect, but the suffixes
+in @var{suffixes} are still tried.
+
+The optional argument @var{predicate}, if non-@code{nil}, specifies a
+predicate function for testing whether a candidate file is suitable.
+The predicate is passed the candidate file name as its single
+argument. If @var{predicate} is @code{nil} or omitted,
+@code{locate-file} uses @code{file-readable-p} as the predicate.
+@xref{Kinds of Files}, for other useful predicates, e.g.@:
+@code{file-executable-p} and @code{file-directory-p}.
For compatibility, @var{predicate} can also be one of the symbols
@code{executable}, @code{readable}, @code{writable}, @code{exists}, or
@@ -1368,11 +1400,11 @@ a list of one or more of these symbols.
@defun executable-find program
This function searches for the executable file of the named
-@var{program} and returns the full absolute name of the executable,
+@var{program} and returns the absolute file name of the executable,
including its file-name extensions, if any. It returns @code{nil} if
the file is not found. The functions searches in all the directories
-in @code{exec-path} and tries all the file-name extensions in
-@code{exec-suffixes}.
+in @code{exec-path}, and tries all the file-name extensions in
+@code{exec-suffixes} (@pxref{Subprocess Creation}).
@end defun
@node Changing Files
@@ -1383,8 +1415,8 @@ in @code{exec-path} and tries all the file-name extensions in
@cindex linking files
@cindex setting modes of files
- The functions in this section rename, copy, delete, link, and set the
-modes of files.
+ The functions in this section rename, copy, delete, link, and set
+the modes (permissions) of files.
In the functions that have an argument @var{newname}, if a file by the
name of @var{newname} already exists, the actions taken depend on the
@@ -1485,7 +1517,7 @@ with @code{add-name-to-file} and then deleting @var{filename} has the
same effect as renaming, aside from momentary intermediate states.
@end deffn
-@deffn Command copy-file oldname newname &optional ok-if-exists time preserve-uid-gid
+@deffn Command copy-file oldname newname &optional ok-if-exists time preserve-uid-gid preserve-selinux
This command copies the file @var{oldname} to @var{newname}. An
error is signaled if @var{oldname} does not exist. If @var{newname}
names a directory, it copies @var{oldname} into that directory,
@@ -1506,6 +1538,10 @@ usually set to the user running Emacs). If @var{preserve-uid-gid} is
non-@code{nil}, we attempt to copy the user and group ownership of the
file. This works only on some operating systems, and only if you have
the correct permissions to do so.
+
+If the optional argument @var{preserve-selinux} is non-@code{nil}, and
+Emacs has been compiled with SELinux support, this function attempts
+to copy the file's SELinux context (@pxref{File Attributes}).
@end deffn
@deffn Command make-symbolic-link filename newname &optional ok-if-exists
@@ -1543,54 +1579,67 @@ no prefix argument is given, and @code{nil} otherwise.
See also @code{delete-directory} in @ref{Create/Delete Dirs}.
@end deffn
+@cindex file permissions, setting
+@cindex permissions, file
+@cindex file modes, setting
@deffn Command set-file-modes filename mode
-This function sets mode bits of @var{filename} to @var{mode} (which
-must be an integer when the function is called non-interactively).
-Only the low 12 bits of @var{mode} are used.
+This function sets the @dfn{file mode} (or @dfn{file permissions}) of
+@var{filename} to @var{mode}. It recursively follows symbolic links
+at all levels for @var{filename}.
+
+If called non-interactively, @var{mode} must be an integer. Only the
+lowest 12 bits of the integer are used; on most systems, only the
+lowest 9 bits are meaningful. You can use the Lisp construct for
+octal numbers to enter @var{mode}. For example,
+
+@example
+(set-file-modes #o644)
+@end example
+
+@noindent
+specifies that the file should be readable and writable for its owner,
+readable for group members, and readable for all other users.
+@xref{File Permissions,,, coreutils, The @sc{gnu} @code{Coreutils}
+Manual}, for a description of mode bit specifications.
Interactively, @var{mode} is read from the minibuffer using
-@code{read-file-modes}, which accepts mode bits either as a number or
-as a character string representing the mode bits symbolically. See
-the description of @code{read-file-modes} below for the supported
-forms of symbolic notation for mode bits.
+@code{read-file-modes} (see below), which lets the user type in either
+an integer or a string representing the permissions symbolically.
-This function recursively follows symbolic links at all levels for
-@var{filename}.
+@xref{File Attributes}, for the function @code{file-modes}, which
+returns the permissions of a file.
@end deffn
-@c Emacs 19 feature
@defun set-default-file-modes mode
@cindex umask
-This function sets the default file protection for new files created by
-Emacs and its subprocesses. Every file created with Emacs initially has
-this protection, or a subset of it (@code{write-region} will not give a
-file execute permission even if the default file protection allows
-execute permission). On Unix and GNU/Linux, the default protection is
-the bitwise complement of the ``umask'' value.
-
-The argument @var{mode} must be an integer. On most systems, only the
-low 9 bits of @var{mode} are meaningful. You can use the Lisp construct
-for octal character codes to enter @var{mode}; for example,
-
-@example
-(set-default-file-modes ?\644)
-@end example
-
-Saving a modified version of an existing file does not count as creating
-the file; it preserves the existing file's mode, whatever that is. So
-the default file protection has no effect.
+This function sets the default file permissions for new files created
+by Emacs and its subprocesses. Every file created with Emacs
+initially has these permissions, or a subset of them
+(@code{write-region} will not grant execute permissions even if the
+default file permissions allow execution). On Unix and GNU/Linux, the
+default permissions are given by the bitwise complement of the
+``umask'' value.
+
+The argument @var{mode} should be an integer which specifies the
+permissions, similar to @code{set-file-modes} above. Only the lowest
+9 bits are meaningful.
+
+The default file permissions have no effect when you save a modified
+version of an existing file; saving a file preserves its existing
+permissions.
@end defun
@defun default-file-modes
-This function returns the current default protection value.
+This function returns the default file permissions, as an integer.
@end defun
@defun read-file-modes &optional prompt base-file
-This function reads file mode bits from the minibuffer. The optional
-argument @var{prompt} specifies a non-default prompt. Second optional
-argument @var{base-file} is the name of a file on whose permissions to
-base the mode bits that this function returns, if what the user types
-specifies mode bits relative to permissions of an existing file.
+This function reads a set of file mode bits from the minibuffer. The
+first optional argument @var{prompt} specifies a non-default prompt.
+Second second optional argument @var{base-file} is the name of a file
+on whose permissions to base the mode bits that this function returns,
+if what the user types specifies mode bits relative to permissions of
+an existing file.
If user input represents an octal number, this function returns that
number. If it is a complete symbolic specification of mode bits, as
@@ -1602,16 +1651,16 @@ mode bits of @var{base-file}. If @var{base-file} is omitted or
@code{nil}, the function uses @code{0} as the base mode bits. The
complete and relative specifications can be combined, as in
@code{"u+r,g+rx,o+r,g-w"}. @xref{File Permissions,,, coreutils, The
-@sc{gnu} @code{Coreutils} Manual}, for detailed description of
-symbolic mode bits specifications.
+@sc{gnu} @code{Coreutils} Manual}, for a description of file mode
+specifications.
@end defun
@defun file-modes-symbolic-to-number modes &optional base-modes
-This subroutine converts a symbolic specification of file mode bits in
-@var{modes} into the equivalent numeric value. If the symbolic
+This function converts a symbolic file mode specification in
+@var{modes} into the equivalent integer value. If the symbolic
specification is based on an existing file, that file's mode bits are
taken from the optional argument @var{base-modes}; if that argument is
-omitted or @code{nil}, it defaults to zero, i.e.@: no access rights at
+omitted or @code{nil}, it defaults to 0, i.e.@: no access rights at
all.
@end defun
@@ -1623,6 +1672,16 @@ time and must be in the format returned by @code{current-time}
(@pxref{Time of Day}).
@end defun
+@defun set-file-selinux-context filename context
+This function sets the SELinux security context of the file
+@var{filename} to @var{context}. @xref{File Attributes}, for a brief
+description of SELinux contexts. The @var{context} argument should be
+a list @code{(@var{user} @var{role} @var{type} @var{range})}, like the
+return value of @code{file-selinux-context}. The function does
+nothing if SELinux is disabled, or if Emacs was compiled without
+SELinux support.
+@end defun
+
@node File Names
@section File Names
@cindex file names
@@ -1744,7 +1803,7 @@ return value, but backup version numbers are kept.
@end defun
@defun file-name-extension filename &optional period
-This function returns @var{filename}'s final ``extension,'' if any,
+This function returns @var{filename}'s final ``extension'', if any,
after applying @code{file-name-sans-versions} to remove any
version/backup part. The extension, in a file name, is the part that
follows the last @samp{.} in the last name component (minus any
@@ -1786,6 +1845,17 @@ Note that the @samp{.~3~} in the two last examples is the backup part,
not an extension.
@end defun
+@defun file-name-base &optional filename
+This function is the composition of @code{file-name-sans-extension}
+and @code{file-name-nondirectory}. For example,
+
+@example
+(file-name-base "/my/home/foo.c")
+ @result{} "foo"
+@end example
+
+The @var{filename} argument defaults to @code{buffer-file-name}.
+@end defun
@node Relative File Names
@subsection Absolute and Relative File Names
@@ -1794,14 +1864,15 @@ not an extension.
All the directories in the file system form a tree starting at the
root directory. A file name can specify all the directory names
-starting from the root of the tree; then it is called an @dfn{absolute}
-file name. Or it can specify the position of the file in the tree
-relative to a default directory; then it is called a @dfn{relative} file
-name. On Unix and GNU/Linux, an absolute file name starts with a slash
-or a tilde (@samp{~}), and a relative one does not. On MS-DOS and
-MS-Windows, an absolute file name starts with a slash or a backslash, or
-with a drive specification @samp{@var{x}:/}, where @var{x} is the
-@dfn{drive letter}.
+starting from the root of the tree; then it is called an
+@dfn{absolute} file name. Or it can specify the position of the file
+in the tree relative to a default directory; then it is called a
+@dfn{relative} file name. On Unix and GNU/Linux, an absolute file
+name starts with a @samp{/} or a @samp{~}
+(@pxref{abbreviate-file-name}), and a relative one does not. On
+MS-DOS and MS-Windows, an absolute file name starts with a slash or a
+backslash, or with a drive specification @samp{@var{x}:/}, where
+@var{x} is the @dfn{drive letter}.
@defun file-name-absolute-p filename
This function returns @code{t} if file @var{filename} is an absolute
@@ -1850,7 +1921,6 @@ form.
@end defun
@node Directory Names
-@comment node-name, next, previous, up
@subsection Directory Names
@cindex directory name
@cindex file name of directory
@@ -1937,8 +2007,10 @@ because this is not portable. Always use
To convert a directory name to its abbreviation, use this
function:
+@cindex file name abbreviations
+@cindex abbreviated file names
@defun abbreviate-file-name filename
-@anchor{Definition of abbreviate-file-name}
+@anchor{abbreviate-file-name}
This function returns an abbreviated form of @var{filename}. It
applies the abbreviations specified in @code{directory-abbrev-alist}
(@pxref{File Aliases,,File Aliases, emacs, The GNU Emacs Manual}),
@@ -1956,11 +2028,15 @@ because it recognizes abbreviations even as part of the name.
@subsection Functions that Expand Filenames
@cindex expansion of file names
- @dfn{Expansion} of a file name means converting a relative file name
-to an absolute one. Since this is done relative to a default directory,
-you must specify the default directory name as well as the file name to
-be expanded. Expansion also simplifies file names by eliminating
-redundancies such as @file{./} and @file{@var{name}/../}.
+ @dfn{Expanding} a file name means converting a relative file name to
+an absolute one. Since this is done relative to a default directory,
+you must specify the default directory name as well as the file name
+to be expanded. It also involves expanding abbreviations like
+@file{~/}
+@ifnottex
+(@pxref{abbreviate-file-name}),
+@end ifnottex
+and eliminating redundancies like @file{./} and @file{@var{name}/../}.
@defun expand-file-name filename &optional directory
This function converts @var{filename} to an absolute file name. If
@@ -2086,7 +2162,7 @@ double all @samp{$} characters to prevent subsequent incorrect
results.
@c Wordy to avoid overfull hbox. --rjc 15mar92
-Here we assume that the environment variable @code{HOME}, which holds
+Here we assume that the environment variable @env{HOME}, which holds
the user's home directory name, has value @samp{/xcssun/users/rms}.
@example
@@ -2170,29 +2246,10 @@ programs use @code{small-temporary-file-directory} instead, if that is
non-@code{nil}. To use it, you should expand the prefix against
the proper directory before calling @code{make-temp-file}.
- In older Emacs versions where @code{make-temp-file} does not exist,
-you should use @code{make-temp-name} instead:
-
-@example
-(make-temp-name
- (expand-file-name @var{name-of-application}
- temporary-file-directory))
-@end example
-
-@defun make-temp-name string
-This function generates a string that can be used as a unique file
-name. The name starts with @var{string}, and has several random
-characters appended to it, which are different in each Emacs job. It
-is like @code{make-temp-file} except that it just constructs a name,
-and does not create a file. Another difference is that @var{string}
-should be an absolute file name. On MS-DOS, this function can
-truncate the @var{string} prefix to fit into the 8+3 file-name limits.
-@end defun
-
@defopt temporary-file-directory
-@cindex @code{TMPDIR} environment variable
-@cindex @code{TMP} environment variable
-@cindex @code{TEMP} environment variable
+@cindex @env{TMPDIR} environment variable
+@cindex @env{TMP} environment variable
+@cindex @env{TEMP} environment variable
This variable specifies the directory name for creating temporary files.
Its value should be a directory name (@pxref{Directory Names}), but it
is good for Lisp programs to cope if the value is a directory's file
@@ -2200,7 +2257,7 @@ name instead. Using the value as the second argument to
@code{expand-file-name} is a good way to achieve that.
The default value is determined in a reasonable way for your operating
-system; it is based on the @code{TMPDIR}, @code{TMP} and @code{TEMP}
+system; it is based on the @env{TMPDIR}, @env{TMP} and @env{TEMP}
environment variables, with a fall-back to a system-dependent name if
none of these variables is defined.
@@ -2226,6 +2283,21 @@ should compute the directory like this:
@end example
@end defopt
+@defun make-temp-name base-name
+This function generates a string that can be used as a unique file
+name. The name starts with @var{base-name}, and has several random
+characters appended to it, which are different in each Emacs job. It
+is like @code{make-temp-file} except that (i) it just constructs a
+name, and does not create a file, and (ii) @var{base-name} should be
+an absolute file name (on MS-DOS, this function can truncate
+@var{base-name} to fit into the 8+3 file-name limits).
+
+@strong{Warning:} In most cases, you should not use this function; use
+@code{make-temp-file} instead! This function is susceptible to a race
+condition, between the @code{make-temp-name} call and the creation of
+the file, which in some cases may cause a security hole.
+@end defun
+
@node File Name Completion
@subsection File Name Completion
@cindex file name completion subroutines
@@ -2329,49 +2401,60 @@ filter out a directory named @file{foo.elc}.
@node Standard File Names
@subsection Standard File Names
- Most of the file names used in Lisp programs are entered by the user.
-But occasionally a Lisp program needs to specify a standard file name
-for a particular use---typically, to hold customization information
-about each user. For example, abbrev definitions are stored (by
-default) in the file @file{~/.abbrev_defs}; the @code{completion}
-package stores completions in the file @file{~/.completions}. These are
-two of the many standard file names used by parts of Emacs for certain
-purposes.
-
- Various operating systems have their own conventions for valid file
-names and for which file names to use for user profile data. A Lisp
-program which reads a file using a standard file name ought to use, on
-each type of system, a file name suitable for that system. The function
-@code{convert-standard-filename} makes this easy to do.
-
-@defun convert-standard-filename filename
-This function alters the file name @var{filename} to fit the conventions
-of the operating system in use, and returns the result as a new string.
-@end defun
-
- The recommended way to specify a standard file name in a Lisp program
-is to choose a name which fits the conventions of GNU and Unix systems,
-usually with a nondirectory part that starts with a period, and pass it
-to @code{convert-standard-filename} instead of using it directly. Here
-is an example from the @code{completion} package:
+ Sometimes, an Emacs Lisp program needs to specify a standard file
+name for a particular use---typically, to hold configuration data
+specified by the current user. Usually, such files should be located
+in the directory specified by @code{user-emacs-directory}, which is
+@file{~/.emacs.d} by default (@pxref{Init File}). For example, abbrev
+definitions are stored by default in @file{~/.emacs.d/abbrev_defs}.
+The easiest way to specify such a file name is to use the function
+@code{locate-user-emacs-file}.
+
+@defun locate-user-emacs-file base-name &optional old-name
+This function returns an absolute file name for an Emacs-specific
+configuration or data file. The argument @file{base-name} should be a
+relative file name. The return value is the absolute name of a file
+in the directory specified by @code{user-emacs-directory}; if that
+directory does not exist, this function creates it.
+
+If the optional argument @var{old-name} is non-@code{nil}, it
+specifies a file in the user's home directory,
+@file{~/@var{old-name}}. If such a file exists, the return value is
+the absolute name of that file, instead of the file specified by
+@var{base-name}. This argument is intended to be used by Emacs
+packages to provide backward compatibility. For instance, prior to
+the introduction of @code{user-emacs-directory}, the abbrev file was
+located in @file{~/.abbrev_defs}. Here is the definition of
+@code{abbrev-file-name}:
@example
-(defvar save-completions-file-name
- (convert-standard-filename "~/.completions")
- "*The file name to save completions to.")
+(defcustom abbrev-file-name
+ (locate-user-emacs-file "abbrev_defs" ".abbrev_defs")
+ "Default name of file from which to read abbrevs."
+ @dots{}
+ :type 'file)
@end example
+@end defun
- On GNU and Unix systems, and on some other systems as well,
-@code{convert-standard-filename} returns its argument unchanged. On
-some other systems, it alters the name to fit the system's conventions.
+ A lower-level function for standardizing file names, which
+@code{locate-user-emacs-file} uses as a subroutine, is
+@code{convert-standard-filename}.
- For example, on MS-DOS the alterations made by this function include
-converting a leading @samp{.} to @samp{_}, converting a @samp{_} in the
-middle of the name to @samp{.} if there is no other @samp{.}, inserting
-a @samp{.} after eight characters if there is none, and truncating to
-three characters after the @samp{.}. (It makes other changes as well.)
-Thus, @file{.abbrev_defs} becomes @file{_abbrev.def}, and
-@file{.completions} becomes @file{_complet.ion}.
+@defun convert-standard-filename filename
+This function returns a file name based on @var{filename}, which fits
+the conventions of the current operating system.
+
+On GNU and Unix systems, this simply returns @var{filename}. On other
+operating systems, it may enforce system-specific file name
+conventions; for example, on MS-DOS this function performs a variety
+of changes to enforce MS-DOS file name limitations, including
+converting any leading @samp{.} to @samp{_} and truncating to three
+characters after the @samp{.}.
+
+The recommended way to use this function is to specify a name which
+fits the conventions of GNU and Unix systems, and pass it to
+@code{convert-standard-filename}.
+@end defun
@node Contents of Directories
@section Contents of Directories
@@ -2550,7 +2633,6 @@ no prefix argument is given, and @code{nil} otherwise.
@section Making Certain File Names ``Magic''
@cindex magic file names
-@c Emacs 19 feature
You can implement special handling for certain file names. This is
called making those names @dfn{magic}. The principal use for this
feature is in implementing remote file names (@pxref{Remote Files,,
@@ -2559,7 +2641,7 @@ Remote Files, emacs, The GNU Emacs Manual}).
To define a kind of magic file name, you must supply a regular
expression to define the class of names (all those that match the
regular expression), plus a handler that implements all the primitive
-Emacs file operations for file names that do match.
+Emacs file operations for file names that match.
@vindex file-name-handler-alist
The variable @code{file-name-handler-alist} holds a list of handlers,
@@ -2645,9 +2727,9 @@ first, before handlers for jobs such as remote file access.
@code{file-name-nondirectory},
@code{file-name-sans-versions}, @code{file-newer-than-file-p},
@code{file-ownership-preserved-p},
-@code{file-readable-p}, @code{file-regular-p}, @code{file-symlink-p},
-@code{file-truename}, @code{file-writable-p},
-@code{find-backup-file-name},
+@code{file-readable-p}, @code{file-regular-p}, @code{file-in-directory-p},
+@code{file-symlink-p}, @code{file-truename}, @code{file-writable-p},
+@code{file-equal-p}, @code{find-backup-file-name},
@c Not sure why it was here: @code{find-file-noselect},@*
@code{get-file-buffer},
@code{insert-directory},
@@ -2723,7 +2805,7 @@ unlocking the buffer if it is locked.
possibly others to be added in the future. It need not implement all
these operations itself---when it has nothing special to do for a
certain operation, it can reinvoke the primitive, to handle the
-operation ``in the usual way.'' It should always reinvoke the primitive
+operation ``in the usual way''. It should always reinvoke the primitive
for an operation it does not recognize. Here's one way to do this:
@smallexample
@@ -2857,30 +2939,29 @@ is a good way to come up with one.
@end defun
@defopt remote-file-name-inhibit-cache
-Whether to use the remote file-name cache for read access.
-
-File attributes of remote files are cached for better performance. If
-they are changed out of Emacs' control, the cached values become
+The attributes of remote files can be cached for better performance. If
+they are changed outside of Emacs's control, the cached values become
invalid, and must be reread.
-When set to @code{nil}, cached values are always used. This shall be
-set with care. When set to @code{t}, cached values are never used.
-ALthough this is the safest value, it could result in performance
-degradation.
+When this variable is set to @code{nil}, cached values are never
+expired. Use this setting with caution, only if you are sure nothing
+other than Emacs ever changes the remote files. If it is set to
+@code{t}, cached values are never used. This is the safest value, but
+could result in performance degradation.
A compromise is to set it to a positive number. This means that
cached values are used for that amount of seconds since they were
-cached.
-
-In case a remote file is checked regularly, it might be reasonable to
-let-bind this variable to a value less then the time period between
-two checks. Example:
+cached. If a remote file is checked regularly, it might be a good
+idea to let-bind this variable to a value less than the time period
+between consecutive checks. For example:
@example
(defun display-time-file-nonempty-p (file)
- (let ((remote-file-name-inhibit-cache (- display-time-interval 5)))
+ (let ((remote-file-name-inhibit-cache
+ (- display-time-interval 5)))
(and (file-exists-p file)
- (< 0 (nth 7 (file-attributes (file-chase-links file)))))))
+ (< 0 (nth 7 (file-attributes
+ (file-chase-links file)))))))
@end example
@end defopt
@@ -3055,10 +3136,10 @@ in the order of appearance in the list.
This command writes the current buffer contents into the file @var{file}
in a format based on @var{format}, which is a list of format names. It
constructs the actual format starting from @var{format}, then appending
-any elements from the value of @code{buffer-file-format} with a non-nil
-@var{preserve} flag (see above), if they are not already present in
-@var{format}. It then updates @code{buffer-file-format} with this
-format, making it the default for future saves. Except for the
+any elements from the value of @code{buffer-file-format} with a
+non-@code{nil} @var{preserve} flag (see above), if they are not already
+present in @var{format}. It then updates @code{buffer-file-format} with
+this format, making it the default for future saves. Except for the
@var{format} argument, this command is similar to @code{write-file}. In
particular, @var{confirm} has the same meaning and interactive treatment
as the corresponding argument to @code{write-file}. @xref{Definition of
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index dad1f28026e..846dfbaf17c 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -1,10 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
-@c Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/frames
-@node Frames, Positions, Windows, Top
+@node Frames
@chapter Frames
@cindex frame
@@ -24,26 +22,25 @@ into smaller windows. @xref{Splitting Windows}.
more Emacs frames. In Emacs Lisp, a @dfn{terminal object} is a Lisp
object that represents a terminal. @xref{Terminal Type}.
-@cindex terminal frame
-@cindex window frame
- There are two classes of terminals: text-only terminals and
-graphical terminals. Text-only terminals are non-graphics-capable
-display devices, including ``terminal emulators'' such as xterm. On
-text-only terminals, each frame occupies the entire terminal screen;
-although you can create additional frames and switch between them,
-only one frame can be shown at any given time. We refer to frames on
-text-only terminals as @dfn{terminal frames}. Graphical terminals, on
-the other hand, are graphics-capable windowing systems, such as the X
-Window System. On a graphical terminal, Emacs can display multiple
-frames simultaneously. We refer to such frames as @dfn{window
-frames}.
+@cindex text terminal
+@cindex graphical terminal
+@cindex graphical display
+ There are two classes of terminals: @dfn{text terminals} and
+@dfn{graphical terminals}. Text terminals are non-graphics-capable
+displays, including @command{xterm} and other terminal emulators. On
+a text terminal, each Emacs frame occupies the terminal's entire
+screen; although you can create additional frames and switch between
+them, the terminal only shows one frame at a time. Graphical
+terminals, on the other hand, are managed by graphical display systems
+such as the X Window System, which allow Emacs to show multiple frames
+simultaneously on the same display.
On GNU and Unix systems, you can create additional frames on any
available terminal, within a single Emacs session, regardless of
-whether Emacs was started on a text-only or graphical terminal. Emacs
-can display on both graphical and text-only terminals simultaneously.
-This comes in handy, for instance, when you connect to the same
-session from several remote locations. @xref{Multiple Terminals}.
+whether Emacs was started on a text or graphical terminal. Emacs can
+display on both graphical and text terminals simultaneously. This
+comes in handy, for instance, when you connect to the same session
+from several remote locations. @xref{Multiple Terminals}.
@defun framep object
This predicate returns a non-@code{nil} value if @var{object} is a
@@ -51,14 +48,15 @@ frame, and @code{nil} otherwise. For a frame, the value indicates which
kind of display the frame uses:
@table @code
-@item x
-The frame is displayed in an X window.
@item t
-A terminal frame on a character display.
+The frame is displayed on a text terminal.
+@item x
+The frame is displayed on an X graphical terminal.
@item w32
-The frame is displayed on MS-Windows 9X/NT.
+The frame is displayed on a MS-Windows graphical terminal.
@item ns
-The frame is displayed on a GNUstep or Macintosh Cocoa display.
+The frame is displayed on a GNUstep or Macintosh Cocoa graphical
+terminal.
@item pc
The frame is displayed on an MS-DOS terminal.
@end table
@@ -72,10 +70,10 @@ selected frame.
@defun terminal-live-p object
This predicate returns a non-@code{nil} value if @var{object} is a
-terminal that is alive (i.e.@: was not deleted), and @code{nil}
-otherwise. For live terminals, the return value indicates what kind
-of frames are displayed on that terminal; the list of possible values
-is the same as for @code{framep} above.
+terminal that is live (i.e.@: not deleted), and @code{nil} otherwise.
+For live terminals, the return value indicates what kind of frames are
+displayed on that terminal; the list of possible values is the same as
+for @code{framep} above.
@end defun
@menu
@@ -100,7 +98,7 @@ is the same as for @code{framep} above.
* Window System Selections:: Transferring text to and from other X clients.
* Drag and Drop:: Internals of Drag-and-Drop implementation.
* Color Names:: Getting the definitions of color names.
-* Text Terminal Colors:: Defining colors for text-only terminals.
+* Text Terminal Colors:: Defining colors for text terminals.
* Resources:: Getting resource values from the server.
* Display Feature Testing:: Determining the features of a terminal.
@end menu
@@ -110,7 +108,7 @@ is the same as for @code{framep} above.
To create a new frame, call the function @code{make-frame}.
-@defun make-frame &optional alist
+@deffn Command make-frame &optional alist
This function creates and returns a new frame, displaying the current
buffer.
@@ -119,7 +117,7 @@ for the new frame. @xref{Frame Parameters}. If you specify the
@code{terminal} parameter in @var{alist}, the new frame is created on
that terminal. Otherwise, if you specify the @code{window-system}
frame parameter in @var{alist}, that determines whether the frame
-should be displayed on a text-only or graphical terminal.
+should be displayed on a text terminal or a graphical terminal.
@xref{Window Systems}. If neither is specified, the new frame is
created in the same terminal as the selected frame.
@@ -136,7 +134,7 @@ This function itself does not make the new frame the selected frame.
@xref{Input Focus}. The previously selected frame remains selected.
On graphical terminals, however, the windowing system may select the
new frame for its own reasons.
-@end defun
+@end deffn
@defvar before-make-frame-hook
A normal hook run by @code{make-frame} before it creates the frame.
@@ -164,15 +162,15 @@ frame.
@cindex multiple X displays
@cindex displays, multiple
- Emacs represents each terminal, whether graphical or text-only, as a
-@dfn{terminal object} data type (@pxref{Terminal Type}). On GNU and
-Unix systems, Emacs can use multiple terminals simultaneously in each
-session. On other systems, it can only use a single terminal. Each
-terminal object has the following attributes:
+ Emacs represents each terminal as a @dfn{terminal object} data type
+(@pxref{Terminal Type}). On GNU and Unix systems, Emacs can use
+multiple terminals simultaneously in each session. On other systems,
+it can only use a single terminal. Each terminal object has the
+following attributes:
@itemize @bullet
@item
-The name of the device used by the terminal (e.g., @samp{:0.0} or
+The name of the device used by the terminal (e.g.@: @samp{:0.0} or
@file{/dev/tty}).
@item
@@ -181,7 +179,7 @@ The terminal and keyboard coding systems used on the terminal.
@item
The kind of display associated with the terminal. This is the symbol
-returned by the function @code{terminal-live-p} (i.e., @code{x},
+returned by the function @code{terminal-live-p} (i.e.@: @code{x},
@code{t}, @code{w32}, @code{ns}, or @code{pc}). @xref{Frames}.
@item
@@ -190,7 +188,7 @@ A list of terminal parameters. @xref{Terminal Parameters}.
There is no primitive for creating terminal objects. Emacs creates
them as needed, such as when you call @code{make-frame-on-display}
-(which is described below).
+(described below).
@defun terminal-name &optional terminal
This function returns the file name of the device used by
@@ -200,7 +198,7 @@ a frame, meaning that frame's terminal.
@end defun
@defun terminal-list
-This function returns a list of all terminal objects currently in use.
+This function returns a list of all live terminal objects.
@end defun
@defun get-device-terminal device
@@ -249,15 +247,15 @@ never be buffer-local (@pxref{Buffer-Local Variables}).
On GNU and Unix systems, each X display is a separate graphical
terminal. When Emacs is started from within the X window system, it
-uses the X display chosen with the @code{DISPLAY} environment
-variable, or with the @samp{--display} option. @xref{Initial
-Options,,, emacs, The GNU Emacs Manual}. Emacs can connect to other X
-displays via the command @code{make-frame-on-display}. Each X display
-has its own selected frame and its own minibuffer windows; however,
-only one of those frames is ``@emph{the} selected frame'' at any given
-moment (@pxref{Input Focus}). Emacs can even connect to other
-text-only terminals, by interacting with the @command{emacsclient}
-program. @xref{Emacs Server,,, emacs, The GNU Emacs Manual}.
+uses the X display specified by the @env{DISPLAY} environment
+variable, or by the @samp{--display} option (@pxref{Initial Options,,,
+emacs, The GNU Emacs Manual}). Emacs can connect to other X displays
+via the command @code{make-frame-on-display}. Each X display has its
+own selected frame and its own minibuffer windows; however, only one
+of those frames is ``@emph{the} selected frame'' at any given moment
+(@pxref{Input Focus}). Emacs can even connect to other text
+terminals, by interacting with the @command{emacsclient} program.
+@xref{Emacs Server,,, emacs, The GNU Emacs Manual}.
A single X server can handle more than one display. Each X display
has a three-part name, @samp{@var{host}:@var{server}.@var{screen}}.
@@ -268,8 +266,8 @@ server, Emacs knows by the similarity in their names that they share a
single keyboard.
On some ``multi-monitor'' setups, a single X display outputs to more
-than one monitor. Currently, there is no way for Emacs to distinguish
-between the different physical monitors.
+than one physical monitor. Currently, there is no way for Emacs to
+distinguish between the different physical monitors.
@deffn Command make-frame-on-display display &optional parameters
This function creates and returns a new frame on @var{display}, taking
@@ -278,8 +276,8 @@ the other frame parameters from the alist @var{parameters}.
Before creating the frame, this function ensures that Emacs is ``set
up'' to display graphics. For instance, if Emacs has not processed X
-resources (e.g., if it was started on a text-only terminal), it does
-so at this time. In all other respects, this function behaves like
+resources (e.g.@: if it was started on a text terminal), it does so at
+this time. In all other respects, this function behaves like
@code{make-frame} (@pxref{Creating Frames}).
@end deffn
@@ -325,15 +323,15 @@ on that display (@pxref{Deleting Frames}).
Just what parameters a frame has depends on what display mechanism it
uses.
- Frame parameters exist mostly for the sake of window systems. A
-terminal frame has a few parameters, mostly for compatibility's sake;
-only the @code{height}, @code{width}, @code{name}, @code{title},
-@code{menu-bar-lines}, @code{buffer-list} and @code{buffer-predicate}
-parameters do something special. If the terminal supports colors, the
-parameters @code{foreground-color}, @code{background-color},
-@code{background-mode} and @code{display-type} are also meaningful.
-If the terminal supports frame transparency, the parameter
-@code{alpha} is also meaningful.
+ Frame parameters exist mostly for the sake of graphical displays.
+Most frame parameters have no effect when applied to a frame on a text
+terminal; only the @code{height}, @code{width}, @code{name},
+@code{title}, @code{menu-bar-lines}, @code{buffer-list} and
+@code{buffer-predicate} parameters do something special. If the
+terminal supports colors, the parameters @code{foreground-color},
+@code{background-color}, @code{background-mode} and
+@code{display-type} are also meaningful. If the terminal supports
+frame transparency, the parameter @code{alpha} is also meaningful.
@menu
* Parameter Access:: How to change a frame's parameters.
@@ -387,12 +385,13 @@ parameter values to frames that will be created henceforth.
@node Initial Parameters
@subsection Initial Frame Parameters
-You can specify the parameters for the initial startup frame
-by setting @code{initial-frame-alist} in your init file (@pxref{Init File}).
+You can specify the parameters for the initial startup frame by
+setting @code{initial-frame-alist} in your init file (@pxref{Init
+File}).
@defopt initial-frame-alist
-This variable's value is an alist of parameter values used when creating
-the initial window frame. You can set this variable to specify the
+This variable's value is an alist of parameter values used when
+creating the initial frame. You can set this variable to specify the
appearance of the initial frame without altering subsequent frames.
Each element has the form:
@@ -420,15 +419,16 @@ the initial frame, specify the same parameters in
@code{initial-frame-alist} with values that match the X resources.
@end defopt
-If these parameters specify a separate minibuffer-only frame with
-@code{(minibuffer . nil)}, and you have not created one, Emacs creates
-one for you.
+@cindex minibuffer-only frame
+If these parameters include @code{(minibuffer . nil)}, that indicates
+that the initial frame should have no minibuffer. In this case, Emacs
+creates a separate @dfn{minibuffer-only frame} as well.
@defopt minibuffer-frame-alist
This variable's value is an alist of parameter values used when
-creating an initial minibuffer-only frame. This is the
-minibuffer-only frame that Emacs creates if @code{initial-frame-alist}
-specifies a frame with no minibuffer.
+creating an initial minibuffer-only frame (i.e.@: the minibuffer-only
+frame that Emacs creates if @code{initial-frame-alist} specifies a
+frame with no minibuffer).
@end defopt
@defopt default-frame-alist
@@ -437,18 +437,18 @@ Emacs frames---the first frame, and subsequent frames. When using the X
Window System, you can get the same results by means of X resources
in many cases.
-Setting this variable does not affect existing frames.
+Setting this variable does not affect existing frames. Furthermore,
+functions that display a buffer in a separate frame may override the
+default parameters by supplying their own parameters.
@end defopt
-Functions that display a buffer in a separate frame can override the
-default parameters by supplying their own parameters. @xref{Definition
-of special-display-frame-alist}.
-
-If you use options that specify window appearance when you invoke Emacs,
-they take effect by adding elements to @code{default-frame-alist}. One
-exception is @samp{-geometry}, which adds the specified position to
-@code{initial-frame-alist} instead. @xref{Emacs Invocation,, Command
-Line Arguments for Emacs Invocation, emacs, The GNU Emacs Manual}.
+If you invoke Emacs with command-line options that specify frame
+appearance, those options take effect by adding elements to either
+@code{initial-frame-alist} or @code{default-frame-alist}. Options
+which affect just the initial frame, such as @samp{-geometry} and
+@samp{--maximized}, add to @code{initial-frame-alist}; the others add
+to @code{default-frame-alist}. @pxref{Emacs Invocation,, Command Line
+Arguments for Emacs Invocation, emacs, The GNU Emacs Manual}.
@node Window Frame Parameters
@subsection Window Frame Parameters
@@ -459,8 +459,8 @@ it uses. This section describes the parameters that have special
meanings on some or all kinds of terminals. Of these, @code{name},
@code{title}, @code{height}, @code{width}, @code{buffer-list} and
@code{buffer-predicate} provide meaningful information in terminal
-frames, and @code{tty-color-mode} is meaningful @emph{only} in
-terminal frames.
+frames, and @code{tty-color-mode} is meaningful only for frames on
+text terminals.
@menu
* Basic Parameters:: Parameters that are fundamental.
@@ -485,7 +485,7 @@ frame. @code{title} and @code{name} are meaningful on all terminals.
@item display
The display on which to open this frame. It should be a string of the
form @code{"@var{host}:@var{dpy}.@var{screen}"}, just like the
-@code{DISPLAY} environment variable.
+@env{DISPLAY} environment variable.
@vindex display-type, a frame parameter
@item display-type
@@ -524,7 +524,7 @@ named, this parameter will be @code{nil}.
@cindex window position on display
Position parameters' values are normally measured in pixels, but on
-text-only terminals they count characters or lines instead.
+text terminals they count characters or lines instead.
@table @code
@vindex left, a frame parameter
@@ -561,19 +561,17 @@ to the top (or bottom) edge of the screen. It works just like
@vindex icon-left, a frame parameter
@item icon-left
-The screen position of the left edge @emph{of the frame's icon}, in
-pixels, counting from the left edge of the screen. This takes effect if
-and when the frame is iconified.
-
-If you specify a value for this parameter, then you must also specify
-a value for @code{icon-top} and vice versa. The window manager may
-ignore these two parameters.
+The screen position of the left edge of the frame's icon, in pixels,
+counting from the left edge of the screen. This takes effect when the
+frame is iconified, if the window manager supports this feature. If
+you specify a value for this parameter, then you must also specify a
+value for @code{icon-top} and vice versa.
@vindex icon-top, a frame parameter
@item icon-top
-The screen position of the top edge @emph{of the frame's icon}, in
-pixels, counting from the top edge of the screen. This takes effect if
-and when the frame is iconified.
+The screen position of the top edge of the frame's icon, in pixels,
+counting from the top edge of the screen. This takes effect when the
+frame is iconified, if the window manager supports this feature.
@vindex user-position, a frame parameter
@item user-position
@@ -601,8 +599,9 @@ parameters represent the user's stated preference; otherwise, use
@subsubsection Size Parameters
@cindex window size on display
- Size parameters' values are normally measured in pixels, but on
-text-only terminals they count characters or lines instead.
+ Frame parameters specify frame sizes in character units. On
+graphical displays, the @code{default} face determines the actual
+pixel sizes of these character units (@pxref{Face Attributes}).
@table @code
@vindex height, a frame parameter
@@ -757,8 +756,9 @@ If non-@code{nil}, this frame's window is never split automatically.
@subsubsection Window Management Parameters
@cindex window manager interaction, and frame parameters
- These frame parameters, meaningful only on window system displays,
-interact with the window manager.
+ The following frame parameters control various aspects of the
+frame's interaction with the window manager. They have no effect on
+text terminals.
@table @code
@vindex visibility, a frame parameter
@@ -769,11 +769,13 @@ iconified. @xref{Visibility of Frames}.
@vindex auto-raise, a frame parameter
@item auto-raise
-Whether selecting the frame raises it (non-@code{nil} means yes).
+If non-@code{nil}, Emacs automatically raises the frame when it is
+selected. Some window managers do not allow this.
@vindex auto-lower, a frame parameter
@item auto-lower
-Whether deselecting the frame lowers it (non-@code{nil} means yes).
+If non-@code{nil}, Emacs automatically lowers the frame when it is
+deselected. Some window managers do not allow this.
@vindex icon-type, a frame parameter
@item icon-type
@@ -789,12 +791,15 @@ appears. If this is @code{nil}, the frame's title is used.
@vindex window-id, a frame parameter
@item window-id
-The number of the window-system window used by the frame
-to contain the actual Emacs windows.
+The ID number which the graphical display uses for this frame. Emacs
+assigns this parameter when the frame is created; changing the
+parameter has no effect on the actual ID number.
@vindex outer-window-id, a frame parameter
@item outer-window-id
-The number of the outermost window-system window used for the whole frame.
+The ID number of the outermost window-system window in which the frame
+exists. As with @code{window-id}, changing this parameter has no
+actual effect.
@vindex wait-for-wm, a frame parameter
@item wait-for-wm
@@ -849,16 +854,33 @@ Display a horizontal bar @var{height} pixels high.
@end table
@vindex cursor-type
-The buffer-local variable @code{cursor-type} overrides the value of
-the @code{cursor-type} frame parameter, but if it is @code{t}, that
-means to use the cursor specified for the frame.
+The @code{cursor-type} frame parameter may be overridden by the
+variables @code{cursor-type} and
+@code{cursor-in-non-selected-windows}:
+
+@defvar cursor-type
+This buffer-local variable controls how the cursor looks in a selected
+window showing the buffer. If its value is @code{t}, that means to
+use the cursor specified by the @code{cursor-type} frame parameter.
+Otherwise, the value should be one of the cursor types listed above,
+and it overrides the @code{cursor-type} frame parameter.
+@end defvar
+
+@defopt cursor-in-non-selected-windows
+This buffer-local variable controls how the cursor looks in a window
+that is not selected. It supports the same values as the
+@code{cursor-type} frame parameter; also, @code{nil} means don't
+display a cursor in nonselected windows, and @code{t} (the default)
+means use a standard modification of the usual cursor type (solid box
+becomes hollow box, and bar becomes a narrower bar).
+@end defopt
@defopt blink-cursor-alist
This variable specifies how to blink the cursor. Each element has the
form @code{(@var{on-state} . @var{off-state})}. Whenever the cursor
type equals @var{on-state} (comparing using @code{equal}), the
corresponding @var{off-state} specifies what the cursor looks like
-when it blinks ``off.'' Both @var{on-state} and @var{off-state}
+when it blinks ``off''. Both @var{on-state} and @var{off-state}
should be suitable values for the @code{cursor-type} frame parameter.
There are various defaults for how to blink each type of cursor, if
@@ -867,15 +889,6 @@ variable do not take effect immediately, only when you specify the
@code{cursor-type} frame parameter.
@end defopt
-@defopt cursor-in-non-selected-windows
-This variable controls how the cursor looks in a window that is not
-selected. It supports the same values as the @code{cursor-type} frame
-parameter; also, @code{nil} means don't display a cursor in
-nonselected windows, and @code{t} (the default) means use a standard
-modification of the usual cursor type (solid box becomes hollow box,
-and bar becomes a narrower bar).
-@end defopt
-
@node Font and Color Parameters
@subsubsection Font and Color Parameters
@cindex font and color, frame parameters
@@ -888,9 +901,11 @@ and bar becomes a narrower bar).
A list of symbols, specifying the @dfn{font backends} to use for
drawing fonts in the frame, in order of priority. On X, there are
currently two available font backends: @code{x} (the X core font
-driver) and @code{xft} (the Xft font driver). On other systems, there
-is only one available font backend, so it does not make sense to
-modify this frame parameter.
+driver) and @code{xft} (the Xft font driver). On Windows, there are
+currently two available font backends: @code{gdi} and
+@code{uniscribe} (@pxref{Windows Fonts,,, emacs, The GNU Emacs
+Manual}). On other systems, there is only one available font backend,
+so it does not make sense to modify this frame parameter.
@vindex background-mode, a frame parameter
@item background-mode
@@ -902,7 +917,7 @@ to whether the background color is a light one or a dark one.
@cindex standard colors for character terminals
This parameter overrides the terminal's color support as given by the
system's terminal capabilities database in that this parameter's value
-specifies the color mode to use in terminal frames. The value can be
+specifies the color mode to use on a text terminal. The value can be
either a symbol or a number. A number specifies the number of colors
to use (and, indirectly, what commands to issue to produce each
color). For example, @code{(tty-color-mode . 8)} specifies use of the
@@ -1046,17 +1061,17 @@ selected frame.
@defunx frame-pixel-width &optional frame
These functions return the height and width of the main display area
of @var{frame}, measured in pixels. If you don't supply @var{frame},
-they use the selected frame. For a text-only terminal, the results are
-in characters rather than pixels.
+they use the selected frame. For a text terminal, the results are in
+characters rather than pixels.
-These values include the internal borders, and windows' scroll bars and
-fringes (which belong to individual windows, not to the frame itself).
-The exact value of the heights depends on the window-system and toolkit
-in use. With Gtk+, the height does not include any tool bar or menu
-bar. With the Motif or Lucid toolkits, it includes the tool bar but
-not the menu bar. In a graphical version with no toolkit, it includes
-both the tool bar and menu bar. For a text-only terminal, the result
-includes the menu bar.
+These values include the internal borders, and windows' scroll bars
+and fringes (which belong to individual windows, not to the frame
+itself). The exact value of the heights depends on the window-system
+and toolkit in use. With GTK+, the height does not include any tool
+bar or menu bar. With the Motif or Lucid toolkits, it includes the
+tool bar but not the menu bar. In a graphical version with no
+toolkit, it includes both the tool bar and menu bar. For a text
+terminal, the result includes the menu bar.
@end defun
@defun frame-char-height &optional frame
@@ -1083,13 +1098,13 @@ fit.
If @var{pretend} is non-@code{nil}, then Emacs displays @var{lines}
lines of output in @var{frame}, but does not change its value for the
-actual height of the frame. This is only useful for a terminal frame.
+actual height of the frame. This is only useful on text terminals.
Using a smaller height than the terminal actually implements may be
useful to reproduce behavior observed on a smaller screen, or if the
terminal malfunctions when using its whole screen. Setting the frame
height ``for real'' does not always work, because knowing the correct
-actual size may be necessary for correct cursor positioning on a
-terminal frame.
+actual size may be necessary for correct cursor positioning on
+text terminals.
@end defun
@defun set-frame-width frame width &optional pretend
@@ -1098,12 +1113,20 @@ The argument @var{pretend} has the same meaning as in
@code{set-frame-height}.
@end defun
-@findex set-screen-height
-@findex set-screen-width
- The older functions @code{set-screen-height} and
-@code{set-screen-width} were used to specify the height and width of the
-screen, in Emacs versions that did not support multiple frames. They
-are semi-obsolete, but still work; they apply to the selected frame.
+@c FIXME? Belongs more in Emacs manual than here?
+@c But eg fit-window-to-buffer is in this manual.
+@deffn Command fit-frame-to-buffer &optional frame max-height min-height
+This command adjusts the height of @var{frame} (the default is the
+selected frame) to fit its contents. The optional arguments
+@var{max-height} and @var{min-height} specify the maximum and minimum
+new frame heights, respectively.
+
+@vindex fit-frame-to-buffer-bottom-margin
+The default minimum height corresponds to @code{window-min-height}.
+The default maximum height is the screen height below the current top
+position of the frame, minus any margin specified by the option
+@code{fit-frame-to-buffer-bottom-margin}.
+@end deffn
@node Geometry
@subsection Geometry
@@ -1229,9 +1252,10 @@ while processing @code{frame-title-format} or
@section Deleting Frames
@cindex deleting frames
-Frames remain potentially visible until you explicitly @dfn{delete}
-them. A deleted frame cannot appear on the screen, but continues to
-exist as a Lisp object until there are no references to it.
+ A @dfn{live frame} is one that has not been deleted. When a frame
+is deleted, it is removed from its terminal display, although it may
+continue to exist as a Lisp object until there are no more references
+to it.
@deffn Command delete-frame &optional frame force
@vindex delete-frame-functions
@@ -1262,25 +1286,25 @@ calls the function @code{delete-frame}. @xref{Misc Events}.
@cindex frames, scanning all
@defun frame-list
-The function @code{frame-list} returns a list of all the live frames,
-i.e.@: those that have not been deleted. It is analogous to
-@code{buffer-list} for buffers, and includes frames on all terminals.
-The list that you get is newly created, so modifying the list doesn't
-have any effect on the internals of Emacs.
+This function returns a list of all the live frames, i.e.@: those that
+have not been deleted. It is analogous to @code{buffer-list} for
+buffers, and includes frames on all terminals. The list that you get
+is newly created, so modifying the list doesn't have any effect on the
+internals of Emacs.
@end defun
@defun visible-frame-list
This function returns a list of just the currently visible frames.
-@xref{Visibility of Frames}. (Terminal frames always count as
-``visible,'' even though only the selected one is actually displayed.)
+@xref{Visibility of Frames}. Frames on text terminals always count as
+``visible'', even though only the selected one is actually displayed.
@end defun
@defun next-frame &optional frame minibuf
-The function @code{next-frame} lets you cycle conveniently through all
-the frames on the current display from an arbitrary starting point. It
-returns the ``next'' frame after @var{frame} in the cycle. If
-@var{frame} is omitted or @code{nil}, it defaults to the selected frame
-(@pxref{Input Focus}).
+This function lets you cycle conveniently through all the frames on
+the current display from an arbitrary starting point. It returns the
+``next'' frame after @var{frame} in the cycle. If @var{frame} is
+omitted or @code{nil}, it defaults to the selected frame (@pxref{Input
+Focus}).
The second argument, @var{minibuf}, says which frames to consider:
@@ -1368,23 +1392,23 @@ function @code{select-frame}. This does not alter the window system's
concept of focus; rather, it escapes from the window manager's control
until that control is somehow reasserted.
-When using a text-only terminal, only one frame can be displayed at a
-time on the terminal, so after a call to @code{select-frame}, the next
+When using a text terminal, only one frame can be displayed at a time
+on the terminal, so after a call to @code{select-frame}, the next
redisplay actually displays the newly selected frame. This frame
remains selected until a subsequent call to @code{select-frame}. Each
-terminal frame has a number which appears in the mode line before the
-buffer name (@pxref{Mode Line Variables}).
+frame on a text terminal has a number which appears in the mode line
+before the buffer name (@pxref{Mode Line Variables}).
-@defun select-frame-set-input-focus frame
+@defun select-frame-set-input-focus frame &optional norecord
This function selects @var{frame}, raises it (should it happen to be
-obscured by other frames) and tries to give it the X server's focus. On
-a text-only terminal, the next redisplay displays the new frame on the
-entire terminal screen. The return value of this function is not
-significant.
+obscured by other frames) and tries to give it the X server's focus.
+On a text terminal, the next redisplay displays the new frame on the
+entire terminal screen. The optional argument @var{norecord} has the
+same meaning as for @code{select-frame} (see below). The return value
+of this function is not significant.
@end defun
-@c ??? This is not yet implemented properly.
-@defun select-frame frame &optional norecord
+@deffn Command select-frame frame &optional norecord
This function selects frame @var{frame}, temporarily disregarding the
focus of the X server if any. The selection of @var{frame} lasts until
the next time the user does something to select a different frame, or
@@ -1393,19 +1417,21 @@ window system, the previously selected frame may be restored as the
selected frame after return to the command loop, because it still may
have the window system's input focus.)
-The specified @var{frame} becomes the selected frame, as explained
-above, and the terminal that @var{frame} is on becomes the selected
-terminal. The window selected within @var{frame} becomes the selected
-window. This function returns @var{frame}, or @code{nil} if @var{frame}
-has been deleted.
+The specified @var{frame} becomes the selected frame, and its terminal
+becomes the selected terminal. This function then calls
+@code{select-window} as a subroutine, passing the window selected
+within @var{frame} as its first argument and @var{norecord} as its
+second argument (hence, if @var{norecord} is non-@code{nil}, this
+avoids changing the order of recently selected windows nor the buffer
+list). @xref{Selecting Windows}.
-Optional argument @var{norecord} non-@code{nil} means to neither change
-the order of recently selected windows nor the buffer list. @xref{The
-Buffer List}.
+This function returns @var{frame}, or @code{nil} if @var{frame} has
+been deleted.
-In general, you should never use @code{select-frame} in a way that could
-switch to a different terminal without switching back when you're done.
-@end defun
+In general, you should never use @code{select-frame} in a way that
+could switch to a different terminal without switching back when
+you're done.
+@end deffn
Emacs cooperates with the window system by arranging to select frames as
the server and window manager request. It does so by generating a
@@ -1463,20 +1489,35 @@ position consistent with the new selected frame.
@cindex visible frame
@cindex invisible frame
@cindex iconified frame
+@cindex minimized frame
@cindex frame visibility
-A window frame may be @dfn{visible}, @dfn{invisible}, or
-@dfn{iconified}. If it is visible, you can see its contents, unless
-other windows cover it. If it is iconified, the frame's contents do
-not appear on the screen, but an icon does. (Note: because of the
-way in which some window managers implement the concept of multiple
-workspaces, or desktops, all frames on other workspaces may appear to
-Emacs to be iconified.) If the frame is invisible, it doesn't show on
-the screen, not even as an icon.
+A frame on a graphical display may be @dfn{visible}, @dfn{invisible},
+or @dfn{iconified}. If it is visible, its contents are displayed in
+the usual manner. If it is iconified, its contents are not displayed,
+but there is a little icon somewhere to bring the frame back into view
+(some window managers refer to this state as @dfn{minimized} rather
+than @dfn{iconified}, but from Emacs' point of view they are the same
+thing). If a frame is invisible, it is not displayed at all.
-Visibility is meaningless for terminal frames, since only the selected
+ Visibility is meaningless on text terminals, since only the selected
one is actually displayed in any case.
+@defun frame-visible-p frame
+This function returns the visibility status of frame @var{frame}. The
+value is @code{t} if @var{frame} is visible, @code{nil} if it is
+invisible, and @code{icon} if it is iconified.
+
+On a text terminal, all frames are considered ``visible'' for the
+purposes of this function, even though only one frame is displayed.
+@xref{Raising and Lowering}.
+@end defun
+
+@deffn Command iconify-frame &optional frame
+This function iconifies frame @var{frame}. If you omit @var{frame}, it
+iconifies the selected frame.
+@end deffn
+
@deffn Command make-frame-visible &optional frame
This function makes frame @var{frame} visible. If you omit
@var{frame}, it makes the selected frame visible. This does not raise
@@ -1492,51 +1533,24 @@ Unless @var{force} is non-@code{nil}, this function refuses to make
@var{frame} invisible if all other frames are invisible..
@end deffn
-@deffn Command iconify-frame &optional frame
-This function iconifies frame @var{frame}. If you omit @var{frame}, it
-iconifies the selected frame.
-@end deffn
-
-@defun frame-visible-p frame
-This returns the visibility status of frame @var{frame}. The value is
-@code{t} if @var{frame} is visible, @code{nil} if it is invisible, and
-@code{icon} if it is iconified.
-
-On a text-only terminal, all frames are considered visible, whether
-they are currently being displayed or not, and this function returns
-@code{t} for all frames.
-@end defun
-
The visibility status of a frame is also available as a frame
parameter. You can read or change it as such. @xref{Management
-Parameters}.
-
- The user can iconify and deiconify frames with the window manager.
-This happens below the level at which Emacs can exert any control, but
-Emacs does provide events that you can use to keep track of such
-changes. @xref{Misc Events}.
+Parameters}. The user can also iconify and deiconify frames with the
+window manager. This happens below the level at which Emacs can exert
+any control, but Emacs does provide events that you can use to keep
+track of such changes. @xref{Misc Events}.
@node Raising and Lowering
@section Raising and Lowering Frames
- Most window systems use a desktop metaphor. Part of this metaphor is
-the idea that windows are stacked in a notional third dimension
-perpendicular to the screen surface, and thus ordered from ``highest''
-to ``lowest.'' Where two windows overlap, the one higher up covers
-the one underneath. Even a window at the bottom of the stack can be
-seen if no other window overlaps it.
-
-@c @cindex raising a frame redundant with raise-frame
+@cindex raising a frame
@cindex lowering a frame
- A window's place in this ordering is not fixed; in fact, users tend
-to change the order frequently. @dfn{Raising} a window means moving
-it ``up,'' to the top of the stack. @dfn{Lowering} a window means
-moving it to the bottom of the stack. This motion is in the notional
-third dimension only, and does not change the position of the window
-on the screen.
-
- With Emacs, frames constitute the windows in the metaphor sketched
-above. You can raise and lower frames using these functions:
+ Most window systems use a desktop metaphor. Part of this metaphor
+is the idea that system-level windows (e.g.@: Emacs frames) are
+stacked in a notional third dimension perpendicular to the screen
+surface. Where two overlap, the one higher up covers the one
+underneath. You can @dfn{raise} or @dfn{lower} a frame using the
+functions @code{raise-frame} and @code{lower-frame}.
@deffn Command raise-frame &optional frame
This function raises frame @var{frame} (default, the selected frame).
@@ -1552,9 +1566,21 @@ If this is non-@code{nil}, activation of the minibuffer raises the frame
that the minibuffer window is in.
@end defopt
-You can also enable auto-raise (raising automatically when a frame is
-selected) or auto-lower (lowering automatically when it is deselected)
-for any frame using frame parameters. @xref{Management Parameters}.
+ On window systems, you can also enable auto-raising (on frame
+selection) or auto-lowering (on frame deselection) using frame
+parameters. @xref{Management Parameters}.
+
+@cindex top frame
+ The concept of raising and lowering frames also applies to text
+terminal frames. On each text terminal, only the top frame is
+displayed at any one time.
+
+@defun tty-top-frame terminal
+This function returns the top frame on @var{terminal}. @var{terminal}
+should be a terminal object, a frame (meaning that frame's terminal),
+or @code{nil} (meaning the selected frame's terminal). If it does not
+refer to a text terminal, the return value is @code{nil}.
+@end defun
@node Frame Configurations
@section Frame Configurations
@@ -1705,7 +1731,7 @@ displayed on @var{frame} is visible; otherwise it returns @code{nil}.
@var{frame} omitted or @code{nil} means the selected frame. This is
useful when @code{make-pointer-invisible} is set to @code{t}: it
allows to know if the pointer has been hidden.
-@xref{Mouse Avoidance,,,emacs}.
+@xref{Mouse Avoidance,,,emacs, The Emacs Manual}.
@end defun
@need 3000
@@ -1763,10 +1789,12 @@ where each pane is a list of form
(@var{title} @var{item1} @var{item2}...)
@end example
-Each item should normally be a cons cell @code{(@var{line} . @var{value})},
-where @var{line} is a string, and @var{value} is the value to return if
-that @var{line} is chosen. An item can also be a string; this makes a
-non-selectable line in the menu.
+Each @var{item} should be a cons cell, @code{(@var{line} . @var{value})},
+where @var{line} is a string and @var{value} is the value to return if
+that @var{line} is chosen. Unlike in a menu keymap, a @code{nil}
+@var{value} does not make the menu item non-selectable.
+Alternatively, each @var{item} can be a string rather than a cons
+cell; this makes a non-selectable menu item.
If the user gets rid of the menu without making a valid choice, for
instance by clicking the mouse away from a valid choice or by typing
@@ -1804,7 +1832,7 @@ the menu keymap as necessary.
A dialog box is a variant of a pop-up menu---it looks a little
different, it always appears in the center of a frame, and it has just
one level and one or more buttons. The main use of dialog boxes is
-for asking questions that the user can answer with ``yes,'' ``no,''
+for asking questions that the user can answer with ``yes'', ``no'',
and a few other alternatives. With a single button, they can also
force the user to acknowledge important information. The functions
@code{y-or-n-p} and @code{yes-or-no-p} use dialog boxes instead of the
@@ -1871,12 +1899,12 @@ of the buffer contents), the mouse pointer usually uses the
@code{arrow} style, but you can specify a different style (one of
those above) by setting @code{void-text-area-pointer}.
-@defvar void-text-area-pointer
+@defopt void-text-area-pointer
This variable specifies the mouse pointer style for void text areas.
These include the areas after the end of a line or below the last line
in the buffer. The default is to use the @code{arrow} (non-text)
pointer style.
-@end defvar
+@end defopt
When using X, you can specify what the @code{text} pointer style
really looks like by setting the variable @code{x-pointer-shape}.
@@ -2018,7 +2046,7 @@ colors.)
These functions provide a way to determine which color names are
valid, and what they look like. In some cases, the value depends on the
@dfn{selected frame}, as described below; see @ref{Input Focus}, for the
-meaning of the term ``selected frame.''
+meaning of the term ``selected frame''.
To read user input of color names with completion, use
@code{read-color} (@pxref{High-Level Completion, read-color}).
@@ -2107,10 +2135,10 @@ and that name is still supported as an alias.
@node Text Terminal Colors
@section Text Terminal Colors
-@cindex colors on text-only terminals
+@cindex colors on text terminals
- Text-only terminals usually support only a small number of colors,
-and the computer uses small integers to select colors on the terminal.
+ Text terminals usually support only a small number of colors, and
+the computer uses small integers to select colors on the terminal.
This means that the computer cannot reliably tell what the selected
color looks like; instead, you have to inform your application which
small integers correspond to which colors. However, Emacs does know
@@ -2124,10 +2152,10 @@ in @ref{Color Names}.
These functions accept a display (either a frame or the name of a
terminal) as an optional argument. We hope in the future to make
-Emacs support different colors on different text-only terminals; then
-this argument will specify which terminal to operate on (the default
-being the selected frame's terminal; @pxref{Input Focus}). At
-present, though, the @var{frame} argument has no effect.
+Emacs support different colors on different text terminals; then this
+argument will specify which terminal to operate on (the default being
+the selected frame's terminal; @pxref{Input Focus}). At present,
+though, the @var{frame} argument has no effect.
@defun tty-color-define name number &optional rgb frame
This function associates the color name @var{name} with
@@ -2141,12 +2169,12 @@ Emacs will not know what it looks like.
@end defun
@defun tty-color-clear &optional frame
-This function clears the table of defined colors for a text-only terminal.
+This function clears the table of defined colors for a text terminal.
@end defun
@defun tty-color-alist &optional frame
-This function returns an alist recording the known colors supported by a
-text-only terminal.
+This function returns an alist recording the known colors supported by
+a text terminal.
Each element has the form @code{(@var{name} @var{number} . @var{rgb})}
or @code{(@var{name} @var{number})}. Here, @var{name} is the color
@@ -2262,8 +2290,8 @@ a mouse.
@defun display-graphic-p &optional display
This function returns @code{t} if @var{display} is a graphic display
capable of displaying several frames and several different fonts at
-once. This is true for displays that use a window system such as X, and
-false for text-only terminals.
+once. This is true for displays that use a window system such as X,
+and false for text terminals.
@end defun
@defun display-mouse-p &optional display
@@ -2415,7 +2443,7 @@ software (as a string). Really this means whoever distributes the X
server.
When the developers of X labeled software distributors as
-``vendors,'' they showed their false assumption that no system could
+``vendors'', they showed their false assumption that no system could
ever be developed and distributed noncommercially.
@end defun
diff --git a/doc/lispref/front-cover-1.texi b/doc/lispref/front-cover-1.texi
deleted file mode 100644
index 56d0f2b1c2d..00000000000
--- a/doc/lispref/front-cover-1.texi
+++ /dev/null
@@ -1,52 +0,0 @@
-\input texinfo @c -*-texinfo-*-
-@comment %**start of header
-@setfilename front1.info
-@settitle GNU Emacs Lisp Reference Manual
-@smallbook
-@comment %**end of header
-
-@titlepage
-.
-@sp 2
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19.29
-@center for Unix Users
-@center Edition 2.4, June 1995
-@sp 2
-@center @titlefont{Volume 1}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-@page
-.
-@sp 5
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19.29
-@center for Unix Users
-@center Edition 2.4, June 1995
-@sp 2
-@center @titlefont{Volume 2}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-@end titlepage
-@bye
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index f3b2375b61d..05fd2486fd6 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -1,10 +1,9 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/functions
-@node Functions, Macros, Variables, Top
+@node Functions
@chapter Functions
A Lisp program is composed mainly of Lisp functions. This chapter
@@ -21,8 +20,10 @@ define them.
* Anonymous Functions:: Lambda expressions are functions with no names.
* Function Cells:: Accessing or setting the function definition
of a symbol.
+* Closures:: Functions that enclose a lexical environment.
* Obsolete Functions:: Declaring functions obsolete.
-* Inline Functions:: Defining functions that the compiler will open code.
+* Inline Functions:: Functions that the compiler will expand inline.
+* Declare Form:: Adding additional information about a function.
* Declaring Functions:: Telling the compiler that a function is defined.
* Function Safety:: Determining whether a function is safe to call.
* Related Topics:: Cross-references to specific Lisp primitives
@@ -32,104 +33,117 @@ define them.
@node What Is a Function
@section What Is a Function?
- In a general sense, a function is a rule for carrying on a computation
-given several values called @dfn{arguments}. The result of the
-computation is called the value of the function. The computation can
-also have side effects: lasting changes in the values of variables or
-the contents of data structures.
-
- Here are important terms for functions in Emacs Lisp and for other
-function-like objects.
+@cindex return value
+@cindex value of function
+@cindex argument
+ In a general sense, a function is a rule for carrying out a
+computation given input values called @dfn{arguments}. The result of
+the computation is called the @dfn{value} or @dfn{return value} of the
+function. The computation can also have side effects, such as lasting
+changes in the values of variables or the contents of data structures.
+
+ In most computer languages, every function has a name. But in Lisp,
+a function in the strictest sense has no name: it is an object which
+can @emph{optionally} be associated with a symbol (e.g.@: @code{car})
+that serves as the function name. @xref{Function Names}. When a
+function has been given a name, we usually also refer to that symbol
+as a ``function'' (e.g.@: we refer to ``the function @code{car}'').
+In this manual, the distinction between a function name and the
+function object itself is usually unimportant, but we will take note
+wherever it is relevant.
+
+ Certain function-like objects, called @dfn{special forms} and
+@dfn{macros}, also accept arguments to carry out computations.
+However, as explained below, these are not considered functions in
+Emacs Lisp.
+
+ Here are important terms for functions and function-like objects:
@table @dfn
-@item function
-@cindex function
-In Emacs Lisp, a @dfn{function} is anything that can be applied to
-arguments in a Lisp program. In some cases, we use it more
-specifically to mean a function written in Lisp. Special forms and
-macros are not functions.
+@item lambda expression
+A function (in the strict sense, i.e.@: a function object) which is
+written in Lisp. These are described in the following section.
+@ifnottex
+@xref{Lambda Expressions}.
+@end ifnottex
@item primitive
@cindex primitive
@cindex subr
@cindex built-in function
-A @dfn{primitive} is a function callable from Lisp that is written in C,
-such as @code{car} or @code{append}. These functions are also called
-@dfn{built-in functions}, or @dfn{subrs}. (Special forms are also
-considered primitives.)
-
-Usually the reason we implement a function as a primitive is either
-because it is fundamental, because it provides a low-level interface
-to operating system services, or because it needs to run fast.
-Primitives can be modified or added only by changing the C sources and
-recompiling the editor. See @ref{Writing Emacs Primitives}.
-
-@item lambda expression
-A @dfn{lambda expression} is a function written in Lisp.
-These are described in the following section.
-@ifnottex
-@xref{Lambda Expressions}.
-@end ifnottex
+A function which is callable from Lisp but is actually written in C.
+Primitives are also called @dfn{built-in functions}, or @dfn{subrs}.
+Examples include functions like @code{car} and @code{append}. In
+addition, all special forms (see below) are also considered
+primitives.
+
+Usually, a function is implemented as a primitive because it is a
+fundamental part of Lisp (e.g.@: @code{car}), or because it provides a
+low-level interface to operating system services, or because it needs
+to run fast. Unlike functions defined in Lisp, primitives can be
+modified or added only by changing the C sources and recompiling
+Emacs. See @ref{Writing Emacs Primitives}.
@item special form
-A @dfn{special form} is a primitive that is like a function but does not
-evaluate all of its arguments in the usual way. It may evaluate only
-some of the arguments, or may evaluate them in an unusual order, or
-several times. Many special forms are described in @ref{Control
-Structures}.
+A primitive that is like a function but does not evaluate all of its
+arguments in the usual way. It may evaluate only some of the
+arguments, or may evaluate them in an unusual order, or several times.
+Examples include @code{if}, @code{and}, and @code{while}.
+@xref{Special Forms}.
@item macro
@cindex macro
-A @dfn{macro} is a construct defined in Lisp by the programmer. It
-differs from a function in that it translates a Lisp expression that you
-write into an equivalent expression to be evaluated instead of the
-original expression. Macros enable Lisp programmers to do the sorts of
-things that special forms can do. @xref{Macros}, for how to define and
-use macros.
+A construct defined in Lisp, which differs from a function in that it
+translates a Lisp expression into another expression which is to be
+evaluated instead of the original expression. Macros enable Lisp
+programmers to do the sorts of things that special forms can do.
+@xref{Macros}.
@item command
@cindex command
-A @dfn{command} is an object that @code{command-execute} can invoke; it
-is a possible definition for a key sequence. Some functions are
-commands; a function written in Lisp is a command if it contains an
-interactive declaration (@pxref{Defining Commands}). Such a function
-can be called from Lisp expressions like other functions; in this case,
-the fact that the function is a command makes no difference.
+An object which can be invoked via the @code{command-execute}
+primitive, usually due to the user typing in a key sequence
+@dfn{bound} to that command. @xref{Interactive Call}. A command is
+usually a function; if the function is written in Lisp, it is made
+into a command by an @code{interactive} form in the function
+definition (@pxref{Defining Commands}). Commands that are functions
+can also be called from Lisp expressions, just like other functions.
Keyboard macros (strings and vectors) are commands also, even though
-they are not functions. A symbol is a command if its function
-definition is a command; such symbols can be invoked with @kbd{M-x}.
-The symbol is a function as well if the definition is a function.
-@xref{Interactive Call}.
-
-@item keystroke command
-@cindex keystroke command
-A @dfn{keystroke command} is a command that is bound to a key sequence
-(typically one to three keystrokes). The distinction is made here
-merely to avoid confusion with the meaning of ``command'' in non-Emacs
-editors; for Lisp programs, the distinction is normally unimportant.
+they are not functions. @xref{Keyboard Macros}. We say that a symbol
+is a command if its function cell contains a command (@pxref{Symbol
+Components}); such a @dfn{named command} can be invoked with
+@kbd{M-x}.
+
+@item closure
+A function object that is much like a lambda expression, except that
+it also encloses an ``environment'' of lexical variable bindings.
+@xref{Closures}.
@item byte-code function
-A @dfn{byte-code function} is a function that has been compiled by the
-byte compiler. @xref{Byte-Code Type}.
+A function that has been compiled by the byte compiler.
+@xref{Byte-Code Type}.
@item autoload object
@cindex autoload object
-An @dfn{autoload object} is a place-holder for a real function. If
-the autoload object is called, it will make Emacs load the file
-containing the definition of the real function, and then call the real
-function instead.
+A place-holder for a real function. If the autoload object is called,
+Emacs loads the file containing the definition of the real function,
+and then calls the real function. @xref{Autoload}.
@end table
+ You can use the function @code{functionp} to test if an object is a
+function:
+
@defun functionp object
This function returns @code{t} if @var{object} is any kind of
function, i.e.@: can be passed to @code{funcall}. Note that
-@code{functionp} returns @code{nil} for special forms (@pxref{Special
-Forms}).
+@code{functionp} returns @code{t} for symbols that are function names,
+and returns @code{nil} for special forms.
@end defun
-Unlike @code{functionp}, the next three functions do @emph{not}
-treat a symbol as its function definition.
+@noindent
+Unlike @code{functionp}, the next three functions do @emph{not} treat
+a symbol as its function definition.
@defun subrp object
This function returns @code{t} if @var{object} is a built-in function
@@ -172,21 +186,26 @@ function with @code{&rest} arguments, or the symbol @code{unevalled} if
@section Lambda Expressions
@cindex lambda expression
- A function written in Lisp is a list that looks like this:
+ A lambda expression is a function object written in Lisp. Here is
+an example:
@example
-(lambda (@var{arg-variables}@dots{})
- @r{[}@var{documentation-string}@r{]}
- @r{[}@var{interactive-declaration}@r{]}
- @var{body-forms}@dots{})
+(lambda (x)
+ "Return the hyperbolic cosine of X."
+ (* 0.5 (+ (exp x) (exp (- x)))))
@end example
@noindent
-Such a list is called a @dfn{lambda expression}. In Emacs Lisp, it
-actually is valid as an expression---it evaluates to itself. In some
-other Lisp dialects, a lambda expression is not a valid expression at
-all. In either case, its main use is not to be evaluated as an
-expression, but to be called as a function.
+In Emacs Lisp, such a list is valid as an expression---it evaluates to
+itself. But its main use is not to be evaluated as an expression, but
+to be called as a function.
+
+ A lambda expression, by itself, has no name; it is an @dfn{anonymous
+function}. Although lambda expressions can be used this way
+(@pxref{Anonymous Functions}), they are more commonly associated with
+symbols to make @dfn{named functions} (@pxref{Function Names}).
+Before going into these details, the following subsections describe
+the components of a lambda expression and what they do.
@menu
* Lambda Components:: The parts of a lambda expression.
@@ -198,10 +217,7 @@ expression, but to be called as a function.
@node Lambda Components
@subsection Components of a Lambda Expression
-@ifnottex
-
- A function written in Lisp (a ``lambda expression'') is a list that
-looks like this:
+ A lambda expression is a list that looks like this:
@example
(lambda (@var{arg-variables}@dots{})
@@ -209,7 +225,6 @@ looks like this:
[@var{interactive-declaration}]
@var{body-forms}@dots{})
@end example
-@end ifnottex
@cindex lambda list
The first element of a lambda expression is always the symbol
@@ -243,22 +258,21 @@ code to do the work of the function (or, as a Lisp programmer would say,
function is the value returned by the last element of the body.
@node Simple Lambda
-@subsection A Simple Lambda-Expression Example
+@subsection A Simple Lambda Expression Example
- Consider for example the following function:
+ Consider the following example:
@example
(lambda (a b c) (+ a b c))
@end example
@noindent
-We can call this function by writing it as the @sc{car} of an
-expression, like this:
+We can call this function by passing it to @code{funcall}, like this:
@example
@group
-((lambda (a b c) (+ a b c))
- 1 2 3)
+(funcall (lambda (a b c) (+ a b c))
+ 1 2 3)
@end group
@end example
@@ -273,8 +287,8 @@ this example:
@example
@group
-((lambda (a b c) (+ a b c))
- 1 (* 2 3) (- 5 4))
+(funcall (lambda (a b c) (+ a b c))
+ 1 (* 2 3) (- 5 4))
@end group
@end example
@@ -283,18 +297,15 @@ This evaluates the arguments @code{1}, @code{(* 2 3)}, and @code{(- 5
4)} from left to right. Then it applies the lambda expression to the
argument values 1, 6 and 1 to produce the value 8.
- It is not often useful to write a lambda expression as the @sc{car} of
-a form in this way. You can get the same result, of making local
-variables and giving them values, using the special form @code{let}
-(@pxref{Local Variables}). And @code{let} is clearer and easier to use.
-In practice, lambda expressions are either stored as the function
-definitions of symbols, to produce named functions, or passed as
-arguments to other functions (@pxref{Anonymous Functions}).
-
- However, calls to explicit lambda expressions were very useful in the
-old days of Lisp, before the special form @code{let} was invented. At
-that time, they were the only way to bind and initialize local
-variables.
+ As these examples show, you can use a form with a lambda expression
+as its @sc{car} to make local variables and give them values. In the
+old days of Lisp, this technique was the only way to bind and
+initialize local variables. But nowadays, it is clearer to use the
+special form @code{let} for this purpose (@pxref{Local Variables}).
+Lambda expressions are mainly used as anonymous functions for passing
+as arguments to other functions (@pxref{Anonymous Functions}), or
+stored as symbol function definitions to produce named functions
+(@pxref{Function Names}).
@node Argument List
@subsection Other Features of Argument Lists
@@ -387,30 +398,30 @@ after a @code{&rest} argument.
Here are some examples of argument lists and proper calls:
-@smallexample
-((lambda (n) (1+ n)) ; @r{One required:}
- 1) ; @r{requires exactly one argument.}
+@example
+(funcall (lambda (n) (1+ n)) ; @r{One required:}
+ 1) ; @r{requires exactly one argument.}
@result{} 2
-((lambda (n &optional n1) ; @r{One required and one optional:}
- (if n1 (+ n n1) (1+ n))) ; @r{1 or 2 arguments.}
- 1 2)
+(funcall (lambda (n &optional n1) ; @r{One required and one optional:}
+ (if n1 (+ n n1) (1+ n))) ; @r{1 or 2 arguments.}
+ 1 2)
@result{} 3
-((lambda (n &rest ns) ; @r{One required and one rest:}
- (+ n (apply '+ ns))) ; @r{1 or more arguments.}
- 1 2 3 4 5)
+(funcall (lambda (n &rest ns) ; @r{One required and one rest:}
+ (+ n (apply '+ ns))) ; @r{1 or more arguments.}
+ 1 2 3 4 5)
@result{} 15
-@end smallexample
+@end example
@node Function Documentation
@subsection Documentation Strings of Functions
@cindex documentation of function
- A lambda expression may optionally have a @dfn{documentation string} just
-after the lambda list. This string does not affect execution of the
-function; it is a kind of comment, but a systematized comment which
-actually appears inside the Lisp world and can be used by the Emacs help
-facilities. @xref{Documentation}, for how the @var{documentation-string} is
-accessed.
+ A lambda expression may optionally have a @dfn{documentation string}
+just after the lambda list. This string does not affect execution of
+the function; it is a kind of comment, but a systematized comment
+which actually appears inside the Lisp world and can be used by the
+Emacs help facilities. @xref{Documentation}, for how the
+documentation string is accessed.
It is a good idea to provide documentation strings for all the
functions in your program, even those that are called only from within
@@ -463,55 +474,45 @@ way users think of the parts of the macro call.
@cindex named function
@cindex function name
- In most computer languages, every function has a name; the idea of a
-function without a name is nonsensical. In Lisp, a function in the
-strictest sense has no name. It is simply a list whose first element is
-@code{lambda}, a byte-code function object, or a primitive subr-object.
-
- However, a symbol can serve as the name of a function. This happens
-when you put the function in the symbol's @dfn{function cell}
-(@pxref{Symbol Components}). Then the symbol itself becomes a valid,
-callable function, equivalent to the list or subr-object that its
-function cell refers to. The contents of the function cell are also
-called the symbol's @dfn{function definition}. The procedure of using a
-symbol's function definition in place of the symbol is called
-@dfn{symbol function indirection}; see @ref{Function Indirection}.
-
- In practice, nearly all functions are given names in this way and
-referred to through their names. For example, the symbol @code{car} works
-as a function and does what it does because the primitive subr-object
-@code{#<subr car>} is stored in its function cell.
+ A symbol can serve as the name of a function. This happens when the
+symbol's @dfn{function cell} (@pxref{Symbol Components}) contains a
+function object (e.g.@: a lambda expression). Then the symbol itself
+becomes a valid, callable function, equivalent to the function object
+in its function cell.
+
+ The contents of the function cell are also called the symbol's
+@dfn{function definition}. The procedure of using a symbol's function
+definition in place of the symbol is called @dfn{symbol function
+indirection}; see @ref{Function Indirection}. If you have not given a
+symbol a function definition, its function cell is said to be
+@dfn{void}, and it cannot be used as a function.
+
+ In practice, nearly all functions have names, and are referred to by
+their names. You can create a named Lisp function by defining a
+lambda expression and putting it in a function cell (@pxref{Function
+Cells}). However, it is more common to use the @code{defun} special
+form, described in the next section.
+@ifnottex
+@xref{Defining Functions}.
+@end ifnottex
We give functions names because it is convenient to refer to them by
-their names in Lisp expressions. For primitive subr-objects such as
-@code{#<subr car>}, names are the only way you can refer to them: there
-is no read syntax for such objects. For functions written in Lisp, the
-name is more convenient to use in a call than an explicit lambda
-expression. Also, a function with a name can refer to itself---it can
-be recursive. Writing the function's name in its own definition is much
-more convenient than making the function definition point to itself
-(something that is not impossible but that has various disadvantages in
-practice).
-
- We often identify functions with the symbols used to name them. For
-example, we often speak of ``the function @code{car},'' not
-distinguishing between the symbol @code{car} and the primitive
-subr-object that is its function definition. For most purposes, the
-distinction is not important.
-
- Even so, keep in mind that a function need not have a unique name. While
-a given function object @emph{usually} appears in the function cell of only
-one symbol, this is just a matter of convenience. It is easy to store
-it in several symbols using @code{fset}; then each of the symbols is
-equally well a name for the same function.
-
- A symbol used as a function name may also be used as a variable; these
-two uses of a symbol are independent and do not conflict. (Some Lisp
-dialects, such as Scheme, do not distinguish between a symbol's value
-and its function definition; a symbol's value as a variable is also its
-function definition.) If you have not given a symbol a function
-definition, you cannot use it as a function; whether the symbol has a
-value as a variable makes no difference to this.
+their names in Lisp expressions. Also, a named Lisp function can
+easily refer to itself---it can be recursive. Furthermore, primitives
+can only be referred to textually by their names, since primitive
+function objects (@pxref{Primitive Function Type}) have no read
+syntax.
+
+ A function need not have a unique name. A given function object
+@emph{usually} appears in the function cell of only one symbol, but
+this is just a convention. It is easy to store it in several symbols
+using @code{fset}; then each of the symbols is a valid name for the
+same function.
+
+ Note that a symbol used as a function name may also be used as a
+variable; these two uses of a symbol are independent and do not
+conflict. (This is not the case in some dialects of Lisp, like
+Scheme.)
@node Defining Functions
@section Defining Functions
@@ -519,38 +520,28 @@ value as a variable makes no difference to this.
We usually give a name to a function when it is first created. This
is called @dfn{defining a function}, and it is done with the
-@code{defun} special form.
+@code{defun} macro.
-@defspec defun name argument-list body-forms
+@defmac defun name args [doc] [declare] [interactive] body@dots{}
@code{defun} is the usual way to define new Lisp functions. It
-defines the symbol @var{name} as a function that looks like this:
+defines the symbol @var{name} as a function with argument list
+@var{args} and body forms given by @var{body}. Neither @var{name} nor
+@var{args} should be quoted.
-@example
-(lambda @var{argument-list} . @var{body-forms})
-@end example
+@var{doc}, if present, should be a string specifying the function's
+documentation string (@pxref{Function Documentation}). @var{declare},
+if present, should be a @code{declare} form specifying function
+metadata (@pxref{Declare Form}). @var{interactive}, if present,
+should be an @code{interactive} form specifying how the function is to
+be called interactively (@pxref{Interactive Call}).
-@code{defun} stores this lambda expression in the function cell of
-@var{name}. It returns the value @var{name}, but usually we ignore this
-value.
-
-As described previously, @var{argument-list} is a list of argument
-names and may include the keywords @code{&optional} and @code{&rest}
-(@pxref{Lambda Expressions}). Also, the first two of the
-@var{body-forms} may be a documentation string and an interactive
-declaration.
-
-There is no conflict if the same symbol @var{name} is also used as a
-variable, since the symbol's value cell is independent of the function
-cell. @xref{Symbol Components}.
+The return value of @code{defun} is undefined.
Here are some examples:
@example
@group
(defun foo () 5)
- @result{} foo
-@end group
-@group
(foo)
@result{} 5
@end group
@@ -558,9 +549,6 @@ Here are some examples:
@group
(defun bar (a &optional b &rest c)
(list a b c))
- @result{} bar
-@end group
-@group
(bar 1 2 3 4 5)
@result{} (1 2 (3 4 5))
@end group
@@ -575,32 +563,32 @@ Here are some examples:
@group
(defun capitalize-backwards ()
- "Upcase the last letter of a word."
+ "Upcase the last letter of the word at point."
(interactive)
(backward-word 1)
(forward-word 1)
(backward-char 1)
(capitalize-word 1))
- @result{} capitalize-backwards
@end group
@end example
Be careful not to redefine existing functions unintentionally.
@code{defun} redefines even primitive functions such as @code{car}
-without any hesitation or notification. Redefining a function already
-defined is often done deliberately, and there is no way to distinguish
-deliberate redefinition from unintentional redefinition.
-@end defspec
+without any hesitation or notification. Emacs does not prevent you
+from doing this, because redefining a function is sometimes done
+deliberately, and there is no way to distinguish deliberate
+redefinition from unintentional redefinition.
+@end defmac
@cindex function aliases
-@defun defalias name definition &optional docstring
+@defun defalias name definition &optional doc
@anchor{Definition of defalias}
-This special form defines the symbol @var{name} as a function, with
+This function defines the symbol @var{name} as a function, with
definition @var{definition} (which can be any valid Lisp function).
-It returns @var{definition}.
+Its return value is @emph{undefined}.
-If @var{docstring} is non-@code{nil}, it becomes the function
-documentation of @var{name}. Otherwise, any documentation provided by
+If @var{doc} is non-@code{nil}, it becomes the function documentation
+of @var{name}. Otherwise, any documentation provided by
@var{definition} is used.
The proper place to use @code{defalias} is where a specific function
@@ -626,7 +614,8 @@ call the primitive's C definition directly, so changing the symbol's
definition will have no effect on them.
See also @code{defsubst}, which defines a function like @code{defun}
-and tells the Lisp compiler to open-code it. @xref{Inline Functions}.
+and tells the Lisp compiler to perform inline expansion on it.
+@xref{Inline Functions}.
@node Calling Functions
@section Calling Functions
@@ -790,11 +779,10 @@ This function returns @var{arg} and has no side effects.
This function ignores any arguments and returns @code{nil}.
@end defun
- Emacs Lisp functions can also be user-visible @dfn{commands}. A
-command is a function that has an @dfn{interactive} specification.
-You may want to call these functions as if they were called
-interactively. See @ref{Interactive Call} for details on how to do
-that.
+ Some functions are user-visible @dfn{commands}, which can be called
+interactively (usually by a key sequence). It is possible to invoke
+such a command exactly as though it was called interactively, by using
+the @code{call-interactively} function. @xref{Interactive Call}.
@node Mapping Functions
@section Mapping Functions
@@ -802,12 +790,12 @@ that.
A @dfn{mapping function} applies a given function (@emph{not} a
special form or macro) to each element of a list or other collection.
-Emacs Lisp has several such functions; @code{mapcar} and
-@code{mapconcat}, which scan a list, are described here.
-@xref{Definition of mapatoms}, for the function @code{mapatoms} which
-maps over the symbols in an obarray. @xref{Definition of maphash},
-for the function @code{maphash} which maps over key/value associations
-in a hash table.
+Emacs Lisp has several such functions; this section describes
+@code{mapcar}, @code{mapc}, and @code{mapconcat}, which map over a
+list. @xref{Definition of mapatoms}, for the function @code{mapatoms}
+which maps over the symbols in an obarray. @xref{Definition of
+maphash}, for the function @code{maphash} which maps over key/value
+associations in a hash table.
These mapping functions do not allow char-tables because a char-table
is a sparse array whose nominal range of indices is very large. To map
@@ -824,7 +812,7 @@ char-table; that is, a list, a vector, a bool-vector, or a string. The
result is always a list. The length of the result is the same as the
length of @var{sequence}. For example:
-@smallexample
+@example
@group
(mapcar 'car '((a b) (c d) (e f)))
@result{} (a c e)
@@ -856,7 +844,7 @@ Return the list of results."
(mapcar* 'cons '(a b c) '(1 2 3 4))
@result{} ((a . 1) (b . 2) (c . 3))
@end group
-@end smallexample
+@end example
@end defun
@defun mapc function sequence
@@ -877,7 +865,7 @@ argument and return a string. The argument @var{sequence} can be any
kind of sequence except a char-table; that is, a list, a vector, a
bool-vector, or a string.
-@smallexample
+@example
@group
(mapconcat 'symbol-name
'(The cat in the hat)
@@ -891,54 +879,76 @@ bool-vector, or a string.
"")
@result{} "IBM.9111"
@end group
-@end smallexample
+@end example
@end defun
@node Anonymous Functions
@section Anonymous Functions
@cindex anonymous function
- In Lisp, a function is a list that starts with @code{lambda}, a
-byte-code function compiled from such a list, or alternatively a
-primitive subr-object; names are ``extra.'' Although functions are
-usually defined with @code{defun} and given names at the same time, it
-is occasionally more concise to use an explicit lambda expression---an
-anonymous function. Such a list is valid wherever a function name is.
+ Although functions are usually defined with @code{defun} and given
+names at the same time, it is sometimes convenient to use an explicit
+lambda expression---an @dfn{anonymous function}. Anonymous functions
+are valid wherever function names are. They are often assigned as
+variable values, or as arguments to functions; for instance, you might
+pass one as the @var{function} argument to @code{mapcar}, which
+applies that function to each element of a list (@pxref{Mapping
+Functions}). @xref{describe-symbols example}, for a realistic example
+of this.
+
+ When defining a lambda expression that is to be used as an anonymous
+function, you can in principle use any method to construct the list.
+But typically you should use the @code{lambda} macro, or the
+@code{function} special form, or the @code{#'} read syntax:
+
+@defmac lambda args [doc] [interactive] body@dots{}
+This macro returns an anonymous function with argument list
+@var{args}, documentation string @var{doc} (if any), interactive spec
+@var{interactive} (if any), and body forms given by @var{body}.
+
+In effect, this macro makes @code{lambda} forms ``self-quoting'':
+evaluating a form whose @sc{car} is @code{lambda} yields the form
+itself:
- Any method of creating such a list makes a valid function. Even this:
+@example
+(lambda (x) (* x x))
+ @result{} (lambda (x) (* x x))
+@end example
-@smallexample
-@group
-(setq silly (append '(lambda (x)) (list (list '+ (* 3 4) 'x))))
-@result{} (lambda (x) (+ 12 x))
-@end group
-@end smallexample
+The @code{lambda} form has one other effect: it tells the Emacs
+evaluator and byte-compiler that its argument is a function, by using
+@code{function} as a subroutine (see below).
+@end defmac
-@noindent
-This computes a list that looks like @code{(lambda (x) (+ 12 x))} and
-makes it the value (@emph{not} the function definition!) of
-@code{silly}.
+@defspec function function-object
+@cindex function quoting
+This special form returns @var{function-object} without evaluating it.
+In this, it is similar to @code{quote} (@pxref{Quoting}). But unlike
+@code{quote}, it also serves as a note to the Emacs evaluator and
+byte-compiler that @var{function-object} is intended to be used as a
+function. Assuming @var{function-object} is a valid lambda
+expression, this has two effects:
- Here is how we might call this function:
+@itemize
+@item
+When the code is byte-compiled, @var{function-object} is compiled into
+a byte-code function object (@pxref{Byte Compilation}).
-@example
-@group
-(funcall silly 1)
-@result{} 13
-@end group
-@end example
+@item
+When lexical binding is enabled, @var{function-object} is converted
+into a closure. @xref{Closures}.
+@end itemize
+@end defspec
-@noindent
-It does @emph{not} work to write @code{(silly 1)}, because this
-function is not the @emph{function definition} of @code{silly}. We
-have not given @code{silly} any function definition, just a value as a
-variable.
+@cindex @samp{#'} syntax
+The read syntax @code{#'} is a short-hand for using @code{function}.
+The following forms are all equivalent:
- Most of the time, anonymous functions are constants that appear in
-your program. For instance, you might want to pass one as an argument
-to the function @code{mapcar}, which applies any given function to
-each element of a list (@pxref{Mapping Functions}).
-@xref{describe-symbols example}, for a realistic example of this.
+@example
+(lambda (x) (* x x))
+(function (lambda (x) (* x x)))
+#'(lambda (x) (* x x))
+@end example
In the following example, we define a @code{change-property}
function that takes a function as its third argument, followed by a
@@ -959,70 +969,24 @@ function that takes a function as its third argument, followed by a
@end example
@noindent
-In the @code{double-property} function, we did not quote the
-@code{lambda} form. This is permissible, because a @code{lambda} form
-is @dfn{self-quoting}: evaluating the form yields the form itself.
+Note that we do not quote the @code{lambda} form.
-Whether or not you quote a @code{lambda} form makes a difference if
-you compile the code (@pxref{Byte Compilation}). If the @code{lambda}
-form is unquoted, as in the above example, the anonymous function is
-also compiled. Suppose, however, that we quoted the @code{lambda}
-form:
+ If you compile the above code, the anonymous function is also
+compiled. This would not happen if, say, you had constructed the
+anonymous function by quoting it as a list:
@example
@group
(defun double-property (symbol prop)
- (change-property symbol prop '(lambda (x) (* 2 x))))
+ (change-property symbol prop (lambda (x) (* 2 x))))
@end group
@end example
@noindent
-If you compile this, the argument passed to @code{change-property} is
-the precise list shown:
-
-@example
-(lambda (x) (* x 2))
-@end example
-
-@noindent
-The Lisp compiler cannot assume this list is a function, even though
-it looks like one, since it does not know what @code{change-property}
-will do with the list. Perhaps it will check whether the @sc{car} of
-the third element is the symbol @code{*}!
-
-@findex function
-The @code{function} special form explicitly tells the byte-compiler
-that its argument is a function:
-
-@defspec function function-object
-@cindex function quoting
-This special form returns @var{function-object} without evaluating it.
-In this, it is equivalent to @code{quote}. However, it serves as a
-note to the Emacs Lisp compiler that @var{function-object} is intended
-to be used only as a function, and therefore can safely be compiled.
-Contrast this with @code{quote}, in @ref{Quoting}.
-@end defspec
-
-@cindex @samp{#'} syntax
-The read syntax @code{#'} is a short-hand for using @code{function}.
-Generally, it is not necessary to use either @code{#'} or
-@code{function}; just use an unquoted @code{lambda} form instead.
-(Actually, @code{lambda} is a macro defined using @code{function}.)
-The following forms are all equivalent:
-
-@example
-#'(lambda (x) (* x x))
-(function (lambda (x) (* x x)))
-(lambda (x) (* x x))
-@end example
-
- We sometimes write @code{function} instead of @code{quote} when
-quoting the name of a function, but this usage is just a sort of
-comment:
-
-@example
-(function @var{symbol}) @equiv{} (quote @var{symbol}) @equiv{} '@var{symbol}
-@end example
+In that case, the anonymous function is kept as a lambda expression in
+the compiled code. The byte-compiler cannot assume this list is a
+function, even though it looks like one, since it does not know that
+@code{change-property} intends to use it as a function.
@node Function Cells
@section Accessing Function Cell Contents
@@ -1046,9 +1010,6 @@ function.
@example
@group
(defun bar (n) (+ n 2))
- @result{} bar
-@end group
-@group
(symbol-function 'bar)
@result{} (lambda (n) (+ n 2))
@end group
@@ -1094,9 +1055,6 @@ subsequent attempt to access this cell will cause a
@example
@group
(defun foo (x) x)
- @result{} foo
-@end group
-@group
(foo 1)
@result{}1
@end group
@@ -1118,107 +1076,108 @@ This function stores @var{definition} in the function cell of
this is not checked. The argument @var{symbol} is an ordinary evaluated
argument.
-There are three normal uses of this function:
+The primary use of this function is as a subroutine by constructs that
+define or alter functions, like @code{defadvice} (@pxref{Advising
+Functions}). (If @code{defun} were not a primitive, it could be
+written as a Lisp macro using @code{fset}.) You can also use it to
+give a symbol a function definition that is not a list, e.g.@: a
+keyboard macro (@pxref{Keyboard Macros}):
-@itemize @bullet
-@item
-Copying one symbol's function definition to another---in other words,
-making an alternate name for a function. (If you think of this as the
-definition of the new name, you should use @code{defalias} instead of
-@code{fset}; see @ref{Definition of defalias}.)
+@example
+;; @r{Define a named keyboard macro.}
+(fset 'kill-two-lines "\^u2\^k")
+ @result{} "\^u2\^k"
+@end example
-@item
-Giving a symbol a function definition that is not a list and therefore
-cannot be made with @code{defun}. For example, you can use @code{fset}
-to give a symbol @code{s1} a function definition which is another symbol
-@code{s2}; then @code{s1} serves as an alias for whatever definition
-@code{s2} presently has. (Once again use @code{defalias} instead of
-@code{fset} if you think of this as the definition of @code{s1}.)
+It you wish to use @code{fset} to make an alternate name for a
+function, consider using @code{defalias} instead. @xref{Definition of
+defalias}.
+@end defun
-@item
-In constructs for defining or altering functions. If @code{defun}
-were not a primitive, it could be written in Lisp (as a macro) using
-@code{fset}.
-@end itemize
+@node Closures
+@section Closures
-Here are examples of these uses:
+ As explained in @ref{Variable Scoping}, Emacs can optionally enable
+lexical binding of variables. When lexical binding is enabled, any
+named function that you create (e.g.@: with @code{defun}), as well as
+any anonymous function that you create using the @code{lambda} macro
+or the @code{function} special form or the @code{#'} syntax
+(@pxref{Anonymous Functions}), is automatically converted into a
+@dfn{closure}.
-@example
-@group
-;; @r{Save @code{foo}'s definition in @code{old-foo}.}
-(fset 'old-foo (symbol-function 'foo))
-@end group
+@cindex closure
+ A closure is a function that also carries a record of the lexical
+environment that existed when the function was defined. When it is
+invoked, any lexical variable references within its definition use the
+retained lexical environment. In all other respects, closures behave
+much like ordinary functions; in particular, they can be called in the
+same way as ordinary functions.
-@group
-;; @r{Make the symbol @code{car} the function definition of @code{xfirst}.}
-;; @r{(Most likely, @code{defalias} would be better than @code{fset} here.)}
-(fset 'xfirst 'car)
- @result{} car
-@end group
-@group
-(xfirst '(1 2 3))
- @result{} 1
-@end group
-@group
-(symbol-function 'xfirst)
- @result{} car
-@end group
-@group
-(symbol-function (symbol-function 'xfirst))
- @result{} #<subr car>
-@end group
+ @xref{Lexical Binding}, for an example of using a closure.
-@group
-;; @r{Define a named keyboard macro.}
-(fset 'kill-two-lines "\^u2\^k")
- @result{} "\^u2\^k"
-@end group
+ Currently, an Emacs Lisp closure object is represented by a list
+with the symbol @code{closure} as the first element, a list
+representing the lexical environment as the second element, and the
+argument list and body forms as the remaining elements:
-@group
-;; @r{Here is a function that alters other functions.}
-(defun copy-function-definition (new old)
- "Define NEW with the same function definition as OLD."
- (fset new (symbol-function old)))
-@end group
+@example
+;; @r{lexical binding is enabled.}
+(lambda (x) (* x x))
+ @result{} (closure (t) (x) (* x x))
@end example
-@end defun
- @code{fset} is sometimes used to save the old definition of a
-function before redefining it. That permits the new definition to
-invoke the old definition. But it is unmodular and unclean for a Lisp
-file to redefine a function defined elsewhere. If you want to modify
-a function defined by another package, it is cleaner to use
-@code{defadvice} (@pxref{Advising Functions}).
+@noindent
+However, the fact that the internal structure of a closure is
+``exposed'' to the rest of the Lisp world is considered an internal
+implementation detail. For this reason, we recommend against directly
+examining or altering the structure of closure objects.
@node Obsolete Functions
@section Declaring Functions Obsolete
-You can use @code{make-obsolete} to declare a function obsolete. This
-indicates that the function may be removed at some stage in the future.
+ You can mark a named function as @dfn{obsolete}, meaning that it may
+be removed at some point in the future. This causes Emacs to warn
+that the function is obsolete whenever it byte-compiles code
+containing that function, and whenever it displays the documentation
+for that function. In all other respects, an obsolete function
+behaves like any other function.
+
+ The easiest way to mark a function as obsolete is to put a
+@code{(declare (obsolete @dots{}))} form in the function's
+@code{defun} definition. @xref{Declare Form}. Alternatively, you can
+use the @code{make-obsolete} function, described below.
+
+ A macro (@pxref{Macros}) can also be marked obsolete with
+@code{make-obsolete}; this has the same effects as for a function. An
+alias for a function or macro can also be marked as obsolete; this
+makes the alias itself obsolete, not the function or macro which it
+resolves to.
@defun make-obsolete obsolete-name current-name &optional when
-This function makes the byte compiler warn that the function
-@var{obsolete-name} is obsolete. If @var{current-name} is a symbol, the
-warning message says to use @var{current-name} instead of
-@var{obsolete-name}. @var{current-name} does not need to be an alias for
-@var{obsolete-name}; it can be a different function with similar
-functionality. If @var{current-name} is a string, it is the warning
-message.
+This function marks @var{obsolete-name} as obsolete.
+@var{obsolete-name} should be a symbol naming a function or macro, or
+an alias for a function or macro.
+
+If @var{current-name} is a symbol, the warning message says to use
+@var{current-name} instead of @var{obsolete-name}. @var{current-name}
+does not need to be an alias for @var{obsolete-name}; it can be a
+different function with similar functionality. @var{current-name} can
+also be a string, which serves as the warning message. The message
+should begin in lower case, and end with a period. It can also be
+@code{nil}, in which case the warning message provides no additional
+details.
If provided, @var{when} should be a string indicating when the function
was first made obsolete---for example, a date or a release number.
@end defun
-You can define a function as an alias and declare it obsolete at the
-same time using the macro @code{define-obsolete-function-alias}:
-
-@defmac define-obsolete-function-alias obsolete-name current-name &optional when docstring
-This macro marks the function @var{obsolete-name} obsolete and also
-defines it as an alias for the function @var{current-name}. It is
-equivalent to the following:
+@defmac define-obsolete-function-alias obsolete-name current-name &optional when doc
+This convenience macro marks the function @var{obsolete-name} obsolete
+and also defines it as an alias for the function @var{current-name}.
+It is equivalent to the following:
@example
-(defalias @var{obsolete-name} @var{current-name} @var{docstring})
+(defalias @var{obsolete-name} @var{current-name} @var{doc})
(make-obsolete @var{obsolete-name} @var{current-name} @var{when})
@end example
@end defmac
@@ -1226,69 +1185,130 @@ equivalent to the following:
In addition, you can mark a certain a particular calling convention
for a function as obsolete:
-@defun set-advertised-calling-convention function signature
+@defun set-advertised-calling-convention function signature when
This function specifies the argument list @var{signature} as the
correct way to call @var{function}. This causes the Emacs byte
compiler to issue a warning whenever it comes across an Emacs Lisp
program that calls @var{function} any other way (however, it will
-still allow the code to be byte compiled).
+still allow the code to be byte compiled). @var{when} should be a
+string indicating when the variable was first made obsolete (usually a
+version number string).
For instance, in old versions of Emacs the @code{sit-for} function
accepted three arguments, like this
-@smallexample
+@example
(sit-for seconds milliseconds nodisp)
-@end smallexample
+@end example
However, calling @code{sit-for} this way is considered obsolete
(@pxref{Waiting}). The old calling convention is deprecated like
this:
-@smallexample
+@example
(set-advertised-calling-convention
- 'sit-for '(seconds &optional nodisp))
-@end smallexample
+ 'sit-for '(seconds &optional nodisp) "22.1")
+@end example
@end defun
@node Inline Functions
@section Inline Functions
@cindex inline functions
-@findex defsubst
-You can define an @dfn{inline function} by using @code{defsubst} instead
-of @code{defun}. An inline function works just like an ordinary
-function except for one thing: when you compile a call to the function,
-the function's definition is open-coded into the caller.
+ An @dfn{inline function} is a function that works just like an
+ordinary function, except for one thing: when you byte-compile a call
+to the function (@pxref{Byte Compilation}), the function's definition
+is expanded into the caller. To define an inline function, use
+@code{defsubst} instead of @code{defun}.
-Making a function inline makes explicit calls run faster. But it also
-has disadvantages. For one thing, it reduces flexibility; if you
-change the definition of the function, calls already inlined still use
-the old definition until you recompile them.
+@defmac defsubst name args [doc] [declare] [interactive] body@dots{}
+This macro defines an inline function. Its syntax is exactly the same
+as @code{defun} (@pxref{Defining Functions}).
+@end defmac
+
+ Making a function inline often makes its function calls run faster.
+But it also has disadvantages. For one thing, it reduces flexibility;
+if you change the definition of the function, calls already inlined
+still use the old definition until you recompile them.
-Another disadvantage is that making a large function inline can increase
-the size of compiled code both in files and in memory. Since the speed
-advantage of inline functions is greatest for small functions, you
-generally should not make large functions inline.
+ Another disadvantage is that making a large function inline can
+increase the size of compiled code both in files and in memory. Since
+the speed advantage of inline functions is greatest for small
+functions, you generally should not make large functions inline.
-Also, inline functions do not behave well with respect to debugging,
+ Also, inline functions do not behave well with respect to debugging,
tracing, and advising (@pxref{Advising Functions}). Since ease of
debugging and the flexibility of redefining functions are important
features of Emacs, you should not make a function inline, even if it's
small, unless its speed is really crucial, and you've timed the code
to verify that using @code{defun} actually has performance problems.
-It's possible to define a macro to expand into the same code that an
-inline function would execute. (@xref{Macros}.) But the macro would be
-limited to direct use in expressions---a macro cannot be called with
-@code{apply}, @code{mapcar} and so on. Also, it takes some work to
-convert an ordinary function into a macro. To convert it into an inline
-function is very easy; simply replace @code{defun} with @code{defsubst}.
-Since each argument of an inline function is evaluated exactly once, you
-needn't worry about how many times the body uses the arguments, as you
-do for macros. (@xref{Argument Evaluation}.)
+ It's possible to define a macro to expand into the same code that an
+inline function would execute (@pxref{Macros}). But the macro would
+be limited to direct use in expressions---a macro cannot be called
+with @code{apply}, @code{mapcar} and so on. Also, it takes some work
+to convert an ordinary function into a macro. To convert it into an
+inline function is easy; just replace @code{defun} with
+@code{defsubst}. Since each argument of an inline function is
+evaluated exactly once, you needn't worry about how many times the
+body uses the arguments, as you do for macros.
+
+ After an inline function is defined, its inline expansion can be
+performed later on in the same file, just like macros.
+
+@node Declare Form
+@section The @code{declare} Form
+@findex declare
+
+ @code{declare} is a special macro which can be used to add ``meta''
+properties to a function or macro: for example, marking it as
+obsolete, or giving its forms a special @key{TAB} indentation
+convention in Emacs Lisp mode.
+
+@anchor{Definition of declare}
+@defmac declare @var{specs}@dots{}
+This macro ignores its arguments and evaluates to @code{nil}; it has
+no run-time effect. However, when a @code{declare} form occurs in the
+@var{declare} argument of a @code{defun} or @code{defsubst} function
+definition (@pxref{Defining Functions}) or a @code{defmacro} macro
+definition (@pxref{Defining Macros}), it appends the properties
+specified by @var{specs} to the function or macro. This work is
+specially performed by @code{defun}, @code{defsubst}, and
+@code{defmacro}.
+
+Each element in @var{specs} should have the form @code{(@var{property}
+@var{args}@dots{})}, which should not be quoted. These have the
+following effects:
-Inline functions can be used and open-coded later on in the same file,
-following the definition, just like macros.
+@table @code
+@item (advertised-calling-convention @var{signature} @var{when})
+This acts like a call to @code{set-advertised-calling-convention}
+(@pxref{Obsolete Functions}); @var{signature} specifies the correct
+argument list for calling the function or macro, and @var{when} should
+be a string indicating when the variable was first made obsolete.
+
+@item (debug @var{edebug-form-spec})
+This is valid for macros only. When stepping through the macro with
+Edebug, use @var{edebug-form-spec}. @xref{Instrumenting Macro Calls}.
+
+@item (doc-string @var{n})
+Use element number @var{n}, if any, as the documentation string.
+
+@item (indent @var{indent-spec})
+Indent calls to this function or macro according to @var{indent-spec}.
+This is typically used for macros, though it works for functions too.
+@xref{Indenting Macros}.
+
+@item (obsolete @var{current-name} @var{when})
+Mark the function or macro as obsolete, similar to a call to
+@code{make-obsolete} (@pxref{Obsolete Functions}). @var{current-name}
+should be a symbol (in which case the warning message says to use that
+instead), a string (specifying the warning message), or @code{nil} (in
+which case the warning message gives no extra details). @var{when}
+should be a string indicating when the function or macro was first
+made obsolete.
+@end table
+@end defmac
@node Declaring Functions
@section Telling the Compiler that a Function is Defined
@@ -1302,11 +1322,11 @@ indicates a real problem, but usually the functions in question are
defined in other files which would be loaded if that code is run. For
example, byte-compiling @file{fortran.el} used to warn:
-@smallexample
+@example
In end of data:
-fortran.el:2152:1:Warning: the function `gud-find-c-expr' is not known
- to be defined.
-@end smallexample
+fortran.el:2152:1:Warning: the function `gud-find-c-expr' is not
+ known to be defined.
+@end example
In fact, @code{gud-find-c-expr} is only used in the function that
Fortran mode uses for the local value of
@@ -1319,9 +1339,9 @@ visible. You do that with @code{declare-function}.
All you need to do is add a @code{declare-function} statement before the
first use of the function in question:
-@smallexample
+@example
(declare-function gud-find-c-expr "gud.el" nil)
-@end smallexample
+@end example
This says that @code{gud-find-c-expr} is defined in @file{gud.el} (the
@samp{.el} can be omitted). The compiler takes for granted that that file
@@ -1352,12 +1372,10 @@ definition using @code{locate-library}; if that finds no file, they
expand the definition file name relative to the directory of the file
that contains the @code{declare-function} call.
- You can also say that a function is defined by C code by specifying a
-file name ending in @samp{.c} or @samp{.m}. @code{check-declare-file}
-looks for these files in the C source code directory. This is useful
-only when you call a function that is defined only on certain systems.
-Most of the primitive functions of Emacs are always defined so they will
-never give you a warning.
+ You can also say that a function is a primitive by specifying a file
+name ending in @samp{.c} or @samp{.m}. This is useful only when you
+call a primitive that is defined only on certain systems. Most
+primitives are always defined, so they will never give you a warning.
Sometimes a file will optionally use functions from an external package.
If you prefix the filename in the @code{declare-function} statement with
@@ -1378,7 +1396,7 @@ opposed to an unspecified one).
@cindex function safety
@cindex safety of functions
-Some major modes such as SES call functions that are stored in user
+Some major modes, such as SES, call functions that are stored in user
files. (@inforef{Top, ,ses}, for more information on SES.) User
files sometimes have poor pedigrees---you can get a spreadsheet from
someone you've just met, or you can get one through email from someone
diff --git a/doc/lispref/gpl.texi b/doc/lispref/gpl.texi
index 244f3330d44..97a17e1914e 100644
--- a/doc/lispref/gpl.texi
+++ b/doc/lispref/gpl.texi
@@ -1,14 +1,8 @@
-@c -*-texinfo-*-
-@setfilename ../../info/gpl
-
-@node GPL, Tips, GNU Free Documentation License, Top
-@comment node-name, next, previous, up
-@appendix GNU General Public License
@c The GNU General Public License.
@center Version 3, 29 June 2007
@c This file is intended to be included within another document,
-@c hence no sectioning command or @node.
+@c hence no sectioning command or @node.
@display
Copyright @copyright{} 2007 Free Software Foundation, Inc. @url{http://fsf.org/}
@@ -228,7 +222,7 @@ terms of section 4, provided that you also meet all of these
conditions:
@enumerate a
-@item
+@item
The work must carry prominent notices stating that you modified it,
and giving a relevant date.
@@ -676,7 +670,7 @@ state the exclusion of warranty; and each file should have at least
the ``copyright'' line and a pointer to where the full notice is found.
@smallexample
-@var{one line to give the program's name and a brief idea of what it does.}
+@var{one line to give the program's name and a brief idea of what it does.}
Copyright (C) @var{year} @var{name of author}
This program is free software: you can redistribute it and/or modify
@@ -699,7 +693,7 @@ If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
@smallexample
-@var{program} Copyright (C) @var{year} @var{name of author}
+@var{program} Copyright (C) @var{year} @var{name of author}
This program comes with ABSOLUTELY NO WARRANTY; for details type @samp{show w}.
This is free software, and you are welcome to redistribute it
under certain conditions; type @samp{show c} for details.
diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi
index 0d77cba6fa6..bb7a60e2e2d 100644
--- a/doc/lispref/hash.texi
+++ b/doc/lispref/hash.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/hash
-@node Hash Tables, Symbols, Sequences Arrays Vectors, Top
+@node Hash Tables
@chapter Hash Tables
@cindex hash tables
@cindex lookup tables
@@ -75,13 +74,13 @@ alternatives:
Keys which are numbers are ``the same'' if they are @code{equal}, that
is, if they are equal in value and either both are integers or both
are floating point numbers; otherwise, two distinct objects are never
-``the same.''
+``the same''.
@item eq
Any two distinct Lisp objects are ``different'' as keys.
@item equal
-Two Lisp objects are ``the same,'' as keys, if they are equal
+Two Lisp objects are ``the same'', as keys, if they are equal
according to @code{equal}.
@end table
@@ -129,7 +128,7 @@ doing that takes some extra time.
The default size is 65.
@item :rehash-size @var{rehash-size}
-When you add an association to a hash table and the table is ``full,''
+When you add an association to a hash table and the table is ``full'',
it grows automatically. This value specifies how to make the hash table
larger, at that time.
@@ -263,7 +262,7 @@ will use @var{test-fn} to compare key values, and @var{hash-fn} to compute
a ``hash code'' from a key value.
The function @var{test-fn} should accept two arguments, two keys, and
-return non-@code{nil} if they are considered ``the same.''
+return non-@code{nil} if they are considered ``the same''.
The function @var{hash-fn} should accept one argument, a key, and return
an integer that is the ``hash code'' of that key. For good results, the
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index 3426e81cdb3..1375a057a5a 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -1,18 +1,17 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/help
-@node Documentation, Files, Modes, Top
+@node Documentation
@chapter Documentation
@cindex documentation strings
- GNU Emacs Lisp has convenient on-line help facilities, most of which
-derive their information from the documentation strings associated with
-functions and variables. This chapter describes how to write good
-documentation strings for your Lisp programs, as well as how to write
-programs to access documentation.
+ GNU Emacs has convenient built-in help facilities, most of which
+derive their information from documentation strings associated with
+functions and variables. This chapter describes how to access
+documentation strings in Lisp programs. @xref{Documentation Tips},
+for how to write good documentation strings.
Note that the documentation strings for Emacs are not the same thing
as the Emacs manual. Manuals have their own source files, written in
@@ -23,12 +22,10 @@ manual is not organized in that fashion; it is organized in terms of
topics of discussion.
For commands to display documentation strings, see @ref{Help, ,
-Help, emacs, The GNU Emacs Manual}. For the conventions for writing
-documentation strings, see @ref{Documentation Tips}.
+Help, emacs, The GNU Emacs Manual}.
@menu
-* Documentation Basics:: Good style for doc strings.
- Where to put them. How Emacs stores them.
+* Documentation Basics:: Where doc strings are defined and stored.
* Accessing Documentation:: How Lisp programs can access doc strings.
* Keys in Documentation:: Substituting current key bindings.
* Describing Characters:: Making printable descriptions of
@@ -37,7 +34,6 @@ documentation strings, see @ref{Documentation Tips}.
@end menu
@node Documentation Basics
-@comment node-name, next, previous, up
@section Documentation Basics
@cindex documentation conventions
@cindex writing a documentation string
@@ -52,74 +48,93 @@ string follows the argument list. In a variable definition, the
documentation string follows the initial value of the variable.
When you write a documentation string, make the first line a
-complete sentence (or two complete sentences) since some commands,
-such as @code{apropos}, show only the first line of a multi-line
-documentation string. Also, you should not indent the second line of
-a documentation string, if it has one, because that looks odd when you
+complete sentence (or two complete sentences) that briefly describes
+what the function or variable does. Some commands, such as
+@code{apropos}, show only the first line of a multi-line documentation
+string. Also, you should not indent the second line of a
+documentation string, if it has one, because that looks odd when you
use @kbd{C-h f} (@code{describe-function}) or @kbd{C-h v}
(@code{describe-variable}) to view the documentation string. There
-are many other conventions for doc strings; see @ref{Documentation
-Tips}.
+are many other conventions for documentation strings; see
+@ref{Documentation Tips}.
- Documentation strings can contain several special substrings, which
-stand for key bindings to be looked up in the current keymaps when the
-documentation is displayed. This allows documentation strings to refer
-to the keys for related commands and be accurate even when a user
-rearranges the key bindings. (@xref{Keys in Documentation}.)
+ Documentation strings can contain several special text sequences,
+referring to key bindings which are looked up in the current keymaps
+when the user views the documentation. This allows the help commands
+to display the correct keys even if a user rearranges the default key
+bindings. @xref{Keys in Documentation}.
+
+ In the documentation string of an autoloaded command
+(@pxref{Autoload}), these special text sequences have an additional
+special effect: they cause @kbd{C-h f} (@code{describe-function}) on
+the command to trigger autoloading. (This is needed for correctly
+setting up the hyperlinks in the @file{*Help*} buffer).
@vindex emacs-lisp-docstring-fill-column
Emacs Lisp mode fills documentation strings to the width
specified by @code{emacs-lisp-docstring-fill-column}.
- In Emacs Lisp, a documentation string is accessible through the
-function or variable that it describes:
+ Exactly where a documentation string is stored depends on how its
+function or variable was defined or loaded into memory:
@itemize @bullet
@item
@kindex function-documentation
-The documentation for a function is usually stored in the function
-definition itself (@pxref{Lambda Expressions} and @pxref{Function
-Documentation}). The function @code{documentation} knows how to
-extract it. You can also put function documentation in the
-@code{function-documentation} property of the function name. That is
-useful with definitions such as keyboard macros that can't hold a
-documentation string.
+When you define a function (@pxref{Lambda Expressions}, and
+@pxref{Function Documentation}), the documentation string is stored in
+the function definition itself. You can also put function
+documentation in the @code{function-documentation} property of a
+function name. That is useful for function definitions which can't
+hold a documentation string, such as keyboard macros.
@item
@kindex variable-documentation
-The documentation for a variable is stored in the variable's property
-list under the property name @code{variable-documentation}. The
-function @code{documentation-property} knows how to retrieve it.
-@end itemize
+When you define a variable with a @code{defvar} or related form
+(@pxref{Defining Variables}), the documentation is stored in the
+variable's @code{variable-documentation} property.
@cindex @file{DOC-@var{version}} (documentation) file
-To save space, the documentation for preloaded functions and variables
-(including primitive functions and autoloaded functions) is stored in
-the file @file{emacs/etc/DOC-@var{version}}---not inside Emacs. The
-documentation strings for functions and variables loaded during the
-Emacs session from byte-compiled files are stored in those files
-(@pxref{Docs and Compilation}).
-
-The data structure inside Emacs has an integer offset into the file, or
-a list containing a file name and an integer, in place of the
-documentation string. The functions @code{documentation} and
-@code{documentation-property} use that information to fetch the
-documentation string from the appropriate file; this is transparent to
-the user.
+@item
+To save memory, the documentation for preloaded functions and
+variables (including primitive functions and autoloaded functions) is
+not kept in memory, but in the file
+@file{emacs/etc/DOC-@var{version}}, where @var{version} is the Emacs
+version number (@pxref{Version Info}).
+
+@item
+When a function or variable is loaded from a byte-compiled file during
+the Emacs session, its documentation string is not loaded into memory.
+Instead, Emacs looks it up in the byte-compiled file as needed.
+@xref{Docs and Compilation}.
+@end itemize
+
+@noindent
+Regardless of where the documentation string is stored, you can
+retrieve it using the @code{documentation} or
+@code{documentation-property} function, described in the next section.
@node Accessing Documentation
@section Access to Documentation Strings
@defun documentation-property symbol property &optional verbatim
-This function returns the documentation string that is recorded in
-@var{symbol}'s property list under property @var{property}. It
-retrieves the text from a file if the value calls for that. If the
-property value isn't @code{nil}, isn't a string, and doesn't refer to
-text in a file, then it is evaluated to obtain a string.
+This function returns the documentation string recorded in
+@var{symbol}'s property list under property @var{property}. It is
+most often used to look up the documentation strings of variables, for
+which @var{property} is @code{variable-documentation}. However, it
+can also be used to look up other kinds of documentation, such as for
+customization groups (but for function documentation, use the
+@code{documentation} command, below).
+
+If the value recorded in the property list refers to a documentation
+string stored in a @file{DOC-@var{version}} file or a byte-compiled
+file, it looks up that string and returns it. If the property value
+isn't @code{nil}, isn't a string, and doesn't refer to text in a file,
+then it is evaluated as a Lisp expression to obtain a string.
The last thing this function does is pass the string through
-@code{substitute-command-keys} to substitute actual key bindings,
-unless @var{verbatim} is non-@code{nil}.
+@code{substitute-command-keys} to substitute actual key bindings
+(@pxref{Keys in Documentation}). However, it skips this step if
+@var{verbatim} is non-@code{nil}.
@smallexample
@group
@@ -169,7 +184,7 @@ face.
@c Wordy to prevent overfull hboxes. --rjc 15mar92
Here is an example of using the two functions, @code{documentation} and
@code{documentation-property}, to display the documentation strings for
-several symbols in a @samp{*Help*} buffer.
+several symbols in a @file{*Help*} buffer.
@anchor{describe-symbols example}
@smallexample
@@ -207,7 +222,7 @@ in the `*Help*' buffer."
@group
(princ
(format "%s\t%s\n%s\n\n" s
- (if (user-variable-p s)
+ (if (custom-variable-p s)
"Option " "Variable")
@end group
@group
@@ -270,13 +285,13 @@ When the `track-eol' feature is doing its job, the value is 9999.
@end group
@end smallexample
-@defun Snarf-documentation filename
@anchor{Definition of Snarf-documentation}
-This function is used only during Emacs initialization, just before
-the runnable Emacs is dumped. It finds the file offsets of the
-documentation strings stored in the file @var{filename}, and records
-them in the in-core function definitions and variable property lists in
-place of the actual strings. @xref{Building Emacs}.
+@defun Snarf-documentation filename
+This function is used when building Emacs, just before the runnable
+Emacs is dumped. It finds the positions of the documentation strings
+stored in the file @var{filename}, and records those positions into
+memory in the function definitions and variable property lists.
+@xref{Building Emacs}.
Emacs reads the file @var{filename} from the @file{emacs/etc} directory.
When the dumped Emacs is later executed, the same file will be looked
@@ -337,6 +352,21 @@ This function scans @var{string} for the above special sequences and
replaces them by what they stand for, returning the result as a string.
This permits display of documentation that refers accurately to the
user's own customized key bindings.
+
+@cindex advertised binding
+If a command has multiple bindings, this function normally uses the
+first one it finds. You can specify one particular key binding by
+assigning an @code{:advertised-binding} symbol property to the
+command, like this:
+
+@smallexample
+(put 'undo :advertised-binding [?\C-/])
+@end smallexample
+
+@noindent
+The @code{:advertised-binding} property also affects the binding shown
+in menu items (@pxref{Menu Bar}). The property is ignored if it
+specifies a key binding that the command does not actually have.
@end defun
Here are examples of the special sequences:
@@ -486,7 +516,7 @@ for Meta.
@end smallexample
@end defun
-@defun read-kbd-macro string &optional need-vector
+@deffn Command read-kbd-macro string &optional need-vector
This function is used mainly for operating on keyboard macros, but it
can also be used as a rough inverse for @code{key-description}. You
call it with a string containing key descriptions, separated by spaces;
@@ -494,7 +524,7 @@ it returns a string or vector containing the corresponding events.
(This may or may not be a single valid key sequence, depending on what
events you use; @pxref{Key Sequences}.) If @var{need-vector} is
non-@code{nil}, the return value is always a vector.
-@end defun
+@end deffn
@node Help Functions
@section Help Functions
@@ -515,15 +545,16 @@ definition as a function, variable, or face, or has properties.
The function returns a list of elements that look like this:
@example
-(@var{symbol} @var{score} @var{fn-doc} @var{var-doc}
+(@var{symbol} @var{score} @var{function-doc} @var{variable-doc}
@var{plist-doc} @var{widget-doc} @var{face-doc} @var{group-doc})
@end example
Here, @var{score} is an integer measure of how important the symbol
-seems to be as a match, and the remaining elements are documentation
-strings for @var{symbol}'s various roles (or @code{nil}).
+seems to be as a match. Each of the remaining elements is a
+documentation string, or @code{nil}, for @var{symbol} as a function,
+variable, etc.
-It also displays the symbols in a buffer named @samp{*Apropos*}, each
+It also displays the symbols in a buffer named @file{*Apropos*}, each
with a one-line description taken from the beginning of its
documentation string.
@@ -573,7 +604,7 @@ subcommands of the prefix key.
@defopt help-event-list
The value of this variable is a list of event types that serve as
-alternative ``help characters.'' These events are handled just like the
+alternative ``help characters''. These events are handled just like the
event specified by @code{help-char}.
@end defopt
@@ -582,11 +613,12 @@ If this variable is non-@code{nil}, its value is a form to evaluate
whenever the character @code{help-char} is read. If evaluating the form
produces a string, that string is displayed.
-A command that calls @code{read-event} or @code{read-char} probably
-should bind @code{help-form} to a non-@code{nil} expression while it
-does input. (The time when you should not do this is when @kbd{C-h} has
-some other meaning.) Evaluating this expression should result in a
-string that explains what the input is for and how to enter it properly.
+A command that calls @code{read-event}, @code{read-char-choice}, or
+@code{read-char} probably should bind @code{help-form} to a
+non-@code{nil} expression while it does input. (The time when you
+should not do this is when @kbd{C-h} has some other meaning.)
+Evaluating this expression should result in a string that explains
+what the input is for and how to enter it properly.
Entry to the minibuffer binds this variable to the value of
@code{minibuffer-help-form} (@pxref{Definition of minibuffer-help-form}).
@@ -599,12 +631,12 @@ character, and the help character has no binding after that prefix. The
variable's default value is @code{describe-prefix-bindings}.
@end defvar
-@defun describe-prefix-bindings
+@deffn Command describe-prefix-bindings
This function calls @code{describe-bindings} to display a list of all
the subcommands of the prefix key of the most recent key sequence. The
prefix described consists of all but the last event of that key
sequence. (The last event is, presumably, the help character.)
-@end defun
+@end deffn
The following two functions are meant for modes that want to provide
help without relinquishing control, such as the ``electric'' modes.
@@ -623,6 +655,7 @@ in the minibuffer with the message @samp{Help (Type ? for further
options)}, and then provides assistance in finding out what the key
bindings are, and what the mode is intended for. It returns @code{nil}.
+@vindex Helper-help-map
This can be customized by changing the map @code{Helper-help-map}.
@end deffn
@@ -634,7 +667,7 @@ certain documentation and text files that come with Emacs.
@defun help-buffer
This function returns the name of the help buffer, which is normally
-@samp{*Help*}; if such a buffer does not exist, it is first created.
+@file{*Help*}; if such a buffer does not exist, it is first created.
@end defun
@defmac with-help-window buffer-name body@dots{}
@@ -648,16 +681,16 @@ scroll the help window.
@end defmac
@defun help-setup-xref item interactive-p
-This function updates the cross reference data in the @samp{*Help*}
+This function updates the cross reference data in the @file{*Help*}
buffer, which is used to regenerate the help information when the user
clicks on the @samp{Back} or @samp{Forward} buttons. Most commands
-that use the @samp{*Help*} buffer should invoke this function before
+that use the @file{*Help*} buffer should invoke this function before
clearing the buffer. The @var{item} argument should have the form
@code{(@var{function} . @var{args})}, where @var{function} is a function
to call, with argument list @var{args}, to regenerate the help buffer.
The @var{interactive-p} argument is non-@code{nil} if the calling
command was invoked interactively; in that case, the stack of items
-for the @samp{*Help*} buffer's @samp{Back} buttons is cleared.
+for the @file{*Help*} buffer's @samp{Back} buttons is cleared.
@end defun
@xref{describe-symbols example}, for an example of using
diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi
index 6e2cac9c065..a6ac2c70e84 100644
--- a/doc/lispref/hooks.texi
+++ b/doc/lispref/hooks.texi
@@ -1,14 +1,13 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1993, 1998, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1993, 1998, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/hooks
-@node Standard Hooks, Index, Standard Keymaps, Top
+@node Standard Hooks
@appendix Standard Hooks
@cindex standard hooks
@cindex hook variables, list of
-The following is a list of hook variables that let you provide
+The following is a list of some hook variables that let you provide
functions to be called from within Emacs on suitable occasions.
Most of these variables have names ending with @samp{-hook}. They are
@@ -18,114 +17,92 @@ arguments and their values are completely ignored. The recommended way
to put a new function on such a hook is to call @code{add-hook}.
@xref{Hooks}, for more information about using hooks.
-Every major mode defines a mode hook named
+The variables whose names end in @samp{-functions} are usually @dfn{abnormal
+hooks} (some old code may also use the deprecated @samp{-hooks} suffix); their
+values are lists of functions, but these functions are called in a special way
+(they are passed arguments, or their return values are used). The variables
+whose names end in @samp{-function} have single functions as their values.
+
+This is not an exhaustive list, it only covers the more general hooks.
+For example, every major mode defines a hook named
@samp{@var{modename}-mode-hook}. The major mode command runs this
normal hook with @code{run-mode-hooks} as the very last thing it does.
-@xref{Mode Hooks}. Most minor modes have mode hooks too. Mode hooks
-are omitted in the list below.
-
-The variables whose names end in @samp{-hooks} or @samp{-functions} are
-usually @dfn{abnormal hooks}; their values are lists of functions, but
-these functions are called in a special way (they are passed arguments,
-or their values are used). The variables whose names end in
-@samp{-function} have single functions as their values.
+@xref{Mode Hooks}. Most minor modes have mode hooks too.
A special feature allows you to specify expressions to evaluate if and
when a file is loaded (@pxref{Hooks for Loading}). That feature is
not exactly a hook, but does a similar job.
-@c We need to xref to where each hook is documented or else document
-@c it here.
+@c We need to xref to where each hook is documented or else document it here.
+@c Add vindex for anything not indexed elsewhere.
+@c This list is in alphabetical order, grouped by topic.
+@c TODO It should probably be more thoroughly ordered by topic.
@table @code
-@item abbrev-expand-functions
-@xref{Abbrev Expansion}.
-
@item activate-mark-hook
+@itemx deactivate-mark-hook
@xref{The Mark}.
@item after-change-functions
+@itemx before-change-functions
+@itemx first-change-hook
@xref{Change Hooks}.
@item after-change-major-mode-hook
+@itemx change-major-mode-after-body-hook
@xref{Mode Hooks}.
@item after-init-hook
+@itemx before-init-hook
+@itemx emacs-startup-hook
@xref{Init File}.
@item after-insert-file-functions
+@itemx write-region-annotate-functions
+@itemx write-region-post-annotation-function
@xref{Format Conversion}.
@item after-make-frame-functions
+@itemx before-make-frame-hook
@xref{Creating Frames}.
+@c Not general enough?
+@ignore
@item after-revert-hook
+@itemx before-revert-hook
+@itemx buffer-stale-function
+@itemx revert-buffer-function
+@itemx revert-buffer-insert-file-contents-function
@xref{Reverting}.
+@end ignore
@item after-save-hook
+@itemx before-save-hook
+@itemx write-contents-functions
+@itemx write-file-functions
@xref{Saving Buffers}.
-@item auto-fill-function
-@xref{Auto Filling}.
+@item after-setting-font-hook
+@vindex after-setting-font-hook
+Hook run after a frame's font changes.
@item auto-save-hook
@xref{Auto-Saving}.
-@item before-change-functions
-@xref{Change Hooks}.
-
@item before-hack-local-variables-hook
+@itemx hack-local-variables-hook
@xref{File Local Variables}.
-@item before-init-hook
-@xref{Init File}.
-
-@item before-make-frame-hook
-@xref{Creating Frames}.
-
-@item before-revert-hook
-@xref{Reverting}.
-
-@item before-save-hook
-@xref{Saving Buffers}.
-
-@item blink-paren-function
-@xref{Blinking}.
-
@item buffer-access-fontify-functions
@xref{Lazy Properties}.
-@item calendar-initial-window-hook
-@iftex
-@inforef{Calendar Customizing,, emacs-xtra}.
-@end iftex
-@ifnottex
-@xref{Calendar Customizing,,, emacs}.
-@end ifnottex
-
-@item calendar-load-hook
-@iftex
-@inforef{Calendar Customizing,, emacs-xtra}.
-@end iftex
-@ifnottex
-@xref{Calendar Customizing,,, emacs}.
-@end ifnottex
-
-@item calendar-today-invisible-hook
-@iftex
-@inforef{Calendar Customizing,, emacs-xtra}.
-@end iftex
-@ifnottex
-@xref{Calendar Customizing,,, emacs}.
-@end ifnottex
-
-@item calendar-today-visible-hook
-@iftex
-@inforef{Calendar Customizing,, emacs-xtra}.
-@end iftex
-@ifnottex
-@xref{Calendar Customizing,,, emacs}.
-@end ifnottex
+@item buffer-list-update-hook
+@vindex buffer-list-update-hook
+Hook run when the buffer list changes.
+
+@item buffer-quit-function
+@vindex buffer-quit-function
+Function to call to ``quit'' the current buffer.
@item change-major-mode-hook
@xref{Creating Buffer-Local}.
@@ -133,212 +110,167 @@ not exactly a hook, but does a similar job.
@item command-line-functions
@xref{Command-Line Arguments}.
-@item comment-indent-function
-@xref{Options for Comments,, Options Controlling Comments, emacs, the
-GNU Emacs Manual}.
-
-@item compilation-finish-functions
-Functions to call when a compilation process finishes.
-
-@item custom-define-hook
-Hook called after defining each customize option.
-
-@item deactivate-mark-hook
-@xref{The Mark}.
+@item delayed-warnings-hook
+@vindex delayed-warnings-hook
+The command loop runs this soon after @code{post-command-hook} (q.v.).
@item delete-frame-functions
-Functions to call when Emacs deletes a frame. @xref{Deleting Frames}.
+@xref{Deleting Frames}.
@item delete-terminal-functions
-Functions to call when Emacs deletes a terminal. @xref{Multiple
-Terminals}.
-
-@item desktop-after-read-hook
-Normal hook run after a successful @code{desktop-read}. May be used
-to show a buffer list. @xref{Saving Emacs Sessions,, Saving Emacs
-Sessions, emacs, the GNU Emacs Manual}.
-
-@item desktop-no-desktop-file-hook
-Normal hook run when @code{desktop-read} can't find a desktop file.
-May be used to show a dired buffer. @xref{Saving Emacs Sessions,,
-Saving Emacs Sessions, emacs, the GNU Emacs Manual}.
-
-@item desktop-save-hook
-Normal hook run before the desktop is saved in a desktop file. This
-is useful for truncating history lists, for example. @xref{Saving
-Emacs Sessions,, Saving Emacs Sessions, emacs, the GNU Emacs Manual}.
-
-@item diary-hook
-List of functions called after the display of the diary. Can be used
-for appointment notification.
-
-@item diary-list-entries-hook
-@iftex
-@inforef{Fancy Diary Display,, emacs-xtra}.
-@end iftex
-@ifnottex
-@xref{Fancy Diary Display,,, emacs}.
-@end ifnottex
-
-@item diary-mark-entries-hook
-@iftex
-@inforef{Fancy Diary Display,, emacs-xtra}.
-@end iftex
-@ifnottex
-@xref{Fancy Diary Display,,, emacs}.
-@end ifnottex
-
-@item diary-nongregorian-listing-hook
-@iftex
-@inforef{Non-Gregorian Diary,, emacs-xtra}.
-@end iftex
-@ifnottex
-@xref{Non-Gregorian Diary,,, emacs}.
-@end ifnottex
-
-@item diary-nongregorian-marking-hook
-@iftex
-@inforef{Non-Gregorian Diary,, emacs-xtra}.
-@end iftex
-@ifnottex
-@xref{Non-Gregorian Diary,,, emacs}.
-@end ifnottex
-
-@item diary-print-entries-hook
-@iftex
-@inforef{Diary Display,, emacs-xtra}.
-@end iftex
-@ifnottex
-@xref{Diary Display,,, emacs}.
-@end ifnottex
-
-@item disabled-command-function
-@xref{Disabling Commands}.
+@xref{Multiple Terminals}.
+
+@itemx pop-up-frame-function
+@itemx split-window-preferred-function
+@xref{Choosing Window Options}.
@item echo-area-clear-hook
@xref{Echo Area Customization}.
-@item emacs-startup-hook
-@xref{Init File}.
-
@item find-file-hook
+@itemx find-file-not-found-functions
@xref{Visiting Functions}.
-@item find-file-not-found-functions
-@xref{Visiting Functions}.
+@item font-lock-extend-after-change-region-function
+@xref{Region to Refontify}.
-@item first-change-hook
-@xref{Change Hooks}.
-
-@item font-lock-beginning-of-syntax-function
-@xref{Syntactic Font Lock}.
+@item font-lock-extend-region-functions
+@xref{Multiline Font Lock}.
@item font-lock-fontify-buffer-function
+@itemx font-lock-fontify-region-function
+@itemx font-lock-mark-block-function
+@itemx font-lock-unfontify-buffer-function
+@itemx font-lock-unfontify-region-function
@xref{Other Font Lock Variables}.
-@item font-lock-fontify-region-function
-@xref{Other Font Lock Variables}.
-
-@item font-lock-mark-block-function
-@xref{Other Font Lock Variables}.
+@item fontification-functions
+@xref{Auto Faces,, Automatic Face Assignment}.
-@item font-lock-syntactic-face-function
-@xref{Syntactic Font Lock}.
-
-@item font-lock-unfontify-buffer-function
-@xref{Other Font Lock Variables}.
-
-@item hack-local-variables-hook
-@xref{File Local Variables}.
-
-@item font-lock-unfontify-region-function
-@xref{Other Font Lock Variables}.
-
-@item kbd-macro-termination-hook
-@xref{Keyboard Macros}.
+@item frame-auto-hide-function
+@xref{Quitting Windows}.
@item kill-buffer-hook
-@xref{Killing Buffers}.
-
-@item kill-buffer-query-functions
+@itemx kill-buffer-query-functions
@xref{Killing Buffers}.
@item kill-emacs-hook
+@itemx kill-emacs-query-functions
@xref{Killing Emacs}.
-@item kill-emacs-query-functions
-@xref{Killing Emacs}.
-
-@item lisp-indent-function
-
-@item mail-setup-hook
-@xref{Mail Mode Misc,, Mail Mode Miscellany, emacs, the GNU Emacs
-Manual}.
-
@item menu-bar-update-hook
@xref{Menu Bar}.
@item minibuffer-setup-hook
+@itemx minibuffer-exit-hook
@xref{Minibuffer Misc}.
-@item minibuffer-exit-hook
-@xref{Minibuffer Misc}.
+@item mouse-leave-buffer-hook
+@vindex mouse-leave-buffer-hook
+Hook run when about to switch windows with a mouse command.
@item mouse-position-function
@xref{Mouse Position}.
-@item occur-hook
-
@item post-command-hook
+@itemx pre-command-hook
@xref{Command Overview}.
-@item pre-command-hook
-@xref{Command Overview}.
+@item post-gc-hook
+@xref{Garbage Collection}.
-@item resume-tty-functions
-@xref{Suspending Emacs}.
+@item post-self-insert-hook
+@xref{Keymaps and Minor Modes}.
-@item scheme-indent-function
+@ignore
+@item prog-mode-hook
+@itemx special-mode-hook
+@vindex special-mode-hook
+@xref{Basic Major Modes}.
+@end ignore
@item suspend-hook
+@itemx suspend-resume-hook
+@itemx suspend-tty-functions
+@itemx resume-tty-functions
@xref{Suspending Emacs}.
-@item suspend-resume-hook
-@xref{Suspending Emacs}.
-
-@item suspend-tty-functions
-@xref{Suspending Emacs}.
+@item syntax-begin-function
+@itemx syntax-propertize-extend-region-functions
+@itemx syntax-propertize-function
+@itemx font-lock-syntactic-face-function
+@xref{Syntactic Font Lock}. @xref{Syntax Properties}.
@item temp-buffer-setup-hook
-@xref{Temporary Displays}.
-
-@item temp-buffer-show-function
-@xref{Temporary Displays}.
-
-@item temp-buffer-show-hook
+@itemx temp-buffer-show-function
+@itemx temp-buffer-show-hook
@xref{Temporary Displays}.
@item term-setup-hook
@xref{Terminal-Specific}.
@item window-configuration-change-hook
-@xref{Window Hooks}.
-
-@item window-scroll-functions
+@itemx window-scroll-functions
+@itemx window-size-change-functions
@xref{Window Hooks}.
@item window-setup-hook
@xref{Window Systems}.
-@item window-size-change-functions
-@xref{Window Hooks}.
-
-@item write-contents-functions
-@xref{Saving Buffers}.
+@item window-text-change-functions
+@vindex window-text-change-functions
+Functions to call in redisplay when text in the window might change.
-@item write-file-functions
-@xref{Saving Buffers}.
-
-@item write-region-annotate-functions
-@xref{Format Conversion}.
@end table
+
+@ignore
+Some -hook, -function, -functions from preloaded Lisp or C files that
+I thought did not need to be mentioned here:
+
+Lisp:
+after-load-functions
+auto-coding-functions
+choose-completion-string-functions
+completing-read-function
+completion-annotate-function
+completion-at-point-functions
+completion-in-region-functions
+completion-list-insert-choice-function
+deactivate-current-input-method-function
+describe-current-input-method-function
+filter-buffer-substring-functions
+font-lock-function
+menu-bar-select-buffer-function
+read-file-name-function
+replace-re-search-function
+replace-search-function
+yank-undo-function
+
+C hooks:
+kbd-macro-termination-hook
+signal-hook-function
+
+C functions:
+redisplay-end-trigger-functions
+x-lost-selection-functions
+x-sent-selection-functions
+
+C function:
+auto-composition-function
+auto-fill-function
+command-error-function
+compose-chars-after-function
+composition-function-table
+deferred-action-function
+input-method-function
+load-read-function
+load-source-file-function
+read-buffer-function
+ring-bell-function
+select-safe-coding-system-function
+set-auto-coding-function
+show-help-function
+signal-hook-function
+undo-outer-limit-function
+
+@end ignore
diff --git a/doc/lispref/index.texi b/doc/lispref/index.texi
index 6cdadf94491..8bec3aa635b 100644
--- a/doc/lispref/index.texi
+++ b/doc/lispref/index.texi
@@ -1,5 +1,4 @@
@c -*-texinfo-*-
-@setfilename ../../info/index
@c Indexing guidelines
@@ -19,7 +18,7 @@
@c pindex is used for .el files and Unix programs
-@node Index, , Standard Hooks, Top
+@node Index
@unnumbered Index
@c Print the indices
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index 9ef4646b50b..2a2846921c5 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -1,10 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1993, 1998-1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1993, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/internals
-@node GNU Emacs Internals, Standard Errors, Tips, Top
-@comment node-name, next, previous, up
+@node GNU Emacs Internals
@appendix GNU Emacs Internals
This chapter describes how the runnable Emacs executable is dumped with
@@ -21,63 +19,59 @@ internal aspects of GNU Emacs that may be of interest to C programmers.
@end menu
@node Building Emacs
-@appendixsec Building Emacs
+@section Building Emacs
@cindex building Emacs
@pindex temacs
This section explains the steps involved in building the Emacs
executable. You don't have to know this material to build and install
Emacs, since the makefiles do all these things automatically. This
-information is pertinent to Emacs maintenance.
+information is pertinent to Emacs developers.
Compilation of the C source files in the @file{src} directory
produces an executable file called @file{temacs}, also called a
-@dfn{bare impure Emacs}. It contains the Emacs Lisp interpreter and I/O
-routines, but not the editing commands.
+@dfn{bare impure Emacs}. It contains the Emacs Lisp interpreter and
+I/O routines, but not the editing commands.
@cindex @file{loadup.el}
- The command @w{@samp{temacs -l loadup}} uses @file{temacs} to create
-the real runnable Emacs executable. These arguments direct
-@file{temacs} to evaluate the Lisp files specified in the file
-@file{loadup.el}. These files set up the normal Emacs editing
-environment, resulting in an Emacs that is still impure but no longer
-bare.
+ The command @w{@command{temacs -l loadup}} would run @file{temacs}
+and direct it to load @file{loadup.el}. The @code{loadup} library
+loads additional Lisp libraries, which set up the normal Emacs editing
+environment. After this step, the Emacs executable is no longer
+@dfn{bare}.
@cindex dumping Emacs
- It takes a substantial time to load the standard Lisp files. Luckily,
-you don't have to do this each time you run Emacs; @file{temacs} can
-dump out an executable program called @file{emacs} that has these files
-preloaded. @file{emacs} starts more quickly because it does not need to
-load the files. This is the Emacs executable that is normally
-installed.
-
+ Because it takes some time to load the standard Lisp files, the
+@file{temacs} executable usually isn't run directly by users.
+Instead, as one of the last steps of building Emacs, the command
+@samp{temacs -batch -l loadup dump} is run. The special @samp{dump}
+argument causes @command{temacs} to dump out an executable program,
+called @file{emacs}, which has all the standard Lisp files preloaded.
+(The @samp{-batch} argument prevents @file{temacs} from trying to
+initialize any of its data on the terminal, so that the tables of
+terminal information are empty in the dumped Emacs.)
+
+@cindex preloaded Lisp files
@vindex preloaded-file-list
-@cindex dumped Lisp files
- To create @file{emacs}, use the command @samp{temacs -batch -l loadup
-dump}. The purpose of @samp{-batch} here is to prevent @file{temacs}
-from trying to initialize any of its data on the terminal; this ensures
-that the tables of terminal information are empty in the dumped Emacs.
-The argument @samp{dump} tells @file{loadup.el} to dump a new executable
-named @file{emacs}. The variable @code{preloaded-file-list} stores a
-list of the Lisp files that were dumped with the @file{emacs} executable.
-
- Some operating systems don't support dumping. On those systems, you
-must start Emacs with the @samp{temacs -l loadup} command each time you
-use it. This takes a substantial time, but since you need to start
-Emacs once a day at most---or once a week if you never log out---the
-extra time is not too severe a problem.
+ The dumped @file{emacs} executable (also called a @dfn{pure} Emacs)
+is the one which is installed. The variable
+@code{preloaded-file-list} stores a list of the Lisp files preloaded
+into the dumped Emacs. If you port Emacs to a new operating system,
+and are not able to implement dumping, then Emacs must load
+@file{loadup.el} each time it starts.
@cindex @file{site-load.el}
-
You can specify additional files to preload by writing a library named
-@file{site-load.el} that loads them. You may need to add a definition
+@file{site-load.el} that loads them. You may need to rebuild Emacs
+with an added definition
@example
#define SITELOAD_PURESIZE_EXTRA @var{n}
@end example
@noindent
-to make @var{n} added bytes of pure space to hold the additional files.
+to make @var{n} added bytes of pure space to hold the additional files;
+see @file{src/puresize.h}.
(Try adding increments of 20000 until it is big enough.) However, the
advantage of preloading additional files decreases as machines get
faster. On modern machines, it is usually not advisable.
@@ -108,11 +102,11 @@ Load the files with @file{site-init.el}, then copy the files into the
installation directory for Lisp files when you install Emacs.
@item
-Specify a non-@code{nil} value for
-@code{byte-compile-dynamic-docstrings} as a local variable in each of these
-files, and load them with either @file{site-load.el} or
-@file{site-init.el}. (This method has the drawback that the
-documentation strings take up space in Emacs all the time.)
+Specify a @code{nil} value for @code{byte-compile-dynamic-docstrings}
+as a local variable in each of these files, and load them with either
+@file{site-load.el} or @file{site-init.el}. (This method has the
+drawback that the documentation strings take up space in Emacs all the
+time.)
@end itemize
It is not advisable to put anything in @file{site-load.el} or
@@ -121,17 +115,27 @@ expect in an ordinary unmodified Emacs. If you feel you must override
normal features for your site, do it with @file{default.el}, so that
users can override your changes if they wish. @xref{Startup Summary}.
- In a package that can be preloaded, it is sometimes useful to
-specify a computation to be done when Emacs subsequently starts up.
-For this, use @code{eval-at-startup}:
+ In a package that can be preloaded, it is sometimes necessary (or
+useful) to delay certain evaluations until Emacs subsequently starts
+up. The vast majority of such cases relate to the values of
+customizable variables. For example, @code{tutorial-directory} is a
+variable defined in @file{startup.el}, which is preloaded. The default
+value is set based on @code{data-directory}. The variable needs to
+access the value of @code{data-directory} when Emacs starts, not when
+it is dumped, because the Emacs executable has probably been installed
+in a different location since it was dumped.
+
+@defun custom-initialize-delay symbol value
+This function delays the initialization of @var{symbol} to the next
+Emacs start. You normally use this function by specifying it as the
+@code{:initialize} property of a customizable variable. (The argument
+@var{value} is unused, and is provided only for compatibility with the
+form Custom expects.)
+@end defun
-@defmac eval-at-startup body@dots{}
-This evaluates the @var{body} forms, either immediately if running in
-an Emacs that has already started up, or later when Emacs does start
-up. Since the value of the @var{body} forms is not necessarily
-available when the @code{eval-at-startup} form is run, that form
-always returns @code{nil}.
-@end defmac
+In the unlikely event that you need a more general functionality than
+@code{custom-initialize-delay} provides, you can use
+@code{before-init-hook} (@pxref{Startup Summary}).
@defun dump-emacs to-file from-file
@cindex unexec
@@ -144,31 +148,31 @@ you must run Emacs with @samp{-batch}.
@end defun
@node Pure Storage
-@appendixsec Pure Storage
+@section Pure Storage
@cindex pure storage
Emacs Lisp uses two kinds of storage for user-created Lisp objects:
@dfn{normal storage} and @dfn{pure storage}. Normal storage is where
-all the new data created during an Emacs session are kept; see the
-following section for information on normal storage. Pure storage is
-used for certain data in the preloaded standard Lisp files---data that
-should never change during actual use of Emacs.
+all the new data created during an Emacs session are kept
+(@pxref{Garbage Collection}). Pure storage is used for certain data
+in the preloaded standard Lisp files---data that should never change
+during actual use of Emacs.
- Pure storage is allocated only while @file{temacs} is loading the
+ Pure storage is allocated only while @command{temacs} is loading the
standard preloaded Lisp libraries. In the file @file{emacs}, it is
marked as read-only (on operating systems that permit this), so that
the memory space can be shared by all the Emacs jobs running on the
machine at once. Pure storage is not expandable; a fixed amount is
allocated when Emacs is compiled, and if that is not sufficient for
the preloaded libraries, @file{temacs} allocates dynamic memory for
-the part that didn't fit. If that happens, you should increase the
-compilation parameter @code{PURESIZE} in the file
-@file{src/puresize.h} and rebuild Emacs, even though the resulting
-image will work: garbage collection is disabled in this situation,
-causing a memory leak. Such an overflow normally won't happen unless you
-try to preload additional libraries or add features to the standard
-ones. Emacs will display a warning about the overflow when it
-starts.
+the part that didn't fit. The resulting image will work, but garbage
+collection (@pxref{Garbage Collection}) is disabled in this situation,
+causing a memory leak. Such an overflow normally won't happen unless
+you try to preload additional libraries or add features to the
+standard ones. Emacs will display a warning about the overflow when
+it starts. If this happens, you should increase the compilation
+parameter @code{SYSTEM_PURESIZE_EXTRA} in the file
+@file{src/puresize.h} and rebuild Emacs.
@defun purecopy object
This function makes a copy in pure storage of @var{object}, and returns
@@ -179,8 +183,7 @@ not make copies of other objects such as symbols, but just returns
them unchanged. It signals an error if asked to copy markers.
This function is a no-op except while Emacs is being built and dumped;
-it is usually called only in the file @file{emacs/lisp/loaddefs.el}, but
-a few packages call it just in case you decide to preload them.
+it is usually called only in preloaded Lisp files.
@end defun
@defvar pure-bytes-used
@@ -205,32 +208,40 @@ You should not change this flag in a running Emacs.
@end defvar
@node Garbage Collection
-@appendixsec Garbage Collection
-@cindex garbage collection
+@section Garbage Collection
@cindex memory allocation
- When a program creates a list or the user defines a new function (such
-as by loading a library), that data is placed in normal storage. If
-normal storage runs low, then Emacs asks the operating system to
-allocate more memory in blocks of 1k bytes. Each block is used for one
-type of Lisp object, so symbols, cons cells, markers, etc., are
-segregated in distinct blocks in memory. (Vectors, long strings,
-buffers and certain other editing types, which are fairly large, are
-allocated in individual blocks, one per object, while small strings are
-packed into blocks of 8k bytes.)
-
- It is quite common to use some storage for a while, then release it by
-(for example) killing a buffer or deleting the last pointer to an
-object. Emacs provides a @dfn{garbage collector} to reclaim this
-abandoned storage. (This name is traditional, but ``garbage recycler''
-might be a more intuitive metaphor for this facility.)
+ When a program creates a list or the user defines a new function
+(such as by loading a library), that data is placed in normal storage.
+If normal storage runs low, then Emacs asks the operating system to
+allocate more memory. Different types of Lisp objects, such as
+symbols, cons cells, small vectors, markers, etc., are segregated in
+distinct blocks in memory. (Large vectors, long strings, buffers and
+certain other editing types, which are fairly large, are allocated in
+individual blocks, one per object; small strings are packed into blocks
+of 8k bytes, and small vectors are packed into blocks of 4k bytes).
+
+@cindex vector-like objects, storage
+@cindex storage of vector-like Lisp objects
+ Beyond the basic vector, a lot of objects like window, buffer, and
+frame are managed as if they were vectors. The corresponding C data
+structures include the @code{struct vectorlike_header} field whose
+@code{size} member contains the subtype enumerated by @code{enum pvec_type}
+and an information about how many @code{Lisp_Object} fields this structure
+contains and what the size of the rest data is. This information is
+needed to calculate the memory footprint of an object, and used
+by the vector allocation code while iterating over the vector blocks.
- The garbage collector operates by finding and marking all Lisp objects
-that are still accessible to Lisp programs. To begin with, it assumes
-all the symbols, their values and associated function definitions, and
-any data presently on the stack, are accessible. Any objects that can
-be reached indirectly through other accessible objects are also
-accessible.
+@cindex garbage collection
+ It is quite common to use some storage for a while, then release it
+by (for example) killing a buffer or deleting the last pointer to an
+object. Emacs provides a @dfn{garbage collector} to reclaim this
+abandoned storage. The garbage collector operates by finding and
+marking all Lisp objects that are still accessible to Lisp programs.
+To begin with, it assumes all the symbols, their values and associated
+function definitions, and any data presently on the stack, are
+accessible. Any objects that can be reached indirectly through other
+accessible objects are also accessible.
When marking is finished, all objects still unmarked are garbage. No
matter what the Lisp program or the user does, it is impossible to refer
@@ -244,8 +255,12 @@ might as well be reused, since no one will miss them. The second
The sweep phase puts unused cons cells onto a @dfn{free list}
for future allocation; likewise for symbols and markers. It compacts
the accessible strings so they occupy fewer 8k blocks; then it frees the
-other 8k blocks. Vectors, buffers, windows, and other large objects are
-individually allocated and freed using @code{malloc} and @code{free}.
+other 8k blocks. Unreachable vectors from vector blocks are coalesced
+to create largest possible free areas; if a free area spans a complete
+4k block, that block is freed. Otherwise, the free area is recorded
+in a free list array, where each entry corresponds to a free list
+of areas of the same size. Large vectors, buffers, and other large
+objects are allocated and freed individually.
@cindex CL note---allocate more storage
@quotation
@@ -268,101 +283,158 @@ the amount of space in use. (Garbage collection can also occur
spontaneously if you use more than @code{gc-cons-threshold} bytes of
Lisp data since the previous garbage collection.)
-@code{garbage-collect} returns a list containing the following
-information:
+@code{garbage-collect} returns a list with information on amount of space in
+use, where each entry has the form @samp{(@var{name} @var{size} @var{used})}
+or @samp{(@var{name} @var{size} @var{used} @var{free})}. In the entry,
+@var{name} is a symbol describing the kind of objects this entry represents,
+@var{size} is the number of bytes used by each one, @var{used} is the number
+of those objects that were found live in the heap, and optional @var{free} is
+the number of those objects that are not live but that Emacs keeps around for
+future allocations. So an overall result is:
@example
-@group
-((@var{used-conses} . @var{free-conses})
- (@var{used-syms} . @var{free-syms})
-@end group
- (@var{used-miscs} . @var{free-miscs})
- @var{used-string-chars}
- @var{used-vector-slots}
- (@var{used-floats} . @var{free-floats})
- (@var{used-intervals} . @var{free-intervals})
- (@var{used-strings} . @var{free-strings}))
+((@code{conses} @var{cons-size} @var{used-conse} @var{free-conses})
+ (@code{symbols} @var{symbol-size} @var{used-symbols} @var{free-symbols})
+ (@code{miscs} @var{misc-size} @var{used-miscs} @var{free-miscs})
+ (@code{strings} @var{string-size} @var{used-strings} @var{free-strings})
+ (@code{string-bytes} @var{byte-size} @var{used-bytes})
+ (@code{vectors} @var{vector-size} @var{used-vectors})
+ (@code{vector-slots} @var{slot-size} @var{used-slots} @var{free-slots})
+ (@code{floats} @var{float-size} @var{used-floats} @var{free-floats})
+ (@code{intervals} @var{interval-size} @var{used-intervals} @var{free-intervals})
+ (@code{buffers} @var{buffer-size} @var{used-buffers})
+ (@code{heap} @var{unit-size} @var{total-size} @var{free-size}))
@end example
Here is an example:
@example
-@group
(garbage-collect)
- @result{} ((106886 . 13184) (9769 . 0)
- (7731 . 4651) 347543 121628
- (31 . 94) (1273 . 168)
- (25474 . 3569))
-@end group
+ @result{} ((conses 16 49126 8058) (symbols 48 14607 0)
+ (miscs 40 34 56) (strings 32 2942 2607)
+ (string-bytes 1 78607) (vectors 16 7247)
+ (vector-slots 8 341609 29474) (floats 8 71 102)
+ (intervals 56 27 26) (buffers 944 8)
+ (heap 1024 11715 2678))
@end example
-Here is a table explaining each element:
+Below is a table explaining each element. Note that last @code{heap} entry
+is optional and present only if an underlying @code{malloc} implementation
+provides @code{mallinfo} function.
@table @var
+@item cons-size
+Internal size of a cons cell, i.e.@: @code{sizeof (struct Lisp_Cons)}.
+
@item used-conses
The number of cons cells in use.
@item free-conses
-The number of cons cells for which space has been obtained from the
-operating system, but that are not currently being used.
+The number of cons cells for which space has been obtained from
+the operating system, but that are not currently being used.
+
+@item symbol-size
+Internal size of a symbol, i.e.@: @code{sizeof (struct Lisp_Symbol)}.
-@item used-syms
+@item used-symbols
The number of symbols in use.
-@item free-syms
-The number of symbols for which space has been obtained from the
-operating system, but that are not currently being used.
+@item free-symbols
+The number of symbols for which space has been obtained from
+the operating system, but that are not currently being used.
+
+@item misc-size
+Internal size of a miscellaneous entity, i.e.@:
+@code{sizeof (union Lisp_Misc)}, which is a size of the
+largest type enumerated in @code{enum Lisp_Misc_Type}.
@item used-miscs
-The number of miscellaneous objects in use. These include markers and
-overlays, plus certain objects not visible to users.
+The number of miscellaneous objects in use. These include markers
+and overlays, plus certain objects not visible to users.
@item free-miscs
The number of miscellaneous objects for which space has been obtained
from the operating system, but that are not currently being used.
-@item used-string-chars
-The total size of all strings, in characters.
+@item string-size
+Internal size of a string header, i.e.@: @code{sizeof (struct Lisp_String)}.
-@item used-vector-slots
-The total number of elements of existing vectors.
+@item used-strings
+The number of string headers in use.
+
+@item free-strings
+The number of string headers for which space has been obtained
+from the operating system, but that are not currently being used.
+
+@item byte-size
+This is used for convenience and equals to @code{sizeof (char)}.
+
+@item used-bytes
+The total size of all string data in bytes.
+
+@item vector-size
+Internal size of a vector header, i.e.@: @code{sizeof (struct Lisp_Vector)}.
+
+@item used-vectors
+The number of vector headers allocated from the vector blocks.
+
+@item slot-size
+Internal size of a vector slot, always equal to @code{sizeof (Lisp_Object)}.
+
+@item used-slots
+The number of slots in all used vectors.
+
+@item free-slots
+The number of free slots in all vector blocks.
+
+@item float-size
+Internal size of a float object, i.e.@: @code{sizeof (struct Lisp_Float)}.
+(Do not confuse it with the native platform @code{float} or @code{double}.)
@item used-floats
-@c Emacs 19 feature
The number of floats in use.
@item free-floats
-@c Emacs 19 feature
-The number of floats for which space has been obtained from the
-operating system, but that are not currently being used.
+The number of floats for which space has been obtained from
+the operating system, but that are not currently being used.
+
+@item interval-size
+Internal size of an interval object, i.e.@: @code{sizeof (struct interval)}.
@item used-intervals
-The number of intervals in use. Intervals are an internal
-data structure used for representing text properties.
+The number of intervals in use.
@item free-intervals
-The number of intervals for which space has been obtained
-from the operating system, but that are not currently being used.
+The number of intervals for which space has been obtained from
+the operating system, but that are not currently being used.
-@item used-strings
-The number of strings in use.
+@item buffer-size
+Internal size of a buffer, i.e.@: @code{sizeof (struct buffer)}.
+(Do not confuse with the value returned by @code{buffer-size} function.)
-@item free-strings
-The number of string headers for which the space was obtained from the
-operating system, but which are currently not in use. (A string
-object consists of a header and the storage for the string text
-itself; the latter is only allocated when the string is created.)
+@item used-buffers
+The number of buffer objects in use. This includes killed buffers
+invisible to users, i.e.@: all buffers in @code{all_buffers} list.
+
+@item unit-size
+The unit of heap space measurement, always equal to 1024 bytes.
+
+@item total-size
+Total heap size, in @var{unit-size} units.
+
+@item free-size
+Heap space which is not currently used, in @var{unit-size} units.
@end table
-If there was overflow in pure space (see the previous section),
+If there was overflow in pure space (@pxref{Pure Storage}),
@code{garbage-collect} returns @code{nil}, because a real garbage
-collection can not be done in this situation.
+collection cannot be done.
@end deffn
@defopt garbage-collection-messages
If this variable is non-@code{nil}, Emacs displays a message at the
beginning and end of garbage collection. The default value is
-@code{nil}, meaning there are no such messages.
+@code{nil}.
@end defopt
@defvar post-gc-hook
@@ -374,23 +446,25 @@ careful writing them.
@defopt gc-cons-threshold
The value of this variable is the number of bytes of storage that must
be allocated for Lisp objects after one garbage collection in order to
-trigger another garbage collection. A cons cell counts as eight bytes,
-a string as one byte per character plus a few bytes of overhead, and so
-on; space allocated to the contents of buffers does not count. Note
-that the subsequent garbage collection does not happen immediately when
-the threshold is exhausted, but only the next time the Lisp evaluator is
-called.
-
-The initial threshold value is 400,000. If you specify a larger
-value, garbage collection will happen less often. This reduces the
-amount of time spent garbage collecting, but increases total memory use.
-You may want to do this when running a program that creates lots of
-Lisp data.
-
-You can make collections more frequent by specifying a smaller value,
-down to 10,000. A value less than 10,000 will remain in effect only
-until the subsequent garbage collection, at which time
-@code{garbage-collect} will set the threshold back to 10,000.
+trigger another garbage collection. You can use the result returned by
+@code{garbage-collect} to get an information about size of the particular
+object type; space allocated to the contents of buffers does not count.
+Note that the subsequent garbage collection does not happen immediately
+when the threshold is exhausted, but only the next time the Lisp interpreter
+is called.
+
+The initial threshold value is @code{GC_DEFAULT_THRESHOLD}, defined in
+@file{alloc.c}. Since it's defined in @code{word_size} units, the value
+is 400,000 for the default 32-bit configuration and 800,000 for the 64-bit
+one. If you specify a larger value, garbage collection will happen less
+often. This reduces the amount of time spent garbage collecting, but
+increases total memory use. You may want to do this when running a program
+that creates lots of Lisp data.
+
+You can make collections more frequent by specifying a smaller value, down
+to 1/10th of @code{GC_DEFAULT_THRESHOLD}. A value less than this minimum
+will remain in effect only until the subsequent garbage collection, at which
+time @code{garbage-collect} will set the threshold back to the minimum.
@end defopt
@defopt gc-cons-percentage
@@ -409,7 +483,6 @@ memory used by Lisp data, broken down by data type. By contrast, the
function @code{memory-limit} provides information on the total amount of
memory Emacs is currently using.
-@c Emacs 19 feature
@defun memory-limit
This function returns the address of the last byte Emacs has allocated,
divided by 1024. We divide the value by 1024 to make sure it fits in a
@@ -420,7 +493,7 @@ memory usage.
@end defun
@defvar memory-full
-This variable is @code{t} if Emacs is close to out of memory for Lisp
+This variable is @code{t} if Emacs is nearly out of memory for Lisp
objects, and @code{nil} otherwise.
@end defvar
@@ -448,7 +521,7 @@ point number.
These functions and variables give information about the total amount
of memory allocation that Emacs has done, broken down by data type.
Note the difference between these and the values returned by
-@code{(garbage-collect)}; those count objects that currently exist, but
+@code{garbage-collect}; those count objects that currently exist, but
these count the number or size of all allocations, including those for
objects that have since been freed.
@@ -474,12 +547,12 @@ in this Emacs session.
@defvar string-chars-consed
The total number of string characters that have been allocated so far
-in this Emacs session.
+in this session.
@end defvar
@defvar misc-objects-consed
The total number of miscellaneous objects that have been allocated so
-far in this Emacs session. These include markers and overlays, plus
+far in this session. These include markers and overlays, plus
certain objects not visible to users.
@end defvar
@@ -494,7 +567,7 @@ Emacs session.
@end defvar
@node Writing Emacs Primitives
-@appendixsec Writing Emacs Primitives
+@section Writing Emacs Primitives
@cindex primitive function internals
@cindex writing Emacs primitives
@@ -511,8 +584,9 @@ appearance.)
@smallexample
@group
DEFUN ("or", For, Sor, 0, UNEVALLED, 0,
- doc: /* Eval args until one of them yields non-nil, then return that
-value. The remaining args are not evalled at all.
+ doc: /* Eval args until one of them yields non-nil, then return
+that value.
+The remaining args are not evalled at all.
If all args return nil, return nil.
@end group
@group
@@ -530,7 +604,7 @@ usage: (or CONDITIONS ...) */)
@group
while (CONSP (args))
@{
- val = Feval (XCAR (args));
+ val = eval_sub (XCAR (args));
if (!NILP (val))
break;
args = XCDR (args);
@@ -558,14 +632,11 @@ This is the name of the Lisp symbol to define as the function name; in
the example above, it is @code{or}.
@item fname
-This is the C function name for this function. This is
-the name that is used in C code for calling the function. The name is,
-by convention, @samp{F} prepended to the Lisp name, with all dashes
-(@samp{-}) in the Lisp name changed to underscores. Thus, to call this
-function from C code, call @code{For}. Remember that the arguments must
-be of type @code{Lisp_Object}; various macros and functions for creating
-values of type @code{Lisp_Object} are declared in the file
-@file{lisp.h}.
+This is the C function name for this function. This is the name that
+is used in C code for calling the function. The name is, by
+convention, @samp{F} prepended to the Lisp name, with all dashes
+(@samp{-}) in the Lisp name changed to underscores. Thus, to call
+this function from C code, call @code{For}.
@item sname
This is a C variable name to use for a structure that holds the data for
@@ -585,8 +656,8 @@ there is a fixed maximum. Alternatively, it can be @code{UNEVALLED},
indicating a special form that receives unevaluated arguments, or
@code{MANY}, indicating an unlimited number of evaluated arguments (the
equivalent of @code{&rest}). Both @code{UNEVALLED} and @code{MANY} are
-macros. If @var{max} is a number, it may not be less than @var{min} and
-it may not be greater than eight.
+macros. If @var{max} is a number, it must be more than @var{min} but
+less than 8.
@item interactive
This is an interactive specification, a string such as might be used as
@@ -595,6 +666,8 @@ the argument of @code{interactive} in a Lisp function. In the case of
called interactively. A value of @code{""} indicates a function that
should receive no arguments when called interactively. If the value
begins with a @samp{(}, the string is evaluated as a Lisp form.
+For examples of the last two forms, see @code{widen} and
+@code{narrow-to-region} in @file{editfns.c}.
@item doc
This is the documentation string. It uses C comment syntax rather
@@ -617,35 +690,40 @@ too.
@end table
After the call to the @code{DEFUN} macro, you must write the
-argument list that every C function must have, including the types for
-the arguments. For a function with a fixed maximum number of
-arguments, declare a C argument for each Lisp argument, and give them
-all type @code{Lisp_Object}. When a Lisp function has no upper limit
-on the number of arguments, its implementation in C actually receives
-exactly two arguments: the first is the number of Lisp arguments, and
-the second is the address of a block containing their values. They
-have types @code{int} and @w{@code{Lisp_Object *}}.
+argument list for the C function, including the types for the
+arguments. If the primitive accepts a fixed maximum number of Lisp
+arguments, there must be one C argument for each Lisp argument, and
+each argument must be of type @code{Lisp_Object}. (Various macros and
+functions for creating values of type @code{Lisp_Object} are declared
+in the file @file{lisp.h}.) If the primitive has no upper limit on
+the number of Lisp arguments, it must have exactly two C arguments:
+the first is the number of Lisp arguments, and the second is the
+address of a block containing their values. These have types
+@code{int} and @w{@code{Lisp_Object *}} respectively. Since
+@code{Lisp_Object} can hold any Lisp object of any data type, you
+can determine the actual data type only at run time; so if you want
+a primitive to accept only a certain type of argument, you must check
+the type explicitly using a suitable predicate (@pxref{Type Predicates}).
+@cindex type checking internals
@cindex @code{GCPRO} and @code{UNGCPRO}
@cindex protect C variables from garbage collection
Within the function @code{For} itself, note the use of the macros
-@code{GCPRO1} and @code{UNGCPRO}. @code{GCPRO1} is used to
-``protect'' a variable from garbage collection---to inform the garbage
-collector that it must look in that variable and regard its contents
-as an accessible object. GC protection is necessary whenever you call
-@code{Feval} or anything that can directly or indirectly call
-@code{Feval}. At such a time, any Lisp object that this function may
-refer to again must be protected somehow.
+@code{GCPRO1} and @code{UNGCPRO}. These macros are defined for the
+sake of the few platforms which do not use Emacs' default
+stack-marking garbage collector. The @code{GCPRO1} macro ``protects''
+a variable from garbage collection, explicitly informing the garbage
+collector that that variable and all its contents must be as
+accessible. GC protection is necessary in any function which can
+perform Lisp evaluation by calling @code{eval_sub} or @code{Feval} as
+a subroutine, either directly or indirectly.
It suffices to ensure that at least one pointer to each object is
-GC-protected; that way, the object cannot be recycled, so all pointers
-to it remain valid. Thus, a particular local variable can do without
+GC-protected. Thus, a particular local variable can do without
protection if it is certain that the object it points to will be
-preserved by some other pointer (such as another local variable which
-has a @code{GCPRO})@footnote{Formerly, strings were a special
-exception; in older Emacs versions, every local variable that might
-point to a string needed a @code{GCPRO}.}. Otherwise, the local
-variable needs a @code{GCPRO}.
+preserved by some other pointer (such as another local variable that
+has a @code{GCPRO}). Otherwise, the local variable needs a
+@code{GCPRO}.
The macro @code{GCPRO1} protects just one local variable. If you
want to protect two variables, use @code{GCPRO2} instead; repeating
@@ -654,33 +732,17 @@ want to protect two variables, use @code{GCPRO2} instead; repeating
implicitly use local variables such as @code{gcpro1}; you must declare
these explicitly, with type @code{struct gcpro}. Thus, if you use
@code{GCPRO2}, you must declare @code{gcpro1} and @code{gcpro2}.
-Alas, we can't explain all the tricky details here.
@code{UNGCPRO} cancels the protection of the variables that are
protected in the current function. It is necessary to do this
explicitly.
- Built-in functions that take a variable number of arguments actually
-accept two arguments at the C level: the number of Lisp arguments, and
-a @code{Lisp_Object *} pointer to a C vector containing those Lisp
-arguments. This C vector may be part of a Lisp vector, but it need
-not be. The responsibility for using @code{GCPRO} to protect the Lisp
-arguments from GC if necessary rests with the caller in this case,
-since the caller allocated or found the storage for them.
-
You must not use C initializers for static or global variables unless
the variables are never written once Emacs is dumped. These variables
with initializers are allocated in an area of memory that becomes
read-only (on certain operating systems) as a result of dumping Emacs.
@xref{Pure Storage}.
- Do not use static variables within functions---place all static
-variables at top level in the file. This is necessary because Emacs on
-some operating systems defines the keyword @code{static} as a null
-macro. (This definition is used because those systems put all variables
-declared static in a place that becomes read-only after dumping, whether
-they have initializers or not.)
-
@cindex @code{defsubr}, Lisp symbol for a primitive
Defining the C function is not enough to make a Lisp primitive
available; you must also create the Lisp symbol for the primitive and
@@ -688,12 +750,11 @@ store a suitable subr object in its function cell. The code looks like
this:
@example
-defsubr (&@var{subr-structure-name});
+defsubr (&@var{sname});
@end example
@noindent
-Here @var{subr-structure-name} is the name you used as the third
-argument to @code{DEFUN}.
+Here @var{sname} is the name you used as the third argument to @code{DEFUN}.
If you add a new primitive to a file that already has Lisp primitives
defined in it, find the function (near the end of the file) named
@@ -718,6 +779,11 @@ with a value that is either @code{t} or @code{nil}. Note that variables
defined with @code{DEFVAR_BOOL} are automatically added to the list
@code{byte-boolean-vars} used by the byte compiler.
+@cindex defining customization variables in C
+ If you want to make a Lisp variables that is defined in C behave
+like one declared with @code{defcustom}, add an appropriate entry to
+@file{cus-start.el}.
+
@cindex @code{staticpro}, protection from GC
If you define a file-scope C variable of type @code{Lisp_Object},
you must protect it from garbage-collection by calling @code{staticpro}
@@ -734,48 +800,53 @@ of macros and functions to manipulate Lisp objects.
@smallexample
@group
DEFUN ("coordinates-in-window-p", Fcoordinates_in_window_p,
- Scoordinates_in_window_p, 2, 2,
- "xSpecify coordinate pair: \nXExpression which evals to window: ",
- "Return non-nil if COORDINATES is in WINDOW.\n\
-COORDINATES is a cons of the form (X . Y), X and Y being distances\n\
-...
+ Scoordinates_in_window_p, 2, 2, 0,
+ doc: /* Return non-nil if COORDINATES are in WINDOW.
+ ...
@end group
@group
-If they are on the border between WINDOW and its right sibling,\n\
- `vertical-line' is returned.")
- (coordinates, window)
- register Lisp_Object coordinates, window;
+ or `right-margin' is returned. */)
+ (register Lisp_Object coordinates, Lisp_Object window)
@{
+ struct window *w;
+ struct frame *f;
int x, y;
+ Lisp_Object lx, ly;
@end group
@group
- CHECK_LIVE_WINDOW (window, 0);
- CHECK_CONS (coordinates, 1);
- x = XINT (Fcar (coordinates));
- y = XINT (Fcdr (coordinates));
+ CHECK_LIVE_WINDOW (window);
+ w = XWINDOW (window);
+ f = XFRAME (w->frame);
+ CHECK_CONS (coordinates);
+ lx = Fcar (coordinates);
+ ly = Fcdr (coordinates);
+ CHECK_NUMBER_OR_FLOAT (lx);
+ CHECK_NUMBER_OR_FLOAT (ly);
+ x = FRAME_PIXEL_X_FROM_CANON_X (f, lx) + FRAME_INTERNAL_BORDER_WIDTH(f);
+ y = FRAME_PIXEL_Y_FROM_CANON_Y (f, ly) + FRAME_INTERNAL_BORDER_WIDTH(f);
@end group
@group
- switch (coordinates_in_window (XWINDOW (window), &x, &y))
+ switch (coordinates_in_window (w, x, y))
@{
- case 0: /* NOT in window at all. */
+ case ON_NOTHING: /* NOT in window at all. */
return Qnil;
@end group
-@group
- case 1: /* In text part of window. */
- return Fcons (make_number (x), make_number (y));
-@end group
+ ...
@group
- case 2: /* In mode line of window. */
+ case ON_MODE_LINE: /* In mode line of window. */
return Qmode_line;
@end group
+ ...
+
@group
- case 3: /* On right border of window. */
- return Qvertical_line;
+ case ON_SCROLL_BAR: /* On scroll-bar of window. */
+ /* Historically we are supposed to return nil in this case. */
+ return Qnil;
@end group
@group
@@ -806,30 +877,78 @@ number of arguments. They work by calling @code{Ffuncall}.
functions.
If you define a function which is side-effect free, update the code
-in @file{byte-opt.el} which binds @code{side-effect-free-fns} and
+in @file{byte-opt.el} that binds @code{side-effect-free-fns} and
@code{side-effect-and-error-free-fns} so that the compiler optimizer
knows about it.
@node Object Internals
-@appendixsec Object Internals
+@section Object Internals
@cindex object internals
- GNU Emacs Lisp manipulates many different types of data. The actual
-data are stored in a heap and the only access that programs have to it
-is through pointers. Each pointer is 32 bits wide on 32-bit machines,
-and 64 bits wide on 64-bit machines; three of these bits are used for
-the tag that identifies the object's type, and the remainder are used
-to address the object.
-
- Because Lisp objects are represented as tagged pointers, it is always
-possible to determine the Lisp data type of any object. The C data type
-@code{Lisp_Object} can hold any Lisp object of any data type. Ordinary
-variables have type @code{Lisp_Object}, which means they can hold any
-type of Lisp value; you can determine the actual data type only at run
-time. The same is true for function arguments; if you want a function
-to accept only a certain type of argument, you must check the type
-explicitly using a suitable predicate (@pxref{Type Predicates}).
-@cindex type checking internals
+ Emacs Lisp provides a rich set of the data types. Some of them, like cons
+cells, integers and stirngs, are common to nearly all Lisp dialects. Some
+others, like markers and buffers, are quite special and needed to provide
+the basic support to write editor commands in Lisp. To implement such
+a variety of object types and provide an efficient way to pass objects between
+the subsystems of an interpreter, there is a set of C data structures and
+a special type to represent the pointers to all of them, which is known as
+@dfn{tagged pointer}.
+
+ In C, the tagged pointer is an object of type @code{Lisp_Object}. Any
+initialized variable of such a type always holds the value of one of the
+following basic data types: integer, symbol, string, cons cell, float,
+vectorlike or miscellaneous object. Each of these data types has the
+corresponding tag value. All tags are enumerated by @code{enum Lisp_Type}
+and placed into a 3-bit bitfield of the @code{Lisp_Object}. The rest of the
+bits is the value itself. Integer values are immediate, i.e.@: directly
+represented by those @dfn{value bits}, and all other objects are represented
+by the C pointers to a corresponding object allocated from the heap. Width
+of the @code{Lisp_Object} is platform- and configuration-dependent: usually
+it's equal to the width of an underlying platform pointer (i.e.@: 32-bit on
+a 32-bit machine and 64-bit on a 64-bit one), but also there is a special
+configuration where @code{Lisp_Object} is 64-bit but all pointers are 32-bit.
+The latter trick was designed to overcome the limited range of values for
+Lisp integers on a 32-bit system by using 64-bit @code{long long} type for
+@code{Lisp_Object}.
+
+ The following C data structures are defined in @file{lisp.h} to represent
+the basic data types beyond integers:
+
+@table @code
+@item struct Lisp_Cons
+Cons cell, an object used to construct lists.
+
+@item struct Lisp_String
+String, the basic object to represent a sequence of characters.
+
+@item struct Lisp_Vector
+Array, a fixed-size set of Lisp objects which may be accessed by an index.
+
+@item struct Lisp_Symbol
+Symbol, the unique-named entity commonly used as an identifier.
+
+@item struct Lisp_Float
+Floating point value.
+
+@item union Lisp_Misc
+Miscellaneous kinds of objects which don't fit into any of the above.
+@end table
+
+ These types are the first-class citizens of an internal type system.
+Since the tag space is limited, all other types are the subtypes of either
+@code{Lisp_Vectorlike} or @code{Lisp_Misc}. Vector subtypes are enumerated
+by @code{enum pvec_type}, and nearly all complex objects like windows, buffers,
+frames, and processes fall into this category. The rest of special types,
+including markers and overlays, are enumerated by @code{enum Lisp_Misc_Type}
+and form the set of subtypes of @code{Lisp_Misc}.
+
+ Below there is a description of a few subtypes of @code{Lisp_Vectorlike}.
+Buffer object represents the text to display and edit. Window is the part
+of display structure which shows the buffer or used as a container to
+recursively place other windows on the same frame. (Do not confuse Emacs Lisp
+window object with the window as an entity managed by the user interface
+system like X; in Emacs terminology, the latter is called frame.) Finally,
+process object is used to manage the subprocesses.
@menu
* Buffer Internals:: Components of a buffer structure.
@@ -838,15 +957,15 @@ explicitly using a suitable predicate (@pxref{Type Predicates}).
@end menu
@node Buffer Internals
-@appendixsubsec Buffer Internals
+@subsection Buffer Internals
@cindex internals, of buffer
@cindex buffer internals
- Two structures are used to represent buffers in C. The
-@code{buffer_text} structure contains fields describing the text of a
-buffer; the @code{buffer} structure holds other fields. In the case
-of indirect buffers, two or more @code{buffer} structures reference
-the same @code{buffer_text} structure.
+ Two structures (see @file{buffer.h}) are used to represent buffers
+in C. The @code{buffer_text} structure contains fields describing the
+text of a buffer; the @code{buffer} structure holds other fields. In
+the case of indirect buffers, two or more @code{buffer} structures
+reference the same @code{buffer_text} structure.
Here are some of the fields in @code{struct buffer_text}:
@@ -904,12 +1023,9 @@ The interval tree which records the text properties of this buffer.
Some of the fields of @code{struct buffer} are:
@table @code
-@item next
-Points to the next buffer, in the chain of all buffers (including
-killed buffers). This chain is used only for garbage collection, in
-order to collect killed buffers properly. Note that vectors, and most
-kinds of objects allocated as vectors, are all on one chain, but
-buffers are on a separate chain of their own.
+@item header
+A header of type @code{struct vectorlike_header} is common to all
+vectorlike objects.
@item own_text
A @code{struct buffer_text} structure that ordinarily holds the buffer
@@ -920,6 +1036,11 @@ A pointer to the @code{buffer_text} structure for this buffer. In an
ordinary buffer, this is the @code{own_text} field above. In an
indirect buffer, this is the @code{own_text} field of the base buffer.
+@item next
+A pointer to the next buffer, in the chain of all buffers, including
+killed buffers. This chain is used only for allocation and garbage
+collection, in order to collect killed buffers properly.
+
@item pt
@itemx pt_byte
The character and byte positions of point in a buffer.
@@ -979,6 +1100,8 @@ after the current overlay center. @xref{Managing Overlays}.
and @code{overlays_after} is sorted in order of increasing beginning
position.
+@c FIXME? the following are now all Lisp_Object BUFFER_INTERNAL_FIELD (foo).
+
@item name
A Lisp string that names the buffer. It is guaranteed to be unique.
@xref{Buffer Names}.
@@ -1001,6 +1124,7 @@ the value of the buffer-local variable @code{buffer-file-name}
@item undo_list
@itemx backed_up
@itemx auto_save_file_name
+@itemx auto_save_file_format
@itemx read_only
@itemx file_format
@itemx file_truename
@@ -1011,8 +1135,7 @@ These fields store the values of Lisp variables that are automatically
buffer-local (@pxref{Buffer-Local Variables}), whose corresponding
variable names have the additional prefix @code{buffer-} and have
underscores replaced with dashes. For instance, @code{undo_list}
-stores the value of @code{buffer-undo-list}. @xref{Standard
-Buffer-Local Variables}.
+stores the value of @code{buffer-undo-list}.
@item mark
The mark for the buffer. The mark is a marker, hence it is also
@@ -1068,15 +1191,15 @@ when the buffer is not current.
@itemx truncate_lines
@itemx word_wrap
@itemx ctl_arrow
+@itemx bidi_display_reordering
+@itemx bidi_paragraph_direction
@itemx selective_display
@itemx selective_display_ellipses
@itemx overwrite_mode
@itemx abbrev_mode
-@itemx display_table
@itemx mark_active
@itemx enable_multibyte_characters
@itemx buffer_file_coding_system
-@itemx auto_save_file_format
@itemx cache_long_line_scans
@itemx point_before_scroll
@itemx left_fringe_width
@@ -1095,7 +1218,6 @@ These fields store the values of Lisp variables that are automatically
buffer-local (@pxref{Buffer-Local Variables}), whose corresponding
variable names have underscores replaced with dashes. For instance,
@code{mode_line_format} stores the value of @code{mode-line-format}.
-@xref{Standard Buffer-Local Variables}.
@item last_selected_window
This is the last window that was selected with this buffer in it, or @code{nil}
@@ -1103,11 +1225,12 @@ if that window no longer displays this buffer.
@end table
@node Window Internals
-@appendixsubsec Window Internals
+@subsection Window Internals
@cindex internals, of window
@cindex window internals
- Windows have the following accessible fields:
+ The fields of a window (for a complete list, see the definition of
+@code{struct window} in @file{window.h}) include:
@table @code
@item frame
@@ -1131,13 +1254,14 @@ leaves of the tree, which actually display buffers.
These fields contain the window's leftmost child and its topmost child
respectively. @code{hchild} is used if the window is subdivided
horizontally by child windows, and @code{vchild} if it is subdivided
-vertically.
+vertically. In a live window, only one of @code{hchild}, @code{vchild},
+and @code{buffer} (q.v.) is non-@code{nil}.
@item next
@itemx prev
The next sibling and previous sibling of this window. @code{next} is
-@code{nil} if the window is the rightmost or bottommost in its group;
-@code{prev} is @code{nil} if it is the leftmost or topmost in its
+@code{nil} if the window is the right-most or bottom-most in its group;
+@code{prev} is @code{nil} if it is the left-most or top-most in its
group.
@item left_col
@@ -1208,11 +1332,19 @@ window was last updated.
@item vertical_scroll_bar
This window's vertical scroll bar.
-@item left_margin_width
-@itemx right_margin_width
+@item left_margin_cols
+@itemx right_margin_cols
The widths of the left and right margins in this window. A value of
-@code{nil} means to use the buffer's value of @code{left-margin-width}
-or @code{right-margin-width}.
+@code{nil} means no margin.
+
+@item left_fringe_width
+@itemx right_fringe_width
+The widths of the left and right fringes in this window. A value of
+@code{nil} or @code{t} means use the values of the frame.
+
+@item fringes_outside_margins
+A non-@code{nil} value means the fringes outside the display margins;
+othersize they are between the margin and the text.
@item window_end_pos
This is computed as @code{z} minus the buffer position of the last glyph
@@ -1228,7 +1360,7 @@ The window-relative vertical position of the line containing
@item window_end_valid
This field is set to a non-@code{nil} value if @code{window_end_pos} is truly
-valid. This is @code{nil} if nontrivial redisplay is preempted since in that
+valid. This is @code{nil} if nontrivial redisplay is pre-empted, since in that
case the display that @code{window_end_pos} was computed for did not get
onto the screen.
@@ -1242,13 +1374,19 @@ The value of @code{cursor} as of the last redisplay that finished.
A structure describing where the cursor of this window physically is.
@item phys_cursor_type
-The type of cursor that was last displayed on this window.
+@c FIXME What is this?
+@c itemx phys_cursor_ascent
+@itemx phys_cursor_height
+@itemx phys_cursor_width
+The type, height, and width of the cursor that was last displayed on
+this window.
@item phys_cursor_on_p
This field is non-zero if the cursor is physically on.
@item cursor_off_p
-Non-zero means the cursor in this window is logically on.
+Non-zero means the cursor in this window is logically off. This is
+used for blinking the cursor.
@item last_cursor_off_p
This field contains the value of @code{cursor_off_p} as of the time of
@@ -1279,7 +1417,8 @@ This is used for displaying the line number of point in the mode line.
@item base_line_pos
The position in the buffer for which the line number is known, or
-@code{nil} meaning none is known.
+@code{nil} meaning none is known. If it is a buffer, don't display
+the line number as long as the window shows that buffer.
@item region_showing
If the region (or part of it) is highlighted in this window, this field
@@ -1291,18 +1430,17 @@ The column number currently displayed in this window's mode line, or @code{nil}
if column numbers are not being displayed.
@item current_matrix
-A glyph matrix describing the current display of this window.
-
-@item desired_matrix
-A glyph matrix describing the desired display of this window.
+@itemx desired_matrix
+Glyph matrices describing the current and desired display of this window.
@end table
@node Process Internals
-@appendixsubsec Process Internals
+@subsection Process Internals
@cindex internals, of process
@cindex process internals
- The fields of a process are:
+ The fields of a process (for a complete list, see the definition of
+@code{struct Lisp_Process} in @file{process.h}) include:
@table @code
@item name
@@ -1314,21 +1452,24 @@ process. For a network or serial process, it is @code{nil} if the
process is running or @code{t} if the process is stopped.
@item filter
-A function used to accept output from the process instead of a buffer,
-or @code{nil}.
+If non-@code{nil}, a function used to accept output from the process
+instead of a buffer.
@item sentinel
-A function called whenever the process receives a signal, or @code{nil}.
+If non-@code{nil}, a function called whenever the state of the process
+changes.
@item buffer
The associated buffer of the process.
@item pid
An integer, the operating system's process @acronym{ID}.
+Pseudo-processes such as network or serial connections use a value of 0.
@item childp
-A flag, non-@code{nil} if this is really a child process.
-It is @code{nil} for a network or serial connection.
+A flag, @code{t} if this is really a child process. For a network or
+serial connection, it is a plist based on the arguments to
+@code{make-network-process} or @code{make-serial-process}.
@item mark
A marker indicating the position of the end of the last output from this
@@ -1339,10 +1480,8 @@ of the buffer.
If this is non-zero, killing Emacs while this process is still running
does not ask for confirmation about killing the process.
-@item raw_status_low
-@itemx raw_status_high
-These two fields record 16 bits each of the process status returned by
-the @code{wait} system call.
+@item raw_status
+The raw process status, as returned by the @code{wait} system call.
@item status
The process status, as @code{process-status} should return it.
@@ -1354,7 +1493,7 @@ needs to be reported, either by running the sentinel or by inserting a
message in the process buffer.
@item pty_flag
-Non-@code{nil} if communication with the subprocess uses a @acronym{PTY};
+Non-@code{nil} if communication with the subprocess uses a pty;
@code{nil} if it uses a pipe.
@item infd
@@ -1363,11 +1502,6 @@ The file descriptor for input from the process.
@item outfd
The file descriptor for output to the process.
-@item subtty
-The file descriptor for the terminal that the subprocess is using. (On
-some systems, there is no need to record this, so the value is
-@code{nil}.)
-
@item tty_name
The name of the terminal that the subprocess is using,
or @code{nil} if it is using pipes.
@@ -1387,15 +1521,14 @@ Coding-system for encoding the output to this process.
@item encoding_buf
A working buffer for encoding.
-@item encoding_carryover
-Size of carryover in encoding.
-
@item inherit_coding_system_flag
Flag to set @code{coding-system} of the process buffer from the
coding system used to decode process output.
@item type
Symbol indicating the type of process: @code{real}, @code{network},
-@code{serial}
+@code{serial}.
@end table
+
+@c FIXME Mention src/globals.h somewhere in this file?
diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi
index 44ac947fa99..4770701b601 100644
--- a/doc/lispref/intro.texi
+++ b/doc/lispref/intro.texi
@@ -1,11 +1,9 @@
@c -*-coding: iso-latin-1-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1994, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1994, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/intro
-@node Introduction, Lisp Data Types, Top, Top
-@comment node-name, next, previous, up
+@node Introduction
@chapter Introduction
Most of the GNU Emacs text editor is written in the programming
@@ -34,15 +32,19 @@ Lisp that have counterparts in many programming languages, and later
chapters describe features that are peculiar to Emacs Lisp or relate
specifically to editing.
- This is edition @value{VERSION} of the GNU Emacs Lisp Reference
-Manual, corresponding to Emacs version @value{EMACSVER}.
+ This is
+@iftex
+edition @value{VERSION} of
+@end iftex
+the @cite{GNU Emacs Lisp Reference Manual},
+corresponding to Emacs version @value{EMACSVER}.
@menu
* Caveats:: Flaws and a request for help.
* Lisp History:: Emacs Lisp is descended from Maclisp.
* Conventions:: How the manual is formatted.
* Version Info:: Which Emacs version is running?
-* Acknowledgements:: The authors, editors, and sponsors of this manual.
+* Acknowledgments:: The authors, editors, and sponsors of this manual.
@end menu
@node Caveats
@@ -70,7 +72,7 @@ real-life example for a function or group of functions, please make an
effort to write it up and send it in. Please reference any comments to
the chapter name, section name, and function name, as appropriate, since
page numbers and chapter and section numbers will change and we may have
-trouble finding the text you are talking about. Also state the number
+trouble finding the text you are talking about. Also state the version
of the edition you are criticizing.
@end iftex
@ifnottex
@@ -117,10 +119,10 @@ worry about it; this manual is self-contained.
@pindex cl
A certain amount of Common Lisp emulation is available via the
-@file{cl} library. @inforef{Top, Overview, cl}.
+@file{cl-lib} library. @xref{Top,, Overview, cl, Common Lisp Extensions}.
Emacs Lisp is not at all influenced by Scheme; but the GNU project has
-an implementation of Scheme, called Guile. We use Guile in all new GNU
+an implementation of Scheme, called Guile. We use it in all new GNU
software that calls for extensibility.
@node Conventions
@@ -147,7 +149,7 @@ printer'' refer to those routines in Lisp that convert textual
representations of Lisp objects into actual Lisp objects, and vice
versa. @xref{Printed Representation}, for more details. You, the
person reading this manual, are thought of as ``the programmer'' and are
-addressed as ``you.'' ``The user'' is the person who uses Lisp
+addressed as ``you''. ``The user'' is the person who uses Lisp
programs, including those you write.
@cindex typographic conventions
@@ -162,7 +164,7 @@ being described, are formatted like this: @var{first-number}.
@cindex @code{nil}
@cindex false
- In Lisp, the symbol @code{nil} has three separate meanings: it
+ In Emacs Lisp, the symbol @code{nil} has three separate meanings: it
is a symbol with the name @samp{nil}; it is the logical truth value
@var{false}; and it is the empty list---the list of zero elements.
When used as a variable, @code{nil} always has the value @code{nil}.
@@ -220,7 +222,7 @@ the examples in this manual, this is indicated with @samp{@result{}}:
@end example
@noindent
-You can read this as ``@code{(car '(1 2))} evaluates to 1.''
+You can read this as ``@code{(car '(1 2))} evaluates to 1''.
When a form is a macro call, it expands into a new form for Lisp to
evaluate. We show the result of the expansion with
@@ -233,7 +235,7 @@ evaluation of the expanded form.
@result{} c
@end example
- Sometimes to help describe one form we show another form that
+ To help describe one form, we sometimes show another form that
produces identical results. The exact equivalence of two forms is
indicated with @samp{@equiv{}}.
@@ -247,14 +249,14 @@ indicated with @samp{@equiv{}}.
Many of the examples in this manual print text when they are
evaluated. If you execute example code in a Lisp Interaction buffer
-(such as the buffer @samp{*scratch*}), the printed text is inserted into
+(such as the buffer @file{*scratch*}), the printed text is inserted into
the buffer. If you execute the example by other means (such as by
evaluating the function @code{eval-region}), the printed text is
displayed in the echo area.
Examples in this manual indicate printed text with @samp{@print{}},
irrespective of where that text goes. The value returned by
-evaluating the form (here @code{bar}) follows on a separate line with
+evaluating the form follows on a separate line with
@samp{@result{}}.
@example
@@ -349,7 +351,7 @@ you call the function.
The keyword @code{&rest} (which must be followed by a single
argument name) indicates that any number of arguments can follow. The
-single argument name following @code{&rest} will receive, as its
+single argument name following @code{&rest} receives, as its
value, a list of all the remaining arguments passed to the function.
Do not write @code{&rest} when you call the function.
@@ -377,32 +379,34 @@ More generally,
@end example
@end defun
- Any argument whose name contains the name of a type (e.g.,
-@var{integer}, @var{integer1} or @var{buffer}) is expected to be of that
-type. A plural of a type (such as @var{buffers}) often means a list of
-objects of that type. Arguments named @var{object} may be of any type.
-(@xref{Lisp Data Types}, for a list of Emacs object types.) Arguments
-with other sorts of names (e.g., @var{new-file}) are discussed
-specifically in the description of the function. In some sections,
-features common to the arguments of several functions are described at
-the beginning.
+ By convention, any argument whose name contains the name of a type
+(e.g.@: @var{integer}, @var{integer1} or @var{buffer}) is expected to
+be of that type. A plural of a type (such as @var{buffers}) often
+means a list of objects of that type. An argument named @var{object}
+may be of any type. (For a list of Emacs object types, @pxref{Lisp
+Data Types}.) An argument with any other sort of name
+(e.g.@: @var{new-file}) is specific to the function; if the function
+has a documentation string, the type of the argument should be
+described there (@pxref{Documentation}).
- @xref{Lambda Expressions}, for a more complete description of optional
-and rest arguments.
+ @xref{Lambda Expressions}, for a more complete description of
+arguments modified by @code{&optional} and @code{&rest}.
Command, macro, and special form descriptions have the same format,
-but the word `Function' is replaced by `Command', `Macro', or `Special
-Form', respectively. Commands are simply functions that may be called
-interactively; macros process their arguments differently from functions
-(the arguments are not evaluated), but are presented the same way.
-
- Special form descriptions use a more complex notation to specify
-optional and repeated arguments because they can break the argument
-list down into separate arguments in more complicated ways.
-@samp{@r{[}@var{optional-arg}@r{]}} means that @var{optional-arg} is
-optional and @samp{@var{repeated-args}@dots{}} stands for zero or more
-arguments. Parentheses are used when several arguments are grouped into
-additional levels of list structure. Here is an example:
+but the word @samp{Function} is replaced by @samp{Command},
+@samp{Macro}, or @samp{Special Form}, respectively. Commands are
+simply functions that may be called interactively; macros process
+their arguments differently from functions (the arguments are not
+evaluated), but are presented the same way.
+
+ The descriptions of macros and special forms use a more complex
+notation to specify optional and repeated arguments, because they can
+break the argument list down into separate arguments in more
+complicated ways. @samp{@r{[}@var{optional-arg}@r{]}} means that
+@var{optional-arg} is optional and @samp{@var{repeated-args}@dots{}}
+stands for zero or more arguments. Parentheses are used when several
+arguments are grouped into additional levels of list structure. Here
+is an example:
@defspec count-loop (@var{var} [@var{from} @var{to} [@var{inc}]]) @var{body}@dots{}
This imaginary special form implements a loop that executes the
@@ -442,11 +446,14 @@ from @var{body}, which includes all remaining elements of the form.
@cindex variable descriptions
@cindex option descriptions
- A @dfn{variable} is a name that can hold a value. Although nearly
-all variables can be set by the user, certain variables exist
-specifically so that users can change them; these are called @dfn{user
-options}. Ordinary variables and user options are described using a
-format like that for functions except that there are no arguments.
+ A @dfn{variable} is a name that can be @dfn{bound} (or @dfn{set}) to
+an object. The object to which a variable is bound is called a
+@dfn{value}; we say also that variable holds that value.
+Although nearly all variables can be set by the user, certain
+variables exist specifically so that users can change them; these are
+called @dfn{user options}. Ordinary variables and user options are
+described using a format like that for functions, except that there
+are no arguments.
Here is a description of the imaginary @code{electric-future-map}
variable.@refill
@@ -457,8 +464,8 @@ Future mode. The functions in this map allow you to edit commands you
have not yet thought about executing.
@end defvar
- User option descriptions have the same format, but `Variable' is
-replaced by `User Option'.
+ User option descriptions have the same format, but @samp{Variable}
+is replaced by @samp{User Option}.
@node Version Info
@section Version Information
@@ -485,14 +492,14 @@ giving a prefix argument makes @var{here} non-@code{nil}.
@end deffn
@defvar emacs-build-time
-The value of this variable indicates the time at which Emacs was built
-at the local site. It is a list of three integers, like the value
-of @code{current-time} (@pxref{Time of Day}).
+The value of this variable indicates the time at which Emacs was
+built. It is a list of four integers, like the value of
+@code{current-time} (@pxref{Time of Day}).
@example
@group
emacs-build-time
- @result{} (18846 52016 156039)
+ @result{} (20614 63694 515336 438000)
@end group
@end example
@end defvar
@@ -501,13 +508,11 @@ emacs-build-time
The value of this variable is the version of Emacs being run. It is a
string such as @code{"23.1.1"}. The last number in this string is not
really part of the Emacs release version number; it is incremented
-each time you build Emacs in any given directory. A value with four
+each time Emacs is built in any given directory. A value with four
numeric components, such as @code{"22.0.91.1"}, indicates an
unreleased test version.
@end defvar
- The following two variables have existed since Emacs version 19.23:
-
@defvar emacs-major-version
The major version number of Emacs, as an integer. For Emacs version
23.1, the value is 23.
@@ -518,19 +523,19 @@ The minor version number of Emacs, as an integer. For Emacs version
23.1, the value is 1.
@end defvar
-@node Acknowledgements
-@section Acknowledgements
+@node Acknowledgments
+@section Acknowledgments
- This manual was written by Robert Krawitz, Bil Lewis, Dan LaLiberte,
-Richard@tie{}M. Stallman and Chris Welty, the volunteers of the GNU
-manual group, in an effort extending over several years.
+ This manual was originally written by Robert Krawitz, Bil Lewis, Dan
+LaLiberte, Richard@tie{}M. Stallman and Chris Welty, the volunteers of
+the GNU manual group, in an effort extending over several years.
Robert@tie{}J. Chassell helped to review and edit the manual, with the
support of the Defense Advanced Research Projects Agency, ARPA Order
6082, arranged by Warren@tie{}A. Hunt, Jr.@: of Computational Logic,
-Inc. Additional sections were written by Miles Bader, Lars Brinkhoff,
-Chong Yidong, Kenichi Handa, Lute Kamstra, Juri Linkov, Glenn Morris,
-Thien-Thi Nguyen, Dan Nicolaescu, Martin Rudalics, Kim F. Storm, Luc
-Teirlinck, and Eli Zaretskii.
+Inc. Additional sections have since been written by Miles Bader, Lars
+Brinkhoff, Chong Yidong, Kenichi Handa, Lute Kamstra, Juri Linkov,
+Glenn Morris, Thien-Thi Nguyen, Dan Nicolaescu, Martin Rudalics, Kim
+F. Storm, Luc Teirlinck, and Eli Zaretskii, and others.
Corrections were supplied by Drew Adams, Juanma Barranquero, Karl
Berry, Jim Blandy, Bard Bloom, Stephane Boucher, David Boyes, Alan
@@ -545,3 +550,6 @@ Friedrich Pukelsheim, Arnold D. Robbins, Raul Rockwell, Jason Rumney,
Per Starbck, Shinichirou Sugou, Kimmo Suominen, Edward Tharp, Bill
Trost, Rickard Westman, Jean White, Eduard Wiebe, Matthew Wilding,
Carl Witty, Dale Worley, Rusty Wright, and David D. Zuhn.
+
+ For a more complete list of contributors, please see the relevant
+ChangeLog file in the Emacs sources.
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index e5cca0622a9..d01ecba4bed 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1994, 1998-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1994, 1998-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/keymaps
-@node Keymaps, Modes, Command Loop, Top
+@node Keymaps
@chapter Keymaps
@cindex keymap
@@ -46,7 +45,8 @@ is found. The whole process is called @dfn{key lookup}.
A @dfn{key sequence}, or @dfn{key} for short, is a sequence of one
or more input events that form a unit. Input events include
-characters, function keys, and mouse actions (@pxref{Input Events}).
+characters, function keys, mouse actions, or system events external to
+Emacs, such as @code{iconify-frame} (@pxref{Input Events}).
The Emacs Lisp representation for a key sequence is a string or
vector. Unless otherwise stated, any Emacs Lisp function that accepts
a key sequence as an argument can handle both representations.
@@ -63,9 +63,10 @@ sequence is the concatenation of the string representations of the
constituent events; thus, @code{"\C-xl"} represents the key sequence
@kbd{C-x l}.
- Key sequences containing function keys, mouse button events, or
-non-ASCII characters such as @kbd{C-=} or @kbd{H-a} cannot be
-represented as strings; they have to be represented as vectors.
+ Key sequences containing function keys, mouse button events, system
+events, or non-@acronym{ASCII} characters such as @kbd{C-=} or
+@kbd{H-a} cannot be represented as strings; they have to be
+represented as vectors.
In the vector representation, each element of the vector represents
an input event, in its Lisp form. @xref{Input Events}. For example,
@@ -77,11 +78,11 @@ representations, @ref{Init Rebinding,,, emacs, The GNU Emacs Manual}.
@defmac kbd keyseq-text
This macro converts the text @var{keyseq-text} (a string constant)
into a key sequence (a string or vector constant). The contents of
-@var{keyseq-text} should describe the key sequence using almost the same
-syntax used in this manual. More precisely, it uses the same syntax
-that Edit Macro mode uses for editing keyboard macros (@pxref{Edit
-Keyboard Macro,,, emacs, The GNU Emacs Manual}); you must surround
-function key names with @samp{<@dots{}>}.
+@var{keyseq-text} should use the same syntax as in the buffer invoked
+by the @kbd{C-x C-k @key{RET}} (@code{kmacro-edit-macro}) command; in
+particular, you must surround function key names with
+@samp{<@dots{}>}. @xref{Edit Keyboard Macro,,, emacs, The GNU Emacs
+Manual}.
@example
(kbd "C-x") @result{} "\C-x"
@@ -173,13 +174,11 @@ ordinary binding applies to events of a particular @dfn{event type},
which is always a character or a symbol. @xref{Classifying Events}.
In this kind of binding, @var{binding} is a command.
-@item (@var{type} @var{item-name} @r{[}@var{cache}@r{]} .@: @var{binding})
+@item (@var{type} @var{item-name} .@: @var{binding})
This specifies a binding which is also a simple menu item that
-displays as @var{item-name} in the menu. @var{cache}, if present,
-caches certain information for display in the menu. @xref{Simple Menu
-Items}.
+displays as @var{item-name} in the menu. @xref{Simple Menu Items}.
-@item (@var{type} @var{item-name} @var{help-string} @r{[}@var{cache}@r{]} .@: @var{binding})
+@item (@var{type} @var{item-name} @var{help-string} .@: @var{binding})
This is a simple menu item with help string @var{help-string}.
@item (@var{type} menu-item .@: @var{details})
@@ -211,6 +210,11 @@ Aside from elements that specify bindings for keys, a keymap can also
have a string as an element. This is called the @dfn{overall prompt
string} and makes it possible to use the keymap as a menu.
@xref{Defining Menus}.
+
+@item (keymap @dots{})
+If an element of a keymap is itself a keymap, it counts as if this inner keymap
+were inlined in the outer keymap. This is used for multiple-inheritance, such
+as in @code{make-composed-keymap}.
@end table
When the binding is @code{nil}, it doesn't constitute a definition
@@ -234,8 +238,9 @@ other input events; thus, @kbd{M-@key{end}} has nothing to do with
@kbd{@key{ESC} @key{end}}.
Here as an example is the local keymap for Lisp mode, a sparse
-keymap. It defines bindings for @key{DEL} and @key{TAB}, plus @kbd{C-c
-C-l}, @kbd{M-C-q}, and @kbd{M-C-x}.
+keymap. It defines bindings for @key{DEL}, @kbd{C-c C-z},
+@kbd{C-M-q}, and @kbd{C-M-x} (the actual value also contains a menu
+binding, which is omitted here for the sake of brevity).
@example
@group
@@ -250,11 +255,8 @@ lisp-mode-map
@end group
@group
(27 keymap
- ;; @r{@kbd{M-C-x}, treated as @kbd{@key{ESC} C-x}}
- (24 . lisp-send-defun)
- keymap
- ;; @r{@kbd{M-C-q}, treated as @kbd{@key{ESC} C-q}}
- (17 . indent-sexp))
+ ;; @r{@kbd{C-M-x}, treated as @kbd{@key{ESC} C-x}}
+ (24 . lisp-send-defun))
@end group
@group
;; @r{This part is inherited from @code{lisp-mode-shared-map}.}
@@ -264,9 +266,8 @@ lisp-mode-map
@end group
@group
(27 keymap
- ;; @r{@kbd{M-C-q}, treated as @kbd{@key{ESC} C-q}}
- (17 . indent-sexp))
- (9 . lisp-indent-line))
+ ;; @r{@kbd{C-M-q}, treated as @kbd{@key{ESC} C-q}}
+ (17 . indent-sexp)))
@end group
@end example
@@ -375,7 +376,7 @@ definition is a keymap; the same symbol appears in the new copy.
@node Inheritance and Keymaps
@section Inheritance and Keymaps
@cindex keymap inheritance
-@cindex inheriting a keymap's bindings
+@cindex inheritance, keymap
A keymap can inherit the bindings of another keymap, which we call the
@dfn{parent keymap}. Such a keymap looks like this:
@@ -432,6 +433,34 @@ for every numeric character code without modifier bits, even if it is
@code{nil}, so these character's bindings are never inherited from
the parent keymap.
+@cindex keymap inheritance from multiple maps
+ Sometimes you want to make a keymap that inherits from more than one
+map. You can use the function @code{make-composed-keymap} for this.
+
+@defun make-composed-keymap maps &optional parent
+This function returns a new keymap composed of the existing keymap(s)
+@var{maps}, and optionally inheriting from a parent keymap
+@var{parent}. @var{maps} can be a single keymap or a list of more
+than one. When looking up a key in the resulting new map, Emacs
+searches in each of the @var{maps} in turn, and then in @var{parent},
+stopping at the first match. A @code{nil} binding in any one of
+@var{maps} overrides any binding in @var{parent}, but it does not
+override any non-@code{nil} binding in any other of the @var{maps}.
+@end defun
+
+@noindent For example, here is how Emacs sets the parent of
+@code{help-mode-map}, such that it inherits from both
+@code{button-buffer-map} and @code{special-mode-map}:
+
+@example
+(defvar help-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map
+ (make-composed-keymap button-buffer-map special-mode-map))
+ ... map) ... )
+@end example
+
+
@node Prefix Keys
@section Prefix Keys
@cindex prefix key
@@ -635,7 +664,9 @@ additional active keymaps through the variable
The highest precedence normal keymap comes from the @code{keymap}
text or overlay property. If that is non-@code{nil}, it is the first
-keymap to be processed, in normal circumstances.
+keymap to be processed, in normal circumstances. Next comes
+any keymap added by the function @code{set-temporary-overlay-map}.
+@xref{Controlling Active Maps}.
However, there are also special ways for programs to substitute
other keymaps for some of those. The variable
@@ -663,7 +694,7 @@ and exit commands. @xref{Intro to Minibuffers}.
Emacs has other keymaps that are used in a different way---translating
events within @code{read-key-sequence}. @xref{Translation Keymaps}.
- @xref{Standard Keymaps}, for a list of standard keymaps.
+ @xref{Standard Keymaps}, for a list of some standard keymaps.
@defun current-active-maps &optional olp position
This returns the list of active keymaps that would be used by the
@@ -724,45 +755,35 @@ them:
(overriding-local-map
(@var{find-in} overriding-local-map))
((or (@var{find-in} (get-char-property (point) 'keymap))
- (@var{find-in-any} emulation-mode-map-alists)
- (@var{find-in-any} minor-mode-overriding-map-alist)
- (@var{find-in-any} minor-mode-map-alist)
- (if (get-text-property (point) 'local-map)
- (@var{find-in} (get-char-property (point) 'local-map))
- (@var{find-in} (current-local-map))))))
+ (@var{find-in} @var{temp-map})
+ (@var{find-in-any} emulation-mode-map-alists)
+ (@var{find-in-any} minor-mode-overriding-map-alist)
+ (@var{find-in-any} minor-mode-map-alist)
+ (if (get-text-property (point) 'local-map)
+ (@var{find-in} (get-char-property (point) 'local-map))
+ (@var{find-in} (current-local-map))))))
(@var{find-in} (current-global-map)))
@end lisp
@noindent
-The @var{find-in} and @var{find-in-any} are pseudo functions that
-search in one keymap and in an alist of keymaps, respectively.
-(Searching a single keymap for a binding is called @dfn{key lookup};
-see @ref{Key Lookup}.) If the key sequence starts with a mouse event,
-or a symbolic prefix event followed by a mouse event, that event's
-position is used instead of point and the current buffer. Mouse
-events on an embedded string use non-@code{nil} text properties from
-that string instead of the buffer.
-
-@enumerate
-@item
-The function finally found may be remapped
-(@pxref{Remapping Commands}).
-
-@item
-Characters that are bound to @code{self-insert-command} are translated
-according to @code{translation-table-for-input} before insertion.
-
-@item
-@code{current-active-maps} returns a list of the
-currently active keymaps at point.
-
-@item
-When a match is found (@pxref{Key Lookup}), if the binding in the
+@var{find-in} and @var{find-in-any} are pseudo functions that search
+in one keymap and in an alist of keymaps, respectively. (Searching a
+single keymap for a binding is called @dfn{key lookup}; see @ref{Key
+Lookup}.) If the key sequence starts with a mouse event, or a
+symbolic prefix event followed by a mouse event, that event's position
+is used instead of point and the current buffer. Mouse events on an
+embedded string use non-@code{nil} text properties from that string
+instead of the buffer. @var{temp-map} is a pseudo variable that
+represents the effect of a @code{set-temporary-overlay-map} call.
+
+ When a match is found (@pxref{Key Lookup}), if the binding in the
keymap is a function, the search is over. However if the keymap entry
is a symbol with a value or a string, Emacs replaces the input key
sequences with the variable's value or the string, and restarts the
search of the active keymaps.
-@end enumerate
+
+ The function finally found might also be remapped. @xref{Remapping
+Commands}.
@node Controlling Active Maps
@section Controlling the Active Keymaps
@@ -797,7 +818,7 @@ bindings.
@defun current-local-map
This function returns the current buffer's local keymap, or @code{nil}
if it has none. In the following example, the keymap for the
-@samp{*scratch*} buffer (using Lisp Interaction mode) is a sparse keymap
+@file{*scratch*} buffer (using Lisp Interaction mode) is a sparse keymap
in which the entry for @key{ESC}, @acronym{ASCII} code 27, is another sparse
keymap.
@@ -933,6 +954,21 @@ are used before @code{minor-mode-map-alist} and
@code{minor-mode-overriding-map-alist}.
@end defvar
+@defun set-temporary-overlay-map keymap &optional keep
+This function adds @var{keymap} as a temporary keymap that takes
+precedence over most other keymaps. It does not take precedence over
+the ``overriding'' maps (see above); and unlike them, if no match for
+a key is found in @var{keymap}, the search continues.
+
+Normally, @var{keymap} is used only once. If the optional argument
+@var{pred} is @code{t}, the map stays active if a key from @var{keymap}
+is used. @var{pred} can also be a function of no arguments: if it returns
+non-@code{nil} then @var{keymap} stays active.
+
+For a pseudo-Lisp description of exactly how and when this keymap applies,
+@pxref{Searching Keymaps}.
+@end defun
+
@node Key Lookup
@section Key Lookup
@cindex key lookup
@@ -1022,7 +1058,7 @@ binding of @var{othertype} in @var{othermap} and uses that.
This feature permits you to define one key as an alias for another key.
For example, an entry whose @sc{car} is the keymap called @code{esc-map}
and whose @sc{cdr} is 32 (the code for @key{SPC}) means, ``Use the global
-binding of @kbd{Meta-@key{SPC}}, whatever that may be.''
+binding of @kbd{Meta-@key{SPC}}, whatever that may be''.
@end itemize
@item @var{symbol}
@@ -1060,21 +1096,9 @@ lookup form a complete key, and the object is its binding, but the
binding is not executable as a command.
@end table
- In short, a keymap entry may be a keymap, a command, a keyboard macro,
-a symbol that leads to one of them, or an indirection or @code{nil}.
-Here is an example of a sparse keymap with two characters bound to
-commands and one bound to another keymap. This map is the normal value
-of @code{emacs-lisp-mode-map}. Note that 9 is the code for @key{TAB},
-127 for @key{DEL}, 27 for @key{ESC}, 17 for @kbd{C-q} and 24 for
-@kbd{C-x}.
-
-@example
-@group
-(keymap (9 . lisp-indent-line)
- (127 . backward-delete-char-untabify)
- (27 keymap (17 . indent-sexp) (24 . eval-defun)))
-@end group
-@end example
+ In short, a keymap entry may be a keymap, a command, a keyboard
+macro, a symbol that leads to one of them, or an indirection or
+@code{nil}.
@node Functions for Key Lookup
@section Functions for Key Lookup
@@ -1444,23 +1468,21 @@ that is used for some other purpose is likely to cause trouble; for
example, suppressing @code{global-map} would make it impossible to use
most of Emacs.
-Most often, @code{suppress-keymap} is used to initialize local
-keymaps of modes such as Rmail and Dired where insertion of text is not
-desirable and the buffer is read-only. Here is an example taken from
-the file @file{emacs/lisp/dired.el}, showing how the local keymap for
-Dired mode is set up:
+This function can be used to initialize the local keymap of a major
+mode for which insertion of text is not desirable. But usually such a
+mode should be derived from @code{special-mode} (@pxref{Basic Major
+Modes}); then its keymap will automatically inherit from
+@code{special-mode-map}, which is already suppressed. Here is how
+@code{special-mode-map} is defined:
@smallexample
@group
-(setq dired-mode-map (make-keymap))
-(suppress-keymap dired-mode-map)
-(define-key dired-mode-map "r" 'dired-rename-file)
-(define-key dired-mode-map "\C-d" 'dired-flag-file-deleted)
-(define-key dired-mode-map "d" 'dired-flag-file-deleted)
-(define-key dired-mode-map "v" 'dired-view-file)
-(define-key dired-mode-map "e" 'dired-find-file)
-(define-key dired-mode-map "f" 'dired-find-file)
-@dots{}
+(defvar special-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map "q" 'quit-window)
+ @dots{}
+ map))
@end group
@end smallexample
@end defun
@@ -1537,14 +1559,11 @@ sequence, to translate certain event sequences into others.
being read, as it is read, against @code{input-decode-map}, then
@code{local-function-key-map}, and then against @code{key-translation-map}.
-@defvar input-decode-map
-This variable holds a keymap that describes the character sequences sent
-by function keys on an ordinary character terminal. This keymap has the
-same structure as other keymaps, but is used differently: it specifies
-translations to make while reading key sequences, rather than bindings
-for key sequences.
+These keymaps have the same structure as other keymaps, but they are used
+differently: they specify translations to make while reading key sequences,
+rather than bindings for key sequences.
-If @code{input-decode-map} ``binds'' a key sequence @var{k} to a vector
+If one of these keymaps ``binds'' a key sequence @var{k} to a vector
@var{v}, then when @var{k} appears as a subsequence @emph{anywhere} in a
key sequence, it is replaced with the events in @var{v}.
@@ -1559,6 +1578,10 @@ Thus, typing @kbd{C-c @key{PF1}} sends the character sequence @kbd{C-c
this back into @kbd{C-c @key{PF1}}, which it returns as the vector
@code{[?\C-c pf1]}.
+@defvar input-decode-map
+This variable holds a keymap that describes the character sequences sent
+by function keys on an ordinary character terminal.
+
The value of @code{input-decode-map} is usually set up automatically
according to the terminal's Terminfo or Termcap entry, but sometimes
those need help from terminal-specific Lisp files. Emacs comes with
@@ -1604,10 +1627,11 @@ to @code{self-insert-command}.
@end defvar
@cindex key translation function
-You can use @code{input-decode-map}, @code{local-function-key-map}, or
-@code{key-translation-map} for more than simple aliases, by using a
-function, instead of a key sequence, as the ``translation'' of a key.
-Then this function is called to compute the translation of that key.
+You can use @code{input-decode-map}, @code{local-function-key-map},
+and @code{key-translation-map} for more than simple aliases, by using
+a function, instead of a key sequence, as the ``translation'' of a
+key. Then this function is called to compute the translation of that
+key.
The key translation function receives one argument, which is the prompt
that was specified in @code{read-key-sequence}---or @code{nil} if the
@@ -1632,8 +1656,6 @@ to turn the character that follows into a Hyper character:
(let ((symbol (if (symbolp e) e (car e))))
(setq symbol (intern (concat string
(symbol-name symbol))))
-@end group
-@group
(if (symbolp e)
symbol
(cons symbol (cdr e)))))
@@ -1643,10 +1665,30 @@ to turn the character that follows into a Hyper character:
@end example
If you have enabled keyboard character set decoding using
-@code{set-keyboard-coding-system}, decoding is done after the
-translations listed above. @xref{Terminal I/O Encoding}. However, in
-future Emacs versions, character set decoding may be done at an
-earlier stage.
+@code{set-keyboard-coding-system}, decoding is done before the
+translations listed above. @xref{Terminal I/O Encoding}.
+
+@subsection Interaction with normal keymaps
+
+The end of a key sequence is detected when that key sequence either is bound
+to a command, or when Emacs determines that no additional event can lead
+to a sequence that is bound to a command.
+
+This means that, while @code{input-decode-map} and @code{key-translation-map}
+apply regardless of whether the original key sequence would have a binding, the
+presence of such a binding can still prevent translation from taking place.
+For example, let us return to our VT100 example above and add a binding for
+@kbd{C-c @key{ESC}} to the global map; now when the user hits @kbd{C-c
+@key{PF1}} Emacs will fail to decode @kbd{C-c @key{ESC} O P} into @kbd{C-c
+@key{PF1}} because it will stop reading keys right after @kbd{C-x @key{ESC}},
+leaving @kbd{O P} for later. This is in case the user really hit @kbd{C-c
+@key{ESC}}, in which case Emacs should not sit there waiting for the next key
+to decide whether the user really pressed @kbd{@key{ESC}} or @kbd{@key{PF1}}.
+
+For that reason, it is better to avoid binding commands to key sequences where
+the end of the key sequence is a prefix of a key translation. The main such
+problematic suffixes/prefixes are @kbd{@key{ESC}}, @kbd{M-O} (which is really
+@kbd{@key{ESC} O}) and @kbd{M-[} (which is really @kbd{@key{ESC} [}).
@node Key Binding Commands
@section Commands for Binding Keys
@@ -1891,9 +1933,9 @@ maps searched are @var{keymap} and the global keymap. If @var{keymap}
is a list of keymaps, only those keymaps are searched.
Usually it's best to use @code{overriding-local-map} as the expression
-for @var{keymap}. Then @code{where-is-internal} searches precisely the
-keymaps that are active. To search only the global map, pass
-@code{(keymap)} (an empty keymap) as @var{keymap}.
+for @var{keymap}. Then @code{where-is-internal} searches precisely
+the keymaps that are active. To search only the global map, pass the
+value @code{(keymap)} (an empty keymap) as @var{keymap}.
If @var{firstonly} is @code{non-ascii}, then the value is a single
vector representing the first key sequence found, rather than a list of
@@ -1907,25 +1949,29 @@ If @var{noindirect} is non-@code{nil}, @code{where-is-internal} doesn't
follow indirect keymap bindings. This makes it possible to search for
an indirect definition itself.
-When command remapping is in effect (@pxref{Remapping Commands}),
-@code{where-is-internal} figures out when a command will be run due to
-remapping and reports keys accordingly. It also returns @code{nil} if
-@var{command} won't really be run because it has been remapped to some
-other command. However, if @var{no-remap} is non-@code{nil}.
-@code{where-is-internal} ignores remappings.
+The fifth argument, @var{no-remap}, determines how this function
+treats command remappings (@pxref{Remapping Commands}). There are two
+cases of interest:
-@smallexample
-@group
-(where-is-internal 'describe-function)
- @result{} ([8 102] [f1 102] [help 102]
- [menu-bar help-menu describe describe-function])
-@end group
-@end smallexample
+@table @asis
+@item If a command @var{other-command} is remapped to @var{command}:
+If @var{no-remap} is @code{nil}, find the bindings for
+@var{other-command} and treat them as though they are also bindings
+for @var{command}. If @var{no-remap} is non-@code{nil}, include the
+vector @code{[remap @var{other-command}]} in the list of possible key
+sequences, instead of finding those bindings.
+
+@item If @var{command} is remapped to @var{other-command}:
+If @var{no-remap} is @code{nil}, return the bindings for
+@var{other-command} rather than @var{command}. If @var{no-remap} is
+non-@code{nil}, return the bindings for @var{command}, ignoring the
+fact that it is remapped.
+@end table
@end defun
@deffn Command describe-bindings &optional prefix buffer-or-name
This function creates a listing of all current key bindings, and
-displays it in a buffer named @samp{*Help*}. The text is grouped by
+displays it in a buffer named @file{*Help*}. The text is grouped by
modes---minor modes first, then the major mode, then global bindings.
If @var{prefix} is non-@code{nil}, it should be a prefix key; then the
@@ -1960,13 +2006,14 @@ is active for the next input event, that activates the keyboard menu
feature.
@menu
-* Defining Menus:: How to make a keymap that defines a menu.
-* Mouse Menus:: How users actuate the menu with the mouse.
-* Keyboard Menus:: How users actuate the menu with the keyboard.
-* Menu Example:: Making a simple menu.
-* Menu Bar:: How to customize the menu bar.
-* Tool Bar:: A tool bar is a row of images.
-* Modifying Menus:: How to add new items to a menu.
+* Defining Menus:: How to make a keymap that defines a menu.
+* Mouse Menus:: How users actuate the menu with the mouse.
+* Keyboard Menus:: How users actuate the menu with the keyboard.
+* Menu Example:: Making a simple menu.
+* Menu Bar:: How to customize the menu bar.
+* Tool Bar:: A tool bar is a row of images.
+* Modifying Menus:: How to add new items to a menu.
+* Easy Menu:: A convenience macro for making menus.
@end menu
@node Defining Menus
@@ -2012,17 +2059,12 @@ an existing menu, you can specify its position in the menu using
@code{define-key-after} (@pxref{Modifying Menus}).
@menu
-* Simple Menu Items:: A simple kind of menu key binding,
- limited in capabilities.
-* Extended Menu Items:: More powerful menu item definitions
- let you specify keywords to enable
- various features.
+* Simple Menu Items:: A simple kind of menu key binding.
+* Extended Menu Items:: More complex menu item definitions.
* Menu Separators:: Drawing a horizontal line through a menu.
* Alias Menu Items:: Using command aliases in menu items.
-* Toolkit Differences:: Not all toolkits provide the same features.
@end menu
-
@node Simple Menu Items
@subsubsection Simple Menu Items
@@ -2036,12 +2078,10 @@ event type (it doesn't matter what event type) to a binding like this:
@noindent
The @sc{car}, @var{item-string}, is the string to be displayed in the
menu. It should be short---preferably one to three words. It should
-describe the action of the command it corresponds to. Note that it is
-not generally possible to display non-@acronym{ASCII} text in menus. It will
-work for keyboard menus and will work to a large extent when Emacs is
-built with the Gtk+ toolkit.@footnote{In this case, the text is first
-encoded using the @code{utf-8} coding system and then rendered by the
-toolkit as it sees fit.}
+describe the action of the command it corresponds to. Note that not
+all graphical toolkits can display non-@acronym{ASCII} text in menus
+(it will work for keyboard menus and will work to a large extent with
+the GTK+ toolkit).
You can also supply a second string, called the help string, as follows:
@@ -2153,7 +2193,7 @@ This works because @code{toggle-debug-on-error} is defined as a command
which toggles the variable @code{debug-on-error}.
@dfn{Radio buttons} are a group of menu items, in which at any time one
-and only one is ``selected.'' There should be a variable whose value
+and only one is ``selected''. There should be a variable whose value
says which one is selected at any time. The @var{selected} form for
each radio button in the group should check whether the variable has the
right value for selecting that button. Clicking on the button should
@@ -2287,12 +2327,12 @@ command but with different enable conditions. The best way to do this
in Emacs now is with extended menu items; before that feature existed,
it could be done by defining alias commands and using them in menu
items. Here's an example that makes two aliases for
-@code{toggle-read-only} and gives them different enable conditions:
+@code{read-only-mode} and gives them different enable conditions:
@example
-(defalias 'make-read-only 'toggle-read-only)
+(defalias 'make-read-only 'read-only-mode)
(put 'make-read-only 'menu-enable '(not buffer-read-only))
-(defalias 'make-writable 'toggle-read-only)
+(defalias 'make-writable 'read-only-mode)
(put 'make-writable 'menu-enable 'buffer-read-only)
@end example
@@ -2309,29 +2349,7 @@ itself). To request this, give the alias symbol a non-@code{nil}
@noindent
causes menu items for @code{make-read-only} and @code{make-writable} to
-show the keyboard bindings for @code{toggle-read-only}.
-
-@node Toolkit Differences
-@subsubsection Toolkit Differences
-
-The various toolkits with which you can build Emacs do not all support
-the same set of features for menus. Some code works as expected with
-one toolkit, but not under another.
-
-One example is menu actions or buttons in a top-level menu-bar. The
-following works with the Lucid toolkit or on MS Windows, but not with
-GTK or Nextstep, where clicking on the item has no effect.
-
-@example
-(defun menu-action-greet ()
- (interactive)
- (message "Hello Emacs User!"))
-
-(defun top-level-menu ()
- (interactive)
- (define-key lisp-interaction-mode-map [menu-bar m]
- '(menu-item "Action Button" menu-action-greet)))
-@end example
+show the keyboard bindings for @code{read-only-mode}.
@node Mouse Menus
@subsection Menus and the Mouse
@@ -2350,24 +2368,25 @@ multiple levels or comes from the menu bar.)
It's often best to use a button-down event to trigger the menu. Then
the user can select a menu item by releasing the button.
- A single keymap can appear as multiple menu panes, if you explicitly
-arrange for this. The way to do this is to make a keymap for each pane,
-then create a binding for each of those maps in the main keymap of the
-menu. Give each of these bindings an item string that starts with
-@samp{@@}. The rest of the item string becomes the name of the pane.
-See the file @file{lisp/mouse.el} for an example of this. Any ordinary
-bindings with @samp{@@}-less item strings are grouped into one pane,
-which appears along with the other panes explicitly created for the
-submaps.
-
- X toolkit menus don't have panes; instead, they can have submenus.
-Every nested keymap becomes a submenu, whether the item string starts
-with @samp{@@} or not. In a toolkit version of Emacs, the only thing
-special about @samp{@@} at the beginning of an item string is that the
-@samp{@@} doesn't appear in the menu item.
-
- Multiple keymaps that define the same menu prefix key produce
-separate panes or separate submenus.
+@cindex submenu
+ If the menu keymap contains a binding to a nested keymap, the nested
+keymap specifies a @dfn{submenu}. There will be a menu item, labeled
+by the nested keymap's item string, and clicking on this item
+automatically pops up the specified submenu. As a special exception,
+if the menu keymap contains a single nested keymap and no other menu
+items, the menu shows the contents of the nested keymap directly, not
+as a submenu.
+
+ However, if Emacs is compiled without X toolkit support, submenus
+are not supported. Each nested keymap is shown as a menu item, but
+clicking on it does not automatically pop up the submenu. If you wish
+to imitate the effect of submenus, you can do that by giving a nested
+keymap an item string which starts with @samp{@@}. This causes Emacs
+to display the nested keymap using a separate @dfn{menu pane}; the
+rest of the item string after the @samp{@@} is the pane label. If
+Emacs is compiled without X toolkit support, menu panes are not used;
+in that case, a @samp{@@} at the beginning of an item string is
+omitted when the menu label is displayed, and has no other effect.
@node Keyboard Menus
@subsection Menus and the Keyboard
@@ -2390,18 +2409,6 @@ this; @key{SPC} is the default.)
she should type the corresponding character---the one whose binding is
that alternative.
-@ignore
-In a menu intended for keyboard use, each menu item must clearly
-indicate what character to type. The best convention to use is to make
-the character the first letter of the item string---that is something
-users will understand without being told. We plan to change this; by
-the time you read this manual, keyboard menus may explicitly name the
-key for each alternative.
-@end ignore
-
- This way of using menus in an Emacs-like editor was inspired by the
-Hierarkey system.
-
@defvar menu-prompt-more-char
This variable specifies the character to use to ask to see
the next line of a menu. Its initial value is 32, the code
@@ -2441,7 +2448,7 @@ Next we define the menu items:
Note the symbols which the bindings are ``made for''; these appear
inside square brackets, in the key sequence being defined. In some
cases, this symbol is the same as the command name; sometimes it is
-different. These symbols are treated as ``function keys,'' but they are
+different. These symbols are treated as ``function keys'', but they are
not real function keys on the keyboard. They do not affect the
functioning of the menu itself, but they are ``echoed'' in the echo area
when the user selects from the menu, and they appear in the output of
@@ -2484,21 +2491,17 @@ can do it this way:
@subsection The Menu Bar
@cindex menu bar
- Most window systems allow each frame to have a @dfn{menu bar}---a
-permanently displayed menu stretching horizontally across the top of
-the frame. (In order for a frame to display a menu bar, its
-@code{menu-bar-lines} parameter must be greater than zero.
-@xref{Layout Parameters}.)
-
- The items of the menu bar are the subcommands of the fake ``function
-key'' @code{menu-bar}, as defined in the active keymaps.
+ On graphical displays, there is usually a @dfn{menu bar} at the top
+of each frame. @xref{Menu Bars,,,emacs, The GNU Emacs Manual}. Menu
+bar items are subcommands of the fake ``function key''
+@code{menu-bar}, as defined in the active keymaps.
To add an item to the menu bar, invent a fake ``function key'' of your
own (let's call it @var{key}), and make a binding for the key sequence
@code{[menu-bar @var{key}]}. Most often, the binding is a menu keymap,
so that pressing a button on the menu bar item leads to another menu.
- When more than one active keymap defines the same fake function key
+ When more than one active keymap defines the same ``function key''
for the menu bar, the item appears just once. If the user clicks on
that menu bar item, it brings up a single, combined menu containing
all the subcommands of that item---the global subcommands, the local
@@ -2513,11 +2516,6 @@ were @code{nil}. @xref{Active Keymaps}.
@example
@group
-(modify-frame-parameters (selected-frame)
- '((menu-bar-lines . 2)))
-@end group
-
-@group
;; @r{Make a menu keymap (with a prompt string)}
;; @r{and make it the menu bar item's definition.}
(define-key global-map [menu-bar words]
@@ -2574,36 +2572,24 @@ the same command (if such a key binding exists). This serves as a
convenient hint for users who do not know the key binding. If a
command has multiple bindings, Emacs normally displays the first one
it finds. You can specify one particular key binding by assigning an
-@code{:advertised-binding} symbol property to the command. For
-instance, the following tells Emacs to show @kbd{C-/} for the
-@code{undo} menu item:
-
-@smallexample
-(put 'undo :advertised-binding [?\C-/])
-@end smallexample
-
-@noindent
-If the @code{:advertised-binding} property specifies a key binding
-that the command does not actually have, it is ignored.
+@code{:advertised-binding} symbol property to the command. @xref{Keys
+in Documentation}.
@node Tool Bar
@subsection Tool bars
@cindex tool bar
- A @dfn{tool bar} is a row of icons at the top of a frame, that execute
-commands when you click on them---in effect, a kind of graphical menu
-bar.
+ A @dfn{tool bar} is a row of clickable icons at the top of a frame,
+just below the menu bar. @xref{Tool Bars,,,emacs, The GNU Emacs
+Manual}.
- The frame parameter @code{tool-bar-lines} (X resource @samp{toolBar})
-controls how many lines' worth of height to reserve for the tool bar. A
-zero value suppresses the tool bar. If the value is nonzero, and
-@code{auto-resize-tool-bars} is non-@code{nil}, the tool bar expands and
-contracts automatically as needed to hold the specified contents.
-
- If the value of @code{auto-resize-tool-bars} is @code{grow-only},
-the tool bar expands automatically, but does not contract automatically.
-To contract the tool bar, the user has to redraw the frame by entering
-@kbd{C-l}.
+ On each frame, the frame parameter @code{tool-bar-lines} controls
+how many lines' worth of height to reserve for the tool bar. A zero
+value suppresses the tool bar. If the value is nonzero, and
+@code{auto-resize-tool-bars} is non-@code{nil}, the tool bar expands
+and contracts automatically as needed to hold the specified contents.
+If the value is @code{grow-only}, the tool bar expands automatically,
+but does not contract automatically.
The tool bar contents are controlled by a menu keymap attached to a
fake ``function key'' called @code{tool-bar} (much like the way the menu
@@ -2655,9 +2641,18 @@ button in disabled state by applying an edge-detection algorithm to the
image.
The @code{:rtl} property specifies an alternative image to use for
-right-to-left languages. Only the Gtk+ version of Emacs supports this
+right-to-left languages. Only the GTK+ version of Emacs supports this
at present.
+Like the menu bar, the tool bar can display separators (@pxref{Menu
+Separators}). Tool bar separators are vertical rather than
+horizontal, though, and only a single style is supported. They are
+represented in the tool bar keymap by @code{(menu-item "--")} entries;
+properties like @code{:visible} are not supported for tool bar
+separators. Separators are rendered natively in GTK+ and Nextstep
+tool bars; in the other cases, they are rendered using an image of a
+vertical line.
+
The default tool bar is defined so that items specific to editing do not
appear for major modes whose command symbol has a @code{mode-class}
property of @code{special} (@pxref{Major Mode Conventions}). Major
@@ -2669,18 +2664,20 @@ using an indirection through @code{tool-bar-map}.
@defvar tool-bar-map
By default, the global map binds @code{[tool-bar]} as follows:
+
@example
(global-set-key [tool-bar]
- '(menu-item "tool bar" ignore
- :filter (lambda (ignore) tool-bar-map)))
+ `(menu-item ,(purecopy "tool bar") ignore
+ :filter tool-bar-make-keymap))
@end example
+
@noindent
-Thus the tool bar map is derived dynamically from the value of variable
-@code{tool-bar-map} and you should normally adjust the default (global)
-tool bar by changing that map. Major modes may replace the global bar
-completely by making @code{tool-bar-map} buffer-local and set to a
-keymap containing only the desired items. Info mode provides an
-example.
+The function @code{tool-bar-make-keymap}, in turn, derives the actual
+tool bar map dynamically from the value of the variable
+@code{tool-bar-map}. Hence, you should normally adjust the default
+(global) tool bar by changing that map. Some major modes, such as
+Info mode, completely replace the global tool bar by making
+@code{tool-bar-map} buffer-local and setting it to a different keymap.
@end defvar
There are two convenience functions for defining tool bar items, as
@@ -2833,3 +2830,125 @@ menu of Shell mode, after the item @code{break}:
[work] '("Work" . work-command) 'break)
@end example
@end defun
+
+@node Easy Menu
+@subsection Easy Menu
+
+ The following macro provides a convenient way to define pop-up menus
+and/or menu bar menus.
+
+@defmac easy-menu-define symbol maps doc menu
+This macro defines a pop-up menu and/or menu bar submenu, whose
+contents are given by @var{menu}.
+
+If @var{symbol} is non-@code{nil}, it should be a symbol; then this
+macro defines @var{symbol} as a function for popping up the menu
+(@pxref{Pop-Up Menus}), with @var{doc} as its documentation string.
+@var{symbol} should not be quoted.
+
+Regardless of the value of @var{symbol}, if @var{maps} is a keymap,
+the menu is added to that keymap, as a top-level menu for the menu bar
+(@pxref{Menu Bar}). It can also be a list of keymaps, in which case
+the menu is added separately to each of those keymaps.
+
+The first element of @var{menu} must be a string, which serves as the
+menu label. It may be followed by any number of the following
+keyword-argument pairs:
+
+@table @code
+@item :filter @var{function}
+@var{function} must be a function which, if called with one
+argument---the list of the other menu items---returns the actual items
+to be displayed in the menu.
+
+@item :visible @var{include}
+@var{include} is an expression; if it evaluates to @code{nil}, the
+menu is made invisible. @code{:included} is an alias for
+@code{:visible}.
+
+@item :active @var{enable}
+@var{enable} is an expression; if it evaluates to @code{nil}, the menu
+is not selectable. @code{:enable} is an alias for @code{:active}.
+@end table
+
+The remaining elements in @var{menu} are menu items.
+
+A menu item can be a vector of three elements, @code{[@var{name}
+@var{callback} @var{enable}]}. @var{name} is the menu item name (a
+string). @var{callback} is a command to run, or an expression to
+evaluate, when the item is chosen. @var{enable} is an expression; if
+it evaluates to @code{nil}, the item is disabled for selection.
+
+Alternatively, a menu item may have the form:
+
+@smallexample
+ [ @var{name} @var{callback} [ @var{keyword} @var{arg} ]... ]
+@end smallexample
+
+@noindent
+where @var{name} and @var{callback} have the same meanings as above,
+and each optional @var{keyword} and @var{arg} pair should be one of
+the following:
+
+@table @code
+@item :keys @var{keys}
+@var{keys} is a keyboard equivalent to the menu item (a string). This
+is normally not needed, as keyboard equivalents are computed
+automatically. @var{keys} is expanded with
+@code{substitute-command-keys} before it is displayed (@pxref{Keys in
+Documentation}).
+
+@item :key-sequence @var{keys}
+@var{keys} is a hint for speeding up Emacs's first display of the
+menu. It should be nil if you know that the menu item has no keyboard
+equivalent; otherwise it should be a string or vector specifying a
+keyboard equivalent for the menu item.
+
+@item :active @var{enable}
+@var{enable} is an expression; if it evaluates to @code{nil}, the item
+is make unselectable.. @code{:enable} is an alias for @code{:active}.
+
+@item :visible @var{include}
+@var{include} is an expression; if it evaluates to @code{nil}, the
+item is made invisible. @code{:included} is an alias for
+@code{:visible}.
+
+@item :label @var{form}
+@var{form} is an expression that is evaluated to obtain a value which
+serves as the menu item's label (the default is @var{name}).
+
+@item :suffix @var{form}
+@var{form} is an expression that is dynamically evaluated and whose
+value is concatenated with the menu entry's label.
+
+@item :style @var{style}
+@var{style} is a symbol describing the type of menu item; it should be
+@code{toggle} (a checkbox), or @code{radio} (a radio button), or
+anything else (meaning an ordinary menu item).
+
+@item :selected @var{selected}
+@var{selected} is an expression; the checkbox or radio button is
+selected whenever the expression's value is non-nil.
+
+@item :help @var{help}
+@var{help} is a string describing the menu item.
+@end table
+
+Alternatively, a menu item can be a string. Then that string appears
+in the menu as unselectable text. A string consisting of dashes is
+displayed as a separator (@pxref{Menu Separators}).
+
+Alternatively, a menu item can be a list with the same format as
+@var{menu}. This is a submenu.
+@end defmac
+
+Here is an example of using @code{easy-menu-define} to define a menu
+similar to the one defined in the example in @ref{Menu Bar}:
+
+@example
+(easy-menu-define words-menu global-map
+ "Menu for word navigation commands."
+ '("Words"
+ ["Forward word" forward-word]
+ ["Backward word" backward-word]))
+@end example
diff --git a/doc/lispref/lay-flat.texi b/doc/lispref/lay-flat.texi
index 55973adac59..73e2adbc03a 100644
--- a/doc/lispref/lay-flat.texi
+++ b/doc/lispref/lay-flat.texi
@@ -1,6 +1,6 @@
\input texinfo @c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@c
@comment %**start of header
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 056c924e72c..40e8d08f72c 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/lists
-@node Lists, Sequences Arrays Vectors, Strings and Characters, Top
+@node Lists
@chapter Lists
@cindex lists
@cindex element (of list)
@@ -23,7 +22,6 @@ the whole list.
* Modifying Lists:: Storing new pieces into an existing list.
* Sets And Lists:: A list can represent a finite mathematical set.
* Association Lists:: A list can represent a finite relation or mapping.
-* Rings:: Managing a fixed-size ring of objects.
@end menu
@node Cons Cells
@@ -31,61 +29,56 @@ the whole list.
@cindex lists and cons cells
Lists in Lisp are not a primitive data type; they are built up from
-@dfn{cons cells}. A cons cell is a data object that represents an
-ordered pair. That is, it has two slots, and each slot @dfn{holds}, or
-@dfn{refers to}, some Lisp object. One slot is known as the @sc{car},
-and the other is known as the @sc{cdr}. (These names are traditional;
-see @ref{Cons Cell Type}.) @sc{cdr} is pronounced ``could-er.''
+@dfn{cons cells} (@pxref{Cons Cell Type}). A cons cell is a data
+object that represents an ordered pair. That is, it has two slots,
+and each slot @dfn{holds}, or @dfn{refers to}, some Lisp object. One
+slot is known as the @sc{car}, and the other is known as the @sc{cdr}.
+(These names are traditional; see @ref{Cons Cell Type}.) @sc{cdr} is
+pronounced ``could-er''.
We say that ``the @sc{car} of this cons cell is'' whatever object
its @sc{car} slot currently holds, and likewise for the @sc{cdr}.
- A list is a series of cons cells ``chained together,'' so that each
-cell refers to the next one. There is one cons cell for each element of
-the list. By convention, the @sc{car}s of the cons cells hold the
-elements of the list, and the @sc{cdr}s are used to chain the list: the
-@sc{cdr} slot of each cons cell refers to the following cons cell. The
-@sc{cdr} of the last cons cell is @code{nil}. This asymmetry between
-the @sc{car} and the @sc{cdr} is entirely a matter of convention; at the
-level of cons cells, the @sc{car} and @sc{cdr} slots have the same
-characteristics.
+ A list is a series of cons cells ``chained together'', so that each
+cell refers to the next one. There is one cons cell for each element
+of the list. By convention, the @sc{car}s of the cons cells hold the
+elements of the list, and the @sc{cdr}s are used to chain the list
+(this asymmetry between @sc{car} and @sc{cdr} is entirely a matter of
+convention; at the level of cons cells, the @sc{car} and @sc{cdr}
+slots have similar properties). Hence, the @sc{cdr} slot of each cons
+cell in a list refers to the following cons cell.
@cindex true list
- Since @code{nil} is the conventional value to put in the @sc{cdr} of
-the last cons cell in the list, we call that case a @dfn{true list}.
-
- In Lisp, we consider the symbol @code{nil} a list as well as a
-symbol; it is the list with no elements. For convenience, the symbol
+ Also by convention, the @sc{cdr} of the last cons cell in a list is
+@code{nil}. We call such a @code{nil}-terminated structure a
+@dfn{true list}. In Emacs Lisp, the symbol @code{nil} is both a
+symbol and a list with no elements. For convenience, the symbol
@code{nil} is considered to have @code{nil} as its @sc{cdr} (and also
-as its @sc{car}). Therefore, the @sc{cdr} of a true list is always a
-true list.
+as its @sc{car}).
+
+ Hence, the @sc{cdr} of a true list is always a true list. The
+@sc{cdr} of a nonempty true list is a true list containing all the
+elements except the first.
@cindex dotted list
@cindex circular list
- If the @sc{cdr} of a list's last cons cell is some other value,
-neither @code{nil} nor another cons cell, we call the structure a
-@dfn{dotted list}, since its printed representation would use
-@samp{.}. There is one other possibility: some cons cell's @sc{cdr}
-could point to one of the previous cons cells in the list. We call
-that structure a @dfn{circular list}.
+ If the @sc{cdr} of a list's last cons cell is some value other than
+@code{nil}, we call the structure a @dfn{dotted list}, since its
+printed representation would use dotted pair notation (@pxref{Dotted
+Pair Notation}). There is one other possibility: some cons cell's
+@sc{cdr} could point to one of the previous cons cells in the list.
+We call that structure a @dfn{circular list}.
For some purposes, it does not matter whether a list is true,
-circular or dotted. If the program doesn't look far enough down the
+circular or dotted. If a program doesn't look far enough down the
list to see the @sc{cdr} of the final cons cell, it won't care.
However, some functions that operate on lists demand true lists and
signal errors if given a dotted list. Most functions that try to find
the end of a list enter infinite loops if given a circular list.
@cindex list structure
- Because most cons cells are used as part of lists, the phrase
-@dfn{list structure} has come to mean any structure made out of cons
-cells.
-
- The @sc{cdr} of any nonempty true list @var{l} is a list containing all the
-elements of @var{l} except the first.
-
- @xref{Cons Cell Type}, for the read and print syntax of cons cells and
-lists, and for ``box and arrow'' illustrations of lists.
+ Because most cons cells are used as part of lists, we refer to any
+structure made out of cons cells as a @dfn{list structure}.
@node List-related Predicates
@section Predicates on Lists
@@ -94,7 +87,7 @@ lists, and for ``box and arrow'' illustrations of lists.
whether it is a cons cell or is a list, or whether it is the
distinguished object @code{nil}. (Many of these predicates can be
defined in terms of the others, but they are used so often that it is
-worth having all of them.)
+worth having them.)
@defun consp object
This function returns @code{t} if @var{object} is a cons cell, @code{nil}
@@ -241,13 +234,15 @@ This is in contrast to @code{cdr}, which signals an error if
@end defun
@defmac pop listname
-This macro is a way of examining the @sc{car} of a list,
-and taking it off the list, all at once.
+This macro provides a convenient way to examine the @sc{car} of a
+list, and take it off the list, all at once. It operates on the list
+stored in @var{listname}. It removes the first element from the list,
+saves the @sc{cdr} into @var{listname}, then returns the removed
+element.
-It operates on the list which is stored in the symbol @var{listname}.
-It removes this element from the list by setting @var{listname}
-to the @sc{cdr} of its old value---but it also returns the @sc{car}
-of that list, which is the element being removed.
+In the simplest case, @var{listname} is an unquoted symbol naming a
+list; in that case, this macro is equivalent to @w{@code{(prog1
+(car listname) (setq listname (cdr listname)))}}.
@example
x
@@ -257,6 +252,13 @@ x
x
@result{} (b c)
@end example
+
+More generally, @var{listname} can be a generalized variable. In that
+case, this macro saves into @var{listname} using @code{setf}.
+@xref{Generalized Variables}.
+
+For the @code{push} macro, which adds an element to a list,
+@xref{List Variables}.
@end defmac
@defun nth n list
@@ -372,7 +374,6 @@ making a copy of the list.
@end defun
@node Building Lists
-@comment node-name, next, previous, up
@section Building Cons Cells and Lists
@cindex cons cells
@cindex building lists
@@ -683,9 +684,12 @@ Some examples:
These functions, and one macro, provide convenient ways
to modify a list which is stored in a variable.
-@defmac push newelt listname
-This macro provides an alternative way to write
-@code{(setq @var{listname} (cons @var{newelt} @var{listname}))}.
+@defmac push element listname
+This macro creates a new list whose @sc{car} is @var{element} and
+whose @sc{cdr} is the list specified by @var{listname}, and saves that
+list in @var{listname}. In the simplest case, @var{listname} is an
+unquoted symbol naming a list, and this macro is equivalent
+to @w{@code{(setq @var{listname} (cons @var{element} @var{listname}))}}.
@example
(setq l '(a b))
@@ -695,6 +699,14 @@ This macro provides an alternative way to write
l
@result{} (c a b)
@end example
+
+More generally, @code{listname} can be a generalized variable. In
+that case, this macro does the equivalent of @w{@code{(setf
+@var{listname} (cons @var{element} @var{listname}))}}.
+@xref{Generalized Variables}.
+
+For the @code{pop} macro, which removes the first element from a list,
+@xref{List Elements}.
@end defmac
Two functions modify lists that are the values of variables.
@@ -762,8 +774,7 @@ if it already has one; otherwise, it is equivalent to @code{nil}.
The argument @var{symbol} is not implicitly quoted;
@code{add-to-ordered-list} is an ordinary function, like @code{set}
-and unlike @code{setq}. Quote the argument yourself if that is what
-you want.
+and unlike @code{setq}. Quote the argument yourself if necessary.
The ordering information is stored in a hash table on @var{symbol}'s
@code{list-order} property.
@@ -1267,8 +1278,9 @@ functions for sets include @code{memq} and @code{delq}, and their
@quotation
@b{Common Lisp note:} Common Lisp has functions @code{union} (which
avoids duplicate elements) and @code{intersection} for set operations.
-Although standard GNU Emacs Lisp does not have them, the @file{cl}
-library provides versions. @inforef{Top, Overview, cl}.
+Although standard GNU Emacs Lisp does not have them, the @file{cl-lib}
+library provides versions.
+@xref{Lists as Sets,,, cl, Common Lisp Extensions}.
@end quotation
@defun memq object list
@@ -1294,14 +1306,19 @@ compare @var{object} against the elements of the list. For example:
@defun delq object list
@cindex deleting list elements
This function destructively removes all elements @code{eq} to
-@var{object} from @var{list}. The letter @samp{q} in @code{delq} says
-that it uses @code{eq} to compare @var{object} against the elements of
-the list, like @code{memq} and @code{remq}.
+@var{object} from @var{list}, and returns the resulting list. The
+letter @samp{q} in @code{delq} says that it uses @code{eq} to compare
+@var{object} against the elements of the list, like @code{memq} and
+@code{remq}.
+
+Typically, when you invoke @code{delq}, you should use the return
+value by assigning it to the variable which held the original list.
+The reason for this is explained below.
@end defun
-When @code{delq} deletes elements from the front of the list, it does so
-simply by advancing down the list and returning a sublist that starts
-after those elements:
+The @code{delq} function deletes elements from the front of the list
+by simply advancing down the list, and returning a sublist that starts
+after those elements. For example:
@example
@group
@@ -1309,6 +1326,7 @@ after those elements:
@end group
@end example
+@noindent
When an element to be deleted appears in the middle of the list,
removing it involves changing the @sc{cdr}s (@pxref{Setcdr}).
@@ -1433,12 +1451,15 @@ Compare this with @code{memq}:
@end defun
@defun delete object sequence
-If @code{sequence} is a list, this function destructively removes all
-elements @code{equal} to @var{object} from @var{sequence}. For lists,
-@code{delete} is to @code{delq} as @code{member} is to @code{memq}: it
-uses @code{equal} to compare elements with @var{object}, like
-@code{member}; when it finds an element that matches, it cuts the
-element out just as @code{delq} would.
+This function removes all elements @code{equal} to @var{object} from
+@var{sequence}, and returns the resulting sequence.
+
+If @var{sequence} is a list, @code{delete} is to @code{delq} as
+@code{member} is to @code{memq}: it uses @code{equal} to compare
+elements with @var{object}, like @code{member}; when it finds an
+element that matches, it cuts the element out just as @code{delq}
+would. As with @code{delq}, you should typically use the return value
+by assigning it to the variable which held the original list.
If @code{sequence} is a vector or string, @code{delete} returns a copy
of @code{sequence} with all elements @code{equal} to @code{object}
@@ -1631,7 +1652,7 @@ a @sc{cdr} @code{equal} to @var{value}.
@code{rassoc} is like @code{assoc} except that it compares the @sc{cdr} of
each @var{alist} association instead of the @sc{car}. You can think of
-this as ``reverse @code{assoc},'' finding the key for a given value.
+this as ``reverse @code{assoc}'', finding the key for a given value.
@end defun
@defun assq key alist
@@ -1672,7 +1693,7 @@ a @sc{cdr} @code{eq} to @var{value}.
@code{rassq} is like @code{assq} except that it compares the @sc{cdr} of
each @var{alist} association instead of the @sc{car}. You can think of
-this as ``reverse @code{assq},'' finding the key for a given value.
+this as ``reverse @code{assq}'', finding the key for a given value.
For example:
@@ -1800,90 +1821,3 @@ often modifies the original list structure of @var{alist}.
compares the @sc{cdr} of each @var{alist} association instead of the
@sc{car}.
@end defun
-
-@node Rings
-@section Managing a Fixed-Size Ring of Objects
-
-@cindex ring data structure
- This section describes functions for operating on rings. A
-@dfn{ring} is a fixed-size data structure that supports insertion,
-deletion, rotation, and modulo-indexed reference and traversal.
-
-@defun make-ring size
-This returns a new ring capable of holding @var{size} objects.
-@var{size} should be an integer.
-@end defun
-
-@defun ring-p object
-This returns @code{t} if @var{object} is a ring, @code{nil} otherwise.
-@end defun
-
-@defun ring-size ring
-This returns the maximum capacity of the @var{ring}.
-@end defun
-
-@defun ring-length ring
-This returns the number of objects that @var{ring} currently contains.
-The value will never exceed that returned by @code{ring-size}.
-@end defun
-
-@defun ring-elements ring
-This returns a list of the objects in @var{ring}, in order, newest first.
-@end defun
-
-@defun ring-copy ring
-This returns a new ring which is a copy of @var{ring}.
-The new ring contains the same (@code{eq}) objects as @var{ring}.
-@end defun
-
-@defun ring-empty-p ring
-This returns @code{t} if @var{ring} is empty, @code{nil} otherwise.
-@end defun
-
- The newest element in the ring always has index 0. Higher indices
-correspond to older elements. Indices are computed modulo the ring
-length. Index @minus{}1 corresponds to the oldest element, @minus{}2
-to the next-oldest, and so forth.
-
-@defun ring-ref ring index
-This returns the object in @var{ring} found at index @var{index}.
-@var{index} may be negative or greater than the ring length. If
-@var{ring} is empty, @code{ring-ref} signals an error.
-@end defun
-
-@defun ring-insert ring object
-This inserts @var{object} into @var{ring}, making it the newest
-element, and returns @var{object}.
-
-If the ring is full, insertion removes the oldest element to
-make room for the new element.
-@end defun
-
-@defun ring-remove ring &optional index
-Remove an object from @var{ring}, and return that object. The
-argument @var{index} specifies which item to remove; if it is
-@code{nil}, that means to remove the oldest item. If @var{ring} is
-empty, @code{ring-remove} signals an error.
-@end defun
-
-@defun ring-insert-at-beginning ring object
-This inserts @var{object} into @var{ring}, treating it as the oldest
-element. The return value is not significant.
-
-If the ring is full, this function removes the newest element to make
-room for the inserted element.
-@end defun
-
-@cindex fifo data structure
- If you are careful not to exceed the ring size, you can
-use the ring as a first-in-first-out queue. For example:
-
-@lisp
-(let ((fifo (make-ring 5)))
- (mapc (lambda (obj) (ring-insert fifo obj))
- '(0 one "two"))
- (list (ring-remove fifo) t
- (ring-remove fifo) t
- (ring-remove fifo)))
- @result{} (0 t one t "two")
-@end lisp
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index ca233ac5f21..9ca5314d790 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -1,18 +1,18 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/loading
-@node Loading, Byte Compilation, Customization, Top
+@node Loading
@chapter Loading
@cindex loading
@cindex library
@cindex Lisp library
- Loading a file of Lisp code means bringing its contents into the Lisp
-environment in the form of Lisp objects. Emacs finds and opens the
-file, reads the text, evaluates each form, and then closes the file.
+ Loading a file of Lisp code means bringing its contents into the
+Lisp environment in the form of Lisp objects. Emacs finds and opens
+the file, reads the text, evaluates each form, and then closes the
+file. Such a file is also called a @dfn{Lisp library}.
The load functions evaluate all the expressions in a file just
as the @code{eval-buffer} function evaluates all the
@@ -29,11 +29,6 @@ into a buffer and evaluated there. (Indeed, most code is tested this
way.) Most often, the forms are function definitions and variable
definitions.
- A file containing Lisp code is often called a @dfn{library}. Thus,
-the ``Rmail library'' is a file containing code for Rmail mode.
-Similarly, a ``Lisp library directory'' is a directory of files
-containing Lisp code.
-
@menu
* How Programs Do Loading:: The @code{load} function and others.
* Load Suffixes:: Details about the suffixes that @code{load} tries.
@@ -88,8 +83,8 @@ this case, you must specify the precise file name you want, except
that, if Auto Compression mode is enabled, @code{load} will still use
@code{jka-compr-load-suffixes} to find compressed versions. By
specifying the precise file name and using @code{t} for
-@var{nosuffix}, you can prevent perverse file names such as
-@file{foo.el.el} from being tried.
+@var{nosuffix}, you can prevent file names like @file{foo.el.el} from
+being tried.
If the optional argument @var{must-suffix} is non-@code{nil}, then
@code{load} insists that the file name used must end in either
@@ -118,6 +113,25 @@ When loading a source file (not compiled), @code{load} performs
character set translation just as Emacs would do when visiting the file.
@xref{Coding Systems}.
+@c This is referred to from the Macros chapter.
+@c Not sure if it should be the other way round.
+@cindex eager macro expansion
+When loading an uncompiled file, Emacs tries to expand any macros
+that the file contains (@pxref{Macros}). We refer to this as
+@dfn{eager macro expansion}. Doing this (rather than deferring
+the expansion until the relevant code runs) can significantly speed
+up the execution of uncompiled code. Sometimes, this macro expansion
+cannot be done, owing to a cyclic dependency. In the simplest
+example of this, the file you are loading refers to a macro defined
+in another file, and that file in turn requires the file you are
+loading. This is generally harmless. Emacs prints a warning
+(@samp{Eager macro-expansion skipped due to cycle@dots{}})
+giving details of the problem, but it still loads the file, just
+leaving the macro unexpanded for now. You may wish to restructure
+your code so that this does not happen. Loading a compiled file does
+not cause macroexpansion, because this should already have happened
+during compilation. @xref{Compiling Macros}.
+
Messages like @samp{Loading foo...} and @samp{Loading foo...done} appear
in the echo area during loading unless @var{nomessage} is
non-@code{nil}.
@@ -238,114 +252,88 @@ it skips the latter group.
When Emacs loads a Lisp library, it searches for the library
in a list of directories specified by the variable @code{load-path}.
-@defopt load-path
-@cindex @code{EMACSLOADPATH} environment variable
+@defvar load-path
+@cindex @env{EMACSLOADPATH} environment variable
The value of this variable is a list of directories to search when
loading files with @code{load}. Each element is a string (which must be
a directory name) or @code{nil} (which stands for the current working
directory).
-@end defopt
-
- The value of @code{load-path} is initialized from the environment
-variable @code{EMACSLOADPATH}, if that exists; otherwise its default
-value is specified in @file{emacs/src/epaths.h} when Emacs is built.
-Then the list is expanded by adding subdirectories of the directories
-in the list.
-
- The syntax of @code{EMACSLOADPATH} is the same as used for @code{PATH};
-@samp{:} (or @samp{;}, according to the operating system) separates
-directory names, and @samp{.} is used for the current default directory.
-Here is an example of how to set your @code{EMACSLOADPATH} variable from
-a @code{csh} @file{.login} file:
-
-@smallexample
-setenv EMACSLOADPATH .:/user/bil/emacs:/usr/local/share/emacs/20.3/lisp
-@end smallexample
+@end defvar
- Here is how to set it using @code{sh}:
+ Each time Emacs starts up, it sets up the value of @code{load-path}
+in several steps. First, it initializes @code{load-path} to the
+directories specified by the environment variable @env{EMACSLOADPATH},
+if that exists. The syntax of @env{EMACSLOADPATH} is the same as used
+for @code{PATH}; directory names are separated by @samp{:} (or
+@samp{;}, on some operating systems), and @samp{.} stands for the
+current default directory. Here is an example of how to set
+@env{EMACSLOADPATH} variable from @command{sh}:
-@smallexample
+@example
export EMACSLOADPATH
-EMACSLOADPATH=.:/user/bil/emacs:/usr/local/share/emacs/20.3/lisp
-@end smallexample
+EMACSLOADPATH=/home/foo/.emacs.d/lisp:/opt/emacs/lisp
+@end example
- Here is an example of code you can place in your init file (@pxref{Init
-File}) to add several directories to the front of your default
-@code{load-path}:
+@noindent
+Here is how to set it from @code{csh}:
-@smallexample
-@group
-(setq load-path
- (append (list nil "/user/bil/emacs"
- "/usr/local/lisplib"
- "~/emacs")
- load-path))
-@end group
-@end smallexample
+@example
+setenv EMACSLOADPATH /home/foo/.emacs.d/lisp:/opt/emacs/lisp
+@end example
-@c Wordy to rid us of an overfull hbox. --rjc 15mar92
-@noindent
-In this example, the path searches the current working directory first,
-followed then by the @file{/user/bil/emacs} directory, the
-@file{/usr/local/lisplib} directory, and the @file{~/emacs} directory,
-which are then followed by the standard directories for Lisp code.
-
- Dumping Emacs uses a special value of @code{load-path}. If the value of
-@code{load-path} at the end of dumping is unchanged (that is, still the
-same special value), the dumped Emacs switches to the ordinary
-@code{load-path} value when it starts up, as described above. But if
-@code{load-path} has any other value at the end of dumping, that value
-is used for execution of the dumped Emacs also.
-
- Therefore, if you want to change @code{load-path} temporarily for
-loading a few libraries in @file{site-init.el} or @file{site-load.el},
-you should bind @code{load-path} locally with @code{let} around the
-calls to @code{load}.
-
- The default value of @code{load-path}, when running an Emacs which has
-been installed on the system, includes two special directories (and
-their subdirectories as well):
+@cindex site-lisp directories
+ If @env{EMACSLOADPATH} is not set (which is usually the case), Emacs
+initializes @code{load-path} with the following two directories:
-@smallexample
+@example
"/usr/local/share/emacs/@var{version}/site-lisp"
-@end smallexample
+@end example
@noindent
and
-@smallexample
+@example
"/usr/local/share/emacs/site-lisp"
-@end smallexample
+@end example
@noindent
The first one is for locally installed packages for a particular Emacs
-version; the second is for locally installed packages meant for use with
-all installed Emacs versions.
-
- There are several reasons why a Lisp package that works well in one
-Emacs version can cause trouble in another. Sometimes packages need
-updating for incompatible changes in Emacs; sometimes they depend on
-undocumented internal Emacs data that can change without notice;
-sometimes a newer Emacs version incorporates a version of the package,
-and should be used only with that version.
-
- Emacs finds these directories' subdirectories and adds them to
-@code{load-path} when it starts up. Both immediate subdirectories and
-subdirectories multiple levels down are added to @code{load-path}.
-
- Not all subdirectories are included, though. Subdirectories whose
-names do not start with a letter or digit are excluded. Subdirectories
-named @file{RCS} or @file{CVS} are excluded. Also, a subdirectory which
-contains a file named @file{.nosearch} is excluded. You can use these
-methods to prevent certain subdirectories of the @file{site-lisp}
-directories from being searched.
+version; the second is for locally installed packages meant for use
+with all installed Emacs versions.
If you run Emacs from the directory where it was built---that is, an
-executable that has not been formally installed---then @code{load-path}
-normally contains two additional directories. These are the @code{lisp}
-and @code{site-lisp} subdirectories of the main build directory. (Both
+executable that has not been formally installed---Emacs puts two more
+directories in @code{load-path}. These are the @code{lisp} and
+@code{site-lisp} subdirectories of the main build directory. (Both
are represented as absolute file names.)
+ Next, Emacs ``expands'' the initial list of directories in
+@code{load-path} by adding the subdirectories of those directories.
+Both immediate subdirectories and subdirectories multiple levels down
+are added. But it excludes subdirectories whose names do not start
+with a letter or digit, and subdirectories named @file{RCS} or
+@file{CVS}, and subdirectories containing a file named
+@file{.nosearch}.
+
+ Next, Emacs adds any extra load directory that you specify using the
+@samp{-L} command-line option (@pxref{Action Arguments,,,emacs, The
+GNU Emacs Manual}). It also adds the directories where optional
+packages are installed, if any (@pxref{Packaging Basics}).
+
+ It is common to add code to one's init file (@pxref{Init File}) to
+add one or more directories to @code{load-path}. For example:
+
+@example
+(push "~/.emacs.d/lisp" load-path)
+@end example
+
+ Dumping Emacs uses a special value of @code{load-path}. If the
+value of @code{load-path} at the end of dumping is unchanged (that is,
+still the same special value), the dumped Emacs switches to the
+ordinary @code{load-path} value when it starts up, as described above.
+But if @code{load-path} has any other value at the end of dumping,
+that value is used for execution of the dumped Emacs also.
+
@deffn Command locate-library library &optional nosuffix path interactive-call
This command finds the precise file name for library @var{library}. It
searches for the library in the same way @code{load} does, and the
@@ -371,9 +359,9 @@ similarly-named file in a directory earlier on @code{load-path}.
For instance, suppose @code{load-path} is set to
-@smallexample
+@example
("/opt/emacs/site-lisp" "/usr/share/emacs/23.3/lisp")
-@end smallexample
+@end example
@noindent
and that both these directories contain a file named @file{foo.el}.
@@ -401,30 +389,27 @@ example) is read without decoding, the text of the program will be
unibyte text, and its string constants will be unibyte strings.
@xref{Coding Systems}.
- The reason Emacs is designed this way is so that Lisp programs give
-predictable results, regardless of how Emacs was started. In addition,
-this enables programs that depend on using multibyte text to work even
-in a unibyte Emacs.
-
- In most Emacs Lisp programs, the fact that non-@acronym{ASCII} strings are
-multibyte strings should not be noticeable, since inserting them in
-unibyte buffers converts them to unibyte automatically. However, if
-this does make a difference, you can force a particular Lisp file to be
-interpreted as unibyte by writing @samp{-*-unibyte: t;-*-} in a
-comment on the file's first line. With that designator, the file will
-unconditionally be interpreted as unibyte, even in an ordinary
-multibyte Emacs session. This can matter when making keybindings to
+ In most Emacs Lisp programs, the fact that non-@acronym{ASCII}
+strings are multibyte strings should not be noticeable, since
+inserting them in unibyte buffers converts them to unibyte
+automatically. However, if this does make a difference, you can force
+a particular Lisp file to be interpreted as unibyte by writing
+@samp{coding: raw-text} in a local variables section. With
+that designator, the file will unconditionally be interpreted as
+unibyte. This can matter when making keybindings to
non-@acronym{ASCII} characters written as @code{?v@var{literal}}.
@node Autoload
@section Autoload
@cindex autoload
- The @dfn{autoload} facility allows you to make a function or macro
-known in Lisp, but put off loading the file that defines it. The first
-call to the function automatically reads the proper file to install the
-real definition and other associated code, then runs the real definition
-as if it had been loaded all along.
+ The @dfn{autoload} facility lets you register the existence of a
+function or macro, but put off loading the file that defines it. The
+first call to the function automatically loads the proper library, in
+order to install the real definition and other associated code, then
+runs the real definition as if it had been loaded all along.
+Autoloading can also be triggered by looking up the documentation of
+the function or macro (@pxref{Documentation Basics}).
There are two ways to set up an autoloaded function: by calling
@code{autoload}, and by writing a special ``magic'' comment in the
@@ -442,9 +427,9 @@ to load automatically from @var{filename}. The string @var{filename}
specifies the file to load to get the real definition of @var{function}.
If @var{filename} does not contain either a directory name, or the
-suffix @code{.el} or @code{.elc}, then @code{autoload} insists on adding
-one of these suffixes, and it will not load from a file whose name is
-just @var{filename} with no added suffix. (The variable
+suffix @code{.el} or @code{.elc}, this function insists on adding one
+of these suffixes, and it will not load from a file whose name is just
+@var{filename} with no added suffix. (The variable
@code{load-suffixes} specifies the exact required suffixes.)
The argument @var{docstring} is the documentation string for the
@@ -476,10 +461,11 @@ and calls @code{define-key}; not even if the variable name is the same
symbol @var{function}.
@cindex function cell in autoload
-If @var{function} already has a non-void function definition that is not
-an autoload object, @code{autoload} does nothing and returns @code{nil}.
-If the function cell of @var{function} is void, or is already an autoload
-object, then it is defined as an autoload object like this:
+if @var{function} already has non-void function definition that is not
+an autoload object, this function does nothing and returns @code{nil}.
+Otherwise, it constructs an autoload object (@pxref{Autoload Type}),
+and stores it as the function definition for @var{function}. The
+autoload object has this form:
@example
(autoload @var{filename} @var{docstring} @var{interactive} @var{type})
@@ -502,6 +488,16 @@ refers to the documentation string in the
not a macro or a keymap.
@end defun
+@defun autoloadp object
+This function returns non-@code{nil} if @var{object} is an autoload
+object. For example, to check if @code{run-prolog} is defined as an
+autoloaded function, evaluate
+
+@smallexample
+(autoloadp (symbol-function 'run-prolog))
+@end smallexample
+@end defun
+
@cindex autoload errors
The autoloaded file usually contains other definitions and may require
or provide one or more features. If the file is not completely loaded
@@ -535,14 +531,31 @@ Building Emacs loads @file{loaddefs.el} and thus calls @code{autoload}.
autoloads for all files in the current directory.
The same magic comment can copy any kind of form into
-@file{loaddefs.el}. If the form following the magic comment is not a
-function-defining form or a @code{defcustom} form, it is copied
-verbatim. ``Function-defining forms'' include @code{define-skeleton},
-@code{define-derived-mode}, @code{define-generic-mode} and
-@code{define-minor-mode} as well as @code{defun} and
-@code{defmacro}. To save space, a @code{defcustom} form is converted to
-a @code{defvar} in @file{loaddefs.el}, with some additional information
-if it uses @code{:require}.
+@file{loaddefs.el}. The form following the magic comment is copied
+verbatim, @emph{except} if it is one of the forms which the autoload
+facility handles specially (e.g.@: by conversion into an
+@code{autoload} call). The forms which are not copied verbatim are
+the following:
+
+@table @asis
+@item Definitions for function or function-like objects:
+@code{defun} and @code{defmacro}; also @code{cl-defun} and
+@code{cl-defmacro} (@pxref{Argument Lists,,,cl,Common Lisp Extensions}),
+and @code{define-overloadable-function} (see the commentary in
+@file{mode-local.el}).
+
+@item Definitions for major or minor modes:
+@code{define-minor-mode}, @code{define-globalized-minor-mode},
+@code{define-generic-mode}, @code{define-derived-mode},
+@code{easy-mmode-define-minor-mode},
+@code{easy-mmode-define-global-mode}, @code{define-compilation-mode},
+and @code{define-global-minor-mode}.
+
+@item Other definition types:
+@code{defcustom}, @code{defgroup}, @code{defclass}
+(@pxref{Top,EIEIO,,eieio,EIEIO}), and @code{define-skeleton} (see the
+commentary in @file{skeleton.el}).
+@end table
You can also use a magic comment to execute a form at build time
@emph{without} executing it when the file itself is loaded. To do this,
@@ -554,24 +567,24 @@ it is executed while building Emacs.
The following example shows how @code{doctor} is prepared for
autoloading with a magic comment:
-@smallexample
+@example
;;;###autoload
(defun doctor ()
"Switch to *doctor* buffer and start giving psychotherapy."
(interactive)
(switch-to-buffer "*doctor*")
(doctor-mode))
-@end smallexample
+@end example
@noindent
Here's what that produces in @file{loaddefs.el}:
-@smallexample
+@example
(autoload (quote doctor) "doctor" "\
Switch to *doctor* buffer and start giving psychotherapy.
\(fn)" t nil)
-@end smallexample
+@end example
@noindent
@cindex @code{fn} in function's documentation string
@@ -590,11 +603,11 @@ ordinary magic autoload comment would copy the whole definition into
@code{loaddefs.el}. That is not desirable. You can put the desired
@code{autoload} call into @code{loaddefs.el} instead by writing this:
-@smallexample
+@example
;;;###autoload (autoload 'foo "myfile")
(mydefunmacro foo
...)
-@end smallexample
+@end example
You can use a non-default string as the autoload cookie and have the
corresponding autoload calls written into a file whose name is
@@ -616,6 +629,19 @@ override that, e.g., in the ``Local Variables'' section of a
assumed to contain a trailer starting with a formfeed character.
@end defvar
+ The following function may be used to explicitly load the library
+specified by an autoload object:
+
+@defun autoload-do-load autoload &optional name macro-only
+This function performs the loading specified by @var{autoload}, which
+should be an autoload object. The optional argument @var{name}, if
+non-@code{nil}, should be a symbol whose function value is
+@var{autoload}; in that case, the return value of this function is the
+symbol's new function value. If the value of the optional argument
+@var{macro-only} is @code{macro}, this function avoids loading a
+function, only a macro.
+@end defun
+
@node Repeated Loading
@section Repeated Loading
@cindex repeated loading
@@ -696,29 +722,35 @@ already. If not, it loads the feature from the appropriate file. This
file should call @code{provide} at the top level to add the feature to
@code{features}; if it fails to do so, @code{require} signals an error.
- For example, in @file{emacs/lisp/prolog.el},
-the definition for @code{run-prolog} includes the following code:
+ For example, in @file{idlwave.el}, the definition for
+@code{idlwave-complete-filename} includes the following code:
-@smallexample
-(defun run-prolog ()
- "Run an inferior Prolog process, with I/O via buffer *prolog*."
- (interactive)
- (require 'comint)
- (switch-to-buffer (make-comint "prolog" prolog-program-name))
- (inferior-prolog-mode))
-@end smallexample
+@example
+(defun idlwave-complete-filename ()
+ "Use the comint stuff to complete a file name."
+ (require 'comint)
+ (let* ((comint-file-name-chars "~/A-Za-z0-9+@@:_.$#%=@{@}\\-")
+ (comint-completion-addsuffix nil)
+ ...)
+ (comint-dynamic-complete-filename)))
+@end example
@noindent
The expression @code{(require 'comint)} loads the file @file{comint.el}
-if it has not yet been loaded. This ensures that @code{make-comint} is
-defined. Features are normally named after the files that provide them,
-so that @code{require} need not be given the file name.
+if it has not yet been loaded, ensuring that
+@code{comint-dynamic-complete-filename} is defined. Features are
+normally named after the files that provide them, so that
+@code{require} need not be given the file name. (Note that it is
+important that the @code{require} statement be outside the body of the
+@code{let}. Loading a library while its variables are let-bound can
+have unintended consequences, namely the variables becoming unbound
+after the let exits.)
The @file{comint.el} file contains the following top-level expression:
-@smallexample
+@example
(provide 'comint)
-@end smallexample
+@end example
@noindent
This adds @code{comint} to the global @code{features} list, so that
@@ -739,13 +771,13 @@ ensure that a file of definitions is loaded before it is byte-compiled
by including a @code{provide} followed by a @code{require} for the same
feature, as in the following example.
-@smallexample
+@example
@group
(provide 'my-feature) ; @r{Ignored by byte compiler,}
; @r{evaluated by @code{load}.}
(require 'my-feature) ; @r{Evaluated by byte compiler.}
@end group
-@end smallexample
+@end example
@noindent
The compiler ignores the @code{provide}, then processes the
@@ -775,7 +807,7 @@ package, which might or might not be loaded, or might or might not be
present in a given version. @xref{Network Feature Testing}, for
an example.
-@smallexample
+@example
features
@result{} (bar bish)
@@ -783,7 +815,7 @@ features
@result{} foo
features
@result{} (foo bar bish)
-@end smallexample
+@end example
When a file is loaded to satisfy an autoload, and it stops due to an
error in the evaluation of its contents, any function definitions or
@@ -908,8 +940,8 @@ It then restores any autoloads formerly associated with those symbols.
Before restoring the previous definitions, @code{unload-feature} runs
@code{remove-hook} to remove functions in the library from certain
-hooks. These hooks include variables whose names end in @samp{hook}
-or @samp{-hooks}, plus those listed in
+hooks. These hooks include variables whose names end in @samp{-hook}
+(or the deprecated suffix @samp{-hooks}), plus those listed in
@code{unload-feature-special-hooks}, as well as
@code{auto-mode-alist}. This is to prevent Emacs from ceasing to
function because important hooks refer to functions that are no longer
diff --git a/doc/lispref/locals.texi b/doc/lispref/locals.texi
deleted file mode 100644
index a196efc9734..00000000000
--- a/doc/lispref/locals.texi
+++ /dev/null
@@ -1,217 +0,0 @@
-@c -*-texinfo-*-
-@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1993, 1999, 2001-2011 Free Software Foundation, Inc.
-@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/locals
-@node Standard Buffer-Local Variables, Standard Keymaps, Standard Errors, Top
-@appendix Buffer-Local Variables
-@c The title "Standard Buffer-Local Variables" is too long for
-@c smallbook. --rjc 30mar92
-@cindex buffer-local variables, general-purpose
-@cindex standard buffer-local variables
-
- The table below lists the general-purpose Emacs variables that
-automatically become buffer-local in each buffer. Most become
-buffer-local only when set; a few of them are always local in every
-buffer. Many Lisp packages define such variables for their internal
-use, but we don't try to list them all here.
-
- Every buffer-specific minor mode defines a buffer-local variable
-named @samp{@var{modename}-mode}. @xref{Minor Mode Conventions}.
-Minor mode variables will not be listed here.
-
-@table @code
-@item auto-fill-function
-@xref{Auto Filling}.
-
-@item buffer-auto-save-file-format
-@xref{Format Conversion}.
-
-@item buffer-auto-save-file-name
-@xref{Auto-Saving}.
-
-@item buffer-backed-up
-@xref{Making Backups}.
-
-@item buffer-display-count
-@xref{Buffers and Windows}.
-
-@item buffer-display-table
-@xref{Active Display Table}.
-
-@item buffer-display-time
-@xref{Buffers and Windows}.
-
-@item buffer-file-coding-system
-@xref{Encoding and I/O}.
-
-@item buffer-file-format
-@xref{Format Conversion}.
-
-@item buffer-file-name
-@xref{Buffer File Name}.
-
-@item buffer-file-number
-@xref{Buffer File Name}.
-
-@item buffer-file-truename
-@xref{Buffer File Name}.
-
-@item buffer-file-type
-@xref{MS-DOS File Types}.
-
-@item buffer-invisibility-spec
-@xref{Invisible Text}.
-
-@item buffer-offer-save
-@xref{Killing Buffers}.
-
-@item buffer-save-without-query
-@xref{Killing Buffers}.
-
-@item buffer-read-only
-@xref{Read Only Buffers}.
-
-@item buffer-saved-size
-@xref{Auto-Saving}.
-
-@item buffer-undo-list
-@xref{Undo}.
-
-@item cache-long-line-scans
-@xref{Truncation}.
-
-@item case-fold-search
-@xref{Searching and Case}.
-
-@item comment-column
-@xref{Comments,,, emacs, The GNU Emacs Manual}.
-
-@item ctl-arrow
-@xref{Usual Display}.
-
-@item cursor-in-non-selected-windows
-@xref{Basic Windows}.
-
-@item cursor-type
-@xref{Cursor Parameters}.
-
-@item default-directory
-@xref{File Name Expansion}.
-
-@item defun-prompt-regexp
-@xref{List Motion}.
-
-@item desktop-save-buffer
-@xref{Desktop Save Mode}.
-
-@item enable-multibyte-characters
-@ref{Text Representations}.
-
-@item fill-column
-@xref{Margins}.
-
-@item fill-prefix
-@xref{Margins}.
-
-@item font-lock-defaults
-@xref{Font Lock Basics}.
-
-@item fringe-cursor-alist
-@xref{Fringe Cursors}.
-
-@item fringe-indicator-alist
-@xref{Fringe Indicators}.
-
-@item fringes-outside-margins
-@xref{Fringes}.
-
-@item goal-column
-@xref{Moving Point,,, emacs, The GNU Emacs Manual}.
-
-@item header-line-format
-@xref{Header Lines}.
-
-@item indicate-buffer-boundaries
-@xref{Usual Display}.
-
-@item indicate-empty-lines
-@xref{Usual Display}.
-
-@item left-fringe-width
-@xref{Fringe Size/Pos}.
-
-@item left-margin
-@xref{Margins}.
-
-@item left-margin-width
-@xref{Display Margins}.
-
-@item line-spacing
-@xref{Line Height}.
-
-@item local-abbrev-table
-@xref{Standard Abbrev Tables}.
-
-@item major-mode
-@xref{Mode Help}.
-
-@item mark-active
-@xref{The Mark}.
-
-@item mark-ring
-@xref{The Mark}.
-
-@item mode-line-buffer-identification
-@xref{Mode Line Variables}.
-
-@item mode-line-format
-@xref{Mode Line Data}.
-
-@item mode-line-modified
-@xref{Mode Line Variables}.
-
-@item mode-line-process
-@xref{Mode Line Variables}.
-
-@item mode-name
-@xref{Mode Line Variables}.
-
-@item point-before-scroll
-Used for communication between mouse commands and scroll-bar commands.
-
-@item right-fringe-width
-@xref{Fringe Size/Pos}.
-
-@item right-margin-width
-@xref{Display Margins}.
-
-@item save-buffer-coding-system
-@xref{Encoding and I/O}.
-
-@item scroll-bar-width
-@xref{Scroll Bars}.
-
-@item scroll-down-aggressively
-@itemx scroll-up-aggressively
-@xref{Textual Scrolling}.
-
-@item selective-display
-@itemx selective-display-ellipses
-@xref{Selective Display}.
-
-@item tab-width
-@xref{Usual Display}.
-
-@item truncate-lines
-@xref{Truncation}.
-
-@item vertical-scroll-bar
-@xref{Scroll Bars}.
-
-@item window-size-fixed
-@xref{Resizing Windows}.
-
-@item write-contents-functions
-@xref{Saving Buffers}.
-@end table
diff --git a/doc/lispref/macros.texi b/doc/lispref/macros.texi
index c66feec08b7..b0dee1bf215 100644
--- a/doc/lispref/macros.texi
+++ b/doc/lispref/macros.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/macros
-@node Macros, Customization, Functions, Top
+@node Macros
@chapter Macros
@cindex macros
@@ -27,7 +26,6 @@ instead. @xref{Inline Functions}.
* Expansion:: How, when and why macros are expanded.
* Compiling Macros:: How macros are expanded by the compiler.
* Defining Macros:: How to write a macro definition.
-* Backquote:: Easier construction of list structure.
* Problems with Macros:: Don't evaluate the macro arguments too many times.
Don't hide the user's variables.
* Indenting Macros:: Specifying how to indent macro calls.
@@ -78,10 +76,9 @@ to the argument values from the macro call, or to a list of them in the
case of a @code{&rest} argument. And the macro body executes and
returns its value just as a function body does.
- The second crucial difference between macros and functions is that the
-value returned by the macro body is not the value of the macro call.
-Instead, it is an alternate expression for computing that value, also
-known as the @dfn{expansion} of the macro. The Lisp interpreter
+ The second crucial difference between macros and functions is that
+the value returned by the macro body is an alternate Lisp expression,
+also known as the @dfn{expansion} of the macro. The Lisp interpreter
proceeds to evaluate the expansion as soon as it comes back from the
macro.
@@ -89,6 +86,10 @@ macro.
calls to other macros. It may even be a call to the same macro, though
this is unusual.
+ Note that Emacs tries to expand macros when loading an uncompiled
+Lisp file. This is not always possible, but if it is, it speeds up
+subsequent execution. @xref{How Programs Do Loading}.
+
You can see the expansion of a given macro call by calling
@code{macroexpand}.
@@ -112,11 +113,10 @@ If @var{environment} is provided, it specifies an alist of macro
definitions that shadow the currently defined macros. Byte compilation
uses this feature.
-@smallexample
+@example
@group
(defmacro inc (var)
(list 'setq var (list '1+ var)))
- @result{} inc
@end group
@group
@@ -127,14 +127,13 @@ uses this feature.
@group
(defmacro inc2 (var1 var2)
(list 'progn (list 'inc var1) (list 'inc var2)))
- @result{} inc2
@end group
@group
(macroexpand '(inc2 r s))
@result{} (progn (inc r) (inc s)) ; @r{@code{inc} not expanded here.}
@end group
-@end smallexample
+@end example
@end defun
@@ -148,10 +147,10 @@ Repeating the example used for @code{macroexpand} above with
@code{macroexpand-all}, we see that @code{macroexpand-all} @emph{does}
expand the embedded calls to @code{inc}:
-@smallexample
+@example
(macroexpand-all '(inc2 r s))
@result{} (progn (setq r (1+ r)) (setq s (1+ s)))
-@end smallexample
+@end example
@end defun
@@ -190,117 +189,44 @@ During Compile}).
@node Defining Macros
@section Defining Macros
- A Lisp macro is a list whose @sc{car} is @code{macro}. Its @sc{cdr} should
-be a function; expansion of the macro works by applying the function
-(with @code{apply}) to the list of unevaluated argument-expressions
-from the macro call.
+ A Lisp macro object is a list whose @sc{car} is @code{macro}, and
+whose @sc{cdr} is a lambda expression. Expansion of the macro works
+by applying the lambda expression (with @code{apply}) to the list of
+@emph{unevaluated} arguments from the macro call.
It is possible to use an anonymous Lisp macro just like an anonymous
-function, but this is never done, because it does not make sense to pass
-an anonymous macro to functionals such as @code{mapcar}. In practice,
-all Lisp macros have names, and they are usually defined with the
-special form @code{defmacro}.
+function, but this is never done, because it does not make sense to
+pass an anonymous macro to functionals such as @code{mapcar}. In
+practice, all Lisp macros have names, and they are almost always
+defined with the @code{defmacro} macro.
-@defspec defmacro name argument-list body-forms@dots{}
-@code{defmacro} defines the symbol @var{name} as a macro that looks
-like this:
+@defmac defmacro name args [doc] [declare] body@dots{}
+@code{defmacro} defines the symbol @var{name} (which should not be
+quoted) as a macro that looks like this:
@example
-(macro lambda @var{argument-list} . @var{body-forms})
+(macro lambda @var{args} . @var{body})
@end example
-(Note that the @sc{cdr} of this list is a function---a lambda expression.)
-This macro object is stored in the function cell of @var{name}. The
-value returned by evaluating the @code{defmacro} form is @var{name}, but
-usually we ignore this value.
-
-The shape and meaning of @var{argument-list} is the same as in a
-function, and the keywords @code{&rest} and @code{&optional} may be used
-(@pxref{Argument List}). Macros may have a documentation string, but
-any @code{interactive} declaration is ignored since macros cannot be
-called interactively.
-@end defspec
-
- The body of the macro definition can include a @code{declare} form,
-which can specify how @key{TAB} should indent macro calls, and how to
-step through them for Edebug.
-
-@defmac declare @var{specs}@dots{}
-@anchor{Definition of declare}
-A @code{declare} form is used in a macro definition to specify various
-additional information about it. Two kinds of specification are
-currently supported:
-
-@table @code
-@item (debug @var{edebug-form-spec})
-Specify how to step through macro calls for Edebug.
-@xref{Instrumenting Macro Calls}.
-
-@item (indent @var{indent-spec})
-Specify how to indent calls to this macro. @xref{Indenting Macros},
-for more details.
-@end table
-
-A @code{declare} form only has its special effect in the body of a
-@code{defmacro} form if it immediately follows the documentation
-string, if present, or the argument list otherwise. (Strictly
-speaking, @emph{several} @code{declare} forms can follow the
-documentation string or argument list, but since a @code{declare} form
-can have several @var{specs}, they can always be combined into a
-single form.) When used at other places in a @code{defmacro} form, or
-outside a @code{defmacro} form, @code{declare} just returns @code{nil}
-without evaluating any @var{specs}.
+(Note that the @sc{cdr} of this list is a lambda expression.) This
+macro object is stored in the function cell of @var{name}. The
+meaning of @var{args} is the same as in a function, and the keywords
+@code{&rest} and @code{&optional} may be used (@pxref{Argument List}).
+Neither @var{name} nor @var{args} should be quoted. The return value
+of @code{defmacro} is undefined.
+
+@var{doc}, if present, should be a string specifying the macro's
+documentation string. @var{declare}, if present, should be a
+@code{declare} form specifying metadata for the macro (@pxref{Declare
+Form}). Note that macros cannot have interactive declarations, since
+they cannot be called interactively.
@end defmac
- No macro absolutely needs a @code{declare} form, because that form
-has no effect on how the macro expands, on what the macro means in the
-program. It only affects secondary features: indentation and Edebug.
-
-@node Backquote
-@section Backquote
-@cindex backquote (list substitution)
-@cindex ` (list substitution)
-@findex `
-
- Macros often need to construct large list structures from a mixture of
-constants and nonconstant parts. To make this easier, use the @samp{`}
-syntax (usually called @dfn{backquote}).
-
- Backquote allows you to quote a list, but selectively evaluate
-elements of that list. In the simplest case, it is identical to the
-special form @code{quote} (@pxref{Quoting}). For example, these
-two forms yield identical results:
+ Macros often need to construct large list structures from a mixture
+of constants and nonconstant parts. To make this easier, use the
+@samp{`} syntax (@pxref{Backquote}). For example:
@example
-@group
-`(a list of (+ 2 3) elements)
- @result{} (a list of (+ 2 3) elements)
-@end group
-@group
-'(a list of (+ 2 3) elements)
- @result{} (a list of (+ 2 3) elements)
-@end group
-@end example
-
-@findex , @r{(with backquote)}
-The special marker @samp{,} inside of the argument to backquote
-indicates a value that isn't constant. Backquote evaluates the
-argument of @samp{,} and puts the value in the list structure:
-
-@example
-@group
-(list 'a 'list 'of (+ 2 3) 'elements)
- @result{} (a list of 5 elements)
-@end group
-@group
-`(a list of ,(+ 2 3) elements)
- @result{} (a list of 5 elements)
-@end group
-@end example
-
- Substitution with @samp{,} is allowed at deeper levels of the list
-structure also. For example:
-
@example
@group
(defmacro t-becomes-nil (variable)
@@ -313,50 +239,17 @@ structure also. For example:
@equiv{} (if (eq foo t) (setq foo nil))
@end group
@end example
-
-@findex ,@@ @r{(with backquote)}
-@cindex splicing (with backquote)
- You can also @dfn{splice} an evaluated value into the resulting list,
-using the special marker @samp{,@@}. The elements of the spliced list
-become elements at the same level as the other elements of the resulting
-list. The equivalent code without using @samp{`} is often unreadable.
-Here are some examples:
-
-@example
-@group
-(setq some-list '(2 3))
- @result{} (2 3)
-@end group
-@group
-(cons 1 (append some-list '(4) some-list))
- @result{} (1 2 3 4 2 3)
-@end group
-@group
-`(1 ,@@some-list 4 ,@@some-list)
- @result{} (1 2 3 4 2 3)
-@end group
-
-@group
-(setq list '(hack foo bar))
- @result{} (hack foo bar)
-@end group
-@group
-(cons 'use
- (cons 'the
- (cons 'words (append (cdr list) '(as elements)))))
- @result{} (use the words foo bar as elements)
-@end group
-@group
-`(use the words ,@@(cdr list) as elements)
- @result{} (use the words foo bar as elements)
-@end group
@end example
+ The body of a macro definition can include a @code{declare} form,
+which specifies additional properties about the macro. @xref{Declare
+Form}.
+
@node Problems with Macros
@section Common Problems Using Macros
- The basic facts of macro expansion have counterintuitive consequences.
-This section describes some important consequences that can lead to
+ Macro expansion can have counterintuitive consequences. This
+section describes some important consequences that can lead to
trouble, and rules to follow to avoid trouble.
@menu
@@ -404,21 +297,20 @@ program is actually run.
When defining a macro you must pay attention to the number of times
the arguments will be evaluated when the expansion is executed. The
-following macro (used to facilitate iteration) illustrates the problem.
-This macro allows us to write a simple ``for'' loop such as one might
-find in Pascal.
+following macro (used to facilitate iteration) illustrates the
+problem. This macro allows us to write a ``for'' loop construct.
@findex for
-@smallexample
+@example
@group
(defmacro for (var from init to final do &rest body)
"Execute a simple \"for\" loop.
For example, (for i from 1 to 10 do (print i))."
(list 'let (list (list var init))
- (cons 'while (cons (list '<= var final)
- (append body (list (list 'inc var)))))))
+ (cons 'while
+ (cons (list '<= var final)
+ (append body (list (list 'inc var)))))))
@end group
-@result{} for
@group
(for i from 1 to 3 do
@@ -440,7 +332,7 @@ For example, (for i from 1 to 10 do (print i))."
@print{}3 9
@result{} nil
@end group
-@end smallexample
+@end example
@noindent
The arguments @code{from}, @code{to}, and @code{do} in this macro are
@@ -450,7 +342,7 @@ in those positions in the macro call.
Here's an equivalent definition simplified through use of backquote:
-@smallexample
+@example
@group
(defmacro for (var from init to final do &rest body)
"Execute a simple \"for\" loop.
@@ -460,7 +352,7 @@ For example, (for i from 1 to 10 do (print i))."
,@@body
(inc ,var))))
@end group
-@end smallexample
+@end example
Both forms of this definition (with backquote and without) suffer from
the defect that @var{final} is evaluated on every iteration. If
@@ -475,7 +367,7 @@ producing an expansion that evaluates the argument expressions exactly
once unless repeated evaluation is part of the intended purpose of the
macro. Here is a correct expansion for the @code{for} macro:
-@smallexample
+@example
@group
(let ((i 1)
(max 3))
@@ -484,11 +376,11 @@ macro. Here is a correct expansion for the @code{for} macro:
(princ (format "%d %d" i square))
(inc i)))
@end group
-@end smallexample
+@end example
Here is a macro definition that creates this expansion:
-@smallexample
+@example
@group
(defmacro for (var from init to final do &rest body)
"Execute a simple for loop: (for i from 1 to 10 do (print i))."
@@ -498,7 +390,7 @@ Here is a macro definition that creates this expansion:
,@@body
(inc ,var))))
@end group
-@end smallexample
+@end example
Unfortunately, this fix introduces another problem,
described in the following section.
@@ -511,7 +403,7 @@ described in the following section.
follows to make the expansion evaluate the macro arguments the proper
number of times:
-@smallexample
+@example
@group
(defmacro for (var from init to final do &rest body)
"Execute a simple for loop: (for i from 1 to 10 do (print i))."
@@ -523,14 +415,14 @@ number of times:
,@@body
(inc ,var))))
@end group
-@end smallexample
+@end example
@end ifnottex
The new definition of @code{for} has a new problem: it introduces a
local variable named @code{max} which the user does not expect. This
causes trouble in examples such as the following:
-@smallexample
+@example
@group
(let ((max 0))
(for x from 0 to 10 do
@@ -538,7 +430,7 @@ causes trouble in examples such as the following:
(if (< max this)
(setq max this)))))
@end group
-@end smallexample
+@end example
@noindent
The references to @code{max} inside the body of the @code{for}, which
@@ -554,7 +446,7 @@ put it into the program later. It will never appear anywhere except
where put by @code{for}. Here is a definition of @code{for} that works
this way:
-@smallexample
+@example
@group
(defmacro for (var from init to final do &rest body)
"Execute a simple for loop: (for i from 1 to 10 do (print i))."
@@ -565,7 +457,7 @@ this way:
,@@body
(inc ,var)))))
@end group
-@end smallexample
+@end example
@noindent
This creates an uninterned symbol named @code{max} and puts it in the
@@ -588,7 +480,6 @@ it. Here is an example:
@group
(defmacro foo (a)
(list 'setq (eval a) t))
- @result{} foo
@end group
@group
(setq x 'b)
@@ -680,9 +571,9 @@ either.
@node Indenting Macros
@section Indenting Macros
- You can use the @code{declare} form in the macro definition to
-specify how to @key{TAB} should indent calls to the macro. You
-write it like this:
+ Within a macro definition, you can use the @code{declare} form
+(@pxref{Defining Macros}) to specify how @key{TAB} should indent
+calls to the macro. An indentation specification is written like this:
@example
(declare (indent @var{indent-spec}))
@@ -712,6 +603,7 @@ the line uses the standard pattern.
@var{symbol} should be a function name; that function is called to
calculate the indentation of a line within this expression. The
function receives two arguments:
+
@table @asis
@item @var{state}
The value returned by @code{parse-partial-sexp} (a Lisp primitive for
@@ -720,6 +612,7 @@ beginning of this line.
@item @var{pos}
The position at which the line being indented begins.
@end table
+
@noindent
It should return either a number, which is the number of columns of
indentation for that line, or a list whose car is such a number. The
diff --git a/doc/lispref/makefile.w32-in b/doc/lispref/makefile.w32-in
index 7b88e861d67..2914852dc8a 100644
--- a/doc/lispref/makefile.w32-in
+++ b/doc/lispref/makefile.w32-in
@@ -1,6 +1,6 @@
# -*- Makefile -*- for the GNU Emacs Lisp Reference Manual.
-# Copyright (C) 2003-2011 Free Software Foundation, Inc.
+# Copyright (C) 2003-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -28,6 +28,9 @@ emacsdir = $(srcdir)/../emacs
# Directory with the (customized) texinfo.tex file.
texinfodir = $(srcdir)/../misc
+INFO_EXT=.info
+INFO_OPTS=--no-split
+
# Redefine `TEX' if `tex' does not invoke plain TeX. For example:
# TEX=platex
TEX=tex
@@ -38,14 +41,9 @@ MAKEINFO_OPTS = --force --enable-encoding -I$(srcdir) -I$(emacsdir)
# The environment variable and its value to add $(srcdir) to the path
# searched for TeX input files.
texinputdir = $(srcdir)\..\..\nt\envadd.bat \
- "TEXINPUTS=$(srcdir);$(texinputdir);$(TEXINPUTS)" \
+ "TEXINPUTS=$(srcdir);$(texinfodir);$(emacsdir);$(TEXINPUTS)" \
"MAKEINFO=$(MAKEINFO) $(MAKEINFO_OPTS)" /C
-# The name of the manual:
-VERSION=2.9
-## FIXME can this be set by configure, as per Makefile.in?
-manual = elisp-manual-23-$(VERSION)
-
# List of all the texinfo files in the manual:
srcs = \
@@ -53,7 +51,6 @@ srcs = \
$(srcdir)/abbrevs.texi \
$(srcdir)/advice.texi \
$(srcdir)/anti.texi \
- $(srcdir)/back.texi \
$(srcdir)/backups.texi \
$(srcdir)/buffers.texi \
$(srcdir)/commands.texi \
@@ -77,7 +74,6 @@ srcs = \
$(srcdir)/keymaps.texi \
$(srcdir)/lists.texi \
$(srcdir)/loading.texi \
- $(srcdir)/locals.texi \
$(srcdir)/macros.texi \
$(srcdir)/maps.texi \
$(srcdir)/markers.texi \
@@ -109,13 +105,13 @@ srcs = \
# The info file is named `elisp'.
-info: $(infodir)/elisp
+info: $(infodir)/elisp$(INFO_EXT)
$(infodir)/dir:
$(INSTALL_INFO) --info-dir=$(infodir) $(infodir)/elisp
-$(infodir)/elisp: $(srcs)
- $(MAKEINFO) $(MAKEINFO_OPTS) -o $(infodir)/elisp $(srcdir)/elisp.texi
+$(infodir)/elisp$(INFO_EXT): $(srcs)
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ $(srcdir)/elisp.texi
elisp.dvi: $(srcs)
$(texinputdir) $(TEX) $(srcdir)/elisp.texi
@@ -130,4 +126,4 @@ distclean: clean
- $(DEL) makefile
maintainer-clean: distclean
- - $(DEL) elisp elisp-? elisp-?? elisp.dvi elisp.oaux
+ - $(DEL) elisp$(INFO_EXT) elisp$(INFO_EXT)-? elisp$(INFO_EXT)-?? elisp.dvi elisp.oaux
diff --git a/doc/lispref/maps.texi b/doc/lispref/maps.texi
index d235fee90ee..9426dfd4a88 100644
--- a/doc/lispref/maps.texi
+++ b/doc/lispref/maps.texi
@@ -1,39 +1,39 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1993, 1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1993, 1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/maps
-@node Standard Keymaps, Standard Hooks, Standard Buffer-Local Variables, Top
+@node Standard Keymaps
@appendix Standard Keymaps
-@cindex standard keymaps
+@cindex keymaps, standard
-The following symbols are used as the names for various keymaps.
-Some of these exist when Emacs is first started, others are
-loaded only when their respective mode is used. This is not
-an exhaustive list.
+In this section we list some of the more general keymaps. Many of
+these exist when Emacs is first started, but some are loaded only when
+the respective feature is accessed.
-Several keymaps are used in the minibuffer. @xref{Completion Commands}.
-
-Almost all of these maps are used as local maps. Indeed, of the modes
-that presently exist, only Vip mode and Terminal mode ever change the
-global keymap.
+There are many other, more specialized, maps than these; in particular
+those associated with major and minor modes. The minibuffer uses
+several keymaps (@pxref{Completion Commands}). For more details on
+keymaps, @pxref{Keymaps}.
+@c Don't list individual major mode keymaps here, only more general things.
+@c Only add vindex for things not covered elsewhere in this manual.
+@c Don't add xrefs to things covered in {Keymaps}.
@table @code
-@item apropos-mode-map
-@vindex apropos-mode-map
-A sparse keymap for @code{apropos} buffers.
+@item 2C-mode-map
+A sparse keymap for subcommands of the prefix @kbd{C-x 6}.@*
+@xref{Two-Column,, Two-Column Editing, emacs, The GNU Emacs Manual}.
-@item Buffer-menu-mode-map
-@vindex Buffer-menu-mode-map
-A full keymap used by Buffer Menu mode.
+@item abbrev-map
+@vindex abbrev-map
+A sparse keymap for subcommands of the prefix @kbd{C-x a}.@*
+@xref{Defining Abbrevs,,, emacs, The GNU Emacs Manual}.
-@item c-mode-map
-@vindex c-mode-map
-A sparse keymap used by C mode.
+@item button-buffer-map
+A sparse keymap useful for buffers containing buffers.@*
+You may want to use this as a parent keymap. @xref{Buttons}.
-@item command-history-map
-@vindex command-history-map
-A full keymap used by Command History mode.
+@item button-map
+A sparse keymap used by buttons.
@item ctl-x-4-map
A sparse keymap for subcommands of the prefix @kbd{C-x 4}.
@@ -44,196 +44,155 @@ A sparse keymap for subcommands of the prefix @kbd{C-x 5}.
@item ctl-x-map
A full keymap for @kbd{C-x} commands.
-@item custom-mode-map
-A full keymap for Custom mode.
-
-@item debugger-mode-map
-@vindex debugger-mode-map
-A full keymap used by Debugger mode.
-
-@item dired-mode-map
-@vindex dired-mode-map
-A full keymap for @code{dired-mode} buffers.
-
-@item edit-abbrevs-map
-@vindex edit-abbrevs-map
-A sparse keymap used in @code{edit-abbrevs}.
-
-@item edit-tab-stops-map
-@vindex edit-tab-stops-map
-A sparse keymap used in @code{edit-tab-stops}.
-
-@item electric-buffer-menu-mode-map
-@vindex electric-buffer-menu-mode-map
-A full keymap used by Electric Buffer Menu mode.
-
-@item electric-history-map
-@vindex electric-history-map
-A full keymap used by Electric Command History mode.
-
-@item emacs-lisp-mode-map
-@vindex emacs-lisp-mode-map
-A sparse keymap used by Emacs Lisp mode.
+@item ctl-x-r-map
+@vindex ctl-x-r-map
+A sparse keymap for subcommands of the prefix @kbd{C-x r}.@*
+@xref{Registers,,, emacs, The GNU Emacs Manual}.
@item esc-map
A full keymap for @kbd{ESC} (or @kbd{Meta}) commands.
-@item facemenu-menu
-@vindex facemenu-menu
-The sparse keymap that displays the Text Properties menu.
-
-@item facemenu-background-menu
-@vindex facemenu-background-menu
-The sparse keymap that displays the Background Color submenu of the Text
-Properties menu.
-
-@item facemenu-face-menu
-@vindex facemenu-face-menu
-The sparse keymap that displays the Face submenu of the Text Properties menu.
+@item facemenu-keymap
+A sparse keymap used for the @kbd{M-o} prefix key.
-@item facemenu-foreground-menu
-@vindex facemenu-foreground-menu
-The sparse keymap that displays the Foreground Color submenu of the Text
-Properties menu.
-
-@item facemenu-indentation-menu
-@vindex facemenu-indentation-menu
-The sparse keymap that displays the Indentation submenu of the Text
-Properties menu.
-
-@item facemenu-justification-menu
-@vindex facemenu-justification-menu
-The sparse keymap that displays the Justification submenu of the Text
-Properties menu.
-
-@item facemenu-special-menu
-@vindex facemenu-special-menu
-The sparse keymap that displays the Special Props submenu of the Text
-Properties menu.
-
-@item local-function-key-map
-The keymap for translating key sequences to preferred alternatives.@*
-If there are none, then it contains an empty sparse keymap.
-@xref{Translation Keymaps}.
+@item function-key-map
+The parent keymap of all @code{local-function-key-map} (q.v.) instances.
+@ignore
+@c Doesn't exist.
@item fundamental-mode-map
@vindex fundamental-mode-map
The sparse keymap for Fundamental mode.@*
It is empty and should not be changed.
+@end ignore
@item global-map
The full keymap containing default global key bindings.@*
Modes should not modify the Global map.
-@item grep-mode-map
-@vindex grep-mode-map
-The keymap for @code{grep-mode} buffers.
+@item goto-map
+A sparse keymap used for the @kbd{M-g} prefix key.
@item help-map
-The sparse keymap for the keys that follow the help character @kbd{C-h}.
-
-@item help-mode-map
-@vindex help-mode-map
-The sparse keymap for Help mode.
+A sparse keymap for the keys following the help character @kbd{C-h}.@*
+@xref{Help Functions}.
@item Helper-help-map
-@vindex Helper-help-map
A full keymap used by the help utility package.@*
-It has the same keymap in its value cell and in its function
-cell.
-
-@item Info-edit-map
-@vindex Info-edit-map
-A sparse keymap used by the @kbd{e} command of Info.
-
-@item Info-mode-map
-@vindex Info-mode-map
-A sparse keymap containing Info commands.
+It has the same keymap in its value cell and in its function cell.
@item input-decode-map
The keymap for translating keypad and function keys.@*
If there are none, then it contains an empty sparse keymap.
@xref{Translation Keymaps}.
-@item isearch-mode-map
-@vindex isearch-mode-map
-A keymap that defines the characters you can type within incremental
-search.
-
@item key-translation-map
A keymap for translating keys. This one overrides ordinary key
bindings, unlike @code{local-function-key-map}. @xref{Translation
Keymaps}.
-@item kmacro-map
-@vindex kmacro-map
-A sparse keymap for keys that follows the @kbd{C-x C-k} prefix
-search.
-
-@item lisp-interaction-mode-map
-@vindex lisp-interaction-mode-map
-A sparse keymap used by Lisp Interaction mode.
+@item kmacro-keymap
+@vindex kmacro-keymap
+A sparse keymap for keys that follows the @kbd{C-x C-k} prefix search.@*
+@xref{Keyboard Macros,,, emacs, The GNU Emacs Manual}.
-@item lisp-mode-map
-@vindex lisp-mode-map
-A sparse keymap used by Lisp mode.
-
-@item menu-bar-edit-menu
-@vindex menu-bar-edit-menu
-The keymap which displays the Edit menu in the menu bar.
+@item local-function-key-map
+The keymap for translating key sequences to preferred alternatives.@*
+If there are none, then it contains an empty sparse keymap.
+@xref{Translation Keymaps}.
@item menu-bar-file-menu
+@itemx menu-bar-edit-menu
+@itemx menu-bar-options-menu
+@itemx global-buffers-menu-map
+@itemx menu-bar-tools-menu
+@itemx menu-bar-help-menu
+@cindex menu bar keymaps
@vindex menu-bar-file-menu
-The keymap which displays the File menu in the menu bar.
-
-@item menu-bar-help-menu
-@vindex menu-bar-help-menu
-The keymap which displays the Help menu in the menu bar.
-
-@item menu-bar-mule-menu
-@vindex menu-bar-mule-menu
-The keymap which displays the Mule menu in the menu bar.
-
-@item menu-bar-search-menu
-@vindex menu-bar-search-menu
-The keymap which displays the Search menu in the menu bar.
-
-@item menu-bar-tools-menu
+@vindex menu-bar-options-menu
+@vindex global-buffers-menu-map
@vindex menu-bar-tools-menu
-The keymap which displays the Tools menu in the menu bar.
+@vindex menu-bar-help-menu
+These keymaps display the main, top-level menus in the menu bar.@*
+Some of them contain sub-menus. For example, the Edit menu contains
+@code{menu-bar-search-menu}, etc. @xref{Menu Bar}.
+@ignore
+TODO list all submenus?
+There are probably too many, and it would not be useful to do so, eg:
+The Edit menu includes @code{yank-menu}, @code{menu-bar-search-menu},
+@code{menu-bar-replace-menu}, @code{menu-bar-goto-menu},
+@code{menu-bar-bookmark-map}, and @code{facemenu-menu}.
+There is also mule-menu-keymap, set-coding-system-map,
+setup-language-environment-map, describe-language-environment-map,
+menu-bar-epatch-menu, menu-bar-ediff-merge-menu, menu-bar-ediff-menu, etc.
+@end ignore
+
+@item minibuffer-inactive-mode-map
+A full keymap used in the minibuffer when it is not active.@*
+@xref{Minibuffer Edit,, Editing in the Minibuffer, emacs, The GNU Emacs Manual}.
+
+@item mode-line-coding-system-map
+@itemx mode-line-input-method-map
+@itemx mode-line-column-line-number-mode-map
+@vindex mode-line-coding-system-map
+@vindex mode-line-input-method-map
+@vindex mode-line-column-line-number-mode-map
+These keymaps control various areas of the mode line.@*
+@xref{Mode Line Format}.
@item mode-specific-map
The keymap for characters following @kbd{C-c}. Note, this is in the
-global map. This map is not actually mode specific: its name was chosen
-to be informative for the user in @kbd{C-h b} (@code{display-bindings}),
+global map. This map is not actually mode-specific: its name was chosen
+to be informative in @kbd{C-h b} (@code{display-bindings}),
where it describes the main use of the @kbd{C-c} prefix key.
-@item multi-query-replace-map
-A sparse keymap that extends @code{query-replace-map} for multi-buffer
-replacements. @xref{Search and Replace, query-replace-map}.
+@c FIXME - don't mention this one?
+@item mouse-appearance-menu-map
+@vindex mouse-appearance-menu-map
+A sparse keymap used for the @kbd{S-mouse-1} key.
+
+@item mule-keymap
+The global keymap used for the @kbd{C-x @key{RET}} prefix key.
-@item occur-mode-map
-@vindex occur-mode-map
-A sparse keymap used by Occur mode.
+@item narrow-map
+@vindex narrow-map
+A sparse keymap for subcommands of the prefix @kbd{C-x n}.
+
+@item prog-mode-map
+The keymap used by Prog mode.@*
+@xref{Basic Major Modes}.
@item query-replace-map
+@itemx multi-query-replace-map
A sparse keymap used for responses in @code{query-replace} and related
commands; also for @code{y-or-n-p} and @code{map-y-or-n-p}. The functions
that use this map do not support prefix keys; they look up one event at a
-time.
+time. @code{multi-query-replace-map} extends @code{query-replace-map}
+for multi-buffer replacements. @xref{Search and Replace, query-replace-map}.
@item search-map
-A sparse keymap that provides global bindings for search-related
-commands.
+A sparse keymap that provides global bindings for search-related commands.
-@item text-mode-map
-@vindex text-mode-map
-A sparse keymap used by Text mode.
+@item special-mode-map
+The keymap used by Special mode.@*
+@xref{Basic Major Modes}.
@item tool-bar-map
-The keymap defining the contents of the tool bar.
+The keymap defining the contents of the tool bar.@*
+@xref{Tool Bar}.
+
+@item universal-argument-map
+@vindex universal-argument-map
+A sparse keymap used while processing @kbd{C-u}.@*
+@xref{Prefix Command Arguments}.
+
+@item vc-prefix-map
+The global keymap used for the @kbd{C-x v} prefix key.
+
+@item x-alternatives-map
+@vindex x-alternatives-map
+@findex x-setup-function-keys
+A sparse keymap used to map certain keys under graphical frames.@*
+The function @code{x-setup-function-keys} uses this.
-@item view-mode-map
-@vindex view-mode-map
-A full keymap used by View mode.
@end table
diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi
index 7b73c454c87..fa884269b36 100644
--- a/doc/lispref/markers.texi
+++ b/doc/lispref/markers.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/markers
-@node Markers, Text, Positions, Top
+@node Markers
@chapter Markers
@cindex markers
@@ -27,8 +26,8 @@ deleted, so that it stays with the two characters on either side of it.
@node Overview of Markers
@section Overview of Markers
- A marker specifies a buffer and a position in that buffer. The
-marker can be used to represent a position in the functions that
+ A marker specifies a buffer and a position in that buffer. A
+marker can be used to represent a position in functions that
require one, just as an integer could be used. In that case, the
marker's buffer is normally ignored. Of course, a marker used in this
way usually points to a position in the buffer that the function
@@ -38,12 +37,12 @@ operates on, but that is entirely the programmer's responsibility.
A marker has three attributes: the marker position, the marker
buffer, and the insertion type. The marker position is an integer
that is equivalent (at a given time) to the marker as a position in
-that buffer. But the marker's position value can change often during
-the life of the marker. Insertion and deletion of text in the buffer
-relocate the marker. The idea is that a marker positioned between two
-characters remains between those two characters despite insertion and
-deletion elsewhere in the buffer. Relocation changes the integer
-equivalent of the marker.
+that buffer. But the marker's position value can change during
+the life of the marker, and often does. Insertion and deletion of
+text in the buffer relocate the marker. The idea is that a marker
+positioned between two characters remains between those two characters
+despite insertion and deletion elsewhere in the buffer. Relocation
+changes the integer equivalent of the marker.
@cindex marker relocation
Deleting text around a marker's position leaves the marker between the
@@ -58,12 +57,12 @@ with @code{insert-before-markers} (@pxref{Insertion}).
relocate them if necessary. This slows processing in a buffer with a
large number of markers. For this reason, it is a good idea to make a
marker point nowhere if you are sure you don't need it any more.
-Unreferenced markers are garbage collected eventually, but until then
-will continue to use time if they do point somewhere.
+Markers that can no longer be accessed are eventually removed
+(@pxref{Garbage Collection}).
@cindex markers as numbers
Because it is common to perform arithmetic operations on a marker
-position, most of the arithmetic operations (including @code{+} and
+position, most of these operations (including @code{+} and
@code{-}) accept markers as arguments. In such cases, the marker
stands for its current position.
@@ -188,7 +187,7 @@ chapter.
(point-min-marker)
@result{} #<marker at 1 in markers.texi>
(point-max-marker)
- @result{} #<marker at 15573 in markers.texi>
+ @result{} #<marker at 24080 in markers.texi>
@end group
@group
@@ -206,7 +205,7 @@ chapter.
@end example
@end defun
-@defun copy-marker marker-or-integer &optional insertion-type
+@defun copy-marker &optional marker-or-integer insertion-type
If passed a marker as its argument, @code{copy-marker} returns a
new marker that points to the same place and the same buffer as does
@var{marker-or-integer}. If passed an integer as its argument,
@@ -229,8 +228,8 @@ buffer.
@end group
@group
-(copy-marker 20000)
- @result{} #<marker at 7572 in markers.texi>
+(copy-marker 90000)
+ @result{} #<marker at 24080 in markers.texi>
@end group
@end example
@@ -308,11 +307,6 @@ This function returns the buffer that @var{marker} points into, or
@end example
@end defun
-@defun buffer-has-markers-at position
-This function returns @code{t} if one or more markers
-point at position @var{position} in the current buffer.
-@end defun
-
@node Marker Insertion Types
@section Marker Insertion Types
@@ -356,9 +350,9 @@ the current buffer.
If @var{position} is less than 1, @code{set-marker} moves @var{marker}
to the beginning of the buffer. If @var{position} is greater than the
-size of the buffer, @code{set-marker} moves marker to the end of the
-buffer. If @var{position} is @code{nil} or a marker that points
-nowhere, then @var{marker} is set to point nowhere.
+size of the buffer (@pxref{Point}), @code{set-marker} moves marker to
+the end of the buffer. If @var{position} is @code{nil} or a marker
+that points nowhere, then @var{marker} is set to point nowhere.
The value returned is @var{marker}.
@@ -422,11 +416,11 @@ can request deactivation of the mark upon return to the editor command
loop by setting the variable @code{deactivate-mark} to a
non-@code{nil} value.
- If Transient Mode is enabled, certain editing commands that normally
-apply to text near point, apply instead to the region when the mark is
-active. This is the main motivation for using Transient Mark mode.
-(Another is that this enables highlighting of the region when the mark
-is active. @xref{Display}.)
+ If Transient Mark mode is enabled, certain editing commands that
+normally apply to text near point, apply instead to the region when
+the mark is active. This is the main motivation for using Transient
+Mark mode. (Another is that this enables highlighting of the region
+when the mark is active. @xref{Display}.)
In addition to the mark, each buffer has a @dfn{mark ring} which is a
list of markers containing previous values of the mark. When editing
@@ -509,7 +503,8 @@ example:
This function sets the current buffer's mark to @var{position}, and
pushes a copy of the previous mark onto @code{mark-ring}. If
@var{position} is @code{nil}, then the value of point is used.
-@code{push-mark} returns @code{nil}.
+@c Doesn't seem relevant.
+@c @code{push-mark} returns @code{nil}.
The function @code{push-mark} normally @emph{does not} activate the
mark. To do that, specify @code{t} for the argument @var{activate}.
@@ -523,8 +518,9 @@ This function pops off the top element of @code{mark-ring} and makes
that mark become the buffer's actual mark. This does not move point in
the buffer, and it does nothing if @code{mark-ring} is empty. It
deactivates the mark.
-
-The return value is not meaningful.
+@c
+@c Seems even less relevant.
+@c The return value is not meaningful.
@end defun
@defopt transient-mark-mode
@@ -593,8 +589,16 @@ the function @code{use-region-p} for that (@pxref{The Region}).
@defvarx deactivate-mark-hook
These normal hooks are run, respectively, when the mark becomes active
and when it becomes inactive. The hook @code{activate-mark-hook} is
-also run at the end of a command if the mark is active and it is
-possible that the region may have changed.
+also run at the end of the command loop if the mark is active and it
+is possible that the region may have changed.
+@ignore
+This piece of command_loop_1, run unless deactivating the mark:
+ if (current_buffer != prev_buffer || MODIFF != prev_modiff)
+ {
+ Lisp_Object hook = intern ("activate-mark-hook");
+ Frun_hooks (1, &hook);
+ }
+@end ignore
@end defvar
@defun handle-shift-selection
@@ -634,6 +638,9 @@ more marks than this are pushed onto the @code{mark-ring},
@code{push-mark} discards an old mark when it adds a new one.
@end defopt
+@c There is also global-mark-ring-max, but this chapter explicitly
+@c does not talk about the global mark.
+
@node The Region
@section The Region
@cindex region (between point and mark)
@@ -660,16 +667,23 @@ integer). This is the position of either point or the mark, whichever is
larger.
@end defun
- Few programs need to use the @code{region-beginning} and
-@code{region-end} functions. A command designed to operate on a region
-should normally use @code{interactive} with the @samp{r} specification
-to find the beginning and end of the region. This lets other Lisp
-programs specify the bounds explicitly as arguments. (@xref{Interactive
-Codes}.)
+ Instead of using @code{region-beginning} and @code{region-end}, a
+command designed to operate on a region should normally use
+@code{interactive} with the @samp{r} specification to find the
+beginning and end of the region. This lets other Lisp programs
+specify the bounds explicitly as arguments. @xref{Interactive Codes}.
@defun use-region-p
This function returns @code{t} if Transient Mark mode is enabled, the
-mark is active, and there's a valid region in the buffer. Commands
-that operate on the region (instead of on text near point) when
-there's an active mark should use this to test whether to do that.
+mark is active, and there is a valid region in the buffer. This
+function is intended to be used by commands that operate on the
+region, instead of on text near point, when the mark is active.
+
+A region is valid if it has a non-zero size, or if the user option
+@code{use-empty-active-region} is non-@code{nil} (by default, it is
+@code{nil}). The function @code{region-active-p} is similar to
+@code{use-region-p}, but considers all regions as valid. In most
+cases, you should not use @code{region-active-p}, since if the region
+is empty it is often more appropriate to operate on point.
@end defun
+
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index aa22e6c92ff..033c10fbf7d 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1,10 +1,9 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/minibuf
-@node Minibuffers, Command Loop, Read and Print, Top
+@node Minibuffers
@chapter Minibuffers
@cindex arguments, reading
@cindex complex arguments
@@ -30,8 +29,8 @@ argument.
* Multiple Queries:: Asking a series of similar questions.
* Reading a Password:: Reading a password from the terminal.
* Minibuffer Commands:: Commands used as key bindings in minibuffers.
-* Minibuffer Contents:: How such commands access the minibuffer text.
* Minibuffer Windows:: Operating on the special minibuffer windows.
+* Minibuffer Contents:: How such commands access the minibuffer text.
* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
* Minibuffer Misc:: Various customization hooks and variables.
@end menu
@@ -58,14 +57,17 @@ including @code{beginning-of-line}, @code{forward-word},
@code{forward-sentence}, and @code{forward-paragraph}, stop at the
boundary between the prompt and the actual text.
+@c See http://debbugs.gnu.org/11276
The minibuffer's window is normally a single line; it grows
-automatically if the contents require more space. You can explicitly
-resize it temporarily with the window sizing commands; it reverts to
-its normal size when the minibuffer is exited. You can resize it
+automatically if the contents require more space. Whilst it is
+active, you can explicitly resize it temporarily with the window
+sizing commands; it reverts to its normal size when the minibuffer is
+exited. When the minibuffer is not active, you can resize it
permanently by using the window sizing commands in the frame's other
-window, when the minibuffer is not active. If the frame contains just
-a minibuffer, you can change the minibuffer's size by changing the
-frame's size.
+window, or dragging the mode line with the mouse. (Due to details of
+the current implementation, for this to work @code{resize-mini-windows}
+must be @code{nil}.) If the frame contains just a minibuffer, you can
+change the minibuffer's size by changing the frame's size.
Use of the minibuffer reads input events, and that alters the values
of variables such as @code{this-command} and @code{last-command}
@@ -73,9 +75,9 @@ of variables such as @code{this-command} and @code{last-command}
code that uses the minibuffer, if you do not want that to change them.
Under some circumstances, a command can use a minibuffer even if
-there is an active minibuffer; such minibuffers are called a
+there is an active minibuffer; such a minibuffer is called a
@dfn{recursive minibuffer}. The first minibuffer is named
-@w{@samp{ *Minibuf-0*}}. Recursive minibuffers are named by
+@w{@samp{ *Minibuf-1*}}. Recursive minibuffers are named by
incrementing the number at the end of the name. (The names begin with
a space so that they won't show up in normal buffer lists.) Of
several recursive minibuffers, the innermost (or most recently
@@ -91,6 +93,12 @@ to be done. @xref{Text from Minibuffer}, for the non-completion
minibuffer local maps. @xref{Completion Commands}, for the minibuffer
local maps for completion.
+@cindex inactive minibuffer
+ When a minibuffer is inactive, its major mode is
+@code{minibuffer-inactive-mode}, with keymap
+@code{minibuffer-inactive-mode-map}. This is only really useful if
+the minibuffer is in a separate frame. @xref{Minibuffers and Frames}.
+
When Emacs is running in batch mode, any request to read from the
minibuffer actually reads a line from the standard input descriptor that
was supplied when Emacs was started.
@@ -111,7 +119,7 @@ middle of a Lisp function. Instead, do all minibuffer input as part of
reading the arguments for a command, in the @code{interactive}
specification. @xref{Defining Commands}.
-@defun read-from-minibuffer prompt-string &optional initial-contents keymap read hist default inherit-input-method
+@defun read-from-minibuffer prompt &optional initial keymap read history default inherit-input-method
This function is the most general way to get input from the
minibuffer. By default, it accepts arbitrary text and returns it as a
string; however, if @var{read} is non-@code{nil}, then it uses
@@ -119,8 +127,8 @@ string; however, if @var{read} is non-@code{nil}, then it uses
Functions}).
The first thing this function does is to activate a minibuffer and
-display it with @var{prompt-string} as the prompt. This value must be a
-string. Then the user can edit text in the minibuffer.
+display it with @var{prompt} (which must be a string) as the
+prompt. Then the user can edit text in the minibuffer.
When the user types a command to exit the minibuffer,
@code{read-from-minibuffer} constructs the return value from the text in
@@ -132,7 +140,7 @@ reads the text and returns the resulting Lisp object, unevaluated.
The argument @var{default} specifies default values to make available
through the history commands. It should be a string, a list of
strings, or @code{nil}. The string or strings become the minibuffer's
-``future history,'' available to the user with @kbd{M-n}.
+``future history'', available to the user with @kbd{M-n}.
If @var{read} is non-@code{nil}, then @var{default} is also used
as the input to @code{read}, if the user enters empty input.
@@ -149,12 +157,13 @@ value of @code{minibuffer-local-map} is used as the keymap. Specifying
a keymap is the most important way to customize the minibuffer for
various applications such as completion.
-The argument @var{hist} specifies which history list variable to use
+The argument @var{history} specifies a history list variable to use
for saving the input and for history commands used in the minibuffer.
-It defaults to @code{minibuffer-history}. @xref{Minibuffer History}.
+It defaults to @code{minibuffer-history}. You can optionally specify
+a starting position in the history list as well. @xref{Minibuffer History}.
If the variable @code{minibuffer-allow-text-properties} is
-non-@code{nil}, then the string which is returned includes whatever text
+non-@code{nil}, then the string that is returned includes whatever text
properties were present in the minibuffer. Otherwise all the text
properties are stripped when the value is returned.
@@ -164,9 +173,9 @@ the setting of @code{enable-multibyte-characters} (@pxref{Text
Representations}) from whichever buffer was current before entering the
minibuffer.
-Use of @var{initial-contents} is mostly deprecated; we recommend using
+Use of @var{initial} is mostly deprecated; we recommend using
a non-@code{nil} value only in conjunction with specifying a cons cell
-for @var{hist}. @xref{Initial Input}.
+for @var{history}. @xref{Initial Input}.
@end defun
@defun read-string prompt &optional initial history default inherit-input-method
@@ -179,11 +188,11 @@ The optional argument @var{default} is used as in
@code{read-from-minibuffer}, except that, if non-@code{nil}, it also
specifies a default value to return if the user enters null input. As
in @code{read-from-minibuffer} it should be a string, a list of
-strings, or @code{nil} which is equivalent to an empty string. When
+strings, or @code{nil}, which is equivalent to an empty string. When
@var{default} is a string, that string is the default value. When it
is a list of strings, the first string is the default value. (All
these strings are available to the user in the ``future minibuffer
-history.'')
+history''.)
This function works by calling the
@code{read-from-minibuffer} function:
@@ -202,22 +211,25 @@ This function works by calling the
@end smallexample
@end defun
-@defun read-regexp prompt &optional default-value
+@defun read-regexp prompt &optional default history
This function reads a regular expression as a string from the
minibuffer and returns it. The argument @var{prompt} is used as in
-@code{read-from-minibuffer}. The keymap used is
-@code{minibuffer-local-map}, and @code{regexp-history} is used as the
-history list (@pxref{Minibuffer History, regexp-history}).
+@code{read-from-minibuffer}.
-The optional argument @var{default-value} specifies a default value to
+The optional argument @var{default} specifies a default value to
return if the user enters null input; it should be a string, or
-@code{nil} which is equivalent to an empty string.
+@code{nil}, which is equivalent to an empty string.
-In addition, @code{read-regexp} collects a few useful candidates for
-input and passes them to @code{read-from-minibuffer}, to make them
-available to the user as the ``future minibuffer history list''
-(@pxref{Minibuffer History, future list,, emacs, The GNU Emacs
-Manual}). These candidates are:
+The optional argument @var{history}, if non-@code{nil}, is a symbol
+specifying a minibuffer history list to use (@pxref{Minibuffer
+History}). If it is omitted or @code{nil}, the history list defaults
+to @code{regexp-history}.
+
+@code{read-regexp} also collects a few useful candidates for input and
+passes them to @code{read-from-minibuffer}, to make them available to
+the user as the ``future minibuffer history list'' (@pxref{Minibuffer
+History, future list,, emacs, The GNU Emacs Manual}). These
+candidates are:
@itemize @minus
@item
@@ -235,9 +247,9 @@ function, after computing the list of defaults as described above.
@end defun
@defvar minibuffer-allow-text-properties
-If this variable is @code{nil}, then @code{read-from-minibuffer} strips
-all text properties from the minibuffer input before returning it.
-This variable also affects @code{read-string}. However,
+If this variable is @code{nil}, then @code{read-from-minibuffer}
+and @code{read-string} strip all text properties from the minibuffer
+input before returning it. However,
@code{read-no-blanks-input} (see below), as well as
@code{read-minibuffer} and related functions (@pxref{Object from
Minibuffer,, Reading Lisp Objects With the Minibuffer}), and all
@@ -275,6 +287,12 @@ default, it makes the following bindings:
@item @kbd{M-r}
@code{previous-matching-history-element}
+
+@ignore
+@c Does not seem worth/appropriate mentioning.
+@item @kbd{C-@key{TAB}}
+@code{file-cache-minibuffer-complete}
+@end ignore
@end table
@end defvar
@@ -305,6 +323,8 @@ This function discards text properties, regardless of the value of
@end smallexample
@end defun
+@c Slightly unfortunate name, suggesting it might be related to the
+@c Nextstep port...
@defvar minibuffer-local-ns-map
This built-in variable is the keymap used as the minibuffer local keymap
in the function @code{read-no-blanks-input}. By default, it makes the
@@ -389,23 +409,16 @@ This function simply evaluates the result of a call to
@end defun
@defun edit-and-eval-command prompt form
-This function reads a Lisp expression in the minibuffer, and then
-evaluates it. The difference between this command and
+This function reads a Lisp expression in the minibuffer, evaluates it,
+then returns the result. The difference between this command and
@code{eval-minibuffer} is that here the initial @var{form} is not
optional and it is treated as a Lisp object to be converted to printed
representation rather than as a string of text. It is printed with
@code{prin1}, so if it is a string, double-quote characters (@samp{"})
appear in the initial text. @xref{Output Functions}.
-The first thing @code{edit-and-eval-command} does is to activate the
-minibuffer with @var{prompt} as the prompt. Then it inserts the printed
-representation of @var{form} in the minibuffer, and lets the user edit it.
-When the user exits the minibuffer, the edited text is read with
-@code{read} and then evaluated. The resulting value becomes the value
-of @code{edit-and-eval-command}.
-
In the following example, we offer the user an expression with initial
-text which is a valid form already:
+text that is already a valid form:
@smallexample
@group
@@ -425,7 +438,6 @@ Please edit: (forward-word 1)@point{}
@noindent
Typing @key{RET} right away would exit the minibuffer and evaluate the
expression, thus moving point forward one word.
-@code{edit-and-eval-command} returns @code{nil} in this example.
@end defun
@node Minibuffer History
@@ -441,7 +453,7 @@ is a list of strings (previous inputs), most recent first.
kinds of inputs. It's the Lisp programmer's job to specify the right
history list for each use of the minibuffer.
- You specify a minibuffer history list with the optional @var{hist}
+ You specify a minibuffer history list with the optional @var{history}
argument to @code{read-from-minibuffer} or @code{completing-read}.
Here are the possible values for it:
@@ -457,7 +469,7 @@ Specifying 0 for @var{startpos} is equivalent to just specifying the
symbol @var{variable}. @code{previous-history-element} will display
the most recent element of the history list in the minibuffer. If you
specify a positive @var{startpos}, the minibuffer history functions
-behave as if @code{(elt @var{variable} (1- @var{STARTPOS}))} were the
+behave as if @code{(elt @var{variable} (1- @var{startpos}))} were the
history element currently shown in the minibuffer.
For consistency, you should also specify that element of the history
@@ -465,7 +477,7 @@ as the initial minibuffer contents, using the @var{initial} argument
to the minibuffer input function (@pxref{Initial Input}).
@end table
- If you don't specify @var{hist}, then the default history list
+ If you don't specify @var{history}, then the default history list
@code{minibuffer-history} is used. For other standard history lists,
see below. You can also create your own history list variable; just
initialize it to @code{nil} before the first use.
@@ -503,16 +515,15 @@ duplicates, and to add @var{newelt} to the list even if it is empty.
If the value of this variable is @code{nil}, standard functions that
read from the minibuffer don't add new elements to the history list.
This lets Lisp programs explicitly manage input history by using
-@code{add-to-history}. By default, @code{history-add-new-input} is
-set to a non-@code{nil} value.
+@code{add-to-history}. The default value is @code{t}.
@end defvar
@defopt history-length
The value of this variable specifies the maximum length for all
history lists that don't specify their own maximum lengths. If the
value is @code{t}, that means there is no maximum (don't delete old
-elements). The value of @code{history-length} property of the history
-list variable's symbol, if set, overrides this variable for that
+elements). If a history list variable's symbol has a non-@code{nil}
+@code{history-length} property, it overrides this variable for that
particular history list.
@end defopt
@@ -556,11 +567,19 @@ A history list for arguments that are shell commands.
A history list for arguments that are Lisp expressions to evaluate.
@end defvar
+@defvar face-name-history
+A history list for arguments that are faces.
+@end defvar
+
+@c Less common: coding-system-history, input-method-history,
+@c command-history, grep-history, grep-find-history,
+@c read-envvar-name-history, setenv-history, yes-or-no-p-history.
+
@node Initial Input
@section Initial Input
Several of the functions for minibuffer input have an argument called
-@var{initial} or @var{initial-contents}. This is a mostly-deprecated
+@var{initial}. This is a mostly-deprecated
feature for specifying that the minibuffer should start out with
certain text, instead of empty as usual.
@@ -577,7 +596,7 @@ to offer useful default inputs to the user.
There is just one situation where you should specify a string for an
@var{initial} argument. This is when you specify a cons cell for the
-@var{hist} or @var{history} argument. @xref{Minibuffer History}.
+@var{history} argument. @xref{Minibuffer History}.
@var{initial} can also be a cons cell of the form @code{(@var{string}
. @var{position})}. This means to insert @var{string} in the
@@ -589,11 +608,10 @@ inconsistently in different functions. In @code{completing-read},
of 0 means the beginning of the string, 1 means after the first
character, etc. In @code{read-minibuffer}, and the other
non-completion minibuffer input functions that support this argument,
-1 means the beginning of the string 2 means after the first character,
+1 means the beginning of the string, 2 means after the first character,
etc.
-Use of a cons cell as the value for @var{initial} arguments is
-deprecated in user code.
+Use of a cons cell as the value for @var{initial} arguments is deprecated.
@node Completion
@section Completion
@@ -604,6 +622,7 @@ starting from an abbreviation for it. Completion works by comparing the
user's input against a list of valid names and determining how much of
the name is determined uniquely by what the user has typed. For
example, when you type @kbd{C-x b} (@code{switch-to-buffer}) and then
+@c "This is the sort of English up with which I will not put."
type the first few letters of the name of the buffer to which you wish
to switch, and then type @key{TAB} (@code{minibuffer-complete}), Emacs
extends the name as far as it can.
@@ -628,11 +647,12 @@ for reading certain kinds of names with completion.
* Minibuffer Completion:: Invoking the minibuffer with completion.
* Completion Commands:: Minibuffer commands that do completion.
* High-Level Completion:: Convenient special cases of completion
- (reading buffer name, file name, etc.).
+ (reading buffer names, variable names, etc.).
* Reading File Names:: Using completion to read file names and
shell commands.
-* Completion Styles:: Specifying rules for performing completion.
-* Programmed Completion:: Writing your own completion-function.
+* Completion Variables:: Variables controlling completion behavior.
+* Programmed Completion:: Writing your own completion function.
+* Completion in Buffers:: Completing text in ordinary buffers.
@end menu
@node Basic Completion
@@ -644,47 +664,40 @@ higher-level completion features that do use the minibuffer.
@defun try-completion string collection &optional predicate
This function returns the longest common substring of all possible
-completions of @var{string} in @var{collection}. The value of
-@var{collection} must be a list of strings, an alist whose keys are
-strings or symbols, an obarray, a hash table, or a completion function
-(@pxref{Programmed Completion}).
-
-Completion compares @var{string} against each of the permissible
-completions specified by @var{collection}. If no permissible
-completions match, @code{try-completion} returns @code{nil}. If there
-is just one matching completion, and the match is exact, it returns
+completions of @var{string} in @var{collection}.
+
+@cindex completion table
+@var{collection} is called the @dfn{completion table}. Its value must
+be a list of strings or cons cells, an obarray, a hash table, or a
+completion function.
+
+@code{try-completion} compares @var{string} against each of the
+permissible completions specified by the completion table. If no
+permissible completions match, it returns @code{nil}. If there is
+just one matching completion, and the match is exact, it returns
@code{t}. Otherwise, it returns the longest initial sequence common
to all possible matching completions.
-If @var{collection} is an alist (@pxref{Association Lists}), the
-permissible completions are the elements of the alist that are either
-strings, or conses whose @sc{car} is a string or symbol.
-Symbols are converted to strings using @code{symbol-name}. Other
-elements of the alist are ignored. (Remember that in Emacs Lisp, the
-elements of alists do not @emph{have} to be conses.) In particular, a
-list of strings is allowed, even though we usually do not
-think of such lists as alists.
+If @var{collection} is an list, the permissible completions are
+specified by the elements of the list, each of which should be either
+a string, or a cons cell whose @sc{car} is either a string or a symbol
+(a symbol is converted to a string using @code{symbol-name}). If the
+list contains elements of any other type, those are ignored.
@cindex obarray in completion
If @var{collection} is an obarray (@pxref{Creating Symbols}), the names
-of all symbols in the obarray form the set of permissible completions. The
-global variable @code{obarray} holds an obarray containing the names of
-all interned Lisp symbols.
-
-Note that the only valid way to make a new obarray is to create it
-empty and then add symbols to it one by one using @code{intern}.
-Also, you cannot intern a given symbol in more than one obarray.
+of all symbols in the obarray form the set of permissible completions.
If @var{collection} is a hash table, then the keys that are strings
are the possible completions. Other keys are ignored.
-You can also use a function as @var{collection}.
-Then the function is solely responsible for performing completion;
-@code{try-completion} returns whatever this function returns. The
-function is called with three arguments: @var{string}, @var{predicate}
-and @code{nil} (the reason for the third argument is so that the same
-function can be used in @code{all-completions} and do the appropriate
-thing in either case). @xref{Programmed Completion}.
+You can also use a function as @var{collection}. Then the function is
+solely responsible for performing completion; @code{try-completion}
+returns whatever this function returns. The function is called with
+three arguments: @var{string}, @var{predicate} and @code{nil} (the
+third argument is so that the same function can be used
+in @code{all-completions} and do the appropriate thing in either
+case). @xref{Programmed Completion}.
If the argument @var{predicate} is non-@code{nil}, then it must be a
function of one argument, unless @var{collection} is a hash table, in
@@ -705,8 +718,8 @@ handle @code{completion-regexp-list} itself.)
In the first of the following examples, the string @samp{foo} is
matched by three of the alist @sc{car}s. All of the matches begin with
the characters @samp{fooba}, so that is the result. In the second
-example, there is only one possible match, and it is exact, so the value
-is @code{t}.
+example, there is only one possible match, and it is exact, so the
+return value is @code{t}.
@smallexample
@group
@@ -754,16 +767,20 @@ too short). Both of those begin with the string @samp{foobar}.
@end smallexample
@end defun
-@defun all-completions string collection &optional predicate nospace
+@c Removed obsolete argument nospace.
+@defun all-completions string collection &optional predicate
This function returns a list of all possible completions of
-@var{string}. The arguments to this function (aside from
-@var{nospace}) are the same as those of @code{try-completion}. Also,
-this function uses @code{completion-regexp-list} in the same way that
+@var{string}. The arguments to this function
+@c (aside from @var{nospace})
+are the same as those of @code{try-completion}, and it
+uses @code{completion-regexp-list} in the same way that
@code{try-completion} does.
+@ignore
The optional argument @var{nospace} is obsolete. If it is
non-@code{nil}, completions that start with a space are ignored unless
@var{string} starts with a space.
+@end ignore
If @var{collection} is a function, it is called with three arguments:
@var{string}, @var{predicate} and @code{t}; then @code{all-completions}
@@ -792,7 +809,7 @@ example for @code{try-completion}:
@defun test-completion string collection &optional predicate
@anchor{Definition of test-completion}
This function returns non-@code{nil} if @var{string} is a valid
-completion possibility specified by @var{collection} and
+completion alternative specified by @var{collection} and
@var{predicate}. The arguments are the same as in
@code{try-completion}. For instance, if @var{collection} is a list of
strings, this is true if @var{string} appears in the list and
@@ -833,7 +850,7 @@ pertains to the area after @code{"/usr/"} and before @code{"/doc"}.
@end defun
If you store a completion alist in a variable, you should mark the
-variable as ``risky'' with a non-@code{nil}
+variable as ``risky'' by giving it a non-@code{nil}
@code{risky-local-variable} property. @xref{File Local Variables}.
@defvar completion-ignore-case
@@ -862,29 +879,32 @@ proper value is done the first time you do completion using @var{var}.
It is done by calling @var{fun} with no arguments. The
value @var{fun} returns becomes the permanent value of @var{var}.
-Here is an example of use:
+Here is an example:
@smallexample
(defvar foo (lazy-completion-table foo make-my-alist))
@end smallexample
@end defmac
-The function @code{completion-in-region} provides a convenient way to
-perform completion on an arbitrary stretch of text in an Emacs buffer:
+@c FIXME? completion-table-with-context?
+@findex completion-table-case-fold
+@findex completion-table-in-turn
+@findex completion-table-subvert
+@findex completion-table-with-quoting
+@findex completion-table-with-predicate
+@findex completion-table-with-terminator
+@cindex completion table, modifying
+@cindex completion tables, combining
+There are several functions that take an existing completion table and
+return a modified version. @code{completion-table-case-fold} returns
+a case-insensitive table. @code{completion-table-in-turn} combines
+multiple input tables. @code{completion-table-subvert} alters a table
+to use a different initial prefix. @code{completion-table-with-quoting}
+returns a table suitable for operating on quoted text.
+@code{completion-table-with-predicate} filters a table with a
+predicate function. @code{completion-table-with-terminator} adds a
+terminating string.
-@defun completion-in-region start end collection &optional predicate
-This function completes the text in the current buffer between the
-positions @var{start} and @var{end}, using @var{collection}. The
-argument @var{collection} has the same meaning as in
-@code{try-completion} (@pxref{Basic Completion}).
-
-This function inserts the completion text directly into the current
-buffer. Unlike @code{completing-read} (@pxref{Minibuffer
-Completion}), it does not activate the minibuffer.
-
-For this function to work, point must be somewhere between @var{start}
-and @var{end}.
-@end defun
@node Minibuffer Completion
@subsection Completion and the Minibuffer
@@ -894,18 +914,19 @@ and @var{end}.
This section describes the basic interface for reading from the
minibuffer with completion.
-@defun completing-read prompt collection &optional predicate require-match initial hist default inherit-input-method
+@defun completing-read prompt collection &optional predicate require-match initial history default inherit-input-method
This function reads a string in the minibuffer, assisting the user by
providing completion. It activates the minibuffer with prompt
@var{prompt}, which must be a string.
-The actual completion is done by passing @var{collection} and
-@var{predicate} to the function @code{try-completion} (@pxref{Basic
-Completion}). This happens in certain commands bound in the local
-keymaps used for completion. Some of these commands also call
-@code{test-completion}. Thus, if @var{predicate} is non-@code{nil},
-it should be compatible with @var{collection} and
-@code{completion-ignore-case}. @xref{Definition of test-completion}.
+The actual completion is done by passing the completion table
+@var{collection} and the completion predicate @var{predicate} to the
+function @code{try-completion} (@pxref{Basic Completion}). This
+happens in certain commands bound in the local keymaps used for
+completion. Some of these commands also call @code{test-completion}.
+Thus, if @var{predicate} is non-@code{nil}, it should be compatible
+with @var{collection} and @code{completion-ignore-case}.
+@xref{Definition of test-completion}.
The value of the optional argument @var{require-match} determines how
the user may exit the minibuffer:
@@ -948,13 +969,13 @@ The function @code{completing-read} uses
@code{minibuffer-local-must-match-map} if @var{require-match} is
non-@code{nil}. @xref{Completion Commands}.
-The argument @var{hist} specifies which history list variable to use for
+The argument @var{history} specifies which history list variable to use for
saving the input and for minibuffer history commands. It defaults to
@code{minibuffer-history}. @xref{Minibuffer History}.
The argument @var{initial} is mostly deprecated; we recommend using a
non-@code{nil} value only in conjunction with specifying a cons cell
-for @var{hist}. @xref{Initial Input}. For default input, use
+for @var{history}. @xref{Initial Input}. For default input, use
@var{default} instead.
If the argument @var{inherit-input-method} is non-@code{nil}, then the
@@ -963,7 +984,7 @@ Methods}) and the setting of @code{enable-multibyte-characters}
(@pxref{Text Representations}) from whichever buffer was current before
entering the minibuffer.
-If the built-in variable @code{completion-ignore-case} is
+If the variable @code{completion-ignore-case} is
non-@code{nil}, completion ignores case when comparing the input
against the possible matches. @xref{Basic Completion}. In this mode
of operation, @var{predicate} must also ignore case, or you will get
@@ -998,6 +1019,14 @@ information to the commands that actually do completion.
They are described in the following section.
@end defun
+@defvar completing-read-function
+The value of this variable must be a function, which is called by
+@code{completing-read} to actually do its work. It should accept the
+same arguments as @code{completing-read}. This can be bound to a
+different function to completely override the normal behavior of
+@code{completing-read}.
+@end defvar
+
@node Completion Commands
@subsection Minibuffer Commands that Do Completion
@@ -1005,10 +1034,11 @@ They are described in the following section.
in the minibuffer to do completion.
@defvar minibuffer-completion-table
-The value of this variable is the collection used for completion in
-the minibuffer. This is the global variable that contains what
+The value of this variable is the completion table used for completion
+in the minibuffer. This is the global variable that contains what
@code{completing-read} passes to @code{try-completion}. It is used by
-minibuffer completion commands such as @code{minibuffer-complete-word}.
+minibuffer completion commands such as
+@code{minibuffer-complete-word}.
@end defvar
@defvar minibuffer-completion-predicate
@@ -1066,7 +1096,7 @@ using the value of the variable @code{minibuffer-completion-table} as
the @var{collection} argument, and the value of
@code{minibuffer-completion-predicate} as the @var{predicate} argument.
The list of completions is displayed as text in a buffer named
-@samp{*Completions*}.
+@file{*Completions*}.
@end deffn
@defun display-completion-list completions &optional common-substring
@@ -1087,8 +1117,8 @@ uses this to highlight text in the completion list for better visual
feedback. This is not needed in the minibuffer; for minibuffer
completion, you can pass @code{nil}.
-This function is called by @code{minibuffer-completion-help}. The
-most common way to use it is together with
+This function is called by @code{minibuffer-completion-help}. A
+common way to use it is together with
@code{with-output-to-temp-buffer}, like this:
@example
@@ -1122,7 +1152,7 @@ keymap makes the following bindings:
@end table
@noindent
-with other characters bound as in @code{minibuffer-local-map}
+and uses @code{minibuffer-local-map} as its parent keymap
(@pxref{Definition of minibuffer-local-map}).
@end defvar
@@ -1134,15 +1164,6 @@ minibuffer unconditionally. By default, this keymap makes the following
bindings:
@table @asis
-@item @kbd{?}
-@code{minibuffer-completion-help}
-
-@item @key{SPC}
-@code{minibuffer-complete-word}
-
-@item @key{TAB}
-@code{minibuffer-complete}
-
@item @kbd{C-j}
@code{minibuffer-complete-and-exit}
@@ -1151,25 +1172,21 @@ bindings:
@end table
@noindent
-with other characters bound as in @code{minibuffer-local-map}.
+and uses @code{minibuffer-local-completion-map} as its parent keymap.
@end defvar
@defvar minibuffer-local-filename-completion-map
-This is like @code{minibuffer-local-completion-map}
-except that it does not bind @key{SPC}. This keymap is used by the
-function @code{read-file-name}.
+This is a sparse keymap that simply unbinds @key{SPC}; because
+filenames can contain spaces. The function @code{read-file-name}
+combines this keymap with either @code{minibuffer-local-completion-map}
+or @code{minibuffer-local-must-match-map}.
@end defvar
-@defvar minibuffer-local-filename-must-match-map
-This is like @code{minibuffer-local-must-match-map}
-except that it does not bind @key{SPC}. This keymap is used by the
-function @code{read-file-name}.
-@end defvar
@node High-Level Completion
@subsection High-Level Completion Functions
- This section describes the higher-level convenient functions for
+ This section describes the higher-level convenience functions for
reading certain sorts of names with completion.
In most cases, you should not call these functions in the middle of a
@@ -1221,11 +1238,9 @@ Buffer name (default foo): @point{}
@end defun
@defopt read-buffer-function
-This variable specifies how to read buffer names. The function is
-called with the arguments passed to @code{read-buffer}. For example,
-if you set this variable to @code{iswitchb-read-buffer}, all Emacs
-commands that call @code{read-buffer} to read a buffer name will
-actually use the @code{iswitchb} package to read it.
+This variable, if non-@code{nil}, specifies a function for reading
+buffer names. @code{read-buffer} calls this function instead of doing
+its usual work, with the same arguments passed to @code{read-buffer}.
@end defopt
@defopt read-buffer-completion-ignore-case
@@ -1243,7 +1258,7 @@ for which @code{commandp} returns @code{t}. @xref{Interactive Call}.
The argument @var{default} specifies what to return if the user enters
null input. It can be a symbol, a string or a list of strings. If it
is a string, @code{read-command} interns it before returning it.
-If it is a list, @code{read-command} returns the first element of this list.
+If it is a list, @code{read-command} interns the first element of this list.
If @var{default} is @code{nil}, that means no default has been
specified; then if the user enters null input, the return value is
@code{(intern "")}, that is, a symbol whose name is an empty string.
@@ -1285,69 +1300,29 @@ complete in the set of extant Lisp symbols, and it uses the
@defun read-variable prompt &optional default
@anchor{Definition of read-variable}
-This function reads the name of a user variable and returns it as a
-symbol.
-
-The argument @var{default} specifies the default value to return if
-the user enters null input. It can be a symbol, a string, or a list
-of strings. If it is a string, @code{read-variable} interns it to
-make the default value. If it is a list, @code{read-variable} interns
-the first element. If @var{default} is @code{nil}, that means no
-default has been specified; then if the user enters null input, the
-return value is @code{(intern "")}.
-
-@example
-@group
-(read-variable "Variable name? ")
-
-;; @r{After evaluation of the preceding expression,}
-;; @r{the following prompt appears,}
-;; @r{with an empty minibuffer:}
-@end group
-
-@group
----------- Buffer: Minibuffer ----------
-Variable name? @point{}
----------- Buffer: Minibuffer ----------
-@end group
-@end example
-
-@noindent
-If the user then types @kbd{fill-p @key{RET}}, @code{read-variable}
-returns @code{fill-prefix}.
-
-In general, @code{read-variable} is similar to @code{read-command},
-but uses the predicate @code{user-variable-p} instead of
-@code{commandp}:
-
-@cindex @code{user-variable-p} example
-@example
-@group
-(read-variable @var{prompt})
-@equiv{}
-(intern
- (completing-read @var{prompt} obarray
- 'user-variable-p t nil))
-@end group
-@end example
+This function reads the name of a customizable variable and returns it
+as a symbol. Its arguments have the same form as those of
+@code{read-command}. It behaves just like @code{read-command}, except
+that it uses the predicate @code{custom-variable-p} instead of
+@code{commandp}.
@end defun
@deffn Command read-color &optional prompt convert allow-empty display
This function reads a string that is a color specification, either the
color's name or an RGB hex value such as @code{#RRRGGGBBB}. It
-prompts with @var{prompt} (default: @code{"Color (name or #R+G+B+):"})
+prompts with @var{prompt} (default: @code{"Color (name or #RGB triplet):"})
and provides completion for color names, but not for hex RGB values.
In addition to names of standard colors, completion candidates include
the foreground and background colors at point.
Valid RGB values are described in @ref{Color Names}.
-The function's return value is the color name typed by the user in the
+The function's return value is the string typed by the user in the
minibuffer. However, when called interactively or if the optional
-argument @var{convert} is non-@code{nil}, it converts the name into
-the color's RGB value and returns that value as a string. If an
-invalid color name was specified, this function signals an error,
-except that empty color names are allowed when @code{allow-empty} is
+argument @var{convert} is non-@code{nil}, it converts any input color
+name into the corresponding RGB value string and instead returns that.
+This function requires a valid color specification to be input.
+Empty color names are allowed when @var{allow-empty} is
non-@code{nil} and the user enters null input.
Interactively, or when @var{display} is non-@code{nil}, the return
@@ -1365,7 +1340,7 @@ and @code{read-input-method-name}, in @ref{Input Methods}.
The high-level completion functions @code{read-file-name},
@code{read-directory-name}, and @code{read-shell-command} are designed
-to read file names, directory names, and shell commands respectively.
+to read file names, directory names, and shell commands, respectively.
They provide special features, including automatic insertion of the
default directory.
@@ -1374,30 +1349,40 @@ This function reads a file name, prompting with @var{prompt} and
providing completion.
As an exception, this function reads a file name using a graphical
-file dialog instead of the minibuffer, if (i) it is invoked via a
-mouse command, and (ii) the selected frame is on a graphical display
-supporting such dialogs, and (iii) the variable @code{use-dialog-box}
-is non-@code{nil} (@pxref{Dialog Boxes,, Dialog Boxes, emacs, The GNU
-Emacs Manual}), and (iv) the @var{directory} argument, described
-below, does not specify a remote file (@pxref{Remote Files,, Remote
-Files, emacs, The GNU Emacs Manual}). The exact behavior when using a
-graphical file dialog is platform-dependent. Here, we simply document
-the behavior when using the minibuffer.
+file dialog instead of the minibuffer, if all of the following are
+true:
+
+@enumerate
+@item
+It is invoked via a mouse command.
+
+@item
+The selected frame is on a graphical display supporting such dialogs.
+
+@item
+The variable @code{use-dialog-box} is non-@code{nil}.
+@xref{Dialog Boxes,, Dialog Boxes, emacs, The GNU Emacs Manual}.
+
+@item
+The @var{directory} argument, described below, does not specify a
+remote file. @xref{Remote Files,, Remote Files, emacs, The GNU Emacs Manual}.
+@end enumerate
+
+@noindent
+The exact behavior when using a graphical file dialog is
+platform-dependent. Here, we simply document the behavior when using
+the minibuffer.
@code{read-file-name} does not automatically expand the returned file
name. You must call @code{expand-file-name} yourself if an absolute
file name is required.
The optional argument @var{require-match} has the same meaning as in
-@code{completing-read}. @xref{Minibuffer Completion}. If
-@var{require-match} is @code{nil}, the local keymap in the minibuffer
-is @code{minibuffer-local-filename-completion-map}; otherwise, it is
-@code{minibuffer-local-filename-must-match-map}. @xref{Completion
-Commands}.
+@code{completing-read}. @xref{Minibuffer Completion}.
The argument @var{directory} specifies the directory to use for
completing relative file names. It should be an absolute directory
-name. If @code{insert-default-directory} is non-@code{nil},
+name. If the variable @code{insert-default-directory} is non-@code{nil},
@var{directory} is also inserted in the minibuffer as initial input.
It defaults to the current buffer's value of @code{default-directory}.
@@ -1405,9 +1390,9 @@ If you specify @var{initial}, that is an initial file name to insert
in the buffer (after @var{directory}, if that is inserted). In this
case, point goes at the beginning of @var{initial}. The default for
@var{initial} is @code{nil}---don't insert any file name. To see what
-@var{initial} does, try the command @kbd{C-x C-v}. @strong{Please
-note:} we recommend using @var{default} rather than @var{initial} in
-most cases.
+@var{initial} does, try the command @kbd{C-x C-v} in a buffer visiting
+a file. @strong{Please note:} we recommend using @var{default} rather
+than @var{initial} in most cases.
If @var{default} is non-@code{nil}, then the function returns
@var{default} if the user exits the minibuffer with the same non-empty
@@ -1437,11 +1422,11 @@ returns the pre-inserted contents of the minibuffer.
If the user types @key{RET} in an empty minibuffer, this function
returns an empty string, regardless of the value of
@var{require-match}. This is, for instance, how the user can make the
-current buffer visit no file using @code{M-x set-visited-file-name}.
+current buffer visit no file using @kbd{M-x set-visited-file-name}.
If @var{predicate} is non-@code{nil}, it specifies a function of one
argument that decides which file names are acceptable completion
-possibilities. A file name is an acceptable value if @var{predicate}
+alternatives. A file name is an acceptable value if @var{predicate}
returns non-@code{nil} for it.
Here is an example of using @code{read-file-name}:
@@ -1492,7 +1477,7 @@ when performing completion.
@defun read-directory-name prompt &optional directory default require-match initial
This function is like @code{read-file-name} but allows only directory
-names as completion possibilities.
+names as completion alternatives.
If @var{default} is @code{nil} and @var{initial} is non-@code{nil},
@code{read-directory-name} constructs a substitute default by
@@ -1510,7 +1495,7 @@ use the code letters @samp{f} or @samp{F} in their interactive form.
@xref{Interactive Codes,, Code Characters for interactive}.) Its
value controls whether @code{read-file-name} starts by placing the
name of the default directory in the minibuffer, plus the initial file
-name if any. If the value of this variable is @code{nil}, then
+name, if any. If the value of this variable is @code{nil}, then
@code{read-file-name} does not place any initial input in the
minibuffer (unless you specify initial input with the @var{initial}
argument). In that case, the default directory is still used for
@@ -1553,17 +1538,17 @@ The file is @point{}
@end example
@end defopt
-@defun read-shell-command prompt &optional initial-contents hist &rest args
+@defun read-shell-command prompt &optional initial history &rest args
This function reads a shell command from the minibuffer, prompting
with @var{prompt} and providing intelligent completion. It completes
the first word of the command using candidates that are appropriate
for command names, and the rest of the command words as file names.
This function uses @code{minibuffer-local-shell-command-map} as the
-keymap for minibuffer input. The @var{hist} argument specifies the
+keymap for minibuffer input. The @var{history} argument specifies the
history list to use; if is omitted or @code{nil}, it defaults to
@code{shell-command-history} (@pxref{Minibuffer History,
-shell-command-history}). The optional argument @var{initial-contents}
+shell-command-history}). The optional argument @var{initial}
specifies the initial content of the minibuffer (@pxref{Initial
Input}). The rest of @var{args}, if present, are used as the
@var{default} and @var{inherit-input-method} arguments in
@@ -1572,60 +1557,115 @@ Input}). The rest of @var{args}, if present, are used as the
@defvar minibuffer-local-shell-command-map
This keymap is used by @code{read-shell-command} for completing
-command and file names that are part of a shell command.
+command and file names that are part of a shell command. It uses
+@code{minibuffer-local-map} as its parent keymap, and binds @key{TAB}
+to @code{completion-at-point}.
@end defvar
-@node Completion Styles
-@subsection Completion Styles
-@cindex completion styles
+@node Completion Variables
+@subsection Completion Variables
- A @dfn{completion style} is a set of rules for generating
-completions. The user option @code{completion-styles} stores a list
-of completion styles, which are represented by symbols.
+ Here are some variables that can be used to alter the default
+completion behavior.
+@cindex completion styles
@defopt completion-styles
-This is a list of completion style symbols to use for performing
-completion. Each completion style in this list must be defined in
-@code{completion-styles-alist}.
+The value of this variable is a list of completion style (symbols) to
+use for performing completion. A @dfn{completion style} is a set of
+rules for generating completions. Each symbol occurring this list
+must have a corresponding entry in @code{completion-styles-alist}.
@end defopt
@defvar completion-styles-alist
This variable stores a list of available completion styles. Each
-element in the list must have the form @samp{(@var{name}
-@var{try-completion} @var{all-completions})}. Here, @var{name} is the
-name of the completion style (a symbol), which may be used in
-@code{completion-styles-alist} to refer to this style.
-
-@var{try-completion} is the function that does the completion, and
-@var{all-completions} is the function that lists the completions.
-These functions should accept four arguments: @var{string},
-@var{collection}, @var{predicate}, and @var{point}. The @var{string},
-@var{collection}, and @var{predicate} arguments have the same meanings
-as in @code{try-completion} (@pxref{Basic Completion}), and the
-@var{point} argument is the position of point within @var{string}.
-Each function should return a non-@code{nil} value if it performed its
-job, and @code{nil} if it did not (e.g., if there is no way to
-complete @var{string} according to the completion style).
-
-When the user calls a completion command, such as
+element in the list has the form
+
+@example
+(@var{style} @var{try-completion} @var{all-completions} @var{doc})
+@end example
+
+@noindent
+Here, @var{style} is the name of the completion style (a symbol),
+which may be used in the @code{completion-styles} variable to refer to
+this style; @var{try-completion} is the function that does the
+completion; @var{all-completions} is the function that lists the
+completions; and @var{doc} is a string describing the completion
+style.
+
+The @var{try-completion} and @var{all-completions} functions should
+each accept four arguments: @var{string}, @var{collection},
+@var{predicate}, and @var{point}. The @var{string}, @var{collection},
+and @var{predicate} arguments have the same meanings as in
+@code{try-completion} (@pxref{Basic Completion}), and the @var{point}
+argument is the position of point within @var{string}. Each function
+should return a non-@code{nil} value if it performed its job, and
+@code{nil} if it did not (e.g.@: if there is no way to complete
+@var{string} according to the completion style).
+
+When the user calls a completion command like
@code{minibuffer-complete} (@pxref{Completion Commands}), Emacs looks
for the first style listed in @code{completion-styles} and calls its
@var{try-completion} function. If this function returns @code{nil},
-Emacs moves to the next completion style listed in
-@code{completion-styles} and calls its @var{try-completion} function,
-and so on until one of the @var{try-completion} functions successfully
-performs completion and returns a non-@code{nil} value. A similar
-procedure is used for listing completions, via the
-@var{all-completions} functions.
+Emacs moves to the next listed completion style and calls its
+@var{try-completion} function, and so on until one of the
+@var{try-completion} functions successfully performs completion and
+returns a non-@code{nil} value. A similar procedure is used for
+listing completions, via the @var{all-completions} functions.
+
+@xref{Completion Styles,,, emacs, The GNU Emacs Manual}, for a
+description of the available completion styles.
@end defvar
- By default, @code{completion-styles-alist} contains five pre-defined
-completion styles: @code{basic}, a basic completion style;
-@code{partial-completion}, which does partial completion (completing
-each word in the input separately); @code{emacs22}, which performs
-completion according to the rules used in Emacs 22; @code{emacs21},
-which performs completion according to the rules used in Emacs 21; and
-@code{initials}, which completes acronyms and initialisms.
+@defopt completion-category-overrides
+This variable specifies special completion styles and other completion
+behaviors to use when completing certain types of text. Its value
+should be an alist with elements of the form @code{(@var{category}
+. @var{alist})}. @var{category} is a symbol describing what is being
+completed; currently, the @code{buffer}, @code{file}, and
+@code{unicode-name} categories are defined, but others can be defined
+via specialized completion functions (@pxref{Programmed Completion}).
+@var{alist} is an association list describing how completion should
+behave for the corresponding category. The following alist keys are
+supported:
+
+@table @code
+@item styles
+The value should be a list of completion styles (symbols).
+
+@item cycle
+The value should be a value for @code{completion-cycle-threshold}
+(@pxref{Completion Options,,, emacs, The GNU Emacs Manual}) for this
+category.
+@end table
+
+@noindent
+Additional alist entries may be defined in the future.
+@end defopt
+
+@defvar completion-extra-properties
+This variable is used to specify extra properties of the current
+completion command. It is intended to be let-bound by specialized
+completion commands. Its value should be a list of property and value
+pairs. The following properties are supported:
+
+@table @code
+@item :annotation-function
+The value should be a function to add annotations in the completions
+buffer. This function must accept one argument, a completion, and
+should either return @code{nil} or a string to be displayed next to
+the completion.
+
+@item :exit-function
+The value should be a function to run after performing completion.
+The function should accept two arguments, @var{string} and
+@var{status}, where @var{string} is the text to which the field was
+completed, and @var{status} indicates what kind of operation happened:
+@code{finished} if text is now complete, @code{sole} if the text
+cannot be further completed but completion is not finished, or
+@code{exact} if the text is a valid completion but may be further
+completed.
+@end table
+@end defvar
@node Programmed Completion
@subsection Programmed Completion
@@ -1652,71 +1692,175 @@ the work.
The string to be completed.
@item
-The predicate function to filter possible matches, or @code{nil} if
-none. Your function should call the predicate for each possible match,
-and ignore the possible match if the predicate returns @code{nil}.
+A predicate function with which to filter possible matches, or
+@code{nil} if none. The function should call the predicate for each
+possible match, and ignore the match if the predicate returns
+@code{nil}.
@item
-A flag specifying the type of operation. The best way to think about
-it is that the function stands for an object (in the
-``object-oriented'' sense of the word), and this third argument
-specifies which method to run.
-@end itemize
-
- There are currently four methods, i.e. four flag values, one for
-each of the four different basic operations:
-
-@itemize @bullet
-@item
-@code{nil} specifies @code{try-completion}. The completion function
-should return the completion of the specified string, or @code{t} if the
-string is a unique and exact match already, or @code{nil} if the string
-matches no possibility.
-
-If the string is an exact match for one possibility, but also matches
-other longer possibilities, the function should return the string, not
-@code{t}.
-
-@item
-@code{t} specifies @code{all-completions}. The completion function
+A flag specifying the type of completion operation to perform. This
+is one of the following four values:
+
+@table @code
+@item nil
+This specifies a @code{try-completion} operation. The function should
+return @code{t} if the specified string is a unique and exact match;
+if there is more than one match, it should return the common substring
+of all matches (if the string is an exact match for one completion
+alternative but also matches other longer alternatives, the return
+value is the string); if there are no matches, it should return
+@code{nil}.
+
+@item t
+This specifies an @code{all-completions} operation. The function
should return a list of all possible completions of the specified
string.
-@item
-@code{lambda} specifies @code{test-completion}. The completion
-function should return @code{t} if the specified string is an exact
-match for some possibility; @code{nil} otherwise.
+@item lambda
+This specifies a @code{test-completion} operation. The function
+should return @code{t} if the specified string is an exact match for
+some completion alternative; @code{nil} otherwise.
+
+@item (boundaries . @var{suffix})
+This specifies a @code{completion-boundaries} operation. The function
+should return @code{(boundaries @var{start} . @var{end})}, where
+@var{start} is the position of the beginning boundary in the specified
+string, and @var{end} is the position of the end boundary in
+@var{suffix}.
+
+@item metadata
+This specifies a request for information about the state of the
+current completion. The return value should have the form
+@code{(metadata . @var{alist})}, where @var{alist} is an alist whose
+elements are described below.
+@end table
-@item
-@code{(boundaries . SUFFIX)} specifies @code{completion-boundaries}.
-The function should return a value of the form @code{(boundaries
-START . END)} where START is the position of the beginning boundary
-in the string to complete, and END is the position of the end boundary
-in SUFFIX.
+@noindent
+If the flag has any other value, the completion function should return
+@code{nil}.
@end itemize
+The following is a list of metadata entries that a completion function
+may return in response to a @code{metadata} flag argument:
+
+@table @code
+@item category
+The value should be a symbol describing what kind of text the
+completion function is trying to complete. If the symbol matches one
+of the keys in @code{completion-category-overrides}, the usual
+completion behavior is overridden. @xref{Completion Variables}.
+
+@item annotation-function
+The value should be a function for @dfn{annotating} completions. The
+function should take one argument, @var{string}, which is a possible
+completion. It should return a string, which is displayed after the
+completion @var{string} in the @file{*Completions*} buffer.
+
+@item display-sort-function
+The value should be a function for sorting completions. The function
+should take one argument, a list of completion strings, and return a
+sorted list of completion strings. It is allowed to alter the input
+list destructively.
+
+@item cycle-sort-function
+The value should be a function for sorting completions, when
+@code{completion-cycle-threshold} is non-@code{nil} and the user is
+cycling through completion alternatives. @xref{Completion Options,,,
+emacs, The GNU Emacs Manual}. Its argument list and return value are
+the same as for @code{display-sort-function}.
+@end table
+
@defun completion-table-dynamic function
This function is a convenient way to write a function that can act as
-programmed completion function. The argument @var{function} should be
+a programmed completion function. The argument @var{function} should be
a function that takes one argument, a string, and returns an alist of
possible completions of it. You can think of
@code{completion-table-dynamic} as a transducer between that interface
and the interface for programmed completion functions.
@end defun
-@defvar completion-annotate-function
-The value of this variable, if non-@code{nil}, should be a function
-for ``annotating'' the entries in the @samp{*Completions*} buffer.
-The function should accept a single argument, the completion string
-for an entry. It should return an additional string to display next
-to that entry in the @samp{*Completions*} buffer, or @code{nil} if no
-additional string is to be displayed.
-
-The function can determine the collection used for the current
-completion via the variable @code{minibuffer-completion-table}
-(@pxref{Completion Commands}).
+@node Completion in Buffers
+@subsection Completion in Ordinary Buffers
+@cindex inline completion
+
+@findex completion-at-point
+ Although completion is usually done in the minibuffer, the
+completion facility can also be used on the text in ordinary Emacs
+buffers. In many major modes, in-buffer completion is performed by
+the @kbd{C-M-i} or @kbd{M-@key{TAB}} command, bound to
+@code{completion-at-point}. @xref{Symbol Completion,,, emacs, The GNU
+Emacs Manual}. This command uses the abnormal hook variable
+@code{completion-at-point-functions}:
+
+@defvar completion-at-point-functions
+The value of this abnormal hook should be a list of functions, which
+are used to compute a completion table for completing the text at
+point. It can be used by major modes to provide mode-specific
+completion tables (@pxref{Major Mode Conventions}).
+
+When the command @code{completion-at-point} runs, it calls the
+functions in the list one by one, without any argument. Each function
+should return @code{nil} if it is unable to produce a completion table
+for the text at point. Otherwise it should return a list of the form
+
+@example
+(@var{start} @var{end} @var{collection} . @var{props})
+@end example
+
+@noindent
+@var{start} and @var{end} delimit the text to complete (which should
+enclose point). @var{collection} is a completion table for completing
+that text, in a form suitable for passing as the second argument to
+@code{try-completion} (@pxref{Basic Completion}); completion
+alternatives will be generated from this completion table in the usual
+way, via the completion styles defined in @code{completion-styles}
+(@pxref{Completion Variables}). @var{props} is a property list for
+additional information; any of the properties in
+@code{completion-extra-properties} are recognized (@pxref{Completion
+Variables}), as well as the following additional ones:
+
+@table @code
+@item :predicate
+The value should be a predicate that completion candidates need to
+satisfy.
+
+@item :exclusive
+If the value is @code{no}, then if the completion table fails to match
+the text at point, @code{completion-at-point} moves on to the
+next function in @code{completion-at-point-functions} instead of
+reporting a completion failure.
+@end table
+
+A function in @code{completion-at-point-functions} may also return a
+function. In that case, that returned function is called, with no
+argument, and it is entirely responsible for performing the
+completion. We discourage this usage; it is intended to help convert
+old code to using @code{completion-at-point}.
+
+The first function in @code{completion-at-point-functions} to return a
+non-@code{nil} value is used by @code{completion-at-point}. The
+remaining functions are not called. The exception to this is when
+there is an @code{:exclusive} specification, as described above.
@end defvar
+ The following function provides a convenient way to perform
+completion on an arbitrary stretch of text in an Emacs buffer:
+
+@defun completion-in-region start end collection &optional predicate
+This function completes the text in the current buffer between the
+positions @var{start} and @var{end}, using @var{collection}. The
+argument @var{collection} has the same meaning as in
+@code{try-completion} (@pxref{Basic Completion}).
+
+This function inserts the completion text directly into the current
+buffer. Unlike @code{completing-read} (@pxref{Minibuffer
+Completion}), it does not activate the minibuffer.
+
+For this function to work, point must be somewhere between @var{start}
+and @var{end}.
+@end defun
+
+
@node Yes-or-No Queries
@section Yes-or-No Queries
@cindex asking the user questions
@@ -1734,7 +1878,7 @@ answer.
using the mouse---more precisely, if @code{last-nonmenu-event}
(@pxref{Command Loop Info}) is either @code{nil} or a list---then it
uses a dialog box or pop-up menu to ask the question. Otherwise, it
-uses keyboard input. You can force use of the mouse or use of keyboard
+uses keyboard input. You can force use either of the mouse or of keyboard
input by binding @code{last-nonmenu-event} to a suitable value around
the call.
@@ -1745,7 +1889,7 @@ the call.
This function asks the user a question, expecting input in the echo
area. It returns @code{t} if the user types @kbd{y}, @code{nil} if the
user types @kbd{n}. This function also accepts @key{SPC} to mean yes
-and @key{DEL} to mean no. It accepts @kbd{C-]} to mean ``quit,'' like
+and @key{DEL} to mean no. It accepts @kbd{C-]} to mean ``quit'', like
@kbd{C-g}, because the question might look like a minibuffer and for
that reason the user might try to use @kbd{C-]} to get out. The answer
is a single character, with no @key{RET} needed to terminate it. Upper
@@ -1763,53 +1907,24 @@ Echo Area}), which uses the same screen space as the minibuffer. The
cursor moves to the echo area while the question is being asked.
The answers and their meanings, even @samp{y} and @samp{n}, are not
-hardwired. The keymap @code{query-replace-map} specifies them.
-@xref{Search and Replace}.
-
-In the following example, the user first types @kbd{q}, which is
-invalid. At the next prompt the user types @kbd{y}.
-
-@smallexample
-@group
-(y-or-n-p "Do you need a lift? ")
-
-;; @r{After evaluation of the preceding expression,}
-;; @r{the following prompt appears in the echo area:}
-@end group
-
-@group
----------- Echo area ----------
-Do you need a lift? (y or n)
----------- Echo area ----------
-@end group
-
-;; @r{If the user then types @kbd{q}, the following appears:}
-
-@group
----------- Echo area ----------
-Please answer y or n. Do you need a lift? (y or n)
----------- Echo area ----------
-@end group
-
-;; @r{When the user types a valid answer,}
-;; @r{it is displayed after the question:}
-
-@group
----------- Echo area ----------
-Do you need a lift? (y or n) y
----------- Echo area ----------
-@end group
-@end smallexample
+hardwired, and are specified by the keymap @code{query-replace-map}
+(@pxref{Search and Replace}). In particular, if the user enters the
+special responses @code{recenter}, @code{scroll-up},
+@code{scroll-down}, @code{scroll-other-window}, or
+@code{scroll-other-window-down} (respectively bound to @kbd{C-l},
+@kbd{C-v}, @kbd{M-v}, @kbd{C-M-v} and @kbd{C-M-S-v} in
+@code{query-replace-map}), this function performs the specified window
+recentering or scrolling operation, and poses the question again.
@noindent
We show successive lines of echo area messages, but only one actually
appears on the screen at a time.
@end defun
-@defun y-or-n-p-with-timeout prompt seconds default-value
+@defun y-or-n-p-with-timeout prompt seconds default
Like @code{y-or-n-p}, except that if the user fails to answer within
@var{seconds} seconds, this function stops waiting and returns
-@var{default-value}. It works by setting up a timer; see @ref{Timers}.
+@var{default}. It works by setting up a timer; see @ref{Timers}.
The argument @var{seconds} may be an integer or a floating point number.
@end defun
@@ -1877,7 +1992,7 @@ single-character answer in the echo area for each one.
The value of @var{list} specifies the objects to ask questions about.
It should be either a list of objects or a generator function. If it is
a function, it should expect no arguments, and should return either the
-next object to ask about, or @code{nil} meaning stop asking questions.
+next object to ask about, or @code{nil}, meaning to stop asking questions.
The argument @var{prompter} specifies how to ask each question. If
@var{prompter} is a string, the question text is computed like this:
@@ -1893,8 +2008,8 @@ where @var{object} is the next object to ask about (as obtained from
If not a string, @var{prompter} should be a function of one argument
(the next object to ask about) and should return the question text. If
the value is a string, that is the question to ask the user. The
-function can also return @code{t} meaning do act on this object (and
-don't ask the user), or @code{nil} meaning ignore this object (and don't
+function can also return @code{t}, meaning do act on this object (and
+don't ask the user), or @code{nil}, meaning ignore this object (and don't
ask the user).
The argument @var{actor} says how to act on the answers that the user
@@ -1935,7 +2050,7 @@ answer); @var{function} is a function of one argument (an object from
When the user responds with @var{char}, @code{map-y-or-n-p} calls
@var{function}. If it returns non-@code{nil}, the object is considered
-``acted upon,'' and @code{map-y-or-n-p} advances to the next object in
+``acted upon'', and @code{map-y-or-n-p} advances to the next object in
@var{list}. If it returns @code{nil}, the prompt is repeated for the
same object.
@@ -1947,12 +2062,14 @@ If @code{map-y-or-n-p} is called in a command that was invoked using the
mouse---more precisely, if @code{last-nonmenu-event} (@pxref{Command
Loop Info}) is either @code{nil} or a list---then it uses a dialog box
or pop-up menu to ask the question. In this case, it does not use
-keyboard input or the echo area. You can force use of the mouse or use
+keyboard input or the echo area. You can force use either of the mouse or
of keyboard input by binding @code{last-nonmenu-event} to a suitable
value around the call.
The return value of @code{map-y-or-n-p} is the number of objects acted on.
@end defun
+@c FIXME An example of this would be more useful than all the
+@c preceding examples of simple things.
@node Reading a Password
@section Reading a Password
@@ -2015,6 +2132,19 @@ This command replaces the minibuffer contents with the value of the
regular expression).
@end deffn
+@deffn Command previous-complete-history-element n
+This command replaces the minibuffer contents with the value of the
+@var{n}th previous (older) history element that completes the current
+contents of the minibuffer before the point.
+@end deffn
+
+@deffn Command next-complete-history-element n
+This command replaces the minibuffer contents with the value of the
+@var{n}th next (newer) history element that completes the current
+contents of the minibuffer before the point.
+@end deffn
+
+
@node Minibuffer Windows
@section Minibuffer Windows
@cindex minibuffer windows
@@ -2024,7 +2154,7 @@ and test whether they are active.
@defun active-minibuffer-window
This function returns the currently active minibuffer window, or
-@code{nil} if none is currently active.
+@code{nil} if there is none.
@end defun
@defun minibuffer-window &optional frame
@@ -2057,8 +2187,8 @@ there can be more than one minibuffer window if there is more than one
frame.
@defun minibuffer-window-active-p window
-This function returns non-@code{nil} if @var{window}, assumed to be
-a minibuffer window, is currently active.
+This function returns non-@code{nil} if @var{window} is the currently
+active minibuffer window.
@end defun
@node Minibuffer Contents
@@ -2173,7 +2303,7 @@ minibuffer, it scrolls this window.
@end defvar
@defun minibuffer-selected-window
-This function returns the window which was selected when the
+This function returns the window that was selected when the
minibuffer was entered. If selected window is not a minibuffer
window, it returns @code{nil}.
@end defun
@@ -2184,10 +2314,19 @@ windows. If a float, it specifies a fraction of the height of the
frame. If an integer, it specifies a number of lines.
@end defopt
+@vindex minibuffer-message-timeout
@defun minibuffer-message string &rest args
This function displays @var{string} temporarily at the end of the
-minibuffer text, for two seconds, or until the next input event
-arrives, whichever comes first. If @var{args} is non-@code{nil}, the
-actual message is obtained by passing @var{string} and @var{args}
-through @code{format}. @xref{Formatting Strings}.
+minibuffer text, for a few seconds, or until the next input event
+arrives, whichever comes first. The variable
+@code{minibuffer-message-timeout} specifies the number of seconds to
+wait in the absence of input. It defaults to 2. If @var{args} is
+non-@code{nil}, the actual message is obtained by passing @var{string}
+and @var{args} through @code{format}. @xref{Formatting Strings}.
@end defun
+
+@deffn Command minibuffer-inactive-mode
+This is the major mode used in inactive minibuffers. It uses
+keymap @code{minibuffer-inactive-mode-map}. This can be useful
+if the minibuffer is in a separate frame. @xref{Minibuffers and Frames}.
+@end deffn
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index fcb7c772936..55d838d111e 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/modes
-@node Modes, Documentation, Keymaps, Top
+@node Modes
@chapter Major and Minor Modes
@cindex mode
@@ -38,7 +37,7 @@ user. For related topics such as keymaps and syntax tables, see
to be called on a particular occasion by an existing program. Emacs
provides hooks for the sake of customization. Most often, hooks are set
up in the init file (@pxref{Init File}), but Lisp programs can set them also.
-@xref{Standard Hooks}, for a list of standard hook variables.
+@xref{Standard Hooks}, for a list of some standard hook variables.
@cindex normal hook
Most of the hooks in Emacs are @dfn{normal hooks}. These variables
@@ -48,17 +47,16 @@ you it is normal. We try to make all hooks normal, as much as
possible, so that you can use them in a uniform way.
Every major mode command is supposed to run a normal hook called the
-@dfn{mode hook} as the one of the last steps of initialization. This
-makes it easy for a user to customize the behavior of the mode, by
-overriding the buffer-local variable assignments already made by the
-mode. Most minor mode functions also run a mode hook at the end. But
-hooks are used in other contexts too. For example, the hook
-@code{suspend-hook} runs just before Emacs suspends itself
-(@pxref{Suspending Emacs}).
-
- The recommended way to add a hook function to a normal hook is by
-calling @code{add-hook} (see below). The hook functions may be any of
-the valid kinds of functions that @code{funcall} accepts (@pxref{What
+@dfn{mode hook} as one of the last steps of initialization. This makes
+it easy for a user to customize the behavior of the mode, by overriding
+the buffer-local variable assignments already made by the mode. Most
+minor mode functions also run a mode hook at the end. But hooks are
+used in other contexts too. For example, the hook @code{suspend-hook}
+runs just before Emacs suspends itself (@pxref{Suspending Emacs}).
+
+ The recommended way to add a hook function to a hook is by calling
+@code{add-hook} (@pxref{Setting Hooks}). The hook functions may be any
+of the valid kinds of functions that @code{funcall} accepts (@pxref{What
Is a Function}). Most normal hook variables are initially void;
@code{add-hook} knows how to deal with this. You can add hooks either
globally or buffer-locally with @code{add-hook}.
@@ -72,9 +70,9 @@ called. You can use @code{add-hook} to add a function to an abnormal
hook, but you must write the function to follow the hook's calling
convention.
- By convention, abnormal hook names end in @samp{-functions} or
-@samp{-hooks}. If the variable's name ends in @samp{-function}, then
-its value is just a single function, not a list of functions.
+ By convention, abnormal hook names end in @samp{-functions}. If the
+variable's name ends in @samp{-function}, then its value is just a single
+function, not a list of functions.
@menu
* Running Hooks:: How to run a hook.
@@ -135,23 +133,42 @@ This macro runs the abnormal hook @code{hook} as a series of nested
``wrapper functions'' around the @var{body} forms. The effect is
similar to nested @code{around} advices (@pxref{Around-Advice}).
-Each hook function must accept an argument list consisting of a function
+Each hook function should accept an argument list consisting of a function
@var{fun}, followed by the additional arguments listed in @var{args}.
-The function @var{fun} passed to the very first hook function in
-@var{hook} does the same as @var{body}, if it is called with arguments
-@var{args}. The @var{fun} passed to each successive hook function is
+The first hook function is passed a function @var{fun} that, if it is
+called with arguments @var{args}, performs @var{body} (i.e., the default
+operation). The @var{fun} passed to each successive hook function is
constructed from all the preceding hook functions (and @var{body}); if
this @var{fun} is called with arguments @var{args}, it does what the
@code{with-wrapper-hook} call would if the preceding hook functions were
the only ones in @var{hook}.
-In the function definition of the hook function, @var{fun} can be called
-any number of times (including not calling it at all). This function
-definition is then used to construct the @var{fun} passed to the next
-hook function in @var{hook}, if any. The last or ``outermost''
-@var{fun} is called once to produce the effect.
+Each hook function may call its @var{fun} argument as many times as it
+wishes, including never. In that case, such a hook function acts to
+replace the default definition altogether, and any preceding hook
+functions. Of course, a subsequent hook function may do the same thing.
+
+Each hook function definition is used to construct the @var{fun} passed
+to the next hook function in @var{hook}, if any. The last or
+``outermost'' @var{fun} is called once to produce the overall effect.
+
+When might you want to use a wrapper hook? The function
+@code{filter-buffer-substring} illustrates a common case. There is a
+basic functionality, performed by @var{body}---in this case, to extract
+a buffer-substring. Then any number of hook functions can act in
+sequence to modify that string, before returning the final result.
+A wrapper-hook also allows for a hook function to completely replace the
+default definition (by not calling @var{fun}).
@end defmac
+@defun run-hook-wrapped hook wrap-function &rest args
+This function is similar to @code{run-hook-with-args-until-success}.
+Like that function, it runs the functions on the abnormal hook
+@code{hook}, stopping at the first one that returns non-@code{nil}.
+Instead of calling the hook functions directly, though, it actually
+calls @code{wrap-function} with arguments @code{fun} and @code{args}.
+@end defun
+
@node Setting Hooks
@subsection Setting Hooks
@@ -159,7 +176,7 @@ hook function in @var{hook}, if any. The last or ``outermost''
in Lisp Interaction mode:
@example
-(add-hook 'lisp-interaction-mode-hook 'turn-on-auto-fill)
+(add-hook 'lisp-interaction-mode-hook 'auto-fill-mode)
@end example
@defun add-hook hook function &optional append local
@@ -183,13 +200,13 @@ If @var{function} has a non-@code{nil} property
changing major modes) won't delete it from the hook variable's local
value.
-It is best to design your hook functions so that the order in which
-they are executed does not matter. Any dependence on the order is
-asking for trouble. However, the order is predictable: normally,
-@var{function} goes at the front of the hook list, so it will be
-executed first (barring another @code{add-hook} call). If the
-optional argument @var{append} is non-@code{nil}, the new hook
-function goes at the end of the hook list and will be executed last.
+For a normal hook, hook functions should be designed so that the order
+in which they are executed does not matter. Any dependence on the order
+is asking for trouble. However, the order is predictable: normally,
+@var{function} goes at the front of the hook list, so it is executed
+first (barring another @code{add-hook} call). If the optional argument
+@var{append} is non-@code{nil}, the new hook function goes at the end of
+the hook list and is executed last.
@code{add-hook} can handle the cases where @var{hook} is void or its
value is a single function; it sets or changes the value to a list of
@@ -266,9 +283,10 @@ buffer is put in Fundamental mode (@pxref{Major Mode Conventions}).
* Derived Modes:: Defining a new major mode based on another major
mode.
* Basic Major Modes:: Modes that other modes are often derived from.
+* Mode Hooks:: Hooks run at the end of major mode functions.
+* Tabulated List Mode:: Parent mode for buffers containing tabulated data.
* Generic Modes:: Defining a simple major mode that supports
comment syntax and Font Lock mode.
-* Mode Hooks:: Hooks run at the end of major mode commands.
* Example Major Modes:: Text mode and Lisp modes.
@end menu
@@ -283,8 +301,8 @@ initialization, function and variable names, and hooks.
If you use the @code{define-derived-mode} macro, it will take care of
many of these conventions automatically. @xref{Derived Modes}. Note
-also that fundamental mode is an exception to many of these conventions,
-because its definition is to present the global state of Emacs.
+also that Fundamental mode is an exception to many of these conventions,
+because it represents the default state of Emacs.
The following list of conventions is only partial. Each major mode
should aim for consistency in general with other Emacs major modes, as
@@ -366,7 +384,7 @@ reserved for users.
A major mode can also rebind the keys @kbd{M-n}, @kbd{M-p} and
@kbd{M-s}. The bindings for @kbd{M-n} and @kbd{M-p} should normally
-be some kind of ``moving forward and backward,'' but this does not
+be some kind of ``moving forward and backward'', but this does not
necessarily mean cursor motion.
It is legitimate for a major mode to rebind a standard key sequence if
@@ -441,13 +459,9 @@ The mode can specify a local value for
this mode.
@item
-The mode can specify how to complete various keywords by adding
-to the special hook @code{completion-at-point-functions}.
-
-@item
-Use @code{defvar} or @code{defcustom} to set mode-related variables, so
-that they are not reinitialized if they already have a value. (Such
-reinitialization could discard customizations made by the user.)
+The mode can specify how to complete various keywords by adding one or
+more buffer-local entries to the special hook
+@code{completion-at-point-functions}. @xref{Completion in Buffers}.
@item
@cindex buffer-local variables in modes
@@ -468,8 +482,9 @@ other packages would interfere with them.
@cindex major mode hook
Each major mode should have a normal @dfn{mode hook} named
@code{@var{modename}-mode-hook}. The very last thing the major mode command
-should do is to call @code{run-mode-hooks}. This runs the mode hook,
-and then runs the normal hook @code{after-change-major-mode-hook}.
+should do is to call @code{run-mode-hooks}. This runs the normal
+hook @code{change-major-mode-after-body-hook}, the mode hook,
+and then the normal hook @code{after-change-major-mode-hook}.
@xref{Mode Hooks}.
@item
@@ -509,6 +524,10 @@ mode when creating new buffers (@pxref{Auto Major Mode}), but with such
@code{special} modes, Fundamental mode is used instead. Modes such as
Dired, Rmail, and Buffer List use this feature.
+The function @code{view-buffer} does not enable View mode in buffers
+whose mode-class is special, because such modes usually provide their
+own View-like bindings.
+
The @code{define-derived-mode} macro automatically marks the derived
mode as special if the parent mode is special. Special mode is a
convenient parent for such modes to inherit from; @xref{Basic Major
@@ -526,25 +545,22 @@ not autoload the mode command, it is sufficient to add the element in
the file that contains the mode definition.
@item
-In the comments that document the file, you should provide a sample
-@code{autoload} form and an example of how to add to
-@code{auto-mode-alist}, that users can include in their init files
-(@pxref{Init File}).
-
-@item
@cindex mode loading
The top-level forms in the file defining the mode should be written so
that they may be evaluated more than once without adverse consequences.
-Even if you never load the file more than once, someone else will.
+For instance, use @code{defvar} or @code{defcustom} to set mode-related
+variables, so that they are not reinitialized if they already have a
+value (@pxref{Defining Variables}).
+
@end itemize
@node Auto Major Mode
@subsection How Emacs Chooses a Major Mode
@cindex major mode, automatic selection
- Based on information in the file name or in the file itself, Emacs
-automatically selects a major mode for the new buffer when a file is
-visited. It also processes local variables specified in the file text.
+ When Emacs visits a file, it automatically selects a major mode for
+the buffer based on information in the file name or in the file itself.
+It also processes local variables specified in the file text.
@deffn Command normal-mode &optional find-file
This function establishes the proper major mode and buffer-local variable
@@ -588,6 +604,18 @@ Chosen, emacs, The GNU Emacs Manual}. If @code{enable-local-variables}
is @code{nil}, @code{set-auto-mode} does not check the @w{@samp{-*-}}
line, or near the end of the file, for any mode tag.
+@vindex inhibit-local-variables-regexps
+There are some file types where it is not appropriate to scan the file
+contents for a mode specifier. For example, a tar archive may happen to
+contain, near the end of the file, a member file that has a local
+variables section specifying a mode for that particular file. This
+should not be applied to the containing tar file. Similarly, a tiff
+image file might just happen to contain a first line that seems to
+match the @w{@samp{-*-}} pattern. For these reasons, both these file
+extensions are members of the list @var{inhibit-local-variables-regexps}.
+Add patterns to this list to prevent Emacs searching them for local
+variables of any kind (not just mode specifiers).
+
If @var{keep-mode-if-same} is non-@code{nil}, this function does not
call the mode command if the buffer is already in the proper major
mode. For instance, @code{set-visited-file-name} sets this to
@@ -599,7 +627,7 @@ have set.
This function sets the major mode of @var{buffer} to the default value of
@code{major-mode}; if that is @code{nil}, it uses the
current buffer's major mode (if that is suitable). As an exception,
-if @var{buffer}'s name is @samp{*scratch*}, it sets the mode to
+if @var{buffer}'s name is @file{*scratch*}, it sets the mode to
@code{initial-major-mode}.
The low-level primitives for creating buffers do not use this function,
@@ -608,9 +636,9 @@ but medium-level commands such as @code{switch-to-buffer} and
@end defun
@defopt initial-major-mode
-@cindex @samp{*scratch*}
+@cindex @file{*scratch*}
The value of this variable determines the major mode of the initial
-@samp{*scratch*} buffer. The value should be a symbol that is a major
+@file{*scratch*} buffer. The value should be a symbol that is a major
mode command. The default value is @code{lisp-interaction-mode}.
@end defopt
@@ -706,13 +734,15 @@ modes. It is normally bound to @kbd{C-h m}. It uses the value of the
variable @code{major-mode} (@pxref{Major Modes}), which is why every
major mode command needs to set that variable.
-@deffn Command describe-mode
-This function displays the documentation of the current major mode.
+@deffn Command describe-mode &optional buffer
+This command displays the documentation of the current buffer's major
+mode and minor modes. It uses the @code{documentation} function to
+retrieve the documentation strings of the major and minor mode
+commands (@pxref{Accessing Documentation}).
-The @code{describe-mode} function calls the @code{documentation}
-function using the value of @code{major-mode} as an argument. Thus, it
-displays the documentation string of the major mode command.
-(@xref{Accessing Documentation}.)
+If called from Lisp with a non-nil @var{buffer} argument, this
+function displays the documentation for that buffer's major and minor
+modes, rather than those of the current buffer.
@end deffn
@node Derived Modes
@@ -775,10 +805,10 @@ You can also specify @code{nil} for @var{parent}. This gives the new
mode no parent. Then @code{define-derived-mode} behaves as described
above, but, of course, omits all actions connected with @var{parent}.
-The argument @var{docstring} specifies the documentation string for
-the new mode. @code{define-derived-mode} adds some general
-information about the mode's hook, followed by the mode's keymap, at
-the end of this docstring. If you omit @var{docstring},
+The argument @var{docstring} specifies the documentation string for the
+new mode. @code{define-derived-mode} adds some general information
+about the mode's hook, followed by the mode's keymap, at the end of this
+documentation string. If you omit @var{docstring},
@code{define-derived-mode} generates a documentation string.
The @var{keyword-args} are pairs of keywords and values. The values
@@ -869,9 +899,9 @@ Prog mode binds @code{parse-sexp-ignore-comments} to @code{t}
@deffn Command special-mode
Special mode is a basic major mode for buffers containing text that is
-produced specially by Emacs, rather than from a file. Major modes
-derived from Special mode are given a @code{mode-class} property of
-@code{special} (@pxref{Major Mode Conventions}).
+produced specially by Emacs, rather than directly from a file. Major
+modes derived from Special mode are given a @code{mode-class} property
+of @code{special} (@pxref{Major Mode Conventions}).
Special mode sets the buffer to read-only. Its keymap defines several
common bindings, including @kbd{q} for @code{quit-window}, @kbd{z} for
@@ -879,56 +909,20 @@ common bindings, including @kbd{q} for @code{quit-window}, @kbd{z} for
(@pxref{Reverting}).
An example of a major mode derived from Special mode is Buffer Menu
-mode, which is used by the @samp{*Buffer List*} buffer. @xref{List
+mode, which is used by the @file{*Buffer List*} buffer. @xref{List
Buffers,,Listing Existing Buffers, emacs, The GNU Emacs Manual}.
@end deffn
-@node Generic Modes
-@subsection Generic Modes
-@cindex generic mode
-
- @dfn{Generic modes} are simple major modes with basic support for
-comment syntax and Font Lock mode. To define a generic mode, use the
-macro @code{define-generic-mode}. See the file @file{generic-x.el}
-for some examples of the use of @code{define-generic-mode}.
-
-@defmac define-generic-mode mode comment-list keyword-list font-lock-list auto-mode-list function-list &optional docstring
-This macro defines a generic mode command named @var{mode} (a symbol,
-not quoted). The optional argument @var{docstring} is the
-documentation for the mode command. If you do not supply it,
-@code{define-generic-mode} generates one by default.
-
-The argument @var{comment-list} is a list in which each element is
-either a character, a string of one or two characters, or a cons cell.
-A character or a string is set up in the mode's syntax table as a
-``comment starter.'' If the entry is a cons cell, the @sc{car} is set
-up as a ``comment starter'' and the @sc{cdr} as a ``comment ender.''
-(Use @code{nil} for the latter if you want comments to end at the end
-of the line.) Note that the syntax table mechanism has limitations
-about what comment starters and enders are actually possible.
-@xref{Syntax Tables}.
-
-The argument @var{keyword-list} is a list of keywords to highlight
-with @code{font-lock-keyword-face}. Each keyword should be a string.
-Meanwhile, @var{font-lock-list} is a list of additional expressions to
-highlight. Each element of this list should have the same form as an
-element of @code{font-lock-keywords}. @xref{Search-based
-Fontification}.
-
-The argument @var{auto-mode-list} is a list of regular expressions to
-add to the variable @code{auto-mode-alist}. They are added by the execution
-of the @code{define-generic-mode} form, not by expanding the macro call.
-
-Finally, @var{function-list} is a list of functions for the mode
-command to call for additional setup. It calls these functions just
-before it runs the mode hook variable @code{@var{mode}-hook}.
-@end defmac
+ In addition, modes for buffers of tabulated data can inherit from
+Tabulated List mode, which is in turn derived from Special mode.
+@xref{Tabulated List Mode}.
@node Mode Hooks
@subsection Mode Hooks
- Every major mode command should finish by running its mode hook and
-the mode-independent normal hook @code{after-change-major-mode-hook}.
+ Every major mode command should finish by running the mode-independent
+normal hook @code{change-major-mode-after-body-hook}, its mode hook,
+and the normal hook @code{after-change-major-mode-hook}.
It does this by calling @code{run-mode-hooks}. If the major mode is a
derived mode, that is if it calls another major mode (the parent mode)
in its body, it should do this inside @code{delay-mode-hooks} so that
@@ -937,20 +931,22 @@ call to @code{run-mode-hooks} runs the parent's mode hook too.
@xref{Major Mode Conventions}.
Emacs versions before Emacs 22 did not have @code{delay-mode-hooks}.
-When user-implemented major modes have not been updated to use it,
-they won't entirely follow these conventions: they may run the
-parent's mode hook too early, or fail to run
-@code{after-change-major-mode-hook}. If you encounter such a major
-mode, please correct it to follow these conventions.
+Versions before 24 did not have @code{change-major-mode-after-body-hook}.
+When user-implemented major modes do not use @code{run-mode-hooks} and
+have not been updated to use these newer features, they won't entirely
+follow these conventions: they may run the parent's mode hook too early,
+or fail to run @code{after-change-major-mode-hook}. If you encounter
+such a major mode, please correct it to follow these conventions.
When you defined a major mode using @code{define-derived-mode}, it
automatically makes sure these conventions are followed. If you
-define a major mode ``by hand,'' not using @code{define-derived-mode},
+define a major mode ``by hand'', not using @code{define-derived-mode},
use the following functions to handle these conventions automatically.
@defun run-mode-hooks &rest hookvars
Major modes should run their mode hook using this function. It is
similar to @code{run-hooks} (@pxref{Hooks}), but it also runs
+@code{change-major-mode-after-body-hook} and
@code{after-change-major-mode-hook}.
When this function is called during the execution of a
@@ -970,11 +966,187 @@ The hooks will actually run during the next call to
construct.
@end defmac
+@defvar change-major-mode-after-body-hook
+This is a normal hook run by @code{run-mode-hooks}. It is run before
+the mode hooks.
+@end defvar
+
@defvar after-change-major-mode-hook
This is a normal hook run by @code{run-mode-hooks}. It is run at the
very end of every properly-written major mode command.
@end defvar
+@node Tabulated List Mode
+@subsection Tabulated List mode
+@cindex Tabulated List mode
+
+ Tabulated List mode is a major mode for displaying tabulated data,
+i.e.@: data consisting of @dfn{entries}, each entry occupying one row of
+text with its contents divided into columns. Tabulated List mode
+provides facilities for pretty-printing rows and columns, and sorting
+the rows according to the values in each column. It is derived from
+Special mode (@pxref{Basic Major Modes}).
+
+ Tabulated List mode is intended to be used as a parent mode by a more
+specialized major mode. Examples include Process Menu mode
+(@pxref{Process Information}) and Package Menu mode (@pxref{Package
+Menu,,, emacs, The GNU Emacs Manual}).
+
+@findex tabulated-list-mode
+ Such a derived mode should use @code{define-derived-mode} in the usual
+way, specifying @code{tabulated-list-mode} as the second argument
+(@pxref{Derived Modes}). The body of the @code{define-derived-mode}
+form should specify the format of the tabulated data, by assigning
+values to the variables documented below; then, it should call the
+function @code{tabulated-list-init-header} to initialize the header
+line.
+
+ The derived mode should also define a @dfn{listing command}. This,
+not the mode command, is what the user calls (e.g.@: @kbd{M-x
+list-processes}). The listing command should create or switch to a
+buffer, turn on the derived mode, specify the tabulated data, and
+finally call @code{tabulated-list-print} to populate the buffer.
+
+@defvar tabulated-list-format
+This buffer-local variable specifies the format of the Tabulated List
+data. Its value should be a vector. Each element of the vector
+represents a data column, and should be a list @code{(@var{name}
+@var{width} @var{sort})}, where
+
+@itemize
+@item
+@var{name} is the column's name (a string).
+
+@item
+@var{width} is the width to reserve for the column (an integer). This
+is meaningless for the last column, which runs to the end of each line.
+
+@item
+@var{sort} specifies how to sort entries by the column. If @code{nil},
+the column cannot be used for sorting. If @code{t}, the column is
+sorted by comparing string values. Otherwise, this should be a
+predicate function for @code{sort} (@pxref{Rearrangement}), which
+accepts two arguments with the same form as the elements of
+@code{tabulated-list-entries} (see below).
+@end itemize
+@end defvar
+
+@defvar tabulated-list-entries
+This buffer-local variable specifies the entries displayed in the
+Tabulated List buffer. Its value should be either a list, or a
+function.
+
+If the value is a list, each list element corresponds to one entry, and
+should have the form @w{@code{(@var{id} @var{contents})}}, where
+
+@itemize
+@item
+@var{id} is either @code{nil}, or a Lisp object that identifies the
+entry. If the latter, the cursor stays on the ``same'' entry when
+re-sorting entries. Comparison is done with @code{equal}.
+
+@item
+@var{contents} is a vector with the same number of elements as
+@code{tabulated-list-format}. Each vector element is either a string,
+which is inserted into the buffer as-is, or a list @code{(@var{label}
+. @var{properties})}, which means to insert a text button by calling
+@code{insert-text-button} with @var{label} and @var{properties} as
+arguments (@pxref{Making Buttons}).
+
+There should be no newlines in any of these strings.
+@end itemize
+
+Otherwise, the value should be a function which returns a list of the
+above form when called with no arguments.
+@end defvar
+
+@defvar tabulated-list-revert-hook
+This normal hook is run prior to reverting a Tabulated List buffer. A
+derived mode can add a function to this hook to recompute
+@code{tabulated-list-entries}.
+@end defvar
+
+@defvar tabulated-list-printer
+The value of this variable is the function called to insert an entry at
+point, including its terminating newline. The function should accept
+two arguments, @var{id} and @var{contents}, having the same meanings as
+in @code{tabulated-list-entries}. The default value is a function which
+inserts an entry in a straightforward way; a mode which uses Tabulated
+List mode in a more complex way can specify another function.
+@end defvar
+
+@defvar tabulated-list-sort-key
+The value of this variable specifies the current sort key for the
+Tabulated List buffer. If it is @code{nil}, no sorting is done.
+Otherwise, it should have the form @code{(@var{name} . @var{flip})},
+where @var{name} is a string matching one of the column names in
+@code{tabulated-list-format}, and @var{flip}, if non-@code{nil}, means
+to invert the sort order.
+@end defvar
+
+@defun tabulated-list-init-header
+This function computes and sets @code{header-line-format} for the
+Tabulated List buffer (@pxref{Header Lines}), and assigns a keymap to
+the header line to allow sort entries by clicking on column headers.
+
+Modes derived from Tabulated List mode should call this after setting
+the above variables (in particular, only after setting
+@code{tabulated-list-format}).
+@end defun
+
+@defun tabulated-list-print &optional remember-pos
+This function populates the current buffer with entries. It should be
+called by the listing command. It erases the buffer, sorts the entries
+specified by @code{tabulated-list-entries} according to
+@code{tabulated-list-sort-key}, then calls the function specified by
+@code{tabulated-list-printer} to insert each entry.
+
+If the optional argument @var{remember-pos} is non-@code{nil}, this
+function looks for the @var{id} element on the current line, if any, and
+tries to move to that entry after all the entries are (re)inserted.
+@end defun
+
+@node Generic Modes
+@subsection Generic Modes
+@cindex generic mode
+
+ @dfn{Generic modes} are simple major modes with basic support for
+comment syntax and Font Lock mode. To define a generic mode, use the
+macro @code{define-generic-mode}. See the file @file{generic-x.el}
+for some examples of the use of @code{define-generic-mode}.
+
+@defmac define-generic-mode mode comment-list keyword-list font-lock-list auto-mode-list function-list &optional docstring
+This macro defines a generic mode command named @var{mode} (a symbol,
+not quoted). The optional argument @var{docstring} is the
+documentation for the mode command. If you do not supply it,
+@code{define-generic-mode} generates one by default.
+
+The argument @var{comment-list} is a list in which each element is
+either a character, a string of one or two characters, or a cons cell.
+A character or a string is set up in the mode's syntax table as a
+``comment starter''. If the entry is a cons cell, the @sc{car} is set
+up as a ``comment starter'' and the @sc{cdr} as a ``comment ender''.
+(Use @code{nil} for the latter if you want comments to end at the end
+of the line.) Note that the syntax table mechanism has limitations
+about what comment starters and enders are actually possible.
+@xref{Syntax Tables}.
+
+The argument @var{keyword-list} is a list of keywords to highlight
+with @code{font-lock-keyword-face}. Each keyword should be a string.
+Meanwhile, @var{font-lock-list} is a list of additional expressions to
+highlight. Each element of this list should have the same form as an
+element of @code{font-lock-keywords}. @xref{Search-based
+Fontification}.
+
+The argument @var{auto-mode-list} is a list of regular expressions to
+add to the variable @code{auto-mode-alist}. They are added by the execution
+of the @code{define-generic-mode} form, not by expanding the macro call.
+
+Finally, @var{function-list} is a list of functions for the mode
+command to call for additional setup. It calls these functions just
+before it runs the mode hook variable @code{@var{mode}-hook}.
+@end defmac
+
@node Example Major Modes
@subsection Major Mode Examples
@@ -1000,13 +1172,10 @@ the conventions listed above:
(defvar text-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\e\t" 'ispell-complete-word)
- (define-key map "\es" 'center-line)
- (define-key map "\eS" 'center-paragraph)
map)
"Keymap for `text-mode'.
-Many other modes, such as Mail mode, Outline mode
-and Indented Text mode, inherit all the commands
-defined in this map.")
+Many other modes, such as `mail-mode', `outline-mode' and
+`indented-text-mode', inherit all the commands defined in this map.")
@end group
@end smallexample
@@ -1024,7 +1193,6 @@ Turning on Text mode runs the normal hook `text-mode-hook'."
@end group
@group
(set (make-local-variable 'text-mode-variant) t)
- ;; @r{These two lines are a feature added recently.}
(set (make-local-variable 'require-final-newline)
mode-require-final-newline)
(set (make-local-variable 'indent-line-function) 'indent-relative))
@@ -1035,103 +1203,29 @@ Turning on Text mode runs the normal hook `text-mode-hook'."
(The last line is redundant nowadays, since @code{indent-relative} is
the default value, and we'll delete it in a future version.)
- Here is how it was defined formerly, before
-@code{define-derived-mode} existed:
-
-@smallexample
-@group
-;; @r{This isn't needed nowadays, since @code{define-derived-mode} does it.}
-(define-abbrev-table 'text-mode-abbrev-table ()
- "Abbrev table used while in text mode.")
-@end group
-
-@group
-(defun text-mode ()
- "Major mode for editing text intended for humans to read...
- Special commands: \\@{text-mode-map@}
-@end group
-@group
-Turning on text-mode runs the hook `text-mode-hook'."
- (interactive)
- (kill-all-local-variables)
- (use-local-map text-mode-map)
-@end group
-@group
- (setq local-abbrev-table text-mode-abbrev-table)
- (set-syntax-table text-mode-syntax-table)
-@end group
-@group
- ;; @r{These four lines are absent from the current version}
- ;; @r{not because this is done some other way, but because}
- ;; @r{nowadays Text mode uses the normal definition of paragraphs.}
- (set (make-local-variable 'paragraph-start)
- (concat "[ \t]*$\\|" page-delimiter))
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'indent-line-function) 'indent-relative-maybe)
-@end group
-@group
- (setq mode-name "Text")
- (setq major-mode 'text-mode)
- (run-mode-hooks 'text-mode-hook)) ; @r{Finally, this permits the user to}
- ; @r{customize the mode with a hook.}
-@end group
-@end smallexample
-
@cindex @file{lisp-mode.el}
- The three Lisp modes (Lisp mode, Emacs Lisp mode, and Lisp
-Interaction mode) have more features than Text mode and the code is
-correspondingly more complicated. Here are excerpts from
-@file{lisp-mode.el} that illustrate how these modes are written.
+ The three Lisp modes (Lisp mode, Emacs Lisp mode, and Lisp Interaction
+mode) have more features than Text mode and the code is correspondingly
+more complicated. Here are excerpts from @file{lisp-mode.el} that
+illustrate how these modes are written.
+
+ Here is how the Lisp mode syntax and abbrev tables are defined:
@cindex syntax table example
@smallexample
@group
;; @r{Create mode-specific table variables.}
-(defvar lisp-mode-syntax-table nil "")
-(defvar lisp-mode-abbrev-table nil "")
-@end group
-
-@group
-(defvar emacs-lisp-mode-syntax-table
- (let ((table (make-syntax-table)))
- (let ((i 0))
-@end group
-
-@group
- ;; @r{Set syntax of chars up to @samp{0} to say they are}
- ;; @r{part of symbol names but not words.}
- ;; @r{(The digit @samp{0} is @code{48} in the @acronym{ASCII} character set.)}
- (while (< i ?0)
- (modify-syntax-entry i "_ " table)
- (setq i (1+ i)))
- ;; @r{@dots{} similar code follows for other character ranges.}
-@end group
-@group
- ;; @r{Then set the syntax codes for characters that are special in Lisp.}
- (modify-syntax-entry ? " " table)
- (modify-syntax-entry ?\t " " table)
- (modify-syntax-entry ?\f " " table)
- (modify-syntax-entry ?\n "> " table)
-@end group
-@group
- ;; @r{Give CR the same syntax as newline, for selective-display.}
- (modify-syntax-entry ?\^m "> " table)
- (modify-syntax-entry ?\; "< " table)
- (modify-syntax-entry ?` "' " table)
- (modify-syntax-entry ?' "' " table)
- (modify-syntax-entry ?, "' " table)
-@end group
-@group
- ;; @r{@dots{}likewise for many other characters@dots{}}
- (modify-syntax-entry ?\( "() " table)
- (modify-syntax-entry ?\) ")( " table)
- (modify-syntax-entry ?\[ "(] " table)
- (modify-syntax-entry ?\] ")[ " table))
- table))
-@end group
-@group
-;; @r{Create an abbrev table for lisp-mode.}
+(defvar lisp-mode-abbrev-table nil)
(define-abbrev-table 'lisp-mode-abbrev-table ())
+
+(defvar lisp-mode-syntax-table
+ (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
+ (modify-syntax-entry ?\[ "_ " table)
+ (modify-syntax-entry ?\] "_ " table)
+ (modify-syntax-entry ?# "' 14" table)
+ (modify-syntax-entry ?| "\" 23bn" table)
+ table)
+ "Syntax table used in `lisp-mode'.")
@end group
@end smallexample
@@ -1140,30 +1234,22 @@ each calls the following function to set various variables:
@smallexample
@group
-(defun lisp-mode-variables (lisp-syntax)
- (when lisp-syntax
+(defun lisp-mode-variables (&optional syntax keywords-case-insensitive)
+ (when syntax
(set-syntax-table lisp-mode-syntax-table))
(setq local-abbrev-table lisp-mode-abbrev-table)
@dots{}
@end group
@end smallexample
- In Lisp and most programming languages, we want the paragraph
-commands to treat only blank lines as paragraph separators. And the
-modes should understand the Lisp conventions for comments. The rest of
-@code{lisp-mode-variables} sets this up:
+@noindent
+Amongst other things, this function sets up the @code{comment-start}
+variable to handle Lisp comments:
@smallexample
@group
- (set (make-local-variable 'paragraph-start)
- (concat page-delimiter "\\|$" ))
- (set (make-local-variable 'paragraph-separate)
- paragraph-start)
- @dots{}
-@end group
-@group
- (set (make-local-variable 'comment-indent-function)
- 'lisp-comment-indent))
+ (make-local-variable 'comment-start)
+ (setq comment-start ";")
@dots{}
@end group
@end smallexample
@@ -1175,11 +1261,10 @@ common. The following code sets up the common commands:
@smallexample
@group
-(defvar shared-lisp-mode-map
+(defvar lisp-mode-shared-map
(let ((map (make-sparse-keymap)))
- (define-key shared-lisp-mode-map "\e\C-q" 'indent-sexp)
- (define-key shared-lisp-mode-map "\177"
- 'backward-delete-char-untabify)
+ (define-key map "\e\C-q" 'indent-sexp)
+ (define-key map "\177" 'backward-delete-char-untabify)
map)
"Keymap for commands shared by all sorts of Lisp modes.")
@end group
@@ -1191,25 +1276,29 @@ And here is the code to set up the keymap for Lisp mode:
@smallexample
@group
(defvar lisp-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map shared-lisp-mode-map)
+ (let ((map (make-sparse-keymap))
+ (menu-map (make-sparse-keymap "Lisp")))
+ (set-keymap-parent map lisp-mode-shared-map)
(define-key map "\e\C-x" 'lisp-eval-defun)
(define-key map "\C-c\C-z" 'run-lisp)
+ @dots{}
map)
- "Keymap for ordinary Lisp mode...")
+ "Keymap for ordinary Lisp mode.
+All commands in `lisp-mode-shared-map' are inherited by this map.")
@end group
@end smallexample
- Finally, here is the complete major mode command definition for Lisp
-mode.
+@noindent
+Finally, here is the major mode command for Lisp mode:
@smallexample
@group
-(defun lisp-mode ()
+(define-derived-mode lisp-mode prog-mode "Lisp"
"Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
Commands:
Delete converts tabs to spaces as it moves back.
Blank lines separate paragraphs. Semicolons start comments.
+
\\@{lisp-mode-map@}
Note that `run-lisp' may be used either to start an inferior Lisp job
or to switch back to an existing one.
@@ -1218,24 +1307,12 @@ or to switch back to an existing one.
@group
Entry to this mode calls the value of `lisp-mode-hook'
if that value is non-nil."
- (interactive)
- (kill-all-local-variables)
-@end group
-@group
- (use-local-map lisp-mode-map) ; @r{Select the mode's keymap.}
- (setq major-mode 'lisp-mode) ; @r{This is how @code{describe-mode}}
- ; @r{finds out what to describe.}
- (setq mode-name "Lisp") ; @r{This goes into the mode line.}
- (lisp-mode-variables t) ; @r{This defines various variables.}
+ (lisp-mode-variables nil t)
+ (set (make-local-variable 'find-tag-default-function)
+ 'lisp-find-tag-default)
(set (make-local-variable 'comment-start-skip)
"\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
- (set (make-local-variable 'font-lock-keywords-case-fold-search) t)
-@end group
-@group
- (setq imenu-case-fold-search t)
- (set-syntax-table lisp-mode-syntax-table)
- (run-mode-hooks 'lisp-mode-hook)) ; @r{This permits the user to use a}
- ; @r{hook to customize the mode.}
+ (setq imenu-case-fold-search t))
@end group
@end smallexample
@@ -1243,27 +1320,20 @@ if that value is non-nil."
@section Minor Modes
@cindex minor mode
- A @dfn{minor mode} provides features that users may enable or disable
-independently of the choice of major mode. Minor modes can be enabled
-individually or in combination. Minor modes would be better named
-``generally available, optional feature modes,'' except that such a name
-would be unwieldy.
+ A @dfn{minor mode} provides optional features that users may enable or
+disable independently of the choice of major mode. Minor modes can be
+enabled individually or in combination.
- A minor mode is not usually meant as a variation of a single major mode.
-Usually they are general and can apply to many major modes. For
-example, Auto Fill mode works with any major mode that permits text
-insertion. To be general, a minor mode must be effectively independent
-of the things major modes do.
+ Most minor modes implement features that are independent of the major
+mode, and can thus be used with most major modes. For example, Auto
+Fill mode works with any major mode that permits text insertion. A few
+minor modes, however, are specific to a particular major mode. For
+example, Diff Auto Refine mode is a minor mode that is intended to be
+used only with Diff mode.
- A minor mode is often much more difficult to implement than a major
-mode. One reason is that you should be able to activate and deactivate
-minor modes in any order. A minor mode should be able to have its
-desired effect regardless of the major mode and regardless of the other
-minor modes in effect.
-
- Often the biggest problem in implementing a minor mode is finding a
-way to insert the necessary hook into the rest of Emacs. Minor mode
-keymaps make this easier than it used to be.
+ Ideally, a minor mode should have its desired effect regardless of the
+other minor modes in effect. It should be possible to activate and
+deactivate minor modes in any order.
@defvar minor-mode-list
The value of this variable is a list of all minor mode commands.
@@ -1281,60 +1351,76 @@ The value of this variable is a list of all minor mode commands.
@cindex conventions for writing minor modes
There are conventions for writing minor modes just as there are for
-major modes. Several of the major mode conventions apply to minor
-modes as well: those regarding the name of the mode initialization
-function, the names of global symbols, the use of a hook at the end of
-the initialization function, and the use of keymaps and other tables.
-
- In addition, there are several conventions that are specific to
-minor modes. (The easiest way to follow all the conventions is to use
-the macro @code{define-minor-mode}; @ref{Defining Minor Modes}.)
+major modes. These conventions are described below. The easiest way to
+follow them is to use the macro @code{define-minor-mode}.
+@xref{Defining Minor Modes}.
@itemize @bullet
@item
@cindex mode variable
-Make a variable whose name ends in @samp{-mode} to control the minor
-mode. We call this the @dfn{mode variable}. The minor mode command
-should set this variable (@code{nil} to disable; anything else to
-enable).
-
-If possible, implement the mode so that setting the variable
-automatically enables or disables the mode. Then the minor mode command
-does not need to do anything except set the variable.
+Define a variable whose name ends in @samp{-mode}. We call this the
+@dfn{mode variable}. The minor mode command should set this variable.
+The value will be @code{nil} is the mode is disabled, and non-@code{nil}
+if the mode is enabled. The variable should be buffer-local if the
+minor mode is buffer-local.
This variable is used in conjunction with the @code{minor-mode-alist} to
-display the minor mode name in the mode line. It can also enable
-or disable a minor mode keymap. Individual commands or hooks can also
-check the variable's value.
-
-If you want the minor mode to be enabled separately in each buffer,
-make the variable buffer-local.
+display the minor mode name in the mode line. It also determines
+whether the minor mode keymap is active, via @code{minor-mode-map-alist}
+(@pxref{Controlling Active Maps}). Individual commands or hooks can
+also check its value.
@item
-Define a command whose name is the same as the mode variable.
-Its job is to enable and disable the mode by setting the variable.
+Define a command, called the @dfn{mode command}, whose name is the same
+as the mode variable. Its job is to set the value of the mode variable,
+plus anything else that needs to be done to actually enable or disable
+the mode's features.
-The command should accept one optional argument. If the argument is
-@code{nil}, it should toggle the mode (turn it on if it is off, and
-off if it is on). It should turn the mode on if the argument is a
-positive integer, the symbol @code{t}, or a list whose @sc{car} is one
-of those. It should turn the mode off if the argument is a negative
-integer or zero, the symbol @code{-}, or a list whose @sc{car} is a
-negative integer or zero. The meaning of other arguments is not
-specified.
+The mode command should accept one optional argument. If called
+interactively with no prefix argument, it should toggle the mode
+(i.e.@: enable if it is disabled, and disable if it is enabled). If
+called interactively with a prefix argument, it should enable the mode
+if the argument is positive and disable it otherwise.
-Here is an example taken from the definition of @code{transient-mark-mode}.
-It shows the use of @code{transient-mark-mode} as a variable that enables or
-disables the mode's behavior, and also shows the proper way to toggle,
-enable or disable the minor mode based on the raw prefix argument value.
+If the mode command is called from Lisp (i.e.@: non-interactively), it
+should enable the mode if the argument is omitted or @code{nil}; it
+should toggle the mode if the argument is the symbol @code{toggle};
+otherwise it should treat the argument in the same way as for an
+interactive call with a numeric prefix argument, as described above.
-@smallexample
-@group
-(setq transient-mark-mode
- (if (null arg) (not transient-mark-mode)
- (> (prefix-numeric-value arg) 0)))
-@end group
-@end smallexample
+The following example shows how to implement this behavior (it is
+similar to the code generated by the @code{define-minor-mode} macro):
+
+@example
+(interactive (list (or current-prefix-arg 'toggle)))
+(let ((enable (if (eq arg 'toggle)
+ (not foo-mode) ; @r{this mode's mode variable}
+ (> (prefix-numeric-value arg) 0))))
+ (if enable
+ @var{do-enable}
+ @var{do-disable}))
+@end example
+
+The reason for this somewhat complex behavior is that it lets users
+easily toggle the minor mode interactively, and also lets the minor mode
+be easily enabled in a mode hook, like this:
+
+@example
+(add-hook 'text-mode-hook 'foo-mode)
+@end example
+
+@noindent
+This behaves correctly whether or not @code{foo-mode} was already
+enabled, since the @code{foo-mode} mode command unconditionally enables
+the minor mode when it is called from Lisp with no argument. Disabling
+a minor mode in a mode hook is a little uglier:
+
+@example
+(add-hook 'text-mode-hook (lambda () (foo-mode -1)))
+@end example
+
+@noindent
+However, this is not very commonly done.
@item
Add an element to @code{minor-mode-alist} for each minor mode
@@ -1357,8 +1443,7 @@ check for an existing element, to avoid duplication. For example:
@smallexample
@group
(unless (assq 'leif-mode minor-mode-alist)
- (setq minor-mode-alist
- (cons '(leif-mode " Leif") minor-mode-alist)))
+ (push '(leif-mode " Leif") minor-mode-alist))
@end group
@end smallexample
@@ -1372,25 +1457,24 @@ or like this, using @code{add-to-list} (@pxref{List Variables}):
@end smallexample
@end itemize
- Global minor modes distributed with Emacs should if possible support
-enabling and disabling via Custom (@pxref{Customization}). To do this,
-the first step is to define the mode variable with @code{defcustom}, and
-specify @code{:type 'boolean}.
+ In addition, several major mode conventions apply to minor modes as
+well: those regarding the names of global symbols, the use of a hook at
+the end of the initialization function, and the use of keymaps and other
+tables.
- If just setting the variable is not sufficient to enable the mode, you
+ The minor mode should, if possible, support enabling and disabling via
+Custom (@pxref{Customization}). To do this, the mode variable should be
+defined with @code{defcustom}, usually with @code{:type 'boolean}. If
+just setting the variable is not sufficient to enable the mode, you
should also specify a @code{:set} method which enables the mode by
-invoking the mode command. Note in the variable's documentation string that
-setting the variable other than via Custom may not take effect.
-
- Also mark the definition with an autoload cookie (@pxref{autoload cookie}),
-and specify a @code{:require} so that customizing the variable will load
-the library that defines the mode. This will copy suitable definitions
-into @file{loaddefs.el} so that users can use @code{customize-option} to
-enable the mode. For example:
+invoking the mode command. Note in the variable's documentation string
+that setting the variable other than via Custom may not take effect.
+Also, mark the definition with an autoload cookie (@pxref{autoload
+cookie}), and specify a @code{:require} so that customizing the variable
+will load the library that defines the mode. For example:
@smallexample
@group
-
;;;###autoload
(defcustom msb-mode nil
"Toggle msb-mode.
@@ -1415,11 +1499,12 @@ alist @code{minor-mode-map-alist}. @xref{Definition of minor-mode-map-alist}.
@cindex @code{self-insert-command}, minor modes
One use of minor mode keymaps is to modify the behavior of certain
self-inserting characters so that they do something else as well as
-self-insert. In general, this is the only way to do that, since the
-facilities for customizing @code{self-insert-command} are limited to
-special cases (designed for abbrevs and Auto Fill mode). (Do not try
-substituting your own definition of @code{self-insert-command} for the
-standard one. The editor command loop handles this function specially.)
+self-insert. (Another way to customize @code{self-insert-command} is
+through @code{post-self-insert-hook}. Apart from this, the facilities
+for customizing @code{self-insert-command} are limited to special cases,
+designed for abbrevs and Auto Fill mode. Do not try substituting your
+own definition of @code{self-insert-command} for the standard one. The
+editor command loop handles this function specially.)
The key sequences bound in a minor mode should consist of @kbd{C-c}
followed by one of @kbd{.,/?`'"[]\|~!#$%^&*()-_+=}. (The other
@@ -1434,11 +1519,21 @@ implementing a mode in one self-contained definition.
@defmac define-minor-mode mode doc [init-value [lighter [keymap]]] keyword-args@dots{} body@dots{}
This macro defines a new minor mode whose name is @var{mode} (a
symbol). It defines a command named @var{mode} to toggle the minor
-mode, with @var{doc} as its documentation string. It also defines a
-variable named @var{mode}, which is set to @code{t} or @code{nil} by
-enabling or disabling the mode. The variable is initialized to
-@var{init-value}. Except in unusual circumstances (see below), this
-value must be @code{nil}.
+mode, with @var{doc} as its documentation string.
+
+The toggle command takes one optional (prefix) argument.
+If called interactively with no argument it toggles the mode on or off.
+A positive prefix argument enables the mode, any other prefix argument
+disables it. From Lisp, an argument of @code{toggle} toggles the mode,
+whereas an omitted or @code{nil} argument enables the mode.
+This makes it easy to enable the minor mode in a major mode hook, for example.
+If @var{doc} is nil, the macro supplies a default documentation string
+explaining the above.
+
+By default, it also defines a variable named @var{mode}, which is set to
+@code{t} or @code{nil} by enabling or disabling the mode. The variable
+is initialized to @var{init-value}. Except in unusual circumstances
+(see below), this value must be @code{nil}.
The string @var{lighter} says what to display in the mode line
when the mode is enabled; if it is @code{nil}, the mode is not displayed
@@ -1477,8 +1572,8 @@ rather than buffer-local. It defaults to @code{nil}.
One of the effects of making a minor mode global is that the
@var{mode} variable becomes a customization variable. Toggling it
-through the Custom interface turns the mode on and off, and its value
-can be saved for future Emacs sessions (@pxref{Saving
+through the Customize interface turns the mode on and off, and its
+value can be saved for future Emacs sessions (@pxref{Saving
Customizations,,, emacs, The GNU Emacs Manual}. For the saved
variable to work, you should ensure that the @code{define-minor-mode}
form is evaluated each time Emacs starts; for packages that are not
@@ -1493,15 +1588,31 @@ This is equivalent to specifying @var{lighter} positionally.
@item :keymap @var{keymap}
This is equivalent to specifying @var{keymap} positionally.
+
+@item :variable @var{place}
+This replaces the default variable @var{mode}, used to store the state
+of the mode. If you specify this, the @var{mode} variable is not
+defined, and any @var{init-value} argument is unused. @var{place}
+can be a different named variable (which you must define yourself), or
+anything that can be used with the @code{setf} function
+(@pxref{Generalized Variables}).
+@var{place} can also be a cons @code{(@var{get} . @var{set})},
+where @var{get} is an expression that returns the current state,
+and @var{set} is a function of one argument (a state) that sets it.
+
+@item :after-hook @var{after-hook}
+This defines a single Lisp form which is evaluated after the mode hooks
+have run. It should not be quoted.
@end table
Any other keyword arguments are passed directly to the
@code{defcustom} generated for the variable @var{mode}.
-The command named @var{mode} first performs the standard actions such
-as setting the variable named @var{mode} and then executes the
-@var{body} forms, if any. It finishes by running the mode hook
-variable @code{@var{mode}-hook}.
+The command named @var{mode} first performs the standard actions such as
+setting the variable named @var{mode} and then executes the @var{body}
+forms, if any. It then runs the mode hook variable
+@code{@var{mode}-hook} and finishes by evaluating any form in
+@code{:after-hook}.
@end defmac
The initial value must be @code{nil} except in cases where (1) the
@@ -1521,9 +1632,10 @@ for this macro.
@smallexample
(define-minor-mode hungry-mode
"Toggle Hungry mode.
-With no argument, this command toggles the mode.
-Non-null prefix argument turns on the mode.
-Null prefix argument turns off the mode.
+Interactively with no argument, this command toggles the mode.
+A positive prefix argument enables the mode, any other prefix
+argument disables it. From Lisp, argument omitted or nil enables
+the mode, `toggle' toggles the state.
When Hungry mode is enabled, the control delete key
gobbles all preceding whitespace except the last.
@@ -1538,7 +1650,7 @@ See the command \\[hungry-electric-delete]."
@end smallexample
@noindent
-This defines a minor mode named ``Hungry mode,'' a command named
+This defines a minor mode named ``Hungry mode'', a command named
@code{hungry-mode} to toggle it, a variable named @code{hungry-mode}
which indicates whether the mode is enabled, and a variable named
@code{hungry-mode-map} which holds the keymap that is active when the
@@ -1552,13 +1664,7 @@ minor modes don't need any.
@smallexample
(define-minor-mode hungry-mode
"Toggle Hungry mode.
-With no argument, this command toggles the mode.
-Non-null prefix argument turns on the mode.
-Null prefix argument turns off the mode.
-
-When Hungry mode is enabled, the control delete key
-gobbles all preceding whitespace except the last.
-See the command \\[hungry-electric-delete]."
+...rest of documentation as before..."
;; The initial value.
:init-value nil
;; The indicator for the mode line.
@@ -1586,17 +1692,24 @@ Fundamental mode; but it does not detect the creation of a new buffer
in Fundamental mode.
This defines the customization option @var{global-mode} (@pxref{Customization}),
-which can be toggled in the Custom interface to turn the minor mode on
+which can be toggled in the Customize interface to turn the minor mode on
and off. As with @code{define-minor-mode}, you should ensure that the
@code{define-globalized-minor-mode} form is evaluated each time Emacs
starts, for example by providing a @code{:require} keyword.
Use @code{:group @var{group}} in @var{keyword-args} to specify the
custom group for the mode variable of the global minor mode.
+
+Generally speaking, when you define a globalized minor mode, you should
+also define a non-globalized version, so that people can use (or
+disable) it in individual buffers. This also allows them to disable a
+globally enabled minor mode in a specific major mode, by using that
+mode's hook.
@end defmac
+
@node Mode Line Format
-@section Mode-Line Format
+@section Mode Line Format
@cindex mode line
Each Emacs window (aside from minibuffer windows) typically has a mode
@@ -1626,61 +1739,59 @@ minor modes.
@node Mode Line Basics
@subsection Mode Line Basics
- @code{mode-line-format} is a buffer-local variable that holds a
-@dfn{mode line construct}, a kind of template, which controls what is
-displayed on the mode line of the current buffer. The value of
-@code{header-line-format} specifies the buffer's header line in the
-same way. All windows for the same buffer use the same
+ The contents of each mode line are specified by the buffer-local
+variable @code{mode-line-format} (@pxref{Mode Line Top}). This variable
+holds a @dfn{mode line construct}: a template that controls what is
+displayed on the buffer's mode line. The value of
+@code{header-line-format} specifies the buffer's header line in the same
+way. All windows for the same buffer use the same
@code{mode-line-format} and @code{header-line-format}.
- For efficiency, Emacs does not continuously recompute the mode
-line and header line of a window. It does so when circumstances
-appear to call for it---for instance, if you change the window
-configuration, switch buffers, narrow or widen the buffer, scroll, or
-change the buffer's modification status. If you modify any of the
-variables referenced by @code{mode-line-format} (@pxref{Mode Line
-Variables}), or any other variables and data structures that affect
-how text is displayed (@pxref{Display}), you may want to force an
-update of the mode line so as to display the new information or
-display it in the new way.
+ For efficiency, Emacs does not continuously recompute each window's
+mode line and header line. It does so when circumstances appear to call
+for it---for instance, if you change the window configuration, switch
+buffers, narrow or widen the buffer, scroll, or modify the buffer. If
+you alter any of the variables referenced by @code{mode-line-format} or
+@code{header-line-format} (@pxref{Mode Line Variables}), or any other
+data structures that affect how text is displayed (@pxref{Display}), you
+should use the function @code{force-mode-line-update} to update the
+display.
@defun force-mode-line-update &optional all
-Force redisplay of the current buffer's mode line and header line.
-The next redisplay will update the mode line and header line based on
-the latest values of all relevant variables. With optional
-non-@code{nil} @var{all}, force redisplay of all mode lines and header
-lines.
-
-This function also forces recomputation of the menu bar menus
-and the frame title.
+This function forces Emacs to update the current buffer's mode line and
+header line, based on the latest values of all relevant variables,
+during its next redisplay cycle. If the optional argument @var{all} is
+non-@code{nil}, it forces an update for all mode lines and header lines.
+
+This function also forces an update of the menu bar and frame title.
@end defun
The selected window's mode line is usually displayed in a different
-color using the face @code{mode-line}. Other windows' mode lines
-appear in the face @code{mode-line-inactive} instead. @xref{Faces}.
+color using the face @code{mode-line}. Other windows' mode lines appear
+in the face @code{mode-line-inactive} instead. @xref{Faces}.
@node Mode Line Data
@subsection The Data Structure of the Mode Line
-@cindex mode-line construct
+@cindex mode line construct
- The mode-line contents are controlled by a data structure called a
-@dfn{mode-line construct}, made up of lists, strings, symbols, and
+ The mode line contents are controlled by a data structure called a
+@dfn{mode line construct}, made up of lists, strings, symbols, and
numbers kept in buffer-local variables. Each data type has a specific
-meaning for the mode-line appearance, as described below. The same
-data structure is used for constructing frame titles (@pxref{Frame
-Titles}) and header lines (@pxref{Header Lines}).
+meaning for the mode line appearance, as described below. The same data
+structure is used for constructing frame titles (@pxref{Frame Titles})
+and header lines (@pxref{Header Lines}).
- A mode-line construct may be as simple as a fixed string of text,
+ A mode line construct may be as simple as a fixed string of text,
but it usually specifies how to combine fixed strings with variables'
values to construct the text. Many of these variables are themselves
-defined to have mode-line constructs as their values.
+defined to have mode line constructs as their values.
- Here are the meanings of various data types as mode-line constructs:
+ Here are the meanings of various data types as mode line constructs:
@table @code
@cindex percent symbol in mode line
@item @var{string}
-A string as a mode-line construct appears verbatim except for
+A string as a mode line construct appears verbatim except for
@dfn{@code{%}-constructs} in it. These stand for substitution of
other data; see @ref{%-Constructs}.
@@ -1693,8 +1804,8 @@ default, in the face @code{mode-line} or @code{mode-line-inactive}
special meanings. @xref{Properties in Mode}.
@item @var{symbol}
-A symbol as a mode-line construct stands for its value. The value of
-@var{symbol} is used as a mode-line construct, in place of @var{symbol}.
+A symbol as a mode line construct stands for its value. The value of
+@var{symbol} is used as a mode line construct, in place of @var{symbol}.
However, the symbols @code{t} and @code{nil} are ignored, as is any
symbol whose value is void.
@@ -1703,17 +1814,17 @@ displayed verbatim: the @code{%}-constructs are not recognized.
Unless @var{symbol} is marked as ``risky'' (i.e., it has a
non-@code{nil} @code{risky-local-variable} property), all text
-properties specified in @var{symbol}'s value are ignored. This
-includes the text properties of strings in @var{symbol}'s value, as
-well as all @code{:eval} and @code{:propertize} forms in it. (The
-reason for this is security: non-risky variables could be set
-automatically from file variables without prompting the user.)
+properties specified in @var{symbol}'s value are ignored. This includes
+the text properties of strings in @var{symbol}'s value, as well as all
+@code{:eval} and @code{:propertize} forms in it. (The reason for this
+is security: non-risky variables could be set automatically from file
+variables without prompting the user.)
@item (@var{string} @var{rest}@dots{})
@itemx (@var{list} @var{rest}@dots{})
A list whose first element is a string or list means to process all the
elements recursively and concatenate the results. This is the most
-common form of mode-line construct.
+common form of mode line construct.
@item (:eval @var{form})
A list whose first element is the symbol @code{:eval} says to evaluate
@@ -1723,24 +1834,24 @@ recursion.
@item (:propertize @var{elt} @var{props}@dots{})
A list whose first element is the symbol @code{:propertize} says to
-process the mode-line construct @var{elt} recursively, then add the text
+process the mode line construct @var{elt} recursively, then add the text
properties specified by @var{props} to the result. The argument
@var{props} should consist of zero or more pairs @var{text-property}
-@var{value}. (This feature is new as of Emacs 22.1.)
+@var{value}.
@item (@var{symbol} @var{then} @var{else})
A list whose first element is a symbol that is not a keyword specifies
a conditional. Its meaning depends on the value of @var{symbol}. If
@var{symbol} has a non-@code{nil} value, the second element,
-@var{then}, is processed recursively as a mode-line element.
+@var{then}, is processed recursively as a mode line construct.
Otherwise, the third element, @var{else}, is processed recursively.
-You may omit @var{else}; then the mode-line element displays nothing
+You may omit @var{else}; then the mode line construct displays nothing
if the value of @var{symbol} is @code{nil} or void.
@item (@var{width} @var{rest}@dots{})
A list whose first element is an integer specifies truncation or
padding of the results of @var{rest}. The remaining elements
-@var{rest} are processed recursively as mode-line constructs and
+@var{rest} are processed recursively as mode line constructs and
concatenated together. When @var{width} is positive, the result is
space filled on the right if its width is less than @var{width}. When
@var{width} is negative, the result is truncated on the right to
@@ -1757,12 +1868,12 @@ the top of the window is to use a list like this: @code{(-3 "%p")}.
@code{mode-line-format}.
@defopt mode-line-format
-The value of this variable is a mode-line construct that controls the
+The value of this variable is a mode line construct that controls the
contents of the mode-line. It is always buffer-local in all buffers.
-If you set this variable to @code{nil} in a buffer, that buffer does
-not have a mode line. (A window that is just one line tall never
-displays a mode line.)
+If you set this variable to @code{nil} in a buffer, that buffer does not
+have a mode line. (A window that is just one line tall also does not
+display a mode line.)
@end defopt
The default value of @code{mode-line-format} is designed to use the
@@ -1780,9 +1891,9 @@ the information in another fashion. This way, customizations made by
the user or by Lisp programs (such as @code{display-time} and major
modes) via changes to those variables remain effective.
- Here is an example of a @code{mode-line-format} that might be
-useful for @code{shell-mode}, since it contains the host name and default
-directory.
+ Here is a hypothetical example of a @code{mode-line-format} that might
+be useful for Shell mode (in reality, Shell mode does not set
+@code{mode-line-format}):
@example
@group
@@ -1795,7 +1906,7 @@ directory.
@end group
@group
;; @r{Note that this is evaluated while making the list.}
- ;; @r{It makes a mode-line construct which is just a string.}
+ ;; @r{It makes a mode line construct which is just a string.}
(getenv "HOST")
@end group
":"
@@ -1812,8 +1923,7 @@ directory.
'(which-func-mode ("" which-func-format "--"))
'(line-number-mode "L%l--")
'(column-number-mode "C%c--")
- '(-3 "%p")
- "-%-"))
+ '(-3 "%p")))
@end group
@end example
@@ -1825,23 +1935,23 @@ these variable names are also the minor mode command names.)
@node Mode Line Variables
@subsection Variables Used in the Mode Line
- This section describes variables incorporated by the standard value
-of @code{mode-line-format} into the text of the mode line. There is
+ This section describes variables incorporated by the standard value of
+@code{mode-line-format} into the text of the mode line. There is
nothing inherently special about these variables; any other variables
-could have the same effects on the mode line if
-@code{mode-line-format}'s value were changed to use them. However,
-various parts of Emacs set these variables on the understanding that
-they will control parts of the mode line; therefore, practically
-speaking, it is essential for the mode line to use them.
+could have the same effects on the mode line if the value of
+@code{mode-line-format} is changed to use them. However, various parts
+of Emacs set these variables on the understanding that they will control
+parts of the mode line; therefore, practically speaking, it is essential
+for the mode line to use them.
@defvar mode-line-mule-info
-This variable holds the value of the mode-line construct that displays
+This variable holds the value of the mode line construct that displays
information about the language environment, buffer coding system, and
current input method. @xref{Non-ASCII Characters}.
@end defvar
@defvar mode-line-modified
-This variable holds the value of the mode-line construct that displays
+This variable holds the value of the mode line construct that displays
whether the current buffer is modified. Its default value displays
@samp{**} if the buffer is modified, @samp{--} if the buffer is not
modified, @samp{%%} if the buffer is read only, and @samp{%*} if the
@@ -1882,14 +1992,14 @@ default value also displays the recursive editing level, information
on the process status, and whether narrowing is in effect.
@end defopt
-@defopt mode-line-remote
+@defvar mode-line-remote
This variable is used to show whether @code{default-directory} for the
current buffer is remote.
-@end defopt
+@end defvar
-@defopt mode-line-client
+@defvar mode-line-client
This variable is used to identify @code{emacsclient} frames.
-@end defopt
+@end defvar
The following three variables are used in @code{mode-line-modes}:
@@ -1904,10 +2014,10 @@ identify the mode name in the mode line, use @code{format-mode-line}
@end defvar
@defvar mode-line-process
-This buffer-local variable contains the mode-line information on process
+This buffer-local variable contains the mode line information on process
status in modes used for communicating with subprocesses. It is
displayed immediately following the major mode name, with no intervening
-space. For example, its value in the @samp{*shell*} buffer is
+space. For example, its value in the @file{*shell*} buffer is
@code{(":%s")}, which allows the shell to display its status along
with the major mode as: @samp{(Shell:run)}. Normally this variable
is @code{nil}.
@@ -1923,12 +2033,12 @@ the @code{minor-mode-alist} should be a two-element list:
(@var{minor-mode-variable} @var{mode-line-string})
@end example
-More generally, @var{mode-line-string} can be any mode-line spec. It
-appears in the mode line when the value of @var{minor-mode-variable}
+More generally, @var{mode-line-string} can be any mode line construct.
+It appears in the mode line when the value of @var{minor-mode-variable}
is non-@code{nil}, and not otherwise. These strings should begin with
spaces so that they don't run together. Conventionally, the
-@var{minor-mode-variable} for a specific mode is set to a
-non-@code{nil} value when that minor mode is activated.
+@var{minor-mode-variable} for a specific mode is set to a non-@code{nil}
+value when that minor mode is activated.
@code{minor-mode-alist} itself is not buffer-local. Each variable
mentioned in the alist should be buffer-local if its minor mode can be
@@ -1936,12 +2046,12 @@ enabled separately in each buffer.
@end defvar
@defvar global-mode-string
-This variable holds a mode-line spec that, by default, appears in the
-mode line just after the @code{which-func-mode} minor mode if set,
-else after @code{mode-line-modes}. The command @code{display-time}
-sets @code{global-mode-string} to refer to the variable
-@code{display-time-string}, which holds a string containing the time
-and load information.
+This variable holds a mode line construct that, by default, appears in
+the mode line just after the @code{which-func-mode} minor mode if set,
+else after @code{mode-line-modes}. The command @code{display-time} sets
+@code{global-mode-string} to refer to the variable
+@code{display-time-string}, which holds a string containing the time and
+load information.
The @samp{%M} construct substitutes the value of
@code{global-mode-string}, but that is obsolete, since the variable is
@@ -1975,12 +2085,17 @@ specifies addition of text properties.
@node %-Constructs
@subsection @code{%}-Constructs in the Mode Line
- Strings used as mode-line constructs can use certain
-@code{%}-constructs to substitute various kinds of data. Here is a
-list of the defined @code{%}-constructs, and what they mean. In any
-construct except @samp{%%}, you can add a decimal integer after the
-@samp{%} to specify a minimum field width. If the width is less, the
-field is padded with spaces to the right.
+ Strings used as mode line constructs can use certain
+@code{%}-constructs to substitute various kinds of data. The
+following is a list of the defined @code{%}-constructs, and what they
+mean.
+
+ In any construct except @samp{%%}, you can add a decimal integer
+after the @samp{%} to specify a minimum field width. If the width is
+less, the field is padded to that width. Purely numeric constructs
+(@samp{c}, @samp{i}, @samp{I}, and @samp{l}) are padded by inserting
+spaces to the left, and others are padded by inserting spaces to the
+right.
@table @code
@item %b
@@ -2021,8 +2136,8 @@ of the buffer.
@item %p
The percentage of the buffer text above the @strong{top} of window, or
-@samp{Top}, @samp{Bottom} or @samp{All}. Note that the default
-mode-line specification truncates this to three characters.
+@samp{Top}, @samp{Bottom} or @samp{All}. Note that the default mode
+line construct truncates this to three characters.
@item %P
The percentage of the buffer text that is above the @strong{bottom} of
@@ -2102,11 +2217,11 @@ line:
@enumerate
@item
-Put a string with a text property directly into the mode-line data
+Put a string with a text property directly into the mode line data
structure.
@item
-Put a text property on a mode-line %-construct such as @samp{%12b}; then
+Put a text property on a mode line %-construct such as @samp{%12b}; then
the expansion of the %-construct will have that same text property.
@item
@@ -2114,7 +2229,7 @@ Use a @code{(:propertize @var{elt} @var{props}@dots{})} construct to
give @var{elt} a text property specified by @var{props}.
@item
-Use a list containing @code{:eval @var{form}} in the mode-line data
+Use a list containing @code{:eval @var{form}} in the mode line data
structure, and make @var{form} evaluate to a string that has a text
property.
@end enumerate
@@ -2136,10 +2251,10 @@ local variables.
@cindex header line (of a window)
@cindex window header line
- A window can have a @dfn{header line} at the
-top, just as it can have a mode line at the bottom. The header line
-feature works just like the mode-line feature, except that it's
-controlled by different variables.
+ A window can have a @dfn{header line} at the top, just as it can have
+a mode line at the bottom. The header line feature works just like the
+mode line feature, except that it's controlled by
+@code{header-line-format}:
@defvar header-line-format
This variable, local in every buffer, specifies how to display the
@@ -2154,11 +2269,11 @@ header line at once; if it has a mode line, then it does not display a
header line.
@node Emulating Mode Line
-@subsection Emulating Mode-Line Formatting
+@subsection Emulating Mode Line Formatting
- You can use the function @code{format-mode-line} to compute
-the text that would appear in a mode line or header line
-based on a certain mode-line specification.
+ You can use the function @code{format-mode-line} to compute the text
+that would appear in a mode line or header line based on a certain
+mode line construct.
@defun format-mode-line format &optional face window buffer
This function formats a line of text according to @var{format} as if it
@@ -2207,10 +2322,10 @@ definitions, or other named portions of the buffer; then the user can
choose one of them and move point to it. Major modes can add a menu
bar item to use Imenu using @code{imenu-add-to-menubar}.
-@defun imenu-add-to-menubar name
+@deffn Command imenu-add-to-menubar name
This function defines a local menu bar item named @var{name}
to run Imenu.
-@end defun
+@end deffn
The user-level commands for using Imenu are described in the Emacs
Manual (@pxref{Imenu,, Imenu, emacs, the Emacs Manual}). This section
@@ -2392,12 +2507,12 @@ Setting this variable makes it buffer-local in the current buffer.
@section Font Lock Mode
@cindex Font Lock mode
- @dfn{Font Lock mode} is a feature that automatically attaches
-@code{face} properties to certain parts of the buffer based on their
-syntactic role. How it parses the buffer depends on the major mode;
-most major modes define syntactic criteria for which faces to use in
-which contexts. This section explains how to customize Font Lock for a
-particular major mode.
+ @dfn{Font Lock mode} is a buffer-local minor mode that automatically
+attaches @code{face} properties to certain parts of the buffer based on
+their syntactic role. How it parses the buffer depends on the major
+mode; most major modes define syntactic criteria for which faces to use
+in which contexts. This section explains how to customize Font Lock for
+a particular major mode.
Font Lock mode finds text to highlight in two ways: through
syntactic parsing based on the syntax table, and through searching
@@ -2416,8 +2531,6 @@ Search-based fontification happens second.
contents can also specify how to fontify it.
* Faces for Font Lock:: Special faces specifically for Font Lock.
* Syntactic Font Lock:: Fontification based on syntax tables.
-* Setting Syntax Properties:: Defining character syntax based on context
- using the Font Lock mechanism.
* Multiline Font Lock:: How to coerce Font Lock into properly
highlighting multiline constructs.
@end menu
@@ -2432,12 +2545,12 @@ variable. The value assigned to this variable is used, if and when Font
Lock mode is enabled, to set all the other variables.
@defvar font-lock-defaults
-This variable is set by major modes, as a buffer-local variable, to
-specify how to fontify text in that mode. It automatically becomes
-buffer-local when you set it. If its value is @code{nil}, Font-Lock
-mode does no highlighting, and you can use the @samp{Faces} menu
-(under @samp{Edit} and then @samp{Text Properties} in the menu bar) to
-assign faces explicitly to text in the buffer.
+This variable is set by major modes to specify how to fontify text in
+that mode. It automatically becomes buffer-local when set. If its
+value is @code{nil}, Font Lock mode does no highlighting, and you can
+use the @samp{Faces} menu (under @samp{Edit} and then @samp{Text
+Properties} in the menu bar) to assign faces explicitly to text in the
+buffer.
If non-@code{nil}, the value should look like this:
@@ -2460,19 +2573,20 @@ value. @xref{Levels of Font Lock}.
The second element, @var{keywords-only}, specifies the value of the
variable @code{font-lock-keywords-only}. If this is omitted or
@code{nil}, syntactic fontification (of strings and comments) is also
-performed. If this is non-@code{nil}, such fontification is not
+performed. If this is non-@code{nil}, syntactic fontification is not
performed. @xref{Syntactic Font Lock}.
The third element, @var{case-fold}, specifies the value of
@code{font-lock-keywords-case-fold-search}. If it is non-@code{nil},
-Font Lock mode ignores case when searching as directed by
-@code{font-lock-keywords}.
+Font Lock mode ignores case during search-based fontification.
-If the fourth element, @var{syntax-alist}, is non-@code{nil}, it
-should be a list of cons cells of the form @code{(@var{char-or-string}
-. @var{string})}. These are used to set up a syntax table for
-syntactic fontification (@pxref{Syntax Table Functions}). The
-resulting syntax table is stored in @code{font-lock-syntax-table}.
+If the fourth element, @var{syntax-alist}, is non-@code{nil}, it should
+be a list of cons cells of the form @code{(@var{char-or-string}
+. @var{string})}. These are used to set up a syntax table for syntactic
+fontification; the resulting syntax table is stored in
+@code{font-lock-syntax-table}. If @var{syntax-alist} is omitted or
+@code{nil}, syntactic fontification uses the syntax table returned by
+the @code{syntax-table} function. @xref{Syntax Table Functions}.
The fifth element, @var{syntax-begin}, specifies the value of
@code{font-lock-beginning-of-syntax-function}. We recommend setting
@@ -2498,15 +2612,17 @@ fontification for other parts of the text.
@node Search-based Fontification
@subsection Search-based Fontification
- The most important variable for customizing Font Lock mode is
-@code{font-lock-keywords}. It specifies the search criteria for
-search-based fontification. You should specify the value of this
-variable with @var{keywords} in @code{font-lock-defaults}.
+ The variable which directly controls search-based fontification is
+@code{font-lock-keywords}, which is typically specified via the
+@var{keywords} element in @code{font-lock-defaults}.
@defvar font-lock-keywords
-This variable's value is a list of the keywords to highlight. Be
-careful when composing regular expressions for this list; a poorly
-written pattern can dramatically slow things down!
+The value of this variable is a list of the keywords to highlight. Lisp
+programs should not set this variable directly. Normally, the value is
+automatically set by Font Lock mode, using the @var{keywords} element in
+@code{font-lock-defaults}. The value can also be altered using the
+functions @code{font-lock-add-keywords} and
+@code{font-lock-remove-keywords} (@pxref{Customizing Keywords}).
@end defvar
Each element of @code{font-lock-keywords} specifies how to find
@@ -2531,9 +2647,10 @@ Highlight all matches for @var{regexp} using
"\\<foo\\>"
@end example
-The function @code{regexp-opt} (@pxref{Regexp Functions}) is useful
-for calculating optimal regular expressions to match a number of
-different keywords.
+Be careful when composing these regular expressions; a poorly written
+pattern can dramatically slow things down! The function
+@code{regexp-opt} (@pxref{Regexp Functions}) is useful for calculating
+optimal regular expressions to match several keywords.
@item @var{function}
Find text by calling @var{function}, and highlight the matches
@@ -2758,7 +2875,7 @@ highlighting patterns. See the variables
@code{c-font-lock-extra-types}, @code{c++-font-lock-extra-types},
and @code{java-font-lock-extra-types}, for example.
-@strong{Warning:} major mode commands must not call
+@strong{Warning:} Major mode commands must not call
@code{font-lock-add-keywords} under any circumstances, either directly
or indirectly, except through their mode hooks. (Doing so would lead to
incorrect behavior for some minor modes.) They should set up their
@@ -2774,7 +2891,10 @@ command name or @code{nil}. All the caveats and requirements for
@code{font-lock-add-keywords} apply here too.
@end defun
- For example, this code
+ For example, the following code adds two fontification patterns for C
+mode: one to fontify the word @samp{FIXME}, even in comments, and
+another to fontify the words @samp{and}, @samp{or} and @samp{not} as
+keywords.
@smallexample
(font-lock-add-keywords 'c-mode
@@ -2783,13 +2903,8 @@ command name or @code{nil}. All the caveats and requirements for
@end smallexample
@noindent
-adds two fontification patterns for C mode: one to fontify the word
-@samp{FIXME}, even in comments, and another to fontify the words
-@samp{and}, @samp{or} and @samp{not} as keywords.
-
-@noindent
-That example affects only C mode proper. To add the same patterns to
-C mode @emph{and} all modes derived from it, do this instead:
+This example affects only C mode proper. To add the same patterns to C
+mode @emph{and} all modes derived from it, do this instead:
@smallexample
(add-hook 'c-mode-hook
@@ -2876,13 +2991,13 @@ function using @code{jit-lock-register}, this function unregisters it.
@node Levels of Font Lock
@subsection Levels of Font Lock
- Many major modes offer three different levels of fontification. You
+ Some major modes offer three different levels of fontification. You
can define multiple levels by using a list of symbols for @var{keywords}
in @code{font-lock-defaults}. Each symbol specifies one level of
fontification; it is up to the user to choose one of these levels,
normally by setting @code{font-lock-maximum-decoration} (@pxref{Font
-Lock,,, emacs, the GNU Emacs Manual}). The chosen level's symbol
-value is used to initialize @code{font-lock-keywords}.
+Lock,,, emacs, the GNU Emacs Manual}). The chosen level's symbol value
+is used to initialize @code{font-lock-keywords}.
Here are the conventions for how to define the levels of
fontification:
@@ -2930,10 +3045,10 @@ the normal Font Lock machinery, it should not set the variable
@cindex font lock faces
Font Lock mode can highlight using any face, but Emacs defines several
-faces specifically for syntactic highlighting. These @dfn{Font Lock
-faces} are listed below. They can also be used by major modes for
-syntactic highlighting outside of Font Lock mode (@pxref{Major Mode
-Conventions}).
+faces specifically for Font Lock to use to highlight text. These
+@dfn{Font Lock faces} are listed below. They can also be used by major
+modes for syntactic highlighting outside of Font Lock mode (@pxref{Major
+Mode Conventions}).
Each of these symbols is both a face name, and a variable whose
default value is the symbol itself. Thus, the default value of
@@ -3008,128 +3123,66 @@ for easily-overlooked negation characters.
@subsection Syntactic Font Lock
@cindex syntactic font lock
-Syntactic fontification uses the syntax table to find comments and
-string constants (@pxref{Syntax Tables}). It highlights them using
-@code{font-lock-comment-face} and @code{font-lock-string-face}
-(@pxref{Faces for Font Lock}), or whatever
-@code{font-lock-syntactic-face-function} chooses. There are several
-variables that affect syntactic fontification; you should set them by
-means of @code{font-lock-defaults} (@pxref{Font Lock Basics}).
+Syntactic fontification uses a syntax table (@pxref{Syntax Tables}) to
+find and highlight syntactically relevant text. If enabled, it runs
+prior to search-based fontification. The variable
+@code{font-lock-syntactic-face-function}, documented below, determines
+which syntactic constructs to highlight. There are several variables
+that affect syntactic fontification; you should set them by means of
+@code{font-lock-defaults} (@pxref{Font Lock Basics}).
+
+ Whenever Font Lock mode performs syntactic fontification on a stretch
+of text, it first calls the function specified by
+@code{syntax-propertize-function}. Major modes can use this to apply
+@code{syntax-table} text properties to override the buffer's syntax
+table in special cases. @xref{Syntax Properties}.
@defvar font-lock-keywords-only
-Non-@code{nil} means Font Lock should not do syntactic fontification;
-it should only fontify based on @code{font-lock-keywords}. The normal
-way for a mode to set this variable to @code{t} is with
-@var{keywords-only} in @code{font-lock-defaults}.
+If the value of this variable is non-@code{nil}, Font Lock does not do
+syntactic fontification, only search-based fontification based on
+@code{font-lock-keywords}. It is normally set by Font Lock mode based
+on the @var{keywords-only} element in @code{font-lock-defaults}.
@end defvar
@defvar font-lock-syntax-table
This variable holds the syntax table to use for fontification of
-comments and strings. Specify it using @var{syntax-alist} in
-@code{font-lock-defaults}. If this is @code{nil}, fontification uses
-the buffer's syntax table.
+comments and strings. It is normally set by Font Lock mode based on the
+@var{syntax-alist} element in @code{font-lock-defaults}. If this value
+is @code{nil}, syntactic fontification uses the buffer's syntax table
+(the value returned by the function @code{syntax-table}; @pxref{Syntax
+Table Functions}).
@end defvar
@defvar font-lock-beginning-of-syntax-function
If this variable is non-@code{nil}, it should be a function to move
point back to a position that is syntactically at ``top level'' and
-outside of strings or comments. Font Lock uses this when necessary
-to get the right results for syntactic fontification.
-
-This function is called with no arguments. It should leave point at
-the beginning of any enclosing syntactic block. Typical values are
-@code{beginning-of-line} (used when the start of the line is known to
-be outside a syntactic block), or @code{beginning-of-defun} for
+outside of strings or comments. The value is normally set through an
+@var{other-vars} element in @code{font-lock-defaults}. If it is
+@code{nil}, Font Lock uses @code{syntax-begin-function} to move back
+outside of any comment, string, or sexp (@pxref{Position Parse}).
+
+This variable is semi-obsolete; we usually recommend setting
+@code{syntax-begin-function} instead. One of its uses is to tune the
+behavior of syntactic fontification, e.g.@: to ensure that different
+kinds of strings or comments are highlighted differently.
+
+The specified function is called with no arguments. It should leave
+point at the beginning of any enclosing syntactic block. Typical values
+are @code{beginning-of-line} (used when the start of the line is known
+to be outside a syntactic block), or @code{beginning-of-defun} for
programming modes, or @code{backward-paragraph} for textual modes.
-
-If the value is @code{nil}, Font Lock uses
-@code{syntax-begin-function} to move back outside of any comment,
-string, or sexp. This variable is semi-obsolete; we recommend setting
-@code{syntax-begin-function} instead.
-
-Specify this variable using @var{syntax-begin} in
-@code{font-lock-defaults}.
@end defvar
@defvar font-lock-syntactic-face-function
-A function to determine which face to use for a given syntactic
-element (a string or a comment). The function is called with one
-argument, the parse state at point returned by
-@code{parse-partial-sexp}, and should return a face. The default
-value returns @code{font-lock-comment-face} for comments and
-@code{font-lock-string-face} for strings.
-
-This can be used to highlighting different kinds of strings or
-comments differently. It is also sometimes abused together with
-@code{font-lock-syntactic-keywords} to highlight constructs that span
-multiple lines, but this is too esoteric to document here.
-
-Specify this variable using @var{other-vars} in
+If this variable is non-@code{nil}, it should be a function to determine
+which face to use for a given syntactic element (a string or a comment).
+The value is normally set through an @var{other-vars} element in
@code{font-lock-defaults}.
-@end defvar
-
-@node Setting Syntax Properties
-@subsection Setting Syntax Properties
- Font Lock mode can be used to update @code{syntax-table} properties
-automatically (@pxref{Syntax Properties}). This is useful in
-languages for which a single syntax table by itself is not sufficient.
-
-@defvar font-lock-syntactic-keywords
-This variable enables and controls updating @code{syntax-table}
-properties by Font Lock. Its value should be a list of elements of
-this form:
-
-@example
-(@var{matcher} @var{subexp} @var{syntax} @var{override} @var{laxmatch})
-@end example
-
-The parts of this element have the same meanings as in the corresponding
-sort of element of @code{font-lock-keywords},
-
-@example
-(@var{matcher} @var{subexp} @var{facespec} @var{override} @var{laxmatch})
-@end example
-
-However, instead of specifying the value @var{facespec} to use for the
-@code{face} property, it specifies the value @var{syntax} to use for
-the @code{syntax-table} property. Here, @var{syntax} can be a string
-(as taken by @code{modify-syntax-entry}), a syntax table, a cons cell
-(as returned by @code{string-to-syntax}), or an expression whose value
-is one of those two types. @var{override} cannot be @code{prepend} or
-@code{append}.
-
-For example, an element of the form:
-
-@example
-("\\$\\(#\\)" 1 ".")
-@end example
-
-highlights syntactically a hash character when following a dollar
-character, with a SYNTAX of @code{"."} (meaning punctuation syntax).
-Assuming that the buffer syntax table specifies hash characters to
-have comment start syntax, the element will only highlight hash
-characters that do not follow dollar characters as comments
-syntactically.
-
-An element of the form:
-
-@example
- ("\\('\\).\\('\\)"
- (1 "\"")
- (2 "\""))
-@end example
-
-highlights syntactically both single quotes which surround a single
-character, with a SYNTAX of @code{"\""} (meaning string quote syntax).
-Assuming that the buffer syntax table does not specify single quotes
-to have quote syntax, the element will only highlight single quotes of
-the form @samp{'@var{c}'} as strings syntactically. Other forms, such
-as @samp{foo'bar} or @samp{'fubar'}, will not be highlighted as
-strings.
-
-Major modes normally set this variable with @var{other-vars} in
-@code{font-lock-defaults}.
+The function is called with one argument, the parse state at point
+returned by @code{parse-partial-sexp}, and should return a face. The
+default value returns @code{font-lock-comment-face} for comments and
+@code{font-lock-string-face} for strings (@pxref{Faces for Font Lock}).
@end defvar
@node Multiline Font Lock
@@ -3238,18 +3291,17 @@ easy to add the @code{font-lock-multiline} property by hand.
The @code{font-lock-multiline} property is meant to ensure proper
refontification; it does not automatically identify new multiline
-constructs. Identifying the requires that Font-Lock operate on large
-enough chunks at a time. This will happen by accident on many cases,
-which may give the impression that multiline constructs magically work.
-If you set the @code{font-lock-multiline} variable non-@code{nil},
-this impression will be even stronger, since the highlighting of those
-constructs which are found will be properly updated from then on.
-But that does not work reliably.
-
- To find multiline constructs reliably, you must either manually
-place the @code{font-lock-multiline} property on the text before
-Font-Lock looks at it, or use
-@code{font-lock-fontify-region-function}.
+constructs. Identifying the requires that Font Lock mode operate on
+large enough chunks at a time. This will happen by accident on many
+cases, which may give the impression that multiline constructs magically
+work. If you set the @code{font-lock-multiline} variable
+non-@code{nil}, this impression will be even stronger, since the
+highlighting of those constructs which are found will be properly
+updated from then on. But that does not work reliably.
+
+ To find multiline constructs reliably, you must either manually place
+the @code{font-lock-multiline} property on the text before Font Lock
+mode looks at it, or use @code{font-lock-fontify-region-function}.
@node Region to Refontify
@subsubsection Region to Fontify after a Buffer Change
@@ -3264,8 +3316,8 @@ earlier line.
the following variable:
@defvar font-lock-extend-after-change-region-function
-This buffer-local variable is either @code{nil} or a function for
-Font-Lock to call to determine the region to scan and fontify.
+This buffer-local variable is either @code{nil} or a function for Font
+Lock mode to call to determine the region to scan and fontify.
The function is given three parameters, the standard @var{beg},
@var{end}, and @var{old-len} from @code{after-change-functions}
@@ -3281,7 +3333,7 @@ reasonably fast.
@end defvar
@node Auto-Indentation
-@section Auto-indentation of code
+@section Automatic Indentation of code
For programming languages, an important feature of a major mode is to
provide automatic indentation. This is controlled in Emacs by
@@ -3304,7 +3356,7 @@ for a compiler, but on the other hand, the parser embedded in the
indentation code will want to be somewhat friendly to syntactically
incorrect code.
-Good maintainable indentation functions usually fall into 2 categories:
+Good maintainable indentation functions usually fall into two categories:
either parsing forward from some ``safe'' starting point until the
position of interest, or parsing backward from the position of interest.
Neither of the two is a clearly better choice than the other: parsing
@@ -3329,7 +3381,7 @@ Another one is SMIE which takes an approach in the spirit
of Lisp sexps and adapts it to non-Lisp languages.
@menu
-* SMIE:: A simple minded indentation engine
+* SMIE:: A simple minded indentation engine.
@end menu
@node SMIE
@@ -3355,14 +3407,14 @@ languages cannot be parsed correctly using SMIE, at least not without
resorting to some special tricks (@pxref{SMIE Tricks}).
@menu
-* SMIE setup:: SMIE setup and features
-* Operator Precedence Grammars:: A very simple parsing technique
-* SMIE Grammar:: Defining the grammar of a language
-* SMIE Lexer:: Defining tokens
-* SMIE Tricks:: Working around the parser's limitations
-* SMIE Indentation:: Specifying indentation rules
-* SMIE Indentation Helpers:: Helper functions for indentation rules
-* SMIE Indentation Example:: Sample indentation rules
+* SMIE setup:: SMIE setup and features.
+* Operator Precedence Grammars:: A very simple parsing technique.
+* SMIE Grammar:: Defining the grammar of a language.
+* SMIE Lexer:: Defining tokens.
+* SMIE Tricks:: Working around the parser's limitations.
+* SMIE Indentation:: Specifying indentation rules.
+* SMIE Indentation Helpers:: Helper functions for indentation rules.
+* SMIE Indentation Example:: Sample indentation rules.
@end menu
@node SMIE setup
@@ -3815,9 +3867,9 @@ Return non-@code{nil} if the current token's parent is among @var{parents}.
@end defun
@defun smie-rule-sibling-p
-Return non-nil if the current token's parent is actually a sibling.
-This is the case for example when the parent of a @code{","} is just the
-previous @code{","}.
+Return non-@code{nil} if the current token's parent is actually a
+sibling. This is the case for example when the parent of a @code{","}
+is just the previous @code{","}.
@end defun
@defun smie-rule-parent &optional offset
@@ -3988,8 +4040,3 @@ Here @var{desktop-buffer-misc} is the value returned by the function
optionally bound to @code{desktop-save-buffer}.
@end defvar
-@ignore
- Local Variables:
- fill-column: 72
- End:
-@end ignore
diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi
index 46dbbb08e57..e384d40176e 100644
--- a/doc/lispref/nonascii.texi
+++ b/doc/lispref/nonascii.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1998-1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/characters
-@node Non-ASCII Characters, Searching and Matching, Text, Top
+@node Non-ASCII Characters
@chapter Non-@acronym{ASCII} Characters
@cindex multibyte characters
@cindex characters, multi-byte
@@ -242,8 +241,12 @@ representation is in use. It also adjusts various data in the buffer
(including overlays, text properties and markers) so that they cover the
same text as they did before.
-You cannot use @code{set-buffer-multibyte} on an indirect buffer,
-because indirect buffers always inherit the representation of the
+This function signals an error if the buffer is narrowed, since the
+narrowing might have occurred in the middle of multibyte character
+sequences.
+
+This function also signals an error if the buffer is an indirect
+buffer. An indirect buffer always inherits the representation of its
base buffer.
@end defun
@@ -409,17 +412,15 @@ codepoint belongs: most unassigned codepoints get the value of
or @code{R} (strong R).
@item decomposition
-Corresponds to the Unicode @code{Decomposition_Type} and
-@code{Decomposition_Value} properties. The value is a list, whose
-first element may be a symbol representing a compatibility formatting
-tag, such as @code{small}@footnote{
-Note that the Unicode spec writes these tag names inside
-@samp{<..>} brackets. The tag names in Emacs do not include the
-brackets; e.g., Unicode specifies @samp{<small>} where Emacs uses
-@samp{small}.
-}; the other elements are characters that give the compatibility
-decomposition sequence of this character. For unassigned codepoints,
-the value is the character itself.
+Corresponds to the Unicode properties @code{Decomposition_Type} and
+@code{Decomposition_Value}. The value is a list, whose first element
+may be a symbol representing a compatibility formatting tag, such as
+@code{small}@footnote{The Unicode specification writes these tag names
+inside @samp{<..>} brackets, but the tag names in Emacs do not include
+the brackets; e.g.@: Unicode specifies @samp{<small>} where Emacs uses
+@samp{small}. }; the other elements are characters that give the
+compatibility decomposition sequence of this character. For
+unassigned codepoints, the value is the character itself.
@item decimal-digit-value
Corresponds to the Unicode @code{Numeric_Value} property for
@@ -609,7 +610,7 @@ The value is a list of all defined character set names.
@end defvar
@defun charset-priority-list &optional highestp
-This functions returns a list of all defined character sets ordered by
+This function returns a list of all defined character sets ordered by
their priority. If @var{highestp} is non-@code{nil}, the function
returns a single character set of the highest priority.
@end defun
diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index 3efddebffb4..a086f2b3af1 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -1,10 +1,9 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/numbers
-@node Numbers, Strings and Characters, Lisp Data Types, Top
+@node Numbers
@chapter Numbers
@cindex integers
@cindex numbers
@@ -32,7 +31,6 @@ exact; they have a fixed, limited amount of precision.
@end menu
@node Integer Basics
-@comment node-name, next, previous, up
@section Integer Basics
The range of values for an integer depends on the machine. The
@@ -50,9 +48,8 @@ to
@tex
@math{2^{29}-1}),
@end tex
-but some machines provide a wider range. Many examples in this
-chapter assume that an integer has 30 bits and that floating point
-numbers are IEEE double precision.
+but many machines provide a wider range. Many examples in this
+chapter assume the minimum integer width of 30 bits.
@cindex overflow
The Lisp reader reads an integer as a sequence of digits with optional
@@ -162,40 +159,52 @@ The value of this variable is the smallest integer that Emacs Lisp can
handle. It is negative.
@end defvar
- @xref{Character Codes, max-char}, for the maximum value of a valid
-character codepoint.
+ In Emacs Lisp, text characters are represented by integers. Any
+integer between zero and the value of @code{max-char}, inclusive, is
+considered to be valid as a character. @xref{String Basics}.
@node Float Basics
@section Floating Point Basics
+@cindex @acronym{IEEE} floating point
Floating point numbers are useful for representing numbers that are
not integral. The precise range of floating point numbers is
machine-specific; it is the same as the range of the C data type
-@code{double} on the machine you are using.
+@code{double} on the machine you are using. Emacs uses the
+@acronym{IEEE} floating point standard, which is supported by all
+modern computers.
- The read-syntax for floating point numbers requires either a decimal
+ The read syntax for floating point numbers requires either a decimal
point (with at least one digit following), an exponent, or both. For
example, @samp{1500.0}, @samp{15e2}, @samp{15.0e2}, @samp{1.5e3}, and
@samp{.15e4} are five ways of writing a floating point number whose
-value is 1500. They are all equivalent. You can also use a minus sign
-to write negative floating point numbers, as in @samp{-1.0}.
+value is 1500. They are all equivalent. You can also use a minus
+sign to write negative floating point numbers, as in @samp{-1.0}.
+
+ Emacs Lisp treats @code{-0.0} as equal to ordinary zero (with
+respect to @code{equal} and @code{=}), even though the two are
+distinguishable in the @acronym{IEEE} floating point standard.
-@cindex @acronym{IEEE} floating point
@cindex positive infinity
@cindex negative infinity
@cindex infinity
@cindex NaN
- Most modern computers support the @acronym{IEEE} floating point standard,
-which provides for positive infinity and negative infinity as floating point
-values. It also provides for a class of values called NaN or
-``not-a-number''; numerical functions return such values in cases where
-there is no correct answer. For example, @code{(/ 0.0 0.0)} returns a
-NaN. For practical purposes, there's no significant difference between
-different NaN values in Emacs Lisp, and there's no rule for precisely
-which NaN value should be used in a particular case, so Emacs Lisp
-doesn't try to distinguish them (but it does report the sign, if you
-print it). Here are the read syntaxes for these special floating
-point values:
+ The @acronym{IEEE} floating point standard supports positive
+infinity and negative infinity as floating point values. It also
+provides for a class of values called NaN or ``not-a-number'';
+numerical functions return such values in cases where there is no
+correct answer. For example, @code{(/ 0.0 0.0)} returns a NaN. (NaN
+values can also carry a sign, but for practical purposes there's no
+significant difference between different NaN values in Emacs Lisp.)
+
+When a function is documented to return a NaN, it returns an
+implementation-defined value when Emacs is running on one of the
+now-rare platforms that do not use @acronym{IEEE} floating point. For
+example, @code{(log -1.0)} typically returns a NaN, but on
+non-@acronym{IEEE} platforms it returns an implementation-defined
+value.
+
+Here are the read syntaxes for these special floating point values:
@table @asis
@item positive infinity
@@ -206,20 +215,41 @@ point values:
@samp{0.0e+NaN} or @samp{-0.0e+NaN}.
@end table
- To test whether a floating point value is a NaN, compare it with
-itself using @code{=}. That returns @code{nil} for a NaN, and
-@code{t} for any other floating point value.
+@defun isnan number
+This predicate tests whether its argument is NaN, and returns @code{t}
+if so, @code{nil} otherwise. The argument must be a number.
+@end defun
+
+ The following functions are specialized for handling floating point
+numbers:
+
+@defun frexp x
+This function returns a cons cell @code{(@var{sig} . @var{exp})},
+where @var{sig} and @var{exp} are respectively the significand and
+exponent of the floating point number @var{x}:
+
+@smallexample
+@var{x} = @var{sig} * 2^@var{exp}
+@end smallexample
+
+@var{sig} is a floating point number between 0.5 (inclusive) and 1.0
+(exclusive). If @var{x} is zero, the return value is @code{(0 . 0)}.
+@end defun
- The value @code{-0.0} is distinguishable from ordinary zero in
-@acronym{IEEE} floating point, but Emacs Lisp @code{equal} and
-@code{=} consider them equal values.
+@defun ldexp sig &optional exp
+This function returns a floating point number corresponding to the
+significand @var{sig} and exponent @var{exp}.
+@end defun
- You can use @code{logb} to extract the binary exponent of a floating
-point number (or estimate the logarithm of an integer):
+@defun copysign x1 x2
+This function copies the sign of @var{x2} to the value of @var{x1},
+and returns the result. @var{x1} and @var{x2} must be floating point
+numbers.
+@end defun
@defun logb number
This function returns the binary exponent of @var{number}. More
-precisely, the value is the logarithm of @var{number} base 2, rounded
+precisely, the value is the logarithm of |@var{number}| base 2, rounded
down to an integer.
@example
@@ -230,14 +260,6 @@ down to an integer.
@end example
@end defun
-@defvar float-e
-The mathematical constant @math{e} (2.71828@dots{}).
-@end defvar
-
-@defvar float-pi
-The mathematical constant @math{pi} (3.14159@dots{}).
-@end defvar
-
@node Predicates on Numbers
@section Type Predicates for Numbers
@cindex predicates for numbers
@@ -252,8 +274,6 @@ its argument. See also @code{integer-or-marker-p} and
@defun floatp object
This predicate tests whether its argument is a floating point
number and returns @code{t} if so, @code{nil} otherwise.
-
-@code{floatp} does not exist in Emacs versions 18 and earlier.
@end defun
@defun integerp object
@@ -266,15 +286,15 @@ This predicate tests whether its argument is a number (either integer or
floating point), and returns @code{t} if so, @code{nil} otherwise.
@end defun
-@defun wholenump object
+@defun natnump object
@cindex natural numbers
-The @code{wholenump} predicate (whose name comes from the phrase
-``whole-number-p'') tests to see whether its argument is a nonnegative
-integer, and returns @code{t} if so, @code{nil} otherwise. 0 is
-considered non-negative.
+This predicate (whose name comes from the phrase ``natural number'')
+tests to see whether its argument is a nonnegative integer, and
+returns @code{t} if so, @code{nil} otherwise. 0 is considered
+non-negative.
-@findex natnump
-@code{natnump} is an obsolete synonym for @code{wholenump}.
+@findex wholenump number
+This is a synonym for @code{natnump}.
@end defun
@defun zerop number
@@ -296,17 +316,16 @@ compare them, then you test whether two values are the same
@emph{object}. By contrast, @code{=} compares only the numeric values
of the objects.
- At present, each integer value has a unique Lisp object in Emacs Lisp.
+ In Emacs Lisp, each integer value is a unique Lisp object.
Therefore, @code{eq} is equivalent to @code{=} where integers are
-concerned. It is sometimes convenient to use @code{eq} for comparing an
-unknown value with an integer, because @code{eq} does not report an
-error if the unknown value is not a number---it accepts arguments of any
-type. By contrast, @code{=} signals an error if the arguments are not
-numbers or markers. However, it is a good idea to use @code{=} if you
-can, even for comparing integers, just in case we change the
-representation of integers in a future Emacs version.
-
- Sometimes it is useful to compare numbers with @code{equal}; it
+concerned. It is sometimes convenient to use @code{eq} for comparing
+an unknown value with an integer, because @code{eq} does not report an
+error if the unknown value is not a number---it accepts arguments of
+any type. By contrast, @code{=} signals an error if the arguments are
+not numbers or markers. However, it is better programming practice to
+use @code{=} if you can, even for comparing integers.
+
+ Sometimes it is useful to compare numbers with @code{equal}, which
treats two numbers as equal if they have the same data type (both
integers, or both floating point) and the same value. By contrast,
@code{=} can treat an integer and a floating point number as equal.
@@ -419,15 +438,16 @@ If @var{number} is already a floating point number, @code{float} returns
it unchanged.
@end defun
-There are four functions to convert floating point numbers to integers;
-they differ in how they round. All accept an argument @var{number}
-and an optional argument @var{divisor}. Both arguments may be
-integers or floating point numbers. @var{divisor} may also be
+ There are four functions to convert floating point numbers to
+integers; they differ in how they round. All accept an argument
+@var{number} and an optional argument @var{divisor}. Both arguments
+may be integers or floating point numbers. @var{divisor} may also be
@code{nil}. If @var{divisor} is @code{nil} or omitted, these
functions convert @var{number} to an integer, or return it unchanged
if it already is an integer. If @var{divisor} is non-@code{nil}, they
divide @var{number} by @var{divisor} and convert the result to an
-integer. An @code{arith-error} results if @var{divisor} is 0.
+integer. integer. If @var{divisor} is zero (whether integer or
+floating-point), Emacs signals an @code{arith-error} error.
@defun truncate number &optional divisor
This returns @var{number}, converted to an integer by rounding towards
@@ -504,14 +524,12 @@ depending on your machine.
@section Arithmetic Operations
@cindex arithmetic operations
- Emacs Lisp provides the traditional four arithmetic operations:
-addition, subtraction, multiplication, and division. Remainder and modulus
-functions supplement the division functions. The functions to
-add or subtract 1 are provided because they are traditional in Lisp and
-commonly used.
-
- All of these functions except @code{%} return a floating point value
-if any argument is floating.
+ Emacs Lisp provides the traditional four arithmetic operations
+(addition, subtraction, multiplication, and division), as well as
+remainder and modulus functions, and functions to add or subtract 1.
+Except for @code{%}, each of these functions accepts both integer and
+floating point arguments, and returns a floating point number if any
+argument is a floating point number.
It is important to note that in Emacs Lisp, arithmetic functions
do not check for overflow. Thus @code{(1+ 536870911)} may evaluate to
@@ -600,40 +618,49 @@ quotient. If there are additional arguments @var{divisors}, then it
divides @var{dividend} by each divisor in turn. Each argument may be a
number or a marker.
-If all the arguments are integers, then the result is an integer too.
-This means the result has to be rounded. On most machines, the result
-is rounded towards zero after each division, but some machines may round
-differently with negative arguments. This is because the Lisp function
-@code{/} is implemented using the C division operator, which also
-permits machine-dependent rounding. As a practical matter, all known
-machines round in the standard fashion.
-
-@cindex @code{arith-error} in division
-If you divide an integer by 0, an @code{arith-error} error is signaled.
-(@xref{Errors}.) Floating point division by zero returns either
-infinity or a NaN if your machine supports @acronym{IEEE} floating point;
-otherwise, it signals an @code{arith-error} error.
+If all the arguments are integers, the result is an integer, obtained
+by rounding the quotient towards zero after each division.
+(Hypothetically, some machines may have different rounding behavior
+for negative arguments, because @code{/} is implemented using the C
+division operator, which permits machine-dependent rounding; but this
+does not happen in practice.)
@example
@group
(/ 6 2)
@result{} 3
@end group
+@group
(/ 5 2)
@result{} 2
+@end group
+@group
(/ 5.0 2)
@result{} 2.5
+@end group
+@group
(/ 5 2.0)
@result{} 2.5
+@end group
+@group
(/ 5.0 2.0)
@result{} 2.5
+@end group
+@group
(/ 25 3 2)
@result{} 4
+@end group
@group
(/ -17 6)
- @result{} -2 @r{(could in theory be @minus{}3 on some machines)}
+ @result{} -2
@end group
@end example
+
+@cindex @code{arith-error} in division
+If you divide an integer by the integer 0, Emacs signals an
+@code{arith-error} error (@pxref{Errors}). If you divide a floating
+point number by 0, or divide by the floating point number 0.0, the
+result is either positive or negative infinity (@pxref{Float Basics}).
@end defun
@defun % dividend divisor
@@ -641,10 +668,18 @@ otherwise, it signals an @code{arith-error} error.
This function returns the integer remainder after division of @var{dividend}
by @var{divisor}. The arguments must be integers or markers.
-For negative arguments, the remainder is in principle machine-dependent
-since the quotient is; but in practice, all known machines behave alike.
+For any two integers @var{dividend} and @var{divisor},
-An @code{arith-error} results if @var{divisor} is 0.
+@example
+@group
+(+ (% @var{dividend} @var{divisor})
+ (* (/ @var{dividend} @var{divisor}) @var{divisor}))
+@end group
+@end example
+
+@noindent
+always equals @var{dividend}. If @var{divisor} is zero, Emacs signals
+an @code{arith-error} error.
@example
(% 9 4)
@@ -656,18 +691,6 @@ An @code{arith-error} results if @var{divisor} is 0.
(% -9 -4)
@result{} -1
@end example
-
-For any two integers @var{dividend} and @var{divisor},
-
-@example
-@group
-(+ (% @var{dividend} @var{divisor})
- (* (/ @var{dividend} @var{divisor}) @var{divisor}))
-@end group
-@end example
-
-@noindent
-always equals @var{dividend}.
@end defun
@defun mod dividend divisor
@@ -677,12 +700,12 @@ in other words, the remainder after division of @var{dividend}
by @var{divisor}, but with the same sign as @var{divisor}.
The arguments must be numbers or markers.
-Unlike @code{%}, @code{mod} returns a well-defined result for negative
-arguments. It also permits floating point arguments; it rounds the
-quotient downward (towards minus infinity) to an integer, and uses that
-quotient to compute the remainder.
+Unlike @code{%}, @code{mod} permits floating point arguments; it
+rounds the quotient downward (towards minus infinity) to an integer,
+and uses that quotient to compute the remainder.
-An @code{arith-error} results if @var{divisor} is 0.
+If @var{divisor} is zero, @code{mod} signals an @code{arith-error}
+error if both arguments are integers, and returns a NaN otherwise.
@example
@group
@@ -762,7 +785,7 @@ and returns that value as a floating point number.
sequence of @dfn{bits} (digits which are either zero or one). A bitwise
operation acts on the individual bits of such a sequence. For example,
@dfn{shifting} moves the whole sequence left or right one or more places,
-reproducing the same pattern ``moved over.''
+reproducing the same pattern ``moved over''.
The bitwise operations in Emacs Lisp apply only to integers.
@@ -1065,8 +1088,8 @@ numbers as arguments.
@defun sin arg
@defunx cos arg
@defunx tan arg
-These are the ordinary trigonometric functions, with argument measured
-in radians.
+These are the basic trigonometric functions, with argument @var{arg}
+measured in radians.
@end defun
@defun asin arg
@@ -1084,8 +1107,8 @@ pi/2
@tex
@math{\pi/2}
@end tex
-(inclusive) whose sine is @var{arg}; if, however, @var{arg} is out of
-range (outside [@minus{}1, 1]), it signals a @code{domain-error} error.
+(inclusive) whose sine is @var{arg}. If @var{arg} is out of range
+(outside [@minus{}1, 1]), @code{asin} returns a NaN.
@end defun
@defun acos arg
@@ -1096,8 +1119,8 @@ pi
@tex
@math{\pi}
@end tex
-(inclusive) whose cosine is @var{arg}; if, however, @var{arg} is out
-of range (outside [@minus{}1, 1]), it signals a @code{domain-error} error.
+(inclusive) whose cosine is @var{arg}. If @var{arg} is out of range
+(outside [@minus{}1, 1]), @code{acos} returns a NaN.
@end defun
@defun atan y &optional x
@@ -1122,105 +1145,85 @@ angle in radians between the vector @code{[@var{x}, @var{y}]} and the
@end defun
@defun exp arg
-This is the exponential function; it returns
-@tex
-@math{e}
-@end tex
-@ifnottex
-@i{e}
-@end ifnottex
-to the power @var{arg}.
-@tex
-@math{e}
-@end tex
-@ifnottex
-@i{e}
-@end ifnottex
-is a fundamental mathematical constant also called the base of natural
-logarithms.
+This is the exponential function; it returns @math{e} to the power
+@var{arg}.
@end defun
@defun log arg &optional base
-This function returns the logarithm of @var{arg}, with base @var{base}.
-If you don't specify @var{base}, the base
-@tex
-@math{e}
-@end tex
-@ifnottex
-@i{e}
-@end ifnottex
-is used. If @var{arg} is negative, it signals a @code{domain-error}
-error.
-@end defun
-
-@ignore
-@defun expm1 arg
-This function returns @code{(1- (exp @var{arg}))}, but it is more
-accurate than that when @var{arg} is negative and @code{(exp @var{arg})}
-is close to 1.
-@end defun
-
-@defun log1p arg
-This function returns @code{(log (1+ @var{arg}))}, but it is more
-accurate than that when @var{arg} is so small that adding 1 to it would
-lose accuracy.
+This function returns the logarithm of @var{arg}, with base
+@var{base}. If you don't specify @var{base}, the natural base
+@math{e} is used. If @var{arg} or @var{base} is negative, @code{log}
+returns a NaN.
@end defun
-@end ignore
@defun log10 arg
-This function returns the logarithm of @var{arg}, with base 10. If
-@var{arg} is negative, it signals a @code{domain-error} error.
-@code{(log10 @var{x})} @equiv{} @code{(log @var{x} 10)}, at least
-approximately.
+This function returns the logarithm of @var{arg}, with base 10:
+@code{(log10 @var{x})} @equiv{} @code{(log @var{x} 10)}.
@end defun
@defun expt x y
This function returns @var{x} raised to power @var{y}. If both
arguments are integers and @var{y} is positive, the result is an
integer; in this case, overflow causes truncation, so watch out.
+If @var{x} is a finite negative number and @var{y} is a finite
+non-integer, @code{expt} returns a NaN.
@end defun
@defun sqrt arg
This returns the square root of @var{arg}. If @var{arg} is negative,
-it signals a @code{domain-error} error.
+@code{sqrt} returns a NaN.
@end defun
+In addition, Emacs defines the following common mathematical
+constants:
+
+@defvar float-e
+The mathematical constant @math{e} (2.71828@dots{}).
+@end defvar
+
+@defvar float-pi
+The mathematical constant @math{pi} (3.14159@dots{}).
+@end defvar
+
@node Random Numbers
@section Random Numbers
@cindex random numbers
-A deterministic computer program cannot generate true random numbers.
-For most purposes, @dfn{pseudo-random numbers} suffice. A series of
-pseudo-random numbers is generated in a deterministic fashion. The
-numbers are not truly random, but they have certain properties that
-mimic a random series. For example, all possible values occur equally
-often in a pseudo-random series.
-
-In Emacs, pseudo-random numbers are generated from a ``seed'' number.
-Starting from any given seed, the @code{random} function always
-generates the same sequence of numbers. Emacs always starts with the
-same seed value, so the sequence of values of @code{random} is actually
-the same in each Emacs run! For example, in one operating system, the
-first call to @code{(random)} after you start Emacs always returns
-@minus{}1457731, and the second one always returns @minus{}7692030. This
-repeatability is helpful for debugging.
-
-If you want random numbers that don't always come out the same, execute
-@code{(random t)}. This chooses a new seed based on the current time of
-day and on Emacs's process @acronym{ID} number.
+ A deterministic computer program cannot generate true random
+numbers. For most purposes, @dfn{pseudo-random numbers} suffice. A
+series of pseudo-random numbers is generated in a deterministic
+fashion. The numbers are not truly random, but they have certain
+properties that mimic a random series. For example, all possible
+values occur equally often in a pseudo-random series.
+
+ Pseudo-random numbers are generated from a ``seed''. Starting from
+any given seed, the @code{random} function always generates the same
+sequence of numbers. By default, Emacs initializes the random seed at
+startup, in such a way that the sequence of values of @code{random}
+(with overwhelming likelihood) differs in each Emacs run.
+
+ Sometimes you want the random number sequence to be repeatable. For
+example, when debugging a program whose behavior depends on the random
+number sequence, it is helpful to get the same behavior in each
+program run. To make the sequence repeat, execute @code{(random "")}.
+This sets the seed to a constant value for your particular Emacs
+executable (though it may differ for other Emacs builds). You can use
+other strings to choose various seed values.
@defun random &optional limit
This function returns a pseudo-random integer. Repeated calls return a
series of pseudo-random integers.
If @var{limit} is a positive integer, the value is chosen to be
-nonnegative and less than @var{limit}.
+nonnegative and less than @var{limit}. Otherwise, the value might be
+any integer representable in Lisp, i.e.@: an integer between
+@code{most-negative-fixnum} and @code{most-positive-fixnum}
+(@pxref{Integer Basics}).
If @var{limit} is @code{t}, it means to choose a new seed based on the
current time of day and on Emacs's process @acronym{ID} number.
-@c "Emacs'" is incorrect usage!
-On some machines, any integer representable in Lisp may be the result
-of @code{random}. On other machines, the result can never be larger
-than a certain maximum or less than a certain (negative) minimum.
+If @var{limit} is a string, it means to choose a new seed based on the
+string's contents.
+
@end defun
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 26def7858b7..6933ffe492a 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -1,10 +1,9 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/objects
-@node Lisp Data Types, Numbers, Introduction, Top
+@node Lisp Data Types
@chapter Lisp Data Types
@cindex object
@cindex Lisp object
@@ -61,7 +60,6 @@ to use these types can be found in later chapters.
@end menu
@node Printed Representation
-@comment node-name, next, previous, up
@section Printed Representation and Read Syntax
@cindex printed representation
@cindex read syntax
@@ -108,7 +106,6 @@ not be evaluated later. @xref{Input Functions}, for a description of
@code{read}, the basic function for reading objects.
@node Comments
-@comment node-name, next, previous, up
@section Comments
@cindex comments
@cindex @samp{;} in comment
@@ -352,53 +349,50 @@ following text.)
In addition to the specific escape sequences for special important
control characters, Emacs provides several types of escape syntax that
-you can use to specify non-ASCII text characters.
-
-@cindex unicode character escape
- You can specify characters by their Unicode values.
-@code{?\u@var{nnnn}} represents a character that maps to the Unicode
-code point @samp{U+@var{nnnn}} (by convention, Unicode code points are
-given in hexadecimal). There is a slightly different syntax for
-specifying characters with code points higher than
-@code{U+@var{ffff}}: @code{\U00@var{nnnnnn}} represents the character
-whose code point is @samp{U+@var{nnnnnn}}. The Unicode Standard only
-defines code points up to @samp{U+@var{10ffff}}, so if you specify a
-code point higher than that, Emacs signals an error.
-
- This peculiar and inconvenient syntax was adopted for compatibility
-with other programming languages. Unlike some other languages, Emacs
-Lisp supports this syntax only in character literals and strings.
+you can use to specify non-@acronym{ASCII} text characters.
@cindex @samp{\} in character constant
-@cindex backslash in character constant
-@cindex octal character code
- The most general read syntax for a character represents the
-character code in either octal or hex. To use octal, write a question
-mark followed by a backslash and the octal character code (up to three
-octal digits); thus, @samp{?\101} for the character @kbd{A},
-@samp{?\001} for the character @kbd{C-a}, and @code{?\002} for the
-character @kbd{C-b}. Although this syntax can represent any
-@acronym{ASCII} character, it is preferred only when the precise octal
-value is more important than the @acronym{ASCII} representation.
-
-@example
-@group
-?\012 @result{} 10 ?\n @result{} 10 ?\C-j @result{} 10
-?\101 @result{} 65 ?A @result{} 65
-@end group
-@end example
-
- To use hex, write a question mark followed by a backslash, @samp{x},
-and the hexadecimal character code. You can use any number of hex
-digits, so you can represent any character code in this way.
-Thus, @samp{?\x41} for the character @kbd{A}, @samp{?\x1} for the
-character @kbd{C-a}, and @code{?\xe0} for the Latin-1 character
+@cindex backslash in character constants
+@cindex unicode character escape
+ Firstly, you can specify characters by their Unicode values.
+@code{?\u@var{nnnn}} represents a character with Unicode code point
+@samp{U+@var{nnnn}}, where @var{nnnn} is (by convention) a hexadecimal
+number with exactly four digits. The backslash indicates that the
+subsequent characters form an escape sequence, and the @samp{u}
+specifies a Unicode escape sequence.
+
+ There is a slightly different syntax for specifying Unicode
+characters with code points higher than @code{U+@var{ffff}}:
+@code{?\U00@var{nnnnnn}} represents the character with code point
+@samp{U+@var{nnnnnn}}, where @var{nnnnnn} is a six-digit hexadecimal
+number. The Unicode Standard only defines code points up to
+@samp{U+@var{10ffff}}, so if you specify a code point higher than
+that, Emacs signals an error.
+
+ Secondly, you can specify characters by their hexadecimal character
+codes. A hexadecimal escape sequence consists of a backslash,
+@samp{x}, and the hexadecimal character code. Thus, @samp{?\x41} is
+the character @kbd{A}, @samp{?\x1} is the character @kbd{C-a}, and
+@code{?\xe0} is the character
@iftex
@samp{@`a}.
@end iftex
@ifnottex
@samp{a} with grave accent.
@end ifnottex
+You can use any number of hex digits, so you can represent any
+character code in this way.
+
+@cindex octal character code
+ Thirdly, you can specify characters by their character code in
+octal. An octal escape sequence consists of a backslash followed by
+up to three octal digits; thus, @samp{?\101} for the character
+@kbd{A}, @samp{?\001} for the character @kbd{C-a}, and @code{?\002}
+for the character @kbd{C-b}. Only characters up to octal code 777 can
+be specified this way.
+
+ These escape sequences may also be used in strings. @xref{Non-ASCII
+in Strings}.
@node Ctl-Char Syntax
@subsubsection Control-Character Syntax
@@ -427,10 +421,10 @@ codes for these non-@acronym{ASCII} control characters include the
@ifnottex
2**26
@end ifnottex
-bit as well as the code for the corresponding non-control
-character. Ordinary terminals have no way of generating non-@acronym{ASCII}
-control characters, but you can generate them straightforwardly using X
-and other window systems.
+bit as well as the code for the corresponding non-control character.
+Ordinary text terminals have no way of generating non-@acronym{ASCII}
+control characters, but you can generate them straightforwardly using
+X and other window systems.
For historical reasons, Emacs treats the @key{DEL} character as
the control equivalent of @kbd{?}:
@@ -501,10 +495,10 @@ character is upper case or lower case. Emacs uses the
@end ifnottex
bit to indicate that the shift key was used in typing a control
character. This distinction is possible only when you use X terminals
-or other special terminals; ordinary terminals do not report the
-distinction to the computer in any way. The Lisp syntax for
-the shift bit is @samp{\S-}; thus, @samp{?\C-\S-o} or @samp{?\C-\S-O}
-represents the shifted-control-o character.
+or other special terminals; ordinary text terminals do not report the
+distinction. The Lisp syntax for the shift bit is @samp{\S-}; thus,
+@samp{?\C-\S-o} or @samp{?\C-\S-O} represents the shifted-control-o
+character.
@cindex hyper characters
@cindex super characters
@@ -541,9 +535,9 @@ intended. But you can use one symbol in all of these ways,
independently.
A symbol whose name starts with a colon (@samp{:}) is called a
-@dfn{keyword symbol}. These symbols automatically act as constants, and
-are normally used only by comparing an unknown symbol with a few
-specific alternatives.
+@dfn{keyword symbol}. These symbols automatically act as constants,
+and are normally used only by comparing an unknown symbol with a few
+specific alternatives. @xref{Constant Variables}.
@cindex @samp{\} in symbols
@cindex backslash in symbols
@@ -617,26 +611,28 @@ all symbols; @pxref{Creating Symbols}.)
@subsection Sequence Types
A @dfn{sequence} is a Lisp object that represents an ordered set of
-elements. There are two kinds of sequence in Emacs Lisp, lists and
-arrays. Thus, an object of type list or of type array is also
-considered a sequence.
-
- Arrays are further subdivided into strings, vectors, char-tables and
-bool-vectors. Vectors can hold elements of any type, but string
-elements must be characters, and bool-vector elements must be @code{t}
-or @code{nil}. Char-tables are like vectors except that they are
-indexed by any valid character code. The characters in a string can
-have text properties like characters in a buffer (@pxref{Text
-Properties}), but vectors do not support text properties, even when
-their elements happen to be characters.
-
- Lists, strings and the other array types are different, but they have
-important similarities. For example, all have a length @var{l}, and all
-have elements which can be indexed from zero to @var{l} minus one.
-Several functions, called sequence functions, accept any kind of
-sequence. For example, the function @code{elt} can be used to extract
-an element of a sequence, given its index. @xref{Sequences Arrays
-Vectors}.
+elements. There are two kinds of sequence in Emacs Lisp: @dfn{lists}
+and @dfn{arrays}.
+
+ Lists are the most commonly-used sequences. A list can hold
+elements of any type, and its length can be easily changed by adding
+or removing elements. See the next subsection for more about lists.
+
+ Arrays are fixed-length sequences. They are further subdivided into
+strings, vectors, char-tables and bool-vectors. Vectors can hold
+elements of any type, whereas string elements must be characters, and
+bool-vector elements must be @code{t} or @code{nil}. Char-tables are
+like vectors except that they are indexed by any valid character code.
+The characters in a string can have text properties like characters in
+a buffer (@pxref{Text Properties}), but vectors do not support text
+properties, even when their elements happen to be characters.
+
+ Lists, strings and the other array types also share important
+similarities. For example, all have a length @var{l}, and all have
+elements which can be indexed from zero to @var{l} minus one. Several
+functions, called sequence functions, accept any kind of sequence.
+For example, the function @code{length} reports the length of any kind
+of sequence. @xref{Sequences Arrays Vectors}.
It is generally impossible to read the same sequence twice, since
sequences are always created anew upon reading. If you read the read
@@ -650,28 +646,31 @@ same object, @code{nil}.
@cindex decrement field of register
@cindex pointers
- A @dfn{cons cell} is an object that consists of two slots, called the
-@sc{car} slot and the @sc{cdr} slot. Each slot can @dfn{hold} or
-@dfn{refer to} any Lisp object. We also say that ``the @sc{car} of
-this cons cell is'' whatever object its @sc{car} slot currently holds,
-and likewise for the @sc{cdr}.
-
-@quotation
-A note to C programmers: in Lisp, we do not distinguish between
-``holding'' a value and ``pointing to'' the value, because pointers in
-Lisp are implicit.
-@end quotation
+ A @dfn{cons cell} is an object that consists of two slots, called
+the @sc{car} slot and the @sc{cdr} slot. Each slot can @dfn{hold} any
+Lisp object. We also say that ``the @sc{car} of this cons cell is''
+whatever object its @sc{car} slot currently holds, and likewise for
+the @sc{cdr}.
+@cindex list structure
A @dfn{list} is a series of cons cells, linked together so that the
@sc{cdr} slot of each cons cell holds either the next cons cell or the
empty list. The empty list is actually the symbol @code{nil}.
-@xref{Lists}, for functions that work on lists. Because most cons
-cells are used as part of lists, the phrase @dfn{list structure} has
-come to refer to any structure made out of cons cells.
+@xref{Lists}, for details. Because most cons cells are used as part
+of lists, we refer to any structure made out of cons cells as a
+@dfn{list structure}.
+
+@cindex linked list
+@quotation
+A note to C programmers: a Lisp list thus works as a @dfn{linked list}
+built up of cons cells. Because pointers in Lisp are implicit, we do
+not distinguish between a cons cell slot ``holding'' a value versus
+``pointing to'' the value.
+@end quotation
@cindex atoms
Because cons cells are so central to Lisp, we also have a word for
-``an object which is not a cons cell.'' These objects are called
+``an object which is not a cons cell''. These objects are called
@dfn{atoms}.
@cindex parenthesis
@@ -909,7 +908,6 @@ It looks like this:
@end ifnottex
@node Association List Type
-@comment node-name, next, previous, up
@subsubsection Association List Type
An @dfn{association list} or @dfn{alist} is a specially-constructed
@@ -1025,40 +1023,53 @@ but the newline is ignored if escaped."
@node Non-ASCII in Strings
@subsubsection Non-@acronym{ASCII} Characters in Strings
- You can include a non-@acronym{ASCII} international character in a string
-constant by writing it literally. There are two text representations
-for non-@acronym{ASCII} characters in Emacs strings (and in buffers): unibyte
-and multibyte. If the string constant is read from a multibyte source,
-such as a multibyte buffer or string, or a file that would be visited as
-multibyte, then the character is read as a multibyte character, and that
-makes the string multibyte. If the string constant is read from a
-unibyte source, then the character is read as unibyte and that makes the
-string unibyte.
-
- You can also represent a multibyte non-@acronym{ASCII} character with its
-character code: use a hex escape, @samp{\x@var{nnnnnnn}}, with as many
-digits as necessary. (Multibyte non-@acronym{ASCII} character codes are all
-greater than 256.) Any character which is not a valid hex digit
-terminates this construct. If the next character in the string could be
-interpreted as a hex digit, write @w{@samp{\ }} (backslash and space) to
-terminate the hex escape---for example, @w{@samp{\xe0\ }} represents
-one character, @samp{a} with grave accent. @w{@samp{\ }} in a string
-constant is just like backslash-newline; it does not contribute any
-character to the string, but it does terminate the preceding hex escape.
-
- You can represent a unibyte non-@acronym{ASCII} character with its
-character code, which must be in the range from 128 (0200 octal) to
-255 (0377 octal). If you write all such character codes in octal and
-the string contains no other characters forcing it to be multibyte,
-this produces a unibyte string. However, using any hex escape in a
-string (even for an @acronym{ASCII} character) forces the string to be
-multibyte.
-
- You can also specify characters in a string by their numeric values
-in Unicode, using @samp{\u} and @samp{\U} (@pxref{Character Type}).
-
- @xref{Text Representations}, for more information about the two
-text representations.
+ There are two text representations for non-@acronym{ASCII}
+characters in Emacs strings: multibyte and unibyte (@pxref{Text
+Representations}). Roughly speaking, unibyte strings store raw bytes,
+while multibyte strings store human-readable text. Each character in
+a unibyte string is a byte, i.e.@: its value is between 0 and 255. By
+contrast, each character in a multibyte string may have a value
+between 0 to 4194303 (@pxref{Character Type}). In both cases,
+characters above 127 are non-@acronym{ASCII}.
+
+ You can include a non-@acronym{ASCII} character in a string constant
+by writing it literally. If the string constant is read from a
+multibyte source, such as a multibyte buffer or string, or a file that
+would be visited as multibyte, then Emacs reads each
+non-@acronym{ASCII} character as a multibyte character and
+automatically makes the string a multibyte string. If the string
+constant is read from a unibyte source, then Emacs reads the
+non-@acronym{ASCII} character as unibyte, and makes the string
+unibyte.
+
+ Instead of writing a character literally into a multibyte string,
+you can write it as its character code using an escape sequence.
+@xref{General Escape Syntax}, for details about escape sequences.
+
+ If you use any Unicode-style escape sequence @samp{\uNNNN} or
+@samp{\U00NNNNNN} in a string constant (even for an @acronym{ASCII}
+character), Emacs automatically assumes that it is multibyte.
+
+ You can also use hexadecimal escape sequences (@samp{\x@var{n}}) and
+octal escape sequences (@samp{\@var{n}}) in string constants.
+@strong{But beware:} If a string constant contains hexadecimal or
+octal escape sequences, and these escape sequences all specify unibyte
+characters (i.e.@: less than 256), and there are no other literal
+non-@acronym{ASCII} characters or Unicode-style escape sequences in
+the string, then Emacs automatically assumes that it is a unibyte
+string. That is to say, it assumes that all non-@acronym{ASCII}
+characters occurring in the string are 8-bit raw bytes.
+
+ In hexadecimal and octal escape sequences, the escaped character
+code may contain a variable number of digits, so the first subsequent
+character which is not a valid hexadecimal or octal digit terminates
+the escape sequence. If the next character in a string could be
+interpreted as a hexadecimal or octal digit, write @w{@samp{\ }}
+(backslash and space) to terminate the escape sequence. For example,
+@w{@samp{\xe0\ }} represents one character, @samp{a} with grave
+accent. @w{@samp{\ }} in a string constant is just like
+backslash-newline; it does not contribute any character to the string,
+but it does terminate any preceding hex escape.
@node Nonprinting Characters
@subsubsection Nonprinting Characters in Strings
@@ -1285,7 +1296,7 @@ without qualification, we mean a Lisp macro, not a keyboard macro.
A @dfn{primitive function} is a function callable from Lisp but
written in the C programming language. Primitive functions are also
called @dfn{subrs} or @dfn{built-in functions}. (The word ``subr'' is
-derived from ``subroutine.'') Most primitive functions evaluate all
+derived from ``subroutine''.) Most primitive functions evaluate all
their arguments when they are called. A primitive function that does
not evaluate all its arguments is called a @dfn{special form}
(@pxref{Special Forms}).@refill
@@ -1318,11 +1329,11 @@ with the name of the subroutine.
@node Byte-Code Type
@subsection Byte-Code Function Type
-The byte compiler produces @dfn{byte-code function objects}.
-Internally, a byte-code function object is much like a vector; however,
-the evaluator handles this data type specially when it appears as a
-function to be called. @xref{Byte Compilation}, for information about
-the byte compiler.
+@dfn{Byte-code function objects} are produced by byte-compiling Lisp
+code (@pxref{Byte Compilation}). Internally, a byte-code function
+object is much like a vector; however, the evaluator handles this data
+type specially when it appears in a function call. @xref{Byte-Code
+Objects}.
The printed representation and read syntax for a byte-code function
object is like that for a vector, with an additional @samp{#} before the
@@ -1563,7 +1574,6 @@ runs in a process of this sort. However, in Emacs Lisp, a process is a
Lisp object that designates a subprocess created by the Emacs process.
Programs such as shells, GDB, ftp, and compilers, running in
subprocesses of Emacs, extend the capabilities of Emacs.
-
An Emacs subprocess takes textual input from Emacs and returns textual
output to Emacs for further manipulation. Emacs can also send signals
to the subprocess.
@@ -1627,7 +1637,7 @@ buffer temporarily in a different display style. Overlays have no read
syntax, and print in hash notation, giving the buffer name and range of
positions.
- @xref{Overlays}, for how to create and use overlays.
+ @xref{Overlays}, for information on how you can create and use overlays.
@node Font Type
@subsection Font Type
@@ -1790,6 +1800,9 @@ with references to further information.
@item consp
@xref{List-related Predicates, consp}.
+@item custom-variable-p
+@xref{Variable Definitions, custom-variable-p}.
+
@item display-table-p
@xref{Display Tables, display-table-p}.
@@ -1865,9 +1878,6 @@ with references to further information.
@item syntax-table-p
@xref{Syntax Tables, syntax-table-p}.
-@item user-variable-p
-@xref{Defining Variables, user-variable-p}.
-
@item vectorp
@xref{Vectors, vectorp}.
@@ -1922,23 +1932,24 @@ This function returns a symbol naming the primitive type of
@section Equality Predicates
@cindex equality
- Here we describe functions that test for equality between any two
-objects. Other functions test equality of contents between objects of specific
-types, e.g., strings. For these predicates, see the appropriate chapter
-describing the data type.
+ Here we describe functions that test for equality between two
+objects. Other functions test equality of contents between objects of
+specific types, e.g.@: strings. For these predicates, see the
+appropriate chapter describing the data type.
@defun eq object1 object2
This function returns @code{t} if @var{object1} and @var{object2} are
-the same object, @code{nil} otherwise.
-
-@code{eq} returns @code{t} if @var{object1} and @var{object2} are
-integers with the same value. Also, since symbol names are normally
-unique, if the arguments are symbols with the same name, they are
-@code{eq}. For other types (e.g., lists, vectors, strings), two
-arguments with the same contents or elements are not necessarily
-@code{eq} to each other: they are @code{eq} only if they are the same
-object, meaning that a change in the contents of one will be reflected
-by the same change in the contents of the other.
+the same object, and @code{nil} otherwise.
+
+If @var{object1} and @var{object2} are integers with the same value,
+they are considered to be the same object (i.e.@: @code{eq} returns
+@code{t}). If @var{object1} and @var{object2} are symbols with the
+same name, they are normally the same object---but see @ref{Creating
+Symbols} for exceptions. For other types (e.g.@: lists, vectors,
+strings), two arguments with the same contents or elements are not
+necessarily @code{eq} to each other: they are @code{eq} only if they
+are the same object, meaning that a change in the contents of one will
+be reflected by the same change in the contents of the other.
@example
@group
@@ -1988,6 +1999,7 @@ by the same change in the contents of the other.
@end group
@end example
+@noindent
The @code{make-symbol} function returns an uninterned symbol, distinct
from the symbol that is used if you write the name in a Lisp expression.
Distinct symbols with the same name are not @code{eq}. @xref{Creating
@@ -2003,11 +2015,11 @@ Symbols}.
@defun equal object1 object2
This function returns @code{t} if @var{object1} and @var{object2} have
-equal components, @code{nil} otherwise. Whereas @code{eq} tests if its
-arguments are the same object, @code{equal} looks inside nonidentical
-arguments to see if their elements or contents are the same. So, if two
-objects are @code{eq}, they are @code{equal}, but the converse is not
-always true.
+equal components, and @code{nil} otherwise. Whereas @code{eq} tests
+if its arguments are the same object, @code{equal} looks inside
+nonidentical arguments to see if their elements or contents are the
+same. So, if two objects are @code{eq}, they are @code{equal}, but
+the converse is not always true.
@example
@group
@@ -2059,13 +2071,13 @@ always true.
@end example
Comparison of strings is case-sensitive, but does not take account of
-text properties---it compares only the characters in the strings. Use
-@code{equal-including-properties} to also compare text properties. For
-technical reasons, a unibyte string and a multibyte string are
-@code{equal} if and only if they contain the same sequence of
-character codes and all these codes are either in the range 0 through
-127 (@acronym{ASCII}) or 160 through 255 (@code{eight-bit-graphic}).
-(@pxref{Text Representations}).
+text properties---it compares only the characters in the strings.
+@xref{Text Properties}. Use @code{equal-including-properties} to also
+compare text properties. For technical reasons, a unibyte string and
+a multibyte string are @code{equal} if and only if they contain the
+same sequence of character codes and all these codes are either in the
+range 0 through 127 (@acronym{ASCII}) or 160 through 255
+(@code{eight-bit-graphic}). (@pxref{Text Representations}).
@example
@group
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 7d05f8f3468..7552aaccc53 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1,15 +1,13 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/os
-@node System Interface, Packaging, Display, Top
+@node System Interface
@chapter Operating System Interface
This chapter is about starting and getting out of Emacs, access to
-values in the operating system environment, and terminal input, output,
-and flow control.
+values in the operating system environment, and terminal input, output.
@xref{Building Emacs}, for related information. @xref{Display}, for
additional operating system status information pertaining to the
@@ -36,6 +34,7 @@ terminal and the screen.
* X11 Keysyms:: Operating on key symbols for X Windows.
* Batch Mode:: Running Emacs without terminal interaction.
* Session Management:: Saving and restoring state with X Session Management.
+* Notifications:: Desktop notifications.
* Dynamic Libraries:: On-demand loading of support libraries.
@end menu
@@ -60,7 +59,7 @@ can customize these actions.
@cindex @file{startup.el}
When Emacs is started up, it performs the following operations
-(which are defined in @file{startup.el}):
+(see @code{normal-top-level} in @file{startup.el}):
@enumerate
@item
@@ -70,6 +69,13 @@ adds the directory's subdirectories to the list, and those are scanned
in their turn. The files @file{subdirs.el} are normally generated
automatically when Emacs is installed.
+@item
+If the library @file{leim-list.el} exists, Emacs loads it. This
+optional library is intended for registering input methods; Emacs
+looks for it in @code{load-path} (@pxref{Library Search}), skipping
+those directories containing the standard Emacs libraries (since
+@file{leim-list.el} should not exist in those directories).
+
@vindex before-init-time
@item
It sets the variable @code{before-init-time} to the value of
@@ -77,32 +83,49 @@ It sets the variable @code{before-init-time} to the value of
@code{after-init-time} to @code{nil}, which signals to Lisp programs
that Emacs is being initialized.
+@c set-locale-environment
+@item
+It sets the language environment and the terminal coding system,
+if requested by environment variables such as @env{LANG}.
+
+@item
+It does some basic parsing of the command-line arguments.
+
@vindex initial-window-system@r{, and startup}
@vindex window-system-initialization-alist
@item
-It loads the initialization library for the window system specified by
-the variable @code{initial-window-system} (@pxref{Window Systems,
-initial-window-system}). This library's name is
-@file{term/@var{windowsystem}-win.el}, where @var{windowsystem} is the
-value of @code{initial-window-system}. From that library, it calls
-the appropriate initialization function. The initialization function
-for each supported window system is specified by
-@code{window-system-initialization-alist}.
+If not running in batch mode, it initializes the window system that
+the variable @code{initial-window-system} specifies (@pxref{Window
+Systems, initial-window-system}). The initialization function for
+each supported window system is specified by
+@code{window-system-initialization-alist}. If the value
+of @code{initial-window-system} is @var{windowsystem}, then the
+appropriate initialization function is defined in the file
+@file{term/@var{windowsystem}-win.el}. This file should have been
+compiled into the Emacs executable when it was built.
@item
-It sets the language environment and the terminal coding system,
-if requested by environment variables such as @code{LANG}.
+It runs the normal hook @code{before-init-hook}.
@item
-It processes the initial options. (Some of them are handled
-even earlier than this.)
+If appropriate, it creates a graphical frame. This is not done if the
+options @samp{--batch} or @samp{--daemon} were specified.
@item
-It runs the normal hook @code{before-init-hook}.
+It initializes the initial frame's faces, and sets up the menu bar
+and tool bar if needed. If graphical frames are supported, it sets up
+the tool bar even if the current frame is not a graphical one, since a
+graphical frame may be created later on.
@item
-It initializes the window frame and faces, if appropriate, and turns
-on the menu bar and tool bar, if the initial frame needs them.
+It use @code{custom-reevaluate-setting} to re-initialize the members
+of the list @code{custom-delayed-init-variables}. These are any
+pre-loaded user options whose default value depends on the run-time,
+rather than build-time, context.
+@xref{Building Emacs, custom-initialize-delay}.
+
+@c @item
+@c It registers the colors available for tty frames.
@item
It loads the library @file{site-start}, if it exists. This is not
@@ -127,6 +150,11 @@ It loads your abbrevs from the file specified by
(@pxref{Abbrev Files, abbrev-file-name}). This is not done if the
option @samp{--batch} was specified.
+@item
+If @code{package-enable-at-startup} is non-@code{nil}, it calls the
+function @code{package-initialize} to activate any optional Emacs Lisp
+package that has been installed. @xref{Packaging Basics}.
+
@vindex after-init-time
@item
It sets the variable @code{after-init-time} to the value of
@@ -139,31 +167,44 @@ measurement of how long it took.
It runs the normal hook @code{after-init-hook}.
@item
-If the buffer @samp{*scratch*} exists and is still in Fundamental mode
+If the buffer @file{*scratch*} exists and is still in Fundamental mode
(as it should be by default), it sets its major mode according to
@code{initial-major-mode}.
@item
-If started on a text-only terminal, it loads the terminal-specific
+If started on a text terminal, it loads the terminal-specific
Lisp library, which is specified by the variable
@code{term-file-prefix} (@pxref{Terminal-Specific}). This is not done
in @code{--batch} mode, nor if @code{term-file-prefix} is @code{nil}.
+@c Now command-line calls command-line-1.
+
@item
It displays the initial echo area message, unless you have suppressed
that with @code{inhibit-startup-echo-area-message}.
@item
-It processes the action arguments from the command line.
+It processes any command-line options that were not handled earlier.
+@c This next one is back in command-line, but the remaining bits of
+@c command-line-1 are not done if noninteractive.
@item
It now exits if the option @code{--batch} was specified.
@item
If @code{initial-buffer-choice} is a string, it visits the file with
-that name. Furthermore, if the @samp{*scratch*} buffer exists and is
+that name. If the @file{*scratch*} buffer exists and is
empty, it inserts @code{initial-scratch-message} into that buffer.
+@c To make things nice and confusing, the next three items can be
+@c called from two places. If displaying a startup screen, they are
+@c called in command-line-1 before the startup screen is shown.
+@c inhibit-startup-hooks is then set and window-setup-hook set to nil.
+@c If not displaying a startup screen, they are are called in
+@c normal-top-level.
+@c FIXME? So it seems they can be called before or after the
+@c daemon/session restore step?
+
@item
It runs @code{emacs-startup-hook} and then @code{term-setup-hook}.
@@ -176,26 +217,41 @@ specify.
It runs @code{window-setup-hook}. @xref{Window Systems}.
@item
+It displays the @dfn{startup screen}, which is a special buffer that
+contains information about copyleft and basic Emacs usage. This is
+not done if @code{inhibit-startup-screen} or @code{initial-buffer-choice}
+are non-@code{nil}, or if the @samp{--no-splash} or @samp{-Q} command-line
+options were specified.
+
+@c End of command-line-1.
+
+@c Back to command-line from command-line-1.
+
+@c This is the point at which we actually exit in batch mode, but the
+@c last few bits of command-line-1 are not done in batch mode.
+
+@item
If the option @code{--daemon} was specified, it calls
@code{server-start} and detaches from the controlling terminal.
@xref{Emacs Server,,, emacs, The GNU Emacs Manual}.
@item
-It displays the @dfn{startup screen}, which is a special buffer that
-contains information about copyleft and basic Emacs usage. This is
-not done if @code{initial-buffer-choice} or
-@code{inhibit-startup-screen} are @code{nil}, nor if the
-@samp{--no-splash} or @samp{-Q} command-line options were specified.
-
-@item
If started by the X session manager, it calls
@code{emacs-session-restore} passing it as argument the ID of the
previous session. @xref{Session Management}.
+
+@c End of command-line.
+
+@c Back to normal-top-level from command-line.
+
@end enumerate
+@noindent
+The following options affect some aspects of the startup sequence.
+
@defopt inhibit-startup-screen
This variable, if non-@code{nil}, inhibits the startup screen. In
-that case, Emacs typically displays the @samp{*scratch*} buffer; but
+that case, Emacs typically displays the @file{*scratch*} buffer; but
see @code{initial-buffer-choice}, below.
Do not set this variable in the init file of a new user, or in a way
@@ -209,11 +265,14 @@ aliases for this variable.
@end defopt
@defopt initial-buffer-choice
-This variable, if non-@code{nil}, determines a file or buffer for
-Emacs to display after starting up, instead of the startup screen. If
-its value is @code{t}, Emacs displays the @samp{*scratch*} buffer. If
-its value is a string, that specifies the name of a file for Emacs to
-visit.
+If non-@code{nil}, this variable is a string that specifies a file or
+directory for Emacs to display after starting up, instead of the
+startup screen.
+@ignore
+@c I do not think this should be mentioned. AFAICS it is just a dodge
+@c around inhibit-startup-screen not being settable on a site-wide basis.
+If its value is @code{t}, Emacs displays the @file{*scratch*} buffer.
+@end ignore
@end defopt
@defopt inhibit-startup-echo-area-message
@@ -228,55 +287,87 @@ form to your init file:
Emacs explicitly checks for an expression as shown above in your init
file; your login name must appear in the expression as a Lisp string
-constant. Other methods of setting
-@code{inhibit-startup-echo-area-message} to the same value do not
-inhibit the startup message. This way, you can easily inhibit the
+constant. You can also use the Customize interface. Other methods of
+setting @code{inhibit-startup-echo-area-message} to the same value do
+not inhibit the startup message. This way, you can easily inhibit the
message for yourself if you wish, but thoughtless copying of your init
file will not inhibit the message for someone else.
@end defopt
@defopt initial-scratch-message
This variable, if non-@code{nil}, should be a string, which is
-inserted into the @samp{*scratch*} buffer when Emacs starts up. If it
-is @code{nil}, the @samp{*scratch*} buffer is empty.
+inserted into the @file{*scratch*} buffer when Emacs starts up. If it
+is @code{nil}, the @file{*scratch*} buffer is empty.
@end defopt
+@noindent
+The following command-line options affect some aspects of the startup
+sequence. @xref{Initial Options,,, emacs, The GNU Emacs Manual}.
+
+@table @code
+@item --no-splash
+Do not display a splash screen.
+
+@item --batch
+Run without an interactive terminal. @xref{Batch Mode}.
+
+@item --daemon
+Do not initialize any display; just start a server in the background.
+
+@item --no-init-file
+@itemx -Q
+Do not load either the init file, or the @file{default} library.
+
+@item --no-site-file
+Do not load the @file{site-start} library.
+
+@item --quick
+@itemx -Q
+Equivalent to @samp{-q --no-site-file --no-splash}.
+@c and --no-site-lisp, but let's not mention that here.
+@end table
+
+
@node Init File
-@subsection The Init File, @file{.emacs}
+@subsection The Init File
@cindex init file
@cindex @file{.emacs}
+@cindex @file{init.el}
When you start Emacs, it normally attempts to load your @dfn{init
file}. This is either a file named @file{.emacs} or @file{.emacs.el}
in your home directory, or a file named @file{init.el} in a
-subdirectory named @file{.emacs.d} in your home directory. Whichever
-place you use, you can also compile the file (@pxref{Byte
+subdirectory named @file{.emacs.d} in your home directory.
+@ignore
+Whichever place you use, you can also compile the file (@pxref{Byte
Compilation}); then the actual file loaded will be @file{.emacs.elc}
or @file{init.elc}.
+@end ignore
The command-line switches @samp{-q}, @samp{-Q}, and @samp{-u}
control whether and where to find the init file; @samp{-q} (and the
stronger @samp{-Q}) says not to load an init file, while @samp{-u
@var{user}} says to load @var{user}'s init file instead of yours.
@xref{Entering Emacs,,, emacs, The GNU Emacs Manual}. If neither
-option is specified, Emacs uses the @code{LOGNAME} environment
-variable, or the @code{USER} (most systems) or @code{USERNAME} (MS
+option is specified, Emacs uses the @env{LOGNAME} environment
+variable, or the @env{USER} (most systems) or @env{USERNAME} (MS
systems) variable, to find your home directory and thus your init
file; this way, even if you have su'd, Emacs still loads your own init
file. If those environment variables are absent, though, Emacs uses
your user-id to find your home directory.
@cindex default init file
- A site may have a @dfn{default init file}, which is the library
-named @file{default.el}. Emacs finds the @file{default.el} file
-through the standard search path for libraries (@pxref{How Programs Do
-Loading}). The Emacs distribution does not come with this file; sites
-may provide one for local customizations. If the default init file
-exists, it is loaded whenever you start Emacs, except in batch mode or
-if @samp{-q} (or @samp{-Q}) is specified. But your own personal init
+ An Emacs installation may have a @dfn{default init file}, which is a
+Lisp library named @file{default.el}. Emacs finds this file through
+the standard search path for libraries (@pxref{How Programs Do
+Loading}). The Emacs distribution does not come with this file; it is
+intended for local customizations. If the default init file exists,
+it is loaded whenever you start Emacs. But your own personal init
file, if any, is loaded first; if it sets @code{inhibit-default-init}
to a non-@code{nil} value, then Emacs does not subsequently load the
-@file{default.el} file.
+@file{default.el} file. In batch mode, or if you specify @samp{-q}
+(or @samp{-Q}), Emacs loads neither your personal init file nor
+the default init file.
Another file for site-customization is @file{site-start.el}. Emacs
loads this @emph{before} the user's init file. You can inhibit the
@@ -287,6 +378,7 @@ This variable specifies the site-customization file to load before the
user's init file. Its normal value is @code{"site-start"}. The only
way you can change it with real effect is to do so before dumping
Emacs.
+@c So why even mention it here. I imagine it is almost never changed.
@end defopt
@xref{Init Examples,, Init File Examples, emacs, The GNU Emacs Manual}, for
@@ -294,28 +386,27 @@ examples of how to make various commonly desired customizations in your
@file{.emacs} file.
@defopt inhibit-default-init
-This variable prevents Emacs from loading the default initialization
-library file for your session of Emacs. If its value is non-@code{nil},
-then the default library is not loaded. The default value is
-@code{nil}.
+If this variable is non-@code{nil}, it prevents Emacs from loading the
+default initialization library file. The default value is @code{nil}.
@end defopt
@defvar before-init-hook
This normal hook is run, once, just before loading all the init files
-(the user's init file, @file{default.el}, and/or @file{site-start.el}).
+(@file{site-start.el}, your init file, and @file{default.el}).
(The only way to change it with real effect is before dumping Emacs.)
@end defvar
@defvar after-init-hook
This normal hook is run, once, just after loading all the init files
-(the user's init file, @file{default.el}, and/or @file{site-start.el}),
-before loading the terminal-specific library and processing the
-command-line action arguments.
+(@file{site-start.el}, your init file, and @file{default.el}),
+before loading the terminal-specific library (if started on a text
+terminal) and processing the command-line action arguments.
@end defvar
@defvar emacs-startup-hook
This normal hook is run, once, just after handling the command line
-arguments, just before @code{term-setup-hook}.
+arguments, just before @code{term-setup-hook}. In batch mode, Emacs
+does not run either of these hooks.
@end defvar
@defvar user-init-file
@@ -326,7 +417,7 @@ the value refers to the corresponding source file.
@defvar user-emacs-directory
This variable holds the name of the @file{.emacs.d} directory. It is
-ordinarily @file{~/.emacs.d}, but differs on some platforms.
+@file{~/.emacs.d} on all platforms but MS-DOS.
@end defvar
@node Terminal-Specific
@@ -336,30 +427,29 @@ ordinarily @file{~/.emacs.d}, but differs on some platforms.
Each terminal type can have its own Lisp library that Emacs loads when
run on that type of terminal. The library's name is constructed by
concatenating the value of the variable @code{term-file-prefix} and the
-terminal type (specified by the environment variable @code{TERM}).
+terminal type (specified by the environment variable @env{TERM}).
Normally, @code{term-file-prefix} has the value
@code{"term/"}; changing this is not recommended. Emacs finds the file
in the normal manner, by searching the @code{load-path} directories, and
trying the @samp{.elc} and @samp{.el} suffixes.
@cindex Termcap
- The usual function of a terminal-specific library is to enable
-special keys to send sequences that Emacs can recognize. It may also
-need to set or add to @code{input-decode-map} if the Termcap or
-Terminfo entry does not specify all the terminal's function keys.
-@xref{Terminal Input}.
+ The usual role of a terminal-specific library is to enable special
+keys to send sequences that Emacs can recognize. It may also need to
+set or add to @code{input-decode-map} if the Termcap or Terminfo entry
+does not specify all the terminal's function keys. @xref{Terminal
+Input}.
- When the name of the terminal type contains a hyphen, and no library
+ When the name of the terminal type contains a hyphen or underscore, and no library
is found whose name is identical to the terminal's name, Emacs strips
-from the terminal's name the last hyphen and everything that follows
+from the terminal's name the last hyphen or underscore and everything that follows
it, and tries again. This process is repeated until Emacs finds a
-matching library or until there are no more hyphens in the name (the
-latter means the terminal doesn't have any library specific to it).
-Thus, for example, if there are no @samp{aaa-48} and @samp{aaa-30}
-libraries, Emacs will try the same library @file{term/aaa.el} for
-terminal types @samp{aaa-48} and @samp{aaa-30-rv}. If necessary, the
-library can evaluate @code{(getenv "TERM")} to find the full name of
-the terminal type.@refill
+matching library, or until there are no more hyphens or underscores in the name
+(i.e.@: there is no terminal-specific library). For example, if the
+terminal name is @samp{xterm-256color} and there is no
+@file{term/xterm-256color.el} library, Emacs tries to load
+@file{term/xterm.el}. If necessary, the terminal library can evaluate
+@code{(getenv "TERM")} to find the full name of the terminal type.
Your init file can prevent the loading of the
terminal-specific library by setting the variable
@@ -368,16 +458,16 @@ experimenting with your own peculiar customizations.
You can also arrange to override some of the actions of the
terminal-specific library by setting the variable
-@code{term-setup-hook}. This is a normal hook which Emacs runs using
-@code{run-hooks} at the end of Emacs initialization, after loading both
-your init file and any terminal-specific libraries. You can
-use this variable to define initializations for terminals that do not
+@code{term-setup-hook}. This is a normal hook that Emacs runs
+at the end of its initialization, after loading both
+your init file and any terminal-specific libraries. You could
+use this hook to define initializations for terminals that do not
have their own libraries. @xref{Hooks}.
@defvar term-file-prefix
-@cindex @code{TERM} environment variable
-If the @code{term-file-prefix} variable is non-@code{nil}, Emacs loads
-a terminal-specific initialization file as follows:
+@cindex @env{TERM} environment variable
+If the value of this variable is non-@code{nil}, Emacs loads a
+terminal-specific initialization file as follows:
@example
(load (concat term-file-prefix (getenv "TERM")))
@@ -386,11 +476,9 @@ a terminal-specific initialization file as follows:
@noindent
You may set the @code{term-file-prefix} variable to @code{nil} in your
init file if you do not wish to load the
-terminal-initialization file. To do this, put the following in
-your init file: @code{(setq term-file-prefix nil)}.
+terminal-initialization file.
-On MS-DOS, if the environment variable @code{TERM} is not set, Emacs
-uses @samp{internal} as the terminal type.
+On MS-DOS, Emacs sets the @env{TERM} environment variable to @samp{internal}.
@end defvar
@defvar term-setup-hook
@@ -400,43 +488,27 @@ terminal-specific Lisp file.
You can use @code{term-setup-hook} to override the definitions made by a
terminal-specific file.
-@end defvar
- See @code{window-setup-hook} in @ref{Window Systems}, for a related
-feature.
+For a related feature, @pxref{Window Systems, window-setup-hook}.
+@end defvar
@node Command-Line Arguments
@subsection Command-Line Arguments
@cindex command-line arguments
- You can use command-line arguments to request various actions when you
-start Emacs. Since you do not need to start Emacs more than once per
-day, and will often leave your Emacs session running longer than that,
-command-line arguments are hardly ever used. As a practical matter, it
-is best to avoid making the habit of using them, since this habit would
-encourage you to kill and restart Emacs unnecessarily often. These
-options exist for two reasons: to be compatible with other editors (for
-invocation by other programs) and to enable shell scripts to run
-specific Lisp programs.
-
- This section describes how Emacs processes command-line arguments,
-and how you can customize them.
-
-@ignore
- (Note that some other editors require you to start afresh each time
-you want to edit a file. With this kind of editor, you will probably
-specify the file as a command-line argument. The recommended way to
-use GNU Emacs is to start it only once, just after you log in, and do
-all your editing in the same Emacs process. Each time you want to edit
-a different file, you visit it with the existing Emacs, which eventually
-comes to have many files in it ready for editing. Usually you do not
-kill the Emacs until you are about to log out.)
-@end ignore
+ You can use command-line arguments to request various actions when
+you start Emacs. Note that the recommended way of using Emacs is to
+start it just once, after logging in, and then do all editing in the same
+Emacs session (@pxref{Entering Emacs,,, emacs, The GNU Emacs Manual}).
+For this reason, you might not use command-line arguments very often;
+nonetheless, they can be useful when invoking Emacs from session
+scripts or debugging Emacs. This section describes how Emacs
+processes command-line arguments.
@defun command-line
This function parses the command line that Emacs was called with,
-processes it, loads the user's init file and displays the
-startup messages.
+processes it, and (amongst other things) loads the user's init file and
+displays the startup messages.
@end defun
@defvar command-line-processed
@@ -452,9 +524,9 @@ to process its new command-line arguments.
@cindex switches on command line
@cindex options on command line
@cindex command-line options
-The value of this variable is an alist of user-defined command-line
-options and associated handler functions. This variable exists so you
-can add elements to it.
+This variable is an alist of user-defined command-line options and
+associated handler functions. By default it is empty, but you can
+add elements if you wish.
A @dfn{command-line option} is an argument on the command line, which
has the form:
@@ -494,7 +566,9 @@ to Emacs.
@defvar command-line-args-left
@vindex argv
The value of this variable is the list of command-line arguments that
-have not yet been processed. @code{argv} is an alias for this.
+have not yet been processed.
+@c Don't mention this, since it is a "bad name for a dynamically bound variable"
+@c @code{argv} is an alias for this.
@end defvar
@defvar command-line-functions
@@ -515,7 +589,7 @@ should return a non-@code{nil} value to say it has dealt with that
argument. If it has also dealt with some of the following arguments, it
can indicate that by deleting them from @code{command-line-args-left}.
-If all of these functions return @code{nil}, then the argument is used
+If all of these functions return @code{nil}, then the argument is treated
as a file name to visit.
@end defvar
@@ -525,9 +599,9 @@ as a file name to visit.
There are two ways to get out of Emacs: you can kill the Emacs job,
which exits permanently, or you can suspend it, which permits you to
-reenter the Emacs process later. As a practical matter, you seldom kill
-Emacs---only when you are about to log out. Suspending is much more
-common.
+reenter the Emacs process later. (In a graphical environment, you can
+of course simply switch to another application without doing anything
+special to Emacs, then switch back to Emacs when you want.)
@menu
* Killing Emacs:: Exiting Emacs irreversibly.
@@ -535,13 +609,13 @@ common.
@end menu
@node Killing Emacs
-@comment node-name, next, previous, up
@subsection Killing Emacs
@cindex killing Emacs
- Killing Emacs means ending the execution of the Emacs process. The
-parent process normally resumes control. The low-level primitive for
-killing Emacs is @code{kill-emacs}.
+ Killing Emacs means ending the execution of the Emacs process.
+If you started Emacs from a terminal, the parent process normally
+resumes control. The low-level primitive for killing Emacs is
+@code{kill-emacs}.
@deffn Command kill-emacs &optional exit-data
This command calls the hook @code{kill-emacs-hook}, then exits the
@@ -600,7 +674,7 @@ directly does not run this hook.
@subsection Suspending Emacs
@cindex suspending Emacs
- On text-only terminals, it is possible to @dfn{suspend Emacs}, which
+ On text terminals, it is possible to @dfn{suspend Emacs}, which
means stopping Emacs temporarily and returning control to its superior
process, which is usually the shell. This allows you to resume
editing later in the same Emacs process, with the same buffers, the
@@ -612,11 +686,17 @@ use the appropriate command in the parent shell---most likely
Suspending works only on a terminal device from which the Emacs
session was started. We call that device the @dfn{controlling
terminal} of the session. Suspending is not allowed if the
-controlling terminal is a graphical terminal.
-
- Some operating systems do not support suspension of jobs; on these
-systems, ``suspension'' actually creates a new shell temporarily as a
-subprocess of Emacs. Then you would exit the shell to return to Emacs.
+controlling terminal is a graphical terminal. Suspending is usually
+not relevant in graphical environments, since you can simply switch to
+another application without doing anything special to Emacs.
+
+@c FIXME? Are there any systems Emacs still supports that do not
+@c have SIGTSTP?
+@cindex SIGTSTP
+ Some operating systems (those without @code{SIGTSTP}, or MS-DOS) do
+not support suspension of jobs; on these systems, ``suspension''
+actually creates a new shell temporarily as a subprocess of Emacs.
+Then you would exit the shell to return to Emacs.
@deffn Command suspend-emacs &optional string
This function stops Emacs and returns control to the superior process.
@@ -631,9 +711,10 @@ before suspending Emacs, or this function signals an error.
@xref{Multiple Terminals}.
If @var{string} is non-@code{nil}, its characters are sent to Emacs's
-superior shell, to be read as terminal input. The characters in
-@var{string} are not echoed by the superior shell; only the results
-appear.
+superior shell, to be read as terminal input.
+@c FIXME? It seems to me that shell does echo STRING.
+The characters in @var{string} are not echoed by the superior shell;
+only the results appear.
Before suspending, @code{suspend-emacs} runs the normal hook
@code{suspend-hook}. After the user resumes Emacs,
@@ -644,34 +725,23 @@ The next redisplay after resumption will redraw the entire screen,
unless the variable @code{no-redraw-on-reenter} is non-@code{nil}.
@xref{Refresh Screen}.
-In the following example, note that @samp{pwd} is not echoed after
-Emacs is suspended. But it is read and executed by the shell.
+Here is an example of how you could use these hooks:
@smallexample
@group
-(suspend-emacs)
- @result{} nil
-@end group
-
-@group
(add-hook 'suspend-hook
- (function (lambda ()
- (or (y-or-n-p
- "Really suspend? ")
- (error "Suspend canceled")))))
- @result{} (lambda nil
- (or (y-or-n-p "Really suspend? ")
- (error "Suspend canceled")))
-@end group
-@group
-(add-hook 'suspend-resume-hook
- (function (lambda () (message "Resumed!"))))
- @result{} (lambda nil (message "Resumed!"))
-@end group
-@group
-(suspend-emacs "pwd")
- @result{} nil
+ (lambda () (or (y-or-n-p "Really suspend? ")
+ (error "Suspend canceled"))))
@end group
+(add-hook 'suspend-resume-hook (lambda () (message "Resumed!")
+ (sit-for 2)))
+@end smallexample
+@c The sit-for prevents the ``nil'' that suspend-emacs returns
+@c hiding the message.
+
+Here is what you would see upon evaluating @code{(suspend-emacs "pwd")}:
+
+@smallexample
@group
---------- Buffer: Minibuffer ----------
Really suspend? @kbd{y}
@@ -680,8 +750,8 @@ Really suspend? @kbd{y}
@group
---------- Parent Shell ----------
-lewis@@slug[23] % /user/lewis/manual
-lewis@@slug[24] % fg
+bash$ /home/username
+bash$ fg
@end group
@group
@@ -689,6 +759,10 @@ lewis@@slug[24] % fg
Resumed!
@end group
@end smallexample
+
+@c FIXME? AFAICS, it is echoed.
+Note that @samp{pwd} is not echoed after Emacs is suspended. But it
+is read and executed by the shell.
@end deffn
@defvar suspend-hook
@@ -717,33 +791,33 @@ terminal object as an argument to each function.
@defun resume-tty &optional tty
This function resumes the previously suspended terminal device
-@var{tty}; @var{tty} can be a terminal object, a frame (meaning the
-terminal for that frame), or @code{nil} (meaning the terminal for the
-selected frame).
+@var{tty}; where @var{tty} has the same possible values as it does
+for @code{suspend-tty}.
@vindex resume-tty-functions
This function reopens the terminal device, re-initializes it, and
-redraws its with that terminal's selected frame. It then runs the
+redraws it with that terminal's selected frame. It then runs the
hook @code{resume-tty-functions}, passing the terminal object as an
argument to each function.
If the same device is already used by another Emacs terminal, this
-function signals an error.
+function signals an error. If @var{tty} is not suspended, this
+function does nothing.
@end defun
-@defun controlling-tty-p &optional terminal
-This function returns non-@code{nil} if @var{terminal} is the
-controlling terminal of the Emacs session; @code{terminal} can be a
+@defun controlling-tty-p &optional tty
+This function returns non-@code{nil} if @var{tty} is the
+controlling terminal of the Emacs session; @var{tty} can be a
terminal object, a frame (meaning the terminal for that frame), or
@code{nil} (meaning the terminal for the selected frame).
@end defun
@deffn Command suspend-frame
This command @dfn{suspends} a frame. For GUI frames, it calls
-@code{iconify-frame} (@pxref{Visibility of Frames}); for text-only
-frames, it calls either @code{suspend-emacs} or @code{suspend-tty},
-depending on whether the frame is displayed on the controlling
-terminal device or not.
+@code{iconify-frame} (@pxref{Visibility of Frames}); for frames on
+text terminals, it calls either @code{suspend-emacs} or
+@code{suspend-tty}, depending on whether the frame is displayed on the
+controlling terminal device or not.
@end deffn
@node System Environment
@@ -756,15 +830,15 @@ system, the user's @acronym{UID}, and so on.
@defvar system-configuration
This variable holds the standard GNU configuration name for the
-hardware/software configuration of your system, as a string. The
-convenient way to test parts of this string is with
-@code{string-match}.
+hardware/software configuration of your system, as a string. For
+example, a typical value for a 64-bit GNU/Linux system is
+@samp{"x86_64-unknown-linux-gnu"}.
@end defvar
@cindex system type and name
@defvar system-type
The value of this variable is a symbol indicating the type of operating
-system Emacs is operating on. Here is a table of the possible values:
+system Emacs is running on. The possible values are:
@table @code
@item aix
@@ -784,7 +858,7 @@ The GNU system (using the GNU kernel, which consists of the HURD and Mach).
@item gnu/linux
A GNU/Linux system---that is, a variant GNU system, using the Linux
-kernel. (These systems are the ones people often call ``Linux,'' but
+kernel. (These systems are the ones people often call ``Linux'', but
actually Linux is just the kernel, not the whole system.)
@item gnu/kfreebsd
@@ -797,33 +871,28 @@ Hewlett-Packard HPUX operating system.
Silicon Graphics Irix system.
@item ms-dos
-Microsoft MS-DOS ``operating system.'' Emacs compiled with DJGPP for
-MS-DOS binds @code{system-type} to @code{ms-dos} even when you run it on
-MS-Windows.
+Microsoft's DOS. Emacs compiled with DJGPP for MS-DOS binds
+@code{system-type} to @code{ms-dos} even when you run it on MS-Windows.
@item usg-unix-v
AT&T Unix System V.
@item windows-nt
-Microsoft Windows NT and later. The same executable supports Windows
-9X, but the value of @code{system-type} is @code{windows-nt} in either
-case.
+Microsoft Windows NT, 9X and later. The value of @code{system-type}
+is always @code{windows-nt}, e.g. even on Windows 7.
@end table
We do not wish to add new symbols to make finer distinctions unless it
is absolutely necessary! In fact, we hope to eliminate some of these
-alternatives in the future. We recommend using
-@code{system-configuration} to distinguish between different operating
-systems.
+alternatives in the future. If you need to make a finer distinction
+than @code{system-type} allows for, you can test
+@code{system-configuration}, e.g. against a regexp.
@end defvar
@defun system-name
-This function returns the name of the machine you are running on.
-@example
-(system-name)
- @result{} "www.gnu.org"
-@end example
+This function returns the name of the machine you are running on, as a
+string.
@end defun
The symbol @code{system-name} is a variable as well as a function. In
@@ -833,6 +902,7 @@ fact, the function returns whatever value the variable
system. The variable is also useful for constructing frame titles
(@pxref{Frame Titles}).
+@c FIXME seems like this section is not the best place for this option?
@defopt mail-host-address
If this variable is non-@code{nil}, it is used instead of
@code{system-name} for purposes of generating email addresses. For
@@ -840,37 +910,43 @@ example, it is used when constructing the default value of
@code{user-mail-address}. @xref{User Identification}. (Since this is
done when Emacs starts up, the value actually used is the one saved when
Emacs was dumped. @xref{Building Emacs}.)
+@c FIXME sounds like should probably give this a :set-after and some
+@c custom-initialize-delay voodoo.
@end defopt
@deffn Command getenv var &optional frame
@cindex environment variable access
This function returns the value of the environment variable @var{var},
as a string. @var{var} should be a string. If @var{var} is undefined
-in the environment, @code{getenv} returns @code{nil}. If returns
-@samp{""} if @var{var} is set but null. Within Emacs, the environment
-variable values are kept in the Lisp variable @code{process-environment}.
+in the environment, @code{getenv} returns @code{nil}. It returns
+@samp{""} if @var{var} is set but null. Within Emacs, a list of environment
+variables and their values is kept in the variable @code{process-environment}.
@example
@group
(getenv "USER")
@result{} "lewis"
@end group
+@end example
+
+The shell command @code{printenv} prints all or part of the environment:
+@example
@group
-lewis@@slug[10] % printenv
-PATH=.:/user/lewis/bin:/usr/bin:/usr/local/bin
+bash$ printenv
+PATH=/usr/local/bin:/usr/bin:/bin
USER=lewis
@end group
@group
-TERM=ibmapa16
-SHELL=/bin/csh
-HOME=/user/lewis
+TERM=xterm
+SHELL=/bin/bash
+HOME=/home/lewis
@end group
+@dots{}
@end example
@end deffn
-@c Emacs 19 feature
-@deffn Command setenv variable &optional value
+@deffn Command setenv variable &optional value substitute
This command sets the value of the environment variable named
@var{variable} to @var{value}. @var{variable} should be a string.
Internally, Emacs Lisp can handle any string. However, normally
@@ -878,8 +954,13 @@ Internally, Emacs Lisp can handle any string. However, normally
of letters, digits and underscores, starting with a letter or
underscore. Otherwise, errors may occur if subprocesses of Emacs try
to access the value of @var{variable}. If @var{value} is omitted or
-@code{nil}, @code{setenv} removes @var{variable} from the environment.
-Otherwise, @var{value} should be a string.
+@code{nil} (or, interactively, with a prefix argument), @code{setenv}
+removes @var{variable} from the environment. Otherwise, @var{value}
+should be a string.
+
+If the optional argument @var{substitute} is non-@code{nil}, Emacs
+calls the function @code{substitute-env-vars} to expand any
+environment variables in @var{value}.
@code{setenv} works by modifying @code{process-environment}; binding
that variable with @code{let} is also reasonable practice.
@@ -896,14 +977,14 @@ of this variable.
@smallexample
@group
process-environment
-@result{} ("l=/usr/stanford/lib/gnuemacs/lisp"
- "PATH=.:/user/lewis/bin:/usr/class:/nfsusr/local/bin"
+@result{} ("PATH=/usr/local/bin:/usr/bin:/bin"
"USER=lewis"
@end group
@group
- "TERM=ibmapa16"
- "SHELL=/bin/csh"
- "HOME=/user/lewis")
+ "TERM=xterm"
+ "SHELL=/bin/bash"
+ "HOME=/home/lewis"
+ @dots{})
@end group
@end smallexample
@@ -914,23 +995,21 @@ specifies the variable, and the other ``duplicates'' are ignored.
@defvar initial-environment
This variable holds the list of environment variables Emacs inherited
-from its parent process. It is computed during startup, see
-@ref{Startup Summary}.
+from its parent process when Emacs started.
@end defvar
@defvar path-separator
-This variable holds a string which says which character separates
+This variable holds a string that says which character separates
directories in a search path (as found in an environment variable). Its
-value is @code{":"} for Unix and GNU systems, and @code{";"} for MS-DOS
-and MS-Windows.
+value is @code{":"} for Unix and GNU systems, and @code{";"} for MS systems.
@end defvar
@defun parse-colon-path path
-This function takes a search path string such as would be the value of
-the @code{PATH} environment variable, and splits it at the separators,
-returning a list of directory names. @code{nil} in this list stands for
-``use the current directory.'' Although the function's name says
-``colon,'' it actually uses the value of @code{path-separator}.
+This function takes a search path string such as the value of
+the @env{PATH} environment variable, and splits it at the separators,
+returning a list of directory names. @code{nil} in this list means
+the current directory. Although the function's name says
+``colon'', it actually uses the value of @code{path-separator}.
@example
(parse-colon-path ":/foo:/bar")
@@ -945,30 +1024,32 @@ value is a string, and does not include a directory name.
@defvar invocation-directory
This variable holds the directory from which the Emacs executable was
-invoked, or perhaps @code{nil} if that directory cannot be determined.
+invoked, or @code{nil} if that directory cannot be determined.
@end defvar
@defvar installation-directory
If non-@code{nil}, this is a directory within which to look for the
-@file{lib-src} and @file{etc} subdirectories. This is non-@code{nil}
+@file{lib-src} and @file{etc} subdirectories. In an installed Emacs,
+it is normally @code{nil}. It is non-@code{nil}
when Emacs can't find those directories in their standard installed
locations, but can find them in a directory related somehow to the one
-containing the Emacs executable.
+containing the Emacs executable (i.e., @code{invocation-directory}).
@end defvar
@defun load-average &optional use-float
-This function returns the current 1-minute, 5-minute, and 15-minute load
-averages, in a list.
+This function returns the current 1-minute, 5-minute, and 15-minute
+system load averages, in a list. The load average indicates the
+number of processes trying to run on the system.
By default, the values are integers that are 100 times the system load
-averages, which indicate the average number of processes trying to run.
-If @var{use-float} is non-@code{nil}, then they are returned
-as floating point numbers and without multiplying by 100.
+averages, but if @var{use-float} is non-@code{nil}, then they are
+returned as floating point numbers without multiplying by 100.
If it is impossible to obtain the load average, this function signals
an error. On some platforms, access to load averages requires
installing Emacs as setuid or setgid so that it can read kernel
information, and that usually isn't advisable.
+@c FIXME which platforms are these? Are they still relevant?
If the 1-minute load average is available, but the 5- or 15-minute
averages are not, this function returns a shortened list containing
@@ -983,13 +1064,9 @@ the available averages.
(load-average t)
@result{} (1.69 0.48 0.36)
@end group
-
-@group
-lewis@@rocky[5] % uptime
- 11:55am up 1 day, 19:37, 3 users,
- load average: 1.69, 0.48, 0.36
-@end group
@end example
+
+The shell command @code{uptime} returns similar information.
@end defun
@defun emacs-pid
@@ -1000,7 +1077,8 @@ as an integer.
@defvar tty-erase-char
This variable holds the erase character that was selected
in the system's terminal driver, before Emacs was started.
-The value is @code{nil} if Emacs is running under a window system.
+@c FIXME? Seems untrue since 23.1. For me, it is 0.
+@c The value is @code{nil} if Emacs is running under a window system.
@end defvar
@node User Identification
@@ -1030,44 +1108,27 @@ want to use the default value.
@end defopt
@defun user-login-name &optional uid
-If you don't specify @var{uid}, this function returns the name under
-which the user is logged in. If the environment variable @code{LOGNAME}
-is set, that value is used. Otherwise, if the environment variable
-@code{USER} is set, that value is used. Otherwise, the value is based
-on the effective @acronym{UID}, not the real @acronym{UID}.
+This function returns the name under which the user is logged in.
+It uses the environment variables @env{LOGNAME} or @env{USER} if
+either is set. Otherwise, the value is based on the effective
+@acronym{UID}, not the real @acronym{UID}.
-If you specify @var{uid}, the value is the user name that corresponds
-to @var{uid} (which should be an integer), or @code{nil} if there is
-no such user.
-
-@example
-@group
-(user-login-name)
- @result{} "lewis"
-@end group
-@end example
+If you specify @var{uid} (a number), the result is the user name that
+corresponds to @var{uid}, or @code{nil} if there is no such user.
@end defun
@defun user-real-login-name
This function returns the user name corresponding to Emacs's real
-@acronym{UID}. This ignores the effective @acronym{UID} and ignores the
-environment variables @code{LOGNAME} and @code{USER}.
+@acronym{UID}. This ignores the effective @acronym{UID}, and the
+environment variables @env{LOGNAME} and @env{USER}.
@end defun
@defun user-full-name &optional uid
This function returns the full name of the logged-in user---or the value
-of the environment variable @code{NAME}, if that is set.
+of the environment variable @env{NAME}, if that is set.
-@c "Bil" is the correct spelling.
-@example
-@group
-(user-full-name)
- @result{} "Bil Lewis"
-@end group
-@end example
-
-If the Emacs job's user-id does not correspond to any known user (and
-provided @code{NAME} is not set), the value is @code{"unknown"}.
+If the Emacs process's user-id does not correspond to any known user (and
+provided @code{NAME} is not set), the result is @code{"unknown"}.
If @var{uid} is non-@code{nil}, then it should be a number (a user-id)
or a string (a login name). Then @code{user-full-name} returns the full
@@ -1087,14 +1148,8 @@ Titles}).
@defun user-real-uid
This function returns the real @acronym{UID} of the user.
-The value may be a floating point number.
-
-@example
-@group
-(user-real-uid)
- @result{} 19
-@end group
-@end example
+The value may be a floating point number, in the (unlikely) event that
+the UID is too large to fit in a Lisp integer.
@end defun
@defun user-uid
@@ -1102,27 +1157,72 @@ This function returns the effective @acronym{UID} of the user.
The value may be a floating point number.
@end defun
+@defun system-users
+This function returns a list of strings, listing the user names on the
+system. If Emacs cannot retrieve this information, the return value
+is a list containing just the value of @code{user-real-login-name}.
+@end defun
+
+@cindex user groups
+@defun system-groups
+This function returns a list of strings, listing the names of user
+groups on the system. If Emacs cannot retrieve this information, the
+return value is @code{nil}.
+@end defun
+
+
@node Time of Day
@section Time of Day
- This section explains how to determine the current time and the time
+ This section explains how to determine the current time and time
zone.
+@cindex epoch
+ Most of these functions represent time as a list of either four
+integers, @code{(@var{sec-high} @var{sec-low} @var{microsec}
+@var{picosec})}, or of three
+integers, @code{(@var{sec-high} @var{sec-low} @var{microsec})}, or of
+two integers, @code{(@var{sec-high} @var{sec-low})}. The integers
+@var{sec-high} and @var{sec-low} give the high and low bits of an
+integer number of seconds. This integer number,
+@ifnottex
+@var{high} * 2**16 + @var{low},
+@end ifnottex
+@tex
+$high*2^{16}+low$,
+@end tex
+is the number of seconds from the @dfn{epoch} (0:00 January 1, 1970
+UTC) to the specified time. The third list element @var{microsec}, if
+present, gives the number of microseconds from the start of that
+second to the specified time.
+Similarly, the fourth list element @var{picosec}, if present, gives
+the number of picoseconds from the start of that microsecond to the
+specified time.
+
+ The return value of @code{current-time} represents time using four
+integers, as do the timestamps in the return value of
+@code{file-attributes} (@pxref{Definition of
+file-attributes}). In function arguments, e.g.@: the @var{time-value}
+argument to @code{current-time-string}, two-, three-, and four-integer
+lists are accepted. You can convert times from the list
+representation into standard human-readable strings using
+@code{current-time}, or to other forms using the @code{decode-time}
+and @code{format-time-string} functions documented in the following
+sections.
+
@defun current-time-string &optional time-value
This function returns the current time and date as a human-readable
-string. The format of the string is unvarying; the number of characters
-used for each part is always the same, so you can reliably use
-@code{substring} to extract pieces of it. It is wise to count the
-characters from the beginning of the string rather than from the end, as
-additional information may some day be added at the end.
+string. The format does not vary for the initial part of the string,
+which contains the day of week, month, day of month, and time of day
+in that order: the number of characters used for these fields is
+always the same, so you can reliably
+use @code{substring} to extract them. You should count
+characters from the beginning of the string rather than from the end,
+as the year might not have exactly four digits, and additional
+information may some day be added at the end.
The argument @var{time-value}, if given, specifies a time to format
-instead of the current time. This argument should have the same form
-as the times obtained from @code{current-time} (see below) and from
-@code{file-attributes} (@pxref{Definition of file-attributes}). It
-should be a list whose first two elements are integers; a third
-(microsecond) element, if present, is ignored. @var{time-value} can
-also be a cons of two integers, but this usage is obsolete.
+(represented as a list of integers), instead of the current time.
@example
@group
@@ -1133,33 +1233,19 @@ also be a cons of two integers, but this usage is obsolete.
@end defun
@defun current-time
-This function returns the system's time value as a list of three
-integers: @code{(@var{high} @var{low} @var{microsec})}. The integers
-@var{high} and @var{low} combine to give the number of seconds since
-0:00 January 1, 1970 UTC (Coordinated Universal Time), which is
-@ifnottex
-@var{high} * 2**16 + @var{low}.
-@end ifnottex
-@tex
-$high*2^{16}+low$.
-@end tex
-
-The third element, @var{microsec}, gives the microseconds since the
-start of the current second (or 0 for systems that return time with
-the resolution of only one second).
-
-The first two elements can be compared with file time values such as you
-get with the function @code{file-attributes}.
-@xref{Definition of file-attributes}.
+This function returns the current time, represented as a list of four
+integers @code{(@var{sec-high} @var{sec-low} @var{microsec} @var{picosec})}.
+These integers have trailing zeros on systems that return time with
+lower resolutions. On all current machines @var{picosec} is a
+multiple of 1000, but this may change as higher-resolution clocks
+become available.
@end defun
@defun float-time &optional time-value
This function returns the current time as a floating-point number of
-seconds since the epoch. The argument @var{time-value}, if given,
-specifies a time to convert instead of the current time. The argument
-should have the same form as for @code{current-time-string} (see
-above). Thus, it accepts the output of @code{current-time} and
-@code{file-attributes} (@pxref{Definition of file-attributes}).
+seconds since the epoch. The optional argument @var{time-value}, if
+given, specifies a time (represented as a list of integers) to convert
+instead of the current time.
@emph{Warning}: Since the result is floating point, it may not be
exact. Do not use this function if precise time stamps are required.
@@ -1180,32 +1266,28 @@ adjustment, then the value is constant through time.
If the operating system doesn't supply all the information necessary to
compute the value, the unknown elements of the list are @code{nil}.
-The argument @var{time-value}, if given, specifies a time to analyze
-instead of the current time. The argument should have the same form
-as for @code{current-time-string} (see above). Thus, you can use
-times obtained from @code{current-time} (see above) and from
-@code{file-attributes}. @xref{Definition of file-attributes}.
+The argument @var{time-value}, if given, specifies a time (represented
+as a list of integers) to analyze instead of the current time.
@end defun
-The current time zone is determined by the @samp{TZ} environment
+The current time zone is determined by the @env{TZ} environment
variable. @xref{System Environment}. For example, you can tell Emacs
-to use universal time with @code{(setenv "TZ" "UTC0")}. If @samp{TZ}
+to use universal time with @code{(setenv "TZ" "UTC0")}. If @env{TZ}
is not in the environment, Emacs uses a platform-dependent default
time zone.
@node Time Conversion
@section Time Conversion
- These functions convert time values (lists of two or three integers)
-to calendrical information and vice versa. You can get time values
-from the functions @code{current-time} (@pxref{Time of Day}) and
-@code{file-attributes} (@pxref{Definition of file-attributes}).
+ These functions convert time values (lists of two to four integers,
+as explained in the previous section) into calendrical information and
+vice versa.
- Many 32-bit operating systems are limited to time values that contain 32 bits
-of information; these systems typically handle only the times from
-1901-12-13 20:45:52 UTC through 2038-01-19 03:14:07 UTC. However, 64-bit
-and some 32-bit operating systems have larger time values, and can
-represent times far in the past or future.
+ Many 32-bit operating systems are limited to time values containing
+32 bits of information; these systems typically handle only the times
+from 1901-12-13 20:45:52 UTC through 2038-01-19 03:14:07 UTC.
+However, 64-bit and some 32-bit operating systems have larger time
+values, and can represent times far in the past or future.
Time conversion functions always use the Gregorian calendar, even
for dates before the Gregorian calendar was introduced. Year numbers
@@ -1264,7 +1346,7 @@ yourself before you call @code{encode-time}.
The optional argument @var{zone} defaults to the current time zone and
its daylight saving time rules. If specified, it can be either a list
(as you would get from @code{current-time-zone}), a string as in the
-@code{TZ} environment variable, @code{t} for Universal Time, or an
+@env{TZ} environment variable, @code{t} for Universal Time, or an
integer (as you would get from @code{decode-time}). The specified
zone is used without any further alteration for daylight saving time.
@@ -1291,8 +1373,8 @@ on others, years as early as 1901 do work.
@node Time Parsing
@section Parsing and Formatting Times
- These functions convert time values (lists of two or three integers)
-to text in a string, and vice versa.
+ These functions convert time values to text in a string, and vice versa.
+Time values are lists of two to four integers (@pxref{Time of Day}).
@defun date-to-time string
This function parses the time-string @var{string} and returns the
@@ -1348,8 +1430,6 @@ This stands for a newline.
This stands for the nanoseconds (000000000-999999999). To ask for
fewer digits, use @samp{%3N} for milliseconds, @samp{%6N} for
microseconds, etc. Any excess digits are discarded, without rounding.
-Currently Emacs time stamps are at best microsecond resolution so the
-last three digits generated by plain @samp{%N} are always zero.
@item %p
This stands for @samp{AM} or @samp{PM}, as appropriate.
@item %r
@@ -1501,18 +1581,9 @@ When called interactively, it prints the uptime in the echo area.
@defun get-internal-run-time
This function returns the processor run time used by Emacs as a list
-of three integers: @code{(@var{high} @var{low} @var{microsec})}. The
-integers @var{high} and @var{low} combine to give the number of
-seconds, which is
-@ifnottex
-@var{high} * 2**16 + @var{low}.
-@end ifnottex
-@tex
-$high*2^{16}+low$.
-@end tex
-
-The third element, @var{microsec}, gives the microseconds (or 0 for
-systems that return time with the resolution of only one second).
+of four integers: @code{(@var{high} @var{low} @var{microsec}
+@var{picosec})}, using the same format as @code{current-time}
+(@pxref{Time of Day}).
Note that the time returned by this function excludes the time Emacs
was not using the processor, and if the Emacs process has several
@@ -1672,11 +1743,11 @@ between them). If you want a timer to run again no less than @var{n}
seconds after the last invocation, don't use the @var{repeat} argument.
Instead, the timer function should explicitly reschedule the timer.
-@defvar timer-max-repeats
+@defopt timer-max-repeats
This variable's value specifies the maximum number of times to repeat
calling a timer function in a row, when many previously scheduled
calls were unavoidably delayed.
-@end defvar
+@end defopt
@defmac with-timeout (seconds timeout-forms@dots{}) body@dots{}
Execute @var{body}, but give up after @var{seconds} seconds. If
@@ -1718,9 +1789,9 @@ certain length of time. Aside from how to set them up, idle timers
work just like ordinary timers.
@deffn Command run-with-idle-timer secs repeat function &rest args
-Set up a timer which runs when Emacs has been idle for @var{secs}
-seconds. The value of @var{secs} may be an integer or a floating point
-number; a value of the type returned by @code{current-idle-time}
+Set up a timer which runs the next time Emacs is idle for @var{secs}
+seconds. The value of @var{secs} may be an integer or a floating
+point number; a value of the type returned by @code{current-idle-time}
is also allowed.
If @var{repeat} is @code{nil}, the timer runs just once, the first time
@@ -1733,13 +1804,13 @@ can use in calling @code{cancel-timer} (@pxref{Timers}).
@end deffn
@cindex idleness
- Emacs becomes ``idle'' when it starts waiting for user input, and it
-remains idle until the user provides some input. If a timer is set for
-five seconds of idleness, it runs approximately five seconds after Emacs
-first becomes idle. Even if @var{repeat} is non-@code{nil}, this timer
-will not run again as long as Emacs remains idle, because the duration
-of idleness will continue to increase and will not go down to five
-seconds again.
+ Emacs becomes @dfn{idle} when it starts waiting for user input, and
+it remains idle until the user provides some input. If a timer is set
+for five seconds of idleness, it runs approximately five seconds after
+Emacs first becomes idle. Even if @var{repeat} is non-@code{nil},
+this timer will not run again as long as Emacs remains idle, because
+the duration of idleness will continue to increase and will not go
+down to five seconds again.
Emacs can do various things while idle: garbage collect, autosave or
handle data from a subprocess. But these interludes during idleness do
@@ -1753,72 +1824,65 @@ minutes, and even if there have been garbage collections and autosaves.
input. Then it becomes idle again, and all the idle timers that are
set up to repeat will subsequently run another time, one by one.
-@c Emacs 19 feature
+ Do not write an idle timer function containing a loop which does a
+certain amount of processing each time around, and exits when
+@code{(input-pending-p)} is non-@code{nil}. This approach seems very
+natural but has two problems:
+
+@itemize
+@item
+It blocks out all process output (since Emacs accepts process output
+only while waiting).
+
+@item
+It blocks out any idle timers that ought to run during that time.
+@end itemize
+
+@noindent
+Similarly, do not write an idle timer function that sets up another
+idle timer (including the same idle timer) with @var{secs} argument
+less than or equal to the current idleness time. Such a timer will
+run almost immediately, and continue running again and again, instead
+of waiting for the next time Emacs becomes idle. The correct approach
+is to reschedule with an appropriate increment of the current value of
+the idleness time, as described below.
+
@defun current-idle-time
If Emacs is idle, this function returns the length of time Emacs has
-been idle, as a list of three integers: @code{(@var{high} @var{low}
-@var{microsec})}. The integers @var{high} and @var{low} combine to
-give the number of seconds of idleness, which is
-@ifnottex
-@var{high} * 2**16 + @var{low}.
-@end ifnottex
-@tex
-$high*2^{16}+low$.
-@end tex
-
-The third element, @var{microsec}, gives the microseconds since the
-start of the current second (or 0 for systems that return time with
-the resolution of only one second).
+been idle, as a list of four integers: @code{(@var{sec-high}
+@var{sec-low} @var{microsec} @var{picosec})}, using the same format as
+@code{current-time} (@pxref{Time of Day}).
When Emacs is not idle, @code{current-idle-time} returns @code{nil}.
This is a convenient way to test whether Emacs is idle.
+@end defun
-The main use of this function is when an idle timer function wants to
-``take a break'' for a while. It can set up another idle timer to
-call the same function again, after a few seconds more idleness.
-Here's an example:
+ The main use of @code{current-idle-time} is when an idle timer
+function wants to ``take a break'' for a while. It can set up another
+idle timer to call the same function again, after a few seconds more
+idleness. Here's an example:
-@smallexample
-(defvar resume-timer nil
- "Timer that `timer-function' used to reschedule itself, or nil.")
+@example
+(defvar my-resume-timer nil
+ "Timer for `my-timer-function' to reschedule itself, or nil.")
-(defun timer-function ()
- ;; @r{If the user types a command while @code{resume-timer}}
+(defun my-timer-function ()
+ ;; @r{If the user types a command while @code{my-resume-timer}}
;; @r{is active, the next time this function is called from}
- ;; @r{its main idle timer, deactivate @code{resume-timer}.}
- (when resume-timer
- (cancel-timer resume-timer))
+ ;; @r{its main idle timer, deactivate @code{my-resume-timer}.}
+ (when my-resume-timer
+ (cancel-timer my-resume-timer))
...@var{do the work for a while}...
(when @var{taking-a-break}
- (setq resume-timer
+ (setq my-resume-timer
(run-with-idle-timer
;; Compute an idle time @var{break-length}
;; more than the current value.
(time-add (current-idle-time)
(seconds-to-time @var{break-length}))
nil
- 'timer-function))))
-@end smallexample
-@end defun
-
- Some idle timer functions in user Lisp packages have a loop that
-does a certain amount of processing each time around, and exits when
-@code{(input-pending-p)} is non-@code{nil}. That approach seems very
-natural but has two problems:
-
-@itemize
-@item
-It blocks out all process output (since Emacs accepts process output
-only while waiting).
-
-@item
-It blocks out any idle timers that ought to run during that time.
-@end itemize
-
-@noindent
-To avoid these problems, don't use that technique. Instead, write
-such idle timers to reschedule themselves after a brief pause, using
-the method in the @code{timer-function} example above.
+ 'my-timer-function))))
+@end example
@node Terminal Input
@section Terminal Input
@@ -1852,7 +1916,6 @@ If @var{flow} is non-@code{nil}, then Emacs uses @sc{xon/xoff}
(@kbd{C-q}, @kbd{C-s}) flow control for output to the terminal. This
has no effect except in @sc{cbreak} mode.
-@c Emacs 19 feature
The argument @var{meta} controls support for input character codes
above 127. If @var{meta} is @code{t}, Emacs converts characters with
the 8th bit set into Meta characters. If @var{meta} is @code{nil},
@@ -1861,7 +1924,6 @@ it as a parity bit. If @var{meta} is neither @code{t} nor @code{nil},
Emacs uses all 8 bits of input unchanged. This is good for terminals
that use 8-bit character sets.
-@c Emacs 19 feature
If @var{quit-char} is non-@code{nil}, it specifies the character to
use for quitting. Normally this character is @kbd{C-g}.
@xref{Quitting}.
@@ -1870,7 +1932,6 @@ use for quitting. Normally this character is @kbd{C-g}.
The @code{current-input-mode} function returns the input mode settings
Emacs is currently using.
-@c Emacs 19 feature
@defun current-input-mode
This function returns the current mode for reading keyboard input. It
returns a list, corresponding to the arguments of @code{set-input-mode},
@@ -1902,7 +1963,7 @@ is the character Emacs currently uses for quitting, usually @kbd{C-g}.
This function returns a vector containing the last 300 input events from
the keyboard or mouse. All input events are included, whether or not
they were used as parts of key sequences. Thus, you always get the last
-100 input events, not counting events generated by keyboard macros.
+300 input events, not counting events generated by keyboard macros.
(These are excluded because they are less interesting for debugging; it
should be enough to see the events that invoked the macros.)
@@ -2014,9 +2075,8 @@ See also @code{open-dribble-file} in @ref{Recording Input}.
@cindex sound
To play sound using Emacs, use the function @code{play-sound}. Only
-certain systems are supported; if you call @code{play-sound} on a system
-which cannot really do the job, it gives an error. Emacs version 20 and
-earlier did not support sound at all.
+certain systems are supported; if you call @code{play-sound} on a
+system which cannot really do the job, it gives an error.
The sound must be stored as a file in RIFF-WAVE format (@samp{.wav})
or Sun Audio format (@samp{.au}).
@@ -2056,10 +2116,10 @@ calls the functions in the list @code{play-sound-functions}.
Each function is called with one argument, @var{sound}.
@end defun
-@defun play-sound-file file &optional volume device
+@deffn Command play-sound-file file &optional volume device
This function is an alternative interface to playing a sound @var{file}
specifying an optional @var{volume} and @var{device}.
-@end defun
+@end deffn
@defvar play-sound-functions
A list of functions to be called before playing a sound. Each function
@@ -2183,7 +2243,7 @@ non-@code{nil}, Emacs tells the session manager to cancel the
shutdown.
@end defvar
-Here is an example that just inserts some text into @samp{*scratch*} when
+Here is an example that just inserts some text into @file{*scratch*} when
Emacs is restarted by the session manager.
@example
@@ -2200,6 +2260,247 @@ Emacs is restarted by the session manager.
@end group
@end example
+@node Notifications
+@section Desktop Notifications
+@cindex desktop notifications
+
+Emacs is able to send @dfn{notifications} on systems that support the
+freedesktop.org Desktop Notifications Specification. In order to use
+this functionality, Emacs must have been compiled with D-Bus support,
+and the @code{notifications} library must be loaded.
+
+@defun notifications-notify &rest params
+This function sends a notification to the desktop via D-Bus,
+consisting of the parameters specified by the @var{params} arguments.
+These arguments should consist of alternating keyword and value pairs.
+The supported keywords and values are as follows:
+
+@table @code
+@item :bus @var{bus}
+The D-Bus bus. This argument is needed only if a bus other than
+@code{:session} shall be used.
+
+@item :title @var{title}
+The notification title.
+
+@item :body @var{text}
+The notification body text. Depending on the implementation of the
+notification server, the text could contain HTML markups, like
+@samp{"<b>bold text</b>"}, hyperlinks, or images. Special HTML
+characters must be encoded, as @samp{"Contact
+&lt;postmaster@@localhost&gt;!"}.
+
+@item :app-name @var{name}
+The name of the application sending the notification. The default is
+@code{notifications-application-name}.
+
+@item :replaces-id @var{id}
+The notification @var{id} that this notification replaces. @var{id}
+must be the result of a previous @code{notifications-notify} call.
+
+@item :app-icon @var{icon-file}
+The file name of the notification icon. If set to @code{nil}, no icon
+is displayed. The default is @code{notifications-application-icon}.
+
+@item :actions (@var{key} @var{title} @var{key} @var{title} ...)
+A list of actions to be applied. @var{key} and @var{title} are both
+strings. The default action (usually invoked by clicking the
+notification) should have a key named @samp{"default"}. The title can
+be anything, though implementations are free not to display it.
+
+@item :timeout @var{timeout}
+The timeout time in milliseconds since the display of the notification
+at which the notification should automatically close. If -1, the
+notification's expiration time is dependent on the notification
+server's settings, and may vary for the type of notification. If 0,
+the notification never expires. Default value is -1.
+
+@item :urgency @var{urgency}
+The urgency level. It can be @code{low}, @code{normal}, or @code{critical}.
+
+@item :action-items
+When this keyword is given, the @var{title} string of the actions is
+interpreted as icon name.
+
+@item :category @var{category}
+The type of notification this is, a string. See the
+@uref{http://developer.gnome.org/notification-spec/#categories,
+Desktop Notifications Specification} for a list of standard
+categories.
+
+@item :desktop-entry @var{filename}
+This specifies the name of the desktop filename representing the
+calling program, like @samp{"emacs"}.
+
+@item :image-data (@var{width} @var{height} @var{rowstride} @var{has-alpha} @var{bits} @var{channels} @var{data})
+This is a raw data image format that describes the width, height,
+rowstride, whether there is an alpha channel, bits per sample,
+channels and image data, respectively.
+
+@item :image-path @var{path}
+This is represented either as a URI (@samp{file://} is the only URI
+schema supported right now) or a name in a freedesktop.org-compliant
+icon theme from @samp{$XDG_DATA_DIRS/icons}.
+
+@item :sound-file @var{filename}
+The path to a sound file to play when the notification pops up.
+
+@item :sound-name @var{name}
+A themable named sound from the freedesktop.org sound naming
+specification from @samp{$XDG_DATA_DIRS/sounds}, to play when the
+notification pops up. Similar to the icon name, only for sounds. An
+example would be @samp{"message-new-instant"}.
+
+@item :suppress-sound
+Causes the server to suppress playing any sounds, if it has that
+ability.
+
+@item :resident
+When set the server will not automatically remove the notification
+when an action has been invoked. The notification will remain resident
+in the server until it is explicitly removed by the user or by the
+sender. This hint is likely only useful when the server has the
+@code{:persistence} capability.
+
+@item :transient
+When set the server will treat the notification as transient and
+by-pass the server's persistence capability, if it should exist.
+
+@item :x @var{position}
+@itemx :y @var{position}
+Specifies the X, Y location on the screen that the
+notification should point to. Both arguments must be used together.
+
+@item :on-action @var{function}
+Function to call when an action is invoked. The notification @var{id}
+and the @var{key} of the action are passed as arguments to the
+function.
+
+@item :on-close @var{function}
+Function to call when the notification has been closed by timeout or
+by the user. The function receive the notification @var{id} and the closing
+@var{reason} as arguments:
+
+@itemize
+@item @code{expired} if the notification has expired
+@item @code{dismissed} if the notification was dismissed by the user
+@item @code{close-notification} if the notification was closed by a call to
+@code{notifications-close-notification}
+@item @code{undefined} if the notification server hasn't provided a reason
+@end itemize
+@end table
+
+Which parameters are accepted by the notification server can be
+checked via @code{notifications-get-capabilities}.
+
+This function returns a notification id, an integer, which can be used
+to manipulate the notification item with
+@code{notifications-close-notification} or the @code{:replaces-id}
+argument of another @code{notifications-notify} call. For example:
+
+@example
+@group
+(defun my-on-action-function (id key)
+ (message "Message %d, key \"%s\" pressed" id key))
+ @result{} my-on-action-function
+@end group
+
+@group
+(defun my-on-close-function (id reason)
+ (message "Message %d, closed due to \"%s\"" id reason))
+ @result{} my-on-close-function
+@end group
+
+@group
+(notifications-notify
+ :title "Title"
+ :body "This is <b>important</b>."
+ :actions '("Confirm" "I agree" "Refuse" "I disagree")
+ :on-action 'my-on-action-function
+ :on-close 'my-on-close-function)
+ @result{} 22
+@end group
+
+@group
+A message window opens on the desktop. Press "I agree"
+ @result{} Message 22, key "Confirm" pressed
+ Message 22, closed due to "dismissed"
+@end group
+@end example
+@end defun
+
+@defun notifications-close-notification id &optional bus
+This function closes a notification with identifier @var{id}.
+@var{bus} can be a string denoting a D-Bus connection, the default is
+@code{:session}.
+@end defun
+
+@defun notifications-get-capabilities &optional bus
+Returns the capabilities of the notification server, a list of
+symbols. @var{bus} can be a string denoting a D-Bus connection, the
+default is @code{:session}. The following capabilities can be
+expected:
+
+@table @code
+@item :actions
+The server will provide the specified actions to the user.
+
+@item :body
+Supports body text.
+
+@item :body-hyperlinks
+The server supports hyperlinks in the notifications.
+
+@item :body-images
+The server supports images in the notifications.
+
+@item :body-markup
+Supports markup in the body text.
+
+@item :icon-multi
+The server will render an animation of all the frames in a given image
+array.
+
+@item :icon-static
+Supports display of exactly 1 frame of any given image array. This
+value is mutually exclusive with @code{:icon-multi}.
+
+@item :persistence
+The server supports persistence of notifications.
+
+@item :sound
+The server supports sounds on notifications.
+@end table
+
+Further vendor-specific caps start with @code{:x-vendor}, like
+@code{:x-gnome-foo-cap}.
+@end defun
+
+@defun notifications-get-server-information &optional bus
+Return information on the notification server, a list of strings.
+@var{bus} can be a string denoting a D-Bus connection, the default is
+@code{:session}. The returned list is @code{(@var{name} @var{vendor}
+@var{version} @var{spec-version})}.
+
+@table @var
+@item name
+The product name of the server.
+
+@item vendor
+The vendor name. For example, @samp{"KDE"}, @samp{"GNOME"}.
+
+@item version
+The server's version number.
+
+@item spec-version
+The specification version the server is compliant with.
+@end table
+
+If @var{SPEC_VERSION} is @code{nil}, the server supports a
+specification prior to @samp{"1.0"}.
+@end defun
+
+
@node Dynamic Libraries
@section Dynamically Loaded Libraries
@cindex dynamic libraries
@@ -2218,26 +2519,27 @@ a symbol representing a supported external library, and the rest are
strings giving alternate filenames for that library.
Emacs tries to load the library from the files in the order they
-appear in the list; if none is found, the running session of Emacs
-won't have access to that library, and the features that depend on the
-library will be unavailable.
+appear in the list; if none is found, the Emacs session won't have
+access to that library, and the features it provides will be
+unavailable.
Image support on some platforms uses this facility. Here's an example
of setting this variable for supporting images on MS-Windows:
-@lisp
+@example
(setq dynamic-library-alist
'((xpm "libxpm.dll" "xpm4.dll" "libXpm-nox4.dll")
(png "libpng12d.dll" "libpng12.dll" "libpng.dll"
- "libpng13d.dll" "libpng13.dll")
- (jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll")
+ "libpng13d.dll" "libpng13.dll")
+ (jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll"
+ "jpeg.dll")
(tiff "libtiff3.dll" "libtiff.dll")
(gif "giflib4.dll" "libungif4.dll" "libungif.dll")
(svg "librsvg-2-2.dll")
(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
(glib "libglib-2.0-0.dll")
(gobject "libgobject-2.0-0.dll")))
-@end lisp
+@end example
Note that image types @code{pbm} and @code{xbm} do not need entries in
this variable because they do not depend on external libraries and are
diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi
index 5533f8ab5fa..08677f1718b 100644
--- a/doc/lispref/package.texi
+++ b/doc/lispref/package.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 2010-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2010-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/package
-@node Packaging, Antinews, System Interface, Top
+@node Packaging
@chapter Preparing Lisp code for distribution
@cindex package
@cindex Lisp package
@@ -15,6 +14,8 @@ install, uninstall, and upgrade it.
The following sections describe how to create a package, and how to
put it in a @dfn{package archive} for others to download.
+@xref{Packages,,, emacs, The GNU Emacs Manual}, for a description of
+user-level features of the packaging system.
@menu
* Packaging Basics:: The basic concepts of Emacs Lisp packages.
@@ -75,8 +76,8 @@ if any dependency cannot be found, the package cannot be installed.
@end table
@cindex content directory, package
- Installing a package, either via the Package Menu, or via the
-command @code{package-install-file}, creates a subdirectory of
+ Installing a package, either via the command @code{package-install-file},
+or via the Package Menu, creates a subdirectory of
@code{package-user-dir} named @file{@var{name}-@var{version}}, where
@var{name} is the package's name and @var{version} its version
(e.g. @file{~/.emacs.d/elpa/auctex-11.86/}). We call this the
@@ -91,17 +92,34 @@ definitions are saved to a file named @file{@var{name}-autoloads.el}
in the content directory. They are typically used to autoload the
principal user commands defined in the package, but they can also
perform other tasks, such as adding an element to
-@code{auto-mode-alist} (@pxref{Auto Major Mode}). During this time,
-Emacs will also byte-compile the Lisp files.
-
- After installation, and (by default) each time Emacs is started, the
-installed package is @dfn{activated}. During activation, Emacs adds
-the package's content directory to @code{load-path}, and evaluates the
-autoload definitions in @file{@var{name}-autoloads.el}.
-
- Note that a package typically does @emph{not} autoload every
-function and variable defined within it---only the handful of commands
-typically called to begin using the package.
+@code{auto-mode-alist} (@pxref{Auto Major Mode}). Note that a package
+typically does @emph{not} autoload every function and variable defined
+within it---only the handful of commands typically called to begin
+using the package. Emacs then byte-compiles every Lisp file in the
+package.
+
+ After installation, the installed package is @dfn{loaded}: Emacs
+adds the package's content directory to @code{load-path}, and
+evaluates the autoload definitions in @file{@var{name}-autoloads.el}.
+
+ Whenever Emacs starts up, it automatically calls the function
+@code{package-initialize} to load installed packages. This is done
+after loading the init file and abbrev file (if any) and before
+running @code{after-init-hook} (@pxref{Startup Summary}). Automatic
+package loading is disabled if the user option
+@code{package-enable-at-startup} is @code{nil}.
+
+@deffn Command package-initialize &optional no-activate
+This function initializes Emacs' internal record of which packages are
+installed, and loads them. The user option @code{package-load-list}
+specifies which packages to load; by default, all installed packages
+are loaded. @xref{Package Installation,,, emacs, The GNU Emacs
+Manual}.
+
+The optional argument @var{no-activate}, if non-@code{nil}, causes
+Emacs to update its record of installed packages without actually
+loading them; it is for internal use only.
+@end deffn
@node Simple Packages
@section Simple Packages
@@ -276,8 +294,8 @@ How to accomplish this is beyond the scope of this manual.
A convenient way to set up and update a package archive is via the
@code{package-x} library. This is included with Emacs, but not loaded
-by default; type @kbd{M-x load-library @kbd{RET} package-x @kbd{RET}}
-to load it, or add @code{(require 'package-x)} to your init file.
+by default; type @kbd{M-x load-library @key{RET} package-x @key{RET}} to
+load it, or add @code{(require 'package-x)} to your init file.
@xref{Lisp Libraries,, Lisp Libraries, emacs, The GNU Emacs Manual}.
Once loaded, you can make use of the following:
diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index 74444c7ad60..c4576e6456d 100644
--- a/doc/lispref/positions.texi
+++ b/doc/lispref/positions.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/positions
-@node Positions, Markers, Frames, Top
+@node Positions
@chapter Positions
@cindex position (in buffer)
@@ -372,18 +371,17 @@ This function returns the number of lines between the positions
1, even if @var{start} and @var{end} are on the same line. This is
because the text between them, considered in isolation, must contain at
least one line unless it is empty.
+@end defun
-Here is an example of using @code{count-lines}:
+@deffn Command count-words start end
+@cindex words in region
+This function returns the number of words between the positions
+@var{start} and @var{end} in the current buffer.
-@example
-@group
-(defun current-line ()
- "Return the vertical position of point@dots{}"
- (+ (count-lines (window-start) (point))
- (if (= (current-column) 0) 1 0)))
-@end group
-@end example
-@end defun
+This function can also be called interactively. In that case, it
+prints a message reporting the number of lines, words, and characters
+in the buffer, or in the region if the region is active.
+@end deffn
@defun line-number-at-pos &optional pos
@cindex line number
@@ -616,7 +614,6 @@ beginning of the first screen line. @xref{Minibuffer Contents}.
@end defun
@node List Motion
-@comment node-name, next, previous, up
@subsection Moving over Balanced Expressions
@cindex sexp motion
@cindex Lisp expression motion
@@ -727,7 +724,6 @@ of using its normal method.
@end defvar
@node Skipping Characters
-@comment node-name, next, previous, up
@subsection Skipping Characters
@cindex skipping characters
@@ -832,7 +828,8 @@ consequences, so the byte compiler warns if you call @code{set-buffer}
during an excursion:
@example
-Warning: Use `with-current-buffer' rather than save-excursion+set-buffer
+Warning: Use `with-current-buffer' rather than
+ save-excursion+set-buffer
@end example
@noindent
@@ -853,9 +850,6 @@ after setting the desired current buffer, as in the following example:
@cindex window excursions
Likewise, @code{save-excursion} does not restore window-buffer
correspondences altered by functions such as @code{switch-to-buffer}.
-One way to restore these correspondences, and the selected window, is to
-use @code{save-window-excursion} inside @code{save-excursion}
-(@pxref{Window Configurations}).
@strong{Warning:} Ordinary insertion of text adjacent to the saved
point value relocates the saved value, just as it relocates all
@@ -880,18 +874,18 @@ commands to a limited range of characters in a buffer. The text that
remains addressable is called the @dfn{accessible portion} of the
buffer.
- Narrowing is specified with two buffer positions which become the
-beginning and end of the accessible portion. For most editing commands
-and most Emacs primitives, these positions replace the values of the
-beginning and end of the buffer. While narrowing is in effect, no text
-outside the accessible portion is displayed, and point cannot move
-outside the accessible portion.
-
- Values such as positions or line numbers, which usually count from the
-beginning of the buffer, do so despite narrowing, but the functions
-which use them refuse to operate on text that is inaccessible.
-
- The commands for saving buffers are unaffected by narrowing; they save
+ Narrowing is specified with two buffer positions, which become the
+beginning and end of the accessible portion. For most editing
+commands and primitives, these positions replace the values of the
+beginning and end of the buffer. While narrowing is in effect, no
+text outside the accessible portion is displayed, and point cannot
+move outside the accessible portion. Note that narrowing does not
+alter actual buffer positions (@pxref{Point}); it only determines
+which positions are considered the accessible portion of the buffer.
+Most functions refuse to operate on text that is outside the
+accessible portion.
+
+ Commands for saving buffers are unaffected by narrowing; they save
the entire buffer regardless of any narrowing.
If you need to display in a single buffer several very different
@@ -930,6 +924,11 @@ It is equivalent to the following expression:
@end example
@end deffn
+@defun buffer-narrowed-p
+This function returns non-@code{nil} if the buffer is narrowed, and
+@code{nil} otherwise.
+@end defun
+
@defspec save-restriction body@dots{}
This special form saves the current bounds of the accessible portion,
evaluates the @var{body} forms, and finally restores the saved bounds,
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 51d91572d0e..217f9f9eaee 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -1,10 +1,9 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/processes
-@node Processes, Display, Abbrevs, Top
+@node Processes
@chapter Processes
@cindex child process
@cindex parent process
@@ -23,7 +22,7 @@ subprocess, the Lisp program waits for the subprocess to terminate
before continuing execution. When you create an asynchronous
subprocess, it can run in parallel with the Lisp program. This kind of
subprocess is represented within Emacs by a Lisp object which is also
-called a ``process.'' Lisp programs can use this object to communicate
+called a ``process''. Lisp programs can use this object to communicate
with the subprocess or to control it. For example, you can send
signals, obtain status information, receive output from the process, or
send input to it.
@@ -70,21 +69,23 @@ a program. One of them, @code{start-process}, creates an asynchronous
process and returns a process object (@pxref{Asynchronous Processes}).
The other two, @code{call-process} and @code{call-process-region},
create a synchronous process and do not return a process object
-(@pxref{Synchronous Processes}).
+(@pxref{Synchronous Processes}). There are various higher-level
+functions that make use of these primitives to run particular types of
+process.
Synchronous and asynchronous processes are explained in the following
sections. Since the three functions are all called in a similar
fashion, their common arguments are described here.
@cindex execute program
-@cindex @code{PATH} environment variable
-@cindex @code{HOME} environment variable
+@cindex @env{PATH} environment variable
+@cindex @env{HOME} environment variable
In all cases, the function's @var{program} argument specifies the
program to be run. An error is signaled if the file is not found or
cannot be executed. If the file name is relative, the variable
@code{exec-path} contains a list of directories to search. Emacs
initializes @code{exec-path} when it starts up, based on the value of
-the environment variable @code{PATH}. The standard file name
+the environment variable @env{PATH}. The standard file name
constructs, @samp{~}, @samp{.}, and @samp{..}, are interpreted as
usual in @code{exec-path}, but environment variable substitutions
(@samp{$HOME}, etc.) are not recognized; use
@@ -95,25 +96,28 @@ Expansion}). @code{nil} in this list refers to
Executing a program can also try adding suffixes to the specified
name:
-@defvar exec-suffixes
+@defopt exec-suffixes
This variable is a list of suffixes (strings) to try adding to the
specified program file name. The list should include @code{""} if you
want the name to be tried exactly as specified. The default value is
system-dependent.
-@end defvar
+@end defopt
@strong{Please note:} The argument @var{program} contains only the
name of the program; it may not contain any command-line arguments. You
-must use @var{args} to provide those.
+must use a separate argument, @var{args}, to provide those, as
+described below.
Each of the subprocess-creating functions has a @var{buffer-or-name}
-argument which specifies where the standard output from the program will
+argument that specifies where the standard output from the program will
go. It should be a buffer or a buffer name; if it is a buffer name,
that will create the buffer if it does not already exist. It can also
be @code{nil}, which says to discard the output unless a filter function
handles it. (@xref{Filter Functions}, and @ref{Read and Print}.)
Normally, you should avoid having multiple processes send output to the
same buffer because their output would be intermixed randomly.
+For synchronous processes, you can send the output to a file instead
+of a buffer.
@cindex program arguments
All three of the subprocess-creating functions have a @code{&rest}
@@ -122,18 +126,16 @@ supplied to @var{program} as separate command line arguments. Wildcard
characters and other shell constructs have no special meanings in these
strings, since the strings are passed directly to the specified program.
- The subprocess gets its current directory from the value of
-@code{default-directory} (@pxref{File Name Expansion}).
-
@cindex environment variables, subprocesses
The subprocess inherits its environment from Emacs, but you can
specify overrides for it with @code{process-environment}. @xref{System
-Environment}.
+Environment}. The subprocess gets its current directory from the
+value of @code{default-directory}.
@defvar exec-directory
@pindex movemail
The value of this variable is a string, the name of a directory that
-contains programs that come with GNU Emacs, programs intended for Emacs
+contains programs that come with GNU Emacs and are intended for Emacs
to invoke. The program @code{movemail} is an example of such a program;
Rmail uses it to fetch new mail from an inbox.
@end defvar
@@ -148,6 +150,11 @@ directory (which is the value of @code{default-directory}).
The value of @code{exec-path} is used by @code{call-process} and
@code{start-process} when the @var{program} argument is not an absolute
file name.
+
+Generally, you should not modify @code{exec-path} directly. Instead,
+ensure that your @env{PATH} environment variable is set appropriately
+before starting Emacs. Trying to modify @code{exec-path}
+independently of @env{PATH} can lead to confusing results.
@end defopt
@node Shell Arguments
@@ -163,7 +170,7 @@ occur in the file name, they will confuse the shell. To handle these
characters, use the function @code{shell-quote-argument}:
@defun shell-quote-argument argument
-This function returns a string which represents, in shell syntax,
+This function returns a string that represents, in shell syntax,
an argument whose actual contents are @var{argument}. It should
work reliably to concatenate the return value into a shell command
and then pass it to a shell for execution.
@@ -201,10 +208,10 @@ a shell command:
The following two functions are useful for combining a list of
individual command-line argument strings into a single string, and
taking a string apart into a list of individual command-line
-arguments. These functions are mainly intended to be used for
+arguments. These functions are mainly intended for
converting user input in the minibuffer, a Lisp string, into a list of
string arguments to be passed to @code{call-process} or
-@code{start-process}, or for the converting such lists of arguments in
+@code{start-process}, or for converting such lists of arguments into
a single Lisp string to be presented in the minibuffer or echo area.
@defun split-string-and-unquote string &optional separators
@@ -268,6 +275,9 @@ system, much like text written into a file. @xref{Coding Systems}.
@defun call-process program &optional infile destination display &rest args
This function calls @var{program} and waits for it to finish.
+The current working directory of the subprocess is
+@code{default-directory}.
+
The standard input for the new process comes from file @var{infile} if
@var{infile} is not @code{nil}, and from the null device otherwise.
The argument @var{destination} says where to put the process output.
@@ -300,7 +310,8 @@ MS-DOS doesn't support asynchronous subprocesses, so this option doesn't
work there.
@item @code{(:file @var{file-name})}
-Send the output to the file name specified.
+Send the output to the file name specified, overwriting it if it
+already exists.
@item @code{(@var{real-destination} @var{error-destination})}
Keep the standard output stream separate from the standard error stream;
@@ -344,7 +355,7 @@ In the examples below, the buffer @samp{foo} is current.
@result{} 0
---------- Buffer: foo ----------
-/usr/user/lewis/manual
+/home/lewis/manual
---------- Buffer: foo ----------
@end group
@@ -353,18 +364,18 @@ In the examples below, the buffer @samp{foo} is current.
@result{} 0
---------- Buffer: bar ----------
-lewis:5LTsHm66CSWKg:398:21:Bil Lewis:/user/lewis:/bin/csh
+lewis:x:1001:1001:Bil Lewis,,,,:/home/lewis:/bin/bash
---------- Buffer: bar ----------
@end group
@end smallexample
-Here is a good example of the use of @code{call-process}, which used to
-be found in the definition of @code{insert-directory}:
+Here is an example of the use of @code{call-process}, as used to
+be found in the definition of the @code{insert-directory} function:
@smallexample
@group
-(call-process insert-directory-program nil t nil @var{switches}
+(call-process insert-directory-program nil t nil switches
(if full-directory-p
(concat (file-name-as-directory file) ".")
file))
@@ -374,9 +385,9 @@ be found in the definition of @code{insert-directory}:
@defun process-file program &optional infile buffer display &rest args
This function processes files synchronously in a separate process. It
-is similar to @code{call-process} but may invoke a file handler based
-on the value of the variable @code{default-directory}. The current
-working directory of the subprocess is @code{default-directory}.
+is similar to @code{call-process}, but may invoke a file handler based
+on the value of the variable @code{default-directory}, which specifies
+the current working directory of the subprocess.
The arguments are handled in almost the same way as for
@code{call-process}, with the following differences:
@@ -389,15 +400,15 @@ file handlers might not support separating standard output and error
output by way of the @var{buffer} argument.
If a file handler is invoked, it determines the program to run based
-on the first argument @var{program}. For instance, consider that a
+on the first argument @var{program}. For instance, suppose that a
handler for remote files is invoked. Then the path that is used for
-searching the program might be different than @code{exec-path}.
+searching for the program might be different from @code{exec-path}.
The second argument @var{infile} may invoke a file handler. The file
handler could be different from the handler chosen for the
@code{process-file} function itself. (For example,
-@code{default-directory} could be on a remote host, whereas
-@var{infile} is on another remote host. Or @code{default-directory}
+@code{default-directory} could be on one remote host, and
+@var{infile} on a different remote host. Or @code{default-directory}
could be non-special, whereas @var{infile} is on a remote host.)
If @var{buffer} is a list of the form @code{(@var{real-destination}
@@ -414,16 +425,16 @@ file names.
@end defun
@defvar process-file-side-effects
-This variable indicates, whether a call of @code{process-file} changes
+This variable indicates whether a call of @code{process-file} changes
remote files.
-Per default, this variable is always set to @code{t}, meaning that a
+By default, this variable is always set to @code{t}, meaning that a
call of @code{process-file} could potentially change any file on a
remote host. When set to @code{nil}, a file handler could optimize
-its behavior with respect to remote file attributes caching.
+its behavior with respect to remote file attribute caching.
-This variable should never be changed by @code{setq}. Instead of, it
-shall be set only by let-binding.
+You should only ever change this variable with a let-binding; never
+with @code{setq}.
@end defvar
@defun call-process-region start end program &optional delete destination display &rest args
@@ -439,7 +450,7 @@ as it comes in. For details, see the description of
@code{call-process}, above. If @var{destination} is the integer 0,
@code{call-process-region} discards the output and returns @code{nil}
immediately, without waiting for the subprocess to finish (this only
-works if asynchronous subprocesses are supported).
+works if asynchronous subprocesses are supported; i.e. not on MS-DOS).
The remaining arguments, @var{args}, are strings that specify command
line arguments for the program.
@@ -473,20 +484,21 @@ inputinput@point{}
@end group
@end smallexample
- The @code{shell-command-on-region} command uses
-@code{call-process-region} like this:
+ For example, the @code{shell-command-on-region} command uses
+@code{call-process-region} in a manner similar to this:
@smallexample
@group
(call-process-region
start end
- shell-file-name ; @r{Name of program.}
- nil ; @r{Do not delete region.}
- buffer ; @r{Send output to @code{buffer}.}
- nil ; @r{No redisplay during output.}
- "-c" command) ; @r{Arguments for the shell.}
+ shell-file-name ; @r{name of program}
+ nil ; @r{do not delete region}
+ buffer ; @r{send output to @code{buffer}}
+ nil ; @r{no redisplay during output}
+ "-c" command) ; @r{arguments for the shell}
@end group
@end smallexample
+@c It actually uses shell-command-switch, but no need to mention that here.
@end defun
@defun call-process-shell-command command &optional infile destination display &rest args
@@ -507,6 +519,9 @@ This function executes @var{command} (a string) as a shell command,
then returns the command's output as a string.
@end defun
+@c There is also shell-command-on-region, but that is more of a user
+@c command, not something to use in programs.
+
@defun process-lines program &rest args
This function runs @var{program}, waits for it to finish, and returns
its output as a list of strings. Each string in the list holds a
@@ -526,16 +541,29 @@ is decoded in the same way as for @code{call-process}.
@section Creating an Asynchronous Process
@cindex asynchronous subprocess
- After an @dfn{asynchronous process} is created, Emacs and the subprocess
-both continue running immediately. The process thereafter runs
-in parallel with Emacs, and the two can communicate with each other
-using the functions described in the following sections. However,
+ In this section, we describe how to create an @dfn{asynchronous
+process}. After an asynchronous process is created, it runs in
+parallel with Emacs, and Emacs can communicate with it using the
+functions described in the following sections (@pxref{Input to
+Processes}, and @pxref{Output from Processes}). Note that process
communication is only partially asynchronous: Emacs sends data to the
process only when certain functions are called, and Emacs accepts data
-from the process only when Emacs is waiting for input or for a time
-delay.
-
- Here we describe how to create an asynchronous process.
+from the process only while waiting for input or for a time delay.
+
+@cindex pty
+@cindex pipe
+ An asynchronous process is controlled either via a @dfn{pty}
+(pseudo-terminal) or a @dfn{pipe}. The choice of pty or pipe is made
+when creating the process, based on the value of the variable
+@code{process-connection-type} (see below). Ptys are usually
+preferable for processes visible to the user, as in Shell mode,
+because they allow for job control (@kbd{C-c}, @kbd{C-z}, etc.)
+between the process and its children, whereas pipes do not. For
+subprocesses used for internal purposes by programs, it is often
+better to use a pipe, because they are more efficient, and because
+they are immune to stray character injections that ptys introduce for
+large (around 500 byte) messages. Also, the total number of ptys is
+limited on many systems and it is good not to waste them.
@defun start-process name buffer-or-name program &rest args
This function creates a new asynchronous subprocess and starts the
@@ -546,11 +574,17 @@ already exists, then @var{name} is modified (by appending @samp{<1>},
etc.) to be unique. The buffer @var{buffer-or-name} is the buffer to
associate with the process.
+If @var{program} is @code{nil}, Emacs opens a new pseudoterminal (pty)
+and associates its input and output with @var{buffer-or-name}, without
+creating a subprocess. In that case, the remaining arguments
+@var{args} are ignored.
+
The remaining arguments, @var{args}, are strings that specify command
-line arguments for the program.
+line arguments for the subprocess.
In the example below, the first process is started and runs (rather,
-sleeps) for 100 seconds. Meanwhile, the second process is started, and
+sleeps) for 100 seconds (the output buffer @samp{foo} is created
+immediately). Meanwhile, the second process is started, and
given the name @samp{my-process<1>} for the sake of uniqueness. It
inserts the directory listing at the end of the buffer @samp{foo},
before the first process finishes. Then it finishes, and a message to
@@ -564,13 +598,15 @@ finishes, and another message is inserted in the buffer for it.
@end group
@group
-(start-process "my-process" "foo" "ls" "-l" "/user/lewis/bin")
+(start-process "my-process" "foo" "ls" "-l" "/bin")
@result{} #<process my-process<1>>
---------- Buffer: foo ----------
-total 2
-lrwxrwxrwx 1 lewis 14 Jul 22 10:12 gnuemacs --> /emacs
--rwxrwxrwx 1 lewis 19 Jul 30 21:02 lemon
+total 8336
+-rwxr-xr-x 1 root root 971384 Mar 30 10:14 bash
+-rwxr-xr-x 1 root root 146920 Jul 5 2011 bsd-csh
+@dots{}
+-rwxr-xr-x 1 root root 696880 Feb 28 15:55 zsh4
Process my-process<1> finished
@@ -583,62 +619,56 @@ Process my-process finished
@defun start-file-process name buffer-or-name program &rest args
Like @code{start-process}, this function starts a new asynchronous
subprocess running @var{program} in it, and returns its process
-object---when @code{default-directory} is not a magic file name.
+object.
-If @code{default-directory} is magic, the function invokes its file
-handler instead. This handler ought to run @var{program}, perhaps on
-the local host, perhaps on a remote host that corresponds to
-@code{default-directory}. In the latter case, the local part of
-@code{default-directory} becomes the working directory of the process.
+The difference from @code{start-process} is that this function may
+invoked a file handler based on the value of @code{default-directory}.
+This handler ought to run @var{program}, perhaps on the local host,
+perhaps on a remote host that corresponds to @code{default-directory}.
+In the latter case, the local part of @code{default-directory} becomes
+the working directory of the process.
This function does not try to invoke file name handlers for
@var{program} or for the @var{program-args}.
Depending on the implementation of the file handler, it might not be
possible to apply @code{process-filter} or @code{process-sentinel} to
-the resulting process object (@pxref{Filter Functions}, @pxref{Sentinels}).
+the resulting process object. @xref{Filter Functions}, and @ref{Sentinels}.
+@c FIXME Can we find a better example (i.e. a more modern function
+@c that is actually documented).
Some file handlers may not support @code{start-file-process} (for
-example @code{ange-ftp-hook-function}). In such cases, the function
-does nothing and returns @code{nil}.
+example the function @code{ange-ftp-hook-function}). In such cases,
+this function does nothing and returns @code{nil}.
@end defun
@defun start-process-shell-command name buffer-or-name command
-This function is like @code{start-process} except that it uses a shell
+This function is like @code{start-process}, except that it uses a shell
to execute the specified command. The argument @var{command} is a shell
command name. The variable @code{shell-file-name} specifies which shell to
use.
The point of running a program through the shell, rather than directly
with @code{start-process}, is so that you can employ shell features such
-as wildcards in the arguments. It follows that if you include an
-arbitrary user-specified arguments in the command, you should quote it
+as wildcards in the arguments. It follows that if you include any
+arbitrary user-specified arguments in the command, you should quote them
with @code{shell-quote-argument} first, so that any special shell
characters do @emph{not} have their special shell meanings. @xref{Shell
-Arguments}.
+Arguments}. Of course, when executing commands based on user input
+you should also consider the security implications.
@end defun
@defun start-file-process-shell-command name buffer-or-name command
This function is like @code{start-process-shell-command}, but uses
-@code{start-file-process} internally. By this, @var{command} can be
-executed also on remote hosts, depending on @code{default-directory}.
+@code{start-file-process} internally. Because of this, @var{command}
+can also be executed on remote hosts, depending on @code{default-directory}.
@end defun
@defvar process-connection-type
-@cindex pipes
-@cindex @acronym{PTY}s
This variable controls the type of device used to communicate with
-asynchronous subprocesses. If it is non-@code{nil}, then @acronym{PTY}s are
+asynchronous subprocesses. If it is non-@code{nil}, then ptys are
used, when available. Otherwise, pipes are used.
-@acronym{PTY}s are usually preferable for processes visible to the user, as
-in Shell mode, because they allow job control (@kbd{C-c}, @kbd{C-z},
-etc.) to work between the process and its children, whereas pipes do
-not. For subprocesses used for internal purposes by programs, it is
-often better to use a pipe, because they are more efficient. In
-addition, the total number of @acronym{PTY}s is limited on many systems and
-it is good not to waste them.
-
The value of @code{process-connection-type} takes effect when
@code{start-process} is called. So you can specify how to communicate
with one subprocess by binding the variable around the call to
@@ -646,13 +676,13 @@ with one subprocess by binding the variable around the call to
@smallexample
@group
-(let ((process-connection-type nil)) ; @r{Use a pipe.}
+(let ((process-connection-type nil)) ; @r{use a pipe}
(start-process @dots{}))
@end group
@end smallexample
-To determine whether a given subprocess actually got a pipe or a
-@acronym{PTY}, use the function @code{process-tty-name} (@pxref{Process
+To determine whether a given subprocess actually got a pipe or a pty,
+use the function @code{process-tty-name} (@pxref{Process
Information}).
@end defvar
@@ -663,9 +693,9 @@ Information}).
@dfn{Deleting a process} disconnects Emacs immediately from the
subprocess. Processes are deleted automatically after they terminate,
but not necessarily right away. You can delete a process explicitly
-at any time. If you delete a terminated process explicitly before it
+at any time. If you explicitly delete a terminated process before it
is deleted automatically, no harm results. Deleting a running
-process sends a signal to terminate it (and its child processes if
+process sends a signal to terminate it (and its child processes, if
any), and calls the process sentinel if it has one. @xref{Sentinels}.
When a process is deleted, the process object itself continues to
@@ -706,14 +736,17 @@ happen sooner or later).
@section Process Information
Several functions return information about processes.
-@code{list-processes} is provided for interactive use.
-@deffn Command list-processes &optional query-only
+@deffn Command list-processes &optional query-only buffer
This command displays a listing of all living processes. In addition,
it finally deletes any process whose status was @samp{Exited} or
@samp{Signaled}. It returns @code{nil}.
-If @var{query-only} is non-@code{nil} then it lists only processes
+The processes are shown in a buffer named @file{*Process List*}
+(unless you specify otherwise using the optional argument @var{buffer}),
+whose major mode is Process Menu mode.
+
+If @var{query-only} is non-@code{nil}, it only lists processes
whose query flag is non-@code{nil}. @xref{Query Before Exit}.
@end deffn
@@ -729,8 +762,8 @@ This function returns a list of all processes that have not been deleted.
@end defun
@defun get-process name
-This function returns the process named @var{name}, or @code{nil} if
-there is none. An error is signaled if @var{name} is not a string.
+This function returns the process named @var{name} (a string), or
+@code{nil} if there is none.
@smallexample
@group
@@ -749,7 +782,7 @@ were given to the program.
@smallexample
@group
(process-command (get-process "shell"))
- @result{} ("/bin/csh" "-i")
+ @result{} ("bash" "-i")
@end group
@end smallexample
@end defun
@@ -757,11 +790,10 @@ were given to the program.
@defun process-contact process &optional key
This function returns information about how a network or serial
-process was set up. For a network process, when @var{key} is
-@code{nil}, it returns @code{(@var{hostname} @var{service})} which
-specifies what you connected to. For a serial process, when @var{key}
-is @code{nil}, it returns @code{(@var{port} @var{speed})}. For an
-ordinary child process, this function always returns @code{t}.
+process was set up. When @var{key} is @code{nil}, it returns
+@code{(@var{hostname} @var{service})} for a network process, and
+@code{(@var{port} @var{speed})} for a serial process.
+For an ordinary child process, this function always returns @code{t}.
If @var{key} is @code{t}, the value is the complete status information
for the connection, server, or serial port; that is, the list of
@@ -769,7 +801,8 @@ keywords and values specified in @code{make-network-process} or
@code{make-serial-process}, except that some of the values represent
the current status instead of what you specified.
-For a network process:
+For a network process, the values include (see
+@code{make-network-process} for a complete list):
@table @code
@item :buffer
@@ -806,7 +839,7 @@ process is started and remains constant as long as the process exists.
@end defun
@defun process-name process
-This function returns the name of @var{process}.
+This function returns the name of @var{process}, as a string.
@end defun
@defun process-status process-name
@@ -846,12 +879,6 @@ if @var{process-name} is not the name of an existing process.
(process-status (get-buffer "*shell*"))
@result{} run
@end group
-@group
-x
- @result{} #<process xx<1>>
-(process-status x)
- @result{} exit
-@end group
@end smallexample
For a network connection, @code{process-status} returns one of the symbols
@@ -860,7 +887,7 @@ closed the connection, or Emacs did @code{delete-process}.
@end defun
@defun process-live-p process
-This function returns nin-@code{nil} if @var{process} is alive. A
+This function returns non-@code{nil} if @var{process} is alive. A
process is considered alive if its status is @code{run}, @code{open},
@code{listen}, @code{connect} or @code{stop}.
@end defun
@@ -889,13 +916,9 @@ the remote host is provided as process property @code{remote-tty}.
@defun process-coding-system process
@anchor{Coding systems for a subprocess}
-This function returns a cons cell describing the coding systems in use
-for decoding output from @var{process} and for encoding input to
-@var{process} (@pxref{Coding Systems}). The value has this form:
-
-@example
-(@var{coding-system-for-decoding} . @var{coding-system-for-encoding})
-@end example
+This function returns a cons cell @code{(@var{decode} . @var{encode})},
+describing the coding systems in use for decoding output from, and
+encoding input to, @var{process} (@pxref{Coding Systems}).
@end defun
@defun set-process-coding-system process &optional decoding-system encoding-system
@@ -935,10 +958,11 @@ Emacs, which is done with the functions in this section. You must
specify the process to send input to, and the input data to send. The
data appears on the ``standard input'' of the subprocess.
+@c FIXME which?
Some operating systems have limited space for buffered input in a
-@acronym{PTY}. On these systems, Emacs sends an @acronym{EOF}
-periodically amidst the other characters, to force them through. For
-most programs, these @acronym{EOF}s do no harm.
+pty. On these systems, Emacs sends an @acronym{EOF} periodically
+amidst the other characters, to force them through. For most
+programs, these @acronym{EOF}s do no harm.
Subprocess input is normally encoded using a coding system before the
subprocess receives it, much like text written into a file. You can use
@@ -961,26 +985,14 @@ the current buffer's process.
@defun process-send-string process string
This function sends @var{process} the contents of @var{string} as
-standard input. If it is @code{nil}, the current buffer's process is used.
-
- The function returns @code{nil}.
+standard input. It returns @code{nil}. For example, to make a
+Shell buffer list files:
@smallexample
@group
(process-send-string "shell<1>" "ls\n")
@result{} nil
@end group
-
-
-@group
----------- Buffer: *shell* ----------
-...
-introduction.texi syntax-tables.texi~
-introduction.texi~ text.texi
-introduction.txt text.texi~
-...
----------- Buffer: *shell* ----------
-@end group
@end smallexample
@end defun
@@ -996,7 +1008,6 @@ is unimportant which number is larger.)
@defun process-send-eof &optional process
This function makes @var{process} see an end-of-file in its
input. The @acronym{EOF} comes after any text already sent to it.
-
The function returns @var{process}.
@smallexample
@@ -1027,7 +1038,7 @@ system. For example, the signal @code{SIGINT} means that the user has
typed @kbd{C-c}, or that some analogous thing has happened.
Each signal has a standard effect on the subprocess. Most signals
-kill the subprocess, but some stop or resume execution instead. Most
+kill the subprocess, but some stop (or resume) execution instead. Most
signals can optionally be handled by programs; if the program handles
the signal, then we can say nothing in general about its effects.
@@ -1036,7 +1047,7 @@ section. Emacs also sends signals automatically at certain times:
killing a buffer sends a @code{SIGHUP} signal to all its associated
processes; killing Emacs sends a @code{SIGHUP} signal to all remaining
processes. (@code{SIGHUP} is a signal that usually indicates that the
-user hung up the phone.)
+user ``hung up the phone'', i.e., disconnected.)
Each of the signal-sending functions takes two optional arguments:
@var{process} and @var{current-group}.
@@ -1065,7 +1076,7 @@ job-control shells won't work when a pipe is used. See
@defun interrupt-process &optional process current-group
This function interrupts the process @var{process} by sending the
signal @code{SIGINT}. Outside of Emacs, typing the ``interrupt
-character'' (normally @kbd{C-c} on some systems, and @code{DEL} on
+character'' (normally @kbd{C-c} on some systems, and @key{DEL} on
others) sends this signal. When the argument @var{current-group} is
non-@code{nil}, you can think of this function as ``typing @kbd{C-c}''
on the terminal by which Emacs talks to the subprocess.
@@ -1080,6 +1091,8 @@ and cannot be handled by the subprocess.
@defun quit-process &optional process current-group
This function sends the signal @code{SIGQUIT} to the process
@var{process}. This signal is the one sent by the ``quit
+@c FIXME? Never heard of C-b being used for this. In readline, eg
+@c bash, that is backward-word.
character'' (usually @kbd{C-b} or @kbd{C-\}) when you are not inside
Emacs.
@end defun
@@ -1102,14 +1115,15 @@ it the signal @code{SIGCONT}. This presumes that @var{process} was
stopped previously.
@end defun
-@defun signal-process process signal
+@deffn Command signal-process process signal
This function sends a signal to process @var{process}. The argument
-@var{signal} specifies which signal to send; it should be an integer.
+@var{signal} specifies which signal to send; it should be an integer,
+or a symbol whose name is a signal.
-The @var{process} argument can be a system process @acronym{ID}; that
-allows you to send signals to processes that are not children of
-Emacs. @xref{System Processes}.
-@end defun
+The @var{process} argument can be a system process @acronym{ID} (an
+integer); that allows you to send signals to processes that are not
+children of Emacs. @xref{System Processes}.
+@end deffn
@node Output from Processes
@section Receiving Output from Processes
@@ -1118,10 +1132,10 @@ Emacs. @xref{System Processes}.
There are two ways to receive the output that a subprocess writes to
its standard output stream. The output can be inserted in a buffer,
-which is called the associated buffer of the process, or a function
-called the @dfn{filter function} can be called to act on the output. If
-the process has no buffer and no filter function, its output is
-discarded.
+which is called the associated buffer of the process (@pxref{Process
+Buffers}), or a function called the @dfn{filter function} can be
+called to act on the output. If the process has no buffer and no
+filter function, its output is discarded.
When a subprocess terminates, Emacs reads any pending output,
then stops reading output from that subprocess. Therefore, if the
@@ -1129,19 +1143,20 @@ subprocess has children that are still live and still producing
output, Emacs won't receive that output.
Output from a subprocess can arrive only while Emacs is waiting: when
-reading terminal input, in @code{sit-for} and @code{sleep-for}
-(@pxref{Waiting}), and in @code{accept-process-output} (@pxref{Accepting
-Output}). This minimizes the problem of timing errors that usually
-plague parallel programming. For example, you can safely create a
-process and only then specify its buffer or filter function; no output
-can arrive before you finish, if the code in between does not call any
-primitive that waits.
+reading terminal input (see the function @code{waiting-for-user-input-p}),
+in @code{sit-for} and @code{sleep-for} (@pxref{Waiting}), and in
+@code{accept-process-output} (@pxref{Accepting Output}). This
+minimizes the problem of timing errors that usually plague parallel
+programming. For example, you can safely create a process and only
+then specify its buffer or filter function; no output can arrive
+before you finish, if the code in between does not call any primitive
+that waits.
@defvar process-adaptive-read-buffering
On some systems, when Emacs reads the output from a subprocess, the
output data is read in very small blocks, potentially resulting in
very poor performance. This behavior can be remedied to some extent
-by setting the variable @var{process-adaptive-read-buffering} to a
+by setting the variable @code{process-adaptive-read-buffering} to a
non-@code{nil} value (the default), as it will automatically delay reading
from such processes, thus allowing them to produce more output before
Emacs tries to read it.
@@ -1210,9 +1225,9 @@ to insert, and updates it to point after the inserted text. That is why
successive batches of output are inserted consecutively.
Filter functions normally should use this marker in the same fashion
-as is done by direct insertion of output in the buffer. A good
-example of a filter function that uses @code{process-mark} is found at
-the end of the following section.
+as is done by direct insertion of output in the buffer. For an
+example of a filter function that uses @code{process-mark},
+@pxref{Process Filter Example}.
When the user is expected to enter input in the process buffer for
transmission to the process, the process marker separates the new input
@@ -1260,14 +1275,16 @@ there is no filter.
The filter function can only be called when Emacs is waiting for
something, because process output arrives only at such times. Emacs
-waits when reading terminal input, in @code{sit-for} and
-@code{sleep-for} (@pxref{Waiting}), and in @code{accept-process-output}
-(@pxref{Accepting Output}).
+waits when reading terminal input (see the function
+@code{waiting-for-user-input-p}), in @code{sit-for} and
+@code{sleep-for} (@pxref{Waiting}), and in
+@code{accept-process-output} (@pxref{Accepting Output}).
A filter function must accept two arguments: the associated process
and a string, which is output just received from it. The function is
then free to do whatever it chooses with the output.
+@c Note this text is duplicated in the sentinels section.
Quitting is normally inhibited within a filter function---otherwise,
the effect of typing @kbd{C-g} at command level or to quit a user
command would be unpredictable. If you want to permit quitting inside
@@ -1278,19 +1295,20 @@ cases, the right way to do this is with the macro
If an error happens during execution of a filter function, it is
caught automatically, so that it doesn't stop the execution of whatever
program was running when the filter function was started. However, if
-@code{debug-on-error} is non-@code{nil}, the error-catching is turned
-off. This makes it possible to use the Lisp debugger to debug the
+@code{debug-on-error} is non-@code{nil}, errors are not caught.
+This makes it possible to use the Lisp debugger to debug the
filter function. @xref{Debugger}.
- Many filter functions sometimes or always insert the text in the
+ Many filter functions sometimes (or always) insert the output in the
process's buffer, mimicking the actions of Emacs when there is no
-filter. Such filter functions need to use @code{set-buffer} in order to
-be sure to insert in that buffer. To avoid setting the current buffer
-semipermanently, these filter functions must save and restore the
-current buffer. They should also check whether the buffer is still
-alive, update the process marker, and in some cases update the value
-of point. Here is how to do these things:
-
+filter. Such filter functions need to make sure that they save the
+current buffer, select the correct buffer (if different) before
+inserting output, and then restore the original buffer.
+They should also check whether the buffer is still alive, update the
+process marker, and in some cases update the value of point. Here is
+how to do these things:
+
+@anchor{Process Filter Example}
@smallexample
@group
(defun ordinary-insertion-filter (proc string)
@@ -1300,7 +1318,7 @@ of point. Here is how to do these things:
@end group
@group
(save-excursion
- ;; @r{Insert the text, advancing the process marker.}
+ ;; @r{Insert the text, advancing the process marker.}
(goto-char (process-mark proc))
(insert string)
(set-marker (process-mark proc) (point)))
@@ -1308,14 +1326,8 @@ of point. Here is how to do these things:
@end group
@end smallexample
-@noindent
-The reason to use @code{with-current-buffer}, rather than using
-@code{save-excursion} to save and restore the current buffer, is so as
-to preserve the change in point made by the second call to
-@code{goto-char}.
-
To make the filter force the process buffer to be visible whenever new
-text arrives, insert the following line just before the
+text arrives, you could insert a line like the following just before the
@code{with-current-buffer} construct:
@smallexample
@@ -1326,12 +1338,16 @@ text arrives, insert the following line just before the
previously, eliminate the variable @code{moving} and call
@code{goto-char} unconditionally.
+@ignore
In earlier Emacs versions, every filter function that did regular
expression searching or matching had to explicitly save and restore the
match data. Now Emacs does this automatically for filter functions;
-they never need to do it explicitly. @xref{Match Data}.
+they never need to do it explicitly.
+@end ignore
+ Note that Emacs automatically saves and restores the match data
+while executing filter functions. @xref{Match Data}.
- The output to the function may come in chunks of any size. A program
+ The output to the filter may come in chunks of any size. A program
that produces the same output twice in a row may send it as one batch of
200 characters one time, and five batches of 40 characters the next. If
the filter looks for certain text strings in the subprocess output, make
@@ -1349,7 +1365,7 @@ This function returns the filter function of @var{process}, or @code{nil}
if it has none.
@end defun
- Here is an example of use of a filter function:
+ Here is an example of the use of a filter function:
@smallexample
@group
@@ -1369,7 +1385,7 @@ if it has none.
(process-send-string "shell" "ls ~/other\n")
@result{} nil
kept
- @result{} ("lewis@@slug[8] % "
+ @result{} ("lewis@@slug:$ "
@end group
@group
"FINAL-W87-SHORT.MSS backup.otl kolstad.mss~
@@ -1425,8 +1441,8 @@ bytes, Emacs by default uses @code{no-conversion} for it; see
@ref{Lisp and Coding Systems, inhibit-null-byte-detection}, for how to
control this behavior.
- @strong{Warning:} Coding systems such as @code{undecided} which
-determine the coding system from the data do not work entirely
+ @strong{Warning:} Coding systems such as @code{undecided}, which
+determine the coding system from the data, do not work entirely
reliably with asynchronous subprocess output. This is because Emacs
has to process asynchronous subprocess output in batches, as it
arrives. Emacs must try to detect the proper coding system from one
@@ -1444,7 +1460,7 @@ output as a multibyte string or as a unibyte string according to the
process's filter coding system. Emacs
decodes the output according to the process output coding system,
which usually produces a multibyte string, except for coding systems
-such as @code{binary} and @code{raw-text}
+such as @code{binary} and @code{raw-text}.
@node Accepting Output
@subsection Accepting Output from Processes
@@ -1462,7 +1478,6 @@ output is inserted in the associated buffers or given to their filter
functions. If @var{process} is non-@code{nil} then this function does
not return until some output has been received from @var{process}.
-@c Emacs 19 feature
The arguments @var{seconds} and @var{millisec} let you specify timeout
periods. The former specifies a period measured in seconds and the
latter specifies one measured in milliseconds. The two time periods
@@ -1470,10 +1485,10 @@ thus specified are added together, and @code{accept-process-output}
returns after that much time, whether or not there has been any
subprocess output.
-The argument @var{millisec} is semi-obsolete nowadays because
-@var{seconds} can be a floating point number to specify waiting a
-fractional number of seconds. If @var{seconds} is 0, the function
-accepts whatever output is pending but does not wait.
+The argument @var{millisec} is obsolete (and should not be used),
+because @var{seconds} can be a floating point number to specify
+waiting a fractional number of seconds. If @var{seconds} is 0, the
+function accepts whatever output is pending but does not wait.
@c Emacs 22.1 feature
If @var{process} is a process, and the argument @var{just-this-one} is
@@ -1504,6 +1519,7 @@ describing the type of event.
The string describing the event looks like one of the following:
+@c FIXME? Also "killed\n" - see example below?
@itemize @bullet
@item
@code{"finished\n"}.
@@ -1520,7 +1536,7 @@ describing the type of event.
A sentinel runs only while Emacs is waiting (e.g., for terminal
input, or for time to elapse, or for process output). This avoids the
-timing errors that could result from running them at random places in
+timing errors that could result from running sentinels at random places in
the middle of other Lisp programs. A program can wait, so that
sentinels will run, by calling @code{sit-for} or @code{sleep-for}
(@pxref{Waiting}), or @code{accept-process-output} (@pxref{Accepting
@@ -1544,6 +1560,7 @@ should check whether the buffer is still alive. If it tries to insert
into a dead buffer, it will get an error. If the buffer is dead,
@code{(buffer-name (process-buffer @var{process}))} returns @code{nil}.
+@c Note this text is duplicated in the filter functions section.
Quitting is normally inhibited within a sentinel---otherwise, the
effect of typing @kbd{C-g} at command level or to quit a user command
would be unpredictable. If you want to permit quitting inside a
@@ -1554,8 +1571,8 @@ right way to do this is with the macro @code{with-local-quit}.
If an error happens during execution of a sentinel, it is caught
automatically, so that it doesn't stop the execution of whatever
programs was running when the sentinel was started. However, if
-@code{debug-on-error} is non-@code{nil}, the error-catching is turned
-off. This makes it possible to use the Lisp debugger to debug the
+@code{debug-on-error} is non-@code{nil}, errors are not caught.
+This makes it possible to use the Lisp debugger to debug the
sentinel. @xref{Debugger}.
While a sentinel is running, the process sentinel is temporarily
@@ -1563,10 +1580,14 @@ set to @code{nil} so that the sentinel won't run recursively.
For this reason it is not possible for a sentinel to specify
a new sentinel.
+@ignore
In earlier Emacs versions, every sentinel that did regular expression
searching or matching had to explicitly save and restore the match data.
Now Emacs does this automatically for sentinels; they never need to do
-it explicitly. @xref{Match Data}.
+it explicitly.
+@end ignore
+ Note that Emacs automatically saves and restores the match data
+while executing sentinels. @xref{Match Data}.
@defun set-process-sentinel process sentinel
This function associates @var{sentinel} with @var{process}. If
@@ -1574,7 +1595,7 @@ This function associates @var{sentinel} with @var{process}. If
The default behavior when there is no sentinel is to insert a message in
the process's buffer when the process status changes.
-Changes in process sentinel take effect immediately---if the sentinel
+Changes in process sentinels take effect immediately---if the sentinel
is slated to be run but has not been called yet, and you specify a new
sentinel, the eventual call to the sentinel will use the new one.
@@ -1602,7 +1623,7 @@ has none.
@defun waiting-for-user-input-p
While a sentinel or filter function is running, this function returns
non-@code{nil} if Emacs was waiting for keyboard input from the user at
-the time the sentinel or filter function was called, @code{nil} if it
+the time the sentinel or filter function was called, or @code{nil} if it
was not.
@end defun
@@ -1612,7 +1633,7 @@ was not.
When Emacs exits, it terminates all its subprocesses by sending them
the @code{SIGHUP} signal. Because subprocesses may be doing
valuable work, Emacs normally asks the user to confirm that it is ok
-to terminate them. Each process has a query flag which, if
+to terminate them. Each process has a query flag, which, if
non-@code{nil}, says that Emacs should ask for confirmation before
exiting and thus killing that process. The default for the query flag
is @code{t}, meaning @emph{do} query.
@@ -1625,31 +1646,13 @@ This returns the query flag of @var{process}.
This function sets the query flag of @var{process} to @var{flag}. It
returns @var{flag}.
-@smallexample
-@group
-;; @r{Don't query about the shell process}
-(set-process-query-on-exit-flag (get-process "shell") nil)
- @result{} t
-@end group
-@end smallexample
-@end defun
-
-@defun process-kill-without-query process &optional do-query
-This function clears the query flag of @var{process}, so that
-Emacs will not query the user on account of that process.
-
-Actually, the function does more than that: it returns the old value of
-the process's query flag, and sets the query flag to @var{do-query}.
-Please don't use this function to do those things any more---please
-use the newer, cleaner functions @code{process-query-on-exit-flag} and
-@code{set-process-query-on-exit-flag} in all but the simplest cases.
-The only way you should use @code{process-kill-without-query} nowadays
-is like this:
+Here is an example of using @code{set-process-query-on-exit-flag} on a
+shell process to avoid querying:
@smallexample
@group
-;; @r{Don't query about the shell process}
-(process-kill-without-query (get-process "shell"))
+(set-process-query-on-exit-flag (get-process "shell") nil)
+ @result{} nil
@end group
@end smallexample
@end defun
@@ -1661,7 +1664,7 @@ is like this:
In addition to accessing and manipulating processes that are
subprocesses of the current Emacs session, Emacs Lisp programs can
also access other processes running on the same machine. We call
-these @dfn{system processes}, to distinguish between them and Emacs
+these @dfn{system processes}, to distinguish them from Emacs
subprocesses.
Emacs provides several primitives for accessing system processes.
@@ -1681,7 +1684,7 @@ This function returns an alist of attributes for the process specified
by its process ID @var{pid}. Each association in the alist is of the
form @code{(@var{key} . @var{value})}, where @var{key} designates the
attribute and @var{value} is the value of that attribute. The various
-attribute @var{key}'s that this function can return are listed below.
+attribute @var{key}s that this function can return are listed below.
Not all platforms support all of these attributes; if an attribute is
not supported, its association will not appear in the returned alist.
Values that are numbers can be either integer or floating-point,
@@ -1770,7 +1773,7 @@ faults for all the child processes of the given process.
@item utime
Time spent by the process in the user context, for running the
application's code. The corresponding @var{value} is in the
-@w{@code{(@var{high} @var{low} @var{microsec})}} format, the same
+@w{@code{(@var{high} @var{low} @var{microsec} @var{picosec})}} format, the same
format used by functions @code{current-time} (@pxref{Time of Day,
current-time}) and @code{file-attributes} (@pxref{File Attributes}).
@@ -1801,12 +1804,12 @@ The number of threads in the process.
@item start
The time when the process was started, in the same
-@w{@code{(@var{high} @var{low} @var{microsec})}} format used by
-@code{current-time} and @code{file-attributes}.
+@w{@code{(@var{high} @var{low} @var{microsec} @var{picosec})}} format used by
+@code{current-time} and by @code{file-attributes}.
@item etime
The time elapsed since the process started, in the @w{@code{(@var{high}
-@var{low} @var{microsec})}} format.
+@var{low} @var{microsec} @var{picosec})}} format.
@item vsize
The virtual memory size of the process, measured in kilobytes.
@@ -1842,6 +1845,8 @@ as @code{shell-command}.
@section Transaction Queues
@cindex transaction queue
+@c That's not very informative. What is a transaction, and when might
+@c I want to use one?
You can use a @dfn{transaction queue} to communicate with a subprocess
using transactions. First use @code{tq-create} to create a transaction
queue communicating with a specified process. Then you can call
@@ -1871,8 +1876,11 @@ text at the end of the entire answer, but nothing before; that's how
If the argument @var{delay-question} is non-@code{nil}, delay sending
this question until the process has finished replying to any previous
questions. This produces more reliable results with some processes.
+@ignore
+@c Let's not mention it then.
The return value of @code{tq-enqueue} itself is not meaningful.
+@end ignore
@end defun
@defun tq-close queue
@@ -1890,10 +1898,11 @@ Transaction queues are implemented by means of a filter function.
@cindex UDP
Emacs Lisp programs can open stream (TCP) and datagram (UDP) network
-connections to other processes on the same machine or other machines.
+connections (@pxref{Datagrams}) to other processes on the same machine
+or other machines.
A network connection is handled by Lisp much like a subprocess, and is
represented by a process object. However, the process you are
-communicating with is not a child of the Emacs process, so it has no
+communicating with is not a child of the Emacs process, has no
process @acronym{ID}, and you can't kill it or send it signals. All you
can do is send and receive data. @code{delete-process} closes the
connection, but does not kill the program at the other end; that
@@ -1921,7 +1930,7 @@ network connection or server, @code{serial} for a serial port
connection, or @code{real} for a real subprocess.
The @code{process-status} function returns @code{open},
-@code{closed}, @code{connect}, and @code{failed} for network
+@code{closed}, @code{connect}, or @code{failed} for network
connections. For a network server, the status is always
@code{listen}. None of those values is possible for a real
subprocess. @xref{Process Information}.
@@ -1931,47 +1940,144 @@ subprocess. @xref{Process Information}.
process, being stopped means not accepting new connections. (Up to 5
connection requests will be queued for when you resume the server; you
can increase this limit, unless it is imposed by the operating
-system.) For a network stream connection, being stopped means not
-processing input (any arriving input waits until you resume the
-connection). For a datagram connection, some number of packets may be
-queued but input may be lost. You can use the function
+system---see the @code{:server} keyword of @code{make-network-process},
+@ref{Network Processes}.) For a network stream connection, being
+stopped means not processing input (any arriving input waits until you
+resume the connection). For a datagram connection, some number of
+packets may be queued but input may be lost. You can use the function
@code{process-command} to determine whether a network connection or
server is stopped; a non-@code{nil} value means yes.
-@defun open-network-stream name buffer-or-name host service
-This function opens a TCP connection, and returns a process object
-that represents the connection.
+@cindex network connection, encrypted
+@cindex encrypted network connections
+@cindex @acronym{TLS} network connections
+@cindex @acronym{STARTTLS} network connections
+Emacs can create encrypted network connections, using either built-in
+or external support. The built-in support uses the GnuTLS
+(``Transport Layer Security'') library; see
+@uref{http://www.gnu.org/software/gnutls/, the GnuTLS project page}.
+If your Emacs was compiled with GnuTLS support, the function
+@code{gnutls-available-p} is defined and returns non-@code{nil}. For
+more details, @pxref{Top,, Overview, emacs-gnutls, The Emacs-GnuTLS manual}.
+The external support uses the @file{starttls.el} library, which
+requires a helper utility such as @command{gnutls-cli} to be installed
+on the system. The @code{open-network-stream} function can
+transparently handle the details of creating encrypted connections for
+you, using whatever support is available.
+
+@defun open-network-stream name buffer host service &rest parameters
+This function opens a TCP connection, with optional encryption, and
+returns a process object that represents the connection.
The @var{name} argument specifies the name for the process object. It
is modified as necessary to make it unique.
-The @var{buffer-or-name} argument is the buffer to associate with the
+The @var{buffer} argument is the buffer to associate with the
connection. Output from the connection is inserted in the buffer,
unless you specify a filter function to handle the output. If
-@var{buffer-or-name} is @code{nil}, it means that the connection is not
+@var{buffer} is @code{nil}, it means that the connection is not
associated with any buffer.
The arguments @var{host} and @var{service} specify where to connect to;
@var{host} is the host name (a string), and @var{service} is the name of
a defined network service (a string) or a port number (an integer).
+
+The remaining arguments @var{parameters} are keyword/argument pairs
+that are mainly relevant to encrypted connections:
+
+@table @code
+
+@item :nowait @var{boolean}
+If non-@code{nil}, try to make an asynchronous connection.
+
+@item :type @var{type}
+The type of connection. Options are:
+
+@table @code
+@item plain
+An ordinary, unencrypted connection.
+@item tls
+@itemx ssl
+A @acronym{TLS} (``Transport Layer Security'') connection.
+@item nil
+@itemx network
+Start with a plain connection, and if parameters @samp{:success}
+and @samp{:capability-command} are supplied, try to upgrade to an encrypted
+connection via @acronym{STARTTLS}. If that fails, retain the
+unencrypted connection.
+@item starttls
+As for @code{nil}, but if @acronym{STARTTLS} fails drop the connection.
+@item shell
+A shell connection.
+@end table
+
+@item :always-query-capabilities @var{boolean}
+If non-@code{nil}, always ask for the server's capabilities, even when
+doing a @samp{plain} connection.
+
+@item :capability-command @var{capability-command}
+Command string to query the host capabilities.
+
+@item :end-of-command @var{regexp}
+@itemx :end-of-capability @var{regexp}
+Regular expression matching the end of a command, or the end of the
+command @var{capability-command}. The latter defaults to the former.
+
+@item :starttls-function @var{function}
+Function of one argument (the response to @var{capability-command}),
+which returns either @code{nil}, or the command to activate @acronym{STARTTLS}
+if supported.
+
+@item :success @var{regexp}
+Regular expression matching a successful @acronym{STARTTLS} negotiation.
+
+@item :use-starttls-if-possible @var{boolean}
+If non-@code{nil}, do opportunistic @acronym{STARTTLS} upgrades even if Emacs
+doesn't have built-in @acronym{TLS} support.
+
+@item :client-certificate @var{list-or-t}
+Either a list of the form @code{(@var{key-file} @var{cert-file})},
+naming the certificate key file and certificate file itself, or
+@code{t}, meaning to query @code{auth-source} for this information
+(@pxref{Top,,Overview, auth, The Auth-Source Manual}).
+Only used for @acronym{TLS} or @acronym{STARTTLS}.
+
+@item :return-list @var{cons-or-nil}
+The return value of this function. If omitted or @code{nil}, return a
+process object. Otherwise, a cons of the form @code{(@var{process-object}
+. @var{plist})}, where @var{plist} has keywords:
+
+@table @code
+@item :greeting @var{string-or-nil}
+If non-@code{nil}, the greeting string returned by the host.
+@item :capabilities @var{string-or-nil}
+If non-@code{nil}, the host's capability string.
+@item :type @var{symbol}
+The connection type: @samp{plain} or @samp{tls}.
+@end table
+
+@end table
+
@end defun
@node Network Servers
@section Network Servers
@cindex network servers
- You create a server by calling @code{make-network-process} with
-@code{:server t}. The server will listen for connection requests from
-clients. When it accepts a client connection request, that creates a
-new network connection, itself a process object, with the following
-parameters:
+ You create a server by calling @code{make-network-process}
+(@pxref{Network Processes}) with @code{:server t}. The server will
+listen for connection requests from clients. When it accepts a client
+connection request, that creates a new network connection, itself a
+process object, with the following parameters:
@itemize @bullet
@item
The connection's process name is constructed by concatenating the
-server process' @var{name} with a client identification string. The
+server process's @var{name} with a client identification string. The
+@c FIXME? What about IPv6? Say briefly what the difference is?
client identification string for an IPv4 connection looks like
-@samp{<@var{a}.@var{b}.@var{c}.@var{d}:@var{p}>}. Otherwise, it is a
+@samp{<@var{a}.@var{b}.@var{c}.@var{d}:@var{p}>}, which represents an
+address and port number. Otherwise, it is a
unique number in brackets, as in @samp{<@var{nnn}>}. The number
is unique for each connection in the Emacs session.
@@ -1992,7 +2098,7 @@ uses its filter and sentinel; their sole purpose is to initialize
connections made to the server.
@item
-The connection's process contact info is set according to the client's
+The connection's process contact information is set according to the client's
addressing information (typically an IP address and a port number).
This information is associated with the @code{process-contact}
keywords @code{:host}, @code{:service}, @code{:remote}.
@@ -2002,14 +2108,14 @@ The connection's local address is set up according to the port
number used for the connection.
@item
-The client process' plist is initialized from the server's plist.
+The client process's plist is initialized from the server's plist.
@end itemize
@node Datagrams
@section Datagrams
@cindex datagrams
- A datagram connection communicates with individual packets rather
+ A @dfn{datagram} connection communicates with individual packets rather
than streams of data. Each call to @code{process-send} sends one
datagram packet (@pxref{Input to Processes}), and each datagram
received results in one call to the filter function.
@@ -2062,7 +2168,8 @@ process object that represents it. The arguments @var{args} are a
list of keyword/argument pairs. Omitting a keyword is always
equivalent to specifying it with value @code{nil}, except for
@code{:coding}, @code{:filter-multibyte}, and @code{:reuseaddr}. Here
-are the meaningful keywords:
+are the meaningful keywords (those corresponding to network options
+are listed in the following section):
@table @asis
@item :name @var{name}
@@ -2078,7 +2185,7 @@ connection. Both connections and servers can be of these types.
@item :server @var{server-flag}
If @var{server-flag} is non-@code{nil}, create a server. Otherwise,
create a connection. For a stream type server, @var{server-flag} may
-be an integer which then specifies the length of the queue of pending
+be an integer, which then specifies the length of the queue of pending
connections to the server. The default queue length is 5.
@item :host @var{host}
@@ -2089,7 +2196,7 @@ specify a valid address for the local host, and only clients
connecting to that address will be accepted.
@item :service @var{service}
-@var{service} specifies a port number to connect to, or, for a server,
+@var{service} specifies a port number to connect to; or, for a server,
the port number to listen on. It should be a service name that
translates to a port number, or an integer specifying the port number
directly. For a server, it can also be @code{t}, which means to let
@@ -2100,18 +2207,18 @@ the system select an unused port number.
communication. @code{nil} means determine the proper address family
automatically for the given @var{host} and @var{service}.
@code{local} specifies a Unix socket, in which case @var{host} is
-ignored. @code{ipv4} and @code{ipv6} specify to use IPv4 and IPv6
+ignored. @code{ipv4} and @code{ipv6} specify to use IPv4 and IPv6,
respectively.
@item :local @var{local-address}
For a server process, @var{local-address} is the address to listen on.
-It overrides @var{family}, @var{host} and @var{service}, and you
-may as well not specify them.
+It overrides @var{family}, @var{host} and @var{service}, so you
+might as well not specify them.
@item :remote @var{remote-address}
For a connection, @var{remote-address} is the address to connect to.
-It overrides @var{family}, @var{host} and @var{service}, and you
-may as well not specify them.
+It overrides @var{family}, @var{host} and @var{service}, so you
+might as well not specify them.
For a datagram server, @var{remote-address} specifies the initial
setting of the remote datagram address.
@@ -2135,7 +2242,7 @@ integers @code{[@var{a} @var{b} @var{c} @var{d} @var{e} @var{f}
port number @var{p}.
@item
-A local address is represented as a string which specifies the address
+A local address is represented as a string, which specifies the address
in the local address space.
@item
@@ -2157,8 +2264,8 @@ second argument matching @code{"open"} (if successful) or
has succeeded or failed.
@item :stop @var{stopped}
-Start the network connection or server in the `stopped' state if
-@var{stopped} is non-@code{nil}.
+If @var{stopped} is non-@code{nil}, start the network connection or
+server in the ``stopped'' state.
@item :buffer @var{buffer}
Use @var{buffer} as the process buffer.
@@ -2179,6 +2286,11 @@ Initialize the process query flag to @var{query-flag}.
@item :filter @var{filter}
Initialize the process filter to @var{filter}.
+@item :filter-multibyte @var{multibyte}
+If @var{multibyte} is non-@code{nil}, strings given to the process
+filter are multibyte, otherwise they are unibyte. The default is the
+default value of @code{enable-multibyte-characters}.
+
@item :sentinel @var{sentinel}
Initialize the process sentinel to @var{sentinel}.
@@ -2186,7 +2298,7 @@ Initialize the process sentinel to @var{sentinel}.
Initialize the log function of a server process to @var{log}. The log
function is called each time the server accepts a network connection
from a client. The arguments passed to the log function are
-@var{server}, @var{connection}, and @var{message}, where @var{server}
+@var{server}, @var{connection}, and @var{message}; where @var{server}
is the server process, @var{connection} is the new process for the
connection, and @var{message} is a string describing what has
happened.
@@ -2223,7 +2335,7 @@ Using this option may require special privileges on some systems.
@item :broadcast @var{broadcast-flag}
If @var{broadcast-flag} is non-@code{nil} for a datagram process, the
process will receive datagram packet sent to a broadcast address, and
-be able to send packets to a broadcast address. Ignored for a stream
+be able to send packets to a broadcast address. This is ignored for a stream
connection.
@item :dontroute @var{dontroute-flag}
@@ -2239,10 +2351,11 @@ If @var{linger-arg} is non-@code{nil}, wait for successful
transmission of all queued packets on the connection before it is
deleted (see @code{delete-process}). If @var{linger-arg} is an
integer, it specifies the maximum time in seconds to wait for queued
-packets to be sent before closing the connection. Default is
-@code{nil} which means to discard unsent queued packets when the
+packets to be sent before closing the connection. The default is
+@code{nil}, which means to discard unsent queued packets when the
process is deleted.
+@c FIXME Where out-of-band data is ...?
@item :oobinline @var{oobinline-flag}
If @var{oobinline-flag} is non-@code{nil} for a stream connection,
receive out-of-band data in the normal data stream. Otherwise, ignore
@@ -2251,7 +2364,7 @@ out-of-band data.
@item :priority @var{priority}
Set the priority for packets sent on this connection to the integer
@var{priority}. The interpretation of this number is protocol
-specific, such as setting the TOS (type of service) field on IP
+specific; such as setting the TOS (type of service) field on IP
packets sent on this connection. It may also have system dependent
effects, such as selecting a specific output queue on the network
interface.
@@ -2259,20 +2372,20 @@ interface.
@item :reuseaddr @var{reuseaddr-flag}
If @var{reuseaddr-flag} is non-@code{nil} (the default) for a stream
server process, allow this server to reuse a specific port number (see
-@code{:service}) unless another process on this host is already
+@code{:service}), unless another process on this host is already
listening on that port. If @var{reuseaddr-flag} is @code{nil}, there
may be a period of time after the last use of that port (by any
-process on the host), where it is not possible to make a new server on
+process on the host) where it is not possible to make a new server on
that port.
@end table
@defun set-network-process-option process option value &optional no-error
This function sets or modifies a network option for network process
-@var{process}. See @code{make-network-process} for details of options
-@var{option} and their corresponding values @var{value}. If
-@var{no-error} is non-@code{nil}, this function returns @code{nil}
-instead of signaling an error if @var{option} is not a supported
-option. If the function successfully completes, it returns @code{t}.
+@var{process}. The accepted options and values are as for
+@code{make-network-process}. If @var{no-error} is non-@code{nil},
+this function returns @code{nil} instead of signaling an error if
+@var{option} is not a supported option. If the function successfully
+completes, it returns @code{t}.
The current setting of an option is available via the
@code{process-contact} function.
@@ -2289,11 +2402,9 @@ The current setting of an option is available via the
@end example
@noindent
-The result of the first form is @code{t} if it works to specify
+The result of this form is @code{t} if it works to specify
@var{keyword} with value @var{value} in @code{make-network-process}.
-The result of the second form is @code{t} if @var{keyword} is
-supported by @code{make-network-process}. Here are some of the
-@var{keyword}---@var{value} pairs you can test in
+Here are some of the @var{keyword}---@var{value} pairs you can test in
this way.
@table @code
@@ -2317,20 +2428,10 @@ Non-@code{nil} if the system can select the port for a server.
@end example
@noindent
-Here are some of the options you can test in this way.
-
-@table @code
-@item :bindtodevice
-@itemx :broadcast
-@itemx :dontroute
-@itemx :keepalive
-@itemx :linger
-@itemx :oobinline
-@itemx :priority
-@itemx :reuseaddr
-That particular network option is supported by
-@code{make-network-process} and @code{set-network-process-option}.
-@end table
+The accepted @var{keyword} values are @code{:bindtodevice}, etc.
+For the complete list, @pxref{Network Options}. This form returns
+non-@code{nil} if that particular network option is supported by
+@code{make-network-process} (or @code{set-network-process-option}).
@node Misc Network
@section Misc Network Facilities
@@ -2402,11 +2503,11 @@ lets you change the speed, bytesize, and other parameters. In a
terminal window created by @code{serial-term}, you can click on the
mode line for configuration.
- A serial connection is represented by a process object which can be
-used similar to a subprocess or network process. You can send and
-receive data and configure the serial port. A serial process object
-has no process ID, you can't send signals to it, and the status codes
-are different from other types of processes.
+ A serial connection is represented by a process object, which can be
+used in a similar way to a subprocess or network process. You can send and
+receive data, and configure the serial port. A serial process object
+has no process ID, however, and you can't send signals to it, and the
+status codes are different from other types of processes.
@code{delete-process} on the process object or @code{kill-buffer} on
the process buffer close the connection, but this does not affect the
device connected to the serial port.
@@ -2414,15 +2515,17 @@ device connected to the serial port.
The function @code{process-type} returns the symbol @code{serial}
for a process object representing a serial port connection.
- Serial ports are available on GNU/Linux, Unix, and Windows systems.
+ Serial ports are available on GNU/Linux, Unix, and MS Windows systems.
@deffn Command serial-term port speed
Start a terminal-emulator for a serial port in a new buffer.
-@var{port} is the name of the serial port to which to connect. For
-example, this could be @file{/dev/ttyS0} on Unix. On Windows, this
+@var{port} is the name of the serial port to connect to. For
+example, this could be @file{/dev/ttyS0} on Unix. On MS Windows, this
could be @file{COM1}, or @file{\\.\COM10} (double the backslashes in
Lisp strings).
+@c FIXME is 9600 still the most common value, or is it 115200 now?
+@c (Same value, 9600, appears below as well.)
@var{speed} is the speed of the serial port in bits per second. 9600
is a common value. The buffer is in Term mode; see @ref{Term Mode,,,
emacs, The GNU Emacs Manual}, for the commands to use in that buffer.
@@ -2431,25 +2534,27 @@ You can change the speed and the configuration in the mode line menu.
@defun make-serial-process &rest args
This function creates a process and a buffer. Arguments are specified
-as keyword/argument pairs. Here's the list of the meaningful keywords:
+as keyword/argument pairs. Here's the list of the meaningful
+keywords, with the first two (@var{port} and @var{speed}) being mandatory:
@table @code
-@item :port @var{port}@r{ (mandatory)}
+@item :port @var{port}
This is the name of the serial port. On Unix and GNU systems, this is
a file name such as @file{/dev/ttyS0}. On Windows, this could be
@file{COM1}, or @file{\\.\COM10} for ports higher than @file{COM9}
(double the backslashes in Lisp strings).
-@item :speed @var{speed}@r{ (mandatory)}
+@item :speed @var{speed}
The speed of the serial port in bits per second. This function calls
-@code{serial-process-configure} to handle the speed.
+@code{serial-process-configure} to handle the speed; see the
+following documentation of that function for more details.
@item :name @var{name}
The name of the process. If @var{name} is not given, @var{port} will
serve as the process name as well.
@item :buffer @var{buffer}
-The buffer to associate with the process. The value could be either a
+The buffer to associate with the process. The value can be either a
buffer or a string that names a buffer. Process output goes at the
end of that buffer, unless you specify an output stream or filter
function to handle the output. If @var{buffer} is not given, the
@@ -2459,16 +2564,16 @@ keyword.
@item :coding @var{coding}
If @var{coding} is a symbol, it specifies the coding system used for
both reading and writing for this process. If @var{coding} is a cons
-@code{(decoding . encoding)}, @var{decoding} is used for reading, and
-@var{encoding} is used for writing. If not specified, the default is
-to determine the coding systems from data itself.
+@code{(@var{decoding} . @var{encoding})}, @var{decoding} is used for
+reading, and @var{encoding} is used for writing. If not specified,
+the default is to determine the coding systems from the data itself.
@item :noquery @var{query-flag}
Initialize the process query flag to @var{query-flag}. @xref{Query
Before Exit}. The flags defaults to @code{nil} if unspecified.
@item :stop @var{bool}
-Start process in the @code{stopped} state if @var{bool} is
+Start process in the ``stopped'' state if @var{bool} is
non-@code{nil}. In the stopped state, a serial process does not
accept incoming data, but you can send outgoing data. The stopped
state is cleared by @code{continue-process} and set by
@@ -2483,8 +2588,7 @@ Install @var{sentinel} as the process sentinel.
@item :plist @var{plist}
Install @var{plist} as the initial plist of the process.
-@item :speed
-@itemx :bytesize
+@item :bytesize
@itemx :parity
@itemx :stopbits
@itemx :flowcontrol
@@ -2512,7 +2616,7 @@ Here is an example:
This functions configures a serial port connection. Arguments are
specified as keyword/argument pairs. Attributes that are not given
are re-initialized from the process's current configuration (available
-via the function @code{process-contact}) or set to reasonable default
+via the function @code{process-contact}), or set to reasonable default
values. The following arguments are defined:
@table @code
@@ -2530,8 +2634,8 @@ rate}. The value can be any number, but most serial ports work only
at a few defined values between 1200 and 115200, with 9600 being the
most common value. If @var{speed} is @code{nil}, the function ignores
all other arguments and does not configure the port. This may be
-useful for special serial ports such as Bluetooth-to-serial converters
-which can only be configured through AT commands sent through the
+useful for special serial ports such as Bluetooth-to-serial converters,
+which can only be configured through @samp{AT} commands sent through the
connection. The value of @code{nil} for @var{speed} is valid only for
connections that were already opened by a previous call to
@code{make-serial-process} or @code{serial-term}.
@@ -2558,9 +2662,9 @@ flow control). If @var{flowcontrol} is not given, it defaults to no
flow control.
@end table
-@code{serial-process-configure} is called by
-@code{make-serial-process} for the initial configuration of the serial
-port.
+Internally, @code{make-serial-process} calls
+@code{serial-process-configure} for the initial configuration of the
+serial port.
@end defun
@node Byte Packing
@@ -2570,8 +2674,12 @@ port.
This section describes how to pack and unpack arrays of bytes,
usually for binary network protocols. These functions convert byte arrays
to alists, and vice versa. The byte array can be represented as a
+@c FIXME? No multibyte?
unibyte string or as a vector of integers, while the alist associates
symbols either with fixed-size objects or with recursive sub-alists.
+To use the functions referred to in this section, load the
+@code{bindat} library.
+@c It doesn't have any autoloads.
@cindex serializing
@cindex deserializing
@@ -2592,10 +2700,10 @@ direction is also known as @dfn{serializing} or @dfn{packing}.
To control unpacking and packing, you write a @dfn{data layout
specification}, a special nested list describing named and typed
-@dfn{fields}. This specification controls length of each field to be
+@dfn{fields}. This specification controls the length of each field to be
processed, and how to pack or unpack it. We normally keep bindat specs
in variables whose names end in @samp{-bindat-spec}; that kind of name
-is automatically recognized as ``risky.''
+is automatically recognized as ``risky''.
@cindex endianness
@cindex big endian
@@ -2605,7 +2713,7 @@ is automatically recognized as ``risky.''
that the field represents and, in the case of multibyte fields, how
the bytes are ordered within the field. The two possible orderings
are ``big endian'' (also known as ``network byte ordering'') and
-``little endian.'' For instance, the number @code{#x23cd} (decimal
+``little endian''. For instance, the number @code{#x23cd} (decimal
9165) in big endian would be the two bytes @code{#x23} @code{#xcd};
and in little endian, @code{#xcd} @code{#x23}. Here are the possible
type values:
@@ -2627,7 +2735,7 @@ Unsigned integer in network byte order, with length 3.
@itemx dword
@itemx long
Unsigned integer in network byte order, with length 4.
-Note: These values may be limited by Emacs' integer implementation limits.
+Note: These values may be limited by Emacs's integer implementation limits.
@item u16r
@itemx u24r
@@ -2641,12 +2749,12 @@ String of length @var{len}.
Zero-terminated string, in a fixed-size field with length @var{len}.
@item vec @var{len} [@var{type}]
-Vector of @var{len} elements of type @var{type}, or bytes if not
-@var{type} is specified.
+Vector of @var{len} elements of type @var{type}, defaulting to bytes.
The @var{type} is any of the simple types above, or another vector
-specified as a list @code{(vec @var{len} [@var{type}])}.
+specified as a list of the form @code{(vec @var{len} [@var{type}])}.
@item ip
+@c FIXME? IPv6?
Four-byte vector representing an Internet address. For example:
@code{[127 0 0 1]} for localhost.
@@ -2674,12 +2782,11 @@ below, or by an expression @code{(eval @var{form})} where @var{form}
should evaluate to an integer, specifying the field length.
A field specification generally has the form @code{([@var{name}]
-@var{handler})}. The square braces indicate that @var{name} is
-optional. (Don't use names that are symbols meaningful as type
-specifications (above) or handler specifications (below), since that
-would be ambiguous.) @var{name} can be a symbol or the expression
-@code{(eval @var{form})}, in which case @var{form} should evaluate to
-a symbol.
+@var{handler})}, where @var{name} is optional. Don't use names that
+are symbols meaningful as type specifications (above) or handler
+specifications (below), since that would be ambiguous. @var{name} can
+be a symbol or an expression @code{(eval @var{form})}, in which case
+@var{form} should evaluate to a symbol.
@var{handler} describes how to unpack or pack the field and can be one
of the following:
@@ -2726,10 +2833,11 @@ of @var{form}. A non-@code{nil} result indicates a match.
@item repeat @var{count} @var{field-specs}@dots{}
Process the @var{field-specs} recursively, in order, then repeat
-starting from the first one, processing all the specs @var{count}
+starting from the first one, processing all the specifications @var{count}
times overall. The @var{count} is given using the same formats as a
field length---if an @code{eval} form is used, it is evaluated just once.
-For correct operation, each spec in @var{field-specs} must include a name.
+For correct operation, each specification in @var{field-specs} must
+include a name.
@end table
For the @code{(eval @var{form})} forms used in a bindat specification,
@@ -2768,9 +2876,10 @@ specification, @code{bindat-raw} to a byte array, and @var{struct} to an
alist representing unpacked field data.
@defun bindat-unpack spec bindat-raw &optional bindat-idx
+@c FIXME? Again, no multibyte?
This function unpacks data from the unibyte string or byte
array @code{bindat-raw}
-according to @var{spec}. Normally this starts unpacking at the
+according to @var{spec}. Normally, this starts unpacking at the
beginning of the byte array, but if @var{bindat-idx} is non-@code{nil}, it
specifies a zero-based starting position to use instead.
@@ -2806,7 +2915,7 @@ according to @var{spec}.
@defun bindat-pack spec struct &optional bindat-raw bindat-idx
This function returns a byte array packed according to @var{spec} from
-the data in the alist @var{struct}. Normally it creates and fills a
+the data in the alist @var{struct}. It normally creates and fills a
new byte array starting at the beginning. However, if @var{bindat-raw}
is non-@code{nil}, it specifies a pre-allocated unibyte string or vector to
pack into. If @var{bindat-idx} is non-@code{nil}, it specifies the starting
@@ -2819,6 +2928,7 @@ meets or exceeds the total length to avoid an out-of-range error.
@defun bindat-ip-to-string ip
Convert the Internet address vector @var{ip} to a string in the usual
dotted notation.
+@c FIXME? Does it do IPv6?
@example
(bindat-ip-to-string [127 0 0 1])
@@ -2828,10 +2938,16 @@ dotted notation.
@node Bindat Examples
@subsection Examples of Byte Unpacking and Packing
+@c FIXME? This seems a very long example for something that is not used
+@c very often. As of 24.1, gdb-mi.el is the only user of bindat.el in Emacs.
+@c Maybe one or both of these examples should just be moved to the
+@c commentary of bindat.el.
Here is a complete example of byte unpacking and packing:
@lisp
+(require 'bindat)
+
(defvar fcookie-index-spec
'((:version u32)
(:count u32)
@@ -2840,16 +2956,14 @@ dotted notation.
(:flags u32)
(:delim u8)
(:ignored fill 3)
- (:offset repeat (:count)
- (:foo u32)))
+ (:offset repeat (:count) (:foo u32)))
"Description of a fortune cookie index file's contents.")
(defun fcookie (cookies &optional index)
"Display a random fortune cookie from file COOKIES.
Optional second arg INDEX specifies the associated index
-filename, which is by default constructed by appending
-\".dat\" to COOKIES. Display cookie text in possibly
-new buffer \"*Fortune Cookie: BASENAME*\" where BASENAME
+filename, by default \"COOKIES.dat\". Display cookie text
+in buffer \"*Fortune Cookie: BASENAME*\", where BASENAME
is COOKIES without the directory part."
(interactive "fCookies file: ")
(let* ((info (with-temp-buffer
@@ -2872,10 +2986,9 @@ is COOKIES without the directory part."
(defun fcookie-create-index (cookies &optional index delim)
"Scan file COOKIES, and write out its index file.
-Optional second arg INDEX specifies the index filename,
-which is by default constructed by appending \".dat\" to
-COOKIES. Optional third arg DELIM specifies the unibyte
-character which, when found on a line of its own in
+Optional arg INDEX specifies the index filename, which by
+default is \"COOKIES.dat\". Optional arg DELIM specifies the
+unibyte character that, when found on a line of its own in
COOKIES, indicates the border between entries."
(interactive "fCookies file: ")
(setq delim (or delim ?%))
@@ -2912,8 +3025,8 @@ COOKIES, indicates the border between entries."
(write-file (or index (concat cookies ".dat")))))))
@end lisp
-Following is an example of defining and unpacking a complex structure.
-Consider the following C structures:
+The following is an example of defining and unpacking a complex
+structure. Consider the following C structures:
@example
struct header @{
@@ -2926,14 +3039,14 @@ struct header @{
struct data @{
unsigned char type;
unsigned char opcode;
- unsigned short length; /* In network byte order */
+ unsigned short length; /* in network byte order */
unsigned char id[8]; /* null-terminated string */
unsigned char data[/* (length + 3) & ~3 */];
@};
struct packet @{
struct header header;
- unsigned long counters[2]; /* In little endian order */
+ unsigned long counters[2]; /* in little endian order */
unsigned char items;
unsigned char filler[3];
struct data item[/* items */];
@@ -2941,7 +3054,7 @@ struct packet @{
@};
@end example
-The corresponding data layout specification:
+The corresponding data layout specification is:
@lisp
(setq header-spec
@@ -2953,21 +3066,21 @@ The corresponding data layout specification:
(setq data-spec
'((type u8)
(opcode u8)
- (length u16) ;; network byte order
+ (length u16) ; network byte order
(id strz 8)
(data vec (length))
(align 4)))
(setq packet-spec
'((header struct header-spec)
- (counters vec 2 u32r) ;; little endian order
+ (counters vec 2 u32r) ; little endian order
(items u8)
(fill 3)
(item repeat (items)
(struct data-spec))))
@end lisp
-A binary data representation:
+A binary data representation is:
@lisp
(setq binary-data
@@ -2977,7 +3090,7 @@ A binary data representation:
1 4 0 7 ?B ?C ?D ?E ?F ?G 0 0 6 7 8 9 10 11 12 0 ])
@end lisp
-The corresponding decoded structure:
+The corresponding decoded structure is:
@lisp
(setq decoded (bindat-unpack packet-spec binary-data))
@@ -3001,7 +3114,7 @@ The corresponding decoded structure:
(type . 1))))
@end lisp
-Fetching data from this structure:
+An example of fetching data from this structure:
@lisp
(bindat-get-field decoded 'item 1 'id)
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index a601ed0c2c0..f165381a0f8 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -1,10 +1,9 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/searching
-@node Searching and Matching, Syntax Tables, Non-ASCII Characters, Top
+@node Searching and Matching
@chapter Searching and Matching
@cindex searching
@@ -38,7 +37,8 @@ properties, see @ref{Property Search}.
buffer. They are meant for use in programs, but you may call them
interactively. If you do so, they prompt for the search string; the
arguments @var{limit} and @var{noerror} are @code{nil}, and @var{repeat}
-is 1.
+is 1. For more details on interactive searching, @pxref{Search,,
+Searching and Replacement, emacs, The GNU Emacs Manual}.
These search functions convert the search string to multibyte if the
buffer is multibyte; they convert the search string to unibyte if the
@@ -49,7 +49,6 @@ This function searches forward from point for an exact match for
@var{string}. If successful, it sets point to the end of the occurrence
found, and returns the new value of point. If no match is found, the
value and side effects depend on @var{noerror} (see below).
-@c Emacs 19 feature
In the following example, point is initially at the beginning of the
line. Then @code{(search-forward "fox")} moves point after the last
@@ -72,8 +71,8 @@ The quick brown fox@point{} jumped over the lazy dog.
@end group
@end example
-The argument @var{limit} specifies the upper bound to the search. (It
-must be a position in the current buffer.) No match extending after
+The argument @var{limit} specifies the bound to the search, and should
+be a position in the current buffer. No match extending after
that position is accepted. If @var{limit} is omitted or @code{nil}, it
defaults to the end of the accessible portion of the buffer.
@@ -83,26 +82,34 @@ What happens when the search fails depends on the value of
error is signaled. If @var{noerror} is @code{t}, @code{search-forward}
returns @code{nil} and does nothing. If @var{noerror} is neither
@code{nil} nor @code{t}, then @code{search-forward} moves point to the
-upper bound and returns @code{nil}. (It would be more consistent now to
-return the new position of point in that case, but some existing
-programs may depend on a value of @code{nil}.)
+upper bound and returns @code{nil}.
+@c I see no prospect of this ever changing, and frankly the current
+@c behavior seems better, so there seems no need to mention this.
+@ignore
+(It would be more consistent now to return the new position of point
+in that case, but some existing programs may depend on a value of
+@code{nil}.)
+@end ignore
The argument @var{noerror} only affects valid searches which fail to
find a match. Invalid arguments cause errors regardless of
@var{noerror}.
-If @var{repeat} is supplied (it must be a positive number), then the
-search is repeated that many times (each time starting at the end of the
-previous time's match). If these successive searches succeed, the
-function succeeds, moving point and returning its new value. Otherwise
-the search fails, with results depending on the value of
-@var{noerror}, as described above.
+If @var{repeat} is a positive number @var{n}, it serves as a repeat
+count: the search is repeated @var{n} times, each time starting at the
+end of the previous time's match. If these successive searches
+succeed, the function succeeds, moving point and returning its new
+value. Otherwise the search fails, with results depending on the
+value of @var{noerror}, as described above. If @var{repeat} is a
+negative number -@var{n}, it serves as a repeat count of @var{n} for a
+search in the opposite (backward) direction.
@end deffn
@deffn Command search-backward string &optional limit noerror repeat
This function searches backward from point for @var{string}. It is
-just like @code{search-forward} except that it searches backwards and
-leaves point at the beginning of the match.
+like @code{search-forward}, except that it searches backwards rather
+than forwards. Backward searches leave point at the beginning of the
+match.
@end deffn
@deffn Command word-search-forward string &optional limit noerror repeat
@@ -130,7 +137,7 @@ the ball boy!"
@group
(word-search-forward "Please find the ball, boy.")
- @result{} 35
+ @result{} 36
---------- Buffer: foo ----------
He said "Please! Find
@@ -151,11 +158,16 @@ end of the accessible portion of the buffer) and returns @code{nil}.
If @var{repeat} is non-@code{nil}, then the search is repeated that many
times. Point is positioned at the end of the last match.
+
+@findex word-search-regexp
+Internal, @code{word-search-forward} and related functions use the
+function @code{word-search-regexp} to convert @var{string} to a
+regular expression that ignores punctuation.
@end deffn
@deffn Command word-search-forward-lax string &optional limit noerror repeat
This command is identical to @code{word-search-forward}, except that
-the end of @code{string} need not match a word boundary unless it ends
+the end of @var{string} need not match a word boundary, unless @var{string} ends
in whitespace. For instance, searching for @samp{ball boy} matches
@samp{ball boyee}, but does not match @samp{aball boy}.
@end deffn
@@ -169,7 +181,7 @@ beginning of the match.
@deffn Command word-search-backward-lax string &optional limit noerror repeat
This command is identical to @code{word-search-backward}, except that
-the end of @code{string} need not match a word boundary unless it ends
+the end of @var{string} need not match a word boundary, unless @var{string} ends
in whitespace.
@end deffn
@@ -187,24 +199,26 @@ regular expressions, too; thus, @samp{[aB]} would match @samp{a} or
@code{case-fold-search} to @code{nil}. Then all letters must match
exactly, including case. This is a buffer-local variable; altering the
variable affects only the current buffer. (@xref{Intro to
-Buffer-Local}.) Alternatively, you may change the default value of
-@code{case-fold-search}.
+Buffer-Local}.) Alternatively, you may change the default value.
+In Lisp code, you will more typically use @code{let} to bind
+@code{case-fold-search} to the desired value.
Note that the user-level incremental search feature handles case
distinctions differently. When the search string contains only lower
case letters, the search ignores case, but when the search string
contains one or more upper case letters, the search becomes
case-sensitive. But this has nothing to do with the searching
-functions used in Lisp code.
+functions used in Lisp code. @xref{Incremental Search,,, emacs,
+The GNU Emacs Manual}.
@defopt case-fold-search
This buffer-local variable determines whether searches should ignore
case. If the variable is @code{nil} they do not ignore case; otherwise
-they do ignore case.
+(and by default) they do ignore case.
@end defopt
@defopt case-replace
-This variable determines whether the higher level replacement
+This variable determines whether the higher-level replacement
functions should preserve case. If the variable is @code{nil}, that
means to use the replacement text verbatim. A non-@code{nil} value
means to convert the case of the replacement text according to the
@@ -226,7 +240,7 @@ regexps; the following section says how to search for them.
@findex re-builder
@cindex regular expressions, developing
- For convenient interactive development of regular expressions, you
+ For interactive development of regular expressions, you
can use the @kbd{M-x re-builder} command. It provides a convenient
interface for creating regular expressions, by giving immediate visual
feedback in a separate buffer. As you edit the regexp, all its
@@ -303,6 +317,7 @@ possible. Thus, @samp{o*} matches any number of @samp{o}s (including no
expression. Thus, @samp{fo*} has a repeating @samp{o}, not a repeating
@samp{fo}. It matches @samp{f}, @samp{fo}, @samp{foo}, and so on.
+@cindex backtracking and regular expressions
The matcher processes a @samp{*} construct by matching, immediately, as
many repetitions as can be found. Then it continues with the rest of
the pattern. If that fails, backtracking occurs, discarding some of the
@@ -372,7 +387,16 @@ Ranges may be intermixed freely with individual characters, as in
@samp{[a-z$%.]}, which matches any lower case @acronym{ASCII} letter
or @samp{$}, @samp{%} or period.
-Note that the usual regexp special characters are not special inside a
+If @code{case-fold-search} is non-@code{nil}, @samp{[a-z]} also
+matches upper-case letters. Note that a range like @samp{[a-z]} is
+not affected by the locale's collation sequence, it always represents
+a sequence in @acronym{ASCII} order.
+@c This wasn't obvious to me, since eg the grep manual "Character
+@c Classes and Bracket Expressions" specifically notes the opposite
+@c behavior. But by experiment Emacs seems unaffected by LC_COLLATE
+@c in this regard.
+
+Note also that the usual regexp special characters are not special inside a
character alternative. A completely different set of characters is
special inside character alternatives: @samp{]}, @samp{-} and @samp{^}.
@@ -380,23 +404,27 @@ To include a @samp{]} in a character alternative, you must make it the
first character. For example, @samp{[]a]} matches @samp{]} or @samp{a}.
To include a @samp{-}, write @samp{-} as the first or last character of
the character alternative, or put it after a range. Thus, @samp{[]-]}
-matches both @samp{]} and @samp{-}.
+matches both @samp{]} and @samp{-}. (As explained below, you cannot
+use @samp{\]} to include a @samp{]} inside a character alternative,
+since @samp{\} is not special there.)
To include @samp{^} in a character alternative, put it anywhere but at
the beginning.
+@c What if it starts with a multibyte and ends with a unibyte?
+@c That doesn't seem to match anything...?
If a range starts with a unibyte character @var{c} and ends with a
multibyte character @var{c2}, the range is divided into two parts: one
-is @samp{@var{c}..?\377}, the other is @samp{@var{c1}..@var{c2}}, where
-@var{c1} is the first character of the charset to which @var{c2}
-belongs.
+spans the unibyte characters @samp{@var{c}..?\377}, the other the
+multibyte characters @samp{@var{c1}..@var{c2}}, where @var{c1} is the
+first character of the charset to which @var{c2} belongs.
A character alternative can also specify named character classes
-(@pxref{Char Classes}). This is a POSIX feature whose syntax is
-@samp{[:@var{class}:]}. Using a character class is equivalent to
-mentioning each of the characters in that class; but the latter is not
-feasible in practice, since some classes include thousands of
-different characters.
+(@pxref{Char Classes}). This is a POSIX feature. For example,
+@samp{[[:ascii:]]} matches any @acronym{ASCII} character.
+Using a character class is equivalent to mentioning each of the
+characters in that class; but the latter is not feasible in practice,
+since some classes include thousands of different characters.
@item @samp{[^ @dots{} ]}
@cindex @samp{^} in regexp
@@ -557,6 +585,7 @@ through @samp{f} and @samp{A} through @samp{F}.
@node Regexp Backslash
@subsubsection Backslash Constructs in Regular Expressions
+@cindex backslash in regular expressions
For the most part, @samp{\} followed by any character matches only
that character. However, there are several exceptions: certain
@@ -796,13 +825,12 @@ with a symbol-constituent character.
@kindex invalid-regexp
Not every string is a valid regular expression. For example, a string
-that ends inside a character alternative without terminating @samp{]}
+that ends inside a character alternative without a terminating @samp{]}
is invalid, and so is a string that ends with a single @samp{\}. If
an invalid regular expression is passed to any of the search functions,
an @code{invalid-regexp} error is signaled.
@node Regexp Example
-@comment node-name, next, previous, up
@subsection Complex Regexp Example
Here is a complicated regexp which was formerly used by Emacs to
@@ -811,20 +839,14 @@ follows. (Nowadays Emacs uses a similar but more complex default
regexp constructed by the function @code{sentence-end}.
@xref{Standard Regexps}.)
- First, we show the regexp as a string in Lisp syntax to distinguish
-spaces from tab characters. The string constant begins and ends with a
+ Below, we show first the regexp as a string in Lisp syntax (to
+distinguish spaces from tab characters), and then the result of
+evaluating it. The string constant begins and ends with a
double-quote. @samp{\"} stands for a double-quote as part of the
string, @samp{\\} for a backslash as part of the string, @samp{\t} for a
tab and @samp{\n} for a newline.
@example
-"[.?!][]\"')@}]*\\($\\| $\\|\t\\|@ @ \\)[ \t\n]*"
-@end example
-
-@noindent
-In contrast, if you evaluate this string, you will see the following:
-
-@example
@group
"[.?!][]\"')@}]*\\($\\| $\\|\t\\|@ @ \\)[ \t\n]*"
@result{} "[.?!][]\"')@}]*\\($\\| $\\| \\|@ @ \\)[
@@ -833,7 +855,7 @@ In contrast, if you evaluate this string, you will see the following:
@end example
@noindent
-In this output, tab and newline appear as themselves.
+In the output, tab and newline appear as themselves.
This regular expression contains four parts in succession and can be
deciphered as follows:
@@ -878,7 +900,7 @@ This function returns a regular expression whose only exact match is
@var{string}. Using this regular expression in @code{looking-at} will
succeed only if the next characters in the buffer are @var{string};
using it in a search function will succeed if the text being searched
-contains @var{string}.
+contains @var{string}. @xref{Regexp Search}.
This allows you to request an exact string match or search when calling
a function that wants a regular expression.
@@ -907,7 +929,11 @@ whitespace:
This function returns an efficient regular expression that will match
any of the strings in the list @var{strings}. This is useful when you
need to make matching or searching as fast as possible---for example,
-for Font Lock mode.
+for Font Lock mode@footnote{Note that @code{regexp-opt} does not
+guarantee that its result is absolutely the most efficient form
+possible. A hand-tuned regular expression can sometimes be slightly
+more efficient, but is almost never worth the effort.}.
+@c See eg http://debbugs.gnu.org/2816
If the optional argument @var{paren} is non-@code{nil}, then the
returned regular expression is always enclosed by at least one
@@ -923,7 +949,7 @@ regular expression which is equivalent to the actual value
(but not as efficient):
@example
-(defun regexp-opt (strings paren)
+(defun regexp-opt (strings &optional paren)
(let ((open-paren (if paren "\\(" ""))
(close-paren (if paren "\\)" "")))
(concat open-paren
@@ -938,6 +964,19 @@ This function returns the total number of grouping constructs
shy groups (@pxref{Regexp Backslash}).
@end defun
+@c Supposedly an internal regexp-opt function, but table.el uses it at least.
+@defun regexp-opt-charset chars
+This function returns a regular expression matching a character in the
+list of characters @var{chars}.
+
+@example
+(regexp-opt-charset '(?a ?b ?c ?d ?e))
+ @result{} "[a-e]"
+@end example
+@end defun
+
+@c Internal functions: regexp-opt-group
+
@node Regexp Search
@section Regular Expression Searching
@cindex regular expression searching
@@ -1080,8 +1119,7 @@ following'' means precisely that: the search is ``anchored'' and it can
succeed only starting with the first character following point. The
result is @code{t} if so, @code{nil} otherwise.
-This function does not move point, but it updates the match data, which
-you can access using @code{match-beginning} and @code{match-end}.
+This function does not move point, but it does update the match data.
@xref{Match Data}. If you need to test for a match without modifying
the match data, use @code{looking-at-p}, described below.
@@ -1102,8 +1140,8 @@ comes back" twice.
@end defun
@defun looking-back regexp &optional limit greedy
-This function returns @code{t} if @var{regexp} matches text before
-point, ending at point, and @code{nil} otherwise.
+This function returns @code{t} if @var{regexp} matches the text
+immediately before point (i.e., ending at point), and @code{nil} otherwise.
Because regular expression matching works only going forward, this is
implemented by searching backwards from point for a match that ends at
@@ -1131,6 +1169,11 @@ comes back" twice.
@result{} nil
@end group
@end example
+
+@c http://debbugs.gnu.org/5689
+As a general recommendation, try to avoid using @code{looking-back}
+wherever possible, since it is slow. For this reason, there are no
+plans to add a @code{looking-back-p} function.
@end defun
@defun looking-at-p regexp
@@ -1154,6 +1197,7 @@ a part of the code.
@node POSIX Regexps
@section POSIX Regular Expression Searching
+@cindex backtracking and POSIX regular expressions
The usual regular expression functions do backtracking when necessary
to handle the @samp{\|} and repetition constructs, but they continue
this only until they find @emph{some} match. Then they succeed and
@@ -1234,20 +1278,18 @@ search. It works by means of the match data.
@cindex case in replacements
@defun replace-match replacement &optional fixedcase literal string subexp
-This function replaces the text in the buffer (or in @var{string}) that
-was matched by the last search. It replaces that text with
-@var{replacement}.
+This function performs a replacement operation on a buffer or string.
-If you did the last search in a buffer, you should specify @code{nil}
-for @var{string} and make sure that the current buffer when you call
-@code{replace-match} is the one in which you did the searching or
-matching. Then @code{replace-match} does the replacement by editing
-the buffer; it leaves point at the end of the replacement text, and
-returns @code{t}.
+If you did the last search in a buffer, you should omit the
+@var{string} argument or specify @code{nil} for it, and make sure that
+the current buffer is the one in which you performed the last search.
+Then this function edits the buffer, replacing the matched text with
+@var{replacement}. It leaves point at the end of the replacement
+text, and returns @code{t}.
-If you did the search in a string, pass the same string as @var{string}.
-Then @code{replace-match} does the replacement by constructing and
-returning a new string.
+If you performed the last search on a string, pass the same string as
+@var{string}. Then this function returns a new string, in which the
+matched text is replaced by @var{replacement}.
If @var{fixedcase} is non-@code{nil}, then @code{replace-match} uses
the replacement text without case conversion; otherwise, it converts
@@ -1268,22 +1310,31 @@ part of one of the following sequences:
@table @asis
@item @samp{\&}
@cindex @samp{&} in replacement
-@samp{\&} stands for the entire text being replaced.
+This stands for the entire text being replaced.
-@item @samp{\@var{n}}
+@item @samp{\@var{n}}, where @var{n} is a digit
@cindex @samp{\@var{n}} in replacement
-@samp{\@var{n}}, where @var{n} is a digit, stands for the text that
-matched the @var{n}th subexpression in the original regexp.
-Subexpressions are those expressions grouped inside @samp{\(@dots{}\)}.
-If the @var{n}th subexpression never matched, an empty string is substituted.
+This stands for the text that matched the @var{n}th subexpression in
+the original regexp. Subexpressions are those expressions grouped
+inside @samp{\(@dots{}\)}. If the @var{n}th subexpression never
+matched, an empty string is substituted.
@item @samp{\\}
@cindex @samp{\} in replacement
-@samp{\\} stands for a single @samp{\} in the replacement text.
+This stands for a single @samp{\} in the replacement text.
+
+@item @samp{\?}
+This stands for itself (for compatibility with @code{replace-regexp}
+and related commands; @pxref{Regexp Replacement,,, emacs, The GNU
+Emacs Manual}).
@end table
-These substitutions occur after case conversion, if any,
-so the strings they substitute are never case-converted.
+@noindent
+Any other character following @samp{\} signals an error.
+
+The substitutions performed by @samp{\&} and @samp{\@var{n}} occur
+after case conversion, if any. Therefore, the strings they substitute
+are never case-converted.
If @var{subexp} is non-@code{nil}, that says to replace just
subexpression number @var{subexp} of the regexp that was matched, not
@@ -1326,12 +1377,16 @@ only information available is about the entire match.
query the match data immediately after searching, before calling any
other function that might perform another search. Alternatively, you
may save and restore the match data (@pxref{Saving Match Data}) around
-the call to functions that could perform another search.
+the call to functions that could perform another search. Or use the
+functions that explicitly do not modify the match data;
+e.g. @code{string-match-p}.
+@c This is an old comment and presumably there is no prospect of this
+@c changing now. But still the advice stands.
A search which fails may or may not alter the match data. In the
-past, a failing search did not do this, but we may change it in the
-future. So don't try to rely on the value of the match data after
-a failing search.
+current implementation, it does not, but we may change it in the
+future. Don't try to rely on the value of the match data after a
+failing search.
@defun match-string count &optional in-string
This function returns, as a string, the text matched in the last search
@@ -1345,7 +1400,7 @@ argument @var{in-string}. After a buffer search or match,
you should omit @var{in-string} or pass @code{nil} for it; but you
should make sure that the current buffer when you call
@code{match-string} is the one in which you did the searching or
-matching.
+matching. Failure to follow this advice will lead to incorrect results.
The value is @code{nil} if @var{count} is out of range, or for a
subexpression inside a @samp{\|} alternative that wasn't used or a
@@ -1358,7 +1413,7 @@ has no text properties.
@end defun
@defun match-beginning count
-This function returns the position of the start of text matched by the
+This function returns the position of the start of the text matched by the
last regular expression searched for, or a subexpression of it.
If @var{count} is zero, then the value is the position of the start of
@@ -1451,7 +1506,7 @@ write the entire match data, all at once.
@defun match-data &optional integers reuse reseat
This function returns a list of positions (markers or integers) that
-record all the information on what text the last search matched.
+record all the information on the text that the last search matched.
Element zero is the position of the beginning of the match for the
whole expression; element one is the position of the end of the match
for the expression. The next two elements are the positions of the
@@ -1520,6 +1575,7 @@ an error; that sets the match data in a meaningless but harmless way.
If @var{reseat} is non-@code{nil}, all markers on the @var{match-list} list
are reseated to point to nowhere.
+@c TODO Make it properly obsolete.
@findex store-match-data
@code{store-match-data} is a semi-obsolete alias for @code{set-match-data}.
@end defun
@@ -1527,7 +1583,7 @@ are reseated to point to nowhere.
@node Saving Match Data
@subsection Saving and Restoring the Match Data
- When you call a function that may do a search, you may need to save
+ When you call a function that may search, you may need to save
and restore the match data around that call, if you want to preserve the
match data from an earlier search for later use. Here is an example
that shows the problem that arises if you fail to save the match data:
@@ -1536,8 +1592,7 @@ that shows the problem that arises if you fail to save the match data:
@group
(re-search-forward "The \\(cat \\)")
@result{} 48
-(foo) ; @r{Perhaps @code{foo} does}
- ; @r{more searching.}
+(foo) ; @r{@code{foo} does more searching.}
(match-end 0)
@result{} 61 ; @r{Unexpected result---not 48!}
@end group
@@ -1630,7 +1685,7 @@ Instead of a string, @var{rep} can be a function. In that case,
@code{replace-regexp-in-string} calls @var{rep} for each match,
passing the text of the match as its sole argument. It collects the
value @var{rep} returns and passes that to @code{replace-match} as the
-replacement string. The match-data at this point are the result
+replacement string. The match data at this point are the result
of matching @var{regexp} against a substring of @var{string}.
@end defun
@@ -1668,7 +1723,7 @@ it specifies how many times to use each of the strings in the
If @var{from-string} contains upper-case letters, then
@code{perform-replace} binds @code{case-fold-search} to @code{nil}, and
-it uses the @code{replacements} without altering the case of them.
+it uses the @var{replacements} without altering their case.
Normally, the keymap @code{query-replace-map} defines the possible
user responses for queries. The argument @var{map}, if
@@ -1698,7 +1753,7 @@ to the functions that use this map.
Prefix keys are not supported; each key binding must be for a
single-event key sequence. This is because the functions don't use
@code{read-key-sequence} to get the input; instead, they read a single
-event and look it up ``by hand.''
+event and look it up ``by hand''.
@end itemize
@end defvar
@@ -1708,26 +1763,30 @@ friends.
@table @code
@item act
-Do take the action being considered---in other words, ``yes.''
+Do take the action being considered---in other words, ``yes''.
@item skip
-Do not take action for this question---in other words, ``no.''
+Do not take action for this question---in other words, ``no''.
@item exit
-Answer this question ``no,'' and give up on the entire series of
-questions, assuming that the answers will be ``no.''
+Answer this question ``no'', and give up on the entire series of
+questions, assuming that the answers will be ``no''.
+
+@item exit-prefix
+Like @code{exit}, but add the key that was pressed to
+@code{unread-comment-events}.
@item act-and-exit
-Answer this question ``yes,'' and give up on the entire series of
-questions, assuming that subsequent answers will be ``no.''
+Answer this question ``yes'', and give up on the entire series of
+questions, assuming that subsequent answers will be ``no''.
@item act-and-show
-Answer this question ``yes,'' but show the results---don't advance yet
+Answer this question ``yes'', but show the results---don't advance yet
to the next question.
@item automatic
Answer this question and all subsequent questions in the series with
-``yes,'' without further user interaction.
+``yes'', without further user interaction.
@item backup
Move back to the previous place that a question was asked about.
@@ -1736,12 +1795,21 @@ Move back to the previous place that a question was asked about.
Enter a recursive edit to deal with this question---instead of any
other action that would normally be taken.
+@item edit-replacement
+Edit the replacement for this question in the minibuffer.
+
@item delete-and-edit
Delete the text being considered, then enter a recursive edit to replace
it.
@item recenter
-Redisplay and center the window, then ask the same question again.
+@itemx scroll-up
+@itemx scroll-down
+@itemx scroll-other-window
+@itemx scroll-other-window-down
+Perform the specified window scroll operation, then ask the same
+question again. Only @code{y-or-n-p} and related functions use this
+answer.
@item quit
Perform a quit right away. Only @code{y-or-n-p} and related functions
@@ -1754,7 +1822,18 @@ Display some help, then ask again.
@defvar multi-query-replace-map
This variable holds a keymap that extends @code{query-replace-map} by
providing additional keybindings that are useful in multi-buffer
-replacements.
+replacements. The additional ``bindings'' are:
+
+@table @code
+@item automatic-all
+Answer this question and all subsequent questions in the series with
+``yes'', without further user interaction, for all remaining buffers.
+
+@item exit-current
+Answer this question ``no'', and give up on the entire series of
+questions for the current buffer. Continue to the next buffer in the
+sequence.
+@end table
@end defvar
@defvar replace-search-function
@@ -1817,8 +1896,8 @@ If non-@code{nil}, the value should be a regular expression describing
the end of a sentence, including the whitespace following the
sentence. (All paragraph boundaries also end sentences, regardless.)
-If the value is @code{nil}, the default, then the function
-@code{sentence-end} has to construct the regexp. That is why you
+If the value is @code{nil}, as it is by default, then the function
+@code{sentence-end} constructs the regexp. That is why you
should always call the function @code{sentence-end} to obtain the
regexp to be used to recognize the end of a sentence.
@end defopt
@@ -1828,6 +1907,6 @@ This function returns the value of the variable @code{sentence-end},
if non-@code{nil}. Otherwise it returns a default value based on the
values of the variables @code{sentence-end-double-space}
(@pxref{Definition of sentence-end-double-space}),
-@code{sentence-end-without-period} and
+@code{sentence-end-without-period}, and
@code{sentence-end-without-space}.
@end defun
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 825dd976eac..e66f61d22d3 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -1,17 +1,16 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/sequences
-@node Sequences Arrays Vectors, Hash Tables, Lists, Top
+@node Sequences Arrays Vectors
@chapter Sequences, Arrays, and Vectors
@cindex sequence
- Recall that the @dfn{sequence} type is the union of two other Lisp
-types: lists and arrays. In other words, any list is a sequence, and
-any array is a sequence. The common property that all sequences have is
-that each is an ordered collection of elements.
+ The @dfn{sequence} type is the union of two other Lisp types: lists
+and arrays. In other words, any list is a sequence, and any array is
+a sequence. The common property that all sequences have is that each
+is an ordered collection of elements.
An @dfn{array} is a fixed-length object with a slot for each of its
elements. All the elements are accessible in constant time. The four
@@ -54,19 +53,17 @@ But it is possible to add elements to the list, or remove elements.
* Vector Functions:: Functions specifically for vectors.
* Char-Tables:: How to work with char-tables.
* Bool-Vectors:: How to work with bool-vectors.
+* Rings:: Managing a fixed-size ring of objects.
@end menu
@node Sequence Functions
@section Sequences
- In Emacs Lisp, a @dfn{sequence} is either a list or an array. The
-common property of all sequences is that they are ordered collections of
-elements. This section describes functions that accept any kind of
-sequence.
+ This section describes functions that accept any kind of sequence.
@defun sequencep object
-Returns @code{t} if @var{object} is a list, vector, string,
-bool-vector, or char-table, @code{nil} otherwise.
+This function returns @code{t} if @var{object} is a list, vector,
+string, bool-vector, or char-table, @code{nil} otherwise.
@end defun
@defun length sequence
@@ -110,6 +107,11 @@ Emacs character code.
@noindent
See also @code{string-bytes}, in @ref{Text Representations}.
+If you need to compute the width of a string on display, you should
+use @code{string-width} (@pxref{Width}), not @code{length}, since
+@code{length} only counts the number of characters, but does not
+account for the display width of each character.
+
@defun elt sequence index
@cindex elements of sequences
This function returns the element of @var{sequence} indexed by
@@ -149,8 +151,9 @@ This function generalizes @code{aref} (@pxref{Array Functions}) and
@defun copy-sequence sequence
@cindex copying sequences
-Returns a copy of @var{sequence}. The copy is the same type of object
-as the original sequence, and it has the same elements in the same order.
+This function returns a copy of @var{sequence}. The copy is the same
+type of object as the original sequence, and it has the same elements
+in the same order.
Storing a new element into the copy does not affect the original
@var{sequence}, and vice versa. However, the elements of the new
@@ -244,7 +247,7 @@ The length of the array is fixed once you create it; you cannot
change the length of an existing array.
@item
-For purposes of evaluation, the array is a constant---in other words,
+For purposes of evaluation, the array is a constant---i.e.,
it evaluates to itself.
@item
@@ -394,8 +397,8 @@ symbol-lookup tables (@pxref{Creating Symbols}), as part of the
representation of a byte-compiled function (@pxref{Byte Compilation}),
and more.
- In Emacs Lisp, the indices of the elements of a vector start from zero
-and count up from there.
+ Like other arrays, vectors use zero-origin indexing: the first
+element has index 0.
Vectors are printed with square brackets surrounding the elements.
Thus, a vector whose elements are the symbols @code{a}, @code{b} and
@@ -728,3 +731,96 @@ bv
@noindent
These results make sense because the binary codes for control-_ and
control-W are 11111 and 10111, respectively.
+
+@node Rings
+@section Managing a Fixed-Size Ring of Objects
+
+@cindex ring data structure
+ A @dfn{ring} is a fixed-size data structure that supports insertion,
+deletion, rotation, and modulo-indexed reference and traversal. An
+efficient ring data structure is implemented by the @code{ring}
+package. It provides the functions listed in this section.
+
+ Note that several ``rings'' in Emacs, like the kill ring and the
+mark ring, are actually implemented as simple lists, @emph{not} using
+the @code{ring} package; thus the following functions won't work on
+them.
+
+@defun make-ring size
+This returns a new ring capable of holding @var{size} objects.
+@var{size} should be an integer.
+@end defun
+
+@defun ring-p object
+This returns @code{t} if @var{object} is a ring, @code{nil} otherwise.
+@end defun
+
+@defun ring-size ring
+This returns the maximum capacity of the @var{ring}.
+@end defun
+
+@defun ring-length ring
+This returns the number of objects that @var{ring} currently contains.
+The value will never exceed that returned by @code{ring-size}.
+@end defun
+
+@defun ring-elements ring
+This returns a list of the objects in @var{ring}, in order, newest first.
+@end defun
+
+@defun ring-copy ring
+This returns a new ring which is a copy of @var{ring}.
+The new ring contains the same (@code{eq}) objects as @var{ring}.
+@end defun
+
+@defun ring-empty-p ring
+This returns @code{t} if @var{ring} is empty, @code{nil} otherwise.
+@end defun
+
+ The newest element in the ring always has index 0. Higher indices
+correspond to older elements. Indices are computed modulo the ring
+length. Index @minus{}1 corresponds to the oldest element, @minus{}2
+to the next-oldest, and so forth.
+
+@defun ring-ref ring index
+This returns the object in @var{ring} found at index @var{index}.
+@var{index} may be negative or greater than the ring length. If
+@var{ring} is empty, @code{ring-ref} signals an error.
+@end defun
+
+@defun ring-insert ring object
+This inserts @var{object} into @var{ring}, making it the newest
+element, and returns @var{object}.
+
+If the ring is full, insertion removes the oldest element to
+make room for the new element.
+@end defun
+
+@defun ring-remove ring &optional index
+Remove an object from @var{ring}, and return that object. The
+argument @var{index} specifies which item to remove; if it is
+@code{nil}, that means to remove the oldest item. If @var{ring} is
+empty, @code{ring-remove} signals an error.
+@end defun
+
+@defun ring-insert-at-beginning ring object
+This inserts @var{object} into @var{ring}, treating it as the oldest
+element. The return value is not significant.
+
+If the ring is full, this function removes the newest element to make
+room for the inserted element.
+@end defun
+
+@cindex fifo data structure
+ If you are careful not to exceed the ring size, you can
+use the ring as a first-in-first-out queue. For example:
+
+@lisp
+(let ((fifo (make-ring 5)))
+ (mapc (lambda (obj) (ring-insert fifo obj))
+ '(0 one "two"))
+ (list (ring-remove fifo) t
+ (ring-remove fifo) t
+ (ring-remove fifo)))
+ @result{} (0 t one t "two")
+@end lisp
diff --git a/doc/lispref/spellfile b/doc/lispref/spellfile
index 18fb633acfd..590d356d2d4 100644
--- a/doc/lispref/spellfile
+++ b/doc/lispref/spellfile
@@ -1,6 +1,5 @@
ARPA
Abbrev
-Acknowledgements
Alan
Arnold
Autoloading
diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi
index 4d3a66d8852..5fd082678c5 100644
--- a/doc/lispref/streams.texi
+++ b/doc/lispref/streams.texi
@@ -1,10 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1994, 1998-1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1994, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/streams
-@node Read and Print, Minibuffers, Debugging, Top
-@comment node-name, next, previous, up
+@node Read and Print
@chapter Reading and Printing Lisp Objects
@dfn{Printing} and @dfn{reading} are the operations of converting Lisp
@@ -115,7 +113,7 @@ When it is called with one argument (always a character), @var{function}
should save the argument and arrange to return it on the next call.
This is called @dfn{unreading} the character; it happens when the Lisp
reader reads one character too many and wants to ``put it back where it
-came from.'' In this case, it makes no difference what value
+came from''. In this case, it makes no difference what value
@var{function} returns.
@end itemize
@@ -266,12 +264,6 @@ reader encountered the open parenthesis, decided that it ended the
input, and unread it. Another attempt to read from the stream at this
point would read @samp{()} and return @code{nil}.
-@defun get-file-char
-This function is used internally as an input stream to read from the
-input file opened by the function @code{load}. Don't use this function
-yourself.
-@end defun
-
@node Input Functions
@section Input Functions
@@ -625,7 +617,7 @@ spacing between calls.
@defun terpri &optional stream
@cindex newline in print
This function outputs a newline to @var{stream}. The name stands
-for ``terminate print.''
+for ``terminate print''.
@end defun
@defun write-char character &optional stream
@@ -702,9 +694,8 @@ The default is @code{t}, meaning display in the echo area.
@defvar print-quoted
If this is non-@code{nil}, that means to print quoted forms using
-abbreviated reader syntax. @code{(quote foo)} prints as @code{'foo},
-@code{(function foo)} as @code{#'foo}, and backquoted forms print
-using modern backquote syntax.
+abbreviated reader syntax, e.g.@: @code{(quote foo)} prints as
+@code{'foo}, and @code{(function foo)} as @code{#'foo}.
@end defvar
@defvar print-escape-newlines
@@ -820,7 +811,6 @@ reader to produce an uninterned symbol.
If non-@code{nil}, that means number continuously across print calls.
This affects the numbers printed for @samp{#@var{n}=} labels and
@samp{#@var{m}#} references.
-
Don't set this variable with @code{setq}; you should only bind it
temporarily to @code{t} with @code{let}. When you do that, you should
also bind @code{print-number-table} to @code{nil}.
@@ -833,8 +823,8 @@ to bind it to @code{nil} when you bind @code{print-continuous-numbering}.
@end defvar
@defvar float-output-format
-This variable specifies how to print floating point numbers. Its
-default value is @code{nil}, meaning use the shortest output
+This variable specifies how to print floating point numbers. The
+default is @code{nil}, meaning use the shortest output
that represents the number without losing information.
To control output format more precisely, you can put a string in this
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 2b8911277cd..865435c91b3 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -1,11 +1,9 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/strings
-@node Strings and Characters, Lists, Numbers, Top
-@comment node-name, next, previous, up
+@node Strings and Characters
@chapter Strings and Characters
@cindex strings
@cindex character arrays
@@ -37,26 +35,31 @@ keyboard character events.
@node String Basics
@section String and Character Basics
- Characters are represented in Emacs Lisp as integers;
-whether an integer is a character or not is determined only by how it is
-used. Thus, strings really contain integers. @xref{Character Codes},
-for details about character representation in Emacs.
+ A character is a Lisp object which represents a single character of
+text. In Emacs Lisp, characters are simply integers; whether an
+integer is a character or not is determined only by how it is used.
+@xref{Character Codes}, for details about character representation in
+Emacs.
- The length of a string (like any array) is fixed, and cannot be
-altered once the string exists. Strings in Lisp are @emph{not}
-terminated by a distinguished character code. (By contrast, strings in
-C are terminated by a character with @acronym{ASCII} code 0.)
+ A string is a fixed sequence of characters. It is a type of
+sequence called a @dfn{array}, meaning that its length is fixed and
+cannot be altered once it is created (@pxref{Sequences Arrays
+Vectors}). Unlike in C, Emacs Lisp strings are @emph{not} terminated
+by a distinguished character code.
Since strings are arrays, and therefore sequences as well, you can
-operate on them with the general array and sequence functions.
-(@xref{Sequences Arrays Vectors}.) For example, you can access or
-change individual characters in a string using the functions @code{aref}
-and @code{aset} (@pxref{Array Functions}).
-
- There are two text representations for non-@acronym{ASCII} characters in
-Emacs strings (and in buffers): unibyte and multibyte (@pxref{Text
-Representations}). For most Lisp programming, you don't need to be
-concerned with these two representations.
+operate on them with the general array and sequence functions
+documented in @ref{Sequences Arrays Vectors}. For example, you can
+access or change individual characters in a string using the functions
+@code{aref} and @code{aset} (@pxref{Array Functions}). However, note
+that @code{length} should @emph{not} be used for computing the width
+of a string on display; use @code{string-width} (@pxref{Width})
+instead.
+
+ There are two text representations for non-@acronym{ASCII}
+characters in Emacs strings (and in buffers): unibyte and multibyte.
+For most Lisp programming, you don't need to be concerned with these
+two representations. @xref{Text Representations}, for details.
Sometimes key sequences are represented as unibyte strings. When a
unibyte string is a key sequence, string elements in the range 128 to
@@ -88,7 +91,7 @@ for information about the syntax of characters and strings.
representations and to encode and decode character codes.
@node Predicates for Strings
-@section The Predicates for Strings
+@section Predicates for Strings
For more information about general sequence and array predicates,
see @ref{Sequences Arrays Vectors}, and @ref{Arrays}.
@@ -410,8 +413,13 @@ in case if @code{case-fold-search} is non-@code{nil}.
@defun string= string1 string2
This function returns @code{t} if the characters of the two strings
match exactly. Symbols are also allowed as arguments, in which case
-their print names are used.
-Case is always significant, regardless of @code{case-fold-search}.
+the symbol names are used. Case is always significant, regardless of
+@code{case-fold-search}.
+
+This function is equivalent to @code{equal} for comparing two strings
+(@pxref{Equality Predicates}). In particular, the text properties of
+the two strings are ignored. But if either argument is not a string
+or symbol, an error is signaled.
@example
(string= "abc" "abc")
@@ -422,10 +430,6 @@ Case is always significant, regardless of @code{case-fold-search}.
@result{} nil
@end example
-The function @code{string=} ignores the text properties of the two
-strings. When @code{equal} (@pxref{Equality Predicates}) compares two
-strings, it uses @code{string=}.
-
For technical reasons, a unibyte and a multibyte string are
@code{equal} if and only if they contain the same sequence of
character codes and all these codes are either in the range 0 through
@@ -505,6 +509,13 @@ are used.
@code{string-lessp} is another name for @code{string<}.
@end defun
+@defun string-prefix-p string1 string2 &optional ignore-case
+This function returns non-@code{nil} if @var{string1} is a prefix of
+@var{string2}; i.e., if @var{string2} starts with @var{string1}. If
+the optional argument @var{ignore-case} is non-@code{nil}, the
+comparison ignores case differences.
+@end defun
+
@defun compare-strings string1 start1 end1 string2 start2 end2 &optional ignore-case
This function compares the specified part of @var{string1} with the
specified part of @var{string2}. The specified part of @var{string1}
@@ -545,7 +556,6 @@ against a string, can be used for a kind of string comparison; see
@ref{Regexp Search}.
@node String Conversion
-@comment node-name, next, previous, up
@section Conversion of Characters and Strings
@cindex conversion of strings
@@ -661,7 +671,6 @@ This function converts a byte of character data into a unibyte string.
@end table
@node Formatting Strings
-@comment node-name, next, previous, up
@section Formatting Strings
@cindex formatting strings
@cindex strings, formatting them
@@ -894,7 +903,6 @@ shows only the first three characters of the representation for
characters.
@node Case Conversion
-@comment node-name, next, previous, up
@section Case Conversion in Lisp
@cindex upper case
@cindex lower case
@@ -1107,7 +1115,7 @@ Exits}).
@acronym{ASCII} characters; for example, in the Turkish language
environment, the @acronym{ASCII} character @samp{I} is downcased into
a Turkish ``dotless i''. This can interfere with code that requires
-ordinary ASCII case conversion, such as implementations of
+ordinary @acronym{ASCII} case conversion, such as implementations of
@acronym{ASCII}-based network protocols. In that case, use the
@code{with-case-table} macro with the variable @var{ascii-case-table},
which stores the unmodified case table for the @acronym{ASCII}
diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi
index 79b3249d760..326c6cd4ab2 100644
--- a/doc/lispref/symbols.texi
+++ b/doc/lispref/symbols.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/symbols
-@node Symbols, Evaluation, Hash Tables, Top
+@node Symbols
@chapter Symbols
@cindex symbol
@@ -31,7 +30,7 @@ otherwise.
for recording miscellaneous information.
@end menu
-@node Symbol Components, Definitions, Symbols, Symbols
+@node Symbol Components
@section Symbol Components
@cindex symbol components
@@ -41,62 +40,58 @@ references another object:
@table @asis
@item Print name
@cindex print name cell
-The @dfn{print name cell} holds a string that names the symbol for
-reading and printing. See @code{symbol-name} in @ref{Creating Symbols}.
+The symbol's name.
@item Value
@cindex value cell
-The @dfn{value cell} holds the current value of the symbol as a
-variable. When a symbol is used as a form, the value of the form is the
-contents of the symbol's value cell. See @code{symbol-value} in
-@ref{Accessing Variables}.
+The symbol's current value as a variable.
@item Function
@cindex function cell
-The @dfn{function cell} holds the function definition of the symbol.
-When a symbol is used as a function, its function definition is used in
-its place. This cell is also used to make a symbol stand for a keymap
-or a keyboard macro, for editor command execution. Because each symbol
-has separate value and function cells, variables names and function names do
-not conflict. See @code{symbol-function} in @ref{Function Cells}.
+The symbol's function definition. It can also hold a symbol, a
+keymap, or a keyboard macro.
@item Property list
@cindex property list cell
-The @dfn{property list cell} holds the property list of the symbol. See
-@code{symbol-plist} in @ref{Property Lists}.
+The symbol's property list.
@end table
- The print name cell always holds a string, and cannot be changed. The
-other three cells can be set individually to any specified Lisp object.
-
- The print name cell holds the string that is the name of the symbol.
-Since symbols are represented textually by their names, it is important
-not to have two symbols with the same name. The Lisp reader ensures
-this: every time it reads a symbol, it looks for an existing symbol with
-the specified name before it creates a new one. (In GNU Emacs Lisp,
-this lookup uses a hashing algorithm and an obarray; see @ref{Creating
-Symbols}.)
-
- The value cell holds the symbol's value as a variable
-(@pxref{Variables}). That is what you get if you evaluate the symbol as
-a Lisp expression (@pxref{Evaluation}). Any Lisp object is a legitimate
-value. Certain symbols have values that cannot be changed; these
-include @code{nil} and @code{t}, and any symbol whose name starts with
-@samp{:} (those are called @dfn{keywords}). @xref{Constant Variables}.
-
- We often refer to ``the function @code{foo}'' when we really mean
-the function stored in the function cell of the symbol @code{foo}. We
-make the distinction explicit only when necessary. In normal
-usage, the function cell usually contains a function
-(@pxref{Functions}) or a macro (@pxref{Macros}), as that is what the
-Lisp interpreter expects to see there (@pxref{Evaluation}). Keyboard
-macros (@pxref{Keyboard Macros}), keymaps (@pxref{Keymaps}) and
-autoload objects (@pxref{Autoloading}) are also sometimes stored in
-the function cells of symbols.
+@noindent
+The print name cell always holds a string, and cannot be changed.
+Each of the other three cells can be set to any Lisp object.
+
+ The print name cell holds the string that is the name of a symbol.
+Since symbols are represented textually by their names, it is
+important not to have two symbols with the same name. The Lisp reader
+ensures this: every time it reads a symbol, it looks for an existing
+symbol with the specified name before it creates a new one. To get a
+symbol's name, use the function @code{symbol-name} (@pxref{Creating
+Symbols}).
+
+ The value cell holds a symbol's value as a variable, which is what
+you get if the symbol itself is evaluated as a Lisp expression.
+@xref{Variables}, for details about how values are set and retrieved,
+including complications such as @dfn{local bindings} and @dfn{scoping
+rules}. Most symbols can have any Lisp object as a value, but certain
+special symbols have values that cannot be changed; these include
+@code{nil} and @code{t}, and any symbol whose name starts with
+@samp{:} (those are called @dfn{keywords}). @xref{Constant
+Variables}.
+
+ The function cell holds a symbol's function definition. Often, we
+refer to ``the function @code{foo}'' when we really mean the function
+stored in the function cell of @code{foo}; we make the distinction
+explicit only when necessary. Typically, the function cell is used to
+hold a function (@pxref{Functions}) or a macro (@pxref{Macros}).
+However, it can also be used to hold a symbol (@pxref{Function
+Indirection}), keyboard macro (@pxref{Keyboard Macros}), keymap
+(@pxref{Keymaps}), or autoload object (@pxref{Autoloading}). To get
+the contents of a symbol's function cell, use the function
+@code{symbol-function} (@pxref{Function Cells}).
The property list cell normally should hold a correctly formatted
-property list (@pxref{Property Lists}), as a number of functions expect
-to see a property list there.
+property list. To get a symbol's property list, use the function
+@code{symbol-plist}. @xref{Property Lists}.
The function cell or the value cell may be @dfn{void}, which means
that the cell does not reference any object. (This is not the same
@@ -104,62 +99,48 @@ thing as holding the symbol @code{void}, nor the same as holding the
symbol @code{nil}.) Examining a function or value cell that is void
results in an error, such as @samp{Symbol's value as variable is void}.
- The four functions @code{symbol-name}, @code{symbol-value},
-@code{symbol-plist}, and @code{symbol-function} return the contents of
-the four cells of a symbol. Here as an example we show the contents of
-the four cells of the symbol @code{buffer-file-name}:
+ Because each symbol has separate value and function cells, variables
+names and function names do not conflict. For example, the symbol
+@code{buffer-file-name} has a value (the name of the file being
+visited in the current buffer) as well as a function definition (a
+primitive function that returns the name of the file):
@example
-(symbol-name 'buffer-file-name)
- @result{} "buffer-file-name"
-(symbol-value 'buffer-file-name)
+buffer-file-name
@result{} "/gnu/elisp/symbols.texi"
(symbol-function 'buffer-file-name)
@result{} #<subr buffer-file-name>
-(symbol-plist 'buffer-file-name)
- @result{} (variable-documentation 29529)
@end example
-@noindent
-Because this symbol is the variable which holds the name of the file
-being visited in the current buffer, the value cell contents we see are
-the name of the source file of this chapter of the Emacs Lisp Manual.
-The property list cell contains the list @code{(variable-documentation
-29529)} which tells the documentation functions where to find the
-documentation string for the variable @code{buffer-file-name} in the
-@file{DOC-@var{version}} file. (29529 is the offset from the beginning
-of the @file{DOC-@var{version}} file to where that documentation string
-begins---see @ref{Documentation Basics}.) The function cell contains
-the function for returning the name of the file.
-@code{buffer-file-name} names a primitive function, which has no read
-syntax and prints in hash notation (@pxref{Primitive Function Type}). A
-symbol naming a function written in Lisp would have a lambda expression
-(or a byte-code object) in this cell.
-
-@node Definitions, Creating Symbols, Symbol Components, Symbols
+@node Definitions
@section Defining Symbols
@cindex definitions of symbols
- A @dfn{definition} in Lisp is a special form that announces your
-intention to use a certain symbol in a particular way. In Emacs Lisp,
-you can define a symbol as a variable, or define it as a function (or
-macro), or both independently.
-
- A definition construct typically specifies a value or meaning for the
-symbol for one kind of use, plus documentation for its meaning when used
-in this way. Thus, when you define a symbol as a variable, you can
-supply an initial value for the variable, plus documentation for the
-variable.
+ A @dfn{definition} is a special kind of Lisp expression that
+announces your intention to use a symbol in a particular way. It
+typically specifies a value or meaning for the symbol for one kind of
+use, plus documentation for its meaning when used in this way. Thus,
+when you define a symbol as a variable, you can supply an initial
+value for the variable, plus documentation for the variable.
@code{defvar} and @code{defconst} are special forms that define a
-symbol as a global variable. They are documented in detail in
-@ref{Defining Variables}. For defining user option variables that can
-be customized, use @code{defcustom} (@pxref{Customization}).
+symbol as a @dfn{global variable}---a variable that can be accessed at
+any point in a Lisp program. @xref{Variables}, for details about
+variables. To define a customizable variable, use the
+@code{defcustom} macro, which also calls @code{defvar} as a subroutine
+(@pxref{Customization}).
+
+ In principle, you can assign a variable value to any symbol with
+@code{setq}, whether not it has first been defined as a variable.
+However, you ought to write a variable definition for each global
+variable that you want to use; otherwise, your Lisp program may not
+act correctly if it is evaluated with lexical scoping enabled
+(@pxref{Variable Scoping}).
@code{defun} defines a symbol as a function, creating a lambda
expression and storing it in the function cell of the symbol. This
lambda expression thus becomes the function definition of the symbol.
-(The term ``function definition,'' meaning the contents of the function
+(The term ``function definition'', meaning the contents of the function
cell, is derived from the idea that @code{defun} gives the symbol its
definition as a function.) @code{defsubst} and @code{defalias} are two
other ways of defining a function. @xref{Functions}.
@@ -171,17 +152,16 @@ both macro and function definitions are kept in the function cell, and
that cell can hold only one Lisp object at any given time.
@xref{Macros}.
- In Emacs Lisp, a definition is not required in order to use a symbol
-as a variable or function. Thus, you can make a symbol a global
-variable with @code{setq}, whether you define it first or not. The real
-purpose of definitions is to guide programmers and programming tools.
-They inform programmers who read the code that certain symbols are
-@emph{intended} to be used as variables, or as functions. In addition,
-utilities such as @file{etags} and @file{make-docfile} recognize
-definitions, and add appropriate information to tag tables and the
-@file{DOC-@var{version}} file. @xref{Accessing Documentation}.
-
-@node Creating Symbols, Property Lists, Definitions, Symbols
+ As previously noted, Emacs Lisp allows the same symbol to be defined
+both as a variable (e.g.@: with @code{defvar}) and as a function or
+macro (e.g.@: with @code{defun}). Such definitions do not conflict.
+
+ These definition also act as guides for programming tools. For
+example, the @kbd{C-h f} and @kbd{C-h v} commands create help buffers
+containing links to the relevant variable, function, or macro
+definitions. @xref{Name Help,,, emacs, The GNU Emacs Manual}.
+
+@node Creating Symbols
@section Creating and Interning Symbols
@cindex reading symbols
@@ -254,8 +234,8 @@ not work---only @code{intern} can enter a symbol in an obarray properly.
@cindex CL note---symbol in obarrays
@quotation
-@b{Common Lisp note:} In Common Lisp, a single symbol may be interned in
-several obarrays.
+@b{Common Lisp note:} Unlike Common Lisp, Emacs Lisp does not provide
+for interning a single symbol in several obarrays.
@end quotation
Most of the functions below take a name and sometimes an obarray as
@@ -330,7 +310,7 @@ The argument @var{name} may also be a symbol; in that case,
the function returns @var{name} if @var{name} is interned
in the specified obarray, and otherwise @code{nil}.
-@smallexample
+@example
(intern-soft "frazzle") ; @r{No such symbol exists.}
@result{} nil
(make-symbol "frazzle") ; @r{Create an uninterned one.}
@@ -351,7 +331,7 @@ in the specified obarray, and otherwise @code{nil}.
(eq sym 'frazzle) ; @r{And it is the same one.}
@result{} t
@end group
-@end smallexample
+@end example
@end defun
@defvar obarray
@@ -366,7 +346,7 @@ This function calls @var{function} once with each symbol in the obarray
omitted, it defaults to the value of @code{obarray}, the standard
obarray for ordinary symbols.
-@smallexample
+@example
(setq count 0)
@result{} 0
(defun count-syms (s)
@@ -376,7 +356,7 @@ obarray for ordinary symbols.
@result{} nil
count
@result{} 1871
-@end smallexample
+@end example
See @code{documentation} in @ref{Accessing Documentation}, for another
example using @code{mapatoms}.
@@ -396,7 +376,7 @@ If @code{unintern} does delete a symbol, it returns @code{t}. Otherwise
it returns @code{nil}.
@end defun
-@node Property Lists,, Creating Symbols, Symbols
+@node Property Lists
@section Property Lists
@cindex property list
@cindex plist
@@ -448,12 +428,13 @@ must be distinct.
Property lists are better than association lists for attaching
information to various Lisp function names or variables. If your
-program keeps all of its associations in one association list, it will
+program keeps all such information in one association list, it will
typically need to search that entire list each time it checks for an
-association. This could be slow. By contrast, if you keep the same
-information in the property lists of the function names or variables
-themselves, each search will scan only the length of one property list,
-which is usually short. This is why the documentation for a variable is
+association for a particular Lisp function name or variable, which
+could be slow. By contrast, if you keep the same information in the
+property lists of the function names or variables themselves, each
+search will scan only the length of one property list, which is
+usually short. This is why the documentation for a variable is
recorded in a property named @code{variable-documentation}. The byte
compiler likewise uses properties to record those functions needing
special treatment.
@@ -481,12 +462,12 @@ This function sets @var{symbol}'s property list to @var{plist}.
Normally, @var{plist} should be a well-formed property list, but this is
not enforced. The return value is @var{plist}.
-@smallexample
+@example
(setplist 'foo '(a 1 b (2 3) c nil))
@result{} (a 1 b (2 3) c nil)
(symbol-plist 'foo)
@result{} (a 1 b (2 3) c nil)
-@end smallexample
+@end example
For symbols in special obarrays, which are not used for ordinary
purposes, it may make sense to use the property list cell in a
@@ -506,12 +487,18 @@ using @code{eq}, so any object is a legitimate property.
See @code{put} for an example.
@end defun
+@defun function-get symbol property
+This function is identical to @code{get}, except that if @var{symbol}
+is the name of a function alias, it looks in the property list of the
+symbol naming the actual function. @xref{Defining Functions}.
+@end defun
+
@defun put symbol property value
This function puts @var{value} onto @var{symbol}'s property list under
the property name @var{property}, replacing any previous property value.
The @code{put} function returns @var{value}.
-@smallexample
+@example
(put 'fly 'verb 'transitive)
@result{}'transitive
(put 'fly 'noun '(a buzzing little bug))
@@ -520,14 +507,14 @@ The @code{put} function returns @var{value}.
@result{} transitive
(symbol-plist 'fly)
@result{} (verb transitive noun (a buzzing little bug))
-@end smallexample
+@end example
@end defun
@node Other Plists
@subsection Property Lists Outside Symbols
These functions are useful for manipulating property lists
-that are stored in places other than symbols:
+not stored in symbols:
@defun plist-get plist property
This returns the value of the @var{property} property stored in the
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi
index 0d7a0c0bed4..624b5a92d6e 100644
--- a/doc/lispref/syntax.texi
+++ b/doc/lispref/syntax.texi
@@ -1,32 +1,28 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/syntax
-@node Syntax Tables, Abbrevs, Searching and Matching, Top
+@node Syntax Tables
@chapter Syntax Tables
@cindex parsing buffer text
@cindex syntax table
@cindex text parsing
- A @dfn{syntax table} specifies the syntactic textual function of each
-character. This information is used by the @dfn{parsing functions}, the
-complex movement commands, and others to determine where words, symbols,
-and other syntactic constructs begin and end. The current syntax table
-controls the meaning of the word motion functions (@pxref{Word Motion})
-and the list motion functions (@pxref{List Motion}), as well as the
-functions in this chapter.
+ A @dfn{syntax table} specifies the syntactic role of each character
+in a buffer. It can be used to determine where words, symbols, and
+other syntactic constructs begin and end. This information is used by
+many Emacs facilities, including Font Lock mode (@pxref{Font Lock
+Mode}) and the various complex movement commands (@pxref{Motion}).
@menu
* Basics: Syntax Basics. Basic concepts of syntax tables.
-* Desc: Syntax Descriptors. How characters are classified.
+* Syntax Descriptors:: How characters are classified.
* Syntax Table Functions:: How to create, examine and alter syntax tables.
* Syntax Properties:: Overriding syntax with text properties.
* Motion and Syntax:: Moving over characters with certain syntaxes.
* Parsing Expressions:: Parsing balanced expressions
using the syntax table.
-* Standard Syntax Tables:: Syntax tables used by various major modes.
* Syntax Table Internals:: How syntax table information is stored.
* Categories:: Another way of classifying character syntax.
@end menu
@@ -34,78 +30,98 @@ functions in this chapter.
@node Syntax Basics
@section Syntax Table Concepts
-@ifnottex
- A @dfn{syntax table} provides Emacs with the information that
-determines the syntactic use of each character in a buffer. This
-information is used by the parsing commands, the complex movement
-commands, and others to determine where words, symbols, and other
-syntactic constructs begin and end. The current syntax table controls
-the meaning of the word motion functions (@pxref{Word Motion}) and the
-list motion functions (@pxref{List Motion}) as well as the functions in
-this chapter.
-@end ifnottex
+ A syntax table is a data structure which can be used to look up the
+@dfn{syntax class} and other syntactic properties of each character.
+Syntax tables are used by Lisp programs for scanning and moving across
+text.
- A syntax table is a char-table (@pxref{Char-Tables}). The element at
-index @var{c} describes the character with code @var{c}. The element's
-value should be a list that encodes the syntax of the character in
-question.
+ Internally, a syntax table is a char-table (@pxref{Char-Tables}).
+The element at index @var{c} describes the character with code
+@var{c}; its value is a cons cell which specifies the syntax of the
+character in question. @xref{Syntax Table Internals}, for details.
+However, instead of using @code{aset} and @code{aref} to modify and
+inspect syntax table contents, you should usually use the higher-level
+functions @code{char-syntax} and @code{modify-syntax-entry}, which are
+described in @ref{Syntax Table Functions}.
- Syntax tables are used only for moving across text, not for the Emacs
-Lisp reader. Emacs Lisp uses built-in syntactic rules when reading Lisp
-expressions, and these rules cannot be changed. (Some Lisp systems
-provide ways to redefine the read syntax, but we decided to leave this
-feature out of Emacs Lisp for simplicity.)
+@defun syntax-table-p object
+This function returns @code{t} if @var{object} is a syntax table.
+@end defun
Each buffer has its own major mode, and each major mode has its own
-idea of the syntactic class of various characters. For example, in Lisp
+idea of the syntax class of various characters. For example, in Lisp
mode, the character @samp{;} begins a comment, but in C mode, it
-terminates a statement. To support these variations, Emacs makes the
-choice of syntax table local to each buffer. Typically, each major
-mode has its own syntax table and installs that table in each buffer
-that uses that mode. Changing this table alters the syntax in all
-those buffers as well as in any buffers subsequently put in that mode.
-Occasionally several similar modes share one syntax table.
+terminates a statement. To support these variations, the syntax table
+is local to each buffer. Typically, each major mode has its own
+syntax table, which it installs in all buffers that use that mode.
+For example, the variable @code{emacs-lisp-mode-syntax-table} holds
+the syntax table used by Emacs Lisp mode, and
+@code{c-mode-syntax-table} holds the syntax table used by C mode.
+Changing a major mode's syntax table alters the syntax in all of that
+mode's buffers, as well as in any buffers subsequently put in that
+mode. Occasionally, several similar modes share one syntax table.
@xref{Example Major Modes}, for an example of how to set up a syntax
table.
-A syntax table can inherit the data for some characters from the
-standard syntax table, while specifying other characters itself. The
-``inherit'' syntax class means ``inherit this character's syntax from
-the standard syntax table.'' Just changing the standard syntax for a
-character affects all syntax tables that inherit from it.
+@cindex standard syntax table
+@cindex inheritance, syntax table
+ A syntax table can @dfn{inherit} from another syntax table, which is
+called its @dfn{parent syntax table}. A syntax table can leave the
+syntax class of some characters unspecified, by giving them the
+``inherit'' syntax class; such a character then acquires the syntax
+class specified by the parent syntax table (@pxref{Syntax Class
+Table}). Emacs defines a @dfn{standard syntax table}, which is the
+default parent syntax table, and is also the syntax table used by
+Fundamental mode.
-@defun syntax-table-p object
-This function returns @code{t} if @var{object} is a syntax table.
+@defun standard-syntax-table
+This function returns the standard syntax table, which is the syntax
+table used in Fundamental mode.
@end defun
+ Syntax tables are not used by the Emacs Lisp reader, which has its
+own built-in syntactic rules which cannot be changed. (Some Lisp
+systems provide ways to redefine the read syntax, but we decided to
+leave this feature out of Emacs Lisp for simplicity.)
+
@node Syntax Descriptors
@section Syntax Descriptors
@cindex syntax class
- This section describes the syntax classes and flags that denote the
-syntax of a character, and how they are represented as a @dfn{syntax
-descriptor}, which is a Lisp string that you pass to
-@code{modify-syntax-entry} to specify the syntax you want.
-
- The syntax table specifies a syntax class for each character. There
+ The @dfn{syntax class} of a character describes its syntactic role.
+Each syntax table specifies the syntax class of each character. There
is no necessary relationship between the class of a character in one
syntax table and its class in any other table.
- Each class is designated by a mnemonic character, which serves as the
-name of the class when you need to specify a class. Usually the
-designator character is one that is often assigned that class; however,
-its meaning as a designator is unvarying and independent of what syntax
-that character currently has. Thus, @samp{\} as a designator character
-always gives ``escape character'' syntax, regardless of what syntax
-@samp{\} currently has.
+ Each syntax class is designated by a mnemonic character, which
+serves as the name of the class when you need to specify a class.
+Usually, this designator character is one that is often assigned that
+class; however, its meaning as a designator is unvarying and
+independent of what syntax that character currently has. Thus,
+@samp{\} as a designator character always means ``escape character''
+syntax, regardless of whether the @samp{\} character actually has that
+syntax in the current syntax table.
+@ifnottex
+@xref{Syntax Class Table}, for a list of syntax classes and their
+designator characters.
+@end ifnottex
@cindex syntax descriptor
- A syntax descriptor is a Lisp string that specifies a syntax class, a
-matching character (used only for the parenthesis classes) and flags.
-The first character is the designator for a syntax class. The second
-character is the character to match; if it is unused, put a space there.
-Then come the characters for any desired flags. If no matching
-character or flags are needed, one character is sufficient.
+ A @dfn{syntax descriptor} is a Lisp string that describes the syntax
+class and other syntactic properties of a character. When you want to
+modify the syntax of a character, that is done by calling the function
+@code{modify-syntax-entry} and passing a syntax descriptor as one of
+its arguments (@pxref{Syntax Table Functions}).
+
+ The first character in a syntax descriptor must be a syntax class
+designator character. The second character, if present, specifies a
+matching character (e.g.@: in Lisp, the matching character for
+@samp{(} is @samp{)}); a space specifies that there is no matching
+character. Then come characters specifying additional syntax
+properties (@pxref{Syntax Flags}).
+
+ If no matching character or flags are needed, only one character
+(specifying the syntax class) is sufficient.
For example, the syntax descriptor for the character @samp{*} in C
mode is @code{". 23"} (i.e., punctuation, matching character slot
@@ -114,6 +130,10 @@ comment-ender), and the entry for @samp{/} is @samp{@w{. 14}} (i.e.,
punctuation, matching character slot unused, first character of a
comment-starter, second character of a comment-ender).
+ Emacs also defines @dfn{raw syntax descriptors}, which are used to
+describe syntax classes at a lower level. @xref{Syntax Table
+Internals}.
+
@menu
* Syntax Class Table:: Table of syntax classes.
* Syntax Flags:: Additional flags each character can have.
@@ -122,70 +142,58 @@ comment-starter, second character of a comment-ender).
@node Syntax Class Table
@subsection Table of Syntax Classes
- Here is a table of syntax classes, the characters that stand for them,
-their meanings, and examples of their use.
-
-@deffn {Syntax class} @w{whitespace character}
-@dfn{Whitespace characters} (designated by @w{@samp{@ }} or @samp{-})
-separate symbols and words from each other. Typically, whitespace
-characters have no other syntactic significance, and multiple whitespace
-characters are syntactically equivalent to a single one. Space, tab,
-newline and formfeed are classified as whitespace in almost all major
-modes.
-@end deffn
-
-@deffn {Syntax class} @w{word constituent}
-@dfn{Word constituents} (designated by @samp{w}) are parts of words in
-human languages, and are typically used in variable and command names
-in programs. All upper- and lower-case letters, and the digits, are
-typically word constituents.
-@end deffn
+ Here is a table of syntax classes, the characters that designate
+them, their meanings, and examples of their use.
-@deffn {Syntax class} @w{symbol constituent}
-@dfn{Symbol constituents} (designated by @samp{_}) are the extra
-characters that are used in variable and command names along with word
-constituents. For example, the symbol constituents class is used in
-Lisp mode to indicate that certain characters may be part of symbol
-names even though they are not part of English words. These characters
-are @samp{$&*+-_<>}. In standard C, the only non-word-constituent
+@table @asis
+@item Whitespace characters: @samp{@ } or @samp{-}
+Characters that separate symbols and words from each other.
+Typically, whitespace characters have no other syntactic significance,
+and multiple whitespace characters are syntactically equivalent to a
+single one. Space, tab, and formfeed are classified as whitespace in
+almost all major modes.
+
+This syntax class can be designated by either @w{@samp{@ }} or
+@samp{-}. Both designators are equivalent.
+
+@item Word constituents: @samp{w}
+Parts of words in human languages. These are typically used in
+variable and command names in programs. All upper- and lower-case
+letters, and the digits, are typically word constituents.
+
+@item Symbol constituents: @samp{_}
+Extra characters used in variable and command names along with word
+constituents. Examples include the characters @samp{$&*+-_<>} in Lisp
+mode, which may be part of a symbol name even though they are not part
+of English words. In standard C, the only non-word-constituent
character that is valid in symbols is underscore (@samp{_}).
-@end deffn
-@deffn {Syntax class} @w{punctuation character}
-@dfn{Punctuation characters} (designated by @samp{.}) are those
-characters that are used as punctuation in English, or are used in some
-way in a programming language to separate symbols from one another.
-Some programming language modes, such as Emacs Lisp mode, have no
-characters in this class since the few characters that are not symbol or
-word constituents all have other uses. Other programming language modes,
-such as C mode, use punctuation syntax for operators.
-@end deffn
-
-@deffn {Syntax class} @w{open parenthesis character}
-@deffnx {Syntax class} @w{close parenthesis character}
-@cindex parenthesis syntax
-Open and close @dfn{parenthesis characters} are characters used in
-dissimilar pairs to surround sentences or expressions. Such a grouping
-is begun with an open parenthesis character and terminated with a close.
-Each open parenthesis character matches a particular close parenthesis
-character, and vice versa. Normally, Emacs indicates momentarily the
-matching open parenthesis when you insert a close parenthesis.
-@xref{Blinking}.
-
-The class of open parentheses is designated by @samp{(}, and that of
-close parentheses by @samp{)}.
-
-In English text, and in C code, the parenthesis pairs are @samp{()},
-@samp{[]}, and @samp{@{@}}. In Emacs Lisp, the delimiters for lists and
-vectors (@samp{()} and @samp{[]}) are classified as parenthesis
-characters.
-@end deffn
-
-@deffn {Syntax class} @w{string quote}
-@dfn{String quote characters} (designated by @samp{"}) are used in
-many languages, including Lisp and C, to delimit string constants. The
-same string quote character appears at the beginning and the end of a
-string. Such quoted strings do not nest.
+@item Punctuation characters: @samp{.}
+Characters used as punctuation in a human language, or used in a
+programming language to separate symbols from one another. Some
+programming language modes, such as Emacs Lisp mode, have no
+characters in this class since the few characters that are not symbol
+or word constituents all have other uses. Other programming language
+modes, such as C mode, use punctuation syntax for operators.
+
+@item Open parenthesis characters: @samp{(}
+@itemx Close parenthesis characters: @samp{)}
+Characters used in dissimilar pairs to surround sentences or
+expressions. Such a grouping is begun with an open parenthesis
+character and terminated with a close. Each open parenthesis
+character matches a particular close parenthesis character, and vice
+versa. Normally, Emacs indicates momentarily the matching open
+parenthesis when you insert a close parenthesis. @xref{Blinking}.
+
+In human languages, and in C code, the parenthesis pairs are
+@samp{()}, @samp{[]}, and @samp{@{@}}. In Emacs Lisp, the delimiters
+for lists and vectors (@samp{()} and @samp{[]}) are classified as
+parenthesis characters.
+
+@item String quotes: @samp{"}
+Characters used to delimit string constants. The same string quote
+character appears at the beginning and the end of a string. Such
+quoted strings do not nest.
The parsing facilities of Emacs consider a string as a single token.
The usual syntactic meanings of the characters in the string are
@@ -197,94 +205,79 @@ is used in Common Lisp. C also has two string quote characters:
double-quote for strings, and single-quote (@samp{'}) for character
constants.
-English text has no string quote characters because English is not a
-programming language. Although quotation marks are used in English,
-we do not want them to turn off the usual syntactic properties of
-other characters in the quotation.
-@end deffn
+Human text has no string quote characters. We do not want quotation
+marks to turn off the usual syntactic properties of other characters
+in the quotation.
-@deffn {Syntax class} @w{escape-syntax character}
-An @dfn{escape character} (designated by @samp{\}) starts an escape
-sequence such as is used in C string and character constants. The
-character @samp{\} belongs to this class in both C and Lisp. (In C, it
-is used thus only inside strings, but it turns out to cause no trouble
-to treat it this way throughout C code.)
+@item Escape-syntax characters: @samp{\}
+Characters that start an escape sequence, such as is used in string
+and character constants. The character @samp{\} belongs to this class
+in both C and Lisp. (In C, it is used thus only inside strings, but
+it turns out to cause no trouble to treat it this way throughout C
+code.)
Characters in this class count as part of words if
@code{words-include-escapes} is non-@code{nil}. @xref{Word Motion}.
-@end deffn
-@deffn {Syntax class} @w{character quote}
-A @dfn{character quote character} (designated by @samp{/}) quotes the
-following character so that it loses its normal syntactic meaning. This
-differs from an escape character in that only the character immediately
-following is ever affected.
+@item Character quotes: @samp{/}
+Characters used to quote the following character so that it loses its
+normal syntactic meaning. This differs from an escape character in
+that only the character immediately following is ever affected.
Characters in this class count as part of words if
@code{words-include-escapes} is non-@code{nil}. @xref{Word Motion}.
This class is used for backslash in @TeX{} mode.
-@end deffn
-
-@deffn {Syntax class} @w{paired delimiter}
-@dfn{Paired delimiter characters} (designated by @samp{$}) are like
-string quote characters except that the syntactic properties of the
-characters between the delimiters are not suppressed. Only @TeX{} mode
-uses a paired delimiter presently---the @samp{$} that both enters and
-leaves math mode.
-@end deffn
-
-@deffn {Syntax class} @w{expression prefix}
-An @dfn{expression prefix operator} (designated by @samp{'}) is used for
-syntactic operators that are considered as part of an expression if they
-appear next to one. In Lisp modes, these characters include the
-apostrophe, @samp{'} (used for quoting), the comma, @samp{,} (used in
-macros), and @samp{#} (used in the read syntax for certain data types).
-@end deffn
-@deffn {Syntax class} @w{comment starter}
-@deffnx {Syntax class} @w{comment ender}
+@item Paired delimiters: @samp{$}
+Similar to string quote characters, except that the syntactic
+properties of the characters between the delimiters are not
+suppressed. Only @TeX{} mode uses a paired delimiter presently---the
+@samp{$} that both enters and leaves math mode.
+
+@item Expression prefixes: @samp{'}
+Characters used for syntactic operators that are considered as part of
+an expression if they appear next to one. In Lisp modes, these
+characters include the apostrophe, @samp{'} (used for quoting), the
+comma, @samp{,} (used in macros), and @samp{#} (used in the read
+syntax for certain data types).
+
+@item Comment starters: @samp{<}
+@itemx Comment enders: @samp{>}
@cindex comment syntax
-The @dfn{comment starter} and @dfn{comment ender} characters are used in
-various languages to delimit comments. These classes are designated
-by @samp{<} and @samp{>}, respectively.
+Characters used in various languages to delimit comments. Human text
+has no comment characters. In Lisp, the semicolon (@samp{;}) starts a
+comment and a newline or formfeed ends one.
-English text has no comment characters. In Lisp, the semicolon
-(@samp{;}) starts a comment and a newline or formfeed ends one.
-@end deffn
-
-@deffn {Syntax class} @w{inherit standard syntax}
-This syntax class does not specify a particular syntax. It says to look
-in the standard syntax table to find the syntax of this character. The
-designator for this syntax class is @samp{@@}.
-@end deffn
+@item Inherit standard syntax: @samp{@@}
+This syntax class does not specify a particular syntax. It says to
+look in the standard syntax table to find the syntax of this
+character.
-@deffn {Syntax class} @w{generic comment delimiter}
-A @dfn{generic comment delimiter} (designated by @samp{!}) starts
-or ends a special kind of comment. @emph{Any} generic comment delimiter
-matches @emph{any} generic comment delimiter, but they cannot match
-a comment starter or comment ender; generic comment delimiters can only
-match each other.
+@item Generic comment delimiters: @samp{!}
+Characters that start or end a special kind of comment. @emph{Any}
+generic comment delimiter matches @emph{any} generic comment
+delimiter, but they cannot match a comment starter or comment ender;
+generic comment delimiters can only match each other.
This syntax class is primarily meant for use with the
-@code{syntax-table} text property (@pxref{Syntax Properties}). You can
-mark any range of characters as forming a comment, by giving the first
-and last characters of the range @code{syntax-table} properties
+@code{syntax-table} text property (@pxref{Syntax Properties}). You
+can mark any range of characters as forming a comment, by giving the
+first and last characters of the range @code{syntax-table} properties
identifying them as generic comment delimiters.
-@end deffn
-@deffn {Syntax class} @w{generic string delimiter}
-A @dfn{generic string delimiter} (designated by @samp{|}) starts or ends
-a string. This class differs from the string quote class in that @emph{any}
-generic string delimiter can match any other generic string delimiter; but
-they do not match ordinary string quote characters.
+@item Generic string delimiters: @samp{|}
+Characters that start or end a string. This class differs from the
+string quote class in that @emph{any} generic string delimiter can
+match any other generic string delimiter; but they do not match
+ordinary string quote characters.
This syntax class is primarily meant for use with the
-@code{syntax-table} text property (@pxref{Syntax Properties}). You can
-mark any range of characters as forming a string constant, by giving the
-first and last characters of the range @code{syntax-table} properties
-identifying them as generic string delimiters.
-@end deffn
+@code{syntax-table} text property (@pxref{Syntax Properties}). You
+can mark any range of characters as forming a string constant, by
+giving the first and last characters of the range @code{syntax-table}
+properties identifying them as generic string delimiters.
+@end table
@node Syntax Flags
@subsection Syntax Flags
@@ -382,7 +375,6 @@ character does not have the @samp{b} flag.
@end table
@item
-@c Emacs 19 feature
@samp{p} identifies an additional ``prefix character'' for Lisp syntax.
These characters are treated as whitespace when they appear between
expressions. When they appear within an expression, they are handled
@@ -400,44 +392,41 @@ prefix (@samp{'}). @xref{Motion and Syntax}.
altering syntax tables.
@defun make-syntax-table &optional table
-This function creates a new syntax table, with all values initialized
-to @code{nil}. If @var{table} is non-@code{nil}, it becomes the
-parent of the new syntax table, otherwise the standard syntax table is
-the parent. Like all char-tables, a syntax table inherits from its
-parent. Thus the original syntax of all characters in the returned
-syntax table is determined by the parent. @xref{Char-Tables}.
-
-Most major mode syntax tables are created in this way.
+This function creates a new syntax table. If @var{table} is
+non-@code{nil}, the parent of the new syntax table is @var{table};
+otherwise, the parent is the standard syntax table.
+
+In the new syntax table, all characters are initially given the
+``inherit'' (@samp{@@}) syntax class, i.e.@: their syntax is inherited
+from the parent table (@pxref{Syntax Class Table}).
@end defun
@defun copy-syntax-table &optional table
This function constructs a copy of @var{table} and returns it. If
-@var{table} is not supplied (or is @code{nil}), it returns a copy of the
-standard syntax table. Otherwise, an error is signaled if @var{table} is
-not a syntax table.
+@var{table} is omitted or @code{nil}, it returns a copy of the
+standard syntax table. Otherwise, an error is signaled if @var{table}
+is not a syntax table.
@end defun
@deffn Command modify-syntax-entry char syntax-descriptor &optional table
This function sets the syntax entry for @var{char} according to
-@var{syntax-descriptor}. @var{char} can be a character, or a cons
+@var{syntax-descriptor}. @var{char} must be a character, or a cons
cell of the form @code{(@var{min} . @var{max})}; in the latter case,
the function sets the syntax entries for all characters in the range
between @var{min} and @var{max}, inclusive.
The syntax is changed only for @var{table}, which defaults to the
-current buffer's syntax table, and not in any other syntax table. The
-argument @var{syntax-descriptor} specifies the desired syntax; this is
-a string beginning with a class designator character, and optionally
-containing a matching character and flags as well. @xref{Syntax
-Descriptors}.
+current buffer's syntax table, and not in any other syntax table.
+
+The argument @var{syntax-descriptor} is a syntax descriptor, i.e.@: a
+string whose first character is a syntax class designator and whose
+second and subsequent characters optionally specify a matching
+character and syntax flags. @xref{Syntax Descriptors}. An error is
+signaled if @var{syntax-descriptor} is not a valid syntax descriptor.
This function always returns @code{nil}. The old syntax information in
the table for this character is discarded.
-An error is signaled if the first character of the syntax descriptor is not
-one of the seventeen syntax class designator characters. An error is also
-signaled if @var{char} is not a character.
-
@example
@group
@exdent @r{Examples:}
@@ -474,38 +463,37 @@ signaled if @var{char} is not a character.
@defun char-syntax character
This function returns the syntax class of @var{character}, represented
-by its mnemonic designator character. This returns @emph{only} the
-class, not any matching parenthesis or flags.
-
-An error is signaled if @var{char} is not a character.
+by its designator character (@pxref{Syntax Class Table}). This
+returns @emph{only} the class, not its matching character or syntax
+flags.
-The following examples apply to C mode. The first example shows that
-the syntax class of space is whitespace (represented by a space). The
-second example shows that the syntax of @samp{/} is punctuation. This
-does not show the fact that it is also part of comment-start and -end
-sequences. The third example shows that open parenthesis is in the class
-of open parentheses. This does not show the fact that it has a matching
-character, @samp{)}.
+The following examples apply to C mode. (We use @code{string} to make
+it easier to see the character returned by @code{char-syntax}.)
@example
@group
+;; Space characters have whitespace syntax class.
(string (char-syntax ?\s))
@result{} " "
@end group
@group
+;; Forward slash characters have punctuation syntax. Note that this
+;; @code{char-syntax} call does not reveal that it is also part of
+;; comment-start and -end sequences.
(string (char-syntax ?/))
@result{} "."
@end group
@group
+;; Open parenthesis characters have open parenthesis syntax. Note
+;; that this @code{char-syntax} call does not reveal that it has a
+;; matching character, @samp{)}.
(string (char-syntax ?\())
@result{} "("
@end group
@end example
-We use @code{string} to make it easier to see the character returned by
-@code{char-syntax}.
@end defun
@defun set-syntax-table table
@@ -534,23 +522,22 @@ execution starts. Other buffers are not affected.
@kindex syntax-table @r{(text property)}
When the syntax table is not flexible enough to specify the syntax of
-a language, you can use @code{syntax-table} text properties to
-override the syntax table for specific character occurrences in the
-buffer. @xref{Text Properties}. You can use Font Lock mode to set
-@code{syntax-table} text properties. @xref{Setting Syntax
-Properties}.
+a language, you can override the syntax table for specific character
+occurrences in the buffer, by applying a @code{syntax-table} text
+property. @xref{Text Properties}, for how to apply text properties.
-The valid values of @code{syntax-table} text property are:
+ The valid values of @code{syntax-table} text property are:
@table @asis
@item @var{syntax-table}
If the property value is a syntax table, that table is used instead of
-the current buffer's syntax table to determine the syntax for this
-occurrence of the character.
+the current buffer's syntax table to determine the syntax for the
+underlying text character.
@item @code{(@var{syntax-code} . @var{matching-char})}
-A cons cell of this format specifies the syntax for this
-occurrence of the character. (@pxref{Syntax Table Internals})
+A cons cell of this format is a raw syntax descriptor (@pxref{Syntax
+Table Internals}), which directly specifies a syntax class for the
+underlying text character.
@item @code{nil}
If the property is @code{nil}, the character's syntax is determined from
@@ -558,9 +545,41 @@ the current syntax table in the usual way.
@end table
@defvar parse-sexp-lookup-properties
-If this is non-@code{nil}, the syntax scanning functions pay attention
-to syntax text properties. Otherwise they use only the current syntax
-table.
+If this is non-@code{nil}, the syntax scanning functions, like
+@code{forward-sexp}, pay attention to syntax text properties.
+Otherwise they use only the current syntax table.
+@end defvar
+
+@defvar syntax-propertize-function
+This variable, if non-@code{nil}, should store a function for applying
+@code{syntax-table} properties to a specified stretch of text. It is
+intended to be used by major modes to install a function which applies
+@code{syntax-table} properties in some mode-appropriate way.
+
+The function is called by @code{syntax-ppss} (@pxref{Position Parse}),
+and by Font Lock mode during syntactic fontification (@pxref{Syntactic
+Font Lock}). It is called with two arguments, @var{start} and
+@var{end}, which are the starting and ending positions of the text on
+which it should act. It is allowed to call @code{syntax-ppss} on any
+position before @var{end}. However, it should not call
+@code{syntax-ppss-flush-cache}; so, it is not allowed to call
+@code{syntax-ppss} on some position and later modify the buffer at an
+earlier position.
+@end defvar
+
+@defvar syntax-propertize-extend-region-functions
+This abnormal hook is run by the syntax parsing code prior to calling
+@code{syntax-propertize-function}. Its role is to help locate safe
+starting and ending buffer positions for passing to
+@code{syntax-propertize-function}. For example, a major mode can add
+a function to this hook to identify multi-line syntactic constructs,
+and ensure that the boundaries do not fall in the middle of one.
+
+Each function in this hook should accept two arguments, @var{start}
+and @var{end}. It should return either a cons cell of two adjusted
+buffer positions, @code{(@var{new-start} . @var{new-end})}, or
+@code{nil} if no adjustment is necessary. The hook functions are run
+in turn, repeatedly, until they all return @code{nil}.
@end defvar
@node Motion and Syntax
@@ -606,11 +625,14 @@ expression prefix syntax class, and characters with the @samp{p} flag.
@section Parsing Expressions
This section describes functions for parsing and scanning balanced
-expressions, also known as @dfn{sexps}. Basically, a sexp is either a
-balanced parenthetical grouping, a string, or a symbol name (a
-sequence of characters whose syntax is either word constituent or
-symbol constituent). However, characters whose syntax is expression
-prefix are treated as part of the sexp if they appear next to it.
+expressions. We will refer to such expressions as @dfn{sexps},
+following the terminology of Lisp, even though these functions can act
+on languages other than Lisp. Basically, a sexp is either a balanced
+parenthetical grouping, a string, or a ``symbol'' (i.e.@: a sequence
+of characters whose syntax is either word constituent or symbol
+constituent). However, characters in the expression prefix syntax
+class (@pxref{Syntax Class Table}) are treated as part of the sexp if
+they appear next to it.
The syntax table controls the interpretation of characters, so these
functions can be used for Lisp expressions when in Lisp mode and for C
@@ -620,7 +642,7 @@ higher-level functions for moving over balanced expressions.
A character's syntax controls how it changes the state of the
parser, rather than describing the state itself. For example, a
string delimiter character toggles the parser state between
-``in-string'' and ``in-code,'' but the syntax of characters does not
+``in-string'' and ``in-code'', but the syntax of characters does not
directly say whether they are inside a string. For example (note that
15 is the syntax code for generic string delimiters),
@@ -648,23 +670,25 @@ result, Emacs treats them as four consecutive empty string constants.
based on parsing expressions.
@defun scan-lists from count depth
-This function scans forward @var{count} balanced parenthetical groupings
-from position @var{from}. It returns the position where the scan stops.
-If @var{count} is negative, the scan moves backwards.
-
-If @var{depth} is nonzero, parenthesis depth counting begins from that
-value. The only candidates for stopping are places where the depth in
-parentheses becomes zero; @code{scan-lists} counts @var{count} such
-places and then stops. Thus, a positive value for @var{depth} means go
-out @var{depth} levels of parenthesis.
+This function scans forward @var{count} balanced parenthetical
+groupings from position @var{from}. It returns the position where the
+scan stops. If @var{count} is negative, the scan moves backwards.
+
+If @var{depth} is nonzero, treat the starting position as being
+@var{depth} parentheses deep. The scanner moves forward or backward
+through the buffer until the depth changes to zero @var{count} times.
+Hence, a positive value for @var{depth} has the effect of moving out
+@var{depth} levels of parenthesis from the starting position, while a
+negative @var{depth} has the effect of moving deeper by @var{-depth}
+levels of parenthesis.
Scanning ignores comments if @code{parse-sexp-ignore-comments} is
non-@code{nil}.
-If the scan reaches the beginning or end of the buffer (or its
-accessible portion), and the depth is not zero, an error is signaled.
-If the depth is zero but the count is not used up, @code{nil} is
-returned.
+If the scan reaches the beginning or end of the accessible part of the
+buffer before it has scanned over @var{count} parenthetical groupings,
+the return value is @code{nil} if the depth at that point is zero; if
+the depth is non-zero, a @code{scan-error} error is signaled.
@end defun
@defun scan-sexps from count
@@ -697,12 +721,12 @@ expected, with nothing except whitespace between them, it returns
This function cannot tell whether the ``comments'' it traverses are
embedded within a string. If they look like comments, it treats them
as comments.
-@end defun
To move forward over all comments and whitespace following point, use
-@code{(forward-comment (buffer-size))}. @code{(buffer-size)} is a good
-argument to use, because the number of comments in the buffer cannot
-exceed that many.
+@code{(forward-comment (buffer-size))}. @code{(buffer-size)} is a
+good argument to use, because the number of comments in the buffer
+cannot exceed that many.
+@end defun
@node Position Parse
@subsection Finding the Parse State for a Position
@@ -712,22 +736,34 @@ thing is to compute the syntactic state corresponding to a given buffer
position. This function does that conveniently.
@defun syntax-ppss &optional pos
-This function returns the parser state (see next section) that the
-parser would reach at position @var{pos} starting from the beginning
-of the buffer. This is equivalent to @code{(parse-partial-sexp
-(point-min) @var{pos})}, except that @code{syntax-ppss} uses a cache
-to speed up the computation. Due to this optimization, the 2nd value
-(previous complete subexpression) and 6th value (minimum parenthesis
-depth) of the returned parser state are not meaningful.
-@end defun
-
- @code{syntax-ppss} automatically hooks itself to
-@code{before-change-functions} to keep its cache consistent. But
-updating can fail if @code{syntax-ppss} is called while
+This function returns the parser state that the parser would reach at
+position @var{pos} starting from the beginning of the buffer.
+@iftex
+See the next section for
+@end iftex
+@ifnottex
+@xref{Parser State},
+@end ifnottex
+for a description of the parser state.
+
+The return value is the same as if you call the low-level parsing
+function @code{parse-partial-sexp} to parse from the beginning of the
+buffer to @var{pos} (@pxref{Low-Level Parsing}). However,
+@code{syntax-ppss} uses a cache to speed up the computation. Due to
+this optimization, the second value (previous complete subexpression)
+and sixth value (minimum parenthesis depth) in the returned parser
+state are not meaningful.
+
+This function has a side effect: it adds a buffer-local entry to
+@code{before-change-functions} (@pxref{Change Hooks}) for
+@code{syntax-ppss-flush-cache} (see below). This entry keeps the
+cache consistent as the buffer is modified. However, the cache might
+not be updated if @code{syntax-ppss} is called while
@code{before-change-functions} is temporarily let-bound, or if the
-buffer is modified without obeying the hook, such as when using
-@code{inhibit-modification-hooks}. For this reason, it is sometimes
-necessary to flush the cache manually.
+buffer is modified without running the hook, such as when using
+@code{inhibit-modification-hooks}. In those cases, it is necessary to
+call @code{syntax-ppss-flush-cache} explicitly.
+@end defun
@defun syntax-ppss-flush-cache beg &rest ignored-args
This function flushes the cache used by @code{syntax-ppss}, starting
@@ -752,18 +788,23 @@ optimize its computations, when the cache gives no help.
@subsection Parser State
@cindex parser state
- A @dfn{parser state} is a list of ten elements describing the final
-state of parsing text syntactically as part of an expression. The
-parsing functions in the following sections return a parser state as
-the value, and in some cases accept one as an argument also, so that
-you can resume parsing after it stops. Here are the meanings of the
-elements of the parser state:
+ A @dfn{parser state} is a list of ten elements describing the state
+of the syntactic parser, after it parses the text between a specified
+starting point and a specified end point in the buffer. Parsing
+functions such as @code{syntax-ppss}
+@ifnottex
+(@pxref{Position Parse})
+@end ifnottex
+return a parser state as the value. Some parsing functions accept a
+parser state as an argument, for resuming parsing.
+
+ Here are the meanings of the elements of the parser state:
@enumerate 0
@item
The depth in parentheses, counting from 0. @strong{Warning:} this can
be negative if there are more close parens than open parens between
-the start of the defun and point.
+the parser's starting point and end point.
@item
@cindex innermost containing parentheses
@@ -783,22 +824,22 @@ string delimiter character should terminate it.
@item
@cindex inside comment
-@code{t} if inside a comment (of either style),
-or the comment nesting level if inside a kind of comment
-that can be nested.
+@code{t} if inside a non-nestable comment (of any comment style;
+@pxref{Syntax Flags}); or the comment nesting level if inside a
+comment that can be nested.
@item
@cindex quote character
-@code{t} if point is just after a quote character.
+@code{t} if the end point is just after a quote character.
@item
The minimum parenthesis depth encountered during this scan.
@item
-What kind of comment is active: @code{nil} for a comment of style
-``a'' or when not inside a comment, @code{t} for a comment of style
-``b,'' and @code{syntax-table} for a comment that should be ended by a
-generic comment delimiter character.
+What kind of comment is active: @code{nil} if not in a comment or in a
+comment of style @samp{a}; 1 for a comment of style @samp{b}; 2 for a
+comment of style @samp{c}; and @code{syntax-table} for a comment that
+should be ended by a generic comment delimiter character.
@item
The string or comment start position. While inside a comment, this is
@@ -814,8 +855,8 @@ as the @var{state} argument to another call.
Elements 1, 2, and 6 are ignored in a state which you pass as an
argument to continue parsing, and elements 8 and 9 are used only in
-trivial cases. Those elements serve primarily to convey information
-to the Lisp program which does the parsing.
+trivial cases. Those elements are mainly used internally by the
+parser code.
One additional piece of useful information is available from a
parser state using this function:
@@ -830,10 +871,6 @@ The value is @code{nil} if @var{state} represents a parse which has
arrived at a top level position.
@end defun
- We have provided this access function rather than document how the
-data is represented in the state, because we plan to change the
-representation in the future.
-
@node Low-Level Parsing
@subsection Low-Level Parsing
@@ -846,6 +883,9 @@ This function parses a sexp in the current buffer starting at
@var{start}, not scanning past @var{limit}. It stops at position
@var{limit} or when certain criteria described below are met, and sets
point to the location where parsing stops. It returns a parser state
+@ifinfo
+(@pxref{Parser State})
+@end ifinfo
describing the status of the parse at the point where it stops.
@cindex parenthesis depth
@@ -893,160 +933,101 @@ The behavior of @code{parse-partial-sexp} is also affected by
You can use @code{forward-comment} to move forward or backward over
one comment or several comments.
-@node Standard Syntax Tables
-@section Some Standard Syntax Tables
-
- Most of the major modes in Emacs have their own syntax tables. Here
-are several of them:
-
-@defun standard-syntax-table
-This function returns the standard syntax table, which is the syntax
-table used in Fundamental mode.
-@end defun
-
-@defvar text-mode-syntax-table
-The value of this variable is the syntax table used in Text mode.
-@end defvar
-
-@defvar c-mode-syntax-table
-The value of this variable is the syntax table for C-mode buffers.
-@end defvar
-
-@defvar emacs-lisp-mode-syntax-table
-The value of this variable is the syntax table used in Emacs Lisp mode
-by editing commands. (It has no effect on the Lisp @code{read}
-function.)
-@end defvar
-
@node Syntax Table Internals
@section Syntax Table Internals
@cindex syntax table internals
- Lisp programs don't usually work with the elements directly; the
-Lisp-level syntax table functions usually work with syntax descriptors
-(@pxref{Syntax Descriptors}). Nonetheless, here we document the
-internal format. This format is used mostly when manipulating
-syntax properties.
-
- Each element of a syntax table is a cons cell of the form
-@code{(@var{syntax-code} . @var{matching-char})}. The @sc{car},
-@var{syntax-code}, is an integer that encodes the syntax class, and any
-flags. The @sc{cdr}, @var{matching-char}, is non-@code{nil} if
-a character to match was specified.
-
- This table gives the value of @var{syntax-code} which corresponds
-to each syntactic type.
-
-@multitable @columnfractions .05 .3 .3 .31
+ Syntax tables are implemented as char-tables (@pxref{Char-Tables}),
+but most Lisp programs don't work directly with their elements.
+Syntax tables do not store syntax data as syntax descriptors
+(@pxref{Syntax Descriptors}); they use an internal format, which is
+documented in this section. This internal format can also be assigned
+as syntax properties (@pxref{Syntax Properties}).
+
+@cindex syntax code
+@cindex raw syntax descriptor
+ Each entry in a syntax table is a @dfn{raw syntax descriptor}: a
+cons cell of the form @code{(@var{syntax-code}
+. @var{matching-char})}. @var{syntax-code} is an integer which
+encodes the syntax class and syntax flags, according to the table
+below. @var{matching-char}, if non-@code{nil}, specifies a matching
+character (similar to the second character in a syntax descriptor).
+
+ Here are the syntax codes corresponding to the various syntax
+classes:
+
+@multitable @columnfractions .2 .3 .2 .3
@item
-@tab
-@i{Integer} @i{Class}
-@tab
-@i{Integer} @i{Class}
-@tab
-@i{Integer} @i{Class}
+@i{Code} @tab @i{Class} @tab @i{Code} @tab @i{Class}
@item
-@tab
-0 @ @ whitespace
-@tab
-5 @ @ close parenthesis
-@tab
-10 @ @ character quote
+0 @tab whitespace @tab 8 @tab paired delimiter
@item
-@tab
-1 @ @ punctuation
-@tab
-6 @ @ expression prefix
-@tab
-11 @ @ comment-start
+1 @tab punctuation @tab 9 @tab escape
@item
-@tab
-2 @ @ word
-@tab
-7 @ @ string quote
-@tab
-12 @ @ comment-end
+2 @tab word @tab 10 @tab character quote
@item
-@tab
-3 @ @ symbol
-@tab
-8 @ @ paired delimiter
-@tab
-13 @ @ inherit
+3 @tab symbol @tab 11 @tab comment-start
@item
-@tab
-4 @ @ open parenthesis
-@tab
-9 @ @ escape
-@tab
-14 @ @ generic comment
+4 @tab open parenthesis @tab 12 @tab comment-end
@item
-@tab
-15 @ generic string
+5 @tab close parenthesis @tab 13 @tab inherit
+@item
+6 @tab expression prefix @tab 14 @tab generic comment
+@item
+7 @tab string quote @tab 15 @tab generic string
@end multitable
- For example, the usual syntax value for @samp{(} is @code{(4 . 41)}.
-(41 is the character code for @samp{)}.)
+@noindent
+For example, in the standard syntax table, the entry for @samp{(} is
+@code{(4 . 41)}. 41 is the character code for @samp{)}.
- The flags are encoded in higher order bits, starting 16 bits from the
-least significant bit. This table gives the power of two which
+ Syntax flags are encoded in higher order bits, starting 16 bits from
+the least significant bit. This table gives the power of two which
corresponds to each syntax flag.
-@multitable @columnfractions .05 .3 .3 .3
+@multitable @columnfractions .15 .3 .15 .3
@item
-@tab
-@i{Prefix} @i{Flag}
-@tab
-@i{Prefix} @i{Flag}
-@tab
-@i{Prefix} @i{Flag}
+@i{Prefix} @tab @i{Flag} @tab @i{Prefix} @tab @i{Flag}
@item
-@tab
-@samp{1} @ @ @code{(lsh 1 16)}
-@tab
-@samp{4} @ @ @code{(lsh 1 19)}
-@tab
-@samp{b} @ @ @code{(lsh 1 21)}
+@samp{1} @tab @code{(lsh 1 16)} @tab @samp{p} @tab @code{(lsh 1 20)}
@item
-@tab
-@samp{2} @ @ @code{(lsh 1 17)}
-@tab
-@samp{p} @ @ @code{(lsh 1 20)}
-@tab
-@samp{n} @ @ @code{(lsh 1 22)}
+@samp{2} @tab @code{(lsh 1 17)} @tab @samp{b} @tab @code{(lsh 1 21)}
@item
-@tab
-@samp{3} @ @ @code{(lsh 1 18)}
+@samp{3} @tab @code{(lsh 1 18)} @tab @samp{n} @tab @code{(lsh 1 22)}
+@item
+@samp{4} @tab @code{(lsh 1 19)}
@end multitable
@defun string-to-syntax @var{desc}
-This function returns the internal form corresponding to the syntax
-descriptor @var{desc}, a cons cell @code{(@var{syntax-code}
-. @var{matching-char})}.
+Given a syntax descriptor @var{desc} (a string), this function returns
+the corresponding raw syntax descriptor.
@end defun
@defun syntax-after pos
-This function returns the syntax code of the character in the buffer
-after position @var{pos}, taking account of syntax properties as well
-as the syntax table. If @var{pos} is outside the buffer's accessible
-portion (@pxref{Narrowing, accessible portion}), this function returns
-@code{nil}.
+This function returns the raw syntax descriptor for the character in
+the buffer after position @var{pos}, taking account of syntax
+properties as well as the syntax table. If @var{pos} is outside the
+buffer's accessible portion (@pxref{Narrowing, accessible portion}),
+the return value is @code{nil}.
@end defun
@defun syntax-class syntax
-This function returns the syntax class of the syntax code
-@var{syntax}. (It masks off the high 16 bits that hold the flags
-encoded in the syntax descriptor.) If @var{syntax} is @code{nil}, it
-returns @code{nil}; this is so evaluating the expression
+This function returns the syntax code for the raw syntax descriptor
+@var{syntax}. More precisely, it takes the raw syntax descriptor's
+@var{syntax-code} component, masks off the high 16 bits which record
+the syntax flags, and returns the resulting integer.
+
+If @var{syntax} is @code{nil}, the return value is returns @code{nil}.
+This is so that the expression
@example
(syntax-class (syntax-after pos))
@end example
@noindent
-where @code{pos} is outside the buffer's accessible portion, will
-yield @code{nil} without throwing errors or producing wrong syntax
-class codes.
+evaluates to @code{nil} if @code{pos} is outside the buffer's
+accessible portion, without throwing errors or returning an incorrect
+code.
@end defun
@node Categories
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index f7f9c716162..57df02b74a0 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -1,9 +1,8 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/text
-@node Text, Non-ASCII Characters, Markers, Top
+@node Text
@chapter Text
@cindex text
@@ -52,12 +51,12 @@ the character after point.
* Case Changes:: Case conversion of parts of the buffer.
* Text Properties:: Assigning Lisp property lists to text characters.
* Substitution:: Replacing a given character wherever it appears.
-* Transposition:: Swapping two portions of a buffer.
* Registers:: How registers are implemented. Accessing the text or
position stored in a register.
+* Transposition:: Swapping two portions of a buffer.
* Base 64:: Conversion to or from base 64 encoding.
-* MD5 Checksum:: Compute the MD5 "message digest"/"checksum".
-* Parsing HTML:: Parsing HTML and XML.
+* Checksum/Hash:: Computing cryptographic hashes.
+* Parsing HTML/XML:: Parsing HTML and XML.
* Atomic Changes:: Installing several buffer changes "atomically".
* Change Hooks:: Supplying functions to be run when text is changed.
@end menu
@@ -169,13 +168,9 @@ convert any portion of the text in the buffer into a string.
@defun buffer-substring start end
This function returns a string containing a copy of the text of the
region defined by positions @var{start} and @var{end} in the current
-buffer. If the arguments are not positions in the accessible portion of
-the buffer, @code{buffer-substring} signals an @code{args-out-of-range}
-error.
-
-It is not necessary for @var{start} to be less than @var{end}; the
-arguments can be given in either order. But most often the smaller
-argument is written first.
+buffer. If the arguments are not positions in the accessible portion
+of the buffer, @code{buffer-substring} signals an
+@code{args-out-of-range} error.
Here's an example which assumes Font-Lock mode is not enabled:
@@ -218,70 +213,67 @@ This is like @code{buffer-substring}, except that it does not copy text
properties, just the characters themselves. @xref{Text Properties}.
@end defun
-@defun filter-buffer-substring start end &optional delete noprops
+@defun buffer-string
+This function returns the contents of the entire accessible portion of
+the current buffer, as a string.
+@end defun
+
+@defun filter-buffer-substring start end &optional delete
This function passes the buffer text between @var{start} and @var{end}
-through the filter functions specified by the variable
-@code{buffer-substring-filters}, and returns the value from the last
-filter function. If @code{buffer-substring-filters} is @code{nil},
-the value is the unaltered text from the buffer, what
-@code{buffer-substring} would return.
+through the filter functions specified by the wrapper hook
+@code{filter-buffer-substring-functions}, and returns the result. The
+obsolete variable @code{buffer-substring-filters} is also consulted.
+If both of these variables are @code{nil}, the value is the unaltered
+text from the buffer, i.e.@: what @code{buffer-substring} would
+return.
If @var{delete} is non-@code{nil}, this function deletes the text
between @var{start} and @var{end} after copying it, like
@code{delete-and-extract-region}.
-If @var{noprops} is non-@code{nil}, the final string returned does not
-include text properties, while the string passed through the filters
-still includes text properties from the buffer text.
-
Lisp code should use this function instead of @code{buffer-substring},
@code{buffer-substring-no-properties},
or @code{delete-and-extract-region} when copying into user-accessible
data structures such as the kill-ring, X clipboard, and registers.
Major and minor modes can add functions to
-@code{buffer-substring-filters} to alter such text as it is copied out
-of the buffer.
+@code{filter-buffer-substring-functions} to alter such text as it is
+copied out of the buffer.
@end defun
-@defvar buffer-substring-filters
-This variable should be a list of functions that accept a single
-argument, a string, and return a string.
-@code{filter-buffer-substring} passes the buffer substring to the
-first function in this list, and the return value of each function is
-passed to the next function. The return value of the last function is
-used as the return value of @code{filter-buffer-substring}.
-
-As a special convention, point is set to the start of the buffer text
-being operated on (i.e., the @var{start} argument for
-@code{filter-buffer-substring}) before these functions are called.
-
-If this variable is @code{nil}, no filtering is performed.
+@defvar filter-buffer-substring-functions
+This variable is a wrapper hook (@pxref{Running Hooks}), whose members
+should be functions that accept four arguments: @var{fun},
+@var{start}, @var{end}, and @var{delete}. @var{fun} is a function
+that takes three arguments (@var{start}, @var{end}, and @var{delete}),
+and returns a string. In both cases, the @var{start}, @var{end}, and
+@var{delete} arguments are the same as those of
+@code{filter-buffer-substring}.
+
+The first hook function is passed a @var{fun} that is equivalent to
+the default operation of @code{filter-buffer-substring}, i.e. it
+returns the buffer-substring between @var{start} and @var{end}
+(processed by any @code{buffer-substring-filters}) and optionally
+deletes the original text from the buffer. In most cases, the hook
+function will call @var{fun} once, and then do its own processing of
+the result. The next hook function receives a @var{fun} equivalent to
+this, and so on. The actual return value is the result of all the
+hook functions acting in sequence.
@end defvar
-@defun buffer-string
-This function returns the contents of the entire accessible portion of
-the current buffer as a string. It is equivalent to
-
-@example
-(buffer-substring (point-min) (point-max))
-@end example
-
-@example
-@group
----------- Buffer: foo ----------
-This is the contents of buffer foo
-
----------- Buffer: foo ----------
-
-(buffer-string)
- @result{} "This is the contents of buffer foo\n"
-@end group
-@end example
-@end defun
+@defvar buffer-substring-filters
+This variable is obsoleted by
+@code{filter-buffer-substring-functions}, but is still supported for
+backward compatibility. Its value should should be a list of
+functions which accept a single string argument and return another
+string. @code{filter-buffer-substring} passes the buffer substring to
+the first function in this list, and the return value of each function
+is passed to the next function. The return value of the last function
+is passed to @code{filter-buffer-substring-functions}.
+@end defvar
@defun current-word &optional strict really-word
-This function returns the symbol (or word) at or near point, as a string.
-The return value includes no text properties.
+This function returns the symbol (or word) at or near point, as a
+string. The return value includes no text properties.
If the optional argument @var{really-word} is non-@code{nil}, it finds a
word; otherwise, it finds a symbol (which includes both word
@@ -409,19 +401,23 @@ ends at the insertion point, the inserted text falls inside that
overlay.
@end defun
-@defun insert-char character count &optional inherit
-This function inserts @var{count} instances of @var{character} into the
-current buffer before point. The argument @var{count} should be an
-integer, and @var{character} must be a character. The value is @code{nil}.
+@deffn Command insert-char character &optional count inherit
+This command inserts @var{count} instances of @var{character} into the
+current buffer before point. The argument @var{count} must be an
+integer, and @var{character} must be a character.
+
+If called interactively, this command prompts for @var{character}
+using its Unicode name or its code point. @xref{Inserting Text,,,
+emacs, The GNU Emacs Manual}.
This function does not convert unibyte character codes 128 through 255
to multibyte characters, not even if the current buffer is a multibyte
buffer. @xref{Converting Representations}.
-If @var{inherit} is non-@code{nil}, then the inserted characters inherit
+If @var{inherit} is non-@code{nil}, the inserted characters inherit
sticky text properties from the two characters before and after the
insertion point. @xref{Sticky Properties}.
-@end defun
+@end deffn
@defun insert-buffer-substring from-buffer-or-name &optional start end
This function inserts a portion of buffer @var{from-buffer-or-name}
@@ -500,6 +496,11 @@ syntax. (@xref{Abbrevs}, and @ref{Syntax Class Table}.) It is also
responsible for calling @code{blink-paren-function} when the inserted
character has close parenthesis syntax (@pxref{Blinking}).
+@vindex post-self-insert-hook
+The final thing this command does is to run the hook
+@code{post-self-insert-hook}. You could use this to automatically
+reindent text as it is typed, for example.
+
Do not try substituting your own definition of
@code{self-insert-command} for the standard one. The editor command
loop handles this function specially.
@@ -557,7 +558,7 @@ error; if some of the text in it is read-only, it signals a
asking for any confirmation. It returns @code{nil}.
Normally, deleting a large amount of text from a buffer inhibits further
-auto-saving of that buffer ``because it has shrunk.'' However,
+auto-saving of that buffer ``because it has shrunk''. However,
@code{erase-buffer} does not do this, the idea being that the future
text is not really related to the former text, and its size should not
be compared with that of the former text.
@@ -808,7 +809,7 @@ that treat it as a ring.
Some people think this use of the word ``kill'' is unfortunate, since
it refers to operations that specifically @emph{do not} destroy the
-entities ``killed.'' This is in sharp contrast to ordinary life, in
+entities ``killed''. This is in sharp contrast to ordinary life, in
which death is permanent and ``killed'' entities do not come back to
life. Therefore, other metaphors have been proposed. For example, the
term ``cut ring'' makes sense to people who, in pre-computer days, used
@@ -825,7 +826,6 @@ would be difficult to change the terminology now.
@end menu
@node Kill Ring Concepts
-@comment node-name, next, previous, up
@subsection Kill Ring Concepts
The kill ring records killed text as strings in a list, most recent
@@ -847,12 +847,11 @@ the entry made by the first one.
For yanking, one entry in the kill ring is designated the ``front'' of
the ring. Some yank commands ``rotate'' the ring by designating a
-different element as the ``front.'' But this virtual rotation doesn't
+different element as the ``front''. But this virtual rotation doesn't
change the list itself---the most recent entry always comes first in the
list.
@node Kill Functions
-@comment node-name, next, previous, up
@subsection Functions for Killing
@code{kill-region} is the usual subroutine for killing text. Any
@@ -900,31 +899,34 @@ In Lisp programs, it is better to use @code{kill-new} or
@node Yanking
@subsection Yanking
- Yanking means inserting text from the kill ring, but it does
-not insert the text blindly. Yank commands and some other commands
-use @code{insert-for-yank} to perform special processing on the
-text that they copy into the buffer.
+ Yanking means inserting text from the kill ring, but it does not
+insert the text blindly. The @code{yank} command, and related
+commands, use @code{insert-for-yank} to perform special processing on
+the text before it is inserted.
@defun insert-for-yank string
-This function normally works like @code{insert} except that it doesn't
-insert the text properties (@pxref{Text Properties}) in the list
-variable @code{yank-excluded-properties}. However, if any part of
-@var{string} has a non-@code{nil} @code{yank-handler} text property,
-that property can do various special processing on that part of the
-text being inserted.
+This function works like @code{insert}, except that it processes the
+text in @var{string} according to the @code{yank-handler} text
+property, as well as the variables @code{yank-handled-properties} and
+@code{yank-excluded-properties} (see below), before inserting the
+result into the current buffer.
@end defun
@defun insert-buffer-substring-as-yank buf &optional start end
-This function resembles @code{insert-buffer-substring} except that it
-doesn't insert the text properties in the
-@code{yank-excluded-properties} list.
+This function resembles @code{insert-buffer-substring}, except that it
+processes the text according to @code{yank-handled-properties} and
+@code{yank-excluded-properties}. (It does not handle the
+@code{yank-handler} property, which does not normally occur in buffer
+text anyway.)
@end defun
- You can put a @code{yank-handler} text property on all or part of
-the text to control how it will be inserted if it is yanked. The
-@code{insert-for-yank} function looks for that property. The property
-value must be a list of one to four elements, with the following
-format (where elements after the first may be omitted):
+ If you put a @code{yank-handler} text property on all or part of a
+string, that alters how @code{insert-for-yank} inserts the string. If
+different parts of the string have different @code{yank-handler}
+values (comparison being done with @code{eq}), each substring is
+handled separately. The property value must be a list of one to four
+elements, with the following format (where elements after the first
+may be omitted):
@example
(@var{function} @var{param} @var{noexclude} @var{undo})
@@ -934,22 +936,21 @@ format (where elements after the first may be omitted):
@table @var
@item function
-When @var{function} is present and non-@code{nil}, it is called instead of
-@code{insert} to insert the string. @var{function} takes one
-argument---the string to insert.
+When @var{function} is non-@code{nil}, it is called instead of
+@code{insert} to insert the string, with one argument---the string to
+insert.
@item param
If @var{param} is present and non-@code{nil}, it replaces @var{string}
-(or the part of @var{string} being processed) as the object passed to
-@var{function} (or @code{insert}); for example, if @var{function} is
-@code{yank-rectangle}, @var{param} should be a list of strings to
-insert as a rectangle.
+(or the substring of @var{string} being processed) as the object
+passed to @var{function} (or @code{insert}). For example, if
+@var{function} is @code{yank-rectangle}, @var{param} should be a list
+of strings to insert as a rectangle.
@item noexclude
-If @var{noexclude} is present and non-@code{nil}, the normal removal of the
-yank-excluded-properties is not performed; instead @var{function} is
-responsible for removing those properties. This may be necessary
-if @var{function} adjusts point before or after inserting the object.
+If @var{noexclude} is present and non-@code{nil}, that disables the
+normal action of @code{yank-handled-properties} and
+@code{yank-excluded-properties} on the inserted string.
@item undo
If @var{undo} is present and non-@code{nil}, it is a function that will be
@@ -960,16 +961,30 @@ the @var{undo} value.
@end table
@cindex yanking and text properties
+@defopt yank-handled-properties
+This variable specifies special text property handling conditions for
+yanked text. It takes effect after the text has been inserted (either
+normally, or via the @code{yank-handler} property), and prior to
+@code{yank-excluded-properties} taking effect.
+
+The value should be an alist of elements @code{(@var{prop}
+. @var{fun})}. Each alist element is handled in order. The inserted
+text is scanned for stretches of text having text properties @code{eq}
+to @var{prop}; for each such stretch, @var{fun} is called with three
+arguments: the value of the property, and the start and end positions
+of the text.
+@end defopt
+
@defopt yank-excluded-properties
-Yanking discards certain text properties from the yanked text, as
-described above. The value of this variable is the list of properties
-to discard. Its default value contains properties that might lead to
-annoying results, such as causing the text to respond to the mouse or
-specifying key bindings.
+The value of this variable is the list of properties to remove from
+inserted text. Its default value contains properties that might lead
+to annoying results, such as causing the text to respond to the mouse
+or specifying key bindings. It takes effect after
+@code{yank-handled-properties}.
@end defopt
+
@node Yank Commands
-@comment node-name, next, previous, up
@subsection Functions for Yanking
This section describes higher-level commands for yanking, which are
@@ -1095,8 +1110,8 @@ programs, when you are using a window system. Its value should be
@code{nil} or a function of no arguments.
If the value is a function, @code{current-kill} calls it to get the
-``most recent kill.'' If the function returns a non-@code{nil} value,
-then that value is used as the ``most recent kill.'' If it returns
+``most recent kill''. If the function returns a non-@code{nil} value,
+then that value is used as the ``most recent kill''. If it returns
@code{nil}, then the front of the kill ring is used.
To facilitate support for window systems that support multiple
@@ -1105,13 +1120,11 @@ case, the first string is used as the ``most recent kill'', and all
the other strings are pushed onto the kill ring, for easy access by
@code{yank-pop}.
-The normal use of this function is to get the window system's primary
-selection as the most recent kill, even if the selection belongs to
+The normal use of this function is to get the window system's
+clipboard as the most recent kill, even if the selection belongs to
another application. @xref{Window System Selections}. However, if
-the selection was provided by the current Emacs session, this function
-should return @code{nil}. (If it is hard to tell whether Emacs or
-some other program provided the selection, it should be good enough to
-use @code{string=} to compare it with the last text Emacs provided.)
+the clipboard contents come from the current Emacs session, this
+function should return @code{nil}.
@end defvar
@defvar interprogram-cut-function
@@ -1122,13 +1135,11 @@ programs, when you are using a window system. Its value should be
If the value is a function, @code{kill-new} and @code{kill-append} call
it with the new first element of the kill ring as the argument.
-The normal use of this function is to set the window system's primary
-selection from the newly killed text.
-@xref{Window System Selections}.
+The normal use of this function is to put newly killed text in the
+window system's clipboard. @xref{Window System Selections}.
@end defvar
@node Internals of Kill Ring
-@comment node-name, next, previous, up
@subsection Internals of the Kill Ring
The variable @code{kill-ring} holds the kill ring contents, in the
@@ -1201,7 +1212,6 @@ value for @code{kill-ring-max} is 60.
@end defopt
@node Undo
-@comment node-name, next, previous, up
@section Undo
@cindex redo
@@ -1240,11 +1250,12 @@ reinsert it is @code{(abs @var{position})}. If @var{position} is
positive, point was at the beginning of the deleted text, otherwise it
was at the end.
-@item (t @var{high} . @var{low})
+@item (t @var{sec-high} @var{sec-low} @var{microsec} @var{picosec})
This kind of element indicates that an unmodified buffer became
-modified. The elements @var{high} and @var{low} are two integers, each
-recording 16 bits of the visited file's modification time as of when it
-was previously visited or saved. @code{primitive-undo} uses those
+modified. The list @code{(@var{sec-high} @var{sec-low} @var{microsec}
+@var{picosec})} represents the visited file's modification time as of
+when it was previously visited or saved, using the same format as
+@code{current-time}; see @ref{Time of Day}. @code{primitive-undo} uses those
values to determine whether to mark the buffer as unmodified once again;
it does so only if the file's modification time matches those numbers.
@@ -1404,7 +1415,6 @@ leak memory if the user waits too long before answering the question.
@end defopt
@node Filling
-@comment node-name, next, previous, up
@section Filling
@cindex filling text
@@ -1782,7 +1792,6 @@ prefix or @code{nil}, meaning it has failed to determine a prefix.
@end defopt
@node Auto Filling
-@comment node-name, next, previous, up
@section Auto Filling
@cindex filling, automatic
@cindex Auto Fill mode
@@ -1804,12 +1813,6 @@ special is done in that case.
The value of @code{auto-fill-function} is @code{do-auto-fill} when
Auto-Fill mode is enabled. That is a function whose sole purpose is to
implement the usual strategy for breaking a line.
-
-@quotation
-In older Emacs versions, this variable was named @code{auto-fill-hook},
-but since it is not called with the standard convention for hooks, it
-was renamed to @code{auto-fill-function} in version 19.
-@end quotation
@end defvar
@defvar normal-auto-fill-function
@@ -2083,7 +2086,6 @@ utility program.
@end deffn
@node Columns
-@comment node-name, next, previous, up
@section Counting Columns
@cindex columns
@cindex counting columns
@@ -2207,14 +2209,48 @@ key to indent properly for the language being edited. This section
describes the mechanism of the @key{TAB} key and how to control it.
The functions in this section return unpredictable values.
-@defvar indent-line-function
-This variable's value is the function to be used by @key{TAB} (and
-various commands) to indent the current line. The command
-@code{indent-according-to-mode} does little more than call this function.
+@deffn Command indent-for-tab-command &optional rigid
+This is the command bound to @key{TAB} in most editing modes. Its
+usual action is to indent the current line, but it can alternatively
+insert a tab character or indent a region.
-In Lisp mode, the value is the symbol @code{lisp-indent-line}; in C
-mode, @code{c-indent-line}; in Fortran mode, @code{fortran-indent-line}.
-The default value is @code{indent-relative}. @xref{Auto-Indentation}.
+Here is what it does:
+
+@itemize
+@item
+First, it checks whether Transient Mark mode is enabled and the region
+is active. If so, it called @code{indent-region} to indent all the
+text in the region (@pxref{Region Indent}).
+
+@item
+Otherwise, if the indentation function in @code{indent-line-function}
+is @code{indent-to-left-margin} (a trivial command that inserts a tab
+character), or if the variable @code{tab-always-indent} specifies that
+a tab character ought to be inserted (see below), then it inserts a
+tab character.
+
+@item
+Otherwise, it indents the current line; this is done by calling the
+function in @code{indent-line-function}. If the line is already
+indented, and the value of @code{tab-always-indent} is @code{complete}
+(see below), it tries completing the text at point.
+@end itemize
+
+If @var{rigid} is non-@code{nil} (interactively, with a prefix
+argument), then after this command indents a line or inserts a tab, it
+also rigidly indents the entire balanced expression which starts at
+the beginning of the current line, in order to reflect the new
+indentation. This argument is ignored if the command indents the
+region.
+@end deffn
+
+@defvar indent-line-function
+This variable's value is the function to be used by
+@code{indent-for-tab-command}, and various other indentation commands,
+to indent the current line. It is usually assigned by the major mode;
+for instance, Lisp mode sets it to @code{lisp-indent-line}, C mode
+sets it to @code{c-indent-line}, and so on. The default value is
+@code{indent-relative}. @xref{Auto-Indentation}.
@end defvar
@deffn Command indent-according-to-mode
@@ -2222,41 +2258,31 @@ This command calls the function in @code{indent-line-function} to
indent the current line in a way appropriate for the current major mode.
@end deffn
-@deffn Command indent-for-tab-command &optional rigid
-This command calls the function in @code{indent-line-function} to
-indent the current line; however, if that function is
-@code{indent-to-left-margin}, @code{insert-tab} is called instead.
-(That is a trivial command that inserts a tab character.) If
-@var{rigid} is non-@code{nil}, this function also rigidly indents the
-entire balanced expression that starts at the beginning of the current
-line, to reflect change in indentation of the current line.
-@end deffn
-
@deffn Command newline-and-indent
This function inserts a newline, then indents the new line (the one
-following the newline just inserted) according to the major mode.
-
-It does indentation by calling the current @code{indent-line-function}.
-In programming language modes, this is the same thing @key{TAB} does,
-but in some text modes, where @key{TAB} inserts a tab,
-@code{newline-and-indent} indents to the column specified by
-@code{left-margin}.
+following the newline just inserted) according to the major mode. It
+does indentation by calling @code{indent-according-to-mode}.
@end deffn
@deffn Command reindent-then-newline-and-indent
-@comment !!SourceFile simple.el
This command reindents the current line, inserts a newline at point,
and then indents the new line (the one following the newline just
-inserted).
-
-This command does indentation on both lines according to the current
-major mode, by calling the current value of @code{indent-line-function}.
-In programming language modes, this is the same thing @key{TAB} does,
-but in some text modes, where @key{TAB} inserts a tab,
-@code{reindent-then-newline-and-indent} indents to the column specified
-by @code{left-margin}.
+inserted). It does indentation on both lines by calling
+@code{indent-according-to-mode}.
@end deffn
+@defopt tab-always-indent
+This variable can be used to customize the behavior of the @key{TAB}
+(@code{indent-for-tab-command}) command. If the value is @code{t}
+(the default), the command normally just indents the current line. If
+the value is @code{nil}, the command indents the current line only if
+point is at the left margin or in the line's indentation; otherwise,
+it inserts a tab character. If the value is @code{complete}, the
+command first tries to indent the current line, and if the line was
+already indented, it calls @code{completion-at-point} to complete the
+text at point (@pxref{Completion in Buffers}).
+@end defopt
+
@node Region Indent
@subsection Indenting an Entire Region
@@ -2402,7 +2428,6 @@ column, this command does nothing.
@end deffn
@node Indent Tabs
-@comment node-name, next, previous, up
@subsection Adjustable ``Tab Stops''
@cindex tabs stops for indentation
@@ -2461,7 +2486,6 @@ If @var{arg} is omitted or @code{nil}, it defaults to 1.
@end deffn
@node Case Changes
-@comment node-name, next, previous, up
@section Case Changes
@cindex case conversion in buffers
@@ -2831,7 +2855,7 @@ faster to process chunks of text that have the same property value.
comparing property values. In all cases, @var{object} defaults to the
current buffer.
- For high performance, it's very important to use the @var{limit}
+ For good performance, it's very important to use the @var{limit}
argument to these functions, especially the ones that search for a
single property---otherwise, they may spend a long time scanning to the
end of the buffer, if the property you are interested in does not change.
@@ -2843,15 +2867,15 @@ different properties.
@defun next-property-change pos &optional object limit
The function scans the text forward from position @var{pos} in the
-string or buffer @var{object} till it finds a change in some text
+string or buffer @var{object} until it finds a change in some text
property, then returns the position of the change. In other words, it
returns the position of the first character beyond @var{pos} whose
properties are not identical to those of the character just after
@var{pos}.
If @var{limit} is non-@code{nil}, then the scan ends at position
-@var{limit}. If there is no property change before that point,
-@code{next-property-change} returns @var{limit}.
+@var{limit}. If there is no property change before that point, this
+function returns @var{limit}.
The value is @code{nil} if the properties remain unchanged all the way
to the end of @var{object} and @var{limit} is @code{nil}. If the value
@@ -2984,26 +3008,28 @@ character.
@item face
@cindex face codes of text
@kindex face @r{(text property)}
-You can use the property @code{face} to control the font and color of
-text. @xref{Faces}, for more information.
-
-@code{face} can be the following:
+The @code{face} property controls the appearance of the character,
+such as its font and color. @xref{Faces}. The value of the property
+can be the following:
@itemize @bullet
@item
A face name (a symbol or string).
@item
-A property list of face attributes. This has the
-form (@var{keyword} @var{value} @dots{}), where each @var{keyword} is a
-face attribute name and @var{value} is a meaningful value for that
-attribute. With this feature, you do not need to create a face each
-time you want to specify a particular attribute for certain text.
-@xref{Face Attributes}.
-@end itemize
+A property list of face attributes. This has the form (@var{keyword}
+@var{value} @dots{}), where each @var{keyword} is a face attribute
+name and @var{value} is a meaningful value for that attribute. With
+this feature, you do not need to create a face each time you want to
+specify a particular attribute for certain text.
-@code{face} can also be a list, where each element uses one of the
-forms listed above.
+@item
+A list of faces. This specifies a face which is an aggregate of the
+attributes of each of the listed faces. Faces occurring earlier in
+the list have higher priority. Each list element must have one of the
+two above forms (i.e.@: either a face name or a property list of face
+attributes).
+@end itemize
Font Lock mode (@pxref{Font Lock Mode}) works in most buffers by
dynamically updating the @code{face} property of characters based on
@@ -3160,21 +3186,41 @@ Consecutive characters with the same @code{field} property constitute a
@item cursor
@kindex cursor @r{(text property)}
-Normally, the cursor is displayed at the end of any overlay and text
-property strings present at the current buffer position. You can
-place the cursor on any desired character of these strings by giving
-that character a non-@code{nil} @code{cursor} text property. In
-addition, if the value of the @code{cursor} property of an overlay
-string is an integer number, it specifies the number of buffer's
-character positions associated with the overlay string; this way,
-Emacs will display the cursor on the character with that property
-regardless of whether the current buffer position is actually covered
-by the overlay. Specifically, if the value of the @code{cursor}
-property of a character is the number @var{n}, the cursor will be
-displayed on this character for any buffer position in the range
-@code{[@var{ovpos}..@var{ovpos}+@var{n}]}, where @var{ovpos} is the
-starting buffer position covered by the overlay (@pxref{Managing
-Overlays}).
+Normally, the cursor is displayed at the beginning or the end of any
+overlay and text property strings present at the current buffer
+position. You can place the cursor on any desired character of these
+strings by giving that character a non-@code{nil} @code{cursor} text
+property. In addition, if the value of the @code{cursor} property is
+an integer number, it specifies the number of buffer's character
+positions, starting with the position where the overlay or the
+@code{display} property begins, for which the cursor should be
+displayed on that character. Specifically, if the value of the
+@code{cursor} property of a character is the number @var{n}, the
+cursor will be displayed on this character for any buffer position in
+the range @code{[@var{ovpos}..@var{ovpos}+@var{n})}, where @var{ovpos}
+is the overlay's starting position given by @code{overlay-start}
+(@pxref{Managing Overlays}), or the position where the @code{display}
+text property begins in the buffer.
+
+In other words, the string character with the @code{cursor} property
+of any non-@code{nil} value is the character where to display the
+cursor. The value of the property says for which buffer positions to
+display the cursor there. If the value is an integer number @var{n},
+the cursor is displayed there when point is anywhere between the
+beginning of the overlay or @code{display} property and @var{n}
+positions after that. If the value is anything else and
+non-@code{nil}, the cursor is displayed there only when point is at
+the beginning of the @code{display} property or at
+@code{overlay-start}.
+
+@cindex cursor position for @code{display} properties and overlays
+When the buffer has many overlay strings (e.g., @pxref{Overlay
+Properties, before-string}) or @code{display} properties that are
+strings, it is a good idea to use the @code{cursor} property on these
+strings to cue the Emacs display about the places where to put the
+cursor while traversing these strings. This directly communicates to
+the display engine where the Lisp program wants to put the cursor, or
+where the user would expect the cursor.
@item pointer
@kindex pointer @r{(text property)}
@@ -3353,20 +3399,20 @@ of the text.
@node Sticky Properties
@subsection Stickiness of Text Properties
@cindex sticky text properties
-@cindex inheritance of text properties
+@cindex inheritance, text property
Self-inserting characters normally take on the same properties as the
preceding character. This is called @dfn{inheritance} of properties.
- In a Lisp program, you can do insertion with inheritance or without,
-depending on your choice of insertion primitive. The ordinary text
-insertion functions such as @code{insert} do not inherit any properties.
-They insert text with precisely the properties of the string being
-inserted, and no others. This is correct for programs that copy text
-from one context to another---for example, into or out of the kill ring.
-To insert with inheritance, use the special primitives described in this
-section. Self-inserting characters inherit properties because they work
-using these primitives.
+ A Lisp program can do insertion with inheritance or without,
+depending on the choice of insertion primitive. The ordinary text
+insertion functions, such as @code{insert}, do not inherit any
+properties. They insert text with precisely the properties of the
+string being inserted, and no others. This is correct for programs
+that copy text from one context to another---for example, into or out
+of the kill ring. To insert with inheritance, use the special
+primitives described in this section. Self-inserting characters
+inherit properties because they work using these primitives.
When you do insertion with inheritance, @emph{which} properties are
inherited, and from where, depends on which properties are @dfn{sticky}.
@@ -3466,7 +3512,7 @@ once for the same part of the buffer, you can use the variable
If this variable's value is non-@code{nil}, it is a symbol which is used
as a text property name. A non-@code{nil} value for that text property
means, ``the other text properties for this character have already been
-computed.''
+computed''.
If all the characters in the range specified for @code{buffer-substring}
have a non-@code{nil} value for this property, @code{buffer-substring}
@@ -3498,7 +3544,7 @@ properties. For simplicity, we will refer to the clickable text as a
@dfn{link}.
Implementing a link involves three separate steps: (1) indicating
-clickability when the mouse moves over the link; (2) making @kbd{RET}
+clickability when the mouse moves over the link; (2) making @key{RET}
or @kbd{Mouse-2} on that link do something; and (3) setting up a
@code{follow-link} condition so that the link obeys
@code{mouse-1-click-follows-link}.
@@ -3758,7 +3804,7 @@ closest to @var{new-pos} that is in the same field as @var{old-pos}.
If @var{new-pos} is @code{nil}, then @code{constrain-to-field} uses
the value of point instead, and moves point to the resulting position
-as well as returning it.
+in addition to returning that position.
If @var{old-pos} is at the boundary of two fields, then the acceptable
final positions depend on the argument @var{escape-from-edge}. If
@@ -3770,7 +3816,7 @@ after @var{old-pos}.) If @var{escape-from-edge} is non-@code{nil},
@var{new-pos} can be anywhere in the two adjacent fields.
Additionally, if two fields are separated by another field with the
special value @code{boundary}, then any point within this special
-field is also considered to be ``on the boundary.''
+field is also considered to be ``on the boundary''.
Commands like @kbd{C-a} with no argument, that normally move backward
to a specific kind of location and stay there once there, probably
@@ -3991,7 +4037,7 @@ changed in the future.
@node Transposition
@section Transposition of Text
- This subroutine is used by the transposition commands.
+ This function can be used to transpose stretches of text:
@defun transpose-regions start1 end1 start2 end2 &optional leave-markers
This function exchanges two nonoverlapping portions of the buffer.
@@ -4036,7 +4082,7 @@ text, to avoid overlong lines. However, if the optional argument
the output is just one long line.
@end deffn
-@deffn Command base64-encode-string string &optional no-line-break
+@defun base64-encode-string string &optional no-line-break
This function converts the string @var{string} into base 64 code. It
returns a string containing the encoded text. As for
@code{base64-encode-region}, an error is signaled if a character in the
@@ -4046,15 +4092,15 @@ Normally, this function inserts newline characters into the encoded
text, to avoid overlong lines. However, if the optional argument
@var{no-line-break} is non-@code{nil}, these newlines are not added, so
the result string is just one long line.
-@end deffn
+@end defun
-@defun base64-decode-region beg end
+@deffn Command base64-decode-region beg end
This function converts the region from @var{beg} to @var{end} from base
64 code into the corresponding decoded text. It returns the length of
the decoded text.
The decoding functions ignore newline characters in the encoded text.
-@end defun
+@end deffn
@defun base64-decode-string string
This function converts the string @var{string} from base 64 code into
@@ -4064,47 +4110,67 @@ decoded text.
The decoding functions ignore newline characters in the encoded text.
@end defun
-@node MD5 Checksum
-@section MD5 Checksum
+@node Checksum/Hash
+@section Checksum/Hash
@cindex MD5 checksum
-@cindex message digest computation
-
- MD5 cryptographic checksums, or @dfn{message digests}, are 128-bit
-``fingerprints'' of a document or program. They are used to verify
-that you have an exact and unaltered copy of the data. The algorithm
-to calculate the MD5 message digest is defined in Internet
-RFC@footnote{
-For an explanation of what is an RFC, see the footnote in @ref{Base
-64}.
-}1321. This section describes the Emacs facilities for computing
-message digests.
-
-@defun md5 object &optional start end coding-system noerror
-This function returns the MD5 message digest of @var{object}, which
-should be a buffer or a string.
+@cindex SHA hash
+@cindex hash, cryptographic
+@cindex cryptographic hash
+
+ Emacs has built-in support for computing @dfn{cryptographic hashes}.
+A cryptographic hash, or @dfn{checksum}, is a digital ``fingerprint''
+of a piece of data (e.g.@: a block of text) which can be used to check
+that you have an unaltered copy of that data.
+
+@cindex message digest
+ Emacs supports several common cryptographic hash algorithms: MD5,
+SHA-1, SHA-2, SHA-224, SHA-256, SHA-384 and SHA-512. MD5 is the
+oldest of these algorithms, and is commonly used in @dfn{message
+digests} to check the integrity of messages transmitted over a
+network. MD5 is not ``collision resistant'' (i.e.@: it is possible to
+deliberately design different pieces of data which have the same MD5
+hash), so you should not used it for anything security-related. A
+similar theoretical weakness also exists in SHA-1. Therefore, for
+security-related applications you should use the other hash types,
+such as SHA-2.
+
+@defun secure-hash algorithm object &optional start end binary
+This function returns a hash for @var{object}. The argument
+@var{algorithm} is a symbol stating which hash to compute: one of
+@code{md5}, @code{sha1}, @code{sha224}, @code{sha256}, @code{sha384}
+or @code{sha512}. The argument @var{object} should be a buffer or a
+string.
-The two optional arguments @var{start} and @var{end} are character
+The optional arguments @var{start} and @var{end} are character
positions specifying the portion of @var{object} to compute the
-message digest for. If they are @code{nil} or omitted, the digest is
+message digest for. If they are @code{nil} or omitted, the hash is
computed for the whole of @var{object}.
-The function @code{md5} does not compute the message digest directly
-from the internal Emacs representation of the text (@pxref{Text
-Representations}). Instead, it encodes the text using a coding
-system, and computes the message digest from the encoded text. The
-optional fourth argument @var{coding-system} specifies which coding
-system to use for encoding the text. It should be the same coding
-system that you used to read the text, or that you used or will use
-when saving or sending the text. @xref{Coding Systems}, for more
-information about coding systems.
-
-If @var{coding-system} is @code{nil} or omitted, the default depends
-on @var{object}. If @var{object} is a buffer, the default for
-@var{coding-system} is whatever coding system would be chosen by
-default for writing this text into a file. If @var{object} is a
-string, the user's most preferred coding system (@pxref{Recognize
-Coding, prefer-coding-system, the description of
-@code{prefer-coding-system}, emacs, GNU Emacs Manual}) is used.
+If the argument @var{binary} is omitted or @code{nil}, the function
+returns the @dfn{text form} of the hash, as an ordinary Lisp string.
+If @var{binary} is non-@code{nil}, it returns the hash in @dfn{binary
+form}, as a sequence of bytes stored in a unibyte string.
+
+This function does not compute the hash directly from the internal
+representation of @var{object}'s text (@pxref{Text Representations}).
+Instead, it encodes the text using a coding system (@pxref{Coding
+Systems}), and computes the hash from that encoded text. If
+@var{object} is a buffer, the coding system used is the one which
+would be chosen by default for writing the text into a file. If
+@var{object} is a string, the user's preferred coding system is used
+(@pxref{Recognize Coding,,, emacs, GNU Emacs Manual}).
+@end defun
+
+@defun md5 object &optional start end coding-system noerror
+This function returns an MD5 hash. It is semi-obsolete, since for
+most purposes it is equivalent to calling @code{secure-hash} with
+@code{md5} as the @var{algorithm} argument. The @var{object},
+@var{start} and @var{end} arguments have the same meanings as in
+@code{secure-hash}.
+
+If @var{coding-system} is non-@code{nil}, it specifies a coding system
+to use to encode the text; if omitted or @code{nil}, the default
+coding system is used, like in @code{secure-hash}.
Normally, @code{md5} signals an error if the text can't be encoded
using the specified or chosen coding system. However, if
@@ -4112,55 +4178,53 @@ using the specified or chosen coding system. However, if
coding instead.
@end defun
-@node Parsing HTML
-@section Parsing HTML
+@node Parsing HTML/XML
+@section Parsing HTML and XML
@cindex parsing html
+When Emacs is compiled with libxml2 support, the following functions
+are available to parse HTML or XML text into Lisp object trees.
+
@defun libxml-parse-html-region start end &optional base-url
-This function provides HTML parsing via the @code{libxml2} library.
-It parses ``real world'' HTML and tries to return a sensible parse tree
-regardless.
+This function parses the text between @var{start} and @var{end} as
+HTML, and returns a list representing the HTML @dfn{parse tree}. It
+attempts to handle ``real world'' HTML by robustly coping with syntax
+mistakes.
+
+The optional argument @var{base-url}, if non-@code{nil}, should be a
+string specifying the base URL for relative URLs occurring in links.
-In addition to @var{start} and @var{end} (specifying the start and end
-of the region to act on), it takes an optional parameter,
-@var{base-url}, which is used to expand relative URLs in the document,
-if any.
+In the parse tree, each HTML node is represented by a list in which
+the first element is a symbol representing the node name, the second
+element is an alist of node attributes, and the remaining elements are
+the subnodes.
-Here's an example demonstrating the structure of the parsed data you
-get out. Given this HTML document:
+The following example demonstrates this. Given this (malformed) HTML
+document:
@example
-<html><hEad></head><body width=101><div class=thing>Foo<div>Yes
+<html><head></head><body width=101><div class=thing>Foo<div>Yes
@end example
-You get this parse tree:
+@noindent
+A call to @code{libxml-parse-html-region} returns this:
@example
-(html
- (head)
- (body
- (:width . "101")
- (div
- (:class . "thing")
- (text . "Foo")
- (div
- (text . "Yes\n")))))
+(html ()
+ (head ())
+ (body ((width . "101"))
+ (div ((class . "thing"))
+ "Foo"
+ (div ()
+ "Yes"))))
@end example
-
-It's a simple tree structure, where the @code{car} for each node is
-the name of the node, and the @code{cdr} is the value, or the list of
-values.
-
-Attributes are coded the same way as child nodes, but with @samp{:} as
-the first character.
@end defun
@cindex parsing xml
@defun libxml-parse-xml-region start end &optional base-url
-
-This is much the same as @code{libxml-parse-html-region} above, but
-operates on XML instead of HTML, and is correspondingly stricter about
-syntax.
+This function is the same as @code{libxml-parse-html-region}, except
+that it parses the text as XML rather than HTML (so it is stricter
+about syntax).
@end defun
@node Atomic Changes
@@ -4277,18 +4341,18 @@ buffer that is about to change is always the current buffer.
@defvar after-change-functions
This variable holds a list of functions to call after any buffer
-modification. Each function receives three arguments: the beginning and
-end of the region just changed, and the length of the text that existed
-before the change. All three arguments are integers. The buffer that's
-about to change is always the current buffer.
-
-The length of the old text is the difference between the buffer positions
-before and after that text as it was before the change. As for the
-changed text, its length is simply the difference between the first two
-arguments.
+modification. Each function receives three arguments: the beginning
+and end of the region just changed, and the length of the text that
+existed before the change. All three arguments are integers. The
+buffer has been changed is always the current buffer.
+
+The length of the old text is the difference between the buffer
+positions before and after that text as it was before the change. As
+for the changed text, its length is simply the difference between the
+first two arguments.
@end defvar
- Output of messages into the @samp{*Messages*} buffer does not
+ Output of messages into the @file{*Messages*} buffer does not
call these functions.
@defmac combine-after-change-calls body@dots{}
diff --git a/doc/lispref/tindex.pl b/doc/lispref/tindex.pl
deleted file mode 100755
index 5c9b88f57b2..00000000000
--- a/doc/lispref/tindex.pl
+++ /dev/null
@@ -1,124 +0,0 @@
-#! /usr/bin/perl
-
-# Copyright (C) 2000-2011 Free Software Foundation, Inc.
-
-# 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/>.
-
-
-require 5;
-use Getopt::Long;
-
-my $USAGE = <<ENDUSAGE;
-Remove \@tindex lines from files that were already present in previous
-versions.
-
-Usage: $0 [--old=EXT] FILE...
- $0 --help
- $0 --version
-
- --help display this help and exit
- --version print version and exit
- --old=DIR find old files in DIR
-
-The script performs two passes. In the first pass, Texinfo files from
-DIR are scanned for \@tindex lines, and identifiers in them are
-recorded. In a second pass, Texinfo files in the current directory
-are scanned, and \@tindex lines for identifiers that were recorded in
-the first pass are removed. Old file contents are saved in files
-with extension ".orig". A list of modified files and removed \@tindex
-identifiers is printed to stdout at the end.
-ENDUSAGE
-
-sub fatal {
- print STDERR "$0: ", @_, ".\n";
- exit 1;
-}
-
-my $help = 0;
-my $version = 0;
-my $old;
-
-my $rc = GetOptions ('help' => \$help, 'version' => \$version,
- 'old=s' => \$old);
-if ($version) {
- print "0.1\n";
- exit 0;
-} elsif (!$rc || !$old || @ARGV) {
- print $USAGE;
- exit 1;
-} elsif ($help) {
- print $USAGE;
- exit 0;
-}
-
-# Fill the hash %tindex with associations VAR -> COUNT where
-# the keys VAR are identifiers mentioned in @tindex lines in the older
-# files to process and COUNT is the number of times they are seen in
-# the files.
-
-my %tindex;
-my %removed;
-my @old_files = glob "$old/*.texi";
-my @new_files = glob "*.texi";
-fatal ("No Texinfo files found in `$old'") unless @old_files;
-fatal ("No Texinfo files found in current directory") unless @new_files;
-
-print "Scanning old files for \@tindex lines\n";
-foreach $file (@old_files) {
- open (IN, "<$file") or fatal "Cannot open $file: $!";
- while (<IN>) {
- ++$tindex{$1} if /^\s*\@tindex\s+(\S+)/;
- }
- close IN;
-}
-
-# Process current files and remove those @tindex lines which we
-# know were already present in the files scanned above.
-
-print "Removing old \@tindex lines\n";
-foreach $file (@new_files) {
- my $modified = 0;
- my $contents = "";
-
- open (IN, "< $file") or fatal "Cannot open $file.orig for reading: $!";
- while (<IN>) {
- if (/^\s*\@tindex\s+(\S+)/ && $tindex{$1}) {
- ++$removed{$1};
- $modified = 1;
- } else {
- $contents = $contents . $_;
- }
- }
-
- close IN;
-
- if ($modified) {
- print " $file\n";
- system ("cp $file $file.orig") == 0 or fatal "Cannot backup $file: $!";
- open (OUT, ">$file") or fatal "Cannot open $file for writing: $!";
- print OUT $contents;
- close OUT;
- }
-}
-
-# Print a list of identifiers removed.
-
-print "Removed \@tindex commands for:\n";
-my $key;
-foreach $key (keys %removed) {
- print " $key\n";
-}
-
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index fd875b45be9..bba416d5614 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -1,10 +1,9 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1993, 1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1993, 1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/tips
-@node Tips, GNU Emacs Internals, GPL, Top
+@node Tips
@appendix Tips and Conventions
@cindex tips for writing Lisp
@cindex standards of coding style
@@ -58,7 +57,7 @@ Separate the prefix from the rest of the name with a hyphen, @samp{-}.
This practice helps avoid name conflicts, since all global variables
in Emacs Lisp share the same name space, and all functions share
another name space@footnote{The benefits of a Common Lisp-style
-package system are considered not to outweigh the costs.}
+package system are considered not to outweigh the costs.}.
Occasionally, for a command name intended for users to use, it is more
convenient if some words come before the package's name prefix. And
@@ -110,15 +109,29 @@ called before the first use of the macro in the file. @xref{Compiling
Macros}.
@item
-Please don't require the @code{cl} package of Common Lisp extensions at
-run time. Use of this package is optional, and it is not part of the
-standard Emacs namespace. If your package loads @code{cl} at run time,
-that could cause name clashes for users who don't use that package.
+Avoid loading additional libraries at run time unless they are really
+needed. If your file simply cannot work without some other library,
+then just @code{require} that library at the top-level and be done
+with it. But if your file contains several independent features, and
+only one or two require the extra library, then consider putting
+@code{require} statements inside the relevant functions rather than at
+the top-level. Or use @code{autoload} statements to load the extra
+library when needed. This way people who don't use those aspects of
+your file do not need to load the extra library.
-However, there is no problem with using the @code{cl} package at
-compile time, with @code{(eval-when-compile (require 'cl))}. That's
+@item
+If you need Common Lisp extensions, use the @code{cl-lib} library
+rather than the old @code{cl} library. The latter does not
+use a clean namespace (i.e., its definitions do not
+start with a @samp{cl-} prefix). If your package loads @code{cl} at
+run time, that could cause name clashes for users who don't use that
+package.
+
+There is no problem with using the @code{cl} package at @emph{compile}
+time, with @code{(eval-when-compile (require 'cl))}. That's
sufficient for using the macros in the @code{cl} package, because the
-compiler expands them before generating the byte-code.
+compiler expands them before generating the byte-code. It is still
+better to use the more modern @code{cl-lib} in this case, though.
@item
When defining a major mode, please follow the major mode
@@ -194,11 +207,8 @@ replacements differs from that of the originals.
@item
Constructs that define a function or variable should be macros,
-not functions, and their names should start with @samp{def}.
-
-@item
-A macro that defines a function or variable should have a name that
-starts with @samp{define-}. The macro should receive the name to be
+not functions, and their names should start with @samp{define-}.
+The macro should receive the name to be
defined as the first argument. That will help various tools find the
definition automatically. Avoid constructing the names in the macro
itself, since that would confuse these tools.
@@ -207,7 +217,7 @@ itself, since that would confuse these tools.
In some other systems there is a convention of choosing variable names
that begin and end with @samp{*}. We don't use that convention in Emacs
Lisp, so please don't use it in your programs. (Emacs uses such names
-only for special-purpose buffers.) The users will find Emacs more
+only for special-purpose buffers.) People will find Emacs more
coherent if all libraries use the same conventions.
@item
@@ -216,7 +226,7 @@ constants, you should make sure Emacs always decodes these characters
the same way, regardless of the user's settings. The easiest way to
do this is to use the coding system @code{utf-8-emacs} (@pxref{Coding
System Basics}), and specify that coding in the @samp{-*-} line or the
-local variables list. @xref{File variables, , Local Variables in
+local variables list. @xref{File Variables, , Local Variables in
Files, emacs, The GNU Emacs Manual}.
@example
@@ -224,8 +234,7 @@ Files, emacs, The GNU Emacs Manual}.
@end example
@item
-Indent each function with @kbd{C-M-q} (@code{indent-sexp}) using the
-default indentation parameters.
+Indent the file using the default indentation parameters.
@item
Don't make a habit of putting close-parentheses on lines by
@@ -233,29 +242,8 @@ themselves; Lisp programmers find this disconcerting.
@item
Please put a copyright notice and copying permission notice on the
-file if you distribute copies. Use a notice like this one:
-
-@smallexample
-;; Copyright (C) @var{year} @var{name}
-
-;; 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.
+file if you distribute copies. @xref{Library Headers}.
-;; 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/>.
-@end smallexample
-
-If you have signed papers to assign the copyright to the Foundation,
-then use @samp{Free Software Foundation, Inc.} as @var{name}.
-Otherwise, use your name. @xref{Library Headers}.
@end itemize
@node Key Binding Conventions
@@ -324,11 +312,11 @@ Similarly, don't bind a key sequence ending in @key{C-g}, since that
is commonly used to cancel a key sequence.
@item
-Anything which acts like a temporary mode or state which the user can
+Anything that acts like a temporary mode or state that the user can
enter and leave should define @kbd{@key{ESC} @key{ESC}} or
@kbd{@key{ESC} @key{ESC} @key{ESC}} as a way to escape.
-For a state which accepts ordinary Emacs commands, or more generally any
+For a state that accepts ordinary Emacs commands, or more generally any
kind of state in which @key{ESC} followed by a function key or arrow key
is potentially meaningful, then you must not define @kbd{@key{ESC}
@key{ESC}}, since that would preclude recognizing an escape sequence
@@ -398,8 +386,8 @@ An error message should start with a capital letter but should not end
with a period.
@item
-A question asked in the minibuffer with @code{y-or-n-p} or
-@code{yes-or-no-p} should start with a capital letter and end with
+A question asked in the minibuffer with @code{yes-or-no-p} or
+@code{y-or-n-p} should start with a capital letter and end with
@samp{? }.
@item
@@ -457,10 +445,9 @@ to generate such messages.
@item
Try to avoid using recursive edits. Instead, do what the Rmail @kbd{e}
-command does: use a new local keymap that contains one command defined
-to switch back to the old local keymap. Or do what the
-@code{edit-options} command does: switch to another buffer and let the
-user switch back at will. @xref{Recursive Editing}.
+command does: use a new local keymap that contains a command defined
+to switch back to the old local keymap. Or simply switch to another
+buffer and let the user switch back at will. @xref{Recursive Editing}.
@end itemize
@node Compilation Tips
@@ -473,18 +460,8 @@ Lisp programs.
@itemize @bullet
@item
-@cindex profiling
-@cindex timing programs
-@cindex @file{elp.el}
-Profile your program with the @file{elp} library. See the file
-@file{elp.el} for instructions.
-
-@item
-@cindex @file{benchmark.el}
-@cindex benchmarking
-Check the speed of individual Emacs Lisp forms using the
-@file{benchmark} library. See the functions @code{benchmark-run} and
-@code{benchmark-run-compiled} in @file{benchmark.el}.
+Profile your program, to find out where the time is being spent.
+@xref{Profiling}.
@item
Use iteration rather than recursion whenever possible.
@@ -515,6 +492,10 @@ compiled specially (@pxref{Array Functions}):
@end group
@end example
+@noindent
+Note that in this case (and many others), you must first load the
+@file{bytecomp} library, which defines the @code{byte-compile} property.
+
@item
If calling a small function accounts for a substantial part of your
program's running time, make the function inline. This eliminates
@@ -541,6 +522,11 @@ Such a definition has no effect except to tell the compiler
not to warn about uses of the variable @code{foo} in this file.
@item
+Similarly, to avoid a compiler warning about an undefined function
+that you know @emph{will} be defined, use a @code{declare-function}
+statement (@pxref{Declaring Functions}).
+
+@item
If you use many functions and variables from a certain file, you can
add a @code{require} for that package to avoid compilation warnings
for them. For instance,
@@ -561,8 +547,8 @@ functions and variables in your package.
@item
The last resort for avoiding a warning, when you want to do something
-that usually is a mistake but it's not a mistake in this one case,
-is to put a call to @code{with-no-warnings} around it.
+that is usually a mistake but you know is not a mistake in your usage,
+is to put it inside @code{with-no-warnings}. @xref{Compiler Errors}.
@end itemize
@node Documentation Tips
@@ -580,11 +566,9 @@ Every command, function, or variable intended for users to know about
should have a documentation string.
@item
-An internal variable or subroutine of a Lisp program might as well have
-a documentation string. In earlier Emacs versions, you could save space
-by using a comment instead of a documentation string, but that is no
-longer the case---documentation strings now take up very little space in
-a running Emacs.
+An internal variable or subroutine of a Lisp program might as well
+have a documentation string. Documentation strings take up very
+little space in a running Emacs.
@item
Format the documentation string so that it fits in an Emacs window on an
@@ -595,14 +579,14 @@ or it will look bad in the output of @code{apropos}.
You can fill the text if that looks good. However, rather than blindly
filling the entire documentation string, you can often make it much more
readable by choosing certain line breaks with care. Use blank lines
-between topics if the documentation string is long.
+between sections if the documentation string is long.
@item
The first line of the documentation string should consist of one or two
complete sentences that stand on their own as a summary. @kbd{M-x
apropos} displays just the first line, and if that line's contents don't
stand on their own, the result looks bad. In particular, start the
-first line with a capital letter and end with a period.
+first line with a capital letter and end it with a period.
For a function, the first line should briefly answer the question,
``What does this function do?'' For a variable, the first line should
@@ -630,7 +614,7 @@ important arguments.
When a function's documentation string mentions the value of an argument
of the function, use the argument name in capital letters as if it were
a name for that value. Thus, the documentation string of the function
-@code{eval} refers to its second argument as @samp{FORM}, because the
+@code{eval} refers to its first argument as @samp{FORM}, because the
actual argument name is @code{form}:
@example
@@ -649,12 +633,12 @@ have the form (KEY . VALUE). Here, KEY is ...
@item
Never change the case of a Lisp symbol when you mention it in a doc
-string. If the symbol's name is @code{foo}, write ``foo,'' not
+string. If the symbol's name is @code{foo}, write ``foo'', not
``Foo'' (which is a different symbol).
This might appear to contradict the policy of writing function
argument values, but there is no real contradiction; the argument
-@emph{value} is not the same thing as the @emph{symbol} which the
+@emph{value} is not the same thing as the @emph{symbol} that the
function uses to hold the value.
If this puts a lower-case letter at the beginning of a sentence
@@ -781,9 +765,9 @@ is indicative and has a proper subject.
@item
The documentation string for a function that is a yes-or-no predicate
-should start with words such as ``Return t if,'' to indicate
-explicitly what constitutes ``truth.'' The word ``return'' avoids
-starting the sentence with lower-case ``t,'' which could be somewhat
+should start with words such as ``Return t if'', to indicate
+explicitly what constitutes ``truth''. The word ``return'' avoids
+starting the sentence with lower-case ``t'', which could be somewhat
distracting.
@item
@@ -806,8 +790,8 @@ returned.''
@item
Avoid using the word ``cause'' (or its equivalents) unnecessarily.
-Instead of, ``Cause Emacs to display text in boldface,'' write just
-``Display text in boldface.''
+Instead of, ``Cause Emacs to display text in boldface'', write just
+``Display text in boldface''.
@item
Avoid using ``iff'' (a mathematics term meaning ``if and only if''),
@@ -825,14 +809,12 @@ In Dired, visit the file or directory named on this line.
@end example
@item
-When you define a variable that users ought to set interactively, you
-normally should use @code{defcustom}. However, if for some reason you
-use @code{defvar} instead, start the doc string with a @samp{*}.
-@xref{Defining Variables}.
+When you define a variable that represents an option users might want
+to set, use @code{defcustom}. @xref{Defining Variables}.
@item
The documentation string for a variable that is a yes-or-no flag should
-start with words such as ``Non-nil means,'' to make it clear that
+start with words such as ``Non-nil means'', to make it clear that
all non-@code{nil} values are equivalent and indicate explicitly what
@code{nil} and non-@code{nil} mean.
@end itemize
@@ -841,19 +823,14 @@ all non-@code{nil} values are equivalent and indicate explicitly what
@section Tips on Writing Comments
@cindex comments, Lisp convention for
- We recommend these conventions for where to put comments and how to
-indent them:
+ We recommend these conventions for comments:
@table @samp
@item ;
Comments that start with a single semicolon, @samp{;}, should all be
aligned to the same column on the right of the source code. Such
-comments usually explain how the code on the same line does its job. In
-Lisp mode and related modes, the @kbd{M-;} (@code{indent-for-comment})
-command automatically inserts such a @samp{;} in the right place, or
-aligns such a comment if it is already present.
-
-This and following examples are taken from the Emacs sources.
+comments usually explain how the code on that line does its job.
+For example:
@smallexample
@group
@@ -875,7 +852,7 @@ at that point. For example:
(prog1 (setq auto-fill-function
@dots{}
@dots{}
- ;; update mode line
+ ;; Update mode line.
(force-mode-line-update)))
@end group
@end smallexample
@@ -884,17 +861,17 @@ We also normally use two semicolons for comments outside functions.
@smallexample
@group
-;; This Lisp code is run in Emacs
-;; when it is to operate as a server
-;; for other processes.
+;; This Lisp code is run in Emacs when it is to operate as
+;; a server for other processes.
@end group
@end smallexample
-Every function that has no documentation string (presumably one that is
-used only internally within the package it belongs to), should instead
-have a two-semicolon comment right before the function, explaining what
-the function does and how to call it properly. Explain precisely what
-each argument means and how the function interprets its possible values.
+If a function has no documentation string, it should instead have a
+two-semicolon comment right before the function, explaining what the
+function does and how to call it properly. Explain precisely what
+each argument means and how the function interprets its possible
+values. It is much better to convert such comments to documentation
+strings, though.
@item ;;;
Comments that start with three semicolons, @samp{;;;}, should start at
@@ -905,7 +882,7 @@ semicolons depends on whether the comment should be considered a
``heading'' by Outline minor mode. By default, comments starting with
at least three semicolons (followed by a single space and a
non-whitespace character) are considered headings, comments starting
-with two or less are not.
+with two or fewer are not.
Another use for triple-semicolon comments is for commenting out lines
within a function. We use three semicolons for this precisely so that
@@ -936,11 +913,11 @@ program. For example:
@end table
@noindent
-The indentation commands of the Lisp modes in Emacs, such as @kbd{M-;}
-(@code{indent-for-comment}) and @key{TAB} (@code{lisp-indent-line}),
-automatically indent comments according to these conventions,
-depending on the number of semicolons. @xref{Comments,,
-Manipulating Comments, emacs, The GNU Emacs Manual}.
+Generally speaking, the @kbd{M-;} (@code{comment-dwim}) command
+automatically starts a comment of the appropriate type; or indents an
+existing comment to the right place, depending on the number of
+semicolons.
+@xref{Comments,, Manipulating Comments, emacs, The GNU Emacs Manual}.
@node Library Headers
@section Conventional Headers for Emacs Libraries
@@ -949,39 +926,28 @@ Manipulating Comments, emacs, The GNU Emacs Manual}.
Emacs has conventions for using special comments in Lisp libraries
to divide them into sections and give information such as who wrote
-them. This section explains these conventions.
-
- We'll start with an example, a package that is included in the Emacs
-distribution.
-
- Parts of this example reflect its status as part of Emacs; for
-example, the copyright notice lists the Free Software Foundation as the
-copyright holder, and the copying permission says the file is part of
-Emacs. When you write a package and post it, the copyright holder would
-be you (unless your employer claims to own it instead), and you should
-get the suggested copying permission from the end of the GNU General
-Public License itself. Don't say your file is part of Emacs
-if we haven't installed it in Emacs yet!
-
- With that warning out of the way, on to the example:
+them. Using a standard format for these items makes it easier for
+tools (and people) to extract the relevant information. This section
+explains these conventions, starting with an example:
@smallexample
@group
-;;; lisp-mnt.el --- minor mode for Emacs Lisp maintainers
+;;; foo.el --- Support for the Foo programming language
-;; Copyright (C) 1992 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Your Name
@end group
-;; Author: Eric S. Raymond <esr@@snark.thyrsus.com>
-;; Maintainer: Eric S. Raymond <esr@@snark.thyrsus.com>
-;; Created: 14 Jul 1992
-;; Version: 1.2
+;; Author: Your Name <yourname@@example.com>
+;; Maintainer: Someone Else <someone@@example.com>
+;; Created: 14 Jul 2010
@group
-;; Keywords: docs
+;; Keywords: languages
-;; This file is part of GNU Emacs.
+;; This file is not part of GNU Emacs.
+
+;; This file is free software@dots{}
@dots{}
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;; along with this file. If not, see <http://www.gnu.org/licenses/>.
@end group
@end smallexample
@@ -992,8 +958,19 @@ if we haven't installed it in Emacs yet!
@end example
@noindent
-The description should be complete in one line. If the file
+The description should be contained in one line. If the file
needs a @samp{-*-} specification, put it after @var{description}.
+If this would make the first line too long, use a Local Variables
+section at the end of the file.
+
+ The copyright notice usually lists your name (if you wrote the
+file). If you have an employer who claims copyright on your work, you
+might need to list them instead. Do not say that the copyright holder
+is the Free Software Foundation (or that the file is part of GNU
+Emacs) unless your file has been accepted into the Emacs distribution.
+For more information on the form of copyright and license notices, see
+@uref{http://www.gnu.org/licenses/gpl-howto.html, the guide on the GNU
+website}.
After the copyright notice come several @dfn{header comment} lines,
each beginning with @samp{;; @var{header-name}:}. Here is a table of
@@ -1001,55 +978,55 @@ the conventional possibilities for @var{header-name}:
@table @samp
@item Author
-This line states the name and net address of at least the principal
-author of the library.
-
-If there are multiple authors, you can list them on continuation lines
-led by @code{;;} and a tab character, like this:
+This line states the name and email address of at least the principal
+author of the library. If there are multiple authors, list them on
+continuation lines led by @code{;;} and whitespace (this is easier
+for tools to parse than having more than one author on one line).
+We recommend including a contact email address, of the form
+@samp{<@dots{}>}. For example:
@smallexample
@group
-;; Author: Ashwin Ram <Ram-Ashwin@@cs.yale.edu>
-;; Dave Sill <de5@@ornl.gov>
-;; Dave Brennan <brennan@@hal.com>
-;; Eric Raymond <esr@@snark.thyrsus.com>
+;; Author: Your Name <yourname@@example.com>
+;; Someone Else <someone@@example.com>
+;; Another Person <another@@example.com>
@end group
@end smallexample
@item Maintainer
-This line should contain a single name/address as in the Author line, or
-an address only, or the string @samp{FSF}. If there is no maintainer
-line, the person(s) in the Author field are presumed to be the
-maintainers. The example above is mildly bogus because the maintainer
-line is redundant.
-
-The idea behind the @samp{Author} and @samp{Maintainer} lines is to make
-possible a Lisp function to ``send mail to the maintainer'' without
-having to mine the name out by hand.
+This header has the same format as the Author header. It lists the
+person(s) who currently maintain(s) the file (respond to bug reports,
+etc.).
-Be sure to surround the network address with @samp{<@dots{}>} if
-you include the person's full name as well as the network address.
+If there is no maintainer line, the person(s) in the Author field
+is/are presumed to be the maintainers. Some files in Emacs use
+@samp{FSF} for the maintainer. This means that the original author is
+no longer responsible for the file, and that it is maintained as part
+of Emacs.
@item Created
-This optional line gives the original creation date of the
-file. For historical interest only.
+This optional line gives the original creation date of the file, and
+is for historical interest only.
@item Version
-If you wish to record version numbers for the individual Lisp program, put
-them in this line.
-
-@item Adapted-By
-In this header line, place the name of the person who adapted the
-library for installation (to make it fit the style conventions, for
-example).
+If you wish to record version numbers for the individual Lisp program,
+put them in this line. Lisp files distributed with Emacs generally do
+not have a @samp{Version} header, since the version number of Emacs
+itself serves the same purpose. If you are distributing a collection
+of multiple files, we recommend not writing the version in every file,
+but only the main one.
@item Keywords
This line lists keywords for the @code{finder-by-keyword} help command.
Please use that command to see a list of the meaningful keywords.
-This field is important; it's how people will find your package when
-they're looking for things by topic area. To separate the keywords, you
-can use spaces, commas, or both.
+This field is how people will find your package when they're looking
+for things by topic. To separate the keywords, you can use spaces,
+commas, or both.
+
+The name of this field is unfortunate, since people often assume it is
+the place to write arbitrary keywords that describe their package,
+rather than just the relevant Finder keywords.
@item Package-Version
If @samp{Version} is not suitable for use by the package manager, then
@@ -1062,7 +1039,7 @@ If this exists, it names packages on which the current package depends
for proper operation. @xref{Packaging Basics}. This is used by the
package manager both at download time (to ensure that a complete set
of packages is downloaded) and at activation time (to ensure that a
-package is activated if and only if all its dependencies have been).
+package is only activated if all its dependencies have been).
Its format is a list of lists. The @code{car} of each sub-list is the
name of a package, as a symbol. The @code{cadr} of each sub-list is
@@ -1083,8 +1060,8 @@ appropriate. You can also put in header lines with other header
names---they have no standard meanings, so they can't do any harm.
We use additional stylized comments to subdivide the contents of the
-library file. These should be separated by blank lines from anything
-else. Here is a table of them:
+library file. These should be separated from anything else by blank
+lines. Here is a table of them:
@table @samp
@item ;;; Commentary:
@@ -1094,16 +1071,12 @@ It should come right after the copying permissions, terminated by a
text is used by the Finder package, so it should make sense in that
context.
-@item ;;; Documentation:
-This was used in some files in place of @samp{;;; Commentary:},
-but it is deprecated.
-
@item ;;; Change Log:
-This begins change log information stored in the library file (if you
-store the change history there). For Lisp files distributed with Emacs,
-the change history is kept in the file @file{ChangeLog} and not in the
-source file at all; these files generally do not have a @samp{;;; Change
-Log:} line. @samp{History} is an alternative to @samp{Change Log}.
+This begins an optional log of changes to the file over time. Don't
+put too much information in this section---it is better to keep the
+detailed logs in a separate @file{ChangeLog} file (as Emacs does),
+and/or to use a version control system. @samp{History} is an
+alternative to @samp{Change Log}.
@item ;;; Code:
This begins the actual code of the program.
diff --git a/doc/lispref/two-volume-cross-refs.txt b/doc/lispref/two-volume-cross-refs.txt
index 6eb11a92f47..67b5dbf89a3 100644
--- a/doc/lispref/two-volume-cross-refs.txt
+++ b/doc/lispref/two-volume-cross-refs.txt
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See end for copying conditions.
Two Volume Cross References
diff --git a/doc/lispref/two-volume.make b/doc/lispref/two-volume.make
index 8949bfe0157..eb5c0e0193d 100644
--- a/doc/lispref/two-volume.make
+++ b/doc/lispref/two-volume.make
@@ -1,32 +1,45 @@
-# Copyright (C) 2007-2011 Free Software Foundation, Inc.
+# Copyright (C) 2007-2012 Free Software Foundation, Inc.
# See end for copying conditions.
# although it would be nice to use tex rather than pdftex to avoid
# colors, spurious warnings about names being referenced but not
# existing, etc., dvips | ps2pdf doesn't preserve the page size.
# Instead of creating a special dvips config file, put up with the warnings.
+# (Note added 2012/05: for me, using texlive-2007-57, pdftex
+# doesn't work for reason, but tex does.)
texinfodir=../misc
+emacsdir=../emacs
-tex = TEXINPUTS=".:$(texinfodir):${TEXINPUTS}" pdftex -interaction=nonstopmode
+tex = TEXINPUTS=".:$(texinfodir):${emacsdir}:${TEXINPUTS}" pdftex -interaction=nonstopmode
all: vol1.pdf vol2.pdf
-# vol1.texi and vol2.texi specially define \tocreadfilename so we can
-# use our premade .toc's.
+# There's probably a better way to do this, without using a temp file.
+# Something like:
+# tex -jobname=vol1 '\def\SETVOL1 \input{elisp.texi}'
+# but I don't know what to use for "\def\SETVOL1".
+tex1 = sed '/^@setfilename/a\
+@set VOL1' elisp.texi > elisp1tmp.tex && $(tex) -jobname=vol1 elisp1tmp.tex
+
+tex2 = sed '/^@setfilename/a\
+@set VOL2' elisp.texi > elisp2tmp.tex && $(tex) -jobname=vol2 elisp2tmp.tex
+
+# elisp.texi specially defines \tocreadfilename when VOL1 or VOL2 is
+# set, so we can use our premade .toc's.
#
vol1.pdf: elisp1med-fns-ready elisp1med-aux-ready elisp1med-toc-ready
@echo -e "\f Final TeX run for volume 1..."
cp elisp1med-toc-ready elisp1-toc-ready.toc
cp elisp1med-fns-ready vol1.fns
cp elisp1med-aux-ready vol1.aux
- $(tex) vol1.texi
+ $(tex1)
#
vol2.pdf: elisp2med-fns-ready elisp2med-aux-ready elisp2med-toc-ready
@echo "Final TeX run for volume 2..."
cp elisp2med-toc-ready elisp2-toc-ready.toc
cp elisp2med-fns-ready vol2.fns
cp elisp2med-aux-ready vol2.aux
- $(tex) vol2.texi
+ $(tex2)
# intermediate toc files.
#
@@ -104,7 +117,7 @@ elisp1med-init: elisp1-fns-ready elisp1-aux-ready elisp1init-toc-ready $(texinfo
cp elisp1init-toc-ready elisp1-toc-ready.toc
cp elisp1-fns-ready vol1.fns
cp elisp1-aux-ready vol1.aux
- $(tex) vol1.texi
+ $(tex1)
texindex vol1.??
mv vol1.aux elisp1med-aux
mv vol1.toc elisp1med-toc
@@ -114,7 +127,7 @@ elisp2med-init: elisp2-fns-ready elisp2-aux-ready elisp2init-toc-ready $(texinfo
cp elisp2init-toc-ready elisp2-toc-ready.toc
cp elisp2-fns-ready vol2.fns
cp elisp2-aux-ready vol2.aux
- $(tex) vol2.texi
+ $(tex2)
texindex vol2.??
mv vol2.aux elisp2med-aux
mv vol2.toc elisp2med-toc
@@ -188,19 +201,19 @@ elisp2-fn-vol-added: elisp2-init
# but we run texindex and TeX a second time just to get them closer.
# Otherwise it might take even longer for them to converge.
#
-elisp1-init: vol1.texi
+elisp1-init: elisp.texi
@echo -e "\f Initial TeX run for volume 1..."
rm -f vol1.aux vol1.toc
- $(tex) $<
+ $(tex1)
texindex vol1.??
mv vol1.aux elisp1-aux
mv vol1.toc elisp1-toc
touch $@
#
-elisp2-init: vol2.texi
+elisp2-init: elisp.texi
@echo "Initial TeX run for volume 2..."
rm -f vol2.aux vol2.toc
- $(tex) $<
+ $(tex2)
texindex vol2.??
mv vol2.aux elisp2-aux
mv vol2.toc elisp2-toc
diff --git a/doc/lispref/two.el b/doc/lispref/two.el
deleted file mode 100644
index b3a8666bcf2..00000000000
--- a/doc/lispref/two.el
+++ /dev/null
@@ -1,78 +0,0 @@
-;; Auxiliary functions for preparing a two volume manual.
-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
-
-;; --rjc 30mar92
-
-;; This file 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 file 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 file. If not, see <http://www.gnu.org/licenses/>.
-
-
-(defun volume-aux-markup (arg)
- "Append `vol. NUMBER' to page number.
-Apply to aux file that you save.
-Then insert marked file into other volume's .aux file."
- (interactive "sType volume number, 1 or 2: " )
- (goto-char (point-min))
- (while (search-forward "-pg" nil t)
- (end-of-line 1)
- (delete-backward-char 1 nil)
- (insert ", vol.'tie" arg "}")))
-
-(defun volume-index-markup (arg)
- "Prepend `NUMBER:' to page number. Use Roman Numeral.
-Apply only to unsorted index file,
-Then insert marked file into other volume's unsorted index file.
-Then run texindex on that file and save."
- (interactive
- "sType volume number, roman number I or II: " )
- (goto-char (point-min))
- (while (search-forward "\\entry" nil t)
- (search-forward "}{" (save-excursion (end-of-line) (point)) nil)
- (insert arg ":")))
-
-(defun volume-numbers-toc-markup (arg)
- (interactive
- "sType volume number, roman number I or II: " )
- (goto-char (point-min))
- (while (search-forward "chapentry" nil t)
- (end-of-line)
- (search-backward "{" nil t)
- (forward-char 1)
- (insert arg ":")))
-
-(defun volume-header-toc-markup ()
- "Insert Volume I and Volume II text into .toc file.
-NOTE: this auxiliary function is file specific.
-This is for the *Elisp Ref Manual*."
- (interactive)
- (goto-char (point-min))
- (insert "\\unnumbchapentry {Volume 1}{}\n\\unnumbchapentry {}{}\n")
- (search-forward "\\unnumbchapentry {Index}")
- (forward-line 1)
- (insert
- "\\unnumbchapentry {}{}\n\\unnumbchapentry {}{}\n\\unnumbchapentry {}{}\n\\unnumbchapentry {}{}\n\\unnumbchapentry {Volume 2}{}\n\\unnumbchapentry {}{}\n"))
-
-
-;;; In batch mode, you cannot call functions with args; hence this kludge:
-
-(defun volume-aux-markup-1 () (volume-aux-markup "1"))
-(defun volume-aux-markup-2 () (volume-aux-markup "2"))
-
-(defun volume-index-markup-I () (volume-index-markup "I"))
-(defun volume-index-markup-II () (volume-index-markup "II"))
-
-(defun volume-numbers-toc-markup-I () (volume-numbers-toc-markup "I"))
-(defun volume-numbers-toc-markup-II () (volume-numbers-toc-markup "II"))
-
-;;; two.el ends here
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 62f5092497a..dfde3c45c04 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -1,27 +1,26 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/variables
-@node Variables, Functions, Control Structures, Top
+@node Variables
@chapter Variables
@cindex variable
A @dfn{variable} is a name used in a program to stand for a value.
-Nearly all programming languages have variables of some sort. In the
-text of a Lisp program, variables are written using the syntax for
-symbols.
-
- In Lisp, unlike most programming languages, programs are represented
-primarily as Lisp objects and only secondarily as text. The Lisp
-objects used for variables are symbols: the symbol name is the
-variable name, and the variable's value is stored in the value cell of
-the symbol. The use of a symbol as a variable is independent of its
-use as a function name. @xref{Symbol Components}.
-
- The textual form of a Lisp program is given by the read syntax of
-the Lisp objects that constitute the program. Hence, a variable in a
-textual Lisp program is written using the read syntax for the symbol
+In Lisp, each variable is represented by a Lisp symbol
+(@pxref{Symbols}). The variable name is simply the symbol's name, and
+the variable's value is stored in the symbol's value cell@footnote{To
+be precise, under the default @dfn{dynamic binding} rules the value
+cell always holds the variable's current value, but this is not the
+case under @dfn{lexical binding} rules. @xref{Variable Scoping}, for
+details.}. @xref{Symbol Components}. In Emacs Lisp, the use of a
+symbol as a variable is independent of its use as a function name.
+
+ As previously noted in this manual, a Lisp program is represented
+primarily by Lisp objects, and only secondarily as text. The textual
+form of a Lisp program is given by the read syntax of the Lisp objects
+that constitute the program. Hence, the textual form of a variable in
+a Lisp program is written using the read syntax for the symbol
representing the variable.
@menu
@@ -42,6 +41,7 @@ representing the variable.
* Variable Aliases:: Variables that are aliases for other variables.
* Variables with Restricted Values:: Non-constant variables whose value can
@emph{not} be an arbitrary Lisp object.
+* Generalized Variables:: Extending the concept of variables.
@end menu
@node Global Variables
@@ -145,63 +145,63 @@ does not raise an error if you actually change it.
@cindex global binding
Global variables have values that last until explicitly superseded
-with new values. Sometimes it is useful to create variable values that
-exist temporarily---only until a certain part of the program finishes.
-These values are called @dfn{local}, and the variables so used are
-called @dfn{local variables}.
-
- For example, when a function is called, its argument variables receive
-new local values that last until the function exits. The @code{let}
-special form explicitly establishes new local values for specified
-variables; these last until exit from the @code{let} form.
-
-@cindex shadowing of variables
- Establishing a local value saves away the variable's previous value
-(or lack of one). We say that the previous value is @dfn{shadowed}
-and @dfn{not visible}. Both global and local values may be shadowed
-(@pxref{Scope}). After the life span of the local value is over, the
-previous value (or lack of one) is restored.
-
- If you set a variable (such as with @code{setq}) while it is local,
-this replaces the local value; it does not alter the global value, or
-previous local values, that are shadowed. To model this behavior, we
-speak of a @dfn{local binding} of the variable as well as a local value.
-
- The local binding is a conceptual place that holds a local value.
-Entering a function, or a special form such as @code{let}, creates the
-local binding; exiting the function or the @code{let} removes the
-local binding. While the local binding lasts, the variable's value is
-stored within it. Using @code{setq} or @code{set} while there is a
-local binding stores a different value into the local binding; it does
-not create a new binding.
+with new values. Sometimes it is useful to give a variable a
+@dfn{local value}---a value that takes effect only within a certain
+part of a Lisp program. When a variable has a local value, we say
+that it is @dfn{locally bound} to that value, and that it is a
+@dfn{local variable}.
+
+ For example, when a function is called, its argument variables
+receive local values, which are the actual arguments supplied to the
+function call; these local bindings take effect within the body of the
+function. To take another example, the @code{let} special form
+explicitly establishes local bindings for specific variables, which
+take effect within the body of the @code{let} form.
We also speak of the @dfn{global binding}, which is where
(conceptually) the global value is kept.
+@cindex shadowing of variables
+ Establishing a local binding saves away the variable's previous
+value (or lack of one). We say that the previous value is
+@dfn{shadowed}. Both global and local values may be shadowed. If a
+local binding is in effect, using @code{setq} on the local variable
+stores the specified value in the local binding. When that local
+binding is no longer in effect, the previously shadowed value (or lack
+of one) comes back.
+
@cindex current binding
- A variable can have more than one local binding at a time (for
-example, if there are nested @code{let} forms that bind it). In such a
-case, the most recently created local binding that still exists is the
-@dfn{current binding} of the variable. (This rule is called
-@dfn{dynamic scoping}; see @ref{Variable Scoping}.) If there are no
-local bindings, the variable's global binding is its current binding.
-We sometimes call the current binding the @dfn{most-local existing
-binding}, for emphasis. Ordinary evaluation of a symbol always returns
-the value of its current binding.
-
- The special forms @code{let} and @code{let*} exist to create
-local bindings.
+ A variable can have more than one local binding at a time (e.g.@: if
+there are nested @code{let} forms that bind the variable). The
+@dfn{current binding} is the local binding that is actually in effect.
+It determines the value returned by evaluating the variable symbol,
+and it is the binding acted on by @code{setq}.
+
+ For most purposes, you can think of the current binding as the
+``innermost'' local binding, or the global binding if there is no
+local binding. To be more precise, a rule called the @dfn{scoping
+rule} determines where in a program a local binding takes effect. The
+default scoping rule in Emacs Lisp is called @dfn{dynamic scoping},
+which simply states that the current binding at any given point in the
+execution of a program is the most recently-created binding for that
+variable that still exists. For details about dynamic scoping, and an
+alternative scoping rule called @dfn{lexical scoping}, @xref{Variable
+Scoping}.
+
+ The special forms @code{let} and @code{let*} exist to create local
+bindings:
@defspec let (bindings@dots{}) forms@dots{}
-This special form binds variables according to @var{bindings} and then
-evaluates all of the @var{forms} in textual order. The @code{let}-form
-returns the value of the last form in @var{forms}.
+This special form sets up local bindings for a certain set of
+variables, as specified by @var{bindings}, and then evaluates all of
+the @var{forms} in textual order. Its return value is the value of
+the last form in @var{forms}.
Each of the @var{bindings} is either @w{(i) a} symbol, in which case
-that symbol is bound to @code{nil}; or @w{(ii) a} list of the form
-@code{(@var{symbol} @var{value-form})}, in which case @var{symbol} is
-bound to the result of evaluating @var{value-form}. If @var{value-form}
-is omitted, @code{nil} is used.
+that symbol is locally bound to @code{nil}; or @w{(ii) a} list of the
+form @code{(@var{symbol} @var{value-form})}, in which case
+@var{symbol} is locally bound to the result of evaluating
+@var{value-form}. If @var{value-form} is omitted, @code{nil} is used.
All of the @var{value-form}s in @var{bindings} are evaluated in the
order they appear and @emph{before} binding any of the symbols to them.
@@ -213,6 +213,7 @@ Here is an example of this: @code{z} is bound to the old value of
(setq y 2)
@result{} 2
@end group
+
@group
(let ((y 1)
(z y))
@@ -226,15 +227,15 @@ Here is an example of this: @code{z} is bound to the old value of
This special form is like @code{let}, but it binds each variable right
after computing its local value, before computing the local value for
the next variable. Therefore, an expression in @var{bindings} can
-reasonably refer to the preceding symbols bound in this @code{let*}
-form. Compare the following example with the example above for
-@code{let}.
+refer to the preceding symbols bound in this @code{let*} form.
+Compare the following example with the example above for @code{let}.
@example
@group
(setq y 2)
@result{} 2
@end group
+
@group
(let* ((y 1)
(z y)) ; @r{Use the just-established value of @code{y}.}
@@ -262,7 +263,7 @@ Macro calls (@pxref{Macros}).
Variables}); a few variables have terminal-local bindings
(@pxref{Multiple Terminals}). These kinds of bindings work somewhat
like ordinary local bindings, but they are localized depending on
-``where'' you are in Emacs, rather than localized in time.
+``where'' you are in Emacs.
@defopt max-specpdl-size
@anchor{Definition of max-specpdl-size}
@@ -280,7 +281,7 @@ that Lisp avoids infinite recursion on an ill-defined function.
@code{max-lisp-eval-depth} provides another limit on depth of nesting.
@xref{Definition of max-lisp-eval-depth,, Eval}.
-The default value is 1000. Entry to the Lisp debugger increases the
+The default value is 1300. Entry to the Lisp debugger increases the
value, if there is little room left, to make sure the debugger itself
has room to execute.
@end defopt
@@ -290,46 +291,33 @@ has room to execute.
@cindex @code{void-variable} error
@cindex void variable
- If you have never given a symbol any value as a global variable, we
-say that that symbol's global value is @dfn{void}. In other words, the
-symbol's value cell does not have any Lisp object in it. If you try to
-evaluate the symbol, you get a @code{void-variable} error rather than
-a value.
-
- Note that a value of @code{nil} is not the same as void. The symbol
-@code{nil} is a Lisp object and can be the value of a variable just as any
-other object can be; but it is @emph{a value}. A void variable does not
-have any value.
-
- After you have given a variable a value, you can make it void once more
-using @code{makunbound}.
+ We say that a variable is void if its symbol has an unassigned value
+cell (@pxref{Symbol Components}). Under Emacs Lisp's default dynamic
+binding rules (@pxref{Variable Scoping}), the value cell stores the
+variable's current (local or global) value. Note that an unassigned
+value cell is @emph{not} the same as having @code{nil} in the value
+cell. The symbol @code{nil} is a Lisp object and can be the value of
+a variable, just as any other object can be; but it is still a value.
+If a variable is void, trying to evaluate the variable signals a
+@code{void-variable} error rather than a value.
+
+ Under lexical binding rules, the value cell only holds the
+variable's global value, i.e.@: the value outside of any lexical
+binding construct. When a variable is lexically bound, the local value
+is determined by the lexical environment; the variable may have a
+local value if its symbol's value cell is unassigned.
@defun makunbound symbol
-This function makes the current variable binding of @var{symbol} void.
-Subsequent attempts to use this symbol's value as a variable will signal
-the error @code{void-variable}, unless and until you set it again.
-
-@code{makunbound} returns @var{symbol}.
+This function empties out the value cell of @var{symbol}, making the
+variable void. It returns @var{symbol}.
-@example
-@group
-(makunbound 'x) ; @r{Make the global value of @code{x} void.}
- @result{} x
-@end group
-@group
-x
-@error{} Symbol's value as variable is void: x
-@end group
-@end example
+If @var{symbol} has a dynamic local binding, @code{makunbound} voids
+the current binding, and this voidness lasts only as long as the local
+binding is in effect. Afterwards, the previously shadowed local or
+global binding is reexposed; then the variable will no longer be void,
+unless the reexposed binding is void too.
-If @var{symbol} is locally bound, @code{makunbound} affects the most
-local existing binding. This is the only way a symbol can have a void
-local binding, since all the constructs that create local bindings
-create them with values. In this case, the voidness lasts at most as
-long as the binding does; when the binding is removed due to exit from
-the construct that made it, the previous local or global binding is
-reexposed as usual, and the variable is no longer void unless the newly
-reexposed binding was void all along.
+Here are some examples (assuming dynamic binding is in effect):
@smallexample
@group
@@ -361,17 +349,11 @@ x ; @r{The global binding is unchanged.}
@end smallexample
@end defun
- A variable that has been made void with @code{makunbound} is
-indistinguishable from one that has never received a value and has
-always been void.
-
- You can use the function @code{boundp} to test whether a variable is
-currently void.
-
@defun boundp variable
-@code{boundp} returns @code{t} if @var{variable} (a symbol) is not void;
-more precisely, if its current binding is not void. It returns
-@code{nil} otherwise.
+This function returns @code{t} if @var{variable} (a symbol) is not
+void, and @code{nil} if it is void.
+
+Here are some examples (assuming dynamic binding is in effect):
@smallexample
@group
@@ -402,52 +384,42 @@ more precisely, if its current binding is not void. It returns
@section Defining Global Variables
@cindex variable definition
- You may announce your intention to use a symbol as a global variable
-with a @dfn{variable definition}: a special form, either @code{defconst}
-or @code{defvar}.
-
- In Emacs Lisp, definitions serve three purposes. First, they inform
-people who read the code that certain symbols are @emph{intended} to be
-used a certain way (as variables). Second, they inform the Lisp system
-of these things, supplying a value and documentation. Third, they
-provide information to utilities such as @code{etags} and
-@code{make-docfile}, which create data bases of the functions and
-variables in a program.
-
- The difference between @code{defconst} and @code{defvar} is primarily
-a matter of intent, serving to inform human readers of whether the value
-should ever change. Emacs Lisp does not restrict the ways in which a
-variable can be used based on @code{defconst} or @code{defvar}
-declarations. However, it does make a difference for initialization:
-@code{defconst} unconditionally initializes the variable, while
-@code{defvar} initializes it only if it is void.
-
-@ignore
- One would expect user option variables to be defined with
-@code{defconst}, since programs do not change them. Unfortunately, this
-has bad results if the definition is in a library that is not preloaded:
-@code{defconst} would override any prior value when the library is
-loaded. Users would like to be able to set user options in their init
-files, and override the default values given in the definitions. For
-this reason, user options must be defined with @code{defvar}.
-@end ignore
+ A @dfn{variable definition} is a construct that announces your
+intention to use a symbol as a global variable. It uses the special
+forms @code{defvar} or @code{defconst}, which are documented below.
+
+ A variable definition serves three purposes. First, it informs
+people who read the code that the symbol is @emph{intended} to be used
+a certain way (as a variable). Second, it informs the Lisp system of
+this, optionally supplying an initial value and a documentation
+string. Third, it provides information to programming tools such as
+@command{etags}, allowing them to find where the variable was defined.
+
+ The difference between @code{defconst} and @code{defvar} is mainly a
+matter of intent, serving to inform human readers of whether the value
+should ever change. Emacs Lisp does not actually prevent you from
+changing the value of a variable defined with @code{defconst}. One
+notable difference between the two forms is that @code{defconst}
+unconditionally initializes the variable, whereas @code{defvar}
+initializes it only if it is originally void.
+
+ To define a customizable variable, you should use @code{defcustom}
+(which calls @code{defvar} as a subroutine). @xref{Variable
+Definitions}.
@defspec defvar symbol [value [doc-string]]
-This special form defines @var{symbol} as a variable and can also
-initialize and document it. The definition informs a person reading
-your code that @var{symbol} is used as a variable that might be set or
-changed. It also declares this variable as @dfn{special}, meaning that it
-should always use dynamic scoping rules. Note that @var{symbol} is not
-evaluated; the symbol to be defined must appear explicitly in the
-@code{defvar}.
+This special form defines @var{symbol} as a variable. Note that
+@var{symbol} is not evaluated; the symbol to be defined should appear
+explicitly in the @code{defvar} form. The variable is marked as
+@dfn{special}, meaning that it should always be dynamically bound
+(@pxref{Variable Scoping}).
If @var{symbol} is void and @var{value} is specified, @code{defvar}
-evaluates it and sets @var{symbol} to the result. But if @var{symbol}
-already has a value (i.e., it is not void), @var{value} is not even
-evaluated, and @var{symbol}'s value remains unchanged.
-If @var{value} is omitted, the value of @var{symbol} is not changed in any
-case; instead, the only effect of @code{defvar} is to declare locally that this
-variable exists elsewhere and should hence always use dynamic scoping rules.
+evaluates @var{value} and sets @var{symbol} to the result. But if
+@var{symbol} already has a value (i.e.@: it is not void), @var{value}
+is not even evaluated, and @var{symbol}'s value remains unchanged. If
+@var{value} is omitted, the value of @var{symbol} is not changed in
+any case.
If @var{symbol} has a buffer-local binding in the current buffer,
@code{defvar} operates on the default value, which is buffer-independent,
@@ -459,19 +431,9 @@ Emacs Lisp mode (@code{eval-defun}), a special feature of
@code{eval-defun} arranges to set the variable unconditionally, without
testing whether its value is void.
-If the @var{doc-string} argument appears, it specifies the documentation
-for the variable. (This opportunity to specify documentation is one of
-the main benefits of defining the variable.) The documentation is
-stored in the symbol's @code{variable-documentation} property. The
-Emacs help functions (@pxref{Documentation}) look for this property.
-
-If the documentation string begins with the character @samp{*}, Emacs
-allows users to set it interactively using the @code{set-variable}
-command. However, you should nearly always use @code{defcustom}
-instead of @code{defvar} to define such variables, so that users can
-use @kbd{M-x customize} and related commands to set them. In that
-case, it is not necessary to begin the documentation string with
-@samp{*}. @xref{Customization}.
+If the @var{doc-string} argument is supplied, it specifies the
+documentation string for the variable (stored in the symbol's
+@code{variable-documentation} property). @xref{Documentation}.
Here are some examples. This form defines @code{foo} but does not
initialize it:
@@ -494,38 +456,6 @@ it a documentation string:
@end group
@end example
-The following form changes the documentation string for @code{bar},
-making it a user option, but does not change the value, since @code{bar}
-already has a value. (The addition @code{(1+ nil)} would get an error
-if it were evaluated, but since it is not evaluated, there is no error.)
-
-@example
-@group
-(defvar bar (1+ nil)
- "*The normal weight of a bar.")
- @result{} bar
-@end group
-@group
-bar
- @result{} 23
-@end group
-@end example
-
-Here is an equivalent expression for the @code{defvar} special form:
-
-@example
-@group
-(defvar @var{symbol} @var{value} @var{doc-string})
-@equiv{}
-(progn
- (if (not (boundp '@var{symbol}))
- (setq @var{symbol} @var{value}))
- (if '@var{doc-string}
- (put '@var{symbol} 'variable-documentation '@var{doc-string}))
- '@var{symbol})
-@end group
-@end example
-
The @code{defvar} form returns @var{symbol}, but it is normally used
at top level in a file where its value does not matter.
@end defspec
@@ -538,6 +468,11 @@ global value, established here, that should not be changed by the user
or by other programs. Note that @var{symbol} is not evaluated; the
symbol to be defined must appear explicitly in the @code{defconst}.
+The @code{defconst} form, like @code{defvar}, marks the variable as
+@dfn{special}, meaning that it should always be dynamically bound
+(@pxref{Variable Scoping}). In addition, it marks the variable as
+risky (@pxref{File Local Variables}).
+
@code{defconst} always evaluates @var{value}, and sets the value of
@var{symbol} to the result. If @var{symbol} does have a buffer-local
binding in the current buffer, @code{defconst} sets the default value,
@@ -545,7 +480,7 @@ not the buffer-local value. (But you should not be making
buffer-local bindings for a symbol that is defined with
@code{defconst}.)
-An example of the use of @code{defconst} is Emacs' definition of
+An example of the use of @code{defconst} is Emacs's definition of
@code{float-pi}---the mathematical constant @math{pi}, which ought not
to be changed by anyone (attempts by the Indiana State Legislature
notwithstanding). As the second form illustrates, however,
@@ -567,37 +502,13 @@ float-pi
@end example
@end defspec
-@defun user-variable-p variable
-@cindex user option
-This function returns @code{t} if @var{variable} is a user option---a
-variable intended to be set by the user for customization---and
-@code{nil} otherwise. (Variables other than user options exist for the
-internal purposes of Lisp programs, and users need not know about them.)
-
-User option variables are distinguished from other variables either
-though being declared using @code{defcustom}@footnote{They may also be
-declared equivalently in @file{cus-start.el}.} or by the first character
-of their @code{variable-documentation} property. If the property exists
-and is a string, and its first character is @samp{*}, then the variable
-is a user option. Aliases of user options are also user options.
-@end defun
-
-@cindex @code{variable-interactive} property
-@findex set-variable
- If a user option variable has a @code{variable-interactive} property,
-the @code{set-variable} command uses that value to control reading the
-new value for the variable. The property's value is used as if it were
-specified in @code{interactive} (@pxref{Using Interactive}). However,
-this feature is largely obsoleted by @code{defcustom}
-(@pxref{Customization}).
-
- @strong{Warning:} If the @code{defconst} and @code{defvar} special
-forms are used while the variable has a local binding (made with
-@code{let}, or a function argument), they set the local-binding's
-value; the top-level binding is not changed. This is not what you
-usually want. To prevent it, use these special forms at top level in
-a file, where normally no local binding is in effect, and make sure to
-load the file before making a local binding for the variable.
+ @strong{Warning:} If you use a @code{defconst} or @code{defvar}
+special form while the variable has a local binding (made with
+@code{let}, or a function argument), it sets the local binding rather
+than the global binding. This is not what you usually want. To
+prevent this, use these special forms at top level in a file, where
+normally no local binding is in effect, and make sure to load the file
+before making a local binding for the variable.
@node Tips for Defining
@section Tips for Defining Variables Robustly
@@ -667,9 +578,9 @@ loading the file, the variable is either still uninitialized or
initialized properly, never in-between. If it is still uninitialized,
reloading the file will initialize it properly. Second, reloading the
file once the variable is initialized will not alter it; that is
-important if the user has run hooks to alter part of the contents (such
-as, to rebind keys). Third, evaluating the @code{defvar} form with
-@kbd{C-M-x} @emph{will} reinitialize the map completely.
+important if the user has run hooks to alter part of the contents
+(such as, to rebind keys). Third, evaluating the @code{defvar} form
+with @kbd{C-M-x} will reinitialize the map completely.
Putting so much code in the @code{defvar} form has one disadvantage:
it puts the documentation string far away from the line which names the
@@ -690,37 +601,27 @@ This has all the same advantages as putting the initialization inside
the @code{defvar}, except that you must type @kbd{C-M-x} twice, once on
each form, if you do want to reinitialize the variable.
- But be careful not to write the code like this:
-
-@example
-(defvar my-mode-map nil
- @var{docstring})
-(unless my-mode-map
- (setq my-mode-map (make-sparse-keymap))
- (define-key my-mode-map "\C-c\C-a" 'my-command)
- @dots{})
-@end example
-
-@noindent
-This code sets the variable, then alters it, but it does so in more than
-one step. If the user quits just after the @code{setq}, that leaves the
-variable neither correctly initialized nor void nor @code{nil}. Once
-that happens, reloading the file will not initialize the variable; it
-will remain incomplete.
-
@node Accessing Variables
@section Accessing Variable Values
The usual way to reference a variable is to write the symbol which
-names it (@pxref{Symbol Forms}). This requires you to specify the
-variable name when you write the program. Usually that is exactly what
-you want to do. Occasionally you need to choose at run time which
-variable to reference; then you can use @code{symbol-value}.
+names it. @xref{Symbol Forms}.
+
+ Occasionally, you may want to reference a variable which is only
+determined at run time. In that case, you cannot specify the variable
+name in the text of the program. You can use the @code{symbol-value}
+function to extract the value.
@defun symbol-value symbol
-This function returns the value of @var{symbol}. This is the value in
-the innermost local binding of the symbol, or its global value if it
-has no local bindings.
+This function returns the value stored in @var{symbol}'s value cell.
+This is where the variable's current (dynamic) value is stored. If
+the variable has no local binding, this is simply its global value.
+If the variable is void, a @code{void-variable} error is signaled.
+
+If the variable is lexically bound, the value reported by
+@code{symbol-value} is not necessarily the same as the variable's
+lexical value, which is determined by the lexical environment rather
+than the symbol's value cell. @xref{Variable Scoping}.
@example
@group
@@ -754,13 +655,10 @@ has no local bindings.
@result{} 5
@end group
@end example
-
-A @code{void-variable} error is signaled if the current binding of
-@var{symbol} is void.
@end defun
@node Setting Variables
-@section How to Alter a Variable Value
+@section Setting Variable Values
The usual way to change the value of a variable is with the special
form @code{setq}. When you need to compute the choice of variable at
@@ -769,12 +667,12 @@ run time, use the function @code{set}.
@defspec setq [symbol form]@dots{}
This special form is the most common method of changing a variable's
value. Each @var{symbol} is given a new value, which is the result of
-evaluating the corresponding @var{form}. The most-local existing
-binding of the symbol is changed.
+evaluating the corresponding @var{form}. The current binding of the
+symbol is changed.
@code{setq} does not evaluate @var{symbol}; it sets the symbol that you
write. We say that this argument is @dfn{automatically quoted}. The
-@samp{q} in @code{setq} stands for ``quoted.''
+@samp{q} in @code{setq} stands for ``quoted''.
The value of the @code{setq} form is the value of the last @var{form}.
@@ -809,12 +707,17 @@ second @var{symbol} is set, and so on:
@end defspec
@defun set symbol value
-This function sets @var{symbol}'s value to @var{value}, then returns
-@var{value}. Since @code{set} is a function, the expression written for
-@var{symbol} is evaluated to obtain the symbol to set.
-
-The most-local existing binding of the variable is the binding that is
-set; shadowed bindings are not affected.
+This function puts @var{value} in the value cell of @var{symbol}.
+Since it is a function rather than a special form, the expression
+written for @var{symbol} is evaluated to obtain the symbol to set.
+The return value is @var{value}.
+
+When dynamic variable binding is in effect (the default), @code{set}
+has the same effect as @code{setq}, apart from the fact that
+@code{set} evaluates its @var{symbol} argument whereas @code{setq}
+does not. But when a variable is lexically bound, @code{set} affects
+its @emph{dynamic} value, whereas @code{setq} affects its current
+(lexical) value. @xref{Variable Scoping}.
@example
@group
@@ -854,327 +757,337 @@ error is signaled.
(set '(x y) 'z)
@error{} Wrong type argument: symbolp, (x y)
@end example
-
-Logically speaking, @code{set} is a more fundamental primitive than
-@code{setq}. Any use of @code{setq} can be trivially rewritten to use
-@code{set}; @code{setq} could even be defined as a macro, given the
-availability of @code{set}. However, @code{set} itself is rarely used;
-beginners hardly need to know about it. It is useful only for choosing
-at run time which variable to set. For example, the command
-@code{set-variable}, which reads a variable name from the user and then
-sets the variable, needs to use @code{set}.
-
-@cindex CL note---@code{set} local
-@quotation
-@b{Common Lisp note:} In Common Lisp, @code{set} always changes the
-symbol's ``special'' or dynamic value, ignoring any lexical bindings.
-In Emacs Lisp, all variables and all bindings are dynamic, so @code{set}
-always affects the most local existing binding.
-@end quotation
@end defun
@node Variable Scoping
@section Scoping Rules for Variable Bindings
- A given symbol @code{foo} can have several local variable bindings,
-established at different places in the Lisp program, as well as a global
-binding. The most recently established binding takes precedence over
-the others.
+ When you create a local binding for a variable, that binding takes
+effect only within a limited portion of the program (@pxref{Local
+Variables}). This section describes exactly what this means.
@cindex scope
@cindex extent
-@cindex dynamic scoping
-@cindex lexical scoping
- By default, local bindings in Emacs Lisp have @dfn{indefinite scope} and
-@dfn{dynamic extent}. @dfn{Scope} refers to @emph{where} textually in
-the source code the binding can be accessed. ``Indefinite scope'' means
-that any part of the program can potentially access the variable
-binding. @dfn{Extent} refers to @emph{when}, as the program is
-executing, the binding exists. ``Dynamic extent'' means that the binding
-lasts as long as the activation of the construct that established it.
-
- The combination of dynamic extent and indefinite scope is called
-@dfn{dynamic scoping}. By contrast, most programming languages use
-@dfn{lexical scoping}, in which references to a local variable must be
-located textually within the function or block that binds the variable.
-Emacs can also support lexical scoping, upon request (@pxref{Lexical
-Binding}).
-
-@cindex CL note---special variables
-@quotation
-@b{Common Lisp note:} Variables declared ``special'' in Common Lisp are
-dynamically scoped, like all variables in Emacs Lisp.
-@end quotation
+ Each local binding has a certain @dfn{scope} and @dfn{extent}.
+@dfn{Scope} refers to @emph{where} in the textual source code the
+binding can be accessed. @dfn{Extent} refers to @emph{when}, as the
+program is executing, the binding exists.
+
+@cindex dynamic binding
+@cindex indefinite scope
+@cindex dynamic extent
+ By default, the local bindings that Emacs creates are @dfn{dynamic
+bindings}. Such a binding has @dfn{indefinite scope}, meaning that
+any part of the program can potentially access the variable binding.
+It also has @dfn{dynamic extent}, meaning that the binding lasts only
+while the binding construct (such as the body of a @code{let} form) is
+being executed.
+
+@cindex lexical binding
+@cindex lexical scope
+@cindex indefinite extent
+ Emacs can optionally create @dfn{lexical bindings}. A lexical
+binding has @dfn{lexical scope}, meaning that any reference to the
+variable must be located textually within the binding construct. It
+also has @dfn{indefinite extent}, meaning that under some
+circumstances the binding can live on even after the binding construct
+has finished executing, by means of special objects called
+@dfn{closures}.
+
+ The following subsections describe dynamic binding and lexical
+binding in greater detail, and how to enable lexical binding in Emacs
+Lisp programs.
@menu
-* Scope:: Scope means where in the program a value is visible.
- Comparison with other languages.
-* Extent:: Extent means how long in time a value exists.
-* Impl of Scope:: Two ways to implement dynamic scoping.
-* Using Scoping:: How to use dynamic scoping carefully and avoid problems.
-* Lexical Binding:: Use of lexical scoping.
+* Dynamic Binding:: The default for binding local variables in Emacs.
+* Dynamic Binding Tips:: Avoiding problems with dynamic binding.
+* Lexical Binding:: A different type of local variable binding.
+* Using Lexical Binding:: How to enable lexical binding.
@end menu
-@node Scope
-@subsection Scope
+@node Dynamic Binding
+@subsection Dynamic Binding
+
+ By default, the local variable bindings made by Emacs are dynamic
+bindings. When a variable is dynamically bound, its current binding
+at any point in the execution of the Lisp program is simply the most
+recently-created dynamic local binding for that symbol, or the global
+binding if there is no such local binding.
- Emacs Lisp uses @dfn{indefinite scope} for local variable bindings.
-This means that any function anywhere in the program text might access a
-given binding of a variable. Consider the following function
-definitions:
+ Dynamic bindings have indefinite scope and dynamic extent, as shown
+by the following example:
@example
@group
-(defun binder (x) ; @r{@code{x} is bound in @code{binder}.}
- (foo 5)) ; @r{@code{foo} is some other function.}
-@end group
+(defvar x -99) ; @r{@code{x} receives an initial value of -99.}
-@group
-(defun user () ; @r{@code{x} is used ``free'' in @code{user}.}
- (list x))
+(defun getx ()
+ x) ; @r{@code{x} is used ``free'' in this function.}
+
+(let ((x 1)) ; @r{@code{x} is dynamically bound.}
+ (getx))
+ @result{} 1
+
+;; @r{After the @code{let} form finishes, @code{x} reverts to its}
+;; @r{previous value, which is -99.}
+
+(getx)
+ @result{} -99
@end group
@end example
- In a lexically scoped language, the binding of @code{x} in
-@code{binder} would never be accessible in @code{user}, because
-@code{user} is not textually contained within the function
-@code{binder}. However, in dynamically-scoped Emacs Lisp, @code{user}
-may or may not refer to the binding of @code{x} established in
-@code{binder}, depending on the circumstances:
-
-@itemize @bullet
-@item
-If we call @code{user} directly without calling @code{binder} at all,
-then whatever binding of @code{x} is found, it cannot come from
-@code{binder}.
+@noindent
+The function @code{getx} refers to @code{x}. This is a ``free''
+reference, in the sense that there is no binding for @code{x} within
+that @code{defun} construct itself. When we call @code{getx} from
+within a @code{let} form in which @code{x} is (dynamically) bound, it
+retrieves the local value of @code{x} (i.e.@: 1). But when we call
+@code{getx} outside the @code{let} form, it retrieves the global value
+of @code{x} (i.e.@: -99).
-@item
-If we define @code{foo} as follows and then call @code{binder}, then the
-binding made in @code{binder} will be seen in @code{user}:
+ Here is another example, which illustrates setting a dynamically
+bound variable using @code{setq}:
@example
@group
-(defun foo (lose)
- (user))
+(defvar x -99) ; @r{@code{x} receives an initial value of -99.}
+
+(defun addx ()
+ (setq x (1+ x))) ; @r{Add 1 to @code{x} and return its new value.}
+
+(let ((x 1))
+ (addx)
+ (addx))
+ @result{} 3 ; @r{The two @code{addx} calls add to @code{x} twice.}
+
+;; @r{After the @code{let} form finishes, @code{x} reverts to its}
+;; @r{previous value, which is -99.}
+
+(addx)
+ @result{} -98
@end group
@end example
-@item
-However, if we define @code{foo} as follows and then call @code{binder},
-then the binding made in @code{binder} @emph{will not} be seen in
-@code{user}:
+ Dynamic binding is implemented in Emacs Lisp in a simple way. Each
+symbol has a value cell, which specifies its current dynamic value (or
+absence of value). @xref{Symbol Components}. When a symbol is given
+a dynamic local binding, Emacs records the contents of the value cell
+(or absence thereof) in a stack, and stores the new local value in the
+value cell. When the binding construct finishes executing, Emacs pops
+the old value off the stack, and puts it in the value cell.
-@example
-(defun foo (x)
- (user))
-@end example
+@node Dynamic Binding Tips
+@subsection Proper Use of Dynamic Binding
-@noindent
-Here, when @code{foo} is called by @code{binder}, it binds @code{x}.
-(The binding in @code{foo} is said to @dfn{shadow} the one made in
-@code{binder}.) Therefore, @code{user} will access the @code{x} bound
-by @code{foo} instead of the one bound by @code{binder}.
-@end itemize
+ Dynamic binding is a powerful feature, as it allows programs to
+refer to variables that are not defined within their local textual
+scope. However, if used without restraint, this can also make
+programs hard to understand. There are two clean ways to use this
+technique:
-Emacs Lisp used dynamic scoping by default because simple implementations of
-lexical scoping are slow. In addition, every Lisp system needs to offer
-dynamic scoping at least as an option; if lexical scoping is the norm, there
-must be a way to specify dynamic scoping instead for a particular variable.
-Nowadays, Emacs offers both, but the default is still to use exclusively
-dynamic scoping.
-
-@node Extent
-@subsection Extent
-
- @dfn{Extent} refers to the time during program execution that a
-variable name is valid. In Emacs Lisp, a variable is valid only while
-the form that bound it is executing. This is called @dfn{dynamic
-extent}. ``Local'' or ``automatic'' variables in most languages,
-including C and Pascal, have dynamic extent.
-
- One alternative to dynamic extent is @dfn{indefinite extent}. This
-means that a variable binding can live on past the exit from the form
-that made the binding. Common Lisp and Scheme, for example, support
-this, but Emacs Lisp does not.
-
- To illustrate this, the function below, @code{make-add}, returns a
-function that purports to add @var{n} to its own argument @var{m}. This
-would work in Common Lisp, but it does not do the job in Emacs Lisp,
-because after the call to @code{make-add} exits, the variable @code{n}
-is no longer bound to the actual argument 2.
+@itemize @bullet
+@item
+If a variable has no global definition, use it as a local variable
+only within a binding construct, e.g.@: the body of the @code{let}
+form where the variable was bound, or the body of the function for an
+argument variable. If this convention is followed consistently
+throughout a program, the value of the variable will not affect, nor
+be affected by, any uses of the same variable symbol elsewhere in the
+program.
+
+@item
+Otherwise, define the variable with @code{defvar}, @code{defconst}, or
+@code{defcustom}. @xref{Defining Variables}. Usually, the definition
+should be at top-level in an Emacs Lisp file. As far as possible, it
+should include a documentation string which explains the meaning and
+purpose of the variable. You should also choose the variable's name
+to avoid name conflicts (@pxref{Coding Conventions}).
+
+Then you can bind the variable anywhere in a program, knowing reliably
+what the effect will be. Wherever you encounter the variable, it will
+be easy to refer back to the definition, e.g.@: via the @kbd{C-h v}
+command (provided the variable definition has been loaded into Emacs).
+@xref{Name Help,,, emacs, The GNU Emacs Manual}.
+
+For example, it is common to use local bindings for customizable
+variables like @code{case-fold-search}:
@example
-(defun make-add (n)
- (function (lambda (m) (+ n m)))) ; @r{Return a function.}
- @result{} make-add
-(fset 'add2 (make-add 2)) ; @r{Define function @code{add2}}
- ; @r{with @code{(make-add 2)}.}
- @result{} (lambda (m) (+ n m))
-(add2 4) ; @r{Try to add 2 to 4.}
-@error{} Symbol's value as variable is void: n
+@group
+(defun search-for-abc ()
+ "Search for the string \"abc\", ignoring case differences."
+ (let ((case-fold-search nil))
+ (re-search-forward "abc")))
+@end group
@end example
+@end itemize
-@cindex closures not available
- Some Lisp dialects have ``closures,'' objects that are like functions
-but record additional variable bindings. Emacs Lisp does not have
-closures.
+@node Lexical Binding
+@subsection Lexical Binding
-@node Impl of Scope
-@subsection Implementation of Dynamic Scoping
-@cindex deep binding
+Optionally, you can create lexical bindings in Emacs Lisp. A
+lexically bound variable has @dfn{lexical scope}, meaning that any
+reference to the variable must be located textually within the binding
+construct.
- A simple sample implementation (which is not how Emacs Lisp actually
-works) may help you understand dynamic binding. This technique is
-called @dfn{deep binding} and was used in early Lisp systems.
+ Here is an example
+@iftex
+(see the next subsection, for how to actually enable lexical binding):
+@end iftex
+@ifnottex
+(@pxref{Using Lexical Binding}, for how to actually enable lexical binding):
+@end ifnottex
- Suppose there is a stack of bindings, which are variable-value pairs.
-At entry to a function or to a @code{let} form, we can push bindings
-onto the stack for the arguments or local variables created there. We
-can pop those bindings from the stack at exit from the binding
-construct.
+@example
+@group
+(let ((x 1)) ; @r{@code{x} is lexically bound.}
+ (+ x 3))
+ @result{} 4
- We can find the value of a variable by searching the stack from top to
-bottom for a binding for that variable; the value from that binding is
-the value of the variable. To set the variable, we search for the
-current binding, then store the new value into that binding.
-
- As you can see, a function's bindings remain in effect as long as it
-continues execution, even during its calls to other functions. That is
-why we say the extent of the binding is dynamic. And any other function
-can refer to the bindings, if it uses the same variables while the
-bindings are in effect. That is why we say the scope is indefinite.
-
-@cindex shallow binding
- The actual implementation of variable scoping in GNU Emacs Lisp uses a
-technique called @dfn{shallow binding}. Each variable has a standard
-place in which its current value is always found---the value cell of the
-symbol.
-
- In shallow binding, setting the variable works by storing a value in
-the value cell. Creating a new binding works by pushing the old value
-(belonging to a previous binding) onto a stack, and storing the new
-local value in the value cell. Eliminating a binding works by popping
-the old value off the stack, into the value cell.
-
- We use shallow binding because it has the same results as deep
-binding, but runs faster, since there is never a need to search for a
-binding.
+(defun getx ()
+ x) ; @r{@code{x} is used ``free'' in this function.}
-@node Using Scoping
-@subsection Proper Use of Dynamic Scoping
+(let ((x 1)) ; @r{@code{x} is lexically bound.}
+ (getx))
+@error{} Symbol's value as variable is void: x
+@end group
+@end example
- Binding a variable in one function and using it in another is a
-powerful technique, but if used without restraint, it can make programs
-hard to understand. There are two clean ways to use this technique:
+@noindent
+Here, the variable @code{x} has no global value. When it is lexically
+bound within a @code{let} form, it can be used in the textual confines
+of that @code{let} form. But it can @emph{not} be used from within a
+@code{getx} function called from the @code{let} form, since the
+function definition of @code{getx} occurs outside the @code{let} form
+itself.
+
+@cindex lexical environment
+ Here is how lexical binding works. Each binding construct defines a
+@dfn{lexical environment}, specifying the symbols that are bound
+within the construct and their local values. When the Lisp evaluator
+wants the current value of a variable, it looks first in the lexical
+environment; if the variable is not specified in there, it looks in
+the symbol's value cell, where the dynamic value is stored.
+
+@cindex closures, example of using
+ Lexical bindings have indefinite extent. Even after a binding
+construct has finished executing, its lexical environment can be
+``kept around'' in Lisp objects called @dfn{closures}. A closure is
+created when you define a named or anonymous function with lexical
+binding enabled. @xref{Closures}, for details.
+
+ When a closure is called as a function, any lexical variable
+references within its definition use the retained lexical environment.
+Here is an example:
-@itemize @bullet
-@item
-Use or bind the variable only in a few related functions, written close
-together in one file. Such a variable is used for communication within
-one program.
+@example
+(defvar my-ticker nil) ; @r{We will use this dynamically bound}
+ ; @r{variable to store a closure.}
-You should write comments to inform other programmers that they can see
-all uses of the variable before them, and to advise them not to add uses
-elsewhere.
+(let ((x 0)) ; @r{@code{x} is lexically bound.}
+ (setq my-ticker (lambda ()
+ (setq x (1+ x)))))
+ @result{} (closure ((x . 0) t) ()
+ (1+ x))
-@item
-Give the variable a well-defined, documented meaning, and make all
-appropriate functions refer to it (but not bind it or set it) wherever
-that meaning is relevant. For example, the variable
-@code{case-fold-search} is defined as ``non-@code{nil} means ignore case
-when searching''; various search and replace functions refer to it
-directly or through their subroutines, but do not bind or set it.
-
-Then you can bind the variable in other programs, knowing reliably what
-the effect will be.
-@end itemize
+(funcall my-ticker)
+ @result{} 1
- In either case, you should define the variable with @code{defvar}.
-This helps other people understand your program by telling them to look
-for inter-function usage. It also avoids a warning from the byte
-compiler. Choose the variable's name to avoid name conflicts---don't
-use short names like @code{x}.
+(funcall my-ticker)
+ @result{} 2
+(funcall my-ticker)
+ @result{} 3
-@node Lexical Binding
-@subsection Use of Lexical Scoping
+x ; @r{Note that @code{x} has no global value.}
+@error{} Symbol's value as variable is void: x
+@end example
-Emacs Lisp can be evaluated in two different modes: in dynamic binding
-mode or lexical binding mode. In dynamic binding mode, all local
-variables use dynamic scoping, whereas in lexical binding mode
-variables that have been declared @dfn{special} (i.e., declared with
-@code{defvar}, @code{defcustom} or @code{defconst}) use dynamic
-scoping and all others use lexical scoping.
+@noindent
+The @code{let} binding defines a lexical environment in which the
+variable @code{x} is locally bound to 0. Within this binding
+construct, we define a lambda expression which increments @code{x} by
+one and returns the incremented value. This lambda expression is
+automatically turned into a closure, in which the lexical environment
+lives on even after the @code{let} binding construct has exited. Each
+time we evaluate the closure, it increments @code{x}, using the
+binding of @code{x} in that lexical environment.
+
+ Note that functions like @code{symbol-value}, @code{boundp}, and
+@code{set} only retrieve or modify a variable's dynamic binding
+(i.e.@: the contents of its symbol's value cell). Also, the code in
+the body of a @code{defun} or @code{defmacro} cannot refer to
+surrounding lexical variables.
+
+ Currently, lexical binding is not much used within the Emacs
+sources. However, we expect its importance to increase in the future.
+Lexical binding opens up a lot more opportunities for optimization, so
+Emacs Lisp code that makes use of lexical binding is likely to run
+faster in future Emacs versions. Such code is also much more friendly
+to concurrency, which we want to add to Emacs in the near future.
+
+@node Using Lexical Binding
+@subsection Using Lexical Binding
+
+ When loading an Emacs Lisp file or evaluating a Lisp buffer, lexical
+binding is enabled if the buffer-local variable @code{lexical-binding}
+is non-@code{nil}:
@defvar lexical-binding
-When non-nil, evaluation of Lisp code uses lexical scoping for non-special
-local variables instead of dynamic scoping. If nil, dynamic scoping is used
-for all local variables. This variable is typically set for a whole Elisp file
-via file local variables (@pxref{File Local Variables}).
+If this buffer-local variable is non-@code{nil}, Emacs Lisp files and
+buffers are evaluated using lexical binding instead of dynamic
+binding. (However, special variables are still dynamically bound; see
+below.) If @code{nil}, dynamic binding is used for all local
+variables. This variable is typically set for a whole Emacs Lisp
+file, as a file local variable (@pxref{File Local Variables}).
+Note that unlike other such variables, this one must be set in the
+first line of a file.
@end defvar
+@noindent
+When evaluating Emacs Lisp code directly using an @code{eval} call,
+lexical binding is enabled if the @var{lexical} argument to
+@code{eval} is non-@code{nil}. @xref{Eval}.
+
+@cindex special variables
+ Even when lexical binding is enabled, certain variables will
+continue to be dynamically bound. These are called @dfn{special
+variables}. Every variable that has been defined with @code{defvar},
+@code{defcustom} or @code{defconst} is a special variable
+(@pxref{Defining Variables}). All other variables are subject to
+lexical binding.
+
@defun special-variable-p SYMBOL
-Return whether SYMBOL has been declared as a special variable, via
-@code{defvar} or @code{defconst}.
+This function returns non-@code{nil} if @var{symbol} is a special
+variable (i.e.@: it has a @code{defvar}, @code{defcustom}, or
+@code{defconst} variable definition). Otherwise, the return value is
+@code{nil}.
@end defun
-The use of a special variable as a formal argument in a function is generally
-discouraged and its behavior in lexical binding mode is unspecified (it may use
-lexical scoping sometimes and dynamic scoping other times).
-
-Functions like @code{symbol-value}, @code{boundp}, or @code{set} only know
-about dynamically scoped variables, so you cannot get the value of a lexical
-variable via @code{symbol-value} and neither can you change it via @code{set}.
-Another particularity is that code in the body of a @code{defun} or
-@code{defmacro} cannot refer to surrounding lexical variables.
-
-Evaluation of a @code{lambda} expression in lexical binding mode will not just
-return that lambda expression unchanged, as in the dynamic binding case, but
-will instead construct a new object that remembers the current lexical
-environment in which that lambda expression was defined, so that the function
-body can later be evaluated in the proper context. Those objects are called
-@dfn{closures}. They are also functions, in the sense that they are accepted
-by @code{funcall}, and they are represented by a cons cell whose @code{car} is
-the symbol @code{closure}.
-
-@menu
-* Converting to Lexical Binding:: How to start using lexical scoping
-@end menu
-
-@node Converting to Lexical Binding
-@subsubsection Converting a package to use lexical scoping
-
-Lexical scoping, as currently implemented, does not bring many significant
-benefits, unless you are a seasoned functional programmer addicted to
-higher-order functions. But its importance will increase in the future:
-lexical scoping opens up a lot more opportunities for optimization, so
-lexically scoped code is likely to run faster in future Emacs versions, and it
-is much more friendly to concurrency, which we want to add in the near future.
-
-Converting a package to lexical binding is usually pretty easy and should not
-break backward compatibility: just add a file-local variable setting
-@code{lexical-binding} to @code{t} and add declarations of the form
-@code{(defvar @var{VAR})} for every variable which still needs to use
-dynamic scoping.
-
-To find which variables need this declaration, the simplest solution is to
-check the byte-compiler's warnings. The byte-compiler will usually find those
-variables either because they are used outside of a let-binding (leading to
-warnings about reference or assignment to ``free variable @var{VAR}'') or
-because they are let-bound but not used within the let-binding (leading to
-warnings about ``unused lexical variable @var{VAR}'').
-
-In cases where a dynamically scoped variable was bound as a function argument,
-you will also need to move this binding to a @code{let}. These cases are also
-flagged by the byte-compiler.
-
-To silence byte-compiler warnings about unused variables, just use a variable
-name that start with an underscore, which the byte-compiler interpret as an
-indication that this is a variable known not to be used.
-
-In most cases, the resulting code will then work with either setting of
-@code{lexical-binding}, so it can still be used with older Emacsen (which will
-simply ignore the @code{lexical-binding} variable setting).
+ The use of a special variable as a formal argument in a function is
+discouraged. Doing so gives rise to unspecified behavior when lexical
+binding mode is enabled (it may use lexical binding sometimes, and
+dynamic binding other times).
+
+ Converting an Emacs Lisp program to lexical binding is pretty easy.
+First, add a file-local variable setting of @code{lexical-binding} to
+@code{t} in the Emacs Lisp source file. Second, check that every
+variable in the program which needs to be dynamically bound has a
+variable definition, so that it is not inadvertently bound lexically.
+
+ A simple way to find out which variables need a variable definition
+is to byte-compile the source file. @xref{Byte Compilation}. If a
+non-special variable is used outside of a @code{let} form, the
+byte-compiler will warn about reference or assignment to a ``free
+variable''. If a non-special variable is bound but not used within a
+@code{let} form, the byte-compiler will warn about an ``unused lexical
+variable''. The byte-compiler will also issue a warning if you use a
+special variable as a function argument.
+
+ (To silence byte-compiler warnings about unused variables, just use
+a variable name that start with an underscore. The byte-compiler
+interprets this as an indication that this is a variable known not to
+be used.)
@node Buffer-Local Variables
@section Buffer-Local Variables
@@ -1279,7 +1192,8 @@ foo @result{} 'a
@end group
@end example
- Note that references to @code{foo} in @var{body} access the
+@noindent
+Note that references to @code{foo} in @var{body} access the
buffer-local binding of buffer @samp{b}.
When a file specifies local variable values, these become buffer-local
@@ -1348,10 +1262,20 @@ needed if you use the @var{local} argument to @code{add-hook} or
@code{remove-hook}.
@end deffn
+@defmac setq-local variable value
+This macro creates a buffer-local binding in the current buffer for
+@var{variable}, and gives it the buffer-local value @var{value}. It
+is equivalent to calling @code{make-local-variable} followed by
+@code{setq}. @var{variable} should be an unquoted symbol.
+@end defmac
+
@deffn Command make-variable-buffer-local variable
This function marks @var{variable} (a symbol) automatically
buffer-local, so that any subsequent attempt to set it will make it
-local to the current buffer at the time.
+local to the current buffer at the time. Unlike
+@code{make-local-variable}, with which it is often confused, this
+cannot be undone, and affects the behavior of the variable in all
+buffers.
A peculiar wrinkle of this feature is that binding the variable (with
@code{let} or other binding constructs) does not create a buffer-local
@@ -1380,6 +1304,14 @@ on having separate values in separate buffers, then using
@code{make-variable-buffer-local} can be the best solution.
@end deffn
+@defmac defvar-local variable value &optional docstring
+This macro defines @var{variable} as a variable with initial value
+@var{value} and @var{docstring}, and marks it as automatically
+buffer-local. It is equivalent to calling @code{defvar} followed by
+@code{make-variable-buffer-local}. @var{variable} should be an
+unquoted symbol.
+@end defmac
+
@defun local-variable-p variable &optional buffer
This returns @code{t} if @var{variable} is buffer-local in buffer
@var{buffer} (which defaults to the current buffer); otherwise,
@@ -1387,9 +1319,10 @@ This returns @code{t} if @var{variable} is buffer-local in buffer
@end defun
@defun local-variable-if-set-p variable &optional buffer
-This returns @code{t} if @var{variable} will become buffer-local in
-buffer @var{buffer} (which defaults to the current buffer) if it is
-set there.
+This returns @code{t} if @var{variable} either has a buffer-local
+value in buffer @var{buffer}, or is automatically buffer-local.
+Otherwise, it returns @code{nil}. If omitted or @code{nil},
+@var{buffer} defaults to the current buffer.
@end defun
@defun buffer-local-value variable buffer
@@ -1401,11 +1334,12 @@ value (@pxref{Default Value}) of @var{variable} instead.
@defun buffer-local-variables &optional buffer
This function returns a list describing the buffer-local variables in
-buffer @var{buffer}. (If @var{buffer} is omitted, the current buffer is
-used.) It returns an association list (@pxref{Association Lists}) in
-which each element contains one buffer-local variable and its value.
-However, when a variable's buffer-local binding in @var{buffer} is void,
-then the variable appears directly in the resulting list.
+buffer @var{buffer}. (If @var{buffer} is omitted, the current buffer
+is used.) Normally, each list element has the form
+@w{@code{(@var{sym} . @var{val})}}, where @var{sym} is a buffer-local
+variable (a symbol) and @var{val} is its buffer-local value. But when
+a variable's buffer-local binding in @var{buffer} is void, its list
+element is just @var{sym}.
@example
@group
@@ -1657,6 +1591,13 @@ Query (once) about all the variables.
@end table
@end defopt
+@defvar inhibit-local-variables-regexps
+This is a list of regular expressions. If a file has a name
+matching an element of this list, then it is not scanned for
+any form of file-local variable. For examples of why you might want
+to use this, @pxref{Auto Major Mode}.
+@end defvar
+
@defun hack-local-variables &optional mode-only
This function parses, and binds or evaluates as appropriate, any local
variables specified by the contents of the current buffer. The variable
@@ -1712,6 +1653,11 @@ For boolean-valued variables that are safe, use @code{booleanp} as the
property value. Lambda expressions should be quoted so that
@code{describe-variable} can display the predicate.
+ When defining a user option using @code{defcustom}, you can set its
+@code{safe-local-variable} property by adding the arguments
+@code{:safe @var{function}} to @code{defcustom} (@pxref{Variable
+Definitions}).
+
@defopt safe-local-variable-values
This variable provides another way to mark some variable values as
safe. It is a list of cons cells @code{(@var{var} . @var{val})},
@@ -1731,28 +1677,31 @@ the value @var{val}, based on the above criteria.
@end defun
@c @cindex risky local variable Duplicates risky-local-variable
- Some variables are considered @dfn{risky}. A variable whose name
-ends in any of @samp{-command}, @samp{-frame-alist}, @samp{-function},
+ Some variables are considered @dfn{risky}. If a variable is risky,
+it is never entered automatically into
+@code{safe-local-variable-values}; Emacs always queries before setting
+a risky variable, unless the user explicitly allows a value by
+customizing @code{safe-local-variable-values} directly.
+
+ Any variable whose name has a non-@code{nil}
+@code{risky-local-variable} property is considered risky. When you
+define a user option using @code{defcustom}, you can set its
+@code{risky-local-variable} property by adding the arguments
+@code{:risky @var{value}} to @code{defcustom} (@pxref{Variable
+Definitions}). In addition, any variable whose name ends in any of
+@samp{-command}, @samp{-frame-alist}, @samp{-function},
@samp{-functions}, @samp{-hook}, @samp{-hooks}, @samp{-form},
@samp{-forms}, @samp{-map}, @samp{-map-alist}, @samp{-mode-alist},
-@samp{-program}, or @samp{-predicate} is considered risky. The
-variables @samp{font-lock-keywords}, @samp{font-lock-keywords}
-followed by a digit, and @samp{font-lock-syntactic-keywords} are also
-considered risky. Finally, any variable whose name has a
-non-@code{nil} @code{risky-local-variable} property is considered
-risky.
+@samp{-program}, or @samp{-predicate} is automatically considered
+risky. The variables @samp{font-lock-keywords},
+@samp{font-lock-keywords} followed by a digit, and
+@samp{font-lock-syntactic-keywords} are also considered risky.
@defun risky-local-variable-p sym
This function returns non-@code{nil} if @var{sym} is a risky variable,
based on the above criteria.
@end defun
- If a variable is risky, it will not be entered automatically into
-@code{safe-local-variable-values} as described above. Therefore,
-Emacs will always query before setting a risky variable, unless the
-user explicitly allows the setting by customizing
-@code{safe-local-variable-values} directly.
-
@defvar ignored-local-variables
This variable holds a list of variables that should not be given local
values by files. Any value specified for one of these variables is
@@ -1829,6 +1778,15 @@ function works by calling @code{dir-locals-set-class-variables} and
@code{dir-locals-set-directory-class}, described below.
@end defun
+@defun hack-dir-local-variables-non-file-buffer
+This function looks for directory-local variables, and immediately
+applies them in the current buffer. It is intended to be called in
+the mode commands for non-file buffers, such as Dired buffers, to let
+them obey directory-local variable settings. For non-file buffers,
+Emacs looks for directory-local variables in @code{default-directory}
+and its parent directories.
+@end defun
+
@defun dir-locals-set-class-variables class variables
This function defines a set of variable settings for the named
@var{class}, which is a symbol. You can later assign the class to one
@@ -1912,16 +1870,19 @@ variable with a new name. @code{make-obsolete-variable} declares that
the old name is obsolete and therefore that it may be removed at some
stage in the future.
-@defun make-obsolete-variable obsolete-name current-name &optional when
+@defun make-obsolete-variable obsolete-name current-name when &optional access-type
This function makes the byte compiler warn that the variable
-@var{obsolete-name} is obsolete. If @var{current-name} is a symbol, it is
-the variable's new name; then the warning message says to use
-@var{current-name} instead of @var{obsolete-name}. If @var{current-name}
-is a string, this is the message and there is no replacement variable.
-
-If provided, @var{when} should be a string indicating when the
-variable was first made obsolete---for example, a date or a release
-number.
+@var{obsolete-name} is obsolete. If @var{current-name} is a symbol,
+it is the variable's new name; then the warning message says to use
+@var{current-name} instead of @var{obsolete-name}. If
+@var{current-name} is a string, this is the message and there is no
+replacement variable. @var{when} should be a string indicating when
+the variable was first made obsolete (usually a version number
+string).
+
+The optional argument @var{access-type}, if non-@code{nil}, should
+should specify the kind of access that will trigger obsolescence
+warnings; it can be either @code{get} or @code{set}.
@end defun
You can make two variables synonyms and declare one obsolete at the
@@ -2001,3 +1962,195 @@ Attempting to assign them any other value will result in an error:
(setq undo-limit 1000.0)
@error{} Wrong type argument: integerp, 1000.0
@end example
+
+@node Generalized Variables
+@section Generalized Variables
+
+A @dfn{generalized variable} or @dfn{place form} is one of the many places
+in Lisp memory where values can be stored. The simplest place form is
+a regular Lisp variable. But the @sc{car}s and @sc{cdr}s of lists, elements
+of arrays, properties of symbols, and many other locations are also
+places where Lisp values are stored.
+
+Generalized variables are analogous to ``lvalues'' in the C
+language, where @samp{x = a[i]} gets an element from an array
+and @samp{a[i] = x} stores an element using the same notation.
+Just as certain forms like @code{a[i]} can be lvalues in C, there
+is a set of forms that can be generalized variables in Lisp.
+
+@menu
+* Setting Generalized Variables:: The @code{setf} macro.
+* Adding Generalized Variables:: Defining new @code{setf} forms.
+@end menu
+
+@node Setting Generalized Variables
+@subsection The @code{setf} Macro
+
+The @code{setf} macro is the most basic way to operate on generalized
+variables. The @code{setf} form is like @code{setq}, except that it
+accepts arbitrary place forms on the left side rather than just
+symbols. For example, @code{(setf (car a) b)} sets the car of
+@code{a} to @code{b}, doing the same operation as @code{(setcar a b)},
+but without having to remember two separate functions for setting and
+accessing every type of place.
+
+@defmac setf [place form]@dots{}
+This macro evaluates @var{form} and stores it in @var{place}, which
+must be a valid generalized variable form. If there are several
+@var{place} and @var{form} pairs, the assignments are done sequentially
+just as with @code{setq}. @code{setf} returns the value of the last
+@var{form}.
+@end defmac
+
+The following Lisp forms will work as generalized variables, and
+so may appear in the @var{place} argument of @code{setf}:
+
+@itemize
+@item
+A symbol naming a variable. In other words, @code{(setf x y)} is
+exactly equivalent to @code{(setq x y)}, and @code{setq} itself is
+strictly speaking redundant given that @code{setf} exists. Many
+programmers continue to prefer @code{setq} for setting simple
+variables, though, purely for stylistic or historical reasons.
+The macro @code{(setf x y)} actually expands to @code{(setq x y)},
+so there is no performance penalty for using it in compiled code.
+
+@item
+A call to any of the following standard Lisp functions:
+
+@smallexample
+aref cddr symbol-function
+car elt symbol-plist
+caar get symbol-value
+cadr gethash
+cdr nth
+cdar nthcdr
+@end smallexample
+
+@item
+A call to any of the following Emacs-specific functions:
+
+@smallexample
+default-value process-get
+frame-parameter process-sentinel
+terminal-parameter window-buffer
+keymap-parent window-display-table
+match-data window-dedicated-p
+overlay-get window-hscroll
+overlay-start window-parameter
+overlay-end window-point
+process-buffer window-start
+process-filter
+@end smallexample
+@end itemize
+
+@noindent
+@code{setf} signals an error if you pass a @var{place} form that it
+does not know how to handle.
+
+@c And for cl-lib's cl-getf.
+Note that for @code{nthcdr}, the list argument of the function must
+itself be a valid @var{place} form. For example, @code{(setf (nthcdr
+0 foo) 7)} will set @code{foo} itself to 7.
+@c The use of @code{nthcdr} as a @var{place} form is an extension
+@c to standard Common Lisp.
+
+@c FIXME I don't think is a particularly good way to do it,
+@c but these macros are introduced before generalized variables are.
+The macros @code{push} (@pxref{List Variables}) and @code{pop}
+(@pxref{List Elements}) can manipulate generalized variables,
+not just lists. @code{(pop @var{place})} removes and returns the first
+element of the list stored in @var{place}. It is analogous to
+@code{(prog1 (car @var{place}) (setf @var{place} (cdr @var{place})))},
+except that it takes care to evaluate all subforms only once.
+@code{(push @var{x} @var{place})} inserts @var{x} at the front of
+the list stored in @var{place}. It is analogous to @code{(setf
+@var{place} (cons @var{x} @var{place}))}, except for evaluation of the
+subforms. Note that @code{push} and @code{pop} on an @code{nthcdr}
+place can be used to insert or delete at any position in a list.
+
+The @file{cl-lib} library defines various extensions for generalized
+variables, including additional @code{setf} places.
+@xref{Generalized Variables,,, cl, Common Lisp Extensions}.
+
+
+@node Adding Generalized Variables
+@subsection Defining new @code{setf} forms
+
+This section describes how to define new forms that @code{setf} can
+operate on.
+
+@defmac gv-define-simple-setter name setter &optional fix-return
+This macro enables you to easily define @code{setf} methods for simple
+cases. @var{name} is the name of a function, macro, or special form.
+You can use this macro whenever @var{name} has a directly
+corresponding @var{setter} function that updates it, e.g.,
+@code{(gv-define-simple-setter car setcar)}.
+
+This macro translates a call of the form
+
+@example
+(setf (@var{name} @var{args}@dots{}) @var{value})
+@end example
+
+into
+@example
+(@var{setter} @var{args}@dots{} @var{value})
+@end example
+
+@noindent
+Such a @code{setf} call is documented to return @var{value}. This is
+no problem with, e.g., @code{car} and @code{setcar}, because
+@code{setcar} returns the value that it set. If your @var{setter}
+function does not return @var{value}, use a non-@code{nil} value for
+the @var{fix-return} argument of @code{gv-define-simple-setter}. This
+expands into something equivalent to
+@example
+(let ((temp @var{value}))
+ (@var{setter} @var{args}@dots{} temp)
+ temp)
+@end example
+so ensuring that it returns the correct result.
+@end defmac
+
+
+@defmac gv-define-setter name arglist &rest body
+This macro allows for more complex @code{setf} expansions than the
+previous form. You may need to use this form, for example, if there
+is no simple setter function to call, or if there is one but it
+requires different arguments to the place form.
+
+This macro expands the form
+@code{(setf (@var{name} @var{args}@dots{}) @var{value})} by
+first binding the @code{setf} argument forms
+@code{(@var{value} @var{args}@dots{})} according to @var{arglist},
+and then executing @var{body}. @var{body} should return a Lisp
+form that does the assignment, and finally returns the value that was
+set. An example of using this macro is:
+
+@example
+(gv-define-setter caar (val x) `(setcar (car ,x) ,val))
+@end example
+@end defmac
+
+@findex gv-define-expander
+@findex gv-letplace
+@c FIXME? Not sure what or how much to say about these.
+@c See cl.texi for an example of using gv-letplace.
+For more control over the expansion, see the macro @code{gv-define-expander}.
+The macro @code{gv-letplace} can be useful in defining macros that
+perform similarly to @code{setf}; for example, the @code{incf} macro
+of Common Lisp. Consult the source file @file{gv.el} for more details.
+
+@cindex CL note---no @code{setf} functions
+@quotation
+@b{Common Lisp note:} Common Lisp defines another way to specify the
+@code{setf} behavior of a function, namely ``@code{setf} functions'',
+whose names are lists @code{(setf @var{name})} rather than symbols.
+For example, @code{(defun (setf foo) @dots{})} defines the function
+that is used when @code{setf} is applied to @code{foo}. Emacs does
+not support this. It is a compile-time error to use @code{setf} on a
+form that has not already had an appropriate expansion defined. In
+Common Lisp, this is not an error since the function @code{(setf
+@var{func})} might be defined later.
+@end quotation
diff --git a/doc/lispref/vol1.texi b/doc/lispref/vol1.texi
deleted file mode 100644
index c89447fc139..00000000000
--- a/doc/lispref/vol1.texi
+++ /dev/null
@@ -1,1555 +0,0 @@
-\input texinfo @c -*-texinfo-*-
-@c This file is used for printing the GNU Emacs Lisp Reference Manual
-@c in two volumes. It is a modified version of elisp.texi.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
-@c Free Software Foundation, Inc.
-@c %**start of header
-@setfilename elisp
-@settitle GNU Emacs Lisp Reference Manual: Volume 1
-@c %**end of header
-
-@c See two-volume-cross-refs.txt.
-@tex
-\message{Formatting for two volume edition...Volume 1...}
-%
-% Read special toc file, set up in two-volume.make.
-\gdef\tocreadfilename{elisp1-toc-ready.toc}
-%
-% Don't make outlines, they're not needed and \readdatafile can't pay
-% attention to the special definition above.
-\global\let\pdfmakeoutlines=\relax
-%
-% Start volume 1 chapter numbering at 1; this must be listed as chapno0.
-\global\chapno=0
-@end tex
-
-@c Version of the manual and of Emacs.
-@c Please remember to update the edition number in README as well.
-@set VERSION 3.0
-@include emacsver.texi
-@set DATE July 2009
-
-@dircategory Emacs
-@direntry
-* Elisp: (elisp). The Emacs Lisp Reference Manual.
-@end direntry
-
-@c in general, keep the following line commented out, unless doing a
-@c copy of this manual that will be published. the manual should go
-@c onto the distribution in the full, 8.5 x 11" size.
-@set smallbook
-
-@ifset smallbook
-@smallbook
-@end ifset
-
-@c per rms and peterb, use 10pt fonts for the main text, mostly to
-@c save on paper cost.
-@c Do this inside @tex for now, so current makeinfo does not complain.
-@tex
-@ifset smallbook
-@fonttextsize 10
-\global\let\urlcolor=\Black % don't print links in grayscale
-\global\let\linkcolor=\Black
-@end ifset
-\global\hbadness=6666 % don't worry about not-too-underfull boxes
-@end tex
-
-@c Combine indices.
-@synindex cp fn
-@syncodeindex vr fn
-@syncodeindex ky fn
-@syncodeindex pg fn
-@c We use the "type index" to index new functions and variables.
-@c @syncodeindex tp fn
-
-@copying
-This is edition @value{VERSION} of the GNU Emacs Lisp Reference Manual,@*
-corresponding to Emacs version @value{EMACSVER}.
-
-Copyright @copyright{} 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1998,
-1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software
-Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.3 or
-any later version published by the Free Software Foundation; with the
-Invariant Sections being ``GNU General Public License,'' with the
-Front-Cover texts being ``A GNU Manual,'' and with the Back-Cover
-Texts as in (a) below. A copy of the license is included in the
-section entitled ``GNU Free Documentation License.''
-
-(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and
-modify this GNU manual. Buying copies from the FSF supports it in
-developing GNU and promoting software freedom.''
-@end quotation
-@end copying
-
-@titlepage
-@title GNU Emacs Lisp Reference Manual
-@subtitle Volume 1
-@subtitle For Emacs Version @value{EMACSVER}
-@subtitle Revision @value{VERSION}, @value{DATE}
-
-@author by Bil Lewis, Dan LaLiberte, Richard Stallman
-@author and the GNU Manual Group
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-
-@sp 2
-
-Published by the Free Software Foundation @*
-51 Franklin St, Fifth Floor @*
-Boston, MA 02110-1301 @*
-USA @*
-ISBN 1-882114-74-4
-
-@sp 2
-Cover art by Etienne Suvasa.
-@end titlepage
-
-
-@c Print the tables of contents
-@summarycontents
-@contents
-
-
-@ifnottex
-@node Top, Introduction, (dir), (dir)
-@top Emacs Lisp
-
-This Info file contains edition @value{VERSION} of the GNU Emacs Lisp
-Reference Manual, corresponding to GNU Emacs version @value{EMACSVER}.
-@end ifnottex
-
-@menu
-* Introduction:: Introduction and conventions used.
-
-* Lisp Data Types:: Data types of objects in Emacs Lisp.
-* Numbers:: Numbers and arithmetic functions.
-* Strings and Characters:: Strings, and functions that work on them.
-* Lists:: Lists, cons cells, and related functions.
-* Sequences Arrays Vectors:: Lists, strings and vectors are called sequences.
- Certain functions act on any kind of sequence.
- The description of vectors is here as well.
-* Hash Tables:: Very fast lookup-tables.
-* Symbols:: Symbols represent names, uniquely.
-
-* Evaluation:: How Lisp expressions are evaluated.
-* Control Structures:: Conditionals, loops, nonlocal exits.
-* Variables:: Using symbols in programs to stand for values.
-* Functions:: A function is a Lisp program
- that can be invoked from other functions.
-* Macros:: Macros are a way to extend the Lisp language.
-* Customization:: Writing customization declarations.
-
-* Loading:: Reading files of Lisp code into Lisp.
-* Byte Compilation:: Compilation makes programs run faster.
-* Advising Functions:: Adding to the definition of a function.
-* Debugging:: Tools and tips for debugging Lisp programs.
-
-* Read and Print:: Converting Lisp objects to text and back.
-* Minibuffers:: Using the minibuffer to read input.
-* Command Loop:: How the editor command loop works,
- and how you can call its subroutines.
-* Keymaps:: Defining the bindings from keys to commands.
-* Modes:: Defining major and minor modes.
-* Documentation:: Writing and using documentation strings.
-
-* Files:: Accessing files.
-* Backups and Auto-Saving:: Controlling how backups and auto-save
- files are made.
-* Buffers:: Creating and using buffer objects.
-* Windows:: Manipulating windows and displaying buffers.
-* Frames:: Making multiple system-level windows.
-* Positions:: Buffer positions and motion functions.
-* Markers:: Markers represent positions and update
- automatically when the text is changed.
-
-* Text:: Examining and changing text in buffers.
-* Non-ASCII Characters:: Non-ASCII text in buffers and strings.
-* Searching and Matching:: Searching buffers for strings or regexps.
-* Syntax Tables:: The syntax table controls word and list parsing.
-* Abbrevs:: How Abbrev mode works, and its data structures.
-
-* Processes:: Running and communicating with subprocesses.
-* Display:: Features for controlling the screen display.
-* System Interface:: Getting the user id, system type, environment
- variables, and other such things.
-
-* Packaging:: Preparing Lisp code for distribution.
-
-Appendices
-
-* Antinews:: Info for users downgrading to Emacs 22.
-* GNU Free Documentation License:: The license for this documentation.
-* GPL:: Conditions for copying and changing GNU Emacs.
-* Tips:: Advice and coding conventions for Emacs Lisp.
-* GNU Emacs Internals:: Building and dumping Emacs;
- internal data structures.
-* Standard Errors:: List of all error symbols.
-* Standard Buffer-Local Variables::
- List of variables buffer-local in all buffers.
-* Standard Keymaps:: List of standard keymaps.
-* Standard Hooks:: List of standard hook variables.
-
-* Index:: Index including concepts, functions, variables,
- and other terms.
-
-@ignore
-* New Symbols:: New functions and variables in Emacs @value{EMACSVER}.
-@end ignore
-
-@c Do NOT modify the following 3 lines! They must have this form to
-@c be correctly identified by `texinfo-multiple-files-update'. In
-@c particular, the detailed menu header line MUST be identical to the
-@c value of `texinfo-master-menu-header'. See texnfo-upd.el.
-
-@detailmenu
- --- The Detailed Node Listing ---
- ---------------------------------
-
-Here are other nodes that are subnodes of those already listed,
-mentioned here so you can get to them in one step:
-
-Introduction
-
-* Caveats:: Flaws and a request for help.
-* Lisp History:: Emacs Lisp is descended from Maclisp.
-* Conventions:: How the manual is formatted.
-* Version Info:: Which Emacs version is running?
-* Acknowledgements:: The authors, editors, and sponsors of this manual.
-
-Conventions
-
-* Some Terms:: Explanation of terms we use in this manual.
-* nil and t:: How the symbols @code{nil} and @code{t} are used.
-* Evaluation Notation:: The format we use for examples of evaluation.
-* Printing Notation:: The format we use when examples print text.
-* Error Messages:: The format we use for examples of errors.
-* Buffer Text Notation:: The format we use for buffer contents in examples.
-* Format of Descriptions:: Notation for describing functions, variables, etc.
-
-Format of Descriptions
-
-* A Sample Function Description:: A description of an imaginary
- function, @code{foo}.
-* A Sample Variable Description:: A description of an imaginary
- variable, @code{electric-future-map}.
-
-Lisp Data Types
-
-* Printed Representation:: How Lisp objects are represented as text.
-* Comments:: Comments and their formatting conventions.
-* Programming Types:: Types found in all Lisp systems.
-* Editing Types:: Types specific to Emacs.
-* Circular Objects:: Read syntax for circular structure.
-* Type Predicates:: Tests related to types.
-* Equality Predicates:: Tests of equality between any two objects.
-
-Programming Types
-
-* Integer Type:: Numbers without fractional parts.
-* Floating Point Type:: Numbers with fractional parts and with a large range.
-* Character Type:: The representation of letters, numbers and
- control characters.
-* Symbol Type:: A multi-use object that refers to a function,
- variable, or property list, and has a unique identity.
-* Sequence Type:: Both lists and arrays are classified as sequences.
-* Cons Cell Type:: Cons cells, and lists (which are made from cons cells).
-* Array Type:: Arrays include strings and vectors.
-* String Type:: An (efficient) array of characters.
-* Vector Type:: One-dimensional arrays.
-* Char-Table Type:: One-dimensional sparse arrays indexed by characters.
-* Bool-Vector Type:: One-dimensional arrays of @code{t} or @code{nil}.
-* Hash Table Type:: Super-fast lookup tables.
-* Function Type:: A piece of executable code you can call from elsewhere.
-* Macro Type:: A method of expanding an expression into another
- expression, more fundamental but less pretty.
-* Primitive Function Type:: A function written in C, callable from Lisp.
-* Byte-Code Type:: A function written in Lisp, then compiled.
-* Autoload Type:: A type used for automatically loading seldom-used
- functions.
-
-Character Type
-
-* Basic Char Syntax:: Syntax for regular characters.
-* General Escape Syntax:: How to specify characters by their codes.
-* Ctl-Char Syntax:: Syntax for control characters.
-* Meta-Char Syntax:: Syntax for meta-characters.
-* Other Char Bits:: Syntax for hyper-, super-, and alt-characters.
-
-Cons Cell and List Types
-
-* Box Diagrams:: Drawing pictures of lists.
-* Dotted Pair Notation:: A general syntax for cons cells.
-* Association List Type:: A specially constructed list.
-
-String Type
-
-* Syntax for Strings:: How to specify Lisp strings.
-* Non-ASCII in Strings:: International characters in strings.
-* Nonprinting Characters:: Literal unprintable characters in strings.
-* Text Props and Strings:: Strings with text properties.
-
-Editing Types
-
-* Buffer Type:: The basic object of editing.
-* Marker Type:: A position in a buffer.
-* Window Type:: Buffers are displayed in windows.
-* Frame Type:: Windows subdivide frames.
-* Terminal Type:: A terminal device displays frames.
-* Window Configuration Type:: Recording the way a frame is subdivided.
-* Frame Configuration Type:: Recording the status of all frames.
-* Process Type:: A subprocess of Emacs running on the underlying OS.
-* Stream Type:: Receive or send characters.
-* Keymap Type:: What function a keystroke invokes.
-* Overlay Type:: How an overlay is represented.
-* Font Type:: Fonts for displaying text.
-
-Numbers
-
-* Integer Basics:: Representation and range of integers.
-* Float Basics:: Representation and range of floating point.
-* Predicates on Numbers:: Testing for numbers.
-* Comparison of Numbers:: Equality and inequality predicates.
-* Numeric Conversions:: Converting float to integer and vice versa.
-* Arithmetic Operations:: How to add, subtract, multiply and divide.
-* Rounding Operations:: Explicitly rounding floating point numbers.
-* Bitwise Operations:: Logical and, or, not, shifting.
-* Math Functions:: Trig, exponential and logarithmic functions.
-* Random Numbers:: Obtaining random integers, predictable or not.
-
-Strings and Characters
-
-* String Basics:: Basic properties of strings and characters.
-* Predicates for Strings:: Testing whether an object is a string or char.
-* Creating Strings:: Functions to allocate new strings.
-* Modifying Strings:: Altering the contents of an existing string.
-* Text Comparison:: Comparing characters or strings.
-* String Conversion:: Converting to and from characters and strings.
-* Formatting Strings:: @code{format}: Emacs's analogue of @code{printf}.
-* Case Conversion:: Case conversion functions.
-* Case Tables:: Customizing case conversion.
-
-Lists
-
-* Cons Cells:: How lists are made out of cons cells.
-* List-related Predicates:: Is this object a list? Comparing two lists.
-* List Elements:: Extracting the pieces of a list.
-* Building Lists:: Creating list structure.
-* List Variables:: Modifying lists stored in variables.
-* Modifying Lists:: Storing new pieces into an existing list.
-* Sets And Lists:: A list can represent a finite mathematical set.
-* Association Lists:: A list can represent a finite relation or mapping.
-* Rings:: Managing a fixed-size ring of objects.
-
-Modifying Existing List Structure
-
-* Setcar:: Replacing an element in a list.
-* Setcdr:: Replacing part of the list backbone.
- This can be used to remove or add elements.
-* Rearrangement:: Reordering the elements in a list; combining lists.
-
-Sequences, Arrays, and Vectors
-
-* Sequence Functions:: Functions that accept any kind of sequence.
-* Arrays:: Characteristics of arrays in Emacs Lisp.
-* Array Functions:: Functions specifically for arrays.
-* Vectors:: Special characteristics of Emacs Lisp vectors.
-* Vector Functions:: Functions specifically for vectors.
-* Char-Tables:: How to work with char-tables.
-* Bool-Vectors:: How to work with bool-vectors.
-
-Hash Tables
-
-* Creating Hash:: Functions to create hash tables.
-* Hash Access:: Reading and writing the hash table contents.
-* Defining Hash:: Defining new comparison methods.
-* Other Hash:: Miscellaneous.
-
-Symbols
-
-* Symbol Components:: Symbols have names, values, function definitions
- and property lists.
-* Definitions:: A definition says how a symbol will be used.
-* Creating Symbols:: How symbols are kept unique.
-* Property Lists:: Each symbol has a property list
- for recording miscellaneous information.
-
-Property Lists
-
-* Plists and Alists:: Comparison of the advantages of property
- lists and association lists.
-* Symbol Plists:: Functions to access symbols' property lists.
-* Other Plists:: Accessing property lists stored elsewhere.
-
-Evaluation
-
-* Intro Eval:: Evaluation in the scheme of things.
-* Forms:: How various sorts of objects are evaluated.
-* Quoting:: Avoiding evaluation (to put constants in
- the program).
-* Eval:: How to invoke the Lisp interpreter explicitly.
-
-Kinds of Forms
-
-* Self-Evaluating Forms:: Forms that evaluate to themselves.
-* Symbol Forms:: Symbols evaluate as variables.
-* Classifying Lists:: How to distinguish various sorts of list forms.
-* Function Indirection:: When a symbol appears as the car of a list,
- we find the real function via the symbol.
-* Function Forms:: Forms that call functions.
-* Macro Forms:: Forms that call macros.
-* Special Forms:: "Special forms" are idiosyncratic primitives,
- most of them extremely important.
-* Autoloading:: Functions set up to load files
- containing their real definitions.
-
-Control Structures
-
-* Sequencing:: Evaluation in textual order.
-* Conditionals:: @code{if}, @code{cond}, @code{when}, @code{unless}.
-* Combining Conditions:: @code{and}, @code{or}, @code{not}.
-* Iteration:: @code{while} loops.
-* Nonlocal Exits:: Jumping out of a sequence.
-
-Nonlocal Exits
-
-* Catch and Throw:: Nonlocal exits for the program's own purposes.
-* Examples of Catch:: Showing how such nonlocal exits can be written.
-* Errors:: How errors are signaled and handled.
-* Cleanups:: Arranging to run a cleanup form if an
- error happens.
-
-Errors
-
-* Signaling Errors:: How to report an error.
-* Processing of Errors:: What Emacs does when you report an error.
-* Handling Errors:: How you can trap errors and continue execution.
-* Error Symbols:: How errors are classified for trapping them.
-
-Variables
-
-* Global Variables:: Variable values that exist permanently, everywhere.
-* Constant Variables:: Certain "variables" have values that never change.
-* Local Variables:: Variable values that exist only temporarily.
-* Void Variables:: Symbols that lack values.
-* Defining Variables:: A definition says a symbol is used as a variable.
-* Tips for Defining:: Things you should think about when you
- define a variable.
-* Accessing Variables:: Examining values of variables whose names
- are known only at run time.
-* Setting Variables:: Storing new values in variables.
-* Variable Scoping:: How Lisp chooses among local and global values.
-* Buffer-Local Variables:: Variable values in effect only in one buffer.
-* File Local Variables:: Handling local variable lists in files.
-* Directory Local Variables:: Local variables common to all files in a
- directory.
-* Frame-Local Variables:: Frame-local bindings for variables.
-* Variable Aliases:: Variables that are aliases for other variables.
-* Variables with Restricted Values:: Non-constant variables whose value can
- @emph{not} be an arbitrary Lisp object.
-
-Scoping Rules for Variable Bindings
-
-* Scope:: Scope means where in the program a value
- is visible. Comparison with other languages.
-* Extent:: Extent means how long in time a value exists.
-* Impl of Scope:: Two ways to implement dynamic scoping.
-* Using Scoping:: How to use dynamic scoping carefully and
- avoid problems.
-
-Buffer-Local Variables
-
-* Intro to Buffer-Local:: Introduction and concepts.
-* Creating Buffer-Local:: Creating and destroying buffer-local bindings.
-* Default Value:: The default value is seen in buffers
- that don't have their own buffer-local values.
-
-Functions
-
-* What Is a Function:: Lisp functions vs. primitives; terminology.
-* Lambda Expressions:: How functions are expressed as Lisp objects.
-* Function Names:: A symbol can serve as the name of a function.
-* Defining Functions:: Lisp expressions for defining functions.
-* Calling Functions:: How to use an existing function.
-* Mapping Functions:: Applying a function to each element of a list, etc.
-* Anonymous Functions:: Lambda expressions are functions with no names.
-* Function Cells:: Accessing or setting the function definition
- of a symbol.
-* Obsolete Functions:: Declaring functions obsolete.
-* Inline Functions:: Defining functions that the compiler
- will open code.
-* Declaring Functions:: Telling the compiler that a function is defined.
-* Function Safety:: Determining whether a function is safe to call.
-* Related Topics:: Cross-references to specific Lisp primitives
- that have a special bearing on how
- functions work.
-
-Lambda Expressions
-
-* Lambda Components:: The parts of a lambda expression.
-* Simple Lambda:: A simple example.
-* Argument List:: Details and special features of argument lists.
-* Function Documentation:: How to put documentation in a function.
-
-Macros
-
-* Simple Macro:: A basic example.
-* Expansion:: How, when and why macros are expanded.
-* Compiling Macros:: How macros are expanded by the compiler.
-* Defining Macros:: How to write a macro definition.
-* Backquote:: Easier construction of list structure.
-* Problems with Macros:: Don't evaluate the macro arguments too many times.
- Don't hide the user's variables.
-* Indenting Macros:: Specifying how to indent macro calls.
-
-Common Problems Using Macros
-
-* Wrong Time:: Do the work in the expansion, not in the macro.
-* Argument Evaluation:: The expansion should evaluate each macro arg once.
-* Surprising Local Vars:: Local variable bindings in the expansion
- require special care.
-* Eval During Expansion:: Don't evaluate them; put them in the expansion.
-* Repeated Expansion:: Avoid depending on how many times expansion is done.
-
-Writing Customization Definitions
-
-* Common Keywords:: Common keyword arguments for all kinds of
- customization declarations.
-* Group Definitions:: Writing customization group definitions.
-* Variable Definitions:: Declaring user options.
-* Customization Types:: Specifying the type of a user option.
-
-Customization Types
-
-* Simple Types:: Simple customization types: sexp, integer, number,
- string, file, directory, alist.
-* Composite Types:: Build new types from other types or data.
-* Splicing into Lists:: Splice elements into list with @code{:inline}.
-* Type Keywords:: Keyword-argument pairs in a customization type.
-* Defining New Types:: Give your type a name.
-
-Loading
-
-* How Programs Do Loading:: The @code{load} function and others.
-* Load Suffixes:: Details about the suffixes that @code{load} tries.
-* Library Search:: Finding a library to load.
-* Loading Non-ASCII:: Non-@acronym{ASCII} characters in Emacs Lisp files.
-* Autoload:: Setting up a function to autoload.
-* Repeated Loading:: Precautions about loading a file twice.
-* Named Features:: Loading a library if it isn't already loaded.
-* Where Defined:: Finding which file defined a certain symbol.
-* Unloading:: How to "unload" a library that was loaded.
-* Hooks for Loading:: Providing code to be run when
- particular libraries are loaded.
-
-Byte Compilation
-
-* Speed of Byte-Code:: An example of speedup from byte compilation.
-* Compilation Functions:: Byte compilation functions.
-* Docs and Compilation:: Dynamic loading of documentation strings.
-* Dynamic Loading:: Dynamic loading of individual functions.
-* Eval During Compile:: Code to be evaluated when you compile.
-* Compiler Errors:: Handling compiler error messages.
-* Byte-Code Objects:: The data type used for byte-compiled functions.
-* Disassembly:: Disassembling byte-code; how to read byte-code.
-
-Advising Emacs Lisp Functions
-
-* Simple Advice:: A simple example to explain the basics of advice.
-* Defining Advice:: Detailed description of @code{defadvice}.
-* Around-Advice:: Wrapping advice around a function's definition.
-* Computed Advice:: ...is to @code{defadvice} as @code{fset} is to @code{defun}.
-* Activation of Advice:: Advice doesn't do anything until you activate it.
-* Enabling Advice:: You can enable or disable each piece of advice.
-* Preactivation:: Preactivation is a way of speeding up the
- loading of compiled advice.
-* Argument Access in Advice:: How advice can access the function's arguments.
-* Advising Primitives:: Accessing arguments when advising a primitive.
-* Combined Definition:: How advice is implemented.
-
-Debugging Lisp Programs
-
-* Debugger:: How the Emacs Lisp debugger is implemented.
-* Edebug:: A source-level Emacs Lisp debugger.
-* Syntax Errors:: How to find syntax errors.
-* Test Coverage:: Ensuring you have tested all branches in your code.
-* Compilation Errors:: How to find errors that show up in
- byte compilation.
-
-The Lisp Debugger
-
-* Error Debugging:: Entering the debugger when an error happens.
-* Infinite Loops:: Stopping and debugging a program that doesn't exit.
-* Function Debugging:: Entering it when a certain function is called.
-* Explicit Debug:: Entering it at a certain point in the program.
-* Using Debugger:: What the debugger does; what you see while in it.
-* Debugger Commands:: Commands used while in the debugger.
-* Invoking the Debugger:: How to call the function @code{debug}.
-* Internals of Debugger:: Subroutines of the debugger, and global variables.
-
-Edebug
-
-* Using Edebug:: Introduction to use of Edebug.
-* Instrumenting:: You must instrument your code
- in order to debug it with Edebug.
-* Edebug Execution Modes:: Execution modes, stopping more or less often.
-* Jumping:: Commands to jump to a specified place.
-* Edebug Misc:: Miscellaneous commands.
-* Breaks:: Setting breakpoints to make the program stop.
-* Trapping Errors:: Trapping errors with Edebug.
-* Edebug Views:: Views inside and outside of Edebug.
-* Edebug Eval:: Evaluating expressions within Edebug.
-* Eval List:: Expressions whose values are displayed
- each time you enter Edebug.
-* Printing in Edebug:: Customization of printing.
-* Trace Buffer:: How to produce trace output in a buffer.
-* Coverage Testing:: How to test evaluation coverage.
-* The Outside Context:: Data that Edebug saves and restores.
-* Edebug and Macros:: Specifying how to handle macro calls.
-* Edebug Options:: Option variables for customizing Edebug.
-
-Breaks
-
-* Breakpoints:: Breakpoints at stop points.
-* Global Break Condition:: Breaking on an event.
-* Source Breakpoints:: Embedding breakpoints in source code.
-
-The Outside Context
-
-* Checking Whether to Stop::When Edebug decides what to do.
-* Edebug Display Update:: When Edebug updates the display.
-* Edebug Recursive Edit:: When Edebug stops execution.
-
-Edebug and Macros
-
-* Instrumenting Macro Calls::The basic problem.
-* Specification List:: How to specify complex patterns of evaluation.
-* Backtracking:: What Edebug does when matching fails.
-* Specification Examples:: To help understand specifications.
-
-Debugging Invalid Lisp Syntax
-
-* Excess Open:: How to find a spurious open paren or missing close.
-* Excess Close:: How to find a spurious close paren or missing open.
-
-Reading and Printing Lisp Objects
-
-* Streams Intro:: Overview of streams, reading and printing.
-* Input Streams:: Various data types that can be used as
- input streams.
-* Input Functions:: Functions to read Lisp objects from text.
-* Output Streams:: Various data types that can be used as
- output streams.
-* Output Functions:: Functions to print Lisp objects as text.
-* Output Variables:: Variables that control what the printing
- functions do.
-
-Minibuffers
-
-* Intro to Minibuffers:: Basic information about minibuffers.
-* Text from Minibuffer:: How to read a straight text string.
-* Object from Minibuffer:: How to read a Lisp object or expression.
-* Minibuffer History:: Recording previous minibuffer inputs
- so the user can reuse them.
-* Initial Input:: Specifying initial contents for the minibuffer.
-* Completion:: How to invoke and customize completion.
-* Yes-or-No Queries:: Asking a question with a simple answer.
-* Multiple Queries:: Asking a series of similar questions.
-* Reading a Password:: Reading a password from the terminal.
-* Minibuffer Commands:: Commands used as key bindings in minibuffers.
-* Minibuffer Contents:: How such commands access the minibuffer text.
-* Minibuffer Windows:: Operating on the special minibuffer windows.
-* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
-* Minibuffer Misc:: Various customization hooks and variables.
-
-Completion
-
-* Basic Completion:: Low-level functions for completing strings.
- (These are too low level to use the minibuffer.)
-* Minibuffer Completion:: Invoking the minibuffer with completion.
-* Completion Commands:: Minibuffer commands that do completion.
-* High-Level Completion:: Convenient special cases of completion
- (reading buffer name, file name, etc.).
-* Reading File Names:: Using completion to read file names and
- shell commands.
-* Completion Styles:: Specifying rules for performing completion.
-* Programmed Completion:: Writing your own completion-function.
-
-Command Loop
-
-* Command Overview:: How the command loop reads commands.
-* Defining Commands:: Specifying how a function should read arguments.
-* Interactive Call:: Calling a command, so that it will read arguments.
-* Distinguish Interactive:: Making a command distinguish interactive calls.
-* Command Loop Info:: Variables set by the command loop for you to examine.
-* Adjusting Point:: Adjustment of point after a command.
-* Input Events:: What input looks like when you read it.
-* Reading Input:: How to read input events from the keyboard or mouse.
-* Special Events:: Events processed immediately and individually.
-* Waiting:: Waiting for user input or elapsed time.
-* Quitting:: How @kbd{C-g} works. How to catch or defer quitting.
-* Prefix Command Arguments:: How the commands to set prefix args work.
-* Recursive Editing:: Entering a recursive edit,
- and why you usually shouldn't.
-* Disabling Commands:: How the command loop handles disabled commands.
-* Command History:: How the command history is set up, and how accessed.
-* Keyboard Macros:: How keyboard macros are implemented.
-
-Defining Commands
-
-* Using Interactive:: General rules for @code{interactive}.
-* Interactive Codes:: The standard letter-codes for reading arguments
- in various ways.
-* Interactive Examples:: Examples of how to read interactive arguments.
-
-Input Events
-
-* Keyboard Events:: Ordinary characters--keys with symbols on them.
-* Function Keys:: Function keys--keys with names, not symbols.
-* Mouse Events:: Overview of mouse events.
-* Click Events:: Pushing and releasing a mouse button.
-* Drag Events:: Moving the mouse before releasing the button.
-* Button-Down Events:: A button was pushed and not yet released.
-* Repeat Events:: Double and triple click (or drag, or down).
-* Motion Events:: Just moving the mouse, not pushing a button.
-* Focus Events:: Moving the mouse between frames.
-* Misc Events:: Other events the system can generate.
-* Event Examples:: Examples of the lists for mouse events.
-* Classifying Events:: Finding the modifier keys in an event symbol.
- Event types.
-* Accessing Mouse:: Functions to extract info from mouse events.
-* Accessing Scroll:: Functions to get info from scroll bar events.
-* Strings of Events:: Special considerations for putting
- keyboard character events in a string.
-
-Reading Input
-
-* Key Sequence Input:: How to read one key sequence.
-* Reading One Event:: How to read just one event.
-* Event Mod:: How Emacs modifies events as they are read.
-* Invoking the Input Method:: How reading an event uses the input method.
-* Quoted Character Input:: Asking the user to specify a character.
-* Event Input Misc:: How to reread or throw away input events.
-
-Keymaps
-
-* Key Sequences:: Key sequences as Lisp objects.
-* Keymap Basics:: Basic concepts of keymaps.
-* Format of Keymaps:: What a keymap looks like as a Lisp object.
-* Creating Keymaps:: Functions to create and copy keymaps.
-* Inheritance and Keymaps:: How one keymap can inherit the bindings
- of another keymap.
-* Prefix Keys:: Defining a key with a keymap as its definition.
-* Active Keymaps:: How Emacs searches the active keymaps
- for a key binding.
-* Searching Keymaps:: A pseudo-Lisp summary of searching active maps.
-* Controlling Active Maps:: Each buffer has a local keymap
- to override the standard (global) bindings.
- A minor mode can also override them.
-* Key Lookup:: Finding a key's binding in one keymap.
-* Functions for Key Lookup:: How to request key lookup.
-* Changing Key Bindings:: Redefining a key in a keymap.
-* Remapping Commands:: A keymap can translate one command to another.
-* Translation Keymaps:: Keymaps for translating sequences of events.
-* Key Binding Commands:: Interactive interfaces for redefining keys.
-* Scanning Keymaps:: Looking through all keymaps, for printing help.
-* Menu Keymaps:: Defining a menu as a keymap.
-
-Menu Keymaps
-
-* Defining Menus:: How to make a keymap that defines a menu.
-* Mouse Menus:: How users actuate the menu with the mouse.
-* Keyboard Menus:: How users actuate the menu with the keyboard.
-* Menu Example:: Making a simple menu.
-* Menu Bar:: How to customize the menu bar.
-* Tool Bar:: A tool bar is a row of images.
-* Modifying Menus:: How to add new items to a menu.
-
-Defining Menus
-
-* Simple Menu Items:: A simple kind of menu key binding,
- limited in capabilities.
-* Extended Menu Items:: More powerful menu item definitions
- let you specify keywords to enable
- various features.
-* Menu Separators:: Drawing a horizontal line through a menu.
-* Alias Menu Items:: Using command aliases in menu items.
-
-Major and Minor Modes
-
-* Hooks:: How to use hooks; how to write code that provides hooks.
-* Major Modes:: Defining major modes.
-* Minor Modes:: Defining minor modes.
-* Mode Line Format:: Customizing the text that appears in the mode line.
-* Imenu:: Providing a menu of definitions made in a buffer.
-* Font Lock Mode:: How modes can highlight text according to syntax.
-* Desktop Save Mode:: How modes can have buffer state saved between
- Emacs sessions.
-
-Hooks
-
-* Running Hooks:: How to run a hook.
-* Setting Hooks:: How to put functions on a hook, or remove them.
-
-Major Modes
-
-* Major Mode Conventions:: Coding conventions for keymaps, etc.
-* Auto Major Mode:: How Emacs chooses the major mode automatically.
-* Mode Help:: Finding out how to use a mode.
-* Derived Modes:: Defining a new major mode based on another major
- mode.
-* Basic Major Modes:: Modes that other modes are often derived from.
-* Generic Modes:: Defining a simple major mode that supports
- comment syntax and Font Lock mode.
-* Mode Hooks:: Hooks run at the end of major mode commands.
-* Example Major Modes:: Text mode and Lisp modes.
-
-Minor Modes
-
-* Minor Mode Conventions:: Tips for writing a minor mode.
-* Keymaps and Minor Modes:: How a minor mode can have its own keymap.
-* Defining Minor Modes:: A convenient facility for defining minor modes.
-
-Mode Line Format
-
-* Mode Line Basics:: Basic ideas of mode line control.
-* Mode Line Data:: The data structure that controls the mode line.
-* Mode Line Top:: The top level variable, mode-line-format.
-* Mode Line Variables:: Variables used in that data structure.
-* %-Constructs:: Putting information into a mode line.
-* Properties in Mode:: Using text properties in the mode line.
-* Header Lines:: Like a mode line, but at the top.
-* Emulating Mode Line:: Formatting text as the mode line would.
-
-Font Lock Mode
-
-* Font Lock Basics:: Overview of customizing Font Lock.
-* Search-based Fontification:: Fontification based on regexps.
-* Customizing Keywords:: Customizing search-based fontification.
-* Other Font Lock Variables:: Additional customization facilities.
-* Levels of Font Lock:: Each mode can define alternative levels
- so that the user can select more or less.
-* Precalculated Fontification:: How Lisp programs that produce the buffer
- contents can also specify how to fontify it.
-* Faces for Font Lock:: Special faces specifically for Font Lock.
-* Syntactic Font Lock:: Fontification based on syntax tables.
-* Setting Syntax Properties:: Defining character syntax based on context
- using the Font Lock mechanism.
-* Multiline Font Lock:: How to coerce Font Lock into properly
- highlighting multiline constructs.
-
-Multiline Font Lock Constructs
-
-* Font Lock Multiline:: Marking multiline chunks with a text property.
-* Region to Refontify:: Controlling which region gets refontified
- after a buffer change.
-
-Documentation
-
-* Documentation Basics:: Good style for doc strings.
- Where to put them. How Emacs stores them.
-* Accessing Documentation:: How Lisp programs can access doc strings.
-* Keys in Documentation:: Substituting current key bindings.
-* Describing Characters:: Making printable descriptions of
- non-printing characters and key sequences.
-* Help Functions:: Subroutines used by Emacs help facilities.
-
-Files
-
-* Visiting Files:: Reading files into Emacs buffers for editing.
-* Saving Buffers:: Writing changed buffers back into files.
-* Reading from Files:: Reading files into buffers without visiting.
-* Writing to Files:: Writing new files from parts of buffers.
-* File Locks:: Locking and unlocking files, to prevent
- simultaneous editing by two people.
-* Information about Files:: Testing existence, accessibility, size of files.
-* Changing Files:: Renaming files, changing protection, etc.
-* File Names:: Decomposing and expanding file names.
-* Contents of Directories:: Getting a list of the files in a directory.
-* Create/Delete Dirs:: Creating and Deleting Directories.
-* Magic File Names:: Defining "magic" special handling
- for certain file names.
-* Format Conversion:: Conversion to and from various file formats.
-
-Visiting Files
-
-* Visiting Functions:: The usual interface functions for visiting.
-* Subroutines of Visiting:: Lower-level subroutines that they use.
-
-Information about Files
-
-* Testing Accessibility:: Is a given file readable? Writable?
-* Kinds of Files:: Is it a directory? A symbolic link?
-* Truenames:: Eliminating symbolic links from a file name.
-* File Attributes:: How large is it? Any other names? Etc.
-* Locating Files:: How to find a file in standard places.
-
-File Names
-
-* File Name Components:: The directory part of a file name, and the rest.
-* Relative File Names:: Some file names are relative to a current directory.
-* Directory Names:: A directory's name as a directory
- is different from its name as a file.
-* File Name Expansion:: Converting relative file names to absolute ones.
-* Unique File Names:: Generating names for temporary files.
-* File Name Completion:: Finding the completions for a given file name.
-* Standard File Names:: If your package uses a fixed file name,
- how to handle various operating systems simply.
-
-File Format Conversion
-
-* Format Conversion Overview:: @code{insert-file-contents} and @code{write-region}.
-* Format Conversion Round-Trip:: Using @code{format-alist}.
-* Format Conversion Piecemeal:: Specifying non-paired conversion.
-
-Backups and Auto-Saving
-
-* Backup Files:: How backup files are made; how their names
- are chosen.
-* Auto-Saving:: How auto-save files are made; how their
- names are chosen.
-* Reverting:: @code{revert-buffer}, and how to customize
- what it does.
-
-Backup Files
-
-* Making Backups:: How Emacs makes backup files, and when.
-* Rename or Copy:: Two alternatives: renaming the old file
- or copying it.
-* Numbered Backups:: Keeping multiple backups for each source file.
-* Backup Names:: How backup file names are computed; customization.
-
-Buffers
-
-* Buffer Basics:: What is a buffer?
-* Current Buffer:: Designating a buffer as current
- so that primitives will access its contents.
-* Buffer Names:: Accessing and changing buffer names.
-* Buffer File Name:: The buffer file name indicates which file
- is visited.
-* Buffer Modification:: A buffer is @dfn{modified} if it needs to be saved.
-* Modification Time:: Determining whether the visited file was changed
- ``behind Emacs's back''.
-* Read Only Buffers:: Modifying text is not allowed in a
- read-only buffer.
-* The Buffer List:: How to look at all the existing buffers.
-* Creating Buffers:: Functions that create buffers.
-* Killing Buffers:: Buffers exist until explicitly killed.
-* Indirect Buffers:: An indirect buffer shares text with some
- other buffer.
-* Swapping Text:: Swapping text between two buffers.
-* Buffer Gap:: The gap in the buffer.
-
-Windows
-
-* Basic Windows:: Basic information on using windows.
-* Splitting Windows:: Splitting one window into two windows.
-* Deleting Windows:: Deleting a window gives its space to other windows.
-* Selecting Windows:: The selected window is the one that you edit in.
-* Cyclic Window Ordering:: Moving around the existing windows.
-* Buffers and Windows:: Each window displays the contents of a buffer.
-* Switching Buffers:: Higher-level functions for switching to a buffer.
-* Choosing Window:: How to choose a window for displaying a buffer.
-* Display Action Functions:: Subroutines for @code{display-buffer}.
-* Choosing Window Options:: Extra options affecting how buffers are displayed.
-* Window History:: Each window remembers the buffers displayed in it.
-* Dedicated Windows:: How to avoid displaying another buffer in
- a specific window.
-* Window Point:: Each window has its own location of point.
-* Window Start and End:: Buffer positions indicating which text is
- on-screen in a window.
-* Textual Scrolling:: Moving text up and down through the window.
-* Vertical Scrolling:: Moving the contents up and down on the window.
-* Horizontal Scrolling:: Moving the contents sideways on the window.
-* Size of Window:: Accessing the size of a window.
-* Resizing Windows:: Changing the size of a window.
-* Coordinates and Windows:: Converting coordinates to windows.
-* Window Tree:: The layout and sizes of all windows in a frame.
-* Window Configurations:: Saving and restoring the state of the screen.
-* Window Parameters:: Associating additional information with windows.
-* Window Hooks:: Hooks for scrolling, window size changes,
- redisplay going past a certain point,
- or window configuration changes.
-
-Frames
-
-* Creating Frames:: Creating additional frames.
-* Multiple Terminals:: Displaying on several different devices.
-* Frame Parameters:: Controlling frame size, position, font, etc.
-* Terminal Parameters:: Parameters common for all frames on terminal.
-* Frame Titles:: Automatic updating of frame titles.
-* Deleting Frames:: Frames last until explicitly deleted.
-* Finding All Frames:: How to examine all existing frames.
-* Frames and Windows:: A frame contains windows;
- display of text always works through windows.
-* Minibuffers and Frames:: How a frame finds the minibuffer to use.
-* Input Focus:: Specifying the selected frame.
-* Visibility of Frames:: Frames may be visible or invisible, or icons.
-* Raising and Lowering:: Raising a frame makes it hide other windows;
- lowering it makes the others hide it.
-* Frame Configurations:: Saving the state of all frames.
-* Mouse Tracking:: Getting events that say when the mouse moves.
-* Mouse Position:: Asking where the mouse is, or moving it.
-* Pop-Up Menus:: Displaying a menu for the user to select from.
-* Dialog Boxes:: Displaying a box to ask yes or no.
-* Pointer Shape:: Specifying the shape of the mouse pointer.
-* Window System Selections::Transferring text to and from other X clients.
-* Drag and Drop:: Internals of Drag-and-Drop implementation.
-* Color Names:: Getting the definitions of color names.
-* Text Terminal Colors:: Defining colors for text-only terminals.
-* Resources:: Getting resource values from the server.
-* Display Feature Testing:: Determining the features of a terminal.
-
-Frame Parameters
-
-* Parameter Access:: How to change a frame's parameters.
-* Initial Parameters:: Specifying frame parameters when you make a frame.
-* Window Frame Parameters:: List of frame parameters for window systems.
-* Size and Position:: Changing the size and position of a frame.
-* Geometry:: Parsing geometry specifications.
-
-Window Frame Parameters
-
-* Basic Parameters:: Parameters that are fundamental.
-* Position Parameters:: The position of the frame on the screen.
-* Size Parameters:: Frame's size.
-* Layout Parameters:: Size of parts of the frame, and
- enabling or disabling some parts.
-* Buffer Parameters:: Which buffers have been or should be shown.
-* Management Parameters:: Communicating with the window manager.
-* Cursor Parameters:: Controlling the cursor appearance.
-* Font and Color Parameters:: Fonts and colors for the frame text.
-
-Positions
-
-* Point:: The special position where editing takes place.
-* Motion:: Changing point.
-* Excursions:: Temporary motion and buffer changes.
-* Narrowing:: Restricting editing to a portion of the buffer.
-
-Motion
-
-* Character Motion:: Moving in terms of characters.
-* Word Motion:: Moving in terms of words.
-* Buffer End Motion:: Moving to the beginning or end of the buffer.
-* Text Lines:: Moving in terms of lines of text.
-* Screen Lines:: Moving in terms of lines as displayed.
-* List Motion:: Moving by parsing lists and sexps.
-* Skipping Characters:: Skipping characters belonging to a certain set.
-
-Markers
-
-* Overview of Markers:: The components of a marker, and how it relocates.
-* Predicates on Markers:: Testing whether an object is a marker.
-* Creating Markers:: Making empty markers or markers at certain places.
-* Information from Markers::Finding the marker's buffer or character position.
-* Marker Insertion Types:: Two ways a marker can relocate when you
- insert where it points.
-* Moving Markers:: Moving the marker to a new buffer or position.
-* The Mark:: How "the mark" is implemented with a marker.
-* The Region:: How to access "the region".
-
-Text
-
-* Near Point:: Examining text in the vicinity of point.
-* Buffer Contents:: Examining text in a general fashion.
-* Comparing Text:: Comparing substrings of buffers.
-* Insertion:: Adding new text to a buffer.
-* Commands for Insertion:: User-level commands to insert text.
-* Deletion:: Removing text from a buffer.
-* User-Level Deletion:: User-level commands to delete text.
-* The Kill Ring:: Where removed text sometimes is saved for
- later use.
-* Undo:: Undoing changes to the text of a buffer.
-* Maintaining Undo:: How to enable and disable undo information.
- How to control how much information is kept.
-* Filling:: Functions for explicit filling.
-* Margins:: How to specify margins for filling commands.
-* Adaptive Fill:: Adaptive Fill mode chooses a fill prefix
- from context.
-* Auto Filling:: How auto-fill mode is implemented to break lines.
-* Sorting:: Functions for sorting parts of the buffer.
-* Columns:: Computing horizontal positions, and using them.
-* Indentation:: Functions to insert or adjust indentation.
-* Case Changes:: Case conversion of parts of the buffer.
-* Text Properties:: Assigning Lisp property lists to text characters.
-* Substitution:: Replacing a given character wherever it appears.
-* Transposition:: Swapping two portions of a buffer.
-* Registers:: How registers are implemented. Accessing
- the text or position stored in a register.
-* Base 64:: Conversion to or from base 64 encoding.
-* MD5 Checksum:: Compute the MD5 "message digest"/"checksum".
-* Atomic Changes:: Installing several buffer changes "atomically".
-* Change Hooks:: Supplying functions to be run when text is changed.
-
-The Kill Ring
-
-* Kill Ring Concepts:: What text looks like in the kill ring.
-* Kill Functions:: Functions that kill text.
-* Yanking:: How yanking is done.
-* Yank Commands:: Commands that access the kill ring.
-* Low-Level Kill Ring:: Functions and variables for kill ring access.
-* Internals of Kill Ring:: Variables that hold kill ring data.
-
-Indentation
-
-* Primitive Indent:: Functions used to count and insert indentation.
-* Mode-Specific Indent:: Customize indentation for different modes.
-* Region Indent:: Indent all the lines in a region.
-* Relative Indent:: Indent the current line based on previous lines.
-* Indent Tabs:: Adjustable, typewriter-like tab stops.
-* Motion by Indent:: Move to first non-blank character.
-
-Text Properties
-
-* Examining Properties:: Looking at the properties of one character.
-* Changing Properties:: Setting the properties of a range of text.
-* Property Search:: Searching for where a property changes value.
-* Special Properties:: Particular properties with special meanings.
-* Format Properties:: Properties for representing formatting of text.
-* Sticky Properties:: How inserted text gets properties from
- neighboring text.
-* Lazy Properties:: Computing text properties in a lazy fashion
- only when text is examined.
-* Clickable Text:: Using text properties to make regions of text
- do something when you click on them.
-* Fields:: The @code{field} property defines
- fields within the buffer.
-* Not Intervals:: Why text properties do not use
- Lisp-visible text intervals.
-
-Non-@acronym{ASCII} Characters
-
-* Text Representations:: How Emacs represents text.
-* Converting Representations:: Converting unibyte to multibyte and vice versa.
-* Selecting a Representation:: Treating a byte sequence as unibyte or multi.
-* Character Codes:: How unibyte and multibyte relate to
- codes of individual characters.
-* Character Properties:: Character attributes that define their
- behavior and handling.
-* Character Sets:: The space of possible character codes
- is divided into various character sets.
-* Scanning Charsets:: Which character sets are used in a buffer?
-* Translation of Characters:: Translation tables are used for conversion.
-* Coding Systems:: Coding systems are conversions for saving files.
-* Input Methods:: Input methods allow users to enter various
- non-ASCII characters without special keyboards.
-* Locales:: Interacting with the POSIX locale.
-
-Coding Systems
-
-* Coding System Basics:: Basic concepts.
-* Encoding and I/O:: How file I/O functions handle coding systems.
-* Lisp and Coding Systems:: Functions to operate on coding system names.
-* User-Chosen Coding Systems:: Asking the user to choose a coding system.
-* Default Coding Systems:: Controlling the default choices.
-* Specifying Coding Systems:: Requesting a particular coding system
- for a single file operation.
-* Explicit Encoding:: Encoding or decoding text without doing I/O.
-* Terminal I/O Encoding:: Use of encoding for terminal I/O.
-* MS-DOS File Types:: How DOS "text" and "binary" files
- relate to coding systems.
-
-Searching and Matching
-
-* String Search:: Search for an exact match.
-* Searching and Case:: Case-independent or case-significant searching.
-* Regular Expressions:: Describing classes of strings.
-* Regexp Search:: Searching for a match for a regexp.
-* POSIX Regexps:: Searching POSIX-style for the longest match.
-* Match Data:: Finding out which part of the text matched,
- after a string or regexp search.
-* Search and Replace:: Commands that loop, searching and replacing.
-* Standard Regexps:: Useful regexps for finding sentences, pages,...
-
-Regular Expressions
-
-* Syntax of Regexps:: Rules for writing regular expressions.
-* Regexp Example:: Illustrates regular expression syntax.
-* Regexp Functions:: Functions for operating on regular expressions.
-
-Syntax of Regular Expressions
-
-* Regexp Special:: Special characters in regular expressions.
-* Char Classes:: Character classes used in regular expressions.
-* Regexp Backslash:: Backslash-sequences in regular expressions.
-
-The Match Data
-
-* Replacing Match:: Replacing a substring that was matched.
-* Simple Match Data:: Accessing single items of match data,
- such as where a particular subexpression started.
-* Entire Match Data:: Accessing the entire match data at once, as a list.
-* Saving Match Data:: Saving and restoring the match data.
-
-Syntax Tables
-
-* Syntax Basics:: Basic concepts of syntax tables.
-* Syntax Descriptors:: How characters are classified.
-* Syntax Table Functions:: How to create, examine and alter syntax tables.
-* Syntax Properties:: Overriding syntax with text properties.
-* Motion and Syntax:: Moving over characters with certain syntaxes.
-* Parsing Expressions:: Parsing balanced expressions
- using the syntax table.
-* Standard Syntax Tables:: Syntax tables used by various major modes.
-* Syntax Table Internals:: How syntax table information is stored.
-* Categories:: Another way of classifying character syntax.
-
-Syntax Descriptors
-
-* Syntax Class Table:: Table of syntax classes.
-* Syntax Flags:: Additional flags each character can have.
-
-Parsing Expressions
-
-* Motion via Parsing:: Motion functions that work by parsing.
-* Position Parse:: Determining the syntactic state of a position.
-* Parser State:: How Emacs represents a syntactic state.
-* Low-Level Parsing:: Parsing across a specified region.
-* Control Parsing:: Parameters that affect parsing.
-
-Abbrevs and Abbrev Expansion
-
-* Abbrev Mode:: Setting up Emacs for abbreviation.
-* Abbrev Tables:: Creating and working with abbrev tables.
-* Defining Abbrevs:: Specifying abbreviations and their expansions.
-* Abbrev Files:: Saving abbrevs in files.
-* Abbrev Expansion:: Controlling expansion; expansion subroutines.
-* Standard Abbrev Tables:: Abbrev tables used by various major modes.
-* Abbrev Properties:: How to read and set abbrev properties.
- Which properties have which effect.
-* Abbrev Table Properties:: How to read and set abbrev table properties.
- Which properties have which effect.
-
-Processes
-
-* Subprocess Creation:: Functions that start subprocesses.
-* Shell Arguments:: Quoting an argument to pass it to a shell.
-* Synchronous Processes:: Details of using synchronous subprocesses.
-* Asynchronous Processes:: Starting up an asynchronous subprocess.
-* Deleting Processes:: Eliminating an asynchronous subprocess.
-* Process Information:: Accessing run-status and other attributes.
-* Input to Processes:: Sending input to an asynchronous subprocess.
-* Signals to Processes:: Stopping, continuing or interrupting
- an asynchronous subprocess.
-* Output from Processes:: Collecting output from an asynchronous subprocess.
-* Sentinels:: Sentinels run when process run-status changes.
-* Query Before Exit:: Whether to query if exiting will kill a process.
-* System Processes:: Accessing other processes running on your system.
-* Transaction Queues:: Transaction-based communication with subprocesses.
-* Network:: Opening network connections.
-* Network Servers:: Network servers let Emacs accept net connections.
-* Datagrams:: UDP network connections.
-* Low-Level Network:: Lower-level but more general function
- to create connections and servers.
-* Misc Network:: Additional relevant functions for
- network connections.
-* Serial Ports:: Communicating with serial ports.
-* Byte Packing:: Using bindat to pack and unpack binary data.
-
-Receiving Output from Processes
-
-* Process Buffers:: If no filter, output is put in a buffer.
-* Filter Functions:: Filter functions accept output from the process.
-* Decoding Output:: Filters can get unibyte or multibyte strings.
-* Accepting Output:: How to wait until process output arrives.
-
-Low-Level Network Access
-
-* Network Processes:: Using @code{make-network-process}.
-* Network Options:: Further control over network connections.
-* Network Feature Testing:: Determining which network features work on
- the machine you are using.
-
-Packing and Unpacking Byte Arrays
-
-* Bindat Spec:: Describing data layout.
-* Bindat Functions:: Doing the unpacking and packing.
-* Bindat Examples:: Samples of what bindat.el can do for you!
-
-Emacs Display
-
-* Refresh Screen:: Clearing the screen and redrawing everything on it.
-* Forcing Redisplay:: Forcing redisplay.
-* Truncation:: Folding or wrapping long text lines.
-* The Echo Area:: Displaying messages at the bottom of the screen.
-* Warnings:: Displaying warning messages for the user.
-* Invisible Text:: Hiding part of the buffer text.
-* Selective Display:: Hiding part of the buffer text (the old way).
-* Temporary Displays:: Displays that go away automatically.
-* Overlays:: Use overlays to highlight parts of the buffer.
-* Width:: How wide a character or string is on the screen.
-* Line Height:: Controlling the height of lines.
-* Faces:: A face defines a graphics style
- for text characters: font, colors, etc.
-* Fringes:: Controlling window fringes.
-* Scroll Bars:: Controlling vertical scroll bars.
-* Display Property:: Enabling special display features.
-* Images:: Displaying images in Emacs buffers.
-* Buttons:: Adding clickable buttons to Emacs buffers.
-* Abstract Display:: Emacs' Widget for Object Collections.
-* Blinking:: How Emacs shows the matching open parenthesis.
-* Usual Display:: The usual conventions for displaying
- nonprinting chars.
-* Display Tables:: How to specify other conventions.
-* Beeping:: Audible signal to the user.
-* Window Systems:: Which window system is being used.
-* Bidirectional Display:: Display of bidirectional scripts, such as
- Arabic and Farsi.
-* Glyphless Chars:: How glyphless characters are drawn.
-
-The Echo Area
-
-* Displaying Messages:: Explicitly displaying text in the echo area.
-* Progress:: Informing user about progress of a long operation.
-* Logging Messages:: Echo area messages are logged for the user.
-* Echo Area Customization:: Controlling the echo area.
-
-Reporting Warnings
-
-* Warning Basics:: Warnings concepts and functions to report them.
-* Warning Variables:: Variables programs bind to customize
- their warnings.
-* Warning Options:: Variables users set to control display of warnings.
-
-Overlays
-
-* Managing Overlays:: Creating and moving overlays.
-* Overlay Properties:: How to read and set properties.
- What properties do to the screen display.
-* Finding Overlays:: Searching for overlays.
-
-Faces
-
-* Defining Faces:: How to define a face with @code{defface}.
-* Face Attributes:: What is in a face?
-* Attribute Functions:: Functions to examine and set face attributes.
-* Displaying Faces:: How Emacs combines the faces specified for
- a character.
-* Face Remapping:: Remapping faces to alternative definitions.
-* Face Functions:: How to define and examine faces.
-* Auto Faces:: Hook for automatic face assignment.
-* Basic Faces:: Faces that are defined by default.
-* Font Selection:: Finding the best available font for a face.
-* Font Lookup:: Looking up the names of available fonts
- and information about them.
-* Fontsets:: A fontset is a collection of fonts
- that handle a range of character sets.
-* Low-Level Font:: Lisp representation for character display fonts.
-
-Fringes
-
-* Fringe Size/Pos:: Specifying where to put the window fringes.
-* Fringe Indicators:: Displaying indicator icons in the window fringes.
-* Fringe Cursors:: Displaying cursors in the right fringe.
-* Fringe Bitmaps:: Specifying bitmaps for fringe indicators.
-* Customizing Bitmaps:: Specifying your own bitmaps to use in the fringes.
-* Overlay Arrow:: Display of an arrow to indicate position.
-
-The @code{display} Property
-
-* Replacing Specs:: Display specs that replace the text.
-* Specified Space:: Displaying one space with a specified width.
-* Pixel Specification:: Specifying space width or height in pixels.
-* Other Display Specs:: Displaying an image; adjusting the height,
- spacing, and other properties of text.
-* Display Margins:: Displaying text or images to the side of
- the main text.
-
-Images
-
-* Image Formats:: Supported image formats.
-* Image Descriptors:: How to specify an image for use in @code{:display}.
-* XBM Images:: Special features for XBM format.
-* XPM Images:: Special features for XPM format.
-* GIF Images:: Special features for GIF format.
-* TIFF Images:: Special features for TIFF format.
-* PostScript Images:: Special features for PostScript format.
-* Other Image Types:: Various other formats are supported.
-* Defining Images:: Convenient ways to define an image for later use.
-* Showing Images:: Convenient ways to display an image once
- it is defined.
-* Image Cache:: Internal mechanisms of image display.
-
-Buttons
-
-* Button Properties:: Button properties with special meanings.
-* Button Types:: Defining common properties for classes of buttons.
-* Making Buttons:: Adding buttons to Emacs buffers.
-* Manipulating Buttons:: Getting and setting properties of buttons.
-* Button Buffer Commands:: Buffer-wide commands and bindings for buttons.
-
-Abstract Display
-
-* Abstract Display Functions:: Functions in the Ewoc package.
-* Abstract Display Example:: Example of using Ewoc.
-
-Display Tables
-
-* Display Table Format:: What a display table consists of.
-* Active Display Table:: How Emacs selects a display table to use.
-* Glyphs:: How to define a glyph, and what glyphs mean.
-
-Operating System Interface
-
-* Starting Up:: Customizing Emacs startup processing.
-* Getting Out:: How exiting works (permanent or temporary).
-* System Environment:: Distinguish the name and kind of system.
-* User Identification:: Finding the name and user id of the user.
-* Time of Day:: Getting the current time.
-* Time Conversion:: Converting a time from numeric form to
- calendrical data and vice versa.
-* Time Parsing:: Converting a time from numeric form to text
- and vice versa.
-* Processor Run Time:: Getting the run time used by Emacs.
-* Time Calculations:: Adding, subtracting, comparing times, etc.
-* Timers:: Setting a timer to call a function at a
- certain time.
-* Idle Timers:: Setting a timer to call a function when Emacs has
- been idle for a certain length of time.
-* Terminal Input:: Accessing and recording terminal input.
-* Terminal Output:: Controlling and recording terminal output.
-* Sound Output:: Playing sounds on the computer's speaker.
-* X11 Keysyms:: Operating on key symbols for X Windows.
-* Batch Mode:: Running Emacs without terminal interaction.
-* Session Management:: Saving and restoring state with
- X Session Management.
-
-Preparing Lisp code for distribution
-
-* Packaging Basics:: The basic concepts of Emacs Lisp packages.
-* Simple Packages:: How to package a single .el file.
-* Multi-file Packages:: How to package multiple files.
-
-Starting Up Emacs
-
-* Startup Summary:: Sequence of actions Emacs performs at startup.
-* Init File:: Details on reading the init file.
-* Terminal-Specific:: How the terminal-specific Lisp file is read.
-* Command-Line Arguments:: How command-line arguments are processed,
- and how you can customize them.
-
-Getting Out of Emacs
-
-* Killing Emacs:: Exiting Emacs irreversibly.
-* Suspending Emacs:: Exiting Emacs reversibly.
-
-Terminal Input
-
-* Input Modes:: Options for how input is processed.
-* Recording Input:: Saving histories of recent or all input events.
-
-Tips and Conventions
-
-* Coding Conventions:: Conventions for clean and robust programs.
-* Key Binding Conventions:: Which keys should be bound by which programs.
-* Programming Tips:: Making Emacs code fit smoothly in Emacs.
-* Compilation Tips:: Making compiled code run fast.
-* Warning Tips:: Turning off compiler warnings.
-* Documentation Tips:: Writing readable documentation strings.
-* Comment Tips:: Conventions for writing comments.
-* Library Headers:: Standard headers for library packages.
-
-GNU Emacs Internals
-
-* Building Emacs:: How the dumped Emacs is made.
-* Pure Storage:: Kludge to make preloaded Lisp functions shareable.
-* Garbage Collection:: Reclaiming space for Lisp objects no longer used.
-* Memory Usage:: Info about total size of Lisp objects made so far.
-* Writing Emacs Primitives:: Writing C code for Emacs.
-* Object Internals:: Data formats of buffers, windows, processes.
-
-Object Internals
-
-* Buffer Internals:: Components of a buffer structure.
-* Window Internals:: Components of a window structure.
-* Process Internals:: Components of a process structure.
-@end detailmenu
-@end menu
-
-@include intro.texi
-@include objects.texi
-@include numbers.texi
-@include strings.texi
-
-@include lists.texi
-@include sequences.texi
-@include hash.texi
-@include symbols.texi
-@include eval.texi
-
-@include control.texi
-@include variables.texi
-@include functions.texi
-@include macros.texi
-
-@include customize.texi
-@include loading.texi
-@include compile.texi
-@include advice.texi
-
-@c This includes edebug.texi.
-@include debugging.texi
-@include streams.texi
-@include minibuf.texi
-@include commands.texi
-
-@include keymaps.texi
-@include modes.texi
-@include help.texi
-@include files.texi
-
-@include backups.texi
-
-@c ================ Beginning of Volume 2 ================
-@c include buffers.texi
-@c include windows.texi
-@c include frames.texi
-
-@c include positions.texi
-@c include markers.texi
-@c include text.texi
-@c include nonascii.texi
-
-@c include searching.texi
-@c include syntax.texi
-@c include abbrevs.texi
-@c include processes.texi
-
-@c include display.texi
-@c include os.texi
-
-@c MOVE to Emacs Manual: include misc-modes.texi
-
-@c appendices
-
-@c REMOVE this: include non-hacker.texi
-
-@c include anti.texi
-@c include doclicense.texi
-@c include gpl.texi
-@c include tips.texi
-@c include internals.texi
-@c include errors.texi
-@c include locals.texi
-@c include maps.texi
-@c include hooks.texi
-
-@include index.texi
-
-@ignore
-@node New Symbols, , Index, Top
-@unnumbered New Symbols Since the Previous Edition
-
-@printindex tp
-@end ignore
-
-@bye
-
-
-These words prevent "local variables" above from confusing Emacs.
diff --git a/doc/lispref/vol2.texi b/doc/lispref/vol2.texi
deleted file mode 100644
index d45d23da365..00000000000
--- a/doc/lispref/vol2.texi
+++ /dev/null
@@ -1,1554 +0,0 @@
-\input texinfo @c -*-texinfo-*-
-@c This file is used for printing the GNU Emacs Lisp Reference Manual
-@c in two volumes. It is a modified version of elisp.texi.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
-@c Free Software Foundation, Inc.
-@c %**start of header
-@setfilename elisp
-@settitle GNU Emacs Lisp Reference Manual: Volume 2
-@c %**end of header
-
-@c See two-volume-cross-refs.txt.
-@tex
-\message{Formatting for two volume edition...Volume 2...}
-%
-% Read special toc file, set up in two-volume.make.
-\gdef\tocreadfilename{elisp2-toc-ready.toc}
-%
-% Don't make outlines, they're not needed and \readdatafile can't pay
-% attention to the special definition above.
-\global\let\pdfmakeoutlines=\relax
-%
-% Start volume 2 chapter numbering at 27; this must be listed as chapno26
-\global\chapno=26
-@end tex
-
-@c Version of the manual and of Emacs.
-@c Please remember to update the edition number in README as well.
-@set VERSION 3.0
-@include emacsver.texi
-@set DATE July 2009
-
-@dircategory Emacs
-@direntry
-* Elisp: (elisp). The Emacs Lisp Reference Manual.
-@end direntry
-
-@c in general, keep the following line commented out, unless doing a
-@c copy of this manual that will be published. the manual should go
-@c onto the distribution in the full, 8.5 x 11" size.
-@set smallbook
-
-@ifset smallbook
-@smallbook
-@end ifset
-
-@c per rms and peterb, use 10pt fonts for the main text, mostly to
-@c save on paper cost.
-@c Do this inside @tex for now, so current makeinfo does not complain.
-@tex
-@ifset smallbook
-@fonttextsize 10
-\global\let\urlcolor=\Black % don't print links in grayscale
-\global\let\linkcolor=\Black
-@end ifset
-\global\hbadness=6666 % don't worry about not-too-underfull boxes
-@end tex
-
-@c Combine indices.
-@synindex cp fn
-@syncodeindex vr fn
-@syncodeindex ky fn
-@syncodeindex pg fn
-@c We use the "type index" to index new functions and variables.
-@c @syncodeindex tp fn
-
-@copying
-This is edition @value{VERSION} of the GNU Emacs Lisp Reference Manual,@*
-corresponding to Emacs version @value{EMACSVER}.
-
-Copyright @copyright{} 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1998,
-1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software
-Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.3 or
-any later version published by the Free Software Foundation; with the
-Invariant Sections being ``GNU General Public License,'' with the
-Front-Cover texts being ``A GNU Manual,'' and with the Back-Cover
-Texts as in (a) below. A copy of the license is included in the
-section entitled ``GNU Free Documentation License.''
-
-(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and
-modify this GNU manual. Buying copies from the FSF supports it in
-developing GNU and promoting software freedom.''
-@end quotation
-@end copying
-
-@titlepage
-@title GNU Emacs Lisp Reference Manual
-@subtitle Volume 2
-@subtitle For Emacs Version @value{EMACSVER}
-@subtitle Revision @value{VERSION}, @value{DATE}
-
-@author by Bil Lewis, Dan LaLiberte, Richard Stallman
-@author and the GNU Manual Group
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-
-@sp 2
-Published by the Free Software Foundation @*
-51 Franklin St, Fifth Floor @*
-Boston, MA 02110-1301 @*
-USA @*
-ISBN 1-882114-74-4
-
-@sp 2
-Cover art by Etienne Suvasa.
-@end titlepage
-
-
-@c Print the tables of contents
-@summarycontents
-@contents
-
-
-@ifnottex
-@node Top, Introduction, (dir), (dir)
-@top Emacs Lisp
-
-This Info file contains edition @value{VERSION} of the GNU Emacs Lisp
-Reference Manual, corresponding to GNU Emacs version @value{EMACSVER}.
-@end ifnottex
-
-@menu
-* Introduction:: Introduction and conventions used.
-
-* Lisp Data Types:: Data types of objects in Emacs Lisp.
-* Numbers:: Numbers and arithmetic functions.
-* Strings and Characters:: Strings, and functions that work on them.
-* Lists:: Lists, cons cells, and related functions.
-* Sequences Arrays Vectors:: Lists, strings and vectors are called sequences.
- Certain functions act on any kind of sequence.
- The description of vectors is here as well.
-* Hash Tables:: Very fast lookup-tables.
-* Symbols:: Symbols represent names, uniquely.
-
-* Evaluation:: How Lisp expressions are evaluated.
-* Control Structures:: Conditionals, loops, nonlocal exits.
-* Variables:: Using symbols in programs to stand for values.
-* Functions:: A function is a Lisp program
- that can be invoked from other functions.
-* Macros:: Macros are a way to extend the Lisp language.
-* Customization:: Writing customization declarations.
-
-* Loading:: Reading files of Lisp code into Lisp.
-* Byte Compilation:: Compilation makes programs run faster.
-* Advising Functions:: Adding to the definition of a function.
-* Debugging:: Tools and tips for debugging Lisp programs.
-
-* Read and Print:: Converting Lisp objects to text and back.
-* Minibuffers:: Using the minibuffer to read input.
-* Command Loop:: How the editor command loop works,
- and how you can call its subroutines.
-* Keymaps:: Defining the bindings from keys to commands.
-* Modes:: Defining major and minor modes.
-* Documentation:: Writing and using documentation strings.
-
-* Files:: Accessing files.
-* Backups and Auto-Saving:: Controlling how backups and auto-save
- files are made.
-* Buffers:: Creating and using buffer objects.
-* Windows:: Manipulating windows and displaying buffers.
-* Frames:: Making multiple system-level windows.
-* Positions:: Buffer positions and motion functions.
-* Markers:: Markers represent positions and update
- automatically when the text is changed.
-
-* Text:: Examining and changing text in buffers.
-* Non-ASCII Characters:: Non-ASCII text in buffers and strings.
-* Searching and Matching:: Searching buffers for strings or regexps.
-* Syntax Tables:: The syntax table controls word and list parsing.
-* Abbrevs:: How Abbrev mode works, and its data structures.
-
-* Processes:: Running and communicating with subprocesses.
-* Display:: Features for controlling the screen display.
-* System Interface:: Getting the user id, system type, environment
- variables, and other such things.
-
-* Packaging:: Preparing Lisp code for distribution.
-
-Appendices
-
-* Antinews:: Info for users downgrading to Emacs 22.
-* GNU Free Documentation License:: The license for this documentation.
-* GPL:: Conditions for copying and changing GNU Emacs.
-* Tips:: Advice and coding conventions for Emacs Lisp.
-* GNU Emacs Internals:: Building and dumping Emacs;
- internal data structures.
-* Standard Errors:: List of all error symbols.
-* Standard Buffer-Local Variables::
- List of variables buffer-local in all buffers.
-* Standard Keymaps:: List of standard keymaps.
-* Standard Hooks:: List of standard hook variables.
-
-* Index:: Index including concepts, functions, variables,
- and other terms.
-
-@ignore
-* New Symbols:: New functions and variables in Emacs @value{EMACSVER}.
-@end ignore
-
-@c Do NOT modify the following 3 lines! They must have this form to
-@c be correctly identified by `texinfo-multiple-files-update'. In
-@c particular, the detailed menu header line MUST be identical to the
-@c value of `texinfo-master-menu-header'. See texnfo-upd.el.
-
-@detailmenu
- --- The Detailed Node Listing ---
- ---------------------------------
-
-Here are other nodes that are subnodes of those already listed,
-mentioned here so you can get to them in one step:
-
-Introduction
-
-* Caveats:: Flaws and a request for help.
-* Lisp History:: Emacs Lisp is descended from Maclisp.
-* Conventions:: How the manual is formatted.
-* Version Info:: Which Emacs version is running?
-* Acknowledgements:: The authors, editors, and sponsors of this manual.
-
-Conventions
-
-* Some Terms:: Explanation of terms we use in this manual.
-* nil and t:: How the symbols @code{nil} and @code{t} are used.
-* Evaluation Notation:: The format we use for examples of evaluation.
-* Printing Notation:: The format we use when examples print text.
-* Error Messages:: The format we use for examples of errors.
-* Buffer Text Notation:: The format we use for buffer contents in examples.
-* Format of Descriptions:: Notation for describing functions, variables, etc.
-
-Format of Descriptions
-
-* A Sample Function Description:: A description of an imaginary
- function, @code{foo}.
-* A Sample Variable Description:: A description of an imaginary
- variable, @code{electric-future-map}.
-
-Lisp Data Types
-
-* Printed Representation:: How Lisp objects are represented as text.
-* Comments:: Comments and their formatting conventions.
-* Programming Types:: Types found in all Lisp systems.
-* Editing Types:: Types specific to Emacs.
-* Circular Objects:: Read syntax for circular structure.
-* Type Predicates:: Tests related to types.
-* Equality Predicates:: Tests of equality between any two objects.
-
-Programming Types
-
-* Integer Type:: Numbers without fractional parts.
-* Floating Point Type:: Numbers with fractional parts and with a large range.
-* Character Type:: The representation of letters, numbers and
- control characters.
-* Symbol Type:: A multi-use object that refers to a function,
- variable, or property list, and has a unique identity.
-* Sequence Type:: Both lists and arrays are classified as sequences.
-* Cons Cell Type:: Cons cells, and lists (which are made from cons cells).
-* Array Type:: Arrays include strings and vectors.
-* String Type:: An (efficient) array of characters.
-* Vector Type:: One-dimensional arrays.
-* Char-Table Type:: One-dimensional sparse arrays indexed by characters.
-* Bool-Vector Type:: One-dimensional arrays of @code{t} or @code{nil}.
-* Hash Table Type:: Super-fast lookup tables.
-* Function Type:: A piece of executable code you can call from elsewhere.
-* Macro Type:: A method of expanding an expression into another
- expression, more fundamental but less pretty.
-* Primitive Function Type:: A function written in C, callable from Lisp.
-* Byte-Code Type:: A function written in Lisp, then compiled.
-* Autoload Type:: A type used for automatically loading seldom-used
- functions.
-
-Character Type
-
-* Basic Char Syntax:: Syntax for regular characters.
-* General Escape Syntax:: How to specify characters by their codes.
-* Ctl-Char Syntax:: Syntax for control characters.
-* Meta-Char Syntax:: Syntax for meta-characters.
-* Other Char Bits:: Syntax for hyper-, super-, and alt-characters.
-
-Cons Cell and List Types
-
-* Box Diagrams:: Drawing pictures of lists.
-* Dotted Pair Notation:: A general syntax for cons cells.
-* Association List Type:: A specially constructed list.
-
-String Type
-
-* Syntax for Strings:: How to specify Lisp strings.
-* Non-ASCII in Strings:: International characters in strings.
-* Nonprinting Characters:: Literal unprintable characters in strings.
-* Text Props and Strings:: Strings with text properties.
-
-Editing Types
-
-* Buffer Type:: The basic object of editing.
-* Marker Type:: A position in a buffer.
-* Window Type:: Buffers are displayed in windows.
-* Frame Type:: Windows subdivide frames.
-* Terminal Type:: A terminal device displays frames.
-* Window Configuration Type:: Recording the way a frame is subdivided.
-* Frame Configuration Type:: Recording the status of all frames.
-* Process Type:: A subprocess of Emacs running on the underlying OS.
-* Stream Type:: Receive or send characters.
-* Keymap Type:: What function a keystroke invokes.
-* Overlay Type:: How an overlay is represented.
-* Font Type:: Fonts for displaying text.
-
-Numbers
-
-* Integer Basics:: Representation and range of integers.
-* Float Basics:: Representation and range of floating point.
-* Predicates on Numbers:: Testing for numbers.
-* Comparison of Numbers:: Equality and inequality predicates.
-* Numeric Conversions:: Converting float to integer and vice versa.
-* Arithmetic Operations:: How to add, subtract, multiply and divide.
-* Rounding Operations:: Explicitly rounding floating point numbers.
-* Bitwise Operations:: Logical and, or, not, shifting.
-* Math Functions:: Trig, exponential and logarithmic functions.
-* Random Numbers:: Obtaining random integers, predictable or not.
-
-Strings and Characters
-
-* String Basics:: Basic properties of strings and characters.
-* Predicates for Strings:: Testing whether an object is a string or char.
-* Creating Strings:: Functions to allocate new strings.
-* Modifying Strings:: Altering the contents of an existing string.
-* Text Comparison:: Comparing characters or strings.
-* String Conversion:: Converting to and from characters and strings.
-* Formatting Strings:: @code{format}: Emacs's analogue of @code{printf}.
-* Case Conversion:: Case conversion functions.
-* Case Tables:: Customizing case conversion.
-
-Lists
-
-* Cons Cells:: How lists are made out of cons cells.
-* List-related Predicates:: Is this object a list? Comparing two lists.
-* List Elements:: Extracting the pieces of a list.
-* Building Lists:: Creating list structure.
-* List Variables:: Modifying lists stored in variables.
-* Modifying Lists:: Storing new pieces into an existing list.
-* Sets And Lists:: A list can represent a finite mathematical set.
-* Association Lists:: A list can represent a finite relation or mapping.
-* Rings:: Managing a fixed-size ring of objects.
-
-Modifying Existing List Structure
-
-* Setcar:: Replacing an element in a list.
-* Setcdr:: Replacing part of the list backbone.
- This can be used to remove or add elements.
-* Rearrangement:: Reordering the elements in a list; combining lists.
-
-Sequences, Arrays, and Vectors
-
-* Sequence Functions:: Functions that accept any kind of sequence.
-* Arrays:: Characteristics of arrays in Emacs Lisp.
-* Array Functions:: Functions specifically for arrays.
-* Vectors:: Special characteristics of Emacs Lisp vectors.
-* Vector Functions:: Functions specifically for vectors.
-* Char-Tables:: How to work with char-tables.
-* Bool-Vectors:: How to work with bool-vectors.
-
-Hash Tables
-
-* Creating Hash:: Functions to create hash tables.
-* Hash Access:: Reading and writing the hash table contents.
-* Defining Hash:: Defining new comparison methods.
-* Other Hash:: Miscellaneous.
-
-Symbols
-
-* Symbol Components:: Symbols have names, values, function definitions
- and property lists.
-* Definitions:: A definition says how a symbol will be used.
-* Creating Symbols:: How symbols are kept unique.
-* Property Lists:: Each symbol has a property list
- for recording miscellaneous information.
-
-Property Lists
-
-* Plists and Alists:: Comparison of the advantages of property
- lists and association lists.
-* Symbol Plists:: Functions to access symbols' property lists.
-* Other Plists:: Accessing property lists stored elsewhere.
-
-Evaluation
-
-* Intro Eval:: Evaluation in the scheme of things.
-* Forms:: How various sorts of objects are evaluated.
-* Quoting:: Avoiding evaluation (to put constants in
- the program).
-* Eval:: How to invoke the Lisp interpreter explicitly.
-
-Kinds of Forms
-
-* Self-Evaluating Forms:: Forms that evaluate to themselves.
-* Symbol Forms:: Symbols evaluate as variables.
-* Classifying Lists:: How to distinguish various sorts of list forms.
-* Function Indirection:: When a symbol appears as the car of a list,
- we find the real function via the symbol.
-* Function Forms:: Forms that call functions.
-* Macro Forms:: Forms that call macros.
-* Special Forms:: "Special forms" are idiosyncratic primitives,
- most of them extremely important.
-* Autoloading:: Functions set up to load files
- containing their real definitions.
-
-Control Structures
-
-* Sequencing:: Evaluation in textual order.
-* Conditionals:: @code{if}, @code{cond}, @code{when}, @code{unless}.
-* Combining Conditions:: @code{and}, @code{or}, @code{not}.
-* Iteration:: @code{while} loops.
-* Nonlocal Exits:: Jumping out of a sequence.
-
-Nonlocal Exits
-
-* Catch and Throw:: Nonlocal exits for the program's own purposes.
-* Examples of Catch:: Showing how such nonlocal exits can be written.
-* Errors:: How errors are signaled and handled.
-* Cleanups:: Arranging to run a cleanup form if an
- error happens.
-
-Errors
-
-* Signaling Errors:: How to report an error.
-* Processing of Errors:: What Emacs does when you report an error.
-* Handling Errors:: How you can trap errors and continue execution.
-* Error Symbols:: How errors are classified for trapping them.
-
-Variables
-
-* Global Variables:: Variable values that exist permanently, everywhere.
-* Constant Variables:: Certain "variables" have values that never change.
-* Local Variables:: Variable values that exist only temporarily.
-* Void Variables:: Symbols that lack values.
-* Defining Variables:: A definition says a symbol is used as a variable.
-* Tips for Defining:: Things you should think about when you
- define a variable.
-* Accessing Variables:: Examining values of variables whose names
- are known only at run time.
-* Setting Variables:: Storing new values in variables.
-* Variable Scoping:: How Lisp chooses among local and global values.
-* Buffer-Local Variables:: Variable values in effect only in one buffer.
-* File Local Variables:: Handling local variable lists in files.
-* Directory Local Variables:: Local variables common to all files in a
- directory.
-* Frame-Local Variables:: Frame-local bindings for variables.
-* Variable Aliases:: Variables that are aliases for other variables.
-* Variables with Restricted Values:: Non-constant variables whose value can
- @emph{not} be an arbitrary Lisp object.
-
-Scoping Rules for Variable Bindings
-
-* Scope:: Scope means where in the program a value
- is visible. Comparison with other languages.
-* Extent:: Extent means how long in time a value exists.
-* Impl of Scope:: Two ways to implement dynamic scoping.
-* Using Scoping:: How to use dynamic scoping carefully and
- avoid problems.
-
-Buffer-Local Variables
-
-* Intro to Buffer-Local:: Introduction and concepts.
-* Creating Buffer-Local:: Creating and destroying buffer-local bindings.
-* Default Value:: The default value is seen in buffers
- that don't have their own buffer-local values.
-
-Functions
-
-* What Is a Function:: Lisp functions vs. primitives; terminology.
-* Lambda Expressions:: How functions are expressed as Lisp objects.
-* Function Names:: A symbol can serve as the name of a function.
-* Defining Functions:: Lisp expressions for defining functions.
-* Calling Functions:: How to use an existing function.
-* Mapping Functions:: Applying a function to each element of a list, etc.
-* Anonymous Functions:: Lambda expressions are functions with no names.
-* Function Cells:: Accessing or setting the function definition
- of a symbol.
-* Obsolete Functions:: Declaring functions obsolete.
-* Inline Functions:: Defining functions that the compiler
- will open code.
-* Declaring Functions:: Telling the compiler that a function is defined.
-* Function Safety:: Determining whether a function is safe to call.
-* Related Topics:: Cross-references to specific Lisp primitives
- that have a special bearing on how
- functions work.
-
-Lambda Expressions
-
-* Lambda Components:: The parts of a lambda expression.
-* Simple Lambda:: A simple example.
-* Argument List:: Details and special features of argument lists.
-* Function Documentation:: How to put documentation in a function.
-
-Macros
-
-* Simple Macro:: A basic example.
-* Expansion:: How, when and why macros are expanded.
-* Compiling Macros:: How macros are expanded by the compiler.
-* Defining Macros:: How to write a macro definition.
-* Backquote:: Easier construction of list structure.
-* Problems with Macros:: Don't evaluate the macro arguments too many times.
- Don't hide the user's variables.
-* Indenting Macros:: Specifying how to indent macro calls.
-
-Common Problems Using Macros
-
-* Wrong Time:: Do the work in the expansion, not in the macro.
-* Argument Evaluation:: The expansion should evaluate each macro arg once.
-* Surprising Local Vars:: Local variable bindings in the expansion
- require special care.
-* Eval During Expansion:: Don't evaluate them; put them in the expansion.
-* Repeated Expansion:: Avoid depending on how many times expansion is done.
-
-Writing Customization Definitions
-
-* Common Keywords:: Common keyword arguments for all kinds of
- customization declarations.
-* Group Definitions:: Writing customization group definitions.
-* Variable Definitions:: Declaring user options.
-* Customization Types:: Specifying the type of a user option.
-
-Customization Types
-
-* Simple Types:: Simple customization types: sexp, integer, number,
- string, file, directory, alist.
-* Composite Types:: Build new types from other types or data.
-* Splicing into Lists:: Splice elements into list with @code{:inline}.
-* Type Keywords:: Keyword-argument pairs in a customization type.
-* Defining New Types:: Give your type a name.
-
-Loading
-
-* How Programs Do Loading:: The @code{load} function and others.
-* Load Suffixes:: Details about the suffixes that @code{load} tries.
-* Library Search:: Finding a library to load.
-* Loading Non-ASCII:: Non-@acronym{ASCII} characters in Emacs Lisp files.
-* Autoload:: Setting up a function to autoload.
-* Repeated Loading:: Precautions about loading a file twice.
-* Named Features:: Loading a library if it isn't already loaded.
-* Where Defined:: Finding which file defined a certain symbol.
-* Unloading:: How to "unload" a library that was loaded.
-* Hooks for Loading:: Providing code to be run when
- particular libraries are loaded.
-
-Byte Compilation
-
-* Speed of Byte-Code:: An example of speedup from byte compilation.
-* Compilation Functions:: Byte compilation functions.
-* Docs and Compilation:: Dynamic loading of documentation strings.
-* Dynamic Loading:: Dynamic loading of individual functions.
-* Eval During Compile:: Code to be evaluated when you compile.
-* Compiler Errors:: Handling compiler error messages.
-* Byte-Code Objects:: The data type used for byte-compiled functions.
-* Disassembly:: Disassembling byte-code; how to read byte-code.
-
-Advising Emacs Lisp Functions
-
-* Simple Advice:: A simple example to explain the basics of advice.
-* Defining Advice:: Detailed description of @code{defadvice}.
-* Around-Advice:: Wrapping advice around a function's definition.
-* Computed Advice:: ...is to @code{defadvice} as @code{fset} is to @code{defun}.
-* Activation of Advice:: Advice doesn't do anything until you activate it.
-* Enabling Advice:: You can enable or disable each piece of advice.
-* Preactivation:: Preactivation is a way of speeding up the
- loading of compiled advice.
-* Argument Access in Advice:: How advice can access the function's arguments.
-* Advising Primitives:: Accessing arguments when advising a primitive.
-* Combined Definition:: How advice is implemented.
-
-Debugging Lisp Programs
-
-* Debugger:: How the Emacs Lisp debugger is implemented.
-* Edebug:: A source-level Emacs Lisp debugger.
-* Syntax Errors:: How to find syntax errors.
-* Test Coverage:: Ensuring you have tested all branches in your code.
-* Compilation Errors:: How to find errors that show up in
- byte compilation.
-
-The Lisp Debugger
-
-* Error Debugging:: Entering the debugger when an error happens.
-* Infinite Loops:: Stopping and debugging a program that doesn't exit.
-* Function Debugging:: Entering it when a certain function is called.
-* Explicit Debug:: Entering it at a certain point in the program.
-* Using Debugger:: What the debugger does; what you see while in it.
-* Debugger Commands:: Commands used while in the debugger.
-* Invoking the Debugger:: How to call the function @code{debug}.
-* Internals of Debugger:: Subroutines of the debugger, and global variables.
-
-Edebug
-
-* Using Edebug:: Introduction to use of Edebug.
-* Instrumenting:: You must instrument your code
- in order to debug it with Edebug.
-* Edebug Execution Modes:: Execution modes, stopping more or less often.
-* Jumping:: Commands to jump to a specified place.
-* Edebug Misc:: Miscellaneous commands.
-* Breaks:: Setting breakpoints to make the program stop.
-* Trapping Errors:: Trapping errors with Edebug.
-* Edebug Views:: Views inside and outside of Edebug.
-* Edebug Eval:: Evaluating expressions within Edebug.
-* Eval List:: Expressions whose values are displayed
- each time you enter Edebug.
-* Printing in Edebug:: Customization of printing.
-* Trace Buffer:: How to produce trace output in a buffer.
-* Coverage Testing:: How to test evaluation coverage.
-* The Outside Context:: Data that Edebug saves and restores.
-* Edebug and Macros:: Specifying how to handle macro calls.
-* Edebug Options:: Option variables for customizing Edebug.
-
-Breaks
-
-* Breakpoints:: Breakpoints at stop points.
-* Global Break Condition:: Breaking on an event.
-* Source Breakpoints:: Embedding breakpoints in source code.
-
-The Outside Context
-
-* Checking Whether to Stop::When Edebug decides what to do.
-* Edebug Display Update:: When Edebug updates the display.
-* Edebug Recursive Edit:: When Edebug stops execution.
-
-Edebug and Macros
-
-* Instrumenting Macro Calls::The basic problem.
-* Specification List:: How to specify complex patterns of evaluation.
-* Backtracking:: What Edebug does when matching fails.
-* Specification Examples:: To help understand specifications.
-
-Debugging Invalid Lisp Syntax
-
-* Excess Open:: How to find a spurious open paren or missing close.
-* Excess Close:: How to find a spurious close paren or missing open.
-
-Reading and Printing Lisp Objects
-
-* Streams Intro:: Overview of streams, reading and printing.
-* Input Streams:: Various data types that can be used as
- input streams.
-* Input Functions:: Functions to read Lisp objects from text.
-* Output Streams:: Various data types that can be used as
- output streams.
-* Output Functions:: Functions to print Lisp objects as text.
-* Output Variables:: Variables that control what the printing
- functions do.
-
-Minibuffers
-
-* Intro to Minibuffers:: Basic information about minibuffers.
-* Text from Minibuffer:: How to read a straight text string.
-* Object from Minibuffer:: How to read a Lisp object or expression.
-* Minibuffer History:: Recording previous minibuffer inputs
- so the user can reuse them.
-* Initial Input:: Specifying initial contents for the minibuffer.
-* Completion:: How to invoke and customize completion.
-* Yes-or-No Queries:: Asking a question with a simple answer.
-* Multiple Queries:: Asking a series of similar questions.
-* Reading a Password:: Reading a password from the terminal.
-* Minibuffer Commands:: Commands used as key bindings in minibuffers.
-* Minibuffer Contents:: How such commands access the minibuffer text.
-* Minibuffer Windows:: Operating on the special minibuffer windows.
-* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
-* Minibuffer Misc:: Various customization hooks and variables.
-
-Completion
-
-* Basic Completion:: Low-level functions for completing strings.
- (These are too low level to use the minibuffer.)
-* Minibuffer Completion:: Invoking the minibuffer with completion.
-* Completion Commands:: Minibuffer commands that do completion.
-* High-Level Completion:: Convenient special cases of completion
- (reading buffer name, file name, etc.).
-* Reading File Names:: Using completion to read file names and
- shell commands.
-* Completion Styles:: Specifying rules for performing completion.
-* Programmed Completion:: Writing your own completion-function.
-
-Command Loop
-
-* Command Overview:: How the command loop reads commands.
-* Defining Commands:: Specifying how a function should read arguments.
-* Interactive Call:: Calling a command, so that it will read arguments.
-* Distinguish Interactive:: Making a command distinguish interactive calls.
-* Command Loop Info:: Variables set by the command loop for you to examine.
-* Adjusting Point:: Adjustment of point after a command.
-* Input Events:: What input looks like when you read it.
-* Reading Input:: How to read input events from the keyboard or mouse.
-* Special Events:: Events processed immediately and individually.
-* Waiting:: Waiting for user input or elapsed time.
-* Quitting:: How @kbd{C-g} works. How to catch or defer quitting.
-* Prefix Command Arguments:: How the commands to set prefix args work.
-* Recursive Editing:: Entering a recursive edit,
- and why you usually shouldn't.
-* Disabling Commands:: How the command loop handles disabled commands.
-* Command History:: How the command history is set up, and how accessed.
-* Keyboard Macros:: How keyboard macros are implemented.
-
-Defining Commands
-
-* Using Interactive:: General rules for @code{interactive}.
-* Interactive Codes:: The standard letter-codes for reading arguments
- in various ways.
-* Interactive Examples:: Examples of how to read interactive arguments.
-
-Input Events
-
-* Keyboard Events:: Ordinary characters--keys with symbols on them.
-* Function Keys:: Function keys--keys with names, not symbols.
-* Mouse Events:: Overview of mouse events.
-* Click Events:: Pushing and releasing a mouse button.
-* Drag Events:: Moving the mouse before releasing the button.
-* Button-Down Events:: A button was pushed and not yet released.
-* Repeat Events:: Double and triple click (or drag, or down).
-* Motion Events:: Just moving the mouse, not pushing a button.
-* Focus Events:: Moving the mouse between frames.
-* Misc Events:: Other events the system can generate.
-* Event Examples:: Examples of the lists for mouse events.
-* Classifying Events:: Finding the modifier keys in an event symbol.
- Event types.
-* Accessing Mouse:: Functions to extract info from mouse events.
-* Accessing Scroll:: Functions to get info from scroll bar events.
-* Strings of Events:: Special considerations for putting
- keyboard character events in a string.
-
-Reading Input
-
-* Key Sequence Input:: How to read one key sequence.
-* Reading One Event:: How to read just one event.
-* Event Mod:: How Emacs modifies events as they are read.
-* Invoking the Input Method:: How reading an event uses the input method.
-* Quoted Character Input:: Asking the user to specify a character.
-* Event Input Misc:: How to reread or throw away input events.
-
-Keymaps
-
-* Key Sequences:: Key sequences as Lisp objects.
-* Keymap Basics:: Basic concepts of keymaps.
-* Format of Keymaps:: What a keymap looks like as a Lisp object.
-* Creating Keymaps:: Functions to create and copy keymaps.
-* Inheritance and Keymaps:: How one keymap can inherit the bindings
- of another keymap.
-* Prefix Keys:: Defining a key with a keymap as its definition.
-* Active Keymaps:: How Emacs searches the active keymaps
- for a key binding.
-* Searching Keymaps:: A pseudo-Lisp summary of searching active maps.
-* Controlling Active Maps:: Each buffer has a local keymap
- to override the standard (global) bindings.
- A minor mode can also override them.
-* Key Lookup:: Finding a key's binding in one keymap.
-* Functions for Key Lookup:: How to request key lookup.
-* Changing Key Bindings:: Redefining a key in a keymap.
-* Remapping Commands:: A keymap can translate one command to another.
-* Translation Keymaps:: Keymaps for translating sequences of events.
-* Key Binding Commands:: Interactive interfaces for redefining keys.
-* Scanning Keymaps:: Looking through all keymaps, for printing help.
-* Menu Keymaps:: Defining a menu as a keymap.
-
-Menu Keymaps
-
-* Defining Menus:: How to make a keymap that defines a menu.
-* Mouse Menus:: How users actuate the menu with the mouse.
-* Keyboard Menus:: How users actuate the menu with the keyboard.
-* Menu Example:: Making a simple menu.
-* Menu Bar:: How to customize the menu bar.
-* Tool Bar:: A tool bar is a row of images.
-* Modifying Menus:: How to add new items to a menu.
-
-Defining Menus
-
-* Simple Menu Items:: A simple kind of menu key binding,
- limited in capabilities.
-* Extended Menu Items:: More powerful menu item definitions
- let you specify keywords to enable
- various features.
-* Menu Separators:: Drawing a horizontal line through a menu.
-* Alias Menu Items:: Using command aliases in menu items.
-
-Major and Minor Modes
-
-* Hooks:: How to use hooks; how to write code that provides hooks.
-* Major Modes:: Defining major modes.
-* Minor Modes:: Defining minor modes.
-* Mode Line Format:: Customizing the text that appears in the mode line.
-* Imenu:: Providing a menu of definitions made in a buffer.
-* Font Lock Mode:: How modes can highlight text according to syntax.
-* Desktop Save Mode:: How modes can have buffer state saved between
- Emacs sessions.
-
-Hooks
-
-* Running Hooks:: How to run a hook.
-* Setting Hooks:: How to put functions on a hook, or remove them.
-
-Major Modes
-
-* Major Mode Conventions:: Coding conventions for keymaps, etc.
-* Auto Major Mode:: How Emacs chooses the major mode automatically.
-* Mode Help:: Finding out how to use a mode.
-* Derived Modes:: Defining a new major mode based on another major
- mode.
-* Basic Major Modes:: Modes that other modes are often derived from.
-* Generic Modes:: Defining a simple major mode that supports
- comment syntax and Font Lock mode.
-* Mode Hooks:: Hooks run at the end of major mode commands.
-* Example Major Modes:: Text mode and Lisp modes.
-
-Minor Modes
-
-* Minor Mode Conventions:: Tips for writing a minor mode.
-* Keymaps and Minor Modes:: How a minor mode can have its own keymap.
-* Defining Minor Modes:: A convenient facility for defining minor modes.
-
-Mode Line Format
-
-* Mode Line Basics:: Basic ideas of mode line control.
-* Mode Line Data:: The data structure that controls the mode line.
-* Mode Line Top:: The top level variable, mode-line-format.
-* Mode Line Variables:: Variables used in that data structure.
-* %-Constructs:: Putting information into a mode line.
-* Properties in Mode:: Using text properties in the mode line.
-* Header Lines:: Like a mode line, but at the top.
-* Emulating Mode Line:: Formatting text as the mode line would.
-
-Font Lock Mode
-
-* Font Lock Basics:: Overview of customizing Font Lock.
-* Search-based Fontification:: Fontification based on regexps.
-* Customizing Keywords:: Customizing search-based fontification.
-* Other Font Lock Variables:: Additional customization facilities.
-* Levels of Font Lock:: Each mode can define alternative levels
- so that the user can select more or less.
-* Precalculated Fontification:: How Lisp programs that produce the buffer
- contents can also specify how to fontify it.
-* Faces for Font Lock:: Special faces specifically for Font Lock.
-* Syntactic Font Lock:: Fontification based on syntax tables.
-* Setting Syntax Properties:: Defining character syntax based on context
- using the Font Lock mechanism.
-* Multiline Font Lock:: How to coerce Font Lock into properly
- highlighting multiline constructs.
-
-Multiline Font Lock Constructs
-
-* Font Lock Multiline:: Marking multiline chunks with a text property.
-* Region to Refontify:: Controlling which region gets refontified
- after a buffer change.
-
-Documentation
-
-* Documentation Basics:: Good style for doc strings.
- Where to put them. How Emacs stores them.
-* Accessing Documentation:: How Lisp programs can access doc strings.
-* Keys in Documentation:: Substituting current key bindings.
-* Describing Characters:: Making printable descriptions of
- non-printing characters and key sequences.
-* Help Functions:: Subroutines used by Emacs help facilities.
-
-Files
-
-* Visiting Files:: Reading files into Emacs buffers for editing.
-* Saving Buffers:: Writing changed buffers back into files.
-* Reading from Files:: Reading files into buffers without visiting.
-* Writing to Files:: Writing new files from parts of buffers.
-* File Locks:: Locking and unlocking files, to prevent
- simultaneous editing by two people.
-* Information about Files:: Testing existence, accessibility, size of files.
-* Changing Files:: Renaming files, changing protection, etc.
-* File Names:: Decomposing and expanding file names.
-* Contents of Directories:: Getting a list of the files in a directory.
-* Create/Delete Dirs:: Creating and Deleting Directories.
-* Magic File Names:: Defining "magic" special handling
- for certain file names.
-* Format Conversion:: Conversion to and from various file formats.
-
-Visiting Files
-
-* Visiting Functions:: The usual interface functions for visiting.
-* Subroutines of Visiting:: Lower-level subroutines that they use.
-
-Information about Files
-
-* Testing Accessibility:: Is a given file readable? Writable?
-* Kinds of Files:: Is it a directory? A symbolic link?
-* Truenames:: Eliminating symbolic links from a file name.
-* File Attributes:: How large is it? Any other names? Etc.
-* Locating Files:: How to find a file in standard places.
-
-File Names
-
-* File Name Components:: The directory part of a file name, and the rest.
-* Relative File Names:: Some file names are relative to a current directory.
-* Directory Names:: A directory's name as a directory
- is different from its name as a file.
-* File Name Expansion:: Converting relative file names to absolute ones.
-* Unique File Names:: Generating names for temporary files.
-* File Name Completion:: Finding the completions for a given file name.
-* Standard File Names:: If your package uses a fixed file name,
- how to handle various operating systems simply.
-
-File Format Conversion
-
-* Format Conversion Overview:: @code{insert-file-contents} and @code{write-region}.
-* Format Conversion Round-Trip:: Using @code{format-alist}.
-* Format Conversion Piecemeal:: Specifying non-paired conversion.
-
-Backups and Auto-Saving
-
-* Backup Files:: How backup files are made; how their names
- are chosen.
-* Auto-Saving:: How auto-save files are made; how their
- names are chosen.
-* Reverting:: @code{revert-buffer}, and how to customize
- what it does.
-
-Backup Files
-
-* Making Backups:: How Emacs makes backup files, and when.
-* Rename or Copy:: Two alternatives: renaming the old file
- or copying it.
-* Numbered Backups:: Keeping multiple backups for each source file.
-* Backup Names:: How backup file names are computed; customization.
-
-Buffers
-
-* Buffer Basics:: What is a buffer?
-* Current Buffer:: Designating a buffer as current
- so that primitives will access its contents.
-* Buffer Names:: Accessing and changing buffer names.
-* Buffer File Name:: The buffer file name indicates which file
- is visited.
-* Buffer Modification:: A buffer is @dfn{modified} if it needs to be saved.
-* Modification Time:: Determining whether the visited file was changed
- ``behind Emacs's back''.
-* Read Only Buffers:: Modifying text is not allowed in a
- read-only buffer.
-* The Buffer List:: How to look at all the existing buffers.
-* Creating Buffers:: Functions that create buffers.
-* Killing Buffers:: Buffers exist until explicitly killed.
-* Indirect Buffers:: An indirect buffer shares text with some
- other buffer.
-* Swapping Text:: Swapping text between two buffers.
-* Buffer Gap:: The gap in the buffer.
-
-Windows
-
-* Basic Windows:: Basic information on using windows.
-* Splitting Windows:: Splitting one window into two windows.
-* Deleting Windows:: Deleting a window gives its space to other windows.
-* Selecting Windows:: The selected window is the one that you edit in.
-* Cyclic Window Ordering:: Moving around the existing windows.
-* Buffers and Windows:: Each window displays the contents of a buffer.
-* Switching Buffers:: Higher-level functions for switching to a buffer.
-* Choosing Window:: How to choose a window for displaying a buffer.
-* Display Action Functions:: Subroutines for @code{display-buffer}.
-* Choosing Window Options:: Extra options affecting how buffers are displayed.
-* Window History:: Each window remembers the buffers displayed in it.
-* Dedicated Windows:: How to avoid displaying another buffer in
- a specific window.
-* Window Point:: Each window has its own location of point.
-* Window Start and End:: Buffer positions indicating which text is
- on-screen in a window.
-* Textual Scrolling:: Moving text up and down through the window.
-* Vertical Scrolling:: Moving the contents up and down on the window.
-* Horizontal Scrolling:: Moving the contents sideways on the window.
-* Size of Window:: Accessing the size of a window.
-* Resizing Windows:: Changing the size of a window.
-* Coordinates and Windows:: Converting coordinates to windows.
-* Window Tree:: The layout and sizes of all windows in a frame.
-* Window Configurations:: Saving and restoring the state of the screen.
-* Window Parameters:: Associating additional information with windows.
-* Window Hooks:: Hooks for scrolling, window size changes,
- redisplay going past a certain point,
- or window configuration changes.
-
-Frames
-
-* Creating Frames:: Creating additional frames.
-* Multiple Terminals:: Displaying on several different devices.
-* Frame Parameters:: Controlling frame size, position, font, etc.
-* Terminal Parameters:: Parameters common for all frames on terminal.
-* Frame Titles:: Automatic updating of frame titles.
-* Deleting Frames:: Frames last until explicitly deleted.
-* Finding All Frames:: How to examine all existing frames.
-* Frames and Windows:: A frame contains windows;
- display of text always works through windows.
-* Minibuffers and Frames:: How a frame finds the minibuffer to use.
-* Input Focus:: Specifying the selected frame.
-* Visibility of Frames:: Frames may be visible or invisible, or icons.
-* Raising and Lowering:: Raising a frame makes it hide other windows;
- lowering it makes the others hide it.
-* Frame Configurations:: Saving the state of all frames.
-* Mouse Tracking:: Getting events that say when the mouse moves.
-* Mouse Position:: Asking where the mouse is, or moving it.
-* Pop-Up Menus:: Displaying a menu for the user to select from.
-* Dialog Boxes:: Displaying a box to ask yes or no.
-* Pointer Shape:: Specifying the shape of the mouse pointer.
-* Window System Selections::Transferring text to and from other X clients.
-* Drag and Drop:: Internals of Drag-and-Drop implementation.
-* Color Names:: Getting the definitions of color names.
-* Text Terminal Colors:: Defining colors for text-only terminals.
-* Resources:: Getting resource values from the server.
-* Display Feature Testing:: Determining the features of a terminal.
-
-Frame Parameters
-
-* Parameter Access:: How to change a frame's parameters.
-* Initial Parameters:: Specifying frame parameters when you make a frame.
-* Window Frame Parameters:: List of frame parameters for window systems.
-* Size and Position:: Changing the size and position of a frame.
-* Geometry:: Parsing geometry specifications.
-
-Window Frame Parameters
-
-* Basic Parameters:: Parameters that are fundamental.
-* Position Parameters:: The position of the frame on the screen.
-* Size Parameters:: Frame's size.
-* Layout Parameters:: Size of parts of the frame, and
- enabling or disabling some parts.
-* Buffer Parameters:: Which buffers have been or should be shown.
-* Management Parameters:: Communicating with the window manager.
-* Cursor Parameters:: Controlling the cursor appearance.
-* Font and Color Parameters:: Fonts and colors for the frame text.
-
-Positions
-
-* Point:: The special position where editing takes place.
-* Motion:: Changing point.
-* Excursions:: Temporary motion and buffer changes.
-* Narrowing:: Restricting editing to a portion of the buffer.
-
-Motion
-
-* Character Motion:: Moving in terms of characters.
-* Word Motion:: Moving in terms of words.
-* Buffer End Motion:: Moving to the beginning or end of the buffer.
-* Text Lines:: Moving in terms of lines of text.
-* Screen Lines:: Moving in terms of lines as displayed.
-* List Motion:: Moving by parsing lists and sexps.
-* Skipping Characters:: Skipping characters belonging to a certain set.
-
-Markers
-
-* Overview of Markers:: The components of a marker, and how it relocates.
-* Predicates on Markers:: Testing whether an object is a marker.
-* Creating Markers:: Making empty markers or markers at certain places.
-* Information from Markers::Finding the marker's buffer or character position.
-* Marker Insertion Types:: Two ways a marker can relocate when you
- insert where it points.
-* Moving Markers:: Moving the marker to a new buffer or position.
-* The Mark:: How "the mark" is implemented with a marker.
-* The Region:: How to access "the region".
-
-Text
-
-* Near Point:: Examining text in the vicinity of point.
-* Buffer Contents:: Examining text in a general fashion.
-* Comparing Text:: Comparing substrings of buffers.
-* Insertion:: Adding new text to a buffer.
-* Commands for Insertion:: User-level commands to insert text.
-* Deletion:: Removing text from a buffer.
-* User-Level Deletion:: User-level commands to delete text.
-* The Kill Ring:: Where removed text sometimes is saved for
- later use.
-* Undo:: Undoing changes to the text of a buffer.
-* Maintaining Undo:: How to enable and disable undo information.
- How to control how much information is kept.
-* Filling:: Functions for explicit filling.
-* Margins:: How to specify margins for filling commands.
-* Adaptive Fill:: Adaptive Fill mode chooses a fill prefix
- from context.
-* Auto Filling:: How auto-fill mode is implemented to break lines.
-* Sorting:: Functions for sorting parts of the buffer.
-* Columns:: Computing horizontal positions, and using them.
-* Indentation:: Functions to insert or adjust indentation.
-* Case Changes:: Case conversion of parts of the buffer.
-* Text Properties:: Assigning Lisp property lists to text characters.
-* Substitution:: Replacing a given character wherever it appears.
-* Transposition:: Swapping two portions of a buffer.
-* Registers:: How registers are implemented. Accessing
- the text or position stored in a register.
-* Base 64:: Conversion to or from base 64 encoding.
-* MD5 Checksum:: Compute the MD5 "message digest"/"checksum".
-* Atomic Changes:: Installing several buffer changes "atomically".
-* Change Hooks:: Supplying functions to be run when text is changed.
-
-The Kill Ring
-
-* Kill Ring Concepts:: What text looks like in the kill ring.
-* Kill Functions:: Functions that kill text.
-* Yanking:: How yanking is done.
-* Yank Commands:: Commands that access the kill ring.
-* Low-Level Kill Ring:: Functions and variables for kill ring access.
-* Internals of Kill Ring:: Variables that hold kill ring data.
-
-Indentation
-
-* Primitive Indent:: Functions used to count and insert indentation.
-* Mode-Specific Indent:: Customize indentation for different modes.
-* Region Indent:: Indent all the lines in a region.
-* Relative Indent:: Indent the current line based on previous lines.
-* Indent Tabs:: Adjustable, typewriter-like tab stops.
-* Motion by Indent:: Move to first non-blank character.
-
-Text Properties
-
-* Examining Properties:: Looking at the properties of one character.
-* Changing Properties:: Setting the properties of a range of text.
-* Property Search:: Searching for where a property changes value.
-* Special Properties:: Particular properties with special meanings.
-* Format Properties:: Properties for representing formatting of text.
-* Sticky Properties:: How inserted text gets properties from
- neighboring text.
-* Lazy Properties:: Computing text properties in a lazy fashion
- only when text is examined.
-* Clickable Text:: Using text properties to make regions of text
- do something when you click on them.
-* Fields:: The @code{field} property defines
- fields within the buffer.
-* Not Intervals:: Why text properties do not use
- Lisp-visible text intervals.
-
-Non-@acronym{ASCII} Characters
-
-* Text Representations:: How Emacs represents text.
-* Converting Representations:: Converting unibyte to multibyte and vice versa.
-* Selecting a Representation:: Treating a byte sequence as unibyte or multi.
-* Character Codes:: How unibyte and multibyte relate to
- codes of individual characters.
-* Character Properties:: Character attributes that define their
- behavior and handling.
-* Character Sets:: The space of possible character codes
- is divided into various character sets.
-* Scanning Charsets:: Which character sets are used in a buffer?
-* Translation of Characters:: Translation tables are used for conversion.
-* Coding Systems:: Coding systems are conversions for saving files.
-* Input Methods:: Input methods allow users to enter various
- non-ASCII characters without special keyboards.
-* Locales:: Interacting with the POSIX locale.
-
-Coding Systems
-
-* Coding System Basics:: Basic concepts.
-* Encoding and I/O:: How file I/O functions handle coding systems.
-* Lisp and Coding Systems:: Functions to operate on coding system names.
-* User-Chosen Coding Systems:: Asking the user to choose a coding system.
-* Default Coding Systems:: Controlling the default choices.
-* Specifying Coding Systems:: Requesting a particular coding system
- for a single file operation.
-* Explicit Encoding:: Encoding or decoding text without doing I/O.
-* Terminal I/O Encoding:: Use of encoding for terminal I/O.
-* MS-DOS File Types:: How DOS "text" and "binary" files
- relate to coding systems.
-
-Searching and Matching
-
-* String Search:: Search for an exact match.
-* Searching and Case:: Case-independent or case-significant searching.
-* Regular Expressions:: Describing classes of strings.
-* Regexp Search:: Searching for a match for a regexp.
-* POSIX Regexps:: Searching POSIX-style for the longest match.
-* Match Data:: Finding out which part of the text matched,
- after a string or regexp search.
-* Search and Replace:: Commands that loop, searching and replacing.
-* Standard Regexps:: Useful regexps for finding sentences, pages,...
-
-Regular Expressions
-
-* Syntax of Regexps:: Rules for writing regular expressions.
-* Regexp Example:: Illustrates regular expression syntax.
-* Regexp Functions:: Functions for operating on regular expressions.
-
-Syntax of Regular Expressions
-
-* Regexp Special:: Special characters in regular expressions.
-* Char Classes:: Character classes used in regular expressions.
-* Regexp Backslash:: Backslash-sequences in regular expressions.
-
-The Match Data
-
-* Replacing Match:: Replacing a substring that was matched.
-* Simple Match Data:: Accessing single items of match data,
- such as where a particular subexpression started.
-* Entire Match Data:: Accessing the entire match data at once, as a list.
-* Saving Match Data:: Saving and restoring the match data.
-
-Syntax Tables
-
-* Syntax Basics:: Basic concepts of syntax tables.
-* Syntax Descriptors:: How characters are classified.
-* Syntax Table Functions:: How to create, examine and alter syntax tables.
-* Syntax Properties:: Overriding syntax with text properties.
-* Motion and Syntax:: Moving over characters with certain syntaxes.
-* Parsing Expressions:: Parsing balanced expressions
- using the syntax table.
-* Standard Syntax Tables:: Syntax tables used by various major modes.
-* Syntax Table Internals:: How syntax table information is stored.
-* Categories:: Another way of classifying character syntax.
-
-Syntax Descriptors
-
-* Syntax Class Table:: Table of syntax classes.
-* Syntax Flags:: Additional flags each character can have.
-
-Parsing Expressions
-
-* Motion via Parsing:: Motion functions that work by parsing.
-* Position Parse:: Determining the syntactic state of a position.
-* Parser State:: How Emacs represents a syntactic state.
-* Low-Level Parsing:: Parsing across a specified region.
-* Control Parsing:: Parameters that affect parsing.
-
-Abbrevs and Abbrev Expansion
-
-* Abbrev Mode:: Setting up Emacs for abbreviation.
-* Abbrev Tables:: Creating and working with abbrev tables.
-* Defining Abbrevs:: Specifying abbreviations and their expansions.
-* Abbrev Files:: Saving abbrevs in files.
-* Abbrev Expansion:: Controlling expansion; expansion subroutines.
-* Standard Abbrev Tables:: Abbrev tables used by various major modes.
-* Abbrev Properties:: How to read and set abbrev properties.
- Which properties have which effect.
-* Abbrev Table Properties:: How to read and set abbrev table properties.
- Which properties have which effect.
-
-Processes
-
-* Subprocess Creation:: Functions that start subprocesses.
-* Shell Arguments:: Quoting an argument to pass it to a shell.
-* Synchronous Processes:: Details of using synchronous subprocesses.
-* Asynchronous Processes:: Starting up an asynchronous subprocess.
-* Deleting Processes:: Eliminating an asynchronous subprocess.
-* Process Information:: Accessing run-status and other attributes.
-* Input to Processes:: Sending input to an asynchronous subprocess.
-* Signals to Processes:: Stopping, continuing or interrupting
- an asynchronous subprocess.
-* Output from Processes:: Collecting output from an asynchronous subprocess.
-* Sentinels:: Sentinels run when process run-status changes.
-* Query Before Exit:: Whether to query if exiting will kill a process.
-* System Processes:: Accessing other processes running on your system.
-* Transaction Queues:: Transaction-based communication with subprocesses.
-* Network:: Opening network connections.
-* Network Servers:: Network servers let Emacs accept net connections.
-* Datagrams:: UDP network connections.
-* Low-Level Network:: Lower-level but more general function
- to create connections and servers.
-* Misc Network:: Additional relevant functions for
- network connections.
-* Serial Ports:: Communicating with serial ports.
-* Byte Packing:: Using bindat to pack and unpack binary data.
-
-Receiving Output from Processes
-
-* Process Buffers:: If no filter, output is put in a buffer.
-* Filter Functions:: Filter functions accept output from the process.
-* Decoding Output:: Filters can get unibyte or multibyte strings.
-* Accepting Output:: How to wait until process output arrives.
-
-Low-Level Network Access
-
-* Network Processes:: Using @code{make-network-process}.
-* Network Options:: Further control over network connections.
-* Network Feature Testing:: Determining which network features work on
- the machine you are using.
-
-Packing and Unpacking Byte Arrays
-
-* Bindat Spec:: Describing data layout.
-* Bindat Functions:: Doing the unpacking and packing.
-* Bindat Examples:: Samples of what bindat.el can do for you!
-
-Emacs Display
-
-* Refresh Screen:: Clearing the screen and redrawing everything on it.
-* Forcing Redisplay:: Forcing redisplay.
-* Truncation:: Folding or wrapping long text lines.
-* The Echo Area:: Displaying messages at the bottom of the screen.
-* Warnings:: Displaying warning messages for the user.
-* Invisible Text:: Hiding part of the buffer text.
-* Selective Display:: Hiding part of the buffer text (the old way).
-* Temporary Displays:: Displays that go away automatically.
-* Overlays:: Use overlays to highlight parts of the buffer.
-* Width:: How wide a character or string is on the screen.
-* Line Height:: Controlling the height of lines.
-* Faces:: A face defines a graphics style
- for text characters: font, colors, etc.
-* Fringes:: Controlling window fringes.
-* Scroll Bars:: Controlling vertical scroll bars.
-* Display Property:: Enabling special display features.
-* Images:: Displaying images in Emacs buffers.
-* Buttons:: Adding clickable buttons to Emacs buffers.
-* Abstract Display:: Emacs' Widget for Object Collections.
-* Blinking:: How Emacs shows the matching open parenthesis.
-* Usual Display:: The usual conventions for displaying
- nonprinting chars.
-* Display Tables:: How to specify other conventions.
-* Beeping:: Audible signal to the user.
-* Window Systems:: Which window system is being used.
-* Bidirectional Display:: Display of bidirectional scripts, such as
- Arabic and Farsi.
-* Glyphless Chars:: How glyphless characters are drawn.
-
-The Echo Area
-
-* Displaying Messages:: Explicitly displaying text in the echo area.
-* Progress:: Informing user about progress of a long operation.
-* Logging Messages:: Echo area messages are logged for the user.
-* Echo Area Customization:: Controlling the echo area.
-
-Reporting Warnings
-
-* Warning Basics:: Warnings concepts and functions to report them.
-* Warning Variables:: Variables programs bind to customize
- their warnings.
-* Warning Options:: Variables users set to control display of warnings.
-
-Overlays
-
-* Managing Overlays:: Creating and moving overlays.
-* Overlay Properties:: How to read and set properties.
- What properties do to the screen display.
-* Finding Overlays:: Searching for overlays.
-
-Faces
-
-* Defining Faces:: How to define a face with @code{defface}.
-* Face Attributes:: What is in a face?
-* Attribute Functions:: Functions to examine and set face attributes.
-* Displaying Faces:: How Emacs combines the faces specified for
- a character.
-* Face Remapping:: Remapping faces to alternative definitions.
-* Face Functions:: How to define and examine faces.
-* Auto Faces:: Hook for automatic face assignment.
-* Basic Faces:: Faces that are defined by default.
-* Font Selection:: Finding the best available font for a face.
-* Font Lookup:: Looking up the names of available fonts
- and information about them.
-* Fontsets:: A fontset is a collection of fonts
- that handle a range of character sets.
-* Low-Level Font:: Lisp representation for character display fonts.
-
-Fringes
-
-* Fringe Size/Pos:: Specifying where to put the window fringes.
-* Fringe Indicators:: Displaying indicator icons in the window fringes.
-* Fringe Cursors:: Displaying cursors in the right fringe.
-* Fringe Bitmaps:: Specifying bitmaps for fringe indicators.
-* Customizing Bitmaps:: Specifying your own bitmaps to use in the fringes.
-* Overlay Arrow:: Display of an arrow to indicate position.
-
-The @code{display} Property
-
-* Replacing Specs:: Display specs that replace the text.
-* Specified Space:: Displaying one space with a specified width.
-* Pixel Specification:: Specifying space width or height in pixels.
-* Other Display Specs:: Displaying an image; adjusting the height,
- spacing, and other properties of text.
-* Display Margins:: Displaying text or images to the side of
- the main text.
-
-Images
-
-* Image Formats:: Supported image formats.
-* Image Descriptors:: How to specify an image for use in @code{:display}.
-* XBM Images:: Special features for XBM format.
-* XPM Images:: Special features for XPM format.
-* GIF Images:: Special features for GIF format.
-* TIFF Images:: Special features for TIFF format.
-* PostScript Images:: Special features for PostScript format.
-* Other Image Types:: Various other formats are supported.
-* Defining Images:: Convenient ways to define an image for later use.
-* Showing Images:: Convenient ways to display an image once
- it is defined.
-* Image Cache:: Internal mechanisms of image display.
-
-Buttons
-
-* Button Properties:: Button properties with special meanings.
-* Button Types:: Defining common properties for classes of buttons.
-* Making Buttons:: Adding buttons to Emacs buffers.
-* Manipulating Buttons:: Getting and setting properties of buttons.
-* Button Buffer Commands:: Buffer-wide commands and bindings for buttons.
-
-Abstract Display
-
-* Abstract Display Functions:: Functions in the Ewoc package.
-* Abstract Display Example:: Example of using Ewoc.
-
-Display Tables
-
-* Display Table Format:: What a display table consists of.
-* Active Display Table:: How Emacs selects a display table to use.
-* Glyphs:: How to define a glyph, and what glyphs mean.
-
-Operating System Interface
-
-* Starting Up:: Customizing Emacs startup processing.
-* Getting Out:: How exiting works (permanent or temporary).
-* System Environment:: Distinguish the name and kind of system.
-* User Identification:: Finding the name and user id of the user.
-* Time of Day:: Getting the current time.
-* Time Conversion:: Converting a time from numeric form to
- calendrical data and vice versa.
-* Time Parsing:: Converting a time from numeric form to text
- and vice versa.
-* Processor Run Time:: Getting the run time used by Emacs.
-* Time Calculations:: Adding, subtracting, comparing times, etc.
-* Timers:: Setting a timer to call a function at a
- certain time.
-* Idle Timers:: Setting a timer to call a function when Emacs has
- been idle for a certain length of time.
-* Terminal Input:: Accessing and recording terminal input.
-* Terminal Output:: Controlling and recording terminal output.
-* Sound Output:: Playing sounds on the computer's speaker.
-* X11 Keysyms:: Operating on key symbols for X Windows.
-* Batch Mode:: Running Emacs without terminal interaction.
-* Session Management:: Saving and restoring state with
- X Session Management.
-
-Preparing Lisp code for distribution
-
-* Packaging Basics:: The basic concepts of Emacs Lisp packages.
-* Simple Packages:: How to package a single .el file.
-* Multi-file Packages:: How to package multiple files.
-
-Starting Up Emacs
-
-* Startup Summary:: Sequence of actions Emacs performs at startup.
-* Init File:: Details on reading the init file.
-* Terminal-Specific:: How the terminal-specific Lisp file is read.
-* Command-Line Arguments:: How command-line arguments are processed,
- and how you can customize them.
-
-Getting Out of Emacs
-
-* Killing Emacs:: Exiting Emacs irreversibly.
-* Suspending Emacs:: Exiting Emacs reversibly.
-
-Terminal Input
-
-* Input Modes:: Options for how input is processed.
-* Recording Input:: Saving histories of recent or all input events.
-
-Tips and Conventions
-
-* Coding Conventions:: Conventions for clean and robust programs.
-* Key Binding Conventions:: Which keys should be bound by which programs.
-* Programming Tips:: Making Emacs code fit smoothly in Emacs.
-* Compilation Tips:: Making compiled code run fast.
-* Warning Tips:: Turning off compiler warnings.
-* Documentation Tips:: Writing readable documentation strings.
-* Comment Tips:: Conventions for writing comments.
-* Library Headers:: Standard headers for library packages.
-
-GNU Emacs Internals
-
-* Building Emacs:: How the dumped Emacs is made.
-* Pure Storage:: Kludge to make preloaded Lisp functions shareable.
-* Garbage Collection:: Reclaiming space for Lisp objects no longer used.
-* Memory Usage:: Info about total size of Lisp objects made so far.
-* Writing Emacs Primitives:: Writing C code for Emacs.
-* Object Internals:: Data formats of buffers, windows, processes.
-
-Object Internals
-
-* Buffer Internals:: Components of a buffer structure.
-* Window Internals:: Components of a window structure.
-* Process Internals:: Components of a process structure.
-@end detailmenu
-@end menu
-
-@c include intro.texi
-@c include objects.texi
-@c include numbers.texi
-@c include strings.texi
-
-@c include lists.texi
-@c include sequences.texi
-@c include hash.texi
-@c include symbols.texi
-@c include eval.texi
-
-@c include control.texi
-@c include variables.texi
-@c include functions.texi
-@c include macros.texi
-
-@c include customize.texi
-@c include loading.texi
-@c include compile.texi
-@c include advice.texi
-
-@c This includes edebug.texi.
-@c include debugging.texi
-@c include streams.texi
-@c include minibuf.texi
-@c include commands.texi
-
-@c include keymaps.texi
-@c include modes.texi
-@c include help.texi
-@c include files.texi
-
-@c include backups.texi
-
-@c ================ Beginning of Volume 2 ================
-@include buffers.texi
-@include windows.texi
-@include frames.texi
-
-@include positions.texi
-@include markers.texi
-@include text.texi
-@include nonascii.texi
-
-@include searching.texi
-@include syntax.texi
-@include abbrevs.texi
-@include processes.texi
-
-@include display.texi
-@include os.texi
-
-@c MOVE to Emacs Manual: include misc-modes.texi
-
-@c appendices
-
-@c REMOVE this: include non-hacker.texi
-
-@include anti.texi
-@include doclicense.texi
-@include gpl.texi
-@include tips.texi
-@include internals.texi
-@include errors.texi
-@include locals.texi
-@include maps.texi
-@include hooks.texi
-
-@include index.texi
-
-@ignore
-@node New Symbols, , Index, Top
-@unnumbered New Symbols Since the Previous Edition
-
-@printindex tp
-@end ignore
-
-@bye
-
-
-These words prevent "local variables" above from confusing Emacs.
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index df631158689..7622fcfd233 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -1,10 +1,9 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2011
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/windows
-@node Windows, Frames, Buffers, Top
+@node Windows
@chapter Windows
This chapter describes the functions and variables related to Emacs
@@ -17,8 +16,10 @@ is displayed in windows.
* Windows and Frames:: Relating windows to the frame they appear on.
* Window Sizes:: Accessing a window's size.
* Resizing Windows:: Changing the sizes of windows.
-* Splitting Windows:: Splitting one window into two windows.
-* Deleting Windows:: Deleting a window gives its space to other windows.
+* Splitting Windows:: Creating a new window.
+* Deleting Windows:: Removing a window from its frame.
+* Recombining Windows:: Preserving the frame layout when splitting and
+ deleting windows.
* Selecting Windows:: The selected window is the one that you edit in.
* Cyclic Window Ordering:: Moving around the existing windows.
* Buffers and Windows:: Each window displays the contents of a buffer.
@@ -50,9 +51,9 @@ is displayed in windows.
@section Basic Concepts of Emacs Windows
@cindex window
-A @dfn{window} is a area of the screen which is used to display a
-buffer (@pxref{Buffers}). In Emacs Lisp, windows are represented by a
-special Lisp object type.
+A @dfn{window} is an area of the screen that is used to display a buffer
+(@pxref{Buffers}). In Emacs Lisp, windows are represented by a special
+Lisp object type.
@cindex multiple windows
Windows are grouped into frames (@pxref{Frames}). Each frame
@@ -68,7 +69,7 @@ window, and the contents of the selected message in another window.
graphical desktop environments and window systems, such as the X
Window System. When Emacs is run on X, each of its graphical X
windows is an Emacs frame (containing one or more Emacs windows).
-When Emacs is run on a text-only terminal, the frame fills the entire
+When Emacs is run on a text terminal, the frame fills the entire
terminal screen.
@cindex tiled windows
@@ -77,30 +78,35 @@ within the area of the frame. When a window is created, resized, or
deleted, the change in window space is taken from or given to the
adjacent windows, so that the total area of the frame is unchanged.
-@cindex live windows
-@cindex internal windows
- A @dfn{live window} is one that is actually displaying a buffer in a
-frame. Such a window can be @dfn{deleted}, i.e. removed from the
-frame (@pxref{Deleting Windows}); then it is no longer live, but the
-Lisp object representing it might be still referenced from other Lisp
-objects. A deleted window may be brought back to life by restoring a
-saved window configuration (@pxref{Window Configurations}).
-
@defun windowp object
This function returns @code{t} if @var{object} is a window (whether or
-not it is live). Otherwise, it returns @code{nil}.
+not it displays a buffer). Otherwise, it returns @code{nil}.
@end defun
+@cindex live windows
+A @dfn{live window} is one that is actually displaying a buffer in a
+frame.
+
@defun window-live-p object
This function returns @code{t} if @var{object} is a live window and
@code{nil} otherwise. A live window is one that displays a buffer.
@end defun
- The windows in each frame are organized into a @dfn{window tree}.
-@xref{Windows and Frames}. The leaf nodes of each window tree are
-live windows---the ones actually displaying buffers. The internal
-nodes of the window tree are internal windows, which are not live.
-You can distinguish internal windows from deleted windows with
+@cindex internal windows
+The windows in each frame are organized into a @dfn{window tree}.
+@xref{Windows and Frames}. The leaf nodes of each window tree are live
+windows---the ones actually displaying buffers. The internal nodes of
+the window tree are @dfn{internal windows}, which are not live.
+
+@cindex valid windows
+ A @dfn{valid window} is one that is either live or internal. A valid
+window can be @dfn{deleted}, i.e. removed from its frame
+(@pxref{Deleting Windows}); then it is no longer valid, but the Lisp
+object representing it might be still referenced from other Lisp
+objects. A deleted window may be made valid again by restoring a saved
+window configuration (@pxref{Window Configurations}).
+
+ You can distinguish valid windows from deleted windows with
@code{window-valid-p}.
@defun window-valid-p object
@@ -241,12 +247,12 @@ following example:
@end smallexample
@noindent
-The root window of this frame is an internal window, @code{W1}. Its
+The root window of this frame is an internal window, @var{W1}. Its
child windows form a horizontal combination, consisting of the live
-window @code{W2} and the internal window @code{W3}. The child windows
-of @code{W3} form a vertical combination, consisting of the live
-windows @code{W4} and @code{W5}. Hence, the live windows in this
-window tree are @code{W2} @code{W4}, and @code{W5}.
+window @var{W2} and the internal window @var{W3}. The child windows
+of @var{W3} form a vertical combination, consisting of the live
+windows @var{W4} and @var{W5}. Hence, the live windows in this
+window tree are @var{W2} @var{W4}, and @var{W5}.
The following functions can be used to retrieve a child window of an
internal window, and the siblings of a child window.
@@ -298,12 +304,12 @@ child of its parent.
The functions @code{window-next-sibling} and
@code{window-prev-sibling} should not be confused with the functions
-@code{next-window} and @code{previous-window} which respectively
-return the next and previous window in the cyclic ordering of windows
+@code{next-window} and @code{previous-window}, which return the next
+and previous window, respectively, in the cyclic ordering of windows
(@pxref{Cyclic Window Ordering}).
- You can use the following functions to find the first live window on
-a frame, and to retrieve the entire window tree of a frame:
+ You can use the following functions to find the first live window on a
+frame and the window nearest to a given window.
@defun frame-first-window &optional frame-or-window
This function returns the live window at the upper left corner of the
@@ -312,9 +318,32 @@ frame specified by @var{frame-or-window}. The argument
to the selected frame. If @var{frame-or-window} specifies a window,
this function returns the first window on that window's frame. Under
the assumption that the frame from our canonical example is selected
-@code{(frame-first-window)} returns @code{W2}.
+@code{(frame-first-window)} returns @var{W2}.
@end defun
+@cindex window in direction
+@defun window-in-direction direction &optional window ignore
+This function returns the nearest live window in direction
+@var{direction} as seen from the position of @code{window-point} in
+window @var{window}. The argument @var{direction} must be one of
+@code{above}, @code{below}, @code{left} or @code{right}. The optional
+argument @var{window} must denote a live window and defaults to the
+selected one.
+
+This function does not return a window whose @code{no-other-window}
+parameter is non-@code{nil} (@pxref{Window Parameters}). If the nearest
+window's @code{no-other-window} parameter is non-@code{nil}, this
+function tries to find another window in the indicated direction whose
+@code{no-other-window} parameter is @code{nil}. If the optional
+argument @var{ignore} is non-@code{nil}, a window may be returned even
+if its @code{no-other-window} parameter is non-@code{nil}.
+
+If it doesn't find a suitable window, this function returns @code{nil}.
+@end defun
+
+The following function allows to retrieve the entire window tree of a
+frame:
+
@defun window-tree &optional frame
This function returns a list representing the window tree for frame
@var{frame}. If @var{frame} is omitted or @code{nil}, it defaults to
@@ -377,7 +406,7 @@ line (@pxref{Mode Line Format}).
Emacs provides several functions for finding the height and width of
a window. Except where noted, Emacs reports window heights and widths
-as integer numbers of lines and columns respectively. On a graphical
+as integer numbers of lines and columns, respectively. On a graphical
display, each ``line'' and ``column'' actually corresponds to the
height and width of a ``default'' character specified by the frame's
default font. Thus, if a window is displaying text with a different
@@ -479,11 +508,13 @@ partially-visible line at the bottom of the text area is not counted.
@end defun
For compatibility with previous versions of Emacs,
-@code{window-height} is an alias for @code{window-body-height}, and
+@code{window-height} is an alias for @code{window-total-height}, and
@code{window-width} is an alias for @code{window-body-width}. These
aliases are considered obsolete and will be removed in the future.
@cindex fixed-size window
+@vindex window-min-height
+@vindex window-min-width
Commands that change the size of windows (@pxref{Resizing Windows}),
or split them (@pxref{Splitting Windows}), obey the variables
@code{window-min-height} and @code{window-min-width}, which specify
@@ -583,7 +614,7 @@ function @code{window-resizable} above.
The choice of which window edges this function alters depends on the
values of the option @code{window-combination-resize} and the
combination limits of the involved windows; in some cases, it may alter
-both edges. @xref{Splitting Windows}. To resize by moving only the
+both edges. @xref{Recombining Windows}. To resize by moving only the
bottom or right edge of a window, use the function
@code{adjust-window-trailing-edge}, below.
@end defun
@@ -620,13 +651,17 @@ window.
The optional argument @var{max-height}, if non-@code{nil}, specifies
the maximum total height that this function can give @var{window}.
-The optional argument @var{min-height}, if no-@code{nil}, specifies
+The optional argument @var{min-height}, if non-@code{nil}, specifies
the minimum total height that it can give, which overrides the
variable @code{window-min-height}.
If the optional argument @var{override} is non-@code{nil}, this
function ignores any size restrictions imposed by
@code{window-min-height} and @code{window-min-width}.
+
+@vindex fit-frame-to-buffer
+If the option @code{fit-frame-to-buffer} is non-@code{nil}, this
+command may resize the frame to fit its contents.
@end deffn
@deffn Command shrink-window-if-larger-than-buffer &optional window
@@ -724,7 +759,7 @@ properties of the window selected within @var{window}'s frame.
The behavior of this function may be altered by the window parameters
of @var{window}, so long as the variable
-@code{ignore-window-parameters} is non-@code{nil}. If the value of
+@code{ignore-window-parameters} is @code{nil}. If the value of
the @code{split-window} window parameter is @code{t}, this function
ignores all other window parameters. Otherwise, if the value of the
@code{split-window} window parameter is a function, that function is
@@ -791,26 +826,169 @@ A new live window @var{W2} is created, to the left of the internal
window @var{W3}. A new internal window @var{W1} is created, becoming
the new root window.
-@defopt window-combination-resize
-If this variable is @code{nil}, @code{split-window} can only split a
-window (denoted by @var{window}) if @var{window}'s screen area is large
-enough to accommodate both itself and the new window.
+ For interactive use, Emacs provides two commands which always split
+the selected window. These call @code{split-window} internally.
-If this variable is @code{t}, @code{split-window} tries to resize all
-windows that are part of the same combination as @var{window}, in order
-to accommodate the new window. In particular, this may allow
-@code{split-window} to succeed even if @var{window} is a fixed-size
-window or too small to ordinarily split. Furthermore, subsequently
-resizing or deleting @var{window} may resize all other windows in its
-combination.
+@deffn Command split-window-right &optional size
+This function splits the selected window into two side-by-side
+windows, putting the selected window on the left. If @var{size} is
+positive, the left window gets @var{size} columns; if @var{size} is
+negative, the right window gets @minus{}@var{size} columns.
+@end deffn
-The default is @code{nil}. Other values are reserved for future use.
-The value of this variable is ignored when
-@code{window-combination-limit} is non-@code{nil} (see below).
+@deffn Command split-window-below &optional size
+This function splits the selected window into two windows, one above
+the other, leaving the upper window selected. If @var{size} is
+positive, the upper window gets @var{size} lines; if @var{size} is
+negative, the lower window gets @minus{}@var{size} lines.
+@end deffn
+
+@defopt split-window-keep-point
+If the value of this variable is non-@code{nil} (the default),
+@code{split-window-below} behaves as described above.
+
+If it is @code{nil}, @code{split-window-below} adjusts point in each
+of the two windows to minimize redisplay. (This is useful on slow
+terminals.) It selects whichever window contains the screen line that
+point was previously on. Note that this only affects
+@code{split-window-below}, not the lower-level @code{split-window}
+function.
@end defopt
- To illustrate the effect of @code{window-combination-resize},
-consider the following window configuration:
+@node Deleting Windows
+@section Deleting Windows
+@cindex deleting windows
+
+ @dfn{Deleting} a window removes it from the frame's window tree. If
+the window is a live window, it disappears from the screen. If the
+window is an internal window, its child windows are deleted too.
+
+ Even after a window is deleted, it continues to exist as a Lisp
+object, until there are no more references to it. Window deletion can
+be reversed, by restoring a saved window configuration (@pxref{Window
+Configurations}).
+
+@deffn Command delete-window &optional window
+This function removes @var{window} from display and returns
+@code{nil}. If @var{window} is omitted or @code{nil}, it defaults to
+the selected window. If deleting the window would leave no more
+windows in the window tree (e.g. if it is the only live window in the
+frame), an error is signaled.
+
+By default, the space taken up by @var{window} is given to one of its
+adjacent sibling windows, if any. However, if the variable
+@code{window-combination-resize} is non-@code{nil}, the space is
+proportionally distributed among any remaining windows in the window
+combination. @xref{Recombining Windows}.
+
+The behavior of this function may be altered by the window parameters
+of @var{window}, so long as the variable
+@code{ignore-window-parameters} is @code{nil}. If the value of
+the @code{delete-window} window parameter is @code{t}, this function
+ignores all other window parameters. Otherwise, if the value of the
+@code{delete-window} window parameter is a function, that function is
+called with the argument @var{window}, in lieu of the usual action of
+@code{delete-window}. Otherwise, this function obeys the
+@code{window-atom} or @code{window-side} window parameter, if any.
+@xref{Window Parameters}.
+@end deffn
+
+@deffn Command delete-other-windows &optional window
+This function makes @var{window} fill its frame, by deleting other
+windows as necessary. If @var{window} is omitted or @code{nil}, it
+defaults to the selected window. The return value is @code{nil}.
+
+The behavior of this function may be altered by the window parameters
+of @var{window}, so long as the variable
+@code{ignore-window-parameters} is @code{nil}. If the value of
+the @code{delete-other-windows} window parameter is @code{t}, this
+function ignores all other window parameters. Otherwise, if the value
+of the @code{delete-other-windows} window parameter is a function,
+that function is called with the argument @var{window}, in lieu of the
+usual action of @code{delete-other-windows}. Otherwise, this function
+obeys the @code{window-atom} or @code{window-side} window parameter,
+if any. @xref{Window Parameters}.
+@end deffn
+
+@deffn Command delete-windows-on &optional buffer-or-name frame
+This function deletes all windows showing @var{buffer-or-name}, by
+calling @code{delete-window} on those windows. @var{buffer-or-name}
+should be a buffer, or the name of a buffer; if omitted or @code{nil},
+it defaults to the current buffer. If there are no windows showing
+the specified buffer, this function does nothing. If the specified
+buffer is a minibuffer, an error is signaled.
+
+If there is a dedicated window showing the buffer, and that window is
+the only one on its frame, this function also deletes that frame if it
+is not the only frame on the terminal.
+
+The optional argument @var{frame} specifies which frames to operate
+on:
+
+@itemize @bullet
+@item @code{nil}
+means operate on all frames.
+@item @code{t}
+means operate on the selected frame.
+@item @code{visible}
+means operate on all visible frames.
+@item @code{0}
+means operate on all visible or iconified frames.
+@item A frame
+means operate on that frame.
+@end itemize
+
+Note that this argument does not have the same meaning as in other
+functions which scan all live windows (@pxref{Cyclic Window
+Ordering}). Specifically, the meanings of @code{t} and @code{nil} here
+are the opposite of what they are in those other functions.
+@end deffn
+
+
+@node Recombining Windows
+@section Recombining Windows
+
+When deleting the last sibling of a window @var{W}, its parent window
+is deleted too, with @var{W} replacing it in the window tree. This
+means that @var{W} must be recombined with its parent's siblings to
+form a new window combination (@pxref{Windows and Frames}). In some
+occasions, deleting a live window may even entail the deletion of two
+internal windows.
+
+@smallexample
+@group
+ ______________________________________
+ | ______ ____________________________ |
+ || || __________________________ ||
+ || ||| ___________ ___________ |||
+ || |||| || ||||
+ || ||||____W6_____||_____W7____||||
+ || |||____________W4____________|||
+ || || __________________________ ||
+ || ||| |||
+ || ||| |||
+ || |||____________W5____________|||
+ ||__W2__||_____________W3_____________ |
+ |__________________W1__________________|
+
+@end group
+@end smallexample
+
+@noindent
+Deleting @var{W5} in this configuration normally causes the deletion of
+@var{W3} and @var{W4}. The remaining live windows @var{W2},
+@var{W6} and @var{W7} are recombined to form a new horizontal
+combination with parent @var{W1}.
+
+ Sometimes, however, it makes sense to not delete a parent window like
+@var{W4}. In particular, a parent window should not be removed when it
+was used to preserve a combination embedded in a combination of the same
+type. Such embeddings make sense to assure that when you split a window
+and subsequently delete the new window, Emacs reestablishes the layout
+of the associated frame as it existed before the splitting.
+
+ Consider a scenario starting with two live windows @var{W2} and
+@var{W3} and their parent @var{W1}.
@smallexample
@group
@@ -820,10 +998,10 @@ consider the following window configuration:
|| ||
|| ||
|| ||
- ||_________________W2_________________||
- | ____________________________________ |
|| ||
|| ||
+ ||_________________W2_________________||
+ | ____________________________________ |
|| ||
|| ||
||_________________W3_________________||
@@ -833,8 +1011,7 @@ consider the following window configuration:
@end smallexample
@noindent
-If @code{window-combination-resize} is @code{nil}, splitting window
-@code{W3} leaves the size of @code{W2} unchanged:
+Split @var{W2} to make a new window @var{W4} as follows.
@smallexample
@group
@@ -842,24 +1019,25 @@ If @code{window-combination-resize} is @code{nil}, splitting window
| ____________________________________ |
|| ||
|| ||
- || ||
- || ||
||_________________W2_________________||
| ____________________________________ |
|| ||
- ||_________________W3_________________||
- | ____________________________________ |
|| ||
||_________________W4_________________||
+ | ____________________________________ |
+ || ||
+ || ||
+ ||_________________W3_________________||
|__________________W1__________________|
@end group
@end smallexample
@noindent
-If @code{window-combination-resize} is @code{t}, splitting @code{W3}
-instead leaves all three live windows with approximately the same
-height:
+Now, when enlarging a window vertically, Emacs tries to obtain the
+corresponding space from its lower sibling, provided such a window
+exists. In our scenario, enlarging @var{W4} will steal space from
+@var{W3}.
@smallexample
@group
@@ -871,36 +1049,119 @@ height:
| ____________________________________ |
|| ||
|| ||
+ || ||
+ || ||
+ ||_________________W4_________________||
+ | ____________________________________ |
||_________________W3_________________||
+ |__________________W1__________________|
+
+@end group
+@end smallexample
+
+@noindent
+Deleting @var{W4} will now give its entire space to @var{W2},
+including the space earlier stolen from @var{W3}.
+
+@smallexample
+@group
+ ______________________________________
| ____________________________________ |
|| ||
|| ||
- ||_________________W4_________________||
+ || ||
+ || ||
+ || ||
+ || ||
+ || ||
+ || ||
+ ||_________________W2_________________||
+ | ____________________________________ |
+ ||_________________W3_________________||
|__________________W1__________________|
@end group
@end smallexample
+@noindent
+This can be counterintuitive, in particular if @var{W4} were used for
+displaying a buffer only temporarily (@pxref{Temporary Displays}), and
+you want to continue working with the initial layout.
+
+The behavior can be fixed by making a new parent window when splitting
+@var{W2}. The variable described next allows to do that.
+
@defopt window-combination-limit
-If the value of this variable is @code{t}, the @code{split-window}
-function always creates a new internal window. If the value is
-@code{nil}, the new live window is allowed to share the existing
+This variable controls whether splitting a window shall make a new
+parent window. The following values are recognized:
+
+@table @code
+@item nil
+This means that the new live window is allowed to share the existing
parent window, if one exists, provided the split occurs in the same
-direction as the existing window combination (otherwise, a new
-internal window is created anyway). The default is @code{nil}. Other
-values are reserved for future use.
-
-Thus, if the value of this variable is at all times @code{t}, then at
-all times every window tree is a binary tree (a tree where each window
-except the root window has exactly one sibling).
-
-Furthermore, @code{split-window} calls
-@code{set-window-combination-limit} on the newly-created internal
-window, recording the current value of this variable. This affects
-how the window tree is rearranged when the child windows are deleted
-(see below).
+direction as the existing window combination (otherwise, a new internal
+window is created anyway).
+
+@item window-size
+In this case @code{display-buffer} makes a new parent window if it is
+passed a @code{window-height} or @code{window-width} entry in the
+@var{alist} argument (@pxref{Display Action Functions}).
+
+@item temp-buffer
+This value causes the creation of a new parent window when a window is
+split for showing a temporary buffer (@pxref{Temporary Displays}) only.
+
+@item display-buffer
+This means that when @code{display-buffer} (@pxref{Choosing Window})
+splits a window it always makes a new parent window.
+
+@item t
+In this case a new parent window is always created when splitting a
+window. Thus, if the value of this variable is at all times @code{t},
+then at all times every window tree is a binary tree (a tree where each
+window except the root window has exactly one sibling).
+@end table
+
+The default is @code{nil}. Other values are reserved for future use.
+
+If, as a consequence of this variable's setting, @code{split-window}
+makes a new parent window, it also calls
+@code{set-window-combination-limit} (see below) on the newly-created
+internal window. This affects how the window tree is rearranged when
+the child windows are deleted (see below).
@end defopt
+ If @code{window-combination-limit} is @code{t}, splitting @var{W2} in
+the initial configuration of our scenario would have produced this:
+
+@smallexample
+@group
+ ______________________________________
+ | ____________________________________ |
+ || __________________________________ ||
+ ||| |||
+ |||________________W2________________|||
+ || __________________________________ ||
+ ||| |||
+ |||________________W4________________|||
+ ||_________________W5_________________||
+ | ____________________________________ |
+ || ||
+ || ||
+ ||_________________W3_________________||
+ |__________________W1__________________|
+
+@end group
+@end smallexample
+
+@noindent
+A new internal window @var{W5} has been created; its children are
+@var{W2} and the new live window @var{W4}. Now, @var{W2} is the only
+sibling of @var{W4}, so enlarging @var{W4} will try to shrink
+@var{W2}, leaving @var{W3} unaffected. Observe that @var{W5}
+represents a vertical combination of two windows embedded in the
+vertical combination @var{W1}.
+
@cindex window combination limit
@defun set-window-combination-limit window limit
This functions sets the @dfn{combination limit} of the window
@@ -908,25 +1169,52 @@ This functions sets the @dfn{combination limit} of the window
function @code{window-combination-limit}. See below for its effects;
note that it is only meaningful for internal windows. The
@code{split-window} function automatically calls this function, passing
-the value of the variable @code{window-combination-limit} as
-@var{limit}.
+it @code{t} as @var{limit}, provided the value of the variable
+@code{window-combination-limit} is @code{t} when it is called.
@end defun
@defun window-combination-limit window
This function returns the combination limit for @var{window}.
-The combination limit is meaningful only for an internal window. If
-it is @code{nil}, then Emacs is allowed to automatically delete
+The combination limit is meaningful only for an internal window. If it
+is @code{nil}, then Emacs is allowed to automatically delete
@var{window}, in response to a window deletion, in order to group the
child windows of @var{window} with its sibling windows to form a new
window combination. If the combination limit is @code{t}, the child
-windows of @var{window} are never automatically re-combined with its
+windows of @var{window} are never automatically recombined with its
siblings.
+
+If, in the configuration shown at the beginning of this section, the
+combination limit of @var{W4} (the parent window of @var{W6} and
+@var{W7}) is @code{t}, deleting @var{W5} will not implicitly delete
+@var{W4} too.
@end defun
- To illustrate the effect of @code{window-combination-limit},
-consider the following configuration (throughout this example, we will
-assume that @code{window-combination-resize} is @code{nil}):
+Alternatively, the problems sketched above can be avoided by always
+resizing all windows in the same combination whenever one of its windows
+is split or deleted. This also permits to split windows that would be
+otherwise too small for such an operation.
+
+@defopt window-combination-resize
+If this variable is @code{nil}, @code{split-window} can only split a
+window (denoted by @var{window}) if @var{window}'s screen area is large
+enough to accommodate both itself and the new window.
+
+If this variable is @code{t}, @code{split-window} tries to resize all
+windows that are part of the same combination as @var{window}, in order
+to accommodate the new window. In particular, this may allow
+@code{split-window} to succeed even if @var{window} is a fixed-size
+window or too small to ordinarily split. Furthermore, subsequently
+resizing or deleting @var{window} may resize all other windows in its
+combination.
+
+The default is @code{nil}. Other values are reserved for future use.
+The value of this variable is ignored when
+@code{window-combination-limit} is non-@code{nil}.
+@end defopt
+
+ To illustrate the effect of @code{window-combination-resize}, consider
+the following frame layout.
@smallexample
@group
@@ -936,12 +1224,12 @@ assume that @code{window-combination-resize} is @code{nil}):
|| ||
|| ||
|| ||
- || ||
- || ||
||_________________W2_________________||
| ____________________________________ |
|| ||
|| ||
+ || ||
+ || ||
||_________________W3_________________||
|__________________W1__________________|
@@ -949,8 +1237,8 @@ assume that @code{window-combination-resize} is @code{nil}):
@end smallexample
@noindent
-If @code{window-combination-limit} is @code{nil}, splitting @code{W2}
-into two windows, one above the other, yields
+If @code{window-combination-resize} is @code{nil}, splitting window
+@var{W3} leaves the size of @var{W2} unchanged:
@smallexample
@group
@@ -958,171 +1246,50 @@ into two windows, one above the other, yields
| ____________________________________ |
|| ||
|| ||
- ||_________________W2_________________||
- | ____________________________________ |
|| ||
|| ||
- ||_________________W4_________________||
+ ||_________________W2_________________||
| ____________________________________ |
|| ||
- || ||
||_________________W3_________________||
+ | ____________________________________ |
+ || ||
+ ||_________________W4_________________||
|__________________W1__________________|
@end group
@end smallexample
@noindent
-The newly-created window, @code{W4}, shares the same internal window
-@code{W1}. If @code{W4} is resized, it is allowed to resize the other
-live window, @code{W3}.
-
- If @code{window-combination-limit} is @code{t}, splitting @code{W2}
-in the initial configuration would instead have produced this:
+If @code{window-combination-resize} is @code{t}, splitting @var{W3}
+instead leaves all three live windows with approximately the same
+height:
@smallexample
@group
______________________________________
| ____________________________________ |
- || __________________________________ ||
- ||| |||
- |||________________W2________________|||
- || __________________________________ ||
- ||| |||
- |||________________W4________________|||
- ||_________________W5_________________||
+ || ||
+ || ||
+ ||_________________W2_________________||
| ____________________________________ |
|| ||
|| ||
||_________________W3_________________||
+ | ____________________________________ |
+ || ||
+ || ||
+ ||_________________W4_________________||
|__________________W1__________________|
@end group
@end smallexample
@noindent
-A new internal window @code{W5} has been created; its children are
-@code{W2} and the new live window @code{W4}. Now, @code{W2} is the
-only sibling of @code{W4}, so resizing @code{W4} will resize
-@code{W2}, leaving @code{W3} unaffected.
-
- For interactive use, Emacs provides two commands which always split
-the selected window. These call @code{split-window} internally.
-
-@deffn Command split-window-right &optional size
-This function splits the selected window into two side-by-side
-windows, putting the selected window on the left. If @var{size} is
-positive, the left window gets @var{size} columns; if @var{size} is
-negative, the right window gets @minus{}@var{size} columns.
-@end deffn
+Deleting any of the live windows @var{W2}, @var{W3} or @var{W4} will
+distribute its space proportionally among the two remaining live
+windows.
-@deffn Command split-window-below &optional size
-This function splits the selected window into two windows, one above
-the other, leaving the upper window selected. If @var{size} is
-positive, the upper window gets @var{size} lines; if @var{size} is
-negative, the lower window gets @minus{}@var{size} lines.
-@end deffn
-
-@defopt split-window-keep-point
-If the value of this variable is non-@code{nil} (the default),
-@code{split-window-below} behaves as described above.
-
-If it is @code{nil}, @code{split-window-below} adjusts point in each
-of the two windows to minimize redisplay. (This is useful on slow
-terminals.) It selects whichever window contains the screen line that
-point was previously on. Note that this only affects
-@code{split-window-below}, not the lower-level @code{split-window}
-function.
-@end defopt
-
-@node Deleting Windows
-@section Deleting Windows
-@cindex deleting windows
-
- @dfn{Deleting} a window removes it from the frame's window tree. If
-the window is a live window, it disappears from the screen. If the
-window is an internal window, its child windows are deleted too.
-
- Even after a window is deleted, it continues to exist as a Lisp
-object, until there are no more references to it. Window deletion can
-be reversed, by restoring a saved window configuration (@pxref{Window
-Configurations}).
-
-@deffn Command delete-window &optional window
-This function removes @var{window} from display and returns
-@code{nil}. If @var{window} is omitted or @code{nil}, it defaults to
-the selected window. If deleting the window would leave no more
-windows in the window tree (e.g. if it is the only live window in the
-frame), an error is signaled.
-
-By default, the space taken up by @var{window} is given to one of its
-adjacent sibling windows, if any. However, if the variable
-@code{window-combination-resize} is non-@code{nil}, the space is
-proportionally distributed among any remaining windows in the window
-combination. @xref{Splitting Windows}.
-
-The behavior of this function may be altered by the window parameters
-of @var{window}, so long as the variable
-@code{ignore-window-parameters} is non-@code{nil}. If the value of
-the @code{delete-window} window parameter is @code{t}, this function
-ignores all other window parameters. Otherwise, if the value of the
-@code{delete-window} window parameter is a function, that function is
-called with the argument @var{window}, in lieu of the usual action of
-@code{delete-window}. Otherwise, this function obeys the
-@code{window-atom} or @code{window-side} window parameter, if any.
-@xref{Window Parameters}.
-@end deffn
-
-@deffn Command delete-other-windows &optional window
-This function makes @var{window} fill its frame, by deleting other
-windows as necessary. If @var{window} is omitted or @code{nil}, it
-defaults to the selected window. The return value is @code{nil}.
-
-The behavior of this function may be altered by the window parameters
-of @var{window}, so long as the variable
-@code{ignore-window-parameters} is non-@code{nil}. If the value of
-the @code{delete-other-windows} window parameter is @code{t}, this
-function ignores all other window parameters. Otherwise, if the value
-of the @code{delete-other-windows} window parameter is a function,
-that function is called with the argument @var{window}, in lieu of the
-usual action of @code{delete-other-windows}. Otherwise, this function
-obeys the @code{window-atom} or @code{window-side} window parameter,
-if any. @xref{Window Parameters}.
-@end deffn
-
-@deffn Command delete-windows-on &optional buffer-or-name frame
-This function deletes all windows showing @var{buffer-or-name}, by
-calling @code{delete-window} on those windows. @var{buffer-or-name}
-should be a buffer, or the name of a buffer; if omitted or @code{nil},
-it defaults to the current buffer. If there are no windows showing
-the specified buffer, this function does nothing. If the specified
-buffer is a minibuffer, an error is signaled.
-
-If there is a dedicated window showing the buffer, and that window is
-the only one on its frame, this function also deletes that frame if it
-is not the only frame on the terminal.
-
-The optional argument @var{frame} specifies which frames to operate
-on:
-
-@itemize @bullet
-@item @code{nil}
-means operate on all frames.
-@item @code{t}
-means operate on the selected frame.
-@item @code{visible}
-means operate on all visible frames.
-@item @code{0}
-means operate on all visible or iconified frames.
-@item A frame
-means operate on that frame.
-@end itemize
-
-Note that this argument does not have the same meaning as in other
-functions which scan all live windows (@pxref{Cyclic Window
-Ordering}). Specifically, the values @code{t} and @code{nil} have the
-opposite of their meanings in those other functions.
-@end deffn
@node Selecting Windows
@section Selecting Windows
@@ -1130,16 +1297,15 @@ opposite of their meanings in those other functions.
@defun select-window window &optional norecord
This function makes @var{window} the selected window, as well as the
-window selected within its frame (@pxref{Basic Windows}).
-@var{window} must be a live window. Unless @var{window} already is the
-selected window, its buffer becomes the current buffer (@pxref{Buffers
-and Windows}). The return value is @var{window}.
+window selected within its frame (@pxref{Basic Windows}). @var{window}
+must be a live window. This function makes also @var{window}'s buffer
+current (@pxref{Buffers and Windows}). The return value is
+@var{window}.
-By default, this function also moves @var{window}'s selected buffer to
-the front of the buffer list (@pxref{The Buffer List}), and makes
-@var{window} the most recently selected window. However, if the
-optional argument @var{norecord} is non-@code{nil}, these additional
-actions are omitted.
+By default, this function also moves @var{window}'s buffer to the front
+of the buffer list (@pxref{The Buffer List}), and makes @var{window} the
+most recently selected window. However, if the optional argument
+@var{norecord} is non-@code{nil}, these additional actions are omitted.
@end defun
@cindex most recently selected windows
@@ -1172,11 +1338,11 @@ the buffer list.
This macro selects @var{window}, executes @var{forms} in sequence, then
restores the previously selected window and current buffer. The ordering
of recently selected windows and the buffer list remain unchanged unless
-you deliberately change them within @var{forms}, for example, by calling
+you deliberately change them within @var{forms}; for example, by calling
@code{select-window} with argument @var{norecord} @code{nil}.
-The order of recently selected windows and the buffer list are not
-changed by this macro.
+This macro does not change the order of recently selected windows or
+the buffer list.
@end defmac
@defun frame-selected-window &optional frame
@@ -1186,7 +1352,7 @@ within that frame. @var{frame} should be a live frame; if omitted or
@end defun
@defun set-frame-selected-window frame window &optional norecord
-This function makes @code{window} the window selected within the frame
+This function makes @var{window} the window selected within the frame
@var{frame}. @var{frame} should be a live frame; if omitted or
@code{nil}, it defaults to the selected frame. @var{window} should be
a live window; if omitted or @code{nil}, it defaults to the selected
@@ -1224,7 +1390,7 @@ the cyclic ordering of windows. @var{window} should be a live window;
if omitted or @code{nil}, it defaults to the selected window.
The optional argument @var{minibuf} specifies whether minibuffer windows
-shall be included in the cyclic ordering. Normally, when @var{minibuf}
+should be included in the cyclic ordering. Normally, when @var{minibuf}
is @code{nil}, a minibuffer window is included only if it is currently
``active''; this matches the behavior of @kbd{C-x o}. (Note that a
minibuffer window is active as long as its minibuffer is in use; see
@@ -1319,31 +1485,37 @@ meaning as for @code{next-window}.
criterion, without selecting it:
@cindex least recently used window
-@defun get-lru-window &optional all-frames dedicated
+@defun get-lru-window &optional all-frames dedicated not-selected
This function returns a live window which is heuristically the ``least
recently used'' window. The optional argument @var{all-frames} has
the same meaning as in @code{next-window}.
If any full-width windows are present, only those windows are
-considered. The selected window is never returned, unless it is the
-only candidate. A minibuffer window is never a candidate. A
-dedicated window (@pxref{Dedicated Windows}) is never a candidate
-unless the optional argument @var{dedicated} is non-@code{nil}.
+considered. A minibuffer window is never a candidate. A dedicated
+window (@pxref{Dedicated Windows}) is never a candidate unless the
+optional argument @var{dedicated} is non-@code{nil}. The selected
+window is never returned, unless it is the only candidate. However, if
+the optional argument @var{not-selected} is non-@code{nil}, this
+function returns @code{nil} in that case.
@end defun
@cindex largest window
-@defun get-largest-window &optional all-frames dedicated
+@defun get-largest-window &optional all-frames dedicated not-selected
This function returns the window with the largest area (height times
-width). A minibuffer window is never a candidate. A dedicated window
+width). The optional argument @var{all-frames} specifies the windows to
+search, and has the same meaning as in @code{next-window}.
+
+A minibuffer window is never a candidate. A dedicated window
(@pxref{Dedicated Windows}) is never a candidate unless the optional
-argument @var{dedicated} is non-@code{nil}.
+argument @var{dedicated} is non-@code{nil}. The selected window is not
+a candidate if the optional argument @var{not-selected} is
+non-@code{nil}. If the optional argument @var{not-selected} is
+non-@code{nil} and the selected window is the only candidate, this
+function returns @code{nil}.
If there are two candidate windows of the same size, this function
prefers the one that comes first in the cyclic ordering of windows,
starting from the selected window.
-
-The optional argument @var{all-frames} specifies the windows to
-search, and has the same meaning as in @code{next-window}.
@end defun
@cindex window that satisfies a predicate
@@ -1361,6 +1533,7 @@ windows to search, and have the same meanings as in
@code{next-window}.
@end defun
+
@node Buffers and Windows
@section Buffers and Windows
@cindex examining windows
@@ -1400,7 +1573,7 @@ When writing an application, you should normally use the higher-level
functions described in @ref{Switching Buffers}, instead of calling
@code{set-window-buffer} directly.
-This function runs @code{window-scroll-functions}, followed by
+This runs @code{window-scroll-functions}, followed by
@code{window-configuration-change-hook}. @xref{Window Hooks}.
@end defun
@@ -1462,28 +1635,30 @@ behave exactly like in @code{get-buffer-window}.
@deffn Command replace-buffer-in-windows &optional buffer-or-name
This command replaces @var{buffer-or-name} with some other buffer, in
-all windows displaying it. @var{buffer-or-name} should be a buffer,
-or the name of an existing buffer; if omitted or @code{nil}, it
-defaults to the current buffer.
+all windows displaying it. @var{buffer-or-name} should be a buffer, or
+the name of an existing buffer; if omitted or @code{nil}, it defaults to
+the current buffer.
The replacement buffer in each window is chosen via
@code{switch-to-prev-buffer} (@pxref{Window History}). Any dedicated
-window displaying @var{buffer-or-name} is deleted (@pxref{Dedicated
-Windows}), unless it is the only window on its frame---if it is the
-only window, and that frame is not the only frame on its terminal, the
-frame is ``dismissed'' by calling the function specified by
-@code{frame-auto-hide-function} (@pxref{Quitting Windows}). If the
-dedicated window is the only window on the only frame on its terminal,
-the buffer is replaced anyway.
+window displaying @var{buffer-or-name} is deleted if possible
+(@pxref{Dedicated Windows}). If such a window is the only window on its
+frame and there are other frames on the same terminal, the frame is
+deleted as well. If the dedicated window is the only window on the only
+frame on its terminal, the buffer is replaced anyway.
@end deffn
+
@node Switching Buffers
@section Switching to a Buffer in a Window
@cindex switching to a buffer
@cindex displaying a buffer
- This section describes high-level functions for switching to a
-specified buffer in some window.
+This section describes high-level functions for switching to a specified
+buffer in some window. In general, ``switching to a buffer'' means to
+(1) show the buffer in some window, (2) make that window the selected
+window (and its frame the selected frame), and (3) make the buffer the
+current buffer.
Do @emph{not} use these functions to make a buffer temporarily
current just so a Lisp program can access or modify it. They have
@@ -1494,12 +1669,10 @@ to make a buffer current to modify it in Lisp, use
@code{set-buffer}. @xref{Current Buffer}.
@deffn Command switch-to-buffer buffer-or-name &optional norecord force-same-window
-This function displays @var{buffer-or-name} in the selected window,
-and makes it the current buffer. (In contrast, @code{set-buffer}
-makes the buffer current but does not display it; @pxref{Current
-Buffer}). It is often used interactively (as the binding of @kbd{C-x
-b}), as well as in Lisp programs. The return value is the buffer
-switched to.
+This command attempts to display @var{buffer-or-name} in the selected
+window and make it the current buffer. It is often used interactively
+(as the binding of @kbd{C-x b}), as well as in Lisp programs. The
+return value is the buffer switched to.
If @var{buffer-or-name} is @code{nil}, it defaults to the buffer
returned by @code{other-buffer} (@pxref{The Buffer List}). If
@@ -1508,27 +1681,47 @@ buffer, this function creates a new buffer with that name; the new
buffer's major mode is determined by the variable @code{major-mode}
(@pxref{Major Modes}).
-Normally the specified buffer is put at the front of the buffer
+Normally, the specified buffer is put at the front of the buffer
list---both the global buffer list and the selected frame's buffer
list (@pxref{The Buffer List}). However, this is not done if the
optional argument @var{norecord} is non-@code{nil}.
-If this function is unable to display the buffer in the selected
-window---usually because the selected window is a minibuffer window or
-is strongly dedicated to its buffer (@pxref{Dedicated Windows})---then
-it normally tries to display the buffer in some other window, in the
-manner of @code{pop-to-buffer} (see below). However, if the optional
-argument @var{force-same-window} is non-@code{nil}, it signals an error
+Sometimes, @code{switch-to-buffer} may be unable to display the buffer
+in the selected window. This happens if the selected window is a
+minibuffer window, or if the selected window is strongly dedicated to
+its buffer (@pxref{Dedicated Windows}). In that case, the command
+normally tries to display the buffer in some other window, by invoking
+@code{pop-to-buffer} (see below). However, if the optional argument
+@var{force-same-window} is non-@code{nil}, it signals an error
instead.
@end deffn
-The next two functions are similar to @code{switch-to-buffer}, except
-for the described features.
+By default, @code{switch-to-buffer} shows the buffer at its position of
+@code{point}. This behavior can be tuned using the following option.
+
+@defopt switch-to-buffer-preserve-window-point
+If this variable is @code{nil}, @code{switch-to-buffer} displays the
+buffer specified by @var{buffer-or-name} at the position of that
+buffer's @code{point}. If this variable is @code{already-displayed}, it
+tries to display the buffer at its previous position in the selected
+window, provided the buffer is currently displayed in some other window
+on any visible or iconified frame. If this variable is @code{t},
+@code{switch-to-buffer} unconditionally tries to display the buffer at
+its previous position in the selected window.
+
+This variable is ignored if the buffer is already displayed in the
+selected window or never appeared in it before, or if
+@code{switch-to-buffer} calls @code{pop-to-buffer} to display the
+buffer.
+@end defopt
+
+The next two commands are similar to @code{switch-to-buffer}, except for
+the described features.
@deffn Command switch-to-buffer-other-window buffer-or-name &optional norecord
-This function makes the buffer specified by @var{buffer-or-name}
-current and displays it in some window other than the selected window.
-It uses the function @code{pop-to-buffer} internally (see below).
+This function displays the buffer specified by @var{buffer-or-name} in
+some window other than the selected window. It uses the function
+@code{pop-to-buffer} internally (see below).
If the selected window already displays the specified buffer, it
continues to do so, but another window is nonetheless found to display
@@ -1539,9 +1732,9 @@ meanings as in @code{switch-to-buffer}.
@end deffn
@deffn Command switch-to-buffer-other-frame buffer-or-name &optional norecord
-This function makes the buffer specified by @var{buffer-or-name}
-current and displays it, usually in a new frame. It uses the function
-@code{pop-to-buffer} (see below).
+This function displays the buffer specified by @var{buffer-or-name} in a
+new frame. It uses the function @code{pop-to-buffer} internally (see
+below).
If the specified buffer is already displayed in another window, in any
frame on the current terminal, this switches to that window instead of
@@ -1559,7 +1752,7 @@ displaying the buffer. Hence, all the variables affecting
@code{display-buffer} will affect it as well. @xref{Choosing Window},
for the documentation of @code{display-buffer}.
-@defun pop-to-buffer buffer-or-name &optional action norecord
+@deffn Command pop-to-buffer buffer-or-name &optional action norecord
This function makes @var{buffer-or-name} the current buffer and
displays it in some window, preferably not the window previously
selected. It then selects the displaying window. If that window is
@@ -1582,7 +1775,8 @@ displayed in the selected window.
Like @code{switch-to-buffer}, this function updates the buffer list
unless @var{norecord} is non-@code{nil}.
-@end defun
+@end deffn
+
@node Choosing Window
@section Choosing a Window for Display
@@ -1635,11 +1829,6 @@ The variable @code{display-buffer-overriding-action}.
The user option @code{display-buffer-alist}.
@item
-A special action for handling @code{special-display-buffer-names} and
-@code{special-display-regexps}, if either of those variables is
-non-@code{nil}. @xref{Choosing Window Options}.
-
-@item
The @var{action} argument.
@item
@@ -1674,10 +1863,14 @@ default value is empty, i.e. @code{(nil . nil)}.
@end defvar
@defopt display-buffer-alist
-The value of this option is an alist mapping regular expressions to
-display actions. If the name of the buffer passed to
-@code{display-buffer} matches a regular expression in this alist, then
-@code{display-buffer} uses the corresponding display action.
+The value of this option is an alist mapping conditions to display
+actions. Each condition may be either a regular expression matching a
+buffer name or a function that takes two arguments - a buffer name and
+the @var{action} argument passed to @code{display-buffer}. If the name
+of the buffer passed to @code{display-buffer} either matches a regular
+expression in this alist or the function specified by a condition
+returns non-@code{nil}, then @code{display-buffer} uses the
+corresponding display action to display the buffer.
@end defopt
@defopt display-buffer-base-action
@@ -1691,6 +1884,7 @@ This display action specifies the fallback behavior for
@code{display-buffer} if no other display actions are given.
@end defvr
+
@node Display Action Functions
@section Action Functions for @code{display-buffer}
@@ -1730,20 +1924,22 @@ A frame means consider windows on that frame only.
@end itemize
If @var{alist} contains no @code{reusable-frames} entry, this function
-normally searches just the selected frame; however, if either the
-variable @code{display-buffer-reuse-frames} or the variable
+normally searches just the selected frame; however, if the variable
@code{pop-up-frames} is non-@code{nil}, it searches all frames on the
current terminal. @xref{Choosing Window Options}.
-If this function chooses a window on another frame, it makes that
-frame visible and raises it if necessary.
+If this function chooses a window on another frame, it makes that frame
+visible and, unless @var{alist} contains an @code{inhibit-switch-frame}
+entry (@pxref{Choosing Window Options}), raises that frame if necessary.
@end defun
@defun display-buffer-pop-up-frame buffer alist
This function creates a new frame, and displays the buffer in that
frame's window. It actually performs the frame creation by calling
the function specified in @code{pop-up-frame-function}
-(@pxref{Choosing Window Options}).
+(@pxref{Choosing Window Options}). If @var{alist} contains a
+@code{pop-up-frame-parameters} entry, the associated value
+is added to the newly created frame's parameters.
@end defun
@defun display-buffer-pop-up-window buffer alist
@@ -1753,9 +1949,72 @@ It actually performs the split by calling the function specified in
@code{split-window-preferred-function} (@pxref{Choosing Window
Options}).
-It can fail if no window splitting can be performed for some reason
-(e.g. if there is just one frame and it has an @code{unsplittable}
-frame parameter; @pxref{Buffer Parameters}).
+The size of the new window can be adjusted by supplying
+@code{window-height} and @code{window-width} entries in @var{alist}. To
+adjust the window's height, use an entry whose @sc{car} is
+@code{window-height} and whose @sc{cdr} is one of:
+
+@itemize @bullet
+@item
+@code{nil} means to leave the height of the new window alone.
+
+@item
+A number specifies the desired height of the new window. An integer
+number specifies the number of lines of the window. A floating point
+number gives the fraction of the window's height with respect to the
+height of the frame's root window.
+
+@item
+If the @sc{cdr} specifies a function, that function is called with one
+argument - the new window. The function is supposed to adjust the
+height of the window; its return value is ignored. Suitable functions
+are @code{shrink-window-if-larger-than-buffer} and
+@code{fit-window-to-buffer}, see @ref{Resizing Windows}.
+@end itemize
+
+To adjust the window's width, use an entry whose @sc{car} is
+@code{window-width} and whose @sc{cdr} is one of:
+
+@itemize @bullet
+@item
+@code{nil} means to leave the width of the new window alone.
+
+@item
+A number specifies the desired width of the new window. An integer
+number specifies the number of columns of the window. A floating point
+number gives the fraction of the window's width with respect to the
+width of the frame's root window.
+
+@item
+If the @sc{cdr} specifies a function, that function is called with one
+argument - the new window. The function is supposed to adjust the width
+of the window; its return value is ignored.
+@end itemize
+
+This function can fail if no window splitting can be performed for some
+reason (e.g. if the selected frame has an @code{unsplittable} frame
+parameter; @pxref{Buffer Parameters}).
+@end defun
+
+@defun display-buffer-below-selected buffer alist
+This function tries to display @var{buffer} in a window below the
+selected window. This means to either split the selected window or use
+the window below the selected one. If it does create a new window, it
+will also adjust its size provided @var{alist} contains a suitable
+@code{window-height} or @code{window-width} entry, see above.
+@end defun
+
+@defun display-buffer-in-previous-window buffer alist
+This function tries to display @var{buffer} in a window previously
+showing it. If @var{alist} has a non-@code{nil}
+@code{inhibit-same-window} entry, the selected window is not eligible
+for reuse. If @var{alist} contains a @code{reusable-frames} entry, its
+value determines which frames to search for a suitable window as with
+@code{display-buffer-reuse-window}.
+
+If @var{alist} has a @code{previous-window} entry, the window
+specified by that entry will override any other window found by the
+methods above, even if that window never showed @var{buffer} before.
@end defun
@defun display-buffer-use-some-window buffer alist
@@ -1764,6 +2023,80 @@ window and displaying the buffer in that window. It can fail if all
windows are dedicated to another buffer (@pxref{Dedicated Windows}).
@end defun
+To illustrate the use of action functions, consider the following
+example.
+
+@example
+@group
+(display-buffer
+ (get-buffer-create "*foo*")
+ '((display-buffer-reuse-window
+ display-buffer-pop-up-window
+ display-buffer-pop-up-frame)
+ (reusable-frames . 0)
+ (window-height . 10) (window-width . 40)))
+@end group
+@end example
+
+@noindent
+Evaluating the form above will cause @code{display-buffer} to proceed as
+follows: If a buffer called *foo* already appears on a visible or
+iconified frame, it will reuse its window. Otherwise, it will try to
+pop up a new window or, if that is impossible, a new frame and show the
+buffer there. If all these steps fail, it will proceed using whatever
+@code{display-buffer-base-action} and
+@code{display-buffer-fallback-action} prescribe.
+
+ Furthermore, @code{display-buffer} will try to adjust a reused window
+(provided *foo* was put by @code{display-buffer} there before) or a
+popped-up window as follows: If the window is part of a vertical
+combination, it will set its height to ten lines. Note that if, instead
+of the number ``10'', we specified the function
+@code{fit-window-to-buffer}, @code{display-buffer} would come up with a
+one-line window to fit the empty buffer. If the window is part of a
+horizontal combination, it sets its width to 40 columns. Whether a new
+window is vertically or horizontally combined depends on the shape of
+the window split and the values of
+@code{split-window-preferred-function}, @code{split-height-threshold}
+and @code{split-width-threshold} (@pxref{Choosing Window Options}).
+
+ Now suppose we combine this call with a preexisting setup for
+`display-buffer-alist' as follows.
+
+@example
+@group
+(let ((display-buffer-alist
+ (cons
+ '("\\*foo\\*"
+ (display-buffer-reuse-window display-buffer-below-selected)
+ (reusable-frames)
+ (window-height . 5))
+ display-buffer-alist)))
+ (display-buffer
+ (get-buffer-create "*foo*")
+ '((display-buffer-reuse-window
+ display-buffer-pop-up-window
+ display-buffer-pop-up-frame)
+ (reusable-frames . 0)
+ (window-height . 10) (window-width . 40))))
+@end group
+@end example
+
+@noindent
+This form will have @code{display-buffer} first try reusing a window
+that shows *foo* on the selected frame. If there's no such window, it
+will try to split the selected window or, if that is impossible, use the
+window below the selected window.
+
+ If there's no window below the selected one, or the window below the
+selected one is dedicated to its buffer, @code{display-buffer} will
+proceed as described in the previous example. Note, however, that when
+it tries to adjust the height of any reused or popped-up window, it will
+in any case try to set its number of lines to ``5'' since that value
+overrides the corresponding specification in the @var{action} argument
+of @code{display-buffer}.
+
+
@node Choosing Window Options
@section Additional Options for Displaying Buffers
@@ -1771,14 +2104,6 @@ The behavior of the standard display actions of @code{display-buffer}
(@pxref{Choosing Window}) can be modified by a variety of user
options.
-@defopt display-buffer-reuse-frames
-If the value of this variable is non-@code{nil}, @code{display-buffer}
-may search all frames on the current terminal when looking for a
-window already displaying the specified buffer. The default is
-@code{nil}. This variable is consulted by the action function
-@code{display-buffer-reuse-window} (@pxref{Display Action Functions}).
-@end defopt
-
@defopt pop-up-windows
If the value of this variable is non-@code{nil}, @code{display-buffer}
is allowed to split an existing window to make a new window for
@@ -1800,20 +2125,20 @@ make a new window for displaying a buffer. It is used by the
the window (@pxref{Display Action Functions}).
The default value is @code{split-window-sensibly}, which is documented
-below. The value must be a function that takes one argument, a
-window, and return either a new window (which is used to display the
+below. The value must be a function that takes one argument, a window,
+and return either a new window (which will be used to display the
desired buffer) or @code{nil} (which means the splitting failed).
@end defopt
@defun split-window-sensibly window
-This function tries to split @code{window}, and return the newly
-created window. If @code{window} cannot be split, it returns
+This function tries to split @var{window}, and return the newly
+created window. If @var{window} cannot be split, it returns
@code{nil}.
This function obeys the usual rules that determine when a window may
be split (@pxref{Splitting Windows}). It first tries to split by
placing the new window below, subject to the restriction imposed by
-@code{split-height-threshold} (see below) in addition to any other
+@code{split-height-threshold} (see below), in addition to any other
restrictions. If that fails, it tries to split by placing the new
window to the right, subject to @code{split-width-threshold} (see
below). If that fails, and the window is the only window on its
@@ -1876,103 +2201,18 @@ Parameters}), which is used by the default function in
@code{nil}.
@end defopt
-@defopt special-display-buffer-names
-A list of buffer names identifying buffers that should be displayed
-specially. If the name of @var{buffer-or-name} is in this list,
-@code{display-buffer} handles the buffer specially. By default, special
-display means to give the buffer a dedicated frame.
-
-If an element is a list, instead of a string, then the @sc{car} of that
-list is the buffer name, and the rest of that list says how to create
-the frame. There are two possibilities for the rest of that list (its
-@sc{cdr}): It can be an alist, specifying frame parameters, or it can
-contain a function and arguments to give to it. (The function's first
-argument is always the buffer to be displayed; the arguments from the
-list come after that.)
-
-For example:
-
-@example
-(("myfile" (minibuffer) (menu-bar-lines . 0)))
-@end example
-
-@noindent
-specifies to display a buffer named @samp{myfile} in a dedicated frame
-with specified @code{minibuffer} and @code{menu-bar-lines} parameters.
-
-The list of frame parameters can also use the phony frame parameters
-@code{same-frame} and @code{same-window}. If the specified frame
-parameters include @code{(same-window . @var{value})} and @var{value}
-is non-@code{nil}, that means to display the buffer in the current
-selected window. Otherwise, if they include @code{(same-frame .
-@var{value})} and @var{value} is non-@code{nil}, that means to display
-the buffer in a new window in the currently selected frame.
-@end defopt
-
-@defopt special-display-regexps
-A list of regular expressions specifying buffers that should be
-displayed specially. If the buffer's name matches any of the regular
-expressions in this list, @code{display-buffer} handles the buffer
-specially. By default, special display means to give the buffer a
-dedicated frame.
-
-If an element is a list, instead of a string, then the @sc{car} of the
-list is the regular expression, and the rest of the list says how to
-create the frame. See @code{special-display-buffer-names} above.
-@end defopt
-
-@defun special-display-p buffer-name
-This function returns non-@code{nil} if displaying a buffer
-named @var{buffer-name} with @code{display-buffer} would
-create a special frame. The value is @code{t} if it would
-use the default frame parameters, or else the specified list
-of frame parameters.
-@end defun
-
-@defopt special-display-function
-This variable holds the function to call to display a buffer specially.
-It receives the buffer as an argument, and should return the window in
-which it is displayed. The default value of this variable is
-@code{special-display-popup-frame}, see below.
-@end defopt
-
-@defun special-display-popup-frame buffer &optional args
-This function tries to make @var{buffer} visible in a frame of its own.
-If @var{buffer} is already displayed in some window, it makes that
-window's frame visible and raises it. Otherwise, it creates a frame
-that is dedicated to @var{buffer}. The return value is the window used
-to display @var{buffer}.
-
-If @var{args} is an alist, it specifies frame parameters for the new
-frame. If @var{args} is a list whose @sc{car} is a symbol, then
-@code{(car @var{args})} is called as a function to actually create and
-set up the frame; it is called with @var{buffer} as first argument, and
-@code{(cdr @var{args})} as additional arguments.
-
-This function always uses an existing window displaying @var{buffer},
-whether or not it is in a frame of its own; but if you set up the above
-variables in your init file, before @var{buffer} was created, then
-presumably the window was previously made by this function.
-@end defun
-
-@defopt special-display-frame-alist
-@anchor{Definition of special-display-frame-alist}
-This variable holds frame parameters for
-@code{special-display-popup-frame} to use when it creates a frame.
-@end defopt
-
@defopt same-window-buffer-names
A list of buffer names for buffers that should be displayed in the
-selected window. If the buffer's name is in this list,
-@code{display-buffer} handles the buffer by switching to it in the
-selected window.
+selected window. If a buffer's name is in this list,
+@code{display-buffer} handles the buffer by showing it in the selected
+window.
@end defopt
@defopt same-window-regexps
A list of regular expressions that specify buffers that should be
displayed in the selected window. If the buffer's name matches any of
the regular expressions in this list, @code{display-buffer} handles the
-buffer by switching to it in the selected window.
+buffer by showing it in the selected window.
@end defopt
@defun same-window-p buffer-name
@@ -1981,39 +2221,27 @@ named @var{buffer-name} with @code{display-buffer} would
put it in the selected window.
@end defun
-@c Emacs 19 feature
-@defopt display-buffer-function
-This variable is the most flexible way to customize the behavior of
-@code{display-buffer}. If it is non-@code{nil}, it should be a function
-that @code{display-buffer} calls to do the work. The function should
-accept two arguments, the first two arguments that @code{display-buffer}
-received. It should choose or create a window, display the specified
-buffer in it, and then return the window.
-
-This variable takes precedence over all the other options described
-above.
-@end defopt
-
@node Window History
@section Window History
@cindex window history
-Each window remembers the buffers it has displayed earlier and the order
-in which these buffers have been removed from it. This history is used,
-for example, by @code{replace-buffer-in-windows} (@pxref{Buffers and
-Windows}). This list is automatically maintained by Emacs, but you can
-use the following functions to explicitly inspect or alter it:
+Each window remembers in a list the buffers it has previously displayed,
+and the order in which these buffers were removed from it. This history
+is used, for example, by @code{replace-buffer-in-windows}
+(@pxref{Buffers and Windows}). The list is automatically maintained by
+Emacs, but you can use the following functions to explicitly inspect or
+alter it:
@defun window-prev-buffers &optional window
This function returns a list specifying the previous contents of
-@var{window}, which should be a live window and defaults to the
-selected window.
+@var{window}. The optional argument @var{window} should be a live
+window and defaults to the selected one.
Each list element has the form @code{(@var{buffer} @var{window-start}
@var{window-pos})}, where @var{buffer} is a buffer previously shown in
the window, @var{window-start} is the window start position when that
buffer was last shown, and @var{window-pos} is the point position when
-that buffer was last shown.
+that buffer was last shown in @var{window}.
The list is ordered so that earlier elements correspond to more
recently-shown buffers, and the first element usually corresponds to the
@@ -2062,31 +2290,45 @@ This command displays the previous buffer in @var{window}. The
argument @var{window} should be a live window or @code{nil} (meaning
the selected window). If the optional argument @var{bury-or-kill} is
non-@code{nil}, this means that the buffer currently shown in
-@var{window} is about to be buried or killed and consequently shall
+@var{window} is about to be buried or killed and consequently should
not be switched to in future invocations of this command.
The previous buffer is usually the buffer shown before the buffer
currently shown in @var{window}. However, a buffer that has been buried
-or killed or has been already shown by a recent invocation of
-@code{switch-to-prev-buffer} does not qualify as previous buffer.
+or killed, or has been already shown by a recent invocation of
+@code{switch-to-prev-buffer}, does not qualify as previous buffer.
If repeated invocations of this command have already shown all buffers
previously shown in @var{window}, further invocations will show buffers
from the buffer list of the frame @var{window} appears on (@pxref{The
-Buffer List}).
+Buffer List}), trying to skip buffers that are already shown in another
+window on that frame.
@end deffn
@deffn Command switch-to-next-buffer &optional window
-This command switches to the next buffer in @var{window} thus undoing
+This command switches to the next buffer in @var{window}, thus undoing
the effect of the last @code{switch-to-prev-buffer} command in
@var{window}. The argument @var{window} must be a live window and
defaults to the selected one.
-If there is no recent invocation of a @code{switch-to-prev-buffer} that
+If there is no recent invocation of @code{switch-to-prev-buffer} that
can be undone, this function tries to show a buffer from the buffer list
of the frame @var{window} appears on (@pxref{The Buffer List}).
@end deffn
+By default @code{switch-to-prev-buffer} and @code{switch-to-next-buffer}
+can switch to a buffer that is already shown in another window on the
+same frame. The following option can be used to override this behavior.
+
+@defopt switch-to-visible-buffer
+If this variable is non-@code{nil}, @code{switch-to-prev-buffer} and
+@code{switch-to-next-buffer} may switch to a buffer that is already
+visible on the same frame, provided the buffer was shown in the relevant
+window before. If it is @code{nil}, @code{switch-to-prev-buffer} and
+@code{switch-to-next-buffer} always try to avoid switching to a buffer
+that is already visible in another window on the same frame.
+@end defopt
+
@node Dedicated Windows
@section Dedicated Windows
@@ -2096,35 +2338,37 @@ Functions for displaying a buffer can be told to not use specific
windows by marking these windows as @dfn{dedicated} to their buffers.
@code{display-buffer} (@pxref{Choosing Window}) never uses a dedicated
window for displaying another buffer in it. @code{get-lru-window} and
-@code{get-largest-window} (@pxref{Selecting Windows}) do not consider
-dedicated windows as candidates when their @var{dedicated} argument is
-non-@code{nil}. The behavior of @code{set-window-buffer}
+@code{get-largest-window} (@pxref{Cyclic Window Ordering}) do not
+consider dedicated windows as candidates when their @var{dedicated}
+argument is non-@code{nil}. The behavior of @code{set-window-buffer}
(@pxref{Buffers and Windows}) with respect to dedicated windows is
slightly different, see below.
-When @code{delete-windows-on} (@pxref{Deleting Windows}) wants to
-delete a dedicated window and that window is the only window on its
-frame, it deletes the window's frame too, provided there are other
-frames left. @code{replace-buffer-in-windows} (@pxref{Switching
-Buffers}) tries to delete all dedicated windows showing its buffer
-argument. When such a window is the only window on its frame, that
-frame is deleted, provided there are other frames left. If there are
-no more frames left, some other buffer is displayed in the window, and
-the window is marked as non-dedicated.
-
-When you kill a buffer (@pxref{Killing Buffers}) displayed in a
-dedicated window, any such window usually gets deleted too, since
-@code{kill-buffer} calls @code{replace-buffer-in-windows} for cleaning
-up windows. Burying a buffer (@pxref{The Buffer List}) deletes the
-selected window if it is dedicated to that buffer. If, however, that
-window is the only window on its frame, @code{bury-buffer} displays
-another buffer in it and iconifies the frame.
+ Functions supposed to remove a buffer from a window or a window from
+a frame can behave specially when a window they operate on is dedicated.
+We will distinguish three basic cases, namely where (1) the window is
+not the only window on its frame, (2) the window is the only window on
+its frame but there are other frames on the same terminal left, and (3)
+the window is the only window on the only frame on the same terminal.
+
+ In particular, @code{delete-windows-on} (@pxref{Deleting Windows})
+handles case (2) by deleting the associated frame and case (3) by
+showing another buffer in that frame's only window. The function
+@code{replace-buffer-in-windows} (@pxref{Buffers and Windows}) which is
+called when a buffer gets killed, deletes the window in case (1) and
+behaves like @code{delete-windows-on} otherwise.
+
+ When @code{bury-buffer} (@pxref{The Buffer List}) operates on the
+selected window (which shows the buffer that shall be buried), it
+handles case (2) by calling @code{frame-auto-hide-function}
+(@pxref{Quitting Windows}) to deal with the selected frame. The other
+two cases are handled as with @code{replace-buffer-in-windows}.
@defun window-dedicated-p &optional window
This function returns non-@code{nil} if @var{window} is dedicated to its
buffer and @code{nil} otherwise. More precisely, the return value is
the value assigned by the last call of @code{set-window-dedicated-p} for
-@var{window} or @code{nil} if that function was never called with
+@var{window}, or @code{nil} if that function was never called with
@var{window} as its argument. The default for @var{window} is the
selected window.
@end defun
@@ -2145,80 +2389,111 @@ non-@code{nil} value.
@node Quitting Windows
@section Quitting Windows
-When you want to get rid of a window used for displaying a buffer you
+When you want to get rid of a window used for displaying a buffer, you
can call @code{delete-window} or @code{delete-windows-on}
(@pxref{Deleting Windows}) to remove that window from its frame. If the
buffer is shown on a separate frame, you might want to call
@code{delete-frame} (@pxref{Deleting Frames}) instead. If, on the other
hand, a window has been reused for displaying the buffer, you might
-prefer showing the buffer previously shown in that window by calling the
+prefer showing the buffer previously shown in that window, by calling the
function @code{switch-to-prev-buffer} (@pxref{Window History}).
Finally, you might want to either bury (@pxref{The Buffer List}) or kill
(@pxref{Killing Buffers}) the window's buffer.
- The following function uses information on how the window for
-displaying the buffer was obtained in the first place thus attempting to
-automatize the above decisions for you.
+ The following command uses information on how the window for
+displaying the buffer was obtained in the first place, thus attempting
+to automate the above decisions for you.
@deffn Command quit-window &optional kill window
This command quits @var{window} and buries its buffer. The argument
@var{window} must be a live window and defaults to the selected one.
With prefix argument @var{kill} non-@code{nil}, it kills the buffer
-instead of burying it.
-
-Quitting @var{window} means to proceed as follows: If @var{window} was
-created specially for displaying its current buffer, delete @var{window}
-provided its frame contains at least one other live window. If
-@var{window} is the only window on its frame and there are other frames
-on the frame's terminal, the value of @var{kill} determines how to
-proceed with the window. If @var{kill} is @code{nil}, the fate of the
-frame is determined by calling @code{frame-auto-hide-function} (see
-below) with that frame as sole argument. If @var{kill} is
-non-@code{nil}, the frame is deleted unconditionally.
-
-If @var{window} was reused for displaying its buffer, this command tries
-to display the buffer previously shown in it. It also tries to restore
-the window start (@pxref{Window Start and End}) and point (@pxref{Window
-Point}) positions of the previously shown buffer. If, in addition, the
-current buffer was temporarily resized, this command will also try to
-restore the original height of @var{window}.
-
-The three cases described so far require that the buffer shown in
-@var{window} is still the buffer displayed by the last buffer display
-function for this window. If another buffer has been shown in the
-meantime or the buffer previously shown no longer exists, this command
-calls @code{switch-to-prev-buffer} (@pxref{Window History}) to show some
-other buffer instead.
+instead of burying it. It calls the function @code{quit-restore-window}
+described next to deal with the window and its buffer.
@end deffn
-The function @code{quit-window} bases its decisions on information
-stored in @var{window}'s @code{quit-restore} window parameter
-(@pxref{Window Parameters}) and resets that parameter to @code{nil}
-after it's done.
+@defun quit-restore-window &optional window bury-or-kill
+This function tries to restore the state of @var{window} that existed
+before its buffer was displayed in it. The optional argument
+@var{window} must be a live window and defaults to the selected one.
+
+If @var{window} was created specially for displaying its buffer, this
+function deletes @var{window} provided its frame contains at least one
+other live window. If @var{window} is the only window on its frame and
+there are other frames on the frame's terminal, the value of the
+optional argument @var{bury-or-kill} determines how to proceed with the
+window. If @var{bury-or-kill} equals @code{kill}, the frame is deleted
+unconditionally. Otherwise, the fate of the frame is determined by
+calling @code{frame-auto-hide-function} (see below) with that frame as
+sole argument.
+
+Otherwise, this function tries to redisplay the buffer previously shown
+in @var{window}. It also tries to restore the window start
+(@pxref{Window Start and End}) and point (@pxref{Window Point})
+positions of the previously shown buffer. If, in addition,
+@var{window}'s buffer was temporarily resized, this function will also
+try to restore the original height of @var{window}.
+
+The cases described so far require that the buffer shown in @var{window}
+is still the buffer displayed by the last buffer display function for
+this window. If another buffer has been shown in the meantime, or the
+buffer previously shown no longer exists, this function calls
+@code{switch-to-prev-buffer} (@pxref{Window History}) to show some other
+buffer instead.
+
+The optional argument @var{bury-or-kill} specifies how to deal with
+@var{window}'s buffer. The following values are handled:
+
+@table @code
+@item nil
+This means to not deal with the buffer in any particular way. As a
+consequence, if @var{window} is not deleted, invoking
+@code{switch-to-prev-buffer} will usually show the buffer again.
+
+@item append
+This means that if @var{window} is not deleted, its buffer is moved to
+the end of @var{window}'s list of previous buffers, so it's less likely
+that a future invocation of @code{switch-to-prev-buffer} will switch to
+it. Also, it moves the buffer to the end of the frame's buffer list.
+
+@item bury
+This means that if @var{window} is not deleted, its buffer is removed
+from @var{window}'s list of previous buffers. Also, it moves the buffer
+to the end of the frame's buffer list. This value provides the most
+reliable remedy to not have @code{switch-to-prev-buffer} switch to this
+buffer again without killing the buffer.
+
+@item kill
+This means to kill @var{window}'s buffer.
+@end table
+
+@code{quit-restore-window} bases its decisions on information stored in
+@var{window}'s @code{quit-restore} window parameter (@pxref{Window
+Parameters}), and resets that parameter to @code{nil} after it's done.
+@end defun
The following option specifies how to deal with a frame containing just
-one window that shall be either quit or whose buffer shall be buried.
+one window that should be either quit, or whose buffer should be buried.
@defopt frame-auto-hide-function
The function specified by this option is called to automatically hide
-frames. This function is called with one argument - a frame.
+frames. This function is called with one argument---a frame.
The function specified here is called by @code{bury-buffer} (@pxref{The
Buffer List}) when the selected window is dedicated and shows the buffer
-that shall be buried. It is also called by @code{quit-window} (see
-above) when the frame of the window that shall be quit has been
-specially created for displaying that window's buffer and the buffer
-shall be buried.
+to bury. It is also called by @code{quit-restore-window} (see above)
+when the frame of the window to quit has been specially created for
+displaying that window's buffer and the buffer is not killed.
The default is to call @code{iconify-frame} (@pxref{Visibility of
-Frames}). Alternatively, you may either specify @code{delete-frame}
+Frames}). Alternatively, you may specify either @code{delete-frame}
(@pxref{Deleting Frames}) to remove the frame from its display,
@code{ignore} to leave the frame unchanged, or any other function that
can take a frame as its sole argument.
-Note that the function specified by this option is called if and only if
-there's at least one other frame on the terminal of the frame it's
-supposed to handle and that frame contains only one live window.
+Note that the function specified by this option is called only if the
+specified frame contains just one live window and there is at least one
+other frame on the same terminal.
@end defopt
@@ -2263,19 +2538,18 @@ For a nonselected window, this is the value point would have (in that
window's buffer) if that window were selected. The default for
@var{window} is the selected window.
-When @var{window} is the selected window and its buffer is also the
-current buffer, the value returned is the same as point in that buffer.
-Strictly speaking, it would be more correct to return the ``top-level''
-value of point, outside of any @code{save-excursion} forms. But that
-value is hard to find.
+When @var{window} is the selected window, the value returned is the
+value of point in that window's buffer. Strictly speaking, it would be
+more correct to return the ``top-level'' value of point, outside of any
+@code{save-excursion} forms. But that value is hard to find.
@end defun
@defun set-window-point window position
This function positions point in @var{window} at position
@var{position} in @var{window}'s buffer. It returns @var{position}.
-If @var{window} is selected, and its buffer is current,
-this simply does @code{goto-char}.
+If @var{window} is selected, this simply does @code{goto-char} in
+@var{window}'s buffer.
@end defun
@defvar window-point-insertion-type
@@ -2308,14 +2582,7 @@ command to a key.
@cindex window top line
This function returns the display-start position of window
@var{window}. If @var{window} is @code{nil}, the selected window is
-used. For example,
-
-@example
-@group
-(window-start)
- @result{} 7058
-@end group
-@end example
+used.
When you create a window, or display a different buffer in it, the
display-start position is set to a display-start position recently used
@@ -2327,9 +2594,6 @@ it explicitly since the previous redisplay)---to make sure point appears
on the screen. Nothing except redisplay automatically changes the
window-start position; if you move point, do not expect the window-start
position to change in response until after the next redisplay.
-
-For a realistic example of using @code{window-start}, see the
-description of @code{count-lines}. @xref{Definition of count-lines}.
@end defun
@cindex window end position
@@ -2503,12 +2767,16 @@ commands move the paper up and down. Thus, if you are looking at the
middle of a buffer and repeatedly call @code{scroll-down}, you will
eventually see the beginning of the buffer.
- Some people have urged that the opposite convention be used: they
+ Unfortunately, this sometimes causes confusion, because some people
+tend to think in terms of the opposite convention: they
imagine the window moving over text that remains in place, so that
``down'' commands take you to the end of the buffer. This convention
is consistent with fact that such a command is bound to a key named
-@key{PageDown} on modern keyboards. We have not switched to this
-convention as that is likely to break existing Emacs Lisp code.
+@key{PageDown} on modern keyboards.
+@ignore
+We have not switched to this convention as that is likely to break
+existing Emacs Lisp code.
+@end ignore
Textual scrolling functions (aside from @code{scroll-other-window})
have unpredictable results if the current buffer is not the one
@@ -2538,13 +2806,8 @@ signals an error. Otherwise, it returns @code{nil}.
This function scrolls backward by @var{count} lines in the selected
window.
-If @var{count} is negative, it scrolls forward instead. If
-@var{count} is omitted or @code{nil}, the distance scrolled is
-@code{next-screen-context-lines} lines less than the height of the
-window's text area.
-
-If the selected window cannot be scrolled any further, this function
-signals an error. Otherwise, it returns @code{nil}.
+If @var{count} is negative, it scrolls forward instead. In other
+respects, it behaves the same way as @code{scroll-up} does.
@end deffn
@deffn Command scroll-up-command &optional count
@@ -2574,8 +2837,8 @@ already displayed, @code{scroll-other-window} displays it in some
window.
When the selected window is the minibuffer, the next window is normally
-the one at the top left corner. You can specify a different window to
-scroll, when the minibuffer is selected, by setting the variable
+the leftmost one immediately above it. You can specify a different
+window to scroll, when the minibuffer is selected, by setting the variable
@code{minibuffer-scroll-window}. This variable has no effect when any
other window is selected. When it is non-@code{nil} and the
minibuffer is selected, it takes precedence over
@@ -2587,7 +2850,7 @@ window is the one at the bottom right corner. In this case,
@code{scroll-other-window} attempts to scroll the minibuffer. If the
minibuffer contains just one line, it has nowhere to scroll to, so the
line reappears after the echo area momentarily displays the message
-@samp{Beginning of buffer}.
+@samp{End of buffer}.
@end deffn
@defvar other-window-scroll-buffer
@@ -2686,12 +2949,12 @@ If @var{count} is a non-negative number, that puts the line containing
point @var{count} lines down from the top of the window. If
@var{count} is a negative number, then it counts upward from the
bottom of the window, so that @minus{}1 stands for the last usable
-line in the window. If @var{count} is a non-@code{nil} list, then it
-stands for the line in the middle of the window.
+line in the window.
-If @var{count} is @code{nil}, @code{recenter} puts the line containing
-point in the middle of the window, then clears and redisplays the entire
-selected frame.
+If @var{count} is @code{nil} (or a non-@code{nil} list),
+@code{recenter} puts the line containing point in the middle of the
+window. If @var{count} is @code{nil}, this function may redraw the
+frame, according to the value of @code{recenter-redisplay}.
When @code{recenter} is called interactively, @var{count} is the raw
prefix argument. Thus, typing @kbd{C-u} as the prefix sets the
@@ -2700,22 +2963,32 @@ prefix argument. Thus, typing @kbd{C-u} as the prefix sets the
top.
With an argument of zero, @code{recenter} positions the current line at
-the top of the window. This action is so handy that some people make a
-separate key binding to do this. For example,
+the top of the window. The command @code{recenter-top-bottom} offers
+a more convenient way to achieve this.
+@end deffn
-@example
-@group
-(defun line-to-top-of-window ()
- "Scroll current line to top of window.
-Replaces three keystroke sequence C-u 0 C-l."
- (interactive)
- (recenter 0))
+@defopt recenter-redisplay
+If this variable is non-@code{nil}, calling @code{recenter} with a
+@code{nil} argument redraws the frame. The default value is
+@code{tty}, which means only redraw the frame if it is a tty frame.
+@end defopt
-(global-set-key [kp-multiply] 'line-to-top-of-window)
-@end group
-@end example
+@deffn Command recenter-top-bottom &optional count
+This command, which is the default binding for @kbd{C-l}, acts like
+@code{recenter}, except if called with no argument. In that case,
+successive calls place point according to the cycling order defined
+by the variable @code{recenter-positions}.
@end deffn
+@defopt recenter-positions
+This variable controls how @code{recenter-top-bottom} behaves when
+called with no argument. The default value is @code{(middle top
+bottom)}, which means that successive calls of
+@code{recenter-top-bottom} with no argument cycle between placing
+point at the middle, top, and bottom of the window.
+@end defopt
+
+
@node Vertical Scrolling
@section Vertical Fractional Scrolling
@cindex vertical fractional scrolling
@@ -2804,8 +3077,8 @@ times the normal character width. How many characters actually
disappear off to the left depends on their width, and could vary from
line to line.
- Because we read from side to side in the ``inner loop,'' and from top
-to bottom in the ``outer loop,'' the effect of horizontal scrolling is
+ Because we read from side to side in the ``inner loop'', and from top
+to bottom in the ``outer loop'', the effect of horizontal scrolling is
not like that of textual or vertical scrolling. Textual scrolling
involves selection of a portion of text to display, and vertical
scrolling moves the window contents contiguously; but horizontal
@@ -2964,8 +3237,8 @@ the bottommost row.
Note that these are the actual outer edges of the window, including
any header line, mode line, scroll bar, fringes, and display margins.
-On a text-only terminal, if the window has a neighbor on its right,
-its right edge includes the separator line between the window and its
+On a text terminal, if the window has a neighbor on its right, its
+right edge includes the separator line between the window and its
neighbor.
@end defun
@@ -3001,7 +3274,7 @@ frame.
@defun coordinates-in-window-p coordinates window
This function checks whether a window @var{window} occupies the
-frame-relative coordinates @var{coordinates}, and if so which part of
+frame-relative coordinates @var{coordinates}, and if so, which part of
the window that is. @var{window} should be a live window.
@var{coordinates} should be a cons cell of the form @code{(@var{x}
. @var{y})}, where @var{x} and @var{y} are frame-relative coordinates.
@@ -3046,8 +3319,8 @@ argument because it always uses the frame that @var{window} is on.
The following functions return window positions in pixels, rather
than character units. Though mostly useful on graphical displays,
-they can also be called on text-only terminals, where the screen area
-of each text character is taken to be ``one pixel''.
+they can also be called on text terminals, where the screen area of
+each text character is taken to be ``one pixel''.
@defun window-pixel-edges &optional window
This function returns a list of pixel coordinates for the edges of
@@ -3099,12 +3372,14 @@ for the current buffer.
You can bring back an entire frame layout by restoring a previously
saved window configuration. If you want to record the layout of all
frames instead of just one, use a frame configuration instead of a
-window configuration; see @ref{Frame Configurations}.
+window configuration. @xref{Frame Configurations}.
@defun current-window-configuration &optional frame
This function returns a new object representing @var{frame}'s current
window configuration. The default for @var{frame} is the selected
-frame.
+frame. The variable @code{window-persistent-parameters} specifies
+which window parameters (if any) are saved by this function.
+@xref{Window Parameters}.
@end defun
@defun set-window-configuration configuration
@@ -3121,9 +3396,9 @@ change and triggers execution of the @code{window-size-change-functions}
know how to tell whether the new configuration actually differs from the
old one.
-If the frame which @var{configuration} was saved from is dead, all this
+If the frame from which @var{configuration} was saved is dead, all this
function does is restore the three variables @code{window-min-height},
-@code{window-min-width} and @code{minibuffer-scroll-window}. In this
+@code{window-min-width} and @code{minibuffer-scroll-window}. In this
case, the function returns @code{nil}. Otherwise, it returns @code{t}.
Here is a way of using this function to get the same effect
@@ -3140,44 +3415,23 @@ as @code{save-window-excursion}:
@end example
@end defun
-@defspec save-window-excursion forms@dots{}
-This special form records the window configuration, executes @var{forms}
-in sequence, then restores the earlier window configuration. The window
-configuration includes, for each window, the value of point and the
-portion of the buffer that is visible. It also includes the choice of
-selected window. However, it does not include the value of point in
-the current buffer; use @code{save-excursion} also, if you wish to
-preserve that.
-
-Don't use this construct when @code{save-selected-window} is sufficient.
+@defmac save-window-excursion forms@dots{}
+This macro records the window configuration of the selected frame,
+executes @var{forms} in sequence, then restores the earlier window
+configuration. The return value is the value of the final form in
+@var{forms}.
-Exit from @code{save-window-excursion} always triggers execution of
-@code{window-size-change-functions}. (It doesn't know how to tell
-whether the restored configuration actually differs from the one in
-effect at the end of the @var{forms}.)
+Most Lisp code should not use this macro; @code{save-selected-window}
+is typically sufficient. In particular, this macro cannot reliably
+prevent the code in @var{forms} from opening new windows, because new
+windows might be opened in other frames (@pxref{Choosing Window}), and
+@code{save-window-excursion} only saves and restores the window
+configuration on the current frame.
-The return value is the value of the final form in @var{forms}.
-For example:
-
-@example
-@group
-(split-window)
- @result{} #<window 25 on control.texi>
-@end group
-@group
-(setq w (selected-window))
- @result{} #<window 19 on control.texi>
-@end group
-@group
-(save-window-excursion
- (delete-other-windows w)
- (switch-to-buffer "foo")
- 'do-something)
- @result{} do-something
- ;; @r{The screen is now split again.}
-@end group
-@end example
-@end defspec
+Do not use this macro in @code{window-size-change-functions}; exiting
+the macro triggers execution of @code{window-size-change-functions},
+leading to an endless loop.
+@end defmac
@defun window-configuration-p object
This function returns @code{t} if @var{object} is a window configuration.
@@ -3206,27 +3460,31 @@ configurations.
The objects returned by @code{current-window-configuration} die
together with the Emacs process. In order to store a window
-configuration on disk and read it back in another Emacs session the
-following two functions can be used.
+configuration on disk and read it back in another Emacs session, you
+can use the functions described next. These functions are also useful
+to clone the state of a frame into an arbitrary live window
+(@code{set-window-configuration} effectively clones the windows of a
+frame into the root window of that very frame only).
-@defun window-state-get &optional window markers
+@defun window-state-get &optional window writable
This function returns the state of @var{window} as a Lisp object. The
-argument @var{window} can be any window and defaults to the root window
-of the selected frame.
+argument @var{window} must be a valid window and defaults to the root
+window of the selected frame.
-The optional argument @var{markers} non-@code{nil} means to use markers
-for sampling positions like @code{window-point} or @code{window-start}.
-This argument should be non-@code{nil} only if the value is used for
-putting the state back in the same session since markers slow down
-processing.
+If the optional argument @var{writable} is non-@code{nil}, this means to
+not use markers for sampling positions like @code{window-point} or
+@code{window-start}. This argument should be non-@code{nil} when the
+state will be written to disk and read back in another session.
+
+Together, the argument @var{writable} and the variable
+@code{window-persistent-parameters} specify which window parameters are
+saved by this function. @xref{Window Parameters}.
@end defun
-The value returned by @code{window-state-get} can be converted by using
-one of the functions defined by Desktop Save Mode (@pxref{Desktop Save
-Mode}) to an object that can be written to a file. Such objects can be
-read back and converted to a Lisp object representing the state of the
-window. That Lisp object can be used as argument for the following
-function in order to restore the state window in another window.
+The value returned by @code{window-state-get} can be used in the same
+session to make a clone of a window in another window. It can be also
+written to disk and read back in another session. In either case, use
+the following function to restore the state of the window.
@defun window-state-put state &optional window ignore
This function puts the window state @var{state} into @var{window}. The
@@ -3235,9 +3493,9 @@ earlier invocation of @code{window-state-get}, see above. The optional
argument @var{window} must specify a live window and defaults to the
selected one.
-The optional argument @var{ignore} non-@code{nil} means to ignore
-minimum window sizes and fixed size restrictions. If @var{ignore}
-equals @code{safe}, this means windows can get as small as one line
+If the optional argument @var{ignore} is non-@code{nil}, it means to ignore
+minimum window sizes and fixed-size restrictions. If @var{ignore}
+is @code{safe}, this means windows can get as small as one line
and/or two columns.
@end defun
@@ -3257,8 +3515,8 @@ setting for @var{parameter}, this function returns @code{nil}.
@defun window-parameters &optional window
This function returns all parameters of @var{window} and their values.
-The default for @var{window} is the selected window. The return value,
-if non-@code{nil} is an association list whose elements have the form
+The default for @var{window} is the selected window. The return value
+is either @code{nil}, or an association list whose elements have the form
@code{(@var{parameter} . @var{value})}.
@end defun
@@ -3268,8 +3526,46 @@ This function sets @var{window}'s value of @var{parameter} to
is the selected window.
@end defun
-Some functions, notably @code{delete-window},
-@code{delete-other-windows} and @code{split-window} may behave specially
+By default, the functions that save and restore window configurations or the
+states of windows (@pxref{Window Configurations}) do not care about
+window parameters. This means that when you change the value of a
+parameter within the body of a @code{save-window-excursion}, the
+previous value is not restored when that macro exits. It also means
+that when you restore via @code{window-state-put} a window state saved
+earlier by @code{window-state-get}, all cloned windows have their
+parameters reset to @code{nil}. The following variable allows you to
+override the standard behavior:
+
+@defvar window-persistent-parameters
+This variable is an alist specifying which parameters get saved by
+@code{current-window-configuration} and @code{window-state-get}, and
+subsequently restored by @code{set-window-configuration} and
+@code{window-state-put}. @xref{Window Configurations}.
+
+The @sc{car} of each entry of this alist is a symbol specifying the
+parameter. The @sc{cdr} should be one of the following:
+
+@table @asis
+@item @code{nil}
+This value means the parameter is saved neither by
+@code{window-state-get} nor by @code{current-window-configuration}.
+
+@item @code{t}
+This value specifies that the parameter is saved by
+@code{current-window-configuration} and (provided its @var{writable}
+argument is @code{nil}) by @code{window-state-get}.
+
+@item @code{writable}
+This means that the parameter is saved unconditionally by both
+@code{current-window-configuration} and @code{window-state-get}. This
+value should not be used for parameters whose values do not have a read
+syntax. Otherwise, invoking @code{window-state-put} in another session
+may fail with an @code{invalid-read-syntax} error.
+@end table
+@end defvar
+
+Some functions (notably @code{delete-window},
+@code{delete-other-windows} and @code{split-window}), may behave specially
when their @var{window} argument has a parameter set. You can override
such special behavior by binding the following variable to a
non-@code{nil} value:
@@ -3277,7 +3573,7 @@ non-@code{nil} value:
@defvar ignore-window-parameters
If this variable is non-@code{nil}, some standard functions do not
process window parameters. The functions currently affected by this are
-@code{split-window}, @code{delete-window}, @code{delete-other-windows}
+@code{split-window}, @code{delete-window}, @code{delete-other-windows},
and @code{other-window}.
An application can bind this variable to a non-@code{nil} value around
@@ -3287,7 +3583,7 @@ windows when exiting that function.
@end defvar
The following parameters are currently used by the window management
-code.
+code:
@table @asis
@item @code{delete-window}
@@ -3309,14 +3605,39 @@ This parameter affects the execution of @code{other-window}
@item @code{no-other-window}
This parameter marks the window as not selectable by @code{other-window}
(@pxref{Cyclic Window Ordering}).
+
+@item @code{clone-of}
+This parameter specifies the window that this one has been cloned
+from. It is installed by @code{window-state-get} (@pxref{Window
+Configurations}).
+
+@item @code{quit-restore}
+This parameter is installed by the buffer display functions
+(@pxref{Choosing Window}) and consulted by @code{quit-restore-window}
+(@pxref{Quitting Windows}). It contains four elements:
+
+The first element is one of the symbols @code{window} - meaning that the
+window has been specially created by @code{display-buffer}, @code{frame}
+- a separate frame has been created, @code{same} - the window has
+displayed the same buffer before, or @code{other} - the window showed
+another buffer before.
+
+The second element is either one of the symbols @code{window} or
+@code{frame}, or a list whose elements are the buffer shown in the
+window before, that buffer's window start and window point positions,
+and the window's height at that time.
+
+The third element is the window selected at the time the parameter was
+created. The function @code{quit-restore-window} tries to reselect that
+window when it deletes the window passed to it as argument.
+
+The fourth element is the buffer whose display caused the creation of
+this parameter. @code{quit-restore-window} deletes the specified window
+only if it still shows that buffer.
@end table
-In addition, the parameters @code{window-atom} and @code{window-side}
-are reserved and should not be used by applications. The
-@code{quit-restore} parameter tells how to proceed with a window when
-the buffer it shows is no more needed. This parameter is installed by
-the buffer display functions (@pxref{Choosing Window}) and consulted by
-the function @code{quit-window} (@pxref{Quitting Windows}).
+There are additional parameters @code{window-atom} and @code{window-side};
+these are reserved and should not be used by applications.
@node Window Hooks
@@ -3338,7 +3659,7 @@ the window also runs these functions.
This variable is not a normal hook, because each function is called with
two arguments: the window, and its new display-start position.
-These functions must be careful in using @code{window-end}
+These functions must take care when using @code{window-end}
(@pxref{Window Start and End}); if you need an up-to-date value, you
must use the @var{update} argument to ensure you get it.
@@ -3363,11 +3684,11 @@ Creating or deleting windows counts as a size change, and therefore
causes these functions to be called. Changing the frame size also
counts, because it changes the sizes of the existing windows.
-It is not a good idea to use @code{save-window-excursion} (@pxref{Window
-Configurations}) in these functions, because that always counts as a
-size change, and it would cause these functions to be called over and
-over. In most cases, @code{save-selected-window} (@pxref{Selecting
-Windows}) is what you need here.
+You may use @code{save-selected-window} in these functions
+(@pxref{Selecting Windows}). However, do not use
+@code{save-window-excursion} (@pxref{Window Configurations}); exiting
+that macro counts as a size change, which would cause these functions
+to be called over and over.
@end defvar
@defvar window-configuration-change-hook
@@ -3376,7 +3697,7 @@ of an existing frame. This includes splitting or deleting windows,
changing the sizes of windows, or displaying a different buffer in a
window.
-The buffer-local part of this hook is run once per each window on the
+The buffer-local part of this hook is run once for each window on the
affected frame, with the relevant window selected and its buffer
current. The global part is run once for the modified frame, with that
frame selected.
diff --git a/doc/man/ChangeLog b/doc/man/ChangeLog
index 758cdde1dea..cc54cd254b5 100644
--- a/doc/man/ChangeLog
+++ b/doc/man/ChangeLog
@@ -1,3 +1,11 @@
+2012-06-03 Glenn Morris <rgm@gnu.org>
+
+ * rcs-checkin.1: Remove.
+
+2012-04-07 Glenn Morris <rgm@gnu.org>
+
+ * emacs.1: Bump version to 24.1.50.
+
2011-11-16 Juanma Barranquero <lekktu@gmail.com>
* etags.1: Fix typo.
@@ -130,11 +138,9 @@
;; Local Variables:
;; coding: utf-8
-;; fill-column: 79
-;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 2007-2011 Free Software Foundation, Inc.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/doc/man/ebrowse.1 b/doc/man/ebrowse.1
index 5afe59d6bc1..84f1ef1dd9b 100644
--- a/doc/man/ebrowse.1
+++ b/doc/man/ebrowse.1
@@ -85,7 +85,7 @@ was written by Gerd Moellmann.
Copyright
.if t \(co
.if n (C)
-2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+2008-2012 Free Software Foundation, Inc.
.PP
Permission is granted to make and distribute verbatim copies of this
document provided the copyright notice and this permission notice are
diff --git a/doc/man/emacs.1 b/doc/man/emacs.1
index 1acdcf5ebd2..46bda023b5a 100644
--- a/doc/man/emacs.1
+++ b/doc/man/emacs.1
@@ -1,5 +1,5 @@
.\" See section COPYING for copyright and redistribution information.
-.TH EMACS 1 "2007 April 13" "GNU Emacs 24.0.92"
+.TH EMACS 1 "2007 April 13" "GNU Emacs 24.3.50"
.
.
.SH NAME
@@ -634,7 +634,7 @@ Everyone will be free to use, copy, study and change the GNU system.
.SH AUTHORS
.I Emacs
was written by Richard Stallman and the Free Software Foundation.
-For detailed credits and acknowledgements, see the GNU Emacs manual.
+For detailed credits and acknowledgments, see the GNU Emacs manual.
.
.
.
@@ -642,9 +642,7 @@ For detailed credits and acknowledgements, see the GNU Emacs manual.
Copyright
.if t \(co
.if n (C)
-1995, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-2009, 2010, 2011
-Free Software Foundation, Inc.
+1995, 1999-2012 Free Software Foundation, Inc.
.PP
Permission is granted to make and distribute verbatim copies of this
document provided the copyright notice and this permission notice are
diff --git a/doc/man/etags.1 b/doc/man/etags.1
index f7ffa112f3c..a1291829665 100644
--- a/doc/man/etags.1
+++ b/doc/man/etags.1
@@ -267,8 +267,7 @@ Stallman.
Copyright
.if t \(co
.if n (C)
-1992, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
-2010, 2011 Free Software Foundation, Inc.
+1992, 1999, 2001-2012 Free Software Foundation, Inc.
.PP
Permission is granted to make and distribute verbatim copies of this
document provided the copyright notice and this permission notice are
diff --git a/doc/man/grep-changelog.1 b/doc/man/grep-changelog.1
index 45a6abfd579..397e6493343 100644
--- a/doc/man/grep-changelog.1
+++ b/doc/man/grep-changelog.1
@@ -62,7 +62,7 @@ Display basic usage information.
Copyright
.if t \(co
.if n (C)
-2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+2008-2012 Free Software Foundation, Inc.
.PP
Permission is granted to make and distribute verbatim copies of this
document provided the copyright notice and this permission notice are
diff --git a/doc/man/rcs-checkin.1 b/doc/man/rcs-checkin.1
deleted file mode 100644
index 545b128b40d..00000000000
--- a/doc/man/rcs-checkin.1
+++ /dev/null
@@ -1,87 +0,0 @@
-.\" See section COPYING for copyright and redistribution information.
-.TH rcs-checkin 1
-.SH NAME
-rcs-checkin \- check files into RCS
-.SH SYNOPSIS
-.B rcs-checkin
-.RI [ FILE .\|.\|.]
-.SH DESCRIPTION
-.B rcs-checkin
-is a helper script for checking files into RCS. This program is
-distributed with
-.BR "GNU Emacs" .
-
-This program converts files with an old
-.BR Emacs -style
-version history for use with the
-.B "Emacs 19"
-version control interface
-.BR VC ,
-which likes to use RCS as its back end.
-
-For each file to be processed, the script looks for
-.B Emacs
-version files related to it. These files are checked in as deltas,
-oldest first, so that the contents of the file itself becomes the
-latest revision in the master.
-
-The first line of each file is used as its description. The file
-itself is not deleted, as under
-.B VC
-with
-.B vc-keep-workfiles
-at its default of
-.BR t ,
-but all the version files are.
-
-If an argument file is already version-controlled under RCS, any
-version files are added to the list of deltas and deleted, and then
-the workfile is checked in again as the latest version. This is
-probably not quite what was wanted, and is the main reason VC doesn't
-simply call this to do checkins.
-
-In order to make it easier to use
-.BR "rcs-checkin *" ,
-files which are detectably either RCS masters (with names ending in
-.BR ,v )
-or Emacs version files (with names containing
-.BR ~ )
-are ignored.
-.
-.PP
-.SH OPTIONS
-The program accepts no options.
-.
-.SH SEE ALSO
-The Emacs version control interface is documented in the GNU Emacs manual,
-which you can read using
-.BR Info ,
-either from Emacs or as a standalone program.
-.
-.SH AUTHORS
-.I rcs-checkin
-was originally written by Paul Eggert. It was revised for use with
-.B "GNU Emacs"
-.B VC
-by Eric S. Raymond.
-.
-.SH COPYING
-Copyright
-.if t \(co
-.if n (C)
-2008, 2009, 2010, 2011 Free Software Foundation, Inc.
-.PP
-Permission is granted to make and distribute verbatim copies of this
-document provided the copyright notice and this permission notice are
-preserved on all copies.
-.PP
-Permission is granted to copy and distribute modified versions of
-this document under the conditions for verbatim copying, provided that
-the entire resulting derived work is distributed under the terms of
-a permission notice identical to this one.
-.PP
-Permission is granted to copy and distribute translations of this
-document into another language, under the above conditions for
-modified versions, except that this permission notice may be stated
-in a translation approved by the Free Software Foundation.
-.
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index dcf816e7fd3..3284e7b92c8 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,1213 @@
+2012-11-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ * doclicense.texi, gpl.texi: Update to latest version from FSF.
+ These are just minor editorial changes.
+
+2012-11-23 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc.texi (Date Formatting Codes): Mention the new beginning of
+ the date numbering system.
+
+2012-11-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * calc.texi: Fix TeX issues with capitals followed by ".", "?", "!".
+ (Date Forms): Correct off-by-one error in explanation of
+ Julian day numbers. Give Gregorian equivalent of its origin.
+
+2012-11-22 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * doc/misc/calc.texi (Date Forms): Mention the customizable
+ Gregorian-Julian switch.
+ (Customizing Calc): Mention the variable `calc-gregorian-switch'.
+
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Calc now uses the Gregorian calendar for all dates (Bug#12633).
+ It also uses January 1, 1 AD as its day number 1.
+ * calc.texi (Date Forms): Document this.
+
+2012-11-16 Glenn Morris <rgm@gnu.org>
+
+ * cl.texi (Function Bindings): Clarify that cl-flet is lexical.
+ (Obsolete Macros): Move example here from Function Bindings.
+
+ * erc.texi: Use @code{nil} rather than just "nil".
+ (Modules): Undocument obsolete "hecomplete".
+ Add "notifications".
+ (Connecting): Add brief section on passwords.
+ (Options): Make a start by adding erc-hide-list, erc-lurker-hide-list.
+
+2012-11-13 Glenn Morris <rgm@gnu.org>
+
+ * flymake.texi (Customizable variables)
+ (Highlighting erroneous lines): Mention flymake-error-bitmap,
+ flymake-warning-bitmap, and flymake-fringe-indicator-position.
+
+2012-11-12 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.texi: Doc for ses-rename-cell, ses-repair-cell-reference-all & ses-range.
+ In all file place SES into @acronym{...}.
+ (Advanced Features): Add key index and function index for
+ ses-set-header-row. Add description for function
+ ses-rename-cell. Add description for function
+ ses-repair-cell-reference-all.
+ (Ranges in formulas): Add description for ses-range flags.
+
+2012-11-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * texinfo.tex: Merge from gnulib.
+
+2012-11-10 Chong Yidong <cyd@gnu.org>
+
+ * url.texi (Introduction): Move url-configuration-directory to
+ Customization node.
+ (Parsed URIs): Split into its own node.
+ (URI Encoding): New node.
+ (Defining New URLs): Remove empty chapter.
+ (Retrieving URLs): Add an introduction. Doc fix for url-retrieve.
+ Improve docs for url-queue-*.
+ (Supported URL Types): Copyedits. Delete empty subnodes.
+
+ * url.texi (Introduction): Rename from Getting Started. Rewrite
+ the introduction.
+ (URI Parsing): Rewrite. Omit the obsolete attributes slot.
+
+2012-11-10 Glenn Morris <rgm@gnu.org>
+
+ * cl.texi (Obsolete Setf Customization):
+ Revert defsetf example to the more correct let rather than prog1.
+ Give define-modify-macro, defsetf, and define-setf-method
+ gv.el replacements.
+
+ * cl.texi (Overview): Mention EIEIO here, as well as the appendix.
+ (Setf Extensions): Remove obsolete reference.
+ (Obsolete Setf Customization):
+ Move note on lack of setf functions to lispref/variables.texi.
+ Undocument get-setf-method, since it no longer exists.
+ Mention simple defsetf replaced by gv-define-simple-setter.
+
+2012-11-03 Glenn Morris <rgm@gnu.org>
+
+ * cl.texi: Further general copyedits.
+ (List Functions): Remove copy-tree, standard elisp for some time.
+ (Efficiency Concerns): Comment out examples that no longer apply.
+ (Compiler Optimizations): Rename from "Optimizing Compiler"; reword.
+ (Creating Symbols, Random Numbers): De-emphasize internal
+ variables cl--gensym-counter and cl--random-state. (Bug#12788)
+ (Naming Conventions, Type Predicates, Macros)
+ (Predicates on Numbers): No longer mention cl-floatp-safe.
+
+2012-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.texi (Mail Source Specifiers):
+ Document :leave keyword used for pop mail source.
+
+2012-11-01 Glenn Morris <rgm@gnu.org>
+
+ * cl.texi: General copyedits for style, line-breaks, etc.
+ (Time of Evaluation, Iteration): Add xref to Emacs Lisp manual.
+ (Macro Bindings, Blocks and Exits):
+ Acknowledge existence of lexical-binding.
+ (Iteration): Mainly defer to doc of standard dolist, dotimes.
+
+2012-10-31 Glenn Morris <rgm@gnu.org>
+
+ * ert.texi (Introduction, The @code{should} Macro):
+ Refer to "cl-assert" rather than "assert".
+
+ * cl.texi (Function Bindings): Update for cl-flet and cl-labels.
+ (Obsolete Lexical Binding): Rename section from "Lexical Bindings".
+ (Obsolete Macros): Rename section from "Obsolete Lexical Macros".
+ Reword, and add details of flet and labels.
+ (Modify Macros, Function Bindings): Add some xrefs.
+
+2012-10-30 Glenn Morris <rgm@gnu.org>
+
+ * cl.texi (Modify Macros): Update for cl-letf changes.
+ (Obsolete Lexical Macros): Say a little more about letf/cl-letf.
+ (Setf Extensions): Partially restore note about cl-getf,
+ mainly moved to lispref/variables.texi.
+ (Property Lists): Fix cl-getf typos.
+ (Mapping over Sequences): Mention cl-mapc naming oddity.
+
+2012-10-29 Glenn Morris <rgm@gnu.org>
+
+ * cl.texi (Organization): More details on cl-lib.el versus cl.el.
+ (Setf Extensions): Remove `apply' setf since it seems to be disabled.
+ (Customizing Setf): Move contents to "Obsolete Setf Customization".
+ (Modify Macros, Multiple Values, Other Clauses):
+ Remove mentions of obsolete features.
+ (Obsolete Setf Customization): Don't mention `apply' setf.
+
+2012-10-28 Glenn Morris <rgm@gnu.org>
+
+ * cl.texi (Multiple Values, Common Lisp Compatibility):
+ More namespace updates.
+ (Obsolete Features): Copyedits.
+ (Obsolete Lexical Macros, Obsolete Setf Customization):
+ New subsections.
+
+ * cl.texi (Porting Common Lisp, Lexical Bindings):
+ Add some xrefs to the Elisp manual.
+
+ * cl.texi (Lexical Bindings): Move to appendix of obsolete features.
+ (Porting Common Lisp): Emacs Lisp can do true lexical binding now.
+ (Obsolete Features): New appendix. Move Lexical Bindings here.
+
+2012-10-27 Glenn Morris <rgm@gnu.org>
+
+ * cl.texi: Use defmac for macros rather than defspec.
+ (Efficiency Concerns): Related copyedit.
+
+ * cl.texi (Control Structure): Update for setf now being in core.
+ (Setf Extensions): Rename from Basic Setf. Move much of the
+ former content to lispref/variables.texi.
+ (Modify Macros): Move pop, push details to lispref/variables.texi.
+ (Customizing Setf): Copyedits for setf etc being in core.
+ (Modify Macros, Efficiency Concerns, Porting Common Lisp):
+ Further namespaces updates.
+
+2012-10-26 Bastien Guerry <bzg@gnu.org>
+
+ * org.texi (Installation): Update the link to Org's ELPA. Also
+ don't mention org-install.el anymore as the replacement file
+ org-loaddefs.el is now loaded by org.el.
+
+2012-10-25 Michael Albinus <michael.albinus@gmx.de>
+
+ * tramp.texi (Frequently Asked Questions): Mention
+ `tramp-completion-reread-directory-timeout' for performance
+ improvement.
+
+2012-10-25 Glenn Morris <rgm@gnu.org>
+
+ * cl.texi: Don't mess with the TeX section number counter.
+ Use Texinfo recommended convention for quotes+punctuation.
+ (Overview, Sequence Functions): Rephrase for better line-breaking.
+ (Time of Evaluation, Type Predicates, Modify Macros, Function Bindings)
+ (Macro Bindings, Conditionals, Iteration, Loop Basics)
+ (Random Numbers, Mapping over Sequences, Structures)
+ (Porting Common Lisp): Further updates for cl-lib namespace.
+ (Modify Macros, Declarations, Macro Bindings, Structures):
+ Break long lines in examples.
+ (Dynamic Bindings): Update for changed progv behavior.
+ (Loop Examples, Efficiency Concerns): Markup fixes.
+ (Structures): Remove TeX margin change.
+ (Declarations): Fix typos.
+
+2012-10-24 Glenn Morris <rgm@gnu.org>
+
+ * cl.texi (Overview, Multiple Values, Creating Symbols)
+ (Numerical Functions): Say less/nothing about the original cl.el.
+ (Old CL Compatibility): Remove.
+ (Assertions): Remove ignore-errors (standard Elisp for some time).
+
+ * cl.texi (Basic Setf, Macros, Declarations, Symbols, Numbers)
+ (Sequences, Lists, Structures, Assertions, Efficiency Concerns)
+ (Efficiency Concerns, Efficiency Concerns)
+ (Common Lisp Compatibility, Old CL Compatibility):
+ Further updates for cl-lib namespace.
+
+2012-10-24 Paul Eggert <eggert@penguin.cs.ucla.edu>
+
+ Update manual for new time stamp format (Bug#12706).
+ * emacs-mime.texi (time-date): Update for new format.
+ Also, fix bogus time stamp and modernize a bit.
+
+2012-10-23 Glenn Morris <rgm@gnu.org>
+
+ * cl.texi: Include emacsver.texi. Use Emacs version number rather
+ than unchanging cl.el version number.
+ End all menu descriptions with a period.
+ Do not use @dfn{CL} for every instance of "CL".
+ (Overview): Remove no-runtime caveat, and note about foo* names.
+ (Usage): Use cl-lib rather than cl.
+ (Organization, Naming Conventions): Update for cl-lib.el.
+ (Installation): Remove long-irrelevant node.
+ (Program Structure, Predicates, Control Structure):
+ Start updating for cl-lib namespace.
+ * Makefile.in ($(buildinfodir)/cl$(INFO_EXT), cl.dvi, cl.pdf):
+ Depend on emacsver.texi.
+
+2012-10-09 Michael Albinus <michael.albinus@gmx.de>
+
+ * trampver.texi: Update release number.
+
+2012-10-06 Glenn Morris <rgm@gnu.org>
+
+ * erc.texi: Include emacsver.texi, and use EMACSVER rather than
+ ERC version.
+ (Introduction): ERC is distributed with Emacs.
+ (Obtaining ERC, Installation): Remove chapters, no longer relevant.
+ (Getting Started): Simplify.
+ (Getting Help and Reporting Bugs): Refer to general Emacs lists.
+ (History): Mention ERC maintained as part of Emacs now.
+ * Makefile.in ($(buildinfodir)/erc$(INFO_EXT), erc.dvi, erc.pdf):
+ Add dependency on emacsver.texi.
+
+ * erc.texi: Remove hand-written node pointers.
+
+2012-10-05 Glenn Morris <rgm@gnu.org>
+
+ * newsticker.texi (Overview, Requirements, Usage, Configuration):
+ Copyedits.
+
+2012-10-01 Eric Ludlam <zappo@gnu.org>
+
+ * ede.texi (Quick Start, Project Local Variables)
+ (Miscellaneous commands, ede-java-root, Development Overview)
+ (Detecting a Project): New nodes.
+ (Simple projects): Node deleted.
+
+ * eieio.texi (Building Classes): Some slot attributes cannot be
+ overridden.
+ (Slot Options): Remove an example.
+ (Method Invocation, Documentation): New nodes.
+
+2012-10-01 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in ($(buildinfodir)/reftex$(INFO_EXT)), reftex.dvi)
+ (reftex.pdf): Add dependency on emacsver.texi.
+ * reftex.texi: Don't include directory part for emacsver.texi;
+ the Makefile's -I handles it.
+
+2012-09-30 Ralf Angeli <angeli@caeruleus.net>
+
+ Merge from standalone RefTeX repository.
+
+ * reftex.texi: Express TeX, LaTeX, AUCTeX, BibTeX and RefTeX
+ with macros.
+ (Imprint): Mention Wolfgang in list of contributors.
+ (Creating Citations): Give a hint about how to
+ auto-revert the BibTeX database file when using external editors.
+ (Referencing Labels): Simplify section about reference macro
+ cycling.
+ (Options (Referencing Labels)): Adapt to new structure of
+ `reftex-ref-style-alist'.
+ (Referencing Labels, Reference Styles): Document changes in the
+ referencing functionality.
+ (Commands): Mention options for definition of header and footer in
+ BibTeX files.
+ (Options (Creating Citations)): Document
+ `reftex-create-bibtex-header' and `reftex-create-bibtex-footer'.
+ (Reference Styles): New section.
+ (varioref (LaTeX package), fancyref (LaTeX package)): Remove.
+ (Options (Referencing Labels)): Remove descriptions of deprecated
+ variables `reftex-vref-is-default' and `reftex-fref-is-default'.
+ Add descriptions for `reftex-ref-style-alist' and
+ `reftex-ref-style-default-list'.
+ (Referencing Labels): Update regarding reference styles.
+ (Citation Styles): Mention support for ConTeXt.
+ (Options (Defining Label Environments)): Fix typo.
+ (Options (Creating Citations)): Document
+ `reftex-cite-key-separator'.
+
+2012-09-30 Achim Gratz <Stromeko@Stromeko.DE>
+
+ * org.texi: Add description of ORG_ADD_CONTRIB to info
+ documentation. Add link to Worg for more details.
+
+ * org.texi: Clarify installation procedure. Provide link to the
+ build system description on Worg.
+
+ * org.texi: Remove reference to utils/, x11idle.c is now in
+ contrib/scripts.
+
+ * org.texi: Re-normalize to "Org mode" in manual.
+
+ * org.texi (Installation): Adapt documentation to new build
+ system. Mention GNU ELPA (since it needs to be handled like Emacs
+ built-in Org).
+
+2012-09-30 Adam Spiers <orgmode@adamspiers.org> (tiny change)
+
+ * org.texi: Fix typo in description of the 'Hooks' section.
+
+ * org.texi: Add ID to the list of special properties.
+
+2012-09-30 Andrew Hyatt <ahyatt@gmail.com> (tiny change)
+
+ * org.texi (Moving subtrees): Document the ability to archive to a
+ datetree.
+
+2012-09-30 Bastien Guerry <bzg@altern.org>
+
+ * org.texi (Installation, Feedback, Batch execution): Use
+ (add-to-list 'load-path ... t) for the contrib dir.
+
+ * org.texi (results): Update documentation for ":results drawer"
+ and ":results org".
+
+ * org.texi (Column width and alignment): Fix typo.
+
+ * org.texi (Activation): Point to the "Conflicts" section.
+
+ * org.texi (Conflicts): Mention filladapt.el in the list of
+ conflicting packages.
+
+ * org.texi (Activation): Adding org-mode to `auto-mode-alist' is
+ not needed for versions of Emacs > 22.1.
+
+ * org.texi (History and Acknowledgments): Fix typo.
+
+ * org.texi (History and Acknowledgments): Add my own
+ acknowledgments.
+
+ * org.texi (Agenda commands): Document the new command and the new
+ option.
+
+ * org.texi (Agenda commands): Delete `org-agenda-action' section.
+ (Agenda commands): Reorder. Document `*' to toggle persistent
+ marks.
+
+ * org.texi (Agenda dispatcher): Mention
+ `org-toggle-agenda-sticky'.
+ (Agenda commands, Exporting Agenda Views): Fix typo.
+
+ * org.texi (Templates in contexts, Setting Options): Update to
+ reflect changes in how contexts options are processed.
+
+ * org.texi (Templates in contexts): Document the new structure of
+ the variables `org-agenda-custom-commands-contexts' and
+ `org-capture-templates-contexts'.
+
+ * org.texi (Templates in contexts): Document the new option
+ `org-capture-templates-contexts'.
+ (Storing searches): Document the new option
+ `org-agenda-custom-commands-contexts'.
+
+ * org.texi (Formula syntax for Lisp): Reformat.
+
+ * org.texi (Special properties, Column attributes)
+ (Agenda column view): Document the new special property
+ CLOCKSUM_T.
+
+ * org.texi (Template expansion): Document the new %l template.
+
+ * org.texi (Fast access to TODO states): Fix documentation about
+ allowed characters for fast todo selection.
+
+ * org.texi (Weekly/daily agenda): Mention APPT_WARNTIME and its
+ use in `org-agenda-to-appt'.
+
+ * org.texi (Comment lines): Update wrt comments.
+
+ * org.texi (Resolving idle time): Document new keybinding.
+
+ * org.texi (Clocking commands): Document the use of S-M-<up/down>
+ on clock timestamps.
+
+ * org.texi (Fast access to TODO states): Explicitely says only
+ letters are supported as fast TODO selection keys.
+
+ * org.texi (Link abbreviations): Illustrate the use of the "%h"
+ specifier. Document the new "%(my-function)" specifier.
+
+ * org.texi (Clocking commands): New cindex.
+ (Clocking commands): Update documentation for `org-clock-in'.
+ Document `org-clock-in-last'. Mention `org-clock-out' and
+ `org-clock-in-last' as commands that can be globally bound.
+ (Resolving idle time): Document continuous clocking.
+
+ * org.texi (Top, Introduction): Fix formatting.
+ (Activation): Add index entries.
+ (Conventions): Update section.
+ (Embedded @LaTeX{}): Fix formatting.
+
+ * org.texi (Visibility cycling): Document `show-children'.
+
+ * org.texi (Using capture): Mention the `org-capture-last-stored'
+ bookmark as a way to jump to the last stored capture.
+
+ * org.texi (Uploading files): Fix typo.
+
+ * org.texi (Using capture): Document `C-0' as a prefix argument
+ for `org-capture'.
+
+ * org.texi (Agenda commands): Document persistent marks.
+
+ * org.texi (Template expansion): Update doc to reflect change.
+
+ * org.texi (Radio tables): Document the :no-escape parameter.
+
+ * org.texi (Repeated tasks): Document repeat cookies for years,
+ months, weeks, days and hours.
+
+ * org.texi (Export options): State that you can use the d: option
+ by specifying a list of drawers.
+
+ * org.texi (HTML preamble and postamble): Small doc improvement.
+
+2012-09-30 Brian van den Broek <vanden@gmail.com> (tiny change)
+
+ * org.texi: The sections in the Exporting section of the manual
+ left out articles in the description of the org-export-as-*
+ commands, among other places. This patch adds them, adds a few
+ missing prepositions, and switches instances of "an HTML" to "a
+ html" for internal consistency.
+
+ * org.texi: Alter several examples of headings with timestamps in
+ them to include the timestamps in the body instead of the heading.
+
+2012-09-30 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.texi (Agenda dispatcher): Document sticky agenda views and
+ the new key for them.
+
+2012-09-30 Charles <millarc@verizon.net> (tiny change)
+
+ * org.texi (Advanced features): Fix error in table.
+
+2012-09-30 Feng Shu <tumashu@gmail.com>
+
+ * org.texi (@LaTeX{} fragments): Document imagemagick as an
+ alternative to dvipng.
+
+2012-09-30 François Allisson <francois@allisson.co> (tiny change)
+
+ * org.texi: Remove extra curly bracket.
+
+2012-09-30 Giovanni Ridolfi <giovanni.ridolfi@yahoo.it> (tiny change)
+
+ * org.texi (org-clock-in-last and org-clock-cancel): Update the
+ defkeys.
+
+2012-09-30 Ippei FURUHASHI <top.tuna+orgmode@gmail.com> (tiny change)
+
+ * org.texi (Agenda commands): Fix two typos by giving
+ corresponding function names, according to
+ `org-agenda-view-mode-dispatch'.
+
+2012-09-30 Jan Bäcker <jan.boecker@jboecker.de>
+
+ * org.texi (The spreadsheet): Fix typo.
+
+2012-09-30 Memnon Anon <gegendosenfleisch@gmail.com> (tiny change)
+
+ * org.texi (Tracking your habits): Point to the "Tracking TODO
+ state changes" section.
+
+2012-09-30 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.texi (Literal examples): Remove reference to unknown
+ `org-export-latex-minted' variable. Also simplify footnote since
+ `org-export-latex-listings' documentation is exhaustive already.
+
+ * org.texi (Plain lists): Remove reference to now hard-coded
+ `bullet' automatic rule.
+
+2012-09-30 Toby S. Cubitt <tsc25@cantab.net>
+
+ * org.texi: Updated documentation accordingly.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ * texinfo.tex: Merge from gnulib.
+
+2012-09-12 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.6.
+
+ * tramp.texi (Bug Reports): Cleanup caches before a test run.
+
+ * trampver.texi: Update release number.
+
+2012-09-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * texinfo.tex: Merge from gnulib.
+
+2012-08-06 Aurélien Aptel <aurelien.aptel@gmail.com>
+
+ * url.texi (Parsed URLs): Adjust to the code's use of defstruct
+ (bug#12096).
+
+2012-08-01 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc.texi (Simplification modes, Conversions)
+ (Operating on Selections): Mention "basic" simplification.
+ (The Calc Mode Line): Mention the mode line display for Basic
+ simplification mode.
+ (Simplify Formulas): Refer to 'algebraic' rather than 'default'
+ simplifications.
+ (Basic Simplifications): Rename from "Limited Simplifications"
+ Replace "limited" by "basic" throughout.
+ (Algebraic Simplifications): Indicate that the algebraic
+ simplifications are done by default.
+ (Unsafe Simplifications): Mention `m E'.
+ (Simplification of Units): Mention `m U'.
+ (Trigonometric/Hyperbolic Functions, Reducing and Mapping)
+ (Kinds of Declarations, Functions for Declarations): Mention
+ "algebraic simplifications" instead of `a s'.
+ (Algebraic Entry): Remove mention of default simplifications.
+
+2012-07-30 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc.texi (Getting Started, Tutorial): Change simulated
+ Calc output to match actual output.
+ (Simplifying Formulas): Mention that algebraic simplification is now
+ the default.
+
+2012-07-28 Eli Zaretskii <eliz@gnu.org>
+
+ * faq.texi (Right-to-left alphabets): Update for Emacs 24.
+ (Bug#12073)
+
+2012-07-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer typical American spelling for "acknowledgment".
+ * calc.texi (History and Acknowledgments): Rename from
+ History and Acknowledgements.
+ * idlwave.texi (Acknowledgments):
+ * ses.texi (Acknowledgments):
+ * woman.texi (Acknowledgments): Rename from Acknowledgements.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rename configure.in to configure.ac (Bug#11603).
+ * ede.texi (Compiler and Linker objects, ede-proj-project)
+ (ede-step-project): Prefer the name configure.ac to configure.in.
+
+2012-07-06 Michael Albinus <michael.albinus@gmx.de>
+
+ * tramp.texi (Multi-hops): Introduce
+ `tramp-restricted-shell-hosts-alist'.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (POP before SMTP): POP-before-SMTP works with all sending
+ methods, so don't mention smtpmail here.
+
+2012-06-26 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * gnus.texi (Picons): Document gnus-picon-properties.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi: Remove mention of compilation, as that's no longer
+ supported.
+
+2012-06-26 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * gnus.texi (Archived Messages): Mention
+ gnus-gcc-pre-body-encode-hook and gnus-gcc-post-body-encode-hook.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Various Summary Stuff):
+ Remove mention of `gnus-propagate-marks'.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi: Remove mentions of nnml/nnfolder/nntp backend marks,
+ which no longer exist.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.texi (Archived Messages):
+ Document gnus-gcc-self-resent-messages.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.texi (Mail Variables):
+ Mention the optional user parameter for X-Message-SMTP-Method.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Posting Styles): Mention X-Message-SMTP-Method.
+
+ * message.texi (Mail Variables): Document X-Message-SMTP-Method.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Key Index): Change encoding to utf-8.
+
+2012-06-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737)
+
+2012-06-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Group Timestamp): Mention where to find documentation for
+ the `gnus-tmp-' variables (bug#11601).
+
+2012-06-11 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.6-pre.
+
+ * tramp.texi (all): Use consequently @command{}, @env{} and @kbd{}
+ where appropriate.
+ (Ad-hoc multi-hops): New section.
+ (Remote processes): New subsection "Running remote processes on
+ Windows hosts".
+ (History): Add remote commands on Windows, and ad-hoc multi-hop
+ methods.
+ (External methods): "ControlPersist" must be set to "no" for the
+ `scpc' method.
+ (Remote processes): Add a note about `auto-revert-tail-mode'.
+ (Frequently Asked Questions): Use "scpx" in combination with
+ "ControlPersist". Reported by Adam Spiers <emacs@adamspiers.org>.
+
+ * trampver.texi: Update release number.
+
+2012-06-10 Chong Yidong <cyd@gnu.org>
+
+ * sc.texi: Remove bogus @ifinfo commands which prevent makeinfo
+ compilation for html-mono.
+
+2012-06-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ * texinfo.tex: Merge from gnulib.
+
+2012-05-29 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * Makefile.in (echo-info): Don't try to install info files named
+ just ".info".
+
+2012-05-28 Glenn Morris <rgm@gnu.org>
+
+ * calc.texi, dired-x.texi: Use @LaTeX rather than La@TeX. (Bug#10910)
+
+ * sc.texi: Nuke hand-written node pointers.
+ Fix top-level menu to match actual node order.
+
+2012-05-27 Glenn Morris <rgm@gnu.org>
+
+ * cl.texi, dired-x.texi: Nuke hand-written node pointers.
+ Some associated fixes, including not messing with chapno in cl.texi.
+
+2012-05-27 Bastien Guerry <bzg@gnu.org>
+
+ * org.texi (Durations and time values): Fix typo.
+
+2012-05-19 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * doc/misc/calc.texi (Basic Operations on Units, Customizing Calc):
+ Mention `calc-ensure-consistent-units'.
+
+2012-05-14 Andreas Schwab <schwab@linux-m68k.org>
+
+ * cc-mode.texi: Avoid space before macro in 4th argument of cross
+ reference commands. (Bug#11461)
+
+ * Makefile.in (gnus.dvi): Use $@ instead of $*.dvi.
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (mostlyclean): Add more TeX intermediates.
+
+ * Makefile.in: Make it look more like the other doc Makefiles.
+ Use explicit $srcdir in all dependencies.
+ Remove cd $srcdir from rules.
+ (VPATH): Remove.
+ (infodir): Set to an absolute path.
+ (INFO_TARGETS): Use short names.
+ (mkinfodir): infodir is now absolute.
+ (echo-info, maintainer-clean): Update for new format of INFO_TARGETS.
+
+ * Makefile.in (info.info): Rename from info, to avoid duplication.
+ (.SUFFIXES): Disable implicit rules.
+
+ * Makefile.in (MKDIR_P): New, set by configure.
+ (mkinfodir): Use $MKDIR_P.
+
+2012-05-07 Glenn Morris <rgm@gnu.org>
+
+ * forms.texi (Long Example): Update for changed location of files.
+
+2012-05-04 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (INFO_EXT, INFO_OPTS): New, set by configure.
+ (INFO_TARGETS): Use $INFO_EXT.
+ Make all rules generating info files use $INFO_EXT, $INFO_OPT, and -o.
+ * makefile.w32-in (INFO_EXT, INFO_OPTS): New.
+ (INFO_TARGETS): Use $INFO_EXT.
+ Make all rules generating info files use $INFO_EXT, $INFO_OPT, and -o.
+
+2012-05-02 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (echo-info): New phony target, used by top-level.
+
+ * viper.texi: Make direntry shorter (also it is no longer "newest").
+
+ * emacs-gnutls.texi, ert.texi, org.texi:
+ Fix dircategory, direntry to match info/dir.
+
+ * faq.texi: Convert @inforefs to @xrefs.
+ Fix some malformed cross-references.
+ (File-name conventions): Shorten section name to avoid overfull line.
+ (How to add fonts): Use smallexample to avoid overfull lines.
+
+2012-05-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * auth.texi (Help for users): Update for .gpg file being second.
+
+2012-04-27 Ippei Furuhashi <top.tuna+orgmode@gmail.com> (tiny change)
+
+ * org.texi (Agenda commands): Fix two typos: give corresponding
+ function names, according to `org-agenda-view-mode-dispatch'.
+
+2012-04-27 Glenn Morris <rgm@gnu.org>
+
+ * faq.texi (Major packages and programs): Remove section.
+ There is no point listing 6 packages (cf etc/MORE.STUFF).
+ (Finding Emacs and related packages): Move "Spell-checkers" here.
+
+2012-04-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbus.texi (Version): New node.
+ (Properties and Annotations): Mention the object manager
+ interface. Describe dbus-get-all-managed-objects.
+ (Type Conversion): Floating point numbers are allowed, if an
+ anteger does not fit Emacs's integer range.
+ (Synchronous Methods): Remove obsolete dbus-call-method-non-blocking.
+ (Asynchronous Methods): Fix description of
+ dbus-call-method-asynchronously.
+ (Receiving Method Calls): Fix some minor errors. Add
+ dbus-interface-emacs.
+ (Signals): Describe unicast signals and the new match rules.
+ (Alternative Buses): Add the PRIVATE optional argument to
+ dbus-init-bus. Describe its new return value. Add dbus-setenv.
+
+2012-04-20 Glenn Morris <rgm@gnu.org>
+
+ * faq.texi (New in Emacs 24): New section.
+ (Packages that do not come with Emacs): Mention M-x list-packages.
+
+2012-04-14 Alan Mackenzie <acm@muc.de>
+
+ * cc-mode.texi (c-offsets-alist): Correct a typo.
+
+2012-04-14 Jérémie Courrèges-Anglas <jca@wxcvbn.org> (tiny change)
+
+ * org.texi (Deadlines and scheduling): Fix the example: the
+ DEADLINE item should come right after the headline. We enforce
+ this convention, so it is a bug not to illustrate it correctly in
+ the manual.
+
+2012-04-14 Ippei FURUHASHI <top.tuna+orgmode@gmail.com> (tiny change)
+
+ * org.texi (Agenda commands): Fix documentation bug by swapping
+ the equivalent keybindings to `org-agenda-next-line' with the ones
+ to `org-agenda-previous-line'.
+
+2012-04-14 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: Replace non-portable use of $< in ordinary rules.
+
+2012-04-09 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (INFO_TARGETS, DVI_TARGETS, clean): Add
+ emacs-gnutls.
+ ($(infodir)/emacs-gnutls, emacs-gnutls.dvi): New targets.
+
+2012-04-09 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * Makefile.in: Add emacs-gnutls.texi to build.
+
+ * emacs-gnutls.texi: Add documentation for the GnuTLS integration.
+
+2012-04-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * auth.texi (Secret Service API): Edit further and give examples.
+ (Secret Service API): Adjust @samp to @code for collection names.
+
+2012-04-04 Glenn Morris <rgm@gnu.org>
+
+ * auth.texi (Secret Service API): Copyedits.
+ (Help for developers): Fill in some missing function doc-strings.
+ (Help for users, Help for developers)
+ (GnuPG and EasyPG Assistant Configuration): Markup fixes.
+
+2012-04-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * auth.texi (Secret Service API): Add the missing text.
+
+2012-04-04 Chong Yidong <cyd@gnu.org>
+
+ * message.texi (Using PGP/MIME): Note that epg is now the default.
+
+ * gnus.texi: Reduce references to obsolete pgg library.
+ (Security): Note that epg is now the default.
+
+ * gnus-faq.texi (FAQ 8-2): Mention EasyPG.
+
+ * nxml-mode.texi (Completion): C-RET is no longer bound to
+ nxml-complete.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org.texi (Customizing tables in ODT export): Correct few errors.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org.texi (Links in ODT export): Update.
+ (Labels and captions in ODT export): New node.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org.texi (Literal examples in ODT export): htmlfontify.el in
+ Emacs-24.1 now supports fontification. So ODT source blocks will
+ be fontified by default.
+
+2012-04-01 Julian Gehring <julian.gehring@googlemail.com> (tiny change)
+
+ * org.texi (Refiling notes): Remove duplicated keybinding.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.texi (noweb): Documentation of this new option to the :noweb
+ header argument.
+
+2012-04-01 Suvayu Ali <fatkasuvayu+linux@gmail.com>
+
+ * org.texi (Header and sectioning): Add example demonstrating how
+ to use "LaTeX_CLASS_OPTIONS".
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.texi (Noweb reference syntax): Describe the ability to
+ execute noweb references in the manual.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.texi (cache): Improve cache documentation when session
+ evaluation is used.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.texi (Plain lists): Document removal.
+
+2012-04-01 Michael Brand <michael.ch.brand@gmail.com>
+
+ * org.texi: Decapitalize file name in references to Calc manual.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.texi (Plain lists): Document removal.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org.texi (Top, OpenDocument Text export)
+ (ODT export commands, Extending ODT export)
+ (Images in ODT export, Tables in ODT export)
+ (Configuring a document converter): Add or Update.
+
+2012-04-01 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.texi (MobileOrg): Change the wording to reflect that the
+ Android Version is no longer just the little brother of the iOS
+ version.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.texi (Key bindings and useful functions): Updated babel key
+ binding documentation in manual.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.texi (noweb): Document new noweb header value.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.texi (noweb-sep): Document new header argument.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.texi (noweb-ref): Documentation of this new custom variable.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.texi (wrap): Update the new :wrap documentation to match the
+ current implementation.
+
+2012-04-01 Thomas Dye <dk@poto.myhome.westell.com>
+
+ * org.texi: Added documentation for :wrap.
+
+2012-04-01 Thomas Dye <dk@poto.myhome.westell.com>
+
+ * org.texi: #+RESULTS now user-configurable.
+
+2012-04-01 Thomas Dye <dk@poto.myhome.westell.com>
+
+ * org.texi: Documented :noweb no-export.
+
+2012-04-01 Thomas Dye <dk@poto.local>
+
+ * org.texi: Edit :noweb no header argument for correctness.
+
+2012-04-01 Bastien Guerry <bzg@altern.org>
+
+ * org.texi (Customization): Update the approximate number of Org
+ variables.
+
+2012-04-01 Thomas Dye <dk@poto.local>
+
+ * org.texi: The :results wrap produces a drawer instead of a
+ begin_results block.
+
+2012-03-22 Peder O. Klingenberg <peder@klingenberg.no> (tiny change)
+
+ * gnus.texi (Archived Messages): Update `gnus-message-archive-group' to
+ reflect the new default.
+
+2012-03-10 Eli Zaretskii <eliz@gnu.org>
+
+ * info.texi (Expert Info): Move the index entry for "Texinfo" from
+ "Getting Started" to this node. (Bug#10450)
+
+2012-03-10 Chong Yidong <cyd@gnu.org>
+
+ * flymake.texi (Example -- Configuring a tool called via make):
+ Mention the Automake COMPILE variable (Bug#8715).
+
+ * info.texi (Getting Started): Add an index entry (Bug#10450).
+
+2012-03-02 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbus.texi (Signals): Known names will be mapped onto unique
+ names, when registering for signals.
+
+2012-02-29 Glenn Morris <rgm@gnu.org>
+
+ * url.texi: Fix quote usage in body text.
+
+ * sem-user.texi, url.texi, woman.texi: Use "" quotes in menus.
+
+ * cl.texi: Use @code{} in menus when appropriate.
+
+2012-02-28 Glenn Morris <rgm@gnu.org>
+
+ * calc.texi, cc-mode.texi, cl.texi, ebrowse.texi, ediff.texi:
+ * eshell.texi, gnus-faq.texi, gnus-news.texi, gnus.texi:
+ * idlwave.texi, info.texi, newsticker.texi, nxml-mode.texi:
+ * org.texi, sc.texi, vip.texi, viper.texi:
+ Standardize possessive apostrophe usage.
+
+2012-02-26 Chong Yidong <cyd@gnu.org>
+
+ * ediff.texi (Quick Help Commands): Add a couple of index entries
+ (Bug#10834).
+
+2012-02-17 Glenn Morris <rgm@gnu.org>
+
+ * gnus.texi (Posting Styles):
+ * remember.texi (Org): Fix cross-refs to other manuals.
+
+2012-02-15 Glenn Morris <rgm@gnu.org>
+
+ * smtpmail.texi (Emacs Speaks SMTP): General update for 24.1.
+ (Encryption): New chapter, split out from previous.
+
+2012-02-13 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Customizing the IMAP Connection): Mention
+ nnimap-record-commands.
+
+2012-02-10 Glenn Morris <rgm@gnu.org>
+
+ * url.texi (Retrieving URLs): Update url-retrieve arguments.
+ Mention url-queue-retrieve.
+
+2012-02-09 Glenn Morris <rgm@gnu.org>
+
+ * sem-user.texi (Semantic mode user commands): Typo fix.
+
+ * info.texi (Create Info buffer): Mention info-display-manual.
+
+2012-02-07 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Mail Source Specifiers): Add a pop3 via an SSH tunnel
+ example (modified from an example by Michael Albinus).
+
+2012-01-30 Philipp Haselwarter <philipp.haselwarter@gmx.de> (tiny change)
+
+ * gnus.texi (Agent Basics): Fix outdated description of
+ `gnus-agent-auto-agentize-methods'.
+
+2012-01-28 Andreas Schwab <schwab@linux-m68k.org>
+
+ * cc-mode.texi: Always @defindex ss.
+ (Config Basics): Fix argument of @itemize.
+ (Macro Backslashes): Add @code around index entry.
+
+2012-01-23 Glenn Morris <rgm@gnu.org>
+
+ * pcl-cvs.texi (About PCL-CVS): Refer to vc-dir rather than vc-dired.
+
+2012-01-19 Eric Hanchrow <eric.hanchrow@gmail.com>
+
+ * tramp.texi (File): Tweak wording for the `scpc' option.
+
+2012-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Group Parameters): Really note precedence.
+
+2012-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Group Parameters): Note precedence.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.texi (Noweb reference syntax): Adding documentation of
+ the `*org-babel-use-quick-and-dirty-noweb-expansion*'
+ variable.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.texi (Plain lists): Split the table to fix the display
+ of items.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.texi (Plain lists): Fix misplaced explanation.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.texi (Plain lists, Agenda files): Add index entries.
+
+2012-01-03 Julian Gehring <julian.gehring@googlemail.com>
+
+ * org.texi: Use "Org mode" instead of alternatives like
+ "Org-mode" or "org-mode".
+
+2012-01-03 Bernt Hansen <bernt@norang.ca>
+
+ * org.texi (Agenda commands): Document
+ `org-clock-report-include-clocking-task'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.texi (Checkboxes): Document the new behavior of `C-u C-c
+ C-c' on checkboxes.
+
+2012-01-03 Julian Gehring <julian.gehring@googlemail.com>
+
+ * org.texi: End sentences with two spaces.
+
+2012-01-03 Michael Brand <michael.ch.brand@gmail.com>
+
+ * org.texi (External links): Document the link types file+sys
+ and file+emacs, slightly narrow used page width.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.texi (colnames): Note that colnames behavior may differ
+ across languages.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.texi (Weekly/daily agenda, Agenda commands): Fix typos.
+
+2012-01-03 Thomas Dye <dk@poto.westell.com>
+
+ * org.texi: Augmented discussion of babel property
+ inheritance. Put footnote outside sentence ending period.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org.texi (eval): Documenting the full range of :eval header
+ argument values.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org.texi (eval): Documentation of the new :eval option.
+
+2012-01-03 Thomas Dye <dk@poto.local>
+
+ * org.texi: Add accumulated properties.
+
+2012-01-03 Thomas Dye <dk@poto.local>
+
+ * org.texi: Documented no spaces in name=assign, another
+ correction to :var table.
+
+2012-01-03 Thomas Dye <dk@poto.local>
+
+ * org.texi: Changed DATA to NAME in Working With Source Code
+ section.
+
+2012-01-03 Tom Dye <tsd@tsdye.com>
+
+ * org.texi: Minor change to :var table.
+
+2012-01-03 Tom Dye <tsd@tsdye.com>
+
+ * org.texi: More changes to :var table (some examples were wrong).
+
+2012-01-03 Tom Dye <tsd@tsdye.com>
+
+ * org.texi: Cleaned up :var table.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.texi (Timestamps, Weekly/daily agenda)
+ (Weekly/daily agenda): Add @cindex for "appointment".
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org.texi (Literal examples): A new link to the template for
+ inserting empty code blocks.
+ (Structure of code blocks): A new link to the template for
+ inserting empty code blocks.
+
+2012-01-03 Rafael Laboissiere <rafael@laboissiere.net> (tiny change)
+
+ * org.texi (External links): Add footnote on how the behavior
+ of the text search in Org files are controled by the variable
+ `org-link-search-must-match-exact-headline'.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org.texi (Buffer-wide header arguments): Update
+ documentation to reflect removal of #+PROPERTIES.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.texi (The clock table): Mention that ACHIVED trees
+ contribute to the clock table.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> (tiny change)
+
+ * org.texi (Conflicts): Better yasnippet config info.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org> (tiny change)
+
+ * org.texi (Selective export): Explicitely mention the default
+ values for `org-export-select-tags',
+ `org-export-exclude-tags'.
+
+2012-01-03 Tom Dye <tsd@tsdye.com>
+
+ * org.texi: Added a line to specify that header arguments are
+ lowercase.
+
+2012-01-03 Tom Dye <tsd@tsdye.com>
+
+ * org.texi: :var requires default value when declared.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.texi (Handling links): Add a note about the
+ `org-link-frame-setup' option.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.texi (Exporting Agenda Views, Extracting agenda
+ information): Fix command line syntax, quote symbol parameter
+ values.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.texi (Exporting Agenda Views): Fix command line syntax.
+
+2011-12-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ * gnus.texi (Mail Source Customization, Mail Back End Variables):
+ Use octal notation for file permissions, which are normally
+ thought of in octal.
+ (Mail Back End Variables): Use more-plausible modes in example.
+
2011-12-20 Alan Mackenzie <acm@muc.de>
* cc-mode.texi: Update version string 5.31 -> 5.32.
@@ -112,7 +1322,7 @@
* mh-e.texi (VERSION, EDITION, UPDATED, UPDATE-MONTH): Update for
release 8.3.
(Preface): Updated support information.
- (From Bill Wohler): Reset text to original version. As a
+ (From Bill Wohler): Reset text to original version. As a
historical quote, the tense should be correct in the time that it
was written.
@@ -129,11 +1339,11 @@
2011-08-15 Suvayu Ali <fatkasuvayu+linux@gmail.com> (tiny change)
- * org.texi (Images in LaTeX export): rewrite.
+ * org.texi (Images in LaTeX export): Rewrite.
2011-08-15 Bastien Guerry <bzg@gnu.org>
- * org.texi (Using the mapping API): mention 'region as a possible
+ * org.texi (Using the mapping API): Mention 'region as a possible
scope for `org-map-entries'.
2011-08-15 Carsten Dominik <carsten.dominik@gmail.com>
@@ -142,7 +1352,7 @@
2011-08-15 Bastien Guerry <bzg@gnu.org>
- * org.texi (Template expansion): order template sequences in the
+ * org.texi (Template expansion): Order template sequences in the
proper order.
2011-08-15 Eric Schulte <schulte.eric@gmail.com>
@@ -156,11 +1366,11 @@
2011-08-15 Achim Gratz <stromeko@nexgo.de>
- * org.texi: document that both CLOCK_INTO_DRAWER and
+ * org.texi: Document that both CLOCK_INTO_DRAWER and
LOG_INTO_DRAWER can be used to override the contents of variable
org-clock-into-drawer (or if unset, org-log-into-drawer).
- * org.texi: replace @xref->@pxref.
+ * org.texi: Replace @xref->@pxref.
2011-08-15 Eric Schulte <schulte.eric@gmail.com>
@@ -184,8 +1394,8 @@
2011-08-15 Eric Schulte <schulte.eric@gmail.com>
- * org.texi (Structure of code blocks): explicitly state that the
- behavior of multiple blocks of the same name is undefined
+ * org.texi (Structure of code blocks): Explicitly state that the
+ behavior of multiple blocks of the same name is undefined.
2011-08-15 Christian Egli <christian.egli@sbszh.ch>
@@ -308,7 +1518,7 @@
2011-08-15 Bastien Guerry <bzg@gnu.org>
- * org.texi (LaTeX and PDF export): add a note about a limitation
+ * org.texi (LaTeX and PDF export): Add a note about a limitation
of the LaTeX export: the org file has to be properly structured.
2011-08-15 Bastien Guerry <bzg@gnu.org>
@@ -552,7 +1762,7 @@
2011-03-19 Antoine Levitt <antoine.levitt@gmail.com>
- * gnus.texi (Listing Groups): Document gnus-group-list-ticked
+ * gnus.texi (Listing Groups): Document gnus-group-list-ticked.
2011-03-17 Jay Belanger <jay.p.belanger@gmail.com>
@@ -1118,7 +2328,7 @@
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
- * org.texi: multi-line header arguments :PROPERTIES: :ID:
+ * org.texi: Multi-line header arguments :PROPERTIES: :ID:
b77c8857-6c76-4ea9-8a61-ddc2648d96c4 :END:.
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
@@ -2477,7 +3687,7 @@
2009-07-29 Jay Belanger <jay.p.belanger@gmail.com>
* calc.texi (Stack Manipulation Commands): Add documentation for
- `calc-transpose-lines'
+ `calc-transpose-lines'.
2009-07-27 Michael Albinus <michael.albinus@gmx.de>
@@ -4058,7 +5268,7 @@
2007-11-07 Michael Albinus <michael.albinus@gmx.de>
* tramp.texi (Overview): Mention also the PuTTY integration under
- Win32. Remove paragraphs about Tramp's experimental status.
+ w32. Remove paragraphs about Tramp's experimental status.
(Frequently Asked Questions): Add code example for highlighting the
mode line.
@@ -8497,7 +9707,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1993-1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in
index 34f136b09ff..ea1e87333bd 100644
--- a/doc/misc/Makefile.in
+++ b/doc/misc/Makefile.in
@@ -1,6 +1,6 @@
#### Makefile for documentation other than the Emacs manual.
-# Copyright (C) 1994, 1996-2011 Free Software Foundation, Inc.
+# Copyright (C) 1994, 1996-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -24,76 +24,31 @@ SHELL = /bin/sh
# set by the configure script's `--srcdir' option.
srcdir=@srcdir@
-# Tell make where to find source files; this is needed for the makefiles.
-# Note the other doc Makefiles do not use VPATH anymore, instead
-# they set infodir to an absolute path. Not doing that here in
-# case INFO_TARGETS gets too long for some feeble shells.
-# (cf src/Makefile.in's passing of $lisp to make-docfile)
-VPATH=@srcdir@
-
## Where the output files go.
-## Note that the setfilename command in the .texi files assumes this.
-infodir=../../info
+buildinfodir = $(srcdir)/../../info
## Directory with emacsver.texi.
## Currently only used by efaq and calc.
emacsdir = $(srcdir)/../emacs
+MKDIR_P = @MKDIR_P@
+
+INFO_EXT=@INFO_EXT@
+# Options used only when making info output.
+INFO_OPTS=@INFO_OPTS@
+
# The makeinfo program is part of the Texinfo distribution.
# Use --force so that it generates output even if there are errors.
MAKEINFO = @MAKEINFO@
MAKEINFO_OPTS = --force -I$(emacsdir)
-# Also add new entries to INFO_FILES in the top-level Makefile.in.
-INFO_TARGETS = \
- $(infodir)/ada-mode \
- $(infodir)/auth \
- $(infodir)/autotype \
- $(infodir)/calc \
- $(infodir)/ccmode \
- $(infodir)/cl \
- $(infodir)/dbus \
- $(infodir)/dired-x \
- $(infodir)/ebrowse \
- $(infodir)/ede \
- $(infodir)/ediff \
- $(infodir)/edt \
- $(infodir)/eieio \
- $(infodir)/emacs-mime \
- $(infodir)/epa \
- $(infodir)/erc \
- $(infodir)/ert \
- $(infodir)/eshell \
- $(infodir)/eudc \
- $(infodir)/efaq \
- $(infodir)/flymake \
- $(infodir)/forms \
- $(infodir)/gnus \
- $(infodir)/idlwave \
- $(infodir)/info \
- $(infodir)/mairix-el \
- $(infodir)/message \
- $(infodir)/mh-e \
- $(infodir)/newsticker \
- $(infodir)/nxml-mode \
- $(infodir)/org \
- $(infodir)/pcl-cvs \
- $(infodir)/pgg \
- $(infodir)/rcirc \
- $(infodir)/remember \
- $(infodir)/reftex \
- $(infodir)/sasl \
- $(infodir)/sc \
- $(infodir)/semantic \
- $(infodir)/ses \
- $(infodir)/sieve \
- $(infodir)/smtpmail \
- $(infodir)/speedbar \
- $(infodir)/tramp \
- $(infodir)/url \
- $(infodir)/vip \
- $(infodir)/viper \
- $(infodir)/widget \
- $(infodir)/woman
+INFO_TARGETS = ada-mode auth autotype calc ccmode cl \
+ dbus dired-x ebrowse ede ediff edt eieio \
+ emacs-mime epa erc ert eshell eudc efaq \
+ flymake forms gnus emacs-gnutls idlwave info.info \
+ mairix-el message mh-e newsticker nxml-mode \
+ org pcl-cvs pgg rcirc remember reftex sasl \
+ sc semantic ses sieve smtpmail speedbar tramp \
+ url vip viper widget woman
DVI_TARGETS = \
ada-mode.dvi \
@@ -119,6 +74,7 @@ DVI_TARGETS = \
flymake.dvi \
forms.dvi \
gnus.dvi \
+ emacs-gnutls.dvi \
idlwave.dvi \
info.dvi \
mairix-el.dvi \
@@ -170,6 +126,7 @@ PDF_TARGETS = \
flymake.pdf \
forms.pdf \
gnus.pdf \
+ emacs-gnutls.pdf \
idlwave.pdf \
info.pdf \
mairix-el.pdf \
@@ -205,12 +162,21 @@ TEXI2PDF = texi2pdf
ENVADD = TEXINPUTS="$(srcdir):$(emacsdir):$(TEXINPUTS)" \
MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)"
-mkinfodir = @cd ${srcdir}; test -d ${infodir} || mkdir ${infodir} || test -d ${infodir}
+mkinfodir = @${MKDIR_P} ${buildinfodir}
-.PHONY: info dvi pdf
+.PHONY: info dvi pdf echo-info
+## Prevent implicit rule triggering for foo.info.
+.SUFFIXES:
+# Default.
info: $(INFO_TARGETS)
+## Used by top-level Makefile.
+## Base file names of output info files.
+echo-info:
+ @echo "$(INFO_TARGETS) " | \
+ sed -e 's|[^ ]*/||g' -e 's/\.info//g' -e "s/ */$(INFO_EXT) /g"
+
# please modify this for all the web manual targets
webhack: clean
$(MAKE) pdf MAKEINFO_OPTS="-DWEBHACKDEVEL $(MAKEINFO_OPTS)"
@@ -219,480 +185,488 @@ dvi: $(DVI_TARGETS)
pdf: $(PDF_TARGETS)
-# Note that all the Info targets build the Info files
-# in srcdir. There is no provision for Info files
-# to exist in the build directory.
+# Note that all the Info targets build the Info files in srcdir.
+# There is no provision for Info files to exist in the build directory.
# In a distribution of Emacs, the Info files should be up to date.
-## "short" target names for convenience, to just rebuild one manual.
-ada-mode : $(infodir)/ada-mode
-$(infodir)/ada-mode: ada-mode.texi
+# Note: "<" is not portable in ordinary make rules.
+
+ada-mode : $(buildinfodir)/ada-mode$(INFO_EXT)
+$(buildinfodir)/ada-mode$(INFO_EXT): ${srcdir}/ada-mode.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ada-mode.texi
ada-mode.dvi: ${srcdir}/ada-mode.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/ada-mode.texi
ada-mode.pdf: ${srcdir}/ada-mode.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/ada-mode.texi
-auth : $(infodir)/auth
-$(infodir)/auth: auth.texi
+auth : $(buildinfodir)/auth$(INFO_EXT)
+$(buildinfodir)/auth$(INFO_EXT): ${srcdir}/auth.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/auth.texi
auth.dvi: ${srcdir}/auth.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/auth.texi
auth.pdf: ${srcdir}/auth.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/auth.texi
-autotype : $(infodir)/autotype
-$(infodir)/autotype: autotype.texi
+autotype : $(buildinfodir)/autotype$(INFO_EXT)
+$(buildinfodir)/autotype$(INFO_EXT): ${srcdir}/autotype.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/autotype.texi
autotype.dvi: ${srcdir}/autotype.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/autotype.texi
autotype.pdf: ${srcdir}/autotype.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/autotype.texi
-calc : $(infodir)/calc
-$(infodir)/calc: calc.texi $(emacsdir)/emacsver.texi
+calc : $(buildinfodir)/calc$(INFO_EXT)
+$(buildinfodir)/calc$(INFO_EXT): ${srcdir}/calc.texi $(emacsdir)/emacsver.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/calc.texi
calc.dvi: ${srcdir}/calc.texi $(emacsdir)/emacsver.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/calc.texi
calc.pdf: ${srcdir}/calc.texi $(emacsdir)/emacsver.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/calc.texi
-ccmode : $(infodir)/ccmode
-$(infodir)/ccmode: cc-mode.texi
+ccmode : $(buildinfodir)/ccmode$(INFO_EXT)
+$(buildinfodir)/ccmode$(INFO_EXT): ${srcdir}/cc-mode.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/cc-mode.texi
cc-mode.dvi: ${srcdir}/cc-mode.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/cc-mode.texi
cc-mode.pdf: ${srcdir}/cc-mode.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/cc-mode.texi
-cl : $(infodir)/cl
-$(infodir)/cl: cl.texi
+cl : $(buildinfodir)/cl$(INFO_EXT)
+$(buildinfodir)/cl$(INFO_EXT): ${srcdir}/cl.texi $(emacsdir)/emacsver.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
-cl.dvi: ${srcdir}/cl.texi
- $(ENVADD) $(TEXI2DVI) $<
-cl.pdf: ${srcdir}/cl.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/cl.texi
+cl.dvi: ${srcdir}/cl.texi $(emacsdir)/emacsver.texi
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/cl.texi
+cl.pdf: ${srcdir}/cl.texi $(emacsdir)/emacsver.texi
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/cl.texi
-dbus : $(infodir)/dbus
-$(infodir)/dbus: dbus.texi
+dbus : $(buildinfodir)/dbus$(INFO_EXT)
+$(buildinfodir)/dbus$(INFO_EXT): ${srcdir}/dbus.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/dbus.texi
dbus.dvi: ${srcdir}/dbus.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/dbus.texi
dbus.pdf: ${srcdir}/dbus.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/dbus.texi
-dired-x : $(infodir)/dired-x
-$(infodir)/dired-x: dired-x.texi $(emacsdir)/emacsver.texi
+dired-x : $(buildinfodir)/dired-x$(INFO_EXT)
+$(buildinfodir)/dired-x$(INFO_EXT): ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/dired-x.texi
dired-x.dvi: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/dired-x.texi
dired-x.pdf: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/dired-x.texi
-ebrowse : $(infodir)/ebrowse
-$(infodir)/ebrowse: ebrowse.texi
+ebrowse : $(buildinfodir)/ebrowse$(INFO_EXT)
+$(buildinfodir)/ebrowse$(INFO_EXT): ${srcdir}/ebrowse.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ebrowse.texi
ebrowse.dvi: ${srcdir}/ebrowse.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/ebrowse.texi
ebrowse.pdf: ${srcdir}/ebrowse.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/ebrowse.texi
-ede : $(infodir)/ede
-$(infodir)/ede: ede.texi
+ede : $(buildinfodir)/ede$(INFO_EXT)
+$(buildinfodir)/ede$(INFO_EXT): ${srcdir}/ede.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ede.texi
ede.dvi: ${srcdir}/ede.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/ede.texi
ede.pdf: ${srcdir}/ede.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/ede.texi
-ediff : $(infodir)/ediff
-$(infodir)/ediff: ediff.texi
+ediff : $(buildinfodir)/ediff$(INFO_EXT)
+$(buildinfodir)/ediff$(INFO_EXT): ${srcdir}/ediff.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ediff.texi
ediff.dvi: ${srcdir}/ediff.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/ediff.texi
ediff.pdf: ${srcdir}/ediff.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/ediff.texi
-edt : $(infodir)/edt
-$(infodir)/edt: edt.texi
+edt : $(buildinfodir)/edt$(INFO_EXT)
+$(buildinfodir)/edt$(INFO_EXT): ${srcdir}/edt.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/edt.texi
edt.dvi: ${srcdir}/edt.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/edt.texi
edt.pdf: ${srcdir}/edt.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/edt.texi
-eieio : $(infodir)/eieio
-$(infodir)/eieio: eieio.texi
+eieio : $(buildinfodir)/eieio$(INFO_EXT)
+$(buildinfodir)/eieio$(INFO_EXT): ${srcdir}/eieio.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eieio.texi
eieio.dvi: ${srcdir}/eieio.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/eieio.texi
eieio.pdf: ${srcdir}/eieio.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/eieio.texi
+
+emacs-gnutls : $(buildinfodir)/emacs-gnutls$(INFO_EXT)
+$(buildinfodir)/emacs-gnutls$(INFO_EXT): ${srcdir}/emacs-gnutls.texi
+ $(mkinfodir)
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/emacs-gnutls.texi
+emacs-gnutls.dvi: ${srcdir}/emacs-gnutls.texi
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-gnutls.texi
+emacs-gnutls.pdf: ${srcdir}/emacs-gnutls.texi
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-gnutls.texi
-emacs-mime : $(infodir)/emacs-mime
-$(infodir)/emacs-mime: emacs-mime.texi
+emacs-mime : $(buildinfodir)/emacs-mime$(INFO_EXT)
+$(buildinfodir)/emacs-mime$(INFO_EXT): ${srcdir}/emacs-mime.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) --enable-encoding $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) --enable-encoding -o $@ ${srcdir}/emacs-mime.texi
emacs-mime.dvi: ${srcdir}/emacs-mime.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-mime.texi
emacs-mime.pdf: ${srcdir}/emacs-mime.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-mime.texi
-epa : $(infodir)/epa
-$(infodir)/epa: epa.texi
+epa : $(buildinfodir)/epa$(INFO_EXT)
+$(buildinfodir)/epa$(INFO_EXT): ${srcdir}/epa.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/epa.texi
epa.dvi: ${srcdir}/epa.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/epa.texi
epa.pdf: ${srcdir}/epa.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/epa.texi
-erc : $(infodir)/erc
-$(infodir)/erc: erc.texi
+erc : $(buildinfodir)/erc$(INFO_EXT)
+$(buildinfodir)/erc$(INFO_EXT): ${srcdir}/erc.texi $(emacsdir)/emacsver.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
-erc.dvi: ${srcdir}/erc.texi
- $(ENVADD) $(TEXI2DVI) $<
-erc.pdf: ${srcdir}/erc.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/erc.texi
+erc.dvi: ${srcdir}/erc.texi $(emacsdir)/emacsver.texi
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/erc.texi
+erc.pdf: ${srcdir}/erc.texi $(emacsdir)/emacsver.texi
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/erc.texi
-ert : $(infodir)/ert
-$(infodir)/ert: ert.texi
+ert : $(buildinfodir)/ert$(INFO_EXT)
+$(buildinfodir)/ert$(INFO_EXT): ${srcdir}/ert.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ert.texi
ert.dvi: ${srcdir}/ert.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/ert.texi
ert.pdf: ${srcdir}/ert.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/ert.texi
-eshell : $(infodir)/eshell
-$(infodir)/eshell: eshell.texi
+eshell : $(buildinfodir)/eshell$(INFO_EXT)
+$(buildinfodir)/eshell$(INFO_EXT): ${srcdir}/eshell.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eshell.texi
eshell.dvi: ${srcdir}/eshell.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/eshell.texi
eshell.pdf: ${srcdir}/eshell.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/eshell.texi
-eudc : $(infodir)/eudc
-$(infodir)/eudc: eudc.texi
+eudc : $(buildinfodir)/eudc$(INFO_EXT)
+$(buildinfodir)/eudc$(INFO_EXT): ${srcdir}/eudc.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eudc.texi
eudc.dvi: ${srcdir}/eudc.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/eudc.texi
eudc.pdf: ${srcdir}/eudc.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/eudc.texi
-efaq : $(infodir)/efaq
-$(infodir)/efaq: faq.texi $(emacsdir)/emacsver.texi
+efaq : $(buildinfodir)/efaq$(INFO_EXT)
+$(buildinfodir)/efaq$(INFO_EXT): ${srcdir}/faq.texi $(emacsdir)/emacsver.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/faq.texi
faq.dvi: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/faq.texi
faq.pdf: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/faq.texi
## This is the name used on the Emacs web-page.
## sed fixes up links to point to split version of the manual.
emacs-faq.html: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi
$(MAKEINFO) $(MAKEINFO_OPTS) --no-split \
- --css-ref='/layout.css' --html -o $@ $<
+ --css-ref='/layout.css' --html -o $@ ${srcdir}/faq.texi
sed -i -e 's|a href="\([a-z]*\)\.html#\([^"]*\)"|a href="manual/html_node/\1/\2.html"|g' \
-e 's|/Top\.html|/|g' $@
emacs-faq.text: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) --plaintext -o $@ $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) --plaintext -o $@ ${srcdir}/faq.texi
-flymake : $(infodir)/flymake
-$(infodir)/flymake: flymake.texi
+flymake : $(buildinfodir)/flymake$(INFO_EXT)
+$(buildinfodir)/flymake$(INFO_EXT): ${srcdir}/flymake.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/flymake.texi
flymake.dvi: ${srcdir}/flymake.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/flymake.texi
flymake.pdf: ${srcdir}/flymake.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/flymake.texi
-forms : $(infodir)/forms
-$(infodir)/forms: forms.texi
+forms : $(buildinfodir)/forms$(INFO_EXT)
+$(buildinfodir)/forms$(INFO_EXT): ${srcdir}/forms.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/forms.texi
forms.dvi: ${srcdir}/forms.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/forms.texi
forms.pdf: ${srcdir}/forms.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/forms.texi
# gnus/message/emacs-mime/sieve/pgg are part of Gnus:
-gnus : $(infodir)/gnus
-$(infodir)/gnus: gnus.texi gnus-faq.texi
+gnus : $(buildinfodir)/gnus$(INFO_EXT)
+$(buildinfodir)/gnus$(INFO_EXT): ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
-gnus.dvi: ${srcdir}/gnus.texi gnus-faq.texi
- sed -e '/@iflatex/,/@end iflatex/d' $< > gnustmp.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/gnus.texi
+gnus.dvi: ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi
+ sed -e '/@iflatex/,/@end iflatex/d' ${srcdir}/gnus.texi > gnustmp.texi
$(ENVADD) $(TEXI2DVI) gnustmp.texi
- cp gnustmp.dvi $*.dvi
+ cp gnustmp.dvi $@
rm gnustmp.*
-gnus.pdf: ${srcdir}/gnus.texi gnus-faq.texi
- sed -e '/@iflatex/,/@end iflatex/d' $< > gnustmp.texi
+gnus.pdf: ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi
+ sed -e '/@iflatex/,/@end iflatex/d' ${srcdir}/gnus.texi > gnustmp.texi
$(ENVADD) $(TEXI2PDF) gnustmp.texi
cp gnustmp.pdf $@
rm gnustmp.*
-# This is produced with --no-split to avoid making files whose
-# names clash on DOS 8+3 filesystems
-idlwave : $(infodir)/idlwave
-$(infodir)/idlwave: idlwave.texi
+# NB this one needs --no-split even without a .info extension.
+idlwave : $(buildinfodir)/idlwave$(INFO_EXT)
+$(buildinfodir)/idlwave$(INFO_EXT): ${srcdir}/idlwave.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) --no-split $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/idlwave.texi
idlwave.dvi: ${srcdir}/idlwave.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/idlwave.texi
idlwave.pdf: ${srcdir}/idlwave.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/idlwave.texi
-# The following target uses an explicit -o switch to work around
-# the @setfilename directive in info.texi, which is required for
-# the Texinfo distribution.
-###info : $(infodir)/info # circular!
-$(infodir)/info: info.texi
+# NB this one needs --no-split even without a .info extension.
+# Avoid name clash with overall "info" target.
+info.info : $(buildinfodir)/info$(INFO_EXT)
+$(buildinfodir)/info$(INFO_EXT): ${srcdir}/info.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) --no-split $< -o $@
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/info.texi
info.dvi: ${srcdir}/info.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/info.texi
info.pdf: ${srcdir}/info.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/info.texi
-mairix-el : $(infodir)/mairix-el
-$(infodir)/mairix-el: mairix-el.texi
+mairix-el : $(buildinfodir)/mairix-el$(INFO_EXT)
+$(buildinfodir)/mairix-el$(INFO_EXT): ${srcdir}/mairix-el.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/mairix-el.texi
mairix-el.dvi: ${srcdir}/mairix-el.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/mairix-el.texi
mairix-el.pdf: ${srcdir}/mairix-el.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/mairix-el.texi
-message : $(infodir)/message
-$(infodir)/message: message.texi
+message : $(buildinfodir)/message$(INFO_EXT)
+$(buildinfodir)/message$(INFO_EXT): ${srcdir}/message.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/message.texi
message.dvi: ${srcdir}/message.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/message.texi
message.pdf: ${srcdir}/message.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/message.texi
-mh-e : $(infodir)/mh-e
-$(infodir)/mh-e: mh-e.texi
+mh-e : $(buildinfodir)/mh-e$(INFO_EXT)
+$(buildinfodir)/mh-e$(INFO_EXT): ${srcdir}/mh-e.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/mh-e.texi
mh-e.dvi: ${srcdir}/mh-e.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/mh-e.texi
mh-e.pdf: ${srcdir}/mh-e.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/mh-e.texi
-newsticker : $(infodir)/newsticker
-$(infodir)/newsticker: newsticker.texi
+newsticker : $(buildinfodir)/newsticker$(INFO_EXT)
+$(buildinfodir)/newsticker$(INFO_EXT): ${srcdir}/newsticker.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/newsticker.texi
newsticker.dvi: ${srcdir}/newsticker.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/newsticker.texi
newsticker.pdf: ${srcdir}/newsticker.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/newsticker.texi
-nxml-mode : $(infodir)/nxml-mode
-$(infodir)/nxml-mode: nxml-mode.texi
+nxml-mode : $(buildinfodir)/nxml-mode$(INFO_EXT)
+$(buildinfodir)/nxml-mode$(INFO_EXT): ${srcdir}/nxml-mode.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/nxml-mode.texi
nxml-mode.dvi: ${srcdir}/nxml-mode.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/nxml-mode.texi
nxml-mode.pdf: ${srcdir}/nxml-mode.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/nxml-mode.texi
-org : $(infodir)/org
-$(infodir)/org: org.texi
+org : $(buildinfodir)/org$(INFO_EXT)
+$(buildinfodir)/org$(INFO_EXT): ${srcdir}/org.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/org.texi
org.dvi: ${srcdir}/org.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/org.texi
org.pdf: ${srcdir}/org.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/org.texi
-pcl-cvs : $(infodir)/pcl-cvs
-$(infodir)/pcl-cvs: pcl-cvs.texi
+pcl-cvs : $(buildinfodir)/pcl-cvs$(INFO_EXT)
+$(buildinfodir)/pcl-cvs$(INFO_EXT): ${srcdir}/pcl-cvs.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/pcl-cvs.texi
pcl-cvs.dvi: ${srcdir}/pcl-cvs.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/pcl-cvs.texi
pcl-cvs.pdf: ${srcdir}/pcl-cvs.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/pcl-cvs.texi
-pgg : $(infodir)/pgg
-$(infodir)/pgg: pgg.texi
+pgg : $(buildinfodir)/pgg$(INFO_EXT)
+$(buildinfodir)/pgg$(INFO_EXT): ${srcdir}/pgg.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/pgg.texi
pgg.dvi: ${srcdir}/pgg.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/pgg.texi
pgg.pdf: ${srcdir}/pgg.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/pgg.texi
-rcirc : $(infodir)/rcirc
-$(infodir)/rcirc: rcirc.texi
+rcirc : $(buildinfodir)/rcirc$(INFO_EXT)
+$(buildinfodir)/rcirc$(INFO_EXT): ${srcdir}/rcirc.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/rcirc.texi
rcirc.dvi: ${srcdir}/rcirc.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/rcirc.texi
rcirc.pdf: ${srcdir}/rcirc.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/rcirc.texi
-reftex : $(infodir)/reftex
-$(infodir)/reftex: reftex.texi
+reftex : $(buildinfodir)/reftex$(INFO_EXT)
+$(buildinfodir)/reftex$(INFO_EXT): ${srcdir}/reftex.texi $(emacsdir)/emacsver.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
-reftex.dvi: ${srcdir}/reftex.texi
- $(ENVADD) $(TEXI2DVI) $<
-reftex.pdf: ${srcdir}/reftex.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/reftex.texi
+reftex.dvi: ${srcdir}/reftex.texi $(emacsdir)/emacsver.texi
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/reftex.texi
+reftex.pdf: ${srcdir}/reftex.texi $(emacsdir)/emacsver.texi
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/reftex.texi
-remember : $(infodir)/remember
-$(infodir)/remember: remember.texi
+remember : $(buildinfodir)/remember$(INFO_EXT)
+$(buildinfodir)/remember$(INFO_EXT): ${srcdir}/remember.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/remember.texi
remember.dvi: ${srcdir}/remember.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/remember.texi
remember.pdf: ${srcdir}/remember.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/remember.texi
-sasl : $(infodir)/sasl
-$(infodir)/sasl: sasl.texi
+sasl : $(buildinfodir)/sasl$(INFO_EXT)
+$(buildinfodir)/sasl$(INFO_EXT): ${srcdir}/sasl.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/sasl.texi
sasl.dvi: ${srcdir}/sasl.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/sasl.texi
sasl.pdf: ${srcdir}/sasl.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/sasl.texi
-sc : $(infodir)/sc
-$(infodir)/sc: sc.texi
+sc : $(buildinfodir)/sc$(INFO_EXT)
+$(buildinfodir)/sc$(INFO_EXT): ${srcdir}/sc.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/sc.texi
sc.dvi: ${srcdir}/sc.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/sc.texi
sc.pdf: ${srcdir}/sc.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/sc.texi
-semantic : $(infodir)/semantic
-$(infodir)/semantic: semantic.texi sem-user.texi
+semantic : $(buildinfodir)/semantic$(INFO_EXT)
+$(buildinfodir)/semantic$(INFO_EXT): ${srcdir}/semantic.texi ${srcdir}/sem-user.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
-semantic.dvi: ${srcdir}/semantic.texi sem-user.texi
- $(ENVADD) $(TEXI2DVI) $<
-semantic.pdf: ${srcdir}/semantic.texi sem-user.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/semantic.texi
+semantic.dvi: ${srcdir}/semantic.texi ${srcdir}/sem-user.texi
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/semantic.texi
+semantic.pdf: ${srcdir}/semantic.texi ${srcdir}/sem-user.texi
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/semantic.texi
-ses : $(infodir)/ses
-$(infodir)/ses: ses.texi
+ses : $(buildinfodir)/ses$(INFO_EXT)
+$(buildinfodir)/ses$(INFO_EXT): ${srcdir}/ses.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ses.texi
ses.dvi: ${srcdir}/ses.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/ses.texi
ses.pdf: ${srcdir}/ses.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/ses.texi
-sieve : $(infodir)/sieve
-$(infodir)/sieve: sieve.texi
+sieve : $(buildinfodir)/sieve$(INFO_EXT)
+$(buildinfodir)/sieve$(INFO_EXT): ${srcdir}/sieve.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/sieve.texi
sieve.dvi: ${srcdir}/sieve.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/sieve.texi
sieve.pdf: ${srcdir}/sieve.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/sieve.texi
-smtpmail : $(infodir)/smtpmail
-$(infodir)/smtpmail: smtpmail.texi
+smtpmail : $(buildinfodir)/smtpmail$(INFO_EXT)
+$(buildinfodir)/smtpmail$(INFO_EXT): ${srcdir}/smtpmail.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/smtpmail.texi
smtpmail.dvi: ${srcdir}/smtpmail.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/smtpmail.texi
smtpmail.pdf: ${srcdir}/smtpmail.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/smtpmail.texi
-speedbar : $(infodir)/speedbar
-$(infodir)/speedbar: speedbar.texi
+speedbar : $(buildinfodir)/speedbar$(INFO_EXT)
+$(buildinfodir)/speedbar$(INFO_EXT): ${srcdir}/speedbar.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/speedbar.texi
speedbar.dvi: ${srcdir}/speedbar.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/speedbar.texi
speedbar.pdf: ${srcdir}/speedbar.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/speedbar.texi
-tramp : $(infodir)/tramp
-$(infodir)/tramp: tramp.texi trampver.texi
+tramp : $(buildinfodir)/tramp$(INFO_EXT)
+$(buildinfodir)/tramp$(INFO_EXT): ${srcdir}/tramp.texi ${srcdir}/trampver.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) -D emacs $<
-tramp.dvi: ${srcdir}/tramp.texi trampver.texi
- $(ENVADD) $(TEXI2DVI) $<
-tramp.pdf: ${srcdir}/tramp.texi trampver.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ -D emacs ${srcdir}/tramp.texi
+tramp.dvi: ${srcdir}/tramp.texi ${srcdir}/trampver.texi
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/tramp.texi
+tramp.pdf: ${srcdir}/tramp.texi ${srcdir}/trampver.texi
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/tramp.texi
-url : $(infodir)/url
-$(infodir)/url: url.texi
+url : $(buildinfodir)/url$(INFO_EXT)
+$(buildinfodir)/url$(INFO_EXT): ${srcdir}/url.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/url.texi
url.dvi: ${srcdir}/url.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/url.texi
url.pdf: ${srcdir}/url.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/url.texi
-vip : $(infodir)/vip
-$(infodir)/vip: vip.texi
+vip : $(buildinfodir)/vip$(INFO_EXT)
+$(buildinfodir)/vip$(INFO_EXT): ${srcdir}/vip.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/vip.texi
vip.dvi: ${srcdir}/vip.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/vip.texi
vip.pdf: ${srcdir}/vip.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/vip.texi
-viper : $(infodir)/viper
-$(infodir)/viper: viper.texi
+viper : $(buildinfodir)/viper$(INFO_EXT)
+$(buildinfodir)/viper$(INFO_EXT): ${srcdir}/viper.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/viper.texi
viper.dvi: ${srcdir}/viper.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/viper.texi
viper.pdf: ${srcdir}/viper.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/viper.texi
-widget : $(infodir)/widget
-$(infodir)/widget: widget.texi
+widget : $(buildinfodir)/widget$(INFO_EXT)
+$(buildinfodir)/widget$(INFO_EXT): ${srcdir}/widget.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/widget.texi
widget.dvi: ${srcdir}/widget.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/widget.texi
widget.pdf: ${srcdir}/widget.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/widget.texi
-woman : $(infodir)/woman
-$(infodir)/woman: woman.texi
+woman : $(buildinfodir)/woman$(INFO_EXT)
+$(buildinfodir)/woman$(INFO_EXT): ${srcdir}/woman.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $<
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/woman.texi
woman.dvi: ${srcdir}/woman.texi
- $(ENVADD) $(TEXI2DVI) $<
+ $(ENVADD) $(TEXI2DVI) ${srcdir}/woman.texi
woman.pdf: ${srcdir}/woman.texi
- $(ENVADD) $(TEXI2PDF) $<
+ $(ENVADD) $(TEXI2PDF) ${srcdir}/woman.texi
.PHONY: mostlyclean clean distclean maintainer-clean
mostlyclean:
- rm -f *.aux *.log *.toc *.cp *.cps *.fn *.fns *.ky *.kys \
- *.op *.ops *.pg *.pgs *.tp *.tps *.vr *.vrs
+ rm -f *.aux *.log *.toc *.c[mp] *.c[mp]s *.fn *.fns \
+ *.ky *.kys *.op *.ops *.p[gj] *.p[gj]s *.sc *.scs *.ss \
+ *.t[gp] *.t[gp]s *.vr *.vrs
rm -f gnustmp.*
clean: mostlyclean
@@ -701,9 +675,10 @@ clean: mostlyclean
distclean: clean
# rm -f Makefile
-## infodir is relative to srcdir.
+## buildinfodir is relative to srcdir.
maintainer-clean: distclean
- cd $(srcdir); for file in $(INFO_TARGETS); do \
+ cd $(buildinfodir); for file in $(INFO_TARGETS); do \
+ file=`echo $${file} | sed 's/\.info$$//'`${INFO_EXT}; \
rm -f $${file} $${file}-[1-9] $${file}-[1-9][0-9]; \
done
diff --git a/doc/misc/ada-mode.texi b/doc/misc/ada-mode.texi
index 0eb20d01324..8d06ae0de22 100644
--- a/doc/misc/ada-mode.texi
+++ b/doc/misc/ada-mode.texi
@@ -3,7 +3,7 @@
@settitle Ada Mode
@copying
-Copyright @copyright{} 1999-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1999-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi
index 60bb6e7cdac..3a1e4155e97 100644
--- a/doc/misc/auth.texi
+++ b/doc/misc/auth.texi
@@ -10,7 +10,7 @@
@copying
This file describes the Emacs auth-source library.
-Copyright @copyright{} 2008-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 2008-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -113,7 +113,7 @@ The @code{user} is the user name. It's known as @var{:user} in
Spaces are always OK as far as auth-source is concerned (but other
programs may not like them). Just put the data in quotes, escaping
-quotes as you'd expect with @code{\}.
+quotes as you'd expect with @samp{\}.
All these are optional. You could just say (but we don't recommend
it, we're just showing that it's possible)
@@ -125,14 +125,14 @@ password @var{mypassword}
to use the same password everywhere. Again, @emph{DO NOT DO THIS} or
you will be pwned as the kids say.
-``Netrc'' files are usually called @code{.authinfo} or @code{.netrc};
-nowadays @code{.authinfo} seems to be more popular and the auth-source
+``Netrc'' files are usually called @file{.authinfo} or @file{.netrc};
+nowadays @file{.authinfo} seems to be more popular and the auth-source
library encourages this confusion by accepting both, as you'll see
later.
If you have problems with the search, set @code{auth-source-debug} to
@code{'trivia} and see what host, port, and user the library is
-checking in the @code{*Messages*} buffer. Ditto for any other
+checking in the @samp{*Messages*} buffer. Ditto for any other
problems, your first step is always to see what's being checked. The
second step, of course, is to write a blog entry about it and wait for
the answer in the comments.
@@ -180,12 +180,15 @@ Here's a mixed example using two sources:
@end defvar
If you don't customize @code{auth-sources}, you'll have to live with
-the defaults: any host and any port are looked up in the netrc
-file @code{~/.authinfo.gpg}, which is a GnuPG encrypted file
-(@pxref{GnuPG and EasyPG Assistant Configuration}).
+the defaults: the unencrypted netrc file @file{~/.authinfo} will be
+used for any host and any port.
-If that fails, the unencrypted netrc files @code{~/.authinfo} and
-@code{~/.netrc} will be used.
+If that fails, any host and any port are looked up in the netrc file
+@file{~/.authinfo.gpg}, which is a GnuPG encrypted file (@pxref{GnuPG
+and EasyPG Assistant Configuration}).
+
+Finally, the unencrypted netrc file @file{~/.netrc} will be used for
+any host and any port.
The typical netrc line example is without a port.
@@ -227,7 +230,153 @@ necessary if you have an unusual (see earlier comment on those) setup.
@node Secret Service API
@chapter Secret Service API
-TODO: how does it work generally, how does secrets.el work, some examples.
+The @dfn{Secret Service API} is a standard from
+@uref{http://www.freedesktop.org/wiki/Specifications/secret-storage-spec,,freedesktop.org}
+to securely store passwords and other confidential information. This
+API is implemented by system daemons such as the GNOME Keyring and the
+KDE Wallet (these are GNOME and KDE packages respectively and should
+be available on most modern GNU/Linux systems).
+
+The auth-source library uses the @file{secrets.el} library to connect
+through the Secret Service API. You can also use that library in
+other packages, it's not exclusive to auth-source.
+
+@defvar secrets-enabled
+After loading @file{secrets.el}, a non-@code{nil} value of this
+variable indicates the existence of a daemon providing the Secret
+Service API.
+@end defvar
+
+@deffn Command secrets-show-secrets
+This command shows all collections, items, and their attributes.
+@end deffn
+
+The atomic objects managed by the Secret Service API are @dfn{secret
+items}, which contain things an application wishes to store securely,
+like a password. Secret items have a label (a name), the @dfn{secret}
+(which is the string we want, like a password), and a set of lookup
+attributes. The attributes can be used to search and retrieve a
+secret item at a later date.
+
+Secret items are grouped in @dfn{collections}. A collection is
+sometimes called a @samp{keyring} or @samp{wallet} in GNOME Keyring
+and KDE Wallet but it's the same thing, a group of secrets.
+Collections are personal and protected so only the owner can open them.
+
+The most common collection is called @code{"login"}.
+
+A collection can have an alias. The alias @code{"default"} is
+commonly used so the clients don't have to know the specific name of
+the collection they open. Other aliases are not supported yet.
+Since aliases are globally accessible, set the @code{"default"} alias
+only when you're sure it's appropriate.
+
+@defun secrets-list-collections
+This function returns all the collection names as a list.
+@end defun
+
+@defun secrets-set-alias collection alias
+Set @var{alias} as alias of collection labeled @var{collection}.
+Currently only the alias @code{"default"} is supported.
+@end defun
+
+@defun secrets-get-alias alias
+Return the collection name @var{alias} is referencing to.
+Currently only the alias @code{"default"} is supported.
+@end defun
+
+Collections can be created and deleted by the functions
+@code{secrets-create-collection} and @code{secrets-delete-collection}.
+Usually, this is not done from within Emacs. Do not delete standard
+collections such as @code{"login"}.
+
+The special collection @code{"session"} exists for the lifetime of the
+corresponding client session (in our case, Emacs's lifetime). It is
+created automatically when Emacs uses the Secret Service interface and
+it is deleted when Emacs is killed. Therefore, it can be used to
+store and retrieve secret items temporarily. The @code{"session"}
+collection is better than a persistent collection when the secret
+items should not live longer than Emacs. The session collection can
+be specified either by the string @code{"session"}, or by @code{nil},
+whenever a collection parameter is needed in the following functions.
+
+@defun secrets-list-items collection
+Returns all the item labels of @var{collection} as a list.
+@end defun
+
+@defun secrets-create-item collection item password &rest attributes
+This function creates a new item in @var{collection} with label
+@var{item} and password @var{password}. @var{attributes} are
+key-value pairs set for the created item. The keys are keyword
+symbols, starting with a colon. Example:
+
+@example
+;;; The session "session", the label is "my item"
+;;; and the secret (password) is "geheim"
+(secrets-create-item "session" "my item" "geheim"
+ :method "sudo" :user "joe" :host "remote-host")
+@end example
+@end defun
+
+@defun secrets-get-secret collection item
+Return the secret of item labeled @var{item} in @var{collection}.
+If there is no such item, return @code{nil}.
+@end defun
+
+@defun secrets-delete-item collection item
+This function deletes item @var{item} in @var{collection}.
+@end defun
+
+The lookup attributes, which are specified during creation of a
+secret item, must be a key-value pair. Keys are keyword symbols,
+starting with a colon; values are strings. They can be retrieved
+from a given secret item and they can be used for searching of items.
+
+@defun secrets-get-attribute collection item attribute
+Returns the value of key @var{attribute} of item labeled @var{item} in
+@var{collection}. If there is no such item, or the item doesn't own
+this key, the function returns @code{nil}.
+@end defun
+
+@defun secrets-get-attributes collection item
+Return the lookup attributes of item labeled @var{item} in
+@var{collection}. If there is no such item, or the item has no
+attributes, it returns @code{nil}. Example:
+
+@example
+(secrets-get-attributes "session" "my item")
+ @result{} ((:user . "joe") (:host ."remote-host"))
+@end example
+@end defun
+
+@defun secrets-search-items collection &rest attributes
+Search for the items in @var{collection} with matching
+@var{attributes}. The @var{attributes} are key-value pairs, as used
+in @code{secrets-create-item}. Example:
+
+@example
+(secrets-search-items "session" :user "joe")
+ @result{} ("my item" "another item")
+@end example
+@end defun
+
+The auth-source library uses the @file{secrets.el} library and thus
+the Secret Service API when you specify a source matching
+@code{"secrets:COLLECTION"}. For instance, you could use
+@code{"secrets:session"} to use the @code{"session"} collection, open only
+for the lifetime of Emacs. Or you could use @code{"secrets:Login"} to
+open the @code{"Login"} collection. As a special case, you can use the
+symbol @code{default} in @code{auth-sources} (not a string, but a
+symbol) to specify the @code{"default"} alias. Here is a contrived
+example that sets @code{auth-sources} to search three collections and
+then fall back to @file{~/.authinfo.gpg}.
+
+@example
+(setq auth-sources '(default
+ "secrets:session"
+ "secrets:Login"
+ "~/.authinfo.gpg"))
+@end example
@node Help for developers
@chapter Help for developers
@@ -235,21 +384,21 @@ TODO: how does it work generally, how does secrets.el work, some examples.
The auth-source library lets you control logging output easily.
@defvar auth-source-debug
-Set this variable to 'trivia to see lots of output in *Messages*, or
-set it to a function that behaves like @code{message} to do your own
-logging.
+Set this variable to @code{'trivia} to see lots of output in
+@samp{*Messages*}, or set it to a function that behaves like
+@code{message} to do your own logging.
@end defvar
The auth-source library only has a few functions for external use.
-@defun auth-source-search SPEC
-
-TODO: how to include docstring?
-
+@defun auth-source-search &rest spec &key type max host user port secret require create delete &allow-other-keys
+This function searches (or modifies) authentication backends according
+to @var{spec}. See the function's doc-string for details.
+@c TODO more details.
@end defun
Let's take a look at an example of using @code{auth-source-search}
-from Gnus' @code{nnimap.el}.
+from Gnus's @code{nnimap.el}.
@example
(defun nnimap-credentials (address ports)
@@ -304,34 +453,33 @@ the same question again, which is annoying.
So the responsibility of the API user that specified @code{:create t}
is to call the @code{:save-function} if it's provided.
-@defun auth-source-delete SPEC
-
-TODO: how to include docstring?
-
+@defun auth-source-delete &rest spec &key delete &allow-other-keys
+This function deletes entries matching @var{spec} from the
+authentication backends. It returns the entries that were deleted.
+The backend may not actually delete the entries.
@end defun
-@defun auth-source-forget SPEC
-
-TODO: how to include docstring?
-
+@defun auth-source-forget spec
+This function forgets any cached data that exactly matches @var{spec}.
+It returns @code{t} if it forget some data, and @code{nil} if no
+matching data was found.
@end defun
-@defun auth-source-forget+ SPEC
-
-TODO: how to include docstring?
-
+@defun auth-source-forget+ &rest spec &allow-other-keys
+This function forgets any cached data matching @var{spec}.
+It returns the number of items forgotten.
@end defun
@node GnuPG and EasyPG Assistant Configuration
@appendix GnuPG and EasyPG Assistant Configuration
If you don't customize @code{auth-sources}, the auth-source library
-reads @code{~/.authinfo.gpg}, which is a GnuPG encrypted file. Then
-it will check @code{~/.authinfo} but it's not recommended to use such
+reads @file{~/.authinfo.gpg}, which is a GnuPG encrypted file. Then
+it will check @file{~/.authinfo} but it's not recommended to use such
an unencrypted file.
In Emacs 23 or later there is an option @code{auto-encryption-mode} to
-automatically decrypt @code{*.gpg} files. It is enabled by default.
+automatically decrypt @file{*.gpg} files. It is enabled by default.
If you are using earlier versions of Emacs, you will need:
@lisp
diff --git a/doc/misc/autotype.texi b/doc/misc/autotype.texi
index 289c08eb00e..9d7a51233ff 100644
--- a/doc/misc/autotype.texi
+++ b/doc/misc/autotype.texi
@@ -10,7 +10,7 @@
@c @cindex autotypist
@copying
-Copyright @copyright{} 1994-1995, 1999, 2001-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1994-1995, 1999, 2001-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index d0c15c1940e..7e60f4b190f 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -94,7 +94,7 @@ This file documents Calc, the GNU Emacs calculator, included with
GNU Emacs @value{EMACSVER}.
@end ifnotinfo
-Copyright @copyright{} 1990-1991, 2001-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1990-1991, 2001-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -218,7 +218,7 @@ and what are the various ways that it can be used.
* Notations Used in This Manual::
* Demonstration of Calc::
* Using Calc::
-* History and Acknowledgements::
+* History and Acknowledgments::
@end menu
@node What is Calc, About This Manual, Getting Started, Getting Started
@@ -557,7 +557,7 @@ these equations for the variables @expr{x} and @expr{y}.
Type @kbd{d B} to view the solutions in more readable notation.
Type @w{@kbd{d C}} to view them in C language notation, @kbd{d T}
to view them in the notation for the @TeX{} typesetting system,
-and @kbd{d L} to view them in the notation for the La@TeX{} typesetting
+and @kbd{d L} to view them in the notation for the @LaTeX{} typesetting
system. Type @kbd{d N} to return to normal notation.
@noindent
@@ -582,7 +582,7 @@ about the @w{@kbd{t N}} command, @kbd{h f sqrt @key{RET}} to read about the
Press @key{DEL} repeatedly to remove any leftover results from the stack.
To exit from Calc, press @kbd{q} or @kbd{C-x * c} again.
-@node Using Calc, History and Acknowledgements, Demonstration of Calc, Getting Started
+@node Using Calc, History and Acknowledgments, Demonstration of Calc, Getting Started
@section Using Calc
@noindent
@@ -910,12 +910,12 @@ The derivative of
is
-1 / ln(x) x
+1 / x ln(x)
@end group
@end smallexample
(Note that by default, Calc gives division lower precedence than multiplication,
-so that @samp{1 / ln(x) x} is equivalent to @samp{1 / (ln(x) x)}.)
+so that @samp{1 / x ln(x)} is equivalent to @samp{1 / (x ln(x))}.)
To make this look nicer, you might want to press @kbd{d =} to center
the formula, and even @kbd{d B} to use Big display mode.
@@ -932,14 +932,14 @@ is
1
-------
- ln(x) x
+ x ln(x)
@end group
@end smallexample
Calc has added annotations to the file to help it remember the modes
that were used for this formula. They are formatted like comments
in the @TeX{} typesetting language, just in case you are using @TeX{} or
-La@TeX{}. (In this example @TeX{} is not being used, so you might want
+@LaTeX{}. (In this example @TeX{} is not being used, so you might want
to move these comments up to the top of the file or otherwise put them
out of the way.)
@@ -964,7 +964,9 @@ and keyboard will revert to the way they were before.
The related command @kbd{C-x * w} operates on a single word, which
generally means a single number, inside text. It searches for an
expression which ``looks'' like a number containing the point.
-Here's an example of its use:
+Here's an example of its use (before you try this, remove the Calc
+annotations or use a new buffer so that the extra settings in the
+annotations don't take effect):
@smallexample
A slope of one-third corresponds to an angle of 1 degrees.
@@ -1148,8 +1150,8 @@ and record them as the current keyboard macro.
its initial state: Empty stack, and initial mode settings.
@end table
-@node History and Acknowledgements, , Using Calc, Getting Started
-@section History and Acknowledgements
+@node History and Acknowledgments, , Using Calc, Getting Started
+@section History and Acknowledgments
@noindent
Calc was originally started as a two-week project to occupy a lull
@@ -1175,15 +1177,16 @@ turned out to be more open-ended than one might have expected.
Emacs Lisp didn't have built-in floating point math (now it does), so
this had to be simulated in software. In fact, Emacs integers would
-only comfortably fit six decimal digits or so---not enough for a decent
-calculator. So I had to write my own high-precision integer code as
-well, and once I had this I figured that arbitrary-size integers were
-just as easy as large integers. Arbitrary floating-point precision was
-the logical next step. Also, since the large integer arithmetic was
-there anyway it seemed only fair to give the user direct access to it,
-which in turn made it practical to support fractions as well as floats.
-All these features inspired me to look around for other data types that
-might be worth having.
+only comfortably fit six decimal digits or so (at the time)---not
+enough for a decent calculator. So I had to write my own
+high-precision integer code as well, and once I had this I figured
+that arbitrary-size integers were just as easy as large integers.
+Arbitrary floating-point precision was the logical next step. Also,
+since the large integer arithmetic was there anyway it seemed only
+fair to give the user direct access to it, which in turn made it
+practical to support fractions as well as floats. All these features
+inspired me to look around for other data types that might be worth
+having.
Around this time, my friend Rick Koshi showed me his nifty new HP-28
calculator. It allowed the user to manipulate formulas as well as
@@ -1359,15 +1362,14 @@ to control various modes of the Calculator.
@subsection RPN Calculations and the Stack
@cindex RPN notation
-@ifnottex
@noindent
+@ifnottex
Calc normally uses RPN notation. You may be familiar with the RPN
system from Hewlett-Packard calculators, FORTH, or PostScript.
(Reverse Polish Notation, RPN, is named after the Polish mathematician
Jan Lukasiewicz.)
@end ifnottex
@tex
-\noindent
Calc normally uses RPN notation. You may be familiar with the RPN
system from Hewlett-Packard calculators, FORTH, or PostScript.
(Reverse Polish Notation, RPN, is named after the Polish mathematician
@@ -1473,7 +1475,7 @@ multiplication.) Figure it out by hand, then try it with Calc to see
if you're right. @xref{RPN Answer 1, 1}. (@bullet{})
(@bullet{}) @strong{Exercise 2.} Compute
-@texline @math{(2\times4) + (7\times9.4) + {5\over4}}
+@texline @math{(2\times4) + (7\times9.5) + {5\over4}}
@infoline @expr{2*4 + 7*9.5 + 5/4}
using the stack. @xref{RPN Answer 2, 2}. (@bullet{})
@@ -1964,7 +1966,7 @@ values are left alone, even when you evaluate the formula.
@smallexample
@group
-1: 2 a + 2 b 1: 34 + 2 b
+1: 2 a + 2 b 1: 2 b + 34
. .
' 2a+2b @key{RET} =
@@ -1976,7 +1978,7 @@ alone, as are calls for which the value is undefined.
@smallexample
@group
-1: 2 + log10(0) + log10(x) + log10(5, 6) + foo(3)
+1: log10(0) + log10(x) + log10(5, 6) + foo(3) + 2
.
' log10(100) + log10(0) + log10(x) + log10(5,6) + foo(3) @key{RET}
@@ -4459,7 +4461,7 @@ date by one or several months. @xref{Date Arithmetic}, for more.
Friday the 13th? @xref{Types Answer 5, 5}. (@bullet{})
(@bullet{}) @strong{Exercise 6.} How many leap years will there be
-between now and the year 10001 A.D.? @xref{Types Answer 6, 6}. (@bullet{})
+between now and the year 10001 AD@? @xref{Types Answer 6, 6}. (@bullet{})
@cindex Slope and angle of a line
@cindex Angle and slope of a line
@@ -4588,7 +4590,7 @@ that arises in the second one.
@cindex Fermat, primality test of
(@bullet{}) @strong{Exercise 10.} A theorem of Pierre de Fermat
says that
-@texline @w{@math{x^{n-1} \bmod n = 1}}
+@texline @math{x^{n-1} \bmod n = 1}
@infoline @expr{x^(n-1) mod n = 1}
if @expr{n} is a prime number and @expr{x} is an integer less than
@expr{n}. If @expr{n} is @emph{not} a prime number, this will
@@ -4704,19 +4706,17 @@ for them.
@smallexample
@group
-1: 20 degF 1: 11.1111 degC 1: -20:3 degC 1: -6.666 degC
+1: 20 degF 1: 11.1111 degC 1: -6.666 degC
. . . .
- ' 20 degF @key{RET} u c degC @key{RET} U u t degC @key{RET} c f
+ ' 20 degF @key{RET} u c degC @key{RET} U u t degC @key{RET}
@end group
@end smallexample
@noindent
First we convert a change of 20 degrees Fahrenheit into an equivalent
change in degrees Celsius (or Centigrade). Then, we convert the
-absolute temperature 20 degrees Fahrenheit into Celsius. Since
-this comes out as an exact fraction, we then convert to floating-point
-for easier comparison with the other result.
+absolute temperature 20 degrees Fahrenheit into Celsius.
For simple unit conversions, you can put a plain number on the stack.
Then @kbd{u c} and @kbd{u t} will prompt for both old and new units.
@@ -4775,7 +4775,7 @@ formulas as regular data objects.
@smallexample
@group
-1: 2 x^2 - 6 1: 6 - 2 x^2 1: (6 - 2 x^2) (3 x^2 + y)
+1: 2 x^2 - 6 1: 6 - 2 x^2 1: (3 x^2 + y) (6 - 2 x^2)
. . .
' 2x^2-6 @key{RET} n ' 3x^2+y @key{RET} *
@@ -4791,7 +4791,7 @@ formulas. Continuing with the formula from the last example,
@smallexample
@group
-1: 18 x^2 + 6 y - 6 x^4 - 2 x^2 y 1: (18 - 2 y) x^2 - 6 x^4 + 6 y
+1: 18 x^2 - 6 x^4 + 6 y - 2 y x^2 1: (18 - 2 y) x^2 - 6 x^4 + 6 y
. .
a x a c x @key{RET}
@@ -4849,17 +4849,17 @@ the other root(s), let's divide through by @expr{x} and then solve:
@smallexample
@group
-1: (34 x - 24 x^3) / x 1: 34 x / x - 24 x^3 / x 1: 34 - 24 x^2
- . . .
+1: (34 x - 24 x^3) / x 1: 34 - 24 x^2
+ . .
- ' x @key{RET} / a x a s
+ ' x @key{RET} / a x
@end group
@end smallexample
@noindent
@smallexample
@group
-1: 34 - 24 x^2 = 0 1: x = 1.19023
+1: 0.70588 x^2 = 1 1: x = 1.19023
. .
0 a = s 3 a S x @key{RET}
@@ -4867,10 +4867,6 @@ the other root(s), let's divide through by @expr{x} and then solve:
@end smallexample
@noindent
-Notice the use of @kbd{a s} to ``simplify'' the formula. When the
-default algebraic simplifications don't do enough, you can use
-@kbd{a s} to tell Calc to spend more time on the job.
-
Now we compute the second derivative and plug in our values of @expr{x}:
@smallexample
@@ -4905,7 +4901,7 @@ has a maximum value at @expr{x = 1.19023}. (The function also has a
local @emph{minimum} at @expr{x = 0}.)
When we solved for @expr{x}, we got only one value even though
-@expr{34 - 24 x^2 = 0} is a quadratic equation that ought to have
+@expr{0.70588 x^2 = 1} is a quadratic equation that ought to have
two solutions. The reason is that @w{@kbd{a S}} normally returns a
single ``principal'' solution. If it needs to come up with an
arbitrary sign (as occurs in the quadratic formula) it picks @expr{+}.
@@ -4914,7 +4910,7 @@ solution by pressing @kbd{H} (the Hyperbolic flag) before @kbd{a S}.
@smallexample
@group
-1: 34 - 24 x^2 = 0 1: x = 1.19023 s1 1: x = -1.19023
+1: 0.70588 x^2 = 1 1: x = 1.19023 s1 1: x = -1.19023
. . .
r 3 H a S x @key{RET} s 5 1 n s l s1 @key{RET}
@@ -5026,7 +5022,7 @@ One more mode that makes reading formulas easier is Big mode.
Here things like powers, square roots, and quotients and fractions
are displayed in a two-dimensional pictorial form. Calc has other
language modes as well, such as C mode, FORTRAN mode, @TeX{} mode
-and La@TeX{} mode.
+and @LaTeX{} mode.
@smallexample
@group
@@ -5135,7 +5131,7 @@ also have used plain @kbd{v x} as follows: @kbd{v x 10 @key{RET} 9 + .1 *}.)
@smallexample
@group
2: [1, 1.1, ... ] 1: [0., 0.084941, 0.16993, ... ]
-1: sin(x) ln(x) .
+1: ln(x) sin(x) .
.
' sin(x) ln(x) @key{RET} s 1 m r p 5 @key{RET} V M $ @key{RET}
@@ -5168,7 +5164,7 @@ we're not doing too well. Let's try another approach.
@smallexample
@group
-1: sin(x) ln(x) 1: 0.84147 x - 0.84147 + 0.11957 (x - 1)^2 - ...
+1: ln(x) sin(x) 1: 0.84147 x + 0.11957 (x - 1)^2 - ...
. .
r 1 a t x=1 @key{RET} 4 @key{RET}
@@ -5277,60 +5273,43 @@ Suppose we want to simplify this trigonometric formula:
@smallexample
@group
-1: 2 / cos(x)^2 - 2 tan(x)^2
+1: 2 sec(x)^2 / tan(x)^2 - 2 / tan(x)^2
.
- ' 2/cos(x)^2 - 2tan(x)^2 @key{RET} s 1
+ ' 2sec(x)^2/tan(x)^2 - 2/tan(x)^2 @key{RET} s 1
@end group
@end smallexample
@noindent
-If we were simplifying this by hand, we'd probably replace the
-@samp{tan} with a @samp{sin/cos} first, then combine over a common
-denominator. The @kbd{I a s} command will do the former and the @kbd{a n}
-algebra command will do the latter, but we'll do both with rewrite
-rules just for practice.
+If we were simplifying this by hand, we'd probably combine over the common
+denominator. The @kbd{a n} algebra command will do this, but we'll do
+it with a rewrite rule just for practice.
Rewrite rules are written with the @samp{:=} symbol.
@smallexample
@group
-1: 2 / cos(x)^2 - 2 sin(x)^2 / cos(x)^2
+1: (2 sec(x)^2 - 2) / tan(x)^2
.
- a r tan(a) := sin(a)/cos(a) @key{RET}
+ a r a/x + b/x := (a+b)/x @key{RET}
@end group
@end smallexample
@noindent
(The ``assignment operator'' @samp{:=} has several uses in Calc. All
-by itself the formula @samp{tan(a) := sin(a)/cos(a)} doesn't do anything,
+by itself the formula @samp{a/x + b/x := (a+b)/x} doesn't do anything,
but when it is given to the @kbd{a r} command, that command interprets
it as a rewrite rule.)
-The lefthand side, @samp{tan(a)}, is called the @dfn{pattern} of the
+The lefthand side, @samp{a/x + b/x}, is called the @dfn{pattern} of the
rewrite rule. Calc searches the formula on the stack for parts that
match the pattern. Variables in a rewrite pattern are called
@dfn{meta-variables}, and when matching the pattern each meta-variable
can match any sub-formula. Here, the meta-variable @samp{a} matched
-the actual variable @samp{x}.
-
-When the pattern part of a rewrite rule matches a part of the formula,
-that part is replaced by the righthand side with all the meta-variables
-substituted with the things they matched. So the result is
-@samp{sin(x) / cos(x)}. Calc's normal algebraic simplifications then
-mix this in with the rest of the original formula.
-
-To merge over a common denominator, we can use another simple rule:
-
-@smallexample
-@group
-1: (2 - 2 sin(x)^2) / cos(x)^2
- .
-
- a r a/x + b/x := (a+b)/x @key{RET}
-@end group
-@end smallexample
+the expression @samp{2 sec(x)^2}, the meta-variable @samp{b} matched
+the constant @samp{-2} and the meta-variable @samp{x} matched
+the expression @samp{tan(x)^2}.
This rule points out several interesting features of rewrite patterns.
First, if a meta-variable appears several times in a pattern, it must
@@ -5340,13 +5319,18 @@ denominators.
Second, meta-variable names are independent from variables in the
target formula. Notice that the meta-variable @samp{x} here matches
-the subformula @samp{cos(x)^2}; Calc never confuses the two meanings of
+the subformula @samp{tan(x)^2}; Calc never confuses the two meanings of
@samp{x}.
And third, rewrite patterns know a little bit about the algebraic
properties of formulas. The pattern called for a sum of two quotients;
Calc was able to match a difference of two quotients by matching
-@samp{a = 2}, @samp{b = -2 sin(x)^2}, and @samp{x = cos(x)^2}.
+@samp{a = 2 sec(x)^2}, @samp{b = -2}, and @samp{x = tan(x)^2}.
+
+When the pattern part of a rewrite rule matches a part of the formula,
+that part is replaced by the righthand side with all the meta-variables
+substituted with the things they matched. So the result is
+@samp{(2 sec(x)^2 - 2) / tan(x)^2}.
@c [fix-ref Algebraic Properties of Rewrite Rules]
We could just as easily have written @samp{a/x - b/x := (a-b)/x} for
@@ -5356,19 +5340,19 @@ we could have used the @code{plain} symbol. @xref{Algebraic Properties
of Rewrite Rules}, for some examples of this.)
One more rewrite will complete the job. We want to use the identity
-@samp{sin(x)^2 + cos(x)^2 = 1}, but of course we must first rearrange
+@samp{tan(x)^2 + 1 = sec(x)^2}, but of course we must first rearrange
the identity in a way that matches our formula. The obvious rule
-would be @samp{@w{2 - 2 sin(x)^2} := 2 cos(x)^2}, but a little thought shows
-that the rule @samp{sin(x)^2 := 1 - cos(x)^2} will also work. The
+would be @samp{@w{2 sec(x)^2 - 2} := 2 tan(x)^2}, but a little thought shows
+that the rule @samp{sec(x)^2 := 1 + tan(x)^2} will also work. The
latter rule has a more general pattern so it will work in many other
situations, too.
@smallexample
@group
-1: (2 + 2 cos(x)^2 - 2) / cos(x)^2 1: 2
- . .
+1: 2
+ .
- a r sin(x)^2 := 1 - cos(x)^2 @key{RET} a s
+ a r sec(x)^2 := 1 + tan(x)^2 @key{RET}
@end group
@end smallexample
@@ -5383,14 +5367,13 @@ having to retype it.
@smallexample
@group
-' tan(x) := sin(x)/cos(x) @key{RET} s t tsc @key{RET}
-' a/x + b/x := (a+b)/x @key{RET} s t merge @key{RET}
-' sin(x)^2 := 1 - cos(x)^2 @key{RET} s t sinsqr @key{RET}
+' a/x + b/x := (a+b)/x @key{RET} s t merge @key{RET}
+' sec(x)^2 := 1 + tan(x)^2 @key{RET} s t secsqr @key{RET}
-1: 2 / cos(x)^2 - 2 tan(x)^2 1: 2
+1: 2 sec(x)^2 / tan(x)^2 - 2 / tan(x)^2 1: 2
. .
- r 1 a r tsc @key{RET} a r merge @key{RET} a r sinsqr @key{RET} a s
+ r 1 a r merge @key{RET} a r secsqr @key{RET}
@end group
@end smallexample
@@ -5420,20 +5403,20 @@ a variable containing a vector of rules.
@smallexample
@group
-1: [tsc, merge, sinsqr] 1: [tan(x) := sin(x) / cos(x), ... ]
+1: [merge, secsqr] 1: [a/x + b/x := (a + b)/x, ... ]
. .
- ' [tsc,merge,sinsqr] @key{RET} =
+ ' [merge,sinsqr] @key{RET} =
@end group
@end smallexample
@noindent
@smallexample
@group
-1: 1 / cos(x) - sin(x) tan(x) 1: cos(x)
+1: 2 sec(x)^2 / tan(x)^2 - 2 / tan(x)^2 1: 2
. .
- s t trig @key{RET} r 1 a r trig @key{RET} a s
+ s t trig @key{RET} r 1 a r trig @key{RET}
@end group
@end smallexample
@@ -5451,10 +5434,10 @@ only one rewrite at a time.
@smallexample
@group
-1: 1 / cos(x) - sin(x)^2 / cos(x) 1: (1 - sin(x)^2) / cos(x)
- . .
+1: (2 sec(x)^2 - 2) / tan(x)^2 1: 2
+ . .
- r 1 M-1 a r trig @key{RET} M-1 a r trig @key{RET}
+ r 1 M-1 a r trig @key{RET} M-1 a r trig @key{RET}
@end group
@end smallexample
@@ -5466,20 +5449,20 @@ with a @samp{::} symbol and the desired condition. For example,
@smallexample
@group
-1: exp(2 pi i) + exp(3 pi i) + exp(4 pi i)
+1: sin(x + 2 pi) + sin(x + 3 pi) + sin(x + 4 pi)
.
- ' exp(2 pi i) + exp(3 pi i) + exp(4 pi i) @key{RET}
+ ' sin(x+2pi) + sin(x+3pi) + sin(x+4pi) @key{RET}
@end group
@end smallexample
@noindent
@smallexample
@group
-1: 1 + exp(3 pi i) + 1
+1: sin(x + 3 pi) + 2 sin(x)
.
- a r exp(k pi i) := 1 :: k % 2 = 0 @key{RET}
+ a r sin(a + k pi) := sin(a) :: k % 2 = 0 @key{RET}
@end group
@end smallexample
@@ -5487,10 +5470,10 @@ with a @samp{::} symbol and the desired condition. For example,
(Recall, @samp{k % 2} is the remainder from dividing @samp{k} by 2,
which will be zero only when @samp{k} is an even integer.)
-An interesting point is that the variables @samp{pi} and @samp{i}
-were matched literally rather than acting as meta-variables.
-This is because they are special-constant variables. The special
-constants @samp{e}, @samp{phi}, and so on also match literally.
+An interesting point is that the variable @samp{pi} was matched
+literally rather than acting as a meta-variable.
+This is because it is a special-constant variable. The special
+constants @samp{e}, @samp{i}, @samp{phi}, and so on also match literally.
A common error with rewrite
rules is to write, say, @samp{f(a,b,c,d,e) := g(a+b+c+d+e)}, expecting
to match any @samp{f} with five arguments but in fact matching
@@ -5541,7 +5524,7 @@ Now:
@smallexample
@group
-1: fib(6) + fib(x) + fib(0) 1: 8 + fib(x) + fib(0)
+1: fib(6) + fib(x) + fib(0) 1: fib(x) + fib(0) + 8
. .
' fib(6)+fib(x)+fib(0) @key{RET} a r fib @key{RET}
@@ -5707,10 +5690,10 @@ power series represented as @samp{@var{polynomial} + O(@var{var}^@var{n})}.
For example, given @samp{1 - x^2 / 2 + O(x^3)} and @samp{x - x^3 / 6 + O(x^4)}
on the stack, we want to be able to type @kbd{*} and get the result
@samp{x - 2:3 x^3 + O(x^4)}. Don't worry if the terms of the sum are
-rearranged or if @kbd{a s} needs to be typed after rewriting. (This one
-is rather tricky; the solution at the end of this chapter uses 6 rewrite
-rules. Hint: The @samp{constant(x)} condition tests whether @samp{x} is
-a number.) @xref{Rewrites Answer 6, 6}. (@bullet{})
+rearranged. (This one is rather tricky; the solution at the end of
+this chapter uses 6 rewrite rules. Hint: The @samp{constant(x)}
+condition tests whether @samp{x} is a number.) @xref{Rewrites Answer
+6, 6}. (@bullet{})
Just for kicks, try adding the rule @code{2+3 := 6} to @code{EvalRules}.
What happens? (Be sure to remove this rule afterward, or you might get
@@ -5737,7 +5720,7 @@ case @kbd{z} prefix.
@smallexample
@group
-1: 1 + x + x^2 / 2 + x^3 / 6 1: 1 + x + x^2 / 2 + x^3 / 6
+1: x + x^2 / 2 + x^3 / 6 + 1 1: x + x^2 / 2 + x^3 / 6 + 1
. .
' 1 + x + x^2/2! + x^3/3! @key{RET} Z F e myexp @key{RET} @key{RET} @key{RET} y
@@ -5808,7 +5791,7 @@ you may wish to program a keyboard macro to type this for you.
' y=sqrt(x) @key{RET} C-x ( H a S x @key{RET} C-x )
-1: y = cos(x) 1: x = s1 arccos(y) + 2 pi n1
+1: y = cos(x) 1: x = s1 arccos(y) + 2 n1 pi
. .
' y=cos(x) @key{RET} X
@@ -6874,7 +6857,7 @@ matrix as usual.
@smallexample
@group
-1: [6, 10] 2: [6, 10] 1: [6 - 4 a / (b - a), 4 / (b - a) ]
+1: [6, 10] 2: [6, 10] 1: [4 a / (a - b) + 6, 4 / (b - a) ]
. 1: [ [ 1, a ] .
[ 1, b ] ]
.
@@ -6888,9 +6871,9 @@ mode:
@smallexample
@group
- 4 a 4
-1: [6 - -----, -----]
- b - a b - a
+ 4 a 4
+1: [----- + 6, -----]
+ a - b b - a
@end group
@end smallexample
@@ -8442,11 +8425,11 @@ to the other?
@smallexample
@group
-1: 3.3356 ns 1: 0.81356 ns / ns 1: 0.81356
-2: 4.1 ns . .
+1: 3.3356 ns 1: 0.81356
+2: 4.1 ns .
.
- ' 4.1 ns @key{RET} / u s
+ ' 4.1 ns @key{RET} /
@end group
@end smallexample
@@ -8523,7 +8506,7 @@ familiar form.
@noindent
@smallexample
@group
-1: [x - 1.19023, x + 1.19023, x] 1: (x - 1.19023) (x + 1.19023) x
+1: [x - 1.19023, x + 1.19023, x] 1: x*(x + 1.19023) (x - 1.19023)
. .
V M ' x-$ @key{RET} V R *
@@ -8549,7 +8532,7 @@ same as the original polynomial.
@smallexample
@group
-1: x sin(pi x) 1: (sin(pi x) - pi x cos(pi x)) / pi^2
+1: x sin(pi x) 1: sin(pi x) / pi^2 - x cos(pi x) / pi
. .
' x sin(pi x) @key{RET} m r a i x @key{RET}
@@ -8560,7 +8543,7 @@ same as the original polynomial.
@smallexample
@group
1: [y, 1]
-2: (sin(pi x) - pi x cos(pi x)) / pi^2
+2: sin(pi x) / pi^2 - x cos(pi x) / pi
.
' [y,1] @key{RET} @key{TAB}
@@ -8570,7 +8553,7 @@ same as the original polynomial.
@noindent
@smallexample
@group
-1: [(sin(pi y) - pi y cos(pi y)) / pi^2, (sin(pi) - pi cos(pi)) / pi^2]
+1: [sin(pi y) / pi^2 - y cos(pi y) / pi, 1 / pi]
.
V M $ @key{RET}
@@ -8580,7 +8563,7 @@ same as the original polynomial.
@noindent
@smallexample
@group
-1: (sin(pi y) - pi y cos(pi y)) / pi^2 + (pi cos(pi) - sin(pi)) / pi^2
+1: sin(pi y) / pi^2 - y cos(pi y) / pi - 1 / pi
.
V R -
@@ -8590,7 +8573,7 @@ same as the original polynomial.
@noindent
@smallexample
@group
-1: (sin(3.14159 y) - 3.14159 y cos(3.14159 y)) / 9.8696 - 0.3183
+1: sin(3.14159 y) / 9.8696 - y cos(3.14159 y) / 3.14159 - 0.3183
.
=
@@ -8685,11 +8668,11 @@ We'll use Big mode to make the formulas more readable.
@smallexample
@group
- ___
- 2 + V 2
-1: (2 + sqrt(2)) / (1 + sqrt(2)) 1: --------
- . ___
- 1 + V 2
+ ___
+ V 2 + 2
+1: (2 + sqrt(2)) / (1 + sqrt(2)) 1: ---------
+ . ___
+ V 2 + 1
.
@@ -8713,11 +8696,11 @@ Multiplying by the conjugate helps because @expr{(a+b) (a-b) = a^2 - b^2}.
@noindent
@smallexample
@group
- ___ ___
-1: 2 + V 2 - 2 1: V 2
- . .
+ ___
+1: V 2
+ .
- a r a*(b+c) := a*b + a*c a s
+ a r a*(b+c) := a*b + a*c
@end group
@end smallexample
@@ -8914,7 +8897,7 @@ Note that this rule does not mention @samp{O} at all, so it will
apply to any product-of-sum it encounters---this rule may surprise
you if you put it into @code{EvalRules}!
-In the second rule, the sum of two O's is changed to the smaller O.
+In the second rule, the sum of two O's is changed to the smaller O@.
The optional constant coefficients are there mostly so that
@samp{O(x^2) - O(x^3)} and @samp{O(x^3) - O(x^2)} are handled
as well as @samp{O(x^2) + O(x^3)}.
@@ -9819,7 +9802,7 @@ stack but resets everything else to its default state.
@kindex Z ?
@pindex calc-help
The @kbd{?} key (@code{calc-help}) displays a series of brief help messages.
-Some keys (such as @kbd{b} and @kbd{d}) are prefix keys, like Emacs'
+Some keys (such as @kbd{b} and @kbd{d}) are prefix keys, like Emacs's
@key{ESC} and @kbd{C-x} prefixes. You can type
@kbd{?} after a prefix to see a list of commands beginning with that
prefix. (If the message includes @samp{[MORE]}, press @kbd{?} again
@@ -10140,7 +10123,7 @@ formula that goes onto the stack. (Thus @kbd{' pi @key{RET}} pushes
the variable @samp{pi}, but @kbd{' pi M-@key{RET}} pushes 3.1415.)
If you finish your algebraic entry by pressing @key{LFD} (or @kbd{C-j})
-instead of @key{RET}, Calc disables the default simplifications
+instead of @key{RET}, Calc disables simplification
(as if by @kbd{m O}; @pxref{Simplification Modes}) while the entry
is being pushed on the stack. Thus @kbd{' 1+2 @key{RET}} pushes 3
on the stack, but @kbd{' 1+2 @key{LFD}} pushes the formula @expr{1+2};
@@ -11004,10 +10987,10 @@ Input is flexible; date forms can be entered in any of the usual
notations for dates and times. @xref{Date Formats}.
Date forms are stored internally as numbers, specifically the number
-of days since midnight on the morning of January 1 of the year 1 AD.
+of days since midnight on the morning of December 31 of the year 1 BC@.
If the internal number is an integer, the form represents a date only;
if the internal number is a fraction or float, the form represents
-a date and time. For example, @samp{<6:00am Wed Jan 9, 1991>}
+a date and time. For example, @samp{<6:00am Thu Jan 10, 1991>}
is represented by the number 726842.25. The standard precision of
12 decimal digits is enough to ensure that a (reasonable) date and
time can be stored without roundoff error.
@@ -11027,58 +11010,70 @@ You can use the @kbd{v p} (@code{calc-pack}) and @kbd{v u}
of a date form. @xref{Packing and Unpacking}.
Date forms can go arbitrarily far into the future or past. Negative
-year numbers represent years BC. Calc uses a combination of the
-Gregorian and Julian calendars, following the history of Great
-Britain and the British colonies. This is the same calendar that
-is used by the @code{cal} program in most Unix implementations.
+year numbers represent years BC@. There is no ``year 0''; the day
+before @samp{<Mon Jan 1, +1>} is @samp{<Sun Dec 31, -1>}. These are
+days 1 and 0 respectively in Calc's internal numbering scheme. The
+Gregorian calendar is used for all dates, including dates before the
+Gregorian calendar was invented (although that can be configured; see
+below). Thus Calc's use of the day number @mathit{-10000} to
+represent August 15, 28 BC should be taken with a grain of salt.
@cindex Julian calendar
@cindex Gregorian calendar
Some historical background: The Julian calendar was created by
-Julius Caesar in the year 46 BC as an attempt to fix the gradual
-drift caused by the lack of leap years in the calendar used
-until that time. The Julian calendar introduced an extra day in
-all years divisible by four. After some initial confusion, the
-calendar was adopted around the year we call 8 AD. Some centuries
-later it became apparent that the Julian year of 365.25 days was
-itself not quite right. In 1582 Pope Gregory XIII introduced the
-Gregorian calendar, which added the new rule that years divisible
-by 100, but not by 400, were not to be considered leap years
-despite being divisible by four. Many countries delayed adoption
-of the Gregorian calendar because of religious differences;
-in Britain it was put off until the year 1752, by which time
-the Julian calendar had fallen eleven days behind the true
-seasons. So the switch to the Gregorian calendar in early
-September 1752 introduced a discontinuity: The day after
-Sep 2, 1752 is Sep 14, 1752. Calc follows this convention.
-To take another example, Russia waited until 1918 before
-adopting the new calendar, and thus needed to remove thirteen
-days (between Feb 1, 1918 and Feb 14, 1918). This means that
-Calc's reckoning will be inconsistent with Russian history between
-1752 and 1918, and similarly for various other countries.
-
-Today's timekeepers introduce an occasional ``leap second'' as
-well, but Calc does not take these minor effects into account.
-(If it did, it would have to report a non-integer number of days
-between, say, @samp{<12:00am Mon Jan 1, 1900>} and
+Julius Caesar in the year 46 BC as an attempt to fix the confusion
+caused by the irregular Roman calendar that was used before that time.
+The Julian calendar introduced an extra day in all years divisible by
+four. After some initial confusion, the calendar was adopted around
+the year we call 8 AD@. Some centuries later it became
+apparent that the Julian year of 365.25 days was itself not quite
+right. In 1582 Pope Gregory XIII introduced the Gregorian calendar,
+which added the new rule that years divisible by 100, but not by 400,
+were not to be considered leap years despite being divisible by four.
+Many countries delayed adoption of the Gregorian calendar
+because of religious differences. For example, Great Britain and the
+British colonies switched to the Gregorian calendar in September
+1752, when the Julian calendar was eleven days behind the
+Gregorian calendar. That year in Britain, the day after September 2
+was September 14. To take another example, Russia did not adopt the
+Gregorian calendar until 1918, and that year in Russia the day after
+January 31 was February 14. Calc's reckoning therefore matches English
+practice starting in 1752 and Russian practice starting in 1918, but
+disagrees with earlier dates in both countries.
+
+When the Julian calendar was introduced, it had January 1 as the first
+day of the year. By the Middle Ages, many European countries
+had changed the beginning of a new year to a different date, often to
+a religious festival. Almost all countries reverted to using January 1
+as the beginning of the year by the time they adopted the Gregorian
+calendar.
+
+Some calendars attempt to mimic the historical situation by using the
+Gregorian calendar for recent dates and the Julian calendar for older
+dates. The @code{cal} program in most Unix implementations does this,
+for example. While January 1 wasn't always the beginning of a calendar
+year, these hybrid calendars still use January 1 as the beginning of
+the year even for older dates. The customizable variable
+@code{calc-gregorian-switch} (@pxref{Customizing Calc}) can be set to
+have Calc's date forms switch from the Julian to Gregorian calendar at
+any specified date.
+
+Today's timekeepers introduce an occasional ``leap second''.
+These do not occur regularly and Calc does not take these minor
+effects into account. (If it did, it would have to report a
+non-integer number of days between, say,
+@samp{<12:00am Mon Jan 1, 1900>} and
@samp{<12:00am Sat Jan 1, 2000>}.)
-Calc uses the Julian calendar for all dates before the year 1752,
-including dates BC when the Julian calendar technically had not
-yet been invented. Thus the claim that day number @mathit{-10000} is
-called ``August 16, 28 BC'' should be taken with a grain of salt.
-
-Please note that there is no ``year 0''; the day before
-@samp{<Sat Jan 1, +1>} is @samp{<Fri Dec 31, -1>}. These are
-days 0 and @mathit{-1} respectively in Calc's internal numbering scheme.
-
@cindex Julian day counting
Another day counting system in common use is, confusingly, also called
-``Julian.'' The Julian day number is the numbers of days since
-12:00 noon (GMT) on Jan 1, 4713 BC, which in Calc's scheme (in GMT)
-is @mathit{-1721423.5} (recall that Calc starts at midnight instead
-of noon). Thus to convert a Calc date code obtained by unpacking a
-date form into a Julian day number, simply add 1721423.5 after
+``Julian.'' Julian days go from noon to noon. The Julian day number
+is the numbers of days since 12:00 noon (GMT) on November 24, 4714 BC
+in the Gregorian calendar (i.e., January 1, 4713 BC in the Julian
+calendar). In Calc's scheme (in GMT) the Julian day origin is
+@mathit{-1721422.5}, because Calc starts at midnight instead of noon.
+Thus to convert a Calc date code obtained by unpacking a
+date form into a Julian day number, simply add 1721422.5 after
compensating for the time zone difference. The built-in @kbd{t J}
command performs this conversion for you.
@@ -11100,7 +11095,7 @@ pairwise relatively prime) is
@texline @math{15\times 19\times 28 = 7980} years.
@infoline 15*19*28 = 7980 years.
This is the length of a Julian cycle. Working backwards, the previous
-year in which all three cycles began was 4713 BC, and so Scalinger
+year in which all three cycles began was 4713 BC, and so Scaliger
chose that year as the beginning of a Julian cycle. Since at the time
there were no historical records from before 4713 BC, using this year
as a starting point had the advantage of avoiding negative year
@@ -11110,7 +11105,7 @@ the Julian cycle as an astronomical dating system; this idea was taken
up by other astronomers. (At the time, noon was the start of the
astronomical day. Herschel originally suggested counting the days
since Jan 1, 4713 BC at noon Alexandria time; this was later amended to
-noon GMT.) Julian day numbering is largely used in astronomy.
+noon GMT@.) Julian day numbering is largely used in astronomy.
@cindex Unix time format
The Unix operating system measures time as an integer number of
@@ -12586,7 +12581,7 @@ are ``normalized'' when being taken from or pushed onto the stack.
Some normalizations are unavoidable, such as rounding floating-point
results to the current precision, and reducing fractions to simplest
form. Others, such as simplifying a formula like @expr{a+a} (or @expr{2+3}),
-are done by default but can be turned off when necessary.
+are done automatically but can be turned off when necessary.
When you press a key like @kbd{+} when @expr{2} and @expr{3} are on the
stack, Calc pops these numbers, normalizes them, creates the formula
@@ -12601,7 +12596,11 @@ followed by a shifted letter.
The @kbd{m O} (@code{calc-no-simplify-mode}) command turns off all optional
simplifications. These would leave a formula like @expr{2+3} alone. In
fact, nothing except simple numbers are ever affected by normalization
-in this mode.
+in this mode. Explicit simplification commands, such as @kbd{=} or
+@kbd{a s}, can still be given to simplify any formulas.
+@xref{Algebraic Definitions}, for a sample use of
+No-Simplification mode.
+
@kindex m N
@pindex calc-num-simplify-mode
@@ -12616,51 +12615,45 @@ A constant is a number or other numeric object (such as a constant
error form or modulo form), or a vector all of whose
elements are constant.
-@kindex m D
-@pindex calc-default-simplify-mode
-The @kbd{m D} (@code{calc-default-simplify-mode}) command restores the
-default simplifications for all formulas. This includes many easy and
+@kindex m I
+@pindex calc-basic-simplify-mode
+The @kbd{m I} (@code{calc-basic-simplify-mode}) command does some basic
+simplifications for all formulas. This includes many easy and
fast algebraic simplifications such as @expr{a+0} to @expr{a}, and
@expr{a + 2 a} to @expr{3 a}, as well as evaluating functions like
@expr{@tfn{deriv}(x^2, x)} to @expr{2 x}.
@kindex m B
@pindex calc-bin-simplify-mode
-The @kbd{m B} (@code{calc-bin-simplify-mode}) mode applies the default
+The @kbd{m B} (@code{calc-bin-simplify-mode}) mode applies the basic
simplifications to a result and then, if the result is an integer,
uses the @kbd{b c} (@code{calc-clip}) command to clip the integer according
to the current binary word size. @xref{Binary Functions}. Real numbers
are rounded to the nearest integer and then clipped; other kinds of
-results (after the default simplifications) are left alone.
+results (after the basic simplifications) are left alone.
@kindex m A
@pindex calc-alg-simplify-mode
-The @kbd{m A} (@code{calc-alg-simplify-mode}) mode does algebraic
-simplification; it applies all the default simplifications, and also
-the more powerful (and slower) simplifications made by @kbd{a s}
-(@code{calc-simplify}). @xref{Algebraic Simplifications}.
+The @kbd{m A} (@code{calc-alg-simplify-mode}) mode does standard
+algebraic simplifications. @xref{Algebraic Simplifications}.
@kindex m E
@pindex calc-ext-simplify-mode
-The @kbd{m E} (@code{calc-ext-simplify-mode}) mode does ``extended''
-algebraic simplification, as by the @kbd{a e} (@code{calc-simplify-extended})
-command. @xref{Unsafe Simplifications}.
+The @kbd{m E} (@code{calc-ext-simplify-mode}) mode does ``extended'', or
+``unsafe'', algebraic simplification. @xref{Unsafe Simplifications}.
@kindex m U
@pindex calc-units-simplify-mode
The @kbd{m U} (@code{calc-units-simplify-mode}) mode does units
-simplification; it applies the command @kbd{u s}
-(@code{calc-simplify-units}), which in turn
-is a superset of @kbd{a s}. In this mode, variable names which
+simplification. @xref{Simplification of Units}. These include the
+algebraic simplifications, plus variable names which
are identifiable as unit names (like @samp{mm} for ``millimeters'')
are simplified with their unit definitions in mind.
A common technique is to set the simplification mode down to the lowest
amount of simplification you will allow to be applied automatically, then
use manual commands like @kbd{a s} and @kbd{c c} (@code{calc-clean}) to
-perform higher types of simplifications on demand. @xref{Algebraic
-Definitions}, for another sample use of No-Simplification mode.
-
+perform higher types of simplifications on demand.
@node Declarations, Display Modes, Simplification Modes, Mode Settings
@section Declarations
@@ -12870,8 +12863,8 @@ roots (if any) will be included in the list.
only when certain values are integers (such as @samp{(x^y)^z}
shown above).
-Another command that makes use of declarations is @kbd{a s}, when
-simplifying equations and inequalities. It will cancel @code{x}
+Calc's algebraic simplifications also make use of declarations when
+simplifying equations and inequalities. They will cancel @code{x}
from both sides of @samp{a x = b x} only if it is sure @code{x}
is non-zero, say, because it has a @code{pos} declaration.
To declare specifically that @code{x} is real and non-zero,
@@ -13009,10 +13002,10 @@ i.e., is mathematically equal to a real number times @expr{i}.
The @code{dpos} function checks for positive (but nonzero) reals.
The @code{dneg} function checks for negative reals. The @code{dnonneg}
function checks for nonnegative reals, i.e., reals greater than or
-equal to zero. Note that the @kbd{a s} command can simplify an
-expression like @expr{x > 0} to 1 or 0 using @code{dpos}, and that
-@kbd{a s} is effectively applied to all conditions in rewrite rules,
-so the actual functions @code{dpos}, @code{dneg}, and @code{dnonneg}
+equal to zero. Note that Calc's algebraic simplifications, which are
+effectively applied to all conditions in rewrite rules, can simplify
+an expression like @expr{x > 0} to 1 or 0 using @code{dpos}.
+So the actual functions @code{dpos}, @code{dneg}, and @code{dnonneg}
are rarely necessary.
@ignore
@@ -13038,7 +13031,7 @@ also the set of objects considered ``true'' in conditional contexts.)
The @code{deven} function returns 1 if its argument is known to be
an even integer (or integer-valued float); it returns 0 if its argument
is known not to be even (because it is known to be odd or a non-integer).
-The @kbd{a s} command uses this to simplify a test of the form
+Calc's algebraic simplifications use this to simplify a test of the form
@samp{x % 2 = 0}. There is also an analogous @code{dodd} function.
@ignore
@@ -13446,7 +13439,7 @@ the time part. The punctuation characters (including spaces) must
match exactly; letter fields must correspond to suitable text in
the input. If this doesn't work, Calc checks if the input is a
simple number; if so, the number is interpreted as a number of days
-since Jan 1, 1 AD. Otherwise, Calc tries a much more relaxed and
+since Dec 31, 1 BC@. Otherwise, Calc tries a much more relaxed and
flexible algorithm which is described in the next section.
Weekday names are ignored during reading.
@@ -13842,7 +13835,7 @@ left or right as you prefer.
@noindent
The commands in this section change Calc to use a different notation for
entry and display of formulas, corresponding to the conventions of some
-other common language such as Pascal or La@TeX{}. Objects displayed on the
+other common language such as Pascal or @LaTeX{}. Objects displayed on the
stack or yanked from the Calculator to an editing buffer will be formatted
in the current language; objects entered in algebraic entry or yanked from
another buffer will be interpreted according to the current language.
@@ -13867,10 +13860,10 @@ the brackets in @samp{a[1]} and @samp{a[2]}, would not have known that
and would have written the formula back with notations (like implicit
multiplication) which would not have been valid for a C program.
-As another example, suppose you are maintaining a C program and a La@TeX{}
+As another example, suppose you are maintaining a C program and a @LaTeX{}
document, each of which needs a copy of the same formula. You can grab the
-formula from the program in C mode, switch to La@TeX{} mode, and yank the
-formula into the document in La@TeX{} math-mode format.
+formula from the program in C mode, switch to @LaTeX{} mode, and yank the
+formula into the document in @LaTeX{} math-mode format.
Language modes are selected by typing the letter @kbd{d} followed by a
shifted letter key.
@@ -14067,7 +14060,7 @@ convert to lower-case on input. With a negative prefix, these modes
convert to lower-case for display and input.
@node TeX and LaTeX Language Modes, Eqn Language Mode, C FORTRAN Pascal, Language Modes
-@subsection @TeX{} and La@TeX{} Language Modes
+@subsection @TeX{} and @LaTeX{} Language Modes
@noindent
@kindex d T
@@ -14079,38 +14072,38 @@ convert to lower-case for display and input.
The @kbd{d T} (@code{calc-tex-language}) command selects the conventions
of ``math mode'' in Donald Knuth's @TeX{} typesetting language,
and the @kbd{d L} (@code{calc-latex-language}) command selects the
-conventions of ``math mode'' in La@TeX{}, a typesetting language that
-uses @TeX{} as its formatting engine. Calc's La@TeX{} language mode can
-read any formula that the @TeX{} language mode can, although La@TeX{}
+conventions of ``math mode'' in @LaTeX{}, a typesetting language that
+uses @TeX{} as its formatting engine. Calc's @LaTeX{} language mode can
+read any formula that the @TeX{} language mode can, although @LaTeX{}
mode may display it differently.
Formulas are entered and displayed in the appropriate notation;
@texline @math{\sin(a/b)}
@infoline @expr{sin(a/b)}
will appear as @samp{\sin\left( @{a \over b@} \right)} in @TeX{} mode and
-@samp{\sin\left(\frac@{a@}@{b@}\right)} in La@TeX{} mode.
+@samp{\sin\left(\frac@{a@}@{b@}\right)} in @LaTeX{} mode.
Math formulas are often enclosed by @samp{$ $} signs in @TeX{} and
-La@TeX{}; these should be omitted when interfacing with Calc. To Calc,
+@LaTeX{}; these should be omitted when interfacing with Calc. To Calc,
the @samp{$} sign has the same meaning it always does in algebraic
formulas (a reference to an existing entry on the stack).
Complex numbers are displayed as in @samp{3 + 4i}. Fractions and
quotients are written using @code{\over} in @TeX{} mode (as in
-@code{@{a \over b@}}) and @code{\frac} in La@TeX{} mode (as in
+@code{@{a \over b@}}) and @code{\frac} in @LaTeX{} mode (as in
@code{\frac@{a@}@{b@}}); binomial coefficients are written with
@code{\choose} in @TeX{} mode (as in @code{@{a \choose b@}}) and
-@code{\binom} in La@TeX{} mode (as in @code{\binom@{a@}@{b@}}).
+@code{\binom} in @LaTeX{} mode (as in @code{\binom@{a@}@{b@}}).
Interval forms are written with @code{\ldots}, and error forms are
written with @code{\pm}. Absolute values are written as in
@samp{|x + 1|}, and the floor and ceiling functions are written with
@code{\lfloor}, @code{\rfloor}, etc. The words @code{\left} and
-@code{\right} are ignored when reading formulas in @TeX{} and La@TeX{}
+@code{\right} are ignored when reading formulas in @TeX{} and @LaTeX{}
modes. Both @code{inf} and @code{uinf} are written as @code{\infty};
when read, @code{\infty} always translates to @code{inf}.
Function calls are written the usual way, with the function name followed
by the arguments in parentheses. However, functions for which @TeX{}
-and La@TeX{} have special names (like @code{\sin}) will use curly braces
+and @LaTeX{} have special names (like @code{\sin}) will use curly braces
instead of parentheses for very simple arguments. During input, curly
braces and parentheses work equally well for grouping, but when the
document is formatted the curly braces will be invisible. Thus the
@@ -14125,14 +14118,14 @@ The @TeX{} specific unit names (@pxref{Predefined Units}) will not use
the @samp{tex} prefix; the unit name for a @TeX{} point will be
@samp{pt} instead of @samp{texpt}, for example.
-Function and variable names not treated specially by @TeX{} and La@TeX{}
+Function and variable names not treated specially by @TeX{} and @LaTeX{}
are simply written out as-is, which will cause them to come out in
italic letters in the printed document. If you invoke @kbd{d T} or
@kbd{d L} with a positive numeric prefix argument, names of more than
one character will instead be enclosed in a protective commands that
will prevent them from being typeset in the math italics; they will be
written @samp{\hbox@{@var{name}@}} in @TeX{} mode and
-@samp{\text@{@var{name}@}} in La@TeX{} mode. The
+@samp{\text@{@var{name}@}} in @LaTeX{} mode. The
@samp{\hbox@{ @}} and @samp{\text@{ @}} notations are ignored during
reading. If you use a negative prefix argument, such function names are
written @samp{\@var{name}}, and function names that begin with @code{\} during
@@ -14143,7 +14136,7 @@ any @TeX{} mode.)
During reading, text of the form @samp{\matrix@{ ...@: @}} is replaced
by @samp{[ ...@: ]}. The same also applies to @code{\pmatrix} and
-@code{\bmatrix}. In La@TeX{} mode this also applies to
+@code{\bmatrix}. In @LaTeX{} mode this also applies to
@samp{\begin@{matrix@} ... \end@{matrix@}},
@samp{\begin@{bmatrix@} ... \end@{bmatrix@}},
@samp{\begin@{pmatrix@} ... \end@{pmatrix@}}, as well as
@@ -14153,7 +14146,7 @@ and the symbols @samp{\cr} and @samp{\\} are interpreted as semicolons.
During output, matrices are displayed in @samp{\matrix@{ a & b \\ c & d@}}
format in @TeX{} mode and in
@samp{\begin@{pmatrix@} a & b \\ c & d \end@{pmatrix@}} format in
-La@TeX{} mode; you may need to edit this afterwards to change to your
+@LaTeX{} mode; you may need to edit this afterwards to change to your
preferred matrix form. If you invoke @kbd{d T} or @kbd{d L} with an
argument of 2 or -2, then matrices will be displayed in two-dimensional
form, such as
@@ -14177,7 +14170,7 @@ c & d
@end example
@noindent
-While this wouldn't bother Calc, it is incorrect La@TeX{}.
+While this wouldn't bother Calc, it is incorrect @LaTeX{}.
(Similarly for @TeX{}.)
Accents like @code{\tilde} and @code{\bar} translate into function
@@ -14185,7 +14178,7 @@ calls internally (@samp{tilde(x)}, @samp{bar(x)}). The @code{\underline}
sequence is treated as an accent. The @code{\vec} accent corresponds
to the function name @code{Vec}, because @code{vec} is the name of
a built-in Calc function. The following table shows the accents
-in Calc, @TeX{}, La@TeX{} and @dfn{eqn} (described in the next section):
+in Calc, @TeX{}, @LaTeX{} and @dfn{eqn} (described in the next section):
@ignore
@iftex
@@ -14362,7 +14355,7 @@ reading is:
@end example
Note that, because these symbols are ignored, reading a @TeX{} or
-La@TeX{} formula into Calc and writing it back out may lose spacing and
+@LaTeX{} formula into Calc and writing it back out may lose spacing and
font information.
Also, the ``discretionary multiplication sign'' @samp{\*} is read
@@ -14528,7 +14521,7 @@ treated the same as a space in @dfn{eqn} mode, as is the @samp{~}
symbol (these are used to introduce spaces of various widths into
the typeset output of @dfn{eqn}).
-As in La@TeX{} mode, Calc's formatter omits parentheses around the
+As in @LaTeX{} mode, Calc's formatter omits parentheses around the
arguments of functions like @code{ln} and @code{sin} if they are
``simple-looking''; in this case Calc surrounds the argument with
braces, separated by a @samp{~} from the function name: @samp{sin~@{x@}}.
@@ -14675,7 +14668,7 @@ Subscripts use double square brackets: @samp{a[[i]]}.
The @kbd{d W} (@code{calc-maple-language}) command selects the
conventions of Maple.
-Maple's language is much like C. Underscores are allowed in symbol
+Maple's language is much like C@. Underscores are allowed in symbol
names; square brackets are used for subscripts; explicit @samp{*}s for
multiplications are required. Use either @samp{^} or @samp{**} to
denote powers.
@@ -15665,7 +15658,7 @@ The exact sequence of events is as follows: When Calc tries a
rule, it first matches the pattern as usual. It then substitutes
@samp{#1}, @samp{#2}, etc., in the conditions, if any. Next, the
conditions are simplified and evaluated in order from left to right,
-as if by the @w{@kbd{a s}} algebra command (@pxref{Simplifying Formulas}).
+using the algebraic simplifications (@pxref{Simplifying Formulas}).
Each result is true if it is a nonzero number, or an expression
that can be proven to be nonzero (@pxref{Declarations}). If the
results of all conditions are true, the expression (such as
@@ -15893,8 +15886,8 @@ Default simplifications for numeric arguments only (@kbd{m N}).
@item BinSimp@var{w}
Binary-integer simplification mode; word size @var{w} (@kbd{m B}, @kbd{b w}).
-@item AlgSimp
-Algebraic simplification mode (@kbd{m A}).
+@item BasicSimp
+Basic simplification mode (@kbd{m I}).
@item ExtSimp
Extended algebraic simplification mode (@kbd{m E}).
@@ -15939,7 +15932,7 @@ FORTRAN language mode (@kbd{d F}).
@TeX{} language mode (@kbd{d T}; @pxref{TeX and LaTeX Language Modes}).
@item LaTeX
-La@TeX{} language mode (@kbd{d L}; @pxref{TeX and LaTeX Language Modes}).
+@LaTeX{} language mode (@kbd{d L}; @pxref{TeX and LaTeX Language Modes}).
@item Eqn
@dfn{Eqn} language mode (@kbd{d E}; @pxref{Eqn Language Mode}).
@@ -16733,10 +16726,10 @@ produced!) Integers and fractions are generally unaffected by this
operation. Vectors and formulas are cleaned by cleaning each component
number (i.e., pervasively).
-If the simplification mode is set below the default level, it is raised
-to the default level for the purposes of this command. Thus, @kbd{c c}
-applies the default simplifications even if their automatic application
-is disabled. @xref{Simplification Modes}.
+If the simplification mode is set below basic simplification, it is raised
+for the purposes of this command. Thus, @kbd{c c} applies the basic
+simplifications even if their automatic application is disabled.
+@xref{Simplification Modes}.
@cindex Roundoff errors, correcting
A numeric prefix argument to @kbd{c c} sets the floating-point precision
@@ -16813,7 +16806,7 @@ additional argument from the top of the stack.
@pindex calc-date
@tindex date
The @kbd{t D} (@code{calc-date}) [@code{date}] command converts a
-date form into a number, measured in days since Jan 1, 1 AD. The
+date form into a number, measured in days since Jan 1, 1 AD@. The
result will be an integer if @var{date} is a pure date form, or a
fraction or float if @var{date} is a date/time form. Or, if its
argument is a number, it converts this number into a date form.
@@ -16851,7 +16844,7 @@ The last two arguments default to zero if omitted.
@cindex Julian day counts, conversions
The @kbd{t J} (@code{calc-julian}) [@code{julian}] command converts
a date form into a Julian day count, which is the number of days
-since noon (GMT) on Jan 1, 4713 BC. A pure date is converted to an
+since noon (GMT) on Jan 1, 4713 BC@. A pure date is converted to an
integer Julian count representing noon of that day. A date/time form
is converted to an exact floating-point Julian count, adjusted to
interpret the date form in the current time zone but the Julian
@@ -18336,7 +18329,7 @@ of the current angular mode. @xref{Basic Operations on Units}.
Also, the symbolic variable @code{pi} is not ordinarily recognized in
arguments to trigonometric functions, as in @samp{sin(3 pi / 4)}, but
-the @kbd{a s} (@code{calc-simplify}) command recognizes many such
+the default algebraic simplifications recognize many such
formulas when the current angular mode is Radians @emph{and} Symbolic
mode is enabled; this example would be replaced by @samp{sqrt(2) / 2}.
@xref{Symbolic Mode}. Beware, this simplification occurs even if you
@@ -18345,7 +18338,7 @@ reason why changing built-in variables is a bad idea. Arguments of
the form @expr{x} plus a multiple of @cpiover{2} are also simplified.
Calc includes similar formulas for @code{cos} and @code{tan}.
-The @kbd{a s} command knows all angles which are integer multiples of
+Calc's algebraic simplifications know all angles which are integer multiples of
@cpiover{12}, @cpiover{10}, or @cpiover{8} radians. In Degrees mode,
analogous simplifications occur for integer multiples of 15 or 18
degrees, and for arguments plus multiples of 90 degrees.
@@ -18912,7 +18905,7 @@ Computer Programming}, Volume II, contains a thorough description
of the theory of random number generators and their measurement and
characterization.
-If @code{RandSeed} has no stored value, Calc calls Emacs' built-in
+If @code{RandSeed} has no stored value, Calc calls Emacs's built-in
@code{random} function to get a stream of random numbers, which it
then treats in various ways to avoid problems inherent in the simple
random number generators that many systems use to implement @code{random}.
@@ -18997,7 +18990,7 @@ modulo operation as numbers 39 and below.) If @var{m} is a power of
ten, however, the numbers should be completely unbiased.
The Gaussian random numbers generated by @samp{random(0.0)} use the
-``polar'' method described in Knuth section 3.4.1C. This method
+``polar'' method described in Knuth section 3.4.1C@. This method
generates a pair of Gaussian random numbers at a time, so only every
other call to @samp{random(0.0)} will require significant calculations.
@@ -22075,8 +22068,8 @@ as well as equations.
@pindex calc-sel-div-both-sides
The @kbd{j *} (@code{calc-sel-mult-both-sides}) command prompts for a
formula using algebraic entry, then multiplies both sides of the
-selected quotient or equation by that formula. It simplifies each
-side with @kbd{a s} (@code{calc-simplify}) before re-forming the
+selected quotient or equation by that formula. It performs the
+default algebraic simplifications before re-forming the
quotient or equation. You can suppress this simplification by
providing a prefix argument: @kbd{C-u j *}. There is also a @kbd{j /}
(@code{calc-sel-div-both-sides}) which is similar to @kbd{j *} but
@@ -22143,15 +22136,15 @@ now to take the cosine of the selected part.)
@kindex j v
@pindex calc-sel-evaluate
The @kbd{j v} (@code{calc-sel-evaluate}) command performs the
-normal default simplifications on the selected sub-formula.
-These are the simplifications that are normally done automatically
-on all results, but which may have been partially inhibited by
+basic simplifications on the selected sub-formula.
+These simplifications would normally be done automatically
+on all results, but may have been partially inhibited by
previous selection-related operations, or turned off altogether
by the @kbd{m O} command. This command is just an auto-selecting
version of the @w{@kbd{a v}} command (@pxref{Algebraic Manipulation}).
With a numeric prefix argument of 2, @kbd{C-u 2 j v} applies
-the @kbd{a s} (@code{calc-simplify}) command to the selected
+the default algebraic simplifications to the selected
sub-formula. With a prefix argument of 3 or more, e.g., @kbd{C-u j v}
applies the @kbd{a e} (@code{calc-simplify-extended}) command.
@xref{Simplifying Formulas}. With a negative prefix argument
@@ -22195,9 +22188,9 @@ but which also substitutes stored values for variables in the formula.
Use @kbd{a v} if you want the variables to ignore their stored values.
If you give a numeric prefix argument of 2 to @kbd{a v}, it simplifies
-as if in Algebraic Simplification mode. This is equivalent to typing
-@kbd{a s}; @pxref{Simplifying Formulas}. If you give a numeric prefix
-of 3 or more, it uses Extended Simplification mode (@kbd{a e}).
+using Calc's algebraic simplifications; @pxref{Simplifying Formulas}.
+If you give a numeric prefix of 3 or more, it uses Extended
+Simplification mode (@kbd{a e}).
If you give a negative prefix argument @mathit{-1}, @mathit{-2}, or @mathit{-3},
it simplifies in the corresponding mode but only works on the top-level
@@ -22270,8 +22263,8 @@ If inequalities with opposite direction (e.g., @samp{<} and @samp{>})
are mapped, the direction of the second inequality is reversed to
match the first: Using @kbd{a M +} on @samp{a < b} and @samp{a > 2}
reverses the latter to get @samp{2 < a}, which then allows the
-combination @samp{a + 2 < b + a}, which the @kbd{a s} command can
-then simplify to get @samp{2 < b}.
+combination @samp{a + 2 < b + a}, which the algebraic simplifications
+can reduce to @samp{2 < b}.
Using @kbd{a M *}, @kbd{a M /}, @kbd{a M n}, or @kbd{a M &} to negate
or invert an inequality will reverse the direction of the inequality.
@@ -22340,15 +22333,8 @@ turn the default simplifications off first (with @kbd{m O}).
@kindex H a s
@pindex calc-simplify
@tindex simplify
-The @kbd{a s} (@code{calc-simplify}) [@code{simplify}] command applies
-various algebraic rules to simplify a formula. This includes rules which
-are not part of the default simplifications because they may be too slow
-to apply all the time, or may not be desirable all of the time. For
-example, non-adjacent terms of sums are combined, as in @samp{a + b + 2 a}
-to @samp{b + 3 a}, and some formulas like @samp{sin(arcsin(x))} are
-simplified to @samp{x}.
-
-The sections below describe all the various kinds of algebraic
+
+The sections below describe all the various kinds of
simplifications Calc provides in full detail. None of Calc's
simplification commands are designed to pull rabbits out of hats;
they simply apply certain specific rules to put formulas into
@@ -22358,17 +22344,20 @@ and rewrite rules. @xref{Rearranging with Selections}.
@xref{Rewrite Rules}.
@xref{Simplification Modes}, for commands to control what level of
-simplification occurs automatically. Normally only the ``default
-simplifications'' occur.
+simplification occurs automatically. Normally the algebraic
+simplifications described below occur. If you have turned on a
+simplification mode which does not do these algebraic simplifications,
+you can still apply them to a formula with the @kbd{a s}
+(@code{calc-simplify}) [@code{simplify}] command.
There are some simplifications that, while sometimes useful, are never
done automatically. For example, the @kbd{I} prefix can be given to
@kbd{a s}; the @kbd{I a s} command will change any trigonometric
function to the appropriate combination of @samp{sin}s and @samp{cos}s
before simplifying. This can be useful in simplifying even mildly
-complicated trigonometric expressions. For example, while @kbd{a s}
-can reduce @samp{sin(x) csc(x)} to @samp{1}, it will not simplify
-@samp{sin(x)^2 csc(x)}. The command @kbd{I a s} can be used to
+complicated trigonometric expressions. For example, while the algebraic
+simplifications can reduce @samp{sin(x) csc(x)} to @samp{1}, they will not
+simplify @samp{sin(x)^2 csc(x)}. The command @kbd{I a s} can be used to
simplify this latter expression; it will transform @samp{sin(x)^2
csc(x)} into @samp{sin(x)}. However, @kbd{I a s} will also perform
some ``simplifications'' which may not be desired; for example, it
@@ -22379,29 +22368,24 @@ combinations of @samp{sinh}s and @samp{cosh}s before simplifying.
@menu
-* Default Simplifications::
+* Basic Simplifications::
* Algebraic Simplifications::
* Unsafe Simplifications::
* Simplification of Units::
@end menu
-@node Default Simplifications, Algebraic Simplifications, Simplifying Formulas, Simplifying Formulas
-@subsection Default Simplifications
+@node Basic Simplifications, Algebraic Simplifications, Simplifying Formulas, Simplifying Formulas
+@subsection Basic Simplifications
@noindent
-@cindex Default simplifications
-This section describes the ``default simplifications,'' those which are
-normally applied to all results. For example, if you enter the variable
-@expr{x} on the stack twice and push @kbd{+}, Calc's default
-simplifications automatically change @expr{x + x} to @expr{2 x}.
-
-The @kbd{m O} command turns off the default simplifications, so that
-@expr{x + x} will remain in this form unless you give an explicit
-``simplify'' command like @kbd{=} or @kbd{a v}. @xref{Algebraic
-Manipulation}. The @kbd{m D} command turns the default simplifications
-back on.
+@cindex Basic simplifications
+This section describes basic simplifications which Calc performs in many
+situations. For example, both binary simplifications and algebraic
+simplifications begin by performing these basic simplifications. You
+can type @kbd{m I} to restrict the simplifications done on the stack to
+these simplifications.
-The most basic default simplification is the evaluation of functions.
+The most basic simplification is the evaluation of functions.
For example, @expr{2 + 3} is evaluated to @expr{5}, and @expr{@tfn{sqrt}(9)}
is evaluated to @expr{3}. Evaluation does not occur if the arguments
to a function are somehow of the wrong type @expr{@tfn{tan}([2,3,4])}),
@@ -22419,16 +22403,17 @@ operator) do not evaluate their arguments, @code{if} (the @code{? :}
operator) does not evaluate all of its arguments, and @code{evalto}
does not evaluate its lefthand argument.
-Most commands apply the default simplifications to all arguments they
-take from the stack, perform a particular operation, then simplify
-the result before pushing it back on the stack. In the common special
-case of regular arithmetic commands like @kbd{+} and @kbd{Q} [@code{sqrt}],
-the arguments are simply popped from the stack and collected into a
-suitable function call, which is then simplified (the arguments being
-simplified first as part of the process, as described above).
-
-The default simplifications are too numerous to describe completely
-here, but this section will describe the ones that apply to the
+Most commands apply at least these basic simplifications to all
+arguments they take from the stack, perform a particular operation,
+then simplify the result before pushing it back on the stack. In the
+common special case of regular arithmetic commands like @kbd{+} and
+@kbd{Q} [@code{sqrt}], the arguments are simply popped from the stack
+and collected into a suitable function call, which is then simplified
+(the arguments being simplified first as part of the process, as
+described above).
+
+Even the basic set of simplifications are too numerous to describe
+completely here, but this section will describe the ones that apply to the
major arithmetic operators. This list will be rather technical in
nature, and will probably be interesting to you only if you are
a serious user of Calc's algebra facilities.
@@ -22439,14 +22424,14 @@ a serious user of Calc's algebra facilities.
As well as the simplifications described here, if you have stored
any rewrite rules in the variable @code{EvalRules} then these rules
-will also be applied before any built-in default simplifications.
+will also be applied before any of the basic simplifications.
@xref{Automatic Rewrites}, for details.
@tex
\bigskip
@end tex
-And now, on with the default simplifications:
+And now, on with the basic simplifications:
Arithmetic operators like @kbd{+} and @kbd{*} always take two
arguments in Calc's internal form. Sums and products of three or
@@ -22465,11 +22450,11 @@ commutative law (@expr{a + b} to @expr{b + a}) except in a few
special cases described below. Some algebra programs always
rearrange terms into a canonical order, which enables them to
see that @expr{a b + b a} can be simplified to @expr{2 a b}.
-Calc assumes you have put the terms into the order you want
-and generally leaves that order alone, with the consequence
-that formulas like the above will only be simplified if you
-explicitly give the @kbd{a s} command. @xref{Algebraic
-Simplifications}.
+If you are using Basic Simplification mode, Calc assumes you have put
+the terms into the order you want and generally leaves that order alone,
+with the consequence that formulas like the above will only be
+simplified if you explicitly give the @kbd{a s} command.
+@xref{Algebraic Simplifications}.
Differences @expr{a - b} are treated like sums @expr{a + (-b)}
for purposes of simplification; one of the default simplifications
@@ -22500,9 +22485,8 @@ for adjacent terms in a larger sum. Thus @expr{a + b + b + c}
is simplified to @expr{a + 2 b + c}, but @expr{a + b + c + b}
is not simplified. The reason is that comparing all terms of a
sum with one another would require time proportional to the
-square of the number of terms; Calc relegates potentially slow
-operations like this to commands that have to be invoked
-explicitly, like @kbd{a s}.
+square of the number of terms; Calc omits potentially slow
+operations like this in basic simplification mode.
Finally, @expr{a + 0} and @expr{0 + a} are simplified to @expr{a}.
A consequence of the above rules is that @expr{0 - a} is simplified
@@ -22699,9 +22683,9 @@ and @expr{b} are known to be real.
Functions like @code{sin} and @code{arctan} generally don't have
any default simplifications beyond simply evaluating the functions
-for suitable numeric arguments and infinity. The @kbd{a s} command
-described in the next section does provide some simplifications for
-these functions, though.
+for suitable numeric arguments and infinity. The algebraic
+simplifications described in the next section do provide some
+simplifications for these functions, though.
One important simplification that does occur is that
@expr{@tfn{ln}(@tfn{e})} is simplified to 1, and @expr{@tfn{ln}(@tfn{e}^x)} is
@@ -22716,33 +22700,31 @@ and reversing the inequality. While it might seem reasonable to simplify
@expr{!!x} to @expr{x}, this would not be valid in general because
@expr{!!2} is 1, not 2.
-Most other Calc functions have few if any default simplifications
+Most other Calc functions have few if any basic simplifications
defined, aside of course from evaluation when the arguments are
suitable numbers.
-@node Algebraic Simplifications, Unsafe Simplifications, Default Simplifications, Simplifying Formulas
+@node Algebraic Simplifications, Unsafe Simplifications, Basic Simplifications, Simplifying Formulas
@subsection Algebraic Simplifications
@noindent
@cindex Algebraic simplifications
-The @kbd{a s} command makes simplifications that may be too slow to
-do all the time, or that may not be desirable all of the time.
-If you find these simplifications are worthwhile, you can type
-@kbd{m A} to have Calc apply them automatically.
-
+@kindex a s
+@kindex m A
This section describes all simplifications that are performed by
-the @kbd{a s} command. Note that these occur in addition to the
-default simplifications; even if the default simplifications have
-been turned off by an @kbd{m O} command, @kbd{a s} will turn them
-back on temporarily while it simplifies the formula.
+the algebraic simplification mode, which is the default simplification
+mode. If you have switched to a different simplification mode, you can
+switch back with the @kbd{m A} command. Even in other simplification
+modes, the @kbd{a s} command will use these algebraic simplifications to
+simplify the formula.
There is a variable, @code{AlgSimpRules}, in which you can put rewrites
-to be applied by @kbd{a s}. Its use is analogous to @code{EvalRules},
+to be applied. Its use is analogous to @code{EvalRules},
but without the special restrictions. Basically, the simplifier does
@samp{@w{a r} AlgSimpRules} with an infinite repeat count on the whole
expression being simplified, then it traverses the expression applying
the built-in rules described below. If the result is different from
-the original expression, the process repeats with the default
+the original expression, the process repeats with the basic
simplifications (including @code{EvalRules}), then @code{AlgSimpRules},
then the built-in simplifications, and so on.
@@ -22758,8 +22740,8 @@ commuted to @expr{-x + 2}.
Also, terms of sums are combined by the distributive law, as in
@expr{x + y + 2 x} to @expr{y + 3 x}. This always occurs for
-adjacent terms, but @kbd{a s} compares all pairs of terms including
-non-adjacent ones.
+adjacent terms, but Calc's algebraic simplifications compare all pairs
+of terms including non-adjacent ones.
@tex
\bigskip
@@ -22767,11 +22749,11 @@ non-adjacent ones.
Products are sorted into a canonical order using the commutative
law. For example, @expr{b c a} is commuted to @expr{a b c}.
-This allows easier comparison of products; for example, the default
+This allows easier comparison of products; for example, the basic
simplifications will not change @expr{x y + y x} to @expr{2 x y},
-but @kbd{a s} will; it first rewrites the sum to @expr{x y + x y},
-and then the default simplifications are able to recognize a sum
-of identical terms.
+but the algebraic simplifications; it first rewrites the sum to
+@expr{x y + x y} which can then be recognized as a sum of identical
+terms.
The canonical ordering used to sort terms of products has the
property that real-valued numbers, interval forms and infinities
@@ -22813,10 +22795,11 @@ as described above.) If there is any common integer or fractional
factor in the numerator and denominator, it is canceled out;
for example, @expr{(4 x + 6) / 8 x} simplifies to @expr{(2 x + 3) / 4 x}.
-Non-constant common factors are not found even by @kbd{a s}. To
-cancel the factor @expr{a} in @expr{(a x + a) / a^2} you could first
-use @kbd{j M} on the product @expr{a x} to Merge the numerator to
-@expr{a (1+x)}, which can then be simplified successfully.
+Non-constant common factors are not found even by algebraic
+simplifications. To cancel the factor @expr{a} in
+@expr{(a x + a) / a^2} you could first use @kbd{j M} on the product
+@expr{a x} to Merge the numerator to @expr{a (1+x)}, which can then be
+simplified successfully.
@tex
\bigskip
@@ -22825,11 +22808,10 @@ use @kbd{j M} on the product @expr{a x} to Merge the numerator to
Integer powers of the variable @code{i} are simplified according
to the identity @expr{i^2 = -1}. If you store a new value other
than the complex number @expr{(0,1)} in @code{i}, this simplification
-will no longer occur. This is done by @kbd{a s} instead of by default
-in case someone (unwisely) uses the name @code{i} for a variable
-unrelated to complex numbers; it would be unfortunate if Calc
-quietly and automatically changed this formula for reasons the
-user might not have been thinking of.
+will no longer occur. This is not done by the basic
+simplifications; in case someone (unwisely) wants to use the name
+@code{i} for a variable unrelated to complex numbers, they can use
+basic simplification mode.
Square roots of integer or rational arguments are simplified in
several ways. (Note that these will be left unevaluated only in
@@ -22962,21 +22944,26 @@ as is @expr{x^2 >= 0} if @expr{x} is known to be real.
@cindex Unsafe simplifications
@cindex Extended simplification
@kindex a e
+@kindex m E
@pindex calc-simplify-extended
@ignore
@mindex esimpl@idots
@end ignore
@tindex esimplify
-The @kbd{a e} (@code{calc-simplify-extended}) [@code{esimplify}] command
-is like @kbd{a s}
-except that it applies some additional simplifications which are not
-``safe'' in all cases. Use this only if you know the values in your
-formula lie in the restricted ranges for which these simplifications
-are valid. The symbolic integrator uses @kbd{a e};
-one effect of this is that the integrator's results must be used with
-caution. Where an integral table will often attach conditions like
-``for positive @expr{a} only,'' Calc (like most other symbolic
-integration programs) will simply produce an unqualified result.
+Calc is capable of performing some simplifications which may sometimes
+be desired but which are not ``safe'' in all cases. The @kbd{a e}
+(@code{calc-simplify-extended}) [@code{esimplify}] command
+applies the algebraic simplifications as well as these extended, or
+``unsafe'', simplifications. Use this only if you know the values in
+your formula lie in the restricted ranges for which these
+simplifications are valid. You can use Extended Simplification mode
+(@kbd{m E}) to have these simplifications done automatically.
+
+The symbolic integrator uses these extended simplifications; one effect
+of this is that the integrator's results must be used with caution.
+Where an integral table will often attach conditions like ``for positive
+@expr{a} only,'' Calc (like most other symbolic integration programs)
+will simply produce an unqualified result.
Because @kbd{a e}'s simplifications are unsafe, it is sometimes better
to type @kbd{C-u -3 a v}, which does extended simplification only
@@ -22984,21 +22971,20 @@ on the top level of the formula without affecting the sub-formulas.
In fact, @kbd{C-u -3 j v} allows you to target extended simplification
to any specific part of a formula.
-The variable @code{ExtSimpRules} contains rewrites to be applied by
-the @kbd{a e} command. These are applied in addition to
+The variable @code{ExtSimpRules} contains rewrites to be applied when
+the extended simplifications are used. These are applied in addition to
@code{EvalRules} and @code{AlgSimpRules}. (The @kbd{a r AlgSimpRules}
step described above is simply followed by an @kbd{a r ExtSimpRules} step.)
-Following is a complete list of ``unsafe'' simplifications performed
-by @kbd{a e}.
+Following is a complete list of the ``unsafe'' simplifications.
@tex
\bigskip
@end tex
Inverse trigonometric or hyperbolic functions, called with their
-corresponding non-inverse functions as arguments, are simplified
-by @kbd{a e}. For example, @expr{@tfn{arcsin}(@tfn{sin}(x))} changes
+corresponding non-inverse functions as arguments, are simplified.
+For example, @expr{@tfn{arcsin}(@tfn{sin}(x))} changes
to @expr{x}. Also, @expr{@tfn{arcsin}(@tfn{cos}(x))} and
@expr{@tfn{arccos}(@tfn{sin}(x))} both change to @expr{@tfn{pi}/2 - x}.
These simplifications are unsafe because they are valid only for
@@ -23038,8 +23024,8 @@ simplifications are safe if @expr{x} is known to be real).
Common factors are canceled from products on both sides of an
equation, even if those factors may be zero: @expr{a x / b x}
to @expr{a / b}. Such factors are never canceled from
-inequalities: Even @kbd{a e} is not bold enough to reduce
-@expr{a x < b x} to @expr{a < b} (or @expr{a > b}, depending
+inequalities: Even the extended simplifications are not bold enough to
+reduce @expr{a x < b x} to @expr{a < b} (or @expr{a > b}, depending
on whether you believe @expr{x} is positive or negative).
The @kbd{a M /} command can be used to divide a factor out of
both sides of an inequality.
@@ -23048,13 +23034,14 @@ both sides of an inequality.
@subsection Simplification of Units
@noindent
-The simplifications described in this section are applied by the
-@kbd{u s} (@code{calc-simplify-units}) command. These are in addition
-to the regular @kbd{a s} (but not @kbd{a e}) simplifications described
-earlier. @xref{Basic Operations on Units}.
+The simplifications described in this section (as well as the algebraic
+simplifications) are applied when units need to be simplified. They can
+be applied using the @kbd{u s} (@code{calc-simplify-units}) command, or
+will be done automatically in Units Simplification mode (@kbd{m U}).
+@xref{Basic Operations on Units}.
The variable @code{UnitSimpRules} contains rewrites to be applied by
-the @kbd{u s} command. These are applied in addition to @code{EvalRules}
+units simplifications. These are applied in addition to @code{EvalRules}
and @code{AlgSimpRules}.
Scalar mode is automatically put into effect when simplifying units.
@@ -23608,10 +23595,11 @@ forever!)
@vindex IntegSimpRules
Another set of rules, stored in @code{IntegSimpRules}, are applied
-every time the integrator uses @kbd{a s} to simplify an intermediate
-result. For example, putting the rule @samp{twice(x) := 2 x} into
-@code{IntegSimpRules} would tell Calc to convert the @code{twice}
-function into a form it knows whenever integration is attempted.
+every time the integrator uses algebraic simplifications to simplify an
+intermediate result. For example, putting the rule
+@samp{twice(x) := 2 x} into @code{IntegSimpRules} would tell Calc to
+convert the @code{twice} function into a form it knows whenever
+integration is attempted.
One more way to influence the integrator is to define a function with
the @kbd{Z F} command (@pxref{Algebraic Definitions}). Calc's
@@ -23629,8 +23617,8 @@ above to try to hint at a more direct path to the desired result, or
you can use @code{IntegAfterRules}. This is an extra rule set that
runs after the main integrator returns its result; basically, Calc does
an @kbd{a r IntegAfterRules} on the result before showing it to you.
-(It also does an @kbd{a s}, without @code{IntegSimpRules}, after that
-to further simplify the result.) For example, Calc's integrator
+(It also does algebraic simplifications, without @code{IntegSimpRules},
+after that to further simplify the result.) For example, Calc's integrator
sometimes produces expressions of the form @samp{ln(1+x) - ln(1-x)};
the default @code{IntegAfterRules} rewrite this into the more readable
form @samp{2 arctanh(x)}. Note that, unlike @code{IntegRules},
@@ -25441,7 +25429,7 @@ The limits of a sum do not need to be integers. For example,
@samp{sum(a_k, k, 0, 2 n, n)} produces @samp{a_0 + a_n + a_(2 n)}.
Calc computes the number of iterations using the formula
@samp{1 + (@var{high} - @var{low}) / @var{step}}, which must,
-after simplification as if by @kbd{a s}, evaluate to an integer.
+after algebraic simplification, evaluate to an integer.
If the number of iterations according to the above formula does
not come out to an integer, the sum is invalid and will be left
@@ -26065,7 +26053,7 @@ rule, this is an additional condition that must be satisfied before
the rule is accepted. Once @var{old} has been successfully matched
to the target expression, @var{cond} is evaluated (with all the
meta-variables substituted for the values they matched) and simplified
-with @kbd{a s} (@code{calc-simplify}). If the result is a nonzero
+with Calc's algebraic simplifications. If the result is a nonzero
number or any other object known to be nonzero (@pxref{Declarations}),
the rule is accepted. If the result is zero or if it is a symbolic
formula that is not known to be nonzero, the rule is rejected.
@@ -26745,7 +26733,7 @@ whereas @samp{eval(cons(2+3, []))} will be converted to @samp{[5]}.
@end ignore
@tindex evalsimp
The formula @expr{x} has meta-variables substituted in the usual
-way, then algebraically simplified as if by the @kbd{a s} command.
+way, then algebraically simplified.
@item evalextsimp(x)
@ignore
@@ -26768,15 +26756,15 @@ There are also some special functions you can use in conditions.
@end ignore
@tindex let
The expression @expr{x} is evaluated with meta-variables substituted.
-The @kbd{a s} command's simplifications are @emph{not} applied by
+The algebraic simplifications are @emph{not} applied by
default, but @expr{x} can include calls to @code{evalsimp} or
@code{evalextsimp} as described above to invoke higher levels
-of simplification. The
-result of @expr{x} is then bound to the meta-variable @expr{v}. As
-usual, if this meta-variable has already been matched to something
-else the two values must be equal; if the meta-variable is new then
-it is bound to the result of the expression. This variable can then
-appear in later conditions, and on the righthand side of the rule.
+of simplification. The result of @expr{x} is then bound to the
+meta-variable @expr{v}. As usual, if this meta-variable has already
+been matched to something else the two values must be equal; if the
+meta-variable is new then it is bound to the result of the expression.
+This variable can then appear in later conditions, and on the righthand
+side of the rule.
In fact, @expr{v} may be any pattern in which case the result of
evaluating @expr{x} is matched to that pattern, binding any
meta-variables that appear in that pattern. Note that @code{let}
@@ -27526,17 +27514,19 @@ with @code{apply} as the top-level pattern must be tested against
@cindex @code{AlgSimpRules} variable
@vindex AlgSimpRules
Suppose you want @samp{sin(a + b)} to be expanded out not all the time,
-but only when @kbd{a s} is used to simplify the formula. The variable
-@code{AlgSimpRules} holds rules for this purpose. The @kbd{a s} command
-will apply @code{EvalRules} and @code{AlgSimpRules} to the formula, as
-well as all of its built-in simplifications.
+but only when algebraic simplifications are used to simplify the
+formula. The variable @code{AlgSimpRules} holds rules for this purpose.
+The @kbd{a s} command will apply @code{EvalRules} and
+@code{AlgSimpRules} to the formula, as well as all of its built-in
+simplifications.
Most of the special limitations for @code{EvalRules} don't apply to
@code{AlgSimpRules}. Calc simply does an @kbd{a r AlgSimpRules}
-command with an infinite repeat count as the first step of @kbd{a s}.
-It then applies its own built-in simplifications throughout the
-formula, and then repeats these two steps (along with applying the
-default simplifications) until no further changes are possible.
+command with an infinite repeat count as the first step of algebraic
+simplifications. It then applies its own built-in simplifications
+throughout the formula, and then repeats these two steps (along with
+applying the default simplifications) until no further changes are
+possible.
@cindex @code{ExtSimpRules} variable
@cindex @code{UnitSimpRules} variable
@@ -27716,7 +27706,7 @@ to hit the apostrophe key every time you wish to enter units.
@tindex usimplify
The @kbd{u s} (@code{calc-simplify-units}) [@code{usimplify}] command
simplifies a units
-expression. It uses @kbd{a s} (@code{calc-simplify}) to simplify the
+expression. It uses Calc's algebraic simplifications to simplify the
expression first as a regular algebraic formula; it then looks for
features that can be further simplified by converting one object's units
to be compatible with another's. For example, @samp{5 m + 23 mm} will
@@ -27778,6 +27768,11 @@ acres per meter-second.) Remainder units are expressed in terms of
``fundamental'' units like @samp{m} and @samp{s}, regardless of the
input units.
+If you want to disallow using inconsistent units, you can set the customizable variable
+@code{calc-ensure-consistent-units} to @code{t} (@pxref{Customizing Calc}). In this case,
+if you request units which are inconsistent with the original units, you will be warned about
+it and no conversion will occur.
+
One special exception is that if you specify a single unit name, and
a compatible unit appears somewhere in the units expression, then
that compatible unit will be converted to the new unit and the
@@ -27997,7 +27992,7 @@ than the point used by @TeX{}), @code{texdd} (a Didot point),
@code{texcc} (a Cicero) and @code{texsp} (a scaled @TeX{} point,
all dimensions representable in @TeX{} are multiples of this value).
-When Calc is using the @TeX{} or La@TeX{} language mode (@pxref{TeX
+When Calc is using the @TeX{} or @LaTeX{} language mode (@pxref{TeX
and LaTeX Language Modes}), the @TeX{} specific unit names will not
use the @samp{tex} prefix; the unit name for a @TeX{} point will be
@samp{pt} instead of @samp{texpt}, for example. To avoid conflicts,
@@ -28795,7 +28790,7 @@ Edit @code{AlgSimpRules}. @xref{Algebraic Simplifications}.
@item s D
Edit @code{Decls}. @xref{Declarations}.
@item s E
-Edit @code{EvalRules}. @xref{Default Simplifications}.
+Edit @code{EvalRules}. @xref{Basic Simplifications}.
@item s F
Edit @code{FitRules}. @xref{Curve Fitting}.
@item s G
@@ -28906,7 +28901,7 @@ since the evaluation step will also evaluate @code{pi}.
@cindex @samp{=>} operator
The special algebraic symbol @samp{=>} is known as the @dfn{evaluates-to
operator}. (It will show up as an @code{evalto} function call in
-other language modes like Pascal and La@TeX{}.) This is a binary
+other language modes like Pascal and @LaTeX{}.) This is a binary
operator, that is, it has a lefthand and a righthand argument,
although it can be entered with the righthand argument omitted.
@@ -28965,19 +28960,16 @@ to select the lefthand side, execute your commands, then type
All current modes apply when an @samp{=>} operator is computed,
including the current simplification mode. Recall that the
-formula @samp{x + y + x} is not handled by Calc's default
-simplifications, but the @kbd{a s} command will reduce it to
-the simpler form @samp{y + 2 x}. You can also type @kbd{m A}
-to enable an Algebraic Simplification mode in which the
-equivalent of @kbd{a s} is used on all of Calc's results.
-If you enter @samp{x + y + x =>} normally, the result will
-be @samp{x + y + x => x + y + x}. If you change to
-Algebraic Simplification mode, the result will be
-@samp{x + y + x => y + 2 x}. However, just pressing @kbd{a s}
-once will have no effect on @samp{x + y + x => x + y + x},
+formula @samp{arcsin(sin(x))} will not be handled by Calc's algebraic
+simplifications, but Calc's unsafe simplifications will reduce it to
+@samp{x}. If you enter @samp{arcsin(sin(x)) =>} normally, the result
+will be @samp{arcsin(sin(x)) => arcsin(sin(x))}. If you change to
+Extended Simplification mode, the result will be
+@samp{arcsin(sin(x)) => x}. However, just pressing @kbd{a e}
+once will have no effect on @samp{arcsin(sin(x)) => arcsin(sin(x))},
because the righthand side depends only on the lefthand side
and the current mode settings, and the lefthand side is not
-affected by commands like @kbd{a s}.
+affected by commands like @kbd{a e}.
The ``let'' command (@kbd{s l}) has an interesting interaction
with the @samp{=>} operator. The @kbd{s l} command evaluates the
@@ -29589,7 +29581,7 @@ plot on any text-only printer.
@kindex g O
@pindex calc-graph-output
The @kbd{g O} (@code{calc-graph-output}) command sets the name of the
-output file used by GNUPLOT. For some devices, notably @code{x11} and
+output file used by GNUPLOT@. For some devices, notably @code{x11} and
@code{windows}, there is no output file and this information is not
used. Many other ``devices'' are really file formats like
@code{postscript}; in these cases the output in the desired format
@@ -29661,7 +29653,7 @@ window in the upper-left corner of the screen. This command has no
effect if the current device is @code{windows}.
The buffer called @samp{*Gnuplot Trail*} holds a transcript of the
-session with GNUPLOT. This shows the commands Calc has ``typed'' to
+session with GNUPLOT@. This shows the commands Calc has ``typed'' to
GNUPLOT and the responses it has received. Calc tries to notice when an
error message has appeared here and display the buffer for you when
this happens. You can check this buffer yourself if you suspect
@@ -30485,7 +30477,7 @@ are visiting your own files.
Calc will try to guess an appropriate language based on the major mode
of the editing buffer. (@xref{Language Modes}.) If the current buffer is
-in @code{latex-mode}, for example, Calc will set its language to La@TeX{}.
+in @code{latex-mode}, for example, Calc will set its language to @LaTeX{}.
Similarly, Calc will use @TeX{} language for @code{tex-mode},
@code{plain-tex-mode} and @code{context-mode}, C language for
@code{c-mode} and @code{c++-mode}, FORTRAN language for
@@ -30502,7 +30494,7 @@ understands are:
@enumerate
@item
-The @TeX{} and La@TeX{} math delimiters @samp{$ $}, @samp{$$ $$},
+The @TeX{} and @LaTeX{} math delimiters @samp{$ $}, @samp{$$ $$},
@samp{\[ \]}, and @samp{\( \)};
@item
Lines beginning with @samp{\begin} and @samp{\end} (except matrix delimiters);
@@ -30642,14 +30634,14 @@ you haven't done anything with this formula yet.
When Embedded mode ``activates'' a formula, i.e., when it examines
the formula for the first time since the buffer was created or
loaded, Calc tries to sense the language in which the formula was
-written. If the formula contains any La@TeX{}-like @samp{\} sequences,
-it is parsed (i.e., read) in La@TeX{} mode. If the formula appears to
+written. If the formula contains any @LaTeX{}-like @samp{\} sequences,
+it is parsed (i.e., read) in @LaTeX{} mode. If the formula appears to
be written in multi-line Big mode, it is parsed in Big mode. Otherwise,
it is parsed according to the current language mode.
Note that Calc does not change the current language mode according
-the formula it reads in. Even though it can read a La@TeX{} formula when
-not in La@TeX{} mode, it will immediately rewrite this formula using
+the formula it reads in. Even though it can read a @LaTeX{} formula when
+not in @LaTeX{} mode, it will immediately rewrite this formula using
whatever language mode is in effect.
@tex
@@ -30670,8 +30662,8 @@ version.
Plain formulas are preceded and followed by @samp{%%%} signs
by default. This notation has the advantage that the @samp{%}
-character begins a comment in @TeX{} and La@TeX{}, so if your formula is
-embedded in a @TeX{} or La@TeX{} document its plain version will be
+character begins a comment in @TeX{} and @LaTeX{}, so if your formula is
+embedded in a @TeX{} or @LaTeX{} document its plain version will be
invisible in the final printed copy. Certain major modes have different
delimiters to ensure that the ``plain'' version will be
in a comment for those modes, also.
@@ -30957,7 +30949,7 @@ a few lines that look like this:
@noindent
where the leading and trailing @samp{---} can be replaced by
any suitable strings (which must be the same on all three lines)
-or omitted altogether; in a @TeX{} or La@TeX{} file, @samp{%} would be a good
+or omitted altogether; in a @TeX{} or @LaTeX{} file, @samp{%} would be a good
leading string and no trailing string would be necessary. In a
C program, @samp{/*} and @samp{*/} would be good leading and
trailing strings.
@@ -33272,7 +33264,7 @@ in the range @samp{[0 ..@: 60)}.
Date forms are stored as @samp{(date @var{n})}, where @var{n} is
a real number that counts days since midnight on the morning of
-January 1, 1 AD. If @var{n} is an integer, this is a pure date
+January 1, 1 AD@. If @var{n} is an integer, this is a pure date
form. If @var{n} is a fraction or float, this is a date/time form.
Modulo forms are stored as @samp{(mod @var{n} @var{m})}, where @var{m} is a
@@ -33778,8 +33770,9 @@ will be the same as @code{lessp}. But whereas @code{lessp} considers
other types of objects to be unordered, @code{beforep} puts any two
objects into a definite, consistent order. The @code{beforep}
function is used by the @kbd{V S} vector-sorting command, and also
-by @kbd{a s} to put the terms of a product into canonical order:
-This allows @samp{x y + y x} to be simplified easily to @samp{2 x y}.
+by Calc's algebraic simplifications to put the terms of a product into
+canonical order: This allows @samp{x y + y x} to be simplified easily to
+@samp{2 x y}.
@end defun
@defun equal x y
@@ -34448,10 +34441,9 @@ sub-formula that is @code{eq} to @var{old} replaced by @var{new}.
@end defun
@defun simplify expr
-Simplify the expression @var{expr} by applying various algebraic rules.
-This is what the @w{@kbd{a s}} (@code{calc-simplify}) command uses. This
-always returns a copy of the expression; the structure @var{expr} points
-to remains unchanged in memory.
+Simplify the expression @var{expr} by applying Calc's algebraic
+simplifications. This always returns a copy of the expression; the
+structure @var{expr} points to remains unchanged in memory.
More precisely, here is what @code{simplify} does: The expression is
first normalized and evaluated by calling @code{normalize}. If any
@@ -35387,7 +35379,7 @@ The simplest delimiters are blank lines. Other delimiters that
Embedded mode understands by default are:
@enumerate
@item
-The @TeX{} and La@TeX{} math delimiters @samp{$ $}, @samp{$$ $$},
+The @TeX{} and @LaTeX{} math delimiters @samp{$ $}, @samp{$$ $$},
@samp{\[ \]}, and @samp{\( \)};
@item
Lines beginning with @samp{\begin} and @samp{\end} (except matrix delimiters);
@@ -35591,6 +35583,19 @@ as @samp{a/(b*c)}. If @code{calc-multiplication-has-precedence} is
of @code{calc-multiplication-has-precedence} is @code{t}.
@end defvar
+@defvar calc-ensure-consistent-units
+When converting units, the variable @code{calc-ensure-consistent-units}
+determines whether or not the target units need to be consistent with the
+original units. If @code{calc-ensure-consistent-units} is @code{nil}, then
+the target units don't need to have the same dimensions as the original units;
+for example, converting @samp{100 ft/s} to @samp{m} will produce @samp{30.48 m/s}.
+If @code{calc-ensure-consistent-units} is non-@code{nil}, then the target units
+need to have the same dimensions as the original units; for example, converting
+@samp{100 ft/s} to @samp{m} will result in an error, since @samp{ft/s} and @samp{m}
+have different dimensions. The default value of @code{calc-ensure-consistent-units}
+is @code{nil}.
+@end defvar
+
@defvar calc-undo-length
The variable @code{calc-undo-length} determines the number of undo
steps that Calc will keep track of when @code{calc-quit} is called.
@@ -35600,6 +35605,20 @@ number of undo steps that will be preserved; if
be preserved. The default value of @code{calc-undo-length} is @expr{100}.
@end defvar
+@defvar calc-gregorian-switch
+See @ref{Date Forms}.@*
+The variable @code{calc-gregorian-switch} is either a list of integers
+@code{(@var{YEAR} @var{MONTH} @var{DAY})} or @code{nil}.
+If it is @code{nil}, then Calc's date forms always represent Gregorian dates.
+Otherwise, @code{calc-gregorian-switch} represents the date that the
+calendar switches from Julian dates to Gregorian dates;
+@code{(@var{YEAR} @var{MONTH} @var{DAY})} will be the first Gregorian
+date. The customization buffer will offer several standard dates to
+choose from, or the user can enter their own date.
+
+The default value of @code{calc-gregorian-switch} is @code{nil}.
+@end defvar
+
@node Reporting Bugs, Summary, Customizing Calc, Top
@appendix Reporting Bugs
@@ -36571,7 +36590,7 @@ A plain @kbd{C-u} prefix means to prompt for the step size.
@c 7
@item
A prefix argument specifies simplification level and depth.
-1=Default, 2=like @kbd{a s}, 3=like @kbd{a e}.
+1=Basic simplifications, 2=Algebraic simplifications, 3=Extended simplifications
@c 8
@item
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index 8b589259a48..8c574be8f2a 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -147,10 +147,7 @@ CC Mode
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@comment Define an index for syntactic symbols.
-@ifnottex @c In texi2dvi, the @defindex would create an empty cc-mode.ss
- @c For Info, unlike tex, @syncodeindex needs a matching @defindex.
@defindex ss
-@end ifnottex
@comment Combine key, syntactic symbol and concept indices into one.
@syncodeindex ss cp
@@ -159,7 +156,7 @@ CC Mode
@copying
This manual is for CC Mode in Emacs.
-Copyright @copyright{} 1995-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1995-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -704,7 +701,7 @@ in some circumstances---@code{c-insert-tab-function} then defines
precisely what sort of ``whitespace'' this will be. Set the standard
Emacs variable @code{indent-tabs-mode} to @code{t} if you want real
@samp{tab} characters to be used in the indentation, to @code{nil} if
-you want only spaces. @xref{Just Spaces,,, @emacsman{},
+you want only spaces. @xref{Just Spaces,,,@emacsman{},
@emacsmantitle{}}.
@defopt c-tab-always-indent
@@ -1061,8 +1058,8 @@ set this up for you, so you probably won't have to bother.
@cindex Auto Fill mode
@cindex paragraph filling
Line breaks are by default handled (almost) the same regardless of
-whether they are made by auto fill mode (@pxref{Auto Fill,,,
-@emacsman{}, @emacsmantitle{}}), by paragraph filling (e.g. with
+whether they are made by auto fill mode (@pxref{Auto
+Fill,,,@emacsman{}, @emacsmantitle{}}), by paragraph filling (e.g. with
@kbd{M-q}), or explicitly with @kbd{M-j} or similar methods. In
string literals, the new line gets the same indentation as the
previous nonempty line.@footnote{You can change this default by
@@ -1405,7 +1402,7 @@ continuation of the preceding @code{if}.
@vindex abbrev-mode
@findex abbrev-mode
@cindex Abbrev mode
-@ccmode{} uses Abbrev mode (@pxref{Abbrevs,,, @emacsman{}, @emacsmantitle{}})
+@ccmode{} uses Abbrev mode (@pxref{Abbrevs,,,@emacsman{}, @emacsmantitle{}})
to accomplish this. It's therefore turned on by default in all language
modes except IDL mode, since CORBA IDL doesn't have any statements.
@end deffn
@@ -2200,7 +2197,7 @@ method, ``Top-level commands or the customization interface''.
If you make conflicting settings in several of these ways, the way
that takes precedence is the one that appears latest in this list:
-@itemize @asis
+@itemize @w{}
@item
@table @asis
@item Style
@@ -2298,14 +2295,14 @@ to create them.
A @dfn{file local variable setting} is a setting which applies to an
individual source file. You put this in a @dfn{local variables list},
a special block at the end of the source file (@pxref{Specifying File
-Variables,,, @emacsman{}}).
+Variables,,,@emacsman{}}).
@item File Styles
A @dfn{file style} is a rarely used variant of the ``style'' mechanism
described above, which applies to an individual source file.
@xref{File Styles}. You use this by setting certain special variables
-in a local variables list (@pxref{Specifying File Variables,,,
-@emacsman{}}).
+in a local variables list (@pxref{Specifying File
+Variables,,,@emacsman{}}).
@item Hooks with Styles
For ultimate flexibility, you can use hooks and styles together. For
@@ -2900,7 +2897,7 @@ these offsets or the parent style name.
The Emacs manual describes how you can customize certain variables on a
per-file basis by including a @dfn{file local variable} block at the end
-of the file (@pxref{File Variables,, Local Variables in Files, @emacsman{},
+of the file (@pxref{File Variables,, Local Variables in Files,@emacsman{},
@emacsmantitle{}}).
So far, you've only seen a functional interface for setting styles in
@@ -3142,8 +3139,9 @@ results in the current implementation.
@end defopt
@vindex comment-multi-line
-If inside a comment and @code{comment-multi-line} (@pxref{Auto Fill,,,
-@emacsman{}, @emacsmantitle{}} is non-@code{nil}, the indentation and
+If inside a comment and @code{comment-multi-line} (@pxref{Auto
+Fill,,,@emacsman{}, @emacsmantitle{}} is non-@code{nil}, the
+indentation and
line prefix are preserved. If inside a comment and
@code{comment-multi-line} is @code{nil}, a new comment of the same
type is started on the next line and indented as appropriate for
@@ -5198,7 +5196,7 @@ indentation.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
This section explains the structure and semantics of the style
-variable @code{c-offset-alist}, the principal variable for configuring
+variable @code{c-offsets-alist}, the principal variable for configuring
indentation. Details of how to set it up, and its relationship to
@ccmode{}'s style system are given in @ref{Style Variables}.
@@ -6661,7 +6659,7 @@ these macros properly, see @ref{Macros with ;}.
@node Macro Backslashes, Macros with ;, Custom Macros, Custom Macros
@comment node-name, next, previous, up
@section Customizing Macro Backslashes
-@cindex #define
+@cindex @code{#define}
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ccmode{} provides some tools to help keep the line continuation
@@ -6774,7 +6772,7 @@ The stuff that didn't fit in anywhere else is documented here.
Controls whether a final newline is enforced when the file is saved.
The value is an association list that for each language mode specifies
the value to give to @code{require-final-newline} (@pxref{Saving
-Buffers,,, @lispref{}, @lispreftitle{}}) at mode initialization. If a
+Buffers,,,@lispref{}, @lispreftitle{}}) at mode initialization. If a
language isn't present on the association list, CC Mode won't touch
@code{require-final-newline} in buffers for that language.
@@ -6945,7 +6943,7 @@ circumstances, can locate the top-most opening brace much more quickly than
styles where these braces are hung (e.g. most JDK-derived Java styles),
this hack can improve performance of the core syntax parsing routines
from 3 to 60 times. However, for styles which @emph{do} conform to
-Emacs' recommended style of putting top-level braces in column zero,
+Emacs's recommended style of putting top-level braces in column zero,
this hack can degrade performance by about as much. Thus this variable
is set to @code{nil} by default, since the Emacs-friendly styles should
be more common (and encouraged!). Note that this variable has no effect
@@ -7056,7 +7054,7 @@ Set the variable @code{c-basic-offset}. @xref{Getting Started}.
@kindex C-j
@emph{Why doesn't the @kbd{RET} key indent the new line?}
-Emacs' convention is that @kbd{RET} just adds a newline, and that
+Emacs's convention is that @kbd{RET} just adds a newline, and that
@kbd{C-j} adds a newline and indents it. You can make @kbd{RET} do this
too by adding this to your @code{c-initialization-hook}:
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 3f3d616e343..beefa3e9c40 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -1,11 +1,12 @@
\input texinfo @c -*-texinfo-*-
@setfilename ../../info/cl
@settitle Common Lisp Extensions
+@include emacsver.texi
@copying
This file documents the GNU Emacs Common Lisp emulation package.
-Copyright @copyright{} 1993, 2001-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1993, 2001-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -34,7 +35,7 @@ developing GNU and promoting software freedom.''
@sp 4
@center For GNU Emacs Lisp
@sp 1
-@center Version 2.02
+@center as distributed with Emacs @value{EMACSVER}
@sp 5
@center Dave Gillespie
@center daveg@@synaptics.com
@@ -45,49 +46,48 @@ developing GNU and promoting software freedom.''
@contents
-@node Top, Overview, (dir), (dir)
-@chapter Introduction
-
-@noindent
-This document describes a set of Emacs Lisp facilities borrowed from
-Common Lisp. All the facilities are described here in detail. While
-this document does not assume any prior knowledge of Common Lisp, it
-does assume a basic familiarity with Emacs Lisp.
-
@ifnottex
+@node Top
+@top GNU Emacs Common Lisp Emulation
+
@insertcopying
@end ifnottex
@menu
-* Overview:: Installation, usage, etc.
-* Program Structure:: Arglists, `eval-when', `defalias'
-* Predicates:: `typep' and `equalp'
-* Control Structure:: `setf', `do', `loop', etc.
-* Macros:: Destructuring, `define-compiler-macro'
-* Declarations:: `proclaim', `declare', etc.
-* Symbols:: Property lists, `gensym'
-* Numbers:: Predicates, functions, random numbers
-* Sequences:: Mapping, functions, searching, sorting
-* Lists:: `caddr', `sublis', `member*', `assoc*', etc.
-* Structures:: `defstruct'
-* Assertions:: `check-type', `assert', `ignore-errors'.
-
-* Efficiency Concerns:: Hints and techniques
-* Common Lisp Compatibility:: All known differences with Steele
-* Old CL Compatibility:: All known differences with old cl.el
-* Porting Common Lisp:: Hints for porting Common Lisp code
-
+* Overview:: Basics, usage, organization, naming conventions.
+* Program Structure:: Arglists, @code{cl-eval-when}.
+* Predicates:: Type predicates and equality predicates.
+* Control Structure:: Assignment, conditionals, blocks, looping.
+* Macros:: Destructuring, compiler macros.
+* Declarations:: @code{cl-proclaim}, @code{cl-declare}, etc.
+* Symbols:: Property lists, creating symbols.
+* Numbers:: Predicates, functions, random numbers.
+* Sequences:: Mapping, functions, searching, sorting.
+* Lists:: Functions, substitution, sets, associations.
+* Structures:: @code{cl-defstruct}.
+* Assertions:: Assertions and type checking.
+
+Appendices
+* Efficiency Concerns:: Hints and techniques.
+* Common Lisp Compatibility:: All known differences with Steele.
+* Porting Common Lisp:: Hints for porting Common Lisp code.
+* Obsolete Features:: Obsolete features.
* GNU Free Documentation License:: The license for this documentation.
-* Function Index::
-* Variable Index::
+
+Indexes
+* Function Index:: An entry for each documented function.
+* Variable Index:: An entry for each documented variable.
@end menu
-@node Overview, Program Structure, Top, Top
-@ifnottex
+@node Overview
@chapter Overview
-@end ifnottex
@noindent
+This document describes a set of Emacs Lisp facilities borrowed from
+Common Lisp. All the facilities are described here in detail. While
+this document does not assume any prior knowledge of Common Lisp, it
+does assume a basic familiarity with Emacs Lisp.
+
Common Lisp is a huge language, and Common Lisp systems tend to be
massive and extremely complex. Emacs Lisp, by contrast, is rather
minimalist in the choice of Lisp features it offers the programmer.
@@ -97,19 +97,9 @@ Lisp could benefit from many of the conveniences of Common Lisp.
The @dfn{CL} package adds a number of Common Lisp functions and
control structures to Emacs Lisp. While not a 100% complete
-implementation of Common Lisp, @dfn{CL} adds enough functionality
+implementation of Common Lisp, it adds enough functionality
to make Emacs Lisp programming significantly more convenient.
-@strong{Please note:} the @dfn{CL} functions are not standard parts of
-the Emacs Lisp name space, so it is legitimate for users to define
-them with other, conflicting meanings. To avoid conflicting with
-those user activities, we have a policy that packages installed in
-Emacs must not load @dfn{CL} at run time. (It is ok for them to load
-@dfn{CL} at compile time only, with @code{eval-when-compile}, and use
-the macros it provides.) If you are writing packages that you plan to
-distribute and invite widespread use for, you might want to observe
-the same rule.
-
Some Common Lisp features have been omitted from this package
for various reasons:
@@ -117,191 +107,172 @@ for various reasons:
@item
Some features are too complex or bulky relative to their benefit
to Emacs Lisp programmers. CLOS and Common Lisp streams are fine
-examples of this group.
+examples of this group. (The separate package EIEIO implements
+a subset of CLOS functionality. @xref{Top, , Introduction, eieio, EIEIO}.)
@item
Other features cannot be implemented without modification to the
Emacs Lisp interpreter itself, such as multiple return values,
-lexical scoping, case-insensitive symbols, and complex numbers.
-The @dfn{CL} package generally makes no attempt to emulate these
-features.
+case-insensitive symbols, and complex numbers.
+This package generally makes no attempt to emulate these features.
-@item
-Some features conflict with existing things in Emacs Lisp. For
-example, Emacs' @code{assoc} function is incompatible with the
-Common Lisp @code{assoc}. In such cases, this package usually
-adds the suffix @samp{*} to the function name of the Common
-Lisp version of the function (e.g., @code{assoc*}).
@end itemize
-The package described here was written by Dave Gillespie,
-@file{daveg@@synaptics.com}. It is a total rewrite of the original
-1986 @file{cl.el} package by Cesar Quiroz. Most features of the
-Quiroz package have been retained; any incompatibilities are
-noted in the descriptions below. Care has been taken in this
-version to ensure that each function is defined efficiently,
-concisely, and with minimal impact on the rest of the Emacs
-environment.
+This package was originally written by Dave Gillespie,
+@file{daveg@@synaptics.com}, as a total rewrite of an earlier 1986
+@file{cl.el} package by Cesar Quiroz. Care has been taken to ensure
+that each function is defined efficiently, concisely, and with minimal
+impact on the rest of the Emacs environment. Stefan Monnier added the
+file @file{cl-lib.el} and rationalized the namespace for Emacs 24.3.
@menu
-* Usage:: How to use the CL package
-* Organization:: The package's five component files
-* Installation:: Compiling and installing CL
-* Naming Conventions:: Notes on CL function names
+* Usage:: How to use this package.
+* Organization:: The package's component files.
+* Naming Conventions:: Notes on function names.
@end menu
-@node Usage, Organization, Overview, Overview
+@node Usage
@section Usage
@noindent
-Lisp code that uses features from the @dfn{CL} package should
-include at the beginning:
+This package is distributed with Emacs, so there is no need
+to install any additional files in order to start using it. Lisp code
+that uses features from this package should simply include at
+the beginning:
@example
-(require 'cl)
+(require 'cl-lib)
@end example
@noindent
-It is safe to arrange to load @dfn{CL} at all times, e.g.,
-in your @file{.emacs} file. But it's a good idea, for portability,
-to @code{(require 'cl)} in your code even if you do this.
+You may wish to add such a statement to your init file, if you
+make frequent use of features from this package.
-@node Organization, Installation, Usage, Overview
+@node Organization
@section Organization
@noindent
-The Common Lisp package is organized into four files:
+The Common Lisp package is organized into four main files:
@table @file
-@item cl.el
-This is the ``main'' file, which contains basic functions
-and information about the package. This file is relatively
-compact---about 700 lines.
+@item cl-lib.el
+This is the main file, which contains basic functions
+and information about the package. This file is relatively compact.
@item cl-extra.el
This file contains the larger, more complex or unusual functions.
It is kept separate so that packages which only want to use Common
-Lisp fundamentals like the @code{cadr} function won't need to pay
+Lisp fundamentals like the @code{cl-incf} function won't need to pay
the overhead of loading the more advanced functions.
@item cl-seq.el
This file contains most of the advanced functions for operating
-on sequences or lists, such as @code{delete-if} and @code{assoc*}.
+on sequences or lists, such as @code{cl-delete-if} and @code{cl-assoc}.
@item cl-macs.el
-This file contains the features of the packages which are macros
-instead of functions. Macros expand when the caller is compiled,
-not when it is run, so the macros generally only need to be
-present when the byte-compiler is running (or when the macros are
-used in uncompiled code such as a @file{.emacs} file). Most of
-the macros of this package are isolated in @file{cl-macs.el} so
-that they won't take up memory unless you are compiling.
+This file contains the features that are macros instead of functions.
+Macros expand when the caller is compiled, not when it is run, so the
+macros generally only need to be present when the byte-compiler is
+running (or when the macros are used in uncompiled code). Most of the
+macros of this package are isolated in @file{cl-macs.el} so that they
+won't take up memory unless you are compiling.
@end table
-The file @file{cl.el} includes all necessary @code{autoload}
+The file @file{cl-lib.el} includes all necessary @code{autoload}
commands for the functions and macros in the other three files.
-All you have to do is @code{(require 'cl)}, and @file{cl.el}
+All you have to do is @code{(require 'cl-lib)}, and @file{cl-lib.el}
will take care of pulling in the other files when they are
needed.
-There is another file, @file{cl-compat.el}, which defines some
-routines from the older @file{cl.el} package that are not otherwise
-present in the new package. This includes internal routines
-like @code{setelt} and @code{zip-lists}, deprecated features
-like @code{defkeyword}, and an emulation of the old-style
-multiple-values feature. This file is obsolete and should not be used
-in new code. @xref{Old CL Compatibility}.
-
-@node Installation, Naming Conventions, Organization, Overview
-@section Installation
-
-@noindent
-The @dfn{CL} package is distributed with Emacs, so there is no need
-to install anything.
-
-If you do need to install it, just put the byte-compiled files
-@file{cl.elc}, @file{cl-extra.elc}, @file{cl-seq.elc},
-@file{cl-macs.elc}, and (if necessary) @file{cl-compat.elc} into a
-directory on your @code{load-path}. Also, format the @file{cl.texi}
-file and put the resulting Info files into a directory in your
-@code{Info-directory-list}.
-
-@node Naming Conventions, , Installation, Overview
+There is another file, @file{cl.el}, which was the main entry point to
+this package prior to Emacs 24.3. Nowadays, it is replaced by
+@file{cl-lib.el}. The two provide the same features (in most cases),
+but use different function names (in fact, @file{cl.el} mainly just
+defines aliases to the @file{cl-lib.el} definitions). Where
+@file{cl-lib.el} defines a function called, for example,
+@code{cl-incf}, @file{cl.el} uses the same name but without the
+@samp{cl-} prefix, e.g.@: @code{incf} in this example. There are a few
+exceptions to this. First, functions such as @code{cl-defun} where
+the unprefixed version was already used for a standard Emacs Lisp
+function. In such cases, the @file{cl.el} version adds a @samp{*}
+suffix, e.g.@: @code{defun*}. Second, there are some obsolete features
+that are only implemented in @file{cl.el}, not in @file{cl-lib.el},
+because they are replaced by other standard Emacs Lisp features.
+Finally, in a very few cases the old @file{cl.el} versions do not
+behave in exactly the same way as the @file{cl-lib.el} versions.
+@xref{Obsolete Features}.
+@c There is also cl-mapc, which was called cl-mapc even before cl-lib.el.
+@c But not autoloaded, so maybe not much used?
+
+Since the old @file{cl.el} does not use a clean namespace, Emacs has a
+policy that packages distributed with Emacs must not load @code{cl} at
+run time. (It is ok for them to load @code{cl} at @emph{compile}
+time, with @code{eval-when-compile}, and use the macros it provides.)
+There is no such restriction on the use of @code{cl-lib}. New code
+should use @code{cl-lib} rather than @code{cl}.
+
+There is one more file, @file{cl-compat.el}, which defines some
+routines from the older Quiroz @file{cl.el} package that are not otherwise
+present in the new package. This file is obsolete and should not be
+used in new code.
+
+@node Naming Conventions
@section Naming Conventions
@noindent
Except where noted, all functions defined by this package have the
-same names and calling conventions as their Common Lisp counterparts.
-
-Following is a complete list of functions whose names were changed
-from Common Lisp, usually to avoid conflicts with Emacs. In each
-case, a @samp{*} has been appended to the Common Lisp name to obtain
-the Emacs name:
-
-@example
-defun* defsubst* defmacro* function*
-member* assoc* rassoc* get*
-remove* delete* mapcar* sort*
-floor* ceiling* truncate* round*
-mod* rem* random*
-@end example
+same calling conventions as their Common Lisp counterparts, and
+names that are those of Common Lisp plus a @samp{cl-} prefix.
Internal function and variable names in the package are prefixed
-by @code{cl-}. Here is a complete list of functions @emph{not}
-prefixed by @code{cl-} which were not taken from Common Lisp:
+by @code{cl--}. Here is a complete list of functions prefixed by
+@code{cl-} that were @emph{not} taken from Common Lisp:
@example
-floatp-safe lexical-let lexical-let*
-callf callf2 letf letf*
-defsubst*
+cl-callf cl-callf2 cl-defsubst
+cl-letf cl-letf*
@end example
-The following simple functions and macros are defined in @file{cl.el};
+@c This is not uninteresting I suppose, but is of zero practical relevance
+@c to the user, and seems like a hostage to changing implementation details.
+The following simple functions and macros are defined in @file{cl-lib.el};
they do not cause other components like @file{cl-extra} to be loaded.
@example
-floatp-safe endp
-evenp oddp plusp minusp
-caaar .. cddddr
-list* ldiff rest first .. tenth
-copy-list subst mapcar* [2]
-adjoin [3] acons pairlis pop [4]
-push [4] pushnew [3,4] incf [4] decf [4]
-proclaim declaim
+cl-evenp cl-oddp cl-minusp
+cl-plusp cl-endp cl-subst
+cl-copy-list cl-list* cl-ldiff
+cl-rest cl-decf [1] cl-incf [1]
+cl-acons cl-adjoin [2] cl-pairlis
+cl-pushnew [1,2] cl-declaim cl-proclaim
+cl-caaar@dots{}cl-cddddr cl-first@dots{}cl-tenth
+cl-mapcar [3]
@end example
@noindent
-[2] Only for one sequence argument or two list arguments.
+[1] Only when @var{place} is a plain variable name.
@noindent
-[3] Only if @code{:test} is @code{eq}, @code{equal}, or unspecified,
+[2] Only if @code{:test} is @code{eq}, @code{equal}, or unspecified,
and @code{:key} is not used.
@noindent
-[4] Only when @var{place} is a plain variable name.
-
-@iftex
-@chapno=4
-@end iftex
+[3] Only for one sequence argument or two list arguments.
-@node Program Structure, Predicates, Overview, Top
+@node Program Structure
@chapter Program Structure
@noindent
-This section describes features of the @dfn{CL} package which have to
+This section describes features of this package that have to
do with programs as a whole: advanced argument lists for functions,
-and the @code{eval-when} construct.
+and the @code{cl-eval-when} construct.
@menu
-* Argument Lists:: `&key', `&aux', `defun*', `defmacro*'.
-* Time of Evaluation:: The `eval-when' construct.
+* Argument Lists:: @code{&key}, @code{&aux}, @code{cl-defun}, @code{cl-defmacro}.
+* Time of Evaluation:: The @code{cl-eval-when} construct.
@end menu
-@iftex
-@secno=1
-@end iftex
-
-@node Argument Lists, Time of Evaluation, Program Structure, Program Structure
+@node Argument Lists
@section Argument Lists
@noindent
@@ -316,60 +287,63 @@ this package to implement Common Lisp argument lists seamlessly.
Instead, this package defines alternates for several Lisp forms
which you must use if you need Common Lisp argument lists.
-@defspec defun* name arglist body...
+@defmac cl-defun name arglist body@dots{}
This form is identical to the regular @code{defun} form, except
that @var{arglist} is allowed to be a full Common Lisp argument
list. Also, the function body is enclosed in an implicit block
called @var{name}; @pxref{Blocks and Exits}.
-@end defspec
+@end defmac
-@defspec defsubst* name arglist body...
-This is just like @code{defun*}, except that the function that
+@defmac cl-defsubst name arglist body@dots{}
+This is just like @code{cl-defun}, except that the function that
is defined is automatically proclaimed @code{inline}, i.e.,
calls to it may be expanded into in-line code by the byte compiler.
This is analogous to the @code{defsubst} form;
-@code{defsubst*} uses a different method (compiler macros) which
+@code{cl-defsubst} uses a different method (compiler macros) which
works in all versions of Emacs, and also generates somewhat more
-efficient inline expansions. In particular, @code{defsubst*}
+@c For some examples,
+@c see http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00009.html
+efficient inline expansions. In particular, @code{cl-defsubst}
arranges for the processing of keyword arguments, default values,
etc., to be done at compile-time whenever possible.
-@end defspec
+@end defmac
-@defspec defmacro* name arglist body...
+@defmac cl-defmacro name arglist body@dots{}
This is identical to the regular @code{defmacro} form,
except that @var{arglist} is allowed to be a full Common Lisp
argument list. The @code{&environment} keyword is supported as
-described in Steele. The @code{&whole} keyword is supported only
+described in Steele's book @cite{Common Lisp, the Language}.
+The @code{&whole} keyword is supported only
within destructured lists (see below); top-level @code{&whole}
cannot be implemented with the current Emacs Lisp interpreter.
The macro expander body is enclosed in an implicit block called
@var{name}.
-@end defspec
+@end defmac
-@defspec function* symbol-or-lambda
+@defmac cl-function symbol-or-lambda
This is identical to the regular @code{function} form,
except that if the argument is a @code{lambda} form then that
form may use a full Common Lisp argument list.
-@end defspec
+@end defmac
-Also, all forms (such as @code{defsetf} and @code{flet}) defined
+Also, all forms (such as @code{cl-flet} and @code{cl-labels}) defined
in this package that include @var{arglist}s in their syntax allow
full Common Lisp argument lists.
-Note that it is @emph{not} necessary to use @code{defun*} in
-order to have access to most @dfn{CL} features in your function.
-These features are always present; @code{defun*}'s only
+Note that it is @emph{not} necessary to use @code{cl-defun} in
+order to have access to most CL features in your function.
+These features are always present; @code{cl-defun}'s only
difference from @code{defun} is its more flexible argument
lists and its implicit block.
The full form of a Common Lisp argument list is
@example
-(@var{var}...
- &optional (@var{var} @var{initform} @var{svar})...
+(@var{var}@dots{}
+ &optional (@var{var} @var{initform} @var{svar})@dots{}
&rest @var{var}
- &key ((@var{keyword} @var{var}) @var{initform} @var{svar})...
- &aux (@var{var} @var{initform})...)
+ &key ((@var{keyword} @var{var}) @var{initform} @var{svar})@dots{}
+ &aux (@var{var} @var{initform})@dots{})
@end example
Each of the five argument list sections is optional. The @var{svar},
@@ -408,7 +382,7 @@ are optional arguments which are specified by name rather than
positionally in the argument list. For example,
@example
-(defun* foo (a &optional b &key c d (e 17)))
+(cl-defun foo (a &optional b &key c d (e 17)))
@end example
@noindent
@@ -434,7 +408,7 @@ You can also explicitly specify the keyword argument; it need not be
simply the variable name prefixed with a colon. For example,
@example
-(defun* bar (&key (a 1) ((baz b) 4)))
+(cl-defun bar (&key (a 1) ((baz b) 4)))
@end example
@noindent
@@ -459,17 +433,17 @@ function uses both @code{&rest} and @code{&key} at the same time,
the ``rest'' argument is bound to the keyword list as it appears
in the call. For example:
-@smallexample
-(defun* find-thing (thing &rest rest &key need &allow-other-keys)
- (or (apply 'member* thing thing-list :allow-other-keys t rest)
+@example
+(cl-defun find-thing (thing &rest rest &key need &allow-other-keys)
+ (or (apply 'cl-member thing thing-list :allow-other-keys t rest)
(if need (error "Thing not found"))))
-@end smallexample
+@end example
@noindent
This function takes a @code{:need} keyword argument, but also
accepts other keyword arguments which are passed on to the
-@code{member*} function. @code{allow-other-keys} is used to
-keep both @code{find-thing} and @code{member*} from complaining
+@code{cl-member} function. @code{allow-other-keys} is used to
+keep both @code{find-thing} and @code{cl-member} from complaining
about each others' keywords in the arguments.
The fifth section of the argument list consists of @dfn{auxiliary
@@ -480,27 +454,27 @@ difference between the following two functions, except for a
matter of stylistic taste:
@example
-(defun* foo (a b &aux (c (+ a b)) d)
+(cl-defun foo (a b &aux (c (+ a b)) d)
@var{body})
-(defun* foo (a b)
+(cl-defun foo (a b)
(let ((c (+ a b)) d)
@var{body}))
@end example
Argument lists support @dfn{destructuring}. In Common Lisp,
destructuring is only allowed with @code{defmacro}; this package
-allows it with @code{defun*} and other argument lists as well.
+allows it with @code{cl-defun} and other argument lists as well.
In destructuring, any argument variable (@var{var} in the above
-diagram) can be replaced by a list of variables, or more generally,
+example) can be replaced by a list of variables, or more generally,
a recursive argument list. The corresponding argument value must
be a list whose elements match this recursive argument list.
For example:
@example
-(defmacro* dolist ((var listform &optional resultform)
+(cl-defmacro dolist ((var listform &optional resultform)
&rest body)
- ...)
+ @dots{})
@end example
This says that the first argument of @code{dolist} must be a list
@@ -525,7 +499,7 @@ If the optimization quality @code{safety} is set to 0
arguments and invalid keyword arguments is disabled. By default,
argument lists are rigorously checked.
-@node Time of Evaluation, , Argument Lists, Program Structure
+@node Time of Evaluation
@section Time of Evaluation
@noindent
@@ -539,21 +513,21 @@ For example, the compiler effectively evaluates @code{defmacro} forms
at compile-time so that later parts of the file can refer to the
macros that are defined.
-@defspec eval-when (situations...) forms...
+@defmac cl-eval-when (situations@dots{}) forms@dots{}
This form controls when the body @var{forms} are evaluated.
The @var{situations} list may contain any set of the symbols
@code{compile}, @code{load}, and @code{eval} (or their long-winded
ANSI equivalents, @code{:compile-toplevel}, @code{:load-toplevel},
and @code{:execute}).
-The @code{eval-when} form is handled differently depending on
+The @code{cl-eval-when} form is handled differently depending on
whether or not it is being compiled as a top-level form.
Specifically, it gets special treatment if it is being compiled
by a command such as @code{byte-compile-file} which compiles files
or buffers of code, and it appears either literally at the
top level of the file or inside a top-level @code{progn}.
-For compiled top-level @code{eval-when}s, the body @var{forms} are
+For compiled top-level @code{cl-eval-when}s, the body @var{forms} are
executed at compile-time if @code{compile} is in the @var{situations}
list, and the @var{forms} are written out to the file (to be executed
at load-time) if @code{load} is in the @var{situations} list.
@@ -561,11 +535,11 @@ at load-time) if @code{load} is in the @var{situations} list.
For non-compiled-top-level forms, only the @code{eval} situation is
relevant. (This includes forms executed by the interpreter, forms
compiled with @code{byte-compile} rather than @code{byte-compile-file},
-and non-top-level forms.) The @code{eval-when} acts like a
+and non-top-level forms.) The @code{cl-eval-when} acts like a
@code{progn} if @code{eval} is specified, and like @code{nil}
(ignoring the body @var{forms}) if not.
-The rules become more subtle when @code{eval-when}s are nested;
+The rules become more subtle when @code{cl-eval-when}s are nested;
consult Steele (second edition) for the gruesome details (and
some gruesome examples).
@@ -573,13 +547,13 @@ Some simple examples:
@example
;; Top-level forms in foo.el:
-(eval-when (compile) (setq foo1 'bar))
-(eval-when (load) (setq foo2 'bar))
-(eval-when (compile load) (setq foo3 'bar))
-(eval-when (eval) (setq foo4 'bar))
-(eval-when (eval compile) (setq foo5 'bar))
-(eval-when (eval load) (setq foo6 'bar))
-(eval-when (eval compile load) (setq foo7 'bar))
+(cl-eval-when (compile) (setq foo1 'bar))
+(cl-eval-when (load) (setq foo2 'bar))
+(cl-eval-when (compile load) (setq foo3 'bar))
+(cl-eval-when (eval) (setq foo4 'bar))
+(cl-eval-when (eval compile) (setq foo5 'bar))
+(cl-eval-when (eval load) (setq foo6 'bar))
+(cl-eval-when (eval compile load) (setq foo7 'bar))
@end example
When @file{foo.el} is compiled, these variables will be set during
@@ -602,26 +576,26 @@ be set:
foo4 foo5 foo6 foo7 ; `eval'
@end example
-If these seven @code{eval-when}s had been, say, inside a @code{defun},
+If these seven @code{cl-eval-when}s had been, say, inside a @code{defun},
then the first three would have been equivalent to @code{nil} and the
last four would have been equivalent to the corresponding @code{setq}s.
-Note that @code{(eval-when (load eval) @dots{})} is equivalent
+Note that @code{(cl-eval-when (load eval) @dots{})} is equivalent
to @code{(progn @dots{})} in all contexts. The compiler treats
certain top-level forms, like @code{defmacro} (sort-of) and
-@code{require}, as if they were wrapped in @code{(eval-when
+@code{require}, as if they were wrapped in @code{(cl-eval-when
(compile load eval) @dots{})}.
-@end defspec
+@end defmac
-Emacs includes two special forms related to @code{eval-when}.
+Emacs includes two special forms related to @code{cl-eval-when}.
+@xref{Eval During Compile,,,elisp,GNU Emacs Lisp Reference Manual}.
One of these, @code{eval-when-compile}, is not quite equivalent to
-any @code{eval-when} construct and is described below.
+any @code{cl-eval-when} construct and is described below.
The other form, @code{(eval-and-compile @dots{})}, is exactly
-equivalent to @samp{(eval-when (compile load eval) @dots{})} and
-so is not itself defined by this package.
+equivalent to @samp{(cl-eval-when (compile load eval) @dots{})}.
-@defspec eval-when-compile forms...
+@defmac eval-when-compile forms@dots{}
The @var{forms} are evaluated at compile-time; at execution time,
this form acts like a quoted constant of the resulting value. Used
at top-level, @code{eval-when-compile} is just like @samp{eval-when
@@ -630,9 +604,9 @@ allows code to be evaluated once at compile-time for efficiency
or other reasons.
This form is similar to the @samp{#.} syntax of true Common Lisp.
-@end defspec
+@end defmac
-@defspec load-time-value form
+@defmac cl-load-time-value form
The @var{form} is evaluated at load-time; at execution time,
this form acts like a quoted constant of the resulting value.
@@ -640,12 +614,12 @@ Early Common Lisp had a @samp{#,} syntax that was similar to
this, but ANSI Common Lisp replaced it with @code{load-time-value}
and gave it more well-defined semantics.
-In a compiled file, @code{load-time-value} arranges for @var{form}
+In a compiled file, @code{cl-load-time-value} arranges for @var{form}
to be evaluated when the @file{.elc} file is loaded and then used
as if it were a quoted constant. In code compiled by
@code{byte-compile} rather than @code{byte-compile-file}, the
effect is identical to @code{eval-when-compile}. In uncompiled
-code, both @code{eval-when-compile} and @code{load-time-value}
+code, both @code{eval-when-compile} and @code{cl-load-time-value}
act exactly like @code{progn}.
@example
@@ -656,7 +630,7 @@ act exactly like @code{progn}.
(eval-when-compile (current-time-string))
;; or '#.(current-time-string) in real Common Lisp
", and loaded on: "
- (load-time-value (current-time-string))))
+ (cl-load-time-value (current-time-string))))
@end example
@noindent
@@ -669,13 +643,13 @@ Byte-compiled, the above defun will result in the following code
(insert "This function was executed on: "
(current-time-string)
", compiled on: "
- '"Wed Jun 23 18:33:43 1993"
+ '"Wed Oct 31 16:32:28 2012"
", and loaded on: "
--temp--))
@end example
-@end defspec
+@end defmac
-@node Predicates, Control Structure, Program Structure, Top
+@node Predicates
@chapter Predicates
@noindent
@@ -683,21 +657,17 @@ This section describes functions for testing whether various
facts are true or false.
@menu
-* Type Predicates:: `typep', `deftype', and `coerce'
-* Equality Predicates:: `equalp'
+* Type Predicates:: @code{cl-typep}, @code{cl-deftype}, and @code{cl-coerce}.
+* Equality Predicates:: @code{cl-equalp}.
@end menu
-@node Type Predicates, Equality Predicates, Predicates, Predicates
+@node Type Predicates
@section Type Predicates
-@noindent
-The @dfn{CL} package defines a version of the Common Lisp @code{typep}
-predicate.
-
-@defun typep object type
+@defun cl-typep object type
Check if @var{object} is of type @var{type}, where @var{type} is a
(quoted) type name of the sort used by Common Lisp. For example,
-@code{(typep foo 'integer)} is equivalent to @code{(integerp foo)}.
+@code{(cl-typep foo 'integer)} is equivalent to @code{(integerp foo)}.
@end defun
The @var{type} argument to the above function is either a symbol
@@ -712,18 +682,18 @@ than @samp{-p} are used when appropriate.)
@item
The type symbol @code{t} stands for the union of all types.
-@code{(typep @var{object} t)} is always true. Likewise, the
+@code{(cl-typep @var{object} t)} is always true. Likewise, the
type symbol @code{nil} stands for nothing at all, and
-@code{(typep @var{object} nil)} is always false.
+@code{(cl-typep @var{object} nil)} is always false.
@item
The type symbol @code{null} represents the symbol @code{nil}.
-Thus @code{(typep @var{object} 'null)} is equivalent to
+Thus @code{(cl-typep @var{object} 'null)} is equivalent to
@code{(null @var{object})}.
@item
The type symbol @code{atom} represents all objects that are not cons
-cells. Thus @code{(typep @var{object} 'atom)} is equivalent to
+cells. Thus @code{(cl-typep @var{object} 'atom)} is equivalent to
@code{(atom @var{object})}.
@item
@@ -734,10 +704,13 @@ The type symbol @code{real} is a synonym for @code{number}, and
The type symbols @code{character} and @code{string-char} match
integers in the range from 0 to 255.
+@c No longer relevant, so covered by first item above (float -> floatp).
+@ignore
@item
-The type symbol @code{float} uses the @code{floatp-safe} predicate
+The type symbol @code{float} uses the @code{cl-floatp-safe} predicate
defined by this package rather than @code{floatp}, so it will work
correctly even in Emacs versions without floating-point support.
+@end ignore
@item
The type list @code{(integer @var{low} @var{high})} represents all
@@ -757,7 +730,7 @@ combinations of types. For example, @code{(or integer (float 0 *))}
represents all objects that are integers or non-negative floats.
@item
-Lists beginning with @code{member} or @code{member*} represent
+Lists beginning with @code{member} or @code{cl-member} represent
objects @code{eql} to any of the following values. For example,
@code{(member 1 2 3 4)} is equivalent to @code{(integer 1 4)},
and @code{(member nil)} is equivalent to @code{null}.
@@ -769,40 +742,40 @@ with that object as an argument.
@end itemize
The following function and macro (not technically predicates) are
-related to @code{typep}.
+related to @code{cl-typep}.
-@defun coerce object type
+@defun cl-coerce object type
This function attempts to convert @var{object} to the specified
@var{type}. If @var{object} is already of that type as determined by
-@code{typep}, it is simply returned. Otherwise, certain types of
+@code{cl-typep}, it is simply returned. Otherwise, certain types of
conversions will be made: If @var{type} is any sequence type
(@code{string}, @code{list}, etc.) then @var{object} will be
converted to that type if possible. If @var{type} is
@code{character}, then strings of length one and symbols with
one-character names can be coerced. If @var{type} is @code{float},
then integers can be coerced in versions of Emacs that support
-floats. In all other circumstances, @code{coerce} signals an
+floats. In all other circumstances, @code{cl-coerce} signals an
error.
@end defun
-@defspec deftype name arglist forms...
+@defmac cl-deftype name arglist forms@dots{}
This macro defines a new type called @var{name}. It is similar
to @code{defmacro} in many ways; when @var{name} is encountered
as a type name, the body @var{forms} are evaluated and should
return a type specifier that is equivalent to the type. The
@var{arglist} is a Common Lisp argument list of the sort accepted
-by @code{defmacro*}. The type specifier @samp{(@var{name} @var{args}...)}
+by @code{cl-defmacro}. The type specifier @samp{(@var{name} @var{args}@dots{})}
is expanded by calling the expander with those arguments; the type
symbol @samp{@var{name}} is expanded by calling the expander with
no arguments. The @var{arglist} is processed the same as for
-@code{defmacro*} except that optional arguments without explicit
+@code{cl-defmacro} except that optional arguments without explicit
defaults use @code{*} instead of @code{nil} as the ``default''
default. Some examples:
@example
-(deftype null () '(satisfies null)) ; predefined
-(deftype list () '(or null cons)) ; predefined
-(deftype unsigned-byte (&optional bits)
+(cl-deftype null () '(satisfies null)) ; predefined
+(cl-deftype list () '(or null cons)) ; predefined
+(cl-deftype unsigned-byte (&optional bits)
(list 'integer 0 (if (eq bits '*) bits (1- (lsh 1 bits)))))
(unsigned-byte 8) @equiv{} (integer 0 255)
(unsigned-byte) @equiv{} (integer 0 *)
@@ -813,23 +786,23 @@ unsigned-byte @equiv{} (integer 0 *)
The last example shows how the Common Lisp @code{unsigned-byte}
type specifier could be implemented if desired; this package does
not implement @code{unsigned-byte} by default.
-@end defspec
+@end defmac
-The @code{typecase} and @code{check-type} macros also use type
-names. @xref{Conditionals}. @xref{Assertions}. The @code{map},
-@code{concatenate}, and @code{merge} functions take type-name
+The @code{cl-typecase} (@pxref{Conditionals}) and @code{cl-check-type}
+(@pxref{Assertions}) macros also use type names. The @code{cl-map},
+@code{cl-concatenate}, and @code{cl-merge} functions take type-name
arguments to specify the type of sequence to return. @xref{Sequences}.
-@node Equality Predicates, , Type Predicates, Predicates
+@node Equality Predicates
@section Equality Predicates
@noindent
-This package defines the Common Lisp predicate @code{equalp}.
+This package defines the Common Lisp predicate @code{cl-equalp}.
-@defun equalp a b
+@defun cl-equalp a b
This function is a more flexible version of @code{equal}. In
particular, it compares strings case-insensitively, and it compares
-numbers without regard to type (so that @code{(equalp 3 3.0)} is
+numbers without regard to type (so that @code{(cl-equalp 3 3.0)} is
true). Vectors and conses are compared recursively. All other
objects are compared as if by @code{equal}.
@@ -838,44 +811,44 @@ respects. First, Common Lisp's @code{equalp} also compares
@emph{characters} case-insensitively, which would be impractical
in this package since Emacs does not distinguish between integers
and characters. In keeping with the idea that strings are less
-vector-like in Emacs Lisp, this package's @code{equalp} also will
+vector-like in Emacs Lisp, this package's @code{cl-equalp} also will
not compare strings against vectors of integers.
@end defun
Also note that the Common Lisp functions @code{member} and @code{assoc}
use @code{eql} to compare elements, whereas Emacs Lisp follows the
MacLisp tradition and uses @code{equal} for these two functions.
-In Emacs, use @code{member*} and @code{assoc*} to get functions
-which use @code{eql} for comparisons.
+In Emacs, use @code{memq} (or @code{cl-member}) and @code{assq} (or
+@code{cl-assoc}) to get functions which use @code{eql} for comparisons.
-@node Control Structure, Macros, Predicates, Top
+@node Control Structure
@chapter Control Structure
@noindent
The features described in the following sections implement
-various advanced control structures, including the powerful
-@code{setf} facility and a number of looping and conditional
+various advanced control structures, including extensions to the
+standard @code{setf} facility, and a number of looping and conditional
constructs.
@menu
-* Assignment:: The `psetq' form
-* Generalized Variables:: `setf', `incf', `push', etc.
-* Variable Bindings:: `progv', `lexical-let', `flet', `macrolet'
-* Conditionals:: `case', `typecase'
-* Blocks and Exits:: `block', `return', `return-from'
-* Iteration:: `do', `dotimes', `dolist', `do-symbols'
-* Loop Facility:: The Common Lisp `loop' macro
-* Multiple Values:: `values', `multiple-value-bind', etc.
+* Assignment:: The @code{cl-psetq} form.
+* Generalized Variables:: Extensions to generalized variables.
+* Variable Bindings:: @code{cl-progv}, @code{cl-flet}, @code{cl-macrolet}.
+* Conditionals:: @code{cl-case}, @code{cl-typecase}.
+* Blocks and Exits:: @code{cl-block}, @code{cl-return}, @code{cl-return-from}.
+* Iteration:: @code{cl-do}, @code{cl-dotimes}, @code{cl-dolist}, @code{cl-do-symbols}.
+* Loop Facility:: The Common Lisp @code{loop} macro.
+* Multiple Values:: @code{cl-values}, @code{cl-multiple-value-bind}, etc.
@end menu
-@node Assignment, Generalized Variables, Control Structure, Control Structure
+@node Assignment
@section Assignment
@noindent
-The @code{psetq} form is just like @code{setq}, except that multiple
+The @code{cl-psetq} form is just like @code{setq}, except that multiple
assignments are done in parallel rather than sequentially.
-@defspec psetq [symbol form]@dots{}
+@defmac cl-psetq [symbol form]@dots{}
This special form (actually a macro) is used to assign to several
variables simultaneously. Given only one @var{symbol} and @var{form},
it has the same effect as @code{setq}. Given several @var{symbol}
@@ -890,144 +863,92 @@ x
y ; @r{@code{y} was computed after @code{x} was set.}
@result{} 15
(setq x 2 y 3)
-(psetq x (+ x y) y (* x y))
+(cl-psetq x (+ x y) y (* x y))
x
@result{} 5
y ; @r{@code{y} was computed before @code{x} was set.}
@result{} 6
@end example
-The simplest use of @code{psetq} is @code{(psetq x y y x)}, which
-exchanges the values of two variables. (The @code{rotatef} form
+The simplest use of @code{cl-psetq} is @code{(cl-psetq x y y x)}, which
+exchanges the values of two variables. (The @code{cl-rotatef} form
provides an even more convenient way to swap two variables;
@pxref{Modify Macros}.)
-@code{psetq} always returns @code{nil}.
-@end defspec
+@code{cl-psetq} always returns @code{nil}.
+@end defmac
-@node Generalized Variables, Variable Bindings, Assignment, Control Structure
+@node Generalized Variables
@section Generalized Variables
-@noindent
-A ``generalized variable'' or ``place form'' is one of the many places
-in Lisp memory where values can be stored. The simplest place form is
-a regular Lisp variable. But the cars and cdrs of lists, elements
-of arrays, properties of symbols, and many other locations are also
-places where Lisp values are stored.
-
-The @code{setf} form is like @code{setq}, except that it accepts
-arbitrary place forms on the left side rather than just
-symbols. For example, @code{(setf (car a) b)} sets the car of
-@code{a} to @code{b}, doing the same operation as @code{(setcar a b)}
-but without having to remember two separate functions for setting
-and accessing every type of place.
-
-Generalized variables are analogous to ``lvalues'' in the C
-language, where @samp{x = a[i]} gets an element from an array
-and @samp{a[i] = x} stores an element using the same notation.
-Just as certain forms like @code{a[i]} can be lvalues in C, there
-is a set of forms that can be generalized variables in Lisp.
+A @dfn{generalized variable} or @dfn{place form} is one of the many
+places in Lisp memory where values can be stored. The simplest place
+form is a regular Lisp variable. But the @sc{car}s and @sc{cdr}s of lists,
+elements of arrays, properties of symbols, and many other locations
+are also places where Lisp values are stored. For basic information,
+@pxref{Generalized Variables,,,elisp,GNU Emacs Lisp Reference Manual}.
+This package provides several additional features related to
+generalized variables.
@menu
-* Basic Setf:: `setf' and place forms
-* Modify Macros:: `incf', `push', `rotatef', `letf', `callf', etc.
-* Customizing Setf:: `define-modify-macro', `defsetf', `define-setf-method'
+* Setf Extensions:: Additional @code{setf} places.
+* Modify Macros:: @code{cl-incf}, @code{cl-rotatef}, @code{cl-letf}, @code{cl-callf}, etc.
@end menu
-@node Basic Setf, Modify Macros, Generalized Variables, Generalized Variables
-@subsection Basic Setf
-
-@noindent
-The @code{setf} macro is the most basic way to operate on generalized
-variables.
-
-@defspec setf [place form]@dots{}
-This macro evaluates @var{form} and stores it in @var{place}, which
-must be a valid generalized variable form. If there are several
-@var{place} and @var{form} pairs, the assignments are done sequentially
-just as with @code{setq}. @code{setf} returns the value of the last
-@var{form}.
-
-The following Lisp forms will work as generalized variables, and
-so may appear in the @var{place} argument of @code{setf}:
+@node Setf Extensions
+@subsection Setf Extensions
-@itemize @bullet
-@item
-A symbol naming a variable. In other words, @code{(setf x y)} is
-exactly equivalent to @code{(setq x y)}, and @code{setq} itself is
-strictly speaking redundant now that @code{setf} exists. Many
-programmers continue to prefer @code{setq} for setting simple
-variables, though, purely for stylistic or historical reasons.
-The macro @code{(setf x y)} actually expands to @code{(setq x y)},
-so there is no performance penalty for using it in compiled code.
+Several standard (e.g.@: @code{car}) and Emacs-specific
+(e.g.@: @code{window-point}) Lisp functions are @code{setf}-able by default.
+This package defines @code{setf} handlers for several additional functions:
+@itemize
@item
-A call to any of the following Lisp functions:
-
-@smallexample
-car cdr caar .. cddddr
-nth rest first .. tenth
-aref elt nthcdr
-symbol-function symbol-value symbol-plist
-get get* getf
-gethash subseq
-@end smallexample
+Functions from this package:
+@example
+cl-rest cl-subseq cl-get cl-getf
+cl-caaar@dots{}cl-cddddr cl-first@dots{}cl-tenth
+@end example
@noindent
-Note that for @code{nthcdr} and @code{getf}, the list argument
-of the function must itself be a valid @var{place} form. For
-example, @code{(setf (nthcdr 0 foo) 7)} will set @code{foo} itself
-to 7. Note that @code{push} and @code{pop} on an @code{nthcdr}
-place can be used to insert or delete at any position in a list.
-The use of @code{nthcdr} as a @var{place} form is an extension
-to standard Common Lisp.
+Note that for @code{cl-getf} (as for @code{nthcdr}), the list argument
+of the function must itself be a valid @var{place} form.
@item
-The following Emacs-specific functions are also @code{setf}-able.
-
-@smallexample
-buffer-file-name marker-position
-buffer-modified-p match-data
-buffer-name mouse-position
-buffer-string overlay-end
-buffer-substring overlay-get
-current-buffer overlay-start
-current-case-table point
-current-column point-marker
-current-global-map point-max
-current-input-mode point-min
-current-local-map process-buffer
-current-window-configuration process-filter
-default-file-modes process-sentinel
-default-value read-mouse-position
-documentation-property screen-height
-extent-data screen-menubar
-extent-end-position screen-width
-extent-start-position selected-window
-face-background selected-screen
-face-background-pixmap selected-frame
-face-font standard-case-table
-face-foreground syntax-table
-face-underline-p window-buffer
-file-modes window-dedicated-p
-frame-height window-display-table
-frame-parameters window-height
-frame-visible-p window-hscroll
-frame-width window-point
-get-register window-start
-getenv window-width
-global-key-binding x-get-secondary-selection
-keymap-parent x-get-selection
-local-key-binding
-mark
-mark-marker
-@end smallexample
+General Emacs Lisp functions:
+@example
+buffer-file-name getenv
+buffer-modified-p global-key-binding
+buffer-name local-key-binding
+buffer-string mark
+buffer-substring mark-marker
+current-buffer marker-position
+current-case-table mouse-position
+current-column point
+current-global-map point-marker
+current-input-mode point-max
+current-local-map point-min
+current-window-configuration read-mouse-position
+default-file-modes screen-height
+documentation-property screen-width
+face-background selected-window
+face-background-pixmap selected-screen
+face-font selected-frame
+face-foreground standard-case-table
+face-underline-p syntax-table
+file-modes visited-file-modtime
+frame-height window-height
+frame-parameters window-width
+frame-visible-p x-get-secondary-selection
+frame-width x-get-selection
+get-register
+@end example
Most of these have directly corresponding ``set'' functions, like
@code{use-local-map} for @code{current-local-map}, or @code{goto-char}
for @code{point}. A few, like @code{point-min}, expand to longer
-sequences of code when they are @code{setf}'d (@code{(narrow-to-region
-x (point-max))} in this case).
+sequences of code when they are used with @code{setf}
+(@code{(narrow-to-region x (point-max))} in this case).
@item
A call of the form @code{(substring @var{subplace} @var{n} [@var{m}])},
@@ -1054,6 +975,10 @@ a
The generalized variable @code{buffer-substring}, listed above,
also works in this way by replacing a portion of the current buffer.
+@c FIXME? Also `eq'? (see cl-lib.el)
+
+@c Currently commented out in cl.el.
+@ignore
@item
A call of the form @code{(apply '@var{func} @dots{})} or
@code{(apply (function @var{func}) @dots{})}, where @var{func}
@@ -1062,28 +987,27 @@ in the sense described in Steele's book; since none of the standard
Emacs place functions are suitable in this sense, this feature is
only interesting when used with places you define yourself with
@code{define-setf-method} or the long form of @code{defsetf}.
+@xref{Obsolete Setf Customization}.
+@end ignore
+@c FIXME? Is this still true?
@item
A macro call, in which case the macro is expanded and @code{setf}
is applied to the resulting form.
-
-@item
-Any form for which a @code{defsetf} or @code{define-setf-method}
-has been made.
@end itemize
-Using any forms other than these in the @var{place} argument to
-@code{setf} will signal an error.
-
+@c FIXME should this be in lispref? It seems self-evident.
+@c Contrast with the cl-incf example later on.
+@c Here it really only serves as a contrast to wrong-order.
The @code{setf} macro takes care to evaluate all subforms in
the proper left-to-right order; for example,
@example
-(setf (aref vec (incf i)) i)
+(setf (aref vec (cl-incf i)) i)
@end example
@noindent
-looks like it will evaluate @code{(incf i)} exactly once, before the
+looks like it will evaluate @code{(cl-incf i)} exactly once, before the
following access to @code{i}; the @code{setf} expander will insert
temporary variables as necessary to ensure that it does in fact work
this way no matter what setf-method is defined for @code{aref}.
@@ -1103,35 +1027,34 @@ will be preserved. Adapting an example from Steele, given
the form @code{(setf (wrong-order @var{a} @var{b}) 17)} will
evaluate @var{b} first, then @var{a}, just as in an actual call
to @code{wrong-order}.
-@end defspec
-@node Modify Macros, Customizing Setf, Basic Setf, Generalized Variables
+@node Modify Macros
@subsection Modify Macros
@noindent
-This package defines a number of other macros besides @code{setf}
-that operate on generalized variables. Many are interesting and
-useful even when the @var{place} is just a variable name.
+This package defines a number of macros that operate on generalized
+variables. Many are interesting and useful even when the @var{place}
+is just a variable name.
-@defspec psetf [place form]@dots{}
-This macro is to @code{setf} what @code{psetq} is to @code{setq}:
+@defmac cl-psetf [place form]@dots{}
+This macro is to @code{setf} what @code{cl-psetq} is to @code{setq}:
When several @var{place}s and @var{form}s are involved, the
assignments take place in parallel rather than sequentially.
Specifically, all subforms are evaluated from left to right, then
all the assignments are done (in an undefined order).
-@end defspec
+@end defmac
-@defspec incf place &optional x
+@defmac cl-incf place &optional x
This macro increments the number stored in @var{place} by one, or
by @var{x} if specified. The incremented value is returned. For
-example, @code{(incf i)} is equivalent to @code{(setq i (1+ i))}, and
-@code{(incf (car x) 2)} is equivalent to @code{(setcar x (+ (car x) 2))}.
+example, @code{(cl-incf i)} is equivalent to @code{(setq i (1+ i))}, and
+@code{(cl-incf (car x) 2)} is equivalent to @code{(setcar x (+ (car x) 2))}.
-Once again, care is taken to preserve the ``apparent'' order of
-evaluation. For example,
+As with @code{setf}, care is taken to preserve the ``apparent'' order
+of evaluation. For example,
@example
-(incf (aref vec (incf i)))
+(cl-incf (aref vec (cl-incf i)))
@end example
@noindent
@@ -1141,93 +1064,81 @@ does, which means the above form is @emph{not} equivalent to the
``obvious'' expansion,
@example
-(setf (aref vec (incf i)) (1+ (aref vec (incf i)))) ; Wrong!
+(setf (aref vec (cl-incf i))
+ (1+ (aref vec (cl-incf i)))) ; wrong!
@end example
@noindent
but rather to something more like
@example
-(let ((temp (incf i)))
+(let ((temp (cl-incf i)))
(setf (aref vec temp) (1+ (aref vec temp))))
@end example
@noindent
-Again, all of this is taken care of automatically by @code{incf} and
+Again, all of this is taken care of automatically by @code{cl-incf} and
the other generalized-variable macros.
-As a more Emacs-specific example of @code{incf}, the expression
-@code{(incf (point) @var{n})} is essentially equivalent to
+As a more Emacs-specific example of @code{cl-incf}, the expression
+@code{(cl-incf (point) @var{n})} is essentially equivalent to
@code{(forward-char @var{n})}.
-@end defspec
+@end defmac
-@defspec decf place &optional x
+@defmac cl-decf place &optional x
This macro decrements the number stored in @var{place} by one, or
by @var{x} if specified.
-@end defspec
-
-@defspec pop place
-This macro removes and returns the first element of the list stored
-in @var{place}. It is analogous to @code{(prog1 (car @var{place})
-(setf @var{place} (cdr @var{place})))}, except that it takes care
-to evaluate all subforms only once.
-@end defspec
+@end defmac
-@defspec push x place
-This macro inserts @var{x} at the front of the list stored in
-@var{place}. It is analogous to @code{(setf @var{place} (cons
-@var{x} @var{place}))}, except for evaluation of the subforms.
-@end defspec
-
-@defspec pushnew x place @t{&key :test :test-not :key}
+@defmac cl-pushnew x place @t{&key :test :test-not :key}
This macro inserts @var{x} at the front of the list stored in
@var{place}, but only if @var{x} was not @code{eql} to any
existing element of the list. The optional keyword arguments
-are interpreted in the same way as for @code{adjoin}.
+are interpreted in the same way as for @code{cl-adjoin}.
@xref{Lists as Sets}.
-@end defspec
+@end defmac
-@defspec shiftf place@dots{} newvalue
+@defmac cl-shiftf place@dots{} newvalue
This macro shifts the @var{place}s left by one, shifting in the
value of @var{newvalue} (which may be any Lisp expression, not just
a generalized variable), and returning the value shifted out of
-the first @var{place}. Thus, @code{(shiftf @var{a} @var{b} @var{c}
+the first @var{place}. Thus, @code{(cl-shiftf @var{a} @var{b} @var{c}
@var{d})} is equivalent to
@example
(prog1
@var{a}
- (psetf @var{a} @var{b}
- @var{b} @var{c}
- @var{c} @var{d}))
+ (cl-psetf @var{a} @var{b}
+ @var{b} @var{c}
+ @var{c} @var{d}))
@end example
@noindent
except that the subforms of @var{a}, @var{b}, and @var{c} are actually
evaluated only once each and in the apparent order.
-@end defspec
+@end defmac
-@defspec rotatef place@dots{}
+@defmac cl-rotatef place@dots{}
This macro rotates the @var{place}s left by one in circular fashion.
-Thus, @code{(rotatef @var{a} @var{b} @var{c} @var{d})} is equivalent to
+Thus, @code{(cl-rotatef @var{a} @var{b} @var{c} @var{d})} is equivalent to
@example
-(psetf @var{a} @var{b}
- @var{b} @var{c}
- @var{c} @var{d}
- @var{d} @var{a})
+(cl-psetf @var{a} @var{b}
+ @var{b} @var{c}
+ @var{c} @var{d}
+ @var{d} @var{a})
@end example
@noindent
-except for the evaluation of subforms. @code{rotatef} always
-returns @code{nil}. Note that @code{(rotatef @var{a} @var{b})}
+except for the evaluation of subforms. @code{cl-rotatef} always
+returns @code{nil}. Note that @code{(cl-rotatef @var{a} @var{b})}
conveniently exchanges @var{a} and @var{b}.
-@end defspec
+@end defmac
The following macros were invented for this package; they have no
analogues in Common Lisp.
-@defspec letf (bindings@dots{}) forms@dots{}
+@defmac cl-letf (bindings@dots{}) forms@dots{}
This macro is analogous to @code{let}, but for generalized variables
rather than just symbols. Each @var{binding} should be of the form
@code{(@var{place} @var{value})}; the original contents of the
@@ -1240,543 +1151,210 @@ error.
For example,
@example
-(letf (((point) (point-min))
- (a 17))
- ...)
+(cl-letf (((point) (point-min))
+ (a 17))
+ @dots{})
@end example
@noindent
-moves ``point'' in the current buffer to the beginning of the buffer,
+moves point in the current buffer to the beginning of the buffer,
and also binds @code{a} to 17 (as if by a normal @code{let}, since
@code{a} is just a regular variable). After the body exits, @code{a}
is set back to its original value and point is moved back to its
original position.
-Note that @code{letf} on @code{(point)} is not quite like a
+Note that @code{cl-letf} on @code{(point)} is not quite like a
@code{save-excursion}, as the latter effectively saves a marker
which tracks insertions and deletions in the buffer. Actually,
-a @code{letf} of @code{(point-marker)} is much closer to this
+a @code{cl-letf} of @code{(point-marker)} is much closer to this
behavior. (@code{point} and @code{point-marker} are equivalent
as @code{setf} places; each will accept either an integer or a
marker as the stored value.)
Since generalized variables look like lists, @code{let}'s shorthand
of using @samp{foo} for @samp{(foo nil)} as a @var{binding} would
-be ambiguous in @code{letf} and is not allowed.
+be ambiguous in @code{cl-letf} and is not allowed.
However, a @var{binding} specifier may be a one-element list
@samp{(@var{place})}, which is similar to @samp{(@var{place}
@var{place})}. In other words, the @var{place} is not disturbed
-on entry to the body, and the only effect of the @code{letf} is
-to restore the original value of @var{place} afterwards. (The
-redundant access-and-store suggested by the @code{(@var{place}
+on entry to the body, and the only effect of the @code{cl-letf} is
+to restore the original value of @var{place} afterwards.
+@c I suspect this may no longer be true; either way it's
+@c implementation detail and so not essential to document.
+@ignore
+(The redundant access-and-store suggested by the @code{(@var{place}
@var{place})} example does not actually occur.)
-
-In most cases, the @var{place} must have a well-defined value on
-entry to the @code{letf} form. The only exceptions are plain
-variables and calls to @code{symbol-value} and @code{symbol-function}.
-If the symbol is not bound on entry, it is simply made unbound by
-@code{makunbound} or @code{fmakunbound} on exit.
-@end defspec
-
-@defspec letf* (bindings@dots{}) forms@dots{}
-This macro is to @code{letf} what @code{let*} is to @code{let}:
+@end ignore
+
+Note that in this case, and in fact almost every case, @var{place}
+must have a well-defined value outside the @code{cl-letf} body.
+There is essentially only one exception to this, which is @var{place}
+a plain variable with a specified @var{value} (such as @code{(a 17)}
+in the above example).
+@c See http://debbugs.gnu.org/12758
+@c Some or all of this was true for cl.el, but not for cl-lib.el.
+@ignore
+The only exceptions are plain variables and calls to
+@code{symbol-value} and @code{symbol-function}. If the symbol is not
+bound on entry, it is simply made unbound by @code{makunbound} or
+@code{fmakunbound} on exit.
+@end ignore
+
+Note that the @file{cl.el} version of this macro behaves slightly
+differently. @xref{Obsolete Macros}.
+@end defmac
+
+@defmac cl-letf* (bindings@dots{}) forms@dots{}
+This macro is to @code{cl-letf} what @code{let*} is to @code{let}:
It does the bindings in sequential rather than parallel order.
-@end defspec
+@end defmac
-@defspec callf @var{function} @var{place} @var{args}@dots{}
+@defmac cl-callf @var{function} @var{place} @var{args}@dots{}
This is the ``generic'' modify macro. It calls @var{function},
which should be an unquoted function name, macro name, or lambda.
It passes @var{place} and @var{args} as arguments, and assigns the
-result back to @var{place}. For example, @code{(incf @var{place}
-@var{n})} is the same as @code{(callf + @var{place} @var{n})}.
+result back to @var{place}. For example, @code{(cl-incf @var{place}
+@var{n})} is the same as @code{(cl-callf + @var{place} @var{n})}.
Some more examples:
@example
-(callf abs my-number)
-(callf concat (buffer-name) "<" (int-to-string n) ">")
-(callf union happy-people (list joe bob) :test 'same-person)
+(cl-callf abs my-number)
+(cl-callf concat (buffer-name) "<" (number-to-string n) ">")
+(cl-callf cl-union happy-people (list joe bob) :test 'same-person)
@end example
-@xref{Customizing Setf}, for @code{define-modify-macro}, a way
-to create even more concise notations for modify macros. Note
-again that @code{callf} is an extension to standard Common Lisp.
-@end defspec
+Note again that @code{cl-callf} is an extension to standard Common Lisp.
+@end defmac
-@defspec callf2 @var{function} @var{arg1} @var{place} @var{args}@dots{}
-This macro is like @code{callf}, except that @var{place} is
+@defmac cl-callf2 @var{function} @var{arg1} @var{place} @var{args}@dots{}
+This macro is like @code{cl-callf}, except that @var{place} is
the @emph{second} argument of @var{function} rather than the
first. For example, @code{(push @var{x} @var{place})} is
-equivalent to @code{(callf2 cons @var{x} @var{place})}.
-@end defspec
-
-The @code{callf} and @code{callf2} macros serve as building
-blocks for other macros like @code{incf}, @code{pushnew}, and
-@code{define-modify-macro}. The @code{letf} and @code{letf*}
-macros are used in the processing of symbol macros;
-@pxref{Macro Bindings}.
-
-@node Customizing Setf, , Modify Macros, Generalized Variables
-@subsection Customizing Setf
-
-@noindent
-Common Lisp defines three macros, @code{define-modify-macro},
-@code{defsetf}, and @code{define-setf-method}, that allow the
-user to extend generalized variables in various ways.
-
-@defspec define-modify-macro name arglist function [doc-string]
-This macro defines a ``read-modify-write'' macro similar to
-@code{incf} and @code{decf}. The macro @var{name} is defined
-to take a @var{place} argument followed by additional arguments
-described by @var{arglist}. The call
-
-@example
-(@var{name} @var{place} @var{args}...)
-@end example
-
-@noindent
-will be expanded to
-
-@example
-(callf @var{func} @var{place} @var{args}...)
-@end example
-
-@noindent
-which in turn is roughly equivalent to
-
-@example
-(setf @var{place} (@var{func} @var{place} @var{args}...))
-@end example
+equivalent to @code{(cl-callf2 cons @var{x} @var{place})}.
+@end defmac
-For example:
-
-@example
-(define-modify-macro incf (&optional (n 1)) +)
-(define-modify-macro concatf (&rest args) concat)
-@end example
-
-Note that @code{&key} is not allowed in @var{arglist}, but
-@code{&rest} is sufficient to pass keywords on to the function.
-
-Most of the modify macros defined by Common Lisp do not exactly
-follow the pattern of @code{define-modify-macro}. For example,
-@code{push} takes its arguments in the wrong order, and @code{pop}
-is completely irregular. You can define these macros ``by hand''
-using @code{get-setf-method}, or consult the source file
-@file{cl-macs.el} to see how to use the internal @code{setf}
-building blocks.
-@end defspec
-
-@defspec defsetf access-fn update-fn
-This is the simpler of two @code{defsetf} forms. Where
-@var{access-fn} is the name of a function which accesses a place,
-this declares @var{update-fn} to be the corresponding store
-function. From now on,
-
-@example
-(setf (@var{access-fn} @var{arg1} @var{arg2} @var{arg3}) @var{value})
-@end example
-
-@noindent
-will be expanded to
-
-@example
-(@var{update-fn} @var{arg1} @var{arg2} @var{arg3} @var{value})
-@end example
-
-@noindent
-The @var{update-fn} is required to be either a true function, or
-a macro which evaluates its arguments in a function-like way. Also,
-the @var{update-fn} is expected to return @var{value} as its result.
-Otherwise, the above expansion would not obey the rules for the way
-@code{setf} is supposed to behave.
-
-As a special (non-Common-Lisp) extension, a third argument of @code{t}
-to @code{defsetf} says that the @code{update-fn}'s return value is
-not suitable, so that the above @code{setf} should be expanded to
-something more like
-
-@example
-(let ((temp @var{value}))
- (@var{update-fn} @var{arg1} @var{arg2} @var{arg3} temp)
- temp)
-@end example
+The @code{cl-callf} and @code{cl-callf2} macros serve as building
+blocks for other macros like @code{cl-incf}, and @code{cl-pushnew}.
+The @code{cl-letf} and @code{cl-letf*} macros are used in the processing
+of symbol macros; @pxref{Macro Bindings}.
-Some examples of the use of @code{defsetf}, drawn from the standard
-suite of setf methods, are:
-
-@example
-(defsetf car setcar)
-(defsetf symbol-value set)
-(defsetf buffer-name rename-buffer t)
-@end example
-@end defspec
-
-@defspec defsetf access-fn arglist (store-var) forms@dots{}
-This is the second, more complex, form of @code{defsetf}. It is
-rather like @code{defmacro} except for the additional @var{store-var}
-argument. The @var{forms} should return a Lisp form which stores
-the value of @var{store-var} into the generalized variable formed
-by a call to @var{access-fn} with arguments described by @var{arglist}.
-The @var{forms} may begin with a string which documents the @code{setf}
-method (analogous to the doc string that appears at the front of a
-function).
-
-For example, the simple form of @code{defsetf} is shorthand for
-
-@example
-(defsetf @var{access-fn} (&rest args) (store)
- (append '(@var{update-fn}) args (list store)))
-@end example
-
-The Lisp form that is returned can access the arguments from
-@var{arglist} and @var{store-var} in an unrestricted fashion;
-macros like @code{setf} and @code{incf} which invoke this
-setf-method will insert temporary variables as needed to make
-sure the apparent order of evaluation is preserved.
-
-Another example drawn from the standard package:
-
-@example
-(defsetf nth (n x) (store)
- (list 'setcar (list 'nthcdr n x) store))
-@end example
-@end defspec
-
-@defspec define-setf-method access-fn arglist forms@dots{}
-This is the most general way to create new place forms. When
-a @code{setf} to @var{access-fn} with arguments described by
-@var{arglist} is expanded, the @var{forms} are evaluated and
-must return a list of five items:
-
-@enumerate
-@item
-A list of @dfn{temporary variables}.
-
-@item
-A list of @dfn{value forms} corresponding to the temporary variables
-above. The temporary variables will be bound to these value forms
-as the first step of any operation on the generalized variable.
-
-@item
-A list of exactly one @dfn{store variable} (generally obtained
-from a call to @code{gensym}).
-
-@item
-A Lisp form which stores the contents of the store variable into
-the generalized variable, assuming the temporaries have been
-bound as described above.
-@item
-A Lisp form which accesses the contents of the generalized variable,
-assuming the temporaries have been bound.
-@end enumerate
-
-This is exactly like the Common Lisp macro of the same name,
-except that the method returns a list of five values rather
-than the five values themselves, since Emacs Lisp does not
-support Common Lisp's notion of multiple return values.
-
-Once again, the @var{forms} may begin with a documentation string.
-
-A setf-method should be maximally conservative with regard to
-temporary variables. In the setf-methods generated by
-@code{defsetf}, the second return value is simply the list of
-arguments in the place form, and the first return value is a
-list of a corresponding number of temporary variables generated
-by @code{gensym}. Macros like @code{setf} and @code{incf} which
-use this setf-method will optimize away most temporaries that
-turn out to be unnecessary, so there is little reason for the
-setf-method itself to optimize.
-@end defspec
-
-@defun get-setf-method place &optional env
-This function returns the setf-method for @var{place}, by
-invoking the definition previously recorded by @code{defsetf}
-or @code{define-setf-method}. The result is a list of five
-values as described above. You can use this function to build
-your own @code{incf}-like modify macros. (Actually, it is
-better to use the internal functions @code{cl-setf-do-modify}
-and @code{cl-setf-do-store}, which are a bit easier to use and
-which also do a number of optimizations; consult the source
-code for the @code{incf} function for a simple example.)
-
-The argument @var{env} specifies the ``environment'' to be
-passed on to @code{macroexpand} if @code{get-setf-method} should
-need to expand a macro in @var{place}. It should come from
-an @code{&environment} argument to the macro or setf-method
-that called @code{get-setf-method}.
-
-See also the source code for the setf-methods for @code{apply}
-and @code{substring}, each of which works by calling
-@code{get-setf-method} on a simpler case, then massaging
-the result in various ways.
-@end defun
-
-Modern Common Lisp defines a second, independent way to specify
-the @code{setf} behavior of a function, namely ``@code{setf}
-functions'' whose names are lists @code{(setf @var{name})}
-rather than symbols. For example, @code{(defun (setf foo) @dots{})}
-defines the function that is used when @code{setf} is applied to
-@code{foo}. This package does not currently support @code{setf}
-functions. In particular, it is a compile-time error to use
-@code{setf} on a form which has not already been @code{defsetf}'d
-or otherwise declared; in newer Common Lisps, this would not be
-an error since the function @code{(setf @var{func})} might be
-defined later.
-
-@iftex
-@secno=4
-@end iftex
-
-@node Variable Bindings, Conditionals, Generalized Variables, Control Structure
+@node Variable Bindings
@section Variable Bindings
@noindent
These Lisp forms make bindings to variables and function names,
analogous to Lisp's built-in @code{let} form.
-@xref{Modify Macros}, for the @code{letf} and @code{letf*} forms which
+@xref{Modify Macros}, for the @code{cl-letf} and @code{cl-letf*} forms which
are also related to variable bindings.
@menu
-* Dynamic Bindings:: The `progv' form
-* Lexical Bindings:: `lexical-let' and lexical closures
-* Function Bindings:: `flet' and `labels'
-* Macro Bindings:: `macrolet' and `symbol-macrolet'
+* Dynamic Bindings:: The @code{cl-progv} form.
+* Function Bindings:: @code{cl-flet} and @code{cl-labels}.
+* Macro Bindings:: @code{cl-macrolet} and @code{cl-symbol-macrolet}.
@end menu
-@node Dynamic Bindings, Lexical Bindings, Variable Bindings, Variable Bindings
+@node Dynamic Bindings
@subsection Dynamic Bindings
@noindent
The standard @code{let} form binds variables whose names are known
-at compile-time. The @code{progv} form provides an easy way to
+at compile-time. The @code{cl-progv} form provides an easy way to
bind variables whose names are computed at run-time.
-@defspec progv symbols values forms@dots{}
+@defmac cl-progv symbols values forms@dots{}
This form establishes @code{let}-style variable bindings on a
set of variables computed at run-time. The expressions
@var{symbols} and @var{values} are evaluated, and must return lists
of symbols and values, respectively. The symbols are bound to the
corresponding values for the duration of the body @var{form}s.
If @var{values} is shorter than @var{symbols}, the last few symbols
-are made unbound (as if by @code{makunbound}) inside the body.
+are bound to @code{nil}.
If @var{symbols} is shorter than @var{values}, the excess values
are ignored.
-@end defspec
-
-@node Lexical Bindings, Function Bindings, Dynamic Bindings, Variable Bindings
-@subsection Lexical Bindings
-
-@noindent
-The @dfn{CL} package defines the following macro which
-more closely follows the Common Lisp @code{let} form:
-
-@defspec lexical-let (bindings@dots{}) forms@dots{}
-This form is exactly like @code{let} except that the bindings it
-establishes are purely lexical. Lexical bindings are similar to
-local variables in a language like C: Only the code physically
-within the body of the @code{lexical-let} (after macro expansion)
-may refer to the bound variables.
-
-@example
-(setq a 5)
-(defun foo (b) (+ a b))
-(let ((a 2)) (foo a))
- @result{} 4
-(lexical-let ((a 2)) (foo a))
- @result{} 7
-@end example
-
-@noindent
-In this example, a regular @code{let} binding of @code{a} actually
-makes a temporary change to the global variable @code{a}, so @code{foo}
-is able to see the binding of @code{a} to 2. But @code{lexical-let}
-actually creates a distinct local variable @code{a} for use within its
-body, without any effect on the global variable of the same name.
-
-The most important use of lexical bindings is to create @dfn{closures}.
-A closure is a function object that refers to an outside lexical
-variable. For example:
-
-@example
-(defun make-adder (n)
- (lexical-let ((n n))
- (function (lambda (m) (+ n m)))))
-(setq add17 (make-adder 17))
-(funcall add17 4)
- @result{} 21
-@end example
-
-@noindent
-The call @code{(make-adder 17)} returns a function object which adds
-17 to its argument. If @code{let} had been used instead of
-@code{lexical-let}, the function object would have referred to the
-global @code{n}, which would have been bound to 17 only during the
-call to @code{make-adder} itself.
+@end defmac
-@example
-(defun make-counter ()
- (lexical-let ((n 0))
- (function* (lambda (&optional (m 1)) (incf n m)))))
-(setq count-1 (make-counter))
-(funcall count-1 3)
- @result{} 3
-(funcall count-1 14)
- @result{} 17
-(setq count-2 (make-counter))
-(funcall count-2 5)
- @result{} 5
-(funcall count-1 2)
- @result{} 19
-(funcall count-2)
- @result{} 6
-@end example
-
-@noindent
-Here we see that each call to @code{make-counter} creates a distinct
-local variable @code{n}, which serves as a private counter for the
-function object that is returned.
-
-Closed-over lexical variables persist until the last reference to
-them goes away, just like all other Lisp objects. For example,
-@code{count-2} refers to a function object which refers to an
-instance of the variable @code{n}; this is the only reference
-to that variable, so after @code{(setq count-2 nil)} the garbage
-collector would be able to delete this instance of @code{n}.
-Of course, if a @code{lexical-let} does not actually create any
-closures, then the lexical variables are free as soon as the
-@code{lexical-let} returns.
-
-Many closures are used only during the extent of the bindings they
-refer to; these are known as ``downward funargs'' in Lisp parlance.
-When a closure is used in this way, regular Emacs Lisp dynamic
-bindings suffice and will be more efficient than @code{lexical-let}
-closures:
-
-@example
-(defun add-to-list (x list)
- (mapcar (lambda (y) (+ x y))) list)
-(add-to-list 7 '(1 2 5))
- @result{} (8 9 12)
-@end example
-
-@noindent
-Since this lambda is only used while @code{x} is still bound,
-it is not necessary to make a true closure out of it.
-
-You can use @code{defun} or @code{flet} inside a @code{lexical-let}
-to create a named closure. If several closures are created in the
-body of a single @code{lexical-let}, they all close over the same
-instance of the lexical variable.
-
-The @code{lexical-let} form is an extension to Common Lisp. In
-true Common Lisp, all bindings are lexical unless declared otherwise.
-@end defspec
-
-@defspec lexical-let* (bindings@dots{}) forms@dots{}
-This form is just like @code{lexical-let}, except that the bindings
-are made sequentially in the manner of @code{let*}.
-@end defspec
-
-@node Function Bindings, Macro Bindings, Lexical Bindings, Variable Bindings
+@node Function Bindings
@subsection Function Bindings
@noindent
These forms make @code{let}-like bindings to functions instead
of variables.
-@defspec flet (bindings@dots{}) forms@dots{}
+@defmac cl-flet (bindings@dots{}) forms@dots{}
This form establishes @code{let}-style bindings on the function
cells of symbols rather than on the value cells. Each @var{binding}
must be a list of the form @samp{(@var{name} @var{arglist}
@var{forms}@dots{})}, which defines a function exactly as if
-it were a @code{defun*} form. The function @var{name} is defined
-accordingly for the duration of the body of the @code{flet}; then
+it were a @code{cl-defun} form. The function @var{name} is defined
+accordingly for the duration of the body of the @code{cl-flet}; then
the old function definition, or lack thereof, is restored.
-While @code{flet} in Common Lisp establishes a lexical binding of
-@var{name}, Emacs Lisp @code{flet} makes a dynamic binding. The
-result is that @code{flet} affects indirect calls to a function as
-well as calls directly inside the @code{flet} form itself.
-
-You can use @code{flet} to disable or modify the behavior of a
-function in a temporary fashion. This will even work on Emacs
-primitives, although note that some calls to primitive functions
-internal to Emacs are made without going through the symbol's
-function cell, and so will not be affected by @code{flet}. For
-example,
+You can use @code{cl-flet} to disable or modify the behavior of
+functions (including Emacs primitives) in a temporary, localized fashion.
+(Compare this with the idea of advising functions.
+@xref{Advising Functions,,,elisp,GNU Emacs Lisp Reference Manual}.)
-@example
-(flet ((message (&rest args) (push args saved-msgs)))
- (do-something))
-@end example
+The bindings are lexical in scope. This means that all references to
+the named functions must appear physically within the body of the
+@code{cl-flet} form.
-This code attempts to replace the built-in function @code{message}
-with a function that simply saves the messages in a list rather
-than displaying them. The original definition of @code{message}
-will be restored after @code{do-something} exits. This code will
-work fine on messages generated by other Lisp code, but messages
-generated directly inside Emacs will not be caught since they make
-direct C-language calls to the message routines rather than going
-through the Lisp @code{message} function.
+Functions defined by @code{cl-flet} may use the full Common Lisp
+argument notation supported by @code{cl-defun}; also, the function
+body is enclosed in an implicit block as if by @code{cl-defun}.
+@xref{Program Structure}.
-@c Bug#411.
-Also note that many primitives (e.g. @code{+}) have special byte-compile
-handling. Attempts to redefine such functions using @code{flet} will
-fail if byte-compiled. In such cases, use @code{labels} instead.
+Note that the @file{cl.el} version of this macro behaves slightly
+differently. In particular, its binding is dynamic rather than
+lexical. @xref{Obsolete Macros}.
+@end defmac
-Functions defined by @code{flet} may use the full Common Lisp
-argument notation supported by @code{defun*}; also, the function
-body is enclosed in an implicit block as if by @code{defun*}.
-@xref{Program Structure}.
-@end defspec
-
-@defspec labels (bindings@dots{}) forms@dots{}
-The @code{labels} form is like @code{flet}, except that it
-makes lexical bindings of the function names rather than
-dynamic bindings. (In true Common Lisp, both @code{flet} and
-@code{labels} make lexical bindings of slightly different sorts;
-since Emacs Lisp is dynamically bound by default, it seemed
-more appropriate for @code{flet} also to use dynamic binding.
-The @code{labels} form, with its lexical binding, is fully
-compatible with Common Lisp.)
+@defmac cl-labels (bindings@dots{}) forms@dots{}
+The @code{cl-labels} form is like @code{cl-flet}, except that
+the function bindings can be recursive. The scoping is lexical,
+but you can only capture functions in closures if
+@code{lexical-binding} is @code{t}.
+@xref{Closures,,,elisp,GNU Emacs Lisp Reference Manual}, and
+@ref{Using Lexical Binding,,,elisp,GNU Emacs Lisp Reference Manual}.
Lexical scoping means that all references to the named
functions must appear physically within the body of the
-@code{labels} form. References may appear both in the body
-@var{forms} of @code{labels} itself, and in the bodies of
-the functions themselves. Thus, @code{labels} can define
-local recursive functions, or mutually-recursive sets of
-functions.
+@code{cl-labels} form. References may appear both in the body
+@var{forms} of @code{cl-labels} itself, and in the bodies of
+the functions themselves. Thus, @code{cl-labels} can define
+local recursive functions, or mutually-recursive sets of functions.
A ``reference'' to a function name is either a call to that
function, or a use of its name quoted by @code{quote} or
@code{function} to be passed on to, say, @code{mapcar}.
-@end defspec
-@node Macro Bindings, , Function Bindings, Variable Bindings
+Note that the @file{cl.el} version of this macro behaves slightly
+differently. @xref{Obsolete Macros}.
+@end defmac
+
+@node Macro Bindings
@subsection Macro Bindings
@noindent
-These forms create local macros and ``symbol macros.''
+These forms create local macros and ``symbol macros''.
-@defspec macrolet (bindings@dots{}) forms@dots{}
-This form is analogous to @code{flet}, but for macros instead of
+@defmac cl-macrolet (bindings@dots{}) forms@dots{}
+This form is analogous to @code{cl-flet}, but for macros instead of
functions. Each @var{binding} is a list of the same form as the
-arguments to @code{defmacro*} (i.e., a macro name, argument list,
+arguments to @code{cl-defmacro} (i.e., a macro name, argument list,
and macro-expander forms). The macro is defined accordingly for
-use within the body of the @code{macrolet}.
+use within the body of the @code{cl-macrolet}.
-Because of the nature of macros, @code{macrolet} is lexically
-scoped even in Emacs Lisp: The @code{macrolet} binding will
+Because of the nature of macros, @code{cl-macrolet} is always lexically
+scoped. The @code{cl-macrolet} binding will
affect only calls that appear physically within the body
@var{forms}, possibly after expansion of other macros in the
body.
-@end defspec
+@end defmac
-@defspec symbol-macrolet (bindings@dots{}) forms@dots{}
+@defmac cl-symbol-macrolet (bindings@dots{}) forms@dots{}
This form creates @dfn{symbol macros}, which are macros that look
like variable references rather than function calls. Each
@var{binding} is a list @samp{(@var{var} @var{expansion})};
@@ -1785,8 +1363,8 @@ replaced by @var{expansion}.
@example
(setq bar '(5 . 9))
-(symbol-macrolet ((foo (car bar)))
- (incf foo))
+(cl-symbol-macrolet ((foo (car bar)))
+ (cl-incf foo))
bar
@result{} (6 . 9)
@end example
@@ -1796,25 +1374,31 @@ I.e., @code{(setq foo 4)} in the above would be equivalent to
@code{(setf foo 4)}, which in turn expands to @code{(setf (car bar) 4)}.
Likewise, a @code{let} or @code{let*} binding a symbol macro is
-treated like a @code{letf} or @code{letf*}. This differs from true
+treated like a @code{cl-letf} or @code{cl-letf*}. This differs from true
Common Lisp, where the rules of lexical scoping cause a @code{let}
binding to shadow a @code{symbol-macrolet} binding. In this package,
-only @code{lexical-let} and @code{lexical-let*} will shadow a symbol
-macro.
+such shadowing does not occur, even when @code{lexical-binding} is
+@c See http://debbugs.gnu.org/12119
+@code{t}. (This behavior predates the addition of lexical binding to
+Emacs Lisp, and may change in future to respect @code{lexical-binding}.)
+At present in this package, only @code{lexical-let} and
+@code{lexical-let*} will shadow a symbol macro. @xref{Obsolete
+Lexical Binding}.
There is no analogue of @code{defmacro} for symbol macros; all symbol
-macros are local. A typical use of @code{symbol-macrolet} is in the
+macros are local. A typical use of @code{cl-symbol-macrolet} is in the
expansion of another macro:
@example
-(defmacro* my-dolist ((x list) &rest body)
- (let ((var (gensym)))
- (list 'loop 'for var 'on list 'do
- (list* 'symbol-macrolet (list (list x (list 'car var)))
- body))))
+(cl-defmacro my-dolist ((x list) &rest body)
+ (let ((var (cl-gensym)))
+ (list 'cl-loop 'for var 'on list 'do
+ (cl-list* 'cl-symbol-macrolet
+ (list (list x (list 'car var)))
+ body))))
(setq mylist '(1 2 3 4))
-(my-dolist (x mylist) (incf x))
+(my-dolist (x mylist) (cl-incf x))
mylist
@result{} (2 3 4 5)
@end example
@@ -1826,35 +1410,35 @@ reference onto the elements of the list. The @code{my-dolist} call
shown here expands to
@example
-(loop for G1234 on mylist do
- (symbol-macrolet ((x (car G1234)))
- (incf x)))
+(cl-loop for G1234 on mylist do
+ (cl-symbol-macrolet ((x (car G1234)))
+ (cl-incf x)))
@end example
@noindent
which in turn expands to
@example
-(loop for G1234 on mylist do (incf (car G1234)))
+(cl-loop for G1234 on mylist do (cl-incf (car G1234)))
@end example
-@xref{Loop Facility}, for a description of the @code{loop} macro.
+@xref{Loop Facility}, for a description of the @code{cl-loop} macro.
This package defines a nonstandard @code{in-ref} loop clause that
works much like @code{my-dolist}.
-@end defspec
+@end defmac
-@node Conditionals, Blocks and Exits, Variable Bindings, Control Structure
+@node Conditionals
@section Conditionals
@noindent
These conditional forms augment Emacs Lisp's simple @code{if},
@code{and}, @code{or}, and @code{cond} forms.
-@defspec case keyform clause@dots{}
+@defmac cl-case keyform clause@dots{}
This macro evaluates @var{keyform}, then compares it with the key
values listed in the various @var{clause}s. Whichever clause matches
the key is executed; comparison is done by @code{eql}. If no clause
-matches, the @code{case} form returns @code{nil}. The clauses are
+matches, the @code{cl-case} form returns @code{nil}. The clauses are
of the form
@example
@@ -1865,7 +1449,7 @@ of the form
where @var{keylist} is a list of key values. If there is exactly
one value, and it is not a cons cell or the symbol @code{nil} or
@code{t}, then it can be used by itself as a @var{keylist} without
-being enclosed in a list. All key values in the @code{case} form
+being enclosed in a list. All key values in the @code{cl-case} form
must be distinct. The final clauses may use @code{t} in place of
a @var{keylist} to indicate a default clause that should be taken
if none of the other clauses match. (The symbol @code{otherwise}
@@ -1878,28 +1462,28 @@ four things depending on whether it is an @samp{a}, a @samp{b},
a @key{RET} or @kbd{C-j}, or anything else.
@example
-(case (read-char)
+(cl-case (read-char)
(?a (do-a-thing))
(?b (do-b-thing))
((?\r ?\n) (do-ret-thing))
(t (do-other-thing)))
@end example
-@end defspec
+@end defmac
-@defspec ecase keyform clause@dots{}
-This macro is just like @code{case}, except that if the key does
+@defmac cl-ecase keyform clause@dots{}
+This macro is just like @code{cl-case}, except that if the key does
not match any of the clauses, an error is signaled rather than
simply returning @code{nil}.
-@end defspec
+@end defmac
-@defspec typecase keyform clause@dots{}
-This macro is a version of @code{case} that checks for types
+@defmac cl-typecase keyform clause@dots{}
+This macro is a version of @code{cl-case} that checks for types
rather than values. Each @var{clause} is of the form
-@samp{(@var{type} @var{body}...)}. @xref{Type Predicates},
+@samp{(@var{type} @var{body}@dots{})}. @xref{Type Predicates},
for a description of type specifiers. For example,
@example
-(typecase x
+(cl-typecase x
(integer (munch-integer x))
(float (munch-float x))
(string (munch-integer (string-to-int x)))
@@ -1908,41 +1492,42 @@ for a description of type specifiers. For example,
The type specifier @code{t} matches any type of object; the word
@code{otherwise} is also allowed. To make one clause match any of
-several types, use an @code{(or ...)} type specifier.
-@end defspec
+several types, use an @code{(or @dots{})} type specifier.
+@end defmac
-@defspec etypecase keyform clause@dots{}
-This macro is just like @code{typecase}, except that if the key does
+@defmac cl-etypecase keyform clause@dots{}
+This macro is just like @code{cl-typecase}, except that if the key does
not match any of the clauses, an error is signaled rather than
simply returning @code{nil}.
-@end defspec
+@end defmac
-@node Blocks and Exits, Iteration, Conditionals, Control Structure
+@node Blocks and Exits
@section Blocks and Exits
@noindent
Common Lisp @dfn{blocks} provide a non-local exit mechanism very
-similar to @code{catch} and @code{throw}, but lexically rather than
-dynamically scoped. This package actually implements @code{block}
+similar to @code{catch} and @code{throw}, with lexical scoping.
+This package actually implements @code{cl-block}
in terms of @code{catch}; however, the lexical scoping allows the
-optimizing byte-compiler to omit the costly @code{catch} step if the
-body of the block does not actually @code{return-from} the block.
+byte-compiler to omit the costly @code{catch} step if the
+body of the block does not actually @code{cl-return-from} the block.
-@defspec block name forms@dots{}
+@defmac cl-block name forms@dots{}
The @var{forms} are evaluated as if by a @code{progn}. However,
-if any of the @var{forms} execute @code{(return-from @var{name})},
-they will jump out and return directly from the @code{block} form.
-The @code{block} returns the result of the last @var{form} unless
-a @code{return-from} occurs.
+if any of the @var{forms} execute @code{(cl-return-from @var{name})},
+they will jump out and return directly from the @code{cl-block} form.
+The @code{cl-block} returns the result of the last @var{form} unless
+a @code{cl-return-from} occurs.
-The @code{block}/@code{return-from} mechanism is quite similar to
+The @code{cl-block}/@code{cl-return-from} mechanism is quite similar to
the @code{catch}/@code{throw} mechanism. The main differences are
that block @var{name}s are unevaluated symbols, rather than forms
-(such as quoted symbols) which evaluate to a tag at run-time; and
-also that blocks are lexically scoped whereas @code{catch}/@code{throw}
-are dynamically scoped. This means that functions called from the
-body of a @code{catch} can also @code{throw} to the @code{catch},
-but the @code{return-from} referring to a block name must appear
+(such as quoted symbols) that evaluate to a tag at run-time; and
+also that blocks are always lexically scoped.
+In a dynamically scoped @code{catch}, functions called from the
+@code{catch} body can also @code{throw} to the @code{catch}. This
+is not an option for @code{cl-block}, where
+the @code{cl-return-from} referring to a block name must appear
physically within the @var{forms} that make up the body of the block.
They may not appear within other called functions, although they may
appear within macro expansions or @code{lambda}s in the body. Block
@@ -1951,66 +1536,66 @@ names and @code{catch} names form independent name-spaces.
In true Common Lisp, @code{defun} and @code{defmacro} surround
the function or expander bodies with implicit blocks with the
same name as the function or macro. This does not occur in Emacs
-Lisp, but this package provides @code{defun*} and @code{defmacro*}
-forms which do create the implicit block.
+Lisp, but this package provides @code{cl-defun} and @code{cl-defmacro}
+forms, which do create the implicit block.
The Common Lisp looping constructs defined by this package,
-such as @code{loop} and @code{dolist}, also create implicit blocks
+such as @code{cl-loop} and @code{cl-dolist}, also create implicit blocks
just as in Common Lisp.
-Because they are implemented in terms of Emacs Lisp @code{catch}
+Because they are implemented in terms of Emacs Lisp's @code{catch}
and @code{throw}, blocks have the same overhead as actual
@code{catch} constructs (roughly two function calls). However,
-the optimizing byte compiler will optimize away the @code{catch}
+the byte compiler will optimize away the @code{catch}
if the block does
-not in fact contain any @code{return} or @code{return-from} calls
-that jump to it. This means that @code{do} loops and @code{defun*}
-functions which don't use @code{return} don't pay the overhead to
+not in fact contain any @code{cl-return} or @code{cl-return-from} calls
+that jump to it. This means that @code{cl-do} loops and @code{cl-defun}
+functions that don't use @code{cl-return} don't pay the overhead to
support it.
-@end defspec
+@end defmac
-@defspec return-from name [result]
+@defmac cl-return-from name [result]
This macro returns from the block named @var{name}, which must be
an (unevaluated) symbol. If a @var{result} form is specified, it
is evaluated to produce the result returned from the @code{block}.
Otherwise, @code{nil} is returned.
-@end defspec
+@end defmac
-@defspec return [result]
-This macro is exactly like @code{(return-from nil @var{result})}.
-Common Lisp loops like @code{do} and @code{dolist} implicitly enclose
+@defmac cl-return [result]
+This macro is exactly like @code{(cl-return-from nil @var{result})}.
+Common Lisp loops like @code{cl-do} and @code{cl-dolist} implicitly enclose
themselves in @code{nil} blocks.
-@end defspec
+@end defmac
-@node Iteration, Loop Facility, Blocks and Exits, Control Structure
+@node Iteration
@section Iteration
@noindent
The macros described here provide more sophisticated, high-level
-looping constructs to complement Emacs Lisp's basic @code{while}
-loop.
+looping constructs to complement Emacs Lisp's basic loop forms
+(@pxref{Iteration,,,elisp,GNU Emacs Lisp Reference Manual}).
-@defspec loop forms@dots{}
-The @dfn{CL} package supports both the simple, old-style meaning of
+@defmac cl-loop forms@dots{}
+This package supports both the simple, old-style meaning of
@code{loop} and the extremely powerful and flexible feature known as
the @dfn{Loop Facility} or @dfn{Loop Macro}. This more advanced
facility is discussed in the following section; @pxref{Loop Facility}.
The simple form of @code{loop} is described here.
-If @code{loop} is followed by zero or more Lisp expressions,
-then @code{(loop @var{exprs}@dots{})} simply creates an infinite
+If @code{cl-loop} is followed by zero or more Lisp expressions,
+then @code{(cl-loop @var{exprs}@dots{})} simply creates an infinite
loop executing the expressions over and over. The loop is
enclosed in an implicit @code{nil} block. Thus,
@example
-(loop (foo) (if (no-more) (return 72)) (bar))
+(cl-loop (foo) (if (no-more) (return 72)) (bar))
@end example
@noindent
is exactly equivalent to
@example
-(block nil (while t (foo) (if (no-more) (return 72)) (bar)))
+(cl-block nil (while t (foo) (if (no-more) (return 72)) (bar)))
@end example
If any of the expressions are plain symbols, the loop is instead
@@ -2018,9 +1603,9 @@ interpreted as a Loop Macro specification as described later.
(This is not a restriction in practice, since a plain symbol
in the above notation would simply access and throw away the
value of a variable.)
-@end defspec
+@end defmac
-@defspec do (spec@dots{}) (end-test [result@dots{}]) forms@dots{}
+@defmac cl-do (spec@dots{}) (end-test [result@dots{}]) forms@dots{}
This macro creates a general iterative loop. Each @var{spec} is
of the form
@@ -2033,18 +1618,18 @@ associated @var{init} value as if by a @code{let} form. Then, in
each iteration of the loop, the @var{end-test} is evaluated; if
true, the loop is finished. Otherwise, the body @var{forms} are
evaluated, then each @var{var} is set to the associated @var{step}
-expression (as if by a @code{psetq} form) and the next iteration
+expression (as if by a @code{cl-psetq} form) and the next iteration
begins. Once the @var{end-test} becomes true, the @var{result}
forms are evaluated (with the @var{var}s still bound to their
-values) to produce the result returned by @code{do}.
+values) to produce the result returned by @code{cl-do}.
-The entire @code{do} loop is enclosed in an implicit @code{nil}
-block, so that you can use @code{(return)} to break out of the
+The entire @code{cl-do} loop is enclosed in an implicit @code{nil}
+block, so that you can use @code{(cl-return)} to break out of the
loop at any time.
If there are no @var{result} forms, the loop returns @code{nil}.
If a given @var{var} has no @var{step} form, it is bound to its
-@var{init} value but not otherwise modified during the @code{do}
+@var{init} value but not otherwise modified during the @code{cl-do}
loop (unless the code explicitly modifies it); this case is just
a shorthand for putting a @code{(let ((@var{var} @var{init})) @dots{})}
around the loop. If @var{init} is also omitted it defaults to
@@ -2052,63 +1637,59 @@ around the loop. If @var{init} is also omitted it defaults to
in place of @samp{(@var{var})}, again following the analogy with
@code{let}.
-This example (from Steele) illustrates a loop which applies the
+This example (from Steele) illustrates a loop that applies the
function @code{f} to successive pairs of values from the lists
@code{foo} and @code{bar}; it is equivalent to the call
-@code{(mapcar* 'f foo bar)}. Note that this loop has no body
+@code{(cl-mapcar 'f foo bar)}. Note that this loop has no body
@var{forms} at all, performing all its work as side effects of
the rest of the loop.
@example
-(do ((x foo (cdr x))
- (y bar (cdr y))
- (z nil (cons (f (car x) (car y)) z)))
- ((or (null x) (null y))
- (nreverse z)))
+(cl-do ((x foo (cdr x))
+ (y bar (cdr y))
+ (z nil (cons (f (car x) (car y)) z)))
+ ((or (null x) (null y))
+ (nreverse z)))
@end example
-@end defspec
+@end defmac
-@defspec do* (spec@dots{}) (end-test [result@dots{}]) forms@dots{}
-This is to @code{do} what @code{let*} is to @code{let}. In
+@defmac cl-do* (spec@dots{}) (end-test [result@dots{}]) forms@dots{}
+This is to @code{cl-do} what @code{let*} is to @code{let}. In
particular, the initial values are bound as if by @code{let*}
rather than @code{let}, and the steps are assigned as if by
-@code{setq} rather than @code{psetq}.
+@code{setq} rather than @code{cl-psetq}.
Here is another way to write the above loop:
@example
-(do* ((xp foo (cdr xp))
- (yp bar (cdr yp))
- (x (car xp) (car xp))
- (y (car yp) (car yp))
- z)
+(cl-do* ((xp foo (cdr xp))
+ (yp bar (cdr yp))
+ (x (car xp) (car xp))
+ (y (car yp) (car yp))
+ z)
((or (null xp) (null yp))
(nreverse z))
(push (f x y) z))
@end example
-@end defspec
-
-@defspec dolist (var list [result]) forms@dots{}
-This is a more specialized loop which iterates across the elements
-of a list. @var{list} should evaluate to a list; the body @var{forms}
-are executed with @var{var} bound to each element of the list in
-turn. Finally, the @var{result} form (or @code{nil}) is evaluated
-with @var{var} bound to @code{nil} to produce the result returned by
-the loop. Unlike with Emacs's built in @code{dolist}, the loop is
-surrounded by an implicit @code{nil} block.
-@end defspec
-
-@defspec dotimes (var count [result]) forms@dots{}
-This is a more specialized loop which iterates a specified number
-of times. The body is executed with @var{var} bound to the integers
+@end defmac
+
+@defmac cl-dolist (var list [result]) forms@dots{}
+This is exactly like the standard Emacs Lisp macro @code{dolist},
+but surrounds the loop with an implicit @code{nil} block.
+@end defmac
+
+@defmac cl-dotimes (var count [result]) forms@dots{}
+This is exactly like the standard Emacs Lisp macro @code{dotimes},
+but surrounds the loop with an implicit @code{nil} block.
+The body is executed with @var{var} bound to the integers
from zero (inclusive) to @var{count} (exclusive), in turn. Then
+@c FIXME lispref does not state this part explicitly, could move this there.
the @code{result} form is evaluated with @var{var} bound to the total
number of iterations that were done (i.e., @code{(max 0 @var{count})})
-to get the return value for the loop form. Unlike with Emacs's built in
-@code{dolist}, the loop is surrounded by an implicit @code{nil} block.
-@end defspec
+to get the return value for the loop form.
+@end defmac
-@defspec do-symbols (var [obarray [result]]) forms@dots{}
+@defmac cl-do-symbols (var [obarray [result]]) forms@dots{}
This loop iterates over all interned symbols. If @var{obarray}
is specified and is not @code{nil}, it loops over all symbols in
that obarray. For each symbol, the body @var{forms} are evaluated
@@ -2116,55 +1697,55 @@ with @var{var} bound to that symbol. The symbols are visited in
an unspecified order. Afterward the @var{result} form, if any,
is evaluated (with @var{var} bound to @code{nil}) to get the return
value. The loop is surrounded by an implicit @code{nil} block.
-@end defspec
+@end defmac
-@defspec do-all-symbols (var [result]) forms@dots{}
-This is identical to @code{do-symbols} except that the @var{obarray}
+@defmac cl-do-all-symbols (var [result]) forms@dots{}
+This is identical to @code{cl-do-symbols} except that the @var{obarray}
argument is omitted; it always iterates over the default obarray.
-@end defspec
+@end defmac
@xref{Mapping over Sequences}, for some more functions for
iterating over vectors or lists.
-@node Loop Facility, Multiple Values, Iteration, Control Structure
+@node Loop Facility
@section Loop Facility
@noindent
-A common complaint with Lisp's traditional looping constructs is
-that they are either too simple and limited, such as Common Lisp's
-@code{dotimes} or Emacs Lisp's @code{while}, or too unreadable and
-obscure, like Common Lisp's @code{do} loop.
+A common complaint with Lisp's traditional looping constructs was
+that they were either too simple and limited, such as @code{dotimes}
+or @code{while}, or too unreadable and obscure, like Common Lisp's
+@code{do} loop.
-To remedy this, recent versions of Common Lisp have added a new
-construct called the ``Loop Facility'' or ``@code{loop} macro,''
-with an easy-to-use but very powerful and expressive syntax.
+To remedy this, Common Lisp added a construct called the ``Loop
+Facility'' or ``@code{loop} macro'', with an easy-to-use but very
+powerful and expressive syntax.
@menu
-* Loop Basics:: `loop' macro, basic clause structure
-* Loop Examples:: Working examples of `loop' macro
-* For Clauses:: Clauses introduced by `for' or `as'
-* Iteration Clauses:: `repeat', `while', `thereis', etc.
-* Accumulation Clauses:: `collect', `sum', `maximize', etc.
-* Other Clauses:: `with', `if', `initially', `finally'
+* Loop Basics:: The @code{cl-loop} macro, basic clause structure.
+* Loop Examples:: Working examples of the @code{cl-loop} macro.
+* For Clauses:: Clauses introduced by @code{for} or @code{as}.
+* Iteration Clauses:: @code{repeat}, @code{while}, @code{thereis}, etc.
+* Accumulation Clauses:: @code{collect}, @code{sum}, @code{maximize}, etc.
+* Other Clauses:: @code{with}, @code{if}, @code{initially}, @code{finally}.
@end menu
-@node Loop Basics, Loop Examples, Loop Facility, Loop Facility
+@node Loop Basics
@subsection Loop Basics
@noindent
-The @code{loop} macro essentially creates a mini-language within
+The @code{cl-loop} macro essentially creates a mini-language within
Lisp that is specially tailored for describing loops. While this
language is a little strange-looking by the standards of regular Lisp,
it turns out to be very easy to learn and well-suited to its purpose.
-Since @code{loop} is a macro, all parsing of the loop language
-takes place at byte-compile time; compiled @code{loop}s are just
+Since @code{cl-loop} is a macro, all parsing of the loop language
+takes place at byte-compile time; compiled @code{cl-loop}s are just
as efficient as the equivalent @code{while} loops written longhand.
-@defspec loop clauses@dots{}
+@defmac cl-loop clauses@dots{}
A loop construct consists of a series of @var{clause}s, each
introduced by a symbol like @code{for} or @code{do}. Clauses
-are simply strung together in the argument list of @code{loop},
+are simply strung together in the argument list of @code{cl-loop},
with minimal extra parentheses. The various types of clauses
specify initializations, such as the binding of temporary
variables, actions to be taken in the loop, stepping actions,
@@ -2187,7 +1768,7 @@ be modified or iterated throughout the course of the loop. The
@var{action-clauses} are things to be done during the loop, such
as computing, collecting, and returning values.
-The Emacs version of the @code{loop} macro is less restrictive about
+The Emacs version of the @code{cl-loop} macro is less restrictive about
the order of clauses, but things will behave most predictably if
you put the variable-binding clauses @code{with}, @code{for}, and
@code{repeat} before the action clauses. As in Common Lisp,
@@ -2198,39 +1779,39 @@ them to return a value by using an accumulation clause like
@code{collect}, an end-test clause like @code{always}, or an
explicit @code{return} clause to jump out of the implicit block.
(Because the loop body is enclosed in an implicit block, you can
-also use regular Lisp @code{return} or @code{return-from} to
+also use regular Lisp @code{cl-return} or @code{cl-return-from} to
break out of the loop.)
-@end defspec
+@end defmac
-The following sections give some examples of the Loop Macro in
+The following sections give some examples of the loop macro in
action, and describe the particular loop clauses in great detail.
-Consult the second edition of Steele's @dfn{Common Lisp, the Language},
-for additional discussion and examples of the @code{loop} macro.
+Consult the second edition of Steele for additional discussion
+and examples.
-@node Loop Examples, For Clauses, Loop Basics, Loop Facility
+@node Loop Examples
@subsection Loop Examples
@noindent
Before listing the full set of clauses that are allowed, let's
-look at a few example loops just to get a feel for the @code{loop}
+look at a few example loops just to get a feel for the @code{cl-loop}
language.
@example
-(loop for buf in (buffer-list)
- collect (buffer-file-name buf))
+(cl-loop for buf in (buffer-list)
+ collect (buffer-file-name buf))
@end example
@noindent
This loop iterates over all Emacs buffers, using the list
-returned by @code{buffer-list}. For each buffer @code{buf},
+returned by @code{buffer-list}. For each buffer @var{buf},
it calls @code{buffer-file-name} and collects the results into
-a list, which is then returned from the @code{loop} construct.
+a list, which is then returned from the @code{cl-loop} construct.
The result is a list of the file names of all the buffers in
-Emacs' memory. The words @code{for}, @code{in}, and @code{collect}
-are reserved words in the @code{loop} language.
+Emacs's memory. The words @code{for}, @code{in}, and @code{collect}
+are reserved words in the @code{cl-loop} language.
@example
-(loop repeat 20 do (insert "Yowsa\n"))
+(cl-loop repeat 20 do (insert "Yowsa\n"))
@end example
@noindent
@@ -2238,7 +1819,7 @@ This loop inserts the phrase ``Yowsa'' twenty times in the
current buffer.
@example
-(loop until (eobp) do (munch-line) (forward-line 1))
+(cl-loop until (eobp) do (munch-line) (forward-line 1))
@end example
@noindent
@@ -2247,7 +1828,7 @@ of the buffer. If point is already at the end of the buffer,
the loop exits immediately.
@example
-(loop do (munch-line) until (eobp) do (forward-line 1))
+(cl-loop do (munch-line) until (eobp) do (forward-line 1))
@end example
@noindent
@@ -2255,10 +1836,10 @@ This loop is similar to the above one, except that @code{munch-line}
is always called at least once.
@example
-(loop for x from 1 to 100
- for y = (* x x)
- until (>= y 729)
- finally return (list x (= y 729)))
+(cl-loop for x from 1 to 100
+ for y = (* x x)
+ until (>= y 729)
+ finally return (list x (= y 729)))
@end example
@noindent
@@ -2278,9 +1859,9 @@ Note that even though this loop contains three clauses (two
@code{for}s and an @code{until}) that would have been enough to
define loops all by themselves, it still creates a single loop
rather than some sort of triple-nested loop. You must explicitly
-nest your @code{loop} constructs if you want nested loops.
+nest your @code{cl-loop} constructs if you want nested loops.
-@node For Clauses, Iteration Clauses, Loop Examples, Loop Facility
+@node For Clauses
@subsection For Clauses
@noindent
@@ -2304,7 +1885,7 @@ The variable is bound around the loop as if by @code{let}:
@example
(setq i 'happy)
-(loop for i from 1 to 10 do (do-something-with i))
+(cl-loop for i from 1 to 10 do (do-something-with i))
i
@result{} happy
@end example
@@ -2334,10 +1915,10 @@ which are like @code{upto} and @code{downto} respectively except
that they are exclusive rather than inclusive limits:
@example
-(loop for x to 10 collect x)
- @result{} (0 1 2 3 4 5 6 7 8 9 10)
-(loop for x below 10 collect x)
- @result{} (0 1 2 3 4 5 6 7 8 9)
+(cl-loop for x to 10 collect x)
+ @result{} (0 1 2 3 4 5 6 7 8 9 10)
+(cl-loop for x below 10 collect x)
+ @result{} (0 1 2 3 4 5 6 7 8 9)
@end example
The @code{by} value is always positive, even for downward-counting
@@ -2352,25 +1933,25 @@ is used to traverse the list instead of @code{cdr}; it must be a
function taking one argument. For example:
@example
-(loop for x in '(1 2 3 4 5 6) collect (* x x))
- @result{} (1 4 9 16 25 36)
-(loop for x in '(1 2 3 4 5 6) by 'cddr collect (* x x))
- @result{} (1 9 25)
+(cl-loop for x in '(1 2 3 4 5 6) collect (* x x))
+ @result{} (1 4 9 16 25 36)
+(cl-loop for x in '(1 2 3 4 5 6) by 'cddr collect (* x x))
+ @result{} (1 9 25)
@end example
@item for @var{var} on @var{list} by @var{function}
This clause iterates @var{var} over all the cons cells of @var{list}.
@example
-(loop for x on '(1 2 3 4) collect x)
- @result{} ((1 2 3 4) (2 3 4) (3 4) (4))
+(cl-loop for x on '(1 2 3 4) collect x)
+ @result{} ((1 2 3 4) (2 3 4) (3 4) (4))
@end example
With @code{by}, there is no real reason that the @code{on} expression
must be a list. For example:
@example
-(loop for x on first-animal by 'next-animal collect x)
+(cl-loop for x on first-animal by 'next-animal collect x)
@end example
@noindent
@@ -2384,7 +1965,7 @@ a @code{setf}-able ``reference'' onto the elements of the list
rather than just a temporary variable. For example,
@example
-(loop for x in-ref my-list do (incf x))
+(cl-loop for x in-ref my-list do (cl-incf x))
@end example
@noindent
@@ -2396,8 +1977,8 @@ This clause iterates @var{var} over all the elements of @var{array},
which may be a vector or a string.
@example
-(loop for x across "aeiou"
- do (use-vowel (char-to-string x)))
+(cl-loop for x across "aeiou"
+ do (use-vowel (char-to-string x)))
@end example
@item for @var{var} across-ref @var{array}
@@ -2413,7 +1994,7 @@ at run-time, this is somewhat less efficient than @code{in} or
the successive indices (starting at 0) of the elements.
This clause type is taken from older versions of the @code{loop} macro,
-and is not present in modern Common Lisp. The @samp{using (sequence ...)}
+and is not present in modern Common Lisp. The @samp{using (sequence @dots{})}
term of the older macros is not supported.
@item for @var{var} being the elements of-ref @var{sequence}
@@ -2429,10 +2010,10 @@ an unspecified order.
As an example,
@example
-(loop for sym being the symbols
- when (fboundp sym)
- when (string-match "^map" (symbol-name sym))
- collect sym)
+(cl-loop for sym being the symbols
+ when (fboundp sym)
+ when (string-match "^map" (symbol-name sym))
+ collect sym)
@end example
@noindent
@@ -2443,9 +2024,9 @@ are also recognized but are equivalent to @code{symbols} in Emacs Lisp.
Due to a minor implementation restriction, it will not work to have
more than one @code{for} clause iterating over symbols, hash tables,
-keymaps, overlays, or intervals in a given @code{loop}. Fortunately,
+keymaps, overlays, or intervals in a given @code{cl-loop}. Fortunately,
it would rarely if ever be useful to do so. It @emph{is} valid to mix
-one of these types of clauses with other clauses like @code{for ... to}
+one of these types of clauses with other clauses like @code{for @dots{} to}
or @code{while}.
@item for @var{var} being the hash-keys of @var{hash-table}
@@ -2455,10 +2036,10 @@ This clause iterates over the entries in @var{hash-table} with
a second variable to the opposite part.
@example
-(loop for k being the hash-keys of h
- using (hash-values v)
- do
- (message "key %S -> value %S" k v))
+(cl-loop for k being the hash-keys of h
+ using (hash-values v)
+ do
+ (message "key %S -> value %S" k v))
@end example
@item for @var{var} being the key-codes of @var{keymap}
@@ -2470,10 +2051,10 @@ A @code{using} clause can access both the codes and the bindings
together.
@example
-(loop for c being the key-codes of (current-local-map)
- using (key-bindings b)
- do
- (message "key %S -> binding %S" c b))
+(cl-loop for c being the key-codes of (current-local-map)
+ using (key-bindings b)
+ do
+ (message "key %S -> binding %S" c b))
@end example
@@ -2482,7 +2063,7 @@ This clause iterates over all key sequences defined by @var{keymap}
and its nested keymaps, where @var{var} takes on values which are
vectors. The strings or vectors
are reused for each iteration, so you must copy them if you wish to keep
-them permanently. You can add a @samp{using (key-bindings ...)}
+them permanently. You can add a @samp{using (key-bindings @dots{})}
clause to get the command bindings as well.
@item for @var{var} being the overlays [of @var{buffer}] @dots{}
@@ -2529,8 +2110,8 @@ and successive iterations it will be set by evaluating @var{expr2}
these two loops are effectively the same:
@example
-(loop for x on my-list by 'cddr do ...)
-(loop for x = my-list then (cddr x) while x do ...)
+(cl-loop for x on my-list by 'cddr do @dots{})
+(cl-loop for x = my-list then (cddr x) while x do @dots{})
@end example
Note that this type of @code{for} clause does not imply any sort
@@ -2541,7 +2122,7 @@ If you omit the @code{then} term, @var{expr1} is used both for
the initial setting and for successive settings:
@example
-(loop for x = (random) when (> x 0) return x)
+(cl-loop for x = (random) when (> x 0) return x)
@end example
@noindent
@@ -2553,13 +2134,13 @@ If you include several @code{for} clauses in a row, they are
treated sequentially (as if by @code{let*} and @code{setq}).
You can instead use the word @code{and} to link the clauses,
in which case they are processed in parallel (as if by @code{let}
-and @code{psetq}).
+and @code{cl-psetq}).
@example
-(loop for x below 5 for y = nil then x collect (list x y))
- @result{} ((0 nil) (1 1) (2 2) (3 3) (4 4))
-(loop for x below 5 and y = nil then x collect (list x y))
- @result{} ((0 nil) (1 0) (2 1) (3 2) (4 3))
+(cl-loop for x below 5 for y = nil then x collect (list x y))
+ @result{} ((0 nil) (1 1) (2 2) (3 3) (4 4))
+(cl-loop for x below 5 and y = nil then x collect (list x y))
+ @result{} ((0 nil) (1 0) (2 1) (3 2) (4 3))
@end example
@noindent
@@ -2569,16 +2150,17 @@ that was just set by the previous clause; in the second loop,
based on the value of @code{x} left over from the previous time
through the loop.
-Another feature of the @code{loop} macro is @dfn{destructuring},
-similar in concept to the destructuring provided by @code{defmacro}.
+Another feature of the @code{cl-loop} macro is @emph{destructuring},
+similar in concept to the destructuring provided by @code{defmacro}
+(@pxref{Argument Lists}).
The @var{var} part of any @code{for} clause can be given as a list
of variables instead of a single variable. The values produced
during loop execution must be lists; the values in the lists are
stored in the corresponding variables.
@example
-(loop for (x y) in '((2 3) (4 5) (6 7)) collect (+ x y))
- @result{} (5 9 13)
+(cl-loop for (x y) in '((2 3) (4 5) (6 7)) collect (+ x y))
+ @result{} (5 9 13)
@end example
In loop destructuring, if there are more values than variables
@@ -2590,12 +2172,12 @@ lists of variables like @code{(x . y)} are allowed, so for example
to process an alist
@example
-(loop for (key . value) in '((a . 1) (b . 2))
- collect value)
- @result{} (1 2)
+(cl-loop for (key . value) in '((a . 1) (b . 2))
+ collect value)
+ @result{} (1 2)
@end example
-@node Iteration Clauses, Accumulation Clauses, For Clauses, Loop Facility
+@node Iteration Clauses
@subsection Iteration Clauses
@noindent
@@ -2609,8 +2191,8 @@ This clause simply counts up to the specified number using an
internal temporary variable. The loops
@example
-(loop repeat (1+ n) do ...)
-(loop for temp to n do ...)
+(cl-loop repeat (1+ n) do @dots{})
+(cl-loop for temp to n do @dots{})
@end example
@noindent
@@ -2625,7 +2207,7 @@ that surrounds the second one:
@example
(while @var{cond} @var{forms}@dots{})
-(loop while @var{cond} do @var{forms}@dots{})
+(cl-loop while @var{cond} do @var{forms}@dots{})
@end example
@item until @var{condition}
@@ -2639,7 +2221,7 @@ the @code{finally} clauses are not executed. If all the conditions
were non-@code{nil}, the loop returns @code{t}:
@example
-(if (loop for size in size-list always (> size 10))
+(if (cl-loop for size in size-list always (> size 10))
(some-big-sizes)
(no-big-sizes))
@end example
@@ -2654,7 +2236,7 @@ in this case, it returns that non-@code{nil} value. If all the
values were @code{nil}, the loop returns @code{nil}.
@end table
-@node Accumulation Clauses, Other Clauses, Iteration Clauses, Loop Facility
+@node Accumulation Clauses
@subsection Accumulation Clauses
@noindent
@@ -2716,14 +2298,14 @@ It is valid for several accumulation clauses of the same type to
accumulate into the same place. From Steele:
@example
-(loop for name in '(fred sue alice joe june)
- for kids in '((bob ken) () () (kris sunshine) ())
- collect name
- append kids)
- @result{} (fred bob ken sue alice joe kris sunshine june)
+(cl-loop for name in '(fred sue alice joe june)
+ for kids in '((bob ken) () () (kris sunshine) ())
+ collect name
+ append kids)
+ @result{} (fred bob ken sue alice joe kris sunshine june)
@end example
-@node Other Clauses, , Accumulation Clauses, Loop Facility
+@node Other Clauses
@subsection Other Clauses
@noindent
@@ -2736,17 +2318,17 @@ otherwise leaves the variable alone during the loop. The following
loops are basically equivalent:
@example
-(loop with x = 17 do ...)
-(let ((x 17)) (loop do ...))
-(loop for x = 17 then x do ...)
+(cl-loop with x = 17 do @dots{})
+(let ((x 17)) (cl-loop do @dots{}))
+(cl-loop for x = 17 then x do @dots{})
@end example
Naturally, the variable @var{var} might be used for some purpose
in the rest of the loop. For example:
@example
-(loop for x in my-list with res = nil do (push x res)
- finally return res)
+(cl-loop for x in my-list with res = nil do (push x res)
+ finally return res)
@end example
This loop inserts the elements of @code{my-list} at the front of
@@ -2781,18 +2363,18 @@ by the name @code{it} in the ``then'' part. For example:
@example
(setq funny-numbers '(6 13 -1))
@result{} (6 13 -1)
-(loop for x below 10
- if (oddp x)
- collect x into odds
- and if (memq x funny-numbers) return (cdr it) end
- else
- collect x into evens
- finally return (vector odds evens))
- @result{} [(1 3 5 7 9) (0 2 4 6 8)]
+(cl-loop for x below 10
+ if (cl-oddp x)
+ collect x into odds
+ and if (memq x funny-numbers) return (cdr it) end
+ else
+ collect x into evens
+ finally return (vector odds evens))
+ @result{} [(1 3 5 7 9) (0 2 4 6 8)]
(setq funny-numbers '(6 7 13 -1))
@result{} (6 7 13 -1)
-(loop <@r{same thing again}>)
- @result{} (13 -1)
+(cl-loop <@r{same thing again}>)
+ @result{} (13 -1)
@end example
Note the use of @code{and} to put two clauses into the ``then''
@@ -2817,7 +2399,7 @@ This clause gives a name other than @code{nil} to the implicit
block surrounding the loop. The @var{name} is the symbol to be
used as the block name.
-@item initially [do] @var{forms}...
+@item initially [do] @var{forms}@dots{}
This keyword introduces one or more Lisp forms which will be
executed before the loop itself begins (but after any variables
requested by @code{for} or @code{with} have been bound to their
@@ -2825,7 +2407,7 @@ initial values). @code{initially} clauses can appear anywhere;
if there are several, they are executed in the order they appear
in the loop. The keyword @code{do} is optional.
-@item finally [do] @var{forms}...
+@item finally [do] @var{forms}@dots{}
This introduces Lisp forms which will be executed after the loop
finishes (say, on request of a @code{for} or @code{while}).
@code{initially} and @code{finally} clauses may appear anywhere
@@ -2840,7 +2422,7 @@ return @code{nil}.) Variables bound by @code{for}, @code{with},
or @code{into} will still contain their final values when @var{form}
is executed.
-@item do @var{forms}...
+@item do @var{forms}@dots{}
The word @code{do} may be followed by any number of Lisp expressions
which are executed as an implicit @code{progn} in the body of the
loop. Many of the examples in this section illustrate the use of
@@ -2848,33 +2430,32 @@ loop. Many of the examples in this section illustrate the use of
@item return @var{form}
This clause causes the loop to return immediately. The following
-Lisp form is evaluated to give the return value of the @code{loop}
+Lisp form is evaluated to give the return value of the loop
form. The @code{finally} clauses, if any, are not executed.
Of course, @code{return} is generally used inside an @code{if} or
@code{unless}, as its use in a top-level loop clause would mean
the loop would never get to ``loop'' more than once.
The clause @samp{return @var{form}} is equivalent to
-@samp{do (return @var{form})} (or @code{return-from} if the loop
+@samp{do (cl-return @var{form})} (or @code{cl-return-from} if the loop
was named). The @code{return} clause is implemented a bit more
efficiently, though.
@end table
-While there is no high-level way to add user extensions to @code{loop}
-(comparable to @code{defsetf} for @code{setf}, say), this package
-does offer two properties called @code{cl-loop-handler} and
-@code{cl-loop-for-handler} which are functions to be called when
-a given symbol is encountered as a top-level loop clause or
-@code{for} clause, respectively. Consult the source code in
-file @file{cl-macs.el} for details.
+While there is no high-level way to add user extensions to @code{cl-loop},
+this package does offer two properties called @code{cl-loop-handler}
+and @code{cl-loop-for-handler} which are functions to be called when a
+given symbol is encountered as a top-level loop clause or @code{for}
+clause, respectively. Consult the source code in file
+@file{cl-macs.el} for details.
-This package's @code{loop} macro is compatible with that of Common
+This package's @code{cl-loop} macro is compatible with that of Common
Lisp, except that a few features are not implemented: @code{loop-finish}
-and data-type specifiers. Naturally, the @code{for} clauses which
+and data-type specifiers. Naturally, the @code{for} clauses that
iterate over keymaps, overlays, intervals, frames, windows, and
buffers are Emacs-specific extensions.
-@node Multiple Values, , Loop Facility, Control Structure
+@node Multiple Values
@section Multiple Values
@noindent
@@ -2883,40 +2464,33 @@ functions, by contrast, always return exactly one result. This
package makes no attempt to emulate Common Lisp multiple return
values; Emacs versions of Common Lisp functions that return more
than one value either return just the first value (as in
-@code{compiler-macroexpand}) or return a list of values (as in
-@code{get-setf-method}). This package @emph{does} define placeholders
+@code{cl-compiler-macroexpand}) or return a list of values.
+This package @emph{does} define placeholders
for the Common Lisp functions that work with multiple values, but
in Emacs Lisp these functions simply operate on lists instead.
-The @code{values} form, for example, is a synonym for @code{list}
+The @code{cl-values} form, for example, is a synonym for @code{list}
in Emacs.
-@defspec multiple-value-bind (var@dots{}) values-form forms@dots{}
+@defmac cl-multiple-value-bind (var@dots{}) values-form forms@dots{}
This form evaluates @var{values-form}, which must return a list of
values. It then binds the @var{var}s to these respective values,
as if by @code{let}, and then executes the body @var{forms}.
If there are more @var{var}s than values, the extra @var{var}s
are bound to @code{nil}. If there are fewer @var{var}s than
values, the excess values are ignored.
-@end defspec
+@end defmac
-@defspec multiple-value-setq (var@dots{}) form
+@defmac cl-multiple-value-setq (var@dots{}) form
This form evaluates @var{form}, which must return a list of values.
It then sets the @var{var}s to these respective values, as if by
@code{setq}. Extra @var{var}s or values are treated the same as
-in @code{multiple-value-bind}.
-@end defspec
-
-The older Quiroz package attempted a more faithful (but still
-imperfect) emulation of Common Lisp multiple values. The old
-method ``usually'' simulated true multiple values quite well,
-but under certain circumstances would leave spurious return
-values in memory where a later, unrelated @code{multiple-value-bind}
-form would see them.
+in @code{cl-multiple-value-bind}.
+@end defmac
Since a perfect emulation is not feasible in Emacs Lisp, this
package opts to keep it as simple and predictable as possible.
-@node Macros, Declarations, Control Structure, Top
+@node Macros
@chapter Macros
@noindent
@@ -2929,22 +2503,22 @@ for @code{defmacro} due to technical difficulties.
Destructuring is made available to the user by way of the
following macro:
-@defspec destructuring-bind arglist expr forms@dots{}
-This macro expands to code which executes @var{forms}, with
+@defmac cl-destructuring-bind arglist expr forms@dots{}
+This macro expands to code that executes @var{forms}, with
the variables in @var{arglist} bound to the list of values
returned by @var{expr}. The @var{arglist} can include all
-the features allowed for @code{defmacro} argument lists,
+the features allowed for @code{cl-defmacro} argument lists,
including destructuring. (The @code{&environment} keyword
is not allowed.) The macro expansion will signal an error
if @var{expr} returns a list of the wrong number of arguments
or with incorrect keyword arguments.
-@end defspec
+@end defmac
This package also includes the Common Lisp @code{define-compiler-macro}
facility, which allows you to define compile-time expansions and
optimizations for your functions.
-@defspec define-compiler-macro name arglist forms@dots{}
+@defmac cl-define-compiler-macro name arglist forms@dots{}
This form is similar to @code{defmacro}, except that it only expands
calls to @var{name} at compile-time; calls processed by the Lisp
interpreter are not expanded, nor are they expanded by the
@@ -2962,25 +2536,25 @@ For example, here is a simplified version of a definition that
appears as a standard part of this package:
@example
-(define-compiler-macro member* (&whole form a list &rest keys)
- (if (and (null keys)
- (eq (car-safe a) 'quote)
- (not (floatp-safe (cadr a))))
- (list 'memq a list)
- form))
+(cl-define-compiler-macro cl-member (&whole form a list &rest keys)
+ (if (and (null keys)
+ (eq (car-safe a) 'quote)
+ (not (floatp (cadr a))))
+ (list 'memq a list)
+ form))
@end example
@noindent
-This definition causes @code{(member* @var{a} @var{list})} to change
+This definition causes @code{(cl-member @var{a} @var{list})} to change
to a call to the faster @code{memq} in the common case where @var{a}
is a non-floating-point constant; if @var{a} is anything else, or
if there are any keyword arguments in the call, then the original
-@code{member*} call is left intact. (The actual compiler macro
-for @code{member*} optimizes a number of other cases, including
+@code{cl-member} call is left intact. (The actual compiler macro
+for @code{cl-member} optimizes a number of other cases, including
common @code{:test} predicates.)
-@end defspec
+@end defmac
-@defun compiler-macroexpand form
+@defun cl-compiler-macroexpand form
This function is analogous to @code{macroexpand}, except that it
expands compiler macros rather than regular macros. It returns
@var{form} unchanged if it is not a call to a function for which
@@ -2990,11 +2564,11 @@ decided to punt by returning its @code{&whole} argument. Like
for which no further expansion is possible.
@end defun
-@xref{Macro Bindings}, for descriptions of the @code{macrolet}
-and @code{symbol-macrolet} forms for making ``local'' macro
+@xref{Macro Bindings}, for descriptions of the @code{cl-macrolet}
+and @code{cl-symbol-macrolet} forms for making ``local'' macro
definitions.
-@node Declarations, Symbols, Macros, Top
+@node Declarations
@chapter Declarations
@noindent
@@ -3006,61 +2580,64 @@ package defines versions of all the Common Lisp declaration forms:
@code{declare}, @code{locally}, @code{proclaim}, @code{declaim},
and @code{the}.
-Most of the Common Lisp declarations are not currently useful in
-Emacs Lisp, as the byte-code system provides little opportunity
-to benefit from type information, and @code{special} declarations
-are redundant in a fully dynamically-scoped Lisp. A few
-declarations are meaningful when the optimizing byte
-compiler is being used, however. Under the earlier non-optimizing
-compiler, these declarations will effectively be ignored.
-
-@defun proclaim decl-spec
+Most of the Common Lisp declarations are not currently useful in Emacs
+Lisp. For example, the byte-code system provides little
+opportunity to benefit from type information.
+@ignore
+and @code{special} declarations are redundant in a fully
+dynamically-scoped Lisp.
+@end ignore
+A few declarations are meaningful when byte compiler optimizations
+are enabled, as they are by the default. Otherwise these
+declarations will effectively be ignored.
+
+@defun cl-proclaim decl-spec
This function records a ``global'' declaration specified by
-@var{decl-spec}. Since @code{proclaim} is a function, @var{decl-spec}
+@var{decl-spec}. Since @code{cl-proclaim} is a function, @var{decl-spec}
is evaluated and thus should normally be quoted.
@end defun
-@defspec declaim decl-specs@dots{}
-This macro is like @code{proclaim}, except that it takes any number
+@defmac cl-declaim decl-specs@dots{}
+This macro is like @code{cl-proclaim}, except that it takes any number
of @var{decl-spec} arguments, and the arguments are unevaluated and
-unquoted. The @code{declaim} macro also puts an @code{(eval-when
-(compile load eval) ...)} around the declarations so that they will
+unquoted. The @code{cl-declaim} macro also puts @code{(cl-eval-when
+(compile load eval) @dots{})} around the declarations so that they will
be registered at compile-time as well as at run-time. (This is vital,
since normally the declarations are meant to influence the way the
-compiler treats the rest of the file that contains the @code{declaim}
+compiler treats the rest of the file that contains the @code{cl-declaim}
form.)
-@end defspec
+@end defmac
-@defspec declare decl-specs@dots{}
+@defmac cl-declare decl-specs@dots{}
This macro is used to make declarations within functions and other
code. Common Lisp allows declarations in various locations, generally
at the beginning of any of the many ``implicit @code{progn}s''
throughout Lisp syntax, such as function bodies, @code{let} bodies,
-etc. Currently the only declaration understood by @code{declare}
+etc. Currently the only declaration understood by @code{cl-declare}
is @code{special}.
-@end defspec
+@end defmac
-@defspec locally declarations@dots{} forms@dots{}
-In this package, @code{locally} is no different from @code{progn}.
-@end defspec
+@defmac cl-locally declarations@dots{} forms@dots{}
+In this package, @code{cl-locally} is no different from @code{progn}.
+@end defmac
-@defspec the type form
-Type information provided by @code{the} is ignored in this package;
-in other words, @code{(the @var{type} @var{form})} is equivalent
-to @var{form}. Future versions of the optimizing byte-compiler may
-make use of this information.
+@defmac cl-the type form
+Type information provided by @code{cl-the} is ignored in this package;
+in other words, @code{(cl-the @var{type} @var{form})} is equivalent to
+@var{form}. Future byte-compiler optimizations may make use of this
+information.
For example, @code{mapcar} can map over both lists and arrays. It is
hard for the compiler to expand @code{mapcar} into an in-line loop
unless it knows whether the sequence will be a list or an array ahead
-of time. With @code{(mapcar 'car (the vector foo))}, a future
+of time. With @code{(mapcar 'car (cl-the vector foo))}, a future
compiler would have enough information to expand the loop in-line.
For now, Emacs Lisp will treat the above code as exactly equivalent
to @code{(mapcar 'car foo)}.
-@end defspec
+@end defmac
-Each @var{decl-spec} in a @code{proclaim}, @code{declaim}, or
-@code{declare} should be a list beginning with a symbol that says
+Each @var{decl-spec} in a @code{cl-proclaim}, @code{cl-declaim}, or
+@code{cl-declare} should be a list beginning with a symbol that says
what kind of declaration it is. This package currently understands
@code{special}, @code{inline}, @code{notinline}, @code{optimize},
and @code{warn} declarations. (The @code{warn} declaration is an
@@ -3069,44 +2646,41 @@ such as @code{type} and @code{ftype}, are silently ignored.
@table @code
@item special
+@c FIXME ?
Since all variables in Emacs Lisp are ``special'' (in the Common
Lisp sense), @code{special} declarations are only advisory. They
-simply tell the optimizing byte compiler that the specified
+simply tell the byte compiler that the specified
variables are intentionally being referred to without being
bound in the body of the function. The compiler normally emits
warnings for such references, since they could be typographical
errors for references to local variables.
-The declaration @code{(declare (special @var{var1} @var{var2}))} is
-equivalent to @code{(defvar @var{var1}) (defvar @var{var2})} in the
-optimizing compiler, or to nothing at all in older compilers (which
-do not warn for non-local references).
+The declaration @code{(cl-declare (special @var{var1} @var{var2}))} is
+equivalent to @code{(defvar @var{var1}) (defvar @var{var2})}.
In top-level contexts, it is generally better to write
-@code{(defvar @var{var})} than @code{(declaim (special @var{var}))},
-since @code{defvar} makes your intentions clearer. But the older
-byte compilers can not handle @code{defvar}s appearing inside of
-functions, while @code{(declare (special @var{var}))} takes care
-to work correctly with all compilers.
+@code{(defvar @var{var})} than @code{(cl-declaim (special @var{var}))},
+since @code{defvar} makes your intentions clearer.
@item inline
The @code{inline} @var{decl-spec} lists one or more functions
whose bodies should be expanded ``in-line'' into calling functions
whenever the compiler is able to arrange for it. For example,
-the Common Lisp function @code{cadr} is declared @code{inline}
-by this package so that the form @code{(cadr @var{x})} will
-expand directly into @code{(car (cdr @var{x}))} when it is called
-in user functions, for a savings of one (relatively expensive)
-function call.
+the function @code{cl-acons} is declared @code{inline}
+by this package so that the form @code{(cl-acons @var{key} @var{value}
+@var{alist})} will
+expand directly into @code{(cons (cons @var{key} @var{value}) @var{alist})}
+when it is called in user functions, so as to save function calls.
The following declarations are all equivalent. Note that the
@code{defsubst} form is a convenient way to define a function
and declare it inline all at once.
@example
-(declaim (inline foo bar))
-(eval-when (compile load eval) (proclaim '(inline foo bar)))
-(defsubst foo (...) ...) ; instead of defun
+(cl-declaim (inline foo bar))
+(cl-eval-when (compile load eval)
+ (cl-proclaim '(inline foo bar)))
+(defsubst foo (@dots{}) @dots{}) ; instead of defun
@end example
@strong{Please note:} this declaration remains in effect after the
@@ -3118,7 +2692,7 @@ function.
In Common Lisp, it is possible to use @code{(declare (inline @dots{}))}
before a particular call to a function to cause just that call to
be inlined; the current byte compilers provide no way to implement
-this, so @code{(declare (inline @dots{}))} is currently ignored by
+this, so @code{(cl-declare (inline @dots{}))} is currently ignored by
this package.
@item notinline
@@ -3128,22 +2702,20 @@ declaration.
@item optimize
This declaration controls how much optimization is performed by
-the compiler. Naturally, it is ignored by the earlier non-optimizing
-compilers.
+the compiler.
The word @code{optimize} is followed by any number of lists like
@code{(speed 3)} or @code{(safety 2)}. Common Lisp defines several
optimization ``qualities''; this package ignores all but @code{speed}
and @code{safety}. The value of a quality should be an integer from
-0 to 3, with 0 meaning ``unimportant'' and 3 meaning ``very important.''
+0 to 3, with 0 meaning ``unimportant'' and 3 meaning ``very important''.
The default level for both qualities is 1.
-In this package, with the optimizing compiler, the
-@code{speed} quality is tied to the @code{byte-compile-optimize}
+In this package, the @code{speed} quality is tied to the @code{byte-optimize}
flag, which is set to @code{nil} for @code{(speed 0)} and to
@code{t} for higher settings; and the @code{safety} quality is
tied to the @code{byte-compile-delete-errors} flag, which is
-set to @code{t} for @code{(safety 3)} and to @code{nil} for all
+set to @code{nil} for @code{(safety 3)} and to @code{t} for all
lower settings. (The latter flag controls whether the compiler
is allowed to optimize out code whose only side-effect could
be to signal an error, e.g., rewriting @code{(progn foo bar)} to
@@ -3157,26 +2729,26 @@ Emacs itself, Emacs will not crash with a segmentation fault
just because of an error in a fully-optimized Lisp program.
The @code{optimize} declaration is normally used in a top-level
-@code{proclaim} or @code{declaim} in a file; Common Lisp allows
+@code{cl-proclaim} or @code{cl-declaim} in a file; Common Lisp allows
it to be used with @code{declare} to set the level of optimization
locally for a given form, but this will not work correctly with the
-current version of the optimizing compiler. (The @code{declare}
+current byte-compiler. (The @code{cl-declare}
will set the new optimization level, but that level will not
automatically be unset after the enclosing form is done.)
@item warn
This declaration controls what sorts of warnings are generated
-by the byte compiler. Again, only the optimizing compiler
-generates warnings. The word @code{warn} is followed by any
-number of ``warning qualities,'' similar in form to optimization
+by the byte compiler. The word @code{warn} is followed by any
+number of ``warning qualities'', similar in form to optimization
qualities. The currently supported warning types are
@code{redefine}, @code{callargs}, @code{unresolved}, and
@code{free-vars}; in the current system, a value of 0 will
disable these warnings and any higher value will enable them.
-See the documentation for the optimizing byte compiler for details.
+See the documentation of the variable @code{byte-compile-warnings}
+for more details.
@end table
-@node Symbols, Numbers, Declarations, Top
+@node Symbols
@chapter Symbols
@noindent
@@ -3184,11 +2756,11 @@ This package defines several symbol-related features that were
missing from Emacs Lisp.
@menu
-* Property Lists:: `get*', `remprop', `getf', `remf'
-* Creating Symbols:: `gensym', `gentemp'
+* Property Lists:: @code{cl-get}, @code{cl-remprop}, @code{cl-getf}, @code{cl-remf}.
+* Creating Symbols:: @code{cl-gensym}, @code{cl-gentemp}.
@end menu
-@node Property Lists, Creating Symbols, Symbols, Symbols
+@node Property Lists
@section Property Lists
@noindent
@@ -3197,18 +2769,18 @@ and @code{put} for operating on properties attached to symbols.
There are also functions for working with property lists as
first-class data structures not attached to particular symbols.
-@defun get* symbol property &optional default
+@defun cl-get symbol property &optional default
This function is like @code{get}, except that if the property is
not found, the @var{default} argument provides the return value.
(The Emacs Lisp @code{get} function always uses @code{nil} as
-the default; this package's @code{get*} is equivalent to Common
+the default; this package's @code{cl-get} is equivalent to Common
Lisp's @code{get}.)
-The @code{get*} function is @code{setf}-able; when used in this
+The @code{cl-get} function is @code{setf}-able; when used in this
fashion, the @var{default} argument is allowed but ignored.
@end defun
-@defun remprop symbol property
+@defun cl-remprop symbol property
This function removes the entry for @var{property} from the property
list of @var{symbol}. It returns a true value if the property was
indeed found and removed, or @code{nil} if there was no such property.
@@ -3216,10 +2788,10 @@ indeed found and removed, or @code{nil} if there was no such property.
since @code{get} did not allow a @var{default}, it was very difficult
to distinguish between a missing property and a property whose value
was @code{nil}; thus, setting a property to @code{nil} was close
-enough to @code{remprop} for most purposes.)
+enough to @code{cl-remprop} for most purposes.)
@end defun
-@defun getf place property &optional default
+@defun cl-getf place property &optional default
This function scans the list @var{place} as if it were a property
list, i.e., a list of alternating property names and values. If
an even-numbered element of @var{place} is found which is @code{eq}
@@ -3230,10 +2802,10 @@ is given).
In particular,
@example
-(get sym prop) @equiv{} (getf (symbol-plist sym) prop)
+(get sym prop) @equiv{} (cl-getf (symbol-plist sym) prop)
@end example
-It is valid to use @code{getf} as a @code{setf} place, in which case
+It is valid to use @code{cl-getf} as a @code{setf} place, in which case
its @var{place} argument must itself be a valid @code{setf} place.
The @var{default} argument, if any, is ignored in this context.
The effect is to change (via @code{setcar}) the value cell in the
@@ -3241,25 +2813,25 @@ list that corresponds to @var{property}, or to cons a new property-value
pair onto the list if the property is not yet present.
@example
-(put sym prop val) @equiv{} (setf (getf (symbol-plist sym) prop) val)
+(put sym prop val) @equiv{} (setf (cl-getf (symbol-plist sym) prop) val)
@end example
-The @code{get} and @code{get*} functions are also @code{setf}-able.
+The @code{get} and @code{cl-get} functions are also @code{setf}-able.
The fact that @code{default} is ignored can sometimes be useful:
@example
-(incf (get* 'foo 'usage-count 0))
+(cl-incf (cl-get 'foo 'usage-count 0))
@end example
Here, symbol @code{foo}'s @code{usage-count} property is incremented
if it exists, or set to 1 (an incremented 0) otherwise.
-When not used as a @code{setf} form, @code{getf} is just a regular
+When not used as a @code{setf} form, @code{cl-getf} is just a regular
function and its @var{place} argument can actually be any Lisp
expression.
@end defun
-@defspec remf place property
+@defmac cl-remf place property
This macro removes the property-value pair for @var{property} from
the property list stored at @var{place}, which is any @code{setf}-able
place expression. It returns true if the property was found. Note
@@ -3267,20 +2839,16 @@ that if @var{property} happens to be first on the list, this will
effectively do a @code{(setf @var{place} (cddr @var{place}))},
whereas if it occurs later, this simply uses @code{setcdr} to splice
out the property and value cells.
-@end defspec
-
-@iftex
-@secno=2
-@end iftex
+@end defmac
-@node Creating Symbols, , Property Lists, Symbols
+@node Creating Symbols
@section Creating Symbols
@noindent
These functions create unique symbols, typically for use as
temporary variables.
-@defun gensym &optional x
+@defun cl-gensym &optional x
This function creates a new, uninterned symbol (using @code{make-symbol})
with a unique name. (The name of an uninterned symbol is relevant
only if the symbol is printed.) By default, the name is generated
@@ -3290,123 +2858,106 @@ string is used as a prefix instead of @samp{G}. Uninterned symbols
are used in macro expansions for temporary variables, to ensure that
their names will not conflict with ``real'' variables in the user's
code.
-@end defun
-@defvar *gensym-counter*
-This variable holds the counter used to generate @code{gensym} names.
-It is incremented after each use by @code{gensym}. In Common Lisp
-this is initialized with 0, but this package initializes it with a
-random (time-dependent) value to avoid trouble when two files that
-each used @code{gensym} in their compilation are loaded together.
-(Uninterned symbols become interned when the compiler writes them
-out to a file and the Emacs loader loads them, so their names have to
-be treated a bit more carefully than in Common Lisp where uninterned
+(Internally, the variable @code{cl--gensym-counter} holds the counter
+used to generate names. It is incremented after each use. In Common
+Lisp this is initialized with 0, but this package initializes it with
+a random time-dependent value to avoid trouble when two files that
+each used @code{cl-gensym} in their compilation are loaded together.
+Uninterned symbols become interned when the compiler writes them out
+to a file and the Emacs loader loads them, so their names have to be
+treated a bit more carefully than in Common Lisp where uninterned
symbols remain uninterned after loading.)
-@end defvar
+@end defun
-@defun gentemp &optional x
-This function is like @code{gensym}, except that it produces a new
+@defun cl-gentemp &optional x
+This function is like @code{cl-gensym}, except that it produces a new
@emph{interned} symbol. If the symbol that is generated already
exists, the function keeps incrementing the counter and trying
again until a new symbol is generated.
@end defun
-The Quiroz @file{cl.el} package also defined a @code{defkeyword}
-form for creating self-quoting keyword symbols. This package
-automatically creates all keywords that are called for by
-@code{&key} argument specifiers, and discourages the use of
-keywords as data unrelated to keyword arguments, so the
-@code{defkeyword} form has been discontinued.
-
-@iftex
-@chapno=11
-@end iftex
+This package automatically creates all keywords that are called for by
+@code{&key} argument specifiers, and discourages the use of keywords
+as data unrelated to keyword arguments, so the related function
+@code{defkeyword} (to create self-quoting keyword symbols) is not
+provided.
-@node Numbers, Sequences, Symbols, Top
+@node Numbers
@chapter Numbers
@noindent
This section defines a few simple Common Lisp operations on numbers
-which were left out of Emacs Lisp.
+that were left out of Emacs Lisp.
@menu
-* Predicates on Numbers:: `plusp', `oddp', `floatp-safe', etc.
-* Numerical Functions:: `abs', `floor*', etc.
-* Random Numbers:: `random*', `make-random-state'
-* Implementation Parameters:: `most-positive-float'
+* Predicates on Numbers:: @code{cl-plusp}, @code{cl-oddp}, etc.
+* Numerical Functions:: @code{cl-floor}, @code{cl-ceiling}, etc.
+* Random Numbers:: @code{cl-random}, @code{cl-make-random-state}.
+* Implementation Parameters:: @code{cl-most-positive-float}, etc.
@end menu
-@iftex
-@secno=1
-@end iftex
-
-@node Predicates on Numbers, Numerical Functions, Numbers, Numbers
+@node Predicates on Numbers
@section Predicates on Numbers
@noindent
These functions return @code{t} if the specified condition is
true of the numerical argument, or @code{nil} otherwise.
-@defun plusp number
+@defun cl-plusp number
This predicate tests whether @var{number} is positive. It is an
error if the argument is not a number.
@end defun
-@defun minusp number
+@defun cl-minusp number
This predicate tests whether @var{number} is negative. It is an
error if the argument is not a number.
@end defun
-@defun oddp integer
+@defun cl-oddp integer
This predicate tests whether @var{integer} is odd. It is an
error if the argument is not an integer.
@end defun
-@defun evenp integer
+@defun cl-evenp integer
This predicate tests whether @var{integer} is even. It is an
error if the argument is not an integer.
@end defun
-@defun floatp-safe object
+@ignore
+@defun cl-floatp-safe object
This predicate tests whether @var{object} is a floating-point
number. On systems that support floating-point, this is equivalent
to @code{floatp}. On other systems, this always returns @code{nil}.
@end defun
+@end ignore
-@iftex
-@secno=3
-@end iftex
-
-@node Numerical Functions, Random Numbers, Predicates on Numbers, Numbers
+@node Numerical Functions
@section Numerical Functions
@noindent
These functions perform various arithmetic operations on numbers.
-@defun gcd &rest integers
+@defun cl-gcd &rest integers
This function returns the Greatest Common Divisor of the arguments.
For one argument, it returns the absolute value of that argument.
For zero arguments, it returns zero.
@end defun
-@defun lcm &rest integers
+@defun cl-lcm &rest integers
This function returns the Least Common Multiple of the arguments.
For one argument, it returns the absolute value of that argument.
For zero arguments, it returns one.
@end defun
-@defun isqrt integer
+@defun cl-isqrt integer
This function computes the ``integer square root'' of its integer
argument, i.e., the greatest integer less than or equal to the true
square root of the argument.
@end defun
-@defun floor* number &optional divisor
-This function implements the Common Lisp @code{floor} function.
-It is called @code{floor*} to avoid name conflicts with the
-simpler @code{floor} function built-in to Emacs.
-
-With one argument, @code{floor*} returns a list of two numbers:
+@defun cl-floor number &optional divisor
+With one argument, @code{cl-floor} returns a list of two numbers:
The argument rounded down (toward minus infinity) to an integer,
and the ``remainder'' which would have to be added back to the
first return value to yield the argument again. If the argument
@@ -3415,37 +2966,37 @@ If the argument is a floating-point number, the first
result is a Lisp integer and the second is a Lisp float between
0 (inclusive) and 1 (exclusive).
-With two arguments, @code{floor*} divides @var{number} by
+With two arguments, @code{cl-floor} divides @var{number} by
@var{divisor}, and returns the floor of the quotient and the
corresponding remainder as a list of two numbers. If
-@code{(floor* @var{x} @var{y})} returns @code{(@var{q} @var{r})},
+@code{(cl-floor @var{x} @var{y})} returns @code{(@var{q} @var{r})},
then @code{@var{q}*@var{y} + @var{r} = @var{x}}, with @var{r}
between 0 (inclusive) and @var{r} (exclusive). Also, note
-that @code{(floor* @var{x})} is exactly equivalent to
-@code{(floor* @var{x} 1)}.
+that @code{(cl-floor @var{x})} is exactly equivalent to
+@code{(cl-floor @var{x} 1)}.
This function is entirely compatible with Common Lisp's @code{floor}
function, except that it returns the two results in a list since
Emacs Lisp does not support multiple-valued functions.
@end defun
-@defun ceiling* number &optional divisor
+@defun cl-ceiling number &optional divisor
This function implements the Common Lisp @code{ceiling} function,
which is analogous to @code{floor} except that it rounds the
argument or quotient of the arguments up toward plus infinity.
The remainder will be between 0 and minus @var{r}.
@end defun
-@defun truncate* number &optional divisor
+@defun cl-truncate number &optional divisor
This function implements the Common Lisp @code{truncate} function,
which is analogous to @code{floor} except that it rounds the
argument or quotient of the arguments toward zero. Thus it is
-equivalent to @code{floor*} if the argument or quotient is
-positive, or to @code{ceiling*} otherwise. The remainder has
+equivalent to @code{cl-floor} if the argument or quotient is
+positive, or to @code{cl-ceiling} otherwise. The remainder has
the same sign as @var{number}.
@end defun
-@defun round* number &optional divisor
+@defun cl-round number &optional divisor
This function implements the Common Lisp @code{round} function,
which is analogous to @code{floor} except that it rounds the
argument or quotient of the arguments to the nearest integer.
@@ -3453,62 +3004,47 @@ In the case of a tie (the argument or quotient is exactly
halfway between two integers), it rounds to the even integer.
@end defun
-@defun mod* number divisor
+@defun cl-mod number divisor
This function returns the same value as the second return value
-of @code{floor}.
+of @code{cl-floor}.
@end defun
-@defun rem* number divisor
+@defun cl-rem number divisor
This function returns the same value as the second return value
-of @code{truncate}.
+of @code{cl-truncate}.
@end defun
-These definitions are compatible with those in the Quiroz
-@file{cl.el} package, except that this package appends @samp{*}
-to certain function names to avoid conflicts with existing
-Emacs functions, and that the mechanism for returning
-multiple values is different.
-
-@iftex
-@secno=8
-@end iftex
-
-@node Random Numbers, Implementation Parameters, Numerical Functions, Numbers
+@node Random Numbers
@section Random Numbers
@noindent
This package also provides an implementation of the Common Lisp
random number generator. It uses its own additive-congruential
algorithm, which is much more likely to give statistically clean
+@c FIXME? Still true?
random numbers than the simple generators supplied by many
operating systems.
-@defun random* number &optional state
+@defun cl-random number &optional state
This function returns a random nonnegative number less than
@var{number}, and of the same type (either integer or floating-point).
The @var{state} argument should be a @code{random-state} object
-which holds the state of the random number generator. The
+that holds the state of the random number generator. The
function modifies this state object as a side effect. If
-@var{state} is omitted, it defaults to the variable
-@code{*random-state*}, which contains a pre-initialized
-@code{random-state} object.
+@var{state} is omitted, it defaults to the internal variable
+@code{cl--random-state}, which contains a pre-initialized
+default @code{random-state} object. (Since any number of programs in
+the Emacs process may be accessing @code{cl--random-state} in
+interleaved fashion, the sequence generated from this will be
+irreproducible for all intents and purposes.)
@end defun
-@defvar *random-state*
-This variable contains the system ``default'' @code{random-state}
-object, used for calls to @code{random*} that do not specify an
-alternative state object. Since any number of programs in the
-Emacs process may be accessing @code{*random-state*} in interleaved
-fashion, the sequence generated from this variable will be
-irreproducible for all intents and purposes.
-@end defvar
-
-@defun make-random-state &optional state
+@defun cl-make-random-state &optional state
This function creates or copies a @code{random-state} object.
If @var{state} is omitted or @code{nil}, it returns a new copy of
-@code{*random-state*}. This is a copy in the sense that future
-sequences of calls to @code{(random* @var{n})} and
-@code{(random* @var{n} @var{s})} (where @var{s} is the new
+@code{cl--random-state}. This is a copy in the sense that future
+sequences of calls to @code{(cl-random @var{n})} and
+@code{(cl-random @var{n} @var{s})} (where @var{s} is the new
random-state object) will return identical sequences of random
numbers.
@@ -3523,38 +3059,39 @@ different sequence of random numbers.
It is valid to print a @code{random-state} object to a buffer or
file and later read it back with @code{read}. If a program wishes
to use a sequence of pseudo-random numbers which can be reproduced
-later for debugging, it can call @code{(make-random-state t)} to
+later for debugging, it can call @code{(cl-make-random-state t)} to
get a new sequence, then print this sequence to a file. When the
program is later rerun, it can read the original run's random-state
from the file.
@end defun
-@defun random-state-p object
+@defun cl-random-state-p object
This predicate returns @code{t} if @var{object} is a
@code{random-state} object, or @code{nil} otherwise.
@end defun
-@node Implementation Parameters, , Random Numbers, Numbers
+@node Implementation Parameters
@section Implementation Parameters
@noindent
-This package defines several useful constants having to with numbers.
+This package defines several useful constants having to do with
+floating-point numbers.
-The following parameters have to do with floating-point numbers.
-This package determines their values by exercising the computer's
+It determines their values by exercising the computer's
floating-point arithmetic in various ways. Because this operation
might be slow, the code for initializing them is kept in a separate
function that must be called before the parameters can be used.
@defun cl-float-limits
This function makes sure that the Common Lisp floating-point parameters
-like @code{most-positive-float} have been initialized. Until it is
-called, these parameters will be @code{nil}. If this version of Emacs
-does not support floats, the parameters will remain @code{nil}. If the
-parameters have already been initialized, the function returns
+like @code{cl-most-positive-float} have been initialized. Until it is
+called, these parameters will be @code{nil}.
+@c If this version of Emacs does not support floats, the parameters will
+@c remain @code{nil}.
+If the parameters have already been initialized, the function returns
immediately.
-The algorithm makes assumptions that will be valid for most modern
+The algorithm makes assumptions that will be valid for almost all
machines, but will fail if the machine's arithmetic is extremely
unusual, e.g., decimal.
@end defun
@@ -3566,60 +3103,56 @@ precisions, it has families of constants like
floating-point precision, so this package omits the precision word
from the constants' names.
-@defvar most-positive-float
+@defvar cl-most-positive-float
This constant equals the largest value a Lisp float can hold.
For those systems whose arithmetic supports infinities, this is
the largest @emph{finite} value. For IEEE machines, the value
is approximately @code{1.79e+308}.
@end defvar
-@defvar most-negative-float
-This constant equals the most-negative value a Lisp float can hold.
-(It is assumed to be equal to @code{(- most-positive-float)}.)
+@defvar cl-most-negative-float
+This constant equals the most negative value a Lisp float can hold.
+(It is assumed to be equal to @code{(- cl-most-positive-float)}.)
@end defvar
-@defvar least-positive-float
+@defvar cl-least-positive-float
This constant equals the smallest Lisp float value greater than zero.
For IEEE machines, it is about @code{4.94e-324} if denormals are
supported or @code{2.22e-308} if not.
@end defvar
-@defvar least-positive-normalized-float
+@defvar cl-least-positive-normalized-float
This constant equals the smallest @emph{normalized} Lisp float greater
than zero, i.e., the smallest value for which IEEE denormalization
will not result in a loss of precision. For IEEE machines, this
value is about @code{2.22e-308}. For machines that do not support
the concept of denormalization and gradual underflow, this constant
-will always equal @code{least-positive-float}.
+will always equal @code{cl-least-positive-float}.
@end defvar
-@defvar least-negative-float
-This constant is the negative counterpart of @code{least-positive-float}.
+@defvar cl-least-negative-float
+This constant is the negative counterpart of @code{cl-least-positive-float}.
@end defvar
-@defvar least-negative-normalized-float
+@defvar cl-least-negative-normalized-float
This constant is the negative counterpart of
-@code{least-positive-normalized-float}.
+@code{cl-least-positive-normalized-float}.
@end defvar
-@defvar float-epsilon
+@defvar cl-float-epsilon
This constant is the smallest positive Lisp float that can be added
to 1.0 to produce a distinct value. Adding a smaller number to 1.0
will yield 1.0 again due to roundoff. For IEEE machines, epsilon
is about @code{2.22e-16}.
@end defvar
-@defvar float-negative-epsilon
+@defvar cl-float-negative-epsilon
This is the smallest positive value that can be subtracted from
1.0 to produce a distinct value. For IEEE machines, it is about
@code{1.11e-16}.
@end defvar
-@iftex
-@chapno=13
-@end iftex
-
-@node Sequences, Lists, Numbers, Top
+@node Sequences
@chapter Sequences
@noindent
@@ -3629,14 +3162,14 @@ Emacs Lisp includes a few of these, notably @code{elt} and
@code{length}; this package defines most of the rest.
@menu
-* Sequence Basics:: Arguments shared by all sequence functions
-* Mapping over Sequences:: `mapcar*', `mapcan', `map', `every', etc.
-* Sequence Functions:: `subseq', `remove*', `substitute', etc.
-* Searching Sequences:: `find', `position', `count', `search', etc.
-* Sorting Sequences:: `sort*', `stable-sort', `merge'
+* Sequence Basics:: Arguments shared by all sequence functions.
+* Mapping over Sequences:: @code{cl-mapcar}, @code{cl-map}, @code{cl-maplist}, etc.
+* Sequence Functions:: @code{cl-subseq}, @code{cl-remove}, @code{cl-substitute}, etc.
+* Searching Sequences:: @code{cl-find}, @code{cl-count}, @code{cl-search}, etc.
+* Sorting Sequences:: @code{cl-sort}, @code{cl-stable-sort}, @code{cl-merge}.
@end menu
-@node Sequence Basics, Mapping over Sequences, Sequences, Sequences
+@node Sequence Basics
@section Sequence Basics
@noindent
@@ -3647,8 +3180,8 @@ may appear in any order.
The @code{:key} argument should be passed either @code{nil}, or a
function of one argument. This key function is used as a filter
through which the elements of the sequence are seen; for example,
-@code{(find x y :key 'car)} is similar to @code{(assoc* x y)}:
-It searches for an element of the list whose @code{car} equals
+@code{(cl-find x y :key 'car)} is similar to @code{(cl-assoc x y)}.
+It searches for an element of the list whose @sc{car} equals
@code{x}, rather than for an element which equals @code{x} itself.
If @code{:key} is omitted or @code{nil}, the filter is effectively
the identity function.
@@ -3665,21 +3198,21 @@ true (non-@code{nil}) to indicate a match; instead, you may use
@code{:test-not} to give a function which returns @emph{false} to
indicate a match. The default test function is @code{eql}.
-Many functions which take @var{item} and @code{:test} or @code{:test-not}
+Many functions that take @var{item} and @code{:test} or @code{:test-not}
arguments also come in @code{-if} and @code{-if-not} varieties,
where a @var{predicate} function is passed instead of @var{item},
and sequence elements match if the predicate returns true on them
(or false in the case of @code{-if-not}). For example:
@example
-(remove* 0 seq :test '=) @equiv{} (remove-if 'zerop seq)
+(cl-remove 0 seq :test '=) @equiv{} (cl-remove-if 'zerop seq)
@end example
@noindent
to remove all zeros from sequence @code{seq}.
Some operations can work on a subsequence of the argument sequence;
-these function take @code{:start} and @code{:end} arguments which
+these function take @code{:start} and @code{:end} arguments, which
default to zero and the length of the sequence, respectively.
Only elements between @var{start} (inclusive) and @var{end}
(exclusive) are affected by the operation. The @var{end} argument
@@ -3702,18 +3235,18 @@ are called on various elements. Therefore, it is a bad idea to depend
on side effects of these functions. For example, @code{:from-end}
may cause the sequence to be scanned actually in reverse, or it may
be scanned forwards but computing a result ``as if'' it were scanned
-backwards. (Some functions, like @code{mapcar*} and @code{every},
+backwards. (Some functions, like @code{cl-mapcar} and @code{cl-every},
@emph{do} specify exactly the order in which the function is called
so side effects are perfectly acceptable in those cases.)
Strings may contain ``text properties'' as well
as character data. Except as noted, it is undefined whether or
not text properties are preserved by sequence functions. For
-example, @code{(remove* ?A @var{str})} may or may not preserve
+example, @code{(cl-remove ?A @var{str})} may or may not preserve
the properties of the characters copied from @var{str} into the
result.
-@node Mapping over Sequences, Sequence Functions, Sequence Basics, Sequences
+@node Mapping over Sequences
@section Mapping over Sequences
@noindent
@@ -3721,7 +3254,7 @@ These functions ``map'' the function you specify over the elements
of lists or arrays. They are all variations on the theme of the
built-in function @code{mapcar}.
-@defun mapcar* function seq &rest more-seqs
+@defun cl-mapcar function seq &rest more-seqs
This function calls @var{function} on successive parallel sets of
elements from its argument sequences. Given a single @var{seq}
argument it is equivalent to @code{mapcar}; given @var{n} sequences,
@@ -3734,86 +3267,89 @@ is always a list.
Common Lisp's @code{mapcar} accepts multiple arguments but works
only on lists; Emacs Lisp's @code{mapcar} accepts a single sequence
-argument. This package's @code{mapcar*} works as a compatible
+argument. This package's @code{cl-mapcar} works as a compatible
superset of both.
@end defun
-@defun map result-type function seq &rest more-seqs
+@defun cl-map result-type function seq &rest more-seqs
This function maps @var{function} over the argument sequences,
-just like @code{mapcar*}, but it returns a sequence of type
+just like @code{cl-mapcar}, but it returns a sequence of type
@var{result-type} rather than a list. @var{result-type} must
be one of the following symbols: @code{vector}, @code{string},
@code{list} (in which case the effect is the same as for
-@code{mapcar*}), or @code{nil} (in which case the results are
-thrown away and @code{map} returns @code{nil}).
+@code{cl-mapcar}), or @code{nil} (in which case the results are
+thrown away and @code{cl-map} returns @code{nil}).
@end defun
-@defun maplist function list &rest more-lists
+@defun cl-maplist function list &rest more-lists
This function calls @var{function} on each of its argument lists,
-then on the @code{cdr}s of those lists, and so on, until the
+then on the @sc{cdr}s of those lists, and so on, until the
shortest list runs out. The results are returned in the form
-of a list. Thus, @code{maplist} is like @code{mapcar*} except
+of a list. Thus, @code{cl-maplist} is like @code{cl-mapcar} except
that it passes in the list pointers themselves rather than the
-@code{car}s of the advancing pointers.
+@sc{car}s of the advancing pointers.
@end defun
@defun cl-mapc function seq &rest more-seqs
-This function is like @code{mapcar*}, except that the values returned
+This function is like @code{cl-mapcar}, except that the values returned
by @var{function} are ignored and thrown away rather than being
collected into a list. The return value of @code{cl-mapc} is @var{seq},
the first sequence. This function is more general than the Emacs
-primitive @code{mapc}.
+primitive @code{mapc}. (Note that this function is called
+@code{cl-mapc} even in @file{cl.el}, rather than @code{mapc*} as you
+might expect.)
+@c http://debbugs.gnu.org/6575
@end defun
-@defun mapl function list &rest more-lists
-This function is like @code{maplist}, except that it throws away
+@defun cl-mapl function list &rest more-lists
+This function is like @code{cl-maplist}, except that it throws away
the values returned by @var{function}.
@end defun
-@defun mapcan function seq &rest more-seqs
-This function is like @code{mapcar*}, except that it concatenates
+@defun cl-mapcan function seq &rest more-seqs
+This function is like @code{cl-mapcar}, except that it concatenates
the return values (which must be lists) using @code{nconc},
rather than simply collecting them into a list.
@end defun
-@defun mapcon function list &rest more-lists
-This function is like @code{maplist}, except that it concatenates
+@defun cl-mapcon function list &rest more-lists
+This function is like @code{cl-maplist}, except that it concatenates
the return values using @code{nconc}.
@end defun
-@defun some predicate seq &rest more-seqs
+@defun cl-some predicate seq &rest more-seqs
This function calls @var{predicate} on each element of @var{seq}
in turn; if @var{predicate} returns a non-@code{nil} value,
-@code{some} returns that value, otherwise it returns @code{nil}.
+@code{cl-some} returns that value, otherwise it returns @code{nil}.
Given several sequence arguments, it steps through the sequences
in parallel until the shortest one runs out, just as in
-@code{mapcar*}. You can rely on the left-to-right order in which
+@code{cl-mapcar}. You can rely on the left-to-right order in which
the elements are visited, and on the fact that mapping stops
immediately as soon as @var{predicate} returns non-@code{nil}.
@end defun
-@defun every predicate seq &rest more-seqs
+@defun cl-every predicate seq &rest more-seqs
This function calls @var{predicate} on each element of the sequence(s)
in turn; it returns @code{nil} as soon as @var{predicate} returns
@code{nil} for any element, or @code{t} if the predicate was true
for all elements.
@end defun
-@defun notany predicate seq &rest more-seqs
+@defun cl-notany predicate seq &rest more-seqs
This function calls @var{predicate} on each element of the sequence(s)
in turn; it returns @code{nil} as soon as @var{predicate} returns
a non-@code{nil} value for any element, or @code{t} if the predicate
was @code{nil} for all elements.
@end defun
-@defun notevery predicate seq &rest more-seqs
+@defun cl-notevery predicate seq &rest more-seqs
This function calls @var{predicate} on each element of the sequence(s)
in turn; it returns a non-@code{nil} value as soon as @var{predicate}
returns @code{nil} for any element, or @code{t} if the predicate was
true for all elements.
@end defun
-@defun reduce function seq @t{&key :from-end :start :end :initial-value :key}
+@defun cl-reduce function seq @t{&key :from-end :start :end :initial-value :key}
This function combines the elements of @var{seq} using an associative
binary operation. Suppose @var{function} is @code{*} and @var{seq} is
the list @code{(2 3 4 5)}. The first two elements of the list are
@@ -3821,19 +3357,19 @@ combined with @code{(* 2 3) = 6}; this is combined with the next
element, @code{(* 6 4) = 24}, and that is combined with the final
element: @code{(* 24 5) = 120}. Note that the @code{*} function happens
to be self-reducing, so that @code{(* 2 3 4 5)} has the same effect as
-an explicit call to @code{reduce}.
+an explicit call to @code{cl-reduce}.
If @code{:from-end} is true, the reduction is right-associative instead
of left-associative:
@example
-(reduce '- '(1 2 3 4))
- @equiv{} (- (- (- 1 2) 3) 4) @result{} -8
-(reduce '- '(1 2 3 4) :from-end t)
- @equiv{} (- 1 (- 2 (- 3 4))) @result{} -2
+(cl-reduce '- '(1 2 3 4))
+ @equiv{} (- (- (- 1 2) 3) 4) @result{} -8
+(cl-reduce '- '(1 2 3 4) :from-end t)
+ @equiv{} (- 1 (- 2 (- 3 4))) @result{} -2
@end example
-If @code{:key} is specified, it is a function of one argument which
+If @code{:key} is specified, it is a function of one argument, which
is called on each of the sequence elements in turn.
If @code{:initial-value} is specified, it is effectively added to the
@@ -3847,18 +3383,18 @@ If the sequence is empty (and there is no initial value), then
@end defun
All of these mapping operations can be expressed conveniently in
-terms of the @code{loop} macro. In compiled code, @code{loop} will
+terms of the @code{cl-loop} macro. In compiled code, @code{cl-loop} will
be faster since it generates the loop as in-line code with no
function calls.
-@node Sequence Functions, Searching Sequences, Mapping over Sequences, Sequences
+@node Sequence Functions
@section Sequence Functions
@noindent
This section describes a number of Common Lisp functions for
operating on sequences.
-@defun subseq sequence start &optional end
+@defun cl-subseq sequence start &optional end
This function returns a given subsequence of the argument
@var{sequence}, which may be a list, string, or vector.
The indices @var{start} and @var{end} must be in range, and
@@ -3870,30 +3406,30 @@ with @var{sequence}.
As an extension to Common Lisp, @var{start} and/or @var{end}
may be negative, in which case they represent a distance back
from the end of the sequence. This is for compatibility with
-Emacs' @code{substring} function. Note that @code{subseq} is
+Emacs's @code{substring} function. Note that @code{cl-subseq} is
the @emph{only} sequence function that allows negative
@var{start} and @var{end}.
-You can use @code{setf} on a @code{subseq} form to replace a
+You can use @code{setf} on a @code{cl-subseq} form to replace a
specified range of elements with elements from another sequence.
-The replacement is done as if by @code{replace}, described below.
+The replacement is done as if by @code{cl-replace}, described below.
@end defun
-@defun concatenate result-type &rest seqs
+@defun cl-concatenate result-type &rest seqs
This function concatenates the argument sequences together to
form a result sequence of type @var{result-type}, one of the
symbols @code{vector}, @code{string}, or @code{list}. The
arguments are always copied, even in cases such as
-@code{(concatenate 'list '(1 2 3))} where the result is
+@code{(cl-concatenate 'list '(1 2 3))} where the result is
identical to an argument.
@end defun
-@defun fill seq item @t{&key :start :end}
+@defun cl-fill seq item @t{&key :start :end}
This function fills the elements of the sequence (or the specified
part of the sequence) with the value @var{item}.
@end defun
-@defun replace seq1 seq2 @t{&key :start1 :end1 :start2 :end2}
+@defun cl-replace seq1 seq2 @t{&key :start1 :end1 :start2 :end2}
This function copies part of @var{seq2} into part of @var{seq1}.
The sequence @var{seq1} is not stretched or resized; the amount
of data copied is simply the shorter of the source and destination
@@ -3902,12 +3438,12 @@ of data copied is simply the shorter of the source and destination
If @var{seq1} and @var{seq2} are @code{eq}, then the replacement
will work correctly even if the regions indicated by the start
and end arguments overlap. However, if @var{seq1} and @var{seq2}
-are lists which share storage but are not @code{eq}, and the
+are lists that share storage but are not @code{eq}, and the
start and end arguments specify overlapping regions, the effect
is undefined.
@end defun
-@defun remove* item seq @t{&key :test :test-not :key :count :start :end :from-end}
+@defun cl-remove item seq @t{&key :test :test-not :key :count :start :end :from-end}
This returns a copy of @var{seq} with all elements matching
@var{item} removed. The result may share storage with or be
@code{eq} to @var{seq} in some circumstances, but the original
@@ -3924,25 +3460,25 @@ end of the sequence rather than the beginning (this matters only
if @var{count} was also specified).
@end defun
-@defun delete* item seq @t{&key :test :test-not :key :count :start :end :from-end}
-This deletes all elements of @var{seq} which match @var{item}.
+@defun cl-delete item seq @t{&key :test :test-not :key :count :start :end :from-end}
+This deletes all elements of @var{seq} that match @var{item}.
It is a destructive operation. Since Emacs Lisp does not support
-stretchable strings or vectors, this is the same as @code{remove*}
-for those sequence types. On lists, @code{remove*} will copy the
+stretchable strings or vectors, this is the same as @code{cl-remove}
+for those sequence types. On lists, @code{cl-remove} will copy the
list if necessary to preserve the original list, whereas
-@code{delete*} will splice out parts of the argument list.
+@code{cl-delete} will splice out parts of the argument list.
Compare @code{append} and @code{nconc}, which are analogous
non-destructive and destructive list operations in Emacs Lisp.
@end defun
-@findex remove-if
-@findex remove-if-not
-@findex delete-if
-@findex delete-if-not
-The predicate-oriented functions @code{remove-if}, @code{remove-if-not},
-@code{delete-if}, and @code{delete-if-not} are defined similarly.
+@findex cl-remove-if
+@findex cl-remove-if-not
+@findex cl-delete-if
+@findex cl-delete-if-not
+The predicate-oriented functions @code{cl-remove-if}, @code{cl-remove-if-not},
+@code{cl-delete-if}, and @code{cl-delete-if-not} are defined similarly.
-@defun remove-duplicates seq @t{&key :test :test-not :key :start :end :from-end}
+@defun cl-remove-duplicates seq @t{&key :test :test-not :key :start :end :from-end}
This function returns a copy of @var{seq} with duplicate elements
removed. Specifically, if two elements from the sequence match
according to the @code{:test}, @code{:test-not}, and @code{:key}
@@ -3952,40 +3488,41 @@ is true, the leftmost one is retained instead. If @code{:start} or
examined or removed.
@end defun
-@defun delete-duplicates seq @t{&key :test :test-not :key :start :end :from-end}
+@defun cl-delete-duplicates seq @t{&key :test :test-not :key :start :end :from-end}
This function deletes duplicate elements from @var{seq}. It is
-a destructive version of @code{remove-duplicates}.
+a destructive version of @code{cl-remove-duplicates}.
@end defun
-@defun substitute new old seq @t{&key :test :test-not :key :count :start :end :from-end}
+@defun cl-substitute new old seq @t{&key :test :test-not :key :count :start :end :from-end}
This function returns a copy of @var{seq}, with all elements
matching @var{old} replaced with @var{new}. The @code{:count},
@code{:start}, @code{:end}, and @code{:from-end} arguments may be
used to limit the number of substitutions made.
@end defun
-@defun nsubstitute new old seq @t{&key :test :test-not :key :count :start :end :from-end}
-This is a destructive version of @code{substitute}; it performs
+@defun cl-nsubstitute new old seq @t{&key :test :test-not :key :count :start :end :from-end}
+This is a destructive version of @code{cl-substitute}; it performs
the substitution using @code{setcar} or @code{aset} rather than
by returning a changed copy of the sequence.
@end defun
-@findex substitute-if
-@findex substitute-if-not
-@findex nsubstitute-if
-@findex nsubstitute-if-not
-The @code{substitute-if}, @code{substitute-if-not}, @code{nsubstitute-if},
-and @code{nsubstitute-if-not} functions are defined similarly. For
-these, a @var{predicate} is given in place of the @var{old} argument.
+@findex cl-substitute-if
+@findex cl-substitute-if-not
+@findex cl-nsubstitute-if
+@findex cl-nsubstitute-if-not
+The functions @code{cl-substitute-if}, @code{cl-substitute-if-not},
+@code{cl-nsubstitute-if}, and @code{cl-nsubstitute-if-not} are defined
+similarly. For these, a @var{predicate} is given in place of the
+@var{old} argument.
-@node Searching Sequences, Sorting Sequences, Sequence Functions, Sequences
+@node Searching Sequences
@section Searching Sequences
@noindent
These functions search for elements or subsequences in a sequence.
-(See also @code{member*} and @code{assoc*}; @pxref{Lists}.)
+(See also @code{cl-member} and @code{cl-assoc}; @pxref{Lists}.)
-@defun find item seq @t{&key :test :test-not :key :start :end :from-end}
+@defun cl-find item seq @t{&key :test :test-not :key :start :end :from-end}
This function searches @var{seq} for an element matching @var{item}.
If it finds a match, it returns the matching element. Otherwise,
it returns @code{nil}. It returns the leftmost match, unless
@@ -3994,37 +3531,37 @@ match. The @code{:start} and @code{:end} arguments may be used to
limit the range of elements that are searched.
@end defun
-@defun position item seq @t{&key :test :test-not :key :start :end :from-end}
-This function is like @code{find}, except that it returns the
+@defun cl-position item seq @t{&key :test :test-not :key :start :end :from-end}
+This function is like @code{cl-find}, except that it returns the
integer position in the sequence of the matching item rather than
the item itself. The position is relative to the start of the
sequence as a whole, even if @code{:start} is non-zero. The function
returns @code{nil} if no matching element was found.
@end defun
-@defun count item seq @t{&key :test :test-not :key :start :end}
+@defun cl-count item seq @t{&key :test :test-not :key :start :end}
This function returns the number of elements of @var{seq} which
match @var{item}. The result is always a nonnegative integer.
@end defun
-@findex find-if
-@findex find-if-not
-@findex position-if
-@findex position-if-not
-@findex count-if
-@findex count-if-not
-The @code{find-if}, @code{find-if-not}, @code{position-if},
-@code{position-if-not}, @code{count-if}, and @code{count-if-not}
+@findex cl-find-if
+@findex cl-find-if-not
+@findex cl-position-if
+@findex cl-position-if-not
+@findex cl-count-if
+@findex cl-count-if-not
+The @code{cl-find-if}, @code{cl-find-if-not}, @code{cl-position-if},
+@code{cl-position-if-not}, @code{cl-count-if}, and @code{cl-count-if-not}
functions are defined similarly.
-@defun mismatch seq1 seq2 @t{&key :test :test-not :key :start1 :end1 :start2 :end2 :from-end}
+@defun cl-mismatch seq1 seq2 @t{&key :test :test-not :key :start1 :end1 :start2 :end2 :from-end}
This function compares the specified parts of @var{seq1} and
@var{seq2}. If they are the same length and the corresponding
elements match (according to @code{:test}, @code{:test-not},
and @code{:key}), the function returns @code{nil}. If there is
a mismatch, the function returns the index (relative to @var{seq1})
of the first mismatching element. This will be the leftmost pair of
-elements which do not match, or the position at which the shorter of
+elements that do not match, or the position at which the shorter of
the two otherwise-matching sequences runs out.
If @code{:from-end} is true, then the elements are compared from right
@@ -4032,14 +3569,14 @@ to left starting at @code{(1- @var{end1})} and @code{(1- @var{end2})}.
If the sequences differ, then one plus the index of the rightmost
difference (relative to @var{seq1}) is returned.
-An interesting example is @code{(mismatch str1 str2 :key 'upcase)},
+An interesting example is @code{(cl-mismatch str1 str2 :key 'upcase)},
which compares two strings case-insensitively.
@end defun
-@defun search seq1 seq2 @t{&key :test :test-not :key :from-end :start1 :end1 :start2 :end2}
+@defun cl-search seq1 seq2 @t{&key :test :test-not :key :from-end :start1 :end1 :start2 :end2}
This function searches @var{seq2} for a subsequence that matches
@var{seq1} (or part of it specified by @code{:start1} and
-@code{:end1}.) Only matches which fall entirely within the region
+@code{:end1}). Only matches that fall entirely within the region
defined by @code{:start2} and @code{:end2} will be considered.
The return value is the index of the leftmost element of the
leftmost match, relative to the start of @var{seq2}, or @code{nil}
@@ -4047,10 +3584,10 @@ if no matches were found. If @code{:from-end} is true, the
function finds the @emph{rightmost} matching subsequence.
@end defun
-@node Sorting Sequences, , Searching Sequences, Sequences
+@node Sorting Sequences
@section Sorting Sequences
-@defun sort* seq predicate @t{&key :key}
+@defun cl-sort seq predicate @t{&key :key}
This function sorts @var{seq} into increasing order as determined
by using @var{predicate} to compare pairs of elements. @var{predicate}
should return true (non-@code{nil}) if and only if its first argument
@@ -4059,41 +3596,41 @@ is less than (not equal to) its second argument. For example,
for sorting numbers and strings, respectively; @code{>} would sort
numbers into decreasing rather than increasing order.
-This function differs from Emacs' built-in @code{sort} in that it
+This function differs from Emacs's built-in @code{sort} in that it
can operate on any type of sequence, not just lists. Also, it
-accepts a @code{:key} argument which is used to preprocess data
+accepts a @code{:key} argument, which is used to preprocess data
fed to the @var{predicate} function. For example,
@example
-(setq data (sort* data 'string-lessp :key 'downcase))
+(setq data (cl-sort data 'string-lessp :key 'downcase))
@end example
@noindent
sorts @var{data}, a sequence of strings, into increasing alphabetical
order without regard to case. A @code{:key} function of @code{car}
would be useful for sorting association lists. It should only be a
-simple accessor though, it's used heavily in the current
+simple accessor though, since it's used heavily in the current
implementation.
-The @code{sort*} function is destructive; it sorts lists by actually
-rearranging the @code{cdr} pointers in suitable fashion.
+The @code{cl-sort} function is destructive; it sorts lists by actually
+rearranging the @sc{cdr} pointers in suitable fashion.
@end defun
-@defun stable-sort seq predicate @t{&key :key}
+@defun cl-stable-sort seq predicate @t{&key :key}
This function sorts @var{seq} @dfn{stably}, meaning two elements
which are equal in terms of @var{predicate} are guaranteed not to
be rearranged out of their original order by the sort.
-In practice, @code{sort*} and @code{stable-sort} are equivalent
+In practice, @code{cl-sort} and @code{cl-stable-sort} are equivalent
in Emacs Lisp because the underlying @code{sort} function is
stable by default. However, this package reserves the right to
-use non-stable methods for @code{sort*} in the future.
+use non-stable methods for @code{cl-sort} in the future.
@end defun
-@defun merge type seq1 seq2 predicate @t{&key :key}
+@defun cl-merge type seq1 seq2 predicate @t{&key :key}
This function merges two sequences @var{seq1} and @var{seq2} by
interleaving their elements. The result sequence, of type @var{type}
-(in the sense of @code{concatenate}), has length equal to the sum
+(in the sense of @code{cl-concatenate}), has length equal to the sum
of the lengths of the two input sequences. The sequences may be
modified destructively. Order of elements within @var{seq1} and
@var{seq2} is preserved in the interleaving; elements of the two
@@ -4106,127 +3643,109 @@ a merged sequence which is (stably) sorted according to
@var{predicate}.
@end defun
-@node Lists, Structures, Sequences, Top
+@node Lists
@chapter Lists
@noindent
The functions described here operate on lists.
@menu
-* List Functions:: `caddr', `first', `list*', etc.
-* Substitution of Expressions:: `subst', `sublis', etc.
-* Lists as Sets:: `member*', `adjoin', `union', etc.
-* Association Lists:: `assoc*', `rassoc*', `acons', `pairlis'
+* List Functions:: @code{cl-caddr}, @code{cl-first}, @code{cl-list*}, etc.
+* Substitution of Expressions:: @code{cl-subst}, @code{cl-sublis}, etc.
+* Lists as Sets:: @code{cl-member}, @code{cl-adjoin}, @code{cl-union}, etc.
+* Association Lists:: @code{cl-assoc}, @code{cl-acons}, @code{cl-pairlis}, etc.
@end menu
-@node List Functions, Substitution of Expressions, Lists, Lists
+@node List Functions
@section List Functions
@noindent
This section describes a number of simple operations on lists,
i.e., chains of cons cells.
-@defun caddr x
+@defun cl-caddr x
This function is equivalent to @code{(car (cdr (cdr @var{x})))}.
-Likewise, this package defines all 28 @code{c@var{xxx}r} functions
+Likewise, this package defines all 24 @code{c@var{xxx}r} functions
where @var{xxx} is up to four @samp{a}s and/or @samp{d}s.
All of these functions are @code{setf}-able, and calls to them
are expanded inline by the byte-compiler for maximum efficiency.
@end defun
-@defun first x
+@defun cl-first x
This function is a synonym for @code{(car @var{x})}. Likewise,
-the functions @code{second}, @code{third}, @dots{}, through
-@code{tenth} return the given element of the list @var{x}.
+the functions @code{cl-second}, @code{cl-third}, @dots{}, through
+@code{cl-tenth} return the given element of the list @var{x}.
@end defun
-@defun rest x
+@defun cl-rest x
This function is a synonym for @code{(cdr @var{x})}.
@end defun
-@defun endp x
+@defun cl-endp x
Common Lisp defines this function to act like @code{null}, but
signaling an error if @code{x} is neither a @code{nil} nor a
-cons cell. This package simply defines @code{endp} as a synonym
+cons cell. This package simply defines @code{cl-endp} as a synonym
for @code{null}.
@end defun
-@defun list-length x
+@defun cl-list-length x
This function returns the length of list @var{x}, exactly like
@code{(length @var{x})}, except that if @var{x} is a circular
-list (where the cdr-chain forms a loop rather than terminating
+list (where the @sc{cdr}-chain forms a loop rather than terminating
with @code{nil}), this function returns @code{nil}. (The regular
-@code{length} function would get stuck if given a circular list.)
+@code{length} function would get stuck if given a circular list.
+See also the @code{safe-length} function.)
@end defun
-@defun list* arg &rest others
+@defun cl-list* arg &rest others
This function constructs a list of its arguments. The final
-argument becomes the @code{cdr} of the last cell constructed.
-Thus, @code{(list* @var{a} @var{b} @var{c})} is equivalent to
+argument becomes the @sc{cdr} of the last cell constructed.
+Thus, @code{(cl-list* @var{a} @var{b} @var{c})} is equivalent to
@code{(cons @var{a} (cons @var{b} @var{c}))}, and
-@code{(list* @var{a} @var{b} nil)} is equivalent to
+@code{(cl-list* @var{a} @var{b} nil)} is equivalent to
@code{(list @var{a} @var{b})}.
-
-(Note that this function really is called @code{list*} in Common
-Lisp; it is not a name invented for this package like @code{member*}
-or @code{defun*}.)
@end defun
-@defun ldiff list sublist
+@defun cl-ldiff list sublist
If @var{sublist} is a sublist of @var{list}, i.e., is @code{eq} to
one of the cons cells of @var{list}, then this function returns
a copy of the part of @var{list} up to but not including
-@var{sublist}. For example, @code{(ldiff x (cddr x))} returns
+@var{sublist}. For example, @code{(cl-ldiff x (cddr x))} returns
the first two elements of the list @code{x}. The result is a
copy; the original @var{list} is not modified. If @var{sublist}
is not a sublist of @var{list}, a copy of the entire @var{list}
is returned.
@end defun
-@defun copy-list list
+@defun cl-copy-list list
This function returns a copy of the list @var{list}. It copies
dotted lists like @code{(1 2 . 3)} correctly.
@end defun
-@defun copy-tree x &optional vecp
-This function returns a copy of the tree of cons cells @var{x}.
-Unlike @code{copy-sequence} (and its alias @code{copy-list}),
-which copies only along the @code{cdr} direction, this function
-copies (recursively) along both the @code{car} and the @code{cdr}
-directions. If @var{x} is not a cons cell, the function simply
-returns @var{x} unchanged. If the optional @var{vecp} argument
-is true, this function copies vectors (recursively) as well as
-cons cells.
-@end defun
-
-@defun tree-equal x y @t{&key :test :test-not :key}
+@defun cl-tree-equal x y @t{&key :test :test-not :key}
This function compares two trees of cons cells. If @var{x} and
-@var{y} are both cons cells, their @code{car}s and @code{cdr}s are
+@var{y} are both cons cells, their @sc{car}s and @sc{cdr}s are
compared recursively. If neither @var{x} nor @var{y} is a cons
cell, they are compared by @code{eql}, or according to the
specified test. The @code{:key} function, if specified, is
applied to the elements of both trees. @xref{Sequences}.
@end defun
-@iftex
-@secno=3
-@end iftex
-
-@node Substitution of Expressions, Lists as Sets, List Functions, Lists
+@node Substitution of Expressions
@section Substitution of Expressions
@noindent
These functions substitute elements throughout a tree of cons
-cells. (@xref{Sequence Functions}, for the @code{substitute}
+cells. (@xref{Sequence Functions}, for the @code{cl-substitute}
function, which works on just the top-level elements of a list.)
-@defun subst new old tree @t{&key :test :test-not :key}
+@defun cl-subst new old tree @t{&key :test :test-not :key}
This function substitutes occurrences of @var{old} with @var{new}
in @var{tree}, a tree of cons cells. It returns a substituted
tree, which will be a copy except that it may share storage with
the argument @var{tree} in parts where no substitutions occurred.
The original @var{tree} is not modified. This function recurses
-on, and compares against @var{old}, both @code{car}s and @code{cdr}s
+on, and compares against @var{old}, both @sc{car}s and @sc{cdr}s
of the component cons cells. If @var{old} is itself a cons cell,
then matching cells in the tree are substituted as usual without
recursively substituting in that cell. Comparisons with @var{old}
@@ -4235,132 +3754,132 @@ The @code{:key} function is applied to the elements of the tree
but not to @var{old}.
@end defun
-@defun nsubst new old tree @t{&key :test :test-not :key}
-This function is like @code{subst}, except that it works by
+@defun cl-nsubst new old tree @t{&key :test :test-not :key}
+This function is like @code{cl-subst}, except that it works by
destructive modification (by @code{setcar} or @code{setcdr})
rather than copying.
@end defun
-@findex subst-if
-@findex subst-if-not
-@findex nsubst-if
-@findex nsubst-if-not
-The @code{subst-if}, @code{subst-if-not}, @code{nsubst-if}, and
-@code{nsubst-if-not} functions are defined similarly.
+@findex cl-subst-if
+@findex cl-subst-if-not
+@findex cl-nsubst-if
+@findex cl-nsubst-if-not
+The @code{cl-subst-if}, @code{cl-subst-if-not}, @code{cl-nsubst-if}, and
+@code{cl-nsubst-if-not} functions are defined similarly.
-@defun sublis alist tree @t{&key :test :test-not :key}
-This function is like @code{subst}, except that it takes an
+@defun cl-sublis alist tree @t{&key :test :test-not :key}
+This function is like @code{cl-subst}, except that it takes an
association list @var{alist} of @var{old}-@var{new} pairs.
Each element of the tree (after applying the @code{:key}
-function, if any), is compared with the @code{car}s of
+function, if any), is compared with the @sc{car}s of
@var{alist}; if it matches, it is replaced by the corresponding
-@code{cdr}.
+@sc{cdr}.
@end defun
-@defun nsublis alist tree @t{&key :test :test-not :key}
-This is a destructive version of @code{sublis}.
+@defun cl-nsublis alist tree @t{&key :test :test-not :key}
+This is a destructive version of @code{cl-sublis}.
@end defun
-@node Lists as Sets, Association Lists, Substitution of Expressions, Lists
+@node Lists as Sets
@section Lists as Sets
@noindent
-These functions perform operations on lists which represent sets
+These functions perform operations on lists that represent sets
of elements.
-@defun member* item list @t{&key :test :test-not :key}
+@defun cl-member item list @t{&key :test :test-not :key}
This function searches @var{list} for an element matching @var{item}.
-If a match is found, it returns the cons cell whose @code{car} was
+If a match is found, it returns the cons cell whose @sc{car} was
the matching element. Otherwise, it returns @code{nil}. Elements
are compared by @code{eql} by default; you can use the @code{:test},
@code{:test-not}, and @code{:key} arguments to modify this behavior.
@xref{Sequences}.
-Note that this function's name is suffixed by @samp{*} to avoid
-the incompatible @code{member} function defined in Emacs.
-(That function uses @code{equal} for comparisons; it is equivalent
-to @code{(member* @var{item} @var{list} :test 'equal)}.)
+The standard Emacs lisp function @code{member} uses @code{equal} for
+comparisons; it is equivalent to @code{(cl-member @var{item} @var{list}
+:test 'equal)}. With no keyword arguments, @code{cl-member} is
+equivalent to @code{memq}.
@end defun
-@findex member-if
-@findex member-if-not
-The @code{member-if} and @code{member-if-not} functions
-analogously search for elements which satisfy a given predicate.
+@findex cl-member-if
+@findex cl-member-if-not
+The @code{cl-member-if} and @code{cl-member-if-not} functions
+analogously search for elements that satisfy a given predicate.
-@defun tailp sublist list
+@defun cl-tailp sublist list
This function returns @code{t} if @var{sublist} is a sublist of
@var{list}, i.e., if @var{sublist} is @code{eql} to @var{list} or to
-any of its @code{cdr}s.
+any of its @sc{cdr}s.
@end defun
-@defun adjoin item list @t{&key :test :test-not :key}
+@defun cl-adjoin item list @t{&key :test :test-not :key}
This function conses @var{item} onto the front of @var{list},
like @code{(cons @var{item} @var{list})}, but only if @var{item}
-is not already present on the list (as determined by @code{member*}).
+is not already present on the list (as determined by @code{cl-member}).
If a @code{:key} argument is specified, it is applied to
@var{item} as well as to the elements of @var{list} during
the search, on the reasoning that @var{item} is ``about'' to
become part of the list.
@end defun
-@defun union list1 list2 @t{&key :test :test-not :key}
-This function combines two lists which represent sets of items,
+@defun cl-union list1 list2 @t{&key :test :test-not :key}
+This function combines two lists that represent sets of items,
returning a list that represents the union of those two sets.
-The result list will contain all items which appear in @var{list1}
+The resulting list contains all items that appear in @var{list1}
or @var{list2}, and no others. If an item appears in both
-@var{list1} and @var{list2} it will be copied only once. If
+@var{list1} and @var{list2} it is copied only once. If
an item is duplicated in @var{list1} or @var{list2}, it is
undefined whether or not that duplication will survive in the
result list. The order of elements in the result list is also
undefined.
@end defun
-@defun nunion list1 list2 @t{&key :test :test-not :key}
-This is a destructive version of @code{union}; rather than copying,
+@defun cl-nunion list1 list2 @t{&key :test :test-not :key}
+This is a destructive version of @code{cl-union}; rather than copying,
it tries to reuse the storage of the argument lists if possible.
@end defun
-@defun intersection list1 list2 @t{&key :test :test-not :key}
+@defun cl-intersection list1 list2 @t{&key :test :test-not :key}
This function computes the intersection of the sets represented
by @var{list1} and @var{list2}. It returns the list of items
-which appear in both @var{list1} and @var{list2}.
+that appear in both @var{list1} and @var{list2}.
@end defun
-@defun nintersection list1 list2 @t{&key :test :test-not :key}
-This is a destructive version of @code{intersection}. It
+@defun cl-nintersection list1 list2 @t{&key :test :test-not :key}
+This is a destructive version of @code{cl-intersection}. It
tries to reuse storage of @var{list1} rather than copying.
It does @emph{not} reuse the storage of @var{list2}.
@end defun
-@defun set-difference list1 list2 @t{&key :test :test-not :key}
+@defun cl-set-difference list1 list2 @t{&key :test :test-not :key}
This function computes the ``set difference'' of @var{list1}
and @var{list2}, i.e., the set of elements that appear in
@var{list1} but @emph{not} in @var{list2}.
@end defun
-@defun nset-difference list1 list2 @t{&key :test :test-not :key}
-This is a destructive @code{set-difference}, which will try
+@defun cl-nset-difference list1 list2 @t{&key :test :test-not :key}
+This is a destructive @code{cl-set-difference}, which will try
to reuse @var{list1} if possible.
@end defun
-@defun set-exclusive-or list1 list2 @t{&key :test :test-not :key}
+@defun cl-set-exclusive-or list1 list2 @t{&key :test :test-not :key}
This function computes the ``set exclusive or'' of @var{list1}
and @var{list2}, i.e., the set of elements that appear in
exactly one of @var{list1} and @var{list2}.
@end defun
-@defun nset-exclusive-or list1 list2 @t{&key :test :test-not :key}
-This is a destructive @code{set-exclusive-or}, which will try
+@defun cl-nset-exclusive-or list1 list2 @t{&key :test :test-not :key}
+This is a destructive @code{cl-set-exclusive-or}, which will try
to reuse @var{list1} and @var{list2} if possible.
@end defun
-@defun subsetp list1 list2 @t{&key :test :test-not :key}
+@defun cl-subsetp list1 list2 @t{&key :test :test-not :key}
This function checks whether @var{list1} represents a subset
of @var{list2}, i.e., whether every element of @var{list1}
also appears in @var{list2}.
@end defun
-@node Association Lists, , Lists as Sets, Lists
+@node Association Lists
@section Association Lists
@noindent
@@ -4368,47 +3887,43 @@ An @dfn{association list} is a list representing a mapping from
one set of values to another; any list whose elements are cons
cells is an association list.
-@defun assoc* item a-list @t{&key :test :test-not :key}
+@defun cl-assoc item a-list @t{&key :test :test-not :key}
This function searches the association list @var{a-list} for an
-element whose @code{car} matches (in the sense of @code{:test},
+element whose @sc{car} matches (in the sense of @code{:test},
@code{:test-not}, and @code{:key}, or by comparison with @code{eql})
a given @var{item}. It returns the matching element, if any,
-otherwise @code{nil}. It ignores elements of @var{a-list} which
+otherwise @code{nil}. It ignores elements of @var{a-list} that
are not cons cells. (This corresponds to the behavior of
@code{assq} and @code{assoc} in Emacs Lisp; Common Lisp's
@code{assoc} ignores @code{nil}s but considers any other non-cons
elements of @var{a-list} to be an error.)
@end defun
-@defun rassoc* item a-list @t{&key :test :test-not :key}
-This function searches for an element whose @code{cdr} matches
+@defun cl-rassoc item a-list @t{&key :test :test-not :key}
+This function searches for an element whose @sc{cdr} matches
@var{item}. If @var{a-list} represents a mapping, this applies
the inverse of the mapping to @var{item}.
@end defun
-@findex assoc-if
-@findex assoc-if-not
-@findex rassoc-if
-@findex rassoc-if-not
-The @code{assoc-if}, @code{assoc-if-not}, @code{rassoc-if},
-and @code{rassoc-if-not} functions are defined similarly.
+@findex cl-assoc-if
+@findex cl-assoc-if-not
+@findex cl-rassoc-if
+@findex cl-rassoc-if-not
+The @code{cl-assoc-if}, @code{cl-assoc-if-not}, @code{cl-rassoc-if},
+and @code{cl-rassoc-if-not} functions are defined similarly.
Two simple functions for constructing association lists are:
-@defun acons key value alist
+@defun cl-acons key value alist
This is equivalent to @code{(cons (cons @var{key} @var{value}) @var{alist})}.
@end defun
-@defun pairlis keys values &optional alist
-This is equivalent to @code{(nconc (mapcar* 'cons @var{keys} @var{values})
+@defun cl-pairlis keys values &optional alist
+This is equivalent to @code{(nconc (cl-mapcar 'cons @var{keys} @var{values})
@var{alist})}.
@end defun
-@iftex
-@chapno=18
-@end iftex
-
-@node Structures, Assertions, Lists, Top
+@node Structures
@chapter Structures
@noindent
@@ -4426,43 +3941,43 @@ system provides no way to create new distinct types, this package
implements structures as vectors (or lists upon request) with a
special ``tag'' symbol to identify them.
-@defspec defstruct name slots@dots{}
-The @code{defstruct} form defines a new structure type called
+@defmac cl-defstruct name slots@dots{}
+The @code{cl-defstruct} form defines a new structure type called
@var{name}, with the specified @var{slots}. (The @var{slots}
may begin with a string which documents the structure type.)
In the simplest case, @var{name} and each of the @var{slots}
are symbols. For example,
@example
-(defstruct person name age sex)
+(cl-defstruct person name age sex)
@end example
@noindent
-defines a struct type called @code{person} which contains three
+defines a struct type called @code{person} that contains three
slots. Given a @code{person} object @var{p}, you can access those
slots by calling @code{(person-name @var{p})}, @code{(person-age @var{p})},
and @code{(person-sex @var{p})}. You can also change these slots by
-using @code{setf} on any of these place forms:
+using @code{setf} on any of these place forms, for example:
@example
-(incf (person-age birthday-boy))
+(cl-incf (person-age birthday-boy))
@end example
You can create a new @code{person} by calling @code{make-person},
which takes keyword arguments @code{:name}, @code{:age}, and
@code{:sex} to specify the initial values of these slots in the
new object. (Omitting any of these arguments leaves the corresponding
-slot ``undefined,'' according to the Common Lisp standard; in Emacs
+slot ``undefined'', according to the Common Lisp standard; in Emacs
Lisp, such uninitialized slots are filled with @code{nil}.)
Given a @code{person}, @code{(copy-person @var{p})} makes a new
object of the same type whose slots are @code{eq} to those of @var{p}.
Given any Lisp object @var{x}, @code{(person-p @var{x})} returns
-true if @var{x} looks like a @code{person}, false otherwise. (Again,
+true if @var{x} looks like a @code{person}, and false otherwise. (Again,
in Common Lisp this predicate would be exact; in Emacs Lisp the
best it can do is verify that @var{x} is a vector of the correct
-length which starts with the correct tag symbol.)
+length that starts with the correct tag symbol.)
Accessors like @code{person-name} normally check their arguments
(effectively using @code{person-p}) and signal an error if the
@@ -4499,7 +4014,7 @@ In general, @var{name} is either a name symbol or a list of a name
symbol followed by any number of @dfn{struct options}; each @var{slot}
is either a slot symbol or a list of the form @samp{(@var{slot-name}
@var{default-value} @var{slot-options}@dots{})}. The @var{default-value}
-is a Lisp form which is evaluated any time an instance of the
+is a Lisp form that is evaluated any time an instance of the
structure type is created without specifying that slot's value.
Common Lisp defines several slot options, but the only one
@@ -4509,10 +4024,10 @@ the slot's value is determined when the object is created and does
not change afterward.
@example
-(defstruct person
- (name nil :read-only t)
- age
- (sex 'unknown))
+(cl-defstruct person
+ (name nil :read-only t)
+ age
+ (sex 'unknown))
@end example
Any slot options other than @code{:read-only} are ignored.
@@ -4524,19 +4039,15 @@ by arguments. (By contrast, slot options are key-value pairs not
enclosed in lists.)
@example
-(defstruct (person (:constructor create-person)
- (:type list)
- :named)
- name age sex)
+(cl-defstruct (person (:constructor create-person)
+ (:type list)
+ :named)
+ name age sex)
@end example
The following structure options are recognized.
@table @code
-@iftex
-@itemmax=0 in
-@advance@leftskip-.5@tableindent
-@end iftex
@item :conc-name
The argument is a symbol whose print name is used as the prefix for
the names of slot accessor functions. The default is the name of
@@ -4561,11 +4072,11 @@ The argument names should match the slot names; each slot is
initialized from the corresponding argument. Slots whose names
do not appear in the argument list are initialized based on the
@var{default-value} in their slot descriptor. Also, @code{&optional}
-and @code{&key} arguments which don't specify defaults take their
+and @code{&key} arguments that don't specify defaults take their
defaults from the slot descriptor. It is valid to include arguments
-which don't correspond to slot names; these are useful if they are
+that don't correspond to slot names; these are useful if they are
referred to in the defaults for optional, keyword, or @code{&aux}
-arguments which @emph{do} correspond to slots.
+arguments that @emph{do} correspond to slots.
You can specify any number of full-format @code{:constructor}
options on a structure. The default constructor is still generated
@@ -4573,21 +4084,22 @@ as well unless you disable it with a simple-format @code{:constructor}
option.
@example
-(defstruct
- (person
- (:constructor nil) ; no default constructor
- (:constructor new-person (name sex &optional (age 0)))
- (:constructor new-hound (&key (name "Rover")
- (dog-years 0)
- &aux (age (* 7 dog-years))
- (sex 'canine))))
- name age sex)
+(cl-defstruct
+ (person
+ (:constructor nil) ; no default constructor
+ (:constructor new-person
+ (name sex &optional (age 0)))
+ (:constructor new-hound (&key (name "Rover")
+ (dog-years 0)
+ &aux (age (* 7 dog-years))
+ (sex 'canine))))
+ name age sex)
@end example
The first constructor here takes its arguments positionally rather
than by keyword. (In official Common Lisp terminology, constructors
that work By Order of Arguments instead of by keyword are called
-``BOA constructors.'' No, I'm not making this up.) For example,
+``BOA constructors''. No, I'm not making this up.) For example,
@code{(new-person "Jane" 'female)} generates a person whose slots
are @code{"Jane"}, 0, and @code{female}, respectively.
@@ -4605,7 +4117,7 @@ means not to generate a copier function. (In this implementation,
all copier functions are simply synonyms for @code{copy-sequence}.)
@item :predicate
-The argument is an alternate name for the predicate which recognizes
+The argument is an alternate name for the predicate that recognizes
objects of this type. The default is @code{@var{name}-p}. @code{nil}
means not to generate a predicate function. (If the @code{:type}
option is used without the @code{:named} option, no predicate is
@@ -4613,14 +4125,14 @@ ever generated.)
In true Common Lisp, @code{typep} is always able to recognize a
structure object even if @code{:predicate} was used. In this
-package, @code{typep} simply looks for a function called
+package, @code{cl-typep} simply looks for a function called
@code{@var{typename}-p}, so it will work for structure types
only if they used the default predicate name.
@item :include
This option implements a very limited form of C++-style inheritance.
The argument is the name of another structure type previously
-created with @code{defstruct}. The effect is to cause the new
+created with @code{cl-defstruct}. The effect is to cause the new
structure type to inherit all of the included structure's slots
(plus, of course, any new slots described by this struct's slot
descriptors). The new structure is considered a ``specialization''
@@ -4633,12 +4145,12 @@ slot descriptors for slots in the included structure, possibly with
modified default values. Borrowing an example from Steele:
@example
-(defstruct person name (age 0) sex)
- @result{} person
-(defstruct (astronaut (:include person (age 45)))
- helmet-size
- (favorite-beverage 'tang))
- @result{} astronaut
+(cl-defstruct person name (age 0) sex)
+ @result{} person
+(cl-defstruct (astronaut (:include person (age 45)))
+ helmet-size
+ (favorite-beverage 'tang))
+ @result{} astronaut
(setq joe (make-person :name "Joe"))
@result{} [cl-struct-person "Joe" 0 nil]
@@ -4665,7 +4177,7 @@ work on astronauts just like other people.
@item :print-function
In full Common Lisp, this option allows you to specify a function
-which is called to print an instance of the structure type. The
+that is called to print an instance of the structure type. The
Emacs Lisp system offers no hooks into the Lisp printer which would
allow for such a feature, so this package simply ignores
@code{:print-function}.
@@ -4694,9 +4206,9 @@ use named vectors. Therefore, @code{:named} is only useful in
conjunction with @code{:type}.
@example
-(defstruct (person1) name age sex)
-(defstruct (person2 (:type list) :named) name age sex)
-(defstruct (person3 (:type list)) name age sex)
+(cl-defstruct (person1) name age sex)
+(cl-defstruct (person2 (:type list) :named) name age sex)
+(cl-defstruct (person3 (:type list)) name age sex)
(setq p1 (make-person1))
@result{} [cl-struct-person1 nil nil nil]
@@ -4713,7 +4225,7 @@ conjunction with @code{:type}.
@result{} error: function person3-p undefined
@end example
-Since unnamed structures don't have tags, @code{defstruct} is not
+Since unnamed structures don't have tags, @code{cl-defstruct} is not
able to make a useful predicate for recognizing them. Also,
accessors like @code{person3-name} will be generated but they
will not be able to do any type checking. The @code{person3-name}
@@ -4733,16 +4245,12 @@ the type @code{:include}s another type, then @code{:initial-offset}
specifies a number of slots to be skipped between the last slot
of the included type and the first new slot.
@end table
-@end defspec
+@end defmac
-Except as noted, the @code{defstruct} facility of this package is
+Except as noted, the @code{cl-defstruct} facility of this package is
entirely compatible with that of Common Lisp.
-@iftex
-@chapno=23
-@end iftex
-
-@node Assertions, Efficiency Concerns, Structures, Top
+@node Assertions
@chapter Assertions and Errors
@noindent
@@ -4756,10 +4264,10 @@ If the optimization property @code{speed} has been set to 3, and
away the following assertions. Because assertions might be optimized
away, it is a bad idea for them to include side-effects.
-@defspec assert test-form [show-args string args@dots{}]
+@defmac cl-assert test-form [show-args string args@dots{}]
This form verifies that @var{test-form} is true (i.e., evaluates to
a non-@code{nil} value). If so, it returns @code{nil}. If the test
-is not satisfied, @code{assert} signals an error.
+is not satisfied, @code{cl-assert} signals an error.
A default error message will be supplied which includes @var{test-form}.
You can specify a different error message by including a @var{string}
@@ -4772,7 +4280,7 @@ will also include all non-constant arguments of the top-level
@var{form}. For example:
@example
-(assert (> x 10) t "x is too small: %d")
+(cl-assert (> x 10) t "x is too small: %d")
@end example
This usage of @var{show-args} is an extension to Common Lisp. In
@@ -4780,18 +4288,18 @@ true Common Lisp, the second argument gives a list of @var{places}
which can be @code{setf}'d by the user before continuing from the
error. Since Emacs Lisp does not support continuable errors, it
makes no sense to specify @var{places}.
-@end defspec
+@end defmac
-@defspec check-type form type [string]
+@defmac cl-check-type form type [string]
This form verifies that @var{form} evaluates to a value of type
-@var{type}. If so, it returns @code{nil}. If not, @code{check-type}
+@var{type}. If so, it returns @code{nil}. If not, @code{cl-check-type}
signals a @code{wrong-type-argument} error. The default error message
lists the erroneous value along with @var{type} and @var{form}
themselves. If @var{string} is specified, it is included in the
error message in place of @var{type}. For example:
@example
-(check-type x (integer 1 *) "a positive integer")
+(cl-check-type x (integer 1 *) "a positive integer")
@end example
@xref{Type Predicates}, for a description of the type specifiers
@@ -4801,57 +4309,43 @@ Note that in Common Lisp, the first argument to @code{check-type}
must be a @var{place} suitable for use by @code{setf}, because
@code{check-type} signals a continuable error that allows the
user to modify @var{place}.
-@end defspec
-
-The following error-related macro is also defined:
+@end defmac
-@defspec ignore-errors forms@dots{}
-This executes @var{forms} exactly like a @code{progn}, except that
-errors are ignored during the @var{forms}. More precisely, if
-an error is signaled then @code{ignore-errors} immediately
-aborts execution of the @var{forms} and returns @code{nil}.
-If the @var{forms} complete successfully, @code{ignore-errors}
-returns the result of the last @var{form}.
-@end defspec
-
-@node Efficiency Concerns, Common Lisp Compatibility, Assertions, Top
+@node Efficiency Concerns
@appendix Efficiency Concerns
@appendixsec Macros
@noindent
-Many of the advanced features of this package, such as @code{defun*},
-@code{loop}, and @code{setf}, are implemented as Lisp macros. In
+Many of the advanced features of this package, such as @code{cl-defun},
+@code{cl-loop}, etc., are implemented as Lisp macros. In
byte-compiled code, these complex notations will be expanded into
equivalent Lisp code which is simple and efficient. For example,
-the forms
+the form
@example
-(incf i n)
-(push x (car p))
+(cl-incf i n)
@end example
@noindent
-are expanded at compile-time to the Lisp forms
+is expanded at compile-time to the Lisp form
@example
(setq i (+ i n))
-(setcar p (cons x (car p)))
@end example
@noindent
-which are the most efficient ways of doing these respective operations
+which is the most efficient ways of doing this operation
in Lisp. Thus, there is no performance penalty for using the more
-readable @code{incf} and @code{push} forms in your compiled code.
+readable @code{cl-incf} form in your compiled code.
@emph{Interpreted} code, on the other hand, must expand these macros
every time they are executed. For this reason it is strongly
recommended that code making heavy use of macros be compiled.
-(The features labeled ``Special Form'' instead of ``Function'' in
-this manual are macros.) A loop using @code{incf} a hundred times
-will execute considerably faster if compiled, and will also
-garbage-collect less because the macro expansion will not have
-to be generated, used, and thrown away a hundred times.
+A loop using @code{cl-incf} a hundred times will execute considerably
+faster if compiled, and will also garbage-collect less because the
+macro expansion will not have to be generated, used, and thrown away a
+hundred times.
You can find out how a macro expands by using the
@code{cl-prettyexpand} function.
@@ -4860,56 +4354,56 @@ You can find out how a macro expands by using the
This function takes a single Lisp form as an argument and inserts
a nicely formatted copy of it in the current buffer (which must be
in Lisp mode so that indentation works properly). It also expands
-all Lisp macros which appear in the form. The easiest way to use
-this function is to go to the @code{*scratch*} buffer and type, say,
+all Lisp macros that appear in the form. The easiest way to use
+this function is to go to the @file{*scratch*} buffer and type, say,
@example
-(cl-prettyexpand '(loop for x below 10 collect x))
+(cl-prettyexpand '(cl-loop for x below 10 collect x))
@end example
@noindent
and type @kbd{C-x C-e} immediately after the closing parenthesis;
-the expansion
+an expansion similar to:
@example
-(block nil
- (let* ((x 0)
- (G1004 nil))
- (while (< x 10)
- (setq G1004 (cons x G1004))
- (setq x (+ x 1)))
- (nreverse G1004)))
+(cl-block nil
+ (let* ((x 0)
+ (G1004 nil))
+ (while (< x 10)
+ (setq G1004 (cons x G1004))
+ (setq x (+ x 1)))
+ (nreverse G1004)))
@end example
@noindent
-will be inserted into the buffer. (The @code{block} macro is
+will be inserted into the buffer. (The @code{cl-block} macro is
expanded differently in the interpreter and compiler, so
@code{cl-prettyexpand} just leaves it alone. The temporary
-variable @code{G1004} was created by @code{gensym}.)
+variable @code{G1004} was created by @code{cl-gensym}.)
If the optional argument @var{full} is true, then @emph{all}
-macros are expanded, including @code{block}, @code{eval-when},
+macros are expanded, including @code{cl-block}, @code{cl-eval-when},
and compiler macros. Expansion is done as if @var{form} were
-a top-level form in a file being compiled. For example,
+a top-level form in a file being compiled.
+
+@c FIXME none of these examples are still applicable.
+@ignore
+For example,
@example
-(cl-prettyexpand '(pushnew 'x list))
- @print{} (setq list (adjoin 'x list))
-(cl-prettyexpand '(pushnew 'x list) t)
+(cl-prettyexpand '(cl-pushnew 'x list))
+ @print{} (setq list (cl-adjoin 'x list))
+(cl-prettyexpand '(cl-pushnew 'x list) t)
@print{} (setq list (if (memq 'x list) list (cons 'x list)))
-(cl-prettyexpand '(caddr (member* 'a list)) t)
+(cl-prettyexpand '(caddr (cl-member 'a list)) t)
@print{} (car (cdr (cdr (memq 'a list))))
@end example
+@end ignore
-Note that @code{adjoin}, @code{caddr}, and @code{member*} all
+Note that @code{cl-adjoin}, @code{cl-caddr}, and @code{cl-member} all
have built-in compiler macros to optimize them in common cases.
@end defun
-@ifinfo
-@example
-
-@end example
-@end ifinfo
@appendixsec Error Checking
@noindent
@@ -4919,87 +4413,73 @@ where substantial gains were possible at the expense of marginal
incompatibility.
The Common Lisp standard (as embodied in Steele's book) uses the
-phrase ``it is an error if'' to indicate a situation which is not
+phrase ``it is an error if'' to indicate a situation that is not
supposed to arise in complying programs; implementations are strongly
encouraged but not required to signal an error in these situations.
This package sometimes omits such error checking in the interest of
-compactness and efficiency. For example, @code{do} variable
+compactness and efficiency. For example, @code{cl-do} variable
specifiers are supposed to be lists of one, two, or three forms;
extra forms are ignored by this package rather than signaling a
-syntax error. The @code{endp} function is simply a synonym for
+syntax error. The @code{cl-endp} function is simply a synonym for
@code{null} in this package. Functions taking keyword arguments
will accept an odd number of arguments, treating the trailing
keyword as if it were followed by the value @code{nil}.
-Argument lists (as processed by @code{defun*} and friends)
+Argument lists (as processed by @code{cl-defun} and friends)
@emph{are} checked rigorously except for the minor point just
mentioned; in particular, keyword arguments are checked for
validity, and @code{&allow-other-keys} and @code{:allow-other-keys}
are fully implemented. Keyword validity checking is slightly
time consuming (though not too bad in byte-compiled code);
you can use @code{&allow-other-keys} to omit this check. Functions
-defined in this package such as @code{find} and @code{member*}
+defined in this package such as @code{cl-find} and @code{cl-member}
do check their keyword arguments for validity.
-@ifinfo
-@example
-
-@end example
-@end ifinfo
-@appendixsec Optimizing Compiler
+@appendixsec Compiler Optimizations
@noindent
-Use of the optimizing Emacs compiler is highly recommended; many of the Common
+Changing the value of @code{byte-optimize} from the default @code{t}
+is highly discouraged; many of the Common
Lisp macros emit
-code which can be improved by optimization. In particular,
-@code{block}s (whether explicit or implicit in constructs like
-@code{defun*} and @code{loop}) carry a fair run-time penalty; the
-optimizing compiler removes @code{block}s which are not actually
-referenced by @code{return} or @code{return-from} inside the block.
+code that can be improved by optimization. In particular,
+@code{cl-block}s (whether explicit or implicit in constructs like
+@code{cl-defun} and @code{cl-loop}) carry a fair run-time penalty; the
+byte-compiler removes @code{cl-block}s that are not actually
+referenced by @code{cl-return} or @code{cl-return-from} inside the block.
-@node Common Lisp Compatibility, Old CL Compatibility, Efficiency Concerns, Top
+@node Common Lisp Compatibility
@appendix Common Lisp Compatibility
@noindent
-Following is a list of all known incompatibilities between this
+The following is a list of all known incompatibilities between this
package and Common Lisp as documented in Steele (2nd edition).
-Certain function names, such as @code{member}, @code{assoc}, and
-@code{floor}, were already taken by (incompatible) Emacs Lisp
-functions; this package appends @samp{*} to the names of its
-Common Lisp versions of these functions.
-
-The word @code{defun*} is required instead of @code{defun} in order
+The word @code{cl-defun} is required instead of @code{defun} in order
to use extended Common Lisp argument lists in a function. Likewise,
-@code{defmacro*} and @code{function*} are versions of those forms
+@code{cl-defmacro} and @code{cl-function} are versions of those forms
which understand full-featured argument lists. The @code{&whole}
-keyword does not work in @code{defmacro} argument lists (except
+keyword does not work in @code{cl-defmacro} argument lists (except
inside recursive argument lists).
The @code{equal} predicate does not distinguish
-between IEEE floating-point plus and minus zero. The @code{equalp}
+between IEEE floating-point plus and minus zero. The @code{cl-equalp}
predicate has several differences with Common Lisp; @pxref{Predicates}.
-The @code{setf} mechanism is entirely compatible, except that
-setf-methods return a list of five values rather than five
-values directly. Also, the new ``@code{setf} function'' concept
-(typified by @code{(defun (setf foo) @dots{})}) is not implemented.
-
-The @code{do-all-symbols} form is the same as @code{do-symbols}
+The @code{cl-do-all-symbols} form is the same as @code{cl-do-symbols}
with no @var{obarray} argument. In Common Lisp, this form would
iterate over all symbols in all packages. Since Emacs obarrays
are not a first-class package mechanism, there is no way for
-@code{do-all-symbols} to locate any but the default obarray.
+@code{cl-do-all-symbols} to locate any but the default obarray.
-The @code{loop} macro is complete except that @code{loop-finish}
+The @code{cl-loop} macro is complete except that @code{loop-finish}
and type specifiers are unimplemented.
The multiple-value return facility treats lists as multiple
values, since Emacs Lisp cannot support multiple return values
directly. The macros will be compatible with Common Lisp if
-@code{values} or @code{values-list} is always used to return to
-a @code{multiple-value-bind} or other multiple-value receiver;
-if @code{values} is used without @code{multiple-value-@dots{}}
+@code{cl-values} or @code{cl-values-list} is always used to return to
+a @code{cl-multiple-value-bind} or other multiple-value receiver;
+if @code{cl-values} is used without @code{cl-multiple-value-@dots{}}
or vice-versa the effect will be different from Common Lisp.
Many Common Lisp declarations are ignored, and others match
@@ -5008,119 +4488,18 @@ example, local @code{special} declarations, which are purely
advisory in Emacs Lisp, do not rigorously obey the scoping rules
set down in Steele's book.
-The variable @code{*gensym-counter*} starts out with a pseudo-random
+The variable @code{cl--gensym-counter} starts out with a pseudo-random
value rather than with zero. This is to cope with the fact that
generated symbols become interned when they are written to and
loaded back from a file.
-The @code{defstruct} facility is compatible, except that structures
+The @code{cl-defstruct} facility is compatible, except that structures
are of type @code{:type vector :named} by default rather than some
special, distinct type. Also, the @code{:type} slot option is ignored.
-The second argument of @code{check-type} is treated differently.
-
-@node Old CL Compatibility, Porting Common Lisp, Common Lisp Compatibility, Top
-@appendix Old CL Compatibility
-
-@noindent
-Following is a list of all known incompatibilities between this package
-and the older Quiroz @file{cl.el} package.
-
-This package's emulation of multiple return values in functions is
-incompatible with that of the older package. That package attempted
-to come as close as possible to true Common Lisp multiple return
-values; unfortunately, it could not be 100% reliable and so was prone
-to occasional surprises if used freely. This package uses a simpler
-method, namely replacing multiple values with lists of values, which
-is more predictable though more noticeably different from Common Lisp.
-
-The @code{defkeyword} form and @code{keywordp} function are not
-implemented in this package.
-
-The @code{member}, @code{floor}, @code{ceiling}, @code{truncate},
-@code{round}, @code{mod}, and @code{rem} functions are suffixed
-by @samp{*} in this package to avoid collision with existing
-functions in Emacs. The older package simply
-redefined these functions, overwriting the built-in meanings and
-causing serious portability problems. (Some more
-recent versions of the Quiroz package changed the names to
-@code{cl-member}, etc.; this package defines the latter names as
-aliases for @code{member*}, etc.)
-
-Certain functions in the old package which were buggy or inconsistent
-with the Common Lisp standard are incompatible with the conforming
-versions in this package. For example, @code{eql} and @code{member}
-were synonyms for @code{eq} and @code{memq} in that package, @code{setf}
-failed to preserve correct order of evaluation of its arguments, etc.
-
-Finally, unlike the older package, this package is careful to
-prefix all of its internal names with @code{cl-}. Except for a
-few functions which are explicitly defined as additional features
-(such as @code{floatp-safe} and @code{letf}), this package does not
-export any non-@samp{cl-} symbols which are not also part of Common
-Lisp.
-
-@ifinfo
-@example
+The second argument of @code{cl-check-type} is treated differently.
-@end example
-@end ifinfo
-@appendixsec The @code{cl-compat} package
-
-@noindent
-The @dfn{CL} package includes emulations of some features of the
-old @file{cl.el}, in the form of a compatibility package
-@code{cl-compat}. This file is obsolete and may be removed in future,
-so it should not be used in new code.
-
-The old package defined a number of internal routines without
-@code{cl-} prefixes or other annotations. Call to these routines
-may have crept into existing Lisp code. @code{cl-compat}
-provides emulations of the following internal routines:
-@code{pair-with-newsyms}, @code{zip-lists}, @code{unzip-lists},
-@code{reassemble-arglists}, @code{duplicate-symbols-p},
-@code{safe-idiv}.
-
-Some @code{setf} forms translated into calls to internal
-functions that user code might call directly. The functions
-@code{setnth}, @code{setnthcdr}, and @code{setelt} fall in
-this category; they are defined by @code{cl-compat}, but the
-best fix is to change to use @code{setf} properly.
-
-The @code{cl-compat} file defines the keyword functions
-@code{keywordp}, @code{keyword-of}, and @code{defkeyword},
-which are not defined by the new @dfn{CL} package because the
-use of keywords as data is discouraged.
-
-The @code{build-klist} mechanism for parsing keyword arguments
-is emulated by @code{cl-compat}; the @code{with-keyword-args}
-macro is not, however, and in any case it's best to change to
-use the more natural keyword argument processing offered by
-@code{defun*}.
-
-Multiple return values are treated differently by the two
-Common Lisp packages. The old package's method was more
-compatible with true Common Lisp, though it used heuristics
-that caused it to report spurious multiple return values in
-certain cases. The @code{cl-compat} package defines a set
-of multiple-value macros that are compatible with the old
-CL package; again, they are heuristic in nature, but they
-are guaranteed to work in any case where the old package's
-macros worked. To avoid name collision with the ``official''
-multiple-value facilities, the ones in @code{cl-compat} have
-capitalized names: @code{Values}, @code{Values-list},
-@code{Multiple-value-bind}, etc.
-
-The functions @code{cl-floor}, @code{cl-ceiling}, @code{cl-truncate},
-and @code{cl-round} are defined by @code{cl-compat} to use the
-old-style multiple-value mechanism, just as they did in the old
-package. The newer @code{floor*} and friends return their two
-results in a list rather than as multiple values. Note that
-older versions of the old package used the unadorned names
-@code{floor}, @code{ceiling}, etc.; @code{cl-compat} cannot use
-these names because they conflict with Emacs built-ins.
-
-@node Porting Common Lisp, GNU Free Documentation License, Old CL Compatibility, Top
+@node Porting Common Lisp
@appendix Porting Common Lisp
@noindent
@@ -5148,19 +4527,17 @@ this convention, calls to Lisp builtins like @code{if} and
@item
Lexical scoping. In Common Lisp, function arguments and @code{let}
-bindings apply only to references physically within their bodies
-(or within macro expansions in their bodies). Emacs Lisp, by
-contrast, uses @dfn{dynamic scoping} wherein a binding to a
-variable is visible even inside functions called from the body.
-
-Variables in Common Lisp can be made dynamically scoped by
-declaring them @code{special} or using @code{defvar}. In Emacs
-Lisp it is as if all variables were declared @code{special}.
-
-Often you can use code that was written for lexical scoping
-even in a dynamically scoped Lisp, but not always. Here is
-an example of a Common Lisp code fragment that would fail in
-Emacs Lisp:
+bindings apply only to references physically within their bodies (or
+within macro expansions in their bodies). Traditionally, Emacs Lisp
+uses @dfn{dynamic scoping} wherein a binding to a variable is visible
+even inside functions called from the body.
+@xref{Dynamic Binding,,,elisp,GNU Emacs Lisp Reference Manual}.
+Lexical binding is available since Emacs 24.1, so be sure to set
+@code{lexical-binding} to @code{t} if you need to emulate this aspect
+of Common Lisp. @xref{Lexical Binding,,,elisp,GNU Emacs Lisp Reference Manual}.
+
+Here is an example of a Common Lisp code fragment that would fail in
+Emacs Lisp if @code{lexical-binding} were set to @code{nil}:
@example
(defun map-odd-elements (func list)
@@ -5173,20 +4550,16 @@ Emacs Lisp:
@end example
@noindent
-In Common Lisp, the two functions' usages of @code{x} are completely
-independent. In Emacs Lisp, the binding to @code{x} made by
-@code{add-odd-elements} will have been hidden by the binding
-in @code{map-odd-elements} by the time the @code{(+ a x)} function
-is called.
-
-(This package avoids such problems in its own mapping functions
-by using names like @code{cl-x} instead of @code{x} internally;
-as long as you don't use the @code{cl-} prefix for your own
-variables no collision can occur.)
+With lexical binding, the two functions' usages of @code{x} are
+completely independent. With dynamic binding, the binding to @code{x}
+made by @code{add-odd-elements} will have been hidden by the binding
+in @code{map-odd-elements} by the time the @code{(+ a x)} function is
+called.
-@xref{Lexical Bindings}, for a description of the @code{lexical-let}
-form which establishes a Common Lisp-style lexical binding, and some
-examples of how it differs from Emacs' regular @code{let}.
+Internally, this package uses lexical binding so that such problems do
+not occur. @xref{Obsolete Lexical Binding}, for a description of the obsolete
+@code{lexical-let} form that emulates a Common Lisp-style lexical
+binding when dynamic binding is in use.
@item
Reader macros. Common Lisp includes a second type of macro that
@@ -5199,7 +4572,7 @@ for themselves, which the Emacs parser is incapable of reading.
@item
Other syntactic features. Common Lisp provides a number of
notations beginning with @code{#} that the Emacs Lisp parser
-won't understand. For example, @samp{#| ... |#} is an
+won't understand. For example, @samp{#| @dots{} |#} is an
alternate comment notation, and @samp{#+lucid (foo)} tells
the parser to ignore the @code{(foo)} except in Lucid Common
Lisp.
@@ -5223,10 +4596,10 @@ However, the Emacs parser does not understand colons and just
treats them as part of the symbol name. Thus, while @code{mapcar}
and @code{lisp:mapcar} may refer to the same symbol in Common
Lisp, they are totally distinct in Emacs Lisp. Common Lisp
-programs which refer to a symbol by the full name sometimes
+programs that refer to a symbol by the full name sometimes
and the short name other times will not port cleanly to Emacs.
-Emacs Lisp does have a concept of ``obarrays,'' which are
+Emacs Lisp does have a concept of ``obarrays'', which are
package-like collections of symbols, but this feature is not
strong enough to be used as a true package mechanism.
@@ -5246,10 +4619,10 @@ codes provide such features as paragraph filling, case
conversion, and even loops and conditionals.
While it would have been possible to implement most of Common
-Lisp @code{format} in this package (under the name @code{format*},
+Lisp @code{format} in this package (under the name @code{cl-format},
of course), it was not deemed worthwhile. It would have required
a huge amount of code to implement even a decent subset of
-@code{format*}, yet the functionality it would provide over
+@code{format}, yet the functionality it would provide over
Emacs Lisp's @code{format} would rarely be useful.
@item
@@ -5326,19 +4699,445 @@ note that the current Emacs Lisp compiler does not optimize tail
recursion.
@end itemize
-@node GNU Free Documentation License, Function Index, Porting Common Lisp, Top
+@node Obsolete Features
+@appendix Obsolete Features
+
+This section describes some features of the package that are obsolete
+and should not be used in new code. They are either only provided by
+the old @file{cl.el} entry point, not by the newer @file{cl-lib.el};
+or where versions with a @samp{cl-} prefix do exist they do not behave
+in exactly the same way.
+
+@menu
+* Obsolete Lexical Binding:: An approximation of lexical binding.
+* Obsolete Macros:: Obsolete macros.
+* Obsolete Setf Customization:: Obsolete ways to customize setf.
+@end menu
+
+@node Obsolete Lexical Binding
+@appendixsec Obsolete Lexical Binding
+
+The following macros are extensions to Common Lisp, where all bindings
+are lexical unless declared otherwise. These features are likewise
+obsolete since the introduction of true lexical binding in Emacs 24.1.
+
+@defmac lexical-let (bindings@dots{}) forms@dots{}
+This form is exactly like @code{let} except that the bindings it
+establishes are purely lexical.
+@end defmac
+
+@c FIXME remove this and refer to elisp manual.
+@c Maybe merge some stuff from here to there?
+@noindent
+Lexical bindings are similar to local variables in a language like C:
+Only the code physically within the body of the @code{lexical-let}
+(after macro expansion) may refer to the bound variables.
+
+@example
+(setq a 5)
+(defun foo (b) (+ a b))
+(let ((a 2)) (foo a))
+ @result{} 4
+(lexical-let ((a 2)) (foo a))
+ @result{} 7
+@end example
+
+@noindent
+In this example, a regular @code{let} binding of @code{a} actually
+makes a temporary change to the global variable @code{a}, so @code{foo}
+is able to see the binding of @code{a} to 2. But @code{lexical-let}
+actually creates a distinct local variable @code{a} for use within its
+body, without any effect on the global variable of the same name.
+
+The most important use of lexical bindings is to create @dfn{closures}.
+A closure is a function object that refers to an outside lexical
+variable (@pxref{Closures,,,elisp,GNU Emacs Lisp Reference Manual}).
+For example:
+
+@example
+(defun make-adder (n)
+ (lexical-let ((n n))
+ (function (lambda (m) (+ n m)))))
+(setq add17 (make-adder 17))
+(funcall add17 4)
+ @result{} 21
+@end example
+
+@noindent
+The call @code{(make-adder 17)} returns a function object which adds
+17 to its argument. If @code{let} had been used instead of
+@code{lexical-let}, the function object would have referred to the
+global @code{n}, which would have been bound to 17 only during the
+call to @code{make-adder} itself.
+
+@example
+(defun make-counter ()
+ (lexical-let ((n 0))
+ (cl-function (lambda (&optional (m 1)) (cl-incf n m)))))
+(setq count-1 (make-counter))
+(funcall count-1 3)
+ @result{} 3
+(funcall count-1 14)
+ @result{} 17
+(setq count-2 (make-counter))
+(funcall count-2 5)
+ @result{} 5
+(funcall count-1 2)
+ @result{} 19
+(funcall count-2)
+ @result{} 6
+@end example
+
+@noindent
+Here we see that each call to @code{make-counter} creates a distinct
+local variable @code{n}, which serves as a private counter for the
+function object that is returned.
+
+Closed-over lexical variables persist until the last reference to
+them goes away, just like all other Lisp objects. For example,
+@code{count-2} refers to a function object which refers to an
+instance of the variable @code{n}; this is the only reference
+to that variable, so after @code{(setq count-2 nil)} the garbage
+collector would be able to delete this instance of @code{n}.
+Of course, if a @code{lexical-let} does not actually create any
+closures, then the lexical variables are free as soon as the
+@code{lexical-let} returns.
+
+Many closures are used only during the extent of the bindings they
+refer to; these are known as ``downward funargs'' in Lisp parlance.
+When a closure is used in this way, regular Emacs Lisp dynamic
+bindings suffice and will be more efficient than @code{lexical-let}
+closures:
+
+@example
+(defun add-to-list (x list)
+ (mapcar (lambda (y) (+ x y))) list)
+(add-to-list 7 '(1 2 5))
+ @result{} (8 9 12)
+@end example
+
+@noindent
+Since this lambda is only used while @code{x} is still bound,
+it is not necessary to make a true closure out of it.
+
+You can use @code{defun} or @code{flet} inside a @code{lexical-let}
+to create a named closure. If several closures are created in the
+body of a single @code{lexical-let}, they all close over the same
+instance of the lexical variable.
+
+@defmac lexical-let* (bindings@dots{}) forms@dots{}
+This form is just like @code{lexical-let}, except that the bindings
+are made sequentially in the manner of @code{let*}.
+@end defmac
+
+@node Obsolete Macros
+@appendixsec Obsolete Macros
+
+The following macros are obsolete, and are replaced by versions with
+a @samp{cl-} prefix that do not behave in exactly the same way.
+Consequently, the @file{cl.el} versions are not simply aliases to the
+@file{cl-lib.el} versions.
+
+@defmac flet (bindings@dots{}) forms@dots{}
+This macro is replaced by @code{cl-flet} (@pxref{Function Bindings}),
+which behaves the same way as Common Lisp's @code{flet}.
+This @code{flet} takes the same arguments as @code{cl-flet}, but does
+not behave in precisely the same way.
+
+While @code{flet} in Common Lisp establishes a lexical function
+binding, this @code{flet} makes a dynamic binding (it dates from a
+time before Emacs had lexical binding). The result is
+that @code{flet} affects indirect calls to a function as well as calls
+directly inside the @code{flet} form itself.
+
+This will even work on Emacs primitives, although note that some calls
+to primitive functions internal to Emacs are made without going
+through the symbol's function cell, and so will not be affected by
+@code{flet}. For example,
+
+@example
+(flet ((message (&rest args) (push args saved-msgs)))
+ (do-something))
+@end example
+
+This code attempts to replace the built-in function @code{message}
+with a function that simply saves the messages in a list rather
+than displaying them. The original definition of @code{message}
+will be restored after @code{do-something} exits. This code will
+work fine on messages generated by other Lisp code, but messages
+generated directly inside Emacs will not be caught since they make
+direct C-language calls to the message routines rather than going
+through the Lisp @code{message} function.
+
+@c Bug#411.
+Note that many primitives (e.g.@: @code{+}) have special byte-compile
+handling. Attempts to redefine such functions using @code{flet} will
+fail if byte-compiled.
+@c Or cl-flet.
+@c In such cases, use @code{labels} instead.
+@end defmac
+
+@defmac labels (bindings@dots{}) forms@dots{}
+This macro is replaced by @code{cl-labels} (@pxref{Function Bindings}),
+which behaves the same way as Common Lisp's @code{labels}.
+This @code{labels} takes the same arguments as @code{cl-labels}, but
+does not behave in precisely the same way.
+
+This version of @code{labels} uses the obsolete @code{lexical-let}
+form (@pxref{Obsolete Lexical Binding}), rather than the true
+lexical binding that @code{cl-labels} uses.
+@end defmac
+
+@defmac letf (bindings@dots{}) forms@dots{}
+This macro is almost exactly the same as @code{cl-letf}, which
+replaces it (@pxref{Modify Macros}). The only difference is in
+details that relate to some deprecated usage of @code{symbol-function}
+in place forms.
+@end defmac
+
+@node Obsolete Setf Customization
+@appendixsec Obsolete Ways to Customize Setf
+
+Common Lisp defines three macros, @code{define-modify-macro},
+@code{defsetf}, and @code{define-setf-method}, that allow the
+user to extend generalized variables in various ways.
+In Emacs, these are obsolete, replaced by various features of
+@file{gv.el} in Emacs 24.3.
+@xref{Adding Generalized Variables,,,elisp,GNU Emacs Lisp Reference Manual}.
+
+
+@defmac define-modify-macro name arglist function [doc-string]
+This macro defines a ``read-modify-write'' macro similar to
+@code{cl-incf} and @code{cl-decf}. You can replace this macro
+with @code{gv-letplace}.
+
+The macro @var{name} is defined to take a @var{place} argument
+followed by additional arguments described by @var{arglist}. The call
+
+@example
+(@var{name} @var{place} @var{args}@dots{})
+@end example
+
+@noindent
+will be expanded to
+
+@example
+(cl-callf @var{func} @var{place} @var{args}@dots{})
+@end example
+
+@noindent
+which in turn is roughly equivalent to
+
+@example
+(setf @var{place} (@var{func} @var{place} @var{args}@dots{}))
+@end example
+
+For example:
+
+@example
+(define-modify-macro incf (&optional (n 1)) +)
+(define-modify-macro concatf (&rest args) concat)
+@end example
+
+Note that @code{&key} is not allowed in @var{arglist}, but
+@code{&rest} is sufficient to pass keywords on to the function.
+
+Most of the modify macros defined by Common Lisp do not exactly
+follow the pattern of @code{define-modify-macro}. For example,
+@code{push} takes its arguments in the wrong order, and @code{pop}
+is completely irregular.
+
+The above @code{incf} example could be written using
+@code{gv-letplace} as:
+@example
+(defmacro incf (place &optional n)
+ (gv-letplace (getter setter) place
+ (macroexp-let2 nil v (or n 1)
+ (funcall setter `(+ ,v ,getter)))))
+@end example
+@ignore
+(defmacro concatf (place &rest args)
+ (gv-letplace (getter setter) place
+ (macroexp-let2 nil v (mapconcat 'identity args "")
+ (funcall setter `(concat ,getter ,v)))))
+@end ignore
+@end defmac
+
+@defmac defsetf access-fn update-fn
+This is the simpler of two @code{defsetf} forms, and is
+replaced by @code{gv-define-simple-setter}.
+
+With @var{access-fn} the name of a function that accesses a place,
+this declares @var{update-fn} to be the corresponding store function.
+From now on,
+
+@example
+(setf (@var{access-fn} @var{arg1} @var{arg2} @var{arg3}) @var{value})
+@end example
+
+@noindent
+will be expanded to
+
+@example
+(@var{update-fn} @var{arg1} @var{arg2} @var{arg3} @var{value})
+@end example
+
+@noindent
+The @var{update-fn} is required to be either a true function, or
+a macro that evaluates its arguments in a function-like way. Also,
+the @var{update-fn} is expected to return @var{value} as its result.
+Otherwise, the above expansion would not obey the rules for the way
+@code{setf} is supposed to behave.
+
+As a special (non-Common-Lisp) extension, a third argument of @code{t}
+to @code{defsetf} says that the return value of @code{update-fn} is
+not suitable, so that the above @code{setf} should be expanded to
+something more like
+
+@example
+(let ((temp @var{value}))
+ (@var{update-fn} @var{arg1} @var{arg2} @var{arg3} temp)
+ temp)
+@end example
+
+Some examples are:
+
+@example
+(defsetf car setcar)
+(defsetf buffer-name rename-buffer t)
+@end example
+
+These translate directly to @code{gv-define-simple-setter}:
+
+@example
+(gv-define-simple-setter car setcar)
+(gv-define-simple-setter buffer-name rename-buffer t)
+@end example
+@end defmac
+
+@defmac defsetf access-fn arglist (store-var) forms@dots{}
+This is the second, more complex, form of @code{defsetf}.
+It can be replaced by @code{gv-define-setter}.
+
+This form of @code{defsetf} is rather like @code{defmacro} except for
+the additional @var{store-var} argument. The @var{forms} should
+return a Lisp form that stores the value of @var{store-var} into the
+generalized variable formed by a call to @var{access-fn} with
+arguments described by @var{arglist}. The @var{forms} may begin with
+a string which documents the @code{setf} method (analogous to the doc
+string that appears at the front of a function).
+
+For example, the simple form of @code{defsetf} is shorthand for
+
+@example
+(defsetf @var{access-fn} (&rest args) (store)
+ (append '(@var{update-fn}) args (list store)))
+@end example
+
+The Lisp form that is returned can access the arguments from
+@var{arglist} and @var{store-var} in an unrestricted fashion;
+macros like @code{cl-incf} that invoke this
+setf-method will insert temporary variables as needed to make
+sure the apparent order of evaluation is preserved.
+
+Another standard example:
+
+@example
+(defsetf nth (n x) (store)
+ `(setcar (nthcdr ,n ,x) ,store))
+@end example
+
+You could write this using @code{gv-define-setter} as:
+
+@example
+(gv-define-setter nth (store n x)
+ `(setcar (nthcdr ,n ,x) ,store))
+@end example
+@end defmac
+
+@defmac define-setf-method access-fn arglist forms@dots{}
+This is the most general way to create new place forms. You can
+replace this by @code{gv-define-setter} or @code{gv-define-expander}.
+
+When a @code{setf} to @var{access-fn} with arguments described by
+@var{arglist} is expanded, the @var{forms} are evaluated and must
+return a list of five items:
+
+@enumerate
+@item
+A list of @dfn{temporary variables}.
+
+@item
+A list of @dfn{value forms} corresponding to the temporary variables
+above. The temporary variables will be bound to these value forms
+as the first step of any operation on the generalized variable.
+
+@item
+A list of exactly one @dfn{store variable} (generally obtained
+from a call to @code{gensym}).
+
+@item
+A Lisp form that stores the contents of the store variable into
+the generalized variable, assuming the temporaries have been
+bound as described above.
+
+@item
+A Lisp form that accesses the contents of the generalized variable,
+assuming the temporaries have been bound.
+@end enumerate
+
+This is exactly like the Common Lisp macro of the same name,
+except that the method returns a list of five values rather
+than the five values themselves, since Emacs Lisp does not
+support Common Lisp's notion of multiple return values.
+(Note that the @code{setf} implementation provided by @file{gv.el}
+does not use this five item format. Its use here is only for
+backwards compatibility.)
+
+Once again, the @var{forms} may begin with a documentation string.
+
+A setf-method should be maximally conservative with regard to
+temporary variables. In the setf-methods generated by
+@code{defsetf}, the second return value is simply the list of
+arguments in the place form, and the first return value is a
+list of a corresponding number of temporary variables generated
+@c FIXME I don't think this is true anymore.
+by @code{cl-gensym}. Macros like @code{cl-incf} that
+use this setf-method will optimize away most temporaries that
+turn out to be unnecessary, so there is little reason for the
+setf-method itself to optimize.
+@end defmac
+
+@c Removed in Emacs 24.3, not possible to make a compatible replacement.
+@ignore
+@defun get-setf-method place &optional env
+This function returns the setf-method for @var{place}, by
+invoking the definition previously recorded by @code{defsetf}
+or @code{define-setf-method}. The result is a list of five
+values as described above. You can use this function to build
+your own @code{cl-incf}-like modify macros.
+
+The argument @var{env} specifies the ``environment'' to be
+passed on to @code{macroexpand} if @code{get-setf-method} should
+need to expand a macro in @var{place}. It should come from
+an @code{&environment} argument to the macro or setf-method
+that called @code{get-setf-method}.
+@end defun
+@end ignore
+
+
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
-@node Function Index, Variable Index, GNU Free Documentation License, Top
+@node Function Index
@unnumbered Function Index
@printindex fn
-@node Variable Index, , Function Index, Top
+@node Variable Index
@unnumbered Variable Index
@printindex vr
@bye
-
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index f515109bf76..1f9a401df90 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -9,7 +9,7 @@
@syncodeindex fn cp
@copying
-Copyright @copyright{} 2007-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 2007-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -53,7 +53,7 @@ another. An overview of D-Bus can be found at
* Asynchronous Methods:: Calling methods non-blocking.
* Receiving Method Calls:: Offering own methods.
* Signals:: Sending and receiving signals.
-* Alternative Buses:: Alternative buses.
+* Alternative Buses:: Alternative buses and environments.
* Errors and Events:: Errors and events.
* Index:: Index including concepts, functions, variables.
@@ -116,6 +116,7 @@ name could be @samp{org.gnu.Emacs.TextEditor} or
@cindex inspection
@menu
+* Version:: Determining the D-Bus version.
* Bus names:: Discovering D-Bus names.
* Introspection:: Knowing the details of D-Bus services.
* Nodes and Interfaces:: Detecting object paths and interfaces.
@@ -125,6 +126,25 @@ name could be @samp{org.gnu.Emacs.TextEditor} or
@end menu
+@node Version
+@section D-Bus version.
+
+D-Bus has evolved over the years. New features have been added with
+new D-Bus versions. There are two variables, which allow to determine
+the used D-Bus version.
+
+@defvar dbus-compiled-version
+This variable, a string, determines the version of D-Bus Emacs is
+compiled against. If it cannot be determined the value is @code{nil}.
+@end defvar
+
+@defvar dbus-runtime-version
+The other D-Bus version to be checked is the version of D-Bus Emacs
+runs with. This string can be different from @code{dbus-compiled-version}.
+It is also @code{nil}, if it cannot be determined at runtime.
+@end defvar
+
+
@node Bus names
@section Bus names.
@@ -149,7 +169,6 @@ activatable service names at all. Example:
(member "org.gnome.evince.Daemon"
(dbus-list-activatable-names :session))
@end lisp
-
@end defun
@defun dbus-list-names bus
@@ -637,6 +656,12 @@ Interfaces can have properties. These can be exposed via the
That is, properties can be retrieved and changed during lifetime of an
element.
+A generalized interface is
+@samp{org.freedesktop.DBus.Objectmanager}@footnote{See
+@uref{http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-objectmanager}},
+which returns objects, their interfaces and properties for a given
+service in just one call.
+
Annotations, on the other hand, are static values for an element.
Often, they are used to instruct generators, how to generate code from
the interface for a given language binding.
@@ -732,6 +757,61 @@ If there are no properties, @code{nil} is returned. Example:
@end lisp
@end defun
+@defun dbus-get-all-managed-objects bus service path
+This functions returns all objects at @var{bus}, @var{service},
+@var{path}, and the children of @var{path}. The result is a list of
+objects. Every object is a cons of an existing path name, and the
+list of available interface objects. An interface object is another
+cons, which car is the interface name, and the cdr is the list of
+properties as returned by @code{dbus-get-all-properties} for that path
+and interface. Example:
+
+@lisp
+(dbus-get-all-managed-objects
+ :session "org.gnome.SettingsDaemon" "/")
+
+@result{} (("/org/gnome/SettingsDaemon/MediaKeys"
+ ("org.gnome.SettingsDaemon.MediaKeys")
+ ("org.freedesktop.DBus.Peer")
+ ("org.freedesktop.DBus.Introspectable")
+ ("org.freedesktop.DBus.Properties")
+ ("org.freedesktop.DBus.ObjectManager"))
+ ("/org/gnome/SettingsDaemon/Power"
+ ("org.gnome.SettingsDaemon.Power.Keyboard")
+ ("org.gnome.SettingsDaemon.Power.Screen")
+ ("org.gnome.SettingsDaemon.Power"
+ ("Icon" . ". GThemedIcon battery-full-charged-symbolic ")
+ ("Tooltip" . "Laptop battery is charged"))
+ ("org.freedesktop.DBus.Peer")
+ ("org.freedesktop.DBus.Introspectable")
+ ("org.freedesktop.DBus.Properties")
+ ("org.freedesktop.DBus.ObjectManager"))
+ @dots{})
+@end lisp
+
+If possible, @samp{org.freedesktop.DBus.ObjectManager.GetManagedObjects}
+is used for retrieving the information. Otherwise, the information
+is collected via @samp{org.freedesktop.DBus.Introspectable.Introspect}
+and @samp{org.freedesktop.DBus.Properties.GetAll}, which is slow.
+
+An overview of all existing object paths, their interfaces and
+properties could be retrieved by the following code:
+
+@lisp
+(with-current-buffer (switch-to-buffer "*objectmanager*")
+ (erase-buffer)
+ (let (result)
+ (dolist (service (dbus-list-known-names :session) result)
+ (message "%s" service)
+ (add-to-list
+ 'result
+ (cons service
+ (dbus-get-all-managed-objects :session service "/"))))
+ (insert (message "%s" (pp result)))
+ (redisplay t)))
+@end lisp
+@end defun
+
@defun dbus-introspect-get-annotation-names bus service path interface &optional name
Return a list of all annotation names as list of strings. If
@var{name} is @code{nil}, the annotations are children of
@@ -928,6 +1008,10 @@ represented outside this range are stripped of. For example,
@code{:byte ?x} is equal to @code{:byte ?\M-x}, but it is not equal to
@code{:byte ?\C-x} or @code{:byte ?\M-\C-x}.
+Signed and unsigned integer D-Bus types expect a corresponding integer
+value. If the value does not fit Emacs's integer range, it is also
+possible to use an equivalent floating point number.
+
A D-Bus compound type is always represented as a list. The @sc{car}
of this list can be the type symbol @code{:array}, @code{:variant},
@code{:struct} or @code{:dict-entry}, which would result in a
@@ -1182,24 +1266,6 @@ emulate the @code{lshal} command on GNU/Linux systems:
@end lisp
@end defun
-@defun dbus-call-method-non-blocking bus service path interface method &optional :timeout timeout &rest args
-Call @var{method} on the D-Bus @var{bus}, but don't block the event queue.
-This is necessary for communicating to registered D-Bus methods,
-which are running in the same Emacs process.
-
-The arguments are the same as in @code{dbus-call-method}. Example:
-
-@lisp
-(dbus-call-method-non-blocking
- :system "org.freedesktop.Hal"
- "/org/freedesktop/Hal/devices/computer"
- "org.freedesktop.Hal.Device" "GetPropertyString"
- "system.kernel.machine")
-
-@result{} "i686"
-@end lisp
-@end defun
-
@node Asynchronous Methods
@chapter Calling methods non-blocking.
@@ -1229,7 +1295,7 @@ All other arguments args are passed to @var{method} as arguments.
They are converted into D-Bus types as described in @ref{Type
Conversion}.
-Unless @var{handler} is @code{nil}, the function returns a key into
+If @var{handler} is a Lisp function, the function returns a key into
the hash table @code{dbus-registered-objects-table}. The
corresponding entry in the hash table is removed, when the return
message has been arrived, and @var{handler} is called. Example:
@@ -1241,7 +1307,7 @@ message has been arrived, and @var{handler} is called. Example:
"org.freedesktop.Hal.Device" "GetPropertyString" 'message
"system.kernel.machine")
-@result{} (:system 2)
+@result{} (:serial :system 2)
@print{} i686
@end lisp
@@ -1323,19 +1389,21 @@ implementation of an interface of a well known service, like
It could be also an implementation of an own interface. In this case,
the service name must be @samp{org.gnu.Emacs}. The object path shall
-begin with @samp{/org/gnu/Emacs/@strong{Application}/}, and the
+begin with @samp{/org/gnu/Emacs/@strong{Application}}, and the
interface name shall be @code{org.gnu.Emacs.@strong{Application}}.
@samp{@strong{Application}} is the name of the application which
provides the interface.
@deffn Constant dbus-service-emacs
-The well known service name of Emacs.
+The well known service name @samp{org.gnu.Emacs} of Emacs.
@end deffn
@deffn Constant dbus-path-emacs
-The object path head "/org/gnu/Emacs" used by Emacs. All object
-paths, used by offered methods or signals, shall start with this
-string.
+The object path namespace @samp{/org/gnu/Emacs} used by Emacs.
+@end deffn
+
+@deffn Constant dbus-interface-emacs
+The interface namespace @code{org.gnu.Emacs} used by Emacs.
@end deffn
@defun dbus-register-method bus service path interface method handler dont-register-service
@@ -1400,7 +1468,7 @@ registration for @var{method}. Example:
"org.freedesktop.TextEditor" "OpenFile"
'my-dbus-method-handler)
-@result{} ((:session "org.freedesktop.TextEditor" "OpenFile")
+@result{} ((:method :session "org.freedesktop.TextEditor" "OpenFile")
("org.freedesktop.TextEditor" "/org/freedesktop/TextEditor"
my-dbus-method-handler))
@end lisp
@@ -1497,14 +1565,14 @@ clients from discovering the still incomplete interface.
:session "org.freedesktop.TextEditor" "/org/freedesktop/TextEditor"
"org.freedesktop.TextEditor" "name" :read "GNU Emacs")
-@result{} ((:session "org.freedesktop.TextEditor" "name")
+@result{} ((:property :session "org.freedesktop.TextEditor" "name")
("org.freedesktop.TextEditor" "/org/freedesktop/TextEditor"))
(dbus-register-property
:session "org.freedesktop.TextEditor" "/org/freedesktop/TextEditor"
"org.freedesktop.TextEditor" "version" :readwrite emacs-version t)
-@result{} ((:session "org.freedesktop.TextEditor" "version")
+@result{} ((:property :session "org.freedesktop.TextEditor" "version")
("org.freedesktop.TextEditor" "/org/freedesktop/TextEditor"))
@end lisp
@@ -1569,8 +1637,8 @@ to the service from D-Bus.
@chapter Sending and receiving signals.
@cindex signals
-Signals are broadcast messages. They carry input parameters, which
-are received by all objects which have registered for such a signal.
+Signals are one way messages. They carry input parameters, which are
+received by all objects which have registered for such a signal.
@defun dbus-send-signal bus service path interface signal &rest args
This function is similar to @code{dbus-call-method}. The difference
@@ -1580,10 +1648,14 @@ The function emits @var{signal} on the D-Bus @var{bus}. @var{bus} is
either the symbol @code{:system} or the symbol @code{:session}. It
doesn't matter whether another object has registered for @var{signal}.
-@var{service} is the D-Bus service name of the object the signal is
-emitted from. @var{path} is the corresponding D-Bus object path,
-@var{service} is registered at. @var{interface} is an interface
-offered by @var{service}. It must provide @var{signal}.
+Signals can be unicast or broadcast messages. For broadcast messages,
+@var{service} must be @code{nil}. Otherwise, @var{service} is the
+D-Bus service name the signal is sent to as unicast
+message.@footnote{For backward compatibility, a broadcast message is
+also emitted if @var{service} is the known or unique name Emacs is
+registered at D-Bus @var{bus}.} @var{path} is the D-Bus object path
+@var{signal} is sent from. @var{interface} is an interface available
+at @var{path}. It must provide @var{signal}.
All other arguments args are passed to @var{signal} as arguments.
They are converted into D-Bus types as described in @ref{Type
@@ -1591,43 +1663,66 @@ Conversion}. Example:
@lisp
(dbus-send-signal
- :session dbus-service-emacs dbus-path-emacs
- (concat dbus-service-emacs ".FileManager") "FileModified"
+ :session nil dbus-path-emacs
+ (concat dbus-interface-emacs ".FileManager") "FileModified"
"/home/albinus/.emacs")
@end lisp
@end defun
@defun dbus-register-signal bus service path interface signal handler &rest args
-With this function, an application registers for @var{signal} on the
-D-Bus @var{bus}.
+With this function, an application registers for a signal on the D-Bus
+@var{bus}.
@var{bus} is either the symbol @code{:system} or the symbol
@code{:session}.
@var{service} is the D-Bus service name used by the sending D-Bus
object. It can be either a known name or the unique name of the D-Bus
-object sending the signal. In case of a unique name, signals won't be
-received any longer once the object owning this unique name has
-disappeared, and a new queued object has replaced it.
-
-When @var{service} is @code{nil}, related signals from all D-Bus
-objects shall be accepted.
+object sending the signal. A known name will be mapped onto the
+unique name of the object, owning @var{service} at registration time.
+When the corresponding D-Bus object disappears, signals won't be
+received any longer.
@var{path} is the corresponding D-Bus object path, @var{service} is
-registered at. It can also be @code{nil} if the path name of incoming
-signals shall not be checked.
+registered at. @var{interface} is an interface offered by
+@var{service}. It must provide @var{signal}.
-@var{interface} is an interface offered by @var{service}. It must
-provide @var{signal}.
+@var{service}, @var{path}, @var{interface} and @var{signal} can be
+@code{nil}. This is interpreted as a wildcard for the respective
+argument.
@var{handler} is a Lisp function to be called when the @var{signal} is
received. It must accept as arguments the output parameters
@var{signal} is sending.
-All other arguments @var{args}, if specified, must be strings. They
-stand for the respective arguments of @var{signal} in their order, and
-are used for filtering as well. A @code{nil} argument might be used
-to preserve the order.
+The remaining arguments @var{args} can be keywords or keyword string
+pairs.@footnote{For backward compatibility, the arguments @var{args}
+can also be just strings. They stand for the respective arguments of
+@var{signal} in their order, and are used for filtering as well. A
+@code{nil} argument might be used to preserve the order.} The meaning
+is as follows:
+
+@itemize
+@item @code{:argN} @var{string}:@*
+@code{:pathN} @var{string}:@*
+This stands for the Nth argument of the signal. @code{:pathN}
+arguments can be used for object path wildcard matches as specified by
+D-Bus, while an @code{:argN} argument requires an exact match.
+
+@item @code{:arg-namespace} @var{string}:@*
+Register for the signals, which first argument defines the service or
+interface namespace @var{string}.
+
+@item @code{:path-namespace} @var{string}:@*
+Register for the object path namespace @var{string}. All signals sent
+from an object path, which has @var{string} as the preceding string,
+are matched. This requires @var{path} to be @code{nil}.
+
+@item @code{:eavesdrop}:@*
+Register for unicast signals which are not directed to the D-Bus
+object Emacs is registered at D-Bus BUS, if the security policy of BUS
+allows this. Otherwise, this argument is ignored.
+@end itemize
@code{dbus-register-signal} returns a Lisp object, which can be used
as argument in @code{dbus-unregister-object} for removing the
@@ -1644,7 +1739,7 @@ registration for @var{signal}. Example:
"org.freedesktop.Hal.Manager" "DeviceAdded"
'my-dbus-signal-handler)
-@result{} ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
+@result{} ((:signal :system "org.freedesktop.Hal.Manager" "DeviceAdded")
("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
my-signal-handler))
@end lisp
@@ -1656,23 +1751,36 @@ The callback function @code{my-dbus-signal-handler} must define one
single string argument therefore. Plugging an USB device to your
machine, when registered for signal @samp{DeviceAdded}, will show you
which objects the GNU/Linux @code{hal} daemon adds.
+
+Some of the match rules have been added to a later version of D-Bus.
+In order to test the availability of such features, you could register
+for a dummy signal, and check the result:
+
+@lisp
+(dbus-ignore-errors
+ (dbus-register-signal
+ :system nil nil nil nil 'ignore :path-namespace "/invalid/path"))
+
+@result{} nil
+@end lisp
@end defun
@node Alternative Buses
-@chapter Alternative buses.
+@chapter Alternative buses and environments.
@cindex bus names
@cindex UNIX domain socket
+@cindex TCP/IP socket
Until now, we have spoken about the system and the session buses,
which are the default buses to be connected to. However, it is
possible to connect to any bus, from which the address is known. This
-is a UNIX domain socket. Everywhere, where a @var{bus} is mentioned
-as argument of a function (the symbol @code{:system} or the symbol
-@code{:session}), this address can be used instead. The connection to
-this bus must be initialized first.
+is a UNIX domain or TCP/IP socket. Everywhere, where a @var{bus} is
+mentioned as argument of a function (the symbol @code{:system} or the
+symbol @code{:session}), this address can be used instead. The
+connection to this bus must be initialized first.
-@defun dbus-init-bus bus
+@defun dbus-init-bus bus &optional private
Establish the connection to D-Bus @var{bus}.
@var{bus} can be either the symbol @code{:system} or the symbol
@@ -1681,30 +1789,90 @@ corresponding bus. For the system and session buses, this function
is called when loading @file{dbus.el}, there is no need to call it
again.
-Example: You open another session bus in a terminal window on your host:
+The function returns a number, which counts the connections this Emacs
+session has established to the @var{bus} under the same unique name
+(see @code{dbus-get-unique-name}). It depends on the libraries Emacs
+is linked with, and on the environment Emacs is running. For example,
+if Emacs is linked with the gtk toolkit, and it runs in a GTK-aware
+environment like Gnome, another connection might already be
+established.
-@example
-# eval `dbus-launch --auto-syntax`
-# echo $DBUS_SESSION_BUS_ADDRESS
+When @var{private} is non-@code{nil}, a new connection is established
+instead of reusing an existing one. It results in a new unique name
+at the bus. This can be used, if it is necessary to distinguish from
+another connection used in the same Emacs process, like the one
+established by GTK+. It should be used with care for at least the
+@code{:system} and @code{:session} buses, because other Emacs Lisp
+packages might already use this connection to those buses.
-@print{} unix:abstract=/tmp/dbus-JoFtAVG92w,guid=2f320a1ebe50b7ef58e
-@end example
-
-In Emacs, you can access to this bus via its address:
+Example: You initialize a connection to the AT-SPI bus on your host:
@lisp
(setq my-bus
- "unix:abstract=/tmp/dbus-JoFtAVG92w,guid=2f320a1ebe50b7ef58e")
+ (dbus-call-method
+ :session "org.a11y.Bus" "/org/a11y/bus"
+ "org.a11y.Bus" "GetAddress"))
-@result{} "unix:abstract=/tmp/dbus-JoFtAVG92w,guid=2f320a1ebe50b7ef58e"
+@result{} "unix:abstract=/tmp/dbus-2yzWHOCdSD,guid=a490dd26625870ca1298b6e10000fd7f"
+;; If Emacs is built with gtk support, and you run in a GTK enabled
+;; environment (like a GNOME session), the initialization reuses the
+;; connection established by GTK's atk bindings.
(dbus-init-bus my-bus)
-@result{} nil
+@result{} 2
(dbus-get-unique-name my-bus)
-@result{} ":1.0"
+@result{} ":1.19"
+
+;; Open a new connection to the same bus. This obsoletes the
+;; previous one.
+(dbus-init-bus my-bus 'private)
+
+@result{} 1
+
+(dbus-get-unique-name my-bus)
+
+@result{} ":1.20"
+@end lisp
+
+D-Bus addresses can specify different transport. A possible address
+could be based on TCP/IP sockets, see next example. However, it
+depends on the bus daemon configuration, which transport is supported.
+@end defun
+
+@defun dbus-setenv bus variable value
+Set the value of the @var{bus} environment variable @var{variable} to
+@var{value}.
+
+@var{bus} is either a Lisp symbol, @code{:system} or @code{:session},
+or a string denoting the bus address. Both @var{variable} and
+@var{value} should be strings.
+
+Normally, services inherit the environment of the bus daemon. This
+function adds to or modifies that environment when activating services.
+
+Some bus instances, such as @code{:system}, may disable setting the
+environment. In such cases, or if this feature is not available in
+older D-Bus versions, a @code{dbus-error} error is raised.
+
+As an example, it might be desirable to start X11 enabled services on
+a remote host's bus on the same X11 server the local Emacs is
+running. This could be achieved by
+
+@lisp
+(setq my-bus "unix:host=example.gnu.org,port=4711")
+
+@result{} "unix:host=example.gnu.org,port=4711"
+
+(dbus-init-bus my-bus)
+
+@result{} 1
+
+(dbus-setenv my-bus "DISPLAY" (getenv "DISPLAY"))
+
+@result{} nil
@end lisp
@end defun
@@ -1722,8 +1890,8 @@ If this variable is non-@code{nil}, D-Bus specific debug messages are raised.
@end defvar
Input parameters of @code{dbus-call-method},
-@code{dbus-call-method-non-blocking},
-@code{dbus-call-method-asynchronously}, and
+@code{dbus-call-method-asynchronously}, @code{dbus-send-signal},
+@code{dbus-register-method}, @code{dbus-register-property} and
@code{dbus-register-signal} are checked for correct D-Bus types. If
there is a type mismatch, the Lisp error @code{wrong-type-argument}
@code{D-Bus ARG} is raised.
@@ -1813,7 +1981,7 @@ usually not desired. D-Bus errors in events can be made visible by
setting the variable @code{dbus-debug} to @code{t}. They can also be
handled by a hook function.
-@defvar dbus-event-error-hooks
+@defvar dbus-event-error-functions
This hook variable keeps a list of functions, which are called when a
D-Bus error happens in the event handler. Every function must accept
two arguments, the event and the error variable caught in
@@ -1824,12 +1992,12 @@ Example:
@lisp
(defun my-dbus-event-error-handler (event error)
- (when (string-equal (concat dbus-service-emacs ".FileManager")
+ (when (string-equal (concat dbus-interface-emacs ".FileManager")
(dbus-event-interface-name event))
(message "my-dbus-event-error-handler: %S %S" event error)
(signal 'file-error (cdr error))))
-(add-hook 'dbus-event-error-hooks 'my-dbus-event-error-handler)
+(add-hook 'dbus-event-error-functions 'my-dbus-event-error-handler)
@end lisp
@end defvar
diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi
index a026c63e25b..cd1ad79eab5 100644
--- a/doc/misc/dired-x.texi
+++ b/doc/misc/dired-x.texi
@@ -19,7 +19,7 @@
@comment %**end of header (This is for running Texinfo on a region.)
@copying
-Copyright @copyright{} 1994-1995, 1999, 2001-2011
+Copyright @copyright{} 1994-1995, 1999, 2001-2012
Free Software Foundation, Inc.
@quotation
@@ -111,7 +111,7 @@ For @file{dired-x.el} as distributed with GNU Emacs @value{EMACSVER}.
@end ifnottex
-@node Introduction, Installation, Top, Top
+@node Introduction
@chapter Introduction
This documents some @emph{extra} features for GNU Emacs's Dired Mode
@@ -125,7 +125,7 @@ original @file{dired-x.el}).
@end menu
@end ifnottex
-@node Features, Technical Details, , Introduction
+@node Features
@section Features
@cindex Features
@@ -157,7 +157,7 @@ also binds @kbd{C-x C-f} and @kbd{C-x 4 C-f} to
@code{dired-x-find-file} and @code{dired-x-find-file-other-window},
respectively (@pxref{Find File At Point}).
-@node Technical Details, , Features, Introduction
+@node Technical Details
@section Technical Details
@cindex Modified functions
@cindex @file{dired-aux.el}
@@ -173,7 +173,7 @@ Dired}), if it is active. @code{dired-find-buffer-nocreate} and
@code{dired-guess-shell-command} (@pxref{Shell Command Guessing}) to
offer a smarter default command.
-@node Installation, Omitting Files in Dired, Introduction, Top
+@node Installation
@chapter Installation
@noindent
@@ -211,7 +211,7 @@ when you first type @kbd{C-x d}).
@end menu
@end ifnottex
-@node Optional Installation Dired Jump, Optional Installation File At Point, , Installation
+@node Optional Installation Dired Jump
@section Optional Installation Dired Jump
@cindex Autoloading @code{dired-jump} and @code{dired-jump-other-window}
@@ -232,7 +232,7 @@ for these functions. In your @file{.emacs} file put
(define-key global-map "\C-x4\C-j" 'dired-jump-other-window)
@end example
-@node Optional Installation File At Point, , Optional Installation Dired Jump, Installation
+@node Optional Installation File At Point
@section Optional Installation File At Point
@cindex Binding @code{dired-x-find-file}
@@ -251,7 +251,7 @@ or call @code{dired-x-bind-find-file} after changing the value.
))
@end example
-@node Omitting Files in Dired, Local Variables, Installation, Top
+@node Omitting Files in Dired
@chapter Omitting Files in Dired
@cindex Omitting Files in Dired
@@ -307,7 +307,7 @@ inside @code{dired-load-hook} (@pxref{Installation}) and then evaluate
@end menu
@end ifnottex
-@node Omitting Variables, Omitting Examples, , Omitting Files in Dired
+@node Omitting Variables
@section Omitting Variables
@cindex Customizing file omitting
@@ -403,7 +403,7 @@ will show up again after reverting the buffer, unlike the others.
@end table
-@node Omitting Examples, Omitting Technical, Omitting Variables, Omitting Files in Dired
+@node Omitting Examples
@section Examples of Omitting Various File Types
@itemize @bullet
@@ -429,7 +429,7 @@ in the @code{dired-load-hook} (@pxref{Installation}). This assumes
@cindex Tib files, how to omit them in Dired
@cindex Omitting tib files in Dired
If you use @code{tib}, the bibliography program for use with @TeX{} and
-La@TeX{}, and you
+@LaTeX{}, and you
want to omit the @file{INDEX} and the @file{*-t.tex} files, then put
@example
@@ -458,7 +458,7 @@ better way to achieve this particular goal is simply to omit @samp{-a} from
@end itemize
-@node Omitting Technical, , Omitting Examples, Omitting Files in Dired
+@node Omitting Technical
@section Some Technical Details of Omitting
Loading @file{dired-x.el} will install Dired Omit by putting
@@ -466,7 +466,7 @@ Loading @file{dired-x.el} will install Dired Omit by putting
call @code{dired-extra-startup}, which in turn calls @code{dired-omit-startup}
in your @code{dired-mode-hook}.
-@node Local Variables, Shell Command Guessing, Omitting Files in Dired, Top
+@node Local Variables
@chapter Local Variables for Dired Directories
@cindex Local Variables for Dired Directories
@@ -537,7 +537,7 @@ the Dired Local Variables are hacked. It takes the same values as that
variable. A value of @code{nil} means to ignore any Dired Local Variables.
@end table
-@node Shell Command Guessing, Virtual Dired, Local Variables, Top
+@node Shell Command Guessing
@chapter Shell Command Guessing
@cindex Guessing shell commands for files.
@@ -643,7 +643,7 @@ smaller than the @file{.gz} file.
History list for commands that read dired-shell commands.
@end table
-@node Virtual Dired, Advanced Mark Commands, Shell Command Guessing, Top
+@node Virtual Dired
@chapter Virtual Dired
@cindex Virtual Dired
@@ -684,7 +684,7 @@ virtual Dired mode from the @code{auto-mode-alist}. To edit all
The regexp is a bit more complicated than usual to exclude @file{.dired}
local-variable files.
-@node Advanced Mark Commands, Multiple Dired Directories, Virtual Dired, Top
+@node Advanced Mark Commands
@chapter Advanced Mark Commands
@table @kbd
@@ -730,7 +730,7 @@ Flag all files with a certain extension for deletion. A @samp{.} is
@end menu
@end ifnottex
-@node Advanced Cleaning Functions, Advanced Cleaning Variables, , Advanced Mark Commands
+@node Advanced Cleaning Functions
@section Advanced Cleaning Functions
@table @code
@@ -741,7 +741,7 @@ variable @code{dired-patch-unclean-extensions}.
@item dired-clean-tex
@findex dired-clean-tex
-Flag dispensable files created by @TeX{}, La@TeX{}, and @samp{texinfo} for
+Flag dispensable files created by @TeX{}, @LaTeX{}, and @samp{texinfo} for
deletion. See the following variables (@pxref{Advanced Cleaning Variables}):
@itemize @bullet
@@ -757,11 +757,11 @@ deletion. See the following variables (@pxref{Advanced Cleaning Variables}):
@item dired-very-clean-tex
@findex dired-very-clean-tex
-Flag dispensable files created by @TeX{}, La@TeX{}, @samp{texinfo},
+Flag dispensable files created by @TeX{}, @LaTeX{}, @samp{texinfo},
and @file{*.dvi} files for deletion.
@end table
-@node Advanced Cleaning Variables, Special Marking Function, Advanced Cleaning Functions, Advanced Mark Commands
+@node Advanced Cleaning Variables
@section Advanced Cleaning Variables
@noindent Variables used by the above cleaning commands (and in the default value for
@@ -791,7 +791,7 @@ List of extensions of dispensable files created by @samp{texinfo}.
@vindex dired-latex-unclean-extensions
Default: @code{(".idx" ".lof" ".lot" ".glo")}
-List of extensions of dispensable files created by La@TeX{}.
+List of extensions of dispensable files created by @LaTeX{}.
@item dired-bibtex-unclean-extensions
@vindex dired-bibtex-unclean-extensions
@@ -800,7 +800,7 @@ Default: @code{(".blg" ".bbl")}
List of extensions of dispensable files created by Bib@TeX{}.
@end table
-@node Special Marking Function, , Advanced Cleaning Variables, Advanced Mark Commands
+@node Special Marking Function
@section Special Marking Function
@table @kbd
@@ -856,7 +856,7 @@ to mark all @file{.el} files without a corresponding @file{.elc} file.
@end table
-@node Multiple Dired Directories, Find File At Point, Advanced Mark Commands, Top
+@node Multiple Dired Directories
@chapter Multiple Dired Directories and Non-Dired Commands
@cindex Multiple Dired directories
@@ -876,8 +876,8 @@ The command @code{dired-smart-shell-command}, bound to @kbd{M-!} in
Dired buffers, is like @code{shell-command}, but it runs with
@code{default-directory} bound to the current Dired directory.
-@node Find File At Point, Miscellaneous Commands, Multiple Dired Directories, Top
-@section Find File At Point
+@node Find File At Point
+@chapter Find File At Point
@cindex Visiting a file mentioned in a buffer
@cindex Finding a file at point
@@ -952,7 +952,7 @@ that uses the value of @code{dired-x-hands-off-my-keys} to determine if
@code{find-file-other-window}. See @xref{Optional Installation File At Point}.
@end table
-@node Miscellaneous Commands, Bugs, Find File At Point, Top
+@node Miscellaneous Commands
@chapter Miscellaneous Commands
Miscellaneous features not fitting anywhere else:
@@ -1082,7 +1082,7 @@ Bound to @kbd{%Y}. Relative symlink all marked files containing
info.
@end table
-@node Bugs, GNU Free Documentation License, Miscellaneous Commands, Top
+@node Bugs
@chapter Bugs
@cindex Bugs
@@ -1090,23 +1090,23 @@ info.
If you encounter a bug in this package, or wish to suggest an
enhancement, then please use @kbd{M-x report-emacs-bug} to report it.
-@node GNU Free Documentation License, Concept Index, Bugs, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
-@node Concept Index, Command Index, GNU Free Documentation License, Top
+@node Concept Index
@unnumbered Concept Index
@printindex cp
-@node Command Index, Key Index, Concept Index, Top
+@node Command Index
@unnumbered Function Index
@printindex fn
-@node Key Index, Variable Index, Command Index, Top
+@node Key Index
@unnumbered Key Index
@printindex ky
-@node Variable Index, , Key Index, Top
+@node Variable Index
@unnumbered Variable Index
@printindex vr
diff --git a/doc/misc/doclicense.texi b/doc/misc/doclicense.texi
index a511ffcd5a8..cb71f05a175 100644
--- a/doc/misc/doclicense.texi
+++ b/doc/misc/doclicense.texi
@@ -1,4 +1,3 @@
-@c -*-texinfo-*-
@c The GNU Free Documentation License.
@center Version 1.3, 3 November 2008
@@ -6,7 +5,7 @@
@c hence no sectioning command or @node.
@display
-Copyright @copyright{} 2000, 2001, 2002, 2007, 2008, 2009 Free Software Foundation, Inc.
+Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
@uref{http://fsf.org/}
Everyone is permitted to copy and distribute verbatim copies
@@ -93,16 +92,16 @@ An image format is not Transparent if used for any substantial amount
of text. A copy that is not ``Transparent'' is called ``Opaque''.
Examples of suitable formats for Transparent copies include plain
-@sc{ascii} without markup, Texinfo input format, La@TeX{} input
-format, @acronym{SGML} or @acronym{XML} using a publicly available
-@acronym{DTD}, and standard-conforming simple @acronym{HTML},
-PostScript or @acronym{PDF} designed for human modification. Examples
-of transparent image formats include @acronym{PNG}, @acronym{XCF} and
-@acronym{JPG}. Opaque formats include proprietary formats that can be
-read and edited only by proprietary word processors, @acronym{SGML} or
-@acronym{XML} for which the @acronym{DTD} and/or processing tools are
-not generally available, and the machine-generated @acronym{HTML},
-PostScript or @acronym{PDF} produced by some word processors for
+ASCII without markup, Texinfo input format, La@TeX{} input
+format, SGML or XML using a publicly available
+DTD, and standard-conforming simple HTML,
+PostScript or PDF designed for human modification. Examples
+of transparent image formats include PNG, XCF and
+JPG. Opaque formats include proprietary formats that can be
+read and edited only by proprietary word processors, SGML or
+XML for which the DTD and/or processing tools are
+not generally available, and the machine-generated HTML,
+PostScript or PDF produced by some word processors for
output purposes only.
The ``Title Page'' means, for a printed book, the title page itself,
@@ -482,7 +481,7 @@ license notices just after the title page:
@end smallexample
If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts,
-replace the ``with@dots{}Texts.'' line with this:
+replace the ``with@dots{}Texts.''@: line with this:
@smallexample
@group
@@ -501,7 +500,6 @@ recommend releasing these examples in parallel under your choice of
free software license, such as the GNU General Public License,
to permit their use in free software.
-
@c Local Variables:
@c ispell-local-pdict: "ispell-dict"
@c End:
diff --git a/doc/misc/ebrowse.texi b/doc/misc/ebrowse.texi
index a2a4017eb64..6db27a38808 100644
--- a/doc/misc/ebrowse.texi
+++ b/doc/misc/ebrowse.texi
@@ -10,7 +10,7 @@
@copying
This file documents Ebrowse, a C++ class browser for GNU Emacs.
-Copyright @copyright{} 2000-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 2000-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -149,7 +149,7 @@ importantly you can find or view member declarations and definitions
with a keystroke. @xref{Member Buffers}.
These two buffer types and the commands they provide support the
-navigational use of the browser. The second form resembles Emacs' Tags
+navigational use of the browser. The second form resembles Emacs's Tags
package for C and other procedural languages. Ebrowse's commands of
this type are not confined to special buffers; they are most often used
while you are editing your source code.
diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi
index 2b2a6a21b7f..1299f2ff062 100644
--- a/doc/misc/ede.texi
+++ b/doc/misc/ede.texi
@@ -5,7 +5,7 @@
@copying
This file describes EDE, the Emacs Development Environment.
-Copyright @copyright{} 1998-2001, 2004-2005, 2008-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1998-2001, 2004-2005, 2008-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -82,11 +82,11 @@ learn and adopt GNU ways of doing things.
@menu
* EDE Project Concepts:: @ede{} Project Concepts
* EDE Mode:: Turning on @ede{} mode.
+* Quick Start:: Quick start to building a project.
* Creating a project:: Creating a project.
* Modifying your project:: Adding and removing files and targets.
* Building and Debugging:: Initiating a build or debug session.
* Miscellaneous commands:: Other project related commands.
-* Simple projects:: Projects not managed by @ede{}.
* Extending EDE:: Programming and extending @ede{}.
@end menu
@@ -125,7 +125,7 @@ of search to files in a single target, or to discover the location of
documentation or interface files. @ede{} can provide this
information.
-@node EDE Mode, Creating a project, EDE Project Concepts, top
+@node EDE Mode, Quick Start, EDE Project Concepts, top
@chapter @ede{} Mode
@ede{} is implemented as a minor mode, which augments other modes such
@@ -142,7 +142,303 @@ bar. This menu provides several menu items for high-level @ede{}
commands. These menu items, and their corresponding keybindings, are
independent of the type of project you are actually working on.
-@node Creating a project, Modifying your project, EDE Mode, top
+@node Quick Start, Creating a project, EDE Mode, top
+@chapter Quick Start
+
+Once you have @ede{} enabled, you can create a project. This chapter
+provides an example C++ project that will create Automake files for
+compilation.
+
+@section Step 1: Create root directory
+
+First, lets create a directory for our project. For this example,
+we'll start with something in @file{/tmp}.
+
+@example
+C-x C-f /tmp/myproject/README RET
+M-x make-directory RET RET
+@end example
+
+Now put some plain text in your README file to start.
+
+Now, lets create the project:
+
+@example
+M-x ede-new RET Automake RET myproject RET
+@end example
+
+
+Nothing visible happened, but if you use @code{dired} to look at the
+directory, you should see this:
+
+@example
+ /tmp/myproject:
+ total used in directory 32 available 166643476
+ drwxr-xr-x 2 zappo users 4096 2012-02-23 22:10 .
+ drwxrwxrwt 73 root root 20480 2012-02-23 22:10 ..
+ -rw-r--r-- 1 zappo users 195 2012-02-23 22:10 Project.ede
+ -rw-r--r-- 1 zappo users 10 2012-02-23 22:09 README
+@end example
+
+@section Step 2: Create Subdirectories and Files
+
+We'll make a more complex project, so use dired to create some more
+directories using the @kbd{+} key, and typing in new directories:
+
+@example
++ include RET
++ src RET
+@end example
+
+Now I'll short-cut in this tutorial. Create the following files:
+
+@file{include/myproj.hh}
+@example
+/** myproj.hh ---
+ */
+
+#ifndef myproj_hh
+#define myproj_hh 1
+
+#define IMPORTANT_MACRO 1
+
+int my_lib_function();
+
+#endif // myproj_hh
+@end example
+
+
+@file{src/main.cpp}
+@example
+/** main.cpp ---
+ */
+
+#include <iostream>
+#include "myproj.hh"
+
+int main() @{
+
+@}
+
+#ifdef IMPORTANT_MACRO
+int my_fcn() @{
+
+@}
+#endif
+@end example
+
+@file{src/mylib.cpp}
+@example
+/** mylib.cpp ---
+ *
+ * Shared Library to build
+ */
+
+int my_lib_function() @{
+
+@}
+@end example
+
+@section Step 3: Create subprojects
+
+@ede{} needs subdirectories to also have projects in them. You can
+now create those projects.
+
+With @file{main.cpp} as your current buffer, type:
+
+@example
+M-x ede-new RET Automake RET src RET
+@end example
+
+and in @file{myproj.hh} as your current buffer, type:
+
+@example
+M-x ede-new RET Automake RET include RET
+@end example
+
+These steps effectively only create the Project.ede file in which you
+will start adding targets.
+
+@section Step 4: Create targets
+
+In order to build a program, you must have targets in your @ede{}
+Projects. You can create targets either from a buffer, or from a
+@code{dired} directory buffer.
+
+Note: If for some reason a directory list buffer, or file does not have the
+@samp{Project} menu item, or if @ede{} keybindings don't work, just
+use @kbd{M-x revert-buffer RET} to force a refresh. Sometimes
+creating a new project doesn't restart buffers correctly.
+
+Lets start with the header file. In @file{include/myproj.hh}, you
+could use the menu, but we will now start using the @ede{} command prefix
+which is @kbd{C-c .}.
+
+@example
+C-c . t includes RET miscellaneous RET y
+@end example
+
+
+This creates a misc target for holding your includes, and then adds
+myproj.hh to the target. Automake (the tool) has better ways to do
+this, but for this project, it is sufficient.
+
+Next, visit the @file{src} directory using dired. There should be a
+@samp{Project} menu. You can create a new target with
+
+@example
+. t myprogram RET program RET
+@end example
+
+Note that @kbd{. t} is a command for creating a target. This command
+is also in the menu. This will create a target that will build a
+program. If you want, visit @file{Project.ede} to see the structure
+built so far.
+
+Next, place the cursor on @file{main.cpp}, and use @kbd{. a} to add
+that file to your target.
+
+@example
+. a myprogram RET
+@end example
+
+Note that these prompts often have completion, so you can just press
+@kbd{TAB} to complete the name @file{myprogram}.
+
+If you had many files to add to the same target, you could mark them
+all in your dired buffer, and add them all at the same time.
+
+Next, do the same for the library by placing the cursor on @file{mylib.cpp}.
+
+@example
+. t mylib RET sharedobject RET
+. a mylib RET
+@end example
+
+@section Step 5: Compile, and fail
+
+Next, we'll try to compile the project, but we aren't done yet, so it
+won't work right away.
+
+Visit @file{/tmp/myproject/Project.ede}. We're starting here because
+we don't have any program files in this directory yet. Now we can use
+the compile command:
+
+@example
+C-c . C
+@end example
+
+Because this is the very first time, it will create a bunch of files
+for you that are required by Automake. It will then use automake to
+build the support infrastructure it needs. This step is skipped if
+you choose just a @file{Makefile} build system.
+
+After the Automake init, it runs compile. You will immediately
+discover the error in main.cpp can't find @file{myproj.hh}. We need
+to go fix this.
+
+@section Step 6: Customizing your project
+
+To fix the failed compile, we need to add
+@file{/tmp/myproject/include} to the include path.
+
+Visit @file{main.cpp}.
+
+@example
+M-x customize-project RET
+@end example
+
+Select the @samp{[Settings]} subgroup of options. Under
+@samp{Variable :} click @samp{[INS]}. At this point, you need to be
+somewhat savvy with Automake. Add a variable named @samp{CPPFLAGS},
+and set the value to @samp{../include}.
+
+You should see something like this:
+
+@example
+Variables :
+[INS] [DEL] Cons-cell:
+ Name: AM_CPPFLAGS
+ Value: -I../include
+[INS]
+Variables to set in this Makefile.
+@end example
+
+Click @samp{[Apply]}. Feel free to visit @file{Project.ede} to see
+how it changed the config file.
+
+Compile the whole project again with @kbd{C-c . C} from
+@file{main.cpp}. It should now compile.
+
+@section Step 7: Shared library dependency
+
+Note: Supporting shared libraries for Automake in this way is easy,
+but doing so from a project of type Makefile is a bit tricky. If you
+are creating shared libraries too, stick to Automake projects.
+
+Next, lets add a dependency from @file{main.cpp} on our shared
+library. To do that, update main like this:
+
+@example
+int main() @{
+
+ my_lib_function();
+
+@}
+@end example
+
+Now compile with:
+
+@example
+C-c . c
+@end example
+
+where the lower case @kbd{c} compiles just that target. You should
+see an error.
+
+This time, we need to add a dependency from @file{main.cpp} on our shared
+library. To do that, we need to customize our target instead of the
+project. This is because variables such as the include path are
+treated globally, whereas dependencies for a target are target specific.
+
+@example
+M-x customize-target RET
+@end example
+
+On the first page, you will see an Ldlibs-local section. Add mylib to
+it by first clicking @samp{[INS]}, and they adding the library. It
+should look like this:
+
+@example
+Ldlibs-Local :
+[INS] [DEL] Local Library: libmylib.la
+[INS]
+Libraries that are part of this project. [Hide Rest]
+The full path to these libraries should be specified, such as:
+../lib/libMylib.la or ../ar/myArchive.a
+@end example
+
+You will also see other variables for library related flags and system
+libraries if you need them. Click @samp{[Accept]}, and from
+@file{main.cpp}, again compile the whole project to force all
+dependent elements to compile:
+
+@example
+C-c . C
+@end example
+
+@section Step 8: Run your program
+
+You can run your program directly from @ede{}.
+
+@example
+C-c . R RET RET
+@end example
+
+If your program takes command line arguments, you can type them in
+when it offers the command line you want to use to run your program.
+
+@node Creating a project, Modifying your project, Quick Start, top
@chapter Creating a project
To create a new project, first visit a file that you want to include
@@ -212,6 +508,7 @@ detailed information about exactly what these features do.
* Add/Remove target::
* Add/Remove files::
* Customize Features::
+* Project Local Variables::
* EDE Project Features::
@end menu
@@ -252,7 +549,7 @@ not wish to add the file to any target, you can choose @samp{none}.
You can customize this behavior with the variable
@command{ede-auto-add-method}.
-@node Customize Features, EDE Project Features, Add/Remove files, Modifying your project
+@node Customize Features, Project Local Variables, Add/Remove files, Modifying your project
@section Customize Features
A project, and its targets, are objects using the @samp{EIEIO} object
@@ -272,7 +569,55 @@ object, you can edit the file by typing @kbd{C-c . e}
(@code{ede-edit-file-target}). You should ``rescan'' the project
afterwards (@pxref{Miscellaneous commands}).
-@node EDE Project Features, , Customize Features, Modifying your project
+@node Project Local Variables, EDE Project Features, Customize Features, Modifying your project
+@section Project Local Variables
+
+EDE projects can store and manager project local variables. The
+variables are stored in the project, and will be restored when a
+project reloads.
+
+Projects which are not stored on disk WILL NOT restore your project
+local variables later.
+
+You can use @ref{Customize Features} to of the project to edit the
+project local variables. They are under the 'Settings' group as
+``Project Local Variables''.
+
+You can also use @kbd{M-x ede-set} to set a new variable local in the
+mini buffer.
+
+In multi-level projects such as Automake and Make generating projects,
+project local variables are installed from both the TOP most project,
+and the local directory's project. In that way, you can have some
+variables across your whole project, and some specific to a
+subdirectory.
+
+You can use project local variables to set any Emacs variable so that
+buffers belonging to different projects can have different settings.
+
+NOTE: When you use project-local variables with @ref{ede-cpp-root},
+the format is an association list. For example:
+
+@example
+(ede-cpp-root-project "SOMENAME"
+ :file "/dir/to/some/file"
+ :local-variables
+ '((grep-command . "grep -nHi -e ")
+ (compile-command . "make -f MyCustomMakefile all")))
+@end example
+
+The same is true when you use project-local variables with
+@ref{ede-java-root}. For example:
+
+@example
+(ede-java-root-project "SOMENAME"
+ :file "/dir/to/some/file"
+ :local-variables
+ '((grep-command . "grep -nHi -e ")
+ (compile-command . "ant")))
+@end example
+
+@node EDE Project Features, , Project Local Variables, Modifying your project
@section EDE Project Features
This section details user facing features of an @ede{} @samp{Make}
@@ -351,7 +696,7 @@ Build a distribution file for your project.
These commands are also available from the @samp{Development} menu.
-@node Miscellaneous commands, Simple projects, Building and Debugging, top
+@node Miscellaneous commands, Extending EDE, Building and Debugging, top
@chapter Miscellaneous commands
If you opt to go in and edit @ede{} project files directly---for
@@ -384,7 +729,69 @@ hierarchical tree, grouped according to target.
To activate the speedbar in this mode, type @kbd{C-c . s}
(@code{ede-speedbar}).
-@node Simple projects, Extending EDE, Miscellaneous commands, top
+@menu
+* Make and Automake projects:: Project types of @samp{ede-project}
+* Automake direct projects:: Project interface on hand-written automake files.
+* Android projects:: Projects for Android development
+* Arduino projects:: Projects for Arduino sketches
+* Simple projects:: Projects @ede{} doesn't manage.
+@end menu
+
+@node Make and Automake projects
+@section Make and Automake projects
+
+A project of @samp{ede-project} type creates a file called
+@file{Project.ede} in every project directory. This is used to track
+your configuration information. If you configure this project to be
+in @samp{Makefile} mode, then this project will autogenerate a
+@file{Makefile}. If you configure it in @samp{Automake} mode a
+@file{Makefile.am} file will be created. The automake bootstrapping
+routines will also import and maintain a configure.am script and a
+host of other files required by Automake.
+
+@node Automake direct projects
+@section Automake direct projects
+
+The project type that reads @file{Makefile.am} directly is derived
+from the sources of the original @file{project-am.el} mode that was
+distributed independently. This mode eventually became @ede{}. The
+@samp{project-am} project will read existing automake files, but will
+not generate them automatically, or create new ones. As such, it is
+useful as a browsing tool, or as maintenance in managing file lists.
+
+@node Android projects
+@section Android projects
+
+An Android project of type @samp{ede-android-project} will detect and
+support development of Android apps. Android projects use an
+@file{AndroidManifest.xml} file. Always load your Manifest first in a
+running Emacs to make sure the project is identified correctly.
+
+Android projects can be created with @code{ede-new} but depend on a
+correctly configured Android SDK via @cedet{} support.
+
+@defun cedet-android-sdk-root
+@anchor{cedet-android-sdk-root}
+The root to the android @var{SDK}.
+@end defun
+
+Android projects support different configurations including compile,
+and install, which will upload a program to your Android device. It
+also supports several debugging tools via @file{android.el}.
+
+@node Arduino projects
+@section Arduino projects
+
+An arduino project of type @samp{ede-arduino-project} will read your
+@file{~/.arduino/preferences.txt} file, and identify your sketches.
+You will still need the Arduino IDE to set up your preferences and
+locate your arduino. After quitting the IDE, Emacs will be able to
+find your sketches, compile them, and upload them to your arduino.
+
+If you have the @file{arduino} command on your path, @ede{} will be
+able to find your SDK and compile your programs.
+
+@node Simple projects
@section Simple Projects
There is a wide array of Simple projects. The root for simple
@@ -401,14 +808,14 @@ It can be configured with minimal lisp knowledge to do header file
lookup for @semantic{}, improving code completion performance.
@menu
-* ede-cpp-root:: This project marks the root of a C/C++ code project.
-* ede-simple subclassing:: Create your own simple project.
-* ede-emacs:: A project for working with Emacs.
-* ede-linux:: A project for working with Linux kernels.
-* Custom Locate:: Customizing how to locate files in a simple project
+* ede-cpp-root:: This project marks the root of a C/C++ code project.
+* ede-java-root:: This project marks the root of a Java project.
+* ede-emacs:: A project for working with Emacs.
+* ede-linux:: A project for working with Linux kernels.
+* Custom Locate:: Customizing how to locate files in a simple project
@end menu
-@node ede-cpp-root
+@node ede-cpp-root, ede-java-root, Simple projects, Simple projects
@subsection ede-cpp-root
The @code{ede-cpp-root} project type allows you to create a single
@@ -492,6 +899,11 @@ The name of the file to find.
The directory root for this cpp-root project.
@end table
+When creating a project with @code{ede-cpp-root}, you can get
+additional configurations via @ref{Project Local Variables}. Be aware
+that the format for project local variables is an association list.
+You cannot use @kbd{M-x ede-set} and have your project local variables
+persist between sessions.
If the cpp-root project style is right for you, but you want a dynamic
loader, instead of hard-coding path name values in your @file{.emacs}, you
@@ -540,14 +952,90 @@ of project.
@xref{ede-cpp-root-project}, for details about the class that defines
the @code{ede-cpp-root} project type.
-@node ede-simple subclassing
-@subsection ede-simple Subclassing
+@node ede-java-root, ede-emacs, ede-cpp-root, Simple projects
+@subsection ede-java-root
+
+Much like the project type @ref{ede-cpp-root}, the java variant is
+can be setup in your @file{.emacs} file and just marks a directory as
+the root of a java source tree.
-todo - Write some doc.
+The @code{ede-java-root} project class knows a few things about Java
+projects. In particular, you can use it to control your classpath at
+both the system level, and for your project. If it is insufficient,
+you can subclass @code{ede-java-root-project} and add your own tweaks
+in just a few lines. See @ref{ede-cpp-root} for an example using the
+C++ variant.
+
+In the most basic case, add this to your @file{.emacs} file, modifying
+appropriate bits as needed.
+
+@example
+(ede-java-root-project "SOMENAME" :file "/dir/to/some/file" :srcroot '("src"))
+@end example
+
+Replace @var{SOMENAME} with whatever name you want, and the filename
+to an actual file at the root of your project. It might be a
+Makefile, a README file. Whatever. It doesn't matter. It's just a
+key to hang the rest of @ede{} off of.
- In the meantime look in the commentary of ede-simple.el
+Replace the value of :srcroot with a list of directories under the
+project root which contains Java sources. For example, if you have:
-@node ede-emacs
+@example
+~/myprojects/P1/
+~/myprojects/P1/src/
+~/myprojects/P1/src/com/ericsoft/MyCode.java
+~/myprojects/P1/doc/
+@end example
+
+Then @file{src} represents the directory under which all your Java
+code is. It is important that @file{src} is one step above the
+directory that is the base of your package name, such as
+@file{com/ericsoft} in the example above so that new files can be
+discovered via fully qualified name. You can have multiple such
+directories in one project, and each will be accessible.
+
+You can specify your classpath like this:
+
+@example
+(ede-java-root-project "NAME" :file "FILENAME"
+ :srcroot '("src")
+ :classpath '("/absolute/path.jar")
+ :localclasspath '( "/relative/path.jar" ))
+@end example
+
+In this example, @code{:classpath} specifies absolute paths somewhere
+on your system, and the explicit jar or source root directories
+@semantic{} will search when performing completions.
+
+The @code{:localclasspath} is like @code{:classpath}, but it will
+contain path names relative to the root of your project.
+
+If you want to override the file-finding tool with your own
+function you can do this:
+
+@example
+(ede-java-root-project "NAME" :file "FILENAME" :locate-fcn 'MYFCN)
+@end example
+
+Where @var{MYFCN} is a symbol for a function. The locate function can
+be used in place of @code{ede-expand-filename} so you can quickly
+customize your custom target to use specialized local routines instead
+of the default @ede{} routines. The function symbol must take two
+arguments:
+
+@table @var
+@item NAME
+The name of the file to find.
+@item DIR
+The directory root for this java-root project.
+@end table
+
+If you would like to create your Java projects dynamically, instead of
+putting them all in your @file{.emacs}, you can do that too. See
+@ref{ede-cpp-root} for details that can be applied to this project type.
+
+@node ede-emacs, ede-linux, ede-java-root, Simple projects
@subsection ede-emacs
The @code{ede-emacs} project automatically identifies an Emacs source
@@ -556,7 +1044,7 @@ tree, and enables EDE project mode for it.
It pre-populates the C Preprocessor symbol map for correct parsing,
and has an optimized include file identification function.
-@node ede-linux
+@node ede-linux, Custom Locate, ede-emacs, Simple projects
@subsection ede-linux
The @code{ede-linux} project will automatically identify a Linux
@@ -565,7 +1053,7 @@ Kernel source tree, and enable EDE project mode for it.
It pre-populates the C Preprocessor symbol map for reasonable parsing,
and has an optimized include file identification function.
-@node Custom Locate
+@node Custom Locate, , ede-linux, Simple projects
@subsection Custom Locate
The various simple project styles all have one major drawback, which
@@ -604,7 +1092,7 @@ You can add your own locate tool but subclassing from
methods. See the code in @file{ede-locate.el} for GNU Global as a
simple example.
-@node Extending EDE, , Simple projects, top
+@node Extending EDE, , Miscellaneous commands, top
@chapter Extending @ede{}
This chapter is intended for users who want to write new parts or fix
@@ -647,6 +1135,8 @@ See the @file{ede-skel.el} file for examples of these. The files
examples.
@menu
+* Development Overview::
+* Detecting a Project::
* User interface methods:: Methods associated with keybindings
* Base project methods:: The most basic methods on @ede{} objects.
* Sourcecode objects:: Defining new sourcecode classes.
@@ -657,7 +1147,164 @@ examples.
* Compilers:: Details of compiler classes.
@end menu
-@node User interface methods
+@node Development Overview, Detecting a Project, Extending EDE, Extending EDE
+@section Development Overview
+
+@ede{} is made up of a series of classes implemented with @eieio{}.
+These classes define an interface that can be used to create different
+types of projects.
+
+@ede{} defines two superclasses which are @code{ede-project} and
+@code{ede-target}. All commands in @ede{} are usually meant to
+address the current project, or current target.
+
+All specific projects in @ede{} derive subclasses of the @ede{} superclasses.
+In this way, specific behaviors such as how a project is saved, or how a
+target is compiled can be customized by a project author in detail. @ede{}
+communicates to these project objects via an API using methods. The
+commands you use in @ede{} mode are high-level functional wrappers over
+these methods.
+
+Some example project types are:
+
+@table @code
+@item project-am
+Automake project which reads existing Automake files.
+@item ede-proj-project
+This project type will create @file{Makefiles},
+or @file{Makefile.am} files to compile your project.
+@item ede-linux
+This project type will detect linux source trees.
+@item ede-emacs
+This project will detect an Emacs source tree.
+@end table
+
+There are several other project types as well.
+
+The first class you need to know to create a new project type is
+@code{ede-project-autoload}. New instances of this class are needed
+to define how Emacs associates different files/buffers with different
+project types. All the autoloads are kept in the variable
+@code{ede-project-class-files}.
+
+The next most important class to know is @code{ede-project}. This is
+the baseclass defines how all projects behave. The basic pattern for
+a project is that there is one project per directory, and the topmost
+project or directory defines the project as a whole.
+
+Key features of @code{ede-project} are things like name and version
+number. It also holds a list of @code{ede-target} objects and a list
+of sub projects, or more @code{ede-project} objects.
+
+New project types must subclass @code{ede-project} to add special
+behavior. New project types also need to subclass @code{ede-target} to
+add specialty behavior.
+
+In this way, the common @ede{} interface is designed to work against
+@code{ede-project}, and thus all subclasses.
+
+@code{ede-project} subclasses @code{ede-project-placeholder}. This is
+the minimum necessary project needed to be cached between runs of
+Emacs. This way, Emacs can track all projects ever seen, without
+loading those projects into memory.
+
+Here is a high-level UML diagram for the @ede{} system created with @cogre{}..
+
+@example
++-----------------------+ +-----------------------+
+| | |ede-project-placeholder|
+|ede-project-class-files| +-----------------------+
+| | +-----------------------+
++-----------------------+ +-----------------------+
+ /\ ^
+ \/ /_\
+ | |
+ +--------------------+ +-----------+ +----------+
+ |ede-project-autoload| |ede-project| |ede-target|
+ +--------------------+<>--------------+-----------+<>-------+----------+
+ +--------------------+ +-----------+ +----------+
+ +--------------------+ +-----------+ +----------+
+ ^
+ /_\
+ |
+ +---------------------+-----------------+
+ | | |
+ | | |
+ | | |
+ +----------------+ +-------------------+ +---------+
+ |ede-proj-project| |project-am-makefile| |ede-emacs|
+ +----------------+ +-------------------+ +---------+
+ +----------------+ +-------------------+ +---------+
+ +----------------+ +-------------------+ +---------+
+@end example
+
+
+@node Detecting a Project, User interface methods, Development Overview, Extending EDE
+@section Detecting a Project
+
+Project detection happens with the list of @code{ede-project-autoload}
+instances stored in @code{ede-project-class-files}. The full project
+detection scheme works like this:
+
+@table @asis
+@item Step 1:
+@code{find-file-hook} calls @code{ede-turn-on-hook} on BUFFER.
+@item Step 2:
+@code{ede-turn-on-hook} turns on @code{ede-minor-mode}
+@item Step 3:
+@code{ede-minor-mode} looks to see if BUFFER is associated with any
+open projects. If not, it calls @code{ede-load-project-file} to find
+a project associated with the current directory BUFFER is in.
+@item Step 4:
+@code{ede-minor-mode} associates the found project with the current
+buffer with a series of variables, such as @code{ede-object}, and
+@code{ede-object-project} and @code{ede-object-root-project}.
+@end table
+
+Once a buffer is associated, @ede{} minor mode commands will operate
+on that buffer.
+
+The function @code{ede-load-project-file} is at the heart of detecting
+projects, and it works by looping over all the known project autoload
+types in @code{ede-project-autoload} using the utility
+@code{ede-directory-project-p}.
+
+The function @code{ede-directory-project-p} will call
+@code{ede-dir-to-projectfile} on every @code{ede-project-autoload}
+until one of them returns true. The method
+@code{ede-dir-to-projectfile} in turn gets the @code{:proj-file} slot
+from the autoload. If it is a string (ie, a project file name), it
+checks to see if that exists in BUFFER's directory. If it is a
+function, then it calls that function and expects it to return a file
+name or nil. If the file exists, then this directory is assumed to be
+part of a project, and @code{ede-directory-project-p} returns the
+instance of @code{ede-project-autoload} that matched.
+
+If the current directory contains the file @code{.ede-ignore} then
+that directory is automatically assumed to contain no projects, even
+if there is a matching pattern. Use this type of file in a directory
+that may contain many other sub projects, but still has a Makefile of
+some sort.
+
+If the current directory is a project, then @ede{} scans upwards till
+it finds the top of the project. It does this by calling
+@code{ede-toplevel-project}. If this hasn't already been discovered,
+the directories as scanned upward one at a time until a directory with
+no project is found. The last found project becomes the project
+root. If the found instance of @code{ede-project-autoload} has a
+valid @code{proj-root} slot value, then that function is called instead
+of scanning the project by hand. Some project types have a short-cut
+for determining the root of a project, so this comes in handy.
+
+Getting back to @code{ede-load-project-file}, this now has an instance
+of @code{ede-project-autoload}. It uses the @code{load-type} slot to
+both autoload in the project type, and to create a new instance of the
+project type found for the root of the project. That project is added
+to the global list of all projects. All subprojects are then created
+and assembled into the project data structures.
+
+
+@node User interface methods, Base project methods, Detecting a Project, Extending EDE
@section User interface methods
These methods are core behaviors associated with user commands.
@@ -689,7 +1336,7 @@ Make a distribution (tar archive) of the project.
Rescan a project file, changing the data in the existing objects.
@end table
-@node Base project methods
+@node Base project methods, Sourcecode objects, User interface methods, Extending EDE
@section Base project methods
These methods are important for querying base information from project
@@ -726,7 +1373,7 @@ stored in.
List all documentation a project or target is responsible for.
@end table
-@node Sourcecode objects
+@node Sourcecode objects, Compiler and Linker objects, Base project methods, Extending EDE
@section Sourcecode objects
@ede{} projects track source file / target associates via source code
@@ -772,7 +1419,7 @@ In this case, the garbage pattern is the same.
@xref{Sourcecode}.
-@node Compiler and Linker objects
+@node Compiler and Linker objects, Project, Sourcecode objects, Extending EDE
@section Compiler and Linker objects
In order for a target to create a @file{Makefile}, it must know how to
@@ -790,7 +1437,7 @@ compilers that will be inserted into the Makefile.
Compiler instantiations must also insert variables specifying the
compiler it plans to use, in addition to creating Automake settings for
-@file{configure.in} when appropriate.
+@file{configure.ac} when appropriate.
Compiler objects are stored in the target objects as a list of
symbols, where the symbols value is the object. This enables the
@@ -833,21 +1480,21 @@ See @file{ede-proj-obj.el} for examples of the combination.
@defindex sc
@defindex cm
-@node Project
+@node Project, Targets, Compiler and Linker objects, Extending EDE
@section Project
@menu
-* ede-project-placeholder ::
-* ede-project ::
-* ede-cpp-root-project ::
-* ede-simple-project ::
-* ede-simple-base-project ::
-* ede-proj-project ::
-* project-am-makefile ::
-* ede-step-project ::
+* ede-project-placeholder::
+* ede-project::
+* ede-cpp-root-project::
+* ede-simple-project::
+* ede-simple-base-project::
+* ede-proj-project::
+* project-am-makefile::
+* ede-step-project::
@end menu
-@node ede-project-placeholder
+@node ede-project-placeholder, ede-project, Project, Project
@subsection ede-project-placeholder
@pjindex ede-project-placeholder
@@ -937,7 +1584,7 @@ Make sure placeholder @var{THIS} is replaced with the real thing, and pass throu
Make sure placeholder @var{THIS} is replaced with the real thing, and pass through.
@end deffn
-@node ede-project
+@node ede-project, ede-cpp-root-project, ede-project-placeholder, Project
@subsection ede-project
@pjindex ede-project
@@ -1233,7 +1880,7 @@ Retrieves the slot @code{menu} from an object of class @code{ede-project}
Commit change to local variables in @var{PROJ}.
@end deffn
-@node ede-cpp-root-project
+@node ede-cpp-root-project, ede-simple-project, ede-project, Project
@subsection ede-cpp-root-project
@pjindex ede-cpp-root-project
@@ -1361,7 +2008,7 @@ Within this project @var{PROJ}, find the file @var{NAME}.
This knows details about or source tree.
@end deffn
-@node ede-simple-project
+@node ede-simple-project, ede-simple-base-project, ede-cpp-root-project, Project
@subsection ede-simple-project
@pjindex ede-simple-project
@@ -1391,7 +2038,7 @@ No children
Commit any change to @var{PROJ} to its file.
@end deffn
-@node ede-simple-base-project
+@node ede-simple-base-project, ede-proj-project, ede-simple-project, Project
@subsection ede-simple-base-project
@pjindex ede-simple-base-project
@@ -1421,7 +2068,7 @@ This one project could control a tree of subdirectories.
@table @asis
@end table
-@node ede-proj-project
+@node ede-proj-project, project-am-makefile, ede-simple-base-project, Project
@subsection ede-proj-project
@pjindex ede-proj-project
@@ -1557,7 +2204,7 @@ For project @var{THIS}, test that the file @var{FILE} exists, or create it.
@deffn Method ede-proj-setup-buildenvironment :AFTER this &optional force
Setup the build environment for project @var{THIS}.
-Handles the Makefile, or a Makefile.am configure.in combination.
+Handles the Makefile, or a Makefile.am configure.ac combination.
Optional argument @var{FORCE} will force items to be regenerated.
@end deffn
@@ -1567,7 +2214,7 @@ These are removed with make clean.
@end deffn
@deffn Method ede-proj-configure-synchronize :AFTER this
-Synchronize what we know about project @var{THIS} into configure.in.
+Synchronize what we know about project @var{THIS} into configure.ac.
@end deffn
@deffn Method ede-proj-makefile-insert-variables-new :AFTER this
@@ -1588,7 +2235,7 @@ Argument @var{PROJ} is the project to save.
@end deffn
@deffn Method ede-proj-configure-recreate :AFTER this
-Delete project @var{THIS}es configure script and start over.
+Delete project @var{THIS}'s configure script and start over.
@end deffn
@deffn Method ede-proj-makefile-insert-user-rules :AFTER this
@@ -1603,7 +2250,7 @@ Return the name of the Makefile with the DIST target in it for @var{THIS}.
@end deffn
@deffn Method ede-proj-configure-file :AFTER this
-The configure.in script used by project @var{THIS}.
+The configure.ac script used by project @var{THIS}.
@end deffn
@deffn Method ede-commit-project :AFTER proj
@@ -1618,7 +2265,7 @@ Return a list of files that constitutes a distribution of @var{THIS} project.
Commit change to local variables in @var{PROJ}.
@end deffn
-@node project-am-makefile
+@node project-am-makefile, ede-step-project, ede-proj-project, Project
@subsection project-am-makefile
@pjindex project-am-makefile
@@ -1660,7 +2307,7 @@ Despite the fact that this is a method, it depends on the current
buffer being in order to provide a smart default target type.
@end deffn
-@node ede-step-project
+@node ede-step-project, , project-am-makefile, Project
@subsection ede-step-project
@pjindex ede-step-project
@@ -1767,7 +2414,7 @@ Create a Makefile for all Makefile targets in @var{THIS} if needed.
@deffn Method ede-proj-setup-buildenvironment :AFTER this &optional force
Setup the build environment for project @var{THIS}.
-Handles the Makefile, or a Makefile.am configure.in combination.
+Handles the Makefile, or a Makefile.am configure.ac combination.
Optional argument @var{FORCE} will force items to be regenerated.
@end deffn
@@ -1792,35 +2439,35 @@ Return a list of files that constitutes a distribution of @var{THIS} project.
Commit change to local variables in @var{PROJ}.
@end deffn
-@node Targets
+@node Targets, Sourcecode, Project, Extending EDE
@section Targets
@menu
-* ede-target ::
-* ede-proj-target ::
-* ede-proj-target-makefile ::
-* semantic-ede-proj-target-grammar ::
-* ede-proj-target-makefile-objectcode ::
-* ede-proj-target-makefile-archive ::
-* ede-proj-target-makefile-program ::
-* ede-proj-target-makefile-shared-object ::
-* ede-proj-target-elisp ::
-* ede-proj-target-elisp-autoloads ::
-* ede-proj-target-makefile-miscelaneous ::
-* ede-proj-target-makefile-info ::
-* ede-proj-target-scheme ::
-* project-am-target ::
-* project-am-objectcode ::
-* project-am-program ::
-* project-am-header-noinst ::
-* project-am-header-inst ::
-* project-am-lisp ::
-* project-am-texinfo ::
-* project-am-man ::
+* ede-target::
+* ede-proj-target::
+* ede-proj-target-makefile::
+* semantic-ede-proj-target-grammar::
+* ede-proj-target-makefile-objectcode::
+* ede-proj-target-makefile-archive::
+* ede-proj-target-makefile-program::
+* ede-proj-target-makefile-shared-object::
+* ede-proj-target-elisp::
+* ede-proj-target-elisp-autoloads::
+* ede-proj-target-makefile-miscelaneous::
+* ede-proj-target-makefile-info::
+* ede-proj-target-scheme::
+* project-am-target::
+* project-am-objectcode::
+* project-am-program::
+* project-am-header-noinst::
+* project-am-header-inst::
+* project-am-lisp::
+* project-am-texinfo::
+* project-am-man::
@end menu
-@node ede-target
+@node ede-target, ede-proj-target, Targets, Targets
@subsection ede-target
@tgindex ede-target
@@ -2033,7 +2680,7 @@ Return the name of @var{THIS} target, suitable for make or debug style commands.
Retrieves the slot @code{menu} from an object of class @code{ede-target}
@end deffn
-@node ede-proj-target
+@node ede-proj-target, ede-proj-target-makefile, ede-target, Targets
@subsection ede-proj-target
@tgindex ede-proj-target
@@ -2227,7 +2874,7 @@ sources variable.
@end deffn
-@node ede-proj-target-makefile
+@node ede-proj-target-makefile, semantic-ede-proj-target-grammar, ede-proj-target, Targets
@subsection ede-proj-target-makefile
@tgindex ede-proj-target-makefile
@@ -2329,7 +2976,7 @@ Return a list of configuration variables from @var{THIS}.
Use @var{CONFIGURATION} as the current configuration to query.
@end deffn
-@node semantic-ede-proj-target-grammar
+@node semantic-ede-proj-target-grammar, ede-proj-target-makefile-objectcode, ede-proj-target-makefile, Targets
@subsection semantic-ede-proj-target-grammar
@tgindex semantic-ede-proj-target-grammar
@@ -2383,7 +3030,7 @@ Argument @var{THIS} is the target that should insert stuff.
@end deffn
-@node ede-proj-target-makefile-objectcode
+@node ede-proj-target-makefile-objectcode, ede-proj-target-makefile-archive, semantic-ede-proj-target-grammar, Targets
@subsection ede-proj-target-makefile-objectcode
@tgindex ede-proj-target-makefile-objectcode
@@ -2445,7 +3092,7 @@ Argument @var{THIS} is the target to get sources from.
@end deffn
-@node ede-proj-target-makefile-archive
+@node ede-proj-target-makefile-archive, ede-proj-target-makefile-program, ede-proj-target-makefile-objectcode, Targets
@subsection ede-proj-target-makefile-archive
@tgindex ede-proj-target-makefile-archive
@@ -2488,7 +3135,7 @@ Makefile.am generator, so use it to add this important bin program.
@end deffn
-@node ede-proj-target-makefile-program
+@node ede-proj-target-makefile-program, ede-proj-target-makefile-shared-object, ede-proj-target-makefile-archive, Targets
@subsection ede-proj-target-makefile-program
@tgindex ede-proj-target-makefile-program
@@ -2569,7 +3216,7 @@ Insert bin_PROGRAMS variables needed by target @var{THIS}.
@end deffn
-@node ede-proj-target-makefile-shared-object
+@node ede-proj-target-makefile-shared-object, ede-proj-target-elisp, ede-proj-target-makefile-program, Targets
@subsection ede-proj-target-makefile-shared-object
@tgindex ede-proj-target-makefile-shared-object
@@ -2629,7 +3276,7 @@ Makefile.am generator, so use it to add this important bin program.
@end deffn
-@node ede-proj-target-elisp
+@node ede-proj-target-elisp, ede-proj-target-elisp-autoloads, ede-proj-target-makefile-shared-object, Targets
@subsection ede-proj-target-elisp
@tgindex ede-proj-target-elisp
@@ -2706,7 +3353,7 @@ There are standards in Elisp files specifying how the version string
is found, such as a @code{-version} variable, or the standard header.
@end deffn
-@node ede-proj-target-elisp-autoloads
+@node ede-proj-target-elisp-autoloads, ede-proj-target-makefile-miscelaneous, ede-proj-target-elisp, Targets
@subsection ede-proj-target-elisp-autoloads
@tgindex ede-proj-target-elisp-autoloads
@@ -2823,7 +3470,7 @@ sources variable.
@end deffn
-@node ede-proj-target-makefile-miscelaneous
+@node ede-proj-target-makefile-miscelaneous, ede-proj-target-makefile-info, ede-proj-target-elisp-autoloads, Targets
@subsection ede-proj-target-makefile-miscelaneous
@tgindex ede-proj-target-makefile-miscelaneous
@@ -2880,7 +3527,7 @@ Return a list of files which @var{THIS} target depends on.
@end deffn
-@node ede-proj-target-makefile-info
+@node ede-proj-target-makefile-info, ede-proj-target-scheme, ede-proj-target-makefile-miscelaneous, Targets
@subsection ede-proj-target-makefile-info
@tgindex ede-proj-target-makefile-info
@@ -2967,7 +3614,7 @@ Does the usual for Makefile mode, but splits source into two variables
when working in Automake mode.
@end deffn
-@node ede-proj-target-scheme
+@node ede-proj-target-scheme, project-am-target, ede-proj-target-makefile-info, Targets
@subsection ede-proj-target-scheme
@tgindex ede-proj-target-scheme
@@ -3012,7 +3659,7 @@ Tweak the configure file (current buffer) to accommodate @var{THIS}.
@end deffn
-@node project-am-target
+@node project-am-target, project-am-objectcode, ede-proj-target-scheme, Targets
@subsection project-am-target
@tgindex project-am-target
@@ -3050,7 +3697,7 @@ Run the current project in the debugger.
Edit the target associated w/ this file.
@end deffn
-@node project-am-objectcode
+@node project-am-objectcode, project-am-program, project-am-target, Targets
@subsection project-am-objectcode
@tgindex project-am-objectcode
@@ -3095,7 +3742,7 @@ Default target to use when compiling an object code target.
There are no default header files.
@end deffn
-@node project-am-program
+@node project-am-program, project-am-header-noinst, project-am-objectcode, Targets
@subsection project-am-program
@tgindex project-am-program
@@ -3134,7 +3781,7 @@ Additional LD args.
@end table
@end table
-@node project-am-header-noinst
+@node project-am-header-noinst, project-am-header-inst, project-am-program, Targets
@subsection project-am-header-noinst
@tgindex project-am-header-noinst
@@ -3167,7 +3814,7 @@ No children
Return the default macro to 'edit' for this object.
@end deffn
-@node project-am-header-inst
+@node project-am-header-inst, project-am-lisp, project-am-header-noinst, Targets
@subsection project-am-header-inst
@tgindex project-am-header-inst
@@ -3200,7 +3847,7 @@ No children
Return the default macro to 'edit' for this object.
@end deffn
-@node project-am-lisp
+@node project-am-lisp, project-am-texinfo, project-am-header-inst, Targets
@subsection project-am-lisp
@tgindex project-am-lisp
@@ -3230,7 +3877,7 @@ No children
Return the default macro to 'edit' for this object.
@end deffn
-@node project-am-texinfo
+@node project-am-texinfo, project-am-man, project-am-lisp, Targets
@subsection project-am-texinfo
@tgindex project-am-texinfo
@@ -3273,7 +3920,7 @@ Return the default macro to 'edit' for this object type.
@end deffn
@deffn Method project-compile-target-command :AFTER this
-Default target t- use when compiling a texinfo file.
+Default target to use when compiling a texinfo file.
@end deffn
@deffn Method ede-documentation :AFTER this
@@ -3282,7 +3929,7 @@ Documentation is not for object @var{THIS}, but is provided by @var{THIS} for ot
files in the project.
@end deffn
-@node project-am-man
+@node project-am-man, , project-am-texinfo, Targets
@comment node-name, next, previous, up
@subsection project-am-man
@tgindex project-am-man
@@ -3313,18 +3960,18 @@ No children
Return the default macro to 'edit' for this object type.
@end deffn
-@node Sourcecode
+@node Sourcecode, Compilers, Targets, Extending EDE
@section Sourcecode
The source code type is an object designed to associated files with
targets.
@menu
-* ede-sourcecode ::
+* ede-sourcecode::
@end menu
-@node ede-sourcecode
+@node ede-sourcecode, , Sourcecode, Sourcecode
@subsection ede-sourcecode
@scindex ede-sourcecode
@@ -3427,7 +4074,7 @@ Return non-@code{nil} if @var{THIS} will take @var{FILENAME} as an auxiliary .
Return non-@code{nil} if @var{THIS} will take @var{FILENAME} as an auxiliary .
@end deffn
-@node Compilers
+@node Compilers, , Sourcecode, Extending EDE
@section Compilers
The compiler object is designed to associate source code with
@@ -3436,14 +4083,14 @@ When the makefile is created, this object type knows how to create
compile commands.
@menu
-* ede-compilation-program ::
-* ede-compiler ::
-* ede-object-compiler ::
-* ede-linker ::
+* ede-compilation-program::
+* ede-compiler::
+* ede-object-compiler::
+* ede-linker::
@end menu
-@node ede-compilation-program
+@node ede-compilation-program, ede-compiler, Compilers, Compilers
@subsection ede-compilation-program
@cmindex ede-compilation-program
@@ -3562,7 +4209,7 @@ Tweak the configure file (current buffer) to accommodate @var{THIS}.
@end deffn
-@node ede-compiler
+@node ede-compiler, ede-object-compiler, ede-compilation-program, Compilers
@subsection ede-compiler
@cmindex ede-compiler
@@ -3678,7 +4325,7 @@ Return a string based on @var{THIS} representing a make object variable.
@end deffn
-@node ede-object-compiler
+@node ede-object-compiler, ede-linker, ede-compiler, Compilers
@subsection ede-object-compiler
@cmindex ede-object-compiler
@@ -3722,7 +4369,7 @@ A variable dedicated to dependency generation.
Insert variables needed by the compiler @var{THIS}.
@end deffn
-@node ede-linker
+@node ede-linker, , ede-object-compiler, Compilers
@subsection ede-linker
@cmindex ede-linker
diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi
index 62cd684b57b..0afcdd923d6 100644
--- a/doc/misc/ediff.texi
+++ b/doc/misc/ediff.texi
@@ -25,7 +25,7 @@
This file documents Ediff, a comprehensive visual interface to Unix diff
and patch utilities.
-Copyright @copyright{} 1995-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1995-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -433,6 +433,8 @@ command (see @kbd{ga}, @kbd{gb}, and @kbd{gc}).
@node Quick Help Commands,Other Session Commands,,Session Commands
@section Quick Help Commands
+@cindex command help
+@cindex important commands
@table @kbd
@item ?
@@ -1246,7 +1248,7 @@ This hook is run just before @code{ediff-quit-hook}. This is a good
place to do various cleanups, such as deleting the variant buffers.
Ediff provides a function, @code{ediff-janitor}, as one such possible
hook, which you can add to @code{ediff-cleanup-hook} with
-@code{add-hooks}.
+@code{add-hook}.
@findex ediff-janitor
This function kills buffers A, B, and, possibly, C, if these buffers aren't
@@ -1731,7 +1733,7 @@ faces, you can modify them when Ediff is being loaded using
@end smallexample
@strong{Please note:} to set Ediff's faces, use only @code{copy-face}
-or @code{set/make-face-@dots{}} as shown above. Emacs' low-level
+or @code{set/make-face-@dots{}} as shown above. Emacs's low-level
face-manipulation functions should be avoided.
@node Narrowing, Refinement of Difference Regions, Highlighting Difference Regions, Customization
diff --git a/doc/misc/edt.texi b/doc/misc/edt.texi
index 8f9f8fc03a2..af0069fb1bc 100644
--- a/doc/misc/edt.texi
+++ b/doc/misc/edt.texi
@@ -5,7 +5,7 @@
@copying
This file documents the EDT emulation package for Emacs.
-Copyright @copyright{} 1986, 1992, 1994-1995, 1999-2011
+Copyright @copyright{} 1986, 1992, 1994-1995, 1999-2012
Free Software Foundation, Inc.
@quotation
diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi
index d65c7a15f7b..6b3a87f19fc 100644
--- a/doc/misc/eieio.texi
+++ b/doc/misc/eieio.texi
@@ -11,7 +11,7 @@
@copying
This manual documents EIEIO, an object framework for Emacs Lisp.
-Copyright @copyright{} 2007-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 2007-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -63,7 +63,7 @@ Emacs.
* Making New Objects:: How to construct new objects.
* Accessing Slots:: How to access a slot.
* Writing Methods:: How to write a method.
-@c * Method Invocation:: How methods are invoked.
+* Method Invocation:: How methods are invoked.
* Predicates:: Class-p, Object-p, etc-p.
* Association Lists:: List of objects as association lists.
* Customizing:: Customizing objects.
@@ -71,8 +71,9 @@ Emacs.
* Base Classes:: Additional classes you can inherit from.
* Browsing:: Browsing your class lists.
* Class Values:: Displaying information about a class or object.
+* Documentation:: Automatically creating texinfo documentation.
* Default Superclass:: The root superclasses.
-* Signals:: When you make errors
+* Signals:: When you make errors.
* Naming Conventions:: Name your objects in an Emacs friendly way.
* CLOS compatibility:: What are the differences?
* Wish List:: Things about EIEIO that could be improved.
@@ -269,6 +270,10 @@ If two parents share the same slot name, the parent which appears in
the @var{superclass-list} first sets the tags for that slot. If the
new class has a slot with the same name as the parent, the new slot
overrides the parent's slot.
+
+When overriding a slot, some slot attributes cannot be overridden
+because they break basic OO rules. You cannot override @code{:type}
+or @code{:protection}.
@end defmac
@noindent
@@ -294,7 +299,7 @@ This option is here to support programs written with older versions of
@end defvar
@menu
-* Inheritance:: How to specify parents classes
+* Inheritance:: How to specify parents classes.
* Slot Options:: How to specify features of a slot.
* Class Options:: How to specify features for this class.
@end menu
@@ -435,35 +440,6 @@ A symbol that is a function like this:
:initform +
@end example
will set the initial value as that symbol.
-A function that is a lambda expression, like this:
-@example
-:initform (lambda () some-variablename)
-@end example
-
-will be evaluated at instantiation time to the value of
-@code{some-variablename}.
-@c This feature was more annoying than useful. Use the
-@c `initialize-instance' function to do this.
-@c
-@c On the other hand, if you need code to be
-@c executed at instantiation time as the initform, code like this:
-@c @example
-@c :initform (lambda () (+ 1 some-global-var))
-@c @end example
-@c will be identified as a function call, and be executed in place.
-
-@cindex lambda-default
-
-
-Lastly, using the function @code{lambda-default} instead of
-@code{lambda} will let you specify a lambda expression to use as the
-value, without evaluation, thus:
-@example
-:initform (lambda-default () some-variablename)
-@end example
-@c @@TODO - This will be deleted after fair warning.
-will not be evaluated at instantiation time, and the value in this
-slot will instead be @code{(lambda () some-variablename)}.
After a class has been created with @code{defclass}, you can change
that default value with @code{oset-default}. @ref{Accessing Slots}.
@@ -481,9 +457,6 @@ Here are some examples:
An object of your class type.
@item (or null symbol)
A symbol, or nil.
- @item function
- A function symbol, or a @code{lambda-default} expression.
-
@end table
@item :allocation
@@ -621,9 +594,12 @@ Search for methods in the class hierarchy in breadth first order.
This is the default.
@item :depth-first
Search for methods in the class hierarchy in a depth first order.
+@item :c3
+Searches for methods in in a linearized way that most closely matches
+what CLOS does when a monotonic class structure is defined.
@end table
-@c @xref{Method Invocation}, for more on method invocation order.
+@xref{Method Invocation}, for more on method invocation order.
@item :metaclass
Unsupported CLOS option. Enables the use of a different base class other
@@ -1008,10 +984,39 @@ method.
@c TODO - Write some more about static methods here
-@c @node Method Invocation
-@c @chapter Method Invocation
+@node Method Invocation
+@chapter Method Invocation
-@c TODO - writeme
+When classes are defined, you can specify the
+@code{:method-invocation-order}. This is a feature specific to EIEIO.
+
+This controls the order in which method resolution occurs for
+@code{:primary} methods in cases of multiple inheritance. The order
+affects which method is called first in a tree, and if
+@code{call-next-method} is used, it controls the order in which the
+stack of methods are run.
+
+The original EIEIO order turned out to be broken for multiple
+inheritance, but some programs depended on it. As such this option
+was added when the default invocation order was fixed to something
+that made more sense in that case.
+
+Valid values are:
+
+@table @code
+@item :breadth-first
+Search for methods in the class hierarchy in breadth first order.
+This is the default.
+@item :depth-first
+Search for methods in the class hierarchy in a depth first order.
+@item :c3
+Searches for methods in in a linearized way that most closely matches
+what CLOS does when CLOS when a monotonic class structure is defined.
+
+This is derived from the Dylan language documents by
+Kim Barrett et al.: A Monotonic Superclass Linearization for Dylan
+Retrieved from: http://192.220.96.201/dylan/linearization-oopsla96.html
+@end table
@node Predicates
@comment node-name, next, previous, up
@@ -1399,9 +1404,12 @@ a header line comment from the class allocated slot if one is not
provided.
@end defmethod
-@defun eieio-persistent-read filename
-Read @var{filename} which contains an @code{eieio-persistent} object
-previously written with @code{eieio-persistent-save}.
+@defun eieio-persistent-read filename &optional class allow-subclass
+Read a persistent object from @var{filename}, and return it.
+Signal an error if the object in @var{FILENAME} is not a constructor
+for @var{CLASS}. Optional @var{allow-subclass} says that it is ok for
+@code{eieio-persistent-read} to load in subclasses of class instead of
+being pedantic.
@end defun
@node eieio-named
@@ -1544,8 +1552,51 @@ a class. In a program, pass it a string with the name of a class, a
class symbol, or an object. The resulting buffer will display all slot
names.
-Additionally, all methods defined to have functionality on this class
-are displayed.
+Additionally, all methods defined to have functionality on this class is
+displayed.
+
+@node Documentation
+@comment node-name, next, previous, up
+@chapter Documentation
+
+It is possible to automatically create documentation for your classes in
+texinfo format by using the tools in the file @file{eieio-doc.el}
+
+@deffn Command eieiodoc-class class indexstring &optional skiplist
+
+This will start at the current point, and create an indented menu of
+all the child classes of, and including @var{class}, but skipping any
+classes that might be in @var{skiplist}. It will then create nodes for
+all these classes, subsection headings, and indexes.
+
+Each class will be indexed using the texinfo labeled index
+@var{indexstring} which is a two letter description.
+@xref{(texinfo) New Indices}.
+
+To use this command, the texinfo macro
+
+@example
+@@defindex @@var @{ indexstring @}
+@end example
+
+@noindent
+where @var{indexstring} is replaced with the two letter code.
+
+Next, an inheritance tree will be created listing all parents of that
+section's class.
+
+Then, all the slots will be expanded in tables, and described
+using the documentation strings from the code. Default values will also
+be displayed. Only those slots with @code{:initarg} specified will be
+expanded, others will be hidden. If a slot is inherited from a parent,
+that slot will also be skipped unless the default value is different.
+If there is a change, then the documentation part of the slot will be
+replace with an @@xref back to the parent.
+
+This command can only display documentation for classes whose
+definitions have been loaded in this Emacs session.
+
+@end deffn
@node Default Superclass
@comment node-name, next, previous, up
@@ -1893,7 +1944,7 @@ better in the Emacs environment.
@enumerate
@item
-Allow subclasing of Emacs built-in types, such as faces, markers, and
+Allow subclassing of Emacs built-in types, such as faces, markers, and
buffers.
@item
Allow method overloading of method-like functions in Emacs.
diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi
new file mode 100644
index 00000000000..12e65c9e8dd
--- /dev/null
+++ b/doc/misc/emacs-gnutls.texi
@@ -0,0 +1,198 @@
+\input texinfo @c -*-texinfo-*-
+
+@setfilename ../../info/emacs-gnutls
+@settitle Emacs GnuTLS Integration @value{VERSION}
+
+@set VERSION 0.3
+
+@copying
+This file describes the Emacs GnuTLS integration.
+
+Copyright @copyright{} 2012 Free Software Foundation, Inc.
+
+@quotation
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with the Front-Cover texts being ``A GNU Manual,''
+and with the Back-Cover Texts as in (a) below. A copy of the license
+is included in the section entitled ``GNU Free Documentation License''
+in the Emacs manual.
+
+(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and
+modify this GNU manual. Buying copies from the FSF supports it in
+developing GNU and promoting software freedom.''
+
+This document is part of a collection distributed under the GNU Free
+Documentation License. If you want to distribute this document
+separately from the collection, you can do so by adding a copy of the
+license to the document, as described in section 6 of the license.
+@end quotation
+@end copying
+
+@dircategory Emacs network features
+@direntry
+* GnuTLS: (emacs-gnutls). The Emacs GnuTLS integration.
+@end direntry
+
+@titlepage
+@title Emacs GnuTLS Integration
+@author by Ted Zlatanov
+@page
+@vskip 0pt plus 1filll
+@insertcopying
+@end titlepage
+
+@contents
+
+@ifnottex
+@node Top
+@top Emacs GnuTLS
+This manual describes the Emacs GnuTLS integration.
+
+GnuTLS is a library that establishes encrypted @acronym{SSL} or
+@acronym{TLS} connections. Emacs supports it through the
+@file{gnutls.c} and @file{gnutls.h} C files and the @file{gnutls.el}
+Emacs Lisp library.
+
+@insertcopying
+
+@menu
+* Overview:: Overview of the GnuTLS integration.
+* Help For Users::
+* Help For Developers::
+* Function Index::
+* Variable Index::
+@end menu
+@end ifnottex
+
+@node Overview
+@chapter Overview
+
+The GnuTLS library is an optional add-on for Emacs. Through it, any
+Emacs Lisp program can establish encrypted network connections that
+use @dfn{Secure Socket Layer} (@acronym{SSL}) and @dfn{Transport Layer
+Security} (@acronym{TLS}) protocols. The process of using
+@acronym{SSL} and @acronym{TLS} in establishing connections is as
+automated and transparent as possible.
+
+The user has only a few customization options currently: the log
+level, priority string, trustfile list, and the minimum number of bits
+to be used in Diffie-Hellman key exchange. Rumors that every Emacs
+library requires at least 83 customizable variables are thus proven
+false.
+
+@node Help For Users
+@chapter Help For Users
+
+From the user's perspective, there's nothing to the GnuTLS
+integration. It Just Works for any Emacs Lisp code that uses
+@code{open-protocol-stream} or @code{open-network-stream}
+(@pxref{Network,, Network Connections, elisp, The Emacs Lisp Reference
+Manual}). The two functions are equivalent, the first one being an
+alias of the second.
+
+There's one way to find out if GnuTLS is available, by calling
+@code{gnutls-available-p}. This is a little bit trickier on the W32
+(Windows) platform, but if you have the GnuTLS DLLs (available from
+@url{http://sourceforge.net/projects/ezwinports/files/} thanks to Eli
+Zaretskii) in the same directory as Emacs, you should be OK.
+
+@defun gnutls-available-p
+This function returns t if GnuTLS is available in this instance of Emacs.
+@end defun
+
+Oh, but sometimes things go wrong. Budgets aren't balanced,
+television ads lie, and even TLS and SSL connections can fail to work
+properly. Well, there's something to be done in the last case.
+
+@defvar gnutls-log-level
+The @code{gnutls-log-level} variable sets the log level. 1 is
+verbose. 2 is very verbose. 5 is crazy. Crazy! Set it to 1 or 2
+and look in the @code{*Messages*} buffer for the debugging
+information.
+@end defvar
+
+@defvar gnutls-algorithm-priority
+The @code{gnutls-algorithm-priority} variable sets the GnuTLS priority
+string. This is global, not per host name (although
+@code{gnutls-negotiate} supports a priority string per connection so
+it could be done if needed). The priority string syntax is in the
+@uref{http://www.gnu.org/software/gnutls/documentation.html, GnuTLS
+documentation}.
+@end defvar
+
+@defvar gnutls-trustfiles
+The @code{gnutls-trustfiles} variable is a list of trustfiles
+(certificates for the issuing authorities). This is global, not per
+host name (although @code{gnutls-negotiate} supports a trustfile per
+connection so it could be done if needed). The trustfiles can be in
+PEM or DER format and examples can be found in most Unix
+distributions. By default four locations are tried in this order:
+@file{/etc/ssl/certs/ca-certificates.crt} for Debian, Ubuntu, Gentoo
+and Arch Linux; @file{/etc/pki/tls/certs/ca-bundle.crt} for Fedora
+and RHEL; @file{/etc/ssl/ca-bundle.pem} for Suse;
+@file{/usr/ssl/certs/ca-bundle.crt} for Cygwin. You can easily
+customize @code{gnutls-trustfiles} to be something else, but let us
+know if you do, so we can make the change to benefit the other users
+of that platform.
+@end defvar
+
+@defvar gnutls-min-prime-bits
+The @code{gnutls-min-prime-bits} variable is a pretty exotic
+customization for cases where you want to refuse handshakes with keys
+under a specific size. If you don't know for sure that you need it,
+you don't. Leave it @code{nil}.
+@end defvar
+
+@node Help For Developers
+@chapter Help For Developers
+
+The GnuTLS library is detected automatically at compile time. You
+should see that it's enabled in the @code{configure} output. If not,
+follow the standard procedure for finding out why a system library is
+not picked up by the Emacs compilation. On the W32 (Windows)
+platform, installing the DLLs with a recent build should be enough.
+
+Just use @code{open-protocol-stream} or @code{open-network-stream}
+(the two are equivalent, the first one being an alias to the second).
+You should not have to use the @file{gnutls.el} functions directly.
+But you can test them with @code{open-gnutls-stream}.
+
+@defun open-gnutls-stream name buffer host service
+This function creates a buffer connected to a specific @var{host} and
+@var{service} (port number or service name). The parameters and their
+syntax are the same as those given to @code{open-network-stream}
+(@pxref{Network,, Network Connections, elisp, The Emacs Lisp Reference
+Manual}). The connection process is called @var{name} (made unique if
+necessary). This function returns the connection process.
+
+@lisp
+;; open a HTTPS connection
+(open-gnutls-stream "tls" "tls-buffer" "yourserver.com" "https")
+
+;; open a IMAPS connection
+(open-gnutls-stream "tls" "tls-buffer" "imap.gmail.com" "imaps")
+@end lisp
+
+@end defun
+
+The function @code{gnutls-negotiate} is not generally useful and it
+may change as needed, so please see @file{gnutls.el} for the details.
+
+@defun gnutls-negotiate spec
+Please see @file{gnutls.el} for the @var{spec} details and for usage,
+but do not rely on this function's interface if possible.
+@end defun
+
+@node Function Index
+@chapter Function Index
+@printindex fn
+
+@node Variable Index
+@chapter Variable Index
+@printindex vr
+
+@bye
+
+@c End:
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index 91440dcfe8f..e57fcc8adf1 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -11,7 +11,7 @@
@copying
This file documents the Emacs MIME interface functionality.
-Copyright @copyright{} 1998-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1998-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -1516,16 +1516,16 @@ Here's a bunch of time/date/second/day examples:
@result{} 905595714.0
(seconds-to-time 905595714.0)
-@result{} (13818 19266 0)
+@result{} (13818 19266 0 0)
(time-to-days '(13818 19266))
@result{} 729644
(days-to-time 729644)
-@result{} (961933 65536)
+@result{} (961933 512)
(time-since '(13818 19266))
-@result{} (0 430)
+@result{} (6797 9607 984839 247000)
(time-less-p '(13818 19266) '(13818 19145))
@result{} nil
@@ -1546,7 +1546,7 @@ Here's a bunch of time/date/second/day examples:
(time-to-number-of-days
(time-since
(date-to-time "Mon, 01 Jan 2001 02:22:26 GMT")))
-@result{} 4.146122685185185
+@result{} 4314.095589286675
@end example
And finally, we have @code{safe-date-to-time}, which does the same as
@@ -1561,7 +1561,7 @@ An RFC822 (or similar) date string. For instance: @code{"Sat Sep 12
12:21:54 1998 +0200"}.
@item time
-An internal Emacs time. For instance: @code{(13818 26466)}.
+An internal Emacs time. For instance: @code{(13818 26466 0 0)}.
@item seconds
A floating point representation of the internal Emacs time. For
diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi
index b4137a7dac6..bb5e18f1c8b 100644
--- a/doc/misc/epa.texi
+++ b/doc/misc/epa.texi
@@ -9,7 +9,7 @@
@copying
This file describes EasyPG Assistant @value{VERSION}.
-Copyright @copyright{} 2007-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 2007-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index b46748a08f9..834d2ea844d 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -3,13 +3,13 @@
@setfilename ../../info/erc
@settitle ERC Manual
@syncodeindex fn cp
+@include emacsver.texi
@c %**end of header
@copying
-This manual is for ERC version 5.3.
+This manual is for ERC as distributed with Emacs @value{EMACSVER}.
-Copyright @copyright{} 2005-2011
-Free Software Foundation, Inc.
+Copyright @copyright{} 2005-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -48,8 +48,7 @@ and modified without restriction.
@contents
@ifnottex
-@node Top, Introduction, (dir), (dir)
-@comment node-name, next, previous, up
+@node Top
@top ERC
@insertcopying
@@ -57,9 +56,6 @@ and modified without restriction.
@menu
* Introduction:: What is ERC?
-* Obtaining ERC:: How to get ERC releases and development
- versions.
-* Installation:: Compiling and installing ERC.
* Getting Started:: Quick Start guide to using ERC.
* Keystroke Summary:: Keystrokes used in ERC buffers.
* Modules:: Available modules for ERC.
@@ -76,11 +72,6 @@ and modified without restriction.
@detailmenu
--- The Detailed Node Listing ---
-Obtaining ERC
-
-* Releases:: Released versions of ERC.
-* Development:: Latest unreleased development changes.
-
Getting Started
* Sample Session:: Example of connecting to the #emacs channel
@@ -95,11 +86,11 @@ Advanced Usage
@end detailmenu
@end menu
-@node Introduction, Obtaining ERC, Top, Top
-@comment node-name, next, previous, up
+@node Introduction
@chapter Introduction
ERC is a powerful, modular, and extensible IRC client for Emacs.
+It is distributed with Emacs since version 22.1.
It comes with the following capabilities enabled by default.
@@ -119,217 +110,13 @@ It comes with the following capabilities enabled by default.
@end itemize
-@node Obtaining ERC, Installation, Introduction, Top
-@comment node-name, next, previous, up
-@chapter Obtaining ERC
-
-@menu
-* Releases:: Released versions of ERC.
-* Development:: Latest unreleased development changes.
-@end menu
-
-Note that some ERC files are not included with Emacs due to copyright or
-dependency issues. If desired, they may be found at the following
-locations, or from your local GNU mirror.
-
-@itemize @bullet
-@item @uref{http://ftp.gnu.org/gnu/erc/erc-5.3-extras.tar.gz}
-@item @uref{http://ftp.gnu.org/gnu/erc/erc-5.3-extras.zip}
-@end itemize
-
-The rest of this chapter may be skipped if you are using the version of
-ERC that comes with Emacs.
-
-@node Releases, Development, Obtaining ERC, Obtaining ERC
-@comment node-name, next, previous, up
-@section Releases
-
-Choose to install a release if you want to minimize risk.
-
-Errors are corrected in development first. User-visible changes will be
-announced on the @email{erc-discuss@@gnu.org} mailing list.
-@pxref{Getting Help and Reporting Bugs}.
-
-@cindex releases, Debian package
-@cindex Debian package for ERC
-Debian users can get ERC via apt-get. The @file{erc} package is
-available in the official Debian repository.
-
-@cindex releases, from source
-Alternatively, you can download the latest release from
-@uref{http://ftp.gnu.org/gnu/erc}, or your local GNU mirror.
-
-@node Development, , Releases, Obtaining ERC
-@comment node-name, next, previous, up
-@section Development
-@cindex development
-
-Choose the development version if you want to live on the bleeding edge
-of ERC development or try out new features before release.
-
-@cindex git version control system, using
-The git version control system allows you to keep up-to-date with the
-latest changes to the development version of ERC. It also allows you
-to contribute changes (via commits, if you are have developer access to
-the repository, or via patches, otherwise). If you would like to
-contribute to ERC development, it is highly recommended that you use
-git.
-
-If you are new to git, you might find this tutorial helpful:
-@uref{http://www.kernel.org/pub/software/scm/git/docs/gittutorial.html}.
-
-Downloading ERC with git and staying up-to-date involves the following
-steps.
-
-@enumerate
-@item Install git.
-
-@itemize @bullet
-@item Debian and Ubuntu: @kbd{apt-get install git-core}.
-@item Windows: @uref{http://git.or.cz/gitwiki/WindowsInstall}.
-@item Other operating systems: download, compile, and install the source
-from @uref{http://www.kernel.org/pub/software/scm/git/}, or find a git
-package for your operating system.
-@end itemize
-
-@item Download the ERC development branch.
-
-If you have developer access to ERC, do:
-
-@example
-git clone ssh://loginname@@git.sv.gnu.org/srv/git/erc.git
-@end example
-
-otherwise, do:
-
-@example
-git clone git://git.sv.gnu.org/erc.git
-@end example
-
-If you are behind a restrictive firewall, and do not have developer
-access, then do the following instead:
-
-@example
-git clone http://git.sv.gnu.org/r/erc.git
-@end example
-
-@item List upstream changes that are missing from your local copy.
-Do this whenever you want to see whether new changes have been committed
-to ERC. If you wish, you may skip this step and proceed directly to
-the ``update'' step.
-
-@example
-# Change to the source directory you are interested in.
-cd erc
-
-# Fetch new changes from the repository, but don't apply them yet
-git fetch origin
-
-# Display log messages for the new changes
-git log HEAD..origin
-@end example
-
-``origin'' is git's name for the location where you originally got ERC
-from. You can change this location at any time by editing the
-@file{.git/config} file in the directory where the ERC source was
-placed.
-
-@cindex updating ERC with git
-@item Update to the latest version by pulling in any missing changes.
-
-@example
-cd erc
-git pull origin
-@end example
-
-git will show how many files changed, and will provide a visual display
-for how many lines were changed in each file.
-
-@end enumerate
-
-There are other ways to interact with the ERC repository.
-
-@itemize
-@item Browse git repo: @uref{http://git.sv.gnu.org/gitweb/?p=erc.git}
-@item Latest development snapshot: @uref{http://mwolson.org/static/dist/erc-latest.tar.gz}
-@item Latest development snapshot (zip file): @uref{http://mwolson.org/static/dist/erc-latest.zip}
-@end itemize
-
-The latest development snapshot can lag behind the git repo by as much
-as 20 minutes, but never more than that.
-
-For further information on committing changes to ERC and performing
-development, please consult
-@uref{http://emacswiki.org/cgi-bin/wiki/ErcDevelopment}.
-
-
-@node Installation, Getting Started, Obtaining ERC, Top
-@comment node-name, next, previous, up
-@chapter Installation
-
-ERC may be compiled and installed on your machine.
-
-This section may be skipped if you are using the version of ERC that
-comes with Emacs.
-
-@subsubheading Compilation
-
-This is an optional step, since Emacs Lisp source code does not
-necessarily have to be byte-compiled. It will yield a speed increase,
-though.
-
-A working copy of Emacs or XEmacs is needed in order to compile ERC. By
-default, the program that is installed with the name @command{emacs}
-will be used.
-
-If you want to use the @command{xemacs} binary to perform the
-compilation, you would need to edit @file{Makefile} in the top-level
-directory as follows. You can put either a full path to an Emacs or
-XEmacs binary or just the command name, as long as it is in the
-@env{PATH}.
-
-@example
-EMACS = xemacs
-SITEFLAG = -no-site-file
-@end example
-
-Running @code{make} should compile the ERC source files in the
-@file{lisp} directory.
-@subsubheading Installation
-
-ERC may be installed into your file hierarchy by doing the following.
-
-Edit the @file{Makefile} file so that @env{ELISPDIR} points to where you
-want the source and compiled ERC files to be installed and
-@env{INFODIR} indicates where to put the ERC manual. Of course, you
-will want to edit @env{EMACS} and @env{SITEFLAG} as shown in the
-Compilation section if you are using XEmacs.
-
-If you are installing ERC on a Debian system, you might want to change
-the value of @env{INSTALLINFO} as specified in @file{Makefile}.
-
-Run @code{make} as a normal user.
-
-Run @code{make install} as the root user if you have chosen installation
-locations that require this.
-
-
-@node Getting Started, Keystroke Summary, Installation, Top
-@comment node-name, next, previous, up
+@node Getting Started
@chapter Getting Started
@cindex settings
-To use ERC, add the directory containing its files to your
-@code{load-path} variable, in your @file{.emacs} file. Then, load ERC
-itself. An example follows.
-
-@lisp
-(require 'erc)
-@end lisp
-
-Once ERC is loaded, the command @kbd{M-x erc} will start ERC and
-prompt for the server to connect to.
+The command @kbd{M-x erc} will start ERC and prompt for the server to
+connect to.
If you want to place ERC settings in their own file, you can place them
in @file{~/.emacs.d/.ercrc.el}, creating it if necessary.
@@ -344,8 +131,7 @@ you want, do @kbd{M-x customize-variable RET erc-modules RET}.
* Special Features:: Differences from standalone IRC clients
@end menu
-@node Sample Session, Special Features, Getting Started, Getting Started
-@comment node-name, next, previous, up
+@node Sample Session
@section Sample Session
This is an example ERC session which shows how to connect to the #emacs
@@ -403,8 +189,7 @@ talk with them.
@end itemize
-@node Special Features, , Sample Session, Getting Started
-@comment node-name, next, previous, up
+@node Special Features
@section Special Features
ERC has some features that distinguish it from some IRC clients.
@@ -478,8 +263,7 @@ ERC buffer and run the @code{/RECONNECT} command.
@end itemize
-@node Keystroke Summary, Modules, Getting Started, Top
-@comment node-name, next, previous, up
+@node Keystroke Summary
@chapter Keys Used in ERC
@cindex keystrokes
@@ -562,8 +346,7 @@ Kill current input line using `erc-bol' followed by `kill-line'.
@end table
-@node Modules, Advanced Usage, Keystroke Summary, Top
-@comment node-name, next, previous, up
+@node Modules
@chapter Modules
@cindex modules
@@ -607,11 +390,6 @@ Complete nicknames and commands (programmable)
@item fill
Wrap long lines
-@cindex modules, hecomplete
-@item hecomplete
-Complete nicknames and commands (old). This is the old module---you
-might prefer the ``completion'' module instead.
-
@cindex modules, identd
@item identd
Launch an identd server on port 8113
@@ -644,6 +422,11 @@ Don't display non-IRC commands after evaluation
@item notify
Notify when the online status of certain users changes
+@cindex modules, notifications
+@item notifications
+Send you a notification when you get a private message,
+or your nickname is mentioned
+
@cindex modules, page
@item page
Process CTCP PAGE requests from IRC
@@ -701,8 +484,7 @@ Translate morse code in messages
@c PRE5_4: Document every option of every module in its own subnode
-@node Advanced Usage, Getting Help and Reporting Bugs, Modules, Top
-@comment node-name, next, previous, up
+@node Advanced Usage
@chapter Advanced Usage
@cindex advanced topics
@@ -712,8 +494,7 @@ Translate morse code in messages
* Options:: Options that are available for ERC.
@end menu
-@node Connecting, Sample Configuration, Advanced Usage, Advanced Usage
-@comment node-name, next, previous, up
+@node Connecting
@section Connecting to an IRC Server
@cindex connecting
@@ -749,7 +530,7 @@ parameters.
@defun erc-compute-server &optional server
Return an IRC server name.
-This tries a number of increasingly more default methods until a non-nil
+This tries a number of increasingly more default methods until a non-@code{nil}
value is found.
@itemize @bullet
@@ -761,7 +542,7 @@ value is found.
@end defun
-@defopt erc-server nil
+@defopt erc-server
IRC server to use if one is not provided.
@end defopt
@@ -770,7 +551,7 @@ IRC server to use if one is not provided.
@defun erc-compute-port &optional port
Return a port for an IRC server.
-This tries a number of increasingly more default methods until a non-nil
+This tries a number of increasingly more default methods until a non-@code{nil}
value is found.
@itemize @bullet
@@ -793,7 +574,7 @@ This can be either a string or a number.
Return user's IRC nick.
This tries a number of increasingly more default methods until a
-non-nil value is found.
+non-@code{nil} value is found.
@itemize
@item @var{nick} (the argument passed to this function)
@@ -817,19 +598,43 @@ The string to append to the nick if it is already in use.
@end defopt
@defopt erc-try-new-nick-p
-If the nickname you chose isn't available, and this option is non-nil,
+If the nickname you chose isn't available, and this option is non-@code{nil},
ERC should automatically attempt to connect with another nickname.
You can manually set another nickname with the /NICK command.
@end defopt
+@subheading Password
+@cindex password
+
+@defopt erc-prompt-for-password
+If non-@code{nil} (the default), @kbd{M-x erc} prompts for a password.
+@end defopt
+
+If you prefer, you can set this option to @code{nil} and use the
+@code{auth-source} mechanism to store your password. For instance, if
+you use @file{~/.authinfo} as your auth-source backend, then put
+something like the following in that file:
+
+@example
+machine irc.example.net login "#fsf" password sEcReT
+@end example
+
+@noindent
+ERC also consults @code{auth-source} to find any channel keys required
+for the channels that you wish to autojoin, as specified by the
+variable @code{erc-autojoin-channels-alist}.
+
+For more details, @pxref{Top,,auth-source, auth, Emacs auth-source Library}.
+
+
@subheading Full name
@defun erc-compute-full-name &optional full-name
Return user's full name.
This tries a number of increasingly more default methods until a
-non-nil value is found.
+non-@code{nil} value is found.
@itemize @bullet
@item @var{full-name} (the argument passed to this function)
@@ -846,8 +651,7 @@ User full name.
This can be either a string or a function to call.
@end defopt
-@node Sample Configuration, Options, Connecting, Advanced Usage
-@comment node-name, next, previous, up
+@node Sample Configuration
@section Sample Configuration
@cindex configuration, sample
@@ -926,21 +730,33 @@ stuff, to the current ERC buffer."
;; (setq erc-kill-server-buffer-on-quit t)
@end lisp
-@node Options, , Sample Configuration, Advanced Usage
-@comment node-name, next, previous, up
+@node Options
@section Options
@cindex options
@c PRE5_4: (Node) Document every ERC option (module options go in
@c previous chapter)
-This section has not yet been written. For now, the easiest way to
-check out the available options for ERC is to do
+This section is extremely incomplete. For now, the easiest way to
+check out all the available options for ERC is to do
@kbd{M-x customize-group erc RET}.
+@defopt erc-hide-list
+If non, @code{nil}, this is a list of IRC message types to hide, e.g.
-@node Getting Help and Reporting Bugs, History, Advanced Usage, Top
-@comment node-name, next, previous, up
+@example
+(setq erc-hide-list '("JOIN" "PART" "QUIT"))
+@end example
+@end defopt
+
+@defopt erc-lurker-hide-list
+Like @code{erc-hide-list}, but only applies to messages sent by
+lurkers. The function @code{erc-lurker-p} determines whether a given
+nickname is considerd a lurker.
+@end defopt
+
+
+@node Getting Help and Reporting Bugs
@chapter Getting Help and Reporting Bugs
@cindex help, getting
@cindex bugs, reporting
@@ -952,36 +768,24 @@ or if you have bugs to report, there are several places you can go.
@item
@uref{http://www.emacswiki.org/cgi-bin/wiki/ERC} is the
-emacswiki.org page for ERC. Anyone may add tips, hints, or bug
-descriptions to it.
+emacswiki.org page for ERC. Anyone may add tips, hints, etc. to it.
@item
-There are several mailing lists for ERC. To subscribe, visit
-@uref{http://savannah.gnu.org/mail/?group=erc}.
-
-The mailing lists are also available on Gmane.
-(@url{http://gmane.org/}). Gmane provides additional methods for
-accessing the mailing lists, adding content to them, and searching them.
-
-@enumerate
-@item gmane.emacs.erc.announce: Announcements
-
-@item gmane.emacs.erc.discuss: General discussion
-
-@item gmane.emacs.erc.cvs: Log messages for changes to the ERC source code
-
-@end enumerate
+You can ask questions about using ERC on the Emacs mailing list,
+@uref{http://lists.gnu.org/mailman/listinfo/help-gnu-emacs}.
@item
You can visit the IRC Freenode channel @samp{#emacs}. Many of the
contributors are frequently around and willing to answer your
questions.
+@item
+To report a bug in ERC, use @kbd{M-x report-emacs-bug}.
+
@end itemize
-@node History, Copying, Getting Help and Reporting Bugs, Top
-@comment node-name, next, previous, up
+@node History
@chapter History
@cindex history, of ERC
@@ -1044,18 +848,22 @@ our revision control system. Our mailing list address changed as well.
We switched to using git for our version control system.
+@item 2009+
+
+Since about 2009, ERC is no longer developed as a separate project, but
+is maintained as part of Emacs.
+
@end itemize
-@node Copying, GNU Free Documentation License, History, Top
-@comment node-name, next, previous, up
+@node Copying
+@appendix GNU GENERAL PUBLIC LICENSE
@include gpl.texi
-@node GNU Free Documentation License, Concept Index, Copying, Top
-@comment node-name, next, previous, up
+@node GNU Free Documentation License
+@appendix GNU Free Documentation License
@include doclicense.texi
-@node Concept Index, , GNU Free Documentation License, Top
-@comment node-name, next, previous, up
+@node Concept Index
@unnumbered Index
@printindex cp
diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
index 00755262075..b585b68daa8 100644
--- a/doc/misc/ert.texi
+++ b/doc/misc/ert.texi
@@ -4,13 +4,13 @@
@settitle Emacs Lisp Regression Testing
@c %**end of header
-@dircategory Emacs
+@dircategory Emacs misc features
@direntry
-* ERT: (ert). Emacs Lisp Regression Testing.
+* ERT: (ert). Emacs Lisp regression testing tool.
@end direntry
@copying
-Copyright @copyright{} 2008, 2010-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 2008, 2010-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -130,7 +130,7 @@ familiar: This example defines a test named @code{pp-test-quote} that
will pass if the three calls to @code{equal} all return true
(non-nil).
-@code{should} is a macro with the same meaning as @code{assert} but
+@code{should} is a macro with the same meaning as @code{cl-assert} but
better error reporting. @xref{The @code{should} Macro}.
Each test should have a name that describes what functionality it tests.
@@ -342,7 +342,7 @@ to find where a test was defined if the test was loaded from a file.
Test bodies can include arbitrary code; but to be useful, they need to
check whether the code being tested (or @emph{code under test})
does what it is supposed to do. The macro @code{should} is similar to
-@code{assert} from the cl package
+@code{cl-assert} from the cl package
(@pxref{Assertions,,, cl, Common Lisp Extensions}),
but analyzes its argument form and records information that ERT can
display to help debugging.
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index 7c178757927..d322ca7c3e1 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -8,7 +8,7 @@
@copying
This manual is for Eshell, the Emacs shell.
-Copyright @copyright{} 1999-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1999-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -94,7 +94,7 @@ handling the sort of tasks accomplished by those tools.
@cindex Eshell, what it is
Eshell is a @dfn{command shell} written in Emacs Lisp. Everything it
-does, it uses Emacs' facilities to do. This means that Eshell is as
+does, it uses Emacs's facilities to do. This means that Eshell is as
portable as Emacs itself. It also means that cooperation with Lisp code
is natural and seamless.
diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi
index a68eda50025..dec178c5258 100644
--- a/doc/misc/eudc.texi
+++ b/doc/misc/eudc.texi
@@ -12,7 +12,7 @@ EUDC is the Emacs Unified Directory Client, a common interface to
directory servers using various protocols such as LDAP or the CCSO white
pages directory system (PH/QI)
-Copyright @copyright{} 1998, 2000-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1998, 2000-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/faq.texi b/doc/misc/faq.texi
index 15c9232d4b6..2983667c5cd 100644
--- a/doc/misc/faq.texi
+++ b/doc/misc/faq.texi
@@ -11,7 +11,7 @@
@c appreciate a notice if you do).
@copying
-Copyright @copyright{} 2001-2011 Free Software Foundation, Inc.@*
+Copyright @copyright{} 2001-2012 Free Software Foundation, Inc.@*
Copyright @copyright{} 1994, 1995, 1996, 1997, 1998, 1999, 2000
Reuven M. Lerner@*
Copyright @copyright{} 1992, 1993 Steven Byrnes@*
@@ -91,7 +91,6 @@ Emacs, the Emacs manual is often the best starting point.
* Bugs and problems::
* Compiling and installing Emacs::
* Finding Emacs and related packages::
-* Major packages and programs::
* Key bindings::
* Alternate character sets::
* Mail and news::
@@ -196,8 +195,7 @@ pressed.}.
Also, on very few keyboards does @kbd{C-?} generate @acronym{ASCII} code 127.
@c FIXME I cannot understand the previous sentence.
-@inforef{Keys, Keys, emacs}, for more information. (@xref{Emacs
-manual}, for more information about Info.)
+@xref{Keys,,, emacs, The GNU Emacs Manual}.
@node Extended commands
@section What does @file{M-x @var{command}} mean?
@@ -253,7 +251,7 @@ reference to follow it.
Emacs manual.
@node File-name conventions
-@section What are @file{etc/GNU}, @file{src/config.h}, @file{site-lisp/default.el}, etc.?
+@section What are @file{src/config.h}, @file{site-lisp/default.el}, etc.?
@cindex File-name conventions
@cindex Conventions for file names
@cindex Directories and files that come with Emacs
@@ -942,6 +940,7 @@ status of its latest version.
@menu
* Origin of the term Emacs::
* Latest version of Emacs::
+* New in Emacs 24::
* New in Emacs 23::
* New in Emacs 22::
* New in Emacs 21::
@@ -1009,12 +1008,84 @@ Emacs, type @kbd{C-h C-n} (@kbd{M-x view-emacs-news}). As of Emacs 22,
you can give this command a prefix argument to read about which features
were new in older versions.
+@node New in Emacs 24
+@section What is different about Emacs 24?
+@cindex Differences between Emacs 23 and Emacs 24
+@cindex Emacs 24, new features in
+
+@itemize
+@cindex packages, installing more
+@item
+Emacs now includes a package manager. Type @kbd{M-x list-packages} to
+get started. You can use this to download and automatically install
+many more Lisp packages.
+
+@cindex lexical binding
+@item
+Emacs Lisp now supports lexical binding on a per-file basis. In
+@emph{lexical binding}, variable references must be located textually
+within the binding construct. This contrasts with @emph{dynamic
+binding}, where programs can refer to variables defined outside their
+local textual scope. A Lisp file can use a local variable setting of
+@code{lexical-binding: t} to indicate that the contents should be
+interpreted using lexical binding. See the Emacs Lisp Reference
+Manual for more details.
+
+@cindex bidirectional display
+@cindex right-to-left languages
+@item
+Some human languages, such as English, are written from left to right.
+Others, such as Arabic, are written from right to left. Emacs now has
+support for any mixture of these forms---this is ``bidirectional text''.
+
+@item
+Handling of text selections has been improved, and now integrates
+better with external clipboards.
+
+@cindex themes
+@item
+A new command @kbd{customize-themes} allows you to easily change the
+appearance of your Emacs.
+
+@item
+Emacs can be compiled with the GTK+ 3 toolkit.
+
+@item
+Support for several new external libraries can be included at compile
+time:
+
+@itemize
+
+@item
+``Security-Enhanced Linux'' (SELinux) is a Linux kernel feature that
+provides more sophisticated file access controls than ordinary
+``Unix-style'' file permissions.
+
+@item
+The ImageMagick display library. This allows you to display many more
+image format in Emacs, as well as carry out transformations such as
+rotations.
+
+@item
+The GnuTLS library for secure network communications. Emacs uses this
+transparently for email if your mail server supports it.
+
+@item
+The libxml2 library for parsing XML structures.
+@end itemize
+
+@item
+Much more flexibility in the handling of windows and buffer display.
+
+@end itemize
+
+As always, consult the @file{NEWS} file for more information.
+
+
@node New in Emacs 23
@section What is different about Emacs 23?
@cindex Differences between Emacs 22 and Emacs 23
@cindex Emacs 23, new features in
-@cindex Recently introduced features
-@cindex Default features
@itemize
@@ -1065,8 +1136,7 @@ Other changes include: support for serial port access; D-Bus bindings; a
new Visual Line mode for line-motion; improved completion; a new mode
(@samp{DocView}) for viewing of PDF, PostScript, and DVI documents; nXML
mode (for editing XML documents) is included; VC has been updated for
-newer version control systems; etc. As always, consult the @file{NEWS}
-file for more information.
+newer version control systems; etc.
@node New in Emacs 22
@@ -1267,7 +1337,7 @@ of files from Macintosh, Microsoft, and Unix platforms.
@cindex Init file, setting up
@cindex Customization file, setting up
-@inforef{Init File, Init File, emacs}.
+@xref{Init File,,, emacs, The GNU Emacs Manual}.
In general, new Emacs users should not be provided with @file{.emacs}
files, because this can cause confusing non-standard behavior. Then
@@ -1282,8 +1352,8 @@ rather than Lisp code.
While Customize might indeed make it easier to configure Emacs,
consider taking a bit of time to learn Emacs Lisp and modifying your
@file{.emacs} directly. Simple configuration options are described
-rather completely in @inforef{Init File, Init File, emacs}, for users
-interested in performing frequently requested, basic tasks.
+rather completely in @ref{Init File,,, emacs, The GNU Emacs Manual},
+for users interested in performing frequently requested, basic tasks.
Sometimes users are unsure as to where their @file{.emacs} file should
be found. Visiting the file as @file{~/.emacs} from Emacs will find
@@ -1299,7 +1369,7 @@ The main Customize entry point is @kbd{M-x customize @key{RET}}. This
command takes you to a buffer listing all the available Customize
groups. From there, you can access all customizable options and faces,
change their values, and save your changes to your init file.
-@inforef{Easy Customization, Easy Customization, emacs}.
+@xref{Easy Customization,,, emacs, The GNU Emacs Manual}.
If you know the name of the group in advance (e.g. ``shell''), use
@kbd{M-x customize-group @key{RET}}.
@@ -1604,16 +1674,16 @@ M-x replace-regexp @key{RET} [^ @key{TAB} C-q @key{LFD} C-q @key{RET} C-q C-l @k
@cindex Searching for newlines
@cindex Replacing newlines
-Use @kbd{C-q C-j}. For more information, see @inforef{Special Isearch,
-Special Input for Incremental Search, emacs}.
-
+Use @kbd{C-q C-j}. For more information,
+@pxref{Special Isearch,, Special Input for Incremental Search, emacs,
+The GNU Emacs Manual}.
@node Yanking text in isearch
@section How do I copy text from the kill ring into the search string?
@cindex Yanking text into the search string
@cindex isearch yanking
-Use @kbd{M-y}. @inforef{Isearch Yank, Isearch Yanking, emacs}.
+Use @kbd{M-y}. @xref{Isearch Yank,,, emacs, The GNU Emacs Manual}.
@node Wrapping words automatically
@section How do I make Emacs wrap words for me?
@@ -2062,7 +2132,7 @@ commands you've typed.
To repeat a set of commands, use keyboard macros. Use @kbd{C-x (} and
@kbd{C-x )} to make a keyboard macro that invokes the command and then
-type @kbd{C-x e}. (@inforef{Keyboard Macros, Keyboard Macros, emacs}.)
+type @kbd{C-x e}. @xref{Keyboard Macros,,, emacs, The GNU Emacs Manual}.
If you're really desperate for the @code{.} command in @code{vi} that
redoes the last insertion/deletion, use VIPER, a @code{vi} emulation
@@ -2074,7 +2144,7 @@ mode which comes with Emacs, and which appears to support it.
@cindex X resources
@cindex Setting X resources
-@inforef{X Resources, X Resources, emacs}.
+@xref{X Resources,,, emacs, The GNU Emacs Manual}.
You can also use a resource editor, such as editres (for X11R5 and
onwards), to look at the resource names for the menu bar, assuming Emacs
@@ -2185,7 +2255,7 @@ See also the variable @code{track-eol} and the command
@cindex Suspending Emacs
@kbd{C-z} iconifies Emacs when running under X and suspends Emacs
-otherwise. @inforef{Frame Commands, Frame Commands, emacs}.
+otherwise. @xref{Frame Commands,,, emacs, The GNU Emacs Manual}.
@node Using regular expressions
@section How do I use regexps (regular expressions) in Emacs?
@@ -2195,7 +2265,7 @@ otherwise. @inforef{Frame Commands, Frame Commands, emacs}.
@cindex Unix regexps, differences from Emacs
@cindex Text strings, putting regexps in
-@inforef{Regexp Backslash, Regexp Backslash, emacs}.
+@xref{Regexp Backslash,,, emacs, The GNU Emacs Manual}.
The @code{or} operator is @samp{\|}, not @samp{|}, and the grouping operators
are @samp{\(} and @samp{\)}. Also, the string syntax for a backslash is
@@ -2252,7 +2322,7 @@ To accept all replacements in each file, hit @kbd{!}.
Another way to do the same thing is to use the ``tags'' feature of
Emacs: it includes the command @code{tags-query-replace} which performs
a query-replace across all the files mentioned in the @file{TAGS} file.
-@inforef{Tags Search, Tags Search, emacs}.
+@xref{Tags Search,,, emacs, The GNU Emacs Manual}.
@node Documentation for etags
@section Where is the documentation for @code{etags}?
@@ -2295,8 +2365,8 @@ the Unix shell, try GNU @code{ls} with the @samp{-B} option. GNU
@code{ls} is part of the GNU Fileutils package, available from
@samp{ftp.gnu.org} and its mirrors (@pxref{Current GNU distributions}).
-To disable or change the way backups are made, @inforef{Backup Names, ,
-emacs}.
+To disable or change the way backups are made,
+@pxref{Backup Names,,, emacs, The GNU Emacs Manual}.
@cindex Backup files in a single directory
Beginning with Emacs 21.1, you can control where Emacs puts backup files
@@ -2326,8 +2396,8 @@ package (@pxref{Packages that do not come with Emacs}). This
package also allows you to place all auto-save files in one directory,
such as @file{/tmp}.
-To disable or change how @code{auto-save-mode} works, @inforef{Auto
-Save, , emacs}.
+To disable or change how @code{auto-save-mode} works,
+@pxref{Auto Save,,, emacs, The GNU Emacs Manual}.
@node Going to a line by number
@section How can I go to a certain line given its number?
@@ -2550,7 +2620,7 @@ consult the documentation of the variables @code{ps-printer-name},
Customize the @code{scroll-conservatively} variable with @kbd{M-x
customize-variable @key{RET} scroll-conservatively @key{RET}} and set it
to a large value like, say, 10000. For an explanation of what this
-means, @inforef{Auto Scrolling, Auto Scrolling, emacs}.
+means, @pxref{Auto Scrolling,,, emacs, The GNU Emacs Manual}.
Alternatively, use the following Lisp form in your @file{.emacs}:
@@ -2621,8 +2691,8 @@ put the following in your @file{.emacs} file:
To avoid the slightly distracting visual effect of Emacs starting with
its default frame size and then growing to fullscreen, you can add an
-@samp{Emacs.Geometry} entry to the Windows registry settings (see
-@pxref{(emacs)X Resources}).
+@samp{Emacs.Geometry} entry to the Windows registry settings.
+@xref{X Resources,,, emacs, The GNU Emacs Manual}.
To compute the correct values for width and height, first maximize the
Emacs frame and then evaluate @code{(frame-height)} and
@@ -2987,7 +3057,7 @@ You can also tell Emacs whether to allow the evaluation of Emacs Lisp
code found at the bottom of files by setting the variable
@code{enable-local-eval}.
-For more information, @inforef{File Variables, File Variables, emacs}.
+@xref{File Variables,,, emacs, The GNU Emacs Manual}.
@item
Synthetic X events. (Yes, a risk; use @samp{MIT-MAGIC-COOKIE-1} or
@@ -3170,6 +3240,7 @@ problem (@pxref{Reporting bugs}).
* Finding Emacs on the Internet::
* Finding a package with particular functionality::
* Packages that do not come with Emacs::
+* Spell-checkers::
* Current GNU distributions::
* Difference between Emacs and XEmacs::
* Emacs for minimalists::
@@ -3225,6 +3296,14 @@ see @ref{Packages that do not come with Emacs}.
@cindex Emacs Lisp List
@cindex Emacs Lisp Archive
+Your first port of call should be the @kbd{M-x list-packages} command.
+This connects to the @uref{http:///elpa.gnu.org, GNU ELPA} (``Emacs
+Lisp Package Archive'') server and fetches the list of additional
+packages that it offers. These are GNU packages that are available
+for use with Emacs, but are distributed separately. Select a package
+to get more details about the features that it offers, and then if you
+wish, Emacs can download and automatically install it for you.
+
@uref{http://www.damtp.cam.ac.uk/user/sje30/emacs/ell.html, The Emacs Lisp
List (ELL)}, maintained by @email{S.J.Eglen@@damtp.cam.ac.uk, Stephen Eglen},
aims to provide one compact list with links to all of the current Emacs
@@ -3243,6 +3322,29 @@ Several packages are stored in
Read the file @file{etc/MORE.STUFF} for more information about
external packages.
+@node Spell-checkers
+@section Spell-checkers
+@cindex Spell-checker
+@cindex Checking spelling
+@cindex Ispell
+@cindex Aspell
+@cindex Hunspell
+
+Various spell-checkers are compatible with Emacs, including:
+
+@table @b
+
+@item GNU Aspell
+@uref{http://aspell.net/}
+
+@item Ispell
+@uref{http://fmg-www.cs.ucla.edu/geoff/ispell.html}
+
+@item Hunspell
+@uref{http://hunspell.sourceforge.net/}
+
+@end table
+
@node Current GNU distributions
@section Where can I get other up-to-date GNU stuff?
@cindex Current GNU distributions
@@ -3363,124 +3465,6 @@ Beginning with version 22.1, Emacs supports Mac OS X natively.
See the file @file{nextstep/INSTALL} in the distribution.
@c ------------------------------------------------------------
-@node Major packages and programs
-@chapter Major packages and programs
-@cindex Major packages and programs
-
-@menu
-* VM::
-* AUCTeX::
-* BBDB::
-* Spell-checkers::
-* Emacs/W3::
-* EDB::
-* JDEE::
-@end menu
-
-@node VM
-@section VM (View Mail) --- another mail reader within Emacs, with MIME support
-@cindex VM
-@cindex Alternative mail software
-@cindex View Mail
-@cindex E-mail reader, VM
-
-@table @b
-
-@item Web site
-@uref{http://launchpad.net/vm}
-(was @uref{http://www.nongnu.org/viewmail/})
-
-@item Informational newsgroup
-@uref{news:gnu.emacs.vm.info}@*
-
-@item Bug reports newsgroup
-@uref{news:gnu.emacs.vm.bug}@*
-@end table
-
-VM was originally written by @uref{http://www.wonderworks.com/vm/,Kyle Jones}.
-@uref{ftp://ftp.wonderworks.com/pub/vm/,Older versions} of VM remain
-available.
-
-
-@node AUCTeX
-@section AUC@TeX{} --- enhanced @TeX{} modes with debugging facilities
-@cindex Mode for @TeX{}
-@cindex @TeX{} mode
-@cindex AUC@TeX{} mode for editing @TeX{}
-@cindex Writing and debugging @TeX{}
-
-AUC@TeX{} is a set of sophisticated major modes for @TeX{}, LaTeX,
-ConTeXt, and Texinfo offering context-sensitive syntax highlighting,
-indentation, formatting and folding, macro completion, @TeX{} shell
-functionality, and debugging. Be also sure to check out
-@ref{Introduction, RefTeX, Introduction, reftex, Ref@TeX{} User Manual}.
-Current versions of AUC@TeX{} include the
-@uref{http://www.gnu.org/software/auctex/preview-latex.html,preview-latex}
-package for WYSIWYG previews of various LaTeX constructs in the Emacs
-source buffer.
-
-@uref{http://www.gnu.org/software/auctex/, AUCTeX}
-
-@node BBDB
-@section BBDB --- personal Info Rolodex integrated with mail/news readers
-@cindex BBDB
-@cindex Rolodex-like functionality
-@cindex Integrated contact database
-@cindex Contact database
-@cindex Big Brother Database
-@cindex Address book
-
-@uref{http://bbdb.sourceforge.net/, The Insidious Big Brother Database}
-
-@node Spell-checkers
-@section Spell-checkers
-@cindex Spell-checker
-@cindex Checking spelling
-@cindex Ispell
-@cindex Aspell
-@cindex Hunspell
-
-Various spell-checkers are compatible with Emacs, including:
-
-@table @b
-
-@item GNU Aspell
-@uref{http://aspell.net/}
-
-@item Ispell
-@uref{http://fmg-www.cs.ucla.edu/geoff/ispell.html}
-
-@item Hunspell
-@uref{http://hunspell.sourceforge.net/}
-
-@end table
-
-@node Emacs/W3
-@section Emacs/W3 --- A World Wide Web browser inside of Emacs
-@cindex WWW browser
-@cindex Web browser
-@cindex HTML browser in Emacs
-@cindex @code{w3-mode}
-
-@uref{http://www.gnu.org/software/w3/, Emacs/W3}
-
-@node EDB
-@section EDB --- Database program for Emacs; replaces forms editing modes
-@cindex EDB
-@cindex Database
-@cindex Forms mode
-
-@uref{http://gnuvola.org/software/edb/, The Emacs Database}
-
-@node JDEE
-@section JDEE --- Integrated development environment for Java
-@cindex Java development environment
-@cindex Integrated Java development environment
-@cindex JDEE
-
-@uref{http://jdee.sourceforge.net/, A Java Development Environment for Emacs}
-
-@c ------------------------------------------------------------
@node Key bindings
@chapter Key bindings
@cindex Key bindings
@@ -3516,7 +3500,7 @@ Keys can be bound to commands either interactively or in your
To bind a key just in the current major mode, type @kbd{M-x
local-set-key @key{RET} @var{key} @var{cmd} @key{RET}}.
-@inforef{Key Bindings, Key Bindings, emacs}, for further details.
+@xref{Key Bindings,,, emacs, The GNU Emacs Manual}.
To make the process of binding keys interactively easier, use the
following ``trick'': First bind the key interactively, then immediately
@@ -3781,8 +3765,8 @@ keymaps.
However, in the specific case of @kbd{C-h} and @key{DEL}, you should
toggle @code{normal-erase-is-backspace-mode} instead of calling
-@code{keyboard-translate}. @inforef{DEL Does Not Delete, DEL Does Not Delete,
-emacs}.
+@code{keyboard-translate}.
+@xref{DEL Does Not Delete,,, emacs, The GNU Emacs Manual}.
Keyboard translations are not the same as key bindings in keymaps.
Emacs contains numerous keymaps that apply in different situations, but
@@ -3910,7 +3894,7 @@ terminals. Non-@acronym{ASCII} keys and mouse events (e.g. @kbd{C-=} and
@cindex @key{Meta} key and @code{xterm}
@cindex Xterm and @key{Meta} key
-@inforef{Unibyte Mode, Single-Byte Character Set Support, emacs}.
+@xref{Unibyte Mode,, Single-Byte Character Set Support, emacs, The GNU Emacs Manual}.
If the advice in the Emacs manual fails, try all of these methods before
asking for further help:
@@ -4034,8 +4018,8 @@ You can get the old behavior by binding @kbd{SPC} to
@cindex Displaying eight-bit characters
@cindex Eight-bit characters, displaying
-@inforef{Unibyte Mode, Single-byte Character Set
-Support, emacs}. On a Unix, when Emacs runs on a text-only terminal
+@xref{Unibyte Mode,, Single-byte Character Set Support, emacs, The GNU
+Emacs Manual}. On a Unix, when Emacs runs on a text-only terminal
display or is invoked with @samp{emacs -nw}, you typically need to use
@code{set-terminal-coding-system} to tell Emacs what the terminal can
display, even after setting the language environment; otherwise
@@ -4050,23 +4034,23 @@ terminal coding system automatically.
@cindex Eight-bit characters, entering
@cindex Input, 8-bit characters
-Various methods are available for input of eight-bit characters. See
-@inforef{Unibyte Mode, Single-byte Character Set
-Support, emacs}. For more sophisticated methods, @inforef{Input
-Methods, Input Methods, emacs}.
+Various methods are available for input of eight-bit characters.
+@xref{Unibyte Mode,, Single-byte Character Set Support, emacs, The GNU
+Emacs Manual}. For more sophisticated methods,
+@pxref{Input Methods,,, emacs, The GNU Emacs Manual}.
@node Right-to-left alphabets
@section Where is an Emacs that can handle Semitic (right-to-left) alphabets?
@cindex Right-to-left alphabets
@cindex Hebrew, handling with Emacs
@cindex Semitic alphabets
-@cindex Arabic alphabets
-@cindex Bidirectional text
+@cindex Arabic
+@cindex Farsi
+@cindex bidirectional scripts
-Emacs supports Hebrew characters (ISO 8859-8) since version 20, but does
-not yet support right-to-left character entry and display. The
-@uref{http://lists.gnu.org/mailman/listinfo/emacs-bidi, emacs-bidi
-mailing list} discusses development of support for this feature.
+Emacs supports display and editing of bidirectional scripts, such as
+Arabic, Farsi, and Hebrew, since version 24.1.
+@xref{New in Emacs 24, bidirectional display}.
@node How to add fonts
@@ -4148,7 +4132,7 @@ set up @code{w32-bdf-filename-alist}:
Now, create fontsets for the BDF fonts:
-@lisp
+@smallexample
(create-fontset-from-fontset-spec
"-*-fixed-medium-r-normal-*-16-*-*-*-c-*-fontset-bdf,
japanese-jisx0208:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0208.1983-*,
@@ -4160,7 +4144,7 @@ Now, create fontsets for the BDF fonts:
tibetan-1-column:-TibMdXA-fixed-medium-r-normal--16-160-72-72-m-80-MuleTibetan-1,
ethiopic:-Admas-Ethiomx16f-Medium-R-Normal--16-150-100-100-M-160-Ethiopic-Unicode,
tibetan:-TibMdXA-fixed-medium-r-normal--16-160-72-72-m-160-MuleTibetan-0")
-@end lisp
+@end smallexample
Many of the international bdf fonts from Intlfonts are type 0, and
therefore need to be added to font-encoding-alist:
@@ -4392,7 +4376,7 @@ you to start Emacs quickly when you needed to.
Use @kbd{M-x gnus}. For more information on Gnus, @pxref{Top,, the Gnus
Manual, gnus, The Gnus Manual}, which includes @ref{Frequently Asked
-Questions,, the Gnus FAQ, gnus}.
+Questions,, the Gnus FAQ, gnus, The Gnus Manual}.
@node Gnus does not work with NNTP
diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi
index 625e9549444..4a873490e86 100644
--- a/doc/misc/flymake.texi
+++ b/doc/misc/flymake.texi
@@ -11,7 +11,7 @@
This manual is for GNU Flymake (version @value{VERSION}, @value{UPDATED}),
which is a universal on-the-fly syntax checker for GNU Emacs.
-Copyright @copyright{} 2004-2011
+Copyright @copyright{} 2004-2012
Free Software Foundation, Inc.
@quotation
@@ -337,6 +337,17 @@ been reported.
A custom face for highlighting lines for which at least one warning
and no errors have been reported.
+@item flymake-error-bitmap
+A bitmap used in the fringe to mark lines for which an error has
+been reported.
+
+@item flymake-warning-bitmap
+A bitmap used in the fringe to mark lines for which a warning has
+been reported.
+
+@item flymake-fringe-indicator-position
+Which fringe (if any) should show the warning/error bitmaps.
+
@end table
@node Adding support for a new syntax check tool
@@ -449,10 +460,10 @@ Finally, we add an entry to @code{flymake-err-line-patterns}:
@cindex Adding support for C (gcc+make)
In this example we will add support for C files syntax checked by
-@code{gcc} called via @code{make}.
+@command{gcc} called via @command{make}.
We're not required to write any new functions, as Flymake already has
-functions for @code{make}. We just add a new entry to the
+functions for @command{make}. We just add a new entry to the
@code{flymake-allowed-file-name-masks}:
@lisp
@@ -464,7 +475,7 @@ functions for @code{make}. We just add a new entry to the
flymake-allowed-file-name-masks))
@end lisp
-@code{flymake-simple-make-init} builds the following @code{make}
+@code{flymake-simple-make-init} builds the following @command{make}
command line:
@lisp
@@ -486,9 +497,17 @@ check-syntax:
gcc -o /dev/null -S ${CHK_SOURCES}
@end verbatim
-The format of error messages reported by @code{gcc} is already
+@noindent
+The format of error messages reported by @command{gcc} is already
supported by Flymake, so we don't have to add a new entry to
-@code{flymake-err-line-patterns}.
+@code{flymake-err-line-patterns}. Note that if you are using
+Automake, you may want to replace @code{gcc} with the standard
+Automake variable @code{COMPILE}:
+
+@verbatim
+check-syntax:
+ $(COMPILE) -o /dev/null -S ${CHK_SOURCES}
+@end verbatim
@node Flymake Implementation
@chapter Flymake Implementation
@@ -548,9 +567,9 @@ These modes are handled inside init/cleanup/getfname functions, see
@ref{Adding support for a new syntax check tool}.
Flymake contains implementations of all functionality required to
-support different syntax check modes described above (making
-temporary copies, finding master files, etc.), as well as some
-tool-specific (routines for @code{make}, @code{Ant}, etc.) code.
+support different syntax check modes described above (making temporary
+copies, finding master files, etc.), as well as some tool-specific
+(routines for Make, Ant, etc.) code.
@node Making a temporary copy
@@ -626,8 +645,8 @@ Therefore, a customizable variable
way to implement the desired behavior.
The default implementation, @code{flymake-get-project-include-dirs-imp},
-uses a @code{make} call. This requires a correct base directory, that is, a
-directory containing a correct @code{Makefile}, to be determined.
+uses a @command{make} call. This requires a correct base directory, that is, a
+directory containing a correct @file{Makefile}, to be determined.
As obtaining the project include directories might be a costly operation, its
return value is cached in the hash table. The cache is cleared in the beginning
@@ -641,16 +660,16 @@ of every syntax check attempt.
Flymake can be configured to use different tools for performing syntax
checks. For example, it can use direct compiler call to syntax check a perl
-script or a call to @code{make} for a more complicated case of a
+script or a call to @command{make} for a more complicated case of a
@code{C/C++} source. The general idea is that simple files, like perl
scripts and html pages, can be checked by directly invoking a
corresponding tool. Files that are usually more complex and generally
used as part of larger projects, might require non-trivial options to
be passed to the syntax check tool, like include directories for
C++. The latter files are syntax checked using some build tool, like
-@code{make} or @code{Ant}.
+Make or Ant.
-All @code{make} configuration data is usually stored in a file called
+All Make configuration data is usually stored in a file called
@code{Makefile}. To allow for future extensions, flymake uses a notion of
buildfile to reference the 'project configuration' file.
@@ -710,6 +729,15 @@ are used: @code{flymake-errline} and
@code{flymake-warnline}. Errors belonging outside the current
buffer are considered to belong to line 1 of the current buffer.
+@c This manual does not use vindex.
+@c @vindex flymake-fringe-indicator-position
+@c @vindex flymake-error-bitmap
+@c @vindex flymake-warning-bitmap
+If the option @code{flymake-fringe-indicator-position} is non-@code{nil},
+errors and warnings are also highlighted in the left or right fringe,
+using the bitmaps specified by @code{flymake-error-bitmap}
+and @code{flymake-warning-bitmap}.
+
@node Interaction with other modes
@section Interaction with other modes
@cindex Interaction with other modes
diff --git a/doc/misc/forms.texi b/doc/misc/forms.texi
index 17c1d7feaf0..11c3782dd7e 100644
--- a/doc/misc/forms.texi
+++ b/doc/misc/forms.texi
@@ -18,7 +18,7 @@
@copying
This file documents Forms mode, a form-editing major mode for GNU Emacs.
-Copyright @copyright{} 1989, 1997, 2001-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1989, 1997, 2001-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -170,8 +170,8 @@ of the buffer are parsed using the specifications in
@code{forms-format-list}, and the data file is updated. If the record
has fields that aren't included in the display, they are not changed.
-@vindex forms-mode-hooks
-Entering Forms mode runs the normal hook @code{forms-mode-hooks} to
+@vindex forms-mode-hook
+Entering Forms mode runs the normal hook @code{forms-mode-hook} to
perform user-defined customization.
To save any modified data, you can use @kbd{C-x C-s}
@@ -861,7 +861,7 @@ you said `no'.
@chapter Long Example
The following example exploits most of the features of Forms mode.
-This example is included in the distribution as file @file{forms-d2.el}.
+This example is included in the distribution as file @file{etc/forms/forms-d2.el}.
@example
;; demo2 -- demo forms-mode -*- emacs-lisp -*-
@@ -869,7 +869,8 @@ This example is included in the distribution as file @file{forms-d2.el}.
;; @r{This sample forms exploit most of the features of forms mode.}
;; @r{Set the name of the data file.}
-(setq forms-file "forms-d2.dat")
+(setq forms-file
+ (expand-file-name "forms/forms-d2.dat" data-directory))
;; @r{Use @code{forms-enumerate} to set field names and number thereof.}
(setq forms-number-of-fields
diff --git a/doc/misc/gnus-coding.texi b/doc/misc/gnus-coding.texi
index a79c68f0123..bbaf2c068da 100644
--- a/doc/misc/gnus-coding.texi
+++ b/doc/misc/gnus-coding.texi
@@ -7,7 +7,7 @@
@syncodeindex pg cp
@copying
-Copyright @copyright{} 2004-2005, 2007-2011 Free Software
+Copyright @copyright{} 2004-2005, 2007-2012 Free Software
Foundation, Inc.
@quotation
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi
index 7bd3e4ac7fa..6c2946549e8 100644
--- a/doc/misc/gnus-faq.texi
+++ b/doc/misc/gnus-faq.texi
@@ -1,7 +1,7 @@
@c \input texinfo @c -*-texinfo-*-
@c Uncomment 1st line before texing this file alone.
@c %**start of header
-@c Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
@c
@setfilename gnus-faq.info
@settitle Frequently Asked Questions
@@ -161,7 +161,7 @@ Where and how to get Gnus?
@subsubheading Answer
Gnus is released independent from releases of Emacs and XEmacs.
-Therefore, the version bundled with Emacs or the version in XEmacs'
+Therefore, the version bundled with Emacs or the version in XEmacs's
package system might not be up to date (e.g. Gnus 5.9 bundled with Emacs
21 is outdated).
You can get the latest released version of Gnus from
@@ -407,7 +407,7 @@ you want, so let's do it the correct way.
The first thing you've got to do is to
create a suitable directory (no blanks in directory name
please) e.g. c:\myhome. Then you must set the environment
-variable HOME to this directory. To do this under Win9x
+variable HOME to this directory. To do this under Windows 9x
or Me include the line
@example
@@ -2109,12 +2109,11 @@ I can't find anything in the Gnus manual about X
@subsubheading Answer
-There's not only the Gnus manual but also the manuals
-for message, emacs-mime, sieve and pgg. Those packages
-are distributed with Gnus and used by Gnus but aren't
-really part of core Gnus, so they are documented in
-different info files, you should have a look in those
-manuals, too.
+There's not only the Gnus manual but also the manuals for message,
+emacs-mime, sieve, EasyPG Assistant, and pgg. Those packages are
+distributed with Gnus and used by Gnus but aren't really part of core
+Gnus, so they are documented in different info files, you should have
+a look in those manuals, too.
@node FAQ 8-3
@subsubheading Question 8.3
diff --git a/doc/misc/gnus-news.el b/doc/misc/gnus-news.el
index 485e7ce4646..0c083c85a4d 100644
--- a/doc/misc/gnus-news.el
+++ b/doc/misc/gnus-news.el
@@ -1,5 +1,5 @@
;;; gnus-news.el --- a hack to create GNUS-NEWS from texinfo source
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Reiner Steib <Reiner.Steib@gmx.de>
;; Keywords: tools
@@ -26,7 +26,7 @@
(defvar gnus-news-header-disclaimer
"GNUS NEWS -- history of user-visible changes.
-Copyright (C) 1999-2011 Free Software Foundation, Inc.
+Copyright (C) 1999-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Gnus bug reports to bugs@gnus.org.
diff --git a/doc/misc/gnus-news.texi b/doc/misc/gnus-news.texi
index 612ea14e2cf..19bbe01667c 100644
--- a/doc/misc/gnus-news.texi
+++ b/doc/misc/gnus-news.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
-@c Copyright (C) 2004-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2004-2012 Free Software Foundation, Inc.
@c Permission is granted to anyone to make or distribute verbatim copies
@c of this document as received, in any medium, provided that the
@@ -44,7 +44,7 @@ for more information about nntp marks. Note that downgrading isn't
safe in general.
@item Incompatibility when switching from Emacs 23 to Emacs 22
-In Emacs 23, Gnus uses Emacs' new internal coding system @code{utf-8-emacs}
+In Emacs 23, Gnus uses Emacs's new internal coding system @code{utf-8-emacs}
for saving articles drafts and @file{~/.newsrc.eld}. These files may not
be read correctly in Emacs 22 and below. If you want to use Gnus across
different Emacs versions, you may set @code{mm-auto-save-coding-system}
@@ -333,7 +333,7 @@ in the group buffer, see the variable @code{gnus-group-update-tool-bar}.
Its default value depends on your Emacs version.
@c FIXME: Document this in the manual
-@item You can change the location of XEmacs' toolbars in Gnus buffers.
+@item You can change the location of XEmacs's toolbars in Gnus buffers.
See @code{gnus-use-toolbar} and @code{message-use-toolbar}.
@end itemize
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 8ed57699df5..47ff355d946 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -8,10 +8,10 @@
@syncodeindex vr cp
@syncodeindex pg cp
-@documentencoding ISO-8859-1
+@documentencoding UTF-8
@copying
-Copyright @copyright{} 1995-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1995-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -399,7 +399,7 @@ This manual corresponds to Gnus v5.13
@item Message manual: Composing messages
@item Emacs-MIME: Composing messages; @acronym{MIME}-specific parts.
@item Sieve: Managing Sieve scripts in Emacs.
-@item PGG: @acronym{PGP/MIME} with Gnus.
+@item EasyPG: @acronym{PGP/MIME} with Gnus.
@item SASL: @acronym{SASL} authentication in Emacs.
@end itemize
@@ -426,7 +426,7 @@ Other related manuals
* Message:(message). Composing messages.
* Emacs-MIME:(emacs-mime). Composing messages; @acronym{MIME}-specific parts.
* Sieve:(sieve). Managing Sieve scripts in Emacs.
-* PGG:(pgg). @acronym{PGP/MIME} with Gnus.
+* EasyPG:(epa). @acronym{PGP/MIME} with Gnus.
* SASL:(sasl). @acronym{SASL} authentication in Emacs.
@detailmenu
@@ -663,7 +663,6 @@ Getting News
* Direct Functions:: Connecting directly to the server.
* Indirect Functions:: Connecting indirectly to the server.
* Common Variables:: Understood by several connection functions.
-* NNTP marks:: Storing marks for @acronym{NNTP} servers.
Getting Mail
@@ -816,7 +815,6 @@ Various
* Formatting Variables:: You can specify what buffers should look like.
* Window Layout:: Configuring the Gnus buffer windows.
* Faces and Fonts:: How to change how faces look.
-* Compilation:: How to speed Gnus up.
* Mode Lines:: Displaying information in the mode lines.
* Highlighting and Menus:: Making buffers look all nice and cozy.
* Daemons:: Gnus can do things behind your back.
@@ -907,7 +905,8 @@ New Features
* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7.
* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9.
* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11.
-* No Gnus:: Very punny.
+* No Gnus:: Very punny. Gnus 5.12/5.13
+* Ma Gnus:: Celebrating 25 years of Gnus.
Customization
@@ -1066,10 +1065,6 @@ you would typically set this variable to
(setq gnus-secondary-select-methods '((nnmbox "")))
@end lisp
-Note: the @acronym{NNTP} back end stores marks in marks files
-(@pxref{NNTP marks}). This feature makes it easy to share marks between
-several Gnus installations, but may slow down things a bit when fetching
-new articles. @xref{NNTP marks}, for more information.
@node The Server is Down
@@ -1328,7 +1323,7 @@ variable to @code{nil}.
@vindex gnus-auto-subscribed-categories
As if that wasn't enough, @code{gnus-auto-subscribed-categories} also
-allows you to specify that new groups should be subcribed based on the
+allows you to specify that new groups should be subscribed based on the
category their select methods belong to. The default is @samp{(mail
post-mail)}, meaning that all new groups from mail-like backends
should be subscribed automatically.
@@ -2884,7 +2879,7 @@ composed messages will be @code{Gcc}'d to the current group. If
generated, if @code{(gcc-self . "string")} is present, this string will
be inserted literally as a @code{gcc} header. This parameter takes
precedence over any default @code{Gcc} rules as described later
-(@pxref{Archived Messages}).
+(@pxref{Archived Messages}), with the exception for messages to resend.
@strong{Caveat}: Adding @code{(gcc-self . t)} to the parameter list of
@code{nntp} groups (or the like) isn't valid. An @code{nntp} server
@@ -3027,6 +3022,7 @@ like this in the group parameters:
@example
(posting-style
(name "Funky Name")
+ ("X-Message-SMTP-Method" "smtp smtp.example.org 587")
("X-My-Header" "Funky Value")
(signature "Funky Signature"))
@end example
@@ -3152,7 +3148,7 @@ following is added to a group parameter
@lisp
(gnus-summary-prepared-hook
- '(lambda nil (local-set-key "d" (local-key-binding "n"))))
+ (lambda nil (local-set-key "d" (local-key-binding "n"))))
@end lisp
when the group is entered, the 'd' key will not mark the article as
@@ -3180,15 +3176,20 @@ For example:
(to-group . "\\1"))
("mail\\.me"
- (gnus-use-scoring t))
+ (gnus-use-scoring t))
("list\\..*"
(total-expire . t)
(broken-reply-to . t))))
@end lisp
-String value of parameters will be subjected to regexp substitution, as
-the @code{to-group} example shows.
+All clauses that matches the group name will be used, but the last
+setting ``wins''. So if you have two clauses that both match the
+group name, and both set, say @code{display}, the last setting will
+override the first.
+
+Parameters that are strings will be subjected to regexp substitution,
+as the @code{to-group} example shows.
@vindex gnus-parameters-case-fold-search
By default, whether comparing the group name and one of those regexps
@@ -4288,12 +4289,11 @@ default is @code{nil} in Emacs, or is the aliasee of the coding system
named @code{file-name} (a certain coding system of which an alias is
@code{file-name}) in XEmacs.
-The @code{nnml} back end, the @code{nnrss} back end, the @acronym{NNTP}
-marks feature (@pxref{NNTP marks}), the agent, and the cache use
-non-@acronym{ASCII} group names in those files and directories. This
-variable overrides the value of @code{file-name-coding-system} which
-specifies the coding system used when encoding and decoding those file
-names and directory names.
+The @code{nnml} back end, the @code{nnrss} back end, the agent, and
+the cache use non-@acronym{ASCII} group names in those files and
+directories. This variable overrides the value of
+@code{file-name-coding-system} which specifies the coding system used
+when encoding and decoding those file names and directory names.
In XEmacs (with the @code{mule} feature), @code{file-name-coding-system}
is the only means to specify the coding system used to encode and decode
@@ -4583,6 +4583,11 @@ trick:
"")))
@end lisp
+To see what variables are dynamically bound (like
+@code{gnus-tmp-group}), you have to look at the source code. The
+variable names aren't guaranteed to be stable over Gnus versions,
+either.
+
@node File Commands
@subsection File Commands
@@ -8976,7 +8981,7 @@ Translate many non-@acronym{ASCII} characters into their
@acronym{ASCII} equivalents (@code{gnus-article-treat-non-ascii}).
This is mostly useful if you're on a terminal that has a limited font
and doesn't show accented characters, ``advanced'' punctuation, and the
-like. For instance, @samp{} is translated into @samp{>>}, and so on.
+like. For instance, @samp{»} is translated into @samp{>>}, and so on.
@item W Y f
@kindex W Y f (Summary)
@@ -10809,12 +10814,6 @@ buffers. For example:
Also @pxref{Group Parameters}.
-@vindex gnus-propagate-marks
-@item gnus-propagate-marks
-If non-@code{nil}, propagate marks to the backends for possible
-storing. @xref{NNTP marks}, and friends, for a more fine-grained
-sieve.
-
@end table
@@ -12394,32 +12393,25 @@ value suitable for your system.
@xref{Mail Variables, ,Mail Variables,message,Message manual}, for more
information.
+
@node POP before SMTP
@section POP before SMTP
@cindex pop before smtp
-@findex message-smtpmail-send-it
@findex mail-source-touch-pop
-Does your @acronym{ISP} require the @acronym{POP}-before-@acronym{SMTP}
-authentication? It is whether you need to connect to the @acronym{POP}
-mail server within a certain time before sending mails. If so, there is
-a convenient way. To do that, put the following lines in your
-@file{~/.gnus.el} file:
+Does your @acronym{ISP} use @acronym{POP}-before-@acronym{SMTP}
+authentication? This authentication method simply requires you to
+contact the @acronym{POP} server before sending email. To do that,
+put the following lines in your @file{~/.gnus.el} file:
@lisp
-(setq message-send-mail-function 'message-smtpmail-send-it)
(add-hook 'message-send-mail-hook 'mail-source-touch-pop)
@end lisp
@noindent
-It means to let Gnus connect to the @acronym{POP} mail server in advance
-whenever you send a mail. The @code{mail-source-touch-pop} function
-does only a @acronym{POP} authentication according to the value of
-@code{mail-sources} without fetching mails, just before sending a mail.
-Note that you have to use @code{message-smtpmail-send-it} which runs
-@code{message-send-mail-hook} rather than @code{smtpmail-send-it} and
-set the value of @code{mail-sources} for a @acronym{POP} connection
-correctly. @xref{Mail Sources}.
+The @code{mail-source-touch-pop} function does @acronym{POP}
+authentication according to the value of @code{mail-sources} without
+fetching mails, just before sending a mail. @xref{Mail Sources}.
If you have two or more @acronym{POP} mail servers set in
@code{mail-sources}, you may want to specify one of them to
@@ -12447,6 +12439,7 @@ Otherwise, bind it dynamically only when performing the
(mail-source-touch-pop))))
@end lisp
+
@node Mail and Post
@section Mail and Post
@@ -12521,8 +12514,8 @@ mode buffers.
Gnus provides a few different methods for storing the mail and news you
send. The default method is to use the @dfn{archive virtual server} to
store the messages. If you want to disable this completely, the
-@code{gnus-message-archive-group} variable should be @code{nil}, which
-is the default.
+@code{gnus-message-archive-group} variable should be @code{nil}. The
+default is "sent.%Y-%m", which gives you one archive group per month.
For archiving interesting messages in a group you read, see the
@kbd{B c} (@code{gnus-summary-copy-article}) command (@pxref{Mail
@@ -12664,6 +12657,35 @@ and matches the Gcc group name, attach files as external parts; if it is
non-@code{nil}, the behavior is the same as @code{all}, but it may be
changed in the future.
+@item gnus-gcc-self-resent-messages
+@vindex gnus-gcc-self-resent-messages
+Like the @code{gcc-self} group parameter, applied only for unmodified
+messages that @code{gnus-summary-resend-message} (@pxref{Summary Mail
+Commands}) resends. Non-@code{nil} value of this variable takes
+precedence over any existing @code{Gcc} header.
+
+If this is @code{none}, no @code{Gcc} copy will be made. If this is
+@code{t}, messages resent will be @code{Gcc} copied to the current
+group. If this is a string, it specifies a group to which resent
+messages will be @code{Gcc} copied. If this is @code{nil}, @code{Gcc}
+will be done according to existing @code{Gcc} header(s), if any. If
+this is @code{no-gcc-self}, that is the default, resent messages will be
+@code{Gcc} copied to groups that existing @code{Gcc} header specifies,
+except for the current group.
+
+@item gnus-gcc-pre-body-encode-hook
+@vindex gnus-gcc-pre-body-encode-hook
+@itemx gnus-gcc-post-body-encode-hook
+@vindex gnus-gcc-post-body-encode-hook
+
+These hooks are run before/after encoding the message body of the Gcc
+copy of a sent message. 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. You can use these hooks to edit the copy (and influence
+subsequent transformations), e.g. remove MML secure tags
+(@pxref{Signing and encrypting}).
+
@end table
@@ -12758,8 +12780,8 @@ from date id references chars lines xref extra.
In the case of a string value, if the @code{match} is a regular
expression, a @samp{gnus-match-substitute-replacement} is proceed on
the value to replace the positional parameters @samp{\@var{n}} by the
-corresponding parenthetical matches (see @xref{Replacing the Text that
-Matched, , Text Replacement, elisp, The Emacs Lisp Reference Manual}.)
+corresponding parenthetical matches (see @xref{Replacing Match,,
+Replacing the Text that Matched, elisp, The Emacs Lisp Reference Manual}.)
@vindex message-reply-headers
@@ -12795,6 +12817,7 @@ So here's a new example:
(signature-file "~/.work-signature")
(address "user@@bar.foo")
(body "You are fired.\n\nSincerely, your boss.")
+ ("X-Message-SMTP-Method" "smtp smtp.example.org 587")
(organization "Important Work, Inc"))
("nnml:.*"
(From (with-current-buffer gnus-article-buffer
@@ -12809,6 +12832,13 @@ if you fill many roles.
You may also use @code{message-alternative-emails} instead.
@xref{Message Headers, ,Message Headers, message, Message Manual}.
+Of particular interest in the ``work-mail'' style is the
+@samp{X-Message-SMTP-Method} header. It specifies how to send the
+outgoing email. You may want to sent certain emails through certain
+@acronym{SMTP} servers due to company policies, for instance.
+@xref{Mail Variables, ,Message Variables, message, Message Manual}.
+
+
@node Drafts
@section Drafts
@cindex drafts
@@ -13734,7 +13764,6 @@ don't update their active files often, this can help.
* Direct Functions:: Connecting directly to the server.
* Indirect Functions:: Connecting indirectly to the server.
* Common Variables:: Understood by several connection functions.
-* NNTP marks:: Storing marks for @acronym{NNTP} servers.
@end menu
@@ -14005,53 +14034,6 @@ is @samp{()}.
@end table
-@node NNTP marks
-@subsubsection NNTP marks
-@cindex storing NNTP marks
-
-Gnus stores marks (@pxref{Marking Articles}) for @acronym{NNTP}
-servers in marks files. A marks file records what marks you have set
-in a group and each file is specific to the corresponding server.
-Marks files are stored in @file{~/News/marks}
-(@code{nntp-marks-directory}) under a classic hierarchy resembling
-that of a news server, for example marks for the group
-@samp{gmane.discuss} on the news.gmane.org server will be stored in
-the file @file{~/News/marks/news.gmane.org/gmane/discuss/.marks}.
-
-Marks files are useful because you can copy the @file{~/News/marks}
-directory (using rsync, scp or whatever) to another Gnus installation,
-and it will realize what articles you have read and marked. The data
-in @file{~/News/marks} has priority over the same data in
-@file{~/.newsrc.eld}.
-
-Note that marks files are very much server-specific: Gnus remembers
-the article numbers so if you don't use the same servers on both
-installations things are most likely to break (most @acronym{NNTP}
-servers do not use the same article numbers as any other server).
-However, if you use servers A, B, C on one installation and servers A,
-D, E on the other, you can sync the marks files for A and then you'll
-get synchronization for that server between the two installations.
-
-Using @acronym{NNTP} marks can possibly incur a performance penalty so
-if Gnus feels sluggish, try setting the @code{nntp-marks-is-evil}
-variable to @code{t}. Marks will then be stored in @file{~/.newsrc.eld}.
-
-Related variables:
-
-@table @code
-
-@item nntp-marks-is-evil
-@vindex nntp-marks-is-evil
-If non-@code{nil}, this back end will ignore any marks files. The
-default is @code{nil}.
-
-@item nntp-marks-directory
-@vindex nntp-marks-directory
-The directory where marks for nntp groups will be stored.
-
-@end table
-
-
@node News Spool
@subsection News Spool
@cindex nnspool
@@ -14222,8 +14204,9 @@ if the server supports UID EXPUNGE, but it's not done by default on
servers that doesn't support that command.
@item nnimap-streaming
-Virtually all @code{IMAP} server support fast streaming of data. If
-you have problems connecting to the server, try setting this to @code{nil}.
+Virtually all @acronym{IMAP} server support fast streaming of data.
+If you have problems connecting to the server, try setting this to
+@code{nil}.
@item nnimap-fetch-partial-articles
If non-@code{nil}, fetch partial articles from the server. If set to
@@ -14231,6 +14214,10 @@ a string, then it's interpreted as a regexp, and parts that have
matching types will be fetched. For instance, @samp{"text/"} will
fetch all textual parts, while leaving the rest on the server.
+@item nnimap-record-commands
+If non-@code{nil}, record all @acronym{IMAP} commands in the
+@samp{"*imap log*"} buffer.
+
@end table
@@ -14746,6 +14733,18 @@ corresponding keywords.
A script to be run before fetching the mail. The syntax is the same as
the @code{:program} keyword. This can also be a function to be run.
+One popular way to use this is to set up an SSH tunnel to access the
+@acronym{POP} server. Here's an example:
+
+@lisp
+(pop :server "127.0.0.1"
+ :port 1234
+ :user "foo"
+ :password "secret"
+ :prescript
+ "nohup ssh -f -L 1234:pop.server:110 remote.host sleep 3600 &")
+@end lisp
+
@item :postscript
A script to be run after fetching the mail. The syntax is the same as
the @code{:program} keyword. This can also be a function to be run.
@@ -14760,20 +14759,37 @@ This can be either the symbol @code{password} or the symbol @code{apop}
and says what authentication scheme to use. The default is
@code{password}.
+@item :leave
+Non-@code{nil} if the mail is to be left on the @acronym{POP} server
+after fetching. Mails once fetched will never be fetched again by the
+@acronym{UIDL} control. Only the built-in @code{pop3-movemail} program
+(the default) supports this keyword.
+
+If this is neither @code{nil} nor a number, all mails will be left on
+the server. If this is a number, leave mails on the server for this
+many days since you first checked new mails. If this is @code{nil}
+(the default), mails will be deleted on the server right after fetching.
+
+@vindex pop3-uidl-file
+The @code{pop3-uidl-file} variable specifies the file to which the
+@acronym{UIDL} data are locally stored. The default value is
+@file{~/.pop3-uidl}.
+
+Note that @acronym{POP} servers maintain no state information between
+sessions, so what the client believes is there and what is actually
+there may not match up. If they do not, then you may get duplicate
+mails or the whole thing can fall apart and leave you with a corrupt
+mailbox.
+
@end table
-@vindex pop3-movemail
+@findex pop3-movemail
@vindex pop3-leave-mail-on-server
If the @code{:program} and @code{:function} keywords aren't specified,
-@code{pop3-movemail} will be used. If @code{pop3-leave-mail-on-server}
-is non-@code{nil} the mail is to be left on the @acronym{POP} server
-after fetching when using @code{pop3-movemail}. Note that POP servers
-maintain no state information between sessions, so what the client
-believes is there and what is actually there may not match up. If they
-do not, then you may get duplicate mails or the whole thing can fall
-apart and leave you with a corrupt mailbox.
+@code{pop3-movemail} will be used.
Here are some examples for getting mail from a @acronym{POP} server.
+
Fetch from the default @acronym{POP} server, using the default user
name, and default fetcher:
@@ -14788,6 +14804,14 @@ Fetch from a named server with a named user and password:
:user "user-name" :password "secret")
@end lisp
+Leave mails on the server for 14 days:
+
+@lisp
+(pop :server "my.pop.server"
+ :user "user-name" :password "secret"
+ :leave 14)
+@end lisp
+
Use @samp{movemail} to move the mail:
@lisp
@@ -15033,7 +15057,7 @@ number.
@item mail-source-default-file-modes
@vindex mail-source-default-file-modes
-All new mail files will get this file mode. The default is 384.
+All new mail files will get this file mode. The default is @code{#o600}.
@item mail-source-movemail-program
@vindex mail-source-movemail-program
@@ -15123,10 +15147,10 @@ default file modes the new mail files get:
@lisp
(add-hook 'nnmail-pre-get-new-mail-hook
- (lambda () (set-default-file-modes 511)))
+ (lambda () (set-default-file-modes #o700)))
(add-hook 'nnmail-post-get-new-mail-hook
- (lambda () (set-default-file-modes 551)))
+ (lambda () (set-default-file-modes #o775)))
@end lisp
@item nnmail-use-long-file-names
@@ -16125,22 +16149,6 @@ splitting. It has to create lots of files, and it also generates
@acronym{NOV} databases for the incoming mails. This makes it possibly the
fastest back end when it comes to reading mail.
-@cindex self contained nnml servers
-@cindex marks
-When the marks file is used (which it is by default), @code{nnml}
-servers have the property that you may backup them using @code{tar} or
-similar, and later be able to restore them into Gnus (by adding the
-proper @code{nnml} server) and have all your marks be preserved. Marks
-for a group are usually stored in the @code{.marks} file (but see
-@code{nnml-marks-file-name}) within each @code{nnml} group's directory.
-Individual @code{nnml} groups are also possible to backup, use @kbd{G m}
-to restore the group (after restoring the backup into the nnml
-directory).
-
-If for some reason you believe your @file{.marks} files are screwed
-up, you can just delete them all. Gnus will then correctly regenerate
-them next time it starts.
-
Virtual server settings:
@table @code
@@ -16178,15 +16186,6 @@ The name of the @acronym{NOV} files. The default is @file{.overview}.
@vindex nnml-prepare-save-mail-hook
Hook run narrowed to an article before saving.
-@item nnml-marks-is-evil
-@vindex nnml-marks-is-evil
-If non-@code{nil}, this back end will ignore any @sc{marks} files. The
-default is @code{nil}.
-
-@item nnml-marks-file-name
-@vindex nnml-marks-file-name
-The name of the @dfn{marks} files. The default is @file{.marks}.
-
@item nnml-use-compressed-files
@vindex nnml-use-compressed-files
If non-@code{nil}, @code{nnml} will allow using compressed message
@@ -16527,19 +16526,6 @@ separate file. Each file is in the standard Un*x mbox format.
@code{nnfolder} will add extra headers to keep track of article
numbers and arrival dates.
-@cindex self contained nnfolder servers
-@cindex marks
-When the marks file is used (which it is by default), @code{nnfolder}
-servers have the property that you may backup them using @code{tar} or
-similar, and later be able to restore them into Gnus (by adding the
-proper @code{nnfolder} server) and have all your marks be preserved.
-Marks for a group are usually stored in a file named as the mbox file
-with @code{.mrk} concatenated to it (but see
-@code{nnfolder-marks-file-suffix}) within the @code{nnfolder}
-directory. Individual @code{nnfolder} groups are also possible to
-backup, use @kbd{G m} to restore the group (after restoring the backup
-into the @code{nnfolder} directory).
-
Virtual server settings:
@table @code
@@ -16598,20 +16584,6 @@ The extension for @acronym{NOV} files. The default is @file{.nov}.
The directory where the @acronym{NOV} files should be stored. If
@code{nil}, @code{nnfolder-directory} is used.
-@item nnfolder-marks-is-evil
-@vindex nnfolder-marks-is-evil
-If non-@code{nil}, this back end will ignore any @sc{marks} files. The
-default is @code{nil}.
-
-@item nnfolder-marks-file-suffix
-@vindex nnfolder-marks-file-suffix
-The extension for @sc{marks} files. The default is @file{.mrk}.
-
-@item nnfolder-marks-directory
-@vindex nnfolder-marks-directory
-The directory where the @sc{marks} files should be stored. If
-@code{nil}, @code{nnfolder-directory} is used.
-
@end table
@@ -16674,7 +16646,7 @@ was used for mail landing on the system, but Babyl had its own internal
format to which mail was converted, primarily involving creating a
spool-file-like entity with a scheme for inserting Babyl-specific
headers and status bits above the top of each message in the file.
-Rmail was Emacs' first mail reader, it was written by Richard Stallman,
+Rmail was Emacs's first mail reader, it was written by Richard Stallman,
and Stallman came out of that TOPS/Babyl environment, so he wrote Rmail
to understand the mail files folks already had in existence. Gnus (and
VM, for that matter) continue to support this format because it's
@@ -16772,9 +16744,7 @@ undergo treatment such as duplicate checking.
@code{nnmaildir} stores article marks for a given group in the
corresponding maildir, in a way designed so that it's easy to manipulate
them from outside Gnus. You can tar up a maildir, unpack it somewhere
-else, and still have your marks. @code{nnml} also stores marks, but
-it's not as easy to work with them from outside Gnus as with
-@code{nnmaildir}.
+else, and still have your marks.
@code{nnmaildir} uses a significant amount of memory to speed things up.
(It keeps in memory some of the things that @code{nnml} stores in files
@@ -16866,16 +16836,6 @@ adding a server definition pointing to that directory in Gnus. The
might interfere with overwriting data, so you may want to shut down Gnus
before you restore the data.
-It is also possible to archive individual @code{nnml},
-@code{nnfolder}, or @code{nnmaildir} groups, while preserving marks.
-For @code{nnml} or @code{nnmaildir}, you copy all files in the group's
-directory. For @code{nnfolder} you need to copy both the base folder
-file itself (@file{FOO}, say), and the marks file (@file{FOO.mrk} in
-this example). Restoring the group is done with @kbd{G m} from the Group
-buffer. The last step makes Gnus notice the new directory.
-@code{nnmaildir} notices the new directory automatically, so @kbd{G m}
-is unnecessary in that case.
-
@node Web Searches
@subsection Web Searches
@cindex nnweb
@@ -18231,8 +18191,7 @@ Agent. Go to the server buffer (@kbd{^} in the group buffer) and press
@kbd{J a} on the server (or servers) that you wish to have covered by the
Agent (@pxref{Server Agent Commands}), or @kbd{J r} on automatically
added servers you do not wish to have covered by the Agent. By default,
-all @code{nntp} and @code{nnimap} servers in @code{gnus-select-method} and
-@code{gnus-secondary-select-methods} are agentized.
+no servers are agentized.
@item
Decide on download policy. It's fairly simple once you decide whether
@@ -19258,7 +19217,7 @@ to agentize remote back ends. The auto-agentizing has the same effect
as running @kbd{J a} on the servers (@pxref{Server Agent Commands}).
If the file exist, you must manage the servers manually by adding or
removing them, this variable is only applicable the first time you
-start Gnus. The default is @samp{(nntp nnimap)}.
+start Gnus. The default is @samp{nil}.
@end table
@@ -20043,7 +20002,7 @@ matches will use the @code{Message-ID}s of these matching articles.)
This will ensure that you can raise/lower the score of an entire thread,
even though some articles in the thread may not have complete
@code{References} headers. Note that using this may lead to
-undeterministic scores of the articles in the thread. (Using this match
+nondeterministic scores of the articles in the thread. (Using this match
key will lead to creation of @file{ADAPT} files.)
@end table
@end enumerate
@@ -20849,7 +20808,7 @@ then this operator will return @code{false}.
@item !
@itemx not
-@itemx
+@itemx ¬
This logical operator only takes a single argument. It returns the
logical negation of the value of its argument.
@@ -21019,7 +20978,7 @@ and `gnus-score-decay-scale'."
(* (abs score)
gnus-score-decay-scale)))))))
(if (and (featurep 'xemacs)
- ;; XEmacs' floor can handle only the floating point
+ ;; XEmacs's floor can handle only the floating point
;; number below the half of the maximum integer.
(> (abs n) (lsh -1 -2)))
(string-to-number
@@ -22125,8 +22084,8 @@ to you, using @kbd{G b u} and updating the group will usually fix this.
@include emacs-mime.texi
@chapter Sieve
@include sieve.texi
-@chapter PGG
-@include pgg.texi
+@chapter EasyPG
+@include epa.texi
@chapter SASL
@include sasl.texi
@end iflatex
@@ -22142,7 +22101,6 @@ to you, using @kbd{G b u} and updating the group will usually fix this.
* Formatting Variables:: You can specify what buffers should look like.
* Window Layout:: Configuring the Gnus buffer windows.
* Faces and Fonts:: How to change how faces look.
-* Compilation:: How to speed Gnus up.
* Mode Lines:: Displaying information in the mode lines.
* Highlighting and Menus:: Making buffers look all nice and cozy.
* Daemons:: Gnus can do things behind your back.
@@ -22439,11 +22397,6 @@ than 6 characters to make it look nice in columns.)
Ignoring is done first; then cutting; then maxing; and then as the very
last operation, padding.
-If you use lots of these advanced thingies, you'll find that Gnus gets
-quite slow. This can be helped enormously by running @kbd{M-x
-gnus-compile} when you are satisfied with the look of your lines.
-@xref{Compilation}.
-
@node User-Defined Specs
@subsection User-Defined Specs
@@ -22489,7 +22442,7 @@ and so on. Create as many faces as you wish. The same goes for the
@samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}.
@cindex %<<, %>>, guillemets
-@c @cindex %<<, %>>, %, %, guillemets
+@c @cindex %<<, %>>, %«, %», guillemets
@vindex gnus-balloon-face-0
Text inside the @samp{%<<} and @samp{%>>} specifiers will get the
special @code{balloon-help} property set to
@@ -22952,30 +22905,6 @@ the face you want to alter, and alter it via the standard Customize
interface.
-@node Compilation
-@section Compilation
-@cindex compilation
-@cindex byte-compilation
-
-@findex gnus-compile
-
-Remember all those line format specification variables?
-@code{gnus-summary-line-format}, @code{gnus-group-line-format}, and so
-on. Now, Gnus will of course heed whatever these variables are, but,
-unfortunately, changing them will mean a quite significant slow-down.
-(The default values of these variables have byte-compiled functions
-associated with them, while the user-generated versions do not, of
-course.)
-
-To help with this, you can run @kbd{M-x gnus-compile} after you've
-fiddled around with the variables and feel that you're (kind of)
-satisfied. This will result in the new specs being byte-compiled, and
-you'll get top speed again. Gnus will save these compiled specs in the
-@file{.newsrc.eld} file. (User-defined functions aren't compiled by
-this function, though---you should compile them yourself by sticking
-them into the @file{~/.gnus.el} file and byte-compiling that file.)
-
-
@node Mode Lines
@section Mode Lines
@cindex mode lines
@@ -23630,6 +23559,10 @@ The variable @code{gnus-picon-style} controls how picons are displayed.
If @code{inline}, the textual representation is replaced. If
@code{right}, picons are added right to the textual representation.
+@vindex gnus-picon-properties
+The value of the variable @code{gnus-picon-properties} is a list of
+properties applied to picons.
+
The following variables offer control over where things are located.
@table @code
@@ -26383,6 +26316,7 @@ renamed it back again to ``Gnus''. But in mixed case. ``Gnus'' vs.
@cindex Pterodactyl Gnus
@cindex Oort Gnus
@cindex No Gnus
+@cindex Ma Gnus
@cindex Gnus versions
The first ``proper'' release of Gnus 5 was done in November 1995 when it
@@ -26411,12 +26345,15 @@ On April 19, 2010 Gnus development was moved to Git. See
http://git.gnus.org for details (http://www.gnus.org will be updated
with the information when possible).
+On the January 31th 2012, Ma Gnus was begun.
+
If you happen upon a version of Gnus that has a prefixed name --
``(ding) Gnus'', ``September Gnus'', ``Red Gnus'', ``Quassia Gnus'',
-``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'' -- don't panic.
-Don't let it know that you're frightened. Back away. Slowly. Whatever
-you do, don't run. Walk away, calmly, until you're out of its reach.
-Find a proper released version of Gnus and snuggle up to that instead.
+``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'', ``Ma Gnus'' -- don't
+panic. Don't let it know that you're frightened. Back away. Slowly.
+Whatever you do, don't run. Walk away, calmly, until you're out of
+its reach. Find a proper released version of Gnus and snuggle up to
+that instead.
@node Why?
@@ -27019,7 +26956,8 @@ actually are people who are using Gnus. Who'd'a thunk it!
* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7.
* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9.
* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11.
-* No Gnus:: Very punny.
+* No Gnus:: Very punny. Gnus 5.12/5.13.
+* Ma Gnus:: Celebrating 25 years of Gnus.
@end menu
These lists are, of course, just @emph{short} overviews of the
@@ -28394,6 +28332,32 @@ New features in No Gnus:
@include gnus-news.texi
+@node Ma Gnus
+@subsubsection Ma Gnus
+@cindex Ma Gnus
+
+I'm sure there will be lots of text here. It's really spelled 真
+Gnus.
+
+New features in Ma Gnus:
+
+@itemize @bullet
+
+@item Changes in Message mode and related Gnus features
+@c ****************************************************
+
+@itemize @bullet
+
+@item
+The new hooks @code{gnus-gcc-pre-body-encode-hook} and
+@code{gnus-gcc-post-body-encode-hook} are run before/after encoding
+the message body of the Gcc copy of a sent message. See
+@xref{Archived Messages}.
+
+@end itemize
+
+@end itemize
+
@iftex
@page
@@ -30020,7 +29984,7 @@ Here's a typical score file:
@lisp
(("summary"
- ("win95" -10000 nil s)
+ ("Windows 95" -10000 nil s)
("Gnus"))
("from"
("Lars" -1000))
@@ -30616,5 +30580,5 @@ former). The manual is unambiguous, but it can be confusing.
@c Local Variables:
@c mode: texinfo
-@c coding: iso-8859-1
+@c coding: utf-8
@c End:
diff --git a/doc/misc/gpl.texi b/doc/misc/gpl.texi
index 1908d1f8f98..97a17e1914e 100644
--- a/doc/misc/gpl.texi
+++ b/doc/misc/gpl.texi
@@ -2,7 +2,7 @@
@center Version 3, 29 June 2007
@c This file is intended to be included within another document,
-@c hence no sectioning command or @node.
+@c hence no sectioning command or @node.
@display
Copyright @copyright{} 2007 Free Software Foundation, Inc. @url{http://fsf.org/}
@@ -222,7 +222,7 @@ terms of section 4, provided that you also meet all of these
conditions:
@enumerate a
-@item
+@item
The work must carry prominent notices stating that you modified it,
and giving a relevant date.
@@ -670,7 +670,7 @@ state the exclusion of warranty; and each file should have at least
the ``copyright'' line and a pointer to where the full notice is found.
@smallexample
-@var{one line to give the program's name and a brief idea of what it does.}
+@var{one line to give the program's name and a brief idea of what it does.}
Copyright (C) @var{year} @var{name of author}
This program is free software: you can redistribute it and/or modify
@@ -693,7 +693,7 @@ If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
@smallexample
-@var{program} Copyright (C) @var{year} @var{name of author}
+@var{program} Copyright (C) @var{year} @var{name of author}
This program comes with ABSOLUTELY NO WARRANTY; for details type @samp{show w}.
This is free software, and you are welcome to redistribute it
under certain conditions; type @samp{show c} for details.
diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi
index c7495d8cc93..feef325ad30 100644
--- a/doc/misc/idlwave.texi
+++ b/doc/misc/idlwave.texi
@@ -22,7 +22,7 @@ Emacs, and interacting with an IDL shell run as a subprocess.
This is edition @value{EDITION} of the IDLWAVE User Manual for IDLWAVE
@value{VERSION}.
-Copyright @copyright{} 1999-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1999-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -71,7 +71,7 @@ Interactive Data Language (IDL), and running IDL as an inferior shell.
* Getting Started:: Tutorial
* The IDLWAVE Major Mode:: The mode for editing IDL programs
* The IDLWAVE Shell:: The mode for running IDL as an inferior program
-* Acknowledgements:: Who did what
+* Acknowledgments:: Who did what
* Sources of Routine Info:: How does IDLWAVE know about routine XYZ
* HTML Help Browser Tips::
* Configuration Examples:: The user is king
@@ -2361,7 +2361,7 @@ Normal hook. Executed when a buffer is put into @code{idlwave-mode}.
Normal hook. Executed when @file{idlwave.el} is loaded.
@end defopt
-@node The IDLWAVE Shell, Acknowledgements, The IDLWAVE Major Mode, Top
+@node The IDLWAVE Shell, Acknowledgments, The IDLWAVE Major Mode, Top
@chapter The IDLWAVE Shell
@cindex IDLWAVE shell
@cindex Major mode, @code{idlwave-shell-mode}
@@ -3273,9 +3273,9 @@ examine command strings to send, after all instances of @code{___}
(three underscores) are replaced by the indicated expression.
@end defopt
-@node Acknowledgements, Sources of Routine Info, The IDLWAVE Shell, Top
-@chapter Acknowledgements
-@cindex Acknowledgements
+@node Acknowledgments, Sources of Routine Info, The IDLWAVE Shell, Top
+@chapter Acknowledgments
+@cindex Acknowledgments
@cindex Maintainer, of IDLWAVE
@cindex Authors, of IDLWAVE
@cindex Contributors, to IDLWAVE
@@ -3352,7 +3352,7 @@ scripts and documentation to interface with the IDL Assistant.
@noindent
Thanks to everyone!
-@node Sources of Routine Info, HTML Help Browser Tips, Acknowledgements, Top
+@node Sources of Routine Info, HTML Help Browser Tips, Acknowledgments, Top
@appendix Sources of Routine Info
@cindex Sources of routine information
@@ -4020,7 +4020,7 @@ user is King!
@end example
@html
-<A NAME="WIN_MAC"></A>
+<A NAME="WINDOWS_MAC"></A>
@end html
@node Windows and MacOS, Troubleshooting, Configuration Examples, Top
@appendix Windows and MacOS
@@ -4193,7 +4193,7 @@ installed. Many Emacsen come with an older bundled copy of IDLWAVE
(e.g. v4.7 for Emacs 21.x), which is likely what's being used instead.
You need to make sure your Emacs @emph{load-path} contains the directory
where IDLWAVE is installed (@file{/usr/local/share/emacs/site-lisp}, by
-default), @emph{before} Emacs' default search directories. You can
+default), @emph{before} Emacs's default search directories. You can
accomplish this by putting the following in your @file{.emacs}:
@lisp
diff --git a/doc/misc/info.texi b/doc/misc/info.texi
index 68390a2f0cc..8952bfb9122 100644
--- a/doc/misc/info.texi
+++ b/doc/misc/info.texi
@@ -14,8 +14,7 @@
This file describes how to use Info, the on-line, menu-driven GNU
documentation system.
-Copyright @copyright{} 1989, 1992, 1996-2011
-Free Software Foundation, Inc.
+Copyright @copyright{} 1989, 1992, 1996-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -1108,7 +1107,7 @@ In the stand-alone reader, @kbd{0} goes through the last menu item;
this is so you need not count how many entries are there.
If your display supports multiple fonts, colors or underlining, and
-you are using Emacs' Info mode to read Info files, the third, sixth
+you are using Emacs's Info mode to read Info files, the third, sixth
and ninth menu items have a @samp{*} that stands out, either in color
or in some other attribute, such as underline; this makes it easy to
see at a glance which number to use for an item.
@@ -1142,6 +1141,12 @@ prefix argument for the @kbd{C-h i} command (@code{info}) which
switches to the Info buffer with that number. Thus, @kbd{C-u 2 C-h i}
switches to the buffer @samp{*info*<2>}, creating it if necessary.
+@findex info-display-manual
+ If you have created many Info buffers in Emacs, you might find it
+difficult to remember which buffer is showing which manual. You can
+use the command @kbd{M-x info-display-manual} to show an Info manual
+by name, reusing an existing buffer if there is one.
+
@node Emacs Info Variables, , Create Info buffer, Advanced
@comment node-name, next, previous, up
@section Emacs Info-mode Variables
@@ -1230,6 +1235,7 @@ this:
@node Expert Info
@chapter Info for Experts
+@cindex Texinfo
This chapter explains how to write an Info file by hand. However,
in most cases, writing a Texinfo file is better, since you can use it
diff --git a/doc/misc/mairix-el.texi b/doc/misc/mairix-el.texi
index d64f316cb7b..468283ffd93 100644
--- a/doc/misc/mairix-el.texi
+++ b/doc/misc/mairix-el.texi
@@ -6,7 +6,7 @@
@documentencoding ISO-8859-1
@copying
-Copyright @copyright{} 2008-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 2008-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/makefile.w32-in b/doc/misc/makefile.w32-in
index 0edaf3db3d6..9e577c351b7 100644
--- a/doc/misc/makefile.w32-in
+++ b/doc/misc/makefile.w32-in
@@ -1,6 +1,6 @@
#### -*- Makefile -*- for documentation other than the Emacs manual.
-# Copyright (C) 2003-2011 Free Software Foundation, Inc.
+# Copyright (C) 2003-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -30,28 +30,31 @@ infodir = $(srcdir)/../../info
## Currently only used by efaq; could be added to MAKEINFO.
emacsdir = $(srcdir)/../emacs
+INFO_EXT=.info
+INFO_OPTS=--no-split
+
# The makeinfo program is part of the Texinfo distribution.
MAKEINFO = makeinfo
MAKEINFO_OPTS = --force -I$(emacsdir)
MULTI_INSTALL_INFO = $(srcdir)\..\..\nt\multi-install-info.bat
-INFO_TARGETS = $(infodir)/ccmode \
- $(infodir)/cl $(infodir)/dbus $(infodir)/dired-x \
- $(infodir)/ediff $(infodir)/forms $(infodir)/gnus \
- $(infodir)/message $(infodir)/sieve $(infodir)/pgg \
- $(infodir)/emacs-mime $(infodir)/info $(infodir)/mh-e \
- $(infodir)/reftex $(infodir)/sc $(infodir)/vip \
- $(infodir)/viper $(infodir)/widget $(infodir)/efaq \
- $(infodir)/ada-mode $(infodir)/autotype $(infodir)/calc \
- $(infodir)/idlwave $(infodir)/eudc $(infodir)/ebrowse \
- $(infodir)/pcl-cvs $(infodir)/woman $(infodir)/eshell \
- $(infodir)/org $(infodir)/url $(infodir)/speedbar \
- $(infodir)/tramp $(infodir)/ses $(infodir)/smtpmail \
- $(infodir)/flymake $(infodir)/newsticker $(infodir)/rcirc \
- $(infodir)/erc $(infodir)/ert \
- $(infodir)/remember $(infodir)/nxml-mode \
- $(infodir)/epa $(infodir)/mairix-el $(infodir)/sasl \
- $(infodir)/auth $(infodir)/eieio $(infodir)/ede \
- $(infodir)/semantic $(infodir)/edt
+INFO_TARGETS = $(infodir)/ccmode$(INFO_EXT) \
+ $(infodir)/cl$(INFO_EXT) $(infodir)/dbus$(INFO_EXT) $(infodir)/dired-x$(INFO_EXT) \
+ $(infodir)/ediff$(INFO_EXT) $(infodir)/forms$(INFO_EXT) $(infodir)/gnus$(INFO_EXT) \
+ $(infodir)/message$(INFO_EXT) $(infodir)/sieve$(INFO_EXT) $(infodir)/pgg$(INFO_EXT) \
+ $(infodir)/emacs-mime$(INFO_EXT) $(infodir)/info$(INFO_EXT) $(infodir)/mh-e$(INFO_EXT) \
+ $(infodir)/reftex$(INFO_EXT) $(infodir)/sc$(INFO_EXT) $(infodir)/vip$(INFO_EXT) \
+ $(infodir)/viper$(INFO_EXT) $(infodir)/widget$(INFO_EXT) $(infodir)/efaq$(INFO_EXT) \
+ $(infodir)/ada-mode$(INFO_EXT) $(infodir)/autotype$(INFO_EXT) $(infodir)/calc$(INFO_EXT) \
+ $(infodir)/idlwave$(INFO_EXT) $(infodir)/eudc$(INFO_EXT) $(infodir)/ebrowse$(INFO_EXT) \
+ $(infodir)/pcl-cvs$(INFO_EXT) $(infodir)/woman$(INFO_EXT) $(infodir)/eshell$(INFO_EXT) \
+ $(infodir)/org$(INFO_EXT) $(infodir)/url$(INFO_EXT) $(infodir)/speedbar$(INFO_EXT) \
+ $(infodir)/tramp$(INFO_EXT) $(infodir)/ses$(INFO_EXT) $(infodir)/smtpmail$(INFO_EXT) \
+ $(infodir)/flymake$(INFO_EXT) $(infodir)/newsticker$(INFO_EXT) $(infodir)/rcirc$(INFO_EXT) \
+ $(infodir)/erc$(INFO_EXT) $(infodir)/ert$(INFO_EXT) \
+ $(infodir)/remember$(INFO_EXT) $(infodir)/nxml-mode$(INFO_EXT) \
+ $(infodir)/epa$(INFO_EXT) $(infodir)/mairix-el$(INFO_EXT) $(infodir)/sasl$(INFO_EXT) \
+ $(infodir)/auth$(INFO_EXT) $(infodir)/eieio$(INFO_EXT) $(infodir)/ede$(INFO_EXT) \
+ $(infodir)/semantic$(INFO_EXT) $(infodir)/edt$(INFO_EXT) $(infodir)/emacs-gnutls$(INFO_EXT)
DVI_TARGETS = calc.dvi cc-mode.dvi cl.dvi dbus.dvi dired-x.dvi \
ediff.dvi forms.dvi gnus.dvi message.dvi emacs-mime.dvi \
sieve.dvi pgg.dvi mh-e.dvi \
@@ -62,7 +65,7 @@ DVI_TARGETS = calc.dvi cc-mode.dvi cl.dvi dbus.dvi dired-x.dvi \
newsticker.dvi rcirc.dvi erc.dvi ert.dvi \
remember.dvi nxml-mode.dvi \
epa.dvi mairix-el.dvi sasl.dvi auth.dvi eieio.dvi ede.dvi \
- semantic.dvi edt.dvi
+ semantic.dvi edt.dvi emacs-gnutls.dvi
INFOSOURCES = info.texi
# The following rule does not work with all versions of `make'.
@@ -93,68 +96,68 @@ $(infodir)/dir:
# Some Windows ports of makeinfo seem to require -o to come before the
# texi filename, contrary to GNU standards.
-$(infodir)/info: $(INFOSOURCES)
- $(MAKEINFO) $(MAKEINFO_OPTS) --no-split -o $@ info.texi
+$(infodir)/info$(INFO_EXT): $(INFOSOURCES)
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ info.texi
info.dvi: $(INFOSOURCES)
$(ENVADD) $(TEXI2DVI) $(srcdir)/info.texi
-$(infodir)/ccmode: cc-mode.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) cc-mode.texi
+$(infodir)/ccmode$(INFO_EXT): cc-mode.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ cc-mode.texi
cc-mode.dvi: cc-mode.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/cc-mode.texi
-$(infodir)/ada-mode: ada-mode.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) ada-mode.texi
+$(infodir)/ada-mode$(INFO_EXT): ada-mode.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ada-mode.texi
ada-mode.dvi: ada-mode.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/ada-mode.texi
-$(infodir)/pcl-cvs: pcl-cvs.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) pcl-cvs.texi
+$(infodir)/pcl-cvs$(INFO_EXT): pcl-cvs.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ pcl-cvs.texi
pcl-cvs.dvi: pcl-cvs.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/pcl-cvs.texi
-$(infodir)/eshell: eshell.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) eshell.texi
+$(infodir)/eshell$(INFO_EXT): eshell.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ eshell.texi
eshell.dvi: eshell.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/eshell.texi
-$(infodir)/cl: cl.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) cl.texi
+$(infodir)/cl$(INFO_EXT): cl.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ cl.texi
cl.dvi: cl.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/cl.texi
-$(infodir)/dbus: dbus.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) dbus.texi
+$(infodir)/dbus$(INFO_EXT): dbus.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ dbus.texi
dbus.dvi: dbus.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/dbus.texi
-$(infodir)/dired-x: dired-x.texi $(emacsdir)/emacsver.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) dired-x.texi
+$(infodir)/dired-x$(INFO_EXT): dired-x.texi $(emacsdir)/emacsver.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ dired-x.texi
dired-x.dvi: dired-x.texi $(emacsdir)/emacsver.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/dired-x.texi
-$(infodir)/ediff: ediff.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) ediff.texi
+$(infodir)/ediff$(INFO_EXT): ediff.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ediff.texi
ediff.dvi: ediff.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/ediff.texi
-$(infodir)/flymake: flymake.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) flymake.texi
+$(infodir)/flymake$(INFO_EXT): flymake.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ flymake.texi
flymake.dvi: flymake.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/flymake.texi
-$(infodir)/forms: forms.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) forms.texi
+$(infodir)/forms$(INFO_EXT): forms.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ forms.texi
forms.dvi: forms.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/forms.texi
# gnus/message/emacs-mime/sieve/pgg are part of Gnus:
-$(infodir)/gnus: gnus.texi gnus-overrides.texi message.texi emacs-mime.texi \
+$(infodir)/gnus$(INFO_EXT): gnus.texi gnus-overrides.texi message.texi emacs-mime.texi \
sieve.texi pgg.texi sasl.texi gnus-news.texi gnus-faq.texi \
doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) gnus.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ gnus.texi
gnus.dvi: gnus.texi gnus-overrides.texi message.texi emacs-mime.texi \
sieve.texi pgg.texi sasl.texi gnus-news.texi gnus-faq.texi \
doclicense.texi
@@ -163,193 +166,198 @@ gnus.dvi: gnus.texi gnus-overrides.texi message.texi emacs-mime.texi \
cp gnustmp.dvi $*.dvi
rm gnustmp.*
#
-$(infodir)/message: message.texi gnus-overrides.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) message.texi
+$(infodir)/message$(INFO_EXT): message.texi gnus-overrides.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ message.texi
message.dvi: message.texi gnus-overrides.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/message.texi
#
-$(infodir)/emacs-mime: emacs-mime.texi gnus-overrides.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) --enable-encoding emacs-mime.texi
+$(infodir)/emacs-mime$(INFO_EXT): emacs-mime.texi gnus-overrides.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ --enable-encoding emacs-mime.texi
emacs-mime.dvi: emacs-mime.texi gnus-overrides.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-mime.texi
#
-$(infodir)/sieve: sieve.texi gnus-overrides.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) sieve.texi
+$(infodir)/sieve$(INFO_EXT): sieve.texi gnus-overrides.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ sieve.texi
sieve.dvi: sieve.texi gnus-overrides.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/sieve.texi
#
-$(infodir)/pgg: pgg.texi gnus-overrides.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) pgg.texi
+$(infodir)/pgg$(INFO_EXT): pgg.texi gnus-overrides.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ pgg.texi
pgg.dvi: pgg.texi gnus-overrides.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/pgg.texi
-$(infodir)/mh-e: mh-e.texi doclicense.texi gpl.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) mh-e.texi
+$(infodir)/mh-e$(INFO_EXT): mh-e.texi doclicense.texi gpl.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ mh-e.texi
mh-e.dvi: mh-e.texi doclicense.texi gpl.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/mh-e.texi
-$(infodir)/reftex: reftex.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) reftex.texi
+$(infodir)/reftex$(INFO_EXT): reftex.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ reftex.texi
reftex.dvi: reftex.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/reftex.texi
-$(infodir)/remember: remember.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) remember.texi
+$(infodir)/remember$(INFO_EXT): remember.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ remember.texi
remember.dvi: remember.texi doclicense.texix
$(ENVADD) $(TEXI2DVI) $(srcdir)/remember.texi
-$(infodir)/sasl: sasl.texi gnus-overrides.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) sasl.texi
+$(infodir)/sasl$(INFO_EXT): sasl.texi gnus-overrides.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ sasl.texi
sasl.dvi: sasl.texi gnus-overrides.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/sasl.texi
-$(infodir)/sc: sc.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) sc.texi
+$(infodir)/sc$(INFO_EXT): sc.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ sc.texi
sc.dvi: sc.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/sc.texi
-$(infodir)/vip: vip.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) vip.texi
+$(infodir)/vip$(INFO_EXT): vip.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ vip.texi
vip.dvi: vip.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/vip.texi
-$(infodir)/viper: viper.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) viper.texi
+$(infodir)/viper$(INFO_EXT): viper.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ viper.texi
viper.dvi: viper.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/viper.texi
-$(infodir)/widget: widget.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) widget.texi
+$(infodir)/widget$(INFO_EXT): widget.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ widget.texi
widget.dvi: widget.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/widget.texi
-$(infodir)/efaq: faq.texi $(emacsdir)/emacsver.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) faq.texi
+$(infodir)/efaq$(INFO_EXT): faq.texi $(emacsdir)/emacsver.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ faq.texi
faq.dvi: faq.texi $(emacsdir)/emacsver.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/faq.texi
-$(infodir)/autotype: autotype.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) autotype.texi
+$(infodir)/autotype$(INFO_EXT): autotype.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ autotype.texi
autotype.dvi: autotype.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/autotype.texi
-$(infodir)/calc: calc.texi $(emacsdir)/emacsver.texi gpl.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) calc.texi
+$(infodir)/calc$(INFO_EXT): calc.texi $(emacsdir)/emacsver.texi gpl.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ calc.texi
calc.dvi: calc.texi $(emacsdir)/emacsver.texi gpl.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/calc.texi
# This is produced with --no-split to avoid making files whose
# names clash on DOS 8+3 filesystems
-$(infodir)/idlwave: idlwave.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) --no-split idlwave.texi
+$(infodir)/idlwave$(INFO_EXT): idlwave.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ idlwave.texi
idlwave.dvi: idlwave.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/idlwave.texi
-$(infodir)/eudc: eudc.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) eudc.texi
+$(infodir)/eudc$(INFO_EXT): eudc.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ eudc.texi
eudc.dvi: eudc.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/eudc.texi
-$(infodir)/ebrowse: ebrowse.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) ebrowse.texi
+$(infodir)/ebrowse$(INFO_EXT): ebrowse.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ebrowse.texi
ebrowse.dvi: ebrowse.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/ebrowse.texi
-$(infodir)/woman: woman.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) woman.texi
+$(infodir)/woman$(INFO_EXT): woman.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ woman.texi
woman.dvi: woman.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/woman.texi
-$(infodir)/speedbar: speedbar.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) speedbar.texi
+$(infodir)/speedbar$(INFO_EXT): speedbar.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ speedbar.texi
speedbar.dvi: speedbar.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/speedbar.texi
-$(infodir)/tramp: tramp.texi trampver.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) tramp.texi
+$(infodir)/tramp$(INFO_EXT): tramp.texi trampver.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ tramp.texi
tramp.dvi: tramp.texi trampver.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/tramp.texi
-$(infodir)/ses: ses.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) ses.texi
+$(infodir)/ses$(INFO_EXT): ses.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ses.texi
ses.dvi: ses.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/ses.texi
-$(infodir)/smtpmail: smtpmail.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) smtpmail.texi
+$(infodir)/smtpmail$(INFO_EXT): smtpmail.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ smtpmail.texi
smtpmail.dvi: smtpmail.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/smtpmail.texi
-$(infodir)/org: org.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) org.texi
+$(infodir)/org$(INFO_EXT): org.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ org.texi
org.dvi: org.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/org.texi
-$(infodir)/url: url.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) url.texi
+$(infodir)/url$(INFO_EXT): url.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ url.texi
url.dvi: url.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/url.texi
-$(infodir)/newsticker: newsticker.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) newsticker.texi
+$(infodir)/newsticker$(INFO_EXT): newsticker.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ newsticker.texi
newsticker.dvi: newsticker.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/newsticker.texi
-$(infodir)/nxml-mode: nxml-mode.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) nxml-mode.texi
+$(infodir)/nxml-mode$(INFO_EXT): nxml-mode.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ nxml-mode.texi
nxml-mod.dvi: nxml-mode.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/nxml-mode.texi
-$(infodir)/rcirc: rcirc.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) rcirc.texi
+$(infodir)/rcirc$(INFO_EXT): rcirc.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ rcirc.texi
rcirc.dvi: rcirc.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/rcirc.texi
-$(infodir)/erc: erc.texi gpl.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) erc.texi
+$(infodir)/erc$(INFO_EXT): erc.texi gpl.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ erc.texi
erc.dvi: erc.texi gpl.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/erc.texi
-$(infodir)/ert: ert.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) ert.texi
+$(infodir)/ert$(INFO_EXT): ert.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ert.texi
ert.dvi: ert.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/ert.texi
-$(infodir)/epa: epa.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) epa.texi
+$(infodir)/epa$(INFO_EXT): epa.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ epa.texi
epa.dvi: epa.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/epa.texi
-$(infodir)/mairix-el: mairix-el.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) mairix-el.texi
+$(infodir)/mairix-el$(INFO_EXT): mairix-el.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ mairix-el.texi
mairix-el.dvi: mairix-el.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/mairix-el.texi
-$(infodir)/auth: auth.texi gnus-overrides.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) auth.texi
+$(infodir)/auth$(INFO_EXT): auth.texi gnus-overrides.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ auth.texi
auth.dvi: auth.texi gnus-overrides.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/auth.texi
-$(infodir)/eieio: eieio.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) eieio.texi
+$(infodir)/eieio$(INFO_EXT): eieio.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ eieio.texi
eieio.dvi: eieio.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/eieio.texi
-$(infodir)/ede: ede.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) ede.texi
+$(infodir)/ede$(INFO_EXT): ede.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ede.texi
ede.dvi: ede.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/ede.texi
-$(infodir)/semantic: semantic.texi sem-user.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) semantic.texi
+$(infodir)/semantic$(INFO_EXT): semantic.texi sem-user.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ semantic.texi
semantic.dvi: semantic.texi sem-user.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/semantic.texi
-$(infodir)/edt: edt.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) edt.texi
+$(infodir)/edt$(INFO_EXT): edt.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ edt.texi
edt.dvi: edt.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/edt.texi
+$(infodir)/emacs-gnutls$(INFO_EXT): emacs-gnutls.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ emacs-gnutls.texi
+emacs-gnutls.dvi: emacs-gnutls.texi doclicense.texi
+ $(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-gnutls.texi
+
mostlyclean:
- $(DEL) *.log *.cp *.fn *.ky *.pg *.vr core *.tp *.core gnustmp.*
@@ -377,7 +385,7 @@ clean: mostlyclean
$(infodir)/epa* $(infodir)/sasl* \
$(infodir)/mairix-el* $(infodir)/auth* \
$(infodir)/eieio* $(infodir)/ede* \
- $(infodir)/semantic* $(infodir)edt*
+ $(infodir)/semantic* $(infodir)edt* $(infodir)/emacs-gnutls*
distclean: clean
- $(DEL) makefile
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index 774bf180266..ef752a96fdc 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -10,7 +10,7 @@
@copying
This file documents Message, the Emacs message composition mode.
-Copyright @copyright{} 1996-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1996-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -1101,10 +1101,11 @@ the passphrase prompt.
@acronym{PGP/MIME} requires an external OpenPGP implementation, such
as @uref{http://www.gnupg.org/, GNU Privacy Guard}. Pre-OpenPGP
-implementations such as PGP 2.x and PGP 5.x are also supported. One
-Emacs interface to the PGP implementations, PGG (@pxref{Top, ,PGG,
-pgg, PGG Manual}), is included, but Mailcrypt is also supported.
-@xref{PGP Compatibility}.
+implementations such as PGP 2.x and PGP 5.x are also supported. The
+default Emacs interface to the PGP implementation is EasyPG
+(@pxref{Top,,EasyPG Assistant User's Manual, epa, EasyPG Assistant
+User's Manual}), but PGG (@pxref{Top, ,PGG, pgg, PGG Manual}) and
+Mailcrypt are also supported. @xref{PGP Compatibility}.
@cindex gpg-agent
Message internally calls GnuPG (the @command{gpg} command) to perform
@@ -1139,11 +1140,6 @@ does the trick.
gpg --use-agent --sign < /dev/null > /dev/null
@end example
-The Lisp variable @code{pgg-gpg-use-agent} controls whether to use
-@command{gpg-agent}. See also @xref{Caching passphrase, , , pgg, The
-PGG Manual}.
-
-
@node PGP Compatibility
@subsection Compatibility with older implementations
@@ -1158,7 +1154,7 @@ your PGP implementation, so we refer to it.
If you have imported your old PGP 2.x key into GnuPG, and want to send
signed and encrypted messages to your fellow PGP 2.x users, you'll
discover that the receiver cannot understand what you send. One
-solution is to use PGP 2.x instead (i.e., if you use @code{pgg}, set
+solution is to use PGP 2.x instead (e.g.@: if you use @code{pgg}, set
@code{pgg-default-scheme} to @code{pgp}). You could also convince your
fellow PGP 2.x users to convert to GnuPG.
@vindex mml-signencrypt-style-alist
@@ -1641,6 +1637,40 @@ To the thing similar to this, there is
requires the @acronym{POP}-before-@acronym{SMTP} authentication.
@xref{POP before SMTP, , POP before SMTP, gnus, The Gnus Manual}.
+@cindex X-Message-SMTP-Method
+If you have a complex @acronym{SMTP} setup, and want some messages to
+go via one mail server, and other messages to go through another, you
+can use the @samp{X-Message-SMTP-Method} header. These are the
+supported values:
+
+@table @samp
+@item smtpmail
+
+@example
+X-Message-SMTP-Method: smtp smtp.fsf.org 587
+@end example
+
+This will send the message via @samp{smtp.fsf.org}, using port 587.
+
+@example
+X-Message-SMTP-Method: smtp smtp.fsf.org 587 other-user
+@end example
+
+This is the same as the above, but uses @samp{other-user} as the user
+name when authenticating. This is handy if you have several
+@acronym{SMTP} accounts on the same server.
+
+@item sendmail
+
+@example
+X-Message-SMTP-Method: sendmail
+@end example
+
+This will send the message via the locally installed sendmail/exim/etc
+installation.
+
+@end table
+
@item message-mh-deletable-headers
@vindex message-mh-deletable-headers
Most versions of MH doesn't like being fed messages that contain the
diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi
index 4e63410f4a0..2ae0ed7ffce 100644
--- a/doc/misc/mh-e.texi
+++ b/doc/misc/mh-e.texi
@@ -24,7 +24,7 @@
This is version @value{VERSION}@value{EDITION} of @cite{The MH-E
Manual}, last updated @value{UPDATED}.
-Copyright @copyright{} 1995, 2001-2003, 2005-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1995, 2001-2003, 2005-2012 Free Software Foundation, Inc.
@c This dual license has been agreed upon by the FSF.
@@ -429,7 +429,7 @@ for a description about @dfn{normal hooks} and @dfn{abnormal hooks}.
MH-E uses normal hooks in nearly all cases, so you can assume that we
are talking about normal hooks unless we explicitly mention that a
hook is abnormal. We also follow the conventions described in that
-section: the name of the abnormal hooks end in @code{-hooks} and all
+section: the name of the abnormal hooks end in @code{-functions} and all
the rest of the MH-E hooks end in @code{-hook}. You can add hooks with
either @code{customize-option} or @code{add-hook}.
@@ -3749,9 +3749,9 @@ when you press @key{TAB} when prompted for a folder name.
@findex mh-search-p
@kindex k
-@vindex mh-kill-folder-suppress-prompt-hooks
+@vindex mh-kill-folder-suppress-prompt-functions
-The hook @code{mh-kill-folder-suppress-prompt-hooks} is an abnormal
+The hook @code{mh-kill-folder-suppress-prompt-functions} is an abnormal
hook run at the beginning of the command @kbd{k}. The hook functions
are called with no arguments and should return a non-nil value to
suppress the normal prompt when you remove a folder. This is useful
@@ -6966,23 +6966,22 @@ swish-e -c /home/user/Mail/.swish/config
@cindex @command{mairix}
@cindex Unix commands, @command{mairix}
-In the examples below, replace @file{/home/user/Mail} with the path to
-your MH directory.
+In the examples below, replace @file{~/Mail} with the path to your MH
+directory.
-First create the directory @file{/home/user/Mail/.mairix}. Then create
-the file @file{/home/user/Mail/.mairix/config} with the following
-contents:
+First create the directory @file{~/Mail/.mairix}. Then create the file
+@file{~/Mail/.mairix/config} with the following contents:
@smallexample
@group
-base=/home/user/Mail
+base=~/Mail
# List of folders that should be indexed. 3 dots at the end means there
# are subfolders within the folder
mh=archive...:inbox:drafts:news:sent:trash
-vfolder_format=mh
-database=/home/user/Mail/.mairix/database
+mformat=mh
+database=~/Mail/.mairix/database
@end group
@end smallexample
@@ -6990,7 +6989,7 @@ Use the following command line to generate the mairix index. Run this daily
from cron:
@smallexample
-mairix -f /home/user/Mail/.mairix/config
+mairix -f ~/Mail/.mairix/config
@end smallexample
@subsection namazu
@@ -7901,7 +7900,7 @@ PATH=$PATH:/usr/bin/mh
MAILDIR=$HOME/`mhparam Path`
#
-# Filter messages with win32 executables/virii.
+# Filter messages with w32 executables/virii.
#
# These attachments are base64 and have a TVqQAAMAAAAEAAAA//8AALg
# pattern. The string "this program cannot be run in MS-DOS mode"
@@ -9060,5 +9059,3 @@ Bill Wohler, August 2008
@c Local Variables:
@c sentence-end-double-space: nil
@c End:
-
-
diff --git a/doc/misc/newsticker.texi b/doc/misc/newsticker.texi
index 18e11aeeeb3..5add229724c 100644
--- a/doc/misc/newsticker.texi
+++ b/doc/misc/newsticker.texi
@@ -13,8 +13,7 @@
This manual is for Newsticker (version @value{VERSION}, @value{UPDATED}).
@noindent
-Copyright @copyright{} 2004-2011
-Free Software Foundation, Inc.
+Copyright @copyright{} 2004-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -70,14 +69,14 @@ developing GNU and promoting software freedom.''
@node Overview
@chapter Overview
-Newsticker provides a newsticker for Emacs. A newsticker is a thing
+Newsticker provides a newsticker for Emacs. A newsticker is a thing
that asynchronously retrieves headlines from a list of news sites,
prepares these headlines for reading, and allows for loading the
corresponding articles in a web browser.
Headlines consist of a title and (possibly) a small description. They
-are contained in "RSS" (RDF Site Summary) or "Atom" files. Newsticker
+are contained in ``RSS'' (RDF Site Summary) or ``Atom'' files. Newsticker
works with the following RSS formats:
@itemize
@@ -106,8 +105,9 @@ messages in a stock-quote ticker, or just changing.
Newsticker allows for automatic processing of headlines by providing
hooks and (sample) functions for automatically downloading images and
-enclosed files (as delivered by podcasts, e.g.).
+enclosed files (as delivered by, e.g., podcasts).
+@ignore
@ifhtml
Here are screen shots of the @uref{newsticker-1.7.png, version 1.7
(current version)} and some older screen shots:
@@ -117,6 +117,7 @@ Here are screen shots of the @uref{newsticker-1.7.png, version 1.7
@uref{newsticker-1.3.png, version 1.3},
@uref{newsticker-1.0.png, version 1.0}.
@end ifhtml
+@end ignore
@node Requirements
@chapter Requirements
@@ -124,11 +125,11 @@ Here are screen shots of the @uref{newsticker-1.7.png, version 1.7
Newsticker can be used with
@uref{http://www.gnu.org/software/emacs/emacs.html, GNU Emacs} version
21.1 or later as well as @uref{http://www.xemacs.org, XEmacs}. It
-requires an XML-parser (@file{xml.el}) which is part of GNU Emacs. If
+requires an XML-parser (@file{xml.el}), which is part of GNU Emacs. If
you are using XEmacs you want to get the @file{net-utils} package
which contains @file{xml.el} for XEmacs.
-Newsticker retrieves headlines either via Emacs' built-in retrieval
+Newsticker retrieves headlines either via Emacs's built-in retrieval
functions, by an arbitrary external program that retrieves files via
http and prints them to stdout (like
@uref{http://www.gnu.org/software/wget/wget.html, wget}, or -- on a
@@ -162,11 +163,11 @@ You can choose between two different frontends for reading headlines:
@itemize
@item Newsticker's @emph{treeview} uses separate windows for the
feeds (in tree form), a list of headlines for the current feed, and
-the content of the current headline. Feeds can be placed into groups
-which itself can be placed in groups and so on.
+the content of the current headline. Feeds can be placed into groups,
+which themselves can be placed in groups and so on.
@item Newsticker's @emph{plainview} displays all headlines in a
-single buffer, called @samp{*newsticker*}. The modeline in the
-@samp{*newsticker*} buffer informs whenever new headlines have
+single buffer, called @samp{*newsticker*}. The modeline in the
+@samp{*newsticker*} buffer informs you whenever new headlines have
arrived.
@end itemize
In both views clicking mouse-button 2 or pressing RET on a headline
@@ -176,13 +177,13 @@ your favorite web browser.
@findex newsticker-start-ticker
@findex newsticker-stop-ticker
The scrolling, or flashing of headlines in the echo area, can be
-started with the command @code{newsticker-start-ticker}. It can be
+started with the command @code{newsticker-start-ticker}. It can be
stopped with @code{newsticker-stop-ticker}.
@findex newsticker-start
@findex newsticker-stop
If you just want to start the periodic download of headlines use the
-command @code{newsticker-start}. Calling @code{newsticker-stop} will
+command @code{newsticker-start}. Calling @code{newsticker-stop} will
stop the periodic download, but will call
@code{newsticker-stop-ticker} as well.
@@ -190,7 +191,7 @@ stop the periodic download, but will call
@chapter Configuration
All Newsticker options are customizable, i.e. they can be changed with
-Emacs customization methods: Call the command
+Emacs customization methods. Call the command
@code{customize-group} and enter @samp{newsticker} for the customization
group.
@@ -210,12 +211,12 @@ feeds are retrieved and how this is done.
@itemize
@item
@vindex newsticker-url-list
-@code{newsticker-url-list} defines the list of headlines which are
+@code{newsticker-url-list} defines the list of headlines that are
retrieved.
@item
@vindex newsticker-retrieval-method
@code{newsticker-retrieval-method} defines how headlines are
-retrieved. This is either done using Emacs' built-in download
+retrieved. This is either done using Emacs's built-in download
capabilities or using an external tool.
@item
@vindex newsticker-retrieval-interval
@@ -246,11 +247,11 @@ commands to newsticker functions.
@item
@vindex newsticker-new-item-functions
@code{newsticker-new-item-functions} allows for automatic
-processing of headlines. See `newsticker-download-images', and
-`newsticker-download-enclosures' for sample functions.
+processing of headlines. See @code{newsticker-download-images}, and
+@code{newsticker-download-enclosures} for sample functions.
@item
@vindex newsticker-plainview-hooks
-The subgroup @code{newsticker-plainview-hooks} contains hook which
+The subgroup @code{newsticker-plainview-hooks} contains hooks that
apply to the plainview reader only.
@end itemize
@@ -277,7 +278,7 @@ the echo area.
@itemize
@item
@vindex newsticker-frontend
-@code{newsticker-frontend} determines the actual headline reader. The
+@code{newsticker-frontend} determines the actual headline reader. The
``plainview'' reader uses a single buffer, the ``treeview'' uses
separate buffers and windows.
@end itemize
diff --git a/doc/misc/nxml-mode.texi b/doc/misc/nxml-mode.texi
index 27603440413..c8d159e2363 100644
--- a/doc/misc/nxml-mode.texi
+++ b/doc/misc/nxml-mode.texi
@@ -5,11 +5,10 @@
@c %**end of header
@copying
-This manual documents nxml-mode, an Emacs major mode for editing
+This manual documents nXML mode, an Emacs major mode for editing
XML with RELAX NG support.
-Copyright @copyright{} 2007-2011
-Free Software Foundation, Inc.
+Copyright @copyright{} 2007-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -109,31 +108,25 @@ lists. Report any bugs with @kbd{M-x report-emacs-bug}.
@node Completion
@chapter Completion
-Apart from real-time validation, the most important feature that
-nxml-mode provides for assisting in document creation is "completion".
+Apart from real-time validation, the most important feature that nXML
+mode provides for assisting in document creation is "completion".
Completion assists the user in inserting characters at point, based on
knowledge of the schema and on the contents of the buffer before
point.
-The traditional GNU Emacs key combination for completion in a
-buffer is @kbd{M-@key{TAB}}. However, many window systems
-and window managers use this key combination themselves (typically for
-switching between windows) and do not pass it to applications. It's
-hard to find key combinations in GNU Emacs that are both easy to type
-and not taken by something else. @kbd{C-@key{RET}} (i.e.
-pressing the Enter or Return key, while the Ctrl key is held down) is
-available. It won't be available on a traditional terminal (because
-it is indistinguishable from Return), but it will work with a window
-system. Therefore we adopt the following solution by default: use
-@kbd{C-@key{RET}} when there's a window system and
-@kbd{M-@key{TAB}} when there's not. In the following, I
-will assume that a window system is being used and will therefore
-refer to @kbd{C-@key{RET}}.
-
-Completion works by examining the symbol preceding point. This
-is the symbol to be completed. The symbol to be completed may be the
-empty. Completion considers what symbols starting with the symbol to
-be completed would be valid replacements for the symbol to be
+nXML mode adapts the standard GNU Emacs command for completion in a
+buffer: @code{completion-at-point}, which is bound to @kbd{C-M-i} and
+@kbd{M-@key{TAB}}. Note that many window systems and window managers
+use @kbd{M-@key{TAB}} themselves (typically for switching between
+windows) and do not pass it to applications. In that case, you should
+type @kbd{C-M-i} or @kbd{@key{ESC} @key{TAB}} for completion, or bind
+@code{completion-at-point} to a key that is convenient for you. In
+the following, I will assume that you type @kbd{C-M-i}.
+
+nXML mode completion works by examining the symbol preceding point.
+This is the symbol to be completed. The symbol to be completed may be
+the empty. Completion considers what symbols starting with the symbol
+to be completed would be valid replacements for the symbol to be
completed, given the schema and the contents of the buffer before
point. These symbols are the possible completions. An example may
make this clearer. Suppose the buffer looks like this (where @point{}
@@ -169,7 +162,7 @@ completions are @samp{base}, @samp{isindex},
In this case, the symbol to be completed is empty, and the possible
completions are just @samp{http://www.w3.org/1999/xhtml}.
-When you type @kbd{C-@key{RET}}, what happens depends
+When you type @kbd{C-M-i}, what happens depends
on what the set of possible completions are.
@itemize @bullet
@@ -187,7 +180,7 @@ required. For example, in this case:
@end example
@noindent
-@kbd{C-@key{RET}} will yield
+@kbd{C-M-i} will yield
@example
<html xmlns="http://www.w3.org/1999/xhtml">
@@ -203,18 +196,17 @@ is inserted. For example, suppose the buffer is:
@end example
@noindent
-The symbol to be completed is @samp{x}. The possible completions
-are @samp{xmlns} and @samp{xml:lang}. These share a
-common prefix of @samp{xml}. Thus, @kbd{C-@key{RET}}
-will yield:
+The symbol to be completed is @samp{x}. The possible completions are
+@samp{xmlns} and @samp{xml:lang}. These share a common prefix of
+@samp{xml}. Thus, @kbd{C-M-i} will yield:
@example
<html xml@point{}
@end example
@noindent
-Typically, you would do @kbd{C-@key{RET}} again, which would
-have the result described in the next item.
+Typically, you would do @kbd{C-M-i} again, which would have the result
+described in the next item.
@item
If there is more than one possible completion, but the
possible completions do not share a non-empty prefix, then Emacs will
@@ -252,19 +244,19 @@ If you input @kbd{xmlns}, the result will be:
@end example
@noindent
-(If you do @kbd{C-@key{RET}} again, the namespace URI will
-be inserted. Should that happen automatically?)
+(If you do @kbd{C-M-i} again, the namespace URI will be
+inserted. Should that happen automatically?)
@end itemize
@node Inserting end-tags
@chapter Inserting end-tags
-The main redundancy in XML syntax is end-tags. nxml-mode provides
+The main redundancy in XML syntax is end-tags. nXML mode provides
several ways to make it easier to enter end-tags. You can use all of
these without a schema.
-You can use @kbd{C-@key{RET}} after @samp{</}
-to complete the rest of the end-tag.
+You can use @kbd{C-M-i} after @samp{</} to complete the rest of the
+end-tag.
@kbd{C-c C-f} inserts an end-tag for the element containing
point. This command is useful when you want to input the start-tag,
@@ -280,9 +272,9 @@ start-tag, point and the end-tag on successive lines, appropriately
indented. The @samp{i} is mnemonic for inline and the
@samp{b} is mnemonic for block.
-Finally, you can customize nxml-mode so that @kbd{/}
-automatically inserts the rest of the end-tag when it occurs after
-@samp{<}, by doing
+Finally, you can customize nXML mode so that @kbd{/} automatically
+inserts the rest of the end-tag when it occurs after @samp{<}, by
+doing
@display
@kbd{M-x customize-variable @key{RET} nxml-slash-auto-complete-flag @key{RET}}
@@ -355,7 +347,7 @@ Otherwise, it is a paragraph boundary.
@chapter Outlining
nXML mode allows you to display all or part of a buffer as an
-outline, in a similar way to Emacs' outline mode. An outline in nXML
+outline, in a similar way to Emacs's outline mode. An outline in nXML
mode is based on recognizing two kinds of element: sections and
headings. There is one heading for every section and one section for
every heading. A section contains its heading as or within its first
@@ -869,7 +861,7 @@ an @samp{applyFollowingRules} to the private file.
@node DTDs
@chapter DTDs
-nxml-mode is designed to support the creation of standalone XML
+nXML mode is designed to support the creation of standalone XML
documents that do not depend on a DTD. Although it is common practice
to insert a DOCTYPE declaration referencing an external DTD, this has
undesirable side-effects. It means that the document is no longer
@@ -878,7 +870,7 @@ the document in different ways, since the XML Recommendation does not
require XML parsers to read the DTD. With DTDs, it was impractical to
get validation without using an external DTD or reference to an
parameter entity. With RELAX NG and other schema languages, you can
-simulataneously get the benefits of validation and standalone XML
+simultaneously get the benefits of validation and standalone XML
documents. Therefore, I recommend that you do not reference an
external DOCTYPE in your XML documents.
@@ -908,4 +900,3 @@ specification are not enforced.
@end itemize
@bye
-
diff --git a/doc/misc/org.texi b/doc/misc/org.texi
index adc9cf0b139..a69dc0fd81f 100644
--- a/doc/misc/org.texi
+++ b/doc/misc/org.texi
@@ -1,11 +1,8 @@
-
\input texinfo
@c %**start of header
@setfilename ../../info/org
@settitle The Org Manual
-
-@set VERSION 7.7
-@set DATE July 2011
+@set VERSION 7.9.2 (GNU Emacs 24.3)
@c Use proper quote and backtick for code sections in PDF output
@c Cf. Texinfo manual 14.2
@@ -36,7 +33,7 @@
@c orgkey{key} A key item
@c orgcmd{key,cmd} Key with command name
-@c xorgcmd{key,command} Key with command name as @itemx
+@c xorgcmd{key,cmd} Key with command name as @itemx
@c orgcmdnki{key,cmd} Like orgcmd, but do not index the key
@c orgcmdtkc{text,key,cmd} Like orgcmd,special text instead of key
@c orgcmdkkc{key1,key2,cmd} Two keys with one command name, use "or"
@@ -265,7 +262,7 @@
@copying
This manual is for Org version @value{VERSION}.
-Copyright @copyright{} 2004-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 2004-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -286,7 +283,7 @@ license to the document, as described in section 6 of the license.
@end quotation
@end copying
-@dircategory Emacs
+@dircategory Emacs editing modes
@direntry
* Org Mode: (org). Outline-based notes management and organizer
@end direntry
@@ -296,7 +293,7 @@ license to the document, as described in section 6 of the license.
@subtitle Release @value{VERSION}
@author by Carsten Dominik
-with contributions by David O'Toole, Bastien Guerry, Philip Rooke, Dan Davison, Eric Schulte, and Thomas Dye
+with contributions by David O'Toole, Bastien Guerry, Philip Rooke, Dan Davison, Eric Schulte, Thomas Dye and Jambunathan K.
@c The following two commands start the copyright page.
@page
@@ -347,7 +344,7 @@ Introduction
* Installation:: How to install a downloaded version of Org
* Activation:: How to activate Org for certain buffers
* Feedback:: Bug reports, ideas, patches etc.
-* Conventions:: Type-setting conventions in the manual
+* Conventions:: Typesetting conventions in the manual
Document structure
@@ -382,7 +379,7 @@ The spreadsheet
* Column formulas:: Formulas valid for an entire column
* Editing and debugging formulas:: Fixing formulas
* Updating the table:: Recomputing all dependent fields
-* Advanced features:: Field names, parameters and automatic recalc
+* Advanced features:: Field and column names, parameters and automatic recalc
Hyperlinks
@@ -433,7 +430,7 @@ Tags
Properties and columns
* Property syntax:: How properties are spelled out
-* Special properties:: Access to other Org-mode features
+* Special properties:: Access to other Org mode features
* Property searches:: Matching property values
* Property inheritance:: Passing values down the tree
* Column view:: Tabular viewing and editing
@@ -462,7 +459,7 @@ Dates and times
Creating timestamps
-* The date/time prompt:: How Org-mode helps you entering date and time
+* The date/time prompt:: How Org mode helps you entering date and time
* Custom time format:: Making dates look different
Deadlines and scheduling
@@ -495,6 +492,7 @@ Capture templates
* Template elements:: What is needed for a complete template entry
* Template expansion:: Filling in information about time and context
+* Templates in contexts:: Only show a template in a specific context
Archiving
@@ -541,7 +539,7 @@ Markup for rich export
* Include files:: Include additional files into a document
* Index entries:: Making an index
* Macro replacement:: Use macros to create complex output
-* Embedded LaTeX:: LaTeX can be freely used inside Org documents
+* Embedded @LaTeX{}:: LaTeX can be freely used inside Org documents
Structural markup elements
@@ -560,8 +558,8 @@ Embedded @LaTeX{}
* Special symbols:: Greek letters and other symbols
* Subscripts and superscripts:: Simple syntax for raising/lowering text
-* LaTeX fragments:: Complex formulas made easy
-* Previewing LaTeX fragments:: What will this snippet look like?
+* @LaTeX{} fragments:: Complex formulas made easy
+* Previewing @LaTeX{} fragments:: What will this snippet look like?
* CDLaTeX mode:: Speed up entering of formulas
Exporting
@@ -571,9 +569,9 @@ Exporting
* The export dispatcher:: How to access exporter commands
* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding
* HTML export:: Exporting to HTML
-* LaTeX and PDF export:: Exporting to @LaTeX{}, and processing to PDF
+* @LaTeX{} and PDF export:: Exporting to @LaTeX{}, and processing to PDF
* DocBook export:: Exporting to DocBook
-* OpenDocumentText export:: Exporting to OpenDocumentText
+* OpenDocument Text export:: Exporting to OpenDocument Text
* TaskJuggler export:: Exporting to TaskJuggler
* Freemind export:: Exporting to Freemind mind maps
* XOXO export:: Exporting to XOXO
@@ -583,7 +581,7 @@ HTML export
* HTML Export commands:: How to invoke HTML export
* HTML preamble and postamble:: How to insert a preamble and a postamble
-* Quoting HTML tags:: Using direct HTML in Org-mode
+* Quoting HTML tags:: Using direct HTML in Org mode
* Links in HTML export:: How links will be interpreted and formatted
* Tables in HTML export:: How to modify the formatting of tables
* Images in HTML export:: How to insert figures into HTML output
@@ -594,11 +592,11 @@ HTML export
@LaTeX{} and PDF export
-* LaTeX/PDF export commands:: Which key invokes which commands
+* @LaTeX{}/PDF export commands::
* Header and sectioning:: Setting up the export file structure
-* Quoting LaTeX code:: Incorporating literal @LaTeX{} code
-* Tables in LaTeX export:: Options for exporting tables to @LaTeX{}
-* Images in LaTeX export:: How to insert figures into @LaTeX{} output
+* Quoting @LaTeX{} code:: Incorporating literal @LaTeX{} code
+* Tables in @LaTeX{} export:: Options for exporting tables to @LaTeX{}
+* Images in @LaTeX{} export:: How to insert figures into @LaTeX{} output
* Beamer class export:: Turning the file into a presentation
DocBook export
@@ -610,15 +608,32 @@ DocBook export
* Images in DocBook export:: How to insert figures into DocBook output
* Special characters:: How to handle special characters
-OpenDocument export
+OpenDocument Text export
+
+* Pre-requisites for ODT export:: What packages ODT exporter relies on
+* ODT export commands:: How to invoke ODT export
+* Extending ODT export:: How to produce @samp{doc}, @samp{pdf} files
+* Applying custom styles:: How to apply custom styles to the output
+* Links in ODT export:: How links will be interpreted and formatted
+* Tables in ODT export:: How Tables are exported
+* Images in ODT export:: How to insert images
+* Math formatting in ODT export:: How @LaTeX{} fragments are formatted
+* Labels and captions in ODT export:: How captions are rendered
+* Literal examples in ODT export:: How source and example blocks are formatted
+* Advanced topics in ODT export:: Read this if you are a power user
+
+Math formatting in ODT export
+
+* Working with @LaTeX{} math snippets:: How to embed @LaTeX{} math fragments
+* Working with MathML or OpenDocument formula files:: How to embed equations in native format
-* OpenDocumentText export commands:: How to invoke OpenDocumentText export
-* Applying Custom Styles:: How to apply custom styles to the output
-* Converting to Other formats:: How to convert to formats like doc, docx etc
-* Links in OpenDocumentText export:: How links will be interpreted and formatted
-* Tables in OpenDocumentText export:: How Tables are handled
-* Images in OpenDocumentText export:: How to insert figures
-* Additional Documentation:: How to handle special characters
+Advanced topics in ODT export
+
+* Configuring a document converter:: How to register a document converter
+* Working with OpenDocument style files:: Explore the internals
+* Creating one-off styles:: How to produce custom highlighting etc
+* Customizing tables in ODT export:: How to define and use Table templates
+* Validating OpenDocument XML:: How to debug corrupt OpenDocument files
Publishing
@@ -649,12 +664,12 @@ Working with source code
* Editing source code:: Language major-mode editing
* Exporting code blocks:: Export contents and/or results
* Extracting source code:: Create pure source code files
-* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer
+* Evaluating code blocks:: Place results of evaluation in the Org mode buffer
* Library of Babel:: Use and contribute to a library of useful code blocks
* Languages:: List of supported code block languages
* Header arguments:: Configure code block functionality
* Results of evaluation:: How evaluation results are handled
-* Noweb reference syntax:: Literate programming in Org-mode
+* Noweb reference syntax:: Literate programming in Org mode
* Key bindings and useful functions:: Work quickly with code blocks
* Batch execution:: Call functions from the command line
@@ -668,7 +683,7 @@ Using header arguments
* System-wide header arguments:: Set global default values
* Language-specific header arguments:: Set default values by language
* Buffer-wide header arguments:: Set default values for a specific buffer
-* Header arguments in Org-mode properties:: Set default values for a buffer or heading
+* Header arguments in Org mode properties:: Set default values for a buffer or heading
* Code block specific header arguments:: The most common way to set values
* Header arguments in function calls:: The most specific level
@@ -678,6 +693,7 @@ Specific header arguments
* results:: Specify the type of results and how they will
be collected and handled
* file:: Specify a path for file output
+* file-desc:: Specify a description for file results
* dir:: Specify the default (possibly remote)
directory for code block execution
* exports:: Export code and/or results
@@ -693,6 +709,7 @@ Specific header arguments
* session:: Preserve the state of code evaluation
* noweb:: Toggle expansion of noweb references
* noweb-ref:: Specify block's noweb reference resolution target
+* noweb-sep:: String used to separate noweb references
* cache:: Avoid re-evaluating unchanged code blocks
* sep:: Delimiter for writing tabular results outside Org
* hlines:: Handle horizontal lines in tables
@@ -700,6 +717,7 @@ Specific header arguments
* rownames:: Handle row names in tables
* shebang:: Make tangled files executable
* eval:: Limit evaluation of specific code blocks
+* wrap:: Mark source block evaluation results
Miscellaneous
@@ -722,7 +740,7 @@ Interaction with other packages
Hacking
-* Hooks:: Who to reach into Org's internals
+* Hooks:: How to reach into Org's internals
* Add-on packages:: Available extensions
* Adding hyperlink types:: New custom link types
* Context-sensitive commands:: How to add functionality to such commands
@@ -736,7 +754,7 @@ Hacking
Tables and lists in arbitrary syntax
* Radio tables:: Sending and receiving radio tables
-* A LaTeX example:: Step by step, almost a tutorial
+* A @LaTeX{} example:: Step by step, almost a tutorial
* Translator functions:: Copy and modify
* Radio lists:: Doing the same for lists
@@ -758,7 +776,7 @@ MobileOrg
* Installation:: How to install a downloaded version of Org
* Activation:: How to activate Org for certain buffers
* Feedback:: Bug reports, ideas, patches etc.
-* Conventions:: Type-setting conventions in the manual
+* Conventions:: Typesetting conventions in the manual
@end menu
@node Summary, Installation, Introduction, Introduction
@@ -836,73 +854,116 @@ Theory Ltd.}
@cindex installation
@cindex XEmacs
-@b{Important:} @i{If you are using a version of Org that is part of the Emacs
-distribution or an XEmacs package, please skip this section and go directly
-to @ref{Activation}. To see what version of Org (if any) is part of your
-Emacs distribution, type @kbd{M-x load-library RET org} and then @kbd{M-x
-org-version}.}
+@b{Important:} @i{If you the version of Org that comes with Emacs or as a
+XEmacs package, please skip this section and go directly to @ref{Activation}.
+If you downloaded Org as an ELPA package, please read the instructions on the
+@uref{http://orgmode.org/elpa.html, Org ELPA page}. To see what version of Org
+(if any) is part of your Emacs distribution, type @kbd{M-x org-version} (if
+your Emacs distribution does not come with Org, this function will not be
+defined).}
-If you have downloaded Org from the Web, either as a distribution @file{.zip}
-or @file{.tar} file, or as a Git archive, you must take the following steps
-to install it: go into the unpacked Org distribution directory and edit the
-top section of the file @file{Makefile}. You must set the name of the Emacs
-binary (likely either @file{emacs} or @file{xemacs}), and the paths to the
-directories where local Lisp and Info files are kept. If you don't have
-access to the system-wide directories, you can simply run Org directly from
-the distribution directory by adding the @file{lisp} subdirectory to the
-Emacs load path. To do this, add the following line to @file{.emacs}:
+Installation of Org mode uses a build system, which is described in more
+detail on @uref{http://orgmode.org/worg/dev/org-build-system.html, Worg}.
-@example
-(setq load-path (cons "~/path/to/orgdir/lisp" load-path))
-@end example
+If you have downloaded Org from the Web as a distribution @file{.zip} or
+@file{.tar.gz} archive, take the following steps to install it:
-@noindent
-If you plan to use code from the @file{contrib} subdirectory, do a similar
-step for this directory:
+@itemize @bullet
+@item Unpack the distribution archive.
+@item Change into (@code{cd}) the Org directory.
+@item Run @code{make help config}
+and then check and edit the file @file{local.mk} if the default configuration
+does not match your system. Set the name of the Emacs binary (likely either
+@file{emacs} or @file{xemacs}), and the paths to the directories where local
+Lisp and Info files will be installed. If the Emacs binary is not in your
+path, give the full path to the executable. Avoid spaces in any path names.
+@item Run @code{make config}
+again to check the configuration.
+@item Optionally run @code{make test}
+to build Org mode and then run the full testsuite.
+@item Run @code{make install} or @code{sudo make install}
+to build and install Org mode on your system.
+@end itemize
-@example
-(setq load-path (cons "~/path/to/orgdir/contrib/lisp" load-path))
-@end example
+If you use a cloned Git repository, then the procedure is slightly different.
+The following description assumes that you are using the @code{master} branch
+(where the development is done). You could also use the @code{maint} branch
+instead, where the release versions are published, just replace @code{master}
+with @code{maint} in the description below.
-@noindent Now byte-compile the Lisp files with the shell command:
+@itemize @bullet
+@item Change into (@code{cd}) the Org repository.
+@item Run @code{git checkout master}
+to switch to the @code{master} branch of the Org repository.
+@item Run @code{make help}
+and then check and edit the file @file{local.mk}. You must set the name of
+the Emacs binary (likely either @file{emacs} or @file{xemacs}), and the paths
+to the directories where local Lisp and Info files will be installed. If the
+Emacs binary is not in your path, you must give the full path to the
+executable. Avoid spaces in any path names.
+@item Run @code{make config}
+to check the configuration.
+@item Run @code{make update2} or @code{make up2}
+to update the Git repository and build and install Org mode. The latter
+invocation runs the complete test suite before installation and installs only
+if the build passes all tests.
+@end itemize
+
+If you don't have access to the system-wide directories and you don't want to
+install somewhere into your home directory, you can run Org directly from the
+distribution directory or Org repository by compiling Org mode in place:
+
+@itemize @bullet
+@item Change into (@code{cd}) the Org repository.
+@item Run @code{git checkout master}
+to switch to the @code{master} branch of the Org repository.
+@item Run @code{make compile}
+@end itemize
+
+Last but not least you can also run Org mode directly from an Org repository
+without any compilation. Simply replace the last step in the recipe above
+with @code{make uncompiled}.
+
+Then add the following line to @file{.emacs}:
@example
-make
+(add-to-list 'load-path "~/path/to/orgdir/lisp")
@end example
-@noindent If you are running Org from the distribution directory, this is
-all. If you want to install Org into the system directories, use (as
-administrator)
+@noindent
+If you plan to use code from the @file{contrib} subdirectory without
+compiling them, do a similar step for this directory:
@example
-make install
+(add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t)
@end example
+If you want to include those files with the build and install, please
+customize the variable @code{ORG_ADD_CONTRIB} instead in your @code{local.mk}
+file, for more details please see this
+@uref{http://orgmode.org/worg/dev/org-build-system.html#sec-4-1-2,
+description on Worg}.
+
Installing Info files is system dependent, because of differences in the
-@file{install-info} program. The following should correctly install the Info
-files on most systems, please send a bug report if not@footnote{The output
-from install-info (if any) is also system dependent. In particular Debian
-and its derivatives use two different versions of install-info and you may
-see the message:
+@file{install-info} program. The Info documentation is installed together
+with the rest of Org mode. If you don't install Org mode, it is possible to
+install the Info documentation separately (you need to have
+install-info@footnote{The output from install-info (if any) is system
+dependent. In particular Debian and its derivatives use two different
+versions of install-info and you may see the message:
@example
This is not dpkg install-info anymore, but GNU install-info
See the man page for ginstall-info for command line arguments
@end example
-@noindent which can be safely ignored.}.
+@noindent which can be safely ignored.}
+on your system).
@example
make install-info
@end example
-Then add the following line to @file{.emacs}. It is needed so that
-Emacs can autoload functions that are located in files not immediately loaded
-when Org-mode starts.
-@lisp
-(require 'org-install)
-@end lisp
-
Do not forget to activate Org as described in the following section.
@page
@@ -910,17 +971,28 @@ Do not forget to activate Org as described in the following section.
@section Activation
@cindex activation
@cindex autoload
+@cindex ELPA
@cindex global key bindings
@cindex key bindings, global
+@findex org-agenda
+@findex org-capture
+@findex org-store-link
+@findex org-iswitchb
+
+Since Emacs 22.2, files with the @file{.org} extension use Org mode by
+default. If you are using an earlier version of Emacs, add this line to your
+@file{.emacs} file:
-To make sure files with extension @file{.org} use Org mode, add the following
-line to your @file{.emacs} file.
@lisp
(add-to-list 'auto-mode-alist '("\\.org\\'" . org-mode))
@end lisp
-@noindent Org mode buffers need font-lock to be turned on - this is the
-default in Emacs@footnote{If you don't use font-lock globally, turn it on in
-Org buffer with @code{(add-hook 'org-mode-hook 'turn-on-font-lock)}}.
+
+Org mode buffers need font-lock to be turned on - this is the default in
+Emacs@footnote{If you don't use font-lock globally, turn it on in Org buffer
+with @code{(add-hook 'org-mode-hook 'turn-on-font-lock)}}.
+
+There are compatibility issues between Org mode and some other Elisp
+packages, please take the time to check the list (@pxref{Conflicts}).
The four Org commands @command{org-store-link}, @command{org-capture},
@command{org-agenda}, and @command{org-iswitchb} should be accessible through
@@ -934,9 +1006,9 @@ liking.
(global-set-key "\C-cb" 'org-iswitchb)
@end lisp
-@cindex Org-mode, turning on
+@cindex Org mode, turning on
With this setup, all files with extension @samp{.org} will be put
-into Org-mode. As an alternative, make the first line of a file look
+into Org mode. As an alternative, make the first line of a file look
like this:
@example
@@ -944,7 +1016,7 @@ MY PROJECTS -*- mode: org; -*-
@end example
@vindex org-insert-mode-line-in-empty-file
-@noindent which will select Org-mode for this buffer no matter what
+@noindent which will select Org mode for this buffer no matter what
the file's name is. See also the variable
@code{org-insert-mode-line-in-empty-file}.
@@ -987,6 +1059,34 @@ version information of Emacs (@kbd{M-x emacs-version @key{RET}}) and Org
that you only need to add your description. If you re not sending the Email
from within Emacs, please copy and paste the content into your Email program.
+Sometimes you might face a problem due to an error in your Emacs or Org mode
+setup. Before reporting a bug, it is very helpful to start Emacs with minimal
+customizations and reproduce the problem. Doing so often helps you determine
+if the problem is with your customization or with Org mode itself. You can
+start a typical minimal session with a command like the example below.
+
+@example
+$ emacs -Q -l /path/to/minimal-org.el
+@end example
+
+However if you are using Org mode as distributed with Emacs, a minimal setup
+is not necessary. In that case it is sufficient to start Emacs as
+@code{emacs -Q}. The @code{minimal-org.el} setup file can have contents as
+shown below.
+
+@example
+;;; Minimal setup to load latest `org-mode'
+
+;; activate debugging
+(setq debug-on-error t
+ debug-on-signal nil
+ debug-on-quit nil)
+
+;; add latest org-mode to load path
+(add-to-list 'load-path (expand-file-name "/path/to/org-mode/lisp"))
+(add-to-list 'load-path (expand-file-name "/path/to/org-mode/contrib/lisp" t))
+@end example
+
If an error occurs, a backtrace can be very useful (see below on how to
create one). Often a small example file helps, along with clear information
about:
@@ -1009,7 +1109,7 @@ error occurred. Here is how to produce a useful backtrace:
@enumerate
@item
-Reload uncompiled versions of all Org-mode Lisp files. The backtrace
+Reload uncompiled versions of all Org mode Lisp files. The backtrace
contains much more information if it is produced with uncompiled code.
To do this, use
@example
@@ -1033,7 +1133,9 @@ attach it to your bug report.
@node Conventions, , Feedback, Introduction
@section Typesetting conventions used in this manual
-Org uses three types of keywords: TODO keywords, tags, and property
+@subsubheading TODO keywords, tags, properties, etc.
+
+Org mainly uses three types of keywords: TODO keywords, tags and property
names. In this manual we use the following conventions:
@table @code
@@ -1051,17 +1153,33 @@ User-defined properties are capitalized; built-in properties with
special meaning are written with all capitals.
@end table
-The manual lists both the keys and the corresponding commands for accessing
-functionality. Org mode often uses the same key for different functions,
-depending on context. The command that is bound to such keys has a generic
-name, like @code{org-metaright}. In the manual we will, wherever possible,
-give the function that is internally called by the generic command. For
-example, in the chapter on document structure, @kbd{M-@key{right}} will be
-listed to call @code{org-do-demote}, while in the chapter on tables, it will
-be listed to call org-table-move-column-right.
-
-If you prefer, you can compile the manual without the command names by
-unsetting the flag @code{cmdnames} in @file{org.texi}.
+Moreover, Org uses @i{option keywords} (like @code{#+TITLE} to set the title)
+and @i{environment keywords} (like @code{#+BEGIN_HTML} to start a @code{HTML}
+environment). They are written in uppercase in the manual to enhance its
+readability, but you can use lowercase in your Org files@footnote{Easy
+templates insert lowercase keywords and Babel dynamically inserts
+@code{#+results}.}
+
+@subsubheading Keybindings and commands
+@kindex C-c a
+@findex org-agenda
+@kindex C-c c
+@findex org-capture
+
+The manual suggests two global keybindings: @kbd{C-c a} for @code{org-agenda}
+and @kbd{C-c c} for @code{org-capture}. These are only suggestions, but the
+rest of the manual assumes that you are using these keybindings.
+
+Also, the manual lists both the keys and the corresponding commands for
+accessing a functionality. Org mode often uses the same key for different
+functions, depending on context. The command that is bound to such keys has
+a generic name, like @code{org-metaright}. In the manual we will, wherever
+possible, give the function that is internally called by the generic command.
+For example, in the chapter on document structure, @kbd{M-@key{right}} will
+be listed to call @code{org-do-demote}, while in the chapter on tables, it
+will be listed to call @code{org-table-move-column-right}. If you prefer,
+you can compile the manual without the command names by unsetting the flag
+@code{cmdnames} in @file{org.texi}.
@node Document Structure, Tables, Introduction, Top
@chapter Document structure
@@ -1111,7 +1229,8 @@ Headlines define the structure of an outline tree. The headlines in Org
start with one or more stars, on the left margin@footnote{See the variables
@code{org-special-ctrl-a/e}, @code{org-special-ctrl-k}, and
@code{org-ctrl-k-protect-subtree} to configure special behavior of @kbd{C-a},
-@kbd{C-e}, and @kbd{C-k} in headlines.}. For example:
+@kbd{C-e}, and @kbd{C-k} in headlines.} @footnote{Clocking only works with
+headings indented less then 30 stars.}. For example:
@example
* Top level headline
@@ -1191,15 +1310,21 @@ tables, @kbd{S-@key{TAB}} jumps to the previous field.
@cindex show all, command
@orgcmd{C-u C-u C-u @key{TAB},show-all}
Show all, including drawers.
+@cindex revealing context
@orgcmd{C-c C-r,org-reveal}
Reveal context around point, showing the current entry, the following heading
and the hierarchy above. Useful for working near a location that has been
exposed by a sparse tree command (@pxref{Sparse trees}) or an agenda command
(@pxref{Agenda commands}). With a prefix argument show, on each
-level, all sibling headings. With double prefix arg, also show the entire
-subtree of the parent.
+level, all sibling headings. With a double prefix argument, also show the
+entire subtree of the parent.
+@cindex show branches, command
@orgcmd{C-c C-k,show-branches}
Expose all the headings of the subtree, CONTENT view for just one subtree.
+@cindex show children, command
+@orgcmd{C-c @key{TAB},show-children}
+Expose all direct children of the subtree. With a numeric prefix argument N,
+expose all children down to level N.
@orgcmd{C-c C-x b,org-tree-to-indirect-buffer}
Show the current subtree in an indirect buffer@footnote{The indirect
buffer
@@ -1381,7 +1506,7 @@ more details, see the docstring of the command
@code{org-clone-subtree-with-time-shift}.
@orgcmd{C-c C-w,org-refile}
Refile entry or region to a different location. @xref{Refiling notes}.
-@orgcmd{C-c ^,org-sort-entries-or-items}
+@orgcmd{C-c ^,org-sort}
Sort same-level entries. When there is an active region, all entries in the
region will be sorted. Otherwise the children of the current headline are
sorted. The command prompts for the sorting method, which can be
@@ -1390,8 +1515,7 @@ creation time, scheduled time, deadline time), by priority, by TODO keyword
(in the sequence the keywords have been defined in the setup) or by the value
of a property. Reverse sorting is possible as well. You can also supply
your own function to extract the sorting key. With a @kbd{C-u} prefix,
-sorting will be case-sensitive. With two @kbd{C-u C-u} prefixes, duplicate
-entries will also be removed.
+sorting will be case-sensitive.
@orgcmd{C-x n s,org-narrow-to-subtree}
Narrow buffer to current subtree.
@orgcmd{C-x n b,org-narrow-to-block}
@@ -1430,7 +1554,7 @@ functionality.
@vindex org-show-following-heading
@vindex org-show-siblings
@vindex org-show-entry-below
-An important feature of Org-mode is the ability to construct @emph{sparse
+An important feature of Org mode is the ability to construct @emph{sparse
trees} for selected information in an outline tree, so that the entire
document is folded as much as possible, but the selected information is made
visible along with the headline structure above it@footnote{See also the
@@ -1439,7 +1563,7 @@ variables @code{org-show-hierarchy-above}, @code{org-show-following-heading},
control on how much context is shown around each match.}. Just try it out
and you will see immediately how it works.
-Org-mode contains several commands creating such trees, all these
+Org mode contains several commands creating such trees, all these
commands can be accessed through a dispatcher:
@table @asis
@@ -1542,16 +1666,11 @@ line. In particular, if an ordered list reaches number @samp{10.}, then the
list. An item ends before the next line that is less or equally indented
than its bullet/number.
-@vindex org-list-ending-method
-@vindex org-list-end-regexp
@vindex org-empty-line-terminates-plain-lists
-Two methods@footnote{To disable either of them, configure
-@code{org-list-ending-method}.} are provided to terminate lists. A list ends
-whenever every item has ended, which means before any line less or equally
-indented than items at top level. It also ends before two blank
+A list ends whenever every item has ended, which means before any line less
+or equally indented than items at top level. It also ends before two blank
lines@footnote{See also @code{org-empty-line-terminates-plain-lists}.}. In
-that case, all items are closed. For finer control, you can end lists with
-any pattern set in @code{org-list-end-regexp}. Here is an example:
+that case, all items are closed. Here is an example:
@example
@group
@@ -1597,14 +1716,18 @@ to disable them individually.
@table @asis
@orgcmd{@key{TAB},org-cycle}
+@cindex cycling, in plain lists
@vindex org-cycle-include-plain-lists
Items can be folded just like headline levels. Normally this works only if
the cursor is on a plain list item. For more details, see the variable
@code{org-cycle-include-plain-lists}. If this variable is set to
@code{integrate}, plain list items will be treated like low-level
-headlines. The level of an item is then given by the
-indentation of the bullet/number. Items are always subordinate to real
-headlines, however; the hierarchies remain completely separated.
+headlines. The level of an item is then given by the indentation of the
+bullet/number. Items are always subordinate to real headlines, however; the
+hierarchies remain completely separated. In a new item with no text yet, the
+first @key{TAB} demotes the item to become a child of the previous
+one. Subsequent @key{TAB}s move the item to meaningful levels in the list
+and eventually get it back to its initial position.
@orgcmd{M-@key{RET},org-insert-heading}
@vindex org-M-RET-may-split-line
@vindex org-list-automatic-rules
@@ -1615,17 +1738,15 @@ new item@footnote{If you do not want the item to be split, customize the
variable @code{org-M-RET-may-split-line}.}. If this command is executed
@emph{before item's body}, the new item is created @emph{before} the current
one.
+@end table
+
+@table @kbd
@kindex M-S-@key{RET}
-@item M-S-@key{RET}
+@item M-S-RET
Insert a new item with a checkbox (@pxref{Checkboxes}).
-@orgcmd{@key{TAB},org-cycle}
-In a new item with no text yet, the first @key{TAB} demotes the item to
-become a child of the previous one. Subsequent @key{TAB}s move the item to
-meaningful levels in the list and eventually get it back to its initial
-position.
@kindex S-@key{down}
-@item S-@key{up}
-@itemx S-@key{down}
+@item S-up
+@itemx S-down
@cindex shift-selection-mode
@vindex org-support-shift-select
@vindex org-list-use-circular-motion
@@ -1637,21 +1758,21 @@ jumping commands like @kbd{C-@key{up}} and @kbd{C-@key{down}} to quite
similar effect.
@kindex M-@key{up}
@kindex M-@key{down}
-@item M-@key{up}
-@itemx M-@key{down}
+@item M-up
+@itemx M-down
Move the item including subitems up/down@footnote{See
@code{org-liste-use-circular-motion} for a cyclic behavior.} (swap with
previous/next item of same indentation). If the list is ordered, renumbering
is automatic.
@kindex M-@key{left}
@kindex M-@key{right}
-@item M-@key{left}
-@itemx M-@key{right}
+@item M-left
+@itemx M-right
Decrease/increase the indentation of an item, leaving children alone.
@kindex M-S-@key{left}
@kindex M-S-@key{right}
-@item M-S-@key{left}
-@itemx M-S-@key{right}
+@item M-S-left
+@itemx M-S-right
Decrease/increase the indentation of the item, including subitems.
Initially, the item tree is selected based on current indentation. When
these commands are executed several times in direct succession, the initially
@@ -1670,19 +1791,16 @@ state of the checkbox. In any case, verify bullets and indentation
consistency in the whole list.
@kindex C-c -
@vindex org-plain-list-ordered-item-terminator
-@vindex org-list-automatic-rules
@item C-c -
Cycle the entire list level through the different itemize/enumerate bullets
(@samp{-}, @samp{+}, @samp{*}, @samp{1.}, @samp{1)}) or a subset of them,
depending on @code{org-plain-list-ordered-item-terminator}, the type of list,
-and its position@footnote{See @code{bullet} rule in
-@code{org-list-automatic-rules} for more information.}. With a numeric
-prefix argument N, select the Nth bullet from this list. If there is an
-active region when calling this, selected text will be changed into an item.
-With a prefix argument, all lines will be converted to list items. If the
-first line already was a list item, any item marker will be removed from the
-list. Finally, even without an active region, a normal line will be
-converted into a list item.
+and its indentation. With a numeric prefix argument N, select the Nth bullet
+from this list. If there is an active region when calling this, selected
+text will be changed into an item. With a prefix argument, all lines will be
+converted to list items. If the first line already was a list item, any item
+marker will be removed from the list. Finally, even without an active
+region, a normal line will be converted into a list item.
@kindex C-c *
@item C-c *
Turn a plain list item into a headline (so that it becomes a subheading at
@@ -1694,7 +1812,7 @@ Turn the whole plain list into a subtree of the current heading. Checkboxes
(resp. checked).
@kindex S-@key{left}
@kindex S-@key{right}
-@item S-@key{left}/@key{right}
+@item S-left/right
@vindex org-support-shift-select
This command also cycles bullet styles when the cursor in on the bullet or
anywhere in an item line, details depending on
@@ -1712,11 +1830,13 @@ numerically, alphabetically, by time, or by custom function.
@cindex visibility cycling, drawers
@vindex org-drawers
+@cindex org-insert-drawer
+@kindex C-c C-x d
Sometimes you want to keep information associated with an entry, but you
-normally don't want to see it. For this, Org-mode has @emph{drawers}.
+normally don't want to see it. For this, Org mode has @emph{drawers}.
Drawers need to be configured with the variable
-@code{org-drawers}@footnote{You can define drawers on a per-file basis
-with a line like @code{#+DRAWERS: HIDDEN PROPERTIES STATE}}. Drawers
+@code{org-drawers}@footnote{You can define additional drawers on a
+per-file basis with a line like @code{#+DRAWERS: HIDDEN STATE}}. Drawers
look like this:
@example
@@ -1728,10 +1848,17 @@ look like this:
After the drawer.
@end example
+You can interactively insert drawers at point by calling
+@code{org-insert-drawer}, which is bound to @key{C-c C-x d}. With an active
+region, this command will put the region inside the drawer. With a prefix
+argument, this command calls @code{org-insert-property-drawer} and add a
+property drawer right below the current headline. Completion over drawer
+keywords is also possible using @key{M-TAB}.
+
Visibility cycling (@pxref{Visibility cycling}) on the headline will hide and
show the entry, but keep the drawer collapsed to a single line. In order to
look inside the drawer, you need to move the cursor to the drawer line and
-press @key{TAB} there. Org-mode uses the @code{PROPERTIES} drawer for
+press @key{TAB} there. Org mode uses the @code{PROPERTIES} drawer for
storing properties (@pxref{Properties and Columns}), and you can also arrange
for state change notes (@pxref{Tracking TODO state changes}) and clock times
(@pxref{Clocking work time}) to be stored in a drawer @code{LOGBOOK}. If you
@@ -1748,7 +1875,7 @@ Add a time-stamped note to the LOGBOOK drawer.
@vindex org-hide-block-startup
@cindex blocks, folding
-Org-mode uses begin...end blocks for various purposes from including source
+Org mode uses begin...end blocks for various purposes from including source
code examples (@pxref{Literal examples}) to capturing time logging
information (@pxref{Clocking work time}). These blocks can be folded and
unfolded by pressing TAB in the begin line. You can also get all blocks
@@ -1766,8 +1893,8 @@ or on a per-file basis by using
@section Footnotes
@cindex footnotes
-Org-mode supports the creation of footnotes. In contrast to the
-@file{footnote.el} package, Org-mode's footnotes are designed for work on a
+Org mode supports the creation of footnotes. In contrast to the
+@file{footnote.el} package, Org mode's footnotes are designed for work on a
larger document, not only for one-off documents like emails. The basic
syntax is similar to the one used by @file{footnote.el}, i.e.@: a footnote is
defined in a paragraph that is started by a footnote marker in square
@@ -1781,11 +1908,11 @@ The Org homepage[fn:1] now looks a lot better than it used to.
[fn:1] The link is: http://orgmode.org
@end example
-Org-mode extends the number-based syntax to @emph{named} footnotes and
+Org mode extends the number-based syntax to @emph{named} footnotes and
optional inline definition. Using plain numbers as markers (as
@file{footnote.el} does) is supported for backward compatibility, but not
encouraged because of possible conflicts with @LaTeX{} snippets (@pxref{Embedded
-LaTeX}). Here are the valid references:
+@LaTeX{}}). Here are the valid references:
@table @code
@item [1]
@@ -1875,7 +2002,7 @@ you can use the usual commands to follow these links.
@cindex Orgstruct mode
@cindex minor mode for structure editing
-If you like the intuitive way the Org-mode structure editing and list
+If you like the intuitive way the Org mode structure editing and list
formatting works, you might want to use these commands in other modes like
Text mode or Mail mode as well. The minor mode @code{orgstruct-mode} makes
this possible. Toggle the mode with @kbd{M-x orgstruct-mode}, or
@@ -1902,13 +2029,7 @@ item.
Org comes with a fast and intuitive table editor. Spreadsheet-like
calculations are supported using the Emacs @file{calc} package
-@ifinfo
-(@pxref{Top,Calc,,Calc,Gnu Emacs Calculator Manual}).
-@end ifinfo
-@ifnotinfo
-(see the Emacs Calculator manual for more information about the Emacs
-calculator).
-@end ifnotinfo
+(@pxref{Top, Calc, , calc, Gnu Emacs Calculator Manual}).
@menu
* Built-in table editor:: Simple tables
@@ -2188,7 +2309,7 @@ on a per-file basis with:
If you would like to overrule the automatic alignment of number-rich columns
to the right and of string-rich column to the left, you can use @samp{<r>},
-@samp{c}@footnote{Centering does not work inside Emacs, but it does have an
+@samp{<c>}@footnote{Centering does not work inside Emacs, but it does have an
effect when exporting to HTML.} or @samp{<l>} in a similar fashion. You may
also combine alignment and field width like this: @samp{<l10>}.
@@ -2206,7 +2327,8 @@ of columns, much like horizontal lines can do for groups of rows. In
order to specify column groups, you can use a special row where the
first field contains only @samp{/}. The further fields can either
contain @samp{<} to indicate that this column should start a group,
-@samp{>} to indicate the end of a column, or @samp{<>} to make a column
+@samp{>} to indicate the end of a column, or @samp{<>} (no space between @samp{<}
+and @samp{>}) to make a column
a group of its own. Boundaries between column groups will upon export be
marked with vertical lines. Here is an example:
@@ -2276,7 +2398,7 @@ formula, moving these references by arrow keys
* Column formulas:: Formulas valid for an entire column
* Editing and debugging formulas:: Fixing formulas
* Updating the table:: Recomputing all dependent fields
-* Advanced features:: Field names, parameters and automatic recalc
+* Advanced features:: Field and column names, parameters and automatic recalc
@end menu
@node References, Formula syntax for Calc, The spreadsheet, The spreadsheet
@@ -2468,9 +2590,8 @@ A formula can be any algebraic expression understood by the Emacs
non-standard convention that @samp{/} has lower precedence than
@samp{*}, so that @samp{a/b*c} is interpreted as @samp{a/(b*c)}.} Before
evaluation by @code{calc-eval} (@pxref{Calling Calc from
-Your Programs,calc-eval,Calling Calc from Your Lisp Programs,Calc,GNU
+Your Programs, calc-eval, Calling Calc from Your Lisp Programs, calc, GNU
Emacs Calc Manual}),
-@c FIXME: The link to the Calc manual in HTML does not work.
variable substitution takes place according to the rules described above.
@cindex vectors, in table calculations
The range vectors can be directly fed into the Calc vector functions
@@ -2539,23 +2660,28 @@ durations computations @ref{Durations and time values}.
@subsection Emacs Lisp forms as formulas
@cindex Lisp forms, as table formulas
-It is also possible to write a formula in Emacs Lisp; this can be useful for
-string manipulation and control structures, if Calc's functionality is not
-enough. If a formula starts with a single-quote followed by an opening
-parenthesis, then it is evaluated as a Lisp form. The evaluation should
-return either a string or a number. Just as with @file{calc} formulas, you
-can specify modes and a printf format after a semicolon. With Emacs Lisp
-forms, you need to be conscious about the way field references are
-interpolated into the form. By default, a reference will be interpolated as
-a Lisp string (in double-quotes) containing the field. If you provide the
-@samp{N} mode switch, all referenced elements will be numbers (non-number
-fields will be zero) and interpolated as Lisp numbers, without quotes. If
-you provide the @samp{L} flag, all fields will be interpolated literally,
-without quotes. I.e., if you want a reference to be interpreted as a string
-by the Lisp form, enclose the reference operator itself in double-quotes,
-like @code{"$3"}. Ranges are inserted as space-separated fields, so you can
-embed them in list or vector syntax. Here are a few examples---note how the
-@samp{N} mode is used when we do computations in Lisp:
+It is also possible to write a formula in Emacs Lisp. This can be useful
+for string manipulation and control structures, if Calc's functionality is
+not enough.
+
+If a formula starts with a single-quote followed by an opening parenthesis,
+then it is evaluated as a Lisp form. The evaluation should return either a
+string or a number. Just as with @file{calc} formulas, you can specify modes
+and a printf format after a semicolon.
+
+With Emacs Lisp forms, you need to be conscious about the way field
+references are interpolated into the form. By default, a reference will be
+interpolated as a Lisp string (in double-quotes) containing the field. If
+you provide the @samp{N} mode switch, all referenced elements will be numbers
+(non-number fields will be zero) and interpolated as Lisp numbers, without
+quotes. If you provide the @samp{L} flag, all fields will be interpolated
+literally, without quotes. I.e., if you want a reference to be interpreted
+as a string by the Lisp form, enclose the reference operator itself in
+double-quotes, like @code{"$3"}. Ranges are inserted as space-separated
+fields, so you can embed them in list or vector syntax.
+
+Here are a few examples---note how the @samp{N} mode is used when we do
+computations in Lisp:
@example
@r{Swap the first two characters of the content of column 1}
@@ -2587,7 +2713,7 @@ formulas or Elisp formulas:
Input duration values must be of the form @code{[HH:MM[:SS]}, where seconds
are optional. With the @code{T} flag, computed durations will be displayed
-as @code{[HH:MM:SS} (see the first formula above). With the @code{t} flag,
+as @code{HH:MM:SS} (see the first formula above). With the @code{t} flag,
computed durations will be displayed according to the value of the variable
@code{org-table-duration-custom-format}, which defaults to @code{'hours} and
will display the result as a fraction of hours (see the second formula in the
@@ -2619,7 +2745,7 @@ modified in order to still reference the same field. To avoid this from
happening, in particular in range references, anchor ranges at the table
borders (using @code{@@<}, @code{@@>}, @code{$<}, @code{$>}), or at hlines
using the @code{@@I} notation. Automatic adaptation of field references does
-of cause not happen if you edit the table structure with normal editing
+of course not happen if you edit the table structure with normal editing
commands---then you must fix the equations yourself.
Instead of typing an equation into the field, you may also use the following
@@ -2833,9 +2959,11 @@ dependencies.
@node Advanced features, , Updating the table, The spreadsheet
@subsection Advanced features
-If you want the recalculation of fields to happen automatically, or if
-you want to be able to assign @i{names} to fields and columns, you need
-to reserve the first column of the table for special marking characters.
+If you want the recalculation of fields to happen automatically, or if you
+want to be able to assign @i{names}@footnote{Such names must start by an
+alphabetic character and use only alphanumeric/underscore characters.} to
+fields and columns, you need to reserve the first column of the table for
+special marking characters.
@table @kbd
@orgcmd{C-#,org-table-rotate-recalc-marks}
@@ -2859,7 +2987,7 @@ makes use of these features:
| # | Peter | 10 | 8 | 23 | 41 | 8.2 |
| # | Sam | 2 | 4 | 3 | 9 | 1.8 |
|---+---------+--------+--------+--------+-------+------|
-| | Average | | | | 29.7 | |
+| | Average | | | | 25.0 | |
| ^ | | | | | at | |
| $ | max=50 | | | | | |
|---+---------+--------+--------+--------+-------+------|
@@ -3005,7 +3133,7 @@ When plotting @code{3d} or @code{grid} types, set this to @code{t} to graph a
flat mapping rather than a @code{3d} slope.
@item timefmt
-Specify format of Org-mode timestamps as they will be parsed by Gnuplot.
+Specify format of Org mode timestamps as they will be parsed by Gnuplot.
Defaults to @samp{%Y-%m-%d-%H:%M:%S}.
@item script
@@ -3168,17 +3296,27 @@ file:papers/last.pdf @r{file, relative path}
./papers/last.pdf @r{same as above}
file:/myself@@some.where:papers/last.pdf @r{file, path on remote machine}
/myself@@some.where:papers/last.pdf @r{same as above}
-file:sometextfile::NNN @r{file with line number to jump to}
+file:sometextfile::NNN @r{file, jump to line number}
file:projects.org @r{another Org file}
-file:projects.org::some words @r{text search in Org file}
+file:projects.org::some words @r{text search in Org file}@footnote{
+The actual behavior of the search will depend on the value of
+the variable @code{org-link-search-must-match-exact-headline}. If its value
+is nil, then a fuzzy text search will be done. If it is t, then only the
+exact headline will be matched. If the value is @code{'query-to-create},
+then an exact headline will be searched; if it is not found, then the user
+will be queried to create it.}
file:projects.org::*task title @r{heading search in Org file}
-docview:papers/last.pdf::NNN @r{open file in doc-view mode at page NNN}
+file+sys:/path/to/file @r{open via OS, like double-click}
+file+emacs:/path/to/file @r{force opening by Emacs}
+docview:papers/last.pdf::NNN @r{open in doc-view mode at page}
id:B7423F4D-2E8A-471B-8810-C40F074717E9 @r{Link to heading by ID}
news:comp.emacs @r{Usenet link}
mailto:adent@@galaxy.net @r{Mail link}
vm:folder @r{VM folder link}
vm:folder#id @r{VM message link}
vm://myself@@some.where.org/folder#id @r{VM on remote machine}
+vm-imap:account:folder @r{VM IMAP folder link}
+vm-imap:account:folder#id @r{VM IMAP message link}
wl:folder @r{WANDERLUST folder link}
wl:folder#id @r{WANDERLUST message link}
mhe:folder @r{MH-E folder link}
@@ -3189,7 +3327,7 @@ gnus:group @r{Gnus group link}
gnus:group#id @r{Gnus article link}
bbdb:R.*Stallman @r{BBDB link (with regexp)}
irc:/irc.com/#emacs/bob @r{IRC link}
-info:org#External%20links @r{Info node link (with encoded space)}
+info:org#External links @r{Info node link}
shell:ls *.org @r{A shell command}
elisp:org-agenda @r{Interactive Elisp command}
elisp:(find-file-other-frame "Elisp.org") @r{Elisp form to evaluate}
@@ -3235,7 +3373,7 @@ create a link. The link will be stored for later insertion into an Org
buffer (see below). What kind of link will be created depends on the current
buffer:
-@b{Org-mode buffers}@*
+@b{Org mode buffers}@*
For Org files, if there is a @samp{<<target>>} at the cursor, the link points
to the target. Otherwise it points to the current headline, which will also
be the description@footnote{If the headline contains a timestamp, it will be
@@ -3338,6 +3476,7 @@ link and description parts of the link.
@cindex following links
@orgcmd{C-c C-o,org-open-at-point}
@vindex org-file-apps
+@vindex org-link-frame-setup
Open link at point. This will launch a web browser for URLs (using
@command{browse-url-at-point}), run VM/MH-E/Wanderlust/Rmail/Gnus/BBDB for
the corresponding links, and execute the command in a shell link. When the
@@ -3351,7 +3490,9 @@ Classification of files is based on file extension only. See option
visit the file with Emacs, use a @kbd{C-u} prefix. If you want to avoid
opening in Emacs, use a @kbd{C-u C-u} prefix.@*
If the cursor is on a headline, but not on a link, offer all links in the
-headline and entry text.
+headline and entry text. If you want to setup the frame configuration for
+following links, customize @code{org-link-frame-setup}.
+
@orgkey @key{RET}
@vindex org-return-follows-link
When @code{org-return-follows-link} is set, @kbd{@key{RET}} will also follow
@@ -3447,18 +3588,26 @@ that relates the linkwords to replacement text. Here is an example:
@smalllisp
@group
(setq org-link-abbrev-alist
- '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=")
- ("google" . "http://www.google.com/search?q=")
- ("gmap" . "http://maps.google.com/maps?q=%s")
- ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1")
- ("ads" . "http://adsabs.harvard.edu/cgi-bin/nph-abs_connect?author=%s&db_key=AST")))
+ '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=")
+ ("url-to-ja" . "http://translate.google.fr/translate?sl=en&tl=ja&u=%h")
+ ("google" . "http://www.google.com/search?q=")
+ ("gmap" . "http://maps.google.com/maps?q=%s")
+ ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1")
+ ("ads" . "http://adsabs.harvard.edu/cgi-bin/nph-abs_connect?author=%s&db_key=AST")))
@end group
@end smalllisp
If the replacement text contains the string @samp{%s}, it will be
-replaced with the tag. Otherwise the tag will be appended to the string
-in order to create the link. You may also specify a function that will
-be called with the tag as the only argument to create the link.
+replaced with the tag. Using @samp{%h} instead of @samp{%s} will
+url-encode the tag (see the example above, where we need to encode
+the URL parameter.) Using @samp{%(my-function)} will pass the tag
+to a custom function, and replace it by the resulting string.
+
+If the replacement text don't contain any specifier, it will simply
+be appended to the string in order to create the link.
+
+Instead of a string, you may also specify a function that will be
+called with the tag as the only argument to create the link.
With the above setting, you could link to a specific bug with
@code{[[bugzilla:129]]}, search the web for @samp{OrgMode} with
@@ -3516,7 +3665,7 @@ Jump to line 255.
Search for a link target @samp{<<My Target>>}, or do a text search for
@samp{my target}, similar to the search in internal links, see
@ref{Internal links}. In HTML export (@pxref{HTML export}), such a file
-link will become an HTML reference to the corresponding named anchor in
+link will become a HTML reference to the corresponding named anchor in
the linked file.
@item *My Target
In an Org file, restrict search to headlines.
@@ -3525,7 +3674,7 @@ Link to a heading with a @code{CUSTOM_ID} property
@item /regexp/
Do a regular expression search for @code{regexp}. This uses the Emacs
command @code{occur} to list all matches in a separate window. If the
-target file is in Org-mode, @code{org-occur} is used to create a
+target file is in Org mode, @code{org-occur} is used to create a
sparse tree with the matches.
@c If the target file is a directory,
@c @code{grep} will be used to search all files in the directory.
@@ -3564,7 +3713,7 @@ an implementation example. See the file @file{org-bibtex.el}.
@chapter TODO items
@cindex TODO items
-Org-mode does not maintain TODO lists as separate documents@footnote{Of
+Org mode does not maintain TODO lists as separate documents@footnote{Of
course, you can make a document that contains only long lists of TODO items,
but this is not required.}. Instead, TODO items are an integral part of the
notes file, because TODO items usually come up while taking notes! With Org
@@ -3573,7 +3722,7 @@ information is not duplicated, and the entire context from which the TODO
item emerged is always present.
Of course, this technique for managing TODO items scatters them
-throughout your notes file. Org-mode compensates for this by providing
+throughout your notes file. Org mode compensates for this by providing
methods to give you an overview of all the things that you have to do.
@menu
@@ -3626,7 +3775,7 @@ mostly if more than two TODO states are possible (@pxref{TODO
extensions}). See also @ref{Conflicts}, for a discussion of the interaction
with @code{shift-selection-mode}. See also the variable
@code{org-treat-S-cursor-todo-selection-as-state-change}.
-@orgcmd{C-c / t,org-show-todo-key}
+@orgcmd{C-c / t,org-show-todo-tree}
@cindex sparse tree, for TODO
@vindex org-todo-keywords
View TODO items in a @emph{sparse tree} (@pxref{Sparse trees}). Folds the
@@ -3659,7 +3808,7 @@ option @code{org-todo-state-tags-triggers} for details.
@vindex org-todo-keywords
By default, marked TODO entries have one of only two states: TODO and
-DONE. Org-mode allows you to classify TODO items in more complex ways
+DONE. Org mode allows you to classify TODO items in more complex ways
with @emph{TODO keywords} (stored in @code{org-todo-keywords}). With
special setup, the TODO keyword system can work differently in different
files.
@@ -3684,7 +3833,7 @@ TODO items in particular (@pxref{Tags}).
You can use TODO keywords to indicate different @emph{sequential} states
in the process of working on an item, for example@footnote{Changing
-this variable only becomes effective after restarting Org-mode in a
+this variable only becomes effective after restarting Org mode in a
buffer.}:
@lisp
@@ -3727,7 +3876,7 @@ be set up like this:
In this case, different keywords do not indicate a sequence, but rather
different types. So the normal work flow would be to assign a task to a
-person, and later to mark it DONE. Org-mode supports this style by adapting
+person, and later to mark it DONE. Org mode supports this style by adapting
the workings of the command @kbd{C-c C-t}@footnote{This is also true for the
@kbd{t} command in the timeline and agenda buffers.}. When used several
times in succession, it will still cycle through all names, in order to first
@@ -3758,7 +3907,7 @@ like this:
(sequence "|" "CANCELED")))
@end lisp
-The keywords should all be different, this helps Org-mode to keep track
+The keywords should all be different, this helps Org mode to keep track
of which subsequence should be used for a given entry. In this setup,
@kbd{C-c C-t} only operates within a subsequence, so it switches from
@code{DONE} to (nothing) to @code{TODO}, and from @code{FIXED} to
@@ -3793,9 +3942,10 @@ from @code{DONE} to @code{REPORT} in the example above. See also
@subsection Fast access to TODO states
If you would like to quickly change an entry to an arbitrary TODO state
-instead of cycling through the states, you can set up keys for
-single-letter access to the states. This is done by adding the section
-key after each keyword, in parentheses. For example:
+instead of cycling through the states, you can set up keys for single-letter
+access to the states. This is done by adding the selection character after
+each keyword, in parentheses@footnote{All characters are allowed except
+@code{@@^!}, which have a special meaning here.}. For example:
@lisp
(setq org-todo-keywords
@@ -3855,9 +4005,9 @@ Remember that the keywords after the vertical bar (or the last keyword
if no bar is there) must always mean that the item is DONE (although you
may use a different word). After changing one of these lines, use
@kbd{C-c C-c} with the cursor still in the line to make the changes
-known to Org-mode@footnote{Org-mode parses these lines only when
-Org-mode is activated after visiting a file. @kbd{C-c C-c} with the
-cursor in a line starting with @samp{#+} is simply restarting Org-mode
+known to Org mode@footnote{Org mode parses these lines only when
+Org mode is activated after visiting a file. @kbd{C-c C-c} with the
+cursor in a line starting with @samp{#+} is simply restarting Org mode
for the current buffer.}.
@node Faces for TODO keywords, TODO dependencies, Per-file keywords, TODO extensions
@@ -3867,7 +4017,7 @@ for the current buffer.}.
@vindex org-todo @r{(face)}
@vindex org-done @r{(face)}
@vindex org-todo-keyword-faces
-Org-mode highlights TODO keywords with special faces: @code{org-todo}
+Org mode highlights TODO keywords with special faces: @code{org-todo}
for keywords indicating that an item still has to be acted upon, and
@code{org-done} for keywords indicating that an item is finished. If
you are using more than 2 different states, you might want to use
@@ -3955,7 +4105,7 @@ module @file{org-depend.el}.
@cindex progress logging
@cindex logging, of progress
-Org-mode can automatically record a timestamp and possibly a note when
+Org mode can automatically record a timestamp and possibly a note when
you mark a TODO item as DONE, or even each time you change the state of
a TODO item. This system is highly configurable, settings can be on a
per-keyword basis and can be localized to a file or even a subtree. For
@@ -4014,26 +4164,32 @@ time-stamped note for a change. These records will be inserted after the
headline as an itemized list, newest first@footnote{See the variable
@code{org-log-states-order-reversed}}. When taking a lot of notes, you might
want to get the notes out of the way into a drawer (@pxref{Drawers}).
-Customize the variable @code{org-log-into-drawer} to get this
-behavior---the recommended drawer for this is called @code{LOGBOOK}. You can
-also overrule the setting of this variable for a subtree by setting a
+Customize the variable @code{org-log-into-drawer} to get this behavior---the
+recommended drawer for this is called @code{LOGBOOK}@footnote{Note that the
+@code{LOGBOOK} drawer is unfolded when pressing @key{SPC} in the agenda to
+show an entry---use @key{C-u SPC} to keep it folded here}. You can also
+overrule the setting of this variable for a subtree by setting a
@code{LOG_INTO_DRAWER} property.
-Since it is normally too much to record a note for every state, Org-mode
+Since it is normally too much to record a note for every state, Org mode
expects configuration on a per-keyword basis for this. This is achieved by
-adding special markers @samp{!} (for a timestamp) and @samp{@@} (for a note)
-in parentheses after each keyword. For example, with the setting
+adding special markers @samp{!} (for a timestamp) or @samp{@@} (for a note
+with timestamp) in parentheses after each keyword. For example, with the
+setting
@lisp
(setq org-todo-keywords
'((sequence "TODO(t)" "WAIT(w@@/!)" "|" "DONE(d!)" "CANCELED(c@@)")))
@end lisp
+To record a timestamp without a note for TODO keywords configured with
+@samp{@@}, just type @kbd{C-c C-c} to enter a blank note when prompted.
+
@noindent
@vindex org-log-done
you not only define global TODO keywords and fast access keys, but also
request that a time is recorded when the entry is set to
-DONE@footnote{It is possible that Org-mode will record two timestamps
+DONE@footnote{It is possible that Org mode will record two timestamps
when you are using both @code{org-log-done} and state change logging.
However, it will never prompt for two notes---if you have configured
both, the state change recording note will take precedence and cancel
@@ -4102,10 +4258,10 @@ The TODO may also have minimum and maximum ranges specified by using the
syntax @samp{.+2d/3d}, which says that you want to do the task at least every
three days, but at most every two days.
@item
-You must also have state logging for the @code{DONE} state enabled, in order
-for historical data to be represented in the consistency graph. If it is not
-enabled it is not an error, but the consistency graphs will be largely
-meaningless.
+You must also have state logging for the @code{DONE} state enabled
+(@pxref{Tracking TODO state changes}), in order for historical data to be
+represented in the consistency graph. If it is not enabled it is not an
+error, but the consistency graphs will be largely meaningless.
@end enumerate
To give you an idea of what the above rules look like in action, here's an
@@ -4182,7 +4338,7 @@ which should only be done in certain contexts, for example.
@section Priorities
@cindex priorities
-If you use Org-mode extensively, you may end up with enough TODO items that
+If you use Org mode extensively, you may end up with enough TODO items that
it starts to make sense to prioritize them. Prioritizing can be done by
placing a @emph{priority cookie} into the headline of a TODO item, like this
@@ -4192,11 +4348,11 @@ placing a @emph{priority cookie} into the headline of a TODO item, like this
@noindent
@vindex org-priority-faces
-By default, Org-mode supports three priorities: @samp{A}, @samp{B}, and
+By default, Org mode supports three priorities: @samp{A}, @samp{B}, and
@samp{C}. @samp{A} is the highest priority. An entry without a cookie is
treated just like priority @samp{B}. Priorities make a difference only for
sorting in the agenda (@pxref{Weekly/daily agenda}); outside the agenda, they
-have no inherent meaning to Org-mode. The cookies can be highlighted with
+have no inherent meaning to Org mode. The cookies can be highlighted with
special faces by customizing the variable @code{org-priority-faces}.
Priorities can be attached to any outline node; they do not need to be TODO
@@ -4363,9 +4519,11 @@ off a box while there are unchecked boxes above it.
@table @kbd
@orgcmd{C-c C-c,org-toggle-checkbox}
-Toggle checkbox status or (with prefix arg) checkbox presence at point. With
-double prefix argument, set it to @samp{[-]}, which is considered to be an
-intermediate state.
+Toggle checkbox status or (with prefix arg) checkbox presence at point.
+With a single prefix argument, add an empty checkbox or remove the current
+one@footnote{`C-u C-c C-c' on the @emph{first} item of a list with no checkbox
+will add checkboxes to the rest of the list.}. With a double prefix argument, set it to @samp{[-]}, which is
+considered to be an intermediate state.
@orgcmd{C-c C-x C-b,org-toggle-checkbox}
Toggle checkbox status or (with prefix arg) checkbox presence at point. With
double prefix argument, set it to @samp{[-]}, which is considered to be an
@@ -4410,7 +4568,7 @@ hand, use this command to get things back into sync.
@cindex sparse tree, tag based
An excellent way to implement labels and contexts for cross-correlating
-information is to assign @i{tags} to headlines. Org-mode has extensive
+information is to assign @i{tags} to headlines. Org mode has extensive
support for tags.
@vindex org-tag-faces
@@ -4489,7 +4647,7 @@ also a special command for inserting tags:
@orgcmd{C-c C-q,org-set-tags-command}
@cindex completion, of tags
@vindex org-tags-column
-Enter new tags for the current headline. Org-mode will either offer
+Enter new tags for the current headline. Org mode will either offer
completion or a special single-key interface for setting tags, see
below. After pressing @key{RET}, the tags will be inserted and aligned
to @code{org-tags-column}. When called with a @kbd{C-u} prefix, all
@@ -4532,7 +4690,7 @@ by adding a STARTUP option line to that file:
#+STARTUP: noptag
@end example
-By default Org-mode uses the standard minibuffer completion facilities for
+By default Org mode uses the standard minibuffer completion facilities for
entering tags. However, it also implements another, quicker, tag selection
method called @emph{fast tag selection}. This allows you to select and
deselect tags with just a single key press. For this to work well you should
@@ -4691,25 +4849,26 @@ and properties. For a complete description with many examples, see
@chapter Properties and columns
@cindex properties
-Properties are a set of key-value pairs associated with an entry. There
-are two main applications for properties in Org-mode. First, properties
-are like tags, but with a value. Second, you can use properties to
-implement (very basic) database capabilities in an Org buffer. For
-an example of the first application, imagine maintaining a file where
+A property is a key-value pair associated with an entry. Properties can be
+set so they are associated with a single entry, with every entry in a tree,
+or with every entry in an Org mode file.
+
+There are two main applications for properties in Org mode. First,
+properties are like tags, but with a value. Imagine maintaining a file where
you document bugs and plan releases for a piece of software. Instead of
-using tags like @code{:release_1:}, @code{:release_2:}, one can use a
+using tags like @code{:release_1:}, @code{:release_2:}, you can use a
property, say @code{:Release:}, that in different subtrees has different
-values, such as @code{1.0} or @code{2.0}. For an example of the second
-application of properties, imagine keeping track of your music CDs,
-where properties could be things such as the album, artist, date of
-release, number of tracks, and so on.
+values, such as @code{1.0} or @code{2.0}. Second, you can use properties to
+implement (very basic) database capabilities in an Org buffer. Imagine
+keeping track of your music CDs, where properties could be things such as the
+album, artist, date of release, number of tracks, and so on.
Properties can be conveniently edited and viewed in column view
(@pxref{Column view}).
@menu
* Property syntax:: How properties are spelled out
-* Special properties:: Access to other Org-mode features
+* Special properties:: Access to other Org mode features
* Property searches:: Matching property values
* Property inheritance:: Passing values down the tree
* Column view:: Tabular viewing and editing
@@ -4721,7 +4880,8 @@ Properties can be conveniently edited and viewed in column view
@cindex property syntax
@cindex drawer, for properties
-Properties are key-value pairs. They need to be inserted into a special
+Properties are key-value pairs. When they are associated with a single entry
+or with a tree they need to be inserted into a special
drawer (@pxref{Drawers}) with the name @code{PROPERTIES}. Each property
is specified on a single line, with the key (surrounded by colons)
first, and the value after it. Here is an example:
@@ -4739,6 +4899,10 @@ first, and the value after it. Here is an example:
:END:
@end example
+Depending on the value of @code{org-use-property-inheritance}, a property set
+this way will either be associated with a single entry, or the sub-tree
+defined by the entry, see @ref{Property inheritance}.
+
You may define the allowed values for a particular property @samp{:Xyz:}
by setting a property @samp{:Xyz_ALL:}. This special property is
@emph{inherited}, so if you set it in a level 1 entry, it will apply to
@@ -4763,6 +4927,37 @@ file, use a line like
#+PROPERTY: NDisks_ALL 1 2 3 4
@end example
+If you want to add to the value of an existing property, append a @code{+} to
+the property name. The following results in the property @code{var} having
+the value ``foo=1 bar=2''.
+@cindex property, +
+@example
+#+PROPERTY: var foo=1
+#+PROPERTY: var+ bar=2
+@end example
+
+It is also possible to add to the values of inherited properties. The
+following results in the @code{genres} property having the value ``Classic
+Baroque'' under the @code{Goldberg Variations} subtree.
+@cindex property, +
+@example
+* CD collection
+** Classic
+ :PROPERTIES:
+ :GENRES: Classic
+ :END:
+*** Goldberg Variations
+ :PROPERTIES:
+ :Title: Goldberg Variations
+ :Composer: J.S. Bach
+ :Artist: Glen Gould
+ :Publisher: Deutsche Grammophon
+ :NDisks: 1
+ :GENRES+: Baroque
+ :END:
+@end example
+Note that a property can only have one entry per Drawer.
+
@vindex org-global-properties
Property values set with the global variable
@code{org-global-properties} can be inherited by all entries in all
@@ -4778,8 +4973,8 @@ in the current file will be offered as possible completions.
@orgcmd{C-c C-x p,org-set-property}
Set a property. This prompts for a property name and a value. If
necessary, the property drawer is created as well.
-@item M-x org-insert-property-drawer
-@findex org-insert-property-drawer
+@item C-u M-x org-insert-drawer
+@cindex org-insert-drawer
Insert a property drawer into the current entry. The drawer will be
inserted early in the entry, but after the lines with planning
information like deadlines.
@@ -4803,13 +4998,14 @@ nearest column format definition.
@section Special properties
@cindex properties, special
-Special properties provide an alternative access method to Org-mode features,
+Special properties provide an alternative access method to Org mode features,
like the TODO state or the priority of an entry, discussed in the previous
chapters. This interface exists so that you can include these states in a
column view (@pxref{Column view}), or to use them in queries. The following
property names are special and (except for @code{:CATEGORY:}) should not be
used as keys in the properties drawer:
+@cindex property, special, ID
@cindex property, special, TODO
@cindex property, special, TAGS
@cindex property, special, ALLTAGS
@@ -4821,11 +5017,14 @@ used as keys in the properties drawer:
@cindex property, special, TIMESTAMP
@cindex property, special, TIMESTAMP_IA
@cindex property, special, CLOCKSUM
+@cindex property, special, CLOCKSUM_T
@cindex property, special, BLOCKED
@c guessing that ITEM is needed in this area; also, should this list be sorted?
@cindex property, special, ITEM
@cindex property, special, FILE
@example
+ID @r{A globally unique ID used for synchronization during}
+ @r{iCalendar or MobileOrg export.}
TODO @r{The TODO keyword of the entry.}
TAGS @r{The tags defined directly in the headline.}
ALLTAGS @r{All tags, including inherited ones.}
@@ -4838,8 +5037,11 @@ TIMESTAMP @r{The first keyword-less timestamp in the entry.}
TIMESTAMP_IA @r{The first inactive timestamp in the entry.}
CLOCKSUM @r{The sum of CLOCK intervals in the subtree. @code{org-clock-sum}}
@r{must be run first to compute the values in the current buffer.}
+CLOCKSUM_T @r{The sum of CLOCK intervals in the subtree for today.}
+ @r{@code{org-clock-sum-today} must be run first to compute the}
+ @r{values in the current buffer.}
BLOCKED @r{"t" if task is currently blocked by children or siblings}
-ITEM @r{The content of the entry.}
+ITEM @r{The headline of the entry.}
FILE @r{The filename the entry is located in.}
@end example
@@ -4885,9 +5087,9 @@ a regular expression and matched against the property values.
@cindex inheritance, of properties
@vindex org-use-property-inheritance
-The outline structure of Org-mode documents lends itself to an
+The outline structure of Org mode documents lends itself to an
inheritance model of properties: if the parent in a tree has a certain
-property, the children can inherit this property. Org-mode does not
+property, the children can inherit this property. Org mode does not
turn this on by default, because it can slow down property searches
significantly and is often not needed. However, if you find inheritance
useful, you can turn it on by setting the variable
@@ -4898,7 +5100,7 @@ inherited properties. If a property has the value @samp{nil}, this is
interpreted as an explicit undefine of the property, so that inheritance
search will stop at this value and return @code{nil}.
-Org-mode has a few properties for which inheritance is hard-coded, at
+Org mode has a few properties for which inheritance is hard-coded, at
least for the special applications for which they are used:
@cindex property, COLUMNS
@@ -4929,7 +5131,7 @@ subtree (@pxref{Tracking TODO state changes}).
A great way to view and edit properties in an outline tree is
@emph{column view}. In column view, each outline node is turned into a
table row. Columns in this table provide access to properties of the
-entries. Org-mode implements columns by overlaying a tabular structure
+entries. Org mode implements columns by overlaying a tabular structure
over the headline of each item. While the headlines have been turned
into a table row, you can still change the visibility of the outline
tree. For example, you get a compact table by switching to CONTENTS
@@ -5055,7 +5257,7 @@ values.
@example
:COLUMNS: %25ITEM %9Approved(Approved?)@{X@} %Owner %11Status \@footnote{Please note that the COLUMNS definition must be on a single line---it is wrapped here only because of formatting constraints.}
- %10Time_Estimate@{:@} %CLOCKSUM
+ %10Time_Estimate@{:@} %CLOCKSUM %CLOCKSUM_T
:Owner_ALL: Tammy Mark Karl Lisa Don
:Status_ALL: "In progress" "Not started yet" "Finished" ""
:Approved_ALL: "[ ]" "[X]"
@@ -5074,8 +5276,9 @@ modified title (@samp{Approved?}, with a question mark). Summaries will
be created for the @samp{Time_Estimate} column by adding time duration
expressions like HH:MM, and for the @samp{Approved} column, by providing
an @samp{[X]} status if all children have been checked. The
-@samp{CLOCKSUM} column is special, it lists the sum of CLOCK intervals
-in the subtree.
+@samp{CLOCKSUM} and @samp{CLOCKSUM_T} columns are special, they lists the
+sums of CLOCK intervals in the subtree, either for all clocks or just for
+today.
@node Using column view, Capturing column view, Defining columns, Column view
@subsection Using column view
@@ -5231,9 +5434,9 @@ property API}.
To assist project planning, TODO items can be labeled with a date and/or
a time. The specially formatted string carrying the date and time
-information is called a @emph{timestamp} in Org-mode. This may be a
+information is called a @emph{timestamp} in Org mode. This may be a
little confusing because timestamp is often used as indicating when
-something was created or last changed. However, in Org-mode this term
+something was created or last changed. However, in Org mode this term
is used in a much wider sense.
@menu
@@ -5256,25 +5459,30 @@ is used in a much wider sense.
@cindex scheduling
A timestamp is a specification of a date (possibly with a time or a range of
-times) in a special format, either @samp{<2003-09-16 Tue>} or
-@samp{<2003-09-16 Tue 09:39>} or @samp{<2003-09-16 Tue
-12:00-12:30>}@footnote{This is inspired by the standard ISO 8601 date/time
-format. To use an alternative format, see @ref{Custom time format}.}. A
-timestamp can appear anywhere in the headline or body of an Org tree entry.
-Its presence causes entries to be shown on specific dates in the agenda
-(@pxref{Weekly/daily agenda}). We distinguish:
+times) in a special format, either @samp{<2003-09-16 Tue>}@footnote{In this
+simplest form, the day name is optional when you type the date yourself.
+However, any dates inserted or modified by Org will add that day name, for
+reading convenience.} or @samp{<2003-09-16 Tue 09:39>} or @samp{<2003-09-16
+Tue 12:00-12:30>}@footnote{This is inspired by the standard ISO 8601
+date/time format. To use an alternative format, see @ref{Custom time
+format}.}. A timestamp can appear anywhere in the headline or body of an Org
+tree entry. Its presence causes entries to be shown on specific dates in the
+agenda (@pxref{Weekly/daily agenda}). We distinguish:
@table @var
@item Plain timestamp; Event; Appointment
@cindex timestamp
+@cindex appointment
A simple timestamp just assigns a date/time to an item. This is just
like writing down an appointment or event in a paper agenda. In the
timeline and agenda displays, the headline of an entry associated with a
plain timestamp will be shown exactly on that date.
@example
-* Meet Peter at the movies <2006-11-01 Wed 19:15>
-* Discussion on climate change <2006-11-02 Thu 20:00-22:00>
+* Meet Peter at the movies
+ <2006-11-01 Wed 19:15>
+* Discussion on climate change
+ <2006-11-02 Thu 20:00-22:00>
@end example
@item Timestamp with repeater interval
@@ -5285,11 +5493,12 @@ interval of N days (d), weeks (w), months (m), or years (y). The
following will show up in the agenda every Wednesday:
@example
-* Pick up Sam at school <2007-05-16 Wed 12:30 +1w>
+* Pick up Sam at school
+ <2007-05-16 Wed 12:30 +1w>
@end example
@item Diary-style sexp entries
-For more complex date specifications, Org-mode supports using the special
+For more complex date specifications, Org mode supports using the special
sexp diary entries implemented in the Emacs calendar/diary
package@footnote{When working with the standard diary sexp functions, you
need to be very careful with the order of the arguments. That order depend
@@ -5297,14 +5506,15 @@ evilly on the variable @code{calendar-date-style} (or, for older Emacs
versions, @code{european-calendar-style}). For example, to specify a date
December 12, 2005, the call might look like @code{(diary-date 12 1 2005)} or
@code{(diary-date 1 12 2005)} or @code{(diary-date 2005 12 1)}, depending on
-the settings. This has been the source of much confusion. Org-mode users
+the settings. This has been the source of much confusion. Org mode users
can resort to special versions of these functions like @code{org-date} or
@code{org-anniversary}. These work just like the corresponding @code{diary-}
functions, but with stable ISO order of arguments (year, month, day) wherever
-applicable, independent of the value of @code{calendar-date-style}.}. For example
+applicable, independent of the value of @code{calendar-date-style}.}. For
+example with optional time
@example
-* The nerd meeting on every 2nd Thursday of the month
+* 22:00-23:00 The nerd meeting on every 2nd Thursday of the month
<%%(org-float t 4 2)>
@end example
@@ -5328,7 +5538,8 @@ angular ones. These timestamps are inactive in the sense that they do
@emph{not} trigger an entry to show up in the agenda.
@example
-* Gillian comes late for the fifth time [2006-11-01 Wed]
+* Gillian comes late for the fifth time
+ [2006-11-01 Wed]
@end example
@end table
@@ -5338,7 +5549,7 @@ angular ones. These timestamps are inactive in the sense that they do
@cindex creating timestamps
@cindex timestamps, creating
-For Org-mode to recognize timestamps, they need to be in the specific
+For Org mode to recognize timestamps, they need to be in the specific
format. All commands listed below produce timestamps in the correct
format.
@@ -5362,6 +5573,9 @@ Like @kbd{C-c .} and @kbd{C-c !}, but use the alternative format which
contains date and time. The default time can be rounded to multiples of 5
minutes, see the option @code{org-time-stamp-rounding-minutes}.
@c
+@orgkey{C-c C-c}
+Normalize timestamp, insert/fix day name if missing or wrong.
+@c
@orgcmd{C-c <,org-date-from-calendar}
Insert a timestamp corresponding to the cursor date in the Calendar.
@c
@@ -5397,7 +5611,7 @@ the following column).
@menu
-* The date/time prompt:: How Org-mode helps you entering date and time
+* The date/time prompt:: How Org mode helps you entering date and time
* Custom time format:: Making dates look different
@end menu
@@ -5407,17 +5621,17 @@ the following column).
@cindex time, reading in minibuffer
@vindex org-read-date-prefer-future
-When Org-mode prompts for a date/time, the default is shown in default
+When Org mode prompts for a date/time, the default is shown in default
date/time format, and the prompt therefore seems to ask for a specific
format. But it will in fact accept any string containing some date and/or
time information, and it is really smart about interpreting your input. You
can, for example, use @kbd{C-y} to paste a (possibly multi-line) string
-copied from an email message. Org-mode will find whatever information is in
+copied from an email message. Org mode will find whatever information is in
there and derive anything you have not specified from the @emph{default date
and time}. The default is usually the current date and time, but when
modifying an existing timestamp, or when entering the second stamp of a
range, it is taken from the stamp in the buffer. When filling in
-information, Org-mode assumes that most of the time you will want to enter a
+information, Org mode assumes that most of the time you will want to enter a
date in the future: if you omit the month/year and the given day/month is
@i{before} today, it will assume that you mean a future date@footnote{See the
variable @code{org-read-date-prefer-future}. You may set that variable to
@@ -5426,7 +5640,7 @@ tomorrow.}. If the date has been automatically shifted into the future, the
time prompt will show this with @samp{(=>F).}
For example, let's assume that today is @b{June 13, 2006}. Here is how
-various inputs will be interpreted, the items filled in by Org-mode are
+various inputs will be interpreted, the items filled in by Org mode are
in @b{bold}.
@example
@@ -5536,7 +5750,7 @@ minibuffer@footnote{If you find this distracting, turn the display of with
@vindex org-display-custom-times
@vindex org-time-stamp-custom-formats
-Org-mode uses the standard ISO notation for dates and times as it is
+Org mode uses the standard ISO notation for dates and times as it is
defined in ISO 8601. If you cannot get used to this and require another
representation of date and time to keep you happy, you can get it by
customizing the variables @code{org-display-custom-times} and
@@ -5548,7 +5762,7 @@ Toggle the display of custom formats for dates and times.
@end table
@noindent
-Org-mode needs the default format for scanning, so the custom date/time
+Org mode needs the default format for scanning, so the custom date/time
format does not @emph{replace} the default format---instead it is put
@emph{over} the default format using text properties. This has the
following consequences:
@@ -5597,8 +5811,8 @@ until the entry is marked DONE. An example:
@example
*** TODO write article about the Earth for the Guide
- The editor in charge is [[bbdb:Ford Prefect]]
DEADLINE: <2004-02-29 Sun>
+ The editor in charge is [[bbdb:Ford Prefect]]
@end example
You can specify a different lead time for warnings for a specific
@@ -5625,23 +5839,23 @@ the task will automatically be forwarded until completed.
@end example
@noindent
-@b{Important:} Scheduling an item in Org-mode should @i{not} be
+@b{Important:} Scheduling an item in Org mode should @i{not} be
understood in the same way that we understand @i{scheduling a meeting}.
Setting a date for a meeting is just a simple appointment, you should
mark this entry with a simple plain timestamp, to get this item shown
on the date where it applies. This is a frequent misunderstanding by
-Org users. In Org-mode, @i{scheduling} means setting a date when you
+Org users. In Org mode, @i{scheduling} means setting a date when you
want to start working on an action item.
@end table
You may use timestamps with repeaters in scheduling and deadline
-entries. Org-mode will issue early and late warnings based on the
+entries. Org mode will issue early and late warnings based on the
assumption that the timestamp represents the @i{nearest instance} of
the repeater. However, the use of diary sexp entries like
@c
@code{<%%(org-float t 42)>}
@c
-in scheduling and deadline timestamps is limited. Org-mode does not
+in scheduling and deadline timestamps is limited. Org mode does not
know enough about the internals of each sexp function to issue early and
late warnings. However, it will show the item on each day where the
sexp entry matches.
@@ -5714,7 +5928,7 @@ to the previous week before any current timestamp.
@cindex tasks, repeated
@cindex repeated tasks
-Some tasks need to be repeated again and again. Org-mode helps to
+Some tasks need to be repeated again and again. Org mode helps to
organize such tasks using a so-called repeater in a DEADLINE, SCHEDULED,
or plain timestamp. In the following example
@example
@@ -5724,9 +5938,10 @@ or plain timestamp. In the following example
@noindent
the @code{+1m} is a repeater; the intended interpretation is that the task
has a deadline on <2005-10-01> and repeats itself every (one) month starting
-from that time. If you need both a repeater and a special warning period in
-a deadline entry, the repeater should come first and the warning period last:
-@code{DEADLINE: <2005-10-01 Sat +1m -3d>}.
+from that time. You can use yearly, monthly, weekly, daily and hourly repeat
+cookies by using the @code{y/w/m/d/h} letters. If you need both a repeater
+and a special warning period in a deadline entry, the repeater should come
+first and the warning period last: @code{DEADLINE: <2005-10-01 Sat +1m -3d>}.
@vindex org-todo-repeat-to-state
Deadlines and scheduled items produce entries in the agenda when they are
@@ -5734,7 +5949,7 @@ over-due, so it is important to be able to mark such an entry as completed
once you have done so. When you mark a DEADLINE or a SCHEDULE with the TODO
keyword DONE, it will no longer produce entries in the agenda. The problem
with this is, however, that then also the @emph{next} instance of the
-repeated entry will not be active. Org-mode deals with this in the following
+repeated entry will not be active. Org mode deals with this in the following
way: When you try to mark such an entry DONE (using @kbd{C-c C-t}), it will
shift the base date of the repeating timestamp by the repeater interval, and
immediately set the entry state back to TODO@footnote{In fact, the target
@@ -5767,7 +5982,7 @@ task, this may not be the best way to handle it. For example, if you
forgot to call your father for 3 weeks, it does not make sense to call
him 3 times in a single day to make up for it. Finally, there are tasks
like changing batteries which should always repeat a certain time
-@i{after} the last time you did it. For these tasks, Org-mode has
+@i{after} the last time you did it. For these tasks, Org mode has
special repeaters @samp{++} and @samp{.+}. For example:
@example
@@ -5796,13 +6011,15 @@ created for this purpose, it is described in @ref{Structure editing}.
@cindex clocking time
@cindex time clocking
-Org-mode allows you to clock the time you spend on specific tasks in a
-project. When you start working on an item, you can start the clock.
-When you stop working on that task, or when you mark the task done, the
-clock is stopped and the corresponding time interval is recorded. It
-also computes the total time spent on each subtree of a project. And it
-remembers a history or tasks recently clocked, to that you can jump quickly
-between a number of tasks absorbing your time.
+Org mode allows you to clock the time you spend on specific tasks in a
+project. When you start working on an item, you can start the clock. When
+you stop working on that task, or when you mark the task done, the clock is
+stopped and the corresponding time interval is recorded. It also computes
+the total time spent on each subtree@footnote{Clocking only works if all
+headings are indented with less than 30 stars. This is a hardcoded
+limitation of `lmax' in `org-clock-sum'.} of a project. And it remembers a
+history or tasks recently clocked, to that you can jump quickly between a
+number of tasks absorbing your time.
To save the clock history across Emacs sessions, use
@lisp
@@ -5827,6 +6044,7 @@ what to do with it.
@table @kbd
@orgcmd{C-c C-x C-i,org-clock-in}
@vindex org-clock-into-drawer
+@vindex org-clock-continuously
@cindex property, LOG_INTO_DRAWER
Start the clock on the current item (clock-in). This inserts the CLOCK
keyword together with a timestamp. If this is not the first clocking of
@@ -5837,9 +6055,10 @@ the setting of this variable for a subtree by setting a
@code{CLOCK_INTO_DRAWER} or @code{LOG_INTO_DRAWER} property.
When called with a @kbd{C-u} prefix argument,
select the task from a list of recently clocked tasks. With two @kbd{C-u
-C-u} prefixes, clock into the task at point and mark it as the default task.
-The default task will always be available when selecting a clocking task,
-with letter @kbd{d}.@*
+C-u} prefixes, clock into the task at point and mark it as the default task;
+the default task will then always be available with letter @kbd{d} when
+selecting a clocking task. With three @kbd{C-u C-u C-u} prefixes, force
+continuous clocking by starting the clock when the last clock stopped.@*
@cindex property: CLOCK_MODELINE_TOTAL
@cindex property: LAST_REPEAT
@vindex org-clock-modeline-total
@@ -5869,6 +6088,12 @@ HH:MM}. See the variable @code{org-log-note-clock-out} for the
possibility to record an additional note together with the clock-out
timestamp@footnote{The corresponding in-buffer setting is:
@code{#+STARTUP: lognoteclock-out}}.
+@orgcmd{C-c C-x C-x,org-clock-in-last}
+@vindex org-clock-continuously
+Reclock the last clocked task. With one @kbd{C-u} prefix argument,
+select the task from the clock history. With two @kbd{C-u} prefixes,
+force continuous clocking by starting the clock when the last clock
+stopped.
@orgcmd{C-c C-x C-e,org-clock-modify-effort-estimate}
Update the effort estimate for the current clock task.
@kindex C-c C-y
@@ -5878,12 +6103,18 @@ Recompute the time interval after changing one of the timestamps. This
is only necessary if you edit the timestamps directly. If you change
them with @kbd{S-@key{cursor}} keys, the update is automatic.
@orgcmd{C-S-@key{up/down},org-clock-timestamps-up/down}
-On @code{CLOCK} log lines, increase/decrease both timestamps at the same
-time so that duration keeps the same.
+On @code{CLOCK} log lines, increase/decrease both timestamps so that the
+clock duration keeps the same.
+@orgcmd{S-M-@key{up/down},org-timestamp-up/down}
+On @code{CLOCK} log lines, increase/decrease the timestamp at point and
+the one of the previous (or the next clock) timestamp by the same duration.
+For example, if you hit @kbd{S-M-@key{up}} to increase a clocked-out timestamp
+by five minutes, then the clocked-in timestamp of the next clock will be
+increased by five minutes.
@orgcmd{C-c C-t,org-todo}
Changing the TODO state of an item to DONE automatically stops the clock
if it is running in this same item.
-@orgcmd{C-c C-x C-x,org-clock-cancel}
+@orgcmd{C-c C-x C-q,org-clock-cancel}
Cancel the current clock. This is useful if a clock was started by
mistake, or if you ended up working on something else.
@orgcmd{C-c C-x C-j,org-clock-goto}
@@ -5903,6 +6134,10 @@ The @kbd{l} key may be used in the timeline (@pxref{Timeline}) and in
the agenda (@pxref{Weekly/daily agenda}) to show which tasks have been
worked on or closed during a day.
+@strong{Important:} note that both @code{org-clock-out} and
+@code{org-clock-in-last} can have a global keybinding and will not
+modify the window disposition.
+
@node The clock table, Resolving idle time, Clocking commands, Clocking work time
@subsection The clock table
@cindex clocktable, dynamic block
@@ -5915,10 +6150,11 @@ formatted as one or several Org tables.
@table @kbd
@orgcmd{C-c C-x C-r,org-clock-report}
Insert a dynamic block (@pxref{Dynamic blocks}) containing a clock
-report as an Org-mode table into the current file. When the cursor is
+report as an Org mode table into the current file. When the cursor is
at an existing clock table, just update it. When called with a prefix
argument, jump to the first clock report in the current document and
-update it.
+update it. The clock table always includes also trees with
+@code{:ARCHIVE:} tag.
@orgcmdkkc{C-c C-c,C-c C-x C-u,org-dblock-update}
Update dynamic block at point. The cursor needs to be in the
@code{#+BEGIN} line of the dynamic block.
@@ -6039,7 +6275,9 @@ would be
@end example
@node Resolving idle time, , The clock table, Clocking work time
-@subsection Resolving idle time
+@subsection Resolving idle time and continuous clocking
+
+@subsubheading Resolving idle time
@cindex resolve idle time
@cindex idle, resolve, dangling
@@ -6054,12 +6292,12 @@ as 10 or 15, Emacs can alert you when you get back to your computer after
being idle for that many minutes@footnote{On computers using Mac OS X,
idleness is based on actual user idleness, not just Emacs' idle time. For
X11, you can install a utility program @file{x11idle.c}, available in the
-UTILITIES directory of the Org git distribution, to get the same general
-treatment of idleness. On other systems, idle time refers to Emacs idle time
-only.}, and ask what you want to do with the idle time. There will be a
-question waiting for you when you get back, indicating how much idle time has
-passed (constantly updated with the current amount), as well as a set of
-choices to correct the discrepancy:
+@code{contrib/scripts} directory of the Org git distribution, to get the same
+general treatment of idleness. On other systems, idle time refers to Emacs
+idle time only.}, and ask what you want to do with the idle time. There will
+be a question waiting for you when you get back, indicating how much idle
+time has passed (constantly updated with the current amount), as well as a
+set of choices to correct the discrepancy:
@table @kbd
@item k
@@ -6104,7 +6342,19 @@ identical to dealing with away time due to idleness; it is just happening due
to a recovery event rather than a set amount of idle time.
You can also check all the files visited by your Org agenda for dangling
-clocks at any time using @kbd{M-x org-resolve-clocks}.
+clocks at any time using @kbd{M-x org-resolve-clocks RET} (or @kbd{C-c C-x C-z}).
+
+@subsubheading Continuous clocking
+@cindex continuous clocking
+@vindex org-clock-continuously
+
+You may want to start clocking from the time when you clocked out the
+previous task. To enable this systematically, set @code{org-clock-continuously}
+to @code{t}. Each time you clock in, Org retrieves the clock-out time of the
+last clocked entry for this session, and start the new clock from there.
+
+If you only want this from time to time, use three universal prefix arguments
+with @code{org-clock-in} and two @kbd{C-u C-u} with @code{org-clock-in-last}.
@node Effort estimates, Relative timer, Clocking work time, Dates and Times
@section Effort estimates
@@ -6215,7 +6465,7 @@ not started at exactly the right moment.
@kindex C-c C-x ;
@kindex ;
-Calling @code{org-timer-set-timer} from an Org-mode buffer runs a countdown
+Calling @code{org-timer-set-timer} from an Org mode buffer runs a countdown
timer. Use @kbd{;} from agenda buffers, @key{C-c C-x ;} everywhere else.
@code{org-timer-set-timer} prompts the user for a duration and displays a
@@ -6249,7 +6499,7 @@ trees to an archive file keeps the system compact and fast.
Org's method for capturing new items is heavily inspired by John Wiegley
excellent remember package. Up to version 6.36 Org used a special setup
-for @file{remember.el}. @file{org-remember.el} is still part of Org-mode for
+for @file{remember.el}. @file{org-remember.el} is still part of Org mode for
backward compatibility with existing setups. You can find the documentation
for org-remember at @url{http://orgmode.org/org-remember.pdf}.
@@ -6334,6 +6584,15 @@ template in the usual way.
Visit the last stored capture item in its buffer.
@end table
+@vindex org-capture-bookmark
+@cindex org-capture-last-stored
+You can also jump to the bookmark @code{org-capture-last-stored}, which will
+automatically be created unless you set @code{org-capture-bookmark} to
+@code{nil}.
+
+To insert the capture at point in an Org buffer, call @code{org-capture} with
+a @code{C-0} prefix argument.
+
@node Capture templates, , Using capture, Capture
@subsection Capture templates
@cindex templates, for Capture
@@ -6388,12 +6647,13 @@ like this:
@menu
* Template elements:: What is needed for a complete template entry
* Template expansion:: Filling in information about time and context
+* Templates in contexts:: Only show a template in a specific context
@end menu
@node Template elements, Template expansion, Capture templates, Capture templates
@subsubsection Template elements
-Now let's look at the elements of a template definition. Each entry in
+Now lets look at the elements of a template definition. Each entry in
@code{org-capture-templates} is a list with the following items:
@table @var
@@ -6418,8 +6678,8 @@ selection.
The type of entry, a symbol. Valid values are:
@table @code
@item entry
-An Org-mode node, with a headline. Will be filed as the child of the target
-entry or as a top-level entry. The target file should be an Org-mode file.
+An Org mode node, with a headline. Will be filed as the child of the target
+entry or as a top-level entry. The target file should be an Org mode file.
@item item
A plain list item, placed in the first plain list at the target
location. Again the target file should be an Org file.
@@ -6436,7 +6696,7 @@ Text to be inserted as it is.
@item target
@vindex org-default-notes-file
-Specification of where the captured item should be placed. In Org-mode
+Specification of where the captured item should be placed. In Org mode
files, targets usually define a node. Entries will become children of this
node. Other types will be added to the table or list in the body of this
node. Most target specifications contain a file name. If that file name is
@@ -6531,36 +6791,38 @@ buffer again after capture is completed.
@end table
@end table
-@node Template expansion, , Template elements, Capture templates
+@node Template expansion, Templates in contexts, Template elements, Capture templates
@subsubsection Template expansion
In the template itself, special @kbd{%}-escapes@footnote{If you need one of
-these sequences literally, escape the @kbd{%} with a backslash.} allow
-dynamic insertion of content. The templates are expanded in the order given here:
+these sequences literally, escape the @kbd{%} with a backslash.} allow
+dynamic insertion of content. The templates are expanded in the order given here:
@smallexample
-%[@var{file}] @r{insert the contents of the file given by @var{file}.}
-%(@var{sexp}) @r{evaluate Elisp @var{sexp} and replace with the result.}
-%<...> @r{the result of format-time-string on the ... format specification.}
-%t @r{timestamp, date only.}
-%T @r{timestamp with date and time.}
-%u, %U @r{like the above, but inactive timestamps.}
-%a @r{annotation, normally the link created with @code{org-store-link}.}
-%i @r{initial content, the region when capture is called while the}
+%[@var{file}] @r{Insert the contents of the file given by @var{file}.}
+%(@var{sexp}) @r{Evaluate Elisp @var{sexp} and replace with the result.}
+ @r{The sexp must return a string.}
+%<...> @r{The result of format-time-string on the ... format specification.}
+%t @r{Timestamp, date only.}
+%T @r{Timestamp, with date and time.}
+%u, %U @r{Like the above, but inactive timestamps.}
+%i @r{Initial content, the region when capture is called while the}
@r{region is active.}
@r{The entire text will be indented like @code{%i} itself.}
-%A @r{like @code{%a}, but prompt for the description part.}
+%a @r{Annotation, normally the link created with @code{org-store-link}.}
+%A @r{Like @code{%a}, but prompt for the description part.}
+%l @r{Like %a, but only insert the literal link.}
%c @r{Current kill ring head.}
%x @r{Content of the X clipboard.}
-%k @r{title of the currently clocked task.}
-%K @r{link to the currently clocked task.}
-%n @r{user name (taken from @code{user-full-name}).}
-%f @r{file visited by current buffer when org-capture was called.}
-%F @r{full path of the file or directory visited by current buffer.}
-%:keyword @r{specific information for certain link types, see below.}
-%^g @r{prompt for tags, with completion on tags in target file.}
-%^G @r{prompt for tags, with completion all tags in all agenda files.}
-%^t @r{like @code{%t}, but prompt for date. Similarly @code{%^T}, @code{%^u}, @code{%^U}.}
+%k @r{Title of the currently clocked task.}
+%K @r{Link to the currently clocked task.}
+%n @r{User name (taken from @code{user-full-name}).}
+%f @r{File visited by current buffer when org-capture was called.}
+%F @r{Full path of the file or directory visited by current buffer.}
+%:keyword @r{Specific information for certain link types, see below.}
+%^g @r{Prompt for tags, with completion on tags in target file.}
+%^G @r{Prompt for tags, with completion all tags in all agenda files.}
+%^t @r{Like @code{%t}, but prompt for date. Similarly @code{%^T}, @code{%^u}, @code{%^U}.}
@r{You may define a prompt like @code{%^@{Birthday@}t}.}
%^C @r{Interactive selection of which kill or clip to use.}
%^L @r{Like @code{%^C}, but insert as link.}
@@ -6569,6 +6831,9 @@ dynamic insertion of content. The templates are expanded in the order given here
@r{You may specify a default value and a completion table with}
@r{%^@{prompt|default|completion2|completion3...@}.}
@r{The arrow keys access a prompt-specific history.}
+%\n @r{Insert the text entered at the nth %^@{@var{prompt}@}, where @code{n} is}
+ @r{a number, starting from 1.}
+%? @r{After completing the template, position cursor here.}
@end smallexample
@noindent
@@ -6580,21 +6845,21 @@ similar way.}:
@vindex org-from-is-user-regexp
@smallexample
-Link type | Available keywords
-------------------------+----------------------------------------------
-bbdb | %:name %:company
-irc | %:server %:port %:nick
-vm, wl, mh, mew, rmail | %:type %:subject %:message-id
- | %:from %:fromname %:fromaddress
- | %:to %:toname %:toaddress
- | %:date @r{(message date header field)}
- | %:date-timestamp @r{(date as active timestamp)}
- | %:date-timestamp-inactive @r{(date as inactive timestamp)}
- | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}}
-gnus | %:group, @r{for messages also all email fields}
-w3, w3m | %:url
-info | %:file %:node
-calendar | %:date
+Link type | Available keywords
+---------------------------------+----------------------------------------------
+bbdb | %:name %:company
+irc | %:server %:port %:nick
+vm, vm-imap, wl, mh, mew, rmail | %:type %:subject %:message-id
+ | %:from %:fromname %:fromaddress
+ | %:to %:toname %:toaddress
+ | %:date @r{(message date header field)}
+ | %:date-timestamp @r{(date as active timestamp)}
+ | %:date-timestamp-inactive @r{(date as inactive timestamp)}
+ | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}}
+gnus | %:group, @r{for messages also all email fields}
+w3, w3m | %:url
+info | %:file %:node
+calendar | %:date
@end smallexample
@noindent
@@ -6604,6 +6869,29 @@ To place the cursor after template expansion use:
%? @r{After completing the template, position cursor here.}
@end smallexample
+@node Templates in contexts, , Template expansion, Capture templates
+@subsubsection Templates in contexts
+
+@vindex org-capture-templates-contexts
+To control whether a capture template should be accessible from a specific
+context, you can customize @var{org-capture-templates-contexts}. Let's say
+for example that you have a capture template @code{"p"} for storing Gnus
+emails containing patches. Then you would configure this option like this:
+
+@example
+(setq org-capture-templates-contexts
+ '(("p" (in-mode . "message-mode"))))
+@end example
+
+You can also tell that the command key @code{"p"} should refer to another
+template. In that case, add this command key like this:
+
+@example
+(setq org-capture-templates-contexts
+ '(("p" "q" (in-mode . "message-mode"))))
+@end example
+
+See the docstring of the variable for more information.
@node Attachments, RSS Feeds, Capture, Capture - Refile - Archive
@section Attachments
@@ -6795,10 +7083,7 @@ Use the refile interface to jump to a heading.
Jump to the location where @code{org-refile} last moved a tree to.
@item C-2 C-c C-w
Refile as the child of the item currently being clocked.
-@item C-0 C-c C-w @ @r{or} @ C-u C-u C-u C-c C-w
-
@orgcmdtkc{C-0 C-c C-w @ @r{or} @ C-u C-u C-u C-c C-w,C-0 C-c C-w,org-refile-cache-clear}
-
Clear the target cache. Caching of refile targets can be turned on by
setting @code{org-refile-use-cache}. To make the command see new possible
targets, you have to clear the cache with this command.
@@ -6848,16 +7133,20 @@ is invoked, the level 1 trees will be checked.
@cindex archive locations
The default archive location is a file in the same directory as the
current file, with the name derived by appending @file{_archive} to the
-current file name. For information and examples on how to change this,
+current file name. You can also choose what heading to file archived
+items under, with the possibility to add them to a datetree in a file.
+For information and examples on how to specify the file and the heading,
see the documentation string of the variable
-@code{org-archive-location}. There is also an in-buffer option for
-setting this variable, for example@footnote{For backward compatibility,
-the following also works: If there are several such lines in a file,
-each specifies the archive location for the text below it. The first
-such line also applies to any text before its definition. However,
-using this method is @emph{strongly} deprecated as it is incompatible
-with the outline structure of the document. The correct method for
-setting multiple archive locations in a buffer is using properties.}:
+@code{org-archive-location}.
+
+There is also an in-buffer option for setting this variable, for
+example@footnote{For backward compatibility, the following also works:
+If there are several such lines in a file, each specifies the archive
+location for the text below it. The first such line also applies to any
+text before its definition. However, using this method is
+@emph{strongly} deprecated as it is incompatible with the outline
+structure of the document. The correct method for setting multiple
+archive locations in a buffer is using properties.}:
@cindex #+ARCHIVE
@example
@@ -7032,6 +7321,7 @@ the front. With a prefix argument, file is added/moved to the end.
@orgcmd{C-c ],org-remove-file}
Remove current file from the list of agenda files.
@kindex C-,
+@cindex cycling, of agenda files
@orgcmd{C-',org-cycle-agenda-files}
@itemx C-,
Cycle through agenda file list, visiting one file after the other.
@@ -7120,6 +7410,17 @@ the region. Otherwise, restrict it to the current subtree@footnote{For
backward compatibility, you can also press @kbd{0} to restrict to the
current region/subtree.}. After pressing @kbd{< <}, you still need to press the
character selecting the command.
+
+@item *
+@vindex org-agenda-sticky
+Toggle sticky agenda views. By default, Org maintains only a single agenda
+buffer and rebuilds it each time you change the view, to make sure everything
+is always up to date. If you switch between views often and the build time
+bothers you, you can turn on sticky agenda buffers (make this the default by
+customizing the variable @code{org-agenda-sticky}). With sticky agendas, the
+dispatcher only switches to the selected view, you need to update it by hand
+with @kbd{r} or @kbd{g}. You can toggle sticky agenda view any time with
+@code{org-toggle-sticky-agenda}.
@end table
You can also define custom commands that will be accessible through the
@@ -7187,7 +7488,7 @@ anniversaries, lunar phases, sunrise/set, recurrent appointments
Org. It can be very useful to combine output from Org with
the diary.
-In order to include entries from the Emacs diary into Org-mode's
+In order to include entries from the Emacs diary into Org mode's
agenda, you only need to customize the variable
@lisp
@@ -7196,7 +7497,7 @@ agenda, you only need to customize the variable
@noindent After that, everything will happen automatically. All diary
entries including holidays, anniversaries, etc., will be included in the
-agenda buffer created by Org-mode. @key{SPC}, @key{TAB}, and
+agenda buffer created by Org mode. @key{SPC}, @key{TAB}, and
@key{RET} can be used from the agenda buffer to jump to the diary
file in order to edit existing diary entries. The @kbd{i} command to
insert new entries for the current date works in the agenda buffer, as
@@ -7207,7 +7508,7 @@ between calendar and agenda.
If you are using the diary only for sexp entries and holidays, it is
faster to not use the above setting, but instead to copy or even move
-the entries into an Org file. Org-mode evaluates diary-style sexp
+the entries into an Org file. Org mode evaluates diary-style sexp
entries, and does it faster because there is no overhead for first
creating the diary display. Note that the sexp entries must start at
the left margin, no whitespace is allowed before them. For example,
@@ -7231,7 +7532,7 @@ If you are using the Big Brothers Database to store your contacts, you will
very likely prefer to store anniversaries in BBDB rather than in a
separate Org or diary file. Org supports this and will show BBDB
anniversaries as part of the agenda. All you need to do is to add the
-following to one your your agenda files:
+following to one of your agenda files:
@example
* Anniversaries
@@ -7253,7 +7554,7 @@ followed by a space and the class of the anniversary (@samp{birthday} or
1973-06-22
06-22
1955-08-02 wedding
-2008-04-14 %s released version 6.01 of org-mode, %d years ago
+2008-04-14 %s released version 6.01 of org mode, %d years ago
@end example
After a change to BBDB, or for the first agenda display during an Emacs
@@ -7265,12 +7566,16 @@ in an Org or Diary file.
@subsubheading Appointment reminders
@cindex @file{appt.el}
@cindex appointment reminders
+@cindex appointment
+@cindex reminders
-Org can interact with Emacs appointments notification facility. To add all
-the appointments of your agenda files, use the command
-@code{org-agenda-to-appt}. This command also lets you filter through the
-list of your appointments and add only those belonging to a specific category
-or matching a regular expression. See the docstring for details.
+Org can interact with Emacs appointments notification facility. To add the
+appointments of your agenda files, use the command @code{org-agenda-to-appt}.
+This command lets you filter through the list of your appointments and add
+only those belonging to a specific category or matching a regular expression.
+It also reads a @code{APPT_WARNTIME} property which will then override the
+value of @code{appt-message-warning-time} for this appointment. See the
+docstring for details.
@node Global TODO list, Matching tags and properties, Weekly/daily agenda, Built-in agenda views
@subsection The global TODO list
@@ -7409,6 +7714,9 @@ So a search @samp{+LEVEL=3+boss-TODO="DONE"} lists all level three headlines
that have the tag @samp{boss} and are @emph{not} marked with the TODO keyword
DONE. In buffers with @code{org-odd-levels-only} set, @samp{LEVEL} does not
count the number of stars, but @samp{LEVEL=2} will correspond to 3 stars etc.
+The ITEM special property cannot currently be used in tags/property
+searches@footnote{But @pxref{x-agenda-skip-entry-regexp,
+,skipping entries based on regexp}.}.
Here are more examples:
@table @samp
@@ -7466,7 +7774,7 @@ other properties will slow down the search. However, once you have paid the
price by accessing one property, testing additional properties is cheap
again.
-You can configure Org-mode to use property inheritance during a search, but
+You can configure Org mode to use property inheritance during a search, but
beware that this can slow down searches considerably. See @ref{Property
inheritance}, for details.
@@ -7499,7 +7807,7 @@ Select @samp{:work:}-tagged TODO lines that are either @samp{WAITING} or
@cindex timeline, single file
@cindex time-sorted view
-The timeline summarizes all time-stamped items from a single Org-mode
+The timeline summarizes all time-stamped items from a single Org mode
file in a @emph{time-sorted view}. The main purpose of this command is
to give an overview over events in a project.
@@ -7520,7 +7828,7 @@ The commands available in the timeline buffer are listed in
@cindex text search
@cindex searching, for text
-This agenda view is a general text search facility for Org-mode entries.
+This agenda view is a general text search facility for Org mode entries.
It is particularly useful to find notes.
@table @kbd
@@ -7552,7 +7860,7 @@ If you are following a system like David Allen's GTD to organize your
work, one of the ``duties'' you have is a regular review to make sure
that all projects move along. A @emph{stuck} project is a project that
has no defined next actions, so it will never show up in the TODO lists
-Org-mode produces. During the review, you need to identify such
+Org mode produces. During the review, you need to identify such
projects and define next actions for them.
@table @kbd
@@ -7570,7 +7878,7 @@ work for you. The built-in default assumes that all your projects are
level-2 headlines, and that a project is not stuck if it has at least
one entry marked with a TODO keyword TODO or NEXT or NEXTACTION.
-Let's assume that you, in your own way of using Org-mode, identify
+Let's assume that you, in your own way of using Org mode, identify
projects with a tag PROJECT, and that you use a TODO keyword MAYBE to
indicate a project that should not be considered yet. Let's further
assume that the TODO keyword DONE marks finished projects, and that NEXT
@@ -7598,7 +7906,7 @@ will still be searched for stuck projects.
@vindex org-agenda-prefix-format
@vindex org-agenda-tags-column
-Before displaying items in an agenda view, Org-mode visually prepares the
+Before displaying items in an agenda view, Org mode visually prepares the
items and sorts them. Each item occupies a single line. The line starts
with a @emph{prefix} that contains the @emph{category} (@pxref{Categories})
of the item and other important information. You can customize in which
@@ -7651,7 +7959,7 @@ You can set up icons for category by customizing the
@subsection Time-of-day specifications
@cindex time-of-day specification
-Org-mode checks each agenda item for a time-of-day specification. The
+Org mode checks each agenda item for a time-of-day specification. The
time can be part of the timestamp that triggered inclusion into the
agenda, for example as in @w{@samp{<2005-05-10 Tue 19:00>}}. Time
ranges can be specified with two timestamps, like
@@ -7663,7 +7971,7 @@ plain text (like @samp{12:45} or a @samp{8:30-1pm}). If the agenda
integrates the Emacs diary (@pxref{Weekly/daily agenda}), time
specifications in diary entries are recognized as well.
-For agenda display, Org-mode extracts the time and displays it in a
+For agenda display, Org mode extracts the time and displays it in a
standard 24 hour format as part of the prefix. The example times in
the previous paragraphs would end up in the agenda like this:
@@ -7750,9 +8058,9 @@ the other commands, the cursor needs to be in the desired line.
@tsubheading{Motion}
@cindex motion commands in agenda
@orgcmd{n,org-agenda-next-line}
-Next line (same as @key{up} and @kbd{C-p}).
+Next line (same as @key{down} and @kbd{C-n}).
@orgcmd{p,org-agenda-previous-line}
-Previous line (same as @key{down} and @kbd{C-n}).
+Previous line (same as @key{up} and @kbd{C-p}).
@tsubheading{View/Go to Org file}
@orgcmdkkc{@key{SPC},mouse-3,org-agenda-show-and-scroll-up}
Display the original location of the item in another window.
@@ -7798,9 +8106,9 @@ Interactively select another agenda view and append it to the current view.
Delete other windows.
@c
@orgcmdkskc{v d,d,org-agenda-day-view}
-@xorgcmdkskc{v w,w,org-agenda-day-view}
+@xorgcmdkskc{v w,w,org-agenda-week-view}
@xorgcmd{v m,org-agenda-month-view}
-@xorgcmd{v y,org-agenda-month-year}
+@xorgcmd{v y,org-agenda-year-view}
@xorgcmd{v SPC,org-agenda-reset-view}
@vindex org-agenda-span
Switch to day/week/month/year view. When switching to day or week view, this
@@ -7861,6 +8169,7 @@ press @kbd{v a} again.
@c
@orgcmdkskc{v R,R,org-agenda-clockreport-mode}
@vindex org-agenda-start-with-clockreport-mode
+@vindex org-clock-report-include-clocking-task
Toggle Clockreport mode. In Clockreport mode, the daily/weekly agenda will
always show a table with the clocked times for the timespan and file scope
covered by the current agenda view. The initial setting for this mode in new
@@ -7868,7 +8177,8 @@ agenda buffers can be set with the variable
@code{org-agenda-start-with-clockreport-mode}. By using a prefix argument
when toggling this mode (i.e.@: @kbd{C-u R}), the clock table will not show
contributions from entries that are hidden by agenda filtering@footnote{Only
-tags filtering will be respected here, effort filtering is ignored.}.
+tags filtering will be respected here, effort filtering is ignored.}. See
+also the variable @code{org-clock-report-include-clocking-task}.
@c
@orgkey{v c}
@vindex org-agenda-clock-consistency-checks
@@ -7921,18 +8231,27 @@ Remove the restriction lock on the agenda, if it is currently restricted to a
file or subtree (@pxref{Agenda files}).
@tsubheading{Secondary filtering and query editing}
-@cindex filtering, by tag and effort, in agenda
+@cindex filtering, by tag category and effort, in agenda
@cindex tag filtering, in agenda
+@cindex category filtering, in agenda
@cindex effort filtering, in agenda
@cindex query editing, in agenda
+@orgcmd{<,org-agenda-filter-by-category}
+@vindex org-agenda-category-filter-preset
+
+Filter the current agenda view with respect to the category of the item at
+point. Pressing @code{<} another time will remove this filter. You can add
+a filter preset through the option @code{org-agenda-category-filter-preset}
+(see below.)
+
@orgcmd{/,org-agenda-filter-by-tag}
-@vindex org-agenda-filter-preset
+@vindex org-agenda-tag-filter-preset
Filter the current agenda view with respect to a tag and/or effort estimates.
The difference between this and a custom agenda command is that filtering is
very fast, so that you can switch quickly between different filters without
having to recreate the agenda.@footnote{Custom commands can preset a filter by
-binding the variable @code{org-agenda-filter-preset} as an option. This
+binding the variable @code{org-agenda-tag-filter-preset} as an option. This
filter will then be applied to the view and persist as a basic filter through
refreshes and more secondary filtering. The filter is a global property of
the entire agenda view---in a block agenda, you should only set this in the
@@ -8076,7 +8395,7 @@ agenda, change a tag for all headings in the region.
@kindex ,
@item ,
Set the priority for the current item (@command{org-agenda-priority}).
-Org-mode prompts for the priority character. If you reply with @key{SPC},
+Org mode prompts for the priority character. If you reply with @key{SPC},
the priority cookie is removed from the entry.
@c
@orgcmd{P,org-agenda-show-priority}
@@ -8105,30 +8424,17 @@ Schedule this item. With prefix arg remove the scheduling timestamp
@orgcmd{C-c C-d,org-agenda-deadline}
Set a deadline for this item. With prefix arg remove the deadline.
@c
-@orgcmd{k,org-agenda-action}
-Agenda actions, to set dates for selected items to the cursor date.
-This command also works in the calendar! The command prompts for an
-additional key:
-@example
-m @r{Mark the entry at point for action. You can also make entries}
- @r{in Org files with @kbd{C-c C-x C-k}.}
-d @r{Set the deadline of the marked entry to the date at point.}
-s @r{Schedule the marked entry at the date at point.}
-r @r{Call @code{org-capture} with the cursor date as default date.}
-@end example
-@noindent
-Press @kbd{r} afterward to refresh the agenda and see the effect of the
-command.
-@c
@orgcmd{S-@key{right},org-agenda-do-date-later}
Change the timestamp associated with the current line by one day into the
-future. With a numeric prefix argument, change it by that many days. For
-example, @kbd{3 6 5 S-@key{right}} will change it by a year. With a
-@kbd{C-u} prefix, change the time by one hour. If you immediately repeat the
-command, it will continue to change hours even without the prefix arg. With
-a double @kbd{C-u C-u} prefix, do the same for changing minutes. The stamp
-is changed in the original Org file, but the change is not directly reflected
-in the agenda buffer. Use @kbd{r} or @kbd{g} to update the buffer.
+future. If the date is in the past, the first call to this command will move
+it to today.@*
+With a numeric prefix argument, change it by that many days. For example,
+@kbd{3 6 5 S-@key{right}} will change it by a year. With a @kbd{C-u} prefix,
+change the time by one hour. If you immediately repeat the command, it will
+continue to change hours even without the prefix arg. With a double @kbd{C-u
+C-u} prefix, do the same for changing minutes.@*
+The stamp is changed in the original Org file, but the change is not directly
+reflected in the agenda buffer. Use @kbd{r} or @kbd{g} to update the buffer.
@c
@orgcmd{S-@key{left},org-agenda-do-date-earlier}
Change the timestamp associated with the current line by one day
@@ -8150,9 +8456,18 @@ Cancel the currently running clock.
@c
@orgcmd{J,org-agenda-clock-goto}
Jump to the running clock in another window.
+@c
+@orgcmd{k,org-agenda-capture}
+Like @code{org-capture}, but use the date at point as the default date for
+the capture template. See @var{org-capture-use-agenda-date} to make this
+the default behavior of @code{org-capture}.
+@cindex capturing, from agenda
+@vindex org-capture-use-agenda-date
@tsubheading{Bulk remote editing selected entries}
@cindex remote editing, bulk, from agenda
+@vindex org-agenda-bulk-persistent-marks
+@vindex org-agenda-bulk-custom-functions
@orgcmd{m,org-agenda-bulk-mark}
Mark the entry at point for bulk action. With prefix arg, mark that many
@@ -8171,10 +8486,12 @@ Unmark all marked entries for bulk action.
Bulk action: act on all marked entries in the agenda. This will prompt for
another key to select the action to be applied. The prefix arg to @kbd{B}
will be passed through to the @kbd{s} and @kbd{d} commands, to bulk-remove
-these special timestamps.
+these special timestamps. By default, marks are removed after the bulk. If
+you want them to persist, set @code{org-agenda-bulk-persistent-marks} to
+@code{t} or hit @kbd{p} at the prompt.
+
@example
-r @r{Prompt for a single refile target and move all entries. The entries}
- @r{will no longer be in the agenda; refresh (@kbd{g}) to bring them back.}
+* @r{Toggle persistent marks.}
$ @r{Archive all selected entries.}
A @r{Archive entries by moving them to their respective archive siblings.}
t @r{Change TODO state. This prompts for a single TODO keyword and}
@@ -8185,10 +8502,12 @@ t @r{Change TODO state. This prompts for a single TODO keyword and}
s @r{Schedule all items to a new date. To shift existing schedule dates}
@r{by a fixed number of days, use something starting with double plus}
@r{at the prompt, for example @samp{++8d} or @samp{++2w}.}
+d @r{Set deadline to a specific date.}
+r @r{Prompt for a single refile target and move all entries. The entries}
+ @r{will no longer be in the agenda; refresh (@kbd{g}) to bring them back.}
S @r{Reschedule randomly into the coming N days. N will be prompted for.}
@r{With prefix arg (@kbd{C-u B S}), scatter only across weekdays.}
-d @r{Set deadline to a specific date.}
-f @r{Apply a function to marked entries.}
+f @r{Apply a function@footnote{You can also create persistent custom functions through@code{org-agenda-bulk-custom-functions}.} to marked entries.}
@r{For example, the function below sets the CATEGORY property of the}
@r{entries to web.}
@r{(defun set-category ()}
@@ -8213,7 +8532,7 @@ f @r{Apply a function to marked entries.}
Open the Emacs calendar and move to the date at the agenda cursor.
@c
@orgcmd{c,org-calendar-goto-agenda}
-When in the calendar, compute and show the Org-mode agenda for the
+When in the calendar, compute and show the Org mode agenda for the
date at the cursor.
@c
@cindex diary entries, creating from agenda
@@ -8226,8 +8545,8 @@ file@footnote{This file is parsed for the agenda when
command in the calendar. The diary file will pop up in another window, where
you can add the entry.
-If you configure @code{org-agenda-diary-file} to point to an Org-mode file,
-Org will create entries (in org-mode syntax) in that file instead. Most
+If you configure @code{org-agenda-diary-file} to point to an Org mode file,
+Org will create entries (in Org mode syntax) in that file instead. Most
entries will be stored in a date-based outline tree that will later make it
easy to archive appointments from previous months/years. The tree will be
built under an entry with a @code{DATE_TREE} property, or else with years as
@@ -8256,13 +8575,13 @@ Export a single iCalendar file containing entries from all agenda files.
This is a globally available command, and also available in the agenda menu.
@tsubheading{Exporting to a file}
-@orgcmd{C-x C-w,org-write-agenda}
+@orgcmd{C-x C-w,org-agenda-write}
@cindex exporting agenda views
@cindex agenda views, exporting
@vindex org-agenda-exporter-settings
Write the agenda view to a file. Depending on the extension of the selected
file name, the view will be exported as HTML (extension @file{.html} or
-@file{.htm}), PostScript (extension @file{.ps}), PDF (extension @file{.pdf}),
+@file{.htm}), Postscript (extension @file{.ps}), PDF (extension @file{.pdf}),
and plain text (any other extension). When called with a @kbd{C-u} prefix
argument, immediately open the newly created file. Use the variable
@code{org-agenda-exporter-settings} to set options for @file{ps-print} and
@@ -8305,11 +8624,12 @@ buffer, or a sparse tree (the latter covering of course only the current
buffer).
@kindex C-c a C
@vindex org-agenda-custom-commands
+
Custom commands are configured in the variable
@code{org-agenda-custom-commands}. You can customize this variable, for
-example by pressing @kbd{C-c a C}. You can also directly set it with
-Emacs Lisp in @file{.emacs}. The following example contains all valid
-search types:
+example by pressing @kbd{C-c a C}. You can also directly set it with Emacs
+Lisp in @file{.emacs}. The following example contains all valid search
+types:
@lisp
@group
@@ -8403,7 +8723,7 @@ command @kbd{C-c a o} provides a similar view for office tasks.
@cindex options, for custom agenda views
@vindex org-agenda-custom-commands
-Org-mode contains a number of variables regulating agenda construction
+Org mode contains a number of variables regulating agenda construction
and display. The global variables define the behavior for all agenda
commands, including the custom commands. However, if you want to change
some settings just for a single custom view, you can do so. Setting
@@ -8469,27 +8789,48 @@ this interface, the @emph{values} are just Lisp expressions. So if the
value is a string, you need to add the double-quotes around the value
yourself.
+@vindex org-agenda-custom-commands-contexts
+To control whether an agenda command should be accessible from a specific
+context, you can customize @var{org-agenda-custom-commands-contexts}. Let's
+say for example that you have an agenda commands @code{"o"} displaying a view
+that you only need when reading emails. Then you would configure this option
+like this:
+
+@example
+(setq org-agenda-custom-commands-contexts
+ '(("o" (in-mode . "message-mode"))))
+@end example
+
+You can also tell that the command key @code{"o"} should refer to another
+command key @code{"r"}. In that case, add this command key like this:
+
+@example
+(setq org-agenda-custom-commands-contexts
+ '(("o" "r" (in-mode . "message-mode"))))
+@end example
+
+See the docstring of the variable for more information.
@node Exporting Agenda Views, Agenda column view, Custom agenda views, Agenda Views
@section Exporting Agenda Views
@cindex agenda views, exporting
If you are away from your computer, it can be very useful to have a printed
-version of some agenda views to carry around. Org-mode can export custom
+version of some agenda views to carry around. Org mode can export custom
agenda views as plain text, HTML@footnote{You need to install Hrvoje Niksic's
-@file{htmlize.el}.}, PostScript, PDF@footnote{To create PDF output, the
+@file{htmlize.el}.}, Postscript, PDF@footnote{To create PDF output, the
ghostscript @file{ps2pdf} utility must be installed on the system. Selecting
-a PDF file will also create the PostScript file.}, and iCalendar files. If
+a PDF file will also create the postscript file.}, and iCalendar files. If
you want to do this only occasionally, use the command
@table @kbd
-@orgcmd{C-x C-w,org-write-agenda}
+@orgcmd{C-x C-w,org-agenda-write}
@cindex exporting agenda views
@cindex agenda views, exporting
@vindex org-agenda-exporter-settings
Write the agenda view to a file. Depending on the extension of the selected
file name, the view will be exported as HTML (extension @file{.html} or
-@file{.htm}), PostScript (extension @file{.ps}), iCalendar (extension
+@file{.htm}), Postscript (extension @file{.ps}), iCalendar (extension
@file{.ics}), or plain text (any other extension). Use the variable
@code{org-agenda-exporter-settings} to set options for @file{ps-print} and
for @file{htmlize} to be used during export, for example
@@ -8539,10 +8880,10 @@ or absolute.
@end lisp
The extension of the file name determines the type of export. If it is
-@file{.html}, Org-mode will use the @file{htmlize.el} package to convert
+@file{.html}, Org mode will use the @file{htmlize.el} package to convert
the buffer to HTML and save it to this file name. If the extension is
@file{.ps}, @code{ps-print-buffer-with-faces} is used to produce
-PostScript output. If the extension is @file{.ics}, iCalendar export is
+Postscript output. If the extension is @file{.ics}, iCalendar export is
run export over all files that were used to construct the agenda, and
limit the export to entries listed in the agenda. Any other
extension produces a plain ASCII file.
@@ -8573,7 +8914,7 @@ set options for the export commands. For example:
@end lisp
@noindent
-This command sets two options for the PostScript exporter, to make it
+This command sets two options for the Postscript exporter, to make it
print in two columns in landscape format---the resulting page can be cut
in two and then used in a paper agenda. The remaining settings modify
the agenda prefix to omit category and scheduling information, and
@@ -8586,14 +8927,14 @@ in @code{org-agenda-custom-commands} take precedence.
@noindent
From the command line you may also use
@example
-emacs -f org-batch-store-agenda-views -kill
+emacs -eval (org-batch-store-agenda-views) -kill
@end example
@noindent
or, if you need to modify some parameters@footnote{Quoting depends on the
system you use, please check the FAQ for examples.}
@example
emacs -eval '(org-batch-store-agenda-views \
- org-agenda-span month \
+ org-agenda-span (quote month) \
org-agenda-start-day "2007-11-01" \
org-agenda-include-diary nil \
org-agenda-files (quote ("~/org/project.org")))' \
@@ -8662,17 +9003,25 @@ a column listing the planned total effort for a task---one of the major
applications for column view in the agenda. If you want information about
clocked time in the displayed period use clock table mode (press @kbd{R} in
the agenda).
+
+@item
+@cindex property, special, CLOCKSUM_T
+When the column view in the agenda shows the @code{CLOCKSUM_T}, that is
+always today's clocked time for this item. So even in the weekly agenda,
+the clocksum listed in column view only originates from today. This lets
+you compare the time you spent on a task for today, with the time already
+spent (via @code{CLOCKSUM}) and with the planned total effort for it.
@end enumerate
@node Markup, Exporting, Agenda Views, Top
@chapter Markup for rich export
-When exporting Org-mode documents, the exporter tries to reflect the
+When exporting Org mode documents, the exporter tries to reflect the
structure of the document as accurately as possible in the backend. Since
export targets like HTML, @LaTeX{}, or DocBook allow much richer formatting,
-Org-mode has rules on how to prepare text for rich export. This section
-summarizes the markup rules used in an Org-mode buffer.
+Org mode has rules on how to prepare text for rich export. This section
+summarizes the markup rules used in an Org mode buffer.
@menu
* Structural markup elements:: The basic structure as seen by the exporter
@@ -8681,7 +9030,7 @@ summarizes the markup rules used in an Org-mode buffer.
* Include files:: Include additional files into a document
* Index entries:: Making an index
* Macro replacement:: Use macros to create complex output
-* Embedded LaTeX:: LaTeX can be freely used inside Org documents
+* Embedded @LaTeX{}:: LaTeX can be freely used inside Org documents
@end menu
@node Structural markup elements, Images and tables, Markup, Markup
@@ -8764,7 +9113,7 @@ the table of contents entirely, by configuring the variable
@cindex text before first headline, markup rules
@cindex #+TEXT
-Org-mode normally exports the text before the first headline, and even uses
+Org mode normally exports the text before the first headline, and even uses
the first line as the document title. The text will be fully marked up. If
you need to include literal HTML, @LaTeX{}, or DocBook code, use the special
constructs described below in the sections for the individual exporters.
@@ -8818,7 +9167,7 @@ can use this construct, which can also be used to format poetry.
When quoting a passage from another document, it is customary to format this
as a paragraph that is indented on both the left and the right margin. You
-can include quotations in Org-mode documents like this:
+can include quotations in Org mode documents like this:
@cindex #+BEGIN_QUOTE
@example
@@ -8858,7 +9207,7 @@ multiple footnotes side by side.
@cindex strike-through text, markup rules
You can make words @b{*bold*}, @i{/italic/}, _underlined_, @code{=code=}
and @code{~verbatim~}, and, if you must, @samp{+strike-through+}. Text
-in the code and verbatim string is not processed for Org-mode specific
+in the code and verbatim string is not processed for Org mode specific
syntax; it is exported verbatim.
@node Horizontal rules, Comment lines, Emphasis and monospace, Structural markup elements
@@ -8873,11 +9222,11 @@ a horizontal line (@samp{<hr/>} in HTML and @code{\hrule} in @LaTeX{}).
@cindex exporting, not
@cindex #+BEGIN_COMMENT
-Lines starting with @samp{#} in column zero are treated as comments and will
-never be exported. If you want an indented line to be treated as a comment,
-start it with @samp{#+ }. Also entire subtrees starting with the word
-@samp{COMMENT} will never be exported. Finally, regions surrounded by
-@samp{#+BEGIN_COMMENT} ... @samp{#+END_COMMENT} will not be exported.
+Lines starting with zero or more whitespace characters followed by @samp{#}
+are treated as comments and will never be exported. Also entire subtrees
+starting with the word @samp{COMMENT} will never be exported. Finally,
+regions surrounded by @samp{#+BEGIN_COMMENT} ... @samp{#+END_COMMENT} will
+not be exported.
@table @kbd
@kindex C-c ;
@@ -8892,8 +9241,8 @@ Toggle the COMMENT keyword at the beginning of an entry.
@cindex tables, markup rules
@cindex #+CAPTION
@cindex #+LABEL
-Both the native Org-mode tables (@pxref{Tables}) and tables formatted with
-the @file{table.el} package will be exported properly. For Org-mode tables,
+Both the native Org mode tables (@pxref{Tables}) and tables formatted with
+the @file{table.el} package will be exported properly. For Org mode tables,
the lines before the first horizontal separator line will become table header
lines. You can use the following lines somewhere before the table to assign
a caption and a label for cross references, and in the text you can refer to
@@ -8901,7 +9250,7 @@ the object with @code{\ref@{tab:basic-data@}}:
@example
#+CAPTION: This is the caption for the next table (or link)
-#+LABEL: tbl:basic-data
+#+LABEL: tab:basic-data
| ... | ...|
|-----|----|
@end example
@@ -8963,24 +9312,16 @@ If the example is source code from a programming language, or any other text
that can be marked up by font-lock in Emacs, you can ask for the example to
look like the fontified Emacs buffer@footnote{This works automatically for
the HTML backend (it requires version 1.34 of the @file{htmlize.el} package,
-which is distributed with Org). Fontified code chunks in LaTeX can be
+which is distributed with Org). Fontified code chunks in @LaTeX{} can be
achieved using either the listings or the
-@url{http://code.google.com/p/minted, minted,} package. To use listings, turn
-on the variable @code{org-export-latex-listings} and ensure that the listings
-package is included by the LaTeX header (e.g.@: by configuring
-@code{org-export-latex-packages-alist}). See the listings documentation for
-configuration options, including obtaining colored output. For minted it is
-necessary to install the program @url{http://pygments.org, pygments}, in
-addition to setting @code{org-export-latex-minted}, ensuring that the minted
-package is included by the LaTeX header, and ensuring that the
-@code{-shell-escape} option is passed to @file{pdflatex} (see
-@code{org-latex-to-pdf-process}). See the documentation of the variables
-@code{org-export-latex-listings} and @code{org-export-latex-minted} for
-further details.}. This is done with the @samp{src} block, where you also
-need to specify the name of the major mode that should be used to fontify the
-example@footnote{Code in @samp{src} blocks may also be evaluated either
-interactively or on export. See @pxref{Working With Source Code} for more
-information on evaluating code blocks.}:
+@url{http://code.google.com/p/minted, minted,} package. Refer to
+@code{org-export-latex-listings} documentation for details.}. This is done
+with the @samp{src} block, where you also need to specify the name of the
+major mode that should be used to fontify the example@footnote{Code in
+@samp{src} blocks may also be evaluated either interactively or on export.
+See @pxref{Working With Source Code} for more information on evaluating code
+blocks.}, see @ref{Easy Templates} for shortcuts to easily insert code
+blocks.
@cindex #+BEGIN_SRC
@example
@@ -9004,7 +9345,7 @@ cool.
You can also add a @code{-r} switch which @i{removes} the labels from the
source code@footnote{Adding @code{-k} to @code{-n -r} will @i{keep} the
labels in the source code while using line numbers for the links, which might
-be useful to explain those in an org-mode example code.}. With the @code{-n}
+be useful to explain those in an Org mode example code.}. With the @code{-n}
switch, links to these references will be labeled by the line numbers from
the code listing, otherwise links will use the labels with no parentheses.
Here is an example:
@@ -9035,16 +9376,16 @@ so often, shortcuts are provided using the Easy Templates facility
@item C-c '
Edit the source code example at point in its native mode. This works by
switching to a temporary buffer with the source code. You need to exit by
-pressing @kbd{C-c '} again@footnote{Upon exit, lines starting with @samp{*}
-or @samp{#} will get a comma prepended, to keep them from being interpreted
-by Org as outline nodes or special comments. These commas will be stripped
-for editing with @kbd{C-c '}, and also for export.}. The edited version will
-then replace the old version in the Org buffer. Fixed-width regions
-(where each line starts with a colon followed by a space) will be edited
-using @code{artist-mode}@footnote{You may select a different-mode with the
-variable @code{org-edit-fixed-width-region-mode}.} to allow creating ASCII
-drawings easily. Using this command in an empty line will create a new
-fixed-width region.
+pressing @kbd{C-c '} again@footnote{Upon exit, lines starting with @samp{*},
+@samp{,*}, @samp{#+} and @samp{,#+} will get a comma prepended, to keep them
+from being interpreted by Org as outline nodes or special syntax. These
+commas will be stripped for editing with @kbd{C-c '}, and also for export.}.
+The edited version will then replace the old version in the Org buffer.
+Fixed-width regions (where each line starts with a colon followed by a space)
+will be edited using @code{artist-mode}@footnote{You may select
+a different-mode with the variable @code{org-edit-fixed-width-region-mode}.}
+to allow creating ASCII drawings easily. Using this command in an empty line
+will create a new fixed-width region.
@kindex C-c l
@item C-c l
Calling @code{org-store-link} while editing a source code example in a
@@ -9070,11 +9411,11 @@ include your @file{.emacs} file, you could use:
The optional second and third parameter are the markup (e.g.@: @samp{quote},
@samp{example}, or @samp{src}), and, if the markup is @samp{src}, the
language for formatting the contents. The markup is optional; if it is not
-given, the text will be assumed to be in Org-mode format and will be
+given, the text will be assumed to be in Org mode format and will be
processed normally. The include line will also allow additional keyword
parameters @code{:prefix1} and @code{:prefix} to specify prefixes for the
first line and for each following line, @code{:minlevel} in order to get
-org-mode content demoted to a specified level, as well as any options
+Org mode content demoted to a specified level, as well as any options
accepted by the selected markup. For example, to include a file as an item,
use
@@ -9117,7 +9458,7 @@ an index} for more information.
-@node Macro replacement, Embedded LaTeX, Index entries, Markup
+@node Macro replacement, Embedded @LaTeX{}, Index entries, Markup
@section Macro replacement
@cindex macro replacement, during export
@cindex #+MACRO
@@ -9142,7 +9483,7 @@ Macro expansion takes place during export, and some people use it to
construct complex HTML code.
-@node Embedded LaTeX, , Macro replacement, Markup
+@node Embedded @LaTeX{}, , Macro replacement, Markup
@section Embedded @LaTeX{}
@cindex @TeX{} interpretation
@cindex @LaTeX{} interpretation
@@ -9152,7 +9493,7 @@ include scientific notes, which often require mathematical symbols and the
occasional formula. @LaTeX{}@footnote{@LaTeX{} is a macro system based on
Donald E. Knuth's @TeX{} system. Many of the features described here as
``@LaTeX{}'' are really from @TeX{}, but for simplicity I am blurring this
-distinction.} is widely used to typeset scientific documents. Org-mode
+distinction.} is widely used to typeset scientific documents. Org mode
supports embedding @LaTeX{} code into its files, because many academics are
used to writing and reading @LaTeX{} source code, and because it can be
readily processed to produce pretty output for a number of export backends.
@@ -9160,12 +9501,12 @@ readily processed to produce pretty output for a number of export backends.
@menu
* Special symbols:: Greek letters and other symbols
* Subscripts and superscripts:: Simple syntax for raising/lowering text
-* LaTeX fragments:: Complex formulas made easy
-* Previewing LaTeX fragments:: What will this snippet look like?
+* @LaTeX{} fragments:: Complex formulas made easy
+* Previewing @LaTeX{} fragments:: What will this snippet look like?
* CDLaTeX mode:: Speed up entering of formulas
@end menu
-@node Special symbols, Subscripts and superscripts, Embedded LaTeX, Embedded LaTeX
+@node Special symbols, Subscripts and superscripts, Embedded @LaTeX{}, Embedded @LaTeX{}
@subsection Special symbols
@cindex math symbols
@cindex special symbols
@@ -9178,7 +9519,7 @@ You can use @LaTeX{} macros to insert special symbols like @samp{\alpha} to
indicate the Greek letter, or @samp{\to} to indicate an arrow. Completion
for these macros is available, just type @samp{\} and maybe a few letters,
and press @kbd{M-@key{TAB}} to see possible completions. Unlike @LaTeX{}
-code, Org-mode allows these macros to be present without surrounding math
+code, Org mode allows these macros to be present without surrounding math
delimiters, for example:
@example
@@ -9212,7 +9553,7 @@ buffer content which remains plain ASCII, but it overlays the UTF-8 character
for display purposes only.
@end table
-@node Subscripts and superscripts, LaTeX fragments, Special symbols, Embedded LaTeX
+@node Subscripts and superscripts, @LaTeX{} fragments, Special symbols, Embedded @LaTeX{}
@subsection Subscripts and superscripts
@cindex subscript
@cindex superscript
@@ -9250,13 +9591,13 @@ In addition to showing entities as UTF-8 characters, this command will also
format sub- and superscripts in a WYSIWYM way.
@end table
-@node LaTeX fragments, Previewing LaTeX fragments, Subscripts and superscripts, Embedded LaTeX
+@node @LaTeX{} fragments, Previewing @LaTeX{} fragments, Subscripts and superscripts, Embedded @LaTeX{}
@subsection @LaTeX{} fragments
@cindex @LaTeX{} fragments
@vindex org-format-latex-header
Going beyond symbols and sub- and superscripts, a full formula language is
-needed. Org-mode can contain @LaTeX{} math fragments, and it supports ways
+needed. Org mode can contain @LaTeX{} math fragments, and it supports ways
to process these for several export backends. When exporting to @LaTeX{},
the code is obviously left as it is. When exporting to HTML, Org invokes the
@uref{http://www.mathjax.org, MathJax library} (@pxref{Math formatting in
@@ -9266,10 +9607,11 @@ this regularly or on pages with significant page views, you should install
server in order to limit the load of our server.}. Finally, it can also
process the mathematical expressions into images@footnote{For this to work
you need to be on a system with a working @LaTeX{} installation. You also
-need the @file{dvipng} program, available at
-@url{http://sourceforge.net/projects/dvipng/}. The @LaTeX{} header that will
-be used when processing a fragment can be configured with the variable
-@code{org-format-latex-header}.} that can be displayed in a browser or in
+need the @file{dvipng} program or the @file{convert}, respectively available
+at @url{http://sourceforge.net/projects/dvipng/} and from the
+@file{imagemagick} suite. The @LaTeX{} header that will be used when
+processing a fragment can be configured with the variable
+@code{org-format-latex-header}.} that can be displayed in a browser or in
DocBook documents.
@LaTeX{} fragments don't need any special marking at all. The following
@@ -9309,10 +9651,10 @@ can configure the option @code{org-format-latex-options} to deselect the
ones you do not wish to have interpreted by the @LaTeX{} converter.
@vindex org-export-with-LaTeX-fragments
-LaTeX processing can be configured with the variable
+@LaTeX{} processing can be configured with the variable
@code{org-export-with-LaTeX-fragments}. The default setting is @code{t}
which means @file{MathJax} for HTML, and no processing for DocBook, ASCII and
-LaTeX backends. You can also set this variable on a per-file basis using one
+@LaTeX{} backends. You can also set this variable on a per-file basis using one
of these lines:
@example
@@ -9322,9 +9664,9 @@ of these lines:
#+OPTIONS: LaTeX:verbatim @r{Verbatim export, for jsMath or so}
@end example
-@node Previewing LaTeX fragments, CDLaTeX mode, LaTeX fragments, Embedded LaTeX
-@subsection Previewing LaTeX fragments
-@cindex LaTeX fragments, preview
+@node Previewing @LaTeX{} fragments, CDLaTeX mode, @LaTeX{} fragments, Embedded @LaTeX{}
+@subsection Previewing @LaTeX{} fragments
+@cindex @LaTeX{} fragments, preview
If you have @file{dvipng} installed, @LaTeX{} fragments can be processed to
produce preview images of the typeset expressions:
@@ -9349,18 +9691,18 @@ some aspects of the preview. In particular, the @code{:scale} (and for HTML
export, @code{:html-scale}) property can be used to adjust the size of the
preview images.
-@node CDLaTeX mode, , Previewing LaTeX fragments, Embedded LaTeX
-@subsection Using CDLa@TeX{} to enter math
-@cindex CDLa@TeX{}
+@node CDLaTeX mode, , Previewing @LaTeX{} fragments, Embedded @LaTeX{}
+@subsection Using CD@LaTeX{} to enter math
+@cindex CD@LaTeX{}
-CDLa@TeX{} mode is a minor mode that is normally used in combination with a
+CD@LaTeX{} mode is a minor mode that is normally used in combination with a
major @LaTeX{} mode like AUC@TeX{} in order to speed-up insertion of
-environments and math templates. Inside Org-mode, you can make use of
-some of the features of CDLa@TeX{} mode. You need to install
+environments and math templates. Inside Org mode, you can make use of
+some of the features of CD@LaTeX{} mode. You need to install
@file{cdlatex.el} and @file{texmathp.el} (the latter comes also with
AUC@TeX{}) from @url{http://www.astro.uva.nl/~dominik/Tools/cdlatex}.
-Don't use CDLa@TeX{} mode itself under Org-mode, but use the light
-version @code{org-cdlatex-mode} that comes as part of Org-mode. Turn it
+Don't use CD@LaTeX{} mode itself under Org mode, but use the light
+version @code{org-cdlatex-mode} that comes as part of Org mode. Turn it
on for the current buffer with @code{M-x org-cdlatex-mode}, or for all
Org files with
@@ -9369,7 +9711,7 @@ Org files with
@end lisp
When this mode is enabled, the following features are present (for more
-details see the documentation of CDLa@TeX{} mode):
+details see the documentation of CD@LaTeX{} mode):
@itemize @bullet
@kindex C-c @{
@item
@@ -9377,7 +9719,7 @@ Environment templates can be inserted with @kbd{C-c @{}.
@item
@kindex @key{TAB}
The @key{TAB} key will do template expansion if the cursor is inside a
-@LaTeX{} fragment@footnote{Org-mode has a method to test if the cursor is
+@LaTeX{} fragment@footnote{Org mode has a method to test if the cursor is
inside such a fragment, see the documentation of the function
@code{org-inside-LaTeX-fragment-p}.}. For example, @key{TAB} will
expand @code{fr} to @code{\frac@{@}@{@}} and position the cursor
@@ -9414,20 +9756,20 @@ is normal.
@chapter Exporting
@cindex exporting
-Org-mode documents can be exported into a variety of other formats. For
+Org mode documents can be exported into a variety of other formats. For
printing and sharing of notes, ASCII export produces a readable and simple
version of an Org file. HTML export allows you to publish a notes file on
the web, while the XOXO format provides a solid base for exchange with a
-broad range of other applications. @LaTeX{} export lets you use Org-mode and
+broad range of other applications. @LaTeX{} export lets you use Org mode and
its structured editing functions to easily create @LaTeX{} files. DocBook
export makes it possible to convert Org files to many other formats using
-DocBook tools. OpenDocumentText export allows seamless collaboration across
-organizational boundaries. For project management you can create gantt and
-resource charts by using TaskJuggler export. To incorporate entries with
-associated times like deadlines or appointments into a desktop calendar
-program like iCal, Org-mode can also produce extracts in the iCalendar
-format. Currently Org-mode only supports export, not import of these
-different formats.
+DocBook tools. OpenDocument Text (ODT) export allows seamless
+collaboration across organizational boundaries. For project management you
+can create gantt and resource charts by using TaskJuggler export. To
+incorporate entries with associated times like deadlines or appointments into
+a desktop calendar program like iCal, Org mode can also produce extracts in
+the iCalendar format. Currently, Org mode only supports export, not import of
+these different formats.
Org supports export of selected regions when @code{transient-mark-mode} is
enabled (default in Emacs 23).
@@ -9438,9 +9780,9 @@ enabled (default in Emacs 23).
* The export dispatcher:: How to access exporter commands
* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding
* HTML export:: Exporting to HTML
-* LaTeX and PDF export:: Exporting to @LaTeX{}, and processing to PDF
+* @LaTeX{} and PDF export:: Exporting to @LaTeX{}, and processing to PDF
* DocBook export:: Exporting to DocBook
-* OpenDocumentText export:: Exporting to OpenDocumentText
+* OpenDocument Text export:: Exporting to OpenDocument Text
* TaskJuggler export:: Exporting to TaskJuggler
* Freemind export:: Exporting to Freemind mind maps
* XOXO export:: Exporting to XOXO
@@ -9456,7 +9798,8 @@ enabled (default in Emacs 23).
@cindex org-export-with-tasks
You may use tags to select the parts of a document that should be exported,
or to exclude parts from export. This behavior is governed by two variables:
-@code{org-export-select-tags} and @code{org-export-exclude-tags}.
+@code{org-export-select-tags} and @code{org-export-exclude-tags},
+respectively defaulting to @code{'(:export:)} and @code{'(:noexport:)}.
@enumerate
@item
@@ -9513,14 +9856,15 @@ Insert template with export options, see example below.
@cindex #+EXPORT_SELECT_TAGS
@cindex #+EXPORT_EXCLUDE_TAGS
@cindex #+XSLT
-@cindex #+LATEX_HEADER
+@cindex #+LaTeX_HEADER
@vindex user-full-name
@vindex user-mail-address
@vindex org-export-default-language
+@vindex org-export-date-timestamp-format
@example
#+TITLE: the title to be shown (default is the buffer name)
#+AUTHOR: the author (default taken from @code{user-full-name})
-#+DATE: a date, fixed, or a format string for @code{format-time-string}
+#+DATE: a date, an Org timestamp@footnote{@code{org-export-date-timestamp-format} defines how this timestamp will be exported.}, or a format string for @code{format-time-string}
#+EMAIL: his/her email address (default from @code{user-mail-address})
#+DESCRIPTION: the page description, e.g.@: for the XHTML meta tag
#+KEYWORDS: the page keywords, e.g.@: for the XHTML meta tag
@@ -9528,19 +9872,19 @@ Insert template with export options, see example below.
#+TEXT: Some descriptive text to be inserted at the beginning.
#+TEXT: Several lines may be given.
#+OPTIONS: H:2 num:t toc:t \n:nil @@:t ::t |:t ^:t f:t TeX:t ...
-#+BIND: lisp-var lisp-val, e.g.@:: org-export-latex-low-levels itemize
+#+BIND: lisp-var lisp-val, e.g.@:: @code{org-export-latex-low-levels itemize}
@r{You need to confirm using these, or configure @code{org-export-allow-BIND}}
#+LINK_UP: the ``up'' link of an exported page
#+LINK_HOME: the ``home'' link of an exported page
-#+LATEX_HEADER: extra line(s) for the LaTeX header, like \usepackage@{xyz@}
+#+LaTeX_HEADER: extra line(s) for the @LaTeX{} header, like \usepackage@{xyz@}
#+EXPORT_SELECT_TAGS: Tags that select a tree for export
#+EXPORT_EXCLUDE_TAGS: Tags that exclude a tree from export
#+XSLT: the XSLT stylesheet used by DocBook exporter to generate FO file
@end example
@noindent
-The OPTIONS line is a compact@footnote{If you want to configure many options
-this way, you can use several OPTIONS lines.} form to specify export
+The @code{#+OPTIONS} line is a compact@footnote{If you want to configure many options
+this way, you can use several @code{#+OPTIONS} lines.} form to specify export
settings. Here you can:
@cindex headline levels
@cindex section-numbers
@@ -9589,7 +9933,7 @@ author: @r{turn on/off inclusion of author name/email into exported file}
email: @r{turn on/off inclusion of author email into exported file}
creator: @r{turn on/off inclusion of creator info into exported file}
timestamp: @r{turn on/off inclusion creation time into exported file}
-d: @r{turn on/off inclusion of drawers}
+d: @r{turn on/off inclusion of drawers, or list drawers to include}
@end example
@noindent
These options take effect in both the HTML and @LaTeX{} export, except for
@@ -9642,7 +9986,7 @@ not set, or force processing in the current Emacs process if set.
@cindex Latin-1 export
@cindex UTF-8 export
-ASCII export produces a simple and very readable version of an Org-mode
+ASCII export produces a simple and very readable version of an Org mode
file, containing only plain ASCII. Latin-1 and UTF-8 export augment the file
with special characters and symbols available in these encodings.
@@ -9652,7 +9996,7 @@ with special characters and symbols available in these encodings.
@table @kbd
@orgcmd{C-c C-e a,org-export-as-ascii}
@cindex property, EXPORT_FILE_NAME
-Export as ASCII file. For an Org file, @file{myfile.org}, the ASCII file
+Export as an ASCII file. For an Org file, @file{myfile.org}, the ASCII file
will be @file{myfile.txt}. The file will be overwritten without
warning. If there is an active region@footnote{This requires
@code{transient-mark-mode} be turned on.}, only the region will be
@@ -9684,31 +10028,31 @@ at a different level, specify it with a prefix argument. For example,
@end example
@noindent
-creates only top level headlines and does the rest as items. When
+creates only top level headlines and exports the rest as items. When
headlines are converted to items, the indentation of the text following
the headline is changed to fit nicely under the item. This is done with
the assumption that the first body line indicates the base indentation of
the body text. Any indentation larger than this is adjusted to preserve
the layout relative to the first line. Should there be lines with less
-indentation than the first, these are left alone.
+indentation than the first one, these are left alone.
@vindex org-export-ascii-links-to-notes
Links will be exported in a footnote-like style, with the descriptive part in
the text and the link in a note before the next heading. See the variable
@code{org-export-ascii-links-to-notes} for details and other options.
-@node HTML export, LaTeX and PDF export, ASCII/Latin-1/UTF-8 export, Exporting
+@node HTML export, @LaTeX{} and PDF export, ASCII/Latin-1/UTF-8 export, Exporting
@section HTML export
@cindex HTML export
-Org-mode contains an HTML (XHTML 1.0 strict) exporter with extensive
+Org mode contains a HTML (XHTML 1.0 strict) exporter with extensive
HTML formatting, in ways similar to John Gruber's @emph{markdown}
language, but with additional support for tables.
@menu
* HTML Export commands:: How to invoke HTML export
* HTML preamble and postamble:: How to insert a preamble and a postamble
-* Quoting HTML tags:: Using direct HTML in Org-mode
+* Quoting HTML tags:: Using direct HTML in Org mode
* Links in HTML export:: How links will be interpreted and formatted
* Tables in HTML export:: How to modify the formatting of tables
* Images in HTML export:: How to insert figures into HTML output
@@ -9727,7 +10071,7 @@ language, but with additional support for tables.
@table @kbd
@orgcmd{C-c C-e h,org-export-as-html}
@cindex property, EXPORT_FILE_NAME
-Export as HTML file. For an Org file @file{myfile.org},
+Export as a HTML file. For an Org file @file{myfile.org},
the HTML file will be @file{myfile.html}. The file will be overwritten
without warning. If there is an active region@footnote{This requires
@code{transient-mark-mode} be turned on.}, only the region will be
@@ -9736,7 +10080,7 @@ current subtree, use @kbd{C-c @@}.}, the tree head will become the document
title. If the tree head entry has, or inherits, an @code{EXPORT_FILE_NAME}
property, that name will be used for the export.
@orgcmd{C-c C-e b,org-export-as-html-and-open}
-Export as HTML file and immediately open it with a browser.
+Export as a HTML file and immediately open it with a browser.
@orgcmd{C-c C-e H,org-export-as-html-to-buffer}
Export to a temporary buffer. Do not create a file.
@orgcmd{C-c C-e R,org-export-region-as-html}
@@ -9746,11 +10090,11 @@ the region. This is good for cut-and-paste operations.
@item C-c C-e v h/b/H/R
Export only the visible part of the document.
@item M-x org-export-region-as-html
-Convert the region to HTML under the assumption that it was Org-mode
+Convert the region to HTML under the assumption that it was in Org mode
syntax before. This is a global command that can be invoked in any
buffer.
@item M-x org-replace-region-by-HTML
-Replace the active region (assumed to be in Org-mode syntax) by HTML
+Replace the active region (assumed to be in Org mode syntax) by HTML
code.
@end table
@@ -9783,11 +10127,11 @@ creates two levels of headings and does the rest as items.
The HTML exporter lets you define a preamble and a postamble.
The default value for @code{org-export-html-preamble} is @code{t}, which
-means that the preamble is inserted depending on the relevant formatting
-string in @code{org-export-html-preamble-format}.
+means that the preamble is inserted depending on the relevant format string
+in @code{org-export-html-preamble-format}.
Setting @code{org-export-html-preamble} to a string will override the default
-formatting string. Setting it to a function, will insert the output of the
+format string. Setting it to a function, will insert the output of the
function, which must be a string; such a function takes no argument but you
can check against the value of @code{opt-plist}, which contains the list of
publishing properties for the current file. Setting to @code{nil} will not
@@ -9799,7 +10143,7 @@ means that the HTML exporter will look for the value of
@code{org-export-creator-info} and @code{org-export-time-stamp-file},
@code{org-export-html-validation-link} and build the postamble from these
values. Setting @code{org-export-html-postamble} to @code{t} will insert the
-postamble from the relevant formatting string found in
+postamble from the relevant format string found in
@code{org-export-html-postamble-format}. Setting it to @code{nil} will not
insert any postamble.
@@ -9840,7 +10184,7 @@ includes automatic links created by radio targets (@pxref{Radio
targets}). Links to external files will still work if the target file is on
the same @i{relative} path as the published Org file. Links to other
@file{.org} files will be translated into HTML links under the assumption
-that an HTML version also exists of the linked file, at the same relative
+that a HTML version also exists of the linked file, at the same relative
path. @samp{id:} links can then be used to jump to specific entries across
files. For information related to linking files while publishing them to a
publishing directory see @ref{Publishing links}.
@@ -9852,7 +10196,7 @@ and @code{style} attributes for a link:
@cindex #+ATTR_HTML
@example
-#+ATTR_HTML: title="The Org-mode homepage" style="color:red;"
+#+ATTR_HTML: title="The Org mode homepage" style="color:red;"
[[http://orgmode.org]]
@end example
@@ -9861,7 +10205,7 @@ and @code{style} attributes for a link:
@cindex tables, in HTML
@vindex org-export-html-table-tag
-Org-mode tables are exported to HTML using the table tag defined in
+Org mode tables are exported to HTML using the table tag defined in
@code{org-export-html-table-tag}. The default setting makes tables without
cell borders and frame. If you would like to change this for individual
tables, place something like the following before the table:
@@ -9870,7 +10214,7 @@ tables, place something like the following before the table:
@cindex #+ATTR_HTML
@example
#+CAPTION: This is a table with lines around and between cells
-#+ATTR_HTML: border="2" rules="all" frame="all"
+#+ATTR_HTML: border="2" rules="all" frame="border"
@end example
@node Images in HTML export, Math formatting in HTML export, Tables in HTML export, HTML export
@@ -9915,11 +10259,11 @@ You could use @code{http} addresses just as well.
@cindex MathJax
@cindex dvipng
-@LaTeX{} math snippets (@pxref{LaTeX fragments}) can be displayed in two
+@LaTeX{} math snippets (@pxref{@LaTeX{} fragments}) can be displayed in two
different ways on HTML pages. The default is to use the
@uref{http://www.mathjax.org, MathJax system} which should work out of the
box with Org mode installation because @code{http://orgmode.org} serves
-@file{MathJax} for Org-mode users for small applications and for testing
+@file{MathJax} for Org mode users for small applications and for testing
purposes. @b{If you plan to use this regularly or on pages with significant
page views, you should install@footnote{Installation instructions can be
found on the MathJax website, see
@@ -9985,7 +10329,7 @@ addition to any of the standard classes like for headlines, tables, etc.
@example
p.author @r{author information, including email}
p.date @r{publishing date}
-p.creator @r{creator info, about org-mode version}
+p.creator @r{creator info, about org mode version}
.title @r{document title}
.todo @r{TODO keywords, all not-done states}
.done @r{the DONE keywords, all states that count as done}
@@ -10081,7 +10425,7 @@ viewing options:
path: @r{The path to the script. The default is to grab the script from}
@r{@url{http://orgmode.org/org-info.js}, but you might want to have}
@r{a local copy and use a path like @samp{../scripts/org-info.js}.}
-view: @r{Initial view when website is first shown. Possible values are:}
+view: @r{Initial view when the website is first shown. Possible values are:}
info @r{Info-like interface with one section per page.}
overview @r{Folding interface, initially showing only top-level.}
content @r{Folding interface, starting with all headlines visible.}
@@ -10111,16 +10455,16 @@ You can choose default values for these options by customizing the variable
@code{org-infojs-options}. If you always want to apply the script to your
pages, configure the variable @code{org-export-html-use-infojs}.
-@node LaTeX and PDF export, DocBook export, HTML export, Exporting
+@node @LaTeX{} and PDF export, DocBook export, HTML export, Exporting
@section @LaTeX{} and PDF export
@cindex @LaTeX{} export
@cindex PDF export
@cindex Guerry, Bastien
-Org-mode contains a @LaTeX{} exporter written by Bastien Guerry. With
-further processing@footnote{The default LaTeX output is designed for
-processing with pdftex or latex. It includes packages that are not
-compatible with xetex and possibly luatex. See the variables
+Org mode contains a @LaTeX{} exporter written by Bastien Guerry. With
+further processing@footnote{The default @LaTeX{} output is designed for
+processing with @code{pdftex} or @LaTeX{}. It includes packages that are not
+compatible with @code{xetex} and possibly @code{luatex}. See the variables
@code{org-export-latex-default-packages-alist} and
@code{org-export-latex-packages-alist}.}, this backend is also used to
produce PDF output. Since the @LaTeX{} output uses @file{hyperref} to
@@ -10130,15 +10474,15 @@ structured in order to be correctly exported: respect the hierarchy of
sections.
@menu
-* LaTeX/PDF export commands:: Which key invokes which commands
+* @LaTeX{}/PDF export commands::
* Header and sectioning:: Setting up the export file structure
-* Quoting LaTeX code:: Incorporating literal @LaTeX{} code
-* Tables in LaTeX export:: Options for exporting tables to @LaTeX{}
-* Images in LaTeX export:: How to insert figures into @LaTeX{} output
+* Quoting @LaTeX{} code:: Incorporating literal @LaTeX{} code
+* Tables in @LaTeX{} export:: Options for exporting tables to @LaTeX{}
+* Images in @LaTeX{} export:: How to insert figures into @LaTeX{} output
* Beamer class export:: Turning the file into a presentation
@end menu
-@node LaTeX/PDF export commands, Header and sectioning, LaTeX and PDF export, LaTeX and PDF export
+@node @LaTeX{}/PDF export commands, Header and sectioning, @LaTeX{} and PDF export, @LaTeX{} and PDF export
@subsection @LaTeX{} export commands
@cindex region, active
@@ -10147,7 +10491,7 @@ sections.
@table @kbd
@orgcmd{C-c C-e l,org-export-as-latex}
@cindex property EXPORT_FILE_NAME
-Export as @LaTeX{} file. For an Org file
+Export as a @LaTeX{} file. For an Org file
@file{myfile.org}, the @LaTeX{} file will be @file{myfile.tex}. The file will
be overwritten without warning. If there is an active region@footnote{This
requires @code{transient-mark-mode} be turned on.}, only the region will be
@@ -10160,11 +10504,11 @@ Export to a temporary buffer. Do not create a file.
@item C-c C-e v l/L
Export only the visible part of the document.
@item M-x org-export-region-as-latex
-Convert the region to @LaTeX{} under the assumption that it was Org-mode
+Convert the region to @LaTeX{} under the assumption that it was in Org mode
syntax before. This is a global command that can be invoked in any
buffer.
@item M-x org-replace-region-by-latex
-Replace the active region (assumed to be in Org-mode syntax) by @LaTeX{}
+Replace the active region (assumed to be in Org mode syntax) by @LaTeX{}
code.
@orgcmd{C-c C-e p,org-export-as-pdf}
Export as @LaTeX{} and then process to PDF.
@@ -10190,13 +10534,13 @@ with a numeric prefix argument. For example,
@noindent
creates two levels of headings and does the rest as items.
-@node Header and sectioning, Quoting LaTeX code, LaTeX/PDF export commands, LaTeX and PDF export
+@node Header and sectioning, Quoting @LaTeX{} code, @LaTeX{}/PDF export commands, @LaTeX{} and PDF export
@subsection Header and sectioning structure
@cindex @LaTeX{} class
@cindex @LaTeX{} sectioning structure
@cindex @LaTeX{} header
-@cindex header, for LaTeX files
-@cindex sectioning structure, for LaTeX export
+@cindex header, for @LaTeX{} files
+@cindex sectioning structure, for @LaTeX{} export
By default, the @LaTeX{} output uses the class @code{article}.
@@ -10204,11 +10548,11 @@ By default, the @LaTeX{} output uses the class @code{article}.
@vindex org-export-latex-classes
@vindex org-export-latex-default-packages-alist
@vindex org-export-latex-packages-alist
-@cindex #+LATEX_HEADER
-@cindex #+LATEX_CLASS
-@cindex #+LATEX_CLASS_OPTIONS
-@cindex property, LATEX_CLASS
-@cindex property, LATEX_CLASS_OPTIONS
+@cindex #+LaTeX_HEADER
+@cindex #+LaTeX_CLASS
+@cindex #+LaTeX_CLASS_OPTIONS
+@cindex property, LaTeX_CLASS
+@cindex property, LaTeX_CLASS_OPTIONS
You can change this globally by setting a different value for
@code{org-export-latex-default-class} or locally by adding an option like
@code{#+LaTeX_CLASS: myclass} in your file, or with a @code{:LaTeX_CLASS:}
@@ -10218,16 +10562,27 @@ defines a header template for each class@footnote{Into which the values of
@code{org-export-latex-default-packages-alist} and
@code{org-export-latex-packages-alist} are spliced.}, and allows you to
define the sectioning structure for each class. You can also define your own
-classes there. @code{#+LaTeX_CLASS_OPTIONS} or a @code{LaTeX_CLASS_OPTIONS}
-property can specify the options for the @code{\documentclass} macro. You
-can also use @code{#+LATEX_HEADER: \usepackage@{xyz@}} to add lines to the
-header. See the docstring of @code{org-export-latex-classes} for more
-information.
+classes there. @code{#+LaTeX_CLASS_OPTIONS} or a @code{:LaTeX_CLASS_OPTIONS:}
+property can specify the options for the @code{\documentclass} macro. The
+options to documentclass have to be provided, as expected by @LaTeX{}, within
+square brackets. You can also use @code{#+LaTeX_HEADER: \usepackage@{xyz@}}
+to add lines to the header. See the docstring of
+@code{org-export-latex-classes} for more information. An example is shown
+below.
+
+@example
+#+LaTeX_CLASS: article
+#+LaTeX_CLASS_OPTIONS: [a4paper]
+#+LaTeX_HEADER: \usepackage@{xyz@}
+
+* Headline 1
+ some text
+@end example
-@node Quoting LaTeX code, Tables in LaTeX export, Header and sectioning, LaTeX and PDF export
+@node Quoting @LaTeX{} code, Tables in @LaTeX{} export, Header and sectioning, @LaTeX{} and PDF export
@subsection Quoting @LaTeX{} code
-Embedded @LaTeX{} as described in @ref{Embedded LaTeX}, will be correctly
+Embedded @LaTeX{} as described in @ref{Embedded @LaTeX{}}, will be correctly
inserted into the @LaTeX{} file. This includes simple macros like
@samp{\ref@{LABEL@}} to create a cross reference to a figure. Furthermore,
you can add special code that should only be present in @LaTeX{} export with
@@ -10236,7 +10591,7 @@ the following constructs:
@cindex #+LaTeX
@cindex #+BEGIN_LaTeX
@example
-#+LaTeX: Literal LaTeX code for export
+#+LaTeX: Literal @LaTeX{} code for export
@end example
@noindent or
@@ -10249,7 +10604,7 @@ All lines between these markers are exported literally
@end example
-@node Tables in LaTeX export, Images in LaTeX export, Quoting LaTeX code, LaTeX and PDF export
+@node Tables in @LaTeX{} export, Images in @LaTeX{} export, Quoting @LaTeX{} code, @LaTeX{} and PDF export
@subsection Tables in @LaTeX{} export
@cindex tables, in @LaTeX{} export
@@ -10286,7 +10641,7 @@ or to specify a multicolumn table with @code{tabulary}
| ..... | ..... |
@end example
-@node Images in LaTeX export, Beamer class export, Tables in LaTeX export, LaTeX and PDF export
+@node Images in @LaTeX{} export, Beamer class export, Tables in @LaTeX{} export, @LaTeX{} and PDF export
@subsection Images in @LaTeX{} export
@cindex images, inline in @LaTeX{}
@cindex inlining images in @LaTeX{}
@@ -10306,9 +10661,7 @@ add something like @samp{placement=[h!]} to the attributes. It is to be noted
this option can be used with tables as well@footnote{One can also take
advantage of this option to pass other, unrelated options into the figure or
table environment. For an example see the section ``Exporting org files'' in
-@url{http://orgmode.org/worg/org-hacks.html}}. For example the
-@code{#+ATTR_LaTeX:} line below is exported as the @code{figure} environment
-below it.
+@url{http://orgmode.org/worg/org-hacks.html}}.
If you would like to let text flow around the image, add the word @samp{wrap}
to the @code{#+ATTR_LaTeX:} line, which will make the figure occupy the left
@@ -10337,14 +10690,14 @@ will export the image wrapped in a @code{figure*} environment.
If you need references to a label created in this way, write
@samp{\ref@{fig:SED-HR4049@}} just like in @LaTeX{}.
-@node Beamer class export, , Images in LaTeX export, LaTeX and PDF export
+@node Beamer class export, , Images in @LaTeX{} export, @LaTeX{} and PDF export
@subsection Beamer class export
-The LaTeX class @file{beamer} allows production of high quality presentations
-using LaTeX and pdf processing. Org-mode has special support for turning an
-Org-mode file or tree into a @file{beamer} presentation.
+The @LaTeX{} class @file{beamer} allows production of high quality presentations
+using @LaTeX{} and pdf processing. Org mode has special support for turning an
+Org mode file or tree into a @file{beamer} presentation.
-When the LaTeX class for the current buffer (as set with @code{#+LaTeX_CLASS:
+When the @LaTeX{} class for the current buffer (as set with @code{#+LaTeX_CLASS:
beamer}) or subtree (set with a @code{LaTeX_CLASS} property) is
@code{beamer}, a special export mode will turn the file or tree into a beamer
presentation. Any tree with not-too-deep level nesting should in principle be
@@ -10395,7 +10748,7 @@ transitions.
Frames will automatically receive a @code{fragile} option if they contain
source code that uses the verbatim environment. Special @file{beamer}
specific code can be inserted using @code{#+BEAMER:} and
-@code{#+BEGIN_beamer...#+end_beamer} constructs, similar to other export
+@code{#+BEGIN_BEAMER...#+END_BEAMER} constructs, similar to other export
backends, but with the difference that @code{#+LaTeX:} stuff will be included
in the presentation as well.
@@ -10464,7 +10817,7 @@ Here is a simple example Org document that is intended for beamer export.
For more information, see the documentation on Worg.
-@node DocBook export, OpenDocumentText export, LaTeX and PDF export, Exporting
+@node DocBook export, OpenDocument Text export, @LaTeX{} and PDF export, Exporting
@section DocBook export
@cindex DocBook export
@cindex PDF export
@@ -10495,7 +10848,7 @@ Currently DocBook exporter only supports DocBook V5.0.
@table @kbd
@orgcmd{C-c C-e D,org-export-as-docbook}
@cindex property EXPORT_FILE_NAME
-Export as DocBook file. For an Org file, @file{myfile.org}, the DocBook XML
+Export as a DocBook file. For an Org file, @file{myfile.org}, the DocBook XML
file will be @file{myfile.xml}. The file will be overwritten without
warning. If there is an active region@footnote{This requires
@code{transient-mark-mode} to be turned on}, only the region will be
@@ -10504,12 +10857,12 @@ current subtree, use @kbd{C-c @@}.}, the tree head will become the document
title. If the tree head entry has, or inherits, an @code{EXPORT_FILE_NAME}
property, that name will be used for the export.
@orgcmd{C-c C-e V,org-export-as-docbook-pdf-and-open}
-Export as DocBook file, process to PDF, then open the resulting PDF file.
+Export as a DocBook file, process to PDF, then open the resulting PDF file.
@vindex org-export-docbook-xslt-proc-command
@vindex org-export-docbook-xsl-fo-proc-command
-Note that, in order to produce PDF output based on exported DocBook file, you
-need to have XSLT processor and XSL-FO processor software installed on your
+Note that, in order to produce PDF output based on an exported DocBook file,
+you need to have XSLT processor and XSL-FO processor software installed on your
system. Check variables @code{org-export-docbook-xslt-proc-command} and
@code{org-export-docbook-xsl-fo-proc-command}.
@@ -10620,7 +10973,7 @@ set:
@cindex #+LABEL
@cindex #+ATTR_DOCBOOK
@example
-#+CAPTION: The logo of Org-mode
+#+CAPTION: The logo of Org mode
#+LABEL: unicorn-svg
#+ATTR_DOCBOOK: scalefit="1" width="100%" depth="100%"
[[./img/org-mode-unicorn.svg]]
@@ -10663,39 +11016,48 @@ special characters included in XHTML entities:
@c begin opendocument
-@node OpenDocumentText export, TaskJuggler export, DocBook export, Exporting
-@section OpenDocumentText export
-@cindex OpenDocumentText export
+@node OpenDocument Text export, TaskJuggler export, DocBook export, Exporting
+@section OpenDocument Text export
@cindex K, Jambunathan
-
-Org-mode 7.6 supports export to OpenDocumentText format using
-@file{org-odt.el} module contributed by Jambunathan K. This module can be
-enabled in one of the following ways based on your mode of installation.
-
-@enumerate
-@item
-If you have downloaded the Org from the Web, either as a distribution
-@file{.zip} or @file{.tar} file, or as a Git archive, enable the @code{odt}
-option in variable @code{org-modules}.
-@item
-If you are using Org that comes bundled with Emacs, then you can install the
-OpenDocumentText exporter using the package manager. To do this, customize
-the variable @code{package-archives} to include
-@uref{http://orgmode.org/pkg/releases/} as one of the package archives.
-@end enumerate
+@cindex ODT
+@cindex OpenDocument
+@cindex export, OpenDocument
+@cindex LibreOffice
+@cindex org-odt.el
+@cindex org-modules
+
+Org Mode@footnote{Versions 7.8 or later} supports export to OpenDocument Text
+(ODT) format using the @file{org-odt.el} module. Documents created
+by this exporter use the @cite{OpenDocument-v1.2
+specification}@footnote{@url{http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html,
+Open Document Format for Office Applications (OpenDocument) Version 1.2}} and
+are compatible with LibreOffice 3.4.
@menu
-* OpenDocumentText export commands::How to invoke OpenDocumentText export
-* Applying Custom Styles:: How to apply custom styles to the output
-* Converting to Other formats:: How to convert to formats like doc, docx etc
-* Links in OpenDocumentText export:: How links will be interpreted and formatted
-* Tables in OpenDocumentText export:: Tables are exported as HTML tables
-* Images in OpenDocumentText export:: How to insert figures into DocBook output
-* Additional Documentation:: Where to find more information
+* Pre-requisites for ODT export:: What packages ODT exporter relies on
+* ODT export commands:: How to invoke ODT export
+* Extending ODT export:: How to produce @samp{doc}, @samp{pdf} files
+* Applying custom styles:: How to apply custom styles to the output
+* Links in ODT export:: How links will be interpreted and formatted
+* Tables in ODT export:: How Tables are exported
+* Images in ODT export:: How to insert images
+* Math formatting in ODT export:: How @LaTeX{} fragments are formatted
+* Labels and captions in ODT export:: How captions are rendered
+* Literal examples in ODT export:: How source and example blocks are formatted
+* Advanced topics in ODT export:: Read this if you are a power user
@end menu
-@node OpenDocumentText export commands, Applying Custom Styles, OpenDocumentText export, OpenDocumentText export
-@subsection OpenDocumentText export commands
+@node Pre-requisites for ODT export, ODT export commands, OpenDocument Text export, OpenDocument Text export
+@subsection Pre-requisites for ODT export
+@cindex zip
+The ODT exporter relies on the @file{zip} program to create the final
+output. Check the availability of this program before proceeding further.
+
+@node ODT export commands, Extending ODT export, Pre-requisites for ODT export, OpenDocument Text export
+@subsection ODT export commands
+
+@subsubheading Exporting to ODT
+@anchor{x-export-to-odt}
@cindex region, active
@cindex active region
@@ -10703,113 +11065,873 @@ the variable @code{package-archives} to include
@table @kbd
@orgcmd{C-c C-e o,org-export-as-odt}
@cindex property EXPORT_FILE_NAME
-Export as OpenDocumentText file. For an Org file, @file{myfile.org}, the
-OpenDocumentText file will be @file{myfile.odt}. The file will be
-overwritten without warning. If there is an active region@footnote{This
-requires @code{transient-mark-mode} to be turned on}, only the region will be
-exported. If the selected region is a single tree@footnote{To select the
-current subtree, use @kbd{C-c @@}.}, the tree head will become the document
-title. If the tree head entry has, or inherits, an @code{EXPORT_FILE_NAME}
-property, that name will be used for the export.
+
+Export as OpenDocument Text file.
+
+@vindex org-export-odt-preferred-output-format
+If @code{org-export-odt-preferred-output-format} is specified, automatically
+convert the exported file to that format. @xref{x-export-to-other-formats, ,
+Automatically exporting to other formats}.
+
+For an Org file @file{myfile.org}, the ODT file will be
+@file{myfile.odt}. The file will be overwritten without warning. If there
+is an active region,@footnote{This requires @code{transient-mark-mode} to be
+turned on} only the region will be exported. If the selected region is a
+single tree,@footnote{To select the current subtree, use @kbd{C-c @@}} the
+tree head will become the document title. If the tree head entry has, or
+inherits, an @code{EXPORT_FILE_NAME} property, that name will be used for the
+export.
+
@orgcmd{C-c C-e O,org-export-as-odt-and-open}
-Export as OpenDocumentText file and open the resulting file.
+Export as an OpenDocument Text file and open the resulting file.
+
+@vindex org-export-odt-preferred-output-format
+If @code{org-export-odt-preferred-output-format} is specified, open the
+converted file instead. @xref{x-export-to-other-formats, , Automatically
+exporting to other formats}.
+@end table
+
+@node Extending ODT export, Applying custom styles, ODT export commands, OpenDocument Text export
+@subsection Extending ODT export
+
+The ODT exporter can interface with a variety of document
+converters and supports popular converters out of the box. As a result, you
+can use it to export to formats like @samp{doc} or convert a document from
+one format (say @samp{csv}) to another format (say @samp{ods} or @samp{xls}).
+
+@cindex @file{unoconv}
+@cindex LibreOffice
+If you have a working installation of LibreOffice, a document converter is
+pre-configured for you and you can use it right away. If you would like to
+use @file{unoconv} as your preferred converter, customize the variable
+@code{org-export-odt-convert-process} to point to @code{unoconv}. You can
+also use your own favorite converter or tweak the default settings of the
+@file{LibreOffice} and @samp{unoconv} converters. @xref{Configuring a
+document converter}.
+
+@subsubsection Automatically exporting to other formats
+@anchor{x-export-to-other-formats}
+
+@vindex org-export-odt-preferred-output-format
+Very often, you will find yourself exporting to ODT format, only to
+immediately save the exported document to other formats like @samp{doc},
+@samp{docx}, @samp{rtf}, @samp{pdf} etc. In such cases, you can specify your
+preferred output format by customizing the variable
+@code{org-export-odt-preferred-output-format}. This way, the export commands
+(@pxref{x-export-to-odt,,Exporting to ODT}) can be extended to export to a
+format that is of immediate interest to you.
+
+@subsubsection Converting between document formats
+@anchor{x-convert-to-other-formats}
+
+There are many document converters in the wild which support conversion to
+and from various file formats, including, but not limited to the
+ODT format. LibreOffice converter, mentioned above, is one such
+converter. Once a converter is configured, you can interact with it using
+the following command.
+
+@vindex org-export-odt-convert
+@table @kbd
+
+@item M-x org-export-odt-convert
+Convert an existing document from one format to another. With a prefix
+argument, also open the newly produced file.
@end table
-@node Applying Custom Styles, Converting to Other formats, OpenDocumentText export commands, OpenDocumentText export
-@subsection Applying Custom Styles
+@node Applying custom styles, Links in ODT export, Extending ODT export, OpenDocument Text export
+@subsection Applying custom styles
@cindex styles, custom
@cindex template, custom
-@vindex org-export-odt-styles-file
+The ODT exporter ships with a set of OpenDocument styles
+(@pxref{Working with OpenDocument style files}) that ensure a well-formatted
+output. These factory styles, however, may not cater to your specific
+tastes. To customize the output, you can either modify the above styles
+files directly, or generate the required styles using an application like
+LibreOffice. The latter method is suitable for expert and non-expert
+users alike, and is described here.
-OpenDocumentExporter ships with a custom @file{styles.xml} for formatting of
-the exported file. To customize the output to suit your needs you can use
-one of the following methods:
+@subsubsection Applying custom styles - the easy way
@enumerate
@item
-Customize the variable @code{org-export-odt-styles-file} to point to either a
-@file{styles.xml} file, a OpenDocument Text Template file @code{.ott} or a
-combination of Text or Template Document together with a set of member files.
-Use the first two options if the styles.xml has no references to additional
-set of files and use the last option if the @file{styles.xml} references
-additional files like header and footer images.
+Create a sample @file{example.org} file with the below settings and export it
+to ODT format.
+
+@example
+#+OPTIONS: H:10 num:t
+@end example
+
+@item
+Open the above @file{example.odt} using LibreOffice. Use the @file{Stylist}
+to locate the target styles - these typically have the @samp{Org} prefix -
+and modify those to your taste. Save the modified file either as an
+OpenDocument Text (@file{.odt}) or OpenDocument Template (@file{.ott}) file.
+
@item
-Use an external tool like unoconv to apply custom templates.
+@cindex #+ODT_STYLES_FILE
+@vindex org-export-odt-styles-file
+Customize the variable @code{org-export-odt-styles-file} and point it to the
+newly created file. For additional configuration options
+@pxref{x-overriding-factory-styles,,Overriding factory styles}.
+
+If you would like to choose a style on a per-file basis, you can use the
+@code{#+ODT_STYLES_FILE} option. A typical setting will look like
+
+@example
+#+ODT_STYLES_FILE: "/path/to/example.ott"
+@end example
+
+or
+
+@example
+#+ODT_STYLES_FILE: ("/path/to/file.ott" ("styles.xml" "image/hdr.png"))
+@end example
+
@end enumerate
-For best results, it is necessary that the style names used by
-OpenDocumentText exporter match that used in the @file{styles.xml}.
+@subsubsection Using third-party styles and templates
-@node Converting to Other formats, Links in OpenDocumentText export, Applying Custom Styles, OpenDocumentText export
-@subsection Converting to Other formats
+You can use third-party styles and templates for customizing your output.
+This will produce the desired output only if the template provides all
+style names that the @samp{ODT} exporter relies on. Unless this condition is
+met, the output is going to be less than satisfactory. So it is highly
+recommended that you only work with templates that are directly derived from
+the factory settings.
-@cindex convert
-@cindex doc, docx
+@node Links in ODT export, Tables in ODT export, Applying custom styles, OpenDocument Text export
+@subsection Links in ODT export
+@cindex tables, in DocBook export
-@vindex org-export-odt-styles-file
+ODT exporter creates native cross-references for internal links. It creates
+Internet-style links for all other links.
+
+A link with no description and destined to a regular (un-itemized) outline
+heading is replaced with a cross-reference and section number of the heading.
+
+A @samp{\ref@{label@}}-style reference to an image, table etc. is replaced
+with a cross-reference and sequence number of the labeled entity.
+@xref{Labels and captions in ODT export}.
+
+@node Tables in ODT export, Images in ODT export, Links in ODT export, OpenDocument Text export
+@subsection Tables in ODT export
+@cindex tables, in DocBook export
+
+Export of native Org mode tables (@pxref{Tables}) and simple @file{table.el}
+tables is supported. However, export of complex @file{table.el} tables -
+tables that have column or row spans - is not supported. Such tables are
+stripped from the exported document.
+
+By default, a table is exported with top and bottom frames and with rules
+separating row and column groups (@pxref{Column groups}). Furthermore, all
+tables are typeset to occupy the same width. If the table specifies
+alignment and relative width for its columns (@pxref{Column width and
+alignment}) then these are honored on export.@footnote{The column widths are
+interpreted as weighted ratios with the default weight being 1}
+
+@cindex #+ATTR_ODT
+You can control the width of the table by specifying @code{:rel-width}
+property using an @code{#+ATTR_ODT} line.
+
+For example, consider the following table which makes use of all the rules
+mentioned above.
+
+@example
+#+ATTR_ODT: :rel-width 50
+| Area/Month | Jan | Feb | Mar | Sum |
+|---------------+-------+-------+-------+-------|
+| / | < | | | < |
+| <l13> | <r5> | <r5> | <r5> | <r6> |
+| North America | 1 | 21 | 926 | 948 |
+| Middle East | 6 | 75 | 844 | 925 |
+| Asia Pacific | 9 | 27 | 790 | 826 |
+|---------------+-------+-------+-------+-------|
+| Sum | 16 | 123 | 2560 | 2699 |
+@end example
+
+On export, the table will occupy 50% of text area. The columns will be sized
+(roughly) in the ratio of 13:5:5:5:6. The first column will be left-aligned
+and rest of the columns will be right-aligned. There will be vertical rules
+after separating the header and last columns from other columns. There will
+be horizontal rules separating the header and last rows from other rows.
+
+If you are not satisfied with the above formatting options, you can create
+custom table styles and associate them with a table using the
+@code{#+ATTR_ODT} line. @xref{Customizing tables in ODT export}.
+
+@node Images in ODT export, Math formatting in ODT export, Tables in ODT export, OpenDocument Text export
+@subsection Images in ODT export
+@cindex images, embedding in ODT
+@cindex embedding images in ODT
+
+@subsubheading Embedding images
+You can embed images within the exported document by providing a link to the
+desired image file with no link description. For example, to embed
+@samp{img.png} do either of the following:
+
+@example
+[[file:img.png]]
+@end example
+
+@example
+[[./img.png]]
+@end example
+
+@subsubheading Embedding clickable images
+You can create clickable images by providing a link whose description is a
+link to an image file. For example, to embed a image
+@file{org-mode-unicorn.png} which when clicked jumps to
+@uref{http://Orgmode.org} website, do the following
+
+@example
+[[http://orgmode.org][./org-mode-unicorn.png]]
+@end example
+
+@subsubheading Sizing and scaling of embedded images
-Often times there is a need to convert OpenDocumentText files to other
-formats like doc, docx or pdf. You can accomplish this by one of the
-following methods:
+@cindex #+ATTR_ODT
+You can control the size and scale of the embedded images using the
+@code{#+ATTR_ODT} attribute.
+
+@cindex identify, ImageMagick
+@vindex org-export-odt-pixels-per-inch
+The exporter specifies the desired size of the image in the final document in
+units of centimeters. In order to scale the embedded images, the exporter
+queries for pixel dimensions of the images using one of a) ImageMagick's
+@file{identify} program or b) Emacs `create-image' and `image-size'
+APIs.@footnote{Use of @file{ImageMagick} is only desirable. However, if you
+routinely produce documents that have large images or you export your Org
+files that has images using a Emacs batch script, then the use of
+@file{ImageMagick} is mandatory.} The pixel dimensions are subsequently
+converted in to units of centimeters using
+@code{org-export-odt-pixels-per-inch}. The default value of this variable is
+set to @code{display-pixels-per-inch}. You can tweak this variable to
+achieve the best results.
+
+The examples below illustrate the various possibilities.
+
+@table @asis
+@item Explicitly size the image
+To embed @file{img.png} as a 10 cm x 10 cm image, do the following:
+
+@example
+#+ATTR_ODT: :width 10 :height 10
+[[./img.png]]
+@end example
+
+@item Scale the image
+To embed @file{img.png} at half its size, do the following:
+
+@example
+#+ATTR_ODT: :scale 0.5
+[[./img.png]]
+@end example
+
+@item Scale the image to a specific width
+To embed @file{img.png} with a width of 10 cm while retaining the original
+height:width ratio, do the following:
+
+@example
+#+ATTR_ODT: :width 10
+[[./img.png]]
+@end example
+
+@item Scale the image to a specific height
+To embed @file{img.png} with a height of 10 cm while retaining the original
+height:width ratio, do the following
+
+@example
+#+ATTR_ODT: :height 10
+[[./img.png]]
+@end example
+@end table
+
+@subsubheading Anchoring of images
+
+@cindex #+ATTR_ODT
+You can control the manner in which an image is anchored by setting the
+@code{:anchor} property of it's @code{#+ATTR_ODT} line. You can specify one
+of the the following three values for the @code{:anchor} property -
+@samp{"as-char"}, @samp{"paragraph"} and @samp{"page"}.
+
+To create an image that is anchored to a page, do the following:
+@example
+#+ATTR_ODT: :anchor "page"
+[[./img.png]]
+@end example
+
+@node Math formatting in ODT export, Labels and captions in ODT export, Images in ODT export, OpenDocument Text export
+@subsection Math formatting in ODT export
+
+The ODT exporter has special support for handling math.
+
+@menu
+* Working with @LaTeX{} math snippets:: How to embed @LaTeX{} math fragments
+* Working with MathML or OpenDocument formula files:: How to embed equations in native format
+@end menu
+
+@node Working with @LaTeX{} math snippets, Working with MathML or OpenDocument formula files, Math formatting in ODT export, Math formatting in ODT export
+@subsubsection Working with @LaTeX{} math snippets
+
+@LaTeX{} math snippets (@pxref{@LaTeX{} fragments}) can be embedded in the ODT
+document in one of the following ways:
+
+@cindex MathML
+@enumerate
+@item MathML
+
+This option is activated on a per-file basis with
+
+@example
+#+OPTIONS: LaTeX:t
+@end example
+
+With this option, @LaTeX{} fragments are first converted into MathML
+fragments using an external @LaTeX{}-to-MathML converter program. The
+resulting MathML fragments are then embedded as an OpenDocument Formula in
+the exported document.
+
+@vindex org-latex-to-mathml-convert-command
+@vindex org-latex-to-mathml-jar-file
+
+You can specify the @LaTeX{}-to-MathML converter by customizing the variables
+@code{org-latex-to-mathml-convert-command} and
+@code{org-latex-to-mathml-jar-file}.
+
+If you prefer to use @file{MathToWeb}@footnote{See
+@uref{http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl, MathToWeb}} as your
+converter, you can configure the above variables as shown below.
+
+@lisp
+(setq org-latex-to-mathml-convert-command
+ "java -jar %j -unicode -force -df %o %I"
+ org-latex-to-mathml-jar-file
+ "/path/to/mathtoweb.jar")
+@end lisp
+
+You can use the following commands to quickly verify the reliability of
+the @LaTeX{}-to-MathML converter.
@table @kbd
-@item M-x org-lparse
-Export the outline first to one of the native formats (like OpenDocumentText)
-and immediately post-process it to other formats using an external converter.
-@item M-x org-lparse-convert
-Export an existing document to other formats using an external converter.
+@item M-x org-export-as-odf
+Convert a @LaTeX{} math snippet to an OpenDocument formula (@file{.odf}) file.
+
+@item M-x org-export-as-odf-and-open
+Convert a @LaTeX{} math snippet to an OpenDocument formula (@file{.odf}) file
+and open the formula file with the system-registered application.
@end table
-You can choose the converter used for conversion by customizing the variable
-@code{org-lparse-convert-process}.
+@cindex dvipng
+@item PNG images
-@node Links in OpenDocumentText export, Tables in OpenDocumentText export, Converting to Other formats, OpenDocumentText export
-@subsection Links in OpenDocumentText export
-@cindex tables, in DocBook export
+This option is activated on a per-file basis with
-OpenDocumentExporter creates cross-references (aka bookmarks) for links that
-are destined locally. It creates internet style links for all other links.
+@example
+#+OPTIONS: LaTeX:dvipng
+@end example
-@node Tables in OpenDocumentText export, Images in OpenDocumentText export, Links in OpenDocumentText export, OpenDocumentText export
-@subsection Tables in OpenDocumentText export
-@cindex tables, in DocBook export
+With this option, @LaTeX{} fragments are processed into PNG images and the
+resulting images are embedded in the exported document. This method requires
+that the @file{dvipng} program be available on your system.
+@end enumerate
+
+@node Working with MathML or OpenDocument formula files, , Working with @LaTeX{} math snippets, Math formatting in ODT export
+@subsubsection Working with MathML or OpenDocument formula files
+
+For various reasons, you may find embedding @LaTeX{} math snippets in an
+ODT document less than reliable. In that case, you can embed a
+math equation by linking to its MathML (@file{.mml}) source or its
+OpenDocument formula (@file{.odf}) file as shown below:
+
+@example
+[[./equation.mml]]
+@end example
+
+or
+
+@example
+[[./equation.odf]]
+@end example
+
+@node Labels and captions in ODT export, Literal examples in ODT export, Math formatting in ODT export, OpenDocument Text export
+@subsection Labels and captions in ODT export
+
+You can label and caption various category of objects - an inline image, a
+table, a @LaTeX{} fragment or a Math formula - using @code{#+LABEL} and
+@code{#+CAPTION} lines. @xref{Images and tables}. ODT exporter enumerates
+each labeled or captioned object of a given category separately. As a
+result, each such object is assigned a sequence number based on order of it's
+appearance in the Org file.
+
+In the exported document, a user-provided caption is augmented with the
+category and sequence number. Consider the following inline image in an Org
+file.
+
+@example
+#+CAPTION: Bell curve
+#+LABEL: fig:SED-HR4049
+[[./img/a.png]]
+@end example
+
+It could be rendered as shown below in the exported document.
+
+@example
+Figure 2: Bell curve
+@end example
+
+@vindex org-export-odt-category-strings
+You can modify the category component of the caption by customizing the
+variable @code{org-export-odt-category-strings}. For example, to tag all
+embedded images with the string @samp{Illustration} (instead of the default
+@samp{Figure}) use the following setting.
+
+@lisp
+(setq org-export-odt-category-strings
+ '(("en" "Table" "Illustration" "Equation" "Equation")))
+@end lisp
+
+With this, previous image will be captioned as below in the exported
+document.
+
+@example
+Illustration 2: Bell curve
+@end example
+
+@node Literal examples in ODT export, Advanced topics in ODT export, Labels and captions in ODT export, OpenDocument Text export
+@subsection Literal examples in ODT export
+
+Export of literal examples (@pxref{Literal examples}) with full fontification
+is supported. Internally, the exporter relies on @file{htmlfontify.el} to
+generate all style definitions needed for a fancy listing.@footnote{Your
+@file{htmlfontify.el} library must at least be at Emacs 24.1 levels for
+fontification to be turned on.} The auto-generated styles have @samp{OrgSrc}
+as prefix and inherit their color from the faces used by Emacs
+@code{font-lock} library for the source language.
+
+@vindex org-export-odt-fontify-srcblocks
+If you prefer to use your own custom styles for fontification, you can do so
+by customizing the variable
+@code{org-export-odt-create-custom-styles-for-srcblocks}.
+
+@vindex org-export-odt-create-custom-styles-for-srcblocks
+You can turn off fontification of literal examples by customizing the
+variable @code{org-export-odt-fontify-srcblocks}.
+
+@node Advanced topics in ODT export, , Literal examples in ODT export, OpenDocument Text export
+@subsection Advanced topics in ODT export
+
+If you rely heavily on ODT export, you may want to exploit the full
+set of features that the exporter offers. This section describes features
+that would be of interest to power users.
+
+@menu
+* Configuring a document converter:: How to register a document converter
+* Working with OpenDocument style files:: Explore the internals
+* Creating one-off styles:: How to produce custom highlighting etc
+* Customizing tables in ODT export:: How to define and use Table templates
+* Validating OpenDocument XML:: How to debug corrupt OpenDocument files
+@end menu
+
+@node Configuring a document converter, Working with OpenDocument style files, Advanced topics in ODT export, Advanced topics in ODT export
+@subsubsection Configuring a document converter
+@cindex convert
+@cindex doc, docx, rtf
+@cindex converter
+
+The ODT exporter can work with popular converters with little or no
+extra configuration from your side. @xref{Extending ODT export}.
+If you are using a converter that is not supported by default or if you would
+like to tweak the default converter settings, proceed as below.
+
+@enumerate
+@item Register the converter
+
+@vindex org-export-odt-convert-processes
+Name your converter and add it to the list of known converters by customizing
+the variable @code{org-export-odt-convert-processes}. Also specify how the
+converter can be invoked via command-line to effect the conversion.
+
+@item Configure its capabilities
+
+@vindex org-export-odt-convert-capabilities
+@anchor{x-odt-converter-capabilities}
+Specify the set of formats the converter can handle by customizing the
+variable @code{org-export-odt-convert-capabilities}. Use the default value
+for this variable as a guide for configuring your converter. As suggested by
+the default setting, you can specify the full set of formats supported by the
+converter and not limit yourself to specifying formats that are related to
+just the OpenDocument Text format.
+
+@item Choose the converter
+
+@vindex org-export-odt-convert-process
+Select the newly added converter as the preferred one by customizing the
+variable @code{org-export-odt-convert-process}.
+@end enumerate
+
+@node Working with OpenDocument style files, Creating one-off styles, Configuring a document converter, Advanced topics in ODT export
+@subsubsection Working with OpenDocument style files
+@cindex styles, custom
+@cindex template, custom
+
+This section explores the internals of the ODT exporter and the
+means by which it produces styled documents. Read this section if you are
+interested in exploring the automatic and custom OpenDocument styles used by
+the exporter.
+
+@anchor{x-factory-styles}
+@subsubheading Factory styles
+
+The ODT exporter relies on two files for generating its output.
+These files are bundled with the distribution under the directory pointed to
+by the variable @code{org-odt-styles-dir}. The two files are:
+
+@itemize
+@anchor{x-orgodtstyles-xml}
+@item
+@file{OrgOdtStyles.xml}
+
+This file contributes to the @file{styles.xml} file of the final @samp{ODT}
+document. This file gets modified for the following purposes:
+@enumerate
+
+@item
+To control outline numbering based on user settings.
+
+@item
+To add styles generated by @file{htmlfontify.el} for fontification of code
+blocks.
+@end enumerate
+
+@anchor{x-orgodtcontenttemplate-xml}
+@item
+@file{OrgOdtContentTemplate.xml}
+
+This file contributes to the @file{content.xml} file of the final @samp{ODT}
+document. The contents of the Org outline are inserted between the
+@samp{<office:text>}@dots{}@samp{</office:text>} elements of this file.
+
+Apart from serving as a template file for the final @file{content.xml}, the
+file serves the following purposes:
+@enumerate
+
+@item
+It contains automatic styles for formatting of tables which are referenced by
+the exporter.
+
+@item
+It contains @samp{<text:sequence-decl>}@dots{}@samp{</text:sequence-decl>}
+elements that control how various entities - tables, images, equations etc -
+are numbered.
+@end enumerate
+@end itemize
+
+@anchor{x-overriding-factory-styles}
+@subsubheading Overriding factory styles
+The following two variables control the location from which the ODT
+exporter picks up the custom styles and content template files. You can
+customize these variables to override the factory styles used by the
+exporter.
+
+@itemize
+@anchor{x-org-export-odt-styles-file}
+@item
+@code{org-export-odt-styles-file}
+
+Use this variable to specify the @file{styles.xml} that will be used in the
+final output. You can specify one of the following values:
+
+@enumerate
+@item A @file{styles.xml} file
+
+Use this file instead of the default @file{styles.xml}
+
+@item A @file{.odt} or @file{.ott} file
+
+Use the @file{styles.xml} contained in the specified OpenDocument Text or
+Template file
+
+@item A @file{.odt} or @file{.ott} file and a subset of files contained within them
+
+Use the @file{styles.xml} contained in the specified OpenDocument Text or
+Template file. Additionally extract the specified member files and embed
+those within the final @samp{ODT} document.
+
+Use this option if the @file{styles.xml} file references additional files
+like header and footer images.
+
+@item @code{nil}
+
+Use the default @file{styles.xml}
+@end enumerate
+
+@anchor{x-org-export-odt-content-template-file}
+@item
+@code{org-export-odt-content-template-file}
+
+Use this variable to specify the blank @file{content.xml} that will be used
+in the final output.
+@end itemize
+
+@node Creating one-off styles, Customizing tables in ODT export, Working with OpenDocument style files, Advanced topics in ODT export
+@subsubsection Creating one-off styles
+
+There are times when you would want one-off formatting in the exported
+document. You can achieve this by embedding raw OpenDocument XML in the Org
+file. The use of this feature is better illustrated with couple of examples.
+
+@enumerate
+@item Embedding ODT tags as part of regular text
+
+You can include simple OpenDocument tags by prefixing them with
+@samp{@@}. For example, to highlight a region of text do the following:
+
+@example
+@@<text:span text:style-name="Highlight">This is a
+highlighted text@@</text:span>. But this is a
+regular text.
+@end example
+
+@strong{Hint:} To see the above example in action, edit your
+@file{styles.xml} (@pxref{x-orgodtstyles-xml,,Factory styles}) and add a
+custom @samp{Highlight} style as shown below.
+
+@example
+<style:style style:name="Highlight" style:family="text">
+ <style:text-properties fo:background-color="#ff0000"/>
+</style:style>
+@end example
+
+@item Embedding a one-line OpenDocument XML
+
+You can add a simple OpenDocument one-liner using the @code{#+ODT:}
+directive. For example, to force a page break do the following:
+
+@example
+#+ODT: <text:p text:style-name="PageBreak"/>
+@end example
+
+@strong{Hint:} To see the above example in action, edit your
+@file{styles.xml} (@pxref{x-orgodtstyles-xml,,Factory styles}) and add a
+custom @samp{PageBreak} style as shown below.
+
+@example
+<style:style style:name="PageBreak" style:family="paragraph"
+ style:parent-style-name="Text_20_body">
+ <style:paragraph-properties fo:break-before="page"/>
+</style:style>
+@end example
+
+@item Embedding a block of OpenDocument XML
+
+You can add a large block of OpenDocument XML using the
+@code{#+BEGIN_ODT}@dots{}@code{#+END_ODT} construct.
+
+For example, to create a one-off paragraph that uses bold text, do the
+following:
+
+@example
+#+BEGIN_ODT
+<text:p text:style-name="Text_20_body_20_bold">
+This paragraph is specially formatted and uses bold text.
+</text:p>
+#+END_ODT
+@end example
+
+@end enumerate
+
+@node Customizing tables in ODT export, Validating OpenDocument XML, Creating one-off styles, Advanced topics in ODT export
+@subsubsection Customizing tables in ODT export
+@cindex tables, in ODT export
+
+@cindex #+ATTR_ODT
+You can override the default formatting of the table by specifying a custom
+table style with the @code{#+ATTR_ODT} line. For a discussion on default
+formatting of tables @pxref{Tables in ODT export}.
+
+This feature closely mimics the way table templates are defined in the
+OpenDocument-v1.2
+specification.@footnote{@url{http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html,
+OpenDocument-v1.2 Specification}}
+
+
+
+@subsubheading Custom table styles - an illustration
+
+To have a quick preview of this feature, install the below setting and export
+the table that follows.
+
+@lisp
+(setq org-export-odt-table-styles
+ (append org-export-odt-table-styles
+ '(("TableWithHeaderRowAndColumn" "Custom"
+ ((use-first-row-styles . t)
+ (use-first-column-styles . t)))
+ ("TableWithFirstRowandLastRow" "Custom"
+ ((use-first-row-styles . t)
+ (use-last-row-styles . t))))))
+@end lisp
+
+@example
+#+ATTR_ODT: :style "TableWithHeaderRowAndColumn"
+| Name | Phone | Age |
+| Peter | 1234 | 17 |
+| Anna | 4321 | 25 |
+@end example
+
+In the above example, you used a template named @samp{Custom} and installed
+two table styles with the names @samp{TableWithHeaderRowAndColumn} and
+@samp{TableWithFirstRowandLastRow}. (@strong{Important:} The OpenDocument
+styles needed for producing the above template have been pre-defined for you.
+These styles are available under the section marked @samp{Custom Table
+Template} in @file{OrgOdtContentTemplate.xml}
+(@pxref{x-orgodtcontenttemplate-xml,,Factory styles}). If you need
+additional templates you have to define these styles yourselves.
+
+@subsubheading Custom table styles - the nitty-gritty
+To use this feature proceed as follows:
+
+@enumerate
+@item
+Create a table template@footnote{See the @code{<table:table-template>}
+element of the OpenDocument-v1.2 specification}
+
+A table template is nothing but a set of @samp{table-cell} and
+@samp{paragraph} styles for each of the following table cell categories:
+
+@itemize @minus
+@item Body
+@item First column
+@item Last column
+@item First row
+@item Last row
+@item Even row
+@item Odd row
+@item Even column
+@item Odd Column
+@end itemize
+
+The names for the above styles must be chosen based on the name of the table
+template using a well-defined convention.
+
+The naming convention is better illustrated with an example. For a table
+template with the name @samp{Custom}, the needed style names are listed in
+the following table.
+
+@multitable {Table cell type} {CustomEvenColumnTableCell} {CustomEvenColumnTableParagraph}
+@headitem Table cell type
+@tab @code{table-cell} style
+@tab @code{paragraph} style
+@item
+@tab
+@tab
+@item Body
+@tab @samp{CustomTableCell}
+@tab @samp{CustomTableParagraph}
+@item First column
+@tab @samp{CustomFirstColumnTableCell}
+@tab @samp{CustomFirstColumnTableParagraph}
+@item Last column
+@tab @samp{CustomLastColumnTableCell}
+@tab @samp{CustomLastColumnTableParagraph}
+@item First row
+@tab @samp{CustomFirstRowTableCell}
+@tab @samp{CustomFirstRowTableParagraph}
+@item Last row
+@tab @samp{CustomLastRowTableCell}
+@tab @samp{CustomLastRowTableParagraph}
+@item Even row
+@tab @samp{CustomEvenRowTableCell}
+@tab @samp{CustomEvenRowTableParagraph}
+@item Odd row
+@tab @samp{CustomOddRowTableCell}
+@tab @samp{CustomOddRowTableParagraph}
+@item Even column
+@tab @samp{CustomEvenColumnTableCell}
+@tab @samp{CustomEvenColumnTableParagraph}
+@item Odd column
+@tab @samp{CustomOddColumnTableCell}
+@tab @samp{CustomOddColumnTableParagraph}
+@end multitable
-Export of @file{table.el} tables with row or column spanning is not
-supported. Such tables are stripped from the exported document.
+To create a table template with the name @samp{Custom}, define the above
+styles in the
+@code{<office:automatic-styles>}...@code{</office:automatic-styles>} element
+of the content template file (@pxref{x-orgodtcontenttemplate-xml,,Factory
+styles}).
-@node Images in OpenDocumentText export, Additional Documentation, Tables in OpenDocumentText export, OpenDocumentText export
-@subsection Images in OpenDocumentText export
-@cindex images, embedding in OpenDocumentText
-@cindex embedding images in OpenDocumentText
+@item
+Define a table style@footnote{See the attributes @code{table:template-name},
+@code{table:use-first-row-styles}, @code{table:use-last-row-styles},
+@code{table:use-first-column-styles}, @code{table:use-last-column-styles},
+@code{table:use-banding-rows-styles}, and
+@code{table:use-banding-column-styles} of the @code{<table:table>} element in
+the OpenDocument-v1.2 specification}
+
+@vindex org-export-odt-table-styles
+To define a table style, create an entry for the style in the variable
+@code{org-export-odt-table-styles} and specify the following:
+
+@itemize @minus
+@item the name of the table template created in step (1)
+@item the set of cell styles in that template that are to be activated
+@end itemize
+
+For example, the entry below defines two different table styles
+@samp{TableWithHeaderRowAndColumn} and @samp{TableWithFirstRowandLastRow}
+based on the same template @samp{Custom}. The styles achieve their intended
+effect by selectively activating the individual cell styles in that template.
+
+@lisp
+(setq org-export-odt-table-styles
+ (append org-export-odt-table-styles
+ '(("TableWithHeaderRowAndColumn" "Custom"
+ ((use-first-row-styles . t)
+ (use-first-column-styles . t)))
+ ("TableWithFirstRowandLastRow" "Custom"
+ ((use-first-row-styles . t)
+ (use-last-row-styles . t))))))
+@end lisp
-OpenDocumentText exporter can embed images within the exported document. To
-embed images, provide a link to the desired image file with no link
-description. For example, the following links @samp{[[file:img.jpg]]} or
-@samp{[[./img.jpg]]}, will result in embedding of @samp{img.jpg} in the
-exported file.
+@item
+Associate a table with the table style
+
+To do this, specify the table style created in step (2) as part of
+the @code{ATTR_ODT} line as shown below.
+
+@example
+#+ATTR_ODT: :style "TableWithHeaderRowAndColumn"
+| Name | Phone | Age |
+| Peter | 1234 | 17 |
+| Anna | 4321 | 25 |
+@end example
+@end enumerate
-The exporter can also embed scaled and explicitly sized images within the
-exported document. The markup of the scale and size specifications has not
-been standardized yet and is hence conveniently skipped in this document.
+@node Validating OpenDocument XML, , Customizing tables in ODT export, Advanced topics in ODT export
+@subsubsection Validating OpenDocument XML
-The exporter can also make an image the clickable part of a link. To create
-clickable images, provide a link whose description is a link to an image
-file. For example, the following link
-@samp{[[http://orgmode.org][./img.jpg]]}, will result in a clickable image
-that links to @uref{http://Orgmode.org} website.
+Occasionally, you will discover that the document created by the
+ODT exporter cannot be opened by your favorite application. One of
+the common reasons for this is that the @file{.odt} file is corrupt. In such
+cases, you may want to validate the document against the OpenDocument RELAX
+NG Compact Syntax (RNC) schema.
-@node Additional Documentation, , Images in OpenDocumentText export, OpenDocumentText export
-@subsection Additional documentation
+For de-compressing the @file{.odt} file@footnote{@file{.odt} files are
+nothing but @samp{zip} archives}: @inforef{File Archives,,emacs}. For
+general help with validation (and schema-sensitive editing) of XML files:
+@inforef{Introduction,,nxml-mode}.
-The OpenDocumentText exporter is still in development. For up to date
-information, please follow Org mailing list @email{emacs-orgmode@@gnu.org}
-closely.
+@vindex org-export-odt-schema-dir
+If you have ready access to OpenDocument @file{.rnc} files and the needed
+schema-locating rules in a single folder, you can customize the variable
+@code{org-export-odt-schema-dir} to point to that directory. The
+ODT exporter will take care of updating the
+@code{rng-schema-locating-files} for you.
@c end opendocument
-@node TaskJuggler export, Freemind export, OpenDocumentText export, Exporting
+@node TaskJuggler export, Freemind export, OpenDocument Text export, Exporting
@section TaskJuggler export
@cindex TaskJuggler export
@cindex Project management
@@ -10820,7 +11942,7 @@ resource assignments based on the project outline and the constraints that
you have provided.
The TaskJuggler exporter is a bit different from other exporters, such as the
-HTML and LaTeX exporters for example, in that it does not export all the
+@code{HTML} and @LaTeX{} exporters for example, in that it does not export all the
nodes of a document or strictly follow the order of the nodes in the
document.
@@ -10833,16 +11955,16 @@ all the nodes.
@table @kbd
@orgcmd{C-c C-e j,org-export-as-taskjuggler}
-Export as TaskJuggler file.
+Export as a TaskJuggler file.
@orgcmd{C-c C-e J,org-export-as-taskjuggler-and-open}
-Export as TaskJuggler file and then open the file with TaskJugglerUI.
+Export as a TaskJuggler file and then open the file with TaskJugglerUI.
@end table
@subsection Tasks
@vindex org-export-taskjuggler-project-tag
-Create your tasks as you usually do with Org-mode. Assign efforts to each
+Create your tasks as you usually do with Org mode. Assign efforts to each
task using properties (it is easiest to do this in the column view). You
should end up with something similar to the example by Peter Jones in
@url{http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org}.
@@ -10946,7 +12068,7 @@ The Freemind exporter was written by Lennart Borgman.
@table @kbd
@orgcmd{C-c C-e m,org-export-as-freemind}
-Export as Freemind mind map. For an Org file @file{myfile.org}, the Freemind
+Export as a Freemind mind map. For an Org file @file{myfile.org}, the Freemind
file will be @file{myfile.mm}.
@end table
@@ -10954,13 +12076,13 @@ file will be @file{myfile.mm}.
@section XOXO export
@cindex XOXO export
-Org-mode contains an exporter that produces XOXO-style output.
+Org mode contains an exporter that produces XOXO-style output.
Currently, this exporter only handles the general outline structure and
-does not interpret any additional Org-mode features.
+does not interpret any additional Org mode features.
@table @kbd
@orgcmd{C-c C-e x,org-export-as-xoxo}
-Export as XOXO file. For an Org file @file{myfile.org}, the XOXO file will be
+Export as an XOXO file. For an Org file @file{myfile.org}, the XOXO file will be
@file{myfile.html}.
@orgkey{C-c C-e v x}
Export only the visible part of the document.
@@ -10975,10 +12097,10 @@ Export only the visible part of the document.
@vindex org-icalendar-use-scheduled
@vindex org-icalendar-categories
@vindex org-icalendar-alarm-time
-Some people use Org-mode for keeping track of projects, but still prefer a
+Some people use Org mode for keeping track of projects, but still prefer a
standard calendar application for anniversaries and appointments. In this
case it can be useful to show deadlines and other time-stamped items in Org
-files in the calendar application. Org-mode can export calendar information
+files in the calendar application. Org mode can export calendar information
in the standard iCalendar format. If you also want to have TODO entries
included in the export, configure the variable
@code{org-icalendar-include-todo}. Plain timestamps are exported as VEVENT,
@@ -11422,7 +12544,7 @@ Defaults to @code{nil}.
@subsection Generating an index
@cindex index, in a publishing project
-Org-mode can generate an index across the files of a publishing project.
+Org mode can generate an index across the files of a publishing project.
@multitable @columnfractions 0.25 0.75
@item @code{:makeindex}
@@ -11431,7 +12553,7 @@ publish it as @file{theindex.html}.
@end multitable
The file will be created when first publishing a project with the
-@code{:makeindex} set. The file only contains a statement @code{#+include:
+@code{:makeindex} set. The file only contains a statement @code{#+INCLUDE:
"theindex.inc"}. You can then build around this include statement by adding
a title, style information, etc.
@@ -11442,7 +12564,7 @@ a title, style information, etc.
For those people already utilizing third party sync tools such as
@command{rsync} or @command{unison}, it might be preferable not to use the built in
-@i{remote} publishing facilities of Org-mode which rely heavily on
+@i{remote} publishing facilities of Org mode which rely heavily on
Tramp. Tramp, while very useful and powerful, tends not to be
so efficient for multiple file transfer and has been known to cause problems
under heavy usage.
@@ -11465,7 +12587,7 @@ Publishing to a local directory is also much faster than to a remote one, so
that you can afford more easily to republish entire projects. If you set
@code{org-publish-use-timestamps-flag} to @code{nil}, you gain the main
benefit of re-including any changed external files such as source example
-files you might include with @code{#+INCLUDE}. The timestamp mechanism in
+files you might include with @code{#+INCLUDE:}. The timestamp mechanism in
Org is not smart enough to detect if included files have been modified.
@node Sample configuration, Triggering publication, Uploading files, Publishing
@@ -11581,7 +12703,7 @@ This may be necessary in particular if files include other files via
@cindex Davison, Dan
@cindex source code, working with
-Source code can be included in Org-mode documents using a @samp{src} block,
+Source code can be included in Org mode documents using a @samp{src} block,
e.g.@:
@example
@@ -11592,26 +12714,26 @@ e.g.@:
#+END_SRC
@end example
-Org-mode provides a number of features for working with live source code,
+Org mode provides a number of features for working with live source code,
including editing of code blocks in their native major-mode, evaluation of
code blocks, converting code blocks into source files (known as @dfn{tangling}
in literate programming), and exporting code blocks and their
results in several formats. This functionality was contributed by Eric
Schulte and Dan Davison, and was originally named Org-babel.
-The following sections describe Org-mode's code block handling facilities.
+The following sections describe Org mode's code block handling facilities.
@menu
* Structure of code blocks:: Code block syntax described
* Editing source code:: Language major-mode editing
* Exporting code blocks:: Export contents and/or results
* Extracting source code:: Create pure source code files
-* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer
+* Evaluating code blocks:: Place results of evaluation in the Org mode buffer
* Library of Babel:: Use and contribute to a library of useful code blocks
* Languages:: List of supported code block languages
* Header arguments:: Configure code block functionality
* Results of evaluation:: How evaluation results are handled
-* Noweb reference syntax:: Literate programming in Org-mode
+* Noweb reference syntax:: Literate programming in Org mode
* Key bindings and useful functions:: Work quickly with code blocks
* Batch execution:: Call functions from the command line
@end menu
@@ -11623,18 +12745,26 @@ The following sections describe Org-mode's code block handling facilities.
@section Structure of code blocks
@cindex code block, structure
@cindex source code, block structure
+@cindex #+NAME
+@cindex #+BEGIN_SRC
-The structure of code blocks is as follows:
+Live code blocks can be specified with a @samp{src} block or
+inline.@footnote{Note that @samp{src} blocks may be inserted using Org mode's
+@ref{Easy Templates} system} The structure of a @samp{src} block is
@example
-#+srcname: <name>
-#+begin_src <language> <switches> <header arguments>
+#+NAME: <name>
+#+BEGIN_SRC <language> <switches> <header arguments>
<body>
-#+end_src
+#+END_SRC
@end example
-Switches and header arguments are optional. Code can also be embedded in text
-inline using
+The @code{#+NAME:} line is optional, and can be used to name the code
+block. Live code blocks require that a language be specified on the
+@code{#+BEGIN_SRC} line. Switches and header arguments are optional.
+@cindex source code, inline
+
+Live code blocks can also be specified inline using
@example
src_<language>@{<body>@}
@@ -11647,26 +12777,30 @@ src_<language>[<header arguments>]@{<body>@}
@end example
@table @code
-@item <name>
-This name is associated with the code block. This is similar to the
-@samp{#+tblname} lines that can be used to name tables in Org-mode files.
-Referencing the name of a code block makes it possible to evaluate the
-block from other places in the file, other files, or from Org-mode table
-formulas (see @ref{The spreadsheet}). Names are assumed to be unique by
-evaluation functions and the behavior of multiple blocks of the same name is
+@item <#+NAME: name>
+This line associates a name with the code block. This is similar to the
+@code{#+TBLNAME: NAME} lines that can be used to name tables in Org mode
+files. Referencing the name of a code block makes it possible to evaluate
+the block from other places in the file, from other files, or from Org mode
+table formulas (see @ref{The spreadsheet}). Names are assumed to be unique
+and the behavior of Org mode when two or more blocks share the same name is
undefined.
+@cindex #+NAME
@item <language>
-The language of the code in the block.
+The language of the code in the block (see @ref{Languages}).
+@cindex source code, language
@item <switches>
-Optional switches controlling exportation of the code block (see switches discussion in
+Optional switches control code block export (see the discussion of switches in
@ref{Literal examples})
+@cindex source code, switches
@item <header arguments>
Optional header arguments control many aspects of evaluation, export and
-tangling of code blocks. See the @ref{Header arguments}.
+tangling of code blocks (see @ref{Header arguments}).
Header arguments can also be set on a per-buffer or per-subtree
basis using properties.
+@item source code, header arguments
@item <body>
-The source code.
+Source code in the specified language.
@end table
@comment node-name, next, previous, up
@@ -11715,12 +12849,12 @@ variable @code{org-src-fontify-natively}.
@cindex code block, exporting
@cindex source code, exporting
-It is possible to export the @emph{contents} of code blocks, the
-@emph{results} of code block evaluation, @emph{neither}, or @emph{both}. For
-most languages, the default exports the contents of code blocks. However, for
-some languages (e.g.@: @code{ditaa}) the default exports the results of code
-block evaluation. For information on exporting code block bodies, see
-@ref{Literal examples}.
+It is possible to export the @emph{code} of code blocks, the @emph{results}
+of code block evaluation, @emph{both} the code and the results of code block
+evaluation, or @emph{none}. For most languages, the default exports code.
+However, for some languages (e.g.@: @code{ditaa}) the default exports the
+results of code block evaluation. For information on exporting code block
+bodies, see @ref{Literal examples}.
The @code{:exports} header argument can be used to specify export
behavior:
@@ -11732,7 +12866,7 @@ The default in most languages. The body of the code block is exported, as
described in @ref{Literal examples}.
@item :exports results
The code block will be evaluated and the results will be placed in the
-Org-mode buffer for export, either updating previous results of the code
+Org mode buffer for export, either updating previous results of the code
block located anywhere in the buffer or, if no previous results exist,
placing the results immediately after the code block. The body of the code
block will not be exported.
@@ -11745,8 +12879,8 @@ Neither the code block nor its results will be exported.
It is possible to inhibit the evaluation of code blocks during export.
Setting the @code{org-export-babel-evaluate} variable to @code{nil} will
ensure that no code blocks are evaluated as part of the export process. This
-can be useful in situations where potentially untrusted Org-mode files are
-exported in an automated fashion, for example when Org-mode is used as the
+can be useful in situations where potentially untrusted Org mode files are
+exported in an automated fashion, for example when Org mode is used as the
markup language for a wiki.
@comment node-name, next, previous, up
@@ -11796,16 +12930,24 @@ of tangled code files.
@section Evaluating code blocks
@cindex code block, evaluating
@cindex source code, evaluating
+@cindex #+RESULTS
Code blocks can be evaluated@footnote{Whenever code is evaluated there is a
-potential for that code to do harm. Org-mode provides a number of safeguards
-to ensure that it only evaluates code with explicit confirmation from the
-user. For information on these safeguards (and on how to disable them) see
-@ref{Code evaluation security}.} and the results placed in the Org-mode
-buffer. By default, evaluation is only turned on for @code{emacs-lisp} code
-blocks, however support exists for evaluating blocks in many languages. See
-@ref{Languages} for a list of supported languages. See @ref{Structure of
-code blocks} for information on the syntax used to define a code block.
+potential for that code to do harm. Org mode provides safeguards to ensure
+that code is only evaluated after explicit confirmation from the user. For
+information on these safeguards (and on how to disable them) see @ref{Code
+evaluation security}.} and the results of evaluation optionally placed in the
+Org mode buffer. The results of evaluation are placed following a line that
+begins by default with @code{#+RESULTS} and optionally a cache identifier
+and/or the name of the evaluated code block. The default value of
+@code{#+RESULTS} can be changed with the customizable variable
+@code{org-babel-results-keyword}.
+
+By default, the evaluation facility is only enabled for Lisp code blocks
+specified as @code{emacs-lisp}. However, source code blocks in many languages
+can be evaluated within Org mode (see @ref{Languages} for a list of supported
+languages and @ref{Structure of code blocks} for information on the syntax
+used to define a code block).
@kindex C-c C-c
There are a number of ways to evaluate code blocks. The simplest is to press
@@ -11813,64 +12955,52 @@ There are a number of ways to evaluate code blocks. The simplest is to press
@code{org-babel-no-eval-on-ctrl-c-ctrl-c} variable can be used to remove code
evaluation from the @kbd{C-c C-c} key binding.}. This will call the
@code{org-babel-execute-src-block} function to evaluate the block and insert
-its results into the Org-mode buffer.
+its results into the Org mode buffer.
+@cindex #+CALL
+
+It is also possible to evaluate named code blocks from anywhere in an Org
+mode buffer or an Org mode table. Live code blocks located in the current
+Org mode buffer or in the ``Library of Babel'' (see @ref{Library of Babel})
+can be executed. Named code blocks can be executed with a separate
+@code{#+CALL:} line or inline within a block of text.
-It is also possible to evaluate named code blocks from anywhere in an
-Org-mode buffer or an Org-mode table. @code{#+call} (or synonymously
-@code{#+function} or @code{#+lob}) lines can be used to remotely execute code
-blocks located in the current Org-mode buffer or in the ``Library of Babel''
-(see @ref{Library of Babel}). These lines use the following syntax to place
-a call on a line by itself.
+The syntax of the @code{#+CALL:} line is
@example
-#+call: <name>(<arguments>)
-#+call: <name>[<header args>](<arguments>) <header args>
+#+CALL: <name>(<arguments>)
+#+CALL: <name>[<inside header arguments>](<arguments>) <end header arguments>
@end example
-The following syntax can be used to place these calls within a block of
-prose.
+The syntax for inline evaluation of named code blocks is
@example
-...prose... call_<name>(<arguments>) ...prose...
-...prose... call_<name>[<header args>](<arguments>)[<header args>] ...prose...
+... call_<name>(<arguments>) ...
+... call_<name>[<inside header arguments>](<arguments>)[<end header arguments>] ...
@end example
@table @code
@item <name>
-The name of the code block to be evaluated.
+The name of the code block to be evaluated (see @ref{Structure of code blocks}).
@item <arguments>
Arguments specified in this section will be passed to the code block. These
-arguments should relate to @code{:var} header arguments in the called code
-block expressed using standard function call syntax. For example if the
-original code block named @code{double} has the header argument @code{:var
-n=2}, then the call line passing the number four to that block would be
-written as @code{#+call: double(n=2)}.
-@item <header args>
-Header arguments can be placed either inside the call to the code block or at
-the end of the line as shown below.
-
-@example
-#+call: code_bloc_name[XXXX](arguments) YYYY
-@end example
-
-Header arguments located in these two locations are treated differently.
-
-@table @code
-@item XXXX
-Those placed in the @code{XXXX} location are passed through and applied to
-the code block being called. These header arguments affect how the code
-block is evaluated, for example @code{[:results output]} will collect the
-results from @code{STDOUT} of the called code block.
-@item YYYY
-Those placed in the @code{YYYY} location are applied to the call line and do
-not affect the code block being called. These header arguments affect how
-the results are incorporated into the Org-mode buffer when the call line is
-evaluated, and how the call line is exported. For example @code{:results
-org} at the end of the call line will insert the results of the call line
-inside of an Org-mode block.
-@end table
-
-For more examples of passing header arguments to @code{#+call:} lines see
+arguments use standard function call syntax, rather than
+header argument syntax. For example, a @code{#+CALL:} line that passes the
+number four to a code block named @code{double}, which declares the header
+argument @code{:var n=2}, would be written as @code{#+CALL: double(n=4)}.
+@item <inside header arguments>
+Inside header arguments are passed through and applied to the named code
+block. These arguments use header argument syntax rather than standard
+function call syntax. Inside header arguments affect how the code block is
+evaluated. For example, @code{[:results output]} will collect the results of
+everything printed to @code{STDOUT} during execution of the code block.
+@item <end header arguments>
+End header arguments are applied to the calling instance and do not affect
+evaluation of the named code block. They affect how the results are
+incorporated into the Org mode buffer and how the call line is exported. For
+example, @code{:results html} will insert the results of the call line
+evaluation in the Org buffer, wrapped in a @code{BEGIN_HTML:} block.
+
+For more examples of passing header arguments to @code{#+CALL:} lines see
@ref{Header arguments in function calls}.
@end table
@@ -11880,18 +13010,22 @@ For more examples of passing header arguments to @code{#+call:} lines see
@cindex source code, library
@cindex code block, library
-The ``Library of Babel'' is a library of code blocks
-that can be called from any Org-mode file. The library is housed in an
-Org-mode file located in the @samp{contrib} directory of Org-mode.
-Org-mode users can deposit functions they believe to be generally
-useful in the library.
+The ``Library of Babel'' consists of code blocks that can be called from any
+Org mode file. Code blocks defined in the ``Library of Babel'' can be called
+remotely as if they were in the current Org mode buffer (see @ref{Evaluating
+code blocks} for information on the syntax of remote code block evaluation).
+
+
+The central repository of code blocks in the ``Library of Babel'' is housed
+in an Org mode file located in the @samp{contrib} directory of Org mode.
+
+Users can add code blocks they believe to be generally useful to their
+``Library of Babel.'' The code blocks can be stored in any Org mode file and
+then loaded into the library with @code{org-babel-lob-ingest}.
-Code blocks defined in the ``Library of Babel'' can be called remotely as if
-they were in the current Org-mode buffer (see @ref{Evaluating code blocks}
-for information on the syntax of remote code block evaluation).
@kindex C-c C-v i
-Code blocks located in any Org-mode file can be loaded into the ``Library of
+Code blocks located in any Org mode file can be loaded into the ``Library of
Babel'' with the @code{org-babel-lob-ingest} function, bound to @kbd{C-c C-v
i}.
@@ -11916,7 +13050,7 @@ Code blocks in the following languages are supported.
@item Ledger @tab ledger @tab Lisp @tab lisp
@item Lilypond @tab lilypond @tab MATLAB @tab matlab
@item Mscgen @tab mscgen @tab Objective Caml @tab ocaml
-@item Octave @tab octave @tab Org-mode @tab org
+@item Octave @tab octave @tab Org mode @tab org
@item Oz @tab oz @tab Perl @tab perl
@item Plantuml @tab plantuml @tab Python @tab python
@item R @tab R @tab Ruby @tab ruby
@@ -11927,7 +13061,7 @@ Code blocks in the following languages are supported.
Language-specific documentation is available for some languages. If
available, it can be found at
-@uref{http://orgmode.org/worg/org-contrib/babel/languages}.
+@uref{http://orgmode.org/worg/org-contrib/babel/languages.html}.
The @code{org-babel-load-languages} controls which languages are enabled for
evaluation (by default only @code{emacs-lisp} is enabled). This variable can
@@ -11980,7 +13114,7 @@ specific (and having higher priority) than the last.
* System-wide header arguments:: Set global default values
* Language-specific header arguments:: Set default values by language
* Buffer-wide header arguments:: Set default values for a specific buffer
-* Header arguments in Org-mode properties:: Set default values for a buffer or heading
+* Header arguments in Org mode properties:: Set default values for a buffer or heading
* Code block specific header arguments:: The most common way to set values
* Header arguments in function calls:: The most specific level
@end menu
@@ -12031,12 +13165,11 @@ Each language can define its own set of default header arguments. See the
language-specific documentation available online at
@uref{http://orgmode.org/worg/org-contrib/babel}.
-@node Buffer-wide header arguments, Header arguments in Org-mode properties, Language-specific header arguments, Using header arguments
+@node Buffer-wide header arguments, Header arguments in Org mode properties, Language-specific header arguments, Using header arguments
@subsubheading Buffer-wide header arguments
-Buffer-wide header arguments may be specified through the use of a special
-line placed anywhere in an Org-mode file. The line consists of the
-@code{#+BABEL:} keyword followed by a series of header arguments which may be
-specified using the standard header argument syntax.
+Buffer-wide header arguments may be specified as properties through the use
+of @code{#+PROPERTY:} lines placed anywhere in an Org mode file (see
+@ref{Property syntax}).
For example the following would set @code{session} to @code{*R*}, and
@code{results} to @code{silent} for every code block in the buffer, ensuring
@@ -12044,24 +13177,27 @@ that all execution took place in the same session, and no results would be
inserted into the buffer.
@example
-#+BABEL: :session *R* :results silent
+#+PROPERTY: session *R*
+#+PROPERTY: results silent
@end example
-@node Header arguments in Org-mode properties, Code block specific header arguments, Buffer-wide header arguments, Using header arguments
-@subsubheading Header arguments in Org-mode properties
+@node Header arguments in Org mode properties, Code block specific header arguments, Buffer-wide header arguments, Using header arguments
+@subsubheading Header arguments in Org mode properties
-Header arguments are also read from Org-mode properties (see @ref{Property
+Header arguments are also read from Org mode properties (see @ref{Property
syntax}), which can be set on a buffer-wide or per-heading basis. An example
of setting a header argument for all code blocks in a buffer is
@example
-#+property: tangle yes
+#+PROPERTY: tangle yes
@end example
+@vindex org-use-property-inheritance
When properties are used to set default header arguments, they are looked up
-with inheritance, so the value of the @code{:cache} header argument will default
-to @code{yes} in all code blocks in the subtree rooted at the following
-heading:
+with inheritance, regardless of the value of
+@code{org-use-property-inheritance}. In the following example the value of
+the @code{:cache} header argument will default to @code{yes} in all code
+blocks in the subtree rooted at the following heading:
@example
* outline header
@@ -12075,59 +13211,61 @@ heading:
Properties defined in this way override the properties set in
@code{org-babel-default-header-args}. It is convenient to use the
@code{org-set-property} function bound to @kbd{C-c C-x p} to set properties
-in Org-mode documents.
+in Org mode documents.
-@node Code block specific header arguments, Header arguments in function calls, Header arguments in Org-mode properties, Using header arguments
+@node Code block specific header arguments, Header arguments in function calls, Header arguments in Org mode properties, Using header arguments
@subsubheading Code block specific header arguments
The most common way to assign values to header arguments is at the
code block level. This can be done by listing a sequence of header
-arguments and their values as part of the @code{#+begin_src} line.
+arguments and their values as part of the @code{#+BEGIN_SRC} line.
Properties set in this way override both the values of
@code{org-babel-default-header-args} and header arguments specified as
properties. In the following example, the @code{:results} header argument
is set to @code{silent}, meaning the results of execution will not be
inserted in the buffer, and the @code{:exports} header argument is set to
@code{code}, meaning only the body of the code block will be
-preserved on export to HTML or LaTeX.
+preserved on export to HTML or @LaTeX{}.
@example
-#+source: factorial
-#+begin_src haskell :results silent :exports code :var n=0
+#+NAME: factorial
+#+BEGIN_SRC haskell :results silent :exports code :var n=0
fac 0 = 1
fac n = n * fac (n-1)
-#+end_src
+#+END_SRC
@end example
-Similarly, it is possible to set header arguments for inline code blocks:
+Similarly, it is possible to set header arguments for inline code blocks
@example
src_haskell[:exports both]@{fac 5@}
@end example
-Code block header arguments can span multiple lines using =#+header:= or
-=#+headers:= lines preceding a code block or nested in between the name and
-body of a named code block.
+Code block header arguments can span multiple lines using @code{#+HEADER:} or
+@code{#+HEADERS:} lines preceding a code block or nested between the
+@code{#+NAME:} line and the @code{#+BEGIN_SRC} line of a named code block.
+@cindex #+HEADER:
+@cindex #+HEADERS:
Multi-line header arguments on an un-named code block:
@example
- #+headers: :var data1=1
- #+begin_src emacs-lisp :var data2=2
+ #+HEADERS: :var data1=1
+ #+BEGIN_SRC emacs-lisp :var data2=2
(message "data1:%S, data2:%S" data1 data2)
- #+end_src
+ #+END_SRC
- #+results:
+ #+RESULTS:
: data1:1, data2:2
@end example
Multi-line header arguments on a named code block:
@example
- #+source: named-block
- #+header: :var data=2
- #+begin_src emacs-lisp
+ #+NAME: named-block
+ #+HEADER: :var data=2
+ #+BEGIN_SRC emacs-lisp
(message "data:%S" data)
- #+end_src
+ #+END_SRC
- #+results: named-block
+ #+RESULTS: named-block
: data:2
@end example
@@ -12136,31 +13274,33 @@ Multi-line header arguments on a named code block:
@subsubheading Header arguments in function calls
At the most specific level, header arguments for ``Library of Babel'' or
-function call lines can be set as shown in the two examples below. For more
-information on the structure of @code{#+call:} lines see @ref{Evaluating code
+@code{#+CALL:} lines can be set as shown in the two examples below. For more
+information on the structure of @code{#+CALL:} lines see @ref{Evaluating code
blocks}.
The following will apply the @code{:exports results} header argument to the
-evaluation of the @code{#+call:} line.
+evaluation of the @code{#+CALL:} line.
@example
-#+call: factorial(n=5) :exports results
+#+CALL: factorial(n=5) :exports results
@end example
The following will apply the @code{:session special} header argument to the
evaluation of the @code{factorial} code block.
@example
-#+call: factorial[:session special](n=5)
+#+CALL: factorial[:session special](n=5)
@end example
@node Specific header arguments, , Using header arguments, Header arguments
@subsection Specific header arguments
-The following header arguments are defined:
+Header arguments consist of an initial colon followed by the name of the
+argument in lowercase letters. The following header arguments are defined:
@menu
* var:: Pass arguments to code blocks
* results:: Specify the type of results and how they will
be collected and handled
* file:: Specify a path for file output
+* file-desc:: Specify a description for file results
* dir:: Specify the default (possibly remote)
directory for code block execution
* exports:: Export code and/or results
@@ -12176,6 +13316,7 @@ The following header arguments are defined:
* session:: Preserve the state of code evaluation
* noweb:: Toggle expansion of noweb references
* noweb-ref:: Specify block's noweb reference resolution target
+* noweb-sep:: String used to separate noweb references
* cache:: Avoid re-evaluating unchanged code blocks
* sep:: Delimiter for writing tabular results outside Org
* hlines:: Handle horizontal lines in tables
@@ -12183,6 +13324,7 @@ The following header arguments are defined:
* rownames:: Handle row names in tables
* shebang:: Make tangled files executable
* eval:: Limit evaluation of specific code blocks
+* wrap:: Mark source block evaluation results
@end menu
Additional header arguments are defined on a language-specific basis, see
@@ -12193,13 +13335,18 @@ Additional header arguments are defined on a language-specific basis, see
The @code{:var} header argument is used to pass arguments to code blocks.
The specifics of how arguments are included in a code block vary by language;
these are addressed in the language-specific documentation. However, the
-syntax used to specify arguments is the same across all languages. The
-values passed to arguments can be literal values, values from org-mode tables
-and literal example blocks, the results of other code blocks, or Emacs Lisp
-code---see the ``Emacs Lisp evaluation of variables'' heading below.
+syntax used to specify arguments is the same across all languages. In every
+case, variables require a default value when they are declared.
+
+The values passed to arguments can either be literal values, references, or
+Emacs Lisp code (see @ref{var, Emacs Lisp evaluation of variables}). References
+include anything in the Org mode file that takes a @code{#+NAME:},
+@code{#+TBLNAME:}, or @code{#+RESULTS:} line. This includes tables, lists,
+@code{#+BEGIN_EXAMPLE} blocks, other code blocks, and the results of other
+code blocks.
-These values can be indexed in a manner similar to arrays---see the
-``indexable variable values'' heading below.
+Argument values can be indexed in a manner similar to arrays (see @ref{var,
+Indexable variable values}).
The following syntax is used to pass arguments to code blocks using the
@code{:var} header argument.
@@ -12208,76 +13355,122 @@ The following syntax is used to pass arguments to code blocks using the
:var name=assign
@end example
-where @code{assign} can take one of the following forms
+The argument, @code{assign}, can either be a literal value, such as a string
+@samp{"string"} or a number @samp{9}, or a reference to a table, a list, a
+literal example, another code block (with or without arguments), or the
+results of evaluating another code block.
-@itemize @bullet
-@item literal value
-either a string @code{"string"} or a number @code{9}.
-@item reference
-a table name:
+Here are examples of passing values by reference:
+
+@table @dfn
+@item table
+an Org mode table named with either a @code{#+NAME:} or @code{#+TBLNAME:} line
@example
-#+tblname: example-table
+#+TBLNAME: example-table
| 1 |
| 2 |
| 3 |
| 4 |
-#+source: table-length
-#+begin_src emacs-lisp :var table=example-table
+#+NAME: table-length
+#+BEGIN_SRC emacs-lisp :var table=example-table
(length table)
-#+end_src
+#+END_SRC
-#+results: table-length
+#+RESULTS: table-length
: 4
@end example
-a code block name, as assigned by @code{#+srcname:}, followed by
-parentheses:
+@item list
+a simple list named with a @code{#+NAME:} line (note that nesting is not
+carried through to the source code block)
+
+@example
+#+NAME: example-list
+ - simple
+ - not
+ - nested
+ - list
+
+#+BEGIN_SRC emacs-lisp :var x=example-list
+ (print x)
+#+END_SRC
+
+#+RESULTS:
+| simple | list |
+@end example
+
+@item code block without arguments
+a code block name (from the example above), as assigned by @code{#+NAME:},
+optionally followed by parentheses
@example
-#+begin_src emacs-lisp :var length=table-length()
+#+BEGIN_SRC emacs-lisp :var length=table-length()
(* 2 length)
-#+end_src
+#+END_SRC
-#+results:
+#+RESULTS:
: 8
@end example
-In addition, an argument can be passed to the code block referenced
-by @code{:var}. The argument is passed within the parentheses following the
-code block name:
+@item code block with arguments
+a code block name, as assigned by @code{#+NAME:}, followed by parentheses and
+optional arguments passed within the parentheses following the
+code block name using standard function call syntax
@example
-#+source: double
-#+begin_src emacs-lisp :var input=8
+#+NAME: double
+#+BEGIN_SRC emacs-lisp :var input=8
(* 2 input)
-#+end_src
+#+END_SRC
-#+results: double
+#+RESULTS: double
: 16
-#+source: squared
-#+begin_src emacs-lisp :var input=double(input=1)
+#+NAME: squared
+#+BEGIN_SRC emacs-lisp :var input=double(input=1)
(* input input)
-#+end_src
+#+END_SRC
-#+results: squared
+#+RESULTS: squared
: 4
@end example
-@end itemize
+
+@item literal example
+a literal example block named with a @code{#+NAME:} line
+
+@example
+#+NAME: literal-example
+#+BEGIN_EXAMPLE
+A literal example
+on two lines
+#+END_EXAMPLE
+
+#+NAME: read-literal-example
+#+BEGIN_SRC emacs-lisp :var x=literal-example
+ (concatenate 'string x " for you.")
+#+END_SRC
+
+#+RESULTS: read-literal-example
+: A literal example
+: on two lines for you.
+
+@end example
+
+@end table
@subsubheading Alternate argument syntax
It is also possible to specify arguments in a potentially more natural way
-using the @code{#+source:} line of a code block. As in the following
-example arguments can be packed inside of parenthesis, separated by commas,
+using the @code{#+NAME:} line of a code block. As in the following
+example, arguments can be packed inside of parentheses, separated by commas,
following the source name.
@example
-#+source: double(input=0, x=2)
-#+begin_src emacs-lisp
+#+NAME: double(input=0, x=2)
+#+BEGIN_SRC emacs-lisp
(* 2 (+ input x))
-#+end_src
+#+END_SRC
@end example
@subsubheading Indexable variable values
@@ -12291,17 +13484,17 @@ following example assigns the last cell of the first row the table
@code{example-table} to the variable @code{data}:
@example
-#+results: example-table
+#+NAME: example-table
| 1 | a |
| 2 | b |
| 3 | c |
| 4 | d |
-#+begin_src emacs-lisp :var data=example-table[0,-1]
+#+BEGIN_SRC emacs-lisp :var data=example-table[0,-1]
data
-#+end_src
+#+END_SRC
-#+results:
+#+RESULTS:
: a
@end example
@@ -12311,18 +13504,18 @@ example the following assigns the middle three rows of @code{example-table}
to @code{data}.
@example
-#+results: example-table
+#+NAME: example-table
| 1 | a |
| 2 | b |
| 3 | c |
| 4 | d |
| 5 | 3 |
-#+begin_src emacs-lisp :var data=example-table[1:3]
+#+BEGIN_SRC emacs-lisp :var data=example-table[1:3]
data
-#+end_src
+#+END_SRC
-#+results:
+#+RESULTS:
| 2 | b |
| 3 | c |
| 4 | d |
@@ -12334,17 +13527,17 @@ interpreted to mean the entire range and as such are equivalent to
column is referenced.
@example
-#+results: example-table
+#+NAME: example-table
| 1 | a |
| 2 | b |
| 3 | c |
| 4 | d |
-#+begin_src emacs-lisp :var data=example-table[,0]
+#+BEGIN_SRC emacs-lisp :var data=example-table[,0]
data
-#+end_src
+#+END_SRC
-#+results:
+#+RESULTS:
| 1 | 2 | 3 | 4 |
@end example
@@ -12353,51 +13546,51 @@ Any number of dimensions can be indexed. Dimensions are separated from one
another by commas, as shown in the following example.
@example
-#+source: 3D
-#+begin_src emacs-lisp
+#+NAME: 3D
+#+BEGIN_SRC emacs-lisp
'(((1 2 3) (4 5 6) (7 8 9))
((10 11 12) (13 14 15) (16 17 18))
((19 20 21) (22 23 24) (25 26 27)))
-#+end_src
+#+END_SRC
-#+begin_src emacs-lisp :var data=3D[1,,1]
+#+BEGIN_SRC emacs-lisp :var data=3D[1,,1]
data
-#+end_src
+#+END_SRC
-#+results:
+#+RESULTS:
| 11 | 14 | 17 |
@end example
@subsubheading Emacs Lisp evaluation of variables
Emacs lisp code can be used to initialize variable values. When a variable
-value starts with @code{(}, @code{[}, @code{'} or @code{`} it will be evaluated as
-Emacs Lisp and the result of the evaluation will be assigned as the variable
-value. The following example demonstrates use of this evaluation to reliably
-pass the file-name of the org-mode buffer to a code block---note that
-evaluation of header arguments is guaranteed to take place in the original
-org-mode file, while there is no such guarantee for evaluation of the code
-block body.
+value starts with @code{(}, @code{[}, @code{'} or @code{`} it will be
+evaluated as Emacs Lisp and the result of the evaluation will be assigned as
+the variable value. The following example demonstrates use of this
+evaluation to reliably pass the file-name of the Org mode buffer to a code
+block---note that evaluation of header arguments is guaranteed to take place
+in the original Org mode file, while there is no such guarantee for
+evaluation of the code block body.
@example
-#+begin_src sh :var filename=(buffer-file-name) :exports both
+#+BEGIN_SRC sh :var filename=(buffer-file-name) :exports both
wc -w $filename
-#+end_src
+#+END_SRC
@end example
Note that values read from tables and lists will not be evaluated as
Emacs Lisp, as shown in the following example.
@example
-#+results: table
+#+NAME: table
| (a b c) |
-#+headers: :var data=table[0,0]
-#+begin_src perl
+#+HEADERS: :var data=table[0,0]
+#+BEGIN_SRC perl
$data
-#+end_src
+#+END_SRC
-#+results:
+#+RESULTS:
: (a b c)
@end example
@@ -12414,7 +13607,7 @@ from the code block
@item
@b{type} header arguments specify what type of result the code block will
return---which has implications for how they will be inserted into the
-Org-mode buffer
+Org mode buffer
@item
@b{handling} header arguments specify how the results of evaluating the code
block should be handled.
@@ -12445,28 +13638,32 @@ table or scalar depending on their value.
@itemize @bullet
@item @code{table}, @code{vector}
-The results should be interpreted as an Org-mode table. If a single value is
+The results should be interpreted as an Org mode table. If a single value is
returned, it will be converted into a table with one row and one column.
E.g., @code{:results value table}.
@item @code{list}
-The results should be interpreted as an Org-mode list. If a single scalar
+The results should be interpreted as an Org mode list. If a single scalar
value is returned it will be converted into a list with only one element.
@item @code{scalar}, @code{verbatim}
The results should be interpreted literally---they will not be
-converted into a table. The results will be inserted into the Org-mode
+converted into a table. The results will be inserted into the Org mode
buffer as quoted text. E.g., @code{:results value verbatim}.
@item @code{file}
The results will be interpreted as the path to a file, and will be inserted
-into the Org-mode buffer as a file link. E.g., @code{:results value file}.
-@item @code{raw}, @code{org}
-The results are interpreted as raw Org-mode code and are inserted directly
+into the Org mode buffer as a file link. E.g., @code{:results value file}.
+@item @code{raw}
+The results are interpreted as raw Org mode code and are inserted directly
into the buffer. If the results look like a table they will be aligned as
-such by Org-mode. E.g., @code{:results value raw}.
+such by Org mode. E.g., @code{:results value raw}.
+@item @code{org}
+The results are will be enclosed in a @code{BEGIN_SRC org} block.
+They are not comma-escaped by default but they will be if you hit @kbd{TAB}
+in the block and/or if you export the file. E.g., @code{:results value org}.
@item @code{html}
-Results are assumed to be HTML and will be enclosed in a @code{begin_html}
+Results are assumed to be HTML and will be enclosed in a @code{BEGIN_HTML}
block. E.g., @code{:results value html}.
@item @code{latex}
-Results assumed to be LaTeX and are enclosed in a @code{begin_latex} block.
+Results assumed to be @LaTeX{} and are enclosed in a @code{BEGIN_LaTeX} block.
E.g., @code{:results value latex}.
@item @code{code}
Result are assumed to be parsable code and are enclosed in a code block.
@@ -12475,10 +13672,10 @@ E.g., @code{:results value code}.
The result is converted to pretty-printed code and is enclosed in a code
block. This option currently supports Emacs Lisp, Python, and Ruby. E.g.,
@code{:results value pp}.
-@item @code{wrap}
-The result is wrapped in a @code{begin_result} block. This can be useful for
+@item @code{drawer}
+The result is wrapped in a RESULTS drawer. This can be useful for
inserting @code{raw} or @code{org} syntax results in such a way that their
-extend is known and they can be automatically removed or replaced.
+extent is known and they can be automatically removed or replaced.
@end itemize
@subsubheading Handling
@@ -12488,10 +13685,10 @@ results once they are collected.
@itemize @bullet
@item @code{silent}
The results will be echoed in the minibuffer but will not be inserted into
-the Org-mode buffer. E.g., @code{:results output silent}.
+the Org mode buffer. E.g., @code{:results output silent}.
@item @code{replace}
The default value. Any existing results will be removed, and the new results
-will be inserted into the Org-mode buffer in their place. E.g.,
+will be inserted into the Org mode buffer in their place. E.g.,
@code{:results output replace}.
@item @code{append}
If there are pre-existing results of the code block then the new results will
@@ -12503,13 +13700,13 @@ be prepended to the existing results. Otherwise the new results will be
inserted as with @code{replace}.
@end itemize
-@node file, dir, results, Specific header arguments
+@node file, file-desc, results, Specific header arguments
@subsubsection @code{:file}
The header argument @code{:file} is used to specify an external file in which
-to save code block results. After code block evaluation an Org-mode style
+to save code block results. After code block evaluation an Org mode style
@code{[[file:]]} link (see @ref{Link format}) to the file will be inserted
-into the Org-mode buffer. Some languages including R, gnuplot, dot, and
+into the Org mode buffer. Some languages including R, gnuplot, dot, and
ditaa provide special handling of the @code{:file} header argument
automatically wrapping the code block body in the boilerplate code required
to save output to the specified file. This is often useful for saving
@@ -12519,7 +13716,16 @@ The argument to @code{:file} should be either a string specifying the path to
a file, or a list of two strings in which case the first element of the list
should be the path to a file and the second a description for the link.
-@node dir, exports, file, Specific header arguments
+@node file-desc, dir, file, Specific header arguments
+@subsubsection @code{:file-desc}
+
+The value of the @code{:file-desc} header argument is used to provide a
+description for file code block results which are inserted as Org mode links
+(see @ref{Link format}). If the @code{:file-desc} header argument is given
+with no value the link path will be placed in both the ``link'' and the
+``description'' portion of the Org mode link.
+
+@node dir, exports, file-desc, Specific header arguments
@subsubsection @code{:dir} and remote execution
While the @code{:file} header argument can be used to specify the path to the
@@ -12538,9 +13744,9 @@ In other words, if you want your plot to go into a folder called @file{Work}
in your home directory, you could use
@example
-#+begin_src R :file myplot.png :dir ~/Work
+#+BEGIN_SRC R :file myplot.png :dir ~/Work
matplot(matrix(rnorm(100), 10), type="l")
-#+end_src
+#+END_SRC
@end example
@subsubheading Remote execution
@@ -12548,14 +13754,14 @@ A directory on a remote machine can be specified using tramp file syntax, in
which case the code will be evaluated on the remote machine. An example is
@example
-#+begin_src R :file plot.png :dir /dand@@yakuba.princeton.edu:
+#+BEGIN_SRC R :file plot.png :dir /dand@@yakuba.princeton.edu:
plot(1:10, main=system("hostname", intern=TRUE))
-#+end_src
+#+END_SRC
@end example
-Text results will be returned to the local Org-mode buffer as usual, and file
+Text results will be returned to the local Org mode buffer as usual, and file
output will be created on the remote machine with relative paths interpreted
-relative to the remote directory. An Org-mode link to the remote file will be
+relative to the remote directory. An Org mode link to the remote file will be
created.
So, in the above example a plot will be created on the remote machine,
@@ -12581,7 +13787,7 @@ currently made to alter the directory associated with an existing session.
@code{:dir} should typically not be used to create files during export with
@code{:exports results} or @code{:exports both}. The reason is that, in order
to retain portability of exported material between machines, during export
-links inserted into the buffer will *not* be expanded against @code{default
+links inserted into the buffer will @emph{not} be expanded against @code{default
directory}. Therefore, if @code{default-directory} is altered using
@code{:dir}, it is probable that the file will be created in a location to
which the link does not point.
@@ -12591,7 +13797,7 @@ which the link does not point.
@subsubsection @code{:exports}
The @code{:exports} header argument specifies what should be included in HTML
-or LaTeX exports of the Org-mode file.
+or @LaTeX{} exports of the Org mode file.
@itemize @bullet
@item @code{code}
@@ -12616,14 +13822,14 @@ block should be included in tangled extraction of source code files.
@itemize @bullet
@item @code{tangle}
The code block is exported to a source code file named after the full path
-(including the directory) and file name (w/o extension) of the Org-mode file.
+(including the directory) and file name (w/o extension) of the Org mode file.
E.g., @code{:tangle yes}.
@item @code{no}
The default. The code block is not exported to a source code file.
E.g., @code{:tangle no}.
@item other
Any other string passed to the @code{:tangle} header argument is interpreted
-as a path (directory and file name relative to the directory of the Org-mode
+as a path (directory and file name relative to the directory of the Org mode
file) to which the block will be exported. E.g., @code{:tangle path}.
@end itemize
@@ -12650,7 +13856,7 @@ original Org file from which the code was tangled.
@item @code{yes}
A synonym for ``link'' to maintain backwards compatibility.
@item @code{org}
-Include text from the org-mode file as a comment.
+Include text from the Org mode file as a comment.
The text is picked from the leading context of the tangled code and is
limited by the nearest headline or source block as the case may be.
@@ -12699,22 +13905,34 @@ interpreted language.
@node noweb, noweb-ref, session, Specific header arguments
@subsubsection @code{:noweb}
-The @code{:noweb} header argument controls expansion of ``noweb'' style (see
-@ref{Noweb reference syntax}) references in a code block. This header
-argument can have one of three values: @code{yes}, @code{no}, or @code{tangle}.
+The @code{:noweb} header argument controls expansion of ``noweb'' syntax
+references (see @ref{Noweb reference syntax}) when the code block is
+evaluated, tangled, or exported. The @code{:noweb} header argument can have
+one of the five values: @code{no}, @code{yes}, @code{tangle}, or
+@code{no-export} @code{strip-export}.
@itemize @bullet
-@item @code{yes}
-All ``noweb'' syntax references in the body of the code block will be
-expanded before the block is evaluated, tangled or exported.
@item @code{no}
-The default. No ``noweb'' syntax specific action is taken on evaluating
-code blocks, However, noweb references will still be expanded during
-tangling.
+The default. ``Noweb'' syntax references in the body of the code block will
+not be expanded before the code block is evaluated, tangled or exported.
+@item @code{yes}
+``Noweb'' syntax references in the body of the code block will be
+expanded before the code block is evaluated, tangled or exported.
@item @code{tangle}
-All ``noweb'' syntax references in the body of the code block will be
-expanded before the block is tangled, however ``noweb'' references will not
-be expanded when the block is evaluated or exported.
+``Noweb'' syntax references in the body of the code block will be expanded
+before the code block is tangled. However, ``noweb'' syntax references will
+not be expanded when the code block is evaluated or exported.
+@item @code{no-export}
+``Noweb'' syntax references in the body of the code block will be expanded
+before the block is evaluated or tangled. However, ``noweb'' syntax
+references will not be expanded when the code block is exported.
+@item @code{strip-export}
+``Noweb'' syntax references in the body of the code block will be expanded
+before the block is evaluated or tangled. However, ``noweb'' syntax
+references will not be removed when the code block is exported.
+@item @code{eval}
+``Noweb'' syntax references in the body of the code block will only be
+expanded before the block is evaluated.
@end itemize
@subsubheading Noweb prefix lines
@@ -12742,7 +13960,7 @@ Note that noweb replacement text that does not contain any newlines will not
be affected by this change, so it is still possible to use inline noweb
references.
-@node noweb-ref, cache, noweb, Specific header arguments
+@node noweb-ref, noweb-sep, noweb, Specific header arguments
@subsubsection @code{:noweb-ref}
When expanding ``noweb'' style references the bodies of all code block with
@emph{either} a block name matching the reference name @emph{or} a
@@ -12751,46 +13969,62 @@ concatenated together to form the replacement text.
By setting this header argument at the sub-tree or file level, simple code
block concatenation may be achieved. For example, when tangling the
-following Org-mode file, the bodies of code blocks will be concatenated into
-the resulting pure code file.
+following Org mode file, the bodies of code blocks will be concatenated into
+the resulting pure code file@footnote{(The example needs property inheritance
+to be turned on for the @code{noweb-ref} property, see @ref{Property
+inheritance}).}.
@example
- #+begin_src sh :tangle yes :noweb yes :shebang #!/bin/sh
+ #+BEGIN_SRC sh :tangle yes :noweb yes :shebang #!/bin/sh
<<fullest-disk>>
- #+end_src
+ #+END_SRC
* the mount point of the fullest disk
:PROPERTIES:
:noweb-ref: fullest-disk
:END:
** query all mounted disks
- #+begin_src sh
+ #+BEGIN_SRC sh
df \
- #+end_src
+ #+END_SRC
** strip the header row
- #+begin_src sh
+ #+BEGIN_SRC sh
|sed '1d' \
- #+end_src
+ #+END_SRC
** sort by the percent full
- #+begin_src sh
+ #+BEGIN_SRC sh
|awk '@{print $5 " " $6@}'|sort -n |tail -1 \
- #+end_src
+ #+END_SRC
** extract the mount point
- #+begin_src sh
+ #+BEGIN_SRC sh
|awk '@{print $2@}'
- #+end_src
+ #+END_SRC
@end example
-@node cache, sep, noweb-ref, Specific header arguments
+The @code{:noweb-sep} (see @ref{noweb-sep}) header argument holds the string
+used to separate accumulate noweb references like those above. By default a
+newline is used.
+
+@node noweb-sep, cache, noweb-ref, Specific header arguments
+@subsubsection @code{:noweb-sep}
+
+The @code{:noweb-sep} header argument holds the string used to separate
+accumulate noweb references (see @ref{noweb-ref}). By default a newline is
+used.
+
+@node cache, sep, noweb-sep, Specific header arguments
@subsubsection @code{:cache}
The @code{:cache} header argument controls the use of in-buffer caching of
the results of evaluating code blocks. It can be used to avoid re-evaluating
-unchanged code blocks. This header argument can have one of two
-values: @code{yes} or @code{no}.
+unchanged code blocks. Note that the @code{:cache} header argument will not
+attempt to cache results when the @code{:session} header argument is used,
+because the results of the code block execution may be stored in the session
+outside of the Org mode buffer. The @code{:cache} header argument can have
+one of two values: @code{yes} or @code{no}.
@itemize @bullet
@item @code{no}
@@ -12799,7 +14033,7 @@ every time it is called.
@item @code{yes}
Every time the code block is run a SHA1 hash of the code and arguments
passed to the block will be generated. This hash is packed into the
-@code{#+results:} line and will be checked on subsequent
+@code{#+RESULTS:} line and will be checked on subsequent
executions of the code block. If the code block has not
changed since the last time it was evaluated, it will not be re-evaluated.
@end itemize
@@ -12811,20 +14045,20 @@ invalidated and the code block is re-run. In the following example,
changed since it was last run.
@example
- #+srcname: random
- #+begin_src R :cache yes
+ #+NAME: random
+ #+BEGIN_SRC R :cache yes
runif(1)
- #+end_src
+ #+END_SRC
- #+results[a2a72cd647ad44515fab62e144796432793d68e1]: random
+ #+RESULTS[a2a72cd647ad44515fab62e144796432793d68e1]: random
0.4659510825295
- #+srcname: caller
- #+begin_src emacs-lisp :var x=random :cache yes
+ #+NAME: caller
+ #+BEGIN_SRC emacs-lisp :var x=random :cache yes
x
- #+end_src
+ #+END_SRC
- #+results[bec9c8724e397d5df3b696502df3ed7892fc4f5f]: caller
+ #+RESULTS[bec9c8724e397d5df3b696502df3ed7892fc4f5f]: caller
0.254227238707244
@end example
@@ -12832,7 +14066,7 @@ changed since it was last run.
@subsubsection @code{:sep}
The @code{:sep} header argument can be used to control the delimiter used
-when writing tabular results out to files external to Org-mode. This is used
+when writing tabular results out to files external to Org mode. This is used
either when opening tabular results of a code block by calling the
@code{org-open-at-point} function bound to @kbd{C-c C-o} on the code block,
or when writing code block results to an external file (see @ref{file})
@@ -12856,19 +14090,19 @@ variable and raises an error. Setting @code{:hlines no} or relying on the
default value yields the following results.
@example
-#+tblname: many-cols
+#+TBLNAME: many-cols
| a | b | c |
|---+---+---|
| d | e | f |
|---+---+---|
| g | h | i |
-#+source: echo-table
-#+begin_src python :var tab=many-cols
+#+NAME: echo-table
+#+BEGIN_SRC python :var tab=many-cols
return tab
-#+end_src
+#+END_SRC
-#+results: echo-table
+#+RESULTS: echo-table
| a | b | c |
| d | e | f |
| g | h | i |
@@ -12878,19 +14112,19 @@ default value yields the following results.
Leaves hlines in the table. Setting @code{:hlines yes} has this effect.
@example
-#+tblname: many-cols
+#+TBLNAME: many-cols
| a | b | c |
|---+---+---|
| d | e | f |
|---+---+---|
| g | h | i |
-#+source: echo-table
-#+begin_src python :var tab=many-cols :hlines yes
+#+NAME: echo-table
+#+BEGIN_SRC python :var tab=many-cols :hlines yes
return tab
-#+end_src
+#+END_SRC
-#+results: echo-table
+#+RESULTS: echo-table
| a | b | c |
|---+---+---|
| d | e | f |
@@ -12904,6 +14138,10 @@ Leaves hlines in the table. Setting @code{:hlines yes} has this effect.
The @code{:colnames} header argument accepts the values @code{yes},
@code{no}, or @code{nil} for unassigned. The default value is @code{nil}.
+Note that the behavior of the @code{:colnames} header argument may differ
+across languages. For example Emacs Lisp code blocks ignore the
+@code{:colnames} header argument entirely given the ease with which tables
+with column names may be handled directly in Emacs Lisp.
@itemize @bullet
@item @code{nil}
@@ -12913,18 +14151,18 @@ names will be removed from the table before
processing, then reapplied to the results.
@example
-#+tblname: less-cols
+#+TBLNAME: less-cols
| a |
|---|
| b |
| c |
-#+srcname: echo-table-again
-#+begin_src python :var tab=less-cols
+#+NAME: echo-table-again
+#+BEGIN_SRC python :var tab=less-cols
return [[val + '*' for val in row] for row in tab]
-#+end_src
+#+END_SRC
-#+results: echo-table-again
+#+RESULTS: echo-table-again
| a |
|----|
| b* |
@@ -12958,16 +14196,16 @@ The first column of the table is removed from the table before processing,
and is then reapplied to the results.
@example
-#+tblname: with-rownames
+#+TBLNAME: with-rownames
| one | 1 | 2 | 3 | 4 | 5 |
| two | 6 | 7 | 8 | 9 | 10 |
-#+srcname: echo-table-once-again
-#+begin_src python :var tab=with-rownames :rownames yes
+#+NAME: echo-table-once-again
+#+BEGIN_SRC python :var tab=with-rownames :rownames yes
return [[val + 10 for val in row] for row in tab]
-#+end_src
+#+END_SRC
-#+results: echo-table-once-again
+#+RESULTS: echo-table-once-again
| one | 11 | 12 | 13 | 14 | 15 |
| two | 16 | 17 | 18 | 19 | 20 |
@end example
@@ -12985,20 +14223,39 @@ Setting the @code{:shebang} header argument to a string value
first line of any tangled file holding the code block, and the file
permissions of the tangled file are set to make it executable.
-@node eval, , shebang, Specific header arguments
+@node eval, wrap, shebang, Specific header arguments
@subsubsection @code{:eval}
The @code{:eval} header argument can be used to limit the evaluation of
-specific code blocks. @code{:eval} accepts two arguments ``never'' and
-``query''. @code{:eval never} will ensure that a code block is never
-evaluated, this can be useful for protecting against the evaluation of
-dangerous code blocks. @code{:eval query} will require a query for every
-execution of a code block regardless of the value of the
-@code{org-confirm-babel-evaluate} variable.
+specific code blocks. The @code{:eval} header argument can be useful for
+protecting against the evaluation of dangerous code blocks or to ensure that
+evaluation will require a query regardless of the value of the
+@code{org-confirm-babel-evaluate} variable. The possible values of
+@code{:eval} and their effects are shown below.
+
+@table @code
+@item never or no
+The code block will not be evaluated under any circumstances.
+@item query
+Evaluation of the code block will require a query.
+@item never-export or no-export
+The code block will not be evaluated during export but may still be called
+interactively.
+@item query-export
+Evaluation of the code block during export will require a query.
+@end table
If this header argument is not set then evaluation is determined by the value
of the @code{org-confirm-babel-evaluate} variable see @ref{Code evaluation
security}.
+@node wrap, , eval, Specific header arguments
+@subsubsection @code{:wrap}
+The @code{:wrap} header argument is used to mark the results of source block
+evaluation. The header argument can be passed a string that will be appended
+to @code{#+BEGIN_} and @code{#+END_}, which will then be used to wrap the
+results. If not string is specified then the results will be wrapped in a
+@code{#+BEGIN/END_RESULTS} block.
+
@node Results of evaluation, Noweb reference syntax, Header arguments, Working With Source Code
@section Results of evaluation
@cindex code block, results of evaluation
@@ -13016,7 +14273,7 @@ of the possible results header arguments see @ref{results}.
@end multitable
Note: With @code{:results value}, the result in both @code{:session} and
-non-session is returned to Org-mode as a table (a one- or two-dimensional
+non-session is returned to Org mode as a table (a one- or two-dimensional
vector of strings or numbers) when appropriate.
@subsection Non-session
@@ -13062,26 +14319,26 @@ were passed to a non-interactive interpreter running as an external
process. For example, compare the following two blocks:
@example
-#+begin_src python :results output
+#+BEGIN_SRC python :results output
print "hello"
2
print "bye"
-#+end_src
+#+END_SRC
-#+resname:
+#+RESULTS:
: hello
: bye
@end example
In non-session mode, the `2' is not printed and does not appear.
@example
-#+begin_src python :results output :session
+#+BEGIN_SRC python :results output :session
print "hello"
2
print "bye"
-#+end_src
+#+END_SRC
-#+resname:
+#+RESULTS:
: hello
: 2
: bye
@@ -13109,7 +14366,16 @@ When a code block is tangled or evaluated, whether or not ``noweb''
references are expanded depends upon the value of the @code{:noweb} header
argument. If @code{:noweb yes}, then a Noweb reference is expanded before
evaluation. If @code{:noweb no}, the default, then the reference is not
-expanded before evaluation.
+expanded before evaluation. See the @ref{noweb-ref} header argument for
+a more flexible way to resolve noweb references.
+
+It is possible to include the @emph{results} of a code block rather than the
+body. This is done by appending parenthesis to the code block name which may
+optionally contain arguments to the code block as shown below.
+
+@example
+<<code-block-name(optional arguments)>>
+@end example
Note: the default value, @code{:noweb no}, was chosen to ensure that
correct code is not broken in a language, such as Ruby, where
@@ -13117,11 +14383,17 @@ correct code is not broken in a language, such as Ruby, where
syntactically valid in languages that you use, then please consider setting
the default value.
+Note: if noweb tangling is slow in large Org mode files consider setting the
+@code{*org-babel-use-quick-and-dirty-noweb-expansion*} variable to true.
+This will result in faster noweb reference resolution at the expense of not
+correctly resolving inherited values of the @code{:noweb-ref} header
+argument.
+
@node Key bindings and useful functions, Batch execution, Noweb reference syntax, Working With Source Code
@section Key bindings and useful functions
@cindex code block, key bindings
-Many common Org-mode key sequences are re-bound depending on
+Many common Org mode key sequences are re-bound depending on
the context.
Within a code block, the following key bindings
@@ -13138,37 +14410,75 @@ are active:
@item @kbd{M-@key{down}} @tab @code{org-babel-pop-to-session}
@end multitable
-In an Org-mode buffer, the following key bindings are active:
+In an Org mode buffer, the following key bindings are active:
@multitable @columnfractions 0.45 0.55
-@kindex C-c C-v a
-@kindex C-c C-v C-a
-@item @kbd{C-c C-v a} @ @ @r{or} @ @ @kbd{C-c C-v C-a} @tab @code{org-babel-sha1-hash}
+@kindex C-c C-v p
+@kindex C-c C-v C-p
+@item @kbd{C-c C-v p} @ @ @r{or} @ @ @kbd{C-c C-v C-p} @tab @code{org-babel-previous-src-block}
+@kindex C-c C-v n
+@kindex C-c C-v C-n
+@item @kbd{C-c C-v n} @ @ @r{or} @ @ @kbd{C-c C-v C-n} @tab @code{org-babel-next-src-block}
+@kindex C-c C-v e
+@kindex C-c C-v C-e
+@item @kbd{C-c C-v e} @ @ @r{or} @ @ @kbd{C-c C-v C-e} @tab @code{org-babel-execute-maybe}
+@kindex C-c C-v o
+@kindex C-c C-v C-o
+@item @kbd{C-c C-v o} @ @ @r{or} @ @ @kbd{C-c C-v C-o} @tab @code{org-babel-open-src-block-result}
+@kindex C-c C-v v
+@kindex C-c C-v C-v
+@item @kbd{C-c C-v v} @ @ @r{or} @ @ @kbd{C-c C-v C-v} @tab @code{org-babel-expand-src-block}
+@kindex C-c C-v u
+@kindex C-c C-v C-u
+@item @kbd{C-c C-v u} @ @ @r{or} @ @ @kbd{C-c C-v C-u} @tab @code{org-babel-goto-src-block-head}
+@kindex C-c C-v g
+@kindex C-c C-v C-g
+@item @kbd{C-c C-v g} @ @ @r{or} @ @ @kbd{C-c C-v C-g} @tab @code{org-babel-goto-named-src-block}
+@kindex C-c C-v r
+@kindex C-c C-v C-r
+@item @kbd{C-c C-v r} @ @ @r{or} @ @ @kbd{C-c C-v C-r} @tab @code{org-babel-goto-named-result}
@kindex C-c C-v b
@kindex C-c C-v C-b
@item @kbd{C-c C-v b} @ @ @r{or} @ @ @kbd{C-c C-v C-b} @tab @code{org-babel-execute-buffer}
-@kindex C-c C-v f
-@kindex C-c C-v C-f
-@item @kbd{C-c C-v f} @ @ @r{or} @ @ @kbd{C-c C-v C-f} @tab @code{org-babel-tangle-file}
-@kindex C-c C-v g
-@item @kbd{C-c C-v g} @tab @code{org-babel-goto-named-source-block}
-@kindex C-c C-v h
-@item @kbd{C-c C-v h} @tab @code{org-babel-describe-bindings}
-@kindex C-c C-v l
-@kindex C-c C-v C-l
-@item @kbd{C-c C-v l} @ @ @r{or} @ @ @kbd{C-c C-v C-l} @tab @code{org-babel-lob-ingest}
-@kindex C-c C-v p
-@kindex C-c C-v C-p
-@item @kbd{C-c C-v p} @ @ @r{or} @ @ @kbd{C-c C-v C-p} @tab @code{org-babel-expand-src-block}
@kindex C-c C-v s
@kindex C-c C-v C-s
@item @kbd{C-c C-v s} @ @ @r{or} @ @ @kbd{C-c C-v C-s} @tab @code{org-babel-execute-subtree}
+@kindex C-c C-v d
+@kindex C-c C-v C-d
+@item @kbd{C-c C-v d} @ @ @r{or} @ @ @kbd{C-c C-v C-d} @tab @code{org-babel-demarcate-block}
@kindex C-c C-v t
@kindex C-c C-v C-t
@item @kbd{C-c C-v t} @ @ @r{or} @ @ @kbd{C-c C-v C-t} @tab @code{org-babel-tangle}
+@kindex C-c C-v f
+@kindex C-c C-v C-f
+@item @kbd{C-c C-v f} @ @ @r{or} @ @ @kbd{C-c C-v C-f} @tab @code{org-babel-tangle-file}
+@kindex C-c C-v c
+@kindex C-c C-v C-c
+@item @kbd{C-c C-v c} @ @ @r{or} @ @ @kbd{C-c C-v C-c} @tab @code{org-babel-check-src-block}
+@kindex C-c C-v j
+@kindex C-c C-v C-j
+@item @kbd{C-c C-v j} @ @ @r{or} @ @ @kbd{C-c C-v C-j} @tab @code{org-babel-insert-header-arg}
+@kindex C-c C-v l
+@kindex C-c C-v C-l
+@item @kbd{C-c C-v l} @ @ @r{or} @ @ @kbd{C-c C-v C-l} @tab @code{org-babel-load-in-session}
+@kindex C-c C-v i
+@kindex C-c C-v C-i
+@item @kbd{C-c C-v i} @ @ @r{or} @ @ @kbd{C-c C-v C-i} @tab @code{org-babel-lob-ingest}
+@kindex C-c C-v I
+@kindex C-c C-v C-I
+@item @kbd{C-c C-v I} @ @ @r{or} @ @ @kbd{C-c C-v C-I} @tab @code{org-babel-view-src-block-info}
@kindex C-c C-v z
@kindex C-c C-v C-z
-@item @kbd{C-c C-v z} @ @ @r{or} @ @ @kbd{C-c C-v C-z} @tab @code{org-babel-switch-to-session}
+@item @kbd{C-c C-v z} @ @ @r{or} @ @ @kbd{C-c C-v C-z} @tab @code{org-babel-switch-to-session-with-code}
+@kindex C-c C-v a
+@kindex C-c C-v C-a
+@item @kbd{C-c C-v a} @ @ @r{or} @ @ @kbd{C-c C-v C-a} @tab @code{org-babel-sha1-hash}
+@kindex C-c C-v h
+@kindex C-c C-v C-h
+@item @kbd{C-c C-v h} @ @ @r{or} @ @ @kbd{C-c C-v C-h} @tab @code{org-babel-describe-bindings}
+@kindex C-c C-v x
+@kindex C-c C-v C-x
+@item @kbd{C-c C-v x} @ @ @r{or} @ @ @kbd{C-c C-v C-x} @tab @code{org-babel-do-key-sequence-in-edit-buffer}
@end multitable
@c When possible these keybindings were extended to work when the control key is
@@ -13203,17 +14513,16 @@ Be sure to adjust the paths to fit your system.
#
DIR=`pwd`
FILES=""
-ORGINSTALL="~/src/org/lisp/org-install.el"
# wrap each argument in the code required to call tangle on it
for i in $@@; do
FILES="$FILES \"$i\""
done
-emacs -Q --batch -l $ORGINSTALL \
+emacs -Q --batch \
--eval "(progn
(add-to-list 'load-path (expand-file-name \"~/src/org/lisp/\"))
-(add-to-list 'load-path (expand-file-name \"~/src/org/contrib/lisp/\"))
+(add-to-list 'load-path (expand-file-name \"~/src/org/contrib/lisp/\" t))
(require 'org)(require 'org-exp)(require 'ob)(require 'ob-tangle)
(mapc (lambda (file)
(find-file (expand-file-name file \"$DIR\"))
@@ -13255,7 +14564,7 @@ emacs -Q --batch -l $ORGINSTALL \
@cindex tag completion
@cindex link abbreviations, completion of
-Emacs would not be Emacs without completion, and Org-mode uses it whenever it
+Emacs would not be Emacs without completion, and Org mode uses it whenever it
makes sense. If you prefer an @i{iswitchb}- or @i{ido}-like interface for
some of the completion prompts, you can specify your preference by setting at
most one of the variables @code{org-completion-use-iswitchb}
@@ -13290,7 +14599,7 @@ buffer.
After @samp{[}, complete link abbreviations (@pxref{Link abbreviations}).
@item
After @samp{#+}, complete the special keywords like @samp{TYP_TODO} or
-@samp{OPTIONS} which set file-specific options for Org-mode. When the
+@samp{OPTIONS} which set file-specific options for Org mode. When the
option keyword is already complete, pressing @kbd{M-@key{TAB}} again
will insert example settings for this keyword.
@item
@@ -13306,7 +14615,7 @@ Elsewhere, complete dictionary words using Ispell.
@cindex template insertion
@cindex insertion, of templates
-Org-mode supports insertion of empty structural elements (like
+Org mode supports insertion of empty structural elements (like
@code{#+BEGIN_SRC} and @code{#+END_SRC} pairs) with just a few key
strokes. This is achieved through a native template expansion mechanism.
Note that Emacs has several other template mechanisms which could be used in
@@ -13319,19 +14628,19 @@ keystrokes are typed on a line by itself.
The following template selectors are currently supported.
@multitable @columnfractions 0.1 0.9
-@item @kbd{s} @tab @code{#+begin_src ... #+end_src}
-@item @kbd{e} @tab @code{#+begin_example ... #+end_example}
-@item @kbd{q} @tab @code{#+begin_quote ... #+end_quote}
-@item @kbd{v} @tab @code{#+begin_verse ... #+end_verse}
-@item @kbd{c} @tab @code{#+begin_center ... #+end_center}
-@item @kbd{l} @tab @code{#+begin_latex ... #+end_latex}
-@item @kbd{L} @tab @code{#+latex:}
-@item @kbd{h} @tab @code{#+begin_html ... #+end_html}
-@item @kbd{H} @tab @code{#+html:}
-@item @kbd{a} @tab @code{#+begin_ascii ... #+end_ascii}
-@item @kbd{A} @tab @code{#+ascii:}
-@item @kbd{i} @tab @code{#+index:} line
-@item @kbd{I} @tab @code{#+include:} line
+@item @kbd{s} @tab @code{#+BEGIN_SRC ... #+END_SRC}
+@item @kbd{e} @tab @code{#+BEGIN_EXAMPLE ... #+END_EXAMPLE}
+@item @kbd{q} @tab @code{#+BEGIN_QUOTE ... #+END_QUOTE}
+@item @kbd{v} @tab @code{#+BEGIN_VERSE ... #+END_VERSE}
+@item @kbd{c} @tab @code{#+BEGIN_CENTER ... #+END_CENTER}
+@item @kbd{l} @tab @code{#+BEGIN_LaTeX ... #+END_LaTeX}
+@item @kbd{L} @tab @code{#+LaTeX:}
+@item @kbd{h} @tab @code{#+BEGIN_HTML ... #+END_HTML}
+@item @kbd{H} @tab @code{#+HTML:}
+@item @kbd{a} @tab @code{#+BEGIN_ASCII ... #+END_ASCII}
+@item @kbd{A} @tab @code{#+ASCII:}
+@item @kbd{i} @tab @code{#+INDEX:} line
+@item @kbd{I} @tab @code{#+INCLUDE:} line
@end multitable
For example, on an empty line, typing "<e" and then pressing TAB, will expand
@@ -13425,7 +14734,7 @@ either by the @i{calc} interpreter, or by the @i{Emacs Lisp} interpreter.
@cindex options, for customization
@cindex variables, for customization
-There are more than 180 variables that can be used to customize
+There are more than 500 variables that can be used to customize
Org. For the sake of compactness of the manual, I am not
describing the variables here. A structured overview of customization
variables is available with @kbd{M-x org-customize}. Or select
@@ -13438,7 +14747,7 @@ lines into the buffer (@pxref{In-buffer settings}).
@cindex in-buffer settings
@cindex special keywords
-Org-mode uses special lines in the buffer to define settings on a
+Org mode uses special lines in the buffer to define settings on a
per-file basis. These lines start with a @samp{#+} followed by a
keyword, a colon, and then individual words defining a setting. Several
setting words can be in the same line, but you can also have multiple
@@ -13476,8 +14785,8 @@ Set tags that can be inherited by any entry in the file, including the
top-level entries.
@item #+DRAWERS: NAME1 .....
@vindex org-drawers
-Set the file-local set of drawers. The corresponding global variable is
-@code{org-drawers}.
+Set the file-local set of additional drawers. The corresponding global
+variable is @code{org-drawers}.
@item #+LINK: linkword replace
@vindex org-link-abbrev-alist
These lines (several are allowed) specify link abbreviations.
@@ -13497,14 +14806,14 @@ buffer, most useful for specifying the allowed values of a property.
@item #+SETUPFILE: file
This line defines a file that holds more in-buffer setup. Normally this is
entirely ignored. Only when the buffer is parsed for option-setting lines
-(i.e.@: when starting Org-mode for a file, when pressing @kbd{C-c C-c} in a
+(i.e.@: when starting Org mode for a file, when pressing @kbd{C-c C-c} in a
settings line, or when exporting), then the contents of this file are parsed
as if they had been included in the buffer. In particular, the file can be
-any other Org-mode file with internal setup. You can visit the file the
+any other Org mode file with internal setup. You can visit the file the
cursor is in the line with @kbd{C-c '}.
@item #+STARTUP:
@cindex #+STARTUP:
-This line sets options to be used at startup of Org-mode, when an
+This line sets options to be used at startup of Org mode, when an
Org file is being visited.
The first set of options deals with the initial visibility of the outline
@@ -13527,7 +14836,7 @@ showeverything @r{show even drawer contents}
@cindex @code{indent}, STARTUP keyword
@cindex @code{noindent}, STARTUP keyword
Dynamic virtual indentation is controlled by the variable
-@code{org-startup-indented}@footnote{Emacs 23 and Org-mode 6.29 are required}
+@code{org-startup-indented}@footnote{Emacs 23 and Org mode 6.29 are required}
@example
indent @r{start with @code{org-indent-mode} turned on}
noindent @r{start with @code{org-indent-mode} turned off}
@@ -13688,7 +14997,7 @@ This line contains the formulas for the table directly above the line.
@item #+TITLE:, #+AUTHOR:, #+EMAIL:, #+LANGUAGE:, #+TEXT:, #+DATE:,
@itemx #+OPTIONS:, #+BIND:, #+XSLT:,
@itemx #+DESCRIPTION:, #+KEYWORDS:,
-@itemx #+LATEX_HEADER:, #+STYLE:, #+LINK_UP:, #+LINK_HOME:,
+@itemx #+LaTeX_HEADER:, #+STYLE:, #+LINK_UP:, #+LINK_HOME:,
@itemx #+EXPORT_SELECT_TAGS:, #+EXPORT_EXCLUDE_TAGS:
These lines provide settings for exporting files. For more details see
@ref{Export options}.
@@ -13748,6 +15057,8 @@ ordered list.
@item
If the cursor is on the @code{#+BEGIN} line of a dynamic block, the
block is updated.
+@item
+If the cursor is at a timestamp, fix the day name in the timestamp.
@end itemize
@node Clean view, TTY keys, The very busy C-c C-c key, Miscellaneous
@@ -13938,7 +15249,7 @@ checks for the availability of Calc by looking for the function
been installed properly. As of Emacs 22, Calc is part of the Emacs
distribution. Another possibility for interaction between the two
packages is using Calc for embedded calculations. @xref{Embedded Mode,
-, Embedded Mode, Calc, GNU Emacs Calc Manual}.
+, Embedded Mode, calc, GNU Emacs Calc Manual}.
@item @file{constants.el} by Carsten Dominik
@cindex @file{constants.el}
@cindex Dominik, Carsten
@@ -13956,11 +15267,11 @@ setup. See the installation instructions in the file
@item @file{cdlatex.el} by Carsten Dominik
@cindex @file{cdlatex.el}
@cindex Dominik, Carsten
-Org-mode can make use of the CDLa@TeX{} package to efficiently enter
+Org mode can make use of the CD@LaTeX{} package to efficiently enter
@LaTeX{} fragments into Org files. See @ref{CDLaTeX mode}.
@item @file{imenu.el} by Ake Stenhoff and Lars Lindberg
@cindex @file{imenu.el}
-Imenu allows menu access to an index of items in a file. Org-mode
+Imenu allows menu access to an index of items in a file. Org mode
supports Imenu---all you need to do to get the index is the following:
@lisp
(add-hook 'org-mode-hook
@@ -13977,7 +15288,7 @@ Org used to use this package for capture, but no longer does.
@cindex @file{speedbar.el}
@cindex Ludlam, Eric M.
Speedbar is a package that creates a special frame displaying files and
-index items in files. Org-mode supports Speedbar and allows you to
+index items in files. Org mode supports Speedbar and allows you to
drill into Org files directly from the Speedbar. It also allows you to
restrict the scope of agenda commands to a file or a subtree by using
the command @kbd{<} in the Speedbar frame.
@@ -13991,8 +15302,8 @@ the command @kbd{<} in the Speedbar frame.
Complex ASCII tables with automatic line wrapping, column- and row-spanning,
and alignment can be created using the Emacs table package by Takaaki Ota
(@uref{http://sourceforge.net/projects/table}, and also part of Emacs 22).
-Org-mode will recognize these tables and export them properly. Because of
-interference with other Org-mode functionality, you unfortunately cannot edit
+Org mode will recognize these tables and export them properly. Because of
+interference with other Org mode functionality, you unfortunately cannot edit
these tables directly in the buffer. Instead, you need to use the command
@kbd{C-c '} to edit them, similar to source code snippets.
@@ -14002,7 +15313,7 @@ Edit a @file{table.el} table. Works when the cursor is in a table.el table.
@c
@orgcmd{C-c ~,org-table-create-with-table.el}
Insert a @file{table.el} table. If there is already a table at point, this
-command converts it between the @file{table.el} format and the Org-mode
+command converts it between the @file{table.el} format and the Org mode
format. See the documentation string of the command
@code{org-convert-table} for the restrictions under which this is
possible.
@@ -14011,13 +15322,13 @@ possible.
@item @file{footnote.el} by Steven L. Baur
@cindex @file{footnote.el}
@cindex Baur, Steven L.
-Org-mode recognizes numerical footnotes as provided by this package.
-However, Org-mode also has its own footnote support (@pxref{Footnotes}),
+Org mode recognizes numerical footnotes as provided by this package.
+However, Org mode also has its own footnote support (@pxref{Footnotes}),
which makes using @file{footnote.el} unnecessary.
@end table
@node Conflicts, , Cooperation, Interaction
-@subsection Packages that lead to conflicts with Org-mode
+@subsection Packages that lead to conflicts with Org mode
@table @asis
@@ -14029,7 +15340,7 @@ This conflicts with the use of @kbd{S-@key{cursor}} commands in Org to change
timestamps, TODO keywords, priorities, and item bullet types if the cursor is
at such a location. By default, @kbd{S-@key{cursor}} commands outside
special contexts don't do anything, but you can customize the variable
-@code{org-support-shift-select}. Org-mode then tries to accommodate shift
+@code{org-support-shift-select}. Org mode then tries to accommodate shift
selection by (i) using it outside of the special contexts where special
commands apply, and by (ii) extending an existing active region even if the
cursor moves across a special context.
@@ -14044,7 +15355,7 @@ region. In fact, Emacs 23 has this built-in in the form of
@code{shift-selection-mode}, see previous paragraph. If you are using Emacs
23, you probably don't want to use another package for this purpose. However,
if you prefer to leave these keys to a different package while working in
-Org-mode, configure the variable @code{org-replace-disputed-keys}. When set,
+Org mode, configure the variable @code{org-replace-disputed-keys}. When set,
Org will move the following key bindings in Org files, and in the agenda
buffer (but not during date selection).
@@ -14059,6 +15370,18 @@ Yes, these are unfortunately more difficult to remember. If you want
to have other replacement keys, look at the variable
@code{org-disputed-keys}.
+@item @file{filladapt.el} by Kyle Jones
+@cindex @file{filladapt.el}
+
+Org mode tries to do the right thing when filling paragraphs, list items and
+other elements. Many users reported they had problems using both
+@file{filladapt.el} and Org mode, so a safe thing to do is to disable it like
+this:
+
+@lisp
+(add-hook 'org-mode-hook 'turn-off-filladapt-mode)
+@end lisp
+
@item @file{yasnippet.el}
@cindex @file{yasnippet.el}
The way Org mode binds the TAB key (binding to @code{[tab]} instead of
@@ -14069,7 +15392,7 @@ fixed this problem:
(add-hook 'org-mode-hook
(lambda ()
(org-set-local 'yas/trigger-key [tab])
- (define-key yas/keymap [tab] 'yas/next-field-group)))
+ (define-key yas/keymap [tab] 'yas/next-field-or-maybe-expand)))
@end lisp
The latest version of yasnippet doesn't play well with Org mode. If the
@@ -14096,7 +15419,7 @@ Then, tell Org mode what to do with the new function:
@cindex @file{windmove.el}
This package also uses the @kbd{S-<cursor>} keys, so everything written
in the paragraph above about CUA mode also applies here. If you want make
-the windmove function active in locations where Org-mode does not have
+the windmove function active in locations where Org mode does not have
special functionality on @kbd{S-@key{cursor}}, add this to your
configuration:
@@ -14112,7 +15435,7 @@ configuration:
@cindex @file{viper.el}
@kindex C-c /
Viper uses @kbd{C-c /} and therefore makes this key not access the
-corresponding Org-mode command @code{org-sparse-tree}. You need to find
+corresponding Org mode command @code{org-sparse-tree}. You need to find
another key for this command, or override the key in
@code{viper-vi-global-user-map} with
@@ -14169,7 +15492,7 @@ This appendix covers some aspects where users can extend the functionality of
Org.
@menu
-* Hooks:: Who to reach into Org's internals
+* Hooks:: How to reach into Org's internals
* Add-on packages:: Available extensions
* Adding hyperlink types:: New custom link types
* Context-sensitive commands:: How to add functionality to such commands
@@ -14197,7 +15520,7 @@ maintained by the Worg project and can be found at
A large number of add-on packages have been written by various authors.
These packages are not part of Emacs, but they are distributed as contributed
-packages with the separate release available at the Org-mode home page at
+packages with the separate release available at the Org mode home page at
@uref{http://orgmode.org}. The list of contributed packages, along with
documentation about each package, is maintained by the Worg project at
@uref{http://orgmode.org/worg/org-contrib/}.
@@ -14314,14 +15637,14 @@ not accept any arguments, and return the full link with prefix.
@vindex org-ctrl-c-ctrl-c-hook
Org has several commands that act differently depending on context. The most
-important example it the @kbd{C-c C-c} (@pxref{The very busy C-c C-c key}).
+important example is the @kbd{C-c C-c} (@pxref{The very busy C-c C-c key}).
Also the @kbd{M-cursor} and @kbd{M-S-cursor} keys have this property.
Add-ons can tap into this functionality by providing a function that detects
special context for that add-on and executes functionality appropriate for
the context. Here is an example from Dan Davison's @file{org-R.el} which
allows you to evaluate commands based on the @file{R} programming language
-@footnote{@file{org-R.el} has been replaced by the org-mode functionality
+@footnote{@file{org-R.el} has been replaced by the Org mode functionality
described in @ref{Working With Source Code} and is now obsolete.}. For this
package, special contexts are lines that start with @code{#+R:} or
@code{#+RR:}.
@@ -14374,12 +15697,12 @@ can use Org's facilities to edit and structure lists by turning
@menu
* Radio tables:: Sending and receiving radio tables
-* A LaTeX example:: Step by step, almost a tutorial
+* A @LaTeX{} example:: Step by step, almost a tutorial
* Translator functions:: Copy and modify
* Radio lists:: Doing the same for lists
@end menu
-@node Radio tables, A LaTeX example, Tables in arbitrary syntax, Tables in arbitrary syntax
+@node Radio tables, A @LaTeX{} example, Tables in arbitrary syntax, Tables in arbitrary syntax
@subsection Radio tables
@cindex radio tables
@@ -14422,6 +15745,10 @@ calculation marks, that column is automatically discarded as well.
Please note that the translator function sees the table @emph{after} the
removal of these columns, the function never knows that there have been
additional columns.
+
+@item :no-escape t
+When non-nil, do not escape special characters @code{&%#_^} when exporting
+the table. The default value is nil.
@end table
@noindent
@@ -14447,7 +15774,7 @@ makes this comment-toggling very easy, in particular if you bind it to a
key.
@end itemize
-@node A LaTeX example, Translator functions, Radio tables, Tables in arbitrary syntax
+@node A @LaTeX{} example, Translator functions, Radio tables, Tables in arbitrary syntax
@subsection A @LaTeX{} example of radio tables
@cindex @LaTeX{}, and Orgtbl mode
@@ -14557,7 +15884,7 @@ applied. Similar to @code{fmt}, functions of two arguments can be
supplied instead of strings.
@end table
-@node Translator functions, Radio lists, A LaTeX example, Tables in arbitrary syntax
+@node Translator functions, Radio lists, A @LaTeX{} example, Tables in arbitrary syntax
@subsection Translator functions
@cindex HTML, and Orgtbl mode
@cindex translator function
@@ -14821,9 +16148,10 @@ Skip current entry if the TODO keyword is TODO or WAITING.
Skip current entry if the TODO keyword marks a DONE state.
@item (org-agenda-skip-entry-if 'timestamp)
Skip current entry if it has any timestamp, may also be deadline or scheduled.
-@item (org-agenda-skip-entry 'regexp "regular expression")
+@anchor{x-agenda-skip-entry-regexp}
+@item (org-agenda-skip-entry-if 'regexp "regular expression")
Skip current entry if the regular expression matches in the entry.
-@item (org-agenda-skip-entry 'notregexp "regular expression")
+@item (org-agenda-skip-entry-if 'notregexp "regular expression")
Skip current entry unless the regular expression matches.
@item (org-agenda-skip-subtree-if 'regexp "regular expression")
Same as above, but check and skip the entire subtree.
@@ -14877,7 +16205,7 @@ You may also modify parameters on the fly like this:
@example
emacs -batch -l ~/.emacs \
-eval '(org-batch-agenda "a" \
- org-agenda-span month \
+ org-agenda-span (quote month) \
org-agenda-include-diary nil \
org-agenda-files (quote ("~/org/project.org")))' \
| lpr
@@ -14962,6 +16290,7 @@ If WHICH is nil or `all', get all properties. If WHICH is
`special' or `standard', only get that subclass.
@end defun
@vindex org-use-property-inheritance
+@findex org-insert-property-drawer
@defun org-entry-get pom property &optional inherit
Get value of PROPERTY for entry at point-or-marker POM. By default,
this only looks at properties defined locally in the entry. If INHERIT
@@ -14984,7 +16313,7 @@ Get all property keys in the current buffer.
@end defun
@defun org-insert-property-drawer
-Insert a property drawer at point.
+Insert a property drawer for the current entry. Also
@end defun
@defun org-entry-put-multivalued-property pom property &rest values
@@ -15137,13 +16466,16 @@ The following example counts the number of entries with TODO keyword
@cindex iPhone
@cindex MobileOrg
-@uref{http://mobileorg.ncogni.to/, MobileOrg} is an application for the
-@i{iPhone/iPod Touch} series of devices, developed by Richard Moreland.
-@i{MobileOrg} offers offline viewing and capture support for an Org-mode
-system rooted on a ``real'' computer. It does also allow you to record
-changes to existing entries. Android users should check out
+@i{MobileOrg} is the name of the mobile companion app for Org mode, currently
+available for iOS and for Android. @i{MobileOrg} offers offline viewing and
+capture support for an Org mode system rooted on a ``real'' computer. It
+does also allow you to record changes to existing entries.
+The @uref{http://mobileorg.ncogni.to/, iOS implementation} for the
+@i{iPhone/iPod Touch/iPad} series of devices, was developed by Richard
+Moreland. Android users should check out
@uref{http://wiki.github.com/matburt/mobileorg-android/, MobileOrg Android}
-by Matt Jones.
+by Matt Jones. The two implementations are not identical but offer similar
+features.
This appendix describes the support Org has for creating agenda views in a
format that can be displayed by @i{MobileOrg}, and for integrating notes
@@ -15168,7 +16500,7 @@ in-buffer settings, but it will understand the logistics of TODO state
MobileOrg needs to interact with Emacs through a directory on a server. If you
are using a public server, you should consider to encrypt the files that are
-uploaded to the server. This can be done with Org-mode 7.02 and with
+uploaded to the server. This can be done with Org mode 7.02 and with
@i{MobileOrg 1.5} (iPhone version), and you need an @file{openssl}
installation on your system. To turn on encryption, set a password in
@i{MobileOrg} and, on the Emacs side, configure the variable
@@ -15191,7 +16523,7 @@ Emacs about it:
(setq org-mobile-directory "~/Dropbox/MobileOrg")
@end lisp
-Org-mode has commands to put files for @i{MobileOrg} into that directory,
+Org mode has commands to put files for @i{MobileOrg} into that directory,
and to read captured notes from there.
@node Pushing to MobileOrg, Pulling from MobileOrg, Setting up the staging area, MobileOrg
@@ -15204,7 +16536,7 @@ can be included by customizing @code{org-mobile-files}. File names will be
staged with paths relative to @code{org-directory}, so all files should be
inside this directory. The push operation also creates a special Org file
@file{agendas.org} with all custom agenda view defined by the
-user@footnote{While creating the agendas, Org-mode will force ID properties
+user@footnote{While creating the agendas, Org mode will force ID properties
on all referenced entries, so that these entries can be uniquely identified
if @i{MobileOrg} flags them for further action. If you do not want to get
these properties in so many entries, you can set the variable
@@ -15213,8 +16545,8 @@ rely on outline paths, in the hope that these will be unique enough.}.
Finally, Org writes the file @file{index.org}, containing links to all other
files. @i{MobileOrg} first reads this file from the server, and then
downloads all agendas and Org files listed in it. To speed up the download,
-MobileOrg will only read files whose checksums@footnote{stored automatically
-in the file @file{checksums.dat}} have changed.
+MobileOrg will only read files whose checksums@footnote{Checksums are stored
+automatically in the file @file{checksums.dat}} have changed.
@node Pulling from MobileOrg, , Pushing to MobileOrg, MobileOrg
@section Pulling from MobileOrg
@@ -15275,6 +16607,8 @@ the current agenda files will be searched.} using @kbd{C-c a ?}.
@cindex history
@cindex thanks
+@section From Carsten
+
Org was born in 2003, out of frustration over the user interface of the Emacs
Outline mode. I was trying to organize my notes and projects, and using
Emacs seemed to be the natural way to go. However, having to remember eleven
@@ -15305,10 +16639,10 @@ Before I get to this list, a few special mentions are in order:
@table @i
@item Bastien Guerry
Bastien has written a large number of extensions to Org (most of them
-integrated into the core by now), including the LaTeX exporter and the plain
+integrated into the core by now), including the @LaTeX{} exporter and the plain
list parser. His support during the early days, when he basically acted as
co-maintainer, was central to the success of this project. Bastien also
-invented Worg, helped establishing the Web presence of Org, and sponsors
+invented Worg, helped establishing the Web presence of Org, and sponsored
hosting costs for the orgmode.org website.
@item Eric Schulte and Dan Davison
Eric and Dan are jointly responsible for the Org-babel system, which turns
@@ -15329,8 +16663,57 @@ webpages derived from Org using an Info-like or a folding interface with
single-key navigation.
@end table
-@noindent OK, now to the full list of contributions! Again, please let me
-know what I am missing here!
+@noindent See below for the full list of contributions! Again, please
+let me know what I am missing here!
+
+@section From Bastien
+
+I (Bastien) have been maintaining Org since January 2011. This appendix
+would not be complete without adding a few more acknowledgements and thanks
+to Carsten's ones above.
+
+I am first grateful to Carsten for his trust while handing me over the
+maintainership of Org. His support as been great since day one of this new
+adventure, and it helped a lot.
+
+When I took over maintainership, I knew I would have to make Org more
+collaborative than ever, as I would have to rely on people that are more
+knowledgeable than I am on many parts of the code. Here is a list of the
+persons I could rely on, they should really be considered co-maintainers,
+either of the code or the community:
+
+@table @i
+@item Eric Schulte
+Eric is maintaining the Babel parts of Org. His reactivity here kept me away
+from worrying about possible bugs here and let me focus on other parts.
+
+@item Nicolas Goaziou
+Nicolas is maintaining the consistency of the deepest parts of Org. His work
+on @file{org-element.el} and @file{org-export.el} has been outstanding, and
+opened the doors for many new ideas and features.
+
+@item Jambunathan K
+Jambunathan contributed the ODT exporter, definitely a killer feature of
+Org mode. He also contributed the new HTML exporter, which is another core
+feature of Org. Here too, I knew I could rely on him to fix bugs in these
+areas and to patiently explain the users what was the problems and solutions.
+
+@item Achim Gratz
+Achim rewrote the building process of Org, turning some @emph{ad hoc} tools
+into a flexible and conceptually clean process. He patiently coped with the
+many hiccups that such a change can create for users.
+
+@item Nick Dokos
+The Org mode mailing list would not be such a nice place without Nick, who
+patiently helped users so many times. It is impossible to overestimate such
+a great help, and the list would not be so active without him.
+@end table
+
+I received support from so many users that it is clearly impossible to be
+fair when shortlisting a few of them -- but Org's history would not be
+complete if the ones above were not mentioned in this manual.
+
+@section List of contributions
@itemize @bullet
@@ -15340,13 +16723,13 @@ know what I am missing here!
@i{Thomas Baumann} wrote @file{org-bbdb.el} and @file{org-mhe.el}.
@item
@i{Christophe Bataillon} created the great unicorn logo that we use on the
-Org-mode website.
+Org mode website.
@item
@i{Alex Bochannek} provided a patch for rounding timestamps.
@item
@i{Jan Böcker} wrote @file{org-docview.el}.
@item
-@i{Brad Bozarth} showed how to pull RSS feed data into Org-mode files.
+@i{Brad Bozarth} showed how to pull RSS feed data into Org mode files.
@item
@i{Tom Breton} wrote @file{org-choose.el}.
@item
@@ -15522,7 +16905,7 @@ tweaks and features.
extension system, added support for mairix, and proposed the mapping API.
@item
@i{Ulf Stegemann} created the table to translate special symbols to HTML,
-LaTeX, UTF-8, Latin-1 and ASCII.
+@LaTeX{}, UTF-8, Latin-1 and ASCII.
@item
@i{Andy Stewart} contributed code to @file{org-w3m.el}, to copy HTML content
with links transformation to Org syntax.
@@ -15530,9 +16913,9 @@ with links transformation to Org syntax.
@i{David O'Toole} wrote @file{org-publish.el} and drafted the manual
chapter about publishing.
@item
-@i{Jambunathan K} contributed the OpenDocumentText exporter.
+@i{Jambunathan K} contributed the ODT exporter.
@item
-@i{Sebastien Vauban} reported many issues with LaTeX and BEAMER export and
+@i{Sebastien Vauban} reported many issues with @LaTeX{} and BEAMER export and
enabled source code highlighting in Gnus.
@item
@i{Stefan Vollmar} organized a video-recorded talk at the
@@ -15558,7 +16941,6 @@ work on a tty.
@item
@i{Piotr Zielinski} wrote @file{org-mouse.el}, proposed agenda blocks
and contributed various ideas and code snippets.
-@item
@end itemize
diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi
index d4f82b6b3a7..92c309f5e98 100644
--- a/doc/misc/pcl-cvs.texi
+++ b/doc/misc/pcl-cvs.texi
@@ -6,8 +6,7 @@
@c %**end of header
@copying
-Copyright @copyright{} 1991-2011
-Free Software Foundation, Inc.
+Copyright @copyright{} 1991-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -136,10 +135,9 @@ Customization
PCL-CVS is a front-end to CVS versions 1.9 and later.
It concisely shows the present status of a checked out module in an
Emacs buffer and provides single-key access to the most frequently used CVS
-commands.
-For Emacs users accustomed to VC, PCL-CVS can be thought of as a replacement
-for VC-dired (@pxref{VC Directory Mode, , , emacs, The GNU
-Emacs Manual}) specifically designed for CVS.
+commands. Note that the @code{vc-dir} command (@pxref{VC Directory
+Mode, , , emacs, The GNU Emacs Manual}) provides similar
+functionality, but for several version control systems, including CVS.
PCL-CVS was originally written many years ago by Per Cederqvist who
proudly maintained it until January 1996, at which point he released the
diff --git a/doc/misc/pgg.texi b/doc/misc/pgg.texi
index 0de12577b2d..5aa9b1eb230 100644
--- a/doc/misc/pgg.texi
+++ b/doc/misc/pgg.texi
@@ -11,7 +11,7 @@
This file describes PGG @value{VERSION}, an Emacs interface to various
PGP implementations.
-Copyright @copyright{} 2001, 2003-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 2001, 2003-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi
index 192afe33cb4..0174c3fa87f 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -5,7 +5,7 @@
@c %**end of header
@copying
-Copyright @copyright{} 2006-2011
+Copyright @copyright{} 2006-2012
Free Software Foundation, Inc.
@quotation
diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi
index 3944b712338..1ffa2473b27 100644
--- a/doc/misc/reftex.texi
+++ b/doc/misc/reftex.texi
@@ -6,28 +6,46 @@
@syncodeindex vr cp
@syncodeindex fn cp
-@c Version and Contact Info
-@set VERSION 4.31
-@set EDITION 4.31
-@set DATE February 2006
-@set AUCTEXSITE @uref{http://www.gnu.org/software/auctex/,AUCTeX distribution site}
-@set MAINTAINERSITE @uref{http://www.gnu.org/software/auctex/reftex.html,Ref@TeX{} web page}
+@ifnottex
+@macro RefTeX {}
+Ref@TeX{}
+@end macro
+@macro AUCTeX {}
+AUC@TeX{}
+@end macro
+@macro BibTeX {}
+Bib@TeX{}
+@end macro
+@macro ConTeXt {}
+Con@TeX{}t
+@end macro
+@end ifnottex
+@tex
+\gdef\RefTeX{Ref\TeX}
+\gdef\AUCTeX{AUC\TeX}
+\gdef\BibTeX{Bib\TeX}
+\gdef\ConTeXt{Con\TeX t}
+@end tex
+
+@include emacsver.texi
+
+@set VERSION @value{EMACSVER}
+@set AUCTEXSITE @uref{http://www.gnu.org/software/auctex/,@AUCTeX{} web site}
+@set MAINTAINERSITE @uref{http://www.gnu.org/software/auctex/reftex.html,@RefTeX{} web page}
@set MAINTAINERCONTACT @uref{mailto:auctex-devel@@gnu.org,contact the maintainers}
-@set MAINTAINER the AUC@TeX{} project
-@set SUPPORTADDRESS AUC@TeX{} user mailing list (@email{auctex@@gnu.org})
-@set DEVELADDRESS AUC@TeX{} developer mailing list (@email{auctex-devel@@gnu.org})
-@set BUGADDRESS AUC@TeX{} bug mailing list (@email{bug-auctex@@gnu.org})
-@set XEMACSFTP @uref{ftp://ftp.xemacs.org/pub/xemacs/packages/,XEmacs ftp site}
+@set MAINTAINER the @AUCTeX{} project
+@set SUPPORTADDRESS @AUCTeX{} user mailing list (@email{auctex@@gnu.org})
+@set DEVELADDRESS @AUCTeX{} developer mailing list (@email{auctex-devel@@gnu.org})
+@set BUGADDRESS @AUCTeX{} bug mailing list (@email{bug-auctex@@gnu.org})
+@set XEMACSFTP @uref{ftp://ftp.xemacs.org/pub/xemacs/packages/,XEmacs FTP site}
@c %**end of header
@copying
-This file documents @b{Ref@TeX{}}, a package to do labels, references,
-citations and indices for LaTeX documents with Emacs.
+This manual documents @RefTeX{} (version @value{VERSION}), a package
+to do labels, references, citations and indices for LaTeX documents
+with Emacs.
-This is edition @value{EDITION} of the @b{Ref@TeX{}} User Manual for
-@b{Ref@TeX{}} @value{VERSION}
-
-Copyright @copyright{} 1997-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1997-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -64,9 +82,9 @@ developing GNU and promoting software freedom.''
@end macro
@titlepage
-@title Ref@TeX{} User Manual
-@subtitle Support for LaTeX labels, references, citations and index entries with GNU Emacs
-@subtitle Edition @value{EDITION}, @value{DATE}
+@title @RefTeX{} User Manual
+@subtitle Support for @LaTeX{} labels, references, citations and index entries with GNU Emacs
+@subtitle Version @value{VERSION}
@author by Carsten Dominik
@page
@@ -79,18 +97,17 @@ developing GNU and promoting software freedom.''
@ifnottex
@node Top,,,(dir)
-@top RefTeX
+@top @RefTeX{}
-@b{Ref@TeX{}} is a package for managing Labels, References,
-Citations and index entries with GNU Emacs.
+@RefTeX{} is a package for managing Labels, References, Citations and
+index entries with GNU Emacs.
-Don't be discouraged by the size of this manual, which covers
-@b{Ref@TeX{}} in great depth. All you need to know to use
-@b{Ref@TeX{}} can be summarized on two pages (@pxref{RefTeX in a
-Nutshell}). You can go back later to other parts of this document when
-needed.
+This manual documents @RefTeX{} version @value{VERSION}.
-@insertcopying
+Don't be discouraged by the size of this manual, which covers @RefTeX{}
+in great depth. All you need to know to use @RefTeX{} can be summarized
+on two pages (@pxref{RefTeX in a Nutshell}). You can go back later to
+other parts of this document when needed.
@menu
* Introduction:: Quick-Start information.
@@ -106,8 +123,8 @@ needed.
* Faces:: Fontification of RefTeX's buffers.
* Multifile Documents:: Document spread over many files.
* Language Support:: How to support other languages.
-* Finding Files:: Included TeX files and BibTeX .bib files.
-* AUCTeX:: Cooperation with AUCTeX.
+* Finding Files:: Included @TeX{} files and @BibTeX{} .bib files.
+* AUCTeX:: Cooperation with @AUCTeX{}.
* Optimizations:: When RefTeX is too slow.
* Problems and Work-Arounds:: First Aid.
* Imprint:: Author, Web-site, Thanks
@@ -123,6 +140,7 @@ The Index
* Index:: The full index.
@detailmenu
+ --- The Detailed Node Listing ---
Introduction
@@ -136,9 +154,8 @@ Labels and References
* Builtin Label Environments:: The environments RefTeX knows about.
* Defining Label Environments:: ... and environments it doesn't.
* Reference Info:: View the label corresponding to a \ref.
+* Reference Styles:: Macros to be used instead of \ref.
* xr (LaTeX package):: References to external documents.
-* varioref (LaTeX package):: How to create \vref instead of \ref.
-* fancyref (LaTeX package):: How to create \fref instead of \ref.
Defining Label Environments
@@ -157,7 +174,7 @@ Citations
* Citation Info:: View the corresponding database entry.
* Chapterbib and Bibunits:: Multiple bibliographies in a Document.
* Citations Outside LaTeX:: How to make citations in Emails etc.
-* BibTeX Database Subsets:: Extract parts of a big database.
+* BibTeX Database Subsets:: Extract parts of a big database.
Index Support
@@ -176,7 +193,7 @@ The Index Phrases File
AUCTeX
* AUCTeX-RefTeX Interface:: How both packages work together
-* Style Files:: AUCTeX's style files can support RefTeX
+* Style Files:: @AUCTeX{}'s style files can support RefTeX
* Bib-Cite:: Hypertext reading of a document
Options, Keymaps, Hooks
@@ -202,18 +219,18 @@ Options, Keymaps, Hooks
@chapter Introduction
@cindex Introduction
-@b{Ref@TeX{}} is a specialized package for support of labels,
-references, citations, and the index in LaTeX. @b{Ref@TeX{}} wraps
-itself round 4 LaTeX macros: @code{\label}, @code{\ref}, @code{\cite},
-and @code{\index}. Using these macros usually requires looking up
-different parts of the document and searching through BibTeX database
-files. @b{Ref@TeX{}} automates these time--consuming tasks almost
-entirely. It also provides functions to display the structure of a
-document and to move around in this structure quickly.
+@RefTeX{} is a specialized package for support of labels, references,
+citations, and the index in @LaTeX{}. @RefTeX{} wraps itself round four
+@LaTeX{} macros: @code{\label}, @code{\ref}, @code{\cite}, and
+@code{\index}. Using these macros usually requires looking up different
+parts of the document and searching through @BibTeX{} database files.
+@RefTeX{} automates these time-consuming tasks almost entirely. It also
+provides functions to display the structure of a document and to move
+around in this structure quickly.
@iftex
-Don't be discouraged by the size of this manual, which covers @b{Ref@TeX{}}
-in great depth. All you need to know to use @b{Ref@TeX{}} can be
+Don't be discouraged by the size of this manual, which covers @RefTeX{}
+in great depth. All you need to know to use @RefTeX{} can be
summarized on two pages (@pxref{RefTeX in a Nutshell}). You can go
back later to other parts of this document when needed.
@end iftex
@@ -230,51 +247,122 @@ reports or suggestions.
@section Installation
@cindex Installation
-@b{Ref@TeX{}} is bundled and pre--installed with Emacs since version
-20.2. It was also bundled and pre--installed with XEmacs 19.16--20.x.
-XEmacs 21.x users want to install the corresponding plug-in package
-which is available from the @value{XEMACSFTP}. See the XEmacs 21.x
-documentation on package installation for details.
+@RefTeX{} has been bundled and pre-installed with Emacs since
+version 20.2. It has also been bundled and pre-installed with XEmacs
+19.16--20.x. XEmacs 21.x users want to install the corresponding
+plug-in package which is available from the @value{XEMACSFTP}. See the
+XEmacs 21.x documentation on package installation for details.
-Users of earlier Emacs distributions (including Emacs 19) can get a copy
-of the @b{Ref@TeX{}} distribution from the maintainers web-page.
-@xref{Imprint}, for more information.
+Users of earlier Emacs distributions (including Emacs 19) or people
+craving for new features and bugs can get a copy of the @RefTeX{}
+distribution from the maintainer's web page. @xref{Imprint}, for more
+information. The following instructions will guide you through the
+process of installing such a distribution.
-@section Environment
-@cindex Finding files
-@cindex BibTeX database files, not found
-@cindex TeX files, not found
-@cindex @code{TEXINPUTS}, environment variable
-@cindex @code{BIBINPUTS}, environment variable
+@subsection Building and Installing
-@b{Ref@TeX{}} needs to access all files which are part of a multifile
-document, and the BibTeX database files requested by the
-@code{\bibliography} command. To find these files, @b{Ref@TeX{}} will
-require a search path, i.e. a list of directories to check. Normally
-this list is stored in the environment variables @code{TEXINPUTS} and
-@code{BIBINPUTS} which are also used by @b{Ref@TeX{}}. However, on some
-systems these variables do not contain the full search path. If
-@b{Ref@TeX{}} does not work for you because it cannot find some files,
-read @ref{Finding Files}.
+Note: Currently installation is supported for Emacs only. XEmacs users
+might want to refer to the @RefTeX{} package available through the
+package system of XEmacs.
+
+@subsubheading Installation with make
+
+In order to install RefTeX, unpack the distribution and edit the header
+of the Makefile. Basically, you need to change the path specifications
+for Emacs Lisp files and info files. Also, enter the name of your Emacs
+executable (usually either @samp{emacs} or @samp{xemacs}).
+
+Then, type
+
+@example
+make
+make install
+@end example
+
+to compile and install the code and documentation.
+
+Per default @RefTeX{} is installed in its own subdirectory which might
+not be on your load path. In this case, add it to load path with a
+command like the following, replacing the sample directory with the one
+where @RefTeX{} is installed in your case.
+
+@example
+(add-to-list 'load-path "/path/to/reftex")
+@end example
+
+Put this command into your init file before other @RefTeX{}-related
+settings.
+
+@subsubheading Installation by Hand
-@section Entering @b{Ref@TeX{}} Mode
+If you want to get your hands dirty, there is also the possibility to
+install by manually copying files.
+
+@enumerate a
+@item
+Copy the reftex*.el lisp files to a directory on your load path. Make
+sure that no old copy of @RefTeX{} shadows these files.
+@item
+Byte compile the files. The sequence of compiling should be:
+reftex-var.el, reftex.el, and then all the others.
+@item
+Copy the info file reftex.info to the info directory.
+@end enumerate
+
+@subsection Loading @RefTeX{}
+
+In order to make the most important functions for entering @RefTeX{}
+mode available add the following line to your init file.
+
+@example
+(require 'reftex)
+@end example
+
+@subsection Entering @RefTeX{} Mode
@findex turn-on-reftex
@findex reftex-mode
@vindex LaTeX-mode-hook
@vindex latex-mode-hook
-To turn @b{Ref@TeX{}} Mode on and off in a particular buffer, use
-@kbd{M-x reftex-mode}. To turn on @b{Ref@TeX{}} Mode for all LaTeX
-files, add the following lines to your @file{.emacs} file:
+To turn @RefTeX{} Mode on and off in a particular buffer, use
+@kbd{M-x reftex-mode @key{RET}}. To turn on @RefTeX{} Mode for all
+LaTeX files, add the following lines to your @file{.emacs} file:
@example
(add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; with AUCTeX LaTeX mode
(add-hook 'latex-mode-hook 'turn-on-reftex) ; with Emacs latex mode
@end example
+That's all!
+
+To get started, read the documentation, in particular the
+summary. (@pxref{RefTeX in a Nutshell})
+
+In order to produce a printed version of the documentation, use
+@code{make pdf} to produce a reftex.pdf file. Analogously you can use
+the @code{dvi}, @code{ps}, or @code{html} targets to create DVI,
+PostScript or HTML files.
+
+@subsection Environment
+@cindex Finding files
+@cindex BibTeX database files, not found
+@cindex TeX files, not found
+@cindex @code{TEXINPUTS}, environment variable
+@cindex @code{BIBINPUTS}, environment variable
+
+@RefTeX{} needs to access all files which are part of a multifile
+document, and the BibTeX database files requested by the
+@code{\bibliography} command. To find these files, @RefTeX{} will
+require a search path, i.e. a list of directories to check. Normally
+this list is stored in the environment variables @code{TEXINPUTS} and
+@code{BIBINPUTS} which are also used by @RefTeX{}. However, on some
+systems these variables do not contain the full search path. If
+@RefTeX{} does not work for you because it cannot find some files,
+@xref{Finding Files}.
+
@page
@node RefTeX in a Nutshell, , Installation, Introduction
-@section @b{Ref@TeX{}} in a Nutshell
+@section @RefTeX{} in a Nutshell
@cindex Quick-Start
@cindex Getting Started
@cindex RefTeX in a Nutshell
@@ -289,7 +377,7 @@ can jump quickly to every part of your document. Press @kbd{?} to get
help.
@item
-@b{Labels and References}@* @b{Ref@TeX{}} helps to create unique labels
+@b{Labels and References}@* @RefTeX{} helps to create unique labels
and to find the correct key for references quickly. It distinguishes
labels for different environments, knows about all standard
environments (and many others), and can be configured to recognize any
@@ -300,7 +388,7 @@ additional labeled environments you have defined yourself (variable
@item
@b{Creating Labels}@*
Type @kbd{C-c (} (@code{reftex-label}) to insert a label at point.
-@b{Ref@TeX{}} will either
+@RefTeX{} will either
@itemize @minus
@item
derive a label from context (default for section labels)
@@ -325,7 +413,7 @@ into the original buffer.
@item
@b{Citations}@*
Typing @kbd{C-c [} (@code{reftex-citation}) will let you specify a
-regular expression to search in current BibTeX database files (as
+regular expression to search in current @BibTeX{} database files (as
specified in the @code{\bibliography} command) and pull out a list of
matches for you to choose from. The list is @emph{formatted} and
sorted. The selected article is referenced as @samp{\cite@{@var{key}@}}
@@ -334,9 +422,9 @@ different macros).
@item
@b{Index Support}@*
-@b{Ref@TeX{}} helps to enter index entries. It also compiles all
+@RefTeX{} helps to enter index entries. It also compiles all
entries into an alphabetically sorted @file{*Index*} buffer which you
-can use to check and edit the entries. @b{Ref@TeX{}} knows about the
+can use to check and edit the entries. @RefTeX{} knows about the
standard index macros and can be configured to recognize any additional
macros you have defined (@code{reftex-index-macros}). Multiple indices
are supported.
@@ -354,7 +442,7 @@ and enter the arguments with completion.
@b{The Index Phrases File (Delayed Indexing)}@*
Type @kbd{C-c \} (@code{reftex-index-phrase-selection-or-word}) to add
the current word or selection to a special @emph{index phrase file}.
-@b{Ref@TeX{}} can later search the document for occurrences of these
+@RefTeX{} can later search the document for occurrences of these
phrases and let you interactively index the matches.
@item
@@ -366,11 +454,11 @@ all entries.
@page
@item @b{Viewing Cross-References}@*
-When point is on the @var{key} argument of a cross--referencing macro
+When point is on the @var{key} argument of a cross-referencing macro
(@code{\label}, @code{\ref}, @code{\cite}, @code{\bibitem},
-@code{\index}, and variations) or inside a BibTeX database entry, you
+@code{\index}, and variations) or inside a @BibTeX{} database entry, you
can press @kbd{C-c &} (@code{reftex-view-crossref}) to display
-corresponding locations in the document and associated BibTeX database
+corresponding locations in the document and associated @BibTeX{} database
files. @*
When the enclosing macro is @code{\cite} or @code{\ref} and no other
message occupies the echo area, information about the citation or label
@@ -380,12 +468,12 @@ will automatically be displayed in the echo area.
@b{Multifile Documents}@*
Multifile Documents are fully supported. The included files must have a
file variable @code{TeX-master} or @code{tex-main-file} pointing to the
-master file. @b{Ref@TeX{}} provides cross-referencing information from
+master file. @RefTeX{} provides cross-referencing information from
all parts of the document, and across document borders
(@file{xr.sty}).
@item
-@b{Document Parsing}@* @b{Ref@TeX{}} needs to parse the document in
+@b{Document Parsing}@* @RefTeX{} needs to parse the document in
order to find labels and other information. It does it automatically
once and updates its list internally when @code{reftex-label} and
@code{reftex-index} are used. To enforce reparsing, call any of the
@@ -394,20 +482,20 @@ commands described above with a raw @kbd{C-u} prefix, or press the
buffer, or the index buffer.
@item
-@b{AUCTeX} @* If your major LaTeX mode is AUCTeX, @b{Ref@TeX{}} can
-cooperate with it (see variable @code{reftex-plug-into-AUCTeX}). AUCTeX
+@b{@AUCTeX{}} @* If your major @LaTeX{} mode is @AUCTeX{}, @RefTeX{} can
+cooperate with it (see variable @code{reftex-plug-into-AUCTeX}). @AUCTeX{}
contains style files which trigger appropriate settings in
-@b{Ref@TeX{}}, so that for many of the popular LaTeX packages no
+@RefTeX{}, so that for many of the popular @LaTeX{} packages no
additional customizations will be necessary.
@item
@b{Useful Settings}@*
-To integrate RefTeX with AUCTeX, use
+To integrate RefTeX with @AUCTeX{}, use
@lisp
(setq reftex-plug-into-AUCTeX t)
@end lisp
-To make your own LaTeX macro definitions known to @b{Ref@TeX{}},
+To make your own @LaTeX{} macro definitions known to @RefTeX{},
customize the variables
@example
@code{reftex-label-alist} @r{(for label macros/environments)}
@@ -417,15 +505,15 @@ customize the variables
@code{reftex-index-default-macro} @r{(to set the default macro)}
@end example
If you have a large number of macros defined, you may want to write
-an AUCTeX style file to support them with both AUCTeX and
-@b{Ref@TeX{}}.
+an @AUCTeX{} style file to support them with both @AUCTeX{} and
+@RefTeX{}.
-@item @b{Where Next?}@* Go ahead and use @b{Ref@TeX{}}. Use its menus
+@item @b{Where Next?}@* Go ahead and use @RefTeX{}. Use its menus
until you have picked up the key bindings. For an overview of what you
can do in each of the different special buffers, press @kbd{?}. Read
-the manual if you get stuck, of if you are curious what else might be
+the manual if you get stuck, or if you are curious what else might be
available. The first part of the manual explains in
-a tutorial way how to use and customize @b{Ref@TeX{}}. The second
+a tutorial way how to use and customize @RefTeX{}. The second
part is a command and variable reference.
@end enumerate
@@ -463,10 +551,10 @@ Prefix argument.
@tablesubheading{Moving around}
@item n
-Goto next entry in the table of context.
+Goto next entry in the table of contents.
@item p
-Goto previous entry in the table of context.
+Goto previous entry in the table of contents.
@item C-c C-n
Goto next section heading. Useful when many labels and index entries
@@ -506,7 +594,7 @@ always show the location corresponding to the line at point in the
@file{*toc*} buffer. This is similar to pressing @key{SPC} after each
cursor motion. The default for this flag can be set with the variable
@code{reftex-toc-follow-mode}. Note that only context in files already
-visited is shown. @b{Ref@TeX{}} will not visit a file just for follow
+visited is shown. @RefTeX{} will not visit a file just for follow
mode. See, however, the variable
@code{reftex-revisit-to-follow}.
@@ -521,8 +609,8 @@ Show calling point in another window. This is the point from where
Promote the current section. This will convert @code{\section} to
@code{\chapter}, @code{\subsection} to @code{\section} etc. If there is
an active region, all sections in the region will be promoted, including
-the one at point. To avoid mistakes, @b{Ref@TeX{}} requires a fresh
-document scan before executing this command - if necessary, it will
+the one at point. To avoid mistakes, @RefTeX{} requires a fresh
+document scan before executing this command -- if necessary, it will
automatically do this scan and ask the user to repeat the promotion
command.
@@ -578,7 +666,7 @@ variable @code{reftex-toc-include-file-boundaries}.
Toggle the display of labels in the @file{*toc*} buffer. The default
for this flag can be set with the variable
@code{reftex-toc-include-labels}. When called with a prefix argument,
-@b{Ref@TeX{}} will prompt for a label type and include only labels of
+@RefTeX{} will prompt for a label type and include only labels of
the selected type in the @file{*toc*} buffer. The mode line @samp{L<>}
indicator shows which labels are included.
@@ -587,7 +675,7 @@ indicator shows which labels are included.
Toggle the display of index entries in the @file{*toc*} buffer. The
default for this flag can be set with the variable
@code{reftex-toc-include-index-entries}. When called with a prefix
-argument, @b{Ref@TeX{}} will prompt for a specific index and include
+argument, @RefTeX{} will prompt for a specific index and include
only entries in the selected index in the @file{*toc*} buffer. The mode
line @samp{I<>} indicator shows which index is used.
@@ -605,18 +693,18 @@ document.
@item r
@vindex reftex-enable-partial-scans
-Reparse the LaTeX document and rebuild the @file{*toc*} buffer. When
+Reparse the @LaTeX{} document and rebuild the @file{*toc*} buffer. When
@code{reftex-enable-partial-scans} is non-@code{nil}, rescan only the file this
location is defined in, not the entire document.
@item C-u r
-Reparse the @emph{entire} LaTeX document and rebuild the @file{*toc*}
+Reparse the @emph{entire} @LaTeX{} document and rebuild the @file{*toc*}
buffer.
@item x
Switch to the @file{*toc*} buffer of an external document. When the
current document is using the @code{xr} package (@pxref{xr (LaTeX
-package)}), @b{Ref@TeX{}} will switch to one of the external
+package)}), @RefTeX{} will switch to one of the external
documents.
@@ -669,11 +757,11 @@ recentering of the TOC window on the current frame with
@cindex LaTeX classes, KOMA-Script
@cindex TOC entries for environments
@vindex reftex-section-levels
-The section macros recognized by @b{Ref@TeX{}} are all LaTeX section
+The section macros recognized by @RefTeX{} are all @LaTeX{} section
macros (from @code{\part} to @code{\subsubparagraph}) and the commands
@code{\addchap} and @code{\addsec} from the KOMA-Script classes.
Additional macros can be configured with the variable
-@code{reftex-section-levels}. It is also possible to add certain LaTeX
+@code{reftex-section-levels}. It is also possible to add certain @LaTeX{}
environments to the table of contents. This is probably only useful for
theorem-like environments. @xref{Defining Label Environments}, for an
example.
@@ -686,21 +774,21 @@ example.
@cindex Label environment
@cindex @code{\label}
-LaTeX provides a powerful mechanism to deal with cross--references in a
+@LaTeX{} provides a powerful mechanism to deal with cross-references in a
document. When writing a document, any part of it can be marked with a
-label, like @samp{\label@{mark@}}. LaTeX records the current value of a
+label, like @samp{\label@{mark@}}. @LaTeX{} records the current value of a
certain counter when a label is defined. Later references to this label
(like @samp{\ref@{mark@}}) will produce the recorded value of the
counter.
Labels can be used to mark sections, figures, tables, equations,
-footnotes, items in enumerate lists etc. LaTeX is context sensitive in
+footnotes, items in enumerate lists etc. @LaTeX{} is context sensitive in
doing this: A label defined in a figure environment automatically
records the figure counter, not the section counter.
Several different environments can share a common counter and therefore
-a common label category. E.g. labels in both @code{equation} and
-@code{eqnarray} environments record the value of the same counter - the
+a common label category. For example labels in both @code{equation} and
+@code{eqnarray} environments record the value of the same counter -- the
equation counter.
@menu
@@ -709,9 +797,8 @@ equation counter.
* Builtin Label Environments:: The environments RefTeX knows about.
* Defining Label Environments:: ... and environments it doesn't.
* Reference Info:: View the label corresponding to a \ref.
+* Reference Styles:: Macros to be used instead of \ref.
* xr (LaTeX package):: References to external documents.
-* varioref (LaTeX package):: How to create \vref instead of \ref.
-* fancyref (LaTeX package):: How to create \fref instead of \ref.
@end menu
@node Creating Labels, Referencing Labels, , Labels and References
@@ -722,12 +809,12 @@ equation counter.
@kindex C-c (
@findex reftex-label
-In order to create a label in a LaTeX document, press @kbd{C-c (}
-(@code{reftex-label}). Just like LaTeX, @b{Ref@TeX{}} is context sensitive
+In order to create a label in a @LaTeX{} document, press @kbd{C-c (}
+(@code{reftex-label}). Just like @LaTeX{}, @RefTeX{} is context sensitive
and will figure out the environment it currently is in and adapt the
label to that environment. A label usually consists of a short prefix
-indicating the type of the label and a unique mark. @b{Ref@TeX{}} has
-3 different modes to create this mark.
+indicating the type of the label and a unique mark. @RefTeX{} has
+three different modes to create this mark.
@enumerate
@item
@@ -735,10 +822,10 @@ indicating the type of the label and a unique mark. @b{Ref@TeX{}} has
@vindex reftex-derive-label-parameters
@vindex reftex-label-illegal-re
@vindex reftex-abbrev-parameters
-A label can be derived from context. This means, @b{Ref@TeX{}} takes
+A label can be derived from context. This means, @RefTeX{} takes
the context of the label definition and constructs a label from
that@footnote{Note that the context may contain constructs which are
-invalid in labels. @b{Ref@TeX{}} will therefore strip the accent from
+invalid in labels. @RefTeX{} will therefore strip the accent from
accented Latin-1 characters and remove everything else which is not
valid in labels. This mechanism is safe, but may not be satisfactory
for non-western languages. Check the following variables if you need to
@@ -746,28 +833,28 @@ change things: @code{reftex-translate-to-ascii-function},
@code{reftex-derive-label-parameters}, @code{reftex-label-illegal-re},
@code{reftex-abbrev-parameters}.}. This works best for section labels,
where the section heading is used to construct a label. In fact,
-@b{Ref@TeX{}}'s default settings use this method only for section
+@RefTeX{}'s default settings use this method only for section
labels. You will be asked to confirm the derived label, or edit
it.
@item
We may also use a simple unique number to identify a label. This is
mostly useful for labels where it is difficult to come up with a very
-good descriptive name. @b{Ref@TeX{}}'s default settings use this method
-for equations, enumerate items and footnotes. The author of @b{Ref@TeX{}}
+good descriptive name. @RefTeX{}'s default settings use this method
+for equations, enumerate items and footnotes. The author of @RefTeX{}
tends to write documents with many equations and finds it impossible
to come up with good names for each of them. These simple labels are
inserted without query, and are therefore very fast. Good descriptive
-names are not really necessary as @b{Ref@TeX{}} will provide context to
+names are not really necessary as @RefTeX{} will provide context to
reference a label (@pxref{Referencing Labels}).
@item
The third method is to ask the user for a label. This is most
useful for things which are easy to describe briefly and do not turn up
-too frequently in a document. @b{Ref@TeX{}} uses this for figures and
+too frequently in a document. @RefTeX{} uses this for figures and
tables. Of course, one can enter the label directly by typing the full
@samp{\label@{mark@}}. The advantage of using @code{reftex-label}
-anyway is that @b{Ref@TeX{}} will know that a new label has been defined.
+anyway is that @RefTeX{} will know that a new label has been defined.
It will then not be necessary to rescan the document in order to access
this label later.
@end enumerate
@@ -777,9 +864,9 @@ If you want to change the way certain labels are created, check out the
variable @code{reftex-insert-label-flags} (@pxref{Options (Creating
Labels)}).
-If you are using AUCTeX to write your LaTeX documents, you can
+If you are using @AUCTeX{} to write your @LaTeX{} documents, you can
set it up to delegate the creation of labels to
-@b{Ref@TeX{}}. @xref{AUCTeX}, for more information.
+@RefTeX{}. @xref{AUCTeX}, for more information.
@node Referencing Labels, Builtin Label Environments, Creating Labels, Labels and References
@section Referencing Labels
@@ -792,24 +879,31 @@ set it up to delegate the creation of labels to
@findex reftex-reference
@vindex reftex-trust-label-prefix
-@b{Ref@TeX{}} scans the document in order to find all labels. To make
+@RefTeX{} scans the document in order to find all labels. To make
referencing labels easier, it assigns to each label a category, the
@emph{label type} (for example section, table, figure, equation, etc.).
-In order to determine the label type, RefTeX parses around each label
+In order to determine the label type, @RefTeX{} parses around each label
to see in what kind of environments it is located. You can speed up
the parsing by using type-specific prefixes for labels and configuring
the variable @code{reftex-trust-label-prefix}.
-Referencing Labels is really at the heart of @b{Ref@TeX{}}. Press @kbd{C-c
-)} in order to reference a label (reftex-reference). This will start a
-selection process and finally insert the complete @samp{\ref@{label@}}
-into the buffer.
+Referencing Labels is really at the heart of @RefTeX{}. Press @kbd{C-c
+)} in order to reference a label (@code{reftex-reference}). This will
+start a selection process and finally insert the complete
+@samp{\ref@{label@}} into the buffer.
-First, @b{Ref@TeX{}} will determine the label category which is required.
-Often that can be figured out from context. For example, if you
-write @samp{As shown in eq.} and the press @kbd{C-c )}, @b{Ref@TeX{}} knows
-that an equation label is going to be referenced. If it cannot figure
-out what label category is needed, it will query for one.
+@vindex reftex-ref-macro-prompt
+First, you can select which reference macro you want to use,
+e.g. @samp{\ref} or @samp{\pageref}. Later in the process you have
+another chance to make this selection and you can therefore disable this
+step by customizing @code{reftex-ref-macro-prompt} if you find it too
+intrusive. @xref{Reference Styles}.
+
+Then, @RefTeX{} will determine the label category which is required.
+Often that can be figured out from context. For example, if you write
+@samp{As shown in eq.} and then press @kbd{C-c )}, @RefTeX{} knows that
+an equation label is going to be referenced. If it cannot figure out
+what label category is needed, it will query for one.
You will then be presented with a label selection menu. This is a
special buffer which contains an outline of the document along with all
@@ -820,7 +914,7 @@ sufficient to identify the label. If you are unsure about a certain
label, pressing @key{SPC} will show the label definition point in
another window.
-In order to reference a label, move to cursor to the correct label and
+In order to reference a label, move the cursor to the correct label and
press @key{RET}. You can also reference several labels with a single
call to @code{reftex-reference} by marking entries with the @kbd{m}
key (see below).
@@ -871,7 +965,7 @@ window. See also the @kbd{f} key.
Toggle follow mode. When follow mode is active, the other window will
always display the full context of the current label. This is similar
to pressing @key{SPC} after each cursor motion. Note that only context
-in files already visited is shown. @b{RefTeX} will not visit a file
+in files already visited is shown. @RefTeX{} will not visit a file
just for follow mode. See, however, the variable
@code{reftex-revisit-to-follow}.
@@ -888,8 +982,8 @@ references all marked labels.
@item mouse-2
@vindex reftex-highlight-selection
Clicking with mouse button 2 on a label will accept it like @key{RET}
-would. See also variable @code{reftex-highlight-selection}, @ref{Options
-(Misc)}.
+would. See also variable @code{reftex-highlight-selection},
+@ref{Options (Misc)}.
@vindex reftex-multiref-punctuation
@item m - + ,
@@ -923,26 +1017,15 @@ Enter a label with completion. This may also be a label which does not
yet exist in the document.
@item v
-@cindex @code{varioref}, LaTeX package
-@cindex @code{\vref}
-@cindex LaTeX packages, @code{varioref}
-Toggle between @code{\ref} and @code{\vref} macro for references. The
-@code{\vref} macro is defined in the @code{varioref} LaTeX package.
-With this key you can force @b{Ref@TeX{}} to insert a @code{\vref}
-macro. The current state of this flag is displayed by the @samp{S<>}
-indicator in the mode line of the selection buffer.
+Cycle forward through active reference macros. The selected macro is
+displayed by the @samp{S<...>} indicator in the mode line of the
+selection buffer. This mechanism comes in handy if you are using
+@LaTeX{} packages like @code{varioref} or @code{fancyref} and want to
+use the special referencing macros they provide (e.g. @code{\vref} or
+@code{\fref}) instead of @code{\ref}.
@item V
-@cindex @code{fancyref}, LaTeX package
-@cindex @code{\fref}
-@cindex @code{\Fref}
-@cindex LaTeX packages, @code{fancyref}
-Cycle between @code{\ref}, @code{\fref} and @code{\Fref}. The
-@code{\fref} and @code{\Fref} macros are defined in the @code{fancyref}
-LaTeX package. With this key you can force @b{Ref@TeX{}} to insert a
-@code{\fref} or @code{\Fref} macro. The current state of this flag is
-displayed by the @samp{S<>} indicator in the mode line of the
-selection buffer.
+Cycle backward through active reference macros.
@tablesubheading{Exiting}
@@ -966,7 +1049,7 @@ selection buffer.
@item t
Toggle the display of the table of contents in the selection buffer.
With prefix @var{arg}, change the maximum level of toc entries displayed
-to @var{arg}. Chapters are level 1, section are level 2.
+to @var{arg}. Chapters are level 1, sections are level 2.
@item #
Toggle the display of a label counter in the selection buffer.
@@ -974,7 +1057,7 @@ Toggle the display of a label counter in the selection buffer.
@item %
Toggle the display of labels hidden in comments in the selection
buffers. Sometimes, you may have commented out parts of your document.
-If these parts contain label definitions, @b{Ref@TeX{}} can still display
+If these parts contain label definitions, @RefTeX{} can still display
and reference these labels.
@tablesubheading{Updating the buffer}
@@ -998,7 +1081,7 @@ Switch the label category. After prompting for another label category,
a menu for that category will be shown.
@item x
-Reference a label from an external document. With the LaTeX package
+Reference a label from an external document. With the @LaTeX{} package
@code{xr} it is possible to reference labels defined in another
document. This key will switch to the label menu of an external
document and let you select a label from there (@pxref{xr (LaTeX
@@ -1018,10 +1101,10 @@ keymap @code{reftex-select-label-map} may be used.
@vindex reftex-label-alist
@vindex reftex-label-alist-builtin
-@b{Ref@TeX{}} needs to be aware of the environments which can be referenced
-with a label (i.e. which carry their own counters). By default, @b{Ref@TeX{}}
+@RefTeX{} needs to be aware of the environments which can be referenced
+with a label (i.e. which carry their own counters). By default, @RefTeX{}
recognizes all labeled environments and macros discussed in @cite{The
-LaTeX Companion by Goossens, Mittelbach & Samarin, Addison-Wesley
+@LaTeX{} Companion by Goossens, Mittelbach & Samarin, Addison-Wesley
1994.}. These are:
@itemize @minus
@@ -1038,7 +1121,7 @@ LaTeX Companion by Goossens, Mittelbach & Samarin, Addison-Wesley
@cindex LaTeX core
@code{figure}, @code{figure*}, @code{table}, @code{table*}, @code{equation},
@code{eqnarray}, @code{enumerate}, the @code{\footnote} macro (this is
-the LaTeX core stuff)
+the @LaTeX{} core stuff)
@item
@cindex AMS-LaTeX
@cindex @code{amsmath}, LaTeX package
@@ -1053,7 +1136,7 @@ the LaTeX core stuff)
@cindex @code{subequations}, AMS-LaTeX environment
@code{align}, @code{gather}, @code{multline}, @code{flalign},
@code{alignat}, @code{xalignat}, @code{xxalignat}, @code{subequations}
-(from AMS-LaTeX's @file{amsmath.sty} package)
+(from AMS-@LaTeX{}'s @file{amsmath.sty} package)
@item
@cindex @code{endnote}, LaTeX package
@cindex LaTeX packages, @code{endnote}
@@ -1112,7 +1195,7 @@ the @code{\endnote} macro (from @file{endnotes.sty})
@end itemize
If you want to use other labeled environments, defined with
-@code{\newtheorem}, @b{Ref@TeX{}} needs to be configured to recognize
+@code{\newtheorem}, @RefTeX{} needs to be configured to recognize
them (@pxref{Defining Label Environments}).
@node Defining Label Environments, Reference Info, Builtin Label Environments, Labels and References
@@ -1120,7 +1203,7 @@ them (@pxref{Defining Label Environments}).
@cindex Label environments, defining
@vindex reftex-label-alist
-@b{Ref@TeX{}} can be configured to recognize additional labeled
+@RefTeX{} can be configured to recognize additional labeled
environments and macros. This is done with the variable
@code{reftex-label-alist} (@pxref{Options (Defining Label
Environments)}). If you are not familiar with Lisp, you can use the
@@ -1143,7 +1226,7 @@ Environments}).
* Quick Equation:: When a macro sets the label type.
* Figure Wrapper:: When a macro argument is a label.
* Adding Magic Words:: Other words for other languages.
-* Using \eqref:: How to switch to this AMS-LaTeX macro.
+* Using \eqref:: How to switch to this AMS-@LaTeX{} macro.
* Non-Standard Environments:: Environments without \begin and \end
* Putting it Together:: How to combine many entries.
@end menu
@@ -1154,7 +1237,7 @@ Environments}).
@cindex @code{axiom}, newtheorem
@cindex @code{\newtheorem}
-Suppose you are using @code{\newtheorem} in LaTeX in order to define two
+Suppose you are using @code{\newtheorem} in @LaTeX{} in order to define two
new environments, @code{theorem} and @code{axiom}
@example
@@ -1172,7 +1255,7 @@ to be used like this:
\end@{axiom@}
@end example
-So we need to tell @b{Ref@TeX{}} that @code{theorem} and @code{axiom} are new
+So we need to tell @RefTeX{} that @code{theorem} and @code{axiom} are new
labeled environments which define their own label categories. We can
either use Lisp to do this (e.g. in @file{.emacs}) or use the custom
library. With Lisp it would look like this
@@ -1184,7 +1267,7 @@ library. With Lisp it would look like this
@end lisp
The type indicator characters @code{?a} and @code{?h} are used for
-prompts when @b{Ref@TeX{}} queries for a label type. @code{?h}
+prompts when @RefTeX{} queries for a label type. @code{?h}
was chosen for @code{theorem} since @code{?t} is already taken by
@code{table}. Note that also @code{?s}, @code{?f}, @code{?e},
@code{?i}, @code{?n} are already used for standard environments.
@@ -1192,10 +1275,10 @@ was chosen for @code{theorem} since @code{?t} is already taken by
@noindent
The labels for Axioms and Theorems will have the prefixes @samp{ax:} and
@samp{thr:}, respectively. @xref{AUCTeX}, for information on how
-AUCTeX can use RefTeX to automatically create labels when a new environment
-is inserted into a buffer. Additionally, the following needs to be
-added to one's .emacs file before AUCTeX will automatically create
-labels for the new environments.
+@AUCTeX{} can use @RefTeX{} to automatically create labels when a new
+environment is inserted into a buffer. Additionally, the following
+needs to be added to one's .emacs file before @AUCTeX{} will
+automatically create labels for the new environments.
@lisp
(add-hook 'LaTeX-mode-hook
@@ -1226,9 +1309,9 @@ Environments)}).
@end itemize
The following list of strings is used to guess the correct label type
-from the word before point when creating a reference. E.g. if you
+from the word before point when creating a reference. For example if you
write: @samp{As we have shown in Theorem} and then press @kbd{C-c )},
-@b{Ref@TeX{}} will know that you are looking for a theorem label and
+@RefTeX{} will know that you are looking for a theorem label and
restrict the menu to only these labels without even asking.
The final item in each entry is the level at which the environment
@@ -1299,7 +1382,7 @@ and used like this:
Einstein's equation is \quickeq@{E=mc^2 \label@{eq:einstein@}@}.
@end example
-We need to tell @b{Ref@TeX{}} that any label defined in the argument of the
+We need to tell @RefTeX{} that any label defined in the argument of the
@code{\quickeq} is an equation label. Here is how to do this with lisp:
@lisp
@@ -1310,7 +1393,7 @@ The first element in this list is now the macro with empty braces as an
@emph{image} of the macro arguments. @code{?e} indicates that this is
an equation label, the different @code{nil} elements indicate to use the
default values for equations. The @samp{1} as the fifth element
-indicates that the context of the label definition should be the 1st
+indicates that the context of the label definition should be the first
argument of the macro.
Here is again how this would look in the customization buffer:
@@ -1352,7 +1435,7 @@ which would be called like
\myfig[htp]@{filename@}@{caption text@}@{label@}@{1@}
@end example
-Now we need to tell @b{Ref@TeX{}} that the 4th argument of the
+Now we need to tell @RefTeX{} that the fourth argument of the
@code{\myfig} macro @emph{is itself} a figure label, and where to find
the context.
@@ -1366,8 +1449,8 @@ The empty pairs of brackets indicate the different arguments of the
indicates that this is a figure label which will be listed together with
labels from normal figure environments. The @code{nil} entries for
prefix and reference format mean to use the defaults for figure labels.
-The @samp{3} for the context method means to grab the 3rd macro argument
-- the caption.
+The @samp{3} for the context method means to grab the third macro argument
+-- the caption.
As a side effect of this configuration, @code{reftex-label} will now
insert the required naked label (without the @code{\label} macro) when
@@ -1420,7 +1503,7 @@ predefined label categories.
Another case where one only wants to change the information associated
with the label category is to change the macro which is used for
-referencing the label. When working with the AMS-LaTeX stuff, you might
+referencing the label. When working with the AMS-@LaTeX{}, you might
prefer @code{\eqref} for doing equation references. Here is how to
do this:
@@ -1428,7 +1511,7 @@ do this:
(setq reftex-label-alist '((nil ?e nil "~\\eqref@{%s@}" nil nil)))
@end lisp
-@b{Ref@TeX{}} has also a predefined symbol for this special purpose. The
+@RefTeX{} has also a predefined symbol for this special purpose. The
following is equivalent to the line above.
@lisp
@@ -1436,7 +1519,7 @@ following is equivalent to the line above.
@end lisp
Note that this is automatically done by the @file{amsmath.el} style file
-of AUCTeX (@pxref{Style Files}) - so if you use AUCTeX,
+of @AUCTeX{} (@pxref{Style Files}) -- so if you use @AUCTeX{},
this configuration will not be necessary.
@node Non-Standard Environments, Putting it Together, Using \eqref, Defining Label Environments
@@ -1446,8 +1529,8 @@ this configuration will not be necessary.
@cindex Special parser functions
@cindex Parser functions, for special environments
-Some LaTeX packages define environment-like structures without using the
-standard @samp{\begin..\end} structure. @b{Ref@TeX{}} cannot parse
+Some @LaTeX{} packages define environment-like structures without using the
+standard @samp{\begin..\end} structure. @RefTeX{} cannot parse
these directly, but you can write your own special-purpose parser and
use it instead of the name of an environment in an entry for
@code{reftex-label-alist}. The function should check if point is
@@ -1506,7 +1589,7 @@ terminated by @samp{\z.} or by an empty line.
The difficulty is that the @samp{\a.} lists can nest and that an empty
line terminates all list levels in one go. So we have to count nesting
levels between @samp{\a.} and @samp{\z.}. Here is the implementation
-for @b{Ref@TeX{}}.
+for @RefTeX{}.
@lisp
(setq reftex-label-alist
@@ -1558,7 +1641,7 @@ the entries described above:
(detect-linguex ?x "ex:" "~\\ref@{%s@}" nil ("Example" "Ex."))))
@end lisp
-@node Reference Info, xr (LaTeX package), Defining Label Environments, Labels and References
+@node Reference Info, Reference Styles, Defining Label Environments, Labels and References
@section Reference Info
@findex reftex-view-crossref
@findex reftex-mouse-view-crossref
@@ -1575,12 +1658,100 @@ information about the label referenced there. Note that the information
is only displayed if the echo area is not occupied by a different
message.
-@b{Ref@TeX{}} can also display the label definition corresponding to a
+@RefTeX{} can also display the label definition corresponding to a
@code{\ref} macro, or all reference locations corresponding to a
@code{\label} macro. @xref{Viewing Cross-References}, for more
information.
-@node xr (LaTeX package), varioref (LaTeX package), Reference Info, Labels and References
+@node Reference Styles, xr (LaTeX package), Reference Info, Labels and References
+@section Reference Styles
+
+In case you defined your own macros for referencing or you are using
+@LaTeX{} packages providing specialized macros to be used instead of
+@code{\ref}, @RefTeX{} provides ways to select and insert them in a
+convenient way.
+
+@RefTeX{} comes equipped with a set of so-called reference styles where
+each relates to one or more reference macros. The standard macros
+@samp{\ref} and @samp{\pageref} or provided by the ``Default'' style.
+The ``Varioref'' style offers macros for the @samp{varioref} @LaTeX{}
+package (@samp{\vref}, @samp{\Vref}, @samp{\Ref}, @samp{\vpageref}),
+``Fancyref'' for the @samp{fancyref} package (@samp{\fref},
+@samp{\Fref}) and ``Hyperref'' for the @samp{hyperref} package
+(@samp{\autoref}, @samp{\autopageref}).
+
+@vindex reftex-ref-style-default-list
+A style can be toggled by selecting the respective entry in the
+@samp{Reference Style} menu. Changes made through the menu will only
+last for the Emacs session. In order to configure a preference
+permanently, the variable @code{reftex-ref-style-default-list} should be
+customized. This variable specifies the list of styles to be activated.
+It can also be set as a file variable if the preference should be set
+for a specific file.
+
+@vindex reftex-ref-style-alist
+In case the built-in styles do not suffice, you can add additional
+macros and styles to the variable @code{reftex-ref-style-alist}. Those
+do not necessarily have to be related to a certain @LaTeX{} package but
+can follow an arbitrary grouping rule. For example you could define a
+style called ``Personal'' for your personal referencing macros. (When
+changing the variable you should be aware that other Emacs packages,
+like @AUCTeX{}, might rely on the entries from the default value to be
+present.)
+
+Once a style is active the macros it relates to are available for
+selection when you are about to insert a reference. In general this
+process involves three steps: the selection of a reference macro, a
+label type and a label. Reference macros can be chosen in the first and
+last step.
+
+@vindex reftex-ref-macro-prompt
+In the first step you will be presented with a list of macros from which
+you can select one by typing a single key. If you dislike having an
+extra step for reference macro selection, you can disable it by
+customizing @code{reftex-ref-macro-prompt} and relying only on the
+selection facilities provided in the last step.
+
+In the last step, i.e. the label selection, two key bindings are
+provided to set the reference macro. Type @key{v} in order to cycle
+forward through the list of available macros or @key{V} to cycle
+backward. The mode line of the selection buffer shows the macro
+currently selected.
+
+In case you are not satisfied with the order of macros when cycling
+through them you should adapt the order of entries in the variable
+@code{reftex-ref-style-alist} to fit your liking.
+
+For each entry in @code{reftex-ref-style-alist} a function with the name
+@code{reftex-<package>-<macro>} (e.g. @code{reftex-varioref-vref}) will
+be created automatically by @RefTeX{}. These functions can be used
+instead of @kbd{C-c )} and provide an alternative way of having your
+favorite referencing macro preselected and if cycling through the macros
+seems inconvenient to you.@footnote{You could e.g. bind
+@code{reftex-varioref-vref} to @kbd{C-c v} and
+@code{reftex-fancyref-fref} to @kbd{C-c f}.}
+
+@cindex @code{varioref}, LaTeX package
+@cindex LaTeX packages, @code{varioref}
+@cindex @code{fancyref}, LaTeX package
+@cindex LaTeX packages, @code{fancyref}
+@vindex reftex-vref-is-default (deprecated)
+@vindex reftex-fref-is-default (deprecated)
+In former versions of @RefTeX{} only support for @code{varioref} and
+@code{fancyref} was included. @code{varioref} is a @LaTeX{} package to
+create cross-references with page information. @code{fancyref} is a
+package where a macro call like @code{\fref@{@var{fig:map-of-germany}@}}
+creates not only the number of the referenced counter but also the
+complete text around it, like @samp{Figure 3 on the preceding page}. In
+order to make it work you need to use label prefixes like @samp{fig:}
+consistently -- something @RefTeX{} does automatically. For each of
+these packages a variable could be configured to make its macros to take
+precedence over @code{\ref}. Those were @code{reftex-vref-is-default}
+and @code{reftex-fref-is-default} respectively. While still working,
+these variables are deprecated now. Instead of setting them, the
+variable @code{reftex-ref-style-default-list} should be adapted now.
+
+@node xr (LaTeX package), , Reference Styles, Labels and References
@section @code{xr}: Cross-Document References
@cindex @code{xr}, LaTeX package
@cindex LaTeX packages, @code{xr}
@@ -1589,7 +1760,7 @@ information.
@cindex References to external documents
@cindex Cross-document references
-The LaTeX package @code{xr} makes it possible to create references to
+The @LaTeX{} package @code{xr} makes it possible to create references to
labels defined in external documents. The preamble of a document using
@code{xr} will contain something like this:
@@ -1604,66 +1775,26 @@ and we can make references to any labels defined in these
external documents by using the prefixes @samp{V1-} and @samp{V3-},
respectively.
-@b{Ref@TeX{}} can be used to create such references as well. Start the
+@RefTeX{} can be used to create such references as well. Start the
referencing process normally, by pressing @kbd{C-c )}. Select a label
type if necessary. When you see the label selection buffer, pressing
@kbd{x} will switch to the label selection buffer of one of the external
-documents. You may then select a label as before and @b{Ref@TeX{}} will
+documents. You may then select a label as before and @RefTeX{} will
insert it along with the required prefix.
For this kind of inter-document cross-references, saving of parsing
information and the use of multiple selection buffers can mean a large
speed-up (@pxref{Optimizations}).
-@node varioref (LaTeX package), fancyref (LaTeX package), xr (LaTeX package), Labels and References
-@section @code{varioref}: Variable Page References
-@cindex @code{varioref}, LaTeX package
-@cindex @code{\vref}
-@cindex LaTeX packages, @code{varioref}
-@vindex reftex-vref-is-default
-@code{varioref} is a frequently used LaTeX package to create
-cross--references with page information. When you want to make a
-reference with the @code{\vref} macro, just press the @kbd{v} key in the
-selection buffer to toggle between @code{\ref} and @code{\vref}
-(@pxref{Referencing Labels}). The mode line of the selection buffer
-shows the current status of this switch. If you find that you almost
-always use @code{\vref}, you may want to make it the default by
-customizing the variable @code{reftex-vref-is-default}. If this
-toggling seems too inconvenient, you can also use the command
-@code{reftex-varioref-vref}@footnote{bind it to @kbd{C-c v}.}.
-Or use AUCTeX to create your macros (@pxref{AUCTeX}).
-
-@node fancyref (LaTeX package), , varioref (LaTeX package), Labels and References
-@section @code{fancyref}: Fancy Cross References
-@cindex @code{fancyref}, LaTeX package
-@cindex @code{\fref}
-@cindex @code{\Fref}
-@cindex LaTeX packages, @code{fancyref}
-@vindex reftex-fref-is-default
-@code{fancyref} is a LaTeX package where a macro call like
-@code{\fref@{@var{fig:map-of-germany}@}} creates not only the number of
-the referenced counter but also the complete text around it, like
-@samp{Figure 3 on the preceding page}. In order to make it work you
-need to use label prefixes like @samp{fig:} consistently - something
-@b{Ref@TeX{}} does automatically. When you want to make a reference
-with the @code{\fref} macro, just press the @kbd{V} key in the selection
-buffer to cycle between @code{\ref}, @code{\fref} and @code{\Fref}
-(@pxref{Referencing Labels}). The mode line of the selection buffer
-shows the current status of this switch. If this cycling seems
-inconvenient, you can also use the commands @code{reftex-fancyref-fref}
-and @code{reftex-fancyref-Fref}@footnote{bind them to @kbd{C-c
-f} and @kbd{C-c F}.}. Or use AUCTeX to create your macros
-(@pxref{AUCTeX}).
-
@node Citations, Index Support, Labels and References, Top
@chapter Citations
@cindex Citations
@cindex @code{\cite}
-Citations in LaTeX are done with the @code{\cite} macro or variations of
+Citations in @LaTeX{} are done with the @code{\cite} macro or variations of
it. The argument of the macro is a citation key which identifies an
-article or book in either a BibTeX database file or in an explicit
-@code{thebibliography} environment in the document. @b{Ref@TeX{}}'s
+article or book in either a @BibTeX{} database file or in an explicit
+@code{thebibliography} environment in the document. @RefTeX{}'s
support for citations helps to select the correct key quickly.
@menu
@@ -1672,7 +1803,7 @@ support for citations helps to select the correct key quickly.
* Citation Info:: View the corresponding database entry.
* Chapterbib and Bibunits:: Multiple bibliographies in a Document.
* Citations Outside LaTeX:: How to make citations in Emails etc.
-* BibTeX Database Subsets:: Extract parts of a big database.
+* BibTeX Database Subsets:: Extract parts of a big database.
@end menu
@node Creating Citations, Citation Styles, , Citations
@@ -1684,7 +1815,7 @@ support for citations helps to select the correct key quickly.
@cindex Selection buffer, citations
@cindex Selection process
-In order to create a citation, press @kbd{C-c [}. @b{Ref@TeX{}} then
+In order to create a citation, press @kbd{C-c [}. @RefTeX{} then
prompts for a regular expression which will be used to search through
the database and present the list of matches to choose from in a
selection process similar to that for selecting labels
@@ -1695,8 +1826,8 @@ logic @code{and} for regular expressions. For example
@samp{Einstein&&Bose} will match all articles which mention
Bose-Einstein condensation, or which are co-authored by Bose and
Einstein. When entering the regular expression, you can complete on
-known citation keys. RefTeX also offers a default when prompting for a
-regular expression. This default is the word before the cursor or the
+known citation keys. @RefTeX{} also offers a default when prompting for
+a regular expression. This default is the word before the cursor or the
word before the current @samp{\cite} command. Sometimes this may be a
good search key.
@@ -1704,16 +1835,16 @@ good search key.
@cindex @code{thebibliography}, LaTeX environment
@cindex @code{BIBINPUTS}, environment variable
@cindex @code{TEXBIB}, environment variable
-@b{Ref@TeX{}} prefers to use BibTeX database files specified with a
+@RefTeX{} prefers to use @BibTeX{} database files specified with a
@code{\bibliography} macro to collect its information. Just like
-BibTeX, it will search for the specified files in the current directory
+@BibTeX{}, it will search for the specified files in the current directory
and along the path given in the environment variable @code{BIBINPUTS}.
-If you do not use BibTeX, but the document contains an explicit
-@code{thebibliography} environment, @b{Ref@TeX{}} will collect its
+If you do not use @BibTeX{}, but the document contains an explicit
+@code{thebibliography} environment, @RefTeX{} will collect its
information from there. Note that in this case the information
presented in the selection buffer will just be a copy of relevant
@code{\bibitem} entries, not the structured listing available with
-BibTeX database files.
+@BibTeX{} database files.
@kindex ?
In the selection buffer, the following keys provide special commands. A
@@ -1743,7 +1874,7 @@ another window. See also the @kbd{f} key.
@item f
Toggle follow mode. When follow mode is active, the other window will
always display the full database entry of the current article. This is
-equivalent to pressing @key{SPC} after each cursor motion. With BibTeX
+equivalent to pressing @key{SPC} after each cursor motion. With @BibTeX{}
entries, follow mode can be rather slow.
@tablesubheading{Selecting entries and creating the citation}
@@ -1774,14 +1905,14 @@ Accept all (marked) entries in the selection buffer and create a
separate @code{\cite} macro for each of it.
@item e
-Create a new BibTeX database file which contains all @i{marked} entries
+Create a new @BibTeX{} database file which contains all @i{marked} entries
in the selection buffer. If no entries are marked, all entries are
-selected.
+selected.
@item E
-Create a new BibTeX database file which contains all @i{unmarked}
+Create a new @BibTeX{} database file which contains all @i{unmarked}
entries in the selection buffer. If no entries are marked, all entries
-are selected.
+are selected.
@item @key{TAB}
Enter a citation key with completion. This may also be a key which does
@@ -1814,6 +1945,17 @@ entries.
In order to define additional commands for this selection process, the
keymap @code{reftex-select-bib-map} may be used.
+Note that if you do not use Emacs to edit the @BibTeX{} database files,
+@RefTeX{} will ask if the related buffers should be updated once it
+detects that the files were changed externally. If you do not want to
+be bothered by such queries, you can activate Auto Revert mode for these
+buffers by adding the following expression to your init file:
+
+@lisp
+(add-hook 'bibtex-mode-hook 'turn-on-auto-revert-mode)
+@end lisp
+
+
@node Citation Styles, Citation Info, Creating Citations, Citations
@section Citation Styles
@cindex Citation styles
@@ -1821,20 +1963,22 @@ keymap @code{reftex-select-bib-map} may be used.
@cindex Citation styles, @code{harvard}
@cindex Citation styles, @code{chicago}
@cindex Citation styles, @code{jurabib}
+@cindex Citation styles, @ConTeXt{}
@cindex @code{natbib}, citation style
@cindex @code{harvard}, citation style
@cindex @code{chicago}, citation style
@cindex @code{jurabib}, citation style
+@cindex @ConTeXt{}, citation style
@vindex reftex-cite-format
-The standard LaTeX macro @code{\cite} works well with numeric or simple
-key citations. To deal with the more complex task of author-year
+The standard @LaTeX{} macro @code{\cite} works well with numeric or
+simple key citations. To deal with the more complex task of author-year
citations as used in many natural sciences, a variety of packages has
been developed which define derived forms of the @code{\cite} macro.
-@b{Ref@TeX{}} can be configured to produce these citation macros as well
-by setting the variable @code{reftex-cite-format}. For the most
-commonly used packages (@code{natbib}, @code{harvard}, @code{chicago},
-@code{jurabib}) this may be done from the menu, under
+@RefTeX{} can be configured to produce these citation macros as well by
+setting the variable @code{reftex-cite-format}. For the most commonly
+used @LaTeX{} packages (@code{natbib}, @code{harvard}, @code{chicago},
+@code{jurabib}) and for @ConTeXt{} this may be done from the menu, under
@code{Ref->Citation Styles}. Since there are usually several macros to
create the citations, executing @code{reftex-citation} (@kbd{C-c [})
starts by prompting for the correct macro. For the Natbib style, this
@@ -1856,7 +2000,7 @@ SELECT A CITATION FORMAT
@end example
@vindex reftex-cite-prompt-optional-args
-If cite formats contain empty paris of square brackets, RefTeX can
+If citation formats contain empty pairs of square brackets, @RefTeX{}
will prompt for values of these optional arguments if you call the
@code{reftex-citation} command with a @kbd{C-u} prefix.
Following the most generic of these packages, @code{natbib}, the builtin
@@ -1872,12 +2016,12 @@ To make one of these styles the default, customize the variable
(setq reftex-cite-format 'natbib)
@end lisp
-You can also use AUCTeX style files to automatically set the
+You can also use @AUCTeX{} style files to automatically set the
citation style based on the @code{usepackage} commands in a given
document. @xref{Style Files}, for information on how to set up the style
files correctly.
-@node Citation Info, Chapterbib and Bibunits, Citation Styles, Citations, Top
+@node Citation Info, Chapterbib and Bibunits, Citation Styles, Citations
@section Citation Info
@cindex Displaying citations
@cindex Citations, displaying
@@ -1893,9 +2037,9 @@ argument of a @code{\cite} macro, the echo area will display some
information about the article cited there. Note that the information is
only displayed if the echo area is not occupied by a different message.
-@b{Ref@TeX{}} can also display the @code{\bibitem} or BibTeX database
+@RefTeX{} can also display the @code{\bibitem} or @BibTeX{} database
entry corresponding to a @code{\cite} macro, or all citation locations
-corresponding to a @code{\bibitem} or BibTeX database entry.
+corresponding to a @code{\bibitem} or @BibTeX{} database entry.
@xref{Viewing Cross-References}.
@node Chapterbib and Bibunits, Citations Outside LaTeX, Citation Info, Citations
@@ -1904,24 +2048,24 @@ corresponding to a @code{\bibitem} or BibTeX database entry.
@cindex @code{bibunits}, LaTeX package
@cindex Bibliographies, multiple
-@code{chapterbib} and @code{bibunits} are two LaTeX packages which
+@code{chapterbib} and @code{bibunits} are two @LaTeX{} packages which
produce multiple bibliographies in a document. This is no problem for
-@b{Ref@TeX{}} as long as all bibliographies use the same BibTeX database
+@RefTeX{} as long as all bibliographies use the same @BibTeX{} database
files. If they do not, it is best to have each document part in a
separate file (as it is required for @code{chapterbib} anyway). Then
-@b{Ref@TeX{}} will still scan the locally relevant databases correctly. If
+@RefTeX{} will still scan the locally relevant databases correctly. If
you have multiple bibliographies within a @emph{single file}, this may
or may not be the case.
@node Citations Outside LaTeX, BibTeX Database Subsets, Chapterbib and Bibunits, Citations
-@section Citations outside LaTeX
+@section Citations outside @LaTeX{}
@cindex Citations outside LaTeX
@vindex reftex-default-bibliography
-The command @code{reftex-citation} can also be executed outside a LaTeX
+The command @code{reftex-citation} can also be executed outside a @LaTeX{}
buffer. This can be useful to reference articles in the mail buffer and
other documents. You should @emph{not} enter @code{reftex-mode} for
-this, just execute the command. The list of BibTeX files will in this
+this, just execute the command. The list of @BibTeX{} files will in this
case be taken from the variable @code{reftex-default-bibliography}.
Setting the variable @code{reftex-cite-format} to the symbol
@code{locally} does a decent job of putting all relevant information
@@ -1943,24 +2087,24 @@ binding for @code{reftex-cite-format}.
@cindex BibTeX database subsets
@findex reftex-create-bibtex-file
-@b{Ref@TeX{}} offers two ways to create a new BibTeX database file.
+@RefTeX{} offers two ways to create a new @BibTeX{} database file.
The first option produces a file which contains only the entries
actually referenced in the current document. This can be useful if
-the database in only meant for a single document and you want to clean
+the database is only meant for a single document and you want to clean
it of old and unused ballast. It can also be useful while writing a
document together with collaborators, in order to avoid sending around
the entire (possibly very large) database. To create the file, use
@kbd{M-x reftex-create-bibtex-file}, also available from the menu
under @code{Ref->Global Actions->Create Bibtex File}. The command will
-prompt for a BibTeX file name and write the extracted entries to that
+prompt for a @BibTeX{} file name and write the extracted entries to that
file.
The second option makes use of the selection process started by the
command @kbd{C-c [} (@pxref{Creating Citations}). This command uses a
regular expression to select entries, and lists them in a formatted
selection buffer. After pressing the @kbd{e} key (mnemonics: Export),
-the command will prompt for the name of a new BibTeX file and write
+the command will prompt for the name of a new @BibTeX{} file and write
the selected entries to that file. You can also first mark some
entries in the selection buffer with the @kbd{m} key and then export
either the @i{marked} entries (with the @kbd{e} key) or the
@@ -1971,15 +2115,15 @@ either the @i{marked} entries (with the @kbd{e} key) or the
@cindex Index Support
@cindex @code{\index}
-LaTeX has builtin support for creating an Index. The LaTeX core
+@LaTeX{} has builtin support for creating an Index. The @LaTeX{} core
supports two different indices, the standard index and a glossary. With
-the help of special LaTeX packages (@file{multind.sty} or
+the help of special @LaTeX{} packages (@file{multind.sty} or
@file{index.sty}), any number of indices can be supported.
Index entries are created with the @code{\index@{@var{entry}@}} macro.
All entries defined in a document are written out to the @file{.aux}
file. A separate tool must be used to convert this information into a
-nicely formatted index. Tools used with LaTeX include @code{MakeIndex}
+nicely formatted index. Tools used with @LaTeX{} include @code{MakeIndex}
and @code{xindy}.
Indexing is a very difficult task. It must follow strict conventions to
@@ -1996,27 +2140,27 @@ correspond to appropriate index entries. This part of the index can
very well be developed along with the document. Often it is worthwhile
to define special purpose macros which define an item and at the same
time make an index entry, possibly with special formatting to make the
-reference page in the index bold or underlined. To make @b{Ref@TeX{}}
+reference page in the index bold or underlined. To make @RefTeX{}
support for indexing possible, these special macros must be added to
-@b{Ref@TeX{}}'s configuration (@pxref{Defining Index Macros}).
+@RefTeX{}'s configuration (@pxref{Defining Index Macros}).
@item
The rest of the index is often just a collection of where in the
document certain words or phrases are being used. This part is
difficult to develop along with the document, because consistent entries
for each occurrence are needed and are best selected when the document
-is ready. @b{Ref@TeX{}} supports this with an @emph{index phrases file}
+is ready. @RefTeX{} supports this with an @emph{index phrases file}
which collects phrases and helps indexing the phrases globally.
@end enumerate
-Before you start, you need to make sure that @b{Ref@TeX{}} knows about
-the index style being used in the current document. @b{Ref@TeX{}} has
+Before you start, you need to make sure that @RefTeX{} knows about
+the index style being used in the current document. @RefTeX{} has
builtin support for the default @code{\index} and @code{\glossary}
-macros. Other LaTeX packages, like the @file{multind} or @file{index}
+macros. Other @LaTeX{} packages, like the @file{multind} or @file{index}
package, redefine the @code{\index} macro to have an additional
-argument, and @b{Ref@TeX{}} needs to be configured for those. A
-sufficiently new version of AUCTeX (9.10c or later) will do this
-automatically. If you really don't use AUCTeX (you should!), this
+argument, and @RefTeX{} needs to be configured for those. A
+sufficiently new version of @AUCTeX{} (9.10c or later) will do this
+automatically. If you really don't use @AUCTeX{} (you should!), this
configuration needs to be done by hand with the menu (@code{Ref->Index
Style}), or globally for all your documents with
@@ -2057,7 +2201,7 @@ When there is nothing selected and no word at point, this command will
just call @code{reftex-index}, described below.
In order to create a general index entry, press @kbd{C-c <}
-(@code{reftex-index}). @b{Ref@TeX{}} will prompt for one of the
+(@code{reftex-index}). @RefTeX{} will prompt for one of the
available index macros and for its arguments. Completion will be
available for the index entry and, if applicable, the index tag. The
index tag is a string identifying one of multiple indices. With the
@@ -2072,7 +2216,7 @@ to the redefined @code{\index} macro.
@findex reftex-index-visit-phrases-buffer
@cindex Macro definition lines, in phrase buffer
-@b{Ref@TeX{}} maintains a file in which phrases can be collected for
+@RefTeX{} maintains a file in which phrases can be collected for
later indexing. The file is located in the same directory as the master
file of the document and has the extension @file{.rip} (@b{R}eftex
@b{I}ndex @b{P}hrases). You can create or visit the file with @kbd{C-c
@@ -2080,7 +2224,7 @@ file of the document and has the extension @file{.rip} (@b{R}eftex
is initialized by inserting a file header which contains the definition
of the available index macros. This list is initialized from
@code{reftex-index-macros} (@pxref{Defining Index Macros}). You can
-edit the header as needed, but if you define new LaTeX indexing macros,
+edit the header as needed, but if you define new @LaTeX{} indexing macros,
don't forget to add them to @code{reftex-index-macros} as well. Here is
a phrase file header example:
@@ -2122,7 +2266,7 @@ Phrases for indexing can be collected while writing the document. The
command @kbd{C-c \} (@code{reftex-index-phrase-selection-or-word})
copies the current selection (if active) or the word near point into the
phrases buffer. It then selects this buffer, so that the phrase line
-can be edited. To return to the LaTeX document, press @kbd{C-c C-c}
+can be edited. To return to the @LaTeX{} document, press @kbd{C-c C-c}
(@code{reftex-index-phrases-save-and-return}).
You can also prepare the list of index phrases in a different way and
@@ -2131,7 +2275,7 @@ a word list of the document and remove all words which should not be
indexed.
The phrase lines in the phrase buffer must have a specific format.
-@b{Ref@TeX{}} will use font-lock to indicate if a line has the proper
+@RefTeX{} will use font-lock to indicate if a line has the proper
format. A phrase line looks like this:
@example
@@ -2226,7 +2370,7 @@ region and @kbd{C-c C-a} on all phrase lines in the buffer. It is
probably good to do indexing in small chunks since your concentration
may not last long enough to do everything in one go.
-@b{Ref@TeX{}} will start at the first phrase line and search the phrase
+@RefTeX{} will start at the first phrase line and search the phrase
globally in the whole document. At each match it will stop, compute the
replacement string and offer you the following choices@footnote{Windows
users: Restrict yourself to the described keys during indexing. Pressing
@@ -2275,9 +2419,9 @@ sentence, and even typos. You can always say @emph{no} at a match you
do not like.
@item Wrap Long Lines
Inserting index macros increases the line length. Turn this option on
-to allow @b{Ref@TeX{}} to wrap long lines.
+to allow @RefTeX{} to wrap long lines.
@item Skip Indexed Matches
-When this is on, @b{Ref@TeX{}} will at each match try to figure out if
+When this is on, @RefTeX{} will at each match try to figure out if
this match is already indexed. A match is considered indexed if it is
either the argument of an index macro, or if an index macro is directly
(without whitespace separation) before or after the match. Index macros
@@ -2289,7 +2433,7 @@ Even though indexing should be the last thing you do to a document, you
are bound to make changes afterwards. Indexing then has to be applied
to the changed regions. The command
@code{reftex-index-phrases-apply-to-region} is designed for this
-purpose. When called from a LaTeX document with active region, it will
+purpose. When called from a @LaTeX{} document with active region, it will
apply @code{reftex-index-all-phrases} to the current region.
@node Displaying and Editing the Index, Builtin Index Macros, The Index Phrases File, Index Support
@@ -2303,7 +2447,7 @@ apply @code{reftex-index-all-phrases} to the current region.
@findex reftex-display-index
In order to compile and display the index, press @kbd{C-c >}. If the
-document uses multiple indices, @b{Ref@TeX{}} will ask you to select
+document uses multiple indices, @RefTeX{} will ask you to select
one. Then, all index entries will be sorted alphabetically and
displayed in a special buffer, the @file{*Index*} buffer. From that
buffer you can check and edit each entry.
@@ -2317,7 +2461,7 @@ region, make the region active and use a numeric prefix @samp{3} (press
restriction can be moved from one section to the next by pressing the
@kbd{<} and @kbd{>} keys.
-One caveat: @b{Ref@TeX{}} finds the definition point of an index entry
+One caveat: @RefTeX{} finds the definition point of an index entry
by searching near the buffer position where it had found to macro during
scanning. If you have several identical index entries in the same
buffer and significant changes have shifted the entries around, you must
@@ -2371,7 +2515,7 @@ always show the location corresponding to the line in the @file{*Index*}
buffer at point. This is similar to pressing @key{SPC} after each
cursor motion. The default for this flag can be set with the variable
@code{reftex-index-follow-mode}. Note that only context in files
-already visited is shown. @b{Ref@TeX{}} will not visit a file just for
+already visited is shown. @RefTeX{} will not visit a file just for
follow mode. See, however, the variable
@code{reftex-revisit-to-follow}.
@@ -2459,12 +2603,12 @@ will move to the correct position.
@item r
@vindex reftex-enable-partial-scans
-Reparse the LaTeX document and rebuild the @file{*Index*} buffer. When
+Reparse the @LaTeX{} document and rebuild the @file{*Index*} buffer. When
@code{reftex-enable-partial-scans} is non-@code{nil}, rescan only the file this
location is defined in, not the entire document.
@item C-u r
-Reparse the @emph{entire} LaTeX document and rebuild the @file{*Index*}
+Reparse the @emph{entire} @LaTeX{} document and rebuild the @file{*Index*}
buffer.
@item s
@@ -2483,8 +2627,8 @@ indices).
@cindex LaTeX packages, @code{multind}
@cindex LaTeX packages, @code{index}
-@b{Ref@TeX{}} by default recognizes the @code{\index} and
-@code{\glossary} macros which are defined in the LaTeX core. It has
+@RefTeX{} by default recognizes the @code{\index} and
+@code{\glossary} macros which are defined in the @LaTeX{} core. It has
also builtin support for the re-implementations of @code{\index}
in the @file{multind} and @file{index} packages. However, since
the different definitions of the @code{\index} macro are incompatible,
@@ -2513,7 +2657,7 @@ argument in the text and places it into a separate index with the tag
@samp{name}@footnote{We are using the syntax of the @file{index} package
here.}. The last macro also places its argument into the index, but as
subitems under the main index entry @samp{Astronomical Objects}. Here
-is how to make @b{Ref@TeX{}} recognize and correctly interpret these
+is how to make @RefTeX{} recognize and correctly interpret these
macros, first with Emacs Lisp.
@lisp
@@ -2528,7 +2672,7 @@ Note that the index tag is @samp{idx} for the main index, and
for the default index and for the glossary.
The character arguments @code{?x}, @code{?n}, and @code{?o} are for
-quick identification of these macros when @b{Ref@TeX{}} inserts new
+quick identification of these macros when @RefTeX{} inserts new
index entries with @code{reftex-index}. These codes need to be
unique. @code{?i}, @code{?I}, and @code{?g} are reserved for the
@code{\index}, @code{\index*}, and @code{\glossary} macros,
@@ -2589,22 +2733,22 @@ in the buffer with @kbd{C-c /} (@code{reftex-index-selection-or-word}).
The index tag is "idx".
@node Viewing Cross-References, RefTeXs Menu, Index Support, Top
-@chapter Viewing Cross--References
+@chapter Viewing Cross-References
@findex reftex-view-crossref
@findex reftex-mouse-view-crossref
@kindex C-c &
@kindex S-mouse-2
-@b{Ref@TeX{}} can display cross--referencing information. This means,
-if two document locations are linked, @b{Ref@TeX{}} can display the
+@RefTeX{} can display cross-referencing information. This means,
+if two document locations are linked, @RefTeX{} can display the
matching location(s) in another window. The @code{\label} and @code{\ref}
macros are one way of establishing such a link. Also, a @code{\cite}
-macro is linked to the corresponding @code{\bibitem} macro or a BibTeX
+macro is linked to the corresponding @code{\bibitem} macro or a @BibTeX{}
database entry.
The feature is invoked by pressing @kbd{C-c &}
(@code{reftex-view-crossref}) while point is on the @var{key} argument
-of a macro involved in cross--referencing. You can also click with
+of a macro involved in cross-referencing. You can also click with
@kbd{S-mouse-2} on the macro argument. Here is what will happen for
individual classes of macros:
@@ -2615,7 +2759,7 @@ individual classes of macros:
Display the corresponding label definition. All usual
variants@footnote{all macros that start with @samp{ref} or end with
@samp{ref} or @samp{refrange}} of the @code{\ref} macro are active for
-cross--reference display. This works also for labels defined in an
+cross-reference display. This works also for labels defined in an
external document when the current document refers to them through the
@code{xr} interface (@pxref{xr (LaTeX package)}).
@@ -2626,13 +2770,13 @@ Display a document location which references this label. Pressing
@kbd{C-c &} several times moves through the entire document and finds
all locations. Not only the @code{\label} macro but also other macros
with label arguments (as configured with @code{reftex-label-alist}) are
-active for cross--reference display.
+active for cross-reference display.
@item @code{\cite}
@cindex @code{\cite}
-Display the corresponding BibTeX database entry or @code{\bibitem}.
+Display the corresponding @BibTeX{} database entry or @code{\bibitem}.
All usual variants@footnote{all macros that either start or end with
-@samp{cite}} of the @code{\cite} macro are active for cross--reference
+@samp{cite}} of the @code{\cite} macro are active for cross-reference
display.
@item @code{\bibitem}
@@ -2641,12 +2785,12 @@ Display a document location which cites this article. Pressing
@kbd{C-c &} several times moves through the entire document and finds
all locations.
-@item BibTeX
+@item @BibTeX{}
@cindex BibTeX buffer, viewing cite locations from
@cindex Viewing cite locations from BibTeX buffer
-@kbd{C-c &} is also active in BibTeX buffers. All locations in a
+@kbd{C-c &} is also active in @BibTeX{} buffers. All locations in a
document where the database entry at point is cited will be displayed.
-On first use, @b{Ref@TeX{}} will prompt for a buffer which belongs to
+On first use, @RefTeX{} will prompt for a buffer which belongs to
the document you want to search. Subsequent calls will use the same
document, until you break this link with a prefix argument to @kbd{C-c
&}.
@@ -2661,7 +2805,7 @@ and @code{\glossary} macros, all macros configured in
@vindex reftex-view-crossref-extra
While the display of cross referencing information for the above
-mentioned macros is hard--coded, you can configure additional relations
+mentioned macros is hard-coded, you can configure additional relations
in the variable @code{reftex-view-crossref-extra}.
@iftex
@@ -2669,14 +2813,14 @@ in the variable @code{reftex-view-crossref-extra}.
@end iftex
@node RefTeXs Menu, Key Bindings, Viewing Cross-References, Top
-@section @b{Ref@TeX{}}'s Menu
+@section @RefTeX{}'s Menu
@cindex RefTeXs Menu
@cindex Menu, in the menu bar
-@b{Ref@TeX{}} installs a @code{Ref} menu in the menu bar on systems
+@RefTeX{} installs a @code{Ref} menu in the menu bar on systems
which support this. From this menu you can access all of
-@b{Ref@TeX{}}'s commands and a few of its options. There is also a
-@code{Customize} submenu which can be used to access @b{Ref@TeX{}}'s
+@RefTeX{}'s commands and a few of its options. There is also a
+@code{Customize} submenu which can be used to access @RefTeX{}'s
entire set of options.
@node Key Bindings, Faces, RefTeXs Menu, Top
@@ -2713,7 +2857,7 @@ Here is a summary of the available key bindings.
@end example
Note that the @kbd{S-mouse-2} binding is only provided if this key is
-not already used by some other package. @b{Ref@TeX{}} will not override an
+not already used by some other package. @RefTeX{} will not override an
existing binding to @kbd{S-mouse-2}.
Personally, I also bind some functions in the users @kbd{C-c} map for
@@ -2749,7 +2893,7 @@ default. If you want to have these key bindings available, set in your
@end lisp
@vindex reftex-load-hook
-Changing and adding to @b{Ref@TeX{}}'s key bindings is best done in the hook
+Changing and adding to @RefTeX{}'s key bindings is best done in the hook
@code{reftex-load-hook}. For information on the keymaps
which should be used to add keys, see @ref{Keymaps and Hooks}.
@@ -2757,9 +2901,9 @@ which should be used to add keys, see @ref{Keymaps and Hooks}.
@section Faces
@cindex Faces
-@b{Ref@TeX{}} uses faces when available to structure the selection and
+@RefTeX{} uses faces when available to structure the selection and
table of contents buffers. It does not create its own faces, but uses
-the ones defined in @file{font-lock.el}. Therefore, @b{Ref@TeX{}} will
+the ones defined in @file{font-lock.el}. Therefore, @RefTeX{} will
use faces only when @code{font-lock} is loaded. This seems to be
reasonable because people who like faces will very likely have it
loaded. If you wish to turn off fontification or change the involved
@@ -2775,9 +2919,9 @@ files:
@itemize @bullet
@item
-@b{Ref@TeX{}} has full support for multifile documents. You can edit parts of
+@RefTeX{} has full support for multifile documents. You can edit parts of
several (multifile) documents at the same time without conflicts.
-@b{Ref@TeX{}} provides functions to run @code{grep}, @code{search} and
+@RefTeX{} provides functions to run @code{grep}, @code{search} and
@code{query-replace} on all files which are part of a multifile
document.
@@ -2785,10 +2929,10 @@ document.
@vindex tex-main-file
@vindex TeX-master
All files belonging to a multifile document should define a File
-Variable (@code{TeX-master} for AUCTeX or @code{tex-main-file} for the
-standard Emacs LaTeX mode) containing the name of the master file. For
+Variable (@code{TeX-master} for @AUCTeX{} or @code{tex-main-file} for the
+standard Emacs @LaTeX{} mode) containing the name of the master file. For
example, to set the file variable @code{TeX-master}, include something
-like the following at the end of each TeX file:
+like the following at the end of each @TeX{} file:
@example
%%% Local Variables: ***
@@ -2797,7 +2941,7 @@ like the following at the end of each TeX file:
%%% End: ***
@end example
-AUCTeX with the setting
+@AUCTeX{} with the setting
@lisp
(setq-default TeX-master nil)
@@ -2805,14 +2949,14 @@ AUCTeX with the setting
will actually ask you for each new file about the master file and insert
this comment automatically. For more details see the documentation of
-the AUCTeX (@pxref{Multifile,,,auctex, The AUC TeX User Manual}), the
+the @AUCTeX{} (@pxref{Multifile,,,auctex, The AUCTeX User Manual}), the
documentation about the Emacs (La)TeX mode (@pxref{TeX Print,,,emacs,
The GNU Emacs Manual}) and the Emacs documentation on File Variables
(@pxref{File Variables,,,emacs, The GNU Emacs Manual}).
@item
The context of a label definition must be found in the same file as the
-label itself in order to be processed correctly by @b{Ref@TeX{}}. The only
+label itself in order to be processed correctly by @RefTeX{}. The only
exception is that section labels referring to a section statement
outside the current file can still use that section title as
context.
@@ -2822,7 +2966,7 @@ context.
@section Language Support
@cindex Language support
-Some parts of @b{Ref@TeX{}} are language dependent. The default
+Some parts of @RefTeX{} are language dependent. The default
settings work well for English. If you are writing in a different
language, the following hints may be useful:
@@ -2838,7 +2982,7 @@ to be changed for other languages. See the variables
@item
@vindex reftex-translate-to-ascii-function
@vindex reftex-label-illegal-re
-Also, when a label is derived from context, @b{Ref@TeX{}} clears the
+Also, when a label is derived from context, @RefTeX{} clears the
context string from non-ASCII characters in order to make a valid label.
If there should ever be a version of @TeX{} which allows extended
characters @emph{in labels}, then we will have to look at the
@@ -2846,7 +2990,7 @@ variables @code{reftex-translate-to-ascii-function} and
@code{reftex-label-illegal-re}.
@item
-When a label is referenced, @b{Ref@TeX{}} looks at the word before point
+When a label is referenced, @RefTeX{} looks at the word before point
to guess which label type is required. These @emph{magic words} are
different in every language. For an example of how to add magic words,
see @ref{Adding Magic Words}.
@@ -2854,7 +2998,7 @@ see @ref{Adding Magic Words}.
@vindex reftex-multiref-punctuation
@vindex reftex-cite-punctuation
@item
-@b{Ref@TeX{}} inserts ``punctuation'' for multiple references and
+@RefTeX{} inserts ``punctuation'' for multiple references and
for the author list in citations. Some of this may be language
dependent. See the variables @code{reftex-multiref-punctuation} and
@code{reftex-cite-punctuation}.
@@ -2865,25 +3009,25 @@ dependent. See the variables @code{reftex-multiref-punctuation} and
@cindex Finding files
In order to find files included in a document via @code{\input} or
-@code{\include}, @b{Ref@TeX{}} searches all directories specified in the
+@code{\include}, @RefTeX{} searches all directories specified in the
environment variable @code{TEXINPUTS}. Similarly, it will search the
path specified in the variables @code{BIBINPUTS} and @code{TEXBIB} for
-BibTeX database files.
+@BibTeX{} database files.
-When searching, @b{Ref@TeX{}} will also expand recursive path
+When searching, @RefTeX{} will also expand recursive path
definitions (directories ending in @samp{//} or @samp{!!}). But it will
only search and expand directories @emph{explicitly} given in these
variables. This may cause problems under the following circumstances:
@itemize @bullet
@item
-Most TeX system have a default search path for both TeX files and BibTeX
+Most @TeX{} system have a default search path for both @TeX{} files and @BibTeX{}
files which is defined in some setup file. Usually this default path is
-for system files which @b{Ref@TeX{}} does not need to see. But if your
-document needs TeX files or BibTeX database files in a directory only
-given in the default search path, @b{Ref@TeX{}} will fail to find them.
+for system files which @RefTeX{} does not need to see. But if your
+document needs @TeX{} files or @BibTeX{} database files in a directory only
+given in the default search path, @RefTeX{} will fail to find them.
@item
-Some TeX systems do not use environment variables at all in order to
+Some @TeX{} systems do not use environment variables at all in order to
specify the search path. Both default and user search path are then
defined in setup files.
@end itemize
@@ -2896,7 +3040,7 @@ There are three ways to solve this problem:
Specify all relevant directories explicitly in the environment
variables. If for some reason you don't want to mess with the default
variables @code{TEXINPUTS} and @code{BIBINPUTS}, define your own
-variables and configure @b{Ref@TeX{}} to use them instead:
+variables and configure @RefTeX{} to use them instead:
@lisp
(setq reftex-texpath-environment-variables '("MYTEXINPUTS"))
@@ -2904,7 +3048,7 @@ variables and configure @b{Ref@TeX{}} to use them instead:
@end lisp
@item
-Specify the full search path directly in @b{Ref@TeX{}}'s variables.
+Specify the full search path directly in @RefTeX{}'s variables.
@lisp
(setq reftex-texpath-environment-variables
@@ -2914,10 +3058,10 @@ Specify the full search path directly in @b{Ref@TeX{}}'s variables.
@end lisp
@item
-Some TeX systems provide stand--alone programs to do the file search just
-like TeX and BibTeX. E.g. Thomas Esser's @code{teTeX} uses the
+Some @TeX{} systems provide stand-alone programs to do the file search just
+like @TeX{} and @BibTeX{}. E.g. Thomas Esser's @code{teTeX} uses the
@code{kpathsearch} library which provides the command @code{kpsewhich}
-to search for files. @b{Ref@TeX{}} can be configured to use this
+to search for files. @RefTeX{} can be configured to use this
program. Note that the exact syntax of the @code{kpsewhich}
command depends upon the version of that program.
@@ -2935,8 +3079,8 @@ command depends upon the version of that program.
Some people like to use RefTeX with noweb files, which usually have the
extension @file{.nw}. In order to deal with such files, the new
extension must be added to the list of valid extensions in the variable
-@code{reftex-file-extensions}. When working with AUCTeX as major mode,
-the new extension must also be known to AUCTeX via the variable
+@code{reftex-file-extensions}. When working with @AUCTeX{} as major mode,
+the new extension must also be known to @AUCTeX{} via the variable
@code{TeX-file-extension}. For example:
@lisp
@@ -2956,15 +3100,15 @@ am leaving this stuff in the manual for people who want to write thick
books, where some of it still might be useful.}
Implementing the principle of least surprises, the default settings of
-@b{Ref@TeX{}} ensure a safe ride for beginners and casual users. However,
-when using @b{Ref@TeX{}} for a large project and/or on a small computer,
+@RefTeX{} ensure a safe ride for beginners and casual users. However,
+when using @RefTeX{} for a large project and/or on a small computer,
there are ways to improve speed or memory usage.
@itemize @bullet
@item
@b{Removing Lookup Buffers}@*
@cindex Removing lookup buffers
-@b{Ref@TeX{}} will load other parts of a multifile document as well as BibTeX
+@RefTeX{} will load other parts of a multifile document as well as @BibTeX{}
database files for lookup purposes. These buffers are kept, so that
subsequent use of the same files is fast. If you can't afford keeping
these buffers around, and if you can live with a speed penalty, try
@@ -2978,13 +3122,13 @@ these buffers around, and if you can live with a speed penalty, try
@b{Partial Document Scans}@*
@cindex Partial documents scans
@cindex Document scanning, partial
-A @kbd{C-u} prefix on the major @b{Ref@TeX{}} commands @code{reftex-label}
+A @kbd{C-u} prefix on the major @RefTeX{} commands @code{reftex-label}
(@kbd{C-u C-c (}), @code{reftex-reference} (@kbd{C-u C-c )}),
@code{reftex-citation} (@kbd{C-u C-c [}), @code{reftex-toc} (@kbd{C-u C-c
=}), and @code{reftex-view-crossref} (@kbd{C-u C-c &}) initiates
re-parsing of the entire document in order to update the parsing
information. For a large document this can be unnecessary, in
-particular if only one file has changed. @b{Ref@TeX{}} can be configured
+particular if only one file has changed. @RefTeX{} can be configured
to do partial scans instead of full ones. @kbd{C-u} re-parsing then
does apply only to the current buffer and files included from it.
Likewise, the @kbd{r} key in both the label selection buffer and the
@@ -3004,7 +3148,7 @@ try
@cindex Saving parser information
@cindex Parse information, saving to a file
@vindex reftex-parse-file-extension
-Even with partial scans enabled, @b{Ref@TeX{}} still has to make one full
+Even with partial scans enabled, @RefTeX{} still has to make one full
scan, when you start working with a document. To avoid this, parsing
information can be stored in a file. The file @file{MASTER.rel} is used
for storing information about a document with master file
@@ -3022,11 +3166,11 @@ session. To use this feature, put into @file{.emacs}:
@b{Identifying label types by prefix}@*
@cindex Parse information, saving to a file
@vindex reftex-trust-label-prefix
-@b{Ref@TeX{}} normally parses around each label to check in which
+@RefTeX{} normally parses around each label to check in which
environment this label is located, in order to assign a label type to
the label. If your document contains thousands of labels, document
parsing will take considerable time. If you have been using label prefixes
-like tab: and fn: consistently, you can tell @b{Ref@TeX{}} to get the
+like tab: and fn: consistently, you can tell @RefTeX{} to get the
label type directly from the prefix, without additional parsing. This
will be faster and also allow labels to end up in the correct category
if for some reason it is not possible to derive the correct type from
@@ -3041,7 +3185,7 @@ equation labels, use
@b{Automatic Document Scans}@*
@cindex Automatic document scans
@cindex Document scanning, automatic
-At rare occasions, @b{Ref@TeX{}} will automatically rescan a part of the
+At rare occasions, @RefTeX{} will automatically rescan a part of the
document. If this gets into your way, it can be turned off with
@vindex reftex-allow-automatic-rescan
@@ -3049,7 +3193,7 @@ document. If this gets into your way, it can be turned off with
(setq reftex-allow-automatic-rescan nil)
@end lisp
-@b{Ref@TeX{}} will then occasionally annotate new labels in the selection
+@RefTeX{} will then occasionally annotate new labels in the selection
buffer, saying that their position in the label list in uncertain. A
manual document scan will fix this.
@@ -3059,7 +3203,7 @@ manual document scan will fix this.
@cindex Selection buffers, multiple
Normally, the selection buffer @file{*RefTeX Select*} is re-created for
every selection process. In documents with very many labels this can
-take several seconds. @b{Ref@TeX{}} provides an option to create a
+take several seconds. @RefTeX{} provides an option to create a
separate selection buffer for each label type and to keep this buffer
from one selection to the next. These buffers are updated automatically
only when a new label has been added in the buffers category with
@@ -3089,7 +3233,7 @@ with the @kbd{g} key. To get this behavior, use instead
@need 2000
@noindent
@b{As a summary}, here are the settings I recommend for heavy use of
-@b{Ref@TeX{}} with large documents:
+@RefTeX{} with large documents:
@lisp
@group
@@ -3100,30 +3244,30 @@ with the @kbd{g} key. To get this behavior, use instead
@end lisp
@node AUCTeX, Multifile Documents, Faces, Top
-@section AUC@TeX{}
+@section @AUCTeX{}
@cindex @code{AUCTeX}, Emacs package
@cindex Emacs packages, @code{AUCTeX}
-AUCTeX is without doubt the best major mode for editing TeX and LaTeX
+@AUCTeX{} is without doubt the best major mode for editing @TeX{} and @LaTeX{}
files with Emacs (@pxref{Top,AUCTeX,,auctex, The AUCTeX User Manual}).
-If AUCTeX is not part of your Emacs distribution, you can get
+If @AUCTeX{} is not part of your Emacs distribution, you can get
it@footnote{XEmacs 21.x users may want to install the corresponding
-XEmacs package.} by ftp from the @value{AUCTEXSITE}.
+XEmacs package.} by FTP from the @value{AUCTEXSITE}.
@menu
* AUCTeX-RefTeX Interface:: How both packages work together
-* Style Files:: AUCTeX's style files can support RefTeX
+* Style Files:: @AUCTeX{}'s style files can support RefTeX
* Bib-Cite:: Hypertext reading of a document
@end menu
@node AUCTeX-RefTeX Interface, Style Files, , AUCTeX
-@subsection The AUC@TeX{}-@b{Ref@TeX{}} Interface
+@subsection The @AUCTeX{}-@RefTeX{} Interface
-@b{Ref@TeX{}} contains code to interface with AUCTeX. When this
+@RefTeX{} contains code to interface with @AUCTeX{}. When this
interface is turned on, both packages will interact closely. Instead of
-using @b{Ref@TeX{}}'s commands directly, you can then also use them
-indirectly as part of the AUCTeX
-environment@footnote{@b{Ref@TeX{}} 4.0 and AUCTeX 9.10c will be
+using @RefTeX{}'s commands directly, you can then also use them
+indirectly as part of the @AUCTeX{}
+environment@footnote{@RefTeX{} 4.0 and @AUCTeX{} 9.10c will be
needed for all of this to work. Parts of it work also with earlier
versions.}. The interface is turned on with
@@ -3146,12 +3290,12 @@ The following list describes the individual parts of the interface.
@kindex C-c C-s
@findex LaTeX-section, @r{AUCTeX}
@findex TeX-insert-macro, @r{AUCTeX}
-@b{AUCTeX calls @code{reftex-label} to insert labels}@*
+@b{@AUCTeX{} calls @code{reftex-label} to insert labels}@*
When a new section is created with @kbd{C-c C-s}, or a new environment
-is inserted with @kbd{C-c C-e}, AUCTeX normally prompts for a label to
+is inserted with @kbd{C-c C-e}, @AUCTeX{} normally prompts for a label to
go with it. With the interface, @code{reftex-label} is called instead.
-For example, if you type @kbd{C-c C-e equation @key{RET}}, AUCTeX and
-@b{Ref@TeX{}} will insert
+For example, if you type @kbd{C-c C-e equation @key{RET}}, @AUCTeX{} and
+@RefTeX{} will insert
@example
\begin@{equation@}
@@ -3163,12 +3307,12 @@ For example, if you type @kbd{C-c C-e equation @key{RET}}, AUCTeX and
@noindent
without further prompts.
-Similarly, when you type @kbd{C-c C-s section @key{RET}}, @b{Ref@TeX{}}
+Similarly, when you type @kbd{C-c C-s section @key{RET}}, @RefTeX{}
will offer its default label which is derived from the section title.
@item
-@b{AUCTeX tells @b{Ref@TeX{}} about new sections}@*
-When creating a new section with @kbd{C-c C-s}, @b{Ref@TeX{}} will not
+@b{@AUCTeX{} tells @RefTeX{} about new sections}@*
+When creating a new section with @kbd{C-c C-s}, @RefTeX{} will not
have to rescan the buffer in order to see it.
@item
@@ -3182,44 +3326,44 @@ have to rescan the buffer in order to see it.
@findex TeX-arg-index, @r{AUCTeX function}
@findex TeX-insert-macro, @r{AUCTeX function}
@kindex C-c @key{RET}
-@b{@b{Ref@TeX{}} supplies macro arguments}@* When you insert a macro
-interactively with @kbd{C-c @key{RET}}, AUCTeX normally prompts for
+@b{@RefTeX{} supplies macro arguments}@* When you insert a macro
+interactively with @kbd{C-c @key{RET}}, @AUCTeX{} normally prompts for
macro arguments. Internally, it uses the functions
@code{TeX-arg-label}, @code{TeX-arg-cite}, and @code{TeX-arg-index} to
prompt for arguments which are labels, citation keys and index entries.
The interface takes over these functions@footnote{@code{fset} is used to
-do this, which is not reversible. However, @b{Ref@TeX{}} implements the
+do this, which is not reversible. However, @RefTeX{} implements the
old functionality when you later decide to turn off the interface.} and
-supplies the macro arguments with @b{Ref@TeX{}'s} mechanisms. For
-example, when you type @kbd{C-c @key{RET} ref @key{RET}}, @b{Ref@TeX{}}
+supplies the macro arguments with @b{@RefTeX{}'s} mechanisms. For
+example, when you type @kbd{C-c @key{RET} ref @key{RET}}, @RefTeX{}
will supply its label selection process (@pxref{Referencing
Labels}).
@item
-@b{@b{Ref@TeX{}} tells AUCTeX about new labels, citation-- and index keys}@*
-@b{Ref@TeX{}} will add all newly created labels to AUCTeX's completion list.
+@b{@RefTeX{} tells @AUCTeX{} about new labels, citation and index keys}@*
+@RefTeX{} will add all newly created labels to @AUCTeX{}'s completion list.
@end itemize
@node Style Files, Bib-Cite, AUCTeX-RefTeX Interface, AUCTeX
@subsection Style Files
@cindex Style files, AUCTeX
@findex TeX-add-style-hook, @r{AUCTeX}
-Style files are Emacs Lisp files which are evaluated by AUCTeX in
+Style files are Emacs Lisp files which are evaluated by @AUCTeX{} in
association with the @code{\documentclass} and @code{\usepackage}
commands of a document (@pxref{Style Files,,,auctex}). Support for
-@b{Ref@TeX{}} in such a style file is useful when the LaTeX style
+@RefTeX{} in such a style file is useful when the @LaTeX{} style
defines macros or environments connected with labels, citations, or the
index. Many style files (e.g. @file{amsmath.el} or @file{natbib.el})
-distributed with AUCTeX already support @b{Ref@TeX{}} in this
+distributed with @AUCTeX{} already support @RefTeX{} in this
way.
-Before calling a @b{Ref@TeX{}} function, the style hook should always
+Before calling a @RefTeX{} function, the style hook should always
test for the availability of the function, so that the style file will
-also work for people who do not use @b{Ref@TeX{}}.
+also work for people who do not use @RefTeX{}.
Additions made with style files in the way described below remain local
to the current document. For example, if one package uses AMSTeX, the
-style file will make @b{Ref@TeX{}} switch over to @code{\eqref}, but
+style file will make @RefTeX{} switch over to @code{\eqref}, but
this will not affect other documents.
@findex reftex-add-label-environments
@@ -3230,7 +3374,7 @@ function @code{reftex-add-to-label-alist} which is still available as an
alias for compatibility.} which defines additions to
@code{reftex-label-alist}. The argument taken by this function must have
the same format as @code{reftex-label-alist}. The @file{amsmath.el}
-style file of AUCTeX for example contains the following:
+style file of @AUCTeX{} for example contains the following:
@lisp
@group
@@ -3262,7 +3406,7 @@ with @code{\newtheorem} might use
Similarly, a style hook may contain a call to
@code{reftex-set-cite-format} to set the citation format. The style
file @file{natbib.el} for the Natbib citation style does switch
-@b{Ref@TeX{}}'s citation format like this:
+@RefTeX{}'s citation format like this:
@lisp
(TeX-add-style-hook "natbib"
@@ -3286,7 +3430,7 @@ the style @file{multind.el} contains
@end lisp
If you have your own package @file{myindex} which defines the
-following macros to be used with the LaTeX @file{index.sty} file
+following macros to be used with the @LaTeX{} @file{index.sty} file
@example
\newcommand@{\molec@}[1]@{#1\index@{Molecules!#1@}@}
\newcommand@{\aindex@}[1]@{#1\index[author]@{#1@}
@@ -3310,7 +3454,7 @@ you could write this in the style file @file{myindex.el}:
Finally the hook may contain a call to @code{reftex-add-section-levels}
to define additional section statements. For example, the FoilTeX class
has just two headers, @code{\foilhead} and @code{\rotatefoilhead}. Here
-is a style file @file{foils.el} that will inform @b{Ref@TeX{}} about these:
+is a style file @file{foils.el} that will inform @RefTeX{} about these:
@lisp
(TeX-add-style-hook "foils"
@@ -3326,20 +3470,20 @@ is a style file @file{foils.el} that will inform @b{Ref@TeX{}} about these:
@cindex Emacs packages, @code{bib-cite}
Once you have written a document with labels, references and citations,
-it can be nice to read it like a hypertext document. @b{Ref@TeX{}} has
+it can be nice to read it like a hypertext document. @RefTeX{} has
support for that: @code{reftex-view-crossref} (bound to @kbd{C-c
&}), @code{reftex-mouse-view-crossref} (bound to @kbd{S-mouse-2}), and
@code{reftex-search-document}. A somewhat fancier interface with mouse
highlighting is provided (among other things) by Peter S. Galbraith's
@file{bib-cite.el}. There is some overlap in the functionalities of
-Bib-cite and @b{Ref@TeX{}}. Bib-cite.el comes bundled with
-AUCTeX.
+Bib-cite and @RefTeX{}. Bib-cite.el comes bundled with
+@AUCTeX{}.
Bib-cite version 3.06 and later can be configured so that bib-cite's
-mouse functions use @b{Ref@TeX{}} for displaying references and citations.
-This can be useful in particular when working with the LaTeX @code{xr}
+mouse functions use @RefTeX{} for displaying references and citations.
+This can be useful in particular when working with the @LaTeX{} @code{xr}
package or with an explicit @code{thebibliography} environment (rather
-than BibTeX). Bib-cite cannot handle those, but @b{Ref@TeX{}} does. To
+than @BibTeX{}). Bib-cite cannot handle those, but @RefTeX{} does. To
make use of this feature, try
@vindex bib-cite-use-reftex-view-crossref
@@ -3354,7 +3498,7 @@ make use of this feature, try
@itemize @bullet
@item
-@b{LaTeX commands}@*
+@b{@LaTeX{} commands}@*
@cindex LaTeX commands, not found
@code{\input}, @code{\include}, and @code{\section} (etc.) statements
have to be first on a line (except for white space).
@@ -3362,7 +3506,7 @@ have to be first on a line (except for white space).
@item
@b{Commented regions}@*
@cindex Labels, commented out
-@b{Ref@TeX{}} sees also labels in regions commented out and will refuse to
+@RefTeX{} sees also labels in regions commented out and will refuse to
make duplicates of such labels. This is considered to be a feature.
@item
@@ -3382,7 +3526,7 @@ scan will fix this.
The label environment definitions in @code{reftex-label-alist} are
global and apply to all documents. If you need to make definitions
local to a document, because they would interfere with settings in other
-documents, you should use AUCTeX and set up style files with calls to
+documents, you should use @AUCTeX{} and set up style files with calls to
@code{reftex-add-label-environments}, @code{reftex-set-cite-format},
@code{reftex-add-index-macros}, and @code{reftex-add-section-levels}.
Settings made with these functions remain local to the current
@@ -3398,9 +3542,9 @@ document. @xref{AUCTeX}.
@cindex Emacs packages, @code{iso-cvt}
When using packages which make the buffer representation of a file
different from its disk representation (e.g. x-symbol, isotex,
-iso-cvt) you may find that @b{Ref@TeX{}}'s parsing information sometimes
+iso-cvt) you may find that @RefTeX{}'s parsing information sometimes
reflects the disk state of a file. This happens only in @emph{unvisited}
-parts of a multifile document, because @b{Ref@TeX{}} visits these files
+parts of a multifile document, because @RefTeX{} visits these files
literally for speed reasons. Then both short context and section
headings may look different from what you usually see on your screen.
In rare cases @code{reftex-toc} may have problems to jump to an affected
@@ -3410,7 +3554,7 @@ this:
@item
@vindex reftex-keep-temporary-buffers
@code{(setq reftex-keep-temporary-buffers t)}@*
-This implies that @b{Ref@TeX{}} will load all parts of a multifile
+This implies that @RefTeX{} will load all parts of a multifile
document into Emacs (i.e. there won't be any temporary buffers).
@item
@vindex reftex-initialize-temporary-buffers
@@ -3437,7 +3581,7 @@ to specify a label. E.g. Lamport's @file{pf.sty} uses both
@end example
@noindent
-We need to trick @b{Ref@TeX{}} into swallowing this:
+We need to trick @RefTeX{} into swallowing this:
@lisp
@group
@@ -3450,7 +3594,7 @@ We need to trick @b{Ref@TeX{}} into swallowing this:
@noindent
The first line is just a normal configuration for a macro. For the
-@code{step+} environment we actually tell @b{Ref@TeX{}} to look for the
+@code{step+} environment we actually tell @RefTeX{} to look for the
@emph{macro} @samp{\begin@{step+@}} and interpret the @emph{first}
argument (which really is a second argument to the macro @code{\begin})
as a label of type @code{?p}. Argument count for this macro starts only
@@ -3462,7 +3606,7 @@ context.
@cindex Idle timer restart
@vindex reftex-use-itimer-in-xemacs
In XEmacs, idle timer restart does not work reliably after fast
-keystrokes. Therefore @b{Ref@TeX{}} currently uses the post command
+keystrokes. Therefore @RefTeX{} currently uses the post command
hook to start the timer used for automatic crossref information. When
this bug gets fixed, a real idle timer can be requested with
@lisp
@@ -3475,7 +3619,7 @@ this bug gets fixed, a real idle timer can be requested with
@cindex Key bindings, problems with Viper mode
@findex viper-harness-minor-mode
With @i{Viper} mode prior to Vipers version 3.01, you need to protect
-@b{Ref@TeX{}}'s keymaps with
+@RefTeX{}'s keymaps with
@lisp
(viper-harness-minor-mode "reftex")
@@ -3491,15 +3635,15 @@ With @i{Viper} mode prior to Vipers version 3.01, you need to protect
@cindex Acknowledgments
@cindex Thanks
@cindex Bug reports
-@cindex @code{http}, @b{Ref@TeX{}} home page
-@cindex @code{ftp}, @b{Ref@TeX{}} site
+@cindex @code{http}, @RefTeX{} home page
+@cindex @code{ftp}, @RefTeX{} site
-Ref@TeX{} was written by @i{Carsten Dominik}
+@RefTeX{} was written by @i{Carsten Dominik}
@email{dominik@@science.uva.nl}, with contributions by @i{Stephen
-Eglen}. Ref@TeX{} is currently maintained by @value{MAINTAINER}, see
+Eglen}. @RefTeX{} is currently maintained by @value{MAINTAINER}, see
the @value{MAINTAINERSITE} for detailed information.
-If you have questions about Ref@TeX{}, you can send email to the
+If you have questions about @RefTeX{}, you can send email to the
@value{SUPPORTADDRESS}. If you want to contribute code or ideas, write
to the @value{DEVELADDRESS}. And in the rare case of finding a bug,
please use @kbd{M-x reftex-report-bug @key{RET}} which will prepare a
@@ -3512,42 +3656,31 @@ There are also several Usenet groups which have competent readers who
might be able to help: @code{comp.emacs}, @code{gnu.emacs.help},
@code{comp.emacs.xemacs}, and @code{comp.text.tex}.
-@b{Ref@TeX{}} is bundled and pre-installed with Emacs since version 20.2.
-It was also bundled and pre-installed with XEmacs 19.16--20.x. XEmacs
-21.x users want to install the corresponding plugin package which is
-available from the @value{XEMACSFTP}. See the XEmacs 21.x
-documentation on package installation for details.
-
-Users of earlier Emacs distributions (including Emacs 19) can get a
-@b{Ref@TeX{}} distribution from the @value{MAINTAINERSITE}. Note that
-the Emacs 19 version supports many but not all features described in
-this manual.
-
-Thanks to the people on the Net who have used @b{Ref@TeX{}} and helped
+Thanks to the people on the Net who have used @RefTeX{} and helped
developing it with their reports. In particular thanks to @i{Ralf
Angeli, Fran Burstall, Alastair Burt, Lars Clausen, Soren Dayton,
Stephen Eglen, Karl Eichwalder, Erik Frisk, Peter Galbraith, Kai
Grossjohann, Frank Harrell, Till A. Heilmann, Peter Heslin, Stephan
Heuel, Alan Ho, Lute Kamstra, Dieter Kraft, David Kastrup, Adrian Lanz,
-Juri Linkov, Rory Molinari, Stefan Monnier, Laurent Mugnier, Dan
-Nicolaescu, Sudeep Kumar Palat, Daniel Polani, Alan Shutko, Robin Socha,
-Richard Stanton, Allan Strand, Jan Vroonhof, Christoph Wedler, Alan
-Williams, Roland Winkler, Hans-Christoph Wirth, Eli Zaretskii}.
-
+Juri Linkov, Wolfgang Mayer, Rory Molinari, Stefan Monnier, Laurent
+Mugnier, Dan Nicolaescu, Sudeep Kumar Palat, Daniel Polani, Alan Shutko,
+Robin Socha, Richard Stanton, Allan Strand, Jan Vroonhof, Christoph
+Wedler, Alan Williams, Roland Winkler, Hans-Christoph Wirth, Eli
+Zaretskii}.
The @code{view-crossref} feature was inspired by @i{Peter Galbraith's}
@file{bib-cite.el}.
Finally thanks to @i{Uwe Bolick} who first got me interested in
-supporting LaTeX labels and references with an editor (which was
+supporting @LaTeX{} labels and references with an editor (which was
MicroEmacs at the time).
@node Commands, Options, Imprint, Top
@chapter Commands
@cindex Commands, list of
-Here is a summary of @b{Ref@TeX{}}'s commands which can be executed from
-LaTeX files. Command which are executed from the special buffers are
+Here is a summary of @RefTeX{}'s commands which can be executed from
+@LaTeX{} files. Command which are executed from the special buffers are
not described here. All commands are available from the @code{Ref}
menu. See @xref{Key Bindings}.
@@ -3567,8 +3700,8 @@ it. With one or two @kbd{C-u} prefixes, enforce document rescan first.
@end deffn
@deffn Command reftex-citation
-Make a citation using BibTeX database files. After prompting for a regular
-expression, scans the buffers with BibTeX entries (taken from the
+Make a citation using @BibTeX{} database files. After prompting for a regular
+expression, scans the buffers with @BibTeX{} entries (taken from the
@code{\bibliography} command or a @code{thebibliography} environment)
and offers the matching entries for selection. The selected entry is
formatted according to @code{reftex-cite-format} and inserted into the
@@ -3588,8 +3721,8 @@ expression to match all entries in all files.
@deffn Command reftex-index
Query for an index macro and insert it along with its arguments. The
index macros available are those defined in @code{reftex-index-macro} or
-by a call to @code{reftex-add-index-macros}, typically from an AUCTeX
-style file. @b{Ref@TeX{}} provides completion for the index tag and the
+by a call to @code{reftex-add-index-macros}, typically from an @AUCTeX{}
+style file. @RefTeX{} provides completion for the index tag and the
index key, and will prompt for other arguments.
@end deffn
@@ -3600,8 +3733,8 @@ to make an index entry. The phrase indexed is the current selection or
the word near point. When called with one @kbd{C-u} prefix, let the
user have a chance to edit the index entry. When called with 2
@kbd{C-u} as prefix, also ask for the index macro and other stuff. When
-called inside TeX math mode as determined by the @file{texmathp.el}
-library which is part of AUCTeX, the string is first processed with the
+called inside @TeX{} math mode as determined by the @file{texmathp.el}
+library which is part of @AUCTeX{}, the string is first processed with the
@code{reftex-index-math-format}, which see.
@end deffn
@@ -3610,7 +3743,7 @@ Add current selection or the word at point to the phrases buffer.
When you are in transient-mark-mode and the region is active, the
selection will be used - otherwise the word at point.
You get a chance to edit the entry in the phrases buffer - to save the
-buffer and return to the LaTeX document, finish with @kbd{C-c C-c}.
+buffer and return to the @LaTeX{} document, finish with @kbd{C-c C-c}.
@end deffn
@deffn Command reftex-index-visit-phrases-buffer
@@ -3644,9 +3777,9 @@ the command @code{reftex-view-crossref-from-bibtex}. With one or two
@end deffn
@deffn Command reftex-view-crossref-from-bibtex
-View location in a LaTeX document which cites the BibTeX entry at point.
-Since BibTeX files can be used by many LaTeX documents, this function
-prompts upon first use for a buffer in @b{Ref@TeX{}} mode. To reset this
+View location in a @LaTeX{} document which cites the @BibTeX{} entry at point.
+Since @BibTeX{} files can be used by many @LaTeX{} documents, this function
+prompts upon first use for a buffer in @RefTeX{} mode. To reset this
link to a document, call the function with a prefix arg. Calling
this function several times find successive citation locations.
@end deffn
@@ -3677,7 +3810,7 @@ active TAGS table is required.
@deffn Command reftex-isearch-minor-mode
Toggle a minor mode which enables incremental search to work globally
-on the entire multifile document. Files will be searched in th
+on the entire multifile document. Files will be searched in the
sequence they appear in the document.
@end deffn
@@ -3699,7 +3832,7 @@ Renumber all simple labels in the document to make them sequentially.
Simple labels are the ones created by RefTeX, consisting only of the
prefix and a number. After the command completes, all these labels will
have sequential numbers throughout the document. Any references to the
-labels will be changed as well. For this, @b{Ref@TeX{}} looks at the
+labels will be changed as well. For this, @RefTeX{} looks at the
arguments of any macros which either start or end with the string
@samp{ref}. This command should be used with care, in particular in
multifile documents. You should not use it if another document refers
@@ -3711,21 +3844,30 @@ Produce a list of all duplicate labels in the document.
@end deffn
@deffn Command reftex-create-bibtex-file
-Create a new BibTeX database file with all entries referenced in document.
-The command prompts for a filename and writes the collected entries to
-that file. Only entries referenced in the current document with
-any @code{\cite}-like macros are used.
-The sequence in the new file is the same as it was in the old database.
+@vindex reftex-create-bibtex-header
+@vindex reftex-create-bibtex-footer
+Create a new @BibTeX{} database file with all entries referenced in
+document. The command prompts for a filename and writes the collected
+entries to that file. Only entries referenced in the current document
+with any @code{\cite}-like macros are used. The sequence in the new
+file is the same as it was in the old database.
+
+Entries referenced from other entries must appear after all referencing
+entries.
+
+You can define strings to be used as header or footer for the created
+files in the variables @code{reftex-create-bibtex-header} or
+@code{reftex-create-bibtex-footer} respectively.
@end deffn
@deffn Command reftex-customize
-Run the customize browser on the @b{Ref@TeX{}} group.
+Run the customize browser on the @RefTeX{} group.
@end deffn
@deffn Command reftex-show-commentary
Show the commentary section from @file{reftex.el}.
@end deffn
@deffn Command reftex-info
-Run info on the top @b{Ref@TeX{}} node.
+Run info on the top @RefTeX{} node.
@end deffn
@deffn Command reftex-parse-document
Parse the entire document in order to update the parsing information.
@@ -3739,7 +3881,7 @@ removes the parse file associated with the current document.
@chapter Options, Keymaps, Hooks
@cindex Options, list of
-Here is a complete list of @b{Ref@TeX{}}'s configuration variables. All
+Here is a complete list of @RefTeX{}'s configuration variables. All
variables have customize support - so if you are not familiar with Emacs
Lisp (and even if you are) you might find it more comfortable to use
@code{customize} to look at and change these variables. @kbd{M-x
@@ -3765,14 +3907,14 @@ reftex-customize} will get you there.
@cindex Table of contents, options
@defopt reftex-include-file-commands
-List of LaTeX commands which input another file.
+List of @LaTeX{} commands which input another file.
The file name is expected after the command, either in braces or separated
by whitespace.
@end defopt
@defopt reftex-max-section-depth
Maximum depth of section levels in document structure.
-Standard LaTeX needs 7, default is 12.
+Standard @LaTeX{} needs 7, default is 12.
@end defopt
@defopt reftex-section-levels
@@ -3819,7 +3961,7 @@ only in that frame. So when creating that frame (with @kbd{d} key in an
ordinary TOC window), the automatic recentering is turned on. When the
frame gets destroyed, automatic recentering is turned off again.
-This feature can be turned on and off from the menu
+This feature can be turned on and off from the menu
(Ref->Options).
@end defopt
@@ -3910,7 +4052,7 @@ itself and has the following structure:
@end example
Each list entry describes either an environment carrying a counter for
-use with @code{\label} and @code{\ref}, or a LaTeX macro defining a
+use with @code{\label} and @code{\ref}, or a @LaTeX{} macro defining a
label as (or inside) one of its arguments. The elements of each list
entry are:
@@ -3947,7 +4089,7 @@ list, to cover cases in which different environments carry the same
label type (like @code{equation} and @code{eqnarray}). If the type
indicator is @code{nil} and the macro has a label argument @samp{@{*@}},
the macro defines neutral labels just like @code{\label}. In this case
-the reminder of this entry is ignored.
+the remainder of this entry is ignored.
@item @var{label-prefix}
Label prefix string, like @samp{tab:}. The prefix is a short string
@@ -3968,7 +4110,7 @@ Example: In a file @file{intro.tex}, @samp{eq:%f:} will become
@samp{eq:intro:}.
@item @var{reference-format}
-Format string for reference insert in buffer. @samp{%s} will be
+Format string for reference insertion in buffer. @samp{%s} will be
replaced by the label. When the format starts with @samp{~}, this
@samp{~} will only be inserted when the character before point is
@emph{not} a whitespace.
@@ -3996,7 +4138,7 @@ If an integer, use the nth argument of the macro. As a special case,
1000 means to get text after the last macro argument.
@item
If a string, use as regexp to search @emph{backward} from the label.
-Context is then the text following the end of the match. E.g. putting
+Context is then the text following the end of the match. E.g. setting
this to @samp{\\caption[[@{]} will use the caption in a figure or table
environment. @samp{\\begin@{eqnarray@}\|\\\\} works for
eqnarrays.
@@ -4021,7 +4163,7 @@ context:
@end example
@end itemize
-Label context is used in two ways by @b{Ref@TeX{}}: For display in the label
+Label context is used in two ways by @RefTeX{}: For display in the label
menu, and to derive a label string. If you want to use a different
method for each of these, specify them as a dotted pair.
E.g. @code{(nil . t)} uses the text after the label (@code{nil}) for
@@ -4033,7 +4175,7 @@ List of magic words which identify a reference to be of this type. If
the word before point is equal to one of these words when calling
@code{reftex-reference}, the label list offered will be automatically
restricted to labels of the correct type. If the first element of this
-word--list is the symbol `regexp', the strings are interpreted as regular
+word list is the symbol `regexp', the strings are interpreted as regular
expressions.
@item @var{toc-level}
@@ -4047,7 +4189,7 @@ made.
@end table
If the type indicator characters of two or more entries are the same,
-@b{Ref@TeX{}} will use
+@RefTeX{} will use
@itemize @minus
@item
the first non-@code{nil} format and prefix
@@ -4081,7 +4223,7 @@ replaced with the environment or macro.
@defopt reftex-trust-label-prefix
Non-@code{nil} means, trust the label prefix when determining label type.
It is customary to use special label prefixes to distinguish different label
-types. The label prefixes have no syntactic meaning in LaTeX (unless
+types. The label prefixes have no syntactic meaning in @LaTeX{} (unless
special packages like fancyref) are being used. RefTeX can and by
default does parse around each label to detect the correct label type,
but this process can be slow when a document contains thousands of
@@ -4095,7 +4237,7 @@ Possible values for this option are:
t @r{This means to trust any label prefixes found.}
regexp @r{If a regexp, only prefixes matched by the regexp are trusted.}
list @r{List of accepted prefixes, as strings. The colon is part of}
- @r{the prefix, e.g. ("fn:" "eqn:" "item:").}
+ @r{the prefix, e.g. ("fn:" "eqn:" "item:").}
nil @r{Never trust a label prefix.}
@end example
The only disadvantage of using this feature is that the label context
@@ -4122,7 +4264,7 @@ Flags governing label insertion. The value has the form
(@var{derive} @var{prompt})
@end example
-If @var{derive}is @code{t}, @b{Ref@TeX{}} will try to derive a sensible
+If @var{derive} is @code{t}, @RefTeX{} will try to derive a sensible
label from context. A section label for example will be derived from
the section heading. The conversion of the context to a valid label is
governed by the specifications given in
@@ -4171,7 +4313,7 @@ buffer.
@deffn Hook reftex-string-to-label-function
Function to turn an arbitrary string into a valid label.
-@b{Ref@TeX{}}'s default function uses the variable
+@RefTeX{}'s default function uses the variable
@code{reftex-derive-label-parameters}.
@end deffn
@@ -4278,35 +4420,38 @@ This is used to string together whole reference sets, like
@code{reftex-reference}.
@end defopt
-@defopt reftex-vref-is-default
-Non-@code{nil} means, the varioref macro @code{\vref} is used as
-default. In the selection buffer, the @kbd{v} key toggles the reference
-macro between @code{\ref} and @code{\vref}. The value of this variable
-determines the default which is active when entering the selection
-process. Instead of @code{nil} or @code{t}, this may also be a string
-of type letters indicating the label types for which it should be
-true.
+@defopt reftex-ref-style-alist
+Alist of reference styles. Each element is a list of the style name,
+the name of the @LaTeX{} package associated with the style or @code{t}
+for any package, and an alist of macros where the first entry of each
+item is the reference macro and the second a key for selecting the macro
+when the macro type is being prompted for. (See also
+@code{reftex-ref-macro-prompt}.) The keys, represented as characters,
+have to be unique.
+@end defopt
+
+@defopt reftex-ref-style-default-list
+List of reference styles to be activated by default. The order is
+significant and controls the order in which macros can be cycled in the
+buffer for selecting a label. The entries in the list have to match the
+respective reference style names used in the variable
+@code{reftex-ref-style-alist}.
@end defopt
-@defopt reftex-fref-is-default
-Non-@code{nil} means, the fancyref macro @code{\fref} is used as
-default. In the selection buffer, the @kbd{V} key toggles the reference
-macro between @code{\ref}, @code{\fref} and @code{\Fref}. The value of
-this variable determines the default which is active when entering the
-selection process. Instead of @code{nil} or @code{t}, this may also be
-a string of type letters indicating the label types for which it should
-be true.
+@defopt reftex-ref-macro-prompt
+Controls if @code{reftex-reference} prompts for the reference macro.
@end defopt
@deffn Hook reftex-format-ref-function
If non-@code{nil}, should be a function which produces the string to
insert as a reference. Note that the insertion format can also be
changed with @code{reftex-label-alist}. This hook also is used by the
-special commands to insert @code{\vref} and @code{\fref} references, so
-even if you set this, your setting will be ignored by the special
-commands. The function will be called with two arguments, the
-@var{label} and the @var{default-format} (usually @samp{~\ref@{%s@}}).
-It should return the string to insert into the buffer.
+special commands to insert e.g. @code{\vref} and @code{\fref}
+references, so even if you set this, your setting will be ignored by the
+special commands. The function will be called with three arguments, the
+@var{label}, the @var{default format} which normally is
+@samp{~\ref@{%s@}} and the @var{reference style}. The function should
+return the string to insert into the buffer.
@end deffn
@defopt reftex-level-indent
@@ -4315,11 +4460,11 @@ Number of spaces to be used for indentation per section level.
@defopt reftex-guess-label-type
Non-@code{nil} means, @code{reftex-reference} will try to guess the
-label type. To do that, @b{Ref@TeX{}} will look at the word before the
+label type. To do that, @RefTeX{} will look at the word before the
cursor and compare it with the magic words given in
-@code{reftex-label-alist}. When it finds a match, @b{Ref@TeX{}} will
+@code{reftex-label-alist}. When it finds a match, @RefTeX{} will
immediately offer the correct label menu - otherwise it will prompt you
-for a label type. If you set this variable to @code{nil}, @b{Ref@TeX{}}
+for a label type. If you set this variable to @code{nil}, @RefTeX{}
will always prompt for a label type.
@end defopt
@@ -4351,7 +4496,7 @@ The keymap which is active in the labels selection process
@cindex Creating citations, options
@defopt reftex-bibliography-commands
-LaTeX commands which specify the BibTeX databases to use with the document.
+@LaTeX{} commands which specify the @BibTeX{} databases to use with the document.
@end defopt
@defopt reftex-bibfile-ignore-regexps
@@ -4359,20 +4504,20 @@ List of regular expressions to exclude files in
@code{\\bibliography@{..@}}. File names matched by any of these regexps
will not be parsed. Intended for files which contain only
@code{@@string} macro definitions and the like, which are ignored by
-@b{Ref@TeX{}} anyway.
+@RefTeX{} anyway.
@end defopt
@defopt reftex-default-bibliography
-List of BibTeX database files which should be used if none are specified.
+List of @BibTeX{} database files which should be used if none are specified.
When @code{reftex-citation} is called from a document with neither
a @samp{\bibliography@{...@}} statement nor a @code{thebibliography}
-environment, @b{Ref@TeX{}} will scan these files instead. Intended for
-using @code{reftex-citation} in non-LaTeX files. The files will be
+environment, @RefTeX{} will scan these files instead. Intended for
+using @code{reftex-citation} in non-@LaTeX{} files. The files will be
searched along the BIBINPUTS or TEXBIB path.
@end defopt
@defopt reftex-sort-bibtex-matches
-Sorting of the entries found in BibTeX databases by reftex-citation.
+Sorting of the entries found in @BibTeX{} databases by reftex-citation.
Possible values:
@example
nil @r{Do not sort entries.}
@@ -4393,7 +4538,7 @@ In the format, the following percent escapes will be expanded.
@table @code
@item %l
-The BibTeX label of the citation.
+The @BibTeX{} label of the citation.
@item %a
List of author names, see also @code{reftex-cite-punctuation}.
@item %2a
@@ -4405,7 +4550,7 @@ Works like @samp{%a}, but on list of editor names. (@samp{%2e} and
@samp{%E} work a well).
@end table
-It is also possible to access all other BibTeX database fields:
+It is also possible to access all other @BibTeX{} database fields:
@example
%b booktitle %c chapter %d edition %h howpublished
@@ -4426,7 +4571,7 @@ after the string has been formatted.
A pair of square brackets indicates an optional argument, and RefTeX
will prompt for the values of these arguments.
-Beware that all this only works with BibTeX database files. When
+Beware that all this only works with @BibTeX{} database files. When
citations are made from the @code{\bibitems} in an explicit
@code{thebibliography} environment, only @samp{%l} is available.
@@ -4505,6 +4650,24 @@ The keymap which is active in the citation-key selection process
(@pxref{Creating Citations}).
@end deffn
+@defopt reftex-cite-key-separator
+String used to separate several keys in a single @samp{\\cite} macro.
+Per default this is @samp{","} but if you often have to deal with a lot
+of entries and need to break the macro across several lines you might
+want to change it to @samp{", "}.
+@end defopt
+
+@defopt reftex-create-bibtex-header
+Header to insert in BibTeX files generated by
+@code{reftex-create-bibtex-file}.
+@end defopt
+
+@defopt reftex-create-bibtex-footer
+Footer to insert in BibTeX files generated by
+@code{reftex-create-bibtex-file}.
+@end defopt
+
+
@node Options (Index Support), Options (Viewing Cross-References), Options (Creating Citations), Options
@section Index Support
@cindex Options, Index support
@@ -4553,7 +4716,7 @@ should be @samp{Molecules!}.
@var{exclude} can be a function. If this function exists and returns a
non-@code{nil} value, the index entry at point is ignored. This was
implemented to support the (deprecated) @samp{^} and @samp{_} shortcuts
-in the LaTeX2e @code{index} package.
+in the @LaTeX{}2e @code{index} package.
@var{repeat}, if non-@code{nil}, means the index macro does not typeset
the entry in the text, so that the text has to be repeated outside the
@@ -4564,14 +4727,14 @@ The final entry may also be a symbol. It must have an association in
the variable @code{reftex-index-macros-builtin} to specify the main
indexing package you are using. Valid values are currently
@example
-default @r{The LaTeX default - unnecessary to specify this one}
+default @r{The @LaTeX{} default - unnecessary to specify this one}
multind @r{The multind.sty package}
index @r{The index.sty package}
index-shortcut @r{The index.sty packages with the ^ and _ shortcuts.}
@r{Should not be used - only for old documents}
@end example
-Note that AUCTeX sets these things internally for @b{Ref@TeX{}} as well,
-so with a sufficiently new version of AUCTeX, you should not set the
+Note that @AUCTeX{} sets these things internally for @RefTeX{} as well,
+so with a sufficiently new version of @AUCTeX{}, you should not set the
package here.
@end defopt
@@ -4584,7 +4747,7 @@ This is a list with @code{(@var{macro-key} @var{default-tag})}.
@var{default-tag} is the tag to be used if the macro requires a
@var{tag} argument. When this is @code{nil} and a @var{tag} is needed,
-@b{Ref@TeX{}} will ask for it. When this is the empty string and the
+@RefTeX{} will ask for it. When this is the empty string and the
TAG argument of the index macro is optional, the TAG argument will be
omitted.
@end defopt
@@ -4604,11 +4767,11 @@ last @r{The last used index tag will be offered as default}
@defopt reftex-index-math-format
Format of index entries when copied from inside math mode. When
-@code{reftex-index-selection-or-word} is executed inside TeX math mode,
+@code{reftex-index-selection-or-word} is executed inside @TeX{} math mode,
the index key copied from the buffer is processed with this format
string through the @code{format} function. This can be used to add the
math delimiters (e.g. @samp{$}) to the string. Requires the
-@file{texmathp.el} library which is part of AUCTeX.
+@file{texmathp.el} library which is part of @AUCTeX{}.
@end defopt
@defopt reftex-index-phrase-file-extension
@@ -4660,7 +4823,7 @@ When doing global indexing from the phrases buffer, searches for some
phrases may match at places where that phrase was already indexed. In
particular when indexing an already processed document again, this
will even be the norm. When this variable is non-@code{nil},
-@b{Ref@TeX{}} checks if the match is an index macro argument, or if an
+@RefTeX{} checks if the match is an index macro argument, or if an
index macro is directly before or after the phrase. If that is the
case, that match will be ignored.
@end defopt
@@ -4701,7 +4864,7 @@ Normal hook which is run when a buffer is put into
The letters which denote sections in the index. Usually these are all
capital letters. Don't use any downcase letters. Order is not
significant, the index will be sorted by whatever the sort function
-thinks is correct. In addition to these letters, @b{Ref@TeX{}} will
+thinks is correct. In addition to these letters, @RefTeX{} will
create a group @samp{!} which contains all entries sorted below the
lowest specified letter. In the @file{*Index*} buffer, pressing any of
these capital letters or @kbd{!} will jump to that section.
@@ -4773,7 +4936,7 @@ escapes.
Non-@code{nil} means, automatic citation display will revisit files if
necessary. When nil, citation display in echo area will only be active
for cached echo strings (see @code{reftex-cache-cite-echo}), or for
-BibTeX database files which are already visited by a live associated
+@BibTeX{} database files which are already visited by a live associated
buffers.
@end defopt
@@ -4790,7 +4953,7 @@ scans. In order to clear it, use @kbd{M-x reftex-reset-mode}.
@cindex Finding files, options
@defopt reftex-texpath-environment-variables
-List of specifications how to retrieve the search path for TeX files.
+List of specifications how to retrieve the search path for @TeX{} files.
Several entries are possible.
@itemize @minus
@item
@@ -4809,7 +4972,7 @@ be expanded recursively. See also @code{reftex-use-external-file-finders}.
@end defopt
@defopt reftex-bibpath-environment-variables
-List of specifications how to retrieve the search path for BibTeX
+List of specifications how to retrieve the search path for @BibTeX{}
files. Several entries are possible.
@itemize @minus
@item
@@ -4847,14 +5010,14 @@ then @samp{/tex/}, and then all subdirectories of @samp{./}. If this
option is @code{nil}, the subdirectories of @samp{./} are searched
before @samp{/tex/}. This is mainly for speed - most of the time the
recursive path is for the system files and not for the user files. Set
-this to @code{nil} if the default makes @b{Ref@TeX{}} finding files with
+this to @code{nil} if the default makes @RefTeX{} finding files with
equal names in wrong sequence.
@end defopt
@defopt reftex-use-external-file-finders
Non-@code{nil} means, use external programs to find files. Normally,
-@b{Ref@TeX{}} searches the paths given in the environment variables
-@code{TEXINPUTS} and @code{BIBINPUTS} to find TeX files and BibTeX
+@RefTeX{} searches the paths given in the environment variables
+@code{TEXINPUTS} and @code{BIBINPUTS} to find @TeX{} files and @BibTeX{}
database files. With this option turned on, it calls an external
program specified in the option @code{reftex-external-file-finders}
instead. As a side effect, the variables
@@ -4881,14 +5044,14 @@ non-@code{nil}.
@defopt reftex-keep-temporary-buffers
Non-@code{nil} means, keep buffers created for parsing and lookup.
-@b{Ref@TeX{}} sometimes needs to visit files related to the current
+@RefTeX{} sometimes needs to visit files related to the current
document. We distinguish files visited for
@table @asis
@item PARSING
Parts of a multifile document loaded when (re)-parsing the
document.
@item LOOKUP
-BibTeX database files and TeX files loaded to find a reference, to
+@BibTeX{} database files and @TeX{} files loaded to find a reference, to
display label context, etc.
@end table
The created buffers can be kept for later use, or be thrown away
@@ -4912,7 +5075,7 @@ away, the initialization of the buffer depends upon the variable
@defopt reftex-initialize-temporary-buffers
Non-@code{nil} means do initializations even when visiting file
-temporarily. When @code{nil}, @b{Ref@TeX{}} may turn off find-file hooks and
+temporarily. When @code{nil}, @RefTeX{} may turn off find-file hooks and
other stuff to briefly visit a file. When @code{t}, the full default
initializations are done (@code{find-file-hook} etc.). Instead of
@code{t} or @code{nil}, this variable may also be a list of hook
@@ -4923,12 +5086,12 @@ functions to do a minimal initialization.
List of regular expressions to exclude certain input files from parsing.
If the name of a file included via @code{\include} or @code{\input} is
matched by any of the regular expressions in this list, that file is not
-parsed by @b{Ref@TeX{}}.
+parsed by @RefTeX{}.
@end defopt
@defopt reftex-enable-partial-scans
Non-@code{nil} means, re-parse only 1 file when asked to re-parse.
-Re-parsing is normally requested with a @kbd{C-u} prefix to many @b{Ref@TeX{}}
+Re-parsing is normally requested with a @kbd{C-u} prefix to many @RefTeX{}
commands, or with the @kbd{r} key in menus. When this option is
@code{t} in a multifile document, we will only parse the current buffer,
or the file associated with the label or section heading near point in a
@@ -4958,7 +5121,7 @@ This extension is added to the base name of the master file.
@end defopt
@defopt reftex-allow-automatic-rescan
-Non-@code{nil} means, @b{Ref@TeX{}} may rescan the document when this seems
+Non-@code{nil} means, @RefTeX{} may rescan the document when this seems
necessary. Applies (currently) only in rare cases, when a new label
cannot be placed with certainty into the internal label list.
@end defopt
@@ -5092,8 +5255,8 @@ map. @xref{Key Bindings}.
@end defopt
@defopt reftex-plug-into-AUCTeX
-Plug-in flags for AUCTeX interface. This variable is a list of
-5 boolean flags. When a flag is non-@code{nil}, @b{Ref@TeX{}}
+Plug-in flags for @AUCTeX{} interface. This variable is a list of
+5 boolean flags. When a flag is non-@code{nil}, @RefTeX{}
will
@example
@@ -5110,7 +5273,7 @@ Supplying labels in new sections and environments applies when creating
sections with @kbd{C-c C-s} and environments with @kbd{C-c C-e}.@*
Supplying macro arguments applies when you insert such a macro
interactively with @kbd{C-c @key{RET}}.@*
-See the AUCTeX documentation for more information.
+See the @AUCTeX{} documentation for more information.
@end defopt
@defopt reftex-revisit-to-follow
@@ -5130,10 +5293,10 @@ argument.
@section Keymaps and Hooks
@cindex Keymaps
-@b{Ref@TeX{}} has the usual general keymap and load-- and mode-hook.
+@RefTeX{} has the usual general keymap, load hook and mode hook.
@deffn Keymap reftex-mode-map
-The keymap for @b{Ref@TeX{}} mode.
+The keymap for @RefTeX{} mode.
@end deffn
@deffn {Normal Hook} reftex-load-hook
@@ -5141,20 +5304,54 @@ Normal hook which is being run when loading @file{reftex.el}.
@end deffn
@deffn {Normal Hook} reftex-mode-hook
-Normal hook which is being run when turning on @b{Ref@TeX{}} mode.
+Normal hook which is being run when turning on @RefTeX{} mode.
@end deffn
-Furthermore, the 4 modes used for referencing labels, creating
+Furthermore, the four modes used for referencing labels, creating
citations, the table of contents buffer and the phrases buffer have
their own keymaps and mode hooks. See the respective sections. There
are many more hooks which are described in the relevant sections about
-options for a specific part of @b{Ref@TeX{}}.
+options for a specific part of @RefTeX{}.
@node Changes, GNU Free Documentation License, Keymaps and Hooks, Top
@chapter Changes
@cindex Changes
-Here is a list of recent changes to @b{Ref@TeX{}}.
+Here is a list of recent changes to @RefTeX{}.
+
+@noindent @b{Version 4.33}
+
+@itemize @bullet
+@item
+Update to GPLv3.
+@item
+Parse files are created in a way that does not interfere with recentf
+mode.
+@end itemize
+
+@noindent @b{Version 4.32}
+
+@itemize @bullet
+@item
+First release by @AUCTeX{} project.
+@item
+Installation routine rewritten after structure of source package
+changed.
+@item
+Activation of @RefTeX{} changed, so make sure you read the installation
+instructions and remove obsolete cruft related to @RefTeX{} from your
+init file.
+@item
+Fixed bug where point would end up in the wrong buffer when jumping
+between several @LaTeX{} and phrases buffers.
+@item
+Fixed bug where @BibTeX{} keys with hyphens were parsed incorrectly.
+@item
+Some performance improvements.
+@item
+The separator used between multiple citations in a \cite macro can now
+be changed by customizing the variable @code{reftex-cite-key-separator}.
+@end itemize
@noindent @b{Version 4.28}
@itemize @bullet
@@ -5179,11 +5376,11 @@ Fixed bug with @samp{%F} in a label prefix. Added new escapes
@noindent @b{Version 4.24}
@itemize @bullet
-@item
+@item
Inserting citation commands now prompts for optional arguments
when called with a prefix argument. Related new options are
@code{reftex-cite-prompt-optional-args} and
-@code{reftex-cite-cleanup-optional-args}.
+@code{reftex-cite-cleanup-optional-args}.
@item
New option @code{reftex-trust-label-prefix}. Configure this variable
if you'd like RefTeX to base its classification of labels on prefixes.
@@ -5199,7 +5396,7 @@ after words. Disabled indexing in comment lines.
@noindent @b{Version 4.22}
@itemize @bullet
-@item
+@item
New command @code{reftex-create-bibtex-file} to create a new database
with all entries referenced in the current document.
@item
@@ -5209,7 +5406,7 @@ from entries marked in a citation selection buffer.
@noindent @b{Version 4.21}
@itemize @bullet
-@item
+@item
Renaming labels from the toc buffer with key @kbd{M-%}.
@end itemize
@@ -5342,7 +5539,7 @@ default stuff which has been moved to a constant.
@item
Environments like theorems can be placed into the TOC by putting
entries for @samp{"begin@{theorem@}"} in
-@code{reftex-setion-levels}.
+@code{reftex-section-levels}.
@end itemize
@noindent @b{Version 4.06}
@@ -5425,7 +5622,7 @@ File search further refined. New option @code{reftex-file-extensions}.
document, all labels and associated context. New keys @kbd{i}, @kbd{l},
and @kbd{c}. New options @code{reftex-toc-include-labels},
@code{reftex-toc-include-context},
-@code{reftex-toc-include-file-boundaries}.
+@code{reftex-toc-include-file-boundaries}.
@end itemize
@noindent @b{Version 3.41}
@@ -5504,7 +5701,7 @@ Option @code{reftex-bibfile-ignore-list} renamed to @code{-regexps}.
@item
Expansion of recursive tex and bib path rewritten.
@item
-Fixed problem where @b{Ref@TeX{}} did not scan unsaved buffers.
+Fixed problem where @RefTeX{} did not scan unsaved buffers.
@item
Fixed bug with section numbering after *-red sections.
@end itemize
@@ -5571,15 +5768,15 @@ variable @code{reftex-auto-view-crossref}.
AUCTeX interface updates:
@itemize @minus
@item
-AUCTeX 9.9c and later notifies @b{Ref@TeX{}} about new sections.
+AUCTeX 9.9c and later notifies @RefTeX{} about new sections.
@item
-@b{Ref@TeX{}} notifies AUCTeX about new labels.
+@RefTeX{} notifies AUCTeX about new labels.
@item
@code{TeX-arg-ref} no longer used (introduction was unnecessary).
@item
@code{reftex-arg-label} and @code{reftex-arg-cite} fixed up.
@item
-Settings added to @b{Ref@TeX{}} via style files remain local.
+Settings added to @RefTeX{} via style files remain local.
@end itemize
@item
Fixed bug with @code{reftex-citation} in non-latex buffers.
@@ -5601,7 +5798,7 @@ Fixed bug with empty context strings.
@noindent @b{Version 3.21}
@itemize @bullet
@item
-New options for all faces used by @b{Ref@TeX{}}. They're in the
+New options for all faces used by @RefTeX{}. They're in the
customization group @code{reftex-fontification-configurations}.
@end itemize
@@ -5627,7 +5824,7 @@ Fixed some problems regarding the interaction with VIPER mode.
@item
Follow-mode is now only used after point motion.
@item
-@b{Ref@TeX{}} now finally does not fontify temporary files anymore.
+@RefTeX{} now finally does not fontify temporary files anymore.
@end itemize
@noindent @b{Version 3.17}
@@ -5740,7 +5937,7 @@ Search for input and @file{.bib} files with recursive path definitions.
@noindent @b{Version 3.00}
@itemize @bullet
@item
-@b{Ref@TeX{}} should work better for very large projects:
+@RefTeX{} should work better for very large projects:
@item
The new parser works without creating a master buffer.
@item
@@ -5748,19 +5945,19 @@ Rescanning can be limited to a part of a multifile document.
@item
Information from the parser can be stored in a file.
@item
-@b{Ref@TeX{}} can deal with macros having a naked label as an argument.
+@RefTeX{} can deal with macros having a naked label as an argument.
@item
Macros may have white space and newlines between arguments.
@item
Multiple identical section headings no longer confuse
@code{reftex-toc}.
@item
-@b{Ref@TeX{}} should work correctly in combination with buffer-altering
+@RefTeX{} should work correctly in combination with buffer-altering
packages like outline, folding, x-symbol, iso-cvt, isotex, etc.
@item
All labeled environments discussed in @emph{The LaTeX Companion} by
Goossens, Mittelbach & Samarin, Addison-Wesley 1994) are part of
-@b{Ref@TeX{}}'s defaults.
+@RefTeX{}'s defaults.
@end itemize
@noindent @b{Version 2.17}
@@ -5858,7 +6055,7 @@ MS-DOS support.
@noindent @b{Version 1.07}
@itemize @bullet
@item
-@b{Ref@TeX{}} gets its own menu.
+@RefTeX{} gets its own menu.
@end itemize
@noindent @b{Version 1.05}
diff --git a/doc/misc/remember.texi b/doc/misc/remember.texi
index e67d6155bbe..1dd7d1b6153 100644
--- a/doc/misc/remember.texi
+++ b/doc/misc/remember.texi
@@ -8,7 +8,7 @@
@copying
This manual is for Remember Mode, version 1.9
-Copyright @copyright{} 2001, 2004-2005, 2007-2011
+Copyright @copyright{} 2001, 2004-2005, 2007-2012
Free Software Foundation, Inc.
@quotation
@@ -389,8 +389,15 @@ The default priority for remembered mail messages.
@section Saving to an Org Mode file
@cindex org mode, integration
+@ignore
+From org.texi:
+Up to version 6.36 Org used a special setup
+for @file{remember.el}. @file{org-remember.el} is still part of Org mode for
+backward compatibility with existing setups. You can find the documentation
+for org-remember at @url{http://orgmode.org/org-remember.pdf}.
+@end ignore
For instructions on how to integrate Remember with Org Mode,
-consult @ref{Remember, , , org}.
+consult @ref{Capture, , , org}.
@node GNU Free Documentation License, Concept Index, Backends, Top
@appendix GNU Free Documentation License
diff --git a/doc/misc/sasl.texi b/doc/misc/sasl.texi
index a75b237519c..a31d9ca5e38 100644
--- a/doc/misc/sasl.texi
+++ b/doc/misc/sasl.texi
@@ -10,7 +10,7 @@
@copying
This file describes the Emacs SASL library, version @value{VERSION}.
-Copyright @copyright{} 2000, 2004-2011
+Copyright @copyright{} 2000, 2004-2012
Free Software Foundation, Inc.
@quotation
diff --git a/doc/misc/sc.texi b/doc/misc/sc.texi
index 37ccc4045be..a2fe0f68a74 100644
--- a/doc/misc/sc.texi
+++ b/doc/misc/sc.texi
@@ -14,7 +14,7 @@
This document describes Supercite, an Emacs package for citing and
attributing replies to mail and news messages.
-Copyright @copyright{} 1993, 2001-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1993, 2001-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -52,9 +52,8 @@ developing GNU and promoting software freedom.''
@contents
@ifnottex
-@node Top, Introduction, (dir), (dir)
+@node Top
@top Supercite
-@comment node-name, next, previous, up
@insertcopying
@@ -64,13 +63,13 @@ into the following chapters.
@menu
* Introduction::
* Citations::
+* Information Keys and the Info Alist::
+* Reference Headers::
* Getting Connected::
* Replying and Yanking::
* Selecting an Attribution::
* Configuring the Citation Engine::
* Post-yank Formatting Commands::
-* Information Keys and the Info Alist::
-* Reference Headers::
* Hints to MUA Authors::
* Thanks and History::
@@ -83,7 +82,7 @@ into the following chapters.
@end ifnottex
-@node Introduction, Usage Overview, Top, Top
+@node Introduction
@chapter Introduction
Supercite is a GNU Emacs package written entirely in Emacs Lisp. It
@@ -96,13 +95,11 @@ of composing replies to both USENET network news and electronic mail.
The preferred way to spell Supercite is with a capital @samp{S},
lowercase @samp{upercite}.
-@ifinfo
@menu
* Usage Overview::
* What Supercite Does Not Do::
* What Supercite Does::
@end menu
-@end ifinfo
@cindex MUA
@cindex NUA
@@ -113,14 +110,14 @@ formatting styles are available in that reply buffer until the reply is
sent. Supercite is re-initialized in each new reply buffer.
-@node Usage Overview, What Supercite Does Not Do, Introduction, Introduction
+@node Usage Overview
+@section Usage Overview
@kindex r
@kindex f
@kindex C-c C-y
@cindex yank
@cindex cite, citing
@cindex attribute, attributing
-@section Usage Overview
Typical usage is as follows. You want to reply or followup to a message
in your MUA. You will probably hit @kbd{r} (i.e., ``reply'') or @kbd{f}
@@ -138,7 +135,7 @@ special text tag. Most MUAs provide some default style of citing; by
using Supercite you gain a wider flexibility in the look and style of
citations. Supercite's only job is to cite the original message.
-@node What Supercite Does Not Do, What Supercite Does, Usage Overview, Introduction
+@node What Supercite Does Not Do
@section What Supercite Doesn't Do
Because of this clear division of labor, there are useful features which
@@ -159,9 +156,9 @@ know anything about the meaning of these headers, and never ventures
outside the designated region. @xref{Hints to MUA Authors}, for more
details.@refill
-@node What Supercite Does, Citations, What Supercite Does Not Do, Introduction
-@findex sc-cite-original
+@node What Supercite Does
@section What Supercite Does
+@findex sc-cite-original
Supercite is invoked for the first time on a reply buffer via your MUA's
reply or forward command. This command will actually perform citations
@@ -204,7 +201,7 @@ When the original message is cited by @code{sc-cite-original}, it will
(optionally) be filled by Supercite. However, if you manually edit the
cited text and want to re-fill it, you must use an add-on package such
as @cite{filladapt} or @cite{gin-mode}. These packages can recognize
-Supercited text and will fill them appropriately. Emacs' built-in
+Supercited text and will fill them appropriately. Emacs's built-in
filling routines, e.g@. @code{fill-paragraph}, do not recognize cited
text and will not re-fill them properly because it cannot guess the
@code{fill-prefix} being used.
@@ -219,12 +216,12 @@ but it is also immediately useful with the default configuration, once
it has been properly connected to your MUA. @xref{Getting Connected},
for more details.@refill
-@node Citations, Citation Elements, What Supercite Does, Top
+@node Citations
+@chapter Citations
@cindex nested citations
@cindex citation
-@chapter Citations
-A @dfn{citation} is the acknowledgement of the original author of a mail
+A @dfn{citation} is the acknowledgment of the original author of a mail
message in the body of the reply. There are two basic citation styles
which Supercite supports. The first, called @dfn{nested citations} is
an anonymous form of citation; in other words, an indication is made
@@ -243,12 +240,10 @@ citations after multiple replies:
And that's what I think too.
@end example
-@ifinfo
@menu
* Citation Elements::
* Recognizing Citations::
@end menu
-@end ifinfo
Note that multiple inclusions of the original messages result in a
nesting of the @samp{@code{>}} characters. This can sometimes be quite
@@ -284,9 +279,9 @@ non-nested citations are used. When non-@code{nil}, nested citations
are used.
-@node Citation Elements, Recognizing Citations, Citations, Citations
-@cindex citation string
+@node Citation Elements
@section Citation Elements
+@cindex citation string
@dfn{Citation strings} are composed of one or more elements. Non-nested
citations are composed of four elements, three of which are directly
@@ -339,7 +334,7 @@ of the same elements, sans the attribution string. Supercite is smart
enough to not put additional spaces between citation delimiters for
multi-level nested citations.
-@node Recognizing Citations, Getting Connected, Citation Elements, Citations
+@node Recognizing Citations
@section Recognizing Citations
Supercite also recognizes citations in the original article, and can
@@ -383,13 +378,13 @@ non-nested citation roots. It is important to remember that if you
change @code{sc-citation-root-regexp} you should always also change
@code{sc-citation-nonnested-root-regexp}.@refill
-@node Information Keys and the Info Alist, Reference Headers, Miscellaneous Commands, Top
+@node Information Keys and the Info Alist
+@chapter Information Keys and the Info Alist
@cindex information keys
@cindex Info Alist
@cindex information extracted from mail fields
@findex sc-mail-field
@findex mail-field (sc-)
-@chapter Information Keys and the Info Alist
@dfn{Mail header information keys} are nuggets of information that
Supercite extracts from the various mail headers of the original
@@ -493,9 +488,9 @@ If the author's name has more than one middle name, they will appear as
info keys with the appropriate index (e.g., @code{"sc-middlename-2"},
@dots{}). @xref{Selecting an Attribution}.@refill
-@node Reference Headers, The Built-in Header Rewrite Functions, Information Keys and the Info Alist, Top
-@cindex reference headers
+@node Reference Headers
@chapter Reference Headers
+@cindex reference headers
Supercite will insert an informative @dfn{reference header} at the
beginning of the cited body of text, which display more detail about the
@@ -507,12 +502,10 @@ name, email address, the original article's subject, etc. In fact any
information contained in the info alist can be inserted into a reference
header.
-@ifinfo
@menu
* The Built-in Header Rewrite Functions::
* Electric References::
@end menu
-@end ifinfo
@cindex header rewrite functions
@vindex sc-rewrite-header-list
@@ -534,9 +527,9 @@ functions. The one it uses is defined in the variable
integer which is an index into the @code{sc-rewrite-header-list},
beginning at zero.
-@node The Built-in Header Rewrite Functions, Electric References, Reference Headers, Reference Headers
-@cindex header rewrite functions, built-in
+@node The Built-in Header Rewrite Functions
@section The Built-in Header Rewrite Functions
+@cindex header rewrite functions, built-in
Below are examples of the various built-in header rewrite functions.
Please note the following:@: first, the text which appears in the
@@ -613,9 +606,9 @@ line after the @code{mail-header-separator} line will be removed.
@code{>>>>> see @var{references} for more details}
@end table
-@node Electric References, Hints to MUA Authors, The Built-in Header Rewrite Functions, Reference Headers
-@cindex electric references
+@node Electric References
@section Electric References
+@cindex electric references
By default, when Supercite cites the original message for the first
time, it just goes ahead and inserts the reference header indexed by
@@ -709,10 +702,9 @@ Exit from electric reference mode without inserting the current header.
Supercite will execute the hook @code{sc-electric-mode-hook} before
entering electric reference mode.
-@node Getting Connected, Replying and Yanking, Recognizing Citations, Top
-@cindex citation interface specification
+@node Getting Connected
@chapter Getting Connected
-
+@cindex citation interface specification
@vindex mail-citation-hook
@cindex .emacs file
@@ -786,14 +778,13 @@ pertaining to the MUAs you are using.
One final note. After Supercite is loaded into your Emacs session, it
runs the hook @code{sc-load-hook}. You can put any customizations into
this hook since it is only run once. This will not work, however, if
-your Emacs maintainer has put Supercite into your dumped Emacs' image.
+your Emacs maintainer has put Supercite into your dumped Emacs image.
In that case, you can use the @code{sc-pre-hook} variable, but this will
get executed every time @code{sc-cite-original} is called. @xref{Reply
Buffer Initialization}.@refill
-@node Replying and Yanking, Reply Buffer Initialization, Getting Connected, Top
+@node Replying and Yanking
@chapter Replying and Yanking
-@ifinfo
This chapter explains what happens when you reply and yank an original
message from an MUA.
@@ -802,11 +793,11 @@ message from an MUA.
* Reply Buffer Initialization::
* Filling Cited Text::
@end menu
-@end ifinfo
-@node Reply Buffer Initialization, Filling Cited Text, Replying and Yanking, Replying and Yanking
+
+@node Reply Buffer Initialization
+@section Reply Buffer Initialization
@findex sc-cite-original
@findex cite-original (sc-)
-@section Reply Buffer Initialization
Executing @code{sc-cite-original} performs the following steps as it
initializes the reply buffer:
@@ -960,7 +951,8 @@ for completeness and backward compatibility. Perhaps it could be used to
reset certain variables set in @code{sc-pre-hook}.@refill
@end enumerate
-@node Filling Cited Text, Selecting an Attribution, Reply Buffer Initialization, Replying and Yanking
+@node Filling Cited Text
+@section Filling Cited Text
@cindex filling paragraphs
@vindex sc-auto-fill-region-p
@vindex auto-fill-region-p (sc-)
@@ -970,7 +962,6 @@ reset certain variables set in @code{sc-pre-hook}.@refill
@findex setup-filladapt (sc-)
@vindex sc-load-hook
@vindex load-hook (sc-)
-@section Filling Cited Text
Supercite will automatically fill newly cited text from the original
message unless the variable @code{sc-auto-fill-region-p} has a
@@ -1008,7 +999,7 @@ fill each cited paragraph in the reply buffer.
I usually run with both these variables containing their default values.
When Supercite's automatic filling breaks on a particular message, I
-will use Emacs' undo feature to undo back before the citation was
+will use Emacs's undo feature to undo back before the citation was
applied to the original message. Then I'll toggle the variables and
manually cite those paragraphs that I don't want to fill or collapse
whitespace on. @xref{Variable Toggling Shortcuts}.@refill
@@ -1039,11 +1030,11 @@ have been widespread complaints on the net about mail and news messages
containing lines greater than about 72 characters. So the default is to
fill cited text.
-@node Selecting an Attribution, Attribution Preferences, Filling Cited Text, Top
+@node Selecting an Attribution
+@chapter Selecting an Attribution
@cindex attribution list
@vindex sc-preferred-attribution-list
@vindex preferred-attribution-list (sc-)
-@chapter Selecting an Attribution
As you know, the attribution string is the part of the author's name
that will be used to composed a non-nested citation string. Supercite
@@ -1055,15 +1046,13 @@ element in the attribution alist is a key-value pair containing such
information as the author's first name, middle names, and last name, the
author's initials, and the author's email terminus.
-@ifinfo
@menu
* Attribution Preferences::
* Anonymous Attributions::
* Author Names::
@end menu
-@end ifinfo
-@node Attribution Preferences, Anonymous Attributions, Selecting an Attribution, Selecting an Attribution
+@node Attribution Preferences
@section Attribution Preferences
When you cite an original message, you can tell Supercite which part of
@@ -1165,12 +1154,12 @@ what nickname they would prefer to use, and you can set up this list to
match against a specific mail field, e.g., @samp{From:@:}, allowing you
to cite your friend's message with the appropriate attribution.
-@node Anonymous Attributions, Author Names, Attribution Preferences, Selecting an Attribution
+@node Anonymous Attributions
+@section Anonymous Attributions
@vindex sc-default-author-name
@vindex default-author-name (sc-)
@vindex sc-default-attribution
@vindex default-attribution (sc-)
-@section Anonymous Attributions
When the author's name cannot be found in the @samp{From:@:} mail
header, a fallback author name and attribution string must be supplied.
@@ -1254,9 +1243,9 @@ to override any automatically derived attribution string when it is only
one character long; e.g. you prefer to use @code{"initials"} but the
author only has one name.@refill
-@node Author Names, Configuring the Citation Engine, Anonymous Attributions, Selecting an Attribution
-@cindex author names
+@node Author Names
@section Author Names
+@cindex author names
Supercite employs a number of heuristics to decipher the author's name
based on value of the @samp{From:@:} mail field of the original message.
@@ -1316,11 +1305,11 @@ The position indicator is an integer, or one of the two special symbols
word in the name field, while @code{any} matches against every word in
the name field.
-@node Configuring the Citation Engine, Using Regi, Author Names, Top
+@node Configuring the Citation Engine
+@chapter Configuring the Citation Engine
@cindex Regi
@cindex frames (Regi)
@cindex entries (Regi)
-@chapter Configuring the Citation Engine
At the heart of Supercite is a regular expression interpreting engine
called @dfn{Regi}. Regi operates by interpreting a data structure
@@ -1333,12 +1322,10 @@ can be transformed in an @emph{awk}-like manner. Regi is used
throughout Supercite, from mail header information extraction, to header
nuking, to citing text.
-@ifinfo
@menu
* Using Regi::
* Frames You Can Customize::
@end menu
-@end ifinfo
While the details of Regi are discussed below (@pxref{Using Regi}), only
those who wish to customize certain aspects of Supercite need concern
@@ -1354,11 +1341,11 @@ Supercite to recognize such things as uuencoded messages or C code and
cite or fill those differently than normal text. None of this is
currently part of Supercite, but contributions are welcome!
-@node Using Regi, Frames You Can Customize, Configuring the Citation Engine, Configuring the Citation Engine
+@node Using Regi
+@section Using Regi
@findex regi-interpret
@findex eval
@findex looking-at
-@section Using Regi
Regi works by interpreting frames with the function
@code{regi-interpret}. A frame is a list of arbitrary size where each
@@ -1452,9 +1439,9 @@ The current frame being interpreted.
The current frame entry being interpreted.
@end table
-@node Frames You Can Customize, Post-yank Formatting Commands, Using Regi, Configuring the Citation Engine
-@vindex sc-nuke-mail-header
+@node Frames You Can Customize
@section Frames You Can Customize
+@vindex sc-nuke-mail-header
As mentioned earlier, Supercite uses various frames to perform
certain jobs such as mail header information extraction and mail header
@@ -1516,11 +1503,11 @@ When Supercite is about to cite, uncite, or recite a region, it consults
the appropriate alist and attempts to find a frame to use. If one
is not found from the alist, then the appropriate default frame is used.
-@node Post-yank Formatting Commands, Citing Commands, Frames You Can Customize, Top
+@node Post-yank Formatting Commands
+@chapter Post-yank Formatting Commands
@vindex sc-mode-map-prefix
@vindex mode-map-prefix (sc-)
@kindex C-c C-p
-@chapter Post-yank Formatting Commands
Once the original message has been yanked into the reply buffer, and
@code{sc-cite-original} has had a chance to do its thing, a number of
@@ -1536,7 +1523,6 @@ but unfortunately the best general solution so far. In the rest of this
chapter, we'll assume you've installed Supercite's keymap on the default
prefix.@refill
-@ifinfo
@menu
* Citing Commands::
* Insertion Commands::
@@ -1544,11 +1530,10 @@ prefix.@refill
* Mail Field Commands::
* Miscellaneous Commands::
@end menu
-@end ifinfo
-@node Citing Commands, Insertion Commands, Post-yank Formatting Commands, Post-yank Formatting Commands
-@vindex sc-cite-region-limit
+@node Citing Commands
@section Commands to Manually Cite, Recite, and Uncite
+@vindex sc-cite-region-limit
Probably the three most common post-yank formatting operations that you
will perform will be the manual citing, reciting, and unciting of
@@ -1608,7 +1593,7 @@ Supercite will always ask you to confirm the attribution when reciting a
region, regardless of the value of @code{sc-confirm-always-p}.
@end table
-@node Insertion Commands, Variable Toggling Shortcuts, Citing Commands, Post-yank Formatting Commands
+@node Insertion Commands
@section Insertion Commands
These two functions insert various strings into the reply buffer.
@@ -1638,9 +1623,9 @@ Inserts the current citation string at the beginning of the line that
an error and will not cite the line.
@end table
-@node Variable Toggling Shortcuts, Mail Field Commands, Insertion Commands, Post-yank Formatting Commands
-@cindex toggling variables
+@node Variable Toggling Shortcuts
@section Variable Toggling Shortcuts
+@cindex toggling variables
Supercite defines a number of commands that make it easier for you to
toggle and set various Supercite variables as you are editing the reply
@@ -1688,7 +1673,7 @@ Toggles the variable @code{sc-fixup-whitespace-p}.
@findex set-variable
The following commands let you set the value of multi-value variables,
-in the same way that Emacs' @code{set-variable} does:
+in the same way that Emacs's @code{set-variable} does:
@table @kbd
@item C-c C-p C-t a
@@ -1718,7 +1703,7 @@ Finally, the command @kbd{C-c C-p C-t h} (also @kbd{C-c C-p C-t ?})
brings up a Help message on the toggling keymap.
-@node Mail Field Commands, Miscellaneous Commands, Variable Toggling Shortcuts, Post-yank Formatting Commands
+@node Mail Field Commands
@section Mail Field Commands
These commands allow you to view, modify, add, and delete various bits
@@ -1768,7 +1753,7 @@ message author. Note that unless an error during processing occurs, any
old information is lost.@refill
@end table
-@node Miscellaneous Commands, Information Keys and the Info Alist, Mail Field Commands, Post-yank Formatting Commands
+@node Miscellaneous Commands
@section Miscellaneous Commands
@table @asis
@@ -1777,12 +1762,12 @@ old information is lost.@refill
@findex open-line
@kindex C-c C-p o
@item @code{sc-open-line} (@kbd{C-c C-p o})
-Similar to Emacs' standard @code{open-line} commands, but inserts the
+Similar to Emacs's standard @code{open-line} commands, but inserts the
citation string in front of the new line. As with @code{open-line},
an optional numeric argument inserts that many new lines.@refill
@end table
-@node Hints to MUA Authors, Thanks and History, Electric References, Top
+@node Hints to MUA Authors
@chapter Hints to MUA Authors
In June of 1989, some discussion was held between the various MUA
@@ -1864,7 +1849,7 @@ need only add @code{sc-cite-original} to this list of hooks using
If you do all this your MUA will join the ranks of those that conform to
this interface ``out of the box.''
-@node Thanks and History, GNU Free Documentation License, Hints to MUA Authors, Top
+@node Thanks and History
@chapter Thanks and History
The Supercite package was derived from its predecessor Superyank 1.11
@@ -1901,19 +1886,17 @@ All who have helped and contributed have been greatly appreciated.
Supercite was written by Barry Warsaw.
-@node GNU Free Documentation License, Concept Index, Thanks and History, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
-@node Concept Index, Command Index, GNU Free Documentation License, Top
+@node Concept Index
@unnumbered Concept Index
@printindex cp
-@node Command Index, Key Index, Concept Index, Top
+@node Command Index
@unnumbered Command Index
-@ifinfo
-@end ifinfo
Since all supercite commands are prepended with the string
``@code{sc-}'', each appears under its @code{sc-}@var{command} name and
its @var{command} name.
@@ -1922,15 +1905,13 @@ its @var{command} name.
@end iftex
@printindex fn
-@node Key Index, Variable Index, Command Index, Top
+@node Key Index
@unnumbered Key Index
@printindex ky
-@node Variable Index, , Key Index, Top
+@node Variable Index
@unnumbered Variable Index
-@ifinfo
-@end ifinfo
Since all supercite variables are prepended with the string
``@code{sc-}'', each appears under its @code{sc-}@var{variable} name and
its @var{variable} name.
diff --git a/doc/misc/sem-user.texi b/doc/misc/sem-user.texi
index e1631bcacc8..9d6fb11db50 100644
--- a/doc/misc/sem-user.texi
+++ b/doc/misc/sem-user.texi
@@ -1,6 +1,6 @@
@c This file is included by semantic.texi
-@c Copyright (C) 1999-2005, 2007, 2009-2011 Free Software Foundation, Inc.
+@c Copyright (C) 1999-2005, 2007, 2009-2012 Free Software Foundation, Inc.
@c Permission is granted to copy, distribute and/or modify this
@c document under the terms of the GNU Free Documentation License,
@@ -31,7 +31,7 @@ File,,,emacs,Emacs manual}.
* Analyzer:: Semantic tools for analyzing code.
* Speedbar:: Using @semantic{} with the Speedbar.
* SymRef:: Interface to symbol reference tools.
-* MRU Bookmarks:: Managing tag ``bookmarks''.
+* MRU Bookmarks:: Managing tag "bookmarks".
* Sticky Func Mode:: Showing declarations in the header line.
* Highlight Func Mode:: Highlight the current function declaration.
* Tag Decoration Mode:: Minor mode to decorate tags.
@@ -176,7 +176,7 @@ Copy the current tag into a register
kill it as well. This allows you to insert or jump to that tag with
the usual register commands. @xref{Registers,,,emacs,Emacs manual}.
-@item \C-c , @kbd{up}
+@item C-c , @kbd{up}
Transpose the current tag with the previous one
(@code{senator-transpose-tags-up}).
@@ -277,7 +277,7 @@ variable. This allows SemanticDB to save tag caches in directories
controlled by them.
@end defvar
-@deffn Option semanticdb-save-database-hooks
+@deffn Option semanticdb-save-database-functions
Abnormal hook run after a database is saved. Each function is called
with one argument, the object representing the database recently
written.
diff --git a/doc/misc/semantic.texi b/doc/misc/semantic.texi
index 8c56d2dc9f8..ad8392c208b 100644
--- a/doc/misc/semantic.texi
+++ b/doc/misc/semantic.texi
@@ -24,7 +24,7 @@
@copying
This manual documents the Semantic library and utilities.
-Copyright @copyright{} 1999-2005, 2007, 2009-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1999-2005, 2007, 2009-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -536,7 +536,7 @@ the buffer.
@item bovine parser
A parser using the bovine parser generator. It is an LL parser
-suitible for small simple languages.
+suitable for small simple languages.
@item context
diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi
index 8300e6511a6..cccd74dec0f 100644
--- a/doc/misc/ses.texi
+++ b/doc/misc/ses.texi
@@ -1,7 +1,7 @@
\input texinfo @c -*-texinfo-*-
@c %**start of header
@setfilename ../../info/ses
-@settitle SES: Simple Emacs Spreadsheet
+@settitle @acronym{SES}: Simple Emacs Spreadsheet
@setchapternewpage off
@syncodeindex fn cp
@syncodeindex vr cp
@@ -9,9 +9,9 @@
@c %**end of header
@copying
-This file documents SES: the Simple Emacs Spreadsheet.
+This file documents @acronym{SES}: the Simple Emacs Spreadsheet.
-Copyright @copyright{} 2002-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 2002-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -29,13 +29,13 @@ developing GNU and promoting software freedom.''
@dircategory Emacs misc features
@direntry
-* SES: (ses). Simple Emacs Spreadsheet.
+* @acronym{SES}: (ses). Simple Emacs Spreadsheet.
@end direntry
@finalout
@titlepage
-@title SES
+@title @acronym{SES}
@subtitle Simple Emacs Spreadsheet
@author Jonathan A. Yavner
@author @email{jyavner@@member.fsf.org}
@@ -52,10 +52,10 @@ developing GNU and promoting software freedom.''
@ifnottex
@node Top, Sales Pitch, (dir), (dir)
@comment node-name, next, previous, up
-@top SES: Simple Emacs Spreadsheet
+@top @acronym{SES}: Simple Emacs Spreadsheet
@display
-SES is a major mode for GNU Emacs to edit spreadsheet files, which
+@acronym{SES} is a major mode for GNU Emacs to edit spreadsheet files, which
contain a rectangular grid of cells. The cells' values are specified
by formulas that can refer to the values of other cells.
@end display
@@ -66,12 +66,12 @@ To report bugs, send email to @email{jyavner@@member.fsf.org}.
@insertcopying
@menu
-* Sales Pitch:: Why use SES?
+* Sales Pitch:: Why use @acronym{SES}?
* The Basics:: Basic spreadsheet commands
* Advanced Features:: Want to know more?
* For Gurus:: Want to know @emph{even more}?
* Index:: Concept, Function and Variable Index
-* Acknowledgements:: Acknowledgements
+* Acknowledgments:: Acknowledgments
* GNU Free Documentation License:: The license for this documentation.
@end menu
@@ -126,9 +126,9 @@ Moves point to cell, specified by identifier (@code{ses-jump}).
Point is always at the left edge of a cell, or at the empty endline.
When mark is inactive, the current cell is underlined. When mark is
-active, the range is the highlighted rectangle of cells (SES always
+active, the range is the highlighted rectangle of cells (@acronym{SES} always
uses transient mark mode). Drag the mouse from A1 to A3 to create the
-range A1-A2. Many SES commands operate only on single cells, not
+range A1-A2. Many @acronym{SES} commands operate only on single cells, not
ranges.
@table @kbd
@@ -155,7 +155,7 @@ Highlight all cells (@code{mark-whole-buffer}).
* Printer functions::
* Clearing cells::
* Copy/cut/paste::
-* Customizing SES::
+* Customizing @acronym{SES}::
@end menu
@node Formulas, Resizing, The Basics, The Basics
@@ -192,7 +192,7 @@ this cell's formula will be reevaluated. While typing in the
expression, you can use @kbd{M-@key{TAB}} to complete symbol names.
@item ' @r{(apostrophe)}
-Enter a symbol (ses-read-symbol). SES remembers all symbols that have
+Enter a symbol (ses-read-symbol). @acronym{SES} remembers all symbols that have
been used as formulas, so you can type just the beginning of a symbol
and use @kbd{@key{SPC}}, @kbd{@key{TAB}}, and @kbd{?} to complete it.
@end table
@@ -349,7 +349,7 @@ Clear cell and move right (@code{ses-clear-cell-forward}).
@end table
-@node Copy/cut/paste, Customizing SES, Clearing cells, The Basics
+@node Copy/cut/paste, Customizing @acronym{SES}, Clearing cells, The Basics
@section Copy, cut, and paste
@cindex copy
@cindex cut
@@ -365,7 +365,7 @@ Clear cell and move right (@code{ses-clear-cell-forward}).
@findex ses-yank-pop
The copy functions work on rectangular regions of cells. You can paste the
-copies into non-SES buffers to export the print text.
+copies into non-@acronym{SES} buffers to export the print text.
@table @kbd
@item M-w
@@ -394,7 +394,7 @@ Paste from kill ring (@code{yank}). The paste functions behave
differently depending on the format of the text being inserted:
@itemize @bullet
@item
-When pasting cells that were cut from a SES buffer, the print text is
+When pasting cells that were cut from a @acronym{SES} buffer, the print text is
ignored and only the attached formula and printer are inserted; cell
references in the formula are relocated unless you use @kbd{C-u}.
@item
@@ -402,7 +402,7 @@ The pasted text overwrites a rectangle of cells whose top left corner
is the current cell. If part of the rectangle is beyond the edges of
the spreadsheet, you must confirm the increase in spreadsheet size.
@item
-Non-SES text is usually inserted as a replacement formula for the
+Non-@acronym{SES} text is usually inserted as a replacement formula for the
current cell. If the formula would be a symbol, it's treated as a
string unless you use @kbd{C-u}. Pasted formulas with syntax errors
are always treated as strings.
@@ -420,12 +420,12 @@ Set point and paste from secondary clipboard (@code{mouse-yank-secondary}).
@item M-y
Immediately after a paste, you can replace the text with a preceding
element from the kill ring (@code{ses-yank-pop}). Unlike the standard
-Emacs yank-pop, the SES version uses @code{undo} to delete the old
+Emacs yank-pop, the @acronym{SES} version uses @code{undo} to delete the old
yank. This doesn't make any difference?
@end table
-@node Customizing SES, , Copy/cut/paste, The Basics
-@section Customizing SES
+@node Customizing @acronym{SES}, , Copy/cut/paste, The Basics
+@section Customizing @acronym{SES}
@cindex customizing
@vindex enable-local-eval
@vindex ses-mode-hook
@@ -443,7 +443,7 @@ up or down. For diagonal movement, select two functions from the
list.
@code{ses-mode-hook} is a normal mode hook (list of functions to
-execute when starting SES mode for a buffer).
+execute when starting @acronym{SES} mode for a buffer).
The variable @code{safe-functions} is a list of possibly-unsafe
functions to be treated as safe when analyzing formulas and printers.
@@ -469,7 +469,10 @@ safety belts!
@table @kbd
@item C-c M-C-h
-(@code{ses-set-header-row}). The header line at the top of the SES
+(@code{ses-set-header-row}).
+@findex ses-set-header-row
+@kindex C-c M-C-h
+The header line at the top of the @acronym{SES}
window normally shows the column letter for each column. You can set
it to show a copy of some row, such as a row of column titles, so that
row will always be visible. Default is to set the current row as the
@@ -478,6 +481,16 @@ show column letters again.
@item [header-line mouse-3]
Pops up a menu to set the current row as the header, or revert to
column letters.
+@item M-x ses-rename-cell
+@findex ses-rename-cell
+Rename a cell from a standard A1-like name to any
+string.
+@item M-x ses-repair-cell-reference-all
+@findex ses-repair-cell-reference-all
+When you interrupt a cell formula update by clicking @kbd{C-g}, then
+the cell reference link may be broken, which will jeopardize automatic
+cell update when any other cell on which it depends is changed. To
+repair that use function @code{ses-repair-cell-reference-all}
@end table
@menu
@@ -498,9 +511,9 @@ column letters.
@findex ses-renarrow-buffer
@findex ses-reprint-all
-A SES file consists of a print area and a data area. Normally the
+A @acronym{SES} file consists of a print area and a data area. Normally the
buffer is narrowed to show only the print area. The print area is
-read-only except for special SES commands; it contains cell values
+read-only except for special @acronym{SES} commands; it contains cell values
formatted by printer functions. The data area records the formula and
printer functions, etc.
@@ -576,6 +589,52 @@ If you insert a new row just beyond the end of a one-column range, or
a new column just beyond a one-row range, the new cell is included in
the range. New cells inserted just before a range are not included.
+Flags can be added to @code{ses-range} immediately after the @var{to}
+cell.
+@table @code
+@item !
+Empty cells in range can be removed by adding the @code{!} flag. An
+empty cell is a cell the value of which is one of symbols @code{nil}
+or @code{*skip*}. For instance @code{(ses-range A1 A4 !)} will do the
+same as @code{(list A1 A3)} when cells @code{A2} and @code{A4} are
+empty.
+@item _
+Empty cell values are replaced by the argument following flag
+@code{_}, or @code{0} when flag @code{_} is last in argument list. For
+instance @code{(ses-range A1 A4 _ "empty")} will do the same as
+@code{(list A1 "empty" A3 "empty")} when cells @code{A2} and @code{A4}
+are empty. Similarly, @code{(ses-range A1 A4 _ )} will do the same as
+@code{(list A1 0 A3 0)}.
+@item >v
+When order matters, list cells by reading cells row-wise from top left
+to bottom right. This flag is provided for completeness only as it is
+the default reading order.
+@item <v
+List cells by reading cells row-wise from top right to bottom left.
+@item v>
+List cells by reading cells column-wise from top left to bottom right.
+@item v<
+List cells by reading cells column-wise from top right to bottom left.
+@item v
+A short hand for @code{v>}.
+@item ^
+A short hand for @code{^>}.
+@item >
+A short hand for @code{>v}.
+@item <
+A short hand for @code{>^}.
+@item *
+Instead of listing cells, it makes a Calc vector or matrix of it
+(@pxref{Top,,,calc,GNU Emacs Calc Manual}). If the range contains only
+one row or one column a vector is made, otherwise a matrix is made.
+@item *2
+Same as @code{*} except that a matrix is always made even when there
+is only one row or column in the range.
+@item *1
+Same as @code{*} except that a vector is always made even when there
+is only one row or column in the range, that is to say the
+corresponding matrix is flattened.
+@end table
@node Sorting by column, Standard formula functions, Ranges in formulas, Advanced Features
@section Sorting by column
@@ -653,7 +712,7 @@ the result is too wide for the available space (up to the end of the
row or the next non-@code{nil} cell), the result is truncated if the cell's
value is a string, or replaced with hash marks otherwise.
-SES could get confused by printer results that contain newlines or
+@acronym{SES} could get confused by printer results that contain newlines or
tabs, so these are replaced with question marks.
@table @kbd
@@ -734,7 +793,7 @@ for more info on how Lisp forms are classified as safe or unsafe.
A common organization for spreadsheets is to have a bunch of ``detail''
rows, each perhaps describing a transaction, and then a set of
``summary'' rows that each show reduced data for some subset of the
-details. SES supports this organization via the @code{ses-select}
+details. @acronym{SES} supports this organization via the @code{ses-select}
function.
@table @code
@@ -771,7 +830,7 @@ details-and-summary spreadsheet.
* Nonrelocatable references::
* The data area::
* Buffer-local variables in spreadsheets::
-* Uses of defadvice in SES::
+* Uses of defadvice in @acronym{SES}::
@end menu
@node Deferred updates, Nonrelocatable references, For Gurus, For Gurus
@@ -799,7 +858,7 @@ progress message of the form ``Writing... (@var{nnn} cells left)''.
These deferred cell-writes cannot be interrupted by @kbd{C-g}, so
you'll just have to wait.
-SES uses @code{run-with-idle-timer} to move the cell underline when
+@acronym{SES} uses @code{run-with-idle-timer} to move the cell underline when
Emacs will be scrolling the buffer after the end of a command, and
also to narrow and underline after @kbd{C-x C-v}. This is visible as
a momentary glitch after C-x C-v and certain scrolling commands. You
@@ -843,14 +902,14 @@ Begins with an 014 character, followed by sets of cell-definition
macros for each row, followed by column-widths, column-printers,
default-printer, and header-row. Then there's the global parameters
(file-format ID, numrows, numcols) and the local variables (specifying
-SES mode for the buffer, etc.)
+@acronym{SES} mode for the buffer, etc.)
-When a SES file is loaded, first the numrows and numcols values are
+When a @acronym{SES} file is loaded, first the numrows and numcols values are
loaded, then the entire data area is @code{eval}ed, and finally the local
variables are processed.
You can edit the data area, but don't insert or delete any newlines
-except in the local-variables part, since SES locates things by
+except in the local-variables part, since @acronym{SES} locates things by
counting newlines. Use @kbd{C-x C-e} at the end of a line to install
your edits into the spreadsheet data structures (this does not update
the print area, use e.g. @kbd{C-c C-l} for that).
@@ -866,7 +925,7 @@ data structures:
@end table
-@node Buffer-local variables in spreadsheets, Uses of defadvice in SES, The data area, For Gurus
+@node Buffer-local variables in spreadsheets, Uses of defadvice in @acronym{SES}, The data area, For Gurus
@section Buffer-local variables in spreadsheets
@cindex buffer-local variables
@cindex variables, buffer-local
@@ -900,8 +959,8 @@ avoid virus warnings, each function used in a formula needs
(put 'your-function-name 'safe-function t)
@end lisp
-@node Uses of defadvice in SES, , Buffer-local variables in spreadsheets, For Gurus
-@section Uses of defadvice in SES
+@node Uses of defadvice in @acronym{SES}, , Buffer-local variables in spreadsheets, For Gurus
+@section Uses of defadvice in @acronym{SES}
@cindex defadvice
@cindex undo-more
@cindex copy-region-as-kill
@@ -927,15 +986,15 @@ cell.
@end table
@c ===================================================================
-@node Index, Acknowledgements, For Gurus, Top
+@node Index, Acknowledgments, For Gurus, Top
@unnumbered Index
@printindex cp
@c ===================================================================
-@node Acknowledgements, GNU Free Documentation License, Index, Top
-@chapter Acknowledgements
+@node Acknowledgments, GNU Free Documentation License, Index, Top
+@chapter Acknowledgments
Coding by:
@quotation
@@ -976,7 +1035,7 @@ Jean-Philippe Theberge @email{jphil@@acs.pagesjaunes.fr}
@c ===================================================================
-@node GNU Free Documentation License, , Acknowledgements, Top
+@node GNU Free Documentation License, , Acknowledgments, Top
@appendix GNU Free Documentation License
@include doclicense.texi
diff --git a/doc/misc/sieve.texi b/doc/misc/sieve.texi
index 64fd92f40ca..d13f25c2a55 100644
--- a/doc/misc/sieve.texi
+++ b/doc/misc/sieve.texi
@@ -11,7 +11,7 @@
@copying
This file documents the Emacs Sieve package, for server-side mail filtering.
-Copyright @copyright{} 2001-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 2001-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi
index 854be0d0012..4e4df3f0bbb 100644
--- a/doc/misc/smtpmail.texi
+++ b/doc/misc/smtpmail.texi
@@ -3,7 +3,7 @@
@settitle Emacs SMTP Library
@syncodeindex vr fn
@copying
-Copyright @copyright{} 2003-2011
+Copyright @copyright{} 2003-2012
Free Software Foundation, Inc.
@quotation
@@ -47,6 +47,7 @@ developing GNU and promoting software freedom.''
* How Mail Works:: Brief introduction to mail concepts.
* Emacs Speaks SMTP:: How to use the SMTP library in Emacs.
* Authentication:: Authenticating yourself to the server.
+* Encryption:: Protecting your connection to the server.
* Queued delivery:: Sending mail without an internet connection.
* Server workarounds:: Mail servers with special requirements.
* Debugging:: Tracking down problems.
@@ -129,24 +130,37 @@ be useful if you don't have a MTA set up on your host, or if your
machine is often disconnected from the internet.
Sending mail via SMTP requires configuring your mail user agent
-(@pxref{Mail Methods,,,emacs}) to use the SMTP library. How to do
-this should be described for each mail user agent; for the default
-mail user agent the variable @code{send-mail-function} (@pxref{Mail
-Sending,,,emacs}) is used; for the Message and Gnus user agents the
-variable @code{message-send-mail-function} (@pxref{Mail
-Variables,,,message}) is used.
-
-@example
-;; If you use the default mail user agent.
+(@pxref{Mail Methods,,,emacs}) to use the SMTP library. If you
+have not configured anything, then in Emacs 24.1 and later the first
+time you try to send a mail Emacs will ask how you want to send
+mail. To use this library, answer @samp{smtp} when prompted. Emacs
+then asks for the name of the SMTP server.
+
+ If you prefer, or if you are using a non-standard mail user agent,
+you can configure this yourself. The normal way to do this is to set
+the variable @code{send-mail-function} (@pxref{Mail
+Sending,,,emacs}) to the value you want to use. To use this library:
+
+@smallexample
(setq send-mail-function 'smtpmail-send-it)
-;; If you use Message or Gnus.
-(setq message-send-mail-function 'smtpmail-send-it)
-@end example
+@end smallexample
+
+@noindent
+The default value for this variable is @code{sendmail-query-once},
+which interactively asks how you want to send mail.
+
+Your mail user agent might use a different variable for this purpose.
+It should inherit from @code{send-mail-function}, but if it does not,
+or if you prefer, you can set that variable directly. Consult your
+mail user agent's documentation for more details. For example,
+(@pxref{Mail Variables,,,message}).
Before using SMTP you must find out the hostname of the SMTP server
-to use. Your system administrator should provide you with this
-information, but often it is the same as the server you receive mail
-from.
+to use. Your system administrator or mail service provider should
+supply this information. Often it is some variant of the server you
+receive mail from. If your email address is
+@samp{yourname@@example.com}, then the name of the SMTP server is
+may be something like @samp{smtp.example.com}.
@table @code
@item smtpmail-smtp-server
@@ -201,101 +215,114 @@ The following example illustrates what you could put in
@node Authentication
@chapter Authentication
+@cindex password
+@cindex user name
+Most SMTP servers require clients to authenticate themselves before
+they are allowed to send mail. Authentication usually involves
+supplying a user name and password.
+
+If you have not configured anything, then the first time you try to
+send mail via a server, Emacs (version 24.1 and later) prompts you
+for the user name and password to use, and then offers to save the
+information. By default, Emacs stores authentication information in
+a file @file{~/.authinfo}.
+
+@cindex authinfo
+The basic format of the @file{~/.authinfo} file is one line for each
+set of credentials. Each line consists of pairs of variables and
+values. A simple example would be:
+
+@smallexample
+machine mail.example.org port 25 login myuser password mypassword
+@end smallexample
+
+@noindent
+This specifies that when using the SMTP server called @samp{mail.example.org}
+on port 25, Emacs should send the user name @samp{myuser} and the
+password @samp{mypassword}. Either or both of the login and password
+fields may be absent, in which case Emacs prompts for the information
+when you try to send mail. (This replaces the old
+@code{smtpmail-auth-credentials} variable used prior to Emacs 24.1.)
+
+@vindex smtpmail-smtp-user
+ When the SMTP library connects to a host on a certain port, it
+searches the @file{~/.authinfo} file for a matching entry. If an
+entry is found, the authentication process is invoked and the
+credentials are used. If the variable @code{smtpmail-smtp-user} is
+set to a non-@code{nil} value, then only entries for that user are
+considered. For more information on the @file{~/.authinfo}
+file, @pxref{Top,,auth-source, auth, Emacs auth-source Library}.
+
@cindex SASL
@cindex CRAM-MD5
+@cindex PLAIN
@cindex LOGIN
+The process by which the SMTP library authenticates you to the server
+is known as ``Simple Authentication and Security Layer'' (SASL).
+There are various SASL mechanisms, and this library supports three of
+them: CRAM-MD5, PLAIN, and LOGIN. It tries each of them, in that order,
+until one succeeds. The first uses a form of encryption to obscure
+your password, while the other two do not.
+
+
+@node Encryption
+@chapter Encryption
+
@cindex STARTTLS
@cindex TLS
@cindex SSL
-Many environments require SMTP clients to authenticate themselves
-before they are allowed to route mail via a server. The two following
-variables contains the authentication information needed for this.
-
-The first variable, @code{smtpmail-auth-credentials}, instructs the
-SMTP library to use a SASL authentication step, currently only the
-CRAM-MD5 and LOGIN mechanisms are supported and will be selected in
-that order if the server support both.
-
-The second variable, @code{smtpmail-starttls-credentials}, instructs
-the SMTP library to connect to the server using STARTTLS. This means
-the protocol exchange may be integrity protected and confidential by
-using the Transport Layer Security (TLS) protocol, and optionally also
-authentication of the client and server.
-
-TLS is a security protocol that is also known as SSL, although
-strictly speaking, SSL is an older variant of TLS. TLS is backwards
-compatible with SSL. In most mundane situations, the two terms are
-equivalent.
-
-The TLS feature uses the elisp package @file{starttls.el} (see it for
-more information on customization), which in turn require that at
-least one of the following external tools are installed:
+For greater security, you can encrypt your connection to the SMTP
+server. If this is to work, both Emacs and the server must support it.
+
+The SMTP library supports the ``Transport Layer Security'' (TLS), and
+the older ``Secure Sockets Layer'' (SSL) encryption mechanisms.
+It also supports STARTTLS, which is a variant of TLS in which the
+initial connection to the server is made in plain text, requesting a
+switch to an encrypted channel for the rest of the process.
+
+@vindex smtpmail-stream-type
+The variable @code{smtpmail-stream-type} controls what form of
+connection the SMTP library uses. The default value is @code{nil},
+which means to use a plain connection, but try to switch to a STARTTLS
+encrypted connection if the server supports it. Other possible values
+are: @code{starttls} - insist on STARTTLS; @code{ssl} - use TLS/SSL;
+and @code{plain} - no encryption.
+
+Use of any form of TLS/SSL requires support in Emacs. You can either
+use the built-in support (in Emacs 24.1 and later), or the
+@file{starttls.el} Lisp library. The built-in support uses the GnuTLS
+@footnote{@url{http://www.gnu.org/software/gnutls/}} library.
+If your Emacs has GnuTLS support built-in, the function
+@code{gnutls-available-p} is defined and returns non-@code{nil}.
+Otherwise, you must use the @file{starttls.el} library (see that file for
+more information on customization options, etc.). The Lisp library
+requires one of the following external tools to be installed:
@enumerate
@item
-The GnuTLS command line tool @samp{gnutls-cli}, you can get it from
+The GnuTLS command line tool @samp{gnutls-cli}, which you can get from
@url{http://www.gnu.org/software/gnutls/}. This is the recommended
-tool, mainly because it can verify the server certificates.
+tool, mainly because it can verify server certificates.
@item
-The @samp{starttls} external program, you can get it from
+The @samp{starttls} external program, which you can get from
@file{starttls-*.tar.gz} from @uref{ftp://ftp.opaopa.org/pub/elisp/}.
@end enumerate
-It is not uncommon to use both these mechanisms, e.g., to use STARTTLS
-to achieve integrity and confidentiality and then use SASL for client
-authentication.
+@cindex certificates
+@cindex keys
+The SMTP server may also request that you verify your identity by
+sending a certificate and the associated encryption key to the server.
+If you need to do this, you can use an @file{~/.authinfo} entry like this:
-@table @code
-@item smtpmail-auth-credentials
-@vindex smtpmail-auth-credentials
- The variable @code{smtpmail-auth-credentials} contains a list of
-hostname, port, username and password tuples. When the SMTP library
-connects to a host on a certain port, this variable is searched to
-find a matching entry for that hostname and port. If an entry is
-found, the authentication process is invoked and the credentials are
-used.
-
-The hostname field follows the same format as
-@code{smtpmail-smtp-server} (i.e., a string) and the port field the
-same format as @code{smtpmail-smtp-service} (i.e., a string or an
-integer). The username and password fields, which either can be
-@code{nil} to indicate that the user is prompted for the value
-interactively, should be strings with the username and password,
-respectively, information that is normally provided by system
-administrators.
-
-@item smtpmail-starttls-credentials
-@vindex smtpmail-starttls-credentials
- The variable @code{smtpmail-starttls-credentials} contains a list of
-tuples with hostname, port, name of file containing client key, and
-name of file containing client certificate. The processing is similar
-to the previous variable. The client key and certificate may be
-@code{nil} if you do not wish to use client authentication.
-@end table
+@smallexample
+machine mail.example.org port 25 key "~/.my_smtp_tls.key" cert "~/.my_smtp_tls.cert"
+@end smallexample
-The following example illustrates what you could put in
-@file{~/.emacs} to enable both SASL authentication and STARTTLS. The
-server name (@code{smtpmail-smtp-server}) is @var{hostname}, the
-server port (@code{smtpmail-smtp-service}) is @var{port}, and the
-username and password are @var{username} and @var{password}
-respectively.
+@noindent
+(This replaces the old @code{smtpmail-starttls-credentials} variable used
+prior to Emacs 24.1.)
-@example
-;; Authenticate using this username and password against my server.
-(setq smtpmail-auth-credentials
- '(("@var{hostname}" "@var{port}" "@var{username}" "@var{password}")))
-
-;; Note that if @var{port} is an integer, you must not quote it as a
-;; string. Normally @var{port} should be the integer 25, and the example
-;; become:
-(setq smtpmail-auth-credentials
- '(("@var{hostname}" 25 "@var{username}" "@var{password}")))
-
-;; Use STARTTLS without authentication against the server.
-(setq smtpmail-starttls-credentials
- '(("@var{hostname}" "@var{port}" nil nil)))
-@end example
@node Queued delivery
@chapter Queued delivery
diff --git a/doc/misc/speedbar.texi b/doc/misc/speedbar.texi
index 9dc47e4574c..6604dc5f0d0 100644
--- a/doc/misc/speedbar.texi
+++ b/doc/misc/speedbar.texi
@@ -4,7 +4,7 @@
@syncodeindex fn cp
@copying
-Copyright @copyright{} 1999-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1999-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index 3298298bb9d..b5f31415771 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -3,11 +3,11 @@
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2011-09-23.09}
+\def\texinfoversion{2012-11-08.11}
%
% Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995,
% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-% 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+% 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
%
% This texinfo.tex file is free software: you can redistribute it and/or
% modify it under the terms of the GNU General Public License as
@@ -28,9 +28,9 @@
%
% Please try the latest version of texinfo.tex before submitting bug
% reports; you can get the latest version from:
-% http://www.gnu.org/software/texinfo/ (the Texinfo home page), or
-% ftp://tug.org/tex/texinfo.tex
-% (and all CTAN mirrors, see http://www.ctan.org).
+% http://ftp.gnu.org/gnu/texinfo/ (the Texinfo release area), or
+% http://ftpmirror.gnu.org/texinfo/ (same, via a mirror), or
+% http://www.gnu.org/software/texinfo/ (the Texinfo home page)
% The texinfo.tex in any given distribution could well be out
% of date, so if that's what you're using, please check.
%
@@ -116,6 +116,7 @@
% Set up fixed words for English if not already set.
\ifx\putwordAppendix\undefined \gdef\putwordAppendix{Appendix}\fi
\ifx\putwordChapter\undefined \gdef\putwordChapter{Chapter}\fi
+\ifx\putworderror\undefined \gdef\putworderror{error}\fi
\ifx\putwordfile\undefined \gdef\putwordfile{file}\fi
\ifx\putwordin\undefined \gdef\putwordin{in}\fi
\ifx\putwordIndexIsEmpty\undefined \gdef\putwordIndexIsEmpty{(Index is empty)}\fi
@@ -229,6 +230,13 @@
\errorcontextlines16
}%
+% @errormsg{MSG}. Do the index-like expansions on MSG, but if things
+% aren't perfect, it's not the end of the world, being an error message,
+% after all.
+%
+\def\errormsg{\begingroup \indexnofonts \doerrormsg}
+\def\doerrormsg#1{\errmessage{#1}}
+
% add check for \lastpenalty to plain's definitions. If the last thing
% we did was a \nobreak, we don't want to insert more space.
%
@@ -586,7 +594,7 @@
\def\:{\spacefactor=1000 }
% @* forces a line break.
-\def\*{\hfil\break\hbox{}\ignorespaces}
+\def\*{\unskip\hfil\break\hbox{}\ignorespaces}
% @/ allows a line break.
\let\/=\allowbreak
@@ -879,7 +887,7 @@ where each line of input produces a line of output.}
\def\popthisfilestack{\errthisfilestackempty}
\def\errthisfilestackempty{\errmessage{Internal error:
the stack of filenames is empty.}}
-
+%
\def\thisfile{}
% @center line
@@ -887,36 +895,46 @@ where each line of input produces a line of output.}
%
\parseargdef\center{%
\ifhmode
- \let\next\centerH
+ \let\centersub\centerH
\else
- \let\next\centerV
+ \let\centersub\centerV
\fi
- \next{\hfil \ignorespaces#1\unskip \hfil}%
+ \centersub{\hfil \ignorespaces#1\unskip \hfil}%
+ \let\centersub\relax % don't let the definition persist, just in case
}
-\def\centerH#1{%
- {%
- \hfil\break
- \advance\hsize by -\leftskip
- \advance\hsize by -\rightskip
- \line{#1}%
- \break
- }%
+\def\centerH#1{{%
+ \hfil\break
+ \advance\hsize by -\leftskip
+ \advance\hsize by -\rightskip
+ \line{#1}%
+ \break
+}}
+%
+\newcount\centerpenalty
+\def\centerV#1{%
+ % The idea here is the same as in \startdefun, \cartouche, etc.: if
+ % @center is the first thing after a section heading, we need to wipe
+ % out the negative parskip inserted by \sectionheading, but still
+ % prevent a page break here.
+ \centerpenalty = \lastpenalty
+ \ifnum\centerpenalty>10000 \vskip\parskip \fi
+ \ifnum\centerpenalty>9999 \penalty\centerpenalty \fi
+ \line{\kern\leftskip #1\kern\rightskip}%
}
-\def\centerV#1{\line{\kern\leftskip #1\kern\rightskip}}
% @sp n outputs n lines of vertical space
-
+%
\parseargdef\sp{\vskip #1\baselineskip}
% @comment ...line which is ignored...
% @c is the same as @comment
% @ignore ... @end ignore is another way to write a comment
-
+%
\def\comment{\begingroup \catcode`\^^M=\other%
\catcode`\@=\other \catcode`\{=\other \catcode`\}=\other%
\commentxxx}
{\catcode`\^^M=\other \gdef\commentxxx#1^^M{\endgroup}}
-
+%
\let\c=\comment
% @paragraphindent NCHARS
@@ -1089,50 +1107,24 @@ where each line of input produces a line of output.}
% for display in the outlines, and in other places. Thus, we have to
% double any backslashes. Otherwise, a name like "\node" will be
% interpreted as a newline (\n), followed by o, d, e. Not good.
-% http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html
-% (and related messages, the final outcome is that it is up to the TeX
-% user to double the backslashes and otherwise make the string valid, so
-% that's what we do).
-
-% double active backslashes.
-%
-{\catcode`\@=0 \catcode`\\=\active
- @gdef@activebackslashdouble{%
- @catcode`@\=@active
- @let\=@doublebackslash}
-}
-
-% To handle parens, we must adopt a different approach, since parens are
-% not active characters. hyperref.dtx (which has the same problem as
-% us) handles it with this amazing macro to replace tokens, with minor
-% changes for Texinfo. It is included here under the GPL by permission
-% from the author, Heiko Oberdiek.
-%
-% #1 is the tokens to replace.
-% #2 is the replacement.
-% #3 is the control sequence with the string.
-%
-\def\HyPsdSubst#1#2#3{%
- \def\HyPsdReplace##1#1##2\END{%
- ##1%
- \ifx\\##2\\%
- \else
- #2%
- \HyReturnAfterFi{%
- \HyPsdReplace##2\END
- }%
- \fi
- }%
- \xdef#3{\expandafter\HyPsdReplace#3#1\END}%
-}
-\long\def\HyReturnAfterFi#1\fi{\fi#1}
-
-% #1 is a control sequence in which to do the replacements.
-\def\backslashparens#1{%
- \xdef#1{#1}% redefine it as its expansion; the definition is simply
- % \lastnode when called from \setref -> \pdfmkdest.
- \HyPsdSubst{(}{\realbackslash(}{#1}%
- \HyPsdSubst{)}{\realbackslash)}{#1}%
+%
+% See http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html and
+% related messages. The final outcome is that it is up to the TeX user
+% to double the backslashes and otherwise make the string valid, so
+% that's what we do. pdftex 1.30.0 (ca.2005) introduced a primitive to
+% do this reliably, so we use it.
+
+% #1 is a control sequence in which to do the replacements,
+% which we \xdef.
+\def\txiescapepdf#1{%
+ \ifx\pdfescapestring\thisisundefined
+ % No primitive available; should we give a warning or log?
+ % Many times it won't matter.
+ \else
+ % The expandable \pdfescapestring primitive escapes parentheses,
+ % backslashes, and other special chars.
+ \xdef#1{\pdfescapestring{#1}}%
+ \fi
}
\newhelp\nopdfimagehelp{Texinfo supports .png, .jpg, .jpeg, and .pdf images
@@ -1191,32 +1183,34 @@ output) for that.)}
%
% #1 is image name, #2 width (might be empty/whitespace), #3 height (ditto).
\def\dopdfimage#1#2#3{%
- \def\imagewidth{#2}\setbox0 = \hbox{\ignorespaces #2}%
- \def\imageheight{#3}\setbox2 = \hbox{\ignorespaces #3}%
+ \def\pdfimagewidth{#2}\setbox0 = \hbox{\ignorespaces #2}%
+ \def\pdfimageheight{#3}\setbox2 = \hbox{\ignorespaces #3}%
%
- % pdftex (and the PDF format) support .png, .jpg, .pdf (among
- % others). Let's try in that order.
+ % pdftex (and the PDF format) support .pdf, .png, .jpg (among
+ % others). Let's try in that order, PDF first since if
+ % someone has a scalable image, presumably better to use that than a
+ % bitmap.
\let\pdfimgext=\empty
\begingroup
- \openin 1 #1.png \ifeof 1
- \openin 1 #1.jpg \ifeof 1
- \openin 1 #1.jpeg \ifeof 1
- \openin 1 #1.JPG \ifeof 1
- \openin 1 #1.pdf \ifeof 1
- \openin 1 #1.PDF \ifeof 1
+ \openin 1 #1.pdf \ifeof 1
+ \openin 1 #1.PDF \ifeof 1
+ \openin 1 #1.png \ifeof 1
+ \openin 1 #1.jpg \ifeof 1
+ \openin 1 #1.jpeg \ifeof 1
+ \openin 1 #1.JPG \ifeof 1
\errhelp = \nopdfimagehelp
\errmessage{Could not find image file #1 for pdf}%
- \else \gdef\pdfimgext{PDF}%
+ \else \gdef\pdfimgext{JPG}%
\fi
- \else \gdef\pdfimgext{pdf}%
+ \else \gdef\pdfimgext{jpeg}%
\fi
- \else \gdef\pdfimgext{JPG}%
+ \else \gdef\pdfimgext{jpg}%
\fi
- \else \gdef\pdfimgext{jpeg}%
+ \else \gdef\pdfimgext{png}%
\fi
- \else \gdef\pdfimgext{jpg}%
+ \else \gdef\pdfimgext{PDF}%
\fi
- \else \gdef\pdfimgext{png}%
+ \else \gdef\pdfimgext{pdf}%
\fi
\closein 1
\endgroup
@@ -1228,8 +1222,8 @@ output) for that.)}
\else
\immediate\pdfximage
\fi
- \ifdim \wd0 >0pt width \imagewidth \fi
- \ifdim \wd2 >0pt height \imageheight \fi
+ \ifdim \wd0 >0pt width \pdfimagewidth \fi
+ \ifdim \wd2 >0pt height \pdfimageheight \fi
\ifnum\pdftexversion<13
#1.\pdfimgext
\else
@@ -1244,10 +1238,9 @@ output) for that.)}
% such as \, aren't expanded when present in a section title.
\indexnofonts
\turnoffactive
- \activebackslashdouble
\makevalueexpandable
\def\pdfdestname{#1}%
- \backslashparens\pdfdestname
+ \txiescapepdf\pdfdestname
\safewhatsit{\pdfdest name{\pdfdestname} xyz}%
}}
%
@@ -1279,28 +1272,22 @@ output) for that.)}
% page number. We could generate a destination for the section
% text in the case where a section has no node, but it doesn't
% seem worth the trouble, since most documents are normally structured.
- \def\pdfoutlinedest{#3}%
+ \edef\pdfoutlinedest{#3}%
\ifx\pdfoutlinedest\empty
\def\pdfoutlinedest{#4}%
\else
- % Doubled backslashes in the name.
- {\activebackslashdouble \xdef\pdfoutlinedest{#3}%
- \backslashparens\pdfoutlinedest}%
+ \txiescapepdf\pdfoutlinedest
\fi
%
- % Also double the backslashes in the display string.
- {\activebackslashdouble \xdef\pdfoutlinetext{#1}%
- \backslashparens\pdfoutlinetext}%
+ % Also escape PDF chars in the display string.
+ \edef\pdfoutlinetext{#1}%
+ \txiescapepdf\pdfoutlinetext
%
\pdfoutline goto name{\pdfmkpgn{\pdfoutlinedest}}#2{\pdfoutlinetext}%
}
%
\def\pdfmakeoutlines{%
\begingroup
- % Thanh's hack / proper braces in bookmarks
- \edef\mylbrace{\iftrue \string{\else}\fi}\let\{=\mylbrace
- \edef\myrbrace{\iffalse{\else\string}\fi}\let\}=\myrbrace
- %
% Read toc silently, to get counts of subentries for \pdfoutline.
\def\partentry##1##2##3##4{}% ignore parts in the outlines
\def\numchapentry##1##2##3##4{%
@@ -1356,25 +1343,41 @@ output) for that.)}
% Latin 2 (0xea) gets translated to a | character. Info from
% Staszek Wawrykiewicz, 19 Jan 2004 04:09:24 +0100.
%
- % xx to do this right, we have to translate 8-bit characters to
- % their "best" equivalent, based on the @documentencoding. Right
- % now, I guess we'll just let the pdf reader have its way.
+ % TODO this right, we have to translate 8-bit characters to
+ % their "best" equivalent, based on the @documentencoding. Too
+ % much work for too little return. Just use the ASCII equivalents
+ % we use for the index sort strings.
+ %
\indexnofonts
\setupdatafile
+ % We can have normal brace characters in the PDF outlines, unlike
+ % Texinfo index files. So set that up.
+ \def\{{\lbracecharliteral}%
+ \def\}{\rbracecharliteral}%
\catcode`\\=\active \otherbackslash
\input \tocreadfilename
\endgroup
}
+ {\catcode`[=1 \catcode`]=2
+ \catcode`{=\other \catcode`}=\other
+ \gdef\lbracecharliteral[{]%
+ \gdef\rbracecharliteral[}]%
+ ]
%
\def\skipspaces#1{\def\PP{#1}\def\D{|}%
\ifx\PP\D\let\nextsp\relax
\else\let\nextsp\skipspaces
- \ifx\p\space\else\addtokens{\filename}{\PP}%
- \advance\filenamelength by 1
- \fi
+ \addtokens{\filename}{\PP}%
+ \advance\filenamelength by 1
\fi
\nextsp}
- \def\getfilename#1{\filenamelength=0\expandafter\skipspaces#1|\relax}
+ \def\getfilename#1{%
+ \filenamelength=0
+ % If we don't expand the argument now, \skipspaces will get
+ % snagged on things like "@value{foo}".
+ \edef\temp{#1}%
+ \expandafter\skipspaces\temp|\relax
+ }
\ifnum\pdftexversion < 14
\let \startlink \pdfannotlink
\else
@@ -1471,9 +1474,6 @@ output) for that.)}
\def\ttsl{\setfontstyle{ttsl}}
-% Default leading.
-\newdimen\textleading \textleading = 13.2pt
-
% Set the baselineskip to #1, and the lineskip and strut size
% correspondingly. There is no deep meaning behind these magic numbers
% used as factors; they just match (closely enough) what Knuth defined.
@@ -1485,6 +1485,7 @@ output) for that.)}
% can get a sort of poor man's double spacing by redefining this.
\def\baselinefactor{1}
%
+\newdimen\textleading
\def\setleading#1{%
\dimen0 = #1\relax
\normalbaselineskip = \baselinefactor\dimen0
@@ -1757,18 +1758,24 @@ end
\fi\fi
-% Set the font macro #1 to the font named #2, adding on the
-% specified font prefix (normally `cm').
+% Set the font macro #1 to the font named \fontprefix#2.
% #3 is the font's design size, #4 is a scale factor, #5 is the CMap
-% encoding (currently only OT1, OT1IT and OT1TT are allowed, pass
-% empty to omit).
+% encoding (only OT1, OT1IT and OT1TT are allowed, or empty to omit).
+% Example:
+% #1 = \textrm
+% #2 = \rmshape
+% #3 = 10
+% #4 = \mainmagstep
+% #5 = OT1
+%
\def\setfont#1#2#3#4#5{%
\font#1=\fontprefix#2#3 scaled #4
\csname cmap#5\endcsname#1%
}
% This is what gets called when #5 of \setfont is empty.
\let\cmap\gobble
-% emacs-page end of cmaps
+%
+% (end of cmaps)
% Use cm as the default font prefix.
% To specify the font prefix, you must define \fontprefix
@@ -1778,7 +1785,7 @@ end
\fi
% Support font families that don't use the same naming scheme as CM.
\def\rmshape{r}
-\def\rmbshape{bx} %where the normal face is bold
+\def\rmbshape{bx} % where the normal face is bold
\def\bfshape{b}
\def\bxshape{bx}
\def\ttshape{tt}
@@ -1793,8 +1800,7 @@ end
\def\scshape{csc}
\def\scbshape{csc}
-% Definitions for a main text size of 11pt. This is the default in
-% Texinfo.
+% Definitions for a main text size of 11pt. (The default in Texinfo.)
%
\def\definetextfontsizexi{%
% Text fonts (11.2pt, magstep1).
@@ -1919,7 +1925,7 @@ end
\textleading = 13.2pt % line spacing for 11pt CM
\textfonts % reset the current fonts
\rm
-} % end of 11pt text font size definitions
+} % end of 11pt text font size definitions, \definetextfontsizexi
% Definitions to make the main text be 10pt Computer Modern, with
@@ -2051,7 +2057,7 @@ end
\textleading = 12pt % line spacing for 10pt CM
\textfonts % reset the current fonts
\rm
-} % end of 10pt text font size definitions
+} % end of 10pt text font size definitions, \definetextfontsizex
% We provide the user-level command
@@ -2266,8 +2272,6 @@ end
\gdef\markupsetcodequoteleft{\let`\codequoteleft}
\gdef\markupsetcodequoteright{\let'\codequoteright}
-
-\gdef\markupsetnoligaturesquoteleft{\let`\noligaturesquoteleft}
}
\let\markupsetuplqcode \markupsetcodequoteleft
@@ -2276,6 +2280,9 @@ end
\let\markupsetuplqexample \markupsetcodequoteleft
\let\markupsetuprqexample \markupsetcodequoteright
%
+\let\markupsetuplqkbd \markupsetcodequoteleft
+\let\markupsetuprqkbd \markupsetcodequoteright
+%
\let\markupsetuplqsamp \markupsetcodequoteleft
\let\markupsetuprqsamp \markupsetcodequoteright
%
@@ -2285,8 +2292,6 @@ end
\let\markupsetuplqverbatim \markupsetcodequoteleft
\let\markupsetuprqverbatim \markupsetcodequoteright
-\let\markupsetuplqkbd \markupsetnoligaturesquoteleft
-
% Allow an option to not use regular directed right quote/apostrophe
% (char 0x27), but instead the undirected quote from cmtt (char 0x0d).
% The undirected quote is ugly, so don't make it the default, but it
@@ -2372,19 +2377,26 @@ end
\else\ifx\next-%
\else\ifx\next.%
\else\ptexslash
- \fi\fi\fi}
+ \fi\fi\fi
+ \aftersmartic
+}
-% like \smartslanted except unconditionally uses \ttsl, and no ic.
-% @var is set to this for defun arguments.
+% Unconditional use \ttsl, and no ic. @var is set to this for defuns.
\def\ttslanted#1{{\ttsl #1}}
% @cite is like \smartslanted except unconditionally use \sl. We never want
% ttsl for book titles, do we?
\def\cite#1{{\sl #1}\futurelet\next\smartitaliccorrection}
+\def\aftersmartic{}
+\def\var#1{%
+ \let\saveaftersmartic = \aftersmartic
+ \def\aftersmartic{\null\let\aftersmartic=\saveaftersmartic}%
+ \smartslanted{#1}%
+}
+
\let\i=\smartitalic
\let\slanted=\smartslanted
-\def\var#1{\smartslanted{#1}}
\let\dfn=\smartslanted
\let\emph=\smartitalic
@@ -2434,34 +2446,12 @@ end
% @samp.
\def\samp#1{{\setupmarkupstyle{samp}\lq\tclose{#1}\rq\null}}
-% definition of @key that produces a lozenge. Doesn't adjust to text size.
-%\setfont\keyrm\rmshape{8}{1000}{OT1}
-%\font\keysy=cmsy9
-%\def\key#1{{\keyrm\textfont2=\keysy \leavevmode\hbox{%
-% \raise0.4pt\hbox{\angleleft}\kern-.08em\vtop{%
-% \vbox{\hrule\kern-0.4pt
-% \hbox{\raise0.4pt\hbox{\vphantom{\angleleft}}#1}}%
-% \kern-0.4pt\hrule}%
-% \kern-.06em\raise0.4pt\hbox{\angleright}}}}
-
-% definition of @key with no lozenge. If the current font is already
-% monospace, don't change it; that way, we respect @kbdinputstyle. But
-% if it isn't monospace, then use \tt.
-%
-\def\key#1{{\setupmarkupstyle{key}%
- \nohyphenation
- \ifmonospace\else\tt\fi
- #1}\null}
-
-% ctrl is no longer a Texinfo command.
-\def\ctrl #1{{\tt \rawbackslash \hat}#1}
-
-% @file, @option are the same as @samp.
-\let\file=\samp
-\let\option=\samp
+% @indicateurl is \samp, that is, with quotes.
+\let\indicateurl=\samp
-% @code is a modification of @t,
-% which makes spaces the same size as normal in the surrounding text.
+% @code (and similar) prints in typewriter, but with spaces the same
+% size as normal in the surrounding text, without hyphenation, etc.
+% This is a subroutine for that.
\def\tclose#1{%
{%
% Change normal interword space to be same as for the current font.
@@ -2480,13 +2470,13 @@ end
\plainfrenchspacing
#1%
}%
- \null
+ \null % reset spacefactor to 1000
}
% We *must* turn on hyphenation at `-' and `_' in @code.
% Otherwise, it is too hard to avoid overfull hboxes
% in the Emacs manual, the Library manual, etc.
-
+%
% Unfortunately, TeX uses one parameter (\hyphenchar) to control
% both hyphenation at - and hyphenation within words.
% We must therefore turn them both off (\tclose does that)
@@ -2550,6 +2540,13 @@ end
\fi\fi
}
+% For @command, @env, @file, @option quotes seem unnecessary,
+% so use \code rather than \samp.
+\let\command=\code
+\let\env=\code
+\let\file=\code
+\let\option=\code
+
% @uref (abbreviation for `urlref') takes an optional (comma-separated)
% second argument specifying the text to display and an optional third
% arg as text to display instead of (rather than in addition to) the url
@@ -2696,10 +2693,6 @@ end
\let\email=\uref
\fi
-% @kbd is like @code, except that if the argument is just one @key command,
-% then @kbd has no effect.
-\def\kbd#1{{\setupmarkupstyle{kbd}\def\look{#1}\expandafter\kbdfoo\look??\par}}
-
% @kbdinputstyle -- arg is `distinct' (@kbd uses slanted tty font always),
% `example' (@kbd uses ttsl only inside of @example and friends),
% or `code' (@kbd uses normal tty font always).
@@ -2723,16 +2716,36 @@ end
% Default is `distinct'.
\kbdinputstyle distinct
+% @kbd is like @code, except that if the argument is just one @key command,
+% then @kbd has no effect.
+\def\kbd#1{{\def\look{#1}\expandafter\kbdsub\look??\par}}
+
\def\xkey{\key}
-\def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}%
-\ifx\one\xkey\ifx\threex\three \key{#2}%
-\else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi
-\else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi}
+\def\kbdsub#1#2#3\par{%
+ \def\one{#1}\def\three{#3}\def\threex{??}%
+ \ifx\one\xkey\ifx\threex\three \key{#2}%
+ \else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi
+ \else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi
+}
-% For @indicateurl, @env, @command quotes seem unnecessary, so use \code.
-\let\indicateurl=\code
-\let\env=\code
-\let\command=\code
+% definition of @key that produces a lozenge. Doesn't adjust to text size.
+%\setfont\keyrm\rmshape{8}{1000}{OT1}
+%\font\keysy=cmsy9
+%\def\key#1{{\keyrm\textfont2=\keysy \leavevmode\hbox{%
+% \raise0.4pt\hbox{\angleleft}\kern-.08em\vtop{%
+% \vbox{\hrule\kern-0.4pt
+% \hbox{\raise0.4pt\hbox{\vphantom{\angleleft}}#1}}%
+% \kern-0.4pt\hrule}%
+% \kern-.06em\raise0.4pt\hbox{\angleright}}}}
+
+% definition of @key with no lozenge. If the current font is already
+% monospace, don't change it; that way, we respect @kbdinputstyle. But
+% if it isn't monospace, then use \tt.
+%
+\def\key#1{{\setupmarkupstyle{key}%
+ \nohyphenation
+ \ifmonospace\else\tt\fi
+ #1}\null}
% @clicksequence{File @click{} Open ...}
\def\clicksequence#1{\begingroup #1\endgroup}
@@ -2762,6 +2775,7 @@ end
\ifx\temp\empty \else
\space ({\unsepspaces \ignorespaces \temp \unskip})%
\fi
+ \null % reset \spacefactor=1000
}
% @abbr for "Comput. J." and the like.
@@ -2774,6 +2788,7 @@ end
\ifx\temp\empty \else
\space ({\unsepspaces \ignorespaces \temp \unskip})%
\fi
+ \null % reset \spacefactor=1000
}
% @asis just yields its argument. Used with @table, for example.
@@ -2838,20 +2853,51 @@ end
}
}
+% ctrl is no longer a Texinfo command, but leave this definition for fun.
+\def\ctrl #1{{\tt \rawbackslash \hat}#1}
+
+% @inlinefmt{FMTNAME,PROCESSED-TEXT} and @inlineraw{FMTNAME,RAW-TEXT}.
+% Ignore unless FMTNAME == tex; then it is like @iftex and @tex,
+% except specified as a normal braced arg, so no newlines to worry about.
+%
+\def\outfmtnametex{tex}
+%
+\long\def\inlinefmt#1{\doinlinefmt #1,\finish}
+\long\def\doinlinefmt#1,#2,\finish{%
+ \def\inlinefmtname{#1}%
+ \ifx\inlinefmtname\outfmtnametex \ignorespaces #2\fi
+}
+% For raw, must switch into @tex before parsing the argument, to avoid
+% setting catcodes prematurely. Doing it this way means that, for
+% example, @inlineraw{html, foo{bar} gets a parse error instead of being
+% ignored. But this isn't important because if people want a literal
+% *right* brace they would have to use a command anyway, so they may as
+% well use a command to get a left brace too. We could re-use the
+% delimiter character idea from \verb, but it seems like overkill.
+%
+\long\def\inlineraw{\tex \doinlineraw}
+\long\def\doinlineraw#1{\doinlinerawtwo #1,\finish}
+\def\doinlinerawtwo#1,#2,\finish{%
+ \def\inlinerawname{#1}%
+ \ifx\inlinerawname\outfmtnametex \ignorespaces #2\fi
+ \endgroup % close group opened by \tex.
+}
+
\message{glyphs,}
% and logos.
-% @@ prints an @.
+% @@ prints an @, as does @atchar{}.
\def\@{\char64 }
+\let\atchar=\@
-% Used to generate quoted braces. Unless we're in typewriter, use
-% \ecfont because the CM text fonts do not have braces, and we don't
-% want to switch into math.
+% @{ @} @lbracechar{} @rbracechar{} all generate brace characters.
+% Unless we're in typewriter, use \ecfont because the CM text fonts do
+% not have braces, and we don't want to switch into math.
\def\mylbrace{{\ifmonospace\else\ecfont\fi \char123}}
\def\myrbrace{{\ifmonospace\else\ecfont\fi \char125}}
-\let\{=\mylbrace
-\let\}=\myrbrace
+\let\{=\mylbrace \let\lbracechar=\{
+\let\}=\myrbrace \let\rbracechar=\}
\begingroup
% Definitions to produce \{ and \} commands for indices,
% and @{ and @} for the aux/toc files.
@@ -2979,7 +3025,7 @@ end
{\tentt \global\dimen0 = 3em}% Width of the box.
\dimen2 = .55pt % Thickness of rules
% The text. (`r' is open on the right, `e' somewhat less so on the left.)
-\setbox0 = \hbox{\kern-.75pt \reducedsf error\kern-1.5pt}
+\setbox0 = \hbox{\kern-.75pt \reducedsf \putworderror\kern-1.5pt}
%
\setbox\errorbox=\hbox to \dimen0{\hfil
\hsize = \dimen0 \advance\hsize by -5.8pt % Space to left+right.
@@ -3100,12 +3146,17 @@ end
% hopefully nobody will notice/care.
\edef\ecsize{\csname\curfontsize ecsize\endcsname}%
\edef\nominalsize{\csname\curfontsize nominalsize\endcsname}%
- \ifx\curfontstyle\bfstylename
- % bold:
- \font\thisecfont = ecb\ifusingit{i}{x}\ecsize \space at \nominalsize
+ \ifmonospace
+ % typewriter:
+ \font\thisecfont = ectt\ecsize \space at \nominalsize
\else
- % regular:
- \font\thisecfont = ec\ifusingit{ti}{rm}\ecsize \space at \nominalsize
+ \ifx\curfontstyle\bfstylename
+ % bold:
+ \font\thisecfont = ecb\ifusingit{i}{x}\ecsize \space at \nominalsize
+ \else
+ % regular:
+ \font\thisecfont = ec\ifusingit{ti}{rm}\ecsize \space at \nominalsize
+ \fi
\fi
\thisecfont
}
@@ -3218,6 +3269,20 @@ end
\finishedtitlepagetrue
}
+% Settings used for typesetting titles: no hyphenation, no indentation,
+% don't worry much about spacing, ragged right. This should be used
+% inside a \vbox, and fonts need to be set appropriately first. Because
+% it is always used for titles, nothing else, we call \rmisbold. \par
+% should be specified before the end of the \vbox, since a vbox is a group.
+%
+\def\raggedtitlesettings{%
+ \rmisbold
+ \hyphenpenalty=10000
+ \parindent=0pt
+ \tolerance=5000
+ \ptexraggedright
+}
+
% Macros to be used within @titlepage:
\let\subtitlerm=\tenrm
@@ -3225,7 +3290,7 @@ end
\parseargdef\title{%
\checkenv\titlepage
- \leftline{\titlefonts\rmisbold #1}
+ \vbox{\titlefonts \raggedtitlesettings #1\par}%
% print a rule at the page bottom also.
\finishedtitlepagefalse
\vskip4pt \hrule height 4pt width \hsize \vskip4pt
@@ -4162,7 +4227,7 @@ end
}
\def\ifsetfail{\doignore{ifset}}
-% @ifclear VAR ... @end ifclear reads the `...' iff VAR has never been
+% @ifclear VAR ... @end executes the `...' iff VAR has never been
% defined with @set, or has been undefined with @clear.
%
% The `\else' inside the `\doifset' parameter is a trick to reuse the
@@ -4173,6 +4238,35 @@ end
\def\ifclear{\parsearg{\doifset{\else \let\next=\ifclearfail}}}
\def\ifclearfail{\doignore{ifclear}}
+% @ifcommandisdefined CMD ... @end executes the `...' if CMD (written
+% without the @) is in fact defined. We can only feasibly check at the
+% TeX level, so something like `mathcode' is going to considered
+% defined even though it is not a Texinfo command.
+%
+\makecond{ifcommanddefined}
+\def\ifcommanddefined{\parsearg{\doifcmddefined{\let\next=\ifcmddefinedfail}}}
+%
+\def\doifcmddefined#1#2{{%
+ \makevalueexpandable
+ \let\next=\empty
+ \expandafter\ifx\csname #2\endcsname\relax
+ #1% If not defined, \let\next as above.
+ \fi
+ \expandafter
+ }\next
+}
+\def\ifcmddefinedfail{\doignore{ifcommanddefined}}
+
+% @ifcommandnotdefined CMD ... handled similar to @ifclear above.
+\makecond{ifcommandnotdefined}
+\def\ifcommandnotdefined{%
+ \parsearg{\doifcmddefined{\else \let\next=\ifcmdnotdefinedfail}}}
+\def\ifcmdnotdefinedfail{\doignore{ifcommandnotdefined}}
+
+% Set the `txicommandconditionals' variable, so documents have a way to
+% test if the @ifcommand...defined conditionals are available.
+\set txicommandconditionals
+
% @dircategory CATEGORY -- specify a category of the dir file
% which this file should belong to. Ignore this in TeX.
\let\dircategory=\comment
@@ -4409,6 +4503,7 @@ end
\definedummyword\guillemetright
\definedummyword\guilsinglleft
\definedummyword\guilsinglright
+ \definedummyword\lbracechar
\definedummyword\leq
\definedummyword\minus
\definedummyword\ogonek
@@ -4421,6 +4516,7 @@ end
\definedummyword\quoteleft
\definedummyword\quoteright
\definedummyword\quotesinglbase
+ \definedummyword\rbracechar
\definedummyword\result
\definedummyword\textdegree
%
@@ -4472,7 +4568,9 @@ end
\definedummyword\t
%
% Commands that take arguments.
+ \definedummyword\abbr
\definedummyword\acronym
+ \definedummyword\anchor
\definedummyword\cite
\definedummyword\code
\definedummyword\command
@@ -4482,7 +4580,9 @@ end
\definedummyword\emph
\definedummyword\env
\definedummyword\file
+ \definedummyword\image
\definedummyword\indicateurl
+ \definedummyword\inforef
\definedummyword\kbd
\definedummyword\key
\definedummyword\math
@@ -4529,7 +4629,10 @@ end
% content at all. So for index sorting, we map @{ and @} to strings
% starting with |, since that ASCII character is between ASCII { and }.
\def\{{|a}%
+ \def\lbracechar{|a}%
+ %
\def\}{|b}%
+ \def\rbracechar{|b}%
%
% Non-English letters.
\def\AA{AA}%
@@ -4705,10 +4808,9 @@ end
%
% ..., ready, GO:
%
-\def\safewhatsit#1{%
-\ifhmode
+\def\safewhatsit#1{\ifhmode
#1%
-\else
+ \else
% \lastskip and \lastpenalty cannot both be nonzero simultaneously.
\whatsitskip = \lastskip
\edef\lastskipmacro{\the\lastskip}%
@@ -4732,7 +4834,6 @@ end
% to re-insert the same penalty (values >10000 are used for various
% signals); since we just inserted a non-discardable item, any
% following glue (such as a \parskip) would be a breakpoint. For example:
- %
% @deffn deffn-whatever
% @vindex index-whatever
% Description.
@@ -4745,8 +4846,7 @@ end
% (the whatsit from the \write), so we must insert a \nobreak.
\nobreak\vskip\whatsitskip
\fi
-\fi
-}
+\fi}
% The index entry written in the file actually looks like
% \entry {sortstring}{page}{topic}
@@ -5493,14 +5593,6 @@ end
% Define @majorheading, @heading and @subheading
-% NOTE on use of \vbox for chapter headings, section headings, and such:
-% 1) We use \vbox rather than the earlier \line to permit
-% overlong headings to fold.
-% 2) \hyphenpenalty is set to 10000 because hyphenation in a
-% heading is obnoxious; this forbids it.
-% 3) Likewise, headings look best if no \parindent is used, and
-% if justification is not attempted. Hence \raggedright.
-
\def\majorheading{%
{\advance\chapheadingskip by 10pt \chapbreak }%
\parsearg\chapheadingzzz
@@ -5508,10 +5600,8 @@ end
\def\chapheading{\chapbreak \parsearg\chapheadingzzz}
\def\chapheadingzzz#1{%
- {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
- \parindent=0pt\ptexraggedright
- \rmisbold #1\hfill}}%
- \bigskip \par\penalty 200\relax
+ \vbox{\chapfonts \raggedtitlesettings #1\par}%
+ \nobreak\bigskip \nobreak
\suppressfirstparagraphindent
}
@@ -5670,8 +5760,7 @@ end
%
% Typeset the actual heading.
\nobreak % Avoid page breaks at the interline glue.
- \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \ptexraggedright
- \hangindent=\wd0 \centerparametersmaybe
+ \vbox{\raggedtitlesettings \hangindent=\wd0 \centerparametersmaybe
\unhbox0 #1\par}%
}%
\nobreak\bigskip % no page break after a chapter title
@@ -5693,18 +5782,18 @@ end
\def\setchapterstyle #1 {\csname CHAPF#1\endcsname}
%
\def\unnchfopen #1{%
-\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
- \parindent=0pt\ptexraggedright
- \rmisbold #1\hfill}}\bigskip \par\nobreak
+ \chapoddpage
+ \vbox{\chapfonts \raggedtitlesettings #1\par}%
+ \nobreak\bigskip\nobreak
}
\def\chfopen #1#2{\chapoddpage {\chapfonts
\vbox to 3in{\vfil \hbox to\hsize{\hfil #2} \hbox to\hsize{\hfil #1} \vfil}}%
\par\penalty 5000 %
}
\def\centerchfopen #1{%
-\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
- \parindent=0pt
- \hfill {\rmisbold #1}\hfill}}\bigskip \par\nobreak
+ \chapoddpage
+ \vbox{\chapfonts \raggedtitlesettings \hfill #1\hfill}%
+ \nobreak\bigskip \nobreak
}
\def\CHAPFopen{%
\global\let\chapmacro=\chfopen
@@ -5849,14 +5938,15 @@ end
%
% We'll almost certainly start a paragraph next, so don't let that
% glue accumulate. (Not a breakpoint because it's preceded by a
- % discardable item.)
+ % discardable item.) However, when a paragraph is not started next
+ % (\startdefun, \cartouche, \center, etc.), this needs to be wiped out
+ % or the negative glue will cause weirdly wrong output, typically
+ % obscuring the section heading with something else.
\vskip-\parskip
%
- % This is purely so the last item on the list is a known \penalty >
- % 10000. This is so \startdefun can avoid allowing breakpoints after
- % section headings. Otherwise, it would insert a valid breakpoint between:
- % @section sec-whatever
- % @deffn def-whatever
+ % This is so the last item on the main vertical list is a known
+ % \penalty > 10000, so \startdefun, etc., can recognize the situation
+ % and do the needful.
\penalty 10001
}
@@ -6276,7 +6366,7 @@ end
% If this cartouche directly follows a sectioning command, we need the
% \parskip glue (backspaced over by default) or the cartouche can
% collide with the section heading.
- \ifnum\lastpenalty>10000 \vskip\parskip \fi
+ \ifnum\lastpenalty>10000 \vskip\parskip \penalty\lastpenalty \fi
%
\vbox\bgroup
\baselineskip=0pt\parskip=0pt\lineskip=0pt
@@ -6469,16 +6559,9 @@ end
\makedispenvdef{quotation}{\quotationstart}
%
\def\quotationstart{%
- {\parskip=0pt \aboveenvbreak}% because \aboveenvbreak inserts \parskip
- \parindent=0pt
- %
- % @cartouche defines \nonarrowing to inhibit narrowing at next level down.
+ \indentedblockstart % same as \indentedblock, but increase right margin too.
\ifx\nonarrowing\relax
- \advance\leftskip by \lispnarrowing
\advance\rightskip by \lispnarrowing
- \exdentamount = \lispnarrowing
- \else
- \let\nonarrowing = \relax
\fi
\parsearg\quotationlabel
}
@@ -6504,6 +6587,32 @@ end
\fi
}
+% @indentedblock is like @quotation, but indents only on the left and
+% has no optional argument.
+%
+\makedispenvdef{indentedblock}{\indentedblockstart}
+%
+\def\indentedblockstart{%
+ {\parskip=0pt \aboveenvbreak}% because \aboveenvbreak inserts \parskip
+ \parindent=0pt
+ %
+ % @cartouche defines \nonarrowing to inhibit narrowing at next level down.
+ \ifx\nonarrowing\relax
+ \advance\leftskip by \lispnarrowing
+ \exdentamount = \lispnarrowing
+ \else
+ \let\nonarrowing = \relax
+ \fi
+}
+
+% Keep a nonzero parskip for the environment, since we're doing normal filling.
+%
+\def\Eindentedblock{%
+ \par
+ {\parskip=0pt \afterenvbreak}%
+}
+\def\Esmallindentedblock{\Eindentedblock}
+
% LaTeX-like @verbatim...@end verbatim and @verb{<char>...<char>}
% If we want to allow any <char> as delimiter,
@@ -6982,7 +7091,10 @@ end
\df \sl \hyphenchar\font=0
%
% On the other hand, if an argument has two dashes (for instance), we
- % want a way to get ttsl. Let's try @var for that.
+ % want a way to get ttsl. We used to recommend @var for that, so
+ % leave the code in, but it's strange for @var to lead to typewriter.
+ % Nowadays we recommend @code, since the difference between a ttsl hyphen
+ % and a tt hyphen is pretty tiny. @code also disables ?` !`.
\def\var##1{{\setupmarkupstyle{var}\ttslanted{##1}}}%
#1%
\sl\hyphenchar\font=45
@@ -7766,7 +7878,7 @@ end
\fi\fi
}
-
+%
% @xref, @pxref, and @ref generate cross-references. For \xrefX, #1 is
% the node name, #2 the name of the Info cross-reference, #3 the printed
% node name, #4 the name of the Info file, #5 the name of the printed
@@ -7775,26 +7887,41 @@ end
\def\pxref#1{\putwordsee{} \xrefX[#1,,,,,,,]}
\def\xref#1{\putwordSee{} \xrefX[#1,,,,,,,]}
\def\ref#1{\xrefX[#1,,,,,,,]}
+%
+\newbox\toprefbox
+\newbox\printedrefnamebox
+\newbox\infofilenamebox
+\newbox\printedmanualbox
+%
\def\xrefX[#1,#2,#3,#4,#5,#6]{\begingroup
\unsepspaces
- \def\printedmanual{\ignorespaces #5}%
+ %
+ % Get args without leading/trailing spaces.
\def\printedrefname{\ignorespaces #3}%
- \setbox1=\hbox{\printedmanual\unskip}%
- \setbox0=\hbox{\printedrefname\unskip}%
- \ifdim \wd0 = 0pt
+ \setbox\printedrefnamebox = \hbox{\printedrefname\unskip}%
+ %
+ \def\infofilename{\ignorespaces #4}%
+ \setbox\infofilenamebox = \hbox{\infofilename\unskip}%
+ %
+ \def\printedmanual{\ignorespaces #5}%
+ \setbox\printedmanualbox = \hbox{\printedmanual\unskip}%
+ %
+ % If the printed reference name (arg #3) was not explicitly given in
+ % the @xref, figure out what we want to use.
+ \ifdim \wd\printedrefnamebox = 0pt
% No printed node name was explicitly given.
\expandafter\ifx\csname SETxref-automatic-section-title\endcsname \relax
- % Use the node name inside the square brackets.
+ % Not auto section-title: use node name inside the square brackets.
\def\printedrefname{\ignorespaces #1}%
\else
- % Use the actual chapter/section title appear inside
- % the square brackets. Use the real section title if we have it.
- \ifdim \wd1 > 0pt
- % It is in another manual, so we don't have it.
+ % Auto section-title: use chapter/section title inside
+ % the square brackets if we have it.
+ \ifdim \wd\printedmanualbox > 0pt
+ % It is in another manual, so we don't have it; use node name.
\def\printedrefname{\ignorespaces #1}%
\else
\ifhavexrefs
- % We know the real title if we have the xref values.
+ % We (should) know the real title if we have the xref values.
\def\printedrefname{\refx{#1-title}{}}%
\else
% Otherwise just copy the Info node name.
@@ -7808,13 +7935,20 @@ end
\ifpdf
{\indexnofonts
\turnoffactive
+ \makevalueexpandable
% This expands tokens, so do it after making catcode changes, so _
- % etc. don't get their TeX definitions.
+ % etc. don't get their TeX definitions. This ignores all spaces in
+ % #4, including (wrongly) those in the middle of the filename.
\getfilename{#4}%
%
- % See comments at \activebackslashdouble.
- {\activebackslashdouble \xdef\pdfxrefdest{#1}%
- \backslashparens\pdfxrefdest}%
+ % This (wrongly) does not take account of leading or trailing
+ % spaces in #1, which should be ignored.
+ \edef\pdfxrefdest{#1}%
+ \ifx\pdfxrefdest\empty
+ \def\pdfxrefdest{Top}% no empty targets
+ \else
+ \txiescapepdf\pdfxrefdest % escape PDF special chars
+ \fi
%
\leavevmode
\startlink attr{/Border [0 0 0]}%
@@ -7841,29 +7975,42 @@ end
\iffloat\Xthisreftitle
% If the user specified the print name (third arg) to the ref,
% print it instead of our usual "Figure 1.2".
- \ifdim\wd0 = 0pt
+ \ifdim\wd\printedrefnamebox = 0pt
\refx{#1-snt}{}%
\else
\printedrefname
\fi
%
- % if the user also gave the printed manual name (fifth arg), append
+ % If the user also gave the printed manual name (fifth arg), append
% "in MANUALNAME".
- \ifdim \wd1 > 0pt
+ \ifdim \wd\printedmanualbox > 0pt
\space \putwordin{} \cite{\printedmanual}%
\fi
\else
% node/anchor (non-float) references.
+ %
+ % If we use \unhbox to print the node names, TeX does not insert
+ % empty discretionaries after hyphens, which means that it will not
+ % find a line break at a hyphen in a node names. Since some manuals
+ % are best written with fairly long node names, containing hyphens,
+ % this is a loss. Therefore, we give the text of the node name
+ % again, so it is as if TeX is seeing it for the first time.
+ %
+ \ifdim \wd\printedmanualbox > 0pt
+ % Cross-manual reference with a printed manual name.
+ %
+ \crossmanualxref{\cite{\printedmanual\unskip}}%
+ %
+ \else\ifdim \wd\infofilenamebox > 0pt
+ % Cross-manual reference with only an info filename (arg 4), no
+ % printed manual name (arg 5). This is essentially the same as
+ % the case above; we output the filename, since we have nothing else.
+ %
+ \crossmanualxref{\code{\infofilename\unskip}}%
%
- % If we use \unhbox0 and \unhbox1 to print the node names, TeX does not
- % insert empty discretionaries after hyphens, which means that it will
- % not find a line break at a hyphen in a node names. Since some manuals
- % are best written with fairly long node names, containing hyphens, this
- % is a loss. Therefore, we give the text of the node name again, so it
- % is as if TeX is seeing it for the first time.
- \ifdim \wd1 > 0pt
- \putwordSection{} ``\printedrefname'' \putwordin{} \cite{\printedmanual}%
\else
+ % Reference within this manual.
+ %
% _ (for example) has to be the character _ for the purposes of the
% control sequence corresponding to the node, but it has to expand
% into the usual \leavevmode...\vrule stuff for purposes of
@@ -7875,7 +8022,7 @@ end
\setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}%
\ifdim \wd2 > 0pt \refx{#1-snt}\space\fi
}%
- % output the `[mynode]' via a macro so it can be overridden.
+ % output the `[mynode]' via the macro below so it can be overridden.
\xrefprintnodename\printedrefname
%
% But we always want a comma and a space:
@@ -7883,11 +8030,37 @@ end
%
% output the `page 3'.
\turnoffactive \putwordpage\tie\refx{#1-pg}{}%
- \fi
+ \fi\fi
\fi
\endlink
\endgroup}
+% Output a cross-manual xref to #1. Used just above (twice).
+%
+% Only include the text "Section ``foo'' in" if the foo is neither
+% missing or Top. Thus, @xref{,,,foo,The Foo Manual} outputs simply
+% "see The Foo Manual", the idea being to refer to the whole manual.
+%
+% But, this being TeX, we can't easily compare our node name against the
+% string "Top" while ignoring the possible spaces before and after in
+% the input. By adding the arbitrary 7sp below, we make it much less
+% likely that a real node name would have the same width as "Top" (e.g.,
+% in a monospaced font). Hopefully it will never happen in practice.
+%
+% For the same basic reason, we retypeset the "Top" at every
+% reference, since the current font is indeterminate.
+%
+\def\crossmanualxref#1{%
+ \setbox\toprefbox = \hbox{Top\kern7sp}%
+ \setbox2 = \hbox{\ignorespaces \printedrefname \unskip \kern7sp}%
+ \ifdim \wd2 > 7sp % nonempty?
+ \ifdim \wd2 = \wd\toprefbox \else % same as Top?
+ \putwordSection{} ``\printedrefname'' \putwordin{}\space
+ \fi
+ \fi
+ #1%
+}
+
% This macro is called from \xrefX for the `[nodename]' part of xref
% output. It's a separate macro only so it can be changed more easily,
% since square brackets don't work well in some documents. Particularly
@@ -8103,7 +8276,7 @@ end
% space to prevent strange expansion errors.)
\def\supereject{\par\penalty -20000\footnoteno =0 }
-% @footnotestyle is meaningful for info output only.
+% @footnotestyle is meaningful for Info output only.
\let\footnotestyle=\comment
{\catcode `\@=11
@@ -8166,6 +8339,8 @@ end
% expands into a box, it must come within the paragraph, lest it
% provide a place where TeX can split the footnote.
\footstrut
+ %
+ % Invoke rest of plain TeX footnote routine.
\futurelet\next\fo@t
}
}%end \catcode `\@=11
@@ -8253,7 +8428,7 @@ end
it from ftp://tug.org/tex/epsf.tex.}
%
\def\image#1{%
- \ifx\epsfbox\thisiundefined
+ \ifx\epsfbox\thisisundefined
\ifwarnednoepsf \else
\errhelp = \noepsfhelp
\errmessage{epsf.tex not found, images will be ignored}%
@@ -8277,6 +8452,13 @@ end
% If the image is by itself, center it.
\ifvmode
\imagevmodetrue
+ \else \ifx\centersub\centerV
+ % for @center @image, we need a vbox so we can have our vertical space
+ \imagevmodetrue
+ \vbox\bgroup % vbox has better behavior than vtop herev
+ \fi\fi
+ %
+ \ifimagevmode
\nobreak\medskip
% Usually we'll have text after the image which will insert
% \parskip glue, so insert it here too to equalize the space
@@ -8286,9 +8468,13 @@ end
\fi
%
% Leave vertical mode so that indentation from an enclosing
- % environment such as @quotation is respected. On the other hand, if
- % it's at the top level, we don't want the normal paragraph indentation.
- \noindent
+ % environment such as @quotation is respected.
+ % However, if we're at the top level, we don't want the
+ % normal paragraph indentation.
+ % On the other hand, if we are in the case of @center @image, we don't
+ % want to start a paragraph, which will create a hsize-width box and
+ % eradicate the centering.
+ \ifx\centersub\centerV\else \noindent \fi
%
% Output the image.
\ifpdf
@@ -8300,7 +8486,10 @@ end
\epsfbox{#1.eps}%
\fi
%
- \ifimagevmode \medskip \fi % space after the standalone image
+ \ifimagevmode
+ \medskip % space after a standalone image
+ \fi
+ \ifx\centersub\centerV \egroup \fi
\endgroup}
@@ -9781,14 +9970,24 @@ directory should work if nowhere else does.}
% In texinfo, backslash is an active character; it prints the backslash
% in fixed width font.
-\catcode`\\=\active
-@def@normalbackslash{{@tt@backslashcurfont}}
+\catcode`\\=\active % @ for escape char from now on.
+
+% The story here is that in math mode, the \char of \backslashcurfont
+% ends up printing the roman \ from the math symbol font (because \char
+% in math mode uses the \mathcode, and plain.tex sets
+% \mathcode`\\="026E). It seems better for @backslashchar{} to always
+% print a typewriter backslash, hence we use an explicit \mathchar,
+% which is the decimal equivalent of "715c (class 7, e.g., use \fam;
+% ignored family value; char position "5C). We can't use " for the
+% usual hex value because it has already been made active.
+@def@normalbackslash{{@tt @ifmmode @mathchar29020 @else @backslashcurfont @fi}}
+@let@backslashchar = @normalbackslash % @backslashchar{} is for user documents.
+
% On startup, @fixbackslash assigns:
% @let \ = @normalbackslash
-
% \rawbackslash defines an active \ to do \backslashcurfont.
% \otherbackslash defines an active \ to be a literal `\' character with
-% catcode other.
+% catcode other. We switch back and forth between these.
@gdef@rawbackslash{@let\=@backslashcurfont}
@gdef@otherbackslash{@let\=@realbackslash}
@@ -9844,10 +10043,13 @@ directory should work if nowhere else does.}
@def@normalslash{/}
% These look ok in all fonts, so just make them not special.
+% @hashchar{} gets its own user-level command, because of #line.
@catcode`@& = @other @def@normalamp{&}
@catcode`@# = @other @def@normalhash{#}
@catcode`@% = @other @def@normalpercent{%}
+@let @hashchar = @normalhash
+
@c Finally, make ` and ' active, so that txicodequoteundirected and
@c txicodequotebacktick work right in, e.g., @w{@code{`foo'}}. If we
@c don't make ` and ' active, @code will not get them as active chars.
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 1cea074fa2b..a983f76ffd3 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -37,7 +37,7 @@
@end macro
@copying
-Copyright @copyright{} 1999-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1999-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -197,6 +197,7 @@ Using @value{tramp}
* Filename Syntax:: @value{tramp} filename conventions.
* Alternative Syntax:: URL-like filename syntax.
* Filename completion:: Filename completion.
+* Ad-hoc multi-hops:: Declaring multiple hops in the file name.
* Remote processes:: Integration with other @value{emacsname} packages.
* Cleanup remote connections:: Cleanup remote connections.
@@ -442,6 +443,11 @@ Support of gateways exists since April 2007.
@ifset emacsgvfs
GVFS integration started in February 2009.
@end ifset
+@ifset emacs
+Remote commands on Windows hosts are available since September 2011.
+@end ifset
+Ad-hoc multi-hop methods (with a changed syntax) have been reenabled
+in November 2011.
In December 2001, @value{tramp} has been added to the XEmacs package
repository. Being part of the Emacs repository happened in June 2002,
@@ -510,7 +516,7 @@ Method}.
@node Connection types
-@section Types of connections made to remote machines.
+@section Types of connections made to remote machines
@cindex connection types, overview
There are two basic types of transfer methods, each with its own
@@ -866,13 +872,24 @@ Newer versions of @option{ssh} (for example OpenSSH 4) offer an option
@option{ControlMaster}. This allows @option{scp} to reuse an existing
@option{ssh} channel, which increases performance.
-Before you use this method, you shall check whether your @option{ssh}
-implementation does support this option. Try from the command line
+Before you use this method, you should check whether your @option{ssh}
+implementation supports this option. Try from the command line
@example
-ssh localhost -o ControlMaster=yes
+ssh localhost -o ControlMaster=yes /bin/true
@end example
+If that command succeeds silently, then you can use @option{scpc}; but
+if it fails like
+
+@example
+command-line: line 0: Bad configuration option: ControlMaster
+@end example
+
+then you cannot use it. Note, that the option
+@option{ControlPersist}, if it is supported by your @option{ssh}
+version, must be set to @option{no}.
+
This method supports the @samp{-p} argument.
@@ -967,8 +984,8 @@ This is another not natural @value{tramp} method. It uses the
@command{smbclient} command on different Unices in order to connect to
an SMB server. An SMB server might be a Samba (or CIFS) server on
another UNIX host or, more interesting, a host running MS Windows. So
-far, it is tested against MS Windows NT, MS Windows 2000, and MS
-Windows XP.
+far, it is tested against MS Windows NT, MS Windows 2000, MS Windows
+XP, MS Windows Vista, and MS Windows 7.
The first directory in the localname must be a share name on the remote
host. Remember that the @code{$} character, in which default shares
@@ -1250,8 +1267,8 @@ See the documentation for the variable
One trap to fall in must be known. If @value{tramp} finds a default
user, this user will be passed always to the connection command as
-parameter (for example @samp{ssh here.somewhere.else -l john}. If you
-have specified another user for your command in its configuration
+parameter (for example @command{ssh here.somewhere.else -l john}. If
+you have specified another user for your command in its configuration
files, @value{tramp} cannot know it, and the remote access will fail.
If you have specified in the given example in @file{~/.ssh/config} the
lines
@@ -1310,19 +1327,21 @@ because @samp{/:} is the prefix for quoted file names.
@cindex multi-hop
@cindex proxy hosts
-Sometimes, the methods described before are not sufficient. Sometimes,
-it is not possible to connect to a remote host using a simple command.
-For example, if you are in a secured network, you might have to log in
-to a `bastion host' first before you can connect to the outside world.
-Of course, the target host may also require a bastion host.
+Sometimes, the methods described before are not sufficient.
+Sometimes, it is not possible to connect to a remote host using a
+simple command. For example, if you are in a secured network, you
+might have to log in to a bastion host first before you can connect to
+the outside world. Of course, the target host may also require a
+bastion host.
@vindex tramp-default-proxies-alist
-In order to specify such multiple hops, it is possible to define a proxy
+@defopt tramp-default-proxies-alist
+In order to specify multiple hops, it is possible to define a proxy
host to pass through, via the variable
@code{tramp-default-proxies-alist}. This variable keeps a list of
triples (@var{host} @var{user} @var{proxy}).
- The first matching item specifies the proxy host to be passed for a
+The first matching item specifies the proxy host to be passed for a
file name located on a remote target matching @var{user}@@@var{host}.
@var{host} and @var{user} are regular expressions or @code{nil}, which
is interpreted as a regular expression which always matches.
@@ -1389,8 +1408,8 @@ host, wouldn't be useful here.
@var{host}, @var{user} and @var{proxy} can also be Lisp forms. These
forms are evaluated, and must return a string, or @code{nil}. The
previous example could be generalized then: For all hosts except my
-local one connect via @code{ssh} first, and apply @code{sudo -u root}
-afterwards:
+local one connect via @command{ssh} first, and apply @command{sudo -u
+root} afterwards:
@lisp
(add-to-list 'tramp-default-proxies-alist
@@ -1425,6 +1444,26 @@ following rule:
Gateway methods can be declared as first hop only in a multiple hop
chain.
@end ifset
+@end defopt
+
+Hops to be passed tend to be restricted firewalls and alike.
+Sometimes they offer limited features only, like running @command{rbash}
+(restricted bash). This must be told to @value{tramp}.
+
+@vindex tramp-restricted-shell-hosts-alist
+@defopt tramp-restricted-shell-hosts-alist
+This variable keeps a list of regular expressions, which denote hosts
+running a registered shell like "rbash". Those hosts can be used as
+proxies only.
+
+If the bastion host from the example above runs a restricted shell,
+you shall apply
+
+@lisp
+(add-to-list 'tramp-restricted-shell-hosts-alist
+ "\\`bastion\\.your\\.domain\\'")
+@end lisp
+@end defopt
@node Customizing Methods
@@ -1562,7 +1601,7 @@ Example:
@node Password handling
-@section Reusing passwords for several connections.
+@section Reusing passwords for several connections
@cindex passwords
Sometimes it is necessary to connect to the same remote host several
@@ -1636,7 +1675,7 @@ parameters}.
@node Connection caching
-@section Reusing connection related information.
+@section Reusing connection related information
@cindex caching
@vindex tramp-persistency-file-name
@@ -1681,7 +1720,7 @@ connection again.
@node Remote Programs
-@section How @value{tramp} finds and uses programs on the remote machine.
+@section How @value{tramp} finds and uses programs on the remote machine
@value{tramp} depends on a number of programs on the remote host in order to
function, including @command{ls}, @command{test}, @command{find} and
@@ -1858,7 +1897,7 @@ Maybe some shells ask other questions when they are started.
@value{tramp} does not know how to answer these questions. There are
two approaches for dealing with this problem. One approach is to take
care that the shell does not ask any questions when invoked from
-@value{tramp}. You can do this by checking the @code{TERM}
+@value{tramp}. You can do this by checking the @env{TERM}
environment variable, it will be set to @code{dumb} when connecting.
@vindex tramp-terminal-type
@@ -1889,9 +1928,9 @@ the variable @code{tramp-actions-before-shell}. Example:
@item Environment variables named like users in @file{.profile}
-If you have a user named frumple and set the variable @code{FRUMPLE} in
+If you have a user named frumple and set the variable @env{FRUMPLE} in
your shell environment, then this might cause trouble. Maybe rename
-the variable to @code{FRUMPLE_DIR} or the like.
+the variable to @env{FRUMPLE_DIR} or the like.
This weird effect was actually reported by a @value{tramp} user!
@@ -1916,7 +1955,7 @@ understand this syntax and will emit a syntax error when it reaches
this line.
Another example is the tilde (@code{~}) character, say when adding
-@file{~/bin} to @code{PATH}. Many Bourne shells will not expand this
+@file{~/bin} to @env{PATH}. Many Bourne shells will not expand this
character, and since there is usually no directory whose name consists
of the single character tilde, strange things will happen.
@@ -1951,10 +1990,10 @@ output robustly. When calling an interactive shell by @kbd{M-x
shell}, this doesn't look nice.
You can redefine the shell prompt by checking the environment variable
-@code{INSIDE_EMACS}, which is set by @value{tramp}, in your startup
-script @file{~/.emacs_SHELLNAME}. @code{SHELLNAME} might be the string
+@env{INSIDE_EMACS}, which is set by @value{tramp}, in your startup
+script @file{~/.emacs_SHELLNAME}. @env{SHELLNAME} might be the string
@code{bash} or similar, in case of doubt you could set it the
-environment variable @code{ESHELL} in your @file{.emacs}:
+environment variable @env{ESHELL} in your @file{.emacs}:
@lisp
(setenv "ESHELL" "bash")
@@ -2168,7 +2207,7 @@ If you want to use either @option{ssh} based method on Windows, then
you might encounter problems with @command{ssh-agent}. Using this
program, you can avoid typing the pass-phrase every time you log in.
However, if you start @value{emacsname} from a desktop shortcut, then
-the environment variable @code{SSH_AUTH_SOCK} is not set and so
+the environment variable @env{SSH_AUTH_SOCK} is not set and so
@value{emacsname} and thus @value{tramp} and thus @command{ssh} and
@command{scp} started from @value{tramp} cannot communicate with
@command{ssh-agent}. It works better to start @value{emacsname} from
@@ -2206,6 +2245,7 @@ minute you have already forgotten that you hit that key!
* Filename Syntax:: @value{tramp} filename conventions.
* Alternative Syntax:: URL-like filename syntax.
* Filename completion:: Filename completion.
+* Ad-hoc multi-hops:: Declaring multiple hops in the file name.
* Remote processes:: Integration with other @value{emacsname} packages.
* Cleanup remote connections:: Cleanup remote connections.
@end menu
@@ -2446,16 +2486,56 @@ always cached values for the directory contents.
@end defopt
+@node Ad-hoc multi-hops
+@section Declaring multiple hops in the file name
+@cindex multi-hop, ad-hoc
+@cindex proxy hosts, ad-hoc
+
+Multiple hops are configured with the variable
+@code{tramp-default-proxies-alist} (@pxref{Multi-hops}). However,
+sometimes it is desirable to reach a remote host immediately, without
+configuration changes. This can be reached by an ad-hoc specification
+of the proxies.
+
+A proxy looks like a remote file name specification without the local
+file name part. It is prepended to the target remote file name,
+separated by @samp{|}. As an example, a remote file on
+@samp{you@@remotehost}, passing the proxy @samp{bird@@bastion}, could
+be opened by
+
+@example
+@c @kbd{C-x C-f @trampfn{ssh@value{postfixhop}bird@@bastion|ssh, you,
+@c remotehost, /path}}
+@kbd{C-x C-f @value{prefix}ssh@value{postfixhop}bird@@bastion|ssh@value{postfixhop}you@@remotehost@value{postfix}/path}
+@end example
+
+Multiple hops can be cascaded, separating all proxies by @samp{|}.
+The proxies can also contain the patterns @code{%h} or @code{%u}.
+
+The ad-hoc definition is added on the fly to
+@code{tramp-default-proxies-alist}. Therefore, during the lifetime of
+the @value{emacsname} session it is not necessary to enter this ad-hoc
+specification, again. The remote file name @samp{@trampfn{ssh, you,
+remotehost, /path}} would be sufficient from now on.
+
+@vindex tramp-save-ad-hoc-proxies
+@defopt tramp-save-ad-hoc-proxies
+This customer option controls whether ad-hoc definitions are kept
+persistently in @code{tramp-default-proxies-alist}. That means, those
+definitions are available also for future @value{emacsname} sessions.
+@end defopt
+
+
@node Remote processes
-@section Integration with other @value{emacsname} packages.
+@section Integration with other @value{emacsname} packages
@cindex compile
@cindex recompile
@value{tramp} supports running processes on a remote host. This
allows to exploit @value{emacsname} packages without modification for
-remote file names. It does not work for the @option{ftp} and
-@option{smb} methods. Association of a pty, as specified in
-@code{start-file-process}, is not supported.
+remote file names. It does not work for the @option{ftp} method.
+Association of a pty, as specified in @code{start-file-process}, is
+not supported.
@code{process-file} and @code{start-file-process} work on the remote
host when the variable @code{default-directory} is remote:
@@ -2494,9 +2574,9 @@ Programs}):
The environment for your program can be adapted by customizing
@code{tramp-remote-process-environment}. This variable is a list of
strings. It is structured like @code{process-environment}. Each
-element is a string of the form ENVVARNAME=VALUE. An entry
-ENVVARNAME= disables the corresponding environment variable, which
-might have been set in your init file like @file{~/.profile}.
+element is a string of the form @code{"ENVVARNAME=VALUE"}. An entry
+@code{"ENVVARNAME="} disables the corresponding environment variable,
+which might have been set in your init file like @file{~/.profile}.
@noindent
Adding an entry can be performed via @code{add-to-list}:
@@ -2508,7 +2588,7 @@ Adding an entry can be performed via @code{add-to-list}:
Changing or removing an existing entry is not encouraged. The default
values are chosen for proper @value{tramp} work. Nevertheless, if for
example a paranoid system administrator disallows changing the
-@code{HISTORY} environment variable, you can customize
+@env{HISTORY} environment variable, you can customize
@code{tramp-remote-process-environment}, or you can apply the
following code in your @file{.emacs}:
@@ -2527,7 +2607,7 @@ integrate them as well. @xref{Bug Reports}.
If you want to run a remote program, which shall connect the X11
server you are using with your local host, you can set the
-@code{DISPLAY} environment variable on the remote host:
+@env{DISPLAY} environment variable on the remote host:
@lisp
(add-to-list 'tramp-remote-process-environment
@@ -2548,7 +2628,7 @@ that host.
@subsection Running @code{shell} on a remote host
@cindex shell
-Calling @code{M-x shell} in a buffer related to a remote host runs the
+Calling @kbd{M-x shell} in a buffer related to a remote host runs the
local shell as defined in @option{shell-file-name}. This might be
also a valid path name for a shell to be applied on the remote host,
but it will fail at least when your local and remote hosts belong to
@@ -2581,13 +2661,18 @@ hosts. Example:
You will see the buffer @file{*Async Shell Command*}, containing the
continuous output of the @command{tail} command.
+@ifset emacs
+A similar behaviour can be reached by @kbd{M-x auto-revert-tail-mode},
+if available.
+@end ifset
+
@subsection Running @code{eshell} on a remote host
@cindex eshell
@value{tramp} is integrated into @file{eshell.el}. That is, you can
open an interactive shell on your remote host, and run commands there.
-After you have started @code{M-x eshell}, you could perform commands
+After you have started @kbd{M-x eshell}, you could perform commands
like this:
@example
@@ -2663,8 +2748,40 @@ means, file names as arguments must be given as ordinary relative or
absolute file names, without any remote specification.
+@subsection Running remote processes on Windows hosts
+@cindex winexe
+@cindex powershell
+
+With the help of the @command{winexe} it is possible tu run processes
+on a remote Windows host. @value{tramp} has implemented this for
+@code{process-file} and @code{start-file-process}.
+
+The variable @code{tramp-smb-winexe-program} must contain the file
+name of your local @command{winexe} command. On the remote host,
+Powershell V2.0 must be installed; it is used to run the remote
+process.
+
+In order to open a remote shell on the Windows host via @kbd{M-x
+shell}, you must set the variables @option{explicit-shell-file-name}
+and @option{explicit-*-args}. If you want, for example, run
+@command{cmd}, you must set:
+
+@lisp
+(setq explicit-shell-file-name "cmd"
+ explicit-cmd-args '("/q"))
+@end lisp
+
+@noindent
+In case of running @command{powershell} as remote shell, the settings are
+
+@lisp
+(setq explicit-shell-file-name "powershell"
+ explicit-powershell-args '("-file" "-"))
+@end lisp
+
+
@node Cleanup remote connections
-@section Cleanup remote connections.
+@section Cleanup remote connections
@cindex cleanup
Sometimes it is useful to cleanup remote connections. The following
@@ -2736,6 +2853,9 @@ If you can identify a minimal test case that reproduces the problem,
include that with your bug report. This will make it much easier for
the development team to analyze and correct the problem.
+Sometimes, there might be also problems due to Tramp caches. Flush
+all caches before running the test, @ref{Cleanup remote connections}.
+
Before reporting the bug, you should set the verbosity level to 6
(@pxref{Traces and Profiles, Traces}) in the @file{~/.emacs} file and
repeat the bug. Then, include the contents of the @file{*tramp/foo*}
@@ -2798,7 +2918,8 @@ information about remote hosts is kept in the file specified in
@code{tramp-persistency-file-name}. Keep this file. If you are
confident that files on remote hosts are not changed out of
@value{emacsname}' control, set @code{remote-file-name-inhibit-cache}
-to @code{nil}.
+to @code{nil}. Set also @code{tramp-completion-reread-directory-timeout}
+to @code{nil}, @ref{Filename completion}.
Disable version control. If you access remote files which are not
under version control, a lot of check operations can be avoided by
@@ -2860,7 +2981,7 @@ Echoed characters after login
When the remote machine opens an echoing shell, there might be control
characters in the welcome message. @value{tramp} tries to suppress
-such echoes via the @code{stty -echo} command, but sometimes this
+such echoes via the @command{stty -echo} command, but sometimes this
command is not reached, because the echoed output has confused
@value{tramp} already. In such situations it might be helpful to use
the @option{sshx} or @option{scpx} methods, which allocate a pseudo tty.
@@ -2887,10 +3008,10 @@ checksum.
@lisp
(add-hook
- 'find-file-hooks
- '(lambda ()
- (when (file-remote-p default-directory)
- (set (make-local-variable 'file-precious-flag) t))))
+ 'find-file-hook
+ (lambda ()
+ (when (file-remote-p default-directory)
+ (set (make-local-variable 'file-precious-flag) t))))
@end lisp
@end itemize
@@ -2915,6 +3036,20 @@ Host *
@item
+How can I use @samp{ControlPersist}?
+
+When @samp{ControlPersist} is set to @samp{yes}, the @option{scpc}
+method does not work. You can use @option{scpx} instead with the
+following settings in @file{~/.ssh/config}:
+
+@example
+Host *
+ ControlMaster auto
+ ControlPersist yes
+@end example
+
+
+@item
File name completion does not work with @value{tramp}
When you log in to the remote machine, do you see the output of
@@ -2992,7 +3127,7 @@ into your @file{~/.emacs}:
(setq mode-line-format
(format-mode-line mode-line-format 'font-lock-warning-face))))
-(add-hook 'find-file-hooks 'my-mode-line-function)
+(add-hook 'find-file-hook 'my-mode-line-function)
(add-hook 'dired-mode-hook 'my-mode-line-function)
@end lisp
@end ifset
@@ -3025,10 +3160,10 @@ should put it into your @file{~/.emacs}:
(add-hook
'dired-mode-hook
- '(lambda ()
- (setq
- mode-line-buffer-identification
- my-mode-line-buffer-identification)))
+ (lambda ()
+ (setq
+ mode-line-buffer-identification
+ my-mode-line-buffer-identification)))
@end lisp
Since @value{emacsname} 23.1, the mode line contains an indication if
@@ -3061,9 +3196,9 @@ like this:
@lisp
(add-hook
'dired-before-readin-hook
- '(lambda ()
- (when (file-remote-p default-directory)
- (setq dired-actual-switches "-al"))))
+ (lambda ()
+ (when (file-remote-p default-directory)
+ (setq dired-actual-switches "-al"))))
@end lisp
@end ifset
@@ -3195,9 +3330,9 @@ minibuffer:
(add-hook
'minibuffer-setup-hook
- '(lambda ()
- (abbrev-mode 1)
- (setq local-abbrev-table my-tramp-abbrev-table)))
+ (lambda ()
+ (abbrev-mode 1)
+ (setq local-abbrev-table my-tramp-abbrev-table)))
(defadvice minibuffer-complete
(before my-minibuffer-complete activate)
@@ -3264,7 +3399,7 @@ their readability through a remote access:
@ifset xemacs
(recent-files-initialize)
(add-hook
- 'find-file-hooks
+ 'find-file-hook
(lambda ()
(when (file-remote-p (buffer-file-name))
(recent-files-make-permanent)))
@@ -3376,7 +3511,7 @@ could write a script @file{emacsclient.sh}:
emacsclient @trampfn{ssh, $(whoami), $(hostname --fqdn), $1}
@end example
-Then you must set the environment variable @code{EDITOR} pointing to
+Then you must set the environment variable @env{EDITOR} pointing to
that script:
@example
@@ -3468,7 +3603,7 @@ This resets also the @value{ftppackagename} plugins.
@node Localname deconstruction
-@section Breaking a localname into its components.
+@section Breaking a localname into its components
@value{tramp} file names are somewhat different, obviously, to ordinary file
names. As such, the lisp functions @code{file-name-directory} and
@@ -3485,7 +3620,7 @@ effect while preserving the @value{tramp} file name information.
@ifset emacs
@node External packages
-@section Integration with external Lisp packages.
+@section Integration with external Lisp packages
@subsection Filename completion.
While reading filenames in the minibuffer, @value{tramp} must decide
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index 63dc78dc4e8..96043a07300 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -2,13 +2,13 @@
@c texi/trampver.texi. Generated from trampver.texi.in by configure.
@c This is part of the Emacs manual.
-@c Copyright (C) 2003-2011 Free Software Foundation, Inc.
+@c Copyright (C) 2003-2012 Free Software Foundation, Inc.
@c See file doclicense.texi for copying conditions.
@c In the Tramp CVS, the version number is auto-frobbed from
@c configure.ac, so you should edit that file and run
@c "autoconf && ./configure" to change the version number.
-@set trampver 2.2.3-24.1
+@set trampver 2.2.7-pre
@c Other flags from configuration
@set instprefix /usr/local
diff --git a/doc/misc/url.texi b/doc/misc/url.texi
index 42594457ab1..90ab7f5554f 100644
--- a/doc/misc/url.texi
+++ b/doc/misc/url.texi
@@ -18,9 +18,9 @@
@end direntry
@copying
-This file documents the Emacs Lisp URL loading package.
+This is the manual for the @code{url} Emacs Lisp library.
-Copyright @copyright{} 1993-1999, 2002, 2004-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1993-1999, 2002, 2004-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -57,10 +57,10 @@ developing GNU and promoting software freedom.''
@end ifnottex
@menu
-* Getting Started:: Preparing your program to use URLs.
+* Introduction:: About the @code{url} library.
+* URI Parsing:: Parsing (and unparsing) URIs.
* Retrieving URLs:: How to use this package to retrieve a URL.
* Supported URL Types:: Descriptions of URL types currently supported.
-* Defining New URLs:: How to define a URL loader for a new protocol.
* General Facilities:: URLs can be cached, accessed via a gateway
and tracked in a history list.
* Customization:: Variables you can alter.
@@ -70,90 +70,129 @@ developing GNU and promoting software freedom.''
* Concept Index::
@end menu
-@node Getting Started
-@chapter Getting Started
-@cindex URLs, definition
-@cindex URIs
+@node Introduction
+@chapter Introduction
+@cindex URL
+@cindex URI
+@cindex uniform resource identifier
+@cindex uniform resource locator
-@dfn{Uniform Resource Locators} (URLs) are a specific form of
-@dfn{Uniform Resource Identifiers} (URI) described in RFC 2396 which
-updates RFC 1738 and RFC 1808. RFC 2016 defines uniform resource
-agents.
+A @dfn{Uniform Resource Identifier} (URI) is a specially-formatted
+name, such as an Internet address, that identifies some name or
+resource. The format of URIs is described in RFC 3986, which updates
+and replaces the earlier RFCs 2732, 2396, 1808, and 1738. A
+@dfn{Uniform Resource Locator} (URL) is an older but still-common
+term, which basically refers to a URI corresponding to a resource that
+can be accessed (usually over a network) in a specific way.
-URIs have the form @var{scheme}:@var{scheme-specific-part}, where the
-@var{scheme}s supported by this library are described below.
-@xref{Supported URL Types}.
+ Here are some examples of URIs (taken from RFC 3986):
-FTP, NFS, HTTP, HTTPS, @code{rlogin}, @code{telnet}, tn3270,
-IRC and gopher URLs all have the form
+@example
+ftp://ftp.is.co.za/rfc/rfc1808.txt
+http://www.ietf.org/rfc/rfc2396.txt
+ldap://[2001:db8::7]/c=GB?objectClass?one
+mailto:John.Doe@@example.com
+news:comp.infosystems.www.servers.unix
+tel:+1-816-555-1212
+telnet://192.0.2.16:80/
+urn:oasis:names:specification:docbook:dtd:xml:4.1.2
+@end example
+
+ This manual describes the @code{url} library, an Emacs Lisp library
+for parsing URIs and retrieving the resources to which they refer.
+(The library is so-named for historical reasons; nowadays, the ``URI''
+terminology is regarded as the more general one, and ``URL'' is
+technically obsolete despite its widespread vernacular usage.)
+
+@node URI Parsing
+@chapter URI Parsing
+
+ A URI consists of several @dfn{components}, each having a different
+meaning. For example, the URI
@example
-@var{scheme}://@r{[}@var{userinfo}@@@r{]}@var{hostname}@r{[}:@var{port}@r{]}@r{[}/@var{path}@r{]}
+http://www.gnu.org/software/emacs/
@end example
+
@noindent
-where @samp{@r{[}} and @samp{@r{]}} delimit optional parts.
-@var{userinfo} sometimes takes the form @var{username}:@var{password}
-but you should beware of the security risks of sending cleartext
-passwords. @var{hostname} may be a domain name or a dotted decimal
-address. If the @samp{:@var{port}} is omitted then the library will
-use the `well known' port for that service when accessing URLs. With
-the possible exception of @code{telnet}, it is rare for ports to be
-specified, and it is possible using a non-standard port may have
-undesired consequences if a different service is listening on that
-port (e.g., an HTTP URL specifying the SMTP port can cause mail to be
-sent). @c , but @xref{Other Variables, url-bad-port-list}.
-The meaning of the @var{path} component depends on the service.
+specifies the scheme component @samp{http}, the hostname component
+@samp{www.gnu.org}, and the path component @samp{/software/emacs/}.
+
+@cindex parsed URIs
+ The format of URIs is specified by RFC 3986. The @code{url} library
+provides the Lisp function @code{url-generic-parse-url}, a (mostly)
+standard-compliant URI parser, as well as function
+@code{url-recreate-url}, which converts a parsed URI back into a URI
+string.
+
+@defun url-generic-parse-url uri-string
+This function returns a parsed version of the string @var{uri-string}.
+@end defun
-@menu
-* Configuration::
-* Parsed URLs:: URLs are parsed into vector structures.
-@end menu
+@defun url-recreate-url uri-obj
+@cindex unparsing URLs
+Given a parsed URI, this function returns the corresponding URI string.
+@end defun
-@node Configuration
-@section Configuration
+@cindex parsed URI
+ The return value of @code{url-generic-parse-url}, and the argument
+expected by @code{url-recreate-url}, is a @dfn{parsed URI}: a CL
+structure whose slots hold the various components of the URI.
+@xref{top,the CL Manual,,cl,GNU Emacs Common Lisp Emulation}, for
+details about CL structures. Most of the other functions in the
+@code{url} library act on parsed URIs.
-@defvar url-configuration-directory
-@cindex @file{~/.url}
-@cindex configuration files
-The directory in which URL configuration files, the cache etc.,
-reside. The old default was @file{~/.url}, and this directory
-is still used if it exists. The new default is a @file{url/}
-directory in @code{user-emacs-directory}, which is normally
-@file{~/.emacs.d}.
-@end defvar
+@menu
+* Parsed URIs:: Format of parsed URI structures.
+* URI Encoding:: Non-@acronym{ASCII} characters in URIs.
+@end menu
-@node Parsed URLs
-@section Parsed URLs
-@cindex parsed URLs
-The library functions typically operate on @dfn{parsed} versions of
-URLs. These are actually vectors of the form:
+@node Parsed URIs
+@section Parsed URI structures
-@example
-[@var{type} @var{user} @var{password} @var{host} @var{port} @var{file} @var{target} @var{attributes} @var{full}]
-@end example
+ Each parsed URI structure contains the following slots:
-@noindent where
-@table @var
+@table @code
@item type
-is the type of the URL scheme, e.g., @code{http}
+The URI scheme (a string, e.g.@: @code{http}). @xref{Supported URL
+Types}, for a list of schemes that the @code{url} library knows how to
+process. This slot can also be @code{nil}, if the URI is not fully
+specified.
+
@item user
-is the username associated with it, or @code{nil};
+The user name (a string), or @code{nil}.
+
@item password
-is the user password associated with it, or @code{nil};
+The user password (a string), or @code{nil}. The use of this URI
+component is strongly discouraged; nowadays, passwords are transmitted
+by other means, not as part of a URI.
+
@item host
-is the host name associated with it, or @code{nil};
+The host name (a string), or @code{nil}. If present, this is
+typically a domain name or IP address.
+
@item port
-is the port number associated with it, or @code{nil};
-@item file
-is the `file' part of it, or @code{nil}. This doesn't necessarily
-actually refer to a file;
+The port number (an integer), or @code{nil}. Omitting this component
+usually means to use the ``standard'' port associated with the URI
+scheme.
+
+@item filename
+The combination of the ``path'' and ``query'' components of the URI (a
+string), or @code{nil}. If the query component is present, it is the
+substring following the first @samp{?} character, and the path
+component is the substring before the @samp{?}. The meaning of these
+components is scheme-dependent; they do not necessarily refer to a
+file on a disk.
+
@item target
-is the target part, or @code{nil};
-@item attributes
-is the attributes associated with it, or @code{nil};
-@item full
-is @code{t} for a fully-specified URL, with a host part indicated by
-@samp{//} after the scheme part.
+The fragment component (a string), or @code{nil}. The fragment
+component specifies a ``secondary resource'', such as a section of a
+webpage.
+
+@item fullness
+This is @code{t} if the URI is fully specified, i.e.@: the
+hierarchical components of the URI (the hostname and/or username
+and/or password) are preceded by @samp{//}.
@end table
@findex url-type
@@ -161,110 +200,204 @@ is @code{t} for a fully-specified URL, with a host part indicated by
@findex url-password
@findex url-host
@findex url-port
-@findex url-file
+@findex url-filename
@findex url-target
@findex url-attributes
-@findex url-full
-@findex url-set-type
-@findex url-set-user
-@findex url-set-password
-@findex url-set-host
-@findex url-set-port
-@findex url-set-file
-@findex url-set-target
-@findex url-set-attributes
-@findex url-set-full
-These attributes have accessors named @code{url-@var{part}}, where
-@var{part} is the name of one of the elements above, e.g.,
-@code{url-host}. Similarly, there are setters of the form
-@code{url-set-@var{part}}.
-
-There are functions for parsing and unparsing between the string and
-vector forms.
-
-@defun url-generic-parse-url url
-Return a parsed version of the string @var{url}.
+@findex url-fullness
+These slots have accessors named @code{url-@var{part}}, where
+@var{part} is the slot name. For example, the accessor for the
+@code{host} slot is the function @code{url-host}. The @code{url-port}
+accessor returns the default port for the URI scheme if the parsed
+URI's @var{port} slot is @code{nil}.
+
+ The slots can be set using @code{setf}. For example:
+
+@example
+(setf (url-port url) 80)
+@end example
+
+@node URI Encoding
+@section URI Encoding
+
+@cindex percent encoding
+ The @code{url-generic-parse-url} parser does not obey RFC 3986 in
+one respect: it allows non-@acronym{ASCII} characters in URI strings.
+
+ Strictly speaking, RFC 3986 compatible URIs may only consist of
+@acronym{ASCII} characters; non-@acronym{ASCII} characters are
+represented by converting them to UTF-8 byte sequences, and performing
+@dfn{percent encoding} on the bytes. For example, the o-umlaut
+character is converted to the UTF-8 byte sequence @samp{\xD3\xA7},
+then percent encoded to @samp{%D3%A7}. (Certain ``reserved''
+@acronym{ASCII} characters must also be percent encoded when they
+appear in URI components.)
+
+ The function @code{url-encode-url} can be used to convert a URI
+string containing arbitrary characters to one that is properly
+percent-encoded in accordance with RFC 3986.
+
+@defun url-encode-url url-string
+This function return a properly URI-encoded version of
+@var{url-string}. It also performs @dfn{URI normalization},
+e.g.@: converting the scheme component to lowercase if it was
+previously uppercase.
@end defun
-@defun url-recreate-url url
-@cindex unparsing URLs
-Recreates a URL string from the parsed @var{url}.
+ To convert between a string containing arbitrary characters and a
+percent-encoded all-@acronym{ASCII} string, use the functions
+@code{url-hexify-string} and @code{url-unhex-string}:
+
+@defun url-hexify-string string &optional allowed-chars
+This function performs percent-encoding on @var{string}, and returns
+the result.
+
+If @var{string} is multibyte, it is first converted to a UTF-8 byte
+string. Each byte corresponding to an allowed character is left
+as-is, while all other bytes are converted to a three-character
+sequence: @samp{%} followed by two upper-case hex digits.
+
+@vindex url-unreserved-chars
+@cindex unreserved characters
+The allowed characters are specified by @var{allowed-chars}. If this
+argument is @code{nil}, the allowed characters are those specified as
+@dfn{unreserved characters} by RFC 3986 (see the variable
+@code{url-unreserved-chars}). Otherwise, @var{allowed-chars} should
+be a vector whose @var{n}-th element is non-@code{nil} if character
+@var{n} is allowed.
+@end defun
+
+@defun url-unhex-string string &optional allow-newlines
+This function replaces percent-encoding sequences in @var{string} with
+their character equivalents, and returns the resulting string.
+
+If @var{allow-newlines} is non-@code{nil}, it allows the decoding of
+carriage returns and line feeds, which are normally forbidden in URIs.
@end defun
@node Retrieving URLs
@chapter Retrieving URLs
+ The @code{url} library defines the following three functions for
+retrieving the data specified by a URL. The actual retrieval protocol
+depends on the URL's URI scheme, and is performed by lower-level
+scheme-specific functions. (Those lower-level functions are not
+documented here, and generally should not be called directly.)
+
+ In each of these functions, the @var{url} argument can be either a
+string or a parsed URL structure. If it is a string, that string is
+passed through @code{url-encode-url} before using it, to ensure that
+it is properly URI-encoded (@pxref{URI Encoding}).
+
@defun url-retrieve-synchronously url
-Retrieve @var{url} synchronously and return a buffer containing the
-data. @var{url} is either a string or a parsed URL structure. Return
-@code{nil} if there are no data associated with it (the case for dired,
-info, or mailto URLs that need no further processing).
+This function synchronously retrieves the data specified by @var{url},
+and returns a buffer containing the data. The return value is
+@code{nil} if there is no data associated with the URL (as is the case
+for @code{dired}, @code{info}, and @code{mailto} URLs).
+@end defun
+
+@defun url-retrieve url callback &optional cbargs silent no-cookies
+This function retrieves @var{url} asynchronously, calling the function
+@var{callback} when the object has been completely retrieved. The
+return value is the buffer into which the data will be inserted, or
+@code{nil} if the process has already completed.
+
+The callback function is called this way:
+
+@example
+(apply @var{callback} @var{status} @var{cbargs})
+@end example
+
+@noindent
+where @var{status} is a plist representing what happened during the
+retrieval, with most recent events first, or an empty list if no
+events have occurred. Each pair in the plist is one of:
+
+@table @code
+@item (:redirect @var{redirected-to})
+This means that the request was redirected to the URL
+@var{redirected-to}.
+
+@item (:error (@var{error-symbol} . @var{data}))
+This means that an error occurred. If so desired, the error can be
+signaled with @code{(signal @var{error-symbol} @var{data})}.
+@end table
+
+When the callback function is called, the current buffer is the one
+containing the retrieved data (if any). The buffer also contains any
+MIME headers associated with the data retrieval.
+
+If the optional argument @var{silent} is non-@code{nil}, progress
+messages are suppressed. If the optional argument @var{no-cookies} is
+non-@code{nil}, cookies are not stored or sent.
@end defun
-@defun url-retrieve url callback &optional cbargs
-Retrieve @var{url} asynchronously and call @var{callback} with args
-@var{cbargs} when finished. The callback is called when the object
-has been completely retrieved, with the current buffer containing the
-object and any MIME headers associated with it. @var{url} is either a
-string or a parsed URL structure. Returns the buffer @var{url} will
-load into, or @code{nil} if the process has already completed.
+@defun url-queue-retrieve url callback &optional cbargs silent no-cookies
+This function acts like @code{url-retrieve}, but with limits on the
+number of concurrently-running network processes. The option
+@code{url-queue-parallel-processes} controls the number of concurrent
+processes, and the option @code{url-queue-timeout} sets a timeout in
+seconds.
+
+To use this function, you must @code{(require 'url-queue)}.
@end defun
+@vindex url-queue-parallel-processes
+@defopt url-queue-parallel-processes
+The value of this option is an integer specifying the maximum number
+of concurrent @code{url-queue-retrieve} network processes. If the
+number of @code{url-queue-retrieve} calls is larger than this number,
+later ones are queued until earlier ones are finished.
+@end defopt
+
+@vindex url-queue-timeout
+@defopt url-queue-timeout
+The value of this option is a number specifying the maximum lifetime
+of a @code{url-queue-retrieve} network process, once it is started.
+If a process is not finished by then, it is killed and removed from
+the queue.
+@end defopt
+
@node Supported URL Types
@chapter Supported URL Types
+This chapter describes functions and variables affecting URL retrieval
+for specific schemes.
+
@menu
* http/https:: Hypertext Transfer Protocol.
* file/ftp:: Local files and FTP archives.
-* info:: Emacs `Info' pages.
+* info:: Emacs "Info" pages.
* mailto:: Sending email.
* news/nntp/snews:: Usenet news.
* rlogin/telnet/tn3270:: Remote host connectivity.
* irc:: Internet Relay Chat.
* data:: Embedded data URLs.
* nfs:: Networked File System
-@c * finger::
-@c * gopher::
-@c * netrek::
-@c * prospero::
-* cid:: Content-ID.
-* about::
* ldap:: Lightweight Directory Access Protocol
-* imap:: IMAP mailboxes.
* man:: Unix man pages.
@end menu
@node http/https
@section @code{http} and @code{https}
-The scheme @code{http} is Hypertext Transfer Protocol. The library
-supports version 1.1, specified in RFC 2616. (This supersedes 1.0,
-defined in RFC 1945) HTTP URLs have the following form, where most of
-the parts are optional:
-@example
-http://@var{user}:@var{password}@@@var{host}:@var{port}/@var{path}?@var{searchpart}#@var{fragment}
-@end example
-@c The @code{:@var{port}} part is optional, and @var{port} defaults to
-@c 80. The @code{/@var{path}} part, if present, is a slash-separated
-@c series elements. The @code{?@var{searchpart}}, if present, is the
-@c query for a search or the content of a form submission. The
-@c @code{#fragment} part, if present, is a location in the document.
-
-The scheme @code{https} is a secure version of @code{http}, with
-transmission via SSL. It is defined in RFC 2069. Its default port is
-443. This scheme depends on SSL support in Emacs via the
-@file{ssl.el} library and is actually implemented by forcing the
-@code{ssl} gateway method to be used. @xref{Gateways in general}.
+The @code{http} scheme refers to the Hypertext Transfer Protocol. The
+@code{url} library supports HTTP version 1.1, specified in RFC 2616.
+Its default port is 80.
+
+ The @code{https} scheme is a secure version of @code{http}, with
+transmission via SSL. It is defined in RFC 2069, and its default port
+is 443. When using @code{https}, the @code{url} library performs SSL
+encryption via the @code{ssl} library, by forcing the @code{ssl}
+gateway method to be used. @xref{Gateways in general}.
@defopt url-honor-refresh-requests
-This controls honoring of HTTP @samp{Refresh} headers by which
-servers can direct clients to reload documents from the same URL or a
-or different one. @code{nil} means they will not be honored,
-@code{t} (the default) means they will always be honored, and
-otherwise the user will be asked on each request.
+If this option is non-@code{nil} (the default), the @code{url} library
+honors the HTTP @samp{Refresh} header, which is used by servers to
+direct clients to reload documents from the same URL or a or different
+one. If the value is @code{nil}, the @samp{Refresh} header is
+ignored; any other value means to ask the user on each request.
@end defopt
-
@menu
* Cookies::
* HTTP language/coding::
@@ -396,26 +529,32 @@ emacs-mime, The Emacs MIME Manual}.
@cindex compressed files
@cindex dired
+The @code{ftp} and @code{file} schemes are defined in RFC 1808. The
+@code{url} library treats @samp{ftp:} and @samp{file:} as synonymous.
+Such URLs have the form
+
@example
ftp://@var{user}:@var{password}@@@var{host}:@var{port}/@var{file}
file://@var{user}:@var{password}@@@var{host}:@var{port}/@var{file}
@end example
-These schemes are defined in RFC 1808.
-@samp{ftp:} and @samp{file:} are synonymous in this library. They
-allow reading arbitrary files from hosts. Either @samp{ange-ftp}
-(Emacs) or @samp{efs} (XEmacs) is used to retrieve them from remote
-hosts. Local files are accessed directly.
+@noindent
+If the URL specifies a local file, it is retrieved by reading the file
+contents in the usual way. If it specifies a remote file, it is
+retrieved using the Ange-FTP package. @xref{Remote Files,,, emacs,
+The GNU Emacs Manual}.
-Compressed files are handled, but support is hard-coded so that
-@code{jka-compr-compression-info-list} and so on have no affect.
-Suffixes recognized are @samp{.z}, @samp{.gz}, @samp{.Z} and
-@samp{.bz2}.
+ When retrieving a compressed file, it is automatically uncompressed
+if it has the file suffix @file{.z}, @file{.gz}, @file{.Z},
+@file{.bz2}, or @file{.xz}. (The list of supported suffixes is
+hard-coded, and cannot be altered by customizing
+@code{jka-compr-compression-info-list}.)
@defopt url-directory-index-file
-The filename to look for when indexing a directory, default
-@samp{"index.html"}. If this file exists, and is readable, then it
-will be viewed instead of using @code{dired} to view the directory.
+This option specifies the filename to look for when a @code{file} or
+@code{ftp} URL specifies a directory. The default is
+@file{index.html}. If this file exists and is readable, it is viewed.
+Otherwise, Emacs visits the directory using Dired.
@end defopt
@node info
@@ -424,47 +563,53 @@ will be viewed instead of using @code{dired} to view the directory.
@cindex Texinfo
@findex Info-goto-node
+The @code{info} scheme is non-standard. Such URLs have the form
+
@example
info:@var{file}#@var{node}
@end example
-Info URLs are not officially defined. They invoke
-@code{Info-goto-node} with argument @samp{(@var{file})@var{node}}.
-@samp{#@var{node}} is optional, defaulting to @samp{Top}.
+@noindent
+and are retrieved by invoking @code{Info-goto-node} with argument
+@samp{(@var{file})@var{node}}. If @samp{#@var{node}} is omitted, the
+@samp{Top} node is opened.
@node mailto
@section mailto
@cindex mailto
@cindex email
-A mailto URL will send an email message to the address in the
-URL, for example @samp{mailto:foo@@bar.com} would compose a
-message to @samp{foo@@bar.com}.
-
-@defopt url-mail-command
-@vindex mail-user-agent
-The function called whenever url needs to send mail. This should
-normally be left to default from @var{mail-user-agent}. @xref{Mail
-Methods, , Mail-Composition Methods, emacs, The GNU Emacs Manual}.
-@end defopt
+A @code{mailto} URL specifies an email message to be sent to a given
+email address. For example, @samp{mailto:foo@@bar.com} specifies
+sending a message to @samp{foo@@bar.com}. The ``retrieval method''
+for such URLs is to open a mail composition buffer in which the
+appropriate content (e.g.@: the recipient address) has been filled in.
-An @samp{X-Url-From} header field containing the URL of the document
-that contained the mailto URL is added if that URL is known.
+ As defined in RFC 2368, a @code{mailto} URL has the form
-RFC 2368 extends the definition of mailto URLs in RFC 1738.
-The form of a mailto URL is
@example
@samp{mailto:@var{mailbox}[?@var{header}=@var{contents}[&@var{header}=@var{contents}]]}
@end example
-@noindent where an arbitrary number of @var{header}s can be added. If the
-@var{header} is @samp{body}, then @var{contents} is put in the body
-otherwise a @var{header} header field is created with @var{contents}
-as its contents. Note that the URL library does not consider any
-headers `dangerous' so you should check them before sending the
-message.
-@c Fixme: update
-Email messages are defined in @sc{rfc}822.
+@noindent
+where an arbitrary number of @var{header}s can be added. If the
+@var{header} is @samp{body}, then @var{contents} is put in the message
+body; otherwise, a @var{header} header field is created with
+@var{contents} as its contents. Note that the @code{url} library does
+not perform any checking of @var{header} or @var{contents}, so you
+should check them before sending the message.
+
+@defopt url-mail-command
+@vindex mail-user-agent
+The value of this variable is the function called whenever url needs
+to send mail. This should normally be left its default, which is the
+standard mail-composition command @code{compose-mail}. @xref{Sending
+Mail,,, emacs, The GNU Emacs Manual}.
+@end defopt
+
+ If the document containing the @code{mailto} URL itself possessed a
+known URL, Emacs automatically inserts an @samp{X-Url-From} header
+field into the mail buffer, specifying that URL.
@node news/nntp/snews
@section @code{news}, @code{nntp} and @code{snews}
@@ -474,11 +619,13 @@ Email messages are defined in @sc{rfc}822.
@cindex NNTP
@cindex snews
-@c draft-gilman-news-url-01
-The network news URL scheme take the following forms following RFC
-1738 except that for compatibility with other clients, host and port
-fields may be included in news URLs though they are properly only
-allowed for nntp an snews.
+The @code{news}, @code{nntp}, and @code{snews} schemes, defined in RFC
+1738, are used for reading Usenet newsgroups. For compatibility with
+non-standard-compliant news clients, the @code{url} library allows
+host and port fields to be included in @code{news} URLs, even though
+they are properly only allowed for @code{nntp} and @code{snews}.
+
+ @code{news} and @code{nntp} URLs have the following form:
@table @samp
@item news:@var{newsgroup}
@@ -493,24 +640,22 @@ Retrieves a list of all available newsgroups;
Similar to the @samp{news} versions.
@end table
-@samp{:@var{port}} is optional and defaults to :119.
-
-@samp{snews} is the same as @samp{nntp} except that the default port
-is :563.
-@cindex SSL
-(It is tunneled through SSL.)
+ The default port for @code{nntp} (and @code{news}) is 119. The
+difference between an @code{nntp} URL and a @code{news} URL is that an
+@code{nttp} URL may specify an article by its number. The
+@samp{snews} scheme is the same as @samp{nntp}, except that it is
+tunneled through SSL and has default port 563.
-An @samp{nntp} URL is the same as a news URL, except that the URL may
-specify an article by its number.
+ These URLs are retrieved via the Gnus package.
-@defopt url-news-server
-This variable can be used to override the default news server.
-Usually this will be set by the Gnus package, which is used to fetch
-news.
@cindex environment variable
@vindex NNTPSERVER
-It may be set from the conventional environment variable
-@code{NNTPSERVER}.
+@defopt url-news-server
+This variable specifies the default news server from which to fetch
+news, if no server was specified in the URL. The default value,
+@code{nil}, means to use the server specified by the standard
+environment variable @samp{NNTPSERVER}, or @samp{news} if that
+environment variable is unset.
@end defopt
@node rlogin/telnet/tn3270
@@ -521,12 +666,15 @@ It may be set from the conventional environment variable
@cindex terminal emulation
@findex terminal-emulator
-These URL schemes from RFC 1738 for logon via a terminal emulator have
-the form
+These URL schemes are defined in RFC 1738, and are used for logging in
+via a terminal emulator. They have the form
+
@example
telnet://@var{user}:@var{password}@@@var{host}:@var{port}
@end example
-but the @code{:@var{password}} component is ignored.
+
+@noindent
+but the @var{password} component is ignored.
To handle rlogin, telnet and tn3270 URLs, a @code{rlogin},
@code{telnet} or @code{tn3270} (the program names and arguments are
@@ -540,39 +688,43 @@ Well-known ports are used if the URL does not specify a port.
@cindex ZEN IRC
@cindex ERC
@cindex rcirc
-@c Fixme: reference (was http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt)
-@dfn{Internet Relay Chat} (IRC) is handled by handing off the @sc{irc}
-session to a function named in @code{url-irc-function}.
+
+ The @code{irc} scheme is defined in the Internet Draft at
+@url{http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt} (which
+was never approved as an RFC). Such URLs have the form
+
+@example
+irc://@var{host}:@var{port}/@var{target},@var{needpass}
+@end example
+
+@noindent
+and are retrieved by opening an @acronym{IRC} session using the
+function specified by @code{url-irc-function}.
@defopt url-irc-function
-A function to actually open an IRC connection.
-This function
-must take five arguments, @var{host}, @var{port}, @var{channel},
-@var{user} and @var{password}. The @var{channel} argument specifies the
-channel to join immediately, this can be @code{nil}. By default this is
-@code{url-irc-rcirc}.
+The value of this option is a function, which is called to open an IRC
+connection for @code{irc} URLs. This function must take five
+arguments, @var{host}, @var{port}, @var{channel}, @var{user} and
+@var{password}. The @var{channel} argument specifies the channel to
+join immediately, and may be @code{nil}.
+
+The default is @code{url-irc-rcirc}, which uses the Rcirc package.
+Other options are @code{url-irc-erc} (which uses ERC) and
+@code{url-irc-zenirc} (which uses ZenIRC).
@end defopt
-@defun url-irc-rcirc host port channel user password
-Processes the arguments and lets @code{rcirc} handle the session.
-@end defun
-@defun url-irc-erc host port channel user password
-Processes the arguments and lets @code{ERC} handle the session.
-@end defun
-@defun url-irc-zenirc host port channel user password
-Processes the arguments and lets @code{zenirc} handle the session.
-@end defun
@node data
@section data
@cindex data URLs
+ The @code{data} scheme, defined in RFC 2397, contains MIME data in
+the URL itself. Such URLs have the form
+
@example
data:@r{[}@var{media-type}@r{]}@r{[};@var{base64}@r{]},@var{data}
@end example
-Data URLs contain MIME data in the URL itself. They are defined in
-RFC 2397.
-
+@noindent
@var{media-type} is a MIME @samp{Content-Type} string, possibly
including parameters. It defaults to
@samp{text/plain;charset=US-ASCII}. The @samp{text/plain} can be
@@ -585,14 +737,14 @@ present, the @var{data} are base64-encoded.
@cindex Network File System
@cindex automounter
+The @code{nfs} scheme, defined in RFC 2224, is similar to @code{ftp}
+except that it points to a file on a remote host that is handled by an
+NFS automounter on the local host. Such URLs have the form
+
@example
nfs://@var{user}:@var{password}@@@var{host}:@var{port}/@var{file}
@end example
-The @samp{nfs:} scheme is defined in RFC 2224. It is similar to
-@samp{ftp:} except that it points to a file on a remote host that is
-handled by the automounter on the local host.
-
@defvar url-nfs-automounter-directory-spec
@end defvar
A string saying how to invoke the NFS automounter. Certain @samp{%}
@@ -615,15 +767,6 @@ A literal @samp{%}.
Each can be used any number of times.
-@node cid
-@section cid
-@cindex Content-ID
-
-RFC 2111
-
-@node about
-@section about
-
@node ldap
@section ldap
@cindex LDAP
@@ -631,50 +774,21 @@ RFC 2111
The LDAP scheme is defined in RFC 2255.
-@node imap
-@section imap
-@cindex IMAP
-
-RFC 2192
-
@node man
@section man
@cindex @command{man}
@cindex Unix man pages
@findex man
+The @code{man} scheme is a non-standard one. Such URLs have the form
+
@example
@samp{man:@var{page-spec}}
@end example
-This is a non-standard scheme. @var{page-spec} is passed directly to
-the Lisp @code{man} function.
-
-@node Defining New URLs
-@chapter Defining New URLs
-
-@menu
-* Naming conventions::
-* Required functions::
-* Optional functions::
-* Asynchronous fetching::
-* Supporting file-name-handlers::
-@end menu
-
-@node Naming conventions
-@section Naming conventions
-
-@node Required functions
-@section Required functions
-
-@node Optional functions
-@section Optional functions
-
-@node Asynchronous fetching
-@section Asynchronous fetching
-
-@node Supporting file-name-handlers
-@section Supporting file-name-handlers
+@noindent
+and are retrieved by passing @var{page-spec} to the Lisp function
+@code{man}.
@node General Facilities
@chapter General Facilities
@@ -997,7 +1111,7 @@ This the @samp{nslookup} program. It is @code{"nslookup"} by default.
In some circumstances it is desirable to suppress making network
connections. A typical case is when rendering HTML in a mail user
agent, when external URLs should not be activated, particularly to
-avoid `bugs' which `call home' by fetch single-pixel images and the
+avoid ``bugs'' which ``call home'' by fetch single-pixel images and the
like. To arrange this, bind the following variable for the duration
of such processing.
@@ -1050,7 +1164,7 @@ automatically via @code{url-do-setup} when it is configured to be on.
Note that the size of the history list is currently not limited.
@vindex url-history-hash-table
-The history `list' is actually a hash table,
+The history ``list'' is actually a hash table,
@code{url-history-hash-table}. It contains access times keyed by URL
strings. The times are in the format returned by @code{current-time}.
@@ -1095,11 +1209,9 @@ You can use this function to do completion of URLs from the history.
@node Customization
@chapter Customization
-@section Environment Variables
-
@cindex environment variables
-The following environment variables affect the library's operation at
-startup.
+ The following environment variables affect the @code{url} library's
+operation at startup.
@table @code
@item TMPDIR
@@ -1109,10 +1221,21 @@ If this is defined, @var{url-temporary-directory} is initialized from
it.
@end table
-@section General User Options
+ The following user options affect the general operation of
+@code{url} library.
-The following user options, settable with Customize, affect the
-general operation of the package.
+@defopt url-configuration-directory
+@cindex configuration files
+The value of this variable specifies the name of the directory where
+the @code{url} library stores its various configuration files, cache
+files, etc.
+
+The default value specifies a subdirectory named @file{url/} in the
+standard Emacs user data directory specified by the variable
+@code{user-emacs-directory} (normally @file{~/.emacs.d}). However,
+the old default was @file{~/.url}, and this directory is used instead
+if it exists.
+@end defopt
@defopt url-debug
@cindex debugging
diff --git a/doc/misc/vip.texi b/doc/misc/vip.texi
index 03ca65882e5..0d9bb286330 100644
--- a/doc/misc/vip.texi
+++ b/doc/misc/vip.texi
@@ -3,7 +3,7 @@
@settitle VIP
@copying
-Copyright @copyright{} 1987, 2001-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1987, 2001-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -1705,7 +1705,7 @@ expressions}. For example, a typical forward search would be invoked by
@var{pat} you must preceded it by @samp{\}. VIP strips off these @kbd{\}'s
before @kbd{/} and the resulting @var{pat} becomes the actual search
pattern. Emacs provides a different and richer class or regular
-expressions than Vi/Ex, and VIP uses Emacs' regular expressions. See GNU
+expressions than Vi/Ex, and VIP uses Emacs's regular expressions. See GNU
Emacs Manual for details of regular expressions.
Several Ex commands can be entered in a line by separating them by a pipe
diff --git a/doc/misc/viper.texi b/doc/misc/viper.texi
index 1f0dffee5b4..94f7e53ce8c 100644
--- a/doc/misc/viper.texi
+++ b/doc/misc/viper.texi
@@ -7,7 +7,7 @@
@setfilename ../../info/viper
@copying
-Copyright @copyright{} 1995-1997, 2001-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 1995-1997, 2001-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -25,9 +25,7 @@ developing GNU and promoting software freedom.''
@dircategory Emacs misc features
@direntry
-* VIPER: (viper). The newest Emacs VI-emulation mode.
- (also, A VI Plan for Emacs Rescue
- or the VI PERil.)
+* VIPER: (viper). A VI-emulation mode for Emacs.
@end direntry
@finalout
@@ -687,7 +685,7 @@ Insert state. For instance, Emacs has a @dfn{yank} command, @kbd{C-y},
which is similar to Vi's @kbd{p}. However, unlike @kbd{p}, @kbd{C-y} can be
used in Insert state of Viper. Emacs also has a kill ring where it keeps
pieces of text you deleted while editing buffers. The command @kbd{M-y} is
-used to delete the text previously put back by Emacs' @kbd{C-y} or by Vi's
+used to delete the text previously put back by Emacs's @kbd{C-y} or by Vi's
@kbd{p} command and reinsert text that was placed on the kill-ring earlier.
This works both in Vi and Insert states.
@@ -1289,7 +1287,7 @@ the following example:
The above discussion of the meaning of Viper's words concerns only Viper's
movement commands. In regular expressions, words remain the same as in
Emacs. That is, the expressions @code{\w}, @code{\>}, @code{\<}, etc., use
-Emacs' idea of what is a word, and they don't look into the value of
+Emacs's idea of what is a word, and they don't look into the value of
variable @code{viper-syntax-preference}. This is because Viper doesn't change
syntax tables in fear of upsetting the various major modes that set these
tables.
@@ -2504,7 +2502,7 @@ major modes.
@item viper-minibuffer-emacs-face 'viper-minibuffer-emacs-face
These faces control the appearance of the minibuffer text in the
corresponding Viper states. You can change the appearance of these faces
-through Emacs' customization widget, which is accessible through the
+through Emacs's customization widget, which is accessible through the
menubar.
Viper is located in this widget under the @emph{Emulations} customization
@@ -3205,7 +3203,7 @@ in the appropriate major mode hooks.
The above discussion concerns only the movement commands. In regular
expressions, words remain the same as in Emacs. That is, the expressions
-@code{\w}, @code{\>}, @code{\<}, etc., use Emacs' idea of what is a word,
+@code{\w}, @code{\>}, @code{\<}, etc., use Emacs's idea of what is a word,
and they don't look into the value of variable
@code{viper-syntax-preference}. This is because Viper avoids changing
syntax tables in order to not thwart the various major modes that set these
diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi
index a778f491e76..24fe3e63ac9 100644
--- a/doc/misc/widget.texi
+++ b/doc/misc/widget.texi
@@ -8,7 +8,7 @@
@c %**end of header
@copying
-Copyright @copyright{} 2000-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 2000-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/woman.texi b/doc/misc/woman.texi
index c869d1a46c7..7f72b5faafb 100644
--- a/doc/misc/woman.texi
+++ b/doc/misc/woman.texi
@@ -18,7 +18,7 @@
This file documents WoMan: A program to browse Unix manual pages `W.O.
(without) man'.
-Copyright @copyright{} 2001-2011 Free Software Foundation, Inc.
+Copyright @copyright{} 2001-2012 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -94,7 +94,7 @@ Mile End Road, London E1 4NS, UK
* Log:: The *WoMan-Log* Buffer
* Technical:: Technical Details
* Bugs:: Reporting Bugs
-* Acknowledgements:: Acknowledgements
+* Acknowledgments:: Acknowledgments
* GNU Free Documentation License:: The license for this documentation.
* Command Index:: Command Index
* Variable Index:: Variable Index
@@ -432,7 +432,7 @@ slow. @xref{Cache, , The WoMan Topic Cache}, for further details.
@menu
* Cache:: The WoMan Topic Cache
-* Word at point:: Using the ``Word at Point'' as a Topic Suggestion
+* Word at point:: Using the "Word at Point" as a Topic Suggestion
@end menu
@node Cache, Word at point, Topic, Topic
@@ -472,7 +472,7 @@ time it is run in a new Emacs session.
@node Word at point, , Cache, Topic
@comment node-name, next, previous, up
-@subsection Using the ``Word at Point'' as a Topic Suggestion
+@subsection Using the "Word at Point" as a Topic Suggestion
@cindex word at point
@cindex point, word at
@@ -1306,7 +1306,7 @@ is output.
@c ===================================================================
-@node Bugs, Acknowledgements, Technical, Top
+@node Bugs, Acknowledgments, Technical, Top
@comment node-name, next, previous, up
@chapter Reporting Bugs
@cindex reporting bugs
@@ -1331,10 +1331,10 @@ man source file from, but do not send it unless asked to send it.
@c ===================================================================
-@node Acknowledgements, GNU Free Documentation License, Bugs, Top
+@node Acknowledgments, GNU Free Documentation License, Bugs, Top
@comment node-name, next, previous, up
-@chapter Acknowledgements
-@cindex acknowledgements
+@chapter Acknowledgments
+@cindex acknowledgments
For Heather, Kathryn and Madelyn, the women in my life (although they
will probably never use it)!
@@ -1388,7 +1388,7 @@ Eli Zaretskii, @email{eliz@@is.elta.co.il}
@page
-@node GNU Free Documentation License, Command Index, Acknowledgements, Top
+@node GNU Free Documentation License, Command Index, Acknowledgments, Top
@appendix GNU Free Documentation License
@include doclicense.texi
diff --git a/etc/AUTHORS b/etc/AUTHORS
index b7929dbf453..e6e8137141e 100644
--- a/etc/AUTHORS
+++ b/etc/AUTHORS
@@ -3,15 +3,13 @@ Foundation's distribution of GNU Emacs. To show our appreciation for
their public spirit, we list here in alphabetical order a condensed
list of their contributions.
-Aaa Bbb: changed org-archive.el
-
Aaron Ecay: changed nsterm.m
Aaron Larson: co-wrote bibtex.el
-Aaron S. Hawley: changed files.texi morse.el add-log.el autoinsert.el
- building.texi custom.texi files.el glossary.texi isearch.el
- jka-cmpr-hook.el misc.texi re-builder.el sgml-mode.el tar-mode.el
+Aaron S. Hawley: changed files.texi morse.el tar-mode.el add-log.el
+ autoinsert.el building.texi custom.texi files.el glossary.texi
+ isearch.el jka-cmpr-hook.el misc.texi re-builder.el sgml-mode.el
texinfo.el thingatpt.el tutorial.el
Abraham Nahum: changed configure.in dgux4.h sysdep.c
@@ -31,6 +29,8 @@ Adam Sjøgren: changed spam.el blink.xpm braindamaged.xpm cry.xpm dead.xpm
reverse-smile.xpm sad.xpm smile.xpm wry.xpm xterm.c gnus-html.el
gnus-start.el gnus-sum.el gnus.el gtkutil.c shr.el xterm.h
+Adam Spiers: changed calendar.el
+
Adam W: changed mail-source.el
Aditya Siram: changed ob.el
@@ -53,8 +53,6 @@ and changed nsterm.m nsfns.m nsfont.m nsterm.h Makefile.in nsmenu.m
Agustín Martín: changed ispell.el flyspell.el fixit.texi
-Agustín Martín Domingo: changed flyspell.el ispell.el
-
Aidan Kehoe: changed ipa.el lread.c mm-util.el erc-log.el erc.el
gnus-sum.el gnus-util.el latin-ltx.el nnfolder.el ob-tangle.el
objects.texi
@@ -72,10 +70,10 @@ Alakazam Petrofsky: changed hanoi.el
Alan Mackenzie: wrote cc-awk.el
and co-wrote cc-align.el cc-cmds.el cc-defs.el cc-engine.el cc-fonts.el
cc-langs.el cc-mode.el cc-styles.el cc-vars.el
-and changed cc-mode.texi lread.c programs.texi isearch.el lisp.el
- cc-subword.el display.texi font-lock.el modes.texi os.texi search.texi
- startup.el subr.el text.texi INSTALL.BZR add-log.el buffers.texi
- bytecomp.el callint.c cc-fix.el cc-menus.el and 21 other files
+and changed cc-mode.texi lread.c programs.texi font-lock.el font-core.el
+ isearch.el lisp.el modes.texi cc-subword.el display.texi os.texi
+ search.texi startup.el subr.el text.texi INSTALL.BZR add-log.el
+ buffers.texi bytecomp.el callint.c cc-fix.el and 22 other files
Alan Shutko: changed diary-lib.el calendar.el bindings.el cal-hebrew.el
easy-mmode.el gnus-sum.el ibuf-ext.el ibuffer.el lunar.el macros.el
@@ -89,9 +87,6 @@ Aleksei Gusev: changed progmodes/compile.el
Alex Coventry: changed files.el
-Alex Harsanyi: changed soap-client.el emacs3.py soap-inspect.el
- vc-hooks.el vc.el
-
Alex Ott: changed TUTORIAL.ru ru-refcard.tex ispell.el ru-refcard.ps
Alex Rezinsky: wrote which-func.el
@@ -99,7 +94,7 @@ Alex Rezinsky: wrote which-func.el
Alex Schroeder: wrote ansi-color.el cus-theme.el erc-compat.el
erc-hecomplete.el erc-join.el erc-lang.el erc-ring.el master.el
spam-stat.el sql.el
-and co-wrote longlines.el rmailmm.el
+and co-wrote longlines.el mail/rmailmm.el
and changed erc.el erc-track.el erc-button.el erc-stamp.el erc-match.el
erc-autoaway.el erc-nickserv.el rcirc.texi erc-autojoin.el erc-fill.el
erc-pcomplete.el erc-complete.el erc-ibuffer.el erc-members.el rmail.el
@@ -117,7 +112,7 @@ Alexander Kreuzer: changed nnrss.el
Alexander L. Belikoff: wrote erc.el
-Alexander Pohoyda: co-wrote rmailmm.el
+Alexander Pohoyda: co-wrote mail/rmailmm.el
and changed rmailsum.el man.el rmail.el sendmail.el
Alexander Shopov: changed code-pages.el
@@ -133,6 +128,7 @@ and changed unexelf.c format.el iris4d.h iris5d.h regex.c unexsgi.c
Alexandre Veyrenc: changed fr-refcard.tex
Alexandru Harsanyi: wrote soap-client.el soap-inspect.el
+and changed emacs3.py vc-hooks.el vc.el xml.el
Alfred Correira: changed generic-x.el
@@ -147,11 +143,13 @@ Alin C. Soare: changed lisp-mode.el hexl.el
Allen S. Rout: changed org-capture.el
+Alon Albert: wrote rcompile.el
+
Alp Aker: changed nsfont.m nsterm.h nsterm.m buff-menu.el configure.in
nsfns.m nsmenu.m
Ami Fischman: changed bindings.el calendar.el diary-lib.el print.c
- savehist.el
+ savehist.el vc-git.el
Anand Mitra: changed gnus-sum.el
@@ -186,18 +184,20 @@ and changed erc.el erc-bbdb.el erc-button.el erc-log.el erc-stamp.el
Andreas Jaeger: changed gnus-msg.el gnus-start.el gnus-xmas.el
nnfolder.el nnml.el
+Andreas Leha: changed ob.el
+
Andreas Leue: changed artist.el
Andreas Luik: changed xfns.c xterm.c
-Andreas Politz: changed editfns.c elp.el ido.el term.el
+Andreas Politz: changed editfns.c elp.el ido.el outline.el term.el
Andreas Rottmann: changed emacsclient.1 emacsclient.c misc.texi server.el
Andreas Schwab: changed Makefile.in configure.in lisp.h xdisp.c alloc.c
- process.c coding.c files.el xterm.c editfns.c keyboard.c fns.c print.c
- emacs.c eval.c fileio.c lread.c sysdep.c dired.el xfns.c buffer.c
- and 571 other files
+ process.c coding.c files.el keyboard.c xterm.c editfns.c emacs.c fns.c
+ print.c eval.c fileio.c lread.c sysdep.c dired.el xfns.c buffer.c
+ and 577 other files
Andreas Seltenreich: changed nnweb.el gnus.texi message.el gnus-sum.el
gnus.el nnslashdot.el gnus-srvr.el gnus-util.el mm-url.el mm-uu.el
@@ -249,19 +249,21 @@ and changed erc.el
Angelo Graziosi: changed sysdep.c term.c
+Anmol Khirbat: changed ido.el
+
Anna M. Bigatti: wrote cal-html.el
Antoine Levitt: changed gnus-group.el gnus-sum.el message.texi ada-prj.el
ange-ftp.el cus-edit.el dired-x.el ebnf2ps.el emerge.el erc-button.el
- erc-track.el files.el find-file.el gnus-art.el gnus-uu.el gnus.el
- gnus.texi message.el mh-funcs.el mh-mime.el printing.el
- and 5 other files
+ erc-goodies.el erc-track.el files.el find-file.el gnus-art.el
+ gnus-uu.el gnus.el gnus.texi message.el mh-funcs.el mh-mime.el
+ and 7 other files
Ari Roponen: changed atimer.c doc.c mule.texi startup.el time-date.el
Arisawa Akihiro: changed characters.el coding.c epa-file.el japan-util.el
- message.el mm-decode.el mm-view.el ps-print.el tai-viet.el term.c
- tibetan.el time.el utf-8.el
+ language/tibetan.el message.el mm-decode.el mm-view.el ps-print.el
+ tai-viet.el term.c time.el utf-8.el
Arnaud Giersch: changed gnus-sum.el
@@ -294,13 +296,13 @@ and changed c++-mode.el cplus-md1.el syntax.c syntax.h
Barry Fishman: changed gnu-linux.h
-Bastien Guerry: wrote gnus-bookmark.el org-latex.el org-protocol.el
-and co-wrote org-bibtex.el org-list.el org-src.el
-and changed org.el org-html.el org-agenda.el org-clock.el org-exp.el
- org-capture.el org-timer.el org-export-latex.el org-table.el
- org-publish.el org.texi org-ascii.el bookmark.el info.el ob.el
- org-archive.el org-attach.el org-crypt.el org-gnus.el org-mobile.el
- rmail.el and 20 other files
+Bastien Guerry: wrote gnus-bookmark.el org-latex.el
+and co-wrote org-bibtex.el org-list.el org-protocol.el org-src.el
+and changed org.el org-agenda.el org-html.el org-clock.el org-exp.el
+ org.texi org-table.el org-capture.el org-publish.el org-timer.el
+ org-export-latex.el org-archive.el org-ascii.el org-colview.el
+ org-exp-blocks.el org-mobile.el ob.el org-eshell.el bookmark.el info.el
+ org-attach.el and 36 other files
Ben A. Mesander: co-wrote erc-dcc.el
@@ -332,7 +334,7 @@ and changed vc.el gnus-msg.el message.el diff-mode.el ffap.el nnimap.el
Bernhard Herzog: changed vc-hg.el menu.c xsmfns.c
Bernt Hansen: changed org-agenda.el org-clock.el org.el org-capture.el
- org-indent.el
+ org-html.el org-indent.el org.texi
Bill Atkins: changed wdired.el
@@ -431,9 +433,7 @@ Brian Preble: changed abbrev.el apropos.el asm-mode.el awk-mode.el
compare-w.el compile.el dabbrev.el debug.el diary.el diff.el dired.el
doctex.el doctor.el ebuff-menu.el echistory.el and 129 other files
-Brian Sniffen: changed gnus-draft.el
-
-Brian T. Sniffen: changed imap.el
+Brian Sniffen: changed gnus-draft.el imap.el mm-decode.el
Bruno Haible: co-wrote po.el
and changed INSTALL emacs.1 epaths.in info.el paths.el
@@ -469,7 +469,7 @@ and changed org-latex.el org.texi org-publish.el orgcard.tex
org-export-latex.el org-colview-xemacs.el org-docbook.el org-attach.el
org-mouse.el org-protocol.el org-mac-message.el org-wl.el org-crypt.el
org-freemind.el idlw-rinfo.el org-exp-blocks.el org-habit.el org-mhe.el
- org-plot.el reftex.texi ob.el and 24 other files
+ org-plot.el org-special-blocks.el reftex.texi and 24 other files
Caveh Jalali: changed configure.in intel386.h sol2-4.h
@@ -497,16 +497,17 @@ Chip Coldwell: changed font.c
Chong Yidong: wrote compile-tests.el dichromacy-theme.el
font-parse-tests.el redisplay-testsuite.el tabulated-list.el
and co-wrote longlines.el tango-dark-theme.el tango-theme.el
-and changed xdisp.c simple.el files.el display.texi frames.texi
- cus-edit.el files.texi keyboard.c startup.el package.el custom.el
- emacs.texi xterm.c subr.el text.texi faces.el image.c mouse.el
- misc.texi progmodes/compile.el xfns.c and 830 other files
+and changed xdisp.c simple.el display.texi files.el frames.texi
+ files.texi cus-edit.el keyboard.c custom.el text.texi package.el
+ startup.el faces.el xterm.c emacs.texi misc.texi subr.el image.c
+ mouse.el custom.texi xfns.c and 845 other files
Chris Chase: co-wrote idlw-shell.el idlwave.el
Chris Foote: changed progmodes/python.el
Chris Gray: wrote org-special-blocks.el
+and changed mm-decode.el
Chris Hall: changed callproc.c frame.c
@@ -544,7 +545,7 @@ Christian Lynbech: changed appt.el emacsserver.c tramp.el
Christian Millour: changed shell.el
-Christian Moe: changed org-bbdb.el
+Christian Moe: changed org-bbdb.el org-html.el org-special-blocks.el
Christian Neukirchen: changed mm-util.el
@@ -563,20 +564,24 @@ Christoph Bauer: changed configure.in
Christoph Conrad: changed gnus-agent.el gnus-score.el makefile.w32-in
qp.el
-Christoph Scholtes: changed makefile.w32-in progmodes/python.el stdint.h
- INSTALL README.W32 maintaining.texi zipdist.bat admin.el bookmark.el
- config.nt configure.bat control.texi cua-base.el help-mode.el help.el
- ido.el makedist.bat menu.c minibuf.c process.c progmodes/grep.el
- and 3 other files
+Christoph Scholtes: changed makefile.w32-in README.W32
+ progmodes/python.el stdint.h INSTALL maintaining.texi zipdist.bat
+ admin.el bookmark.el config.nt configure.bat control.texi cua-base.el
+ gmake.defs help-mode.el help.el ido.el make-dist makedist.bat menu.c
+ minibuf.c and 6 other files
Christoph Wedler: wrote antlr-mode.el
and changed format.el gnus-art.el gnus-picon.el message.el register.el
smiley.el texinfmt.el
+Christophe Rhodes: changed org-exp.el
+
Christophe de Dinechin: co-wrote ns-win.el
Christopher Allan Webber: changed gamegrid.el org-agenda.el tetris.el
+Christopher Genovese: changed assoc.el
+
Christopher J. Madsen: wrote decipher.el
and changed replace.el files.el ispell.el time.el
@@ -584,6 +589,8 @@ Christopher J. White: changed url-http.el
Christopher Oliver: changed mouse.el
+Christopher Schmidt: changed ibuffer.el
+
Christopher Suckling: co-wrote org-mac-message.el
Chuck Blake: changed term.c
@@ -660,7 +667,8 @@ and changed vc.el Makefile.in configure.in vc-hg.el vc-git.el vc-bzr.el
Dan Rosenberg: changed movemail.c
-Dani Moncayo: changed lists.texi
+Dani Moncayo: changed buffers.texi lists.texi custom.texi dired.texi
+ makefile.w32-in text.texi
Daniel Brockman: changed cus-start.el format-spec.el ibuffer.el rcirc.el
@@ -668,8 +676,8 @@ Daniel Clemente: changed generic-x.el org-html.el
Daniel Colascione: co-wrote js.el
and changed cmdproxy.c subr.el syntax.el DEBUG cc-engine.el cus-start.el
- eval.c fns.c imenu.el keyboard.c lisp.h nxml-mode.el nxml-rap.el
- nxml-util.el sh-script.el which-func.el
+ eval.c fns.c frames.texi imenu.el keyboard.c lisp.h nxml-mode.el
+ nxml-rap.el nxml-util.el sh-script.el which-func.el
Daniel Dehennin: changed mml2015.el gnus-msg.el mm-decode.el
@@ -680,7 +688,7 @@ Daniel Elliott: changed octave-mod.el
Daniel Engeler: changed sysdep.c elisp.texi emacs.texi internals.texi
misc.texi process.c process.h processes.texi term.el w32.c w32.h
-Daniel Hackney: changed emacsclient.c process.c
+Daniel Hackney: changed emacsclient.c package.el process.c
Daniel Jensen: changed apropos.el
@@ -690,7 +698,7 @@ and changed mlconvert.el eval-region.el
Daniel M Coffman: changed arc-mode.el
-Daniel M German: wrote org-protocol.el
+Daniel M German: co-wrote org-protocol.el
Daniel Néri: changed message.el
@@ -699,7 +707,7 @@ Daniel Ortmann: changed paragraphs.el
Daniel Pfeiffer: wrote conf-mode.el copyright.el executable.el
sh-script.el skeleton.el two-column.el
and co-wrote ada-stmt.el apropos.el progmodes/compile.el wyse50.el
-and changed files.el make-mode.el buff-menu.el font-lock.el mpuz.el
+and changed make-mode.el files.el buff-menu.el font-lock.el mpuz.el
progmodes/grep.el sgml-mode.el autoinsert.el cperl-mode.el facemenu.el
gomoku.el help.el imenu.el autoload.el autorevert.el bindings.el
button.el cc-fonts.el cc-mode.el compilation.txt compile.el
@@ -722,33 +730,34 @@ Darren Stalder: changed gnus-util.el
Darrin B. Jewell: changed etags.c lisp.h
-Dave Abrahams: changed gnus-registry.el gnus-sum.el gnus.texi nnimap.el
- nnir.el nnmairix.el nnregistry.el
-
Dave Detlefs: co-wrote cc-align.el cc-cmds.el cc-defs.el cc-engine.el
cc-langs.el cc-menus.el cc-mode.el cc-styles.el cc-vars.el
Dave Lambert: changed sol2-5.h xfns.c xterm.c xterm.h
Dave Love: wrote autoarg.el autoconf.el benchmark.el cap-words.el
- cfengine.el elide-head.el georgian.el hl-line.el latin1-disp.el
- progmodes/python.el refill.el rfc1345.el sgml-input.el smiley.el
- sym-comp.el tool-bar.el uni-input.el utf-7.el utf-8-lang.el vc-bzr.el
- welsh.el
+ cfengine.el elide-head.el hl-line.el language/georgian.el
+ latin1-disp.el progmodes/python.el quail/georgian.el refill.el
+ rfc1345.el sgml-input.el smiley.el sym-comp.el tool-bar.el uni-input.el
+ utf-7.el utf-8-lang.el vc/vc-bzr.el welsh.el
and co-wrote latin-ltx.el socks.el
and changed Makefile.in configure.in help.el mule-cmds.el fortran.el
- mule-conf.el xterm.c browse-url.el mule.el coding.c cyrillic.el
- european.el fns.c mule-diag.el simple.el wid-edit.el cus-edit.el
- cus-start.el files.el keyboard.c byte-opt.el and 759 other files
+ mule-conf.el xterm.c browse-url.el mule.el coding.c european.el fns.c
+ mule-diag.el simple.el wid-edit.el cus-edit.el cus-start.el files.el
+ keyboard.c byte-opt.el info.el and 770 other files
Dave Pearson: wrote 5x5.el quickurl.el
David A. Capello: changed etags.c
-David Abrahams: changed coding.c ediff-init.el mairix.el
+David Abrahams: changed gnus-sum.el org-agenda.el coding.c ediff-init.el
+ gnus-registry.el gnus.texi mairix.el nnimap.el nnir.el nnmairix.el
+ nnregistry.el org-clock.el
David Bakhash: wrote strokes.el
+David Benjamin: changed xfns.c xterm.c xterm.h
+
David Burger: changed macros.el
David Byers: changed minibuf.c
@@ -758,15 +767,15 @@ David Casperson: changed font-core.el menu-bar.el tex-mode.el
David De La Harpe Golden: changed files.el mouse.el simple.el fileio.c
cus-start.el nsselect.m select.el w32-fns.el x-win.el xterm.c
-David Edmondson: changed message.el gnus-cite.el imap.el mm-view.el
- mml2015.el nnfolder.el nnimap.el nnml.el
+David Edmondson: changed message.el gnus-cite.el imap.el mm-uu.el
+ mm-view.el mml2015.el nnfolder.el nnimap.el nnml.el
David Engster: wrote mairix.el nnmairix.el
-and changed gnus.texi registry.el gnus-msg.el insert.el
+and changed gnus.texi insert.el registry.el db-find.el gnus-msg.el
analyze/complete.el base.el bovine-grammar.el cedet/srecode.el
- cpp-root.el custom.el db-find.el db-typecache.el db.el dictionary.el
- display.texi document.el ede-grammar.el files.el generic.el
- gnus-registry.el gnus-sum.el and 21 other files
+ cpp-root.el db-typecache.el db.el dictionary.el display.texi
+ document.el ede-grammar.el ede/custom.el ede/generic.el files.el
+ filters.el gnus-registry.el and 23 other files
David Gillespie: wrote calc-aent.el calc-alg.el calc-arith.el calc-bin.el
calc-comb.el calc-cplx.el calc-embed.el calc-ext.el calc-fin.el
@@ -800,10 +809,10 @@ David J. MacKenzie: changed configure.in etags.c Makefile.in fakemail.c
b2m.c config.in digest-doc.c emacsclient.c emacsserver.c emacstool.c
etags-vmslib.c fortran.el hexl.c and 14 other files
-David Kastrup: changed greek.el replace.el faq.texi search.c ange-ftp.el
- calc.el help.el keymaps.texi mouse.el subr.el woman.el Makefile.in
- desktop.el gnus-art.el keymap.c keymap.h lisp-mnt.el meta-mode.el
- mpuz.el process.c search.texi and 79 other files
+David Kastrup: changed quail/greek.el replace.el faq.texi search.c
+ ange-ftp.el calc.el help.el keymaps.texi mouse.el subr.el woman.el
+ Makefile.in desktop.el gnus-art.el keymap.c keymap.h lisp-mnt.el
+ meta-mode.el mpuz.el process.c search.texi and 79 other files
David Kågedal: wrote tempo.el
and changed sendmail.el xmenu.c
@@ -824,11 +833,11 @@ David M. Smith: wrote ielm.el
and changed imenu.el pgg-def.el xterm.c
David Maus: co-wrote org-wl.el
-and changed org.el org-feed.el org-html.el org-agenda.el org-exp.el
- org-gnus.el org-capture.el org.texi org-protocol.el org-macs.el
- ob-haskell.el org-bibtex.el org-footnote.el org-id.el org-latex.el
- org-list.el org-mhe.el org-mobile.el org-publish.el org-table.el ob.el
- and 13 other files
+and changed org.el org-agenda.el org-feed.el org-exp.el org-html.el
+ org-macs.el org-capture.el org.texi org-gnus.el org-bbdb.el
+ org-clock.el org-protocol.el org-publish.el ob-haskell.el ob.el
+ org-bibtex.el org-compat.el org-footnote.el org-id.el org-latex.el
+ org-list.el and 20 other files
David McCabe: changed lisp-mode.el
@@ -846,6 +855,7 @@ David Mosberger-Tang: changed alpha.h unexelf.c cm.h config.in
sysdep.c terminfo.c unexelf1.c yow.c
David O'Toole: wrote org-publish.el
+and co-wrote ob-lisp.el
David Ponce: wrote bovine-grammar.el cedet.el comp.el grammar-wy.el
grammar.el java-tags.el mode-local.el recentf.el ruler-mode.el
@@ -859,9 +869,9 @@ and changed w32menu.c w32term.c close.png close.xpm empty.png empty.xpm
David Reitter: wrote mailclient.el
and changed nsterm.m nsfns.m ns-win.el nsfont.m Makefile.in cus-start.el
- macos.texi menu-bar.el simple.el commands.h cus-edit.el easy-mmode.el
- emacsbug.el emacsclient.c faces.el flyspell.el info.el keyboard.c
- keymap.c macterm.c menu.c and 12 other files
+ macos.texi menu-bar.el nsmenu.m simple.el commands.h cus-edit.el
+ easy-mmode.el emacsbug.el emacsclient.c faces.el flyspell.el info.el
+ keyboard.c keymap.c macterm.c and 12 other files
David Robinow: changed makefile.w32-in w32inevt.c
@@ -869,8 +879,6 @@ David Robinson: changed menu-bar.el x-win.el
David S. Goldberg: changed gnus-art.el message.el
-David T. O'Toole: co-wrote ob-lisp.el
-
David Vazquez: changed m4-mode.el
David Z. Maze: changed nnml.el nnrss.el
@@ -897,7 +905,7 @@ Denis Stünkel: changed ibuf-ext.el
Deniz Dogan: changed rcirc.el simple.el css-mode.el commands.texi
image.el iswitchb.el lisp-mode.el process.c progmodes/python.el
- quickurl.el rcirc.texi vc-bzr.el wdired.el window.el
+ quickurl.el rcirc.texi vc/vc-bzr.el wdired.el window.el
Dennis Gilmore: changed sparc.h
@@ -913,7 +921,7 @@ Derek Upham: changed nxml-mode.el
Detlev Zundel: wrote re-builder.el
-Devon Sean Mccullough: changed comint.el
+Devon Sean McCullough: changed comint.el url-http.el
Dhruva Krishnamurthy: changed makefile.w32-in emacsclient.c fontset.c
sound.c w32proc.c
@@ -953,6 +961,8 @@ Dmitry Bolshakov: changed hideshow.el
Dmitry Dzhus: changed gdb-mi.el gud.el fadr.el all.xpm building.texi
emacs.texi process.c thread.xpm
+Dmitry Gutov: changed lisp.el ruby-mode.el
+
Dmitry Kurochkin: changed isearch.el
Dominique de Waleffe: changed pcvs-info.el
@@ -971,10 +981,10 @@ Drake Wilson: changed emacsclient.c files.el misc.texi
Drew Adams: wrote light-blue-theme.el
and co-wrote color.el
-and changed cus-edit.el dired.el faces.el isearch.el menu-bar.el mouse.el
- bindings.el bookmark.el custom.el dired.texi etags.el files.el
- finder.el frame.el help-fns.el help.el image-dired.el info.el
- modes.texi msdog.texi pp.el and 5 other files
+and changed cus-edit.el dired.el faces.el files.el info.el isearch.el
+ menu-bar.el mouse.el ange-ftp.el bindings.el bookmark.el custom.el
+ descr-text.el dired.texi etags.el finder.el frame.el help-fns.el
+ help.el image-dired.el modes.texi and 7 other files
E. Jay Berkenbilt: changed b2m.c flyspell.el ispell.el unrmail.el
whitespace.el window.h
@@ -983,9 +993,9 @@ Ed L. Cashin: changed gnus-sum.el imap.el
Ed Swarthout: changed hexl.el textmodes/table.el
-Eduard Wiebe: changed browse-url.el dired.el flymake.texi footnote.el
- javascript.el korean.el locate.el mule-conf.el nxml-mode.texi
- objects.texi ps-print.el vc-rcs.el
+Eduard Wiebe: changed dired.el browse-url.el flymake.texi footnote.el
+ javascript.el jit-lock.el korean.el locate.el mule-conf.el
+ nxml-mode.texi objects.texi ps-print.el vc-rcs.el
Eduardo Muñoz: changed dired.el ls-lisp.el
@@ -1006,8 +1016,6 @@ and changed erc.el erc-viper.el erc-log.el erc-track.el viper.el
Edward Trumbo: changed Makefile.in
-Edward Wiebe: changed jit-lock.el
-
Edwin Steiner: changed gnus-nocem.el
Ehud Karni: changed rmail.el aviion-intel.h complete.el configure.in
@@ -1021,15 +1029,15 @@ Eli Tziperman: wrote rmail-spam-filter.el
Eli Zaretskii: wrote [bidirectional display in xdisp.c] bidi.c rxvt.el
tty-colors.el
-and changed makefile.w32-in msdos.c xdisp.c Makefile.in files.el
- config.bat fileio.c msdos.h simple.el mainmake.v2 sed1v2.inp info.el
- display.texi rmail.el w32.c process.c pc-win.el startup.el dispextern.h
- dispnew.c dired.c and 697 other files
+and changed makefile.w32-in xdisp.c msdos.c Makefile.in files.el
+ config.bat fileio.c simple.el msdos.h info.el mainmake.v2 rmail.el
+ sed1v2.inp display.texi w32.c pc-win.el process.c dispnew.c startup.el
+ dispextern.h dired.c and 702 other files
Elias Oltmanns: changed tls.el gnus-agent.el gnus-int.el gnus-srvr.el
gnus.el
-Elias Pipping: changed XDelAssoc.c XMakeAssoc.c
+Elias Pipping: changed XDelAssoc.c XMakeAssoc.c shr.el
Emanuele Giaquinta: changed configure.in rxvt.el charset.c etags.c
fontset.c frame.el gnus-faq.texi loadup.el lread.c sh-script.el
@@ -1060,7 +1068,8 @@ Eric Eide: changed gnus-xmas.el
Eric Hanchrow: changed vc-git.el TUTORIAL.es abbrev.el autorevert.el
cperl-mode.el delphi.el dired.el emacsclient.c env.el erc.el
- frames.texi ibuf-ext.el ispell.el ldap.el make-dist
+ frames.texi ibuf-ext.el ispell.el ldap.el make-dist tramp.texi
+ window.el
Éric Jacoboni: changed fr-refcard.tex
@@ -1070,16 +1079,16 @@ Eric M. Ludlam: wrote analyze.el analyze/complete.el analyze/debug.el
args.el auto.el autoconf-edit.el base.el bovine.el bovine/debug.el
bovine/el.el bovine/make.el c.el cedet-cscope.el cedet-files.el
cedet-global.el cedet-idutils.el cedet-utests.el cedet/semantic.el
- cedet/srecode.el checkdoc.el cpp-root.el cscope.el custom.el
- data-debug.el db-debug.el db-el.el db-file.el db-find.el db-global.el
- db-mode.el db-ref.el db-typecache.el db.el decorate.el decorate/mode.el
- dep.el dframe.el dictionary.el doc.el document.el ede-grammar.el
- ede-tests.el ede.el ede/dired.el ede/files.el ede/linux.el
- ede/locate.el ede/make.el ede/shell.el ede/simple.el ede/speedbar.el
- ede/srecode.el ede/util.el edit.el eieio-base.el eieio-custom.el
- eieio-datadebug.el eieio-opt.el eieio-speedbar.el eieio.el
- emacs-lisp/chart.el emacs.el expandproto.el extract.el ezimage.el
- fcn.el fields.el filter.el filters.el fw.el gcc.el generic.el getset.el
+ cedet/srecode.el checkdoc.el cpp-root.el cscope.el data-debug.el
+ db-debug.el db-el.el db-file.el db-find.el db-global.el db-mode.el
+ db-ref.el db-typecache.el db.el decorate.el decorate/mode.el dep.el
+ dframe.el dictionary.el doc.el document.el ede-grammar.el ede-tests.el
+ ede.el ede/custom.el ede/dired.el ede/files.el ede/generic.el
+ ede/linux.el ede/locate.el ede/make.el ede/shell.el ede/simple.el
+ ede/speedbar.el ede/srecode.el ede/util.el edit.el eieio-base.el
+ eieio-custom.el eieio-datadebug.el eieio-opt.el eieio-speedbar.el
+ eieio.el emacs-lisp/chart.el emacs.el expandproto.el extract.el
+ ezimage.el fcn.el fields.el filter.el filters.el fw.el gcc.el getset.el
global.el html.el ia-sb.el ia.el idle.el idutils.el include.el
insert.el inversion.el javascript.el lex-spp.el lex.el list.el
makefile-edit.el map.el mru-bookmark.el pconf.el pmake.el
@@ -1120,15 +1129,16 @@ Eric Schulte: wrote ob-C.el ob-asymptote.el ob-awk.el ob-calc.el
ob-comint.el ob-css.el ob-ditaa.el ob-dot.el ob-emacs-lisp.el
ob-eval.el ob-gnuplot.el ob-haskell.el ob-java.el ob-js.el ob-keys.el
ob-latex.el ob-ocaml.el ob-org.el ob-ruby.el ob-sass.el ob-scheme.el
- ob-sh.el ob-sql.el ob-sqlite.el ob-table.el ob-tangle.el
+ ob-sh.el ob-shen.el ob-sql.el ob-sqlite.el ob-table.el ob-tangle.el
org-exp-blocks.el org-plot.el
-and co-wrote ob-R.el ob-clojure.el ob-exp.el ob-lisp.el ob-lob.el
- ob-maxima.el ob-perl.el ob-python.el ob-ref.el ob.el org-bibtex.el
+and co-wrote ob-R.el ob-clojure.el ob-exp.el ob-fortran.el ob-lisp.el
+ ob-lob.el ob-maxima.el ob-perl.el ob-picolisp.el ob-python.el ob-ref.el
+ ob.el org-bibtex.el
and changed org.texi org.el org-exp.el org-latex.el ob-plantuml.el
- org-table.el org-macs.el org-src.el orgcard.tex ob-lilypond.el
- ob-mscgen.el ob-octave.el ob-screen.el org-agenda.el org-ascii.el
- org-html.el org-mouse.el gnus-art.el ob-ledger.el ob-matlab.el
- org-attach.el and 4 other files
+ org-src.el org-table.el org-agenda.el org-macs.el orgcard.tex
+ ob-lilypond.el ob-mscgen.el ob-octave.el ob-screen.el org-ascii.el
+ org-footnote.el org-html.el org-mouse.el gnus-art.el ob-ledger.el
+ ob-matlab.el and 5 other files
Eric Youngdale: changed etags-vmslib.c
@@ -1153,7 +1163,7 @@ Ethan Ligon: changed org-docbook.el org-html.el
Eugene Exarevsky: changed sql.el
-Evangelos Evangelou: changed f90.el
+Evangelos Evangelou: changed progmodes/f90.el
Evgeni Dobrev: changed man.el
@@ -1168,7 +1178,7 @@ Fabian Ezequiel Gallina: changed progmodes/python.el
Fabrice Bauzac: changed dired-aux.el
Fabrice Popineau: changed config.nt etags.c fileio.c gnus-cache.el
- inttypes.h lisp.h ms-w32.h nmake.defs regex.c stdint.h w32.c
+ inttypes.h lisp.h ms-w32.h nmake.defs regex.c stdint.h w32.c w32heap.c
Fan Kai: changed esh-arg.el
@@ -1232,7 +1242,7 @@ Frank Weinberg: changed gnus-art.el
François Pinard: co-wrote po.el
and changed nndoc.el allout.el bytecomp.el gnus-sum.el gnus-util.el
- gnus-uu.el make-mode.el nnmail.el rmailsum.el timezone.el
+ gnus-uu.el make-mode.el nnmail.el org.el rmailsum.el timezone.el
François-David Collin: changed message.el mm-decode.el
@@ -1306,7 +1316,7 @@ Gerd Möllmann: wrote authors.el ebrowse.el jit-lock.el rx.el tooltip.el
and changed xdisp.c xterm.c dispnew.c dispextern.h xfns.c xfaces.c
window.c keyboard.c lisp.h Makefile.in faces.el alloc.c buffer.c
startup.el xterm.h fns.c simple.el term.c frame.c xmenu.c emacs.c
- and 615 other files
+ and 617 other files
Gergely Nagy: changed erc.el
@@ -1323,11 +1333,11 @@ Giuliano Procida: changed perl-mode.el
Giuseppe Scrivano: changed browse-url.el buffer.c configure.in sysdep.c
xsmfns.c
-Glenn Morris: wrote check-declare.el f90.el vc-bzr.el
+Glenn Morris: wrote automated/f90.el automated/vc-bzr.el check-declare.el
and changed Makefile.in configure.in calendar.el diary-lib.el rmail.el
- files.el cal-menu.el appt.el cal-hebrew.el fortran.el bytecomp.el
- holidays.el make-dist calendar.texi emacs.texi simple.el sed1v2.inp
- cal-islam.el cal-bahai.el startup.el ack.texi and 1208 other files
+ progmodes/f90.el files.el cal-menu.el appt.el cal-hebrew.el fortran.el
+ bytecomp.el holidays.el emacs.texi calendar.texi ack.texi make-dist
+ simple.el sed1v2.inp cal-islam.el dired-x.el and 1249 other files
Glynn Clements: wrote gamegrid.el snake.el tetris.el
@@ -1397,8 +1407,8 @@ Helmut Eller: changed cl-macs.el emacs-lisp/debug.el process.c
Helmut Waitzmann: changed gnus-sum.el gnus.texi
Henrik Enberg: changed rmailout.el gnus-art.el gnus-msg.el lread.c
- rmail.el rmailedit.el rmailkwd.el rmailmm.el rmailmsc.el rmailsort.el
- rmailsum.el xfaces.c
+ mail/rmailmm.el rmail.el rmailedit.el rmailkwd.el rmailmsc.el
+ rmailsort.el rmailsum.el xfaces.c
Henrique Martins: changed mh-mime.el mh-xface.el
@@ -1417,6 +1427,8 @@ Hiroshi Fujishima: changed faq.texi gnus-score.el mail-source.el
Hiroshi Nakano: changed ralloc.c unexelf.c
+Hiroshi Oota: changed coding.c
+
Hoan Ton-That: changed erc-log.el
Holger Schauer: wrote fortune.el
@@ -1458,6 +1470,9 @@ Ilja Weis: co-wrote gnus-topic.el
Ilya N. Golubev: changed mm-util.el shell.el
+Ilya Shlyakhter: changed org.el ob-lilypond.el org-clock.el
+ org-colview.el
+
Ilya Zakharevich: wrote tmm.el
and co-wrote cperl-mode.el
and changed syntax.c syntax.h textprop.c dired.c font-lock.el interval.c
@@ -1515,10 +1530,14 @@ Jacob Morzinski: changed mh-comp.el
Jacques Duthen: co-wrote ps-print.el ps-samp.el
+Jae-Hyeon Park: changed fontset.el
+
Jaeyoun Chung: changed hangul3.el hanja3.el gnus-mule.el hangul.el
-Jambunathan K: changed org.el org-exp.el org.texi indian.el
- org-footnote.el org-html.el package-x.el tar-mode.el
+Jambunathan K: wrote org-lparse.el org-odt.el
+and changed org.el org-exp.el org.texi OrgOdtContentTemplate.xml
+ org-footnote.el org-inlinetask.el OrgOdtStyles.xml htmlfontify.el
+ org-html.el package-x.el quail/indian.el tar-mode.el
James Clark: wrote nxml-enc.el nxml-glyph.el nxml-maint.el nxml-mode.el
nxml-ns.el nxml-outln.el nxml-parse.el nxml-rap.el nxml-uchnm.el
@@ -1556,9 +1575,9 @@ Jan Böker: changed org.el
Jan Djärv: wrote dnd.el dynamic-setting.el x-dnd.el
and changed gtkutil.c xterm.c xfns.c configure.in xmenu.c xterm.h
- gtkutil.h x-win.el keyboard.c Makefile.in nsterm.m frames.texi
- xsettings.c frame.c emacs.c xselect.c process.c xlwmenu.c config.in
- cus-start.el nsfns.m and 302 other files
+ gtkutil.h nsterm.m x-win.el keyboard.c Makefile.in frames.texi
+ xsettings.c emacs.c frame.c nsfns.m xselect.c process.c xlwmenu.c
+ config.in cus-start.el and 303 other files
Jan Moringen: co-wrote srecode/cpp.el tango-dark-theme.el tango-theme.el
and changed dbus.el dbus.texi dbusbind.c eieio.el log-edit.el zeroconf.el
@@ -1600,10 +1619,10 @@ and changed w32fns.c w32term.c w32font.c makefile.w32-in w32menu.c
font.c image.c w32font.h w32gui.h and 160 other files
Jay Belanger: changed calc.texi calc.el calc-ext.el calc-aent.el
- calc-units.el calc-embed.el calc-lang.el calc-prog.el calc-help.el
+ calc-units.el calc-embed.el calc-help.el calc-lang.el calc-prog.el
calc-math.el calccomp.el calc-arith.el calc-graph.el calc-forms.el
calc-misc.el calc-store.el calc-yank.el calcalg2.el calc-bin.el
- calc-alg.el calc-vec.el and 39 other files
+ calc-alg.el calc-vec.el and 40 other files
Jay K. Adams: wrote jka-cmpr-hook.el jka-compr.el
@@ -1634,11 +1653,12 @@ Jens Krinke: changed smime.el
Jens Lautenbacher: changed gnus.el
Jens Petersen: wrote find-func.el
-and changed ffap.el mule-cmds.el pcmpl-rpm.el
+and changed mule-cmds.el pcmpl-rpm.el
Jens Toivo Berger Thielemann: changed word-help.el
-Jens-Ulrik Holger Petersen: changed cus-edit.el find-func.el gnus.el
+Jens-Ulrik Holger Petersen: changed cus-edit.el ffap.el find-func.el
+ gnus.el
Jeramey Crawford: changed amdx86-64.h configure.in
@@ -1670,7 +1690,7 @@ and co-wrote wyse50.el
and changed keyboard.c xterm.c xfns.c Makefile.in window.c process.c
ymakefile dispnew.c xdisp.c sysdep.c configure.in lisp.h keymap.c
configure make-dist buffer.c frame.c screen.c simple.el alloc.c emacs.c
- and 387 other files
+ and 388 other files
Jim Kingdon: changed emacsclient.c emacs.tex functions.texinfo hp300bsd.h
rmail.el
@@ -1678,7 +1698,7 @@ Jim Kingdon: changed emacsclient.c emacs.tex functions.texinfo hp300bsd.h
Jim Meyering: changed lread.c w32.c copyright.el ebrowse.c emacs.c
make-docfile.c nsfont.m term.c w32font.c xfaces.c xselect.c Makefile.in
alloc.c artist.el autoinsert.el buffer.h character.h charset.c
- configure configure.in doprnt.c and 52 other files
+ configure configure.in doprnt.c and 53 other files
Jim Radford: changed gnus-start.el
@@ -1759,8 +1779,6 @@ John F. Carr: changed dired.c
John F. Whitehead: changed mule-cmds.el mule-diag.el
-John Foerch: changed display.texi
-
John Fremlin: changed gnus-msg.el message.el
John Grabowski: changed xfaces.c xfns.c
@@ -1771,9 +1789,10 @@ John Heidemann: wrote mouse-copy.el mouse-drag.el
John Hughes: changed term.c
-John J Foerch: changed erc-stamp.el progmodes/compile.el
+John J Foerch: changed display.texi erc-stamp.el org.el
+ progmodes/compile.el
-John Mongan: changed f90.el
+John Mongan: changed progmodes/f90.el
John Paul Wallington: changed ibuffer.el ibuf-ext.el subr.el help-fns.el
rmail.el files.el thumbs.el bindings.el fns.c xfns.c arc-mode.el
@@ -1784,16 +1803,17 @@ John Sullivan: changed window.c
John Tobey: changed gud.el
-John W. Eaton: wrote octave-inf.el octave-mod.el
+John W. Eaton: co-wrote octave-mod.el
+and changed octave-inf.el
John Wiegley: wrote align.el cal-bahai.el em-alias.el em-banner.el
em-basic.el em-cmpl.el em-dirs.el em-glob.el em-hist.el em-ls.el
em-pred.el em-prompt.el em-rebind.el em-script.el em-smart.el
em-term.el em-unix.el em-xtra.el erc-identd.el esh-arg.el esh-cmd.el
esh-ext.el esh-io.el esh-mode.el esh-module.el esh-opt.el esh-proc.el
- esh-util.el esh-var.el eshell.el eudcb-mab.el isearchb.el org-attach.el
- org-crypt.el org-habit.el pcmpl-cvs.el pcomplete.el remember.el
- timeclock.el
+ esh-util.el esh-var.el eshell/eshell.el eudcb-mab.el isearchb.el
+ org-attach.el org-crypt.el org-habit.el pcmpl-cvs.el pcomplete.el
+ remember.el test/eshell.el timeclock.el
and co-wrote org-mac-message.el org-pcomplete.el
and changed org-clock.el org-agenda.el erc-chess.el org.el erc.el
iswitchb.el ido.el esh-test.el Makefile.in allout.el cal-menu.el
@@ -1803,6 +1823,8 @@ and changed org-clock.el org-agenda.el erc-chess.el org.el erc.el
John Williams: changed etags.el
+John Yates: changed hideshow.el
+
Jon Anders Skorpen: changed org-publish.el
Jon Ericson: changed gnus.el spam-report.el
@@ -1869,13 +1891,15 @@ and changed ob-octave.el
Juanma Barranquero: wrote emacs-lock.el
and changed makefile.w32-in subr.el w32fns.c files.el server.el bs.el
emacsclient.c help-fns.el faces.el org.el simple.el buffer.c xdisp.c
- keyboard.c process.c w32term.c window.c desktop.el ido.el allout.el
- eval.c and 1084 other files
+ keyboard.c desktop.el process.c w32term.c window.c ido.el w32.c
+ allout.el and 1089 other files
Juergen Kreileder: changed imap.el nnimap.el
Juergen Nickelsen: wrote ws-mode.el
+Julian Gehring: changed org.texi orgcard.tex
+
Julian Scheid: changed tramp.el
Julien Avarre: changed gnus-fun.el
@@ -1887,7 +1911,7 @@ Julien Danjou: wrote gnus-gravatar.el gravatar.el notifications.el
and co-wrote color.el
and changed shr.el org-agenda.el gnus-art.el gnus-html.el gnus.el
mm-decode.el gnus-group.el gnus-util.el message.el org.el gnus-sum.el
- gnus.texi mm-view.el mm-uu.el nnimap.el nnir.el sieve-manage.el
+ gnus.texi mm-view.el nnimap.el mm-uu.el nnir.el sieve-manage.el
color-lab.el url-cache.el auth-source.el gnus-ems.el and 82 other files
Julien Gilles: wrote gnus-ml.el
@@ -1901,7 +1925,7 @@ and changed info.el isearch.el simple.el replace.el progmodes/grep.el
dired-aux.el progmodes/compile.el dired.el startup.el faces.el files.el
display.texi menu-bar.el descr-text.el bindings.el cus-edit.el
image-mode.el ispell.el man.el dired-x.el log-view.el
- and 335 other files
+ and 338 other files
Justin Bogner: changed fortune.el
@@ -1909,6 +1933,8 @@ Justin Sheehy: changed gnus-sum.el nntp.el
Justus Piater: changed smtpmail.el
+Jérémy Compostella: changed battery.el windmove.el window.el
+
Jérôme Marant: changed Makefile.in make-dist bindings.el configure.in
emacsclient.c misc.texi
@@ -1930,7 +1956,7 @@ and changed message.el gnus-agent.el gnus-sum.el files.el nnmail.el
paragraphs.el bindings.el files.texi gnus-art.el gnus-group.el man.el
INSTALL crisp.el fileio.c and 45 other files
-Kai Tetzlaff: changed url-http.el
+Kai Tetzlaff: changed org-publish.el url-http.el
Kailash C. Chowksey: changed HELLO Makefile.in ind-util.el kannada.el
knd-util.el loadup.el makefile.w32-in
@@ -1962,7 +1988,7 @@ Karl Fogel: wrote bookmark.el mail-hist.el saveplace.el
and changed files.el doc-view.el image-mode.el info.el simple.el INSTALL
autogen.sh isearch.el menu-bar.el thingatpt.el INSTALL.BZR configure
configure.in editfns.c gnus-bookmark.el gnus-msg.el gnus-sum.el man.el
- nnmail.el vc-svn.el window.c and 3 other files
+ nnmail.el org-agenda.el vc-svn.el and 4 other files
Karl Heuer: changed keyboard.c lisp.h xdisp.c buffer.c xfns.c xterm.c
alloc.c files.el frame.c window.c configure.in Makefile.in data.c
@@ -1985,8 +2011,10 @@ Katsuhiro Hermit Endo: changed gnus-group.el gnus-spec.el
Katsumi Yamaoka: wrote canlock.el
and changed gnus-art.el gnus-sum.el message.el gnus.texi mm-decode.el
mm-util.el mm-view.el gnus-group.el mml.el rfc2047.el gnus-util.el
- gnus-start.el gnus-msg.el shr.el gnus.el nntp.el gnus-agent.el nnrss.el
- nnmail.el mm-uu.el gnus-html.el and 133 other files
+ gnus-start.el gnus-msg.el gnus.el shr.el nntp.el gnus-agent.el nnrss.el
+ mm-uu.el nnmail.el gnus-html.el and 135 other files
+
+Kaushik Srenevasan: changed gdb-mi.el
Kaveh R. Ghazi: changed delta88k.h xterm.c
@@ -2007,16 +2035,17 @@ Keith Gabryelski: wrote hexl.c hexl.el
Keith Packard: changed font.c
Ken Brown: changed configure.in cygwin.h sheap.c browse-url.el gmalloc.c
- vm-limit.c dired.c emacs.c gdb-mi.el loadup.el mem-limits.h unexcw.c
+ vm-limit.c callproc.c dired.c emacs.c fileio.c gdb-mi.el loadup.el
+ mem-limits.h unexcw.c
Ken Brush: changed emacsclient.c
Ken Laprade: changed simple.el
Ken Manheimer: wrote allout-widgets.el allout.el icomplete.el
-and changed pgg-gpg.el pgg.el progmodes/python.el encrypted-locked.xpm
- pgg-pgp.el pgg-pgp5.el unlocked-encrypted.png unlocked-encrypted.xpm
- README edebug.el pgg.texi tips.texi
+and changed pgg-gpg.el pgg.el progmodes/python.el locked-encrypted.png
+ locked-encrypted.xpm pgg-pgp.el pgg-pgp5.el unlocked-encrypted.png
+ unlocked-encrypted.xpm README edebug.el pgg.texi tips.texi
Ken Raeburn: changed lisp.h lread.c Makefile.in alloc.c buffer.c fns.c
keyboard.c minibuf.c coding.c editfns.c fileio.c keymap.c xdisp.c
@@ -2025,13 +2054,13 @@ Ken Raeburn: changed lisp.h lread.c Makefile.in alloc.c buffer.c fns.c
Ken Stevens: wrote ispell.el
-Kenichi Handa: wrote composite.el cyrillic.el isearch-x.el ps-bdf.el
- py-punct.el pypunct-b5.el thai-word.el
+Kenichi Handa: wrote composite.el isearch-x.el language/cyrillic.el
+ ps-bdf.el py-punct.el pypunct-b5.el thai-word.el
and co-wrote ps-def.el ps-mule.el ps-print.el ps-samp.el quail.el
and changed coding.c mule-cmds.el mule.el fontset.c charset.c xdisp.c
fontset.el font.c xterm.c Makefile.in fileio.c mule-conf.el
characters.el fns.c ftfont.c mule-diag.el charset.h ccl.c coding.h
- xfaces.c japanese.el and 379 other files
+ xfaces.c editfns.c and 388 other files
Kenichi Okada: co-wrote sasl-cram.el sasl-digest.el
@@ -2111,7 +2140,8 @@ and changed hanja.el hangul.el hangul3.el hanja-jis.el symbol-ksc.el
Kobayashi Yasuhiro: changed w32fns.c configure.bat indent.c info.el
w32term.c w32term.h window.c xfns.c
-Konrad Hinsen: changed ob-python.el
+Konrad Hinsen: wrote org-eshell.el
+and changed ob-python.el
Konstantin Novitsky: changed progmodes/python.el
@@ -2119,7 +2149,8 @@ Kristoffer Grönlund: wrote wombat-theme.el
Kurt B. Kaiser: changed message.el
-Kurt Hornik: wrote octave-inf.el octave-mod.el
+Kurt Hornik: wrote octave-inf.el
+and co-wrote octave-mod.el
and changed battery.el ielm.el octave-hlp.el term.el
Kurt Swanson: changed gnus-art.el gnus-salt.el gnus-sum.el gnus-ems.el
@@ -2147,15 +2178,11 @@ Lars Hansen: changed desktop.el tramp.el info.el mh-e.el dired-x.el
hilit-chg.el misc.texi url-auth.el url-cache.el url-dired.el url-ftp.el
url-irc.el url-misc.el url-news.el url-privacy.el and 39 other files
-Lars Ingebrigtsen: changed nnimap.el gnus-art.el gnus-sum.el shr.el
- gnus.texi gnus-start.el auth-source.el message.el nntp.el gnus-draft.el
- gnus-group.el gnus-agent.el gnus-html.el gnus-util.el nnfolder.el
- nnmail.el proto-stream.el gnus-demon.el gnus-gravatar.el gnus-int.el
- gnus-msg.el and 6 other files
-
Lars Lindberg: wrote msb.el
and co-wrote dabbrev.el imenu.el
+Lars Ljung: changed esh-ext.el
+
Lars Magne Ingebrigtsen: wrote compface.el dns.el ecomplete.el
format-spec.el gnus-agent.el gnus-art.el gnus-async.el gnus-bcklg.el
gnus-cache.el gnus-demon.el gnus-draft.el gnus-dup.el gnus-eform.el
@@ -2172,11 +2199,10 @@ and co-wrote gnus-kill.el gnus-mh.el gnus-msg.el gnus-score.el
mm-encode.el mm-util.el nnbabyl.el nndoc.el nneething.el nnfolder.el
nnheader.el nnimap.el nnmbox.el nnmh.el nnml.el nnspool.el nnvirtual.el
rfc2047.el time-date.el
-and changed gnus.texi gnus-cite.el pop3.el gnus-xmas.el smtpmail.el
- proto-stream.el auth-source.el xml.c dired.el editfns.c nnultimate.el
- subr.el gnus-nocem.el gnutls.c imap.el nnkiboze.el nnrss.el
- nnslashdot.el spam-report.el url-http.el gnus-cus.el
- and 206 other files
+and changed gnus.texi gnus-cite.el pop3.el smtpmail.el gnus-xmas.el
+ auth-source.el proto-stream.el url-http.el gnutls.c subr.el xml.c
+ dired.el editfns.c nnultimate.el gnus-nocem.el imap.el nnkiboze.el
+ nnrss.el nnslashdot.el simple.el spam-report.el and 210 other files
Lars Rasmusson: changed ebrowse.c
@@ -2189,7 +2215,7 @@ and changed erc.el org-latex.el org.el erc-match.el erc-nets.el
erc-nickserv.el org-exp.el browse-url.el erc-button.el erc-compat.el
erc-dcc.el erc-fill.el erc-list.el erc-track.el ielm.el ob.el
org-html.el cl-macs.el erc-autoaway.el erc-autojoin.el erc-bbdb.el
- and 22 other files
+ and 23 other files
Lawrence R. Dodd: co-wrote dired-x.el
and changed fortran.el ispell.el sendmail.el cmuscheme.el comint.el
@@ -2207,10 +2233,10 @@ and changed nxml-mode.el tutorial.el window.el ada-xref.el buff-menu.el
Lennart Staflin: changed dired.el diary-ins.el diary-lib.el tq.el xdisp.c
-Leo Liu: changed rcirc.el ido.el makefile.w32-in abbrev.el Makefile.in
- deps.mk fns.c gl-comp.m4 gnulib.mk minibuffer.el register.el replace.el
- subr.el abbrevlist.el ansi-color.el bindings.el bookmark.el cl-macs.el
- diff.el editfns.c files.el and 22 other files
+Leo Liu: changed rcirc.el ido.el abbrev.el makefile.w32-in subr.el
+ Makefile.in deps.mk diff-mode.el dnd.el em-hist.el erc.el files.el
+ fns.c font-lock.el footnote.el gl-comp.m4 gnulib.mk help-mode.el
+ iswitchb.el minibuf.c minibuffer.el and 62 other files
Leonard H. Tower Jr.: changed rnews.el rnewspost.el emacsbug.el
rmailout.el sendmail.el
@@ -2221,6 +2247,10 @@ Lewis Perin: changed emacs.manifest
Liam Healy: changed outline.el
+Liang Wang: changed etags.el
+
+Litvinov Sergey: changed ob-maxima.el ob-octave.el
+
Lloyd Zusman: changed mml.el pgg-gpg.el
Luc Teirlinck: wrote help-at-pt.el
@@ -2247,11 +2277,11 @@ Lukas Huonker: changed tetris.el
Łukasz Stelmach: changed cookie1.el message.el org-agenda.el org-bbdb.el
org-exp.el org-html.el org.el
-Lute Kamstra: changed modes.texi generic.el emacs-lisp/debug.el
- generic-x.el font-lock.el simple.el subr.el Makefile.in battery.el
- debugging.texi easy-mmode.el elisp.texi hl-line.el info.el basic.texi
- bindings.el calc.el cmdargs.texi diff-mode.el doclicense.texi
- edebug.texi and 290 other files
+Lute Kamstra: changed modes.texi emacs-lisp/debug.el generic-x.el
+ generic.el font-lock.el simple.el subr.el Makefile.in battery.el
+ debugging.texi easy-mmode.el elisp.texi emacs-lisp/generic.el
+ hl-line.el info.el basic.texi bindings.el calc.el cmdargs.texi
+ diff-mode.el doclicense.texi and 291 other files
Lynn Slater: wrote help-macro.el
@@ -2259,8 +2289,9 @@ Maciek Pasternacki: changed nnrss.el
Magnus Henoch: changed url-http.el ispell.el url.el dbusbind.c dns.el
url-gw.el url-parse.el url-proxy.el autoinsert.el cl.texi configure.in
- cyrillic.el dbus.el gnus.texi hashcash.el log-edit.el message.el
- org-clock.el org-latex.el org-table.el process.c and 10 other files
+ dbus.el gnus.texi hashcash.el log-edit.el message.el org-clock.el
+ org-latex.el org-table.el process.c quail/cyrillic.el
+ and 10 other files
Malcolm Purvis: changed spam-stat.el
@@ -2268,6 +2299,8 @@ Manoj Srivastava: wrote manoj-dark-theme.el
Manuel Giraud: changed org-html.el org-publish.el org.texi
+Manuel Gómez: changed speedbar.el
+
Manuel Serrano: wrote flyspell.el
Marc Fleischeuers: changed files.el
@@ -2340,6 +2373,8 @@ Mark Osbourne: changed hexl-mode.el
Mark Plaksin: changed nnrss.el term.el
+Mark Shoulson: changed org.el
+
Mark Thomas: changed flow-fill.el gnus-sum.el gnus-util.el nnmail.el
Mark Triggs: changed nnir.el
@@ -2399,7 +2434,7 @@ Martin Pohlack: changed iimage.el pc-select.el
Martin Rudalics: changed window.el window.c windows.texi frame.c buffer.c
help.el window.h cus-start.el frame.el cus-edit.el files.el
buffers.texi dired.el subr.el add-log.el xdisp.c font-lock.el
- help-fns.el lisp.h mouse.el wid-edit.el and 135 other files
+ help-fns.el lisp.h mouse.el wid-edit.el and 137 other files
Martin Stjernholm: wrote cc-bytecomp.el
and co-wrote cc-align.el cc-cmds.el cc-compat.el cc-defs.el cc-engine.el
@@ -2414,6 +2449,7 @@ Martin Svenson: changed progmodes/python.el
Martin Thornquist: changed gnus-group.el gnus-topic.el
Martyn Jago: wrote ob-lilypond.el
+and changed ob-emacs-lisp.el
Masahiko Sato: wrote vip.el
@@ -2428,15 +2464,13 @@ and co-wrote cc-guess.el
and changed etags.el asm-mode.el hexl.el xdisp.c bindings.el man.el
xfaces.c simple.el vc.el wid-edit.el add-log.el etags.c faces.el
pcvs.el progmodes/compile.el register.el ruler-mode.el buffer.c
- cus-face.el dired-x.el dispextern.h and 71 other files
+ cc-langs.el cus-face.el dired-x.el and 73 other files
Masayuki Ataka: changed texinfmt.el texinfo.el characters.el cmuscheme.el
make-mode.el
Masayuki Fujii: changed dnd.el w32-win.el
-Mastake Yamato: changed cc-guess.el cc-langs.el cc-mode.el cc-styles.el
-
Mathias Dahl: wrote image-dired.el
and changed tumme.el dired.el dired.texi
@@ -2483,15 +2517,15 @@ Michael Albinus: wrote dbus.el secrets.el tramp-cmds.el tramp-compat.el
zeroconf.el
and co-wrote tramp-cache.el tramp-sh.el tramp.el
and changed tramp.texi dbusbind.c trampver.texi dbus.texi trampver.el
- ange-ftp.el tramp-fish.el files.el tramp-imap.el files.texi Makefile.in
- tramp-vc.el tramp-util.el tramp-uu.el simple.el auth-source.el
- dired-aux.el configure.in em-unix.el fileio.c keyboard.c
- and 65 other files
+ ange-ftp.el tramp-fish.el files.el files.texi tramp-imap.el Makefile.in
+ tramp-vc.el tramp-util.el tramp-uu.el notifications.el simple.el
+ auth-source.el dired-aux.el configure.in em-unix.el fileio.c
+ and 66 other files
Michael Ben-Gershon: changed acorn.h configure.in riscix1-1.h riscix1-2.h
unexec.c
-Michael Brand: changed org-agenda.el org-table.el org.el
+Michael Brand: changed org.el org-agenda.el org.texi org-table.el
Michael D. Ernst: wrote reposition.el
and changed dired-x.el uniquify.el ispell.el bibtex.el rmail.el dired.el
@@ -2555,7 +2589,7 @@ Michael Shields: changed spam.el gnus-art.el gnus-sum.el gnus-cite.el
window.c window.el
Michael Sperber: changed aix3-1.h aix4-2.h gnus.texi mail-source.el
- nnmail.el
+ nnmail.el org-capture.el
Michael Staats: wrote pc-select.el
@@ -2568,6 +2602,8 @@ Michal Jankowski: changed insdel.c keyboard.c
Michal Nazarewicz: changed frame.c frame.h ispell.el w32term.c xterm.c
+Michal Sojka: changed org-icalendar.el
+
Michaël Cadilhac: changed browse-url.el gnus-sum.el gnus.texi ido.el
emacsbug.el files.el fill.el flyspell.el fr-drdref.tex fr-refcard.ps
fr-refcard.tex ispell.el meta-mode.el nnrss.el
@@ -2592,6 +2628,8 @@ Mike Kazantsev: changed erc-dcc.el
Mike Kupfer: changed mh-e.el mh-utils.el
+Mike Lamb: changed em-unix.el esh-util.el pcmpl-unix.el
+
Mike Long: changed b2m.c make-dist make-mode.el netbsd.h view.el vms.h
Mike McEwan: changed gnus-agent.el gnus-sum.el gnus-score.el
@@ -2608,9 +2646,10 @@ Mike Woolley: changed gnus-sum.el
Mikio Nakajima: changed ring.el viper-util.el
-Milan Zamazal: wrote czech.el glasses.el tildify.el
-and co-wrote prolog.el slovak.el
-and changed abbrev.el filecache.el files.el mm-view.el
+Milan Zamazal: wrote glasses.el language/czech.el quail/czech.el
+ tildify.el
+and co-wrote language/slovak.el prolog.el quail/slovak.el
+and changed abbrev.el filecache.el files.el mm-view.el org.el
progmodes/compile.el
Miles Bader: wrote button.el face-remap.el image-file.el macroexp.el
@@ -2692,7 +2731,9 @@ Nic Ferrier: changed tramp.el
Nicholas Maniscalco: changed term.el
-Nick Dokos: changed org-exp.el mh-search.el url-cache.el
+Nick Alcock: changed gnus.el
+
+Nick Dokos: changed org-exp.el mh-search.el org.el url-cache.el
Nick Roberts: wrote gdb-mi.el t-mouse.el
and changed gdb-ui.el gud.el building.texi tooltip.el speedbar.el
@@ -2704,13 +2745,14 @@ Nico Francois: changed w32fns.c w32inevt.c w32menu.c
Nicolas Avrutin: changed url-http.el
-Nicolas Goaziou: changed org-list.el org.el org-latex.el org-exp.el
- org-footnote.el org-html.el org-inlinetask.el org-docbook.el
- org-timer.el org-capture.el org-ascii.el ob.el org-archive.el
- org-clock.el org-macs.el org-indent.el org-mouse.el
+Nicolas Goaziou: changed org-list.el org.el org-footnote.el org-exp.el
+ org-latex.el org-html.el org-inlinetask.el org-indent.el org-docbook.el
+ org-timer.el ob-asymptote.el org-ascii.el org-capture.el ob.el
+ org-agenda.el org-archive.el ob-exp.el org-clock.el org-macs.el
+ org-mouse.el org.texi and 3 other files
-Niels Giesen: changed icalendar.el org-clock.el org-docbook.el
- org-icalendar.el
+Niels Giesen: changed icalendar.el org-agenda.el org-clock.el
+ org-docbook.el org-icalendar.el
Niimi Satoshi: changed pp.el search.c
@@ -2739,9 +2781,7 @@ Nobuyuki Hikichi: changed news-risc.h
Noel Cragg: changed mh-junk.el
Noorul Islam: changed org-latex.el org-html.el org.el org.texi
- org-capture.el org-gnus.el org-habit.el
-
-Noorul Islam K M: changed package.el
+ org-capture.el org-gnus.el org-habit.el package.el
Norbert Koch: changed gnus-msg.el gnus-score.el
@@ -2752,7 +2792,7 @@ Nuutti Kotivuori: changed gnus-sum.el flow-fill.el gnus-cache.el
Odd Gripenstam: wrote dcl-mode.el
-Ognyan Kulev: changed TUTORIAL.bg cyrillic.el
+Ognyan Kulev: changed TUTORIAL.bg quail/cyrillic.el
Okazaki Tetsurou: changed cc-fonts.el
@@ -2760,7 +2800,8 @@ Olaf Sylvester: wrote bs.el
Ole Aamot: changed compile.el
-Oleg S. Tihonov: changed cyrillic.el ispell.el map-ynp.el subr.el
+Oleg S. Tihonov: changed ispell.el language/cyrillic.el map-ynp.el
+ quail/cyrillic.el subr.el
Oleksandr Gavenko: changed generic-x.el progmodes/grep.el
@@ -2797,7 +2838,7 @@ P. E. Jareth Hein: changed gnus-util.el
Pascal Dupuis: changed octave-inf.el
-Pascal Rigaux: changed rfc2231.el
+Pascal Rigaux: changed image.c rfc2231.el
Pat Thoyts: changed xfns.c
@@ -2814,8 +2855,8 @@ Paul Eggert: wrote rcs2log vcdiff
and co-wrote cal-dst.el
and changed lisp.h Makefile.in editfns.c alloc.c xdisp.c configure.in
fileio.c image.c process.c fns.c xterm.c dispextern.h keyboard.c data.c
- lread.c sysdep.c xfns.c eval.c emacs.c config.in print.c
- and 564 other files
+ lread.c sysdep.c xfns.c eval.c emacs.c buffer.c config.in
+ and 573 other files
Paul Fisher: changed fns.c
@@ -2835,7 +2876,7 @@ Paul Pogonyshev: changed progmodes/python.el subr.el which-func.el
Paul Reilly: changed dgux.h lwlib-Xm.c lwlib.c xlwmenu.c configure.in
mail-utils.el process.c rmail.el xfns.c Makefile.in dgux5-4R2.h
dgux5-4R3.h files.el keyboard.c lwlib-Xaw.c lwlib-Xm.h lwlib-int.h
- lwlib.h rmailedit.el rmailkwd.el rmailmm.el and 10 other files
+ lwlib.h mail/rmailmm.el rmailedit.el rmailkwd.el and 10 other files
Paul Rivier: changed ada-mode.el mixal-mode.el reftex-vars.el reftex.el
@@ -2850,11 +2891,13 @@ Paul Stodghill: changed gnus-agent.el gnus-util.el
Pavel Janík: changed keyboard.c xterm.c COPYING xdisp.c Makefile.in
process.c emacs.c lisp.h menu-bar.el ldap.el make-dist xfns.c buffer.c
coding.c eval.c fileio.c flyspell.el fns.c indent.c callint.c
- cus-start.el and 700 other files
+ cus-start.el and 710 other files
Pavel Kobiakov: wrote flymake.el
and changed flymake.texi
+Peder O. Klingenberg: changed gnus.texi
+
Per Abrahamsen: wrote cus-dep.el cus-edit.el cus-face.el cus-start.el
custom.el double.el gnus-cite.el gnus-cus.el progmodes/cpp.el
wid-browse.el wid-edit.el widget.el xt-mouse.el
@@ -2884,8 +2927,9 @@ Pete Kazmier: changed gnus-art.el
Pete Ware: changed message.el
-Peter Breton: wrote dirtrack.el filecache.el find-lisp.el generic-x.el
- generic.el locate.el net-utils.el
+Peter Breton: wrote dirtrack.el emacs-lisp/generic.el filecache.el
+ find-lisp.el generic-x.el locate.el net-utils.el
+and changed generic.el
Peter Danenberg: changed scheme.el
@@ -2895,7 +2939,7 @@ Peter Dyballa: changed calendar.el
Peter Heslin: changed flyspell.el outline.el
-Peter J. Weisberg: changed picture.el simple.el
+Peter J. Weisberg: changed help.el picture.el simple.el
Peter Jolly: changed arc-mode.el ftfont.c
@@ -2905,7 +2949,7 @@ Peter Kleiweg: wrote ps-mode.el
Peter Liljenberg: wrote elint.el
-Peter Münster: changed gnus.texi
+Peter Münster: changed gnus.texi org-agenda.el org.el
Peter O'Gorman: changed configure.in frame.h hpux10-20.h termhooks.h
@@ -2947,24 +2991,26 @@ Phil Sung: changed follow.el progmodes/python.el wdired.el
Philip Jackson: wrote find-cmd.el org-irc.el
+Philipp Haselwarter: changed gnus-agent.el gnus.texi
+
Philippe Schnoebelen: wrote gomoku.el mpuz.el
Philippe Waroquiers: changed etags.el term.c
Pierre Poissinger: changed charset.c
-Piet Van Oostrum: changed data.c fileio.c flyspell.el smtpmail.el
+Piet van Oostrum: changed data.c fileio.c flyspell.el smtpmail.el
Pieter E.J. Pareit: wrote mixal-mode.el
Pieter Praet: changed org-crypt.el
+Pieter Schoenmakers: changed TUTORIAL.nl
+
Pinku Surana: changed sql.el
Piotr Zielinski: wrote org-mouse.el
-Pj Weisberg: changed help.el
-
Prestoo Ten: changed screen.el
Primoz Peterlin: changed TUTORIAL.sl
@@ -2974,6 +3020,8 @@ Puneeth Chaganti: changed org.texi org-exp.el org-agenda.el
R. Bernstein: changed gud.el
+Rafael Laboissiere: changed org.el org.texi
+
Rafael Sepúlveda: changed TUTORIAL.es
Raffael Mancini: changed misc.el
@@ -3001,8 +3049,6 @@ and changed w32fns.c gnus-art.el reftex-cite.el reftex-toc.el reftex.el
Ralf Fassel: changed dabbrev.el files.el fill.el iso-acc.el tar-mode.el
-Ralf Scheidhauer And Michael Mehl: wrote prolog.el
-
Ralph Schleicher: wrote battery.el info-look.el
and changed libc.el browse-url.el fileio.c info.el mm-decode.el
nnultimate.el perl-mode.el which-func.el
@@ -3068,15 +3114,15 @@ and co-wrote cc-align.el cc-cmds.el cc-defs.el cc-engine.el cc-langs.el
cc-menus.el cc-mode.el cc-styles.el cc-vars.el font-lock.el
and changed files.el keyboard.c simple.el xterm.c xdisp.c rmail.el
Makefile.in fileio.c process.c sysdep.c buffer.c xfns.c window.c
- configure.in subr.el startup.el emacs.c sendmail.el editfns.c info.el
- dispnew.c and 1347 other files
+ configure.in subr.el startup.el sendmail.el emacs.c editfns.c info.el
+ dispnew.c and 1350 other files
Richard Mlynarik: wrote cl-indent.el ebuff-menu.el ehelp.el rfc822.el
terminal.el yow.el
-and changed files.el rmail.el sysdep.c info.el keyboard.c bytecomp.el
- fileio.c simple.el process.c startup.el window.c editfns.c unexec.c
- xfns.c keymap.c minibuf.c sendmail.el buffer.c dispnew.c emacs.c
- subr.el and 129 other files
+and changed files.el simple.el rmail.el info.el sysdep.c bytecomp.el
+ startup.el keyboard.c fileio.c process.c sendmail.el window.c editfns.c
+ unexec.c xfns.c keymap.c lisp-mode.el minibuf.c buffer.c dired.el
+ dispnew.c and 140 other files
Richard Sharman: wrote hilit-chg.el
and changed sh-script.el ediff-init.el regexp-opt.el simple.el
@@ -3090,6 +3136,8 @@ Rob Browning: changed configure.in
Rob Christie: changed nsmenu.m
+Rob Giardina: changed org-agenda.el
+
Rob Kaut: changed vhdl-mode.el
Rob Riepel: wrote tpu-edt.el tpu-extras.el tpu-mapper.el vt-control.el
@@ -3116,6 +3164,8 @@ Robert Pluim: changed gnus-demon.el org-agenda.el
Robert Thorpe: changed cus-start.el indent.el
+Roberto Huelga: changed org-clock.el
+
Roberto Rodríguez: changed ada-mode.texi glossary.texi widget.texi
Roderick Schertler: changed dgux.h dgux4.h gud.el sysdep.c
@@ -3158,7 +3208,7 @@ Ron Schnell: wrote dunnet.el
Ronan Waide: changed smtpmail.el
-Ross Patterson: wrote org-protocol.el
+Ross Patterson: co-wrote org-protocol.el
Roy Liu: changed ns-win.el
@@ -3200,13 +3250,16 @@ Sam Kendall: changed etags.c etags.el
Sam Steingold: wrote gulp.el midnight.el
and changed progmodes/compile.el cl-indent.el vc-cvs.el vc.el mouse.el
- simple.el font-lock.el ange-ftp.el vc-hg.el add-log.el bookmark.el
- bug-reference.el diary-lib.el dired.el pcvs.el tex-mode.el apropos.el
- bindings.el emacs-lisp/debug.el etags.el files.el and 124 other files
+ simple.el font-lock.el ange-ftp.el vc-hg.el window.el add-log.el
+ bookmark.el bug-reference.el diary-lib.el dired.el etags.el pcvs.el
+ tex-mode.el apropos.el bindings.el emacs-lisp/debug.el
+ and 126 other files
+
+Samuel Bronson: changed custom.el
Samuel Tardieu: changed smime.el
-Samuel Thibault: changed sysdep.c term.c
+Samuel Thibault: changed gnu.h sysdep.c term.c
Sanghyuk Suh: changed mac-win.el macterm.c
@@ -3244,11 +3297,11 @@ Scott M. Meyers: changed cmacexp.el
Sean Neakums: changed gnus-msg.el gnus-uu.el supercite.el
+Sean O'Halpin: changed ob.el
+
Sean O'Rourke: changed complete.el comint.el dabbrev.el find-func.el
ibuf-ext.el pcomplete.el register.el tramp.el
-Sean O'halpin: changed ob.el
-
Sean Sieger: changed emacs-lisp-intro.texi
Sebastian Freundt: changed nnmaildir.el
@@ -3259,7 +3312,7 @@ Sebastian Kremer: wrote dired-aux.el dired.el ls-lisp.el
and co-wrote dired-x.el find-dired.el
and changed add-log.el
-Sebastian Rose: wrote org-protocol.el
+Sebastian Rose: co-wrote org-protocol.el
and changed org-publish.el ftfont.c org-jsinfo.el
Sebastian Tennant: changed desktop.el
@@ -3278,13 +3331,15 @@ Seppo Sade: changed esh-ext.el
Sergei Organov: changed vc.el
+Sergey Litvinov: co-wrote ob-fortran.el
+
Sergey Poznyakoff: changed mh-mime.el rmail.el rmail.texi smtpmail.el
Sergio Pokrovskij: changed TUTORIAL.eo
Seweryn Kokot: changed positions.texi searching.texi
-Shaun Johnson: changed ob-tangle.el
+Shaun Johnson: changed ob-tangle.el org-exp-blocks.el
Shawn Boles: changed url-cookie.el
@@ -3307,6 +3362,8 @@ Shinichirou Sugou: changed etags.c
Sho Nakatani: changed doc-view.el
+Shoji Nishimura: changed org.el
+
Shuhei Kobayashi: wrote hex-util.el hmac-def.el hmac-md5.el
and changed gnus-group.el message.el nnmail.el
@@ -3329,7 +3386,7 @@ and changed message.el gnus-sum.el gnus-art.el smtpmail.el pgg-gpg.el
hashcash.el mm-view.el password.el gnus-cache.el and 99 other files
Simon Leinen: changed Makefile.in smtpmail.el Makefile cm.c cm.h hpux9.h
- indent.c process.c sc.texinfo sgml-mode.el term.c xfns.c xmenu.c
+ indent.c process.c sc.texinfo sgml-mode.el term.c vc.el xfns.c xmenu.c
xterm.c
Simon Marshall: wrote fast-lock.el lazy-lock.el regexp-opt.el
@@ -3337,7 +3394,7 @@ and co-wrote comint.el shell.el
and changed font-lock.el rmail.el fortran.el sendmail.el subr.el dired.el
sh-script.el texinfo.el add-log.el compile.el outline.el help.el
menu-bar.el perl-mode.el ps-print.el rmailsum.el bytecomp.el
- cc-fonts.el data.c faces.el lisp-mode.el and 55 other files
+ cc-fonts.el data.c faces.el lisp-mode.el and 56 other files
Simon South: co-wrote delphi.el
@@ -3365,9 +3422,9 @@ Stefan Monnier: wrote bibtex-style.el bzrmerge.el css-mode.el
pcvs-util.el reveal.el smerge-mode.el smie.el vc-mtn.el
and co-wrote font-lock.el
and changed vc.el subr.el simple.el lisp.h keyboard.c files.el
- bytecomp.el Makefile.in keymap.c progmodes/compile.el xdisp.c pcvs.el
- alloc.c newcomment.el vc-hooks.el tex-mode.el buffer.c fileio.c
- sh-script.el eval.c fill.el and 1032 other files
+ bytecomp.el keymap.c Makefile.in progmodes/compile.el xdisp.c pcvs.el
+ alloc.c newcomment.el vc-hooks.el tex-mode.el buffer.c fileio.c eval.c
+ sh-script.el fill.el and 1033 other files
Stefan Reichör: changed gnus-agent.el
@@ -3429,7 +3486,7 @@ Steve Nygard: changed unexnext.c
Steve Purcell: changed nnimap.el
-Steve Strassman: wrote spook.el
+Steve Strassmann: wrote spook.el
Steve Youngs: changed mh-utils.el mh-xemacs-compat.el mh-customize.el
mh-e.el mh-comp.el mh-mime.el dns.el gnus-art.el browse-url.el
@@ -3469,9 +3526,9 @@ and changed emacsclient.c server.el
Sun Yijiang: changed TUTORIAL.cn
-Sundar Narasimhan: changed rnews.el rnewspost.el
+Sundar Narasimhan: changed rnews.el
-Suvayu Ali: changed org.texi
+Suvayu Ali: changed org.texi org-exp.el org-inlinetask.el org-src.el
Sven Joachim: changed files.el de-refcard.tex dired-aux.el emacs.1
arc-mode.el dired-x.el em-cmpl.el em-hist.el em-ls.el esh-cmd.el
@@ -3480,18 +3537,19 @@ Sven Joachim: changed files.el de-refcard.tex dired-aux.el emacs.1
Svend Tollak Munkejord: changed deuglify.el
-Sébastien Delafond: changed org.el
+Syver Enstad: changed gud.el
-Sébastien Vauban: changed org-agenda.el org-latex.el org.el
+Sébastien Delafond: changed org.el
-T. V. Raman: changed completion.el files.el json.el
+Sébastien Vauban: changed org.el org-agenda.el org-html.el org-latex.el
-T.V. Raman: changed mairix.el mspools.el xml.c
+T.V. Raman: changed completion.el files.el json.el mairix.el mspools.el
+ xml.c
-Taichi Kawabata: wrote indian.el ucs-normalize.el
+Taichi Kawabata: wrote quail/indian.el ucs-normalize.el
and changed devanagari.el ind-util.el Makefile.in devan-util.el
- characters.el fontset.el malayalam.el mlm-util.el mule-conf.el tamil.el
- tml-util.el
+ language/indian.el characters.el fontset.el malayalam.el mlm-util.el
+ mule-conf.el tamil.el tml-util.el
Takaaki Ota: wrote textmodes/table.el
and changed appt.el dired.c etags.c ldap.el makefile.w32-in
@@ -3499,8 +3557,8 @@ and changed appt.el dired.c etags.c ldap.el makefile.w32-in
Takahashi Kaoru: changed texinfmt.el
-Takahashi Naoto: wrote cyrillic.el ethio-util.el ethiopic.el
- latin-post.el robin.el
+Takahashi Naoto: wrote ethio-util.el language/ethiopic.el latin-post.el
+ quail/cyrillic.el quail/ethiopic.el robin.el
and co-wrote latin-ltx.el quail.el
and changed fontset.el mule-conf.el
@@ -3515,9 +3573,9 @@ Tassilo Horn: wrote doc-view.el
and co-wrote org-gnus.el
and changed subword.el image-mode.el Makefile.in cc-cmds.el emacsbug.el
gnus-art.el gnus.texi nnimap.el files.el gnus-sum.el info.el
- org-footnote.el org.el reftex-ref.el simple.el tsdh-dark-theme.el
- tsdh-light-theme.el ack.texi bindings.el bookmark.el cc-mode.el
- and 22 other files
+ org-footnote.el org.el reftex-ref.el saveplace.el simple.el
+ tsdh-dark-theme.el tsdh-light-theme.el ack.texi artist.el bindings.el
+ and 26 other files
Tatsuya Ichikawa: changed gnus-agent.el gnus-cache.el
@@ -3528,11 +3586,12 @@ Ted Phelps: changed mh-search.el mh-tool-bar.el
Teemu Likonen: changed dired.el gnus-agent.el message.el
Teodor Zlatanov: wrote auth-source.el gnus-registry.el gnus-sync.el
- gnus-tests.el gnutls.el registry.el spam-report.el url-future.el
+ gnus-tests.el gnutls.el registry.el spam-report.el url-future-tests.el
+ url-future.el
and changed spam.el gnus.el nnimap.el gnus.texi gnus-sum.el gnus-util.el
auth.texi netrc.el gnus-start.el gnutls.c message.el spam-stat.el
- encrypt.el nnir.el nnmail.el imap.el mail-source.el nnmairix.el
- Makefile.in gnus-encrypt.el gnus-html.el and 97 other files
+ encrypt.el nnir.el nnmail.el imap.el mail-source.el nnmairix.el nntp.el
+ Makefile.in gnus-encrypt.el and 97 other files
Terje Rosten: changed xfns.c version.el xterm.c xterm.h
@@ -3550,16 +3609,17 @@ Thamer Mahmoud: changed arabic.el
Theodore Jump: changed makefile.nt makefile.def w32-win.el w32faces.c
Thien-Thi Nguyen: co-wrote hideshow.el
-and changed ewoc.el vc.el zone.el info.el Makefile.in processes.texi
+and changed ewoc.el vc.el info.el zone.el Makefile.in processes.texi
lisp-mode.el text.texi vc-rcs.el display.texi fileio.c files.el
scheme.el vc-git.el MORE.STUFF TUTORIAL.it bindat.el cc-vars.el
configure.in dcl-mode.el diff-mode.el and 158 other files
Thierry Emery: changed kinsoku.el timezone.el url-http.el wid-edit.el
-Thierry Volpiatto: changed bookmark.el eshell.el gnus-sum.el
- image-mode.el info.el man.el woman.el dired-aux.el dired.el doc-view.el
- files.el gnus-art.el image-dired.el vc-rcs.el
+Thierry Volpiatto: changed bookmark.el files.el dired-aux.el
+ eshell/eshell.el gnus-sum.el files.texi image-mode.el info.el man.el
+ woman.el dired.el doc-view.el find-func.el gnus-art.el gnus-msg.el
+ image-dired.el tramp.el vc-rcs.el
Thomas Baumann: wrote org-mhe.el
and co-wrote org-bbdb.el
@@ -3570,6 +3630,8 @@ Thomas Deweese: changed x-win.el
Thomas Dorner: changed ange-ftp.el
+Thomas Dye: changed org.texi org-bibtex.el ob-R.el org.el
+
Thomas Horsley: changed cxux-crt0.s cxux.h cxux7.h emacs.c nh3000.h
nh4000.h simple.el sysdep.c xterm.c
@@ -3577,7 +3639,7 @@ Thomas Hühn: changed tutorial.el
Thomas Link: wrote filesets.el
-Thomas Morgan: changed forms.el select.el
+Thomas Morgan: changed org-habit.el forms.el select.el
Thomas Neumann: co-wrote make-mode.el
and changed makefile.el
@@ -3591,19 +3653,21 @@ and changed emacs-lock.el subr.el
Thor Kristoffersen: changed nntp.el
+Thorsten Jolitz: co-wrote ob-picolisp.el
+
Thorsten Ohl: changed lread.c next.h
Tiago Saboga: changed files.el
-Tibor Šimko: co-wrote slovak.el
+Tibor Šimko: co-wrote language/slovak.el quail/slovak.el
-Tijs Van Bakel: changed erc.el
+Tijs van Bakel: changed erc.el
Tim Cross: changed keymaps.texi
Tim Harper: changed ns-win.el
-Tim Landscheidt: changed gnus.texi
+Tim Landscheidt: changed gnus.texi icalendar.el sort.el ws-mode.el
Tim Van Holder: changed emacsclient.c Makefile.in configure.in
progmodes/compile.el which-func.el
@@ -3621,6 +3685,8 @@ Toby Allsopp: changed ldap.el eudc.el
Toby Cubitt: co-wrote avl-tree.el
+Toby S. Cubitt: changed org.el
+
Toby Speight: changed generic-x.el window.el
Tokuya Kameshima: wrote org-mew.el
@@ -3628,8 +3694,6 @@ and co-wrote org-wl.el
Tom Breton: changed autoinsert.el cus-edit.el gnus-agent.el lread.c
-Tom Dye: changed org-bibtex.el org.texi org.el
-
Tom Hageman: changed etags.c
Tom Houlder: wrote mantemp.el
@@ -3660,11 +3724,14 @@ Tomoji Kagatani: wrote smtpmail.el
Torbjörn Axelsson: changed options.el
-Torbjörn Einarsson: wrote f90.el
+Torbjörn Einarsson: wrote progmodes/f90.el
+and changed f90.el
+
+Torsten Anders: changed org-beamer.el
Torsten Bronger: changed latin-ltx.el
-Toru Tomabechi: wrote tibet-util.el tibetan.el
+Toru Tomabechi: wrote language/tibetan.el quail/tibetan.el tibet-util.el
Toru Tsuneyoshi: changed ange-ftp.el buff-menu.el cus-start.el fileio.c
files.el lisp.h tramp.el w32fns.c
@@ -3679,6 +3746,8 @@ Trey Jackson: changed spam-stat.el
Triet Hoai Lai: changed vntelex.el viet-util.el vietnamese.el
+Troels Nielsen: changed process.c
+
Trung Tran-Duc: changed nntp.el
Tsuchiya Masatoshi: changed gnus-art.el mm-view.el gnus-sum.el
@@ -3712,9 +3781,9 @@ and changed org-gnus.el smime.el
Ulrich Leodolter: changed w32proc.c
-Ulrich Mueller: changed configure.in Makefile.in files.el gud.el
- server.el ChgPane.c ChgSel.c HELLO INSTALL XMakeAssoc.c authors.el
- bytecomp.el calc-units.el case-table.el configure doctor.el em-ls.el
+Ulrich Mueller: changed configure.in Makefile.in doctor.el files.el
+ gud.el server.el ChgPane.c ChgSel.c HELLO INSTALL XMakeAssoc.c
+ authors.el bytecomp.el calc-units.el case-table.el configure em-ls.el
emacs.1 emacs.c emacs.desktop emacsclient.c and 26 other files
Ulrich Neumerkel: changed xterm.c
@@ -3726,13 +3795,20 @@ Vadim Nasardinov: changed allout.el
Vagn Johansen: changed gnus-cache.el vc-svn.el
-Valery Alexeev: changed cyril-util.el cyrillic.el
+Valentin Wüstholz: changed org.el
+
+Valery Alexeev: changed cyril-util.el quail/cyrillic.el
-Vasily Korytov: changed cyrillic.el message.el cperl-mode.el gnus-art.el
- gnus-dired.el gnus-msg.el gnus-util.el mail-source.el smiley.el
+Vasily Korytov: changed message.el quail/cyrillic.el cperl-mode.el
+ gnus-art.el gnus-dired.el gnus-msg.el gnus-util.el mail-source.el
+ smiley.el
Victor Zandy: wrote zone.el
+Vida Gábor: changed gnus-demon.el
+
+Viktor Rosenfeld: changed ob-sql.el
+
Ville Skyttä: changed mh-comp.el pgg.el tcl.el
Vincent Belaïche: changed ses.el 5x5.el calc-alg.el calc-vec.el calc.texi
@@ -3750,6 +3826,8 @@ and changed ps-prin1.ps ps-bdf.el ps-prin0.ps blank-mode.el ps-prin3.ps
easymenu.el loading.texi menu-bar.el misc.texi progmodes/compile.el
ps-print-def.el ps-print.ps ps-vars.el
+Vitalie Spinu: changed ob-R.el
+
Vivek Dasmohapatra: wrote hfy-cmap.el htmlfontify.el
and changed erc.el erc-backend.el emacs.c erc-join.el erc-services.el
sh-script.el xterm.c xterm.h
@@ -3758,6 +3836,8 @@ Vladimir Alexiev: changed arc-mode.el nnvirtual.el tmm.el
Vladimir Volovich: changed smime.el
+Volker Sobek: changed programs.texi
+
W. Martin Borgert: changed files.el schemas.xml
Walter C. Pelissero: changed browse-url.el url-methods.el
@@ -3767,10 +3847,11 @@ Wang Diancheng: changed gdb-mi.el nnml.el
Werner Benger: changed keyboard.c
Werner Lemberg: wrote sisheng.el vntelex.el
-and changed Makefile.in TUTORIAL.de calc.texi chinese.el czech.el emacs.1
- european.el idlwave.el reftex-vars.el reftex.el reftex.texi slovak.el
- supercite.el advice.el calc-forms.el calc-sel.el calendar.el
- china-util.el cl-macs.el cl.texi complete.el and 50 other files
+and changed Makefile.in TUTORIAL.de calc.texi chinese.el emacs.1
+ european.el idlwave.el language/czech.el language/slovak.el
+ reftex-vars.el reftex.el reftex.texi supercite.el advice.el
+ calc-forms.el calc-sel.el calendar.el china-util.el cl-macs.el cl.texi
+ complete.el and 50 other files
Werner Meisner: changed lwlib-Xm.c
@@ -3815,7 +3896,7 @@ and changed latin-pre.el pl-refcard.ps pl-refcard.tex refcard-pl.ps
Wolfgang Glas: changed unexsgi.c
-Wolfgang Jenkner: changed conf-mode.el gnus-sum.el lread.c
+Wolfgang Jenkner: changed conf-mode.el gnus-agent.el gnus-sum.el lread.c
network-stream.el pcvs.el pop3.el
Wolfgang Lux: changed nsterm.m keyboard.c
@@ -3837,7 +3918,7 @@ Xavier Maillard: changed gnus-faq.texi gnus-score.el mh-utils.el spam.el
Yagi Tatsuya: changed gnus-art.el gnus-start.el
-Yair F: changed hebrew.el
+Yair F: changed quail/hebrew.el
Yamamoto Mitsuharu: changed macterm.c macfns.c mac-win.el mac.c macterm.h
macmenu.c macgui.h image.c xdisp.c macselect.c keyboard.c xterm.c
@@ -3853,7 +3934,7 @@ Yavor Doganov: changed configure.in Info-gnustep.plist Makefile.in
Yoichi Nakayama: changed browse-url.el finder.el man.el rfc2368.el
-Yong Lu: changed charset.c coding.c greek.el
+Yong Lu: changed charset.c coding.c language/greek.el
Yoni Rabkin: changed faces.el net-utils.el artist.el bs.el cmacexp.el
ediff.el files.el hilit19.el ps-mode.el simula.el vera-mode.el
@@ -3892,6 +3973,8 @@ Zoltan Kemenczy: changed gud.el
Zoran Milojevic: changed avoid.el
+Йордан Миладинов: changed quail/cyrillic.el
+
Local Variables:
coding: utf-8
End:
diff --git a/etc/CONTRIBUTE b/etc/CONTRIBUTE
index 990335a3f77..aff350f9642 100644
--- a/etc/CONTRIBUTE
+++ b/etc/CONTRIBUTE
@@ -1,4 +1,4 @@
-Copyright (C) 2006-2011 Free Software Foundation, Inc.
+Copyright (C) 2006-2012 Free Software Foundation, Inc.
See end for license conditions.
@@ -44,13 +44,24 @@ Ref: The "Tips" Appendix in the Emacs Lisp Reference.
* Copyright Assignment
-We can accept small changes (roughly, fewer than 15 lines) without
-legal papers. Anything more substantial requires a copyright
-disclaimer or assignment (the latter is preferred, especially for
-larger changes). Both of these involved filling out a short form and
-filing it with the FSF. The process is straightforward -- contact us
-at emacs-devel@gnu.org to obtain the relevant forms.
+The FSF (Free Software Foundation) is the copyright holder for GNU Emacs.
+The FSF is a nonprofit with a worldwide mission to promote computer
+user freedom and to defend the rights of all free software users.
+For general information, see the website http://www.fsf.org/ .
+
+Generally speaking, for non-trivial contributions to GNU Emacs we
+require that the copyright be assigned to the FSF. For the reasons
+behind this, see: http://www.gnu.org/licenses/why-assign.html .
+Copyright assignment is a simple process. If you live in the US, you
+can do it entirely electronically. We can help you get started, and
+answer any questions you may have (or point you to the people with the
+answers), at the emacs-devel@gnu.org mailing list.
+
+A copyright disclaimer is also a possibility, but we prefer an assignment.
+We can accept small changes (roughly, fewer than 15 lines) without
+an assignment. This is a cumulative limit (e.g. three separate 5 line
+patches) over all your contributions.
* Getting the Source Code
diff --git a/etc/ChangeLog b/etc/ChangeLog
index 758025c6c3e..11dc42b7f45 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,393 @@
+2012-11-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * NEWS: Document Calc changes for Gregorian calendar (Bug#12633).
+
+2012-10-26 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * refcards/orgcard.tex: Fix keybindings about
+ `org-show-todo-tree'.
+
+2012-10-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix outdated timestamp documentation in Elisp manual (bug#12706).
+ * NEWS: Document increased precision in undo list.
+
+2012-10-21 Glenn Morris <rgm@gnu.org>
+
+ * images/icons/hicolor/32x32/apps/emacs22.png:
+ * images/icons/hicolor/16x16/apps/emacs22.png:
+ * images/icons/hicolor/48x48/apps/emacs22.png:
+ * images/icons/hicolor/24x24/apps/emacs22.png: Restore old icons.
+
+2012-10-14 Kenichi Handa <handa@gnu.org>
+
+ * charsets/JISC6226.map: Re-generated.
+
+2012-10-14 Eli Zaretskii <eliz@gnu.org>
+
+ * compilation.txt (msft): Add error messages in new Studio 2010
+ format.
+
+2012-10-11 Kenichi Handa <handa@gnu.org>
+
+ * charsets/CNS-2.map, charsets/CNS-3.map, charsets/CNS-4.map:
+ * charsets/CNS-5.map, charsets/CNS-6.map, charsets/CNS-7.map:
+ * charsets/CP932-2BYTE.map, charsets/GB180302.map:
+ * charsets/GB180304.map, charsets/JISC6226.map:
+ * charsets/JISX2131.map, charsets/MIK.map, charsets/PTCP154.map:
+ * charsets/stdenc.map, charsets/symbol.map: Re-generate.
+
+2012-10-07 Jan Djärv <jan.h.d@swipnet.se>
+
+ * NEWS (NextStep/OSX port changes): OSX 10.4 or newer is required.
+
+2012-10-05 Douglas Lewan <d_lewan2000@yahoo.com> (tiny change)
+
+ * tutorials/TUTORIAL.pt_BR: Fix typo. (Bug#12557)
+
+2012-10-01 Eric Ludlam <zappo@gnu.org>
+
+ * srecode/cc.srt, srecode/ede-autoconf.srt: New files.
+
+ * srecode/cpp.srt: Move parts to c.srt.
+
+ * srecode/ede-make.srt: Extra templates for Arduino Makefiles.
+
+2012-10-01 Ralf Mattes <rm@mh-freiburg.de> (tiny change)
+
+ * srecode/el.srt (variable-option): Add missing quote.
+
+2012-10-01 Chong Yidong <cyd@gnu.org>
+
+ * images/icons/hicolor/32x32/apps/emacs22.png:
+ * images/icons/hicolor/16x16/apps/emacs22.png:
+ * images/icons/hicolor/48x48/apps/emacs22.png:
+ * images/icons/hicolor/24x24/apps/emacs22.png: Remove old icons
+ (Bug#12536).
+
+2012-10-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Revert the FOLLOW-SYMLINKS change for file-attributes.
+ * NEWS: Undo last change.
+
+2012-09-30 Bastien Guerry <bzg@gnu.org>
+
+ * refcards/orgcard.tex: Update version number.
+
+2012-09-30 Jambunathan K <kjambunathan@gmail.com>
+
+ * org/OrgOdtContentTemplate.xml:
+ * org/OrgOdtStyles.xml: Add Listing-related entries.
+
+2012-09-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ file-attributes has a new optional arg FOLLOW-SYMLINKS.
+ * NEWS: Document the change.
+
+2012-09-30 Jan Djärv <jan.h.d@swipnet.se>
+
+ * NEWS: The NS port supports fullscreen.
+ Mention that the file dialog is used on NS.
+
+2012-09-17 Glenn Morris <rgm@gnu.org>
+
+ * refcards/emacsver.tex: New file.
+ * refcards/calccard.tex, refcards/cs-dired-ref.tex:
+ * refcards/cs-refcard.tex, refcards/cs-survival.tex:
+ * refcards/de-refcard.tex, refcards/dired-ref.tex:
+ * refcards/emacsver.tex, refcards/fr-dired-ref.tex:
+ * refcards/fr-refcard.tex, refcards/fr-survival.tex:
+ * refcards/orgcard.tex, refcards/pl-refcard.tex:
+ * refcards/pt-br-refcard.tex, refcards/refcard.tex:
+ * refcards/sk-dired-ref.tex, refcards/sk-refcard.tex:
+ * refcards/sk-survival.tex, refcards/survival.tex:
+ * refcards/vipcard.tex, refcards/viperCard.tex: Include emacsver.tex.
+ * refcards/calccard.tex (\emacsversionnumber):
+ Rename to \versionemacs, same as all the other refcards.
+ * refcards/Makefile (ENVADD): New variable.
+ (sk-dired-ref.pdf, sk-survival.pdf, pl-refcard.pdf)
+ (%.pdf, %,dvi, sk-dired-ref.dvi, sk-survival.dvi, pl-refcard.dvi):
+ Depend on emacsver.tex. Add "." to TEXINPUTS for TeX commands.
+
+2012-09-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove configure's --without-sync-input option (Bug#12450).
+ * TODO (Make SYNC_INPUT the default): Remove, as the code now
+ behaves as if SYNC_INPUT is always true.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use a more backwards-compatible timer format (Bug#12430).
+ * NEWS: Document it, plus fix a typo.
+
+2012-09-13 Jan Djärv <jan.h.d@swipnet.se>
+
+ * NEWS (--with-x-toolkit): Mention that Gtk+ 3 is now default.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ * NEWS: Document timer format change (Bug#12430).
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify, document, and port floating-point (Bug#12381).
+ * NEWS: Document NaNs versus signaling-error change.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Give more-useful info on a fatal error (Bug#12328).
+ * NEWS: Document the change.
+
+2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better seeds for (random).
+ * NEWS: Document new behavior of (random), (random "string").
+
+2012-08-28 Andreas Schwab <schwab@linux-m68k.org>
+
+ * charsets/MULE-ethiopic.map: Fix typo in comment.
+ * charsets/MULE-ipa.map: Likewise.
+ * charsets/MULE-is13194.map: Likewise.
+ * charsets/MULE-lviscii.map: Likewise.
+ * charsets/MULE-sisheng.map: Likewise.
+ * charsets/MULE-tibetan.map: Likewise.
+ * charsets/MULE-uviscii.map: Likewise.
+
+2012-08-09 Chong Yidong <cyd@gnu.org>
+
+ * images/splash.svg, images/splash.png: Tweak SVG paths to improve
+ legibility.
+
+2012-08-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * NEWS: Mention --without-all and --enable-link-time-optimization.
+
+2012-07-31 Jan Djärv <jan.h.d@swipnet.se>
+
+ * TODO (NS port): Add text about event loop.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ deactive->inactive, inactivate->deactivate spelling fixes (Bug#10150)
+ * NEWS: Document these changes.
+
+2012-07-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * NEWS: Fix typo.
+
+2012-07-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify export of symbols to GDB.
+ * emacs-buffer.gdb ($tagmask, $valmask): Remove.
+ (ygetptr): Adjust to recent changes in lisp.h and emacs.c,
+ by using VALMASK instead of $valmask, CHECK_LISP_OBJECT_TYPE
+ instead of gdb_use_union, and DATA_SEG_BITS instead of
+ gdb_data_seg_bits. Also, use $ptr.i rather than $ptr.u.val.
+
+2012-07-20 Eli Zaretskii <eliz@gnu.org>
+
+ * tutorials/TUTORIAL.he: Make the first sentence display correctly
+ in a left-to-right paragraph, such as what is shown on the fancy
+ splash screen.
+
+2012-07-15 Leo Liu <sdl.web@gmail.com>
+
+ * NEWS: Mention exclamation-mark and flymake.
+
+2012-07-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * tutorials/TUTORIAL.es: Sync with changes in 2012-07-07T10:34:37Z!cyd@gnu.org.
+
+2012-07-07 Michael Witten <mfwitten@gmail.com> (tiny change)
+
+ * tutorials/TUTORIAL: Copyedits (Bug#11689).
+
+2012-06-28 Glenn Morris <rgm@gnu.org>
+
+ * emacs.py, emacs2.py, emacs3.py: Remove files, no longer used.
+
+2012-06-24 Lawrence Mitchell <wence@gmx.li>
+
+ * NEWS: Move and improve the defun/defalias changes (bug#11686).
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+ * NEWS: Mention addition of picoseconds to time stamp format.
+
+2012-06-13 Deniz Dogan <deniz@dogan.se>
+
+ * tutorials/TUTORIAL.sv: Fix grammar and a couple of typos.
+
+2012-06-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * PROBLEMS (68000 C compiler problems): Remove obsolete section.
+ Not only are the compilers long-dead, the obsolete advice
+ typically doesn't apply to current Emacs sources.
+
+2012-06-03 Chong Yidong <cyd@gnu.org>
+
+ * themes/wheatgrass-theme.el:
+ * themes/deeper-blue-theme.el:
+ * themes/tango-dark-theme.el:
+ * themes/tsdh-dark-theme.el: Add compilation-mode-line-fail,
+ compilation-mode-line-run, and compilation-mode-line-exit faces.
+
+ * themes/manoj-dark-theme.el: Remove :family attributes.
+
+2012-06-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove --disable-maintainer-mode option from 'configure'. (Bug#11555)
+ * NEWS: Mention this.
+
+2012-06-01 Andrew Beals <andrew.beals@gmail.com> (tiny change)
+
+ * spook.lines: Additions. (Bug#11598)
+
+2012-05-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ * PROBLEMS: Remove obsolete '#define static' cruft.
+
+2012-05-07 Glenn Morris <rgm@gnu.org>
+
+ * forms/forms-d2.el, forms/forms-pass.el: Move here from ../lisp.
+ * forms/forms-d2.dat: Move to forms/ subdirectory.
+ * forms/README: New.
+
+2012-05-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * NEWS: Do not limit current-time-string to years 1000..9999.
+
+2012-04-27 Jambunathan K <kjambunathan@gmail.com>
+
+ * org/OrgOdtStyles.xml (OrgDescriptionList): Modify style.
+ With this change, in a description list, if the description paragraph
+ spawns multiple lines then it will correctly indented.
+
+2012-04-20 Glenn Morris <rgm@gnu.org>
+
+ * CONTRIBUTE: Expand a bit on copyright assignments.
+
+ * MORE.STUFF: General update. Mention list-packages.
+ Remove many old/outdated URLs.
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * publicsuffix.txt: New file (bug#1401).
+
+2012-04-02 Alan Mackenzie <acm@muc.de>
+
+ * NEWS: Add CC Mode entries.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org/OrgOdtContentTemplate.xml (OrgIndentedSection-Level-*):
+ New section styles. These sections are indented to the same
+ level as the corresponding list entries. These sections hold
+ tables that occur within a list. (OrgTable):
+ Increased relative width from 90% to 96% for aesthetic reasons.
+
+2012-03-16 Glenn Morris <rgm@gnu.org>
+
+ * HELLO: Say that this is not a comprehensive list.
+ Remove "duplicate" entry. (Bug#11024)
+
+2012-02-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ * emacs-buffer.gdb ($valmask): Don't assume EMACS_INT fits in 'long'.
+
+2012-02-10 Leo Liu <sdl.web@gmail.com>
+
+ * NEWS: Change condition-case-no-debug to
+ condition-case-unless-debug and split the entry in two.
+
+2012-02-08 Alex Ott <alexott@gmail.com>
+
+ * tutorials/TUTORIAL.ru: Updated; synchronize with TUTORIAL.
+ Coding system changed to UTF-8.
+
+2012-02-06 Juanma Barranquero <lekktu@gmail.com>
+
+ * tutorials/TUTORIAL.es: Updated; synchronize with TUTORIAL.
+
+2012-02-03 Pieter Schoenmakers <tiggr@tiggr.net>
+
+ * tutorials/TUTORIAL.nl: Updated; synchronize with TUTORIAL.
+
+2012-01-30 Chong Yidong <cyd@gnu.org>
+
+ * tutorials/TUTORIAL: Delete a repeat sentence.
+
+2012-01-25 Mats Lidell <mats.lidell@cag.se>
+
+ * tutorials/TUTORIAL.sv: Updated; synchronize with TUTORIAL.
+
+2012-01-21 Ognyan Kulev <ogi@tower.3.bg>
+
+ * tutorials/TUTORIAL.bg: Updated; synchronize with TUTORIAL.
+
+2012-01-19 Werner Lemberg <wl@gnu.org>
+
+ * tutorial/TUTORIAL.de: Updated; synchronize with TUTORIAL.
+ Minor typographical improvements.
+
+2012-01-17 Primoz PETERLIN <primoz.peterlin@mf.uni-lj.si>
+
+ * tutorials/TUTORIAL.sl: Update.
+
+2012-01-14 Eli Zaretskii <eliz@gnu.org>
+
+ * tutorials/TUTORIAL.he: Update to follow changes to TUTORIAL in
+ 2012-01-10T08:27:22Z!cyd@gnu.org.
+
+2012-01-10 Chong Yidong <cyd@gnu.org>
+
+ * tutorials/TUTORIAL: Don't give instructions for old-style X
+ scrollbars. Use DEL terminology instead of DelBack.
+ Improve description of graphical continuation lines and mode-line.
+ Promote use of C-/ and C-SPC. Remove discussion of flow control.
+
+2012-01-05 Glenn Morris <rgm@gnu.org>
+
+ * refcards/calccard.tex, refcards/cs-dired-ref.tex:
+ * refcards/cs-refcard.tex, refcards/cs-survival.tex:
+ * refcards/de-refcard.tex, refcards/dired-ref.tex:
+ * refcards/fr-dired-ref.tex, refcards/fr-refcard.tex:
+ * refcards/fr-survival.tex, refcards/pl-refcard.tex:
+ * refcards/pt-br-refcard.tex, refcards/refcard.tex:
+ * refcards/ru-refcard.tex, refcards/sk-dired-ref.tex:
+ * refcards/sk-refcard.tex, refcards/sk-survival.tex:
+ * refcards/survival.tex: Bump version number to 24.
+
+ * refcards/calccard.tex, refcards/cs-dired-ref.tex:
+ * refcards/cs-refcard.tex, refcards/cs-survival.tex:
+ * refcards/de-refcard.tex, refcards/dired-ref.tex:
+ * refcards/fr-dired-ref.tex, refcards/fr-refcard.tex:
+ * refcards/fr-survival.tex, refcards/orgcard.tex:
+ * refcards/pl-refcard.tex, refcards/pt-br-refcard.tex:
+ * refcards/refcard.tex, refcards/ru-refcard.tex:
+ * refcards/sk-dired-ref.tex, refcards/sk-refcard.tex:
+ * refcards/sk-survival.tex, refcards/survival.tex:
+ * refcards/vipcard.tex, refcards/viperCard.tex:
+ Update short copyright year to 2012.
+
+2012-01-04 Chong Yidong <cyd@stupidchicken.com>
+
+ * org/README: Rename from COPYRIGHT-AND-LICENSE.
+
+2012-01-03 Jambunathan K <kjambunathan@gmail.com>
+
+ * org/OrgOdtContentTemplate.xml, org/OrgOdtStyles.xml: New files.
+
+2012-01-03 Bastien Guerry <bzg@altern.org>
+
+ * org/COPYRIGHT-AND-LICENSE: New file.
+
+ * org/: New directory.
+
+2012-01-03 Julian Gehring <julian.gehring@googlemail.com>
+
+ * refcards/orgcard.tex: Correct one markup in the "Timestamps" section.
+
2011-12-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
* NEWS: Mention auth-source twice in connection with smtpmail to
@@ -283,12 +673,12 @@
2011-02-17 Ken Manheimer <ken.manheimer@gmail.com>
- * images/icons/allout-widgets/dark-bg/encrypted-locked.png:
- * images/icons/allout-widgets/dark-bg/encrypted-locked.xpm:
+ * images/icons/allout-widgets/dark-bg/locked-encrypted.png:
+ * images/icons/allout-widgets/dark-bg/locked-encrypted.xpm:
* images/icons/allout-widgets/dark-bg/unlocked-encrypted.png:
* images/icons/allout-widgets/dark-bg/unlocked-encrypted.xpm:
- * images/icons/allout-widgets/light-bg/encrypted-locked.png:
- * images/icons/allout-widgets/light-bg/encrypted-locked.xpm:
+ * images/icons/allout-widgets/light-bg/locked-encrypted.png:
+ * images/icons/allout-widgets/light-bg/locked-encrypted.xpm:
* images/icons/allout-widgets/light-bg/unlocked-encrypted.png:
* images/icons/allout-widgets/light-bg/unlocked-encrypted.xpm:
Reorganize icon directories and files to reconcile against windows
@@ -326,11 +716,11 @@
POSIX does not allow "-" in Makefile variable names.
Reported by Bruno Haible in
<http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00990.html>.
- * refcards/Makefile (DIRED_REFCARDS_PDF): Renamed from
+ * refcards/Makefile (DIRED_REFCARDS_PDF): Rename from
DIRED-REFCARDS_PDF.
- (MISC_REFCARDS_PDF): Renamed from MISC-REFCARDS_PDF.
- (SURVIVAL_CARDS_PDF): Renamed from SURVIVAL-CARDS_PDF.
- (VIPER_CARDS_PDF): Renamed from VIPER-CARDS_PDF.
+ (MISC_REFCARDS_PDF): Rename from MISC-REFCARDS_PDF.
+ (SURVIVAL_CARDS_PDF): Rename from SURVIVAL-CARDS_PDF.
+ (VIPER_CARDS_PDF): Rename from VIPER-CARDS_PDF.
2011-01-18 Glenn Morris <rgm@gnu.org>
@@ -799,7 +1189,7 @@
2009-09-27 Teodor Zlatanov <tzz@lifelogs.com>
- * NEWS: Mention new library imap-hash.el
+ * NEWS: Mention new library imap-hash.el.
2009-09-22 Juanma Barranquero <lekktu@gmail.com>
@@ -843,7 +1233,7 @@
2009-08-08 Dmitry Dzhus <dima@sphinx.net.ru>
* images/gud/all.xpm, images/gud/thread.xpm: New icons for
- gdb-mi.el
+ gdb-mi.el.
2009-08-07 Dan Nicolaescu <dann@ics.uci.edu>
@@ -1794,7 +2184,7 @@
* refcards/refcard.tex: Updates for printing.
(\versionyear): Update to 2007.
- (\copyrightnotice): Modified or unmodified ok.
+ (\copyrightnotice): Modify or unmodified ok.
(Simple Customization): Don't use goto-line, since now it's bound.
Also, use now-preferred (kbd ...) syntax.
@@ -1879,7 +2269,7 @@
2007-07-02 Carsten Dominik <dominik@science.uva.nl>
- * orgcard.tex: Version 5.01
+ * orgcard.tex: Version 5.01.
2007-06-27 Michael Albinus <michael.albinus@gmx.de>
@@ -2447,7 +2837,7 @@
2006-09-15 Richard Stallman <rms@gnu.org>
* THE-GNU-PROJECT: Update with the latest footnotes
- from www.gnu.org/gnu/the-gnu-project.html
+ from www.gnu.org/gnu/the-gnu-project.html.
2006-09-15 David Kastrup <dak@gnu.org>
@@ -2468,7 +2858,7 @@
2006-09-03 Diane Murray <disumu@x3y2z1.net>
- * erc.texi (Getting Started, Connecting): Changed erc-select to erc.
+ * erc.texi (Getting Started, Connecting): Change erc-select to erc.
2006-09-02 Juri Linkov <juri@jurta.org>
@@ -2585,8 +2975,8 @@
2006-07-05 Kenichi Handa <handa@m17n.org>
- * HELLO: Add a paragraph for non-ASCII examples at the head. Add
- Bulgarian and Hungarian. Add more "hello"s to Danish and Swedish.
+ * HELLO: Add a paragraph for non-ASCII examples at the head.
+ Add Bulgarian and Hungarian. Add more "hello"s to Danish and Swedish.
2006-07-03 Bill Wohler <wohler@newt.com>
@@ -2732,7 +3122,7 @@
2006-05-24 Carsten Dominik <dominik@science.uva.nl>
- * orgcard.tex (section{Motion}): Added the item navigation commands.
+ * orgcard.tex (section{Motion}): Add the item navigation commands.
(section{Publishing}): New section.
(section{Links}): Documented elisp and shell links.
@@ -2868,8 +3258,8 @@
New bitmaps for new images.
* images/refresh.xpm, images/sort-ascending.xpm,
- * images/sort-descending.xpm: Update with GTK 2.x images. Note
- that the default GTK icons are not overridden by the GNOME theme
+ * images/sort-descending.xpm: Update with GTK 2.x images.
+ Note that the default GTK icons are not overridden by the GNOME theme
due to a bug which was fixed in GNOME 2.15. Once GNOME 2.16 is in
wide circulation, then the GTK icons should be replaced with the
equivalent GNOME icons. Until then, we should be consistent with
@@ -3073,7 +3463,7 @@
2005-11-18 Carsten Dominik <dominik@science.uva.nl>
- * orgcard.tex: Version 3.20
+ * orgcard.tex: Version 3.20.
2005-11-16 Nick Roberts <nickrob@snap.net.nz>
@@ -4139,8 +4529,8 @@
2001-11-22 Colin Walters <walters@debian.org>
- * PROBLEMS: Remove already applied calc info patches. Clarify
- that there is no such thing as Debian GNU/Linux 2.4.3. ftpd is
+ * PROBLEMS: Remove already applied calc info patches.
+ Clarify that there is no such thing as Debian GNU/Linux 2.4.3. ftpd is
not handled by alternatives in Debian, the reporter surely meant
just "--config ftp".
@@ -4257,8 +4647,8 @@
* ps-prin1.ps: Footer implementation. Doc fix.
(doLineNumber): Code fix for line number color.
- (BeginPage, BeginSheet, HeaderFramePath, HeaderFrame, HeaderText): Code
- fix for footer implementation.
+ (BeginPage, BeginSheet, HeaderFramePath, HeaderFrame, HeaderText):
+ Code fix for footer implementation.
(TextStart, SetFooterLines, FooterFrameStart, doFramePath)
(FooterFramePath, doFrame, FooterFrame, FooterStart)
(HeaderOrFooterTextLines, HeaderOrFooterText, FooterText): New funs.
@@ -4446,8 +4836,8 @@
* ps-prin0.ps: Insert a version number comment (5.2.2).
Indentation fix.
- * ps-prin1.ps: Insert a version number comment (5.2.2). Can
- select page size with/without giving an error if PostScript
+ * ps-prin1.ps: Insert a version number comment (5.2.2).
+ Can select page size with/without giving an error if PostScript
printer doesn't have this kind of page size. Zebra Stripe
continues or restarts on next page. Indentation fix.
(BeginSheet): If necessary, rescale n-up to fit on the sheet of
@@ -4658,8 +5048,8 @@
* termcap.dat, termcap.ucb: Deleted and replaced.
* termcap: New termcap file from the ncurses project; bigger,
- better, brighter, does away with waxy yellow buildup. Email
- me at terminfo@ccil.org if you have any trouble with this.
+ better, brighter, does away with waxy yellow buildup.
+ Email me at terminfo@ccil.org if you have any trouble with this.
* README: Changed to track above change.
@@ -4669,7 +5059,7 @@
1995-04-26 Karl Heuer <kwzh@nutrimat.gnu.ai.mit.edu>
- * Makefile (maintainer-clean): Renamed from realclean.
+ * Makefile (maintainer-clean): Rename from realclean.
1995-04-09 Richard Stallman <rms@mole.gnu.ai.mit.edu>
@@ -4824,7 +5214,7 @@
1993-03-19 Eric S. Raymond (eric@geech.gnu.ai.mit.edu)
- * sex.6: Added 900-line support
+ * sex.6: Added 900-line support.
* NEWS: Added news about the package finder.
@@ -4866,8 +5256,8 @@
* DISTRIB: The actual domestic order form is now ORDERS.USA.
The DISTRIB text now mentions 19.
- * ORDERS.USA: Created. This is just the order form. DISTRIB
- has a pointer to it at the beginning.
+ * ORDERS.USA: Created. This is just the order form.
+ DISTRIB has a pointer to it at the beginning.
* EUROPE: Renamed to ORDERS.EUROPE. DISTRIB now has a pointer
to it at the beginning.
@@ -4948,7 +5338,7 @@
1992-04-06 Jim Blandy (jimb@pogo.cs.oberlin.edu)
- * etags.c (C_entries): Removed comment saying that \" in a string
+ * etags.c (C_entries): Remove comment saying that \" in a string
isn't recognized as magic, because it is correctly handled.
* getopt.c, getopt.h: New files, from GNU C library.
@@ -4958,8 +5348,8 @@
optind.
(main): Argument processing loop rewritten to call getopt to get
next option. Options which take parameters (-o and -i) rewritten
- to get parameter from optarg instead of argv[1]. Filename
- preprocessing loop and update command changed similarly.
+ to get parameter from optarg instead of argv[1].
+ Filename preprocessing loop and update command changed similarly.
* Makefile (etags, ctags): Depend on and link with getopt.h,
getopt.o, and getopt1.o.
(getopt.o, getopt1.o): New targets for the GNU getopt routines.
@@ -5100,8 +5490,8 @@
1991-01-25 Jim Blandy (jimb@churchy.ai.mit.edu)
* make-docfile: Find the arguments to a C function correctly,
- by not ignoring the character that read_c_string returns. Don't
- even try to find argument names for functions that take MANY
+ by not ignoring the character that read_c_string returns.
+ Don't even try to find argument names for functions that take MANY
or UNEVALLED arguments, since they're a figment of the docstring's
imagination.
@@ -5363,7 +5753,7 @@
1988-12-31 Richard Mlynarik (mly@rice-chex.ai.mit.edu)
* env.c: Add decl for my-index.
- * etags.c (file-entries): .oak => scheme
+ * etags.c (file-entries): .oak => scheme.
1988-12-30 Richard Stallman (rms@sugar-bombs.ai.mit.edu)
@@ -5528,7 +5918,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1993-1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/etc/DEBUG b/etc/DEBUG
index 625a76ac952..20bdd6cdbdc 100644
--- a/etc/DEBUG
+++ b/etc/DEBUG
@@ -1,6 +1,6 @@
Debugging GNU Emacs
-Copyright (C) 1985, 2000-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 2000-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/etc/DISTRIB b/etc/DISTRIB
index cc121105073..7a724c97a95 100644
--- a/etc/DISTRIB
+++ b/etc/DISTRIB
@@ -1,7 +1,7 @@
-*- text -*-
GNU Emacs availability information
-Copyright (C) 1986-1993, 1995, 1998, 2000-2011 Free Software Foundation, Inc.
+Copyright (C) 1986-1993, 1995, 1998, 2000-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 14d2a22e9f9..a1c7b7012f8 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -1,8 +1,10 @@
ERC NEWS -*- outline -*-
-Copyright (C) 2006-2011 Free Software Foundation, Inc.
+Copyright (C) 2006-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
+* For changes after ERC 5.3, see the main Emacs NEWS file
+
* Changes in ERC 5.3
** New function `erc-tls' is to be used for connecting to a server via TLS.
diff --git a/etc/ETAGS.EBNF b/etc/ETAGS.EBNF
index 333465b7a41..2b4857b747a 100644
--- a/etc/ETAGS.EBNF
+++ b/etc/ETAGS.EBNF
@@ -94,7 +94,7 @@ those.
===================== end of discussion of tag names =====================
-Copyright (C) 2002-2011 Free Software Foundation, Inc.
+Copyright (C) 2002-2012 Free Software Foundation, Inc.
COPYING PERMISSIONS:
diff --git a/etc/ETAGS.README b/etc/ETAGS.README
index fd9636c9734..39045719b1c 100644
--- a/etc/ETAGS.README
+++ b/etc/ETAGS.README
@@ -28,7 +28,7 @@ ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2011
+Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2012
Free Software Foundation, Inc.
This file is not considered part of GNU Emacs.
diff --git a/etc/GNU b/etc/GNU
index 97ad4aa9d4b..45f36465da5 100644
--- a/etc/GNU
+++ b/etc/GNU
@@ -1,4 +1,4 @@
-Copyright (C) 1985, 1993, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1993, 2001-2012 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim copies
of this document, in any medium, provided that the copyright notice and
diff --git a/etc/GNUS-NEWS b/etc/GNUS-NEWS
index 3192a58ce90..2417c1c35ce 100644
--- a/etc/GNUS-NEWS
+++ b/etc/GNUS-NEWS
@@ -1,263 +1,44 @@
GNUS NEWS -- history of user-visible changes.
-Copyright (C) 1999-2011 Free Software Foundation, Inc.
+Copyright (C) 1999-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Gnus bug reports to bugs@gnus.org.
For older news, see Gnus info node "New Features".
-* Installation changes
+* New features
-** Upgrading from previous (stable) version if you have used No Gnus.
+** New package `gnus-notifications.el' can send notifications when you
+ receive new messages.
-If you have tried No Gnus (the unstable Gnus branch leading to this
-release) but went back to a stable version, be careful when upgrading to
-this version. In particular, you will probably want to remove the
-`~/News/marks' directory (perhaps selectively), so that flags are read
-from your `~/.newsrc.eld' instead of from the stale marks file, where
-this release will store flags for nntp. See a later entry for more
-information about nntp marks. Note that downgrading isn't safe in
-general.
+** If you have the "tnef" program installed, Gnus will display ms-tnef
+ files, aka "winmail.dat".
-** Incompatibility when switching from Emacs 23 to Emacs 22 In Emacs 23,
-Gnus uses Emacs' new internal coding system `utf-8-emacs' for saving
-articles drafts and `~/.newsrc.eld'. These files may not be read
-correctly in Emacs 22 and below. If you want to use Gnus across
-different Emacs versions, you may set `mm-auto-save-coding-system' to
-`emacs-mule'.
+** Archives (like tar and zip files) will be automatically unpacked,
+ and the files inside the packages will be displayed as MIME parts.
-** Lisp files are now installed in `.../site-lisp/gnus/' by default. It
-defaulted to `.../site-lisp/' formerly. In addition to this, the new
-installer issues a warning if other Gnus installations which will shadow
-the latest one are detected. You can then remove those shadows manually
-or remove them using `make remove-installed-shadows'.
+** shr has a new command `z' that cycles through image sizes.
-** The installation directory name is allowed to have spaces and/or tabs.
+** `backtab' in the summary buffer now selects the previous link in
+ the article buffer.
-
-* New packages and libraries within Gnus
-
-** Gnus includes the Emacs Lisp SASL library.
-
-This provides a clean API to SASL mechanisms from within Emacs. The
-user visible aspects of this, compared to the earlier situation, include
-support for DIGEST-MD5 and NTLM. *Note Emacs SASL: (sasl)Top.
-
-** ManageSieve connections uses the SASL library by default.
-
-The primary change this brings is support for DIGEST-MD5 and NTLM, when
-the server supports it.
-
-** Gnus includes a password cache mechanism in password-cache.el.
-
-It is enabled by default (see `password-cache'), with a short timeout of
-16 seconds (see `password-cache-expiry'). If PGG is used as the PGP
-back end, the PGP passphrase is managed by this mechanism. Passwords
-for ManageSieve connections are managed by this mechanism, after
-querying the user about whether to do so.
-
-** Using EasyPG with Gnus When EasyPG, is available, Gnus will use it
-instead of PGG. EasyPG is an Emacs user interface to GNU Privacy Guard.
- *Note EasyPG Assistant user's manual: (epa)Top. EasyPG is included in
-Emacs 23 and available separately as well.
-
-
-* Changes in group mode
-
-** Old intermediate incoming mail files (`Incoming*') are deleted after a
-couple of days, not immediately. *Note Mail Source Customization::.
-(New in Gnus 5.10.10 / Emacs 22.2)
-
-
-
-* Changes in summary and article mode
-
-** Gnus now supports sticky article buffers. Those are article buffers
-that are not reused when you select another article. *Note Sticky
-Articles::.
-
-** Gnus can selectively display `text/html' articles with a WWW browser
-with `K H'. *Note MIME Commands::.
-
-** International host names (IDNA) can now be decoded inside article bodies
-using `W i' (`gnus-summary-idna-message'). This requires that GNU Libidn
-(`http://www.gnu.org/software/libidn/') has been installed.
-
-** The non-ASCII group names handling has been much improved. The back
-ends that fully support non-ASCII group names are now `nntp', `nnml',
-and `nnrss'. Also the agent, the cache, and the marks features work
-with those back ends. *Note Non-ASCII Group Names::.
-
-** Gnus now displays DNS master files sent as text/dns using dns-mode.
-
-** Gnus supports new limiting commands in the Summary buffer: `/ r'
-(`gnus-summary-limit-to-replied') and `/ R'
-(`gnus-summary-limit-to-recipient'). *Note Limiting::.
-
-** You can now fetch all ticked articles from the server using `Y t'
-(`gnus-summary-insert-ticked-articles'). *Note Summary Generation
-Commands::.
-
-** Gnus supports a new sort command in the Summary buffer: `C-c C-s C-t'
-(`gnus-summary-sort-by-recipient'). *Note Summary Sorting::.
-
-** S/MIME now features LDAP user certificate searches. You need to
-configure the server in `smime-ldap-host-list'.
-
-** URLs inside OpenPGP headers are retrieved and imported to your PGP key
-ring when you click on them.
-
-** Picons can be displayed right from the textual address, see
-`gnus-picon-style'. *Note Picons::.
-
-** ANSI SGR control sequences can be transformed using `W A'.
-
-ANSI sequences are used in some Chinese hierarchies for highlighting
-articles (`gnus-article-treat-ansi-sequences').
-
-** Gnus now MIME decodes articles even when they lack "MIME-Version" header.
-This changes the default of `gnus-article-loose-mime'.
-
-** `gnus-decay-scores' can be a regexp matching score files. For example,
-set it to `\\.ADAPT\\'' and only adaptive score files will be decayed.
- *Note Score Decays::.
-
-** Strings prefixing to the `To' and `Newsgroup' headers in summary lines
-when using `gnus-ignored-from-addresses' can be customized with
-`gnus-summary-to-prefix' and `gnus-summary-newsgroup-prefix'. *Note To
-From Newsgroups::.
-
-** You can replace MIME parts with external bodies. See
-`gnus-mime-replace-part' and `gnus-article-replace-part'. *Note MIME
-Commands::, *note Using MIME::.
-
-** The option `mm-fill-flowed' can be used to disable treatment of
-format=flowed messages. Also, flowed text is disabled when sending
-inline PGP signed messages. *Note Flowed text: (emacs-mime)Flowed text.
-(New in Gnus 5.10.7)
-
-** Now the new command `S W' (`gnus-article-wide-reply-with-original') for
-a wide reply in the article buffer yanks a text that is in the active
-region, if it is set, as well as the `R'
-(`gnus-article-reply-with-original') command. Note that the `R' command
-in the article buffer no longer accepts a prefix argument, which was
-used to make it do a wide reply. *Note Article Keymap::.
-
-** The new command `C-h b' (`gnus-article-describe-bindings') used in the
-article buffer now shows not only the article commands but also the real
-summary commands that are accessible from the article buffer.
+** Using the "X-Message-SMTP-Method" header in Message buffers now
+ allows specifying how messages are to be sent. For example:
+ X-Message-SMTP-Method: smtp smtp.fsf.org 587
-
-* Changes in Message mode
-
-** Gnus now supports the "hashcash" client puzzle anti-spam mechanism. Use
-`(setq message-generate-hashcash t)' to enable. *Note Hashcash::.
-
-** You can now drag and drop attachments to the Message buffer. See
-`mml-dnd-protocol-alist' and `mml-dnd-attach-options'. *Note MIME:
-(message)MIME.
-
-** The option `message-yank-empty-prefix' now controls how empty lines are
-prefixed in cited text. *Note Insertion Variables: (message)Insertion
-Variables.
-
-** Gnus uses narrowing to hide headers in Message buffers. The
-`References' header is hidden by default. To make all headers visible,
-use `(setq message-hidden-headers nil)'. *Note Message Headers:
-(message)Message Headers.
-
-** You can highlight different levels of citations like in the article
-buffer. See `gnus-message-highlight-citation'.
-
-** `auto-fill-mode' is enabled by default in Message mode. See
-`message-fill-column'. *Note Message Headers: (message)Various Message
-Variables.
-
-** You can now store signature files in a special directory named
-`message-signature-directory'.
-
-** The option `message-citation-line-format' controls the format of the
-"Whomever writes:" line. You need to set
-`message-citation-line-function' to
-`message-insert-formatted-citation-line' as well.
-
-
-* Changes in back ends
-
-** The nntp back end stores article marks in `~/News/marks'.
-
-The directory can be changed using the (customizable) variable
-`nntp-marks-directory', and marks can be disabled using the (back end)
-variable `nntp-marks-is-evil'. The advantage of this is that you can
-copy `~/News/marks' (using rsync, scp or whatever) to another Gnus
-installation, and it will realize what articles you have read and
-marked. The data in `~/News/marks' has priority over the same data in
-`~/.newsrc.eld'.
-
-** You can import and export your RSS subscriptions from OPML files. *Note
-RSS::.
-
-** IMAP identity (RFC 2971) is supported.
-
-By default, Gnus does not send any information about itself, but you can
-customize it using the variable `nnimap-id'.
-
-** The `nnrss' back end now supports multilingual text. Non-ASCII group
-names for the `nnrss' groups are also supported. *Note RSS::.
+** Gnus keeps track of non-existent articles for nnimap groups, so
+ that sparse IMAP folders now list a correct number of messages in
+ them.
-** Retrieving mail with POP3 is supported over SSL/TLS and with StartTLS.
+** Gnus will guess the real type of MIME parts of type
+ application/octet-stream based on the file suffix. So an
+ application/octet-stream with a name of "rms.jpg" will be displayed
+ as an image/jpeg type by default, for instance.
-** The nnml back end allows other compression programs beside `gzip' for
-compressed message files. *Note Mail Spool::.
-
-** The nnml back end supports group compaction.
-
-This feature, accessible via the functions `gnus-group-compact-group'
-(`G z' in the group buffer) and `gnus-server-compact-server' (`z' in the
-server buffer) renumbers all articles in a group, starting from 1 and
-removing gaps. As a consequence, you get a correct total article count
-(until messages are deleted again).
-
-
-
-* Appearance
-
-** The tool bar has been updated to use GNOME icons. You can also
-customize the tool bars: `M-x customize-apropos RET -tool-bar$' should
-get you started. (Only for Emacs, not in XEmacs.)
-
-** The tool bar icons are now (de)activated correctly in the group buffer,
-see the variable `gnus-group-update-tool-bar'. Its default value
-depends on your Emacs version.
-
-** You can change the location of XEmacs' toolbars in Gnus buffers. See
-`gnus-use-toolbar' and `message-use-toolbar'.
-
-
-
-* Miscellaneous changes
-
-** Having edited the select-method for the foreign server in the server
-buffer is immediately reflected to the subscription of the groups which
-use the server in question. For instance, if you change
-`nntp-via-address' into `bar.example.com' from `foo.example.com', Gnus
-will connect to the news host by way of the intermediate host
-`bar.example.com' from next time.
-
-** The `all.SCORE' file can be edited from the group buffer using `W e'.
-
-** You can set `gnus-mark-copied-or-moved-articles-as-expirable' to a
-non-`nil' value so that articles that have been read may be marked as
-expirable automatically when copying or moving them to a group that has
-auto-expire turned on. The default is `nil' and copying and moving of
-articles behave as before; i.e., the expirable marks will be unchanged
-except that the marks will be removed when copying or moving articles to
-a group that has not turned auto-expire on. *Note Expiring Mail::.
-
-
-
+** `nnimap-inbox' can now be a list of mail box names.
+
* For older news, see Gnus info node "New Features".
----------------------------------------------------------------------
diff --git a/etc/HELLO b/etc/HELLO
index d330bc8625c..d6857235f68 100644
--- a/etc/HELLO
+++ b/etc/HELLO
@@ -1,4 +1,6 @@
This is a list of ways to say hello in various languages.
+It is not intended to be comprehensive, but to demonstrate
+some of the character sets that Emacs supports.
Non-ASCII examples:
Europe: ,A!(BHola!, Gr,A|_(B Gott, Hyv,Add(B p,Ad(Biv,Add(B, Tere ,Au(Bhtust, Bon,Cu(Bu
@@ -46,7 +48,6 @@ Lao ((1>RJRERG(B) (1JP:R-4U(B / (1"mcKib*!4U(B
Malayalam ($,1@N@R@O@^@S@"(B) $,1@H@N@X@m@5@^@P@"(B
Maltese (il-Malti) Bon,Cu(Bu / Sa,C11(Ba
Mathematics $,1x (B p $,1x((B world $,1s"(B hello p $,2!a(B
-Nederlands, Vlaams Hallo / Dag
Norwegian (norsk) Hei / God dag
Oriya ($,1:s;\;?:f(B) $,1;6;A;#;?;,;G(B
Polish (j,Bj(Bzyk polski) Dzie,Bq(B dobry! / Cze,B6f(B!
@@ -55,7 +56,7 @@ Sinhala ($,1B#B2ABB$A}(B) $,1AFAzB4AvB=B AqB*(B
Slovak (sloven,Bh(Bina) Dobr,A}(B de,Br(B
Slovenian (sloven,B9h(Bina) Pozdravljeni!
Spanish (espa,Aq(Bol) ,A!(BHola!
-Swedish (p,Ae(B svenska) Hej / Goddag / Hall,Ae(B
+Swedish (svenska) Hej / Goddag / Hall,Ae(B
Tamil ($,1<D<N<_<T<m(B) $,1<U<C<5<m<5<N<m(B
Telugu ($,1=d>&=r>!=W>!(B) $,1=h=n=x>-=U=~=p=B(B
Thai (,T@RIRd7B(B) ,TJGQJ4U$CQ:(B / ,TJGQJ4U$hP(B
@@ -72,7 +73,7 @@ Korean ($(CGQ1[(B) $(C>H3gGO<<?d(B / $(C>H3gGO=J4O1n(B
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/etc/MACHINES b/etc/MACHINES
index 1e68376b94a..db610b90ee3 100644
--- a/etc/MACHINES
+++ b/etc/MACHINES
@@ -1,6 +1,6 @@
Emacs machines list
-Copyright (C) 1989-1990, 1992-1993, 1998, 2001-2011
+Copyright (C) 1989-1990, 1992-1993, 1998, 2001-2012
Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -10,19 +10,12 @@ Information about older releases, and platforms that are no longer
supported, has been removed. Consult older versions of this file if
you are interested in this information.
-The `configure' script uses the configuration name to decide which
-machine and operating system description files `src/config.h' should
-include. The machine description files are all in `src/m', and have
-names similar to, but not identical to, the machine names used in
-configuration names. The operating system files are all in `src/s',
-and are named similarly. See the `configure' script if you need to
-know which configuration names use which machine and operating system
-description files.
+The `configure' script uses the configuration name, and the results of
+testing the system, to decide which options to use in src/config.h and
+elsewhere (eg Makefiles).
If you add support for a new configuration, add a section to this
-file, and then edit the `configure' script to tell it which
-configuration name(s) should select your new machine description and
-system description files.
+file, and edit the `configure.ac' source as needed.
Some obsolete platforms are unsupported beginning with Emacs 23.1. See
the list at the end of this file.
diff --git a/etc/MAILINGLISTS b/etc/MAILINGLISTS
index 98f10511835..33e4ff03657 100644
--- a/etc/MAILINGLISTS
+++ b/etc/MAILINGLISTS
@@ -318,7 +318,7 @@ mode: outline
fill-column: 72
End:
-Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
Permission is hereby granted, free of charge, to any person obtaining
a copy of this file, to deal in the file without restriction, including
diff --git a/etc/MH-E-NEWS b/etc/MH-E-NEWS
index 8b96d08c17a..aca5781fe35 100644
--- a/etc/MH-E-NEWS
+++ b/etc/MH-E-NEWS
@@ -1,6 +1,6 @@
* COPYRIGHT
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
* Changes in MH-E 8.3.1
diff --git a/etc/MORE.STUFF b/etc/MORE.STUFF
index d876b6df504..7186047dfb6 100644
--- a/etc/MORE.STUFF
+++ b/etc/MORE.STUFF
@@ -1,99 +1,87 @@
More Neat Stuff for your Emacs
-Copyright (C) 1993, 1999, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1993, 1999, 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
-This file describes GNU Emacs programs and resources that are
-maintained by other people. Some of these may become part of the
-Emacs distribution in the future. Others we unfortunately can't
-distribute, even though they are free software, because we lack legal
-papers for copyright purposes. Also included are sites where
-development versions of some packages distributed with Emacs may be
-found.
+The easiest way to add more features to your Emacs is to use the command
+M-x list-packages. This contacts the server at <URL:http://elpa.gnu.org>,
+where many Emacs Lisp packages are stored. These are distributed
+separately from Emacs itself for reasons of space, etc. You can browse
+the resulting *Packages* buffer to see what is available, and then
+Emacs can automatically download and install the packages that you
+select. See the section "Emacs Lisp Packages" in the Emacs manual
+for more details.
-You might also look at the Emacs web page
-<URL:http://www.gnu.org/software/emacs/emacs.html>. If you use the
-Windows-32 version of Emacs, see the NTEmacs sites listed in the FAQ.
+Below we describe some GNU Emacs programs and resources that are
+maintained by other people. Some of these may become part of the
+Emacs distribution, or GNU ELPA, in the future. Others we unfortunately
+can't distribute, even though they are free software, because we lack
+legal papers for copyright purposes.
-Please submit a bug report if you find that any of the addresses
-listed here fail.
+Also listed are sites where development versions of some packages
+distributed with Emacs may be found.
-* The `Emacs Lisp List' at
- <URL:http://www.damtp.cam.ac.uk/user/eglen/emacs/ell.html> has pointers
- to sources of a large number of packages.
+It is difficult to keep this file up-to-date, and it only lists a fraction
+of the Emacs modes that are available. If you are interested in
+a particular feature, then after checking Emacs itself and GNU ELPA,
+a web search is often the best way to find results.
-* gnu.emacs.sources
+* The gnu-emacs-sources mailing list
+ <URL:https://lists.gnu.org/mailman/listinfo/gnu-emacs-sources>
+ which is gatewayed to the gnu.emacs.sources newsgroup (although the
+ connection between the two can be unreliable) is an official
+ place where people can post or announce their extensions to Emacs.
-Packages posted to the gnu.emacs.sources newsgroup (see
-etc/MAILINGLISTS) might be archived specifically (try a web search
-engine) or retrievable from general Usenet archive services.
+* The `Emacs Lisp List' at
+ <URL:http://www.damtp.cam.ac.uk/user/sje30/emacs/ell.html> has pointers
+ to sources of a large number of packages. Unfortunately, at the time
+ of writing it seems to no longer be updating.
* emacswiki.org
+ The Emacs Wiki has an area for storing elisp files
+ <URL:http://www.emacswiki.org/cgi-bin/wiki/ElispArea>.
-The Emacs Wiki has an area for storing elisp files
-<URL:http://www.emacswiki.org/cgi-bin/wiki/ElispArea>.
-
-* Emacs tutorials and manuals
+* WikEmacs
+ <URL:http://wikemacs.org> is an alternative wiki for Emacs.
- * Emacs slides and tutorials can be found here:
+* Emacs slides and tutorials can be found here:
<URL:http://web.psung.name/emacs/>
* Maintenance versions of some packages distributed with Emacs
You might find bug-fixes or enhancements in these places.
+In many cases, however, development of these packages has shifted to Emacs,
+so you will find the latest version in Emacs.
* Ada-mode: <URL:http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html>
* Battery and Info Look: <URL:http://ralph-schleicher.de/emacs.html>
- * BS: <URL:http://www.geekware.de/software/emacs/index.html>
-
- * Calculator: <URL:http://www.barzilay.org/misc/calculator.el>
-
* CC mode: <URL:http://cc-mode.sourceforge.net/>
* CPerl: <URL:http://math.berkeley.edu/~ilya/software/emacs/>
* Ediff and Viper: <URL:http://www.cs.sunysb.edu/~kifer/emacs.html>
- * Eldoc and Rlogin:
- <URL:http://www.splode.com/~friedman/software/emacs-lisp/>
-
* ERC: <URL:http://savannah.gnu.org/projects/erc/>
- * Etags: <URL:http://fly.isti.cnr.it/software/>
-
* Gnus: <URL:http://www.gnus.org/>
- * Ispell: <URL:http://www.kdstevens.com/stevens/ispell-page.html>
-
* MH-E: <URL:http://mh-e.sourceforge.net/>
* nXML: <URL:http://www.thaiopensource.com/nxml-mode/>
* Org mode: <URL:http://orgmode.org/>
- * PS mode: <URL:http://odur.let.rug.nl/%7Ekleiweg/postscript/>
-
- * PS-print: <URL:http://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage>
-
- * Python: <URL:http://www.loveshack.ukfsn.org/emacs/>
-
- * QuickURL: <URL:http://www.davep.org/emacs/>
-
* RefTeX: <URL:http://www.gnu.org/software/auctex/reftex.html>
* Remember: <URL:https://gna.org/p/remember-el>
- * Speedbar, Checkdoc etc: <URL:http://cedet.sourceforge.net/>
-
- * SQL: <URL:http://www.emacswiki.org/cgi-bin/wiki/sql.el>
+ * CEDET: <URL:http://cedet.sourceforge.net/>
* Tramp: Remote file access via rsh/ssh
<URL:http://savannah.gnu.org/projects/tramp/>
- * Webjump: <URL:http://www.neilvandyke.org/webjump>
-
* Auxiliary files
* (Tex)info files for use with Info-look that don't come from GNU
@@ -114,18 +102,16 @@ Emacs for various reasons, sometimes because their authors haven't made
a copyright assignment to the FSF. Some of them may be integrated in
the future.
-You might like to check whether they are packaged for your system.
-Several are for Debian GNU/Linux in particular.
+Your operating system distribution may include several of these as optional
+packages that you can install.
* AUCTeX: <URL:http://www.gnu.org/software/auctex/>
An extensible package that supports writing and formatting TeX
files (including AMS-TeX, LaTeX, Texinfo, ConTeXt, and docTeX).
+ Available from GNU ELPA.
* BBDB: personal Info Rolodex integrated with mail/news:
- <URL:http://bbdb.sourceforge.net/>
- [You might want to set the coding system of your .bbdb file to
- emacs-mule, say by adding `("\\.bbdb\\'" . emacs-mule)' to
- `file-coding-system-alist' for non-ASCII characters.]
+ <URL:http://savannah.nongnu.org/projects/bbdb>
* Boxquote: <URL:http://www.davep.org/emacs/>
@@ -143,13 +129,6 @@ Several are for Debian GNU/Linux in particular.
* Ee: categorizing information manager:
<URL:http://www.jurta.org/en/emacs/ee/>
- * EFS: enhanced version of ange-ftp:
- <URL:http://www-pu.informatik.uni-tuebingen.de/users/sperber/software/efs/>
-
- * Elib library: <URL:http://www.gnu.org/software/elib/elib.html>
- From GNU distribution mirrors. (Much of this functionality is now
- in Emacs.)
-
* EMacro: <URL:http://emacro.sourceforge.net/>
EMacro is a portable configuration file that configures itself.
@@ -168,33 +147,19 @@ Several are for Debian GNU/Linux in particular.
* Emacs Wiki Mode: <URL:http://mwolson.org/projects/EmacsWikiMode.html>
A wiki-like publishing tool and personal information manager
- * Gnuserv:
- <URL:http://www.hpl.hp.com/personal/ange/gnuserv/home.html>
- Alternative emacsclient/emacsserver. Also available from this Web
- page: eiffel-mode.el.
-
* Go in a buffer: Go Text Protocol client:
<URL:http://www.gnuvola.org/software/personal-elisp/dist/lisp/diversions/gnugo.el>
A modified version is also bundled with GNU Go:
<URL:http://www.gnu.org/software/gnugo/gnugo.html>
- * hm--html-menus:
- <URL:ftp://sunsite.unc.edu/pub/Linux/apps/editors/emacs/>
- HTML-specific editing. Can work with PSGML.
-
* Hyperbole:
- <URL:http://directory.fsf.org/hyperbole.html>
+ <URL:http://directory.fsf.org/wiki/Hyperbole>
Hyperbole is an open, efficient, programmable information
management and hypertext system.
* JDEE: <URL:http://jdee.sourceforge.net/>
Provides a Java development environment for Emacs.
- * Mailcrypt:
- <URL:http://mailcrypt.sourceforge.net/>
- PGP and GPG support. PGP isn't free software, but GPG, the GNU
- Privacy Guard, is a free replacement <URL:http://www.gnupg.org/>.
-
* Mew: <URL:http://www.mew.org/>
A MIME mail reader for Emacs/XEmacs.
@@ -208,9 +173,6 @@ Several are for Debian GNU/Linux in particular.
* Preview LaTeX: embed preview LaTeX images in source buffer.
<URL:http://www.gnu.org/software/auctex/preview-latex.html>
- * PSGML: <URL:http://www.lysator.liu.se/projects/about_psgml.html>
- DTD-aware serious SGML/XML editing.
-
* Quack: <URL:http://www.neilvandyke.org/quack/>
Quack enhances Emacs support for Scheme.
@@ -227,26 +189,17 @@ Several are for Debian GNU/Linux in particular.
* Tamago: Chinese/Japanese/Korean input method
<URL:http://www.m17n.org/tamago/index.en.html>
Emacs Lisp package to provide input methods for CJK characters.
- It can use these background conversion servers:
- FreeWnn (jserver, cserver, tserver),
- Wnn6,
- SJ3 Ver.2
- * Tiny Tools: <URL:http://freshmeat.net/projects/emacs-tiny-tools>
+ * Tiny Tools: <URL:https://savannah.nongnu.org/projects/emacs-tiny-tools>
* VM (View Mail): Alternative mail reader
<URL:http://launchpad.net/vm>
Previously hosted at: <URL:http://www.nongnu.org/viewmail/>
- There are VM newsgroups: <URL:news:gnu.emacs.vm.info>, and
- <URL:news:gnu.emacs.vm.bug>.
- * W3: <URL:http://savannah.gnu.org/projects/w3/>
- Web browser. There's a W3 mail list/newsgroup
- <URL:http://savannah.gnu.org/mail/?group=w3>.
+ * W3 Web browser: <URL:http://savannah.gnu.org/projects/w3/>
* Wanderlust: <URL:http://www.gohome.org/wl/>
- Yet Another Message Interface on Emacsen. Wanderlust is a mail/news
- reader supporting IMAP4rev1 for emacsen.
+ Wanderlust is a mail/news reader for Emacs.
* WhizzyTex: <URL:http://cristal.inria.fr/whizzytex/>
WhizzyTeX provides a minor mode for Emacs or XEmacs, a (bash)
@@ -257,8 +210,8 @@ Several are for Debian GNU/Linux in particular.
Local Variables:
mode: text
-mode: view
-mode: goto-address
+eval: (view-mode 1)
+eval: (goto-address-mode 1)
End:
This file is part of GNU Emacs.
diff --git a/etc/NEWS b/etc/NEWS
index f37f562ec82..6c01d2ef607 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes.
-Copyright (C) 2010-2011 Free Software Foundation, Inc.
+Copyright (C) 2010-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
@@ -14,352 +14,1363 @@ and NEWS.1-17 for changes in older Emacs versions.
You can narrow news to a specific version by calling `view-emacs-news'
with a prefix argument or by typing C-u C-h C-n.
-
Temporary note:
- +++ indicates that the appropriate manual has already been updated.
- --- means no change in the manuals is called for.
++++ indicates that the appropriate manual has already been updated.
+--- means no change in the manuals is called for.
When you add a new item, please add it without either +++ or ---
so we will look at it and add it to the manual.
-* Installation Changes in Emacs 24.1
+* Installation Changes in Emacs 24.4
+* Startup Changes in Emacs 24.4
+* Changes in Emacs 24.4
+* Editing Changes in Emacs 24.4
+
+
+* Changes in Specialized Modes and Packages in Emacs 24.4
+
+** Calc
+
+*** Calc by default now uses the Gregorian calendar for all dates, and
+uses January 1, 1 AD as its day number 1. Previously Calc used the
+Julian calendar for dates before September 14, 1752, and it used
+December 31, 1 BC as its day number 1; the new scheme is more
+consistent with Calendar's calendrical system and day numbering.
+
+*** The new variable `calc-gregorian-switch' lets you configure the
+date when Calc switches from the Julian to the Gregorian calendar.
+Nil, the default value, means to always use the Gregorian calendar.
+The value (YEAR MONTH DAY) means to start using the Gregorian calendar
+on the given date.
+
++++
+** New function `ses-rename-cell' to give SES cells arbitrary names.
+
+** trace-function was largely rewritten.
+New features include:
+- no prompting for the destination buffer, unless a prefix-arg was used.
+- additionally to prompting for a destination buffer, when a prefix-arg is
+ used, the user can enter a "context", i.e. Lisp expression whose value at the
+ time the function is entered/exited will be printed along with the function
+ name and arguments. Useful to trace the value of (current-buffer) or
+ (point) when the function is invoked.
+
+** Woman
+
+*** The commands `woman-default-faces' and `woman-monochrome-faces'
+are obsolete. Customize the `woman-* faces instead.
+
+
+* New Modes and Packages in Emacs 24.4
+** New nadvice.el package offering lighter-weight advice facilities.
+It is layered as:
+- add-function/remove-function which can be used to add/remove code on any
+ function-carrying place, such as process-filters or `<foo>-function' hooks.
+- advice-add/advice-remove to add/remove a piece of advice on a named function,
+ much like `defadvice' does.
+
+* Incompatible Lisp Changes in Emacs 24.4
+
+** nil and "unbound" are indistinguishable in symbol-function.
+`symbol-function' never signals `void-function' any more.
+`fboundp' returns non-nil if the symbol was `fset' to nil.
+
+** `defadvice' does not honor the `freeze' flag and cannot advise
+special-forms any more.
+
+** `dolist' in lexical-binding mode does not bind VAR in RESULT any more.
+VAR was bound to nil which was not tremendously useful and just lead to
+spurious warnings about an unused var.
+
+* Lisp changes in Emacs 24.4
+
+** time-to-seconds is not obsolete any more.
+** New function special-form-p.
+** Docstrings can be made dynamic by adding a `dynamic-docstring-function'
+text-property on the first char.
+
+** The `defalias-fset-function' property lets you catch calls to defalias
+and redirect them to your own function instead of `fset'.
+
+* Changes in Emacs 24.4 on non-free operating systems
+
++++
+** The "generate a backtrace on fatal error" feature now works on MS Windows.
+The backtrace is written to the 'emacs_backtrace.txt' file in the
+directory where Emacs was running.
+
+
+* Installation Changes in Emacs 24.3
-** Configure links against libselinux if it is found.
-You can disable this by using --without-selinux.
+---
+** The default toolkit has been changed to Gtk+ version 3.
+If you don't pass --with-x-toolkit to configure or if you pass
+--with-x-toolkit=gtk or --with-x-toolkit=yes, configure will try to build
+with Gtk+ version 3, and if that fails, try Gtk+ version 2.
+You can explicitly require a specific version by passing
+--with-x-toolkit=gtk2 or --with-x-toolkit=gtk3 to configure.
---
-** By default, the installed Info and man pages are compressed.
-You can disable this by configuring --without-compress-info.
+** New configure option '--without-all' to disable additional features.
+This disables most of the features that are normally enabled by default.
---
-** There are new configure options:
---with-mmdf, --with-mail-unlink, --with-mailhost.
-These provide no new functionality, they just remove the need to edit
-lib-src/Makefile by hand in order to use the associated features.
+** New configure option '--enable-link-time-optimization' to utilize
+an appropriate feature provided by GCC since version 4.5.0.
---
-** Emacs can be compiled against Gtk+ 3.0 if you pass --with-x-toolkit=gtk3
-to configure. Note that other libraries used by Emacs, RSVG and GConf,
-also depend on Gtk+. You can disable them with --without-rsvg and
---without-gconf.
+** New configure option '--enable-gcc-warnings', intended for developers.
+If building with GCC, this enables compile-time checks that warn about
+possibly-questionable C code. On a recent GNU system there should be
+no warnings; on older and on non-GNU systems the generated warnings
+may be useful.
---
-** There is a new configure option --enable-use-lisp-union-type.
-This is only useful for Emacs developers to debug certain types of bugs.
-This is not a new feature; only the configure flag is new.
+** The configure option '--enable-use-lisp-union-type' has been
+renamed to '--enable-check-lisp-object-type', as the resulting
+Lisp_Object type no longer uses a union to implement the compile time
+check that this option enables.
---
-** There is a new configure option --with-wide-int.
-With it, Emacs integers typically have 62 bits, even on 32-bit machines.
-On 32-bit hosts, this raises the limit on buffer sizes from about 512 MiB
-to about 2 GiB.
+** The configure option '--disable-maintainer-mode' has been removed,
+as it was confusingly-named and rarely useful.
---
-** New translation of the Emacs Tutorial in Hebrew is available.
-Type `C-u C-h t' to choose it in case your language setup doesn't
-automatically select it.
+** You can use `NO_BIN_LINK=t make install' to prevent the installation
+overwriting "emacs" in the installation bin/ directory with a link
+to emacs-VERSION.
-** Emacs can be compiled with ImageMagick support.
-Emacs links to ImageMagick if version 6.2.8 or newer of the library is
-present at build time. To inhibit ImageMagick, use the configure
-option `--without-imagemagick' .
+---
+** The configure options `--program-prefix', `--program-suffix', and
+`--program-transform-name' apply to more than just the installed
+binaries. Now they also affect the man pages, icons, and the
+etc/emacs.desktop file; but not the info pages, since this would break
+links between the various manuals.
---
-** The standalone programs digest-doc and sorted-doc are removed.
-Emacs now uses Lisp commands `doc-file-to-man' and `doc-file-to-info'.
+** Emacs uses libtinfo in preference to libncurses, if available.
---
-** The standalone program `fakemail' is removed.
-If you need it, feedmail.el provides a superset of the functionality.
+** On FreeBSD and NetBSD, configure no longer adds /usr/local/lib and
+/usr/pkg/lib to the linker search path. You must add them yourself if
+you want them.
+
+---
+** The standalone scripts rcs-checkin and vcdiff have been removed
+(from the bin and libexec directories, respectively). The former is
+no longer relevant, the latter is replaced by lisp (in vc-sccs.el).
-* Startup Changes in Emacs 24.1
+* Startup Changes in Emacs 24.3
+
++++
+** Emacs no longer searches for `leim-list.el' files beneath the standard
+lisp/ directory. There should not be any there anyway. If you have
+been adding them there, put them somewhere else, eg site-lisp.
---
-** The --unibyte, --multibyte, --no-multibyte, and --no-unibyte
-command line arguments, and the EMACS_UNIBYTE environment variable, no
-longer have any effect. (They were declared obsolete in Emacs 23.)
+** The `--no-site-lisp' command line option now works for Nextstep builds.
+
+
+* Changes in Emacs 24.3
+++
-** New command line option `--no-site-lisp' removes site-lisp directories
-from load-path. -Q now implies this.
+** Most y-or-n prompts now allow you to scroll the selected window.
+Typing C-v or M-v at a y-or-n prompt scrolls forward or backward
+respectively, without exiting from the prompt.
+** Mode line changes
---
-** On Windows, Emacs now warns when the obsolete _emacs init file is used,
-and also when HOME is set to C:\ by default.
+*** New option `mode-line-default-help-echo' specifies the help text
+(shown in a tooltip or in the echo area) for any part of the mode line
+that does not have its own specialized help text.
++++
+*** You can now click mouse-3 in the coding system indicator to invoke
+`set-buffer-file-coding-system'.
+
+** Help changes
+
++++
+*** `C-h f' (describe-function) can now perform autoloading.
+When this command is called for an autoloaded function whose docstring
+contains a key substitution construct, that function's library is
+automatically loaded, so that the documentation can be shown
+correctly. To disable this, set `help-enable-auto-load' to nil.
+
+---
+*** `C-h f' now reports previously-autoloaded functions as "autoloaded",
+even after their associated libraries have been loaded (and the
+autoloads have been redefined as functions).
+
+** Minibuffer changes
+---
+*** In minibuffer filename prompts, `C-M-f' and `C-M-b' now move to the
+next and previous path separator, respectively.
++++
+*** minibuffer-electric-default-mode can rewrite (default ...) to [...].
+Just set minibuffer-eldef-shorten-default to t before enabling the mode.
+
++++
+** ImageMagick support, if available, is automatically enabled.
+It is no longer necessary to call `imagemagick-register-types'
+explicitly to install ImageMagick image types; that function is called
+automatically at startup, or when customizing an imagemagick- option.
++++
+*** Setting `imagemagick-types-inhibit' to t now disables the use of
+ImageMagick to view images. You must call imagemagick-register-types
+afterwards if you do not use customize to change this.
++++
+*** The new variable `imagemagick-enabled-types' also affects which
+ImageMagick types are treated as images. The function
+`imagemagick-filter-types' returns the list of types that will be
+treated as images.
+---
+*** Images displayed via ImageMagick now support transparency and the
+:background image spec property.
+
+** Server and client changes
++++
+*** emacsclient now obeys string values for `initial-buffer-choice',
+if it is told to open a new frame without specifying any file to visit
+or expression to evaluate.
+---
+*** New option `server-auth-key' specifies a shared server key.
+
++++
+** In the Package Menu, newly-available packages are listed as "new",
+and sorted above the other "available" packages by default.
+
++++
+** `C-x C-q' is now bound to the new minor mode `read-only-mode'.
+This minor mode replaces `toggle-read-only', which is now obsolete.
+
++++
+** Emacs now generates backtraces on fatal errors.
+On encountering a fatal error, Emacs now outputs a textual description
+of the fatal signal, and a short backtrace on platforms like glibc
+that support backtraces.
+
+---
+** If your Emacs was built from a bzr checkout, the new variable
+`emacs-bzr-version' contains information about the bzr revision used.
+
++++
+** New variable `create-lockfiles' specifies usage of lockfiles.
+It defaults to t. Changing it to nil inhibits the creation of lock
+files (use this with caution).
+
++++
+** Using "unibyte: t" in Lisp source files is obsolete.
+Use "coding: raw-text" instead.
+
++++
+** Setting `enable-remote-dir-locals' to non-nil allows directory
+local variables on remote hosts.
+
+---
+** The entry for PCL-CVS has been removed from the Tools menu.
+The PCL-CVS commands are still available via the keyboard.
+
+** Internationalization changes
+---
+*** New language environment: Persian.
+---
+*** New input method `vietnamese-vni'.
+
+** Nextstep (GNUstep / Mac OS X) port changes
+---
+*** Fullscreen and frame parameter fullscreen is supported.
+---
+*** A file dialog is used for open/save operations initiated from the
+menu/toolbar.
-* Changes in Emacs 24.1
+* Editing Changes in Emacs 24.3
+** Navigation command changes
+++
-** auto-mode-case-fold is now enabled by default.
+*** New binding `M-g c' for `goto-char'.
++++
+*** New binding `M-g TAB' for `move-to-column'.
++++
+*** `M-g TAB' (`move-to-column') prompts for a column number if called
+interactively with no prefix arg. Previously, it moved to column 1.
-** Completion
+** Search and Replace changes
++++
+*** Non-regexp Isearch now performs "lax" space matching.
+Each sequence of spaces in the supplied search string may match any
+sequence of one or more whitespace characters, as specified by the
+variable `search-whitespace-regexp'. (This variable is also used by a
+similar existing feature for regexp Isearch).
++++
+*** New Isearch command `M-s SPC' toggles lax space matching.
+This applies to both ordinary and regexp Isearch.
++++
+*** New option `replace-lax-whitespace'.
+If non-nil, `query-replace' uses flexible whitespace matching too.
+The default is nil.
++++
+*** Global `M-s _' starts a symbol (identifier) incremental search,
+and `M-s _' in Isearch toggles symbol search mode.
+`M-s c' in Isearch toggles search case-sensitivity.
-*** shell-mode uses pcomplete rules, with the standard completion UI.
+++
-*** Many packages have been changed to use `completion-at-point'
-rather than their own completion code.
+** `C-x 8 RET' is now bound to `insert-char', which is now a command.
+`ucs-insert' is now an obsolete alias for `insert-char'.
+
+---
+** The `z' key no longer has a binding in most special modes.
+It used to be bound to `kill-this-buffer', but `z' is too easy to
+accidentally type.
+
+++
-*** `completion-at-point' now handles tags and semantic completion.
+** New option `delete-trailing-lines' specifies whether
+M-x delete-trailing-whitespace should delete trailing lines at the end
+of the buffer. It defaults to t.
+
+** Register changes
++++
+*** `C-x r +' is now overloaded to invoke `append-to-register.
++++
+*** New option `register-separator' specifies the register containing
+the text to put between collected texts for use with M-x
+append-to-register and M-x prepend-to-register.
+
++++
+** `C-u M-=' now counts lines/words/characters in the entire buffer.
+
++++
+** New command `C-x r M-w' (copy-rectangle-as-kill).
+It copies the region-rectangle as the last rectangle kill.
+
++++
+** New option `yank-handled-properties' allows processing of text
+properties on yanked text, in more ways that are more general than
+just removing them, as done by `yank-excluded-properties'.
+
+
+* Changes in Specialized Modes and Packages in Emacs 24.3
+
+** Apropos
---
-*** Completion in a non-minibuffer now tries to detect the end of completion
-and pops down the *Completions* buffer accordingly.
+*** The faces used by Apropos are now directly customizable.
+These faces are named `apropos-symbol', `apropos-keybinding', and so on;
+see the `apropos' Custom group for details.
+---
+*** The old options whose values specified faces to use were removed
+(i.e. `apropos-symbol-face', `apropos-keybinding-face', etc.).
+
+** Buffer Menu
+This package has been rewritten to use Tabulated List mode.
+---
+*** Option `Buffer-menu-buffer+size-width' is now obsolete.
+Use `Buffer-menu-name-width' and `Buffer-menu-size-width' instead.
+
+** Calendar
+
+++
-*** Completion can cycle, depending on completion-cycle-threshold.
+*** You can customize the header text that appears above each calendar month.
+See the variable `calendar-month-header'.
+
+++
-*** New completion style `substring'.
+*** New LaTeX calendar style, produced by `cal-tex-cursor-week2-summary'.
+
+++
-*** Completion style can be set per-category `completion-category-overrides'.
+*** The calendars produced by cal-html include holidays.
+Customize `cal-html-holidays' to change this.
+
+** CL
+
+++
-*** Completion of buffers now uses substring completion by default.
+*** CL's main entry is now (require 'cl-lib).
+`cl-lib' is like the old `cl' except that it uses the namespace cleanly,
+i.e. all its definitions have the "cl-" prefix (and internal definitions use
+the "cl--" prefix).
-** Mail changes
+If `cl' provided a feature under the name `foo', then `cl-lib' provides it
+under the name `cl-foo' instead, with the exceptions of the few definitions
+that had to use `foo*' to avoid conflicts with pre-existing Elisp entities,
+which have not been renamed to `cl-foo*' but just `cl-foo'.
-The default of `send-mail-function' is now `sendmail-query-once',
-which asks the user (once) whether to use the smtpmail package to send
-email, or to use the old defaults that rely on external mail
-facilities (`sendmail-send-it' on GNU/Linux and other Unix-like
-systems, and `mailclient-send-it' on Windows).
+The old `cl' is now deprecated and is mainly just a bunch of aliases that
+provide the old non-prefixed names. Some exceptions are listed below.
-*** smtpmail changes
++++
+*** `cl-flet' is not like `flet' (which is deprecated).
+Instead it obeys the behavior of Common-Lisp's `flet'.
+In particular, in cl-flet function definitions are lexically scoped,
+whereas in flet the scoping is dynamic.
-**** smtpmail now uses encrypted connections (via STARTTLS) if the
-mail server supports them. It also uses the auth-source framework for
-getting credentials.
++++
+*** `cl-labels' is slightly different from `labels'.
+The difference is that it relies on the `lexical-binding' machinery (as opposed
+to the `lexical-let' machinery used previously) to capture definitions in
+closures, so such closures will only work if `lexical-binding' is in use.
-**** The variable `smtpmail-auth-credentials' has been removed.
-That variable used to have the default value "~/.authinfo", in which
-case you won't see any difference. But if you changed it to be a list
-of user names and passwords, that setting is now ignored; you will be
-prompted for the user name and the password, which will then be saved
-to ~/.authinfo. (To control where and how the credentials are stored,
-see the auth-source manual. You may want to change the auth-source
-preferences if you want to store the credentials encrypted, for
-instance.)
++++
+*** `cl-letf' is not exactly like `letf'.
+The only difference is in details that relate to some deprecated usage
+of `symbol-function' in place forms.
-You can also manually copy the credentials to your ~/.authinfo file.
-For example, if you had
++++
+*** `progv' was rewritten to use the `let' machinery.
+A side effect is that vars without corresponding value are bound to nil
+rather than making them unbound.
- (setq smtpmail-auth-credentials
- '(("mail.example.org" 25 "jim" "s!cret")))
++++
+*** The following methods of extending `setf' are obsolete
+(use features from gv.el instead):
+`define-modify-macro' (use `gv-letplace')
+`defsetf' (use `gv-define-simple-setter' or `gv-define-setter')
+`define-setf-expander' (use `gv-define-setter' or `gv-define-expander')
+`get-setf-method' no longer exists (see "Incompatible Lisp Changes")
-then the equivalent line in ~/.authinfo would be
++++
+** New compilation option `compilation-always-kill'.
- machine mail.example.org port 25 login jim password s!cret
+** Customize
+---
+*** `custom-reset-button-menu' now defaults to t.
+---
+*** Non-option variables are never matched in `customize-apropos' and
+`customize-apropos-options' (i.e. the prefix argument does nothing for
+these commands now).
-**** The variable `smtpmail-starttls-credentials' has been removed.
+---
+** `desktop-path' no longer includes the "." directory.
+Desktop files are now located in ~/.emacs.d by default.
-If you had that set, then you need to put
+** D-Bus
- machine smtp.whatever.foo port 25 key "~/.my_smtp_tls.key" cert "~/.my_smtp_tls.cert"
++++
+*** New variables `dbus-compiled-version' and `dbus-runtime-version'.
-in your ~/.authinfo file instead.
++++
+*** The D-Bus object manager interface is implemented.
+
++++
+*** Variables of type :(u)int32 and :(u)int64 accept floating points,
+if their value does not fit into Emacs's integer range.
+
++++
+*** The function `dbus-call-method' works non-blocking now, it can be
+interrupted by C-g. `dbus-call-method-non-blocking' is obsolete.
+
++++
+*** Signals can be sent also as unicast message.
+
++++
+*** The argument list of `dbus-register-signal' has been extended,
+according to the new match rule types of D-Bus. See the manual for
+details.
-*** sendmail changes
+++
-You can now add MIME attachments to outgoing messages with the new
-command `mail-add-attachment'.
+*** `dbus-init-bus' supports private connections.
+
++++
+*** There is a new function `dbus-setenv'.
+
+** Diff mode
---
-The command `mail-attach-file' was renamed to `mail-insert-file'; the
-old name is now an obsolete alias to the new name.
+*** Changes are now highlighted using the same color scheme as in
+modern VCSes. Deletions are displayed in red (new faces
+`diff-refine-removed' and `smerge-refined-removed', and new definition
+of `diff-removed'), insertions in green (new faces `diff-refine-added'
+and `smerge-refined-added', and new definition of `diff-added').
+
+---
+*** The variable `diff-use-changed-face' defines whether to use the
+face `diff-changed', or `diff-removed' and `diff-added' to highlight
+changes in context diffs.
-** Emacs server and client changes
+++
-*** New option `server-port' specifies the port on which the Emacs
-server should listen.
+*** The new command `diff-delete-trailing-whitespace' removes trailing
+whitespace introduced by a diff.
+
+** Dired
+++
-*** New emacsclient argument -q/--quiet suppresses some status messages.
+*** `dired-do-async-shell-command' executes each file sequentially
+if the command ends in `;' (when operating on multiple files).
+Otherwise, it executes the command on each file in parallel.
+---
+*** Typing M-n in the minibuffer of `dired-do-chmod', `dired-do-chgrp',
+`dired-do-chown', `dired-do-touch' pulls the file attributes of the
+file at point.
+++
-*** New emacsclient argument --frame-parameters can be used to set the
-frame parameters of a newly-created graphical frame.
+*** When the region is active, `m' (`dired-mark'), `u' (`dired-unmark'),
+`DEL' (`dired-unmark-backward'), `d' (`dired-flag-file-deletion')
+mark/unmark/flag all files in the active region.
+++
-*** If emacsclient shuts down as a result of Emacs signaling an
-error, its exit status is 1.
+*** The minibuffer default for `=' (`dired-diff) has changed.
+It is now the backup file for the file at point, if one exists.
+In Transient Mark mode the default is the file at the active mark.
+++
-*** New emacsclient argument --parent-id ID.
-This opens a client frame in parent X window ID, via XEmbed, similar
-to the --parent-id argument to Emacs.
+*** `M-=' is no longer bound to `dired-backup-diff' in Dired buffers.
+The global binding for `M-=', `count-words-region' is in effect.
-** Internationalization changes
+---
+** Ediff now uses the same color scheme as Diff mode.
+
+** ERC
+++
-*** Emacs now supports display and editing of bidirectional text.
+*** New module "notifications", which can send a notification when you
+receive a private message or your nickname is mentioned.
-Text that includes characters from right-to-left (RTL) scripts, such
-as Arabic, Farsi, or Hebrew, is displayed in the correct visual order
-as expected by users of those scripts. This display reordering is a
-"Full bidirectionality" class implementation of the Unicode
-Bidirectional Algorithm. Buffers with no RTL text should look exactly
-the same as before.
++++
+*** ERC will look up server/channel names via auth-source and use any
+channel keys found.
-For more information, see the node "Bidirectional Editing" in the
-Emacs Manual.
++++
+*** New option `erc-lurker-hide-list', similar to `erc-hide-list', but
+only applies to messages sent by lurkers.
+++
-**** New buffer-local variable `bidi-display-reordering'.
-To disable display reordering in any given buffer, change this to nil.
+** Flymake uses fringe bitmaps to indicate errors and warnings.
+See `flymake-fringe-indicator-position', `flymake-error-bitmap' and
+`flymake-warning-bitmap'.
+
+---
+** Follow mode no longer works by using advice.
+The option `follow-intercept-processes' has been removed.
+
+---
+** The FFAP option `ffap-url-unwrap-remote' can now be a list of strings,
+specifying URL types that should be converted to remote file names at
+the FFAP prompt. The default is now '("ftp").
+
+---
+** New Ibuffer `derived-mode' filter, bound to `/ M'.
+The old binding for `/ M' (filter by used-mode) is now bound to `/ m'.
+
+---
+** `javascript-generic-mode' is now an obsolete alias for `js-mode'.
+++
-**** New buffer-local variable `bidi-paragraph-direction'.
-If nil (the default), Emacs determines the base direction of each
-paragraph from its text, as specified by the Unicode Bidirectional
-Algorithm.
+** New option `mouse-avoidance-banish-position' specifies where the
+`banish' mouse avoidance setting moves the mouse.
+
++++
+** notifications.el supports now version 1.2 of the Notifications API.
+The function `notifications-get-capabilities' returns the supported
+server properties.
+
+---
+** In Perl mode, new option `perl-indent-parens-as-block' causes non-block
+closing brackets to be aligned with the line of the opening bracket.
-Setting this to `right-to-left' or `left-to-right' forces a particular
-base direction on each paragraph in the buffer.
+---
+** In Proced mode, new command `proced-renice' renices marked processes.
-Paragraphs whose base direction is right-to-left are displayed
-starting at the right margin of the window.
+---
+** Python mode
+
+A new version of python.el, which provides several new features, including:
+per-buffer shells, better indentation, Python 3 support, and improved
+shell-interaction compatible with iPython (and virtually any other
+text based shell).
+
+*** Some user options have been replaced/renamed:
+Old defcustom: | New defcustom:
+python-indent | python-indent-offset
+python-guess-indent | python-indent-guess-indent-offset
+python-pdbtrack-do-tracking-p | python-pdbtrack-activate
+python-use-skeletons | python-skeleton-autoinsert
+
+*** Some user options have been removed:
+
+**** `python-indent-string-contents': Strings are never indented.
+
+**** `python-honour-comment-indentation':
+Comments are never considered as indentation markers themselves.
+
+**** `python-continuation-offset': Indentation is automatically
+calculated in a pep8 compliant way depending on the context.
+
+**** `python-shell-prompt-alist', `python-shell-continuation-prompt-alist':
+Have no direct mapping as the shell interaction is completely different.
+
+**** `python-python-command', `python-jython-command':
+Replaced by `python-shell-interpreter'.
+
+**** `inferior-python-filter-regexp', `python-remove-cwd-from-path',
+`python-pdbtrack-minor-mode-string', `python-source-modes':
+No longer relevant.
+
+*** Some commands have been replaced:
+Old command | New command
+python-insert-class | python-skeleton-class
+python-insert-def | python-skeleton-def
+python-insert-for | python-skeleton-for
+python-insert-if | python-skeleton-if
+python-insert-try/except | python-skeleton-try
+python-insert-try/finally | python-skeleton-try
+python-insert-while | python-skeleton-while
+python-find-function | python-nav-jump-to-defun
+python-next-statement | python-nav-forward-sentence
+python-previous-statement | python-nav-backward-sentence
+python-beginning-of-defun-function | python-nav-beginning-of-defun
+python-end-of-defun-function | python-nav-end-of-defun
+python-send-buffer | python-shell-send-buffer
+python-send-defun | python-shell-send-defun
+python-send-region | python-shell-send-region
+python-send-region-and-go | Emulate with python-shell-send-region and
+ python-shell-switch-to-shell
+python-send-string | python-shell-send-string
+python-switch-to-python | python-shell-switch-to-shell
+python-describe-symbol | python-eldoc-at-point
+
+---
+** reStructuredText mode
+
+*** Keybindings (see `C-c C-h'), TAB indentation, filling and auto-filling,
+fontification, comment handling, and customization have all been revised
+and improved.
+
+*** Support for `imenu' and `which-function-mode'.
+
+*** The reStructuredText syntax is more closely covered.
+Sphinx support has been improved.
+
+*** `rst-insert-list' inserts new list or continues existing lists.
+
+*** A negative prefix argument always works for `rst-adjust'.
+
+*** The window configuration is reset after displaying a TOC.
+
+*** The constant `rst-version' describes the rst.el package version.
+
+---
+** Shell Script mode
+
+*** Pairing of parens/quotes uses electric-pair-mode instead of skeleton-pair.
+
+*** `sh-electric-here-document-mode' now controls auto-insertion of here-docs.
+
+*** `sh-use-smie' lets you choose a new indentation and navigation code.
+++
-*** Enhanced support for characters with no glyphs in available fonts.
-If a character has no glyphs in any of the available fonts, Emacs
-normally displays it either as a hexadecimal code in a box or as a
-thin 1-pixel space. In addition to these two methods, Emacs can
-display these characters as empty box, as an acronym, or not display
-them at all. To change how these characters are displayed, customize
-the variable `glyphless-char-display-control'.
+** New option `async-shell-command-buffer' specifies the buffer to use
+for a new asynchronous `shell-command' when the default output buffer
+`*Async Shell Command*' is already in use.
-On character terminals, these methods are used for characters that
-cannot be encoded by the `terminal-coding-system'.
+---
+** SQL mode has a new option `sql-db2-escape-newlines'.
+If non-nil, newlines sent to the command interpreter will be escaped
+by a backslash. The default does not escape the newlines and assumes
+that the sql statement will be terminated by a semicolon.
+
+** Tabulated List and packages derived from it
++++
+*** New command `tabulated-list-sort', bound to `S', sorts the column
+at point, or the Nth column if a numeric prefix argument is given.
+
+** Term
++++
+*** The variables `term-default-fg-color' and `term-default-bg-color' are
+now deprecated in favor of the customizable face `term'.
++++
+*** You can customize how to display ANSI terminal colors and styles
+by customizing the corresponding `term-color-<COLOR>',
+`term-color-underline' and `term-color-bold' faces.
+
+** Tramp
++++
+*** The syntax has been extended in order to allow ad-hoc proxy definitions.
+See the manual for details.
++++
+*** Remote processes are now supported also on remote Windows host.
+
+** URL
++++
+*** Structs made by `url-generic-parse-url' have nil `attributes' slot.
+Previously, this slot stored semicolon-separated attribute-value pairs
+appended to some imap URLs, but this is not compatible with RFC 3986.
+So now the `filename' slot stores the entire path and query components
+and the `attributes' slot is always nil.
++++
+*** New function `url-encode-url' for encoding a URI string.
+The `url-retrieve' function now uses this to encode its URL argument,
+in case that is not properly encoded.
---
-*** New input methods for Farsi: farsi and farsi-translit.
+** VHDL mode
+
+*** The free software compiler GHDL is supported (and now the default).
+
+*** Support for the VHDL-AMS packages has been added/updated.
+
+*** Updated to the 2002 revision of the VHDL standard.
+
+*** Accepts \r and \f as whitespace.
+++
-*** `nobreak-char-display' now also highlights Unicode hyphen chars
-(U+2010 and U+2011).
+** `which-func-modes' now defaults to t, so Which Function mode, when
+enabled, applies to all applicable major modes.
-** Improved GTK integration
+---
+** winner-mode-hook now runs when the mode is disabled, as well as when it is
+enabled.
+
++++
+** Hooks renamed to avoid obsolete "-hooks" suffix:
+*** semantic-lex-reset-hooks -> semantic-lex-reset-functions
+*** semantic-change-hooks -> semantic-change-functions
+*** semantic-edits-new-change-hooks -> semantic-edits-new-change-functions
+*** semantic-edits-delete-change-hooks -> semantic-edits-delete-change-functions
+*** semantic-edits-reparse-change-hooks -> semantic-edits-reparse-change-functions
+*** semanticdb-save-database-hooks -> semanticdb-save-database-functions
+*** c-prepare-bug-report-hooks -> c-prepare-bug-report-hook
+*** rcirc-sentinel-hooks -> rcirc-sentinel-functions
+*** rcirc-receive-message-hooks -> rcirc-receive-message-functions
+*** rcirc-activity-hooks -> rcirc-activity-functions
+*** rcirc-print-hooks -> rcirc-print-functions
+*** dbus-event-error-hooks -> dbus-event-error-functions
+*** eieio-pre-method-execution-hooks -> eieio-pre-method-execution-functions
+*** checkdoc-style-hooks -> checkdoc-style-functions
+*** checkdoc-comment-style-hooks -> checkdoc-comment-style-functions
+*** archive-extract-hooks -> archive-extract-hook
+*** filesets-cache-fill-content-hooks -> filesets-cache-fill-content-hook
+*** hfy-post-html-hooks -> hfy-post-html-hook
+*** nndiary-request-create-group-hooks -> nndiary-request-create-group-functions
+*** nndiary-request-update-info-hooks -> nndiary-request-update-info-functions
+*** nndiary-request-accept-article-hooks -> nndiary-request-accept-article-functions
+*** gnus-subscribe-newsgroup-hooks -> gnus-subscribe-newsgroup-functions
+
+** Obsolete packages:
++++
+*** assoc.el
+In most cases, assoc+member+push+delq work just as well.
+And in any case it's just a terrible package: ugly semantics, terrible
+inefficiency, and not namespace-clean.
+---
+*** bruce.el
+++
-*** GTK scroll-bars are now placed on the right by default.
-Use `set-scroll-bar-mode' to change this.
+*** cust-print.el
+---
+*** ledit.el
+---
+*** mailpost.el
+++
-*** GTK tool bars can have just text, just images or images and text.
-Customize `tool-bar-style' to choose style. On a Gnome desktop, the default
-is taken from the desktop settings.
+*** mouse-sel.el
+---
+*** patcomp.el
+
+
+* Incompatible Lisp Changes in Emacs 24.3
+
++++
+** set-buffer-multibyte now signals an error in narrowed buffers.
+
++++
+** (random) by default now returns a different random sequence in
+every Emacs run. Use (random S), where S is a string, to set the
+random seed to a value based on S, in order to get a repeatable
+sequence in later calls.
+
---
-*** GTK tool bars can be placed on the left/right or top/bottom of the frame.
-The frame-parameter tool-bar-position controls this. It takes the values
-top, left, right or bottom. The Options => Show/Hide menu has entries
-for this.
+** The function `x-select-font' can return a font spec, instead of a
+font name as a string. Whether it returns a font spec or a font name
+depends on the graphical library.
+
+++
-*** The colors for selected text (the `region' face) are taken from
-the GTK theme when Emacs is built with GTK.
+** If the NEWTEXT arg to `replace-match' contains a substring "\?",
+that substring is inserted literally even if the LITERAL arg is
+non-nil, instead of causing an error to be signaled.
+
+++
-*** Emacs uses GTK tooltips by default if built with GTK. You can turn that
-off by customizing x-gtk-use-system-tooltips.
+** Docstrings starting with `*' no longer indicate user options.
+Only variables defined using `defcustom' are considered user options.
+The function `user-variable-p' is now an obsolete alias for
+`custom-variable-p'.
+++
-** New basic faces `error', `warning', `success' are available to
-highlight strings that indicate failure, caution or successful operation.
+** The return values of `defalias', `defun' and `defmacro' have changed,
+and are now undefined. For backwards compatibility, defun and
+defmacro currently return the name of the newly defined function/macro
+but this should not be relied upon.
---
-** Lucid menus and dialogs can display antialiased fonts if Emacs is built
-with Xft. To change font, use the X resource font, for example:
-Emacs.pane.menubar.font: Courier-12
+** `face-spec-set' no longer sets frame-specific attributes when the
+third argument is a frame (that usage was obsolete since Emacs 22.2).
+++
-** On graphical displays, the mode-line no longer ends in dashes.
-Also, the first dash (which does not indicate anything) is just
-displayed as a space.
+** The arguments of `dbus-register-signal' are no longer just strings,
+but keywords or keyword-string pairs. The old argument list will
+still be supported for Emacs 24.x.
-** Basic SELinux support has been added.
-This requires Emacs to be linked with libselinux at build time.
++++
+** The CL package's `get-setf-method' function no longer exists.
+Generalized variables are now part of core Emacs Lisp, and implemented
+differently to the way cl.el used to do it. It is not possible to
+define a compatible replacement for `get-setf-method'. See the file
+gv.el for internal details of the new implementation.
-*** Emacs preserves the SELinux file context when backing up, and
-optionally when copying files. To this end, copy-file has an extra
-optional argument, and backup-buffer and friends include the SELinux
-context in their return values.
+** Spelling changes.
+Some Lisp symbols have been renamed to avoid problems with spelling
+that is incorrect or inconsistent with how Emacs normally spells a word.
-*** The new functions file-selinux-context and set-file-selinux-context
-get and set the SELinux context of a file.
---
-*** Tramp offers handlers for file-selinux-context and set-file-selinux-context
-for remote machines which support SELinux.
+*** Renamed functions
+
+**** hangul-input-method-inactivate -> hangul-input-method-deactivate
+**** inactivate-input-method -> deactivate-input-method
+**** quail-inactivate -> quail-deactivate
+**** robin-inactivate -> robin-deactivate
+**** viper-inactivate-input-method -> viper-deactivate-input-method
+**** viper-inactivate-input-method-action ->
+ viper-deactivate-input-method-action
+**** ucs-input-inactivate -> ucs-input-deactivate
+
+---
+*** Renamed hooks
+The old hooks are still supported for backward compatibility, but they
+are deprecated and will be removed eventually.
+**** input-method-inactivate-hook -> input-method-deactivate-hook
+**** robin-inactivate-hook -> robin-deactivate-hook
+**** quail-inactivate-hook -> quail-deactivate-hook
+
+---
+*** Renamed Lisp variables
+**** follow-deactive-menu -> follow-inactive-menu
+**** inactivate-current-input-method-function ->
+ deactivate-current-input-method-function
+
++++
+** Some obsolete functions, variables, and faces have been removed:
+*** `last-input-char', `last-command-char', `unread-command-char'
+*** `facemenu-unlisted-faces'
+*** `rmail-decode-mime-charset'
+*** `iswitchb-read-buffer'
+*** `sc-version', `sc-submit-bug-report'
+*** `set-char-table-default'
+*** `string-to-sequence' (use `string-to-list' or `string-to-vector')
+*** `compile-internal'
+*** `modeline'
+*** `mode-line-inverse-video'
+*** `follow-mode-off-hook'
+*** `cvs-commit-buffer-require-final-newline'
+(use `log-edit-require-final-newline' instead)
+*** `cvs-changelog-full-paragraphs'
+(use `log-edit-changelog-full-paragraphs' instead)
+*** `cvs-diff-ignore-marks', `cvs-diff-buffer-name'
+*** `vc-ignore-vc-files' (use `vc-handled-backends' instead)
+*** `vc-master-templates' (use `vc-handled-backends' instead)
+*** `vc-checkout-carefully'
+
+
+* Lisp changes in Emacs 24.3
+
+** New sampling-based Elisp profiler.
+Try M-x profiler-start, do some work, and then call M-x profiler-report.
+When finished, use M-x profiler-stop. The sampling rate can be based on
+CPU time or memory allocations.
-** Changes for exiting Emacs
+++
-*** The function kill-emacs is now run upon receipt of the signals
-SIGTERM and SIGHUP, and upon SIGINT in batch mode.
+** CL-style generalized variables are now in core Elisp.
+`setf' is autoloaded; `push' and `pop' accept generalized variables.
+You can define your own generalized variables using `gv-define-simple-setter',
+`gv-define-setter', etc.
+
+++
-*** kill-emacs-hook is now also run in batch mode.
-If you have code that adds something to kill-emacs-hook, you should
-consider if it is still appropriate to add it in the noninteractive case.
+** `defun' also accepts a (declare DECLS) form, like `defmacro'.
+The interpretation of the DECLS is determined by `defun-declarations-alist'.
-** Scrolling changes
+** Minibuffer
+++
-*** New scrolling commands `scroll-up-command' and `scroll-down-command'
-(bound to C-v/[next] and M-v/[prior]) do not signal errors at top/bottom
-of buffer at first key-press (instead move to top/bottom of buffer)
-when `scroll-error-top-bottom' is non-nil.
+*** `read-regexp' has a new argument HISTORY; the first argument PROMPT
+of `read-regexp' accepts a string ending with a colon and space, and its
+second argument DEFAULTS can be a list of strings accessible via M-n
+in the minibuffer ahead of other hard-coded useful regexp-related values.
+More commands use `read-regexp' now to read their regexp arguments.
+
+** Completion
+
+*** New function `completion-table-with-quoting' to handle completion
+in the presence of quoting, such as file completion in shell buffers.
+
+++
-*** New variable `scroll-error-top-bottom' (see above).
+*** New function `completion-table-subvert' to use an existing completion
+table, but with a different prefix.
+
+** Debugger changes
+
+++
-*** New scrolling commands `scroll-up-line' and `scroll-down-line'
-scroll a line instead of full screen.
+*** New error type and new function `user-error'.
+These do not trigger the debugger.
+
+++
-*** New property `scroll-command' should be set on a command's symbol to
-define it as a scroll command affected by `scroll-preserve-screen-position'.
+*** New option `debugger-bury-or-kill', saying what to do with the
+debugger buffer when exiting debug.
+
+++
-*** If you customize `scroll-conservatively' to a value greater than 100,
-Emacs will never recenter point in the window when it scrolls due to
-cursor motion commands or commands that move point (e.f., `M-g M-g').
-Previously, you needed to use `most-positive-fixnum' as the value of
-`scroll-conservatively' to achieve the same effect.
+*** Set `debug-on-message' to enter the debugger when a certain
+message is displayed in the echo area. This can be useful when trying
+to work out which code is doing something.
---
-*** ``Aggressive'' scrolling now honors the scroll margins.
-If you customize `scroll-up-aggressively' or
-`scroll-down-aggressively' and move point off the window, Emacs now
-scrolls the window so as to avoid positioning point inside the scroll
-margin.
+*** New var `inhibit-debugger', automatically set to prevent accidental
+recursive invocations.
-** Trash changes
+** Window changes
+++
-*** `delete-by-moving-to-trash' now only affects commands that specify
-trashing. This avoids inadvertently trashing temporary files.
+*** The functions get-lru-window, get-mru-window and get-largest-window
+now accept a third argument to avoid choosing the selected window.
+++
-*** Calling `delete-file' or `delete-directory' with a prefix argument
-now forces true deletion, regardless of `delete-by-moving-to-trash'.
+*** Additional values recognized for option `window-combination-limit'.
-** New option `list-colors-sort' defines the color sort order
-for `list-colors-display'.
++++
+*** New macro `with-temp-buffer-window', similar to
+`with-output-to-temp-buffer'.
+
+---
+*** `temp-buffer-resize-mode' no longer resizes windows that have been
+reused.
+
++++
+*** New command `fit-frame-to-buffer' adjusts the frame height to
+fit the contents.
+
++++
+*** The command `fit-window-to-buffer' can adjust the frame height
+if the new option `fit-frame-to-buffer' is non-nil.
+
++++
+*** New option switch-to-buffer-preserve-window-point to restore a
+window's point when switching buffers.
++++
+*** New display action functions `display-buffer-below-selected',
+and `display-buffer-in-previous-window'.
++++
+*** New display action alist entry `inhibit-switch-frame', if non-nil,
+tells display action functions to avoid changing which frame is
+selected.
++++
+*** New display action alist entry `pop-up-frame-parameters', if
+non-nil, specifies frame parameters to give any newly-created frame.
++++
+*** New display action alist entry `previous-window', if non-nil,
+specifies window to reuse in `display-buffer-in-previous-window'.
++++
+*** New display action alist entries `window-height' and `window-width'
+to specify size of new window created by `display-buffer'.
+
+*** The following variables are obsolete, as they can be replaced by
+appropriate entries in the `display-buffer-alist' function introduced
+in Emacs 24.1:
++++
+**** `display-buffer-reuse-frames'
++++
+**** `special-display-regexps'
++++
+**** `special-display-frame-alist'
++++
+**** `special-display-buffer-names'
++++
+**** `special-display-function'
++++
+**** `display-buffer-function'
+---
+**** `dired-shrink-to-fit'
+
+** Time
+---
+*** `current-time-string' no longer requires that its argument's year
+must be in the range 1000..9999. It now works with any year supported
+by the underlying C implementation.
++++
+*** `current-time' now returns extended-format time stamps
+(HIGH LOW USEC PSEC), where the new PSEC slot specifies picoseconds.
+PSEC is typically a multiple of 1000 on current machines. Other
+functions that use this format, such as file-attributes and
+format-time-string, have been changed accordingly. Old-format time
+stamps are still accepted.
+---
+*** The format of timers in timer-list and timer-idle-list is now
+[TRIGGERED-P HI-SECS LO-SECS USECS REPEAT-DELAY FUNCTION ARGS IDLE-DELAY PSECS].
+The PSECS slot is new, and uses picosecond resolution. It can be
+accessed via the new timer--psecs accessor.
++++
+*** Last-modified time stamps in undo lists now are of the form
+(t HI-SECS LO-SECS USECS PSECS) instead of (t HI-SECS . LO-SECS).
+
++++
+** Floating point functions now always return special values like NaN,
+instead of signaling errors, if given invalid args, e.g. (log -1.0).
+Previously, they returned NaNs on some platforms but signaled errors
+on others. The affected functions are acos, asin, tan, exp, expt,
+log, log10, sqrt, and mod.
+
++++
+** Emacs tries to macroexpand interpreted (non-compiled) files during load.
+This can significantly speed up execution of non-byte-compiled code,
+but can also bump into previously unnoticed cyclic dependencies.
+These are generally harmless: they will simply cause the macro calls
+to be left for later expansion (as before), but will result in a
+warning ("Eager macro-expansion skipped due to cycle") describing the cycle.
+You may wish to restructure your code so this does not happen.
+
+** Miscellaneous new functions:
++++
+*** `autoloadp' tests if its argument is an autoloaded object.
++++
+*** `autoload-do-load' performs the autoloading operation.
++++
+*** `buffer-narrowed-p' tests if the buffer is narrowed.
++++
+*** `file-name-base' returns a file name sans directory and extension.
++++
+*** `function-get' fetches a function property, following aliases.
++++
+*** `posnp' tests if an object is a `posn'.
++++
+*** `set-temporary-overlay-map' sets up a temporary keymap that
+takes precedence over most other maps for a short while (normally one key).
++++
+*** `system-users' returns the user names on the system.
++++
+*** `system-groups' returns the group names on the system.
++++
+*** `tty-top-frame' returns the topmost frame of a text terminal.
+
++++
+** New macros `setq-local' and `defvar-local'.
+
++++
+** New fringe bitmap `exclamation-mark'.
+
++++
+** Face underlining can now use a wave.
+
+** The following functions and variables are obsolete:
+---
+*** `automount-dir-prefix' (use `directory-abbrev-alist')
++++
+*** `buffer-has-markers-at'
+---
+*** `macro-declaration-function' (use `macro-declarations-alist')
+---
+*** `window-system-version' (provides no useful information)
+---
+*** `dired-pop-to-buffer' (use `dired-mark-pop-up')
+---
+*** `query-replace-interactive'
+---
+*** `font-list-limit' (has had no effect since Emacs < 23)
+
+
+* Changes in Emacs 24.3 on non-free operating systems
+
+---
+** Cygwin builds can use the native MS Windows user interface.
+Pass --with-w32 to configure. The default remains the X11 interface.
+
+** Two new functions are available in Cygwin builds:
+`cygwin-convert-file-name-from-windows' and
+`cygwin-convert-file-name-to-windows'. These functions allow Lisp
+code to access the Cygwin file-name mapping machinery to convert
+between Cygwin and Windows-native file and directory names.
+
+** When invoked with the -nw switch to run on the Windows text-mode terminal,
+Emacs now supports mouse highlight, help-echo (in the echo area), and
+`mouse-autoselect-window'.
+
++++
+** On MS Windows Vista and later Emacs now supports symbolic links.
+
++++
+** On MS Windows, you can pass --without-libxml2 to configure.bat to omit
+support for libxml2, even if its presence is detected.
+
+---
+** On Mac OS X, the Nextstep port requires OS X 10.4 or later.
+
+---
+** On Mac OS X, configure no longer automatically adds the Fink /sw
+directories to the search path. You must add them yourself if you want them.
+
+
+* Changes in Emacs 24.2
+
+** This is mainly a bug-fix release.
+
+
+* Installation Changes in Emacs 24.1
+
+** Emacs can be compiled with Gtk+ 3.0 if you pass --with-x-toolkit=gtk3
+to configure. Note that other libraries used by Emacs, RSVG and GConf,
+also depend on Gtk+. You can disable them with --without-rsvg and
+--without-gconf.
+
+** Emacs can be compiled with GnuTLS support.
+This happens by default if a suitably recent version of the library is
+found at build time. To prevent this, use the configure option
+`--without-gnutls'. See below for GnuTLS features.
+
+** Emacs can be compiled with SELinux support.
+This happens by default if a suitably recent version of the library is
+found at build time. To prevent this, use the configure option
+`--without-selinux'. See below for SELinux features.
+
+** Emacs can be compiled with ImageMagick support.
+This happens by default if a suitably recent version of the library is
+found at build time. To prevent this, use the configure option
+`--without-imagemagick'. See below for ImageMagick features.
+This feature is not available for the Nextstep or MS ports.
+
+** Emacs can be compiled with libxml2 support.
+This happens by default if a suitably recent version of the library is
+found at build time. To prevent this, use the configure option
+`--without-xml2'. See below for libxml2 features.
+
+** By default, the installed Info and man pages are compressed.
+You can disable this by configuring --without-compress-info.
+
+** New configure option --with-wide-int.
+With it, Emacs integers typically have 62 bits, even on 32-bit machines.
+On 32-bit hosts, this raises the limit on buffer sizes from about 512 MiB
+to about 2 GiB.
+
+** New configure options: --with-mmdf, --with-mail-unlink, --with-mailhost.
+These provide no new functionality, they just remove the need to edit
+lib-src/Makefile by hand in order to use the associated features.
+
+** New configure option --enable-use-lisp-union-type.
+This is only useful for Emacs developers to debug certain types of bugs.
+This is not a new feature; only the configure flag is new.
+
+** The standalone programs digest-doc and sorted-doc are removed.
+Emacs now uses Lisp commands `doc-file-to-man' and `doc-file-to-info'.
+
+** The standalone program `fakemail' is removed.
+If you need it, feedmail.el provides a superset of the functionality.
+
+
+* Startup Changes in Emacs 24.1
+
+** The --unibyte, --multibyte, --no-multibyte, and --no-unibyte
+command line arguments, and the EMACS_UNIBYTE environment variable, no
+longer have any effect. (They were declared obsolete in Emacs 23.)
+
+** New command line option `--no-site-lisp' removes site-lisp directories
+from load-path. -Q now implies this. This option does not affect the
+EMACSLOADPATH environment variable (and hence has no effect for
+Nextstep builds).
+
+
+* Changes in Emacs 24.1
+
+** Completion
+
+*** Many packages now use the `completion-at-point' command,
+rather than implementing separate completion commands.
+
+*** `completion-at-point' now handles tags and semantic completion.
+
+*** Completion in a non-minibuffer now tries to detect the end of completion
+and pops down the *Completions* buffer accordingly.
+
+*** New option `completion-cycle-threshold' allows completion cycling.
+
+*** New option `completion-category-overrides' for overriding the
+default completion style in certain circumstances.
+
+*** New completion style `substring'.
+
+*** Completion of buffer names uses `substring' completion by default.
+
+*** The option `widget-complete-field' has been removed.
+
+** Mail changes
+
+*** The first time you try sending mail, Emacs asks for a mail method.
+This is implemented by a new default for `send-mail-function', which
+is `sendmail-query-once'. This offers to use the smtpmail package, or
+to use the old defaults relying on external mail facilities
+(`sendmail-send-it' on GNU/Linux and other Unix-like systems, and
+`mailclient-send-it' on Windows).
+
+*** Typing C-c m in the buffer made by M-x report-emacs-bug transfers
+the report to your desktop's preferred mail client, if there is one.
+This uses either the "xdg-email" utility, or Mac OS's "open" command.
+
+*** See Changes in Specialized Modes and Packages for SMTPmail changes
+and Mail mode changes
+
+** Emacs server and client changes
+
+*** New option `server-port' specifies the port for TCP Emacs servers.
+
+*** New emacsclient argument -q/--quiet suppresses some status messages.
+
+*** New emacsclient argument --frame-parameters specifies the frame
+parameters of any newly-created graphical frame.
+
+*** If emacsclient shuts down due to Emacs signaling an error,
+its exit status is 1.
+
+*** New emacsclient argument --parent-id ID.
+This opens a client frame in parent X window ID, via XEmbed, similar
+to the --parent-id argument to Emacs.
+
+** Internationalization changes
+
+*** Emacs now supports display and editing of bidirectional text.
+Right-to-left (RTL) scripts, such as Arabic, Farsi, and Hebrew, are
+displayed in the correct visual order as expected by users of those
+scripts. The display reordering is a "full bidirectionality" class
+implementation of the Unicode Bidirectional Algorithm (UBA). Buffers
+with no RTL text should look exactly the same as before.
+
+**** New buffer-local variable `bidi-display-reordering'.
+To disable display reordering in a buffer, change this to nil.
+
+**** New buffer-local variable `bidi-paragraph-direction'.
+If nil (the default), Emacs determines the base direction of each
+paragraph from its text, as specified by the UBA. Setting the value
+to `right-to-left' or `left-to-right' forces a base direction on each
+paragraph.
+
+Paragraphs with right-to-left base direction are displayed starting at
+the right window edge.
+
+*** Enhanced support for characters with no glyphs in available fonts,
+or, on text terminals, characters that cannot be encoded by the
+terminal coding system. The new option `glyphless-char-display-control'
+specifies how to display them: as a hexadecimal code in a box, a thin
+1-pixel space, an empty box, etc.
+
+*** New input methods for Farsi and Bulgarian
+(farsi-isiri-9147, farsi-transliterate-banan, bulgarian-alt-phonetic).
+
+*** `nobreak-char-display' now also highlights Unicode hyphen chars
+(U+2010 and U+2011).
+
+*** New Hebrew translation of the Emacs Tutorial.
+Type `C-u C-h t' to choose it in case your language setup doesn't
+automatically select it.
** An Emacs Lisp package manager is now included.
This is a convenient way to download and install additional packages,
from a package repository at http://elpa.gnu.org.
-+++
-*** `M-x list-packages' shows a list of packages, which can be
+
+*** M-x list-packages shows a list of packages, which can be
selected for installation.
-+++
+
*** New command `describe-package', bound to `C-h P'.
-+++
-*** By default, all installed packages are loaded and activated
-automatically when Emacs starts up. To disable this, set
-`package-enable-at-startup' to nil. To change which packages are
-loaded, customize `package-load-list'.
-** Custom Themes
+*** By default, all installed packages are loaded automatically when
+Emacs starts up. To disable this, set `package-enable-at-startup' to
+nil. To specify the packages to load, customize `package-load-list'.
+
+** Custom theme changes
-*** `M-x customize-themes' lists Custom themes which can be enabled.
+*** New command `M-x customize-themes', which provides a convenient
+interface for enabling and disabling Custom themes.
*** New option `custom-theme-load-path' is the load path for themes.
-Emacs no longer looks for custom themes in `load-path'. The default
-is to search in `custom-theme-directory', followed by a built-in theme
-directory named "themes/" in `data-directory'.
+Emacs no longer looks for Custom themes in `load-path'. The default
+value of `custom-theme-load-path' says to look for themes in
+`custom-theme-directory', followed by a subdirectory of
+`data-directory' named "themes/", which contains a small selection of
+built-in Custom themes.
*** New option `custom-safe-themes' records known-safe theme files.
If a theme is not in this list, Emacs queries before loading it, and
offers to save the theme to `custom-safe-themes' automatically. By
default, all themes included in Emacs are treated as safe.
-** The user option `remote-file-name-inhibit-cache' controls whether
-the remote file-name cache is used for read access.
+** Improved GTK integration
+
+*** GTK scroll-bars are now placed on the right by default.
+The function `set-scroll-bar-mode' can change this.
+
+*** GTK tool bars can have just text, just images or images and text.
+Customize `tool-bar-style' to choose the style. On a Gnome desktop,
+the default is taken from desktop settings.
+
+*** GTK tool bars can be placed on any edge of the frame.
+The frame-parameter tool-bar-position controls this. It takes the
+values top, left, right or bottom. The Options => Show/Hide menu has
+entries for this.
+
+*** The default colors for selected text (the `region' face) are taken
+from the GTK theme when Emacs is built with GTK.
+
+*** Emacs uses GTK tooltips by default if built with GTK.
+You can disable this by changing `x-gtk-use-system-tooltips' to nil.
+
+** Graphical interface changes
+
+*** On graphical displays, the mode-line no longer ends in dashes.
+Also, the first dash (which does not indicate anything) is just
+displayed as a space.
+
+*** `menu-bar-select-buffer-function' lets you choose another operation
+instead of `switch-to-buffer' when selecting an item in the Buffers menu.
+
+*** Lucid menus and dialogs can display antialiased fonts if Emacs is
+built with Xft. These fonts can be set via X resources, for example:
+Emacs.pane.menubar.font: Courier-12
+
+** Exiting changes
+
+*** Emacs now calls `kill-emacs' if it receives SIGTERM or SIGHUP,
+or if it receives a SIGINT signal in batch mode.
+
+*** `kill-emacs-hook' is now also run in batch mode.
+Third-party code which adds to `kill-emacs-hook' should check if they
+do the right thing in batch mode.
+
+** Scrolling changes
+
+*** New scrolling commands `scroll-up-command' and `scroll-down-command'
+(bound to C-v/[next] and M-v/[prior]) do not signal errors at top/bottom
+of buffer at first key-press (instead they move to top/bottom of buffer)
+when `scroll-error-top-bottom' is non-nil.
+
+*** New option `scroll-error-top-bottom' (see above).
+
+*** New scrolling commands `scroll-up-line' and `scroll-down-line'
+scroll a line instead of full screen.
+
+*** New property `scroll-command' should be set on a command's symbol to
+define it as a scroll command affected by `scroll-preserve-screen-position'.
+
+*** If you customize `scroll-conservatively' to a value greater than 100,
+Emacs will never recenter point in the window when it scrolls due to
+cursor motion commands or commands that move point (e.f., `M-g M-g').
+Previously, you needed to use `most-positive-fixnum' as the value of
+`scroll-conservatively' to achieve the same effect.
+
+*** "Aggressive" scrolling now honors the scroll margins.
+If you customize `scroll-up-aggressively' or
+`scroll-down-aggressively' and move point off the window, Emacs now
+scrolls the window so as to avoid positioning point inside the scroll
+margin.
+
+** Basic SELinux support has been added.
+This requires Emacs to be linked with libselinux at build time.
+
+*** Emacs preserves the SELinux file context when backing up.
+Also, the function `copy-file' has an extra optional argument for
+preserving SELinux context, and the return value of `backup-buffer'
+now includes the SELinux context.
+
+*** New functions `file-selinux-context' and `set-file-selinux-context'
+get and set the SELinux context of a file.
+
+** Trash changes
+
+*** `delete-by-moving-to-trash' now only affects commands that specify
+trashing. This avoids inadvertently trashing temporary files.
+
+*** Calling `delete-file' or `delete-directory' with a prefix argument
+now forces true deletion, regardless of `delete-by-moving-to-trash'.
** File- and directory-local variable changes
-+++
+
*** You can stop directory local vars from applying to subdirectories.
Add an element (subdirs . nil) to the alist portion of any variables
settings to indicate that the section should not apply to
@@ -370,31 +1381,26 @@ Affected modes include dired, vc-dir, and log-edit. For example,
adding "(diff-mode . ((mode . whitespace)))" to .dir-locals.el will
turn on `whitespace-mode' for *vc-diff* buffers. Modes should call
`hack-dir-local-variables-non-file-buffer' to support this.
-+++
+
*** Using "mode: MINOR-MODE" to enable a minor mode is deprecated.
Instead, use "eval: (minor-mode 1)".
-+++
-** The variable `focus-follows-mouse' now always defaults to nil.
-
-** New primitive `secure-hash' that supports many secure hash algorithms
-including md5, sha-1 and sha-2 (sha-224, sha-256, sha-384 and sha-512).
-The elisp implementation sha1.el is removed. Feature sha1 is provided
-by default.
-
-** Menu-bar changes
----
-*** `menu-bar-select-buffer-function' lets you choose another operation
-instead of `switch-to-buffer' when selecting an item in the Buffers menu.
+*** The variable `inhibit-first-line-modes-regexps' has been renamed
+to `inhibit-local-variables-regexps'. As the name suggests, it now
+applies to ALL file local variables, not just -*- lines. The
+associated `inhibit-first-line-modes-suffixes' has been renamed in the
+corresponding way.
** Window changes
-+++
+*** The `quit-window' command now restores the last buffer displayed
+in the quitted window.
+
*** Resizing an Emacs frame now preserves proportional window sizes,
modulo restrictions like window minimum sizes and fixed-size windows.
*** The behavior of `display-buffer' is now customizable in detail.
-+++
+
**** New option `display-buffer-base-action' specifies a list of
user-determined display "actions" (functions and optional arguments
for choosing the displaying window).
@@ -402,284 +1408,293 @@ for choosing the displaying window).
This takes precedence over the default display action, which is
specified by `display-buffer-fallback-action'.
-+++
**** New option `display-buffer-alist' maps buffer name regexps to
display actions, taking precedence over `display-buffer-base-action'.
-+++
*** New option `window-combination-limit'.
The new option `window-combination-limit' allows to return the space
obtained for resizing or creating a window more reliably to the window
from which such space was obtained.
-+++
*** New option `window-combination-resize'.
The new option `window-combination-resize' allows to split a window that
otherwise cannot be split because it's too small by stealing space from
other windows in the same combination. Subsequent resizing or deletion
of the window will resize all windows in the same combination as well.
-+++
+*** New option `frame-auto-hide-function' lets you choose between
+iconifying or deleting a frame when burying a buffer in a dedicated
+frame, or quitting a window showing a buffer in a frame of its own.
+
*** New commands `maximize-window' and `minimize-window'.
These maximize and minimize the size of a window within its frame.
-+++
*** New commands `switch-to-prev-buffer' and `switch-to-next-buffer'.
These functions allow to navigate through the live buffers that have
been shown in a specific window.
-+++
-*** New functions `window-state-get' and `window-state-put'.
-These functions allow to save and restore the state of an arbitrary
-frame or window as an Elisp object.
+** Minibuffer changes
+
+*** The inactive minibuffer has its own major mode `minibuffer-inactive-mode'.
+This is handy for minibuffer-only frames, and is also used for the feature
+where mouse-1 pops up *Messages*"', which can now easily be changed.
+
+*** Minibuffers set `truncate-lines' to nil.
+If you want to change the value to something else, you could use
+for example `minibuffer-setup-hook'.
+
+** `auto-mode-case-fold' is now enabled by default.
+
+** `backup-by-copying-when-mismatch' now defaults to t.
-** The inactive minibuffer has its own major mode `minibuffer-inactive-mode'.
-This is handy for minibuffer-only frames, and is also used for the "mouse-1
-pops up *Messages*" feature, which can now easily be changed.
+** New basic faces `error', `warning', `success'.
+These are used to highlight text indicating failure, caution or
+successful operation.
+
+** New option `list-colors-sort' defines the color sort order
+for `list-colors-display'.
+
+** The variable `focus-follows-mouse' now always defaults to nil.
* Editing Changes in Emacs 24.1
** Search changes
-+++
-*** C-y in Isearch is now bound to isearch-yank-kill, instead of
-isearch-yank-line.
-+++
-*** M-y in Isearch is now bound to isearch-yank-pop, instead of
-isearch-yank-kill.
-+++
-*** M-s C-e in Isearch is now bound to isearch-yank-line.
-+++
-** New commands `count-words-region' and `count-words'.
+*** C-y in Isearch is now bound to `isearch-yank-kill', instead of
+`isearch-yank-line'.
-*** `count-lines-region' is now an alias for `count-words-region',
-bound to M-=, which shows the number of lines, words, and characters.
+*** M-y in Isearch is now bound to `isearch-yank-pop', instead of
+`isearch-yank-kill'.
-+++
-** The default value of `backup-by-copying-when-mismatch' is now t.
+*** M-s C-e in Isearch is now bound to `isearch-yank-line'.
+
+** New commands `count-words-region' and `count-words'.
+
+*** M-= is bound to `count-words-region', not `count-lines-region'.
+The `count-words-region' command, when called interactively, reports
+the number of lines, words, and characters in the region. It is a
+superset of the old `count-lines-region', which is now an obsolete
+alias for it.
-+++
** The command `just-one-space' (M-SPC), if given a negative argument,
also deletes newlines around point.
** Deletion changes
-+++
+
*** New option `delete-active-region'.
If non-nil, [delete] and DEL delete the region if it is active and no
-prefix argument is given. If set to `kill', these commands kill
+prefix argument is given. If set to `kill', those commands kill
instead.
-+++
+
*** New command `delete-forward-char', bound to [delete].
This is meant for interactive use, and obeys `delete-active-region'.
The command `delete-char' does not obey `delete-active-region'.
----
+
*** `delete-backward-char' is now a Lisp function.
Apart from obeying `delete-active-region', its behavior is unchanged.
-However, the byte compiler now warns if it is called from Lisp; you
-should use delete-char with a negative argument instead.
----
+However, the byte compiler now warns if it is called from Lisp; Lisp
+callers should use delete-char with a negative argument instead.
+
*** The option `mouse-region-delete-keys' has been deleted.
** Selection changes.
-The default handling of clipboard and primary selections was changed
-to conform with modern X applications. In short, most commands for
-killing and yanking text now use the clipboard, while mouse commands
-use the primary selection.
+The default handling of clipboard and primary selections has been
+changed to conform with modern X applications. In short, most
+commands for killing and yanking text now use the clipboard, while
+mouse commands use the primary selection.
In the following, we provide a list of these changes, followed by a
list of steps to get the old behavior back if you prefer that.
-+++
*** `select-active-regions' now defaults to t.
Merely selecting text (e.g. with drag-mouse-1) no longer puts it in
the kill ring. The selected text is put in the primary selection, if
the system possesses a separate primary selection facility (e.g. X).
-+++
**** `select-active-regions' also accepts a new value, `only'.
This means to only set the primary selection for temporarily active
regions (usually made by mouse-dragging or shift-selection);
"ordinary" active regions, such as those made with C-SPC followed by
point motion, do not alter the primary selection.
----
**** `mouse-drag-copy-region' now defaults to nil.
-+++
*** mouse-2 is now bound to `mouse-yank-primary'.
This pastes from the primary selection, ignoring the kill-ring.
Previously, mouse-2 was bound to `mouse-yank-at-click'.
-+++
*** `x-select-enable-clipboard' now defaults to t on all platforms.
-+++
+
*** `x-select-enable-primary' now defaults to nil.
Thus, commands that kill text or copy it to the kill-ring (such as
M-w, C-w, and C-k) also use the clipboard---not the primary selection.
----
**** The "Copy", "Cut", and "Paste" items in the "Edit" menu are now
-exactly equivalent to, respectively M-w, C-w, and C-y.
+exactly equivalent to M-w, C-w, and C-y respectively.
----
**** Note that on MS-Windows, `x-select-enable-clipboard' was already
non-nil by default, as Windows does not support the primary selection
between applications.
----
*** To return to the previous behavior, do the following:
+
**** Change `select-active-regions' to nil.
**** Change `mouse-drag-copy-region' to t.
**** Change `x-select-enable-primary' to t (on X only).
**** Change `x-select-enable-clipboard' to nil.
**** Bind `mouse-yank-at-click' to mouse-2.
-+++
*** Support for X cut buffers has been removed.
*** X clipboard managers are now supported.
To inhibit this, change `x-select-enable-clipboard-manager' to nil.
-+++
-** New command `rectangle-number-lines', bound to `C-x r N', numbers
-the lines in the current rectangle. With a prefix argument, this
-prompts for a number to count from and for a format string.
+** New command `C-x r N' (`rectangle-number-lines') numbers the lines
+in the current rectangle. With a prefix argument, this prompts for a
+number to count from and for a format string.
-+++
-** The default value of redisplay-dont-pause is now t
+** `redisplay-dont-pause' now defaults to t.
This makes Emacs feel more responsive to editing commands that arrive
at high rate, e.g. if you lean on some key, because stopping redisplay
in the middle (when this variable is nil) forces more expensive
updates later on, and Emacs appears to be unable to keep up.
-+++
** The behavior of <TAB> for active regions in Text mode has changed.
In Text and related modes, typing <TAB> (`indent-for-tab-command')
when the region is active causes Emacs to indent all the lines in the
region, aligning them with the line previous to the first line in the
region (or with the left margin if there is no previous line).
+** When `occur' is called with a prefix argument, matching strings are
+collected into the `*Occur*' buffer without line numbers. If there
+are parenthesized subexpressions in the specified regexp, `occur'
+reads replacement text that may contain \\& and \\N whose convention
+follows `replace-match'.
+
* Changes in Specialized Modes and Packages in Emacs 24.1
-+++
** Archive Mode has basic support for browsing and updating 7z archives.
-** browse-url has a new variable `browse-url-mailto-function'
-specifies how mailto: URLs are handled. The default is `browse-url-mail'.
-
----
** BibTeX mode
*** BibTeX mode now supports biblatex.
-Use the variable bibtex-dialect to select support for different BibTeX
-dialects. bibtex-entry-field-alist is now an obsolete alias for
-bibtex-BibTeX-entry-alist.
+Use the variable `bibtex-dialect' to select different BibTeX dialects.
+`bibtex-entry-field-alist' is now an obsolete alias for
+`bibtex-BibTeX-entry-alist'.
-*** New command `bibtex-search-entries' bound to C-c C-a.
+*** New command `bibtex-search-entries', bound to C-c C-a.
*** New `bibtex-entry-format' option `sort-fields', disabled by default.
*** New variable `bibtex-search-entry-globally'.
+** Browse-url
+
+*** New option `browse-url-mailto-function' specifies how to handle "mailto:"s.
+
+*** The default browser used by the package is now the "xdg-open" program,
+on platforms that support it. This calls your desktop's preferred browser.
+
** Calendar, Diary, and Appt
-+++
-*** Diary entries can contain non-printing `comments'.
+*** Diary entries can contain non-printing "comments".
See the variable `diary-comment-start'.
-+++
*** Appointments can specify their individual warning times.
See the variable `appt-warning-time-regexp'.
----
*** The function specified by `appt-disp-window-function' may be passed
lists of arguments if multiple appointments are due at similar times.
If you are using a custom function for this, you should update it.
-+++
*** New function `diary-hebrew-birthday'.
----
*** Elements of `calendar-day-abbrev-array' and `calendar-month-abbrev-array'
may no longer be nil, but must all be strings.
----
-*** The obsolete (since Emacs 22.1) method of enabling the appt package
-by adding appt-make-list to diary-hook has been removed. Use appt-activate.
+*** The obsolete (since Emacs 22.1) method of enabling the appt
+package by adding `appt-make-list' to `diary-hook' has been removed.
+Use `appt-activate' instead.
----
*** Some appt variables (obsolete since Emacs 22.1) have been removed:
appt-issue-message (use the function appt-activate)
appt-visible/appt-msg-window (use the variable appt-display-format)
----
*** Some diary function aliases (obsolete since Emacs 22.1) have been removed:
view-diary-entries, list-diary-entries, show-all-diary-entries
-** CC Mode (C, C++, etc.)
+** CC Mode
*** New feature to "guess" the style in an existing buffer.
+The main entry point is M-x c-guess.
+
+*** Java Mode now supports Java 5.0 (Tiger) and 6 (Mustang).
+
+*** `c-beginning-of-defun' and `c-end-of-defun' now respect nested scopes.
+Thus C-M-a will, by default, go to the beginning of the immediate function,
+not the top level.
-** comint and modes derived from it use the generic completion code.
+*** "Macros with semicolons" can be registered for correct indentation.
+Where such a macro ends a line (no semicolon) the next statement is no longer
+parsed as a statement continuation.
+
+** Comint and modes derived from it use the standard completion code.
** Compilation mode
----
-*** Compilation mode can be used without font-lock-mode.
+
+*** Compilation mode can be used without Font Lock mode.
`compilation-parse-errors-function' is now obsolete.
-*** `compilation-filter-start' is let-bound to the start of the text
-inserted by the compilation filter function, when calling
-compilation-filter-hook.
+*** New variable `compilation-filter-start', which is bound while
+`compilation-filter-hook' runs. It records the start position of the
+text inserted by `compilation-filter'.
-*** `compilation-error-screen-columns' is obeyed in the editing buffer.
-So programming language modes can set it, whereas previously only the value
-in the *compilation* buffer was used.
+*** `compilation-error-screen-columns' and `compilation-first-column'
+are obeyed in the editing buffer. So programming language modes can
+set them, whereas previously only the value in the *Compilation*
+buffer was used.
** Customize
*** Customize buffers now contain a search field.
The search is performed using `customize-apropos'.
-To turn off the search field, set custom-search-field to nil.
+To turn off the search field, set `custom-search-field' to nil.
-*** Custom options now start out hidden if at their default values.
+*** Options in customize group buffers start out hidden if not customized.
Use the arrow to the left of the option name to toggle visibility.
*** custom-buffer-sort-alphabetically now defaults to t.
*** The color widget now has a "Choose" button, which allows you to
-choose a color via list-colors-display.
+choose a color via `list-colors-display'.
** D-Bus
-*** It is possible now, to access alternative buses than the default
-system or session bus.
+*** It is now possible to access buses other than the default system
+or session bus.
-*** dbus-register-{service,method,property}
-The -method and -property functions do not automatically register
-names anymore.
+*** The `dbus-register-method' and `dbus-register-property' functions
+optionally do not register names.
-The new function dbus-register-service registers a service known name
-on a D-Bus without simultaneously registering a property or a method.
+*** The new function `dbus-register-service' registers a known service
+name on a D-Bus without also registering a property or a method.
** Dired-x
----
-*** dired-jump and dired-jump-other-window called with a prefix argument
-read a file name from the minibuffer instead of using buffer-file-name.
-+++
-*** The `dired local variables' feature provided by Dired-x is obsolete.
+*** C-x C-j (`dired-jump') and C-x 4 C-j (`dired-jump-other-window'),
+if called with a prefix argument, read a file name from the minibuffer
+instead of using the current buffer.
+
+*** The "dired local variables" feature of Dired-x is obsolete.
The standard directory local variables feature replaces it.
** ERC changes
-*** New vars `erc-autojoin-timing' and `erc-autojoin-delay'.
-If the value of `erc-autojoin-timing' is 'ident, ERC autojoins after a
-successful NickServ identification, or after `erc-autojoin-delay'
-seconds. The default value, 'ident, means to autojoin immediately
-after connecting.
+*** New options `erc-autojoin-timing' and `erc-autojoin-delay',
+controlling attempts to autojoin a channel.
*** New variable `erc-coding-system-precedence': If we use `undecided'
as the server coding system, this variable will then be consulted.
@@ -688,85 +1703,130 @@ utf-8, and do the normal `undecided' decoding for the rest.
** Eshell changes
-*** The default value of eshell-directory-name is a directory named
-"eshell" in `user-emacs-directory'. If the old "~/.eshell/" directory
-exists, that is used instead.
+*** The default value of `eshell-directory-name' has changed
+to be an "eshell" directory in `user-emacs-directory'.
+The old "~/.eshell/" directory is still used if it exists, though.
** gdb-mi
-*** GDB User Interface migrated to GDB Machine Interface and now
-supports multithread non-stop debugging and debugging of several
-threads simultaneously.
-
-** In ido-mode, C-v is no longer bound to ido-toggle-vc.
-The reason is that this interferes with cua-mode.
+*** The M-x gdb command now uses the GDB Machine Interface protocol.
+It now supports multithread non-stop debugging and simultaneous
+debugging of several threads.
** Image mode
-*** RET (`image-toggle-animation') toggles animation, if the displayed
-image can be animated.
-
-*** Option `image-animate-loop', if non-nil, loops the animation.
-If nil, `image-toggle-animation' plays the animation once.
+*** RET (`image-toggle-animation') toggles animation, if applicable.
+Animation plays once, unless the option `image-animate-loop' is non-nil.
** Info
-*** New command `info-display-manual' displays an Info manual
-specified by its name. If that manual is already visited in some Info
-buffer within the current session, the command will display that
-buffer. Otherwise, it will load the manual and display it. This is
-handy if you have many manuals in many Info buffers, and don't
-remember the name of the buffer visiting the manual you want to
-consult.
+*** New command M-x info-display-manual displays a named Info manual.
+If that manual is already visited in some Info buffer, it displays
+that buffer. (This is handy if you have many manuals in many *info*
+buffers, and don't remember the name of the buffer visiting the manual
+you want to consult.) Otherwise, it loads and displays the manual.
+
+*** `e' is now bound to `end-of-buffer' rather than to `Info-edit'.
+This is for compatibility with the stand-alone Info reader program,
+and also because `Info-edit' is a rarely used command that is disabled
+by default.
+
+** Mail mode changes (not Message mode)
+
+*** New command M-x mail-add-attachment for adding MIME attachments
-** The Landmark game is now invoked with `landmark', not `lm'.
+*** The command M-x mail-attach-file was renamed to M-x mail-insert-file.
+(Its name is misleading, since it has nothing to do with MIME
+attachments.) The old name is now an obsolete alias to the new name.
-** MH-E has been upgraded to MH-E version 8.3.1.
+** MH-E has been updated to MH-E version 8.3.1.
See MH-E-NEWS for details.
** Modula-2 mode provides auto-indentation.
** mpc.el: Can use pseudo tags of the form tag1|tag2 as a union of two tags.
+** nXML mode no longer binds C-RET to `nxml-complete'.
+Completion is now performed via `completion-at-point', bound to C-M-i
+or M-TAB. If `nxml-bind-meta-tab-to-complete-flag' is non-nil (the
+default), this performs tag completion.
+
+** Org mode has been updated to version 7.8.09.
+See ORG-NEWS for details.
+
** Prolog mode has been completely revamped, with lots of additional
-functionality such as more intelligent indentation, electricity, support for
-more variants, including Mercury, and a lot more.
+functionality such as more intelligent indentation, electricity,
+support for more variants, including Mercury, and a lot more.
** Rmail
*** The command `rmail-epa-decrypt' decrypts OpenPGP data
in the Rmail incoming message.
----
*** The variable `rmail-message-filter' no longer has any effect.
This change was made in Emacs 23.1 but was not advertised at the time.
Try using `rmail-show-message-hook' instead.
** Shell mode
-*** Shell mode uses pcomplete rules, with the standard completion UI.
+*** M-x shell prompts for the shell path name if the default directory
+is a remote file name and neither the environment variable $ESHELL nor
+the variable `explicit-shell-file-name' is set.
-*** The `shell' command prompts for the shell path name if the default
-directory is a remote file name and neither the environment variable
-$ESHELL nor the variable `explicit-shell-file-name' is set.
+*** TAB is now bound to the standard `completion-at-point' command,
+which now implements the pcomplete rules for shell command completion.
-*** New variable `shell-dir-cookie-re'.
-If set to an appropriate regexp, Shell mode can track your cwd by
-reading it from your prompt.
+** SMTPmail
----
-** SQL Mode enhancements.
+*** SMTPmail now uses encrypted connections (via STARTTLS) by default
+if the mail server supports them. This uses either built-in GnuTLS
+support, or the starttls.el library. Customize `smtpmail-stream-type'
+to change this.
-*** `sql-dialect' is an alias for `sql-product'.
+*** The variable `smtpmail-auth-credentials' has been removed.
+By default, the information is now stored in the file ~/.authinfo.
+This was the default value of smtpmail-auth-credentials. If you had
+customized smtpmail-auth-credentials to a list of user names and
+passwords, those settings are not used. During your first connection
+to the smtp server, Emacs will prompt for the user name and password,
+and offer to save them to ~/.authinfo. Or you can manually copy the
+credentials to ~/.authinfo. For example, if you had
-*** New variable `sql-port' specifies the port number for connecting
-to a MySQL or Postgres server.
+ (setq smtpmail-auth-credentials
+ '(("mail.example.org" 25 "jim" "s!cret")))
+
+then the equivalent line in ~/.authinfo would be
+
+ machine mail.example.org port 25 login jim password s!cret
+
+See the auth-source manual for more information, e.g. on encrypting
+the credentials file.
+
+*** The variable `smtpmail-starttls-credentials' has been removed.
+If you had that set, you need to put
+
+ machine smtp.whatever.foo port 25 key "~/.my_smtp_tls.key" cert "~/.my_smtp_tls.cert"
+
+in your ~/.authinfo file instead.
+
+*** SMTPmail defaults to using the address in the From: header as the
+SMTP MAIL FROM envelope. To override this, set `mail-envelope-from'
+to the address you wish to use instead.
+
+** SQL mode
+
+*** New options `sql-port', `sql-connection-alist', `sql-send-terminator',
+and `sql-oracle-scan-on'.
+
+*** New options controlling prompting for login parameters.
+Each supported product has a custom variable `sql-*-login-params',
+which is a list of the parameters to be prompted for before a
+connection is established.
*** The command `sql-product-interactive' now takes a prefix argument,
-which causes it to prompt for an SQL product instead of the current
-value of `sql-product'.
+which causes it to prompt for an SQL product.
-*** Product-specific SQL interactive commands now take prefix args.
+*** Product-specific SQL interactive commands now take prefix arguments.
These commands (`sql-sqlite', `sql-postgres', `sql-mysql', etc.),
given a prefix argument, prompt for a name for the SQL interactive
buffer. This reduces the need for calling `sql-rename-buffer'.
@@ -775,19 +1835,8 @@ buffer. This reduces the need for calling `sql-rename-buffer'.
replace tabs with spaces. The first change impacts multiple line SQL
statements entered with C-j between each line, statements yanked into
the buffer and statements sent with `sql-send-*' functions. The
-second change prevents the MySQL and Postgres interpreters from
-listing object name completions when sent text via `sql-send-*'
-functions.
-
-*** New custom variables control prompting for login parameters.
-Each supported product has a custom variable `sql-*-login-params',
-which is a list of the parameters to be prompted for before a
-connection is established.
-
-*** New variable `sql-connection-alist' for login parameter values.
-This can be used to store different username, database and server
-values. Connections defined in this variable appear in the submenu
-SQL->Start... for making new SQLi sessions.
+second prevents the MySQL and Postgres interpreters from listing
+object name completions when sent text via `sql-send-*' functions.
*** New command `sql-connect' starts a predefined SQLi session,
using the login parameters from `sql-connection-alist'.
@@ -796,21 +1845,8 @@ using the login parameters from `sql-connection-alist'.
This gathers the login params specified for the SQLi session, if it
was not started by a connection, and saves them as a new connection.
-*** Commands for listing database objects and details.
-In an SQLi session, you can get a list of objects in the database.
-The contents of these lists are product specific.
-
-**** `C-c C-l a' or the "SQL->List all objects" menu item
-lists all the objects in the database. With a prefix argument, it
-displays additional details or extend the listing to include other
-schemas objects.
-
-**** `C-c C-l t' or the "SQL->List Table details" menu item
-prompts for the name of a database table or view and displays the list
-of columns in the relation. With a prefix argument, it displays
-additional details about each column.
-
-*** New options `sql-send-terminator' and `sql-oracle-scan-on'.
+*** New commands for listing database objects and details:
+sql-list-all and sql-list-table.
*** An API for manipulating SQL product definitions has been added.
@@ -819,88 +1855,93 @@ additional details about each column.
*** latex-electric-env-pair-mode keeps \begin..\end matched on the fly.
** Tramp
----
-*** There exists a new inline access method "ksu" (kerberized su).
----
+
+*** New inline access method "ksu" (kerberized su).
+
*** The following access methods are discontinued: "ssh1_old",
"ssh2_old", "scp1_old", "scp2_old", "imap", "imaps" and "fish".
----
+
+*** The user option `remote-file-name-inhibit-cache' controls whether
+remote file attributes are cached for better performance.
+
*** The option `ange-ftp-binary-file-name-regexp' has changed its
default value to "".
-** `url-queue-retrieve' downloads web pages asynchronously, but allow
-controlling the degree of parallelism.
+*** Handlers for `file-selinux-context' and `set-file-selinux-context'
+for remote machines which support SELinux.
+
+** New function `url-queue-retrieve', which behaves like url-retrieve,
+but with limits (`url-queue-parallel-processes', `url-queue-timeout') on
+the degree of parallelism.
** VC and related modes
-+++
*** Support for pulling on distributed version control systems.
-`C-x v +' (`vc-pull') runs a "pull" operation, if it is supported, to
-update the current branch and working tree. A prefix argument means
-to prompt the user for specifics, e.g. a pull location.
-
-**** `vc-update' is now an alias for `vc-pull'.
+The command C-x v + (`vc-pull') runs a "pull" operation, if it is
+supported (currently with Bzr, Git, and Mercurial), to update the
+current branch and working tree. A prefix argument means to prompt
+the user for specifics, e.g. a pull location.
-**** Currently supported by Bzr, Git, and Mercurial.
+*** `vc-update' is now an alias for `vc-pull'.
-+++
*** Support for merging on distributed version control systems.
-The vc-merge command now runs a "merge" operation, if it is supported,
-to merge changes from another branch into the current one. It prompts
-for specifics, e.g. a merge source.
+The command C-x v m (`vc-merge') now runs a "merge" operation, if it
+is supported (currently with Bzr, Git, and Mercurial), to merge
+changes from another branch into the current one. It prompts for
+specifics, e.g. a merge source.
-**** Currently supported for Bzr, Git, and Mercurial.
-
-+++
*** New option `vc-revert-show-diff' controls whether `vc-revert'
shows a diff while querying the user. It defaults to t.
-+++
*** Log entries in some Log View buffers can be toggled to display a
longer description by typing RET (log-view-toggle-entry-display).
-In the Log View buffers made by `C-x v L' (vc-print-root-log), you can
+This is currently supported for Bzr, Git, and Mercurial (to support
+another backend, define a `log-view-expanded-log-entry-function').
+In the Log View buffers made by C-x v L (`vc-print-root-log'), you can
use this to display the full log entry for the revision at point.
-**** Currently supported for Bzr, Git, and Mercurial.
-
-**** Packages using Log View mode can enable this functionality by
-binding `log-view-expanded-log-entry-function' to a suitable function.
-
-+++
*** New command `vc-ediff' allows visual comparison of two revisions
of a file similar to `vc-diff', but using ediff backend.
-+++
*** The option `vc-initial-comment' was removed in Emacs 23.2, but
this was not advertised at the time.
-+++
*** `vc-toggle-read-only' is an obsolete alias for `toggle-read-only'.
Since Emacs 23, it has done the same thing as `toggle-read-only', but
this was not advertised at the time.
-** FIXME: xdg-open for browse-url and reportbug, 2010/08.
-
** Obsolete modes
-*** partial-completion-mode is obsolete.
+*** abbrevlist.el
+
+*** erc-hecomplete.el (use erc-pcomplete.el instead)
+
+*** partial-completion-mode (complete.el) is obsolete.
You can get a comparable behavior with:
(setq completion-styles '(partial-completion initials))
(setq completion-pcm-complete-word-inserts-delimiters t)
-*** pc-mode.el is obsolete.
+*** pc-mode.el is obsolete (CUA mode is much more comprehensive).
+
+*** pgg is obsolete (use EasyPG instead).
*** sregex.el is obsolete, since rx.el is a strict superset.
-*** s-region.el and pc-select are obsolete.
-They are superseded by shift-select-mode enabled by default in 23.1.
+*** s-region.el and pc-select.el are obsolete.
+They are superseded by shift-select-mode, enabled by default since 23.1.
+
+*** vc-mcvs.el is obsolete (for lack of a maintainer).
** Miscellaneous
-+++
+*** The Landmark game is now invoked with `landmark', not `lm'.
+Its functions and variables have been similarly renamed.
+
+*** In `ido-file-completion-map', C-v is no longer bound to `ido-toggle-vc'.
+(This interfered with cua-mode.)
+
*** f90.el has some support for Fortran 2008 syntax.
----
*** `copyright-fix-years' can optionally convert consecutive years to ranges.
*** New command `nato-region' converts text to NATO phonetic alphabet.
@@ -908,12 +1949,21 @@ They are superseded by shift-select-mode enabled by default in 23.1.
* New Modes and Packages in Emacs 24.1
-+++
** Occur Edit mode applies edits made in *Occur* buffers to the
original buffers. It is bound to "e" in Occur mode.
-** New global minor modes electric-pair-mode, electric-indent-mode,
-and electric-layout-mode.
+** New global minor mode electric-pair-mode.
+When enabled, typing an open parenthesis automatically inserts the
+matching closing one.
+
+** New global minor mode electric-indent-mode.
+When enabled, typing certain characters triggers reindentation.
+Major modes wishing to use this can set electric-indent-chars or
+electric-indent-functions.
+
+** New global minor mode electric-layout-mode.
+When enabled, typing certain characters automatically inserts newlines.
+Major modes wishing to use this can set electric-layout-rules.
** tabulated-list.el provides a generic major mode for tabulated data,
from which other modes can be derived.
@@ -932,97 +1982,150 @@ Notifications API. It requires D-Bus for communication.
** soap-client.el supports access to SOAP web services from Emacs.
soap-inspect.el is an interactive inspector for SOAP WSDL structures.
-** xmodmap-generic-mode for xmodmap files.
+** New generic mode, xmodmap-generic-mode, for xmodmap files.
** New emacs-lock.el package.
-(The pre-existing one has been renamed to old-emacs-lock.el and moved
-to obsolete/.) Now, Emacs Lock is a proper minor mode
-`emacs-lock-mode'. Protection against exiting Emacs and killing the
-buffer can be set separately. The mechanism for auto turning off
-protection for buffers with inferior processes has been generalized.
+The previous version has been moved to obsolete/old-emacs-lock.el.
+Now, there is a proper minor mode `emacs-lock-mode'. Protection
+against exiting Emacs and killing the buffer can be set separately.
+The mechanism for automatically turning off protection for buffers
+with dead inferior processes has been generalized.
* Incompatible Lisp Changes in Emacs 24.1
----
-** `char-direction-table' and the associated function `char-direction'
-were deleted. They were buggy and inferior to the new support of
-bidirectional editing introduced in Emacs 24. If you need the
-bidirectional properties of a character, use `get-char-code-property'
-with the last argument `bidi-class'.
+** Passing a nil argument to a minor mode function call now ENABLES
+the minor mode unconditionally. This is so that you can write e.g.
+
+ (add-hook 'text-mode-hook 'foo-mode)
+
+to enable foo-mode in Text mode buffers, removing the need for
+`turn-on-foo-mode' style functions. This affects all mode commands
+defined by `define-minor-mode'. If called interactively, the mode
+command still toggles the minor mode.
+
+** The return value of `backup-buffer' has changed.
+It is now a list of three elements, where the second element is a list
+describing the original file's SELinux context. If Emacs or the
+system lacks SELinux support, the context list is (nil nil nil nil).
+See "Basic SELinux support" above, under "Changes in Emacs 24.1".
+
+** `char-direction-table' and the `char-direction' function were deleted.
+They were buggy and inferior to the new support of bidirectional
+editing introduced in Emacs 24. If you need the bidirectional
+properties of a character, use `get-char-code-property' with the last
+argument `bidi-class'.
-+++
** `copy-directory' now copies the source directory as a subdirectory
of the target directory, if the latter is an existing directory. The
new optional arg COPY-CONTENTS, if non-nil, makes the function copy
the contents directly into a pre-existing target directory.
-** `compose-mail' now accepts an optional 8th arg, RETURN-ACTION, and
-passes it to the mail user agent function. This argument specifies an
-action for returning to the caller after finishing with the mail.
-This is currently used by Rmail to delete a mail window.
-
** For mouse click input events in the text area, the Y pixel
coordinate in the POSITION list now counts from the top of the text
area, excluding any header line. Previously, it counted from the top
of the header line.
-** Removed obsolete name `e' (use `float-e' instead).
+** Support for "old-style" backquotes, obsolete for 10+ years, has
+been further reduced. Now a backquote not followed by a space is
+always treated as a "new-style" backquote. Please remove all
+"old-style" backquotes from your code. If your code uses backquotes
+as documented in the Elisp manual, and compiles without warning, then
+you have nothing to do in this regard. Code not following the
+appropriate conventions may fail to compile.
-** A backquote not followed by a space is now always treated as new-style.
+The most common cause of trouble seems to be an old-style backquote
+followed by a newline. Another cause of trouble is vector notation
+for key sequence notation: instead of [(control ,)] and [(control ')],
+you should write [(control ?,)] and [(control ?')], which will work in
+older Emacsen too.
-** Test for special mode-class was moved from view-file to view-buffer.
-FIXME: This only says what was changed, but not what are the
-programmer-visible consequences.
+** The macro `eval-at-startup' was removed in Emacs 23.2, but this
+was not advertised at the time. The function `custom-initialize-delay'
+replaced all known uses.
-** Passing a nil argument to a minor mode function now turns the mode
-ON unconditionally.
+** `view-buffer' now treats special mode-class in the same way that
+`view-file' has since Emacs 22 (i.e. it won't enable View mode if the
+major mode is special).
-+++
-** During startup, Emacs no longer adds entries for `menu-bar-lines'
+** Menu and tool bar changes
+
+*** During startup, Emacs no longer adds entries for `menu-bar-lines'
and `tool-bar-lines' to `default-frame-alist' and `initial-frame-alist'.
With these alist entries omitted, `make-frame' checks the value of the
variable `menu-bar-mode'/`tool-bar-mode' to determine whether to create
a menu-bar or tool-bar, respectively. If the alist entries are added,
they override the value of `menu-bar-mode'/`tool-bar-mode'.
-+++
-** Regions created by mouse dragging are now normal active regions,
-similar to the ones created by shift-selection. In previous Emacs
-versions, these regions were delineated by `mouse-drag-overlay', which
-has now been removed.
+*** The menu bar bindings's caches are not used any more.
+Use (where-is-internal <def> nil t) instead.
-** cl.el no longer provides `cl-19'.
+** Regions created by mouse dragging are now normal active regions,
+similar to those created by shift-selection (see Selection changes
+above). In previous Emacs versions, these regions were delineated by
+`mouse-drag-overlay'; that variable has been removed.
-** The menu bar bindings's caches are not used any more.
-Use (where-is-internal <def> nil t) instead.
+** The fourth argument of `filter-buffer-substring' has been removed.
+If you want to remove text properties from the final result, simply
+pass the result through substring-no-properties.
-** The following obsolete functions and aliases were removed:
-comint-kill-output, decompose-composite-char, outline-visible,
-internal-find-face, internal-get-face, frame-update-faces,
-frame-update-face-colors, x-frob-font-weight, x-frob-font-slant,
-x-make-font-bold, x-make-font-demibold, x-make-font-unbold
-x-make-font-italic, x-make-font-oblique, x-make-font-unitalic
-x-make-font-bold-italic, mldrag-drag-mode-line, mldrag-drag-vertical-line,
-iswitchb-default-keybindings, char-bytes, isearch-return-char,
-make-local-hook
+** cl.el no longer provides `cl-19'.
-** The following obsolete variables and varaliases were removed:
-checkdoc-minor-keymap, vc-header-alist, directory-sep-char, and
-font-lock-defaults-alist.
+** The following obsolete functions and aliases have been removed
+(the appropriate new function is given in parentheses; "not needed"
+means you can just remove all calls to the function in question):
+
+*** `comint-kill-output' (`comint-delete-output')
+*** `decompose-composite-char' (`char-to-string')
+*** `outline-visible' (`outline-invisible-p')
+*** `internal-find-face' (`facep')
+*** `internal-get-face' (`facep and check-face')
+*** `frame-update-faces' (not needed)
+*** `frame-update-face-colors' (`frame-set-background-mode')
+*** `x-frob-font-weight' and `x-frob-font-slant' (`make-face-*' functions)
+*** `x-make-font-bold and x-make-font-demibold (`make-face-bold')
+*** `x-make-font-italic' and `x-make-font-oblique' (`make-face-italic')
+*** `x-make-font-bold-italic' (`make-face-bold-italic')
+*** `x-make-font-unbold' (`make-face-unbold')
+*** `x-make-font-unitalic' (`make-face-unitalic')
+*** `mldrag-drag-mode-line' (`mouse-drag-mode-line')
+*** `mldrag-drag-vertical-line' (`mouse-drag-vertical-line')
+*** `iswitchb-default-keybindings' (`iswitchb-mode')
+*** `char-bytes' (== 1)
+*** `isearch-return-char' (`isearch-printing-char')
+*** `make-local-hook' (not needed)
+*** `set-screen-height' (`set-frame-height')
+*** `set-screen-width' (`set-frame-width')
+
+** The following obsolete variables and varaliases have been removed
+(the appropriate new variable is given in parentheses):
+
+*** `checkdoc-minor-keymap' (`checkdoc-minor-mode-map')
+*** `vc-header-alist' (`vc-BACKEND-header')
+*** `directory-sep-char' (== ?/)
+*** `font-lock-defaults-alist' (`font-lock-defaults')
+*** `e' (`float-e').
** The following obsolete files were removed:
sc.el, x-menu.el, rnews.el, rnewspost.el
-** FIXME finder-inf.el changes.
+** The format of the finder-inf.el file has changed, since the Finder
+mechanism is now based on the package system. The variable
+`finder-package-info' is replaced by `package--builtins' and
+`finder-keywords-hash'.
+
+** When generating autoloads, `update-directory-autoloads' no longer
+assumes every inspected file is in your `load-path'. It instead
+generates relative names according to the current `load-path'.
* Lisp changes in Emacs 24.1
** Code can now use lexical scoping by default instead of dynamic scoping.
-The `lexical-binding' variable lets code use lexical scoping for local
-variables. It is typically set via file-local variables, in which case it
-applies to all the code in that file.
+The `lexical-binding' variable enables lexical scoping for local
+variables. It is typically set via a file-local variable in the first
+line of the file, in which case it applies to all the code in that
+file.
*** `eval' takes a new optional argument `lexical' to choose the new lexical
binding instead of the old dynamic binding mode.
@@ -1032,98 +2135,99 @@ of function value which looks like (closure ENV ARGS &rest BODY).
*** New macro `letrec' to define recursive local functions.
+*** `defvar' and `defconst' now mark the variable as special (dynamic).
+So do `defcustom' and other forms that call `defvar' as a subroutine.
+
*** New function `special-variable-p' to check whether a variable is
declared as dynamically bound.
+*** The form ((lambda ...) ...) is deprecated.
+
** An Emacs Lisp testing tool is now included.
Emacs Lisp developers can use this tool to write automated tests for
their code. See the ERT info manual for details.
** Changes for bidirectional display and editing
-+++
*** New function `current-bidi-paragraph-direction'.
-This returns the actual value of base direction of the paragraph at
-point.
+This returns the base direction of the paragraph at point.
-+++
*** New function `bidi-string-mark-left-to-right'.
-Given a string containing characters from right-to-left (RTL) scripts,
-this function returns another string which can be safely inserted into
-a buffer, such that any following text will be always displayed to the
-right of that string. (This works by appending the Unicode
-"LEFT-TO-RIGHT MARK" character when the argument string might need that.)
+Given a string containing characters from right-to-left scripts, this
+function returns another string which can be safely inserted into a
+buffer, such that any following text will be always displayed to the
+right of that string. (This works by appending an invisible Unicode
+"LEFT-TO-RIGHT MARK" character if the argument string might need it.)
-This is useful when the buffer has overall left-to-right (LTR)
-paragraph direction and you need to insert a string whose contents and
-directionality are not known in advance, without disrupting the layout
-of the line.
+This is useful when the buffer has overall left-to-right paragraph
+direction and you need to insert a string whose contents are not known
+in advance, without disrupting the layout of the line.
** Window changes
-+++
+
*** Window tree functions are accessible in Elisp.
Functions are provided to return the parent, siblings or child windows
of any window including internal windows (windows not associated with a
buffer) in the window tree.
-+++
+
**** New function `window-valid-p' gives non-nil for live and internal
windows.
-+++
+
**** Window manipulation can deal with internal windows.
Many window handling functions like `split-window', `delete-window', or
`delete-other-windows' as well as the window resizing functions can now
act on any window including internal ones.
-+++
+
*** window-total-height/-width vs window-body-height/-width.
The function `window-height' has been renamed to `window-total-height'
and `window-width' has been renamed to `window-body-width'. The old
names are provided as aliases. Two new functions `window-total-width'
and `window-body-height' are provided.
-+++
+
*** Window parameters specific to window handling functions.
For each window you can specify a parameter to override the default
behavior of a number of functions like `split-window', `delete-window'
and `delete-other-windows'. The variable `ignore-window-parameters'
allows to ignore processing such parameters.
-+++
+
*** New semantics of third argument of `split-window'.
The third argument of `split-window' has been renamed to SIDE and can be
set to any of the values 'below, 'right, 'above, or 'left to make the
new window appear on the corresponding side of the window that shall be
split. Any other value of SIDE will cause `split-window' to split the
window into two side-by-side windows as before.
-+++
+
*** Window resizing functions.
A new standard function for resizing windows called `window-resize' has
been introduced. This and all other functions for resizing windows no
longer delete any windows when they become too small.
-+++
+
*** Deleting the selected window now selects the most recently selected
live window on that frame instead.
-+++
+
*** `adjust-window-trailing-edge' adjustments.
`adjust-window-trailing-edge' can now deal with fixed-size windows and
is able to resize other windows if a window adjacent to the trailing
edge cannot be shrunk any more. This makes its behavior more similar to
that of Emacs 21 without compromising, however, its inability to delete
windows which was introduced in Emacs 22.
-+++
+
*** Window-local buffer lists.
Windows now have local buffer lists. This means that removing a buffer
from display in a window will preferably show the buffer previously
shown in that window with its previous window-start and window-point
positions. This also means that the same buffer may be automatically
shown twice even if it already appears in another window.
-+++
+
*** `switch-to-buffer' has a new optional argument FORCE-SAME-WINDOW,
which if non-nil requires the buffer to be displayed in the currently
selected window, signaling an error otherwise. If nil, another window
can be used, e.g. if the selected one is strongly dedicated.
-+++
+
*** `split-window-vertically' and `split-window-horizontally' renamed
to `split-window-below' and `split-window-right' respectively.
The old names are kept as aliases.
-+++
+
*** Display actions
**** The second arg to `display-buffer' and `pop-to-buffer' is now
@@ -1141,27 +2245,21 @@ are user-customizable variables.
See the docstring of `display-buffer' for details.
-+++
-*** New behavior of `quit-window'.
-The behavior of `quit-window' has been changed in order to restore the
-state before the last buffer display operation in that window.
-
-+++
-*** The new option `frame-auto-hide-function' lets you choose between
-iconifying or deleting a frame when burying a buffer shown in a dedicated
-frame or quitting a window showing a buffer in a frame of its own.
+*** New functions `window-state-get' and `window-state-put'.
+These functions allow to save and restore the state of an arbitrary
+frame or window as an Elisp object.
** Completion
-*** New variable completion-extra-properties used to specify extra properties
-of the current completion:
+*** New variable `completion-extra-properties' used to specify extra
+properties of the current completion:
- :annotate-function, same as the old completion-annotate-function.
- :exit-function, function to call after completion took place.
-*** Functions on completion-at-point-functions can return any of the properties
-valid for completion-extra-properties.
+*** Functions on `completion-at-point-functions' can return any of the
+properties valid for `completion-extra-properties'.
-*** completion-annotate-function is obsolete.
+*** `completion-annotate-function' is obsolete.
*** New `metadata' method for completion tables. The metadata thus returned
can specify various details of the data returned by `all-completions':
@@ -1171,60 +2269,75 @@ can specify various details of the data returned by `all-completions':
- `display-sort-function' to specify how to sort entries in *Completions*.
- `cycle-sort-function' to specify how to sort entries when cycling.
-*** minibuffer-local-filename-must-match-map is not used any more.
-Instead, the bindings in minibuffer-local-filename-completion-map are
-combined with minibuffer-local-must-match-map.
+*** `minibuffer-local-filename-must-match-map' is not used any more.
+Instead, the bindings in `minibuffer-local-filename-completion-map'
+are combined with `minibuffer-local-must-match-map'.
*** New variable `completing-read-function' allows overriding the
behavior of `completing-read'.
-+++
** `glyphless-char-display' can now distinguish between graphical and
text terminal display, via a char-table entry that is a cons cell.
-** `open-network-stream' can now be used to open an encrypted stream.
-It now accepts an optional `:type' parameter for initiating a TLS
-connection, directly or via STARTTLS. To do STARTTLS, additional
-parameters (`:end-of-command', `:success', `:capabilities-command')
-must also be supplied.
-
-+++
-** pre/post-command-hook are not reset to nil upon error.
+** `pre-command-hook'/`post-command-hook' are not reset to nil on error.
Instead, the offending function is removed.
** New hook types
*** New function `run-hook-wrapped' for running an abnormal hook by
passing the hook functions as arguments to a "wrapping" function.
-+++
+Like `run-hook-with-args-until-success', it stops at the first
+non-nil return value.
+
*** New macro `with-wrapper-hook' for running an abnormal hook as a
set of "wrapping" filters, similar to around advice.
+(A version of this macro was actually added in Emacs 23.2 but was not
+advertised at the time.)
-** `server-eval-at' is provided to allow evaluating forms on different
-Emacs server instances.
+** Debugger changes
-** `call-process' allows a `(:file "file")' spec to redirect STDOUT to
-a file.
+*** New macro `condition-case-unless-debug' (this was actually added in
+Emacs 23.1 as condition-case-no-debug, but not advertised)
----
-** Variable `stack-trace-on-error' removed.
-Also the debugger can now "continue" from an error, which means it will jump
-to the error handler as if the debugger had not been invoked instead of
-jumping all the way to the top-level.
+*** The macro `with-demoted-errors' was added in Emacs 23.1, but not advertised.
-+++
-** The function format-time-string now supports the %N directive, for
-higher-resolution time stamps.
+*** Variable `stack-trace-on-error' removed.
+
+*** The debugger can now "continue" from an error, which means it will
+jump to the error handler as if the debugger had not been invoked
+instead of jumping all the way to the top-level.
+
+*** Set `debug-on-event' to enter the debugger on events like SIGUSR1.
+This can be useful when `inhibit-quit' is set.
+
+** The new function `server-eval-at' allows evaluation of Lisp forms on
+named Emacs server instances.
+
+** `call-process' and `call-process-region' allow a `(:file "file")' spec
+to redirect STDOUT to a file.
+
+** The function `format-time-string' now supports the %N directive,
+for higher-resolution time stamps.
+
+** New input reading functions
+
+*** New function `read-char-choice' reads a restricted set of
+characters, discarding any inputs not inside the set.
-** New function `read-char-choice' reads a restricted set of characters,
-discarding any inputs not inside the set.
+*** The command `read-color' now requires a match for a color name
+or RGB triplet, instead of signaling an error if the user provides
+invalid input.
+
+**** `facemenu-read-color' is now an alias for `read-color'.
** `image-library-alist' is renamed to `dynamic-library-alist'.
The variable is now used to load all kind of supported dynamic libraries,
not just image libraries. The previous name is still available as an
obsolete alias.
-** New variable `syntax-propertize-function'.
+** Syntax parsing changes
+
+*** New variable `syntax-propertize-function'.
This replaces `font-lock-syntactic-keywords' which is now obsolete.
This allows syntax-table properties to be set independently from font-lock:
just call syntax-propertize to make sure the text is propertized.
@@ -1234,15 +2347,17 @@ syntax-propertize-via-font-lock to reuse old font-lock-syntactic-keywords
as-is; and syntax-propertize-rules which provides a new way to specify
syntactic rules.
-** New hook post-self-insert-hook run at the end of self-insert-command.
+*** Syntax tables support a new "comment style c" additionally to style b.
-+++
-** Syntax tables support a new "comment style c" additionally to style b.
+** New hook `post-self-insert-hook', run after `self-insert-command'.
** frame-local variables cannot be let-bound any more.
** Major and minor mode changes
-+++
+
+*** `set-auto-mode' now respects mode: local variables at the end of files,
+as well as those in the -*- line.
+
*** `prog-mode' is a new major mode from which programming modes
should be derived.
@@ -1253,21 +2368,20 @@ on-the-fly spell checking for comments and strings.
*** New hook `change-major-mode-after-body-hook', run by
`run-mode-hooks' just before any other mode hooks.
-*** Enabled globalized minor modes can be disabled in specific modes,
-by running (FOO-mode-hook 0) via a mode hook.
+*** Enabled globalized minor modes can be disabled in specific major modes.
+If the global mode is global-FOO-mode, then run (FOO-mode -1) in the
+major mode's hook, where FOO-mode toggles the mode on a per-buffer basis.
-*** `define-minor-mode' accepts a new keyword :variable.
+*** `define-minor-mode' accepts new keywords :variable, :after-hook.
-+++
-** `delete-file' and `delete-directory' now accept optional arg TRASH.
+** File-handling changes
+
+*** `delete-file' and `delete-directory' now accept optional arg TRASH.
Trashing is performed if TRASH and `delete-by-moving-to-trash' are
both non-nil. Interactively, TRASH defaults to t, unless a prefix
argument is supplied (see Trash changes, above).
-** `facemenu-read-color' is now an alias for `read-color'.
-The command `read-color' now requires a match for a color name or RGB
-triplet, instead of signaling an error if the user provides a invalid
-input.
+*** New file predicates: `file-equal-p', `file-in-directory-p'.
** Tool-bars can display separators.
Tool-bar separators are handled like menu separators in menu-bar maps,
@@ -1284,49 +2398,64 @@ i.e. via menu entries of the form `(menu-item "--")'.
**** `image-animate-timer' returns the timer object for an image that
is being animated.
-*** `image-extension-data' is renamed to `image-metadata'.
+*** `image-extension-data' has been renamed to `image-metadata'.
+The old name is an obsolete alias to the new one.
-*** If Emacs is compiled with ImageMagick support (see Startup
-Changes), the function `imagemagick-types' returns a list of image
-file extensions that your installation of ImageMagick supports. The
-function `imagemagick-register-types' enables ImageMagick support for
-these image types, minus those listed in `imagemagick-types-inhibit'.
+*** Image mode can view any image type that ImageMagick supports.
+This requires Emacs to be built with ImageMagick support.
-See the Emacs Lisp Reference Manual for more information.
+**** New function `imagemagick-types', defined if ImageMagick support
+is enabled, returns a list of image file extensions that your
+ImageMagick installation supports.
-** XML and HTML parsing
+**** New function `imagemagick-register-types' enables ImageMagick
+image types in Image mode and in `create-image' and other helper
+functions.
+
+**** New option `imagemagick-types-inhibit' excludes certain
+ImageMagick image types from `imagemagick-register-types'.
-*** If Emacs is compiled with libxml2 support (which is the default),
-two new Emacs Lisp-level functions are defined:
-`libxml-parse-html-region' (which will parse "real world" HTML)
+**** With ImageMagick support, there are extra Image mode commands to
+resize and rotate images: `image-transform-fit-to-height',
+`image-transform-fit-to-width', `image-transform-set-rotation', and
+`image-transform-set-scale'.
+
+** `compose-mail' now accepts an optional 8th arg, RETURN-ACTION, and
+passes it to the mail user agent function. This argument specifies an
+action for returning to the caller after finishing with the mail. For
+example, this is used by Rmail to optionally delete a mail window.
+
+** XML and HTML parsing
+If Emacs is compiled with libxml2 support, there are two new
+functions: `libxml-parse-html-region' (which parses "real world" HTML)
and `libxml-parse-xml-region' (which parses XML). Both return an
Emacs Lisp parse tree.
-FIXME: These should be front-ended by xml.el.
-
-** GnuTLS
+** Networking and encryption changes
-*** Emacs can be compiled with libgnutls support
-This is the default. You will then be able to use the functionality
-in gnutls.el, namely the `open-gnutls-stream' and `gnutls-negotiate'
-functions. It's easiest to use these functions through
-`open-network-stream' because it can upgrade connections through
-STARTTLS opportunistically or use plain SSL, depending on your needs.
+*** `open-network-stream' can now be used to open an encrypted stream.
+It now accepts an optional `:type' parameter for initiating a TLS
+connection, directly or via STARTTLS. To do STARTTLS, additional
+parameters (`:end-of-command', `:success', `:capabilities-command')
+must also be supplied.
-Only versions 2.8.x and higher or GnuTLS have been tested.
-[FIXME: this statement needs clarifying, given that GnuTLS >= 2.6.6
-is the test used by configure.]
+*** New library gnutls.el.
+The new function `gnutls-available-p' returns non-nil if Emacs is
+built with GnuTLS support. The main entry points are
+`open-gnutls-stream' and `gnutls-negotiate'. It's easiest to use
+these functions through `open-network-stream', because that can
+upgrade connections through STARTTLS opportunistically or use plain
+SSL, depending on your needs. For debugging, set `gnutls-log-level'
+greater than 0.
-*** gnutls-log-level
-Set `gnutls-log-level' higher than 0 to get debug output. 1 is for
-important messages, 2 is for debug data, and higher numbers are as per
-the GnuTLS logging conventions. The output is in *Messages*.
+*** New primitive `secure-hash' that supports many secure hash algorithms:
+md5, sha1, sha2, sha224, sha256, sha384, and sha512. The lisp library
+sha1.el has been removed. The `sha1' feature is provided by default.
** Isearch
*** New hook `isearch-update-post-hook' that runs in `isearch-update'.
-+++
** Progress reporters can now "spin".
The MIN-VALUE and MAX-VALUE arguments of `make-progress-reporter' can
now be nil, or omitted. This makes a "non-numeric" reporter. Each
@@ -1337,27 +2466,34 @@ displayed with a "spinning bar".
** New variable `revert-buffer-in-progress-p' is true while a buffer is
being reverted, even if the buffer has a local `revert-buffer-function'.
-** New variables `delayed-warnings-list' and `delayed-warnings-hook' allow
-deferring warnings until the main command loop is executed.
-
-+++
-** `set-auto-mode' now respects mode: local variables at the end of files,
-as well as those in the -*- line.
+** New variables `delayed-warnings-list' and `delayed-warnings-hook'.
+If delayed-warnings-list is non-nil, the command loop calls
+`delayed-warnings-hook' after `post-command-hook'. At present, this
+is only used by Emacs on some platforms to display warnings during
+startup, which might otherwise not be noticed. This uses the
+functions `display-delayed-warnings' and `collapse-delayed-warnings'.
----
** rx.el has a new `group-n' construct for explicitly numbered groups.
-** keymaps can inherit from multiple parents.
+** New function `make-composed-keymap' that constructs a new keymap
+from multiple input maps. You can use this to make a keymap that
+inherits from multiple maps, eg:
+ (set-keymap-parent newmap (make-composed-keymap othermap parent))
-** `debug-on-event' lets you debug Emacs when stuck because of inhibit-quit.
+** New function `string-prefix-p'.
+(This was actually added in Emacs 23.2 but was not advertised at the time.)
-+++
-** New reader macro ## which stands for the empty symbol.
+** New reader macro ## that stands for the empty symbol.
This means that the empty symbol can now be read back. Also, #: by itself
(when not immediately followed by a possible symbol character) stands for
an empty uninterned symbol.
-** Obsolete functions and variables
+** New math functions `isnan', `copysign', `frexp', `ldexp'.
+
+** The following functions and variables are obsolete:
+
+*** `tooltip-use-echo-area' is obsolete.
+Rather than setting this to t, disable Tooltip mode instead.
*** buffer-substring-filters is obsolete.
Use `filter-buffer-substring-functions' instead.
@@ -1365,30 +2501,36 @@ Use `filter-buffer-substring-functions' instead.
*** `byte-compile-disable-print-circle' is obsolete.
*** `deferred-action-list' and `deferred-action-function' are obsolete.
-+++
+Use `post-command-hook' instead.
+
*** `font-lock-maximum-size' is obsolete.
* Changes in Emacs 24.1 on non-free operating systems
-** New configure.bat option --enable-checking builds Emacs with extra
-runtime checks.
+** On MS Windows, Emacs warns when using the obsolete init file _emacs,
+and also when HOME is set to C:\ by default.
+
+** New configure.bat options
+
+*** --enable-checking builds Emacs with extra runtime checks.
-** New configure.bat option --distfiles to specify files to be
-included in binary distribution.
+*** --distfiles specifies files to be included in binary distribution.
-** New configure.bat option --without-gnutls to disable automatic
-GnuTLS detection.
+*** --without-gnutls disables automatic GnuTLS detection.
-** New configure.bat option --lib for general library linkage, works
-with the USER_LIBS build variable.
+*** --lib for general library linkage, works with the USER_LIBS build variable.
** New make target `dist' to create binary distribution for MS Windows.
-** Function `w32-default-color-map' is now obsolete.
+** The Lisp function `w32-default-color-map' is now obsolete.
+(It is only used internally in the Emacs C code.)
+
+** Customize ns-auto-hide-menu-bar to have the menu-bar hidden, but
+reappear on mouse-over. (Requires OS X 10.6 or later.)
-** On Nextstep/OSX, the menu bar can be hidden by customizing
-ns-auto-hide-menu-bar.
+** On Mac OS X, dragging a file into Emacs visits the file, like on
+other platforms, rather than inserting its contents into the buffer.
----------------------------------------------------------------------
diff --git a/etc/NEWS.1-17 b/etc/NEWS.1-17
index 8b861cca875..7f568ffc1ce 100644
--- a/etc/NEWS.1-17
+++ b/etc/NEWS.1-17
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes. 26-Mar-1986
-Copyright (C) 1985-1986, 2006-2011 Free Software Foundation, Inc.
+Copyright (C) 1985-1986, 2006-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/etc/NEWS.18 b/etc/NEWS.18
index 820103e3110..92454af1013 100644
--- a/etc/NEWS.18
+++ b/etc/NEWS.18
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes. 17-Aug-1988
-Copyright (C) 1988, 2006-2011 Free Software Foundation, Inc.
+Copyright (C) 1988, 2006-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/etc/NEWS.19 b/etc/NEWS.19
index df6c4893f87..54e49484c10 100644
--- a/etc/NEWS.19
+++ b/etc/NEWS.19
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes. 1992.
-Copyright (C) 1993-1995, 2001, 2006-2011 Free Software Foundation, Inc.
+Copyright (C) 1993-1995, 2001, 2006-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -5032,7 +5032,7 @@ if it is `memq' in the list.
** If you call `get-buffer-window' passing t as its second argument, it
will only search for windows on visible frames. Previously, passing t
-as the secord argument caused `get-buffer-window' to search all
+as the second argument caused `get-buffer-window' to search all
frames, visible or not.
** If you call `other-buffer' with a nil or omitted second argument, it
diff --git a/etc/NEWS.20 b/etc/NEWS.20
index 332eec60535..7a76bdd38a9 100644
--- a/etc/NEWS.20
+++ b/etc/NEWS.20
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes. 2006-05-31
-Copyright (C) 1999-2001, 2006-2011 Free Software Foundation, Inc.
+Copyright (C) 1999-2001, 2006-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/etc/NEWS.21 b/etc/NEWS.21
index c018567c40d..6d50b687fae 100644
--- a/etc/NEWS.21
+++ b/etc/NEWS.21
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes. 2006-05-31
-Copyright (C) 2000-2011 Free Software Foundation, Inc.
+Copyright (C) 2000-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -4639,7 +4639,7 @@ simpler form STRING as property value.
*** Variable width and height spaces
To display a space of fractional width or height, use a display
-specification of the form `(LOCATION STRECH)'. If LOCATION is
+specification of the form `(LOCATION STRETCH)'. If LOCATION is
`(margin left-margin)', the space is displayed in the left marginal
area, if it is `(margin right-margin)', it is displayed in the right
marginal area, and if LOCATION is `(margin nil)' the space is
diff --git a/etc/NEWS.22 b/etc/NEWS.22
index 70c7b0e018b..6dd12a7a34f 100644
--- a/etc/NEWS.22
+++ b/etc/NEWS.22
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes.
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
@@ -3035,7 +3035,7 @@ appropriate `sql-interactive-mode' wrapper for the current setting of
** Fortran mode changes
*** F90 mode and Fortran mode have support for `hs-minor-mode' (hideshow).
-It cannot deal with every code format, but ought to handle a sizeable
+It cannot deal with every code format, but ought to handle a sizable
majority.
*** F90 mode and Fortran mode have new navigation commands
diff --git a/etc/NEWS.23 b/etc/NEWS.23
index b9570ee9e29..77ba82c15ad 100644
--- a/etc/NEWS.23
+++ b/etc/NEWS.23
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes.
-Copyright (C) 2007-2011 Free Software Foundation, Inc.
+Copyright (C) 2007-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
@@ -24,12 +24,22 @@ require version 1.14 or later. See README.W32 and nt/INSTALL for
details and pointers to URLs where the latest libpng can be
downloaded.
-
+* Changes in Specialized Modes and Packages in Emacs 23.4
+
+** EDE
+
+*** New variable `ede-project-directories'.
+EDE now refuses to automatically load a project file (Project.ede)
+unless the file is in one of the directories specified by this
+variable. This reduces the risk of inadvertently loading malicious
+project files. The commands `M-x ede-new' and `M-x ede' now offer to
+save directories to `ede-project-directories'.
+
* Changes in Emacs 23.4 on non-free operating systems
** The MS-Windows port can now use more than 500MB of heap.
Depending on the available virtual memory, Emacs on Windows can now
-have up to 2GB of heap space. This allows, e.g., to visit several
+have up to 2GB of heap space. This allows, e.g., visiting several
large (> 256MB) files in the same session.
diff --git a/etc/NEXTSTEP b/etc/NEXTSTEP
index 4aa1dca93f2..6ea431fe982 100644
--- a/etc/NEXTSTEP
+++ b/etc/NEXTSTEP
@@ -1,4 +1,4 @@
-Copyright (C) 2008-2011 Free Software Foundation, Inc.
+Copyright (C) 2008-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
This file contains information about GNU Emacs on "Nextstep" platforms.
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
new file mode 100644
index 00000000000..c6851948368
--- /dev/null
+++ b/etc/ORG-NEWS
@@ -0,0 +1,1432 @@
+ORG NEWS -- history of user-visible changes. -*- org -*-
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+See the end of the file for license conditions.
+
+Please send Org bug reports to emacs-orgmode@gnu.org.
+
+* Version 7.9.2
+
+** New ELPA repository for Org packages
+
+You can now add the Org ELPA repository like this:
+
+#+BEGIN_SRC emacs-lisp
+(add-to-list 'package-archives '("org" . "http://orgmode.org/elpa/") t)
+#+END_SRC
+
+It contains both the =org-*.tar= package (the core Org distribution, also
+available through http://elpa.gnu.org) and the =org-plus*.tar= package (the
+extended Org distribution, with non-GNU packages from the =contrib/=
+directory.)
+
+See http://orgmode.org/elpa/
+
+** Overview of the new keybindings
+
+ | Keybinding | Speedy | Command |
+ |-----------------+--------+-----------------------------|
+ | =C-c C-x C-z= | | [[doc::org-clock-resolve][org-clock-resolve]] |
+ | =C-c C-x C-q= | | [[doc::org-clock-cancel][org-clock-cancel]] |
+ | =C-c C-x C-x= | | [[doc::org-clock-in-last][org-clock-in-last]] |
+ | =M-h= | | [[doc::org-mark-element][org-mark-element]] |
+ | =*= | | [[doc::org-agenda-bulk-mark-all][org-agenda-bulk-mark-all]] |
+ | =C-c C-M-l= | | [[doc::org-insert-all-links][org-insert-all-links]] |
+ | =C-c C-x C-M-v= | | [[doc::org-redisplay-inline-images][org-redisplay-inline-images]] |
+ | =C-c C-x E= | =E= | [[doc::org-inc-effort][org-inc-effort]] |
+ | | =#= | [[doc::org-toggle-comment][org-toggle-comment]] |
+ | | =:= | [[doc::org-columns][org-columns]] |
+ | | =W= | Set =APPT_WARNTIME= |
+ | =k= | | [[doc::org-agenda-capture][org-agenda-capture]] |
+ | C-c , | , | [[doc::org-priority][org-priority]] |
+
+** New package and Babel langage
+
+*** =org-eshell.el= by Konrad Hinsen is now in Org
+
+ =org-eshell.el= allows you to create links from [[http://www.gnu.org/software/emacs/manual/html_node/eshell/index.html][Eshell]].
+
+*** Support for execution of Scala code blocks (see ob-scala.el)
+*** Support for execution of IO code blocks (see ob-io.el)
+
+** Incompatible changes
+
+ - If your code relies on =org-write-agenda=, please use
+ [[doc::org-agenda-write][org-agenda-write]] from now on.
+
+ - If your code relies on =org-make-link=, please use =concat=
+ instead.
+
+ - =org-link-to-org-use-id= has been renamed to
+ =org-id-link-to-org-use-id= and its default value is nil. The
+ previous default was =create-if-interactive-and-no-custom-id=.
+
+** New features and user-visible changes
+
+*** Org Element
+
+ =org-element.el= is a toolbox for parsing and analyzing "elements"
+ in an Org-mode buffer. This has been written by Nicolas Goaziou
+ and has been tested for quite some time. It is now part of Org's
+ core and many core functions rely on this package.
+
+ Two functions might be particularly handy for users:
+ =org-element-at-point= and =org-element-context=.
+
+ See the docstrings for more details.
+
+ Below is a list of editing and navigating commands that now rely
+ on =org-element.el=.
+
+**** [[doc::org-fill-paragraph][org-fill-paragraph]] has been completely rewritten
+
+ The filling mechanisms now rely on org-element, trying to do the
+ right thing on each element in various contexts. E.g. filling in
+ a list item will preserve indentation; filling in message-mode
+ will fall back on the relevant filling functions; etc.
+
+**** [[doc::org-metaup][org-metaup]] and [[doc::org-metadown][org-metadown]] will drag the element backward/forward
+
+ If you want to get the old behavior (i.e. moving a line up and
+ down), you can first select the line as an active region, then
+ =org-metaup= or =org-metadown= to move the region backward or
+ forward. This also works with regions bigger than just one line.
+
+**** [[doc::org-up-element][org-up-element]] and [[doc::org-down-element][org-down-element]] (respectively =C-c C-^= and =C-c C-_=)
+
+ This will move the point up/down in the hierarchy of elements.
+
+**** [[doc::org-backward-element][org-backward-element]] and [[doc::org-forward-element][org-forward-element]] (respectively =M-{= and =M-}=)
+
+ This will move the point backward/forward in the hierarchy of
+ elements.
+
+**** [[doc::org-narrow-to-element][org-narrow-to-element]] will narrow to the element at point
+**** [[doc::org-mark-element][org-mark-element]] will mark the element at point
+
+ This command is bound to =M-h= and will mark the element at
+ point. If the point is at a paragraph, it will mark the
+ paragraph. If the point is at a list item, it will mark the list
+ item. Etc.
+
+ Note that if point is at the beginning of a list, it will mark
+ the whole list.
+
+ To mark a subtree, you can either use =M-h= on the headline
+ (since there is no ambiguity about the element you're at) or
+ [[doc::org-mark-subtree][org-mark-subtree]] (=C-c @=) anywhere in the subtree.
+
+ Invoking [[doc::org-mark-element][org-mark-element]] repeatedly will try to mark the next
+ element on top of the previous one(s). E.g. hitting =M-h= twice
+ on a headline will mark the current subtree and the next one on
+ the same level.
+
+*** Org Agenda
+
+**** New option [[doc::org-agenda-sticky][org-agenda-sticky]]
+
+ There is a new option =org-agenda-sticky= which enables "sticky"
+ agendas. Sticky agendas remain opened in the background so that
+ you don't need to regenerate them each time you hit the
+ corresponding keystroke. This is a big time saver.
+
+ When [[doc::org-agenda-sticky][org-agenda-sticky]] is =non-nil=, the agenda buffer will be
+ named using the agenda key and its description. In sticky
+ agendas, the =q= key will just bury the agenda buffers and
+ further agenda commands will show existing buffer instead of
+ generating new ones.
+
+ If [[doc::org-agenda-sticky][org-agenda-sticky]] is set to =nil=, =q= will kill the single
+ agenda buffer.
+
+**** New option [[doc::org-agenda-custom-commands-contexts][org-agenda-custom-commands-contexts]]
+
+ Setting this option allows you to define specific context where
+ agenda commands should be available from. For example, when set
+ to this value
+
+ #+BEGIN_SRC emacs-lisp
+ (setq org-agenda-custom-commands-contexts
+ '(("p" (in-file . "\\.txt"))))
+#+END_SRC
+
+ then the =p= agenda command will only be available from buffers
+ visiting *.txt files. See the docstring and the manual for more
+ details on how to use this.
+
+**** Changes in bulk actions
+
+ The set of commands starting with =k ...= as been deleted and the
+ features have been merged into the "bulk action" feature.
+
+ After you marked some entries in the agenda, if you call =B s=,
+ the agenda entries will be rescheduled using the date at point if
+ on a date header. If you are on an entry with a timestamp, you
+ will be prompted for a date to reschedule your marked entries to,
+ using the timestamp at point as the default prompt.
+
+ You can now use =k= to capture the marked entry and use the date
+ at point as an overriding date for the capture template.
+
+ To bind this behavior to =M-x org-capture RET= (or its
+ keybinding), set the new option [[doc::org-capture-use-agenda-date][org-capture-use-agenda-date]] to
+ =t=.
+
+**** =N= and =P= in the agenda will move to the next/previous item
+
+**** New command [[doc::org-agenda-bulk-mark-all][org-agenda-bulk-mark-all]] to mark all items
+
+ This new command is bound to =*= in agenda mode.
+
+ There is also a new option [[doc::org-agenda-bulk-mark-char][org-agenda-bulk-mark-char]] to set the
+ character to use as a mark for bulk actions.
+
+**** New option [[doc::org-agenda-persistent-marks][org-agenda-persistent-marks]]
+
+ When set to =non-nil=, marks will remain visible after a bulk
+ action. You can temporarily toggle this by pressing =p= when
+ invoking [[doc::org-agenda-bulk-action][org-agenda-bulk-action]]. Marks are deleted if your
+ rebuild the agenda buffer or move to another date/span (e.g. with
+ =f= or =w=).
+
+**** New option [[doc::org-agenda-skip-timestamp-if-deadline-is-shown][org-agenda-skip-timestamp-if-deadline-is-shown]]
+
+ =Non-nil= means skip timestamp line if same entry shows because
+ of deadline.
+
+ In the agenda of today, an entry can show up multiple times
+ because it has both a plain timestamp and has a nearby deadline.
+ When this variable is t, then only the deadline is shown and the
+ fact that the entry has a timestamp for or including today is not
+ shown. When this variable is =nil=, the entry will be shown
+ several times.
+
+**** New =todo-unblocked= and =nottodo-unblocked= skip conditions
+
+ See the [[http://orgmode.org/w/?p%3Dorg-mode.git%3Ba%3Dcommit%3Bh%3Df426da][git commit]] for more explanations.
+
+**** Allow category filtering in the agenda
+
+ You can now filter the agenda by category. Pressing "<" will
+ filter by the category of the item on the current line, and
+ pressing "<" again will remove the filter. You can combine tag
+ filters and category filters.
+
+ You can use =org-agenda-category-filter= in your custom agenda
+ views and =org-agenda-category-filter-preset= in your main
+ configuration.
+
+ See also the new command [[doc::org-agenda-filter-by-top-category][org-agenda-filter-by-top-category]]:
+ hitting =^= will filter by "Top" category: only show entries that
+ are of the same category than the Top category of the entry at
+ point.
+
+*** Org Links
+
+**** Inserting links
+
+ When inserting links through [[doc::org-insert-link][org-insert-link]], the description is
+ now displayed first, followed by the literal link, as the
+ description is often more useful when you look for the link you
+ want to insert.
+
+ Completion now complete both literal links and description. If
+ you complete a description, the literal link and its description
+ will be inserted directly, whereas when you complete the literal
+ link, you will be prompted for a description (as with Org 7.8.)
+
+ In the completion buffer, links to the current buffer are now
+ highlighted.
+
+**** New templates =%h= and =%(sexp)= for abbreviated links
+
+ On top of =%s= template, which is replaced by the link tag in
+ abbreviated links, you can now use =%h= (which does the same than =%s=
+ but does not hexify the tag) and =%(sexp)= (which can run a function
+ that takes the tag as its own argument.)
+
+**** New link type =help=
+
+ You can now create links from =help= buffers.
+
+ For example, if you request help for the command [[doc::org-agenda][org-agenda]] with
+ =C-h f org-agenda RET=, creating a link from this buffer will let
+ you go back to the same buffer.
+
+**** New command [[doc::org-insert-all-links][org-insert-all-links]]
+
+ This will insert all links as list items. With a universal
+ prefix argument, links will not be deleted from the variable
+ =org-stored-links=.
+
+ This new command is bound to =C-c C-M-l=.
+
+**** New option [[doc::org-url-hexify-p][org-url-hexify-p]]
+
+ When set to =nil=, the =URL= part of a link will not be hexified.
+
+**** Org can now open multiple shell links
+
+**** New option [[doc::org-doi-server-url][org-doi-server-url]] to specify an alternate DOI server
+
+**** RET now follows time stamps links
+
+*** Org Editing
+
+**** [[doc::org-todo][org-todo]] and =org-archive-*= can now loop in the active region
+
+ When [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is =non-nil=, using
+ [[doc::org-todo][org-todo]] or =org-archive-*= commands in the active region will
+ loop over headlines. This is handy if you want to set the TODO
+ keyword for several items, or archive them quickly.
+
+**** You can now set tags for headlines in a region
+
+ If [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is =non-nil=, then
+ selecting the region and hitting =C-c C-q= will set the tags for
+ all headlines in the region.
+
+**** New command [[doc::org-insert-drawer][org-insert-drawer]] to insert a drawer interactively
+
+**** Comments start with "^[ \t]*# " anywhere on a line
+
+ Note that the space after the hashtag is mandatory. Comments
+ with "^#+" are not supported anymore.
+
+**** New speed key =#= to toggle the COMMENT cookie on a headline
+
+**** =indent-region-function= is now set to [[doc::org-indent-region][org-indent-region]]
+
+ =C-M-\= should now produce useful results.
+
+ You can unindent the buffer with [[doc::org-unindent-buffer][org-unindent-buffer]].
+
+**** New option [[doc::org-allow-promoting-top-level-subtree][org-allow-promoting-top-level-subtree]]
+
+ When =non-nil=, =S-M-<left>= will promote level-1 subtrees
+ containing other subtrees. The level-1 headline will be
+ commented out. You can revert to the previous state with =M-x
+ undo RET=.
+
+*** Org Clock
+
+**** New keybinding =C-c C-x C-z= for [[doc::org-clock-resolve][org-clock-resolve]]
+
+**** New keybinding =C-c C-x C-q= for [[doc::org-clock-cancel][org-clock-cancel]]
+
+**** New command [[doc::org-clock-in-last][org-clock-in-last]] to clock in the last clocked item
+
+ This command is bound to =C-c C-x C-x= and will clock in the last
+ clocked entry, if any.
+
+**** =C-u M-x= [[doc::org-clock-out][org-clock-out]] =RET= now prompts for a state to switch to
+
+**** =S-M-<up/down>= on a clock timestamps adjusts the previous/next clock
+
+**** New option [[doc::org-clock-continuously][org-clock-continuously]]
+
+ When set to =nil=, clocking in a task will first try to find the
+ last clocked out task and restart from when that task was clocked
+ out.
+
+ You can temporarily activate continuous clocking with =C-u C-u
+ C-u M-x= [[doc::org-clock-in][org-clock-in]] =RET= (three universal prefix arguments)
+ and =C-u C-u M-x= [[org-clock-in-last][org-clock-in-last]] =RET= (two universal prefix
+ arguments).
+
+
+**** New option [[doc::org-clock-frame-title-format][org-clock-frame-title-format]]
+
+ This option sets the value of =frame-title-format= when clocking
+ in.
+
+**** New options for controlling the clockreport display
+
+ [[doc::org-clock-file-time-cell-format][org-clock-file-time-cell-format]]: Format string for the file time
+ cells in clockreport.
+
+ [[doc::org-clock-total-time-cell-format][org-clock-total-time-cell-format]]: Format string for the total
+ time cells in clockreport.
+
+
+**** New options for controlling the clock/timer display
+
+ [[doc::org-clock-clocked-in-display][org-clock-clocked-in-display]]: control whether the current clock
+ is displayed in the mode line and/or frame title.
+
+ [[doc::org-timer-display][org-timer-display]]: control whether the current timer is displayed
+ in the mode line and/or frame title.
+
+ This allows the clock and timer to be displayed in the frame
+ title instead of, or as well as, the mode line. This is useful
+ for people with limited space in the mode line but with ample
+ space in the frame title.
+
+*** Org Appearance
+
+**** New option [[doc::org-custom-properties][org-custom-properties]]
+
+ The visibility of properties listed in this options can be turn
+ on/off with [[doc::org-toggle-custom-properties-visibility][org-toggle-custom-properties-visibility]]. This might
+ be useful for properties used by third-part tools or that you
+ don't want to see temporarily.
+
+**** New command [[doc::org-redisplay-inline-images][org-redisplay-inline-images]]
+
+ This will redisplay all images. It is bound to =C-c C-x C-M-v=.
+
+**** New entities in =org-entities.el=
+
+ There are these new entities:
+
+ : ("tilde" "\\~{}" nil "&tilde;" "~" "~" "~")
+ : ("slash" "/" nil "/" "/" "/" "/")
+ : ("plus" "+" nil "+" "+" "+" "+")
+ : ("under" "\\_" nil "_" "_" "_" "_")
+ : ("equal" "=" nil "=" "=" "=" "=")
+ : ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^")
+
+**** New face =org-list-dt= for definition terms
+**** New face =org-date-selected= for the selected calendar day
+**** New face value for =org-document-title=
+
+ The face is back to a normal height.
+
+*** Org Columns
+
+**** New speed command =:= to activate the column view
+**** New special property =CLOCKSUM_T= to display today's clocked time
+
+ You can use =CLOCKSUM_T= the same way you use =CLOCKSUM=. It
+ will display the time spent on tasks for today only.
+
+**** Use the =:COLUMNS:= property in columnview dynamic blocks
+
+ If the =:COLUMNS:= is set in a subtree, the columnview dynamic
+ block will use its value as the column format.
+
+**** Consider inline tasks when computing a sum
+
+*** Org Dates and Time Stamps
+
+**** Enhanced [[doc::org-sparse-tree][org-sparse-tree]]
+
+ =C-c /= can now check for time ranges.
+
+ When checking for dates with =C-c /= it is useful to change the
+ type of dates that you are interested in. You can now do this
+ interactively with =c= after =C-c /= and/or by setting
+ [[doc::org-sparse-tree-default-date-type][org-sparse-tree-default-date-type]] to the default value you want.
+
+**** Support for hourly repeat cookies
+
+ You can now use
+
+ : SCHEDULED: <2012-08-20 lun. 08:00 +1h>
+
+ if you want to add an hourly repeater to an entry.
+
+**** =C-u C-u C-c .= inserts a time-stamp with no prompt
+
+**** When (setq [[doc::org-read-date-prefer-future][org-read-date-prefer-future]] 'time), accept days in the prompt
+
+ "8am Wed" and "Wed 8am" are now acceptable values when entering a
+ date from the prompt. If [[doc::org-read-date-prefer-future][org-read-date-prefer-future]] is set to
+ =time=, this will produce the expected prompt indication.
+
+**** New option [[doc::org-datetree-add-timestamp][org-datetree-add-timestamp]]
+
+ When set to =non-nil=, datetree entries will also have a
+ timestamp. This is useful if you want to see these entries in a
+ sparse tree with =C-c /=.
+
+*** Org Capture
+
+**** New command [[doc::org-capture-string][org-capture-string]]
+
+ M-x [[doc::org-capture-string][org-capture-string]] RET will prompt for a string and a capture
+ template. The string will be used as an annotation for the
+ template. This is useful when capturing in batch mode as it lets
+ you define the content of the template without being in Emacs.
+
+**** New option [[doc::org-capture-templates-contexts][org-capture-templates-contexts]]
+
+ Setting this option allows you to define specific context where
+ capture templates should be available from. For example, when
+ set to this value
+
+ #+BEGIN_SRC emacs-lisp
+ (setq org-capture-templates-contexts
+ '(("c" (in-mode . "message-mode"))))
+#+END_SRC
+
+ then the =c= capture template will only be available from
+ =message-mode= buffers. See the docstring and the manual for
+ more details on how to use this.
+
+**** New =%l= template to insert the literal link
+**** New option [[doc::org-capture-bookmark][org-capture-bookmark]]
+
+ Org used to automatically add a bookmark with capture a note.
+ You can now turn this on by setting [[doc::org-capture-bookmark][org-capture-bookmark]] to
+ =nil=.
+
+**** Expand =%<num>= escape sequences into text entered for <num>'th =%^{PROMPT}= escape
+
+ See the manual for more explanations.
+
+**** More control over empty lines
+
+ You can use =:empty-lines-before= and =:empty-lines-after= to
+ control the insertion of empty lines. Check the manual for more
+ explanations.
+
+**** New hook [[doc::org-capture-prepare-finalize-hook][org-capture-prepare-finalize-hook]]
+
+ This new hook runs before the finalization process starts.
+
+*** Org Export
+
+**** New functions =orgtbl-to-table.el= and =orgtbl-to-unicode=
+
+ =orgtbl-to-table.el= convert the table to a =table.el= table, and
+ =orgtbl-to-unicode= will use =ascii-art-to-unicode.el= (when
+ available) to print beautiful tables.
+
+**** [[doc::org-table-export][org-table-export]] now a bit clever about the target format
+
+ When you specify a file name like =table.csv=, [[doc::org-table-export][org-table-export]]
+ will now suggest =orgtbl-to-csv= the default method for exporting
+ the table.
+
+**** New option [[doc::org-export-date-timestamp-format][org-export-date-timestamp-format]]
+
+ The option allows to set a time string format for Org timestamps
+ in the #+DATE option.
+
+**** LaTeX: New options for exporting table rules :tstart, :hline and :tend
+
+ See [[doc::org-export-latex-tables-hline][org-export-latex-tables-hline]] and [[doc::org-export-latex-tables-tend][org-export-latex-tables-tend]].
+
+**** LaTeX: You can now set =:hfmt= from =#+ATTR_LaTeX=
+**** Beamer: Add support and keybinding for the =exampleblock= environment
+
+ Add support for these languages in [[doc::org-export-language-setup][org-export-language-setup]].
+ More languages are always welcome.
+
+**** Beamer: New option [[doc::org-beamer-inherited-properties][org-beamer-inherited-properties]]
+
+ This option allows Beamer export to inherit some properties.
+ Thanks to Carsten for implementing this.
+
+**** ODT: Add support for ODT export in org-bbdb.el
+**** ODT: Add support for indented tables (see [[http://orgmode.org/w/?p%3Dorg-mode.git%3Ba%3Dcommit%3Bh%3De9fd33][this commit]] for details)
+**** ODT: Improve the conversion from ODT to other formats
+**** ASCII: Swap the level-1/level-2 characters to underline the headlines
+**** Support for Chinese, simplified Chinese, Russian, Ukrainian and Japanese
+**** HTML: New option [[doc::org-export-html-date-format-string][org-export-html-date-format-string]]
+
+ Format string to format the date and time in HTML export. Thanks
+ to Sébastien Vauban for this patch.
+
+*** Org Babel
+
+**** New =:results drawer= parameter
+
+=:results drawer= replaces =:results wrap=, which is deprecated but still
+supported.
+
+**** =:results org= now put results in a =#+BEGIN_SRC org= block
+
+=:results org= used to put results in a =#+BEGIN_ORG= block but it now puts
+results in a =#+BEGIN_SRC org= block, with comma-escaped lines.
+
+=#+BEGIN_ORG= blocks are obsolete.
+
+**** Exporting =#+BEGIN_SRC org= blocks exports the code
+
+It used to exports the results of the code.
+
+*** Miscellaneous
+
+**** New menu entry for [[doc::org-refile][org-refile]]
+**** Allow capturing to encrypted entries
+
+If you capture to an encrypted entry, it will be decrypted before
+inserting the template then re-encrypted after finalizing the capture.
+
+**** Inactive timestamps are now handled in tables
+
+Calc can do computation on active time-stamps like <2012-09-29 sat.>.
+Inactive time-stamps in a table's cell are now internally deactivated so
+that Calc formulas can operate on them.
+
+**** [[doc::org-table-number-regexp][org-table-number-regexp]] can now accept comma as decimal mark
+**** Org allows a new property =APPT_WARNTIME=
+
+ You can set it with the =W= speedy key or set it manually. When
+ set, exporting to iCalendar and [[doc::org-agenda-to-appt][org-agenda-to-appt]] will use the
+ value of this property as the number of minutes for the warning
+ alarm.
+
+**** New command [[doc::org-inc-effort][org-inc-effort]]
+
+ This will increment the effort value.
+
+ It is bound to =C-c C-x E= and to =E= as a speedy command.
+
+**** Attach: Add support for creating symbolic links
+
+ =org-attach-method= now supports a new method =lns=, allowing to
+ attach symbolic links.
+
+**** Archive: you can now archive to a datetree
+
+**** New option [[doc::org-inlinetask-show-first-star][org-inlinetask-show-first-star]]
+
+ =Non-nil= means display the first star of an inline task as
+ additional marker. When =nil=, the first star is not shown.
+
+**** New option [[doc::org-latex-preview-ltxpng-directory][org-latex-preview-ltxpng-directory]]
+
+ This lets you define the path for the =ltxpng/= directory.
+
+**** You can now use imagemagick instead of dvipng to preview LaTeX fragments
+**** You can now turn off [[doc::orgstruct++-mode][orgstruct++-mode]] safely
+**** =C-u C-c C-c= on list items to add check boxes
+
+ =C-u C-c C-c= will add an empty check box on a list item.
+
+ When hit from the top of the list, it will add check boxes for
+ all top level list items.
+
+**** =org-list-ending-method= and =org-list-end-regexp= are now obsolete
+
+ Fall back on using =org-list-end-re= only, which see.
+
+**** org-feed.el now expands =%(sexp)= templates
+**** New option [[doc::org-protocol-data-separator][org-protocol-data-separator]]
+
+**** New option [[doc::org-ditaa-jar-option][org-ditaa-jar-option]] to specify the ditaa jar file
+
+**** New possible value for [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]]
+
+ When [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is set to
+ =start-level=, the command will loop over the active region but
+ will only act upon entries that are of the same level than the
+ first headline in the region.
+
+**** New option [[doc::org-habit-show-all-today][org-habit-show-all-today]]
+
+ When set to =t=, show all (even unscheduled) habits on today's
+ agenda.
+
+** Important bug fixes
+
+*** M-TAB on options keywords perform completion correctly again
+
+ If you hit =M-TAB= on keywords like =#+TITLE=, Org will try to
+ perform completion with meaningful values.
+
+*** Add licenses to javascript embedded and external code snippets
+
+ Embedded javascript code produced when exporting an Org file to
+ HTML is now licensed under GPLv3 (or later), and the copyright is
+ owned by the Free Software Foundation, Inc.
+
+ The javascript code for embedding MathJax in the browser mentions
+ the MathJax copyright and the Apache 2.0 license.
+
+ The javascript code for embedding =org-injo.js= in the browser
+ mentions the copyright of Sebastian Rose and the GPLv3 (or later)
+ license.
+
+ =org-export-html-scripts= is now a variable, so that you can adapt
+ the code and the license to your needs.
+
+ See http://www.gnu.org/philosophy/javascript-trap.html for
+ explanations on why these changes were necessary.
+
+* Version 7.8.11
+
+** Incompatible changes
+
+*** Emacs 21 support has been dropped
+
+ Do not use Org mode 7.xx with Emacs 21, use [[http://orgmode.org/org-6.36c.zip][version 6.36c]] instead.
+
+*** XEmacs support requires the XEmacs development version
+
+ To use Org mode 7.xx with XEmacs, you need to run the developer
+ version of XEmacs. We were about to drop XEmacs support entirely,
+ but Michael Sperber stepped in and made changes to XEmacs that
+ made it easier to keep the support. Thanks to Michael for this
+ last-minute save.
+
+*** New keys for TODO sparse trees
+
+ The key =C-c C-v= is now reserved for Org Babel action. TODO
+ sparse trees can still be made with =C-c / t= (all not-done
+ states) and =C-c / T= (specific states).
+
+*** The Agenda =org-agenda-ndays= is now obsolete
+
+ The variable =org-agenda-ndays= is obsolete - please use
+ =org-agenda-span= instead.
+
+ Thanks to Julien Danjou for this.
+
+*** Changes to the intended use of =org-export-latex-classes=
+
+ So far this variable has been used to specify the complete header
+ of the LaTeX document, including all the =\usepackage= calls
+ necessary for the document. This setup makes it difficult to
+ maintain the list of packages that Org itself would like to call,
+ for example for the special symbol support it needs.
+
+ First of all, you can *opt out of this change* in the following
+ way: You can say: /I want to have full control over headers, and I
+ will take responsibility to include the packages Org needs/. If
+ that is what you want, add this to your configuration and skip the
+ rest of this section (except maybe for the description of the
+ =[EXTRA]= place holder):
+
+ #+begin_src emacs-lisp
+ (setq org-export-latex-default-packages-alist nil
+ org-export-latex-packages-alist nil)
+ #+end_src
+
+ /Continue to read here if you want to go along with the modified
+ setup./
+
+ There are now two variables that should be used to list the LaTeX
+ packages that need to be included in all classes. The header
+ definition in =org-export-latex-classes= should then not contain
+ the corresponding =\usepackage= calls (see below).
+
+ The two new variables are:
+
+ 1. =org-export-latex-default-packages-alist= :: This is the
+ variable where Org-mode itself puts the packages it needs.
+ Normally you should not change this variable. The only
+ reason to change it anyway is when one of these packages
+ causes a conflict with another package you want to use. Then
+ you can remove that packages and hope that you are not using
+ Org-mode functionality that needs it.
+
+ 2. =org-export-latex-packages-alist= :: This is the variable where
+ you can put the packages that you'd like to use across all
+ classes.
+
+ The sequence how these customizations will show up in the LaTeX
+ document are:
+
+ 1. Header from =org-export-latex-classes=
+ 2. =org-export-latex-default-packages-alist=
+ 3. =org-export-latex-packages-alist=
+ 4. Buffer-specific things set with =#+LaTeX_HEADER:=
+
+ If you want more control about which segment is placed where, or
+ if you want, for a specific class, have full control over the
+ header and exclude some of the automatic building blocks, you can
+ put the following macro-like place holders into the header:
+
+ #+begin_example
+ [DEFAULT-PACKAGES] \usepackage statements for default packages
+ [NO-DEFAULT-PACKAGES] do not include any of the default packages
+ [PACKAGES] \usepackage statements for packages
+ [NO-PACKAGES] do not include the packages
+ [EXTRA] the stuff from #+LaTeX_HEADER
+ [NO-EXTRA] do not include #+LaTeX_HEADER stuff
+ #+end_example
+
+ If you have currently customized =org-export-latex-classes=, you
+ should revise that customization and remove any package calls that
+ are covered by =org-export-latex-default-packages-alist=. This
+ applies to the following packages:
+
+ - inputenc
+ - fontenc
+ - fixltx2e
+ - graphicx
+ - longtable
+ - float
+ - wrapfig
+ - soul
+ - t1enc
+ - textcomp
+ - marvosym
+ - wasysym
+ - latexsym
+ - amssymb
+ - hyperref
+
+ If one of these packages creates a conflict with another package
+ you are using, you can remove it from
+ =org-export-latex-default-packages-alist=. But then you risk that
+ some of the advertised export features of Org will not work
+ properly.
+
+ You can also consider moving packages that you use in all classes
+ to =org-export-latex-packages-alist=. If necessary, put the place
+ holders so that the packages get loaded in the right sequence. As
+ said above, for backward compatibility, if you omit the place
+ holders, all the variables will dump their content at the end of
+ the header.
+
+*** The constant =org-html-entities= is obsolete
+
+ Its content is now part of the new constant =org-entities=, which
+ is defined in the file org-entities.el. =org-html-entities= was
+ an internal variable, but it is possible that some users did write
+ code using it.
+
+*** =org-bbdb-anniversary-format-alist= has changed
+
+ Please check the docstring and update your settings accordingly.
+
+*** Deleted =org-mode-p=
+
+ This function has been deleted: please update your code.
+
+** Important new features
+
+*** New Org to ODT exporter
+
+ Jambunathan's Org to ODT exporter is now part of Org.
+
+ To use it, it `C-c C-e o' in an Org file. See the documentation
+ for more information on how to customize it.
+
+*** org-capture.el is now the default capture system
+
+ This replaces the earlier system org-remember. The manual only
+ describes org-capture, but for people who prefer to continue to
+ use org-remember, we keep a static copy of the former manual
+ section [[http://orgmode.org/org-remember.pdf][chapter about remember]].
+
+ The new system has a technically cleaner implementation and more
+ possibilities for capturing different types of data. See
+ [[http://thread.gmane.org/gmane.emacs.orgmode/26441/focus%3D26441][Carsten's announcement]] for more details.
+
+ To switch over to the new system:
+
+ 1. Run
+
+ : M-x org-capture-import-remember-templates RET
+
+ to get a translated version of your remember templates into the
+ new variable =org-capture-templates=. This will "mostly" work,
+ but maybe not for all cases. At least it will give you a good
+ place to modify your templates. After running this command,
+ enter the customize buffer for this variable with
+
+ : M-x customize-variable RET org-capture-templates RET
+
+ and convince yourself that everything is OK. Then save the
+ customization.
+
+ 2. Bind the command =org-capture= to a key, similar to what you did
+ with org-remember:
+
+ : (define-key global-map "\C-cc" 'org-capture)
+
+ If your fingers prefer =C-c r=, you can also use this key once
+ you have decided to move over completely to the new
+ implementation. During a test time, there is nothing wrong
+ with using both system in parallel.
+
+** New libraries
+
+*** New Org libraries
+**** org-eshell.el (Konrad Hinsen)
+
+ Implement links to eshell buffers.
+
+**** org-special-blocks (Carsten Dominik)
+
+ This package generalizes the #+begin_foo and #+end_foo tokens.
+
+ To use, put the following in your init file:
+
+ #+BEGIN_EXAMPLE
+(require 'org-special-blocks)
+#+END_EXAMPLE
+
+ The tokens #+begin_center, #+begin_verse, etc. existed
+ previously. This package generalizes them (at least for the
+ LaTeX and html exporters). When a #+begin_foo token is
+ encountered by the LaTeX exporter, it is expanded
+ into \begin{foo}. The text inside the environment is not
+ protected, as text inside environments generally is.
+ When #+begin_foo is encountered by the html exporter, a div with
+ class foo is inserted into the HTML file. It is up to the user
+ to add this class to his or her stylesheet if this div is to mean
+ anything.
+
+**** org-taskjuggler.el (Christian Egli)
+
+ Christian Egli's /org-taskjuggler.el/ module is now part of Org.
+ He also wrote a [[http://orgmode.org/worg/org-tutorials/org-taskjuggler.php][tutorial]] for it.
+
+**** org-ctags.el (Paul Sexton)
+
+ Targets like =<<my target>>= can now be found by Emacs' etag
+ functionality, and Org-mode links can be used to to link to
+ etags, also in non-Org-mode files. For details, see the file
+ /org-ctags.el/.
+
+ This feature uses a new hook =org-open-link-functions= which will
+ call function to do something special with text links.
+
+ Thanks to Paul Sexton for this contribution.
+
+**** org-docview.el (Jan Böcker)
+
+ This new module allows links to various file types using docview, where
+ Emacs displays images of document pages. Docview link types can point
+ to a specific page in a document, for example to page 131 of the
+ Org-mode manual:
+
+ : [[docview:~/.elisp/org/doc/org.pdf::131][Org-Mode Manual]]
+
+ Thanks to Jan Böcker for this contribution.
+
+*** New Babel libraries
+
+- ob-picolisp.el (Thorsten Jolitz)
+- ob-fortran.el (Sergey Litvinov)
+- ob-shen.el (Eric Schulte)
+- ob-maxima.el (Eric S Fraga)
+- ob-java.el (Eric Schulte)
+- ob-lilypond.el (Martyn Jago)
+- ob-awk.el (Eric Schulte)
+
+** Other new features and various enhancements
+
+*** Hyperlinks
+
+**** Org-Bibtex -- major improvements
+
+ Provides support for managing bibtex bibliographical references
+ data in headline properties. Each headline corresponds to a
+ single reference and the relevant bibliographic meta-data is
+ stored in headline properties, leaving the body of the headline
+ free to hold notes and comments. Org-bibtex is aware of all
+ standard bibtex reference types and fields.
+
+ The key new functions are
+
+ - org-bibtex-check :: queries the user to flesh out all required
+ (and with prefix argument optional) bibtex fields available
+ for the specific reference =type= of the current headline.
+
+ - org-bibtex-create :: Create a new entry at the given level,
+ using org-bibtex-check to flesh out the relevant fields.
+
+ - org-bibtex-yank :: Yank a bibtex entry on the kill ring as a
+ formatted Org-mode headline into the current buffer
+
+ - org-bibtex-export-to-kill-ring :: Export the current headline
+ to the kill ring as a formatted bibtex entry.
+
+**** org-gnus.el now allows link creation from messages
+
+ You can now create links from messages. This is particularly
+ useful when the user wants to stored messages that he sends, for
+ later check. Thanks to Ulf Stegemann for the patch.
+
+**** Modified link escaping
+
+ David Maus worked on `org-link-escape'. See [[http://article.gmane.org/gmane.emacs.orgmode/37888][his message]]:
+
+ : Percent escaping is used in Org mode to escape certain characters
+ : in links that would either break the parser (e.g. square brackets
+ : in link target oder description) or are not allowed to appear in
+ : a particular link type (e.g. non-ascii characters in a http:
+ : link).
+ :
+ : With this change in place Org will apply percent escaping and
+ : unescaping more consistently especially for non-ascii characters.
+ : Additionally some of the outstanding bugs or glitches concerning
+ : percent escaped links are solved.
+
+ Thanks a lot to David for this work.
+
+**** Make =org-store-link= point to directory in a dired buffer
+
+ When, in a dired buffer, the cursor is not in a line listing a
+ file, `org-store-link' will store a link to the directory.
+
+ Patch by Stephen Eglen.
+
+**** Allow regexps in =org-file-apps= to capture link parameters
+
+ The way extension regexps in =org-file-apps= are handled has
+ changed. Instead of matching against the file name, the regexps
+ are now matched against the whole link, and you can use grouping
+ to extract link parameters which you can then use in a command
+ string to be executed.
+
+ For example, to allow linking to PDF files using the syntax
+ =file:/doc.pdf::<page number>=, you can add the following entry
+ to org-file-apps:
+
+ #+begin_example
+ Extension: \.pdf::\([0-9]+\)\'
+ Command: evince "%s" -p %1
+ #+end_example
+
+ Thanks to Jan Böcker for a patch to this effect.
+
+*** Dates and time
+
+**** Allow relative time when scheduling/adding a deadline
+
+ You can now use relative duration strings like "-2d" or "++3w"
+ when calling =org-schedule= or =org-deadline=: it will schedule
+ (or set the deadline for) the item respectively two days before
+ today and three weeks after the current timestamp, if any.
+
+ You can use this programmatically: =(org-schedule nil "+2d")=
+ will work on the current entry.
+
+ You can also use this while (bulk-)rescheduling and
+ (bulk-)resetting the deadline of (several) items from the agenda.
+
+ Thanks to Memnon Anon for a heads up about this!
+
+**** American-style dates are now understood by =org-read-date=
+
+ So when you are prompted for a date, you can now answer like this
+
+ #+begin_example
+ 2/5/3 --> 2003-02-05
+ 2/5 --> <CURRENT-YEAR>-02-05
+ #+end_example
+
+*** Agenda
+
+**** =org-agenda-custom-commands= has a default value
+
+ This option used to be `nil' by default. This now has a default
+ value, displaying an agenda and all TODOs. See the docstring for
+ details. Thanks to Carsten for this.
+
+**** Improved filtering through =org-agenda-to-appt=
+
+ The new function allows the user to refine the scope of entries
+ to pass to =org-agenda-get-day-entries= and allows to filter out
+ entries using a function.
+
+ Thanks to Peter Münster for raising a related issue and to
+ Tassilo Horn for this idea. Also thanks to Peter Münster for
+ [[git:68ffb7a7][fixing a small bug]] in the final implementation.
+
+**** Allow ap/pm times in agenda time grid
+
+ Times in the agenda can now be displayed in am/pm format. See
+ the new variable =org-agenda-timegrid-use-ampm=. Thanks to
+ C. A. Webber for a patch to this effect.
+
+**** Agenda: Added a bulk "scattering" command
+
+ =B S= in the agenda buffer will cause tasks to be rescheduled a
+ random number of days into the future, with 7 as the default.
+ This is useful if you've got a ton of tasks scheduled for today,
+ you realize you'll never deal with them all, and you just want
+ them to be distributed across the next N days. When called with
+ a prefix arg, rescheduling will avoid weekend days.
+
+ Thanks to John Wiegley for this.
+
+*** Exporting
+
+**** Simplification of org-export-html-preamble/postamble
+
+ When set to `t', export the preamble/postamble as usual, honoring
+ the =org-export-email/author/creator-info= variables.
+
+ When set to a formatting string, insert this string. See the
+ docstring of these variable for details about available
+ %-sequences.
+
+ You can set =:html-preamble= in publishing project in the same
+ way: `t' means to honor =:email/creator/author-info=, and a
+ formatting string will insert a string.
+
+**** New exporters to Latin-1 and UTF-8
+
+ While Ulf Stegemann was going through the entities list to
+ improve the LaTeX export, he had the great idea to provide
+ representations for many of the entities in Latin-1, and for all
+ of them in UTF-8. This means that we can now export files rich
+ in special symbols to Latin-1 and to UTF-8 files. These new
+ exporters can be reached with the commands =C-c C-e n= and =C-c
+ C-e u=, respectively.
+
+ When there is no representation for a given symbol in the
+ targeted coding system, you can choose to keep the TeX-macro-like
+ representation, or to get an "explanatory" representation. For
+ example, =\simeq= could be represented as "[approx. equal to]".
+ Please use the variable =org-entities-ascii-explanatory= to state
+ your preference.
+
+**** HTML export: Add class to outline containers using property
+
+ The =HTML_CONTAINER_CLASS= property can now be used to add a
+ class name to the outline container of a node in HTML export.
+
+**** Throw an error when creating an image from a LaTeX snippet fails
+
+ This behavior can be configured with the new option variable
+ =org-format-latex-signal-error=.
+
+**** Support for creating BEAMER presentations from Org-mode documents
+
+ Org-mode documents or subtrees can now be converted directly in
+ to BEAMER presentation. Turning a tree into a simple
+ presentations is straight forward, and there is also quite some
+ support to make richer presentations as well. See the [[http://orgmode.org/manual/Beamer-class-export.html#Beamer-class-export][BEAMER
+ section]] in the manual for more details.
+
+ Thanks to everyone who has contributed to the discussion about
+ BEAMER support and how it should work. This was a great example
+ for how this community can achieve a much better result than any
+ individual could.
+
+*** Refiling
+
+**** Refile targets can now be cached
+
+ You can turn on caching of refile targets by setting the variable
+ =org-refile-use-cache=. This should speed up refiling if you
+ have many eligible targets in many files. If you need to update
+ the cache because Org misses a newly created entry or still
+ offers a deleted one, press =C-0 C-c C-w=.
+
+**** New logging support for refiling
+
+ Whenever you refile an item, a time stamp and even a note can be
+ added to this entry. For details, see the new option
+ =org-log-refile=.
+
+ Thanks to Charles Cave for this idea.
+
+*** Completion
+
+**** In-buffer completion is now done using John Wiegley's pcomplete.el
+
+ Thanks to John Wiegley for much of this code.
+
+*** Tables
+
+**** New command =org-table-transpose-table-at-point=
+
+ See the docstring. This hack from Juan Pechiar is now part of
+ Org's core. Thanks to Juan!
+
+**** Display field's coordinates when editing it with =C-c `=
+
+ When editing a field with =C-c `=, the field's coordinate will
+ the displayed in the buffer.
+
+ Thanks to Michael Brand for a patch to this effect.
+
+**** Spreadsheet computation of durations and time values
+
+ If you want to compute time values use the =T= flag, either in
+ Calc formulas or Elisp formulas:
+
+ | Task 1 | Task 2 | Total |
+ |--------+--------+---------|
+ | 35:00 | 35:00 | 1:10:00 |
+ #+TBLFM: @2$3=$1+$2;T
+
+ Values must be of the form =[HH:]MM:SS=, where hours are
+ optional.
+
+ Thanks to Martin Halder, Eric Schulte and Carsten for code and
+ feedback on this.
+
+**** Implement formulas applying to field ranges
+
+ Carsten implemented this field-ranges formulas.
+
+ : A frequently requested feature for tables has been to be able to define
+ : row formulas in a way similar to column formulas. The patch below allows
+ : things like
+ :
+ : @3=
+ : @2$2..@5$7=
+ : @I$2..@II$4=
+ :
+ : as the left hand side for table formulas in order to write a formula that
+ : is valid for an entire column or for a rectangular section in a
+ : table.
+
+ Thanks a lot to Carsten for this.
+
+**** Sending radio tables from org buffers is now allowed
+
+ Org radio tables can no also be sent inside Org buffers. Also,
+ there is a new hook which get called after a table has been sent.
+
+ Thanks to Seweryn Kokot.
+
+*** Lists
+
+**** Improved handling of lists
+
+ Nicolas Goaziou extended and improved the way Org handles lists.
+
+ 1. Indentation of text determines again end of items in
+ lists. So, some text less indented than the previous item
+ doesn't close the whole list anymore, only all items more
+ indented than it.
+
+ 2. Alphabetical bullets are implemented, through the use of the
+ variable `org-alphabetical-lists'. This also adds alphabetical
+ counters like [@c] or [@W].
+
+ 3. Lists can now safely contain drawers, inline tasks, or various
+ blocks, themselves containing lists. Two variables are
+ controlling this: `org-list-forbidden-blocks', and
+ `org-list-export-context'.
+
+ 4. Improve `newline-and-indent' (C-j): used in an item, it will
+ keep text from moving at column 0. This allows to split text
+ and make paragraphs and still not break the list.
+
+ 5. Improve `org-toggle-item' (C-c -): used on a region with
+ standard text, it will change the region into one item. With a
+ prefix argument, it will fallback to the previous behavior and
+ make every line in region an item. It permits to easily
+ integrate paragraphs inside a list.
+
+ 6. `fill-paragraph' (M-q) now understands lists. It can freely be
+ used inside items, or on text just after a list, even with no
+ blank line around, without breaking list structure.
+
+ Thanks a lot to Nicolas for all this!
+
+*** Inline display of linked images
+
+ Images can now be displayed inline. The key C-c C-x C-v does
+ toggle the display of such images. Note that only image links
+ that have no description part will be inlined.
+
+*** Implement offsets for ordered lists
+
+ If you want to start an ordered plain list with a number different
+ from 1, you can now do it like this:
+
+ : 1. [@start:12] will star a lit a number 12
+
+*** Babel: code block body expansion for table and preview
+
+ In org-babel, code is "expanded" prior to evaluation. I.e. the
+ code that is actually evaluated comprises the code block contents,
+ augmented with the extra code which assigns the referenced data to
+ variables. It is now possible to preview expanded contents, and
+ also to expand code during during tangling. This expansion takes
+ into account all header arguments, and variables.
+
+ A new keybinding `C-c M-b p' bound to `org-babel-expand-src-block'
+ can be used from inside of a source code block to preview its
+ expanded contents (which can be very useful for debugging).
+ tangling
+
+ The expanded body can now be tangled, this includes variable
+ values which may be the results of other source-code blocks, or
+ stored in headline properties or tables. One possible use for this
+ is to allow those using org-babel for their emacs initialization
+ to store values (e.g. usernames, passwords, etc...) in headline
+ properties or in tables.
+
+ Org-babel now supports three new header arguments, and new default
+ behavior for handling horizontal lines in tables (hlines), column
+ names, and rownames across all languages.
+
+*** Editing Convenience and Appearance
+
+**** New command =org-copy-visible= (=C-c C-x v=)
+
+ This command will copy the visible text in the region into the
+ kill ring. Thanks to Florian Beck for this function and to
+ Carsten for adding it to org.el and documenting it!
+
+**** Make it possible to protect hidden subtrees from being killed by =C-k=
+
+ See the new variable =org-ctrl-k-protect-subtree=. This was a
+ request by Scott Otterson.
+
+**** Implement pretty display of entities, sub-, and superscripts.
+
+ The command =C-c C-x \= toggles the display of Org's special
+ entities like =\alpha= as pretty unicode characters. Also, sub
+ and superscripts are displayed in a pretty way (raised/lower
+ display, in a smaller font). If you want to exclude sub- and
+ superscripts, see the variable
+ =org-pretty-entities-include-sub-superscripts=.
+
+ Thanks to Eric Schulte and Ulf Stegeman for making this possible.
+
+**** New faces for title, date, author and email address lines
+
+ The keywords in these lines are now dimmed out, and the title is
+ displayed in a larger font, and a special font is also used for
+ author, date, and email information. This is implemented by the
+ following new faces:
+
+ =org-document-title=
+ =org-document-info=
+ =org-document-info-keyword=
+
+ In addition, the variable =org-hidden-keywords= can be used to
+ make the corresponding keywords disappear.
+
+ Thanks to Dan Davison for this feature.
+
+**** Simpler way to specify faces for tags and todo keywords
+
+ The variables =org-todo-keyword-faces=, =org-tag-faces=, and
+ =org-priority-faces= now accept simple color names as
+ specifications. The colors will be used as either foreground or
+ background color for the corresponding keyword. See also the
+ variable =org-faces-easy-properties=, which governs which face
+ property is affected by this setting.
+
+ This is really a great simplification for setting keyword faces.
+ The change is based on an idea and patch by Ryan Thompson.
+
+**** <N> in tables now means fixed width, not maximum width
+
+ Requested by Michael Brand.
+
+**** Better level cycling function
+
+ =TAB= in an empty headline cycles the level of that headline
+ through likely states. Ryan Thompson implemented an improved
+ version of this function, which does not depend upon when exactly
+ this command is used. Thanks to Ryan for this improvement.
+
+**** Adaptive filling
+
+ For paragraph text, =org-adaptive-fill-function= did not handle
+ the base case of regular text which needed to be filled. This is
+ now fixed. Among other things, it allows email-style ">"
+ comments to be filled correctly.
+
+ Thanks to Dan Hackney for this patch.
+
+**** `org-reveal' (=C-c C-r=) also decrypts encrypted entries (org-crypt.el)
+
+ Thanks to Richard Riley for triggering this change.
+
+**** Better automatic letter selection for TODO keywords
+
+ When all first letters of keywords have been used, Org now
+ assigns more meaningful characters based on the keywords.
+
+ Thanks to Mikael Fornius for this patch.
+
+*** Clocking
+
+**** Clock: Allow synchronous update of timestamps in CLOCK log
+
+ Using =S-M-<up/down>= on CLOCK log timestamps will
+ increase/decrease the two timestamps on this line so that
+ duration will keep the same. Note that duration can still be
+ slightly modified in case a timestamp needs some rounding.
+
+ Thanks to Rainer Stengele for this idea.
+
+**** Localized clock tables
+
+ Clock tables now support a new new =:lang= parameter, allowing
+ the user to customize the localization of the table headers. See
+ the variable =org-clock-clocktable-language-setup= which controls
+ available translated strings.
+
+**** Show clock overruns in mode line
+
+ When clocking an item with a planned effort, overrunning the
+ planned time is now made visible in the mode line, for example
+ using the new face =org-mode-line-clock-overrun=, or by adding an
+ extra string given by =org-task-overrun-text=.
+
+ Thanks to Richard Riley for a patch to this effect.
+
+**** Clock reports can now include the running, incomplete clock
+
+ If you have a clock running, and the entry being clocked falls
+ into the scope when creating a clock table, the time so far spent
+ can be added to the total. This behavior depends on the setting
+ of =org-clock-report-include-clocking-task=. The default is
+ =nil=.
+
+ Thanks to Bernt Hansen for this useful addition.
+
+*** Misc
+
+**** Improvements with inline tasks and indentation
+
+ There is now a configurable way on how to export inline tasks.
+ See the new variable =org-inlinetask-export-templates=.
+
+ Thanks to Nicolas Goaziou for coding these changes.
+
+**** A property value of "nil" now means to unset a property
+
+ This can be useful in particular with property inheritance, if
+ some upper level has the property, and some grandchild of it
+ would like to have the default settings (i.e. not overruled by a
+ property) back.
+
+ Thanks to Robert Goldman and Bernt Hansen for suggesting this
+ change.
+
+**** New helper functions in org-table.el
+
+ There are new functions to access and write to a specific table field.
+ This is for hackers, and maybe for the org-babel people.
+
+ #+begin_example
+ org-table-get
+ org-table-put
+ org-table-current-line
+ org-table-goto-line
+ #+end_example
+
+**** Archiving: Allow to reverse order in target node
+
+ The new option =org-archive-reversed-order= allows to have
+ archived entries inserted in a last-on-top fashion in the target
+ node.
+
+ This was requested by Tom.
+
+**** Org-reveal: Double prefix arg shows the entire subtree of the parent
+
+ This can help to get out of an inconsistent state produced for
+ example by viewing from the agenda.
+
+ This was a request by Matt Lundin.
+
+* 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/>.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 57a3387ee40..4edab8a41dc 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -1,6 +1,6 @@
Known Problems with GNU Emacs
-Copyright (C) 1987-1989, 1993-1999, 2001-2011
+Copyright (C) 1987-1989, 1993-1999, 2001-2012
Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -255,6 +255,36 @@ result in an endless loop.
If you need Emacs to be able to recover from closing displays, compile
it with the Lucid toolkit instead of GTK.
+** Emacs crashes when you try to view a file with complex characters.
+For example, the etc/HELLO file (as shown by C-h h).
+The message "symbol lookup error: /usr/bin/emacs: undefined symbol: OTF_open"
+is shown in the terminal from which you launched Emacs.
+This problem only happens when you use a graphical display (ie not
+with -nw) and compiled Emacs with the "libotf" library for complex
+text handling.
+
+This problem occurs because unfortunately there are two libraries
+called "libotf". One is the library for handling OpenType fonts,
+http://www.m17n.org/libotf/, which is the one that Emacs expects.
+The other is a library for Open Trace Format, and is used by some
+versions of the MPI message passing interface for parallel
+programming.
+
+For example, on RHEL6 GNU/Linux, the OpenMPI rpm provides a version
+of "libotf.so" in /usr/lib/openmpi/lib. This directory is not
+normally in the ld search path, but if you want to use OpenMPI,
+you must issue the command "module load openmpi". This adds
+/usr/lib/openmpi/lib to LD_LIBRARY_PATH. If you then start Emacs from
+the same shell, you will encounter this crash.
+Ref: <URL:https://bugzilla.redhat.com/show_bug.cgi?id=806031>
+
+There is no good solution to this problem if you need to use both
+OpenMPI and Emacs with libotf support. The best you can do is use a
+wrapper shell script (or function) "emacs" that removes the offending
+element from LD_LIBRARY_PATH before starting emacs proper.
+Or you could recompile Emacs with an -Wl,-rpath option that
+gives the location of the correct libotf.
+
* General runtime problems
** Lisp problems
@@ -302,6 +332,12 @@ Help mode due to setting `temp-buffer-show-hook' rather than using
** Keyboard problems
+*** Unable to enter the M-| key on some German keyboards.
+Some users have reported that M-| suffers from "keyboard ghosting".
+This can't be fixed by Emacs, as the keypress never gets passed to it
+at all (as can be verified using "xev"). You can work around this by
+typing `ESC |' instead.
+
*** "Compose Character" key does strange things when used as a Meta key.
If you define one key to serve as both Meta and Compose Character, you
@@ -352,7 +388,7 @@ There are two different protocols in general use. One of them uses
the `flock' system call. The other involves creating a lock file;
`movemail' must be able to write in /usr/spool/mail in order to do
this. You control which one is used by defining, or not defining,
-the macro MAIL_USE_FLOCK in config.h or the m- or s- file it includes.
+the macro MAIL_USE_FLOCK in config.h.
IF YOU DON'T USE THE FORM OF INTERLOCKING THAT IS NORMAL ON YOUR
SYSTEM, YOU CAN LOSE MAIL!
@@ -407,8 +443,8 @@ Thus, you could start by adding this to config.h:
#define LIBS_SYSTEM -lresolv
Then if this gives you an error for redefining a macro, and you see that
-the s- file defines LIBS_SYSTEM as -lfoo -lbar, you could change config.h
-again to say this:
+config.h already defines LIBS_SYSTEM as -lfoo -lbar at some other point
+(possibly in an included file) you could change it to say this:
#define LIBS_SYSTEM -lresolv -lfoo -lbar
@@ -1357,6 +1393,28 @@ single copies. You do not need any other drivers or options.
Option "Device" "/dev/input/mice"
EndSection
+*** Emacs is slow to exit in X
+
+After you use e.g. C-x C-c to exit, it takes many seconds before the
+Emacs window disappears. If Emacs was started from a terminal, you
+see the message:
+
+ Error saving to X clipboard manager.
+ If the problem persists, set `x-select-enable-clipboard-manager' to nil.
+
+As the message suggests, this problem occurs when Emacs thinks you
+have a clipboard manager program running, but has trouble contacting it.
+If you don't want to use a clipboard manager, you can set the
+suggested variable. Or you can make Emacs not wait so long by
+reducing the value of `x-selection-timeout', either in .emacs or with
+X resources.
+
+Sometimes this problem is due to a bug in your clipboard manager.
+Updating to the latest version of the manager can help.
+For example, in the Xfce 4.8 desktop environment, the clipboard
+manager in versions of xfce4-settings-helper before 4.8.2 is buggy;
+https://bugzilla.xfce.org/show_bug.cgi?id=7588 .
+
* Runtime problems on character terminals
** The meta key does not work on xterm.
@@ -1651,6 +1709,23 @@ recommended way of turning on Font-lock is by typing "M-x
global-font-lock-mode RET" or by customizing the variable
`global-font-lock-mode'.
+** Unexpected characters inserted into the buffer when you start Emacs.
+See eg http://debbugs.gnu.org/11129
+
+This can happen when you start Emacs in -nw mode in an Xterm.
+For example, in the *scratch* buffer, you might see something like:
+
+ 0;276;0c
+
+This is more likely to happen if you are using Emacs over a slow
+connection, and begin typing before Emacs is ready to respond.
+
+This occurs when Emacs tries to query the terminal to see what
+capabilities it supports, and gets confused by the answer.
+To avoid it, set xterm-extra-capabilities to a value other than
+`check' (the default). See that variable's documentation (in
+term/xterm.el) for more details.
+
* Runtime problems specific to individual Unix variants
** GNU/Linux
@@ -1809,8 +1884,8 @@ Emacs uses symbolic links to implement file locks. In a directory
with +t bit, the directory owner becomes the owner of the symbolic
link, so that it cannot be removed by anyone else.
-If you don't like those useless links, you can let Emacs not to using
-file lock by adding #undef CLASH_DETECTION to config.h.
+If you don't like those useless links, you can customize
+the option `create-lockfiles'.
*** FreeBSD: Getting a Meta key on the console.
@@ -2213,10 +2288,10 @@ printer drivers. A workaround on MS-Windows is to use Windows' basic
built in editor to print (this is possibly the only useful purpose it
has):
-(setq printer-name "") ;; notepad takes the default
-(setq lpr-command "notepad") ;; notepad
-(setq lpr-switches nil) ;; not needed
-(setq lpr-printer-switch "/P") ;; run notepad as batch printer
+(setq printer-name "") ; notepad takes the default
+(setq lpr-command "notepad") ; notepad
+(setq lpr-switches nil) ; not needed
+(setq lpr-printer-switch "/P") ; run notepad as batch printer
** Antivirus software interacts badly with the MS-Windows version of Emacs.
@@ -2733,19 +2808,11 @@ build Emacs in a directory on a local disk.
*** The dumped Emacs crashes when run, trying to write pure data.
-Two causes have been seen for such problems.
-
-1) On a system where getpagesize is not a system call, it is defined
+On a system where getpagesize is not a system call, it is defined
as a macro. If the definition (in both unex*.c and malloc.c) is wrong,
it can cause problems like this. You might be able to find the correct
value in the man page for a.out (5).
-2) Some systems allocate variables declared static among the
-initialized variables. Emacs makes all initialized variables in most
-of its files pure after dumping, but the variables declared static and
-not initialized are not supposed to be pure. On these systems you
-may need to add "#define static" to the m- or the s- file.
-
* Runtime problems on legacy systems
This section covers bugs reported on very old hardware or software.
@@ -2837,10 +2904,6 @@ should do.
pen@lysator.liu.se says (Feb 1998) that the Compose key does work
if you link with the MIT X11 libraries instead of the Solaris X11 libraries.
-*** HP/UX 10: Large file support is disabled.
-(HP/UX 10 was end-of-lifed in May 1999.)
-See the comments in src/s/hpux10-20.h.
-
*** HP/UX: Emacs is slow using X11R5.
This happens if you use the MIT versions of the X libraries--it
@@ -3168,50 +3231,6 @@ causes the problem to go away.
The `contents' field of a Lisp vector is an array of Lisp_Objects,
so you may see the problem happening with indexed references to that.
-** 68000 C compiler problems
-
-Various 68000 compilers have different problems.
-These are some that have been observed.
-
-*** Using value of assignment expression on union type loses.
-This means that x = y = z; or foo (x = z); does not work
-if x is of type Lisp_Object.
-
-*** "cannot reclaim" error.
-
-This means that an expression is too complicated. You get the correct
-line number in the error message. The code must be rewritten with
-simpler expressions.
-
-*** XCONS, XSTRING, etc macros produce incorrect code.
-
-If temacs fails to run at all, this may be the cause.
-Compile this test program and look at the assembler code:
-
-struct foo { char x; unsigned int y : 24; };
-
-lose (arg)
- struct foo arg;
-{
- test ((int *) arg.y);
-}
-
-If the code is incorrect, your compiler has this problem.
-In the XCONS, etc., macros in lisp.h you must replace (a).u.val with
-((a).u.val + coercedummy) where coercedummy is declared as int.
-
-This problem will only happen if USE_LISP_UNION_TYPE is manually
-defined in lisp.h.
-
-** C compilers lose on returning unions.
-
-I hear that some C compilers cannot handle returning a union type.
-Most of the functions in GNU Emacs return type Lisp_Object, which is
-defined as a union on some rare architectures.
-
-This problem will only happen if USE_LISP_UNION_TYPE is manually
-defined in lisp.h.
-
This file is part of GNU Emacs.
diff --git a/etc/README b/etc/README
index d1cad4a3a0f..613306b397c 100644
--- a/etc/README
+++ b/etc/README
@@ -9,5 +9,5 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
File: emacs.icon
Author: Sun Microsystems, Inc
- Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/TERMS b/etc/TERMS
index e361188247b..03c5cfeaba1 100644
--- a/etc/TERMS
+++ b/etc/TERMS
@@ -1,4 +1,4 @@
-Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
See the end of the file for copying permissions.
This file describes what you must or might want to do to termcap entries
diff --git a/etc/TODO b/etc/TODO
index 2470747bfb5..be0ef95aed2 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -1,6 +1,6 @@
Emacs TODO List -*-outline-*-
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -18,13 +18,12 @@ to the FSF.
"which form of concurrency" we'll want.
** Overhaul of customize: sounds wonderful.
** better support for dynamic embedded graphics: I like this idea (my
- mpc.el code could use it for the volume widget), tho I wonder if the
+ mpc.el code could use it for the volume widget), though I wonder if the
resulting efficiency will be sufficient.
** Spread Semantic.
** Improve the "code snippets" support: consolidate skeleton.el, tempo.el,
and expand.el (any other?) and then advertise/use/improve it.
** Improve VC: yes, there's a lot of work to be done there :-(
- And most of it could/should make it into Emacs-23.3.
** Random things that cross my mind right now that I'd like to see (some of
them from my local hacks), but it's not obvious at all whether they'll
@@ -71,6 +70,12 @@ things in their .emacs.
** See if other files can use generated-autoload-file (see eg ps-print).
+** Write more tests. Pick a fixed bug from the database, write a test
+case to make sure it stays fixed. Or pick your favorite programming
+major-mode, and write a test for its indentation. Or a version
+control backend, and write a test for its status parser. Etc.
+See test/automated for examples.
+
* Small but important fixes needed in existing features:
** Flymake's customization mechanism needs to be both simpler (fewer
@@ -79,7 +84,7 @@ understand. I find it quite hard to figure out what compilation
command it will use.
I suggest totally rewriting that part of Flymake, using the simplest
-mechanism that sufficies for the specific needs. That will be easy
+mechanism that suffices for the specific needs. That will be easy
for users to customize.
** Compute the list of active keymaps *after* reading the first event.
@@ -427,18 +432,13 @@ http://lists.gnu.org/archive/html/emacs-devel/2008-02/msg02234.html
** Highlight rectangles (`mouse-track-rectangle-p' in XEmacs). Already in CUA,
but it's a valuable feature worth making more general.
-** Provide MIME support for Rmail using the Gnus MIME library. [Maybe
- not now feasible, given Gnus maintenance decisions. fx looked at
- this and can say where some of the problems are.]
-
** Eliminate the storm of warnings concerning char/unsigned char
mismatches that we get with GCC 4.x and proprietary compilers on
various systems. They make it difficult to spot the important warnings.
** Fix anything necessary to use `long long' EMACS_INTs with GCC.
-** Split out parts of lisp.h [and generate Makefile dependencies automatically.]
-[the last bit is done, see DEPFLAGS etc in src/Makefile.in ]
+** Split out parts of lisp.h.
** Update the FAQ.
@@ -522,15 +522,15 @@ http://lists.gnu.org/archive/html/emacs-devel/2008-02/msg02234.html
artist, ansi-color, array, battery, calculator, cdl, cmuscheme,
completion, cua, delim-col, dirtrack, double, echistory, elide-head,
easymenu, expand, flow-ctrl, format [format-alist],
- generic/generic-x [various modes], kermit, log-edit, ledit
- [obsolete?], makesum, midnight [other than in Kill Buffer node],
+ generic/generic-x [various modes], kermit, log-edit,
+ makesum, midnight [other than in Kill Buffer node],
mouse-copy [?], mouse-drag, mouse-sel, net-utils, rcompile,
snmp-mode [?], soundex [should be interactive?], strokes [start from
the web page], talk, thingatpt [interactive functions?], type-break,
- vcursor, xscheme, zone-mode [?], mlconvert [?], iso-cvt, iso-swed,
- swedish, feedmail [?], uce, bruce, gametree, meese, page-ext,
+ vcursor, xscheme, zone-mode [?], mlconvert [?], iso-cvt,
+ feedmail [?], uce, gametree, meese, page-ext,
refbib, refer, scribe, sgml-mode, spell, texinfo, underline,
- cmacexp, hideif, mantemp [obsolete?], pcomplete, assoc, xml,
+ cmacexp, hideif, mantemp [obsolete?], pcomplete, xml,
cvs-status (should be described in PCL-CVS manual); other progmodes,
probably in separate manual.
@@ -614,6 +614,15 @@ http://lists.gnu.org/archive/html/emacs-devel/2008-02/msg02234.html
*** Bugs
+**** The event loop relies on polling and that hurts performance.
+ A better strategy is to have the select part in its own thread and let
+ the main thread communicate with that thread (see how Gdk does it for
+ inspiration). A problem is that redraw don't happen during resize,
+ because we can't break out from the NSapp loop during resize.
+ There is a special trick to detect mouse press in the lower right
+ corner and track mouse movements, but this does not work well, and is
+ not scalable to the new Lion "resize on every window edge" behavior.
+
**** (mouse-avoidance-mode 'banish) then minimize Emacs, will pop window back
up on top of all others
@@ -641,17 +650,29 @@ up on top of all others
** Bidirectional editing
+*** Support reordering structured text
+Two important use cases: (1) comments and strings in program sources,
+and (2) text with markup, like HTML or XML.
+
+One idea is to invent a special text property that would instruct the
+display engine to reorder only the parts of buffer text covered by
+that property. The display engine will then push its state onto the
+iterator stack, restrict the bidi iterator to accessing only the
+portion of buffer text covered by the property, reorder the text, then
+pop its state from stack and continue as usual. This will require
+minor changes in the bidi_it structure.
+
+This design requires Lisp-level code to put the text properties on the
+relevant parts of the buffer text. That could be done using JIT
+fontifications, or as a preliminary processing when the file is
+visited. With HTML/XML, the code that puts text properties needs to
+pay attention to the bidi directives embedded in the HTML/XML stream.
+
*** Allow the user to control the direction of the UI
**** Introduce user option to control direction of mode line.
-This requires to figure out what to do with unibyte strings that are
-used in constructing the mode line. Currently, unibyte strings are
-not reordered by bidi.c, without which R2L mode line will not display
-correctly. One possibility would be to STRING_SET_MULTIBYTE all Lisp
-strings involved in the mode line, and then pass them through bidi.c.
-
-Another problem is the header line, which is produced by the same
-routines as the mode line. While it makes sense to have the mode-line
+One problem is the header line, which is produced by the same routines
+as the mode line. While it makes sense to have the mode-line
direction controlled by a single global variable, header lines are
buffer-specific, so they need a separate treatment in this regard.
@@ -1199,6 +1220,8 @@ systems for HTML/XML files automatically."
this.]
** Rewrite make-docfile to be clean and maintainable.
+ It might be better to replace it with Lisp, using the byte compiler.
+ http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00037.html
** Add an inferior-comint-minor-mode to capture the common set of operations
offered by major modes that offer an associated inferior
@@ -1206,18 +1229,20 @@ systems for HTML/XML files automatically."
For use by sml-mode, python-mode, tex-mode, scheme-mode, lisp-mode,
haskell-mode, tuareg-mode, ...
-** Make SYNC_INPUT the default. [true since 2008-03-11]
- All loops using immediate_quit need to be checked to ensure that
- C-g can interrupt them, in case of an infinite loop. Once we
- switch to using SYNC_INPUT, we can remove the BLOCK_INPUTs in the
- allocation functions (allocate_string etc.) without worrying about
- data munging.
-
** Add "link" button class
Add a standard button-class named "link", and make all other link-like
button classes inherit from it. Set the default face of the "link" button
class to the standard "link" face.
+* Wishlist items:
+
+** Maybe replace etags.c with a Lisp implementation.
+http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00354.html
+
+** Maybe replace lib-src/rcs2log with a Lisp implementation.
+It wouldn't have to be a complete replacement, just enough
+for vc-rcs-update-changelog.
+
* Other known bugs:
** `make-frame' forgets unhandled parameters, at least for X11 frames.
diff --git a/etc/charsets/CNS-2.map b/etc/charsets/CNS-2.map
index 7fdd4ae0498..1285859a36d 100644
--- a/etc/charsets/CNS-2.map
+++ b/etc/charsets/CNS-2.map
@@ -1,4 +1,4 @@
-# Generated from admin/charsets/mapfiles/cns2ucsdkw.txt.gz which is a copy of
+# Generated from admin/charsets/mapfiles/cns2ucsdkw.txt which is a copy of
# http://kanji-database.cvs.sourceforge.net/viewvc/*checkout*/kanji-database/kanji-database/data/cns2ucsdkw.txt?revision=1.4
0x2121 0x4E42
0x2122 0x4E5C
diff --git a/etc/charsets/CNS-3.map b/etc/charsets/CNS-3.map
index f1542f9da91..d7306a9d81f 100644
--- a/etc/charsets/CNS-3.map
+++ b/etc/charsets/CNS-3.map
@@ -1,4 +1,4 @@
-# Generated from admin/charsets/mapfiles/cns2ucsdkw.txt.gz which is a copy of
+# Generated from admin/charsets/mapfiles/cns2ucsdkw.txt which is a copy of
# http://kanji-database.cvs.sourceforge.net/viewvc/*checkout*/kanji-database/kanji-database/data/cns2ucsdkw.txt?revision=1.4
0x2121 0x4E28
0x2122 0x4E36
diff --git a/etc/charsets/CNS-4.map b/etc/charsets/CNS-4.map
index 8f9f2333c95..ba4f0e7a1fb 100644
--- a/etc/charsets/CNS-4.map
+++ b/etc/charsets/CNS-4.map
@@ -1,4 +1,4 @@
-# Generated from admin/charsets/mapfiles/cns2ucsdkw.txt.gz which is a copy of
+# Generated from admin/charsets/mapfiles/cns2ucsdkw.txt which is a copy of
# http://kanji-database.cvs.sourceforge.net/viewvc/*checkout*/kanji-database/kanji-database/data/cns2ucsdkw.txt?revision=1.4
0x2121 0x20086
0x2122-0x2123 0x4E40
diff --git a/etc/charsets/CNS-5.map b/etc/charsets/CNS-5.map
index c893f164961..bf6bb9d4653 100644
--- a/etc/charsets/CNS-5.map
+++ b/etc/charsets/CNS-5.map
@@ -1,4 +1,4 @@
-# Generated from admin/charsets/mapfiles/cns2ucsdkw.txt.gz which is a copy of
+# Generated from admin/charsets/mapfiles/cns2ucsdkw.txt which is a copy of
# http://kanji-database.cvs.sourceforge.net/viewvc/*checkout*/kanji-database/kanji-database/data/cns2ucsdkw.txt?revision=1.4
0x2121 0x200D1
0x2122 0x200CB
diff --git a/etc/charsets/CNS-6.map b/etc/charsets/CNS-6.map
index 90c048035c0..348416c1c1e 100644
--- a/etc/charsets/CNS-6.map
+++ b/etc/charsets/CNS-6.map
@@ -1,4 +1,4 @@
-# Generated from admin/charsets/mapfiles/cns2ucsdkw.txt.gz which is a copy of
+# Generated from admin/charsets/mapfiles/cns2ucsdkw.txt which is a copy of
# http://kanji-database.cvs.sourceforge.net/viewvc/*checkout*/kanji-database/kanji-database/data/cns2ucsdkw.txt?revision=1.4
0x2121 0x2F802
0x2122 0x20062
diff --git a/etc/charsets/CNS-7.map b/etc/charsets/CNS-7.map
index 96c1ad0efed..5a621737444 100644
--- a/etc/charsets/CNS-7.map
+++ b/etc/charsets/CNS-7.map
@@ -1,4 +1,4 @@
-# Generated from admin/charsets/mapfiles/cns2ucsdkw.txt.gz which is a copy of
+# Generated from admin/charsets/mapfiles/cns2ucsdkw.txt which is a copy of
# http://kanji-database.cvs.sourceforge.net/viewvc/*checkout*/kanji-database/kanji-database/data/cns2ucsdkw.txt?revision=1.4
0x2121 0x20055
0x2122 0x20182
diff --git a/etc/charsets/CP932-2BYTE.map b/etc/charsets/CP932-2BYTE.map
index 045fdc98659..d31770892a6 100644
--- a/etc/charsets/CP932-2BYTE.map
+++ b/etc/charsets/CP932-2BYTE.map
@@ -1,4 +1,4 @@
-# Generated from admin/charsets/mapfiles/CP932.TXT.gz which is a copy of
+# Generated from admin/charsets/mapfiles/CP932.TXT which is a copy of
# http://www.unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP932.TXT
0x8140 0x3000 # 0 2121
0x8141 0x3001 # 0 2122
diff --git a/etc/charsets/GB180302.map b/etc/charsets/GB180302.map
index ee7e0ecd42e..4fe8e530a2b 100644
--- a/etc/charsets/GB180302.map
+++ b/etc/charsets/GB180302.map
@@ -2048,20 +2048,17 @@
0xA6B9-0xA6C0 0xE785
0xA6C1-0xA6D1 0x03B1
0xA6D2-0xA6D8 0x03C3
-0xA6D9 0xFE10
-0xA6DA 0xFE12
-0xA6DB 0xFE11
-0xA6DC-0xA6DF 0xFE13
+0xA6D9-0xA6DF 0xE78D
0xA6E0-0xA6E1 0xFE35
0xA6E2-0xA6E3 0xFE39
0xA6E4-0xA6E5 0xFE3F
0xA6E6-0xA6E7 0xFE3D
0xA6E8-0xA6EB 0xFE41
-0xA6EC-0xA6ED 0xFE17
+0xA6EC-0xA6ED 0xE794
0xA6EE-0xA6EF 0xFE3B
0xA6F0-0xA6F1 0xFE37
0xA6F2 0xFE31
-0xA6F3 0xFE19
+0xA6F3 0xE796
0xA6F4-0xA6F5 0xFE33
0xA6F6-0xA6FE 0xE797
0xA740-0xA77E 0xE706
@@ -10396,7 +10393,7 @@
0xFE56 0x3447
0xFE57 0x2E88
0xFE58 0x2E8B
-0xFE59 0x9FB4
+0xFE59 0xE81E
0xFE5A 0x359E
0xFE5B 0x361A
0xFE5C 0x360E
@@ -10404,18 +10401,18 @@
0xFE5E 0x2E97
0xFE5F 0x396E
0xFE60 0x3918
-0xFE61 0x9FB5
+0xFE61 0xE826
0xFE62 0x39CF
0xFE63 0x39DF
0xFE64 0x3A73
0xFE65 0x39D0
-0xFE66-0xFE67 0x9FB6
+0xFE66-0xFE67 0xE82B
0xFE68 0x3B4E
0xFE69 0x3C6E
0xFE6A 0x3CE0
0xFE6B 0x2EA7
0xFE6C 0x000215D7
-0xFE6D 0x9FB8
+0xFE6D 0xE832
0xFE6E 0x2EAA
0xFE6F 0x4056
0xFE70 0x415F
@@ -10431,7 +10428,7 @@
0xFE7B 0x44D6
0xFE7C 0x4661
0xFE7D 0x464C
-0xFE7E 0x9FB9
+0xFE7E 0xE843
0xFE80 0x4723
0xFE81 0x4729
0xFE82 0x477C
@@ -10446,7 +10443,7 @@
0xFE8D 0x499B
0xFE8E 0x49B7
0xFE8F 0x49B6
-0xFE90 0x9FBA
+0xFE90 0xE854
0xFE91 0x000241FE
0xFE92 0x4CA3
0xFE93-0xFE95 0x4C9F
@@ -10454,5 +10451,5 @@
0xFE97 0x4CA2
0xFE98-0xFE9E 0x4D13
0xFE9F 0x4DAE
-0xFEA0 0x9FBB
+0xFEA0 0xE864
0xFEA1-0xFEFE 0xE468
diff --git a/etc/charsets/GB180304.map b/etc/charsets/GB180304.map
index 31352e266c8..042c7514fab 100644
--- a/etc/charsets/GB180304.map
+++ b/etc/charsets/GB180304.map
@@ -41,171 +41,166 @@
0x8130D135-0x8130D238 0x0402
0x8130D239 0x0450
0x8130D330-0x8135F436 0x0452
-0x8135F438-0x8136A531 0x1E40
-0x8136A532-0x8136A533 0x2011
-0x8136A534 0x2017
-0x8136A535-0x8136A536 0x201A
-0x8136A537-0x8136A633 0x201E
-0x8136A634-0x8136A732 0x2027
-0x8136A733 0x2031
-0x8136A734 0x2034
-0x8136A735-0x8136A739 0x2036
-0x8136A830-0x8136B331 0x203C
-0x8136B332-0x8136BB37 0x20AD
-0x8136BB38 0x2104
-0x8136BB39-0x8136BC31 0x2106
-0x8136BC32-0x8136BD33 0x210A
-0x8136BD34-0x8136BE33 0x2117
-0x8136BE34-0x8136C435 0x2122
-0x8136C436-0x8136C439 0x216C
-0x8136C530-0x8136C731 0x217A
-0x8136C732-0x8136C733 0x2194
-0x8136C734-0x8136D233 0x219A
-0x8136D234-0x8136D239 0x2209
-0x8136D330 0x2210
-0x8136D331-0x8136D333 0x2212
-0x8136D334-0x8136D337 0x2216
-0x8136D338-0x8136D339 0x221B
-0x8136D430-0x8136D431 0x2221
-0x8136D432 0x2224
-0x8136D433 0x2226
-0x8136D434-0x8136D435 0x222C
-0x8136D436-0x8136D530 0x222F
-0x8136D531-0x8136D535 0x2238
-0x8136D536-0x8136D635 0x223E
-0x8136D636-0x8136D638 0x2249
-0x8136D639-0x8136D733 0x224D
-0x8136D734-0x8136D836 0x2253
-0x8136D837-0x8136D838 0x2262
-0x8136D839-0x8136D934 0x2268
-0x8136D935-0x8136DD31 0x2270
-0x8136DD32-0x8136DD34 0x2296
-0x8136DD35-0x8136DE35 0x229A
-0x8136DE36-0x8136E130 0x22A6
-0x8136E131-0x8136E932 0x22C0
-0x8136E933-0x81378C35 0x2313
-0x81378C36-0x81378D35 0x246A
-0x81378D36-0x81379735 0x249C
-0x81379736-0x81379739 0x254C
-0x81379830-0x81379932 0x2574
-0x81379933-0x81379935 0x2590
-0x81379936-0x81379A35 0x2596
-0x81379A36-0x81379C31 0x25A2
-0x81379C32-0x81379C39 0x25B4
-0x81379D30-0x81379D37 0x25BE
-0x81379D38-0x81379E30 0x25C8
-0x81379E31-0x81379E32 0x25CC
-0x81379E33-0x8137A030 0x25D0
-0x8137A031-0x8137A331 0x25E6
-0x8137A332-0x8137A333 0x2607
-0x8137A334-0x8137A837 0x260A
-0x8137A838 0x2641
-0x8137A839-0x8138FD38 0x2643
-0x8138FD39-0x8138FE30 0x2E82
-0x8138FE31-0x8138FE33 0x2E85
-0x8138FE34-0x8138FE35 0x2E89
-0x8138FE36-0x81398135 0x2E8D
-0x81398136-0x81398330 0x2E98
-0x81398331-0x81398332 0x2EA8
-0x81398333-0x81398335 0x2EAB
-0x81398336-0x81398339 0x2EAF
-0x81398430-0x81398431 0x2EB4
-0x81398432-0x81398434 0x2EB8
-0x81398435-0x81398538 0x2EBC
-0x81398539-0x8139A331 0x2ECB
-0x8139A332-0x8139A335 0x2FFC
-0x8139A336 0x3004
-0x8139A337-0x8139A431 0x3018
-0x8139A432-0x8139A433 0x301F
-0x8139A434-0x8139A633 0x302A
-0x8139A634-0x8139A635 0x303F
-0x8139A636-0x8139A732 0x3094
-0x8139A733-0x8139A734 0x309F
-0x8139A735-0x8139A739 0x30F7
-0x8139A830-0x8139A835 0x30FF
-0x8139A836-0x8139C131 0x312A
-0x8139C132-0x8139C138 0x322A
-0x8139C139-0x8139CD31 0x3232
-0x8139CD32-0x8139E435 0x32A4
-0x8139E436-0x8139E537 0x3390
-0x8139E538-0x8139E539 0x339F
-0x8139E630-0x8139E933 0x33A2
-0x8139E934-0x8139EA32 0x33C5
-0x8139EA33-0x8139EA34 0x33CF
-0x8139EA35-0x8139EA36 0x33D3
-0x8139EA37-0x8139F539 0x33D6
-0x8139F630-0x8139FA32 0x3448
-0x8139FA33-0x82309A30 0x3474
-0x82309A31-0x8230A531 0x359F
-0x8230A532-0x8230A632 0x360F
-0x8230A633-0x8230F237 0x361B
-0x8230F238-0x8230FB32 0x3919
-0x8230FB33-0x82318638 0x396F
-0x82318639-0x82318832 0x39D1
-0x82318833-0x82319639 0x39E0
-0x82319730-0x8231AC37 0x3A74
-0x8231AC38-0x8231C934 0x3B4F
-0x8231C935-0x8231D437 0x3C6F
-0x8231D438-0x8232AF32 0x3CE1
-0x8232AF33-0x8232C936 0x4057
-0x8232C937-0x8232F837 0x4160
-0x8232F838-0x82338633 0x4338
-0x82338634-0x82338637 0x43AD
-0x82338638-0x82338B30 0x43B2
-0x82338B31-0x8233A338 0x43DE
-0x8233A339-0x8233C931 0x44D7
-0x8233C932-0x8233CB31 0x464D
-0x8233CB32-0x8233DE34 0x4662
-0x8233DE35-0x8233DE39 0x4724
-0x8233DF30-0x8233E731 0x472A
-0x8233E732-0x8233E837 0x477D
-0x8233E838-0x82349638 0x478E
-0x82349639-0x82349B38 0x4948
-0x82349B39-0x82349C30 0x497B
-0x82349C31-0x82349C34 0x497E
-0x82349C35 0x4984
-0x82349C36-0x82349E35 0x4987
-0x82349E36-0x82349E38 0x499C
-0x82349E39-0x8234A130 0x49A0
-0x8234A131-0x8234E733 0x49B8
-0x8234E734-0x8234EB32 0x4C78
-0x8234EB33-0x8234F633 0x4CA4
-0x8234F634-0x82358731 0x4D1A
-0x82358732-0x82358F32 0x4DAF
-0x82358F33-0x82359036 0x9FA6
-0x82359135-0x8336C738 0x9FBC
-0x8336C739 0xE76C
-0x8135F437 0xE7C7
-0x8336C830 0xE7C8
+0x8135F437-0x8136A530 0x1E40
+0x8136A531-0x8136A532 0x2011
+0x8136A533 0x2017
+0x8136A534-0x8136A535 0x201A
+0x8136A536-0x8136A632 0x201E
+0x8136A633-0x8136A731 0x2027
+0x8136A732 0x2031
+0x8136A733 0x2034
+0x8136A734-0x8136A738 0x2036
+0x8136A739-0x8136B330 0x203C
+0x8136B331-0x8136BB36 0x20AD
+0x8136BB37 0x2104
+0x8136BB38-0x8136BC30 0x2106
+0x8136BC31-0x8136BD32 0x210A
+0x8136BD33-0x8136BE32 0x2117
+0x8136BE33-0x8136C434 0x2122
+0x8136C435-0x8136C438 0x216C
+0x8136C439-0x8136C730 0x217A
+0x8136C731-0x8136C732 0x2194
+0x8136C733-0x8136D232 0x219A
+0x8136D233-0x8136D238 0x2209
+0x8136D239 0x2210
+0x8136D330-0x8136D332 0x2212
+0x8136D333-0x8136D336 0x2216
+0x8136D337-0x8136D338 0x221B
+0x8136D339-0x8136D430 0x2221
+0x8136D431 0x2224
+0x8136D432 0x2226
+0x8136D433-0x8136D434 0x222C
+0x8136D435-0x8136D439 0x222F
+0x8136D530-0x8136D534 0x2238
+0x8136D535-0x8136D634 0x223E
+0x8136D635-0x8136D637 0x2249
+0x8136D638-0x8136D732 0x224D
+0x8136D733-0x8136D835 0x2253
+0x8136D836-0x8136D837 0x2262
+0x8136D838-0x8136D933 0x2268
+0x8136D934-0x8136DD30 0x2270
+0x8136DD31-0x8136DD33 0x2296
+0x8136DD34-0x8136DE34 0x229A
+0x8136DE35-0x8136E039 0x22A6
+0x8136E130-0x8136E931 0x22C0
+0x8136E932-0x81378C34 0x2313
+0x81378C35-0x81378D34 0x246A
+0x81378D35-0x81379734 0x249C
+0x81379735-0x81379738 0x254C
+0x81379739-0x81379931 0x2574
+0x81379932-0x81379934 0x2590
+0x81379935-0x81379A34 0x2596
+0x81379A35-0x81379C30 0x25A2
+0x81379C31-0x81379C38 0x25B4
+0x81379C39-0x81379D36 0x25BE
+0x81379D37-0x81379D39 0x25C8
+0x81379E30-0x81379E31 0x25CC
+0x81379E32-0x81379F39 0x25D0
+0x8137A030-0x8137A330 0x25E6
+0x8137A331-0x8137A332 0x2607
+0x8137A333-0x8137A836 0x260A
+0x8137A837 0x2641
+0x8137A838-0x8138FD37 0x2643
+0x8138FD38-0x8138FD39 0x2E82
+0x8138FE30-0x8138FE32 0x2E85
+0x8138FE33-0x8138FE34 0x2E89
+0x8138FE35-0x81398134 0x2E8D
+0x81398135-0x81398239 0x2E98
+0x81398330-0x81398331 0x2EA8
+0x81398332-0x81398334 0x2EAB
+0x81398335-0x81398338 0x2EAF
+0x81398339-0x81398430 0x2EB4
+0x81398431-0x81398433 0x2EB8
+0x81398434-0x81398537 0x2EBC
+0x81398538-0x8139A330 0x2ECB
+0x8139A331-0x8139A334 0x2FFC
+0x8139A335 0x3004
+0x8139A336-0x8139A430 0x3018
+0x8139A431-0x8139A432 0x301F
+0x8139A433-0x8139A632 0x302A
+0x8139A633-0x8139A634 0x303F
+0x8139A635-0x8139A731 0x3094
+0x8139A732-0x8139A733 0x309F
+0x8139A734-0x8139A738 0x30F7
+0x8139A739-0x8139A834 0x30FF
+0x8139A835-0x8139C130 0x312A
+0x8139C131-0x8139C137 0x322A
+0x8139C138-0x8139CD30 0x3232
+0x8139CD31-0x8139E434 0x32A4
+0x8139E435-0x8139E536 0x3390
+0x8139E537-0x8139E538 0x339F
+0x8139E539-0x8139E932 0x33A2
+0x8139E933-0x8139EA31 0x33C5
+0x8139EA32-0x8139EA33 0x33CF
+0x8139EA34-0x8139EA35 0x33D3
+0x8139EA36-0x8139F538 0x33D6
+0x8139F539-0x8139FA31 0x3448
+0x8139FA32-0x82309939 0x3474
+0x82309A30-0x8230A530 0x359F
+0x8230A531-0x8230A631 0x360F
+0x8230A632-0x8230F236 0x361B
+0x8230F237-0x8230FB31 0x3919
+0x8230FB32-0x82318637 0x396F
+0x82318638-0x82318831 0x39D1
+0x82318832-0x82319638 0x39E0
+0x82319639-0x8231AC36 0x3A74
+0x8231AC37-0x8231C933 0x3B4F
+0x8231C934-0x8231D436 0x3C6F
+0x8231D437-0x8232AF31 0x3CE1
+0x8232AF32-0x8232C935 0x4057
+0x8232C936-0x8232F836 0x4160
+0x8232F837-0x82338632 0x4338
+0x82338633-0x82338636 0x43AD
+0x82338637-0x82338A39 0x43B2
+0x82338B30-0x8233A337 0x43DE
+0x8233A338-0x8233C930 0x44D7
+0x8233C931-0x8233CB30 0x464D
+0x8233CB31-0x8233DE33 0x4662
+0x8233DE34-0x8233DE38 0x4724
+0x8233DE39-0x8233E730 0x472A
+0x8233E731-0x8233E836 0x477D
+0x8233E837-0x82349637 0x478E
+0x82349638-0x82349B37 0x4948
+0x82349B38-0x82349B39 0x497B
+0x82349C30-0x82349C33 0x497E
+0x82349C34 0x4984
+0x82349C35-0x82349E34 0x4987
+0x82349E35-0x82349E37 0x499C
+0x82349E38-0x8234A039 0x49A0
+0x8234A130-0x8234E732 0x49B8
+0x8234E733-0x8234EB31 0x4C78
+0x8234EB32-0x8234F632 0x4CA4
+0x8234F633-0x82358730 0x4D1A
+0x82358731-0x82358F31 0x4DAF
+0x82358F32-0x8336C737 0x9FA6
+0x8336C738 0xE76C
+0x8336C739-0x8336C830 0xE7C7
0x8336C831-0x8336C933 0xE7E7
-0x8336C934 0xE815
-0x8336C935-0x8336C939 0xE819
-0x8336CA30-0x8336CA36 0xE81F
-0x8336CA37-0x8336CB30 0xE827
-0x8336CB31-0x8336CB34 0xE82D
-0x8336CB35-0x8336CC32 0xE833
-0x8336CC33-0x8336CC39 0xE83C
-0x8336CD30-0x8336CE35 0xE844
-0x8336CE36-0x8336CF39 0xE856
-0x8336D030-0x84308534 0xE865
-0x84308535-0x84308D30 0xF92D
-0x84308D31-0x84308F37 0xF97A
-0x84308F38-0x84309738 0xF996
-0x84309739-0x84309837 0xF9E8
-0x84309838-0x84309B33 0xF9F2
-0x84309B34 0xFA10
-0x84309B35 0xFA12
-0x84309B36-0x84309B38 0xFA15
-0x84309B39-0x84309C34 0xFA19
-0x84309C35 0xFA22
-0x84309C36-0x84309C37 0xFA25
-0x84309C38-0x84318235 0xFA2A
-0x84318336-0x84318537 0xFE1A
-0x84318538 0xFE32
-0x84318539-0x84318632 0xFE45
-0x84318633 0xFE53
-0x84318634 0xFE58
-0x84318635 0xFE67
-0x84318636-0x84319534 0xFE6C
-0x84319535-0x8431A233 0xFF5F
-0x8431A234-0x8431A439 0xFFE6
+0x8336C934-0x8336CA32 0xE815
+0x8336CA33-0x8336CA39 0xE81F
+0x8336CB30-0x8336CB33 0xE827
+0x8336CB34-0x8336CB38 0xE82D
+0x8336CB39-0x8336CD34 0xE833
+0x8336CD35-0x8336CF30 0xE844
+0x8336CF31-0x8336D035 0xE855
+0x8336D036-0x84308630 0xE865
+0x84308631-0x84308D36 0xF92D
+0x84308D37-0x84309033 0xF97A
+0x84309034-0x84309834 0xF996
+0x84309835-0x84309933 0xF9E8
+0x84309934-0x84309B39 0xF9F2
+0x84309C30 0xFA10
+0x84309C31 0xFA12
+0x84309C32-0x84309C34 0xFA15
+0x84309C35-0x84309D30 0xFA19
+0x84309D31 0xFA22
+0x84309D32-0x84309D33 0xFA25
+0x84309D34-0x84318633 0xFA2A
+0x84318634 0xFE32
+0x84318635-0x84318638 0xFE45
+0x84318639 0xFE53
+0x84318730 0xFE58
+0x84318731 0xFE67
+0x84318732-0x84319630 0xFE6C
+0x84319631-0x8431A239 0xFF5F
+0x8431A330-0x8431A535 0xFFE6
diff --git a/etc/charsets/JISC6226.map b/etc/charsets/JISC6226.map
index 97d24651628..953867f72db 100644
--- a/etc/charsets/JISC6226.map
+++ b/etc/charsets/JISC6226.map
@@ -1,4 +1,4 @@
-# Generated from admin/charsets/mapfiles/Uni2JIS.gz which is a copy of
+# Generated from admin/charsets/mapfiles/Uni2JIS which is a copy of
# http://kanji.zinbun.kyoto-u.ac.jp/~yasuoka/ftp/CJKtable/Uni2JIS.Z
0x2121 0x3000
0x2122 0x3001
@@ -31,7 +31,7 @@
0x213D 0x2014
0x213E 0x2010
0x213F 0xFF0F
-0x2140 0x005C
+0x2140 0xFF3C
0x2141 0x301C
0x2142 0x2016
0x2143 0xFF5C
@@ -6797,3 +6797,8 @@
0x737C 0x9F95
0x737D 0x9F9C
0x737E 0x9FA0
+0x3442 0x3D4E
+0x374E 0x25874
+0x3764 0x28EF6
+0x513D 0x2F80F
+0x7045 0x9724
diff --git a/etc/charsets/JISX2131.map b/etc/charsets/JISX2131.map
index 5d62e99650b..5219a0ef1ef 100644
--- a/etc/charsets/JISX2131.map
+++ b/etc/charsets/JISX2131.map
@@ -1157,7 +1157,6 @@
0x2d79 0x22BF
0x2d7d 0x2756
0x2d7e 0x261E
-0x2e21 0x4FF1
0x2e22 0x0002000B
0x2e23 0x3402
0x2e24 0x4E28
@@ -1344,7 +1343,6 @@
0x2f7b 0x000218BD
0x2f7c 0x5B19
0x2f7d 0x5B25
-0x2f7e 0x525D
0x3021 0x4E9C
0x3022 0x5516
0x3023 0x5A03
@@ -4310,7 +4308,6 @@
0x4f51 0x6E7E
0x4f52 0x7897
0x4f53 0x8155
-0x4f54 0x00020B9F
0x4f55 0x5B41
0x4f56 0x5B56
0x4f57 0x5B7D
@@ -4352,7 +4349,6 @@
0x4f7b 0x5DA7
0x4f7c 0x5DB8
0x4f7d 0x5DCB
-0x4f7e 0x541E
0x5021 0x5F0C
0x5022 0x4E10
0x5023 0x4E15
@@ -7743,7 +7739,6 @@
0x7424 0x7464
0x7425 0x51DC
0x7426 0x7199
-0x7427 0x5653
0x7428 0x5DE2
0x7429 0x5E14
0x742a 0x5E18
@@ -8766,8 +8761,3 @@
0x7e77 0x9F94
0x7e78 0x9F97
0x7e79 0x9FA2
-0x7e7a 0x59F8
-0x7e7b 0x5C5B
-0x7e7c 0x5E77
-0x7e7d 0x7626
-0x7e7e 0x7E6B
diff --git a/etc/charsets/MIK.map b/etc/charsets/MIK.map
index 5a1176f9f50..3bf3d0eb304 100644
--- a/etc/charsets/MIK.map
+++ b/etc/charsets/MIK.map
@@ -1,4 +1,4 @@
-# Generated from admin/charsets/mapfiles/bulgarian-mik.txt.gz which is a copy of
+# Generated from admin/charsets/mapfiles/bulgarian-mik.txt which is a copy of
# http://czyborra.com/charsets/bulgarian-mik.txt.gz
0x20-0x7E 0x0020
0x80-0xBF 0x0410
diff --git a/etc/charsets/MULE-ethiopic.map b/etc/charsets/MULE-ethiopic.map
index d2720bd10ba..30cf5736763 100644
--- a/etc/charsets/MULE-ethiopic.map
+++ b/etc/charsets/MULE-ethiopic.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x2121 0x1200
0x2122 0x1201
0x2123 0x1202
diff --git a/etc/charsets/MULE-ipa.map b/etc/charsets/MULE-ipa.map
index 35e5d50ecec..0a6c61d5a95 100644
--- a/etc/charsets/MULE-ipa.map
+++ b/etc/charsets/MULE-ipa.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x20 0x0069
0x21 0x026A
0x22 0x0065
diff --git a/etc/charsets/MULE-is13194.map b/etc/charsets/MULE-is13194.map
index 1fa9b21dcf8..390132cd375 100644
--- a/etc/charsets/MULE-is13194.map
+++ b/etc/charsets/MULE-is13194.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x21 0x0901
0x22 0x0902
0x23 0x0903
diff --git a/etc/charsets/MULE-lviscii.map b/etc/charsets/MULE-lviscii.map
index 3b6a38be616..e4d2eca90ac 100644
--- a/etc/charsets/MULE-lviscii.map
+++ b/etc/charsets/MULE-lviscii.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x21 0x1EAF
0x22 0x1EB1
0x23 0x1EB7
diff --git a/etc/charsets/MULE-sisheng.map b/etc/charsets/MULE-sisheng.map
index 405bb1ffa2c..144a3ff5134 100644
--- a/etc/charsets/MULE-sisheng.map
+++ b/etc/charsets/MULE-sisheng.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x21 0x0101
0x22 0x00E1
0x23 0x01CE
diff --git a/etc/charsets/MULE-tibetan.map b/etc/charsets/MULE-tibetan.map
index 0d6ff3a0a39..b885585c094 100644
--- a/etc/charsets/MULE-tibetan.map
+++ b/etc/charsets/MULE-tibetan.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x2130 0x0F00
0x2131 0x0F01
0x2132 0x0F02
diff --git a/etc/charsets/MULE-uviscii.map b/etc/charsets/MULE-uviscii.map
index 65e5d2968e5..dc19583bdfe 100644
--- a/etc/charsets/MULE-uviscii.map
+++ b/etc/charsets/MULE-uviscii.map
@@ -1,4 +1,4 @@
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x21 0x1EAE
0x22 0x1EB0
0x23 0x1EB6
diff --git a/etc/charsets/PTCP154.map b/etc/charsets/PTCP154.map
index 72c6b3484d4..c4aa33ac238 100644
--- a/etc/charsets/PTCP154.map
+++ b/etc/charsets/PTCP154.map
@@ -1,4 +1,4 @@
-# Generated from admin/charsets/mapfiles/PTCP154.gz which is a copy of
+# Generated from admin/charsets/mapfiles/PTCP154 which is a copy of
# http://www.iana.org/assignments/charset-reg/PTCP154
0x00-0x7F 0x0000
0x80 0x0496
diff --git a/etc/charsets/README b/etc/charsets/README
index cd009220c3b..10791b31971 100644
--- a/etc/charsets/README
+++ b/etc/charsets/README
@@ -1,8 +1,9 @@
# README file for charset mapping files in this directory.
+
+# Copyright (C) 2003-2012 Free Software Foundation, Inc.
# Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
# National Institute of Advanced Industrial Science and Technology (AIST)
# Registration Number H13PRO009
-# Copyright (C) 2003-2011 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/etc/charsets/stdenc.map b/etc/charsets/stdenc.map
index ab23002b155..08985141ed2 100644
--- a/etc/charsets/stdenc.map
+++ b/etc/charsets/stdenc.map
@@ -1,4 +1,4 @@
-# Generated from admin/charsets/mapfiles/stdenc.txt.gz which is a copy of
+# Generated from admin/charsets/mapfiles/stdenc.txt which is a copy of
# http://www.unicode.org/Public/MAPPINGS/VENDORS/ADOBE/stdenc.txt
0xFB 0x00DF
0xFA 0x0153
diff --git a/etc/charsets/symbol.map b/etc/charsets/symbol.map
index 95dd2b65eea..8404bd407ba 100644
--- a/etc/charsets/symbol.map
+++ b/etc/charsets/symbol.map
@@ -1,4 +1,4 @@
-# Generated from admin/charsets/mapfiles/symbol.txt.gz which is a copy of
+# Generated from admin/charsets/mapfiles/symbol.txt which is a copy of
# http://www.unicode.org/Public/MAPPINGS/VENDORS/ADOBE/symbol.txt
0xFE 0xF8FE
0xFD 0xF8FD
diff --git a/etc/compilation.txt b/etc/compilation.txt
index eeb09b1712c..8d31847569c 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -308,6 +308,13 @@ made it more strict about the error message that follows.
keyboard handler.c(537) : warning C4005: 'min' : macro redefinition
d:\tmp\test.c(23) : error C2143: syntax error : missing ';' before 'if'
d:\tmp\test.c(1145) : see declaration of 'nsRefPtr'
+1>test_main.cpp(29): error C2144: syntax error : 'int' should be preceded by ';'
+1>test_main.cpp(29): error C4430: missing type specifier - int assumed. Note: C++ does not support default-int
+1>
+1>Build FAILED.
+1>
+1>Time Elapsed 00:00:01.46
+========== Build: 0 succeeded, 1 failed, 0 up-to-date, 0 skipped ==========
* Open Watcom
@@ -570,7 +577,7 @@ Compilation segmentation fault at Thu Jul 13 10:55:49
Compilation finished at Thu Jul 21 15:02:15
-Copyright (C) 2004-2011 Free Software Foundation, Inc.
+Copyright (C) 2004-2012 Free Software Foundation, Inc.
COPYING PERMISSIONS:
diff --git a/etc/edt-user.el b/etc/edt-user.el
index 84e6f8ca1b8..3a7a707eeda 100644
--- a/etc/edt-user.el
+++ b/etc/edt-user.el
@@ -1,6 +1,6 @@
;;; edt-user.el --- Sample user customizations for Emacs EDT emulation
-;; Copyright (C) 1986, 1992-1993, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1992-1993, 2000-2012 Free Software Foundation, Inc.
;; Author: Kevin Gallagher <kgallagh@@spd.dsccc.com>
;; Maintainer: Kevin Gallagher <kgallagh@@spd.dsccc.com>
diff --git a/etc/emacs-buffer.gdb b/etc/emacs-buffer.gdb
index d4eecc9f8ef..f2584a2f504 100644
--- a/etc/emacs-buffer.gdb
+++ b/etc/emacs-buffer.gdb
@@ -1,6 +1,6 @@
# emacs-buffer.gdb --- gdb macros for recovering buffers from emacs coredumps
-# Copyright (C) 2005-2011 Free Software Foundation, Inc.
+# Copyright (C) 2005-2012 Free Software Foundation, Inc.
# Maintainer: Noah Friedman <friedman@splode.com>
# Created: 2005-04-28
@@ -70,19 +70,16 @@
# Code:
-# Force loading of symbols, enough to give us gdb_valbits etc.
+# Force loading of symbols, enough to give us VALMASK etc.
set main
# When nonzero, display some extra diagnostics in various commands
set $yverbose = 1
set $yfile_buffers_only = 0
-set $tagmask = (((long)1 << gdb_gctypebits) - 1)
-set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
-
define ygetptr
set $ptr = $arg0
- set $ptr = (gdb_use_union ? $ptr.u.val : $ptr & $valmask) | gdb_data_seg_bits
+ set $ptr = ((CHECK_LISP_OBJECT_TYPE ? $ptr.i : $ptr) & VALMASK) | DATA_SEG_BITS
end
define ybuffer-list
diff --git a/etc/emacs.py b/etc/emacs.py
deleted file mode 100644
index 24004b321fe..00000000000
--- a/etc/emacs.py
+++ /dev/null
@@ -1,10 +0,0 @@
-"""Wrapper for version-specific implementations of python.el helper
-functions """
-
-import sys
-
-if sys.version_info[0] == 3:
- from emacs3 import *
-else:
- from emacs2 import *
-
diff --git a/etc/emacs2.py b/etc/emacs2.py
deleted file mode 100644
index 805024cca3d..00000000000
--- a/etc/emacs2.py
+++ /dev/null
@@ -1,236 +0,0 @@
-"""Definitions used by commands sent to inferior Python in python.el."""
-
-# Copyright (C) 2004-2011 Free Software Foundation, Inc.
-# Author: Dave Love <fx@gnu.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/>.
-
-import os, sys, traceback, inspect, __main__
-
-try:
- set
-except:
- from sets import Set as set
-
-__all__ = ["eexecfile", "eargs", "complete", "ehelp", "eimport", "modpath"]
-
-def format_exception (filename, should_remove_self):
- type, value, tb = sys.exc_info ()
- sys.last_type = type
- sys.last_value = value
- sys.last_traceback = tb
- if type is SyntaxError:
- try: # parse the error message
- msg, (dummy_filename, lineno, offset, line) = value
- except:
- pass # Not the format we expect; leave it alone
- else:
- # Stuff in the right filename
- value = SyntaxError(msg, (filename, lineno, offset, line))
- sys.last_value = value
- res = traceback.format_exception_only (type, value)
- # There are some compilation errors which do not provide traceback so we
- # should not massage it.
- if should_remove_self:
- tblist = traceback.extract_tb (tb)
- del tblist[:1]
- res = traceback.format_list (tblist)
- if res:
- res.insert(0, "Traceback (most recent call last):\n")
- res[len(res):] = traceback.format_exception_only (type, value)
- # traceback.print_exception(type, value, tb)
- for line in res: print line,
-
-def eexecfile (file):
- """Execute FILE and then remove it.
- Execute the file within the __main__ namespace.
- If we get an exception, print a traceback with the top frame
- (ourselves) excluded."""
- # We cannot use real execfile since it has a bug where the file stays
- # locked forever (under w32) if SyntaxError occurs.
- # --- code based on code.py and PyShell.py.
- try:
- try:
- source = open (file, "r").read()
- code = compile (source, file, "exec")
- # Other exceptions (shouldn't be any...) will (correctly) fall
- # through to "final".
- except (OverflowError, SyntaxError, ValueError):
- # FIXME: When can compile() raise anything else than
- # SyntaxError ????
- format_exception (file, False)
- return
- try:
- exec code in __main__.__dict__
- except:
- format_exception (file, True)
- finally:
- os.remove (file)
-
-def eargs (name, imports):
- "Get arglist of NAME for Eldoc &c."
- try:
- if imports: exec imports
- parts = name.split ('.')
- if len (parts) > 1:
- exec 'import ' + parts[0] # might fail
- func = eval (name)
- if inspect.isbuiltin (func) or type(func) is type:
- doc = func.__doc__
- if doc.find (' ->') != -1:
- print '_emacs_out', doc.split (' ->')[0]
- else:
- print '_emacs_out', doc.split ('\n')[0]
- return
- if inspect.ismethod (func):
- func = func.im_func
- if not inspect.isfunction (func):
- print '_emacs_out '
- return
- (args, varargs, varkw, defaults) = inspect.getargspec (func)
- # No space between name and arglist for consistency with builtins.
- print '_emacs_out', \
- func.__name__ + inspect.formatargspec (args, varargs, varkw,
- defaults)
- except:
- print "_emacs_out "
-
-def all_names (object):
- """Return (an approximation to) a list of all possible attribute
- names reachable via the attributes of OBJECT, i.e. roughly the
- leaves of the dictionary tree under it."""
-
- def do_object (object, names):
- if inspect.ismodule (object):
- do_module (object, names)
- elif inspect.isclass (object):
- do_class (object, names)
- # Might have an object without its class in scope.
- elif hasattr (object, '__class__'):
- names.add ('__class__')
- do_class (object.__class__, names)
- # Probably not a good idea to try to enumerate arbitrary
- # dictionaries...
- return names
-
- def do_module (module, names):
- if hasattr (module, '__all__'): # limited export list
- names.update(module.__all__)
- for i in module.__all__:
- do_object (getattr (module, i), names)
- else: # use all names
- names.update(dir (module))
- for i in dir (module):
- do_object (getattr (module, i), names)
- return names
-
- def do_class (object, names):
- ns = dir (object)
- names.update(ns)
- if hasattr (object, '__bases__'): # superclasses
- for i in object.__bases__: do_object (i, names)
- return names
-
- return do_object (object, set([]))
-
-def complete (name, imports):
- """Complete TEXT in NAMESPACE and print a Lisp list of completions.
- Exec IMPORTS first."""
- import __main__, keyword
-
- def class_members(object):
- names = dir (object)
- if hasattr (object, '__bases__'):
- for super in object.__bases__:
- names = class_members (super)
- return names
-
- names = set([])
- base = None
- try:
- dict = __main__.__dict__.copy()
- if imports: exec imports in dict
- l = len (name)
- if not "." in name:
- for src in [dir (__builtins__), keyword.kwlist, dict.keys()]:
- for elt in src:
- if elt[:l] == name: names.add(elt)
- else:
- base = name[:name.rfind ('.')]
- name = name[name.rfind('.')+1:]
- try:
- object = eval (base, dict)
- names = set(dir (object))
- if hasattr (object, '__class__'):
- names.add('__class__')
- names.update(class_members (object))
- except: names = all_names (dict)
- except:
- print sys.exc_info()
- names = []
-
- l = len(name)
- print '_emacs_out (',
- for n in names:
- if name == n[:l]:
- if base: print '"%s.%s"' % (base, n),
- else: print '"%s"' % n,
- print ')'
-
-def ehelp (name, imports):
- """Get help on string NAME.
- First try to eval name for, e.g. user definitions where we need
- the object. Otherwise try the string form."""
- locls = {}
- if imports:
- try: exec imports in locls
- except: pass
- try: help (eval (name, globals(), locls))
- except: help (name)
-
-def eimport (mod, dir):
- """Import module MOD with directory DIR at the head of the search path.
- NB doesn't load from DIR if MOD shadows a system module."""
- from __main__ import __dict__
-
- path0 = sys.path[0]
- sys.path[0] = dir
- try:
- try:
- if __dict__.has_key(mod) and inspect.ismodule (__dict__[mod]):
- reload (__dict__[mod])
- else:
- __dict__[mod] = __import__ (mod)
- except:
- (type, value, tb) = sys.exc_info ()
- print "Traceback (most recent call last):"
- traceback.print_exception (type, value, tb.tb_next)
- finally:
- sys.path[0] = path0
-
-def modpath (module):
- """Return the source file for the given MODULE (or None).
-Assumes that MODULE.py and MODULE.pyc are in the same directory."""
- try:
- path = __import__ (module).__file__
- if path[-4:] == '.pyc' and os.path.exists (path[0:-1]):
- path = path[:-1]
- print "_emacs_out", path
- except:
- print "_emacs_out ()"
-
-# print '_emacs_ok' # ready for input and can call continuation
-
diff --git a/etc/emacs3.py b/etc/emacs3.py
deleted file mode 100644
index 470547b1877..00000000000
--- a/etc/emacs3.py
+++ /dev/null
@@ -1,234 +0,0 @@
-# Copyright (C) 2004-2011 Free Software Foundation, Inc.
-# Author: Dave Love <fx@gnu.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/>.
-
-import os, sys, traceback, inspect, imp, __main__
-
-try:
- set
-except:
- from sets import Set as set
-
-__all__ = ["eexecfile", "eargs", "complete", "ehelp", "eimport", "modpath"]
-
-def format_exception (filename, should_remove_self):
- type, value, tb = sys.exc_info ()
- sys.last_type = type
- sys.last_value = value
- sys.last_traceback = tb
- if type is SyntaxError:
- try: # parse the error message
- msg, (dummy_filename, lineno, offset, line) = value
- except:
- pass # Not the format we expect; leave it alone
- else:
- # Stuff in the right filename
- value = SyntaxError(msg, (filename, lineno, offset, line))
- sys.last_value = value
- res = traceback.format_exception_only (type, value)
- # There are some compilation errors which do not provide traceback so we
- # should not massage it.
- if should_remove_self:
- tblist = traceback.extract_tb (tb)
- del tblist[:1]
- res = traceback.format_list (tblist)
- if res:
- res.insert(0, "Traceback (most recent call last):\n")
- res[len(res):] = traceback.format_exception_only (type, value)
- # traceback.print_exception(type, value, tb)
- for line in res: print(line, end=' ')
-
-def eexecfile (file):
- """Execute FILE and then remove it.
- Execute the file within the __main__ namespace.
- If we get an exception, print a traceback with the top frame
- (ourselves) excluded."""
- # We cannot use real execfile since it has a bug where the file stays
- # locked forever (under w32) if SyntaxError occurs.
- # --- code based on code.py and PyShell.py.
- try:
- try:
- source = open (file, "r").read()
- code = compile (source, file, "exec")
- # Other exceptions (shouldn't be any...) will (correctly) fall
- # through to "final".
- except (OverflowError, SyntaxError, ValueError):
- # FIXME: When can compile() raise anything else than
- # SyntaxError ????
- format_exception (file, False)
- return
- try:
- exec(code, __main__.__dict__)
- except:
- format_exception (file, True)
- finally:
- os.remove (file)
-
-def eargs (name, imports):
- "Get arglist of NAME for Eldoc &c."
- try:
- if imports: exec(imports)
- parts = name.split ('.')
- if len (parts) > 1:
- exec('import ' + parts[0]) # might fail
- func = eval (name)
- if inspect.isbuiltin (func) or type(func) is type:
- doc = func.__doc__
- if doc.find (' ->') != -1:
- print('_emacs_out', doc.split (' ->')[0])
- else:
- print('_emacs_out', doc.split ('\n')[0])
- return
- if inspect.ismethod (func):
- func = func.im_func
- if not inspect.isfunction (func):
- print('_emacs_out ')
- return
- (args, varargs, varkw, defaults) = inspect.getargspec (func)
- # No space between name and arglist for consistency with builtins.
- print('_emacs_out', \
- func.__name__ + inspect.formatargspec (args, varargs, varkw,
- defaults))
- except:
- print("_emacs_out ")
-
-def all_names (object):
- """Return (an approximation to) a list of all possible attribute
- names reachable via the attributes of OBJECT, i.e. roughly the
- leaves of the dictionary tree under it."""
-
- def do_object (object, names):
- if inspect.ismodule (object):
- do_module (object, names)
- elif inspect.isclass (object):
- do_class (object, names)
- # Might have an object without its class in scope.
- elif hasattr (object, '__class__'):
- names.add ('__class__')
- do_class (object.__class__, names)
- # Probably not a good idea to try to enumerate arbitrary
- # dictionaries...
- return names
-
- def do_module (module, names):
- if hasattr (module, '__all__'): # limited export list
- names.update(module.__all__)
- for i in module.__all__:
- do_object (getattr (module, i), names)
- else: # use all names
- names.update(dir (module))
- for i in dir (module):
- do_object (getattr (module, i), names)
- return names
-
- def do_class (object, names):
- ns = dir (object)
- names.update(ns)
- if hasattr (object, '__bases__'): # superclasses
- for i in object.__bases__: do_object (i, names)
- return names
-
- return do_object (object, set([]))
-
-def complete (name, imports):
- """Complete TEXT in NAMESPACE and print a Lisp list of completions.
- Exec IMPORTS first."""
- import __main__, keyword
-
- def class_members(object):
- names = dir (object)
- if hasattr (object, '__bases__'):
- for super in object.__bases__:
- names = class_members (super)
- return names
-
- names = set([])
- base = None
- try:
- dict = __main__.__dict__.copy()
- if imports: exec(imports, dict)
- l = len (name)
- if not "." in name:
- for src in [dir (__builtins__), keyword.kwlist, list(dict.keys())]:
- for elt in src:
- if elt[:l] == name: names.add(elt)
- else:
- base = name[:name.rfind ('.')]
- name = name[name.rfind('.')+1:]
- try:
- object = eval (base, dict)
- names = set(dir (object))
- if hasattr (object, '__class__'):
- names.add('__class__')
- names.update(class_members (object))
- except: names = all_names (dict)
- except:
- print(sys.exc_info())
- names = []
-
- l = len(name)
- print('_emacs_out (', end=' ')
- for n in names:
- if name == n[:l]:
- if base: print('"%s.%s"' % (base, n), end=' ')
- else: print('"%s"' % n, end=' ')
- print(')')
-
-def ehelp (name, imports):
- """Get help on string NAME.
- First try to eval name for, e.g. user definitions where we need
- the object. Otherwise try the string form."""
- locls = {}
- if imports:
- try: exec(imports, locls)
- except: pass
- try: help (eval (name, globals(), locls))
- except: help (name)
-
-def eimport (mod, dir):
- """Import module MOD with directory DIR at the head of the search path.
- NB doesn't load from DIR if MOD shadows a system module."""
- from __main__ import __dict__
-
- path0 = sys.path[0]
- sys.path[0] = dir
- try:
- try:
- if mod in __dict__ and inspect.ismodule (__dict__[mod]):
- imp.reload (__dict__[mod])
- else:
- __dict__[mod] = __import__ (mod)
- except:
- (type, value, tb) = sys.exc_info ()
- print("Traceback (most recent call last):")
- traceback.print_exception (type, value, tb.tb_next)
- finally:
- sys.path[0] = path0
-
-def modpath (module):
- """Return the source file for the given MODULE (or None).
-Assumes that MODULE.py and MODULE.pyc are in the same directory."""
- try:
- path = __import__ (module).__file__
- if path[-4:] == '.pyc' and os.path.exists (path[0:-1]):
- path = path[:-1]
- print("_emacs_out", path)
- except:
- print("_emacs_out ()")
-
-# print '_emacs_ok' # ready for input and can call continuation
-
diff --git a/etc/enriched.doc b/etc/enriched.doc
index 5b2e1a88f24..78459de8090 100644
--- a/etc/enriched.doc
+++ b/etc/enriched.doc
@@ -256,7 +256,7 @@ bug reports are welcome.</indent>
-Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
COPYING PERMISSIONS:
diff --git a/etc/forms/README b/etc/forms/README
new file mode 100644
index 00000000000..4d728450ac4
--- /dev/null
+++ b/etc/forms/README
@@ -0,0 +1 @@
+This directory contains some example files for the forms.el library.
diff --git a/etc/forms-d2.dat b/etc/forms/forms-d2.dat
index f6c599c9aa8..f6c599c9aa8 100644
--- a/etc/forms-d2.dat
+++ b/etc/forms/forms-d2.dat
diff --git a/lisp/forms-d2.el b/etc/forms/forms-d2.el
index 12cd5d7d570..9fa2145e4d0 100644
--- a/lisp/forms-d2.el
+++ b/etc/forms/forms-d2.el
@@ -1,6 +1,6 @@
-;;; forms-d2.el --- demo forms-mode -*- no-byte-compile: t -*-
+;;; forms-d2.el --- demo forms-mode
-;; Copyright (C) 1991, 1994-1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994-1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Johan Vromans <jvromans@squirrel.nl>
;; Created: 1989
@@ -27,7 +27,7 @@
;;; Code:
;; Set the name of the data file.
-(setq forms-file (expand-file-name "forms-d2.dat" data-directory))
+(setq forms-file (expand-file-name "forms/forms-d2.dat" data-directory))
;; Use 'forms-enumerate' to set field names and number thereof.
(setq forms-number-of-fields
diff --git a/lisp/forms-pass.el b/etc/forms/forms-pass.el
index b635c965cf0..34d4548434b 100644
--- a/lisp/forms-pass.el
+++ b/etc/forms/forms-pass.el
@@ -1,4 +1,4 @@
-;;; forms-pass.el --- passwd file demo for forms-mode -*- no-byte-compile: t -*-
+;;; forms-pass.el --- passwd file demo for forms-mode
;; This file is part of GNU Emacs.
diff --git a/etc/future-bug b/etc/future-bug
index fb6262dfe55..c18dd995d66 100644
--- a/etc/future-bug
+++ b/etc/future-bug
@@ -30,7 +30,7 @@ comments when you write it (sometime in 2198 as I recall).
P.S. You'll be pleased to know that since (time-forward N) still works
- for N >= 0, we've used it to pre-emptively update configure.in.
+ for N >= 0, we've used it to pre-emptively update configure.ac.
Emacs now configures and builds on every platform that will ever
be made. It wasn't easy, but at least that's one problem out of
the way for good. If you'd like the patch, just ask.
diff --git a/etc/gnus-tut.txt b/etc/gnus-tut.txt
index 9132ece533e..60594f0eb0a 100644
--- a/etc/gnus-tut.txt
+++ b/etc/gnus-tut.txt
@@ -24,7 +24,7 @@ was done by moi, yours truly, your humble servant, Lars Magne
Ingebrigtsen. If you have a WWW browser, you can investigate to your
heart's delight at <URL:http://www.ifi.uio.no/~larsi/larsi.html>.
-;; Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
diff --git a/etc/grep.txt b/etc/grep.txt
index 01ffa9f3ef8..e9fea92e304 100644
--- a/etc/grep.txt
+++ b/etc/grep.txt
@@ -84,7 +84,7 @@ grep -nH -e "xyzxyz" ../info/*
-Copyright (C) 2005-2011 Free Software Foundation, Inc.
+Copyright (C) 2005-2012 Free Software Foundation, Inc.
COPYING PERMISSIONS:
diff --git a/etc/images/README b/etc/images/README
index ae2d0556ad2..a9a8d10be7e 100644
--- a/etc/images/README
+++ b/etc/images/README
@@ -23,19 +23,19 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
File: mh-logo.xpm
Author: Satyaki Das
- Copyright (C) 2003-2011 Free Software Foundation, Inc.
+ Copyright (C) 2003-2012 Free Software Foundation, Inc.
Files: splash.pbm, splash.xpm, gnus.pbm
Author: Luis Fernandes <elf@ee.ryerson.ca>
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
Files: splash.png, splash.svg
Author: Francesc Rocher <rocher@member.fsf.org>
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
Files: checked.xpm, unchecked.xpm
Author: Chong Yidong <cyd@stupidchicken.com>
- Copyright (C) 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2010-2012 Free Software Foundation, Inc.
* The following icons are from GTK+ 2.x. They are not part of Emacs, but
diff --git a/etc/images/checked.xpm b/etc/images/checked.xpm
index 959e77d7050..9dc29171250 100644
--- a/etc/images/checked.xpm
+++ b/etc/images/checked.xpm
@@ -1,5 +1,5 @@
/* XPM */
-/* Copyright (C) 2010-2011 Free Software Foundation, Inc.
+/* Copyright (C) 2010-2012 Free Software Foundation, Inc.
*
* Author: Chong Yidong <cyd@stupidchicken.com>
*
diff --git a/etc/images/custom/README b/etc/images/custom/README
index ad37dc1a7ac..831fb8c6316 100644
--- a/etc/images/custom/README
+++ b/etc/images/custom/README
@@ -6,5 +6,5 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
Files: down.xpm down-pushed.xpm right.xpm right-pushed.xpm
Author: Juri Linkov
-Copyright (C) 2008-2011 Free Software Foundation, Inc.
+Copyright (C) 2008-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/ezimage/README b/etc/images/ezimage/README
index 38d49f3bb64..cf6291208a9 100644
--- a/etc/images/ezimage/README
+++ b/etc/images/ezimage/README
@@ -7,5 +7,5 @@ Files: bits.xpm bitsbang.xpm box-minus.xpm box-plus.xpm
tag-gt.xpm tag-minus.xpm tag-plus.xpm tag-type.xpm tag-v.xpm
tag.xpm unlock.xpm
Author: Eric M. Ludlam
-Copyright (C) 1999-2011 Free Software Foundation, Inc.
+Copyright (C) 1999-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/gnus/README b/etc/images/gnus/README
index b19ad3fedcb..824ca05ee2b 100644
--- a/etc/images/gnus/README
+++ b/etc/images/gnus/README
@@ -7,7 +7,7 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
Files: important.xpm, unimportant.xpm
Author: Simon Josefsson <simon@josefsson.org>
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
Files: catchup.pbm catchup.xpm cu-exit.pbm cu-exit.xpm
describe-group.pbm describe-group.xpm exit-gnus.pbm exit-gnus.xpm
@@ -21,11 +21,11 @@ Files: catchup.pbm catchup.xpm cu-exit.pbm cu-exit.xpm
unsubscribe.pbm unsubscribe.xpm uu-decode.pbm uu-decode.xpm
uu-post.pbm uu-post.xpm
Author: Luis Fernandes <elf@ee.ryerson.ca>
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
Files: gnus.png, gnus.svg
Author: Francesc Rocher <rocher@member.fsf.org>
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
* The following icons are from GNOME 2.x. They are not part of Emacs,
diff --git a/etc/images/gnus/gnus.svg b/etc/images/gnus/gnus.svg
index aad6560a004..9c8e57a3f75 100644
--- a/etc/images/gnus/gnus.svg
+++ b/etc/images/gnus/gnus.svg
@@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Gnu Emacs Logo
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
Author: Francesc Rocher <f.rocher@member.fsf.org>
diff --git a/etc/images/gud/README b/etc/images/gud/README
index 11c22bab49f..a37494bd5fa 100644
--- a/etc/images/gud/README
+++ b/etc/images/gud/README
@@ -1,7 +1,7 @@
COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
The following icons were created by Nick Roberts <nickrob@snap.net.nz>.
-Copyright (C) 2002-2011 Free Software Foundation, Inc.
+Copyright (C) 2002-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
break.pbm, nexti.pbm, go.pbm, pp.pbm, print.pbm, pstar.pbm, remove.pbm
@@ -31,7 +31,7 @@ their copyright assignment included the icons.
The following icons are converted from the Insight Windows style icon
set in src/gdb/gdbtk/library/images2.
-Copyright (C) 2002-2011 Free Software Foundation, Inc.
+Copyright (C) 2002-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
cont.pbm and cont.xpm were converted from continue.gif
@@ -47,7 +47,7 @@ License: GNU General Public License version 3 or later (see COPYING)
The following icons are created from the Insight Windows style icon
set in src/gdb/gdbtk/library/images2.
-Copyright (C) 2002-2011 Free Software Foundation, Inc.
+Copyright (C) 2002-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
rcont.xpm rfinish.xpm
diff --git a/etc/images/icons/README b/etc/images/icons/README
index b11b88781e8..664c52906ac 100644
--- a/etc/images/icons/README
+++ b/etc/images/icons/README
@@ -5,7 +5,7 @@ Files: hicolor/16x16/apps/emacs.png hicolor/24x24/apps/emacs.png
hicolor/128x128/apps/emacs.png hicolor/scalable/apps/emacs.svg
Author: Kentaro Ohkouchi <nanasess@fsm.ne.jp>
-Copyright (C) 2007-2011 Free Software Foundation, Inc.
+Copyright (C) 2007-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
@@ -13,7 +13,7 @@ Files: hicolor/16x16/apps/emacs22.png hicolor/24x24/apps/emacs22.png
hicolor/32x32/apps/emacs22.png hicolor/48x48/apps/emacs22.png
Author: Andrew Zhilin <andrew_zhilin@yahoo.com>
-Copyright (C) 2005-2011 Free Software Foundation, Inc.
+Copyright (C) 2005-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
Files: allout-widgets-dark-bg/closed.png
@@ -62,5 +62,5 @@ Files: allout-widgets-dark-bg/closed.png
allout-widgets-light-bg/through-descender.xpm
Author: Ken Manheimer <ken.manheimer@gmail.com>
-Copyright (C) 2011 Free Software Foundation, Inc.
+Copyright (C) 2011-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/icons/hicolor/scalable/apps/emacs.svg b/etc/images/icons/hicolor/scalable/apps/emacs.svg
index 5abdc931c1c..a40eca6ea93 100644
--- a/etc/images/icons/hicolor/scalable/apps/emacs.svg
+++ b/etc/images/icons/hicolor/scalable/apps/emacs.svg
@@ -10,7 +10,7 @@
id="svg4768"
xml:space="preserve">
<!-- Gnu Emacs Icon
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/etc/images/icons/hicolor/scalable/mimetypes/emacs-document.svg b/etc/images/icons/hicolor/scalable/mimetypes/emacs-document.svg
index 2abe908b92c..04b03bc6317 100644
--- a/etc/images/icons/hicolor/scalable/mimetypes/emacs-document.svg
+++ b/etc/images/icons/hicolor/scalable/mimetypes/emacs-document.svg
@@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Gnu Emacs Document Icon
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/etc/images/mh-logo.xpm b/etc/images/mh-logo.xpm
index 8b1d1f53788..a805d93f7a3 100644
--- a/etc/images/mh-logo.xpm
+++ b/etc/images/mh-logo.xpm
@@ -1,7 +1,7 @@
/* XPM */
/* MH-E Logo
*
- * Copyright (C) 2003-2011 Free Software Foundation, Inc.
+ * Copyright (C) 2003-2012 Free Software Foundation, Inc.
*
* Author: Satyaki Das
*
diff --git a/etc/images/mpc/README b/etc/images/mpc/README
index 99317ea90c0..0df00e859b8 100644
--- a/etc/images/mpc/README
+++ b/etc/images/mpc/README
@@ -2,5 +2,5 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
Files: add.xpm ffwd.xpm next.xpm pause.xpm play.xpm prev.xpm rewind.xpm stop.xpm
Author: Stefan Monnier <monnier@iro.umontreal.ca>
-Copyright (C) 2009-2011 Free Software Foundation, Inc.
+Copyright (C) 2009-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/newsticker/README b/etc/images/newsticker/README
index dc91d9eafd4..a8457845537 100644
--- a/etc/images/newsticker/README
+++ b/etc/images/newsticker/README
@@ -4,5 +4,5 @@ Files: browse-url.xpm get-all.xpm mark-immortal.xpm mark-read.xpm
narrow.xpm next-feed.xpm next-item.xpm prev-feed.xpm
prev-item.xpm update.xpm
Author: Ulf Jasper
-Copyright (C) 2011 Free Software Foundation, Inc.
+Copyright (C) 2011-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/smilies/README b/etc/images/smilies/README
index d009849e36c..db2991b4465 100644
--- a/etc/images/smilies/README
+++ b/etc/images/smilies/README
@@ -3,5 +3,5 @@ Files: blink.pbm blink.xpm braindamaged.xpm cry.xpm dead.xpm evil.xpm
sad.xpm smile.pbm smile.xpm wry.pbm wry.xpm
Authors: Reiner Steib, Simon Josefsson, Kai Grossjohann, Alex
Schroeder, Oliver Scholz, Per Abrahamsen, Kim F. Storm.
-Copyright (C) 1999-2011 Free Software Foundation, Inc.
+Copyright (C) 1999-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/smilies/grayscale/README b/etc/images/smilies/grayscale/README
index dc356104a78..0f936b35bb0 100644
--- a/etc/images/smilies/grayscale/README
+++ b/etc/images/smilies/grayscale/README
@@ -2,5 +2,5 @@ Files: blink.xpm braindamaged.xpm cry.xpm dead.xpm evil.xpm forced.xpm
frown.xpm grin.xpm indifferent.xpm reverse-smile.xpm sad.xpm
smile.xpm wry.xpm
Author: Adam Sjgren
-Copyright (C) 2007-2011 Free Software Foundation, Inc.
+Copyright (C) 2007-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/smilies/medium/README b/etc/images/smilies/medium/README
index dc356104a78..0f936b35bb0 100644
--- a/etc/images/smilies/medium/README
+++ b/etc/images/smilies/medium/README
@@ -2,5 +2,5 @@ Files: blink.xpm braindamaged.xpm cry.xpm dead.xpm evil.xpm forced.xpm
frown.xpm grin.xpm indifferent.xpm reverse-smile.xpm sad.xpm
smile.xpm wry.xpm
Author: Adam Sjgren
-Copyright (C) 2007-2011 Free Software Foundation, Inc.
+Copyright (C) 2007-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/splash.png b/etc/images/splash.png
index 9d051319c1b..a5331f1dc5a 100644
--- a/etc/images/splash.png
+++ b/etc/images/splash.png
Binary files differ
diff --git a/etc/images/splash.svg b/etc/images/splash.svg
index 68ba4d7f7d7..ee90dcb243e 100644
--- a/etc/images/splash.svg
+++ b/etc/images/splash.svg
@@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Gnu Emacs Logo
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
Author: Francesc Rocher <f.rocher@members.fsf.org>
Based on the original work by Luis Fernandes <elf@ee.ryerson.ca>
@@ -22,7 +22,7 @@
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-->
-<!-- Created with Inkscape (http://www.inkscape.org/) -->
+
<svg
xmlns:dc="http://purl.org/dc/elements/1.1/"
xmlns:cc="http://creativecommons.org/ns#"
@@ -30,18 +30,10 @@
xmlns:svg="http://www.w3.org/2000/svg"
xmlns="http://www.w3.org/2000/svg"
xmlns:xlink="http://www.w3.org/1999/xlink"
- xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
- xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
- id="svg6706"
- sodipodi:version="0.32"
- inkscape:version="0.46"
- width="271"
- height="217"
version="1.0"
- sodipodi:docname="splash.svg"
- inkscape:label="fg"
- inkscape:output_extension="org.inkscape.output.svg.inkscape"
- sodipodi:docbase="/home/rocher/local/fret/devel/emacs/etc/images"
+ width="275.96875"
+ height="190.40625"
+ id="svg6706"
style="display:inline">
<metadata
id="metadata2314">
@@ -51,7 +43,7 @@
<dc:format>image/svg+xml</dc:format>
<dc:type
rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
- <dc:title>splash</dc:title>
+ <dc:title></dc:title>
<dc:date>2008/06/28</dc:date>
<dc:creator>
<cc:Agent>
@@ -76,59 +68,29 @@
</metadata>
<defs
id="defs6709">
- <inkscape:perspective
- sodipodi:type="inkscape:persp3d"
- inkscape:vp_x="0 : 108.5 : 1"
- inkscape:vp_y="0 : 1000 : 0"
- inkscape:vp_z="271 : 108.5 : 1"
- inkscape:persp3d-origin="135.5 : 72.333333 : 1"
- id="perspective2498" />
- <linearGradient
- id="linearGradient2558">
- <stop
- style="stop-color:#000000;stop-opacity:1;"
- offset="0"
- id="stop2560" />
- <stop
- style="stop-color:#000000;stop-opacity:1;"
- offset="1"
- id="stop2562" />
- </linearGradient>
<linearGradient
id="linearGradient2550">
<stop
- style="stop-color:#2997f6;stop-opacity:0.78431374;"
- offset="0"
- id="stop2552" />
+ id="stop2552"
+ style="stop-color:#4c94f1;stop-opacity:0.78431374"
+ offset="0" />
<stop
- style="stop-color:#2997f6;stop-opacity:0.78431374;"
- offset="1"
- id="stop2554" />
- </linearGradient>
- <linearGradient
- id="linearGradient8019">
- <stop
- style="stop-color:#000000;stop-opacity:1;"
- offset="0"
- id="stop8021" />
- <stop
- style="stop-color:#000000;stop-opacity:1;"
- offset="1"
- id="stop8023" />
+ id="stop2554"
+ style="stop-color:#4c94f1;stop-opacity:0.78431374"
+ offset="1" />
</linearGradient>
<linearGradient
id="linearGradient7896">
<stop
- style="stop-color:#fc644b;stop-opacity:0.78431374;"
- offset="0"
- id="stop7898" />
+ id="stop7898"
+ style="stop-color:#fc644b;stop-opacity:0.78431374"
+ offset="0" />
<stop
- style="stop-color:#fc644b;stop-opacity:0.78431374;"
- offset="1"
- id="stop7900" />
+ id="stop7900"
+ style="stop-color:#fc644b;stop-opacity:0.78431374"
+ offset="1" />
</linearGradient>
<linearGradient
- inkscape:collect="always"
xlink:href="#linearGradient2550"
id="linearGradient2556"
x1="147.62743"
@@ -137,36 +99,6 @@
y2="203.60176"
gradientUnits="userSpaceOnUse" />
<linearGradient
- inkscape:collect="always"
- xlink:href="#linearGradient2558"
- id="linearGradient2564"
- x1="130.93193"
- y1="92.09787"
- x2="129.53438"
- y2="203.60176"
- gradientUnits="userSpaceOnUse" />
- <linearGradient
- inkscape:collect="always"
- xlink:href="#linearGradient7896"
- id="linearGradient2567"
- gradientUnits="userSpaceOnUse"
- x1="148.13887"
- y1="145.57669"
- x2="179.22762"
- y2="44.272839"
- gradientTransform="translate(-2.4002643e-7,-2.6398943e-6)" />
- <linearGradient
- inkscape:collect="always"
- xlink:href="#linearGradient8019"
- id="linearGradient2569"
- gradientUnits="userSpaceOnUse"
- gradientTransform="translate(0.3535448,0.3535474)"
- x1="91.959305"
- y1="48.593826"
- x2="74.102982"
- y2="153.43918" />
- <linearGradient
- inkscape:collect="always"
xlink:href="#linearGradient7896"
id="linearGradient2425"
gradientUnits="userSpaceOnUse"
@@ -175,98 +107,31 @@
y1="0.92070419"
x2="147.12886"
y2="211.99936" />
- <linearGradient
- inkscape:collect="always"
- xlink:href="#linearGradient8019"
- id="linearGradient2427"
- gradientUnits="userSpaceOnUse"
- gradientTransform="translate(0.3535448,0.3535474)"
- x1="131.99864"
- y1="0.56715417"
- x2="131.99864"
- y2="211.64581" />
</defs>
- <sodipodi:namedview
- inkscape:window-height="973"
- inkscape:window-width="1280"
- inkscape:pageshadow="2"
- inkscape:pageopacity="0"
- guidetolerance="10.0"
- gridtolerance="10.0"
- objecttolerance="10.0"
- borderopacity="1.0"
- bordercolor="#666666"
- pagecolor="#000000"
- id="base"
- inkscape:zoom="2.8284271"
- inkscape:cx="125.4227"
- inkscape:cy="119.51264"
- inkscape:window-x="1280"
- inkscape:window-y="0"
- inkscape:current-layer="layer4"
- showguides="false"
- inkscape:guide-bbox="true"
- width="271px"
- height="217px"
- showgrid="false">
- <sodipodi:guide
- orientation="1,0"
- position="15.291184,193.74726"
- id="guide3598" />
- <sodipodi:guide
- orientation="0,1"
- position="20.4375,213.5"
- id="guide3600" />
- <inkscape:grid
- type="xygrid"
- id="grid3602" />
- <sodipodi:guide
- orientation="1,0"
- position="268.5238,3.0935922"
- id="guide3604" />
- </sodipodi:namedview>
<g
- inkscape:groupmode="layer"
- id="layer5"
- inkscape:label="bg-emacs"
+ transform="translate(5.34375,-11.4375)"
+ id="layer2"
style="display:inline">
<path
- style="opacity:1;fill:#000000;display:inline"
- d="M 6.1695811,203.2763 C 1.8388869,199.67523 2.1127919,195.96424 7.4902622,185.38334 C 11.360302,177.76853 13.266697,175.4371 23.932576,165.27521 C 31.613767,157.95698 35.347917,153.77925 34.210011,153.77692 C 33.227002,153.77489 30.969631,152.89774 29.193641,151.82767 C 23.060428,148.13228 25.538468,143.16627 40.345042,129.48016 C 50.392956,120.19262 61.808486,111.61667 70.72365,106.65814 C 82.250389,100.24706 96.306288,95.980687 100.16995,97.720313 C 104.08818,99.484523 103.03488,102.63111 96.454855,108.81859 C 90.856953,114.08255 78.904354,121.98483 77.956715,121.04837 C 77.726566,120.82094 80.412877,118.60777 83.926288,116.13022 C 88.080496,113.20081 90.545462,110.71551 90.975316,109.02305 C 91.33886,107.59164 91.404962,106.19187 91.122204,105.91245 C 90.458257,105.25633 77.249121,109.36745 72.429356,111.73027 C 59.551532,118.04343 39.874422,133.36949 39.874422,137.08657 C 39.874422,142.86737 51.14064,143.84144 61.015932,138.91444 C 67.925573,135.46708 72.661938,133.89327 72.661938,135.04468 C 72.661938,137.28595 60.432861,146.98956 53.740114,150.05889 C 43.112945,154.93258 35.762073,159.85609 27.416547,167.69001 C 19.721397,174.91343 16.028956,180.83255 16.028956,185.94475 C 16.028956,189.40325 18.963121,192.0724 22.764992,192.0724 C 30.62106,192.0724 35.876253,188.9229 58.932752,170.39661 C 64.024743,166.30511 70.24216,161.77637 72.749233,160.33274 C 77.152328,157.79733 81.603988,156.8733 81.603988,158.49475 C 81.603988,159.39101 71.902629,175.78836 68.545674,180.56606 L 66.324887,183.72675 L 68.710427,181.76307 C 70.022484,180.68304 72.455695,178.4739 74.117585,176.85386 C 86.700092,164.58817 95.303775,158.6898 100.61269,158.6898 C 103.05577,158.6898 104.71944,159.20786 105.0555,160.0733 C 105.56783,161.39265 104.60656,165.7543 102.87196,169.98097 C 102.34023,171.27663 103.90906,170.40701 107.48361,167.4247 C 114.82361,161.30083 121.37103,157.70795 125.19076,157.70795 C 129.70556,157.70795 129.95775,159.64928 126.41484,167.131 C 122.70859,174.95765 122.24133,181.95468 125.24549,184.64134 C 127.07268,186.27542 127.36995,186.23152 131.95202,183.65102 C 134.58906,182.16591 137.86439,179.99005 139.23053,178.81577 C 149.46228,170.02101 177.9823,153.45154 179.79411,155.24929 C 180.60737,156.05623 178.12436,157.94916 169.4855,163.10808 C 155.42407,171.50523 147.19459,179.74778 147.18403,185.44497 C 147.17845,188.45426 147.44709,188.59782 150.28011,187.09951 C 154.812,184.70273 153.8964,186.99676 148.9992,190.30881 C 136.22123,198.95077 131.99912,197.37717 137.76983,186.12356 L 140.28337,181.22184 L 132.44653,186.55593 C 118.74115,195.88442 113.35412,197.77987 109.99145,194.45687 C 107.41491,191.91072 108.0274,184.95007 111.41082,178.32662 C 114.12045,173.02219 115.23973,168.50821 113.84539,168.50821 C 111.49183,168.50821 106.46299,172.71228 100.63284,179.55382 C 90.793753,191.09971 83.05265,198.34612 81.276958,197.67276 C 80.089364,197.22241 80.775746,195.19677 84.767238,187.37233 C 87.499959,182.01541 90.812332,176.39446 92.128056,174.88131 C 96.600938,169.7373 95.099966,167.92406 88.497732,170.49572 C 84.81171,171.93148 80.128461,175.82237 68.486498,187.12126 C 54.869574,200.3369 49.810033,204.05197 49.810033,200.83481 C 49.810033,200.25402 51.598443,196.75276 53.784278,193.05424 C 55.970112,189.35572 57.758522,186.10662 57.758522,185.83402 C 57.758522,185.56141 59.483841,182.76661 61.592555,179.62335 C 63.701269,176.48009 65.762511,172.85458 66.17309,171.56667 C 66.919324,169.22591 66.918152,169.22607 63.084238,171.99663 C 60.974779,173.52102 57.460454,176.37942 55.274619,178.34864 C 53.088785,180.31787 50.128748,182.77536 48.696748,183.80974 C 47.264758,184.84412 43.017285,188.15826 39.257918,191.17449 C 35.498561,194.19072 28.855244,198.71947 24.495001,201.23837 C 15.041456,206.69965 10.847465,207.16605 6.1695811,203.2763 z M 164.29064,193.48948 C 159.4721,190.15427 162.86071,176.51691 170.15765,169.87785 C 173.44029,166.89116 182.32808,160.65348 183.30102,160.65348 C 183.57191,160.65348 182.26182,163.55747 180.38971,167.10679 C 174.95449,177.41134 176.14222,185.19951 183.14894,185.19951 C 189.0246,185.19951 194.10068,182.21811 204.1072,172.88981 C 215.28273,162.47177 224.96686,156.86895 233.29431,156.00343 C 239.43659,155.36503 238.29588,156.74072 229.57959,160.48342 C 220.35337,164.44507 217.59282,166.29563 213.98901,170.93468 C 209.42368,176.81148 208.87974,180.47831 212.1011,183.66166 C 214.13209,185.66868 215.62028,186.18012 219.41545,186.1753 C 222.03596,186.17198 225.40955,185.53543 226.91231,184.76077 C 228.41507,183.9861 229.6446,183.7216 229.6446,184.173 C 229.6446,185.28011 220.19356,190.10495 217.98855,190.12349 C 217.02219,190.13162 214.44312,190.77498 212.25728,191.55316 C 210.07145,192.33135 205.7225,192.98744 202.59297,193.01114 C 197.62523,193.04877 196.70033,192.74874 195.30725,190.64771 C 194.36788,189.23094 193.97736,187.41378 194.35775,186.22942 C 195.17832,183.67453 194.67478,183.70501 190.13081,186.4853 C 176.77802,194.6554 169.0151,196.7596 164.29064,193.48948 z M 234.61241,194.08755 C 233.24626,193.62688 230.67542,193.20594 228.89943,193.15211 C 222.98176,192.97275 225.31175,190.63745 233.95678,188.08324 C 236.17336,187.42834 236.66631,187.53872 236.25502,188.59786 C 235.1982,191.31943 244.23779,192.08477 249.79613,189.74434 C 255.20132,187.46838 257.82958,183.84491 257.89957,178.57248 C 257.95845,174.13691 257.81176,173.88692 254.48363,172.75123 C 252.57103,172.09857 245.97626,171.53962 239.82861,171.50915 C 227.02389,171.44566 225.67995,170.38628 232.78291,165.95527 C 242.22085,160.06764 252.77878,155.74427 257.71879,155.74427 C 263.253,155.74427 263.25585,157.15717 257.72368,158.1684 C 253.89831,158.86764 244.11025,163.87967 242.95139,165.73264 C 241.73834,167.67225 245.04566,168.47814 254.2804,168.49317 C 262.75089,168.50696 263.71804,168.70786 265.95474,170.91818 C 269.71614,174.6352 269.37098,180.55553 265.16441,184.47426 C 257.75353,191.37807 241.6262,196.45259 234.61241,194.08755 z"
id="bg-emacs"
- inkscape:label="bg-emacs" />
- </g>
- <g
- inkscape:groupmode="layer"
- id="layer2"
- inkscape:label="emacs"
- style="opacity:1;display:inline">
- <path
- style="opacity:1;fill:url(#linearGradient2556);fill-opacity:1;stroke:url(#linearGradient2564);display:inline"
- d="M 4.931694,200.50384 C 0.57293401,196.83617 0.84861401,193.05655 6.260934,182.27996 C 10.156054,174.52432 12.074804,172.14977 22.809804,161.79994 C 30.540774,154.34636 34.299124,150.09137 33.153844,150.08899 C 32.164464,150.08693 29.892464,149.19355 28.104964,148.10369 C 21.932004,144.33996 24.426104,139.2821 39.328634,125.34288 C 49.441664,115.88357 60.931174,107.14901 69.904114,102.09877 C 81.505554,95.569112 95.652544,91.223832 99.541235,92.995632 C 103.48487,94.792472 102.42474,97.997262 95.802074,104.29918 C 90.167894,109.66049 78.137834,117.70892 77.184054,116.75514 C 76.952414,116.52351 79.656134,114.26941 83.192314,111.74604 C 87.373444,108.76245 89.854384,106.23118 90.287024,104.50742 C 90.652924,103.04954 90.719454,101.62388 90.434864,101.33929 C 89.766614,100.67104 76.471874,104.85819 71.620874,107.26471 C 58.659594,113.69463 38.854964,129.30414 38.854964,133.08996 C 38.854964,138.97768 50.194194,139.96976 60.133484,134.95164 C 67.087904,131.44052 71.854964,129.8376 71.854964,131.01031 C 71.854964,133.29303 59.546634,143.1761 52.810514,146.3022 C 42.114474,151.26603 34.715964,156.28059 26.316354,164.2594 C 18.571334,171.61641 14.854964,177.645 14.854964,182.85175 C 14.854964,186.37421 17.808144,189.09273 21.634654,189.09273 C 29.541634,189.09273 34.830884,185.88498 58.036804,167.01606 C 63.161794,162.84889 69.419504,158.23639 71.942824,156.76606 C 76.374454,154.18376 80.854964,153.24264 80.854964,154.89408 C 80.854964,155.80691 71.090734,172.50752 67.712024,177.37359 L 65.476844,180.59273 L 67.877844,178.59273 C 69.198404,177.49273 71.647384,175.24273 73.320044,173.59273 C 85.984094,161.10019 94.643534,155.09273 99.986845,155.09273 C 102.44577,155.09273 104.12022,155.62038 104.45846,156.50182 C 104.97411,157.84557 104.00661,162.28789 102.26076,166.59273 C 101.72558,167.91235 103.30459,167.02665 106.90231,163.98918 C 114.28987,157.75205 120.87972,154.09273 124.72421,154.09273 C 129.26827,154.09273 129.52209,156.06996 125.95622,163.69005 C 122.22595,171.66145 121.75566,178.78789 124.77929,181.52424 C 126.61832,183.18854 126.91752,183.14383 131.52929,180.5156 C 134.18342,179.00302 137.47997,176.78692 138.85497,175.59092 C 149.15302,166.63351 177.85787,149.7576 179.68142,151.58859 C 180.49995,152.41046 178.00085,154.3384 169.30601,159.59273 C 155.15345,168.14518 146.87064,176.54017 146.86001,182.34273 C 146.85439,185.40767 147.12477,185.55389 149.97615,184.02787 C 154.53741,181.58676 153.61588,183.92322 148.68694,187.29652 C 135.82616,196.09831 131.57669,194.49561 137.3848,183.03387 L 139.91463,178.04149 L 132.027,183.47424 C 118.2328,192.97525 112.81086,194.90576 109.4264,191.5213 C 106.83316,188.92806 107.44962,181.83868 110.85497,175.09273 C 113.58216,169.6902 114.70869,165.09273 113.30531,165.09273 C 110.9365,165.09273 105.87507,169.37455 100.00713,176.34262 C 90.104284,188.10205 82.313014,195.48248 80.525814,194.79667 C 79.330524,194.33799 80.021354,192.27488 84.038714,184.30573 C 86.789144,178.84974 90.122984,173.12483 91.447234,171.5837 C 95.949104,166.34455 94.438404,164.49778 87.793384,167.117 C 84.083474,168.57931 79.369874,172.54216 67.652464,184.05002 C 53.947294,197.51008 48.854964,201.29386 48.854964,198.0172 C 48.854964,197.42566 50.654964,193.85965 52.854964,190.09273 C 55.054964,186.32581 56.854964,183.01662 56.854964,182.73897 C 56.854964,182.46132 58.591464,179.61483 60.713844,176.41344 C 62.836224,173.21205 64.910824,169.51949 65.324064,168.20776 C 66.075134,165.8237 66.073954,165.82387 62.215194,168.64567 C 60.092064,170.19825 56.554964,173.10952 54.354964,175.11516 C 52.154964,177.12081 49.175744,179.62375 47.734464,180.67726 C 46.293194,181.73077 42.018194,185.1062 38.234464,188.17821 C 34.450744,191.25023 27.764374,195.86273 23.375874,198.42822 C 13.861064,203.9905 9.6398944,204.46553 4.931694,200.50384 z M 164.07748,190.53602 C 159.22771,187.13912 162.63828,173.24955 169.98251,166.4877 C 173.28643,163.44577 182.23181,157.09273 183.21106,157.09273 C 183.48371,157.09273 182.16513,160.05043 180.28088,163.66539 C 174.81044,174.16052 176.00587,182.09273 183.05799,182.09273 C 188.97173,182.09273 194.08071,179.05619 204.15208,169.55537 C 215.40003,158.94465 225.14692,153.23821 233.52834,152.35668 C 239.71042,151.70647 238.56232,153.10761 229.78954,156.91953 C 220.50353,160.95445 217.72509,162.83923 214.09793,167.56408 C 209.50301,173.54957 208.95555,177.28421 212.19778,180.52644 C 214.24193,182.57058 215.73977,183.09147 219.55953,183.08657 C 222.19703,183.08318 225.59248,182.43486 227.10498,181.64587 C 228.61748,180.85688 229.85498,180.58749 229.85498,181.04723 C 229.85498,182.17482 220.34269,187.08889 218.12339,187.10778 C 217.15076,187.11606 214.55498,187.77131 212.35498,188.56389 C 210.15498,189.35647 205.77785,190.02469 202.62803,190.04883 C 197.6281,190.08716 196.69721,189.78158 195.2951,187.64169 C 194.34964,186.19872 193.95659,184.34795 194.33944,183.14169 C 195.16533,180.53954 194.65853,180.57059 190.08511,183.4023 C 176.64579,191.7235 168.83256,193.86662 164.07748,190.53602 z M 234.85498,191.14515 C 233.47998,190.67596 230.89248,190.24723 229.10498,190.19241 C 223.14896,190.00973 225.49405,187.63124 234.1951,185.02979 C 236.42605,184.36278 236.92219,184.4752 236.50824,185.55393 C 235.44457,188.32583 244.54274,189.10533 250.1371,186.72161 C 255.57732,184.40356 258.22261,180.71308 258.29306,175.34313 C 258.35232,170.82553 258.20468,170.57092 254.85498,169.41422 C 252.92998,168.74949 246.29248,168.18021 240.10498,168.14917 C 227.21728,168.08451 225.86463,167.00554 233.01362,162.49258 C 242.51273,156.49606 253.13908,152.09273 258.1111,152.09273 C 263.68118,152.09273 263.68405,153.53176 258.11603,154.56169 C 254.26587,155.27386 244.41437,160.37859 243.248,162.26583 C 242.02709,164.24131 245.35584,165.0621 254.65043,165.07741 C 263.17582,165.09146 264.14923,165.29607 266.40043,167.54727 C 270.1862,171.33304 269.83881,177.36286 265.60498,181.35407 C 258.14607,188.38556 241.91422,193.55393 234.85498,191.14515 z"
- id="emacs"
- inkscape:label="emacs" />
- </g>
- <g
- inkscape:groupmode="layer"
- id="layer4"
- inkscape:label="bg-gnu"
- style="display:inline">
+ d="M -0.54734668,196.72853 C -10.238062,181.78405 5.3965305,167.92976 14.809201,161.97512 c 6.963497,-4.40524 14.224571,-9.82272 13.070957,-9.82483 -0.996579,-0.002 -3.28511,-0.79177 -5.085617,-1.75545 -6.217876,-3.328 -7.955628,-16.0503 7.055337,-28.37575 16.709358,-12.01621 42.570706,-26.817295 64.900729,-20.35237 3.972323,1.58882 2.904483,4.42259 -3.766368,9.99493 -5.675178,4.74062 -17.792772,11.85728 -18.753492,11.01391 -0.233326,-0.20481 2.490068,-2.19795 6.051979,-4.42919 3.551812,-2.45188 6.827,-5.57228 6.234589,-9.02517 -1.977492,-3.21848 -14.566202,0.87624 -19.657994,3.11812 -8.980399,3.95401 -30.419617,17.3969 -29.389287,24.77996 0.719552,5.15612 9.095912,7.16542 19.107524,2.72826 7.005023,-3.10464 12.660323,-6.60409 12.285323,-4.56715 -0.365454,1.98509 -12.574667,10.22701 -19.359801,12.99119 -10.773868,4.38916 -18.049435,9.35351 -26.510163,16.40859 -7.801376,6.50528 -6.794788,9.58593 -6.794788,14.18989 0,3.11466 2.974668,5.51843 6.829021,5.51843 7.964514,0 8.895804,0.12074 32.270578,-16.56369 5.162282,-3.68473 10.228089,-7.76323 13.653652,-9.77045 4.326017,-2.53484 9.463124,-4.13198 8.976988,-1.65526 -3.779364,7.61077 -5.74585,10.67934 -9.167556,16.15546 8.11118,-6.33235 15.840916,-14.71763 24.306604,-15.7298 2.101063,-0.25121 7.741174,-0.49516 8.636184,0.99596 0.66736,1.11183 -0.45512,5.1162 -2.21368,8.92266 -0.53908,1.16685 1.05142,0.38368 4.67533,-2.30213 7.4413,-5.51505 14.07911,-8.75072 17.95157,-8.75072 4.57712,0 4.83279,1.74832 1.24097,8.48622 -3.75741,7.04855 -6.75962,17.21422 -4.65148,19.88378 1.46622,1.85669 7.96734,-2.91147 10.3276,-4.31865 2.42293,-1.44454 6.05649,-3.67201 7.44149,-4.72955 10.37298,-7.92039 39.1617,-23.15505 40.99851,-21.53603 0.82449,0.72672 -1.6928,2.43145 -10.4509,7.07749 -14.25554,7.56231 -22.59862,14.9854 -22.60932,20.11619 -0.006,2.71011 4.1743,2.15203 7.26381,1.4275 4.40695,-1.03349 12.41622,-3.9676 -0.1736,3.14023 -13.16001,7.42973 -22.48474,6.17812 -16.63437,-3.95665 l 3.73574,-6.16441 -9.13253,6.55379 c -13.1916,9.46671 -19.35595,10.10807 -22.76505,7.11544 -2.6121,-2.29301 -1.99116,-8.56165 1.43897,-14.5266 2.74703,-4.77707 3.88176,-8.84229 2.46817,-8.84229 -2.38604,0 -7.35931,4.53611 -13.269938,10.69747 -9.974903,10.39803 -8.541011,15.10079 -10.591215,15.36937 -1.2597,0.16503 -6.977484,-1.59412 -4.555892,-8.64067 1.80805,-5.26122 4.692881,-8.68747 6.822262,-11.55279 3.866732,-5.2031 1.480467,-5.97342 -3.790272,-3.77097 -3.05613,1.27704 -5.350157,4.83814 -17.152826,15.01371 -13.804895,11.90177 -18.199091,17.31988 -20.790434,11.99663 -1.273249,-2.61557 1.017602,-5.97434 3.23361,-9.57032 4.367498,-7.21552 10.687821,-13.92473 8.632844,-16.40082 -2.050191,0.66573 -5.701417,3.94706 -7.917424,5.72051 -2.216008,1.77344 -5.216905,3.98662 -6.668674,4.91816 -1.451757,0.93154 -5.757863,3.9162 -9.569125,6.63254 -3.811251,2.71637 -10.546273,6.79489 -14.966706,9.06335 -9.584043,4.91833 -13.8359278,5.33836 -18.57838668,1.83533 z M 159.75643,187.9147 c -4.88506,-3.00364 -1.44968,-15.28517 5.948,-21.2642 3.32796,-2.68976 12.33843,-8.3073 13.32481,-8.3073 0.27463,0 -1.05354,2.61529 -2.9515,5.81174 -5.51025,9.28008 -4.30612,16.29397 2.79731,16.29397 5.95677,0 10.60291,-1.935 15.24759,-9.21089 3.95762,-6.19961 10.07679,-10.04817 15.75277,-13.07984 4.88528,-2.60934 15.49103,-5.23799 19.83723,-4.00272 6.01532,1.70966 5.07061,0.66399 -3.766,4.03459 -9.35359,3.5678 -12.15223,5.23437 -15.80579,9.41222 -4.62835,5.29254 -5.17979,8.5948 -1.91397,11.46168 2.05902,1.80749 3.56776,2.26807 7.41531,2.26374 2.65669,-0.003 5.81168,-1.7253 7.33518,-2.42296 1.52351,-0.69765 3.03519,0.21321 3.03519,0.61971 -5.88638,3.94569 -11.44839,6.45882 -14.00234,7.27145 -2.61375,0.96599 -7.35132,2.03318 -10.23523,1.93803 -5.03631,0.0339 -9.16147,-1.48631 -10.57379,-3.37846 -0.79608,-1.43217 -1.3268,-2.70381 -0.96262,-3.97903 1.0679,-3.73939 0.16517,-2.52343 -4.28527,0.23044 -13.102,8.10733 -21.40719,9.25285 -26.19688,6.30784 z m 75.29251,0.53861 c -1.38501,-0.41487 -3.99134,-0.79396 -5.79185,-0.84243 -5.99934,-0.16153 -3.6372,-2.26466 5.12716,-4.56493 2.24719,-0.58979 2.74693,-0.49039 2.32997,0.46346 -1.0714,2.45099 8.09297,3.14024 13.72804,1.0325 5.4798,-2.04969 7.70684,-5.31293 8.2153,-10.06119 0.16756,-8.34719 -12.6158,-6.31988 -18.32043,-6.36109 -12.98146,-0.0572 -14.34396,-1.01124 -7.14295,-5.00172 9.56822,-5.3023 20.88185,-11.1336 25.8426,-10.44585 5.86061,0.8125 5.42599,3.39743 -0.5575,3.43312 -3.92889,0.0234 -13.80136,5.14348 -14.97622,6.81223 -1.22979,1.74676 2.12319,2.47254 11.4854,2.48607 8.58743,0.0125 9.56792,0.19334 11.8355,2.18392 3.81332,3.3475 3.46341,8.67923 -0.80123,12.20836 -7.5132,6.21743 -19.30064,10.28748 -30.97375,8.65755 z"
+ style="opacity:1;fill:#000000;display:inline" />
<path
id="bg-gnu"
- d="M 57.964139,213.18663 C 60.419089,204.75722 65.429969,194.08978 70.273479,186.98184 C 75.998719,178.57993 77.670749,176.26272 99.036976,147.11956 C 115.95228,124.04737 118.30926,120.64653 121.64961,114.49211 C 123.19636,111.6423 124.83543,109.31064 125.29198,109.31064 C 126.47686,109.31064 126.39522,109.66459 123.65471,116.40903 C 122.29766,119.74874 121.18735,122.85645 121.18735,123.31503 C 121.18735,123.7736 118.20323,128.91551 114.55597,134.74148 C 105.54448,149.13603 103.76812,151.84051 101.44011,154.71012 C 100.3392,156.06717 97.576726,159.84224 95.301296,163.09916 C 93.025866,166.35608 90.702336,169.52146 90.137886,170.13334 C 89.573446,170.74522 87.335119,173.78537 85.163849,176.88923 C 78.455459,186.47891 69.027339,199.54123 67.687459,201.10211 C 66.985889,201.9194 64.635389,205.57568 62.464109,209.22717 C 58.292149,216.24324 56.654209,217.68444 57.964139,213.18663 z M 124.61625,186.04563 C 124.83962,185.36711 126.14939,181.15242 127.52686,176.67964 C 130.98125,165.46294 141.22429,145.66263 147.31637,138.42553 L 149.80876,135.46469 L 152.06645,138.17879 C 154.75072,141.40568 155.95939,141.52233 160.11276,138.95541 C 163.2081,137.04239 167.82894,129.56665 180.26663,106.34981 C 184.82883,97.833765 185.29178,97.282245 185.31415,100.33657 C 185.35582,106.02506 163.04187,147.45245 155.89413,154.95686 C 151.76625,159.29073 149.69002,159.57951 147.02425,156.19054 C 145.95679,154.83349 144.70321,153.72397 144.23852,153.72494 C 142.61294,153.72834 132.1245,172.68283 127.71922,183.57827 C 126.89618,185.61384 125.76994,187.27931 125.21646,187.27931 C 124.66298,187.27931 124.39289,186.72416 124.61625,186.04563 z M 209.02547,157.62164 C 209.02547,149.06737 216.70827,114.14492 221.39068,101.41508 C 224.44307,93.116695 228.74413,77.605995 229.73782,71.313245 C 230.16639,68.599145 231.23241,62.603446 232.10672,57.989476 C 232.98105,53.375516 233.69701,44.783596 233.69775,38.896326 C 233.69933,26.407625 232.49195,23.375465 226.57475,21.007875 C 218.92783,17.948175 216.38102,19.325695 213.53943,28.058435 C 211.79252,33.427035 209.80633,35.888836 208.08175,34.822986 C 206.18062,33.648025 207.02503,29.812025 210.98936,21.614295 C 219.14998,4.7391768 225.58607,0.53542684 235.51027,5.5983768 C 241.178,8.4898368 244.5555,15.424745 244.5555,24.170665 C 244.5555,34.830366 237.51803,64.304686 230.236,84.143525 C 225.74887,96.368055 218.63951,124.4602 215.34281,142.99293 C 213.23722,154.8297 212.18359,158.67625 210.81231,159.53262 C 209.23367,160.5185 209.02547,160.29584 209.02547,157.62164 z M 112.30406,95.774855 C 112.30335,86.107635 112.04448,84.586865 109.48419,79.208805 C 106.81201,73.595725 102.18346,67.858935 100.32692,67.858935 C 99.858122,67.858935 99.474552,67.299035 99.474552,66.614716 C 99.474552,64.835656 108.19817,52.067806 109.41371,52.067806 C 111.15723,52.067806 116.88946,58.299936 118.94539,62.430736 C 121.55774,67.679455 122.31172,75.379195 121.23073,85.768925 C 120.26817,95.020455 117.08016,103.86358 114.14025,105.43697 C 112.40375,106.36632 112.30479,105.84561 112.30406,95.774855 z M 42.858299,98.382615 C 38.870809,95.246035 39.403889,91.231535 45.304209,79.963515 C 50.287489,70.446755 55.424119,62.397976 66.798189,46.283706 C 73.416469,36.907226 75.458009,34.630905 76.402269,35.575166 C 77.203719,36.376616 73.776549,41.731156 64.898629,53.548226 C 47.914999,76.154535 46.116239,84.637005 58.306059,84.637005 C 61.619079,84.637005 64.380449,83.932335 66.788859,82.472295 C 73.165649,78.606515 85.039239,69.582285 90.356266,64.560456 C 93.212106,61.863176 95.826996,59.934616 96.167146,60.274766 C 97.215066,61.322676 91.247486,71.864225 88.330109,74.118685 C 86.814629,75.289785 82.440909,78.912715 78.610739,82.169635 C 74.780549,85.426555 70.024799,89.201625 68.042379,90.558675 C 66.059969,91.915725 63.630929,93.753035 62.644519,94.641595 C 60.390529,96.671985 50.693159,100.42814 47.705199,100.42814 C 46.469649,100.42814 44.288549,99.507655 42.858299,98.382615 z M 169.7749,60.406226 C 165.40905,57.348266 165.38722,55.857466 169.58131,47.184626 L 173.49686,39.087756 L 176.05125,42.123476 C 179.08264,45.726076 182.7945,46.065336 188.79309,43.288076 C 193.61332,41.056386 197.11837,37.355796 200.57535,30.848485 L 203.19691,25.913765 L 202.7015,29.722235 C 201.96128,35.412666 192.58555,51.658577 187.75951,55.613156 C 180.48049,61.577766 173.9372,63.321616 169.7749,60.406226 z M 136.97847,54.083106 C 135.0786,53.068216 128.47651,46.850616 122.30716,40.266216 C 110.74484,27.926045 102.95202,22.459455 96.922976,22.459455 C 92.611736,22.459455 87.006919,26.267795 85.102389,30.491285 C 82.350399,36.594116 81.142179,37.013716 78.889729,32.648845 C 75.725529,26.517155 66.110359,18.511675 61.909959,18.511675 C 61.279849,18.511675 55.705859,23.640995 49.523299,29.910165 C 38.010599,41.584146 32.761459,45.096006 26.763059,45.137516 C 23.263229,45.161736 18.999129,42.054906 16.400189,37.587106 C 14.809579,34.852746 14.849989,34.512975 17.497749,28.357115 C 19.009679,24.841995 20.584839,21.077735 20.998129,19.992085 C 21.652009,18.274415 21.991459,18.555015 23.613259,22.153815 C 25.529349,26.405655 29.950509,30.355015 32.794169,30.355015 C 36.955659,30.355015 44.328219,24.959145 54.247879,14.653345 C 63.827629,4.7006968 65.105539,3.7074968 68.331459,3.7074968 C 72.636069,3.7074968 77.912339,6.8782868 83.025429,12.537855 C 85.100189,14.834365 86.897599,16.562795 87.019689,16.378815 C 87.141779,16.194835 87.967249,14.881735 88.854049,13.460805 C 89.740846,12.039875 92.549116,9.6567568 95.094626,8.1649868 C 98.790816,5.9988768 100.57197,5.5483668 103.93934,5.9279268 C 110.80604,6.7018968 118.98765,12.481855 129.22745,23.792885 C 138.48067,34.014145 146.97435,40.224466 151.70045,40.224466 C 155.50397,40.224466 161.22658,36.521316 164.17375,32.152895 C 166.60256,28.552815 167.0995,28.209095 167.36029,29.948825 C 167.53023,31.082475 166.07293,35.512926 164.12185,39.794286 C 160.75337,47.185936 157.19211,51.363797 151.37603,54.746936 C 148.31837,56.525536 140.9114,56.184026 136.97847,54.083106 z"
- style="opacity:1;fill:#000000;display:inline"
- inkscape:label="bg-gnu" />
+ d="m 55.834396,197.41294 c 2.448659,-7.38073 7.446723,-16.72109 12.277833,-22.94475 5.710592,-7.35667 7.378339,-9.3856 28.689891,-34.90319 16.87202,-20.20188 19.22296,-23.17964 22.55476,-28.56842 1.5428,-2.49527 3.17766,-4.53686 3.63304,-4.53686 1.18186,0 1.10043,0.30992 -1.63307,6.21531 -1.35357,2.92423 -2.46105,5.64532 -2.46105,6.04685 0,0.40153 -2.97647,4.90375 -6.6144,10.00493 -8.98843,12.60381 -10.76025,14.97182 -13.0823,17.48445 -1.0981,1.18822 -3.8535,4.49366 -6.123108,7.34539 -2.269606,2.85173 -4.587188,5.62332 -5.150194,6.15909 -0.562997,0.53575 -2.795585,3.19769 -4.961309,5.91542 -6.691216,8.39667 -16.095209,19.83397 -17.431654,21.20066 -0.699773,0.71561 -3.044271,3.91702 -5.209995,7.11426 -4.16128,6.14322 -5.795033,7.40513 -4.488444,3.46686 z m 66.481544,-23.7645 c 0.22279,-0.5941 1.5292,-4.28446 2.90315,-8.20081 3.44555,-9.82127 13.66236,-27.15831 19.73886,-33.49506 l 2.48602,-2.59251 2.25191,2.37646 c 2.67739,2.82544 3.88298,2.92759 8.02572,0.68 3.08741,-1.67502 7.69643,-8.22076 20.10229,-28.54928 4.55053,-7.456586 5.01229,-7.939498 5.0346,-5.26516 0.0415,4.9808 -22.21528,41.2544 -29.34472,47.82522 -4.11732,3.7947 -6.18823,4.04757 -8.84718,1.0802 -1.06473,-1.18822 -2.3151,-2.15972 -2.77861,-2.15886 -1.62142,0.003 -12.08302,16.59943 -16.47702,26.13939 -0.82094,1.78235 -1.9443,3.24062 -2.49635,3.24062 -0.55207,0 -0.82147,-0.48609 -0.59867,-1.08021 z m 84.19319,-24.88787 c 0,-7.49007 7.66313,-38.06798 12.33356,-49.21415 3.04458,-7.266009 7.33463,-20.847085 8.32578,-26.356986 0.42748,-2.376449 1.49075,-7.626245 2.36285,-11.666209 0.87207,-4.039964 1.5862,-11.563 1.58694,-16.717855 0.002,-10.935036 -1.20271,-13.589976 -7.10476,-15.663026 -7.62736,-2.67905 -10.16765,-1.47291 -13.00198,6.173428 -1.74243,4.700723 -3.72352,6.856253 -5.44369,5.923006 -1.89626,-1.028794 -1.05403,-4.387566 2.90016,-11.565454 8.13973,-14.77576 14.55936,-18.45654 24.45815,-14.02345 5.65324,2.53175 9.02208,8.60392 9.02208,16.2618 0,9.333563 -7.01946,35.141105 -14.28285,52.511886 -4.47563,10.703728 -11.5668,35.30103 -14.85507,51.5282 -2.1002,10.36421 -3.15113,13.73222 -4.51891,14.48205 -1.5746,0.86323 -1.78226,0.66827 -1.78226,-1.67324 z M 110.03525,94.607887 c -7.1e-4,-8.464568 -0.25892,-9.796146 -2.81265,-14.505144 -2.66535,-4.914782 -7.28206,-9.937882 -9.13385,-9.937882 -0.4676,0 -0.85017,-0.490243 -0.85017,-1.08943 0,-1.557732 8.70129,-12.737188 9.91372,-12.737188 1.73907,0 7.4566,5.456815 9.50728,9.073719 2.60567,4.595744 3.35771,11.337596 2.2795,20.434785 -0.9601,8.100583 -4.13995,15.843563 -7.07234,17.221213 -1.73206,0.81373 -1.83075,0.3578 -1.83149,-8.460073 z m -69.268036,2.283327 c -3.977291,-2.746359 -3.44557,-6.261434 2.439644,-16.127646 4.970535,-8.33282 10.094017,-15.38029 21.43897,-29.489855 6.601357,-8.209992 8.637667,-10.20312 9.579511,-9.376336 0.799394,0.701746 -2.618999,5.390153 -11.474198,15.737111 -16.940162,19.79395 -18.734332,27.221155 -6.575701,27.221155 3.304542,0 6.058837,-0.617002 8.461092,-1.895408 6.360466,-3.38485 18.203678,-11.286415 23.507089,-15.683501 2.848527,-2.361722 5.456729,-4.05036 5.795999,-3.752528 1.04524,0.917548 -4.907057,10.147668 -7.816978,12.121655 -1.511589,1.025416 -5.874113,4.197632 -9.69449,7.049372 -3.820388,2.85174 -8.563965,6.157166 -10.541309,7.345392 -1.977334,1.188224 -4.400156,2.796969 -5.384044,3.574986 -2.248219,1.777799 -11.920783,5.066639 -14.901091,5.066639 -1.232383,0 -3.407898,-0.80597 -4.834494,-1.791036 z M 167.35901,63.639316 c -4.35468,-2.677534 -4.37646,-3.982873 -0.1931,-11.57676 l 3.90554,-7.089571 2.54785,2.658058 c 3.02363,3.154415 6.72598,3.451472 12.70923,1.019721 4.8079,-1.95406 8.30397,-5.194275 11.75211,-10.892036 l 2.61484,-4.320814 -0.49413,3.334678 c -0.73833,4.982504 -10.09007,19.207325 -14.90376,22.669936 -7.26038,5.222576 -13.78694,6.749482 -17.93858,4.196788 z m -32.7125,-5.536491 c -1.89501,-0.888629 -8.4802,-6.332726 -14.63377,-12.09799 -11.53272,-10.804983 -19.30559,-15.591501 -25.31921,-15.591501 -4.300218,0 -9.890682,3.33457 -11.790334,7.032628 -2.74495,5.343604 -3.950075,5.711001 -6.196765,1.88915 -3.156098,-5.368868 -12.746669,-12.378428 -16.936324,-12.378428 -0.628489,0 -6.188212,4.49121 -12.354949,9.980456 -11.483232,10.221671 -16.718945,13.296629 -22.701995,13.33298 -3.490867,0.0212 -7.744061,-2.699113 -10.336357,-6.611093 -1.586521,-2.394192 -1.546221,-2.69169 1.094758,-8.081731 1.508064,-3.077822 3.079193,-6.373792 3.491421,-7.324372 0.652211,-1.50398 0.990788,-1.25829 2.608443,1.8928 1.911186,3.72288 6.321032,7.180923 9.157411,7.180923 4.150835,0 11.504527,-4.724593 21.3988,-13.748293 9.555236,-8.71448 10.829873,-9.58412 14.047538,-9.58412 4.293595,0 9.556372,2.77633 14.656374,7.73182 2.069449,2.0108 3.86226,3.5242 3.984029,3.36311 0.12178,-0.16109 0.945137,-1.31084 1.829667,-2.55499 0.88453,-1.24416 3.685604,-3.3308 6.224606,-4.63699 3.686737,-1.89664 5.463317,-2.29109 8.822097,-1.95876 6.8491,0.67769 15.00978,5.73859 25.22338,15.64246 9.22954,8.949677 17.70147,14.387397 22.41549,14.387397 3.79377,0 9.50175,-3.242454 12.44138,-7.067419 2.42259,-3.152211 2.91825,-3.453173 3.17838,-1.929873 0.1695,0.992615 -1.28406,4.871896 -3.23015,8.620627 -3.35987,6.472087 -6.91202,10.130201 -12.7132,13.092455 -3.04983,1.557333 -10.43785,1.258306 -14.36072,-0.581246 z"
+ style="opacity:1;fill:#000000;display:inline" />
</g>
<g
- inkscape:groupmode="layer"
+ transform="translate(5.34375,-11.4375)"
id="layer3"
- inkscape:label="gnu"
- style="opacity:1;display:inline">
+ style="display:inline">
<path
- style="fill:url(#linearGradient2425);fill-opacity:1;stroke:url(#linearGradient2427);stroke-width:0.97730815"
- d="M 61.076106,208.96096 C 63.507076,200.61386 68.469036,190.05059 73.265246,183.01206 C 78.934586,174.69219 80.590286,172.3976 101.74788,143.53901 C 118.49803,120.69211 120.83199,117.32446 124.13972,111.23014 C 125.67137,108.40816 127.29443,106.09927 127.74652,106.09927 C 128.91983,106.09927 128.83899,106.44977 126.12524,113.12835 C 124.78145,116.43545 123.68197,119.51281 123.68197,119.96691 C 123.68197,120.42101 120.727,125.51271 117.11535,131.28179 C 108.19185,145.5358 106.43283,148.21386 104.12755,151.05546 C 103.03739,152.39925 100.30189,156.13747 98.048676,159.36258 C 95.795466,162.58769 93.494626,165.72216 92.935686,166.32808 C 92.376756,166.93398 90.160296,169.94445 88.010216,173.018 C 81.367336,182.51404 72.031276,195.44882 70.704486,196.99445 C 70.009766,197.80377 67.682206,201.42433 65.532126,205.04018 C 61.400906,211.98774 59.778956,213.41486 61.076106,208.96096 z M 127.0774,182.08499 C 127.29858,181.41309 128.59556,177.23956 129.95958,172.81045 C 133.38024,161.70328 143.52325,142.0963 149.55585,134.92988 L 152.02391,131.99795 L 154.25955,134.68555 C 156.91761,137.88092 158.11448,137.99645 162.2273,135.45458 C 165.29241,133.56025 169.86813,126.15749 182.18437,103.16735 C 186.70202,94.734476 187.16045,94.188338 187.18261,97.212831 C 187.22387,102.84577 165.1278,143.86866 158.04986,151.29979 C 153.96228,155.59134 151.90633,155.8773 149.26659,152.52142 C 148.20955,151.17762 146.96821,150.07893 146.50805,150.0799 C 144.89835,150.08326 134.51232,168.85268 130.15006,179.64172 C 129.33506,181.65742 128.21981,183.30663 127.67174,183.30663 C 127.12367,183.30663 126.85621,182.7569 127.0774,182.08499 z M 210.6624,153.93855 C 210.6624,145.46781 218.27017,110.88634 222.90686,98.280809 C 225.92945,90.063464 230.18852,74.704222 231.1725,68.472911 C 231.59689,65.785315 232.65248,59.848166 233.51827,55.279251 C 234.38405,50.710335 235.09303,42.202312 235.09375,36.372532 C 235.09532,24.005777 233.89974,21.003224 228.04031,18.65875 C 220.46806,15.628931 217.94613,16.993 215.13227,25.640465 C 213.40243,30.956652 211.43564,33.394405 209.7279,32.338969 C 207.84533,31.175475 208.68148,27.37694 212.60711,19.259251 C 220.68804,2.5489063 227.06129,-1.6137938 236.88858,3.3997163 C 242.50098,6.2629463 245.84549,13.130142 245.84549,21.790666 C 245.84549,32.346272 238.87674,61.532787 231.66581,81.177917 C 227.22251,93.283081 220.18256,121.1009 216.91805,139.45268 C 214.83302,151.17387 213.78968,154.98286 212.43178,155.83087 C 210.86856,156.80712 210.6624,156.58663 210.6624,153.93855 z M 114.88542,92.695674 C 114.88472,83.122844 114.62838,81.616923 112.09309,76.291377 C 109.447,70.733105 104.86364,65.052333 103.02522,65.052333 C 102.561,65.052333 102.18119,64.497902 102.18119,63.820263 C 102.18119,62.058579 110.81963,49.415401 112.0233,49.415401 C 113.7498,49.415401 119.42604,55.586675 121.4619,59.677138 C 124.04875,64.874602 124.79536,72.499162 123.72493,82.787443 C 122.77177,91.948632 119.61489,100.7054 116.70368,102.26342 C 114.98414,103.1837 114.88615,102.66807 114.88542,92.695674 z M 46.117766,95.277953 C 42.169206,92.172018 42.697086,88.196715 48.539786,77.038724 C 53.474416,67.61489 58.560886,59.644698 69.823886,43.687774 C 76.377556,34.40285 78.399156,32.148763 79.334196,33.083797 C 80.127816,33.877423 76.734116,39.179682 67.942886,50.881363 C 51.125096,73.266927 49.343886,81.666573 61.414686,81.666573 C 64.695356,81.666573 67.429756,80.968786 69.814656,79.523 C 76.129176,75.694973 87.886836,66.758858 93.151936,61.786064 C 95.979886,59.115122 98.569246,57.205392 98.906066,57.542219 C 99.943756,58.579901 94.034456,69.018517 91.145556,71.250958 C 89.644886,72.410631 85.313876,75.998184 81.521096,79.223302 C 77.728306,82.448419 73.018996,86.186623 71.055936,87.530422 C 69.092886,88.87422 66.687566,90.693597 65.710786,91.57348 C 63.478806,93.584045 53.876116,97.303502 50.917336,97.303502 C 49.693856,97.303502 47.534056,96.392006 46.117766,95.277953 z M 171.79508,57.6724 C 167.47186,54.644298 167.45024,53.16805 171.60338,44.5799 L 175.48071,36.562094 L 178.01015,39.56817 C 181.01195,43.135591 184.68755,43.471543 190.62758,40.721402 C 195.40074,38.511498 198.87156,34.847043 202.29479,28.403277 L 204.89074,23.516737 L 204.40017,27.288026 C 203.66718,32.922889 194.383,49.01016 189.60409,52.926128 C 182.39615,58.832494 175.91674,60.559318 171.79508,57.6724 z M 139.3189,51.411018 C 137.43758,50.406042 130.89996,44.249152 124.79084,37.729043 C 113.34143,25.509367 105.62471,20.096158 99.654526,20.096158 C 95.385376,20.096158 89.835296,23.867317 87.949366,28.04956 C 85.224246,34.092801 84.027826,34.5083 81.797366,30.186057 C 78.664066,24.11424 69.142776,16.186925 64.983386,16.186925 C 64.359436,16.186925 58.839876,21.266163 52.717686,27.474119 C 41.317406,39.034109 36.119516,42.511671 30.179686,42.552781 C 26.714036,42.576765 22.491566,39.500273 19.917996,35.076099 C 18.342936,32.368437 18.382946,32.031988 21.004846,25.936231 C 22.502016,22.45543 24.061796,18.727927 24.471046,17.652887 C 25.118546,15.951984 25.454676,16.229839 27.060646,19.793504 C 28.958026,24.003825 33.336016,27.914623 36.151906,27.914623 C 40.272756,27.914623 47.573326,22.571437 57.396126,12.36627 C 66.882336,2.5108063 68.147766,1.5273063 71.342186,1.5273063 C 75.604766,1.5273063 80.829526,4.6671363 85.892686,10.271446 C 87.947186,12.54552 89.727046,14.257073 89.847936,14.07489 C 89.968836,13.892711 90.786246,12.59243 91.664386,11.185376 C 92.542526,9.7783256 95.323366,7.4184763 97.844026,5.9412663 C 101.50413,3.7963063 103.26788,3.3502063 106.60239,3.7260463 C 113.40203,4.4924663 121.50375,10.215986 131.64357,21.416572 C 140.80643,31.538025 149.21716,37.687703 153.89713,37.687703 C 157.6635,37.687703 163.33024,34.020716 166.24863,29.69495 C 168.65373,26.130021 169.14581,25.789654 169.40405,27.5124 C 169.57233,28.634976 168.12927,33.022171 166.19724,37.261722 C 162.86165,44.581197 159.33516,48.718266 153.57588,52.068368 C 150.54808,53.829602 143.21343,53.491422 139.3189,51.411018 z"
id="gnu"
- inkscape:label="gnu" />
+ d="m 57.534816,196.31319 c 2.448659,-7.38073 7.446723,-16.72109 12.277833,-22.94475 5.710592,-7.35667 7.378339,-9.3856 28.689891,-34.90319 16.87202,-20.20188 19.22296,-23.17964 22.55476,-28.56842 1.5428,-2.49527 3.17766,-4.53686 3.63304,-4.53686 1.18186,0 1.10043,0.30992 -1.63307,6.21531 -1.35357,2.92423 -2.46105,5.64532 -2.46105,6.04685 0,0.40153 -2.97647,4.90375 -6.6144,10.00493 -8.98843,12.60381 -10.76025,14.97182 -13.0823,17.48445 -1.0981,1.18822 -3.8535,4.49366 -6.123108,7.34539 -2.269606,2.85173 -4.587188,5.62332 -5.150194,6.15909 -0.562997,0.53575 -2.795585,3.19769 -4.961309,5.91542 -6.691216,8.39667 -16.095209,19.83397 -17.431654,21.20066 -0.699773,0.71561 -3.044271,3.91702 -5.209995,7.11426 -4.16128,6.14322 -5.795033,7.40513 -4.488444,3.46686 z m 66.481544,-23.7645 c 0.22279,-0.5941 1.5292,-4.28446 2.90315,-8.20081 3.44555,-9.82127 13.66236,-27.15831 19.73886,-33.49506 l 2.48602,-2.59251 2.25191,2.37646 c 2.67739,2.82544 3.88298,2.92759 8.02572,0.68 3.08741,-1.67502 7.69643,-8.22076 20.10229,-28.54928 4.55053,-7.45659 5.01229,-7.939502 5.0346,-5.26516 0.0415,4.9808 -22.21528,41.2544 -29.34472,47.82522 -4.11732,3.7947 -6.18823,4.04757 -8.84718,1.0802 -1.06473,-1.18822 -2.3151,-2.15972 -2.77861,-2.15886 -1.62142,0.003 -12.08302,16.59943 -16.47702,26.13939 -0.82094,1.78235 -1.9443,3.24062 -2.49635,3.24062 -0.55207,0 -0.82147,-0.48609 -0.59867,-1.08021 z m 84.19319,-24.88787 c 0,-7.49007 7.66313,-38.06798 12.33356,-49.21415 3.04458,-7.266013 7.33463,-20.847089 8.32578,-26.35699 0.42748,-2.376449 1.49075,-7.626245 2.36285,-11.666209 0.87207,-4.039964 1.5862,-11.563 1.58694,-16.717855 0.002,-10.935036 -1.20271,-13.589976 -7.10476,-15.663026 -7.62736,-2.67905 -10.16765,-1.47291 -13.00198,6.173428 -1.74243,4.700723 -3.72352,6.856253 -5.44369,5.923006 -1.89626,-1.028794 -1.05403,-4.387566 2.90016,-11.565454 8.13973,-14.77576 14.55936,-18.45654 24.45815,-14.02345 5.65324,2.53175 9.02208,8.60392 9.02208,16.2618 0,9.333563 -7.01946,35.141105 -14.28285,52.511886 -4.47563,10.703728 -11.5668,35.301034 -14.85507,51.528204 -2.1002,10.36421 -3.15113,13.73222 -4.51891,14.48205 -1.5746,0.86323 -1.78226,0.66827 -1.78226,-1.67324 z M 111.73567,93.508133 c -7.1e-4,-8.464568 -0.25892,-9.796146 -2.81265,-14.505144 -2.66535,-4.914782 -7.28206,-9.937882 -9.13385,-9.937882 -0.4676,0 -0.85017,-0.490243 -0.85017,-1.08943 0,-1.557732 8.70129,-12.737188 9.91372,-12.737188 1.73907,0 7.4566,5.456815 9.50728,9.073719 2.60567,4.595744 3.35771,11.337596 2.2795,20.434785 -0.9601,8.100583 -4.13995,15.843567 -7.07234,17.221217 -1.73206,0.81373 -1.83075,0.3578 -1.83149,-8.460077 z M 42.467634,95.79146 c -3.977291,-2.746359 -3.44557,-6.261434 2.439644,-16.127646 4.970535,-8.33282 10.094017,-15.38029 21.43897,-29.489855 6.601357,-8.209992 8.637667,-10.20312 9.579511,-9.376336 0.799394,0.701746 -2.618999,5.390153 -11.474198,15.737111 -16.940162,19.79395 -18.734332,27.221155 -6.575701,27.221155 3.304542,0 6.058837,-0.617002 8.461092,-1.895408 6.360466,-3.38485 18.203678,-11.286415 23.507089,-15.683501 2.848527,-2.361722 5.456729,-4.05036 5.795999,-3.752528 1.04524,0.917548 -4.907057,10.147668 -7.816978,12.121655 -1.511589,1.025416 -5.874113,4.197632 -9.69449,7.049372 -3.820388,2.85174 -8.563965,6.157166 -10.541309,7.345392 -1.977334,1.188224 -4.400156,2.796969 -5.384044,3.574986 C 59.955,94.293656 50.282436,97.5825 47.302128,97.5825 c -1.232383,0 -3.407898,-0.80597 -4.834494,-1.79104 z M 169.05943,62.539562 c -4.35468,-2.677534 -4.37646,-3.982873 -0.1931,-11.57676 l 3.90554,-7.089571 2.54785,2.658058 c 3.02363,3.154415 6.72598,3.451472 12.70923,1.019721 4.8079,-1.95406 8.30397,-5.194275 11.75211,-10.892036 l 2.61484,-4.320814 -0.49413,3.334678 c -0.73833,4.982504 -10.09007,19.207325 -14.90376,22.669936 -7.26038,5.222576 -13.78694,6.749482 -17.93858,4.196788 z m -32.7125,-5.536491 c -1.89501,-0.888629 -8.4802,-6.332726 -14.63377,-12.09799 C 110.18044,34.100098 102.40757,29.31358 96.39395,29.31358 c -4.300218,0 -9.890682,3.33457 -11.790334,7.032628 -2.74495,5.343604 -3.950075,5.711001 -6.196765,1.88915 C 75.250753,32.86649 65.660182,25.85693 61.470527,25.85693 c -0.628489,0 -6.188212,4.49121 -12.354949,9.980456 -11.483232,10.221671 -16.718945,13.296629 -22.701995,13.33298 -3.490867,0.0212 -7.744061,-2.699113 -10.336357,-6.611093 -1.586521,-2.394192 -1.546221,-2.69169 1.094758,-8.081731 1.508064,-3.077822 3.079193,-6.373792 3.491421,-7.324372 0.652211,-1.50398 0.990788,-1.25829 2.608443,1.8928 1.911186,3.72288 6.321032,7.180923 9.157411,7.180923 4.150835,0 11.504527,-4.724593 21.3988,-13.748293 9.555236,-8.71448 10.829873,-9.58412 14.047538,-9.58412 4.293595,0 9.556372,2.77633 14.656374,7.73182 2.069449,2.0108 3.86226,3.5242 3.984029,3.36311 0.12178,-0.16109 0.945137,-1.31084 1.829667,-2.55499 0.88453,-1.24416 3.685604,-3.3308 6.224606,-4.63699 3.686737,-1.89664 5.463317,-2.29109 8.822097,-1.95876 6.8491,0.67769 15.00978,5.73859 25.22338,15.64246 9.22954,8.949677 17.70147,14.387397 22.41549,14.387397 3.79377,0 9.50175,-3.242454 12.44138,-7.067419 2.42259,-3.152211 2.91825,-3.453173 3.17838,-1.929873 0.1695,0.992615 -1.28406,4.871896 -3.23015,8.620627 -3.35987,6.472087 -6.91202,10.130201 -12.7132,13.092455 -3.04983,1.557333 -10.43785,1.258306 -14.36072,-0.581246 z"
+ style="fill:url(#linearGradient2425);fill-opacity:1;stroke:#000000;stroke-width:0.97730815" />
+ <path
+ id="emacs"
+ d="M -0.94705426,195.12806 C -10.63777,180.18357 4.9968228,166.32928 14.409493,160.37464 c 6.963497,-4.40524 14.224571,-9.82272 13.070957,-9.82483 -0.996579,-0.002 -3.28511,-0.79177 -5.085617,-1.75545 -6.217876,-3.328 -7.955628,-16.0503 7.055337,-28.37575 16.709358,-12.01621 42.570706,-26.817291 64.900729,-20.35236 3.972325,1.58882 2.904485,4.42259 -3.766368,9.99492 -5.675178,4.74062 -17.792772,11.85728 -18.753492,11.01391 -0.233326,-0.20481 2.490068,-2.19795 6.051979,-4.42919 3.551812,-2.45188 6.827,-5.57228 6.234589,-9.02516 -1.977492,-3.21848 -14.566202,0.87623 -19.657994,3.11811 -8.980399,3.95401 -30.419617,17.3969 -29.389287,24.77996 0.719552,5.15612 9.095912,7.16542 19.107524,2.72826 7.005023,-3.10464 12.660323,-6.60409 12.285323,-4.56715 -0.365454,1.98509 -12.574667,10.22701 -19.359801,12.99119 -10.773868,4.38916 -18.049435,9.35351 -26.510163,16.40859 -7.801376,6.50528 -6.794788,9.58593 -6.794788,14.18989 0,3.11466 2.974668,5.51844 6.829021,5.51844 7.964514,0 8.895804,0.12074 32.270578,-16.5637 5.162282,-3.68473 10.228089,-7.76323 13.653652,-9.77045 4.326017,-2.53484 9.463124,-4.13198 8.976988,-1.65526 -3.779364,7.61077 -5.74585,10.67934 -9.167556,16.15546 8.11118,-6.33235 15.840916,-14.71763 24.306604,-15.7298 2.101063,-0.25121 7.741176,-0.49516 8.636186,0.99596 0.66736,1.11183 -0.45512,5.1162 -2.21368,8.92266 -0.53908,1.16685 1.05142,0.38368 4.675326,-2.30213 7.4413,-5.51505 14.07911,-8.75072 17.95157,-8.75072 4.57712,0 4.83279,1.74832 1.24097,8.48622 -3.75741,7.04855 -6.75962,17.21422 -4.65148,19.88378 1.46622,1.85669 7.96734,-2.91147 10.3276,-4.31865 2.42293,-1.44454 6.05649,-3.67201 7.44149,-4.72955 10.37298,-7.92039 39.1617,-23.15505 40.99851,-21.53603 0.82449,0.72672 -1.6928,2.43145 -10.4509,7.07749 -14.25554,7.56231 -22.59862,14.9854 -22.60932,20.11619 -0.006,2.71011 4.1743,2.15203 7.26381,1.4275 4.40695,-1.03349 12.41622,-3.9676 -0.1736,3.14023 -13.16001,7.42974 -22.48474,6.17813 -16.63437,-3.95665 l 3.73574,-6.16441 -9.13253,6.55379 c -13.1916,9.46671 -19.35595,10.10807 -22.76505,7.11544 -2.6121,-2.29301 -1.99116,-8.56165 1.43897,-14.5266 2.74703,-4.77707 3.88176,-8.84229 2.46817,-8.84229 -2.38604,0 -7.35931,4.53611 -13.269936,10.69747 -9.974903,10.39803 -8.541011,15.10079 -10.591215,15.36938 -1.2597,0.16503 -6.977484,-1.59412 -4.555892,-8.64068 1.80805,-5.26122 4.692881,-8.68747 6.822262,-11.55279 3.866732,-5.2031 1.480467,-5.97342 -3.790272,-3.77097 -3.05613,1.27704 -5.350157,4.83814 -17.152826,15.01371 -13.804895,11.90178 -18.199091,17.31989 -20.790434,11.99664 -1.273249,-2.61557 1.017602,-5.97434 3.23361,-9.57032 4.367498,-7.21553 10.687821,-13.92474 8.632844,-16.40083 -2.050191,0.66573 -5.701417,3.94706 -7.917424,5.72051 -2.216008,1.77344 -5.216905,3.98662 -6.668674,4.91816 -1.451757,0.93154 -5.757863,3.9162 -9.569125,6.63255 -3.811251,2.71637 -10.546273,6.79488 -14.966706,9.06335 -9.5840432,4.91833 -13.8359275,5.33836 -18.57838626,1.83533 z M 159.35672,186.31423 c -4.88506,-3.00364 -1.44968,-15.28518 5.948,-21.26421 3.32796,-2.68976 12.33843,-8.3073 13.32481,-8.3073 0.27463,0 -1.05354,2.61529 -2.9515,5.81174 -5.51025,9.28008 -4.30612,16.29397 2.79731,16.29397 5.95677,0 10.60291,-1.935 15.24759,-9.21089 3.95762,-6.19961 10.07679,-10.04817 15.75277,-13.07984 4.88528,-2.60934 15.49103,-5.23799 19.83723,-4.00272 6.01532,1.70966 5.07061,0.66399 -3.766,4.03459 -9.35359,3.5678 -12.15223,5.23437 -15.80579,9.41222 -4.62835,5.29254 -5.17979,8.5948 -1.91397,11.46168 2.05902,1.80749 3.56776,2.26807 7.41531,2.26374 2.65669,-0.003 5.81168,-1.7253 7.33518,-2.42296 1.52351,-0.69765 3.03519,0.21321 3.03519,0.61971 -5.88638,3.94569 -11.44839,6.45882 -14.00234,7.27145 -2.61375,0.96599 -7.35132,2.03318 -10.23523,1.93803 -5.03631,0.0339 -9.16147,-1.48631 -10.57379,-3.37846 -0.79608,-1.43217 -1.3268,-2.70381 -0.96262,-3.97903 1.0679,-3.73939 0.16517,-2.52343 -4.28527,0.23044 -13.102,8.10733 -21.40719,9.25285 -26.19688,6.30784 z m 75.29251,0.5386 c -1.38501,-0.41486 -3.99134,-0.79396 -5.79185,-0.84243 -5.99934,-0.16153 -3.6372,-2.26466 5.12716,-4.56493 2.24719,-0.58979 2.74693,-0.49039 2.32997,0.46346 -1.0714,2.45099 8.09297,3.14025 13.72804,1.0325 5.4798,-2.04969 7.70684,-5.31293 8.2153,-10.06119 0.16756,-8.34719 -12.6158,-6.31988 -18.32043,-6.36109 -12.98146,-0.0572 -14.34396,-1.01124 -7.14295,-5.00172 9.56822,-5.3023 20.88185,-11.1336 25.8426,-10.44585 5.86061,0.8125 5.42599,3.39743 -0.5575,3.43312 -3.92889,0.0234 -13.80136,5.14348 -14.97622,6.81223 -1.22979,1.74676 2.12319,2.47254 11.4854,2.48607 8.58743,0.0125 9.56792,0.19334 11.8355,2.18392 3.81332,3.3475 3.46341,8.67923 -0.80123,12.20836 -7.5132,6.21744 -19.30064,10.28748 -30.97375,8.65755 z"
+ style="opacity:1;fill:url(#linearGradient2556);fill-opacity:1;stroke:#000000;display:inline" />
</g>
</svg>
diff --git a/etc/images/splash.xpm b/etc/images/splash.xpm
index 30a587babaa..65fcda22840 100644
--- a/etc/images/splash.xpm
+++ b/etc/images/splash.xpm
@@ -1,7 +1,7 @@
/* XPM */
/* Gnu Emacs Logo
*
- * Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ * Copyright (C) 2001-2012 Free Software Foundation, Inc.
*
* Author: Luis Fernandes <elf@ee.ryerson.ca>
*
diff --git a/etc/images/tree-widget/default/README b/etc/images/tree-widget/default/README
index ccc6cdbf21e..78502a370e0 100644
--- a/etc/images/tree-widget/default/README
+++ b/etc/images/tree-widget/default/README
@@ -5,5 +5,5 @@ Files: close.png close.xpm empty.png empty.xpm end-guide.png end-guide.xpm
no-guide.png no-guide.xpm no-handle.png no-handle.xpm open.png
open.xpm
Author: David Ponce <david.ponce@wanadoo.fr>
-Copyright (C) 2004-2011 Free Software Foundation, Inc.
+Copyright (C) 2004-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/tree-widget/folder/README b/etc/images/tree-widget/folder/README
index 58716db456d..ae4ad47d4fc 100644
--- a/etc/images/tree-widget/folder/README
+++ b/etc/images/tree-widget/folder/README
@@ -5,5 +5,5 @@ Files: close.png close.xpm empty.png empty.xpm end-guide.png
leaf.png leaf.xpm no-guide.png no-guide.xpm no-handle.png
no-handle.xpm open.png open.xpm
Author: David Ponce <david.ponce@wanadoo.fr>
-Copyright (C) 2004-2011 Free Software Foundation, Inc.
+Copyright (C) 2004-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/unchecked.xpm b/etc/images/unchecked.xpm
index 06e5178bce0..8201969b080 100644
--- a/etc/images/unchecked.xpm
+++ b/etc/images/unchecked.xpm
@@ -1,5 +1,5 @@
/* XPM */
-/* Copyright (C) 2010-2011 Free Software Foundation, Inc.
+/* Copyright (C) 2010-2012 Free Software Foundation, Inc.
*
* Author: Chong Yidong <cyd@stupidchicken.com>
*
diff --git a/etc/org/OrgOdtContentTemplate.xml b/etc/org/OrgOdtContentTemplate.xml
new file mode 100644
index 00000000000..55e1b787066
--- /dev/null
+++ b/etc/org/OrgOdtContentTemplate.xml
@@ -0,0 +1,263 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!-- See etc/org/README for copyright information -->
+<office:document-content
+ xmlns:office="urn:oasis:names:tc:opendocument:xmlns:office:1.0"
+ xmlns:style="urn:oasis:names:tc:opendocument:xmlns:style:1.0"
+ xmlns:text="urn:oasis:names:tc:opendocument:xmlns:text:1.0"
+ xmlns:table="urn:oasis:names:tc:opendocument:xmlns:table:1.0"
+ xmlns:draw="urn:oasis:names:tc:opendocument:xmlns:drawing:1.0"
+ xmlns:fo="urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0"
+ xmlns:xlink="http://www.w3.org/1999/xlink"
+ xmlns:dc="http://purl.org/dc/elements/1.1/"
+ xmlns:meta="urn:oasis:names:tc:opendocument:xmlns:meta:1.0"
+ xmlns:number="urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0"
+ xmlns:svg="urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0"
+ xmlns:chart="urn:oasis:names:tc:opendocument:xmlns:chart:1.0"
+ xmlns:dr3d="urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0"
+ xmlns:math="http://www.w3.org/1998/Math/MathML"
+ xmlns:form="urn:oasis:names:tc:opendocument:xmlns:form:1.0"
+ xmlns:script="urn:oasis:names:tc:opendocument:xmlns:script:1.0"
+ xmlns:ooo="http://openoffice.org/2004/office"
+ xmlns:ooow="http://openoffice.org/2004/writer"
+ xmlns:oooc="http://openoffice.org/2004/calc"
+ xmlns:dom="http://www.w3.org/2001/xml-events"
+ xmlns:xforms="http://www.w3.org/2002/xforms"
+ xmlns:xsd="http://www.w3.org/2001/XMLSchema"
+ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ xmlns:rpt="http://openoffice.org/2005/report"
+ xmlns:of="urn:oasis:names:tc:opendocument:xmlns:of:1.2"
+ xmlns:xodt="http://www.w3.org/1999/xodt"
+ xmlns:field="urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0" office:version="1.2">
+ <!-- scripts -->
+ <office:scripts/>
+
+ <!-- font face declarations -->
+ <office:font-face-decls>
+ <style:font-face style:name="Tahoma1" svg:font-family="Tahoma"/>
+ <style:font-face style:name="courier" svg:font-family="courier, monospace"/>
+ <style:font-face style:name="Arial Unicode MS" svg:font-family="&apos;Arial Unicode MS&apos;" style:font-pitch="variable"/>
+ <style:font-face style:name="HG Mincho Light J" svg:font-family="&apos;HG Mincho Light J&apos;" style:font-pitch="variable"/>
+ <style:font-face style:name="Thorndale" svg:font-family="Thorndale" style:font-family-generic="roman" style:font-pitch="variable"/>
+ <style:font-face style:name="Times New Roman" svg:font-family="&apos;Times New Roman&apos;" style:font-family-generic="roman" style:font-pitch="variable"/>
+ <style:font-face style:name="Albany" svg:font-family="Albany" style:font-family-generic="swiss" style:font-pitch="variable"/>
+ <style:font-face style:name="SimSun" svg:font-family="SimSun" style:font-family-generic="system" style:font-pitch="variable"/>
+ <style:font-face style:name="Tahoma" svg:font-family="Tahoma" style:font-family-generic="system" style:font-pitch="variable"/>
+ </office:font-face-decls>
+
+ <!-- automatic styles -->
+ <office:automatic-styles>
+ <!-- Section styles -->
+ <style:style style:name="OrgIndentedSection-Level-1" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="1.281cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-2" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="1.905cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-3" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="2.54cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-4" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="3.175cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-5" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="3.81cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-6" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="4.445cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-7" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="5.08cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-8" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="5.715cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-9" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="6.35cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-10" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="6.985cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+
+ <!-- Table styles -->
+ <style:style style:name="OrgTable" style:family="table">
+ <style:table-properties style:rel-width="96%" fo:margin-top="0cm" fo:margin-bottom="0.20cm" table:align="center"/>
+ </style:style>
+
+ <style:style style:name="OrgTableColumn" style:family="table-column">
+ <style:table-column-properties style:rel-column-width="1*"/>
+ </style:style>
+
+ <style:style style:name="OrgTblCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="top" fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="none" fo:border-left="none" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellL" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="none" fo:border-left="0.002cm solid #000000" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="none" fo:border-left="none" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellLR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="none" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellT" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="none" fo:border-left="none" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTL" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="none" fo:border-left="0.002cm solid #000000" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="none" fo:border-left="none" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTLR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="none" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellB" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="0.002cm solid #000000" fo:border-left="none" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellBL" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="0.002cm solid #000000" fo:border-left="0.002cm solid #000000" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellBR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="0.002cm solid #000000" fo:border-left="none" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellBLR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="0.002cm solid #000000" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTB" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000" fo:border-left="none" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTBL" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000" fo:border-left="0.002cm solid #000000" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTBR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000" fo:border-left="none" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTBLR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+
+ <!-- BEGIN: Table styles for numbered equations -->
+ <style:style style:name="OrgEquation" style:family="table">
+ <style:table-properties style:rel-width="100%" fo:margin-top="0cm" fo:margin-bottom="0.20cm" table:align="center"/>
+ </style:style>
+ <style:style style:name="OrgEquationTableColumn" style:family="table-column">
+ <style:table-column-properties style:rel-column-width="1*"/>
+ </style:style>
+ <style:style style:name="OrgFirstEquationFirstColumnTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="middle" fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="none" fo:border-left="none" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgEquationLastColumnTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="middle" fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="none" fo:border-left="none" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgEquationFirstColumnTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="OrgEquationLastColumnTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="end" style:justify-single-word="false"/>
+ </style:style>
+ <!-- END: Table styles for numbered equations -->
+
+ <!-- BEGIN: Custom Table Template -->
+ <style:style style:name="Custom" style:family="table">
+ <style:table-properties style:rel-width="80%" table:align="center"/>
+ </style:style>
+
+ <style:style style:name="CustomColumn" style:family="table-column">
+ <style:table-column-properties style:rel-column-width="1*"/>
+ </style:style>
+
+ <!-- Table Paragraph Styles -->
+ <style:style style:name="CustomTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="start" style:justify-single-word="false"/>
+ <style:text-properties fo:color="#000000" style:text-outline="false" style:text-line-through-style="none" style:font-name="Times New Roman" fo:font-size="12pt" fo:font-style="normal" fo:text-shadow="none" style:text-underline-style="none" fo:font-weight="normal" style:font-size-asian="12pt" style:font-style-asian="normal" style:font-weight-asian="normal" style:font-size-complex="12pt" style:font-style-complex="normal" style:font-weight-complex="normal" style:text-overline-style="none" style:text-overline-color="font-color"/>
+ </style:style>
+
+ <style:style style:name="CustomLastRowTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="start" style:justify-single-word="false"/>
+ <style:text-properties fo:color="#000000" style:text-outline="false" style:text-line-through-style="none" style:font-name="Times New Roman" fo:font-size="12pt" fo:font-style="normal" fo:text-shadow="none" style:text-underline-style="none" fo:font-weight="normal" style:font-size-asian="12pt" style:font-style-asian="normal" style:font-weight-asian="normal" style:font-size-complex="12pt" style:font-style-complex="normal" style:font-weight-complex="normal" style:text-overline-style="none" style:text-overline-color="font-color"/>
+ </style:style>
+
+ <style:style style:name="CustomLastColumnTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="start" style:justify-single-word="false"/>
+ <style:text-properties fo:color="#000000" style:text-outline="false" style:text-line-through-style="none" style:font-name="Times New Roman" fo:font-size="12pt" fo:font-style="normal" fo:text-shadow="none" style:text-underline-style="none" fo:font-weight="normal" style:font-size-asian="12pt" style:font-style-asian="normal" style:font-weight-asian="normal" style:font-size-complex="12pt" style:font-style-complex="normal" style:font-weight-complex="normal" style:text-overline-style="none" style:text-overline-color="font-color"/>
+ </style:style>
+
+ <style:style style:name="CustomFirstRowTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="start" style:justify-single-word="false"/>
+ <style:text-properties fo:color="#ffffff" style:text-outline="false" style:text-line-through-style="none" style:font-name="Times New Roman" fo:font-size="12pt" fo:font-style="normal" fo:text-shadow="none" style:text-underline-style="none" fo:font-weight="normal" style:font-size-asian="12pt" style:font-style-asian="normal" style:font-weight-asian="normal" style:font-size-complex="12pt" style:font-style-complex="normal" style:font-weight-complex="normal" style:text-overline-style="none" style:text-overline-color="font-color"/>
+ </style:style>
+
+ <style:style style:name="CustomFirstColumnTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="start" style:justify-single-word="false"/>
+ <style:text-properties fo:color="#ffffff" style:text-outline="false" style:text-line-through-style="none" style:font-name="Times New Roman" fo:font-size="12pt" fo:font-style="normal" fo:text-shadow="none" style:text-underline-style="none" fo:font-weight="normal" style:font-size-asian="12pt" style:font-style-asian="normal" style:font-weight-asian="normal" style:font-size-complex="12pt" style:font-style-complex="normal" style:font-weight-complex="normal" style:text-overline-style="none" style:text-overline-color="font-color"/>
+ </style:style>
+
+ <!-- Table Cell Styles -->
+ <style:style style:name="CustomTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="top" fo:background-color="#ffffff" fo:padding="0.097cm" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000">
+ <style:background-image/>
+ </style:table-cell-properties>
+ </style:style>
+
+ <style:style style:name="CustomFirstRowTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="top" fo:background-color="#000080" fo:padding="0.097cm" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000">
+ <style:background-image/>
+ </style:table-cell-properties>
+ </style:style>
+
+ <style:style style:name="CustomLastRowTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="top" fo:background-color="#cccccc" fo:padding="0.097cm" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000">
+ <style:background-image/>
+ </style:table-cell-properties>
+ </style:style>
+
+ <style:style style:name="CustomFirstColumnTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="top" fo:background-color="#4d4d4d" fo:padding="0.097cm" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000">
+ <style:background-image/>
+ </style:table-cell-properties>
+ </style:style>
+
+ <style:style style:name="CustomLastColumnTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="top" fo:background-color="#cccccc" fo:padding="0.097cm" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000">
+ <style:background-image/>
+ </style:table-cell-properties>
+ </style:style>
+
+ <!-- END: Custom Table Template -->
+
+ </office:automatic-styles>
+
+ <office:body>
+ <office:text>
+ <text:sequence-decls>
+ <text:sequence-decl text:display-outline-level="0" text:name="Illustration"/>
+ <text:sequence-decl text:display-outline-level="0" text:name="Table"/>
+ <text:sequence-decl text:display-outline-level="0" text:name="Text"/>
+ <text:sequence-decl text:display-outline-level="0" text:name="Drawing"/>
+ <text:sequence-decl text:display-outline-level="0" text:name="Equation"/>
+ <text:sequence-decl text:display-outline-level="0" text:name="Figure"/>
+ <text:sequence-decl text:display-outline-level="0" text:name="Listing"/>
+ </text:sequence-decls>
+ </office:text>
+ </office:body>
+</office:document-content>
diff --git a/etc/org/OrgOdtStyles.xml b/etc/org/OrgOdtStyles.xml
new file mode 100644
index 00000000000..5dfcfa83890
--- /dev/null
+++ b/etc/org/OrgOdtStyles.xml
@@ -0,0 +1,797 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!-- See etc/org/README for copyright information -->
+<office:document-styles xmlns:office="urn:oasis:names:tc:opendocument:xmlns:office:1.0" xmlns:style="urn:oasis:names:tc:opendocument:xmlns:style:1.0" xmlns:text="urn:oasis:names:tc:opendocument:xmlns:text:1.0" xmlns:table="urn:oasis:names:tc:opendocument:xmlns:table:1.0" xmlns:draw="urn:oasis:names:tc:opendocument:xmlns:drawing:1.0" xmlns:fo="urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:meta="urn:oasis:names:tc:opendocument:xmlns:meta:1.0" xmlns:number="urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0" xmlns:svg="urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0" xmlns:chart="urn:oasis:names:tc:opendocument:xmlns:chart:1.0" xmlns:dr3d="urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0" xmlns:math="http://www.w3.org/1998/Math/MathML" xmlns:form="urn:oasis:names:tc:opendocument:xmlns:form:1.0" xmlns:script="urn:oasis:names:tc:opendocument:xmlns:script:1.0" xmlns:ooo="http://openoffice.org/2004/office" xmlns:ooow="http://openoffice.org/2004/writer" xmlns:oooc="http://openoffice.org/2004/calc" xmlns:dom="http://www.w3.org/2001/xml-events" xmlns:rpt="http://openoffice.org/2005/report" xmlns:of="urn:oasis:names:tc:opendocument:xmlns:of:1.2" xmlns:xhtml="http://www.w3.org/1999/xhtml" xmlns:grddl="http://www.w3.org/2003/g/data-view#" office:version="1.2">
+ <office:font-face-decls>
+ <style:font-face style:name="OpenSymbol" svg:font-family="OpenSymbol"/>
+ <style:font-face style:name="Tahoma1" svg:font-family="Tahoma"/>
+ <style:font-face style:name="Courier New" svg:font-family="&apos;Courier New&apos;" style:font-family-generic="modern" style:font-pitch="fixed"/>
+ <style:font-face style:name="NSimSun" svg:font-family="NSimSun" style:font-family-generic="modern" style:font-pitch="fixed"/>
+ <style:font-face style:name="Times New Roman" svg:font-family="&apos;Times New Roman&apos;" style:font-family-generic="roman" style:font-pitch="variable"/>
+ <style:font-face style:name="Arial" svg:font-family="Arial" style:font-family-generic="swiss" style:font-pitch="variable"/>
+ <style:font-face style:name="SimSun" svg:font-family="SimSun" style:font-family-generic="system" style:font-pitch="variable"/>
+ <style:font-face style:name="Tahoma" svg:font-family="Tahoma" style:font-family-generic="system" style:font-pitch="variable"/>
+ </office:font-face-decls>
+ <office:styles>
+ <style:default-style style:family="graphic">
+ <style:graphic-properties draw:shadow-offset-x="0.3cm" draw:shadow-offset-y="0.3cm" draw:start-line-spacing-horizontal="0.283cm" draw:start-line-spacing-vertical="0.283cm" draw:end-line-spacing-horizontal="0.283cm" draw:end-line-spacing-vertical="0.283cm" style:flow-with-text="false"/>
+ <style:paragraph-properties style:text-autospace="ideograph-alpha" style:line-break="strict" style:writing-mode="lr-tb" style:font-independent-line-spacing="false">
+ <style:tab-stops/>
+ </style:paragraph-properties>
+ <style:text-properties style:use-window-font-color="true" fo:font-size="12pt" fo:language="en" fo:country="GB" style:letter-kerning="true" style:font-size-asian="12pt" style:language-asian="zh" style:country-asian="CN" style:font-size-complex="12pt" style:language-complex="hi" style:country-complex="IN"/>
+ </style:default-style>
+ <style:default-style style:family="paragraph">
+ <style:paragraph-properties fo:hyphenation-ladder-count="no-limit" style:text-autospace="ideograph-alpha" style:punctuation-wrap="hanging" style:line-break="strict" style:tab-stop-distance="1.251cm" style:writing-mode="page"/>
+ <style:text-properties style:use-window-font-color="true" style:font-name="Times New Roman" fo:font-size="12pt" fo:language="en" fo:country="GB" style:letter-kerning="true" style:font-name-asian="SimSun" style:font-size-asian="12pt" style:language-asian="zh" style:country-asian="CN" style:font-name-complex="Tahoma" style:font-size-complex="12pt" style:language-complex="hi" style:country-complex="IN" fo:hyphenate="false" fo:hyphenation-remain-char-count="2" fo:hyphenation-push-char-count="2"/>
+ </style:default-style>
+ <style:default-style style:family="table">
+ <style:table-properties table:border-model="collapsing"/>
+ </style:default-style>
+ <style:default-style style:family="table-row">
+ <style:table-row-properties fo:keep-together="auto"/>
+ </style:default-style>
+
+ <!-- Outline numbering -->
+ <text:outline-style style:name="OrgOutline">
+ <text:outline-level-style text:level="1" style:num-suffix=". " style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-0.762cm" fo:margin-left="0.762cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="2" style:num-suffix=". " style:num-format="1" text:display-levels="2">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-1.016cm" fo:margin-left="1.016cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="3" style:num-suffix=". " style:num-format="1" text:display-levels="3">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-1.27cm" fo:margin-left="1.27cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="4" style:num-suffix=". " style:num-format="1" text:display-levels="4">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-1.524cm" fo:margin-left="1.524cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="5" style:num-suffix=". " style:num-format="1" text:display-levels="5">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-1.778cm" fo:margin-left="1.778cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="6" style:num-suffix=". " style:num-format="1" text:display-levels="6">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-2.032cm" fo:margin-left="2.032cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="7" style:num-suffix=". " style:num-format="1" text:display-levels="7">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-2.286cm" fo:margin-left="2.286cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="8" style:num-suffix=". " style:num-format="1" text:display-levels="8">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-2.54cm" fo:margin-left="2.54cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="9" style:num-suffix=". " style:num-format="1" text:display-levels="9">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-2.794cm" fo:margin-left="2.794cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="10" style:num-suffix=". " style:num-format="1" text:display-levels="10">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-3.048cm" fo:margin-left="3.048cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ </text:outline-style>
+
+ <style:style style:name="Standard" style:family="paragraph" style:class="text"/>
+ <style:style style:name="Heading" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="text">
+ <style:paragraph-properties fo:margin-top="0.423cm" fo:margin-bottom="0.212cm" fo:keep-with-next="always"/>
+ <style:text-properties style:font-name="Arial" fo:font-size="14pt" style:font-name-asian="SimSun" style:font-size-asian="14pt" style:font-name-complex="Tahoma" style:font-size-complex="14pt"/>
+ </style:style>
+ <style:style style:name="Text_20_body" style:display-name="Text body" style:family="paragraph" style:parent-style-name="Standard" style:class="text">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.212cm"/>
+ </style:style>
+ <style:style style:name="List" style:family="paragraph" style:parent-style-name="Text_20_body" style:class="list">
+ <style:text-properties style:font-name-complex="Tahoma1"/>
+ </style:style>
+ <style:style style:name="Caption" style:family="paragraph" style:parent-style-name="Standard" style:class="extra">
+ <style:paragraph-properties fo:margin-top="0.212cm" fo:margin-bottom="0.212cm" text:number-lines="false" text:line-number="0"/>
+ <style:text-properties fo:font-size="12pt" fo:font-style="italic" style:font-size-asian="12pt" style:font-style-asian="italic" style:font-name-complex="Tahoma1" style:font-size-complex="12pt" style:font-style-complex="italic"/>
+ </style:style>
+ <style:style style:name="Index" style:family="paragraph" style:parent-style-name="Standard" style:class="index">
+ <style:paragraph-properties text:number-lines="false" text:line-number="0"/>
+ <style:text-properties style:font-name-complex="Tahoma1"/>
+ </style:style>
+ <style:style style:name="Heading_20_1" style:display-name="Heading 1" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="1" style:class="text">
+ <style:text-properties fo:font-size="115%" fo:font-weight="bold" style:font-size-asian="115%" style:font-weight-asian="bold" style:font-size-complex="115%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_2" style:display-name="Heading 2" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="2" style:class="text">
+ <style:text-properties fo:font-size="14pt" fo:font-style="italic" fo:font-weight="bold" style:font-size-asian="14pt" style:font-style-asian="italic" style:font-weight-asian="bold" style:font-size-complex="14pt" style:font-style-complex="italic" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_3" style:display-name="Heading 3" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="3" style:class="text">
+ <style:text-properties fo:font-size="14pt" fo:font-weight="bold" style:font-size-asian="14pt" style:font-weight-asian="bold" style:font-size-complex="14pt" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_4" style:display-name="Heading 4" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="4" style:class="text">
+ <style:text-properties fo:font-size="85%" fo:font-style="italic" fo:font-weight="bold" style:font-size-asian="85%" style:font-style-asian="italic" style:font-weight-asian="bold" style:font-size-complex="85%" style:font-style-complex="italic" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_5" style:display-name="Heading 5" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="5" style:class="text">
+ <style:text-properties fo:font-size="85%" fo:font-weight="bold" style:font-size-asian="85%" style:font-weight-asian="bold" style:font-size-complex="85%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_6" style:display-name="Heading 6" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="6" style:class="text">
+ <style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_7" style:display-name="Heading 7" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="7" style:class="text">
+ <style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_8" style:display-name="Heading 8" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="8" style:class="text">
+ <style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_9" style:display-name="Heading 9" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="9" style:class="text">
+ <style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_10" style:display-name="Heading 10" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="10" style:class="text">
+ <style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_1.title" style:display-name="Heading 1.title" style:family="paragraph" style:parent-style-name="Heading_20_1">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="Title" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Subtitle" style:class="chapter">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ <style:text-properties fo:font-size="18pt" fo:font-weight="bold" style:font-size-asian="18pt" style:font-weight-asian="bold" style:font-size-complex="18pt" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="OrgTitle" style:family="paragraph" style:parent-style-name="Title">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0cm"/>
+ <style:text-properties fo:font-size="24pt"/>
+ </style:style>
+ <style:style style:name="Subtitle" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:class="chapter">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ <style:text-properties fo:font-size="14pt" fo:font-style="italic" style:font-size-asian="14pt" style:font-style-asian="italic" style:font-size-complex="14pt" style:font-style-complex="italic"/>
+ </style:style>
+ <style:style style:name="OrgSubtitle" style:family="paragraph" style:parent-style-name="Subtitle">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0cm"/>
+ <style:text-properties fo:font-size="20pt"/>
+ </style:style>
+ <style:style style:name="Text_20_body_20_indent" style:display-name="Text body indent" style:family="paragraph" style:parent-style-name="Text_20_body" style:class="text">
+ <style:paragraph-properties fo:margin-left="0.499cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false"/>
+ </style:style>
+ <style:style style:name="List_20_Indent" style:display-name="List Indent" style:family="paragraph" style:parent-style-name="Text_20_body" style:class="text">
+ <style:paragraph-properties fo:margin-left="5.001cm" fo:margin-right="0cm" fo:text-indent="-4.5cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="0cm"/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="First_20_line_20_indent" style:display-name="First line indent" style:family="paragraph" style:parent-style-name="Text_20_body" style:class="text">
+ <style:paragraph-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:text-indent="0.499cm" style:auto-text-indent="false"/>
+ </style:style>
+ <style:style style:name="Hanging_20_indent" style:display-name="Hanging indent" style:family="paragraph" style:parent-style-name="Text_20_body" style:class="text">
+ <style:paragraph-properties fo:margin-left="1cm" fo:margin-right="0cm" fo:text-indent="-0.499cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="0cm"/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Salutation" style:family="paragraph" style:parent-style-name="Standard" style:class="text">
+ <style:paragraph-properties text:number-lines="false" text:line-number="0"/>
+ </style:style>
+ <style:style style:name="Contents_20_Heading" style:display-name="Contents Heading" style:family="paragraph" style:parent-style-name="Heading" style:class="index">
+ <style:paragraph-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false" text:number-lines="false" text:line-number="0"/>
+ <style:text-properties fo:font-size="16pt" fo:font-weight="bold" style:font-size-asian="16pt" style:font-weight-asian="bold" style:font-size-complex="16pt" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Contents_20_1" style:display-name="Contents 1" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="17cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_2" style:display-name="Contents 2" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="0.499cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="16.501cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_3" style:display-name="Contents 3" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="0.998cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="16.002cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_4" style:display-name="Contents 4" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="1.498cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="15.503cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_5" style:display-name="Contents 5" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="1.997cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="15.004cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_6" style:display-name="Contents 6" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="2.496cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="14.504cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_7" style:display-name="Contents 7" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="2.995cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="14.005cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_8" style:display-name="Contents 8" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="3.494cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="13.506cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_9" style:display-name="Contents 9" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="3.993cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="13.007cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_10" style:display-name="Contents 10" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="4.493cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="12.508cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Quotations" style:family="paragraph" style:parent-style-name="Standard" style:class="html">
+ <style:paragraph-properties fo:margin-left="1cm" fo:margin-right="1cm" fo:margin-top="0cm" fo:margin-bottom="0.499cm" fo:text-indent="0cm" style:auto-text-indent="false"/>
+ </style:style>
+ <style:style style:name="Preformatted_20_Text" style:display-name="Preformatted Text" style:family="paragraph" style:parent-style-name="Standard" style:class="html">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0cm"/>
+ <style:text-properties style:font-name="Courier New" fo:font-size="10pt" style:font-name-asian="NSimSun" style:font-size-asian="10pt" style:font-name-complex="Courier New" style:font-size-complex="10pt"/>
+ </style:style>
+ <style:style style:name="OrgVerse" style:family="paragraph" style:parent-style-name="Preformatted_20_Text">
+ <style:paragraph-properties fo:background-color="#c0c0c0" fo:padding="0.049cm" fo:border="0.018cm solid #000000" style:shadow="none">
+ <style:background-image/>
+ </style:paragraph-properties>
+ </style:style>
+
+ <style:style style:name="OrgFixedWidthBlock" style:family="paragraph" style:parent-style-name="Preformatted_20_Text">
+ <style:paragraph-properties fo:background-color="#c0c0c0" fo:padding="0.049cm" fo:border="0.018cm solid #000000" style:shadow="none">
+ <style:background-image/>
+ </style:paragraph-properties>
+ </style:style>
+
+ <style:style style:name="OrgFixedWidthBlockLastLine" style:family="paragraph" style:parent-style-name="OrgFixedWidthBlock">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.21cm"/>
+ </style:style>
+
+ <style:style style:name="OrgSrcBlockLastLine" style:family="paragraph" style:parent-style-name="OrgSrcBlock">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.21cm"/>
+ </style:style>
+
+ <style:style style:name="OrgCenter" style:family="paragraph" style:parent-style-name="Text_20_body">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="OrgTableContents" style:family="paragraph" style:parent-style-name="Text_20_body"/>
+ <style:style style:name="OrgTableHeading" style:family="paragraph" style:parent-style-name="OrgTableContents" style:class="extra">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false" text:number-lines="false" text:line-number="0"/>
+ <style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>
+ </style:style>
+
+ <style:style style:name="OrgTableHeadingLeft" style:family="paragraph" style:parent-style-name="OrgTableHeading">
+ <style:paragraph-properties fo:text-align="left" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="OrgTableHeadingRight" style:family="paragraph" style:parent-style-name="OrgTableHeading">
+ <style:paragraph-properties fo:text-align="right" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="OrgTableHeadingCenter" style:family="paragraph" style:parent-style-name="OrgTableHeading">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+
+ <style:style style:name="OrgTableContentsLeft" style:family="paragraph" style:parent-style-name="OrgTableContents">
+ <style:paragraph-properties fo:text-align="left" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="OrgTableContentsRight" style:family="paragraph" style:parent-style-name="OrgTableContents">
+ <style:paragraph-properties fo:text-align="right" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="OrgTableContentsCenter" style:family="paragraph" style:parent-style-name="OrgTableContents">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="Text_20_body_20_bold" style:display-name="Text body bold" style:family="paragraph" style:parent-style-name="Text_20_body" style:next-style-name="Text_20_body">
+ <style:text-properties fo:font-weight="bold"/>
+ </style:style>
+ <style:style style:name="Footnote" style:family="paragraph" style:parent-style-name="Standard" style:class="extra">
+ <style:paragraph-properties fo:margin-left="0.499cm" fo:margin-right="0cm" fo:text-indent="-0.499cm" style:auto-text-indent="false" text:number-lines="false" text:line-number="0"/>
+ <style:text-properties fo:font-size="10pt" style:font-size-asian="10pt" style:font-size-complex="10pt"/>
+ </style:style>
+ <style:style style:name="Figure" style:family="paragraph" style:parent-style-name="Caption"/>
+ <style:style style:name="Illustration_20_Index_20_Heading" style:display-name="Illustration Index Heading" style:family="paragraph" style:parent-style-name="Heading" style:class="index">
+ <style:paragraph-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false" text:number-lines="false" text:line-number="0"/>
+ <style:text-properties fo:font-size="16pt" fo:font-weight="bold" style:font-size-asian="16pt" style:font-weight-asian="bold" style:font-size-complex="16pt" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Table" style:family="paragraph" style:parent-style-name="Caption" style:class="extra">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="Listing" style:family="paragraph" style:parent-style-name="Caption" style:class="extra">
+ <style:paragraph-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false" fo:keep-with-next="always">
+ <style:tab-stops/>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Horizontal_20_Line" style:display-name="Horizontal Line" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="html">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.499cm" style:border-line-width-bottom="0.002cm 0.035cm 0.002cm" fo:padding="0cm" fo:border-left="none" fo:border-right="none" fo:border-top="none" fo:border-bottom="0.039cm double #808080" text:number-lines="false" text:line-number="0" style:join-border="false"/>
+ <style:text-properties fo:font-size="6pt" style:font-size-asian="6pt" style:font-size-complex="6pt"/>
+ </style:style>
+ <style:style style:name="Emphasis" style:family="text">
+ <style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/>
+ </style:style>
+ <style:style style:name="Underline" style:family="text">
+ <style:text-properties style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color" fo:background-color="transparent"/>
+ </style:style>
+ <style:style style:name="Strikethrough" style:family="text">
+ <style:text-properties style:text-line-through-style="solid"/>
+ </style:style>
+ <style:style style:name="Source_20_Text" style:display-name="Source Text" style:family="text">
+ <style:text-properties style:font-name="Courier New" fo:background-color="transparent" style:font-name-asian="NSimSun" style:font-name-complex="Courier New"/>
+ </style:style>
+ <style:style style:name="Citation" style:family="text">
+ <style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/>
+ </style:style>
+ <style:style style:name="Example" style:family="text">
+ <style:text-properties style:font-name="Courier New" fo:background-color="transparent" style:font-name-asian="NSimSun" style:font-name-complex="Courier New"/>
+ </style:style>
+ <style:style style:name="OrgCode" style:family="text" style:parent-style-name="Source_20_Text"/>
+
+ <!-- BEGIN: Org Agenda Styles -->
+ <style:style style:name="OrgTodo" style:family="text">
+ <style:text-properties fo:color="#ff0000"/>
+ </style:style>
+ <style:style style:name="OrgDone" style:family="text">
+ <style:text-properties fo:color="#008000"/>
+ </style:style>
+ <style:style style:name="OrgTag" style:family="text">
+ <style:text-properties fo:background-color="#add8e6"/>
+ </style:style>
+ <style:style style:name="OrgTimestamp" style:family="text">
+ <style:text-properties fo:color="#bebebe"/>
+ </style:style>
+ <style:style style:name="OrgTimestampKeyword" style:family="text">
+ <style:text-properties fo:color="#5f9ea0"/>
+ </style:style>
+ <style:style style:name="OrgTimestampWrapper" style:family="text"/>
+ <style:style style:name="OrgTarget" style:family="text"/>
+ <!-- END: Org Agenda Styles -->
+
+ <style:style style:name="Bold" style:family="text">
+ <style:text-properties fo:font-weight="bold"/>
+ </style:style>
+ <style:style style:name="Numbering_20_Symbols" style:display-name="Numbering Symbols" style:family="text"/>
+ <style:style style:name="Footnote_20_Symbol" style:display-name="Footnote Symbol" style:family="text"/>
+ <style:style style:name="Footnote_20_anchor" style:display-name="Footnote anchor" style:family="text">
+ <style:text-properties style:text-position="super 58%"/>
+ </style:style>
+ <style:style style:name="OrgSuperscript" style:family="text">
+ <style:text-properties style:text-position="super 58%"/>
+ </style:style>
+ <style:style style:name="OrgSubscript" style:family="text">
+ <style:text-properties style:text-position="sub 58%"/>
+ </style:style>
+ <style:style style:name="Internet_20_link" style:display-name="Internet link" style:family="text">
+ <style:text-properties fo:color="#000080" fo:language="zxx" fo:country="none" style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color" style:language-asian="zxx" style:country-asian="none" style:language-complex="zxx" style:country-complex="none"/>
+ </style:style>
+ <style:style style:name="Graphics" style:family="graphic">
+ <style:graphic-properties text:anchor-type="paragraph" svg:x="0cm" svg:y="0cm" style:wrap="none" style:vertical-pos="top" style:vertical-rel="paragraph" style:horizontal-pos="center" style:horizontal-rel="paragraph"/>
+ </style:style>
+ <style:style style:name="Frame" style:family="graphic">
+ <style:graphic-properties text:anchor-type="paragraph" svg:x="0cm" svg:y="0cm" fo:margin-left="0.201cm" fo:margin-right="0.201cm" fo:margin-top="0.201cm" fo:margin-bottom="0.201cm" style:wrap="parallel" style:number-wrapped-paragraphs="no-limit" style:wrap-contour="false" style:vertical-pos="top" style:vertical-rel="paragraph-content" style:horizontal-pos="center" style:horizontal-rel="paragraph-content" fo:padding="0.15cm" fo:border="0.002cm solid #000000"/>
+ </style:style>
+
+ <!-- Simple Images -->
+ <style:style style:name="OrgDisplayImage" style:family="graphic" style:parent-style-name="Graphics">
+ <style:graphic-properties text:anchor-type="paragraph" style:wrap="none" style:vertical-pos="top" style:vertical-rel="paragraph" style:horizontal-pos="center" style:horizontal-rel="paragraph"/>
+ </style:style>
+
+ <style:style style:name="OrgPageImage" style:family="graphic" style:parent-style-name="Graphics">
+ <style:graphic-properties text:anchor-type="page" fo:margin-top="0.21cm" fo:margin-bottom="0.21cm" style:vertical-pos="middle" style:vertical-rel="page" style:horizontal-pos="center" style:horizontal-rel="page" fo:background-color="transparent" style:background-transparency="100%" style:shadow="none" style:mirror="none" fo:clip="rect(0cm, 0cm, 0cm, 0cm)" draw:luminance="0%" draw:contrast="0%" draw:red="0%" draw:green="0%" draw:blue="0%" draw:gamma="100%" draw:color-inversion="false" draw:image-opacity="100%" draw:color-mode="standard">
+ <style:background-image/>
+ </style:graphic-properties>
+ </style:style>
+
+ <!-- Captioned Images -->
+ <style:style style:name="OrgCaptionedImage" style:family="graphic" style:parent-style-name="Graphics">
+ <style:graphic-properties style:rel-width="100%" text:anchor-type="paragraph" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0cm" fo:margin-bottom="0cm" style:run-through="foreground" style:wrap="none" style:vertical-pos="from-top" style:vertical-rel="paragraph-content" style:horizontal-pos="from-left" style:horizontal-rel="paragraph-content" fo:padding="0cm" fo:border="none" style:shadow="none"/>
+ </style:style>
+
+ <style:style style:name="OrgImageCaptionFrame" style:family="graphic" style:parent-style-name="Frame">
+ <style:graphic-properties text:anchor-type="paragraph" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0cm" fo:margin-bottom="0cm" style:wrap="none" style:vertical-pos="top" style:vertical-rel="paragraph" style:horizontal-pos="center" style:horizontal-rel="paragraph" fo:padding="0cm" fo:border="none"/>
+ </style:style>
+
+ <style:style style:name="OrgPageImageCaptionFrame" style:family="graphic" style:parent-style-name="Frame">
+ <style:graphic-properties text:anchor-type="paragraph" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0.21cm" fo:margin-bottom="0.21cm" style:wrap="none" style:vertical-pos="middle" style:vertical-rel="page" style:horizontal-pos="center" style:horizontal-rel="page" fo:background-color="transparent" style:background-transparency="100%" fo:padding="0cm" fo:border="none" style:shadow="none">
+ <style:background-image/>
+ </style:graphic-properties>
+ </style:style>
+
+ <!-- Inlined Images -->
+ <style:style style:name="OrgInlineImage" style:family="graphic" style:parent-style-name="Graphics">
+ <style:graphic-properties text:anchor-type="as-char" style:vertical-pos="top" style:vertical-rel="baseline" style:horizontal-pos="center" style:horizontal-rel="paragraph"/>
+ </style:style>
+
+ <!-- Inline Formula -->
+ <style:style style:name="OrgFormula" style:family="graphic">
+ <style:graphic-properties text:anchor-type="as-char" svg:y="0cm" fo:margin-left="0.201cm" fo:margin-right="0.201cm" style:vertical-pos="middle" style:vertical-rel="text" style:shadow="none"/>
+ </style:style>
+
+ <style:style style:name="OrgInlineFormula" style:family="graphic" style:parent-style-name="Formula">
+ <style:graphic-properties text:anchor-type="as-char" fo:margin-left="0.201cm" fo:margin-right="0.201cm" style:vertical-pos="middle" style:vertical-rel="text"/>
+ </style:style>
+
+ <style:style style:name="OrgInlineFormula" style:family="graphic" style:parent-style-name="Formula">
+ <style:graphic-properties style:vertical-pos="middle" style:vertical-rel="text" draw:ole-draw-aspect="1"/>
+ </style:style>
+
+ <style:style style:name="OrgDisplayFormula" style:family="graphic" style:parent-style-name="OrgFormula">
+ <style:graphic-properties style:vertical-pos="middle" style:vertical-rel="text" style:horizontal-pos="from-left" style:horizontal-rel="paragraph-content" draw:ole-draw-aspect="1"/>
+ </style:style>
+
+ <style:style style:name="OrgFormulaCaptionFrame" style:family="graphic" style:parent-style-name="Frame">
+ <style:graphic-properties fo:margin-top="0cm" fo:margin-bottom="0cm" style:vertical-pos="middle" style:vertical-rel="text" style:horizontal-pos="from-left" style:horizontal-rel="paragraph-content" fo:padding="0cm" fo:border="none"/>
+ </style:style>
+
+ <style:style style:name="OrgCaptionedFormula" style:family="graphic" style:parent-style-name="OrgFormula">
+ <style:graphic-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0cm" fo:margin-bottom="0cm" style:run-through="foreground" style:wrap="none" style:vertical-pos="from-top" style:vertical-rel="paragraph-content" style:horizontal-pos="center" style:horizontal-rel="paragraph-content" fo:padding="0cm" fo:border="none" style:shadow="none" draw:ole-draw-aspect="1"/>
+ </style:style>
+
+ <!-- Inline Tasks -->
+ <style:style style:name="OrgInlineTaskHeading" style:family="paragraph" style:parent-style-name="Caption" style:next-style-name="Text_20_body">
+ <style:text-properties style:font-name="Arial1" fo:font-style="normal" fo:font-weight="bold"/>
+ </style:style>
+ <style:style style:name="OrgInlineTaskFrame" style:family="graphic" style:parent-style-name="Frame">
+ <style:graphic-properties svg:x="0cm" svg:y="0cm" style:wrap="none" style:vertical-pos="top" style:vertical-rel="paragraph-content" style:horizontal-pos="center" style:horizontal-rel="paragraph-content" fo:background-color="#ffffcc" style:background-transparency="0%" fo:padding="0.15cm" fo:border="0.26pt solid #000000" style:shadow="none">
+ <style:background-image/>
+ </style:graphic-properties>
+ </style:style>
+
+ <text:list-style style:name="Numbering_20_1" style:display-name="Numbering 1">
+ <text:list-level-style-number text:level="1" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="0.499cm" fo:text-indent="-0.499cm" fo:margin-left="0.499cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="2" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1cm" fo:text-indent="-0.499cm" fo:margin-left="1cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="3" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1.499cm" fo:text-indent="-0.499cm" fo:margin-left="1.499cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="4" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2cm" fo:text-indent="-0.499cm" fo:margin-left="2cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="5" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2.499cm" fo:text-indent="-0.499cm" fo:margin-left="2.499cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="6" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="3cm" fo:text-indent="-0.499cm" fo:margin-left="3cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="7" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="3.5cm" fo:text-indent="-0.499cm" fo:margin-left="3.5cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="8" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="4.001cm" fo:text-indent="-0.499cm" fo:margin-left="4.001cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="9" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="4.5cm" fo:text-indent="-0.499cm" fo:margin-left="4.5cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="10" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="5.001cm" fo:text-indent="-0.499cm" fo:margin-left="5.001cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ </text:list-style>
+ <text:list-style style:name="List_20_1" style:display-name="List 1">
+ <text:list-level-style-bullet text:level="1" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="0.4cm" fo:text-indent="-0.4cm" fo:margin-left="0.4cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="2" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="0.801cm" fo:text-indent="-0.4cm" fo:margin-left="0.801cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="3" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1.199cm" fo:text-indent="-0.4cm" fo:margin-left="1.199cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="4" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1.6cm" fo:text-indent="-0.4cm" fo:margin-left="1.6cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="5" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2cm" fo:text-indent="-0.4cm" fo:margin-left="2cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="6" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2.401cm" fo:text-indent="-0.4cm" fo:margin-left="2.401cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="7" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2.799cm" fo:text-indent="-0.4cm" fo:margin-left="2.799cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="8" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="3.2cm" fo:text-indent="-0.4cm" fo:margin-left="3.2cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="9" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="3.6cm" fo:text-indent="-0.4cm" fo:margin-left="3.6cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="10" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="4.001cm" fo:text-indent="-0.4cm" fo:margin-left="4.001cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ </text:list-style>
+
+ <!-- Numbered List -->
+ <text:list-style style:name="OrgNumberedList">
+ <text:list-level-style-number text:level="1" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="0.635cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="2" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="1.27cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="3" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="1.905cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="4" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="2.54cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="5" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="3.175cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="6" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="3.81cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="7" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="4.445cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="8" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="5.08cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="9" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="5.715cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="10" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="6.35cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ </text:list-style>
+
+ <!-- Bulleted List -->
+ <text:list-style style:name="OrgBulletedList">
+ <text:list-level-style-bullet text:level="1" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="0.635cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="2" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="1.27cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="3" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="1.905cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="4" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="2.54cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="5" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="3.175cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="6" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="3.81cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="7" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="4.445cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="8" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="5.08cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="9" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="5.715cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="10" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="6.35cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ </text:list-style>
+
+ <!-- Description List -->
+ <text:list-style style:name="OrgDescriptionList">
+ <text:list-level-style-number text:level="1" style:num-format="">
+ <style:list-level-properties text:space-before="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="2" style:num-format="">
+ <style:list-level-properties text:space-before="1.27cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="3" style:num-format="">
+ <style:list-level-properties text:space-before="1.905cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="4" style:num-format="">
+ <style:list-level-properties text:space-before="2.54cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="5" style:num-format="">
+ <style:list-level-properties text:space-before="3.175cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="6" style:num-format="">
+ <style:list-level-properties text:space-before="3.81cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="7" style:num-format="">
+ <style:list-level-properties text:space-before="4.445cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="8" style:num-format="">
+ <style:list-level-properties text:space-before="5.08cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="9" style:num-format="">
+ <style:list-level-properties text:space-before="5.715cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="10" style:num-format="">
+ <style:list-level-properties text:space-before="6.35cm"/>
+ </text:list-level-style-number>
+ </text:list-style>
+
+ <text:list-style style:name="OrgSrcBlockNumberedLine">
+ <text:list-level-style-number text:level="1" style:num-format="1">
+ <style:list-level-properties text:space-before="0.635cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="2" style:num-format="1">
+ <style:list-level-properties text:space-before="1.27cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="3" style:num-format="1">
+ <style:list-level-properties text:space-before="1.905cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="4" style:num-format="1">
+ <style:list-level-properties text:space-before="2.54cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="5" style:num-format="1">
+ <style:list-level-properties text:space-before="3.175cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="6" style:num-format="1">
+ <style:list-level-properties text:space-before="3.81cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="7" style:num-format="1">
+ <style:list-level-properties text:space-before="4.445cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="8" style:num-format="1">
+ <style:list-level-properties text:space-before="5.08cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="9" style:num-format="1">
+ <style:list-level-properties text:space-before="5.715cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="10" style:num-format="1">
+ <style:list-level-properties text:space-before="6.35cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ </text:list-style>
+
+ <text:notes-configuration text:note-class="footnote" text:citation-style-name="Footnote_20_Symbol" text:citation-body-style-name="Footnote_20_anchor" style:num-format="1" text:start-value="0" text:footnotes-position="page" text:start-numbering-at="document"/>
+ <text:notes-configuration text:note-class="endnote" style:num-format="i" text:start-value="0"/>
+ <text:linenumbering-configuration text:number-lines="false" text:offset="0.499cm" style:num-format="1" text:number-position="left" text:increment="5"/>
+ </office:styles>
+ <office:automatic-styles>
+ <style:style style:name="MP1" style:family="paragraph" style:parent-style-name="Footer">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+ <style:page-layout style:name="Mpm1" style:page-usage="mirrored">
+ <style:page-layout-properties fo:page-width="21.001cm" fo:page-height="29.7cm" style:num-format="1" style:print-orientation="portrait" fo:margin-top="2cm" fo:margin-bottom="2cm" fo:margin-left="2cm" fo:margin-right="2cm" style:writing-mode="lr-tb" style:footnote-max-height="0cm">
+ <style:footnote-sep style:width="0.018cm" style:distance-before-sep="0.101cm" style:distance-after-sep="0.101cm" style:line-style="none" style:adjustment="left" style:rel-width="25%" style:color="#000000"/>
+ </style:page-layout-properties>
+ <style:header-style/>
+ <style:footer-style>
+ <style:header-footer-properties fo:min-height="0.6cm" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0.499cm" style:dynamic-spacing="false"/>
+ </style:footer-style>
+ </style:page-layout>
+ <style:page-layout style:name="Mpm2">
+ <style:page-layout-properties fo:page-width="21.001cm" fo:page-height="29.7cm" style:num-format="1" style:print-orientation="portrait" fo:margin-top="2cm" fo:margin-bottom="2cm" fo:margin-left="2cm" fo:margin-right="2cm" style:writing-mode="lr-tb" style:footnote-max-height="0cm">
+ <style:footnote-sep style:width="0.018cm" style:distance-before-sep="0.101cm" style:distance-after-sep="0.101cm" style:line-style="solid" style:adjustment="left" style:rel-width="25%" style:color="#000000"/>
+ </style:page-layout-properties>
+ <style:header-style/>
+ <style:footer-style/>
+ </style:page-layout>
+ <style:page-layout style:name="Mpm3" style:page-usage="mirrored">
+ <style:page-layout-properties fo:page-width="21.001cm" fo:page-height="29.7cm" style:num-format="i" style:print-orientation="portrait" fo:margin-top="2cm" fo:margin-bottom="2cm" fo:margin-left="2cm" fo:margin-right="2cm" style:writing-mode="lr-tb" style:footnote-max-height="0cm">
+ <style:footnote-sep style:width="0.018cm" style:distance-before-sep="0.101cm" style:distance-after-sep="0.101cm" style:line-style="solid" style:adjustment="left" style:rel-width="25%" style:color="#000000"/>
+ </style:page-layout-properties>
+ <style:header-style/>
+ <style:footer-style>
+ <style:header-footer-properties fo:min-height="0cm" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0.499cm"/>
+ </style:footer-style>
+ </style:page-layout>
+ <style:page-layout style:name="Mpm4" style:page-usage="right">
+ <style:page-layout-properties fo:page-width="21.001cm" fo:page-height="29.7cm" style:num-format="1" style:print-orientation="portrait" fo:margin-top="2cm" fo:margin-bottom="2cm" fo:margin-left="2cm" fo:margin-right="2cm" fo:background-color="transparent" style:writing-mode="lr-tb" style:footnote-max-height="0cm">
+ <style:background-image/>
+ <style:footnote-sep style:width="0.018cm" style:distance-before-sep="0.101cm" style:distance-after-sep="0.101cm" style:line-style="solid" style:adjustment="left" style:rel-width="25%" style:color="#000000"/>
+ </style:page-layout-properties>
+ <style:header-style/>
+ <style:footer-style>
+ <style:header-footer-properties fo:min-height="0.6cm" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0.499cm" style:dynamic-spacing="false"/>
+ </style:footer-style>
+ </style:page-layout>
+ <style:page-layout style:name="Mpm5" style:page-usage="mirrored">
+ <style:page-layout-properties fo:page-width="21.001cm" fo:page-height="29.7cm" style:num-format="1" style:print-orientation="portrait" fo:margin-top="2cm" fo:margin-bottom="2cm" fo:margin-left="2cm" fo:margin-right="2cm" style:writing-mode="lr-tb" style:footnote-max-height="0cm">
+ <style:footnote-sep style:width="0.018cm" style:distance-before-sep="0.101cm" style:distance-after-sep="0.101cm" style:line-style="solid" style:adjustment="left" style:rel-width="25%" style:color="#000000"/>
+ </style:page-layout-properties>
+ <style:header-style/>
+ <style:footer-style>
+ <style:header-footer-properties fo:min-height="0.6cm" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0.499cm" style:dynamic-spacing="false"/>
+ </style:footer-style>
+ </style:page-layout>
+ </office:automatic-styles>
+ <office:master-styles>
+ <style:master-page style:name="Standard" style:page-layout-name="Mpm1">
+ <style:footer>
+ <text:p text:style-name="MP1"><text:page-number text:select-page="current"></text:page-number></text:p>
+ </style:footer>
+ </style:master-page>
+ <style:master-page style:name="OrgTitlePage" style:page-layout-name="Mpm2" style:next-style-name="OrgFrontMatterPage"/>
+ <style:master-page style:name="OrgFrontMatterPage" style:page-layout-name="Mpm3">
+ <style:footer>
+ <text:p text:style-name="MP1"><text:page-number text:select-page="current"/></text:p>
+ </style:footer>
+ </style:master-page>
+ <style:master-page style:name="OrgFirstPage" style:page-layout-name="Mpm4" style:next-style-name="OrgPage">
+ <style:footer>
+ <text:p text:style-name="MP1"><text:page-number text:select-page="current"/></text:p>
+ </style:footer>
+ </style:master-page>
+ <style:master-page style:name="OrgPage" style:page-layout-name="Mpm5">
+ <style:footer>
+ <text:p text:style-name="MP1"><text:page-number text:select-page="current"/></text:p>
+ </style:footer>
+ </style:master-page>
+ </office:master-styles>
+</office:document-styles>
diff --git a/etc/org/README b/etc/org/README
new file mode 100644
index 00000000000..206f3a26b52
--- /dev/null
+++ b/etc/org/README
@@ -0,0 +1,36 @@
+The files OrgOdtContentTemplate.xml and OrgOdtStyles.xml have the
+following copyright information:
+
+Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+These files are 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/>.
+
+
+Author: Jambunathan K <kjambunathan at gmail dot com>
+Keywords: outlines, hypermedia, calendar, wp
+Homepage: http://orgmode.org
+
+Commentary:
+
+These files are part of Org-mode's OpenDocument export module.
+
+OrgOdtContentTemplate.xml provides a template within which the content
+of an exported document is enclosed. This file contributes to
+"content.xml" file within an exported document and acts as a
+repository of automatic styles.
+
+OrgOdtStyles.xml contributes to "styles.xml" file within an exported
+document and acts as a repository of custom styles.
diff --git a/etc/ps-prin0.ps b/etc/ps-prin0.ps
index ed48807b068..59bdd2c5eba 100644
--- a/etc/ps-prin0.ps
+++ b/etc/ps-prin0.ps
@@ -1,7 +1,7 @@
% === BEGIN ps-print prologue 0
% version: 6.0
-% Copyright (C) 2000-2011 Free Software Foundation, Inc.
+% Copyright (C) 2000-2012 Free Software Foundation, Inc.
% This file is part of GNU Emacs.
diff --git a/etc/ps-prin1.ps b/etc/ps-prin1.ps
index dbb0db846bf..85130e7cadb 100644
--- a/etc/ps-prin1.ps
+++ b/etc/ps-prin1.ps
@@ -1,7 +1,7 @@
% === BEGIN ps-print prologue 1
% version: 6.1
-% Copyright (C) 2000-2011 Free Software Foundation, Inc.
+% Copyright (C) 2000-2012 Free Software Foundation, Inc.
% This file is part of GNU Emacs.
diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt
new file mode 100644
index 00000000000..45cd95aca30
--- /dev/null
+++ b/etc/publicsuffix.txt
@@ -0,0 +1,5189 @@
+// ***** BEGIN LICENSE BLOCK *****
+// Version: MPL 1.1/GPL 2.0/LGPL 2.1
+//
+// The contents of this file are subject to the Mozilla Public License Version
+// 1.1 (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.mozilla.org/MPL/
+//
+// Software distributed under the License is distributed on an "AS IS" basis,
+// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+// for the specific language governing rights and limitations under the
+// License.
+//
+// The Original Code is the Public Suffix List.
+//
+// The Initial Developer of the Original Code is
+// Jo Hermans <jo.hermans@gmail.com>.
+// Portions created by the Initial Developer are Copyright (C) 2007
+// the Initial Developer. All Rights Reserved.
+//
+// Contributor(s):
+// Ruben Arakelyan <ruben@rubenarakelyan.com>
+// Gervase Markham <gerv@gerv.net>
+// Pamela Greene <pamg.bugs@gmail.com>
+// David Triendl <david@triendl.name>
+// Jothan Frakes <jothan@gmail.com>
+// The kind representatives of many TLD registries
+//
+// Alternatively, the contents of this file may be used under the terms of
+// either the GNU General Public License Version 2 or later (the "GPL"), or
+// the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
+// in which case the provisions of the GPL or the LGPL are applicable instead
+// of those above. If you wish to allow use of your version of this file only
+// under the terms of either the GPL or the LGPL, and not to allow others to
+// use your version of this file under the terms of the MPL, indicate your
+// decision by deleting the provisions above and replace them with the notice
+// and other provisions required by the GPL or the LGPL. If you do not delete
+// the provisions above, a recipient may use your version of this file under
+// the terms of any one of the MPL, the GPL or the LGPL.
+//
+// ***** END LICENSE BLOCK *****
+
+// ac : http://en.wikipedia.org/wiki/.ac
+ac
+com.ac
+edu.ac
+gov.ac
+net.ac
+mil.ac
+org.ac
+
+// ad : http://en.wikipedia.org/wiki/.ad
+ad
+nom.ad
+
+// ae : http://en.wikipedia.org/wiki/.ae
+// see also: "Domain Name Eligibility Policy" at http://www.aeda.ae/eng/aepolicy.php
+ae
+co.ae
+net.ae
+org.ae
+sch.ae
+ac.ae
+gov.ae
+mil.ae
+
+// aero : see http://www.information.aero/index.php?id=66
+aero
+accident-investigation.aero
+accident-prevention.aero
+aerobatic.aero
+aeroclub.aero
+aerodrome.aero
+agents.aero
+aircraft.aero
+airline.aero
+airport.aero
+air-surveillance.aero
+airtraffic.aero
+air-traffic-control.aero
+ambulance.aero
+amusement.aero
+association.aero
+author.aero
+ballooning.aero
+broker.aero
+caa.aero
+cargo.aero
+catering.aero
+certification.aero
+championship.aero
+charter.aero
+civilaviation.aero
+club.aero
+conference.aero
+consultant.aero
+consulting.aero
+control.aero
+council.aero
+crew.aero
+design.aero
+dgca.aero
+educator.aero
+emergency.aero
+engine.aero
+engineer.aero
+entertainment.aero
+equipment.aero
+exchange.aero
+express.aero
+federation.aero
+flight.aero
+freight.aero
+fuel.aero
+gliding.aero
+government.aero
+groundhandling.aero
+group.aero
+hanggliding.aero
+homebuilt.aero
+insurance.aero
+journal.aero
+journalist.aero
+leasing.aero
+logistics.aero
+magazine.aero
+maintenance.aero
+marketplace.aero
+media.aero
+microlight.aero
+modelling.aero
+navigation.aero
+parachuting.aero
+paragliding.aero
+passenger-association.aero
+pilot.aero
+press.aero
+production.aero
+recreation.aero
+repbody.aero
+res.aero
+research.aero
+rotorcraft.aero
+safety.aero
+scientist.aero
+services.aero
+show.aero
+skydiving.aero
+software.aero
+student.aero
+taxi.aero
+trader.aero
+trading.aero
+trainer.aero
+union.aero
+workinggroup.aero
+works.aero
+
+// af : http://www.nic.af/help.jsp
+af
+gov.af
+com.af
+org.af
+net.af
+edu.af
+
+// ag : http://www.nic.ag/prices.htm
+ag
+com.ag
+org.ag
+net.ag
+co.ag
+nom.ag
+
+// ai : http://nic.com.ai/
+ai
+off.ai
+com.ai
+net.ai
+org.ai
+
+// al : http://www.ert.gov.al/ert_alb/faq_det.html?Id=31
+al
+com.al
+edu.al
+gov.al
+mil.al
+net.al
+org.al
+
+// am : http://en.wikipedia.org/wiki/.am
+am
+
+// an : http://www.una.an/an_domreg/default.asp
+an
+com.an
+net.an
+org.an
+edu.an
+
+// ao : http://en.wikipedia.org/wiki/.ao
+// http://www.dns.ao/REGISTR.DOC
+ao
+ed.ao
+gv.ao
+og.ao
+co.ao
+pb.ao
+it.ao
+
+// aq : http://en.wikipedia.org/wiki/.aq
+aq
+
+// ar : http://en.wikipedia.org/wiki/.ar
+*.ar
+!congresodelalengua3.ar
+!educ.ar
+!gobiernoelectronico.ar
+!mecon.ar
+!nacion.ar
+!nic.ar
+!promocion.ar
+!retina.ar
+!uba.ar
+
+// arpa : http://en.wikipedia.org/wiki/.arpa
+// Confirmed by registry <iana-questions@icann.org> 2008-06-18
+e164.arpa
+in-addr.arpa
+ip6.arpa
+iris.arpa
+uri.arpa
+urn.arpa
+
+// as : http://en.wikipedia.org/wiki/.as
+as
+gov.as
+
+// asia: http://en.wikipedia.org/wiki/.asia
+asia
+
+// at : http://en.wikipedia.org/wiki/.at
+// Confirmed by registry <it@nic.at> 2008-06-17
+at
+ac.at
+co.at
+gv.at
+or.at
+
+// http://www.info.at/
+biz.at
+info.at
+
+// priv.at : http://www.nic.priv.at/
+// Submitted by registry <lendl@nic.at> 2008-06-09
+priv.at
+
+// au : http://en.wikipedia.org/wiki/.au
+*.au
+// au geographical names (vic.au etc... are covered above)
+act.edu.au
+nsw.edu.au
+nt.edu.au
+qld.edu.au
+sa.edu.au
+tas.edu.au
+vic.edu.au
+wa.edu.au
+act.gov.au
+// Removed at request of Shae.Donelan@services.nsw.gov.au, 2010-03-04
+// nsw.gov.au
+nt.gov.au
+qld.gov.au
+sa.gov.au
+tas.gov.au
+vic.gov.au
+wa.gov.au
+// CGDNs - http://www.aucd.org.au/
+act.au
+nsw.au
+nt.au
+qld.au
+sa.au
+tas.au
+vic.au
+wa.au
+
+// aw : http://en.wikipedia.org/wiki/.aw
+aw
+com.aw
+
+// ax : http://en.wikipedia.org/wiki/.ax
+ax
+
+// az : http://en.wikipedia.org/wiki/.az
+az
+com.az
+net.az
+int.az
+gov.az
+org.az
+edu.az
+info.az
+pp.az
+mil.az
+name.az
+pro.az
+biz.az
+
+// ba : http://en.wikipedia.org/wiki/.ba
+ba
+org.ba
+net.ba
+edu.ba
+gov.ba
+mil.ba
+unsa.ba
+unbi.ba
+co.ba
+com.ba
+rs.ba
+
+// bb : http://en.wikipedia.org/wiki/.bb
+bb
+biz.bb
+com.bb
+edu.bb
+gov.bb
+info.bb
+net.bb
+org.bb
+store.bb
+
+// bd : http://en.wikipedia.org/wiki/.bd
+*.bd
+
+// be : http://en.wikipedia.org/wiki/.be
+// Confirmed by registry <tech@dns.be> 2008-06-08
+be
+ac.be
+
+// bf : http://en.wikipedia.org/wiki/.bf
+bf
+gov.bf
+
+// bg : http://en.wikipedia.org/wiki/.bg
+// https://www.register.bg/user/static/rules/en/index.html
+bg
+a.bg
+b.bg
+c.bg
+d.bg
+e.bg
+f.bg
+g.bg
+h.bg
+i.bg
+j.bg
+k.bg
+l.bg
+m.bg
+n.bg
+o.bg
+p.bg
+q.bg
+r.bg
+s.bg
+t.bg
+u.bg
+v.bg
+w.bg
+x.bg
+y.bg
+z.bg
+0.bg
+1.bg
+2.bg
+3.bg
+4.bg
+5.bg
+6.bg
+7.bg
+8.bg
+9.bg
+
+// bh : http://en.wikipedia.org/wiki/.bh
+bh
+com.bh
+edu.bh
+net.bh
+org.bh
+gov.bh
+
+// bi : http://en.wikipedia.org/wiki/.bi
+// http://whois.nic.bi/
+bi
+co.bi
+com.bi
+edu.bi
+or.bi
+org.bi
+
+// biz : http://en.wikipedia.org/wiki/.biz
+biz
+
+// bj : http://en.wikipedia.org/wiki/.bj
+bj
+asso.bj
+barreau.bj
+gouv.bj
+
+// bm : http://www.bermudanic.bm/dnr-text.txt
+bm
+com.bm
+edu.bm
+gov.bm
+net.bm
+org.bm
+
+// bn : http://en.wikipedia.org/wiki/.bn
+*.bn
+
+// bo : http://www.nic.bo/
+bo
+com.bo
+edu.bo
+gov.bo
+gob.bo
+int.bo
+org.bo
+net.bo
+mil.bo
+tv.bo
+
+// br : http://registro.br/dominio/dpn.html
+// Updated by registry <fneves@registro.br> 2011-03-01
+br
+adm.br
+adv.br
+agr.br
+am.br
+arq.br
+art.br
+ato.br
+b.br
+bio.br
+blog.br
+bmd.br
+can.br
+cim.br
+cng.br
+cnt.br
+com.br
+coop.br
+ecn.br
+edu.br
+emp.br
+eng.br
+esp.br
+etc.br
+eti.br
+far.br
+flog.br
+fm.br
+fnd.br
+fot.br
+fst.br
+g12.br
+ggf.br
+gov.br
+imb.br
+ind.br
+inf.br
+jor.br
+jus.br
+lel.br
+mat.br
+med.br
+mil.br
+mus.br
+net.br
+nom.br
+not.br
+ntr.br
+odo.br
+org.br
+ppg.br
+pro.br
+psc.br
+psi.br
+qsl.br
+radio.br
+rec.br
+slg.br
+srv.br
+taxi.br
+teo.br
+tmp.br
+trd.br
+tur.br
+tv.br
+vet.br
+vlog.br
+wiki.br
+zlg.br
+
+// bs : http://www.nic.bs/rules.html
+bs
+com.bs
+net.bs
+org.bs
+edu.bs
+gov.bs
+
+// bt : http://en.wikipedia.org/wiki/.bt
+bt
+com.bt
+edu.bt
+gov.bt
+net.bt
+org.bt
+
+// bv : No registrations at this time.
+// Submitted by registry <jarle@uninett.no> 2006-06-16
+
+// bw : http://en.wikipedia.org/wiki/.bw
+// http://www.gobin.info/domainname/bw.doc
+// list of other 2nd level tlds ?
+bw
+co.bw
+org.bw
+
+// by : http://en.wikipedia.org/wiki/.by
+// http://tld.by/rules_2006_en.html
+// list of other 2nd level tlds ?
+by
+gov.by
+mil.by
+// Official information does not indicate that com.by is a reserved
+// second-level domain, but it's being used as one (see www.google.com.by and
+// www.yahoo.com.by, for example), so we list it here for safety's sake.
+com.by
+
+// http://hoster.by/
+of.by
+
+// bz : http://en.wikipedia.org/wiki/.bz
+// http://www.belizenic.bz/
+bz
+com.bz
+net.bz
+org.bz
+edu.bz
+gov.bz
+
+// ca : http://en.wikipedia.org/wiki/.ca
+ca
+// ca geographical names
+ab.ca
+bc.ca
+mb.ca
+nb.ca
+nf.ca
+nl.ca
+ns.ca
+nt.ca
+nu.ca
+on.ca
+pe.ca
+qc.ca
+sk.ca
+yk.ca
+// gc.ca: http://en.wikipedia.org/wiki/.gc.ca
+// see also: http://registry.gc.ca/en/SubdomainFAQ
+gc.ca
+
+// cat : http://en.wikipedia.org/wiki/.cat
+cat
+
+// cc : http://en.wikipedia.org/wiki/.cc
+cc
+
+// cd : http://en.wikipedia.org/wiki/.cd
+// see also: https://www.nic.cd/domain/insertDomain_2.jsp?act=1
+cd
+gov.cd
+
+// cf : http://en.wikipedia.org/wiki/.cf
+cf
+
+// cg : http://en.wikipedia.org/wiki/.cg
+cg
+
+// ch : http://en.wikipedia.org/wiki/.ch
+ch
+
+// ci : http://en.wikipedia.org/wiki/.ci
+// http://www.nic.ci/index.php?page=charte
+ci
+org.ci
+or.ci
+com.ci
+co.ci
+edu.ci
+ed.ci
+ac.ci
+net.ci
+go.ci
+asso.ci
+aéroport.ci
+int.ci
+presse.ci
+md.ci
+gouv.ci
+
+// ck : http://en.wikipedia.org/wiki/.ck
+*.ck
+
+// cl : http://en.wikipedia.org/wiki/.cl
+cl
+gov.cl
+gob.cl
+
+// cm : http://en.wikipedia.org/wiki/.cm
+cm
+gov.cm
+
+// cn : http://en.wikipedia.org/wiki/.cn
+// Submitted by registry <tanyaling@cnnic.cn> 2008-06-11
+cn
+ac.cn
+com.cn
+edu.cn
+gov.cn
+net.cn
+org.cn
+mil.cn
+公司.cn
+网络.cn
+網絡.cn
+// cn geographic names
+ah.cn
+bj.cn
+cq.cn
+fj.cn
+gd.cn
+gs.cn
+gz.cn
+gx.cn
+ha.cn
+hb.cn
+he.cn
+hi.cn
+hl.cn
+hn.cn
+jl.cn
+js.cn
+jx.cn
+ln.cn
+nm.cn
+nx.cn
+qh.cn
+sc.cn
+sd.cn
+sh.cn
+sn.cn
+sx.cn
+tj.cn
+xj.cn
+xz.cn
+yn.cn
+zj.cn
+hk.cn
+mo.cn
+tw.cn
+
+// co : http://en.wikipedia.org/wiki/.co
+// Submitted by registry <tecnico@uniandes.edu.co> 2008-06-11
+co
+arts.co
+com.co
+edu.co
+firm.co
+gov.co
+info.co
+int.co
+mil.co
+net.co
+nom.co
+org.co
+rec.co
+web.co
+
+// com : http://en.wikipedia.org/wiki/.com
+com
+
+// CentralNic names : http://www.centralnic.com/names/domains
+// Confirmed by registry <gavin.brown@centralnic.com> 2008-06-09
+ar.com
+br.com
+cn.com
+de.com
+eu.com
+gb.com
+hu.com
+jpn.com
+kr.com
+no.com
+qc.com
+ru.com
+sa.com
+se.com
+uk.com
+us.com
+uy.com
+za.com
+
+// Requested by Yngve Pettersen <yngve@opera.com> 2009-11-26
+operaunite.com
+
+// Requested by Eduardo Vela <evn@google.com> 2010-09-06
+appspot.com
+
+// coop : http://en.wikipedia.org/wiki/.coop
+coop
+
+// cr : http://www.nic.cr/niccr_publico/showRegistroDominiosScreen.do
+cr
+ac.cr
+co.cr
+ed.cr
+fi.cr
+go.cr
+or.cr
+sa.cr
+
+// cu : http://en.wikipedia.org/wiki/.cu
+cu
+com.cu
+edu.cu
+org.cu
+net.cu
+gov.cu
+inf.cu
+
+// cv : http://en.wikipedia.org/wiki/.cv
+cv
+
+// cx : http://en.wikipedia.org/wiki/.cx
+// list of other 2nd level tlds ?
+cx
+gov.cx
+
+// cy : http://en.wikipedia.org/wiki/.cy
+*.cy
+
+// cz : http://en.wikipedia.org/wiki/.cz
+cz
+
+// de : http://en.wikipedia.org/wiki/.de
+// Confirmed by registry <ops@denic.de> (with technical
+// reservations) 2008-07-01
+de
+
+// dj : http://en.wikipedia.org/wiki/.dj
+dj
+
+// dk : http://en.wikipedia.org/wiki/.dk
+// Confirmed by registry <robert@dk-hostmaster.dk> 2008-06-17
+dk
+
+// dm : http://en.wikipedia.org/wiki/.dm
+dm
+com.dm
+net.dm
+org.dm
+edu.dm
+gov.dm
+
+// do : http://en.wikipedia.org/wiki/.do
+do
+art.do
+com.do
+edu.do
+gob.do
+gov.do
+mil.do
+net.do
+org.do
+sld.do
+web.do
+
+// dz : http://en.wikipedia.org/wiki/.dz
+dz
+com.dz
+org.dz
+net.dz
+gov.dz
+edu.dz
+asso.dz
+pol.dz
+art.dz
+
+// ec : http://www.nic.ec/reg/paso1.asp
+// Submitted by registry <vabboud@nic.ec> 2008-07-04
+ec
+com.ec
+info.ec
+net.ec
+fin.ec
+k12.ec
+med.ec
+pro.ec
+org.ec
+edu.ec
+gov.ec
+gob.ec
+mil.ec
+
+// edu : http://en.wikipedia.org/wiki/.edu
+edu
+
+// ee : http://www.eenet.ee/EENet/dom_reeglid.html#lisa_B
+ee
+edu.ee
+gov.ee
+riik.ee
+lib.ee
+med.ee
+com.ee
+pri.ee
+aip.ee
+org.ee
+fie.ee
+
+// eg : http://en.wikipedia.org/wiki/.eg
+eg
+com.eg
+edu.eg
+eun.eg
+gov.eg
+mil.eg
+name.eg
+net.eg
+org.eg
+sci.eg
+
+// er : http://en.wikipedia.org/wiki/.er
+*.er
+
+// es : https://www.nic.es/site_ingles/ingles/dominios/index.html
+es
+com.es
+nom.es
+org.es
+gob.es
+edu.es
+
+// et : http://en.wikipedia.org/wiki/.et
+*.et
+
+// eu : http://en.wikipedia.org/wiki/.eu
+eu
+
+// fi : http://en.wikipedia.org/wiki/.fi
+fi
+// aland.fi : http://en.wikipedia.org/wiki/.ax
+// This domain is being phased out in favor of .ax. As there are still many
+// domains under aland.fi, we still keep it on the list until aland.fi is
+// completely removed.
+// TODO: Check for updates (expected to be phased out around Q1/2009)
+aland.fi
+// iki.fi : Submitted by Hannu Aronsson <haa@iki.fi> 2009-11-05
+iki.fi
+
+// fj : http://en.wikipedia.org/wiki/.fj
+*.fj
+
+// fk : http://en.wikipedia.org/wiki/.fk
+*.fk
+
+// fm : http://en.wikipedia.org/wiki/.fm
+fm
+
+// fo : http://en.wikipedia.org/wiki/.fo
+fo
+
+// fr : http://www.afnic.fr/
+// domaines descriptifs : http://www.afnic.fr/obtenir/chartes/nommage-fr/annexe-descriptifs
+fr
+com.fr
+asso.fr
+nom.fr
+prd.fr
+presse.fr
+tm.fr
+// domaines sectoriels : http://www.afnic.fr/obtenir/chartes/nommage-fr/annexe-sectoriels
+aeroport.fr
+assedic.fr
+avocat.fr
+avoues.fr
+cci.fr
+chambagri.fr
+chirurgiens-dentistes.fr
+experts-comptables.fr
+geometre-expert.fr
+gouv.fr
+greta.fr
+huissier-justice.fr
+medecin.fr
+notaires.fr
+pharmacien.fr
+port.fr
+veterinaire.fr
+
+// ga : http://en.wikipedia.org/wiki/.ga
+ga
+
+// gb : This registry is effectively dormant
+// Submitted by registry <Damien.Shaw@ja.net> 2008-06-12
+
+// gd : http://en.wikipedia.org/wiki/.gd
+gd
+
+// ge : http://www.nic.net.ge/policy_en.pdf
+ge
+com.ge
+edu.ge
+gov.ge
+org.ge
+mil.ge
+net.ge
+pvt.ge
+
+// gf : http://en.wikipedia.org/wiki/.gf
+gf
+
+// gg : http://www.channelisles.net/applic/avextn.shtml
+gg
+co.gg
+org.gg
+net.gg
+sch.gg
+gov.gg
+
+// gh : http://en.wikipedia.org/wiki/.gh
+// see also: http://www.nic.gh/reg_now.php
+// Although domains directly at second level are not possible at the moment,
+// they have been possible for some time and may come back.
+gh
+com.gh
+edu.gh
+gov.gh
+org.gh
+mil.gh
+
+// gi : http://www.nic.gi/rules.html
+gi
+com.gi
+ltd.gi
+gov.gi
+mod.gi
+edu.gi
+org.gi
+
+// gl : http://en.wikipedia.org/wiki/.gl
+// http://nic.gl
+gl
+
+// gm : http://www.nic.gm/htmlpages%5Cgm-policy.htm
+gm
+
+// gn : http://psg.com/dns/gn/gn.txt
+// Submitted by registry <randy@psg.com> 2008-06-17
+ac.gn
+com.gn
+edu.gn
+gov.gn
+org.gn
+net.gn
+
+// gov : http://en.wikipedia.org/wiki/.gov
+gov
+
+// gp : http://www.nic.gp/index.php?lang=en
+gp
+com.gp
+net.gp
+mobi.gp
+edu.gp
+org.gp
+asso.gp
+
+// gq : http://en.wikipedia.org/wiki/.gq
+gq
+
+// gr : https://grweb.ics.forth.gr/english/1617-B-2005.html
+// Submitted by registry <segred@ics.forth.gr> 2008-06-09
+gr
+com.gr
+edu.gr
+net.gr
+org.gr
+gov.gr
+
+// gs : http://en.wikipedia.org/wiki/.gs
+gs
+
+// gt : http://www.gt/politicas.html
+*.gt
+
+// gu : http://gadao.gov.gu/registration.txt
+*.gu
+
+// gw : http://en.wikipedia.org/wiki/.gw
+gw
+
+// gy : http://en.wikipedia.org/wiki/.gy
+// http://registry.gy/
+gy
+co.gy
+com.gy
+net.gy
+
+// hk : https://www.hkdnr.hk
+// Submitted by registry <hk.tech@hkirc.hk> 2008-06-11
+hk
+com.hk
+edu.hk
+gov.hk
+idv.hk
+net.hk
+org.hk
+公司.hk
+教育.hk
+敎育.hk
+政府.hk
+個人.hk
+个人.hk
+箇人.hk
+網络.hk
+网络.hk
+组織.hk
+網絡.hk
+网絡.hk
+组织.hk
+組織.hk
+組织.hk
+
+// hm : http://en.wikipedia.org/wiki/.hm
+hm
+
+// hn : http://www.nic.hn/politicas/ps02,,05.html
+hn
+com.hn
+edu.hn
+org.hn
+net.hn
+mil.hn
+gob.hn
+
+// hr : http://www.dns.hr/documents/pdf/HRTLD-regulations.pdf
+hr
+iz.hr
+from.hr
+name.hr
+com.hr
+
+// ht : http://www.nic.ht/info/charte.cfm
+ht
+com.ht
+shop.ht
+firm.ht
+info.ht
+adult.ht
+net.ht
+pro.ht
+org.ht
+med.ht
+art.ht
+coop.ht
+pol.ht
+asso.ht
+edu.ht
+rel.ht
+gouv.ht
+perso.ht
+
+// hu : http://www.domain.hu/domain/English/sld.html
+// Confirmed by registry <pasztor@iszt.hu> 2008-06-12
+hu
+co.hu
+info.hu
+org.hu
+priv.hu
+sport.hu
+tm.hu
+2000.hu
+agrar.hu
+bolt.hu
+casino.hu
+city.hu
+erotica.hu
+erotika.hu
+film.hu
+forum.hu
+games.hu
+hotel.hu
+ingatlan.hu
+jogasz.hu
+konyvelo.hu
+lakas.hu
+media.hu
+news.hu
+reklam.hu
+sex.hu
+shop.hu
+suli.hu
+szex.hu
+tozsde.hu
+utazas.hu
+video.hu
+
+// id : http://en.wikipedia.org/wiki/.id
+// see also: https://register.pandi.or.id/
+id
+ac.id
+co.id
+go.id
+mil.id
+net.id
+or.id
+sch.id
+web.id
+
+// ie : http://en.wikipedia.org/wiki/.ie
+ie
+gov.ie
+
+// il : http://en.wikipedia.org/wiki/.il
+*.il
+
+// im : https://www.nic.im/pdfs/imfaqs.pdf
+im
+co.im
+ltd.co.im
+plc.co.im
+net.im
+gov.im
+org.im
+nic.im
+ac.im
+
+// in : http://en.wikipedia.org/wiki/.in
+// see also: http://www.inregistry.in/policies/
+// Please note, that nic.in is not an offical eTLD, but used by most
+// government institutions.
+in
+co.in
+firm.in
+net.in
+org.in
+gen.in
+ind.in
+nic.in
+ac.in
+edu.in
+res.in
+gov.in
+mil.in
+
+// info : http://en.wikipedia.org/wiki/.info
+info
+
+// int : http://en.wikipedia.org/wiki/.int
+// Confirmed by registry <iana-questions@icann.org> 2008-06-18
+int
+eu.int
+
+// io : http://www.nic.io/rules.html
+// list of other 2nd level tlds ?
+io
+com.io
+
+// iq : http://www.cmc.iq/english/iq/iqregister1.htm
+iq
+gov.iq
+edu.iq
+mil.iq
+com.iq
+org.iq
+net.iq
+
+// ir : http://www.nic.ir/Terms_and_Conditions_ir,_Appendix_1_Domain_Rules
+// Also see http://www.nic.ir/Internationalized_Domain_Names
+// Two <iran>.ir entries added at request of <tech-team@nic.ir>, 2010-04-16
+ir
+ac.ir
+co.ir
+gov.ir
+id.ir
+net.ir
+org.ir
+sch.ir
+// xn--mgba3a4f16a.ir (<iran>.ir, Persian YEH)
+ایران.ir
+// xn--mgba3a4fra.ir (<iran>.ir, Arabic YEH)
+ايران.ir
+
+// is : http://www.isnic.is/domain/rules.php
+// Confirmed by registry <marius@isgate.is> 2008-12-06
+is
+net.is
+com.is
+edu.is
+gov.is
+org.is
+int.is
+
+// it : http://en.wikipedia.org/wiki/.it
+it
+gov.it
+edu.it
+// list of reserved geo-names :
+// http://www.nic.it/documenti/regolamenti-e-linee-guida/regolamento-assegnazione-versione-6.0.pdf
+// (There is also a list of reserved geo-names corresponding to Italian
+// municipalities : http://www.nic.it/documenti/appendice-c.pdf , but it is
+// not included here.)
+agrigento.it
+ag.it
+alessandria.it
+al.it
+ancona.it
+an.it
+aosta.it
+aoste.it
+ao.it
+arezzo.it
+ar.it
+ascoli-piceno.it
+ascolipiceno.it
+ap.it
+asti.it
+at.it
+avellino.it
+av.it
+bari.it
+ba.it
+andria-barletta-trani.it
+andriabarlettatrani.it
+trani-barletta-andria.it
+tranibarlettaandria.it
+barletta-trani-andria.it
+barlettatraniandria.it
+andria-trani-barletta.it
+andriatranibarletta.it
+trani-andria-barletta.it
+traniandriabarletta.it
+bt.it
+belluno.it
+bl.it
+benevento.it
+bn.it
+bergamo.it
+bg.it
+biella.it
+bi.it
+bologna.it
+bo.it
+bolzano.it
+bozen.it
+balsan.it
+alto-adige.it
+altoadige.it
+suedtirol.it
+bz.it
+brescia.it
+bs.it
+brindisi.it
+br.it
+cagliari.it
+ca.it
+caltanissetta.it
+cl.it
+campobasso.it
+cb.it
+carboniaiglesias.it
+carbonia-iglesias.it
+iglesias-carbonia.it
+iglesiascarbonia.it
+ci.it
+caserta.it
+ce.it
+catania.it
+ct.it
+catanzaro.it
+cz.it
+chieti.it
+ch.it
+como.it
+co.it
+cosenza.it
+cs.it
+cremona.it
+cr.it
+crotone.it
+kr.it
+cuneo.it
+cn.it
+dell-ogliastra.it
+dellogliastra.it
+ogliastra.it
+og.it
+enna.it
+en.it
+ferrara.it
+fe.it
+fermo.it
+fm.it
+firenze.it
+florence.it
+fi.it
+foggia.it
+fg.it
+forli-cesena.it
+forlicesena.it
+cesena-forli.it
+cesenaforli.it
+fc.it
+frosinone.it
+fr.it
+genova.it
+genoa.it
+ge.it
+gorizia.it
+go.it
+grosseto.it
+gr.it
+imperia.it
+im.it
+isernia.it
+is.it
+laquila.it
+aquila.it
+aq.it
+la-spezia.it
+laspezia.it
+sp.it
+latina.it
+lt.it
+lecce.it
+le.it
+lecco.it
+lc.it
+livorno.it
+li.it
+lodi.it
+lo.it
+lucca.it
+lu.it
+macerata.it
+mc.it
+mantova.it
+mn.it
+massa-carrara.it
+massacarrara.it
+carrara-massa.it
+carraramassa.it
+ms.it
+matera.it
+mt.it
+medio-campidano.it
+mediocampidano.it
+campidano-medio.it
+campidanomedio.it
+vs.it
+messina.it
+me.it
+milano.it
+milan.it
+mi.it
+modena.it
+mo.it
+monza.it
+monza-brianza.it
+monzabrianza.it
+monzaebrianza.it
+monzaedellabrianza.it
+monza-e-della-brianza.it
+mb.it
+napoli.it
+naples.it
+na.it
+novara.it
+no.it
+nuoro.it
+nu.it
+oristano.it
+or.it
+padova.it
+padua.it
+pd.it
+palermo.it
+pa.it
+parma.it
+pr.it
+pavia.it
+pv.it
+perugia.it
+pg.it
+pescara.it
+pe.it
+pesaro-urbino.it
+pesarourbino.it
+urbino-pesaro.it
+urbinopesaro.it
+pu.it
+piacenza.it
+pc.it
+pisa.it
+pi.it
+pistoia.it
+pt.it
+pordenone.it
+pn.it
+potenza.it
+pz.it
+prato.it
+po.it
+ragusa.it
+rg.it
+ravenna.it
+ra.it
+reggio-calabria.it
+reggiocalabria.it
+rc.it
+reggio-emilia.it
+reggioemilia.it
+re.it
+rieti.it
+ri.it
+rimini.it
+rn.it
+roma.it
+rome.it
+rm.it
+rovigo.it
+ro.it
+salerno.it
+sa.it
+sassari.it
+ss.it
+savona.it
+sv.it
+siena.it
+si.it
+siracusa.it
+sr.it
+sondrio.it
+so.it
+taranto.it
+ta.it
+tempio-olbia.it
+tempioolbia.it
+olbia-tempio.it
+olbiatempio.it
+ot.it
+teramo.it
+te.it
+terni.it
+tr.it
+torino.it
+turin.it
+to.it
+trapani.it
+tp.it
+trento.it
+trentino.it
+tn.it
+treviso.it
+tv.it
+trieste.it
+ts.it
+udine.it
+ud.it
+varese.it
+va.it
+venezia.it
+venice.it
+ve.it
+verbania.it
+vb.it
+vercelli.it
+vc.it
+verona.it
+vr.it
+vibo-valentia.it
+vibovalentia.it
+vv.it
+vicenza.it
+vi.it
+viterbo.it
+vt.it
+
+// je : http://www.channelisles.net/applic/avextn.shtml
+je
+co.je
+org.je
+net.je
+sch.je
+gov.je
+
+// jm : http://www.com.jm/register.html
+*.jm
+
+// jo : http://www.dns.jo/Registration_policy.aspx
+jo
+com.jo
+org.jo
+net.jo
+edu.jo
+sch.jo
+gov.jo
+mil.jo
+name.jo
+
+// jobs : http://en.wikipedia.org/wiki/.jobs
+jobs
+
+// jp : http://en.wikipedia.org/wiki/.jp
+// http://jprs.co.jp/en/jpdomain.html
+// Submitted by registry <yone@jprs.co.jp> 2008-06-11
+// Updated by registry <yone@jprs.co.jp> 2008-12-04
+jp
+// jp organizational type names
+ac.jp
+ad.jp
+co.jp
+ed.jp
+go.jp
+gr.jp
+lg.jp
+ne.jp
+or.jp
+// jp geographic type names
+// http://jprs.jp/doc/rule/saisoku-1.html
+*.aichi.jp
+*.akita.jp
+*.aomori.jp
+*.chiba.jp
+*.ehime.jp
+*.fukui.jp
+*.fukuoka.jp
+*.fukushima.jp
+*.gifu.jp
+*.gunma.jp
+*.hiroshima.jp
+*.hokkaido.jp
+*.hyogo.jp
+*.ibaraki.jp
+*.ishikawa.jp
+*.iwate.jp
+*.kagawa.jp
+*.kagoshima.jp
+*.kanagawa.jp
+*.kawasaki.jp
+*.kitakyushu.jp
+*.kobe.jp
+*.kochi.jp
+*.kumamoto.jp
+*.kyoto.jp
+*.mie.jp
+*.miyagi.jp
+*.miyazaki.jp
+*.nagano.jp
+*.nagasaki.jp
+*.nagoya.jp
+*.nara.jp
+*.niigata.jp
+*.oita.jp
+*.okayama.jp
+*.okinawa.jp
+*.osaka.jp
+*.saga.jp
+*.saitama.jp
+*.sapporo.jp
+*.sendai.jp
+*.shiga.jp
+*.shimane.jp
+*.shizuoka.jp
+*.tochigi.jp
+*.tokushima.jp
+*.tokyo.jp
+*.tottori.jp
+*.toyama.jp
+*.wakayama.jp
+*.yamagata.jp
+*.yamaguchi.jp
+*.yamanashi.jp
+*.yokohama.jp
+!metro.tokyo.jp
+!pref.aichi.jp
+!pref.akita.jp
+!pref.aomori.jp
+!pref.chiba.jp
+!pref.ehime.jp
+!pref.fukui.jp
+!pref.fukuoka.jp
+!pref.fukushima.jp
+!pref.gifu.jp
+!pref.gunma.jp
+!pref.hiroshima.jp
+!pref.hokkaido.jp
+!pref.hyogo.jp
+!pref.ibaraki.jp
+!pref.ishikawa.jp
+!pref.iwate.jp
+!pref.kagawa.jp
+!pref.kagoshima.jp
+!pref.kanagawa.jp
+!pref.kochi.jp
+!pref.kumamoto.jp
+!pref.kyoto.jp
+!pref.mie.jp
+!pref.miyagi.jp
+!pref.miyazaki.jp
+!pref.nagano.jp
+!pref.nagasaki.jp
+!pref.nara.jp
+!pref.niigata.jp
+!pref.oita.jp
+!pref.okayama.jp
+!pref.okinawa.jp
+!pref.osaka.jp
+!pref.saga.jp
+!pref.saitama.jp
+!pref.shiga.jp
+!pref.shimane.jp
+!pref.shizuoka.jp
+!pref.tochigi.jp
+!pref.tokushima.jp
+!pref.tottori.jp
+!pref.toyama.jp
+!pref.wakayama.jp
+!pref.yamagata.jp
+!pref.yamaguchi.jp
+!pref.yamanashi.jp
+!city.chiba.jp
+!city.fukuoka.jp
+!city.hiroshima.jp
+!city.kawasaki.jp
+!city.kitakyushu.jp
+!city.kobe.jp
+!city.kyoto.jp
+!city.nagoya.jp
+!city.niigata.jp
+!city.okayama.jp
+!city.osaka.jp
+!city.saitama.jp
+!city.sapporo.jp
+!city.sendai.jp
+!city.shizuoka.jp
+!city.yokohama.jp
+
+// ke : http://www.kenic.or.ke/index.php?option=com_content&task=view&id=117&Itemid=145
+*.ke
+
+// kg : http://www.domain.kg/dmn_n.html
+kg
+org.kg
+net.kg
+com.kg
+edu.kg
+gov.kg
+mil.kg
+
+// kh : http://www.mptc.gov.kh/dns_registration.htm
+*.kh
+
+// ki : http://www.ki/dns/index.html
+ki
+edu.ki
+biz.ki
+net.ki
+org.ki
+gov.ki
+info.ki
+com.ki
+
+// km : http://en.wikipedia.org/wiki/.km
+// http://www.domaine.km/documents/charte.doc
+km
+org.km
+nom.km
+gov.km
+prd.km
+tm.km
+edu.km
+mil.km
+ass.km
+com.km
+// These are only mentioned as proposed suggestions at domaine.km, but
+// http://en.wikipedia.org/wiki/.km says they're available for registration:
+coop.km
+asso.km
+presse.km
+medecin.km
+notaires.km
+pharmaciens.km
+veterinaire.km
+gouv.km
+
+// kn : http://en.wikipedia.org/wiki/.kn
+// http://www.dot.kn/domainRules.html
+kn
+net.kn
+org.kn
+edu.kn
+gov.kn
+
+// kp : http://www.kcce.kp/en_index.php
+com.kp
+edu.kp
+gov.kp
+org.kp
+rep.kp
+tra.kp
+
+// kr : http://en.wikipedia.org/wiki/.kr
+// see also: http://domain.nida.or.kr/eng/registration.jsp
+kr
+ac.kr
+co.kr
+es.kr
+go.kr
+hs.kr
+kg.kr
+mil.kr
+ms.kr
+ne.kr
+or.kr
+pe.kr
+re.kr
+sc.kr
+// kr geographical names
+busan.kr
+chungbuk.kr
+chungnam.kr
+daegu.kr
+daejeon.kr
+gangwon.kr
+gwangju.kr
+gyeongbuk.kr
+gyeonggi.kr
+gyeongnam.kr
+incheon.kr
+jeju.kr
+jeonbuk.kr
+jeonnam.kr
+seoul.kr
+ulsan.kr
+
+// kw : http://en.wikipedia.org/wiki/.kw
+*.kw
+
+// ky : http://www.icta.ky/da_ky_reg_dom.php
+// Confirmed by registry <kysupport@perimeterusa.com> 2008-06-17
+ky
+edu.ky
+gov.ky
+com.ky
+org.ky
+net.ky
+
+// kz : http://en.wikipedia.org/wiki/.kz
+// see also: http://www.nic.kz/rules/index.jsp
+kz
+org.kz
+edu.kz
+net.kz
+gov.kz
+mil.kz
+com.kz
+
+// la : http://en.wikipedia.org/wiki/.la
+// Submitted by registry <gavin.brown@nic.la> 2008-06-10
+la
+int.la
+net.la
+info.la
+edu.la
+gov.la
+per.la
+com.la
+org.la
+// see http://www.c.la/
+c.la
+
+// lb : http://en.wikipedia.org/wiki/.lb
+// Submitted by registry <randy@psg.com> 2008-06-17
+com.lb
+edu.lb
+gov.lb
+net.lb
+org.lb
+
+// lc : http://en.wikipedia.org/wiki/.lc
+// see also: http://www.nic.lc/rules.htm
+lc
+com.lc
+net.lc
+co.lc
+org.lc
+edu.lc
+gov.lc
+
+// li : http://en.wikipedia.org/wiki/.li
+li
+
+// lk : http://www.nic.lk/seclevpr.html
+lk
+gov.lk
+sch.lk
+net.lk
+int.lk
+com.lk
+org.lk
+edu.lk
+ngo.lk
+soc.lk
+web.lk
+ltd.lk
+assn.lk
+grp.lk
+hotel.lk
+
+// local : http://en.wikipedia.org/wiki/.local
+local
+
+// lr : http://psg.com/dns/lr/lr.txt
+// Submitted by registry <randy@psg.com> 2008-06-17
+com.lr
+edu.lr
+gov.lr
+org.lr
+net.lr
+
+// ls : http://en.wikipedia.org/wiki/.ls
+ls
+co.ls
+org.ls
+
+// lt : http://en.wikipedia.org/wiki/.lt
+lt
+// gov.lt : http://www.gov.lt/index_en.php
+gov.lt
+
+// lu : http://www.dns.lu/en/
+lu
+
+// lv : http://www.nic.lv/DNS/En/generic.php
+lv
+com.lv
+edu.lv
+gov.lv
+org.lv
+mil.lv
+id.lv
+net.lv
+asn.lv
+conf.lv
+
+// ly : http://www.nic.ly/regulations.php
+ly
+com.ly
+net.ly
+gov.ly
+plc.ly
+edu.ly
+sch.ly
+med.ly
+org.ly
+id.ly
+
+// ma : http://en.wikipedia.org/wiki/.ma
+// http://www.anrt.ma/fr/admin/download/upload/file_fr782.pdf
+ma
+co.ma
+net.ma
+gov.ma
+org.ma
+ac.ma
+press.ma
+
+// mc : http://www.nic.mc/
+mc
+tm.mc
+asso.mc
+
+// md : http://en.wikipedia.org/wiki/.md
+md
+
+// me : http://en.wikipedia.org/wiki/.me
+me
+co.me
+net.me
+org.me
+edu.me
+ac.me
+gov.me
+its.me
+priv.me
+
+// mg : http://www.nic.mg/tarif.htm
+mg
+org.mg
+nom.mg
+gov.mg
+prd.mg
+tm.mg
+edu.mg
+mil.mg
+com.mg
+
+// mh : http://en.wikipedia.org/wiki/.mh
+mh
+
+// mil : http://en.wikipedia.org/wiki/.mil
+mil
+
+// mk : http://en.wikipedia.org/wiki/.mk
+// see also: http://dns.marnet.net.mk/postapka.php
+mk
+com.mk
+org.mk
+net.mk
+edu.mk
+gov.mk
+inf.mk
+name.mk
+
+// ml : http://www.gobin.info/domainname/ml-template.doc
+// see also: http://en.wikipedia.org/wiki/.ml
+ml
+com.ml
+edu.ml
+gouv.ml
+gov.ml
+net.ml
+org.ml
+presse.ml
+
+// mm : http://en.wikipedia.org/wiki/.mm
+*.mm
+
+// mn : http://en.wikipedia.org/wiki/.mn
+mn
+gov.mn
+edu.mn
+org.mn
+
+// mo : http://www.monic.net.mo/
+mo
+com.mo
+net.mo
+org.mo
+edu.mo
+gov.mo
+
+// mobi : http://en.wikipedia.org/wiki/.mobi
+mobi
+
+// mp : http://www.dot.mp/
+// Confirmed by registry <dcamacho@saipan.com> 2008-06-17
+mp
+
+// mq : http://en.wikipedia.org/wiki/.mq
+mq
+
+// mr : http://en.wikipedia.org/wiki/.mr
+mr
+gov.mr
+
+// ms : http://en.wikipedia.org/wiki/.ms
+ms
+
+// mt : https://www.nic.org.mt/dotmt/
+*.mt
+
+// mu : http://en.wikipedia.org/wiki/.mu
+mu
+com.mu
+net.mu
+org.mu
+gov.mu
+ac.mu
+co.mu
+or.mu
+
+// museum : http://about.museum/naming/
+// http://index.museum/
+museum
+academy.museum
+agriculture.museum
+air.museum
+airguard.museum
+alabama.museum
+alaska.museum
+amber.museum
+ambulance.museum
+american.museum
+americana.museum
+americanantiques.museum
+americanart.museum
+amsterdam.museum
+and.museum
+annefrank.museum
+anthro.museum
+anthropology.museum
+antiques.museum
+aquarium.museum
+arboretum.museum
+archaeological.museum
+archaeology.museum
+architecture.museum
+art.museum
+artanddesign.museum
+artcenter.museum
+artdeco.museum
+arteducation.museum
+artgallery.museum
+arts.museum
+artsandcrafts.museum
+asmatart.museum
+assassination.museum
+assisi.museum
+association.museum
+astronomy.museum
+atlanta.museum
+austin.museum
+australia.museum
+automotive.museum
+aviation.museum
+axis.museum
+badajoz.museum
+baghdad.museum
+bahn.museum
+bale.museum
+baltimore.museum
+barcelona.museum
+baseball.museum
+basel.museum
+baths.museum
+bauern.museum
+beauxarts.museum
+beeldengeluid.museum
+bellevue.museum
+bergbau.museum
+berkeley.museum
+berlin.museum
+bern.museum
+bible.museum
+bilbao.museum
+bill.museum
+birdart.museum
+birthplace.museum
+bonn.museum
+boston.museum
+botanical.museum
+botanicalgarden.museum
+botanicgarden.museum
+botany.museum
+brandywinevalley.museum
+brasil.museum
+bristol.museum
+british.museum
+britishcolumbia.museum
+broadcast.museum
+brunel.museum
+brussel.museum
+brussels.museum
+bruxelles.museum
+building.museum
+burghof.museum
+bus.museum
+bushey.museum
+cadaques.museum
+california.museum
+cambridge.museum
+can.museum
+canada.museum
+capebreton.museum
+carrier.museum
+cartoonart.museum
+casadelamoneda.museum
+castle.museum
+castres.museum
+celtic.museum
+center.museum
+chattanooga.museum
+cheltenham.museum
+chesapeakebay.museum
+chicago.museum
+children.museum
+childrens.museum
+childrensgarden.museum
+chiropractic.museum
+chocolate.museum
+christiansburg.museum
+cincinnati.museum
+cinema.museum
+circus.museum
+civilisation.museum
+civilization.museum
+civilwar.museum
+clinton.museum
+clock.museum
+coal.museum
+coastaldefence.museum
+cody.museum
+coldwar.museum
+collection.museum
+colonialwilliamsburg.museum
+coloradoplateau.museum
+columbia.museum
+columbus.museum
+communication.museum
+communications.museum
+community.museum
+computer.museum
+computerhistory.museum
+comunicações.museum
+contemporary.museum
+contemporaryart.museum
+convent.museum
+copenhagen.museum
+corporation.museum
+correios-e-telecomunicações.museum
+corvette.museum
+costume.museum
+countryestate.museum
+county.museum
+crafts.museum
+cranbrook.museum
+creation.museum
+cultural.museum
+culturalcenter.museum
+culture.museum
+cyber.museum
+cymru.museum
+dali.museum
+dallas.museum
+database.museum
+ddr.museum
+decorativearts.museum
+delaware.museum
+delmenhorst.museum
+denmark.museum
+depot.museum
+design.museum
+detroit.museum
+dinosaur.museum
+discovery.museum
+dolls.museum
+donostia.museum
+durham.museum
+eastafrica.museum
+eastcoast.museum
+education.museum
+educational.museum
+egyptian.museum
+eisenbahn.museum
+elburg.museum
+elvendrell.museum
+embroidery.museum
+encyclopedic.museum
+england.museum
+entomology.museum
+environment.museum
+environmentalconservation.museum
+epilepsy.museum
+essex.museum
+estate.museum
+ethnology.museum
+exeter.museum
+exhibition.museum
+family.museum
+farm.museum
+farmequipment.museum
+farmers.museum
+farmstead.museum
+field.museum
+figueres.museum
+filatelia.museum
+film.museum
+fineart.museum
+finearts.museum
+finland.museum
+flanders.museum
+florida.museum
+force.museum
+fortmissoula.museum
+fortworth.museum
+foundation.museum
+francaise.museum
+frankfurt.museum
+franziskaner.museum
+freemasonry.museum
+freiburg.museum
+fribourg.museum
+frog.museum
+fundacio.museum
+furniture.museum
+gallery.museum
+garden.museum
+gateway.museum
+geelvinck.museum
+gemological.museum
+geology.museum
+georgia.museum
+giessen.museum
+glas.museum
+glass.museum
+gorge.museum
+grandrapids.museum
+graz.museum
+guernsey.museum
+halloffame.museum
+hamburg.museum
+handson.museum
+harvestcelebration.museum
+hawaii.museum
+health.museum
+heimatunduhren.museum
+hellas.museum
+helsinki.museum
+hembygdsforbund.museum
+heritage.museum
+histoire.museum
+historical.museum
+historicalsociety.museum
+historichouses.museum
+historisch.museum
+historisches.museum
+history.museum
+historyofscience.museum
+horology.museum
+house.museum
+humanities.museum
+illustration.museum
+imageandsound.museum
+indian.museum
+indiana.museum
+indianapolis.museum
+indianmarket.museum
+intelligence.museum
+interactive.museum
+iraq.museum
+iron.museum
+isleofman.museum
+jamison.museum
+jefferson.museum
+jerusalem.museum
+jewelry.museum
+jewish.museum
+jewishart.museum
+jfk.museum
+journalism.museum
+judaica.museum
+judygarland.museum
+juedisches.museum
+juif.museum
+karate.museum
+karikatur.museum
+kids.museum
+koebenhavn.museum
+koeln.museum
+kunst.museum
+kunstsammlung.museum
+kunstunddesign.museum
+labor.museum
+labour.museum
+lajolla.museum
+lancashire.museum
+landes.museum
+lans.museum
+läns.museum
+larsson.museum
+lewismiller.museum
+lincoln.museum
+linz.museum
+living.museum
+livinghistory.museum
+localhistory.museum
+london.museum
+losangeles.museum
+louvre.museum
+loyalist.museum
+lucerne.museum
+luxembourg.museum
+luzern.museum
+mad.museum
+madrid.museum
+mallorca.museum
+manchester.museum
+mansion.museum
+mansions.museum
+manx.museum
+marburg.museum
+maritime.museum
+maritimo.museum
+maryland.museum
+marylhurst.museum
+media.museum
+medical.museum
+medizinhistorisches.museum
+meeres.museum
+memorial.museum
+mesaverde.museum
+michigan.museum
+midatlantic.museum
+military.museum
+mill.museum
+miners.museum
+mining.museum
+minnesota.museum
+missile.museum
+missoula.museum
+modern.museum
+moma.museum
+money.museum
+monmouth.museum
+monticello.museum
+montreal.museum
+moscow.museum
+motorcycle.museum
+muenchen.museum
+muenster.museum
+mulhouse.museum
+muncie.museum
+museet.museum
+museumcenter.museum
+museumvereniging.museum
+music.museum
+national.museum
+nationalfirearms.museum
+nationalheritage.museum
+nativeamerican.museum
+naturalhistory.museum
+naturalhistorymuseum.museum
+naturalsciences.museum
+nature.museum
+naturhistorisches.museum
+natuurwetenschappen.museum
+naumburg.museum
+naval.museum
+nebraska.museum
+neues.museum
+newhampshire.museum
+newjersey.museum
+newmexico.museum
+newport.museum
+newspaper.museum
+newyork.museum
+niepce.museum
+norfolk.museum
+north.museum
+nrw.museum
+nuernberg.museum
+nuremberg.museum
+nyc.museum
+nyny.museum
+oceanographic.museum
+oceanographique.museum
+omaha.museum
+online.museum
+ontario.museum
+openair.museum
+oregon.museum
+oregontrail.museum
+otago.museum
+oxford.museum
+pacific.museum
+paderborn.museum
+palace.museum
+paleo.museum
+palmsprings.museum
+panama.museum
+paris.museum
+pasadena.museum
+pharmacy.museum
+philadelphia.museum
+philadelphiaarea.museum
+philately.museum
+phoenix.museum
+photography.museum
+pilots.museum
+pittsburgh.museum
+planetarium.museum
+plantation.museum
+plants.museum
+plaza.museum
+portal.museum
+portland.museum
+portlligat.museum
+posts-and-telecommunications.museum
+preservation.museum
+presidio.museum
+press.museum
+project.museum
+public.museum
+pubol.museum
+quebec.museum
+railroad.museum
+railway.museum
+research.museum
+resistance.museum
+riodejaneiro.museum
+rochester.museum
+rockart.museum
+roma.museum
+russia.museum
+saintlouis.museum
+salem.museum
+salvadordali.museum
+salzburg.museum
+sandiego.museum
+sanfrancisco.museum
+santabarbara.museum
+santacruz.museum
+santafe.museum
+saskatchewan.museum
+satx.museum
+savannahga.museum
+schlesisches.museum
+schoenbrunn.museum
+schokoladen.museum
+school.museum
+schweiz.museum
+science.museum
+scienceandhistory.museum
+scienceandindustry.museum
+sciencecenter.museum
+sciencecenters.museum
+science-fiction.museum
+sciencehistory.museum
+sciences.museum
+sciencesnaturelles.museum
+scotland.museum
+seaport.museum
+settlement.museum
+settlers.museum
+shell.museum
+sherbrooke.museum
+sibenik.museum
+silk.museum
+ski.museum
+skole.museum
+society.museum
+sologne.museum
+soundandvision.museum
+southcarolina.museum
+southwest.museum
+space.museum
+spy.museum
+square.museum
+stadt.museum
+stalbans.museum
+starnberg.museum
+state.museum
+stateofdelaware.museum
+station.museum
+steam.museum
+steiermark.museum
+stjohn.museum
+stockholm.museum
+stpetersburg.museum
+stuttgart.museum
+suisse.museum
+surgeonshall.museum
+surrey.museum
+svizzera.museum
+sweden.museum
+sydney.museum
+tank.museum
+tcm.museum
+technology.museum
+telekommunikation.museum
+television.museum
+texas.museum
+textile.museum
+theater.museum
+time.museum
+timekeeping.museum
+topology.museum
+torino.museum
+touch.museum
+town.museum
+transport.museum
+tree.museum
+trolley.museum
+trust.museum
+trustee.museum
+uhren.museum
+ulm.museum
+undersea.museum
+university.museum
+usa.museum
+usantiques.museum
+usarts.museum
+uscountryestate.museum
+usculture.museum
+usdecorativearts.museum
+usgarden.museum
+ushistory.museum
+ushuaia.museum
+uslivinghistory.museum
+utah.museum
+uvic.museum
+valley.museum
+vantaa.museum
+versailles.museum
+viking.museum
+village.museum
+virginia.museum
+virtual.museum
+virtuel.museum
+vlaanderen.museum
+volkenkunde.museum
+wales.museum
+wallonie.museum
+war.museum
+washingtondc.museum
+watchandclock.museum
+watch-and-clock.museum
+western.museum
+westfalen.museum
+whaling.museum
+wildlife.museum
+williamsburg.museum
+windmill.museum
+workshop.museum
+york.museum
+yorkshire.museum
+yosemite.museum
+youth.museum
+zoological.museum
+zoology.museum
+ירושלים.museum
+иком.museum
+
+// mv : http://en.wikipedia.org/wiki/.mv
+// "mv" included because, contra Wikipedia, google.mv exists.
+mv
+aero.mv
+biz.mv
+com.mv
+coop.mv
+edu.mv
+gov.mv
+info.mv
+int.mv
+mil.mv
+museum.mv
+name.mv
+net.mv
+org.mv
+pro.mv
+
+// mw : http://www.registrar.mw/
+mw
+ac.mw
+biz.mw
+co.mw
+com.mw
+coop.mw
+edu.mw
+gov.mw
+int.mw
+museum.mw
+net.mw
+org.mw
+
+// mx : http://www.nic.mx/
+// Submitted by registry <farias@nic.mx> 2008-06-19
+mx
+com.mx
+org.mx
+gob.mx
+edu.mx
+net.mx
+
+// my : http://www.mynic.net.my/
+my
+com.my
+net.my
+org.my
+gov.my
+edu.my
+mil.my
+name.my
+
+// mz : http://www.gobin.info/domainname/mz-template.doc
+*.mz
+
+// na : http://www.na-nic.com.na/
+// http://www.info.na/domain/
+na
+info.na
+pro.na
+name.na
+school.na
+or.na
+dr.na
+us.na
+mx.na
+ca.na
+in.na
+cc.na
+tv.na
+ws.na
+mobi.na
+co.na
+com.na
+org.na
+
+// name : has 2nd-level tlds, but there's no list of them
+name
+
+// nc : http://www.cctld.nc/
+nc
+asso.nc
+
+// ne : http://en.wikipedia.org/wiki/.ne
+ne
+
+// net : http://en.wikipedia.org/wiki/.net
+net
+
+// CentralNic names : http://www.centralnic.com/names/domains
+// Submitted by registry <gavin.brown@centralnic.com> 2008-06-17
+gb.net
+se.net
+uk.net
+
+// ZaNiC names : http://www.za.net/
+// Confirmed by registry <hostmaster@nic.za.net> 2009-10-03
+za.net
+
+// nf : http://en.wikipedia.org/wiki/.nf
+nf
+com.nf
+net.nf
+per.nf
+rec.nf
+web.nf
+arts.nf
+firm.nf
+info.nf
+other.nf
+store.nf
+
+// ng : http://psg.com/dns/ng/
+// Submitted by registry <randy@psg.com> 2008-06-17
+ac.ng
+com.ng
+edu.ng
+gov.ng
+net.ng
+org.ng
+
+// ni : http://www.nic.ni/dominios.htm
+*.ni
+
+// nl : http://www.domain-registry.nl/ace.php/c,728,122,,,,Home.html
+// Confirmed by registry <Antoin.Verschuren@sidn.nl> (with technical
+// reservations) 2008-06-08
+nl
+
+// BV.nl will be a registry for dutch BV's (besloten vennootschap)
+bv.nl
+
+// the co.nl domain is managed by CoDNS B.V. Added 2010-05-23.
+co.nl
+
+// no : http://www.norid.no/regelverk/index.en.html
+// The Norwegian registry has declined to notify us of updates. The web pages
+// referenced below are the official source of the data. There is also an
+// announce mailing list:
+// https://postlister.uninett.no/sympa/info/norid-diskusjon
+no
+// Norid generic domains : http://www.norid.no/regelverk/vedlegg-c.en.html
+fhs.no
+vgs.no
+fylkesbibl.no
+folkebibl.no
+museum.no
+idrett.no
+priv.no
+// Non-Norid generic domains : http://www.norid.no/regelverk/vedlegg-d.en.html
+mil.no
+stat.no
+dep.no
+kommune.no
+herad.no
+// no geographical names : http://www.norid.no/regelverk/vedlegg-b.en.html
+// counties
+aa.no
+ah.no
+bu.no
+fm.no
+hl.no
+hm.no
+jan-mayen.no
+mr.no
+nl.no
+nt.no
+of.no
+ol.no
+oslo.no
+rl.no
+sf.no
+st.no
+svalbard.no
+tm.no
+tr.no
+va.no
+vf.no
+// primary and lower secondary schools per county
+gs.aa.no
+gs.ah.no
+gs.bu.no
+gs.fm.no
+gs.hl.no
+gs.hm.no
+gs.jan-mayen.no
+gs.mr.no
+gs.nl.no
+gs.nt.no
+gs.of.no
+gs.ol.no
+gs.oslo.no
+gs.rl.no
+gs.sf.no
+gs.st.no
+gs.svalbard.no
+gs.tm.no
+gs.tr.no
+gs.va.no
+gs.vf.no
+// cities
+akrehamn.no
+åkrehamn.no
+algard.no
+ålgård.no
+arna.no
+brumunddal.no
+bryne.no
+bronnoysund.no
+brønnøysund.no
+drobak.no
+drøbak.no
+egersund.no
+fetsund.no
+floro.no
+florø.no
+fredrikstad.no
+hokksund.no
+honefoss.no
+hønefoss.no
+jessheim.no
+jorpeland.no
+jørpeland.no
+kirkenes.no
+kopervik.no
+krokstadelva.no
+langevag.no
+langevåg.no
+leirvik.no
+mjondalen.no
+mjøndalen.no
+mo-i-rana.no
+mosjoen.no
+mosjøen.no
+nesoddtangen.no
+orkanger.no
+osoyro.no
+osøyro.no
+raholt.no
+råholt.no
+sandnessjoen.no
+sandnessjøen.no
+skedsmokorset.no
+slattum.no
+spjelkavik.no
+stathelle.no
+stavern.no
+stjordalshalsen.no
+stjørdalshalsen.no
+tananger.no
+tranby.no
+vossevangen.no
+// communities
+afjord.no
+åfjord.no
+agdenes.no
+al.no
+ål.no
+alesund.no
+ålesund.no
+alstahaug.no
+alta.no
+áltá.no
+alaheadju.no
+álaheadju.no
+alvdal.no
+amli.no
+åmli.no
+amot.no
+åmot.no
+andebu.no
+andoy.no
+andøy.no
+andasuolo.no
+ardal.no
+årdal.no
+aremark.no
+arendal.no
+ås.no
+aseral.no
+åseral.no
+asker.no
+askim.no
+askvoll.no
+askoy.no
+askøy.no
+asnes.no
+åsnes.no
+audnedaln.no
+aukra.no
+aure.no
+aurland.no
+aurskog-holand.no
+aurskog-høland.no
+austevoll.no
+austrheim.no
+averoy.no
+averøy.no
+balestrand.no
+ballangen.no
+balat.no
+bálát.no
+balsfjord.no
+bahccavuotna.no
+báhccavuotna.no
+bamble.no
+bardu.no
+beardu.no
+beiarn.no
+bajddar.no
+bájddar.no
+baidar.no
+báidár.no
+berg.no
+bergen.no
+berlevag.no
+berlevåg.no
+bearalvahki.no
+bearalváhki.no
+bindal.no
+birkenes.no
+bjarkoy.no
+bjarkøy.no
+bjerkreim.no
+bjugn.no
+bodo.no
+bodø.no
+badaddja.no
+bådåddjå.no
+budejju.no
+bokn.no
+bremanger.no
+bronnoy.no
+brønnøy.no
+bygland.no
+bykle.no
+barum.no
+bærum.no
+bo.telemark.no
+bø.telemark.no
+bo.nordland.no
+bø.nordland.no
+bievat.no
+bievát.no
+bomlo.no
+bømlo.no
+batsfjord.no
+båtsfjord.no
+bahcavuotna.no
+báhcavuotna.no
+dovre.no
+drammen.no
+drangedal.no
+dyroy.no
+dyrøy.no
+donna.no
+dønna.no
+eid.no
+eidfjord.no
+eidsberg.no
+eidskog.no
+eidsvoll.no
+eigersund.no
+elverum.no
+enebakk.no
+engerdal.no
+etne.no
+etnedal.no
+evenes.no
+evenassi.no
+evenášši.no
+evje-og-hornnes.no
+farsund.no
+fauske.no
+fuossko.no
+fuoisku.no
+fedje.no
+fet.no
+finnoy.no
+finnøy.no
+fitjar.no
+fjaler.no
+fjell.no
+flakstad.no
+flatanger.no
+flekkefjord.no
+flesberg.no
+flora.no
+fla.no
+flå.no
+folldal.no
+forsand.no
+fosnes.no
+frei.no
+frogn.no
+froland.no
+frosta.no
+frana.no
+fræna.no
+froya.no
+frøya.no
+fusa.no
+fyresdal.no
+forde.no
+førde.no
+gamvik.no
+gangaviika.no
+gáŋgaviika.no
+gaular.no
+gausdal.no
+gildeskal.no
+gildeskål.no
+giske.no
+gjemnes.no
+gjerdrum.no
+gjerstad.no
+gjesdal.no
+gjovik.no
+gjøvik.no
+gloppen.no
+gol.no
+gran.no
+grane.no
+granvin.no
+gratangen.no
+grimstad.no
+grong.no
+kraanghke.no
+kråanghke.no
+grue.no
+gulen.no
+hadsel.no
+halden.no
+halsa.no
+hamar.no
+hamaroy.no
+habmer.no
+hábmer.no
+hapmir.no
+hápmir.no
+hammerfest.no
+hammarfeasta.no
+hámmárfeasta.no
+haram.no
+hareid.no
+harstad.no
+hasvik.no
+aknoluokta.no
+ákŋoluokta.no
+hattfjelldal.no
+aarborte.no
+haugesund.no
+hemne.no
+hemnes.no
+hemsedal.no
+heroy.more-og-romsdal.no
+herøy.møre-og-romsdal.no
+heroy.nordland.no
+herøy.nordland.no
+hitra.no
+hjartdal.no
+hjelmeland.no
+hobol.no
+hobøl.no
+hof.no
+hol.no
+hole.no
+holmestrand.no
+holtalen.no
+holtålen.no
+hornindal.no
+horten.no
+hurdal.no
+hurum.no
+hvaler.no
+hyllestad.no
+hagebostad.no
+hægebostad.no
+hoyanger.no
+høyanger.no
+hoylandet.no
+høylandet.no
+ha.no
+hå.no
+ibestad.no
+inderoy.no
+inderøy.no
+iveland.no
+jevnaker.no
+jondal.no
+jolster.no
+jølster.no
+karasjok.no
+karasjohka.no
+kárášjohka.no
+karlsoy.no
+galsa.no
+gálsá.no
+karmoy.no
+karmøy.no
+kautokeino.no
+guovdageaidnu.no
+klepp.no
+klabu.no
+klæbu.no
+kongsberg.no
+kongsvinger.no
+kragero.no
+kragerø.no
+kristiansand.no
+kristiansund.no
+krodsherad.no
+krødsherad.no
+kvalsund.no
+rahkkeravju.no
+ráhkkerávju.no
+kvam.no
+kvinesdal.no
+kvinnherad.no
+kviteseid.no
+kvitsoy.no
+kvitsøy.no
+kvafjord.no
+kvæfjord.no
+giehtavuoatna.no
+kvanangen.no
+kvænangen.no
+navuotna.no
+návuotna.no
+kafjord.no
+kåfjord.no
+gaivuotna.no
+gáivuotna.no
+larvik.no
+lavangen.no
+lavagis.no
+loabat.no
+loabát.no
+lebesby.no
+davvesiida.no
+leikanger.no
+leirfjord.no
+leka.no
+leksvik.no
+lenvik.no
+leangaviika.no
+leaŋgaviika.no
+lesja.no
+levanger.no
+lier.no
+lierne.no
+lillehammer.no
+lillesand.no
+lindesnes.no
+lindas.no
+lindås.no
+lom.no
+loppa.no
+lahppi.no
+láhppi.no
+lund.no
+lunner.no
+luroy.no
+lurøy.no
+luster.no
+lyngdal.no
+lyngen.no
+ivgu.no
+lardal.no
+lerdal.no
+lærdal.no
+lodingen.no
+lødingen.no
+lorenskog.no
+lørenskog.no
+loten.no
+løten.no
+malvik.no
+masoy.no
+måsøy.no
+muosat.no
+muosát.no
+mandal.no
+marker.no
+marnardal.no
+masfjorden.no
+meland.no
+meldal.no
+melhus.no
+meloy.no
+meløy.no
+meraker.no
+meråker.no
+moareke.no
+moåreke.no
+midsund.no
+midtre-gauldal.no
+modalen.no
+modum.no
+molde.no
+moskenes.no
+moss.no
+mosvik.no
+malselv.no
+målselv.no
+malatvuopmi.no
+málatvuopmi.no
+namdalseid.no
+aejrie.no
+namsos.no
+namsskogan.no
+naamesjevuemie.no
+nååmesjevuemie.no
+laakesvuemie.no
+nannestad.no
+narvik.no
+narviika.no
+naustdal.no
+nedre-eiker.no
+nes.akershus.no
+nes.buskerud.no
+nesna.no
+nesodden.no
+nesseby.no
+unjarga.no
+unjárga.no
+nesset.no
+nissedal.no
+nittedal.no
+nord-aurdal.no
+nord-fron.no
+nord-odal.no
+norddal.no
+nordkapp.no
+davvenjarga.no
+davvenjárga.no
+nordre-land.no
+nordreisa.no
+raisa.no
+ráisa.no
+nore-og-uvdal.no
+notodden.no
+naroy.no
+nærøy.no
+notteroy.no
+nøtterøy.no
+odda.no
+oksnes.no
+øksnes.no
+oppdal.no
+oppegard.no
+oppegård.no
+orkdal.no
+orland.no
+ørland.no
+orskog.no
+ørskog.no
+orsta.no
+ørsta.no
+os.hedmark.no
+os.hordaland.no
+osen.no
+osteroy.no
+osterøy.no
+ostre-toten.no
+østre-toten.no
+overhalla.no
+ovre-eiker.no
+øvre-eiker.no
+oyer.no
+øyer.no
+oygarden.no
+øygarden.no
+oystre-slidre.no
+øystre-slidre.no
+porsanger.no
+porsangu.no
+porsáŋgu.no
+porsgrunn.no
+radoy.no
+radøy.no
+rakkestad.no
+rana.no
+ruovat.no
+randaberg.no
+rauma.no
+rendalen.no
+rennebu.no
+rennesoy.no
+rennesøy.no
+rindal.no
+ringebu.no
+ringerike.no
+ringsaker.no
+rissa.no
+risor.no
+risør.no
+roan.no
+rollag.no
+rygge.no
+ralingen.no
+rælingen.no
+rodoy.no
+rødøy.no
+romskog.no
+rømskog.no
+roros.no
+røros.no
+rost.no
+røst.no
+royken.no
+røyken.no
+royrvik.no
+røyrvik.no
+rade.no
+råde.no
+salangen.no
+siellak.no
+saltdal.no
+salat.no
+sálát.no
+sálat.no
+samnanger.no
+sande.more-og-romsdal.no
+sande.møre-og-romsdal.no
+sande.vestfold.no
+sandefjord.no
+sandnes.no
+sandoy.no
+sandøy.no
+sarpsborg.no
+sauda.no
+sauherad.no
+sel.no
+selbu.no
+selje.no
+seljord.no
+sigdal.no
+siljan.no
+sirdal.no
+skaun.no
+skedsmo.no
+ski.no
+skien.no
+skiptvet.no
+skjervoy.no
+skjervøy.no
+skierva.no
+skiervá.no
+skjak.no
+skjåk.no
+skodje.no
+skanland.no
+skånland.no
+skanit.no
+skánit.no
+smola.no
+smøla.no
+snillfjord.no
+snasa.no
+snåsa.no
+snoasa.no
+snaase.no
+snåase.no
+sogndal.no
+sokndal.no
+sola.no
+solund.no
+songdalen.no
+sortland.no
+spydeberg.no
+stange.no
+stavanger.no
+steigen.no
+steinkjer.no
+stjordal.no
+stjørdal.no
+stokke.no
+stor-elvdal.no
+stord.no
+stordal.no
+storfjord.no
+omasvuotna.no
+strand.no
+stranda.no
+stryn.no
+sula.no
+suldal.no
+sund.no
+sunndal.no
+surnadal.no
+sveio.no
+svelvik.no
+sykkylven.no
+sogne.no
+søgne.no
+somna.no
+sømna.no
+sondre-land.no
+søndre-land.no
+sor-aurdal.no
+sør-aurdal.no
+sor-fron.no
+sør-fron.no
+sor-odal.no
+sør-odal.no
+sor-varanger.no
+sør-varanger.no
+matta-varjjat.no
+mátta-várjjat.no
+sorfold.no
+sørfold.no
+sorreisa.no
+sørreisa.no
+sorum.no
+sørum.no
+tana.no
+deatnu.no
+time.no
+tingvoll.no
+tinn.no
+tjeldsund.no
+dielddanuorri.no
+tjome.no
+tjøme.no
+tokke.no
+tolga.no
+torsken.no
+tranoy.no
+tranøy.no
+tromso.no
+tromsø.no
+tromsa.no
+romsa.no
+trondheim.no
+troandin.no
+trysil.no
+trana.no
+træna.no
+trogstad.no
+trøgstad.no
+tvedestrand.no
+tydal.no
+tynset.no
+tysfjord.no
+divtasvuodna.no
+divttasvuotna.no
+tysnes.no
+tysvar.no
+tysvær.no
+tonsberg.no
+tønsberg.no
+ullensaker.no
+ullensvang.no
+ulvik.no
+utsira.no
+vadso.no
+vadsø.no
+cahcesuolo.no
+čáhcesuolo.no
+vaksdal.no
+valle.no
+vang.no
+vanylven.no
+vardo.no
+vardø.no
+varggat.no
+várggát.no
+vefsn.no
+vaapste.no
+vega.no
+vegarshei.no
+vegårshei.no
+vennesla.no
+verdal.no
+verran.no
+vestby.no
+vestnes.no
+vestre-slidre.no
+vestre-toten.no
+vestvagoy.no
+vestvågøy.no
+vevelstad.no
+vik.no
+vikna.no
+vindafjord.no
+volda.no
+voss.no
+varoy.no
+værøy.no
+vagan.no
+vågan.no
+voagat.no
+vagsoy.no
+vågsøy.no
+vaga.no
+vågå.no
+valer.ostfold.no
+våler.østfold.no
+valer.hedmark.no
+våler.hedmark.no
+
+// the co.no domain is managed by CoDNS B.V. Added 2010-05-23.
+co.no
+
+// np : http://www.mos.com.np/register.html
+*.np
+
+// nr : http://cenpac.net.nr/dns/index.html
+// Confirmed by registry <technician@cenpac.net.nr> 2008-06-17
+nr
+biz.nr
+info.nr
+gov.nr
+edu.nr
+org.nr
+net.nr
+com.nr
+
+// nu : http://en.wikipedia.org/wiki/.nu
+nu
+
+// nz : http://en.wikipedia.org/wiki/.nz
+*.nz
+
+// om : http://en.wikipedia.org/wiki/.om
+*.om
+!mediaphone.om
+!nawrastelecom.om
+!nawras.om
+!omanmobile.om
+!omanpost.om
+!omantel.om
+!rakpetroleum.om
+!siemens.om
+!songfest.om
+!statecouncil.om
+
+// org : http://en.wikipedia.org/wiki/.org
+org
+
+// CentralNic names : http://www.centralnic.com/names/domains
+// Submitted by registry <gavin.brown@centralnic.com> 2008-06-17
+ae.org
+
+// ZaNiC names : http://www.za.net/
+// Confirmed by registry <hostmaster@nic.za.net> 2009-10-03
+za.org
+
+// pa : http://www.nic.pa/
+// Some additional second level "domains" resolve directly as hostnames, such as
+// pannet.pa, so we add a rule for "pa".
+pa
+ac.pa
+gob.pa
+com.pa
+org.pa
+sld.pa
+edu.pa
+net.pa
+ing.pa
+abo.pa
+med.pa
+nom.pa
+
+// pe : https://www.nic.pe/InformeFinalComision.pdf
+pe
+edu.pe
+gob.pe
+nom.pe
+mil.pe
+org.pe
+com.pe
+net.pe
+
+// pf : http://www.gobin.info/domainname/formulaire-pf.pdf
+pf
+com.pf
+org.pf
+edu.pf
+
+// pg : http://en.wikipedia.org/wiki/.pg
+*.pg
+
+// ph : http://www.domains.ph/FAQ2.asp
+// Submitted by registry <jed@email.com.ph> 2008-06-13
+ph
+com.ph
+net.ph
+org.ph
+gov.ph
+edu.ph
+ngo.ph
+mil.ph
+i.ph
+
+// pk : http://pk5.pknic.net.pk/pk5/msgNamepk.PK
+pk
+com.pk
+net.pk
+edu.pk
+org.pk
+fam.pk
+biz.pk
+web.pk
+gov.pk
+gob.pk
+gok.pk
+gon.pk
+gop.pk
+gos.pk
+info.pk
+
+// pl : http://www.dns.pl/english/
+pl
+// NASK functional domains (nask.pl / dns.pl) : http://www.dns.pl/english/dns-funk.html
+aid.pl
+agro.pl
+atm.pl
+auto.pl
+biz.pl
+com.pl
+edu.pl
+gmina.pl
+gsm.pl
+info.pl
+mail.pl
+miasta.pl
+media.pl
+mil.pl
+net.pl
+nieruchomosci.pl
+nom.pl
+org.pl
+pc.pl
+powiat.pl
+priv.pl
+realestate.pl
+rel.pl
+sex.pl
+shop.pl
+sklep.pl
+sos.pl
+szkola.pl
+targi.pl
+tm.pl
+tourism.pl
+travel.pl
+turystyka.pl
+// ICM functional domains (icm.edu.pl)
+6bone.pl
+art.pl
+mbone.pl
+// Government domains (administered by ippt.gov.pl)
+gov.pl
+uw.gov.pl
+um.gov.pl
+ug.gov.pl
+upow.gov.pl
+starostwo.gov.pl
+so.gov.pl
+sr.gov.pl
+po.gov.pl
+pa.gov.pl
+// other functional domains
+ngo.pl
+irc.pl
+usenet.pl
+// NASK geographical domains : http://www.dns.pl/english/dns-regiony.html
+augustow.pl
+babia-gora.pl
+bedzin.pl
+beskidy.pl
+bialowieza.pl
+bialystok.pl
+bielawa.pl
+bieszczady.pl
+boleslawiec.pl
+bydgoszcz.pl
+bytom.pl
+cieszyn.pl
+czeladz.pl
+czest.pl
+dlugoleka.pl
+elblag.pl
+elk.pl
+glogow.pl
+gniezno.pl
+gorlice.pl
+grajewo.pl
+ilawa.pl
+jaworzno.pl
+jelenia-gora.pl
+jgora.pl
+kalisz.pl
+kazimierz-dolny.pl
+karpacz.pl
+kartuzy.pl
+kaszuby.pl
+katowice.pl
+kepno.pl
+ketrzyn.pl
+klodzko.pl
+kobierzyce.pl
+kolobrzeg.pl
+konin.pl
+konskowola.pl
+kutno.pl
+lapy.pl
+lebork.pl
+legnica.pl
+lezajsk.pl
+limanowa.pl
+lomza.pl
+lowicz.pl
+lubin.pl
+lukow.pl
+malbork.pl
+malopolska.pl
+mazowsze.pl
+mazury.pl
+mielec.pl
+mielno.pl
+mragowo.pl
+naklo.pl
+nowaruda.pl
+nysa.pl
+olawa.pl
+olecko.pl
+olkusz.pl
+olsztyn.pl
+opoczno.pl
+opole.pl
+ostroda.pl
+ostroleka.pl
+ostrowiec.pl
+ostrowwlkp.pl
+pila.pl
+pisz.pl
+podhale.pl
+podlasie.pl
+polkowice.pl
+pomorze.pl
+pomorskie.pl
+prochowice.pl
+pruszkow.pl
+przeworsk.pl
+pulawy.pl
+radom.pl
+rawa-maz.pl
+rybnik.pl
+rzeszow.pl
+sanok.pl
+sejny.pl
+siedlce.pl
+slask.pl
+slupsk.pl
+sosnowiec.pl
+stalowa-wola.pl
+skoczow.pl
+starachowice.pl
+stargard.pl
+suwalki.pl
+swidnica.pl
+swiebodzin.pl
+swinoujscie.pl
+szczecin.pl
+szczytno.pl
+tarnobrzeg.pl
+tgory.pl
+turek.pl
+tychy.pl
+ustka.pl
+walbrzych.pl
+warmia.pl
+warszawa.pl
+waw.pl
+wegrow.pl
+wielun.pl
+wlocl.pl
+wloclawek.pl
+wodzislaw.pl
+wolomin.pl
+wroclaw.pl
+zachpomor.pl
+zagan.pl
+zarow.pl
+zgora.pl
+zgorzelec.pl
+// TASK geographical domains (www.task.gda.pl/uslugi/dns)
+gda.pl
+gdansk.pl
+gdynia.pl
+med.pl
+sopot.pl
+// other geographical domains
+gliwice.pl
+krakow.pl
+poznan.pl
+wroc.pl
+zakopane.pl
+
+// co.pl : Mainseek Sp. z o.o. http://www.co.pl
+co.pl
+
+// pn : http://www.government.pn/PnRegistry/policies.htm
+pn
+gov.pn
+co.pn
+org.pn
+edu.pn
+net.pn
+
+// pr : http://www.nic.pr/index.asp?f=1
+pr
+com.pr
+net.pr
+org.pr
+gov.pr
+edu.pr
+isla.pr
+pro.pr
+biz.pr
+info.pr
+name.pr
+// these aren't mentioned on nic.pr, but on http://en.wikipedia.org/wiki/.pr
+est.pr
+prof.pr
+ac.pr
+
+// pro : http://www.nic.pro/support_faq.htm
+pro
+aca.pro
+bar.pro
+cpa.pro
+jur.pro
+law.pro
+med.pro
+eng.pro
+
+// ps : http://en.wikipedia.org/wiki/.ps
+// http://www.nic.ps/registration/policy.html#reg
+ps
+edu.ps
+gov.ps
+sec.ps
+plo.ps
+com.ps
+org.ps
+net.ps
+
+// pt : http://online.dns.pt/dns/start_dns
+pt
+net.pt
+gov.pt
+org.pt
+edu.pt
+int.pt
+publ.pt
+com.pt
+nome.pt
+
+// pw : http://en.wikipedia.org/wiki/.pw
+pw
+co.pw
+ne.pw
+or.pw
+ed.pw
+go.pw
+belau.pw
+
+// py : http://www.nic.py/faq_a.html#faq_b
+*.py
+
+// qa : http://www.qatar.net.qa/services/virtual.htm
+*.qa
+
+// re : http://www.afnic.re/obtenir/chartes/nommage-re/annexe-descriptifs
+re
+com.re
+asso.re
+nom.re
+
+// ro : http://www.rotld.ro/
+ro
+com.ro
+org.ro
+tm.ro
+nt.ro
+nom.ro
+info.ro
+rec.ro
+arts.ro
+firm.ro
+store.ro
+www.ro
+
+// rs : http://en.wikipedia.org/wiki/.rs
+rs
+co.rs
+org.rs
+edu.rs
+ac.rs
+gov.rs
+in.rs
+
+// ru : http://www.cctld.ru/ru/docs/aktiv_8.php
+// Industry domains
+ru
+ac.ru
+com.ru
+edu.ru
+int.ru
+net.ru
+org.ru
+pp.ru
+// Geographical domains
+adygeya.ru
+altai.ru
+amur.ru
+arkhangelsk.ru
+astrakhan.ru
+bashkiria.ru
+belgorod.ru
+bir.ru
+bryansk.ru
+buryatia.ru
+cbg.ru
+chel.ru
+chelyabinsk.ru
+chita.ru
+chukotka.ru
+chuvashia.ru
+dagestan.ru
+dudinka.ru
+e-burg.ru
+grozny.ru
+irkutsk.ru
+ivanovo.ru
+izhevsk.ru
+jar.ru
+joshkar-ola.ru
+kalmykia.ru
+kaluga.ru
+kamchatka.ru
+karelia.ru
+kazan.ru
+kchr.ru
+kemerovo.ru
+khabarovsk.ru
+khakassia.ru
+khv.ru
+kirov.ru
+koenig.ru
+komi.ru
+kostroma.ru
+krasnoyarsk.ru
+kuban.ru
+kurgan.ru
+kursk.ru
+lipetsk.ru
+magadan.ru
+mari.ru
+mari-el.ru
+marine.ru
+mordovia.ru
+mosreg.ru
+msk.ru
+murmansk.ru
+nalchik.ru
+nnov.ru
+nov.ru
+novosibirsk.ru
+nsk.ru
+omsk.ru
+orenburg.ru
+oryol.ru
+palana.ru
+penza.ru
+perm.ru
+pskov.ru
+ptz.ru
+rnd.ru
+ryazan.ru
+sakhalin.ru
+samara.ru
+saratov.ru
+simbirsk.ru
+smolensk.ru
+spb.ru
+stavropol.ru
+stv.ru
+surgut.ru
+tambov.ru
+tatarstan.ru
+tom.ru
+tomsk.ru
+tsaritsyn.ru
+tsk.ru
+tula.ru
+tuva.ru
+tver.ru
+tyumen.ru
+udm.ru
+udmurtia.ru
+ulan-ude.ru
+vladikavkaz.ru
+vladimir.ru
+vladivostok.ru
+volgograd.ru
+vologda.ru
+voronezh.ru
+vrn.ru
+vyatka.ru
+yakutia.ru
+yamal.ru
+yaroslavl.ru
+yekaterinburg.ru
+yuzhno-sakhalinsk.ru
+// More geographical domains
+amursk.ru
+baikal.ru
+cmw.ru
+fareast.ru
+jamal.ru
+kms.ru
+k-uralsk.ru
+kustanai.ru
+kuzbass.ru
+magnitka.ru
+mytis.ru
+nakhodka.ru
+nkz.ru
+norilsk.ru
+oskol.ru
+pyatigorsk.ru
+rubtsovsk.ru
+snz.ru
+syzran.ru
+vdonsk.ru
+zgrad.ru
+// State domains
+gov.ru
+mil.ru
+// Technical domains
+test.ru
+
+// rw : http://www.nic.rw/cgi-bin/policy.pl
+rw
+gov.rw
+net.rw
+edu.rw
+ac.rw
+com.rw
+co.rw
+int.rw
+mil.rw
+gouv.rw
+
+// sa : http://www.nic.net.sa/
+sa
+com.sa
+net.sa
+org.sa
+gov.sa
+med.sa
+pub.sa
+edu.sa
+sch.sa
+
+// sb : http://www.sbnic.net.sb/
+// Submitted by registry <lee.humphries@telekom.com.sb> 2008-06-08
+sb
+com.sb
+edu.sb
+gov.sb
+net.sb
+org.sb
+
+// sc : http://www.nic.sc/
+sc
+com.sc
+gov.sc
+net.sc
+org.sc
+edu.sc
+
+// sd : http://www.isoc.sd/sudanic.isoc.sd/billing_pricing.htm
+// Submitted by registry <admin@isoc.sd> 2008-06-17
+sd
+com.sd
+net.sd
+org.sd
+edu.sd
+med.sd
+gov.sd
+info.sd
+
+// se : http://en.wikipedia.org/wiki/.se
+// Submitted by registry <Patrik.Wallstrom@iis.se> 2008-06-24
+se
+a.se
+ac.se
+b.se
+bd.se
+brand.se
+c.se
+d.se
+e.se
+f.se
+fh.se
+fhsk.se
+fhv.se
+g.se
+h.se
+i.se
+k.se
+komforb.se
+kommunalforbund.se
+komvux.se
+l.se
+lanbib.se
+m.se
+n.se
+naturbruksgymn.se
+o.se
+org.se
+p.se
+parti.se
+pp.se
+press.se
+r.se
+s.se
+sshn.se
+t.se
+tm.se
+u.se
+w.se
+x.se
+y.se
+z.se
+
+// sg : http://www.nic.net.sg/sub_policies_agreement/2ld.html
+sg
+com.sg
+net.sg
+org.sg
+gov.sg
+edu.sg
+per.sg
+
+// sh : http://www.nic.sh/rules.html
+// list of 2nd level domains ?
+sh
+
+// si : http://en.wikipedia.org/wiki/.si
+si
+
+// sj : No registrations at this time.
+// Submitted by registry <jarle@uninett.no> 2008-06-16
+
+// sk : http://en.wikipedia.org/wiki/.sk
+// list of 2nd level domains ?
+sk
+
+// sl : http://www.nic.sl
+// Submitted by registry <adam@neoip.com> 2008-06-12
+sl
+com.sl
+net.sl
+edu.sl
+gov.sl
+org.sl
+
+// sm : http://en.wikipedia.org/wiki/.sm
+sm
+
+// sn : http://en.wikipedia.org/wiki/.sn
+sn
+art.sn
+com.sn
+edu.sn
+gouv.sn
+org.sn
+perso.sn
+univ.sn
+
+// so : http://www.soregistry.com/
+so
+com.so
+net.so
+org.so
+
+// sr : http://en.wikipedia.org/wiki/.sr
+sr
+
+// st : http://www.nic.st/html/policyrules/
+st
+co.st
+com.st
+consulado.st
+edu.st
+embaixada.st
+gov.st
+mil.st
+net.st
+org.st
+principe.st
+saotome.st
+store.st
+
+// su : http://en.wikipedia.org/wiki/.su
+su
+
+// sv : http://www.svnet.org.sv/svpolicy.html
+*.sv
+
+// sy : http://en.wikipedia.org/wiki/.sy
+// see also: http://www.gobin.info/domainname/sy.doc
+sy
+edu.sy
+gov.sy
+net.sy
+mil.sy
+com.sy
+org.sy
+
+// sz : http://en.wikipedia.org/wiki/.sz
+// http://www.sispa.org.sz/
+sz
+co.sz
+ac.sz
+org.sz
+
+// tc : http://en.wikipedia.org/wiki/.tc
+tc
+
+// td : http://en.wikipedia.org/wiki/.td
+td
+
+// tel: http://en.wikipedia.org/wiki/.tel
+// http://www.telnic.org/
+tel
+
+// tf : http://en.wikipedia.org/wiki/.tf
+tf
+
+// tg : http://en.wikipedia.org/wiki/.tg
+// http://www.nic.tg/nictg/index.php implies no reserved 2nd-level domains,
+// although this contradicts wikipedia.
+tg
+
+// th : http://en.wikipedia.org/wiki/.th
+// Submitted by registry <krit@thains.co.th> 2008-06-17
+th
+ac.th
+co.th
+go.th
+in.th
+mi.th
+net.th
+or.th
+
+// tj : http://www.nic.tj/policy.htm
+tj
+ac.tj
+biz.tj
+co.tj
+com.tj
+edu.tj
+go.tj
+gov.tj
+int.tj
+mil.tj
+name.tj
+net.tj
+nic.tj
+org.tj
+test.tj
+web.tj
+
+// tk : http://en.wikipedia.org/wiki/.tk
+tk
+
+// tl : http://en.wikipedia.org/wiki/.tl
+tl
+gov.tl
+
+// tm : http://www.nic.tm/rules.html
+// list of 2nd level tlds ?
+tm
+
+// tn : http://en.wikipedia.org/wiki/.tn
+// http://whois.ati.tn/
+tn
+com.tn
+ens.tn
+fin.tn
+gov.tn
+ind.tn
+intl.tn
+nat.tn
+net.tn
+org.tn
+info.tn
+perso.tn
+tourism.tn
+edunet.tn
+rnrt.tn
+rns.tn
+rnu.tn
+mincom.tn
+agrinet.tn
+defense.tn
+turen.tn
+
+// to : http://en.wikipedia.org/wiki/.to
+// Submitted by registry <egullich@colo.to> 2008-06-17
+to
+com.to
+gov.to
+net.to
+org.to
+edu.to
+mil.to
+
+// tr : http://en.wikipedia.org/wiki/.tr
+*.tr
+!nic.tr
+// Used by government in the TRNC
+// http://en.wikipedia.org/wiki/.nc.tr
+gov.nc.tr
+
+// travel : http://en.wikipedia.org/wiki/.travel
+travel
+
+// tt : http://www.nic.tt/
+tt
+co.tt
+com.tt
+org.tt
+net.tt
+biz.tt
+info.tt
+pro.tt
+int.tt
+coop.tt
+jobs.tt
+mobi.tt
+travel.tt
+museum.tt
+aero.tt
+name.tt
+gov.tt
+edu.tt
+
+// tv : http://en.wikipedia.org/wiki/.tv
+// Not listing any 2LDs as reserved since none seem to exist in practice,
+// Wikipedia notwithstanding.
+tv
+
+// tw : http://en.wikipedia.org/wiki/.tw
+tw
+edu.tw
+gov.tw
+mil.tw
+com.tw
+net.tw
+org.tw
+idv.tw
+game.tw
+ebiz.tw
+club.tw
+網路.tw
+組織.tw
+商業.tw
+
+// tz : http://en.wikipedia.org/wiki/.tz
+// Submitted by registry <randy@psg.com> 2008-06-17
+// Updated from http://www.tznic.or.tz/index.php/domains.html 2010-10-25
+ac.tz
+co.tz
+go.tz
+mil.tz
+ne.tz
+or.tz
+sc.tz
+
+// ua : http://www.nic.net.ua/
+ua
+com.ua
+edu.ua
+gov.ua
+in.ua
+net.ua
+org.ua
+// ua geo-names
+cherkassy.ua
+chernigov.ua
+chernovtsy.ua
+ck.ua
+cn.ua
+crimea.ua
+cv.ua
+dn.ua
+dnepropetrovsk.ua
+donetsk.ua
+dp.ua
+if.ua
+ivano-frankivsk.ua
+kh.ua
+kharkov.ua
+kherson.ua
+khmelnitskiy.ua
+kiev.ua
+kirovograd.ua
+km.ua
+kr.ua
+ks.ua
+kv.ua
+lg.ua
+lugansk.ua
+lutsk.ua
+lviv.ua
+mk.ua
+nikolaev.ua
+od.ua
+odessa.ua
+pl.ua
+poltava.ua
+rovno.ua
+rv.ua
+sebastopol.ua
+sumy.ua
+te.ua
+ternopil.ua
+uzhgorod.ua
+vinnica.ua
+vn.ua
+zaporizhzhe.ua
+zp.ua
+zhitomir.ua
+zt.ua
+
+// ug : http://www.registry.co.ug/
+ug
+co.ug
+ac.ug
+sc.ug
+go.ug
+ne.ug
+or.ug
+
+// uk : http://en.wikipedia.org/wiki/.uk
+*.uk
+*.sch.uk
+!bl.uk
+!british-library.uk
+!icnet.uk
+!jet.uk
+!mod.uk
+!nel.uk
+!nhs.uk
+!nic.uk
+!nls.uk
+!national-library-scotland.uk
+!parliament.uk
+!police.uk
+
+// us : http://en.wikipedia.org/wiki/.us
+us
+dni.us
+fed.us
+isa.us
+kids.us
+nsn.us
+// us geographic names
+ak.us
+al.us
+ar.us
+as.us
+az.us
+ca.us
+co.us
+ct.us
+dc.us
+de.us
+fl.us
+ga.us
+gu.us
+hi.us
+ia.us
+id.us
+il.us
+in.us
+ks.us
+ky.us
+la.us
+ma.us
+md.us
+me.us
+mi.us
+mn.us
+mo.us
+ms.us
+mt.us
+nc.us
+nd.us
+ne.us
+nh.us
+nj.us
+nm.us
+nv.us
+ny.us
+oh.us
+ok.us
+or.us
+pa.us
+pr.us
+ri.us
+sc.us
+sd.us
+tn.us
+tx.us
+ut.us
+vi.us
+vt.us
+va.us
+wa.us
+wi.us
+wv.us
+wy.us
+// The registrar notes several more specific domains available in each state,
+// such as state.*.us, dst.*.us, etc., but resolution of these is somewhat
+// haphazard; in some states these domains resolve as addresses, while in others
+// only subdomains are available, or even nothing at all. We include the
+// most common ones where it's clear that different sites are different
+// entities.
+k12.ak.us
+k12.al.us
+k12.ar.us
+k12.as.us
+k12.az.us
+k12.ca.us
+k12.co.us
+k12.ct.us
+k12.dc.us
+k12.de.us
+k12.fl.us
+k12.ga.us
+k12.gu.us
+// k12.hi.us Hawaii has a state-wide DOE login: bug 614565
+k12.ia.us
+k12.id.us
+k12.il.us
+k12.in.us
+k12.ks.us
+k12.ky.us
+k12.la.us
+k12.ma.us
+k12.md.us
+k12.me.us
+k12.mi.us
+k12.mn.us
+k12.mo.us
+k12.ms.us
+k12.mt.us
+k12.nc.us
+k12.nd.us
+k12.ne.us
+k12.nh.us
+k12.nj.us
+k12.nm.us
+k12.nv.us
+k12.ny.us
+k12.oh.us
+k12.ok.us
+k12.or.us
+k12.pa.us
+k12.pr.us
+k12.ri.us
+k12.sc.us
+k12.sd.us
+k12.tn.us
+k12.tx.us
+k12.ut.us
+k12.vi.us
+k12.vt.us
+k12.va.us
+k12.wa.us
+k12.wi.us
+k12.wv.us
+k12.wy.us
+
+cc.ak.us
+cc.al.us
+cc.ar.us
+cc.as.us
+cc.az.us
+cc.ca.us
+cc.co.us
+cc.ct.us
+cc.dc.us
+cc.de.us
+cc.fl.us
+cc.ga.us
+cc.gu.us
+cc.hi.us
+cc.ia.us
+cc.id.us
+cc.il.us
+cc.in.us
+cc.ks.us
+cc.ky.us
+cc.la.us
+cc.ma.us
+cc.md.us
+cc.me.us
+cc.mi.us
+cc.mn.us
+cc.mo.us
+cc.ms.us
+cc.mt.us
+cc.nc.us
+cc.nd.us
+cc.ne.us
+cc.nh.us
+cc.nj.us
+cc.nm.us
+cc.nv.us
+cc.ny.us
+cc.oh.us
+cc.ok.us
+cc.or.us
+cc.pa.us
+cc.pr.us
+cc.ri.us
+cc.sc.us
+cc.sd.us
+cc.tn.us
+cc.tx.us
+cc.ut.us
+cc.vi.us
+cc.vt.us
+cc.va.us
+cc.wa.us
+cc.wi.us
+cc.wv.us
+cc.wy.us
+
+lib.ak.us
+lib.al.us
+lib.ar.us
+lib.as.us
+lib.az.us
+lib.ca.us
+lib.co.us
+lib.ct.us
+lib.dc.us
+lib.de.us
+lib.fl.us
+lib.ga.us
+lib.gu.us
+lib.hi.us
+lib.ia.us
+lib.id.us
+lib.il.us
+lib.in.us
+lib.ks.us
+lib.ky.us
+lib.la.us
+lib.ma.us
+lib.md.us
+lib.me.us
+lib.mi.us
+lib.mn.us
+lib.mo.us
+lib.ms.us
+lib.mt.us
+lib.nc.us
+lib.nd.us
+lib.ne.us
+lib.nh.us
+lib.nj.us
+lib.nm.us
+lib.nv.us
+lib.ny.us
+lib.oh.us
+lib.ok.us
+lib.or.us
+lib.pa.us
+lib.pr.us
+lib.ri.us
+lib.sc.us
+lib.sd.us
+lib.tn.us
+lib.tx.us
+lib.ut.us
+lib.vi.us
+lib.vt.us
+lib.va.us
+lib.wa.us
+lib.wi.us
+lib.wv.us
+lib.wy.us
+
+// k12.ma.us contains school districts in Massachusetts. The 4LDs are
+// managed indepedently except for private (PVT), charter (CHTR) and
+// parochial (PAROCH) schools. Those are delegated dorectly to the
+// 5LD operators. <k12-ma-hostmaster _ at _ rsuc.gweep.net>
+pvt.k12.ma.us
+chtr.k12.ma.us
+paroch.k12.ma.us
+
+// uy : http://www.antel.com.uy/
+*.uy
+
+// uz : http://www.reg.uz/registerr.html
+// are there other 2nd level tlds ?
+uz
+com.uz
+co.uz
+
+// va : http://en.wikipedia.org/wiki/.va
+va
+
+// vc : http://en.wikipedia.org/wiki/.vc
+// Submitted by registry <kshah@ca.afilias.info> 2008-06-13
+vc
+com.vc
+net.vc
+org.vc
+gov.vc
+mil.vc
+edu.vc
+
+// ve : http://registro.nic.ve/nicve/registro/index.html
+*.ve
+
+// vg : http://en.wikipedia.org/wiki/.vg
+vg
+
+// vi : http://www.nic.vi/newdomainform.htm
+// http://www.nic.vi/Domain_Rules/body_domain_rules.html indicates some other
+// TLDs are "reserved", such as edu.vi and gov.vi, but doesn't actually say they
+// are available for registration (which they do not seem to be).
+vi
+co.vi
+com.vi
+k12.vi
+net.vi
+org.vi
+
+// vn : https://www.dot.vn/vnnic/vnnic/domainregistration.jsp
+vn
+com.vn
+net.vn
+org.vn
+edu.vn
+gov.vn
+int.vn
+ac.vn
+biz.vn
+info.vn
+name.vn
+pro.vn
+health.vn
+
+// vu : http://en.wikipedia.org/wiki/.vu
+// list of 2nd level tlds ?
+vu
+
+// ws : http://en.wikipedia.org/wiki/.ws
+// http://samoanic.ws/index.dhtml
+ws
+com.ws
+net.ws
+org.ws
+gov.ws
+edu.ws
+
+// IDN ccTLDs
+// Please sort by ISO 3166 ccTLD, then punicode string
+// when submitting patches and follow this format:
+// <Punicode> ("<english word>" <language>) : <ISO 3166 ccTLD>
+// [optional sponsoring org]
+// <URL>
+
+// xn--mgbaam7a8h ("Emerat" Arabic) : AE
+//http://nic.ae/english/arabicdomain/rules.jsp
+امارات
+
+// xn--54b7fta0cc ("Bangla" Bangla) : BD
+বাংলা
+
+// xn--fiqs8s ("China" Chinese-Han-Simplified <.Zhonggou>) : CN
+// CNNIC
+// http://cnnic.cn/html/Dir/2005/10/11/3218.htm
+中国
+
+// xn--fiqz9s ("China" Chinese-Han-Traditional <.Zhonggou>) : CN
+// CNNIC
+// http://cnnic.cn/html/Dir/2005/10/11/3218.htm
+中國
+
+// xn--lgbbat1ad8j ("Algeria / Al Jazair" Arabic) : DZ
+الجزائر
+
+// xn--wgbh1c ("Egypt" Arabic .masr) : EG
+// http://www.dotmasr.eg/
+مصر
+
+// xn--node ("ge" Georgian (Mkhedruli)) : GE
+გე
+
+// xn--j6w193g ("Hong Kong" Chinese-Han) : HK
+// https://www2.hkirc.hk/register/rules.jsp
+香港
+
+// xn--h2brj9c ("Bharat" Devanagari) : IN
+// India
+भारत
+
+// xn--mgbbh1a71e ("Bharat" Arabic) : IN
+// India
+بھارت
+
+// xn--fpcrj9c3d ("Bharat" Telugu) : IN
+// India
+భారత్
+
+// xn--gecrj9c ("Bharat" Gujarati) : IN
+// India
+ભારત
+
+// xn--s9brj9c ("Bharat" Gurmukhi) : IN
+// India
+ਭਾਰਤ
+
+// xn--45brj9c ("Bharat" Bengali) : IN
+// India
+ভারত
+
+// xn--xkc2dl3a5ee0h ("India" Tamil) : IN
+// India
+இந்தியா
+
+// xn--mgba3a4f16a ("Iran" Persian) : IR
+ایران
+
+// xn--mgba3a4fra ("Iran" Arabic) : IR
+ايران
+
+//xn--mgbayh7gpa ("al-Ordon" Arabic) JO
+//National Information Technology Center (NITC)
+//Royal Scientific Society, Al-Jubeiha
+الاردن
+
+// xn--3e0b707e ("Republic of Korea" Hangul) : KR
+한국
+
+// xn--fzc2c9e2c ("Lanka" Sinhalese-Sinhala) : LK
+// http://nic.lk
+ලංකා
+
+// xn--xkc2al3hye2a ("Ilangai" Tamil) : LK
+// http://nic.lk
+இலங்கை
+
+// xn--mgbc0a9azcg ("Morocco / al-Maghrib" Arabic) : MA
+المغرب
+
+// xn--mgb9awbf ("Oman" Arabic) : OM
+عمان
+
+// xn--ygbi2ammx ("Falasteen" Arabic) : PS
+// The Palestinian National Internet Naming Authority (PNINA)
+// http://www.pnina.ps
+فلسطين
+
+// xn--90a3ac ("srb" Cyrillic) : RS
+срб
+
+// xn--p1ai ("rf" Russian-Cyrillic) : RU
+// http://www.cctld.ru/en/docs/rulesrf.php
+рф
+
+// xn--wgbl6a ("Qatar" Arabic) : QA
+// http://www.ict.gov.qa/
+قطر
+
+// xn--mgberp4a5d4ar ("AlSaudiah" Arabic) : SA
+// http://www.nic.net.sa/
+السعودية
+
+// xn--mgberp4a5d4a87g ("AlSaudiah" Arabic) variant : SA
+السعودیة
+
+// xn--mgbqly7c0a67fbc ("AlSaudiah" Arabic) variant : SA
+السعودیۃ
+
+// xn--mgbqly7cvafr ("AlSaudiah" Arabic) variant : SA
+السعوديه
+
+// xn--ogbpf8fl ("Syria" Arabic) : SY
+سورية
+
+// xn--mgbtf8fl ("Syria" Arabic) variant : SY
+سوريا
+
+// xn--yfro4i67o Singapore ("Singapore" Chinese-Han) : SG
+新加坡
+
+// xn--clchc0ea0b2g2a9gcd ("Singapore" Tamil) : SG
+சிங்கப்பூர்
+
+// xn--o3cw4h ("Thai" Thai) : TH
+// http://www.thnic.co.th
+ไทย
+
+// xn--pgbs0dh ("Tunis") : TN
+// http://nic.tn
+تونس
+
+// xn--kpry57d ("Taiwan" Chinese-Han-Traditional) : TW
+// http://www.twnic.net/english/dn/dn_07a.htm
+台灣
+
+// xn--kprw13d ("Taiwan" Chinese-Han-Simplified) : TW
+// http://www.twnic.net/english/dn/dn_07a.htm
+台湾
+
+// xn--nnx388a ("Taiwan") variant : TW
+臺灣
+
+// xn--j1amh ("ukr" Cyrillic) : UA
+укр
+
+// xn--mgb2ddes ("AlYemen" Arabic) : YE
+اليمن
+
+// xxx : http://icmregistry.com
+xxx
+
+// ye : http://www.y.net.ye/services/domain_name.htm
+*.ye
+
+// yu : http://www.nic.yu/pravilnik-e.html
+*.yu
+
+// za : http://www.zadna.org.za/slds.html
+*.za
+
+// zm : http://en.wikipedia.org/wiki/.zm
+*.zm
+
+// zw : http://en.wikipedia.org/wiki/.zw
+*.zw
+
+// DynDNS.com Dynamic DNS zones : http://www.dyndns.com/services/dns/dyndns/
+dyndns-at-home.com
+dyndns-at-work.com
+dyndns-blog.com
+dyndns-free.com
+dyndns-home.com
+dyndns-ip.com
+dyndns-mail.com
+dyndns-office.com
+dyndns-pics.com
+dyndns-remote.com
+dyndns-server.com
+dyndns-web.com
+dyndns-wiki.com
+dyndns-work.com
+dyndns.biz
+dyndns.info
+dyndns.org
+dyndns.tv
+at-band-camp.net
+ath.cx
+barrel-of-knowledge.info
+barrell-of-knowledge.info
+better-than.tv
+blogdns.com
+blogdns.net
+blogdns.org
+blogsite.org
+boldlygoingnowhere.org
+broke-it.net
+buyshouses.net
+cechire.com
+dnsalias.com
+dnsalias.net
+dnsalias.org
+dnsdojo.com
+dnsdojo.net
+dnsdojo.org
+does-it.net
+doesntexist.com
+doesntexist.org
+dontexist.com
+dontexist.net
+dontexist.org
+doomdns.com
+doomdns.org
+dvrdns.org
+dyn-o-saur.com
+dynalias.com
+dynalias.net
+dynalias.org
+dynathome.net
+dyndns.ws
+endofinternet.net
+endofinternet.org
+endoftheinternet.org
+est-a-la-maison.com
+est-a-la-masion.com
+est-le-patron.com
+est-mon-blogueur.com
+for-better.biz
+for-more.biz
+for-our.info
+for-some.biz
+for-the.biz
+forgot.her.name
+forgot.his.name
+from-ak.com
+from-al.com
+from-ar.com
+from-az.net
+from-ca.com
+from-co.net
+from-ct.com
+from-dc.com
+from-de.com
+from-fl.com
+from-ga.com
+from-hi.com
+from-ia.com
+from-id.com
+from-il.com
+from-in.com
+from-ks.com
+from-ky.com
+from-la.net
+from-ma.com
+from-md.com
+from-me.org
+from-mi.com
+from-mn.com
+from-mo.com
+from-ms.com
+from-mt.com
+from-nc.com
+from-nd.com
+from-ne.com
+from-nh.com
+from-nj.com
+from-nm.com
+from-nv.com
+from-ny.net
+from-oh.com
+from-ok.com
+from-or.com
+from-pa.com
+from-pr.com
+from-ri.com
+from-sc.com
+from-sd.com
+from-tn.com
+from-tx.com
+from-ut.com
+from-va.com
+from-vt.com
+from-wa.com
+from-wi.com
+from-wv.com
+from-wy.com
+ftpaccess.cc
+fuettertdasnetz.de
+game-host.org
+game-server.cc
+getmyip.com
+gets-it.net
+go.dyndns.org
+gotdns.com
+gotdns.org
+groks-the.info
+groks-this.info
+ham-radio-op.net
+here-for-more.info
+hobby-site.com
+hobby-site.org
+home.dyndns.org
+homedns.org
+homeftp.net
+homeftp.org
+homeip.net
+homelinux.com
+homelinux.net
+homelinux.org
+homeunix.com
+homeunix.net
+homeunix.org
+iamallama.com
+in-the-band.net
+is-a-anarchist.com
+is-a-blogger.com
+is-a-bookkeeper.com
+is-a-bruinsfan.org
+is-a-bulls-fan.com
+is-a-candidate.org
+is-a-caterer.com
+is-a-celticsfan.org
+is-a-chef.com
+is-a-chef.net
+is-a-chef.org
+is-a-conservative.com
+is-a-cpa.com
+is-a-cubicle-slave.com
+is-a-democrat.com
+is-a-designer.com
+is-a-doctor.com
+is-a-financialadvisor.com
+is-a-geek.com
+is-a-geek.net
+is-a-geek.org
+is-a-green.com
+is-a-guru.com
+is-a-hard-worker.com
+is-a-hunter.com
+is-a-knight.org
+is-a-landscaper.com
+is-a-lawyer.com
+is-a-liberal.com
+is-a-libertarian.com
+is-a-linux-user.org
+is-a-llama.com
+is-a-musician.com
+is-a-nascarfan.com
+is-a-nurse.com
+is-a-painter.com
+is-a-patsfan.org
+is-a-personaltrainer.com
+is-a-photographer.com
+is-a-player.com
+is-a-republican.com
+is-a-rockstar.com
+is-a-socialist.com
+is-a-soxfan.org
+is-a-student.com
+is-a-teacher.com
+is-a-techie.com
+is-a-therapist.com
+is-an-accountant.com
+is-an-actor.com
+is-an-actress.com
+is-an-anarchist.com
+is-an-artist.com
+is-an-engineer.com
+is-an-entertainer.com
+is-by.us
+is-certified.com
+is-found.org
+is-gone.com
+is-into-anime.com
+is-into-cars.com
+is-into-cartoons.com
+is-into-games.com
+is-leet.com
+is-lost.org
+is-not-certified.com
+is-saved.org
+is-slick.com
+is-uberleet.com
+is-very-bad.org
+is-very-evil.org
+is-very-good.org
+is-very-nice.org
+is-very-sweet.org
+is-with-theband.com
+isa-geek.com
+isa-geek.net
+isa-geek.org
+isa-hockeynut.com
+issmarterthanyou.com
+isteingeek.de
+istmein.de
+kicks-ass.net
+kicks-ass.org
+knowsitall.info
+land-4-sale.us
+lebtimnetz.de
+leitungsen.de
+likes-pie.com
+likescandy.com
+merseine.nu
+mine.nu
+misconfused.org
+mypets.ws
+myphotos.cc
+neat-url.com
+office-on-the.net
+on-the-web.tv
+podzone.net
+podzone.org
+readmyblog.org
+saves-the-whales.com
+scrapper-site.net
+scrapping.cc
+selfip.biz
+selfip.com
+selfip.info
+selfip.net
+selfip.org
+sells-for-less.com
+sells-for-u.com
+sells-it.net
+sellsyourhome.org
+servebbs.com
+servebbs.net
+servebbs.org
+serveftp.net
+serveftp.org
+servegame.org
+shacknet.nu
+simple-url.com
+space-to-rent.com
+stuff-4-sale.org
+stuff-4-sale.us
+teaches-yoga.com
+thruhere.net
+traeumtgerade.de
+webhop.biz
+webhop.info
+webhop.net
+webhop.org
+worse-than.tv
+writesthisblog.com
diff --git a/etc/refcards/Makefile b/etc/refcards/Makefile
index 115b0ca084a..ef810da6022 100644
--- a/etc/refcards/Makefile
+++ b/etc/refcards/Makefile
@@ -1,6 +1,6 @@
### Makefile for Emacs refcards
-## Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+## Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
## This file is part of GNU Emacs.
#
@@ -47,26 +47,27 @@ VIPER_CARDS_PDF = vipcard.pdf viperCard.pdf
viper-cards_pdf: ${VIPER_CARDS_PDF}
viper-cards_ps: ${VIPER_CARDS_PDF:.pdf=.ps}
+ENVADD = TEXINPUTS=".:"
## PDF files.
## The page layouts (a4/letter) are written directly in the .tex files.
cs-refcard.pdf cs-dired-ref.pdf cs-survival.pdf sk-refcard.pdf \
-sk-dired-ref.pdf sk-survival.pdf: %.pdf: %.tex
+sk-dired-ref.pdf sk-survival.pdf: %.pdf: %.tex emacsver.tex
if pdfcsplain --version > /dev/null 2> /dev/null; then \
- pdfcsplain $<; \
+ ${ENVADD} pdfcsplain $<; \
else \
- csplain "\pdfoutput=1\input $<"; \
+ ${ENVADD} csplain "\pdfoutput=1\input $<"; \
fi
## Some versions of pdfmex seem to create dvi by default, hence output-format.
-pl-refcard.pdf: %.pdf: %.tex
+pl-refcard.pdf: %.pdf: %.tex emacsver.tex
if ! kpsewhich -format=fmt mex > /dev/null && \
! pdfmex --version > /dev/null 2> /dev/null; then \
echo "No mex format found."; false; \
fi
- pdftex -output-format=pdf $<
+ ${ENVADD} pdftex -output-format=pdf $<
ru-refcard.pdf: %.pdf: %.tex
pdflatex $<
@@ -81,21 +82,21 @@ gnus-booklet.pdf: gnus-refcard.tex gnus-logo.pdf
pdflatex -jobname=gnus-booklet '\def\booklettrue{}\def\letterpapertrue{}\input{gnus-refcard}'
## Everything not explicitly listed above.
-%.pdf: %.tex
- pdftex $<
+%.pdf: %.tex emacsver.tex
+ ${ENVADD} pdftex $<
## dvi files.
cs-refcard.dvi cs-dired-ref.dvi cs-survival.dvi sk-refcard.dvi \
-sk-dired-ref.dvi sk-survival.dvi: %.dvi: %.tex
- csplain $<
+sk-dired-ref.dvi sk-survival.dvi: %.dvi: %.tex emacsver.tex
+ ${ENVADD} csplain $<
-pl-refcard.dvi: %.dvi: %.tex
+pl-refcard.dvi: %.dvi: %.tex emacsver.tex
if ! kpsewhich -format=fmt mex > /dev/null; then \
echo "No mex format found."; false; \
fi
- tex $<
+ ${ENVADD} tex $<
ru-refcard.dvi gnus-refcard.dvi: %.dvi: %.tex
latex $<
@@ -105,8 +106,8 @@ gnus-booklet.dvi: gnus-refcard.tex
mv gnus-refcard.dvi $@
## Everything not explicitly listed above.
-%.dvi: %.tex
- tex $<
+%.dvi: %.tex emacsver.tex
+ ${ENVADD} tex $<
## PostScript files.
diff --git a/etc/refcards/README b/etc/refcards/README
index fa5ae9258eb..0372826416e 100644
--- a/etc/refcards/README
+++ b/etc/refcards/README
@@ -1,8 +1,11 @@
-Some of the *.tex files need special versions of TeX to typeset them.
-The files cs-*.tex and sk-*.tex need csTeX, a special version of TeX
-tailored to typesetting Czech and Slovak documents. We provide
-generated files for these documents, so that you could print them
-without installing the modified TeX versions.
+To generate these refcards, you need to install the TeX document
+production system. For example, http://www.tug.org/texlive/ .
+
+All modern GNU/Linux distributions provide TeX packages, so the
+easiest way is just to install those. Your distribution may have
+split some of the files needed to process non-English output into
+separate, optional packages such as: texlive-lang-cyrillic,
+texlive-lang-czechslovak, texlive-lang-german, and texlive-lang-polish.
COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
@@ -12,5 +15,5 @@ it is reproduced here for convenience.
File: gnus-logo.eps, gnus-logo.pdf
Author: Luis Fernandes <elf@ee.ryerson.ca>
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/refcards/calccard.pdf b/etc/refcards/calccard.pdf
index 58b203672de..5e97c2a9d92 100644
--- a/etc/refcards/calccard.pdf
+++ b/etc/refcards/calccard.pdf
Binary files differ
diff --git a/etc/refcards/calccard.tex b/etc/refcards/calccard.tex
index f60be117ad5..04c88befeea 100644
--- a/etc/refcards/calccard.tex
+++ b/etc/refcards/calccard.tex
@@ -20,7 +20,7 @@
% Typical command to format: tex calccard.tex
% Typical command to print (3 cols): dvips -t landscape calccard.dvi
-% Copyright (C) 1987, 1992, 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 1987, 1992, 2001-2012 Free Software Foundation, Inc.
% This file is part of GNU Emacs.
@@ -63,8 +63,7 @@
% UUCP: mit-erl!gildea
% Internet: gildea@stop.mail-abuse.org
-\def\emacsversionnumber{23}
-\def\year{2011} % latest copyright year
+\input emacsver.tex
\def\shortcopyrightnotice{\vskip 1ex plus 2 fill
\centerline{\small \copyright\ \year\ Free Software Foundation, Inc.
@@ -276,7 +275,7 @@ are preserved on all copies.
\title{GNU Calc Reference Card}
-\centerline{(for GNU Emacs version \emacsversionnumber)}
+\centerline{(for GNU Emacs version \versionemacs)}
\section{Starting and Stopping}
diff --git a/etc/refcards/cs-dired-ref.pdf b/etc/refcards/cs-dired-ref.pdf
index cf16c1afd10..1b5a8612ed9 100644
--- a/etc/refcards/cs-dired-ref.pdf
+++ b/etc/refcards/cs-dired-ref.pdf
Binary files differ
diff --git a/etc/refcards/cs-dired-ref.tex b/etc/refcards/cs-dired-ref.tex
index 63239b55c10..45867e11d44 100644
--- a/etc/refcards/cs-dired-ref.tex
+++ b/etc/refcards/cs-dired-ref.tex
@@ -1,6 +1,6 @@
% Reference Card for Dired
-% Copyright (C) 2000-2011 Free Software Foundation, Inc.
+% Copyright (C) 2000-2012 Free Software Foundation, Inc.
% Author: Evgeny Roubinchtein <eroubinc@u.washington.edu>
% Czech translation: Pavel Jank <Pavel@Janik.cz>, March 2001
@@ -41,8 +41,7 @@
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
diff --git a/etc/refcards/cs-refcard.pdf b/etc/refcards/cs-refcard.pdf
index 7d0f92fa404..963adcc7bb9 100644
--- a/etc/refcards/cs-refcard.pdf
+++ b/etc/refcards/cs-refcard.pdf
Binary files differ
diff --git a/etc/refcards/cs-refcard.tex b/etc/refcards/cs-refcard.tex
index 8b9456b4a63..98842dd08e0 100644
--- a/etc/refcards/cs-refcard.tex
+++ b/etc/refcards/cs-refcard.tex
@@ -1,6 +1,6 @@
% Reference Card for GNU Emacs
-% Copyright (C) 1987, 1993, 1996-1997, 2001-2011
+% Copyright (C) 1987, 1993, 1996-1997, 2001-2012
% Free Software Foundation, Inc.
% Author: Stephen Gildea <gildea@stop.mail-abuse.org>
@@ -59,8 +59,7 @@
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
diff --git a/etc/refcards/cs-survival.tex b/etc/refcards/cs-survival.tex
index d20d6a08364..4050cf0a1ab 100644
--- a/etc/refcards/cs-survival.tex
+++ b/etc/refcards/cs-survival.tex
@@ -1,6 +1,6 @@
% Title: GNU Emacs Survival Card
-% Copyright (C) 2000-2011 Free Software Foundation, Inc.
+% Copyright (C) 2000-2012 Free Software Foundation, Inc.
% Author: Wlodek Bzyl <matwb@univ.gda.pl>
% Czech translation: Pavel Jank <Pavel@Janik.cz>, March 2001
@@ -54,8 +54,7 @@
% Czech hyphenation rules applied
\chyph
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % latest copyright year
+\input emacsver.tex
\def\copyrightnotice{\penalty-1\vfill
\vbox{\smallfont\baselineskip=0.8\baselineskip\raggedcenter
diff --git a/etc/refcards/de-refcard.pdf b/etc/refcards/de-refcard.pdf
index c7a619b0486..bccc60993f6 100644
--- a/etc/refcards/de-refcard.pdf
+++ b/etc/refcards/de-refcard.pdf
Binary files differ
diff --git a/etc/refcards/de-refcard.tex b/etc/refcards/de-refcard.tex
index 58527be9d76..906895b358a 100644
--- a/etc/refcards/de-refcard.tex
+++ b/etc/refcards/de-refcard.tex
@@ -1,6 +1,6 @@
% Reference Card for GNU Emacs
-% Copyright (C) 1987, 1993, 1996, 2000-2011 Free Software Foundation, Inc.
+% Copyright (C) 1987, 1993, 1996, 2000-2012 Free Software Foundation, Inc.
% Author: Stephen Gildea <gildea@stop.mail-abuse.org>
% German translation: Sven Joachim <svenjoac@gmx.de>
@@ -60,8 +60,7 @@
\input german.sty
\mdqoff % deactivates the "-char
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed below this line.
diff --git a/etc/refcards/dired-ref.pdf b/etc/refcards/dired-ref.pdf
index 18a02e28ae7..0f579670808 100644
--- a/etc/refcards/dired-ref.pdf
+++ b/etc/refcards/dired-ref.pdf
Binary files differ
diff --git a/etc/refcards/dired-ref.tex b/etc/refcards/dired-ref.tex
index f1fd6808cde..b85bef1ce0b 100644
--- a/etc/refcards/dired-ref.tex
+++ b/etc/refcards/dired-ref.tex
@@ -1,6 +1,6 @@
% Reference Card for Dired
-% Copyright (C) 2000-2011 Free Software Foundation, Inc.
+% Copyright (C) 2000-2012 Free Software Foundation, Inc.
% Author: Evgeny Roubinchtein <eroubinc@u.washington.edu>
@@ -43,8 +43,7 @@
\input pdflayout.sty
\pdflayout=(1)
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
diff --git a/etc/refcards/emacsver.tex b/etc/refcards/emacsver.tex
new file mode 100644
index 00000000000..620ee8ef9e0
--- /dev/null
+++ b/etc/refcards/emacsver.tex
@@ -0,0 +1,4 @@
+%% This file is not generated by configure, because then the provided
+%% pdf files would always appear out-of-date.
+\def\versionemacs{24} % major version of emacs
+\def\year{2012} % latest copyright year
diff --git a/etc/refcards/fr-dired-ref.pdf b/etc/refcards/fr-dired-ref.pdf
index 1bd84b84e75..32f12ab2088 100644
--- a/etc/refcards/fr-dired-ref.pdf
+++ b/etc/refcards/fr-dired-ref.pdf
Binary files differ
diff --git a/etc/refcards/fr-dired-ref.tex b/etc/refcards/fr-dired-ref.tex
index 01afe76ff30..457ee2db472 100644
--- a/etc/refcards/fr-dired-ref.tex
+++ b/etc/refcards/fr-dired-ref.tex
@@ -1,6 +1,6 @@
% Reference Card for Dired
-% Copyright (C) 2000-2011 Free Software Foundation, Inc.
+% Copyright (C) 2000-2012 Free Software Foundation, Inc.
% Author: Evgeny Roubinchtein <eroubinc@u.washington.edu>
% French translation: Eric Jacoboni
@@ -35,8 +35,7 @@
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
diff --git a/etc/refcards/fr-refcard.pdf b/etc/refcards/fr-refcard.pdf
index 91f4fafe2d0..020ffbdeea0 100644
--- a/etc/refcards/fr-refcard.pdf
+++ b/etc/refcards/fr-refcard.pdf
Binary files differ
diff --git a/etc/refcards/fr-refcard.tex b/etc/refcards/fr-refcard.tex
index 61caccbea8e..4fe94d79075 100644
--- a/etc/refcards/fr-refcard.tex
+++ b/etc/refcards/fr-refcard.tex
@@ -1,6 +1,6 @@
% Reference Card for GNU Emacs
-% Copyright (C) 1987, 1993, 1996-1997, 2001-2011
+% Copyright (C) 1987, 1993, 1996-1997, 2001-2012
% Free Software Foundation, Inc.
% Author: Stephen Gildea <gildea@stop.mail-abuse.org>
@@ -56,8 +56,7 @@
\input pdflayout.sty
\pdflayout=(0l)
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed below this line.
diff --git a/etc/refcards/fr-survival.tex b/etc/refcards/fr-survival.tex
index b9c84ac680a..16d67f6b1cd 100644
--- a/etc/refcards/fr-survival.tex
+++ b/etc/refcards/fr-survival.tex
@@ -1,7 +1,7 @@
%&tex
% Title: GNU Emacs Survival Card
-% Copyright (C) 2000-2011 Free Software Foundation, Inc.
+% Copyright (C) 2000-2012 Free Software Foundation, Inc.
% Author: Wlodek Bzyl <matwb@univ.gda.pl>
% French translation: \'Eric Jacoboni <jaco@teaser.fr>, November 2001
@@ -49,8 +49,7 @@
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % latest copyright year
+\input emacsver.tex
\def\copyrightnotice{\penalty-1\vfill
\vbox{\smallfont\baselineskip=0.8\baselineskip\raggedcenter
diff --git a/etc/refcards/gnus-booklet.pdf b/etc/refcards/gnus-booklet.pdf
index f39af860394..6c8fa376234 100644
--- a/etc/refcards/gnus-booklet.pdf
+++ b/etc/refcards/gnus-booklet.pdf
Binary files differ
diff --git a/etc/refcards/gnus-logo.eps b/etc/refcards/gnus-logo.eps
index 36659ebfb4b..f959767c577 100644
--- a/etc/refcards/gnus-logo.eps
+++ b/etc/refcards/gnus-logo.eps
@@ -1,5 +1,5 @@
%!PS-Adobe-2.0 EPSF-2.0
-% Copyright (C) 2000-2011 Free Software Foundation, Inc.
+% Copyright (C) 2000-2012 Free Software Foundation, Inc.
%
% Author: Luis Fernandes <elf@ee.ryerson.ca>
%
diff --git a/etc/refcards/gnus-refcard.pdf b/etc/refcards/gnus-refcard.pdf
index 016f8fd7051..c64ed30f39f 100644
--- a/etc/refcards/gnus-refcard.pdf
+++ b/etc/refcards/gnus-refcard.pdf
Binary files differ
diff --git a/etc/refcards/gnus-refcard.tex b/etc/refcards/gnus-refcard.tex
index 9f13974584d..a2ce63aa20a 100644
--- a/etc/refcards/gnus-refcard.tex
+++ b/etc/refcards/gnus-refcard.tex
@@ -120,7 +120,7 @@
%% Gnus logo by Luis Fernandes.
\newcommand{\Copyright}{%
\begin{center}
- Copyright \copyright\ 1995, 2000, 2002-2011 Free Software Foundation, Inc.\\*
+ Copyright \copyright\ 1995, 2000, 2002-2012 Free Software Foundation, Inc.\\*
\end{center}
Permission is granted to make and distribute copies of this reference
diff --git a/etc/refcards/orgcard.pdf b/etc/refcards/orgcard.pdf
index 71f216156f3..720f08d9ded 100644
--- a/etc/refcards/orgcard.pdf
+++ b/etc/refcards/orgcard.pdf
Binary files differ
diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex
index 1579a31b8d5..9ce2923e845 100644
--- a/etc/refcards/orgcard.tex
+++ b/etc/refcards/orgcard.tex
@@ -1,7 +1,7 @@
% Reference Card for Org Mode
-\def\orgversionnumber{7.7}
-\def\versionyear{2011} % latest update
-\def\year{2011} % latest copyright year
+\def\orgversionnumber{7.9.2}
+\def\versionyear{2012} % latest update
+\input emacsver.tex
%**start of header
\newcount\columnsperpage
@@ -17,7 +17,7 @@
\pdflayout=(0l)
% Nothing else needs to be changed below this line.
-% Copyright (C) 1987, 1993, 1996-1997, 2001-2011
+% Copyright (C) 1987, 1993, 1996-1997, 2001-2012
% Free Software Foundation, Inc.
% This file is part of GNU Emacs.
@@ -445,6 +445,7 @@ formula, \kbd{:=} a field formula.
\key{execute code block at point}{C-c C-c}
\key{open results of code block at point}{C-c C-o}
\key{check code block at point for errors}{C-c C-v c}
+\key{insert a header argument with completion}{C-c C-v j}
\key{view expanded body of code block at point}{C-c C-v v}
\key{view information about code block at point}{C-c C-v I}
\key{go to named code block}{C-c C-v g}
@@ -460,7 +461,7 @@ formula, \kbd{:=} a field formula.
\key{tangle code blocks in supplied file}{C-c C-v f}
\key{ingest all code blocks in supplied file into the Library of Babel}{C-c C-v i}
\key{switch to the session of the current code block}{C-c C-v z}
-\key{load expanded body of the current code block into a session}{C-c C-v l}
+\key{load the current code block into a session}{C-c C-v l}
\key{view sha1 hash of the current code block}{C-c C-v a}
\section{Completion}
@@ -483,9 +484,9 @@ after ``{\tt :}'', and dictionary words elsewhere.
\metax{select next/previous state}{S-LEFT/RIGHT}
\metax{select next/previous set}{C-S-LEFT/RIGHT}
\key{toggle ORDERED property}{C-c C-x o}
-\key{view TODO items in a sparse tree}{C-c C-v}
-\key{view 3rd TODO keyword's sparse tree}{C-3 C-c C-v}
+\key{view TODO items in a sparse tree}{C-c / t}
+\key{view 3rd TODO keyword's sparse tree}{C-3 C-c / t}
\key{set the priority of the current item}{C-c , [ABC]}
\key{remove priority cookie from current item}{C-c , SPC}
\key{raise/lower priority of current item}{S-UP/DOWN\notetwo}
@@ -525,7 +526,7 @@ after ``{\tt :}'', and dictionary words elsewhere.
\section{Timestamps}
\key{prompt for date and insert timestamp}{C-c .}
-\key{like \kbd{C-c} . but insert date and time format}{C-u C-c .}
+\key{like \kbd{C-c .} but insert date and time format}{C-u C-c .}
\key{like \kbd{C-c .} but make stamp inactive}{C-c !} % FIXME
\key{insert DEADLINE timestamp}{C-c C-d}
\key{insert SCHEDULED timestamp}{C-c C-s}
@@ -673,7 +674,7 @@ never exported.
\section{Notes}
[1] This is only a suggestion for a binding of this command. Choose
-your own key as shown under INSTALLATION.
+your own key as shown under ACTIVATION.
[2] Keybinding affected by {\tt org-support-shift-select} and also
{\tt org-replace-disputed-keys}.
@@ -686,4 +687,3 @@ your own key as shown under INSTALLATION.
% compile-command: "tex refcard"
% End:
-
diff --git a/etc/refcards/pdflayout.sty b/etc/refcards/pdflayout.sty
index c7eb1913a09..1b421a1cee8 100644
--- a/etc/refcards/pdflayout.sty
+++ b/etc/refcards/pdflayout.sty
@@ -1,4 +1,4 @@
-% Copyright (C) 2007-2011 Free Software Foundation, Inc.
+% Copyright (C) 2007-2012 Free Software Foundation, Inc.
% This file is part of GNU Emacs.
diff --git a/etc/refcards/pl-refcard.pdf b/etc/refcards/pl-refcard.pdf
index 47299efa1bf..ddeeca97daa 100644
--- a/etc/refcards/pl-refcard.pdf
+++ b/etc/refcards/pl-refcard.pdf
Binary files differ
diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex
index 23624116709..db814cfa8c2 100644
--- a/etc/refcards/pl-refcard.tex
+++ b/etc/refcards/pl-refcard.tex
@@ -1,7 +1,7 @@
%&mex
% Reference Card for GNU Emacs
-% Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
% Author: Stephen Gildea <gildea@stop.mail-abuse.org>
% Polish translation: W{\l}odek Bzyl <matwb@univ.gda.pl>
@@ -69,8 +69,7 @@
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
diff --git a/etc/refcards/pt-br-refcard.pdf b/etc/refcards/pt-br-refcard.pdf
index dff1c3f6c00..dc61712a998 100644
--- a/etc/refcards/pt-br-refcard.pdf
+++ b/etc/refcards/pt-br-refcard.pdf
Binary files differ
diff --git a/etc/refcards/pt-br-refcard.tex b/etc/refcards/pt-br-refcard.tex
index 4091f59d1f6..d3fbe54ce87 100644
--- a/etc/refcards/pt-br-refcard.tex
+++ b/etc/refcards/pt-br-refcard.tex
@@ -1,6 +1,6 @@
% Reference Card for GNU Emacs
-% Copyright (C) 1987, 1993, 1996-1997, 2002-2004, 2006-2011
+% Copyright (C) 1987, 1993, 1996-1997, 2002-2004, 2006-2012
% Free Software Foundation, Inc.
% Author: Stephen Gildea <gildea@stop.mail-abuse.org>
@@ -62,8 +62,7 @@
\input pdflayout.sty
\pdflayout=(0l)
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed below this line.
diff --git a/etc/refcards/refcard.pdf b/etc/refcards/refcard.pdf
index f6c47d8a5f6..f2a720d656b 100644
--- a/etc/refcards/refcard.pdf
+++ b/etc/refcards/refcard.pdf
Binary files differ
diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex
index 7d4f9dbfa89..6ca9856085d 100644
--- a/etc/refcards/refcard.tex
+++ b/etc/refcards/refcard.tex
@@ -1,6 +1,6 @@
% Reference Card for GNU Emacs
-% Copyright (C) 1987, 1993, 1996-1997, 2001-2011
+% Copyright (C) 1987, 1993, 1996-1997, 2001-2012
% Free Software Foundation, Inc.
% Author: Stephen Gildea <gildea@stop.mail-abuse.org>
@@ -63,8 +63,7 @@
% Nothing else needs to be changed below this line.
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % copyright year
+\input emacsver.tex
\def\shortcopyrightnotice{\vskip 1ex plus 2 fill
\centerline{\small \copyright\ \year\ Free Software Foundation, Inc.
diff --git a/etc/refcards/ru-refcard.pdf b/etc/refcards/ru-refcard.pdf
index 3bdc7895a9d..2289acff755 100644
--- a/etc/refcards/ru-refcard.pdf
+++ b/etc/refcards/ru-refcard.pdf
Binary files differ
diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex
index f2b47acc809..1e9cd0e5b79 100644
--- a/etc/refcards/ru-refcard.tex
+++ b/etc/refcards/ru-refcard.tex
@@ -1,4 +1,4 @@
-% Copyright (C) 1997, 2002-2011 Free Software Foundation, Inc.
+% Copyright (C) 1997, 2002-2012 Free Software Foundation, Inc.
% Author: Stephen Gildea <gildea@stop.mail-abuse.org>
% Russian translation: Alex Ott <alexott@gmail.com>
@@ -21,8 +21,8 @@
\newlength{\ColThreeWidth}
\setlength{\ColThreeWidth}{25mm}
-\newcommand{\versionemacs}[0]{23} % version of Emacs this is for
-\newcommand{\cyear}[0]{2011} % copyright year
+\newcommand{\versionemacs}[0]{24} % version of Emacs this is for
+\newcommand{\cyear}[0]{2012} % copyright year
\newcommand\shortcopyrightnotice[0]{\vskip 1ex plus 2 fill
\centerline{\footnotesize \copyright\ \cyear\ Free Software Foundation, Inc.
diff --git a/etc/refcards/sk-dired-ref.pdf b/etc/refcards/sk-dired-ref.pdf
index e14764bd8f8..2cd9ef12fd9 100644
--- a/etc/refcards/sk-dired-ref.pdf
+++ b/etc/refcards/sk-dired-ref.pdf
Binary files differ
diff --git a/etc/refcards/sk-dired-ref.tex b/etc/refcards/sk-dired-ref.tex
index 12d66ce9554..50d17409072 100644
--- a/etc/refcards/sk-dired-ref.tex
+++ b/etc/refcards/sk-dired-ref.tex
@@ -1,6 +1,6 @@
% Reference Card for Dired
-% Copyright (C) 2000-2011 Free Software Foundation, Inc.
+% Copyright (C) 2000-2012 Free Software Foundation, Inc.
% Author: Evgeny Roubinchtein <eroubinc@u.washington.edu>
% Czech translation: Pavel Jank <Pavel@Janik.cz>, March 2001
@@ -42,8 +42,7 @@
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
diff --git a/etc/refcards/sk-refcard.pdf b/etc/refcards/sk-refcard.pdf
index d0a34927a26..e02c7db3d4c 100644
--- a/etc/refcards/sk-refcard.pdf
+++ b/etc/refcards/sk-refcard.pdf
Binary files differ
diff --git a/etc/refcards/sk-refcard.tex b/etc/refcards/sk-refcard.tex
index 789bbaea92f..e617387fad1 100644
--- a/etc/refcards/sk-refcard.tex
+++ b/etc/refcards/sk-refcard.tex
@@ -1,6 +1,6 @@
% Reference Card for GNU Emacs
-% Copyright (C) 1987, 1993, 1996-1997, 2001-2011
+% Copyright (C) 1987, 1993, 1996-1997, 2001-2012
% Free Software Foundation, Inc.
% Author: Stephen Gildea <gildea@stop.mail-abuse.org>
@@ -60,8 +60,7 @@
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2010} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
diff --git a/etc/refcards/sk-survival.tex b/etc/refcards/sk-survival.tex
index f496ac1af0f..2e7ac9b9298 100644
--- a/etc/refcards/sk-survival.tex
+++ b/etc/refcards/sk-survival.tex
@@ -1,6 +1,6 @@
% Title: GNU Emacs Survival Card
-% Copyright (C) 2000-2011 Free Software Foundation, Inc.
+% Copyright (C) 2000-2012 Free Software Foundation, Inc.
% Author: Wlodek Bzyl <matwb@univ.gda.pl>
% Czech translation: Pavel Jank <Pavel@Janik.cz>, March 2001
@@ -55,8 +55,7 @@
% Slovak hyphenation rules applied
\shyph
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % latest copyright year
+\input emacsver.tex
\def\copyrightnotice{\penalty-1\vfill
\vbox{\smallfont\baselineskip=0.8\baselineskip\raggedcenter
diff --git a/etc/refcards/survival.tex b/etc/refcards/survival.tex
index 845bc38bc47..09151e9801c 100644
--- a/etc/refcards/survival.tex
+++ b/etc/refcards/survival.tex
@@ -1,7 +1,7 @@
%&tex
% Title: GNU Emacs Survival Card
-% Copyright (C) 2000-2011 Free Software Foundation, Inc.
+% Copyright (C) 2000-2012 Free Software Foundation, Inc.
% Author: Wlodek Bzyl <matwb@univ.gda.pl>
@@ -44,8 +44,7 @@
\input pdflayout.sty
\pdflayout=(1)
-\def\versionemacs{23} % version of Emacs this is for
-\def\year{2011} % latest copyright year
+\input emacsver.tex
\def\copyrightnotice{\penalty-1\vfill
\vbox{\smallfont\baselineskip=0.8\baselineskip\raggedcenter
diff --git a/etc/refcards/vipcard.tex b/etc/refcards/vipcard.tex
index 47decbb9f74..2a709dc79f2 100644
--- a/etc/refcards/vipcard.tex
+++ b/etc/refcards/vipcard.tex
@@ -1,6 +1,6 @@
% Quick Reference Card for VIP
-% Copyright (C) 1987, 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 1987, 2001-2012 Free Software Foundation, Inc.
% Author: Masahiko Sato <ms@sail.stanford.edu>, <masahiko@sato.riec.tohoku.junet>
@@ -49,8 +49,8 @@
\input pdflayout.sty
\pdflayout=(1)
+\input emacsver.tex
\def\versionemacs{18} % version of Emacs this is for
-\def\year{2011} % latest copyright year
\def\versionvip{3.5}
% Nothing else needs to be changed.
diff --git a/etc/refcards/viperCard.tex b/etc/refcards/viperCard.tex
index 594137744fe..c6ab31cdb83 100644
--- a/etc/refcards/viperCard.tex
+++ b/etc/refcards/viperCard.tex
@@ -1,6 +1,6 @@
% ViperCard -- The Reference Card for Viper under GNU Emacs and XEmacs
-% Copyright (C) 1995-1997, 2001-2011 Free Software Foundation, Inc.
+% Copyright (C) 1995-1997, 2001-2012 Free Software Foundation, Inc.
% Author: Michael Kifer <kifer@cs.sunysb.edu> (Viper)
% Aamod Sane <sane@cs.uiuc.edu> (VIP 4.3)
@@ -52,8 +52,8 @@
\input pdflayout.sty
\pdflayout=(1)
+\input emacsver.tex
\def\versionemacs{21} % version of Emacs this is for
-\def\year{2011} % latest copyright year
\def\versionxemacs{20} % version of XEmacs this is for
\def\versionviper{3.0} % version of Viper this is for
diff --git a/etc/schema/locate.rnc b/etc/schema/locate.rnc
index bab527107e9..431597b1796 100644
--- a/etc/schema/locate.rnc
+++ b/etc/schema/locate.rnc
@@ -1,4 +1,4 @@
-# Copyright (C) 2003-2004, 2007-2011 Free Software Foundation, Inc.
+# Copyright (C) 2003-2004, 2007-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/etc/schema/relaxng.rnc b/etc/schema/relaxng.rnc
index 15b836c7500..b00ac078133 100644
--- a/etc/schema/relaxng.rnc
+++ b/etc/schema/relaxng.rnc
@@ -1,6 +1,6 @@
# RELAX NG XML syntax expressed in RELAX NG Compact syntax.
-# Copyright (C) 2003-2004, 2007-2011 Free Software Foundation, Inc.
+# Copyright (C) 2003-2004, 2007-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/etc/schema/schemas.xml b/etc/schema/schemas.xml
index 36c5fd873d8..e6d6564c76d 100644
--- a/etc/schema/schemas.xml
+++ b/etc/schema/schemas.xml
@@ -1,4 +1,4 @@
-<!-- Copyright (C) 2003-2004, 2007-2011 Free Software Foundation, Inc.
+<!-- Copyright (C) 2003-2004, 2007-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/etc/ses-example.ses b/etc/ses-example.ses
index 842d0ad9477..f0ff4aca121 100644
--- a/etc/ses-example.ses
+++ b/etc/ses-example.ses
@@ -205,7 +205,7 @@ Sales summary - Acme fundraising
;;; ses--symbolic-formulas: (("Eastern area") ("West-district") ("North&South") ("Other"))
;;; End:
-;;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;;; COPYING PERMISSIONS:
;;;
diff --git a/etc/spook.lines b/etc/spook.lines
index d0bda6d12ef..16bc696e0f3 100644
--- a/etc/spook.lines
+++ b/etc/spook.lines
Binary files differ
diff --git a/etc/srecode/c.srt b/etc/srecode/c.srt
new file mode 100644
index 00000000000..14d51ed02e6
--- /dev/null
+++ b/etc/srecode/c.srt
@@ -0,0 +1,164 @@
+;;; c.srt --- SRecode templates for c-mode
+
+;; Copyright (C) 2007, 2008, 2009, 2010, 2012 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <eric@siege-engine.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+set mode "c-mode"
+
+set comment_start "/**"
+set comment_end " */"
+set comment_prefix " *"
+
+;; OVERRIDE THIS in your user or project template file to whatever
+;; you use for your project.
+set HEADEREXT ".h"
+
+context file
+
+template empty :time :user :file :c
+----
+{{>:filecomment}}
+
+{{#NOTHEADER}}
+
+{{^}}
+{{/NOTHEADER}}
+{{#HEADER}}
+{{>:header_guard}}
+{{/HEADER}}
+----
+
+template header_guard :file :blank
+----
+#ifndef {{FILENAME_SYMBOL}}
+#define {{FILENAME_SYMBOL}} 1
+
+{{^}}
+
+#endif // {{FILENAME_SYMBOL}}
+----
+
+context misc
+
+template arglist
+"Insert an argument list for a function.
+@todo - Support smart CR in a buffer for not too long lines."
+----
+({{#ARGS}}{{TYPE}} {{NAME}}{{#NOTLAST}},{{/NOTLAST}}{{/ARGS}})
+----
+
+context declaration
+
+prompt TYPE "Return Type: "
+
+template function :indent :blank
+"Insert a function declaration."
+----
+{{?TYPE}} {{?NAME}}{{>:misc:arglist}}
+{{#INITIALIZERS}}{{>B:initializers}}{{/INITIALIZERS}}
+{
+{{^}}
+}
+----
+bind "f"
+
+template function-prototype :indent :blank
+"Insert a function declaration."
+----
+{{?TYPE}} {{?NAME}}{{>:misc:arglist}};
+----
+
+
+prompt TYPE "Data Type: "
+
+template variable :indent :blank
+"Insert a variable declaration."
+----
+{{?TYPE}} {{?NAME}}{{#HAVEDEFAULT}} = {{DEFAULT}}{{/HAVEDEFAULT}};
+----
+bind "v"
+
+template variable-prototype :indent :blank
+"Insert a variable declaration."
+----
+{{?TYPE}} {{?NAME}};
+----
+bind "v"
+
+
+template include :blank
+"An include statement."
+----
+#include "{{?NAME}}"
+----
+bind "i"
+
+template system-include :blank
+"An include statement."
+----
+#include <{{?NAME}}>
+----
+bind "i"
+
+template label :blank :indent
+----
+ {{?NAME}}:
+----
+
+context declaration
+
+template comment-function :indent :blank
+"Used to put a nice comment in front of a function.
+Override this with your own preference to avoid using doxygen"
+----
+{{>A:declaration:doxygen-function}}
+----
+
+;;; DOXYGEN FEATURES
+;;
+;;
+context declaration
+
+template doxygen-function :indent :blank
+----
+/**
+ * @name {{NAME}} - {{DOC}}{{^}}{{#ARGS}}
+ * @param {{NAME}} - {{DOC}}{{/ARGS}}
+ * @return {{TYPE}}
+ */
+----
+
+template doxygen-variable-same-line
+----
+/**< {{DOC}}{{^}} */
+----
+
+template doxygen-section-comment :blank :indent
+"Insert a comment that separates sections of an Emacs Lisp file."
+----
+
+/** {{?TITLE}}
+ *
+ * {{^}}
+ */
+
+----
+
+
+;; end
diff --git a/etc/srecode/cpp.srt b/etc/srecode/cpp.srt
index 0b042efce69..f73dcd2a1ca 100644
--- a/etc/srecode/cpp.srt
+++ b/etc/srecode/cpp.srt
@@ -1,6 +1,6 @@
;;; cpp.srt --- SRecode templates for c++-mode
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -25,82 +25,8 @@ set comment_start "/**"
set comment_end " */"
set comment_prefix " *"
-;; OVERRIDE THIS in your user or project template file to whatever
-;; you use for your project.
-set HEADEREXT ".h"
-
-context file
-
-template empty :time :user :file :cpp
-----
-{{>:filecomment}}
-
-{{#NOTHEADER}}
-
-{{^}}
-{{/NOTHEADER}}
-{{#HEADER}}
-{{>:header_guard}}
-{{/HEADER}}
-----
-
-template header_guard :file :blank
-----
-#ifndef {{FILENAME_SYMBOL}}
-#define {{FILENAME_SYMBOL}} 1
-
-{{^}}
-
-#endif // {{FILENAME_SYMBOL}}
-----
-
-context misc
-
-template arglist
-"Insert an argument list for a function.
-@todo - Support smart CR in a buffer for not too long lines."
-----
-({{#ARGS}}{{TYPE}} {{NAME}}{{#NOTLAST}},{{/NOTLAST}}{{/ARGS}})
-----
-
context declaration
-prompt TYPE "Return Type: "
-
-template function :indent :blank
-"Insert a function declaration."
-----
-{{?TYPE}} {{?NAME}}{{>:misc:arglist}}
-{{#INITIALIZERS}}{{>B:initializers}}{{/INITIALIZERS}}
-{
-{{^}}
-}
-----
-bind "f"
-
-template function-prototype :indent :blank
-"Insert a function declaration."
-----
-{{?TYPE}} {{?NAME}}{{>:misc:arglist}};
-----
-
-
-prompt TYPE "Data Type: "
-
-template variable :indent :blank
-"Insert a variable declaration."
-----
-{{?TYPE}} {{?NAME}}{{#HAVEDEFAULT}} = {{DEFAULT}}{{/HAVEDEFAULT}};
-----
-bind "v"
-
-template variable-prototype :indent :blank
-"Insert a variable declaration."
-----
-{{?TYPE}} {{?NAME}};
-----
-bind "v"
-
template class :indent :blank
"Insert a C++ class. For use by user insertion.
Override this template to change contents of a class.
@@ -146,18 +72,6 @@ template method :indent :blank
}
----
-template include :blank
-"An include statement."
-----
-#include "{{?NAME}}"
-----
-bind "i"
-
-template label :blank :indent
-----
- {{?NAME}}:
-----
-
context classdecl
template constructor-tag :indent :blank
@@ -196,15 +110,6 @@ Override this with your own preference to avoid using doxygen."
{{>A:classdecl:doxygen-function-group-end}}
----
-context declaration
-
-template comment-function :indent :blank
-"Used to put a nice comment in front of a function.
-Override this with your own preference to avoid using doxygen"
-----
-{{>A:declaration:doxygen-function}}
-----
-
;;; DOXYGEN FEATURES
;;
;;
@@ -229,32 +134,4 @@ template doxygen-function-group-end :indent :blank
----
-context declaration
-
-template doxygen-function :indent :blank
-----
-/**
- * @name {{NAME}} - {{DOC}}{{^}}{{#ARGS}}
- * @param {{NAME}} - {{DOC}}{{/ARGS}}
- * @return {{TYPE}}
- */
-----
-
-template doxygen-variable-same-line
-----
-/**< {{DOC}}{{^}} */
-----
-
-template doxygen-section-comment :blank :indent
-"Insert a comment that separates sections of an Emacs Lisp file."
-----
-
-/** {{?TITLE}}
- *
- * {{^}}
- */
-
-----
-
-
;; end
diff --git a/etc/srecode/default.srt b/etc/srecode/default.srt
index 91a76321193..2cedcfceeff 100644
--- a/etc/srecode/default.srt
+++ b/etc/srecode/default.srt
@@ -1,6 +1,6 @@
;;; default.srt --- SRecode templates for srecode-template-mode
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/etc/srecode/doc-cpp.srt b/etc/srecode/doc-cpp.srt
index a9ea16d1811..67d13691cef 100644
--- a/etc/srecode/doc-cpp.srt
+++ b/etc/srecode/doc-cpp.srt
@@ -1,6 +1,6 @@
;; doc-c.srt --- SRecode templates for "document" applications
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/etc/srecode/doc-default.srt b/etc/srecode/doc-default.srt
index ac8d8bc1ac2..f3876c830af 100644
--- a/etc/srecode/doc-default.srt
+++ b/etc/srecode/doc-default.srt
@@ -1,6 +1,6 @@
;; doc-default.srt --- SRecode templates for "document" applications
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/etc/srecode/doc-java.srt b/etc/srecode/doc-java.srt
index aeae1c2c389..729d025008a 100644
--- a/etc/srecode/doc-java.srt
+++ b/etc/srecode/doc-java.srt
@@ -1,6 +1,6 @@
;; doc-java.srt --- SRecode templates for "document" applications
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/etc/srecode/ede-autoconf.srt b/etc/srecode/ede-autoconf.srt
new file mode 100644
index 00000000000..daefd532dff
--- /dev/null
+++ b/etc/srecode/ede-autoconf.srt
@@ -0,0 +1,54 @@
+;; ede/templates/autoconf.srt --- Templates for autoconf used by EDE.
+;;
+;; Copyright (C) 2010 Eric M. Ludlam
+;;
+;; Author: Eric M. Ludlam <eric@siege-engine.com>
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+set mode "autoconf-mode"
+set escape_start "{{"
+set escape_end "}}"
+set comment_start "#"
+set comment_prefix "#"
+set application "ede"
+
+context file
+
+template ede-empty
+"Start a new EDE generated configure.in/ac file."
+----
+{{comment_prefix}} Automatically Generated/Maintained {{FILE}} by EDE.
+{{comment_prefix}}
+{{comment_prefix}} YOU MAY MODIFY THIS FILE
+{{comment_prefix}} Hand made changes in some sections will be preserved
+{{comment_prefix}} by EDE when this file is updated.
+{{comment_prefix}}
+{{comment_prefix}} EDE is the Emacs Development Environment.
+{{comment_prefix}} http://cedet.sourceforge.net/ede.shtml
+{{comment_prefix}}
+{{comment_prefix}} Process this file with autoconf to produce a configure script
+
+AC_INIT({{TEST_FILE}})
+AM_INIT_AUTOMAKE([{{PROGRAM}}], 0)
+AM_CONFIG_HEADER(config.h)
+
+{{comment_prefix}} End the configure script.
+AC_OUTPUT(Makefile, [date > stamp-h] )
+----
+
+
+;; end
diff --git a/etc/srecode/ede-make.srt b/etc/srecode/ede-make.srt
index 48c5aae5a68..0b024cd30e4 100644
--- a/etc/srecode/ede-make.srt
+++ b/etc/srecode/ede-make.srt
@@ -1,6 +1,6 @@
;; ede-make.srt --- SRecode templates for Makefiles used by EDE.
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -46,4 +46,36 @@ template ede-vars
{{NAME}}={{#VALUE}} {{VAL}}{{/VALUE}}{{/VARIABLE}}
----
+;; Some extra templates for Arduino based Makefiles.
+;; Perhaps split this out someday in the future.
+context arduino
+
+template ede-empty :file
+----
+# Automatically Generated {{FILE}} by EDE.
+# For use with Make for an Arduino project.
+#
+# DO NOT MODIFY THIS FILE OR YOUR CHANGES MAY BE LOST.
+# EDE is the Emacs Development Environment.
+# http://cedet.sourceforge.net/ede.shtml
+
+ARDUINO_DIR = {{ARDUINO_HOME}}
+
+TARGET = {{TARGET}}
+ARDUINO_LIBS = {{ARDUINO_LIBS}}
+
+MCU = {{MCU}}
+F_CPU = {{F_CPU}}
+ARDUINO_PORT = {{PORT}}
+BOARD_TAG = {{BOARD}}
+
+AVRDUDE_ARD_BAUDRATE = {{AVRDUDE_ARD_BAUDRATE}}
+AVRDUDE_ARD_PROGRAMMER = {{AVRDUDE_ARD_PROGRAMMER}}
+
+include {{ARDUINO_MK}}
+
+# End of Makefile
+----
+
+
;; end
diff --git a/etc/srecode/el.srt b/etc/srecode/el.srt
index 03a797bb709..34a8983b29f 100644
--- a/etc/srecode/el.srt
+++ b/etc/srecode/el.srt
@@ -1,6 +1,6 @@
;;; el.srt --- SRecode templates for Emacs Lisp mode
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric Ludlam <zappo@gnu.org>
@@ -197,7 +197,7 @@ template variable-option :el :el-custom :indent :blank
----
(defcustom $?NAME$ $^$
"*$DOC$"
- :group $GROUP$
+ :group '$GROUP$
:type $?CUSTOMTYPE$)
----
bind "o"
diff --git a/etc/srecode/getset-cpp.srt b/etc/srecode/getset-cpp.srt
index ebca17098d5..22dca4ed1b3 100644
--- a/etc/srecode/getset-cpp.srt
+++ b/etc/srecode/getset-cpp.srt
@@ -1,6 +1,6 @@
;;; getset-cpp.srt --- SRecode templates for C++ class getter/setters.
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/etc/srecode/java.srt b/etc/srecode/java.srt
index 3059afad601..706b6b39d57 100644
--- a/etc/srecode/java.srt
+++ b/etc/srecode/java.srt
@@ -1,6 +1,6 @@
;; java.srt
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/etc/srecode/make.srt b/etc/srecode/make.srt
index d07d211a984..4001132e35e 100644
--- a/etc/srecode/make.srt
+++ b/etc/srecode/make.srt
@@ -1,6 +1,6 @@
;; make.srt
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/etc/srecode/template.srt b/etc/srecode/template.srt
index adbe554216b..226d51c7ba9 100644
--- a/etc/srecode/template.srt
+++ b/etc/srecode/template.srt
@@ -1,6 +1,6 @@
;;; template.srt --- Templates for Semantic Recoders
-;; Copyright (C) 2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/test.srt b/etc/srecode/test.srt
index d3dad33a5a2..fe12eb8b8c5 100644
--- a/etc/srecode/test.srt
+++ b/etc/srecode/test.srt
@@ -1,6 +1,6 @@
;; test.srt --- SRecode templates for testing
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/etc/srecode/texi.srt b/etc/srecode/texi.srt
index abf086c7281..8c4ee858e62 100644
--- a/etc/srecode/texi.srt
+++ b/etc/srecode/texi.srt
@@ -1,6 +1,6 @@
;; texi.srt --- SRecode templates for Texinfo
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/etc/srecode/wisent.srt b/etc/srecode/wisent.srt
index b66a17a4be5..75ce5f6b7ab 100644
--- a/etc/srecode/wisent.srt
+++ b/etc/srecode/wisent.srt
@@ -1,6 +1,6 @@
;; wisent.srt --- SRecode templates for Emacs/WISENT grammar files.
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/etc/themes/adwaita-theme.el b/etc/themes/adwaita-theme.el
index 9e991847d5c..26796b85849 100644
--- a/etc/themes/adwaita-theme.el
+++ b/etc/themes/adwaita-theme.el
@@ -1,6 +1,6 @@
;;; adwaita-theme.el --- Tango-based custom theme for faces
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: William Stevenson <yhvh2000@gmail.com>
diff --git a/etc/themes/deeper-blue-theme.el b/etc/themes/deeper-blue-theme.el
index 1a4ca82f438..397228ea035 100644
--- a/etc/themes/deeper-blue-theme.el
+++ b/etc/themes/deeper-blue-theme.el
@@ -1,6 +1,6 @@
;;; deeper-blue-theme.el --- Custom theme for faces
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Scott Frazer <frazer.scott@gmail.com>
@@ -35,6 +35,7 @@
`(compilation-error ((,class (:foreground "Red1"))))
`(compilation-info ((,class (:weight normal :foreground "LightSkyBlue"))))
`(compilation-line-number ((,class (:foreground "LightGreen"))))
+ `(compilation-mode-line-exit ((,class (:foreground "blue4"))))
`(cperl-array-face ((,class (:foreground "yellow2"))))
`(cperl-hash-face ((,class (:foreground "coral1"))))
`(cursor ((,class (:background "green"))))
diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el
index 80215e564f5..903776a779d 100644
--- a/etc/themes/dichromacy-theme.el
+++ b/etc/themes/dichromacy-theme.el
@@ -1,6 +1,6 @@
;;; dichromacy-theme.el --- color theme suitable for color-blind users
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Chong Yidong <cyd@stupidchicken>
diff --git a/etc/themes/light-blue-theme.el b/etc/themes/light-blue-theme.el
index cf6ae543575..ece61f1e1c1 100644
--- a/etc/themes/light-blue-theme.el
+++ b/etc/themes/light-blue-theme.el
@@ -1,6 +1,6 @@
;;; light-blue-theme.el --- Custom theme for faces
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Drew Adams <drew.adams@oracle.com>
diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el
index b06678636c7..bab741372e7 100644
--- a/etc/themes/manoj-dark-theme.el
+++ b/etc/themes/manoj-dark-theme.el
@@ -1,6 +1,6 @@
;;; manoj-dark.el --- A dark theme from Manoj
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Manoj Srivastava <srivasta@ieee.org>
;; Keywords: lisp, faces
@@ -20,7 +20,7 @@
;;; Commentary:
-;; I spend a lot of time workin in front of a screen (many hours in a
+;; I spend a lot of time working in front of a screen (many hours in a
;; dimly lit room) and eye fatigue is an issue. This is a dark color
;; theme for emacs, which is easier on the eyes than light themes.
@@ -307,7 +307,7 @@ jarring angry fruit salad look to reduce eye fatigue.")
'(org-agenda-structure ((t (:foreground "LightSkyBlue"))))
'(org-archived ((t (:foreground "grey70"))))
'(org-code ((t (:foreground "grey70"))))
- '(org-column ((t (:background "grey30" :slant normal :weight normal :height 81 :family "unknown-DejaVu Sans Mono"))))
+ '(org-column ((t (:background "grey30" :slant normal :weight normal :height 81))))
'(org-column-title ((t (:bold t :background "grey30" :underline t :weight bold))))
'(org-date ((t (:foreground "Cyan" :underline t))))
'(org-done ((t (:bold t :foreground "PaleGreen" :weight bold))))
@@ -352,10 +352,10 @@ jarring angry fruit salad look to reduce eye fatigue.")
'(CUA-global-mark-face ((t (:background "cyan" :foreground "black"))))
'(CUA-rectangle-face ((t (:background "maroon" :foreground "white"))))
'(CUA-rectangle-noselect-face ((t (:background "dimgray" :foreground "white"))))
- '(Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728))))
- '(Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44))))
- '(Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2))))
- '(Info-title-4-face ((t (:bold t :family "helv" :weight bold))))
+ '(Info-title-1-face ((t (:bold t :weight bold :height 1.728))))
+ '(Info-title-2-face ((t (:bold t :weight bold :height 1.44))))
+ '(Info-title-3-face ((t (:bold t :weight bold :height 1.2))))
+ '(Info-title-4-face ((t (:bold t :weight bold))))
'(align-highlight-nochange-face ((t (:background "SkyBlue4"))))
'(antlr-font-lock-keyword-face ((t (:foreground "SteelBlue")))) ;%
@@ -383,7 +383,7 @@ jarring angry fruit salad look to reduce eye fatigue.")
'(change-log-conditionals-face ((t (:foreground "Aquamarine"))))
'(change-log-date-face ((t (:italic t :slant oblique :foreground "BurlyWood"))))
'(change-log-email-face ((t (:foreground "Aquamarine"))))
- '(change-log-file-face ((t (:bold t :family "Verdana" :weight bold :foreground "LightSkyBlue" :height 0.9))))
+ '(change-log-file-face ((t (:bold t :weight bold :foreground "LightSkyBlue" :height 0.9))))
'(change-log-function-face ((t (:foreground "Aquamarine"))))
'(change-log-list-face ((t (:foreground "LightSkyBlue"))))
'(change-log-name-face ((t (:bold t :weight bold :foreground "Gold"))))
@@ -397,10 +397,9 @@ jarring angry fruit salad look to reduce eye fatigue.")
'(compilation-message-face ((t (:underline t))))
'(compilation-warning ((t (:bold t :foreground "Orange" :weight bold))))
'(compilation-warning-face ((t (:bold t :foreground "Orange" :weight bold))))
- '(completions-common-part ((t (:family "unknown-DejaVu Sans Mono"
- :width normal :weight normal
- :slant normal :foreground "WhiteSmoke"
- :background "black" :height 81))))
+ '(completions-common-part ((t (:width normal :weight normal
+ :slant normal :foreground "WhiteSmoke"
+ :background "black" :height 81))))
'(completions-first-difference ((t (:bold t :weight bold))))
'(css-selector ((t (:foreground "LightSteelBlue"))))
@@ -415,9 +414,9 @@ jarring angry fruit salad look to reduce eye fatigue.")
'(custom-changed-face ((t (:foreground "wheat" :background "blue"))))
'(custom-comment-face ((t (:background "dim gray"))))
'(custom-comment-tag-face ((t (:foreground "gray80"))))
- '(custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.1))))
- '(custom-group-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.1))))
- '(custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height 1.1))))
+ '(custom-face-tag-face ((t (:bold t :weight bold :height 1.1))))
+ '(custom-group-tag-face ((t (:bold t :foreground "light blue" :weight bold :height 1.1))))
+ '(custom-group-tag-face-1 ((t (:bold t :foreground "pink" :weight bold :height 1.1))))
'(custom-invalid-face ((t (:background "red" :foreground "yellow"))))
'(custom-modified-face ((t (:background "blue" :foreground "white"))))
'(custom-rogue-face ((t (:background "black" :foreground "pink"))))
@@ -428,9 +427,8 @@ jarring angry fruit salad look to reduce eye fatigue.")
:background "lightgrey"
:foreground "black"
:box '(:line-width 2 :style released-button)))))
- '(custom-variable-tag-face ((t (:bold t :family "helv"
- :foreground "light blue"
- :weight bold :height 1.2))))
+ '(custom-variable-tag-face ((t (:bold t :foreground "light blue"
+ :weight bold :height 1.2))))
'(diary ((t (:foreground "IndianRed"))))
'(diary-anniversary ((t (:foreground "Cyan1"))))
@@ -505,7 +503,6 @@ jarring angry fruit salad look to reduce eye fatigue.")
'(excerpt ((t (:italic t))))
'(file-name-shadow ((t (:foreground "grey70"))))
'(fixed ((t (:bold t))))
- '(fixed-pitch ((t (:family "courier"))))
'(flyspell-duplicate-face ((t (:foreground "IndianRed" :bold t :underline t))))
'(flyspell-incorrect-face ((t (:foreground "Pink" :bold t :underline t))))
@@ -543,7 +540,7 @@ jarring angry fruit salad look to reduce eye fatigue.")
'(ido-only-match ((t (:foreground "ForestGreen"))))
'(ido-subdir ((t (:foreground "red1"))))
'(info-menu-5 ((t (:underline t))))
- '(info-menu-header ((t (:bold t :family "helv" :weight bold))))
+ '(info-menu-header ((t (:bold t :weight bold))))
'(info-node ((t (:bold t :italic t :foreground "yellow"))))
'(info-node ((t (:italic t :bold t :foreground "white" :slant italic :weight bold))))
'(info-xref ((t (:bold t :foreground "DodgerBlue1"))))
@@ -638,10 +635,9 @@ jarring angry fruit salad look to reduce eye fatigue.")
'(table-cell ((t (:background "blue1" :foreground "gray90"))))
'(tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button)))))
- '(tooltip ((t (:family "helv" :background "lightyellow" :foreground "black"))))
+ '(tooltip ((t (:background "lightyellow" :foreground "black"))))
'(trailing-whitespace ((t (:background "red1"))))
'(underline ((t (:underline t))))
- '(variable-pitch ((t (:family "helv"))))
'(vcursor ((t (:foreground "blue" :background "cyan" :underline t))))
'(vertical-border ((t (:background "dim gray"))))
'(vhdl-font-lock-attribute-face ((t (:foreground "Orchid"))))
diff --git a/etc/themes/misterioso-theme.el b/etc/themes/misterioso-theme.el
index 6e38a43a4f0..9a47e61d7cd 100644
--- a/etc/themes/misterioso-theme.el
+++ b/etc/themes/misterioso-theme.el
@@ -1,6 +1,6 @@
;;; misterioso-theme.el --- Custom face theme for Emacs
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Sebastian Hermida
diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el
index ae45966b347..d48bf4e4ea9 100644
--- a/etc/themes/tango-dark-theme.el
+++ b/etc/themes/tango-dark-theme.el
@@ -1,6 +1,6 @@
;;; tango-dark-theme.el --- Tango-based custom theme for faces
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Authors: Chong Yidong <cyd@stupidchicken>
;; Jan Moringen <jan.moringen@uni-bielefeld.de>
@@ -72,6 +72,9 @@ Semantic, and Ansi-Color faces are included.")
`(mode-line-inactive ((,class
(:box (:line-width -1 :style released-button)
:background ,alum-5 :foreground ,alum-1))))
+ `(compilation-mode-line-fail ((,class (:foreground ,red-3))))
+ `(compilation-mode-line-run ((,class (:foreground ,orange-3))))
+ `(compilation-mode-line-exit ((,class (:foreground ,cham-3))))
;; Escape and prompt faces
`(minibuffer-prompt ((,class (:foreground ,cham-0))))
`(escape-glyph ((,class (:foreground ,butter-3))))
diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el
index b46bd677f21..e07ccc35360 100644
--- a/etc/themes/tango-theme.el
+++ b/etc/themes/tango-theme.el
@@ -1,6 +1,6 @@
;;; tango-theme.el --- Tango-based custom theme for faces
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Authors: Chong Yidong <cyd@stupidchicken>
;; Jan Moringen <jan.moringen@uni-bielefeld.de>
diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el
index 82732765885..a551ab8722f 100644
--- a/etc/themes/tsdh-dark-theme.el
+++ b/etc/themes/tsdh-dark-theme.el
@@ -1,6 +1,6 @@
;;; tsdh-dark-theme.el --- Tassilo's dark custom theme
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -26,6 +26,9 @@ Used and created by Tassilo Horn.")
(custom-theme-set-faces
'tsdh-dark
'(default ((t (:background "gray20" :foreground "white smoke"))))
+ '(compilation-mode-line-fail ((t (:foreground "red"))))
+ '(compilation-mode-line-run ((t (:foreground "dark orange"))))
+ '(compilation-mode-line-exit ((t (:foreground "sea green"))))
'(diff-added ((t (:inherit diff-changed :background "dark green"))))
'(diff-changed ((t (:background "midnight blue"))))
'(diff-indicator-added ((t (:inherit diff-indicator-changed))))
@@ -40,7 +43,7 @@ Used and created by Tassilo Horn.")
'(message-header-subject ((t (:foreground "SkyBlue"))))
'(minibuffer-prompt ((t (:background "yellow" :foreground "medium blue" :box (:line-width -1 :color "red" :style released-button) :weight bold))))
'(mode-line ((t (:box (:line-width -1 :color "red" :style released-button) :family "DejaVu Sans"))))
- '(mode-line-inactive ((t (:inherit mode-line :foreground "dim gray"))))
+ '(mode-line-inactive ((t (:inherit mode-line :foreground "gray"))))
'(org-agenda-date ((t (:inherit org-agenda-structure))))
'(org-agenda-date-today ((t (:inherit org-agenda-date :underline t))))
'(org-agenda-date-weekend ((t (:inherit org-agenda-date :foreground "dark green"))))
diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el
index f62cea4eb47..e905f37887d 100644
--- a/etc/themes/tsdh-light-theme.el
+++ b/etc/themes/tsdh-light-theme.el
@@ -1,6 +1,6 @@
;;; tsdh-light-theme.el --- Tassilo's light custom theme
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/etc/themes/wheatgrass-theme.el b/etc/themes/wheatgrass-theme.el
index 50db2661a99..423605e4bbd 100644
--- a/etc/themes/wheatgrass-theme.el
+++ b/etc/themes/wheatgrass-theme.el
@@ -1,6 +1,6 @@
;;; wheatgrass-theme.el --- custom theme for faces
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -33,6 +33,10 @@ of green, brown, and blue.")
`(error ((,class (:foreground "salmon1"))))
`(warning ((,class (:foreground "orange"))))
`(success ((,class (:foreground "yellow green"))))
+ ;; Compilation faces
+ `(compilation-mode-line-fail ((,class (:foreground "dark green"))))
+ `(compilation-mode-line-run ((,class (:foreground "dark goldenrod"))))
+ `(compilation-mode-line-exit ((,class (:foreground "SpringGreen4"))))
;; Highlighting faces
`(highlight ((,class (:foreground "white" :background "dark green"))))
`(region ((,class (:foreground "white" :background "dark green"))))
diff --git a/etc/themes/whiteboard-theme.el b/etc/themes/whiteboard-theme.el
index e5c808df68d..a12edac8728 100644
--- a/etc/themes/whiteboard-theme.el
+++ b/etc/themes/whiteboard-theme.el
@@ -1,6 +1,6 @@
;;; whiteboard-theme.el --- Custom theme for faces
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Scott Frazer <frazer.scott@gmail.com>
diff --git a/etc/themes/wombat-theme.el b/etc/themes/wombat-theme.el
index 894a2444ab5..500c877046a 100644
--- a/etc/themes/wombat-theme.el
+++ b/etc/themes/wombat-theme.el
@@ -1,6 +1,6 @@
;;; wombat-theme.el --- Custom face theme for Emacs -*-coding: utf-8 -*-
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Kristoffer Grönlund <krig@koru.se>
diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL
index ae4cfb93edc..b74d1421ee6 100644
--- a/etc/tutorials/TUTORIAL
+++ b/etc/tutorials/TUTORIAL
@@ -16,7 +16,7 @@ The characters ">>" at the left margin indicate directions for you to
try using a command. For instance:
<<Blank lines inserted around following line by help-with-tutorial>>
[Middle of page left blank for didactic purposes. Text continues below]
->> Now type C-v (View next screen) to move to the next screen.
+>> Now type C-v (View next screen) to move to the next screen.
(go ahead, do it by holding down the CONTROL key while typing v).
From now on, you should do this again whenever you finish
reading the screen.
@@ -30,7 +30,7 @@ to place in the text. You already know how to move forward one screen,
with C-v. To move backwards one screen, type M-v (hold down the META key
and type v, or type <ESC>v if you do not have a META, EDIT, or ALT key).
->> Try typing M-v and then C-v, a few times.
+>> Try typing M-v and then C-v, a few times.
* SUMMARY
@@ -209,29 +209,18 @@ prefix argument, regardless of its value, makes the command do
something different.
C-v and M-v are another kind of exception. When given an argument,
-they scroll the screen up or down by that many lines, rather than by a
-screenful. For example, C-u 8 C-v scrolls the screen by 8 lines.
+they scroll the text up or down by that many lines, rather than by a
+screenful. For example, C-u 8 C-v scrolls by 8 lines.
>> Try typing C-u 8 C-v now.
-This should have scrolled the screen up by 8 lines. If you would like
+This should have scrolled the text up by 8 lines. If you would like
to scroll it down again, you can give an argument to M-v.
-If you are using a windowed display, such as X or MS-Windows, there
+If you are using a graphical display, such as X or MS-Windows, there
should be a tall rectangular area called a scroll bar on one side of
-the Emacs window. (There are other tall rectangles on either side of
-the Emacs display. These "fringes" are used for displaying
-continuation characters and other symbols. The scroll bar appears on
-only one side, and is the outermost column on that side.)
-You can scroll the text by clicking the mouse in the scroll bar.
-
->> Try pressing the middle button at the top of the highlighted area
- within the scroll bar. This should scroll the text to a position
- determined by how high or low you click.
-
->> Try moving the mouse up and down, while holding the middle button
- pressed down. You'll see that the text scrolls up and down as
- you move the mouse.
+the Emacs window. You can scroll the text by clicking the mouse in
+the scroll bar.
If your mouse has a wheel button, you can also use this to scroll.
@@ -247,8 +236,8 @@ You can also use C-g to discard a numeric argument or the beginning of
a command that you do not want to finish.
>> Type C-u 100 to make a numeric argument of 100, then type C-g.
- Now type C-f. It should move just one character,
- because you canceled the argument with C-g.
+ Now type C-f. It should move just one character, because you
+ canceled the argument with C-g.
If you have typed an <ESC> by mistake, you can get rid of it with a C-g.
@@ -274,9 +263,9 @@ disabled command, answer the question with "n".
* WINDOWS
---------
-Emacs can have several windows, each displaying its own text. We will
-explain later on how to use multiple windows. Right now we want to
-explain how to get rid of extra windows and go back to basic
+Emacs can have several "windows", each displaying its own text. We
+will explain later on how to use multiple windows. Right now we want
+to explain how to get rid of extra windows and go back to basic
one-window editing. It is simple:
C-x 1 One window (i.e., kill all other windows).
@@ -286,14 +275,12 @@ which contains the cursor, to occupy the full screen. It deletes all
other windows.
>> Move the cursor to this line and type C-u 0 C-l.
->> Type CONTROL-h k CONTROL-f.
+>> Type C-h k C-f.
See how this window shrinks, while a new one appears
- to display documentation on the CONTROL-f command.
+ to display documentation on the C-f command.
>> Type C-x 1 and see the documentation listing window disappear.
-This command is unlike the other commands you have learned in that it
-consists of two characters. It starts with the character CONTROL-x.
There is a whole series of commands that start with CONTROL-x; many of
them have to do with windows, files, buffers, and related things.
These commands are two, three or four characters long.
@@ -302,39 +289,36 @@ These commands are two, three or four characters long.
* INSERTING AND DELETING
------------------------
-If you want to insert text, just type the text. Characters which you
-can see, such as A, 7, *, etc. are taken by Emacs as text and inserted
-immediately. Type <Return> (the carriage-return key) to insert a
-Newline character.
-
-You can delete the last character you typed by typing <Delback>.
-<Delback> is a key on the keyboard--the same one you normally use,
-outside Emacs, for deleting the last character you typed. It is
-normally a large key a couple of lines up from the <Return> key, and
-it is usually labeled "Delete", "Del" or "Backspace".
+If you want to insert text, just type the text. Ordinary characters,
+like A, 7, *, etc., are inserted as you type them. To insert a
+Newline character, type <Return> (this is the key on the keyboard
+which is sometimes labeled "Enter").
-If the large key there is labeled "Backspace", then that's the one you
-use for <Delback>. There may also be another key labeled "Delete"
-somewhere else, but that's not <Delback>.
+To delete the character immediately before the current cursor
+position, type <DEL>. This is the key on the keyboard usually labeled
+"Backspace"--the same one you normally use, outside Emacs, to delete
+the last character typed.
-More generally, <Delback> deletes the character immediately before the
-current cursor position.
+There may also be another key on your keyboard labeled <Delete>, but
+that's not the one we refer to as <DEL>.
->> Do this now--type a few characters, then delete them
- by typing <Delback> a few times. Don't worry about this file
- being changed; you will not alter the master tutorial. This is
- your personal copy of it.
+>> Do this now--type a few characters, then delete them by
+ typing <DEL> a few times. Don't worry about this file
+ being changed; you will not alter the master tutorial.
+ This is your personal copy of it.
When a line of text gets too big for one line on the screen, the line
-of text is "continued" onto a second screen line. A backslash ("\")
-(or, if you're using a windowed display, a little curved arrow) at the
-right margin (actually, in the right "fringe") indicates a line which
-has been continued.
+of text is "continued" onto a second screen line. If you're using a
+graphical display, little curved arrows appear in the narrow spaces on
+each side of the text area (the left and right "fringes"), to indicate
+where a line has been continued. If you're using a text terminal, the
+continued line is indicated by a backslash ("\") on the rightmost
+screen column.
>> Insert text until you reach the right margin, and keep on inserting.
You'll see a continuation line appear.
->> Use <Delback>s to delete the text until the line fits on one screen
+>> Use <DEL>s to delete the text until the line fits on one screen
line again. The continuation line goes away.
You can delete a Newline character just like any other character.
@@ -342,7 +326,7 @@ Deleting the Newline character between two lines merges them into
one line. If the resulting combined line is too long to fit in the
screen width, it will be displayed with a continuation line.
->> Move the cursor to the beginning of a line and type <Delback>. This
+>> Move the cursor to the beginning of a line and type <DEL>. This
merges that line with the previous line.
>> Type <Return> to reinsert the Newline you deleted.
@@ -351,30 +335,32 @@ Remember that most Emacs commands can be given a repeat count;
this includes text characters. Repeating a text character inserts
it several times.
->> Try that now -- type C-u 8 * to insert ********.
+>> Try that now -- type C-u 8 * to insert ********.
You've now learned the most basic way of typing something in
Emacs and correcting errors. You can delete by words or lines
as well. Here is a summary of the delete operations:
- <Delback> Delete the character just before the cursor
+ <DEL> Delete the character just before the cursor
C-d Delete the next character after the cursor
- M-<Delback> Kill the word immediately before the cursor
+ M-<DEL> Kill the word immediately before the cursor
M-d Kill the next word after the cursor
C-k Kill from the cursor position to end of line
M-k Kill to the end of the current sentence
-Notice that <Delback> and C-d vs M-<Delback> and M-d extend the parallel
-started by C-f and M-f (well, <Delback> is not really a control
-character, but let's not worry about that). C-k and M-k are like C-e
-and M-e, sort of, in that lines are paired with sentences.
+Notice that <DEL> and C-d vs M-<DEL> and M-d extend the parallel
+started by C-f and M-f (well, <DEL> is not really a control character,
+but let's not worry about that). C-k and M-k are like C-e and M-e,
+sort of, in that lines are paired with sentences.
-You can also kill any part of the text with one uniform method. Move
-to one end of that part, and type C-@ or C-<SPC> (either one). (<SPC>
-is the Space bar.) Move to the other end of that part, and type C-w.
-That kills all the text between the two positions.
+You can also kill a segment of text with one uniform method. Move to
+one end of that part, and type C-<SPC>. (<SPC> is the Space bar.)
+Next, move the cursor to the other end of the text you intend to kill.
+As you do this, Emacs highlights the text between the cursor and the
+position where you typed C-<SPC>. Finally, type C-w. This kills all
+the text between the two positions.
>> Move the cursor to the Y at the start of the previous paragraph.
>> Type C-<SPC>. Emacs should display a message "Mark set"
@@ -391,10 +377,10 @@ Reinsertion of killed text is called "yanking". Generally, the
commands that can remove a lot of text kill the text (they are set up so
that you can yank the text), while the commands that remove just one
character, or only remove blank lines and spaces, do deletion (so you
-cannot yank that text). <Delback> and C-d do deletion in the simplest
+cannot yank that text). <DEL> and C-d do deletion in the simplest
case, with no argument. When given an argument, they kill instead.
->> Move the cursor to the beginning of a line which is not empty.
+>> Move the cursor to the beginning of a line which is not empty.
Then type C-k to kill the text on that line.
>> Type C-k a second time. You'll see that it kills the Newline
which follows that line.
@@ -405,13 +391,13 @@ treats a numeric argument specially: it kills that many lines AND
their contents. This is not mere repetition. C-u 2 C-k kills two
lines and their newlines; typing C-k twice would not do that.
-Bringing back killed text is called "yanking". (Think of it as
-yanking back, or pulling back, some text that was taken away.) You
-can yank the killed text either at the same place where it was killed,
-or at some other place in the text you are editing, or even in a
-different file. You can yank the same text several times; that makes
-multiple copies of it. Some other editors call killing and yanking
-"cutting" and "pasting" (see the Glossary in the Emacs manual).
+Reinserting killed text is called "yanking". (Think of it as yanking
+back, or pulling back, some text that was taken away.) You can yank
+the killed text either at the same place where it was killed, or at
+some other place in the text you are editing, or even in a different
+file. You can yank the same text several times; that makes multiple
+copies of it. Some other editors call killing and yanking "cutting"
+and "pasting" (see the Glossary in the Emacs manual).
The command for yanking is C-y. It reinserts the last killed text,
at the current cursor position.
@@ -454,27 +440,25 @@ recent kill).
------
If you make a change to the text, and then decide that it was a
-mistake, you can undo the change with the undo command, C-x u.
+mistake, you can undo the change with the undo command, C-/.
-Normally, C-x u undoes the changes made by one command; if you repeat
-the C-x u several times in a row, each repetition undoes one
-additional command.
+Normally, C-/ undoes the changes made by one command; if you repeat
+C-/ several times in a row, each repetition undoes one more command.
-But there are two exceptions: commands that do not change the text do
-not count (this includes cursor motion commands and scrolling
+But there are two exceptions: commands that do not change the text
+don't count (this includes cursor motion commands and scrolling
commands), and self-inserting characters are usually handled in groups
-of up to 20. (This is to reduce the number of C-x u's you have to
-type to undo insertion of text.)
+of up to 20. (This is to reduce the number of C-/'s you have to type
+to undo insertion of text.)
->> Kill this line with C-k, then type C-x u and it should reappear.
+>> Kill this line with C-k, then type C-/ and it should reappear.
-C-_ is an alternative undo command; it works just the same as C-x u,
-but it is easier to type several times in a row. The disadvantage of
-C-_ is that on some keyboards it is not obvious how to type it. That
-is why we provide C-x u as well. On some terminals, you can type C-_
-by typing / while holding down CONTROL.
+C-_ is an alternative undo command; it works exactly the same as C-/.
+On some text terminals, typing C-/ actually sends C-_ to Emacs.
+Alternatively, C-x u also works exactly like C-/, but is a little less
+convenient to type.
-A numeric argument to C-_ or C-x u acts as a repeat count.
+A numeric argument to C-/, C-_, or C-x u acts as a repeat count.
You can undo deletion of text just as you can undo killing of text.
The distinction between killing something and deleting it affects
@@ -485,9 +469,9 @@ whether you can yank it with C-y; it makes no difference for undo.
-------
In order to make the text you edit permanent, you must put it in a
-file. Otherwise, it will go away when your invocation of Emacs goes
-away. In order to put your text in a file, you must "find" the file
-before you enter the text. (This is also called "visiting" the file.)
+file. Otherwise, it will go away when you exit Emacs. In order to
+put your text in a file, you must "find" the file before you enter the
+text. (This is also called "visiting" the file.)
Finding a file means that you see the contents of the file within
Emacs. In many ways, it is as if you were editing the file itself.
@@ -498,17 +482,16 @@ you save, Emacs leaves the original file under a changed name in case
you later decide that your changes were a mistake.
If you look near the bottom of the screen you will see a line that
-begins with dashes, and starts with "--:--- TUTORIAL" or something
+begins with dashes, and starts with " -:--- TUTORIAL" or something
like that. This part of the screen normally shows the name of the
-file that you are visiting. Right now, you are visiting a file called
-"TUTORIAL" which is your personal scratch copy of the Emacs tutorial.
-When you find a file with Emacs, that file's name will appear in that
-precise spot.
+file that you are visiting. Right now, you are visiting your personal
+copy of the Emacs tutorial, which is called "TUTORIAL". When you find
+a file with Emacs, that file's name will appear in that precise spot.
One special thing about the command for finding a file is that you
have to say what file name you want. We say the command "reads an
-argument from the terminal" (in this case, the argument is the name of
-the file). After you type the command
+argument" (in this case, the argument is the name of the file). After
+you type the command
C-x C-f Find a file
@@ -525,35 +508,32 @@ you can cancel the command with C-g.
minibuffer. So you do not find any file.
When you have finished entering the file name, type <Return> to
-terminate it. The C-x C-f command goes to work, and finds the file
-you chose. The minibuffer disappears when the C-x C-f command is
-finished.
+terminate it. The minibuffer disappears, and the C-x C-f command goes
+to work to find the file you chose.
-In a little while the file contents appear on the screen, and you can
-edit the contents. When you wish to make your changes permanent,
-type the command
+The file contents now appear on the screen, and you can edit the
+contents. When you wish to make your changes permanent, type the
+command
C-x C-s Save the file
This copies the text within Emacs into the file. The first time you
do this, Emacs renames the original file to a new name so that it is
not lost. The new name is made by adding "~" to the end of the
-original file's name.
+original file's name. When saving is finished, Emacs displays the
+name of the file written.
-When saving is finished, Emacs displays the name of the file written.
-You should save fairly often, so that you will not lose very much
-work if the system should crash (see the section "Auto Save" below).
-
->> Type C-x C-s, saving your copy of the tutorial.
- This should show "Wrote ...TUTORIAL" at the bottom of the screen.
+>> Type C-x C-s TUTORIAL <Return>.
+ This should save this tutorial to a file named TUTORIAL, and show
+ "Wrote ...TUTORIAL" at the bottom of the screen.
You can find an existing file, to view it or edit it. You can also
find a file which does not already exist. This is the way to create a
-file with Emacs: find the file, which will start out empty, and then
-begin inserting the text for the file. When you ask to "save" the
-file, Emacs will really create the file with the text that you have
-inserted. From then on, you can consider yourself to be editing an
-already existing file.
+file with Emacs: find the file, which starts out empty, and then begin
+inserting the text for the file. When you ask to "save" the file,
+Emacs actually creates the file with the text that you have inserted.
+From then on, you can consider yourself to be editing an already
+existing file.
* BUFFERS
@@ -563,14 +543,9 @@ If you find a second file with C-x C-f, the first file remains
inside Emacs. You can switch back to it by finding it again with
C-x C-f. This way you can get quite a number of files inside Emacs.
->> Create a file named "foo" by typing C-x C-f foo <Return>.
- Then insert some text, edit it, and save "foo" by typing C-x C-s.
- Finally, type C-x C-f TUTORIAL <Return>
- to come back to the tutorial.
-
Emacs stores each file's text inside an object called a "buffer".
Finding a file makes a new buffer inside Emacs. To see a list of the
-buffers that currently exist in your Emacs job, type
+buffers that currently exist, type
C-x C-b List buffers
@@ -589,22 +564,23 @@ that corresponds to a file, you can do it by visiting the file again
with C-x C-f. But there is an easier way: use the C-x b command.
In that command, you have to type the buffer's name.
->> Type C-x b foo <Return> to go back to the buffer "foo" which holds
- the text of the file "foo". Then type C-x b TUTORIAL <Return>
- to come back to this tutorial.
+>> Create a file named "foo" by typing C-x C-f foo <Return>.
+ Then type C-x b TUTORIAL <Return> to come back to this tutorial.
Most of the time, the buffer's name is the same as the file name
(without the file directory part). However, this is not always true.
-The buffer list you make with C-x C-b always shows you the name of
-every buffer.
+The buffer list you make with C-x C-b shows you both the buffer name
+and the file name of every buffer.
+
+Some buffers do not correspond to files. The buffer named
+"*Buffer List*", which contains the buffer list that you made with
+C-x C-b, does not have any file. This TUTORIAL buffer initially did
+not have a file, but now it does, because in the previous section you
+typed C-x C-s and saved it to a file.
-ANY text you see in an Emacs window is always part of some buffer.
-Some buffers do not correspond to files. For example, the buffer
-named "*Buffer List*" does not have any file. It is the buffer which
-contains the buffer list that you made with C-x C-b. The buffer named
-"*Messages*" also does not correspond to any file; it contains the
-messages that have appeared on the bottom line during your Emacs
-session.
+The buffer named "*Messages*" also does not correspond to any file.
+This buffer contains the messages that have appeared on the bottom
+line during your Emacs session.
>> Type C-x b *Messages* <Return> to look at the buffer of messages.
Then type C-x b TUTORIAL <Return> to come back to this tutorial.
@@ -614,8 +590,8 @@ this does not save the first file. Its changes remain inside Emacs,
in that file's buffer. The creation or editing of the second file's
buffer has no effect on the first file's buffer. This is very useful,
but it also means that you need a convenient way to save the first
-file's buffer. It would be a nuisance to have to switch back to
-it with C-x C-f in order to save it with C-x C-s. So we have
+file's buffer. Having to switch back to that buffer, in order to save
+it with C-x C-s, would be a nuisance. So we have
C-x s Save some buffers
@@ -646,23 +622,21 @@ session--this is the command C-x C-c. (Do not worry about losing
changes you have made; C-x C-c offers to save each changed file before
it kills Emacs.)
-If you are using a graphical display that supports multiple
-applications in parallel, you don't need any special command to move
-from Emacs to another application. You can do this with the mouse or
-with window manager commands. However, if you're using a text
-terminal which can only show one application at a time, you need to
-"suspend" Emacs to move to any other program.
+If you are using a graphical display, you don't need any special
+command to move from Emacs to another application. You can do this
+with the mouse or with window manager commands. However, if you're
+using a text terminal which can only show one application at a time,
+you need to "suspend" Emacs to move to any other application.
C-z is the command to exit Emacs *temporarily*--so that you can go
back to the same Emacs session afterward. When Emacs is running on a
text terminal, C-z "suspends" Emacs; that is, it returns to the shell
-but does not destroy the Emacs. In the most common shells, you can
-resume Emacs with the `fg' command or with `%emacs'.
+but does not destroy the Emacs job. In the most common shells, you
+can resume Emacs with the `fg' command or with `%emacs'.
The time to use C-x C-c is when you are about to log out. It's also
-the right thing to use to exit an Emacs invoked under mail handling
-programs and other miscellaneous utilities, since they may not know
-how to cope with suspension of Emacs.
+the right thing to use to exit an Emacs invoked for a quick edit, such
+as by a mail handling utility.
There are many C-x commands. Here is a list of the ones you have learned:
@@ -677,13 +651,13 @@ There are many C-x commands. Here is a list of the ones you have learned:
Named eXtended commands are commands which are used even less
frequently, or commands which are used only in certain modes. An
-example is the command replace-string, which globally replaces one
-string with another. When you type M-x, Emacs prompts you at the
+example is the command replace-string, which replaces one string with
+another in the buffer. When you type M-x, Emacs prompts you at the
bottom of the screen with M-x and you should type the name of the
command; in this case, "replace-string". Just type "repl s<TAB>" and
Emacs will complete the name. (<TAB> is the Tab key, usually found
above the CapsLock or Shift key near the left edge of the keyboard.)
-End the command name with <Return>.
+Submit the command name with <Return>.
The replace-string command requires two arguments--the string to be
replaced, and the string to replace it with. You must end each
@@ -692,9 +666,9 @@ argument with <Return>.
>> Move the cursor to the blank line two lines below this one.
Then type M-x repl s<Return>changed<Return>altered<Return>.
- Notice how this line has changed: you've replaced
- the word c-h-a-n-g-e-d with "altered" wherever it occurred,
- after the initial position of the cursor.
+ Notice how this line has changed: you've replaced the word
+ "changed" with "altered" wherever it occurred, after the
+ initial position of the cursor.
* AUTO SAVE
@@ -729,18 +703,18 @@ shows them to you at the bottom of the screen in an area called the
The line immediately above the echo area is called the "mode line".
The mode line says something like this:
---:**- TUTORIAL 63% L749 (Fundamental)-----------------------
+ -:**- TUTORIAL 63% L749 (Fundamental)
This line gives useful information about the status of Emacs and
the text you are editing.
You already know what the filename means--it is the file you have
-found. NN% indicates your current position in the text; it means that
-NN percent of the text is above the top of the screen. If the top of
-the file is on the screen, it will say "Top" instead of " 0%". If the
-bottom of the text is on the screen, it will say "Bot". If you are
-looking at text so small that all of it fits on the screen, the mode
-line says "All".
+found. NN% indicates your current position in the buffer text; it
+means that NN percent of the buffer is above the top of the screen.
+If the top of the buffer is on the screen, it will say "Top" instead
+of " 0%". If the bottom of the buffer is on the screen, it will say
+"Bot". If you are looking at a buffer so small that all of it fits on
+the screen, the mode line says "All".
The L and digits indicate position in another way: they give the
current line number of point.
@@ -783,7 +757,8 @@ differently.
To view documentation on your current major mode, type C-h m.
->> Use C-u C-v once or more to bring this line near the top of screen.
+>> Move the cursor to the line following this line.
+>> Type C-l C-l to bring this line to the top of screen.
>> Type C-h m, to see how Text mode differs from Fundamental mode.
>> Type C-x 1 to remove the documentation from the screen.
@@ -829,10 +804,10 @@ that paragraph.
* SEARCHING
-----------
-Emacs can do searches for strings (these are groups of contiguous
-characters or words) either forward through the text or backward
-through it. Searching for a string is a cursor motion command;
-it moves the cursor to the next place where that string appears.
+Emacs can do searches for strings (a "string" is a group of contiguous
+characters) either forward through the text or backward through it.
+Searching for a string is a cursor motion command; it moves the cursor
+to the next place where that string appears.
The Emacs search command is "incremental". This means that the
search happens while you type in the string to search for.
@@ -850,7 +825,7 @@ you want to search for. <Return> terminates a search.
character to notice what happens to the cursor.
Now you have searched for "cursor", once.
>> Type C-s again, to search for the next occurrence of "cursor".
->> Now type <Delback> four times and see how the cursor moves.
+>> Now type <DEL> four times and see how the cursor moves.
>> Type <Return> to terminate the search.
Did you see what happened? Emacs, in an incremental search, tries to
@@ -859,27 +834,23 @@ go to the next occurrence of 'cursor' just type C-s again. If no such
occurrence exists, Emacs beeps and tells you the search is currently
"failing". C-g would also terminate the search.
-(Note that on some systems, typing C-s will freeze the screen and you
-will see no further output from Emacs. This indicates that an
-operating system "feature" called "flow control" is intercepting the
-C-s and not letting it get through to Emacs. To unfreeze the screen,
-type C-q.)
-
-If you are in the middle of an incremental search and type <Delback>,
-you'll notice that the last character in the search string is erased
-and the search backs up to the last place of the search. For
-instance, suppose you have typed "c", to search for the first
-occurrence of "c". Now if you type "u", the cursor will move
-to the first occurrence of "cu". Now type <Delback>. This erases
-the "u" from the search string, and the cursor moves back to
-the first occurrence of "c".
+If you are in the middle of an incremental search and type <DEL>, the
+search "retreats" to an earlier location. If you type <DEL> just
+after you had typed C-s to advance to the next occurrence of a search
+string, the <DEL> moves the cursor back to an earlier occurrence. If
+there are no earlier occurrences, the <DEL> erases the last character
+in the search string. For instance, suppose you have typed "c", to
+search for the first occurrence of "c". Now if you type "u", the
+cursor will move to the first occurrence of "cu". Now type <DEL>.
+This erases the "u" from the search string, and the cursor moves back
+to the first occurrence of "c".
If you are in the middle of a search and type a control or meta
-character (with a few exceptions--characters that are special in
-a search, such as C-s and C-r), the search is terminated.
+character (with a few exceptions--characters that are special in a
+search, such as C-s and C-r), the search is terminated.
-The C-s starts a search that looks for any occurrence of the search
-string AFTER the current cursor position. If you want to search for
+C-s starts a search that looks for any occurrence of the search string
+AFTER the current cursor position. If you want to search for
something earlier in the text, type C-r instead. Everything that we
have said about C-s also applies to C-r, except that the direction of
the search is reversed.
@@ -888,17 +859,17 @@ the search is reversed.
* MULTIPLE WINDOWS
------------------
-One of the nice features of Emacs is that you can display more than one
-window on the screen at the same time. (Note that Emacs uses the term
-"frames"--described in the next section--for what some other
+One of the nice features of Emacs is that you can display more than
+one window on the screen at the same time. (Note that Emacs uses the
+term "frames"--described in the next section--for what some other
applications call "windows". The Emacs manual contains a Glossary of
Emacs terms.)
->> Move the cursor to this line and type C-u 0 C-l (that's CONTROL-L, not
- CONTROL-1).
+>> Move the cursor to this line and type C-l C-l.
>> Now type C-x 2 which splits the screen into two windows.
- Both windows display this tutorial. The cursor stays in the top window.
+ Both windows display this tutorial. The editing cursor stays in
+ the top window.
>> Type C-M-v to scroll the bottom window.
(If you do not have a real META key, type <ESC> C-v.)
@@ -910,23 +881,25 @@ Emacs terms.)
>> Type C-x o again to move the cursor back to the top window.
The cursor in the top window is just where it was before.
-You can keep using C-x o to switch between the windows. Each
-window has its own cursor position, but only one window actually
-shows the cursor. All the ordinary editing commands apply to the
-window that the cursor is in. We call this the "selected window".
+You can keep using C-x o to switch between the windows. The "selected
+window", where most editing takes place, is the one with a prominent
+cursor which blinks when you are not typing. The other windows have
+their own cursor positions; if you are running Emacs in a graphical
+display, those cursors are drawn as unblinking hollow boxes.
The command C-M-v is very useful when you are editing text in one
-window and using the other window just for reference. You can keep
-the cursor always in the window where you are editing, and advance
-through the other window sequentially with C-M-v.
-
-C-M-v is an example of a CONTROL-META character. If you have a real
-META key, you can type C-M-v by holding down both CONTROL and META while
-typing v. It does not matter whether CONTROL or META "comes first,"
-because both of these keys act by modifying the characters you type.
-
-If you do not have a real META key, and you use <ESC> instead, the
-order does matter: you must type <ESC> followed by CONTROL-v, because
+window and using the other window just for reference. Without leaving
+the selected window, you can scroll the text in the other window with
+C-M-v.
+
+C-M-v is an example of a CONTROL-META character. If you have a META
+(or Alt) key, you can type C-M-v by holding down both CONTROL and META
+while typing v. It does not matter whether CONTROL or META "comes
+first," as both of these keys act by modifying the characters you
+type.
+
+If you do not have a META key, and you use <ESC> instead, the order
+does matter: you must type <ESC> followed by CONTROL-v, because
CONTROL-<ESC> v will not work. This is because <ESC> is a character
in its own right, not a modifier key.
@@ -953,10 +926,12 @@ Here is another way to use two windows to display two different things:
* MULTIPLE FRAMES
------------------
-Emacs can also create multiple "frames" (unless you are using a
-text-only terminal). A frame is what we call one collection of
-windows, together with its menus, scroll bars, echo area, etc.
-(Some other applications call a frame a "window".)
+Emacs can also create multiple "frames". A frame is what we call one
+collection of windows, together with its menus, scroll bars, echo
+area, etc. On graphical displays, what Emacs calls a "frame" is what
+most other applications call a "window". Multiple graphical frames
+can be shown on the screen at the same time. On a text terminal, only
+one frame can be shown at a time.
>> Type M-x make-frame <Return>.
See a new frame appear on your screen.
@@ -967,10 +942,10 @@ There is nothing special about the first frame.
>> Type M-x delete-frame <Return>.
This removes the selected frame.
-You can also remove a frame by using the normal method provided by
-your window manager (often clicking a button with an "X" at a top
-corner of the frame). No information is lost when you close a frame
-(or window), it is simply removed from sight and can be restored later.
+You can also remove a frame by using the normal method provided by the
+graphical system (often clicking a button with an "X" at a top corner
+of the frame). If you remove the Emacs job's last frame this way,
+that exits Emacs.
* RECURSIVE EDITING LEVELS
@@ -1035,11 +1010,11 @@ To get more information about a command, use C-h k instead of C-h c.
>> Type C-h k C-p.
-This displays the documentation of the function, as well as its
-name, in an Emacs window. When you are finished reading the
-output, type C-x 1 to get rid of the help text. You do not have
-to do this right away. You can do some editing while referring
-to the help text, and then type C-x 1.
+This displays the documentation of the function, as well as its name,
+in an Emacs window. When you are finished reading the output, type
+C-x 1 to get rid of that window. You do not have to do this right
+away. You can do some editing while referring to the help text, and
+then type C-x 1.
Here are some other useful C-h options:
@@ -1063,8 +1038,8 @@ You need to type in the name of the variable when Emacs prompts for it.
>> Type C-h a file <Return>.
This displays in another window a list of all M-x commands with "file"
-in their names. You will see character-commands like C-x C-f listed
-beside the corresponding command names such as find-file.
+in their names. You will see character-commands listed beside the
+corresponding command names (such as C-x C-f beside find-file).
>> Type C-M-v to scroll the help window. Do this a few times.
@@ -1121,7 +1096,7 @@ starting with the one written by Stuart Cracraft for the original Emacs.
This version of the tutorial is a part of GNU Emacs. It is copyrighted
and comes with permission to distribute copies on certain conditions:
- Copyright (C) 1985, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/etc/tutorials/TUTORIAL.bg b/etc/tutorials/TUTORIAL.bg
index cbbc27bd9c4..91198961bff 100644
--- a/etc/tutorials/TUTORIAL.bg
+++ b/etc/tutorials/TUTORIAL.bg
@@ -1,4 +1,4 @@
- . .
+ . .
- CONTROL (
CTRL CTL) META ( EDIT
@@ -14,14 +14,14 @@ ALT). ,
ESC <>.
<ESC>, ESC.
- : C-x C-c.
- ">>" . :
+ : C-x C-c. ( .)
+ , C-g.
+ >> . :
<<Blank lines inserted here by startup of help-with-tutorial>>
->> C-v ( ),
- .
- ( , CONTROL, v).
- ,
- .
+>> C-v ( ),
+ . ( , CONTROL,
+ v). ,
+ .
, ,
; ,
@@ -30,8 +30,8 @@ ALT). ,
, ,
.
, C-v. , M-v
-( META v, <ESC>v,
- META, EDIT ALT).
+( META v, <ESC> v,
+ META, EDIT ALT).
>> M-v C-v .
@@ -49,7 +49,11 @@ ALT). ,
>> .
C-l.
- , .
+ , ,
+ .
+ C-l,
+ . C-l
+ .
PageUp PageDown
, ,
@@ -65,7 +69,7 @@ ALT). ,
.
, -
C-p, C-b, C-f C-n.
- , :
+ :
(Previous), C-p
:
@@ -76,38 +80,37 @@ ALT). ,
(Next), C-n
>> ,
- C-n C-p. C-l, ,
+ C-n C-p. C-l ,
.
,
-, , : P Previous (), N
-Next (), B Backward () F Forward ().
-
-.
+, , : P Previous (), N
+ Next (), B Backward () F Forward ().
+
+ .
->> C-n, .
+>> C-n, .
->> C-f C-p.
+>> C-f C-p.
C-p, .
,
- .
- ( ,
- ).
+ . (
+ , .)
>> C-b .
. ,
.
-C-f C-b.
+C-f , C-b.
->> C-b ,
- . C-f,
- . C-f,
+>> C-b,
+ . C-f,
+ . C-f,
.
,
- . "".
+ . .
,
.
@@ -146,9 +149,8 @@ Control- ,
,
.
- "".
-,
-.
+ . ,
+ .
, ,
:
@@ -175,7 +177,7 @@ Control- ,
, M-> (Meta -),
.
- "<" ,
+ < ,
Shift, .
Shift, M-<;
Shift M-.
@@ -206,17 +208,17 @@ Shift M-.
( EDIT ALT), ,
: , META.
C-u,
- . " ",
+ . ,
, .
-, C-u 8 C-f .
+ C-u 8 C-f .
>> C-n C-p ,
, , .
, .
-( , ) --
+( , )
, ,
.
@@ -234,13 +236,8 @@ C-v M-v . ,
bar), .
, .
->>
- .
- , .
-
->> ,
- . ,
- , .
+ ,
+.
*
@@ -263,7 +260,7 @@ bar), .
*
-------------------
- "",
+ ,
.
, ,
@@ -272,16 +269,16 @@ bar), .
,
.
- , "n".
+ , n.
>> C-x C-l ( ),
- "n" .
+ n .
*
----------
- ,
+ ,
. -
.
@@ -301,57 +298,52 @@ bar), .
>> C-x 1 .
, ,
-, . C-x.
- , C-x;
- , , .
- , .
+, . CONTROL-x.
+ , CONTROL-x;
+ , , .
+ , .
*
----------------------
, . ,
- , , 7, * ..,
- . <Return> (
- ), .
-
- , ,
-<Delback>. <Delback> -- ,
- ,
- . ,
- <Return>, "Delete", "Del"
-"Backspace".
+ , , 7, * .., .
+ , <Return> ( ,
+ Enter).
- "Backspace", ,
- <Delback>.
- "Delete" , <Delback>.
+
+, <DEL>. ,
+Backspace .
-- , <Delback>
-.
+ <Delete> ,
+ <DEL>, .
->> -- ,
- <Delback> . ,
- ;
- . .
+>> ,
+ <DEL> . ,
+ ; .
+ .
,
-, "" .
- ("\") (, ,
- ) ,
-.
+, .
+ ,
+( )
+ . ,
+ (\)
+- .
>> , ,
. .
->> <Delback>, ,
- . .
+>> <DEL>, ,
+ . .
.
.
,
, .
->> <Delback>.
+>> <DEL>.
.
>> <Return>, ,
@@ -361,48 +353,52 @@ bar), .
; .
.
->> -- C-u 8 *, ********.
+>> C-u 8 *, ********.
-
. .
:
- <Delback>
- C-d
+ <DEL>
+ C-d
- M-<Delback>
- M-d
+ M-<DEL>
+ M-d
- C-k
- M-k
+ C-k
+ M-k
-, <Delback> C-d, M-<Delback> M-d,
- , C-f M-f (, <Delback>
- , ). C-k
-M-k C-e M-e , ,
- -- .
+, <DEL> C-d, M-<DEL> M-d,
+, C-f M-f (, <DEL>
+ , ). C-k M-k
+ C-e M-e , ,
+.
-
-. C-@
-C- ( ).
- C-w.
-.
+
+. C-<SPC> (<SPC>
+).. ,
+. ,
+, C-<SPC>. C-w.
+ .
->> "" .
->> C-. "Mark set"
+>> ̓ .
+>> C-<SPC>. Mark set
.
->> "" "" .
->> C-w. , ""
- "".
-
- "" (kill, cut) "" (delete) ,
-"" , ""
- .
- "" (yank, paste). , ,
- , (
- ), ,
+>> .
+>> C-w. , ̓
+ .
+
+ (kill, cut) (delete) ,
+ ,
+ (
+ . -).
+ (yank, paste). , ,
+ , (
+), ,
, (
- ).
+ ). <DEL> C-d
+ , .
+ .
>> , .
C-k, .
@@ -414,14 +410,16 @@ C-k .
C-k :
.
. C-u 2 C-k ;
- C-k .
+ C-k .
- "". (
+ . (
, , ,
.) ,
- , ,
+ , ,
. ;
- .
+ .
+ (kill) (yank) (cut)
+ (paste) (. ).
C-y.
.
@@ -466,31 +464,30 @@ C-k :
--------
,
-, , C-x
-u.
+, , C-/.
- C-x u , ;
- C-x u ,
- .
+ C-/ , ;
+ C-/ ,
+ .
: , ,
( ),
,
-20 . ( C-x u, ,
- .)
+20 . ( C-/, ,
+ .)
->> C-k, C-x u
- .
+>> C-k, C-/
+ .
-C-_ ; C-x u,
-- .
-C_- , .
- C-x u. C-_
- /, CONTROL.
+C-_ ; C-/.
+ C-/ C-_ .
+ , C-x u C-/, -
+.
- C-_ C-x u .
+ C-/, C-_ C-x u
+.
-
+
.
C-y;
.
@@ -501,35 +498,35 @@ C_- , .
, , ,
. ,
-. , ""
- . ( ""
-.)
+. ,
+(find) . (
+ (visit) .)
, .
. ,
, , ,
-"" . ,
- , .
+ (save) . ,
+ , .
, , ,
- , .
- , ,
- "-b:-- TUTORIAL.bg" .
- , .
- , "TUTORIAL.bg",
- - .
-, .
+ , ,
+ b:--- TUTORIAL.bg .
+ , .
+ , TUTORIAL.bg,
+- . ,
+ .
,
- , . "
-" ( ).
+ , . ,
+ ( ).
C-x C-f
. ,
, .
- , .
+ , .
,
.
@@ -541,35 +538,36 @@ C_- , .
.
, <Return>,
- . C-x C-f ,
- . , C-x C-f
-.
+ . C-x C-f
+ , .
.
,
- C-x C-s
+ C-x C-s (save)
. ,
, ,
- . "~"
+ . ~
.
, ,
. ,
- , .
+ ,
+(. -).
->> C-x C-s, .
- "Wrote ...TUTORIAL.bg" .
+>> C-x C-s TUTORIAL.bg <Return>.
+ TUTORIAL.bg
+ Wrote ...TUTORIAL.bg .
,
. , .
: ,
,
-. "" ,
- , .
-, .
+. ,
+ , . ,
+ .
*
@@ -579,53 +577,50 @@ C_- , .
, C-x
C-f. .
->> "foo", C-x C-f foo <Return>.
- , "foo"
- C-x C-s.
- C-x C-f TUTORIAL.bg <Return>,
- .
+ , .
+ .
+ ,
- , "".
- .
-, ,
+ C-x C-b
- C-x C-b
+>> C-x C-b .
->> C-x C-b .
+, , ,
+ . ,
+ , .
- , ,
- . , ,
- .
+>> C-x 1, .
->> C-x 1, .
-
- , ""
+ ,
. , .
- , "" .
+ , .
, ,
, C-x C-f.
- : C-x b.
.
->> C-x b foo <Return>, "foo",
- "foo". C-x b TUTORIAL
- <Return>, .
+>> foo C-x C-f foo <Return>.
+ C-x b TUTORIAL.bg <Return>,
+ .
(
). .
- , C-x C-b,
- .
+ , C-x C-b,
+ , .
, ,
-. . ,
- "*Buffer List*", . ,
- , C-x C-b.
-, "*Messages*", ;
+. . ,
+*Buffer List*, C-x C-b,
+. , .
+TUTORIAL.bg , ,
+ C-x C-s .
+
+, *Messages*, ;
,
.
>> C-x b *Messages* <Return>,
- . C-x b TUTORIAL <Return>,
+ . C-x b TUTORIAL.bg <Return>,
.
@@ -636,14 +631,15 @@ C-f. .
. C-x
C-f, C-x C-s.
- C-x s
+ C-x s (some)
C-x s , ,
-. .
+.
+.
->> , C-x s.
- , "TUTORIAL".
- "" , "y".
+>> , C-x s.
+ , TUTORIAL.bg.
+ , y (yes).
*
@@ -659,53 +655,47 @@ C-x s , ,
, -, ,
. :
- C-x C-f (Find) C-x C-s (Save).
- --
-C-x C-c. ( , ,
- ; C-x C-c ,
- .)
-
-C-z ** --
- -.
-
- , , C-z "" (suspend) ,
-.. , .
- "fg" "%emacs".
-
- , , C-z
-, ,
- ;
-"" . "exit"
- .
-
- C-x C-c ,
-. ,
- ,
- .
- , ,
-, - C-z,
-.
+ C-x C-f (Find) C-x C-s (Save).
+ -- C-x
+C-c. ( , ,
+; C-x C-c ,
+ .)
+
+ ,
+ .
+ .
+ ,
+ ,
+(suspend) .
+
+C-z **
+ -.
+ , C-z , .. ,
+ (job) .
+ fg %emacs.
C-x. , :
- C-x C-f .
- C-x C-s .
- C-x C-b .
- C-x C-c .
- C-x 1 .
- C-x u .
-
- ,
--, , .
- replace-string,
-. M-x,
-M-x ,
-"replace-string". "repl s<TAB>"
-. (<TAB> Tab,
-CapsLock Shift .)
- <Return>.
-
- replace-string -- ,
+ C-x C-f
+ C-x C-s
+ C-x s
+ C-x C-b
+ C-x b
+ C-x C-c
+ C-x 1
+ C-x u
+
+ (X) ,
+ -, ,
+. replace-string,
+ . M-x,
+ M-x ,
+ replace-string. repl s<TAB>
+ . (<TAB> Tab,
+ CapsLock Shift
+.) <Return>.
+
+ replace-string ,
, , .
<Return>.
@@ -713,28 +703,26 @@ CapsLock Shift .)
M-x repl s<Return><Return><Return>
:
- ------ "",
+ ------ ,
.
-: C-\.
-
*
-----------------------
, ,
, .
- , "
-" , .
+ ,
+ , .
# ; ,
- "hello.c",
+ hello.c,
"#hello.c#". ,
.
,
, (,
, )
-M-x recover file<Return>. ,
+M-x recover-file <Return>. ,
yes<Return>,
.
@@ -743,28 +731,28 @@ M-x recover file<Return>. ,
--------------
, ,
- , , " ".
+ , , .
.
*
----------------
- " " (mode line).
+ (mode line).
:
--b:** TUTORIAL.bg (Fundamental)--L670--58%----------------
+ b:**- TUTORIAL.bg 63% L744 (Fundamental)
,
.
- -- ,
-. -NN%-- ;
-, NN .
- , --Top-- ()
---00%--. , --Bot-- ().
- , ,
-, --All--.
+ ,
+. NN% ; ,
+ NN .
+ , Top () 0%.
+ , Bot (bottom ).
+, , ,
+ All ().
L :
.
@@ -776,13 +764,13 @@ M-x recover file<Return>. ,
,
.
Fundamental (), .
-" " (major mode).
+ (major mode).
.
/ ,
-, .
-
- , "Fundamental" .
+Lisp (), Text () .
+
+ , Fundamental .
.
, ,
@@ -793,9 +781,9 @@ Fundamental (), .
Fundamental.
, ,
-- (text).
+- Text ().
->> M-x text mode<Return>.
+>> M-x text-mode <Return>.
, , ,
. , M-f
@@ -804,13 +792,13 @@ Fundamental (), .
.
:
- " " ,
+ ,
- .
, C-h
m.
->> C-u C-v ,
+>> C-l C-l ,
.
>> C-h m,
.
@@ -824,20 +812,20 @@ m.
, ,
.
- , ,
+ , ,
, (Auto Fill
mode). ,
, ,
.
, M-x
-auto fill mode<Return>. ,
- M-x auto fill mode<Return>. ,
+auto-fill-mode <Return>. ,
+ M-x auto-fill-mode<Return>. ,
, , . ,
- " ".
+ (toggle) .
->> M-x auto fill mode<Return> .
- "asdf " , ,
+>> M-x auto-fill-mode <Return> .
+ asdf , ,
. ,
.
@@ -866,51 +854,42 @@ auto fill mode<Return>. ,
;
, .
-
- , "". ,
+ . ,
, .
C-s , C-r
. ! .
- C-s, , "I-search"
+ C-s, , I-search
. , ,
, ,
. <Return> .
>> C-s, . ,
- , "",
+ , ,
, .
- "" .
->> C-s, "".
->> <Delback> .
+ .
+>> C-s, .
+>> <DEL> .
>> <Return>, .
? , ,
, .
- "",
+ ,
C-s. , ,
- "" (failing). C-g .
-
-: C-s
- . ,
-"" , " "
-(flow control), C-s .
- , C-q. "
- " (Spontaneous Entry to Incremental
-Search)
-"".
-
- <Delback>,
+ (failing). C-g
+.
+
+ <DEL>,
,
. , ,
- "", "". ,
- "", "".
- <Delback>. ""
- , "".
+ , . ,
+ , .
+ <DEL>.
+ , .
(
- -- , ,
+ , ,
C-s C-r), .
C-s , ,
@@ -924,9 +903,11 @@ C-s , ,
,
.
+( , ,
+ , , .
+ .)
->> C-u 0 C-l (
- CONTROL-L, CONTROL-1).
+>> C-l C-l.
>> C-x 2,
. .
@@ -935,7 +916,7 @@ C-s , ,
>> C-M-v, . (
META, ESC C-v.)
->> C-x o ("o" "other" -- ""),
+>> C-x o (o other ),
.
>> C-v M-v , .
@@ -946,32 +927,32 @@ C-s , ,
.
C-x o,
-. ,
- .
- , .
- " ".
+. , ,
+ , , .
+ . ,
+ .
C-M-v ,
.
, ,
C-M-v.
-C-M-v CONTROL-META. META,
- C-M-v, CONTROL META,
- v. CONTROL META "
-", , ,
- .
+C-M-v CONTROL-META. META
+( Alt), C-M-v, CONTROL
+META, v. CONTROL META
+ , , ,
+ .
- META ESC ,
- : ESC, CONTROL-v,
-CONTROL-ESC v . , ESC
-, .
+ META <ESC> ,
+ : <ESC>, CONTROL-v,
+ CONTROL-<ESC> v . , <ESC>
+ , .
>> C-x 1 ( ), .
( C-x 1 , .
- " -- ,
- ".)
+ ,
+ .)
.
C-x C-f, ,
@@ -989,22 +970,47 @@ CONTROL-ESC v . , ESC
.
+*
+-----------------
+
+ . (frame) ,
+ , , ,
+ .. ,
+ .
+ .
+ .
+
+>> M-x make-frame <Return>.
+ .
+
+ ,
+ . .
+
+>> M-x delete-frame <Return>
+ .
+
+
+, - , X
+ . ,
+ .
+
+
*
-----------------------------
- , "
-" (recursive editing level).
+ ,
+ (recursive editing level).
,
. , [(Fundamental)]
(Fundamental).
- , ESC ESC
-ESC. "".
- () ,
- .
+ , <ESC>
+<ESC> <ESC>. .
+ () ,
+ .
->> M-x, ; ESC ESC
- ESC, .
+>> M-x, ; <ESC>
+ <ESC> <ESC>, .
C-g,
. , C-g
@@ -1028,13 +1034,10 @@ CONTROL-h, " ".
. C-h , ,
C-g, .
-( C-h.
- ,
- .
-, C-h ,
- F1 M-x help <Return> .)
+( C-h ,
+ F1 M-x help <Return> .)
-- C-h c. C-h, c
+- C-h c. C-h, c
, ;
.
@@ -1045,10 +1048,10 @@ CONTROL-h, " ".
C-p runs the command previous-line
(C-p -)
- " ".
+ .
- .
, ,
- -- ,
+ ,
, .
, C-x C-s ( META EDIT
@@ -1070,7 +1073,7 @@ c.
C-h f .
.
->> C-h f previous-line<Return>.
+>> C-h f previous-line <Return>.
, ,
C-p.
@@ -1086,11 +1089,12 @@ c.
,
.
->> C-h a file<Return>.
+>> C-h a file <Return>.
M-x ,
- "file" . C-x
-C-f, , find-file.
+ file () .
+C-x C-f, ,
+find-file.
>> C-M-v, .
.
@@ -1098,7 +1102,7 @@ C-f, , find-file.
>> C-x 1, .
C-h i (Info).
- , "*info*",
+ , *info*,
. m emacs <Return>,
.
@@ -1113,8 +1117,8 @@ C-f, , find-file.
-----------------
,
- , ( (Help)
-F10 h r). , ,
+ , ( (Help)
+C-h r). , ,
(completion), , dired,
.
@@ -1122,8 +1126,8 @@ F10 h r). , ,
*Messages*, C-x b
*M<Tab> ,
, .
- - ""
-("Completion").
+ -
+(Completion).
Dired (
: ), ,
@@ -1138,13 +1142,11 @@ Dired (
*
------------
-: , C-x C-c.
- ,
--, C-z.
+ , C-x C-c.
-, ,
--- !
+, ,
+ !
*
@@ -1160,26 +1162,28 @@ Dired (
This version of the tutorial, like GNU Emacs, is copyrighted, and
comes with permission to distribute copies on certain conditions:
-Copyright (C) 1985, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
+
+ 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.
- Permission is granted to anyone to make or distribute verbatim copies
- of this document as received, in any medium, provided that the
- copyright notice and permission notice are preserved,
- and that the distributor grants the recipient permission
- for further redistribution as permitted by this notice.
+ 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.
- Permission is granted to distribute modified versions
- of this document, or of portions of it,
- under the above conditions, provided also that they
- carry prominent notices stating who last altered them.
+ You should have received a copy of the GNU General Public License
+ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
- -, .
, COPYING
.
-(""), , !
+(), , !
-
-<ogi@fmi.uni-sofia.bg>.
+ <ogi@tower.3.bg>.
;;; Local Variables:
;;; coding: windows-1251
diff --git a/etc/tutorials/TUTORIAL.cn b/etc/tutorials/TUTORIAL.cn
index 6a605f6e791..46201455997 100644
--- a/etc/tutorials/TUTORIAL.cn
+++ b/etc/tutorials/TUTORIAL.cn
@@ -980,7 +980,7 @@ starting with the one written by Stuart Cracraft for the original Emacs.
This version of the tutorial, like GNU Emacs, is copyrighted, and
comes with permission to distribute copies on certain conditions:
-Copyright (C) 1985, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim copies
of this document as received, in any medium, provided that the
@@ -1005,7 +1005,7 @@ GNU Emacs to your friends. Help stamp out software obstructionism
ƪĵ GNU Emacs һӵаȨԼ·俽
- Copyright (C) 1985, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
ĵڲĵݵκ˷κýϣͬʱ
Ȩ뷢ȫͬġ籾
diff --git a/etc/tutorials/TUTORIAL.cs b/etc/tutorials/TUTORIAL.cs
index 98dcf473aef..db663fd0774 100644
--- a/etc/tutorials/TUTORIAL.cs
+++ b/etc/tutorials/TUTORIAL.cs
@@ -1015,7 +1015,7 @@ tutorilem napsanm Stuartem Cracraftem pro pvodn Emacs.
Tato verze tutorilu je, podobn jako GNU Emacs, chrnna copyrightem a
je ena se svolenm distribuovat kopie za jistch podmnek:
-Copyright (C) 1985, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
Kadmu je zarueno prvo vytvet a distribuovat pesn kopie tohoto
dokumentu tak, jak jej obdrel, na jakmkoliv mdiu, s tm, e bude
diff --git a/etc/tutorials/TUTORIAL.de b/etc/tutorials/TUTORIAL.de
index ad0b765b55b..3e6927441c8 100644
--- a/etc/tutorials/TUTORIAL.de
+++ b/etc/tutorials/TUTORIAL.de
@@ -15,7 +15,7 @@ EDIT oder ALT genannt). Folgende Abkrzungen werden verwendet:
M-f Halten Sie die META-Taste gedrckt und geben
Sie den Buchstaben (klein) f ein.
-`>>' am linken Rand ist ein Hinweis, einen Befehl auszuprobieren:
+>> am linken Rand ist ein Hinweis, einen Befehl auszuprobieren:
<<Blank lines inserted here by startup of help-with-tutorial>>
[Leerzeilen befinden sich hier aus didaktischen Grnden. Fortsetzung unten.]
>> Drcken Sie C-v, um zur nchsten Bildschirmseite vorzublttern.
@@ -32,7 +32,7 @@ Wichtig: Sie knnen Emacs mit der Befehlsfolge C-x C-c beenden.
Im weiteren wird die ESC-Taste mit <ESC> bezeichnet.
[Falls die deutschen Umlaute nicht korrekt auf dem Bildschirm
-erscheinen, lesen Sie bitte den Abschnitt `MULE' kurz vor Ende dieser
+erscheinen, lesen Sie bitte den Abschnitt MULE kurz vor Ende dieser
Einfhrung.]
Zunchst mssen Sie wissen, wie man sich innerhalb eines Dokuments
@@ -43,9 +43,9 @@ Sie zuerst <ESC> und anschlieend v).
>> Probieren Sie einige Male M-v und C-v aus.
-[Auf den meisten Tastaturen bewirkt die PgUp-Taste (`page up', auch
-mit `Bild' und einem Aufwrtspfeil beschriftet) dasselbe wie M-v bzw.
-die PgDn-Taste (`page down', `Bild' mit Abwrtspfeil) dasselbe wie
+[Auf den meisten Tastaturen bewirkt die PgUp-Taste (page up, auch
+mit Bild und einem Aufwrtspfeil beschriftet) dasselbe wie M-v bzw.
+die PgDn-Taste (page down, Bild mit Abwrtspfeil) dasselbe wie
C-v.]
@@ -60,13 +60,14 @@ betrachten:
C-l lsche den Bildschirm und stelle den ganzen Text
erneut dar, wobei der Text rund um den Cursor zur
Mitte des Bildschirms bewegt wird.
- (`l' ist der Buchstabe `klein L', nicht die Ziffer 1.)
+ (l ist der Buchstabe klein L, nicht die Ziffer 1.)
->> Lokalisieren Sie den Cursor und merken sich den Text in dessen
- Umgebung. Drcken Sie C-l. Der Cursor ist jetzt ungefhr in der
- (vertikalen) Bildschirmmitte, und er hat seine Position relativ zum
- Text nicht gendert.
+>> Finden Sie den Cursor und merken sich den Text in dessen Umgebung.
+ Drcken Sie C-l. Der Cursor ist jetzt ungefhr in der (vertikalen)
+ Bildschirmmitte, und er hat seine Position relativ zum Text nicht
+ gendert. Wiederholtes Drcken von C-l bewegt den Text zum oberen
+ Bildschirmrand, dann zum unteren, und dann wieder zur Mitte.
* KONTROLLE DES CURSORS
@@ -91,7 +92,7 @@ Befehl den Cursor wohin bewegt:
[Die Buchstaben p, b, f und n stehen fr die englischen Wrter
-`previous', `backward', `forward' und `next'.]
+previous, backward, forward und next.]
>> Bewegen Sie den Cursor zur Zeile in der Mitte des Diagramms mittels
C-n oder C-p. Geben Sie dann C-l ein, und das ganze Diagramm ist
@@ -113,8 +114,10 @@ untersttzen).
Beobachten Sie, was C-p tut, wenn der Cursor sich in der
Zeilenmitte befindet.
-Jede Textzeile endet mit einem Zeilenvorschub-Zeichen (`newline'), das
-sie von der folgenden Zeile trennt.
+Jede Textzeile endet mit einem Zeilenvorschub-Zeichen (newline), das
+sie von der folgenden Zeile trennt. Die letzte Zeile in einer Datei
+hat normalerweise ebenfalls einen Zeilenvorschub am Schluss, Emacs
+bentigt ihn aber nicht.
>> Probieren Sie C-b am Anfang einer Zeile. Der Cursor sollte zum
Ende der vorigen Zeile springen: C-b berspringt
@@ -132,7 +135,7 @@ C-f berspringt Zeilenvorschub-Zeichen analog zu C-b.
Wenn Sie den Cursor entweder nach oben oder nach unten ber den
Bildschirmrand hinaus bewegen wollen, dann wird statt dessen Text in
-den Bildschirm hineingeschoben. Dies nennt man `scrolling'. Auf
+den Bildschirm hineingeschoben. Dies nennt man scrolling. Auf
diese Weise verhindert Emacs, dass der Cursor je den sichtbaren
Bereich verlsst.
@@ -155,7 +158,7 @@ analog, aber in die entgegengesetzte Richtung.
zwischen Wrtern zu beobachten.
Beachten Sie die Parallele zwischen C-f und C-b einerseits und M-f und
-M-b andererseits. Sehr oft werden mit `META-' beginnende Befehle fr
+M-b andererseits. Sehr oft werden mit META- beginnende Befehle fr
Operationen verwendet, die mit Sprache zu tun haben (Wrter, Stze,
Abstze), whrend CONTROL-Befehle mit den Text-Basiseinheiten
operieren, unabhngig davon, was Sie gerade editieren (Zeichen,
@@ -181,26 +184,26 @@ lassen. Dadurch ermglichen Sie u.a., dass Emacs zwischen
Abkrzungspunkten und dem Satzende unterscheiden kann, was fr
Textsuche in wissenschaftlichen Texten oft vorteilhaft ist.]
-[Anmerkung 2: Die Tasten `Home' (Pos1) und `End' (Ende) verhalten sich
+[Anmerkung 2: Die Tasten Home (Pos1) und End (Ende) verhalten sich
standardmig wie C-a und C-e, wie wohl die meisten Benutzer
annehmen.]
-Die aktuelle Position des Cursors wird im Englischen auch `point'
-(Punkt) genannt. Beachten Sie bitte, dass sich `point' stets
+Die aktuelle Position des Cursors wird im Englischen auch point
+(Punkt) genannt. Beachten Sie bitte, dass sich point stets
*zwischen* zwei Zeichen befindet, nmlich genau vor dem
Cursor-Kstchen.
Hier ist eine Zusammenfassung von einfachen Bewegungsbefehlen fr den
Cursor einschlielich der Wort- und Satzbewegungsbefehle:
- C-f ein Zeichen vorwrts (auch `Pfeil rechts'-Taste)
- C-b ein Zeichen zurck (auch `Pfeil links'-Taste)
+ C-f ein Zeichen vorwrts (auch Pfeil rechts-Taste)
+ C-b ein Zeichen zurck (auch Pfeil links-Taste)
M-f ein Wort vorwrts
M-b ein Wort zurck
- C-n eine Zeile vorwrts (auch `Pfeil hinunter'-Taste)
- C-p eine Zeile zurck (auch `Pfeil hinauf'-Taste)
+ C-n eine Zeile vorwrts (auch Pfeil hinunter-Taste)
+ C-p eine Zeile zurck (auch Pfeil hinauf-Taste)
C-a zum Zeilenanfang
C-e zum Zeilenende
@@ -215,7 +218,7 @@ Zwei weitere wichtige Befehle fr die Cursorbewegung sind M-< (META
Kleiner-als) und M-> (META Grer-als), welche zum Anfang bzw. zum
Ende des ganzen Textes springen.
-Bei den meisten Terminal-Tastaturen befindet sich `<' ber dem Komma,
+Bei den meisten Terminal-Tastaturen befindet sich < ber dem Komma,
d.h., Sie mssen zustzlich die SHIFT-Taste verwenden (der Umschalter
ist auf deutschen Tastaturen normalerweise mit einem dicken
Aufwrtspfeil markiert). Ohne SHIFT-Taste wrden Sie M-Komma
@@ -224,17 +227,17 @@ eingeben.
>> Testen Sie nun M-<, um an den Anfang der Einfhrung
zu gelangen. Verwenden Sie dann C-v, um wieder hierher zu kommen.
-[Anmerkung: Die Tastenkombinationen `C-Home' (Pos1) und `C-End' (Ende)
+[Anmerkung: Die Tastenkombinationen C-Home (Pos1) und C-End (Ende)
verhalten sich standardmig wie M-< und M->.]
Ein weiteres, oft bentztes Konzept in Emacs ist die Markierung
-(`mark'). Der Grundbefehl dazu ist C-SPC (oder gleichwertig C-@,
-`SPC' bezeichnet die Leertaste, engl. `space key'); mit ihm kann eine
+(mark). Der Grundbefehl dazu ist C-SPC (oder gleichwertig C-@,
+SPC bezeichnet die Leertaste, engl. space key); mit ihm kann eine
Markierung gesetzt werden. Mit C-u C-SPC kommt man zu dieser
Markierung zurck, falls man den Cursor inzwischen weiterbewegt hat.
Viele Befehle, die groe Sprnge in einem Text ausfhren (so auch M->
und M-<) setzen eine Markierung implizit, was in der untersten Zeile
-(dem Echobereich, s.u.) als `Mark set' angezeigt wird.
+(dem Echobereich, s.u.) als Mark set angezeigt wird.
>> Verwenden Sie jetzt M->, um zum Ende der Einfhrung
zu springen und bentzen Sie C-u C-SPC, um hierher zurckzukehren.
@@ -257,7 +260,7 @@ Ziffern und dann der Befehl selbst. Alternativ knnen Sie die
META-Taste (bzw. EDIT- oder ALT-Taste) gedrckt halten und dann die
Ziffern des Wiederholungszhlers eingeben. Wir empfehlen allerdings,
die C-u-Methode zu lernen, da sie mit jedem Terminal funktioniert.
-Das numerische Argument wird auch `Prfix-Argument' genannt, da man es
+Das numerische Argument wird auch Prfix-Argument genannt, da man es
vor dem zugehrigen Befehl eingibt.
Beispiel: C-u 8 C-f bewegt den Cursor acht Zeichen vorwrts.
@@ -268,7 +271,7 @@ Beispiel: C-u 8 C-f bewegt den Cursor acht Zeichen vorwrts.
Wie gesagt, die meisten Befehle verwenden das numerische Argument als
Wiederholungszhler, jedoch nicht alle. Einige davon, die allerdings
-noch nicht besprochen wurden, bentzen es als Flag (`Flagge'), d.h.,
+noch nicht besprochen wurden, bentzen es als Flag (Flagge), d.h.,
allein das Vorhandensein eines Prfix-Arguments, unabhngig von seinem
Wert, signalisiert dem Befehl, etwas anderes zu tun.
@@ -283,27 +286,20 @@ Der Bildschirminhalt sollte jetzt um acht Zeilen nach oben verschoben
sein. Wollen Sie ihn nach unten verschieben, dann geben Sie M-v mit
einem numerischen Argument ein.
-Wenn Sie eine graphische Oberflche wie X11 oder MS-Windows verwenden,
-dann befindet sich ein schmaler, langgezogener rechteckiger Bereich auf
-der linken oder rechten Seite des Emacs-Fensters. Dieser Bereich
-wird Scrollbar genannt (`Verschiebungsbalken'). Sie knnen Text
+Wenn Sie eine graphische Oberflche wie X oder MS-Windows verwenden,
+dann befindet sich ein schmaler, langgezogener rechteckiger Bereich
+auf der linken oder rechten Seite des Emacs-Fensters. Dieser Bereich
+wird Scrollbar genannt (Verschiebungsbalken). Sie knnen Text
verschieben, indem Sie mit der Maus auf den Scrollbar klicken.
->> Drcken Sie die mittlere Taste (oder die linke und rechte Taste
- gleichzeitig, falls Sie eine Zwei-Tasten-Maus verwenden) innerhalb
- des Scrollbar-Bereichs. Das sollte den Text zu einer Position
- verschieben, die davon abhngt, wie weit oben oder unten Sie
- geklickt haben.
-
->> Bewegen Sie nun die Maus auf und ab, whrend Sie die mittlere Taste
- gedrckt halten. Sie werden sehen, dass der Text entsprechend der
- Mausbewegungen nach oben oder unter verschoben wird.
+Hat Ihre Maus ein Mausrad, knnen Sie damit ebenfalls Text
+verschieben.
* WENN EMACS NICHT MEHR REAGIERT
--------------------------------
-Wenn Emacs `hngt', also auf keine Ihrer Eingaben reagiert, drcken
+Wenn Emacs hngt, also auf keine Ihrer Eingaben reagiert, drcken
Sie C-g. Sie knnen C-g auch dazu bentzen, einen Befehl zu stoppen,
der zu lange braucht.
@@ -323,13 +319,13 @@ mit C-g rckgngig machen.
* DEAKTIVIERTE BEFEHLE
----------------------
-Ein paar Befehle von Emacs sind deaktiviert (`disabled'), damit
+Ein paar Befehle von Emacs sind deaktiviert (disabled), damit
Anfnger sie nicht unabsichtlich benutzen.
Wenn Sie einen solchen Befehl eingeben, dann gibt Emacs eine Meldung
aus und fragt Sie, ob Sie ihn wirklich ausfhren wollen.
-Antworten Sie mit y (fr `yes') oder drcken Sie die Leertaste, wenn
+Antworten Sie mit y (fr yes) oder drcken Sie die Leertaste, wenn
Sie den Befehl ausfhren wollen, sonst mit n.
>> Geben Sie C-x C-l ein (das ist ein deaktivierter Befehl) und
@@ -339,7 +335,7 @@ Sie den Befehl ausfhren wollen, sonst mit n.
* FENSTER
---------
-Emacs kann mehrere Fenster (`windows') haben, von denen jedes seinen
+Emacs kann mehrere Fenster (windows) haben, von denen jedes seinen
eigenen Text darstellt. Spter erklren wir, wie man mit Fenstern
umgeht. Hier wollen wir nur erklren, wie man ein (vielleicht
irrtmlich erzeugtes) Fenster wieder entfernt und zum normalen
@@ -351,14 +347,14 @@ Das ist C-x gefolgt von der Ziffer 1. C-x 1 expandiert das Fenster,
in dem der Cursor sich befindet, sodass es den ganzen Bildschirm
erfasst. Alle anderen Fenster werden gelscht.
-[Anmerkung: Emacs verwendet das Wort Fenster (`windows') in einem
+[Anmerkung: Emacs verwendet das Wort Fenster (windows) in einem
anderen Sinn, als Sie es vielleicht gewhnt sind. Wenn Sie einen
Textbildschirm vor sich haben, dann ist die Terminologie eindeutig.
Wenn Sie allerdings eine graphische Oberflche benutzen, dann
bezeichnet ein Emacs-Fenster einen Teilbereich des Fensters (von Ihrer
graphischen Oberflche erzeugt), in dem Emacs luft, in vlliger
Analogie zum Textmodus. Fr (graphische) Fenster im herkmmlichen
-Sinn verwenden die Emacs-Entwickler den Ausdruck Rahmen (`frame').]
+Sinn verwenden die Emacs-Entwickler den Ausdruck Rahmen (frame).]
>> Bewegen Sie den Cursor zu dieser Zeile und geben Sie C-u 0 C-l ein.
@@ -376,38 +372,32 @@ Sinn verwenden die Emacs-Entwickler den Ausdruck Rahmen (`frame').]
Wenn Sie Text einfgen wollen, dann geben Sie ihn einfach ein.
Sichtbare Zeichen, z.B. A, 7, * usw. werden als Text von Emacs sofort
eingefgt. Drcken Sie <Return> (die Zeilenvorschubtaste, meistens
-mit `Enter' oder nur mit einem Rckwrts-Hakenpfeil beschriftet), um
+mit Enter oder nur mit einem Rckwrts-Hakenpfeil beschriftet), um
ein Zeilenvorschubzeichen einzufgen.
-Sie knnen das zuletzt eingegebene Zeichen lschen, indem Sie <Delete>
-drcken. <Delete> ist einer Taste auf der Tastatur zugeordnet, die
-mit `Del' oder `Entf' beschriftet ist. In manchen Fllen dient die
-Backspace-Taste (oft auch nur als Rckwrtspfeil beschriftet) als
-<Delete>, aber nicht immer!
+Sie knnen das zuletzt eingegebene Zeichen lschen, indem Sie <DEL>
+drcken. <DEL> ist der Backspace-Taste zugeordnet (oft auch nur als
+Rckwrtspfeil beschriftet).
-Allgemein gesprochen lscht <Delete> das Zeichen unmittelbar vor der
+Allgemein gesprochen lscht <DEL> das Zeichen unmittelbar vor der
aktuellen Cursorposition.
-[Beachten Sie, dass <Delete> ein logischer Befehlsname ist, der auf
-die jeweilige Tastatur abgebildet wird. Lesen Sie im Abschnitt `Init
-Rebinding' des Emacs-Handbuches nach, wie Sie gegebenenfalls die
-Tastaturbelegung verndern knnen.]
-
>> Probieren Sie das jetzt aus: Geben Sie ein paar Zeichen ein und
- lschen Sie sie wieder mit <Delete>. Sie brauchen sich keine
- Sorgen zu machen, dieses Dokument zu verndern: Was Sie hier lesen,
- ist nur eine (persnliche) Kopie des originalen Dokuments.
+ lschen Sie sie wieder mit <DEL>. Sie brauchen sich keine Sorgen
+ zu machen, dieses Dokument zu verndern: Was Sie hier lesen, ist
+ nur eine (persnliche) Kopie des originalen Dokuments.
-Wenn eine Textzeile zu lang wird fr eine Bildschirmzeile, dann wird
-sie auf einer zweiten Bildschirmzeile `fortgesetzt'. Ein
-`Backslash'-Zeichen (`\') bzw. ein kleiner gebogener Pfeil (bei
-graphischen Oberflchen) am rechten Rand verdeutlicht das.
+Wenn eine Textzeile zu lang fr eine Bildschirmzeile ist, wird sie auf
+einer zweiten Bildschirmzeile fortgesetzt: Bei graphischen
+Oberflchen erscheinen zwei kleine gebogene Pfeile links und rechts
+vom Textbereich (diese schmalen Spalten werden fringe genannt), bei
+Terminals ein Backslash-Zeichen (\) am rechten Rand.
>> Fgen Sie Text ein, bis Sie den rechten Rand erreicht haben. Fgen
Sie weiter Text ein. Beobachten Sie, wie eine Fortsetzungszeile
erscheint.
->> Verwenden Sie <Delete> so oft, bis die Textzeile wieder auf eine
+>> Verwenden Sie <DEL> so oft, bis die Textzeile wieder auf eine
Bildschirmzeile passt. Die Fortsetzungszeile verschwindet wieder.
Sie knnen das Zeilenvorschubzeichen wie jedes andere Zeichen lschen:
@@ -415,7 +405,7 @@ Die Zeilen vor und nach ihm werden dann zu einer zusammengehngt. Ist
diese lnger als die Bildschirmbreite, erscheint eine
Fortsetzungszeile.
->> Bewegen Sie den Cursor zum Anfang der Zeile und geben Sie <Delete>
+>> Bewegen Sie den Cursor zum Anfang der Zeile und geben Sie <DEL>
ein: Die momentane Zeile wird an die vorige angehngt.
>> Geben Sie <Return> ein, um wieder ein Zeilenvorschubzeichen
@@ -432,10 +422,10 @@ Bis jetzt kennen Sie die Grundbefehle, um Text in Emacs einzugeben und
Fehler zu korrigieren -- fast analog zu den Bewegungsbefehlen ist es
mglich, ganze Wrter, Stze oder Zeilen zu lschen:
- <Delete> lsche ein Zeichen vor dem Cursor
+ <DEL> lsche ein Zeichen vor dem Cursor
C-d lsche das Zeichen unter dem Cursor
- M-<Delete> lsche bis zum (nchsten) Wortanfang unmittelbar
+ M-<DEL> lsche bis zum (nchsten) Wortanfang unmittelbar
vor dem Cursor
M-d lsche bis zum (nchsten) Wortende nach
(bzw. unter) dem Cursor
@@ -445,42 +435,40 @@ mglich, ganze Wrter, Stze oder Zeilen zu lschen:
M-k lsche bis zum nchsten Satzende nach
(bzw. unter) dem Cursor
-Beachten Sie bitte, dass <Delete> je nach Tastaturbelegung die Del-
-(Entf-) oder die Backspace- (Rckwrtspfeil-) Taste sein kann.
-
Eine andere, einheitliche Methode zum Lschen von Text ist das
Befehlspaar C-@ (oder C-SPC) und C-w. Gehen sie zum Anfang des zu
lschenden Textes und drcken Sie C-@ oder C-SPC. Gehen Sie dann zum
Ende des zu lschenden Textes und drcken Sie C-w, um ihn zu
entfernen.
->> Bewegen Sie den Cursor zum Buchstaben `E' am Anfang des letzten
+>> Bewegen Sie den Cursor zum Buchstaben E am Anfang des letzten
Absatzes.
->> Drcken Sie C-SPC. Emacs sollte die Meldung `Mark set' am unteren
+>> Drcken Sie C-SPC. Emacs sollte die Meldung Mark set am unteren
Bildschirmrand zeigen.
->> Bewegen Sie den Cursor zum Buchstaben `A' in der zweiten Zeile des
+>> Bewegen Sie den Cursor zum Buchstaben A in der zweiten Zeile des
letzten Absatzes.
->> Geben Sie C-w ein. Der ganze Text, beginnend mit dem `E' und
- endend vor dem `A', ist nun gelscht.
+>> Geben Sie C-w ein. Der ganze Text, beginnend mit dem E und
+ endend vor dem A, ist nun gelscht.
Lschen Sie mehr als ein Zeichen auf einmal, speichert Emacs den
gelschten Text, damit Sie ihn bei Bedarf wieder zurckholen knnen.
Einfgen von bereits gelschtem Text wird im englischen Dokumentation
-von Emacs als `yanking' (wrtlich `herausreien') bezeichnet. Sie
+von Emacs als yanking (wrtlich herausreien) bezeichnet. Sie
knnen den gelschten Text an einer beliebigen Stelle wieder
einzufgen. Solange Sie nichts neues lschen, steht Ihnen dieser
gelschte Textteil immer wieder zu Verfgung. Der Befehl dazu ist C-y
-(das Ypsilon steht fr `yank').
+(das Ypsilon steht fr yank).
Emacs unterscheidet zwei Klassen von Lschbefehlen (was man im
-Deutschen leider nicht gut wiedergeben kann): `killing' (umbringen)
-und `deleting' (lschen). Wenn man sich vorstellt, dass `yanking' den
-Begriff `von den Toten erwecken' darstellt, dann hat man ungefhr eine
-Vorstellung von der Metapher -- Von einem `kill'-Befehl gelschter
-Text wird gespeichert und kann bei Bedarf mit C-y zurckgeholt
-werden. Von einem `delete'-Befehl entfernter Text (in der Regel
-einzelne Zeichen, leere Zeilen und Zwischenrume) wird nicht extra
-gespeichert und kann daher auch nicht zurckgeholt werden.
+Deutschen leider nicht gut wiedergeben kann): killing (umbringen)
+und deleting (lschen). Wenn man sich vorstellt, dass yanking den
+Begriff von den Toten erwecken darstellt, dann hat man ungefhr eine
+Vorstellung von der Metapher -- Von einem kill-Befehl gelschter
+Text wird gespeichert und kann bei Bedarf mit C-y zurckgeholt werden.
+Von einem delete-Befehl entfernter Text (in der Regel einzelne
+Zeichen, leere Zeilen und Zwischenrume) wird nicht extra gespeichert
+und kann daher auch nicht zurckgeholt werden. Allerdings besteht die
+Mglichkeit zum Undo, siehe weiter unten.
>> Bringen Sie den Cursor an den Anfang einer nicht-leeren Zeile und
geben Sie C-k ein, um die Zeile zu lschen.
@@ -495,12 +483,16 @@ behandelt: es lscht die angegebene Anzahl von Zeilen UND die
Zeilenvorschbe: C-u 2 C-k lscht zwei Zeilen komplett; zweimal C-k
lscht dagegen nur eine Zeile.
-Wie schon erwhnt, bringt C-y den zuletzt gelschten (`gekillten')
+Wie schon erwhnt, bringt C-y den zuletzt gelschten (gekillten)
Text zurck -- man kann diesen Text einfgen, wo man will: an der
ursprnglichen Stelle, an einer anderen Stelle, oder sogar in einer
anderen Datei. Mehrmaliges Ausfhren von C-y fgt den Text mehrmals
ein.
+In anderen Editoren wird kill und yank oft als cut
+(ausschneiden) und paste (einfgen) bezeichnet. Nheres dazu findet
+sich im Abschnitt Glossary des Emacs-Handbuchs.
+
>> Probieren Sie jetzt C-y, um diesen Effekt zu sehen.
Fhren Sie C-k mehrmals hintereinander aus, dann wird der so
@@ -509,14 +501,14 @@ Text zurck.
>> Drcken Sie mehrmals C-k.
-Holen Sie jetzt den Text `von den Toten' zurck:
+Holen Sie jetzt den Text von den Toten zurck:
>> Drcken Sie C-y. Bewegen Sie dann den Cursor ein paar Zeilen nach
unten und drcken Sie C-y erneut. Der eben eingefgte Text wird
noch einmal an anderer Stelle kopiert.
Wie knnen Sie gelschten Text wieder einfgen, wenn Sie in der
-Zwischenzeit noch etwas anderes `gekillt' haben? C-y wrde das
+Zwischenzeit noch etwas anderes gekillt haben? C-y wrde das
zuletzt gelschte Textstck zurckholen, was aber nicht das gewnschte
ist. Verwenden Sie nun M-y (unmittelbar nach der erstmaligen
Ausfhrung von C-y), um den gerade mit C-y eingefgten Textteil durch
@@ -546,7 +538,7 @@ durchgesehen.
Die meisten graphischen Oberflchen bieten auch die Mglichkeit, mit
der linken Maustaste einen Textteil zu markieren (er erscheint dann
normalerweise grau unterlegt). Der Befehl C-w lscht diesen
-markierten Textteil (in Emacs auch `Region' genannt) und fgt ihn in
+markierten Textteil (in Emacs auch Region genannt) und fgt ihn in
den Lschring ein.
Dasselbe geht auch ohne Maus: Bewegen Sie den Cursor zum Beginn des zu
@@ -562,54 +554,48 @@ man Befehle mit langen Namen ausfhren kann).
------
Wenn Sie etwas am Text gendert haben und nachtrglich bemerken, dass
-das ein Fehler war, so knnen Sie den Fehler mit dem Befehl C-x u
-ungeschehen machen (`undo').
+das ein Fehler war, so knnen Sie den Fehler mit dem Befehl C-/
+ungeschehen machen (undo).
-Normalerweise macht C-x u das Verhalten von einem Befehl ungeschehen;
-fhren Sie C-x u mehrmals hintereinander aus, werden die jeweiligen
+Normalerweise macht C-/ das Verhalten von einem Befehl ungeschehen;
+fhren Sie C-/ mehrmals hintereinander aus, werden die jeweiligen
vorigen Befehle widerrufen.
Es gibt jedoch zwei Ausnahmen: Befehle, die den Text nicht ndern,
werden nicht gezhlt (z.B. Cursorbewegungen und Blttern im Text).
-Und Befehle, die sich selbst einfgen (`self-inserting': Drcken Sie
-zum Beispiel die `u'-Taste, dann wird der Buchstabe u eingefgt)
+Und Befehle, die sich selbst einfgen (self-inserting: Drcken Sie
+zum Beispiel die u-Taste, dann wird der Buchstabe u eingefgt)
werden in Gruppen von bis zu 20 Zeichen wiederhergestellt, um die
-Anzahl der notwendigen C-x u-Befehle zu reduzieren.
+Anzahl der notwendigen C-/-Befehle zu reduzieren.
>> Lschen Sie diese Zeilen mit C-k und drcken Sie anschlieend
- mehrmals C-x u, und die Zeilen erscheinen wieder.
+ mehrmals C-/, und die Zeilen erscheinen wieder.
-C-_ ist ein alternativer Undo-Befehl; er arbeitet genauso wie C-x u,
-ist jedoch einfacher zu tippen, wenn Sie den Befehl mehrmals
-hintereinander ausfhren mchten. Der Nachteil von C-_ ist, dass bei
-manchen Tastaturen nicht sofort einsichtig ist, wie man das eingibt.
-
-Eine weitere Eingabemglichkeit bei vielen Terminals ist C-/.
-
-Ein numerisches Argument fr C-_, C-x u oder C-/ wird als
+Alternative Tastenkombinationen fr C-/ sind C-_ und C-x u. Ein
+numerisches Argument fr C-/, C-_ oder C-x u wird als
Wiederholungszhler interpretiert.
Der Unterschied zwischen der Undo-Funktion und dem oben erklrten C-y
ist, dass erstere gelschten Text an exakt der gleichen Position wie
vorher wiederherstellt, wohingegen C-y den gelschten Text an der
-momentanen Cursorposition einfgt. Im brigen kann auch `gekillter'
-Text wieder hergestellt werden; der Unterschied zwischen `killing' und
-`yanking' betrifft nur C-y, aber nicht die Undo-Funktion.
+momentanen Cursorposition einfgt. Im brigen kann auch gekillter
+Text wieder hergestellt werden; der Unterschied zwischen killing und
+yanking betrifft nur C-y, aber nicht die Undo-Funktion.
* DATEIEN
---------
-Um editierten Text zu sichern, muss man ihn in einer Datei (`file')
-speichern (`save'). Wird Emacs beendet, ohne dass man vorher den Text
+Um editierten Text zu sichern, muss man ihn in einer Datei (file)
+speichern (save). Wird Emacs beendet, ohne dass man vorher den Text
gespeichert hat, dann ist der Text verloren.
Will man andererseits bereits gesicherten Text mit Emacs editieren, so
muss die entsprechende Datei in Emacs geladen werden (im Englischen
-wird das als `finding' (finden) bzw. als `visiting' (besuchen)
+wird das als finding (finden) bzw. als visiting (besuchen)
bezeichnet).
-Eine Datei `finden' bedeutet, dass man den Inhalt dieser Datei mit
+Eine Datei finden bedeutet, dass man den Inhalt dieser Datei mit
Emacs bearbeitet -- es ist fast so, als ob man die Datei selbst
editiert. Jedoch werden nderungen an dieser Datei erst dann
dauerhaft, wenn man sie speichert; auf diese Weise wird vermieden,
@@ -621,9 +607,9 @@ die nderungen ein Fehler sind.
Wenn Sie die untere Bildschirmkante genauer betrachten, dann werden
Sie eine Zeile finden, die mit einem oder mehreren Bindestrichen
beginnt und endet; sie enthlt unter anderem die Zeichenkette
-`TUTORIAL.de'. An dieser Position befindet sich immer der Name der
-Datei, die Sie momentan bearbeiten (`visit'). Gerade in diesem
-Augenblick bearbeiten Sie eine Datei mit dem Namen `TUTORIAL.de'
+TUTORIAL.de. An dieser Position befindet sich immer der Name der
+Datei, die Sie momentan bearbeiten (visit). Gerade in diesem
+Augenblick bearbeiten Sie eine Datei mit dem Namen TUTORIAL.de
(genauer gesagt, Emacs hat eine identische Kopie geladen).
Die Befehle fr das Laden und Speichern von Dateien bestehen aus zwei
@@ -634,14 +620,14 @@ drei oder vier Zeichen lang -- Sie haben bereits C-x u und C-x 1
kennengelernt.
Um eine Datei in Emacs laden zu knnen, muss man dem Lade-Befehl den
-Namen der Datei mitteilen. Der Befehl `liest ein Argument vom
-Terminal' (in diesem Fall ist das der Name der Datei). Nachdem Sie
+Namen der Datei mitteilen. Der Befehl liest ein Argument (in diesem
+Fall ist das der Name der Datei). Nachdem Sie
C-x C-f (lade Datei)
eingegeben haben, werden Sie von Emacs nach dem Dateinamen gefragt.
Die Zeichen, die Sie eingeben, werden in der untersten Bildschirmzeile
-dargestellt, dem sogenannten Minipuffer (`minibuffer'). Sie knnen
+dargestellt, dem sogenannten Minipuffer (minibuffer). Sie knnen
ganz normale Emacs-Editierfunktionen verwenden, um den Dateinamen zu
ndern.
@@ -653,39 +639,42 @@ Minipuffer benutzen) mit C-g abbrechen.
ab (Sie haben also keine Datei geladen).
Wenn Sie den Dateinamen fertig eingegeben haben, drcken Sie <Return>,
-um den Befehl abzuschlieen; C-x C-f wird ausgefhrt und ldt die von
-Ihnen ausgesuchte Datei. Der Minipuffer verschwindet wieder, sobald
-C-x C-f beendet ist.
+um den Befehl abzuschlieen. Der Minipuffer verschwindet wieder, und
+C-x C-f ldt die von Ihnen ausgesuchte Datei.
-Ein paar Augenblicke spter erscheint der Dateiinhalt auf dem
-Bildschirm, und Sie knnen den Text editieren. Wenn Sie Ihre
-nderungen permanent speichern wollen, dann drcken Sie
+Der Dateiinhalt erscheint jetzt auf dem Bildschirm, und Sie knnen den
+Text editieren. Wenn Sie Ihre nderungen permanent speichern wollen,
+dann drcken Sie
C-x C-s (sichere Datei)
und Emacs kopiert den Text in die Datei. Beim ersten Mal benennt
Emacs die Originaldatei um, damit sie nicht verloren ist. Der neue
-Name besteht aus dem Originalnamen plus einer angehngten Tilde `~'
+Name besteht aus dem Originalnamen plus einer angehngten Tilde ~
[unter einigen Betriebssystemen wird statt dessen die
-Namenserweiterung durch `.bak' ersetzt].
+Namenserweiterung durch .bak ersetzt].
Emacs schreibt den Namen der gesicherten Datei in die unterste Zeile,
sobald C-x C-s fertig ausgefhrt ist. Sie sollten den editierten Text
oft speichern, damit nicht allzuviel bei einem etwaigen Systemabsturz
-verloren geht.
+verloren geht (siehe auch den Abschnitt AUTOMATISCHES SPEICHERN
+weiter unten).
+
+>> Geben Sie
+
+ C-x C-s TUTORIAL.de <Return>
->> Geben Sie C-x C-s ein, um Ihre Kopie der Einfhrung zu sichern.
- Die Ausgabe am unteren Bildschirmrand sollte `Wrote ...TUTORIAL.de'
- sein.
+ ein, um Ihre Kopie der Einfhrung zu sichern. Die Ausgabe am
+ unteren Bildschirmrand sollte Wrote ...TUTORIAL.de sein.
[Manche Terminals werden durch C-s angehalten und mssen durch C-q
-wieder `entsperrt' werden. Eine erste Abhilfe zur Umschiffung dieses
-C-s-Problems schafft die Befehlsfolge `M-x save-buffer', welche exakt
+wieder entsperrt werden. Eine erste Abhilfe zur Umschiffung dieses
+C-s-Problems schafft die Befehlsfolge M-x save-buffer, welche exakt
das gleiche wie C-x C-s bewirkt. Mehr Hilfe dazu finden Sie im
-Abschnitt `Spontaneous Entry to Incremental Search' im
+Abschnitt Spontaneous Entry to Incremental Search im
Emacs-Handbuch.]
-Sie knnen eine existierende Datei anschauen (`view') oder editieren.
+Sie knnen eine existierende Datei anschauen (view) oder editieren.
Sie knnen aber auch eine Datei laden, die noch gar nicht existiert,
um so eine neue Datei zu erzeugen: Sie ffnen dazu die
(nicht-existente) Datei, die natrlich leer ist, und beginnen dann
@@ -703,18 +692,8 @@ laden, dann bleibt die erste in Emacs. Sie knnen zur ersten
zurckschalten, indem Sie noch einmal C-x C-f eingeben. Auf diese
Weise lassen sich eine ganze Reihe von Dateien laden und bearbeiten.
->> Erzeugen Sie eine Datei mit dem Namen `foo', indem Sie
-
- C-x C-f foo <Return>
-
- eingeben. Tippen Sie etwas Text ein, editieren Sie ihn und
- speichern Sie ihn abschlieend mit C-x C-s. Kehren Sie
- anschlieend zu dieser Einfhrung zurck mit
-
- C-x C-f TUTORIAL.de <Return>
-
Emacs speichert jeden Text, der aus einer Datei in Emacs geladen wird,
-in einem `Puffer'-Objekt. Um eine Liste der momentan existierenden
+in einem Puffer-Objekt. Um eine Liste der momentan existierenden
Puffer zu sehen, geben Sie
C-x C-b (liste Puffer auf)
@@ -726,7 +705,7 @@ ein.
Beachten Sie, dass jeder Puffer einen Namen hat und manche auch mit
dem Namen einer Datei assoziiert sind, dessen Inhalt sie enthalten.
Manche Puffer aber haben keinen zugehrige Datei, z.B. der mit dem
-Namen `*Buffer List*'. Er wurde von dem Befehl C-x C-b erzeugt, um
+Namen *Buffer List*. Er wurde von dem Befehl C-x C-b erzeugt, um
die Pufferliste darzustellen. JEDER Text, den Sie innerhalb Emacs in
einem Fenster sehen, ist immer ein Ausschnitt eines Puffers.
@@ -734,28 +713,39 @@ einem Fenster sehen, ist immer ein Ausschnitt eines Puffers.
zu lassen.
Wieviele Puffer auch in Emacs geladen sind, nur ein einziger ist der
-`momentane' Puffer, nmlich derjenige, den Sie gerade editieren. Will
+momentane Puffer, nmlich derjenige, den Sie gerade editieren. Will
man einen anderen Puffer editieren, muss man zuerst zu diesem Puffer
-wechseln (`switch'). Wie schon weiter oben erklrt, kann man mittels
+wechseln (switch). Wie schon weiter oben erklrt, kann man mittels
C-x C-f zu einem Puffer wechseln, der zu einer Datei gehrt. Emacs
hat jedoch einen einfacheren Befehl, C-x b, um einen beliebigen Puffer
namentlich auszuwhlen.
->> Geben Sie C-x b foo <Return> ein, um zurck zum Puffer `foo' zu
- schalten, der den Text der Datei `foo' enthlt. Anschlieend geben
- Sie C-x b TUTORIAL.de <RETURN> ein, um wieder zu dieser Einfhrung
- zu gelangen.
+>> Geben Sie
+
+ C-x C-f foo <Return>
+
+ ein, um eine Datei mit dem Namen foo zu erzeugen. Mittels
+
+ C-x b TUTORIAL.de <RETURN>
+
+ gelangen Sie wieder zu dieser Einfhrung.
In der Regel ist der Puffername identisch zu einem Dateinamen (ohne
den Verzeichnisprfix), jedoch nicht immer. Die von C-x C-b erzeugte
-Pufferliste zeigt stets die Namen aller Puffer.
+Pufferliste zeigt stets die Namen aller Puffer mit den
+korrespondierenden Dateinamen.
JEDER Text in Emacs ist Teil eines Puffers, aber nicht jeder Puffer
-entspricht einer Datei. So ist z.B. der Puffer `*Buffer List*' mit
+entspricht einer Datei. So ist z.B. der Puffer *Buffer List* mit
keiner Datei assoziiert -- er wurde direkt von dem Befehl C-x C-b
-erzeugt. Genauso hat der Puffer `*Messages*' keine Entsprechung als
-Datei; er enthlt alle Mitteilungen, die in der untersten Zeile
-whrend des Arbeitens mit Emacs erscheinen.
+erzeugt. Auch dieser TUTORIAL.de-Puffer war anfangs keiner Datei
+zugeordnet, jetzt allerdings schon, denn Sie haben im letzten
+Abschnitt den Befehl C-x C-s eingegeben und so den Pufferinhalt als
+Datei gespeichert.
+
+Der Puffer *Messages* hat ebenfalls keine Entsprechung als Datei; er
+enthlt alle Mitteilungen, die in der untersten Zeile whrend des
+Arbeitens mit Emacs erscheinen.
>> Geben Sie C-x b *Messages* <Return> ein, um sich den
Mitteilungspuffer anzuschauen.
@@ -778,7 +768,7 @@ Sie ihn speichern wollen.
>> Fgen Sie eine Textzeile ein und drcken Sie dann C-x s.
Emacs fragt Sie jetzt, ob Sie einen Puffer mit dem Namen
- TUTORIAL.de speichern wollen. Bejahen Sie, indem Sie `y' drcken.
+ TUTORIAL.de speichern wollen. Bejahen Sie, indem Sie y drcken.
[Anmerkung: Sie verndern nicht die Originaldatei, sondern eine
persnliche Kopie.]
@@ -793,7 +783,7 @@ sie trotzdem alle benutzen zu knnen, gibt es zwei Erweiterungen:
C-x Zeichenerweiterung. Gefolgt von einem Zeichen.
M-x Befehlserweiterung. Gefolgt von einem (langen) Namen.
-[Das `x' steht fr das englische Wort `extension'.] Diese beiden
+[Das x steht fr das englische Wort extension.] Diese beiden
Befehle sind prinzipiell sehr ntzlich, werden aber weniger oft
bentigt als die bisher vorgestellten. Sie haben bereits mehrere
Befehle aus der ersten Kategorie kennengelernt; unter anderem C-x C-f,
@@ -804,31 +794,25 @@ vielleicht vergessen haben, Daten oder Text zu sichern -- Emacs fragt
bei jedem gendertem Puffer (bzw. Datei), ob er gespeichert werden
soll.
-C-z ist der Befehl um Emacs *zeitweise* zu verlassen; es ist also
-mglich, spter an der unterbrochenen Stelle nahtlos weiterzuarbeiten.
-
-Auf den meisten Systemen wie Linux oder FreeBSD wird Emacs
-`suspendiert', wenn Sie C-z drcken, d.h., Sie kehren zurck zur
-Eingabezeile des Betriebssystems, ohne Emacs zu beenden. In der Regel
-knnen Sie dann mittels des Befehls `fg' bzw. `%emacs' wieder zu Emacs
-umschalten. Unter graphischen Oberflchen wie X11 bewirkt C-z in der
-Regel, dass Emacs ikonofiziert wird, also als Ikone (`Icon') darauf
-wartet, mit einem Mausklick bei Bedarf wieder vergrert zu werden.
+Unter graphischen Oberflchen wie X bewirkt C-z in der Regel, dass
+Emacs ikonofiziert wird, also als Ikone (Icon) darauf wartet, mit
+einem Mausklick bei Bedarf wieder vergrert zu werden. Auf einem
+Textterminal dagegen wird Emacs suspendiert, wenn Sie C-z drcken,
+d.h., Sie kehren zurck zur Eingabezeile des Terminals, ohne Emacs zu
+beenden, und knnen beliebige andere Befehle ausfhren. In der Regel
+knnen Sie spter mittels des Befehls fg bzw. %emacs wieder zu
+Emacs umschalten.
Bei Betriebssystemen bzw. Shells, die Suspension von Programmen nicht
implementiert haben (z.B. MS-DOS), startet C-z einen
-System-Befehlsinterpreter innerhalb von Emacs (`subshell').
-Normalerweise mssen Sie dann `exit' in die Befehlszeile schreiben, um
+System-Befehlsinterpreter innerhalb von Emacs (subshell).
+Normalerweise mssen Sie dann exit in die Befehlszeile schreiben, um
zu Emacs zurckzukehren.
Der beste Zeitpunkt fr C-x C-c ist, wenn Sie sich ausloggen
(bzw. Ihren Computer ausschalten); Sie sollten Emacs ebenfalls
beenden, wenn Sie Emacs von einem anderen Programm aus aufgerufen
-haben (z.B. einem Programm, das E-mails liest), da solche Programme
-oft nicht wissen, wie sie mit Emacs im Suspend-Modus umgehen sollen.
-In allen anderen Fllen ist es meistens gnstiger, C-z zu benutzen und
-Emacs nicht zu beenden, damit man im Bedarfsfalle sofort an der
-gleichen Stelle weiterarbeiten kann.
+haben (z.B. einem Programm, das E-mails liest).
Hier ist eine Liste aller C-x-Befehle, die Sie bereits kennengelernt
haben:
@@ -846,19 +830,19 @@ Ein Beispiel fr einen Befehl mit langen Namen ist replace-string, der
global (also in der ganzen Datei bzw. Puffer) eine Zeichenkette durch
eine andere ersetzt. Wenn Sie M-x drcken, dann fragt Sie Emacs in
der untersten Bildschirmzeile nach dem Namen des Befehls (in diesem
-Fall `replace-string'). Geben Sie jetzt `repl s<TAB>' ein und Emacs
+Fall replace-string). Geben Sie jetzt repl s<TAB> ein und Emacs
vervollstndigt den Namen. Schlieen Sie die Eingabe mit <Return> ab.
[<TAB> bezeichnet die Tabulatortaste.]
>> Bewegen Sie den Cursor zu der leeren Zeile sechs Zeilen unter
dieser. Geben Sie dann
- M-x repl s<Return>Bildschirm<Return>Text<Return>
+ M-x repl s <Return> Bildschirm <Return> Text <Return>
ein und kehren Sie mit C-u C-SPC an diese Position zurck.
Beachten Sie wie diese Bildschirmzeile jetzt aussieht: Sie haben
- den Wortteil B-i-l-d-s-c-h-i-r-m durch `Text' ersetzt (und zwar im
+ den Wortteil B-i-l-d-s-c-h-i-r-m durch Text ersetzt (und zwar im
ganzen Dokument beginnend von der Cursorposition).
>> Drcken Sie jetzt C-x u, um diese nderungen auf einmal rckgngig
@@ -872,17 +856,17 @@ Haben Sie nderungen an einem Dokument vorgenommen, sie jedoch nicht
gespeichert, dann knnen sie verloren gehen, falls der Computer
abstrzt. Um Sie davor zu schtzen, sichert Emacs in bestimmten
Zeitintervallen jede von Ihnen editierte Datei in sogenannten
-`auto save'-Dateien. Sie sind daran zu erkennen, dass sie mit einem #
-beginnen und enden; z.B. ist `#hello.c#' der Name der Auto-Save-Datei
-von `hello.c'. Wenn Sie Ihren Text auf normalem Wege speichern, wird
+auto save-Dateien. Sie sind daran zu erkennen, dass sie mit einem #
+beginnen und enden; z.B. ist #hello.c# der Name der Auto-Save-Datei
+von hello.c. Wenn Sie Ihren Text auf normalem Wege speichern, wird
die Auto-Save-Datei gelscht.
Strzt der Rechner einmal wirklich ab, knnen Sie die nderungen, die
beim letzten Auto-Save gespeichert worden sind, folgendermaen
wiederherstellen: Laden Sie die Datei auf normalem Wege (die Datei,
die Sie bearbeitet haben, nicht die Auto-Save-Datei) und geben Sie
-dann `M-x recover-file<Return>' ein. Wenn Emacs Sie um Besttigung
-fragt, antworten Sie mit `yes<Return>', um den Inhalt der
+dann M-x recover-file <Return> ein. Wenn Emacs Sie um Besttigung
+fragt, antworten Sie mit yes <Return>, um den Inhalt der
Auto-Save-Datei zu bernehmen.
@@ -890,8 +874,8 @@ Auto-Save-Datei zu bernehmen.
------------------
Geben Sie Befehle langsam ein, dann zeigt Ihnen Emacs Ihre eigene
-Eingabe am unteren Bildschirmrand im sogenannten Echo-Bereich (`echo
-area'). Der Echo-Bereich enthlt die unterste Bildschirmzeile.
+Eingabe am unteren Bildschirmrand im sogenannten Echo-Bereich (echo
+area). Der Echo-Bereich enthlt die unterste Bildschirmzeile.
[Mini-Puffer und Echo-Bereich fallen normalerweise zusammen, sind aber
nicht das gleiche, da innerhalb des Echo-Bereiches nichts eingegeben
@@ -902,30 +886,30 @@ werden kann.]
------------------
Die Bildschirmzeile unmittelbar ber dem Echo-Bereich ist die
-Statuszeile (`mode line'). Sie schaut ungefhr so aus:
+Statuszeile (mode line). Sie schaut ungefhr so aus:
--1:** TUTORIAL.de 59% L905 (Fundamental)----------------------
+-1:**- TUTORIAL.de 58% L891 (Fundamental)
Diese Zeile gibt ntzliche Hinweise ber den momentanen Zustand von
Emacs und den Text, den Sie gerade editieren.
-Sie wissen bereits, was der Dateiname bedeutet. `--NN%--' zeigt die
-momentane Position innerhalb des Textes an: NN Prozent davon sind
-oberhalb des Bildschirms. Ist der Dateianfang zu sehen, dann
-erscheint `Top' anstelle von `00%'. Analog dazu erscheint `Bot' (fr
-das englische Wort `bottom'), wenn das Dateiende sichtbar ist. Wenn
-Sie einen Text betrachten, der komplett auf den Bildschirm passt, dann
-erscheint `All'.
+Sie wissen bereits, was der Dateiname bedeutet. NN% zeigt die
+momentane Position innerhalb des Puffertextes an: NN Prozent davon
+sind oberhalb des Bildschirms. Ist der Dateianfang zu sehen, dann
+erscheint Top anstelle von 00%. Analog dazu erscheint Bot (fr
+das englische Wort bottom), wenn das Dateiende sichtbar ist. Wenn
+Sie einen Puffer betrachten, der komplett auf den Bildschirm passt,
+dann erscheint All.
-Das `L' und die nachfolgenden Ziffern geben die aktuelle Zeilennummer
+Das L und die nachfolgenden Ziffern geben die aktuelle Zeilennummer
an, in der sich der Cursor befindet.
-Am Anfang der Zeile sehen Sie `-1:**'. Die Zeichen vor dem
+Am Anfang der Zeile sehen Sie -1:**-. Die Zeichen vor dem
Doppelpunkt geben an, in welcher Kodierung der Text ist und welche
Eingabemethode verwendet wird. Dazu mehr weiter unten im Abschnitt
-`MULE'.
+MULE.
-[Anstelle des Doppelpunktes knnen auch ein `\' und `/' stehen, falls
+[Anstelle des Doppelpunktes knnen auch ein \ und / stehen, falls
Sie Dateien editieren, die der MS-DOS- bzw. der
Macintosh-Textkonvention folgen: MS-DOS verwendet als
Zeilenvorschubzeichen CR-LF (Carriage Return gefolgt von Linefeed),
@@ -938,24 +922,24 @@ Prozentzeichen nach dem Doppelpunkt stehen fr eine Datei, die nur
gelesen, aber nicht editiert werden kann.
Der eingeklammerte Teil gibt an, in welchem Editiermodus Sie sich
-befinden. Der Standardmodus heit `Fundamental' (Sie verwenden ihn
-gerade); er ist ein Beispiel fr einen Hauptmodus (`major mode').
+befinden. Der Standardmodus heit Fundamental (Sie verwenden ihn
+gerade); er ist ein Beispiel fr einen Hauptmodus (major mode).
Emacs hat viele Hauptmodi implementiert. Manche davon werden fr
verschiedene (Computer-)Sprachen und/oder Textarten verwendet,
z.B. Lisp-Modus, Text-Modus usw. Es kann immer nur ein Hauptmodus
aktiviert sein, und der Name befindet sich dort, wo jetzt gerade
-`Fundamental' steht.
+Fundamental steht.
Einige Befehle verhalten sich jeweils in verschiedenen Hauptmodi
anders. Es gibt zum Beispiel einen Befehl, um einen Kommentar in den
Quellcode eines Computerprogramm einzufgen -- die Tastenfolge dafr
ist zwar (in der Regel) die gleiche, doch wird ein Kommentar mit der
fr die aktuelle Programmiersprache gltigen Syntax eingefgt
-(z.B. `// ...' fr ein Programm in C++ oder `; ...' fr Lisp). Um in
+(z.B. // ... fr ein Programm in C++ oder ; ... fr Lisp). Um in
einen Hauptmodus zu schalten, hngen Sie einfach das englische Wort
-`-mode' an den (kleingeschriebenen) Namen des Modus an und fhren den
-Befehl mittels M-x aus. Beispiel: `M-x fundamental-mode' schaltet in
+-mode an den (kleingeschriebenen) Namen des Modus an und fhren den
+Befehl mittels M-x aus. Beispiel: M-x fundamental-mode schaltet in
den Fundamental-Modus. Weitere wichtige Modi sind c-mode, perl-mode,
lisp-mode, text-mode u.a. Die meisten davon werden automatisch
aktiviert, und zwar entsprechend der Namenserweiterung der zu ladenden
@@ -965,30 +949,30 @@ C-Modus aktiviert.
Wenn Sie deutschen oder englischen Text bearbeiten, dann sollten Sie
den Textmodus verwenden. [Falls Ihre Tastatur keine Umlaut-Tasten
hat, mssen Sie noch einen weiteren Nebenmodus aktivieren. Lesen Sie
-dazu den Abschnitt `MULE' weiter unten.]
+dazu den Abschnitt MULE weiter unten.]
->> Geben Sie `M-x text mode<Return>' ein.
+>> Geben Sie M-x text-mode <Return> ein.
Sie brauchen keine Angst zu haben, dass sich die bisher dargestellte
Tastaturbelegung von Emacs stark ndert. Beobachten Sie z.B. die
Befehle M-f und M-b: Apostrophe werden nun als Teil eines Wortes
betrachtet (wie man's leicht an diesem Beispiel ausprobieren kann),
wohingegen im Fundamentalmodus Apostrophe als Worttrenner
-(`word-separator') behandelt werden.
+(word-separator) behandelt werden.
Normalerweise ist das eben genannte Beispiel die Methode von
-Hauptmodi: Die meisten Befehle tun `das gleiche', arbeiten aber
+Hauptmodi: Die meisten Befehle tun das gleiche, arbeiten aber
jeweils ein bisschen anders.
Dokumentation zum derzeit aktuellen Hauptmodus bekommen Sie mit C-h m.
->> Drcken Sie C-u C-v ein- oder mehrmals, um diese Zeile in die Nhe
- des oberen Bildschirmrands zu bringen.
+>> Drcken Sie C-l C-l, um diese Zeile an den oberen Bildschirmrand zu
+ bringen.
>> Lesen Sie nun mittels C-h m die englische Dokumentation zum
Textmodus.
>> Entfernen Sie schlielich das Dokumentationsfenster mit C-x 1.
-Neben den Hauptmodi gibt es auch Nebenmodi (`minor modes'). Nebenmodi
+Neben den Hauptmodi gibt es auch Nebenmodi (minor modes). Nebenmodi
sind keine Alternativen zu Hauptmodi, sondern stellen Ergnzungen zur
Verfgung, die (normalerweise) in allen Hauptmodi funktionieren
(z.B. der berschreibmodus: Zeichen werden nicht eingefgt, sondern
@@ -998,20 +982,20 @@ Sie knnen zu Ihrem Hauptmodus keinen, einen oder sogar mehrere
Nebenmodi haben.
Ein Nebenmodus, welcher uerst ntzlich ist, besonders fr das
-Editieren von Text, ist der automatische Zeilenumbruch (`Auto Fill
-mode'). Ist dieser Modus aktiviert, dann bricht Emacs die laufende
+Editieren von Text, ist der automatische Zeilenumbruch (Auto Fill
+mode). Ist dieser Modus aktiviert, dann bricht Emacs die laufende
Zeile selbstttig zwischen Wrtern um, sobald sie zu lang wird.
-Sie knnen den Zeilenumbruchmodus einschalten mittels `M-x auto fill
-mode<Return>'. Wenn der Modus aktiviert ist, knnen Sie ihn mit dem
-gleichen Befehl wieder ausschalten. Mit anderen Worten, der Befehl
-verhlt sich wie ein Lichttaster, der bei Bettigung entweder das
-Licht ein- oder ausschaltet, je nachdem, ob das Licht vorher
+Sie knnen den Zeilenumbruchmodus mittels M-x auto-fill-mode
+<Return> einschalten. Wenn der Modus aktiviert ist, knnen Sie ihn
+mit dem gleichen Befehl wieder ausschalten. Mit anderen Worten, der
+Befehl verhlt sich wie ein Lichttaster, der bei Bettigung entweder
+das Licht ein- oder ausschaltet, je nachdem, ob das Licht vorher
ausgeschaltet bzw. eingeschaltet war. Wir sagen, dass dieser Befehl
-den Modus umschaltet (`toggle').
+den Modus umschaltet (toggle).
->> Geben Sie nun M-x auto fill mode<Return> ein. Fgen Sie
- anschlieend eine Zeile ein, die aus lauter `asdf ' besteht, und
+>> Geben Sie nun M-x auto-fill-mode <Return> ein. Fgen Sie
+ anschlieend eine Zeile ein, die aus lauter asdf besteht, und
zwar so lange, bis die Zeile automatisch umgebrochen wird.
Vergessen Sie nicht, Leerzeichen einzugeben, da nur dort ein
Umbruch erfolgt.
@@ -1038,56 +1022,56 @@ Absatzes stehen muss.
* SUCHEN
--------
-Emacs kann Zeichenketten (`strings') entweder in Richtung Pufferende
-(vorwrts, `forward') oder in Richtung Pufferanfang (rckwrts,
-`backward') suchen. Gleichzeitig wird der Cursor an die nchste
-Stelle bewegt, wo diese Zeichenkette erscheint.
+Emacs kann Zeichenketten (strings, eine Folge von zusammenhngenden
+Zeichen) entweder in Richtung Pufferende (vorwrts, forward) oder in
+Richtung Pufferanfang (rckwrts, backward) suchen. Gleichzeitig
+wird der Cursor an die nchste Stelle bewegt, wo diese Zeichenkette
+erscheint.
-Hier unterscheidet sich Emacs von vielen anderen Editoren, da nmlich
-die Standard-Suchoperation inkrementelles Suchen ist, d.h., die Suche
-beginnt dann, wenn Sie die Zeichen eingeben.
+Die Standard-Suchoperation von Emacs ist inkrementelles Suchen, d.h.,
+die Suche beginnt dann, wenn Sie die Zeichen eingeben.
Der Befehl fr Vorwrtssuchen ist C-s und C-r fr Rckwrtssuchen.
ABER HALT! Probieren Sie bitte diese Befehle noch nicht.
-Wenn Sie C-s eingeben, dann erscheint die Zeichenkette `I-search:' als
+Wenn Sie C-s eingeben, dann erscheint die Zeichenkette I-search: als
Eingabeaufforderung im Echobereich. Das bedeutet, dass Emacs jetzt
eine inkrementellen Suche ausfhrt und darauf wartet, dass Sie die zu
suchende Zeichenkette eingeben. <Return> beendet die Suche.
>> Geben Sie jetzt C-s ein, um einen Suchvorgang zu starten. Schreiben
- Sie LANGSAM, einen Buchstaben nach dem anderen, das Wort `Cursor',
+ Sie LANGSAM, einen Buchstaben nach dem anderen, das Wort Cursor,
und warten Sie jeweils ab, was mit dem Cursor passiert. Sie haben
- jetzt das Wort `Cursor' einmal gefunden.
+ jetzt das Wort Cursor einmal gefunden.
>> Drcken Sie C-s noch einmal, um die nchste Stelle zu suchen, wo das
- Wort `Cursor' vorkommt.
->> Drcken Sie nun <Delete> viermal und beobachten Sie, wie der Cursor
+ Wort Cursor vorkommt.
+>> Drcken Sie nun <DEL> viermal und beobachten Sie, wie der Cursor
zurckspringt.
>> Beenden Sie die Suche mit <Return>.
Verstehen Sie, was gerade vorgegangen ist? Emacs versucht whrend
einer inkrementellen Suche zu der Stelle zu gehen, wo die Zeichenkette
steht, die Sie bis jetzt eingegeben haben. Um die darauffolgende
-Position zu suchen, wo `Cursor' steht, gengt es, noch einmal C-s zu
+Position zu suchen, wo Cursor steht, gengt es, noch einmal C-s zu
bettigen. Wenn es keine nchste Position gibt, dann ertnt ein
kurzer Ton, und Emacs sagt Ihnen, dass die Suche im Augenblick
-fehlschlgt (`failing'). C-g beendet ebenfalls einen Suchvorgang.
+fehlschlgt (failing). C-g beendet ebenfalls einen Suchvorgang.
Wenn Sie sich mitten in einer inkrementellen Suche befinden und
-<Delete> drcken, wird das letzte Zeichen im Suchstring gelscht, und
+<DEL> drcken, wird das letzte Zeichen im Suchstring gelscht, und
der Cursor springt zurck auf die letzte Suchposition. Angenommen,
-Sie haben `c' eingegeben, um das erste Auftreten von `c' zu suchen.
-Geben Sie jetzt `u' ein, dann springt der Cursor zu dem ersten
-Auftreten der Zeichenkette `cu'. Wenn Sie jetzt mit <Delete> das `u'
-vom Suchstring lschen, dann springt der Cursor zurck zum ersten `c'.
-Drcken Sie dagegen ein paar mal C-s, um weitere `cu'-Zeichenketten zu
-finden, dann bewirkt <Delete>, dass Sie zum letzten Auftreten von `cu'
-zurckspringen, und erst wenn es kein weiteres `cu' mehr gibt, springt
-der Cursor zum ersten `c' zurck.
+Sie haben c eingegeben, um das erste Auftreten von c zu suchen.
+Geben Sie jetzt u ein, dann springt der Cursor zu dem ersten
+Auftreten der Zeichenkette cu. Wenn Sie jetzt mit <DEL> das u
+vom Suchstring lschen, dann springt der Cursor zurck zum ersten c.
+Drcken Sie dagegen ein paar mal C-s, um weitere cu-Zeichenketten zu
+finden, dann bewirkt <DEL>, dass Sie zum letzten Auftreten von cu
+zurckspringen, und erst wenn es kein weiteres cu mehr gibt, springt
+der Cursor zum ersten c zurck.
Die Suche wird ebenfalls beendet, wenn Sie ein CONTROL- oder
-META-Zeichen eingeben (mit ein paar Ausnahmen -- Zeichen, die
-bei einer Suche speziell gehandhabt werden wie C-s oder C-r).
+META-Zeichen eingeben (mit ein paar Ausnahmen -- Zeichen, die bei
+einer Suche speziell gehandhabt werden wie C-s oder C-r).
C-s versucht, die Zeichenkette NACH der aktuellen Cursorposition zu
finden. Wollen Sie etwas davor suchen, mssen Sie C-r verwenden. Das
@@ -1101,7 +1085,11 @@ Suchrichtung.
Eine weitere, ntzliche Fhigkeit von Emacs ist die Mglichkeit, mehr
als ein Fenster zur gleichen Zeit auf dem Bildschirm darzustellen.
->> Bewegen Sie den Cursor zu dieser Zeile und geben Sie C-u 0 C-l ein.
+[Der Unterschied zu graphischen Fenstern im herkmmlichen Sinn
+(frame in der Emacs-Terminologie) wurde bereits weiter oben
+besprochen.]
+
+>> Bewegen Sie den Cursor zu dieser Zeile und geben Sie C-l C-l ein.
>> Drcken Sie nun C-x 2, um den Bildschirm in zwei Fenster zu teilen.
Beide Fenster zeigen diese Einfhrung an, und der Cursor bleibt im
@@ -1111,8 +1099,8 @@ als ein Fenster zur gleichen Zeit auf dem Bildschirm darzustellen.
statt dessen auch ESC C-v verwenden, falls Sie keine META-Taste
haben; siehe auch weiter unten).
->> Mittels C-x o (das `o' steht fr das englische Wort `other', `das
- andere') knnen Sie den Cursor in das untere Fenster bewegen.
+>> Mittels C-x o (das o steht fr das englische Wort other, das
+ andere) knnen Sie den Cursor in das untere Fenster bewegen.
>> Bentzen Sie C-v und M-v, um im unteren Fenster zu blttern. Lesen
Sie die Emacs-Einfhrung jedoch im oberen Fenster weiter.
@@ -1122,16 +1110,16 @@ als ein Fenster zur gleichen Zeit auf dem Bildschirm darzustellen.
C-x o ist der Befehl, um zwischen (Emacs-)Fenstern hin- und
herzuschalten. Jedes Fenster hat eine eigene Cursorposition, aber nur
-das aktuelle Fenster zeigt den Cursor an (unter X11 wird die
-nicht-aktuelle Cursorposition durch ein leeres Rechteck dargestellt).
-Alle normalen Editierbefehle betreffen das Fenster, in dem sich der
-Cursor befindet. Wir nennen dieses Fenster `ausgewhlt' (`selected
-window').
+das aktuelle Fenster zeigt den Cursor an (auf einer graphischen
+Oberflche wird die nicht-aktuelle Cursorposition durch ein leeres
+Rechteck dargestellt). Alle normalen Editierbefehle betreffen das
+Fenster, in dem sich der Cursor befindet. Wir nennen dieses Fenster
+ausgewhlt (selected window).
Der Befehl M-C-v ist sehr ntzlich, wenn man Text in einem Fenster
-editiert und das andere Fenster als Referenz verwendet. Der Cursor
-bleibt stets im gleichen Arbeitsfenster, und mit M-C-v kann man bequem
-vorwrtsblttern.
+editiert und das andere Fenster als Referenz verwendet. Ohne das
+momentante Arbeitsfenster verlassen zu mssen, kann man mit M-C-v im
+anderen Fenster bequem vorwrtsblttern.
M-C-v ist ein Beispiel eines CONTROL-META-Zeichens. Haben Sie eine
META-Taste, dann kann man M-C-v erzeugen, indem man CTRL und META
@@ -1147,24 +1135,24 @@ META oder CTRL.
Der umgekehrte Befehl zu M-C-v ist M-C-S-v, um im anderen Fenster
rckwrts zu blttern (d.h., Sie mssen die META-Taste sowie die
-CONTROL- und SHIFT-Taste zusammen mit `v' bettigen) -- jetzt werden
+CONTROL- und SHIFT-Taste zusammen mit v bettigen) -- jetzt werden
Sie wahrscheinlich verstehen, warum manche Kritiker das Wort Emacs als
Abkrzung von Escape-Meta-Alt-Control-Shift betrachten. Leider
funktioniert diese Befehlsfolge normalerweise nur mit graphischen
-Oberflchen wie X11, da C-v von C-S-v auf den meisten Textterminals
-nicht unterschieden werden kann.
+Oberflchen, da C-v von C-S-v auf den meisten Textterminals nicht
+unterschieden werden kann.
-[Unter X11 kann man auerdem in der Regel mit den bequemeren
-Tastenkombinationen META-`Bild mit Aufwrtspfeil' bzw. META-`Bild mit
-Abwrtspfeil' ebenfalls im anderen Fenster rck- bzw. vorwrts
-blttern.]
+[Auf graphischen Oberflchen kann man auerdem in der Regel mit den
+bequemeren Tastenkombinationen META-Bild mit Aufwrtspfeil
+bzw. META-Bild mit Abwrtspfeil ebenfalls im anderen Fenster rck-
+bzw. vorwrts blttern.]
>> Entfernen Sie mit C-x 1 (eingegeben im oberen Fenster) das untere
Fenster.
(Htten Sie C-x 1 im unteren Fenster eingegeben, dann wre das obere
-Fenster geschlossen worden -- eine Eselsbrcke fr C-x 1 ist `ich will
-nur das *eine* Fenster, in dem ich mich gerade befinde.')
+Fenster geschlossen worden -- eine Eselsbrcke fr C-x 1 ist ich will
+nur das *eine* Fenster, in dem ich mich gerade befinde.)
Sie mssen nicht den gleichen Puffer in beiden Fenstern darstellen.
Wenn Sie C-x C-f verwenden, um in einem Fenster eine Datei zu laden,
@@ -1184,11 +1172,42 @@ Texte darzustellen:
Sie C-x 1 ein, um das untere Fenster zu schlieen.
+* MEHRFACHE RAHMEN
+------------------
+
+Emacs kann auch mehrfache Rahmen erzeugen, sobald das Programm auf
+einer graphischen Oberflche ausgefhrt wird. In der
+Emacs-Terminologie bezeichnet ein Rahmen eine Gruppe von Fenstern,
+gemeinsam mit deren Menus, Scrollbars, Echo-Bereichen, usw. Auf einem
+Textterminal kann genau ein Rahmen dargestellt werden.
+
+>> Geben Sie
+
+ M-x make-frame <Return>
+
+ ein, um einen neuen Rahmen zu erzeugen.
+
+Alles, was Sie im ursprnglichen, ersten Rahmen tun knnen,
+funktioniert genauso im neuen Rahmen. Beide Rahmen sind also vllig
+gleichwertig.
+
+>> Geben Sie
+
+ M-x delete-frame <Return>
+
+ ein, um den ausgewhlten Rahmen zu entfernen.
+
+Ein Rahmen kann auch mit der normalen Methode der graphischen
+Oberflche entfernt werden; meistens gibt es dafr einen Knopf mit
+einem X in der linken oder rechten oberen Ecke des Rahmens. Wird
+der letzte Rahmen geschlossen, beendet man Emacs, wie erwartet.
+
+
* REKURSIVE EDITIER-EBENEN
--------------------------
Manchmal kann es passieren, dass Sie in eine sogenannte rekursive
-Editier-Ebene geraten (`recursive editing level'). Sie knnen das an
+Editier-Ebene geraten (recursive editing level). Sie knnen das an
den eckigen Klammern in der Statuszeile erkennen, welche den
derzeitigen Hauptmodus zustzlich umschlieen, z.B. [(Fundamental)]
anstelle von (Fundamental).
@@ -1211,91 +1230,49 @@ dargestellt. Details finden Sie im Emacs-Handbuch beschrieben.
* MULE
------
-Mule ist die Abkrzung fr `Multi-lingual Enhancement to GNU Emacs'.
+Mule ist die Abkrzung fr Multi-lingual Enhancement to GNU Emacs.
Frher wurde damit eine spezielle Emacs-Variante bezeichnet, die
allerdings seit der Version 20 mit Emacs verschmolzen ist.
Emacs untersttzt eine groe Anzahl von internationalen Zeichenstzen,
z.B. verschiedene europische Varianten des lateinischen Alphabets,
Chinesisch, Russisch oder Thai, um nur einige zu nennen. In dieser
-Einfhrung wird jedoch nur auf den deutschen Zeichensatz sowie
+Einfhrung wird jedoch nur auf Unicode und Latin-1 sowie
Eingabemglichkeiten fr Deutsch nher eingegangen.
-Der Standard-Zeichensatz fr Deutsch ist Latin-1 (auch bekannt unter
-dem Namen ISO-8859-1), obwohl Unicode -- und da besonders die
-Kodierungsvariante UTF-8 -- sich immer mehr durchzusetzt. Wenn
-anstelle der deutschen Umlaute unansehnliche Konstrukte wie `\201'
-dargestellt werden, dann ist die sogenannte
-Multibyte-Zeichenuntersttzung deaktiviert (intern werden in Emacs
-Nicht-ASCII-Zeichenstze durch mehr als ein Byte reprsentiert). Der
-Befehl `M-x toggle-enable-multibyte-characters' aktiviert die
-Multibyte-Zeichenuntersttzung. Denken Sie daran, die Tabulatortaste
-zur Vervollstndigung von Befehlsnamen zu bentzen, z.B. `M-x
-toggle-e<TAB><Return>'.
-
-Wenn anstelle der Umlaute `', `' oder `' die Zeichen `d', `v' und
-`|' erscheinen (also `kleines D', `kleines V' und ein senkrechter
-Strich), dann wird das achte Bit von jedem Byte abgeschnitten, sodass
-nur ASCII-Zeichen dargestellt werden knnen. In der Regel gibt es
-zwei Ursachen fr dieses Problem: Sie haben sich nicht `8-bit clean'
-(z.B. mittels `telnet -8 ...') eingeloggt oder Ihr
-Telekommunikationsprogramm ist nicht fr 8-bit konfiguriert. Beides
-ist heutzutage eher unwahrscheinlich, daher wird hier nicht weiter
-darauf eingegangen.
-
->> Geben Sie `M-x toggle-enable-multibyte-characters' ein. Die
- deutschen Umlaute (so sie von Ihrem Terminal darstellbar sind)
- verschwinden und werden durch Zahlenkonstrukte ersetzt. So wird
- zum Beispiel Umlaut a (`') dargestellt als `\201'.
-
->> Aktivieren Sie wieder die Multibyte-Zeichenuntersttzung mittels
- `M-x toggle-enable-multibyte-characters'.
-
-Sehen Sie anstelle der Umlaute leere Kstchen (unter X11 oder anderen
-graphischen Oberflchen), sollten Sie Emacs mit C-x C-c beenden und
-folgendermaen neu starten:
-
- emacs -fn fontset-standard
-
-Sie knnen auch probieren, Emacs mit der `--unibyte'-Option zu
-starten, um Latin-1-Zeichen direkt darzustellen.
-
-Falls das alles nichts ntzt oder Sie Fragezeichen anstelle der
-Umlaute auf ihrem Textterminal sehen, sollten Sie sich an Ihren
-Systemadministrator wenden und sich beschweren, dass kein
-Latin-1-Zeichensatz installiert ist (was heutzutage eigentlich eine
-Selbstverstndlichkeit sein sollte). Falls statt der Umlaute andere
-Zeichen auf ihrem Textterminal erscheinen (z.B. kyrillische
-Buchstaben), dann erkundigen Sie sich, wie sie auf Latin-1 umschalten
-knnen.
-
-Lesen Sie im Emacs-Handbuch nach unter dem Stichwort `International',
+Lesen Sie im Emacs-Handbuch unter dem Stichwort International nach,
welche weitere Optionen es bezglich Zeichenstze gibt.
-Ist die Sprachumgebung (`locale') Ihres Betriebssystems korrekt auf
-Deutsch gesetzt, verwendet Emacs diese Einstellungen automatisch.
-Anderenfalls empfiehlt es sich, Latin-1 als Standardkodierung zu
-aktivieren, wenn Sie primr Deutsch verwenden. Benutzen Sie zu diesem
-Zweck die Befehlsfolge
-
- C-x <Return> l latin-1 <Return>
-
-(C-x <Return> l fhrt die Funktion set-language-environment aus), um
-in einer laufenden Emacs-Sitzung auf Latin-1 umzuschalten. Dadurch
-wird erreicht, dass Emacs beim Laden einer Datei (und Speichern
-derselben) standardmig die Latin-1-Zeichenkodierung verwendet. Sie
-knnen an der Ziffer 1 unmittelbar vor dem Doppelpunkt links unten in
-der Statuszeile erkennen, dass Sie Latin-1 aktiviert haben. Beachten
-Sie allerdings, dass set-language-environment keinen Einfluss auf die
-Kodierung bereits existierender Puffer hat! Haben Sie eine Datei mit
-deutschem Text in Latin-1-Kodierung irrtmlicherweise in einer
-falschen Kodierung geladen, dann mssen Sie diesen Puffer aus Emacs
-mit dem Befehl C-x k (kill-buffer) entfernen und die Datei erneut
-laden, nachdem Sie mit set-language-environment auf Latin-1
-umgeschaltet haben.
+Die Standard-Zeichenstze fr Deutsch sind Latin-1 (auch bekannt unter
+dem Namen ISO-8859-1) und Unicode -- und da besonders dessen
+Kodierungsvariante UTF-8. Werden anstelle der deutschen Umlaute
+unansehnliche Konstrukte wie \374 dargestellt, hat Emacs die
+Kodierung nicht richtig erkannt. Sie knnen die Anwendung einer
+Kodierung auf einen Befehl erzwingen, indem Sie diesen mit der Sequenz
+C-x <Return> c KODIERUNG einleiten. Das Laden einer Datei foo mit
+der Kodierung UTF-8 ist beispielsweise
+
+ C-x <Return> c utf-8 <Return> C-x C-f foo
+
+Ist die Sprachumgebung (locale) Ihres Betriebssystems korrekt auf
+Deutsch gesetzt, verwendet Emacs diese Einstellungen automatisch
+(inklusive einer Standard-Kodierung). Wollen Sie andere Einstellungen
+verwenden, geben Sie C-x <Return> l ein (ein Tastenkrzel fr die
+Funktion set-language-environment). Mittels
+
+ C-x <Return> l latin-1 <Return>
+
+knnen Sie z.B. in einer laufenden Emacs-Sitzung auf Latin-1
+umzuschalten. Dadurch wird erreicht, dass Emacs beim Laden einer
+Datei (und Speichern derselben) standardmig die
+Latin-1-Zeichenkodierung verwendet. Sie knnen an der Ziffer 1
+unmittelbar vor dem Doppelpunkt links unten in der Statuszeile
+erkennen, dass Sie Latin-1 aktiviert haben. Beachten Sie allerdings,
+dass set-language-environment keinen Einfluss auf die Kodierung
+bereits existierender Puffer hat!
>> Fhren Sie jetzt C-x <Return> l latin-1 <Return> aus und ffnen Sie
- anschlieend eine (neue) Datei mit dem Namen `bar' in einem anderen
+ anschlieend eine (neue) Datei mit dem Namen bar in einem anderen
Fenster mittels C-x 4 C-f bar <Return>. In der Statuszeile des
zweiten Fensters sehen Sie die Ziffer 1 unmittelbar vor dem
Doppelpunkt.
@@ -1305,10 +1282,10 @@ umgeschaltet haben.
Wie knnen Sie nun deutsche Umlaute eingeben? Es gibt prinzipiell
zwei unterschiedliche Flle: Sie besitzen eine deutsche Tastatur mit
Tasten fr die Umlaute oder Sie haben eine nicht-deutsche Tastatur.
-Im ersteren Fall sollten Sie die Eingabemethode `german' auswhlen,
+Im ersteren Fall sollten Sie die Eingabemethode german auswhlen,
welche direkt die Umlaute auf die entsprechenden Tasten abbildet. Im
letzteren Fall gibt es mehrere Mglichkeiten, wovon zwei hier erklrt
-werden sollen, nmlich `latin-1-prefix' und `latin-1-postfix'. Die
+werden sollen, nmlich latin-1-prefix und latin-1-postfix. Die
Prfix-Methode erwartet zuerst den Akzent und dann den Basisbuchstaben
('a wird zu , "s zu etc.), whrend bei der Postfix-Methode zuerst
der Basisbuchstabe und dann der Akzent einzugeben ist (a" wird zu ,
@@ -1326,8 +1303,8 @@ angezeigt. Ist der Eingabemodus einmal gewhlt, kann man mit C-\ ihn
ein- und ausschalten.
>> Geben Sie C-u C-\ latin-1-postfix <Return> ein. Beobachten Sie,
- wie links unten in der Statuszeile die Anzeige von `1:**' auf
- `1<1:**' springt. Probieren Sie einzugeben mittels a".
+ wie links unten in der Statuszeile die Anzeige von 1:**- auf
+ 1<1:**- springt. Probieren Sie einzugeben mittels a".
>> Deaktivieren Sie den Eingabemodus wieder mit C-\.
@@ -1338,9 +1315,9 @@ beschriebenen Eingabemethoden:
1< latin-1-postfix
1> latin-1-prefix
-So bedeutet die Angabe `DE@1:**', dass Sie die Eingabemethode `german'
-in einem Puffer mit Latin-1-Kodierung verwenden, und dass die Datei
-bereits modifiziert wurde.
+So bedeutet die Angabe DE@1:**-, dass Sie die Eingabemethode
+german in einem Puffer mit Latin-1-Kodierung verwenden, und dass die
+Datei bereits modifiziert wurde.
[Arbeitet Emacs in einem Terminal, werden noch zwei zustzliche
Spalten zwischen Eingabemethode und Pufferkodierung eingefgt, und
@@ -1356,7 +1333,7 @@ jedoch so mchtig und umfangreich, dass es den Rahmen einer Einfhrung
sprnge, an dieser Stelle mehr zu erklren. Um Sie im weiteren
Lernverlauf zu untersttzen, stellt Emacs eine Reihe von
Hilfe-Funktionen zu Verfgung, die alle mit dem Prfix C-h (dem
-Hilfe-Zeichen, `Help character') beginnen.
+Hilfe-Zeichen, Help character) beginnen.
Nach dem Drcken von C-h geben Sie ein weiteres Zeichen ein, um Emacs
zu sagen, worber Sie mehr Informationen brauchen. Sollten Sie
@@ -1364,11 +1341,7 @@ WIRKLICH verloren sein, geben Sie C-h ? ein, und Emacs sagt Ihnen,
welche Art von Hilfe er Ihnen zu Verfgung stellen kann. Haben Sie
C-h versehentlich gedrckt, knnen Sie mit C-g sofort abbrechen.
-(Es kann vorkommen, dass bei manchen Computern bzw. Terminals C-h
-etwas anderes bedeutet. Da erfahrungsgem C-h eine der
-meistbentigten Emacs-Befehle ist, haben Sie einen wirklichen Grund,
-sich in diesem Fall beim Systemadministrator zu beschweren.
-Alternativen zu C-h sind die F1-Taste und der lange Befehl M-x help
+(Alternativen zu C-h sind die F1-Taste und der lange Befehl M-x help
<Return>.)
Die elementarste Hilfestellung gibt C-h c. Drcken Sie C-h, dann das
@@ -1380,11 +1353,10 @@ Beschreibung des Befehls an.
C-p runs the command previous-line
-Somit wissen Sie den `Namen der Funktion'. Funktionsnamen werden
-hauptschlich benutzt, um Emacs anzupassen bzw. zu erweitern. Aber da
-Namen in der Regel beschreiben, was die jeweilige Funktion tut, knnen
-sie auch als sehr kurze Beschreibung dienen -- ausreichend, um Sie an
-Befehle zu erinnern, die Sie bereits gelernt haben.
+Somit wissen Sie den Namen der Funktion. Da Namen in der Regel
+beschreiben, was die jeweilige Funktion tut, knnen sie auch als sehr
+kurze Beschreibung dienen -- ausreichend, um Sie an Befehle zu
+erinnern, die Sie bereits gelernt haben.
Aus mehr als einem Zeichen bestehende Befehle, z.B. C-x C-s oder
<ESC>v, sind ebenfalls erlaubt nach C-h c.
@@ -1406,20 +1378,20 @@ Hier einige weitere ntzliche Optionen von C-h:
C-h f Beschreibt eine Funktion. Sie mssen den Namen der
Funktion eingeben.
->> Probieren Sie C-h f previous-line<Return>.
+>> Probieren Sie C-h f previous-line <Return>.
Alle Information ber den C-p-Befehl wird angezeigt.
Sie knnen die Tabulator-Taste stets bentzen, um den Namen des
-jeweiligen Befehls zu vervollstndigen. Geben Sie z.B. `C-h f
-previous<TAB>' ein, dann werden alle Befehle angezeigt, deren Namen
-mit `previous-' beginnen. Ergnzen Sie die Zeichenkette auf
-`previous-l' und drcken Sie dann <TAB>, bleibt nur noch der Befehl
-`previous-line' brig, und Sie knnen mit <Return> abschlieen.
+jeweiligen Befehls zu vervollstndigen. Geben Sie z.B. C-h f
+previous<TAB> ein, dann werden alle Befehle angezeigt, deren Namen
+mit previous- beginnen. Ergnzen Sie die Zeichenkette auf
+previous-l und drcken Sie dann <TAB>, bleibt nur noch der Befehl
+previous-line brig, und Sie knnen mit <Return> abschlieen.
Ein hnlicher Befehl ist C-h v. Er zeigt den Wert und die
-Dokumentation von Variablen, deren Werte man ndern kann (um Emacs an
-persnliche Bedrfnisse anzupassen). Auch hier kann man die
-Tabulator-Taste zur Vervollstndigung benutzen.
+Dokumentation von Variablen, deren Werte man ndern kann (um
+beispielsweise Emacs an persnliche Bedrfnisse anzupassen). Auch
+hier kann man die Tabulator-Taste zur Vervollstndigung benutzen.
C-h a Ein Befehls-Apropos. Gibt man ein Schlsselwort ein,
zeigt Emacs alle Befehle, die dieses Schlsselwort
@@ -1429,9 +1401,9 @@ Tabulator-Taste zur Vervollstndigung benutzen.
einem oder zwei Zeichen) aufgelistet, welche den
gleichen Befehl startet.
->> Geben Sie C-h a file<Return> ein.
+>> Geben Sie C-h a file <Return> ein.
-Alle M-x-Befehle, die das Wort `file' in ihrem Namen enthalten, werden
+Alle M-x-Befehle, die das Wort file in ihrem Namen enthalten, werden
angezeigt. Beachten Sie, dass auch C-x C-f aufgelistet wird neben dem
zugehrigen langen Namen, find-file.
@@ -1440,30 +1412,26 @@ zugehrigen langen Namen, find-file.
>> Schlieen Sie das Hilfefenster mit C-x 1.
C-h i Dieser Befehl ffnet einen speziellen Puffer, um
- Online-Handbcher zu lesen (im `Info'-Format), die auf
- dem verwendeten Computersystem installiert sind.
- Geben Sie z.B. m emacs <Return> ein, um das
- Emacs-Handbuch zu lesen. Haben Sie `Info' noch nie
- benutzt, tippen Sie ?, und Emacs fhrt Sie Schritt fr
- Schritt durch die Mglichkeiten des Info-Modus. Wenn
- Sie diese Einfhrung fertiggelesen haben, sollten Sie
- das Info-Handbuch fr Emacs als primre Dokumentation
+ Handbcher zu lesen (im Info-Format), die auf dem
+ verwendeten Computersystem installiert sind. Geben
+ Sie z.B. m emacs <Return> ein, um das Emacs-Handbuch
+ zu lesen. Haben Sie Info noch nie benutzt, tippen
+ Sie ?, und Emacs fhrt Sie Schritt fr Schritt durch
+ die Mglichkeiten des Info-Modus. Wenn Sie diese
+ Einfhrung fertiggelesen haben, sollten Sie das
+ Info-Handbuch fr Emacs als primre Dokumentation
benutzen.
* SCHLUSSBEMERKUNG
------------------
-Das Wichtigste: Emacs wird mit C-x C-c beendet und mit C-z temporr
-unterbrochen.
+Das Wichtigste: Emacs wird mit C-x C-c beendet.
Diese Einfhrung soll fr alle neuen Benutzer von Emacs verstndlich
sein. Wenn daher etwas unklar sein sollte, hadern Sie nicht mit sich
-selbst. Schreiben Sie an die Free Software Foundation oder an den
-Autor und erlutern Sie, was fr Sie unklar geblieben ist. Eine
-weitere Kontaktadresse ist die Mailing-Liste `de@li.org', in der
-Probleme mit der Adaption von GNU-Programmen an das Deutsche
-diskutiert werden.
+selbst. Schreiben Sie an die Free Software Foundation, den Autor oder
+den bersetzer und erlutern Sie, was fr Sie unklar geblieben ist.
* RECHTLICHES
@@ -1477,7 +1445,7 @@ Beachten Sie bitte, dass im Zweifelsfalle das englische Original
dieser Urheberrechtsnotiz gltig ist (zu finden in der Datei
TUTORIAL).
- Copyright (C) 1985, 1996-1997, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1996-1997, 2001-2012 Free Software Foundation, Inc.
Diese Datei ist ein Bestandteil von GNU Emacs.
diff --git a/etc/tutorials/TUTORIAL.eo b/etc/tutorials/TUTORIAL.eo
index f95f3317abf..51c08db04a4 100644
--- a/etc/tutorials/TUTORIAL.eo
+++ b/etc/tutorials/TUTORIAL.eo
@@ -1081,7 +1081,7 @@ la dosiero verkita de Stuart Cracraft por la originala Emakso.
kopirajton, kaj venas kun permeso por disdoni kopiojn se certaj
kondioj estas observataj:
- Copyright (C) 1985, 1999, 2001-2002, 2005, 2007-2011
+ Copyright (C) 1985, 1999, 2001-2002, 2005, 2007-2012
Free Software Foundation, Inc.
i tiu dosiero estas parto de "GNU Emacs".
diff --git a/etc/tutorials/TUTORIAL.es b/etc/tutorials/TUTORIAL.es
index e4b2cf0d528..b48f0aa79fb 100644
--- a/etc/tutorials/TUTORIAL.es
+++ b/etc/tutorials/TUTORIAL.es
@@ -14,8 +14,10 @@ ocasin, usaremos las siguientes abreviaturas.
<car>. Escribimos <ESC> para referirnos a la tecla ESC.
Nota importante: para terminar la sesin de Emacs teclee C-x C-c (dos
-caracteres). Los caracteres ">>" en el margen izquierdo indican
-instrucciones para que usted trate de usar un comando. Por ejemplo:
+caracteres). Para cancelar un comando parcialmente introducido,
+teclee C-g.
+Los caracteres ">>" en el margen izquierdo indican instrucciones para
+que usted trate de usar un comando. Por ejemplo:
<<Blank lines inserted around following line by help-with-tutorial>>
[Mitad de pgina en blanco para propsitos didcticos. El texto contina abajo]
>> Ahora teclee C-v (ver la prxima pantalla) para desplazarse a la
@@ -47,9 +49,12 @@ Los siguientes comandos son tiles para ver pantallas completas:
pantalla (Esto es CONTROL-L, no CONTROL-1.)
>> Encuentre el cursor, y fjese qu texto hay cerca de ste.
- Luego teclee C-l.
- Encuentre el cursor otra vez y note que el mismo texto est cerca
- del cursor ahora.
+ Luego teclee C-l. Encuentre el cursor otra vez y note que el mismo
+ texto est todava cerca del cursor, pero ahora est en el centro
+ de la pantalla.
+ Si vuelve teclear C-l, ese texto se mover al principio de la
+ pantalla. Al teclear C-l otra vez, se mover al final de la
+ pantalla.
Si su terminal las soporta, tambin puede usar las teclas AvPg o
RegPg para moverse por pantallas completas, pero puede editar ms
@@ -89,9 +94,9 @@ comandos de posicionamiento bsico del cursor todo el tiempo.
lo que hace C-p cuando el cursor est en medio de la lnea.
Cada lnea de texto termina con un carcter de nueva lnea (Newline),
-que sirve para separarla de la lnea siguiente. La ltima lnea de su
-archivo debe de tener un carcter de nueva lnea al final (pero Emacs
-no requiere que sta lo tenga).
+que sirve para separarla de la lnea siguiente. (Normalmente, la
+ltima lnea de un archivo termina con un carcter de nueva lnea,
+pero Emacs no requiere que sea as.)
>> Intente usar C-b al comienzo de una lnea. Debera moverse al
final de la lnea previa. Esto sucede porque retrocede a travs
@@ -217,34 +222,27 @@ bandera: la presencia de un argumento prefijo, sin tener en cuenta su
valor, hace que el comando acte de forma diferente.
C-v y M-v son otro tipo de excepcin. Cuando se les da un argumento,
-desplazan la pantalla arriba o abajo esa cantidad de lneas, en vez de
+desplazan el texto arriba o abajo esa cantidad de lneas, en vez de
una pantalla completa. Por ejemplo, C-u 8 C-v desplaza la pantalla 8
lneas.
>> Pruebe tecleando C-u 8 C-v ahora.
-Esto debi haber desplazado la pantalla hacia arriba 8 lneas. Si
+Esto debera haber desplazado el texto hacia arriba 8 lneas. Si
quisiera desplazarla hacia abajo de nuevo, puede dar un argumento a
M-v.
-Si est usando un sistema de ventanas, como X11 o MS-Windows, debe
+Si est usando un entorno grfico, como X o MS-Windows, debe
haber una larga rea rectangular llamada una barra de desplazamiento
en el lado izquierdo de la ventana de Emacs. Puede desplazar el texto
al oprimir el botn del ratn en la barra de desplazamiento.
->> Pruebe presionando el botn del medio en la parte superior del rea
- resaltada en la barra de desplazamiento. ste debe desplazar el
- texto a una posicin determinada segn cuan alto o bajo oprima el
- botn.
-
->> Intente mover el ratn arriba y abajo, mientras mantiene el botn
- del medio presionado. Ver que el texto se desplaza arriba y abajo
- a medida que mueve el ratn.
+Si su ratn tiene un botn de rueda, tambin puede utilizarlo para
+desplazar el texto.
-
-* CUANDO EMACS EST BLOQUEADO
------------------------------
+* SI EMACS DEJA DE RESPONDER
+----------------------------
Si Emacs dejara de responder a sus comandos, puede detenerlo con
seguridad al teclear C-g. Puede usar C-g para detener un comando que
@@ -253,7 +251,7 @@ est tomando mucho tiempo para ejecutarse.
Tambin puede usar C-g para descartar un argumento numrico o el
comienzo de un comando que no quiere finalizar.
->> Escriba C-u 100 para hacer un argumento numrico de 100, entonces
+>> Escriba C-u 100 para hacer un argumento numrico de 100, y luego
pruebe C-g.
Ahora pruebe C-f. Esto deber mover slo un carcter, ya que
cancel el argumento con C-g.
@@ -282,7 +280,7 @@ desactivado, conteste la pregunta con "n".
* VENTANAS
----------
-Emacs puede tener varias ventanas, cada una mostrando su propio texto.
+Emacs puede tener varias "ventanas", cada una mostrando su propio texto.
Explicaremos despus como usar mltiples ventanas. Ahora mismo
queremos explicar cmo deshacerse de ventanas adicionales y volver a
la edicin bsica en una ventana. Es sencillo:
@@ -294,16 +292,14 @@ contiene el cursor, para ocupar toda la pantalla. Esto borra todas las
dems ventanas.
>> Mueva el cursor a esta lnea y escriba C-u 0 C-l.
->> Escriba Control-h k Control-f.
+>> Escriba C-h k C-f.
Vea como esta ventana se encoge, mientras una nueva aparece y
- muestra documentacin sobre el comando Control-f.
+ muestra documentacin sobre el comando C-f.
>> Escriba C-x 1 y vea que la ventana de listado de documentacin
desaparece.
-Este comando es diferente a los otros que ha aprendido en que ste
-consiste de dos caracteres. Comienza con el carcter CONTROL-x. Hay
-toda una serie de comandos que comienzan con CONTROL-x; muchos de
+Hay toda una serie de comandos que comienzan con CONTROL-x; muchos de
ellos tienen que ver con ventanas, archivos, buffers y cosas
relacionadas. Estos comandos son de una longitud de dos, tres o
cuatro caracteres.
@@ -312,41 +308,36 @@ cuatro caracteres.
* INSERTAR Y BORRAR
-------------------
-Si quiere insertar un texto, basta con que lo teclee. Emacs
-interpreta los caracteres que usted puede ver, tales como A, 7, *,
-etc. como texto y los inserta inmediatamente. Teclee <Return> (la
-tecla Enter) para insertar un carcter de nueva lnea.
+Si quiere insertar un texto, basta con que lo teclee. Los caracteres
+normales, como A, 7, *, etc. se insertan nada ms teclearlos. Teclee
+<Return> (la tecla "Enter" o "Intro") para insertar un carcter de
+nueva lnea.
-Puede borrar el ltimo carcter que escribi oprimiendo <Delback>.
-<Delback> es una tecla en el teclado--la misma que normalmente usa
-fuera de emacs para borrar el ltimo carcter que escribi.
-Normalmente es una tecla una o dos filas arriba de la tecla <Return>,
-y que est usualmente rotulada como "Backspace", "Del" o simplemente
-con una flecha en direccin izquierda que no es parte de las teclas de
-flecha.
+Para borrar el carcter que precede al cursor, oprima <DEL>. Es una
+tecla alargada, normalmente etiquetada como "Backspace" o "Del", o con
+una flecha apuntando a la izquierda; la misma que suele utilizar fuera
+de Emacs para borrar el ltimo carcter introducido.
-Si la tecla larga est rotulada "Backspace", entonces sa es la que
-debe de usar para <Delback>. Puede haber otra tecla llamada "Del" en
-otra parte, pero sa no es <Delback>.
-
-Generalmente, <Delback> borra el carcter inmediatamente anterior a la
-posicin actual del cursor.
+Puede haber otra tecla llamada "Del" o "Supr" en otra parte, pero sa
+no es <DEL>.
>> Haga esto ahora: teclee unos pocos caracteres, despus brrelos
- tecleando <Delback> varias veces. No se preocupe si este archivo
+ tecleando <DEL> varias veces. No se preocupe si este archivo
cambia, no alterar el tutorial principal. sta es su copia
personal de l.
-Cuando una lnea de texto se hace muy grande para una sola lnea en la
+Cuando una lnea de texto se hace muy grande para una sola lnea de la
pantalla, la lnea de texto "contina" en una segunda lnea en la
-pantalla. Un backslash ("\") (o, si est usando un sistema de
-ventanas, una pequea flecha curva) en el margen derecho indica que la
-lnea "contina".
+pantalla. Si est usando un entorno grfico, se mostrarn pequeas
+flechas curvas en las estrechas franjas vacas (los "mrgenes" derecho
+e izquierdo) a cada lado del rea de texto, para indicar que la lnea
+contina. Si est utilizando una terminal, la continuacin se seala
+mediante una barra invertida ("\") en la ltima columna de la derecha.
>> Inserte texto hasta que llegue al margen derecho, y siga
insertando. Ver aparecer una lnea de continuacin.
->> Use <Delback> para borrar el texto hasta que la lnea de nuevo
+>> Use <DEL> para borrar el texto hasta que la lnea de nuevo
quepa en la pantalla. La lnea de continuacin se pierde.
Puede borrar un carcter de nueva lnea como cualquier otro carcter.
@@ -355,7 +346,7 @@ sola lnea. Si el resultado de la combinacin de lneas es demasiado
largo para caber en el ancho de la pantalla, se mostrar con una lnea
de continuacin.
->> Mueva el cursor al comienzo de una lnea y teclee <Delback>. Esto
+>> Mueva el cursor al comienzo de una lnea y teclee <DEL>. Esto
juntar esa lnea con la lnea anterior.
>> Teclee <Return> para reinsertar la nueva lnea que borr.
@@ -370,27 +361,29 @@ Ya ha aprendido la manera ms bsica de teclear algo en Emacs y
corregir errores. Puede borrar por palabras o por lneas. He aqu un
resumen de las operaciones de borrado:
- <Delback> borra el carcter justo antes que el cursor
+ <DEL> borra el carcter justo antes que el cursor
C-d borra el siguiente carcter despus del cursor
- M-<Delback> Elimina la palabra inmediatamente antes del
+ M-<DEL> Elimina la palabra inmediatamente antes del
cursor
M-d Elimina la siguiente palabra despus del cursor
C-k Elimina desde el cursor hasta el fin de la lnea
M-k Elimina hasta el final de la oracin actual
-Note que <Delback> y C-d, comparados con M-<Delback> y M-d, extienden
-el paralelismo iniciado por C-f y M-f (bien, <Delback> no es realmente
-una tecla de control, pero no nos preocuparemos de eso ahora). C-k y
-M-k, en ciertas forma, son como C-e y M-e, en que las lneas son
-oraciones opuestas.
+Note que <DEL> y C-d, comparados con M-<DEL> y M-d, extienden el
+paralelismo iniciado por C-f y M-f (bien, <DEL> no es realmente una
+tecla de control, pero no nos preocuparemos de eso ahora). C-k y M-k,
+en ciertas forma, son como C-e y M-e, en que las lneas de unos
+corresponden a sentencias en los otros.
-Tambin puede eliminar cualquier parte del buffer con un mtodo
-uniforme. Muvase a un extremo de esa parte, y teclee C-@ o C-SPC
-(cualquiera de los dos). (SPC es la barra espaciadora.) Muvase al
-otro extremo de esa parte, y teclee C-w. Eso elimina todo el texto
-entre las dos posiciones.
+Tambin puede eliminar un segmento contiguo de texto con un mtodo
+uniforme. Muvase a un extremo de ese segmento de texto, y teclee C-@
+o C-SPC (cualquiera de los dos). (SPC es la barra espaciadora.)
+Luego, mueva el cursor al otro extremo del texto que desea eliminar.
+Al hacerlo, Emacs resaltar el texto situado entre el cursor y la
+posicin en la que tecle C-SPC. Finalmente, teclee C-w. Eso elimina
+todo el texto entre las dos posiciones.
>> Mueva el cursor a la letra T del inicio del prrafo anterior.
>> Teclee C-SPC. Emacs debe mostrar el mensaje "Mark set" en la parte
@@ -401,12 +394,15 @@ entre las dos posiciones.
termina justo antes de la x.
La diferencia entre "eliminar" y "borrar" es que el texto "eliminado"
-puede ser reinsertado, mientras que las cosas "borradas" no pueden ser
-reinsertadas. La reinsercin de texto eliminado se llama "yanking" o
-"pegar". Generalmente, los comandos que pueden quitar mucho texto lo
-eliminan, mientras que los comandos que quitan solo un carcter, o
-solo lneas en blanco y espacios, borran (para que no pueda pegar ese
-texto).
+puede ser reinsertado (en cualquier posicin), mientras que las cosas
+"borradas" no pueden ser reinsertadas (sin embargo, es posible
+deshacer el borrado; ver ms abajo). La reinsercin de texto
+eliminado se llama "yanking" o "pegar". Generalmente, los comandos
+que pueden quitar mucho texto lo eliminan (para que pueda pegarlo de
+nuevo) mientras que los comandos que quitan solo un carcter, o solo
+lneas en blanco y espacios, borran (y por tanto no se puede pegar lo
+borrado). Si se normalmente, sin pasar un argumento, <DEL> y C-d
+borran. Con un argumento, eliminan.
>> Mueva el cursor al comienzo de una lnea que no est vaca.
Luego teclee C-k para eliminar el texto de esa lnea.
@@ -420,12 +416,13 @@ especialmente: Elimina ese nmero de lneas y TAMBIN sus
contenidos. Esto no es una simple repeticin. C-u 2 C-k elimina dos
lneas y sus nuevas lneas, tecleando C-k dos veces no hace esto.
-Traer texto eliminado de regreso es llamado "yanking" o "pegar".
-(Piense en ello como pegar de nuevo, o traer de vuelta, algn texto
-que le fue quitado.) Puede pegar el texto eliminado en, ya sea el
-lugar en que fue eliminado, o en otra parte del buffer, o hasta en un
-archivo diferente. Puede pegar el texto varias veces, lo que hace
-varias copias de l.
+Reinsertar texto eliminado se denomina "yanking" o "pegar". (Piense
+en ello como pegar de nuevo, o traer de vuelta, algn texto que le fue
+quitado.) Puede pegar el texto eliminado, ya sea el lugar en que fue
+eliminado, o en otra parte del buffer, o hasta en un archivo
+diferente. Puede pegar el texto varias veces, lo que hace varias
+copias de l. Algunos editores se refieren a eliminar y reinsertar
+como "cortar" y "pegar" (consulte el Glosario en el manual de Emacs).
El comando para pegar es C-y. Reinserta el ltimo texto eliminado, en
la posicin actual del cursor.
@@ -468,32 +465,31 @@ eliminacin ms reciente).
----------
Si hace un cambio al texto, y luego decide que fue un error,
-puede deshacer el cambio con el comando deshacer, C-x u.
+puede deshacer el cambio con el comando deshacer, C-/.
-Normalmente, C-x u deshace los cambios hechos por un comando; si repite
-varias veces seguidas C-x u, cada repeticin deshar un comando
+Normalmente, C-/ deshace los cambios hechos por un comando; si repite
+varias veces seguidas C-/, cada repeticin deshar un comando
adicional.
Pero hay dos excepciones: los comandos que no cambian el texto no
-cuentan (esto incluye los comandos de movimiento del cursor y el
-comando de desplazamiento), y los caracteres de autoinsercin se
-manejan usualmente en grupos de hasta 20. (Esto es para reducir el
-numero de C-x u que tenga que teclear para deshacer una insercin en
+cuentan (esto incluye los comandos de movimiento del cursor y de
+desplazamiento), y los caracteres de autoinsercin se manejan
+usualmente en grupos de hasta 20 caracteres. (Esto es para reducir el
+numero de C-/ que tenga que teclear para deshacer una insercin en
el texto.)
->> Elimine esta lnea con C-k, despus teclee C-x u y debera
+>> Elimine esta lnea con C-k, despus teclee C-/ y debera
reaparecer.
-C-_ es un comando alternativo para deshacer; funciona igual que C-x u,
-pero es ms fcil de teclear varias veces seguidas. La desventaja de
-C-_ es que en algunos teclados no es obvio cmo se teclea. Por esto
-existe tambin C-x u. En algunas terminales, puede teclear C-_ al
-teclear / mientras oprime CONTROL.
+C-_ es un comando alternativo para deshacer; funciona igual que C-/.
+En algunas terminales, al teclear C-/ en realidad enva C-_ a Emacs.
+Tambin existe la alternativa de usar C-x u, que funciona exactamente
+igual que C-/, pero es menos cmodo de teclear.
-Un argumento numrico para C-_ o C-x u acta como un factor de
+Un argumento numrico para C-/, C-_ o C-x u acta como un factor de
repeticin.
-Uuede deshacer un texto borrado justo como puede deshacer el texto
+Puede deshacer un texto borrado justo como puede deshacer el texto
eliminado. La distincin entre eliminar algo y borrar algo afecta en
si puede pegarlo con C-y; no hay diferencia alguna para deshacer.
@@ -516,17 +512,17 @@ cuando guarde, Emacs dejar el archivo original bajo un nombre
cambiado en caso de que luego decida que sus cambios fueron un error.
Si mira cerca del final de la pantalla podr ver una lnea que
-comienza y termina con guiones, y comienza con "--:-- TUTORIAL.es" o
-algo as. Esta parte de la pantalla normalmente muestra el nombre del
-archivo que est visitando. En este momento est visitando un archivo
-llamado "TUTORIAL.es" que es su borrador personal del tutorial de
-Emacs. Cuando encuentre un archivo con Emacs, el nombre de ese
-archivo aparecer en ese mismo punto.
+comienza con guiones, y empieza con " -:--- TUTORIAL.es" o algo as.
+Esta parte de la pantalla normalmente muestra el nombre del archivo
+que est visitando. En este momento est visitando su propia copia
+del tutorial de Emacs, que se llama "TUTORIAL.es". Cuando encuentre
+un archivo con Emacs, el nombre de ese archivo aparecer en ese mismo
+punto.
Una cosa especial acerca del comando para encontrar un archivo, es que
tendr que decir que nombre de archivo desea. Decimos que el comando
-"lee un argumento desde la terminal" (en este caso, el argumento es el
-nombre del archivo). Despus de teclear el comando:
+"lee un argumento" (en este caso, el argumento es el nombre del
+archivo). Despus de teclear el comando:
C-x C-f Encontrar un archivo
@@ -544,35 +540,31 @@ entrada al minibuffer) puede cancelar el comando con C-g.
As que no encontrar archivo alguno.
Cuando haya finalizado de ingresar el nombre del archivo, teclee
-<Return> para terminarlo. Entonces el comando C-x C-f trabaja, y
-encuentra el archivo que escogi. El minibuffer desaparece cuando el
-comando C-x C-f termina.
+<Return> para terminarlo. El minibuffer desaparece, y el comando C-x
+C-f trabaja para encontrar el archivo que escogi.
-Poco tiempo despus aparecer el contenido del archivo en la pantalla,
-y puede editarlo. Cuando quiera que sus cambios sean permanentes,
-teclee el comando
+En seguida aparecer el contenido del archivo en la pantalla, y puede
+editarlo. Cuando quiera que sus cambios sean permanentes, teclee el
+comando
C-x C-s Guardar el archivo
Esto copia el texto dentro de Emacs al archivo. La primera vez que
haga esto, Emacs renombrar el archivo original con un nuevo nombre
para que ste no se pierda. El nuevo nombre se hace agregando "~" al
-final del nombre del archivo original.
-
-Cuando guardar haya terminado, Emacs mostrar el nombre del archivo
-escrito. Deber guardar frecuentemente, para que no pierda mucho
-trabajo si el sistema falla.
+final del nombre del archivo original. Cuando guardar haya terminado,
+Emacs mostrar el nombre del archivo escrito.
->> Teclee C-x C-s, guardando la copia del tutorial.
- Esto debera mostrar "Wrote ...TUTORIAL.es" al final de la
- pantalla.
+>> Teclee C-x C-s TUTORIAL.es <Return>
+ Esto guardar el tutorial en un archivo llamado TUTORIAL.es, y
+ mostrar "Wrote ...TUTORIAL.es" al final de la pantalla.
Puede encontrar un archivo existente, para verlo o editarlo. Tambin
puede hacerlo con un archivo que no exista. sta es la forma de crear
-un archivo en Emacs: encuentre el archivo, que comenzar vaco, luego
-comience a insertar el texto para ese archivo. Cuando invoque
+un archivo en Emacs: encuentre el archivo, que est inicialmente vaco,
+luego comience a insertar el texto para ese archivo. Cuando invoque
"guardar" el archivo, Emacs crear realmente el archivo con el texto
-que ha insertado. De ah en adelante, puede considerarse estar
+que ha insertado. De ah en adelante, puede considerar que est
editando un archivo existente.
@@ -584,16 +576,10 @@ dentro de Emacs. Puede volver a el encontrndolo de nuevo con C-x
C-f. De esta forma puede mantener un gran nmero de archivos dentro
de Emacs.
->> Cree un archivo llamado "foo" tecleando C-x C-f foo <Return>.
- Luego inserte algn texto, edtelo, y guarde "foo" tecleando C-x
- C-s.
- Finalmente teclee C-x C-f TUTORIAL.es <Return>
- para regresar al tutorial.
-
Emacs almacena cada texto del archivo dentro de un objeto llamado
"buffer". Al encontrar un archivo se crea un nuevo buffer dentro de
-Emacs. Para mirar la lista de los buffers que existen actualmente en
-su sesin de Emacs, teclee:
+Emacs. Para mirar la lista de los buffers que existen actualmente,
+teclee:
C-x C-b Lista de buffers
@@ -612,22 +598,24 @@ que corresponde a un archivo, puede hacerlo visitando el archivo de
nuevo con C-x C-f. Pero existe una manera ms rpida: use el comando
C-x b. En ese comando, necesita teclear el nombre de buffer.
->> Teclee C-x b foo <Return> para volver al buffer "foo" que contiene
- el texto del archivo "foo". Despus teclee C-x b TUTORIAL.es
- <Return> para regresar a este tutorial.
+>> Cree un archivo llamado "foo" tecleando C-x C-f foo <Return>.
+ Despus teclee C-x b TUTORIAL.es <Return> para regresar a este
+ tutorial.
La mayora del tiempo el nombre del buffer es el mismo que el nombre
del archivo (sin la parte del directorio del archivo). Sin embargo,
esto no es as siempre. La lista de buffers que hace con C-x C-b
-siempre muestra el nombre de todos los buffers.
+muestra el nombre de cada buffer y de su archivo correspondiente.
-CUALQUIER texto que vea en una ventana de Emacs siempre es parte de un
-buffer. Algunos buffers no corresponden a un archivo. Por ejemplo,
-el buffer llamado "*Buffer List*" no tiene ningn archivo. Es el
-buffer que contiene la lista de buffers que ha creado con C-x C-b. El
-buffer llamado "*Messages*" tampoco tiene un archivo correspondiente;
-contiene los mensajes que han aparecido en la lnea de abajo durante
-su sesin de Emacs.
+Algunos buffers no corresponden a un archivo. El buffer llamado
+"*Buffer List*", que contiene la lista de buffers que ha creado con
+C-x C-b, no tiene archivo. Este buffer TUTORIAL.es al principio no
+tena archivo, pero ahora ya s, porque en la seccin anterior tecle
+C-x C-s y lo guard en un archivo.
+
+El buffer llamado "*Messages*" tampoco tiene un archivo
+correspondiente. Este buffer contiene los mensajes que han aparecido
+en la lnea de abajo durante su sesin de Emacs.
>> Teclee C-x b *Messages* <Return> para ver el buffer de mensajes.
Luego teclee C-x b TUTORIAL <Return> para regresar a este tutorial.
@@ -637,8 +625,8 @@ archivo, esto no guarda el primer archivo. Sus cambios permanecern
dentro de Emacs en ese buffer del archivo. La creacin o edicin del
segundo buffer de archivo no afecta al primero. Esto es muy til,
pero tambin significa que necesita una forma conveniente para guardar
-el archivo del primer buffer. Sera una molestia tener que volver a
-ste con C-x C-f para guardarlo con C-x C-s. As tenemos
+el archivo del primer buffer. Tener que volver a l para guardarlo
+con C-x C-s sera una molestia. Por tanto, tenemos
C-x s Guardar algunos buffers
@@ -669,45 +657,46 @@ comando C-x C-c. (No se preocupe por perder los cambios que haya
hecho; C-x C-c ofrece guardar cada archivo alterado antes de finalizar
Emacs.)
-C-z es el comando para salir de Emacs *temporalmente*: para que pueda
-regresar a la misma sesin de Emacs despus.
+Si est utilizando una pantalla grfica, no necesita ningn comando
+especial para cambiar de Emacs a otra aplicacin. Puede hacerlo con
+el ratn, o mediante el gestor de ventanas. Sin embargo, si est
+usando una terminal que solo puede mostrar una aplicacin a la vez,
+tendr que "suspender" Emacs para poder acceder a otras aplicaciones.
-En sistemas que lo permiten C-z "suspende" Emacs; esto es, se regresa
-al intrprete de comandos pero no se destruye Emacs. En los
+C-z es el comando para salir de Emacs *temporalmente*: para que pueda
+regresar a la misma sesin de Emacs despus. Cuando Emacs est
+ejecutndose en una terminal, C-z "suspende" Emacs; esto es, se
+regresa al intrprete de comandos pero no se destruye Emacs. En los
intrpretes de comandos ms comunes, puede reanudar Emacs con el
comando `fg' o con `%emacs'.
-En sistemas que no implementen el suspendido, C-z crea un
-subintrprete que corre bajo Emacs para darle la opcin de correr
-otros programas y regresar a Emacs despus; esto en realidad no "sale"
-de Emacs. En este caso, el comando `exit' del intrprete es la va
-usual para regresar a Emacs desde ste.
-
El momento para usar C-x C-c es cuando est listo para salir del
-sistema. Es adems el paso correcto para salir de un Emacs llamado
-bajo programas de manejo de correo y diversas otras utilidades, puesto
-que ellos no saben cmo lidiar con la suspensin de Emacs. En
-circunstancias normales, si no va a salir, es mejor suspender
-Emacs con C-z en lugar de salir de l.
+sistema. Es adems el paso correcto para salir de un Emacs invocado
+para editar algo rpidamente, como por ejemplo desde un programa de
+gestin de correo.
-Existen varios comandos C-x. Aqu hay una lista de los que ha
+Existen muchos comandos C-x. He aqu la lista de los que ya ha
aprendido:
- C-x C-f Encontrar archivo.
- C-x C-s Guardar archivo.
- C-x C-b Lista de buffers.
- C-x C-c Salir de Emacs.
- C-x 1 Borrar todo menos una ventana.
- C-x u Deshacer.
+ C-x C-f Encontrar archivo
+ C-x C-s Guardar archivo
+ C-x s Guardar varios buffers
+ C-x C-b Lista de buffers
+ C-x b Cambiar a otro buffer
+ C-x C-c Salir de Emacs
+ C-x 1 Borrar todo menos una ventana
+ C-x u Deshacer
Los comandos eXtendidos por nombre son comandos que se utilizan an
con menos frecuencia, o nicamente en ciertos modos. Un ejemplo es el
-comando replace-string, el cual globalmente substituye una cadena de
-caracteres por otra. Cuando teclea M-x, Emacs le pregunta al
-final de la pantalla con M-x y debe escribir el nombre del
-comando; en este caso "replace-string". Solo teclee "repl s<TAB>" y
-Emacs completar el nombre. Finalice el nombre del comando con
-<Return>.
+comando replace-string, el cual substituye una cadena de caracteres
+por otra en todo el buffer. Cuando teclea M-x, Emacs le pregunta al
+final de la pantalla con M-x y debe escribir el nombre del comando; en
+este caso "replace-string". Solo teclee "repl s<TAB>" y Emacs
+completar el nombre. (<TAB> es la tecla del tabulador, que
+habitualment est situada sobre la tecla de bloquear maysculas o la
+de shift, en el lado izquierdo del teclado.) Para aceptar el comando
+y ejecutarlo, pulse <Return>.
El comando replace-string requiere dos argumentos: la cadena de
caracteres a reemplazar, y la cadena de caracteres para reemplazarla.
@@ -717,8 +706,8 @@ Debe terminar cada argumento con <Return>.
A continuacin escriba
M-x repl s<Return>cambiado<Return>alterado<Return>.
- Note cmo esta lnea ha cambiado: ha substituido la palabra
- c-a-m-b-i-a-d-o por "alterado" en cada ocurrencia, despus de la
+ Note cmo ha cambiado la lnea: ha substituido la palabra
+ "cambiado" por "alterado" en cada ocurrencia, despus de la
posicin inicial del cursor.
@@ -733,11 +722,11 @@ un # al principio y al final; por ejemplo, si su archivo se llama
"hola.c", su archivo auto guardado es "#hola.c#". Cuando guarda por
la va normal, Emacs borra su archivo de auto guardado.
-Si la computadora falla, puede recuperar su edicin de auto
-guardado encontrando el archivo normal (el archivo que estuvo
-editando, no el archivo de auto guardar) y entonces tecleando M-x
-recover file<Return>. Cuando le pregunte por la confirmacin, teclee
-yes<Return> para ir y recuperar la informacin del auto guardado.
+Si la computadora falla, puede recuperar su edicin de auto guardado
+encontrando el archivo normal (el archivo que estuvo editando, no el
+archivo de auto guardar) y entonces tecleando M-x recover-file
+<Return>. Cuando le pregunte por la confirmacin, teclee yes<Return>
+para seguir adelante y recuperar la informacin de auto guardado.
* REA DE ECO
@@ -754,20 +743,20 @@ lentamente, se los muestra al final de la pantalla en un rea llamada
La lnea inmediatamente encima del rea de eco recibe el nombre de
"lnea de modo" o "mode line". La lnea de modo dice algo as:
---:** TUTORIAL.es (Fundamental)--l765--65%---------
+ -:**- TUTORIAL.es 63% L749 (Fundamental)
Esta lnea da informacin til acerca del estado de Emacs y del texto
que est editando.
Ya sabe qu significa el nombre del archivo: es el archivo que usted
-ha encontrado. -NN%-- indica su posicin actual en el texto; esto
+ha encontrado. NN% indica su posicin actual en el texto; esto
significa que NN por ciento del texto est encima de la parte superior
de la pantalla. Si el principio del archivo est en la pantalla, ste
-dir --Top-- en vez de --00%--. Si el final del texto est en la
-pantalla, dir --Bot--. Si est mirando un texto tan pequeo que cabe
-en la pantalla, el modo de lnea dir --All--.
+dir "Top" en vez de " 0%". Si el final del texto est en la
+pantalla, dir "Bot". Si est mirando un texto tan pequeo que cabe
+entero en la pantalla, el modo de lnea dir "All".
-La L y los dgitos indican la posicin de otra forma: ellos dan el
+La L y los dgitos sealan la posicin de otra forma: indican el
nmero de lnea actual del punto.
Los asteriscos cerca del frente significan que usted ha hecho cambios
@@ -795,7 +784,8 @@ fundamental-mode es un comando para cambiar al modo fundamental.
Si va a editar un texto de algn lenguaje humano, como este archivo,
debera usar el modo de texto.
->> Teclee M-x text mode<Return>.
+
+>> Teclee M-x text-mode <Return>.
No se preocupe, ninguno de los comandos de Emacs que ha aprendido
cambia de manera significativa. Pero puede observar que M-f y M-b
@@ -805,20 +795,22 @@ de palabras.
Los modos mayores normalmente hacen cambios sutiles como el anterior:
la mayora de comandos hacen "el mismo trabajo" en cada modo mayor,
-pero funcionan un poco diferente.
+pero funcionan de forma un poco diferente.
+
+Para ver la documentacin del modo mayor actual, teclee C-h m.
-Para ver documentacin en el modo mayor actual, teclee C-h m.
+>> Mueva el cursor a la lnea siguiente a la actual.
->> Use C-u C-v una o ms veces para traer esta lnea cerca de la
- parte superior de la pantalla.
+>> Use C-l C-l para traer esta lnea a la parte superior de la
+ pantalla.
>> Teclee C-h m, para ver como el modo de Texto difiere del modo
Fundamental.
>> Teclee C-x 1 para eliminar la documentacin de la pantalla.
-Los modos mayores son llamados as porque tambin hay modos menores.
-Los modos menores no son alternativas para los modos mayores, solo
+Los modos mayores se llaman as porque tambin hay modos menores. Los
+modos menores no son alternativas para los modos mayores, solo
modificaciones menores de stos. Cada modo menor puede ser activado o
desactivado por s mismo, independiente de todos los otros modos
menores, e independiente de su modo mayor. Por tanto, puede no usar
@@ -830,13 +822,13 @@ espaol, es el modo Auto Fill. Cuando este modo est activado, Emacs
rompe la lnea entre palabras automticamente siempre que inserte
texto y la lnea sea demasiado ancha.
-Puede activar el modo Auto Fill al hacer M-x auto fill mode<Return>.
+Puede activar el modo Auto Fill al hacer M-x auto-fill-mode <Return>.
Cuando el modo est activado, puede desactivarlo nuevamente usando M-x
-auto fill mode<Return>. Si el modo est desactivado, este comando lo
+auto-fill-mode <Return>. Si el modo est desactivado, este comando lo
activa, y si el modo est activado, este comando lo desactiva.
Decimos que el comando "cambia el modo".
->> teclee M-x auto fill mode<Return> ahora. Luego inserte una lnea
+>> teclee M-x auto-fill-mode <Return> ahora. Luego inserte una lnea
de "asdf " repetidas veces hasta que la vea dividida en dos lneas.
Debe intercalar espacios porque Auto Fill slo rompe lneas en los
espacios.
@@ -861,15 +853,13 @@ ese prrafo.
* BUSCAR
--------
-Emacs puede hacer bsquedas de cadenas (grupos de caracteres o
-palabras contiguos) hacia adelante a travs del texto o hacia atrs en
-el mismo. La bsqueda de una cadena es un comando de movimiento de
+Emacs puede hacer bsquedas de cadenas (una "cadena" es un grupo de
+caracteres contiguos) hacia adelante a travs del texto o hacia atrs
+en el mismo. La bsqueda de una cadena es un comando de movimiento de
cursor; mueve el cursor al prximo lugar donde esa cadena aparece.
-El comando de bsqueda de Emacs es diferente a los comandos de
-bsqueda de los dems editores, en que es "incremental". Esto
-significa que la bsqueda ocurre mientras teclea la cadena para
-buscarla.
+El comando de bsqueda de Emacs es "incremental". Esto significa que
+la bsqueda ocurre mientras teclea la cadena para buscarla.
El comando para iniciar una bsqueda es C-s para bsqueda hacia
adelante, y C-r para la bsqueda hacia atrs. PERO ESPERE! No los
@@ -886,7 +876,7 @@ quiere buscar. <Return> termina una bsqueda.
Ahora ha buscado "cursor", una vez.
>> Teclee C-s de nuevo, para buscar la siguiente ocurrencia de
"cursor".
->> Ahora teclee <Delback> cuatro veces y vea como se mueve el cursor.
+>> Ahora teclee <DEL> cuatro veces y vea como se mueve el cursor.
>> Teclee <Return> para terminar la bsqueda.
Vi lo que ocurri? Emacs, en una bsqueda incremental, trata de ir
@@ -895,27 +885,22 @@ ir a la prxima ocurrencia de 'cursor' solo teclee C-s de nuevo. Si
tal ocurrencia no existe, Emacs pita y le dice que la bsqueda actual
est fallando ("failing"). C-g tambin termina la bsqueda.
-NOTA: En algunos sistemas, teclear C-s dejar inmvil la pantalla y no
-podr ver ms respuesta de Emacs. Esto indica que una
-"caracterstica" del sistema operativo llamada "control de flujo" est
-interceptando el C-s y no permitindole llegar hasta Emacs. Para
-descongelar la pantalla, teclee C-q. Luego consulte la seccin
-"Entrada Espontnea para Bsqueda Incremental" en el manual de Emacs
-para consejos de cmo tratar con esta "caracterstica".
-
-Si se encuentra en medio de una bsqueda incremental y teclea
-<Delback>, notar que el ltimo carcter de la cadena buscada se borra
-y la bsqueda vuelve al sitio anterior de la bsqueda. Por ejemplo,
-suponga que ha tecleado "c", para buscar la primera ocurrencia de "c".
-Ahora, si teclea "u", el cursor se mover a la primera ocurrencia de
-"cu". Ahora teclee <Delback>. Esto borra la "u" de la cadena
-buscada, y el cursor vuelve a la primera ocurrencia de "c".
+Si se encuentra en medio de una bsqueda incremental y teclea <DEL>,
+la bsqueda "vuelve" a un punto anterior. Si teclea <DEL> justo
+despus de teclear C-s para avanzar hasta la siguiente ocurrencia de
+la cadena buscada, el cursor retrocede a una ocurrencia previa. Si no
+hay ocurrencias previas, <DEL> borra el ltimo carcter de la cadena
+buscada. Por ejemplo, suponga que ha tecleado "c", para buscar la
+primera ocurrencia de "c". Ahora, si teclea "u", el cursor se mover
+a la primera ocurrencia de "cu". Ahora teclee <DEL>. Esto borra la
+"u" de la cadena buscada, y el cursor vuelve a la primera ocurrencia
+de "c".
Si est en medio de una bsqueda y teclea un carcter control o meta
(con algunas pocas excepciones: los caracteres que son especiales en
una bsqueda, tales como C-s y C-r), la bsqueda termina.
-El C-s inicia una exploracin que busca alguna ocurrencia de la cadena
+C-s inicia una exploracin que busca alguna ocurrencia de la cadena
buscada DESPUS de la posicin actual del cursor. Si quiere buscar
algo anterior en el texto, teclee en cambio C-r. Todo lo que hemos
dicho sobre C-s tambin se aplica a C-r, excepto que la direccin de
@@ -926,14 +911,16 @@ la bsqueda se invierte.
--------------------
Una de las caractersticas agradables de Emacs es que se puede mostrar
-ms de una ventana en la pantalla al mismo tiempo.
+ms de una ventana en la pantalla al mismo tiempo. (Note que Emacs
+usa el trmino "marcos", descrito en la siguiente seccin, para
+referirse a lo que otras aplicaciones llaman "ventanas". El manual de
+Emacs contiene un Glosario de trminos.)
->> Mueva el cursor a esta lnea y teclee C-u 0 C-l (eso es CONTROL-L,
- no CONTROL-1).
+>> Mueva el cursor a esta lnea y teclee C-l C-l.
->> Ahora teclee C-x 2 que divide la pantalla en dos ventanas. Ambas
- ventanas muestran este tutorial. El cursor permanece en la ventana
- superior.
+>> Ahora teclee C-x 2 que divide la pantalla en dos ventanas.
+ Ambas ventanas muestran este tutorial. El cursor de edicin
+ permanece en la ventana superior.
>> Teclee C-M-v para desplazar la ventana inferior.
(Si no tiene una tecla META real, teclee ESC C-v.)
@@ -947,24 +934,25 @@ ms de una ventana en la pantalla al mismo tiempo.
superior.
El cursor en la ventana superior est justo donde estaba antes.
-Puede continuar usando C-x o para cambiar entre las ventanas. Cada
-ventana tiene su propia posicin del cursor, pero nicamente una
-ventana actual muestra el cursor. Todos los comandos de edicin
-comunes se aplican a la ventana en que est el cursor. Llamaremos
-esto la "ventana seleccionada".
+Puede continuar usando C-x o para cambiar entre las ventanas. La
+"ventana seleccionada", donde tiene lugar casi toda la edicin, es la
+que tiene un cursor muy visible que parpadea cuando usted no est
+tecleando. Las otras ventanas tienen sus propia posicin del cursor;
+si est ejecutando Emacs en una pantalla grfica, esos cursores se
+muestran como rectngulos vacos que no parpadean.
El comando C-M-v es muy til cuando est editando un texto en una
-ventana y usando la otra ventana como referencia. Puede mantener el
-cursor siempre en la ventana donde est editando, y avanzar a la otra
-ventana secuencialmente con C-M-v.
+ventana y usando la otra ventana como referencia. Sin moverse de la
+ventana seleccionada, puede desplazar el texto de la otra ventana con
+C-M-v.
C-M-v es un ejemplo de un carcter CONTROL-META. Si tiene una tecla
-META real, puede teclear C-M-v pulsando a la vez CONTROL y META
+META (o Alt), puede teclear C-M-v pulsando a la vez CONTROL y META
mientras teclea v. No importa qu tecla "vaya primero", CONTROL o
META, porque las dos teclas actan modificando los caracteres que
teclea.
-Si no tiene una tecla META real, y en vez de eso usa ESC, el orden s
+Si no tiene una tecla META, y en vez de eso usa ESC, el orden s
importa: debe teclear ESC seguido de Control-v, porque Control-ESC v
no funcionar. Esto es porque ESC es un carcter que tiene valor por
s mismo, no es una tecla modificadora.
@@ -992,6 +980,32 @@ diferentes:
borrar la ventana inferior.
+* MLTIPLES MARCOS
+------------------
+
+Emacs puede crear tambin mltiples "marcos". Marco es como
+denominamos a un grupo de ventanas, junto con sus menus, barras de
+desplazamiento, reas de eco, etc. En entornos grficos, lo que Emacs
+denomina "marco" es lo que otras aplicaciones llaman "ventana". En
+entornos grficos, es posible mostrar varios marcos al mismo tiempo.
+En una terminal, solo se puede mostrar un marco a la vez.
+
+>> Teclee M-x make-frame <Return>.
+ En la pantalla aparecer un nuevo marco.
+
+En el nuevo marco puede hacer todo lo que haca en el marco original.
+El primer marco no tiene nada de especial.
+
+>> Teclee M-x delete-frame <Return>.
+ Esto destruye el marco seleccionado.
+
+Tambin puede destruir un marco mediante el mtodo normal que ofrezca
+el entorno grfico (a menudo, pinchando con el ratn en un botn
+etiquetado como "X" en alguna de las esquinas superiores del marco).
+Si al hacer eso destruye el ltimo marco de Emacs, la aplicacin
+termina.
+
+
* NIVELES RECURSIVOS DE EDICIN
--------------------------------
@@ -1024,32 +1038,27 @@ Emacs. Todos estos comandos de "ayuda" comienzan con el carcter
Control-h, que es llamado "el carcter de Ayuda (Help)".
Para usar las funciones de ayuda, teclee el carcter C-h, y luego un
-carcter decidiendo qu tipo de ayuda quiere. Si est REALMENTE
+carcter que especifica qu tipo de ayuda quiere. Si est REALMENTE
perdido teclee C-h ? y Emacs le dir qu tipo de ayuda puede
ofrecerle. Si ha tecleado C-h y decide que no quiere ninguna ayuda,
teclee C-g para cancelarlo.
-(En algunas instalaciones cambian el significado del carcter C-h.
-Realmente no deberan hacer esto como una poltica para todos los
-usuarios, as que tiene argumentos para quejarse al administrador del
-sistema. Mientras tanto, si C-h no muestra un mensaje de ayuda en el
-final de la pantalla, intente teclear la tecla F1 o, en su lugar, M-x
-help <Return>).
+(Si C-h no muestra un mensaje de ayuda en el final de la pantalla,
+intente teclear la tecla F1 o, en su lugar, M-x help <Return>.)
La funcin de AYUDA ms bsica es C-h c. Teclee C-h, el carcter c y
un carcter de comando o secuencia de comando; Emacs le mostrar
una descripcin muy breve del comando.
>> Teclee C-h c C-p.
- El mensaje debe ser algo como
+ El mensaje debe ser algo como
C-p runs the command previous-line
-Esto le dice el "nombre de la funcin". Los nombres de funcin se
-usan principalmente para adecuar y extender Emacs. Pero ya que los
-nombres de las funciones se eligen para indicar lo que el comando
-hace, tambin pueden servir como una breve documentacin: suficiente
-para recordarle los comandos que ha aprendido.
+Esto le dice el "nombre de la funcin". Ya que los nombres de las
+funciones se eligen para indicar lo que hace el comando, pueden servir
+como una breve documentacin: suficiente para recordarle los comandos
+que ha aprendido.
Los comandos de mltiples caracteres tales como C-x C-s y (s no tiene
las teclas META o EDIT o ALT) <ESC>v tambin estn permitidos despus
@@ -1062,22 +1071,23 @@ C-h c.
Esto muestra la documentacin de la funcin, al igual que el nombre,
en una ventana de Emacs. Cuando haya terminado de leer el resultado,
-teclee C-x 1 para deshacerse del texto de ayuda. No tiene que hacer
-esto ahora. Puede hacer algunas ediciones mientras se refiere
-al texto de ayuda, y entonces teclear C-x 1.
+teclee C-x 1 para deshacerse de la ventana. No tiene que hacer esto
+ahora. Puede hacer algunas ediciones mientras se refiere al texto de
+ayuda, y entonces teclear C-x 1.
Aqu hay algunas otras opciones tiles de C-h:
C-h f Describe una funcin. Usted teclea el nombre de la
funcin.
->> Intente teclear C-h f previous-line<Return>.
+>> Intente teclear C-h f previous-line <Return>.
Esto muestra toda la informacin que Emacs tiene sobre la funcin
que implementa el comando C-p
-Un comando similar, C-h v, muestra la documentacin de variables cuyos
-valores pueda poner para adecuar el comportamiento de Emacs. Necesita
-teclear el nombre de la variable cuando Emacs pregunte por ella.
+Un comando similar, C-h v, muestra documentacin de las variables,
+incluyendo los valores que pueda poner para adaptar el comportamiento
+de Emacs. Deber teclear el nombre de la variable cuando Emacs
+pregunte por ella.
C-h a Comando Apropos. Teclee una palabra y Emacs har una
lista de todos los comandos que contengan esa palabra.
@@ -1086,48 +1096,49 @@ teclear el nombre de la variable cuando Emacs pregunte por ella.
listar una secuencia de uno o dos caracteres la cual
ejecutar el mismo comando.
->> Teclee C-h a file<Return>.
+>> Teclee C-h a file <Return>.
Esto muestra en otra ventana una lista de todos los comandos M-x con
-la palabra "file" en sus nombres. Ver comandos de caracteres como
-C-x C-f listados adems de los nombres de los comandos
-correspondientes tales como find-file.
+la palabra "file" en sus nombres. Ver los comandos de caracteres
+listados junto a los nombres de los comandos correspondientes (por
+ejemplo, C-x C-f junto a find-file).
>> Teclee C-M-v para desplazar la ventana de ayuda. Haga esto unas
cuantas veces.
>> Teclee C-x 1 para borrar la ventana de ayuda.
- C-h i Leer los Manuales En-Lnea (alias Info). Este comando
+ C-h i Leer los manuales incluidos (alias Info). Este comando
lo pone en un buffer especial llamado `*info*' donde
- puede leer manuales en lnea de los paquetes
- instalados en su sistema. Teclee m Emacs <Return>
- para leer el manual de Emacs. S nunca ha usado Info
- antes, teclee ? y Emacs lo llevar en una visita
- guiada de los servicios del modo de Info. Una vez que
- haya terminado este tutorial, debera considerar el
- manual Info de Emacs como su documentacin primaria.
+ puede leer manuales de los paquetes instalados en su
+ sistema. Teclee m emacs <Return> para leer el manual
+ de Emacs. Si nunca ha usado Info, teclee ? y Emacs y
+ lo llevar por una visita guiada de los servicios del
+ modo de Info. Una vez que haya terminado este
+ tutorial, debera considerar el manual Info de Emacs
+ como su documentacin primaria.
* MS CARACTERSTICAS
---------------------
-Puede aprender ms de Emacs leyendo su manual, ya sea como libro o en
-lnea en el Info (use el men Ayuda--"Help"--o teclee F10 h r). Dos
-caractersticas que pueden gustarle son la completacin, que ahorra
-teclear, y dired, que simplifica el manejo de archivos.
+Puede aprender ms acerca de Emacs leyendo su manual, ya sea como
+libro o en el propio Emacs (use el men Ayuda, "Help", o teclee C-h
+r). Dos caractersticas que pueden gustarle son la completacin, que
+ahorra teclear, y dired, que simplifica el manejo de archivos.
La completacin es una manera de ahorrar teclear innecesariamente.
Por ejemplo, si quiere cambiarse al buffer "*Messages*", puede teclear
C-x b *M<Tab> y emacs encontrar el resto del nombre del buffer tan
lejos como pueda determinar de lo que ya haya tecleado. La
-completacin es descrita en el Info del manual de Emacs en el nodo
-llamado "Completation".
+completacin tambin funciona con nombres de comandos y de archivos.
+La completacin se describe en el Info del manual de Emacs en el nodo
+llamado "Completion".
Dired le permite listar los archivos en un directorio (y opcionalmente
sus subdirectorios), moverse alrededor de esa lista, visitar,
renombrar, borrar y aparte de eso operar en los archivos. Dired est
-descrito en el Info en el manual de Emacs en el nodo llamado "Dired".
+descrito en el manual de Emacs en el nodo llamado "Dired".
El manual tambin describe otras caractersticas de Emacs.
@@ -1135,13 +1146,11 @@ El manual tambin describe otras caractersticas de Emacs.
* CONCLUSIN
------------
-Recuerde, para salir permanentemente de Emacs use C-x C-c. Para salir
-temporalmente a un intrprete de comandos, de forma que puede volver a
-Emacs despus, use C-z.
+Para salir permanentemente de Emacs use C-x C-c.
Este tutorial intenta ser comprensible para todos los usuarios nuevos,
-as que si encuentra algo que no est claro, no se siente y se culpe a
-s mismo: Qujese!
+as que si encuentra algo que no est claro, no se quede parado
+culpndose a s mismo: Qujese!
* COPIA
@@ -1174,12 +1183,13 @@ La versin en espaol ha sido revisada y corregida por:
La versin en espaol ha sido actualizada por:
Rafael Seplveda <drs@gnulinux.org.mx>
+ Juanma Barranquero <lekktu@gmail.com>
Por favor, en caso de duda, slo es vlido el original en ingls de la
siguiente nota de derechos de reproduccin (que puede encontrar en el
archivo TUTORIAL).
-Copyright (C) 1985, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
Se permite a cualquiera hacer o distribuir copias literales de este
documento como se recibe, en cualquier medio, siempre que la nota
diff --git a/etc/tutorials/TUTORIAL.fr b/etc/tutorials/TUTORIAL.fr
index 5ba4ebae9c3..7b829ccee73 100644
--- a/etc/tutorials/TUTORIAL.fr
+++ b/etc/tutorials/TUTORIAL.fr
@@ -12,15 +12,16 @@ ou ALT). Pour ces touches, nous utiliserons les abrviations suivantes :
touches n'existe, pressez puis relchez la touche ESC et
tapez <car>. Nous crirons <ESC> pour dsigner la touche ESC.
-Tapez C-x C-c (deux caractres) pour terminer une session Emacs.
-Dans ce didacticiel, les caractres ">>" en marge gauche indiquent les
-directions suivre pour essayer une commande. Ainsi :
+Note importante : tapez C-x C-c (deux caractres) pour terminer une
+session Emacs. Pour interrompre une commande partiellement entre,
+tapez C-g. Dans ce didacticiel, les caractres ">>" en marge gauche
+indiquent les directions suivre pour essayer une commande. Ainsi :
<<Lignes blanches insres aprs cette ligne par help-with-tutorial>>
[Centre de page delibrment vide. Le texte continue ci-dessous.]
->> Tapez C-v (Voir l'cran suivant) pour passer l'cran suivant
- (faites-le, pressez la touche CTRL tout en pressant la touche v).
- partir de maintenant, vous devrez le faire chaque fois que
- vous avez fini de lire l'cran.
+>> Tapez C-v (Voir l'cran suivant) pour passer l'cran suivant
+ (faites-le, pressez la touche CTRL tout en pressant la touche v).
+ partir de maintenant, vous devrez le faire chaque fois que
+ vous avez fini de lire l'cran.
Vous remarquerez qu'il y a un recouvrement de deux lignes lorsque l'on
passe d'un cran un autre : cela permet une certaine continuit dans
@@ -32,11 +33,8 @@ C-v. Pour revenir un cran en arrire, tapez M-v (pressez la touche
META tout en appuyant sur v ou faites <ESC>v si vous n'avez pas de
touche META, EDIT ou ALT).
->> Faites M-v, puis C-v plusieurs fois.
+>> Faites M-v, puis C-v plusieurs fois.
-Si votre terminal en dispose, vous pouvez galement utiliser les
-touches PgUp et PgDn pour monter ou descendre d'un cran, bien que les
-combinaisons C-v et M-v soient plus efficaces.
* RSUM
--------
@@ -52,7 +50,14 @@ Les commandes suivantes servent manipuler des crans :
>> Notez le texte situ ct du curseur, puis faites C-l.
Recherchez l'emplacement du curseur et vous remarquerez que
- c'est le mme texte qui est ct de lui.
+ c'est le mme texte qui est ct de lui, mais il est dsormais
+ au centre de l'cran.
+ Si vous appuyez de nouveau sur C-l, ce bout de texte se dplacera
+ en haut de l'cran. Faite encore C-l, et il se dplace en bas.
+
+Si votre terminal en dispose, vous pouvez galement utiliser les
+touches PgUp et PgDn pour monter ou descendre d'un cran, bien que les
+combinaisons C-v et M-v soient plus efficaces.
* GESTION DU CURSEUR
@@ -89,7 +94,6 @@ qu'il tait facile de se rappeler que P signifiait Previous
des C-p. Notez ce que fait C-p lorsque le curseur est au milieu de
la ligne.
-
Chaque ligne de texte se termine par un caractre Newline, qui sert
la sparer de la ligne suivante. La dernire ligne de votre fichier
devrait se terminer par un Newline (mais Emacs n'exige pas qu'il y en
@@ -175,7 +179,7 @@ ainsi que les commandes de dplacement par mots et par phrases.
M-< (Meta infrieur ) et M-> (Meta suprieur ) sont deux autres
commandes importantes de dplacement du curseur. La premire renvoie
-au tout dbut du texte, la seconde la fin de celui-ci.
+au tout dbut du texte, la seconde la toute fin de celui-ci.
Sur certains claviers, le "<" se trouve sous la virgule, vous devez
donc utiliser la touche <Maj> pour y avoir accs. Sur ces terminaux,
@@ -223,14 +227,14 @@ vues jusqu' maintenant) l'utilisent comme indicateur -- la prsence
d'un paramtre prfixe, quelle que soit sa valeur, force la commande
agir diffremment.
-C-v et M-v constituent un autre type d'exception. Lorsqu'on leur
-donne un paramtre, elles font dfiler l'cran vers le haut ou vers le
-bas du nombre de lignes indiqu au lieu de passer d'un cran complet
-l'autre. C-u 8 C-v, par exemple, fait dfiler l'cran de 8 lignes.
+C-v et M-v constituent un autre type d'exception. Lorsqu'on leur donne
+un paramtre, elles font dfiler le texte vers le haut ou vers le bas
+du nombre de lignes indiqu au lieu de passer d'un cran complet
+l'autre. C-u 8 C-v, par exemple, fait dfiler le texte de 8 lignes.
>> Faites C-u 8 C-v.
-Cela a d dplacer l'cran de 8 lignes vers le haut. Si vous voulez
+Cela a d dplacer le texte de 8 lignes vers le haut. Si vous voulez
redescendre de 8 lignes, il suffit de passer ce nombre comme paramtre
de M-v.
@@ -240,18 +244,12 @@ ou scrollbar sur le bord gauche de la fentre d'Emacs. Vous pouvez
faire dfiler le texte en cliquant avec la souris dans cette barre de
dfilement.
->> Cliquez avec le bouton du milieu en haut de la zone mise en
- vidence dans la barre de dfilement. Cela devrait dplacer le
- texte jusqu' une position dpendant de la hauteur o vous avez
- cliqu.
+Si votre souris a une molette, vous pouvez aussi l'utiliser pour faire
+dfiler le texte.
->> Dplacez la souris de bas en haut tout en maintenant son bouton du
- milieu press. Vous constaterez que le texte dfile vers le haut et
- vers le bas en fonction du dplacement de la souris.
-
-* QUAND EMACS EST MUET
-----------------------
+* QUAND EMACS NE RPOND PLUS
+----------------------------
Si Emacs cesse de rpondre vos commandes, vous pouvez le dbloquer
en toute scurit avec C-g. Cette commande fait stopper une commande
@@ -269,8 +267,8 @@ Si vous avez tap <ESC> par erreur, vous pouvez vous en dbarrasser
avec un C-g.
-* COMMANDES DSACTIVES
-------------------------
+* COMMANDES DSACTIVES
+-----------------------
Certaines commandes d'Emacs sont dsactives afin que les
utilisateurs dbutants ne puissent les utiliser par accident.
@@ -284,7 +282,8 @@ rponse la question. Si vous ne voulez pas excuter la commande
dsactive, il suffit normalement de rpondre n .
>> Faites C-x C-l (qui est une commande dsactive),
- puis rpondez n la question.
+ puis rpondez n la question.
+
* FENTRES
----------
@@ -302,17 +301,16 @@ contenant le curseur pour qu'elle occupe tout l'cran. Cette commande
supprime toutes les autres fentres.
>> Dplacez le curseur sur cette ligne et faites C-u 0 C-l.
->> Faites CONTROLE-h k CONTROLE-f.
+>> Faites C-h k C-f.
Vous constatez que cette fentre est rduite alors qu'une nouvelle
- apparat pour afficher la documentation sur la commande CONTROLE-f.
+ apparat pour afficher la documentation sur la commande C-f.
>> Faites C-x 1 et la fentre de documentation disparat.
-Cette commande est diffrente de celles que nous avons dj vues car
-elle est forme de deux caractres. Elle commence par le caractre
-CONTROLE-x, comme le font de nombreuses commandes de manipulation de
-fentres, fichiers, tampons et autres entits associes. Ces commandes
-font deux, trois ou quatre caractres.
+Il y a toute une srie de commandes qui commencent par CONTROL-x;
+nombre d'entre elles ont voir avec la manipulation de fentres,
+fichiers, tampons et autres entits associes. Ces commandes font
+deux, trois ou quatre caractres de long.
* INSERTION ET SUPPRESSION
@@ -324,24 +322,24 @@ comme du texte par Emacs et insrs immdiatement. Tapez <Entre> (la
touche de retour chariot) pour insrer un caractre Newline.
Vous pouvez effacer le dernier caractre que vous avez tap en faisant
-<Delback>. <Delback> est une touche du clavier -- la mme que vous
-utilisez habituellement en dehors d'Emacs, pour supprimer le dernier
-caractre saisi. Il s'agit gnralement de la grande touche situe
-quelques lignes au-dessus de la touche Entre . Elle est
-habituellement nomme Delete , Del , Suppr ou Backspace .
+<DEL>. <DEL> est une touche du clavier -- la mme que vous utilisez
+habituellement en dehors d'Emacs, pour supprimer le dernier caractre
+saisi. Il s'agit gnralement de la grande touche situe quelques
+lignes au-dessus de la touche Entre . Elle est habituellement
+nomme Delete , Del , Suppr ou Backspace .
Si cette grande touche s'appelle Backspace , c'est celle-l qui
-reprsente <Delback>. Votre clavier peut galement comporter une autre
+reprsente <DEL>. Votre clavier peut galement comporter une autre
touche, nomme Delete , Del ou Suppr , mais ce n'est pas
-<Delback>.
+<DEL>.
-Plus gnralement, <Delback> efface le caractre situ immdiatement
-avant la position courante du curseur.
+Plus gnralement, <DEL> efface le caractre situ immdiatement avant
+la position courante du curseur.
>> Tapez quelques caractres puis effacez-les en faisant plusieurs
- fois <Delback>. Ne vous inquitez pas de modifier ce fichier ; vous
- ne modifierez pas le didacticiel principal mais uniquement votre
- copie personnelle de celui-ci.
+ fois <DEL>. Ne vous inquitez pas de modifier ce fichier ; vous ne
+ modifierez pas le didacticiel principal mais uniquement votre copie
+ personnelle de celui-ci.
Lorsqu'une ligne de texte devient trop longue pour tenir sur une seule
ligne de l'cran, elle se continue sur une deuxime ligne
@@ -352,7 +350,7 @@ droite indique une ligne qui se poursuit sur la ligne suivante.
>> Insrez du texte jusqu' atteindre la marge droite et continuez
d'en insrer. Vous verrez apparatre une ligne de continuation.
->> Faites des <Delback> pour effacer le texte jusqu' ce que la ligne
+>> Faites des <DEL> pour effacer le texte jusqu' ce que la ligne
tienne nouveau sur une seule ligne d'cran. La ligne de
continuation disparat.
@@ -362,8 +360,8 @@ en une seule ligne. Si la ligne rsultante est trop longue pour tenir
dans la largeur de l'cran, elle s'affichera avec une ligne de
continuation.
->> Placez le curseur au dbut d'une ligne et faites <Delback>.
- Cela fusionne cette ligne avec la ligne prcdente.
+>> Placez le curseur au dbut d'une ligne et faites <DEL>. Cela
+ fusionne cette ligne avec la ligne prcdente.
>> Faites <Entre> pour remettre le Newline que vous avez supprim.
@@ -371,48 +369,53 @@ Rappelez-vous que la plupart des commandes Emacs peuvent utiliser un
nombre de rptitions ; les caractres de texte font de mme. La
rptition d'un caractre de texte l'insre plusieurs fois.
->> Faites C-u 8 * pour insrer ********.
+>> Faites C-u 8 * pour insrer ********.
Vous connaissez maintenant la mthode la plus simple pour taper du
texte dans Emacs et pour corriger les erreurs. Vous pouvez galement
effacer des mots ou des lignes entires. Voici un rsum des
oprations de suppression :
- <Delback> Efface le caractre situ avant le curseur
- C-d Efface le caractre situ aprs le curseur
+ <DEL> Efface le caractre situ avant le curseur
+ C-d Efface le caractre situ aprs le curseur
- M-<Delback> Supprime le mot situ avant le curseur
- M-d Supprime le mot situ aprs le curseur
+ M-<DEL> Supprime le mot situ avant le curseur
+ M-d Supprime le mot situ aprs le curseur
- C-k Supprime du curseur la fin de la ligne
- M-k Supprime jusqu' la fin de la phrase courante
+ C-k Supprime du curseur la fin de la ligne
+ M-k Supprime jusqu' la fin de la phrase courante
-Vous noterez que <Delback> et C-d, par rapport M-<Delback> et M-d,
-ont la mme relation que C-f et M-f (en fait, <Delback> n'est pas
-vraiment un caractre de contrle, mais ne nous soucions pas de cela)
-C-k et M-k sont un peu comme C-e et M-e.
+Vous noterez que <DEL> et C-d, par rapport M-<DEL> et M-d, ont la
+mme relation que C-f et M-f (en fait, <DEL> n'est pas vraiment un
+caractre de contrle, mais ne nous soucions pas de cela) C-k et M-k
+sont un peu comme C-e et M-e.
Vous pouvez aussi supprimer n'importe quelle zone du tampon en
utilisant une mthode unique et gnrale. Placez-vous une extrmit
-de cette zone et tapez soit C-@, soit C-SPC (SPC dsigne la barre
-espace). Puis, allez l'autre extrmit et faites C-w. Cela supprime
-tout le texte compris entre ces deux positions.
+de cette zone et tapez C-SPC (SPC dsigne la barre espace). Puis,
+allez l'autre extrmit du texte que vous voulez supprimer. En
+faisant cela, Emacs surligne le texte entre le curseur et la position
+d'o vous avez tap C-SPC. Enfin, faites C-w. Cela supprime tout le
+texte compris entre ces deux positions.
>> Placez le curseur sur le V au dbut du paragraphe prcdent.
>> Faites C-SPC. Emacs devrait afficher un message "Mark set"
en bas de l'cran.
->> Dplacez le curseur sur le x d' extrmit , sur la seconde ligne
- du paragraphe.
+>> Dplacez le curseur sur le x d' extrmit , sur la seconde
+ ligne du paragraphe.
>> Faites C-w. Cela supprimera le texte allant du V jusqu'au
caractre situ juste avant le x.
La diffrence entre effacer et supprimer est que vous pouvez
rinsrer le texte supprim , alors que c'est impossible avec ce
-qui a t effac . La rinsertion d'un texte supprim s'appelle le
+qui a t effac (Vous pouvez cependant annuler un effacement
+- voir plus bas.) La rinsertion d'un texte supprim s'appelle le
yanking . Gnralement, les commandes qui tent beaucoup de texte
le suppriment (afin que vous puissiez le rcuprer), tandis que celles
qui ne font qu'ter un seul caractre, des lignes blanches ou des
espaces, les effacent (vous ne pouvez donc pas rcuprer ce texte).
+Dans le cas le plus simple et sans paramtre, <DEL> et C-d effacent.
+Avec un paramtre, ces commandes suppriment.
>> Placez le curseur au dbut d'une ligne non vide puis faites
C-k pour supprimer le texte de celle-ci.
@@ -426,11 +429,16 @@ il dtruit ce nombre de lignes ET leur contenu. Ce n'est pas une
simple rptition : C-u 2 C-k dtruit deux lignes et leurs Newlines
alors que taper deux fois C-k n'aurait pas le mme effet.
-Vous pouvez ramener le texte supprim la place qu'il occupait ou
-n'importe quel autre emplacement du texte. Vous pouvez rcuprer
-plusieurs fois ce texte afin d'en crer plusieurs copies.
+Rinsrer du texte supprim est appel yanking ( rcuprer ).
+(Pensez au geste de tirer vers soi du texte qui a t jet.) Vous
+pouvez rcuprer le texte supprim la place qu'il occupait,
+n'importe quel autre emplacement du texte, ou mme dans un autre
+fichier. Vous pouvez rcuprer plusieurs fois ce texte afin d'en
+crer plusieurs copies. Certains diteurs de texte appellent
+ couper et coller les oprations de supprimer et de
+ rcuprer (voir le Glossaire dans le manuel d'Emacs.)
-La commande de rcupration est C-y. Elle rinsre le dernier texte
+La commande de rcupration est C-y. Elle rinsre le dernier texte
supprim la position courante du curseur.
>> Essayez : faites C-y pour rcuprer le texte.
@@ -454,12 +462,12 @@ M-y. Aprs avoir fait C-y pour rcuprer la suppression la plus
rcente, M-y remplacera ce texte rcupr par le texte supprim
prcdemment. En rptant les M-y, vous ramenez les suppressions de
plus en plus anciennes. Lorsque vous avez atteint le texte que vous
-recherchez, vous n'avez rien besoin de faire pour le
-conserver. Continuez simplement diter votre texte et laissez le
-texte rcupr o il est.
+recherchez, vous n'avez rien besoin de faire pour le conserver.
+Continuez simplement diter votre texte et laissez le texte
+rcupr o il est.
-Si vous faites M-y suffisamment de fois, vous reviendrez votre point
-de dpart (la suppression la plus rcente).
+Si vous faites M-y un nombre suffisant de fois, vous reviendrez
+ votre point de dpart (la suppression la plus rcente).
>> Supprimez une ligne, dplacez vous et supprimez une autre ligne.
Puis, faites C-y pour rcuprer cette dernire.
@@ -474,34 +482,36 @@ de dpart (la suppression la plus rcente).
* ANNULATION
------------
-Si vous modifiez le texte, puis que vous dcidez que c'tait une
-erreur, vous pouvez annuler cette modification avec la commande C-x u
-(comme Undo, dfaire).
+Si vous modifiez le texte, puis dcidez que c'tait une erreur,
+vous pouvez annuler cette modification avec la commande C-/.
-Normalement C-x u annule les modifications d'une seule commande ; si
-vous rptez plusieurs fois C-x u dans une ligne, chaque rptition
+Normalement C-/ annule les modifications d'une seule commande ; si
+vous rptez plusieurs fois C-/ dans une ligne, chaque rptition
annulera une commande supplmentaire.
Il y a quand mme deux exceptions : les commandes qui ne modifient pas
le texte ne comptent pas (cela inclut les commandes de dplacement du
curseur et les commandes de dfilement du texte) et les caractres
auto-insrs sont habituellement grs par groupes allant jusqu' 20
-(ceci afin de rduire le nombre de C-x u que vous devriez taper pour
+(ceci afin de rduire le nombre de C-/ que vous devriez taper pour
annuler l'insertion de texte).
->> Supprimez cette ligne avec C-k, puis faites C-x u pour la voir
+>> Supprimez cette ligne avec C-k, puis faites C-/ pour la voir
rapparatre.
C-_ est une autre commande d'annulation ; elle fonctionne exactement
-comme C-x u mais est plus facile taper plusieurs fois dans une
-ligne. Son inconvnient est qu'elle n'est pas facile taper sur
-certains claviers, c'est pourquoi C-x u existe aussi. Sur certains
-terminaux, vous pouvez taper C-_ en tapant / tout en pressant la
-touche CTRL.
+comme C-/. Sur certains terminaux, taper C-/ envoie en fait C-_ Emacs.
+Autrement, C-x u marche aussi exactement comme C-/, mais est un peu
+moins pratique taper.
-Un paramtre numrique pass C-_ ou C-x u agit comme un nombre de
+Un paramtre numrique pass C-_ ou C-/ agit comme un nombre de
rptitions.
+Vous pouvez annuler la suppression de texte de la mme manire que
+vous pouvez annuler son effacement. La distinction entre supprimer
+et effacer quelque chose n'intervient que pour la rcupration avec
+C-y; elle ne fait aucune diffrence pour l'annulation.
+
* FICHIERS
----------
@@ -522,7 +532,7 @@ sauvegardez, Emacs garde le fichier original sous un nom modifi au
cas o vous dcideriez ensuite d'annuler vos modifications.
Si vous examinez le bas de l'cran, vous verrez une ligne qui commence
-et finit par des tirets et dbute par -1:-- TUTORIAL.fr ou quelque
+et finit par des tirets et dbute par -:--- TUTORIAL.fr ou quelque
chose comme a. Cette partie de l'cran montre normalement le nom du
fichier que vous tes en train de visiter. Pour l'instant, vous
visitez un fichier appel TUTORIAL.fr , qui est votre copie
@@ -531,8 +541,8 @@ Emacs, son nom apparat cet endroit prcis.
Une particularit de la commande permettant de trouver un fichier est
que vous devez donner le nom du fichier voulu. On dit que la commande
- lit un paramtre partir du terminal (ici, le paramtre est le
-nom du fichier). Aprs avoir fait la commande
+ lit un paramtre (ici, le paramtre est le nom du fichier). Aprs
+avoir fait la commande
C-x C-f Trouve un fichier
@@ -561,11 +571,8 @@ deviennent permanentes, faites :
Cette commande copie dans le fichier le texte qui est dans Emacs. La
premire fois, Emacs renomme le fichier original afin qu'il ne soit
pas perdu. Le nom de cette sauvegarde est construit en ajoutant ~
- la fin du nom initial.
-
-Lorsque la sauvegarde est finie, Emacs affiche le nom du fichier
-crit. Sauvegardez intervalles rguliers afin de perdre le moins
-possible de travail au cas o votre systme se planterait.
+ la fin du nom initial. Lorsque la sauvegarde est finie, Emacs
+affiche le nom du fichier crit.
>> Faites C-x C-s pour sauvegarder votre copie du didacticiel.
Cela devrait crire "Wrote ...TUTORIAL.fr" en bas de l'cran.
@@ -594,7 +601,7 @@ Emacs.
Emacs stocke le texte de chaque fichier dans un objet appel tampon .
Trouver un fichier cre un nouveau tampon dans Emacs. Pour voir la
-liste des tampons existants dans votre session Emacs, faites
+liste des tampons existants dans votre session Emacs, faites :
C-x C-b Liste des tampons
@@ -607,14 +614,14 @@ pouvez voir dans une fentre Emacs fait toujours partie d'un tampon.
>> Faites C-x 1 pour faire disparatre la liste des tampons.
Lorsque vous avez plusieurs tampons, seul l'un d'entre eux est le
-tampon "courant" un instant donn : c'est celui que vous ditez. Si
-vous souhaitez diter un autre tampon, vous devez "basculer" vers
+tampon courant un instant donn : c'est celui que vous ditez.
+Si vous souhaitez diter un autre tampon, vous devez basculer vers
lui. Pour basculer vers un tampon correspondant un fichier, vous
pouvez le recharger avec C-x C-f mais il y a plus simple : utilisez la
commande C-x b en lui passant le nom du tampon.
->> Faites C-x b truc <Entre> pour revenir au tampon "truc", qui
- contient le texte du fichier "truc".
+>> Faites C-x b truc <Entre> pour revenir au tampon truc , qui
+ contient le texte du fichier truc .
Puis, faites C-x b TUTORIAL <Entre> pour revenir ce didacticiel.
La plupart du temps, le nom d'un tampon est le mme que celui du
@@ -625,13 +632,17 @@ noms de tous les tampons.
TOUT texte que vous visualisez dans une fentre Emacs fait toujours
partie d'un tampon, mais certains tampons ne correspondent pas des
fichiers : le tampon "*Buffer List*", par exemple, ne contient pas de
-fichiers mais la liste obtenue par C-x C-b. Le tampon "*Messages*" ne
-correspond pas non plus un fichier ; il contient la liste des
-messages apparus dans la ligne d'tat pendant votre session Emacs.
+fichiers mais la liste obtenue par C-x C-b. Ce didacticiel n'avait pas
+de fichier au dpart mais il en a un dsormais, car dans la section
+prcdente, vous avez tap C-x C-s pour l'enregistrer.
+
+Le tampon "*Messages*" ne correspond pas non plus un fichier ; il
+contient la liste des messages apparus dans la ligne d'tat pendant
+votre session Emacs.
>> Faites C-x b *Messages* <Entre> pour visualiser le tampon des
messages.
- Puis, faites C-x b TUTORIAL <Entre> pour revenir ce didacticiel.
+ Puis, faites C-x b TUTORIAL.fr <Entre> pour revenir ce didacticiel.
Si vous modifiez le texte d'un fichier, puis que vous chargez un autre
fichier, le premier ne sera pas sauvegard. Ses modifications restent
@@ -674,26 +685,23 @@ inquitez pour les modifications que vous avez faites, C-x C-c vous
proposera de sauvegarder tous les fichiers modifis avant de quitter
Emacs).
-C-z est la commande permettant de quitter *temporairement* Emacs --
-afin de pouvoir revenir la mme session plus tard.
+Si vous utiliser un affichage graphique, vous n'avez pas besoin de
+commande spciale pour vous dplacer d'Emacs une autre application.
+Vous pouvez le faire l'aide de la souris ou avec les commandes du
+gestionnaire de fentres. Cependant, si vous utilisez un terminal
+texte ne pouvant afficher qu'une application la fois, vous devez
+ suspendre Emacs pour passer n'importe quelle autre application.
-Sur les systmes qui le permettent, C-z suspend Emacs ;
-c'est--dire qu'il revient au shell mais ne dtruit pas Emacs. Avec
-les shells les plus courants, vous pouvez revenir Emacs en faisant
-la commande 'fg' ou '%emacs'.
-
-Sur les systmes qui n'implmentent pas ce mcanisme, C-z cre un
-sous-shell qui s'excute sous Emacs afin que vous puissiez lancer
-d'autres programmes et revenir Emacs ensuite : vous ne sortez
-pas vraiment d'Emacs. Dans ce cas, la commande shell 'exit' est le
-moyen habituel pour revenir Emacs partir de ce sous-shell.
+C-z est la commande permettant de quitter *temporairement* Emacs --
+afin de pouvoir revenir la mme session plus tard. Sur les systmes
+qui le permettent, C-z suspend Emacs ; c'est--dire qu'il revient
+au shell mais ne dtruit pas Emacs. Avec les shells les plus courants,
+vous pouvez revenir Emacs en faisant la commande 'fg' ou '%emacs'.
Le moment idal pour utiliser C-x C-c est lorsque l'on se
dconnecte. C'est aussi la commande adapte pour sortir d'un Emacs
-invoqu par un programme de courrier ou tout autre utilitaire car
-ceux-ci peuvent ne pas savoir comment grer la suspension d'Emacs. Dans
-des situations normales, si vous ne devez pas vous dconnecter, il est
-prfrable de suspendre Emacs avec C-z au lieu de le quitter.
+invoqu pour une modification rapide, par exemple par un programme de
+courrier ou tout autre utilitaire.
Il existe de nombreuses commandes C-x. Voici une liste de celles que
vous avez apprises :
@@ -708,7 +716,7 @@ vous avez apprises :
Les eXtensions de commandes nommes sont des commandes utilises
encore moins souvent, ou des commandes qui ne servent que dans
certains modes. Un exemple est la commande replace-string, qui
-remplace globalement une chane par une autre. Lorsque vous faites
+remplace une chane par une autre dans un tampon. Lorsque vous faites
M-x, Emacs affiche M-x en bas de l'cran et vous demande de taper le
nom de la commande, replace-string ici. Contentez-vous de faire
repl s<TAB> et Emacs compltera le nom (<TAB> reprsente la touche
@@ -724,7 +732,7 @@ paramtre par <Entre>.
Puis, faites M-x repl s<Entre>change<Entre>modifie<Entre>.
Notez comment cette ligne a t change : vous avez remplac le mot
- c-h-a-n-g--e par modifie chaque fois qu'il apparaissait aprs
+ change par modifie chaque fois qu'il apparaissait aprs
la position initiale du curseur.
@@ -753,8 +761,8 @@ sauves par la sauvegarde automatique.
-------------
Si Emacs constate que vous tapez les commandes multi-caractres
-lentement, il les affiche en bas de l'cran dans une zone nomme
-zone d'cho . La zone d'cho contient la dernire ligne de l'cran.
+lentement, il les affiche en bas de l'cran dans une zone nomme
+ zone d'cho . La zone d'cho contient la dernire ligne de l'cran.
* LIGNE DE MODE
@@ -763,18 +771,18 @@ zone d'cho . La zone d'cho contient la dernire ligne de l'cran.
La ligne place immdiatement au dessus de la zone d'cho s'appelle la
ligne de mode . Elle affiche quelque chose comme a :
--1:** TUTORIAL.fr (Fundamental)--L752--67%----------------
+ -:**- TUTORIAL.fr 64% L749 (Fundamental)
Cette ligne donne des informations sur l'tat d'Emacs et sur le texte
que vous tes en train d'diter.
Vous savez dj ce que signifie le nom de fichier -- c'est celui que
-vous avez charg. -NN%-- indique votre position actuelle dans le
-texte ; cela signifie que NN pour cent du texte se trouve au dessus du
-sommet de l'cran. Si le dbut du fichier est sur l'cran, il
-s'affichera --Top-- et non --00%--. Si le bas du texte est sur
-l'cran, il s'affichera --Bot--. Si tout le texte tient dans l'cran,
-il s'affichera --All--.
+vous avez charg. NN% indique votre position actuelle dans le texte ;
+cela signifie que NN pour cent du texte se trouve au dessus du sommet
+de l'cran. Si le dbut du fichier est sur l'cran, il s'affichera
+ Top et non 00% . Si le bas du texte est sur l'cran, il
+s'affichera Bot (comme bottom ). Si tout le texte tient dans
+l'cran, il s'affichera All .
Le L et les chiffres qui le suivent indiquent une position d'une faon
diffrente : ils indiquent le numro de la ligne courante du point.
@@ -786,7 +794,7 @@ simplement des tirets.
La partie de la ligne de mode situe entre parenthses indique les
modes d'dition dans lesquels vous vous trouvez. Le mode par dfaut
-est Fundamental et c'est celui que vous tes en train
+est le mode Fundamental et c'est celui que vous tes en train
d'utiliser. C'est un exemple de mode majeur .
Emacs possde de nombreux modes majeurs diffrents. Certains sont
@@ -806,7 +814,7 @@ exemple, est une commande pour basculer dans le mode Fundamental.
Si vous devez diter du texte en langage naturel, comme ce fichier,
vous utiliserez probablement le mode Text.
->> Faites M-x text mode<Entre>.
+>> Faites M-x text-mode<Entre>.
Ne vous inquitez pas, aucune des commandes Emacs que vous avez
apprises ne change beaucoup mais vous pouvez constater que M-f et M-b
@@ -820,7 +828,7 @@ les modes majeurs, mais fonctionnent un peu diffremment.
Pour lire la documentation sur votre mode majeur actuel, faites C-h m.
->> Faites une fois C-u C-v pour amener cette ligne prs du haut de l'cran.
+>> Faites C-l C-l pour amener cette ligne prs du haut de l'cran.
>> Faites C-h m pour voir comment le mode Text diffre du mode Fundamental.
>> Faites C-x 1 pour supprimer la documentation de l'cran.
@@ -842,7 +850,7 @@ faisant nouveau M-x auto fill mode<Entre>. Si le mode est
dsactiv, cette commande l'active et, s'il est activ, elle le
dsactive : on dit que la commande fait basculer le mode .
->> Faites M-x auto fill mode<Entre> puis insrez une ligne de
+>> Faites M-x auto-fill-mode<Entre> puis insrez une ligne de
plusieurs azer jusqu' ce qu'elle se divise en deux lignes.
Vous devez mettre des espaces entre eux car le mode Auto Fill ne
coupe les lignes que sur les espaces.
@@ -872,8 +880,7 @@ l'arrire. La recherche d'une chane est une commande de dplacement
du curseur : elle dplace le curseur l'emplacement o la chane
apparat.
-La commande de recherche d'Emacs est diffrente de celle que l'on
-trouve sur la plupart des diteurs car elle est incrmentale . Cela
+La commande de recherche d'Emacs est incrmentale . Cela
signifie que la recherche a lieu pendant que l'on tape la chane que
l'on recherche.
@@ -891,7 +898,7 @@ que vous recherchez. <Entre> termine une recherche.
pour constater ce que fait le curseur. Vous avez maintenant atteint
curseur une premire fois.
>> Tapez C-s nouveau pour trouver l'occurrence suivante de curseur .
->> Faites maintenant <Delback> quatre fois et tudiez les mouvements du
+>> Faites maintenant <DEL> quatre fois et tudiez les mouvements du
curseur.
>> Faites <Entre> pour mettre fin la recherche.
@@ -902,21 +909,13 @@ avec tape jusqu' cet instant. Pour aller sur l'occurrence suivante de
bippe et vous indique que la recherche a chou. C-g permet galement
de mettre fin la recherche.
-REMARQUE : Sur certains systmes, C-s glera l'cran et vous ne verrez
-plus rien se produire dans Emacs. Cela indique qu'une
- fonctionnalit du systme d'exploitation, appele contrle de
-flux , a intercept le C-s et ne lui permet pas de parvenir
-Emacs. Pour dcoincer l'cran, faites C-q puis consultez la section
- Spontaneous Entry to Incremental Search dans le manuel d'Emacs
-pour avoir des avis sur la gestion de cette fonctionnalit .
-
Si vous vous trouvez au milieu d'une recherche incrmentale et que
-vous tapez <Delback>, vous remarquerez que cela supprime le dernier
+vous tapez <DEL>, vous remarquerez que cela supprime le dernier
caractre de la chane recherche et que la recherche reprend
l'endroit o elle se trouvait prcdemment. Supposons, par exemple,
que vous ayiez tap c pour trouver la premire occurrence de
c . Si vous tapez maintenant u , le curseur ira sur la premire
-occurrence de cu . Faites <Delback> : cela supprime le u de la
+occurrence de cu . Faites <DEL> : cela supprime le u de la
chane de recherche et le curseur revient la premire occurrence de
c .
@@ -931,21 +930,24 @@ haut dans le texte, faites plutt C-r. Tout ce que nous avons dit sur
C-s s'applique galement C-r, sauf que la direction de la recherche
est inverse.
+
* FENTRES MULTIPLES
--------------------
L'une des caractristiques les plus agrables d'Emacs est que vous
-pouvez afficher plusieurs fentres en mme temps l'cran.
+pouvez afficher plusieurs fentres en mme temps l'cran. (Notez
+qu'Emacs utilise le terme cadres -- dcrits dans la section
+d'aprs -- l o d'autres applications disent fentres . Le
+manuel d'Emacs contient un Glossaire des termes d'Emacs.)
->> Placez le curseur sur cette ligne et faites C-u 0 C-l (CTRL-L, pas
- CTRL-1).
+>> Placez le curseur sur cette ligne et faites C-l C-l.
>> Faites maintenant C-x 2 pour diviser l'cran en deux
fentres. Toutes les deux affichent ce didacticiel et le curseur
reste dans celle du haut.
->> Faites C-M-v pour faire dfiler la fentre du bas
- (Si vous n'avez pas de touche Meta, faites <ESC>C-V).
+>> Faites C-M-v pour faire dfiler le texte de la fentre du bas
+ (Si vous n'avez pas de touche Meta, faites <ESC> C-v).
>> Tapez C-x o ( o pour other ) afin de placer le curseur dans
la fentre du bas.
@@ -956,10 +958,11 @@ pouvez afficher plusieurs fentres en mme temps l'cran.
haut. Le curseur est exactement o il tait avant.
Vous pouvez continuer utiliser C-x o pour passer d'une fentre
-l'autre. Chaque fentre a sa propre position du curseur, mais une
-seule le montre vraiment. Toutes les commandes d'dition habituelles
-s'appliquent la fentre dans laquelle se trouve le curseur : on
-l'appelle la fentre slectionne .
+l'autre. La fentre slectionne , o la plupart de l'dition a
+lieu, est celle avec un curseur plus visible, qui clignotte quand
+vous ne tapez pas. Les autres fentres ont leurs propres positions
+de curseur ; si vous utilisez Emacs dans un affichage graphique, ces
+curseurs sont dessins comme des botes fantmes fixes.
La commande C-M-v est trs utile lorsque l'on dite du texte dans une
fentre et que l'on utilise l'autre uniquement comme rfrence. Vous
@@ -1000,6 +1003,33 @@ choses diffrentes :
supprimer celle du bas.
+* CADRES MULTIPLES
+------------------
+
+Emacs peut aussi crer plusieurs cadres . Un cadre est ce que nous
+appelons une collection de fentres, avec ses menus, ses barres de
+dfilement, son mini-tampon, etc. Dans les affichages graphiques, ce
+qu'Emacs appelle un cadre est ce que la plupart des applications
+appellent une fentre . Des cadres graphiques multiples peuvent
+apparatre sur l'cran en mme temps. Dans un terminal texte, seul
+un cadre la fois peut tre affich.
+
+>> Tapez M-x make-frame <Entre>
+ Voyez un nouveau cadre apparatre dans votre cran.
+
+Tout ce que vous faisiez dans votre cadre initial, vous pouvez le
+faire dans le nouveau cadre. Il n'y a rien de spcial au premier
+cadre.
+
+>> Tapez M-x delete-frame <Entre>
+ Ceci dtruit le cadre slectionn.
+
+Vous pouvez aussi dtruire un cadre en utilisant les mthodes normales
+fournies par le systme graphique (souvent en cliquant sur un bouton
+avec un X dans l'angle haut du cadre.) Si vous supprimez le
+dernier cadre de la tche Emacs de cette manire, vous sortez d'Emacs.
+
+
* NIVEAUX D'DITION RCURSIVE
-----------------------------
@@ -1008,18 +1038,18 @@ d'dition rcursive . Cela est indiqu par des crochets dans la ligne
de mode, entourant les parenthses situes autour du nom du mode
majeur. Vous verrez, par exemple [(Fundamental)] au lieu de (Fundamental).
-Pour sortir du niveau d'dition rcursive, faites ESC ESC ESC. C'est
-une commande de sortie tout faire. Vous pouvez galement l'utiliser
-pour supprimer les fentres supplmentaires et pour sortir du
-mini-tampon.
+Pour sortir du niveau d'dition rcursive, faites <ESC> <ESC> <ESC>.
+C'est une commande de sortie tout faire. Vous pouvez galement l'utiliser
+pour supprimer les fentres supplmentaires et pour sortir du mini-tampon.
->> Faites M-x pour aller dans le mini-tampon, puis faites ESC ESC ESC
+>> Faites M-x pour aller dans le mini-tampon, puis faites <ESC> <ESC> <ESC>
pour en sortir.
Vous ne pouvez pas utiliser C-g pour sortir d'un niveau d'dition
rcursive car cette commande sert annuler des commandes et des
paramtres DANS le niveau d'dition rcursive.
+
* OBTENIR DE L'AIDE SUPPLMENTAIRE
----------------------------------
@@ -1037,18 +1067,16 @@ et Emacs vous indiquera les types d'aide qu'il peut fournir. Si vous
avez tap C-h et que vous vous ravisez, il vous suffit de faire C-g
pour annuler.
-Certains sites changent la signification du caractre C-h. Ils ne
-devraient pas le faire la lgre pour tous les utilisateurs et vous
-tes donc en droit de vous plaindre auprs de l'administrateur
-systme. Cependant, si C-h n'affiche pas de message d'aide en bas de
-l'cran, essayez la place la touche F1 ou M-x help <Entre>.
+(si C-h n'affiche pas de message d'aide en bas de l'cran, essayez
+la place la touche F1 ou M-x help <Entre>.)
La commande d'aide la plus simple est C-h c. Faites C-h, le caractre
c, puis un caractre ou une squence de commande : Emacs affichera une
description trs courte de cette commande.
>> Faites C-h c C-p.
- Le message devrait tre quelque chose comme :
+
+Le message devrait tre quelque chose comme :
C-p runs the command previous-line
@@ -1092,9 +1120,9 @@ Voici d'autres options utiles de C-h :
>> Faites C-h a file<Entre>.
Cela affiche dans une autre fentre une liste de toutes les commandes
-M-x ayant file dans leurs noms. Vous verrez des commandes
-caractres, comme C-x C-f, apparatre ct des noms de commandes qui
-leur correspondent, comme find-file.
+M-x ayant file dans leurs noms. Vous verrez liste des commandes
+caractres ct des noms de commandes qui leur correspondent (comme
+C-x C-f ct de find-file).
>> Faites C-M-v pour faire dfiler la fentre d'aide. Faites-le
plusieurs fois.
@@ -1118,7 +1146,7 @@ leur correspondent, comme find-file.
Vous pouvez en apprendre plus en lisant le manuel d'Emacs, qu'il soit
imprim ou en ligne avec le systme Info (utilisez le menu Help, ou
-faites F10 h r). Les deux fonctionnalits que vous apprcierez
+faites C-h r). Les deux fonctionnalits que vous apprcierez
particulirement sont la compltion, qui permet d'conomiser la
frappe, et dired, qui simplifie la manipulation des fichiers.
@@ -1138,12 +1166,11 @@ Info du manuel Emacs, la rubrique "Dired".
Le manuel dcrit galement les nombreuses autres fonctionnalits
d'Emacs.
+
* CONCLUSION
------------
-Rappelez-vous, pour quitter dfinitivement Emacs, faites C-x C-c. Pour
-lancer temporairement un shell et pouvoir ensuite revenir Emacs,
-faites C-z.
+Pour quitter dfinitivement Emacs, faites C-x C-c.
Ce didacticiel est destin tre comprhensible par tous les nouveaux
utilisateurs. Si vous avez trouv que quelque chose n'tait pas clair,
@@ -1159,10 +1186,10 @@ dbute par celui qui fut crit par Stuart Cracraft pour le premier
Emacs.
Cette version du didacticiel, comme GNU Emacs, est place sous
-copyright, et vous pouvez en distribuer des copies sous certaines
+droit d'auteur, et vous pouvez en distribuer des copies sous certaines
conditions :
-Copyright (C) 1985, 1996, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 2001-2012 Free Software Foundation, Inc.
Chacun peut crer ou distribuer des copies de ce document tel qu'il
l'a reu, sur n'importe quel support, pourvu que la note de
@@ -1182,7 +1209,7 @@ l'obstructionnisme du logiciel (sa propritarisation ) en
utilisant, crivant et partagent des logiciels libres !
Cette traduction franaise a t effectue par ric Jacoboni
-<jaco@teaser.fr>.
+<jaco@teaser.fr> et complte par Bastien Guerry <bzg@gnu.org>.
--- end of TUTORIAL.fr ---
@@ -1190,4 +1217,3 @@ Cette traduction franaise a t effectue par ric Jacoboni
;;; coding: latin-1
;;; sentence-end-double-space: nil
;;; End:
-
diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he
index 92d94a0da87..e0c85a379a9 100644
--- a/etc/tutorials/TUTORIAL.he
+++ b/etc/tutorials/TUTORIAL.he
@@ -1,4 +1,4 @@
-שיעור ראשון בשימוש ב־Emacs. זכויות שימוש ראה בסוף המסמך.
+שיעור ראשון בשימוש ב־‫Emacs‬. זכויות שימוש ראה בסוף המסמך.
פקודות רבות של Emacs משתמשות במקש CONTROL (לפעמים הוא מסומן ב־CTRL או CTL)
או במקש META (לפעמים מסומן EDIT או ALT). במקום לציין את כל השמות האפשריים
@@ -198,19 +198,9 @@ argument) משום מקישים אותו לפני הפקודה אליה הוא
כתוצאה, התצוגה היתה צריכה לזוז ב־8 שורות. אם ברצונכם לגלול בחזרה,
אפשר להשיג זאת ע"י מתן ארגומנט ל־M-v.
-אם הפעלתם את Emacs על־גבי מערכת חלונאית כגון X או MS-Windows, אתם
+אם הפעלתם את Emacs על־גבי תצוגה גרפית כגון X או MS-Windows, אתם
צריכים לראות פס צר וגבוה, ששמו פס גלילה (scroll bar) בצידו של החלון
-של Emacs. (שימו לב שבשני צידי החלון קיימים פסים נוספים. אלה נקראים
-"השוליים" -- "fringes" -- ומשמשים להצגת סימני המשך שורה וסימונים
-אחרים. פס הגלילה, לעומתם, מופיע רק בצד אחד והוא הכי קרוב לקצה החלון
-בצד ההוא.)
-
->> נסו עתה להקליק בכפתור האמצעי של העכבר בחלק העליון של האזור המודגש
- של פס הגלילה. פעולה זו אמורה לגלול את הטקסט בשיעור שתלוי במקום בו
- הקלקתם.
-
->> נסו לגרור את העכבר מעלה ומטה, תוך כדי לחיצה על הכפתור האמצעי.
- כתוצאה, Emacs יגלול את הטקסט מעלה ומטה בהתאם לתנועת העכבר.
+של Emacs. ניתן לגלול את הטקסט ע"י הקלקת עכבר בתוך פס הגלילה.
אם העכבר שלכם מצויד בגלגל, תוכלו להשתמש גם בו לגלילת הטקסט.
@@ -255,9 +245,9 @@ argument) משום מקישים אותו לפני הפקודה אליה הוא
מבטלת את שאר החלונות.
>> הניעו את הסמן לתוך שורה זו והקישו C-u 0 C-l.
->> עתה הקישו CONTROL-h k CONTROL-f.
+>> עתה הקישו C-h k C-f.
שימו לב כיצד החלון הנוכחי מצטמצם ומופיע חלון חדש שבו מוצג
- התיעוד של הפקודה CONTROL-f.
+ התיעוד של הפקודה C-f.
>> הקישו C-x 1 ושימו לב שהחלון עם ההסבר על C-f נעלם.
@@ -271,40 +261,37 @@ argument) משום מקישים אותו לפני הפקודה אליה הוא
--------------
אם ברצונכם להכניס טקסט, פשוט הקישו על המקשים המתאימים. תוים רגילים,
-כגון A, א, 7, * וכד' מתפרשים ע"י Emacs כטקסט ומיד מתווספים לטקסט
-הקיים. הקישו <Return> (מקש חזרת גרר) כדי להכניס את תו השורה החדשה
+כגון A, א, 7, * וכד' מיד מתווספים לטקסט הקיים. הקישו <Return> (מקש
+חזרת גרר שלעתים נהוג לקרוא לו "Enter") כדי להכניס את תו השורה החדשה
(Newline).
-למחיקת התו האחרון שהקשתם הקישו <DelBack>. המקש שאנו קוראים לו <DelBack>
-יכול להתקרא בשמות שונים -- "Delete", "DEL" או "Backspace". בדרך כלל
-זהו מקש גדול ובולט שנמצא לא הרחק ממקש <Return>, והוא משמש אתכם למחיקת
-התו אחרון גם בתוכניות אחרות, לא רק ב־Emacs.
-
-אם קיים במקלדת שלכם מקש גדול שעליו רשום <Backspace>, אז זהון המקש אשר
-ישמש כ־<DelBack>. גם אם יהיה מקש אחר המסומן ב־"Delete" במקום אחרת זה
-אינו ה־<DelBack> שלכם.
+למחיקת התו האחרון שהקשתם הקישו <DEL>. בדרך כלל זהו מקש שמסומן
+ב־"Backspace", והוא משמש אתכם למחיקת התו אחרון גם בתוכניות אחרות, לא
+רק ב־Emacs.
-באופן כללי יותר, <DelBack> מוחק את התו שקודם למיקום הסמן.
+יתכן שבמקלדת שלכם קיים מקש שעליו רשום <Delete>, אך זה אינו המקש שאנו
+קוראים לו <DEL>.
>> הקישו עתה מספר תוים, ואחר־כך מחקו אותם ע"י הקשות אחדות
- על <DelBack>. אל תחששו לשנות את הקובץ הזה -- העותק המקורי
+ על <DEL>. אל תחששו לשנות את הקובץ הזה -- העותק המקורי
של השיעור יישאר ללא שינוי. אתם עובדים על העותק האישי שלכם.
כאשר שורה של טקסט נעשית ארוכה משורה אחת של תצוגה, חלק מהטקסט ממשיך
-בשורת תצוגה נוספת, היא "שורת ההמשך". תו לוכסן ("/") בסוף השורה (או
-חץ עקלקל קטן באזור השוליים -- "fringe") מסמל שלשורה יש שורת המשך.
+בשורת תצוגה נוספת, היא "שורת ההמשך". על תצוגה גרפית יופיע חץ עקלקל קטן
+באזור השוליים -- "fringe" שמסמל כי לשורה יש שורת המשך, ואילו על תצוגה
+טקסטואלית יופיע תו לוכסן ("/") לאותה תכלית בסוף השורה.
>> הקישו טקסט עד שתגיעו לקצה השורה, ואז תמשיכו להקיש עוד טקסט.
כתוצאה, תראו שמופיעה שורת המשך.
->> עתה הקישו <DelBack> על־מנת למחוק טקסט עד שהשורה תיעשה קצרה מספיק
+>> עתה הקישו <DEL> על־מנת למחוק טקסט עד שהשורה תיעשה קצרה מספיק
ותתאים לשורה בודדת על־גבי התצוגה. שורת ההמשך תיעלם.
ניתן למחוק את תו ה־Newline כמו כל תו אחר. מחיקת ה־Newline בין שתי
שורות תמזג את השורות לשורה אחת. אם השורה המשולבת תהיה ארוכה מרוחב
התצוגה, היא תוצג עם שורת המשך.
->> הניעו את הסמן לתחילת השורה והקישו <DelBack>. כתוצאה, השורה תתמזג
+>> הניעו את הסמן לתחילת השורה והקישו <DEL>. כתוצאה, השורה תתמזג
אם קודמתה.
>> עתה הקישו <Return> כדי להחזיר את ה־Newline שמחקתם.
@@ -317,24 +304,24 @@ argument) משום מקישים אותו לפני הפקודה אליה הוא
ובכן, למדתם את האופן הבסיסי ביותר להדפיס משהו ב־Emacs ולתקן שגיאות.
אפשר למחוק גם מלים ואף שורות שלמות. להלן סיכום פקודות המחיקה:
- ‏<Delback> מחק תו שלפני הסמן
+ ‏<DEL> מחק תו שלפני הסמן
‏C-d מחק תו מתחת או אחרי הסמן
- ‏‪M-<Delback>‬ גזור מילה שלפני הסמן
+ ‏‪M-<DEL>‬ גזור מילה שלפני הסמן
‏M-d גזור מילה שאחרי הסמן
‏C-k גזור טקסט מהסמן ועד סוף השורה
‏M-k גזור טקסט עד סוף המשפט הנוכחי.
-שימו לב שהיחס בין <Delback> ו־C-d לעומת M-<Delback>‎ ו־M-d ממשיכים את
-ההקבלה שבין C-f ו־M-f (אמנם <Delback> איננו תו בקרה, בוא נזניח את
-הנקודה הזו לעת־עתה). C-k ו־M-k דומים ל־C-e ו־M-e, אם נקביל שורות
-למשפטים.
+שימו לב שהיחס בין <DEL> ו־C-d לעומת M-<DEL>‎ ו־M-d ממשיכים את ההקבלה
+שבין C-f ו־M-f (אמנם <DEL> איננו תו בקרה, אבל בוא נזניח את הנקודה הזו
+לעת־עתה). C-k ו־M-k דומים ל־C-e ו־M-e, אם נקביל שורות למשפטים.
בנוסף, קיימת שיטה אחידה שמאפשרת לגזור קטע כלשהו של טקסט. לשם כך, תגיעו
-לקצה האחד של חלק הטקסט והקישו C-@‎ או C-<SPC>‎ (אחד מבין שני אלו).
-(<SPC> הוא מקש הרווח.) עתה הניעו את הסמן לקצה השני של חלק הטקסט והקישו
-C-w. כתוצאה, כל הטקסט בין שני המקומות הללו ייגזר.
+לקצה האחד של חלק הטקסט והקישו C-<SPC>‎. (<SPC> הוא מקש הרווח.) עתה
+הניעו את הסמן לקצה השני של חלק הטקסט אשר ברצונכם לגזור. תוך כדי תנועת
+הסמן Emacs צובע את הטקסט בין הסמן לבין המקום בו הקשתם C-<SPC>‎. לבסוף,
+הקישו C-w. כתוצאה, כל הטקסט בין שני המקומות הללו ייגזר.
>> הניעו את הסמן אל האות ב בתחילת הפיסקה הקודמת.
>> הקישו C-<SPC>‎. ‏Emacs צריך להציג הודעה האומרת "Mark set" בתחתית
@@ -348,7 +335,7 @@ C-w. כתוצאה, כל הטקסט בין שני המקומות הללו ייג
הטקסט הגזור נקרא "הדבקה" ("yanking"). באופן כללי, פקודות אשר עלולות
להעלים כמויות גדולות של טקסט תמיד גוזרות את הטקסט (כך שניתן יהיה בקלות
לשחזרו) בעוד הפקודות שמורידות תו בודד או שורות ריקות ותוי רווח --
-מוחקות (כך שלא ניתן להדביק את הטקסט שנמחק). כך, <Delback> ו־C-d מוחקים
+מוחקות (כך שלא ניתן להדביק את הטקסט שנמחק). כך, <DEL> ו־C-d מוחקים
כאשר מפעילים אותם ללא ארגומנט, אבל גוזרים כאשר מפעילים אותם עם ארגומנט.
>> הניעו את הסמן לתחילת שורה שאינה ריקה. אחר־כך הקישו C-k כדי לגזור
@@ -406,23 +393,22 @@ C-w. כתוצאה, כל הטקסט בין שני המקומות הללו ייג
--------------
אם שיניתם את הטקסט ואז החלטתם שהשינוי היה טעות, תוכלו לבטל את השינוי
-בעזרת פקודת הביטול, C-x u.
+בעזרת פקודת הביטול, ‪C-/‬.
-בדרך כלל, C-x u מבטל את השינויים שבוצעו ע"י פקודה אחת. הפעלה חוזרת של
-C-x u ברצף מבטלת שינויים של פקודות קודמות, אחת אחרי השניה.
+בדרך כלל,‪C-/‬ מבטל את השינויים שבוצעו ע"י פקודה אחת. הפעלה חוזרת של
+‪C-/‬ ברצף מבטלת שינויים של פקודות קודמות, אחת אחרי השניה.
שני יוצאים מהכלל הזה: פקודות שאינן משנות טקסט (למשל פקודות הנעת הסמן
ופקודות גלילה) אינן נספרות ותוים שמכניסים את עצמם מקובצים בקבוצות של
-עד 20, כדי להקטין את מספר הפעמים שיש להקיש C-x u כדי לבטל הכנסת טקסט.
+עד 20, כדי להקטין את מספר הפעמים שיש להקיש ‪C-/‬ כדי לבטל הכנסת טקסט.
->> גזרו שורה זו עם C-k, אחר־כך הקישו C-x u והיא תופיע שוב.
+>> גזרו שורה זו עם C-k, אחר־כך הקישו ‪C-/‬ והיא תופיע שוב.
-‏C-_‎ הינה דרך חלופית להפעיל את פקודת הביטול. היא פועלת בדיוק כמו C-x u,
-אבל קלה יותר להקשה מספר פעמים בזו אחר זו. החסרון של C-_‎ הוא שבכמה
-מקלדות לא ברור מאליו כיצד להקיש זאת. זו הסיבה לקיומו של C-x u. במקלדות
-אחדות ניתן להקיש C-_‎ ע"י החזקת CONTROL והקשת לוכסן /.
+‏C-_‎ הינה דרך חלופית להפעיל את פקודת הביטול. היא פועלת בדיוק כמו ‪C-/‬.
+במקלדות אחדות הקשה על ‪C-/‬ שולחת ל־Emacs את התו C-_‎. חלופה נוספת היא
+C-x u, אם־כי היא פחות נוחה להקשה מספר פעמים בזו אחר זו.
-ארגומנט נומרי ל־C-_‎ או ל־C-x u משמש כמספר החזרות על הפקודה.
+ארגומנט נומרי ל־‪C-/‬ או ל־C-_‎ או ל־C-x u משמש כמספר החזרות על הפקודה.
ניתן לבטל מחיקה של טקסט בדיוק כמו שניתן לבטל גזירה. ההבדלים בין מחיקה
וגזירה משפיעים על יכולתכם להדביק את הטקסט הגזור עם C-y; הם אינם חשובים
@@ -442,15 +428,15 @@ C-x u ברצף מבטלת שינויים של פקודות קודמות, אחת
שלם במערכת שלא כרצונכם. אפילו אם אתם שומרים את הקובץ, Emacs משאיר את
התוכן המקורי בשם שונה למקרה שמאוחר יותר תחליטו שהשינויים נעשו בטעות.
-אם תביטו בחלק התחתון של התצוגה, תראו שם שורה בולטת שמתחילה ומסתיימת
-במקפים וליד הקצה השמאלי שלה כתוב "TUTORIAL.he". חלק זה של התצוגה בדרך
-כלל מציג את שם הקובץ אותו אתם פוקדים. כרגע אתם פוקדים קובץ בשם
-"TUTORIAL.he" שהוא עותק הטיוטה האישי שלכם של שיעור השימוש ב־Emacs.
-פתיחת קובץ כלשהו ב־Emacs תציג את שמו של הקובץ במקום זה.
+אם תביטו בחלק התחתון של התצוגה, תראו שם שורה בולטת שמתחילה במקפים וליד
+הקצה השמאלי שלה כתוב "TUTORIAL.he". חלק זה של התצוגה בדרך כלל מציג את
+שם הקובץ אותו אתם פוקדים. כרגע אתם פוקדים קובץ בשם "TUTORIAL.he" שהוא
+עותק הטיוטה האישי שלכם של שיעור השימוש ב־Emacs. פתיחת קובץ כלשהו
+ב־Emacs תציג את שמו של הקובץ במקום זה.
היבט אחד מיוחד של פתיחת קובץ הוא שיש לציין את שם הקובץ אשר ברצונכם
-לפתוח. אנו אומרים שהפקודה "קוראת ארגומנט מהמסוף" (במקרה זה הארגומנט
-הוא שם הקובץ). אחרי שתקישו את הפקודה
+לפתוח. אנו אומרים שהפקודה "קוראת ארגומנט" (במקרה זה הארגומנט הוא שם
+הקובץ). אחרי שתקישו את הפקודה
‏C-x C-f פתח קובץ
@@ -465,12 +451,11 @@ C-x u ברצף מבטלת שינויים של פקודות קודמות, אחת
>> הקישו C-x C-f ואחר־כך הקישו C-g. זה מבטל את המיני־חוצץ וגם מבטל
את הפקודה C-x C-f שהשתמשה במיני־חוצץ. התוצאה היא שאף קובץ לא נפתח.
-משסיימתם להקיש את שם הקובץ, הקישו <Return> לסיים את הקלט. או־אז תיגש
-C-x C-f לעבודה ותמצא ותפתח את הקובץ שבחרתם. המיני־חוצץ נעלם כאשר
-פקודת ה־C-x C-f תסיים את עבודתה.
-
-זמן קצר אחר־כך תוכן הקובץ יופיע על־גבי התצוגה ותוכלו לבצע בו שינויים.
-כשתחליטו לשמור את השינויים, הקישו את הפקודה הבאה:
+משסיימתם להקיש את שם הקובץ, הקישו <Return> לסיים את הקלט. או־אז
+המיני־חוצץ נעלם והפקודה C-x C-f תיגש לעבודה ותמצא ותפתח את הקובץ
+שבחרתם. כאשר פקודת ה־C-x C-f תסיים את עבודתה, תוכן הקובץ יופיע על־גבי
+התצוגה ותוכלו לבצע בו שינויים. כשתחליטו לשמור את השינויים, הקישו את
+הפקודה הבאה:
‏C-x C-s שמור את הקובץ
@@ -482,8 +467,9 @@ C-x C-f לעבודה ותמצא ותפתח את הקובץ שבחרתם. המי
לשמור לעתים מזומנות על־מנת להימנע מלאבד יותר מדי מהעבודה שלכם אם המחשב
ייפול (ראה להלן פיסקה על שמירה אוטומטית).
->> הקישו C-x C-s כדי לשמור את העותק שלכם של השיעור.
- כתוצאה, תופיע ההודעה "Wrote ... TUTORIAL.he" בתחתית התצוגה.
+>> הקישו C-x C-s TUTORIAL.he ותסיימו בהקשת <Return>. כתוצאה, שיעור זה
+ יישמר בקובץ בשם TUTORIAL.he ובתחתית התצוגה תופיע ההודעה
+ "Wrote ...TUTORIAL.he".
ניתן לפתוח קובץ קיים על־מנת לצפות בו או לערוך אותו. ניתן גם לפתוח קובץ
שאינו קיים. זו הדרך ליצור קבצים חדשים בעזרת Emacs: פתחו את הקובץ
@@ -498,10 +484,6 @@ Emacs ייצור את הקובץ עם הטקסט שהקשתם. מאותו רגע
אם תפתחו קובץ נוסף עם C-x C-f, הקובץ הראשון עדיין נשאר פתוח ב־Emacs.
תוכלו לחזור אליו ע"י C-x C-f. כך תוכלו לפתוח מספר רב של קבצים.
->> ניצור עתה קובץ בשם "foo" ע"י הקשת C-x C-f foo <Return>‎.
- אחר־כך הכניסו קצת טקסט, ערכו אותו ולבסוף שמרו בקובץ "foo"
- ע"י C-x C-s. עתה חזרו לשיעור בעזרת C-x C-f TUTORIAL.he <Return>‎.
-
‏Emacs מחזיק כל קובץ בתוך יישות בשם "חוצץ" ("buffer"). פתיחת קובץ יוצרת
חוצץ חדש בתוך Emacs. כדי לראות את רשימת החוצצים הקיימים בתוך Emacs,
הקישו
@@ -522,17 +504,19 @@ Emacs ייצור את הקובץ עם הטקסט שהקשתם. מאותו רגע
ע"י C-x C-f שיפקוד את הקובץ בשנית. אבל קיימת דרך פשוטה יותר: שימוש
בפקודה C-x b. פקודה זו תחייב אותכם להקיש את שם החוצץ.
->> הקישו C-x b foo <Return>‎ כדי לחזור לחוצץ "foo" אשר מחזיק טקסט של
- הקובץ "foo". אחר־כך הקישו C-x b TUTORIAL.he <Return>‎ כדי לשוב
- לשיעור זה.
+>> ניצור עתה קובץ בשם "foo" ע"י הקשת C-x C-f foo <Return>‎.
+ עתה חזרו לשיעור זה בעזרת C-x b TUTORIAL.he <Return>‎.
ברוב המקרים שם החוצץ זהה לשם הקובץ (ללא שם התיקיה שלו). אבל אין זה
-תמיד כך. רשימת החוצצים שנוצרת ע"י C-x C-b תמיד תציג את שמות כל החוצצים
-הקיימים ב־Emacs.
+תמיד כך. רשימת החוצצים שנוצרת ע"י C-x C-b תציג הן את שם החוצץ והן את
+שם הקובץ עבור כל החוצצים הקיימים ב־Emacs.
כל טקסט שמוצג בחלון של Emacs הינו תמיד חלק של חוצץ כלשהו. קיימים
-חוצצים שאינם קשורים לשום קובץ. לדוגמא, החוצץ בשם "*Buffer List*" אינו
-מציג שום קובץ. זהו חוצץ המחזיק את רשימת החוצצים שנוצר ע"י C-x C-b.
+חוצצים שאינם קשורים לשום קובץ. לדוגמא, החוצץ בשם "*Buffer List*"
+המחזיק את רשימת החוצצים שנוצרה ע"י C-x C-b אינו מציג שום קובץ. גם
+לחוצץ הנוכחי ששמו TUTORIAL.he לא היה קובץ עד שהקשתם על C-x C-s כדי
+לשמור אותו בקובץ.
+
חוצץ בשם "*Messages*" אף הוא אינו קשור לשום קובץ; הוא מחזיק את ההודעות
שהופיעו בשורה התחתונה במהלך עבודתכם בתוך Emacs.
@@ -573,11 +557,11 @@ C-x C-s. לכן קיימת פקודה
מ־Emacs -- ‏C-x C-c. (כשאתם מפעילים C-x C-c, אל תדאגו לשינויים שטרם
נשמרו; C-x C-c מציע לשמור כל קובץ ששיניתם לפני שהוא מסיים את Emacs.)
-אם אתם משתמשים בצג גרפי אשר תומך במספר תוכניות במקביל, אינכם זקוקים
-לפקודה מיוחדת כדי לעבור מ־Emacs לתוכנית אחרת. אפשר לעשות זאת בעזרת
-העכבר או פקודות של מנהל החלונות. אולם, כאשר אתם משתמשים בתצוגה
-טקסטואלית שמסוגלת להציג רק תוכנית אחת בו־זמנית, תצטרכו "להשעות"
-("suspend") את Emacs על־מנת לעבור לתוכנית אחרת.
+אם אתם משתמשים בצג גרפי, אינכם זקוקים לפקודה מיוחדת כדי לעבור מ־Emacs
+לתוכנית אחרת. אפשר לעשות זאת בעזרת העכבר או פקודות של מנהל החלונות.
+אולם, כאשר אתם משתמשים בתצוגה טקסטואלית שמסוגלת להציג רק תוכנית אחת
+בו־זמנית, תצטרכו "להשעות" ("suspend") את Emacs על־מנת לעבור לתוכנית
+אחרת.
הפקודה C-z יוצאת מ־Emacs *באופן זמני* -- כך שתוכלו לשוב אליו מאוחר
יותר ולהמשיך מאותה נקודה. כאשר Emacs רץ על תצוגת טקסט, C-z "משעה" את
@@ -587,8 +571,7 @@ Emacs: הוא מחזיר אתכם לשורת הפקודות הבסיסית של
הרגע הנכון להשתמש ב־C-x C-c הוא כאשר אתם עומדים להתנתק (log out).
כמו־כן, תצטרכו להשתמש בו כדי לצאת מ־Emacs שהופעל ע"י תוכניות אחרות
-כגון קריאת דואר אלקטרוני -- תוכניות אלו לא תמיד יודעות להסתדר עם
-השעיית Emacs.
+כגון קריאת דואר אלקטרוני.
קיימות פקודות C-x רבות מאד. להלן רשימת אלו שכבר למדתם:
@@ -607,7 +590,7 @@ replace-string (החלף מחרוזת) אשר מחליפה מחרוזת אחת
אחרי שתקישו M-x, ‏Emacs מציג M-x בתחתית התצוגה ומחכה שתקישו את שם
הפקודה, במקרה זה "replace-string". מספיק שתקישו "repl s<TAB>‎" ו־Emacs
ישלים את השם המלא. (<TAB> הוא מקש Tab, בדרך כלל תמצאו אותו מעל מקש
-ה־CapsLock או Shift, ליד הקצה השמאלי של המקלדת.) סיימו את שם הפקודה
+ה־CapsLock או Shift, ליד הקצה השמאלי של המקלדת.) סיימו את הזנת הפקודה
ע"י הקשת <Return>.
הפקודה להחלפת מחרוזת זקוקה לשני ארגומנטים -- המחרוזת שתוחלף וזו שתחליף
@@ -651,15 +634,15 @@ replace-string (החלף מחרוזת) אשר מחליפה מחרוזת אחת
השורה שמעל אזור תצוגת הד נקראת "שורת הסטטוס" (mode line). שורה זו
מציגה משהו כמו:
- -U:**- TUTORIAL.he 63% L651 (Fundamental)-----------------------
+ U:**- TUTORIAL.he 63% L651 (Fundamental)
שורה זו מציגה מידע חשוב לגבי מצבו של Emacs ולגבי הטקסט שנמצא בעריכה.
אתם כבר יודעים מהי משמעותו של שם הקובץ -- זהו הקובץ שפתחתם. NN%‎ מציין
-את מיקומכם הנוכחי בתוך הטקסט, לאמור כי NN אחוזים מהטקסט קודמים לטקסט
-המוצג כרגע בחלון. אם המוצג בחלון כולל את תחילת הטקסט, תראו שם "Top"
-במקום "0% ". אם המוצג בחלון כולל את סוף הטקסט, תראו שם "Bot" ‏(bottom).
-אם הטקסט כל־כך קצר שכולו מוצג בחלון, שורת הסטטוס תציג "All".
+את מיקומכם הנוכחי בתוך הטקסט, לאמור כי NN אחוזים מתכולת החוצץ קודמים
+לטקסט המוצג כרגע בחלון. אם המוצג בחלון כולל את תחילת הטקסט, תראו שם
+"Top" במקום "0% ". אם המוצג בחלון כולל את סוף הטקסט, תראו שם "Bot"
+‏(bottom). אם הטקסט כל־כך קצר שכולו מוצג בחלון, שורת הסטטוס תציג "All".
האות L והמספר שאחריה מציינים את המיקום הנוכחי בדרך אחרת: הם מראים את
מספר השורה שבה נמצא הסמן.
@@ -698,7 +681,7 @@ replace-string (החלף מחרוזת) אשר מחליפה מחרוזת אחת
לצפיה בתיעוד של האופן הראשי הנוכחי יש להקיש C-h m.
->> השתמשו ב־C-u C-v פעם אחת או יותר כדי להביא שורה זו לראשית התצוגה.
+>> הקישו C-l C-l כדי להביא שורה זו לראשית התצוגה.
>> עתה הקישו C-h m כדי לראות במה Text mode שונה מה־Fundamental mode.
>> לבסוף, הקישו C-x 1 כדי לסלק את התיעוד מהתצוגה.
@@ -740,9 +723,9 @@ Auto Fill mode. כאשר אופן זה מופעל, Emacs אוטומטית פות
* חיפוש
-------
-‏Emacs יכול לחפש מחרוזות (רצף של תווים או מילים) קדימה או אחורה בתוך
-הטקסט. חיפוש של מחרוזת הוא סוג של פקודה להנעת הסמן: הוא ממקם את הסמן
-היכן שנמצאה המחרוזת הבאה.
+‏Emacs יכול לחפש מחרוזות (רצף של תווים) קדימה או אחורה בתוך הטקסט.
+חיפוש של מחרוזת הוא סוג של פקודה להנעת הסמן: הוא ממקם את הסמן היכן
+שנמצאה המחרוזת הבאה.
החיפוש של Emacs הינו "מצטבר" ("incremental"). פירוש הדבר הוא שהחיפוש
מתבצע במקביל להקשתכם את המחרוזת אותה ברצונכם למצוא.
@@ -759,7 +742,7 @@ Auto Fill mode. כאשר אופן זה מופעל, Emacs אוטומטית פות
"סמן", עם הפסקה אחרי כל אות, ושימו לב להתנהגות הסמן.
זה עתה מצאתם את המילה "סמן" פעם אחת.
>> הקישו C-s שוב, כדי למצוא את "סמן" במקומות נוספים בטקסט.
->> הקישו <Delback> שלוש פעמים ושימו לב לתנועת הסמן בכל הקשה.
+>> הקישו <DEL> שלוש פעמים ושימו לב לתנועת הסמן בכל הקשה.
>> הקישו <Return> לסיום החיפוש.
האם שמתם לב למה שקרה? במהלך "חיפוש מצטבר" Emacs מנסה למצוא את המקום
@@ -768,16 +751,13 @@ Auto Fill mode. כאשר אופן זה מופעל, Emacs אוטומטית פות
ומודיע שהחיפוש נכנס למצב של "כשלון" ("failing"). הקשה על C-g גם היא
מסיימת את החיפוש.
-(הערה: במערכות אחדות הקשה על C-s מקפיעה את תצוגת המסך, כך שלא תראו
-יותר שום פלט של Emacs. משמעות הדבר שתכונת מערכת ההפעלה ששמה "flow
-control" מופעלת ע"י C-s ואינה מעבירה את C-s ל־Emacs. לביטול הקפאת
-התצוגה במערכות אלו יש להקיש C-q.)
-
-אם במהלך החיפוש תקישו על <Delback>, תראו שהתו האחרון של המחרוזת
-המבוקשת נמחק והחיפוש חוזר למקום הקודם בו נמצאה המחרוזת ללא התו האחרון.
-למשל, נניח שהקשתם "ס" על־מנת למצוא את המקום הבא בו מופיעה האות "ס". אם
-עכשיו תקישו "מ", הסמן יזוז למקום בו נמצא "סמ". עתה הקישו <Delback>.
-ה־"מ" נמחק מהמחרוזת והסמן חוזר למקום בו הוא מצא את "ס" לראשונה.
+אם במהלך החיפוש תקישו על <DEL>, החיפוש "נסוג" למצב קודם. אם הקשתם
+<DEL> מיד אחרי C-s, הקשת <DEL> מחזירה את הסמן למקום הקודם בו נמצאה
+המחרוזת. אם אין מקומות קודמים בהם מופיעה המחרוזת, הקשת <DEL> מוחקת את
+התו האחרון של המחרוזת המבוקשת. למשל, נניח שהקשתם "ס" על־מנת למצוא את
+המקום הבא בו מופיעה האות "ס". אם עכשיו תקישו "מ", הסמן יזוז למקום בו
+נמצא "סמ". עתה הקישו <DEL>. ה־"מ" נמחק מהמחרוזת והסמן חוזר למקום בו
+הוא מצא את "ס" לראשונה.
אם במהלך החיפוש תפעילו פקודה כלשהי ע"י הקשה על מקש תוך לחיצה על
CONTROL או META, החיפוש יסתיים. (כמה תווים יוצאים מכלל זה -- אלו תווים
@@ -796,10 +776,10 @@ CONTROL או META, החיפוש יסתיים. (כמה תווים יוצאים מ
שתוכניות אחרות מכנות "חלון". תבניות מתוארות בפסקה הבאה. תוכלו למצוא את
רשימת המונחים של Emacs בפרק "Glossary" של מדריך משתמש.)
->> הביאו סמן לשורה זו והקישו C-u 0 C-l ‏(CONTROL-L ולא CONTROL-1).
+>> הביאו סמן לשורה זו והקישו C-l C-l ‏(CONTROL-L ולא CONTROL-1).
>> עתה הקישו C-x 2 וכתוצאה מכך החלון יתחלק לשניים. כל אחד משני החלונות
- מציג את השיעור הזה. הסמן נשאר בחלון העליוןץ
+ מציג את השיעור הזה. הסמן נשאר בחלון העליון.
>> הקישו C-M-v כדי לגלול את החלון התחתון.
(אם במקלדת שלכם אין מקש META אמיתי, הקישו ‎<ESC> C-v כתחליף.)
@@ -812,19 +792,19 @@ CONTROL או META, החיפוש יסתיים. (כמה תווים יוצאים מ
>> הקישו C-x o שוב לחזור לחלון העליון.
הסמן בחלון העליון יישאר במקום בו הוא היה לפני־כן.
-תוכלו להמשיך להשתמש ב־C-x o כדי לדלג בין שני החלונות. לכל חלון מיקום
-סמן משלו, אבל רק חלון אחד מציג את הסמן בכל רגע. כל פקודות העריכה
-הרגילות פועלות על החלון שבו מוצג הסמן. אנו קוראים לחלון זה "החלון
-הנבחר".
+תוכלו להמשיך להשתמש ב־C-x o כדי לדלג בין החלונות. "החלון הנבחר", אותו
+חלון בו הנכם עורכים טקסט, מזוהה ע"י סמן בולט שמהבהב בזמן שאינכם
+מקלידים. לכל החלונות האחרים מיקום סמן משלהם; אם הפעלתם את Emacs על צג
+גרפי, מיקום הסמן בחלונות האחרים מוצג כתיבה ריקה שאינה מהבהבת.
הפקודה C-M-v נוחה מאד כאשר הינכם עורכים טקסט בחלון אחד ומשתמשים בחלון
-אחר לייחוס. תוכלו בכל עת לשמור על הסמן בחלון בו אתם עורכים טקסט
-ולהתקדם בחלון השני בעזרת C-M-v.
+אחר לייחוס. תוכלו להתקדם בחלון השני בעזרת C-M-v מבלי לעזוב את החלון
+הנבחר.
‏C-M-v היא דוגמא אחת של פקודת CONTROL-META. אם במקלדת שלכם קיים מקש
-META אמיתי, תוכלו להקיש את הפקודה ע"י לחיצה והחזקה של מקשי CONTROL
-ו־META גם יחד ואז להקיש v. הסדר שבו תלחצו על CONTROL ו־META אינו משנה
-כי שני המקשים הללו פועלים ע"י שינוי התו המוקש יחד איתם.
+META (או Alt) אמיתי, תוכלו להקיש את הפקודה ע"י לחיצה והחזקה של מקשי
+CONTROL ו־META גם יחד ואז להקיש v. הסדר שבו תלחצו על CONTROL ו־META
+אינו משנה כי שני המקשים הללו פועלים ע"י שינוי התו המוקש יחד איתם.
אם אין במקלדת מקש META אמיתי ואתם משתמשים ב־<ESC> כתחליף, הסדר כן
משנה: חייבים להקיש <ESC> ורק לאחר מכן CONTROL-v, וזאת משום
@@ -853,9 +833,10 @@ META אמיתי, תוכלו להקיש את הפקודה ע"י לחיצה והח
* תבניות מרובות
---------------
-‏Emacs מסוגל לפתוח מספר "תבניות" ("frames") בתנאי שאינכם משתמשים בצג
-שמסוגל להציג רק טקסט. תבנית כוללת קבוצת חלונות, תפריט, פסי גלילה, אזור
-תצוגת הד וכו'. (תוכניות אחרות נוהגות לקרוא לזה "חלון".)
+‏Emacs מסוגל לפתוח מספר "תבניות" ("frames"). תבנית כוללת קבוצת חלונות,
+תפריט, פסי גלילה, אזור תצוגת הד וכו'. על צג גרפי מה שאנו קוראים
+"תבנית" נקרא בדרך־כלל "חלון". ניתן להציג תבניות אחדות על אותו צג גרפי
+בו־זמנית על צג טקסטואלי אפשר להציג רק תבנית אחת בכל עת.
>> הקישו M-x make-frame <Return>‎.
כתוצאה, תבנית חדשה תופיע על המסך.
@@ -866,10 +847,10 @@ META אמיתי, תוכלו להקיש את הפקודה ע"י לחיצה והח
>> הקישו M-x delete-frame <Return>‎.
התבנית שבה הקשתם את הפקודה תיסגר ותיעלם מהמסך.
-כמו־כן, ניתן לסגור תבנית בדרך הרגילה הנתמכת ע"י מנהל החלונות של המערכת
-שלכם (בדרך־כלל, ע"י הקלקה על הכפתור המסומן ב־"X" בפינה עליונה של
-התבנית.) שום מידע אינו הולך לעיבוד כאשר סוגרים תבנית (או חלון). המידע
-הזה פשוט יורד מהתצוגה, אבל ניתן לאחזרו מאוחר יותר.
+כמו־כן, ניתן לסגור תבנית בדרך הרגילה הנתמכת ע"י התצוגה הגרפית של
+המערכת שלכם (בדרך־כלל, ע"י הקלקה על הכפתור המסומן ב־"X" בפינה עליונה
+של התבנית.) שום מידע אינו הולך לעיבוד כאשר סוגרים תבנית (או חלון).
+המידע הזה פשוט יורד מהתצוגה, אבל ניתן לאחזרו מאוחר יותר.
* רמות עריכה רקורסיביות
@@ -983,7 +964,7 @@ find-file.
ושמות קבצים. תכונת ההשלמה מתוארת במלואה במדריך למשתמש Emacs בצומת
(node) בשם "Completion".
-‏Dired מאפשר להציג רשימת קבצים בתיקיה (וכאפציה גם בתת-תיקיות שלה), לנוע
+‏Dired מאפשר להציג רשימת קבצים בתיקיה (וכאפציה גם בתת־תיקיות שלה), לנוע
בתוך הרשימה הזו, לפתוח קבצים, לשנות את שמותיהם, למחוק אותם ולבצע עליהם
עוד פעולות רבות. Dired מתואר במלואו במדריך למשתמש בצומת בשם "Dired".
@@ -1008,7 +989,7 @@ find-file.
גירסה זו של השיעור הינה חלק מחבילת GNU Emacs. היא מוגנת בזכויות יוצרים
וניתנת להעתקה והפצת עותקים בתנאים מסויימים כדלקמן:
- Copyright (C) 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2010-2012 Free Software Foundation, Inc.
‏GNU Emacs הינו תכנה חפשית; זכותכם להפיצו ו\או לשנותו בכפוף לתנאי
הרשיון GNU General Public License, כפי שהוא יוצא לאור ע"י Free
diff --git a/etc/tutorials/TUTORIAL.it b/etc/tutorials/TUTORIAL.it
index 1c9f8bc6654..1f222caceef 100644
--- a/etc/tutorials/TUTORIAL.it
+++ b/etc/tutorials/TUTORIAL.it
@@ -1085,7 +1085,7 @@ distribuito con il permesso di farne copie a determinate condizioni:
indicativo, restando comunque inteso il fatto che quella originale a
fare fede.
-Copyright (C) 2003-2011 Free Software Foundation, Inc.
+Copyright (C) 2003-2012 Free Software Foundation, Inc.
permesso a chiunque copiare e distribuire attraverso ogni mezzo copie
fedeli di questo documento cos come viene ricevuto, a condizione che
diff --git a/etc/tutorials/TUTORIAL.ja b/etc/tutorials/TUTORIAL.ja
index d50727ceb82..13a6d01be0e 100644
--- a/etc/tutorials/TUTORIAL.ja
+++ b/etc/tutorials/TUTORIAL.ja
@@ -1062,7 +1062,7 @@ starting with the one written by Stuart Cracraft for the original Emacs.
This version of the tutorial, like GNU Emacs, is copyrighted, and
comes with permission to distribute copies on certain conditions:
-Copyright (C) 1985, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim copies
of this document as received, in any medium, provided that the
diff --git a/etc/tutorials/TUTORIAL.ko b/etc/tutorials/TUTORIAL.ko
index a928923832d..cc87cbad21a 100644
--- a/etc/tutorials/TUTORIAL.ko
+++ b/etc/tutorials/TUTORIAL.ko
@@ -981,7 +981,7 @@ C-x C-s$(C?M(B (META$(C<h3*(B EDIT$(C<h(B $(CH$@:(B $(C13C<<h0!(B $(C
GNU $(C@L8F=:?M(B $(C00@L(B $(C@L(B $(CAvD'<-(B $(CFG@:(B $(C@z@[1G@L(B $(C@V@88g(B $(CF/A$GQ(B $(CA60G@;(B $(C88A7GR(B
$(C6'?!(B $(C:9;g:;@;(B $(C9hFwGR(B $(C<v(B $(C@V4B(B $(CGc0!8&(B $(C0.0m(B $(C3*?B(B $(C0M@L4Y(B:
-Copyright (C) 1985, 1996, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 2001-2012 Free Software Foundation, Inc.
$(C@L(B $(C9.<-4B(B $(C@L(B $(C@z@[1G(B $(C0x0m?M(B $(CGc?k(B $(C0x0m0!(B $(C1W4k7N(B $(C@/Av5G0m(B, $(C9hFw@Z0!(B
$(C<vCk@Z?!0T(B $(C@L(B $(C0x0m?!(B $(C5{6s(B $(CGc?k5G4B(B $(C0MC373(B $(C6G(B $(C@g:P9hGO4B(B $(C0M@;(B
diff --git a/etc/tutorials/TUTORIAL.nl b/etc/tutorials/TUTORIAL.nl
index 59f54c1b2db..e30c73a2441 100644
--- a/etc/tutorials/TUTORIAL.nl
+++ b/etc/tutorials/TUTORIAL.nl
@@ -1,4 +1,4 @@
-Emacs-inleiding. De kopieervoorwaarden staan onderaan.
+De Emacs-inleiding. De kopieervoorwaarden staan onderaan.
De meeste Emacs-commando's gebruiken de CONTROL-toets (soms CTRL of CTL
genaamd) en/of de META-toets (soms genaamd EDIT of ALT). In plaats van
@@ -12,6 +12,7 @@ steeds de volledige naam te noemen, gebruiken we de volgende afkortingen:
verwijzen naar de ESC-toets als <ESC>.
BELANGRIJK: om Emacs te verlaten, tik C-x C-c (twee tekens).
+Om een commando halverwege af te breken, tik C-g.
De tekens ">>" tegen de linkerkantlijn nodigen je uit om een bepaald
commando te proberen. Bijvoorbeeld:
<<Blank lines inserted around following line by help-with-tutorial>>
@@ -48,7 +49,9 @@ De volgende commando's zijn handig om volledige schermen te bekijken:
>> Kijk waar de cursor staat, en onthoud de tekst er omheen. Tik C-l.
Zoek de cursor en merk op dat hij nog steeds bij dezelfde tekst
- staat.
+ staat, maar nu in het midden van het scherm.
+ Als je weer C-l tikt dan gaat hij naar de bovenkant van het scherm.
+ Nog een keer C-l en hij gaat naar de onderkant.
Als je toetsenbord PageUp- en PageDn-toetsen heeft dan kun je deze ook
gebruiken om een scherm terug dan wel vooruit te gaan, maar het werken
@@ -64,10 +67,8 @@ naar een specifieke plaats op het scherm?
Er is een aantal manieren waarop je dit kan doen. Je kan de
pijltjestoetsen gebruiken, maar het is efficinter om je handen in de
standaardhouding te laten, en de commando's C-p, C-b, C-f en C-n te
-gebruiken. Elk van deze commando's verplaatst de cursor precies een
-regel of teken in een bepaalde richting op het scherm. Hier volgt een
-figuur met de vier commando's en de richting waarin ze de cursor
-bewegen:
+gebruiken. Deze commando's komen overeen met de pijltjestoetsen, als
+in onderstaande figuur:
vorige regel, C-p
:
@@ -79,42 +80,41 @@ bewegen:
>> Verplaats, met C-n of C-p, de cursor naar de middelste regel van de
figuur. Tik dan C-l om de hele figuur in het midden van het
- centrum te plaatsen.
+ scherm te plaatsen.
Met een beetje kennis van het Engels zijn deze commando's gemakkelijk
te onthouden: de p komt van "previous" (vorige), de n van "next"
(volgende), de b van "backward" (achteruit) en de f van "forward"
-(vooruit). Dit zijn de basiscommando's om de cursor te bewegen, dus
-je zult ze VOORTDUREND gebruiken: het is vooruitziend als je ze nu
-leert te gebruiken.
+(vooruit). Dit zijn de basiscommando's om de cursor te bewegen, die
+je VOORTDUREND zal gebruiken.
->> Tik een paar keer C-n om de cursor op deze regel te krijgen.
+>> Tik een paar keer C-n om de cursor op deze regel te zetten.
->> Beweeg je binnen de regel met C-f (herhaaldelijk) en terug omhoog
- met C-p. Let op wat C-p doet als de cursor midden in een regel
- staat.
+>> Beweeg de cursor binnen de regel met een paar keer C-f en terug
+ omhoog met C-p. Let op wat C-p doet als de cursor midden in een
+ regel staat.
Elke regel eindigt met een Newline-teken (het Engelse "new line"
betekent "nieuwe regel"); dit teken scheidt elke regel van de
-volgende. De laatste regel in een bestand zou eigenlijk ook met een
-Newline moeten eindigen (maar dat is niet noodzakelijk voor Emacs).
+volgende. (De laatste regel in een bestand heeft meestal ook een
+Newline aan het eind maar dat is geen vereiste voor Emacs.)
>> Probeer C-b aan het begin van een regel. De cursor zal zich naar
het eind van de vorige regel bewegen, omdat je achteruit over het
- Newline teken gaat.
+ Newline-teken gaat.
Net als C-b kan ook C-f zich over Newline-tekens heen bewegen.
>> Tik nog een aantal keren het commando C-b, zodat je een gevoel
krijgt waar de cursor is. Tik dan enkele keren C-f om de cursor
- terug naar het einde van de regel te bewegen. Een verder C-f
- commando beweegt de cursor dan naar de volgende regel.
+ naar het eind van de regel te bewegen. Nog een C-f commando
+ beweegt de cursor dan naar de volgende regel.
-Wanneer je de cursor voorbij het begin of het einde van het scherm
-beweegt, zal de tekst over het scherm heen schuiven. Dit heet
-"scrollen", of "schuiven" in goed Nederlands. Door te scrollen zorgt
-Emacs ervoor dat de cursor de gewenste beweging kan maken zonder dat
-de cursor van het scherm af beweegt.
+Wanneer je de cursor voorbij het begin of het eind van het scherm
+beweegt, zal de tekst over het scherm bewegen. Dit heet "scrollen".
+Door te scrollen zorgt Emacs ervoor dat de cursor naar de gewenste
+plaats in de tekst kan gaan zonder de cursor van het scherm te laten
+verdwijnen.
>> Probeer de cursor voorbij de onderkant van het scherm te bewegen
met C-n en zie wat er gebeurt.
@@ -126,38 +126,39 @@ M-b een woord achteruit.
>> Tik enkele keren M-f en M-b.
Als je midden in een woord staat, beweegt M-f de cursor naar het eind
-van het woord. Als je op een witte ruimte tussen twee woorden staat,
-beweegt M-f de cursor naar het eind van het volgende woord. Het
-commando M-b beweegt de cursor analoog de andere kant op.
+van het woord. Als je op witruimte tussen twee woorden staat, beweegt
+M-f de cursor naar het eind van het volgende woord. Het commando M-b
+werkt op dezelfde manier de andere kant op.
->> Tik enkele keren M-f en M-b en daar tussendoor een paar maal C-f en
- C-b, zodat je ziet wat M-f en M-b doen vanaf bepaalde plaatsen in
+>> Tik enkele keren M-f en M-b en tussendoor een paar maal C-f en C-b,
+ zodat je ziet wat M-f en M-b doen vanaf verschillende plaatsen in
een woord en tussen twee woorden.
Merk op dat er een analogie bestaat tussen enerzijds C-f en C-b en
anderzijds M-f en M-b. Het is bij veel commando's zo dat META-tekens
gebruikt worden om iets te doen in eenheden van de taal (woorden,
-zinnen, alinea's) terwijl CONTROL-tekens te maken hebben met dingen
-die los staan van wat je aan het bewerken bent (tekens, regels, enz.).
+zinnen, alinea's) terwijl CONTROL-tekens te maken hebben met de
+bouwstenen die onafhankelijk zijn van wat je aan het bewerken bent
+(tekens, regels, enz.).
Deze analogie gaat ook op voor regels en zinnen: C-a en C-e bewegen de
cursor naar het begin of eind van een regel, terwijl met M-a,
respectievelijk M-e, de cursor naar het begin, respectievelijk het
eind, van een zin gaat.
->> Tik enkele keren C-a, en dan een enkele keren C-e.
- Tik een paar maal M-a, en dan enkele keren M-e.
+>> Probeer een paar maal C-a, en dan enkele keren C-e.
+ Probeer een paar maal M-a, en dan enkele keren M-e.
Bemerk hoe herhaalde C-a commando's niets doen, terwijl herhaalde M-a
commando's de cursor steeds een zin achteruit bewegen. Alhoewel ze
-niet volledig overeenkomen, is het gedrag van beide heel natuurlijk.
+niet volledig overeenkomen, lijkt het gedrag van beide heel natuurlijk.
De plaats van de cursor in de tekst wordt "punt" genoemd (zonder
lidwoord, "point" in het Engels). Anders gezegd: de cursor laat op
het scherm de plek zien waar punt in de tekst staat.
-Nu volgt een samenvatting van eenvoudige cursorbewegingen, met
-inbegrip van de commando's die de cursor per woord of zin bewegen:
+Nu volgt een samenvatting van eenvoudige cursorbewegingen, inclusief
+de commando's die de cursor per woord of zin bewegen:
C-f Ga een teken vooruit
C-b Ga een teken achteruit
@@ -174,18 +175,17 @@ inbegrip van de commando's die de cursor per woord of zin bewegen:
M-a Ga terug naar het begin van de zin
M-e Ga vooruit naar het eind van de zin
->> Probeer al deze commando's een paar keer als oefening. Deze
- commando's worden het vaakst gebruikt.
+>> Probeer al deze commando's een paar keer als oefening.
+ Dit zijn de meestgebruikte commando's.
Er zijn nog twee belangrijke cursorbewegingen: M-< (META kleiner-dan)
-beweegt de cursor naar het begin van het bestand, en M-> (META
+beweegt de cursor naar het begin van de tekst, en M-> (META
groter-dan) beweegt hem naar het eind.
Op de meeste toetsenborden zit de '<' boven de komma, zodat je de
Shift-toets (ook wel bekend als de hoofdlettertoets) moet gebruiken om
het '<'-teken in te tikken. Op deze toetsenborden moet je ook de
-shift gebruiken om M-< in te tikken: zonder shift zou je M-, (META
-komma) tikken.
+shift gebruiken om M-< in te tikken: zonder shift zou je M-komma tikken.
>> Tik nu M-< om naar het begin van dit bestand te gaan.
Gebruik daarna C-v om hier weer terug te komen.
@@ -195,14 +195,13 @@ komma) tikken.
Als je toetsenbord pijltjestoetsen heeft, kan je die ook gebruiken om
de cursor te verplaatsen. We raden je aan om C-b, C-f, C-n en C-p te
-leren, om drie redenen. Ten eerste werken ze op alle toetsenborden,
-ook die zonder pijltjestoetsen. Ten tweede zul je merken dat wanneer
-je eenmaal wat ervaring hebt opgedaan in de omgang met Emacs, het
-gebruik van de CONTROL-tekens sneller is dan werken met de
-pijltjestoetsen (omdat je handen in de normale tikpositie kunnen
-blijven). Ten derde, als je eenmaal gewend bent aan deze commando's
-met CONTROL-tekens, kan je makkelijk andere gevorderde
-cursorbewegingscommando's leren.
+leren, om drie redenen. Ten eerste werken ze op alle soorten
+toetsenborden. Ten tweede zul je merken dat wanneer je eenmaal wat
+ervaring hebt opgedaan in de omgang met Emacs, het gebruik van de
+CONTROL-tekens sneller is dan werken met de pijltjestoetsen (omdat je
+handen in de normale tikpositie kunnen blijven). Ten derde, als je
+eenmaal gewend bent aan deze commando's met CONTROL-tekens, kan je
+makkelijk andere gevorderde cursorbewegingscommando's leren.
De meeste Emacs-commando's accepteren een numeriek argument. Voor de
meeste commando's is dit argument het aantal keren dat het commando
@@ -211,7 +210,9 @@ vervolgens de cijfers van het getal, vr het commando. Als je
toetsenbord een META- (of EDIT- of ALT-) toets heeft, is er ook een
andere manier om het getal aan te geven: tik de cijfers terwijl je de
META toets ingedrukt houdt. We raden je aan de C-u manier te leren
-omdat die beschikbaar is op elke terminal.
+omdat die beschikbaar is op elke terminal. Het numerieke argument
+wordt ook wel het "prefix-argument" genoemd omdat je het typt voor
+het commando waar het bij hoort.
Bijvoorbeeld, C-u 8 C-f beweegt de cursor 8 plaatsen naar voren.
@@ -233,33 +234,26 @@ verschuift de tekst 4 regels.
>> Probeer nu C-u 8 C-v.
-Daarmee zou je tekst 8 regels opgeschoven moeten zijn. Als je terug
+Daarmee zou de tekst 8 regels opgeschoven moeten zijn. Als je terug
omlaag wil scrollen, kan je M-v een argument geven.
-Als je een scherm met vensters gebruikt, zoals X Windows of
-MS-Windows, zou je een grote rechthoek moeten zien aan de linkerkant
-van het Emacs-venster. Deze rechthoek heet een schuifbalk
-("scrollbar"). Je kan de tekst scrollen door met de muis in de
-schuifbalk te klikken.
+Als je een grafisch scherm gebruikt, zoals X of MS-Windows, dan zou je
+een hoge rechthoek moeten zien aan een katn van het Emacs-venster.
+Deze rechthoek heet de schuifbalk ("scroll bar" in het Engels). Je
+kan de tekst scrollen door met de muis in de schuifbalk te klikken.
->> Klik met de middelste muisknop bovenaan het heldere gebied in de
- schuifbalk. Dit zou de tekst moeten verschuiven naar een positie
- die afhankelijk is van hoe hoog of laag je klikt.
-
->> Beweeg de muis op en neer terwijl je de middelste muisknop
- ingedrukt houdt. Je zal zien dat de tekst met de muis mee heen en
- weer scrollt.
+Als je muis een scrollwiel heeft, dan kan je die gebruiken om te scrollen.
* ALS EMACS HANGT
-----------------
-Als Emacs niet meer op commando's reageert, kan je het veilig
+Als Emacs niet meer op commando's reageert, kan je het gerust
onderbreken door C-g te tikken. Je kan C-g gebruiken om een commando
-te stoppen als het te lang duurt om uit te voeren.
+af te breken als het te lang duurt om uit te voeren.
Je kan C-g ook gebruiken om een numeriek argument te verwijderen of om
-het begin van een commando dat je niet wilt afmaken, te verwijderen.
+het begin van een commando dat je niet wilt afmaken, af te breken.
>> Tik nu C-u 100 om een numeriek argument te maken met de waarde 100,
en tik dan C-g. Tik vervolgens C-f. Het zou de cursor maar n
@@ -292,8 +286,8 @@ niet uitvoeren en beantwoord je de vraag met "n" (van "no" of "nee").
----------
Emacs kan meerdere vensters laten zien, elk venster met zijn eigen
-tekst. We zullen later uitleggen hoe je met meerdere vensters om kan
-gaan. Op dit moment willen we slechts uitleggen hoe je van extra
+tekst. We zullen later uitleggen hoe je met meerdere vensters kan
+werken. Op dit moment willen we slechts uitleggen hoe je van extra
vensters af kunt komen en terug kan keren naar het werken met n
venster. Het is eenvoudig:
@@ -315,60 +309,54 @@ Dit commando is anders dan de commando's die je tot nu toe geleerd
hebt aangezien het uit twee tekens bestaat. Het begint met het teken
CONTROL-x. Er zijn een heleboel commando's die met CONTROL-x
beginnen. Veel van die commando's hebben te maken met vensters,
-bestanden, buffers, en gelijkaardige dingen. Dergelijke commando's
+bestanden, buffers, en soortgelijke dingen. Dergelijke commando's
bestaan uit twee, drie of vier tekens.
* TOEVOEGEN EN WEGHALEN
-----------------------
-Als je tekst toe wil voegen, tik je die eenvoudigweg in. Tekens die
-je kan zien, zoals A, 7, * en dergelijke, worden door Emacs als tekst
-genterpreteerd en meteen aan de tekst toegevoegd. Tik <Return> (de
-"volgende regel"-toets) om een Newline toe te voegen en dus een nieuwe
-regel te beginnen.
-
-Je kan het laatste teken dat je hebt ingetikt weghalen door <Delback>
-te tikken. <Delback> is een toets op het toetsenbord -- dezelfde
-toets die je normaal gesproken gebruikt, buiten Emacs, om het laatst
-ingetikte teken te wissen. Het is meestal een grote toets, een paar
-rijen boven de <Return>-toets, waar "Delete", "Del" of "Backspace" op
-staat.
+Als je tekst toe wil voegen, tik je die gewoon in. Tekens die je kan
+zien, zoals A, 7, * en dergelijke, worden door Emacs als tekst
+genterpreteerd en meteen toegevoegd. Tik <Return> (de "volgende
+regel"-toets) om een Newline toe te voegen en dus een nieuwe regel te
+beginnen.
-Als er op die grote toets "Backspace" staat, dan is dat degene die je
-gebruikt voor <Delback>. Er kan op een andere plaats ook nog een
-andere toets zijn waarop "Delete" staat, maar dat is niet <Delback>.
+Om het teken dat dat voor de cursor staat te verwijderen, tik <DEL>.
+<DEL> is de toets op het toetsenbord die vaak "Backspace" heet --
+dezelfde toets die je normaal gesproken, buiten Emacs, gebruikt om het
+laatst ingetikte teken te wissen.
-In het algemeen haalt <Delback> het teken weg dat juist voor de
-cursorpositie staat.
+Er kan ook nog een toets op het toetsenbord zijn waarop "Delete"
+staat, maar dat is niet de knop die we <DEL> noemen.
>> Probeer dit nu: tik een paar letters en haal ze weer weg door een
- paar keer op <Delback> te drukken. Maak je niet druk over het feit
- dat dit bestand verandert; je zal niets veranderen aan de originele
- versie van deze inleiding. Je zit slechts je eigen kopie te
- wijzigen.
+ paar keer <DEL> te tikken. Maak je niet druk over het feit dat dit
+ bestand verandert; je zal niets veranderen aan de originele versie
+ van deze inleiding. Je bewerkt je eigen kopie.
Als een regel tekst te lang wordt om helemaal op het scherm getoond te
-worden, dan gaat hij verder op de volgende schermregel. Een backslash
-("\") in de rechtermarge (of, als je een scherm met vensters gebruikt,
-een kleine gebogen pijl) laat dan zien dat de regel op de volgende
-schermregel verder gaat.
+worden, dan gaat hij verder op de volgende schermregel. Als je een
+grafisch scherm gebruikt verschijnen kleine gebogen pijltjes links en
+rechts van het tekstgebied om aan te geven waar een regel voortgezet
+is. In een tekstvenster of terminal geeft een backslash ("\") in de
+laatste kolom een vervolgregel aan.
>> Voeg nu tekst toe totdat je de rechter kantlijn raakt, en blijf
toevoegen. Je zal zien dat er een vervolgregel verschijnt.
->> Tik weer enkele keren <Delback> om zoveel tekens weg te halen tot
+>> Tik weer enkele keren <DEL> om zoveel tekens weg te halen dat
de regel weer op een schermregel past. De vervolgregel zal
verdwijnen.
Je kan een Newline zoals elk ander teken verwijderen. Als je een
Newline verwijdert, voeg je de twee regels waar de Newline tussen
staat samen tot een enkele regel. Als de regel die het resultaat is
-van deze operatie niet op een schermregel past, zal hij getoond worden
-met een vervolgregel.
+niet op een enkele schermregel past, zal hij getoond worden met een
+vervolgregel.
->> Beweeg de cursor naar het begin van een regel en tik <Delback>.
- Dit voegt de huidige en vorige regel samen.
+>> Beweeg de cursor naar het begin van een regel en tik <DEL>.
+ Dit voegt die regel en de vorige regel samen.
>> Tik <Return> om de Newline die je net verwijderd hebt weer toe te
voegen.
@@ -376,52 +364,53 @@ met een vervolgregel.
Je herinnert je dat je bij de meeste Emacs-commando's het aantal keren
op kan geven, dat ze herhaald moeten worden. Dit geldt ook voor
gewone tekens. Als je een gewoon teken herhaalt, wordt dat teken
-herhaaldelijk toegevoegd.
+meerdere keren toegevoegd.
>> Probeer dat nu: tik C-u 8 * om ******** toe te voegen.
-Je hebt nu de eenvoudigste manier geleerd om iets in Emacs te tikken
-en fouten te verbeteren. Je kan tekst ook per woord of regel
-verwijderen. Hier volgt een samenvatting van de commando's om tekst
-te verwijderen:
+Je hebt nu de basismanier geleerd om iets in Emacs te tikken en fouten
+te verbeteren. Je kan tekst ook per woord of regel verwijderen. Hier
+volgt een samenvatting van de commando's om tekst te verwijderen:
- <Delback> Haal het teken weg dat voor de cursor staat
+ <DEL> Haal het teken weg dat voor de cursor staat
C-d Haal het teken weg dat achter de cursor staat
- M-<Delback> Verwijder het woord dat voor de cursor staat
+ M-<DEL> Verwijder het woord dat voor de cursor staat
M-d Verwijder het woord dat achter de cursor staat
C-k Verwijder alles van de cursor tot het eind van de regel
M-k Verwijder alles van de cursor tot het eind van de zin
-Merk op dat <Delback> en C-d, met M-<Delback> en M-d de analogie
-verder trekken, die begon met C-f en M-f (waarbij we voor het gemak
-even vergeten dat <Delback> niet echt een CONTROL-teken is). C-k en
-M-k lijken enigzins op C-e en M-e in hun relatie tot regels en zinnen.
+Merk op dat <DEL> en C-d, met M-<DEL> en M-d de analogie verder
+trekken, die begon met C-f en M-f (waarbij we voor het gemak even
+vergeten dat <DEL> niet echt een CONTROL-teken is). C-k en M-k lijken
+enigzins op C-e en M-e in hun relatie tot regels en zinnen.
Je kunt ook op n uniforme manier een willekeurig deel van de tekst
verwijderen. Beweeg daartoe naar n kant van het gedeelte dat je
-wilt verwijderen en tik C-@ of C-<SPC>. (<SPC> is de spatiebalk.)
-Beweeg daarna naar de andere kant en tik C-w. Dat verwijdert alle
-tekst tussen de twee posities.
+wilt verwijderen en tik C-<SPC>. (<SPC> is de spatiebalk.) Beweeg nu
+naar de andere kant van de tekst die je wilt verwijderen. Terwijl je
+beweegt, markeert Emacs zichtbaar de tekst tussen de cursor en de
+plaats waar je C-<SPC> tikte. Tik C-w. Dit verwijdert alle tekst
+tussen beide posities.
>> Beweeg de cursor naar de J aan het begin van de vorige alinea.
>> Tik C-<SPC>. Emacs toont nu de mededeling "Mark set" ("Markering
geplaatst") onderaan het scherm.
>> Plaats de cursor op de n van "kant" op de tweede regel van de
alinea.
->> Tik C-w. Dit zal de tekst vanaf de J tot vlak voor de n
- verwijderen.
-
-Er is een verschil tussen iets weghalen en iets verwijderen: iets dat
-je hebt verwijderd, kan je terugbrengen, maar iets dat je hebt
-weggehaald niet. (In het Engels is het verschil tussen "killing" en
-"deleting" duidelijker dan tussen de Nederlandse vertalingen
-"verwijderen" en "weghalen".) Verwijderde tekst terughalen heet
-"yanken". In het algemeen geldt dat de commando's die meer tekst dan
-een enkel teken, Newline of spatie verwijderen, deze tekst bewaren
-zodat hij geyankt kan worden, terwijl dat niet geldt voor commando's
-die slechts een enkel teken weghalen.
+>> Tik C-w. Dit zal de tekst vanaf de J tot aan de n verwijderen.
+
+Er is een verschil tussen iets verwijderen ("kill") en iets weghalen
+("delete"): iets dat je hebt verwijderd ("killed"), kan je
+terugbrengen, maar iets dat je hebt weggehaald ("deleted") niet. (Je
+kan het weghalen wel herstellen, zie verderop.) Verwijderde tekst
+invoegen heet "yanken". In het algemeen geldt dat de commando's die
+veel tekst kunnen verwijderen, deze tekst bewaren zodat hij geyankt
+kan worden, terwijl dat niet geldt voor commando's die slechts een
+enkel teken weghalen. <DEL> en C-d zijn de eenvoudigste commando's om
+tekst weg te halen, zonder argument. Met argument verwijderen ze en
+kan de verwijderde tekst geyankt worden.
>> Zet de cursor op het begin van een regel die niet leeg is.
Tik C-k om de tekst op die regel te verwijderen.
@@ -435,15 +424,22 @@ aangegeven aantal regels zal worden verwijderd, inclusief de inhoud.
Dit is meer dan simpelweg herhaling: C-u 2 C-k verwijdert twee regels,
terwijl tweemaal C-k tikken dat niet doet.
-Om de laatst verwijderde tekst terug te halen naar de plaats waar de
-cursor nu op staat (te yanken), tik C-y.
+Het invoegen van de laatst verwijderde tekst heet yanken ("yanking").
+Je kan de tekst yanken op de plek waar je het verwijderde, op een
+andere plek of zelfs in een ander bestand. Je kan dezelfde tekst
+meerdere keren yanken; op deze manier maak je meerdere kopien van
+dezelfde tekst. Verwijderen ("killing") en yanken worden in andere
+programma's ook wel knip ("cut") en plak ("paste") genoemd (zie ook de
+Glossary in de Emacs-handleiding).
+
+Het commando om te yanken is C-y. Het voegt de laatst verwijderde
+tekst in op de huidige cursorpositie.
>> Probeer het nu: tik C-y om de tekst te yanken.
-Het is alsof je met C-y iets uit de prullenbak haalt wat je net had
-verwijderd. Merk op dat verschillende C-k's achter elkaar alle regels
-die verwijderd worden, bij elkaar bewaart zodat een enkele C-y die
-regels in een keer terugbrengt.
+Als je meerdere keren C-k achter elkaar hebt gedaan, dan worden alle
+verwijderde tekstregels samen onthouden, zodat een enkele C-y al die
+regels in n keer invoegt.
>> Probeer het nu: tik C-k een paar keer.
@@ -468,7 +464,7 @@ verwijderde tekst.
>> Verwijder een regel, beweeg de cursor wat, en verwijder nog een
regel. Tik C-y om de tweede regel die je verwijderde, terug te
- halen. Tik nog een M-y en die regel wordt vervangen door de eerste
+ halen. Tik M-y en die regel wordt vervangen door de eerste
regel die je verwijderde. Tik nog enkele keren M-y en zie wat er
langs komt. Herhaal dit tot de tweede regel weer langs komt, en
dan nog een paar keer. Je kan ook experimenteren met positieve en
@@ -479,39 +475,41 @@ verwijderde tekst.
------------
Als je de tekst veranderd hebt en je daar toch niet tevreden mee bent,
-dan kan je de verandering ongedaan maken met het herstelcommando, C-x
-u.
+dan kan je de verandering ongedaan maken met het herstelcommando, C-/.
-Normaal gesproken herstelt C-x u de veranderingen die het gevolg zijn
-van een enkel commando; door herhaaldelijk C-x u te tikken, worden
+Normaal gesproken herstelt C-/ de veranderingen die het gevolg zijn
+van een enkel commando; door herhaaldelijk C-/ te tikken, worden
steeds eerdere commando's hersteld.
Er zijn echter twee uitzonderingen: commando's die de tekst niet
-wijzigen, zoals cursorbewegingen, worden overgeslagen, en commando's
-die simpelweg het ingetikte teken aan de tekst toevoegen, worden
-meestal gegroepeerd in groepjes van maximaal 20 tekens, zodat je
-minder vaak het commando C-x u hoeft te tikken om teksttoevoegingen te
-herstellen.
+wijzigen, zoals cursorbewegingen en scrollen, worden overgeslagen, en
+commando's die simpelweg het ingetikte teken aan de tekst toevoegen,
+worden meestal samengenomen in groepjes van maximaal 20 tekens.
+(Hierdoor hoef je minder vaak C-/ te tikken om teksttoevoegingen te
+herstellen.)
+
+>> Gooi deze regel weg met C-k; met C-/ zal hij weer verschijnen.
->> Gooi deze regel weg met C-k; met C-x u zou hij weer moeten
- verschijnen.
+C-_ is een alternatief herstelcommando; het doet exact hetzelfde als
+C-/. Op sommige terminals stuurt het tikken van C-/ in werkelijkheid
+een C-_ naar Emacs. Nog een alternatief commando is C-x u, maar dit
+is minder makkelijk te tikken.
-C-_ is een alternatief voor C-x u. Het levert exact hetzelfde
-resultaat op, maar is makkelijker om een paar keer achter elkaar te
-tikken. Een nadeel van C-_ is dat op sommige toetsenborden het
-intikken ervan niet gebruiksvriendelijk is. Dat is ook de reden voor
-het alternatief, C-x u. Op sommige terminals kan je C-_ tikken door
-"/" te tikken terwijl je de CONTROL-toets ingedrukt houdt.
+Een numeriek argument bij C-/, C-_ of C-x u duidt het aantal
+herhalingen aan.
+
+Je kan het weghalen van tekst herstellen, net zoals je het verwijderen
+ervan herstelt. Het verschil tussen iets verwijderen of weghalen is
+of je het kan yanken met C-y. Voor het herstellen maakt het geen
+verschil.
-Een numeriek argument bij C-_ of C-x u duidt het aantal herhalingen
-aan.
* BESTANDEN
-----------
Om een tekst die je gemaakt of veranderd hebt op te slaan, moet je de
-tekst in een bestand stoppen ("to save a file" in het Engels). Als je
+tekst in een bestand opslaan ("to save a file" in het Engels). Als je
dat niet doet, ben je die veranderingen kwijt op het moment dat je
Emacs verlaat. Je kan een bestand veranderen door het bestand te
"bezoeken". (Ook wel "vinden"; "finding" of "visiting" in het
@@ -526,8 +524,8 @@ als je het bestand opslaat, zorgt Emacs ervoor dat het originele
bestand onder een gewijzigde naam nog steeds beschikbaar is, voor het
geval je later besluit dat de veranderingen toch niet zo goed waren.
-Bij de onderkant van het scherm zie je een regel die begint en eindigt
-met streepjes, met aan het begin "-1:-- TUTORIAL.nl" of iets
+Bij de onderkant van het scherm zie je een regel die begint
+met streepjes, met aan het begin "-:-- TUTORIAL.nl" of iets
dergelijks. Dit deel van het scherm laat normaal de naam van het
bestand zien dat je op dat moment bezoekt. Op dit moment bezoek je
een bestand dat "TUTORIAL.nl" heet; het is je eigen kopie van de
@@ -537,16 +535,16 @@ op deze plaats.
Iets bijzonders aan het commando om een bestand te bezoeken, is dat je
aan moet geven welk bestand je wil. Dit heet dat het commando "een
-argument van de gebruiker vraagt"; in dit geval de naam van het
-bestand. Nadat je het commando
+argument inleest"; in dit geval de naam van het bestand. Nadat je het
+commando
C-x C-f Bezoek bestand (met de f van "find file").
hebt getikt vraagt Emacs om de naam van het bestand. De naam die je
intikt verschijnt op de onderste regel van het scherm. Wanneer die
regel voor dit soort invoer gebruikt wordt, heet hij de minibuffer.
-Je kan gewone Emacs commando's gebruiken om de bestandsnaam te
-veranderen.
+Je kan gewone Emacs commando's gebruiken om de bestandsnaam in te
+geven.
Tijdens het invoeren van de bestandsnaam (of om het even welke invoer
in de minibuffer) kan je het commando afbreken met C-g.
@@ -556,36 +554,38 @@ in de minibuffer) kan je het commando afbreken met C-g.
Het resultaat is dat je geen bestand bezoekt.
Als je de naam van een bestand hebt ingevoerd, tik dan <Return> om het
-commando af te sluiten. Hierna gaat het C-x C-f commando aan het werk
-en haalt het bestand op dat je aangegeven hebt. Als het C-x C-f
-commando daarmee klaar is, verdwijnt de minibuffer.
+commando af te sluiten. Hierna verdwijnt de minibuffer en gaat het
+C-x C-f commando aan het werk: het haalt het bestand op dat je
+aangegeven hebt.
-Na korte tijd verschijnt de inhoud van het bestand op het scherm en
-kan je de inhoud wijzigen. Als je de wijzigingen op wilt slaan, tik
-dan het commando
+De inhoud van het bestand verschijnt nu op het scherm en je kan de
+inhoud wijzigen. Als je de wijzigingen op wilt slaan, tik dan het
+commando
C-x C-s Sla bestand op (met de s van "save file").
-Dit commando slaat de tekst zoals Emacs die nu heeft in het bestand
-op. De eerste keer dat je dit doet, slaat Emacs het originele bestand
-onder een andere naam op, zodat het niet verloren gaat. De nieuwe
-naam bestaat uit de oude bestandsnaam gevolgd door een "~".
+Dit commando slaat de tekst zoals Emacs die nu heeft op in het
+bestand. De eerste keer dat je dit doet, slaat Emacs het originele
+bestand onder een andere naam op, zodat het niet verloren gaat. De
+nieuwe naam bestaat uit de oude bestandsnaam gevolgd door een "~".
Als Emacs het bestand heeft opgeslagen, laat het de naam van het
bestand zien. Het is een goede gewoonte een bestand regelmatig op te
-slaan zodat er niet teveel werk verloren gaat als het systeem hangt of
-crasht.
+slaan zodat er niet teveel werk verloren gaat als het systeem crasht
+(zie ook "Automatisch bewaren" hieronder).
->> Tik C-x C-s, om je kopie van deze inleiding op te slaan. Als het
- goed is verschijnt "Wrote ...TUTORIAL.nl" op de onderste
- schermregel.
+>> Tik C-x C-s TUTORIAL.nl <Return>
+ Op deze manier sla je deze inleiding op in een bestand genaamd
+ TUTORIAL.nl. Als het goed is verschijnt "Wrote ...TUTORIAL.nl" op de
+ onderste schermregel.
-Je kan een bestaand bestand bezoeken om het te bekijken of het te
-wijzigen. Je kan ook een bestand bezoeken dat nog niet bestaat. Dit
-is de manier om met Emacs een nieuw bestand te maken: bezoek het
+Je kan een bestand dat al bestaat bezoeken om het te bekijken of het
+te wijzigen. Je kan ook een bestand bezoeken dat nog niet bestaat.
+Dit is de manier om met Emacs een nieuw bestand te maken: bezoek het
bestand, dat eerst leeg zal zijn, en voeg tekst toe. Zodra je de
-tekst opslaat, wordt het bestand werkelijk gecreerd, met de tekst als
-inhoud. Vanaf dat moment ben je dus bezig met een bestaand bestand.
+tekst opslaat, wordt het bestand werkelijk gecreerd, met de nieuwe
+tekst als inhoud. Vanaf dat moment ben je dus bezig met een bestand
+dat al bestaat.
* BUFFERS
@@ -594,28 +594,22 @@ inhoud. Vanaf dat moment ben je dus bezig met een bestaand bestand.
Als je een tweede bestand bezoekt met C-x C-f, blijft het eerste
bestand gewoon in Emacs. Je kan naar dat bestand terug door het
gewoon nog een keer te bezoeken met C-x C-f. Op deze manier kan je
-een behoorlijk aantal bestanden in Emacs krijgen.
-
->> Creer een bestand dat "foo" heet door te tikken: C-x C-f foo
- <Return>. Voeg hieraan wat tekst toe, wijzig hem, en sla "foo" op
- door C-x C-s te tikken. Tik hierna C-x C-f TUTORIAL <Return> om
- weer hier, in de inleiding, terug te komen.
+een behoorlijk aantal bestanden in Emacs hebben.
-Emacs bewaart intern de tekst van elk bestand in een ding dat een
-"buffer" genoemd wordt. Als je een bestand bezoekt wordt er een
-nieuwe buffer gemaakt. Om een lijst van de huidige buffers te zien,
-tik
+Emacs onthoudt de tekst van elk bestand in een ding dat een "buffer"
+heet. Als je een bestand bezoekt maakt Emacs een nieuwe buffer aan.
+Om een lijst van de huidige buffers te zien, tik
- C-x C-b Laat de bufferlijst zien
+ C-x C-b Toon de bufferlijst
>> Probeer C-x C-b nu.
-Bemerk dat elke buffer een naam heeft en mogelijk ook een
-bestandsnaam; dit is de naam van het bestand waarmee de buffer
-overeenkomt. ALLE tekst die je in een Emacs venster ziet is altijd
-onderdeel van een of andere buffer.
+Merk op dat elke buffer een naam heeft en mogelijk ook een
+bestandsnaam: de naam van het bestand waarvan de inhoud in de buffer
+zit. ALLE tekst die je in een Emacs venster ziet is altijd onderdeel
+van een of andere buffer.
->> Tik C-x 1 om de bufferlijst te verwijderen.
+>> Tik C-x 1 om de bufferlijst uit het zicht krijgen.
Wanneer je met meerdere buffers werkt, dan is op elk moment slechts
n van die buffers "actueel". De actuele buffer is degene die je aan
@@ -626,26 +620,30 @@ opnieuw te bezoeken met C-x C-f. Er is ook een makkelijkere manier:
gebruik het commando C-x b. Dit commando vraagt je naar de naam van
de buffer.
->> Tik C-x b foo <Return> om terug te gaan naar de buffer "foo" die de
- tekst van het bestand "foo" bevat. Tik vervolgens C-x b TUTORIAL
- <Return> om terug te komen naar deze Emacs-inleiding.
+>> Bezoek een bestand met de naam "foo" door te tikken: C-x C-f foo
+ <Return>. Tik vervolgens C-x b TUTORIAL <Return> om terug te komen
+ in deze Emacs-inleiding.
Meestal is de naam van de buffer gelijk aan de naam van het bestand
(minus de naam van de directory). Dit klopt echter niet altijd. De
-lijst met buffers die je maakt met C-x C-b laat je altijd de naam van
-elke buffer zien.
+lijst met buffers die je maakt met C-x C-b laat je zowel de naam van
+buffer als de bestandsnaam van alle buffers zien.
ALLE tekst die je ziet in een venster van Emacs is altijd onderdeel
van een of andere buffer. Sommige buffers komen niet overeen met een
bestand. De buffer genaamd "*Buffer List*" heeft bijvoorbeeld geen
-bijbehorend bestand. Deze buffer bevat de lijst met buffers die je
-gemaakt hebt met C-x C-b. Ook de buffer "*Messages*" heeft geen
-geassocieerd bestand; deze buffer bevat de mededelingen die Emacs je
-op de onderste regel toonde.
+bijbehorend bestand (deze buffer bevat de lijst met buffers die je
+gemaakt hebt met C-x C-b). Deze TUTORIAL.nl-buffer had in het begin
+ook geen bijbehorend bestand; nu heeft hij die wel omdat je eerder in
+deze inleiding C-x C-s tikte om hem in een bestand op te slaan.
+
+Ook de buffer "*Messages*" hoort niet bij een bestand; deze buffer
+bevat de mededelingen die Emacs op de onderste regel toonde tijdens
+deze Emacs-sessie.
>> Tik C-x b *Messages* <Return> om de buffer met mededelingen te
- bekijken. Tik daarna weer C-x b TUTORIAL <Return> om terug te
- keren naar deze buffer met de Emacs-inleiding
+ bekijken. Tik daarna weer C-x b TUTORIAL.nl <Return> om terug te
+ keren naar deze Emacs-inleiding.
Als je de tekst van het ene bestand verandert en dan een ander bestand
bezoekt, wordt het eerste bestand niet opgeslagen. De wijzigingen
@@ -671,12 +669,12 @@ opgeslagen zijn, of je de buffer wilt bewaren.
------------------------
Er zijn veel meer Emacs commando's dan er op de toetsen van het
-toetsenbord passen, zelfs als we hun aantal kunnen vergroten door de
-CONTROL- of META-toets te gebruiken. Emacs lost dit probleem op met
-het X commando (met de X van eXtensie of uitbreiding). Het X commando
-komt voor in twee smaken:
+toetsenbord passen, zelfs als we hun aantal vergroten door de CONTROL-
+of de META-toets te gebruiken. Emacs lost dit probleem op met het X
+commando (met de X van eXtensie of uitbreiding). Het X commando kent
+twee smaken:
- C-x Tekenuitbreiding. Gevolgd door een teken.
+ C-x Tekenuitbreiding. Wordt gevolgd door een teken.
M-x Commando-naam-uitbreiding. Wordt gevolgd door een naam.
Deze commando's zijn in het algemeen nuttig, maar worden minder
@@ -686,29 +684,24 @@ bezoeken en C-x C-s om het te bewaren, bijvoorbeeld. Een ander
voorbeeld is het commando om Emacs te verlaten: dit is C-x C-c. (Maak
je geen zorgen over het verloren gaan van veranderingen die niet
opgeslagen zijn; C-x C-c vraagt of je veranderde buffers wilt bewaren
-voordat Emacs helemaal eindigt.)
+voordat Emacs helemaal stopt.)
-C-z is het commando om Emacs *tijdelijk* te verlaten, zodat je daarna
-weer terug kan keren in dezelfde Emacs-sessie.
-
-Op systemen die deze mogelijkheid bieden, zet C-z Emacs stil: je komt
-weer terug in de shell, maar Emacs is nog aanwezig. In de meeste
-shells kan je Emacs weer activeren met het "fg" commando, of met
-"%emacs".
+Als je een grafisch scherm gebruikt heb je geen commando's nodig om
+van Emacs naar een andere applicatie te gaan. Je gebruikt dat de muis
+of commando's van de vensterbeheerder. Als je Emacs gebruikt in een
+tekstvenster of terminal, die maar n applicatie tegelijkertijd kan
+laten zien, moet je Emacs tijdelijk verlaten om naar een andere
+applicatie te gaan.
-Op systemen die niet de mogelijkheid bieden om programma's stil te
-zetten, creert C-z een subshell onder Emacs om je zo in de
-gelegenheid te stellen andere programma's uit te voeren en daarna weer
-in Emacs terug te keren; Emacs wordt dus niet werkelijk verlaten. In
-dit geval is het shellcommando "exit" de normale manier om de subshell
-te verlaten en in Emacs terug te keren.
+C-z is het commando om Emacs *tijdelijk* te verlaten, zodat je daarna
+weer terug kan keren naar dezelfde Emacs-sessie. Als je Emacs in een
+tekstvenster op terminal gebruikt, zet C-z Emacs stil: je komt weer
+terug in de shell, maar Emacs is nog aanwezig. In de meeste shells
+kan je Emacs weer activeren met het "fg" commando, of met "%emacs".
Het moment om C-x C-c te gebruiken is wanneer je uit gaat loggen. Het
is ook het juiste commando om Emacs te beindigen wanneer Emacs
-opgestart was door een mail-programma of iets dergelijks, aangezien
-die misschien niet met een stilgezette Emacs om kunnen gaan. Normaal
-gezien is het echter beter Emacs stil te zetten met C-z dan om Emacs
-te verlaten, behalve als je uit wilt loggen natuurlijk.
+opgestart was door een mail-programma of iets dergelijks.
Er bestaan vele C-x commando's. Hier is een lijst van degene die je
nu al kent:
@@ -722,14 +715,15 @@ nu al kent:
C-x 1 Een enkel venster
C-x u Herstel
-Commando-naam-bevelen worden nog minder vaak gebruikt, of alleen onder
-bepaalde omstandigheden. Een voorbeeld is het commando
+Commando-naam-commando's worden nog minder vaak gebruikt, of alleen
+onder bepaalde omstandigheden. Een voorbeeld is het commando
replace-string, dat in de hele tekst een string vervangt door een
andere string ("to replace" betekent "vervangen"). Als je M-x tikt,
toont Emacs onderaan het scherm "M-x" en moet je de naam van het
commando intikken, in dit geval "replace-string". Als je gewoon
-"repl s<TAB>" tikt maakt Emacs de naam zelf af. Beindig het commando
-met <Return>.
+"repl s<TAB>" tikt maakt Emacs de naam zelf af. (<TAB> is de
+Tab-toets, die meestal boven de CapsLock of Shift-toets zit aan de
+linkerkant van het toetsenbord.) Beindig het commando met <Return>.
Het replace-string commando heeft twee argumenten nodig: de string die
vervangen moet worden en de string waarmee die vervangen moet worden.
@@ -739,14 +733,14 @@ Je sluit elk argument af met <Return>.
Tik dan M-x repl s<Return>gewijzigd<Return>veranderd<Return>.
Zie hoe deze regel daardoor gewijzigd is. Je hebt elk voorkomen
- van het woord g-e-w-i-j-z-i-g-d vervangen door "veranderd"; te
- beginnen op de plek waar de cursor staat.
+ van het woord g-e-w-i-j-z-i-g-d vervangen door "veranderd", te
+ beginnen op de plek waar de cursor stond.
* AUTOMATISCH BEWAREN
---------------------
-Als je een bestand veranderd hebt maar het nog niet opgeslagen hebt,
+Als je een bestand veranderd hebt maar je hebt het nog niet opgeslagen,
zouden de veranderingen verloren kunnen gaan als het systeem zou
hangen of herstarten. Om je hiertegen te beschermen, slaat Emacs
regelmatig de veranderde tekst automatisch op. De naam van het
@@ -767,21 +761,22 @@ teruggehaald.
* ECHO-GEBIED
-------------
-Als je een commando langzaam intikt, toont Emacs de tekens aan de
-onderkant van het scherm in een deel dat het "echo-gebied" genoemd
-wordt. Dit gebied omvat de onderste regel van het scherm.
+Als je een commando dat uit meerdere tekens bestaat langzaam intikt,
+toont Emacs de tekens onderin het scherm in een deel dat het
+"echo-gebied" genoemd wordt. Dit gebied omvat de onderste regel van
+het scherm.
* MODUS-REGEL
-------------
-De regel direct boven het echo gebied heet de "modusregel". De
+De regel direct boven het echo-gebied heet de "modusregel". De
modusregel ziet er ongeveer zo uit:
--1:** TUTORIAL.nl 62% L763 (Fundamental)-----------------------
+-1:** TUTORIAL.nl 63% L776 (Fundamental)-----------------------
-Deze regel geeft interessante informatie over Emacs en de tekst die je
-aan het bewerken bent.
+Deze regel geeft nuttige informatie over Emacs en de tekst die je aan
+het bewerken bent.
Je weet al wat de bestandsnaam betekent: het is de naam van het
bestand dat je bezoekt. NN% geeft je huidige positie in de tekst aan:
@@ -792,8 +787,8 @@ van " 0%". Als het laatste stuk tekst op het scherm staat, zal er
tekst zo klein is dat hij volledig op het scherm past staat "All" in
de modus-regel.
-De L gevolgd door een getal geeft het nummer van de regel waarin punt
-zich bevindt.
+De L gevolgd door een getal geeft het regelnummer aan waar punt zich
+bevindt.
De sterretjes aan het begin betekenen dat je de tekst veranderd hebt.
Direct na het bezoeken of opslaan staan er gewoon streepjes.
@@ -805,8 +800,8 @@ heet een hoofdmodus ("major mode" in het Engels).
Emacs heeft verschillende hoofdmodi. Sommige daarvan zijn bedoeld
voor het bewerken van verschillende talen of soorten tekst, zoals
-bijvoorbeeld Lisp modus, Text modus, etc. Op elk moment is er altijd
-precies een modus actief, en de naam daarvan staat in de modusregel,
+bijvoorbeeld Lisp-modus, Text-modus, etc. Op elk moment is er altijd
+precies n modus actief, en de naam daarvan staat in de modusregel,
op de plaats waar nu "Fundamental" staat.
Elke hoofdmodus zorgt ervoor dat sommige commando's zich anders
@@ -818,17 +813,17 @@ een uitgebreid commando, en met dat commando schakel je om naar die
hoofdmodus. Zo is bijvoorbeeld M-x fundamental-mode het commando om
naar de basismodus om te schakelen.
-Als je Nederlandse of Engelse tekst wil gaan bewerken, zoals
-bijvoorbeeld dit bestand, kan je beter "Text mode" gebruiken, de modus
-om tekst in een gewone taal te bewerken:
+Als je Nederlandse of Engelse tekst gaat bewerken, zoals bijvoorbeeld
+dit bestand, kan je beter "Text mode" gebruiken, de modus om tekst in
+een gewone taal te bewerken:
->> Tik M-x text-mode<Return>.
+>> Tik M-x text-mode <Return>.
-Wees gerust; geen van de commando's die je geleerd hebt zorgen voor
-grondige veranderingen in Emacs. Een van de dingen die je kan merken,
-is bijvoorbeeld dat M-f en M-b nu apostrofs als onderdeel van een
-woord beschouwen. In de vorige modus (Fundamental) behandelen M-f en
-M-b de apostrof als ruimte tussen twee woorden.
+Wees gerust; geen van de commando's die je geleerd hebt gaan zich nu
+echt anders gedragen. Een van de dingen die je kan merken, is
+bijvoorbeeld dat M-f en M-b nu apostrofs als onderdeel van een woord
+beschouwen. In de vorige modus (Fundamental) behandelen M-f en M-b de
+apostrof als ruimte tussen twee woorden.
Het is gebruikelijk dat hoofdmodi dergelijke subtiele verschillen
hebben. De meeste commando's doen dus min of meer hetzelfde in elke
@@ -837,8 +832,7 @@ hoofdmodus.
Met het commando C-h m kan je de documentatie over de huidige
hoofdmodus lezen.
->> Gebruik C-u C-v een paar keer om deze zin in de buurt van de
- bovenkant van het scherm te krijgen.
+>> Gebruik C-l C-l om deze regel bovenin het scherm te krijgen.
>> Tik C-h m om te zien hoe de tekstmodus verschilt van de basismodus.
>> Tik C-x 1 om de documentatie van het scherm te verwijderen.
@@ -855,26 +849,27 @@ automatisch uitvullen). Wanneer deze modus aanstaat, breekt Emacs
automatisch een regel tussen twee woorden af als de regel te lang
wordt.
-Je kan Auto Fill modus aanzetten met M-x auto-fill-mode<Return>. Als
-deze modus al aanstaat, kan je hem uitzetten met M-x
-auto-fill-mode<Return>. Als de modus uitstaat, zet dit commando de
-modus aan; als ze aanstaat, zet dit commando de modus uit. We zeggen
-dat het commando de modus "schakelt" ("to toggle" in het Engels).
+Je kan Auto Fill modus aanzetten met M-x auto-fill-mode <Return>. Als
+deze modus al aanstaat, kan je hem uitzetten met
+M-x auto-fill-mode <Return>. Als de modus uitstaat, zet dit commando
+de modus aan; als ze aanstaat, zet dit commando de modus uit. We
+zeggen dat het commando de modus "schakelt" ("to toggle" in het
+Engels).
>> Tik nu M-x auto-fill-mode<Return>. Tik nu vele malen "asdf " op
- een regel zodat je kan zien dat de regel in tween gesplitst wordt.
+ een regel totdat je ziet dat de regel in tween gesplitst wordt.
Er moeten wel spaties tussen de woorden staan, omdat de Auto Fill
modus de regel alleen op spaties breekt.
De rechterkantlijn staat meestal op 70 tekens, maar die kan je
-veranderen met het C-x f commando. Dit commando accepteert een
-numeriek argument om de gewenste kantlijn te verkrijgen.
+veranderen met het C-x f commando. Dit commando accepteert de
+gewenste kantlijn als numeriek argument.
>> Tik C-x f met 20 als argument (C-u 20 C-x f).
Tik wat tekst en zie dat Emacs de regels afbreekt bij 20 tekens.
- Zet de kantlijn nu terug op 70, dus met met C-u 70 C-x f.
+ Zet de kantlijn nu terug op 70, met C-u 70 C-x f.
-Als je de tekst midden in een regel verandert vult Auto Fill modus de
+Als je de tekst midden in een regel verandert, vult Auto Fill modus de
regel niet opnieuw.
Om een alinea opnieuw te vullen, tik M-q (META-q) terwijl de cursor in
de alinea staat.
@@ -890,13 +885,12 @@ cursorpositie, als eraan voorafgaand. Het zoeken naar een string
verplaatst de cursor naar de volgende plaats waar de gezochte string
voorkomt.
-Het zoekcommando van Emacs is anders dan de zoekcommando's van de
-meeste tekstverwerkers; het zoekt incrementeel. Dit betekent dat het
+Het zoekcommando van Emacs zoekt incrementeel. Dit betekent dat het
zoeken gebeurt tijdens het intikken van de gezochte string.
Het commando om het voorwaarts zoeken te starten is C-s (met de "s"
van "to search", zoeken); C-r start het achterwaarts zoeken (met de
-"r" van "reverse" of achteruit). MAAR WACHT! Probeer ze nu nog niet.
+"r" van "reverse" of achteruit). WACHT! Probeer ze nu nog niet.
Als je C-s tikt verschijnt de string "I-search" in het echo-gebied.
Dit betekent dat Emacs bezig is met een "incremental search"
@@ -909,7 +903,7 @@ zoekstring. <Return> beindigt het zoeken.
woord "cursor" gezocht.
>> Tik nogmaals C-s, om naar het volgende voorkomen van het woord
"cursor" te zoeken.
->> Tik nu viermaal <Delback> en let op de cursorbewegingen.
+>> Tik nu viermaal <Del> en let op de cursorbewegingen.
>> Tik <Return> om het zoeken te beindigen.
Zag je wat er gebeurde? Tijdens incrementeel zoeken probeert Emacs
@@ -919,23 +913,17 @@ keer. Als er geen volgende plek is gevonden, biept Emacs en vertelt
je dat de zoekopdracht niets gevonden heeft ("failing" in het Engels).
C-g zou het zoeken ook afbreken.
-OPMERKING: Op sommige systemen gebeurt er helemaal niets als je C-s
-tikt, en daarna ook niets meer. Dit komt door een eigenschap van de
-machine waarop je werkt die te maken heeft met "flow control". Met
-C-s stopt de "flow" en komt niets meer van wat je tikt bij Emacs
-terecht. Om deze situatie te herstellen, tik C-q. Lees daarna het
-hoofdstuk "Spontaneous Entry to Incremental Search" in het
-Emacs-handboek over hoe je moet omgaan met deze situatie.
-
-Als je tijdens incrementeel zoeken <Delback> tikt, zal je zien dat het
-laatste teken dat je aan de zoekstring toegevoegd hebt, weggehaald
-wordt en dat het zoeken teruggaat naar de voorgaande plaats. Als je
-bijvoorbeeld begint met zoeken en je tikt een "c", dan ga je naar de
-plaats waar de "c" het eerst voorkomt. Tik je vervolgens een "u", dan
-gaat de cursor naar de plaats waar de string "cu" het eerst voorkomt.
-Als je nu <Delback> tikt, dan wordt de "u" van de zoekstring
-afgehaald, en gaat de cursor terug naar de plaats waar hij stond
-voordat je de "u" intikte, namelijk daar waar "c" het eerst voorkwam.
+Als je tijdens incrementeel zoeken <DEL> tikt, dan gaat het zoeken
+terug naar de vorige plek. Als je <DEL> tikt nadat je C-s hebt getikt
+om naar een volgende plaats te gaan waar de zoekstring voorkomt, zal
+<DEL> de cursor terug laten gaan naar de vorige plaats. Als er geen
+vorige plaats is verwijdert <DEL> het laatste karakter van de
+zoekstring. Als je bijvoorbeeld begint met zoeken en je tikt een "c",
+dan ga je naar de plaats waar de "c" het eerst voorkomt. Tik je
+vervolgens een "u", dan gaat de cursor naar de eerstvolgende plaats
+waar de string "cu" het eerst voorkomt. Tik nu <DEL> en de "u" wordt
+van de zoekstring afgehaald en de cursor gaat terug naar de plaats
+waar "c" het eerst voorkwam.
Als je tijdens een zoekoperatie een CONTROL- of META-teken intikt, dan
wordt het zoeken beindigd. Er zijn een paar uitzonderingen, namelijk
@@ -944,18 +932,20 @@ C-r.
Met C-s begin je te zoeken naar de plaats waar de zoekstring voor het
eerst voorkomt NA de huidige cursorpositie. Als je iets wilt zoeken
-dat eerder in de tekst moet voorkomen, gebruik dan C-r in plaats van
-C-s. Alles wat we nu weten over C-s geldt ook voor C-r, alleen is de
-zoekrichting omgedraaid.
+dat eerder in de tekst moet voorkomen, gebruik dan C-r. Alles wat we
+nu weten over C-s geldt ook voor C-r, alleen is de zoekrichting
+omgedraaid.
* MEERDERE VENSTERS
-------------------
Een van Emacs' aardige eigenschappen is dat je meerdere vensters op
-het scherm kan laten zien.
+het scherm kan laten zien. (Merk op dat wat Emacs "frames" noemt in
+andere systemen "vensters" genoemd wordt. Zie de Woordenlijst van
+Emacs-termen (Glossary of Emacs terms) in de Emacs-handleiding.)
->> Zet de cursor op deze regel en tik C-u 0 C-l.
+>> Zet de cursor op deze regel en tik C-l C-l.
>> Tik C-x 2 om het scherm in twee vensters op te splitsen.
Beide vensters laten deze inleiding zien; de cursor blijft in het
@@ -966,19 +956,20 @@ het scherm kan laten zien.
>> Tik C-x o (met de o van "other"; "ander" in het Nederlands) om de
cursor naar het andere venster te verplaatsen.
-
>> Verschuif de tekst in het onderste venster, met C-v en M-v.
- Zorg ervoor dat je deze inleiding in het bovenste venster leest.
+ Deze inleiding kan je blijven lezen in het bovenste venster.
>> Tik weer C-x o om de cursor weer in het bovenste venster te zetten.
De cursor staat weer precies op de plaats waar hij stond toen je
het venster verliet.
Je kan C-x o blijven gebruiken om van venster naar venster te gaan.
-Elk venster heeft zijn eigen cursorpositie; de cursor is altijd enkel
-zichtbaar in een daarvan. Alle normale commando's hebben betrekking
-op het venster waarin de cursor staat. Dit venster is het
-"geselecteerde venster" ("selected window" in het Engels).
+Het "geselecteerde venster" ("selected windows" in het Engels), waar
+de meeste bewerkingen plaatsvinden, is die met die vette cursor die
+knippert als je niet aan het tikken bent. De andere vensters hebben
+hun eigen cursorposities. Als je Emacs gebruikt op een grafisch
+scherm, dan zijn de cursors in die andere venters niet-gevulde
+rechthoekjes die niet knipperen.
Het C-M-v commando is erg nuttig wanneer je tekst aan het bewerken
bent in het ene venster, terwijl je het andere venster als referentie
@@ -986,28 +977,29 @@ gebruikt. Je kan de cursor dan altijd in het venster houden waarin je
bezig bent, terwijl je met C-M-v door de tekst in het andere venster
loopt.
-C-M-v is een voorbeeld van een CONTROL-META teken. Als je een echte
-META-toets hebt kan je C-M-v intikken door zowel CONTROL als META
-ingedrukt te houden terwijl je v tikt. Het maakt niet uit in welke
-volgorde je CONTROL en META indrukt; het gaat erom welke toetsen
-ingedrukt zijn terwijl je tikt.
+C-M-v is een voorbeeld van een CONTROL-META teken. Als je een
+META-toets (of Alt-toets) hebt kan je C-M-v intikken door zowel
+CONTROL als META ingedrukt te houden terwijl je v tikt. Het maakt
+niet uit in welke volgorde je CONTROL en META indrukt; het gaat erom
+welke toetsen ingedrukt zijn terwijl je tikt.
Als je geen echte META-toets hebt kan je <ESC> gebruiken; de volgorde
is dan wel belangrijk. Je moet dan eerst <ESC> tikken, gevolgd door
CONTROL-v; CONTROL-<ESC> v zal niet werken. Dit komt doordat <ESC>
-zelf een teken is, terwijl CONTROL en META dat niet zijn.
+zelf een teken is, terwijl CONTROL en META dat niet zijn: dat zijn
+"modifiers" (Engels).
>> Tik C-x 1 (in het bovenste venster) om het onderste venster te
laten verdwijnen.
(Als je C-x 1 tikt in het onderste venster laat je het bovenste
-verdwijnen. C-x 1 betekent zoveel als "ik wil maar 1 venster, en wel
-dat venster waar de cursor nu in staat.")
+verdwijnen. C-x 1 betekent zoveel als "ik wil maar 1 venster,
+en wel het venster waar ik nu ben.")
Je hoeft niet dezelfde buffer in beide vensters te hebben. Wanneer je
C-x C-f gebruikt om een bestand in n van de vensters te bezoeken,
-zal het andere venster niet veranderen. Je kunt de vensters
-onafhankelijk van elkaar gebruiken om bestanden te bezoeken.
+verandert het andere venster niet. Je kunt de vensters onafhankelijk
+van elkaar gebruiken om bestanden te bezoeken.
Hier is nog een manier om twee venster te krijgen die elk een andere
tekst laten zien:
@@ -1020,6 +1012,32 @@ tekst laten zien:
het onderste venster te laten verdwijnen.
+* MEERDERE FRAMES
+-----------------
+
+Emacs kan meerdere zogeheten frames maken. Een frame bestaat uit
+vensters, menu's, scrollbalken, echo-gebied, etc. Op grafische
+schermen is een Emacs-frame wat andere applicaties meestal een venter
+(of een "window" in het Engels, vgl. Windows) noemen. Meerdere
+grafische frames kunnen tegelijk op het scherm getoond worden. Een
+tekstterminal kan maar n frame tegelijkertijd tonen.
+
+>> Tik M-x make-frame <Return>.
+ Een nieuw frame verschijnt op het scherm.
+
+In het nieuwe frame kan je alles doen wat je ook in het eerste frame
+kon doen. Het eerste frame is niet speciaal.
+
+>> Tik M-x delete-frame <Return>.
+ Het actieve frame verdwijnt.
+
+Je kan een frame ook laten verdwijnen op de manier die gebruikelijk is
+voor het grafische systeem dat je gebruikt, vaak door de button te
+klikken in een van de bovenhoek van het frame die gemarkeerd is met
+een "X". Als je Emacs' laatste frame op deze manier laat verdwijnen,
+dan sluit je Emacs af.
+
+
* RECURSIEVE BEWERKINGSNIVEAUS
------------------------------
@@ -1029,11 +1047,11 @@ aan de vierkante haken die om de haakjes van de naam van de hoofdmodus
staan. Dan staat er bijvoorbeeld [(Fundamental)] in plaats van
(Fundamental).
-Tik <ESC> <ESC> <ESC> Om uit een recursief bewerkingsniveau te komen.
+Tik <ESC> <ESC> <ESC> om uit een recursief bewerkingsniveau te komen.
Dit is een algemeen "ontsnappingscommando". Je kan het ook gebruiken
om extra vensters te verwijderen of om uit de minibuffer te komen.
->> Tik M-x om in een minibuffer te komen, en tik dan <ESC> <ESC> <ESC>
+>> Tik M-x om in een minibuffer te komen; tik dan <ESC> <ESC> <ESC>
om er weer uit te komen.
C-g is niet bruikbaar om uit een recursief bewerkingsniveau te komen.
@@ -1048,9 +1066,9 @@ We hebben geprobeerd je met deze inleiding precies genoeg informatie
te leveren om met Emacs te beginnen werken. De mogelijkheden van
Emacs zijn zo groot dat het onmogelijk is nu alles uit te leggen. Het
kan zijn dat je meer over Emacs wil leren omdat het zoveel nuttige
-mogelijkheden heeft. Emacs heeft commando's om documentatie te laten
-zien over Emacs commando's. Deze "helpcommando's" beginnen allemaal
-met C-h: "het Hulpteken".
+mogelijkheden heeft. Emacs heeft commando's om documentatie te lezen
+over Emacs commando's. Deze "helpcommando's" beginnen allemaal met
+C-h: "het Hulpteken".
Om hulp te krijgen tik je C-h, gevolgd door een teken om aan te duiden
welke hulp je wilt. Als je het echt niet meer weet, tik C-h ? en
@@ -1058,12 +1076,8 @@ Emacs vertelt welke hulp het allemaal te bieden heeft. Als je C-h
hebt getikt maar van gedachten veranderd bent, tik je gewoon C-g om
het af te breken.
-(In sommige installaties wordt de betekenis van C-h veranderd. Dat is
-geen goed idee, zeker als die verandering op alle gebruikers invloed
-heeft, en is een geldige reden om je beklag te doen bij de
-systeembeheerder of de helpdesk. Als C-h intussen niet een bericht
-onderaan het scherm laat zien over mogelijke hulp, probeer dan de F1
-toets (functietoets 1) of gebruik M-x help <Return>.)
+(Als C-h niet een bericht onderaan het scherm laat zien over mogelijke
+hulp, probeer dan functietoets F1 of gebruik M-x help <Return>.)
De eenvoudigste hulp is C-h c. Tik C-h, het teken "c" en een teken of
uitgebreid commando, en Emacs laat een zeer korte beschrijving van het
@@ -1077,15 +1091,13 @@ De beschrijving die getoond wordt, zou zoiets moeten zijn als:
(Nederlands: C-p voert het commando previous-line uit.)
-Dit commando vertelt je "de naam van de functie". Functies worden
-vooral gebruikt om Emacs uit te breiden of aan de wensen van de
-gebruiker aan te passen. Aangezien functienamen gekozen zijn om aan
-te geven wat de functie doet, zijn ze ook geschikt als heel korte
-documentatie; genoeg om je te herinneren aan wat de commando's die je
-al geleerd hebt betekenen.
+Dit commando vertelt je "de naam van de functie". Aangezien
+functienamen gekozen zijn om aan te geven wat de functie doet, zijn ze
+ook geschikt als heel korte documentatie; genoeg om je te herinneren
+aan wat de commando's die je al geleerd hebt betekenen.
Uitgebreide commando's zoals C-x C-s en (als je geen META-, EDIT- of
-ALT-toets hebt) <ESC> v kunnen ook getikt worden na C-h c.
+ALT-toets hebt) <ESC>v kunnen ook getikt worden na C-h c.
Om meer informatie over een commando te krijgen, tik C-h k in plaats
van C-h c.
@@ -1095,15 +1107,15 @@ van C-h c.
Dit laat de documentatie van de functie, inclusief de naam van de
functie, in een apart venster zien. Als je klaar bent met lezen, tik
C-x 1 om van dat venster af te komen. Je hoeft dat natuurlijk niet
-meteen te doen. Je kan ook eerst wat anders doen voordat je C-x 1
-tikt.
+meteen te doen. Je kan ook eerst wat tekst bewerken (en de helptekst
+lezen) voordat je C-x 1 tikt.
Hier zijn nog wat nuttige mogelijkheden van C-h:
C-h f Beschrijf een functie. Je moet de naam van de functie
intikken.
->> Tik C-h f previous-line<Return>
+>> Tik C-h f previous-line <Return>
Dit laat alle informatie zien die Emacs heeft over de functie die
het C-p commando implementeert.
@@ -1118,24 +1130,24 @@ Het commando vraagt je om de naam van een variabele.
welke tekens dit commando direct uitgevoerd kan
worden.
->> Tik C-h a file<Return>.
+>> Tik C-h a file <Return>.
Dit laat in een ander venster alle M-x commando's zien met "file" in
hun naam. Je zal teken-commando's zien als C-x C-f naast de
overeenkomende commandonaam zoals find-file.
>> Tik C-M-v herhaaldelijk om de tekst in het hulpvenster te
- verschuiven.
+ scrollen.
>> Tik C-x 1 om het hulpvenster te verwijderen.
- C-h i Lees de online handleidingen (ook wel Info genoemd).
+ C-h i Lees de handleidingen (ook wel Info genoemd).
Dit commando zet je in een speciale buffer genaamd
- "*info*" waar je online handleidingen kunt lezen van
- software die op je computer is genstalleerd. Tik m
- Emacs <Return> om de handleiding van Emacs te lezen.
- Als je nog nooit Info hebt gebruikt dan kun je ?
- tikken zodat Emacs je een rondleiding geeft langs de
+ "*info*" waar je handleidingen kunt lezen van
+ software die op je computer is genstalleerd.
+ Tik m Emacs <Return> om de handleiding van Emacs te
+ lezen. Als je nog nooit Info hebt gebruikt dan kun je
+ ? tikken zodat Emacs je een rondleiding geeft langs de
mogelijkheden van het Info systeem. Wanneer je klaar
bent met deze Emacs-inleiding dan kun je de
Emacs-Info-handleiding gebruiken als je primaire bron
@@ -1146,30 +1158,31 @@ overeenkomende commandonaam zoals find-file.
--------------------
Je kunt meer over Emacs leren door haar handleiding te lezen. Deze is
-zowel als boek als in elektronische vorm via Info beschikbaar (gebruik
-het Help menu of tik <F10> h r). Kijk bijvoorbeeld eens naar
-"completion", hetgeen minder tikwerk oplevert, of "dired" wat het
-omgaan met bestanden vereenvoudigt.
+zowel als boek als in in Emacs beschikbaar (gebruik het Help menu of
+tik C-h r). Kijk bijvoorbeeld eens naar "completion", wat minder
+tikwerk oplevert, of "dired" wat het omgaan met bestanden
+vereenvoudigt.
+
+"Completion" ("afmaken" in het Nederlands) is een manier om onnodig
+tikwerk te voorkomen. Als je bijvoorbeeld naar de "*Messages*" buffer
+wilt omschakelen, dan kun je C-x b *M<Tab> tikken en dan zal Emacs de
+rest van de buffernaam invullen voor zover dit mogelijk is gegeven wat
+je al getikt had. Completion staat beschreven in de node "Completion"
+in de Emacs-Info-handleiding.
-"Completion" (of "afmaken", in het Nederlands) is een manier om
-onnodig tikwerk te voorkomen. Als je bijvoorbeeld naar de
-"*Messages*" buffer wilt omschakelen, dan kun je C-x b *M<Tab> tikken
-en dan zal Emacs de rest van de buffernaam invullen voor zover dit
-mogelijk is. Completion staat beschreven in de node "Completion" in
-de Emacs-Info-handleiding.
+"Dired" toont je een lijst van bestanden in een directory (en als je
+wilt ook subdirectories), waarmee je gemakkelijk bestanden kunt
+bezoeken, van naam kunt veranderen, kunt wissen, of andere acties op
+uit kunt voeren. Informatie over Dired kun je vinden in de node
+"Dired" van de Emacs-Info-handleiding.
-"Dired" toont je een lijst van bestanden in een directory, waarmee je
-gemakkelijk bestanden kunt bezoeken, van naam kunt veranderen, kunt
-wissen, of andere acties op uit kunt voeren. Informatie over Dired
-kun je vinden in de node "Dired" van de Emacs-Info-handleiding.
+De handleiding beschrijft ook vele andere Emacs-features.
* CONCLUSIE
-----------
-Denk eraan dat je met C-x C-c Emacs permanent verlaat. Om tijdelijk
-een shell te krijgen en daarna weer in Emacs terug te komen, tik je
-C-z.
+Denk eraan dat je Emacs verlaat met C-x C-c.
De bedoeling van deze inleiding is dat ze begrijpelijk is voor alle
nieuwe Emacs-gebruikers. Als je dus iets onduidelijks bent
@@ -1183,60 +1196,68 @@ Doe je beklag!
(De Engelse versie van) deze inleiding is voorafgegaan door een lange
reeks van Emacs-inleidingen, die begon met de inleiding die Stuart
Cracraft schreef voor de originele Emacs. Deze Nederlandse vertaling
-is gemaakt door Pieter Schoenmakers <tiggr@ics.ele.tue.nl> op basis
-van de GNU Emacs 20.2 TUTORIAL, en nagezien en verbeterd door Frederik
-Fouvry en Lute Kamstra.
+is gemaakt door Pieter Schoenmakers <tiggr@tiggr.net> met
+verbeteringen en correcties door Frederik Fouvry en Lute Kamstra.
(Wat nu volgt is een vertaling naar het Nederlands van de condities
voor gebruik en verspreiding van deze inleiding. Deze vertaling is
niet gecontroleerd door een jurist. Er kunnen derhalve geen rechten
-aan de vertaling worden ontleend, en de vertaling wordt gevolgd door
-het Engelse origineel.)
+aan de vertaling worden ontleend. Na de vertaling volgt het Engelse
+origineel.)
+
+Deze versie van de inleiding is onderdeel van GNU Emacs. Het valt
+onder copyright. Je mag deze inleiding verspreiden onder bepaalde
+voorwaarden:
+
+ Copyright (C) 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
+
+ Dit bestand is onderdeel van GNU Emacs.
+
+ GNU Emacs is vrije software: iedereen mag het verspreiden en/of
+ modificeren onder de voorwaarden van de GNU General Public License
+ ("algemene publieke licentie") zoals die gepubliceerd wordt door de
+ Free Software Foundation, versie 3 of, zo je wilt, een latere
+ versie.
-Deze versie van de inleiding valt onder copyright, net als GNU Emacs.
-Je mag deze inleiding verspreiden onder bepaalde voorwaarden:
+ GNU Emacs wordt verspreid met de bedoeling dat het nuttig zal zijn,
+ maar ZONDER ENIGE GARANTIE; zonder zelfs de impliciete garantie van
+ verkoopbaarheid of geschiktheid voor een specifiek doel. De GNU
+ General Public License bevat meer informatie.
-Copyright (C) 1985, 1996-1997, 2001-2011 Free Software Foundation, Inc.
+ Je zou de GNU General Public License moeten hebben ontvangen als
+ onderdeel van GNU Emacs. Als dat niet het geval is, ga naar
+ www.gnu.org/licenses.
- Iedereen mag letterlijke kopien van dit document, zowel ontvangen
- als verspreiden, op elk medium, vooropgesteld dat de
- copyrightvermelding en de toestemmingsmelding niet veranderd worden
- en dat de verspreider aan de ontvanger dezelfde distributierechten
- verleent als aan hem verleend worden door deze melding.
+Lees het bestand COPYING en geef daarna kopien van Emacs aan al je
+vrienden. Help bij het uitroeien van softwarebeschermingspolitiek
+("eigendom") door vrije software te gebruiken, te schrijven en te
+delen!
- Toestemming wordt verleend om veranderde versies van dit document,
- of delen daarvan, te verspreiden, onder bovenstaande voorwaarden,
- vooropgesteld dat ze ook duidelijk vermelden wie als laatste
- veranderingen aangebracht heeft.
+Engels origineel van de copyrightmelding en condities:
-De condities voor het kopiren van Emacs zelf zijn ingewikkelder dan
-dit, maar gebaseerd op dezelfde gedachte. Lees het bestand COPYING en
-geef vervolgens kopien van Emacs aan al je vrienden. Help bij het
-uitroeien van softwarebeschermingspolitiek ("eigendom") door vrije
-software te gebruiken, te schrijven en te delen!
+This version of the tutorial is a part of GNU Emacs. It is copyrighted
+and comes with permission to distribute copies on certain conditions:
-(Engels origineel van de copyrightmelding en condities:
+ Copyright (C) 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
-This version of the tutorial, like GNU Emacs, is copyrighted, and
-comes with permission to distribute copies on certain conditions:
+ This file is part of GNU Emacs.
-Copyright (C) 1985, 1996-1997, 2001-2011 Free Software Foundation, Inc.
+ 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.
- Permission is granted to anyone to make or distribute verbatim
- copies of this document as received, in any medium, provided that
- the copyright notice and permission notice are preserved, and that
- the distributor grants the recipient permission for further
- redistribution as permitted by this notice.
+ 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.
- Permission is granted to distribute modified versions of this
- document, or of portions of it, under the above conditions,
- provided also that they carry prominent notices stating who last
- altered them.
+ You should have received a copy of the GNU General Public License
+ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-The conditions for copying Emacs itself are more complex, but in the
-same spirit. Please read the file COPYING and then do give copies of
-GNU Emacs to your friends. Help stamp out software obstructionism
-("ownership") by using, writing, and sharing free software!)
+Please read the file COPYING and then do give copies of GNU Emacs to
+your friends. Help stamp out software obstructionism ("ownership") by
+using, writing, and sharing free software!
;;; Local Variables:
;;; coding: latin-1
diff --git a/etc/tutorials/TUTORIAL.pl b/etc/tutorials/TUTORIAL.pl
index f6859612a49..1f35e16d60e 100644
--- a/etc/tutorials/TUTORIAL.pl
+++ b/etc/tutorials/TUTORIAL.pl
@@ -1209,7 +1209,7 @@ z pomoc Ryszarda Kubiaka i Janusza S. Bienia <jsbien@mail.uw.edu.pl>.
Ta wersja samouczka, podobnie jak GNU Emacs, jest chroniona prawem
autorskim, ale wolno j kopiowa pod nastpujcymi warunkami:
-Copyright (C) 1985, 1994, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1994, 2001-2012 Free Software Foundation, Inc.
Zezwala si na wykonywanie lub rozpowszechnianie
wiernych kopii tego dokumentu w otrzymanej formie, na dowolnym
diff --git a/etc/tutorials/TUTORIAL.pt_BR b/etc/tutorials/TUTORIAL.pt_BR
index 1328c22f7b3..f28f86b3105 100644
--- a/etc/tutorials/TUTORIAL.pt_BR
+++ b/etc/tutorials/TUTORIAL.pt_BR
@@ -46,7 +46,7 @@ META, EDIT ou ALT).
Os comandos a seguir so teis para visualizar telas inteiras
C-v Move para tela inteira posterior
- M-x Move para tela inteira anterior
+ M-v Move para tela inteira anterior
C-l Limpa a tela e re-mostr todo o texto, movendo o texto ao
redor do cursor para o centro da tela. (Isso
control-L, no control-1.)
@@ -1056,7 +1056,7 @@ Essa verso do tutorial foi originalmente traduzida por Marcelo Toledo
<marcelo@gnu.org> e como o GNU Emacs, tem um copyright, e vem
com uma permisso de distribuio de cpias nas seguintes condies:
-Copyright (C) 2004-2011 Free Software Foundation, Inc.
+Copyright (C) 2004-2012 Free Software Foundation, Inc.
Permisso garantida a qualquer um para fazer ou distribuir cpias
integrais deste documento como recebido, em qualquer meio, deixando
diff --git a/etc/tutorials/TUTORIAL.ro b/etc/tutorials/TUTORIAL.ro
index a3ce0b79d48..8c31c6c2b4d 100644
--- a/etc/tutorials/TUTORIAL.ro
+++ b/etc/tutorials/TUTORIAL.ro
@@ -1082,7 +1082,7 @@ continuare noita de copyright original n limba englez.
This version of the tutorial, like GNU Emacs, is copyrighted, and
comes with permission to distribute copies on certain conditions:
-Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim copies
of this document as received, in any medium, provided that the
diff --git a/etc/tutorials/TUTORIAL.ru b/etc/tutorials/TUTORIAL.ru
index f8127a2d82e..13c79b99f1f 100644
--- a/etc/tutorials/TUTORIAL.ru
+++ b/etc/tutorials/TUTORIAL.ru
@@ -1,1134 +1,1111 @@
- Emacs. .
-
- Emacs' (key --
- / ), CONTROL (
- CTRL CTL) META ( ALT
-EDIT). , , META CONTROL,
- :
-
- C-<chr> -- CONTROL,
- <chr>. , C-f : CONTROL f.
- M-<chr> -- META,
- <chr>. META, ALT EDIT, <ESC>,
- , <chr>.
-
- : Emacs, C-x C-c (
-). ">>" , ,
- . :
+Учебник Emacs. Условия распространения приведены в конце файла.
+
+Для управления Emacs обычно используются сочетания клавиш (key -- сочетание
+клавиш клавиатуры и/или кнопок мыши), включающие в себя клавишу CONTROL
+(иногда отмечаемая как CTRL или CTL) или клавишу META (иногда помеченную как
+ALT или EDIT). Вместо того, чтобы каждый раз писать META или CONTROL, мы
+будем использовать следующие сокращения:
+
+ C-<chr> -- следует удерживать клавишу CONTROL, пока набирается символ
+ <chr>. Так, C-f должно означать: одновременно нажать клавиши CONTROL и f.
+ M-<chr> -- следует удерживать клавишу META, пока набирается символ
+ <chr>. Если нет клавиши META, ALT или EDIT, то нажмите <ESC>,
+ отпустите ее, а потом наберите символ <chr>.
+
+Важное замечание: для завершения работы Emacs, наберите C-x C-c (два сочетания
+клавиш). Чтобы прервать частично набранную команду, нажмите C-g.
+Символы ">>" с левой стороны указывают, что вам нужно делать, чтобы
+попробовать применить команду. Например:
<<Blank lines inserted here by startup of help-with-tutorial>>
-[ . ]
->> C-v ( )
- . ( CONTROL
- v.) ,
- .
+[Середина страницы оставлена пустой в учебных целях. Текст продолжается ниже]
+>> Теперь нажмите C-v (просмотр следующего экрана) для перемещения к следующему
+ экрану. (Выполните эту команду удерживая клавишу CONTROL и нажимая v.) Теперь
+ вы должны это сделать еще раз, когда вы закончите читать текст на экране.
- ,
- -- ,
- .
+Обратите внимание на то, что при переходе с экрана на экран показываются две
+строки с предыдущего экрана -- это обеспечивает некоторую непрерывность
+восприятия, так что вы можете продолжать читать текст не теряя нити
+повествования.
-, -- ,
- . ,
-, C-v. ,
- M-v ( META v, <ESC>
- v, META, EDIT ALT).
+Первое, что вам необходимо знать -- это то, как передвигаться по тексту из
+одного места в другое. Вы уже знаете, как переместиться вперед на один экран
+используя сочетание клавиш C-v. Для перемещения назад на один экран, нажмите
+M-v (удерживайте клавишу META и наберите v, или нажмите <ESC> и затем v,
+если у вас нет клавиши META, EDIT или ALT).
->> M-v, C-v, .
+>> попробуйте набрать M-v, а затем C-v, несколько раз.
-*
+
+* КРАТКИЙ ПЕРЕЧЕНЬ КОМАНД
-------------------------
- :
+Следующие сочетания клавиш полезны при по-экранном просмотре текста:
- C-v
- M-v
- C-l ,
- , ,
- . ( CONTROL-L, CONTROL-1.)
+ C-v Перейти на один экран вперед
+ M-v Перейти на один экран назад
+ C-l Очистить экран и отобразить все заново,
+ разместив текст, находящийся возле курсора,
+ в центре экрана. (это CONTROL-L, а не CONTROL-1.)
->> . C-l.
- , .
+>> Найдите курсор и запомните текст возле него. Потом нажмите C-l.
+ Найдите курсор снова и убедитесь, что возле него все тот же текст.
- PageUp PageDn
- ( ),
-, C-v M-v.
+Вы также можете использовать клавиши PageUp и PageDn для перемещения между
+экранами (если они есть на вашем терминале), но вы сможете работать более
+эффективно, если будете использовать сочетания C-v и M-v.
-*
+* БАЗОВЫЕ КОМАНДЫ УПРАВЛЕНИЯ КУРСОРОМ
-------------------------------------
- ,
- ?
+Движение от экрана к экрану удобно, но как переместиться в определенную
+точку в тексте на экране?
- .
- (),
- C-p, C-b, C-f C-n.
- ,
- :
+Есть несколько способов сделать это. Вы можете использовать клавиши
+управления курсором (стрелки), но более эффективным будет сохранение рук в
+их стандартной позиции и использовать команды C-p, C-b, C-f и C-n. Эти
+команды эквивалентны четырем клавишам перемещения курсора, как это показано
+на схеме:
- , C-p
+ Предыдущая строка, C-p
:
:
- , C-b .... .... , C-f
+ Назад, C-b .... Текущая позиция курсора .... Вперед, C-f
:
:
- , C-n
-
->> ,
- C-n C-p. C-l
- .
+ Следующая строка, C-n
-
- -- B- (backward) F- (forward).
- , ,
- .
+>> Переместите курсор на строку с центром диаграммы, используя сочетания
+ клавиш C-n или C-p. Затем нажмите C-l и посмотрите как диаграмма
+ переместится в центр экрана.
->> C-n, .
+Вам будет несложно запомнить эти команды по первым буквам соответствующих
+слов: P -- предыдущий (previous), N -- следующий (next), B -- назад
+(backward) и F -- вперед (forward). Вы постоянно будете использовать эти
+основные команды позиционирования курсора.
->> , C-f,
- C-p. ,
- -, .
+>> Нажмите несколько раз C-n, чтобы опустить курсор вниз к этой строке.
- (Newline
-character), .
- ( Emacs
- ).
+>> Переместитесь по строке, используя C-f, и потом поднимитесь вверх с
+ помощью C-p. Посмотрите, как изменилось положение курсора при нажатии
+ С-р, если он находился в середине строки.
->> C-b .
- . ,
- .
+Каждая строка текста завершается символом перевода строки (Newline
+character), который отделяет ее от следующей строки. (Обычно, последняя
+строка файла завершается символом перевода строки, но Emacs не требует
+этого).
-C-f , C-b.
+>> Попробуйте использовать C-b в начале строки. Курсор должен переместиться
+ на конец предыдущей строки. Это происходит потому, что он движется назад
+ через символ перевода строки.
->> C-b , ,
- . C-f
- . C-f ,
- .
+C-f может перемещать курсор через символ перевода строки так же, как и C-b.
- , ,
- , . ""
-(scrolling). Emacs'
- .
+>> Попробуйте несколько раз применить C-b так, чтобы вы увидели, как
+ движется курсор. Далее используйте сочетание клавиш C-f чтобы вернуться
+ на конец строки. Нажмите C-f еще раз, чтобы перейти к началу следующей
+ строки.
->> , C-n,
- , .
+Когда вы перемещаетесь за верхний или нижний край экрана, текст, находящийся
+за экраном, сдвигается внутрь экрана. Это называется "прокрутка"
+(scrolling). Прокрутка позволяет Emacs перемещать курсор в нужное место
+текста без перемещения его за пределы экрана.
- ,
-. M-f (META-f) , M-b .
+>> Попробуйте переместить курсор за нижнюю границу экрана, используя C-n, и
+ посмотрите, что произойдет.
->> M-f M-b.
+Если посимвольное перемещение слишком медленно, вы можете двигаться по
+словам. M-f (META-f) перемещает вперед на слово, а M-b назад на слово.
- , M-f .
- , M-f
-. M-b , .
+>> Нажмите несколько раз M-f и M-b.
->> M-f M-b , C-f C-b, --
- M-f M-b
- .
+Если курсор находится в середине слова, M-f переместит его в конец слова.
+Если курсор находится между словами, M-f переместит его в конец следующего
+слова. M-b работает точно так же, но в противоположном направлении.
- C-f C-b , M-f M-b
-. Meta-
- , (, , ),
-Control- , ,
- (, , ..).
+>> Нажмите M-f и M-b несколько раз, перемежая их с C-f и C-b, -- так вы
+ сможете увидеть как действуют M-f и M-b из разных позиций в словах и
+ между ними.
- : C-a C-e
- , M-a M-e
- .
+Отметьте параллель между C-f и C-b с одной стороны, и M-f и M-b с другой.
+Очень часто Meta-сочетания используются для соответствующих операций над
+единицами, определенными в языке (слова, предложения, абзацы), тогда как
+Control-сочетания работают с базовыми единицами, независимо от того, что вы
+редактируете (символы, строки, и т.д.).
->> C-a, C-e.
- M-a, M-e.
+Эта параллель также применима к строкам и предложениям: C-a и C-e перемещает
+курсор в начало и конец строки, а M-a и M-e перемещает курсор в начало и
+конец предложения.
-, C-a , M-a
- . ,
- .
+>> Попробуйте пару раз нажать C-a, а потом пару раз C-e. Попробуйте пару раз
+ нажать M-a, после этого пару раз нажать M-e.
- " ". :
-
-.
+Посмотрите, что повтор C-a ничего не изменяет, а повтор M-a продолжает
+движение курсора к следующему предложению. Это не совсем аналогично, но
+выглядит естественно.
- ,
- :
+Положение курсора в тексте также называют "точкой вставки" (point). Скажем
+иначе: курсор показывает место на экране в котором будет расположен вводимый
+текст.
- C-f
- C-b
+Вот список всех основных команд перемещения курсора, включая движение по
+словам и предложениям:
- M-f
- M-b
+ C-f На символ вперед
+ C-b На символ назад
- C-n
- C-p
+ M-f На слово вперед
+ M-b На слово назад
- C-a
- C-e
+ C-n На следующую строку
+ C-p На предыдущую строку
- M-a ,
- M-e ,
+ C-a В начало строки
+ C-e В конец строки
->> .
- .
+ M-a Назад, в начало предложения
+ M-e Вперед, в конец предложения
- M-< (META Less-then
-{-}), , M-> (META
-Greater-than {-}), .
+>> Попробуйте сейчас несколько раз использовать все эти команды.
+ Это наиболее часто используемые команды.
- "<" ,
- , Shift.
- Shift, M-< ( Shift
- M-).
+Две другие важные команды перемещения курсора: M-< (META Less-then
+{Меньше-Чем}), которая перемещает курсор в начало текста, и M-> (META
+Greater-than {Больше-Чем}), которая перемещает курсор в конец текста.
->> M-<, .
- C-v, .
+На большинстве терминалов знак "<" находится над знаком точки, и чтобы
+набрать его, вы должны использовать клавишу Shift. На этих терминалах вы так
+же должны использовать Shift, чтобы набрать M-< (без удержания клавиши Shift
+вы наберете M-точка).
->> M->, .
- M-v, .
+>> Сейчас попробуйте M-<, чтобы переместиться в начало учебника.
+ Потом используйте C-v, пока не вернетесь назад.
- (),
- . C-b, C-f, C-n C-p
-. -, . -,
- Emacs, ,
-CTRL- , (
- ). -,
- CTRL-,
- , .
+>> Сейчас попробуйте M->, чтобы переместиться к концу учебника.
+ Используйте M-v, пока не вернетесь назад.
- Emacs ;
- , .
- , C-u, ,
-. META ( EDIT ALT),
- : ,
-META. C-u,
- .
-" ",
-.
+Курсор можно перемещать клавишами управления курсора (стрелками), если ваш
+терминал оборудован ими. Мы рекомендуем выучить C-b, C-f, C-n и C-p по трем
+причинам. Во-первых, они работают на любых терминалах. Во-вторых, однажды
+получив практику использования Emacs, вы поймете, что использовать
+Control-сочетания удобнее и быстрее, чем клавиши со стрелочками (потому что
+вы не убираете руки с обычного их положения при печати). В-третьих, как
+только вы привыкнете использовать Control-сочетания, вы сможете так же легко
+выучить и использовать другие, более сложные команды перемещения курсора.
-, C-u 8 C-f .
+Большинство команд Emacs допускают задание цифрового аргумента; для
+большинства команд, это служит счетчиком повторений. Чтобы задать счетчик
+повторений для команды, нажмите C-u, потом число повторений, и затем укажите
+команду. Если у вас есть клавиша META (или EDIT или ALT), то цифровой
+аргумент можно задать другим способом: наберите цифры, удерживая клавишу
+META. Мы рекомендуем привыкнуть к использованию C-u, поскольку это сочетание
+клавиш работает на любом терминале. Числовой аргумент также называется
+"префиксным аргументом", поскольку вы задаете аргумент до выполнения
+команды.
->> C-n C-p ,
- .
+Например, C-u 8 C-f переместит курсор на восемь символов вперед.
- ,
- . (
- ) --
- ,
- .
+>> Попробуйте использовать C-n или C-p с цифровым аргументом, чтобы
+ переместить курсор на эту строку с помощью одной команды.
- C-v M-v.
-, ,
- . , C-u 8 C-v 8
-.
+Многие команды используют числовой аргумент как счетчик повторений, но
+некоторые команды используют его другим способом. Некоторые команды (но мы
+еще не изучили ни одну из них) используют его как флаг -- наличие
+префиксного аргумента вне зависимости от его значения, изменяет поведение
+команды.
->> C-u 8 C-v.
+Другим видом исключений являются сочетания клавиш C-v и M-v. При получении
+числового аргумента, они прокручивают экран вверх или вниз на указанное
+число строк, вместо указанного числа экранов. Например, C-u 8 C-v прокрутит
+экран на 8 строк.
- 8 .
- , M-v.
+>> Сейчас попробуйте набрать комбинацию C-u 8 C-v.
- , X11 MS-Windows,
- , ,
- Emacs. ,
- .
+Эта команда должна прокрутить экран на 8 строк вверх. Если вы хотите
+прокрутить его вниз, можете задать аргумент для M-v.
->> . ,
- .
+Если вы используете оконную систему, такую как X11 или MS-Windows, то должна
+быть видна прямоугольная область, именуемая полосой прокрутки, расположенная
+с одной из сторон окна Emacs. Вы можете прокручивать текст, щелкая кнопкой
+мыши на полосе прокрутки.
+Если ваша мышь имеет колесо прокрутки, вы можете использовать его.
-* X-
-------------------------------------
-
- X-, , , ,
-
-(). , ,
- -- C-b, C-f, C-p
-C-n, .
- C-left C-right , C-up C-down
- (.. , ).
- HOME ( BEGIN) / END,
- , C-home C-end
- . PgUp PgDn,
- ,
- M-v C-v.
-
- , ,
- .
-: CONTROL META . ,
- 12 , C-1 C-2 C-right. ,
- , CONTROL
-.
-
-
-* EMACS
+* ЕСЛИ EMACS ЗАВИС
------------------
- Emacs , ,
- C-g. C-g,
-, .
+Если Emacs перестал реагировать на ваши команды, то вы можете вывести его из
+этого состояния нажав C-g. Вы можете использовать C-g, чтобы остановить
+выполнение команд, которые слишком долго выполняются.
- C-g
- , , .
+Вы также можете использовать C-g для отмены набранного цифрового аргумента
+или команды, которая начала выполняться, но которую вы не хотите завершить.
->> C-u 100 100, C-g.
- C-f. ,
- C-g.
+>> Наберите C-u 100 для задания аргумента 100, потом нажмите C-g. Теперь
+ нажмите C-f. Курсор должен переместиться всего на один символ, потому что
+ вы отменили аргумент нажатием C-g.
- <ESC> , C-g
- .
+Если вы нажали <ESC> по ошибке, то вы так же можете использовать C-g чтобы
+избежать воздействия данной команды.
-* (DISABLED COMMANDS)
+* ЗАПРЕЩЕННЫЕ КОМАНДЫ (DISABLED COMMANDS)
-----------------------------------------
- Emacs "",
- .
+Некоторые команды Emacs "запрещены", так что начинающие пользователи не
+смогут случайно использовать их.
- , Emacs ,
- , , ,
- .
+Если вы набрали одну из запрещенных команд, то Emacs покажет сообщение,
+говорящее о том, какая команда вызывается, и запросит у вас, хотите ли вы
+продолжать работу и выполнить данную команду.
- ,
-<SPC> () . ,
- , "n".
+Если вы действительно попробовать выполнить эту команду, то нажмите клавишу
+<SPC> (пробел) в ответ на заданный вопрос. Обычно, если вы не хотите
+выполнять запрещенную команду, то ответьте на вопрос нажатием клавиши "n".
->> `C-x C-l' ( ), "n"
- .
+>> Нажмите `C-x C-l' ("запрещенная" команда), а потом ответьте "n" на
+ заданный вопрос.
-*
+* ОКНА (WINDOWS)
------
-Emacs ,
- . .
-
- . :
+Emacs может отображать информацию в нескольких "окнах", каждое из которых
+отображает свой текст. Позже мы объясним как работать с несколькими окнами.
+А сейчас мы хотим объяснить вам как избавляться от лишних окон и вернуться к
+редактированию в одном окне. Это очень просто сделать:
- C-x 1 . ( ).
+ C-x 1 Одно окно. (закрыть все другие окна).
- CONTROL-x 1. C-x 1 ,
-, , .
- .
+Это CONTROL-x со следующей цифрой 1. C-x 1 развернет окно, которое содержит
+курсор, так, чтобы оно заняло весь экран. При этом будут удалены все
+остальные окна.
->> C-u 0 C-l.
+>> Переместите курсор на эту строку и нажмите C-u 0 C-l.
->> CONTROL-h k CONTROL-f.
- , ,
- CONTROL-f.
+>> Наберите C-h k C-f.
+ Посмотрите, как текущее окно сожмется, когда появится новое окно и
+ отобразит документацию для сочетания клавиш C-f.
->> C-x 1 , .
+>> Наберите C-x 1 и посмотрите, как окно с документацией исчезнет.
- , , ,
- . CONTROL-x.
- , CONTROL-x;
-, , .
-, .
+Эта команда отличается от других изученных команд, что она состоит из двух
+сочетаний клавиш. Она начинается с сочетания CONTROL-x. Есть целый набор
+команд, которые начинаются с CONTROL-x -- многие из них работают с окнами,
+буферами, файлами и т.п. вещами. Эти команды состоят из двух, трех или
+четырех сочетаний клавиш.
-*
+* ВСТАВКА И УДАЛЕНИЕ
--------------------
- , . ,
- , A, 7, *, . Emacs'
- . <Return> ( ),
- .
-
- , <Delback>. <Delback> --
- , Emacs
- . ,
- <Return>; "Delete", "Del"
- "Backspace".
-
- "Backspace", ,
- , <Delback>.
- , "Delete", ,
- <Delback>.
-
- , <Delback>
- .
-
->> -- ,
- <Delback>. --
- ; .
-
- ,
-"" . " " ("\") (
- ,
- ) ,
- .
-
->> , ,
- . , .
-
->> <Delback> ,
- . .
-
- , .
-
-. ,
-, ,
- .
-
->> <Delback>.
- .
-
->> <Return> ,
- .
-
-, Emacs ;
- . ,
- .
-
->> -- C-u 8 * ********.
-
- Emacs .
- .
-:
-
- <Delback>
- C-d ()
-
- M-<Delback> ,
- M-d ,
-
- C-k
- M-k
-
-, <Delback> C-d, M-<Delback> M-d
-, C-f M-f (, <Delback> --
-, ). C-k M-k, C-e M-e,
- .
-
- .
- C-@ C-<SPC> (
-). <SPC> .
- C-w.
- .
-
->> .
->> C-<SPC>. Emacs
- "Mark set".
->> "",
- .
->> C-w. ,
- .
-
- " (killing)" " (deleting)" ,
- "" , ""
- . ""
-" (yanking)". , ,
- , ( ,
- ), ,
-, ,
- ( ).
-
->> . C-k,
- .
-
->> C-k . ,
- , .
-
-, C-k ,
- C-k . C-k
- --
- __ . . C-u 2
-C-k , ;
- C-k .
-
- " (yanking)". (
- ,
-).
- .
-
-.
-
- C-y.
- .
-
->> -- C-y,
- .
-
-, C-k ,
- , C-y
-.
-
->> -- C-k .
-
- :
-
->> C-y. ,
- C-y. , .
-
- , , ,
- - ? C-y
-. --
-, M-y.
- , M-y ,
- . M-y ,
- . ,
- , . ,
- , .
-
- M-y ,
-( ).
-
->> , .
- C-y ,
- M-y, . M-y
- , .
- ,
- . ,
- M-y.
-
-
-* (UNDO)
+Если вы хотите вставить текст, то просто набирайте его. Обычные символы,
+такие как A, 7, *, и пр. вставляются сразу как вы нажимаете на них. Чтобы
+вставить символ новой строки нажмите <Return> (клавиша перевода каретки,
+часто помечена как "Enter").
+
+Чтобы удалить символ перед курсором, нажмите клавишу <DEL>. Обычно это
+клавиша помеченная как "Backspace" -- та самая клавиша, которую вы обычно
+используете вне Emacs для удаления последнего набранного символа.
+
+На клавиатуре может присутствовать и другая клавиша, помеченная как
+"Delete", но она имеет другую функцию, отличную от <DEL>.
+
+>> Попробуйте сделать это -- наберите несколько символов, а затем удалите их
+ нажимая <DEL>. Не волнуйтесь что этот файл изменяется -- вы не изменяете
+ учебник. Это ваша личная копия учебника.
+
+Когда строка текста становится слишком большой для строки экрана, то она
+"продолжается" на следующей строке. Если вы используете графический
+дисплей, то небольшие изогнутые стрелки появятся на обоих сторонах экрана
+("fringes") чтобы показать, что строка продолжается с предыдущей
+строки. Если вы используете текстовый терминал, то "продолжаемая" строка
+обозначается символом "обратный слэш" ("\") в правой части экрана.
+
+>> Вводите текст, пока он не достигнет правой границы, и продолжайте вставку
+ символов. Вы увидите что появится "продолжаемая" строка.
+
+>> Используйте <DEL> для удаления текста до тех пор, пока строка снова не
+ поместится в экран. Символ продолжения строки исчезнет с экрана.
+
+Символ новой строки можно удалять точно так же, как и любой другой символ.
+Удаление символа новой строки между двумя строками приведет к их склейке в
+одну. Если полученная строка будет слишком длинной, чтобы вместиться в
+экран, то она будет отображена как строка "с продолжением".
+
+>> Переместите курсор в начало строки и нажмите <DEL>. Это соединит
+ текущую строку с предыдущей.
+
+>> Нажмите <Return> для вставки символа новой строки, вместо удаленного
+ вами.
+
+Помните, что многие команды Emacs могут получать счетчик повторения --
+обычные символы не являются исключением. Вы можете вставлять по несколько
+символов, используя счетчики повторений.
+
+>> Попробуйте -- наберите C-u 8 * для вставки ********.
+
+Вы уже научились основам набора текста в Emacs и исправления ошибок. Вы
+также можете удалять слова и строки. Вот основные операции удаления:
+
+ <DEL> удалить символ перед курсором
+ C-d удалить символ следующий за (над) курсором
+
+ M-<DEL> "убить" слово, стоящее перед курсором
+ M-d "убить" слово, стоящее за курсором
+
+ C-k "убить" все от курсора до конца строки
+ M-k "убить" все до конца предложения
+
+Заметьте, что <DEL> и C-d, вместе с M-<DEL> и M-d продолжает параллель,
+начатую C-f и M-f (да, <DEL> -- это не настоящий управляющий символ, но не
+нужно об этом волноваться). C-k и M-k, также как и C-e и M-e, продолжают
+параллель между строками и предложениями.
+
+Вы можете "убить" любую часть текста следующим методом. Переместитесь к
+одному из концов выбранной области и нажмите C-<SPC> (<SPC> -- клавиша
+пробела). Переместите курсор к другому концу текста, который вы собираетесь
+"убить". По мере того, как вы будете это делать, Emacs будет подсвечивать
+текст между курсором и точкой, где вы нажали C-<SPC>. Затем нажмите C-w. Эта
+операция убьет весь текст между двумя указанными позициями.
+
+>> Переместите курсор к букве В в начале предыдущего параграфа.
+>> Наберите C-<SPC>. Emacs должен отобразить в нижней части экрана сообщение
+ "Mark set" (метка установлена).
+>> Переместите курсор к букве о в слове "концов", на второй строке параграфа.
+>> Нажмите C-w. Это удалит текст начиная с буквы В, и оканчивающийся перед
+ буквой о.
+
+Отличие между "убить" (killing) и "удалить" (deleting) заключается в том,
+что "убитый" текст может быть заново вставлен (в любой точке), в то время
+как "удаленные" части не могут быть вставлены (вы однако можете отменить
+удаление -- см. ниже). Вставка "убитого" текста называется "восстановление"
+(yanking). В общем, команды, которые могут удалять большие части текста,
+убивают этот текст (они настраиваются так, что вы можете восстановить
+текст), в то время как команды, которые убирают только один символ, или
+убирают только пустые строки и пробельные символы, выполняют операцию
+удаления (так что вы не можете восстановить текст). В простейшем случае,
+без дополнительного аргумента, команды <DEL> и C-d выполняют удаление.
+Однако, если им передан аргумент, то они "убивают" текст.
+
+>> Переместите курсор на начало не пустой строки. Теперь нажмите C-k, чтобы
+ убить текст в этой строке.
+
+>> Нажмите C-k еще раз. Вы видите, что это действие убьет символ новой
+ строки, который следует за этой строкой.
+
+Заметьте, что первое выполнение C-k убивает содержимое строки, а второй
+вызов C-k убивает саму строку и поднимает вверх другие строки. C-k
+обрабатывает числовой аргумент специальным образом -- убивает заданное
+количество строк _И_ их содержимое. Это не просто повторение команды. C-u 2
+C-k удалит две строки, а также завершающие их символы новой строки;
+выполнение C-k два раза подряд этого не сделает.
+
+Возврат убитого ранее текста называется "восстановление" (yanking). (Думайте
+об этом, как о восстановлении или помещении назад некоторого взятого
+текста). Вы можете восстановить убитый текст в месте удаления или в любой
+другой точке редактируемого текста или даже в другом файле. Вы можете
+восстановить текст несколько раз и получить несколько копий данного текста.
+Некоторые редакторы называют операции "убить" и "восстановить" иначе:
+"вырезать" (cutting) и "вставить" (pasting) (ознакомьтесь с глоссарием
+(Glossary) в руководстве по Emacs).
+
+Для восстановления убитого текста используется сочетание клавиш C-y. Данная
+команда восстанавливает последний убитый текст в точке расположения курсора.
+
+>> Попробуйте -- наберите C-y, чтобы вставить текст назад.
+
+Помните, что если вы использовали несколько команд C-k подряд, то все убитые
+строки будут сохранены вместе, так что C-y также восстановит их вместе.
+
+>> Попробуйте -- нажмите C-k несколько раз.
+
+Теперь вернем убитый текст:
+
+>> Нажмите C-y. Теперь переместите курсор на несколько строк вниз, и снова
+ нажмите C-y. Вы увидите копию некоторого текста.
+
+Что делать, если есть некоторый текст, который вы хотите вернуть назад, а
+потом убить что-то еще? Одно нажатие C-y вернет только последний удаленный
+текст. Но предыдущий текст не потерян -- вы можете его вернуть назад,
+используя команду M-y. После того как вы вернули последний удаленный текст с
+помощью C-y, нажмите M-y для замены этого восстановленного текста тем,
+который был убит ранее. Выполняя M-y снова и снова, вы будете возвращать
+ранее убитые части текста. Когда вы достигнете нужного текста, то вам не
+нужно ничего делать, чтобы сохранить его. Просто продолжайте работать,
+оставив восстановленный текст там, где он есть.
+
+Нажимая M-y достаточное число раз, вы можете вернуться в начальную точку
+(наиболее раннее удаление).
+
+>> Убейте строку, переместите курсор и убейте еще одну строку. Затем
+ используйте C-y для восстановления второй убитой строки. Затем нажмите
+ M-y, и она будет заменена первой убитой строкой. Нажмите M-y еще
+ несколько раз, чтобы увидеть что вы получаете. Продолжайте выполнять эту
+ команду до тех пор, пока вторая убитая строка не будет восстановлена
+ снова. Если вам хочется, то вы можете задавать положительные и
+ отрицательные аргументы для команды M-y.
+
+
+* ОТМЕНА (UNDO)
---------------
- , , ,
- "",
- C-x u.
+Если вы сделали изменения в тексте, и решили, что это была ошибка, то вы
+можете отменить изменения с помощью команды "отмена" (undo), которая
+привязана к сочетанию клавиш С-/.
-, C-x u , ;
-C-x u , .
+Обычно, C-/ отменяет изменения, сделанные одной командой; если повторить
+C-/ несколько раз подряд, то каждый раз будет отменяться еще одна команда.
- -- , (
- ),
- 20 . (
- C-x u, ).
+Но есть два исключения: не учитываются команды не изменяющие текст (сюда
+включаются команды перемещения курсора и прокрутки текста), а команды
+вставки символов собираются в группы до 20 символов. (Это уменьшает число
+нажатий C-/, которые вам нужно будет набрать для отмены ввода текста).
->> C-k, C-x u,
- .
+>> Убейте эту строку с помощью C-k, а затем наберите C-/, и строка должна
+ вернуться назад.
-C-_ -- ; , C-x u,
- ,
-. C-_
- . C-x u.
- C-_, / CONTROL.
+C-_ -- это еще команда отмены; она работает точно так же, как и C-/. На
+некоторых текстовых терминалах, набор C-/ в действительности приводит к
+отправке C-_. Кроме того, вы можете использовать C-x u для выполнения этой
+же операции, но эту команду менее удобно набирать
- C-_ C-x u .
+Числовой аргумент для C-/, C-_ или C-x u используется как счетчик повторений.
- , .
- - ,
- C-y;
- .
+Вы можете отменить удаление текста точно так же, как и отмену "убития"
+текста. Отличие между убийством и удалением чего-либо заключается в том,
+что вы можете восстановить убитый текст с помощью команды C-y; но для
+команды отмены нет никакой разницы между этими операциями.
-*
+* ФАЙЛЫ
-------
- ,
- . , Emacs.
- , "" ( "" ).
-
- Emacs.
- , .
-, Emacs, ,
- .
-, . ,
-Emacs , ,
- , .
-
- , ,
- , "--:-- TUTORIAL.ru".
- . ,
- "TUTORIAL.ru",
- Emacs. , , Emacs
- .
-
- , -- ,
- , .
- , " " (
- ).
-
- C-x C-f ()
-
-Emacs .
-. - --
- .
- Emacs.
-
- ( -),
- C-g.
-
->> C-x C-f, C-g.
- -, C-x C-f, -
- . , .
-
- , <Return>.
- C-x C-f, . - ,
- C-x C-f .
-
- ,
-. , ,
- ,
-
- C-x C-s
-
- Emacs . ,
-, Emacs ,
- .
- "~" .
-
- , Emacs .
- ,
-, .
-
->> C-x C-s, .
- "Wrote ...TUTORIAL.ru".
-
- .
- , .
- Emacs: (Emacs
- ) .
- , Emacs
- . , ,
-.
-
-
-*
---------
-
- , C-x C-f,
- Emacs'. ,
- C-x C-f.
- Emacs.
-
->> "foo", C-x C-f foo <Return>.
- - , , "foo",
- C-x C-s.
- , C-x C-f TUTORIAL.ru <Return> ,
- .
-
-Emacs , "" ("buffer").
- Emacs.
-, Emacs,
-
- C-x C-b
-
->> C-x C-b .
-
- ,
-, . ,
- Emacs', - .
-
->> C-x 1, .
-
- , ""
- . , .
- , "" .
- , ,
- C-x C-f. --
- C-x b.
- .
-
->> C-x b foo <Return> "foo",
- "foo". C-x b TUTORIAL.ru <Return>
- .
-
- ( ).
- . ,
-C-x C-b, .
-
- , Emacs,
-- . . ,
- "*Buffer List*" .
- C-x C-b .
-"*Messages*" ; ,
- Emacs
- .
+Для того, чтобы сохранить отредактированный текст вы должны поместить его в
+файл. Иначе он исчезнет, когда вы закончите работу Emacs. Чтобы поместить
+ваш текст в файл, вы должны "найти (открыть)" (find) файл до ввода
+текста. (Эту операцию также называют "посетить" (visiting) файл).
+
+Открыть файл означает что вы видите его содержимое в Emacs. Это практически
+также как редактирование самого файла. Однако, ваши изменения, сделанные с
+помощью Emacs, не будут сохранены, пока вы не сохраните файл. Так что вы
+можете не оставлять частично измененный файл в системе, если вы не хотите
+его сохранять. Даже когда вы сохраняете файл, то Emacs оставляет
+оригинальный файл, но с другим именем, на случай, если вы решите что ваши
+изменения были ошибкой.
+
+Если вы посмотрите в нижнюю часть экрана, то вы увидите строку, которая
+начинается с тире, и начало которой выглядит примерно так " -:--- TUTORIAL.ru".
+Эта часть экрана всегда показывает имя открытого вами файла. Итак, сейчас у
+вас открыт файл с именем "TUTORIAL.ru", который является вашей персональной
+копией учебника Emacs. Когда вы открываете файл в Emacs, имя этого файла
+появится в этой строке.
+
+Одной из вещей, которые вам нужно знать о команде открытия файла -- это то,
+что вы должны ввести имя файла, который нужно открыть. Такие команды мы
+называем командами, "читающими аргумент" (в нашем случае аргументом является
+имя файла). После ввода команды
+
+ C-x C-f Открыть (найти) файл
+
+Emacs попросит вас ввести имя файла. Имя файла набирается в нижней строке
+экрана. Нижняя строка называется мини-буфером когда она используется для
+ввода данных. Вы можете использовать обычные команды редактирования Emacs
+для ввода имени файла.
+
+Когда вы вводите имя файла (или любую другую информацию в мини-буфере), вы
+можете отменить текущую команду нажав C-g.
+
+>> Нажмите C-x C-f, а затем нажмите C-g. Это действие отменит ввод данных в
+ мини-буфере, и заодно и команду C-x C-f, которая использовала мини-буфер
+ для ввода аргумента. В итоге, вы не открыли никакого файла.
+
+Когда вы завершите ввод имени файла, нажмите <Return>. Мини-буфер исчезнет и
+команда C-x C-f выполнит работу по открытию указанного вами файла.
+
+А мгновением позже содержимое файла появится на экране, и вы сможете его
+редактировать. Когда вы захотите сохранить изменения, наберите команду
+
+ C-x C-s Сохранить файл
+
+Эта команда скопирует текст из Emacs в файл. В первый раз, когда вы это
+сделаете, Emacs переименует оригинальный файл в файл с новым именем, так что
+он не будет потерян. Имя файла с предыдущим содержимым получается
+добавлением символа "~" к оригинальному имени файла.
+
+Когда сохранение завершится, Emacs отобразит имя сохраненного файла. Вы
+должны сохранять изменения достаточно часто, чтобы не потерять внесенные
+изменения, если система вдруг "рухнет" (см. раздел "Автоматическое
+сохранение" ниже).
+
+>> Наберите C-x C-s TUTORIAL.ru <Return>.
+ Эта команда должна сохранить вашу копию учебника в файле TUTORIAL.ru. В
+ нижней строке экрана должна появиться надпись "Wrote ...TUTORIAL.ru".
+
+Вы можете открыть существующий файл для просмотра или редактирования. Вы
+также можете открыть файл, который еще не существует. Таким образом вы
+можете создать файл с помощью Emacs: откройте несуществующий файл (Emacs
+покажет его пустым) и вводите в него текст. Когда вы выполните команду
+сохранения файла в первый раз, Emacs создаст настоящий файл с набранным
+вами текстом. Далее, как вы поняли, вы будете редактировать уже существующий
+файл.
+
+
+* БУФЕРА (BUFFERS)
+-----------------
+
+Если вы откроете еще один файл с помощью C-x C-f, то предыдущий файл
+остается внутри Emacs. Вы можете переключиться назад к предыдущему файлу,
+открыв его снова с помощью C-x C-f. Таким образом вы можете загрузить
+большое количество файлов в Emacs.
+
+Emacs хранит текст каждого файла в объекте, называемом "буфер" (buffer).
+Открытие файла создает новый буфер внутри Emacs. Чтобы увидеть список
+буферов, созданных в текущем сеансе Emacs, наберите
+
+ C-x C-b Отобразить список буферов
->> C-x b *Messages* <Return>
- . C-x b TUTORIAL.ru <Return>
- .
+>> Попробуйте выполнить C-x C-b.
- , ,
- . Emacs,
-, .
- . , ,
- .
- C-x C-f C-x C-s
- .
+Мы видим, что каждый буфер имеет имя и может иметь связанное с ним имя
+файла, содержимое которого хранится в данном буфере. ЛЮБОЙ текст, который вы
+видите в окне Emacs, всегда является частью какого-либо буфера.
- C-x s . (Save some buffers)
+>> Наберите C-x 1, чтобы избавиться от списка буферов.
-C-x s ,
- .
-: .
+Когда у вас есть несколько буферов, только один из них является "текущим" в
+конкретный момент времени. Это тот буфер, который вы редактируете. Если вы
+хотите редактировать другой буфер, то вы должны "переключиться" в него.
+Если вы хотите переключиться в буфер, связанный с файлом, то вы можете
+открыть этот файл снова с помощью C-x C-f. Но есть более простой способ --
+использовать команду C-x b. В качестве аргумента для данной команды вы
+должны указать имя буфера.
->> , C-x s.
- : TUTORIAL.ru.
- "y".
+>> Наберите C-x b foo <Return> для переключения в буфер "foo". Затем
+ наберите C-x b TUTORIAL.ru <Return> для возвращения в буфер с учебником.
+Чаще всего имя буфера совпадает с именем файла (только без имени каталога).
+Но иногда это не так. Список буферов, который вы создаете с помощью команды
+C-x C-b, показывает вам имя буфера и имя файла для каждого буфера.
-*
+Некоторые буфера не относятся к файлам. Например, буфер с именем "*Buffer
+List*", который создан с помощью C-x C-b и содержит список всех буферов, не
+связан ни с каким файлом. Буфер с данным учебником также сначала не был
+связан с файлом, но сейчас уже связан, поскольку в предыдущем разделе мы
+использовали C-x C-s для сохранения его в файле.
+
+Буфер с именем "*Messages*" также не связан ни с каким файлом; он содержит
+сообщения, которые отображаются в самой нижней строке окна Emacs в течение
+текущего сеанса работы с Emacs.
+
+>> Наберите C-x b *Messages* <Return> для просмотра содержимого буфера
+ сообщений. Затем наберите C-x b TUTORIAL.ru <Return> для возврата к
+ учебнику.
+
+Если вы изменили текст одного файла, а затем открываете другой, то текст в
+первом буфере остается не сохраненным. Изменения останутся внутри Emacs, в
+буфере, связанном с файлом. Создание или редактирование следующего буфера не
+влияет на первый буфер. Это очень удобно, но имейте в виду, что вам нужно
+иметь удобный способ сохранить буфер первого файла. Было бы неприятно каждый
+раз возвращаться назад используя C-x C-f и потом использовать C-x C-s для
+сохранения данных. Поэтому существует команда
+
+ C-x s Сохранить некоторые буфера. (Save some buffers)
+
+C-x s запрашивает у вас подтверждение о сохранении для каждого буфера,
+который содержит не сохраненные изменения. Для каждого такого буфера у вас
+запросят: сохранять или не сохранять изменения.
+
+>> Вставьте строку текста, потом наберите C-x s.
+ Должен появиться запрос: сохранять ли буфер с именем TUTORIAL.ru.
+ Ответьте на запрос утвердительно нажатием клавиши "y".
+
+
+* РАСШИРЕНИЕ НАБОРА КОМАНД
--------------------------
- Emacs , control-
-meta- . Emacs , X- (eXtend,
-). :
-
- C-x . .
- M-x .
- .
-
- , , ,
- . :
- C-x C-f -- , C-x C-s --
-. -- Emacs' -- C-x C-c.
-( , , C-x C-c
- Emacs'.)
-
- ,
- , Emacs'
-
- . ,
- ,
- "" Emacs.
-
-C-z -- ** Emacs.
- Emacs . Emacs ,
-C-z "" ("suspends") Emacs, ..
- (shell), Emacs.
- Emacs, `fg', `%emacs' `exit'.
-
- Emacs C-x C-c. ,
- .
-, Emacs,
- , ,
-Emacs. , ,
- Emacs, C-z, , .
-
- , C-x.
- :
-
- C-x C-f
- C-x C-s
- C-x s
- C-x C-b
- C-x b
- C-x C-c Emacs
- C-x 1 ,
- C-x u
-
- -- , ,
- .
- ,
- . M-x, Emacs ;
- "replace-string". "repl s<TAB>",
- Emacs . (<TAB> -- ,
- CapsLock Shift .)
- <Return>.
-
- (replace-string) -- ,
- , , .
- <Return>.
-
->> .
- M-x repl s<Return><Return><Return>.
-
- , : ---
- "" , , .
-
-
-*
+У Emacs очень много команд, и они все не могут быть назначены на control- и
+meta- сочетания. Emacs решает эту проблему, используя X-команду (eXtend,
+расширять). Есть два варианта:
+
+ C-x Расширение с помощью ввода префикса. За ним следует один символ.
+ M-x Расширение набора команд с помощью их именования. За ним
+ следует имя команды.
+
+Это полезные команды, но они используются менее часто, чем те команды,
+которые мы уже изучили. Вы уже видели некоторые из этих команд. Например,
+команды работы с файлами: C-x C-f -- открыть файл, и C-x C-s -- сохранить
+файл. Другой пример -- команда завершения работы Emacs: C-x C-c. (Не
+волнуйтесь о том, что вы потеряете сделанные изменения, C-x C-c предлагает
+сохранить изменения перед выходом из Emacs).
+
+Если вы работаете на графическом дисплее, то вам не нужно выполнять
+специальных команд чтобы переключится от Emacs к другой программе. Вы можете
+сделать это используя мышь или соответствующее команды операционной системы.
+Но когда вы используете текстовый терминал, который способен показывать
+только одну программу в конкретный момент времени, то для переключения к
+другой программе вам понадобится "приостановить" (suspend) Emacs.
+
+C-z -- это команда *временного* выхода из Emacs. Вы можете позже вернуться в
+ту же сессию Emacs. Когда Emacs запускается на текстовом терминале, команда
+C-z "приостанавливает" (suspend) Emacs, т.е. она возвращает вас в командный
+процессор (shell), но не завершает Emacs. В большинстве командных
+процессоров вы можете вернуться в Emacs с помощью команды `fg' или `%emacs'.
+
+Чтобы покинуть Emacs используйте C-x C-c. Это сочетание также используется,
+чтобы выйти из Emacs, вызванного из почтовой программы или другой утилиты.
+
+Существует много команд с префиксом C-x. Вы уже изучили следующие команды:
+
+ C-x C-f Открыть файл
+ C-x C-s Сохранить файл
+ C-x s Сохранить некоторые буфера
+ C-x C-b Получить список буферов
+ C-x b Переключиться в буфер
+ C-x C-c Завершить Emacs
+ C-x 1 Удалить все окна, кроме текущего
+ C-x u Отмена изменений
+
+Именованные расширенные команды -- это команды, которые используются гораздо
+реже, или используются только в определенных режимах. В качестве примера
+можно привести команду replace-string, которая заменяет одну строку на
+другую во всем тексте. Когда вы наберете M-x, Emacs предложит вам ввести имя
+команды; в нашем случае это команда "replace-string". Наберите лишь
+"repl-s<TAB>", и Emacs дополнит имя. (<TAB> -- это клавиша табуляции, обычно
+находящаяся над клавишами CapsLock или Shift в левой части клавиатуры.)
+Подтвердите имя нажатием <Return>.
+
+Команда replace-string требует два аргумента -- строку, которая будет
+заменена, и строку, на которую нужно заменить. Вы должны завершать каждый
+аргумент вводом <Return>.
+
+>> Переместите курсор к пустой строке на две строчки ниже этой.
+ Наберите M-x repl-s<Return>файл<Return>файлы<Return>.
+
+ Заметьте, как эта строчка изменится: вы замените слово файл
+ словом "файлы" везде, где оно встретится, ниже позиции курсора.
+
+
+* АВТОМАТИЧЕСКОЕ СОХРАНЕНИЕ
---------------------------
- , ,
- . , Emacs
- , .
- ,
- "#" ; , "hello.c",
- "#hello.c#".
- , Emacs .
+Если вы измените файл, но не сохраните его, то в случае "падения" системы вы
+можете потерять информацию. Чтобы защитить вас от этого, Emacs периодически
+сохраняет каждый файл, который вы редактируете. Автоматически сохраняемый
+файл имеет имя с символами "#" в начале и в конце. Например, если ваш файл
+называется "hello.c", то автоматически сохраненный файл будет называться
+"#hello.c#". Когда вы сохраните файл обычным способом, Emacs удаляет
+автоматически сохраненный файл.
- , ,
- , (,
-, ), M-x recover-file<Return>.
- , yes<Return>,
- .
+Если система зависла, то вы можете восстановить ваши изменения, которые были
+сохранены автоматически, путем открытия нужного файла (файла, который вы
+редактировали, а не того, что бы сохранен автоматически) и затем набрав M-x
+recover-file<Return>. Когда у вас запросят подтверждение, наберите
+yes<Return>, чтобы восстановить автоматически сохраненные данные.
-* (ECHO AREA)
+* ОБЛАСТЬ ЭХА (ECHO AREA)
-------------------------
- Emacs , ,
- , " ".
- -- Emacs.
+Если Emacs видит, что вы медленно набираете команды из нескольких сочетаний
+клавиш, то он покажет их вам в нижней части экрана, в области называемой
+"область эха" (echo area). Область эха -- это самая нижняя строка окна
+Emacs.
-*
-------------------
+* СТРОКА СОСТОЯНИЯ (MODE LINE)
+-----------------------------
- " ".
- :
+Строка сразу над областью эха называется "строкой состояния" (mode
+line). Выглядит эта строка примерно так:
--:** TUTORIAL.ru 63% L749 (Fundamental)-----------------------
- Emacs ,
- .
+Эта строка сообщает полезную информацию о состоянии Emacs и текста, который
+вы редактируете.
- , -- , . NN%
- ; NN
- . ,
-"Top" "0%". , "Bot".
- , ,
-"All".
+Вы уже знаете, что означает имя файла -- это файл, который вы открыли. NN%
+показывает вашу текущую позицию в тексте. Это означает что NN процентов
+текста находятся выше начала окна. Если отображается начало текста, вы
+увидите "Top" вместо "0%". Если отображается конец текста, то будет
+отображено "Bot". Если текст настолько мал, что вмещается в один экран, то
+строка состояния сообщит "All".
- L --
- .
+Буква L и цифры показывают позицию другим способом -- они показывают номер
+строки в которой находится курсор.
- , .
- , .
+Звездочки в начале строки означают, что вы изменяли текст. Сразу после
+открытия или сохранения файла эта часть строки будет содержать не звездочки,
+а тире.
- ,
- . , , -- Fundamental,
- . " " ("major
+Часть строки состояния внутри скобок сообщает вам о режиме редактирования,
+который вы сейчас используете. Стандартный, или базовый, режим -- Fundamental,
+он используется и в данном учебнике. Это пример "основного режима" ("major
mode").
-Emacs .
- /
- , Lisp-, Text- .
- ,
- -- , "Fundamental" ().
-
-
--. , ,
-
--, -.
- , . ,
-M-x fundamental-mode -- , (Fundamental)
-.
-
- , , ,
- , Text.
-
->> M-x text mode<Return>.
-
- , Emacs .
- , M-f M-b
-. , (Fundamental mode), M-f M-b
- .
-
- , :
- "" ,
- - .
-
- , C-h m.
-
->> C-u C-v ,
- .
->> C-h m, Text- .
->> C-x 1, :)
-
- ,
-, , (minor) .
- ,
-. /
- .
- ,
- .
-
- ,
- -- (Auto Fill mode).
-, Emacs
-, .
-
- , M-x auto fill mode<Return>.
- , --
-M-x auto fill mode<Return>. ,
-, , . "
-".
-
->> M-x auto fill mode<Return>. " "
- , .
- ,
- .
-
- 70- ,
- C-x f.
- .
-
->> C-x f 20 (C-u 2 0 C-x f). -
- Emacs 20 .
- 70 , C-x f.
-
- ,
- . ,
- M-q (META-q), .
-
->> , M-q.
-
-
-*
+Emacs имеет много различных основных режимов. Некоторые из режимов
+используются для редактирования текста на различных языках и/или различных
+видов текста, такие как Lisp-режим, Text-режим и пр. В каждый момент
+времени действует только один основной режим, и его название вы можете найти
+в скобках -- там, где сейчас находится слово "Fundamental" (базовый).
+
+Каждый основной режим заставляет некоторые команды вести себя по разному.
+Например, имеются команды создания комментариев в программе, и поскольку в
+каждом языке программирования комментарии записываются по своему, то и
+каждый основной режим вставляет их по разному. Каждый основной режим имеет
+именованную команду, которая включает его. Например, M-x fundamental-mode --
+это команда, которая включает базовый (Fundamental) режим.
+
+Если вы редактируете текст на естественном языке, например, как этот файл,
+то вы, вероятно должны переключиться в режим Text.
+
+>> Наберите M-x text mode<Return>.
+
+Не волнуйтесь, ни одна из выученных вами команд Emacs не изменилась. Но вы
+можете заметить, что M-f и M-b теперь рассматривают апострофы как часть
+слова. Ранее, в базовом режиме (Fundamental mode), M-f и M-b воспринимали
+апострофы как разделители слов.
+
+Как правило, основные режимы производят незначительные изменения:
+большинство команд "работает одинаково" в каждом из режимов, но их действие
+отличается какой-нибудь мелочью.
+
+Для просмотра документации о текущем основном режиме, нажмите C-h m.
+
+>> Используйте C-l C-l чтобы расположить эту строку вверху экрана.
+>> Наберите C-h m, чтобы посмотреть отличия Text-режима от базового.
+>> Наберите C-x 1, чтобы убрать документацию с глаз долой :)
+
+Основной режим называется основным потому, что также существуют
+дополнительные (minor) режимы. Дополнительные режимы не являются
+альтернативами основным, они только немного изменяют их поведение. Каждый
+дополнительный режим включается/выключается независимо от других
+дополнительных режимов и независимо от вашего основного режима. Вы можете
+использовать основной режим без дополнительных, или с любой комбинацией
+нескольких дополнительных режимов.
+
+Один из дополнительных режимов очень полезен, особенно для редактирования
+текста -- это режим автозаполнения (Auto Fill mode). Когда этот режим
+включен, то Emacs автоматически разрывает строку между словами в тех
+случаях, когда вставленный текст делает строку слишком длинной.
+
+Вы можете включить режим автозаполнения, набрав M-x auto-fill-mode<Return>.
+Когда этот режим включен, его можно выключить с помощью той же команды --
+M-x auto-fill-mode<Return>. Если режим включен, то такая команда его
+выключит, если выключен, то включит. Мы говорим что команда "переключает
+режим".
+
+>> Наберите M-x auto-fill-mode<Return>. Затем вводите строку из слов "фыва "
+ пока не увидите, как она разделится на две строки. Эти пробелы между
+ словами необходимы, потому что режим автозаполнения разбивает строки
+ только по пробелам.
+
+Граница разбиения обычно равна 70-ти символам, но вы можете изменить ее
+используя команду C-x f. Вы должны задать границу в виде числового
+аргумента для этой команды.
+
+>> Введите C-x f с аргументом 20 (C-u 2 0 C-x f).
+ Затем введите какой-нибудь текст и посмотрите как Emacs заполняет строки
+ по 20 символов в каждой. Верните значение границы равное 70 назад,
+ используя команду C-x f.
+
+Если вы сделали изменения в середине параграфа, то автозаполнение не
+переформатирует текст автоматически.
+Чтобы переформатировать параграф, наберите M-q (META-q), когда курсор
+находится внутри параграфа.
+
+>> Переместите курсор в предыдущий параграф, и нажмите M-q.
+
+
+* ПОИСК
-------
-Emacs ( )
- . -- ;
- , .
-
- Emacs
- , . ,
- , .
-
-, -- C-s, C-r . !
- .
-
- C-s, "I-search", .
- , Emacs , .
-<Return> .
-
->> C-s . , ,
- '', ,
- .
- "".
->> C-s , "".
->> <Delback> .
->> <Return> .
-
- , ? Emacs
- , , .
- '', C-s
-. , Emacs
-, ("failing"), C-g
-.
-
-: C-x C-s ,
- Emacs'. ,
- "", "flow control",
- C-s Emacs'.
- C-q. "Spontaneous
-Entry to Incremental Search" Emacs, ,
- "".
-
- <Delback>, ,
- ,
- . , , "",
- "". ,
-"", "". <Delback>
- "" , "".
-
- control- meta- (
-, , , C-s C-r,
-), .
-
-C-s
- . - ,
-C-r. , C-s, C-r, C-r
- .
-
-
-* (MULTIPLE WINDOWS)
+Emacs умеет искать строки (строка -- непрерывная группа символов) вперед или
+назад по тексту. Поиск строки -- это команда перемещения курсора -- она
+перемещает курсор в следующую точку, где найдена искомая строка.
+
+Команда поиска в Emacs является инкрементальной. Это означает, что поиск
+происходит по мере того, как вы набираете искомую строку.
+
+Команда, начинающая поиск вперед -- C-s, а C-r ищет назад. ПОДОЖДИТЕ! Не
+нужно пробовать прямо сейчас.
+
+Когда вы нажмете C-s, вы увидите строку "I-search", появившуюся в области
+эха. Вам сообщается, что Emacs ждет ввода строки, которую вы хотите найти.
+<Return> завершает поиск.
+
+>> Теперь нажмите C-s для начала поиска. Медленно, по одной букве, набирайте
+ слово 'курсор', останавливаясь после каждой введенной буквы и замечая, что
+ происходит с курсором.
+ Сейчас вы нашли первое вхождение слова "курсор".
+>> Нажмите C-s снова, чтобы найти следующее вхождение слова "курсор".
+>> Теперь нажмите <DEL> четыре раза и проследите за перемещениями курсора.
+>> Нажмите <Return> для завершения поиска.
+
+Вы заметили, что произошло? Emacs в режиме инкрементального поиска пытался
+переходить к строкам, совпадающим с набираемой вами строкой. Чтобы перейти
+к следующему вхождению слова 'курсор', просто нажмите C-s снова. Если больше
+нет вхождений, то Emacs издаст звуковой сигнал и сообщит, что ваш поиск не
+удался ("failing"), C-g также завершает поиск.
+
+Если вы во время инкрементального поиска нажмете <DEL>, то поиск "вернется"
+к предыдущему найденному месту. Если вы наберете <DEL> сразу после того как
+вы нажали C-s для перемещения к следующей позиции, то <DEL> переместит к
+предыдущему вхождению. Если предыдущей позиции не было, то <DEL> удалит
+последний символ в строке поиска. Например, предположим, что вы набрали "к",
+поиск перейдет к первому вхождению символа "к". Теперь, если вы наберете
+"у", курсор перейдет к первому вхождению "ку". Нажатие <DEL> удалит символ
+"у" из строки поиска, и курсор вернется к первому вхождению "к".
+
+Если вы во время поиска введете control- или meta- сочетание клавиш (за
+некоторыми исключениями, например, такими, как C-s и C-r, которые имеют
+специальное значение в поиске), то поиск прекратится.
+
+C-s начинает поиск и ищет любые вхождения искомой строки ПОСЛЕ текущей
+позиции курсора. Если вы хотите найти что-то ранее в тексте, то нажмите
+C-r. Все, что мы говорили о C-s, применимо и к C-r, только C-r ищет в
+противоположном направлении.
+
+
+* МНОЖЕСТВО ОКОН (MULTIPLE WINDOWS)
-----------------------------------
- Emacs' ,
- .
+Одной из приятных возможностей Emacs является то, что вы можете одновременно
+отображать на экране несколько окон. (Заметьте, что Emacs использует термин
+"фрейм" (frame), описанный в следующем разделе, для того, что другие
+приложения называют окна. В Руководстве Emacs имеется подробный глоссарий).
->> C-u 0 C-l ( CONTROL-L,
- CONTROL-1).
+>> Переместите курсор на эту строку и наберите C-l C-l.
->> C-x 2, .
- . .
+>> Теперь наберите C-x 2, что разделит экран на два окна.
+ Оба окна отображают учебник. Курсор остался в верхнем окне.
->> C-M-v .
- ( META (Alt), <ESC> C-v.)
+>> Нажмите C-M-v для прокрутки нижнего окна.
+ (если у вас нет клавиши META (Alt), то нажмите <ESC> C-v.)
->> C-x o ("o" "other" -- )
- .
->> C-v M-v , .
- .
+>> Нажмите C-x o ("o" от слова "other" -- другое) для перемещения курсора в
+ нижнее окно.
+>> Используйте C-v и M-v в нижнем окне, для прокрутки текста.
+ Продолжите чтение этой инструкции в верхнем окне.
->> C-x o , .
- , .
+>> Снова нажмите C-x o, чтобы переместить курсор назад в верхнее окно.
+ Курсор в верхнем окне там же, где и был до того.
- , C-x o.
- , .
- ,
-. "" ("selected window").
+Вы можете продолжать использовать C-x o для переключения между окнами.
+"Выбранное окно", где производится редактирование -- это окно с видимым
+курсором, который мигает когда вы не набираете текст. Остальные окна
+сохраняют собственные позиции курсора. Если вы используете Emacs в
+графической среде, то эти курсоры будут отображаться как немигающие полые
+прямоугольники.
- C-M-v , ,
- .
- ,
- C-M-v.
+Команда C-M-v очень удобна, когда вы редактируете текст в одном окне, а
+второе используете в качестве справочника. С помощью C-M-v вы можете
+прокручивать текст в другом окне не покидая текущего окна.
-C-M-v -- CONTROL-META . META
-( Alt), C-M-v,
-CONTROL META , , v. , , CONTROL
- META, ,
-.
+C-M-v -- пример CONTROL-META сочетания клавиш. Если у вас есть клавиша META
+(или Alt), то вы можете набрать C-M-v, нажав одновременно CONTROL и META и,
+не отпуская их, нажать v. Не важно, какая из клавиш, CONTROL или META, будет
+нажата первой, поскольку обе эти клавиши изменяют набираемый вами символ.
- META, <ESC>,
- : <ESC>, CTRL-v;
-CONTROL-<ESC> v . , <ESC>
- -- .
+Если у вас нет клавиши META, и вместо нее вы используете <ESC>, то порядок
+нажатия важен: сначала вы должны нажать <ESC>, а затем CTRL-v, поскольку
+CONTROL-<ESC> v не будет работать. Это происходит потому, что <ESC> сама
+является символом, а не модифицирующей клавишей.
->> C-x 1 ( ), .
+>> Нажмите C-x 1 (в верхнем окне), чтобы избавиться от нижнего окна.
+
+(Если бы вы нажали C-x 1 в нижнем окне, то вы бы избавились от верхнего.
+Понимайте эту команду как "Оставить только одно окно -- то, в котором я
+сейчас нахожусь").
+
+Вам не нужно отображать один и тот же буфер в обоих окнах. Если вы
+используете C-x C-f, чтобы открыть файл в одном окне, другое останется без
+изменения. Вы можете независимо открывать файлы в каждом окне.
+
+Есть и другой путь использовать два окна, отображающих разные файлы:
+
+>> Наберите C-x 4 C-f, и введите имя одного из ваших файлов. Завершите ввод
+ нажатием <Return>. Заметьте, что выбранный файл появился в нижнем окне.
+ Курсор перешел туда же.
+
+>> Наберите C-x o, чтобы вернуться в верхнее окно, и затем C-x 1, чтобы
+ удалить нижнее окно.
+
+
+* МНОЖЕСТВО ФРЕЙМОВ (MULTIPLE FRAMES)
+-------------------------------------
-( C-x 1 , .
- " -- ,
- ").
+Emacs также может создавать множество "фреймов" (frames). Фрейм -- это то,
+что мы называем коллекцией окон, вместе со строкой меню, полосами прокрутки,
+областью эхо, и т.д. На графических дисплеях, то что в Emacs называется
+"фрейм", большинство других приложений называют "окно". В графической среде
+одновременно может быть отображено несколько фреймов. А на текстовых
+терминалах, может быть показан только один фрейм в конкретный момент
+времени.
- .
- C-x C-f, ,
-. .
+>> Наберите M-x make-frame <Return>.
+ Вы увидите что новый фрейм появился на экране.
- , :
+В новом фрейме вы можете делать все то же самое что и в оригинальном
+фрейме. Между ними нет особых отличий.
->> C-x 4 C-f, .
- <Return>. , .
- .
+>> Наберите M-x delete-frame <Return>.
+ Эта команда удалит текущий фрейм.
->> C-x o, , C-x 1,
- .
+Вы также можете удалить фрейм используя стандартные методы вашей графической
+среды (часто путем нажатия кнопки "X" в верхней части фрейма). Если вы
+таким способом удалите последний имеющийся фрейм Emacs, то это приведет к
+завершению работы Emacs.
-* (RECURSIVE EDITING LEVELS)
+* РЕКУРСИВНЫЕ УРОВНИ РЕДАКТИРОВАНИЯ (RECURSIVE EDITING LEVELS)
--------------------------------------------------------------
- "
-". ,
- . ,
- [(Fundamental)] (Fundamental).
+Иногда вы будете попадать в так называемые "рекурсивные уровни
+редактирования". На это указывают прямоугольные скобки в строке состояния,
+окружающие обычные скобки вокруг имени основного режима. Например, вы
+увидите [(Fundamental)] вместо (Fundamental).
- , <ESC> <ESC>
-<ESC>. "".
- , -.
+Чтобы выйти из рекурсивных уровней редактирования, нажмите <ESC> <ESC>
+<ESC>. Это многоцелевая команда "выхода". Вы также можете использовать ее
+как для уничтожения лишних окон, так и для выхода из мини-буфера.
->> M-x, -, <ESC> <ESC>
- <ESC>, .
+>> Нажмите M-x, чтобы попасть в мини-буфер, а затем нажмите <ESC> <ESC>
+ <ESC>, чтобы покинуть его.
- C-g
-. , C-g
- .
+Вы не можете использовать C-g для выхода из рекурсивных уровней
+редактирования. Это потому, что C-g используется для отмены команд и
+аргументов ВНУТРИ рекурсивных уровней редактирования.
-*
+* КАК ПОЛУЧИТЬ ДОПОЛНИТЕЛЬНУЮ ПОМОЩЬ
------------------------------------
- ,
- Emacs'. Emacs'
-, .
-, Emacs'. Emacs
- Emacs.
-"" ("help") CONTROL-h,
-" ".
+В этом учебнике мы попытались снабдить вас достаточной информацией для
+начала использования Emacs. В Emacs очень много разной функциональности, и
+представить все это здесь не представляется возможным. Однако, возможно вы
+захотите узнать больше о возможностях Emacs. Emacs предоставляет команды
+для чтения документации о командах Emacs. Все команды "справки" (help)
+начинаются с сочетания CONTROL-h, который является "символом справки".
- , C-h, -- ,
-, .
- , C-h ?, Emacs ,
- . C-h
- , C-g, .
+Чтобы использовать справку, нажмите C-h, а затем -- символ, который
+расскажет, какой именно вид справки вы хотите получить. Если вы
+ДЕЙСТВИТЕЛЬНО растерялись, наберите C-h ?, и Emacs расскажет вам о том,
+какую справку он может вам предоставить. Если вы нажали C-h и передумали
+обращаться к справке, то просто нажмите C-g, чтобы отменить эту команду.
-(- C-h. ,
- , . ,
- C-h ,
- F1 M-x help RET).
+(Если C-h не отображает справку внизу экрана, то попробуйте вместо этого
+нажать клавишу F1 или набрать M-x help RET).
- -- C-h c. C-h, c
- , Emacs
- .
+Одна из самых главных функций справки -- C-h c. Нажмите C-h, а затем c и
+символ команды или последовательность, и Emacs отобразит краткое описание
+набранной команды.
->> C-h c C-p.
+>> Нажмите C-h c C-p.
- :
+Сообщение должно выглядеть примерно так:
C-p runs the command previous-line
- (C-p previous-line {-})
+ (C-p выполняет команду previous-line {предыдущая строка})
- " ".
- Emacs. , ,
- ,
- .
+Вам сообщают "имя функции". Поскольку имена функций выбраны так, чтобы
+показать, что именно команда делает, то они могут служить короткой
+документацией -- достаточно чтобы напомнить вам об уже выученных командах.
- , C-x C-s (
-META EDIT ALT) <ESC> v
- C-h c.
+Многосимвольные сочетания клавиш, такие как C-x C-s и (если у вас нет клавиши
+META или EDIT или ALT) <ESC> v также будут доступны для получения справки с
+помощью C-h c.
- C-h k C-h c.
+Вы можете получить больше информации о сочетании клавиш используя C-h k вместо C-h c.
->> C-h k C-p.
+>> Наберите C-h k C-p.
- , , Emacs.
- , C-x 1, .
- C-x 1 : -
- ,
+В отдельном окне Emacs вы увидите описание функции, а также ее имя. Когда вы
+завершите чтение, нажмите C-x 1, чтобы избавиться от окна с текстом справки.
+Не обязательно нажимать C-x 1 сразу: вы можете сначала выполнить какие-либо
+изменения текста во время просмотра текста справки, и только затем нажать
C-x 1.
- , C-h:
+Есть еще несколько полезных функций, доступных через C-h:
- C-h f . .
+ C-h f Описывает функцию. Вам необходимо набрать имя функции.
->> C-h f previous-line<Return>.
- Emacs ,
+>> Попробуйте набрать C-h f previous-line<Return>.
+ Это отобразит информацию Emacs о функции, которая выполняется командой
C-p.
- C-h v ,
- Emacs.
- , Emacs .
+Аналогичная команда C-h v отображает документацию о переменных, включая те,
+значение которых вы можете изменить для настройки поведения Emacs. Вам нужно
+набрать имя переменной, когда Emacs запросит его.
- C-h a (Apropos Command). Emacs
- , .
- , Meta-x, Emacs
- "Command" , ,
- .
+ C-h a (Command Apropos). Введите ключевое слово и Emacs покажет вам
+ список всех команд и функций, имена которых содержат это слово.
+ Эти команды могут быть запущены с помощью Meta-x.
+ Для некоторых команд, эта команда также покажет последовательности
+ клавиш которые могут использоваться для их запуска.
->> C-h a file<Return>.
+>> Наберите C-h a file<Return>.
- M-x,
- "file". , find-file,
- , C-x C-f.
+Это отобразит в другом окне список всех команд M-x, у которых в именах
+содержится слово "file". Также в списке кроме таких команд, как find-file,
+вы увидите соответствующие символьные команды, такие как C-x C-f.
->> C-M-v . .
+>> Наберите C-M-v для прокрутки окна справки. Выполните это несколько раз.
->> C-x 1 .
+>> Наберите C-x 1 для удаления окна справки.
- C-h i ( Info).
- `*info*',
- ,
- . m emacs <Return>
- Emacs. Info, ?
- Emacs Info.
- ,
- Emacs Info .
+ C-h i Читать интерактивные руководства (команда Info). Эта команда
+ переходит в специальный буфер с именем `*info*', где вы можете
+ читать интерактивные руководства для пакетов, установленных в вашей
+ системе. Наберите m emacs <Return> для чтения руководства по
+ Emacs. Если вы никогда ранее не использовали Info, то наберите ? и
+ Emacs откроет учебник по возможностям режима Info. Однажды
+ ознакомившись с этим учебником, вы должны использовать руководство
+ Emacs Info в качестве основной документации.
-*
+* ДОПОЛНИТЕЛЬНЫЕ ВОЗМОЖНОСТИ
----------------------------
- Emacs', ,
- ( Help F10 h r).
- -- ,
- , dired, .
+Вы можете узнать больше об Emacs, читая руководство по нему, книги или
+интерактивный справочник (используйте меню Help или наберите F10 h r). Вам
+особенно понравятся две функции -- дополнение имен (completion), которое
+сокращает количество нажимаемых клавиш, и dired, который упрощает работу с
+файлами.
- , .
-, *Messages*,
- C-x b *M<Tab> Emacs ,
- , .
-Info- Emacs "Completion".
+Дополнение имен используется для того, чтобы избежать набора лишних
+символов. Например, если вы хотите переключиться в буфер *Messages*, то вы
+можете набрать C-x b *M<Tab> и Emacs дополнит остаток имени буфера,
+поскольку он может определить его из того, что вы уже набрали. Дополнение
+имен описано в Info-версии руководства по Emacs в разделе "Completion".
-Dired (
-, ), ,
- , ,
-. Dired Info- Emacs "Dired".
+Dired позволяет вам отображать список файлов в каталоге (а также
+подкаталогах, в зависимости от настройки), перемещаться по списку файлов,
+открывать их, переименовывать, удалять и выполнять прочие действия над
+файлами. Dired описан в Info-версии руководства по Emacs в разделе "Dired".
- Emacs.
+В руководстве также описаны остальные возможности Emacs.
-*
+* ЗАКЛЮЧЕНИЕ
------------
-, , Emacs,
- C-x C-c. (shell)
-, C-z.
+Для выхода из Emacs, используется сочетание клавиш C-x C-c.
- ,
- - , -- !
+Этот учебник должен быть понятен всем новым пользователям, но если вы
+найдете что-нибудь неясное, не нужно сидеть и порицать себя -- жалуйтесь!
-*
+* УСЛОВИЯ РАСПРОСТРАНЕНИЯ
-------------------------
- Emacs,
- Stuart Cracraft Emacs'.
+Этот учебник произошел из длинной серии учебников Emacs, начатой с однажды
+написанного Stuart Cracraft учебника для оригинального Emacs.
- , GNU Emacs,
-(copyrighted)
- :
+Эта версия учебника, как и GNU Emacs, защищена правами копирования
+(copyrighted) и приходит с ограничениями распространения копий со
+следующими соглашениями:
-Copyright (C) 1985, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim copies
of this document as received, in any medium, provided that the
@@ -1141,17 +1118,18 @@ Copyright (C) 1985, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
under the above conditions, provided also that they
carry prominent notices stating who last altered them.
- Emacs , .
-, COPYING GNU Emacs
-.
- (""), ,
- !
+Условия распространения самого Emacs более сложные, но примерно в том же духе.
+Пожалуйста, прочтите файл COPYING и затем раздайте копию GNU Emacs вашим
+друзьям. Помогите уничтожить обструкционизм в области программного
+обеспечения ("владение"), используя, создавая и распространяя свободное
+программное обеспечение!
-// alexott@gmail.com.
+// жду замечаний и исправления ошибок по адресу alexott@gmail.com.
// Alex Ott.
;;; Local Variables:
-;;; coding: cyrillic-koi8
+;;; coding: utf-8
;;; sentence-end-double-space: nil
+;;; fill-column: 76
;;; End:
diff --git a/etc/tutorials/TUTORIAL.sk b/etc/tutorials/TUTORIAL.sk
index b75f4c24f0e..891b29d3da7 100644
--- a/etc/tutorials/TUTORIAL.sk
+++ b/etc/tutorials/TUTORIAL.sk
@@ -1074,7 +1074,7 @@ ttorialom napsanm Stuartom Cracraftom pre pvodn Emacs.
Tto verzia ttorialu je, podobne ako GNU Emacs, chrnen copyrightom
a je ren s povolenm distribuova kpie za istch podmienok:
-Copyright (C) 1985, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
Kadmu je zaruen prvo vytvra a distribuova presn kpie tohto
dokumentu tak, ako ho dostal, na akomkovek mdiu, s tm, e bude
diff --git a/etc/tutorials/TUTORIAL.sl b/etc/tutorials/TUTORIAL.sl
index e43ac324870..804fe366d50 100644
--- a/etc/tutorials/TUTORIAL.sl
+++ b/etc/tutorials/TUTORIAL.sl
@@ -1,41 +1,42 @@
-Prvo berilo za Emacs. Pogoji uporabe in razirjanja so navedeni na koncu.
+Prvo berilo za Emacs. Pogoji uporabe in razširjanja so navedeni na koncu.
-Ukazi v Emacsu v splonem vkljuujejo tipki CONTROL (vasih oznaeni
-CTRL ali CTL) in META (vasih oznaena EDIT ali ALT). Namesto, da bi ju
-vedno izpisali s celim imenom, bomo uporabili naslednji okrajavi:
+Ukazi v Emacsu v splošnem vključujejo tipki CONTROL (včasih označeni
+CTRL ali CTL) in META (včasih označena EDIT ali ALT). Namesto, da bi ju
+vedno izpisali s celim imenom, bomo uporabili naslednji okrajšavi:
- C-<znak> pomeni, da moramo drati pritisnjeno tipko CONTROL, ko
- vtipkamo <znak>. Oznaka C-f tako pomeni: drimo pritisnjeno
+ C-<znak> pomeni, da moramo držati pritisnjeno tipko CONTROL, ko
+ vtipkamo <znak>. Oznaka C-f tako pomeni: držimo pritisnjeno
tipko CONTROL in pritisnemo tipko f.
- M-<znak> pomeni, da moramo drati pritisnjeno tipko META, EDIT ali
- ALT, ko vtipkamo <znak>. e na tipkovnici ni tipk META, EDIT
+ M-<znak> pomeni, da moramo držati pritisnjeno tipko META, EDIT ali
+ ALT, ko vtipkamo <znak>. Če na tipkovnici ni tipk META, EDIT
ali ALT, pritisnemo tipko ESC, jo spustimo in zatem
- pritisnemo tipko <chr>. Tipko ESC bomo oznaevali z <ESC>.
+ pritisnemo tipko <chr>. Tipko ESC bomo označevali z <ESC>.
Pomembno: Emacs zapustimo z ukazom C-x C-c (dva znaka).
-V ubeniku so vaje, s katerimi preskusite nove ukaze. Oznaujeta jih
-znaka ,>>` ob levem robu. Zgled:
+Delno vnešen ukaz prekinete s C-g.
+V učbeniku so vaje, s katerimi preskusite nove ukaze. Označujeta jih
+znaka »>>« ob levem robu. Zgled:
<<Blank lines inserted here by startup of help-with-tutorial>>
-[Sredina strani je iz didaktinih razlogov prazna. Besedilo se nadaljuje spodaj]
->> Vtipkajte zdaj ukaz C-v (View next screen, Prikai naslednji zaslon),
+[Sredina strani je iz didaktičnih razlogov prazna. Besedilo se nadaljuje spodaj]
+>> Vtipkajte zdaj ukaz C-v (View next screen, Prikaži naslednji zaslon),
da se premaknete na naslednji zaslon (kar poskusite, pritisnite
hkrati tipko CONTROL in V). Od zdaj naprej boste morali to
- napraviti sami vsaki, ko pridete do konca zaslona.
+ napraviti sami vsakič, ko pridete do konca zaslona.
-Ste opazili, da sta se dve vrstici s prejnjega zaslona ponovili? Ta
-kontinuiteta olaja branje pri skakanju s strani na stran.
+Ste opazili, da sta se dve vrstici s prejšnjega zaslona ponovili? Ta
+kontinuiteta olajša branje pri skakanju s strani na stran.
Prva stvar, ki si jo morate zapomniti, je, kako se premikate po
-datoteki. Zdaj e veste, da se premaknete za cel zaslon naprej z
+datoteki. Zdaj že veste, da se premaknete za cel zaslon naprej z
ukazom C-v. Za cel zaslon nazaj pa se premaknete z ukazom M-v
-(pritisnite tipko META in jo drite ter pritisnite tipko v, ali pa
-pritisnite in spustite <ESC> ter zatem pritisnite tipko v, e tipke
-META, EDIT ali ALT na vai tipkovnici ni).
+(pritisnite tipko META in jo držite ter pritisnite tipko v, ali pa
+pritisnite in spustite <ESC> ter zatem pritisnite tipko v, če tipke
+META, EDIT ali ALT na vaši tipkovnici ni).
>> Nekajkrat pritisnite M-v in C-v, da vidite, kako ukaza delujeta.
-* POVZETEK
+* povzetek
----------
Za pregled celega zaslona besedila so uporabni naslednji ukazi:
@@ -43,110 +44,113 @@ Za pregled celega zaslona besedila so uporabni naslednji ukazi:
C-v Premik se za cel zaslon naprej
M-v Premik se za cel zaslon nazaj
C-l Cel zaslon premaknemo tako, da je zdaj po vertikali
- osredninjen okoli besedila, kjer se nahaja kazalek
- (znak v C-l je rka L, ne tevka 1)
+ osredninjen okoli besedila, kjer se nahaja kazalček
+ (znak v C-l je črka L, ne števka 1)
->> Poiite kazalek na zaslonu in si zapomnite besedilo okoli njega.
- Vtipkajte C-l.
- Ponovno poiite kazalek. Besedilo okoli njega je ostalo isto.
+>> Poiščite kazalček na zaslonu in si zapomnite besedilo okoli njega.
+ Zatem vtipkajte C-l. Ponovno poiščite kazalček. Opazili boste, da
+ je besedilo okoli njega ostalo isto, vendar se je pomaknilo na sredo
+ zaslona. Če še enkrat pritisnite C-l, se bo ta vrstica pomaknila na
+ vrh zaslona. Pritisnite C-l še enkrat, in vrstica se bo pomaknila
+ na dno zaslona.
Za premikanje za cel zaslon naprej ali nazaj lahko tipkovnicah, ki
imajo ti tipki, uporabljate tudi PageUp in PageDown. Opisan postopek s
C-v in M-v pa deluje povsod.
-* PREMIKANJE KAZALKA
+* PREMIKANJE KAZALČKA
---------------------
Premiki za celo stran naprej in nazaj so sicer uporabni, ampak kako pa
pridemo do izbranega mesta na zaslonu?
-Nainov je ve. Najosnovneji je uporaba ukazov C-p, C-b, C-f in
-C-n. Ti po vrsti premaknejo kazalek v prejnjo vrstico, znak nazaj,
-znak naprej, in v naslednjo vrstico. Ti tirje ukazi so enakovredni
+Načinov je več. Najosnovnejši je uporaba ukazov C-p, C-b, C-f in
+C-n. Ti po vrsti premaknejo kazalček v prejšnjo vrstico, znak nazaj,
+znak naprej, in v naslednjo vrstico. Ti štirje ukazi so enakovredni
kurzorskim tipkam:
- prejnja vrstica, C-p
+ prejšnja vrstica, C-p
:
:
- nazaj, C-b .... trenutni poloaj kazalka .... naprej, C-f
+ nazaj, C-b .... trenutni položaj kazalčka .... naprej, C-f
:
:
naslednja vrstica, C-n
->> S pritiski na C-n ali C-p premaknite kazalek v sredinsko vrstico
+>> S pritiski na C-n ali C-p premaknite kazalček v sredinsko vrstico
na diagramu zgoraj. Zatem pritisnite C-l. S tem diagram postavite na
sredino zaslona.
-V angleini ima izbor tipk nazoren pomen. P kot ,previous`
-(prejnji), N kot ,next` (naslednji), B kot ,backward` (nazaj) in F
-kot ,forward` (naprej). Te osnovne ukaze za premikanje kazalka boste
-uporabljali ves as.
+V angleščini ima izbor tipk nazoren pomen. P kot »previous«
+(prejšnji), N kot »next« (naslednji), B kot »backward« (nazaj) in F
+kot »forward« (naprej). Te osnovne ukaze za premikanje kazalčka boste
+uporabljali ves čas.
->> Nekajkrat pritisnite C-n, da pride kazalek do te vrstice.
+>> Nekajkrat pritisnite C-n, da pride kazalček do te vrstice.
>> Z nekaj C-f se pomaknite na desno na sredo vrstice, nato pa nekajkrat
- pritisnite C-p. Opazujte, kaj se dogaja s kazalkom na sredini
+ pritisnite C-p. Opazujte, kaj se dogaja s kazalčkom na sredini
vrstice.
-Vsaka vrstice v besedilu je zakljuena z znakom za novo vrstico
-(angl. Newline). Ta louje vrstico v besedilu od naslednje. Tudi
-zadnja vrstica v datoteki mora biti zaljuena z znakom za novo vrstico
-(eprav tega Emacs ne zahteva).
+Vsaka vrstice v besedilu je zaključena z znakom za novo vrstico
+(angl. Newline). Ta ločuje vrstico v besedilu od naslednje. (Tudi
+zadnja vrstica v datoteki je po navadi zaključena z znakom za novo
+vrstico, čeprav Emacs tega ne zahteva.)
->> Poskusite ukaz C-b, ko je kazalek na zaetku vrstice. Kazalek se
- mora premakniti na konec prejnje vrstice. To je zato, ker se je
+>> Poskusite ukaz C-b, ko je kazalček na začetku vrstice. Kazalček se
+ mora premakniti na konec prejšnje vrstice. To je zato, ker se je
ravnokar premaknil prek znaka za konec vrstice.
-Ukaz C-f premika kazalek prek znaka za novo vrstico enako kot C-b.
+Ukaz C-f premika kazalček prek znaka za novo vrstico enako kot C-b.
->> Poskusite e nekajkrat pritisniti C-b, da dobite obutek za
- premikanje kazalka. Potem nekajkrat poskusite C-f, da pridete do konca
- vrstice. e enkrat pritisnite C-f, da skoite v naslednjo vrstico.
+>> Poskusite še nekajkrat pritisniti C-b, da dobite občutek za
+ premikanje kazalčka. Potem nekajkrat poskusite C-f, da pridete do konca
+ vrstice. Še enkrat pritisnite C-f, da skočite v naslednjo vrstico.
-Ko s kazalkom doseete zgornji ali spodnji rob zaslona, se besedilo
-toliko premakne, da kazalek ostane na zaslonu. V angleini se temu
-pravi ,,scrolling``. To omogoa, da lahko premaknemo kazalek na
+Ko s kazalčkom dosežete zgornji ali spodnji rob zaslona, se besedilo
+toliko premakne, da kazalček ostane na zaslonu. V angleščini se temu
+pravi »scrolling«. To omogoča, da lahko premaknemo kazalček na
katerokoli mesto v besedilu, a vseeno ostanemo na zaslonu.
->> Poskusite kazalek pripeljati s C-n isto do dna zaslona in si oglejte,
+>> Poskusite kazalček pripeljati s C-n čisto do dna zaslona in si oglejte,
kaj se zgodi.
-e se vam zdi premikanje po en znak prepoasno, se lahko premikate za
-celo besedo. M-f (META-f) premakne kazalek za eno besedo naprej, M-b
+Če se vam zdi premikanje po en znak prepočasno, se lahko premikate za
+celo besedo. M-f (META-f) premakne kazalček za eno besedo naprej, M-b
pa za besedo nazaj.
>> Poskusite nekajkrat M-f in M-b.
-e je kazalek sredi besede, ga M-f prestavi na konec besede. e je v
+Če je kazalček sredi besede, ga M-f prestavi na konec besede. Če je v
belini med besedami, ga M-f premakne na konec naslednje besede. M-b
deluje podobno, a v nasprotni smeri.
->> Nekajkrat poskusite M-f in M-b, vmes pa e nekaj C-f in
- C-b. Opazujte uinke M-f in M-b, ko je kazalek sredi besede ali
+>> Nekajkrat poskusite M-f in M-b, vmes pa še nekaj C-f in
+ C-b. Opazujte učinke M-f in M-b, ko je kazalček sredi besede ali
med besedami.
Ste opazili paralelo med C-f in C-b na eni strani ter M-f in M-b na
-drugi? V Emacsu se dostikrat ukazi Meta nanaajo na operacije nad
+drugi? V Emacsu se dostikrat ukazi Meta nanašajo na operacije nad
enotami jezika (besede, stavki, odstavki), medtem ko se ukazi Control
-nanaajo na operacije, neodvisne od zvrsti besedila (znaki, vrstice
+nanašajo na operacije, neodvisne od zvrsti besedila (znaki, vrstice
ipd.).
Podobna zveza je tudi med vrsticami in stavki: ukaza C-a in C-e
-premakneta kazalek na zaetek oz. konec vrstice, M-a in M-e pa na
-zaetek oz. konec stavka.
+premakneta kazalček na začetek oz. konec vrstice, M-a in M-e pa na
+začetek oz. konec stavka.
>> Poskusite nekaj ukazov C-a, potem pa nekaj ukazov C-e.
Poskusite nekaj ukazov M-a, potem pa nekaj ukazov M-e.
-Ste opazili, da ponovljeni C-a ne napravijo ni, ponovljeni M-a pa se
-premikajo naprej? eprav se ne obnaata enako, pa je vendar obnaanje
+Ste opazili, da ponovljeni C-a ne napravijo nič, ponovljeni M-a pa se
+premikajo naprej? Čeprav se ne obnašata enako, pa je vendar obnašanje
enega in drugega po svoje naravno.
-Poloaju kazalka na zaslonu pravimo tudi ,,point``, toka.
-Parafrazirano: kazalek kae na zaslonu, kje je toka v besedilu.
+Položaju kazalčka na zaslonu pravimo tudi »point«, točka.
+Parafrazirano: kazalček kaže na zaslonu, kje je točka v besedilu.
-Povzetek preprostih ukazov za premikanje kazalka, vkljuno s premiki
+Povzetek preprostih ukazov za premikanje kazalčka, vključno s premiki
po besedo in stavek:
C-f Premik za znak naprej
@@ -156,335 +160,329 @@ po besedo in stavek:
M-b Premik za besedo nazaj
C-n Premik v naslednjo vrstico
- C-p Premik v prejnjo vrstico
+ C-p Premik v prejšnjo vrstico
- C-a Premik na zaetek vrstice
+ C-a Premik na začetek vrstice
C-e Premik na konec vrstice
- M-a Premik na zaetek stavka
+ M-a Premik na začetek stavka
M-e Premik na konec stavka
>> Za vajo nekajkrat poskusite vsakega od teh ukazov.
To so najpogosteje uporabljani ukazi.
-e dva pomembna ukaza za premikanje kazalka sta M-< (META-manji od),
-ki ga premakne na zaetek datoteke, in M-> (META-veji od), ki ga
+Še dva pomembna ukaza za premikanje kazalčka sta M-< (META-manjši od),
+ki ga premakne na začetek datoteke, in M-> (META-večji od), ki ga
premakne na konec datoteke.
-Na amerikih tipkovnicah najdete znak < nad vejico in morate
+Na ameriških tipkovnicah najdete znak < nad vejico in morate
pritisniti tipko Shift, da pridete do njega. Z ukazom M-< je enako -
prav tako morate pritisniti tipko Shift, sicer moste izvedli drug
-ukaz, Meta-vejica. Na naih tipkovnicah sta oba znaka na isti tipko,
-in za ukaz M-> morate pritisniti e tipko Shift.
+ukaz, Meta-vejica. Na naših tipkovnicah sta oba znaka na isti tipko,
+in za ukaz M-> morate pritisniti še tipko Shift.
->> Poskusite zdaj M-<, skok na zaetek tega ubenika.
+>> Poskusite zdaj M-<, skok na začetek tega učbenika.
Potem se vrnite nazaj z zaporednimi C-v.
->> Poskusite zdaj M->, skok na konec tega ubenika.
+>> Poskusite zdaj M->, skok na konec tega učbenika.
Potem se vrnite nazaj z zaporednimi M-v.
-e ima vaa tipkovnica kurzorske tipke, lahko premikate kazalek po
-zaslonu tudi z njimi. Vseeno priporoamo, da se privadite ukazov C-b,
-C-f, C-n in C-p, in to iz treh razlogov. Prvi, delujejo na isto vseh
-terminalih. Drugi, z nekaj prakse v Emacsu boste opazili, da je
-tipkanje ukazov s CONTROL hitreje od tipkanja s kurzorskimi tipkami, ker
-ni treba ves as premikati desnice s tipkovnice na kurzorske tipke in
-nazaj. In tretji, ko se enkrat navadite teh ukazov s CONTROL, se boste
-enostavneje nauili tudi bolj zapletenih ukazov za premikanje kazalka.
-
-Veini ukazov v Emacsu lahko podamo tevilni argument; najvekrat ta
-pove, kolikokrat zapovrstjo naj se ukaz izvede. Vekratno ponovitev
-ukaza izvedemo tako, da najprej vtipkamo C-u, zatem tevilo,
-kolikokrat naj se ukaz ponovi, in nazadnje eljeni ukaz. e ima vaa
+Če ima vaša tipkovnica kurzorske tipke, lahko premikate kazalček po
+zaslonu tudi z njimi. Vseeno priporočamo, da se privadite ukazov C-b,
+C-f, C-n in C-p, in to iz treh razlogov. Prvič, delujejo na čisto vseh
+terminalih. Drugič, z nekaj prakse v Emacsu boste opazili, da je
+tipkanje ukazov s CONTROL hitrejše od tipkanja s kurzorskimi tipkami, ker
+ni treba ves čas premikati desnice s tipkovnice na kurzorske tipke in
+nazaj. In tretjič, ko se enkrat navadite teh ukazov s CONTROL, se boste
+enostavneje naučili tudi bolj zapletenih ukazov za premikanje kazalčka.
+
+Večini ukazov v Emacsu lahko podamo številčni argument; največkrat ta
+pove, kolikokrat zapovrstjo naj se ukaz izvede. Večkratno ponovitev
+ukaza izvedemo tako, da najprej vtipkamo C-u, zatem število,
+kolikokrat naj se ukaz ponovi, in nazadnje željeni ukaz. Če ima vaša
tipkovnica tipko META (ali EDIT ali ALT), lahko izpustite ukaz C-u in
-namesto tega vtipkate tevilo ponovitev, medtem ko drite pritisnjeno
-tipko META. Druga metoda je sicer kraja, priporoamo pa prvo, ker
-deluje na vseh terminalih. Taken tevilni argument je ,,prefiksni``
-argument, ker vnesemo argument pred ukazom, na katerega se nanaa.
+namesto tega vtipkate število ponovitev, medtem ko držite pritisnjeno
+tipko META. Druga metoda je sicer krajša, priporočamo pa prvo, ker
+deluje na vseh terminalih. Takšen številčni argument je »prefiksni«
+argument, ker vnesemo argument pred ukazom, na katerega se nanaša.
-Zgled: C-u 8 C-f premakne kazalek za osem znakov naprej.
+Zgled: C-u 8 C-f premakne kazalček za osem znakov naprej.
->> Poskusite s primernim argumentom za tevilo ponovitev ukaza
- C-n ali C-p priti im blie tej vrstici v enem samem skoku.
+>> Poskusite s primernim argumentom za število ponovitev ukaza
+ C-n ali C-p priti čim bliže tej vrstici v enem samem skoku.
-Veina ukazov, ne pa vsi, uporablja tevilni argument kot tevilo
+Večina ukazov, ne pa vsi, uporablja številčni argument kot število
ponovitev ukaza. Nekateri ukazi - nobeden od tistih, ki smo si jih
ogledali do zdaj - ga uporabljajo kot stikalo: s podanim prefiksnim
-argumentom napravi ukaz nekaj drugega kot obiajno.
+argumentom napravi ukaz nekaj drugega kot običajno.
-Ukaza C-v in M-v sta tudi izjemi, a drugani. e jima podamo argument,
-premakneta zaslon za navedeno tevilo vrstic, ne pa zaslonov. Ukaz C-u
+Ukaza C-v in M-v sta tudi izjemi, a drugačni. Če jima podamo argument,
+premakneta zaslon za navedeno število vrstic, ne pa zaslonov. Ukaz C-u
8 C-v, na primer, premakne zaslon navzgor za 8 vrstic.
>> Poskusite zdaj C-u 8 C-v
-To bi moralo zaslon premakniti navzgor za osem vrstic. e bi ga radi
+To bi moralo zaslon premakniti navzgor za osem vrstic. Če bi ga radi
premaknili nazaj, poskusite M-v z istim argumentom.
-e uporabljate grafini vmesnik, denimo X11 ali MS Windows, imate
-verjetno ob robu Emacsovega okna navpino pravokotno ploskev,
+Če uporabljate grafični vmesnik, denimo X ali MS Windows, imate
+verjetno ob robu Emacsovega okna pokončno pravokotno ploskev,
imenovano drsnik. Pogled na besedilo lahko premikate tudi tako, da z
-miko kliknete na drsnik.
+miško kliknete na drsnik.
->> Postavite kazalec na vrh oznaenega obmoja na drsniku in pritisnite
- srednji gumb na miki. To bi moralo premakniti besedilo na mesto,
- doloeno s tem, kako visoko ali nizko na drsnik ste kliknili.
->> Medtem ko drite srednji gumb pritisnjen, premikajte miko gor in
- dol. Vidite, kako se premika besedilo v Emacsovem oknu, ko
- premikate miko?
-
-
-* E SE EMACS OBESI
--------------------
+* ČE SE EMACS PRENEHA ODZIVATI
+------------------------------
-e se Emacs preneha odzivati na vae ukaze, ga lahko varno prekinete z
+Če se Emacs preneha odzivati na vaše ukaze, ga lahko varno prekinete z
ukazom C-g. Z njim lahko prekinete ukaze, za katere bi trajalo
predolgo, da bi se izvedli.
-Isti ukaz, C-g, lahko uporabite tudi, da prekliete tevilni
-argument, ali pa zaetek ukaza, ki ga ne elite izvesti.
+Isti ukaz, C-g, lahko uporabite tudi, da prekličete številčni
+argument, ali pa začetek ukaza, ki ga ne želite izvesti.
->> Vtipkajte C-u 100, s imer ste izbrali tevilni argument 100,
- zatem pa vtipkajte C-g. Vtipkajte zdaj C-f. Kazalek se je
- premaknil le za en znak, ker ste tevilni argument vmes preklicali
+>> Vtipkajte C-u 100, s čimer ste izbrali številčni argument 100,
+ zatem pa vtipkajte C-g. Vtipkajte zdaj C-f. Kazalček se je
+ premaknil le za en znak, ker ste številčni argument vmes preklicali
s C-g.
-Tudi e ste po nesrei vtipkali <ESC>, se ga lahko znebite s C-g.
+Tudi če ste po nesreči vtipkali <ESC>, se ga lahko znebite s C-g.
-* ONEMOGOENI UKAZI
+* ONEMOGOČENI UKAZI
-------------------
-Nekaj ukazov v Emacsu je namenoma ,,onemogoenih``, da bi jih
-zaetniki ne izvedli po nesrei.
+Nekaj ukazov v Emacsu je namenoma »onemogočenih«, da bi jih
+začetniki ne izvedli po nesreči.
-e vtipkate tak onemogoen ukaz, se bo na zaslonu pojavilo novo okno z
-obvestilom, kateri ukaz ste skuali izvesti, in vas vpraalo, e ga
-res elite izvesti.
+Če vtipkate tak onemogočen ukaz, se bo na zaslonu pojavilo novo okno z
+obvestilom, kateri ukaz ste skušali izvesti, in vas vprašalo, če ga
+res želite izvesti.
-e v resnici elite poskusiti ukaz, pritisnite preslednico kot odgovor
-na vpraanje. Normalno verjetno ukaza ne elite izvesti, zato na
-vpraanje odgovorite z ,n`.
+Če v resnici želite poskusiti ukaz, pritisnite preslednico kot odgovor
+na vprašanje. Normalno verjetno ukaza ne želite izvesti, zato na
+vprašanje odgovorite z »n«.
->> Vtipkajte C-x C-l (ki je onemogoen ukaz),
- zatem na vpraanje odgovorite n.
+>> Vtipkajte C-x C-l (ki je onemogočen ukaz),
+ zatem na vprašanje odgovorite n.
* OKNA
------
-Emacs lahko prikae ve oken in v vsakem svoje besedilo. Kasneje bomo
-razloili, kako uporabljamo ve oken hkrati. Zaenkrat bomo povedali
-le, kako se znebite dodatnih oken, ki jih lahko odpre vgrajena pomo ali
-pa izpis kaknega drugega programa. Preprosto je:
+Emacs lahko prikaže več »oken« in v vsakem svoje besedilo. Kasneje
+bomo razložili, kako uporabljamo več oken hkrati. Zaenkrat bomo
+povedali le, kako se znebite dodatnih oken, ki jih lahko odpre
+vgrajena pomoč ali pa izpis kakšnega drugega programa. Preprosto je:
C-x 1 Eno okno (torej, zaprimo vsa ostala).
-To je CONTROL-x, ki mu sledi tevka 1. Ukaz C-x 1 raztegne ez cel
-zaslon okno, v katerem se nahaja kazalek, ostala pa zapre.
+To je CONTROL-x, ki mu sledi števka 1. Ukaz C-x 1 raztegne čez cel
+zaslon okno, v katerem se nahaja kazalček, ostala pa zapre.
->> Premaknite kazalek do te vrstice in vtipkajte C-u 0 C-l
->> Vtipkajte CONTROL-h k CONTROL-f.
- Vidite, kako se je to okno skrilo in odstopilo prostor oknu,
- ki pojasnjuje ukaz CONTROL-f?
+>> Premaknite kazalček do te vrstice in vtipkajte C-u 0 C-l
+>> Vtipkajte C-h k C-f.
+ Vidite, kako se je to okno skrčilo in odstopilo prostor oknu,
+ ki pojasnjuje ukaz C-f?
>> Vtipkajte C-x 1 in spodnje okno se bo zaprlo.
-Za razliko od ukazov, ki smo se jih nauili do zdaj, je ta ukaz
-sestavljen iz dveh znakov. Zane se z znakom CONTROL-x. Cela vrsta
-ukazov se zane enako, in mnogi od njih zadevajo delo z datotekami,
-delovnimi podroji in podobnim. Vsem tem ukazom je skupno, da se
-zanejo s CONTROL-x, ki mu sledi e en, dva ali trije znaki.
+Za razliko od ukazov, ki smo se jih naučili do zdaj, je ta ukaz
+sestavljen iz dveh znakov. Začne se z znakom CONTROL-x. Cela vrsta
+ukazov se začne enako, in mnogi od njih zadevajo delo z datotekami,
+delovnimi področji in podobnim. Vsem tem ukazom je skupno, da se
+začnejo s CONTROL-x, ki mu sledi še en, dva ali trije znaki.
* VRIVANJE IN BRISANJE
----------------------
-e elite v obstojee besedilo vriniti novo, preprosto premaknite
-kazalek na eljeno mesto in zanite tipkati. Znake, ki jih lahko
-vidite, na primer A, 7, * in podobno, razume Emacs kot del besedila in
-jih takoj vrine. S pritiskom na Return (ali Enter) vrinete znak za
-skok v novo vrstico.
-
-Zadnji vtipkani znak lahko izbriete s pritiskom na tipko
-<Delback>. To je tista tipka na tipkovnici, ki jo navadno uporabljate
-za brisanje nazadnje natipkanega znaka. Navadno je to velika tipka
-vrstico ali dve nad tipko <Return>, ki je oznaena z "Backspace",
-"Delete" ali "Del".
+Če želite v obstoječe besedilo vriniti novo, preprosto premaknite
+kazalček na želeno mesto in začnite tipkati. Vidne znake, na primer A,
+7, * in podobno, Emacs vrine takoj, ko jih vtipkate. S pritiskom na
+tipko <Return> (ali <Enter>) vrinete znak za skok v novo vrstico.
-e imate na tipkovnici tipko "Backspace", je to tipka <Delback>. Naj
-vas ne zmede, e imate poleg tega e tipko "Delete" - <Delback> je
-"Backspace".
+Zadnji vtipkani znak lahko izbrišete s pritiskom na tipko <DEL>. Ta
+tipka je na tipkovnici običajno označena z »Backspace« - skratka, to
+je ista tipka, ki jo tudi v drugih programih uporabljate za brisanje
+nazadnje natipkanega znaka.
-Splono <Delback> pobrie znak neposredno pred trenutnim poloajem
-kazalka.
+Najverjetneje imate na tipkovnici še tipko »Delete«. Naj vas to ne
+zmede - z <DEL> mislimo tipko »Backspace«.
->> Vtipkajte zdaj nekaj znakov in jih zatem s tipko <Delback> pobriite.
- Ni naj vas ne skrbi, e se je ta vrstica spremenila. Izvirnika
- tega ubenika ne boste pokvarili -- tole je samo vaa osebna kopija.
+>> Poskusite zdaj! Vtipkajte zdaj nekaj znakov in jih zatem s tipko
+ <DEL> pobrišite. Nič naj vas ne skrbi, če se je ta vrstica
+ spremenila. Izvirnika tega učbenika ne boste pokvarili -- tole je
+ samo vaša osebna delovna kopija.
-Ko vrstica postane predolga za zaslon, se ,,nadaljuje`` v naslednji
-vrstici na zaslonu. Obrnjena poevnica (znak ,\`) ali v grafinih
-okoljih zavita puica ob desnem robu oznauje vrstico, ki se
-nadaljuje v naslednji zaslonski vrstici.
+Ko vrstica postane predolga za zaslon, se »nadaljuje« v naslednji
+vrstici na zaslonu. Če uporabljate grafično okolje, boste opazili
+zaviti puščici ob levem in desnem robu, ki označujeta vrstico, ki se
+nadaljuje v naslednji zaslonski vrstici. Če uporabljate terminalski
+vmesnik, je vrstica, ki se nadaljuje v naslednji zaslonski vrstici,
+označena z obrnjeno poševnico (znak »\«) v skrajnem desnem stolpcu.
->> Zdaj zanite tipkati besedilo, dokler ne doseete desnega roba, in
- e naprej. Opazili boste, da se pojavi znak za nadaljevanje.
+>> Zdaj začnite tipkati besedilo, dokler ne dosežete desnega roba, in
+ še naprej. Opazili boste, da se pojavi znak za nadaljevanje.
->> S tipko <Delback> pobriite toliko znakov, da vrstica ne sega
- ve ez irino zaslona. Znak za nadaljevanje v naslednji
+>> S tipko <DEL> pobrišite toliko znakov, da vrstica ne sega
+ več čez širino zaslona. Znak za nadaljevanje v naslednji
vrstici je izginil.
-Znak za novo vrstico lahko pobriemo enako kot vsak drug znak. S tem,
-ko pobriemo znak za novo vrstico, zdruimo vrstici v eno samo. e bo
-nova vrstica predolga, da bi cela prila na zaslon, bo razdeljena v
-ve zaslonskih vrstic.
+Znak za novo vrstico lahko pobrišemo enako kot vsak drug znak. S tem,
+ko pobrišemo znak za novo vrstico, združimo vrstici v eno samo. Če bo
+nova vrstica predolga, da bi cela prišla na zaslon, bo razdeljena v
+več zaslonskih vrstic.
->> Premaknite kazalek na zaetek vrstice in pritisnite <Delback>. To
- zdrui vrstico s prejnjo.
+>> Premaknite kazalček na začetek vrstice in pritisnite <DEL>. To
+ združi vrstico s prejšnjo.
>> Pritisnite <Return>. S tem ste ponovno vrinili znak za skok v novo
vrstico, ki ste ga malo prej zbrisali.
-Spomnimo se, da lahko za veino ukazov v Emacsu doloimo, naj se
-izvedejo vekrat zaporedoma; to vkljuuje tudi vnos teksta. Ponovitev
-obiajnega znaka ga vekrat vrine v besedilo.
+Spomnimo se, da lahko za večino ukazov v Emacsu določimo, naj se
+izvedejo večkrat zaporedoma; to vključuje tudi vnos teksta. Ponovitev
+običajnega znaka ga večkrat vrine v besedilo.
>> Poskusite zdaj tole: da vnesete osem zvezdic, vtipkajte C-u 8 *
-Zdaj ste se nauili najpreprosteji nain, da v Emacsu nekaj natipkate
-in popravite. Briete lahko tudi besede ali vrstice. Tu je povzetek
+Zdaj ste se naučili najpreprostejši način, da v Emacsu nekaj natipkate
+in popravite. Brišete lahko tudi besede ali vrstice. Tu je povzetek
ukazov za brisanje:
- <Delback> pobrie znak tik pred kazalkom (levo od
- oznake za kazalek)
- C-d pobrie znak tik za kazalkom (,pod` oznako
- za kazalek)
+ <DEL> pobriše znak tik pred kazalčkom (levo od
+ oznake za kazalček)
+ C-d pobriše znak tik za kazalčkom (»pod« oznako
+ za kazalček)
- M-<Delback> pobrie besedo tik pred kazalkom
- M-d pobrie besedo tik za kazalkom
+ M-<DEL> pobriše besedo tik pred kazalčkom
+ M-d pobriše besedo tik za kazalčkom
- C-k zavre besedilo desno od kazalka do konca vrstice
- M-k zavre besedilo od poloaja kazalka do konca stavka
+ C-k zavrže besedilo desno od kazalčka do konca vrstice
+ M-k zavrže besedilo od položaja kazalčka do konca stavka
-rka ,d` je iz angleke besede ,delete` (pobrisati), rka ,k` pa iz
-besede ,kill` (pobiti). Ste opazili, da <Delback> in C-d na eni, ter
-M-<Delback> in M-d na drugi strani nadaljujeta paralelo, ki sta jo zaela
-C-f in M-f (<Delback> pravzaprav ni kontrolni znak, kar pa naj nas ne
+Črka »d« je iz angleške besede »delete« (pobrisati), črka »k« pa iz
+besede »kill« (pobiti). Ste opazili, da <DEL> in C-d na eni, ter
+M-<DEL> in M-d na drugi strani nadaljujeta paralelo, ki sta jo začela
+C-f in M-f (<DEL> pravzaprav ni kontrolni znak, kar pa naj nas ne
moti). C-k in M-k sta v enakem sorodu s C-e in M-e: prvi deluje na
vrstice, drugi na stavke.
-Obstaja tudi sploen postopek za brisanje kateregakoli dela delovnega
-podroja. Kazalek postavimo na en konec podroja, ki ga elimo
-izbrisati, in pritisnemo C-@ ali C-SPC (SPC je
-preslednica). Katerikoli od obeh ukazov deluje. Premaknite kazalek na
-drug konec podroja, ki ga elite izbrisati, in pritisnite C-w. S tem
-ste zavrgli vse besedilo med obema mejama.
+Obstaja tudi splošen postopek za brisanje kateregakoli dela delovnega
+področja. Kazalček postavimo na en konec področja, ki ga želimo
+izbrisati, in pritisnemo C-@ ali C-<SPC> (<SPC> je preslednica).
+Katerikoli od obeh ukazov deluje. Premaknite kazalček na drug konec
+področja, ki ga želite izbrisati. Med premikanjem Emacs z barvo
+označuje področje med kazalčkom in mestom, kjer ste pritisnili
+C-<SPC>. Končno pritisnite C-w. S tem ste zavrgli vse besedilo med
+obema mejama.
->> Premaknite kazalek na rko O, s katero se zaenja prejnji
+>> Premaknite kazalček na črko O, s katero se začenja prejšnji
odstavek.
->> Vtipkajte C-SPC. Emacs prikae sporoilo "Mark set" (slov. Oznaka
- postavljena) na dnu ekrana.
->> Premaknite kazalek na rko V v "postavimo" v drugi vrstici istega
+>> Vtipkajte C-SPC. Emacs prikaže sporočilo »Mark set« (slov. »oznaka
+ postavljena«) na dnu ekrana.
+>> Premaknite kazalček na črko V v »postavimo« v drugi vrstici istega
odstavka.
->> Vtipkajte C-w. S tem zavremo vse besedilo zaeni z O in vse do
- rke V.
-
-Razlika med tem, e zavrete cel odstavek besedila (angl. ,,kill``,
-pobiti) ali pa e pobriete znak (angl. ,,delete``), je ta, da lahko
-prvega vrnete nazaj z ukazom C-y, drugega pa ne. Na splono ukazi, ki
-lahko povzroijo veliko kode (pobriejo veliko besedila), shranijo
-pobrisano besedilo; tisti, ki pobriejo samo posamezni znak, ali samo
-prazne vrstice in presledke, pa ne.
-
->> Postavite kazalek na zaetek neprazne vrstice. Pritisnite C-k, da
- pobriete vsebino vrstice.
->> e enkrat pritisnite C-k. To pobrie e znak za novo vrstico.
-
-Ste opazili, da prvi C-k pobrie vsebino vrstice, naslednji C-k pa e
-vrstici samo, s imer se vse besedilo pod bivo vrstico premakne za
-eno vrstico navzgor? Ukaz C-k obravnava tevilni argument malo
-drugae: pobrie toliko in toliko vrstic z vsebinami vred. To ni zgolj
-ponovitev. C-u 2 C-k pobrie dve polni vrstici besedila, kar je nekaj
-drugega, kot e dvakrat vtipkate C-k.
-
-Besedilo, ki ste ga prej pobili, lahko povrnete (angl. ,,yank`` --
+>> Vtipkajte C-w. S tem zavržemo vse besedilo začenši z O in vse do
+ črke V.
+
+Razlika med tem, če zavržete cel odstavek besedila (angl. »kill«,
+pobiti) ali pa če pobrišete znak (angl. »delete«), je ta, da lahko
+prvega povrnete - na katerokoli mesto v besedilu - z ukazom C-y,
+drugega pa ne (seveda pa lahko prekličete brisanje - glejte nižje). Na
+splošno ukazi, ki lahko povzročijo veliko škode (pobrišejo veliko
+besedila), shranijo pobrisano besedilo; tisti, ki pobrišejo samo
+posamezni znak, ali samo prazne vrstice in presledke, pa ne.
+
+>> Postavite kazalček na začetek neprazne vrstice. Pritisnite C-k, da
+ pobrišete vsebino vrstice.
+>> Še enkrat pritisnite C-k. To pobriše še znak za novo vrstico.
+
+Ste opazili, da prvi C-k pobriše vsebino vrstice, naslednji C-k pa še
+vrstici samo, s čimer se vse besedilo pod bivšo vrstico premakne za
+eno vrstico navzgor? Ukaz C-k obravnava številčni argument malo
+drugače: pobriše toliko in toliko vrstic z vsebinami vred. To ni zgolj
+ponovitev. C-u 2 C-k pobriše dve polni vrstici besedila, kar je nekaj
+drugega, kot če dvakrat vtipkate C-k.
+
+Besedilo, ki ste ga prej pobili, lahko povrnete (angl. »yank« -
potegniti). Predstavljajte si, kot da potegnete nazaj nekaj, kar vam
je nekdo odnesel. Pobito besedilo lahko potegnete nazaj na isti ali pa
-na kaken drug kraj v besedilu, ali pa celo v kaki drugi
-datoteki. Isto besedilo lahko vekrat potegnete nazaj, tako da je v
-delovnem podroju poveterjeno.
+na kakšen drug kraj v besedilu, ali pa celo v kaki drugi datoteki.
+Isto besedilo lahko večkrat potegnete nazaj, tako da je v delovnem
+področju povečterjeno. Nekateri drugi urejevalniki uporabljajo namesto
+»kill« in »yank« izraza »cut« in »paste« (glejte glosar v priročniku
+za Emacs).
-Ukaz za vraanje pobitega besedila je C-y.
+Ukaz za vračanje pobitega besedila je C-y.
>> Poskusite z ukazom C-y povrniti pobrisano besedilo.
-e ste uporabili ve zaporednih ukazov C-k, je vse pobrisano besedilo
+Če ste uporabili več zaporednih ukazov C-k, je vse pobrisano besedilo
shranjeno skupaj, in en sam C-y bo vrnil vse tako pobrisane vrstice.
>> Poskusite, nekajkrat vtipkajte C-k.
Zdaj pa vrnimo pobrisano besedilo:
->> Vtipkajte C-y. Zdaj pa premaknite kazalek za nekaj vrstic navzdol
- in e enkrat vtipkajte C-y. Vidite zdaj, kako se kopira dele
+>> Vtipkajte C-y. Zdaj pa premaknite kazalček za nekaj vrstic navzdol
+ in še enkrat vtipkajte C-y. Vidite zdaj, kako se kopira dele
besedila?
-Kaj pa, e ste pobrisali nekaj besedila, ki bi ga radi vrnili, vendar
-ste za iskanim odlomkom pobrisali e nekaj? C-y vrne samo nazadnje
-pobrisan odlomek. Vendar tudi prejnje besedilo ni izgubljeno. Do
+Kaj pa, če ste pobrisali nekaj besedila, ki bi ga radi vrnili, vendar
+ste za iskanim odlomkom pobrisali še nekaj? C-y vrne samo nazadnje
+pobrisan odlomek. Vendar tudi prejšnje besedilo ni izgubljeno. Do
njega lahko pridete z ukazom M-y. Ko ste vrnili nazadnje zbrisano
besedilo s C-y, pritisnite M-y, ki ga zamenja s predzanje pobrisanim
-besedilom. Vsak naslednji M-y prikae e eno prej. Ko ste konno
-prili do iskanega besedila, ni treba napraviti ni posebnega, da bi
-ga obdrali. Preprosto nadaljujte z urejanjem, in vrnjeno besedilo bo
-ostalo, kamor ste ga odloili.
+besedilom. Vsak naslednji M-y prikaže še eno prej. Ko ste končno
+prišli do iskanega besedila, ni treba napraviti nič posebnega, da bi
+ga obdržali. Preprosto nadaljujte z urejanjem, in vrnjeno besedilo bo
+ostalo, kamor ste ga odložili.
-e pritisnete M-y dovolj velikokrat, se boste vrnili na zaete, torej
+Če pritisnete M-y dovolj velikokrat, se boste vrnili na začete, torej
spet na zadnje pobrisano besedilo.
->> Pobriite vrstico, premaknite se nekam drugam, in pobriite e
+>> Pobrišite vrstico, premaknite se nekam drugam, in pobrišite še
eno vrstico.
Z ukazom C-y dobite nazaj to drugo vrstico.
Z ukazom M-y pa jo zamenjate s prvo vrstico.
- Ponovite ukaz M-y e nekajkrat in si oglejte, kaj dobite na
- zaslon. Ponavljajte ga, dokler se ne prikae ponovno nazadnje
- pobrisana vrstica, in e naprej. e elite, lahko tudi ukazu
- M-y podate pozitivno ali negativno tevilo ponovitev.
+ Ponovite ukaz M-y še nekajkrat in si oglejte, kaj dobite na
+ zaslon. Ponavljajte ga, dokler se ne prikaže ponovno nazadnje
+ pobrisana vrstica, in še naprej. Če želite, lahko tudi ukazu
+ M-y podate pozitivno ali negativno število ponovitev.
* PREKLIC UKAZA (UNDO)
----------------------
-e ste besedilo spremenili, a ste se kasneje premislili, lahko
-besedilo vrnete v prvotno stanje z ukazom Undo, C-x u. Normalno vrne
-C-x u zadnjo spremembo besedila; e ukaz ponovimo, prekliemo e
-predzadnjo spremembo, in vsaka nadaljnja ponovitev see e eno
+Če ste besedilo spremenili, a ste se kasneje premislili, lahko
+besedilo vrnete v prvotno stanje z ukazom Undo, C-/.
+
+Običajno C-/ prekliče spremembo besedila, ki jo izvede en ukaz; če
+ukaz C-/ ponovimo, prekličemo še spremembo, ki jo je izvedel
+predzadnji ukaz, in vsaka nadaljnja ponovitev C-/ seže še eno
spremembo globlje v zgodovino.
-Emacs hrani bolj ali manj celotno zgodovino naih ukazov, z dvema
-izjemama: ukazov, ki niso napravili nobene spremembe v besedilu
-(npr. premik kazalka), ne shranjuje, in zaporedje do 20 vrinjenih
-znakov shrani kot en sam ukaz. Slednje prihrani nekaj ukazov C-x u, ki
-bi jih morali vtipkati.
+Emacs hrani bolj ali manj celotno zgodovino naših ukazov, z dvema
+izjemama: ukazov, ki niso napravili nobene spremembe v besedilu (npr.
+premik kazalčka), ne shranjuje, in zaporedje do 20 vrinjenih znakov
+shrani kot en sam ukaz. Slednje prihrani nekaj ukazov C-/, ki bi jih
+morali vtipkati.
->> Pobriite to vrstico z ukazom C-k, potem jo prikliite nazaj s C-x u.
+>> Pobrišite to vrstico z ukazom C-k, potem jo prikličite nazaj s C-/.
-C-_ je alternativni ukaz za preklic zadnjega ukaza. Deluje enako kot
-s C-x u, ga je pa laje odtipkati, e morate ukaz ponoviti vekrat
-zaporedoma. Teava z ukazom C-_ je, da na nekaterih tipkovnicah ni
-povsem oitno, kako ga vtipkati, zato je podvojen e kot C-x u. Na
-nekaterih terminalih moramo na primer vtipkati /, medtem ko drimo
-pritisnjeno tipko CONTROL.
+C-_ je alternativni ukaz za preklic zadnjega ukaza. Deluje povsem
+enako kot C-/. Na nekaterih besedilnih terminalih v resnici pritisk
+C-/ pošlje Emacsu ukaz C-_. Še tretja možnost je C-x u, ki tudi deluje
+povsem enako kot C-/, le z nekaj več tipkanja.
-e podamo ukazu C-_ ali C-x u numerini argument, je to enako, kot e
-bi ukaz rono ponovili tolikokrat, kot pravi argument.
+Če podamo ukazu C-/, C-_ ali C-x u numerični argument, je to enako,
+kot če bi ukaz ročno ponovili tolikokrat, kot pravi argument.
-Ukaz za brisanje besedila lahko prekliete in besedilo povrnete,
-enako, kot e bi besedilo pobili. Razlika med brisanjem in pobijanjem
-besedila je le ta, da le slednje lahko potegnete nazaj z ukazom
-C-y. Preklic ukaza pa velja za eno in drugo.
+Ukaz za brisanje besedila lahko prekličete in besedilo povrnete,
+enako, kot če bi besedilo pobili. Razlika med brisanjem in pobijanjem
+besedila je le ta, da le slednje lahko povrnete z ukazom C-y. Preklic
+ukaza pa velja za eno in drugo.
* DATOTEKE
@@ -493,638 +491,657 @@ C-y. Preklic ukaza pa velja za eno in drugo.
Da bi bile spremembe v besedilu trajne, morate besedilo shraniti v
datoteko. V nasprotnem primeru jih boste za vedno izgubili tisti hip,
ko boste zapustili Emacs. Besedilo postavimo v datoteko tako, da
-na disku ,,poiemo`` (angl. find) datoteko, preden zanemo tipkati
-(pravimo tudi, da ,,obiemo`` datoteko).
+na disku »poiščemo« (angl. find) datoteko, preden začnemo tipkati
+(pravimo tudi, da »obiščemo« datoteko).
Poiskati datoteko pomeni, da v Emacsu vidimo vsebino datoteke. To je
bolj ali manj tako, kot da z Emacsom urejamo datoteko samo. Vendar pa
spremembe ne postanejo trajne, dokler datoteke ne shranimo
-(angl. save) na disk. Tako imamo monost, da se izognemo temu, da bi
-nam na pol spremenjene datoteke leale po disku, kadar tega ne
-elimo. Ker pa Emacs ohrani izvorno datoteko pod spremenjenim imenom,
-lahko prvotno datoteko prikliemo nazaj celo e potem, ko smo datoteko
-e shranili na disk.
-
-V predzadnji vrstici na dnu zaslona vidite vrstico, ki se zane in
-kona z vezaji, in vsebuje niz znakov ,,--:-- TUTORIAL``. Ta del
-zaslona navadno vsebuje ime datoteke, ki smo jo obiskali. Zdajle je to
-,,TUTORIAL``, vaa delovna kopija ubenika Emacsa. Ko boste poiskali
-kakno drugo datoteko, bo na tem mestu pisalo njeno ime.
+(angl. save) na disk. Tako imamo možnost, da se izognemo temu, da bi
+nam na pol spremenjene datoteke ležale po disku, kadar tega ne
+želimo. Ker pa Emacs ohrani izvorno datoteko pod spremenjenim imenom,
+lahko prvotno datoteko prikličemo nazaj celo še potem, ko smo datoteko
+že shranili na disk.
+
+V predzadnji vrstici na dnu zaslona vidite vrstico, ki se začne z
+vezaji, na začetku pa vsebuje niz znakov »--:--- TUTORIAL« ali nekaj
+podobnega. Ta del zaslona navadno vsebuje ime datoteke, ki smo jo
+obiskali. Zdajle je to »TUTORIAL«, vaša delovna kopija učbenika
+Emacsa. Ko boste poiskali kakšno drugo datoteko, bo na tem mestu
+izpisano ime te datoteke.
Posebnost ukaza za iskanje datoteke je, da moramo povedati, katero
-datoteko iemo. Pravimo, da ukaz ,,prebere argument s terminala`` (v
-tem primeru je argument ime datoteke). Ko vtipkate ukaz
+datoteko iščemo. Pravimo, da ukaz »prebere argument« (v tem primeru je
+argument ime datoteke). Ko vtipkate ukaz
- C-x C-f (poii datoteko)
+ C-x C-f (poišči datoteko)
-vas Emacs povpraa po imenu datoteke. Kar vtipkate, se sproti vidi v
-vrstici na dnu zaslona. Temu delovnemu podroju pravimo pogovorni
+vas Emacs povpraša po imenu datoteke. Kar vtipkate, se sproti vidi v
+vrstici na dnu zaslona. Temu delovnemu področju pravimo pogovorni
vmesnik (minibuffer), kadar se uporablja za tovrstni vnos. Znotraj
-pogovornega vmesnika lahko uporabljate obiajne ukaze za urejanje, e
+pogovornega vmesnika lahko uporabljate običajne ukaze za urejanje, če
ste se na primer pri tipkanju zmotili.
Sredi tipkanja imena datoteke (ali katerega koli drugega opravila v
-pogovornem vmesniku) lahko ukaz prekliete s C-g.
+pogovornem vmesniku) lahko ukaz prekličete s C-g.
->> Vtipkajte C-x C-f, zatem pa e C-g. Zadnji ukaz od treh je
+>> Vtipkajte C-x C-f, zatem pa še C-g. Zadnji ukaz od treh je
zaprl pogovorni vmesnik in tudi preklical ukaz C-x C-f, ki je
uporabljal pogovorni vmesnik. Konec z iskanjem datoteke.
-Ko ste dokonali ime, ga vnesete s pritiskom na <Return>. S tem se
-poene ukaz C-x C-f in poie iskano datoteko. Pogovorni vmesnik
-izgine, ko je ukaz izveden.
+Ko ste dokončali ime, ga vnesete s pritiskom na <Return>. Pogovorni
+vmesnik izgine, ko je ukaz izveden.
-Trenutek kasneje se vsebina datoteke pojavi na zaslonu. Zdaj lahko
-dopolnjujete, urejate ali kako drugae spreminjate vsebino. Ko elite,
-da ostanejo spremembe trajne, izvedete ukaz:
+Vsebina datoteke se pojavi na zaslonu. Zdaj lahko dopolnjujete,
+urejate ali kako drugače spreminjate vsebino. Ko želite, da ostanejo
+spremembe trajne, izvedete ukaz:
C-x C-s (shrani datoteko)
-Besedilo se s tem shrani iz pomnilnika raunalnika na datoteko na
-disk. Ko prvi izvedete ta ukaz, se izvorna datoteka preimenuje, tako
+Besedilo se s tem shrani iz pomnilnika računalnika na datoteko na
+disk. Ko prvič izvedete ta ukaz, se izvorna datoteka preimenuje, tako
da ni izgubljena. Najdete jo pod novim imenom, ki se od starega
-razlikuje po tem, da ima na koncu pripet znak ,,~``.
+razlikuje po tem, da ima na koncu pripet znak »~«.
-Ko je Emacs shranil datoteko, izpie njeno ime. Shranjujte raje
-pogosteje kot ne, da v primeru, e gre z raunalnikom kaj narobe, ne
-izgubite veliko.
+Ko je Emacs shranil datoteko, izpiše njeno ime. Shranjujte raje
+pogosteje kot ne, da v primeru, če gre z računalnikom kaj narobe, ne
+izgubite veliko (oglejte si tudi razdelek o samodejnem shranjevanju
+nižje).
->> Vtipkajte C-x C-s, s imer boste shranili svojo kopijo tega
- ubenika. Emacs bo v vrstici na dnu zaslona izpisal ,,Wrote
- ...TUTORIAL``.
+>> Vtipkajte C-x C-s TUTORIAL <Return>.
+ S tem boste shranili svojo kopijo tega učbenika. Emacs bo v vrstici
+ na dnu zaslona izpisal »Wrote ...TUTORIAL«.
-Poiete lahko lahko e obstojeo datoteko, da si jo ogledate ali
-popravite, ali pa tudi datoteko, ki e ne obstaja. To je nain, kako z
-Emacsom ustvarimo novo datoteko: poiite datoteko z izbranim imenom,
-ki bo sprva prazna, in zanite pisati. Ko jo boste prvi shranili, bo
-Emacs ustvaril datoteko z vneenim besedilom. Od tod dalje delate na
-e obstojei datoteki.
+Poiščete lahko lahko že obstoječo datoteko, da si jo ogledate ali
+popravite, ali pa tudi datoteko, ki še ne obstaja. To je način, kako z
+Emacsom ustvarimo novo datoteko: poiščite datoteko z izbranim imenom,
+ki bo sprva prazna, in začnite pisati. Ko jo boste prvič shranili, bo
+Emacs ustvaril datoteko z vnešenim besedilom. Od tod dalje delate na
+že obstoječi datoteki.
-* DELOVNA PODROJA
+* DELOVNA PODROČJA
------------------
-Tudi e ste z ukazom C-x C-f poiskali in odprli drugo datoteko, prva
-ostane v Emacsu. Nanjo se vrnete tako, da jo e enkrat ,,poiete`` z
+Tudi če ste z ukazom C-x C-f poiskali in odprli drugo datoteko, prva
+ostane v Emacsu. Nanjo se vrnete tako, da jo še enkrat »poiščete« z
ukazom C-x C-f. Tako imate lahko v Emacsu hkrati kar precej datotek.
->> Ustvarite datoteko z imenom ,,bla`` tako, da vtipkate C-x C-f
- bla <Return>. Natipkajte nekaj besedila, ga po potrebi popravite, in
- shranite v datoteko ,,bla`` z ukazom C-x C-s. Ko ste konali, se
- vrnite v ubenik z ukazom C-x C-f TUTORIAL <Return>.
-
-Emacs hrani besedilo vsake datoteke v takoimenovanem ,,delovnem
-podroju`` (angl. buffer). Ko poiemo datoteko, Emacs ustvari zanjo
-novo delovno podroje. Vsa obstojea delovna podroja v Emacsu vidimo
+Emacs hrani besedilo vsake datoteke v takoimenovanem »delovnem
+področju« (angl. buffer). Ko poiščemo datoteko, Emacs ustvari zanjo
+novo delovno področje. Vsa obstoječa delovna področja v Emacsu vidimo
z ukazom:
- C-x C-b Seznam delovnih podroij.
+ C-x C-b Seznam delovnih področij.
>> Poskusite C-x C-b zdaj.
-Vidite, da ima vsako delovno podroje svoje ime, pri nekaterih pa pie
+Vidite, da ima vsako delovno področje svoje ime, pri nekaterih pa piše
tudi ime datoteke, katere vsebina se hrani v njem. Vsako besedilo, ki
-ga vidite v katerem od Emacsovih oken, je vedno del kaknega delovnega
-podroja.
+ga vidite v katerem od Emacsovih oken, je vedno del kakšnega delovnega
+področja.
->> Z ukazom C-x 1 se znebite seznama delovnih podroij.
+>> Z ukazom C-x 1 se znebite seznama delovnih področij.
-Tudi e imate ve delovnih podroij, pa je vedno le eno od njih
-trenutno dejavno. To je tisto delovno podroje, ki ga popravljate. e
-elite popravljati drugo delovno podroje, morate ,,preklopiti``
-nanj. e bi radi preklopili na delovno podroje, ki pripada kakni
-datoteki, e poznate en nain, kako to storiti: ponovno ,,obiete``
-(odprete) to datoteko z ukazom C-x C-f. Obstaja pa e laji nain: z
-ukazom C-x b. Pri tem ukazu morate navesti ime delovnega podroja.
+Tudi če imate več delovnih področij, pa je vedno le eno od njih
+trenutno dejavno. To je tisto delovno področje, ki ga popravljate. Če
+želite popravljati drugo delovno področje, morate »preklopiti«
+nanj. Če bi radi preklopili na delovno področje, ki pripada kakšni
+datoteki, že poznate en način, kako to storiti: ponovno »obiščete«
+(odprete) to datoteko z ukazom C-x C-f. Obstaja pa še lažji način: z
+ukazom C-x b. Pri tem ukazu morate navesti ime delovnega področja.
->> Vtipkajte C-x b bla <Return>, s imer se vrnete v delovno podroje
- ,,bla`` z vsebino datoteke ,,bla``, ki ste jo maloprej
- odprli. Zatem vtipkajte C-x b TUTORIAL <RETURN>, s imer se vrnete
- nazaj v ta ubenik.
+>> Ustvarite datoteko z imenom »bla« tako, da vtipkate C-x C-f bla
+ <Return>. Zatem se vrnite v ta učbenik z ukazom C-x C-f TUTORIAL
+ <Return>.
-Veinoma se ime delovnega podroja kar ujema z imenom datoteke (brez
-poti do datoteke), ne pa vedno. Seznam delovnih podroij, ki ga
-prikae ukaz C-x C-b, prikae imena vseh delovnih podroij.
+Večinoma se ime delovnega področja kar ujema z imenom datoteke (brez
+poti do datoteke), ne pa vedno. Seznam delovnih področij, ki ga
+prikaže ukaz C-x C-b, prikaže imena vseh delovnih področij in
+pripadajoča imena datotek.
Vsako besedilo, ki ga vidite v katerem od Emacsovih oken, je vedno del
-kaknega delovnega podroja. Nekatera delovna podroja ne pripadajo
-nobeni datoteki. Podroje ,,*Buffer List*``, na primer, je e eno
-takih. To delovno podroje smo ustvarili ravnokar, ko smo pognali ukaz
-C-x C-b, in vsebuje seznam delovnih podroij. Tudi delovno podroje
-,,Messages`` ne pripada nobeni datoteki, ampak vsebuje sporoila, ki
-jih je Emacs izpisoval v odzivnem podroju na dnu zaslona.
-
->> Vtipkajte C-x b *Messages* <Return> in si oglejte delovno podroje
- s sporoili, zatem pa vtipkajte C-x b TUTORIAL <Return> in se tako
- vrnite v ubenik.
-
-e ste spreminjali besedilo ene datoteke, potem pa poiskali drugo, to
+kakšnega delovnega področja. Nekatera delovna področja ne pripadajo
+nobeni datoteki. Področje »*Buffer List*«, na primer, je že eno takih.
+To delovno področje smo ustvarili ravnokar, ko smo pognali ukaz C-x
+C-b, in vsebuje seznam delovnih področij. Temu delovnemu področju
+TUTORIAL sprva ni pripadala datoteka, zdaj pa mu, ker smo v prejšnjem
+razdelku vtipkali C-x C-s in ga shranili v datoteko.
+
+Tudi delovno področje »Messages« ne pripada nobeni datoteki, ampak
+vsebuje sporočila, ki jih je Emacs izpisoval v odzivnem področju na
+dnu zaslona.
+
+>> Vtipkajte C-x b *Messages* <Return> in si oglejte delovno področje
+ s sporočili, zatem pa vtipkajte C-x b TUTORIAL <Return> in se tako
+ vrnite v učbenik.
+
+Če ste spreminjali besedilo ene datoteke, potem pa poiskali drugo, to
ne shrani spremeb v prvo datoteko. Te ostanejo znotraj Emacsa, na
-delovnem podroju, ki pripada prvi datoteki. Ustvarjenje ali
-spreminjanje delovnega podroja druge datoteke nima nobenega vpliva na
-podroje prve. To je zelo uporabno, pomeni pa tudi, da potrebujemo
-udobno pot, da shranimo delovno podroje prve datoteke. Nerodno bi
-bilo preklapljanje na prvo podroje s C-x C-f, da bi shranili s C-x
+delovnem področju, ki pripada prvi datoteki. Ustvarjenje ali
+spreminjanje delovnega področja druge datoteke nima nobenega vpliva na
+področje prve. To je zelo uporabno, pomeni pa tudi, da potrebujemo
+udobno pot, da shranimo delovno področje prve datoteke. Nerodno bi
+bilo preklapljanje na prvo področje s C-x C-f, da bi shranili s C-x
C-s. Namesto tega imamo:
- C-x s Shrani nekatera delovna podroja
+ C-x s Shrani nekatera delovna področja
-Ukaz C-x poie delovna podroja, katerih vsebina je bila spremenjena,
-odkar je bila zadnji shranjena na datoteko. Za vsako tako delovno
-podroje C-x s vpraa, e ga elite shraniti.
+Ukaz C-x poišče delovna področja, katerih vsebina je bila spremenjena,
+odkar je bila zadnjič shranjena na datoteko. Za vsako tako delovno
+področje C-x s vpraša, če ga želite shraniti.
-* RAZIRJEN NABOR UKAZOV
+* RAZŠIRJEN NABOR UKAZOV
------------------------
-e mnogo, mnogo je ukazov Emacsa, ki bi zasluili, da jih obesimo na
+Še mnogo, mnogo je ukazov Emacsa, ki bi zaslužili, da jih obesimo na
razne kontrolne in meta znake. Emacs se temu izogne z ukazom X (iz angl.
-eXtend - raziriti), ki uvede ukaz iz razirjenega nabora. Dveh vrst je:
+eXtend - razširiti), ki uvede ukaz iz razširjenega nabora. Dveh vrst je:
- C-x Znakovna raziritev (angl. Character eXtend).
+ C-x Znakovna razširitev (angl. Character eXtend).
Sledi mu en sam znak.
- M-x Raziritev s poimenovanim ukazom. Sledi mu dolgo ime
+ M-x Razširitev s poimenovanim ukazom. Sledi mu dolgo ime
ukaza.
-Tudi ti ukazi so na splono uporabni, ne uporabljamo pa jih tako
-pogosto kot tiste, ki ste se jih e nauili. Dva ukaza iz razirjenega
-nabora e poznamo: C-x C-f, s katerim poiemo datoteko, in C-x C-s, s
-katerim datoteko shranimo. e en primer je ukaz, s katerim Emacsu
-povemo, da elimo konati z delom iz iziti iz Emacsa. Ta ukaz je C-x
-C-c (ne skrbite: preden kona, Emacs ponudi, da shrani vse spremenjene
+Tudi ti ukazi so na splošno uporabni, ne uporabljamo pa jih tako
+pogosto kot tiste, ki ste se jih že naučili. Dva ukaza iz razširjenega
+nabora že poznamo: C-x C-f, s katerim poiščemo datoteko, in C-x C-s, s
+katerim datoteko shranimo. Še en primer je ukaz, s katerim Emacsu
+povemo, da želimo končati z delom iz iziti iz Emacsa. Ta ukaz je C-x
+C-c (ne skrbite: preden konča, Emacs ponudi, da shrani vse spremenjene
datoteke).
-Z ukazom C-z Emacs zapustimo samo *zaasno*, tako da lahko ob vrnitvi
-nadaljujemo z delom, kjer smo ostali.
+Če uporabljate grafični vmesnik, ne potrebujete posebnega ukaza za
+preklop iz Emacsa v katerikoli drug program, ampak to opravite z miško
+ali ukazom upravljalnika oken. Če pa uporabljate besedilni terminal,
+ki lahko prikazuje le en program naenkrat, morate začasno zapustiti
+Emacs, da preklopite na drug program.
-Na sistemih, ki to dopuajo, ukaz C-z izide iz Emacsa v ukazno
-lupino, a ga ne kona - e uporabljate ukazno lupino C, se lahko
-vrnete z ukazom ,fg` ali sploneje z ukazom ,,%emacs``.
+Z ukazom C-z Emacs zapustimo samo *začasno*, tako da lahko ob vrnitvi
+nadaljujemo z delom, kjer smo ostali. Na sistemih, ki to dopuščajo,
+ukaz C-z izide iz Emacsa v ukazno lupino, a ga ne konča - če
+uporabljate ukazno lupino C, se lahko vrnete z ukazom »fg« ali
+splošneje z ukazom »%emacs«.
-Drugod ukaz C-z poene sekundarno ukazno lupino, tako da lahko
-poenete kaken drug program in se kasneje vrnete v Emacs. V tem
-primeru pravzaprav Emacsa ne zapustimo. Ukaz ,,exit`` v ukazni lupini
-je navadno nain, da zapremo sekundarno lupino in se vrnemo v Emacs.
+Drugod ukaz C-z požene sekundarno ukazno lupino, tako da lahko
+poženete kakšen drug program in se kasneje vrnete v Emacs. V tem
+primeru pravzaprav Emacsa ne zapustimo. Ukaz »exit« v ukazni lupini
+je navadno način, da zapremo sekundarno lupino in se vrnemo v Emacs.
-Ukaz C-x C-c uporabimo, e se nameravamo odjaviti s sistema. To je
-tudi pravilen nain za izhod iz Emacsa, e je tega pognal program za
-delo s poto ali kak drug program, saj ta verjetno ne ve, kaj
-napraviti z zaasno prekinjenim Emacsom. V vseh ostalih primerih pa,
-e se ne nameravate odjaviti s sistema, uporabite C-z, in se vrnite v
-Emacs, ko bi radi spet urejali besedilo.
+Ukaz C-x C-c uporabimo, če se nameravamo odjaviti s sistema. To je
+tudi pravilen način za izhod iz Emacsa, če je tega pognal program za
+delo s pošto ali kak drug program.
Ukazov C-x je veliko. Zaenkrat smo spoznali naslednje:
- C-x C-f Poii datoteko.
+ C-x C-f Poišči datoteko.
C-x C-s Shrani datoteko.
- C-x C-b Prikai seznam delovnih podroij.
- C-x C-c Konaj Emacs.
+ C-x C-b Prikaži seznam delovnih področij.
+ C-x C-c Končaj Emacs.
C-x 1 Zapri vsa okna razen enega.
C-x u Preklic zadnjega ukaza.
-Poimenovani razirjeni ukazi so ukazi, ki se uporabljajo e bolj
-poredko, ali pa se uporabljajo samo v nekaterih nainih dela. Eden
+Poimenovani razširjeni ukazi so ukazi, ki se uporabljajo še bolj
+poredko, ali pa se uporabljajo samo v nekaterih načinih dela. Eden
takih je na primer ukaz replace-string, ki po vsem besedilu zamenja en
-niz znakov z drugim. Ko vtipkate M-x, se to izpie v pogovornem
-vmesniku na dnu zaslona, Emacs pa aka, da vtipkate ime ukaza, ki ga
-elite priklicati; v tem primeru je to ,,replace-string``. Vtipkajte
-samo ,,repl s<TAB>`` in Emacs bo dopolnil ime (<TAB> je tabulatorska
+niz znakov z drugim. Ko vtipkate M-x, se to izpiše v pogovornem
+vmesniku na dnu zaslona, Emacs pa čaka, da vtipkate ime ukaza, ki ga
+želite priklicati; v tem primeru je to »replace-string«. Vtipkajte
+samo »repl s<TAB>« in Emacs bo dopolnil ime (<TAB> je tabulatorska
tipka; navadno jo najdemo nad tipko Caps Lock ali Shift na levi strani
tipkovnice). Ukaz vnesete s pritiskom na <Return>.
-Ukaz replace-string potrebuje dva argumenta -- niz, ki ga elite
+Ukaz replace-string potrebuje dva argumenta -- niz, ki ga želite
zamenjati, in niz, s katerim bi radi zamenjali prvega. Vsakega posebej
-vnesete in zakljuite s pritiskom na tipko Return.
+vnesete in zaključite s pritiskom na tipko Return.
->> Premaknite kazalek na prazno vrstico dve vrstici pod to, zatem
+>> Premaknite kazalček na prazno vrstico dve vrstici pod to, zatem
vtipkajte M-x repl s<Return>zamenjala<Return>spremenila<Return>.
Opazite, kako se je ta vrstica zamenjala? Vse besede
z-a-m-e-n-j-a-l-a od tod do konca besedila ste nadomestili z besedo
- ,,spremenila``.
+ »spremenila«.
-* AVTOMATINO SHRANJEVANJE
+* AVTOMATIČNO SHRANJEVANJE
--------------------------
-Spremembe v datoteki, ki jih e niste shranili na disk, so izgubljene,
-e medtem denimo zmanjka elektrike. Da bi vas zavaroval pred tem,
-Emacs periodino avtomatino shrani vse datoteke, ki jih
-urejate. Avtomatino shranjena datoteka se od izvorne razlikuje po
-znaku ,#` na zaetku in koncu imena: e se je vaa datoteka imenovala
-,,hello.c``, se avtomatino shranjena datoteka imenuje
-,,#hello.c#``. Ko normalno shranite datoteko, avtomatino shranjena
-datoteka ni ve potrebna, in Emacs jo pobrie.
+Spremembe v datoteki, ki jih še niste shranili na disk, so izgubljene,
+če medtem denimo zmanjka elektrike. Da bi vas zavaroval pred tem,
+Emacs periodično avtomatično shrani vse datoteke, ki jih
+urejate. Avtomatično shranjena datoteka se od izvorne razlikuje po
+znaku »#« na začetku in koncu imena: če se je vaša datoteka imenovala
+»hello.c«, se avtomatično shranjena datoteka imenuje
+»#hello.c#«. Ko normalno shranite datoteko, avtomatično shranjena
+datoteka ni več potrebna, in Emacs jo pobriše.
-e res pride do izgube podatkov v pomnilniku, lahko povrnete avtomatino
-shranjeno besedilo tako, da normalno poiete datoteko (pravo ime
-datoteke, ne ime avtomatino shranjene datoteke), zatem pa vtipkate M-x
-recover file<Return>. Ko vas vpraa za potrditev, vtipkajte yes<Return>
-za nadaljevanje in povrnitev avtomatino shranjenenih podatkov.
+Če res pride do izgube podatkov v pomnilniku, lahko povrnete avtomatično
+shranjeno besedilo tako, da normalno poiščete datoteko (pravo ime
+datoteke, ne ime avtomatično shranjene datoteke), zatem pa vtipkate M-x
+recover-file <Return>. Ko vas vpraša za potrditev, vtipkajte yes<Return>
+za nadaljevanje in povrnitev avtomatično shranjenenih podatkov.
-* ODZIVNO PODROJE
+* ODZIVNO PODROČJE
------------------
-Kadar Emacs opazi, da poasi vtipkavate ukaz, odpre v zadnji vrstici
-na dnu zaslona odzivno podroje in v njem sproti prikazuje natipkano.
+Kadar Emacs opazi, da počasi vtipkavate ukaz, odpre v zadnji vrstici
+na dnu zaslona odzivno področje in v njem sproti prikazuje natipkano.
* STATUSNA VRSTICA
------------------
-Vrstica nad odzivnim podrojem je statusna vrstica. Ta kae verjetno
+Vrstica nad odzivnim področjem je statusna vrstica. Ta kaže verjetno
nekaj podobnega kot:
---:** TUTORIAL (Fundamental)--L670--58%----------------------
+--:**- TUTORIAL (Fundamental)--L670--58%----------------------
V njej so izpisani pomembni podatki o stanju Emacsa in besedilu, ki ga
urejate.
-Zdaj e veste, kaj pomeni ime datoteke -- to je datoteka, ki ste jo
-poiskali. Oznaka --NN%-- pomeni, da je nad vrhom zaslona e NN
-odstotkov celotne datoteke. e je zaetek datoteke na zaslonu, bo
-namesto --00%-- pisalo --Top--. Podobno bo pisalo --Bot--, e je
-zadnja vrstica datoteke na zaslonu. e je datoteka, ki jo ogledujete,
-tako kratka, da gre vsa na en zaslon, pa bo pisalo --All--.
+Zdaj že veste, kaj pomeni ime datoteke -- to je datoteka, ki ste jo
+poiskali. Oznaka --NN%-- pomeni, da je nad vrhom zaslona še NN
+odstotkov celotne datoteke. Če je začetek datoteke na zaslonu, bo
+namesto »0%« pisalo »Top«. Podobno bo pisalo »Bot«, če je
+zadnja vrstica datoteke na zaslonu. Če je datoteka, ki jo ogledujete,
+tako kratka, da gre vsa na en zaslon, pa bo pisalo »All«.
-rka L in tevilke za njo kaejo poloaj e drugae, kot zaporedno
-tevilko vrstice, v kateri je kazalek.
+Črka L in številke za njo kažejo položaj še drugače, kot zaporedno
+številko vrstice, v kateri je kazalček.
-Zvezdice na zaetku vrstice pomenijo, da ste datoteko e spreminjali.
+Zvezdice na začetku vrstice pomenijo, da ste datoteko že spreminjali.
Tik po tem, ko ste odprli ali shranili datoteko, ni nobenih zvezdic,
-so samo rtice.
+so samo črtice.
-Del statusne vrstice znotraj oklepajev vam pove, v kaknem nainu dela
-Emacs. Privzeti nain je osnovni nain (Fundamental), v katerem ste
-sedaj. Fundamental je eden od glavnih nainov (angl. major
-mode). Emacs pozna veliko razlinih glavnih nainov. Nekateri od njih
+Del statusne vrstice znotraj oklepajev vam pove, v kakšnem načinu dela
+Emacs. Privzeti način je osnovni način (Fundamental), v katerem ste
+sedaj. Fundamental je eden od glavnih načinov (angl. major
+mode). Emacs pozna veliko različnih glavnih načinov. Nekateri od njih
so namenjeni pisanju programov, kot na primer Lisp, ali pisanju
-besedil, kot npr. Text. Naenkrat je lahko aktiven le en glavni nain,
-njegovo ime pa je vedno izpisano v statusni vrstici, kjer zdaj pie
+besedil, kot npr. Text. Naenkrat je lahko aktiven le en glavni način,
+njegovo ime pa je vedno izpisano v statusni vrstici, kjer zdaj piše
Fundamental.
-Glavni naini lahko spremenijo pomen nekaterim ukazom. Obstajajo,
+Glavni načini lahko spremenijo pomen nekaterim ukazom. Obstajajo,
denimo, ukazi za pisanje komentarjev v programu, in ker ima vsak
programski jezik svoje predstave o tem, kako mora komentar izgledati,
-mora vsak glavni nain vnesti komentarje drugae. Ker je vsak glavni
-nain ime razirjenega ukaza, lahko tako tudi izbiramo glavni
-nain. Na primer, M-x fundamental-mode vas postavi v nain
+mora vsak glavni način vnesti komentarje drugače. Ker je vsak glavni
+način ime razširjenega ukaza, lahko tako tudi izbiramo glavni
+način. Na primer, M-x fundamental-mode vas postavi v način
Fundamental.
-e nameravate popravljati slovensko (ali angleko) besedilo, kot je na
-primer tole, boste verjetno izbrali tekstovni nain (Text).
->> Vtipkajte M-x text mode<Return>.
+Če nameravate popravljati slovensko (ali angleško) besedilo, kot je na
+primer tole, boste verjetno izbrali tekstovni način (Text).
+>> Vtipkajte M-x text-mode <Return>.
-Brez skrbi, noben od ukazov Emacsa, ki ste se jih nauili, se s tem ne
-spremeni kaj dosti. Lahko pa opazite, da Emacs zdaj jemlje opuaje za
-dele besed, ko se premikate z M-f ali M-b. V osnovnem nainu jih je
+Brez skrbi, noben od ukazov Emacsa, ki ste se jih naučili, se s tem ne
+spremeni kaj dosti. Lahko pa opazite, da Emacs zdaj jemlje opuščaje za
+dele besed, ko se premikate z M-f ali M-b. V osnovnem načinu jih je
obravnaval kot meje med besedami.
-Glavni naini navadno poenjajo majhne spremembe, kot je ta: veina
-ukazov ,,opravi isti posel``, vendar pa to ponejo na razlien nain.
+Glavni načini navadno počenjajo majhne spremembe, kot je ta: večina
+ukazov »opravi isti posel«, vendar pa to počnejo na različen način.
-Dokumentacijo o trenutno aktivnem glavnem nainu dobite z ukazom C-h m.
+Dokumentacijo o trenutno aktivnem glavnem načinu dobite z ukazom C-h m.
->> Uporabite C-u C-v enkrat ali vekrat, toliko, da bo ta vrstica blizu
- vrha zaslona.
->> Vtipkajte C-h m, da vidite, v em se tekstovni nain (Text) razlikuje
+>> Vtipkajte C-l C-l, da postavite to vrstico na vrh zaslona.
+>> Vtipkajte C-h m, da vidite, v čem se tekstovni način (Text) razlikuje
od osnovnega (Fundamental).
>> Vtipkajte C-x 1, da umaknete dokumentacijo z zaslona.
-Glavnim nainom pravimo glavni naini zato, ker obstajajo tudi
-podnaini (angl. minor modes). Podnaini ne nadomeajo glavnih
-nainom, ampak le spreminjajo njihovo obnaanje. Podnaine lahko
-aktiviramo ali deaktiviramo neodvisno od glavnega naina in neodvisno
-od ostalih podnainov. Tako lahko ne uporabljate nobenega podnaina,
-en podnain, ali kombinacijo veih podnainov.
+Glavnim načinom pravimo glavni načini zato, ker obstajajo tudi
+podnačini (angl. minor modes). Podnačini ne nadomeščajo glavnih
+načinom, ampak le spreminjajo njihovo obnašanje. Podnačine lahko
+aktiviramo ali deaktiviramo neodvisno od glavnega načina in neodvisno
+od ostalih podnačinov. Tako lahko ne uporabljate nobenega podnačina,
+en podnačin, ali kombinacijo večih podnačinov.
-Podnain, ki je zelo uporaben posebno za pisanje besedil, je Auto
-Fill. Ko je vklopljen, Emacs med pisanjem avtomatino deli vrstice na
+Podnačin, ki je zelo uporaben posebno za pisanje besedil, je Auto
+Fill. Ko je vklopljen, Emacs med pisanjem avtomatično deli vrstice na
presledkih med besedami, tako da vrstice niso predolge.
-Vklopite ga lahko z ukazom M-x auto fill mode<Return>. Ko je
-vklopljen, ga lahko izklopite z istim ukazom, M-x
-auto fill mode<Return>. Z istim ukazom torej preklapljamo
-(angl. toggle) med vklopljenim in izklopljenim stanjem.
+Vklopite ga lahko z ukazom M-x auto-fill-mode <Return>. Ko je
+vklopljen, ga lahko izklopite z istim ukazom, M-x auto-fill-mode
+<Return>. Z istim ukazom torej preklapljamo (angl. toggle) med
+vklopljenim in izklopljenim stanjem.
->> Vtipkajte zdaj M-x auto fill mode<Return>. Potem zanite tipkati
- "asdf asdkl sdjf sdjkf"... dokler ne opazite, da je Emacs razbil
+>> Vtipkajte zdaj M-x auto-fill-mode <Return>. Potem začnite tipkati
+ »asdf asdkl sdjf sdjkf«... dokler ne opazite, da je Emacs razbil
vrstico na dve. Med tipkanjem mora biti dovolj presledkov, saj
Auto Fill prelamlja vrstice samo na presledkih.
-irina besedila je navadno postavljena na 70 znakov, kar pa lahko
-spremenite z ukazom C-x f. Novo irino morate podati kot tevilni
+Širina besedila je navadno postavljena na 70 znakov, kar pa lahko
+spremenite z ukazom C-x f. Novo širino morate podati kot številčni
argument.
>> Vtipkajte C-x f in argument 20. (C-u 2 0 C-x f). Zatem vtipkajte
- nekaj besedila in poglejte, e bo Emacs res delil vrstice pri 20
+ nekaj besedila in poglejte, če bo Emacs res delil vrstice pri 20
znakih. Potem z ukazom C-x f postavite mejo nazaj na 70.
-Auto Fill deluje le, kadar piete novo besedilo, ne pa,
-kadar popravljate e napisan odstavek.
-Tak odstavek lahko poravnate tako, da kazalek premaknete nekam
-znotraj odstavka in ukaete M-q (META-q).
+Auto Fill deluje le, kadar pišete novo besedilo, ne pa,
+kadar popravljate že napisan odstavek.
+Tak odstavek lahko poravnate tako, da kazalček premaknete nekam
+znotraj odstavka in ukažete M-q (META-q).
->> Premaknite kazalek v prejnji odstavek in izvedite M-q.
+>> Premaknite kazalček v prejšnji odstavek in izvedite M-q.
* ISKANJE
---------
-Emacs lahko v besedilu poie niz znakov (zaporedje znakov ali besed),
-naprej ali nazaj po besedilu. Iskanje spada v skupino ukazov za
-premikanje kazalka, saj premakne kazalek na kraj v besedilu, kjer je
-nael iskani niz.
+Emacs lahko v besedilu poišče niz znakov (»niz« je zaporedje soslednih
+znakov), naprej ali nazaj po besedilu. Iskanje spada v skupino ukazov
+za premikanje kazalčka, saj premakne kazalček na kraj v besedilu, kjer
+je našel iskani niz.
-Iskanje v Emacsu je morda nekoliko drugano od tistega, ki ste ga
-navajeni, in sicer je ,,inkrementalno``. To pomeni, da se iskanje
-odvija hkrati s tem, ko tipkate iskani niz.
+Iskanje v Emacsu je »inkrementalno«. To pomeni, da se iskanje odvija
+hkrati s tem, ko tipkate iskani niz.
Ukaza za iskanje sta C-s za iskanje naprej po datoteki in C-r za
-iskanje nazaj po datoteki. POAKAJTE! Ne preizkuajte jih e ta hip!
+iskanje nazaj po datoteki. POČAKAJTE! Ne preizkušajte jih še ta hip!
-Ko boste natipkali C-s, boste opazili niz ,,I-search`` kot pozivnik
+Ko boste natipkali C-s, boste opazili niz »I-search« kot pozivnik
v pogovornem vmesniku. To vam pove, da je Emacs v inkrementalnem iskanju
-in vas aka, da zanete tipkati, kar iete. <Return> zakljui iskanje.
-
->> Pritisnite zdaj C-s. POASI, rko za rko, vtipkajte besedo
- ,,kazalek``. Za vsako vtipkano rko se ustavite in si oglejte, kaj
- se je zgodilo s kazalkom.
->> e enkrat pritisnite C-s, da poiete naslednji ,,kazalek``.
->> estkrat pritisnite <Delback> in opazujte, kako se premika kazalek.
->> Konajte iskanje s tipko <Return>.
-
-Ste videli, kaj se je zgodilo? Emacs pri inkrementalnem iskanju skua
-poiskati niz, ki ste ga natipkali do tistega hipa. Da poiete
-naslednje mesto, kjer se pojavi ,,kazalek``, samo e enkrat
-pritisnete C-s. e takega mesta ni, Emacs ivkne in vam sporoi, da
+in vas čaka, da začnete tipkati, kar iščete. <Return> zaključi iskanje.
+
+>> Pritisnite zdaj C-s. POČASI, črko za črko, vtipkajte besedo
+ »kazalček«. Za vsako vtipkano črko se ustavite in si oglejte, kaj
+ se je zgodilo s kazalčkom.
+>> Še enkrat pritisnite C-s, da poiščete naslednji »kazalček«.
+>> Šestkrat pritisnite <DEL> in opazujte, kako se premika kazalček.
+>> Končajte iskanje s tipko <Return>.
+
+Ste videli, kaj se je zgodilo? Emacs pri inkrementalnem iskanju skuša
+poiskati niz, ki ste ga natipkali do tistega hipa. Da poiščete
+naslednje mesto, kjer se pojavi »kazalček«, samo še enkrat
+pritisnete C-s. Če takega mesta ni, Emacs čivkne in vam sporoči, da
iskanje ni uspelo. Tudi C-g prekine iskanje.
-OPOZORILO: Na nekaterih sistemih bo s pritiskom na C-s ekran
-zmrznil. To je znak, da je operacijski sistem prestregel znak C-s in
-ga interpretiral kot znak za prekinitev toka podatkov, namesto da bi
-ga posredoval programu Emacs. Ekran ,,odtajate`` s pritiskom na
-C-q. Potem si oglejte razdelek ,,Spontaneous Entry to Incremental
-Search`` v prironiku za nasvet, kako se spopasti s to nevenostjo.
-
-e sredi inkrementalnega iskanja pritisnete <Delback>, boste opazili,
-da to pobrie zadnji znak v iskanem nizu, kazalek pa se premakne
-nazaj na mesto v besedilu, kjer je nael kraji niz. Na primer,
-predpostavimo, da ste do zdaj natipkali ,,ka`` in je kazalek na
-mestu, kjer se prvi pojavi ,,ka``. e zdaj pritisnete <Delback>, boste
-s tem v pogovornem vmesniku izbrisali ,a`, hkrati pa se bo kazalek
-postavil na mesto, kjer je prvi nael ,k`, preden ste natipkali e
-,a`.
-
-e sredi iskanja vtipkate katerikoli kontrolni znaki ali metaznak
+Če sredi inkrementalnega iskanja pritisnete <DEL>, boste opazili,
+da to pobriše zadnji znak v iskanem nizu, kazalček pa se premakne
+nazaj na mesto v besedilu, kjer je našel krajši niz. Na primer,
+predpostavimo, da ste do zdaj natipkali »ka« in je kazalček na
+mestu, kjer se prvič pojavi »ka«. Če zdaj pritisnete <DEL>, boste
+s tem v pogovornem vmesniku izbrisali »a«, hkrati pa se bo kazalček
+postavil na mesto, kjer je prvič našel »k«, preden ste natipkali še
+»a«.
+
+Če sredi iskanja vtipkate katerikoli kontrolni znaki ali metaznak
(razen tistih, ki imajo poseben pomen pri iskanju, to sta C-s in C-r),
se iskanje prekine.
-C-s zane iskati na mestu v datoteki, kjer trenutno stoji kazalek, in
-ie do konca datoteke. e bi radi iskali proti zaetku datoteke,
+C-s začne iskati na mestu v datoteki, kjer trenutno stoji kazalček, in
+išče do konca datoteke. Če bi radi iskali proti začetku datoteke,
namesto C-s vtipkamo C-r. Vse, kar smo povedali o ukazu C-s, velja
tudi za C-r, le smer iskanja je obrnjena.
-* VE OKEN NA ZASLONU
+* VEČ OKEN NA ZASLONU
---------------------
-Ena simpatinih lastnosti Emacsa je, da zna hkrati prikazati ve oken
-na ekranu, tudi e ne delamo v grafinem nainu.
+Ena simpatičnih lastnosti Emacsa je, da zna hkrati prikazati več oken
+na zaslonu, tudi če ne delamo v grafičnem načinu. (Opozorimo naj, da
+Emacs uporablja izraz »okvir« (angl. »frame«) - razložen je v
+naslednjem razdelku - za tisto, čemur nekateri drugi programi pravijo
+»okno« (angl. »window«). Priročnik za Emacs vsebuje glosar
+uporabljenih izrazov.)
->> Premaknite kazalek v to vrstico in vtipkajte C-u 0 C-l (zadnji
- znak je CONTROL-L, ne CONTROL-1)
+>> Premaknite kazalček v to vrstico in vtipkajte C-l C-l.
>> Zdaj vtipkajte C-x 2, da razdelite zaslon na dve okni.
- V obeh oknih imate odprt ta prironik. Kazalek je ostal v zgornjem
+ V obeh oknih imate odprt ta priročnik. Kazalček je ostal v zgornjem
oknu.
>> Pritisnite C-M-v za listanje v spodnjem oknu.
- (e nimate tipke META, tipkajte ESC C-v).
->> Vtipkajte C-x o (o kot ,,other``, drugi), da preselite kazalek v
+ (Če nimate tipke META, tipkajte ESC C-v).
+>> Vtipkajte C-x o (o kot »other«, drugi), da preselite kazalček v
spodnje okno.
->> S C-v in M-v se v spodnjem oknu premikate po vsebini datoteke.
- Zgornje okno e vedno kae ta navodila.
->> Ponovni C-x o vas vrne v zgornje okno. Kazalek se je vrnil na
- mesto, kjer je bil, preden smo skoili v spodnje okno.
+>> Z ukazoma C-v in M-v se v spodnjem oknu premikate po vsebini
+ datoteke. Zgornje okno še vedno kaže ta navodila.
+>> Ponovni C-x o vas vrne v zgornje okno. Kazalček se je vrnil na
+ mesto, kjer je bil, preden smo skočili v spodnje okno.
-Z ukazom C-x o lahko preklapljamo med okni. Vsako okno si zapomni, kje
-v oknu je ostal kazalek, samo trenutno aktivno okno pa kazalek tudi
-v resnici prikae. Vsi obiajni ukazi za urejanje, ki smo se jih
-nauili, veljajo za aktivno okno.
+Z ukazom C-x o lahko preklapljamo med okni. Izbrano okno, torej tisto,
+v katerem urejamo besedilo, je tisto z zelo opaznim kazalčkom, ki
+utripa, kadar ne tipkamo. Tudi ostala okna pa si zapomnijo, kje je
+ostal kazalček. Če poganjate Emacs v grafičnem načinu, je položaj
+kazalčka v teh oknih prikazan kot ne-utripajoč črtni pravokotnik.
Ukaz C-M-v je zelo uporaben, kadar urejamo besedilo v enem oknu,
-drugega pa uporabljamo samo za pomo. Kazalek ostaja ves as v oknu,
-v katerem urejamo, po vsebini spodnjega okna pa se vseeno lahko
-premikamo, ne da bi morali venomer skakati iz enega okna v drugega.
+drugega pa uporabljamo samo za pomoč. Ne da bi zapustili izbrano okno,
+se lahko premikamo po vsebini drugega okna z ukazon C-M-v.
-C-M-v je primer znaka CONTROL-META. e imate v resnici tipko META (na
-PC navadno levi Alt), lahko vtipkate C-M-v tako, da drite pritisnjeni
+C-M-v je primer znaka CONTROL-META. Če imate v resnici tipko META (na
+PC navadno levi Alt), lahko vtipkate C-M-v tako, da držite pritisnjeni
tako CONTROL kot META, medtem ko vtipkate v. Ni pomembno, katero od
-tipk, CONTROL ali META, pritisnete prvo, saj obe delujeta ele, ko
-pritisnete znak, ki sledi (v zgornjem primeru ,v`).
+tipk, CONTROL ali META, pritisnete prvo, saj obe delujeta šele, ko
+pritisnete znak, ki sledi (v zgornjem primeru »v«).
-Nasprotno pa je vrstni red pritiskanja pomemben, e nimate tipke META
-in namesto nje uporabljate ESC. V tem primeru morate najprej
-pritisniti ESC, potem pa Control-v. Obratna kombinacija, CONTROL-ESC v
-ne deluje. To je zato, ker je ESC znak sam po sebi, ne pa modifikator,
-kot sta CONTROL in META.
+Nasprotno pa je vrstni red pritiskanja pomemben, če nimate tipke META
+in namesto nje uporabljate <ESC>. V tem primeru morate najprej
+pritisniti <ESC>, potem pa Control-v. Obratna kombinacija,
+CONTROL-<ESC> ne deluje. To je zato, ker je <ESC> znak sam po sebi, ne
+pa modifikator, kot sta CONTROL in META.
>> V zgornjem oknu vtipkajte C-x 1, da se znebite spodnjega okna.
-(e bi vtipkali C-x 1 v spodnjem oknu, bi se znebili
-zgornjega. Razmiljajte o tem ukazu kot ,,Obdri samo eno okno, in
-sicer tisto, v katerem sem zdaj.``)
+(Če bi vtipkali C-x 1 v spodnjem oknu, bi se znebili
+zgornjega. Razmišljajte o tem ukazu kot »Obdrži samo eno okno, in
+sicer tisto, v katerem sem zdaj.«)
-Seveda ni nujno, da obe okni kaeta isto delovno podroje. e v enem
-oknu izvedete C-x C-f in poiete novo datoteko, se vsebina drugega
+Seveda ni nujno, da obe okni kažeta isto delovno področje. Če v enem
+oknu izvedete C-x C-f in poiščete novo datoteko, se vsebina drugega
okna ne spremeni. V vsakem oknu lahko neodvisno obdelujete drugo
datoteko.
-Pa e ena pot, kako v dveh oknih prikaete dve razlini datoteki:
+Pa še ena pot, kako v dveh oknih prikažete dve različni datoteki:
->> Vtipkajte C-x 4 C-f, in na pozivnik vtipkajte ime ene vaih
- datotek. Konajte z <Return>. Odpre se e eno okno in izbrana
- datoteka se pojavi v drugem oknu. Tudi kazalek se preseli v drugo
+>> Vtipkajte C-x 4 C-f, in na pozivnik vtipkajte ime ene vaših
+ datotek. Končajte z <Return>. Odpre se še eno okno in izbrana
+ datoteka se pojavi v drugem oknu. Tudi kazalček se preseli v drugo
okno.
>> Vtipkajte C-x o, da se vrnete nazaj v zgornje okno, in C-x 1, da
zaprete spodnje okno.
+* VEČ HKRATNIH OKVIROV
+----------------------
+
+Emacs lahko ustvari tudi več »okvirov«. Okvir je zbirka oken, skupaj z
+menuji, drsniki, pogovornim vmesnikom ipd. V grafičnem načinu je
+Emacsov »okvir« tisto, čemur večina drugih programov pravi »okno«. Če
+delate v grafičnem načinu, je lahko več okvirov hkrati prikazanih na
+zaslonu. V besedilnem terminalu imamo seveda na voljo le en okvir.
+
+>> Vtipkajte M-x make-frame <Return>
+ Opazite, kako se je na zaslonu pojavil nov okvir.
+
+Vse, kar ste počeli v prvotnem okviru, lahko počnete tudi v novem.
+Prvi okvir ni v ničemer poseben.
+
+>> Vtipkajte M-x delete-frame <Return>
+ Ukaz izbriše izbrani okvir.
+
+Okvir lahko izbrišete tudi z običajnim načinom, ki ga ponuja grafični
+sistem - pogosto s klikom na simbol »X« v enem od zgornjih kotov okna.
+Če zaprete zadnji okvir, s tem obenem zaprete tudi Emacs.
+
+
* REKURZIVNI NIVOJI UREJANJA
----------------------------
-Vasih boste prili v nekaj, emur se pravi ,,rekurzivni nivo
-urejanja``. To se vidi po tem, da v statusni vrstici oglati oklepaji
-oklepajo ime glavnega naina. V osnovnem nainu bi, na primer, videli
+Včasih boste prišli v nekaj, čemur se pravi »rekurzivni nivo
+urejanja«. To se vidi po tem, da v statusni vrstici oglati oklepaji
+oklepajo ime glavnega načina. V osnovnem načinu bi, na primer, videli
[(Fundamental)] namesto (Fundamental).
-Iz rekurzivnega nivoja urejanja se reite, e vtipkate ESC ESC ESC. To
-zaporedje je vsenamenski ukaz ,,pojdi ven``. Uporabite ga lahko tudi
-za ukinjanje odvenih oken, ali vrnitev iz pogovornega vmesnika.
+Iz rekurzivnega nivoja urejanja se rešite, če vtipkate ESC ESC ESC. To
+zaporedje je vsenamenski ukaz »pojdi ven«. Uporabite ga lahko tudi
+za ukinjanje odvečnih oken, ali vrnitev iz pogovornega vmesnika.
>> Pritisnite M-x, da odprete pogovorni vmesnik, zatem pa vtipkajte
ESC ESC ESC, da pridete ven iz njega.
Z ukazom C-g ne morete iz rekurzivnega nivoja urejanja, ker C-g
-preklie ukaze ali argumente ZNOTRAJ rekurzivnega nivoja.
+prekliče ukaze ali argumente ZNOTRAJ rekurzivnega nivoja.
-* DODATNA POMO
+* DODATNA POMOČ
---------------
-V tem uvodu smo poskuali zbrati dovolj informacij, da lahko zanete
-Emacs uporabljati. Emacs ponuja toliko, da bi bilo nemogoe vse to
-zbrati tukaj. Verjetno pa bi se vseeno radi nauili kaj o tevilnih
-koristnih monostih, ki jih e ne poznate. Emacs ima e vgrajene
+V tem uvodu smo poskušali zbrati dovolj informacij, da lahko začnete
+Emacs uporabljati. Emacs ponuja toliko, da bi bilo nemogoče vse to
+zbrati tukaj. Verjetno pa bi se vseeno radi naučili kaj o številnih
+koristnih možnostih, ki jih še ne poznate. Emacs ima že vgrajene
veliko dokumentacije, do katere lahko pridete s pritiskom na CONTROL-h
-(h kot ,,help``, pomo).
+(h kot »help«, pomoč).
-Za pomo pritisnete C-h, potem pa vtipkate znak, ki pove, kakno pomo
-elite. e ste poplnoma izgubljeni, vtipkajte C-h ? in Emacs vam bo
-povedal, kakna pomo je sploh na voljo. e ste vtipkali C-h, pa ste
-si premislili, lahko ukaz prekliete s C-g.
+Za pomoč pritisnete C-h, potem pa vtipkate znak, ki pove, kakšno pomoč
+želite. Če ste poplnoma izgubljeni, vtipkajte C-h ? in Emacs vam bo
+povedal, kakšna pomoč je sploh na voljo. Če ste vtipkali C-h, pa ste
+si premislili, lahko ukaz prekličete s C-g.
-(Na nekaterih sistemih se znak C-h preslika v kaj drugega. To ni
-dobro, in v takem primeru se pritoite sistemskemu vzdrevalcu. Medtem
-pa, e C-h ne prikae sporoila o pomoi na dnu zaslona, namesto tega
-poskusite pritisniti tipko F1 ali pa vtipkajte M-x help <Return>.)
+(Če C-h ne prikaže sporočila o pomoči na dnu zaslona, poskusite
+namesto tega pritisniti tipko F1 ali pa vtipkajte M-x help <Return>.)
-Najosnovneji tip pomoi prikae C-h c. Pritisnite C-h, tipko c, zatem
+Najosnovnejši tip pomoči prikaže C-h c. Pritisnite C-h, tipko c, zatem
pa ukazni znak ali zaporedje ukaznih znakov, in Emacs bo izpisal
kratek opis ukaza.
>> Vtipkajte C-h c C-p.
- Izpie se nekaj takega kot
+ Izpiše se nekaj takega kot
C-p runs the command previous-line
-Ukaz je izpisal ime funkcije, ki izvede ukaz. Imena funkcij
-uporabljamo, kadar piemo prilagoditve in raziritve Emacsa. Ker pa so
-navadno imena funkcij izbrana tako, da kaj povedo o tem, kaj funkcija
-pone, bo verjetno to tudi dovolj za kratko osveitev, e ste se z
-ukazom e kdaj sreali.
+Ukaz je izpisal ime funkcije, ki izvede ukaz. Ker so navadno imena
+funkcij izbrana tako, da kaj povedo o tem, kaj funkcija počne, bo
+verjetno to tudi dovolj za kratko osvežitev, če ste se z ukazom že
+kdaj srečali.
Ukazu C-h lahko sledi tudi zaporedje znakov, kot na primer C-x C-s,
-ali, e nimate tipke META, <Esc>v.
+ali, če nimate tipke META, <Esc>v.
-Za ve informacij o ukazu vtipkajte C-h k namesto C-h c.
+Za več informacij o ukazu vtipkajte C-h k namesto C-h c.
>> Vtipkajte C-h k C-p.
-To odpre novo okno in v njem prikae dokumentacijo o funkciji, obenem
+To odpre novo okno in v njem prikaže dokumentacijo o funkciji, obenem
z njenim imenom. Ko ste opravili, vtipkajte C-x 1, da se znebite okna
-z pomojo. Tega seveda ni potrebno napraviti takoj, ampak lahko
-urejate, medtem ko imate odprto okno s pomojo, in ga zaprete, ko ste
-konali.
+z pomočjo. Tega ni potrebno napraviti ta hip. Namesto tega lahko
+urejate, medtem ko imate odprto okno s pomočjo, in ga zaprete, ko ste
+končali.
-Sledi e nekaj uporabnih monosti, ki jih ponuja pomo:
+Sledi še nekaj uporabnih možnosti, ki jih ponuja pomoč:
- C-h f Opii funkcijo. Kot argument morate podati ime
+ C-h f Opiši funkcijo. Kot argument morate podati ime
funkcije.
->> Poskusite C-h f previous-line<Return>.
- To izpie vse podatke, ki jih ima Emacs o funkciji, ki izvede ukaz C-p.
+>> Poskusite C-h f previous-line <Return>.
+ To izpiše vse podatke, ki jih ima Emacs o funkciji, ki izvede ukaz C-p.
-Podoben ukaz C-h v izpie dokumentacijo za spremenljivke, s katerimi
-lahko nastavite obnaanje Emacsa. Ob pozivniku morate vpisati ime
-spremenljivke.
+Podoben ukaz C-h v izpiše dokumentacijo za spremenljivke, vključno s
+tistimi, s katerimi lahko nastavite obnašanje Emacsa. Ob pozivniku
+morate vpisati ime spremenljivke.
- C-h a Apropos. Vtipkajte kljuno besedo in Emacs bo izpisal
- vse ukaze, ki vsebujejo to kljuno besedo. Vse te
- ukaze lahko prikliete z META-x. Pri nekaterih ukazih
+ C-h a Apropos. Vtipkajte ključno besedo in Emacs bo izpisal
+ vse ukaze, ki vsebujejo to ključno besedo. Vse te
+ ukaze lahko prikličete z META-x. Pri nekaterih ukazih
bo Apropos izpisal tudi eno ali dvoznakovno
- zaporedje, s katerim doseete isti uinek.
+ zaporedje, s katerim dosežete isti učinek.
->> Vtipkajte C-h a file<Return>.
+>> Vtipkajte C-h a file <Return>.
To odpre novo okno, v katerem so vsa dolga imena ukazov, ki vsebujejo
-,,file`` v imenu. Izvedete jih lahko z M-x. Pri nekaterih se izpie
+»file« v imenu. Izvedete jih lahko z M-x. Pri nekaterih se izpiše
tudi kratek ukaz, npr. C-x C-f ali C-x C-w pri ukazih find-file in
write-file.
->> Pritisnite C-M-v, da se sprehajate po oknu s pomojo. Poskusite
+>> Pritisnite C-M-v, da se sprehajate po oknu s pomočjo. Poskusite
nekajkrat.
->> Vtipkajte C-x 1, da zaprete okno s pomojo.
+>> Vtipkajte C-x 1, da zaprete okno s pomočjo.
- C-h i Prironiki z navodili za uporabo (tkim. datoteke
- "info"). Ta ukaz vas prestavi v posebno delovno
- podroje, imenovano "info". V njem lahko prebirate
- prironike za programe, ki so nameeni v sistemu. Z
- ukazom m emacs<Return> denimo dobite prironik za
- urejevalnik Emacs. e sistema Info e niste
+ C-h i Priročniki z navodili za uporabo (tkim. datoteke
+ »info«). Ta ukaz vas prestavi v posebno delovno
+ področje, imenovano »*info*«. V njem lahko prebirate
+ priročnike za programe, ki so nameščeni v sistemu. Z
+ ukazom m emacs<Return> denimo dobite priročnik za
+ urejevalnik Emacs. Če sistema Info še niste
uporabljali, vtipkajte ? in Emacs vas bo popeljal na
- vdeni izlet po nainu Info in monostih, ki jih
- ponuja. Ko boste zakljuili z branjem tega prvega
- berila, bo prironik za Emacs v sistemu Info va
+ vódeni izlet po načinu Info in možnostih, ki jih
+ ponuja. Ko boste zaključili z branjem tega prvega
+ berila, bo priročnik za Emacs v sistemu Info vaš
glavni vir dokumentacije.
-* DRUGE MONOSTI
+* DRUGE MOŽNOSTI
----------------
-e ve se lahko nauite o Emacsu z branjem prironika, bodisi
-natisnjenega, bodisi na zaslonu v sistemu Info (uporabite menu Help
-ali vtipkajte F10 h r). Dve monosti, ki vam bosta morda posebej ve,
-sta samodejno zakljuevanje vrstice, s katerim prihranite nekaj
-tipkanja, in dired, s katerim poenostavimo delo z datotekami.
+Še več se lahko naučite o Emacsu z branjem priročnika, bodisi
+natisnjenega, bodisi znotraj samega Emacsa (uporabite menu Help ali
+vtipkajte C-h r). Dve možnosti, ki vam bosta morda posebej všeč, sta
+samodejno zaključevanje vrstice, s katerim prihranite nekaj tipkanja,
+in dired, s katerim poenostavimo delo z datotekami.
-Samodejno zakljuevanje vrstic je nain, s katerim prihranimo nekaj
-tipkanja. e elite denimo preklopiti v delovno podroje *Messages*,
+Samodejno zaključevanje vrstic je način, s katerim prihranimo nekaj
+tipkanja. Če želite denimo preklopiti v delovno področje *Messages*,
je dovolj, da vtipkate C-x b *M<Tab> in Emacs bo sam dopolnil
-preostanek imena delovnega podroja. Samodejno zakljuevanje je
-opisano v sistemu Info v prironiku za Emacs, razdelek ,,Completion``.
+preostanek imena delovnega področja. Samodejno zaključevanje deluje
+tudi za imena ukazov in imena datotek. Samodejno zaključevanje je
+opisano v priročniku za Emacs, razdelek »Completion«.
-Dired omogoa izpis seznama datotek v imeniku (in po monosti tudi
+Dired omogoča izpis seznama datotek v imeniku (in po možnosti tudi
podimenikih), premikanje po seznamu, obiskovanje (odpiranje),
preimenovanje, brisanje in druge operacije z datotekami. Dired je
-opisav v sistemu Info v prironiku za Emacs, razdelek ,,Dired``.
+opisav v priročniku za Emacs, razdelek »Dired«.
-Prironik opisuje tudi mnoge druge monosti Emacsa.
+Priročnik opisuje tudi mnoge druge možnosti Emacsa.
-* ZAKLJUEK
+* ZAKLJUČEK
-----------
-Zapomnite si, da Emacs zapustite z ukazom C-x C-c. e bi radi samo
-zaasno skoili v ukazno lupino in se kasneje vrnili v Emacs, pa
-storite to z ukazom C-z.
+Emacs zapustite z ukazom C-x C-c.
-Ta ubenik je napisan z namenom, da bi bil razumljiv vsem novincem v
-Emacsu. e se vam kaj ne zdi jasno napisano, ne valite krivde nase -
-pritoite se!
+Ta učbenik je napisan z namenom, da bi bil razumljiv vsem novincem v
+Emacsu. Če se vam kaj ne zdi jasno napisano, ne valite krivde nase -
+pritožite se!
-* RAZMNOEVANJE IN RAZIRJANJE
+* RAZMNOŽEVANJE IN RAZŠIRJANJE
------------------------------
-Angleki izvirnik tega uvoda v Emacs je naslednik dolge vrste tovrstnih
-besedil, zaeni s tistim, ki ga je Stuart Cracraft napisal za izvorni
-Emacs. V slovenino ga je prevedel Primo Peterlin.
+Angleški izvirnik tega uvoda v Emacs je naslednik dolge vrste tovrstnih
+besedil, začenši s tistim, ki ga je Stuart Cracraft napisal za izvorni
+Emacs. V slovenščino ga je prevedel Primož Peterlin.
To besedilo, kot sam GNU Emacs, je avtorsko delo, in njegovo
-razmnoevanje in razirjanje je dovoljeno pod naslednjimi pogoji:
+razmnoževanje in razširjanje je dovoljeno pod naslednjimi pogoji:
+
+Copyright © 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
-Copyright (C) 1985, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+ Ta datoteka je del paketa GNU Emacs.
- Dovoljeno je izdelovati in razirjati neokrnjene kopije tega spisa
- v kakrnikoli obliki pod pogojem, da je ohranjena navedba o
- avtorstvu in to dovoljenje, ter da distributer dovoljuje prejemniku
- nadaljnje razirjanje pod pogoji, navedenimi v tem dovoljenju.
+ GNU Emacs je prost program; lahko ga redistribuirate in/ali prirejate
+ po pogojih, določenih v dovoljenju za rabo »GNU General Public License«,
+ izdanem pri Free Software Foundation, bodisi 3. izdaje tega dovoljenja,
+ bodisi katerekoli kasnejše izdaje, ki je na voljo.
- Pod pogoji iz prejnjega odstavka je dovoljeno razirjati
- spremenjene verzije tega spisa ali njegovih delov, e je jasno
- oznaeno, kdo je nazadnje vnesel spremembe.
+ GNU Emacs je ponujen v dobri veri, da je uporaben, vendar zanj NI
+ NOBENEGA JAMSTVA, niti implicitnih jamstev PRIMERNOSTI ZA PRODAJO
+ ali USTREZNOSTI ZA DOLOČEN NAMEN. Podrobnosti so na voljo v »GNU
+ General Public License«.
-Pogoji za razmnoevanje in razirjanje samega Emacsa so malo drugani,
-a v istem duhu. Prosimo, preberite datoteko COPYING in potem dajte
-kopijo programa GNU Emacs svojim prijateljem. Pomagajte zatreti
-obstrukcionizem (,,lastnitvo``) v programju tako, da uporabljate,
-piete in delite prosto programje!
+ Kopijo »GNU General Public License« bi morali prejeti skupaj s paketom
+ GNU Emacs. Če je niste, je na voljo na <http://www.gnu.org/licenses/>.
+
+Prosimo, preberite datoteko COPYING in potem ponudite kopijo programa
+GNU Emacs svojim prijateljem. Pomagajte zatreti obstrukcionizem
+(»lastništvo«) v programju tako, da uporabljate, pišete in delite
+prosto programje!
;;; Local Variables:
-;;; coding: iso-latin-2
+;;; coding: utf-8
;;; sentence-end-double-space: nil
;;; End:
-
diff --git a/etc/tutorials/TUTORIAL.sv b/etc/tutorials/TUTORIAL.sv
index 1960d35fff5..3f721e5f455 100644
--- a/etc/tutorials/TUTORIAL.sv
+++ b/etc/tutorials/TUTORIAL.sv
@@ -11,6 +11,7 @@ ALT eller EDIT). Vi anvnder hr fljande frkortningar:
den och trycker sedan <chr>.
Viktigt: Fr att avsluta Emacs trycker du C-x C-c (tv tecken).
+Fr att avsluta kommandon som inte skrivits in fullt, tryck C-g.
Tecknen ">>" i vnstermarginalen anger att du kan prova ett
kommando. Till exempel:
<<Tomma rader stts in runt nsta rad nr help-with-tutorial aktiveras>>
@@ -45,7 +46,9 @@ Fljande kommandon r bra fr att se hela skrmbilder:
>> Leta reda p markren och se vad som str dr. Tryck sedan C-l.
Hitta markren igen och notera att det r samma text som str kring
- markren nu.
+ markren nu, men nu mitt p skrmen. Om du trycker C-l igen s
+ flyttas texten hgst upp p skrmen. Tryck C-l igen och den flyttas
+ ner till botten.
Du kan ocks anvnda PageUp och PageDn tangenterna, om din terminal
har dem, fr att flytta en hel skrmbild t gngen, men du redigerar
@@ -77,8 +80,8 @@ fyra piltangenterna. S hr:
Detta r enklare att komma ihg om du tnker p dessa frkortningar: P
fr fregende (previous), N fr nsta (next), B fr bakt (backward)
-och F fr framt (forward). Dessa r de grundlggande kommandona fr
-att flytta markren och du kommer att anvnda dem hela tiden.
+och F fr framt (forward). Du kommer att anvnda dessa grundlggande
+kommandona hela tiden.
>> Gr ngra C-n s att du kommer ned till den hr raden.
@@ -223,22 +226,16 @@ uppt.
Detta borde ha flyttat skrmbilden 8 rader uppt. Om du nskar flytta
tillbaka igen r det bara att ge samma argument till M-v.
-Om du anvnder Emacs under ett fnstersystem, som X11 eller
-MS-Windows, finns det troligen ett rektangulrt omrde p sidan
-av Emacs-fnstret, en s kallad rullningslist. Genom att klicka i den
-med musen kan du rulla texten.
+Om du anvnder ett fnstersystem, som X eller MS-Windows, finns det
+troligen ett rektangulrt omrde p sidan av Emacs-fnstret, en s
+kallad rullningslist. Genom att klicka i den med musen kan du rulla
+texten.
->> Prova att trycka med den mellersta musknappen i det utvalda omrdet
- p rullningslisten. Detta br flytta skrmbilden till en plats i
- texten beroende p var i rullningslisten du trycker.
+Om din mus har ett rullningshjul kan ven den anvndas fr att rulla
+texten.
->> Prova att flytta musen upp och ner medan du hller ner den
- mellersta musknappen. Du ser att texten rullar upp och ner beroende
- p hur du fr musen.
-
-
-* OM EMACS HNGER
------------------
+* OM EMACS SLUTAR SVARA
+-----------------------
Om Emacs slutar att reagera p kommandon kan du lugnt stoppa dem genom
att trycka C-g. Du kan ocks anvnda C-g fr att stoppa ett kommando
@@ -264,9 +261,9 @@ Om du provar ett av dessa sprrade kommandon kommer Emacs ge ett
meddelande som berttar vilket kommando det r och kommer att frga om
du verkligen vill fortstta och utfra detta kommando.
-Om du verkligen nskar att utfra kommandot trycker du mellanslag som
-svar p frgan. Normalt, om du inte nskar att utfra detta kommando,
-svarar du "n" p frgan.
+Om du verkligen nskar att utfra kommandot skriver du <SPC>,
+(mellanslagstangenten) som svar p frgan. Normalt, om du inte nskar
+att utfra detta kommando, svarar du "n" p frgan.
>> Skriv C-x C-l (som r ett sprrat kommando).
Skriv n som svar p frgan.
@@ -275,8 +272,8 @@ svarar du "n" p frgan.
* FNSTER
---------
-Emacs kan ha flera fnster och varje fnster kan visa sin egen text.
-Vi kommer frklara senare hur man anvnder flera fnster. Hr skall vi
+Emacs kan ha flera "fnster" dr varje kan visa sin egen text. Vi
+kommer frklara senare hur man anvnder flera fnster. Hr skall vi
frklara hur man blir av med extra fnster fr att komma tillbaka till
det grundlggande lget med endast ett fnster. Det r enkelt:
@@ -289,53 +286,50 @@ tas bort.
>> Flytta markren till den hr raden och tryck C-u 0 C-l.
>> Tryck C-h k C-f.
Se hur det hr fnstret krymper samtidigt som ett nytt upptrder
- fr att visa dokumentationen fr C-f-kommandot.
+ fr att visa dokumentationen av C-f-kommandot.
>> Sl C-x 1 och se hur dokumentationsfnstret nu frsvinner.
Kommandot skiljer sig lite frn andra kommandon du har lrt dig
-eftersom det bestr av tv tecken. Det startar med tecknet
-KONTROLL-x. Det r faktisk mnga kommandon som startar med KONTROLL-x
-och mnga av dem har med filer, skrmbilder och liknande saker att
-gra. Dessa kommandon r tv, tre eller fyra tecken lnga.
+eftersom det bestr av tv tecken. Det startar med tecknet KONTROLL-x.
+Det finns mnga kommandon som startar med KONTROLL-x och mnga av dem
+har med filer, skrmbilder och liknande saker att gra. Dessa
+kommandon r tv, tre eller fyra tecken lnga.
* SKRIVA OCH TA BORT TEXT
-------------------------
-Om du nskar att stta in text r det bara att skriva in
-texten. Tecken som du kan se, s som A, 7, *, etc. tolkas som text och
-stts in direkt. Skriv <Return> (retur-tangenten) fr att stta in en
-radbrytning.
+Om du nskar att stta in text r det bara att skriva in texten.
+Vanliga tecken, som A, 7, *, etc., stts in direkt nr du skriver dem.
+Tryck p <Return> fr att stta in en radbrytning. (Det r den tangent
+p tangentbordet som ibland r mrkt med "Enter")
-Du kan radera det sista tecknet du skrev genom att trycka <Delback>.
-<Delback> r en tangent p tangentbordet -- samma som du normalt
-anvnder utanfr Emacs fr att ta bort det senaste tecknet du skrivit.
-Det r vanligen en stor tangent ngra rader ovanfr retur-tangenten,
-och den r vanligtvis mrkt "Delete, "Del" eller "Backspace".
+Fr att radera tecknet omedelbart fre aktuell markrposition, tryck
+p <DEL>. Det r tangenten p tangentbordet som vanligtvis r markerad
+med "Backspace" -- det r samma tangent som du normal anvnder fr att
+radera det sist inmatade tecknet utanfr Emacs.
-Om den stora tangenten r mrkt med "Backspace" s r det den du
-anvnder fr <Delback>. Det kan finnas en annan tangent som r mrkt
-med "Delete" men det r inte <Delback>.
-
-Generellt raderar <Delback> tecknet precis fre den aktuella
-markrspositionen.
+Det kan finnas en annan tangent p ditt tangentbordet som r mrkt med
+"Delete", men det r inte den vi menar med <DEL>.
>> Gr detta nu: Skriv in ngra tecken och ta bort dem genom att
- anvnda <Delback>. Var inte rdd fr att skriva i den hr filen,
- du kommer inte att kunna frndra originalet till vgledningen.
- Detta r bara en lokal kopia.
+ anvnda <DEL>. Var inte rdd fr att skriva i den hr filen, du
+ kommer inte att kunna frndra originalet till vgledningen. Detta
+ r bara en lokal kopia.
Nr en rad blir fr lng fr att rymmas p en skrmbredd s fortstter
-den p raden under. Ett bakstreck ("\") (eller om du kr under ett
-fnstersystem, en liten bjd pil) i slutet av hgermarginalen
-indikerar att raden fortstter.
+den p raden under. Om du anvnder ett fnstersystem, visas sm bjda
+pilar i det lilla utrymmet p bgge sidor om textmassan (i vnster och
+hger marginal) fr att ange var en rad fortstter, Om du anvnder
+en textterminal anges med ett bakstreck ("\") i kolumnen lngst till
+hger att raden fortstter.
>> Skriv in lite text s att du kommer till slutet av raden och
fortstt att skriva lite till. Du kommer d att se hur
fortsttningstecknet ser ut.
->> Anvnd <Delback> fr att radera texten tills raden ryms p en
+>> Anvnd <DEL> fr att radera texten tills raden ryms p en
skrmbredd igen. Fortsttningstecknet kommer d att frsvinna.
Du kan radera radbrytning precis som andra tecken. Genom att radera
@@ -343,7 +337,7 @@ radbrytningen mellan tv rader sls dessa samman till en. Om
resultatet av denna sammanslagning blir fr stor fr att passa inom en
skrmbredd, s kommer den att visas med ett fortsttningstecken.
->> Flytta markren till brjan av en rad och tryck <Delback>.
+>> Flytta markren till brjan av en rad och tryck <DEL>.
Detta kommer att klistra ihop raden med raden ver.
>> Tryck <Return> fr att stta in radbrytningen du tog bort.
@@ -358,28 +352,30 @@ Du har nu lrt dig de mest grundlggande stten att skriva ngot i
Emacs och att rtta fel. Du kan radera ord och rader ocks. Hr r en
versikt ver kommandon fr radering:
- <Delback> Raderar tecknet som str precis fre markren
+ <DEL> Raderar tecknet som str precis fre markren
C-d Raderar tecknet som str precis under markren
- M-<Delback> Raderar ordet precis fre markren
+ M-<DEL> Raderar ordet precis fre markren
M-d Raderar ordet precis efter markren
C-k Raderar frn markren till slutet av raden
M-k Raderar till slutet av stycket
-Lgg mrke till att <Delback> och C-d kontra M-<Delback> och M-d
-fljer mnstret som brjade med C-f och M-f. (<Delback> r inte precis
-ett kontrolltecken men lt oss inte bry oss om det.) C-k och M-k
-fungerar p samma stt som C-e och M-e (nstan).
+Lgg mrke till att <DEL> och C-d kontra M-<DEL> och M-d fljer
+mnstret som brjade med C-f och M-f. (<DEL> r inte precis ett
+kontrolltecken men lt oss inte bry oss om det.) C-k och M-k fungerar
+p liknande stt som C-e och M-e nr det gller rader respektive
+meningar.
-Du kan ocks ta bort vilken del som helst av texten med hjlp av
-fljande allmnna metod. Flytta till ena nden av det omrde du vill
-ta bort och tryck C-@ eller C-mellanslag. Flytta till andra nden av
-omrdet och tryck C-w. Detta tar bort all text mellan de tv
-positionerna.
+Du kan ocks ta bort en del av en texten med hjlp av fljande
+allmnna metod. Flytta till ena nden av det omrde du vill ta bort
+och tryck C-<SPC>. (<SPC> r mellanslagstangenten.) Flytta sedan till
+andra nden av omrdet du vill ta bort. Nr du gr det markerar Emacs
+texten mellan markren och den plats dr du tryckte C-<SPC>. Slutligen,
+tryck C-w. Detta tar bort texten mellan de tv positionerna.
>> Flytta markren till bokstaven D i fregende stycke.
->> Tryck C-mellanslag. Emacs skall nu visa meddelandet "Mark set"
+>> Tryck C-<SPC>. Emacs skall nu visa meddelandet "Mark set"
lngst ner p skrmen.
>> Flytta markren till bokstaven o i ordet metod p andra raden i
stycket.
@@ -387,12 +383,15 @@ positionerna.
o.
Skillnaden mellan att "ta bort" (killing) och "radera" (deleting) text
-r att "borttagen" text kan hmtas tillbaka, medan raderad text inte
-kan det. terinsttning av borttagen text kallas "terhmtning"
-(yanking). Generellt kan man sga att kommandon som tar bort fler n
-ett tecken sparar undan texten (s att den kan terhmtas) medan
-kommandon som bara raderar ett tecken eller tomma rader och mellanrum
-inte sparar ngonting (och den texten kan allts inte terhmtas).
+r att "borttagen" text kan sttas tillbaka (var som helst), medan
+raderad text inte kan det p det sttet. (Du kan dock ngra en
+radering--se nedan.) terinsttning av borttagen text kallas
+"terhmtning" (yanking). Generellt kan man sga att kommandon som
+tar bort fler n ett tecken sparar undan texten (s att den kan
+terhmtas) medan kommandon som bara raderar ett tecken, eller bara
+raderar tomma rader och mellanrum inte sparar ngonting (och den
+texten kan allts inte terhmtas). <DEL> och C-d raderar i det enkla
+fallet utan argument. Med argument s tar de bort i stllet.
>> Flytta markren till brjan av en rad som inte r tom.
Tryck C-k fr att ta bort texten p raden.
@@ -412,7 +411,9 @@ tagits bort.) Du kan antingen hmta tillbaka borttagen text till samma
plats som dr den blev borttagen, eller s kan du stta in den p en
annan plats i texten du redigerar eller till och med i en helt annan
fil. Du kan ocks hmta tillbaka samma text flera gnger s att du fr
-flera lika frekomster av den.
+flera kopior av den. Ngra andra textredigerare kallar "ta bort" och
+"terhmta" att "klippa ut" respektive "klistra in" (Se ordlistan i
+Emacs-manualen)
Kommandot fr att hmta tillbaka text r C-y. Kommandot hmtar
tillbaka den sist borttagna texten och placerar den dr markren r.
@@ -455,28 +456,26 @@ till startpunkten (texten som sist blev borttagen).
-------
Om du gr en frndring i texten och sedan ngrar dig, s kan du
-upphva ndringen med kommandot C-x u (undo).
+upphva ndringen med ngra-kommandot C-/.
-Normalt kommer C-x u upphva frndringen som gjordes av det sist
-utfrda kommandot. Om du repeterar C-x u flera gnger kommer varje
+Normalt kommer C-/ upphva frndringen som gjordes av det sist
+utfrda kommandot. Om du repeterar C-/ flera gnger kommer varje
repetition upphva ett kommando till.
Det finns tv undantag. Kommandon som inte frndrar texten rknas
inte (detta inkluderar markrfrflyttningar och blddringskommandon),
och inskrivna enkelbokstver blir vanligtvis grupperade i grupper om
-upp till 20 tecken. Detta r fr att reducera antalet C-x u som behvs
+upp till 20 tecken. Detta r fr att reducera antalet C-/ som behvs
fr att ngra inskriven text.
->> Ta bort den hr raden med C-k. C-x u kommer att hmta tillbaka den
- igen.
+>> Ta bort den hr raden med C-k, hmta sedan tillbaka den med C-/.
-C-_ r ett alternativ till ngra-kommandot. Den fungerar p samma stt
-som C-x u men r enklare att trycka flera gnger i fljd. Det
-olmpliga med C-_ r att den r svr att hitta p en del tangentbord.
-Det r drfr vi ocks har C-x u. P en del terminaler kan du f fram
-C-_ genom att trycka / samtidigt som Ctrl hlls nere.
+C-_ r ett alternativt ngra-kommandot. Den fungerar exakt p samma
+stt som C-/. P vissa textterminaler skickar C-/ faktiskt C-_ till
+Emacs. ven C-x u fungerar precis som C-/, men r inte lika enkelt att
+skriva.
-Ett numeriskt argument till C-_ eller C-x u medfr repetering.
+Ett numeriskt argument till C-/, C-_ eller C-x u medfr upprepning.
Du kan ngra radering av text precis p samma stt som du kan ngra
att du tagit bort text. Skillnaden mellan att ta bort och att radera
@@ -500,16 +499,16 @@ med nr du sparar filen kommer Emacs att behlla originalet under ett
nytt namn, som backup, ifall du senare ngrar alltihop.
Om du tittar nstan lngst ner p skrmbilden s kommer du se en rad
-som brjar och slutar med minustecken, och som innehller texten
-"--:-- TUTORIAL.sv". Denna del av skrmbilden visar alltid namnet p
-filen du besker. Just nu r du inne i en fil som heter "TUTORIAL.sv"
-och som r en personlig kopia av vgledningen till Emacs. Vilken fil
-du n r inne i s kommer filnamnet st dr.
+som brjar med minustecken, och som startar med "--:-- TUTORIAL.sv"
+eller ngot snarlikt. Denna del av skrmbilden visar normalt namnet p
+filen du besker. Just nu besker du din personlig kopia av
+vgledningen till Emacs, vilken heter "TUTORIAL.sv". Vilken fil du n
+r inne i s kommer filnamnet st dr.
En annan sak med kommandot fr att finna filer r att du mste ange
-vilket filnamn du nskar. Vi sger att kommandot "lser ett argument
-frn terminalen". I detta fall r argumentet namnet p filen. Efter
-att du gett kommandot
+vilket filnamn du nskar. Vi sger att kommandot "lser ett
+argument". I detta fall r argumentet namnet p filen. Efter att du
+gett kommandot
C-x C-f Finn en fil
@@ -526,12 +525,11 @@ avbryta med kommandot C-g.
du inte finner ngon fil.
Nr du r frdig med att skriva filnamnet trycker du <Return> fr att
-utfra kommandot. D kommer C-x C-f kommandot att brja leta fram
-filen. Minibufferten frsvinner nr C-x C-f kommandot r frdigt.
+utfra kommandot. Minibufferten frsvinner och C-x C-f kommandot brja
+leta efter filen.
-Efter en liten stund kommer filen upp p skrmen och du kan brja
-redigera innehllet. Nr du vill spara filen kan du anvnda detta
-kommando
+Filinnehllet visas nu upp p skrmen och du kan brja redigera
+innehllet. Nr du vill spara filen kan du anvnda detta kommando
C-x C-s Spara fil
@@ -542,11 +540,11 @@ slutet av det ursprungliga filnamnet.
Nr lagringen r utfrd kommer Emacs skriva ut namnet p filen som
blev sparad. Du br spara ofta s att du inte frlorar s mycket om
-systemet kraschar.
+systemet kraschar. (Se kapitlet om sparautomatik nedan.)
->> Skriv C-x C-s fr att spara en kopia av denna vgledning.
- Detta skall leda till att "Wrote ...TUTORIAL.sv" skrivs ut nederst
- p skrmbilden.
+>> Skriv C-x C-s TUTORIAL.sv <Return>.
+ Detta sparar den hr handledningen i en fil med namnet TUTORIAL
+ och "Wrote ...TUTORIAL.sv" skrivs ut nederst p skrmbilden.
Du kan finna en existerande fil, antingen fr att frndra den eller
fr att titta p den. Du kan ocks finna en fil som inte existerar.
@@ -565,11 +563,6 @@ att vara ppen i Emacs. Du kan byta tillbaka till den genom att finna
den p nytt med C-x C-f. P s stt kan du ha ett stort antal filer
ppna i Emacs.
->> Skapa en fil med namnet "foo" genom att trycka C-x C-f foo <Return>.
- Skriv in lite text, redigera den och spara "foo" genom att anvnda
- C-x C-s. Skriv till slut C-x C-f TUTORIAL.sv <Return> fr att komma
- tillbaka till den hr vgledningen.
-
Emacs sparar texten fr varje fil i ett objekt kallat "buffert". Nr
du finner en ny fil skapas en ny buffert i Emacs. Fr att se en lista
ver existerande buffertar i Emacs kan du skriva
@@ -591,9 +584,9 @@ motsvarar en fil kan du gra det genom att beska den igen med C-x
C-f. Det finns dock ett enklare stt: anvnd C-x b kommandot. I det
kommandot anger du buffertens namn.
->> Skriv C-x b foo <Return> fr att g tillbaka till bufferten "foo"
- som innehller texten i filen "foo". Skriv sedan C-x b TUTORIAL.sv
- <Return> fr att komma tillbaka till den hr handledningen.
+>> Skapa en fil med namnet "foo" genom att trycka C-x C-f foo <Return>.
+ Skriv sedan C-x b TUTORIAL.sv <Return> fr att komma tillbaka till
+ den hr handledningen.
Mestadels r buffertens namn densamma som filens namn (utan
katalogdel.) Det r dock inte alltid s. Bufferlistan du skapar med
@@ -646,24 +639,21 @@ fr att avsluta Emacs som r C-x C-c. Var inte rdd fr att frlora
frndringar du har gjort. C-x C-c erbjuder dig att spara frndringar
innan Emacs avslutas.
-C-z r kommandot fr att avsluta Emacs *tillflligt* s att du kan
-tervnda till samma Emacs senare.
-
-P system som tillter det kommer C-z suspendera Emacs, dvs. returnera
-till kommandoraden utan att avsluta Emacs. I de flesta system kan du f
-tillbaka Emacs med kommandot 'fg' eller '%emacs'.
+Om du anvnder ett fnstersystem behver du inte ngot speciellt
+kommando fr att byta till ett annat program. Du kan gra det med
+musen eller med ett kommando till fnsterhanteraren. Men om du
+anvnder en textterminal, som bara kan visa ett program t gngen, s
+mste du avbryta Emacs fr att flytta till ett annat program.
-P system som saknar suspendering startar C-z ett skal som kr under
-Emacs och som ger dig chansen till att kra andra program och sedan
-terg till Emacs eftert. Den ger ingen riktig avslutning av Emacs. I
-detta fall tervnder man vanligtvis till Emacs med kommandot 'exit'.
+C-z r kommandot fr att avsluta Emacs *tillflligt* s att du kan
+tervnda till samma Emacs senare. Nr Emacs krs frn en textterminal
+s avbryts Emacs med C-z, dvs du tergr till kommandoskalet utan att
+Emacsprocessen frstrs. I de flesta vanliga kommandoskalen s kan man
+terg till Emacs med kommandot 'fg' eller med '%emacs'.
C-x C-c anvnds nr du skall avsluta Emacs. Det r klokt att avsluta
Emacs om den har startats av ett mail-program eller andra
-applikationer eftersom det inte r skert att de kan hantera
-suspendering av Emacs. Under normala omstndigheter, om du inte har
-tnkt att logga ut, r det bttre att suspendera Emacs med C-z
-istllet fr att avsluta.
+applikationer.
Det finns mnga C-x kommandon. Hr r en lista ver de du har lrt dig
hittills:
@@ -685,7 +675,7 @@ M-x dr du skall skriva in kommandot du nskar att kra, i det hr
fallet "replace-string". Det r bara att skriva "repl s<TAB>" och
Emacs kommer d att fylla i kommandonamnet. (<TAB> r
tabulatortangenten, som vanligtvis finns ver CapsLock- eller
-skifttangenten nra den vnstra kanten p tangentbordet.) Avsluta
+skifttangenten nra den vnstra kanten p tangentbordet.) Kr
kommandot med <Return>.
Kommandot replace-string krver tv argument, teckenstrngen som skall
@@ -770,7 +760,7 @@ fundamental-mode kommandot fr att byta till huvudlget Fundamental.
Om du skall redigera text, ssom den hr filen, br du troligen
anvnda Text-lge.
->> Skriv M-x text mode<Return>.
+>> Skriv M-x text-mode <Return>.
Inget av kommandona du har lrt dig hittills frndrar Emacs i ngon
hgre grad. Men lgg mrke till att M-f och M-b nu behandlar
@@ -784,8 +774,7 @@ annorlunda.
Fr att f fram dokumentationen fr det lge du r i nu kan du skriva
C-h m.
->> Anvnd C-u C-v s att denna rad kommer nra toppen av
- skrmbilden.
+>> Anvnd C-l C-l fr att f denna rad verst p skrmbilden.
>> Skriv C-h m och se hur Text-lget skiljer sig frn
Fundamental-lget.
>> Tryck C-x 1 fr att ta bort dokumentationen frn skrmbilden.
@@ -801,13 +790,13 @@ radbrytningslget (auto-fill-mode). Nr detta lge r p bryter Emacs
rader mellan ord automatisk nr du skriver in text s att en rad blir
fr lng.
-Du kan sl p radbrytningslget genom att skriva M-x auto fill
-mode<Return>. Nr lget r pslaget kan du sl av det igen genom att
-upprepa M-x auto fill mode<Return>. Om lget r avslaget slr
+Du kan sl p radbrytningslget genom att skriva M-x auto-fill-mode
+<Return>. Nr lget r pslaget kan du sl av det igen genom att
+upprepa M-x auto-fill-mode <Return>. Om lget r avslaget slr
kommandot p det och vice versa. Vi sger att kommandot "vxlar
lget".
->> Skriv M-x auto fill mode<Return> nu. Skriv s in en rad med
+>> Skriv M-x auto-fill-mode <Return> nu. Skriv s in en rad med
"asdf " tills raden delar sig. Du mste stta in blanktecken, fr
Auto Fill bryter bara raden mellan ord.
@@ -831,15 +820,13 @@ du nskar att omformatera.
* SKNING
---------
-Emacs kan ska efter textstrngar (grupper med sammanhngande
-bokstver eller ord) antingen framt eller bakt i texten. Nr du
+Emacs kan ska efter textstrngar (en "strng" r en grupp med
+sammanhngande bokstver) antingen framt eller bakt i texten. Nr du
sker efter text kommer markren att flytta sig till nsta plats dr
teckenstrngen upptrder.
-Skmetoden i Emacs skiljer sig lite frn skmetoder i andra
-redigeringsprogram genom att den r inkrementell. Detta betyder att
-skandet fortgr medan du skriver in teckenstrngen du skall ska
-efter.
+Skmetoden i Emacs r inkrementell. Detta betyder att skandet fortgr
+medan du skriver in teckenstrngen du skall ska efter.
Kommandot fr att inleda en skning r C-s fr att ska framt och C-r
fr att ska bakt. MEN VNTA! Prova dem inte n.
@@ -855,7 +842,7 @@ efter. <Return> avslutar skandet.
har du skt efter ordet "markr" en gng.
>> Skriv C-s en gng till fr att ska efter nsta frekomst av ordet
"markr".
->> Tryck nu p <Delback> fyra gnger och se hur markren flyttar sig
+>> Tryck nu p <DEL> fyra gnger och se hur markren flyttar sig
>> Tryck <Return> fr att avsluta skandet.
Sg du vad som hnde? Under inkrementell skning frsker Emacs att g
@@ -865,22 +852,18 @@ frekomst av ordet 'markr' r det bara att trycka C-s en gng till.
Om det inte finns flera frekomster kommer Emacs att pipa och meddela
att skandet har misslyckats. C-g avbryter ocks skandet.
-Observera: P vissa system gr C-s att skrmen lser sig. Detta tyder
-p att systemets fldeskontroll har fngat upp C-s och inte skickat
-den vidare till Emacs. Fr att fortstta mste du trycka C-q. Se i s
-fall avsnittet "Spontaneous Entry to Incremental Search" i
-Emacs-manualen fr rd om hur detta kan undvikas.
-
-Om du r inne i en inkrementell skning och trycker <Delback> kommer
-du lgga mrke till att den sista bokstaven i skstrngen blir raderad
-och skandet hoppar tillbaka till en tidigare frekomst. Om du till
-exempel skriver "m" fr att ska efter den frsta frekomsten av "m",
-och sedan trycker "a" s kommer markren flytta sig till frsta
-frekomsten av "ma". Tryck nu <Delback>. Detta avlgsnar "a" frn
-skstrngen, och markren flyttar sig tillbaka till den frsta
-frekomsten av "m".
-
-Om du r mitt i en skning och trycker ett KONTROLL- eller META-tecken
+Om du r inne i en inkrementell skning och trycker <DEL> kommer den
+skningen att terg till en tidigare plats. Om du skriver <DEL>
+precis efter att du skrivit C-s fr att g till nsta frekomst av
+skstrngen, kommer <DEL> att flytta markren tillbaka till en
+tidigare frekomst. Om det inte finns ngra tidigare frekomster s
+raderar <DEL> sista tecknet i skstrngen. Om du till exempel skriver
+"m" fr att ska efter den frsta frekomsten av "m", och sedan
+trycker "a" s kommer markren flytta sig till frsta frekomsten av
+"ma". Tryck nu <DEL>. Detta avlgsnar "a" frn skstrngen, och
+markren flyttar sig tillbaka till den frsta frekomsten av "m".
+
+Om du r mitt i en skning och trycker ett kontroll- eller meta-tecken
s avbryts skandet. Undantag r tecken som anvnds under skningen,
s som C-s och C-r.
@@ -894,21 +877,22 @@ C-r, bortsett frn att riktningen p skningen r den omvnda.
---------------
En av egenskaperna hos Emacs r att den kan visa mera n en buffert p
-skrmen samtidig.
+skrmen samtidig. (Notera att Emacs anvnder termen "ramar"
+(frames), som beskrivs i nsta kapitel, fr det som en del andra
+program kallar fr "fnster" (windows). Emacs-manualen innehller en
+ordlista ver Emacs-termer.
->> Flytta markren till den hr raden och tryck C-u 0 C-l (allts
- KONTROLL-L, inte KONTROLL-1).
+>> Flytta markren till den hr raden och tryck C-l C-l.
>> Skriv nu C-x 2, som leder till att skrmen delas i tv
- fnster. Bgge fnstren visar den hr vgledningen. Markren str i
- det vre fnstret.
+ fnster. Bgge fnstren visar den hr vgledningen.
+ Redigeringsmarkren stannar i det vre fnstret.
>> Skriv C-M-v fr att rulla det nedre fnstret.
(Om du inte har META-tangenten trycker du <ESC> C-v.)
->> Skriv C-x o (o fr other) fr att flytta markren till det
+>> Skriv C-x o ("o" fr "other") fr att flytta markren till det
nedre fnstret.
-
>> Anvnd C-v och M-v i det nedre fnstret fr att flytta upp
och ned i texten. Fortstt att lsa den hr texten i det vre
fnstret.
@@ -918,21 +902,20 @@ skrmen samtidig.
gjorde nr du lmnade det.
Du kan fortstta att anvnda C-x o fr att byta mellan de tv
-fnstren. Vart och ett av fnstren har sin egen markrposition men det
-r bara ett av fnstren som visar den. Alla redigeringskommandon
-fungerar i det fnster dr markren r synlig. Vi kallar detta fnster
-fr det valda fnstret (selected window).
+fnstren. Det valda fnstret, dr de flesta redigeringarna ger rum, r
+det med den tydligaste markren, som blinkar nr du inte skriver. De
+andra fnstren har sin egen markrposition. Om du kr Emacs under ett
+fnstersystem, ritas dessa markrer som en tom ruta som inte blinkar..
Kommandot C-M-v r bra nr du redigerar text i ett fnster och
-anvnder det andra fnstret fr referenser. D kan du kan ha markren
-i samma fnster hela tiden och du kan anvnda C-M-v fr att flytta dig
-i det andra fnstret.
+anvnder det andra fnstret fr referenser. Utan att lmna det valda
+fnstret du kan anvnda C-M-v fr att rulla det andra fnstret.
-C-M-v r ett exempel p en KONTROLL-META-kombination. Om du har
-META-tangenten hller du bde KONTROLL och META nedtryckt samtidigt
-som du trycker v. Det har ingen betydelse vilken av tangenterna
-KONTROLL och META som trycks frst, fr bgge fungerar s att de
-"modifierar" de andra tangenterna du trycker.
+C-M-v r ett exempel p en KONTROLL-META-kombination. Om du har META-
+eller Alt-tangenten hller du bde KONTROLL och META nedtryckt
+samtidigt som du trycker v. Det har ingen betydelse vilken av
+tangenterna KONTROLL och META som trycks frst, fr bgge fungerar s
+att de "modifierar" de andra tangenterna du trycker.
Om du inte har META-tangenten och anvnder <ESC> istllet r
ordningsfljden viktig. Du mste trycka <ESC> fljt av KONTROLL-v,
@@ -961,6 +944,28 @@ filer:
>> Skriv C-x o fr att g tillbaka till det vre fnstret och C-x
1 fr att bli kvitt det nedre igen.
+* MULTIPLA RAMAR
+----------------
+
+Emacs kan ocks skapa flera "ramar". En ram r vad vi kallar en
+samling av fnster tillsammans med menyer, rullningslister, ekoomrde
+etc. Det som Emacs kallar fr ram kallar de flesta andra program fr
+fnster. Flera grafiska ramar kan visas p skrmen samtidigt. P en
+textterminal kan bara en ram visas t gngen.
+
+>> Skriv M-x make-frame <Return>.
+ En ny ram visas p din skrm.
+
+Du kan gra allt du gjorde i den frsta ramen i den hr nya ramen. Det
+finns inget speciellt med den frsta ramen.
+
+>> Skriv M-x delete-frame <Return>.
+ Ta bort den valda ramen.
+
+Du kan ocks ta bort ramen genom den vanliga metod som tillhandahlls
+av fnstersystemet (ofta klickar man p knappen med symbolen "X" i
+ngot av de vre hrnen.) Om den sista ramen tas bort p det hr
+sttet s avlutas Emacs.
* REKURSIVA REDIGERINGSNIVER
-----------------------------
@@ -999,11 +1004,8 @@ hjlp du behver. Om du verkligen r helt villrdig kan du trycka C-h
har skrivit C-h och bestmmer dig fr att du inte behver ha ngon
hjlp kan du trycka C-g fr att avbryta.
-(P vissa platser r C-h omkonfigurerad. Det r normalt ingen bra ide,
-s du kan p goda grunder klaga hos systemadministratren. Under
-tiden, om C-h inte visar ett hjlpmeddelande lngst ner p skrmen,
-kan du i stllet frska med funktionstangenten F1 eller M-x
-help<Return>.)
+(Om C-h inte visar ett hjlpmeddelande lngst ner p skrmen, kan du i
+stllet frska med funktionstangenten F1 eller M-x help <Return>.)
Den mest grundlggande hjlp-funktionen r C-h c. Skriv C-h, ett "c"
och en knappsekvens. Emacs ger d en beskrivning av kommandot.
@@ -1014,8 +1016,7 @@ Meddelandet skall d bli ngot i stil med:
C-p runs the command previous-line
-Detta ger ett funktionsnamn. Funktionsnamnen anvnds huvudsakligen fr
-att specialanpassa och utvidga Emacs. Men eftersom funktionerna har
+Detta ger dig namnet p funktionen. Eftersom funktionerna har
beskrivande namn kan de ocks fungera som en enkel dokumentation,
tillrckligt fr att pminna dig om kommandon du redan lrt dig.
@@ -1062,9 +1063,9 @@ C-x C-f listade bredvid motsvarande kommandonamn, t.ex. find-file.
>> Type C-x 1 fr att ta bort hjlpfnstret.
- C-h i Ls direktmanualen (alias Info). Detta kommando
+ C-h i Ls den bifogade manualen (alias Info). Detta kommando
placerar dig i en speciell buffer vid namn "*info*"
- dr du kan lsa direkthjlpen fr de paket som r
+ dr du kan lsa hjlpen fr de paket som r
installerade i ditt system. Sl m emacs <Return> fr
att lsa Emacs-manualen. Om du aldrig tidigare har
anvnt dig av Info, skriv ? och Emacs tar dig p en
@@ -1074,18 +1075,6 @@ C-x C-f listade bredvid motsvarande kommandonamn, t.ex. find-file.
din huvudsakliga klla till dokumentation.
-* TILL SIST
------------
-
-Tnk p att anvnda C-x C-c fr att avsluta Emacs permanent. Fr att
-tillflligt g till ett skal, s att du senare kan komma tillbaka
-igen, anvnd C-z. (Under X kommer detta att minimera Emacs.)
-
-Denna vgledningen r avsedd fr nya anvndare, om det r ngot som r
-oklart duger det inte att sitta och tycka synd om sig sjlv -- Skicka
-ett mail och klaga!
-
-
* MER FUNKTIONER
----------------
@@ -1108,6 +1097,15 @@ Emacs-manualen i noden "Dired".
Manualen beskriver ven mnga andra Emacs funktioner.
+* SLUTORD
+---------
+
+Fr att avsluta Emacs anvnd C-x C-c.
+
+Den hr handledningen r tnkt att vara frstelig fr alla nya
+Emacs-anvndare. S om det r ngot som r oklart, klandra inte dig
+sjlv, klaga!
+
* KOPIERING
-----------
@@ -1119,26 +1117,28 @@ Lidell versatte den till Svenska.
This version of the tutorial, like GNU Emacs, is copyrighted, and
comes with permission to distribute copies on certain conditions:
-Copyright (C) 1985, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
- Permission is granted to anyone to make or distribute verbatim copies
- of this document as received, in any medium, provided that the
- copyright notice and permission notice are preserved,
- and that the distributor grants the recipient permission
- for further redistribution as permitted by this notice.
+This file is part of GNU Emacs.
- Permission is granted to distribute modified versions
- of this document, or of portions of it,
- under the above conditions, provided also that they
- carry prominent notices stating who last altered them.
+ 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.
-The conditions for copying Emacs itself are more complex, but in the
-same spirit. Please read the file COPYING and then do give copies of
-GNU Emacs to your friends. Help stamp out software obstructionism
-("ownership") by using, writing, and sharing free software!
+ 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/>.
+
+Please read the file COPYING and then do give copies of GNU Emacs to
+your friends. Help stamp out software obstructionism ("ownership") by
+using, writing, and sharing free software!
;;; Local Variables:
;;; coding: latin-1
;;; sentence-end-double-space: nil
;;; End:
-
diff --git a/etc/tutorials/TUTORIAL.th b/etc/tutorials/TUTORIAL.th
index fae084cd5e8..56ea8404ec5 100644
--- a/etc/tutorials/TUTORIAL.th
+++ b/etc/tutorials/TUTORIAL.th
@@ -964,7 +964,7 @@ starting with the one written by Stuart Cracraft for the original Emacs.
This version of the tutorial, like GNU Emacs, is copyrighted, and
comes with permission to distribute copies on certain conditions:
-Copyright (C) 1985, 1996, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 2001-2012 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim copies
of this document as received, in any medium, provided that the
diff --git a/etc/tutorials/TUTORIAL.translators b/etc/tutorials/TUTORIAL.translators
index a69d23c471d..3ec948eb79a 100644
--- a/etc/tutorials/TUTORIAL.translators
+++ b/etc/tutorials/TUTORIAL.translators
@@ -2,8 +2,8 @@ This file contains the list of translators and maintainers of the
tutorial.
* TUTORIAL.bg:
-Author: Ognyan Kulev <ogi@fmi.uni-sofia.bg>
-Maintainer: Ognyan Kulev <ogi@fmi.uni-sofia.bg>
+Author: Ognyan Kulev <ogi@tower.3.bg>
+Maintainer: Ognyan Kulev <ogi@tower.3.bg>
* TUTORIAL.cn:
Author: Sun Yijiang <sunyijiang@gmail.com>
@@ -12,8 +12,7 @@ Maintainer: Sun Yijiang <sunyijiang@gmail.com>
* TUTORIAL.cs:
Author: Milan Zamazal <pdm@zamazal.org>
Pavel Janík <Pavel@Janik.cz>
-Maintainer: Milan Zamazal <pdm@zamazal.org>
- Pavel Janík <Pavel@Janik.cz>
+Maintainer: Maintainer needed.
* TUTORIAL.de:
Author: Werner Lemberg <wl@gnu.org>
@@ -73,11 +72,11 @@ Maintainer: Alex Ott <ottalex@narod.ru>
* TUTORIAL.sk:
Author: Miroslav Vaško <vasko@debian.cz>
Pavel Janík <Pavel@Janik.cz>
-Maintainer: Pavel Janík <Pavel@Janik.cz>
+Maintainer: Maintainer needed.
* TUTORIAL.sl:
-Author: Primož Peterlin <primoz.peterlin@biofiz.mf.uni-lj.si>
-Maintainer: Primož Peterlin <primoz.peterlin@biofiz.mf.uni-lj.si>
+Author: Primož Peterlin <primozz.peterlin@gmail.com>
+Maintainer: Primož Peterlin <primozz.peterlin@gmail.com>
* TUTORIAL.sv:
Author: Mats Lidell <matsl@contactor.se>
diff --git a/etc/tutorials/TUTORIAL.zh b/etc/tutorials/TUTORIAL.zh
index da628a3af68..d67cfcf4e82 100644
--- a/etc/tutorials/TUTORIAL.zh
+++ b/etc/tutorials/TUTORIAL.zh
@@ -1049,7 +1049,7 @@ issue here>vC
oӪֳtnM GNU Emacs @˳OvƪAåB\bYDZU
GG
-Copyright (C) 1985, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim copies
of this document as received, in any medium, provided that the
diff --git a/info/.gitignore b/info/.gitignore
index 72e8ffc0db8..bf12a974f48 100644
--- a/info/.gitignore
+++ b/info/.gitignore
@@ -1 +1 @@
-*
+*.info
diff --git a/info/dir b/info/dir
index 06ee2ab8240..cf039593d52 100644
--- a/info/dir
+++ b/info/dir
@@ -19,6 +19,7 @@ The Info Directory
* Menu:
+Texinfo documentation system
* Info: (info). How to use the documentation browsing system.
Emacs
@@ -40,6 +41,7 @@ Emacs editing modes
Emacs network features
* EUDC: (eudc). Emacs client for directory servers (LDAP, PH).
* Gnus: (gnus). The newsreader Gnus.
+* GnuTLS: (emacs-gnutls). The Emacs GnuTLS integration.
* Mairix: (mairix-el). Emacs interface to the Mairix mail indexer.
* MH-E: (mh-e). Emacs interface to the MH mail system.
* Message: (message). Mail and news composition mode that
@@ -53,7 +55,7 @@ Emacs network features
you're replying to, in flexible ways.
* Sieve: (sieve). Managing Sieve scripts in Emacs.
* TRAMP: (tramp). Transparent Remote Access, Multiple Protocol
- GNU Emacs remote file access via rsh and rcp.
+ Emacs remote file access via rsh and rcp.
Emacs misc features
* Autotype: (autotype). Convenient features for text that you enter
@@ -66,7 +68,7 @@ Emacs misc features
* Ediff: (ediff). A visual interface for comparing and
merging programs.
* EDT: (edt). An Emacs emulation of the EDT editor.
-* EIEIO: (eieio). An object system for Emacs Lisp.
+* EIEIO: (eieio). An objects system for Emacs Lisp.
* ERT: (ert). Emacs Lisp regression testing tool.
* Eshell: (eshell). A command shell implemented in Emacs Lisp.
* Flymake: (flymake). A universal on-the-fly syntax checker.
@@ -76,18 +78,15 @@ Emacs misc features
* RefTeX: (reftex). Emacs support for LaTeX cross-references
and citations.
* Remember: (remember). Simple information manager for Emacs.
-* Semantic: (semantic). Source code parsing utilities for Emacs.
-* SES: (ses). Simple Emacs Spreadsheet
+* Semantic: (semantic). Source code parser library and utilities.
+* SES: (ses). Simple Emacs Spreadsheet.
* Speedbar: (speedbar). File/Tag summarizing utility.
* VIP: (vip). An older VI-emulation for Emacs.
-* VIPER: (viper). The newest Emacs VI-emulation mode.
- (also, A VI Plan for Emacs Rescue
- or the VI PERil.)
+* VIPER: (viper). A VI-emulation mode for Emacs.
* WoMan: (woman). Browse UN*X Manual Pages "W.O. (without) Man".
Emacs lisp libraries
-* Auth-source: (auth). A single configuration for multiple
- applications.
+* Auth-source: (auth). The Emacs auth-source library.
* CL: (cl). Partial Common Lisp support for Emacs Lisp.
* D-Bus: (dbus). Using D-Bus in Emacs.
* Emacs MIME: (emacs-mime). Emacs MIME de/composition library.
diff --git a/leim/ChangeLog b/leim/ChangeLog
index 57c5a406785..6a67c99b5c0 100644
--- a/leim/ChangeLog
+++ b/leim/ChangeLog
@@ -1,3 +1,151 @@
+2012-09-05 Eli Zaretskii <eliz@gnu.org>
+
+ * quail/hebrew.el ("yiddish-royal"): Fix several bogus entries.
+
+2012-08-17 Daniel Bergey <bergey@alum.mit.edu> (tiny change)
+
+ * quail/indian.el (quail-define-inscript-package):
+ Set kbd-translate for all Inscript layouts. It's a positional
+ layout: vowels should be on the left hand regardless of the
+ underlying characters produced by those keys. (Bug#12072)
+
+2012-08-06 Mohsen BANAN <libre@mohsen.1.banan.byname.net>
+
+ * quail/persian.el: Add some mappings. (Bug#11812)
+ (farsi-isiri-9147, farsi-transliterate-banan): Doc fixes.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Update .PHONY listings in makefiles.
+ * Makefile.in (.PHONY): Add all, compile-main, clean, mostlyclean,
+ bootstrap-clean, distclean, maintainer-clean, extraclean.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ deactive->inactive, inactivate->deactivate spelling fixes (Bug#10150)
+ * quail/uni-input.el (ucs-input-deactivate):
+ Rename from ucs-input-inactivate.
+ * quail/hangul.el (hangul-input-method-deactivate):
+ Rename from hangul-input-method-inactivate.
+
+2012-07-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * quail/ipa.el: Use cl-lib.
+
+ * quail/hangul.el: Don't require CL.
+
+2012-06-12 Nguyen Thai Ngoc Duy <pclouds@gmail.com>
+
+ * quail/vnvi.el: New file (Bug#4747).
+
+2012-05-22 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (SUBDIRS): Remove variable and rule.
+ (MKDIR_P): Add it back.
+ (all, changed.tit, changed.misc, leim-list.el):
+ Don't depend on SUBDIRS.
+ (changed.tit, changed.misc): Ensure output directory exists.
+ (distclean): Don't use SUBDIRS.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install): Remove, let top-level do it.
+ (version, prefix, datarootdir, datadir, ns_appresdir, leimdir):
+ (MKDIR_P, GZIP_PROG): Remove, no longer used.
+
+ * Makefile.in (install_prefix): Remove.
+ (LEIM_INSTALLDIR): Rename to leimdir.
+ (install): Update for this change.
+
+ * Makefile.in (leim-list.el, install): Scrap superfluous subshells.
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MKDIR_P): New, set by configure.
+ (install): Use $MKDIR_P.
+
+2012-05-10 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: Install self-contained ns files directly to
+ their final destination.
+ (install_prefix): New.
+ (LEIM_INSTALLDIR): New, set by configure.
+ (install): Use LEIM_INSTALLDIR.
+
+ * Makefile.in (MV_DIRS): Remove.
+ (install): Simplify the --with-ns case.
+
+2012-04-09 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (EMACS): Rename from BUILT_EMACS.
+ (RUN_EMACS, compile-main): Update for this change.
+
+ * Makefile.in (../src/emacs): Remove this rule, no longer relevant
+ since leim distributed with Emacs (eg lisp/ has no such rule).
+ (all): Remove $BUILT_EMACS dependence.
+
+2012-04-09 Eli Zaretskii <eliz@gnu.org>
+
+ * quail/latin-ltx.el (latin-ltx--define-rules): Comment out
+ debugging messages.
+
+2012-04-09 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: Compute list of .el files to be compiled dynamically,
+ as the lisp/ directory does, rather than hard-coding it.
+ Also, separate leim-list generation from byte-compilation.
+ (TIT_GB, TIT_BIG5, CHINESE_TIT, MISC, TIT_MISC):
+ Make them store the .el files rather than the .elc files.
+ (NON_TIT_GB, NON_TIT_BIG5, CHINESE_NON_TIT, CHINESE_GB)
+ (CHINESE_GB, CHINESE_BIG5, JAPANESE, KOREAN, THAI, VIETNAMESE)
+ (LAO, INDIAN, TIBETAN, LATIN, UNICODE, SLAVIC, GREEK, RUSSIAN)
+ (OTHERS, CHINESE, EASTASIA, ASIA, EUROPEAN, WORLD, NON_TIT_MISC):
+ Remove variables listing the non-generated .el files.
+ (.el.elc): Add explicit load-path for quail.
+ (all): Depend on compile-main rule rather than $WORLD.
+ (changed.tit, changed.misc): Also depend on $SUBDIRS.
+ (leim-list.el): Don't depend on changed.tit or changed.misc.
+ Remove unnecessary compilation check.
+ (setwins, compile-targets, compile-main): New.
+ (clean, mostlyclean): Update for change in TIT_MISC contents.
+ (bootstrap-clean): Use a glob match to delete .elc, not a fixed list.
+
+2012-04-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * quail/latin-ltx.el: Auto-generate some of the entries.
+ (latin-ltx--ascii-p): New function.
+ (latin-ltx--define-rules): New macro.
+ (define-rules): Use it.
+
+2012-03-25 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (install): Use $(DIRNAME)_same-dir.tst instead
+ of same-dir.tst, to avoid stepping on other (parallel) Make job's
+ toes.
+
+2012-03-21 Kenichi Handa <handa@m17n.org>
+
+ * quail/indian.el ("devanagari-itrans"): Add a few more useful
+ keys (Bug#10935).
+
+2012-03-16 Kenichi Handa <handa@m17n.org>
+
+ * quail/indian.el (telugu-inscript): Fix typo. (Bug#10936)
+
+2012-03-13 Йордан Миладинов <jordanmiladinov@gmail.com> (tiny change)
+
+ * quail/cyrillic.el (bulgarian-alt-phonetic):
+ New input method. (Bug#10893)
+
+2012-03-09 Mohsen BANAN <libre@mohsen.1.banan.byname.net>
+
+ * quail/persian.el: Update which includes: (1) full compliance to
+ ISIRI-6219, forbidden characters were eliminated and missing
+ characters were added; (2) layer 3 of ISIRI-9147 is now
+ implemented with a '\' prefix; (3) double entry of characters
+ which were postfixed with 'h' is now supported; (4) lots of
+ comment and additional pointers have been added.
+
2011-12-15 Kenichi Handa <handa@m17n.org>
* quail/ethiopic.el ("ethiopic"): Do not refer to
@@ -2218,7 +2366,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1997-1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1997-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/leim/Makefile.in b/leim/Makefile.in
index 23eaf215e2e..f61ab42b9f3 100644
--- a/leim/Makefile.in
+++ b/leim/Makefile.in
@@ -1,6 +1,6 @@
# Makefile for leim subdirectory in GNU Emacs.
-# Copyright (C) 1997-2011 Free Software Foundation, Inc.
+# Copyright (C) 1997-2012 Free Software Foundation, Inc.
# Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011
# National Institute of Advanced Industrial Science and Technology (AIST)
@@ -27,144 +27,62 @@
SHELL = /bin/sh
# Here are the things that we expect ../configure to edit.
-version=@version@
-prefix=@prefix@
-datarootdir=@datarootdir@
-datadir=@datadir@
srcdir=@srcdir@
-ns_appresdir=@ns_appresdir@
-
-# Where to install LEIM files.
-INSTALLDIR=$(DESTDIR)${datadir}/emacs/${version}/leim
-
-GZIP_PROG = @GZIP_PROG@
# Which Emacs to use to convert TIT files to Emacs Lisp files,
# byte-compile Emacs Lisp files, and generate the file leim-list.el.
-BUILT_EMACS = ../src/emacs
+EMACS = ../src/emacs
buildlisppath=${srcdir}/../lisp
# How to run Emacs.
RUN_EMACS = EMACSLOADPATH=$(buildlisppath) LC_ALL=C \
- ${BUILT_EMACS} -batch --no-site-file --no-site-lisp
+ ${EMACS} -batch --no-site-file --no-site-lisp
-# Subdirectories to be made if ${srcdir} is different from the current
-# directory.
-SUBDIRS=quail
+MKDIR_P = @MKDIR_P@
# Files generated from TIT dictionaries for Chinese GB character set.
TIT_GB=\
- quail/CCDOSPY.elc \
- quail/Punct.elc \
- quail/QJ.elc \
- quail/SW.elc \
- quail/TONEPY.elc
+ quail/CCDOSPY.el \
+ quail/Punct.el \
+ quail/QJ.el \
+ quail/SW.el \
+ quail/TONEPY.el
# Files generated from TIT dictionaries for Chinese BIG5 character set.
TIT_BIG5=\
- quail/4Corner.elc \
- quail/ARRAY30.elc \
- quail/ECDICT.elc \
- quail/ETZY.elc \
- quail/Punct-b5.elc \
- quail/PY-b5.elc \
- quail/QJ-b5.elc \
- quail/ZOZY.elc
+ quail/4Corner.el \
+ quail/ARRAY30.el \
+ quail/ECDICT.el \
+ quail/ETZY.el \
+ quail/Punct-b5.el \
+ quail/PY-b5.el \
+ quail/QJ-b5.el \
+ quail/ZOZY.el
CHINESE_TIT=${TIT_GB} ${TIT_BIG5}
-NON_TIT_GB=${srcdir}/quail/py-punct.elc
-
-NON_TIT_BIG5=${srcdir}/quail/pypunct-b5.elc
-
-CHINESE_NON_TIT=${NON_TIT_GB} ${NON_TIT_BIG5}
-
-CHINESE_GB=${TIT_GB} ${NON_TIT_GB}
-
-CHINESE_BIG5=${TIT_BIG5} ${NON_TIT_BIG5}
-
-JAPANESE=${srcdir}/quail/japanese.elc ${srcdir}/ja-dic/ja-dic.elc
-
-KOREAN= ${srcdir}/quail/hangul.elc \
- ${srcdir}/quail/hanja.elc \
- ${srcdir}/quail/hanja3.elc \
- ${srcdir}/quail/hanja-jis.elc \
- ${srcdir}/quail/symbol-ksc.elc
-
-THAI=${srcdir}/quail/thai.elc
-
-VIETNAMESE=${srcdir}/quail/viqr.elc ${srcdir}/quail/vntelex.elc
-
-LAO=${srcdir}/quail/lao.elc ${srcdir}/quail/lrt.elc
-
-INDIAN=${srcdir}/quail/indian.elc
-
-TIBETAN=${srcdir}/quail/tibetan.elc
-
-LATIN= ${srcdir}/quail/latin-pre.elc \
- ${srcdir}/quail/latin-post.elc \
- ${srcdir}/quail/latin-alt.elc \
- ${srcdir}/quail/latin-ltx.elc \
- ${srcdir}/quail/welsh.elc
-
-UNICODE=${srcdir}/quail/sgml-input.elc ${srcdir}/quail/rfc1345.elc \
- ${srcdir}/quail/uni-input.elc
-
-SLAVIC= \
- ${srcdir}/quail/czech.elc \
- ${srcdir}/quail/croatian.elc \
- ${srcdir}/quail/slovak.elc
-
-GREEK=${srcdir}/quail/greek.elc
-
-RUSSIAN=${srcdir}/quail/cyrillic.elc ${srcdir}/quail/cyril-jis.elc
-
-OTHERS= \
- ${srcdir}/quail/arabic.elc \
- ${srcdir}/quail/ethiopic.elc \
- ${srcdir}/quail/ipa.elc \
- ${srcdir}/quail/ipa-praat.elc \
- ${srcdir}/quail/hebrew.elc \
- ${srcdir}/quail/georgian.elc \
- $(srcdir)/quail/persian.elc \
- ${srcdir}/quail/sisheng.elc
-
MISC= \
- quail/tsang-b5.elc \
- quail/quick-b5.elc \
- quail/tsang-cns.elc \
- quail/quick-cns.elc \
- quail/PY.elc \
- quail/ZIRANMA.elc \
- quail/CTLau.elc \
- quail/CTLau-b5.elc
-
-CHINESE=${CHINESE_GB} ${CHINESE_BIG5}
-EASTASIA=${CHINESE} ${JAPANESE} ${KOREAN}
-ASIA=${EASTASIA} ${THAI} ${VIETNAMESE} ${LAO} ${INDIAN} ${TIBETAN}
-EUROPEAN=${LATIN} ${SLAVIC} ${GREEK} ${RUSSIAN}
-WORLD=${ASIA} ${EUROPEAN} ${OTHERS} ${MISC} ${UNICODE}
-
+ quail/tsang-b5.el \
+ quail/quick-b5.el \
+ quail/tsang-cns.el \
+ quail/quick-cns.el \
+ quail/PY.el \
+ quail/ZIRANMA.el \
+ quail/CTLau.el \
+ quail/CTLau-b5.el
+
+## The generated .el files.
TIT_MISC=${CHINESE_TIT} ${MISC}
-NON_TIT_MISC=${CHINESE_NON_TIT} ${JAPANESE} ${KOREAN} ${EUROPEAN} ${OTHERS}
.SUFFIXES: .elc .el
.el.elc:
@echo Compiling $<
- @${RUN_EMACS} -f batch-byte-compile $<
-
-all: ${BUILT_EMACS} ${SUBDIRS} leim-list.el ${WORLD}
-
-# To ensure that we can run Emacs. This target is ignored (never
-# being hit) if a user changes default value of EMACS.
-../src/emacs:
- cd ../src; ${MAKE} ${MFLAGS} emacs
+ @${RUN_EMACS} -l ${buildlisppath}/international/quail -f batch-byte-compile $<
-${SUBDIRS}:
- mkdir $@
- touch stamp-subdir
+all: leim-list.el compile-main
+.PHONY: all
TIT_SOURCES= \
${srcdir}/CXTERM-DIC/4Corner.tit \
@@ -181,10 +99,19 @@ TIT_SOURCES= \
${srcdir}/CXTERM-DIC/TONEPY.tit \
${srcdir}/CXTERM-DIC/ZOZY.tit
-${CHINESE_TIT:.elc=.el}: changed.tit
+${CHINESE_TIT}: changed.tit
@true
+## The changed.* files act to serialize this part of the build.
+## A single Emacs invocation creates all the CHINESE_TIT files.
+## Otherwise in a parallel build multiple Emacs instances could
+## interfere with each other. If we used GNU make we could probably
+## parallelize this without the need for an explicit rule for each
+## file. Something like the pattern rule:
+## quail/%.el: CXTERM-DIC/%.tit
+## It doesn't seem possible to do this with VPATH and suffix rules.
changed.tit: ${TIT_SOURCES}
+ @${MKDIR_P} quail
${RUN_EMACS} -l ${buildlisppath}/international/titdic-cnv \
-f batch-titdic-convert -dir quail ${srcdir}/CXTERM-DIC; \
echo "changed" > $@
@@ -197,19 +124,18 @@ MISC_SOURCES= \
${srcdir}/MISC-DIC/pinyin.map \
${srcdir}/MISC-DIC/ziranma.cin
-${MISC:.elc=.el}: changed.misc
+${MISC}: changed.misc
@true
changed.misc: ${MISC_SOURCES}
+ @${MKDIR_P} quail
${RUN_EMACS} -l ${buildlisppath}/international/titdic-cnv \
-f batch-miscdic-convert -dir quail ${srcdir}/MISC-DIC; \
echo "changed" > $@
-leim-list.el: ${SUBDIRS} ${TIT_MISC} changed.tit changed.misc ${srcdir}/leim-ext.el
+leim-list.el: ${TIT_MISC} ${srcdir}/leim-ext.el
rm -f leim-list.el
- ${RUN_EMACS} -l ${buildlisppath}/international/quail \
- -f batch-byte-compile-if-not-done ${TIT_MISC:.elc=.el}
- if [ x`(cd ${srcdir} && /bin/pwd)` = x`(/bin/pwd)` ] ; then \
+ if [ x`cd ${srcdir} && /bin/pwd` = x`/bin/pwd` ] ; then \
${RUN_EMACS} -l ${buildlisppath}/international/quail \
--eval "(update-leim-list-file \".\")" ; \
else \
@@ -218,67 +144,44 @@ leim-list.el: ${SUBDIRS} ${TIT_MISC} changed.tit changed.misc ${srcdir}/leim-ext
fi
sed -n '/^[^;]/ p' < ${srcdir}/leim-ext.el >> $@
-MV_DIRS = for i in $$dir; do rm -fr `basename "$$i"` ; mv "$$i" . ; done
-
-install: all
- if [ ! -d ${INSTALLDIR} ] ; then \
- umask 022; ${srcdir}/../build-aux/install-sh -d ${INSTALLDIR}; \
- else true; fi
- if [ x`(cd ${INSTALLDIR} && /bin/pwd)` != x`(/bin/pwd)` ] ; then \
- rm -f ${INSTALLDIR}/leim-list.el; \
- rm -rf ${INSTALLDIR}/quail ${INSTALLDIR}/ja-dic ; \
- echo "Copying leim files to ${INSTALLDIR} ..." ; \
- if [ x`(cd ${srcdir} && /bin/pwd)` = x`(/bin/pwd)` ] ; then \
- tar -chf - leim-list.el quail ja-dic \
- | (cd ${INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\
- else \
- tar -chf - leim-list.el quail \
- | (cd ${INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\
- cd ${srcdir}; \
- tar -chf - quail/* ja-dic \
- | (cd ${INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\
- fi; \
- rm -f ${INSTALLDIR}/.gitignore ${INSTALLDIR}/*/.gitignore; \
- rm -f ${INSTALLDIR}/.arch-inventory ${INSTALLDIR}/*/.arch-inventory; \
- rm -f ${INSTALLDIR}/\#* ${INSTALLDIR}/*/\#* ; \
- rm -f ${INSTALLDIR}/.\#* ${INSTALLDIR}/*/.\#* ; \
- rm -f ${INSTALLDIR}/*~ ${INSTALLDIR}/*/*~ ; \
- rm -f ${INSTALLDIR}/*.orig ${INSTALLDIR}/*/*.orig ; \
- else true; fi
- -unset CDPATH; \
- if [ -n "${GZIP_PROG}" ]; \
- then \
- echo "Compressing *.el ..." ; \
- (cd ${INSTALLDIR}; for f in `find . -name "*.elc" -print`; do \
- ${GZIP_PROG} -9n `echo $$f|sed 's/.elc$$/.el/'` ; \
- done) \
- else true; fi
- -chmod -R a+r ${INSTALLDIR}
- for installuser in $${LOGNAME} $${USERNAME} $${USER} \
- `id -un 2> /dev/null`; do \
- [ -n "$${installuser}" ] && break ; \
- done ; \
- find ${INSTALLDIR} -exec chown $${installuser} '{}' ';'
- if [ "${ns_appresdir}" != "" ]; then \
- ( cd ${ns_appresdir} ; \
- if test -d share/emacs ; then dir=share/emacs/*/*; $(MV_DIRS); fi;\
- rm -fr share ) ; \
- else true ; fi
+## Following adapted from lisp/Makefile.in.
+setwins=wins="${srcdir}/ja-dic quail"; \
+ [ `cd ${srcdir} && /bin/pwd` != `/bin/pwd` ] && \
+ wins="$$wins ${srcdir}/quail"
+
+.PHONY: compile-targets
+# TARGETS is set dynamically in the recursive call from `compile-main'.
+compile-targets: $(TARGETS)
+
+# Compile all the Elisp files that need it. Beware: it approximates
+# `no-byte-compile', so watch out for false-positives!
+.PHONY: compile-main
+compile-main: ${TIT_MISC}
+ @($(setwins); \
+ els=`echo "$$wins " | sed -e 's| |/*.el |g'`; \
+ for el in $$els; do \
+ test -f $$el || continue; \
+ test ! -f $${el}c && GREP_OPTIONS= grep '^;.*no-byte-compile: t' $$el > /dev/null && continue; \
+ echo "$${el}c"; \
+ done | xargs echo) | \
+ while read chunk; do \
+ $(MAKE) $(MFLAGS) compile-targets EMACS="$(EMACS)" TARGETS="$$chunk"; \
+ done
+
+.PHONY: clean mostlyclean bootstrap-clean distclean maintainer-clean extraclean
clean mostlyclean:
- rm -f ${TIT_MISC} ${TIT_MISC:.elc=.el} \
+ rm -f ${TIT_MISC} ${TIT_MISC:.el=.elc} \
leim-list.el changed.tit changed.misc
# The following target is needed because the `clean' target only removes
# TIT-generated files and doesn't touch compiled Quail packages. But
# bootstrapping should not leave non-fresh .elc files behind.
bootstrap-clean: clean
- rm -f ${WORLD}
-## FIXME some compiled files go to srcdir, some don't?
-# cd ${srcdir}; rm -f *.elc */*.elc
+ $(setwins); for w in $$wins; do rm -f $$w/*.elc; done
distclean: clean
- if test -f stamp-subdir; then rm -rf ${SUBDIRS} stamp-subdir; fi
+ -[ `cd ${srcdir} && /bin/pwd` != `/bin/pwd` ] && rm -rf quail
rm -f Makefile
maintainer-clean: distclean bootstrap-clean
diff --git a/leim/README b/leim/README
index a47bd7664d8..74c5bba7a54 100644
--- a/leim/README
+++ b/leim/README
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/leim/SKK-DIC/SKK-JISYO.L b/leim/SKK-DIC/SKK-JISYO.L
index 177ba7ce731..5e2199cbfdc 100644
--- a/leim/SKK-DIC/SKK-JISYO.L
+++ b/leim/SKK-DIC/SKK-JISYO.L
@@ -34,7 +34,7 @@
;; the Free Software Foundation Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
-;; ACKNOWLEDGEMENT
+;; ACKNOWLEDGMENT
;;
;; μϡSKK Ԥκƣɧ 1 ǺΤ
;; ŵ̿꺴ƣ漼 () γãȤȤ scratch
diff --git a/leim/ja-dic/ja-dic.el b/leim/ja-dic/ja-dic.el
index 19caea49629..c674ca99165 100644
--- a/leim/ja-dic/ja-dic.el
+++ b/leim/ja-dic/ja-dic.el
@@ -47,7 +47,7 @@
;; the Free Software Foundation Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
-;; ACKNOWLEDGEMENT
+;; ACKNOWLEDGMENT
;;
;; μϡSKK Ԥκƣɧ 1 ǺΤ
;; ŵ̿꺴ƣ漼 () γãȤȤ scratch
diff --git a/leim/leim-ext.el b/leim/leim-ext.el
index 0a12fdde58a..c8a0247b392 100644
--- a/leim/leim-ext.el
+++ b/leim/leim-ext.el
@@ -1,6 +1,6 @@
;; leim-ext.el -- extra leim configuration -*- coding:utf-8; -*-
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H13PRO009
diff --git a/leim/makefile.w32-in b/leim/makefile.w32-in
index 231384308f2..fa4afe81064 100644
--- a/leim/makefile.w32-in
+++ b/leim/makefile.w32-in
@@ -1,6 +1,6 @@
-# -*- Makefile -*- for leim subdirectory in GNU Emacs on the Microsoft W32 API.
+# -*- Makefile -*- for leim subdirectory in GNU Emacs on the Microsoft Windows API.
-# Copyright (C) 2000-2011 Free Software Foundation, Inc.
+# Copyright (C) 2000-2012 Free Software Foundation, Inc.
# Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007
# National Institute of Advanced Industrial Science and Technology (AIST)
@@ -201,13 +201,13 @@ leim-list.el: $(SUBDIRS) $(WORLD) $(srcdir)/leim-ext.el
install: all
- mkdir "$(INSTALLDIR)"
- - $(DEL) same-dir.tst
- - $(DEL) $(INSTALL_DIR)/same-dir.tst
- echo SameDirTest > $(INSTALL_DIR)/same-dir.tst
+ - $(DEL) $(DIRNAME)_same-dir.tst
+ - $(DEL) $(INSTALL_DIR)/$(DIRNAME)_same-dir.tst
+ echo SameDirTest > $(INSTALL_DIR)/$(DIRNAME)_same-dir.tst
$(IFNOTSAMEDIR) $(CP) leim-list.el $(INSTALLDIR) $(ENDIF)
$(IFNOTSAMEDIR) $(CP_DIR) quail $(INSTALLDIR) $(ENDIF)
$(IFNOTSAMEDIR) $(CP_DIR) ja-dic $(INSTALLDIR) $(ENDIF)
- - $(DEL) $(INSTALL_DIR)/same-dir.tst
+ - $(DEL) $(INSTALL_DIR)/$(DIRNAME)_same-dir.tst
clean mostlyclean:
- $(FOREACH) $(TIT) $(FORDO) $(DEL) $(FORVAR) $(ENDFOR)
diff --git a/leim/quail/arabic.el b/leim/quail/arabic.el
index e14fee8c888..66d57239b2a 100644
--- a/leim/quail/arabic.el
+++ b/leim/quail/arabic.el
@@ -1,6 +1,6 @@
;;; arabic.el --- Quail package for inputting Arabic -*- coding: utf-8;-*-
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: James Cloos <cloos@jhcloos.com>
;; Keywords: mule, input method, Arabic
diff --git a/leim/quail/croatian.el b/leim/quail/croatian.el
index 885ac238398..a7348b8a20e 100644
--- a/leim/quail/croatian.el
+++ b/leim/quail/croatian.el
@@ -1,6 +1,6 @@
;;; quail/croatian.el -- Quail package for inputting Croatian -*-coding: iso-8859-2;-*-
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Hrvoje Niki <hniksic@xemacs.org>
;; Keywords: i18n
diff --git a/leim/quail/cyril-jis.el b/leim/quail/cyril-jis.el
index 878c6f53281..bfb05aaa0fd 100644
--- a/leim/quail/cyril-jis.el
+++ b/leim/quail/cyril-jis.el
@@ -1,6 +1,6 @@
;;; cyril-jis.el --- Quail package for inputting JISX0208 Cyrillic letters
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/leim/quail/cyrillic.el b/leim/quail/cyrillic.el
index b1ee78a393e..0e5fb0cdb83 100644
--- a/leim/quail/cyrillic.el
+++ b/leim/quail/cyrillic.el
@@ -1,6 +1,6 @@
;;; cyrillic.el --- Quail package for inputting Cyrillic characters
-;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -1236,6 +1236,79 @@ Unicode based."
("." ?$,1(n(B)
("/" ?.))
+(quail-define-package
+ "bulgarian-alt-phonetic" "Bulgarian" "$,1(1(=(D(B"
+ nil
+ "Bulgarian alternative Phonetic keyboard layout, producing Unicode.
+
+This phonetic layout replaces all the Latin letters with Bulgarian
+\(Cyrillic\) letters based on similarities in their pronunciation or look.
+
+Note that, since the letters ',Li(B', ',Ll(B', ',Ln(B' and ',Lo(B' are attached to the
+']', '\', '`' and '[' keys respectively, Caps Lock does not affect them."
+nil t t t t nil nil nil nil nil t)
+
+;; $,1(N(B 1! 2@ 3$,1uV(B 4$ 5% 6$,1tL(B 7,A'(B 8* 9( 0) -$,1rs(B =+ $,1(l(}(B
+;; $,1(G(B $,1(H(B $,1(5(B $,1(@(B $,1(B(B $,1(J(B $,1(C(B $,1(8(B $,1(>(B $,1(?(B $,1(O(B $,1(I(B
+;; ,L0(B $,1(A(B $,1(4(B $,1(D(B $,1(3(B $,1(E(B $,1(9(B $,1(:(B $,1(;(B :; '"
+;; $,1(7(B $,1(6(B $,1(F(B $,1(2(B $,1(1(B $,1(=(B $,1(<(B ,$,1r~(B .$,1r|(B /?
+
+(quail-define-rules
+ ("#" ?,Lp(B)
+ ("&" ?,A'(B)
+ ("/#" ?#)
+ ("/&" ?&)
+ ("/<" ?<)
+ ("/>" ?>)
+ ("/[" ?\[)
+ ("/\\" ?\\)
+ ("/]" ?\])
+ ("/^" ?^)
+ ("/_" ?_)
+ ("/`" ?`)
+ ("/{" ?{)
+ ("/|" ?|)
+ ("/}" ?})
+ ("/~" ?~)
+ ("<" ?$,1r~(B)
+ (">" ?$,1r|(B)
+ ("A" ?$,1(0(B) ("a" ?$,1(P(B)
+ ("B" ?$,1(1(B) ("b" ?$,1(Q(B)
+ ("C" ?$,1(F(B) ("c" ?$,1(f(B)
+ ("D" ?$,1(4(B) ("d" ?$,1(T(B)
+ ("E" ?$,1(5(B) ("e" ?$,1(U(B)
+ ("F" ?$,1(D(B) ("f" ?$,1(d(B)
+ ("G" ?$,1(3(B) ("g" ?$,1(S(B)
+ ("H" ?$,1(E(B) ("h" ?$,1(e(B)
+ ("I" ?$,1(8(B) ("i" ?$,1(X(B)
+ ("J" ?$,1(9(B) ("j" ?$,1(Y(B)
+ ("K" ?$,1(:(B) ("k" ?$,1(Z(B)
+ ("L" ?$,1(;(B) ("l" ?$,1([(B)
+ ("M" ?$,1(<(B) ("m" ?$,1(\(B)
+ ("N" ?$,1(=(B) ("n" ?$,1(](B)
+ ("O" ?$,1(>(B) ("o" ?$,1(^(B)
+ ("P" ?$,1(?(B) ("p" ?$,1(_(B)
+ ("Q" ?$,1(G(B) ("q" ?$,1(g(B)
+ ("R" ?$,1(@(B) ("r" ?$,1(`(B)
+ ("S" ?$,1(A(B) ("s" ?$,1(a(B)
+ ("T" ?$,1(B(B) ("t" ?$,1(b(B)
+ ("U" ?$,1(C(B) ("u" ?$,1(c(B)
+ ("V" ?$,1(2(B) ("v" ?$,1(R(B)
+ ("W" ?$,1(H(B) ("w" ?$,1(h(B)
+ ("X" ?$,1(6(B) ("x" ?$,1(V(B)
+ ("Y" ?$,1(J(B) ("y" ?$,1(j(B)
+ ("Z" ?$,1(7(B) ("z" ?$,1(W(B)
+ ("[" ?$,1(o(B)
+ ("\\" ?$,1(l(B)
+ ("]" ?$,1(i(B)
+ ("^" ?$,1tL(B)
+ ("_" ?$,1rs(B)
+ ("`" ?$,1(n(B)
+ ("{" ?$,1(O(B)
+ ("|" ?$,1(}(B)
+ ("}" ?$,1(I(B)
+ ("~" ?$,1(N(B))
+
;; From `Bulgarian-PHO.kmap for Yudit', Alexander Shopov
;; <al_shopov@web.bg>.
diff --git a/leim/quail/czech.el b/leim/quail/czech.el
index fc1fb5f6e1f..e2c5ad975ee 100644
--- a/leim/quail/czech.el
+++ b/leim/quail/czech.el
@@ -1,6 +1,6 @@
;;; czech.el --- Quail package for inputting Czech -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Milan Zamazal <pdm@zamazal.org>
;; Maintainer: Pavel Jan,Bm(Bk <Pavel@Janik.cz>
diff --git a/leim/quail/georgian.el b/leim/quail/georgian.el
index d9d8519867d..65c9a3c597f 100644
--- a/leim/quail/georgian.el
+++ b/leim/quail/georgian.el
@@ -1,6 +1,6 @@
;;; georgian.el --- Quail package for inputting Georgian characters -*-coding: utf-8;-*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/leim/quail/greek.el b/leim/quail/greek.el
index 407b52f1f39..8bb3112e974 100644
--- a/leim/quail/greek.el
+++ b/leim/quail/greek.el
@@ -1,6 +1,6 @@
;;; greek.el --- Quail package for inputting Greek -*-coding: iso-2022-7bit-*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/leim/quail/hangul.el b/leim/quail/hangul.el
index d3071d628e0..fd1dc0d2954 100644
--- a/leim/quail/hangul.el
+++ b/leim/quail/hangul.el
@@ -1,6 +1,6 @@
;;; hangul.el --- Korean Hangul input method
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Jihyun Cho <jihyun.jo@gmail.com>
;; Keywords: multilingual, input method, Korean, Hangul
@@ -30,7 +30,6 @@
;;; Code:
(require 'quail)
-(eval-when-compile (require 'cl)) ; for setf
(require 'hanja-util)
;; Hangul double Jamo table.
@@ -513,7 +512,7 @@ When a Korean input method is off, convert the following hangul character."
"Activate Hangul input method INPUT-METHOD.
FUNC is a function to handle input key.
HELP-TEXT is a text set in `hangul-input-method-help-text'."
- (setq inactivate-current-input-method-function 'hangul-input-method-inactivate
+ (setq deactivate-current-input-method-function 'hangul-input-method-deactivate
describe-current-input-method-function 'hangul-input-method-help
hangul-input-method-help-text help-text)
(quail-delete-overlays)
@@ -521,8 +520,8 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'."
(add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
(set (make-local-variable 'input-method-function) func))
-(defun hangul-input-method-inactivate ()
- "Inactivate the current Hangul input method."
+(defun hangul-input-method-deactivate ()
+ "Deactivate the current Hangul input method."
(interactive)
(unwind-protect
(progn
@@ -531,6 +530,10 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'."
(setq describe-current-input-method-function nil))
(kill-local-variable 'input-method-function)))
+(define-obsolete-function-alias
+ 'hangul-input-method-inactivate
+ 'hangul-input-method-deactivate "24.3")
+
(defun hangul-input-method-help ()
"Describe the current Hangul input method."
(interactive)
diff --git a/leim/quail/hanja.el b/leim/quail/hanja.el
index 029309f4c15..e067c965db9 100644
--- a/leim/quail/hanja.el
+++ b/leim/quail/hanja.el
@@ -1,6 +1,6 @@
;;; hanja.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/leim/quail/hanja3.el b/leim/quail/hanja3.el
index dae716c7a8b..7ca597b5cf2 100644
--- a/leim/quail/hanja3.el
+++ b/leim/quail/hanja3.el
@@ -1,6 +1,6 @@
;;; hanja3.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Koaunghi Un <koaunghi.un@zdv.uni-tuebingen.de>
;; Keywords: mule, quail, multilingual, input method, Korean, Hanja
diff --git a/leim/quail/hebrew.el b/leim/quail/hebrew.el
index 7c7f6c6a8b5..307f7fa0c28 100644
--- a/leim/quail/hebrew.el
+++ b/leim/quail/hebrew.el
@@ -333,7 +333,7 @@ Additional mappings for Rafe and Yiddish ligatures.
(quail-define-package
"hebrew-full" "Hebrew" ",Hr$,1,T,K(B" nil "Hebrew Full method.
-Provides access to all Hebrew characters suiltable to Modern Hebrew.
+Provides access to all Hebrew characters suitable to Modern Hebrew.
" nil t t t t nil nil nil nil nil t)
(quail-define-rules
@@ -456,7 +456,7 @@ Provides access to all Hebrew characters suiltable to Modern Hebrew.
"Biblical Hebrew Tiro input method.
Based on Society of Biblical Literature's Tiro keyboard layout.
-Not suiltable for modern Hebrew input.
+Not suitable for modern Hebrew input.
'q' is used to switch levels instead of Alt-Gr.
Combining dot above (Called Masora dot) ($,1%G(B) is mapped to 'q1'.
" nil t t t t nil nil nil nil nil t)
@@ -602,7 +602,7 @@ Not suiltable for modern Hebrew input.
"Biblical Hebrew SIL input method.
Based on Society of Biblical Literature's SIL keyboard layout.
-Phonetic and not suiltable for modern Hebrew input.
+Phonetic and not suitable for modern Hebrew input.
'`' is used to switch levels instead of Alt-Gr.
Euro Sign (,F$(B) is mapped to 'Z'.
" nil t t t t nil nil nil nil nil t)
@@ -773,9 +773,9 @@ Better for yiddish than Hebrew methods.
("@" ?,Y%(B) ; Double Low-9 Quotation Mark
("(" ?\)) ; mirroring
(")" ?\() ; mirroring
- ("Q" ?,A=(B) ; Right Double Quotation Mark
- ("W" ?,A<(B)
- ("E" ?,A>(B) ; Yiddish Double Yod (x2)
+ ("Q" ?,Y4(B) ; Left Double Quotation Mark
+ ("W" ?,Y!(B) ; Right Double Quotation Mark
+ ("E" ?$,1-2(B) ; Yiddish Double Yod (x2)
("R" [ ",H`$,1,W(B" ]) ; Patah Alef (Pasekh Alef)
; ("T" "")
("Y" ?$,1-1(B) ; Ligature Yiddish Vav Yod (vov yud)
diff --git a/leim/quail/indian.el b/leim/quail/indian.el
index 8bdac3f5842..2541e60c57d 100644
--- a/leim/quail/indian.el
+++ b/leim/quail/indian.el
@@ -1,6 +1,6 @@
;;; indian.el --- Quail packages for inputting Indian
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: KAWABATA, Taichi <kawabata@m17n.org>
@@ -56,6 +56,11 @@
(quail-define-indian-trans-package
indian-dev-itrans-v5-hash "devanagari-itrans" "Devanagari" "DevIT"
"Devanagari transliteration by ITRANS method.")
+(quail-defrule "..." ?॥)
+(quail-defrule "\\'" ?॑)
+(quail-defrule "\\_" ?॒)
+(quail-defrule "\\__" ?_)
+(quail-defrule "\\''" ?')
(if nil
(quail-define-package "devanagari-kyoto-harvard" "Devanagari" "DevKH" t "Devanagari Kyoto-Harvard"))
@@ -304,7 +309,7 @@ Full key sequences are listed below:")
(defun quail-define-inscript-package (char-tables key-tables pkgname lang
title docstring)
(funcall 'quail-define-package pkgname lang title nil docstring
- nil nil nil nil nil nil nil nil)
+ nil nil nil t nil nil nil nil)
(let (char-table key-table char key)
(while (and char-tables key-tables)
(setq char-table (car char-tables)
@@ -440,7 +445,7 @@ Full key sequences are listed below:")
(if nil
(quail-define-package "telugu-inscript" "Telugu" "TlgIS" t "Telugu keyboard Inscript"))
(quail-define-inscript-package
- indian-dev-base-table inscript-dev-keytable
+ indian-tlg-base-table inscript-dev-keytable
"telugu-inscript" "Telugu" "TlgIS"
"Telugu keyboard Inscript.")
diff --git a/leim/quail/ipa-praat.el b/leim/quail/ipa-praat.el
index 25eb6d4b995..a1528a17466 100644
--- a/leim/quail/ipa-praat.el
+++ b/leim/quail/ipa-praat.el
@@ -1,6 +1,6 @@
;;; ipa-praat.el --- Inputting IPA characters with the conventions of Praat
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Oliver Scholz <epameinondas@gmx.de>
;; Keywords: multilingual, input method, IPA
diff --git a/leim/quail/ipa.el b/leim/quail/ipa.el
index 4c15be2bf42..b29a6ffc113 100644
--- a/leim/quail/ipa.el
+++ b/leim/quail/ipa.el
@@ -1,11 +1,11 @@
;;; ipa.el --- Quail package for inputting IPA characters -*-coding: utf-8;-*-
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Keywords: multilingual, input method, IPA
@@ -29,7 +29,7 @@
;;; Code:
(require 'quail)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(quail-define-package
"ipa" "IPA" "IPA" t
@@ -277,13 +277,13 @@ string."
(setq quail-keymap (list (string quail-keymap)))
(if (stringp quail-keymap)
(setq quail-keymap (list quail-keymap))
- (assert (vectorp quail-keymap) t)
+ (cl-assert (vectorp quail-keymap) t)
(setq quail-keymap (append quail-keymap nil))))
(list
(apply 'vector
(mapcar
#'(lambda (entry)
- (assert (char-or-string-p entry) t)
+ (cl-assert (char-or-string-p entry) t)
(format "%s%s" to-prepend
(if (integerp entry) (string entry) entry)))
quail-keymap))))
@@ -318,18 +318,18 @@ particular sequence of keys, and the result will be cached by Quail."
(dolist (underscoring underscore-map)
(cond ((null underscoring))
((eq (length underscoring) 2)
- (setq underscore-map-entry (second underscoring))
+ (setq underscore-map-entry (cl-second underscoring))
(setcdr underscoring (ipa-x-sampa-prepend-to-keymap-entry
pre-underscore-map underscore-map-entry)))
((eq (length underscoring) 3)
- (setq underscore-map-entry (second (third underscoring)))
- (setcdr (third underscoring)
+ (setq underscore-map-entry (cl-second (cl-third underscoring)))
+ (setcdr (cl-third underscoring)
(ipa-x-sampa-prepend-to-keymap-entry
pre-underscore-map underscore-map-entry)))
(t
- (assert (null t) t
- "Can't handle subtrees of this level right now."))))
- (append underscore-map (list (list ?< (second x-sampa-submap-entry))))))
+ (cl-assert (null t) t
+ "Can't handle subtrees of this level right now."))))
+ (append underscore-map (list (list ?< (cl-second x-sampa-submap-entry))))))
(quail-define-package
"ipa-x-sampa" "IPA" "IPA-X" t
diff --git a/leim/quail/japanese.el b/leim/quail/japanese.el
index f51bddbf3b4..fa7cd702e35 100644
--- a/leim/quail/japanese.el
+++ b/leim/quail/japanese.el
@@ -1,6 +1,6 @@
;;; japanese.el --- Quail package for inputting Japanese -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/leim/quail/latin-alt.el b/leim/quail/latin-alt.el
index 2276ba3e2a5..a2d0d5754b6 100644
--- a/leim/quail/latin-alt.el
+++ b/leim/quail/latin-alt.el
@@ -1,6 +1,6 @@
;;; latin-alt.el --- Quail package for inputting various European characters -*-coding: utf-8;-*-
-;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/leim/quail/latin-ltx.el b/leim/quail/latin-ltx.el
index fb788378737..9f4c9664899 100644
--- a/leim/quail/latin-ltx.el
+++ b/leim/quail/latin-ltx.el
@@ -1,6 +1,6 @@
;;; latin-ltx.el --- Quail package for TeX-style input -*-coding: utf-8;-*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
;; 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -42,484 +42,265 @@ system, including many technical ones. Examples:
'(("\t" . quail-completion))
t t nil nil nil nil nil nil nil t)
-(quail-define-rules
+(eval-when-compile
+ (defun latin-ltx--ascii-p (char)
+ (and (characterp char) (< char 128)))
+
+ (defmacro latin-ltx--define-rules (&rest rules)
+ (load "uni-name")
+ (let ((newrules ()))
+ (dolist (rule rules)
+ (pcase rule
+ (`(,_ ,(pred characterp)) (push rule newrules)) ;; Normal quail rule.
+ (`(,seq ,re)
+ (let ((count 0))
+ (dolist (pair (ucs-names))
+ (let ((name (car pair))
+ (char (cdr pair)))
+ (when (and (characterp char) ;; Ignore char-ranges.
+ (string-match re name))
+ (let ((keys (if (stringp seq)
+ (replace-match seq nil nil name)
+ (funcall seq name char))))
+ (if (listp keys)
+ (dolist (x keys)
+ (setq count (1+ count))
+ (push (list x char) newrules))
+ (setq count (1+ count))
+ (push (list keys char) newrules))))))
+ ;(message "latin-ltx: %d mapping for %S" count re)
+ ))))
+ `(quail-define-rules ,@(nreverse (delete-dups newrules))))))
+
+(latin-ltx--define-rules
("!`" ?¡)
("\\pounds" ?£) ;; ("{\\pounds}" ?£)
("\\S" ?§) ;; ("{\\S}" ?§)
- ("\\\"{}" ?¨)
- ("\\copyright" ?©) ;; ("{\\copyright}" ?©)
("$^a$" ?ª)
- ("\\={}" ?¯)
("$\\pm$" ?±) ("\\pm" ?±)
("$^2$" ?²)
("$^3$" ?³)
- ("\\'{}" ?´)
("\\P" ?¶) ;; ("{\\P}" ?¶)
;; Fixme: Yudit has the equivalent of ("\\cdot" ?⋅), for U+22C5, DOT
;; OPERATOR, whereas · is MIDDLE DOT. JadeTeX translates both to
;; \cdot.
("$\\cdot$" ?·) ("\\cdot" ?·)
- ("\\c{}" ?¸)
("$^1$" ?¹)
("$^o$" ?º)
("?`" ?¿)
- ("\\`{A}" ?À) ("\\`A" ?À)
- ("\\'{A}" ?Á) ("\\'A" ?Á)
- ("\\^{A}" ?Â) ("\\^A" ?Â)
- ("\\~{A}" ?Ã) ("\\~A" ?Ã)
- ("\\\"{A}" ?Ä) ("\\\"A" ?Ä)
- ("\\\k{A}" ?Ą)
+ ("\\`" ?̀)
+ ("\\`{}" ?`)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\`{%s}" c) (format "\\`%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH GRAVE")
+
+ ("\\'" ?́)
+ ("\\'{}" ?´)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\'{%s}" c) (format "\\'%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH ACUTE")
+
+ ("\\^" ?̂)
+ ("\\^{}" ?^)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\^{%s}" c) (format "\\^%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH CIRCUMFLEX")
+
+ ("\\~" ?̃)
+ ("\\~{}" ?˜)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\~{%s}" c) (format "\\~%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH TILDE")
+
+ ("\\\"" ?̈)
+ ("\\\"{}" ?¨)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\\"{%s}" c) (format "\\\"%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH DIAERESIS")
+
+ ("\\k" ?̨)
+ ("\\k{}" ?˛)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\k{%s}" c) ;; (format "\\k%s" c)
+ )))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH OGONEK")
+
+ ("\\c" ?̧)
+ ("\\c{}" ?¸)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\c{%s}" c) (format "\\c%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH CEDILLA")
+
("\\AA" ?Å) ;; ("{\\AA}" ?Å)
("\\AE" ?Æ) ;; ("{\\AE}" ?Æ)
- ("\\c{C}" ?Ç) ("\\cC" ?Ç)
- ("\\`{E}" ?È) ("\\`E" ?È)
- ("\\'{E}" ?É) ("\\'E" ?É)
- ("\\^{E}" ?Ê) ("\\^E" ?Ê)
- ("\\\"{E}" ?Ë) ("\\\"E" ?Ë)
- ("\\\k{E}" ?Ę)
- ("\\`{I}" ?Ì) ("\\`I" ?Ì)
- ("\\'{I}" ?Í) ("\\'I" ?Í)
- ("\\^{I}" ?Î) ("\\^I" ?Î)
- ("\\\"{I}" ?Ï) ("\\\"I" ?Ï)
- ("\\\k{I}" ?Į)
- ("\\~{N}" ?Ñ) ("\\~N" ?Ñ)
- ("\\`{O}" ?Ò) ("\\`O" ?Ò)
- ("\\'{O}" ?Ó) ("\\'O" ?Ó)
- ("\\^{O}" ?Ô) ("\\^O" ?Ô)
- ("\\~{O}" ?Õ) ("\\~O" ?Õ)
- ("\\\"{O}" ?Ö) ("\\\"O" ?Ö)
- ("\\\k{O}" ?Ǫ)
("$\\times$" ?×) ("\\times" ?×)
("\\O" ?Ø) ;; ("{\\O}" ?Ø)
- ("\\`{U}" ?Ù) ("\\`U" ?Ù)
- ("\\'{U}" ?Ú) ("\\'U" ?Ú)
- ("\\^{U}" ?Û) ("\\^U" ?Û)
- ("\\\"{U}" ?Ü) ("\\\"U" ?Ü)
- ("\\\k{U}" ?Ų)
- ("\\'{Y}" ?Ý) ("\\'Y" ?Ý)
("\\ss" ?ß) ;; ("{\\ss}" ?ß)
- ("\\`{a}" ?à) ("\\`a" ?à)
- ("\\'{a}" ?á) ("\\'a" ?á)
- ("\\^{a}" ?â) ("\\^a" ?â)
- ("\\~{a}" ?ã) ("\\~a" ?ã)
- ("\\\"{a}" ?ä) ("\\\"a" ?ä)
- ("\\\k{a}" ?ą)
("\\aa" ?å) ;; ("{\\aa}" ?å)
("\\ae" ?æ) ;; ("{\\ae}" ?æ)
- ("\\c{c}" ?ç) ("\\cc" ?ç)
- ("\\`{e}" ?è) ("\\`e" ?è)
- ("\\'{e}" ?é) ("\\'e" ?é)
- ("\\^{e}" ?ê) ("\\^e" ?ê)
- ("\\\"{e}" ?ë) ("\\\"e" ?ë)
- ("\\\k{e}" ?ę)
- ("\\`{\\i}" ?ì) ("\\`i" ?ì)
- ("\\'{\\i}" ?í) ("\\'i" ?í)
- ("\\^{\\i}" ?î) ("\\^i" ?î)
- ("\\\"{\\i}" ?ï) ("\\\"i" ?ï)
- ("\\\k{i}" ?į)
- ("\\~{n}" ?ñ) ("\\~n" ?ñ)
- ("\\`{o}" ?ò) ("\\`o" ?ò)
- ("\\'{o}" ?ó) ("\\'o" ?ó)
- ("\\^{o}" ?ô) ("\\^o" ?ô)
- ("\\~{o}" ?õ) ("\\~o" ?õ)
- ("\\\"{o}" ?ö) ("\\\"o" ?ö)
- ("\\\k{o}" ?ǫ)
("$\\div$" ?÷) ("\\div" ?÷)
("\\o" ?ø) ;; ("{\\o}" ?ø)
- ("\\`{u}" ?ù) ("\\`u" ?ù)
- ("\\'{u}" ?ú) ("\\'u" ?ú)
- ("\\^{u}" ?û) ("\\^u" ?û)
- ("\\\"{u}" ?ü) ("\\\"u" ?ü)
- ("\\\k{u}" ?ų)
- ("\\'{y}" ?ý) ("\\'y" ?ý)
- ("\\\"{y}" ?ÿ) ("\\\"y" ?ÿ)
- ("\\={A}" ?Ā) ("\\=A" ?Ā)
- ("\\={a}" ?ā) ("\\=a" ?ā)
- ("\\u{A}" ?Ă) ("\\uA" ?Ă)
- ("\\u{a}" ?ă) ("\\ua" ?ă)
- ("\\'{C}" ?Ć) ("\\'C" ?Ć)
- ("\\'{c}" ?ć) ("\\'c" ?ć)
- ("\\^{C}" ?Ĉ) ("\\^C" ?Ĉ)
- ("\\^{c}" ?ĉ) ("\\^c" ?ĉ)
- ("\\.{C}" ?Ċ) ("\\.C" ?Ċ)
- ("\\.{c}" ?ċ) ("\\.c" ?ċ)
- ("\\v{C}" ?Č) ("\\vC" ?Č)
- ("\\v{c}" ?č) ("\\vc" ?č)
- ("\\v{D}" ?Ď) ("\\vD" ?Ď)
- ("\\v{d}" ?ď) ("\\vd" ?ď)
+ ("\\=" ?̄)
+ ("\\={}" ?¯)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\={%s}" c) (format "\\=%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH MACRON")
- ("\\={E}" ?Ē) ("\\=E" ?Ē)
- ("\\={e}" ?ē) ("\\=e" ?ē)
- ("\\u{E}" ?Ĕ) ("\\uE" ?Ĕ)
- ("\\u{e}" ?ĕ) ("\\ue" ?ĕ)
- ("\\.{E}" ?Ė) ("\\.E" ?Ė)
- ("\\e{e}" ?ė) ("\\ee" ?ė)
- ("\\v{E}" ?Ě) ("\\vE" ?Ě)
- ("\\v{e}" ?ě) ("\\ve" ?ě)
- ("\\^{G}" ?Ĝ) ("\\^G" ?Ĝ)
- ("\\^{g}" ?ĝ) ("\\^g" ?ĝ)
- ("\\u{G}" ?Ğ) ("\\uG" ?Ğ)
- ("\\u{g}" ?ğ) ("\\ug" ?ğ)
+ ("\\u" ?̆)
+ ("\\u{}" ?˘)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\u{%s}" c) (format "\\u%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH BREVE")
- ("\\.{G}" ?Ġ) ("\\.G" ?Ġ)
- ("\\.{g}" ?ġ) ("\\.g" ?ġ)
- ("\\c{G}" ?Ģ) ("\\cG" ?Ģ)
- ("\\c{g}" ?ģ) ("\\cg" ?ģ)
- ("\\^{H}" ?Ĥ) ("\\^H" ?Ĥ)
- ("\\^{h}" ?ĥ) ("\\^h" ?ĥ)
- ("\\~{I}" ?Ĩ) ("\\~I" ?Ĩ)
- ("\\~{\\i}" ?ĩ) ("\\~i" ?ĩ)
- ("\\={I}" ?Ī) ("\\=I" ?Ī)
- ("\\={\\i}" ?ī) ("\\=i" ?ī)
- ("\\u{I}" ?Ĭ) ("\\uI" ?Ĭ)
- ("\\u{\\i}" ?ĭ) ("\\ui" ?ĭ)
+ ("\\." ?̇)
+ ("\\.{}" ?˙)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\.{%s}" c) (format "\\.%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH DOT ABOVE")
+
+ ("\\v" ?̌)
+ ("\\v{}" ?ˇ)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\v{%s}" c) (format "\\v%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH CARON")
+
+ ("\\~{\\i}" ?ĩ)
+ ("\\={\\i}" ?ī)
+ ("\\u{\\i}" ?ĭ)
- ("\\.{I}" ?İ) ("\\.I" ?İ)
("\\i" ?ı) ;; ("{\\i}" ?ı)
- ("\\^{J}" ?Ĵ) ("\\^J" ?Ĵ)
- ("\\^{\\j}" ?ĵ) ("\\^j" ?ĵ)
- ("\\c{K}" ?Ķ) ("\\cK" ?Ķ)
- ("\\c{k}" ?ķ) ("\\ck" ?ķ)
- ("\\'{L}" ?Ĺ) ("\\'L" ?Ĺ)
- ("\\'{l}" ?ĺ) ("\\'l" ?ĺ)
- ("\\c{L}" ?Ļ) ("\\cL" ?Ļ)
- ("\\c{l}" ?ļ) ("\\cl" ?ļ)
+ ("\\^{\\j}" ?ĵ)
("\\L" ?Ł) ;; ("{\\L}" ?Ł)
("\\l" ?ł) ;; ("{\\l}" ?ł)
- ("\\'{N}" ?Ń) ("\\'N" ?Ń)
- ("\\'{n}" ?ń) ("\\'n" ?ń)
- ("\\c{N}" ?Ņ) ("\\cN" ?Ņ)
- ("\\c{n}" ?ņ) ("\\cn" ?ņ)
- ("\\v{N}" ?Ň) ("\\vN" ?Ň)
- ("\\v{n}" ?ň) ("\\vn" ?ň)
- ("\\={O}" ?Ō) ("\\=O" ?Ō)
- ("\\={o}" ?ō) ("\\=o" ?ō)
- ("\\u{O}" ?Ŏ) ("\\uO" ?Ŏ)
- ("\\u{o}" ?ŏ) ("\\uo" ?ŏ)
- ("\\H{O}" ?Ő) ("\\HO" ?Ő)
- ("\\U{o}" ?ő) ("\\Uo" ?ő)
+ ("\\H" ?̋)
+ ("\\H{}" ?˝)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\H{%s}" c) (format "\\H%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH DOUBLE ACUTE")
+ ("\\U{o}" ?ő) ("\\Uo" ?ő) ;; FIXME: Was it just a typo?
+
("\\OE" ?Œ) ;; ("{\\OE}" ?Œ)
("\\oe" ?œ) ;; ("{\\oe}" ?œ)
- ("\\'{R}" ?Ŕ) ("\\'R" ?Ŕ)
- ("\\'{r}" ?ŕ) ("\\'r" ?ŕ)
- ("\\c{R}" ?Ŗ) ("\\cR" ?Ŗ)
- ("\\c{r}" ?ŗ) ("\\cr" ?ŗ)
- ("\\v{R}" ?Ř) ("\\vR" ?Ř)
- ("\\v{r}" ?ř) ("\\vr" ?ř)
- ("\\'{S}" ?Ś) ("\\'S" ?Ś)
- ("\\'{s}" ?ś) ("\\'s" ?ś)
- ("\\^{S}" ?Ŝ) ("\\^S" ?Ŝ)
- ("\\^{s}" ?ŝ) ("\\^s" ?ŝ)
- ("\\c{S}" ?Ş) ("\\cS" ?Ş)
- ("\\c{s}" ?ş) ("\\cs" ?ş)
-
- ("\\v{S}" ?Š) ("\\vS" ?Š)
- ("\\v{s}" ?š) ("\\vs" ?š)
- ("\\c{T}" ?Ţ) ("\\cT" ?Ţ)
- ("\\c{t}" ?ţ) ("\\ct" ?ţ)
- ("\\v{T}" ?Ť) ("\\vT" ?Ť)
- ("\\v{t}" ?ť) ("\\vt" ?ť)
- ("\\~{U}" ?Ũ) ("\\~U" ?Ũ)
- ("\\~{u}" ?ũ) ("\\~u" ?ũ)
- ("\\={U}" ?Ū) ("\\=U" ?Ū)
- ("\\={u}" ?ū) ("\\=u" ?ū)
- ("\\u{U}" ?Ŭ) ("\\uU" ?Ŭ)
- ("\\u{u}" ?ŭ) ("\\uu" ?ŭ)
- ("\\H{U}" ?Ű) ("\\HU" ?Ű)
- ("\\H{u}" ?ű) ("\\Hu" ?ű)
- ("\\^{W}" ?Ŵ) ("\\^W" ?Ŵ)
- ("\\^{w}" ?ŵ) ("\\^w" ?ŵ)
- ("\\^{Y}" ?Ŷ) ("\\^Y" ?Ŷ)
- ("\\^{y}" ?ŷ) ("\\^y" ?ŷ)
- ("\\\"{Y}" ?Ÿ) ("\\\"Y" ?Ÿ)
- ("\\'{Z}" ?Ź) ("\\'Z" ?Ź)
- ("\\'{z}" ?ź) ("\\'z" ?ź)
- ("\\.{Z}" ?Ż) ("\\.Z" ?Ż)
- ("\\.{z}" ?ż) ("\\.z" ?ż)
- ("\\v{Z}" ?Ž) ("\\vZ" ?Ž)
- ("\\v{z}" ?ž) ("\\vz" ?ž)
-
- ("\\v{A}" ?Ǎ) ("\\vA" ?Ǎ)
- ("\\v{a}" ?ǎ) ("\\va" ?ǎ)
- ("\\v{I}" ?Ǐ) ("\\vI" ?Ǐ)
- ("\\v{\\i}" ?ǐ) ("\\vi" ?ǐ)
- ("\\v{O}" ?Ǒ) ("\\vO" ?Ǒ)
- ("\\v{o}" ?ǒ) ("\\vo" ?ǒ)
- ("\\v{U}" ?Ǔ) ("\\vU" ?Ǔ)
- ("\\v{u}" ?ǔ) ("\\vu" ?ǔ)
+ ("\\v{\\i}" ?ǐ)
("\\={\\AE}" ?Ǣ) ("\\=\\AE" ?Ǣ)
("\\={\\ae}" ?ǣ) ("\\=\\ae" ?ǣ)
- ("\\v{G}" ?Ǧ) ("\\vG" ?Ǧ)
- ("\\v{g}" ?ǧ) ("\\vg" ?ǧ)
- ("\\v{K}" ?Ǩ) ("\\vK" ?Ǩ)
- ("\\v{k}" ?ǩ) ("\\vk" ?ǩ)
- ("\\v{\\j}" ?ǰ) ("\\vj" ?ǰ)
- ("\\'{G}" ?Ǵ) ("\\'G" ?Ǵ)
- ("\\'{g}" ?ǵ) ("\\'g" ?ǵ)
- ("\\`{N}" ?Ǹ) ("\\`N" ?Ǹ)
- ("\\`{n}" ?ǹ) ("\\`n" ?ǹ)
+ ("\\v{\\j}" ?ǰ)
("\\'{\\AE}" ?Ǽ) ("\\'\\AE" ?Ǽ)
("\\'{\\ae}" ?ǽ) ("\\'\\ae" ?ǽ)
("\\'{\\O}" ?Ǿ) ("\\'\\O" ?Ǿ)
("\\'{\\o}" ?ǿ) ("\\'\\o" ?ǿ)
- ("\\v{H}" ?Ȟ) ("\\vH" ?Ȟ)
- ("\\v{h}" ?ȟ) ("\\vh" ?ȟ)
- ("\\.{A}" ?Ȧ) ("\\.A" ?Ȧ)
- ("\\.{a}" ?ȧ) ("\\.a" ?ȧ)
- ("\\c{E}" ?Ȩ) ("\\cE" ?Ȩ)
- ("\\c{e}" ?ȩ) ("\\ce" ?ȩ)
- ("\\.{O}" ?Ȯ) ("\\.O" ?Ȯ)
- ("\\.{o}" ?ȯ) ("\\.o" ?ȯ)
- ("\\={Y}" ?Ȳ) ("\\=Y" ?Ȳ)
- ("\\={y}" ?ȳ) ("\\=y" ?ȳ)
-
- ("\\v{}" ?ˇ)
- ("\\u{}" ?˘)
- ("\\.{}" ?˙)
- ("\\~{}" ?˜)
- ("\\H{}" ?˝)
-
- ("\\'" ?́)
- ("\\'K" ?Ḱ)
- ("\\'M" ?Ḿ)
- ("\\'P" ?Ṕ)
- ("\\'W" ?Ẃ)
- ("\\'k" ?ḱ)
- ("\\'m" ?ḿ)
- ("\\'p" ?ṕ)
- ("\\'w" ?ẃ)
("\\," ? )
- ("\\." ?̇)
- ("\\.B" ?Ḃ)
- ("\\.D" ?Ḋ)
- ("\\.F" ?Ḟ)
- ("\\.H" ?Ḣ)
- ("\\.M" ?Ṁ)
- ("\\.N" ?Ṅ)
- ("\\.P" ?Ṗ)
- ("\\.R" ?Ṙ)
- ("\\.S" ?Ṡ)
- ("\\.T" ?Ṫ)
- ("\\.W" ?Ẇ)
- ("\\.X" ?Ẋ)
- ("\\.Y" ?Ẏ)
- ("\\.b" ?ḃ)
- ("\\.d" ?ḋ)
- ("\\.e" ?ė)
- ("\\.f" ?ḟ)
- ("\\.h" ?ḣ)
- ("\\.m" ?ṁ)
- ("\\.n" ?ṅ)
- ("\\.p" ?ṗ)
- ("\\.r" ?ṙ)
- ("\\.s" ?ṡ)
- ("\\.t" ?ṫ)
- ("\\.w" ?ẇ)
- ("\\.x" ?ẋ)
- ("\\.y" ?ẏ)
("\\/" ?‌)
("\\:" ? )
("\\;" ? )
- ("\\=" ?̄)
- ("\\=G" ?Ḡ)
- ("\\=g" ?ḡ)
- ("^(" ?⁽)
- ("^)" ?⁾)
- ("^+" ?⁺)
- ("^-" ?⁻)
- ("^0" ?⁰)
- ("^1" ?¹)
- ("^2" ?²)
- ("^3" ?³)
- ("^4" ?⁴)
- ("^5" ?⁵)
- ("^6" ?⁶)
- ("^7" ?⁷)
- ("^8" ?⁸)
- ("^9" ?⁹)
- ("^=" ?⁼)
+ ((lambda (name char)
+ (let* ((base (concat (match-string 1 name) (match-string 3 name)))
+ (basechar (cdr (assoc base (ucs-names)))))
+ (when (latin-ltx--ascii-p basechar)
+ (string (if (match-end 2) ?^ ?_) basechar))))
+ "\\(.*\\)SU\\(?:B\\|\\(PER\\)\\)SCRIPT \\(.*\\)")
+
("^\\gamma" ?ˠ)
- ;; FIXME: It'd be nicer to generate some of these rules via something like
- ;; (map (lambda (name char)
- ;; (cond ((string-match "MODIFIER SMALL LETTER \\(.\\)" name)
- ;; (list (string ?^ (downcase (aref name (match-beginning 1))))
- ;; char)))
- ;; ...)))
- ("^a" ?ᵃ)
- ("^b" ?ᵇ)
- ("^c" ?ᶜ)
- ("^d" ?ᵈ)
- ("^e" ?ᵉ)
- ("^f" ?ᶠ)
- ("^g" ?ᵍ)
- ("^h" ?ʰ)
- ;; ("^i" ?) ;; FIXME: can't find MODIFIER SMALL LETTER I !?!
- ("^j" ?ʲ)
- ("^k" ?ᵏ)
- ("^l" ?ˡ)
- ("^m" ?ᵐ)
- ("^n" ?ⁿ)
- ("^o" ?ᵒ)
+
+ ((lambda (name char)
+ (let* ((base (format "LATIN %s LETTER %s"
+ (match-string 1 name) (match-string 2 name)))
+ (basechar (cdr (assoc base (ucs-names)))))
+ (when (latin-ltx--ascii-p basechar)
+ (string ?^ basechar))))
+ "MODIFIER LETTER \\(SMALL\\|CAPITAL\\) \\(.*\\)")
+
+ ;; ((lambda (name char) (format "^%s" (downcase (match-string 1 name))))
+ ;; "\\`MODIFIER LETTER SMALL \\(.\\)\\'")
+ ;; ("^\\1" "\\`MODIFIER LETTER CAPITAL \\(.\\)\\'")
("^o_" ?º)
- ("^p" ?ᵖ)
- ;; ("^q" ?) ;; FIXME: can't find MODIFIER SMALL LETTER Q !?!
- ("^r" ?ʳ)
- ("^s" ?ˢ)
- ("^t" ?ᵗ)
- ("^u" ?ᵘ)
- ("^v" ?ᵛ)
- ("^w" ?ʷ)
- ("^x" ?ˣ)
- ("^y" ?ʸ)
- ("^z" ?ᶻ)
- ("^A" ?ᴬ)
- ("^B" ?ᴮ)
- ;; ("^C" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER C !?!
- ("^D" ?ᴰ)
- ("^E" ?ᴱ)
- ;; ("^F" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER F !?!
- ("^G" ?ᴳ)
- ("^H" ?ᴴ)
- ("^I" ?ᴵ)
- ("^J" ?ᴶ)
- ("^K" ?ᴷ)
- ("^L" ?ᴸ)
- ("^M" ?ᴹ)
- ("^N" ?ᴺ)
- ("^O" ?ᴼ)
- ("^P" ?ᴾ)
- ;; ("^Q" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER Q !?!
- ("^R" ?ᴿ)
- ;; ("^S" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER S !?!
- ("^T" ?ᵀ)
- ("^U" ?ᵁ)
- ("^V" ?ⱽ)
- ("^W" ?ᵂ)
- ;; ("^X" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER X !?!
- ;; ("^Y" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER Y !?!
- ;; ("^Z" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER Z !?!
("^{SM}" ?℠)
("^{TEL}" ?℡)
("^{TM}" ?™)
- ("_(" ?₍)
- ("_)" ?₎)
- ("_+" ?₊)
- ("_-" ?₋)
- ("_0" ?₀)
- ("_1" ?₁)
- ("_2" ?₂)
- ("_3" ?₃)
- ("_4" ?₄)
- ("_5" ?₅)
- ("_6" ?₆)
- ("_7" ?₇)
- ("_8" ?₈)
- ("_9" ?₉)
- ("_=" ?₌)
- ("\\~" ?̃)
- ("\\~E" ?Ẽ)
- ("\\~V" ?Ṽ)
- ("\\~Y" ?Ỹ)
- ("\\~e" ?ẽ)
- ("\\~v" ?ṽ)
- ("\\~y" ?ỹ)
-
- ("\\\"" ?̈)
- ("\\\"H" ?Ḧ)
- ("\\\"W" ?Ẅ)
- ("\\\"X" ?Ẍ)
- ("\\\"h" ?ḧ)
- ("\\\"t" ?ẗ)
- ("\\\"w" ?ẅ)
- ("\\\"x" ?ẍ)
- ("\\^" ?̂)
- ("\\^Z" ?Ẑ)
- ("\\^z" ?ẑ)
- ("\\`" ?̀)
- ("\\`W" ?Ẁ)
- ("\\`Y" ?Ỳ)
- ("\\`w" ?ẁ)
- ("\\`y" ?ỳ)
("\\b" ?̱)
- ("\\c" ?̧)
- ("\\c{D}" ?Ḑ)
- ("\\c{H}" ?Ḩ)
- ("\\c{d}" ?ḑ)
- ("\\c{h}" ?ḩ)
+
("\\d" ?̣)
- ("\\d{A}" ?Ạ)
- ("\\d{B}" ?Ḅ)
- ("\\d{D}" ?Ḍ)
- ("\\d{E}" ?Ẹ)
- ("\\d{H}" ?Ḥ)
- ("\\d{I}" ?Ị)
- ("\\d{K}" ?Ḳ)
- ("\\d{L}" ?Ḷ)
- ("\\d{M}" ?Ṃ)
- ("\\d{N}" ?Ṇ)
- ("\\d{O}" ?Ọ)
- ("\\d{R}" ?Ṛ)
- ("\\d{S}" ?Ṣ)
- ("\\d{T}" ?Ṭ)
- ("\\d{U}" ?Ụ)
- ("\\d{V}" ?Ṿ)
- ("\\d{W}" ?Ẉ)
- ("\\d{Y}" ?Ỵ)
- ("\\d{Z}" ?Ẓ)
- ("\\d{a}" ?ạ)
- ("\\d{b}" ?ḅ)
- ("\\d{d}" ?ḍ)
- ("\\d{e}" ?ẹ)
- ("\\d{h}" ?ḥ)
- ("\\d{i}" ?ị)
- ("\\d{k}" ?ḳ)
- ("\\d{l}" ?ḷ)
- ("\\d{m}" ?ṃ)
- ("\\d{n}" ?ṇ)
- ("\\d{o}" ?ọ)
- ("\\d{r}" ?ṛ)
- ("\\d{s}" ?ṣ)
- ("\\d{t}" ?ṭ)
- ("\\d{u}" ?ụ)
- ("\\d{v}" ?ṿ)
- ("\\d{w}" ?ẉ)
- ("\\d{y}" ?ỵ)
- ("\\d{z}" ?ẓ)
+ ;; ("\\d{}" ?) ;; FIXME: can't find the DOT BELOW character.
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\d{%s}" c) ;; (format "\\d%s" c)
+ )))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH DOT BELOW")
+
("\\rq" ?’)
- ("\\u" ?̆)
- ("\\v" ?̌)
- ("\\v{L}" ?Ľ)
- ("\\v{i}" ?ǐ)
- ("\\v{j}" ?ǰ)
- ("\\v{l}" ?ľ)
- ("\\yen" ?¥)
+
+ ;; FIXME: Provides some useful entries (yen, euro, copyright, registered,
+ ;; currency, minus, micro), but also a lot of dubious ones.
+ ((lambda (name char)
+ (unless (latin-ltx--ascii-p char)
+ (concat "\\" (downcase (match-string 1 name)))))
+ "\\`\\([^- ]+\\) SIGN\\'")
+
+ ((lambda (name char)
+ (concat "\\" (funcall (if (match-end 1) #' capitalize #'downcase)
+ (match-string 2 name))))
+ "\\`GREEK \\(?:SMALL\\|CAPITA\\(L\\)\\) LETTER \\([^- ]+\\)\\'")
("\\Box" ?□)
("\\Bumpeq" ?≎)
("\\Cap" ?⋒)
("\\Cup" ?⋓)
- ("\\Delta" ?Δ)
("\\Diamond" ?◇)
("\\Downarrow" ?⇓)
- ("\\Gamma" ?Γ)
- ("\\H" ?̋)
("\\H{o}" ?ő)
("\\Im" ?ℑ)
("\\Join" ?⋈)
- ("\\Lambda" ?Λ)
("\\Leftarrow" ?⇐)
("\\Leftrightarrow" ?⇔)
("\\Ll" ?⋘)
@@ -528,27 +309,18 @@ system, including many technical ones. Examples:
("\\Longleftrightarrow" ?⇔)
("\\Longrightarrow" ?⇒)
("\\Lsh" ?↰)
- ("\\Omega" ?Ω)
- ("\\Phi" ?Φ)
- ("\\Pi" ?Π)
- ("\\Psi" ?Ψ)
("\\Re" ?ℜ)
("\\Rightarrow" ?⇒)
("\\Rrightarrow" ?⇛)
("\\Rsh" ?↱)
- ("\\Sigma" ?Σ)
("\\Subset" ?⋐)
("\\Supset" ?⋑)
- ("\\Theta" ?Θ)
("\\Uparrow" ?⇑)
("\\Updownarrow" ?⇕)
- ("\\Upsilon" ?Υ)
("\\Vdash" ?⊩)
("\\Vert" ?‖)
("\\Vvdash" ?⊪)
- ("\\Xi" ?Ξ)
("\\aleph" ?ℵ)
- ("\\alpha" ?α)
("\\amalg" ?∐)
("\\angle" ?∠)
("\\approx" ?≈)
@@ -563,7 +335,6 @@ system, including many technical ones. Examples:
("\\backslash" ?\\)
("\\barwedge" ?⊼)
("\\because" ?∵)
- ("\\beta" ?β)
("\\beth" ?ℶ)
("\\between" ?≬)
("\\bigcap" ?⋂)
@@ -602,7 +373,7 @@ system, including many technical ones. Examples:
("\\circledcirc" ?⊚)
("\\circleddash" ?⊝)
("\\clubsuit" ?♣)
- ("\\colon" ?:)
+ ("\\colon" ?:) ;FIXME: Conflict with "COLON SIGN" ₡.
("\\coloneq" ?≔)
("\\complement" ?∁)
("\\cong" ?≅)
@@ -623,7 +394,6 @@ system, including many technical ones. Examples:
("\\ddag" ?‡)
("\\ddagger" ?‡)
("\\ddots" ?⋱)
- ("\\delta" ?δ)
("\\diamond" ?⋄)
("\\diamondsuit" ?♢)
("\\digamma" ?Ϝ)
@@ -638,14 +408,11 @@ system, including many technical ones. Examples:
("\\downrightharpoon" ?⇂)
("\\ell" ?ℓ)
("\\emptyset" ?∅)
- ("\\epsilon" ?ε)
("\\eqcirc" ?≖)
("\\eqcolon" ?≕)
("\\eqslantgtr" ?⋝)
("\\eqslantless" ?⋜)
("\\equiv" ?≡)
- ("\\eta" ?η)
- ("\\euro" ?€)
("\\exists" ?∃)
("\\fallingdotseq" ?≒)
("\\flat" ?♭)
@@ -667,7 +434,6 @@ system, including many technical ones. Examples:
("\\frac58" ?⅝)
("\\frac78" ?⅞)
("\\frown" ?⌢)
- ("\\gamma" ?γ)
("\\ge" ?≥)
("\\geq" ?≥)
("\\geqq" ?≧)
@@ -697,9 +463,6 @@ system, including many technical ones. Examples:
("\\infty" ?∞)
("\\int" ?∫)
("\\intercal" ?⊺)
- ("\\iota" ?ι)
- ("\\kappa" ?κ)
- ("\\lambda" ?λ)
("\\langle" ?〈)
("\\lbrace" ?{)
("\\lbrack" ?\[)
@@ -783,7 +546,7 @@ system, including many technical ones. Examples:
("\\nleqslant" ?≰)
("\\nless" ?≮)
("\\nmid" ?∤)
- ("\\not" ?̸)
+ ("\\not" ?̸) ;FIXME: conflict with "NOT SIGN" ¬.
("\\notin" ?∉)
("\\nparallel" ?∦)
("\\nprec" ?⊀)
@@ -805,13 +568,11 @@ system, including many technical ones. Examples:
("\\ntrianglelefteq" ?⋬)
("\\ntriangleright" ?⋫)
("\\ntrianglerighteq" ?⋭)
- ("\\nu" ?ν)
("\\nvDash" ?⊭)
("\\nvdash" ?⊬)
("\\nwarrow" ?↖)
("\\odot" ?⊙)
("\\oint" ?∮)
- ("\\omega" ?ω)
("\\ominus" ?⊖)
("\\oplus" ?⊕)
("\\oslash" ?⊘)
@@ -820,8 +581,6 @@ system, including many technical ones. Examples:
("\\parallel" ?∥)
("\\partial" ?∂)
("\\perp" ?⊥)
- ("\\phi" ?φ)
- ("\\pi" ?π)
("\\pitchfork" ?⋔)
("\\prec" ?≺)
("\\precapprox" ?≾)
@@ -832,7 +591,6 @@ system, including many technical ones. Examples:
("\\prime" ?′)
("\\prod" ?∏)
("\\propto" ?∝)
- ("\\psi" ?ψ)
("\\qed" ?∎)
("\\quad" ? )
("\\rangle" ?〉)
@@ -857,7 +615,6 @@ system, including many technical ones. Examples:
("\\sharp" ?♯)
("\\shortmid" ?∣)
("\\shortparallel" ?∥)
- ("\\sigma" ?σ)
("\\sim" ?∼)
("\\simeq" ?≃)
("\\smallamalg" ?∐)
@@ -896,9 +653,7 @@ system, including many technical ones. Examples:
("\\supsetneqq" ?⊋)
("\\surd" ?√)
("\\swarrow" ?↙)
- ("\\tau" ?τ)
("\\therefore" ?∴)
- ("\\theta" ?θ)
("\\thickapprox" ?≈)
("\\thicksim" ?∼)
("\\to" ?→)
@@ -918,19 +673,18 @@ system, including many technical ones. Examples:
("\\upleftharpoon" ?↿)
("\\uplus" ?⊎)
("\\uprightharpoon" ?↾)
- ("\\upsilon" ?υ)
("\\upuparrows" ?⇈)
("\\urcorner" ?⌝)
("\\u{i}" ?ĭ)
("\\vDash" ?⊨)
- ("\\varkappa" ?ϰ)
- ("\\varphi" ?ϕ)
- ("\\varpi" ?ϖ)
+
+ ((lambda (name char)
+ (concat "\\var" (downcase (match-string 1 name))))
+ "\\`GREEK \\([^- ]+\\) SYMBOL\\'")
+
("\\varprime" ?′)
("\\varpropto" ?∝)
- ("\\varrho" ?ϱ)
- ("\\varsigma" ?ς)
- ("\\vartheta" ?ϑ)
+ ("\\varsigma" ?ς) ;FIXME: Looks reversed with the non\var.
("\\vartriangleleft" ?⊲)
("\\vartriangleright" ?⊳)
("\\vdash" ?⊢)
@@ -941,8 +695,6 @@ system, including many technical ones. Examples:
("\\wedge" ?∧)
("\\wp" ?℘)
("\\wr" ?≀)
- ("\\xi" ?ξ)
- ("\\zeta" ?ζ)
("\\Bbb{N}" ?ℕ) ; AMS commands for blackboard bold
("\\Bbb{P}" ?ℙ) ; Also sometimes \mathbb.
@@ -954,8 +706,6 @@ system, including many technical ones. Examples:
;; a bug where the user finds his ~ key doesn't insert a ~ any more.
("\\ " ? )
("\\\\" ?\\)
- ("\\mu" ?μ)
- ("\\rho" ?ρ)
("\\mathscr{I}" ?ℐ) ; moment of inertia
("\\Smiley" ?☺)
("\\blacksmiley" ?☻)
@@ -980,13 +730,10 @@ system, including many technical ones. Examples:
;; ("\\Writinghand" ?✍)
;; ("\\Yinyang" ?☯)
;; ("\\Heart" ?♡)
- ("\\registered" ?®)
- ("\\currency" ?¤)
("\\dh" ?ð)
("\\DH" ?Ð)
("\\th" ?þ)
("\\TH" ?Þ)
- ("\\micro" ?µ)
("\\lnot" ?¬)
("\\ordfeminine" ?ª)
("\\ordmasculine" ?º)
@@ -995,7 +742,6 @@ system, including many technical ones. Examples:
;; by analogy with lq, rq:
("\\ldq" ?\“)
("\\rdq" ?\”)
- ("\\minus" ?−)
("\\defs" ?≙) ; per fuzz/zed
;; ("\\sqrt[3]" ?∛)
("\\llbracket" ?\〚) ; stmaryrd
diff --git a/leim/quail/latin-post.el b/leim/quail/latin-post.el
index bca518b5121..0fd41b05ff9 100644
--- a/leim/quail/latin-post.el
+++ b/leim/quail/latin-post.el
@@ -1,6 +1,6 @@
;;; latin-post.el --- Quail packages for inputting various European characters -*-coding: utf-8;-*-
-;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/leim/quail/latin-pre.el b/leim/quail/latin-pre.el
index c45a3009970..622662e463e 100644
--- a/leim/quail/latin-pre.el
+++ b/leim/quail/latin-pre.el
@@ -1,6 +1,6 @@
;;; latin-pre.el --- Quail packages for inputting various European characters -*-coding: utf-8;-*-
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/leim/quail/lrt.el b/leim/quail/lrt.el
index d184db3317a..6cba9086e9b 100644
--- a/leim/quail/lrt.el
+++ b/leim/quail/lrt.el
@@ -1,6 +1,6 @@
;;; lrt.el --- Quail package for inputting Lao characters by LRT method -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/leim/quail/persian.el b/leim/quail/persian.el
index b6b3146cc8d..f4e74011ad8 100644
--- a/leim/quail/persian.el
+++ b/leim/quail/persian.el
@@ -1,9 +1,9 @@
;;; persian.el --- Quail package for inputting Persian/Farsi keyboard -*- coding: utf-8;-*-
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
-;; Author: Mohsen BANAN <libre@mohsen.banan.1.byname.net>
-;; http://mohsen.banan.1.byname.net/contact
+;; Author: Mohsen BANAN <libre@mohsen.1.banan.byname.net>
+;; X-URL: http://mohsen.1.banan.byname.net/contact
;; Keywords: multilingual, input method, Farsi, Persian, keyboard
@@ -22,17 +22,18 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;; This is a Halaal Poly-Existential intended to remain perpetually Halaal.
-
;;; Commentary:
;;
;; This file contains a collection of input methods for
-;; Persian languages - Farsi, Urdu, Pashto (Afghani), ...
+;; Persian languages (Farsi, Urdu, Pashto/Afghanic, ...)
;;
;; At this time, the following input methods are specified:
;;
-;; - (farsi) Persian Keyboard based on Islamic Republic of Iran's ISIR-9147
-;; - (farsi-translit) Intuitive transliteration keyboard layout for Persian
+;; - (farsi-isiri-9149) Persian Keyboard based on Islamic Republic of Iran's ISIRI-9147
+;; - (farsi-transliterate-banan) An intuitive transliteration keyboard for Farsi
+;;
+;; Additional documentation for these input methods can be found at:
+;; http://www.persoarabic.org/PLPC/120036
;;
;;; Code:
@@ -42,42 +43,79 @@
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
-;; farsi
+;; farsi-isiri-9147
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; The keyboard mapping defined here is based on:
+;; فنّاوریِ اطلاعات - چیدمان حروف و علائم فارسی بر صفحه کلید رایانه
+;; استاندارد ملی ایران ۹۱۴۷ − چاپ اول
+;;
+;; Institute of Standards and Industrial Research of Iran
+;; Information Technology – Layout of Persian Letters and Symbols
+;; on Computer Keyboards
+;; ISIRI 9147 -- 1st edition
+;; Published at: http://www.isiri.org/portal/files/std/9147.pdf
+;; Re-Published at: http://www.persoarabic.org/Repub/fpf-isiri-9147
+;;
+;;
+;; Specification of Iran's Persian Character Set is also relevant:
+;; فنّاوریِ اطلاعات -- تبادل و شیوه‌ی نمایش اطلاعاتِ فارسی بر اساس یونی کُد
+;; استاندارد ملی ایران ۶۲۱۹ −− نسخهی نهایی
;;
-;; Institute of Standards and Industrial Research of Iran
-;; Information Technology – Layout of Persian Letters and Symbols on Computer Keyboards
-;; ISIRI 9147 -- 1st edition
-;; http://www.isiri.org/UserStd/DownloadStd.aspx?id=9147
+;; Institute of Standards and Industrial Research of Iran
+;; Information Technology – Persian Information Interchange and Display Mechanism, using Unicode
+;; ISIRI-6219 Final Version
+;; Published at: http://www.isiri.org/portal/files/std/6219.htm
+;; Re-Published at: http://www.persoarabic.org/Repub/fpf-isiri-6219
;;
-;; Only layers 1 and 2 of ISIRI-9147 are applicable to emacs.
+;; Layers 1, 2 and 3 of ISIRI-9147 are fully implemented with the
+;; exception of the Backslash, Alt-Backslash, Shift-Space and
+;; Alt-Space keys.
;;
-;; This input method was built using the Farsi table in X Keyboard Configuration Data Base.
+;; The Backslash key is used to replace کلید با دگر ساز راست‌ -- the Alt or
+;; Meta key.
;;
-;; 0) Selected gnome keyboard "USA"
-;; 1) Created a list of all keys
-;; 2) Selected gnome keyboard "Iran"
-;; 3) For each key just press it and get the mapped persian character
+;; Layer 3 is then entered with the Backslash key and Layer 3 is
+;; implemented as two letter keys as specified in ISIRI-9147.
+;;
+;; The character corresponding to Backslash is entered with Backslash-Backslash.
+;; Alt-Backslash has been moved to Backslash-r.
+;; Alt-Space has been moved to Backslash-t.
+;; Shift-Space has been moved to Backslash-y.
+;;
+;; With these modifications, farsi-isiri-9147 is a full implementation
+;; of ISIRI-9147. Additionally, these modifications allow for this
+;; implementation to be ascii input stream based -- in addition to
+;; being a keyboard layout.
+;;
+;; If a key on Layer 1 was reserved to replace دگر ساز راست‌ (the Alt
+;; or Meta key), then farsi-isiri-9147 could have claimed full
+;; compliance -- without the need for the above description. Perhaps
+;; this can be considered a flaw in the base ISIRI-9147 specification
+;; to be addressed in the next revision.
;;
(quail-define-package
- "farsi" "Farsi" " ف" nil "Farsi input method.
+ "farsi-isiri-9147" "Persian" " ف" nil
+ "Farsi keyboard based on ISIRI-9147.
+ See http://www.persoarabic.org/PLPC/120036 for additional documentation."
+ nil t t t t nil nil nil nil nil t)
+
+;; Note: the rows of keys below are enclosed in Left-To-Right Override
+;; embedding, to prevent them from being reordered by the Emacs
+;; display engine.
-Based on ISIRI-9149 Layout of Persian Letters and Symbols on Computer Keyboards.
-" nil t t t t nil nil nil nil nil t)
;; +----------------------------------------------------------------+
-;; | ۱! | ۲٬ | ۳٫ | ۴﷼ | ۵٪ | ۶× | ۷، | ۸* | ۹) | ۰( | -ـ | =+ | `÷ |
+;; ‭| ۱! | ۲٬ | ۳٫ | ۴﷼ | ۵٪ | ۶× | ۷، | ۸* | ۹( | ۰) | -ـ | =+ | `÷ |‬
;; +----------------------------------------------------------------+
-;; | ضْ| صٌ| ثٍ| قً| فُ| غِ| عَ| هّ| خ] | ح[ | ج} | چ{ |
+;; ‭| ضْ| صٌ| ثٍ| قً| فُ| غِ| عَ| هّ| خ] | ح[ | ج{ | چ} |‬
;; +------------------------------------------------------------+
-;; | شؤ | سئ | یي | بإ | لأ | اآ | تة | ن» | م« | ک: | گ؛ | \| |
+;; ‭| ش‌ؤ | س‌ئ | ی‌ي | ب‌إ | لأ | اآ | ت‌ة | ن« | م» | ک: | گ؛ | \| |‬
;; +-----------------------------------------------------------+
-;; | ظك | طٓ| زژ | رٰ| ذB | دٔ| پء | و> | .< | /؟ |
+;; ‭| ظ‌ك | طٓ| زژ | رٰ| ذB | دٔ| پء | و< | .> | /؟ |‬
;; +-------------------------------------------+
(quail-define-rules
@@ -93,7 +131,7 @@ Based on ISIRI-9149 Layout of Persian Letters and Symbols on Computer Keyboards.
("0" ?۰)
("-" ?-)
("=" ?=)
- ;;("`" ?‍\)) ;; اتصال مجازى
+ ("`" ?\u200D) ;; ZWJ -- ZERO WIDTH JOINER اتصال مجازى
("q" ?ض)
("w" ?ص)
("e" ?ث)
@@ -117,7 +155,7 @@ Based on ISIRI-9149 Layout of Persian Letters and Symbols on Computer Keyboards.
("l" ?م)
(";" ?ک)
("'" ?گ)
- ("\\" ?\\) ;; خط اريب وارو
+
("z" ?ظ)
("x" ?ط)
("c" ?ز)
@@ -170,93 +208,209 @@ Based on ISIRI-9149 Layout of Persian Letters and Symbols on Computer Keyboards.
("X" ?ٓ)
("C" ?ژ)
("V" ?ٰ)
- ;; ("B" ?‌‌) ;; فاصلهً مجازى
+ ("B" ?\u200C) ;; ZWNJ -- ZERO WIDTH NON-JOINER فاصلهٔ مجازى
("N" ?ٔ) ;; همزه فارسى بالا
("M" ?ء) ;; harf farsi hamzeh
("<" ?>)
(">" ?<)
("?" ?؟)
+
+ ;; Level 3 Entered with \
+ ;;
+ ("\\" ?\\) ;; خط اريب وارو
+ ("\\\\" ?\\)
+ ("\\~" ?\u007E)
+ ("\\1" ?\u0060)
+ ("\\2" ?\u0040)
+ ("\\3" ?\u0023)
+ ("\\4" ?\u0024)
+ ("\\5" ?\u0025)
+ ("\\6" ?\u005E)
+ ("\\7" ?\u0026)
+ ("\\8" ?\u2022)
+ ("\\9" ?\u200E)
+ ("\\0" ?\u200F)
+ ("\\-" ?\u005F)
+ ("\\+" ?\u2212)
+ ("\\q" ?\u00B0)
+ ;;\\w" ?\u0000)
+ ("\\e" ?\u20AC)
+ ("\\r" ?\u2010) ;; replacement for Alt-BSL
+ ("\\t" ?\u00A0) ;; replacement for ALT-SPC
+ ("\\y" ?\u200C) ;; replacement for SHIFT-SPC
+ ;;("\\u" ?\u0000)
+ ("\\i" ?\u202D)
+ ("\\o" ?\u202E)
+ ("\\p" ?\u202C)
+ ("\\[" ?\u202A)
+ ("\\]" ?\u202B)
+ ;;("\\a" ?\u0000)
+ ;;("\\s" ?\u0000)
+ ("\\d" ?\u0649)
+ ;;("\\f" ?\u0000)
+ ;;("\\g" ?\u0000)
+ ("\\h" ?\u0671)
+ ;;("\\j" ?\u0000)
+ ("\\k" ?\uFD3E)
+ ("\\l" ?\uFD3F)
+ ("\\;" ?\u003B)
+ ("\\'" ?\u0022)
+ ;;("\\z" ?\u0000)
+ ;;("\\x" ?\u0000)
+ ;;("\\c" ?\u0000)
+ ("\\v" ?\u0656)
+ ("\\b" ?\u200D)
+ ("\\n" ?\u0655)
+ ("\\m" ?\u2026)
+ ("\\," ?\u002C)
+ ("\\." ?\u0027)
+ ("\\?" ?\u003F)
+ ;;("\\\\" ?\u2010) ;; Moved to backslash r to leave room for BSL-BSL
)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
-;; farsi-translit
+;; farsi-transliterate-banan
+;;
+;; Given a Qwerty keyboard, use Persian-to-Latin transliteration knowledge
+;; to reverse transliterate in persian
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
-;;; This is a persian/farsi transliteration keyboard designed
-;;; for people who:
-;;; - Know how to write in farsi
-;;; - Are comfortable with the qwerty keyboard
-;;; - Are familiar with two letter phonetic mapping to persian characters
-;;; (e.g.: gh, kh, ch, sh, zh, hh, lh)
-;;;
-;;; This translit keyboard is designed to be intuitive such that
-;;; mapping are easy and natural to remember for a persian writer.
-;;; For some persian characters there are multiple ways of inputting
-;;; the same character.
+;;; See http://www.persoarabic.org/PLPC/120036 document for more complete
+;;; documentation of keyboard bindings and usage instructions.
;;;
-;;; The letter 'h' is used for a number of two character mappings,
-;;; this means that some character sequence inputs need to be repeated
-;;; followed by a backspace followed by the 'h'.
-;;; For example: سحر = 's' 's' '<bs>' 'h' 'h' 'r'
-;;; In practice such sequences are rare.
-;;;
-
+;;
+;; ISIRI-9147 Persian keyboard is generally not well suited for Iranian-Expatriates
+;; working/living in the West.
+;;
+;; The qwerty keyboard is usually second nature to Persian speaking expatriates and they
+;; don't want to learn/adapt to ISIRI-9147. They expect software to adapt to them.
+;;
+;; That is what the ``Banan Multi-Character (Reverse) Transliteration Persian Input Method'' does.
+;;
+;; The typical profile of the user is assumed to be one who:
+;;
+;; - can write in farsi (not just speak it).
+;; - is fully comfortable with a qwerty latin keyboard.
+;; - is not familiar with isir-9147 and does not wish to be trained.
+;; - communicates and writes in a mixed globish/persian -- not pure persian.
+;; - is intuitively familiar with transliteration of farsi/persian into latin based on two letter
+;; phonetic mapping to persian characters (e.g., gh ق -- kh خ -- sh ش -- ch چ -- zh ژ.
+;;
+;; This transliteration keyboard is designed to be intuitive such that
+;; mapping are easy and natural to remember for a persian writer.
+;; It is designed to be equivalent in capability to farsi-isiri-9147
+;; and provide for inputting all characters enumerated in ISIRI-6219.
+;;
+;; farsi-transliterate-banan is of course phonetic oriented. But it is very different from
+;; pinglish. Pinglish is word oriented where you sound out the word with latin letters --
+;; including the vowels. farsi-transliterate-banan is letter oriented where you enter the
+;; latin letter/letters closest to the persian letter. And usually omit vowels.
+;;
+;; For some persian characters there are multiple ways of inputting
+;; the same character. For example both ``i'' and ``y'' produce ی.
+;; For یک ``yk'', ``y'' is more natural and for این ``ain'', ``i'' is more natural.
+;;
+;; The more frequently used keys are mapped to lower case. The less frequently used letter moves to
+;; upper case. For example: ``s'' is س and ``S'' is ص. ``h'' is ه and ``H''
+;; is ح.
+;;
+;; Multi-character input is based on \, &, and / prefix
+;; characters. The letter 'h' is used as a postfix for the following two character mappings:
+;; gh ق -- kh خ -- sh ش -- ch چ -- zh ژ -- Th ة -- Yh ى.
+;;
+;;
+;; Prefix letter \ is used for two character inputs when an alternate form of a letter
+;; is desired for example '\-' is: '÷' when '-' is: '-'.
+;;
+;; Prefix letter & is used for multi-character inputs when special characters are
+;; desired based on their abbreviate name. For example you can enter &lrm; to enter the
+;; ``LEFT-TO-RIGHT MARK'' character.
+;;
+;; Prefix letter / is used to provide two characters. / is: ``ZERO WIDTH NON-JOINER''
+;; and // is /.
+;;
+;; The letter 'h' is used in a number of two character postfix mappings,
+;; for example ``sh'' ش. So if you need the sequence of ``s'' and ``h'' you
+;; need to repeat the ``s''. For example: سهم = 's' 's' 'h' 'm'.
+;;
(quail-define-package
- "farsi-translit" "Farsi" "پ" t
+ "farsi-transliterate-banan" "Persian" "ب" t
"Intuitive transliteration keyboard layout for persian/farsi.
-" nil t t t t nil nil nil nil nil t)
+ See http://www.persoarabic.org/PLPC/120036 for additional documentation."
+ nil t t t t nil nil nil nil nil t)
(quail-define-rules
- ("a" ?ا)
- ("A" ?آ) ;; alef madde
- ("b" ?ب)
- ("p" ?پ)
+;;;;;;;;;;; isiri-6219 Table 5 -- جدول ۵ - حروِفِ اصلیِ فارسی
+ ("W" ?ء) ;; hamzeh
+ ("A" ?آ) ;; U+0622 & ARABIC LETTER ALEF WITH MADDA ABOVE & الف با کلاه
+ ("a" ?ا) ;; U+0627 & ARABIC LETTER ALEF & الف
+ ("\\a" ?أ)
+ ("b" ?ب) ;; U+0628 & ARABIC LETTER BEH &
+ ("p" ?پ) ;; U+067e & ARABIC LETTER PEH &
("t" ?ت)
+ ("tt" ?ت)
("c" ?ث)
+ ("cc" ?ث)
("j" ?ج)
("ch" ?چ)
- ("hh" ?ح)
+ ("H" ?ح)
+ ("hh" ?ح)
("kh" ?خ)
("d" ?د)
("Z" ?ذ)
("r" ?ر)
("z" ?ز)
+ ("zz" ?ز)
("zh" ?ژ)
("s" ?س)
+ ("ss" ?س)
("sh" ?ش)
("S" ?ص)
("x" ?ض)
("T" ?ط)
+ ("TT" ?ط)
("X" ?ظ)
("w" ?ع)
- ("Q" ?غ)
+ ("q" ?غ)
+ ("G" ?غ)
+ ("Gh" ?غ)
+ ("GG" ?غ)
("f" ?ف)
- ("q" ?ق)
+ ("Q" ?ق)
("gh" ?ق)
("k" ?ک)
- ("K" ?ك) ;; Arabic kaf
+ ("kk" ?ک)
("g" ?گ)
+ ("gg" ?گ)
("l" ?ل)
- ("lh" ?ﻻ)
("m" ?م)
("n" ?ن)
("v" ?و)
- ("V" ?ؤ)
("u" ?و)
- ("H" ?ه)
+ ("V" ?ؤ)
("h" ?ه)
- ("th" ?ة) ;; ta marbuteh
- ("yh" ?ۀ) ;; he ye
- ("y" ?ى)
- ("i" ?ي)
+ ("y" ?ی)
+ ("i" ?ی)
("I" ?ئ)
+
+;;;;;;;;;;; isiri-6219 Table 6 -- جدول ۶ - حروِفِ عربی
+ ("F" ?إ)
+ ("D" ?\u0671) ;; (ucs-insert #x0671)ٱ named: حرفِ الفِ وصل
+ ("K" ?ك) ;; Arabic kaf
+ ("Th" ?ة) ;; ta marbuteh
+ ("Y" ?ي)
+ ("YY" ?ي)
+ ("Yh" ?ى)
+
+;;;;;;;;;;; isiri-6219 Table 4 -- جدول ۴ - ارقام و علائم ریاضی
+ ("0" ?۰)
("1" ?۱)
("2" ?۲)
("3" ?۳)
@@ -266,31 +420,107 @@ Based on ISIRI-9149 Layout of Persian Letters and Symbols on Computer Keyboards.
("7" ?۷)
("8" ?۸)
("9" ?۹)
- ("0" ?۰)
- ("F" ?إ)
- ("G" ?أ)
+ ("\\/" ?\u066B) ;; (ucs-insert #x066B)٫ named: ممیزِ فارسی
+ ("\\," ?\u066C) ;; (ucs-insert #x066C)٬ named: جداکننده‌ی هزارهای فارسی
+ ("%" ?\u066A) ;; (ucs-insert #x066A)٪ named: درصدِ فارسی
+ ("+" ?\u002B) ;; (ucs-insert #x002B)+ named: علامتِ به‌اضافه
+ ("-" ?\u2212) ;; (ucs-insert #x2212)− named: علامتِ منها
+ ("\\*" ?\u00D7) ;; (ucs-insert #x00D7)× named: علامتِ ضرب
+ ("\\-" ?\u00F7) ;; (ucs-insert #x00F7)÷ named: علامتِ تقسیم
+ ("<" ?\u003C) ;; (ucs-insert #x003C)< named: علامتِ کوچکتر
+ ("=" ?\u003D) ;; (ucs-insert #x003D)= named: علامتِ مساوی
+ (">" ?\u003E) ;; (ucs-insert #x003E)> named: علامتِ بزرگتر
- ("~" ?ّ) ;; tashdid ;; تشديد فارسى
- ("`" ?ٓ)
- ("e" ?ِ) ;; zir زير فارسى -- فتحه
- ("E" ?ٍ) ;; eizan ;; دو زير فارسى -- تنوين جر
- ("#" ?ً) ;; ً tanvin nasb ;; دو زبر فارسى -- تنوين نصب
- ("@" ?ْ) ;; ساکن فارسى
- ("^" ?َ) ;; zbar ;; زبر فارسى -- فتحه
- ("o" ?ُ) ;; peesh ;; پيش فارسى -- ضمه
- ("O" ?ٌ) ;; دو پيش فارسى -- تنوين رفع
- ("?" ?؟) ;; alamat soal
- ("&" ?ٔ) ;; همزه فارسى بالا
- ("$" ?ء) ;; hamzeh
- ("%" ?÷) ;;
- ("*" ?×) ;;
- (";" ?؛) ;;
- (",h" ?،) ;; farsi
- (",h" ?,) ;; latin
+
+;;;;;;;;;;; isiri-6219 Table 2 -- جدول ۲ - علائم نقطه گذاریِ مشترک
+ ;;; Space
("." ?.) ;;
+ (":" ?\u003A) ;; (ucs-insert #x003A): named:
+ ("!" ?\u0021) ;; (ucs-insert #x0021)! named:
+ ("\\." ?\u2026) ;; (ucs-insert #x2026)… named:
+ ("\\-" ?\u2010) ;; (ucs-insert #x2010)‐ named:
+ ("-" ?\u002D) ;; (ucs-insert #x002D)- named:
+ ("|" ?|)
+ ;;("\\\\" ?\)
+ ("//" ?/)
+ ("*" ?\u002A) ;; (ucs-insert #x002A)* named:
+ ("(" ?\u0028) ;; (ucs-insert #x0028)( named:
+ (")" ?\u0029) ;; (ucs-insert #x0029)) named:
+ ("[" ?\u005B) ;; (ucs-insert #x005B)[ named:
+ ("[" ?\u005D) ;; (ucs-insert #x005D)] named:
+ ("{" ?\u007B) ;; (ucs-insert #x007B){ named:
+ ("}" ?\u007D) ;; (ucs-insert #x007D)} named:
+ ("\\<" ?\u00AB) ;; (ucs-insert #x00AB)« named:
+ ("\\>" ?\u00BB) ;; (ucs-insert #x00BB)» named:
+ ("N" ?\u00AB) ;; (ucs-insert #x00AB)« named:
+ ("M" ?\u00BB) ;; (ucs-insert #x00BB)» named:
+
+;;;;;;;;;;; isiri-6219 Table 3 -- جدول ۳ - علائم نقطه گذاریِ فارسی
+ ("," ?،) ;; farsi
+ (";" ?؛) ;;
+ ("?" ?؟) ;; alamat soal
("_" ?ـ) ;;
-)
+;;;;;;;;;;; isiri-6219 Table 1 -- جدول ۱ - نویسه‌های کنترلی
+ ;; LF
+ ;; CR
+ ("&zwnj;" ?\u200C) ;; (ucs-insert #x200C)‌ named: فاصله‌ی مجازی
+ ("/" ?\u200C) ;;
+ ("&zwj;" ?\u200D) ;; (ucs-insert #x200D)‍ named: اتصالِ مجازی
+ ("J" ?\u200D) ;;
+ ("&lrm;" ?\u200E) ;; (ucs-insert #x200E)‎ named: نشانه‌ی چپ‌به‌راست
+ ("&rlm;" ?\u200F) ;; (ucs-insert #x200F)‏ named: نشانه‌ی راست‌به‌چپ
+ ("&ls;" ?\u2028) ;; (ucs-insert #x2028)
 named: جداکننده‌ی سطرها
+ ("&ps;" ?\u2028) ;; (ucs-insert #x2029)
 named: جداکننده‌ی بندها
+ ("&lre;" ?\u202A) ;; (ucs-insert #x202A)‪ named: زیرمتنِ چپ‌به‌راست
+ ("&rle;" ?\u202B) ;; (ucs-insert #x202B) named: زیرمتنِ راست‌به‌چپ
+ ("&pdf;" ?\u202C) ;; (ucs-insert #x202C) named: پایانِ زیرمتن
+ ("&lro;" ?\u202D) ;; (ucs-insert #x202D) named: زیرمتنِ اکیداً چپ‌به‌راست
+ ("&rlo;" ?\u202D) ;; (ucs-insert #x202E) named: زیرمتنِ اکیداً راست‌به‌چپ
+ ("&bom;" ?\uFEFF) ;; (ucs-insert #xFEFF) named: نشانه‌ی ترتیبِ بایت‌ها
+
+
+;;;;;;;;;;; isiri-6219 Table 7 -- جدول ۷ - نشانه‌هایِ فارسی
+ ("^" ?َ) ;; zbar ;; زبر فارسى
+ ("e" ?ِ) ;; zir زير فارسى
+ ("o" ?ُ) ;; peesh ;; پيش فارسى -- ضمه
+ ("E" ?ٍ) ;; eizan ;; دو زير فارسى -- تنوين جر
+ ("#" ?ً) ;; دو زبر
+ ("O" ?ٌ) ;; دو پيش فارسى -- تنوين رفع
+ ("~" ?ّ) ;; tashdid ;; تشديد فارسى
+ ("@" ?ْ) ;; ساکن فارسى
+ ("U" ?\u0653) ;; (ucs-insert #x0653)ٓ named: مدِ فارسی
+ ("`" ?ٔ) ;; همزه فارسى بالا
+ ("C" ?\u0655) ;; (ucs-insert #x0655)ٕ named: همزه فارسى پایین
+ ("$" ?\u0670) ;; (ucs-insert #x0670)ٰ named: الفِ مقصوره‌ی فارسی
+
+
+;;;;;;;;;;; isiri-6219 Table 8 - Forbidden Characters -- جدول ۸ - نویسه‌هایِ ممنوع
+;; ;; he ye (ucs-insert 1728) (ucs-insert #x06c0) kills emacs-24.0.90
+;; arabic digits 0-9
+
+
+;;;;;;; Latin Extensions
+ ("\\" ?\\) ;; خط اريب وارو
+ ("\\\\" ?\\)
+ ("\\~" ?~)
+ ("\\@" ?@)
+ ("\\#" ?#)
+ ("\\$" ?\uFDFC) ;; (ucs-insert #xFDFC)﷼ named:
+ ("\\^" ?^)
+ ("\\1" ?1)
+ ("\\2" ?2)
+ ("\\3" ?3)
+ ("\\4" ?4)
+ ("\\5" ?5)
+ ("\\6" ?6)
+ ("\\7" ?7)
+ ("\\8" ?8)
+ ("\\9" ?9)
+ ("\\0" ?0)
+
+)
+
;;; persian.el ends here
diff --git a/leim/quail/py-punct.el b/leim/quail/py-punct.el
index 947f54c76fa..839242af05e 100644
--- a/leim/quail/py-punct.el
+++ b/leim/quail/py-punct.el
@@ -1,6 +1,6 @@
;;; py-punct.el --- Quail packages for Chinese (pinyin + extra symbols) -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/leim/quail/rfc1345.el b/leim/quail/rfc1345.el
index a74dd05f7ef..c900d51b8ef 100644
--- a/leim/quail/rfc1345.el
+++ b/leim/quail/rfc1345.el
@@ -1,6 +1,6 @@
;;; rfc1345.el --- Quail method for RFC 1345 mnemonics -*- coding: utf-8 -*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/leim/quail/sgml-input.el b/leim/quail/sgml-input.el
index a8c335afa33..5a95fd19a03 100644
--- a/leim/quail/sgml-input.el
+++ b/leim/quail/sgml-input.el
@@ -1,6 +1,6 @@
;;; sgml-input.el --- Quail method for Unicode entered as SGML entities -*- coding: utf-8 -*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/leim/quail/sisheng.el b/leim/quail/sisheng.el
index 40f36fa032e..8afeaf9de4b 100644
--- a/leim/quail/sisheng.el
+++ b/leim/quail/sisheng.el
@@ -1,6 +1,6 @@
;;; sisheng.el --- sisheng input method for Chinese pinyin transliteration
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Werner LEMBERG <wl@gnu.org>
diff --git a/leim/quail/slovak.el b/leim/quail/slovak.el
index cfc35b07ca2..eafc694dea7 100644
--- a/leim/quail/slovak.el
+++ b/leim/quail/slovak.el
@@ -1,6 +1,6 @@
;;; slovak.el --- Quail package for inputting Slovak -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Authors: Tibor ,B)(Bimko <tibor.simko@fmph.uniba.sk>
;; Milan Zamazal <pdm@zamazal.org>
diff --git a/leim/quail/symbol-ksc.el b/leim/quail/symbol-ksc.el
index 15e78eb9866..c123848755d 100644
--- a/leim/quail/symbol-ksc.el
+++ b/leim/quail/symbol-ksc.el
@@ -1,6 +1,6 @@
;;; symbol-ksc.el --- Quail-package for Korean Symbol (KSC5601) -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/leim/quail/tibetan.el b/leim/quail/tibetan.el
index ba47155524f..e8975b7424c 100644
--- a/leim/quail/tibetan.el
+++ b/leim/quail/tibetan.el
@@ -1,6 +1,6 @@
;;; tibetan.el --- Quail package for inputting Tibetan characters -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -159,7 +159,7 @@
nil nil nil nil nil nil nil nil
'quail-tibetan-update-translation)
-;; Here we build up a Quail map for a Tibtan sequence the whole of
+;; Here we build up a Quail map for a Tibetan sequence the whole of
;; which can be one composition.
;;
;; A Tibetan syllable is typically structured as follows:
@@ -224,7 +224,7 @@
("F" . "M") ; anusvara
("g" . "u") ; zhabs kyu
("G" . "i") ; gi gu
- ("H" . ",") ; viraama
+ ("H" . ",") ; virama
("j" . "o") ; naro
("J" . "e") ; 'greng bu
("k" . "ts") ; tsa
diff --git a/leim/quail/uni-input.el b/leim/quail/uni-input.el
index d532b16ab0e..7946c08e9e5 100644
--- a/leim/quail/uni-input.el
+++ b/leim/quail/uni-input.el
@@ -1,6 +1,6 @@
;;; uni-input.el --- Hex Unicode input method
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
@@ -99,7 +99,7 @@ While this input method is active, the variable
(quail-delete-overlays)
(setq describe-current-input-method-function nil))
(kill-local-variable 'input-method-function))
- (setq inactivate-current-input-method-function 'ucs-input-inactivate)
+ (setq deactivate-current-input-method-function 'ucs-input-deactivate)
(setq describe-current-input-method-function 'ucs-input-help)
(quail-delete-overlays)
(if (eq (selected-window) (minibuffer-window))
@@ -107,11 +107,15 @@ While this input method is active, the variable
(set (make-local-variable 'input-method-function)
'ucs-input-method)))
-(defun ucs-input-inactivate ()
- "Inactivate UCS input method."
+(defun ucs-input-deactivate ()
+ "Deactivate UCS input method."
(interactive)
(ucs-input-activate -1))
+(define-obsolete-function-alias
+ 'ucs-input-inactivate
+ 'ucs-input-deactivate "24.3")
+
(defun ucs-input-help ()
(interactive)
(with-output-to-temp-buffer "*Help*"
diff --git a/leim/quail/vntelex.el b/leim/quail/vntelex.el
index 40380ee27ef..0cb3d402db2 100644
--- a/leim/quail/vntelex.el
+++ b/leim/quail/vntelex.el
@@ -1,6 +1,6 @@
;;; vntelex.el --- Quail package for Vietnamese by Telex method
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Werner Lemberg <wl@gnu.org>
;; Keywords: multilingual, input method, Vietnamese
diff --git a/leim/quail/vnvni.el b/leim/quail/vnvni.el
new file mode 100644
index 00000000000..b5948a7c01f
--- /dev/null
+++ b/leim/quail/vnvni.el
@@ -0,0 +1,305 @@
+;;; vnvni.el --- Quail package for Vietnamese by VNI method
+
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
+
+;; Author: Werner Lemberg <wl@gnu.org>
+;; Nguyen Thai Ngoc Duy <pclouds@gmail.com>
+;; Keywords: multilingual, input method, Vietnamese
+
+;; 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:
+
+;; There are two commonly-used input methods for Vietnamese: Telex
+;; (implemented in vntelex.el) and VNI (implemented in this file,
+;; which was based on vntelex.el).
+
+;;; Code:
+
+(require 'quail)
+
+
+(quail-define-package
+ "vietnamese-vni" ; NAME
+ "Vietnamese" ; LANGUAGE
+ "VV" ; TITLE
+ t ; GUIDANCE
+ "Vietnamese VNI input method
+
+Diacritics:
+
+ effect postfix examples
+ ------------------------------
+ circumflex 6 a6 -> ,Ab(B
+ breve 8 a8 -> ,1e(B
+ horn 7 o7 -> ,1=(B
+
+ acute 1 a1 -> ,1a(B
+ grave 2 a2 -> ,1`(B
+ hook above 3 a3 -> ,1d(B
+ tilde 4 a4 -> ,1c(B
+ dot below 5 a5 -> ,1U(B
+
+ d bar 9 d9 -> ,1p(B
+
+Combinations:
+
+ A82 -> ,2"(B, o74 -> ,1^(B, etc.
+
+Doubling the postfix (but not in combinations) separates the letter
+and postfix: E66 -> E6, a55 -> a5, etc.
+" ; DOCSTRING
+ nil ; TRANSLATION-KEYS
+ t ; FORGET-LAST-SELECTION
+ nil ; DETERMINISTIC
+ nil ; KBD-TRANSLATE
+ nil ; SHOW-LAYOUT
+ nil ; CREATE-DECODE-MAP
+ nil ; MAXIMUM-SHORTEST
+ nil ; OVERLAY-PLIST
+ nil ; UPDATE-TRANSLATION-FUNCTION
+ nil ; CONVERSION-KEYS
+ t) ; SIMPLE
+
+(quail-define-rules
+ ("a2" ?,1`(B) ; LATIN SMALL LETTER A WITH GRAVE
+ ("A2" ?,2`(B) ; LATIN CAPITAL LETTER A WITH GRAVE
+ ("a1" ?,1a(B) ; LATIN SMALL LETTER A WITH ACUTE
+ ("A1" ?,2a(B) ; LATIN CAPITAL LETTER A WITH ACUTE
+ ("a6" ?,1b(B) ; LATIN SMALL LETTER A WITH CIRCUMFLEX
+ ("A6" ?,2b(B) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+ ("a4" ?,1c(B) ; LATIN SMALL LETTER A WITH TILDE
+ ("A4" ?,2c(B) ; LATIN CAPITAL LETTER A WITH TILDE
+ ("e2" ?,1h(B) ; LATIN SMALL LETTER E WITH GRAVE
+ ("E2" ?,2h(B) ; LATIN CAPITAL LETTER E WITH GRAVE
+ ("e1" ?,1i(B) ; LATIN SMALL LETTER E WITH ACUTE
+ ("E1" ?,2i(B) ; LATIN CAPITAL LETTER E WITH ACUTE
+ ("e6" ?,1j(B) ; LATIN SMALL LETTER E WITH CIRCUMFLEX
+ ("E6" ?,2j(B) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+ ("i2" ?,1l(B) ; LATIN SMALL LETTER I WITH GRAVE
+ ("I2" ?,2l(B) ; LATIN CAPITAL LETTER I WITH GRAVE
+ ("i1" ?,1m(B) ; LATIN SMALL LETTER I WITH ACUTE
+ ("I1" ?,2m(B) ; LATIN CAPITAL LETTER I WITH ACUTE
+ ("o2" ?,1r(B) ; LATIN SMALL LETTER O WITH GRAVE
+ ("O2" ?,2r(B) ; LATIN CAPITAL LETTER O WITH GRAVE
+ ("o1" ?,1s(B) ; LATIN SMALL LETTER O WITH ACUTE
+ ("O1" ?,2s(B) ; LATIN CAPITAL LETTER O WITH ACUTE
+ ("o6" ?,1t(B) ; LATIN SMALL LETTER O WITH CIRCUMFLEX
+ ("O6" ?,2t(B) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+ ("o4" ?,1u(B) ; LATIN SMALL LETTER O WITH TILDE
+ ("O4" ?,2u(B) ; LATIN CAPITAL LETTER O WITH TILDE
+ ("u2" ?,1y(B) ; LATIN SMALL LETTER U WITH GRAVE
+ ("U2" ?,2y(B) ; LATIN CAPITAL LETTER U WITH GRAVE
+ ("u1" ?,1z(B) ; LATIN SMALL LETTER U WITH ACUTE
+ ("U1" ?,2z(B) ; LATIN CAPITAL LETTER U WITH ACUTE
+ ("y1" ?,1}(B) ; LATIN SMALL LETTER Y WITH ACUTE
+ ("Y1" ?,2}(B) ; LATIN CAPITAL LETTER Y WITH ACUTE
+ ("a8" ?,1e(B) ; LATIN SMALL LETTER A WITH BREVE
+ ("A8" ?,2e(B) ; LATIN CAPITAL LETTER A WITH BREVE
+ ("i4" ?,1n(B) ; LATIN SMALL LETTER I WITH TILDE
+ ("I4" ?,2n(B) ; LATIN CAPITAL LETTER I WITH TILDE
+ ("u4" ?,1{(B) ; LATIN SMALL LETTER U WITH TILDE
+ ("U4" ?,2{(B) ; LATIN CAPITAL LETTER U WITH TILDE
+ ("o7" ?,1=(B) ; LATIN SMALL LETTER O WITH HORN
+ ("O7" ?,2=(B) ; LATIN CAPITAL LETTER O WITH HORN
+ ("u7" ?,1_(B) ; LATIN SMALL LETTER U WITH HORN
+ ("U7" ?,2_(B) ; LATIN CAPITAL LETTER U WITH HORN
+ ("a5" ?,1U(B) ; LATIN SMALL LETTER A WITH DOT BELOW
+ ("A5" ?,2U(B) ; LATIN CAPITAL LETTER A WITH DOT BELOW
+ ("a3" ?,1d(B) ; LATIN SMALL LETTER A WITH HOOK ABOVE
+ ("A3" ?,2d(B) ; LATIN CAPITAL LETTER A WITH HOOK ABOVE
+ ("a61" ?,1$(B) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE
+ ("A61" ?,2$(B) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE
+ ("a62" ?,1%(B) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE
+ ("A62" ?,2%(B) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE
+ ("a63" ?,1&(B) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE
+ ("A63" ?,2&(B) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE
+ ("a64" ?,1g(B) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE
+ ("A64" ?,2g(B) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE
+ ("a65" ?,1'(B) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+ ("A65" ?,2'(B) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+ ("a81" ?,1!(B) ; LATIN SMALL LETTER A WITH BREVE AND ACUTE
+ ("A81" ?,2!(B) ; LATIN CAPITAL LETTER A WITH BREVE AND ACUTE
+ ("a82" ?,1"(B) ; LATIN SMALL LETTER A WITH BREVE AND GRAVE
+ ("A82" ?,2"(B) ; LATIN CAPITAL LETTER A WITH BREVE AND GRAVE
+ ("a83" ?,1F(B) ; LATIN SMALL LETTER A WITH BREVE AND HO6K ABOVE
+ ("A83" ?,2F(B) ; LATIN CAPITAL LETTER A WITH BREVE AND HO6K ABOVE
+ ("a84" ?,1G(B) ; LATIN SMALL LETTER A WITH BREVE AND TILDE
+ ("A84" ?,2G(B) ; LATIN CAPITAL LETTER A WITH BREVE AND TILDE
+ ("a85" ?,1#(B) ; LATIN SMALL LETTER A WITH BREVE AND DOT BELOW
+ ("A85" ?,2#(B) ; LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW
+ ("e5" ?,1)(B) ; LATIN SMALL LETTER E WITH DOT BELOW
+ ("E5" ?,2)(B) ; LATIN CAPITAL LETTER E WITH DOT BELOW
+ ("e3" ?,1k(B) ; LATIN SMALL LETTER E WITH HO6K ABOVE
+ ("E3" ?,2k(B) ; LATIN CAPITAL LETTER E WITH HO6K ABOVE
+ ("e4" ?,1((B) ; LATIN SMALL LETTER E WITH TILDE
+ ("E4" ?,2((B) ; LATIN CAPITAL LETTER E WITH TILDE
+ ("e61" ?,1*(B) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE
+ ("E61" ?,2*(B) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE
+ ("e62" ?,1+(B) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE
+ ("E62" ?,2+(B) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE
+ ("e63" ?,1,(B) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE
+ ("E63" ?,2,(B) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE
+ ("e64" ?,1-(B) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE
+ ("E64" ?,2-(B) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE
+ ("e65" ?,1.(B) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+ ("E65" ?,2.(B) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+ ("i3" ?,1o(B) ; LATIN SMALL LETTER I WITH HO6K ABOVE
+ ("I3" ?,2o(B) ; LATIN CAPITAL LETTER I WITH HO6K ABOVE
+ ("i5" ?,18(B) ; LATIN SMALL LETTER I WITH DOT BELOW
+ ("I5" ?,28(B) ; LATIN CAPITAL LETTER I WITH DOT BELOW
+ ("o5" ?,1w(B) ; LATIN SMALL LETTER O WITH DOT BELOW
+ ("O5" ?,2w(B) ; LATIN CAPITAL LETTER O WITH DOT BELOW
+ ("o3" ?,1v(B) ; LATIN SMALL LETTER O WITH HO6K ABOVE
+ ("O3" ?,2v(B) ; LATIN CAPITAL LETTER O WITH HO6K ABOVE
+ ("o61" ?,1/(B) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE
+ ("O61" ?,2/(B) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE
+ ("o62" ?,10(B) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE
+ ("O62" ?,20(B) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE
+ ("o63" ?,11(B) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE
+ ("O63" ?,21(B) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE
+ ("o64" ?,12(B) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE
+ ("O64" ?,22(B) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE
+ ("o65" ?,15(B) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELO7
+ ("O65" ?,25(B) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELO7
+ ("o71" ?,1>(B) ; LATIN SMALL LETTER O WITH HORN AND ACUTE
+ ("O71" ?,2>(B) ; LATIN CAPITAL LETTER O WITH HORN AND ACUTE
+ ("o72" ?,16(B) ; LATIN SMALL LETTER O WITH HORN AND GRAVE
+ ("O72" ?,26(B) ; LATIN CAPITAL LETTER O WITH HORN AND GRAVE
+ ("o73" ?,17(B) ; LATIN SMALL LETTER O WITH HORN AND HO6K ABOVE
+ ("O73" ?,27(B) ; LATIN CAPITAL LETTER O WITH HORN AND HO6K ABOVE
+ ("o74" ?,1^(B) ; LATIN SMALL LETTER O WITH HORN AND TILDE
+ ("O74" ?,2^(B) ; LATIN CAPITAL LETTER O WITH HORN AND TILDE
+ ("o75" ?,1~(B) ; LATIN SMALL LETTER O WITH HORN AND DOT BELO7
+ ("O75" ?,2~(B) ; LATIN CAPITAL LETTER O WITH HORN AND DOT BELO7
+ ("u5" ?,1x(B) ; LATIN SMALL LETTER U WITH DOT BELO7
+ ("U5" ?,2x(B) ; LATIN CAPITAL LETTER U WITH DOT BELO7
+ ("u3" ?,1|(B) ; LATIN SMALL LETTER U WITH HO6K ABOVE
+ ("U3" ?,2|(B) ; LATIN CAPITAL LETTER U WITH HO6K ABOVE
+ ("u71" ?,1Q(B) ; LATIN SMALL LETTER U WITH HORN AND ACUTE
+ ("U71" ?,2Q(B) ; LATIN CAPITAL LETTER U WITH HORN AND ACUTE
+ ("u72" ?,1W(B) ; LATIN SMALL LETTER U WITH HORN AND GRAVE
+ ("U72" ?,2W(B) ; LATIN CAPITAL LETTER U WITH HORN AND GRAVE
+ ("u73" ?,1X(B) ; LATIN SMALL LETTER U WITH HORN AND HO6K ABOVE
+ ("U73" ?,2X(B) ; LATIN CAPITAL LETTER U WITH HORN AND HO6K ABOVE
+ ("u74" ?,1f(B) ; LATIN SMALL LETTER U WITH HORN AND TILDE
+ ("U74" ?,2f(B) ; LATIN CAPITAL LETTER U WITH HORN AND TILDE
+ ("u75" ?,1q(B) ; LATIN SMALL LETTER U WITH HORN AND DOT BELO7
+ ("U75" ?,2q(B) ; LATIN CAPITAL LETTER U WITH HORN AND DOT BELO7
+ ("y2" ?,1O(B) ; LATIN SMALL LETTER Y WITH GRAVE
+ ("Y2" ?,2O(B) ; LATIN CAPITAL LETTER Y WITH GRAVE
+ ("y5" ?,1\(B) ; LATIN SMALL LETTER Y WITH DOT BELO7
+ ("Y5" ?,2\(B) ; LATIN CAPITAL LETTER Y WITH DOT BELO7
+ ("y3" ?,1V(B) ; LATIN SMALL LETTER Y WITH HO6K ABOVE
+ ("Y3" ?,2V(B) ; LATIN CAPITAL LETTER Y WITH HO6K ABOVE
+ ("y4" ?,1[(B) ; LATIN SMALL LETTER Y WITH TILDE
+ ("Y4" ?,2[(B) ; LATIN CAPITAL LETTER Y WITH TILDE
+ ("d9" ?,1p(B) ; LATIN SMALL LETTER D WITH STROKE
+ ("D9" ?,2p(B) ; LATIN CAPITAL LETTER D WITH STROKE
+;("$$" ?$,1tK(B) ; U+20AB DONG SIGN (#### check)
+
+ ("a22" ["a22"])
+ ("A22" ["A2"])
+ ("a11" ["a1"])
+ ("A11" ["A1"])
+ ("a66"' ["a6"])
+ ("A66"' ["A6"])
+ ("a44" ["a4"])
+ ("A44" ["A4"])
+ ("e22" ["e2"])
+ ("E22" ["E2"])
+ ("e11" ["e1"])
+ ("E11" ["E1"])
+ ("e66" ["e6"])
+ ("E66" ["E6"])
+ ("i22" ["i2"])
+ ("I22" ["I2"])
+ ("i11" ["i1"])
+ ("I11" ["I1"])
+ ("o22" ["o2"])
+ ("O22" ["O2"])
+ ("o11" ["o1"])
+ ("O11" ["O1"])
+ ("o66" ["o6"])
+ ("O66" ["O6"])
+ ("o44" ["o4"])
+ ("O44" ["O4"])
+ ("u22" ["u2"])
+ ("U22" ["U2"])
+ ("u11" ["u1"])
+ ("U11" ["U1"])
+ ("y11" ["y1"])
+ ("Y11" ["Y1"])
+ ("a88" ["a8"])
+ ("A88" ["A8"])
+ ("i44" ["i4"])
+ ("I44" ["I4"])
+ ("u44" ["u4"])
+ ("U44" ["u4"])
+ ("o77" ["o7"])
+ ("O77" ["O7"])
+ ("u77" ["u7"])
+ ("U77" ["U7"])
+ ("a55" ["a5"])
+ ("A55" ["A5"])
+ ("a33" ["a3"])
+ ("A33" ["A3"])
+ ("e55" ["e5"])
+ ("E55" ["E5"])
+ ("e33" ["e3"])
+ ("E33" ["E3"])
+ ("e44" ["e4"])
+ ("E44" ["E4"])
+ ("i33" ["i3"])
+ ("I33" ["I3"])
+ ("i55" ["i5"])
+ ("I55" ["I5"])
+ ("o55" ["o5"])
+ ("O55" ["O5"])
+ ("o33" ["o3"])
+ ("O33" ["O3"])
+ ("u55" ["u5"])
+ ("U55" ["U5"])
+ ("u33" ["u3"])
+ ("U33" ["U3"])
+ ("y22" ["y2"])
+ ("Y22" ["Y2"])
+ ("y55" ["y5"])
+ ("Y55" ["Y5"])
+ ("y33" ["y3"])
+ ("Y33" ["Y3"])
+ ("y44" ["y4"])
+ ("Y44" ["Y4"])
+ ("d9" ["d9"])
+ ("D99" ["D9"])
+;("$$$" ["$$"])
+
+ ;; escape from composition
+ ("\\1" ?1)
+ ("\\2" ?2)
+ ("\\3" ?3)
+ ("\\4" ?4)
+ ("\\5" ?5)
+ ("\\6" ?6)
+ ("\\7" ?7)
+ ("\\8" ?8)
+ ("\\9" ?9)
+ ("\\\\" ?\\)) ; literal backslash
+
+
+;; Local Variables:
+;; coding: iso-2022-7bit
+;; End:
diff --git a/leim/quail/welsh.el b/leim/quail/welsh.el
index 3085bbc358f..9dfe6293484 100644
--- a/leim/quail/welsh.el
+++ b/leim/quail/welsh.el
@@ -1,6 +1,6 @@
;;; welsh.el --- Quail package for inputting Welsh characters -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog
index e989473219c..b85ba12a5b2 100644
--- a/lib-src/ChangeLog
+++ b/lib-src/ChangeLog
@@ -1,3 +1,527 @@
+2012-11-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ movemail: treat EACCES etc. failures as permanent
+ * movemail.c (main): Treat any link failure other than EEXIST as a
+ permanent failure, not just EPERM. EACCES, for example.
+
+2012-11-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945).
+ * emacsclient.c (getcwd): Remove decl.
+ (get_current_dir_name): Assume getcwd exists.
+ * etags.c (HAVE_GETCWD): Remove.
+ (getcwd): Remove decl.
+ (NO_LONG_OPTIONS): Remove this. All uses removed.
+ Emacs always has GNU getopt.
+ (etags_getcwd): Assume getcwd exists.
+ * movemail.c (F_OK, X_OK, W_OK, R_OK): Remove.
+
+2012-11-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ * emacsclient.c (handle_sigcont, handle_sigtstp): Use raise (sig)
+ rather than kill (getpid (), sig), as it's simpler and safer.
+
+2012-11-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (SYSWAIT_H): New macro.
+ ($(BLD)/movemail.$(O)): Update dependencies.
+
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881).
+ * movemail.c, update-game-score.c: Assume <fcntl.h> exists.
+
+2012-10-26 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (uninstall): No INSTALLABLES live in archlibdir.
+
+ * Makefile.in (install, uninstall): Transformations should not be
+ applied to $EXEEXT.
+
+2012-10-23 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (lisp2): Add cp51932.el and eucjp-ms.el, to
+ follow src/lisp.mk.
+
+2012-10-21 Glenn Morris <rgm@gnu.org>
+
+ * make-docfile.c (scan_lisp_file): Add cp51932.el and eucjp-ms.el.
+
+2012-10-20 Eli Zaretskii <eliz@gnu.org>
+
+ * make-docfile.c (IS_SLASH, DEF_ELISP_FILE): New macros.
+ (scan_lisp_file): Only pass a .el file if its basename matches a
+ known file in its entirety. Use IS_SLASH and DEF_ELISP_FILE.
+
+2012-10-20 Andreas Schwab <schwab@linux-m68k.org>
+
+ * make-docfile.c (scan_lisp_file): Add bounds checking.
+
+2012-10-20 Eli Zaretskii <eliz@gnu.org>
+
+ Prevent silent omission of doc strings from uncompiled Lisp files.
+ * make-docfile.c (scan_lisp_file): Barf if called with a .el file
+ other than one of a small list of supported un-compiled files.
+
+ * makefile.w32-in (lisp1, lisp2): Name .elc files wherever they
+ exist. (Bug#12395)
+
+2012-10-17 Eli Zaretskii <eliz@gnu.org>
+
+ * ntlib.c: Include <mbstring.h>, to avoid compiler warning about
+ _mbspbrk.
+
+2012-10-08 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (obj): Add cygw32.o.
+
+2012-10-08 Daniel Colascione <dancol@dancol.org>
+
+ * emacsclient.c: Include windows.h when HAVE_NTGUI.
+ (alt_display): New variable. We send the display held by this
+ variable when the primary display is either unsupported or not
+ present.
+ (longopts): Allow display everywhere.
+ (w32_set_user_model_id): Move lower in file, inside HAVE_NTGUI
+ section.
+ (decode_options): Use alt_display. Explain why.
+ (main): Retry connection with alt_display if connection with main
+ display fails.
+
+2012-10-01 Fabrice Popineau <fabrice.popineau@gmail.com>
+
+ * make-docfile.c (write_globals): Special-case
+ Fexit_recursive_edit and Fabort_recursive_edit as well, as
+ functions that are _Noreturn, to be consistent with
+ src/keyboard.c.
+
+2012-09-30 Eli Zaretskii <eliz@gnu.org>
+
+ * ntlib.c (gettimeofday): Copy from src/w32.c. lib/gettime.c
+ needs this function.
+
+2012-09-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (obj): Add profiler.o.
+
+2012-09-17 Glenn Morris <rgm@gnu.org>
+
+ * ebrowse.c (version):
+ * etags.c (print_version): Use COPYRIGHT.
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ * pop.c (socket_connection) [HAVE_GETADDRINFO]:
+ Prefer assignment to memcpy when either will do.
+
+2012-08-31 Andreas Schwab <schwab@linux-m68k.org>
+
+ * etags.c (consider_token): Always zero-terminate token buffer.
+ (Bug#12306)
+
+2012-08-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rely on <config.h> + <unistd.h> to declare 'environ'.
+ * emacsclient.c (environ): Remove decl.
+
+2012-08-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/regex.$(O)): Update dependencies.
+
+2012-08-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ * etags.c (Pascal_functions): Fix parenthesization typo.
+
+2012-08-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * make-docfile.c (enum global_type): Sort values roughly in
+ decreasing alignment, except put functions last.
+ (compare_globals): Use this new property of enum global_type.
+ (write_globals): Use bool, not int, for booleans.
+
+2012-08-10 Glenn Morris <rgm@gnu.org>
+
+ * make-docfile.c (IF_LINT):
+ * emacsclient.c (IF_LINT): Remove (in config.h now).
+
+ * make-docfile.c (main):
+ (fopen) [!WINDOWSNT]:
+ (chdir) [!DOS_NT]: No more need to undef.
+
+ * movemail.c (DIRECTORY_SEP, IS_DIRECTORY_SEP):
+ * make-docfile.c (DIRECTORY_SEP, IS_DIRECTORY_SEP):
+ * emacsclient.c (DIRECTORY_SEP, IS_DIRECTORY_SEP, IS_DEVICE_SEP):
+ Remove (they are in config.h now).
+
+ * ebrowse.c (PATH_LIST_SEPARATOR):
+ Remove, and replace with SEPCHAR from config.h.
+
+2012-08-03 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (LOCAL_FLAGS): Remove WINDOWSNT and DOS_NT,
+ they are always defined in config.h.
+
+2012-08-03 Eli Zaretskii <eliz@gnu.org>
+
+ * ntlib.c (lstat): New function, calls 'stat'.
+
+2012-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use C99-style 'extern inline' if available.
+ * profile.c (SYSTIME_INLINE): Define.
+
+2012-08-02 Glenn Morris <rgm@gnu.org>
+
+ * makefile.w32-in (MS_W32_H): Update for new ms-w32.h location.
+
+2012-08-01 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (config_h): New variable.
+ Use throughout in place of ../src/config.h.
+
+2012-08-01 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (CONFIG_H): Update dependencies.
+ (CONF_POST_H): New macro.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Update .PHONY listings in makefiles.
+ * Makefile.in (.PHONY): Add all, need-blessmail, maybe-blessmail,
+ install, uninstall, mostlyclean, clean, distclean,
+ maintainer-clean, extraclean, check, tags.
+
+2012-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in ($(BLD)/profile.$(O)): Depend on stamp_BLD.
+
+2012-07-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * movemail.c: Add missing 'defined'.
+ Suggested by Sven Joachim in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00218.html>.
+
+2012-07-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port 'movemail' again to Solaris and similar hosts.
+ See Susan Cragin's report in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00199.html>.
+ * movemail.c (xmalloc): Also define if !DISABLE_DIRECT_ACCESS &&
+ !MAIL_USE_MMDF && !MAIL_USE_SYSTEM_LOCK. Move up, so it doesn't
+ need a forward declaration.
+ (main): Rewrite to avoid no-longer-present function 'concat', if
+ !DISABLE_DIRECT_ACCESS && !MAIL_USE_MMDF && !MAIL_USE_SYSTEM_LOCK.
+
+ Assume strerror.
+ * emacsclient.c, movemail.c, update-game-score.c (strerror)
+ [!HAVE_STRERROR]: Remove.
+
+2012-07-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ EMACS_TIME simplification (Bug#11875).
+ * profile.c (TV2): Remove no-longer-needed static var.
+
+ Simplify by avoiding confusing use of strncpy etc.
+ * etags.c (write_classname, C_entries):
+ Use sprintf rather than strncpy or strncat.
+ * etags.c (consider_token, C_entries, HTML_labels, Prolog_functions)
+ (Erlang_functions, substitute, readline_internal, savenstr):
+ * movemail.c (mail_spool_name):
+ Use memcpy rather than strncpy or strncat when either will do.
+ * make-docfile.c (write_c_args):
+ Use memcmp rather than strncmp when either will do.
+ * movemail.c (pop_retr):
+ * pop.c (pop_stat, pop_list, pop_multi_first, pop_last)
+ (socket_connection, pop_getline, sendline, getok):
+ Use snprintf rather than strncpy or strncat.
+ * movemail.c (concat): Remove; no longer needed.
+ (xmalloc): Define only if needed, now that concat has gone away.
+ Return void *. All uses changed.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Add GCC-style 'const' attribute to functions that can use it.
+ * etags.c (number_len): Add ATTRIBUTE_CONST.
+
+2012-07-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacsclient.c (w32_execvp): Declare execvp to silence the compiler.
+
+2012-07-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/test-distrib.exe): Use LIB_SRC, not SRC.
+ (LIB_SRC, NT_INC, GNU_LIB, MS_W32_H, CONFIG_H, INTTYPES_H, NTLIB_H)
+ (SYSTIME_H): New macros.
+ (SRC): Redefine to point to src/, not current directory.
+ ($(BLD)/ctags.$(O), $(BLD)/ebrowse.$(O), $(BLD)/emacsclient.$(O))
+ ($(BLD)/etags.$(O), $(BLD)/hexl.$(O), $(BLD)/make-docfile.$(O))
+ ($(BLD)/movemail.$(O), $(BLD)/ntlib.$(O), $(BLD)/pop.$(O))
+ ($(BLD)/profile.$(O), $(BLD)/test-distrib.$(O)): Update dependencies.
+ ($(BLD)/regex.$(O)): New dependency.
+
+2012-07-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (ALL): Add profile.exe.
+ (PROFILEOBJS): New macro.
+ ($(BLD)/profile.exe): New target.
+ (install): Copy profile.exe.
+ ($(BLD)/alloca.$(O), $(BLD)/tcp.$(O)): Remove, obsolete.
+
+2012-07-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/ctags.$(O), $(BLD)/etags.$(O)):
+ Update dependencies.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use c_strcasecmp for ASCII case-insensitive comparison (Bug#11786).
+ * etags.c: Include c-strcase.h.
+ (etags_strcasecmp, etags_strncasecmp): Remove.
+ All uses replaced with c_strcasecmp and c_strncasecmp.
+
+2012-07-06 Andreas Schwab <schwab@linux-m68k.org>
+
+ * make-docfile.c (write_globals): Warn about duplicate function
+ definitions with differing signatures.
+
+2012-07-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * make-docfile.c (scan_c_file): Suppress GCC warning.
+
+2012-06-29 Tom Tromey <tromey@redhat.com>
+
+ * make-docfile.c (enum global_type) <FUNCTION>: New constant.
+ (struct global) <value>: New field.
+ (add_global): Add 'value' argument.
+ (compare_globals): Sort functions at the end.
+ (close_emacs_globals): New function.
+ (write_globals): Handle functions.
+ (scan_c_file): Call add_global for DEFUN.
+
+2012-06-30 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (CTAGS_CFLAGS): Remove EMACS_NAME;
+ already defined in ETAGS_CFLAGS.
+
+2012-06-27 Glenn Morris <rgm@gnu.org>
+
+ * makefile.w32-in (lisp2): Remove paths.el.
+
+2012-06-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clean out last vestiges of the old HAVE_CONFIG_H stuff.
+ * Makefile.in (BASE_CFLAGS):
+ * makefile.w32-in (LOCAL_FLAGS): Remove -DHAVE_CONFIG_H.
+ * etags.c, hexl.c, pop.c: Include <config.h> unconditionally.
+ * etags.c (DOS_NT):
+ * pop.c (MAIL_USE_POP, h_errno):
+ Remove code that was conditioned on !HAVE_CONFIG_H.
+
+2012-06-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * etags.c (etags_strcasecmp, etags_strncasecmp): Define to
+ library functions strcasecmp and strncasecmp if available.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Switch from NO_RETURN to C11's _Noreturn (Bug#11750).
+ * ebrowse.c (usage, version):
+ * emacsclient.c (print_help_and_exit, fail):
+ * etags.c (suggest_asking_for_help, fatal, pfatal):
+ * hexl.c (usage):
+ * make-docfile.c (fatal):
+ * movemail.c (fatal, pfatal_with_name, pfatal_and_delete):
+ * update-game-score.c (usage):
+ * ebrowse.c (usage, version):
+ * emacsclient.c (print_help_and_exit, fail):
+ Use _Noreturn rather than NO_RETURN.
+ No need for separate decl merely because of _Noreturn.
+
+2012-06-24 Samuel Bronson <naesten@gmail.com> (tiny change)
+
+ * emacsclient.c (set_local_socket): Fix compiler warning (Bug#7838).
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+ * Makefile.in (LIB_CLOCK_GETTIME): New macro.
+ (profile${EXEEXT}): Use it.
+ * profile.c: Include inttypes.h, intprops.h.
+ (time_string): Size conservatively; do not guess size.
+ (get_time): Now prints nanoseconds.
+ (gettimeofday): Remove replacement function; gnulib now does this.
+
+2012-06-08 Andreas Schwab <schwab@linux-m68k.org>
+
+ * make-docfile.c (search_lisp_doc_at_eol): Unget last read
+ character.
+
+2012-06-06 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (STAMP_INST_SCRIPTS, STAMP_SCRIPTS, insrcdir)
+ (stamp-rcs2log, stamp-grep-changelog): Remove.
+ (all, clean): Remove references to stamps.
+
+ * vcdiff: Remove file.
+ * Makefile.in (SCRIPTS, STAMP_SCRIPTS): Remove vcdiff.
+ (stamp-vcdiff): Remove.
+
+2012-06-05 Glenn Morris <rgm@gnu.org>
+
+ * makefile.w32-in ($(BLD)/getdate.$(O), $(BLD)/leditcfns.$(O)):
+ ($(BLD)/make-path.$(O), $(BLD)/qsort.$(O)):
+ ($(BLD)/timer.$(O)): Remove cruft.
+
+2012-06-03 Glenn Morris <rgm@gnu.org>
+
+ * rcs-checkin: Remove file.
+ * Makefile.in (INSTALLABLE_SCRIPTS, STAMP_INST_SCRIPTS):
+ Remove rcs-checkin.
+ (stamp-rcs-checkin): Remove.
+
+2012-05-31 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in ($(BLD)/emacsclientw.exe): Use $(MWINDOWS)
+ instead of a literal -mwindows, which is not supported by MSVC.
+ (Bug#11405)
+
+2012-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * make-docfile.c: Improve comment style.
+ (search_lisp_doc_at_eol): New function.
+ (scan_lisp_file): Use it.
+
+2012-05-26 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (INSTALL_DATA): Remove; unused.
+
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove src/m/*.
+ * makefile.w32-in: Remove dependencies on
+ $(EMACS_ROOT)/src/m/intel386.h.
+
+2012-05-22 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install): Remove unneeded chmods.
+
+2012-05-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume C89 or later.
+ * etags.c (static, const): Remove macros.
+ (PTR): Remove; all uses replaced with void *. Omit needless casts.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (insrcdir, $(DESTDIR)${archlibdir}):
+ Scrap superfluous subshells.
+
+2012-05-18 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install): Ensure $bindir exists.
+
+2012-05-17 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (ns_appbindir): New, set by configure.
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MKDIR_P): New, set by configure.
+ ($(DESTDIR)${archlibdir}): Use $MKDIR_P.
+
+2012-05-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ etags: pacify gcc -Wstack-protector on Ubuntu 12.04 x86
+ * etags.c: Include <stdarg.h>.
+ (error): Declare as printf-style, as that's what it really is.
+ All uses changed.
+ (add_regex): Use single char rather than array-of-one char.
+
+2012-05-05 Jim Meyering <meyering@redhat.com>
+
+ * lib-src/pop.c (pop_stat, pop_list, pop_multi_first, pop_last):
+ NUL-terminate the error buffer (Bug#11372).
+
+2012-05-02 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacsclient.c (min): Undef before redefining it.
+
+2012-05-02 Jim Meyering <jim@meyering.net>
+
+ * emacsclient.c (send_to_emacs): Avoid invalid strcpy upon partial
+ send (Bug#11374).
+
+2012-04-29 Andreas Schwab <schwab@linux-m68k.org>
+
+ * make-docfile.c (scan_lisp_file) [DEBUG]: Also skip if and
+ byte-code forms. (Bug#11380)
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * emacsclient.c (decode_options): Move -t -n corner case handling
+ into server.el (Bug#11102).
+ (main): Send -tty to Emacs under more circumstances (Bug#8314).
+
+2012-04-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ configure: new option --enable-gcc-warnings (Bug#11207)
+ * Makefile.in (C_WARNINGS_SWITCH): Remove.
+ (WARN_CFLAGS, WERROR_CFLAGS): New macros.
+ (BASE_CFLAGS): Use new macros rather than old.
+
+2012-04-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume less-ancient POSIX support.
+ * update-game-score.c: Include <getopt.h> rather than rolling our
+ own decls for optarg, optind, opterr. See
+ <http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00720.html>.
+
+2012-04-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacsclient.c (decode_options) [WINDOWSNT]:
+ Call ttyname instead of passing its address (typo in 2011-12-04T17:13:01Z!lekktu@gmail.com).
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (obj): Add xml.o.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (ALL): Now the list of executables, not of phony
+ targets.
+ (.PHONY): Only make-docfile is its prerequisite now.
+ (make-docfile): Don't depend on stamp_BLD. Add a comment about
+ the need in this target.
+ (ctags, etags, ebrowse, hexl, movemail, emacsclient)
+ (test-distrib): Phony targets removed.
+ ($(BLD)/test-distrib.exe): Run test-distrib as part of the recipe.
+ (all): Don't depend on stamp_BLD.
+ (ALL): Include $(BLD)/test-distrib.exe.
+
+2012-03-11 Andreas Schwab <schwab@linux-m68k.org>
+
+ * emacsclient.c (main): Handle -print-nonl command.
+
+ * emacsclient.c (main): Handle multiple messages in a single
+ datagram.
+
+ * emacsclient.c (socket_name): Add const.
+ (get_server_config): Add parameter config_file, use it instead of
+ global server_file.
+ (set_tcp_socket): Add parameter local_server_file, pass it down to
+ get_server_config.
+ (set_local_socket): Add parameter local_socket_name, use it
+ instead of global socket_name.
+ (set_socket): Adjust calls to set_local_socket and set_tcp_socket.
+ Don't clobber global server_file or socket_name.
+ (main): No longer reset server_file or socket_name.
+
+2012-01-05 Glenn Morris <rgm@gnu.org>
+
+ * ebrowse.c (version) <emacs_copyright>:
+ * etags.c (print_version) <emacs_copyright>:
+ * rcs2log (Copyright): Update short copyright year to 2012.
+
2011-12-25 Andreas Schwab <schwab@linux-m68k.org>
* etags.c (C_entries): Properly skip over string and character
@@ -21,7 +545,7 @@
* makefile.w32-in (LOCAL_FLAGS): Add $(EMACS_EXTRA_C_FLAGS).
* emacsclient.c (main) <environ>: Remove declaration, already
- pulled in by unistd.h on Posix hosts and stdlib.h on MS-Windows.
+ pulled in by unistd.h on POSIX hosts and stdlib.h on MS-Windows.
2011-11-24 Glenn Morris <rgm@gnu.org>
@@ -310,8 +834,8 @@
* etags.c (canonicalize_filename, ISUPPER): Fix last change.
- * makefile.w32-in ($(BLD)/ebrowse.$(O), $(BLD)/pop.$(O)): Depend
- on ../lib/min-max.h.
+ * makefile.w32-in ($(BLD)/ebrowse.$(O), $(BLD)/pop.$(O)):
+ Depend on ../lib/min-max.h.
2011-02-22 Paul Eggert <eggert@cs.ucla.edu>
@@ -620,7 +1144,7 @@
(Asm_help, default_C_suffixes, default_C_help, Cplusplus_suffixes)
(Cplusplus_help, Cjava_suffixes, Cobol_suffixes, Cstar_suffixes)
(Erlang_suffixes, Erlang_help, Forth_suffixes, Forth_help)
- (Fortran_suffixes, Fortran_help, HTML_suffixes, HTML_help)
+ (Fortran_suffixes, Fortran_help, HTML_suffixes, HTML_help)
(Lisp_suffixes, Lisp_help, Lua_suffixes, Lua_help)
(Makefile_filenames, Makefile_help, Objc_suffixes, Objc_help)
(Pascal_suffixes, Pascal_help, Perl_suffixes, Perl_interpreters)
@@ -2688,7 +3212,7 @@
* make-docfile.c (read_c_string_or_comment): Declare msgno.
- * Makefile.in (YACC): Deleted.
+ * Makefile.in (YACC): Delete.
2002-10-19 Andreas Schwab <schwab@suse.de>
@@ -2906,7 +3430,7 @@
(TeX_commands): Names now include the initial backslash.
(TeX_commands): Names do not include numeric args #n.
(TeX_commands): Correct line char number in tags.
- (TEX_tabent, TEX_token): Deleted.
+ (TEX_tabent, TEX_token): Delete.
(TeX_commands, TEX_decode_env): Streamlined.
2002-06-05 Francesco Potortì <pot@gnu.org>
@@ -2947,7 +3471,7 @@
(main): New argument -d, for specifying directory.
(usage): Document.
(get_user_id): Compute.
- (get_home_dir): Deleted.
+ (get_home_dir): Delete.
(get_prefix): New function, taken from main.
(main): Check whether or not we are running setuid. Move prefix
computation to get_prefix. Don't call getpwent; we don't need to
@@ -3208,7 +3732,7 @@
(LOOKING_AT, get_tag, PHP_functions): Use notinname.
(Ada_getit, Ada_funcs, Python_functions, Scheme_functions):
Clarified, using strneq or notinname.
- (L_isdef, L_isquote): Removed.
+ (L_isdef, L_isquote): Remove.
(Lisp_functions, L_getit): Clarified.
* etags.c (P_): Rename to __P for consistency with config.h.
@@ -3645,7 +4169,7 @@
comma when --declarations is used.
(C_entries): More accurate tagging of members and declarations.
(yacc_rules): Was global, made local to C_entries.
- (next_token_is_func): Removed.
+ (next_token_is_func): Remove.
(fvdef): New constants fdefunkey, fdefunname.
(consider_token, C_entries): Use them.
(C_entries): Build proper lisp names for Emacs DEFUNs.
@@ -4121,7 +4645,7 @@
(find_entries, takeprec, getit, Fortran_functions, Perl_functions)
(Python_functions, L_getit, Lisp_functions, Scheme_functions)
(prolog_pred, erlanf_func, erlang_attribute): Use them.
- (eat_white): Deleted.
+ (eat_white): Delete.
* etags.c (CHAR, init): Keep into account non US-ASCII
characters and compilers with default signed chars.
@@ -4644,7 +5168,7 @@
1997-05-13 Francesco Potortì <F.Potorti@cnuce.cnr.it>
* etags.c (TeX_functions): Cleaned up.
- (tex_getit): Removed.
+ (tex_getit): Remove.
1997-05-13 Paul Eggert <eggert@twinsun.com>
@@ -5165,7 +5689,7 @@
* etags.c: Prolog language totally rewritten.
(Prolog_functions): Rewritten from scratch.
- (skip_comment, prolog_getit): Removed.
+ (skip_comment, prolog_getit): Remove.
(prolog_skip_comment): New function, like old skip_comment.
(prolog_pred, prolog_atom, prolog_white): New functions.
(erlang_func, erlang_attributes): Forward declarations added.
@@ -5666,7 +6190,7 @@
1995-01-12 Francesco Potortì (pot@cnuce.cnr.it)
- * etags.c (FILEPOS, GET_CHARNO, GET_FILEPOS, max, LINENO): Deleted.
+ * etags.c (FILEPOS, GET_CHARNO, GET_FILEPOS, max, LINENO): Delete.
(append_to_tagfile, typedefs, typedefs_and_cplusplus)
(constantypedefs, update, vgrind_style, no_warnings)
(cxref_style, cplusplus, noindentypedefs): Were int, now logical.
@@ -5685,9 +6209,9 @@
(consider_token): Don't take a token as argument. Use savenstr
when saving a tag in structtag. Callers changed.
(TOKEN): Structure changed. Now used only in C_entries.
- (TOKEN_SAVED_P, SAVE_TOKEN, RESTORE_TOKEN): Deleted.
+ (TOKEN_SAVED_P, SAVE_TOKEN, RESTORE_TOKEN): Delete.
(C_entries): nameb and savenameb deleted. Use dinamic allocation.
- (pfcnt): Deleted. Users updated.
+ (pfcnt): Delete. Users updated.
(getit, Asm_labels, Pascal_functions, L_getit, get_scheme)
(TEX_getit, prolog_getit): Use dinamic allocation for storing
the tag instead of a fixed size buffer.
@@ -6263,7 +6787,7 @@
1994-03-25 Francesco Potortì (pot@cnuce.cnr.it)
- * etags.c (emacs_tags_format, ETAGS): Removed. Use CTAGS instead.
+ * etags.c (emacs_tags_format, ETAGS): Remove. Use CTAGS instead.
(main): Don't allow the use of -t and -T in etags mode.
(print_help): Don't show options enabled by default.
(print_version): Show the emacs version number if VERSION is #defined.
@@ -6380,9 +6904,9 @@
1994-01-14 Francesco Potortì (pot@cnuce.cnr.it)
* etags.c (stab_entry, stab_create, stab_find, stab_search,
- stab_type, add_keyword, C_reate_stab, C_create_stabs): Deleted.
+ stab_type, add_keyword, C_reate_stab, C_create_stabs): Delete.
Use gperf generated hash table instead of linked list.
- (C_stab_entry, hash, in_word_set, get_C_stab, C_symtype): Added.
+ (C_stab_entry, hash, in_word_set, get_C_stab, C_symtype): Add.
Mostly code generated by gperf.
(consider_token): Remove unused parameter `lp'.
(PF_funcs, getit): Allow subroutine and similar declarations
@@ -6605,7 +7129,7 @@
1993-08-25 Paul Eggert (eggert@twinsun.com)
- * rcs2log: Change /{/ to /\{/ for Posix ERE compatibility;
+ * rcs2log: Change /{/ to /\{/ for POSIX ERE compatibility;
otherwise, HP awk complains.
* vcdiff: Append /usr/ccs/bin and /usr/sccs to PATH, since these
@@ -6701,7 +7225,7 @@
* etags.c (consider_token): Was `==', now is `='.
(consider_token): DEFUNs now treated like funcs in ctags mode.
- * etags.c (LEVEL_OK_FOR_FUNCDEF): Removed.
+ * etags.c (LEVEL_OK_FOR_FUNCDEF): Remove.
(C_entries): Optimized the test that used LEVEL_OK_FOR_FUNCDEF.
(C_entries): Remove a piece of useless code.
(C_entries): Making typedef tags is delayed until a semicolon
@@ -6952,7 +7476,7 @@
* rcs2log: mawk, SunOS 4.1.3 nawk, and Ultrix/MKS nawk all barf on
/[/]/, so change it to /[\/]/. This should work on all
- Posix-compliant awks. It's slightly wrong with traditional awk,
+ POSIX-compliant awks. It's slightly wrong with traditional awk,
since it matches \ too, but that's a minor problem compared to awk
syntax errors.
@@ -7000,10 +7524,10 @@
* etags.c (GET_COOKIE): And related macros removed.
(logical): Is now int, no more a char.
(reg): Define deleted.
- (isgood, _gd, notgd): Deleted.
- (gotone): Deleted.
+ (isgood, _gd, notgd): Delete.
+ (gotone): Delete.
(TOKEN): Member linestart removed.
- (linepos, prev_linepos, lb1): Deleted.
+ (linepos, prev_linepos, lb1): Delete.
(main): Call initbuffer on lbs array instead of lb1.
(init): Remove the initialization of the logical _gd array.
(find_entries): A .sa suffix means assembler file.
@@ -7011,7 +7535,7 @@
All C state machines rewritten.
(C_entries): Complete rewrite.
(condider_token): Complete rewrite.
- (getline): Deleted.
+ (getline): Delete.
1993-03-01 Francesco Potortì (pot@fly.CNUCE.CNR.IT)
@@ -7930,7 +8454,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1988-1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1988-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index c5e117f66f9..d271bb3a4fa 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -1,5 +1,5 @@
# Makefile for lib-src subdirectory in GNU Emacs.
-# Copyright (C) 1985, 1987-1988, 1993-1994, 2001-2011
+# Copyright (C) 1985, 1987-1988, 1993-1994, 2001-2012
# Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -36,14 +36,19 @@ configuration=@configuration@
EXEEXT=@EXEEXT@
C_SWITCH_SYSTEM=@C_SWITCH_SYSTEM@
C_SWITCH_MACHINE=@C_SWITCH_MACHINE@
-C_WARNINGS_SWITCH = @C_WARNINGS_SWITCH@
PROFILING_CFLAGS = @PROFILING_CFLAGS@
+WARN_CFLAGS = @WARN_CFLAGS@
+WERROR_CFLAGS = @WERROR_CFLAGS@
# Program name transformation.
TRANSFORM = @program_transform_name@
# ==================== Where To Install Things ====================
+# Location to install Emacs.app under GNUstep / Mac OS X.
+# Later values may use this.
+ns_appbindir=@ns_appbindir@
+
# The default location for installation. Everything is placed in
# subdirectories of this directory. The default values for many of
# the variables below are expressed in terms of this one, so you may
@@ -101,10 +106,10 @@ gameuser=@gameuser@
# ../configure figures out the correct values for these.
INSTALL = @INSTALL@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
-INSTALL_DATA = @INSTALL_DATA@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
# By default, we uphold the dignity of our programs.
INSTALL_STRIP =
+MKDIR_P = @MKDIR_P@
# ========================== Lists of Files ===========================
@@ -112,8 +117,7 @@ INSTALL_STRIP =
INSTALLABLES = etags${EXEEXT} ctags${EXEEXT} emacsclient${EXEEXT} \
ebrowse${EXEEXT}
-INSTALLABLE_SCRIPTS = rcs-checkin grep-changelog
-STAMP_INST_SCRIPTS = stamp-rcs-checkin stamp-grep-changelog
+INSTALLABLE_SCRIPTS = grep-changelog
# Things that Emacs runs internally, or during the build process,
# which should not be installed in bindir.
@@ -124,8 +128,7 @@ DONT_INSTALL= test-distrib${EXEEXT} make-docfile${EXEEXT}
# Like UTILITIES, but they're not system-dependent, and should not be
# deleted by the distclean target.
-SCRIPTS= rcs2log vcdiff
-STAMP_SCRIPTS= stamp-rcs2log stamp-vcdiff
+SCRIPTS= rcs2log
# All files that are created by the linker, i.e., whose names end in ${EXEEXT}.
EXE_FILES = ${INSTALLABLES} ${UTILITIES} ${DONT_INSTALL}
@@ -156,6 +159,8 @@ LIBHESIOD=@LIBHESIOD@
LIBRESOLV=@LIBRESOLV@
## -llockfile if HAVE_LIBLOCKFILE or -lmail if HAVE_LIBMAIL
LIBS_MAIL=@LIBS_MAIL@
+## empty or -lrt or -lposix4 if HAVE_CLOCK_GETTIME
+LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@
## Extra libraries to use when linking movemail.
LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \
@@ -164,42 +169,24 @@ LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \
## Some systems define this to request special libraries.
LIBS_SYSTEM = @LIBS_SYSTEM@
-# Those files shared with other GNU utilities need HAVE_CONFIG_H
-# defined before they know they can take advantage of the information
-# in ../src/config.h.
-BASE_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) ${C_WARNINGS_SWITCH} \
- -DHAVE_CONFIG_H -I. -I../src -I../lib \
+BASE_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \
+ $(WARN_CFLAGS) $(WERROR_CFLAGS) \
+ -I. -I../src -I../lib \
-I${srcdir} -I${srcdir}/../src -I${srcdir}/../lib
ALL_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS}
LINK_CFLAGS = ${BASE_CFLAGS} ${LDFLAGS} ${CFLAGS}
CPP_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${CPPFLAGS} ${CFLAGS}
-all: ${EXE_FILES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS} ${STAMP_INST_SCRIPTS} ${STAMP_SCRIPTS}
-
-LOADLIBES = ../lib/libgnu.a $(LIBS_SYSTEM)
-$(EXE_FILES): ../lib/libgnu.a
-
-## These targets copy the scripts into the build directory so that
-## they can be run from there in an uninstalled Emacs.
-## Nothing to do if pwd = srcdir.
-insrcdir=[ "`/bin/pwd`" = "`(cd $(srcdir) && /bin/pwd)`" ]
-
-stamp-rcs2log: $(srcdir)/rcs2log
- $(insrcdir) || cp -p $(srcdir)/rcs2log rcs2log
- touch $@
+# Configuration files for .o files to depend on.
+config_h = ../src/config.h $(srcdir)/../src/conf_post.h
-stamp-rcs-checkin: $(srcdir)/rcs-checkin
- $(insrcdir) || cp -p $(srcdir)/rcs-checkin rcs-checkin
- touch $@
+all: ${EXE_FILES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS}
-stamp-grep-changelog: $(srcdir)/grep-changelog
- $(insrcdir) || cp -p $(srcdir)/grep-changelog grep-changelog
- touch $@
+.PHONY: all need-blessmail maybe-blessmail
-stamp-vcdiff: $(srcdir)/vcdiff
- $(insrcdir) || cp -p $(srcdir)/vcdiff vcdiff
- touch $@
+LOADLIBES = ../lib/libgnu.a $(LIBS_SYSTEM)
+$(EXE_FILES): ../lib/libgnu.a
## Only used if we need blessmail, but no harm in always defining.
## This makes the actual blessmail executable.
@@ -229,46 +216,49 @@ maybe-blessmail: $(BLESSMAIL_TARGET)
$(DESTDIR)${archlibdir}: all
@echo
@echo "Installing utilities run internally by Emacs."
- umask 022; $(top_srcdir)/build-aux/install-sh -d $(DESTDIR)${archlibdir}
- if [ `(cd $(DESTDIR)${archlibdir} && /bin/pwd)` != `/bin/pwd` ]; then \
+ umask 022; ${MKDIR_P} $(DESTDIR)${archlibdir}
+ if [ `cd $(DESTDIR)${archlibdir} && /bin/pwd` != `/bin/pwd` ]; then \
for file in ${UTILITIES}; do \
$(INSTALL_PROGRAM) $(INSTALL_STRIP) $$file $(DESTDIR)${archlibdir}/$$file ; \
done ; \
fi
- umask 022; $(top_srcdir)/build-aux/install-sh -d $(DESTDIR)${gamedir}; \
+ umask 022; ${MKDIR_P} $(DESTDIR)${gamedir}; \
touch $(DESTDIR)${gamedir}/snake-scores; \
touch $(DESTDIR)${gamedir}/tetris-scores
-if chown ${gameuser} $(DESTDIR)${archlibdir}/update-game-score && chmod u+s $(DESTDIR)${archlibdir}/update-game-score; then \
chown ${gameuser} $(DESTDIR)${gamedir}; \
chmod u=rwx,g=rwx,o=rx $(DESTDIR)${gamedir}; \
fi
- if [ `(cd $(DESTDIR)${archlibdir} && /bin/pwd)` \
- != `(cd ${srcdir} && /bin/pwd)` ]; then \
+ if [ `cd $(DESTDIR)${archlibdir} && /bin/pwd` \
+ != `cd ${srcdir} && /bin/pwd` ]; then \
for file in ${SCRIPTS}; do \
$(INSTALL_SCRIPT) ${srcdir}/$$file $(DESTDIR)${archlibdir}/$$file; \
done ; \
fi
+.PHONY: install uninstall mostlyclean clean distclean maintainer-clean
+.PHONY: extraclean check tags
+
install: $(DESTDIR)${archlibdir}
@echo
@echo "Installing utilities for users to run."
+ umask 022; ${MKDIR_P} $(DESTDIR)${bindir}
for file in ${INSTALLABLES} ; do \
- $(INSTALL_PROGRAM) $(INSTALL_STRIP) $${file} $(DESTDIR)${bindir}/`echo $${file} | sed '$(TRANSFORM)'` ; \
- chmod a+rx $(DESTDIR)${bindir}/`echo $${file} | sed '$(TRANSFORM)'`; \
+ $(INSTALL_PROGRAM) $(INSTALL_STRIP) $${file} $(DESTDIR)${bindir}/`echo $${file} | sed -e 's/${EXEEXT}$$//' -e '$(TRANSFORM)'`${EXEEXT} ; \
done
for file in ${INSTALLABLE_SCRIPTS} ; do \
$(INSTALL_SCRIPT) ${srcdir}/$${file} $(DESTDIR)${bindir}/`echo $${file} | sed '$(TRANSFORM)'` ; \
- chmod a+rx $(DESTDIR)${bindir}/`echo $${file} | sed '$(TRANSFORM)'`; \
done
uninstall:
- (cd $(DESTDIR)${bindir}; \
- for file in ${INSTALLABLES} ${INSTALLABLE_SCRIPTS}; do \
+ for file in ${INSTALLABLES}; do \
+ rm -f $(DESTDIR)${bindir}/`echo $${file} | sed -e 's/${EXEEXT}$$//' -e '$(TRANSFORM)'`${EXEEXT} ; \
+ done
+ for file in ${INSTALLABLE_SCRIPTS}; do \
rm -f $(DESTDIR)${bindir}/`echo $${file} | sed '$(TRANSFORM)'` ; \
- done)
+ done
if [ -d $(DESTDIR)${archlibdir} ]; then \
- (cd $(DESTDIR)${archlibdir} && \
- rm -f ${UTILITIES} ${INSTALLABLES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS}) \
+ (cd $(DESTDIR)${archlibdir} && rm -f ${UTILITIES} ${SCRIPTS}) \
fi
mostlyclean:
@@ -276,7 +266,6 @@ mostlyclean:
clean: mostlyclean
-rm -f ${EXE_FILES}
- -rm -f ${STAMP_INST_SCRIPTS} ${STAMP_SCRIPTS}
distclean: clean
-rm -f TAGS
@@ -304,19 +293,19 @@ test-distrib${EXEEXT}: ${srcdir}/test-distrib.c
$(CC) ${ALL_CFLAGS} -o test-distrib ${srcdir}/test-distrib.c
./test-distrib ${srcdir}/testfile
-../lib/libgnu.a: ../src/config.h
+../lib/libgnu.a: $(config_h)
cd ../lib && $(MAKE) libgnu.a
-regex.o: $(srcdir)/../src/regex.c $(srcdir)/../src/regex.h ../src/config.h
+regex.o: $(srcdir)/../src/regex.c $(srcdir)/../src/regex.h $(config_h)
${CC} -c ${CPP_CFLAGS} -DCONFIG_BROKETS -DINHIBIT_STRING_HEADER \
${srcdir}/../src/regex.c
-etags${EXEEXT}: ${srcdir}/etags.c regex.o ../src/config.h
+etags${EXEEXT}: ${srcdir}/etags.c regex.o $(config_h)
$(CC) ${ALL_CFLAGS} -DEMACS_NAME="\"GNU Emacs\"" \
-DVERSION="\"${version}\"" ${srcdir}/etags.c \
regex.o $(LOADLIBES) -o etags
-ebrowse${EXEEXT}: ${srcdir}/ebrowse.c ${srcdir}/../lib/min-max.h ../src/config.h
+ebrowse${EXEEXT}: ${srcdir}/ebrowse.c ${srcdir}/../lib/min-max.h $(config_h)
$(CC) ${ALL_CFLAGS} -DVERSION="\"${version}\"" \
${srcdir}/ebrowse.c $(LOADLIBES) -o ebrowse
@@ -327,29 +316,30 @@ ctags${EXEEXT}: etags${EXEEXT}
-DVERSION="\"${version}\"" ${srcdir}/etags.c \
regex.o $(LOADLIBES) -o ctags
-profile${EXEEXT}: ${srcdir}/profile.c ../src/config.h
- $(CC) ${ALL_CFLAGS} ${srcdir}/profile.c $(LOADLIBES) -o profile
+profile${EXEEXT}: ${srcdir}/profile.c $(config_h)
+ $(CC) ${ALL_CFLAGS} ${srcdir}/profile.c \
+ $(LOADLIBES) $(LIB_CLOCK_GETTIME) -o profile
-make-docfile${EXEEXT}: ${srcdir}/make-docfile.c ../src/config.h
+make-docfile${EXEEXT}: ${srcdir}/make-docfile.c $(config_h)
$(CC) ${ALL_CFLAGS} ${srcdir}/make-docfile.c $(LOADLIBES) \
-o make-docfile
-movemail${EXEEXT}: ${srcdir}/movemail.c pop.o ../src/config.h
+movemail${EXEEXT}: ${srcdir}/movemail.c pop.o $(config_h)
$(CC) ${ALL_CFLAGS} ${MOVE_FLAGS} ${srcdir}/movemail.c pop.o \
$(LOADLIBES) $(LIBS_MOVE) -o movemail
-pop.o: ${srcdir}/pop.c ${srcdir}/../lib/min-max.h ../src/config.h
+pop.o: ${srcdir}/pop.c ${srcdir}/../lib/min-max.h $(config_h)
$(CC) -c ${CPP_CFLAGS} ${MOVE_FLAGS} ${srcdir}/pop.c
-emacsclient${EXEEXT}: ${srcdir}/emacsclient.c ../src/config.h
+emacsclient${EXEEXT}: ${srcdir}/emacsclient.c $(config_h)
$(CC) ${ALL_CFLAGS} ${srcdir}/emacsclient.c \
-DVERSION="\"${version}\"" \
$(LOADLIBES) -o emacsclient
-hexl${EXEEXT}: ${srcdir}/hexl.c ../src/config.h
+hexl${EXEEXT}: ${srcdir}/hexl.c $(config_h)
$(CC) ${ALL_CFLAGS} ${srcdir}/hexl.c $(LOADLIBES) -o hexl
-update-game-score${EXEEXT}: ${srcdir}/update-game-score.c ../src/config.h
+update-game-score${EXEEXT}: ${srcdir}/update-game-score.c $(config_h)
$(CC) ${ALL_CFLAGS} -DHAVE_SHARED_GAME_DIR="\"$(gamedir)\"" \
${srcdir}/update-game-score.c $(LOADLIBES) -o update-game-score
diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c
index 7395f2c8fdd..056ed471fde 100644
--- a/lib-src/ebrowse.c
+++ b/lib-src/ebrowse.c
@@ -1,6 +1,6 @@
/* ebrowse.c --- parsing files for the ebrowse C++ browser
-Copyright (C) 1992-2011 Free Software Foundation, Inc.
+Copyright (C) 1992-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -43,17 +43,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define READ_CHUNK_SIZE (100 * 1024)
-/* The character used as a separator in path lists (like $PATH). */
-
#if defined (__MSDOS__)
-#define PATH_LIST_SEPARATOR ';'
#define FILENAME_EQ(X,Y) (strcasecmp (X,Y) == 0)
#else
#if defined (WINDOWSNT)
-#define PATH_LIST_SEPARATOR ';'
#define FILENAME_EQ(X,Y) (stricmp (X,Y) == 0)
#else
-#define PATH_LIST_SEPARATOR ':'
#define FILENAME_EQ(X,Y) (streq (X,Y))
#endif
#endif
@@ -463,10 +458,6 @@ static struct member *add_member (struct sym *, char *, int, int, unsigned);
static void class_definition (struct sym *, int, int, int);
static char *operator_name (int *);
static void parse_qualified_param_ident_or_type (char **);
-static void usage (int) NO_RETURN;
-static void version (void) NO_RETURN;
-
-
/***********************************************************************
Utilities
@@ -981,7 +972,7 @@ make_namespace (char *name, struct sym *context)
}
-/* Find the symbol for namespace NAME. If not found, retrun NULL */
+/* Find the symbol for namespace NAME. If not found, return NULL */
static struct sym *
check_namespace (char *name, struct sym *context)
@@ -3421,7 +3412,7 @@ add_search_path (char *path_list)
char *start = path_list;
struct search_path *p;
- while (*path_list && *path_list != PATH_LIST_SEPARATOR)
+ while (*path_list && *path_list != SEPCHAR)
++path_list;
p = (struct search_path *) xmalloc (sizeof *p);
@@ -3438,7 +3429,7 @@ add_search_path (char *path_list)
else
search_path = search_path_tail = p;
- while (*path_list == PATH_LIST_SEPARATOR)
+ while (*path_list == SEPCHAR)
++path_list;
}
}
@@ -3507,7 +3498,7 @@ Usage: ebrowse [options] {files}\n\
--version display version info\n\
"
-static void
+static _Noreturn void
usage (int error)
{
puts (USAGE);
@@ -3522,11 +3513,10 @@ usage (int error)
# define VERSION "21"
#endif
-static void
+static _Noreturn void
version (void)
{
- /* Makes it easier to update automatically. */
- char emacs_copyright[] = "Copyright (C) 2011 Free Software Foundation, Inc.";
+ char emacs_copyright[] = COPYRIGHT;
printf ("ebrowse %s\n", VERSION);
puts (emacs_copyright);
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 5e1c2d61b89..021ac6eb247 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -1,5 +1,6 @@
/* Client process that communicates with GNU Emacs acting as server.
- Copyright (C) 1986-1987, 1994, 1999-2011 Free Software Foundation, Inc.
+
+Copyright (C) 1986-1987, 1994, 1999-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,7 +22,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef WINDOWSNT
-/* config.h defines these, which disables sockets altogether! */
+/* ms-w32.h defines these, which disables sockets altogether! */
# undef _WINSOCKAPI_
# undef _WINSOCK_H
@@ -43,6 +44,10 @@ char *w32_getenv (char *);
#else /* !WINDOWSNT */
+# ifdef HAVE_NTGUI
+# include <windows.h>
+# endif /* HAVE_NTGUI */
+
# include "syswait.h"
# ifdef HAVE_INET_SOCKETS
@@ -83,10 +88,7 @@ char *w32_getenv (char *);
-char *getenv (const char *), *getwd (char *);
-#ifdef HAVE_GETCWD
-char *(getcwd) (char *, size_t);
-#endif
+char *getenv (const char *);
#ifndef VERSION
#define VERSION "unspecified"
@@ -112,12 +114,10 @@ char *(getcwd) (char *, size_t);
/* Additional space when allocating buffers for filenames, etc. */
#define EXTRA_SPACE 100
-/* Use this to suppress gcc's `...may be used before initialized' warnings. */
-#ifdef lint
-# define IF_LINT(Code) Code
-#else
-# define IF_LINT(Code) /* empty */
+#ifdef min
+#undef min
#endif
+#define min(x, y) (((x) < (y)) ? (x) : (y))
/* Name used to invoke this program. */
@@ -141,6 +141,9 @@ int current_frame = 1;
/* The display on which Emacs should work. --display. */
const char *display = NULL;
+/* The alternate display we should try if Emacs does not support display. */
+const char *alt_display = NULL;
+
/* The parent window ID, if we are opening a frame via XEmbed. */
char *parent_id = NULL;
@@ -152,7 +155,7 @@ int tty = 0;
const char *alternate_editor = NULL;
/* If non-NULL, the filename of the UNIX socket. */
-char *socket_name = NULL;
+const char *socket_name = NULL;
/* If non-NULL, the filename of the authentication file. */
const char *server_file = NULL;
@@ -164,8 +167,7 @@ int emacs_pid = 0;
be used for the new frame */
const char *frame_parameters = NULL;
-static void print_help_and_exit (void) NO_RETURN;
-static void fail (void) NO_RETURN;
+static _Noreturn void print_help_and_exit (void);
struct option longopts[] =
@@ -184,9 +186,7 @@ struct option longopts[] =
{ "socket-name", required_argument, NULL, 's' },
#endif
{ "server-file", required_argument, NULL, 'f' },
-#ifndef WINDOWSNT
{ "display", required_argument, NULL, 'd' },
-#endif
{ "parent-id", required_argument, NULL, 'p' },
{ 0, 0, 0, 0 }
};
@@ -209,21 +209,6 @@ xmalloc (size_t size)
/* From sysdep.c */
#if !defined (HAVE_GET_CURRENT_DIR_NAME) || defined (BROKEN_GET_CURRENT_DIR_NAME)
-/* From lisp.h */
-#ifndef DIRECTORY_SEP
-#define DIRECTORY_SEP '/'
-#endif
-#ifndef IS_DIRECTORY_SEP
-#define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP)
-#endif
-#ifndef IS_DEVICE_SEP
-#ifndef DEVICE_SEP
-#define IS_DEVICE_SEP(_c_) 0
-#else
-#define IS_DEVICE_SEP(_c_) ((_c_) == DEVICE_SEP)
-#endif
-#endif
-
char *get_current_dir_name (void);
/* Return the current working directory. Returns NULL on errors.
@@ -235,7 +220,7 @@ get_current_dir_name (void)
char *buf;
const char *pwd;
struct stat dotstat, pwdstat;
- /* If PWD is accurate, use it instead of calling getwd. PWD is
+ /* If PWD is accurate, use it instead of calling getcwd. PWD is
sometimes a nicer name, and using it may avoid a fatal error if a
parent directory is searchable but not readable. */
if ((pwd = egetenv ("PWD")) != 0
@@ -252,7 +237,6 @@ get_current_dir_name (void)
buf = (char *) xmalloc (strlen (pwd) + 1);
strcpy (buf, pwd);
}
-#ifdef HAVE_GETCWD
else
{
size_t buf_size = 1024;
@@ -279,20 +263,6 @@ get_current_dir_name (void)
}
}
}
-#else
- else
- {
- /* We need MAXPATHLEN here. */
- buf = (char *) xmalloc (MAXPATHLEN + 1);
- if (getwd (buf) == NULL)
- {
- int tmp_errno = errno;
- free (buf);
- errno = tmp_errno;
- return NULL;
- }
- }
-#endif
return buf;
}
#endif
@@ -402,32 +372,6 @@ w32_getenv (char *envvar)
return NULL;
}
-void
-w32_set_user_model_id (void)
-{
- HMODULE shell;
- HRESULT (WINAPI * set_user_model) (wchar_t * id);
-
- /* On Windows 7 and later, we need to set the user model ID
- to associate emacsclient launched files with Emacs frames
- in the UI. */
- shell = LoadLibrary ("shell32.dll");
- if (shell)
- {
- set_user_model
- = (void *) GetProcAddress (shell,
- "SetCurrentProcessExplicitAppUserModelID");
- /* If the function is defined, then we are running on Windows 7
- or newer, and the UI uses this to group related windows
- together. Since emacs, runemacs, emacsclient are related, we
- want them grouped even though the executables are different,
- so we need to set a consistent ID between them. */
- if (set_user_model)
- set_user_model (L"GNU.Emacs");
-
- FreeLibrary (shell);
- }
-}
int
w32_window_app (void)
@@ -447,19 +391,19 @@ w32_window_app (void)
return window_app;
}
-/*
- execvp wrapper for Windows. Quotes arguments with embedded spaces.
+/* execvp wrapper for Windows. Quotes arguments with embedded spaces.
This is necessary due to the broken implementation of exec* routines in
the Microsoft libraries: they concatenate the arguments together without
quoting special characters, and pass the result to CreateProcess, with
predictably bad results. By contrast, POSIX execvp passes the arguments
- directly into the argv array of the child process.
-*/
+ directly into the argv array of the child process. */
+
int
w32_execvp (const char *path, char **argv)
{
int i;
+ extern int execvp (const char*, char **);
/* Required to allow a .BAT script as alternate editor. */
argv[0] = (char *) alternate_editor;
@@ -622,48 +566,52 @@ decode_options (int argc, char **argv)
Without the -c option, we used to set `display' to $DISPLAY by
default, but this changed the default behavior and is sometimes
inconvenient. So we force users to use "--display $DISPLAY" if
- they want Emacs to connect to their current display. */
+ they want Emacs to connect to their current display.
+
+ Some window systems have a notion of default display not
+ reflected in the DISPLAY variable. If the user didn't give us an
+ explicit display, try this platform-specific after trying the
+ display in DISPLAY (if any). */
if (!current_frame && !tty && !display)
{
- display = egetenv ("DISPLAY");
-#ifdef NS_IMPL_COCOA
- /* Under Cocoa, we don't really use displays the same way as in X,
- so provide a dummy. */
- if (!display || strlen (display) == 0)
- display = "ns";
+ /* Set these here so we use a default_display only when the user
+ didn't give us an explicit display. */
+#if defined (NS_IMPL_COCOA)
+ alt_display = "ns";
+#elif defined (HAVE_NTGUI)
+ alt_display = "w32";
#endif
+
+ display = egetenv ("DISPLAY");
+ }
+
+ if (!display)
+ {
+ display = alt_display;
+ alt_display = NULL;
}
/* A null-string display is invalid. */
if (display && strlen (display) == 0)
display = NULL;
-#ifdef WINDOWSNT
- /* Emacs on Windows does not support GUI and console frames in the same
- instance. So, it makes sense to treat the -t and -c options as
- equivalent, and open a new frame regardless of whether the running
- instance is GUI or console. Ideally, we would only set tty = 1 when
- the instance is running in a console, but alas we don't know that.
- The simplest workaround is to always ask for a tty frame, and let
- server.el check whether it makes sense. */
- if (tty || !current_frame)
- {
- display = (const char *) ttyname;
- current_frame = 0;
- tty = 1;
- }
-#endif
-
/* If no display is available, new frames are tty frames. */
if (!current_frame && !display)
tty = 1;
- /* --no-wait implies --current-frame on ttys when there are file
- arguments or expressions given. */
- if (nowait && tty && argc - optind > 0)
- current_frame = 1;
-
#ifdef WINDOWSNT
+ /* Emacs on Windows does not support graphical and text terminal
+ frames in the same instance. So, treat the -t and -c options as
+ equivalent, and open a new frame on the server's terminal.
+ Ideally, we would only set tty = 1 when the serve is running in a
+ console, but alas we don't know that. As a workaround, always
+ ask for a tty frame, and let server.el figure it out. */
+ if (!current_frame)
+ {
+ display = NULL;
+ tty = 1;
+ }
+
if (alternate_editor && alternate_editor[0] == '\0')
{
message (TRUE, "--alternate-editor argument or ALTERNATE_EDITOR variable cannot be\n\
@@ -674,7 +622,7 @@ an empty string");
}
-static void
+static _Noreturn void
print_help_and_exit (void)
{
/* Spaces and tabs are significant in this message; they're chosen so the
@@ -717,12 +665,11 @@ Report bugs with M-x report-emacs-bug.\n", progname);
exit (EXIT_SUCCESS);
}
-/*
- Try to run a different command, or --if no alternate editor is
- defined-- exit with an errorcode.
- Uses argv, but gets it from the global variable main_argv.
-*/
-static void
+/* Try to run a different command, or --if no alternate editor is
+ defined-- exit with an errorcode.
+ Uses argv, but gets it from the global variable main_argv. */
+
+static _Noreturn void
fail (void)
{
if (alternate_editor)
@@ -755,16 +702,15 @@ main (int argc, char **argv)
#define AUTH_KEY_LENGTH 64
#define SEND_BUFFER_SIZE 4096
-extern char *strerror (int);
-
/* Buffer to accumulate data to send in TCP connections. */
char send_buffer[SEND_BUFFER_SIZE + 1];
int sblen = 0; /* Fill pointer for the send buffer. */
/* Socket used to communicate with the Emacs server process. */
HSOCKET emacs_socket = 0;
-/* On Windows, the socket library was historically separate from the standard
- C library, so errors are handled differently. */
+/* On Windows, the socket library was historically separate from the
+ standard C library, so errors are handled differently. */
+
static void
sock_err_message (const char *function_name)
{
@@ -792,33 +738,35 @@ sock_err_message (const char *function_name)
static void
send_to_emacs (HSOCKET s, const char *data)
{
- while (data)
+ size_t dlen;
+
+ if (!data)
+ return;
+
+ dlen = strlen (data);
+ while (*data)
{
- size_t dlen = strlen (data);
- if (dlen + sblen >= SEND_BUFFER_SIZE)
- {
- int part = SEND_BUFFER_SIZE - sblen;
- strncpy (&send_buffer[sblen], data, part);
- data += part;
- sblen = SEND_BUFFER_SIZE;
- }
- else if (dlen)
- {
- strcpy (&send_buffer[sblen], data);
- data = NULL;
- sblen += dlen;
- }
- else
- break;
+ size_t part = min (dlen, SEND_BUFFER_SIZE - sblen);
+ memcpy (&send_buffer[sblen], data, part);
+ data += part;
+ sblen += part;
if (sblen == SEND_BUFFER_SIZE
|| (sblen > 0 && send_buffer[sblen-1] == '\n'))
{
int sent = send (s, send_buffer, sblen, 0);
+ if (sent < 0)
+ {
+ message (TRUE, "%s: failed to send %d bytes to socket: %s\n",
+ progname, sblen, strerror (errno));
+ fail ();
+ }
if (sent != sblen)
- strcpy (send_buffer, &send_buffer[sent]);
+ memmove (send_buffer, &send_buffer[sent], sblen - sent);
sblen -= sent;
}
+
+ dlen -= part;
}
}
@@ -867,7 +815,7 @@ quote_argument (HSOCKET s, const char *str)
/* The inverse of quote_argument. Removes quoting in string STR by
- modifying the string in place. Returns STR. */
+ modifying the string in place. Returns STR. */
static char *
unquote_argument (char *str)
@@ -950,41 +898,41 @@ initialize_sockets (void)
#endif /* WINDOWSNT */
-/*
- * Read the information needed to set up a TCP comm channel with
- * the Emacs server: host, port, and authentication string.
- */
+/* Read the information needed to set up a TCP comm channel with
+ the Emacs server: host, port, and authentication string. */
+
static int
-get_server_config (struct sockaddr_in *server, char *authentication)
+get_server_config (const char *config_file, struct sockaddr_in *server,
+ char *authentication)
{
char dotted[32];
char *port;
FILE *config = NULL;
- if (file_name_absolute_p (server_file))
- config = fopen (server_file, "rb");
+ if (file_name_absolute_p (config_file))
+ config = fopen (config_file, "rb");
else
{
const char *home = egetenv ("HOME");
if (home)
{
- char *path = xmalloc (strlen (home) + strlen (server_file)
+ char *path = xmalloc (strlen (home) + strlen (config_file)
+ EXTRA_SPACE);
strcpy (path, home);
strcat (path, "/.emacs.d/server/");
- strcat (path, server_file);
+ strcat (path, config_file);
config = fopen (path, "rb");
free (path);
}
#ifdef WINDOWSNT
if (!config && (home = egetenv ("APPDATA")))
{
- char *path = xmalloc (strlen (home) + strlen (server_file)
+ char *path = xmalloc (strlen (home) + strlen (config_file)
+ EXTRA_SPACE);
strcpy (path, home);
strcat (path, "/.emacs.d/server/");
- strcat (path, server_file);
+ strcat (path, config_file);
config = fopen (path, "rb");
free (path);
}
@@ -1019,32 +967,28 @@ get_server_config (struct sockaddr_in *server, char *authentication)
}
static HSOCKET
-set_tcp_socket (void)
+set_tcp_socket (const char *local_server_file)
{
HSOCKET s;
struct sockaddr_in server;
struct linger l_arg = {1, 1};
char auth_string[AUTH_KEY_LENGTH + 1];
- if (! get_server_config (&server, auth_string))
+ if (! get_server_config (local_server_file, &server, auth_string))
return INVALID_SOCKET;
if (server.sin_addr.s_addr != inet_addr ("127.0.0.1") && !quiet)
message (FALSE, "%s: connected to remote socket at %s\n",
progname, inet_ntoa (server.sin_addr));
- /*
- * Open up an AF_INET socket
- */
+ /* Open up an AF_INET socket. */
if ((s = socket (AF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0)
{
sock_err_message ("socket");
return INVALID_SOCKET;
}
- /*
- * Set up the socket
- */
+ /* Set up the socket. */
if (connect (s, (struct sockaddr *) &server, sizeof server) < 0)
{
sock_err_message ("connect");
@@ -1053,9 +997,7 @@ set_tcp_socket (void)
setsockopt (s, SOL_SOCKET, SO_LINGER, (char *) &l_arg, sizeof l_arg);
- /*
- * Send the authentication
- */
+ /* Send the authentication. */
auth_string[AUTH_KEY_LENGTH] = '\0';
send_to_emacs (s, "-auth ");
@@ -1178,7 +1120,7 @@ handle_sigcont (int signalnum)
else
{
/* We are in the background; cancel the continue. */
- kill (getpid (), SIGSTOP);
+ raise (SIGSTOP);
}
signal (signalnum, handle_sigcont);
@@ -1189,7 +1131,7 @@ handle_sigcont (int signalnum)
going to sleep. Normally the suspend is initiated by Emacs via
server-handle-suspend-tty, but if the server gets out of sync with
reality, we may get a SIGTSTP on C-z. Handling this signal and
- notifying Emacs about it should get things under control again. */
+ notifying Emacs about it should get things under control again. */
static void
handle_sigtstp (int signalnum)
@@ -1205,7 +1147,7 @@ handle_sigtstp (int signalnum)
sigprocmask (SIG_BLOCK, NULL, &set);
sigdelset (&set, signalnum);
signal (signalnum, SIG_DFL);
- kill (getpid (), signalnum);
+ raise (signalnum);
sigprocmask (SIG_SETMASK, &set, NULL); /* Let's the above signal through. */
signal (signalnum, handle_sigtstp);
@@ -1236,15 +1178,12 @@ init_signals (void)
static HSOCKET
-set_local_socket (void)
+set_local_socket (const char *local_socket_name)
{
HSOCKET s;
struct sockaddr_un server;
- /*
- * Open up an AF_UNIX socket in this person's home directory
- */
-
+ /* Open up an AF_UNIX socket in this person's home directory. */
if ((s = socket (AF_UNIX, SOCK_STREAM, 0)) < 0)
{
message (TRUE, "%s: socket: %s\n", progname, strerror (errno));
@@ -1254,27 +1193,20 @@ set_local_socket (void)
server.sun_family = AF_UNIX;
{
- int sock_status = 0;
- int default_sock = !socket_name;
- int saved_errno = 0;
- const char *server_name = "server";
+ int sock_status;
+ int use_tmpdir = 0;
+ int saved_errno;
+ const char *server_name = local_socket_name;
const char *tmpdir IF_LINT ( = NULL);
char *tmpdir_storage = NULL;
char *socket_name_storage = NULL;
- if (socket_name && !strchr (socket_name, '/')
- && !strchr (socket_name, '\\'))
+ if (!strchr (local_socket_name, '/') && !strchr (local_socket_name, '\\'))
{
/* socket_name is a file name component. */
- server_name = socket_name;
- socket_name = NULL;
- default_sock = 1; /* Try both UIDs. */
- }
-
- if (default_sock)
- {
long uid = geteuid ();
ptrdiff_t tmpdirlen;
+ use_tmpdir = 1;
tmpdir = egetenv ("TMPDIR");
if (!tmpdir)
{
@@ -1286,33 +1218,34 @@ set_local_socket (void)
if (n > 0)
{
tmpdir = tmpdir_storage = xmalloc (n);
- confstr (_CS_DARWIN_USER_TEMP_DIR, tmpdir, n);
+ confstr (_CS_DARWIN_USER_TEMP_DIR, tmpdir_storage, n);
}
else
#endif
tmpdir = "/tmp";
}
tmpdirlen = strlen (tmpdir);
- socket_name = socket_name_storage =
+ socket_name_storage =
xmalloc (tmpdirlen + strlen (server_name) + EXTRA_SPACE);
- strcpy (socket_name, tmpdir);
- sprintf (socket_name + tmpdirlen, "/emacs%ld/", uid);
- strcat (socket_name + tmpdirlen, server_name);
+ strcpy (socket_name_storage, tmpdir);
+ sprintf (socket_name_storage + tmpdirlen, "/emacs%ld/", uid);
+ strcat (socket_name_storage + tmpdirlen, server_name);
+ local_socket_name = socket_name_storage;
}
- if (strlen (socket_name) < sizeof (server.sun_path))
- strcpy (server.sun_path, socket_name);
+ if (strlen (local_socket_name) < sizeof (server.sun_path))
+ strcpy (server.sun_path, local_socket_name);
else
{
message (TRUE, "%s: socket-name %s too long\n",
- progname, socket_name);
+ progname, local_socket_name);
fail ();
}
/* See if the socket exists, and if it's owned by us. */
sock_status = socket_status (server.sun_path);
saved_errno = errno;
- if (sock_status && default_sock)
+ if (sock_status && use_tmpdir)
{
/* Failing that, see if LOGNAME or USER exist and differ from
our euid. If so, look for a socket based on the UID
@@ -1333,21 +1266,21 @@ set_local_socket (void)
/* We're running under su, apparently. */
long uid = pw->pw_uid;
ptrdiff_t tmpdirlen = strlen (tmpdir);
- socket_name = xmalloc (tmpdirlen + strlen (server_name)
- + EXTRA_SPACE);
- strcpy (socket_name, tmpdir);
- sprintf (socket_name + tmpdirlen, "/emacs%ld/", uid);
- strcat (socket_name + tmpdirlen, server_name);
-
- if (strlen (socket_name) < sizeof (server.sun_path))
- strcpy (server.sun_path, socket_name);
+ char *user_socket_name
+ = xmalloc (tmpdirlen + strlen (server_name) + EXTRA_SPACE);
+ strcpy (user_socket_name, tmpdir);
+ sprintf (user_socket_name + tmpdirlen, "/emacs%ld/", uid);
+ strcat (user_socket_name + tmpdirlen, server_name);
+
+ if (strlen (user_socket_name) < sizeof (server.sun_path))
+ strcpy (server.sun_path, user_socket_name);
else
{
message (TRUE, "%s: socket-name %s too long\n",
- progname, socket_name);
+ progname, user_socket_name);
exit (EXIT_FAILURE);
}
- free (socket_name);
+ free (user_socket_name);
sock_status = socket_status (server.sun_path);
saved_errno = errno;
@@ -1401,6 +1334,7 @@ static HSOCKET
set_socket (int no_exit_if_error)
{
HSOCKET s;
+ const char *local_server_file = server_file;
INITIALIZE ();
@@ -1408,7 +1342,7 @@ set_socket (int no_exit_if_error)
/* Explicit --socket-name argument. */
if (socket_name)
{
- s = set_local_socket ();
+ s = set_local_socket (socket_name);
if ((s != INVALID_SOCKET) || no_exit_if_error)
return s;
message (TRUE, "%s: error accessing socket \"%s\"\n",
@@ -1418,30 +1352,29 @@ set_socket (int no_exit_if_error)
#endif
/* Explicit --server-file arg or EMACS_SERVER_FILE variable. */
- if (!server_file)
- server_file = egetenv ("EMACS_SERVER_FILE");
+ if (!local_server_file)
+ local_server_file = egetenv ("EMACS_SERVER_FILE");
- if (server_file)
+ if (local_server_file)
{
- s = set_tcp_socket ();
+ s = set_tcp_socket (local_server_file);
if ((s != INVALID_SOCKET) || no_exit_if_error)
return s;
message (TRUE, "%s: error accessing server file \"%s\"\n",
- progname, server_file);
+ progname, local_server_file);
exit (EXIT_FAILURE);
}
#ifndef NO_SOCKETS_IN_FILE_SYSTEM
/* Implicit local socket. */
- s = set_local_socket ();
+ s = set_local_socket ("server");
if (s != INVALID_SOCKET)
return s;
#endif
/* Implicit server file. */
- server_file = "server";
- s = set_tcp_socket ();
+ s = set_tcp_socket ("server");
if ((s != INVALID_SOCKET) || no_exit_if_error)
return s;
@@ -1456,10 +1389,37 @@ set_socket (int no_exit_if_error)
exit (EXIT_FAILURE);
}
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
FARPROC set_fg; /* Pointer to AllowSetForegroundWindow. */
FARPROC get_wc; /* Pointer to RealGetWindowClassA. */
+void
+w32_set_user_model_id (void)
+{
+ HMODULE shell;
+ HRESULT (WINAPI * set_user_model) (wchar_t * id);
+
+ /* On Windows 7 and later, we need to set the user model ID
+ to associate emacsclient launched files with Emacs frames
+ in the UI. */
+ shell = LoadLibrary ("shell32.dll");
+ if (shell)
+ {
+ set_user_model
+ = (void *) GetProcAddress (shell,
+ "SetCurrentProcessExplicitAppUserModelID");
+ /* If the function is defined, then we are running on Windows 7
+ or newer, and the UI uses this to group related windows
+ together. Since emacs, runemacs, emacsclient are related, we
+ want them grouped even though the executables are different,
+ so we need to set a consistent ID between them. */
+ if (set_user_model)
+ set_user_model (L"GNU.Emacs");
+
+ FreeLibrary (shell);
+ }
+}
+
BOOL CALLBACK
w32_find_emacs_process (HWND hWnd, LPARAM lParam)
{
@@ -1484,10 +1444,9 @@ w32_find_emacs_process (HWND hWnd, LPARAM lParam)
return FALSE;
}
-/*
- * Search for a window of class "Emacs" and owned by a process with
- * process id = emacs_pid. If found, allow it to grab the focus.
- */
+/* Search for a window of class "Emacs" and owned by a process with
+ process id = emacs_pid. If found, allow it to grab the focus. */
+
void
w32_give_focus (void)
{
@@ -1509,7 +1468,7 @@ w32_give_focus (void)
&& (get_wc = GetProcAddress (user32, "RealGetWindowClassA")))
EnumWindows (w32_find_emacs_process, (LPARAM) 0);
}
-#endif
+#endif /* HAVE_NTGUI */
/* Start the emacs daemon and try to connect to it. */
@@ -1573,19 +1532,19 @@ main (int argc, char **argv)
int rl = 0, needlf = 0;
char *cwd, *str;
char string[BUFSIZ+1];
- int null_socket_name IF_LINT ( = 0);
- int null_server_file IF_LINT ( = 0);
int start_daemon_if_needed;
int exit_status = EXIT_SUCCESS;
main_argv = argv;
progname = argv[0];
-#ifdef WINDOWSNT
- /* On Windows 7 and later, we need to explicitly associate emacsclient
- with emacs so the UI behaves sensibly. */
+#ifdef HAVE_NTGUI
+ /* On Windows 7 and later, we need to explicitly associate
+ emacsclient with emacs so the UI behaves sensibly. This
+ association does no harm if we're not actually connecting to an
+ Emacs using a window display. */
w32_set_user_model_id ();
-#endif
+#endif /* HAVE_NTGUI */
/* Process options. */
decode_options (argc, argv);
@@ -1602,14 +1561,6 @@ main (int argc, char **argv)
in case of failure to connect. */
start_daemon_if_needed = (alternate_editor
&& (alternate_editor[0] == '\0'));
- if (start_daemon_if_needed)
- {
- /* set_socket changes the values for socket_name and
- server_file, we need to reset them, if they were NULL before
- for the second call to set_socket. */
- null_socket_name = (socket_name == NULL);
- null_server_file = (server_file == NULL);
- }
emacs_socket = set_socket (alternate_editor || start_daemon_if_needed);
if (emacs_socket == INVALID_SOCKET)
@@ -1617,37 +1568,25 @@ main (int argc, char **argv)
if (! start_daemon_if_needed)
fail ();
- /* Reset socket_name and server_file if they were NULL
- before the set_socket call. */
- if (null_socket_name)
- socket_name = NULL;
- if (null_server_file)
- server_file = NULL;
-
start_daemon_and_retry_set_socket ();
}
cwd = get_current_dir_name ();
if (cwd == 0)
{
- /* getwd puts message in STRING if it fails. */
message (TRUE, "%s: %s\n", progname,
"Cannot get current working directory");
fail ();
}
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
+ if (display && !strcmp (display, "w32"))
w32_give_focus ();
-#endif
+#endif /* HAVE_NTGUI */
/* Send over our environment and current directory. */
if (!current_frame)
{
-#ifndef WINDOWSNT
- /* This is defined in stdlib.h on MS-Windows. It's defined in
- unistd.h on some POSIX hosts, but not all (Bug#10155). */
- extern char **environ;
-#endif
int i;
for (i = 0; environ[i]; i++)
{
@@ -1689,10 +1628,10 @@ main (int argc, char **argv)
send_to_emacs (emacs_socket, " ");
}
- /* If using the current frame, send tty information to Emacs anyway.
- In daemon mode, Emacs may need to occupy this tty if no other
- frame is available. */
- if (tty || (current_frame && !eval))
+ /* Unless we are certain we don't want to occupy the tty, send our
+ tty information to Emacs. For example, in daemon mode Emacs may
+ need to occupy this tty if no other frame is available. */
+ if (!current_frame || !eval)
{
const char *tty_type, *tty_name;
@@ -1790,7 +1729,7 @@ main (int argc, char **argv)
/* Now, wait for an answer and print any messages. */
while (exit_status == EXIT_SUCCESS)
{
- char *p;
+ char *p, *end_p;
do
{
errno = 0;
@@ -1805,61 +1744,82 @@ main (int argc, char **argv)
string[rl] = '\0';
- p = string + strlen (string) - 1;
- while (p > string && *p == '\n')
- *p-- = 0;
+ /* Loop over all NL-terminated messages. */
+ for (end_p = p = string; end_p != NULL && *end_p != '\0'; p = end_p)
+ {
+ end_p = strchr (p, '\n');
+ if (end_p != NULL)
+ *end_p++ = '\0';
- if (strprefix ("-emacs-pid ", string))
- {
- /* -emacs-pid PID: The process id of the Emacs process. */
- emacs_pid = strtol (string + strlen ("-emacs-pid"), NULL, 10);
- }
- else if (strprefix ("-window-system-unsupported ", string))
- {
- /* -window-system-unsupported: Emacs was compiled without X
- support. Try again on the terminal. */
- nowait = 0;
- tty = 1;
- goto retry;
- }
- else if (strprefix ("-print ", string))
- {
- /* -print STRING: Print STRING on the terminal. */
- str = unquote_argument (string + strlen ("-print "));
- if (needlf)
- printf ("\n");
- printf ("%s", str);
- needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
- }
- else if (strprefix ("-error ", string))
- {
- /* -error DESCRIPTION: Signal an error on the terminal. */
- str = unquote_argument (string + strlen ("-error "));
- if (needlf)
- printf ("\n");
- fprintf (stderr, "*ERROR*: %s", str);
- needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
- exit_status = EXIT_FAILURE;
- }
+ if (strprefix ("-emacs-pid ", p))
+ {
+ /* -emacs-pid PID: The process id of the Emacs process. */
+ emacs_pid = strtol (p + strlen ("-emacs-pid"), NULL, 10);
+ }
+ else if (strprefix ("-window-system-unsupported ", p))
+ {
+ /* -window-system-unsupported: Emacs was compiled without support
+ for whatever window system we tried. Try the alternate
+ display, or, failing that, try the terminal. */
+ if (alt_display)
+ {
+ display = alt_display;
+ alt_display = NULL;
+ }
+ else
+ {
+ nowait = 0;
+ tty = 1;
+ }
+
+ goto retry;
+ }
+ else if (strprefix ("-print ", p))
+ {
+ /* -print STRING: Print STRING on the terminal. */
+ str = unquote_argument (p + strlen ("-print "));
+ if (needlf)
+ printf ("\n");
+ printf ("%s", str);
+ needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
+ }
+ else if (strprefix ("-print-nonl ", p))
+ {
+ /* -print-nonl STRING: Print STRING on the terminal.
+ Used to continue a preceding -print command. */
+ str = unquote_argument (p + strlen ("-print-nonl "));
+ printf ("%s", str);
+ needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
+ }
+ else if (strprefix ("-error ", p))
+ {
+ /* -error DESCRIPTION: Signal an error on the terminal. */
+ str = unquote_argument (p + strlen ("-error "));
+ if (needlf)
+ printf ("\n");
+ fprintf (stderr, "*ERROR*: %s", str);
+ needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
+ exit_status = EXIT_FAILURE;
+ }
#ifdef SIGSTOP
- else if (strprefix ("-suspend ", string))
- {
- /* -suspend: Suspend this terminal, i.e., stop the process. */
- if (needlf)
- printf ("\n");
- needlf = 0;
- kill (0, SIGSTOP);
- }
+ else if (strprefix ("-suspend ", p))
+ {
+ /* -suspend: Suspend this terminal, i.e., stop the process. */
+ if (needlf)
+ printf ("\n");
+ needlf = 0;
+ kill (0, SIGSTOP);
+ }
#endif
- else
- {
- /* Unknown command. */
- if (needlf)
- printf ("\n");
- printf ("*ERROR*: Unknown message: %s", string);
- needlf = string[0]
- == '\0' ? needlf : string[strlen (string) - 1] != '\n';
- }
+ else
+ {
+ /* Unknown command. */
+ if (needlf)
+ printf ("\n");
+ needlf = 0;
+ printf ("*ERROR*: Unknown message: %s\n", p);
+ }
+ }
}
if (needlf)
@@ -1875,22 +1835,3 @@ main (int argc, char **argv)
}
#endif /* HAVE_SOCKETS && HAVE_INET_SOCKETS */
-
-
-#ifndef HAVE_STRERROR
-char *
-strerror (errnum)
- int errnum;
-{
- extern char *sys_errlist[];
- extern int sys_nerr;
-
- if (errnum >= 0 && errnum < sys_nerr)
- return sys_errlist[errnum];
- return (char *) "Unknown error";
-}
-
-#endif /* ! HAVE_STRERROR */
-
-
-/* emacsclient.c ends here */
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 8852c9faea4..b6af17b8edf 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -28,7 +28,7 @@ OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2011
+Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2012
Free Software Foundation, Inc.
This file is not considered part of GNU Emacs.
@@ -91,25 +91,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
# define NDEBUG /* disable assert */
#endif
-#ifdef HAVE_CONFIG_H
-# include <config.h>
- /* This is probably not necessary any more. On some systems, config.h
- used to define static as nothing for the sake of unexec. We don't
- want that here since we don't use unexec. None of these systems
- are supported any more, but the idea is still mentioned in
- etc/PROBLEMS. */
-# undef static
-# ifndef PTR /* for XEmacs */
-# define PTR void *
-# endif
-#else /* no config.h */
-# if defined (__STDC__) && (__STDC__ || defined (__SUNPRO_C))
-# define PTR void * /* for generic pointers */
-# else /* not standard C */
-# define const /* remove const for old compilers' sake */
-# define PTR long * /* don't use void* */
-# endif
-#endif /* !HAVE_CONFIG_H */
+#include <config.h>
#ifndef _GNU_SOURCE
# define _GNU_SOURCE 1 /* enables some compiler checks on GNU */
@@ -129,10 +111,6 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
# include <fcntl.h>
# include <sys/param.h>
# include <io.h>
-# ifndef HAVE_CONFIG_H
-# define DOS_NT
-# include <sys/config.h>
-# endif
#else
# define MSDOS FALSE
#endif /* MSDOS */
@@ -145,19 +123,10 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
# undef HAVE_NTGUI
# undef DOS_NT
# define DOS_NT
-# ifndef HAVE_GETCWD
-# define HAVE_GETCWD
-# endif /* undef HAVE_GETCWD */
-#else /* not WINDOWSNT */
-#endif /* !WINDOWSNT */
+#endif /* WINDOWSNT */
#include <unistd.h>
-#ifndef HAVE_UNISTD_H
-# if defined (HAVE_GETCWD) && !defined (WINDOWSNT)
- extern char *getcwd (char *buf, size_t size);
-# endif
-#endif /* HAVE_UNISTD_H */
-
+#include <stdarg.h>
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
@@ -165,6 +134,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
#include <errno.h>
#include <sys/types.h>
#include <sys/stat.h>
+#include <c-strcase.h>
#include <assert.h>
#ifdef NDEBUG
@@ -172,24 +142,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
# define assert(x) ((void) 0)
#endif
-#ifdef NO_LONG_OPTIONS /* define this if you don't have GNU getopt */
-# define NO_LONG_OPTIONS TRUE
-# define getopt_long(argc,argv,optstr,lopts,lind) getopt (argc, argv, optstr)
- extern char *optarg;
- extern int optind, opterr;
-#else
-# define NO_LONG_OPTIONS FALSE
-# include <getopt.h>
-#endif /* NO_LONG_OPTIONS */
-
-#ifndef HAVE_CONFIG_H /* this is a standalone compilation */
-# ifdef __CYGWIN__ /* compiling on Cygwin */
- !!! NOTICE !!!
- the regex.h distributed with Cygwin is not compatible with etags, alas!
-If you want regular expression support, you should delete this notice and
- arrange to use the GNU regex.h and regex.c.
-# endif
-#endif
+#include <getopt.h>
#include <regex.h>
/* Define CTAGS to make the program "ctags" compatible with the usual one.
@@ -203,9 +156,9 @@ If you want regular expression support, you should delete this notice and
#endif
#define streq(s,t) (assert ((s)!=NULL || (t)!=NULL), !strcmp (s, t))
-#define strcaseeq(s,t) (assert ((s)!=NULL && (t)!=NULL), !etags_strcasecmp (s, t))
+#define strcaseeq(s,t) (assert ((s)!=NULL && (t)!=NULL), !c_strcasecmp (s, t))
#define strneq(s,t,n) (assert ((s)!=NULL || (t)!=NULL), !strncmp (s, t, n))
-#define strncaseeq(s,t,n) (assert ((s)!=NULL && (t)!=NULL), !etags_strncasecmp (s, t, n))
+#define strncaseeq(s,t,n) (assert ((s)!=NULL && (t)!=NULL), !c_strncasecmp (s, t, n))
#define CHARS 256 /* 2^sizeof(char) */
#define CHAR(x) ((unsigned int)(x) & (CHARS - 1))
@@ -380,10 +333,10 @@ static void get_tag (char *, char **);
static void analyse_regex (char *);
static void free_regexps (void);
static void regex_tag_multiline (void);
-static void error (const char *, const char *);
-static void suggest_asking_for_help (void) NO_RETURN;
-void fatal (const char *, const char *) NO_RETURN;
-static void pfatal (const char *) NO_RETURN;
+static void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
+static _Noreturn void suggest_asking_for_help (void);
+_Noreturn void fatal (const char *, const char *);
+static _Noreturn void pfatal (const char *);
static void add_node (node *, node **);
static void init (void);
@@ -404,8 +357,6 @@ static char *savenstr (const char *, int);
static char *savestr (const char *);
static char *etags_strchr (const char *, int);
static char *etags_strrchr (const char *, int);
-static int etags_strcasecmp (const char *, const char *);
-static int etags_strncasecmp (const char *, const char *, int);
static char *etags_getcwd (void);
static char *relative_filename (char *, char *);
static char *absolute_filename (char *, char *);
@@ -414,8 +365,8 @@ static bool filename_is_absolute (char *f);
static void canonicalize_filename (char *);
static void linebuffer_init (linebuffer *);
static void linebuffer_setlen (linebuffer *, int);
-static PTR xmalloc (size_t);
-static PTR xrealloc (char *, size_t);
+static void *xmalloc (size_t);
+static void *xrealloc (char *, size_t);
static char searchar = '/'; /* use /.../ searches */
@@ -866,8 +817,7 @@ etags --help --lang=ada.");
static void
print_version (void)
{
- /* Makes it easier to update automatically. */
- char emacs_copyright[] = "Copyright (C) 2011 Free Software Foundation, Inc.";
+ char emacs_copyright[] = COPYRIGHT;
printf ("%s (%s %s)\n", (CTAGS) ? "ctags" : "etags", EMACS_NAME, VERSION);
puts (emacs_copyright);
@@ -900,11 +850,7 @@ print_help (argument *argbuffer)
printf ("Usage: %s [options] [[regex-option ...] file-name] ...\n\
\n\
These are the options accepted by %s.\n", progname, progname);
- if (NO_LONG_OPTIONS)
- puts ("WARNING: long option names do not work with this executable,\n\
-as it is not linked with GNU getopt.");
- else
- puts ("You may use unambiguous abbreviations for the long option names.");
+ puts ("You may use unambiguous abbreviations for the long option names.");
puts (" A - as file name means read names from stdin (one per line).\n\
Absolute names are stored in the output file as they are.\n\
Relative ones are stored relative to the output file's directory.\n");
@@ -1096,9 +1042,9 @@ main (int argc, char **argv)
/* When the optstring begins with a '-' getopt_long does not rearrange the
non-options arguments to be at the end, but leaves them alone. */
- optstring = concat (NO_LONG_OPTIONS ? "" : "-",
- "ac:Cf:Il:o:r:RSVhH",
- (CTAGS) ? "BxdtTuvw" : "Di:");
+ optstring = concat ("-ac:Cf:Il:o:r:RSVhH",
+ (CTAGS) ? "BxdtTuvw" : "Di:",
+ "");
while ((opt = getopt_long (argc, argv, optstring, longopts, NULL)) != EOF)
switch (opt)
@@ -1140,7 +1086,7 @@ main (int argc, char **argv)
case 'o':
if (tagfile)
{
- error ("-o option may only be given once.", (char *)NULL);
+ error ("-o option may only be given once.");
suggest_asking_for_help ();
/* NOTREACHED */
}
@@ -1224,7 +1170,7 @@ main (int argc, char **argv)
if (nincluded_files == 0 && file_count == 0)
{
- error ("no input files specified.", (char *)NULL);
+ error ("no input files specified.");
suggest_asking_for_help ();
/* NOTREACHED */
}
@@ -1447,7 +1393,7 @@ get_language_from_langname (const char *name)
language *lang;
if (name == NULL)
- error ("empty language name", (char *)NULL);
+ error ("empty language name");
else
{
for (lang = lang_names; lang->name != NULL; lang++)
@@ -2153,7 +2099,7 @@ invalidate_nodes (fdesc *badfdp, node **npp)
static int total_size_of_entries (node *);
-static int number_len (long);
+static int number_len (long) ATTRIBUTE_CONST;
/* Length of a non-negative number's decimal representation. */
static int
@@ -2233,7 +2179,7 @@ put_entries (register node *np)
{
/* Ctags mode */
if (np->name == NULL)
- error ("internal error: NULL name in ctags mode.", (char *)NULL);
+ error ("internal error: NULL name in ctags mode.");
if (cxref_style)
{
@@ -2672,17 +2618,11 @@ write_classname (linebuffer *cn, const char *qualifier)
}
for (i = 1; i < cstack.nl; i++)
{
- char *s;
- int slen;
-
- s = cstack.cname[i];
+ char *s = cstack.cname[i];
if (s == NULL)
continue;
- slen = strlen (s);
- len += slen + qlen;
- linebuffer_setlen (cn, len);
- strncat (cn->buffer, qualifier, qlen);
- strncat (cn->buffer, s, slen);
+ linebuffer_setlen (cn, len + qlen + strlen (s));
+ len += sprintf (cn->buffer + len, "%s%s", qualifier, s);
}
}
@@ -2773,7 +2713,7 @@ consider_token (register char *str, register int len, register int c, int *c_ext
case dignorerest:
return FALSE;
default:
- error ("internal error: definedef value.", (char *)NULL);
+ error ("internal error: definedef value.");
}
/*
@@ -2897,7 +2837,7 @@ consider_token (register char *str, register int len, register int c, int *c_ext
fvdef = fvnone;
objdef = omethodtag;
linebuffer_setlen (&token_name, len);
- strncpy (token_name.buffer, str, len);
+ memcpy (token_name.buffer, str, len);
token_name.buffer[len] = '\0';
return TRUE;
}
@@ -2909,10 +2849,12 @@ consider_token (register char *str, register int len, register int c, int *c_ext
case omethodparm:
if (parlev == 0)
{
+ int oldlen = token_name.len;
fvdef = fvnone;
objdef = omethodtag;
- linebuffer_setlen (&token_name, token_name.len + len);
- strncat (token_name.buffer, str, len);
+ linebuffer_setlen (&token_name, oldlen + len);
+ memcpy (token_name.buffer + oldlen, str, len);
+ token_name.buffer[oldlen + len] = '\0';
return TRUE;
}
return FALSE;
@@ -3061,7 +3003,7 @@ make_C_tag (int isfun)
make_tag (concat ("INVALID TOKEN:-->", token_name.buffer, ""),
token_name.len + 17, isfun, token.line,
token.offset+token.length+1, token.lineno, token.linepos);
- error ("INVALID TOKEN", NULL);
+ error ("INVALID TOKEN");
}
token.valid = FALSE;
@@ -3341,12 +3283,12 @@ C_entries (int c_ext, FILE *inf)
&& nestlev > 0 && definedef == dnone)
/* in struct body */
{
+ int len;
write_classname (&token_name, qualifier);
- linebuffer_setlen (&token_name,
- token_name.len+qlen+toklen);
- strcat (token_name.buffer, qualifier);
- strncat (token_name.buffer,
- newlb.buffer + tokoff, toklen);
+ len = token_name.len;
+ linebuffer_setlen (&token_name, len+qlen+toklen);
+ sprintf (token_name.buffer + len, "%s%.*s",
+ qualifier, toklen, newlb.buffer + tokoff);
token.named = TRUE;
}
else if (objdef == ocatseen)
@@ -3354,11 +3296,8 @@ C_entries (int c_ext, FILE *inf)
{
int len = strlen (objtag) + 2 + toklen;
linebuffer_setlen (&token_name, len);
- strcpy (token_name.buffer, objtag);
- strcat (token_name.buffer, "(");
- strncat (token_name.buffer,
- newlb.buffer + tokoff, toklen);
- strcat (token_name.buffer, ")");
+ sprintf (token_name.buffer, "%s(%.*s)",
+ objtag, toklen, newlb.buffer + tokoff);
token.named = TRUE;
}
else if (objdef == omethodtag
@@ -3382,8 +3321,8 @@ C_entries (int c_ext, FILE *inf)
len -= 1;
}
linebuffer_setlen (&token_name, len);
- strncpy (token_name.buffer,
- newlb.buffer + off, len);
+ memcpy (token_name.buffer,
+ newlb.buffer + off, len);
token_name.buffer[len] = '\0';
if (defun)
while (--len >= 0)
@@ -3394,8 +3333,8 @@ C_entries (int c_ext, FILE *inf)
else
{
linebuffer_setlen (&token_name, toklen);
- strncpy (token_name.buffer,
- newlb.buffer + tokoff, toklen);
+ memcpy (token_name.buffer,
+ newlb.buffer + tokoff, toklen);
token_name.buffer[toklen] = '\0';
/* Name macros and members. */
token.named = (structdef == stagseen
@@ -4689,7 +4628,7 @@ Pascal_functions (FILE *inf)
/* Check if this is an "extern" declaration. */
if (*dbp == '\0')
continue;
- if (lowcase (*dbp == 'e'))
+ if (lowcase (*dbp) == 'e')
{
if (nocase_tail ("extern")) /* superfluous, really! */
{
@@ -5191,7 +5130,7 @@ HTML_labels (FILE *inf)
for (end = dbp; *end != '\0' && intoken (*end); end++)
continue;
linebuffer_setlen (&token_name, end - dbp);
- strncpy (token_name.buffer, dbp, end - dbp);
+ memcpy (token_name.buffer, dbp, end - dbp);
token_name.buffer[end - dbp] = '\0';
dbp = end;
@@ -5291,7 +5230,7 @@ Prolog_functions (FILE *inf)
else if (len + 1 > allocated)
xrnew (last, len + 1, char);
allocated = len + 1;
- strncpy (last, cp, len);
+ memcpy (last, cp, len);
last[len] = '\0';
}
}
@@ -5464,7 +5403,7 @@ Erlang_functions (FILE *inf)
else if (len + 1 > allocated)
xrnew (last, len + 1, char);
allocated = len + 1;
- strncpy (last, cp, len);
+ memcpy (last, cp, len);
last[len] = '\0';
}
}
@@ -5706,7 +5645,7 @@ add_regex (char *regexp_pattern, language *lang)
{
static struct re_pattern_buffer zeropattern;
char sep, *pat, *name, *modifiers;
- char empty[] = "";
+ char empty = '\0';
const char *err;
struct re_pattern_buffer *patbuf;
regexp *rp;
@@ -5719,7 +5658,7 @@ add_regex (char *regexp_pattern, language *lang)
if (strlen (regexp_pattern) < 3)
{
- error ("null regexp", (char *)NULL);
+ error ("null regexp");
return;
}
sep = regexp_pattern[0];
@@ -5738,7 +5677,7 @@ add_regex (char *regexp_pattern, language *lang)
if (modifiers == NULL) /* no terminating separator --> no name */
{
modifiers = name;
- name = empty;
+ name = &empty;
}
else
modifiers += 1; /* skip separator */
@@ -5749,7 +5688,7 @@ add_regex (char *regexp_pattern, language *lang)
{
case 'N':
if (modifiers == name)
- error ("forcing explicit tag name but no name, ignoring", NULL);
+ error ("forcing explicit tag name but no name, ignoring");
force_explicit_name = TRUE;
break;
case 'i':
@@ -5763,12 +5702,7 @@ add_regex (char *regexp_pattern, language *lang)
need_filebuf = TRUE;
break;
default:
- {
- char wrongmod [2];
- wrongmod[0] = modifiers[0];
- wrongmod[1] = '\0';
- error ("invalid regexp modifier `%s', ignoring", wrongmod);
- }
+ error ("invalid regexp modifier `%c', ignoring", modifiers[0]);
break;
}
@@ -5852,7 +5786,7 @@ substitute (char *in, char *out, struct re_registers *regs)
{
dig = *out - '0';
diglen = regs->end[dig] - regs->start[dig];
- strncpy (t, in + regs->start[dig], diglen);
+ memcpy (t, in + regs->start[dig], diglen);
t += diglen;
}
else
@@ -6075,7 +6009,7 @@ readline_internal (linebuffer *lbp, register FILE *stream)
filebuf.size *= 2;
xrnew (filebuf.buffer, filebuf.size, char);
}
- strncpy (filebuf.buffer + filebuf.len, lbp->buffer, lbp->len);
+ memcpy (filebuf.buffer + filebuf.len, lbp->buffer, lbp->len);
filebuf.len += lbp->len;
filebuf.buffer[filebuf.len++] = '\n';
filebuf.buffer[filebuf.len] = '\0';
@@ -6298,7 +6232,7 @@ savenstr (const char *cp, int len)
register char *dp;
dp = xnew (len + 1, char);
- strncpy (dp, cp, len);
+ memcpy (dp, cp, len);
dp[len] = '\0';
return dp;
}
@@ -6340,48 +6274,6 @@ etags_strchr (register const char *sp, register int c)
return NULL;
}
-/*
- * Compare two strings, ignoring case for alphabetic characters.
- *
- * Same as BSD's strcasecmp, included for portability.
- */
-static int
-etags_strcasecmp (register const char *s1, register const char *s2)
-{
- while (*s1 != '\0'
- && (ISALPHA (*s1) && ISALPHA (*s2)
- ? lowcase (*s1) == lowcase (*s2)
- : *s1 == *s2))
- s1++, s2++;
-
- return (ISALPHA (*s1) && ISALPHA (*s2)
- ? lowcase (*s1) - lowcase (*s2)
- : *s1 - *s2);
-}
-
-/*
- * Compare two strings, ignoring case for alphabetic characters.
- * Stop after a given number of characters
- *
- * Same as BSD's strncasecmp, included for portability.
- */
-static int
-etags_strncasecmp (register const char *s1, register const char *s2, register int n)
-{
- while (*s1 != '\0' && n-- > 0
- && (ISALPHA (*s1) && ISALPHA (*s2)
- ? lowcase (*s1) == lowcase (*s2)
- : *s1 == *s2))
- s1++, s2++;
-
- if (n < 0)
- return 0;
- else
- return (ISALPHA (*s1) && ISALPHA (*s2)
- ? lowcase (*s1) - lowcase (*s2)
- : *s1 - *s2);
-}
-
/* Skip spaces (end of string is not space), return new pointer. */
static char *
skip_spaces (char *cp)
@@ -6418,18 +6310,21 @@ pfatal (const char *s1)
static void
suggest_asking_for_help (void)
{
- fprintf (stderr, "\tTry `%s %s' for a complete list of options.\n",
- progname, NO_LONG_OPTIONS ? "-h" : "--help");
+ fprintf (stderr, "\tTry `%s --help' for a complete list of options.\n",
+ progname);
exit (EXIT_FAILURE);
}
-/* Print error message. `s1' is printf control string, `s2' is arg for it. */
+/* Output a diagnostic with printf-style FORMAT and args. */
static void
-error (const char *s1, const char *s2)
+error (const char *format, ...)
{
+ va_list ap;
+ va_start (ap, format);
fprintf (stderr, "%s: ", progname);
- fprintf (stderr, s1, s2);
+ vfprintf (stderr, format, ap);
fprintf (stderr, "\n");
+ va_end (ap);
}
/* Return a newly-allocated string whose contents
@@ -6454,7 +6349,6 @@ concat (const char *s1, const char *s2, const char *s3)
static char *
etags_getcwd (void)
{
-#ifdef HAVE_GETCWD
int bufsize = 200;
char *path = xnew (bufsize, char);
@@ -6469,34 +6363,6 @@ etags_getcwd (void)
canonicalize_filename (path);
return path;
-
-#else /* not HAVE_GETCWD */
-#if MSDOS
-
- char *p, path[MAXPATHLEN + 1]; /* Fixed size is safe on MSDOS. */
-
- getwd (path);
-
- for (p = path; *p != '\0'; p++)
- if (*p == '\\')
- *p = '/';
- else
- *p = lowcase (*p);
-
- return strdup (path);
-#else /* not MSDOS */
- linebuffer path;
- FILE *pipe;
-
- linebuffer_init (&path);
- pipe = (FILE *) popen ("pwd 2>/dev/null", "r");
- if (pipe == NULL || readline_internal (&path, pipe) == 0)
- pfatal ("pwd");
- pclose (pipe);
-
- return path.buffer;
-#endif /* not MSDOS */
-#endif /* not HAVE_GETCWD */
}
/* Return a newly allocated string containing the file name of FILE
@@ -6687,19 +6553,19 @@ linebuffer_setlen (linebuffer *lbp, int toksize)
}
/* Like malloc but get fatal error if memory is exhausted. */
-static PTR
+static void *
xmalloc (size_t size)
{
- PTR result = (PTR) malloc (size);
+ void *result = malloc (size);
if (result == NULL)
fatal ("virtual memory exhausted", (char *)NULL);
return result;
}
-static PTR
+static void *
xrealloc (char *ptr, size_t size)
{
- PTR result = (PTR) realloc (ptr, size);
+ void *result = realloc (ptr, size);
if (result == NULL)
fatal ("virtual memory exhausted", (char *)NULL);
return result;
diff --git a/lib-src/grep-changelog b/lib-src/grep-changelog
index 0c7c42dc7ce..5477de7b577 100755
--- a/lib-src/grep-changelog
+++ b/lib-src/grep-changelog
@@ -1,6 +1,6 @@
#! /usr/bin/perl
-# Copyright (C) 1999-2011 Free Software Foundation, Inc.
+# Copyright (C) 1999-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
diff --git a/lib-src/hexl.c b/lib-src/hexl.c
index f03663ef5be..08da0075269 100644
--- a/lib-src/hexl.c
+++ b/lib-src/hexl.c
@@ -1,5 +1,5 @@
/* Convert files for Emacs Hexl mode.
- Copyright (C) 1989, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1989, 2001-2012 Free Software Foundation, Inc.
Author: Keith Gabryelski
(according to authors.el)
@@ -20,9 +20,7 @@ You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <stdio.h>
#include <ctype.h>
@@ -48,7 +46,7 @@ int base = DEFAULT_BASE, un_flag = FALSE, iso_flag = FALSE, endian = 1;
int group_by = DEFAULT_GROUPING;
char *progname;
-void usage (void) NO_RETURN;
+_Noreturn void usage (void);
int
main (int argc, char **argv)
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index 1ec365f3446..68e7029ee85 100644
--- a/lib-src/make-docfile.c
+++ b/lib-src/make-docfile.c
@@ -1,6 +1,7 @@
/* Generate doc-string file for GNU Emacs from source files.
- Copyright (C) 1985-1986, 1992-1994, 1997, 1999-2011
- Free Software Foundation, Inc.
+
+Copyright (C) 1985-1986, 1992-1994, 1997, 1999-2012
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -35,57 +36,41 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-/* defined to be emacs_main, sys_fopen, etc. in config.h */
-#undef main
-#undef fopen
-#undef chdir
-
#include <stdio.h>
-#include <stdlib.h>
+#include <stdlib.h> /* config.h unconditionally includes this anyway */
#ifdef MSDOS
#include <fcntl.h>
#endif /* MSDOS */
#ifdef WINDOWSNT
+/* Defined to be sys_fopen in ms-w32.h, but only #ifdef emacs, so this
+ is really just insurance. */
+#undef fopen
#include <fcntl.h>
#include <direct.h>
#endif /* WINDOWSNT */
#ifdef DOS_NT
+/* Defined to be sys_chdir in ms-w32.h, but only #ifdef emacs, so this
+ is really just insurance.
+
+ Similarly, msdos defines this as sys_chdir, but we're not linking with the
+ file where that function is defined. */
+#undef chdir
#define READ_TEXT "rt"
#define READ_BINARY "rb"
+#define IS_SLASH(c) ((c) == '/' || (c) == '\\' || (c) == ':')
#else /* not DOS_NT */
#define READ_TEXT "r"
#define READ_BINARY "r"
+#define IS_SLASH(c) ((c) == '/')
#endif /* not DOS_NT */
-#ifndef DIRECTORY_SEP
-#define DIRECTORY_SEP '/'
-#endif
-
-#ifndef IS_DIRECTORY_SEP
-#define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP)
-#endif
-
-/* Use this to suppress gcc's `...may be used before initialized' warnings. */
-#ifdef lint
-# define IF_LINT(Code) Code
-#else
-# define IF_LINT(Code) /* empty */
-#endif
-
static int scan_file (char *filename);
static int scan_lisp_file (const char *filename, const char *mode);
static int scan_c_file (char *filename, const char *mode);
-static void fatal (const char *s1, const char *s2) NO_RETURN;
static void start_globals (void);
static void write_globals (void);
-#ifdef MSDOS
-/* s/msdos.h defines this as sys_chdir, but we're not linking with the
- file where that function is defined. */
-#undef chdir
-#endif
-
#include <unistd.h>
/* Stdio stream for output to the DOC file. */
@@ -111,7 +96,7 @@ error (const char *s1, const char *s2)
/* Print error message and exit. */
/* VARARGS1 */
-static void
+static _Noreturn void
fatal (const char *s1, const char *s2)
{
error (s1, s2);
@@ -226,7 +211,7 @@ put_filename (char *filename)
for (tmp = filename; *tmp; tmp++)
{
- if (IS_DIRECTORY_SEP(*tmp))
+ if (IS_DIRECTORY_SEP (*tmp))
filename = tmp + 1;
}
@@ -541,8 +526,8 @@ write_c_args (FILE *out, char *func, char *buf, int minargs, int maxargs)
maxargs--;
/* In C code, `default' is a reserved word, so we spell it
- `defalt'; unmangle that here. */
- if (ident_length == 6 && strncmp (ident_start, "defalt", 6) == 0)
+ `defalt'; demangle that here. */
+ if (ident_length == 6 && memcmp (ident_start, "defalt", 6) == 0)
fprintf (out, "DEFAULT");
else
while (ident_length-- > 0)
@@ -562,13 +547,15 @@ write_c_args (FILE *out, char *func, char *buf, int minargs, int maxargs)
putc (')', out);
}
-/* The types of globals. */
+/* The types of globals. These are sorted roughly in decreasing alignment
+ order to avoid allocation gaps, except that functions are last. */
enum global_type
{
+ INVALID,
+ LISP_OBJECT,
EMACS_INTEGER,
BOOLEAN,
- LISP_OBJECT,
- INVALID
+ FUNCTION,
};
/* A single global. */
@@ -576,6 +563,7 @@ struct global
{
enum global_type type;
char *name;
+ int value;
};
/* All the variable names we saw while scanning C sources in `-g'
@@ -585,7 +573,7 @@ int num_globals_allocated;
struct global *globals;
static void
-add_global (enum global_type type, char *name)
+add_global (enum global_type type, char *name, int value)
{
/* Ignore the one non-symbol that can occur. */
if (strcmp (name, "..."))
@@ -606,6 +594,7 @@ add_global (enum global_type type, char *name)
globals[num_globals - 1].type = type;
globals[num_globals - 1].name = name;
+ globals[num_globals - 1].value = value;
}
}
@@ -614,13 +603,24 @@ compare_globals (const void *a, const void *b)
{
const struct global *ga = a;
const struct global *gb = b;
+
+ if (ga->type != gb->type)
+ return ga->type - gb->type;
+
return strcmp (ga->name, gb->name);
}
static void
+close_emacs_globals (void)
+{
+ fprintf (outfile, "};\n");
+ fprintf (outfile, "extern struct emacs_globals globals;\n");
+}
+
+static void
write_globals (void)
{
- int i;
+ int i, seen_defun = 0;
qsort (globals, num_globals, sizeof (struct global), compare_globals);
for (i = 0; i < num_globals; ++i)
{
@@ -632,25 +632,62 @@ write_globals (void)
type = "EMACS_INT";
break;
case BOOLEAN:
- type = "int";
+ type = "bool";
break;
case LISP_OBJECT:
type = "Lisp_Object";
break;
+ case FUNCTION:
+ if (!seen_defun)
+ {
+ close_emacs_globals ();
+ fprintf (outfile, "\n");
+ seen_defun = 1;
+ }
+ break;
default:
fatal ("not a recognized DEFVAR_", 0);
}
- fprintf (outfile, " %s f_%s;\n", type, globals[i].name);
- fprintf (outfile, "#define %s globals.f_%s\n",
- globals[i].name, globals[i].name);
+ if (globals[i].type != FUNCTION)
+ {
+ fprintf (outfile, " %s f_%s;\n", type, globals[i].name);
+ fprintf (outfile, "#define %s globals.f_%s\n",
+ globals[i].name, globals[i].name);
+ }
+ else
+ {
+ /* It would be nice to have a cleaner way to deal with these
+ special hacks. */
+ if (strcmp (globals[i].name, "Fthrow") == 0
+ || strcmp (globals[i].name, "Ftop_level") == 0
+ || strcmp (globals[i].name, "Fkill_emacs") == 0
+ || strcmp (globals[i].name, "Fexit_recursive_edit") == 0
+ || strcmp (globals[i].name, "Fabort_recursive_edit") == 0)
+ fprintf (outfile, "_Noreturn ");
+ fprintf (outfile, "EXFUN (%s, ", globals[i].name);
+ if (globals[i].value == -1)
+ fprintf (outfile, "MANY");
+ else if (globals[i].value == -2)
+ fprintf (outfile, "UNEVALLED");
+ else
+ fprintf (outfile, "%d", globals[i].value);
+ fprintf (outfile, ");\n");
+ }
+
while (i + 1 < num_globals
&& !strcmp (globals[i].name, globals[i + 1].name))
- ++i;
+ {
+ if (globals[i].type == FUNCTION
+ && globals[i].value != globals[i + 1].value)
+ error ("function '%s' defined twice with differing signatures",
+ globals[i].name);
+ ++i;
+ }
}
- fprintf (outfile, "};\n");
- fprintf (outfile, "extern struct emacs_globals globals;\n");
+ if (!seen_defun)
+ close_emacs_globals ();
}
@@ -675,14 +712,14 @@ scan_c_file (char *filename, const char *mode)
if (infile == NULL && extension == 'o')
{
- /* try .m */
+ /* Try .m. */
filename[strlen (filename) - 1] = 'm';
infile = fopen (filename, mode);
if (infile == NULL)
- filename[strlen (filename) - 1] = 'c'; /* don't confuse people */
+ filename[strlen (filename) - 1] = 'c'; /* Don't confuse people. */
}
- /* No error if non-ex input file */
+ /* No error if non-ex input file. */
if (infile == NULL)
{
perror (filename);
@@ -700,6 +737,7 @@ scan_c_file (char *filename, const char *mode)
int defvarperbufferflag = 0;
int defvarflag = 0;
enum global_type type = INVALID;
+ char *name IF_LINT (= 0);
if (c != '\n' && c != '\r')
{
@@ -765,8 +803,9 @@ scan_c_file (char *filename, const char *mode)
}
else continue;
- if (generate_globals && (!defvarflag || defvarperbufferflag
- || type == INVALID))
+ if (generate_globals
+ && (!defvarflag || defvarperbufferflag || type == INVALID)
+ && !defunflag)
continue;
while (c != '(')
@@ -785,7 +824,6 @@ scan_c_file (char *filename, const char *mode)
if (generate_globals)
{
int i = 0;
- char *name;
/* Skip "," and whitespace. */
do
@@ -800,14 +838,18 @@ scan_c_file (char *filename, const char *mode)
input_buffer[i++] = c;
c = getc (infile);
}
- while (! (c == ',' || c == ' ' || c == '\t' ||
- c == '\n' || c == '\r'));
+ while (! (c == ',' || c == ' ' || c == '\t'
+ || c == '\n' || c == '\r'));
input_buffer[i] = '\0';
name = xmalloc (i + 1);
memcpy (name, input_buffer, i + 1);
- add_global (type, name);
- continue;
+
+ if (!defunflag)
+ {
+ add_global (type, name, 0);
+ continue;
+ }
}
/* DEFVAR_LISP ("name", addr, "doc")
@@ -815,12 +857,12 @@ scan_c_file (char *filename, const char *mode)
DEFVAR_LISP ("name", addr, doc: /\* doc *\/) */
if (defunflag)
- commas = 5;
+ commas = generate_globals ? 4 : 5;
else if (defvarperbufferflag)
commas = 3;
else if (defvarflag)
commas = 1;
- else /* For DEFSIMPLE and DEFPRED */
+ else /* For DEFSIMPLE and DEFPRED. */
commas = 2;
while (commas)
@@ -838,11 +880,16 @@ scan_c_file (char *filename, const char *mode)
if (c < 0)
goto eof;
ungetc (c, infile);
- if (commas == 2) /* pick up minargs */
+ if (commas == 2) /* Pick up minargs. */
scanned = fscanf (infile, "%d", &minargs);
- else /* pick up maxargs */
+ else /* Pick up maxargs. */
if (c == 'M' || c == 'U') /* MANY || UNEVALLED */
- maxargs = -1;
+ {
+ if (generate_globals)
+ maxargs = (c == 'M') ? -1 : -2;
+ else
+ maxargs = -1;
+ }
else
scanned = fscanf (infile, "%d", &maxargs);
if (scanned < 0)
@@ -855,6 +902,12 @@ scan_c_file (char *filename, const char *mode)
c = getc (infile);
}
+ if (generate_globals)
+ {
+ add_global (FUNCTION, name, maxargs);
+ continue;
+ }
+
while (c == ' ' || c == '\n' || c == '\r' || c == '\t')
c = getc (infile);
@@ -893,7 +946,7 @@ scan_c_file (char *filename, const char *mode)
fprintf (outfile, "%s\n", input_buffer);
if (comment)
- getc (infile); /* Skip past `*' */
+ getc (infile); /* Skip past `*'. */
c = read_c_string_or_comment (infile, 1, comment, &saw_usage);
/* If this is a defun, find the arguments and print them. If
@@ -974,12 +1027,12 @@ scan_c_file (char *filename, const char *mode)
arglist, but the doc string must still have a backslash and newline
immediately after the double quote.
The only source files that must follow this convention are preloaded
- uncompiled ones like loaddefs.el and bindings.el; aside
- from that, it is always the .elc file that we look at, and they are no
- problem because byte-compiler output follows this convention.
+ uncompiled ones like loaddefs.el; aside from that, it is always the .elc
+ file that we should look at, and they are no problem because byte-compiler
+ output follows this convention.
The NAME and DOCSTRING are output.
NAME is preceded by `F' for a function or `V' for a variable.
- An entry is output only if DOCSTRING has \ newline just after the opening "
+ An entry is output only if DOCSTRING has \ newline just after the opening ".
*/
static void
@@ -1020,20 +1073,83 @@ read_lisp_symbol (FILE *infile, char *buffer)
}
static int
+search_lisp_doc_at_eol (FILE *infile)
+{
+ char c = 0, c1 = 0, c2 = 0;
+
+ /* Skip until the end of line; remember two previous chars. */
+ while (c != '\n' && c != '\r' && c != EOF)
+ {
+ c2 = c1;
+ c1 = c;
+ c = getc (infile);
+ }
+
+ /* If two previous characters were " and \,
+ this is a doc string. Otherwise, there is none. */
+ if (c2 != '"' || c1 != '\\')
+ {
+#ifdef DEBUG
+ fprintf (stderr, "## non-docstring in %s (%s)\n",
+ buffer, filename);
+#endif
+ if (c != EOF)
+ ungetc (c, infile);
+ return 0;
+ }
+ return 1;
+}
+
+#define DEF_ELISP_FILE(fn) { #fn, sizeof(#fn) - 1 }
+
+static int
scan_lisp_file (const char *filename, const char *mode)
{
FILE *infile;
register int c;
char *saved_string = 0;
+ /* These are the only files that are loaded uncompiled, and must
+ follow the conventions of the doc strings expected by this
+ function. These conventions are automatically followed by the
+ byte compiler when it produces the .elc files. */
+ static struct {
+ const char *fn;
+ size_t fl;
+ } const uncompiled[] = {
+ DEF_ELISP_FILE (loaddefs.el),
+ DEF_ELISP_FILE (loadup.el),
+ DEF_ELISP_FILE (charprop.el),
+ DEF_ELISP_FILE (cp51932.el),
+ DEF_ELISP_FILE (eucjp-ms.el)
+ };
+ int i, match;
+ size_t flen = strlen (filename);
if (generate_globals)
fatal ("scanning lisp file when -g specified", 0);
+ if (flen > 3 && !strcmp (filename + flen - 3, ".el"))
+ {
+ for (i = 0, match = 0; i < sizeof (uncompiled) / sizeof (uncompiled[0]);
+ i++)
+ {
+ if (uncompiled[i].fl <= flen
+ && !strcmp (filename + flen - uncompiled[i].fl, uncompiled[i].fn)
+ && (flen == uncompiled[i].fl
+ || IS_SLASH (filename[flen - uncompiled[i].fl - 1])))
+ {
+ match = 1;
+ break;
+ }
+ }
+ if (!match)
+ fatal ("uncompiled lisp file %s is not supported", filename);
+ }
infile = fopen (filename, mode);
if (infile == NULL)
{
perror (filename);
- return 0; /* No error */
+ return 0; /* No error. */
}
c = '\n';
@@ -1110,7 +1226,7 @@ scan_lisp_file (const char *filename, const char *mode)
type = 'F';
read_lisp_symbol (infile, buffer);
- /* Skip the arguments: either "nil" or a list in parens */
+ /* Skip the arguments: either "nil" or a list in parens. */
c = getc (infile);
if (c == 'n') /* nil */
@@ -1154,39 +1270,18 @@ scan_lisp_file (const char *filename, const char *mode)
|| ! strcmp (buffer, "defconst")
|| ! strcmp (buffer, "defcustom"))
{
- char c1 = 0, c2 = 0;
type = 'V';
read_lisp_symbol (infile, buffer);
if (saved_string == 0)
- {
-
- /* Skip until the end of line; remember two previous chars. */
- while (c != '\n' && c != '\r' && c >= 0)
- {
- c2 = c1;
- c1 = c;
- c = getc (infile);
- }
-
- /* If two previous characters were " and \,
- this is a doc string. Otherwise, there is none. */
- if (c2 != '"' || c1 != '\\')
- {
-#ifdef DEBUG
- fprintf (stderr, "## non-docstring in %s (%s)\n",
- buffer, filename);
-#endif
- continue;
- }
- }
+ if (!search_lisp_doc_at_eol (infile))
+ continue;
}
else if (! strcmp (buffer, "custom-declare-variable")
|| ! strcmp (buffer, "defvaralias")
)
{
- char c1 = 0, c2 = 0;
type = 'V';
c = getc (infile);
@@ -1221,31 +1316,12 @@ scan_lisp_file (const char *filename, const char *mode)
}
if (saved_string == 0)
- {
- /* Skip to end of line; remember the two previous chars. */
- while (c != '\n' && c != '\r' && c >= 0)
- {
- c2 = c1;
- c1 = c;
- c = getc (infile);
- }
-
- /* If two previous characters were " and \,
- this is a doc string. Otherwise, there is none. */
- if (c2 != '"' || c1 != '\\')
- {
-#ifdef DEBUG
- fprintf (stderr, "## non-docstring in %s (%s)\n",
- buffer, filename);
-#endif
- continue;
- }
- }
+ if (!search_lisp_doc_at_eol (infile))
+ continue;
}
else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
{
- char c1 = 0, c2 = 0;
type = 'F';
c = getc (infile);
@@ -1278,26 +1354,8 @@ scan_lisp_file (const char *filename, const char *mode)
}
if (saved_string == 0)
- {
- /* Skip to end of line; remember the two previous chars. */
- while (c != '\n' && c != '\r' && c >= 0)
- {
- c2 = c1;
- c1 = c;
- c = getc (infile);
- }
-
- /* If two previous characters were " and \,
- this is a doc string. Otherwise, there is none. */
- if (c2 != '"' || c1 != '\\')
- {
-#ifdef DEBUG
- fprintf (stderr, "## non-docstring in %s (%s)\n",
- buffer, filename);
-#endif
- continue;
- }
- }
+ if (!search_lisp_doc_at_eol (infile))
+ continue;
}
else if (! strcmp (buffer, "autoload"))
@@ -1339,29 +1397,16 @@ scan_lisp_file (const char *filename, const char *mode)
continue;
}
read_c_string_or_comment (infile, 0, 0, 0);
- skip_white (infile);
if (saved_string == 0)
- {
- /* If the next three characters aren't `dquote bslash newline'
- then we're not reading a docstring. */
- if ((c = getc (infile)) != '"'
- || (c = getc (infile)) != '\\'
- || ((c = getc (infile)) != '\n' && c != '\r'))
- {
-#ifdef DEBUG
- fprintf (stderr, "## non-docstring in %s (%s)\n",
- buffer, filename);
-#endif
- continue;
- }
- }
+ if (!search_lisp_doc_at_eol (infile))
+ continue;
}
#ifdef DEBUG
else if (! strcmp (buffer, "if")
|| ! strcmp (buffer, "byte-code"))
- ;
+ continue;
#endif
else
@@ -1373,12 +1418,10 @@ scan_lisp_file (const char *filename, const char *mode)
continue;
}
- /* At this point, we should either use the previous
- dynamic doc string in saved_string
- or gobble a doc string from the input file.
-
- In the latter case, the opening quote (and leading
- backslash-newline) have already been read. */
+ /* At this point, we should either use the previous dynamic doc string in
+ saved_string or gobble a doc string from the input file.
+ In the latter case, the opening quote (and leading backslash-newline)
+ have already been read. */
putc (037, outfile);
putc (type, outfile);
diff --git a/lib-src/makefile.w32-in b/lib-src/makefile.w32-in
index be7f4d0b6db..cbd29f32cfe 100644
--- a/lib-src/makefile.w32-in
+++ b/lib-src/makefile.w32-in
@@ -1,5 +1,5 @@
-# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
-# Copyright (C) 2000-2011 Free Software Foundation, Inc.
+# -*- Makefile -*- for GNU Emacs on the Microsoft Windows API.
+# Copyright (C) 2000-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -17,33 +17,27 @@
# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-ALL = make-docfile hexl ctags etags movemail ebrowse emacsclient
+ALL = $(BLD)/test-distrib.exe $(BLD)/make-docfile.exe $(BLD)/hexl.exe\
+ $(BLD)/ctags.exe $(BLD)/etags.exe $(BLD)/movemail.exe $(BLD)/ebrowse.exe\
+ $(BLD)/emacsclient.exe $(BLD)/emacsclientw.exe $(BLD)/profile.exe
-.PHONY: $(ALL)
+.PHONY: make-docfile
-LOCAL_FLAGS = -DWINDOWSNT -DDOS_NT -DNO_LDAV=1 \
- -DNO_ARCHIVES=1 -DHAVE_CONFIG_H=1 -I../lib \
+LOCAL_FLAGS = -DNO_LDAV=1 -DNO_ARCHIVES=1 -I../lib \
-I../nt/inc -I../src $(EMACS_EXTRA_C_FLAGS)
LIBS = $(BASE_LIBS) $(ADVAPI32)
+# The following target is used by makefile.w32-in files in other directories.
+make-docfile: $(BLD)/make-docfile.exe
+
$(BLD)/make-docfile.exe: $(BLD)/make-docfile.$(O) $(BLD)/ntlib.$(O)
$(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/make-docfile.$(O) $(BLD)/ntlib.$(O) $(LIBS)
$(BLD)/hexl.exe: $(BLD)/hexl.$(O)
$(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/hexl.$(O) $(LIBS)
$(BLD)/test-distrib.exe: $(BLD)/test-distrib.$(O)
$(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/test-distrib.$(O) $(LIBS)
-
-make-docfile: stamp_BLD $(BLD)/make-docfile.exe
-ctags: stamp_BLD $(BLD)/ctags.exe
-etags: stamp_BLD $(BLD)/etags.exe
-ebrowse: stamp_BLD $(BLD)/ebrowse.exe
-hexl: stamp_BLD $(BLD)/hexl.exe
-movemail: stamp_BLD $(BLD)/movemail.exe
-emacsclient: stamp_BLD $(BLD)/emacsclient.exe $(BLD)/emacsclientw.exe
-
-test-distrib: stamp_BLD $(BLD)/test-distrib.exe
- "$(BLD)/test-distrib.exe" "$(SRC)/testfile"
+ "$(BLD)/test-distrib.exe" "$(LIB_SRC)/testfile"
MOVEMAILOBJS = $(BLD)/movemail.$(O) \
$(BLD)/pop.$(O) \
@@ -70,7 +64,7 @@ $(BLD)/emacsclient.exe: $(ECLIENTOBJS)
$(BLD)/emacsclientw.exe: $(ECLIENTOBJS) $(CLIENTRES)
# put wsock32.lib before $(LIBS) to ensure we don't link to ws2_32.lib
- $(LINK) $(LINK_OUT)$@ $(CLIENTRES) -mwindows $(LINK_FLAGS) $(ECLIENTOBJS) $(WSOCK32) $(USER32) $(COMCTL32) $(LIBS)
+ $(LINK) $(LINK_OUT)$@ $(CLIENTRES) $(MWINDOWS) $(LINK_FLAGS) $(ECLIENTOBJS) $(WSOCK32) $(USER32) $(COMCTL32) $(LIBS)
$(BLD)/emacsclient.$(O): emacsclient.c
$(CC) $(CFLAGS) $(ECLIENT_CFLAGS) $(CC_OUT)$@ emacsclient.c
@@ -111,10 +105,16 @@ ctags.c: etags.c
- $(DEL) ctags.c
$(CP) etags.c ctags.c
-CTAGS_CFLAGS = -DCTAGS $(ETAGS_CFLAGS) -DEMACS_NAME="\"GNU Emacs\""
+CTAGS_CFLAGS = -DCTAGS $(ETAGS_CFLAGS)
$(BLD)/ctags.$(O): ctags.c
$(CC) $(CFLAGS) $(CTAGS_CFLAGS) $(CC_OUT)$@ ctags.c
+PROFILEOBJS = $(BLD)/profile.$(O) \
+ ../lib/$(BLD)/libgnu.$(A) \
+ $(BLD)/ntlib.$(O)
+$(BLD)/profile.exe: $(PROFILEOBJS)
+ $(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(PROFILEOBJS) $(LIBS)
+
#
# From ..\src\Makefile.in
# It doesn't matter if the real name is *.obj for the files in this list,
@@ -124,7 +124,7 @@ $(BLD)/ctags.$(O): ctags.c
obj = dosfns.o msdos.o \
xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o fringe.o image.o \
fontset.o menu.o \
- w32.o w32console.o w32fns.o w32heap.o w32inevt.o \
+ w32.o w32console.o w32fns.o w32heap.o w32inevt.o cygw32.o \
w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \
font.o w32font.o w32uniscribe.o \
dispnew.o frame.o scroll.o xdisp.o window.o bidi.o \
@@ -140,7 +140,7 @@ obj = dosfns.o msdos.o \
process.o callproc.o unexw32.o \
region-cache.o sound.o atimer.o \
doprnt.o intervals.o textprop.o composite.o \
- gnutls.o
+ gnutls.o xml.o profiler.o
#
# These are the lisp files that are loaded up in loadup.el
@@ -209,39 +209,40 @@ lisp1= \
$(lispsource)emacs-lisp/map-ynp.elc \
$(lispsource)menu-bar.elc \
$(lispsource)international/mule.elc \
- $(lispsource)international/mule-conf.el \
+ $(lispsource)international/mule-conf.elc \
$(lispsource)international/mule-cmds.elc \
$(lispsource)international/characters.elc \
$(lispsource)international/charprop.el \
$(lispsource)case-table.elc
lisp2 = \
- $(lispsource)language/chinese.el \
- $(lispsource)language/cyrillic.el \
- $(lispsource)language/indian.el \
- $(lispsource)language/sinhala.el \
- $(lispsource)language/english.el \
+ $(lispsource)language/chinese.elc \
+ $(lispsource)language/cyrillic.elc \
+ $(lispsource)language/indian.elc \
+ $(lispsource)language/sinhala.elc \
+ $(lispsource)language/english.elc \
$(lispsource)language/ethiopic.elc \
$(lispsource)language/european.elc \
- $(lispsource)language/czech.el \
- $(lispsource)language/slovak.el \
- $(lispsource)language/romanian.el \
- $(lispsource)language/greek.el \
+ $(lispsource)language/czech.elc \
+ $(lispsource)language/slovak.elc \
+ $(lispsource)language/romanian.elc \
+ $(lispsource)language/greek.elc \
$(lispsource)language/hebrew.elc \
- $(lispsource)language/japanese.el \
- $(lispsource)language/korean.el \
- $(lispsource)language/lao.el \
- $(lispsource)language/cham.el \
- $(lispsource)language/tai-viet.el \
- $(lispsource)language/thai.el \
+ $(lispsource)language/japanese.elc \
+ $(lispsource)international/cp51932.el \
+ $(lispsource)international/eucjp-ms.el \
+ $(lispsource)language/korean.elc \
+ $(lispsource)language/lao.elc \
+ $(lispsource)language/cham.elc \
+ $(lispsource)language/tai-viet.elc \
+ $(lispsource)language/thai.elc \
$(lispsource)language/tibetan.elc \
- $(lispsource)language/vietnamese.el \
- $(lispsource)language/misc-lang.el \
- $(lispsource)language/utf-8-lang.el \
- $(lispsource)language/georgian.el \
- $(lispsource)language/khmer.el \
- $(lispsource)language/burmese.el \
- $(lispsource)paths.el \
+ $(lispsource)language/vietnamese.elc \
+ $(lispsource)language/misc-lang.elc \
+ $(lispsource)language/utf-8-lang.elc \
+ $(lispsource)language/georgian.elc \
+ $(lispsource)language/khmer.elc \
+ $(lispsource)language/burmese.elc \
$(lispsource)register.elc \
$(lispsource)replace.elc \
$(lispsource)simple.elc \
@@ -267,7 +268,7 @@ lisp2 = \
$(WINDOW_SUPPORT) \
$(lispsource)widget.elc \
$(lispsource)window.elc \
- $(lispsource)version.el
+ $(lispsource)version.elc
# This is needed the first time we build the tree, since temacs.exe
# does not exist yet, and the DOC rule needs it to rebuild DOC whenever
@@ -297,7 +298,7 @@ $(DOC): stamp_BLD $(BLD)/make-docfile.exe ../src/$(BLD)/temacs.exe $(lisp1) $(l
#
# Build the executables
#
-all: stamp_BLD $(ALL) $(DOC)
+all: $(ALL) $(DOC)
#
# Assuming INSTALL_DIR is defined, build and install emacs in it.
@@ -312,6 +313,7 @@ install: $(INSTALL_FILES)
$(CP) $(BLD)/movemail.exe $(INSTALL_DIR)/bin
$(CP) $(BLD)/emacsclient.exe $(INSTALL_DIR)/bin
$(CP) $(BLD)/emacsclientw.exe $(INSTALL_DIR)/bin
+ $(CP) $(BLD)/profile.exe $(INSTALL_DIR)/bin
- mkdir "$(INSTALL_DIR)/etc"
$(CP) $(DOC) $(INSTALL_DIR)/etc
@@ -354,114 +356,113 @@ TAGS: $(BLD)/etags.exe *.c *.h
### DEPENDENCIES ###
EMACS_ROOT = ..
-SRC = .
-
-$(BLD)/alloca.$(O) : \
- $(SRC)/alloca.c \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h \
- $(EMACS_ROOT)/src/blockinput.h
+LIB_SRC = .
+SRC = $(EMACS_ROOT)/src
+NT_INC = $(EMACS_ROOT)/nt/inc
+GNU_LIB = $(EMACS_ROOT)/lib
+
+MS_W32_H = $(NT_INC)/ms-w32.h \
+ $(NT_INC)/sys/stat.h
+CONF_POST_H = $(SRC)/conf_post.h \
+ $(MS_W32_H)
+CONFIG_H = $(SRC)/config.h \
+ $(CONF_POST_H)
+INTTYPES_H = $(NT_INC)/inttypes.h \
+ $(NT_INC)/stdint.h
+NTLIB_H = $(LIB_SRC)/ntlib.h \
+ $(NT_INC)/pwd.h
+SYSTIME_H = $(SRC)/systime.h \
+ $(NT_INC)/sys/time.h \
+ $(GNU_LIB)/timespec.h
+SYSWAIT_H = $(SRC)/syswait.h \
+ $(NT_INC)/sys/wait.h
$(BLD)/ctags.$(O) : \
- $(SRC)/ctags.c \
- $(EMACS_ROOT)/nt/inc/sys/param.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h \
- $(SRC)/ntlib.h \
- $(EMACS_ROOT)/lib/getopt.h
+ $(LIB_SRC)/ctags.c \
+ $(SRC)/regex.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/c-strcase.h \
+ $(GNU_LIB)/getopt.h \
+ $(CONFIG_H)
$(BLD)/ebrowse.$(O) : \
- $(SRC)/ebrowse.c \
- $(EMACS_ROOT)/lib/min-max.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h
+ $(LIB_SRC)/ebrowse.c \
+ $(GNU_LIB)/getopt.h \
+ $(GNU_LIB)/min-max.h \
+ $(CONFIG_H)
$(BLD)/emacsclient.$(O) : \
- $(SRC)/emacsclient.c \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h
+ $(LIB_SRC)/emacsclient.c \
+ $(NT_INC)/pwd.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/getopt.h \
+ $(CONFIG_H)
$(BLD)/etags.$(O) : \
- $(SRC)/etags.c \
- $(EMACS_ROOT)/nt/inc/sys/param.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h \
- $(SRC)/ntlib.h \
- $(EMACS_ROOT)/lib/getopt.h
-
-$(BLD)/getdate.$(O) : \
- $(SRC)/getdate.c \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h \
- $(MSTOOLS_SYS)/types.h
+ $(LIB_SRC)/etags.c \
+ $(SRC)/regex.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/c-strcase.h \
+ $(GNU_LIB)/getopt.h \
+ $(CONFIG_H)
$(BLD)/hexl.$(O) : \
- $(SRC)/hexl.c
-
-$(BLD)/leditcfns.$(O) : \
- $(SRC)/leditcfns.c
+ $(LIB_SRC)/hexl.c \
+ $(CONFIG_H)
$(BLD)/make-docfile.$(O) : \
- $(SRC)/make-docfile.c \
- $(EMACS_ROOT)/src/config.h
-
-$(BLD)/make-path.$(O) : \
- $(SRC)/make-path.c
+ $(LIB_SRC)/make-docfile.c \
+ $(NT_INC)/unistd.h \
+ $(CONFIG_H)
$(BLD)/movemail.$(O) : \
- $(SRC)/movemail.c \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h \
- $(EMACS_ROOT)/nt/inc/sys/file.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/lib-src/../src/syswait.h \
- $(EMACS_ROOT)/nt/inc/pwd.h \
- $(SRC)/ntlib.h
- $(CC) $(CFLAGS) -DUSG $(CC_OUT)$@ movemail.c
+ $(LIB_SRC)/movemail.c \
+ $(LIB_SRC)/pop.h \
+ $(NT_INC)/pwd.h \
+ $(NT_INC)/sys/file.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/getopt.h \
+ $(CONFIG_H) \
+ $(NTLIB_H) \
+ $(SYSWAIT_H)
$(BLD)/ntlib.$(O) : \
- $(SRC)/ntlib.c \
- $(SRC)/ntlib.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/nt/inc/pwd.h
+ $(LIB_SRC)/ntlib.c \
+ $(NT_INC)/sys/stat.h \
+ $(NTLIB_H)
$(BLD)/pop.$(O) : \
- $(SRC)/pop.c \
- $(SRC)/pop.h \
- $(EMACS_ROOT)/lib/min-max.h \
- $(SRC)/ntlib.h
+ $(LIB_SRC)/pop.c \
+ $(LIB_SRC)/pop.h \
+ $(NT_INC)/netdb.h \
+ $(NT_INC)/pwd.h \
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/min-max.h \
+ $(CONFIG_H) \
+ $(NTLIB_H)
$(BLD)/profile.$(O) : \
- $(SRC)/profile.c \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h \
- $(EMACS_ROOT)/lib-src/../src/systime.h
-
-$(BLD)/qsort.$(O) : \
- $(SRC)/qsort.c
-
-$(BLD)/tcp.$(O) : \
- $(SRC)/tcp.c
+ $(LIB_SRC)/profile.c \
+ $(GNU_LIB)/intprops.h \
+ $(CONFIG_H) \
+ $(INTTYPES_H) \
+ $(SYSTIME_H)
+
+$(BLD)/regex.$(O) : \
+ $(SRC)/regex.c \
+ $(SRC)/regex.h \
+ $(NT_INC)/stdbool.h \
+ $(NT_INC)/unistd.h \
+ $(CONFIG_H)
$(BLD)/test-distrib.$(O) : \
- $(SRC)/test-distrib.c
-
-$(BLD)/timer.$(O) : \
- $(SRC)/timer.c \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h
+ $(LIB_SRC)/test-distrib.c \
+ $(NT_INC)/unistd.h \
+ $(CONFIG_H)
# The following dependencies are for supporting parallel builds, where
# we must make sure $(BLD) exists before any compilation starts.
@@ -472,4 +473,4 @@ $(BLD)/test-distrib.$(O) $(MOVEMAILOBJS): stamp_BLD
$(BLD)/emacsclient.$(O) $(BLD)/etags.$(O) $(BLD)/regex.$(O): stamp_BLD
-$(BLD)/ebrowse.$(O) $(BLD)/ctags.$(O): stamp_BLD
+$(BLD)/ebrowse.$(O) $(BLD)/ctags.$(O) $(BLD)/profile.$(O): stamp_BLD
diff --git a/lib-src/movemail.c b/lib-src/movemail.c
index b6ea51f6341..264b3d292c6 100644
--- a/lib-src/movemail.c
+++ b/lib-src/movemail.c
@@ -1,7 +1,7 @@
/* movemail foo bar -- move file foo to file bar,
locking file foo the way /bin/mail respects.
-Copyright (C) 1986, 1992-1994, 1996, 1999, 2001-2011
+Copyright (C) 1986, 1992-1994, 1996, 1999, 2001-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -22,7 +22,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Important notice: defining MAIL_USE_FLOCK or MAIL_USE_LOCKF *will
cause loss of mail* if you do it on a system that does not normally
- use flock as its way of interlocking access to inbox files. The
+ use flock/lockf as its way of interlocking access to inbox files. The
setting of MAIL_USE_FLOCK and MAIL_USE_LOCKF *must agree* with the
system's own conventions. It is not a choice that is up to you.
@@ -65,9 +65,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <getopt.h>
#include <unistd.h>
-#ifdef HAVE_FCNTL_H
#include <fcntl.h>
-#endif
#include <string.h>
#include "syswait.h"
#ifdef MAIL_USE_POP
@@ -98,17 +96,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <fcntl.h>
#endif /* WINDOWSNT */
-#ifndef F_OK
-#define F_OK 0
-#define X_OK 1
-#define W_OK 2
-#define R_OK 4
-#endif
-
#ifdef WINDOWSNT
#include <sys/locking.h>
#endif
+/* If your system uses the `flock' or `lockf' system call for mail locking,
+ define MAIL_USE_SYSTEM_LOCK. If your system type should always define
+ MAIL_USE_LOCKF or MAIL_USE_FLOCK but configure does not do this,
+ please make a bug report. */
+
#ifdef MAIL_USE_LOCKF
#define MAIL_USE_SYSTEM_LOCK
#endif
@@ -133,16 +129,10 @@ static char *mail_spool_name (char *);
#endif
#endif
-#ifndef HAVE_STRERROR
-char *strerror (int);
-#endif
-
-static void fatal (const char *s1, const char *s2, const char *s3) NO_RETURN;
+static _Noreturn void fatal (const char *s1, const char *s2, const char *s3);
static void error (const char *s1, const char *s2, const char *s3);
-static void pfatal_with_name (char *name) NO_RETURN;
-static void pfatal_and_delete (char *name) NO_RETURN;
-static char *concat (const char *s1, const char *s2, const char *s3);
-static long *xmalloc (unsigned int size);
+static _Noreturn void pfatal_with_name (char *name);
+static _Noreturn void pfatal_and_delete (char *name);
#ifdef MAIL_USE_POP
static int popmail (char *mailbox, char *outfile, int preserve, char *password, int reverse_order);
static int pop_retr (popserver server, int msgno, FILE *arg);
@@ -151,6 +141,21 @@ static int mbx_delimit_begin (FILE *mbf);
static int mbx_delimit_end (FILE *mbf);
#endif
+#if (defined MAIL_USE_MAILLOCK \
+ || (!defined DISABLE_DIRECT_ACCESS && !defined MAIL_USE_MMDF \
+ && !defined MAIL_USE_SYSTEM_LOCK))
+/* Like malloc but get fatal error if memory is exhausted. */
+
+static void *
+xmalloc (size_t size)
+{
+ void *result = malloc (size);
+ if (!result)
+ fatal ("virtual memory exhausted", 0, 0);
+ return result;
+}
+#endif
+
/* Nonzero means this is name of a lock file to delete on fatal error. */
static char *delete_lockname;
@@ -168,7 +173,7 @@ main (int argc, char **argv)
int tem;
char *lockname;
char *tempname;
- size_t inname_dirlen;
+ size_t inname_len, inname_dirlen;
int desc;
#endif /* not MAIL_USE_SYSTEM_LOCK */
@@ -266,13 +271,6 @@ main (int argc, char **argv)
else
#endif
{
- #ifndef DIRECTORY_SEP
- #define DIRECTORY_SEP '/'
- #endif
- #ifndef IS_DIRECTORY_SEP
- #define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP)
- #endif
-
/* Use a lock file named after our first argument with .lock appended:
If it exists, the mail file is locked. */
/* Note: this locking mechanism is *required* by the mailer
@@ -281,27 +279,23 @@ main (int argc, char **argv)
On systems that use a lock file, extracting the mail without locking
WILL occasionally cause loss of mail due to timing errors!
- So, if creation of the lock file fails
- due to access permission on the mail spool directory,
- you simply MUST change the permission
- and/or make movemail a setgid program
+ So, if creation of the lock file fails due to access
+ permission on the mail spool directory, you simply MUST
+ change the permission and/or make movemail a setgid program
so it can create lock files properly.
- You might also wish to verify that your system is one
- which uses lock files for this purpose. Some systems use other methods.
+ You might also wish to verify that your system is one which
+ uses lock files for this purpose. Some systems use other methods. */
- If your system uses the `flock' system call for mail locking,
- define MAIL_USE_SYSTEM_LOCK in config.h or the s-*.h file
- and recompile movemail. If the s- file for your system
- should define MAIL_USE_SYSTEM_LOCK but does not, send a bug report
- to bug-gnu-emacs@prep.ai.mit.edu so we can fix it. */
-
- lockname = concat (inname, ".lock", "");
- for (inname_dirlen = strlen (inname);
+ inname_len = strlen (inname);
+ lockname = xmalloc (inname_len + sizeof ".lock");
+ strcpy (lockname, inname);
+ strcpy (lockname + inname_len, ".lock");
+ for (inname_dirlen = inname_len;
inname_dirlen && !IS_DIRECTORY_SEP (inname[inname_dirlen - 1]);
inname_dirlen--)
continue;
- tempname = (char *) xmalloc (inname_dirlen + sizeof "EXXXXXX");
+ tempname = xmalloc (inname_dirlen + sizeof "EXXXXXX");
while (1)
{
@@ -334,11 +328,8 @@ main (int argc, char **argv)
tem = link (tempname, lockname);
-#ifdef EPERM
- if (tem < 0 && errno == EPERM)
- fatal ("Unable to create hard link between %s and %s",
- tempname, lockname);
-#endif
+ if (tem < 0 && errno != EEXIST)
+ pfatal_with_name (lockname);
unlink (tempname);
if (tem >= 0)
@@ -548,8 +539,8 @@ main (int argc, char **argv)
wait (&wait_status);
if (!WIFEXITED (wait_status))
exit (EXIT_FAILURE);
- else if (WRETCODE (wait_status) != 0)
- exit (WRETCODE (wait_status));
+ else if (WEXITSTATUS (wait_status) != 0)
+ exit (WEXITSTATUS (wait_status));
#if !defined (MAIL_USE_MMDF) && !defined (MAIL_USE_SYSTEM_LOCK)
#ifdef MAIL_USE_MAILLOCK
@@ -583,8 +574,8 @@ mail_spool_name (char *inname)
if (stat (MAILDIR, &stat1) < 0)
return NULL;
- indir = (char *) xmalloc (fname - inname + 1);
- strncpy (indir, inname, fname - inname);
+ indir = xmalloc (fname - inname + 1);
+ memcpy (indir, inname, fname - inname);
indir[fname-inname] = '\0';
@@ -643,33 +634,6 @@ pfatal_and_delete (char *name)
unlink (name);
fatal ("%s for %s", s, name);
}
-
-/* Return a newly-allocated string whose contents concatenate those of s1, s2, s3. */
-
-static char *
-concat (const char *s1, const char *s2, const char *s3)
-{
- size_t len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3);
- char *result = (char *) xmalloc (len1 + len2 + len3 + 1);
-
- strcpy (result, s1);
- strcpy (result + len1, s2);
- strcpy (result + len1 + len2, s3);
- *(result + len1 + len2 + len3) = 0;
-
- return result;
-}
-
-/* Like malloc but get fatal error if memory is exhausted. */
-
-static long *
-xmalloc (unsigned int size)
-{
- long *result = (long *) malloc (size);
- if (!result)
- fatal ("virtual memory exhausted", 0, 0);
- return result;
-}
/* This is the guts of the interface to the Post Office Protocol. */
@@ -851,10 +815,7 @@ pop_retr (popserver server, int msgno, FILE *arg)
if (pop_retrieve_first (server, msgno, &line))
{
- char *msg = concat ("Error from POP server: ", pop_error, "");
- strncpy (Errmsg, msg, sizeof (Errmsg));
- Errmsg[sizeof (Errmsg)-1] = '\0';
- free (msg);
+ snprintf (Errmsg, sizeof Errmsg, "Error from POP server: %s", pop_error);
return (NOTOK);
}
@@ -873,10 +834,7 @@ pop_retr (popserver server, int msgno, FILE *arg)
if (ret)
{
- char *msg = concat ("Error from POP server: ", pop_error, "");
- strncpy (Errmsg, msg, sizeof (Errmsg));
- Errmsg[sizeof (Errmsg)-1] = '\0';
- free (msg);
+ snprintf (Errmsg, sizeof Errmsg, "Error from POP server: %s", pop_error);
return (NOTOK);
}
@@ -939,21 +897,3 @@ mbx_delimit_end (FILE *mbf)
}
#endif /* MAIL_USE_POP */
-
-#ifndef HAVE_STRERROR
-char *
-strerror (errnum)
- int errnum;
-{
- extern char *sys_errlist[];
- extern int sys_nerr;
-
- if (errnum >= 0 && errnum < sys_nerr)
- return sys_errlist[errnum];
- return (char *) "Unknown error";
-}
-
-#endif /* ! HAVE_STRERROR */
-
-
-/* movemail.c ends here */
diff --git a/lib-src/ntlib.c b/lib-src/ntlib.c
index 83f653f3ea3..4e125eb6d73 100644
--- a/lib-src/ntlib.c
+++ b/lib-src/ntlib.c
@@ -1,5 +1,9 @@
/* Utility and Unix shadow routines for GNU Emacs support programs on NT.
- Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+
+Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
+
+Author: Geoff Voelker (voelker@cs.washington.edu)
+Created: 10-8-94
This file is part of GNU Emacs.
@@ -14,11 +18,7 @@ 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/>.
-
-
- Geoff Voelker (voelker@cs.washington.edu) 10-8-94
-*/
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <windows.h>
#include <stdlib.h>
@@ -29,9 +29,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
#include <sys/stat.h>
#include <errno.h>
#include <ctype.h>
+#include <sys/timeb.h>
+#include <mbstring.h>
#include "ntlib.h"
+struct timezone
+{
+ int tz_minuteswest; /* minutes west of Greenwich */
+ int tz_dsttime; /* type of dst correction */
+};
+
#define MAXPATHLEN _MAX_PATH
/* Emulate sleep...we could have done this with a define, but that
@@ -202,6 +210,29 @@ getpass (const char * prompt)
return NULL;
}
+/* This is needed because lib/gettime.c calls gettimeofday, which MSVC
+ doesn't have. Copied from w32.c. */
+void
+gettimeofday (struct timeval *tv, struct timezone *tz)
+{
+ struct _timeb tb;
+ _ftime (&tb);
+
+ tv->tv_sec = tb.time;
+ tv->tv_usec = tb.millitm * 1000L;
+ /* Implementation note: _ftime sometimes doesn't update the dstflag
+ according to the new timezone when the system timezone is
+ changed. We could fix that by using GetSystemTime and
+ GetTimeZoneInformation, but that doesn't seem necessary, since
+ Emacs always calls gettimeofday with the 2nd argument NULL (see
+ current_emacs_time). */
+ if (tz)
+ {
+ tz->tz_minuteswest = tb.timezone; /* minutes west of Greenwich */
+ tz->tz_dsttime = tb.dstflag; /* type of dst correction */
+ }
+}
+
int
fchown (int fd, unsigned uid, unsigned gid)
{
@@ -260,6 +291,7 @@ is_exec (const char * name)
stricmp (p, ".cmd") == 0));
}
+/* FIXME? This is in config.nt now - is this still needed? */
#define IS_DIRECTORY_SEP(x) ((x) == '/' || (x) == '\\')
/* We need this because nt/inc/sys/stat.h defines struct stat that is
@@ -374,3 +406,9 @@ stat (const char * path, struct stat * buf)
return 0;
}
+int
+lstat (const char * path, struct stat * buf)
+{
+ return stat (path, buf);
+}
+
diff --git a/lib-src/ntlib.h b/lib-src/ntlib.h
index be8d2a58a50..7502a8a8b34 100644
--- a/lib-src/ntlib.h
+++ b/lib-src/ntlib.h
@@ -1,5 +1,5 @@
/* Utility and Unix shadow routines for GNU Emacs support programs on NT.
- Copyright (C) 1994, 2002-2011 Free Software Foundation, Inc.
+ Copyright (C) 1994, 2002-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lib-src/pop.c b/lib-src/pop.c
index ae1000742cc..bfbcb8c9466 100644
--- a/lib-src/pop.c
+++ b/lib-src/pop.c
@@ -1,6 +1,6 @@
/* pop.c: client routines for talking to a POP3-protocol post-office server
-Copyright (C) 1991, 1993, 1996-1997, 1999, 2001-2011
+Copyright (C) 1991, 1993, 1996-1997, 1999, 2001-2012
Free Software Foundation, Inc.
Author: Jonathan Kamens <jik@security.ov.com>
@@ -21,11 +21,7 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#else
-#define MAIL_USE_POP
-#endif
#ifdef MAIL_USE_POP
@@ -101,7 +97,7 @@ extern char *krb_realmofhost (/* char * */);
#endif /* KERBEROS */
#ifndef WINDOWSNT
-#if !defined (HAVE_H_ERRNO) || !defined (HAVE_CONFIG_H)
+#ifndef HAVE_H_ERRNO
extern int h_errno;
#endif
#endif
@@ -344,9 +340,7 @@ pop_stat (popserver server, int *count, int *size)
if (strncmp (fromserver, "+OK ", 4))
{
if (0 == strncmp (fromserver, "-ERR", 4))
- {
- strncpy (pop_error, fromserver, ERROR_MAX);
- }
+ snprintf (pop_error, ERROR_MAX, "%s", fromserver);
else
{
strcpy (pop_error,
@@ -447,7 +441,7 @@ pop_list (popserver server, int message, int **IDs, int **sizes)
if (strncmp (fromserver, "+OK ", 4))
{
if (! strncmp (fromserver, "-ERR", 4))
- strncpy (pop_error, fromserver, ERROR_MAX);
+ snprintf (pop_error, ERROR_MAX, "%s", fromserver);
else
{
strcpy (pop_error,
@@ -686,7 +680,7 @@ pop_multi_first (popserver server, const char *command, char **response)
if (0 == strncmp (*response, "-ERR", 4))
{
- strncpy (pop_error, *response, ERROR_MAX);
+ snprintf (pop_error, ERROR_MAX, "%s", *response);
return (-1);
}
else if (0 == strncmp (*response, "+OK", 3))
@@ -859,7 +853,7 @@ pop_last (popserver server)
if (! strncmp (fromserver, "-ERR", 4))
{
- strncpy (pop_error, fromserver, ERROR_MAX);
+ snprintf (pop_error, ERROR_MAX, "%s", fromserver);
return (-1);
}
else if (strncmp (fromserver, "+OK ", 4))
@@ -1059,9 +1053,8 @@ socket_connection (char *host, int flags)
sock = socket (PF_INET, SOCK_STREAM, 0);
if (sock < 0)
{
- strcpy (pop_error, POP_SOCKET_ERROR);
- strncat (pop_error, strerror (errno),
- ERROR_MAX - sizeof (POP_SOCKET_ERROR));
+ snprintf (pop_error, ERROR_MAX, "%s%s",
+ POP_SOCKET_ERROR, strerror (errno));
return (-1);
}
@@ -1090,7 +1083,7 @@ socket_connection (char *host, int flags)
if (it->ai_addrlen == sizeof (addr))
{
struct sockaddr_in *in_a = (struct sockaddr_in *) it->ai_addr;
- memcpy (&addr.sin_addr, &in_a->sin_addr, sizeof (addr.sin_addr));
+ addr.sin_addr = in_a->sin_addr;
if (! connect (sock, (struct sockaddr *) &addr, sizeof (addr)))
break;
}
@@ -1137,9 +1130,7 @@ socket_connection (char *host, int flags)
if (! connect_ok)
{
CLOSESOCKET (sock);
- strcpy (pop_error, CONNECT_ERROR);
- strncat (pop_error, strerror (errno),
- ERROR_MAX - sizeof (CONNECT_ERROR));
+ snprintf (pop_error, ERROR_MAX, "%s%s", CONNECT_ERROR, strerror (errno));
return (-1);
}
@@ -1157,9 +1148,8 @@ socket_connection (char *host, int flags)
krb5_auth_con_free (kcontext, auth_context);
if (kcontext)
krb5_free_context (kcontext);
- strcpy (pop_error, KRB_ERROR);
- strncat (pop_error, error_message (rem),
- ERROR_MAX - sizeof (KRB_ERROR));
+ snprintf (pop_error, ERROR_MAX, "%s%s",
+ KRB_ERROR, error_message (rem));
CLOSESOCKET (sock);
return (-1);
}
@@ -1197,30 +1187,19 @@ socket_connection (char *host, int flags)
krb5_free_principal (kcontext, server);
if (rem)
{
- strcpy (pop_error, KRB_ERROR);
- strncat (pop_error, error_message (rem),
- ERROR_MAX - sizeof (KRB_ERROR));
+ int pop_error_len = snprintf (pop_error, ERROR_MAX, "%s%s",
+ KRB_ERROR, error_message (rem));
#if defined HAVE_KRB5_ERROR_TEXT
if (err_ret && err_ret->text.length)
{
- strncat (pop_error, " [server says '",
- ERROR_MAX - strlen (pop_error) - 1);
- strncat (pop_error, err_ret->text.data,
- min (ERROR_MAX - strlen (pop_error) - 1,
- err_ret->text.length));
- strncat (pop_error, "']",
- ERROR_MAX - strlen (pop_error) - 1);
+ int errlen = err_ret->text.length;
+ snprintf (pop_error + pop_error_len, ERROR_MAX - pop_error_len,
+ " [server says '.*%s']", errlen, err_ret->text.data);
}
#elif defined HAVE_KRB5_ERROR_E_TEXT
- if (err_ret && err_ret->e_text && strlen (*err_ret->e_text))
- {
- strncat (pop_error, " [server says '",
- ERROR_MAX - strlen (pop_error) - 1);
- strncat (pop_error, *err_ret->e_text,
- ERROR_MAX - strlen (pop_error) - 1);
- strncat (pop_error, "']",
- ERROR_MAX - strlen (pop_error) - 1);
- }
+ if (err_ret && err_ret->e_text && **err_ret->e_text)
+ snprintf (pop_error + pop_error_len, ERRMAX - pop_error_len,
+ " [server says '%s']", *err_ret->e_text);
#endif
if (err_ret)
krb5_free_error (kcontext, err_ret);
@@ -1241,9 +1220,7 @@ socket_connection (char *host, int flags)
free ((char *) ticket);
if (rem != KSUCCESS)
{
- strcpy (pop_error, KRB_ERROR);
- strncat (pop_error, krb_err_txt[rem],
- ERROR_MAX - sizeof (KRB_ERROR));
+ snprintf (pop_error, ERROR_MAX, "%s%s", KRB_ERROR, krb_err_txt[rem]);
CLOSESOCKET (sock);
return (-1);
}
@@ -1348,9 +1325,8 @@ pop_getline (popserver server, char **line)
server->buffer_size - server->data - 1, 0);
if (ret < 0)
{
- strcpy (pop_error, GETLINE_ERROR);
- strncat (pop_error, strerror (errno),
- ERROR_MAX - sizeof (GETLINE_ERROR));
+ snprintf (pop_error, ERROR_MAX, "%s%s",
+ GETLINE_ERROR, strerror (errno));
pop_trash (server);
return (-1);
}
@@ -1434,9 +1410,7 @@ sendline (popserver server, const char *line)
if (ret < 0)
{
pop_trash (server);
- strcpy (pop_error, SENDLINE_ERROR);
- strncat (pop_error, strerror (errno),
- ERROR_MAX - sizeof (SENDLINE_ERROR));
+ snprintf (pop_error, ERROR_MAX, "%s%s", SENDLINE_ERROR, strerror (errno));
return (ret);
}
@@ -1498,8 +1472,7 @@ getok (popserver server)
return (0);
else if (! strncmp (fromline, "-ERR", 4))
{
- strncpy (pop_error, fromline, ERROR_MAX);
- pop_error[ERROR_MAX-1] = '\0';
+ snprintf (pop_error, ERROR_MAX, "%s", fromline);
return (-1);
}
else
diff --git a/lib-src/pop.h b/lib-src/pop.h
index bc079fcc971..682a7f93dc5 100644
--- a/lib-src/pop.h
+++ b/lib-src/pop.h
@@ -1,5 +1,5 @@
/* pop.h: Header file for the "pop.c" client POP3 protocol.
- Copyright (C) 1991, 1993, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1991, 1993, 2001-2012 Free Software Foundation, Inc.
Author: Jonathan Kamens <jik@security.ov.com>
diff --git a/lib-src/profile.c b/lib-src/profile.c
index 086d8cc3e9d..3489e492543 100644
--- a/lib-src/profile.c
+++ b/lib-src/profile.c
@@ -1,5 +1,5 @@
/* profile.c --- generate periodic events for profiling of Emacs Lisp code.
- Copyright (C) 1992, 1994, 1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1992, 1994, 1999, 2001-2012 Free Software Foundation, Inc.
Author: Boaz Ben-Zvi <boaz@lcs.mit.edu>
@@ -20,7 +20,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/**
- ** To be run as an emacs process. Input string that starts with:
+ ** To be run as an emacs subprocess. Input string that starts with:
** 'z' -- resets the watch (to zero).
** 'p' -- return time (on stdout) as string with format <sec>.<micro-sec>
** 'q' -- exit.
@@ -29,53 +29,44 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
** operations: reset_watch, get_time
*/
#include <config.h>
+
+#define SYSTIME_INLINE EXTERN_INLINE
+
+#include <inttypes.h>
#include <stdio.h>
+
+#include <intprops.h>
#include <systime.h>
-static EMACS_TIME TV1, TV2;
+static EMACS_TIME TV1;
static int watch_not_started = 1; /* flag */
-static char time_string[30];
+static char time_string[INT_STRLEN_BOUND (uintmax_t) + sizeof "."
+ + LOG10_EMACS_TIME_RESOLUTION];
/* Reset the stopwatch to zero. */
static void
reset_watch (void)
{
- EMACS_GET_TIME (TV1);
+ TV1 = current_emacs_time ();
watch_not_started = 0;
}
/* This call returns the time since the last reset_watch call. The time
- is returned as a string with the format <seconds>.<micro-seconds>
+ is returned as a string with the format <seconds>.<nanoseconds>
If reset_watch was not called yet, exit. */
static char *
get_time (void)
{
+ EMACS_TIME TV2 = sub_emacs_time (current_emacs_time (), TV1);
+ uintmax_t s = EMACS_SECS (TV2);
+ int ns = EMACS_NSECS (TV2);
if (watch_not_started)
exit (EXIT_FAILURE); /* call reset_watch first ! */
- EMACS_GET_TIME (TV2);
- EMACS_SUB_TIME (TV2, TV2, TV1);
- sprintf (time_string, "%lu.%06lu", (unsigned long)EMACS_SECS (TV2), (unsigned long)EMACS_USECS (TV2));
+ sprintf (time_string, "%"PRIuMAX".%0*d", s, LOG10_EMACS_TIME_RESOLUTION, ns);
return time_string;
}
-
-#if ! defined (HAVE_GETTIMEOFDAY) && defined (HAVE_TIMEVAL)
-
-/* ARGSUSED */
-gettimeofday (tp, tzp)
- struct timeval *tp;
- struct timezone *tzp;
-{
- extern long time ();
-
- tp->tv_sec = time ((long *)0);
- tp->tv_usec = 0;
- if (tzp != 0)
- tzp->tz_minuteswest = -1;
-}
-
-#endif
int
main (void)
diff --git a/lib-src/rcs-checkin b/lib-src/rcs-checkin
deleted file mode 100755
index 6861a30b40b..00000000000
--- a/lib-src/rcs-checkin
+++ /dev/null
@@ -1,116 +0,0 @@
-#! /bin/sh
-
-# This script accepts any number of file arguments and checks them into RCS.
-
-# Copyright (C) 1993-1995, 2001-2011 Free Software Foundation, Inc.
-
-# 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/>.
-
-
-# Arguments which are detectably either RCS masters (with names ending in ,v)
-# or Emacs version files (with names of the form foo.~<number>~) are ignored.
-# For each file foo, the script looks for Emacs version files related to it.
-# These files are checked in as deltas, oldest first, so that the contents of
-# the file itself becomes the latest revision in the master.
-#
-# The first line of each file is used as its description text. The file itself
-# is not deleted, as under VC with vc-keep-workfiles at its default of t, but
-# all the version files are.
-#
-# If an argument file is already version-controlled under RCS, any version
-# files are added to the list of deltas and deleted, and then the workfile
-# is checked in again as the latest version. This is probably not quite
-# what was wanted, and is the main reason VC doesn't simply call this to
-# do checkins.
-#
-# This script is intended to be used to convert files with an old-Emacs-style
-# version history for use with VC (the Emacs 19 version-control interface),
-# which likes to use RCS as its back end. It was written by Paul Eggert
-# and revised/documented for use with VC by Eric S. Raymond, Mar 19 1993.
-
-case $# in
-0)
- echo "rcs-checkin: usage: rcs-checkin file ..."
- echo "rcs-checkin: function: checks file.~*~ and file into a new RCS file"
- echo "rcs-checkin: function: uses the file's first line for the description"
-esac
-
-# expr pattern to extract owner from ls -l output
-ls_owner_pattern='[^ ][^ ]* *[^ ][^ ]* *\([^ ][^ ]*\)'
-
-for file
-do
- # Make it easier to say `rcs-checkin *'
- # by ignoring file names that already contain `~', or end in `,v'.
- case $file in
- *~* | *,v) continue
- esac
- # Ignore non-files too.
- test -f "$file" || continue
-
- # Check that file is readable.
- test -r "$file" || exit
-
- # If the RCS file does not already exist,
- # initialize it with a description from $file's first line.
- rlog -R "$file" >/dev/null 2>&1 ||
- rcs -i -q -t-"`sed 1q $file`" "$file" || exit
-
- # Get list of old files.
- oldfiles=`
- ls $file.~[0-9]*~ 2>/dev/null |
- sort -t~ -n -k 2
- `
-
- # Check that they are properly sorted by date.
- case $oldfiles in
- ?*)
- oldfiles_by_date=`ls -rt $file $oldfiles`
- test " $oldfiles
-$file" = " $oldfiles_by_date" || {
- echo >&2 "rcs-checkin: skipping $file, because its mod times are out of order.
-
-Sorted by mod time:
-$oldfiles_by_date
-
-Sorted by name:
-$oldfiles
-$file"
- continue
- }
- esac
-
- echo >&2 rcs-checkin: checking in: $oldfiles $file
-
- # Save $file as $file.~-~ temporarily.
- mv "$file" "$file.~-~" || exit
-
- # Rename each old file to $file, and check it in.
- for oldfile in $oldfiles
- do
- mv "$oldfile" "$file" || exit
- ls_l=`ls -l "$file"` || exit
- owner=-w`expr " $ls_l" : " $ls_owner_pattern"` || owner=
- echo "Formerly ${oldfile}" | ci -d -l -q $owner "$file" || exit
- done
-
- # Bring $file back from $file.~-~, and check it in.
- mv "$file.~-~" "$file" || exit
- ls_l=`ls -l "$file"` || exit
- owner=-w`expr " $ls_l" : " $ls_owner_pattern"` || owner=
- ci -d -q -u $owner -m"entered into RCS" "$file" || exit
-done
-
diff --git a/lib-src/rcs2log b/lib-src/rcs2log
index 4e1dd306977..3ed54684a7e 100755
--- a/lib-src/rcs2log
+++ b/lib-src/rcs2log
@@ -2,7 +2,7 @@
# RCS to ChangeLog generator
-# Copyright (C) 1992-1998, 2001-2011 Free Software Foundation, Inc.
+# Copyright (C) 1992-1998, 2001-2012 Free Software Foundation, Inc.
# Author: Paul Eggert <eggert@twinsun.com>
@@ -20,7 +20,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
-Copyright='Copyright (C) 2011 Free Software Foundation, Inc.
+Copyright='Copyright (C) 2012 Free Software Foundation, Inc.
This program comes with NO WARRANTY, to the extent permitted by law.
You may redistribute copies of this program
under the terms of the GNU General Public License.
diff --git a/lib-src/test-distrib.c b/lib-src/test-distrib.c
index 5ad19201118..b404c8230d1 100644
--- a/lib-src/test-distrib.c
+++ b/lib-src/test-distrib.c
@@ -1,6 +1,6 @@
/* test-distrib.c --- testing distribution of nonprinting chars
-Copyright (C) 1987, 1993-1995, 1999, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1987, 1993-1995, 1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lib-src/update-game-score.c b/lib-src/update-game-score.c
index e335617df4d..59cab61aa29 100644
--- a/lib-src/update-game-score.c
+++ b/lib-src/update-game-score.c
@@ -1,6 +1,6 @@
/* update-game-score.c --- Update a score file
-Copyright (C) 2002-2011 Free Software Foundation, Inc.
+Copyright (C) 2002-2012 Free Software Foundation, Inc.
Author: Colin Walters <walters@debian.org>
@@ -42,16 +42,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <time.h>
#include <pwd.h>
#include <ctype.h>
-#ifdef HAVE_FCNTL_H
#include <fcntl.h>
-#endif
#include <sys/stat.h>
-
-/* Needed for SunOS4, for instance. */
-extern char *optarg;
-extern int optind, opterr;
-
-static int usage (int err) NO_RETURN;
+#include <getopt.h>
#define MAX_ATTEMPTS 5
#define MAX_SCORES 200
@@ -62,7 +55,7 @@ static int usage (int err) NO_RETURN;
#define difftime(t1, t0) (double)((t1) - (t0))
#endif
-static int
+static _Noreturn void
usage (int err)
{
fprintf (stdout, "Usage: update-game-score [-m MAX] [-r] [-d DIR] game/scorefile SCORE DATA\n");
@@ -92,34 +85,14 @@ static void sort_scores (struct score_entry *scores, int count, int reverse);
static int write_scores (const char *filename,
const struct score_entry *scores, int count);
-static void lose (const char *msg) NO_RETURN;
-
-static void
+static _Noreturn void
lose (const char *msg)
{
fprintf (stderr, "%s\n", msg);
exit (EXIT_FAILURE);
}
-static void lose_syserr (const char *msg) NO_RETURN;
-
-/* Taken from sysdep.c. */
-#ifndef HAVE_STRERROR
-#ifndef WINDOWSNT
-char *
-strerror (int errnum)
-{
- extern char *sys_errlist[];
- extern int sys_nerr;
-
- if (errnum >= 0 && errnum < sys_nerr)
- return sys_errlist[errnum];
- return (char *) "Unknown error";
-}
-#endif /* not WINDOWSNT */
-#endif /* ! HAVE_STRERROR */
-
-static void
+static _Noreturn void
lose_syserr (const char *msg)
{
fprintf (stderr, "%s: %s\n", msg, strerror (errno));
diff --git a/lib-src/vcdiff b/lib-src/vcdiff
deleted file mode 100755
index 0f975cd0ee3..00000000000
--- a/lib-src/vcdiff
+++ /dev/null
@@ -1,114 +0,0 @@
-#! /bin/sh
-
-# Enhanced sccs diff utility for use with vc mode.
-# This version is more compatible with rcsdiff(1).
-
-# Copyright (C) 1992-1993, 1995, 1997, 2001-2011
-# Free Software Foundation, Inc.
-
-# Author: Paul Eggert
-# (according to authors.el)
-
-# 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/>.
-
-
-DIFF="diff"
-usage="$0: Usage: vcdiff [--brief] [-q] [-r<sid1>] [-r<sid2>] [diffopts] sccsfile..."
-
-# Now that we use `sccs get' rather than just `get', we don't need this.
-# PATH=$PATH:/usr/ccs/bin:/usr/sccs:/usr/xpg4/bin # common SCCS hangouts
-
-echo="echo"
-sid1= sid2=
-
-for f
-do
- case $f in
- -*)
- case $f in
- --brief)
- DIFF=cmp;;
- -q)
- echo=:;;
- -r?*)
- case $sid1 in
- '')
- sid1=$f
- ;;
- *)
- case $sid2 in
- ?*) echo "$usage" >&2; exit 2 ;;
- esac
- sid2=$f
- ;;
- esac
- ;;
- *)
- options="$options $f"
- ;;
- esac
- shift
- ;;
- *)
- break
- ;;
- esac
-done
-
-case $# in
-0)
- echo "$usage" >&2
- exit 2
-esac
-
-
-rev1= rev2= status=0
-trap 'status=2; exit' 1 2 13 15
-trap 'rm -f $rev1 $rev2 || status=2; exit $status' 0
-
-for f
-do
- s=2
-
- case $f in
- s.* | */s.*)
- if
- rev1=`mktemp /tmp/geta.XXXXXXXX`
- sccs get -s -p -k $sid1 "$f" > $rev1 &&
- case $sid2 in
- '')
- workfile=`expr " /$f" : '.*/s.\(.*\)'`
- ;;
- *)
- rev2=`mktemp /tmp/getb.XXXXXXXX`
- sccs get -s -p -k $sid2 "$f" > $rev2
- workfile=$rev2
- esac
- then
- $echo $DIFF $options $rev1 $workfile >&2
- $DIFF $options $rev1 $workfile
- s=$?
- fi
- ;;
- *)
- echo "$0: $f is not an SCCS file" >&2
- esac
-
- if test $status -lt $s
- then status=$s
- fi
-done
-
diff --git a/lib/Makefile.am b/lib/Makefile.am
index 220ba713d4e..28fdafd4b45 100644
--- a/lib/Makefile.am
+++ b/lib/Makefile.am
@@ -4,6 +4,7 @@ MOSTLYCLEANDIRS =
MOSTLYCLEANFILES =
noinst_LIBRARIES =
-DEFAULT_INCLUDES = -I. -I../src -I$(top_srcdir)/src
+AM_CFLAGS = $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS)
+DEFAULT_INCLUDES = -I. -I$(top_srcdir)/lib -I../src -I$(top_srcdir)/src
include gnulib.mk
diff --git a/lib/alloca.in.h b/lib/alloca.in.h
index 5b69c6c81a8..d20f4b8f1c3 100644
--- a/lib/alloca.in.h
+++ b/lib/alloca.in.h
@@ -1,6 +1,6 @@
/* Memory allocation on the stack.
- Copyright (C) 1995, 1999, 2001-2004, 2006-2011 Free Software Foundation,
+ Copyright (C) 1995, 1999, 2001-2004, 2006-2012 Free Software Foundation,
Inc.
This program is free software; you can redistribute it and/or modify it
@@ -14,9 +14,9 @@
General Public License for more details.
You should have received a copy of the GNU General Public
- License along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
- USA. */
+ License along with this program; if not, see
+ <http://www.gnu.org/licenses/>.
+ */
/* Avoid using the symbol _ALLOCA_H here, as Bison assumes _ALLOCA_H
means there is a real alloca function. */
@@ -44,6 +44,13 @@
# define alloca _alloca
# elif defined __DECC && defined __VMS
# define alloca __ALLOCA
+# elif defined __TANDEM && defined _TNS_E_TARGET
+# ifdef __cplusplus
+extern "C"
+# endif
+void *_alloca (unsigned short);
+# pragma intrinsic (_alloca)
+# define alloca _alloca
# else
# include <stddef.h>
# ifdef __cplusplus
diff --git a/lib/allocator.h b/lib/allocator.h
index b8de95c0f50..81c4aa20a45 100644
--- a/lib/allocator.h
+++ b/lib/allocator.h
@@ -1,6 +1,6 @@
/* Memory allocators such as malloc+free.
- Copyright (C) 2011 Free Software Foundation, Inc.
+ Copyright (C) 2011-2012 Free Software Foundation, Inc.
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
diff --git a/lib/at-func.c b/lib/at-func.c
new file mode 100644
index 00000000000..481eea475a1
--- /dev/null
+++ b/lib/at-func.c
@@ -0,0 +1,146 @@
+/* Define at-style functions like fstatat, unlinkat, fchownat, etc.
+ Copyright (C) 2006, 2009-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* written by Jim Meyering */
+
+#include "dosname.h" /* solely for definition of IS_ABSOLUTE_FILE_NAME */
+
+#ifdef GNULIB_SUPPORT_ONLY_AT_FDCWD
+# include <errno.h>
+# ifndef ENOTSUP
+# define ENOTSUP EINVAL
+# endif
+#else
+# include "openat.h"
+# include "openat-priv.h"
+# include "save-cwd.h"
+#endif
+
+#ifdef AT_FUNC_USE_F1_COND
+# define CALL_FUNC(F) \
+ (flag == AT_FUNC_USE_F1_COND \
+ ? AT_FUNC_F1 (F AT_FUNC_POST_FILE_ARGS) \
+ : AT_FUNC_F2 (F AT_FUNC_POST_FILE_ARGS))
+# define VALIDATE_FLAG(F) \
+ if (flag & ~AT_FUNC_USE_F1_COND) \
+ { \
+ errno = EINVAL; \
+ return FUNC_FAIL; \
+ }
+#else
+# define CALL_FUNC(F) (AT_FUNC_F1 (F AT_FUNC_POST_FILE_ARGS))
+# define VALIDATE_FLAG(F) /* empty */
+#endif
+
+#ifdef AT_FUNC_RESULT
+# define FUNC_RESULT AT_FUNC_RESULT
+#else
+# define FUNC_RESULT int
+#endif
+
+#ifdef AT_FUNC_FAIL
+# define FUNC_FAIL AT_FUNC_FAIL
+#else
+# define FUNC_FAIL -1
+#endif
+
+/* Call AT_FUNC_F1 to operate on FILE, which is in the directory
+ open on descriptor FD. If AT_FUNC_USE_F1_COND is defined to a value,
+ AT_FUNC_POST_FILE_PARAM_DECLS must include a parameter named flag;
+ call AT_FUNC_F2 if FLAG is 0 or fail if FLAG contains more bits than
+ AT_FUNC_USE_F1_COND. Return int and fail with -1 unless AT_FUNC_RESULT
+ or AT_FUNC_FAIL are defined. If possible, do it without changing the
+ working directory. Otherwise, resort to using save_cwd/fchdir,
+ then AT_FUNC_F?/restore_cwd. If either the save_cwd or the restore_cwd
+ fails, then give a diagnostic and exit nonzero. */
+FUNC_RESULT
+AT_FUNC_NAME (int fd, char const *file AT_FUNC_POST_FILE_PARAM_DECLS)
+{
+ VALIDATE_FLAG (flag);
+
+ if (fd == AT_FDCWD || IS_ABSOLUTE_FILE_NAME (file))
+ return CALL_FUNC (file);
+
+#ifdef GNULIB_SUPPORT_ONLY_AT_FDCWD
+ errno = ENOTSUP;
+ return FUNC_FAIL;
+#else
+ {
+ /* Be careful to choose names unlikely to conflict with
+ AT_FUNC_POST_FILE_PARAM_DECLS. */
+ struct saved_cwd saved_cwd;
+ int saved_errno;
+ FUNC_RESULT err;
+
+ {
+ char proc_buf[OPENAT_BUFFER_SIZE];
+ char *proc_file = openat_proc_name (proc_buf, fd, file);
+ if (proc_file)
+ {
+ FUNC_RESULT proc_result = CALL_FUNC (proc_file);
+ int proc_errno = errno;
+ if (proc_file != proc_buf)
+ free (proc_file);
+ /* If the syscall succeeds, or if it fails with an unexpected
+ errno value, then return right away. Otherwise, fall through
+ and resort to using save_cwd/restore_cwd. */
+ if (FUNC_FAIL != proc_result)
+ return proc_result;
+ if (! EXPECTED_ERRNO (proc_errno))
+ {
+ errno = proc_errno;
+ return proc_result;
+ }
+ }
+ }
+
+ if (save_cwd (&saved_cwd) != 0)
+ openat_save_fail (errno);
+ if (0 <= fd && fd == saved_cwd.desc)
+ {
+ /* If saving the working directory collides with the user's
+ requested fd, then the user's fd must have been closed to
+ begin with. */
+ free_cwd (&saved_cwd);
+ errno = EBADF;
+ return FUNC_FAIL;
+ }
+
+ if (fchdir (fd) != 0)
+ {
+ saved_errno = errno;
+ free_cwd (&saved_cwd);
+ errno = saved_errno;
+ return FUNC_FAIL;
+ }
+
+ err = CALL_FUNC (file);
+ saved_errno = (err == FUNC_FAIL ? errno : 0);
+
+ if (restore_cwd (&saved_cwd) != 0)
+ openat_restore_fail (errno);
+
+ free_cwd (&saved_cwd);
+
+ if (saved_errno)
+ errno = saved_errno;
+ return err;
+ }
+#endif
+}
+#undef CALL_FUNC
+#undef FUNC_RESULT
+#undef FUNC_FAIL
diff --git a/lib/c-ctype.c b/lib/c-ctype.c
new file mode 100644
index 00000000000..952d7a851f3
--- /dev/null
+++ b/lib/c-ctype.c
@@ -0,0 +1,395 @@
+/* Character handling in C locale.
+
+ Copyright 2000-2003, 2006, 2009-2012 Free Software Foundation, Inc.
+
+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/>. */
+
+#include <config.h>
+
+/* Specification. */
+#define NO_C_CTYPE_MACROS
+#include "c-ctype.h"
+
+/* The function isascii is not locale dependent. Its use in EBCDIC is
+ questionable. */
+bool
+c_isascii (int c)
+{
+ return (c >= 0x00 && c <= 0x7f);
+}
+
+bool
+c_isalnum (int c)
+{
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+ && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+ return ((c >= '0' && c <= '9')
+ || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z'));
+#else
+ return ((c >= '0' && c <= '9')
+ || (c >= 'A' && c <= 'Z')
+ || (c >= 'a' && c <= 'z'));
+#endif
+#else
+ switch (c)
+ {
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z':
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+ case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+ case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+ case 'y': case 'z':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_isalpha (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+ return ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z');
+#else
+ return ((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z'));
+#endif
+#else
+ switch (c)
+ {
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z':
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+ case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+ case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+ case 'y': case 'z':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_isblank (int c)
+{
+ return (c == ' ' || c == '\t');
+}
+
+bool
+c_iscntrl (int c)
+{
+#if C_CTYPE_ASCII
+ return ((c & ~0x1f) == 0 || c == 0x7f);
+#else
+ switch (c)
+ {
+ case ' ': case '!': case '"': case '#': case '$': case '%':
+ case '&': case '\'': case '(': case ')': case '*': case '+':
+ case ',': case '-': case '.': case '/':
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ case ':': case ';': case '<': case '=': case '>': case '?':
+ case '@':
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z':
+ case '[': case '\\': case ']': case '^': case '_': case '`':
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+ case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+ case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+ case 'y': case 'z':
+ case '{': case '|': case '}': case '~':
+ return 0;
+ default:
+ return 1;
+ }
+#endif
+}
+
+bool
+c_isdigit (int c)
+{
+#if C_CTYPE_CONSECUTIVE_DIGITS
+ return (c >= '0' && c <= '9');
+#else
+ switch (c)
+ {
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_islower (int c)
+{
+#if C_CTYPE_CONSECUTIVE_LOWERCASE
+ return (c >= 'a' && c <= 'z');
+#else
+ switch (c)
+ {
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+ case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+ case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+ case 'y': case 'z':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_isgraph (int c)
+{
+#if C_CTYPE_ASCII
+ return (c >= '!' && c <= '~');
+#else
+ switch (c)
+ {
+ case '!': case '"': case '#': case '$': case '%': case '&':
+ case '\'': case '(': case ')': case '*': case '+': case ',':
+ case '-': case '.': case '/':
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ case ':': case ';': case '<': case '=': case '>': case '?':
+ case '@':
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z':
+ case '[': case '\\': case ']': case '^': case '_': case '`':
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+ case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+ case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+ case 'y': case 'z':
+ case '{': case '|': case '}': case '~':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_isprint (int c)
+{
+#if C_CTYPE_ASCII
+ return (c >= ' ' && c <= '~');
+#else
+ switch (c)
+ {
+ case ' ': case '!': case '"': case '#': case '$': case '%':
+ case '&': case '\'': case '(': case ')': case '*': case '+':
+ case ',': case '-': case '.': case '/':
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ case ':': case ';': case '<': case '=': case '>': case '?':
+ case '@':
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z':
+ case '[': case '\\': case ']': case '^': case '_': case '`':
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+ case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+ case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+ case 'y': case 'z':
+ case '{': case '|': case '}': case '~':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_ispunct (int c)
+{
+#if C_CTYPE_ASCII
+ return ((c >= '!' && c <= '~')
+ && !((c >= '0' && c <= '9')
+ || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z')));
+#else
+ switch (c)
+ {
+ case '!': case '"': case '#': case '$': case '%': case '&':
+ case '\'': case '(': case ')': case '*': case '+': case ',':
+ case '-': case '.': case '/':
+ case ':': case ';': case '<': case '=': case '>': case '?':
+ case '@':
+ case '[': case '\\': case ']': case '^': case '_': case '`':
+ case '{': case '|': case '}': case '~':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_isspace (int c)
+{
+ return (c == ' ' || c == '\t'
+ || c == '\n' || c == '\v' || c == '\f' || c == '\r');
+}
+
+bool
+c_isupper (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE
+ return (c >= 'A' && c <= 'Z');
+#else
+ switch (c)
+ {
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_isxdigit (int c)
+{
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+ && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+ return ((c >= '0' && c <= '9')
+ || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'F'));
+#else
+ return ((c >= '0' && c <= '9')
+ || (c >= 'A' && c <= 'F')
+ || (c >= 'a' && c <= 'f'));
+#endif
+#else
+ switch (c)
+ {
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+int
+c_tolower (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+ return (c >= 'A' && c <= 'Z' ? c - 'A' + 'a' : c);
+#else
+ switch (c)
+ {
+ case 'A': return 'a';
+ case 'B': return 'b';
+ case 'C': return 'c';
+ case 'D': return 'd';
+ case 'E': return 'e';
+ case 'F': return 'f';
+ case 'G': return 'g';
+ case 'H': return 'h';
+ case 'I': return 'i';
+ case 'J': return 'j';
+ case 'K': return 'k';
+ case 'L': return 'l';
+ case 'M': return 'm';
+ case 'N': return 'n';
+ case 'O': return 'o';
+ case 'P': return 'p';
+ case 'Q': return 'q';
+ case 'R': return 'r';
+ case 'S': return 's';
+ case 'T': return 't';
+ case 'U': return 'u';
+ case 'V': return 'v';
+ case 'W': return 'w';
+ case 'X': return 'x';
+ case 'Y': return 'y';
+ case 'Z': return 'z';
+ default: return c;
+ }
+#endif
+}
+
+int
+c_toupper (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+ return (c >= 'a' && c <= 'z' ? c - 'a' + 'A' : c);
+#else
+ switch (c)
+ {
+ case 'a': return 'A';
+ case 'b': return 'B';
+ case 'c': return 'C';
+ case 'd': return 'D';
+ case 'e': return 'E';
+ case 'f': return 'F';
+ case 'g': return 'G';
+ case 'h': return 'H';
+ case 'i': return 'I';
+ case 'j': return 'J';
+ case 'k': return 'K';
+ case 'l': return 'L';
+ case 'm': return 'M';
+ case 'n': return 'N';
+ case 'o': return 'O';
+ case 'p': return 'P';
+ case 'q': return 'Q';
+ case 'r': return 'R';
+ case 's': return 'S';
+ case 't': return 'T';
+ case 'u': return 'U';
+ case 'v': return 'V';
+ case 'w': return 'W';
+ case 'x': return 'X';
+ case 'y': return 'Y';
+ case 'z': return 'Z';
+ default: return c;
+ }
+#endif
+}
diff --git a/lib/c-ctype.h b/lib/c-ctype.h
new file mode 100644
index 00000000000..0b31309e960
--- /dev/null
+++ b/lib/c-ctype.h
@@ -0,0 +1,294 @@
+/* Character handling in C locale.
+
+ These functions work like the corresponding functions in <ctype.h>,
+ except that they have the C (POSIX) locale hardwired, whereas the
+ <ctype.h> functions' behaviour depends on the current locale set via
+ setlocale.
+
+ Copyright (C) 2000-2003, 2006, 2008-2012 Free Software Foundation, Inc.
+
+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/>. */
+
+#ifndef C_CTYPE_H
+#define C_CTYPE_H
+
+#include <stdbool.h>
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* The functions defined in this file assume the "C" locale and a character
+ set without diacritics (ASCII-US or EBCDIC-US or something like that).
+ Even if the "C" locale on a particular system is an extension of the ASCII
+ character set (like on BeOS, where it is UTF-8, or on AmigaOS, where it
+ is ISO-8859-1), the functions in this file recognize only the ASCII
+ characters. */
+
+
+/* Check whether the ASCII optimizations apply. */
+
+/* ANSI C89 (and ISO C99 5.2.1.3 too) already guarantees that
+ '0', '1', ..., '9' have consecutive integer values. */
+#define C_CTYPE_CONSECUTIVE_DIGITS 1
+
+#if ('A' <= 'Z') \
+ && ('A' + 1 == 'B') && ('B' + 1 == 'C') && ('C' + 1 == 'D') \
+ && ('D' + 1 == 'E') && ('E' + 1 == 'F') && ('F' + 1 == 'G') \
+ && ('G' + 1 == 'H') && ('H' + 1 == 'I') && ('I' + 1 == 'J') \
+ && ('J' + 1 == 'K') && ('K' + 1 == 'L') && ('L' + 1 == 'M') \
+ && ('M' + 1 == 'N') && ('N' + 1 == 'O') && ('O' + 1 == 'P') \
+ && ('P' + 1 == 'Q') && ('Q' + 1 == 'R') && ('R' + 1 == 'S') \
+ && ('S' + 1 == 'T') && ('T' + 1 == 'U') && ('U' + 1 == 'V') \
+ && ('V' + 1 == 'W') && ('W' + 1 == 'X') && ('X' + 1 == 'Y') \
+ && ('Y' + 1 == 'Z')
+#define C_CTYPE_CONSECUTIVE_UPPERCASE 1
+#endif
+
+#if ('a' <= 'z') \
+ && ('a' + 1 == 'b') && ('b' + 1 == 'c') && ('c' + 1 == 'd') \
+ && ('d' + 1 == 'e') && ('e' + 1 == 'f') && ('f' + 1 == 'g') \
+ && ('g' + 1 == 'h') && ('h' + 1 == 'i') && ('i' + 1 == 'j') \
+ && ('j' + 1 == 'k') && ('k' + 1 == 'l') && ('l' + 1 == 'm') \
+ && ('m' + 1 == 'n') && ('n' + 1 == 'o') && ('o' + 1 == 'p') \
+ && ('p' + 1 == 'q') && ('q' + 1 == 'r') && ('r' + 1 == 's') \
+ && ('s' + 1 == 't') && ('t' + 1 == 'u') && ('u' + 1 == 'v') \
+ && ('v' + 1 == 'w') && ('w' + 1 == 'x') && ('x' + 1 == 'y') \
+ && ('y' + 1 == 'z')
+#define C_CTYPE_CONSECUTIVE_LOWERCASE 1
+#endif
+
+#if (' ' == 32) && ('!' == 33) && ('"' == 34) && ('#' == 35) \
+ && ('%' == 37) && ('&' == 38) && ('\'' == 39) && ('(' == 40) \
+ && (')' == 41) && ('*' == 42) && ('+' == 43) && (',' == 44) \
+ && ('-' == 45) && ('.' == 46) && ('/' == 47) && ('0' == 48) \
+ && ('1' == 49) && ('2' == 50) && ('3' == 51) && ('4' == 52) \
+ && ('5' == 53) && ('6' == 54) && ('7' == 55) && ('8' == 56) \
+ && ('9' == 57) && (':' == 58) && (';' == 59) && ('<' == 60) \
+ && ('=' == 61) && ('>' == 62) && ('?' == 63) && ('A' == 65) \
+ && ('B' == 66) && ('C' == 67) && ('D' == 68) && ('E' == 69) \
+ && ('F' == 70) && ('G' == 71) && ('H' == 72) && ('I' == 73) \
+ && ('J' == 74) && ('K' == 75) && ('L' == 76) && ('M' == 77) \
+ && ('N' == 78) && ('O' == 79) && ('P' == 80) && ('Q' == 81) \
+ && ('R' == 82) && ('S' == 83) && ('T' == 84) && ('U' == 85) \
+ && ('V' == 86) && ('W' == 87) && ('X' == 88) && ('Y' == 89) \
+ && ('Z' == 90) && ('[' == 91) && ('\\' == 92) && (']' == 93) \
+ && ('^' == 94) && ('_' == 95) && ('a' == 97) && ('b' == 98) \
+ && ('c' == 99) && ('d' == 100) && ('e' == 101) && ('f' == 102) \
+ && ('g' == 103) && ('h' == 104) && ('i' == 105) && ('j' == 106) \
+ && ('k' == 107) && ('l' == 108) && ('m' == 109) && ('n' == 110) \
+ && ('o' == 111) && ('p' == 112) && ('q' == 113) && ('r' == 114) \
+ && ('s' == 115) && ('t' == 116) && ('u' == 117) && ('v' == 118) \
+ && ('w' == 119) && ('x' == 120) && ('y' == 121) && ('z' == 122) \
+ && ('{' == 123) && ('|' == 124) && ('}' == 125) && ('~' == 126)
+/* The character set is ASCII or one of its variants or extensions, not EBCDIC.
+ Testing the value of '\n' and '\r' is not relevant. */
+#define C_CTYPE_ASCII 1
+#endif
+
+
+/* Function declarations. */
+
+/* Unlike the functions in <ctype.h>, which require an argument in the range
+ of the 'unsigned char' type, the functions here operate on values that are
+ in the 'unsigned char' range or in the 'char' range. In other words,
+ when you have a 'char' value, you need to cast it before using it as
+ argument to a <ctype.h> function:
+
+ const char *s = ...;
+ if (isalpha ((unsigned char) *s)) ...
+
+ but you don't need to cast it for the functions defined in this file:
+
+ const char *s = ...;
+ if (c_isalpha (*s)) ...
+ */
+
+extern bool c_isascii (int c) _GL_ATTRIBUTE_CONST; /* not locale dependent */
+
+extern bool c_isalnum (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isalpha (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isblank (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_iscntrl (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isdigit (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_islower (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isgraph (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isprint (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_ispunct (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isspace (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isupper (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isxdigit (int c) _GL_ATTRIBUTE_CONST;
+
+extern int c_tolower (int c) _GL_ATTRIBUTE_CONST;
+extern int c_toupper (int c) _GL_ATTRIBUTE_CONST;
+
+
+#if defined __GNUC__ && defined __OPTIMIZE__ && !defined __OPTIMIZE_SIZE__ && !defined NO_C_CTYPE_MACROS
+
+/* ASCII optimizations. */
+
+#undef c_isascii
+#define c_isascii(c) \
+ ({ int __c = (c); \
+ (__c >= 0x00 && __c <= 0x7f); \
+ })
+
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+ && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+#undef c_isalnum
+#define c_isalnum(c) \
+ ({ int __c = (c); \
+ ((__c >= '0' && __c <= '9') \
+ || ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'Z')); \
+ })
+#else
+#undef c_isalnum
+#define c_isalnum(c) \
+ ({ int __c = (c); \
+ ((__c >= '0' && __c <= '9') \
+ || (__c >= 'A' && __c <= 'Z') \
+ || (__c >= 'a' && __c <= 'z')); \
+ })
+#endif
+#endif
+
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+#undef c_isalpha
+#define c_isalpha(c) \
+ ({ int __c = (c); \
+ ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'Z'); \
+ })
+#else
+#undef c_isalpha
+#define c_isalpha(c) \
+ ({ int __c = (c); \
+ ((__c >= 'A' && __c <= 'Z') || (__c >= 'a' && __c <= 'z')); \
+ })
+#endif
+#endif
+
+#undef c_isblank
+#define c_isblank(c) \
+ ({ int __c = (c); \
+ (__c == ' ' || __c == '\t'); \
+ })
+
+#if C_CTYPE_ASCII
+#undef c_iscntrl
+#define c_iscntrl(c) \
+ ({ int __c = (c); \
+ ((__c & ~0x1f) == 0 || __c == 0x7f); \
+ })
+#endif
+
+#if C_CTYPE_CONSECUTIVE_DIGITS
+#undef c_isdigit
+#define c_isdigit(c) \
+ ({ int __c = (c); \
+ (__c >= '0' && __c <= '9'); \
+ })
+#endif
+
+#if C_CTYPE_CONSECUTIVE_LOWERCASE
+#undef c_islower
+#define c_islower(c) \
+ ({ int __c = (c); \
+ (__c >= 'a' && __c <= 'z'); \
+ })
+#endif
+
+#if C_CTYPE_ASCII
+#undef c_isgraph
+#define c_isgraph(c) \
+ ({ int __c = (c); \
+ (__c >= '!' && __c <= '~'); \
+ })
+#endif
+
+#if C_CTYPE_ASCII
+#undef c_isprint
+#define c_isprint(c) \
+ ({ int __c = (c); \
+ (__c >= ' ' && __c <= '~'); \
+ })
+#endif
+
+#if C_CTYPE_ASCII
+#undef c_ispunct
+#define c_ispunct(c) \
+ ({ int _c = (c); \
+ (c_isgraph (_c) && ! c_isalnum (_c)); \
+ })
+#endif
+
+#undef c_isspace
+#define c_isspace(c) \
+ ({ int __c = (c); \
+ (__c == ' ' || __c == '\t' \
+ || __c == '\n' || __c == '\v' || __c == '\f' || __c == '\r'); \
+ })
+
+#if C_CTYPE_CONSECUTIVE_UPPERCASE
+#undef c_isupper
+#define c_isupper(c) \
+ ({ int __c = (c); \
+ (__c >= 'A' && __c <= 'Z'); \
+ })
+#endif
+
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+ && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+#undef c_isxdigit
+#define c_isxdigit(c) \
+ ({ int __c = (c); \
+ ((__c >= '0' && __c <= '9') \
+ || ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'F')); \
+ })
+#else
+#undef c_isxdigit
+#define c_isxdigit(c) \
+ ({ int __c = (c); \
+ ((__c >= '0' && __c <= '9') \
+ || (__c >= 'A' && __c <= 'F') \
+ || (__c >= 'a' && __c <= 'f')); \
+ })
+#endif
+#endif
+
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#undef c_tolower
+#define c_tolower(c) \
+ ({ int __c = (c); \
+ (__c >= 'A' && __c <= 'Z' ? __c - 'A' + 'a' : __c); \
+ })
+#undef c_toupper
+#define c_toupper(c) \
+ ({ int __c = (c); \
+ (__c >= 'a' && __c <= 'z' ? __c - 'a' + 'A' : __c); \
+ })
+#endif
+
+#endif /* optimizing for speed */
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* C_CTYPE_H */
diff --git a/lib/c-strcase.h b/lib/c-strcase.h
new file mode 100644
index 00000000000..fdef2385eaf
--- /dev/null
+++ b/lib/c-strcase.h
@@ -0,0 +1,56 @@
+/* Case-insensitive string comparison functions in C locale.
+ Copyright (C) 1995-1996, 2001, 2003, 2005, 2009-2012 Free Software
+ Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+#ifndef C_STRCASE_H
+#define C_STRCASE_H
+
+#include <stddef.h>
+
+
+/* The functions defined in this file assume the "C" locale and a character
+ set without diacritics (ASCII-US or EBCDIC-US or something like that).
+ Even if the "C" locale on a particular system is an extension of the ASCII
+ character set (like on BeOS, where it is UTF-8, or on AmigaOS, where it
+ is ISO-8859-1), the functions in this file recognize only the ASCII
+ characters. More precisely, one of the string arguments must be an ASCII
+ string; the other one can also contain non-ASCII characters (but then
+ the comparison result will be nonzero). */
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* Compare strings S1 and S2, ignoring case, returning less than, equal to or
+ greater than zero if S1 is lexicographically less than, equal to or greater
+ than S2. */
+extern int c_strcasecmp (const char *s1, const char *s2) _GL_ATTRIBUTE_PURE;
+
+/* Compare no more than N characters of strings S1 and S2, ignoring case,
+ returning less than, equal to or greater than zero if S1 is
+ lexicographically less than, equal to or greater than S2. */
+extern int c_strncasecmp (const char *s1, const char *s2, size_t n)
+ _GL_ATTRIBUTE_PURE;
+
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif /* C_STRCASE_H */
diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c
new file mode 100644
index 00000000000..d8332caf839
--- /dev/null
+++ b/lib/c-strcasecmp.c
@@ -0,0 +1,56 @@
+/* c-strcasecmp.c -- case insensitive string comparator in C locale
+ Copyright (C) 1998-1999, 2005-2006, 2009-2012 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+/* Specification. */
+#include "c-strcase.h"
+
+#include <limits.h>
+
+#include "c-ctype.h"
+
+int
+c_strcasecmp (const char *s1, const char *s2)
+{
+ register const unsigned char *p1 = (const unsigned char *) s1;
+ register const unsigned char *p2 = (const unsigned char *) s2;
+ unsigned char c1, c2;
+
+ if (p1 == p2)
+ return 0;
+
+ do
+ {
+ c1 = c_tolower (*p1);
+ c2 = c_tolower (*p2);
+
+ if (c1 == '\0')
+ break;
+
+ ++p1;
+ ++p2;
+ }
+ while (c1 == c2);
+
+ if (UCHAR_MAX <= INT_MAX)
+ return c1 - c2;
+ else
+ /* On machines where 'char' and 'int' are types of the same size, the
+ difference of two 'unsigned char' values - including the sign bit -
+ doesn't fit in an 'int'. */
+ return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
+}
diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c
new file mode 100644
index 00000000000..47fb5fdb678
--- /dev/null
+++ b/lib/c-strncasecmp.c
@@ -0,0 +1,56 @@
+/* c-strncasecmp.c -- case insensitive string comparator in C locale
+ Copyright (C) 1998-1999, 2005-2006, 2009-2012 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+/* Specification. */
+#include "c-strcase.h"
+
+#include <limits.h>
+
+#include "c-ctype.h"
+
+int
+c_strncasecmp (const char *s1, const char *s2, size_t n)
+{
+ register const unsigned char *p1 = (const unsigned char *) s1;
+ register const unsigned char *p2 = (const unsigned char *) s2;
+ unsigned char c1, c2;
+
+ if (p1 == p2 || n == 0)
+ return 0;
+
+ do
+ {
+ c1 = c_tolower (*p1);
+ c2 = c_tolower (*p2);
+
+ if (--n == 0 || c1 == '\0')
+ break;
+
+ ++p1;
+ ++p2;
+ }
+ while (c1 == c2);
+
+ if (UCHAR_MAX <= INT_MAX)
+ return c1 - c2;
+ else
+ /* On machines where 'char' and 'int' are types of the same size, the
+ difference of two 'unsigned char' values - including the sign bit -
+ doesn't fit in an 'int'. */
+ return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
+}
diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c
index 751578b9a58..cd4aa846dca 100644
--- a/lib/careadlinkat.c
+++ b/lib/careadlinkat.c
@@ -1,6 +1,6 @@
/* Read symbolic links into a buffer without size limitation, relative to fd.
- Copyright (C) 2001, 2003-2004, 2007, 2009-2011 Free Software Foundation,
+ Copyright (C) 2001, 2003-2004, 2007, 2009-2012 Free Software Foundation,
Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/careadlinkat.h b/lib/careadlinkat.h
index 6576fb2cecc..c21d3f459cd 100644
--- a/lib/careadlinkat.h
+++ b/lib/careadlinkat.h
@@ -1,6 +1,6 @@
/* Read symbolic links into a buffer without size limitation, relative to fd.
- Copyright (C) 2011 Free Software Foundation, Inc.
+ Copyright (C) 2011-2012 Free Software Foundation, Inc.
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
diff --git a/lib/close-stream.c b/lib/close-stream.c
new file mode 100644
index 00000000000..04fa5ece09d
--- /dev/null
+++ b/lib/close-stream.c
@@ -0,0 +1,78 @@
+/* Close a stream, with nicer error checking than fclose's.
+
+ Copyright (C) 1998-2002, 2004, 2006-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+#include <config.h>
+
+#include "close-stream.h"
+
+#include <errno.h>
+#include <stdbool.h>
+
+#include "fpending.h"
+
+#if USE_UNLOCKED_IO
+# include "unlocked-io.h"
+#endif
+
+/* Close STREAM. Return 0 if successful, EOF (setting errno)
+ otherwise. A failure might set errno to 0 if the error number
+ cannot be determined.
+
+ A failure with errno set to EPIPE may or may not indicate an error
+ situation worth signaling to the user. See the documentation of the
+ close_stdout_set_ignore_EPIPE function for details.
+
+ If a program writes *anything* to STREAM, that program should close
+ STREAM and make sure that it succeeds before exiting. Otherwise,
+ suppose that you go to the extreme of checking the return status
+ of every function that does an explicit write to STREAM. The last
+ printf can succeed in writing to the internal stream buffer, and yet
+ the fclose(STREAM) could still fail (due e.g., to a disk full error)
+ when it tries to write out that buffered data. Thus, you would be
+ left with an incomplete output file and the offending program would
+ exit successfully. Even calling fflush is not always sufficient,
+ since some file systems (NFS and CODA) buffer written/flushed data
+ until an actual close call.
+
+ Besides, it's wasteful to check the return value from every call
+ that writes to STREAM -- just let the internal stream state record
+ the failure. That's what the ferror test is checking below. */
+
+int
+close_stream (FILE *stream)
+{
+ const bool some_pending = (__fpending (stream) != 0);
+ const bool prev_fail = (ferror (stream) != 0);
+ const bool fclose_fail = (fclose (stream) != 0);
+
+ /* Return an error indication if there was a previous failure or if
+ fclose failed, with one exception: ignore an fclose failure if
+ there was no previous error, no data remains to be flushed, and
+ fclose failed with EBADF. That can happen when a program like cp
+ is invoked like this 'cp a b >&-' (i.e., with standard output
+ closed) and doesn't generate any output (hence no previous error
+ and nothing to be flushed). */
+
+ if (prev_fail || (fclose_fail && (some_pending || errno != EBADF)))
+ {
+ if (! fclose_fail)
+ errno = 0;
+ return EOF;
+ }
+
+ return 0;
+}
diff --git a/lib/close-stream.h b/lib/close-stream.h
new file mode 100644
index 00000000000..be3d4196b06
--- /dev/null
+++ b/lib/close-stream.h
@@ -0,0 +1,2 @@
+#include <stdio.h>
+int close_stream (FILE *stream);
diff --git a/lib/dosname.h b/lib/dosname.h
index acdd03b156e..0468ce4dc81 100644
--- a/lib/dosname.h
+++ b/lib/dosname.h
@@ -1,6 +1,6 @@
/* File names on MS-DOS/Windows systems.
- Copyright (C) 2000-2001, 2004-2006, 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2000-2001, 2004-2006, 2009-2012 Free Software Foundation, Inc.
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
diff --git a/lib/dtotimespec.c b/lib/dtotimespec.c
new file mode 100644
index 00000000000..f30fa075077
--- /dev/null
+++ b/lib/dtotimespec.c
@@ -0,0 +1,69 @@
+/* Convert double to timespec.
+
+ Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* written by Paul Eggert */
+
+/* Convert the double value SEC to a struct timespec. Round toward
+ positive infinity. On overflow, return an extremal value. */
+
+#include <config.h>
+
+#include "timespec.h"
+
+#include "intprops.h"
+
+struct timespec
+dtotimespec (double sec)
+{
+ enum { BILLION = 1000 * 1000 * 1000 };
+ double min_representable = TYPE_MINIMUM (time_t);
+ double max_representable =
+ ((TYPE_MAXIMUM (time_t) * (double) BILLION + (BILLION - 1))
+ / BILLION);
+ struct timespec r;
+
+ if (! (min_representable < sec))
+ {
+ r.tv_sec = TYPE_MINIMUM (time_t);
+ r.tv_nsec = 0;
+ }
+ else if (! (sec < max_representable))
+ {
+ r.tv_sec = TYPE_MAXIMUM (time_t);
+ r.tv_nsec = BILLION - 1;
+ }
+ else
+ {
+ time_t s = sec;
+ double frac = BILLION * (sec - s);
+ long ns = frac;
+ ns += ns < frac;
+ s += ns / BILLION;
+ ns %= BILLION;
+
+ if (ns < 0)
+ {
+ s--;
+ ns += BILLION;
+ }
+
+ r.tv_sec = s;
+ r.tv_nsec = ns;
+ }
+
+ return r;
+}
diff --git a/lib/dup2.c b/lib/dup2.c
index 790c98a2e84..f6d0f1c73c5 100644
--- a/lib/dup2.c
+++ b/lib/dup2.c
@@ -1,6 +1,6 @@
/* Duplicate an open file descriptor to a specified file descriptor.
- Copyright (C) 1999, 2004-2007, 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2004-2007, 2009-2012 Free Software Foundation, Inc.
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
@@ -31,7 +31,7 @@
# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
-/* Get declarations of the Win32 API functions. */
+/* Get declarations of the native Windows API functions. */
# define WIN32_LEAN_AND_MEAN
# include <windows.h>
diff --git a/lib/euidaccess.c b/lib/euidaccess.c
new file mode 100644
index 00000000000..ca2ceca5d22
--- /dev/null
+++ b/lib/euidaccess.c
@@ -0,0 +1,221 @@
+/* euidaccess -- check if effective user id can access file
+
+ Copyright (C) 1990-1991, 1995, 1998, 2000, 2003-2006, 2008-2012 Free
+ Software Foundation, Inc.
+
+ This file is part of the GNU C Library.
+
+ 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/>. */
+
+/* Written by David MacKenzie and Torbjorn Granlund.
+ Adapted for GNU C library by Roland McGrath. */
+
+#ifndef _LIBC
+# include <config.h>
+#endif
+
+#include <fcntl.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+
+#include "root-uid.h"
+
+#if HAVE_LIBGEN_H
+# include <libgen.h>
+#endif
+
+#include <errno.h>
+#ifndef __set_errno
+# define __set_errno(val) errno = (val)
+#endif
+
+#if defined EACCES && !defined EACCESS
+# define EACCESS EACCES
+#endif
+
+#ifndef F_OK
+# define F_OK 0
+# define X_OK 1
+# define W_OK 2
+# define R_OK 4
+#endif
+
+
+#ifdef _LIBC
+
+# define access __access
+# define getuid __getuid
+# define getgid __getgid
+# define geteuid __geteuid
+# define getegid __getegid
+# define group_member __group_member
+# define euidaccess __euidaccess
+# undef stat
+# define stat stat64
+
+#endif
+
+/* Return 0 if the user has permission of type MODE on FILE;
+ otherwise, return -1 and set 'errno'.
+ Like access, except that it uses the effective user and group
+ id's instead of the real ones, and it does not always check for read-only
+ file system, text busy, etc. */
+
+int
+euidaccess (const char *file, int mode)
+{
+#if HAVE_FACCESSAT /* glibc, AIX 7, Solaris 11, Cygwin 1.7 */
+ return faccessat (AT_FDCWD, file, mode, AT_EACCESS);
+#elif defined EFF_ONLY_OK /* IRIX, OSF/1, Interix */
+ return access (file, mode | EFF_ONLY_OK);
+#elif defined ACC_SELF /* AIX */
+ return accessx (file, mode, ACC_SELF);
+#elif HAVE_EACCESS /* FreeBSD */
+ return eaccess (file, mode);
+#else /* Mac OS X, NetBSD, OpenBSD, HP-UX, Solaris, Cygwin, mingw, BeOS */
+
+ uid_t uid = getuid ();
+ gid_t gid = getgid ();
+ uid_t euid = geteuid ();
+ gid_t egid = getegid ();
+ struct stat stats;
+
+# if HAVE_DECL_SETREGID && PREFER_NONREENTRANT_EUIDACCESS
+
+ /* Define PREFER_NONREENTRANT_EUIDACCESS if you prefer euidaccess to
+ return the correct result even if this would make it
+ nonreentrant. Define this only if your entire application is
+ safe even if the uid or gid might temporarily change. If your
+ application uses signal handlers or threads it is probably not
+ safe. */
+
+ if (mode == F_OK)
+ return stat (file, &stats);
+ else
+ {
+ int result;
+ int saved_errno;
+
+ if (uid != euid)
+ setreuid (euid, uid);
+ if (gid != egid)
+ setregid (egid, gid);
+
+ result = access (file, mode);
+ saved_errno = errno;
+
+ /* Restore them. */
+ if (uid != euid)
+ setreuid (uid, euid);
+ if (gid != egid)
+ setregid (gid, egid);
+
+ errno = saved_errno;
+ return result;
+ }
+
+# else
+
+ /* The following code assumes the traditional Unix model, and is not
+ correct on systems that have ACLs or the like. However, it's
+ better than nothing, and it is reentrant. */
+
+ unsigned int granted;
+ if (uid == euid && gid == egid)
+ /* If we are not set-uid or set-gid, access does the same. */
+ return access (file, mode);
+
+ if (stat (file, &stats) != 0)
+ return -1;
+
+ /* The super-user can read and write any file, and execute any file
+ that anyone can execute. */
+ if (euid == ROOT_UID
+ && ((mode & X_OK) == 0
+ || (stats.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH))))
+ return 0;
+
+ /* Convert the mode to traditional form, clearing any bogus bits. */
+ if (R_OK == 4 && W_OK == 2 && X_OK == 1 && F_OK == 0)
+ mode &= 7;
+ else
+ mode = ((mode & R_OK ? 4 : 0)
+ + (mode & W_OK ? 2 : 0)
+ + (mode & X_OK ? 1 : 0));
+
+ if (mode == 0)
+ return 0; /* The file exists. */
+
+ /* Convert the file's permission bits to traditional form. */
+ if (S_IRUSR == (4 << 6) && S_IWUSR == (2 << 6) && S_IXUSR == (1 << 6)
+ && S_IRGRP == (4 << 3) && S_IWGRP == (2 << 3) && S_IXGRP == (1 << 3)
+ && S_IROTH == (4 << 0) && S_IWOTH == (2 << 0) && S_IXOTH == (1 << 0))
+ granted = stats.st_mode;
+ else
+ granted = ((stats.st_mode & S_IRUSR ? 4 << 6 : 0)
+ + (stats.st_mode & S_IWUSR ? 2 << 6 : 0)
+ + (stats.st_mode & S_IXUSR ? 1 << 6 : 0)
+ + (stats.st_mode & S_IRGRP ? 4 << 3 : 0)
+ + (stats.st_mode & S_IWGRP ? 2 << 3 : 0)
+ + (stats.st_mode & S_IXGRP ? 1 << 3 : 0)
+ + (stats.st_mode & S_IROTH ? 4 << 0 : 0)
+ + (stats.st_mode & S_IWOTH ? 2 << 0 : 0)
+ + (stats.st_mode & S_IXOTH ? 1 << 0 : 0));
+
+ if (euid == stats.st_uid)
+ granted >>= 6;
+ else if (egid == stats.st_gid || group_member (stats.st_gid))
+ granted >>= 3;
+
+ if ((mode & ~granted) == 0)
+ return 0;
+ __set_errno (EACCESS);
+ return -1;
+
+# endif
+#endif
+}
+#undef euidaccess
+#ifdef weak_alias
+weak_alias (__euidaccess, euidaccess)
+#endif
+
+#ifdef TEST
+# include <error.h>
+# include <stdio.h>
+# include <stdlib.h>
+
+char *program_name;
+
+int
+main (int argc, char **argv)
+{
+ char *file;
+ int mode;
+ int err;
+
+ program_name = argv[0];
+ if (argc < 3)
+ abort ();
+ file = argv[1];
+ mode = atoi (argv[2]);
+
+ err = euidaccess (file, mode);
+ printf ("%d\n", err);
+ if (err != 0)
+ error (0, errno, "%s", file);
+ exit (0);
+}
+#endif
diff --git a/lib/execinfo.c b/lib/execinfo.c
new file mode 100644
index 00000000000..0bcd9f078ba
--- /dev/null
+++ b/lib/execinfo.c
@@ -0,0 +1,3 @@
+#include <config.h>
+#define _GL_EXECINFO_INLINE _GL_EXTERN_INLINE
+#include "execinfo.h"
diff --git a/lib/execinfo.in.h b/lib/execinfo.in.h
new file mode 100644
index 00000000000..d76b0e1b771
--- /dev/null
+++ b/lib/execinfo.in.h
@@ -0,0 +1,54 @@
+/* Information about executables.
+
+ Copyright (C) 2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* Written by Paul Eggert. */
+
+#ifndef _GL_EXECINFO_H
+#define _GL_EXECINFO_H
+
+_GL_INLINE_HEADER_BEGIN
+#ifndef _GL_EXECINFO_INLINE
+# define _GL_EXECINFO_INLINE _GL_INLINE
+#endif
+
+_GL_EXECINFO_INLINE int
+backtrace (void **buffer, int size)
+{
+ (void) buffer;
+ (void) size;
+ return 0;
+}
+
+_GL_EXECINFO_INLINE char **
+backtrace_symbols (void *const *buffer, int size)
+{
+ (void) buffer;
+ (void) size;
+ return 0;
+}
+
+_GL_EXECINFO_INLINE void
+backtrace_symbols_fd (void *const *buffer, int size, int fd)
+{
+ (void) buffer;
+ (void) size;
+ (void) fd;
+}
+
+_GL_INLINE_HEADER_END
+
+#endif
diff --git a/lib/faccessat.c b/lib/faccessat.c
new file mode 100644
index 00000000000..d11a3efaad6
--- /dev/null
+++ b/lib/faccessat.c
@@ -0,0 +1,45 @@
+/* Check the access rights of a file relative to an open directory.
+ Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* written by Eric Blake */
+
+#include <config.h>
+
+#include <unistd.h>
+#include <fcntl.h>
+
+#ifndef HAVE_ACCESS
+/* Mingw lacks access, but it also lacks real vs. effective ids, so
+ the gnulib euidaccess module is good enough. */
+# undef access
+# define access euidaccess
+#endif
+
+/* Invoke access or euidaccess on file, FILE, using mode MODE, in the directory
+ open on descriptor FD. If possible, do it without changing the
+ working directory. Otherwise, resort to using save_cwd/fchdir, then
+ (access|euidaccess)/restore_cwd. If either the save_cwd or the
+ restore_cwd fails, then give a diagnostic and exit nonzero.
+ Note that this implementation only supports AT_EACCESS, although some
+ native versions also support AT_SYMLINK_NOFOLLOW. */
+
+#define AT_FUNC_NAME faccessat
+#define AT_FUNC_F1 euidaccess
+#define AT_FUNC_F2 access
+#define AT_FUNC_USE_F1_COND AT_EACCESS
+#define AT_FUNC_POST_FILE_PARAM_DECLS , int mode, int flag
+#define AT_FUNC_POST_FILE_ARGS , mode
+#include "at-func.c"
diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h
new file mode 100644
index 00000000000..604c31b7984
--- /dev/null
+++ b/lib/fcntl.in.h
@@ -0,0 +1,347 @@
+/* Like <fcntl.h>, but with non-working flags defined to 0.
+
+ Copyright (C) 2006-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* written by Paul Eggert */
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+@PRAGMA_COLUMNS@
+
+#if defined __need_system_fcntl_h
+/* Special invocation convention. */
+
+/* Needed before <sys/stat.h>.
+ May also define off_t to a 64-bit type on native Windows. */
+#include <sys/types.h>
+/* On some systems other than glibc, <sys/stat.h> is a prerequisite of
+ <fcntl.h>. On glibc systems, we would like to avoid namespace pollution.
+ But on glibc systems, <fcntl.h> includes <sys/stat.h> inside an
+ extern "C" { ... } block, which leads to errors in C++ mode with the
+ overridden <sys/stat.h> from gnulib. These errors are known to be gone
+ with g++ version >= 4.3. */
+#if !(defined __GLIBC__ || defined __UCLIBC__) || (defined __cplusplus && defined GNULIB_NAMESPACE && !(__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)))
+# include <sys/stat.h>
+#endif
+#@INCLUDE_NEXT@ @NEXT_FCNTL_H@
+
+#else
+/* Normal invocation convention. */
+
+#ifndef _@GUARD_PREFIX@_FCNTL_H
+
+/* Needed before <sys/stat.h>.
+ May also define off_t to a 64-bit type on native Windows. */
+#include <sys/types.h>
+/* On some systems other than glibc, <sys/stat.h> is a prerequisite of
+ <fcntl.h>. On glibc systems, we would like to avoid namespace pollution.
+ But on glibc systems, <fcntl.h> includes <sys/stat.h> inside an
+ extern "C" { ... } block, which leads to errors in C++ mode with the
+ overridden <sys/stat.h> from gnulib. These errors are known to be gone
+ with g++ version >= 4.3. */
+#if !(defined __GLIBC__ || defined __UCLIBC__) || (defined __cplusplus && defined GNULIB_NAMESPACE && !(__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)))
+# include <sys/stat.h>
+#endif
+/* The include_next requires a split double-inclusion guard. */
+#@INCLUDE_NEXT@ @NEXT_FCNTL_H@
+
+#ifndef _@GUARD_PREFIX@_FCNTL_H
+#define _@GUARD_PREFIX@_FCNTL_H
+
+#ifndef __GLIBC__ /* Avoid namespace pollution on glibc systems. */
+# include <unistd.h>
+#endif
+
+/* Native Windows platforms declare open(), creat() in <io.h>. */
+#if (@GNULIB_OPEN@ || defined GNULIB_POSIXCHECK) \
+ && ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__)
+# include <io.h>
+#endif
+
+
+/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
+
+/* The definition of _GL_ARG_NONNULL is copied here. */
+
+/* The definition of _GL_WARN_ON_USE is copied here. */
+
+
+/* Declare overridden functions. */
+
+#if @GNULIB_FCNTL@
+# if @REPLACE_FCNTL@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef fcntl
+# define fcntl rpl_fcntl
+# endif
+_GL_FUNCDECL_RPL (fcntl, int, (int fd, int action, ...));
+_GL_CXXALIAS_RPL (fcntl, int, (int fd, int action, ...));
+# else
+# if !@HAVE_FCNTL@
+_GL_FUNCDECL_SYS (fcntl, int, (int fd, int action, ...));
+# endif
+_GL_CXXALIAS_SYS (fcntl, int, (int fd, int action, ...));
+# endif
+_GL_CXXALIASWARN (fcntl);
+#elif defined GNULIB_POSIXCHECK
+# undef fcntl
+# if HAVE_RAW_DECL_FCNTL
+_GL_WARN_ON_USE (fcntl, "fcntl is not always POSIX compliant - "
+ "use gnulib module fcntl for portability");
+# endif
+#endif
+
+#if @GNULIB_OPEN@
+# if @REPLACE_OPEN@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef open
+# define open rpl_open
+# endif
+_GL_FUNCDECL_RPL (open, int, (const char *filename, int flags, ...)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (open, int, (const char *filename, int flags, ...));
+# else
+_GL_CXXALIAS_SYS (open, int, (const char *filename, int flags, ...));
+# endif
+/* On HP-UX 11, in C++ mode, open() is defined as an inline function with a
+ default argument. _GL_CXXALIASWARN does not work in this case. */
+# if !defined __hpux
+_GL_CXXALIASWARN (open);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef open
+/* Assume open is always declared. */
+_GL_WARN_ON_USE (open, "open is not always POSIX compliant - "
+ "use gnulib module open for portability");
+#endif
+
+#if @GNULIB_OPENAT@
+# if @REPLACE_OPENAT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef openat
+# define openat rpl_openat
+# endif
+_GL_FUNCDECL_RPL (openat, int,
+ (int fd, char const *file, int flags, /* mode_t mode */ ...)
+ _GL_ARG_NONNULL ((2)));
+_GL_CXXALIAS_RPL (openat, int,
+ (int fd, char const *file, int flags, /* mode_t mode */ ...));
+# else
+# if !@HAVE_OPENAT@
+_GL_FUNCDECL_SYS (openat, int,
+ (int fd, char const *file, int flags, /* mode_t mode */ ...)
+ _GL_ARG_NONNULL ((2)));
+# endif
+_GL_CXXALIAS_SYS (openat, int,
+ (int fd, char const *file, int flags, /* mode_t mode */ ...));
+# endif
+_GL_CXXALIASWARN (openat);
+#elif defined GNULIB_POSIXCHECK
+# undef openat
+# if HAVE_RAW_DECL_OPENAT
+_GL_WARN_ON_USE (openat, "openat is not portable - "
+ "use gnulib module openat for portability");
+# endif
+#endif
+
+
+/* Fix up the FD_* macros, only known to be missing on mingw. */
+
+#ifndef FD_CLOEXEC
+# define FD_CLOEXEC 1
+#endif
+
+/* Fix up the supported F_* macros. Intentionally leave other F_*
+ macros undefined. Only known to be missing on mingw. */
+
+#ifndef F_DUPFD_CLOEXEC
+# define F_DUPFD_CLOEXEC 0x40000000
+/* Witness variable: 1 if gnulib defined F_DUPFD_CLOEXEC, 0 otherwise. */
+# define GNULIB_defined_F_DUPFD_CLOEXEC 1
+#else
+# define GNULIB_defined_F_DUPFD_CLOEXEC 0
+#endif
+
+#ifndef F_DUPFD
+# define F_DUPFD 1
+#endif
+
+#ifndef F_GETFD
+# define F_GETFD 2
+#endif
+
+/* Fix up the O_* macros. */
+
+#if !defined O_DIRECT && defined O_DIRECTIO
+/* Tru64 spells it 'O_DIRECTIO'. */
+# define O_DIRECT O_DIRECTIO
+#endif
+
+#if !defined O_CLOEXEC && defined O_NOINHERIT
+/* Mingw spells it 'O_NOINHERIT'. */
+# define O_CLOEXEC O_NOINHERIT
+#endif
+
+#ifndef O_CLOEXEC
+# define O_CLOEXEC 0
+#endif
+
+#ifndef O_DIRECT
+# define O_DIRECT 0
+#endif
+
+#ifndef O_DIRECTORY
+# define O_DIRECTORY 0
+#endif
+
+#ifndef O_DSYNC
+# define O_DSYNC 0
+#endif
+
+#ifndef O_EXEC
+# define O_EXEC O_RDONLY /* This is often close enough in older systems. */
+#endif
+
+#ifndef O_IGNORE_CTTY
+# define O_IGNORE_CTTY 0
+#endif
+
+#ifndef O_NDELAY
+# define O_NDELAY 0
+#endif
+
+#ifndef O_NOATIME
+# define O_NOATIME 0
+#endif
+
+#ifndef O_NONBLOCK
+# define O_NONBLOCK O_NDELAY
+#endif
+
+/* If the gnulib module 'nonblocking' is in use, guarantee a working non-zero
+ value of O_NONBLOCK. Otherwise, O_NONBLOCK is defined (above) to O_NDELAY
+ or to 0 as fallback. */
+#if @GNULIB_NONBLOCKING@
+# if O_NONBLOCK
+# define GNULIB_defined_O_NONBLOCK 0
+# else
+# define GNULIB_defined_O_NONBLOCK 1
+# undef O_NONBLOCK
+# define O_NONBLOCK 0x40000000
+# endif
+#endif
+
+#ifndef O_NOCTTY
+# define O_NOCTTY 0
+#endif
+
+#ifndef O_NOFOLLOW
+# define O_NOFOLLOW 0
+#endif
+
+#ifndef O_NOLINK
+# define O_NOLINK 0
+#endif
+
+#ifndef O_NOLINKS
+# define O_NOLINKS 0
+#endif
+
+#ifndef O_NOTRANS
+# define O_NOTRANS 0
+#endif
+
+#ifndef O_RSYNC
+# define O_RSYNC 0
+#endif
+
+#ifndef O_SEARCH
+# define O_SEARCH O_RDONLY /* This is often close enough in older systems. */
+#endif
+
+#ifndef O_SYNC
+# define O_SYNC 0
+#endif
+
+#ifndef O_TTY_INIT
+# define O_TTY_INIT 0
+#endif
+
+#if ~O_ACCMODE & (O_RDONLY | O_WRONLY | O_RDWR | O_EXEC | O_SEARCH)
+# undef O_ACCMODE
+# define O_ACCMODE (O_RDONLY | O_WRONLY | O_RDWR | O_EXEC | O_SEARCH)
+#endif
+
+/* For systems that distinguish between text and binary I/O.
+ O_BINARY is usually declared in fcntl.h */
+#if !defined O_BINARY && defined _O_BINARY
+ /* For MSC-compatible compilers. */
+# define O_BINARY _O_BINARY
+# define O_TEXT _O_TEXT
+#endif
+
+#if defined __BEOS__ || defined __HAIKU__
+ /* BeOS 5 and Haiku have O_BINARY and O_TEXT, but they have no effect. */
+# undef O_BINARY
+# undef O_TEXT
+#endif
+
+#ifndef O_BINARY
+# define O_BINARY 0
+# define O_TEXT 0
+#endif
+
+/* Fix up the AT_* macros. */
+
+/* Work around a bug in Solaris 9 and 10: AT_FDCWD is positive. Its
+ value exceeds INT_MAX, so its use as an int doesn't conform to the
+ C standard, and GCC and Sun C complain in some cases. If the bug
+ is present, undef AT_FDCWD here, so it can be redefined below. */
+#if 0 < AT_FDCWD && AT_FDCWD == 0xffd19553
+# undef AT_FDCWD
+#endif
+
+/* Use the same bit pattern as Solaris 9, but with the proper
+ signedness. The bit pattern is important, in case this actually is
+ Solaris with the above workaround. */
+#ifndef AT_FDCWD
+# define AT_FDCWD (-3041965)
+#endif
+
+/* Use the same values as Solaris 9. This shouldn't matter, but
+ there's no real reason to differ. */
+#ifndef AT_SYMLINK_NOFOLLOW
+# define AT_SYMLINK_NOFOLLOW 4096
+#endif
+
+#ifndef AT_REMOVEDIR
+# define AT_REMOVEDIR 1
+#endif
+
+/* Solaris 9 lacks these two, so just pick unique values. */
+#ifndef AT_SYMLINK_FOLLOW
+# define AT_SYMLINK_FOLLOW 2
+#endif
+
+#ifndef AT_EACCESS
+# define AT_EACCESS 4
+#endif
+
+
+#endif /* _@GUARD_PREFIX@_FCNTL_H */
+#endif /* _@GUARD_PREFIX@_FCNTL_H */
+#endif
diff --git a/lib/filemode.c b/lib/filemode.c
index 0f6641ace6a..ed8c6c989f1 100644
--- a/lib/filemode.c
+++ b/lib/filemode.c
@@ -1,6 +1,6 @@
/* filemode.c -- make a string describing file modes
- Copyright (C) 1985, 1990, 1993, 1998-2000, 2004, 2006, 2009-2011 Free
+ Copyright (C) 1985, 1990, 1993, 1998-2000, 2004, 2006, 2009-2012 Free
Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
@@ -21,8 +21,8 @@
#include "filemode.h"
/* The following is for Cray DMF (Data Migration Facility), which is a
- HSM file system. A migrated file has a `st_dm_mode' that is
- different from the normal `st_mode', so any tests for migrated
+ HSM file system. A migrated file has a 'st_dm_mode' that is
+ different from the normal 'st_mode', so any tests for migrated
files should use the former. */
#if HAVE_ST_DM_MODE
# define IS_MIGRATED_FILE(statp) \
diff --git a/lib/filemode.h b/lib/filemode.h
index 1a50302704c..3ca19b85623 100644
--- a/lib/filemode.h
+++ b/lib/filemode.h
@@ -1,6 +1,6 @@
/* Make a string describing file modes.
- Copyright (C) 1998-1999, 2003, 2006, 2009-2011 Free Software Foundation,
+ Copyright (C) 1998-1999, 2003, 2006, 2009-2012 Free Software Foundation,
Inc.
This program is free software: you can redistribute it and/or modify
@@ -23,7 +23,7 @@
/* Get the declaration of strmode. */
# if HAVE_DECL_STRMODE
-# include <string.h> /* MacOS X, FreeBSD, OpenBSD */
+# include <string.h> /* Mac OS X, FreeBSD, OpenBSD */
# include <unistd.h> /* NetBSD */
# endif
diff --git a/lib/fpending.c b/lib/fpending.c
new file mode 100644
index 00000000000..2591d534377
--- /dev/null
+++ b/lib/fpending.c
@@ -0,0 +1,30 @@
+/* fpending.c -- return the number of pending output bytes on a stream
+ Copyright (C) 2000, 2004, 2006-2007, 2009-2012 Free Software Foundation,
+ Inc.
+
+ 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/>. */
+
+/* Written by Jim Meyering. */
+
+#include <config.h>
+
+#include "fpending.h"
+
+/* Return the number of pending (aka buffered, unflushed)
+ bytes on the stream, FP, that is open for writing. */
+size_t
+__fpending (FILE *fp)
+{
+ return PENDING_OUTPUT_N_BYTES;
+}
diff --git a/lib/fpending.h b/lib/fpending.h
new file mode 100644
index 00000000000..0365287ba76
--- /dev/null
+++ b/lib/fpending.h
@@ -0,0 +1,30 @@
+/* Declare __fpending.
+
+ Copyright (C) 2000, 2003, 2005-2006, 2009-2012 Free Software Foundation,
+ Inc.
+
+ 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/>.
+
+ Written by Jim Meyering. */
+
+#include <stddef.h>
+#include <stdio.h>
+
+#if HAVE_DECL___FPENDING
+# if HAVE_STDIO_EXT_H
+# include <stdio_ext.h>
+# endif
+#else
+size_t __fpending (FILE *);
+#endif
diff --git a/lib/ftoastr.c b/lib/ftoastr.c
index 7c99ef00f38..ebeed3e1347 100644
--- a/lib/ftoastr.c
+++ b/lib/ftoastr.c
@@ -1,6 +1,6 @@
/* floating point to accurate string
- Copyright (C) 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2010-2012 Free Software Foundation, Inc.
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
@@ -29,7 +29,6 @@
#include "ftoastr.h"
-#include "intprops.h"
#include <float.h>
#include <stdio.h>
#include <stdlib.h>
diff --git a/lib/ftoastr.h b/lib/ftoastr.h
index 6264952e8e9..89869a2238f 100644
--- a/lib/ftoastr.h
+++ b/lib/ftoastr.h
@@ -1,6 +1,6 @@
/* floating point to accurate string
- Copyright (C) 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2010-2012 Free Software Foundation, Inc.
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
@@ -58,7 +58,7 @@ enum
FTOASTR_ALWAYS_SIGNED = 2,
/* Output " " before positive numbers; ignored if
- FTOASTER_ALWAYS_SIGNED is also given. */
+ FTOASTR_ALWAYS_SIGNED is also given. */
FTOASTR_SPACE_POSITIVE = 4,
/* Pad with zeros instead of spaces; ignored if FTOASTR_LEFT_JUSTIFY
diff --git a/lib/getgroups.c b/lib/getgroups.c
new file mode 100644
index 00000000000..f9d36236afe
--- /dev/null
+++ b/lib/getgroups.c
@@ -0,0 +1,116 @@
+/* provide consistent interface to getgroups for systems that don't allow N==0
+
+ Copyright (C) 1996, 1999, 2003, 2006-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* written by Jim Meyering */
+
+#include <config.h>
+
+#include <unistd.h>
+
+#include <errno.h>
+#include <stdlib.h>
+#include <stdint.h>
+
+#if !HAVE_GETGROUPS
+
+/* Provide a stub that fails with ENOSYS, since there is no group
+ information available on mingw. */
+int
+getgroups (int n _GL_UNUSED, GETGROUPS_T *groups _GL_UNUSED)
+{
+ errno = ENOSYS;
+ return -1;
+}
+
+#else /* HAVE_GETGROUPS */
+
+# undef getgroups
+# ifndef GETGROUPS_ZERO_BUG
+# define GETGROUPS_ZERO_BUG 0
+# endif
+
+/* On at least Ultrix 4.3 and NextStep 3.2, getgroups (0, NULL) always
+ fails. On other systems, it returns the number of supplemental
+ groups for the process. This function handles that special case
+ and lets the system-provided function handle all others. However,
+ it can fail with ENOMEM if memory is tight. It is unspecified
+ whether the effective group id is included in the list. */
+
+int
+rpl_getgroups (int n, gid_t *group)
+{
+ int n_groups;
+ GETGROUPS_T *gbuf;
+ int saved_errno;
+
+ if (n < 0)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+
+ if (n != 0 || !GETGROUPS_ZERO_BUG)
+ {
+ int result;
+ if (sizeof *group == sizeof *gbuf)
+ return getgroups (n, (GETGROUPS_T *) group);
+
+ if (SIZE_MAX / sizeof *gbuf <= n)
+ {
+ errno = ENOMEM;
+ return -1;
+ }
+ gbuf = malloc (n * sizeof *gbuf);
+ if (!gbuf)
+ return -1;
+ result = getgroups (n, gbuf);
+ if (0 <= result)
+ {
+ n = result;
+ while (n--)
+ group[n] = gbuf[n];
+ }
+ saved_errno = errno;
+ free (gbuf);
+ errno == saved_errno;
+ return result;
+ }
+
+ n = 20;
+ while (1)
+ {
+ /* No need to worry about address arithmetic overflow here,
+ since the ancient systems that we're running on have low
+ limits on the number of secondary groups. */
+ gbuf = malloc (n * sizeof *gbuf);
+ if (!gbuf)
+ return -1;
+ n_groups = getgroups (n, gbuf);
+ if (n_groups == -1 ? errno != EINVAL : n_groups < n)
+ break;
+ free (gbuf);
+ n *= 2;
+ }
+
+ saved_errno = errno;
+ free (gbuf);
+ errno = saved_errno;
+
+ return n_groups;
+}
+
+#endif /* HAVE_GETGROUPS */
diff --git a/lib/getloadavg.c b/lib/getloadavg.c
index d324451ef15..a8ffefee33f 100644
--- a/lib/getloadavg.c
+++ b/lib/getloadavg.c
@@ -1,6 +1,6 @@
/* Get the system load averages.
- Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2011 Free Software
+ Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2012 Free Software
Foundation, Inc.
NOTE: The canonical source of this file is maintained with gnulib.
@@ -28,7 +28,7 @@
macro that comes with autoconf 2.13 or newer.
If that isn't an option, then just put
AC_CHECK_FUNCS(pstat_getdynamic) in your
- configure.in file.
+ configure.ac file.
HAVE_LIBPERFSTAT Define this if your system has the
perfstat_cpu_total function in libperfstat (AIX).
FIXUP_KERNEL_SYMBOL_ADDR() Adjust address in returned struct nlist.
@@ -46,7 +46,7 @@
NLIST_STRUCT Include nlist.h, not a.out.h.
N_NAME_POINTER The nlist n_name element is a pointer,
not an array.
- HAVE_STRUCT_NLIST_N_UN_N_NAME `n_un.n_name' is member of `struct nlist'.
+ HAVE_STRUCT_NLIST_N_UN_N_NAME 'n_un.n_name' is member of 'struct nlist'.
LINUX_LDAV_FILE [__linux__, __CYGWIN__]: File containing
load averages.
@@ -80,45 +80,23 @@
We also #define LDAV_PRIVILEGED if a program will require
special installation to be able to call getloadavg. */
-/* "configure" defines CONFIGURING_GETLOADAVG to sidestep problems
- with partially-configured source directories. */
-
-#ifndef CONFIGURING_GETLOADAVG
-# include <config.h>
-# include <stdbool.h>
-#endif
+#include <config.h>
/* Specification. */
#include <stdlib.h>
#include <errno.h>
+#include <stdbool.h>
#include <stdio.h>
# include <sys/types.h>
-/* Both the Emacs and non-Emacs sections want this. Some
- configuration files' definitions for the LOAD_AVE_CVT macro (like
- sparc.h's) use macros like FSCALE, defined here. */
-# if defined (unix) || defined (__unix)
+# if HAVE_SYS_PARAM_H
# include <sys/param.h>
# endif
# include "intprops.h"
-/* The existing Emacs configuration files define a macro called
- LOAD_AVE_CVT, which accepts a value of type LOAD_AVE_TYPE, and
- returns the load average multiplied by 100. What we actually want
- is a macro called LDAV_CVT, which returns the load average as an
- unmultiplied double.
-
- For backwards compatibility, we'll define LDAV_CVT in terms of
- LOAD_AVE_CVT, but future machine config files should just define
- LDAV_CVT directly. */
-
-# if !defined (LDAV_CVT) && defined (LOAD_AVE_CVT)
-# define LDAV_CVT(n) (LOAD_AVE_CVT (n) / 100.0)
-# endif
-
# if !defined (BSD) && defined (ultrix)
/* Ultrix behaves like BSD on Vaxen. */
# define BSD
@@ -794,7 +772,7 @@ getloadavg (double loadavg[], int nelem)
# define LDAV_DONE
/* This call can return -1 for an error, but with good args
it's not supposed to fail. The first argument is for no
- apparent reason of type `long int *'. */
+ apparent reason of type 'long int *'. */
dg_sys_info ((long int *) &load_info,
DG_SYS_INFO_LOAD_INFO_TYPE,
DG_SYS_INFO_LOAD_VERSION_0);
diff --git a/lib/getopt.c b/lib/getopt.c
index 7c9f7040612..4342a34104c 100644
--- a/lib/getopt.c
+++ b/lib/getopt.c
@@ -2,7 +2,7 @@
NOTE: getopt is part of the C library, so if you don't know what
"Keep this file name-space clean" means, talk to drepper@gnu.org
before changing it!
- Copyright (C) 1987-1996, 1998-2004, 2006, 2008-2011 Free Software
+ Copyright (C) 1987-1996, 1998-2004, 2006, 2008-2012 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
@@ -41,15 +41,15 @@
# include <wchar.h>
#endif
-/* This version of `getopt' appears to the caller like standard Unix `getopt'
+/* This version of 'getopt' appears to the caller like standard Unix 'getopt'
but it behaves differently for the user, since it allows the user
to intersperse the options with the other arguments.
- As `getopt_long' works, it permutes the elements of ARGV so that,
+ As 'getopt_long' works, it permutes the elements of ARGV so that,
when it is done, all the options precede everything else. Thus
all application programs are extended to handle flexible argument order.
- Using `getopt' or setting the environment variable POSIXLY_CORRECT
+ Using 'getopt' or setting the environment variable POSIXLY_CORRECT
disables permutation.
Then the behavior is completely standard.
@@ -58,24 +58,24 @@
#include "getopt_int.h"
-/* For communication from `getopt' to the caller.
- When `getopt' finds an option that takes an argument,
+/* For communication from 'getopt' to the caller.
+ When 'getopt' finds an option that takes an argument,
the argument value is returned here.
- Also, when `ordering' is RETURN_IN_ORDER,
+ Also, when 'ordering' is RETURN_IN_ORDER,
each non-option ARGV-element is returned here. */
char *optarg;
/* Index in ARGV of the next element to be scanned.
This is used for communication to and from the caller
- and for communication between successive calls to `getopt'.
+ and for communication between successive calls to 'getopt'.
- On entry to `getopt', zero means this is the first call; initialize.
+ On entry to 'getopt', zero means this is the first call; initialize.
- When `getopt' returns -1, this is the index of the first of the
+ When 'getopt' returns -1, this is the index of the first of the
non-option elements that the caller should itself scan.
- Otherwise, `optind' communicates from one call to the next
+ Otherwise, 'optind' communicates from one call to the next
how much of ARGV has been scanned so far. */
/* 1003.2 says this must be 1 before any call. */
@@ -137,7 +137,7 @@ extern char *__getopt_nonoption_flags;
The other is elements [last_nonopt,optind), which contains all
the options processed since those non-options were skipped.
- `first_nonopt' and `last_nonopt' are relocated so that they describe
+ 'first_nonopt' and 'last_nonopt' are relocated so that they describe
the new indices of the non-options in ARGV after they are moved. */
static void
@@ -154,7 +154,7 @@ exchange (char **argv, struct _getopt_data *d)
but it consists of two parts that need to be swapped next. */
#if defined _LIBC && defined USE_NONOPTION_FLAGS
- /* First make sure the handling of the `__getopt_nonoption_flags'
+ /* First make sure the handling of the '__getopt_nonoption_flags'
string can work normally. Our top argument must be in the range
of the string. */
if (d->__nonoption_flags_len > 0 && top >= d->__nonoption_flags_max_len)
@@ -291,48 +291,48 @@ _getopt_initialize (int argc _GL_UNUSED,
If an element of ARGV starts with '-', and is not exactly "-" or "--",
then it is an option element. The characters of this element
- (aside from the initial '-') are option characters. If `getopt'
+ (aside from the initial '-') are option characters. If 'getopt'
is called repeatedly, it returns successively each of the option characters
from each of the option elements.
- If `getopt' finds another option character, it returns that character,
- updating `optind' and `nextchar' so that the next call to `getopt' can
+ If 'getopt' finds another option character, it returns that character,
+ updating 'optind' and 'nextchar' so that the next call to 'getopt' can
resume the scan with the following option character or ARGV-element.
- If there are no more option characters, `getopt' returns -1.
- Then `optind' is the index in ARGV of the first ARGV-element
+ If there are no more option characters, 'getopt' returns -1.
+ Then 'optind' is the index in ARGV of the first ARGV-element
that is not an option. (The ARGV-elements have been permuted
so that those that are not options now come last.)
OPTSTRING is a string containing the legitimate option characters.
If an option character is seen that is not listed in OPTSTRING,
- return '?' after printing an error message. If you set `opterr' to
+ return '?' after printing an error message. If you set 'opterr' to
zero, the error message is suppressed but we still return '?'.
If a char in OPTSTRING is followed by a colon, that means it wants an arg,
so the following text in the same ARGV-element, or the text of the following
- ARGV-element, is returned in `optarg'. Two colons mean an option that
+ ARGV-element, is returned in 'optarg'. Two colons mean an option that
wants an optional arg; if there is text in the current ARGV-element,
- it is returned in `optarg', otherwise `optarg' is set to zero.
+ it is returned in 'optarg', otherwise 'optarg' is set to zero.
- If OPTSTRING starts with `-' or `+', it requests different methods of
+ If OPTSTRING starts with '-' or '+', it requests different methods of
handling the non-option ARGV-elements.
See the comments about RETURN_IN_ORDER and REQUIRE_ORDER, above.
- Long-named options begin with `--' instead of `-'.
+ Long-named options begin with '--' instead of '-'.
Their names may be abbreviated as long as the abbreviation is unique
or is an exact match for some defined option. If they have an
argument, it follows the option name in the same ARGV-element, separated
- from the option name by a `=', or else the in next ARGV-element.
- When `getopt' finds a long-named option, it returns 0 if that option's
- `flag' field is nonzero, the value of the option's `val' field
- if the `flag' field is zero.
+ from the option name by a '=', or else the in next ARGV-element.
+ When 'getopt' finds a long-named option, it returns 0 if that option's
+ 'flag' field is nonzero, the value of the option's 'val' field
+ if the 'flag' field is zero.
The elements of ARGV aren't really const, because we permute them.
But we pretend they're const in the prototype to be compatible
with other systems.
- LONGOPTS is a vector of `struct option' terminated by an
+ LONGOPTS is a vector of 'struct option' terminated by an
element containing a name which is zero.
LONGIND returns the index in LONGOPT of the long-named option found.
@@ -409,7 +409,7 @@ _getopt_internal_r (int argc, char **argv, const char *optstring,
d->__last_nonopt = d->optind;
}
- /* The special ARGV-element `--' means premature end of options.
+ /* The special ARGV-element '--' means premature end of options.
Skip it like a null option,
then exchange with previous non-options as if it were an option,
then skip everything else like a non-option. */
@@ -788,7 +788,7 @@ _getopt_internal_r (int argc, char **argv, const char *optstring,
char c = *d->__nextchar++;
const char *temp = strchr (optstring, c);
- /* Increment `optind' when we start to process its last character. */
+ /* Increment 'optind' when we start to process its last character. */
if (*d->__nextchar == '\0')
++d->optind;
@@ -887,7 +887,7 @@ _getopt_internal_r (int argc, char **argv, const char *optstring,
return c;
}
else
- /* We already incremented `d->optind' once;
+ /* We already incremented 'd->optind' once;
increment it again when taking next ARGV-elt as argument. */
d->optarg = argv[d->optind++];
@@ -1114,7 +1114,7 @@ _getopt_internal_r (int argc, char **argv, const char *optstring,
c = '?';
}
else
- /* We already incremented `optind' once;
+ /* We already incremented 'optind' once;
increment it again when taking next ARGV-elt as argument. */
d->optarg = argv[d->optind++];
d->__nextchar = NULL;
@@ -1177,7 +1177,7 @@ __posix_getopt (int argc, char *const *argv, const char *optstring)
#ifdef TEST
/* Compile with -DTEST to make an executable for use in testing
- the above definition of `getopt'. */
+ the above definition of 'getopt'. */
int
main (int argc, char **argv)
diff --git a/lib/getopt.in.h b/lib/getopt.in.h
index 0f3918ab771..06b6dfc50c2 100644
--- a/lib/getopt.in.h
+++ b/lib/getopt.in.h
@@ -1,5 +1,5 @@
/* Declarations for getopt.
- Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2007, 2009-2011 Free Software
+ Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2007, 2009-2012 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
@@ -82,7 +82,7 @@
getopt_long_only can permute argv; this is required for backward
compatibility (e.g., for LSB 2.0.1).
- This used to be `#if defined __GETOPT_PREFIX && !defined __need_getopt',
+ This used to be '#if defined __GETOPT_PREFIX && !defined __need_getopt',
but it caused redefinition warnings if both unistd.h and getopt.h were
included, since unistd.h includes getopt.h having previously defined
__need_getopt.
@@ -128,29 +128,29 @@
extern "C" {
#endif
-/* For communication from `getopt' to the caller.
- When `getopt' finds an option that takes an argument,
+/* For communication from 'getopt' to the caller.
+ When 'getopt' finds an option that takes an argument,
the argument value is returned here.
- Also, when `ordering' is RETURN_IN_ORDER,
+ Also, when 'ordering' is RETURN_IN_ORDER,
each non-option ARGV-element is returned here. */
extern char *optarg;
/* Index in ARGV of the next element to be scanned.
This is used for communication to and from the caller
- and for communication between successive calls to `getopt'.
+ and for communication between successive calls to 'getopt'.
- On entry to `getopt', zero means this is the first call; initialize.
+ On entry to 'getopt', zero means this is the first call; initialize.
- When `getopt' returns -1, this is the index of the first of the
+ When 'getopt' returns -1, this is the index of the first of the
non-option elements that the caller should itself scan.
- Otherwise, `optind' communicates from one call to the next
+ Otherwise, 'optind' communicates from one call to the next
how much of ARGV has been scanned so far. */
extern int optind;
-/* Callers store zero here to inhibit the error message `getopt' prints
+/* Callers store zero here to inhibit the error message 'getopt' prints
for unrecognized options. */
extern int opterr;
@@ -162,24 +162,24 @@ extern int optopt;
#ifndef __need_getopt
/* Describe the long-named options requested by the application.
The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector
- of `struct option' terminated by an element containing a name which is
+ of 'struct option' terminated by an element containing a name which is
zero.
- The field `has_arg' is:
+ The field 'has_arg' is:
no_argument (or 0) if the option does not take an argument,
required_argument (or 1) if the option requires an argument,
optional_argument (or 2) if the option takes an optional argument.
- If the field `flag' is not NULL, it points to a variable that is set
- to the value given in the field `val' when the option is found, but
+ If the field 'flag' is not NULL, it points to a variable that is set
+ to the value given in the field 'val' when the option is found, but
left unchanged if the option is not found.
- To have a long-named option do something other than set an `int' to
- a compiled-in constant, such as set a value from `optarg', set the
- option's `flag' field to zero and its `val' field to a nonzero
+ To have a long-named option do something other than set an 'int' to
+ a compiled-in constant, such as set a value from 'optarg', set the
+ option's 'flag' field to zero and its 'val' field to a nonzero
value (the equivalent single-letter option character, if there is
- one). For long options that have a zero `flag' field, `getopt'
- returns the contents of the `val' field. */
+ one). For long options that have a zero 'flag' field, 'getopt'
+ returns the contents of the 'val' field. */
# if !GNULIB_defined_struct_option
struct option
@@ -194,7 +194,7 @@ struct option
# define GNULIB_defined_struct_option 1
# endif
-/* Names for the values of the `has_arg' field of `struct option'. */
+/* Names for the values of the 'has_arg' field of 'struct option'. */
# define no_argument 0
# define required_argument 1
@@ -208,23 +208,23 @@ struct option
Return the option character from OPTS just read. Return -1 when
there are no more options. For unrecognized options, or options
- missing arguments, `optopt' is set to the option letter, and '?' is
+ missing arguments, 'optopt' is set to the option letter, and '?' is
returned.
The OPTS string is a list of characters which are recognized option
letters, optionally followed by colons, specifying that that letter
- takes an argument, to be placed in `optarg'.
+ takes an argument, to be placed in 'optarg'.
If a letter in OPTS is followed by two colons, its argument is
- optional. This behavior is specific to the GNU `getopt'.
+ optional. This behavior is specific to the GNU 'getopt'.
- The argument `--' causes premature termination of argument
- scanning, explicitly telling `getopt' that there are no more
+ The argument '--' causes premature termination of argument
+ scanning, explicitly telling 'getopt' that there are no more
options.
- If OPTS begins with `-', then non-option arguments are treated as
+ If OPTS begins with '-', then non-option arguments are treated as
arguments to the option '\1'. This behavior is specific to the GNU
- `getopt'. If OPTS begins with `+', or POSIXLY_CORRECT is set in
+ 'getopt'. If OPTS begins with '+', or POSIXLY_CORRECT is set in
the environment, then do not permute arguments. */
extern int getopt (int ___argc, char *const *___argv, const char *__shortopts)
diff --git a/lib/getopt1.c b/lib/getopt1.c
index 36568024cc2..fb2a8f5a7b1 100644
--- a/lib/getopt1.c
+++ b/lib/getopt1.c
@@ -1,5 +1,5 @@
/* getopt_long and getopt_long_only entry points for GNU getopt.
- Copyright (C) 1987-1994, 1996-1998, 2004, 2006, 2009-2011 Free Software
+ Copyright (C) 1987-1994, 1996-1998, 2004, 2006, 2009-2012 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
@@ -141,11 +141,11 @@ main (int argc, char **argv)
break;
case 'c':
- printf ("option c with value `%s'\n", optarg);
+ printf ("option c with value '%s'\n", optarg);
break;
case 'd':
- printf ("option d with value `%s'\n", optarg);
+ printf ("option d with value '%s'\n", optarg);
break;
case '?':
diff --git a/lib/getopt_.h b/lib/getopt_.h
index e0923962b4f..d69f57b9cf7 100644
--- a/lib/getopt_.h
+++ b/lib/getopt_.h
@@ -1,283 +1,283 @@
-/* Declarations for getopt.
- Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2007, 2009-2011 Free Software
- Foundation, Inc.
- This file is part of the GNU C Library.
-
- 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/>. */
-
-#ifndef _GL_GETOPT_H
-
-#if __GNUC__ >= 3
-#pragma GCC system_header
-#endif
-
-
-/* The include_next requires a split double-inclusion guard. We must
- also inform the replacement unistd.h to not recursively use
- <getopt.h>; our definitions will be present soon enough. */
-#if HAVE_GETOPT_H
-# define _GL_SYSTEM_GETOPT
-# ifndef __GNUC__
-# include <next_getopt.h>
-# else
-# include_next <getopt.h>
-# endif
-# undef _GL_SYSTEM_GETOPT
-#endif
-
-#ifndef _GL_GETOPT_H
-
-#ifndef __need_getopt
-# define _GL_GETOPT_H 1
-#endif
-
-/* Standalone applications should #define __GETOPT_PREFIX to an
- identifier that prefixes the external functions and variables
- defined in this header. When this happens, include the
- headers that might declare getopt so that they will not cause
- confusion if included after this file (if the system had <getopt.h>,
- we have already included it). Then systematically rename
- identifiers so that they do not collide with the system functions
- and variables. Renaming avoids problems with some compilers and
- linkers. */
-#if defined __GETOPT_PREFIX && !defined __need_getopt
-# if !HAVE_GETOPT_H
-# include <stdlib.h>
-# include <stdio.h>
-# include <unistd.h>
-# endif
-# undef __need_getopt
-# undef getopt
-# undef getopt_long
-# undef getopt_long_only
-# undef optarg
-# undef opterr
-# undef optind
-# undef optopt
-# undef option
-# define __GETOPT_CONCAT(x, y) x ## y
-# define __GETOPT_XCONCAT(x, y) __GETOPT_CONCAT (x, y)
-# define __GETOPT_ID(y) __GETOPT_XCONCAT (__GETOPT_PREFIX, y)
-# define getopt __GETOPT_ID (getopt)
-# define getopt_long __GETOPT_ID (getopt_long)
-# define getopt_long_only __GETOPT_ID (getopt_long_only)
-# define optarg __GETOPT_ID (optarg)
-# define opterr __GETOPT_ID (opterr)
-# define optind __GETOPT_ID (optind)
-# define optopt __GETOPT_ID (optopt)
-# define option __GETOPT_ID (option)
-# define _getopt_internal __GETOPT_ID (getopt_internal)
-#endif
-
-/* Standalone applications get correct prototypes for getopt_long and
- getopt_long_only; they declare "char **argv". libc uses prototypes
- with "char *const *argv" that are incorrect because getopt_long and
- getopt_long_only can permute argv; this is required for backward
- compatibility (e.g., for LSB 2.0.1).
-
- This used to be `#if defined __GETOPT_PREFIX && !defined __need_getopt',
- but it caused redefinition warnings if both unistd.h and getopt.h were
- included, since unistd.h includes getopt.h having previously defined
- __need_getopt.
-
- The only place where __getopt_argv_const is used is in definitions
- of getopt_long and getopt_long_only below, but these are visible
- only if __need_getopt is not defined, so it is quite safe to rewrite
- the conditional as follows:
-*/
-#if !defined __need_getopt
-# if defined __GETOPT_PREFIX
-# define __getopt_argv_const /* empty */
-# else
-# define __getopt_argv_const const
-# endif
-#endif
-
-/* If __GNU_LIBRARY__ is not already defined, either we are being used
- standalone, or this is the first header included in the source file.
- If we are being used with glibc, we need to include <features.h>, but
- that does not exist if we are standalone. So: if __GNU_LIBRARY__ is
- not defined, include <ctype.h>, which will pull in <features.h> for us
- if it's from glibc. (Why ctype.h? It's guaranteed to exist and it
- doesn't flood the namespace with stuff the way some other headers do.) */
-#if !defined __GNU_LIBRARY__
-# include <ctype.h>
-#endif
-
-#ifndef __THROW
-# ifndef __GNUC_PREREQ
-# define __GNUC_PREREQ(maj, min) (0)
-# endif
-# if defined __cplusplus && __GNUC_PREREQ (2,8)
-# define __THROW throw ()
-# else
-# define __THROW
-# endif
-#endif
-
-/* The definition of _GL_ARG_NONNULL is copied here. */
-/* A C macro for declaring that specific arguments must not be NULL.
- Copyright (C) 2009-2011 Free Software Foundation, Inc.
-
- 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/>. */
-
-/* _GL_ARG_NONNULL((n,...,m)) tells the compiler and static analyzer tools
- that the values passed as arguments n, ..., m must be non-NULL pointers.
- n = 1 stands for the first argument, n = 2 for the second argument etc. */
-#ifndef _GL_ARG_NONNULL
-# if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || __GNUC__ > 3
-# define _GL_ARG_NONNULL(params) __attribute__ ((__nonnull__ params))
-# else
-# define _GL_ARG_NONNULL(params)
-# endif
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* For communication from `getopt' to the caller.
- When `getopt' finds an option that takes an argument,
- the argument value is returned here.
- Also, when `ordering' is RETURN_IN_ORDER,
- each non-option ARGV-element is returned here. */
-
-extern char *optarg;
-
-/* Index in ARGV of the next element to be scanned.
- This is used for communication to and from the caller
- and for communication between successive calls to `getopt'.
-
- On entry to `getopt', zero means this is the first call; initialize.
-
- When `getopt' returns -1, this is the index of the first of the
- non-option elements that the caller should itself scan.
-
- Otherwise, `optind' communicates from one call to the next
- how much of ARGV has been scanned so far. */
-
-extern int optind;
-
-/* Callers store zero here to inhibit the error message `getopt' prints
- for unrecognized options. */
-
-extern int opterr;
-
-/* Set to an option character which was unrecognized. */
-
-extern int optopt;
-
-#ifndef __need_getopt
-/* Describe the long-named options requested by the application.
- The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector
- of `struct option' terminated by an element containing a name which is
- zero.
-
- The field `has_arg' is:
- no_argument (or 0) if the option does not take an argument,
- required_argument (or 1) if the option requires an argument,
- optional_argument (or 2) if the option takes an optional argument.
-
- If the field `flag' is not NULL, it points to a variable that is set
- to the value given in the field `val' when the option is found, but
- left unchanged if the option is not found.
-
- To have a long-named option do something other than set an `int' to
- a compiled-in constant, such as set a value from `optarg', set the
- option's `flag' field to zero and its `val' field to a nonzero
- value (the equivalent single-letter option character, if there is
- one). For long options that have a zero `flag' field, `getopt'
- returns the contents of the `val' field. */
-
-# if !GNULIB_defined_struct_option
-struct option
-{
- const char *name;
- /* has_arg can't be an enum because some compilers complain about
- type mismatches in all the code that assumes it is an int. */
- int has_arg;
- int *flag;
- int val;
-};
-# define GNULIB_defined_struct_option 1
-# endif
-
-/* Names for the values of the `has_arg' field of `struct option'. */
-
-# define no_argument 0
-# define required_argument 1
-# define optional_argument 2
-#endif /* need getopt */
-
-
-/* Get definitions and prototypes for functions to process the
- arguments in ARGV (ARGC of them, minus the program name) for
- options given in OPTS.
-
- Return the option character from OPTS just read. Return -1 when
- there are no more options. For unrecognized options, or options
- missing arguments, `optopt' is set to the option letter, and '?' is
- returned.
-
- The OPTS string is a list of characters which are recognized option
- letters, optionally followed by colons, specifying that that letter
- takes an argument, to be placed in `optarg'.
-
- If a letter in OPTS is followed by two colons, its argument is
- optional. This behavior is specific to the GNU `getopt'.
-
- The argument `--' causes premature termination of argument
- scanning, explicitly telling `getopt' that there are no more
- options.
-
- If OPTS begins with `-', then non-option arguments are treated as
- arguments to the option '\1'. This behavior is specific to the GNU
- `getopt'. If OPTS begins with `+', or POSIXLY_CORRECT is set in
- the environment, then do not permute arguments. */
-
-extern int getopt (int ___argc, char *const *___argv, const char *__shortopts)
- __THROW _GL_ARG_NONNULL ((2, 3));
-
-#ifndef __need_getopt
-extern int getopt_long (int ___argc, char *__getopt_argv_const *___argv,
- const char *__shortopts,
- const struct option *__longopts, int *__longind)
- __THROW _GL_ARG_NONNULL ((2, 3));
-extern int getopt_long_only (int ___argc, char *__getopt_argv_const *___argv,
- const char *__shortopts,
- const struct option *__longopts, int *__longind)
- __THROW _GL_ARG_NONNULL ((2, 3));
-
-#endif
-
-#ifdef __cplusplus
-}
-#endif
-
-/* Make sure we later can get all the definitions and declarations. */
-#undef __need_getopt
-
-#endif /* _GL_GETOPT_H */
-#endif /* _GL_GETOPT_H */
+/* Declarations for getopt.
+ Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2007, 2009-2012 Free Software
+ Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ 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/>. */
+
+#ifndef _GL_GETOPT_H
+
+#if __GNUC__ >= 3
+#pragma GCC system_header
+#endif
+
+
+/* The include_next requires a split double-inclusion guard. We must
+ also inform the replacement unistd.h to not recursively use
+ <getopt.h>; our definitions will be present soon enough. */
+#if HAVE_GETOPT_H
+# define _GL_SYSTEM_GETOPT
+# ifndef __GNUC__
+# include <next_getopt.h>
+# else
+# include_next <getopt.h>
+# endif
+# undef _GL_SYSTEM_GETOPT
+#endif
+
+#ifndef _GL_GETOPT_H
+
+#ifndef __need_getopt
+# define _GL_GETOPT_H 1
+#endif
+
+/* Standalone applications should #define __GETOPT_PREFIX to an
+ identifier that prefixes the external functions and variables
+ defined in this header. When this happens, include the
+ headers that might declare getopt so that they will not cause
+ confusion if included after this file (if the system had <getopt.h>,
+ we have already included it). Then systematically rename
+ identifiers so that they do not collide with the system functions
+ and variables. Renaming avoids problems with some compilers and
+ linkers. */
+#if defined __GETOPT_PREFIX && !defined __need_getopt
+# if !HAVE_GETOPT_H
+# include <stdlib.h>
+# include <stdio.h>
+# include <unistd.h>
+# endif
+# undef __need_getopt
+# undef getopt
+# undef getopt_long
+# undef getopt_long_only
+# undef optarg
+# undef opterr
+# undef optind
+# undef optopt
+# undef option
+# define __GETOPT_CONCAT(x, y) x ## y
+# define __GETOPT_XCONCAT(x, y) __GETOPT_CONCAT (x, y)
+# define __GETOPT_ID(y) __GETOPT_XCONCAT (__GETOPT_PREFIX, y)
+# define getopt __GETOPT_ID (getopt)
+# define getopt_long __GETOPT_ID (getopt_long)
+# define getopt_long_only __GETOPT_ID (getopt_long_only)
+# define optarg __GETOPT_ID (optarg)
+# define opterr __GETOPT_ID (opterr)
+# define optind __GETOPT_ID (optind)
+# define optopt __GETOPT_ID (optopt)
+# define option __GETOPT_ID (option)
+# define _getopt_internal __GETOPT_ID (getopt_internal)
+#endif
+
+/* Standalone applications get correct prototypes for getopt_long and
+ getopt_long_only; they declare "char **argv". libc uses prototypes
+ with "char *const *argv" that are incorrect because getopt_long and
+ getopt_long_only can permute argv; this is required for backward
+ compatibility (e.g., for LSB 2.0.1).
+
+ This used to be '#if defined __GETOPT_PREFIX && !defined __need_getopt',
+ but it caused redefinition warnings if both unistd.h and getopt.h were
+ included, since unistd.h includes getopt.h having previously defined
+ __need_getopt.
+
+ The only place where __getopt_argv_const is used is in definitions
+ of getopt_long and getopt_long_only below, but these are visible
+ only if __need_getopt is not defined, so it is quite safe to rewrite
+ the conditional as follows:
+*/
+#if !defined __need_getopt
+# if defined __GETOPT_PREFIX
+# define __getopt_argv_const /* empty */
+# else
+# define __getopt_argv_const const
+# endif
+#endif
+
+/* If __GNU_LIBRARY__ is not already defined, either we are being used
+ standalone, or this is the first header included in the source file.
+ If we are being used with glibc, we need to include <features.h>, but
+ that does not exist if we are standalone. So: if __GNU_LIBRARY__ is
+ not defined, include <ctype.h>, which will pull in <features.h> for us
+ if it's from glibc. (Why ctype.h? It's guaranteed to exist and it
+ doesn't flood the namespace with stuff the way some other headers do.) */
+#if !defined __GNU_LIBRARY__
+# include <ctype.h>
+#endif
+
+#ifndef __THROW
+# ifndef __GNUC_PREREQ
+# define __GNUC_PREREQ(maj, min) (0)
+# endif
+# if defined __cplusplus && __GNUC_PREREQ (2,8)
+# define __THROW throw ()
+# else
+# define __THROW
+# endif
+#endif
+
+/* The definition of _GL_ARG_NONNULL is copied here. */
+/* A C macro for declaring that specific arguments must not be NULL.
+ Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* _GL_ARG_NONNULL((n,...,m)) tells the compiler and static analyzer tools
+ that the values passed as arguments n, ..., m must be non-NULL pointers.
+ n = 1 stands for the first argument, n = 2 for the second argument etc. */
+#ifndef _GL_ARG_NONNULL
+# if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || __GNUC__ > 3
+# define _GL_ARG_NONNULL(params) __attribute__ ((__nonnull__ params))
+# else
+# define _GL_ARG_NONNULL(params)
+# endif
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* For communication from 'getopt' to the caller.
+ When 'getopt' finds an option that takes an argument,
+ the argument value is returned here.
+ Also, when 'ordering' is RETURN_IN_ORDER,
+ each non-option ARGV-element is returned here. */
+
+extern char *optarg;
+
+/* Index in ARGV of the next element to be scanned.
+ This is used for communication to and from the caller
+ and for communication between successive calls to 'getopt'.
+
+ On entry to 'getopt', zero means this is the first call; initialize.
+
+ When 'getopt' returns -1, this is the index of the first of the
+ non-option elements that the caller should itself scan.
+
+ Otherwise, 'optind' communicates from one call to the next
+ how much of ARGV has been scanned so far. */
+
+extern int optind;
+
+/* Callers store zero here to inhibit the error message 'getopt' prints
+ for unrecognized options. */
+
+extern int opterr;
+
+/* Set to an option character which was unrecognized. */
+
+extern int optopt;
+
+#ifndef __need_getopt
+/* Describe the long-named options requested by the application.
+ The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector
+ of 'struct option' terminated by an element containing a name which is
+ zero.
+
+ The field 'has_arg' is:
+ no_argument (or 0) if the option does not take an argument,
+ required_argument (or 1) if the option requires an argument,
+ optional_argument (or 2) if the option takes an optional argument.
+
+ If the field 'flag' is not NULL, it points to a variable that is set
+ to the value given in the field 'val' when the option is found, but
+ left unchanged if the option is not found.
+
+ To have a long-named option do something other than set an 'int' to
+ a compiled-in constant, such as set a value from 'optarg', set the
+ option's 'flag' field to zero and its 'val' field to a nonzero
+ value (the equivalent single-letter option character, if there is
+ one). For long options that have a zero 'flag' field, 'getopt'
+ returns the contents of the 'val' field. */
+
+# if !GNULIB_defined_struct_option
+struct option
+{
+ const char *name;
+ /* has_arg can't be an enum because some compilers complain about
+ type mismatches in all the code that assumes it is an int. */
+ int has_arg;
+ int *flag;
+ int val;
+};
+# define GNULIB_defined_struct_option 1
+# endif
+
+/* Names for the values of the 'has_arg' field of 'struct option'. */
+
+# define no_argument 0
+# define required_argument 1
+# define optional_argument 2
+#endif /* need getopt */
+
+
+/* Get definitions and prototypes for functions to process the
+ arguments in ARGV (ARGC of them, minus the program name) for
+ options given in OPTS.
+
+ Return the option character from OPTS just read. Return -1 when
+ there are no more options. For unrecognized options, or options
+ missing arguments, 'optopt' is set to the option letter, and '?' is
+ returned.
+
+ The OPTS string is a list of characters which are recognized option
+ letters, optionally followed by colons, specifying that that letter
+ takes an argument, to be placed in 'optarg'.
+
+ If a letter in OPTS is followed by two colons, its argument is
+ optional. This behavior is specific to the GNU 'getopt'.
+
+ The argument '--' causes premature termination of argument
+ scanning, explicitly telling 'getopt' that there are no more
+ options.
+
+ If OPTS begins with '-', then non-option arguments are treated as
+ arguments to the option '\1'. This behavior is specific to the GNU
+ 'getopt'. If OPTS begins with '+', or POSIXLY_CORRECT is set in
+ the environment, then do not permute arguments. */
+
+extern int getopt (int ___argc, char *const *___argv, const char *__shortopts)
+ __THROW _GL_ARG_NONNULL ((2, 3));
+
+#ifndef __need_getopt
+extern int getopt_long (int ___argc, char *__getopt_argv_const *___argv,
+ const char *__shortopts,
+ const struct option *__longopts, int *__longind)
+ __THROW _GL_ARG_NONNULL ((2, 3));
+extern int getopt_long_only (int ___argc, char *__getopt_argv_const *___argv,
+ const char *__shortopts,
+ const struct option *__longopts, int *__longind)
+ __THROW _GL_ARG_NONNULL ((2, 3));
+
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+/* Make sure we later can get all the definitions and declarations. */
+#undef __need_getopt
+
+#endif /* _GL_GETOPT_H */
+#endif /* _GL_GETOPT_H */
diff --git a/lib/getopt_int.h b/lib/getopt_int.h
index 9f0c7131a14..2da020c995a 100644
--- a/lib/getopt_int.h
+++ b/lib/getopt_int.h
@@ -1,5 +1,5 @@
/* Internal declarations for getopt.
- Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2004, 2009-2011 Free Software
+ Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2004, 2009-2012 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
@@ -40,7 +40,7 @@ extern int _getopt_internal (int ___argc, char **___argv,
stop option processing when the first non-option is seen.
This is what Unix does.
This mode of operation is selected by either setting the environment
- variable POSIXLY_CORRECT, or using `+' as the first character
+ variable POSIXLY_CORRECT, or using '+' as the first character
of the list of option characters, or by calling getopt.
PERMUTE is the default. We permute the contents of ARGV as we
@@ -52,12 +52,12 @@ extern int _getopt_internal (int ___argc, char **___argv,
written to expect options and other ARGV-elements in any order
and that care about the ordering of the two. We describe each
non-option ARGV-element as if it were the argument of an option
- with character code 1. Using `-' as the first character of the
+ with character code 1. Using '-' as the first character of the
list of option characters selects this mode of operation.
- The special argument `--' forces an end of option-scanning regardless
- of the value of `ordering'. In the case of RETURN_IN_ORDER, only
- `--' can cause `getopt' to return -1 with `optind' != ARGC. */
+ The special argument '--' forces an end of option-scanning regardless
+ of the value of 'ordering'. In the case of RETURN_IN_ORDER, only
+ '--' can cause 'getopt' to return -1 with 'optind' != ARGC. */
enum __ord
{
@@ -99,8 +99,8 @@ struct _getopt_data
/* Handle permutation of arguments. */
/* Describe the part of ARGV that contains non-options that have
- been skipped. `first_nonopt' is the index in ARGV of the first
- of them; `last_nonopt' is the index after the last of them. */
+ been skipped. 'first_nonopt' is the index in ARGV of the first
+ of them; 'last_nonopt' is the index after the last of them. */
int __first_nonopt;
int __last_nonopt;
diff --git a/lib/gettext.h b/lib/gettext.h
index 458e3322177..65ca1e6762e 100644
--- a/lib/gettext.h
+++ b/lib/gettext.h
@@ -1,5 +1,5 @@
/* Convenience header for conditional use of GNU <libintl.h>.
- Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2011 Free Software
+ Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2012 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
@@ -13,8 +13,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ with this program; if not, see <http://www.gnu.org/licenses/>. */
#ifndef _LIBGETTEXT_H
#define _LIBGETTEXT_H 1
@@ -184,9 +183,12 @@ npgettext_aux (const char *domain,
#include <string.h>
-#define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS \
- (((__GNUC__ >= 3 || __GNUG__ >= 2) && !__STRICT_ANSI__) \
- /* || __STDC_VERSION__ >= 199901L */ )
+#if (((__GNUC__ >= 3 || __GNUG__ >= 2) && !defined __STRICT_ANSI__) \
+ /* || __STDC_VERSION__ >= 199901L */ )
+# define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS 1
+#else
+# define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS 0
+#endif
#if !_LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS
#include <stdlib.h>
diff --git a/lib/gettime.c b/lib/gettime.c
new file mode 100644
index 00000000000..8075bfaf999
--- /dev/null
+++ b/lib/gettime.c
@@ -0,0 +1,48 @@
+/* gettime -- get the system clock
+
+ Copyright (C) 2002, 2004-2007, 2009-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* Written by Paul Eggert. */
+
+#include <config.h>
+
+#include "timespec.h"
+
+#include <sys/time.h>
+
+/* Get the system time into *TS. */
+
+void
+gettime (struct timespec *ts)
+{
+#if HAVE_NANOTIME
+ nanotime (ts);
+#else
+
+# if defined CLOCK_REALTIME && HAVE_CLOCK_GETTIME
+ if (clock_gettime (CLOCK_REALTIME, ts) == 0)
+ return;
+# endif
+
+ {
+ struct timeval tv;
+ gettimeofday (&tv, NULL);
+ ts->tv_sec = tv.tv_sec;
+ ts->tv_nsec = tv.tv_usec * 1000;
+ }
+
+#endif
+}
diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c
new file mode 100644
index 00000000000..5d35060950a
--- /dev/null
+++ b/lib/gettimeofday.c
@@ -0,0 +1,154 @@
+/* Provide gettimeofday for systems that don't have it or for which it's broken.
+
+ Copyright (C) 2001-2003, 2005-2007, 2009-2012 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+/* written by Jim Meyering */
+
+#include <config.h>
+
+/* Specification. */
+#include <sys/time.h>
+
+#include <time.h>
+
+#if HAVE_SYS_TIMEB_H
+# include <sys/timeb.h>
+#endif
+
+#if GETTIMEOFDAY_CLOBBERS_LOCALTIME || TZSET_CLOBBERS_LOCALTIME
+
+/* Work around the bug in some systems whereby gettimeofday clobbers
+ the static buffer that localtime uses for its return value. The
+ gettimeofday function from Mac OS X 10.0.4 (i.e., Darwin 1.3.7) has
+ this problem. The tzset replacement is necessary for at least
+ Solaris 2.5, 2.5.1, and 2.6. */
+
+static struct tm tm_zero_buffer;
+static struct tm *localtime_buffer_addr = &tm_zero_buffer;
+
+# undef localtime
+extern struct tm *localtime (time_t const *);
+
+# undef gmtime
+extern struct tm *gmtime (time_t const *);
+
+/* This is a wrapper for localtime. It is used only on systems for which
+ gettimeofday clobbers the static buffer used for localtime's result.
+
+ On the first call, record the address of the static buffer that
+ localtime uses for its result. */
+
+struct tm *
+rpl_localtime (time_t const *timep)
+{
+ struct tm *tm = localtime (timep);
+
+ if (localtime_buffer_addr == &tm_zero_buffer)
+ localtime_buffer_addr = tm;
+
+ return tm;
+}
+
+/* Same as above, since gmtime and localtime use the same buffer. */
+struct tm *
+rpl_gmtime (time_t const *timep)
+{
+ struct tm *tm = gmtime (timep);
+
+ if (localtime_buffer_addr == &tm_zero_buffer)
+ localtime_buffer_addr = tm;
+
+ return tm;
+}
+
+#endif /* GETTIMEOFDAY_CLOBBERS_LOCALTIME || TZSET_CLOBBERS_LOCALTIME */
+
+#if TZSET_CLOBBERS_LOCALTIME
+
+# undef tzset
+extern void tzset (void);
+
+/* This is a wrapper for tzset, for systems on which tzset may clobber
+ the static buffer used for localtime's result. */
+void
+rpl_tzset (void)
+{
+ /* Save and restore the contents of the buffer used for localtime's
+ result around the call to tzset. */
+ struct tm save = *localtime_buffer_addr;
+ tzset ();
+ *localtime_buffer_addr = save;
+}
+#endif
+
+/* This is a wrapper for gettimeofday. It is used only on systems
+ that lack this function, or whose implementation of this function
+ causes problems. */
+
+int
+gettimeofday (struct timeval *restrict tv, void *restrict tz)
+{
+#undef gettimeofday
+#if HAVE_GETTIMEOFDAY
+# if GETTIMEOFDAY_CLOBBERS_LOCALTIME
+ /* Save and restore the contents of the buffer used for localtime's
+ result around the call to gettimeofday. */
+ struct tm save = *localtime_buffer_addr;
+# endif
+
+# if defined timeval /* 'struct timeval' overridden by gnulib? */
+# undef timeval
+ struct timeval otv;
+ int result = gettimeofday (&otv, (struct timezone *) tz);
+ if (result == 0)
+ {
+ tv->tv_sec = otv.tv_sec;
+ tv->tv_usec = otv.tv_usec;
+ }
+# else
+ int result = gettimeofday (tv, (struct timezone *) tz);
+# endif
+
+# if GETTIMEOFDAY_CLOBBERS_LOCALTIME
+ *localtime_buffer_addr = save;
+# endif
+
+ return result;
+
+#else
+
+# if HAVE__FTIME
+
+ struct _timeb timebuf;
+ _ftime (&timebuf);
+ tv->tv_sec = timebuf.time;
+ tv->tv_usec = timebuf.millitm * 1000;
+
+# else
+
+# if !defined OK_TO_USE_1S_CLOCK
+# error "Only 1-second nominal clock resolution found. Is that intended?" \
+ "If so, compile with the -DOK_TO_USE_1S_CLOCK option."
+# endif
+ tv->tv_sec = time (NULL);
+ tv->tv_usec = 0;
+
+# endif
+
+ return 0;
+
+#endif
+}
diff --git a/lib/gnulib.mk b/lib/gnulib.mk
index 14010feb04b..834f63169e2 100644
--- a/lib/gnulib.mk
+++ b/lib/gnulib.mk
@@ -1,6 +1,6 @@
## DO NOT EDIT! GENERATED AUTOMATICALLY!
## Process this file with automake to produce Makefile.in.
-# Copyright (C) 2002-2011 Free Software Foundation, Inc.
+# Copyright (C) 2002-2012 Free Software Foundation, Inc.
#
# This file is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -21,7 +21,7 @@
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
-# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=msvc-inval --avoid=msvc-nothrow --avoid=pathmax --avoid=raise --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dup2 filemode getloadavg getopt-gnu ignore-value intprops lstat mktime pthread_sigmask readlink socklen stdarg stdio strftime strtoimax strtoumax symlink sys_stat
+# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=at-internal --avoid=errno --avoid=fchdir --avoid=fcntl --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=openat-die --avoid=openat-h --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl-h filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub utimens warnings
MOSTLYCLEANFILES += core *.stackdump
@@ -64,6 +64,18 @@ EXTRA_DIST += allocator.h
## end gnulib module allocator
+## begin gnulib module c-ctype
+
+libgnu_a_SOURCES += c-ctype.h c-ctype.c
+
+## end gnulib module c-ctype
+
+## begin gnulib module c-strcase
+
+libgnu_a_SOURCES += c-strcase.h c-strcasecmp.c c-strncasecmp.c
+
+## end gnulib module c-strcase
+
## begin gnulib module careadlinkat
libgnu_a_SOURCES += careadlinkat.c
@@ -72,6 +84,14 @@ EXTRA_DIST += careadlinkat.h
## end gnulib module careadlinkat
+## begin gnulib module close-stream
+
+libgnu_a_SOURCES += close-stream.c
+
+EXTRA_DIST += close-stream.h
+
+## end gnulib module close-stream
+
## begin gnulib module crypto/md5
libgnu_a_SOURCES += md5.c
@@ -123,6 +143,12 @@ EXTRA_libgnu_a_SOURCES += ftoastr.c
## end gnulib module dtoastr
+## begin gnulib module dtotimespec
+
+libgnu_a_SOURCES += dtotimespec.c
+
+## end gnulib module dtotimespec
+
## begin gnulib module dup2
@@ -132,6 +158,86 @@ EXTRA_libgnu_a_SOURCES += dup2.c
## end gnulib module dup2
+## begin gnulib module euidaccess
+
+if gl_GNULIB_ENABLED_euidaccess
+
+endif
+EXTRA_DIST += euidaccess.c
+
+EXTRA_libgnu_a_SOURCES += euidaccess.c
+
+## end gnulib module euidaccess
+
+## begin gnulib module execinfo
+
+BUILT_SOURCES += $(EXECINFO_H)
+
+# We need the following in order to create <execinfo.h> when the system
+# doesn't have one that works.
+if GL_GENERATE_EXECINFO_H
+execinfo.h: execinfo.in.h $(top_builddir)/config.status
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ cat $(srcdir)/execinfo.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+else
+execinfo.h: $(top_builddir)/config.status
+ rm -f $@
+endif
+MOSTLYCLEANFILES += execinfo.h execinfo.h-t
+
+EXTRA_DIST += execinfo.c execinfo.in.h
+
+EXTRA_libgnu_a_SOURCES += execinfo.c
+
+## end gnulib module execinfo
+
+## begin gnulib module faccessat
+
+
+EXTRA_DIST += at-func.c faccessat.c
+
+EXTRA_libgnu_a_SOURCES += at-func.c faccessat.c
+
+## end gnulib module faccessat
+
+## begin gnulib module fcntl-h
+
+BUILT_SOURCES += fcntl.h
+
+# We need the following in order to create <fcntl.h> when the system
+# doesn't have one that works with the given compiler.
+fcntl.h: fcntl.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H)
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_FCNTL_H''@|$(NEXT_FCNTL_H)|g' \
+ -e 's/@''GNULIB_FCNTL''@/$(GNULIB_FCNTL)/g' \
+ -e 's/@''GNULIB_NONBLOCKING''@/$(GNULIB_NONBLOCKING)/g' \
+ -e 's/@''GNULIB_OPEN''@/$(GNULIB_OPEN)/g' \
+ -e 's/@''GNULIB_OPENAT''@/$(GNULIB_OPENAT)/g' \
+ -e 's|@''HAVE_FCNTL''@|$(HAVE_FCNTL)|g' \
+ -e 's|@''HAVE_OPENAT''@|$(HAVE_OPENAT)|g' \
+ -e 's|@''REPLACE_FCNTL''@|$(REPLACE_FCNTL)|g' \
+ -e 's|@''REPLACE_OPEN''@|$(REPLACE_OPEN)|g' \
+ -e 's|@''REPLACE_OPENAT''@|$(REPLACE_OPENAT)|g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/fcntl.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+MOSTLYCLEANFILES += fcntl.h fcntl.h-t
+
+EXTRA_DIST += fcntl.in.h
+
+## end gnulib module fcntl-h
+
## begin gnulib module filemode
libgnu_a_SOURCES += filemode.c
@@ -140,6 +246,26 @@ EXTRA_DIST += filemode.h
## end gnulib module filemode
+## begin gnulib module fpending
+
+
+EXTRA_DIST += fpending.c fpending.h
+
+EXTRA_libgnu_a_SOURCES += fpending.c
+
+## end gnulib module fpending
+
+## begin gnulib module getgroups
+
+if gl_GNULIB_ENABLED_getgroups
+
+endif
+EXTRA_DIST += getgroups.c
+
+EXTRA_libgnu_a_SOURCES += getgroups.c
+
+## end gnulib module getgroups
+
## begin gnulib module getloadavg
@@ -184,6 +310,32 @@ libgnu_a_SOURCES += gettext.h
endif
## end gnulib module gettext-h
+## begin gnulib module gettime
+
+libgnu_a_SOURCES += gettime.c
+
+## end gnulib module gettime
+
+## begin gnulib module gettimeofday
+
+
+EXTRA_DIST += gettimeofday.c
+
+EXTRA_libgnu_a_SOURCES += gettimeofday.c
+
+## end gnulib module gettimeofday
+
+## begin gnulib module group-member
+
+if gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1
+
+endif
+EXTRA_DIST += group-member.c
+
+EXTRA_libgnu_a_SOURCES += group-member.c
+
+## end gnulib module group-member
+
## begin gnulib module ignore-value
@@ -204,7 +356,7 @@ BUILT_SOURCES += inttypes.h
# We need the following in order to create <inttypes.h> when the system
# doesn't have one that works with the given compiler.
-inttypes.h: inttypes.in.h $(top_builddir)/config.status $(WARN_ON_USE_H) $(ARG_NONNULL_H)
+inttypes.h: inttypes.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_USE_H) $(ARG_NONNULL_H)
$(AM_V_GEN)rm -f $@-t $@ && \
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
sed -e 's/@''HAVE_INTTYPES_H''@/$(HAVE_INTTYPES_H)/g' \
@@ -225,10 +377,12 @@ inttypes.h: inttypes.in.h $(top_builddir)/config.status $(WARN_ON_USE_H) $(ARG_N
-e 's/@''HAVE_DECL_IMAXDIV''@/$(HAVE_DECL_IMAXDIV)/g' \
-e 's/@''HAVE_DECL_STRTOIMAX''@/$(HAVE_DECL_STRTOIMAX)/g' \
-e 's/@''HAVE_DECL_STRTOUMAX''@/$(HAVE_DECL_STRTOUMAX)/g' \
+ -e 's/@''REPLACE_STRTOIMAX''@/$(REPLACE_STRTOIMAX)/g' \
-e 's/@''INT32_MAX_LT_INTMAX_MAX''@/$(INT32_MAX_LT_INTMAX_MAX)/g' \
-e 's/@''INT64_MAX_EQ_LONG_MAX''@/$(INT64_MAX_EQ_LONG_MAX)/g' \
-e 's/@''UINT32_MAX_LT_UINTMAX_MAX''@/$(UINT32_MAX_LT_UINTMAX_MAX)/g' \
-e 's/@''UINT64_MAX_EQ_ULONG_MAX''@/$(UINT64_MAX_EQ_ULONG_MAX)/g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
-e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
-e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
< $(srcdir)/inttypes.in.h; \
@@ -258,6 +412,24 @@ EXTRA_libgnu_a_SOURCES += mktime.c
## end gnulib module mktime
+## begin gnulib module pathmax
+
+if gl_GNULIB_ENABLED_pathmax
+
+endif
+EXTRA_DIST += pathmax.h
+
+## end gnulib module pathmax
+
+## begin gnulib module pselect
+
+
+EXTRA_DIST += pselect.c
+
+EXTRA_libgnu_a_SOURCES += pselect.c
+
+## end gnulib module pselect
+
## begin gnulib module pthread_sigmask
@@ -276,6 +448,15 @@ EXTRA_libgnu_a_SOURCES += readlink.c
## end gnulib module readlink
+## begin gnulib module root-uid
+
+if gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c
+
+endif
+EXTRA_DIST += root-uid.h
+
+## end gnulib module root-uid
+
## begin gnulib module signal-h
BUILT_SOURCES += signal.h
@@ -318,17 +499,6 @@ EXTRA_DIST += signal.in.h
## end gnulib module signal-h
-## begin gnulib module sigprocmask
-
-if gl_GNULIB_ENABLED_sigprocmask
-
-endif
-EXTRA_DIST += sigprocmask.c
-
-EXTRA_libgnu_a_SOURCES += sigprocmask.c
-
-## end gnulib module sigprocmask
-
## begin gnulib module snippet/_Noreturn
# Because this Makefile snippet defines a variable used by other
@@ -421,6 +591,37 @@ EXTRA_libgnu_a_SOURCES += stat.c
## end gnulib module stat
+## begin gnulib module stat-time
+
+libgnu_a_SOURCES += stat-time.c
+
+EXTRA_DIST += stat-time.h
+
+## end gnulib module stat-time
+
+## begin gnulib module stdalign
+
+BUILT_SOURCES += $(STDALIGN_H)
+
+# We need the following in order to create <stdalign.h> when the system
+# doesn't have one that works.
+if GL_GENERATE_STDALIGN_H
+stdalign.h: stdalign.in.h $(top_builddir)/config.status
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ cat $(srcdir)/stdalign.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+else
+stdalign.h: $(top_builddir)/config.status
+ rm -f $@
+endif
+MOSTLYCLEANFILES += stdalign.h stdalign.h-t
+
+EXTRA_DIST += stdalign.in.h
+
+## end gnulib module stdalign
+
## begin gnulib module stdarg
BUILT_SOURCES += $(STDARG_H)
@@ -590,7 +791,6 @@ stdio.h: stdio.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H)
-e 's/@''GNULIB_GETCHAR''@/$(GNULIB_GETCHAR)/g' \
-e 's/@''GNULIB_GETDELIM''@/$(GNULIB_GETDELIM)/g' \
-e 's/@''GNULIB_GETLINE''@/$(GNULIB_GETLINE)/g' \
- -e 's/@''GNULIB_GETS''@/$(GNULIB_GETS)/g' \
-e 's/@''GNULIB_OBSTACK_PRINTF''@/$(GNULIB_OBSTACK_PRINTF)/g' \
-e 's/@''GNULIB_OBSTACK_PRINTF_POSIX''@/$(GNULIB_OBSTACK_PRINTF_POSIX)/g' \
-e 's/@''GNULIB_PCLOSE''@/$(GNULIB_PCLOSE)/g' \
@@ -710,8 +910,11 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's/@''GNULIB_MKOSTEMPS''@/$(GNULIB_MKOSTEMPS)/g' \
-e 's/@''GNULIB_MKSTEMP''@/$(GNULIB_MKSTEMP)/g' \
-e 's/@''GNULIB_MKSTEMPS''@/$(GNULIB_MKSTEMPS)/g' \
+ -e 's/@''GNULIB_POSIX_OPENPT''@/$(GNULIB_POSIX_OPENPT)/g' \
-e 's/@''GNULIB_PTSNAME''@/$(GNULIB_PTSNAME)/g' \
+ -e 's/@''GNULIB_PTSNAME_R''@/$(GNULIB_PTSNAME_R)/g' \
-e 's/@''GNULIB_PUTENV''@/$(GNULIB_PUTENV)/g' \
+ -e 's/@''GNULIB_RANDOM''@/$(GNULIB_RANDOM)/g' \
-e 's/@''GNULIB_RANDOM_R''@/$(GNULIB_RANDOM_R)/g' \
-e 's/@''GNULIB_REALLOC_POSIX''@/$(GNULIB_REALLOC_POSIX)/g' \
-e 's/@''GNULIB_REALPATH''@/$(GNULIB_REALPATH)/g' \
@@ -736,7 +939,10 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's|@''HAVE_MKOSTEMPS''@|$(HAVE_MKOSTEMPS)|g' \
-e 's|@''HAVE_MKSTEMP''@|$(HAVE_MKSTEMP)|g' \
-e 's|@''HAVE_MKSTEMPS''@|$(HAVE_MKSTEMPS)|g' \
+ -e 's|@''HAVE_POSIX_OPENPT''@|$(HAVE_POSIX_OPENPT)|g' \
-e 's|@''HAVE_PTSNAME''@|$(HAVE_PTSNAME)|g' \
+ -e 's|@''HAVE_PTSNAME_R''@|$(HAVE_PTSNAME_R)|g' \
+ -e 's|@''HAVE_RANDOM''@|$(HAVE_RANDOM)|g' \
-e 's|@''HAVE_RANDOM_H''@|$(HAVE_RANDOM_H)|g' \
-e 's|@''HAVE_RANDOM_R''@|$(HAVE_RANDOM_R)|g' \
-e 's|@''HAVE_REALPATH''@|$(HAVE_REALPATH)|g' \
@@ -754,7 +960,10 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's|@''REPLACE_MALLOC''@|$(REPLACE_MALLOC)|g' \
-e 's|@''REPLACE_MBTOWC''@|$(REPLACE_MBTOWC)|g' \
-e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \
+ -e 's|@''REPLACE_PTSNAME''@|$(REPLACE_PTSNAME)|g' \
+ -e 's|@''REPLACE_PTSNAME_R''@|$(REPLACE_PTSNAME_R)|g' \
-e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \
+ -e 's|@''REPLACE_RANDOM_R''@|$(REPLACE_RANDOM_R)|g' \
-e 's|@''REPLACE_REALLOC''@|$(REPLACE_REALLOC)|g' \
-e 's|@''REPLACE_REALPATH''@|$(REPLACE_REALPATH)|g' \
-e 's|@''REPLACE_SETENV''@|$(REPLACE_SETENV)|g' \
@@ -830,6 +1039,40 @@ EXTRA_libgnu_a_SOURCES += symlink.c
## end gnulib module symlink
+## begin gnulib module sys_select
+
+BUILT_SOURCES += sys/select.h
+
+# We need the following in order to create <sys/select.h> when the system
+# doesn't have one that works with the given compiler.
+sys/select.h: sys_select.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_USE_H)
+ $(AM_V_at)$(MKDIR_P) sys
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_SYS_SELECT_H''@|$(NEXT_SYS_SELECT_H)|g' \
+ -e 's|@''HAVE_SYS_SELECT_H''@|$(HAVE_SYS_SELECT_H)|g' \
+ -e 's/@''GNULIB_PSELECT''@/$(GNULIB_PSELECT)/g' \
+ -e 's/@''GNULIB_SELECT''@/$(GNULIB_SELECT)/g' \
+ -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \
+ -e 's|@''HAVE_PSELECT''@|$(HAVE_PSELECT)|g' \
+ -e 's|@''REPLACE_PSELECT''@|$(REPLACE_PSELECT)|g' \
+ -e 's|@''REPLACE_SELECT''@|$(REPLACE_SELECT)|g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/sys_select.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+MOSTLYCLEANFILES += sys/select.h sys/select.h-t
+MOSTLYCLEANDIRS += sys
+
+EXTRA_DIST += sys_select.in.h
+
+## end gnulib module sys_select
+
## begin gnulib module sys_stat
BUILT_SOURCES += sys/stat.h
@@ -845,6 +1088,7 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU
-e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_SYS_STAT_H''@|$(NEXT_SYS_STAT_H)|g' \
+ -e 's|@''WINDOWS_64_BIT_ST_SIZE''@|$(WINDOWS_64_BIT_ST_SIZE)|g' \
-e 's/@''GNULIB_FCHMODAT''@/$(GNULIB_FCHMODAT)/g' \
-e 's/@''GNULIB_FSTAT''@/$(GNULIB_FSTAT)/g' \
-e 's/@''GNULIB_FSTATAT''@/$(GNULIB_FSTATAT)/g' \
@@ -891,6 +1135,40 @@ EXTRA_DIST += sys_stat.in.h
## end gnulib module sys_stat
+## begin gnulib module sys_time
+
+BUILT_SOURCES += sys/time.h
+
+# We need the following in order to create <sys/time.h> when the system
+# doesn't have one that works with the given compiler.
+sys/time.h: sys_time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H)
+ $(AM_V_at)$(MKDIR_P) sys
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's/@''HAVE_SYS_TIME_H''@/$(HAVE_SYS_TIME_H)/g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_SYS_TIME_H''@|$(NEXT_SYS_TIME_H)|g' \
+ -e 's/@''GNULIB_GETTIMEOFDAY''@/$(GNULIB_GETTIMEOFDAY)/g' \
+ -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \
+ -e 's/@''HAVE_GETTIMEOFDAY''@/$(HAVE_GETTIMEOFDAY)/g' \
+ -e 's/@''HAVE_STRUCT_TIMEVAL''@/$(HAVE_STRUCT_TIMEVAL)/g' \
+ -e 's/@''REPLACE_GETTIMEOFDAY''@/$(REPLACE_GETTIMEOFDAY)/g' \
+ -e 's/@''REPLACE_STRUCT_TIMEVAL''@/$(REPLACE_STRUCT_TIMEVAL)/g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/sys_time.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+MOSTLYCLEANFILES += sys/time.h sys/time.h-t
+
+EXTRA_DIST += sys_time.in.h
+
+## end gnulib module sys_time
+
## begin gnulib module time
BUILT_SOURCES += time.h
@@ -942,8 +1220,29 @@ EXTRA_libgnu_a_SOURCES += time_r.c
## end gnulib module time_r
+## begin gnulib module timespec
+
+libgnu_a_SOURCES += timespec.c
+
+EXTRA_DIST += timespec.h
+
+## end gnulib module timespec
+
+## begin gnulib module timespec-add
+
+libgnu_a_SOURCES += timespec-add.c
+
+## end gnulib module timespec-add
+
+## begin gnulib module timespec-sub
+
+libgnu_a_SOURCES += timespec-sub.c
+
+## end gnulib module timespec-sub
+
## begin gnulib module u64
+libgnu_a_SOURCES += u64.c
EXTRA_DIST += u64.h
@@ -964,6 +1263,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_UNISTD_H''@|$(NEXT_UNISTD_H)|g' \
+ -e 's|@''WINDOWS_64_BIT_OFF_T''@|$(WINDOWS_64_BIT_OFF_T)|g' \
-e 's/@''GNULIB_CHDIR''@/$(GNULIB_CHDIR)/g' \
-e 's/@''GNULIB_CHOWN''@/$(GNULIB_CHOWN)/g' \
-e 's/@''GNULIB_CLOSE''@/$(GNULIB_CLOSE)/g' \
@@ -988,6 +1288,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's/@''GNULIB_GETPAGESIZE''@/$(GNULIB_GETPAGESIZE)/g' \
-e 's/@''GNULIB_GETUSERSHELL''@/$(GNULIB_GETUSERSHELL)/g' \
-e 's/@''GNULIB_GROUP_MEMBER''@/$(GNULIB_GROUP_MEMBER)/g' \
+ -e 's/@''GNULIB_ISATTY''@/$(GNULIB_ISATTY)/g' \
-e 's/@''GNULIB_LCHOWN''@/$(GNULIB_LCHOWN)/g' \
-e 's/@''GNULIB_LINK''@/$(GNULIB_LINK)/g' \
-e 's/@''GNULIB_LINKAT''@/$(GNULIB_LINKAT)/g' \
@@ -1000,11 +1301,12 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's/@''GNULIB_READLINK''@/$(GNULIB_READLINK)/g' \
-e 's/@''GNULIB_READLINKAT''@/$(GNULIB_READLINKAT)/g' \
-e 's/@''GNULIB_RMDIR''@/$(GNULIB_RMDIR)/g' \
+ -e 's/@''GNULIB_SETHOSTNAME''@/$(GNULIB_SETHOSTNAME)/g' \
-e 's/@''GNULIB_SLEEP''@/$(GNULIB_SLEEP)/g' \
-e 's/@''GNULIB_SYMLINK''@/$(GNULIB_SYMLINK)/g' \
-e 's/@''GNULIB_SYMLINKAT''@/$(GNULIB_SYMLINKAT)/g' \
-e 's/@''GNULIB_TTYNAME_R''@/$(GNULIB_TTYNAME_R)/g' \
- -e 's/@''GNULIB_UNISTD_H_GETOPT''@/$(GNULIB_UNISTD_H_GETOPT)/g' \
+ -e 's/@''GNULIB_UNISTD_H_GETOPT''@/0$(GNULIB_GL_UNISTD_H_GETOPT)/g' \
-e 's/@''GNULIB_UNISTD_H_NONBLOCKING''@/$(GNULIB_UNISTD_H_NONBLOCKING)/g' \
-e 's/@''GNULIB_UNISTD_H_SIGPIPE''@/$(GNULIB_UNISTD_H_SIGPIPE)/g' \
-e 's/@''GNULIB_UNLINK''@/$(GNULIB_UNLINK)/g' \
@@ -1037,6 +1339,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_PWRITE''@|$(HAVE_PWRITE)|g' \
-e 's|@''HAVE_READLINK''@|$(HAVE_READLINK)|g' \
-e 's|@''HAVE_READLINKAT''@|$(HAVE_READLINKAT)|g' \
+ -e 's|@''HAVE_SETHOSTNAME''@|$(HAVE_SETHOSTNAME)|g' \
-e 's|@''HAVE_SLEEP''@|$(HAVE_SLEEP)|g' \
-e 's|@''HAVE_SYMLINK''@|$(HAVE_SYMLINK)|g' \
-e 's|@''HAVE_SYMLINKAT''@|$(HAVE_SYMLINKAT)|g' \
@@ -1049,6 +1352,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_DECL_GETLOGIN_R''@|$(HAVE_DECL_GETLOGIN_R)|g' \
-e 's|@''HAVE_DECL_GETPAGESIZE''@|$(HAVE_DECL_GETPAGESIZE)|g' \
-e 's|@''HAVE_DECL_GETUSERSHELL''@|$(HAVE_DECL_GETUSERSHELL)|g' \
+ -e 's|@''HAVE_DECL_SETHOSTNAME''@|$(HAVE_DECL_SETHOSTNAME)|g' \
-e 's|@''HAVE_DECL_TTYNAME_R''@|$(HAVE_DECL_TTYNAME_R)|g' \
-e 's|@''HAVE_OS_H''@|$(HAVE_OS_H)|g' \
-e 's|@''HAVE_SYS_PARAM_H''@|$(HAVE_SYS_PARAM_H)|g' \
@@ -1058,11 +1362,13 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''REPLACE_DUP''@|$(REPLACE_DUP)|g' \
-e 's|@''REPLACE_DUP2''@|$(REPLACE_DUP2)|g' \
-e 's|@''REPLACE_FCHOWNAT''@|$(REPLACE_FCHOWNAT)|g' \
+ -e 's|@''REPLACE_FTRUNCATE''@|$(REPLACE_FTRUNCATE)|g' \
-e 's|@''REPLACE_GETCWD''@|$(REPLACE_GETCWD)|g' \
-e 's|@''REPLACE_GETDOMAINNAME''@|$(REPLACE_GETDOMAINNAME)|g' \
-e 's|@''REPLACE_GETLOGIN_R''@|$(REPLACE_GETLOGIN_R)|g' \
-e 's|@''REPLACE_GETGROUPS''@|$(REPLACE_GETGROUPS)|g' \
-e 's|@''REPLACE_GETPAGESIZE''@|$(REPLACE_GETPAGESIZE)|g' \
+ -e 's|@''REPLACE_ISATTY''@|$(REPLACE_ISATTY)|g' \
-e 's|@''REPLACE_LCHOWN''@|$(REPLACE_LCHOWN)|g' \
-e 's|@''REPLACE_LINK''@|$(REPLACE_LINK)|g' \
-e 's|@''REPLACE_LINKAT''@|$(REPLACE_LINKAT)|g' \
@@ -1092,6 +1398,14 @@ EXTRA_DIST += unistd.in.h
## end gnulib module unistd
+## begin gnulib module utimens
+
+libgnu_a_SOURCES += utimens.c
+
+EXTRA_DIST += utimens.h
+
+## end gnulib module utimens
+
## begin gnulib module verify
if gl_GNULIB_ENABLED_verify
@@ -1101,6 +1415,15 @@ EXTRA_DIST += verify.h
## end gnulib module verify
+## begin gnulib module xalloc-oversized
+
+if gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec
+
+endif
+EXTRA_DIST += xalloc-oversized.h
+
+## end gnulib module xalloc-oversized
+
mostlyclean-local: mostlyclean-generic
@for dir in '' $(MOSTLYCLEANDIRS); do \
diff --git a/lib/group-member.c b/lib/group-member.c
new file mode 100644
index 00000000000..5fcc7e01d0c
--- /dev/null
+++ b/lib/group-member.c
@@ -0,0 +1,119 @@
+/* group-member.c -- determine whether group id is in calling user's group list
+
+ Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2012 Free Software
+ Foundation, Inc.
+
+ 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/>. */
+
+#include <config.h>
+
+/* Specification. */
+#include <unistd.h>
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <stdlib.h>
+
+#include "xalloc-oversized.h"
+
+/* Most processes have no more than this many groups, and for these
+ processes we can avoid using malloc. */
+enum { GROUPBUF_SIZE = 100 };
+
+struct group_info
+ {
+ gid_t *group;
+ gid_t groupbuf[GROUPBUF_SIZE];
+ };
+
+static void
+free_group_info (struct group_info const *g)
+{
+ if (g->group != g->groupbuf)
+ free (g->group);
+}
+
+static int
+get_group_info (struct group_info *gi)
+{
+ int n_groups = getgroups (GROUPBUF_SIZE, gi->groupbuf);
+ gi->group = gi->groupbuf;
+
+ if (n_groups < 0)
+ {
+ int n_group_slots = getgroups (0, NULL);
+ if (0 <= n_group_slots
+ && ! xalloc_oversized (n_group_slots, sizeof *gi->group))
+ {
+ gi->group = malloc (n_group_slots * sizeof *gi->group);
+ if (gi->group)
+ n_groups = getgroups (n_group_slots, gi->group);
+ }
+ }
+
+ /* In case of error, the user loses. */
+ return n_groups;
+}
+
+/* Return non-zero if GID is one that we have in our groups list.
+ Note that the groups list is not guaranteed to contain the current
+ or effective group ID, so they should generally be checked
+ separately. */
+
+int
+group_member (gid_t gid)
+{
+ int i;
+ int found;
+ struct group_info gi;
+ int n_groups = get_group_info (&gi);
+
+ /* Search through the list looking for GID. */
+ found = 0;
+ for (i = 0; i < n_groups; i++)
+ {
+ if (gid == gi.group[i])
+ {
+ found = 1;
+ break;
+ }
+ }
+
+ free_group_info (&gi);
+
+ return found;
+}
+
+#ifdef TEST
+
+char *program_name;
+
+int
+main (int argc, char **argv)
+{
+ int i;
+
+ program_name = argv[0];
+
+ for (i = 1; i < argc; i++)
+ {
+ gid_t gid;
+
+ gid = atoi (argv[i]);
+ printf ("%d: %s\n", gid, group_member (gid) ? "yes" : "no");
+ }
+ exit (0);
+}
+
+#endif /* TEST */
diff --git a/lib/ignore-value.h b/lib/ignore-value.h
index f021a1ac8ea..2e344350946 100644
--- a/lib/ignore-value.h
+++ b/lib/ignore-value.h
@@ -1,6 +1,6 @@
/* ignore a function return without a compiler warning
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
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
@@ -35,16 +35,6 @@
#ifndef _GL_IGNORE_VALUE_H
# define _GL_IGNORE_VALUE_H
-# ifndef _GL_ATTRIBUTE_DEPRECATED
-/* The __attribute__((__deprecated__)) feature
- is available in gcc versions 3.1 and newer. */
-# if __GNUC__ < 3 || (__GNUC__ == 3 && __GNUC_MINOR__ < 1)
-# define _GL_ATTRIBUTE_DEPRECATED /* empty */
-# else
-# define _GL_ATTRIBUTE_DEPRECATED __attribute__ ((__deprecated__))
-# endif
-# endif
-
/* The __attribute__((__warn_unused_result__)) feature
is available in gcc versions 3.4 and newer,
while the typeof feature has been available since 2.7 at least. */
@@ -54,9 +44,4 @@
# define ignore_value(x) (({ __typeof__ (x) __x = (x); (void) __x; }))
# endif
-/* ignore_value works for scalars, pointers and aggregates;
- deprecate ignore_ptr. */
-static inline void _GL_ATTRIBUTE_DEPRECATED
-ignore_ptr (void *p) { (void) p; } /* deprecated: use ignore_value */
-
#endif
diff --git a/lib/intprops.h b/lib/intprops.h
index 1f6a539c183..2485c78d4ba 100644
--- a/lib/intprops.h
+++ b/lib/intprops.h
@@ -1,6 +1,6 @@
/* intprops.h -- properties of integer types
- Copyright (C) 2001-2005, 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2005, 2009-2012 Free Software Foundation, Inc.
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
diff --git a/lib/inttypes.in.h b/lib/inttypes.in.h
index 7abf39403f0..b9da2b5b091 100644
--- a/lib/inttypes.in.h
+++ b/lib/inttypes.in.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2006-2011 Free Software Foundation, Inc.
+/* Copyright (C) 2006-2012 Free Software Foundation, Inc.
Written by Paul Eggert, Bruno Haible, Derek Price.
This file is part of gnulib.
@@ -31,6 +31,12 @@
The include_next requires a split double-inclusion guard. */
#if ! defined INTTYPES_H || defined _GL_JUST_INCLUDE_SYSTEM_INTTYPES_H
# if @HAVE_INTTYPES_H@
+
+ /* Some pre-C++11 <stdint.h> implementations need this. */
+# if defined __cplusplus && ! defined __STDC_FORMAT_MACROS
+# define __STDC_FORMAT_MACROS 1
+# endif
+
# @INCLUDE_NEXT@ @NEXT_INTTYPES_H@
# endif
#endif
@@ -50,994 +56,992 @@
# error "This file assumes that 'int' has exactly 32 bits. Please report your platform and compiler to <bug-gnulib@gnu.org>."
#endif
+/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
+
/* The definition of _GL_ARG_NONNULL is copied here. */
/* The definition of _GL_WARN_ON_USE is copied here. */
/* 7.8.1 Macros for format specifiers */
-#if ! defined __cplusplus || defined __STDC_FORMAT_MACROS
-
-# if defined _TNS_R_TARGET
+#if defined _TNS_R_TARGET
/* Tandem NonStop R series and compatible platforms released before
July 2005 support %Ld but not %lld. */
-# define _LONG_LONG_FORMAT_PREFIX "L"
-# else
-# define _LONG_LONG_FORMAT_PREFIX "ll"
-# endif
+# define _LONG_LONG_FORMAT_PREFIX "L"
+#else
+# define _LONG_LONG_FORMAT_PREFIX "ll"
+#endif
-# if !defined PRId8 || @PRI_MACROS_BROKEN@
-# undef PRId8
-# ifdef INT8_MAX
-# define PRId8 "d"
-# endif
+#if !defined PRId8 || @PRI_MACROS_BROKEN@
+# undef PRId8
+# ifdef INT8_MAX
+# define PRId8 "d"
# endif
-# if !defined PRIi8 || @PRI_MACROS_BROKEN@
-# undef PRIi8
-# ifdef INT8_MAX
-# define PRIi8 "i"
-# endif
+#endif
+#if !defined PRIi8 || @PRI_MACROS_BROKEN@
+# undef PRIi8
+# ifdef INT8_MAX
+# define PRIi8 "i"
# endif
-# if !defined PRIo8 || @PRI_MACROS_BROKEN@
-# undef PRIo8
-# ifdef UINT8_MAX
-# define PRIo8 "o"
-# endif
+#endif
+#if !defined PRIo8 || @PRI_MACROS_BROKEN@
+# undef PRIo8
+# ifdef UINT8_MAX
+# define PRIo8 "o"
# endif
-# if !defined PRIu8 || @PRI_MACROS_BROKEN@
-# undef PRIu8
-# ifdef UINT8_MAX
-# define PRIu8 "u"
-# endif
+#endif
+#if !defined PRIu8 || @PRI_MACROS_BROKEN@
+# undef PRIu8
+# ifdef UINT8_MAX
+# define PRIu8 "u"
# endif
-# if !defined PRIx8 || @PRI_MACROS_BROKEN@
-# undef PRIx8
-# ifdef UINT8_MAX
-# define PRIx8 "x"
-# endif
+#endif
+#if !defined PRIx8 || @PRI_MACROS_BROKEN@
+# undef PRIx8
+# ifdef UINT8_MAX
+# define PRIx8 "x"
# endif
-# if !defined PRIX8 || @PRI_MACROS_BROKEN@
-# undef PRIX8
-# ifdef UINT8_MAX
-# define PRIX8 "X"
-# endif
+#endif
+#if !defined PRIX8 || @PRI_MACROS_BROKEN@
+# undef PRIX8
+# ifdef UINT8_MAX
+# define PRIX8 "X"
# endif
-# if !defined PRId16 || @PRI_MACROS_BROKEN@
-# undef PRId16
-# ifdef INT16_MAX
-# define PRId16 "d"
-# endif
+#endif
+#if !defined PRId16 || @PRI_MACROS_BROKEN@
+# undef PRId16
+# ifdef INT16_MAX
+# define PRId16 "d"
# endif
-# if !defined PRIi16 || @PRI_MACROS_BROKEN@
-# undef PRIi16
-# ifdef INT16_MAX
-# define PRIi16 "i"
-# endif
+#endif
+#if !defined PRIi16 || @PRI_MACROS_BROKEN@
+# undef PRIi16
+# ifdef INT16_MAX
+# define PRIi16 "i"
# endif
-# if !defined PRIo16 || @PRI_MACROS_BROKEN@
-# undef PRIo16
-# ifdef UINT16_MAX
-# define PRIo16 "o"
-# endif
+#endif
+#if !defined PRIo16 || @PRI_MACROS_BROKEN@
+# undef PRIo16
+# ifdef UINT16_MAX
+# define PRIo16 "o"
# endif
-# if !defined PRIu16 || @PRI_MACROS_BROKEN@
-# undef PRIu16
-# ifdef UINT16_MAX
-# define PRIu16 "u"
-# endif
+#endif
+#if !defined PRIu16 || @PRI_MACROS_BROKEN@
+# undef PRIu16
+# ifdef UINT16_MAX
+# define PRIu16 "u"
# endif
-# if !defined PRIx16 || @PRI_MACROS_BROKEN@
-# undef PRIx16
-# ifdef UINT16_MAX
-# define PRIx16 "x"
-# endif
+#endif
+#if !defined PRIx16 || @PRI_MACROS_BROKEN@
+# undef PRIx16
+# ifdef UINT16_MAX
+# define PRIx16 "x"
# endif
-# if !defined PRIX16 || @PRI_MACROS_BROKEN@
-# undef PRIX16
-# ifdef UINT16_MAX
-# define PRIX16 "X"
-# endif
+#endif
+#if !defined PRIX16 || @PRI_MACROS_BROKEN@
+# undef PRIX16
+# ifdef UINT16_MAX
+# define PRIX16 "X"
# endif
-# if !defined PRId32 || @PRI_MACROS_BROKEN@
-# undef PRId32
-# ifdef INT32_MAX
-# define PRId32 "d"
-# endif
+#endif
+#if !defined PRId32 || @PRI_MACROS_BROKEN@
+# undef PRId32
+# ifdef INT32_MAX
+# define PRId32 "d"
# endif
-# if !defined PRIi32 || @PRI_MACROS_BROKEN@
-# undef PRIi32
-# ifdef INT32_MAX
-# define PRIi32 "i"
-# endif
+#endif
+#if !defined PRIi32 || @PRI_MACROS_BROKEN@
+# undef PRIi32
+# ifdef INT32_MAX
+# define PRIi32 "i"
# endif
-# if !defined PRIo32 || @PRI_MACROS_BROKEN@
-# undef PRIo32
-# ifdef UINT32_MAX
-# define PRIo32 "o"
-# endif
+#endif
+#if !defined PRIo32 || @PRI_MACROS_BROKEN@
+# undef PRIo32
+# ifdef UINT32_MAX
+# define PRIo32 "o"
# endif
-# if !defined PRIu32 || @PRI_MACROS_BROKEN@
-# undef PRIu32
-# ifdef UINT32_MAX
-# define PRIu32 "u"
-# endif
+#endif
+#if !defined PRIu32 || @PRI_MACROS_BROKEN@
+# undef PRIu32
+# ifdef UINT32_MAX
+# define PRIu32 "u"
# endif
-# if !defined PRIx32 || @PRI_MACROS_BROKEN@
-# undef PRIx32
-# ifdef UINT32_MAX
-# define PRIx32 "x"
-# endif
+#endif
+#if !defined PRIx32 || @PRI_MACROS_BROKEN@
+# undef PRIx32
+# ifdef UINT32_MAX
+# define PRIx32 "x"
# endif
-# if !defined PRIX32 || @PRI_MACROS_BROKEN@
-# undef PRIX32
-# ifdef UINT32_MAX
-# define PRIX32 "X"
-# endif
+#endif
+#if !defined PRIX32 || @PRI_MACROS_BROKEN@
+# undef PRIX32
+# ifdef UINT32_MAX
+# define PRIX32 "X"
# endif
-# ifdef INT64_MAX
-# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @INT64_MAX_EQ_LONG_MAX@)
-# define _PRI64_PREFIX "l"
-# elif defined _MSC_VER || defined __MINGW32__
-# define _PRI64_PREFIX "I64"
-# elif @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
-# define _PRI64_PREFIX _LONG_LONG_FORMAT_PREFIX
-# endif
-# if !defined PRId64 || @PRI_MACROS_BROKEN@
-# undef PRId64
-# define PRId64 _PRI64_PREFIX "d"
-# endif
-# if !defined PRIi64 || @PRI_MACROS_BROKEN@
-# undef PRIi64
-# define PRIi64 _PRI64_PREFIX "i"
-# endif
+#endif
+#ifdef INT64_MAX
+# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @INT64_MAX_EQ_LONG_MAX@)
+# define _PRI64_PREFIX "l"
+# elif defined _MSC_VER || defined __MINGW32__
+# define _PRI64_PREFIX "I64"
+# elif @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
+# define _PRI64_PREFIX _LONG_LONG_FORMAT_PREFIX
+# endif
+# if !defined PRId64 || @PRI_MACROS_BROKEN@
+# undef PRId64
+# define PRId64 _PRI64_PREFIX "d"
+# endif
+# if !defined PRIi64 || @PRI_MACROS_BROKEN@
+# undef PRIi64
+# define PRIi64 _PRI64_PREFIX "i"
# endif
-# ifdef UINT64_MAX
-# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @UINT64_MAX_EQ_ULONG_MAX@)
-# define _PRIu64_PREFIX "l"
-# elif defined _MSC_VER || defined __MINGW32__
-# define _PRIu64_PREFIX "I64"
-# elif @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
-# define _PRIu64_PREFIX _LONG_LONG_FORMAT_PREFIX
-# endif
-# if !defined PRIo64 || @PRI_MACROS_BROKEN@
-# undef PRIo64
-# define PRIo64 _PRIu64_PREFIX "o"
-# endif
-# if !defined PRIu64 || @PRI_MACROS_BROKEN@
-# undef PRIu64
-# define PRIu64 _PRIu64_PREFIX "u"
-# endif
-# if !defined PRIx64 || @PRI_MACROS_BROKEN@
-# undef PRIx64
-# define PRIx64 _PRIu64_PREFIX "x"
-# endif
-# if !defined PRIX64 || @PRI_MACROS_BROKEN@
-# undef PRIX64
-# define PRIX64 _PRIu64_PREFIX "X"
-# endif
+#endif
+#ifdef UINT64_MAX
+# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @UINT64_MAX_EQ_ULONG_MAX@)
+# define _PRIu64_PREFIX "l"
+# elif defined _MSC_VER || defined __MINGW32__
+# define _PRIu64_PREFIX "I64"
+# elif @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
+# define _PRIu64_PREFIX _LONG_LONG_FORMAT_PREFIX
+# endif
+# if !defined PRIo64 || @PRI_MACROS_BROKEN@
+# undef PRIo64
+# define PRIo64 _PRIu64_PREFIX "o"
+# endif
+# if !defined PRIu64 || @PRI_MACROS_BROKEN@
+# undef PRIu64
+# define PRIu64 _PRIu64_PREFIX "u"
+# endif
+# if !defined PRIx64 || @PRI_MACROS_BROKEN@
+# undef PRIx64
+# define PRIx64 _PRIu64_PREFIX "x"
+# endif
+# if !defined PRIX64 || @PRI_MACROS_BROKEN@
+# undef PRIX64
+# define PRIX64 _PRIu64_PREFIX "X"
# endif
+#endif
-# if !defined PRIdLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIdLEAST8
-# define PRIdLEAST8 "d"
-# endif
-# if !defined PRIiLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIiLEAST8
-# define PRIiLEAST8 "i"
-# endif
-# if !defined PRIoLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIoLEAST8
-# define PRIoLEAST8 "o"
-# endif
-# if !defined PRIuLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIuLEAST8
-# define PRIuLEAST8 "u"
-# endif
-# if !defined PRIxLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIxLEAST8
-# define PRIxLEAST8 "x"
-# endif
-# if !defined PRIXLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIXLEAST8
-# define PRIXLEAST8 "X"
-# endif
-# if !defined PRIdLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIdLEAST16
-# define PRIdLEAST16 "d"
-# endif
-# if !defined PRIiLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIiLEAST16
-# define PRIiLEAST16 "i"
-# endif
-# if !defined PRIoLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIoLEAST16
-# define PRIoLEAST16 "o"
-# endif
-# if !defined PRIuLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIuLEAST16
-# define PRIuLEAST16 "u"
-# endif
-# if !defined PRIxLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIxLEAST16
-# define PRIxLEAST16 "x"
-# endif
-# if !defined PRIXLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIXLEAST16
-# define PRIXLEAST16 "X"
-# endif
-# if !defined PRIdLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIdLEAST32
-# define PRIdLEAST32 "d"
-# endif
-# if !defined PRIiLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIiLEAST32
-# define PRIiLEAST32 "i"
-# endif
-# if !defined PRIoLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIoLEAST32
-# define PRIoLEAST32 "o"
-# endif
-# if !defined PRIuLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIuLEAST32
-# define PRIuLEAST32 "u"
-# endif
-# if !defined PRIxLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIxLEAST32
-# define PRIxLEAST32 "x"
-# endif
-# if !defined PRIXLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIXLEAST32
-# define PRIXLEAST32 "X"
-# endif
-# ifdef INT64_MAX
-# if !defined PRIdLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIdLEAST64
-# define PRIdLEAST64 PRId64
-# endif
-# if !defined PRIiLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIiLEAST64
-# define PRIiLEAST64 PRIi64
-# endif
+#if !defined PRIdLEAST8 || @PRI_MACROS_BROKEN@
+# undef PRIdLEAST8
+# define PRIdLEAST8 "d"
+#endif
+#if !defined PRIiLEAST8 || @PRI_MACROS_BROKEN@
+# undef PRIiLEAST8
+# define PRIiLEAST8 "i"
+#endif
+#if !defined PRIoLEAST8 || @PRI_MACROS_BROKEN@
+# undef PRIoLEAST8
+# define PRIoLEAST8 "o"
+#endif
+#if !defined PRIuLEAST8 || @PRI_MACROS_BROKEN@
+# undef PRIuLEAST8
+# define PRIuLEAST8 "u"
+#endif
+#if !defined PRIxLEAST8 || @PRI_MACROS_BROKEN@
+# undef PRIxLEAST8
+# define PRIxLEAST8 "x"
+#endif
+#if !defined PRIXLEAST8 || @PRI_MACROS_BROKEN@
+# undef PRIXLEAST8
+# define PRIXLEAST8 "X"
+#endif
+#if !defined PRIdLEAST16 || @PRI_MACROS_BROKEN@
+# undef PRIdLEAST16
+# define PRIdLEAST16 "d"
+#endif
+#if !defined PRIiLEAST16 || @PRI_MACROS_BROKEN@
+# undef PRIiLEAST16
+# define PRIiLEAST16 "i"
+#endif
+#if !defined PRIoLEAST16 || @PRI_MACROS_BROKEN@
+# undef PRIoLEAST16
+# define PRIoLEAST16 "o"
+#endif
+#if !defined PRIuLEAST16 || @PRI_MACROS_BROKEN@
+# undef PRIuLEAST16
+# define PRIuLEAST16 "u"
+#endif
+#if !defined PRIxLEAST16 || @PRI_MACROS_BROKEN@
+# undef PRIxLEAST16
+# define PRIxLEAST16 "x"
+#endif
+#if !defined PRIXLEAST16 || @PRI_MACROS_BROKEN@
+# undef PRIXLEAST16
+# define PRIXLEAST16 "X"
+#endif
+#if !defined PRIdLEAST32 || @PRI_MACROS_BROKEN@
+# undef PRIdLEAST32
+# define PRIdLEAST32 "d"
+#endif
+#if !defined PRIiLEAST32 || @PRI_MACROS_BROKEN@
+# undef PRIiLEAST32
+# define PRIiLEAST32 "i"
+#endif
+#if !defined PRIoLEAST32 || @PRI_MACROS_BROKEN@
+# undef PRIoLEAST32
+# define PRIoLEAST32 "o"
+#endif
+#if !defined PRIuLEAST32 || @PRI_MACROS_BROKEN@
+# undef PRIuLEAST32
+# define PRIuLEAST32 "u"
+#endif
+#if !defined PRIxLEAST32 || @PRI_MACROS_BROKEN@
+# undef PRIxLEAST32
+# define PRIxLEAST32 "x"
+#endif
+#if !defined PRIXLEAST32 || @PRI_MACROS_BROKEN@
+# undef PRIXLEAST32
+# define PRIXLEAST32 "X"
+#endif
+#ifdef INT64_MAX
+# if !defined PRIdLEAST64 || @PRI_MACROS_BROKEN@
+# undef PRIdLEAST64
+# define PRIdLEAST64 PRId64
# endif
-# ifdef UINT64_MAX
-# if !defined PRIoLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIoLEAST64
-# define PRIoLEAST64 PRIo64
-# endif
-# if !defined PRIuLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIuLEAST64
-# define PRIuLEAST64 PRIu64
-# endif
-# if !defined PRIxLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIxLEAST64
-# define PRIxLEAST64 PRIx64
-# endif
-# if !defined PRIXLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIXLEAST64
-# define PRIXLEAST64 PRIX64
-# endif
+# if !defined PRIiLEAST64 || @PRI_MACROS_BROKEN@
+# undef PRIiLEAST64
+# define PRIiLEAST64 PRIi64
+# endif
+#endif
+#ifdef UINT64_MAX
+# if !defined PRIoLEAST64 || @PRI_MACROS_BROKEN@
+# undef PRIoLEAST64
+# define PRIoLEAST64 PRIo64
+# endif
+# if !defined PRIuLEAST64 || @PRI_MACROS_BROKEN@
+# undef PRIuLEAST64
+# define PRIuLEAST64 PRIu64
+# endif
+# if !defined PRIxLEAST64 || @PRI_MACROS_BROKEN@
+# undef PRIxLEAST64
+# define PRIxLEAST64 PRIx64
# endif
+# if !defined PRIXLEAST64 || @PRI_MACROS_BROKEN@
+# undef PRIXLEAST64
+# define PRIXLEAST64 PRIX64
+# endif
+#endif
-# if !defined PRIdFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIdFAST8
-# if INT_FAST8_MAX > INT32_MAX
-# define PRIdFAST8 PRId64
-# else
-# define PRIdFAST8 "d"
-# endif
+#if !defined PRIdFAST8 || @PRI_MACROS_BROKEN@
+# undef PRIdFAST8
+# if INT_FAST8_MAX > INT32_MAX
+# define PRIdFAST8 PRId64
+# else
+# define PRIdFAST8 "d"
# endif
-# if !defined PRIiFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIiFAST8
-# if INT_FAST8_MAX > INT32_MAX
-# define PRIiFAST8 PRIi64
-# else
-# define PRIiFAST8 "i"
-# endif
+#endif
+#if !defined PRIiFAST8 || @PRI_MACROS_BROKEN@
+# undef PRIiFAST8
+# if INT_FAST8_MAX > INT32_MAX
+# define PRIiFAST8 PRIi64
+# else
+# define PRIiFAST8 "i"
# endif
-# if !defined PRIoFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIoFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define PRIoFAST8 PRIo64
-# else
-# define PRIoFAST8 "o"
-# endif
+#endif
+#if !defined PRIoFAST8 || @PRI_MACROS_BROKEN@
+# undef PRIoFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define PRIoFAST8 PRIo64
+# else
+# define PRIoFAST8 "o"
# endif
-# if !defined PRIuFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIuFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define PRIuFAST8 PRIu64
-# else
-# define PRIuFAST8 "u"
-# endif
+#endif
+#if !defined PRIuFAST8 || @PRI_MACROS_BROKEN@
+# undef PRIuFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define PRIuFAST8 PRIu64
+# else
+# define PRIuFAST8 "u"
# endif
-# if !defined PRIxFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIxFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define PRIxFAST8 PRIx64
-# else
-# define PRIxFAST8 "x"
-# endif
+#endif
+#if !defined PRIxFAST8 || @PRI_MACROS_BROKEN@
+# undef PRIxFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define PRIxFAST8 PRIx64
+# else
+# define PRIxFAST8 "x"
# endif
-# if !defined PRIXFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIXFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define PRIXFAST8 PRIX64
-# else
-# define PRIXFAST8 "X"
-# endif
+#endif
+#if !defined PRIXFAST8 || @PRI_MACROS_BROKEN@
+# undef PRIXFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define PRIXFAST8 PRIX64
+# else
+# define PRIXFAST8 "X"
# endif
-# if !defined PRIdFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIdFAST16
-# if INT_FAST16_MAX > INT32_MAX
-# define PRIdFAST16 PRId64
-# else
-# define PRIdFAST16 "d"
-# endif
+#endif
+#if !defined PRIdFAST16 || @PRI_MACROS_BROKEN@
+# undef PRIdFAST16
+# if INT_FAST16_MAX > INT32_MAX
+# define PRIdFAST16 PRId64
+# else
+# define PRIdFAST16 "d"
# endif
-# if !defined PRIiFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIiFAST16
-# if INT_FAST16_MAX > INT32_MAX
-# define PRIiFAST16 PRIi64
-# else
-# define PRIiFAST16 "i"
-# endif
+#endif
+#if !defined PRIiFAST16 || @PRI_MACROS_BROKEN@
+# undef PRIiFAST16
+# if INT_FAST16_MAX > INT32_MAX
+# define PRIiFAST16 PRIi64
+# else
+# define PRIiFAST16 "i"
# endif
-# if !defined PRIoFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIoFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define PRIoFAST16 PRIo64
-# else
-# define PRIoFAST16 "o"
-# endif
+#endif
+#if !defined PRIoFAST16 || @PRI_MACROS_BROKEN@
+# undef PRIoFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define PRIoFAST16 PRIo64
+# else
+# define PRIoFAST16 "o"
# endif
-# if !defined PRIuFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIuFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define PRIuFAST16 PRIu64
-# else
-# define PRIuFAST16 "u"
-# endif
+#endif
+#if !defined PRIuFAST16 || @PRI_MACROS_BROKEN@
+# undef PRIuFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define PRIuFAST16 PRIu64
+# else
+# define PRIuFAST16 "u"
# endif
-# if !defined PRIxFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIxFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define PRIxFAST16 PRIx64
-# else
-# define PRIxFAST16 "x"
-# endif
+#endif
+#if !defined PRIxFAST16 || @PRI_MACROS_BROKEN@
+# undef PRIxFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define PRIxFAST16 PRIx64
+# else
+# define PRIxFAST16 "x"
# endif
-# if !defined PRIXFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIXFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define PRIXFAST16 PRIX64
-# else
-# define PRIXFAST16 "X"
-# endif
+#endif
+#if !defined PRIXFAST16 || @PRI_MACROS_BROKEN@
+# undef PRIXFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define PRIXFAST16 PRIX64
+# else
+# define PRIXFAST16 "X"
# endif
-# if !defined PRIdFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIdFAST32
-# if INT_FAST32_MAX > INT32_MAX
-# define PRIdFAST32 PRId64
-# else
-# define PRIdFAST32 "d"
-# endif
+#endif
+#if !defined PRIdFAST32 || @PRI_MACROS_BROKEN@
+# undef PRIdFAST32
+# if INT_FAST32_MAX > INT32_MAX
+# define PRIdFAST32 PRId64
+# else
+# define PRIdFAST32 "d"
# endif
-# if !defined PRIiFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIiFAST32
-# if INT_FAST32_MAX > INT32_MAX
-# define PRIiFAST32 PRIi64
-# else
-# define PRIiFAST32 "i"
-# endif
+#endif
+#if !defined PRIiFAST32 || @PRI_MACROS_BROKEN@
+# undef PRIiFAST32
+# if INT_FAST32_MAX > INT32_MAX
+# define PRIiFAST32 PRIi64
+# else
+# define PRIiFAST32 "i"
# endif
-# if !defined PRIoFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIoFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define PRIoFAST32 PRIo64
-# else
-# define PRIoFAST32 "o"
-# endif
+#endif
+#if !defined PRIoFAST32 || @PRI_MACROS_BROKEN@
+# undef PRIoFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define PRIoFAST32 PRIo64
+# else
+# define PRIoFAST32 "o"
# endif
-# if !defined PRIuFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIuFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define PRIuFAST32 PRIu64
-# else
-# define PRIuFAST32 "u"
-# endif
+#endif
+#if !defined PRIuFAST32 || @PRI_MACROS_BROKEN@
+# undef PRIuFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define PRIuFAST32 PRIu64
+# else
+# define PRIuFAST32 "u"
# endif
-# if !defined PRIxFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIxFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define PRIxFAST32 PRIx64
-# else
-# define PRIxFAST32 "x"
-# endif
+#endif
+#if !defined PRIxFAST32 || @PRI_MACROS_BROKEN@
+# undef PRIxFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define PRIxFAST32 PRIx64
+# else
+# define PRIxFAST32 "x"
# endif
-# if !defined PRIXFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIXFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define PRIXFAST32 PRIX64
-# else
-# define PRIXFAST32 "X"
-# endif
+#endif
+#if !defined PRIXFAST32 || @PRI_MACROS_BROKEN@
+# undef PRIXFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define PRIXFAST32 PRIX64
+# else
+# define PRIXFAST32 "X"
# endif
-# ifdef INT64_MAX
-# if !defined PRIdFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIdFAST64
-# define PRIdFAST64 PRId64
-# endif
-# if !defined PRIiFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIiFAST64
-# define PRIiFAST64 PRIi64
-# endif
+#endif
+#ifdef INT64_MAX
+# if !defined PRIdFAST64 || @PRI_MACROS_BROKEN@
+# undef PRIdFAST64
+# define PRIdFAST64 PRId64
# endif
-# ifdef UINT64_MAX
-# if !defined PRIoFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIoFAST64
-# define PRIoFAST64 PRIo64
-# endif
-# if !defined PRIuFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIuFAST64
-# define PRIuFAST64 PRIu64
-# endif
-# if !defined PRIxFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIxFAST64
-# define PRIxFAST64 PRIx64
-# endif
-# if !defined PRIXFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIXFAST64
-# define PRIXFAST64 PRIX64
-# endif
+# if !defined PRIiFAST64 || @PRI_MACROS_BROKEN@
+# undef PRIiFAST64
+# define PRIiFAST64 PRIi64
+# endif
+#endif
+#ifdef UINT64_MAX
+# if !defined PRIoFAST64 || @PRI_MACROS_BROKEN@
+# undef PRIoFAST64
+# define PRIoFAST64 PRIo64
+# endif
+# if !defined PRIuFAST64 || @PRI_MACROS_BROKEN@
+# undef PRIuFAST64
+# define PRIuFAST64 PRIu64
+# endif
+# if !defined PRIxFAST64 || @PRI_MACROS_BROKEN@
+# undef PRIxFAST64
+# define PRIxFAST64 PRIx64
# endif
+# if !defined PRIXFAST64 || @PRI_MACROS_BROKEN@
+# undef PRIXFAST64
+# define PRIXFAST64 PRIX64
+# endif
+#endif
-# if !defined PRIdMAX || @PRI_MACROS_BROKEN@
-# undef PRIdMAX
-# if @INT32_MAX_LT_INTMAX_MAX@
-# define PRIdMAX PRId64
-# else
-# define PRIdMAX "ld"
-# endif
+#if !defined PRIdMAX || @PRI_MACROS_BROKEN@
+# undef PRIdMAX
+# if @INT32_MAX_LT_INTMAX_MAX@
+# define PRIdMAX PRId64
+# else
+# define PRIdMAX "ld"
# endif
-# if !defined PRIiMAX || @PRI_MACROS_BROKEN@
-# undef PRIiMAX
-# if @INT32_MAX_LT_INTMAX_MAX@
-# define PRIiMAX PRIi64
-# else
-# define PRIiMAX "li"
-# endif
+#endif
+#if !defined PRIiMAX || @PRI_MACROS_BROKEN@
+# undef PRIiMAX
+# if @INT32_MAX_LT_INTMAX_MAX@
+# define PRIiMAX PRIi64
+# else
+# define PRIiMAX "li"
# endif
-# if !defined PRIoMAX || @PRI_MACROS_BROKEN@
-# undef PRIoMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define PRIoMAX PRIo64
-# else
-# define PRIoMAX "lo"
-# endif
+#endif
+#if !defined PRIoMAX || @PRI_MACROS_BROKEN@
+# undef PRIoMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define PRIoMAX PRIo64
+# else
+# define PRIoMAX "lo"
# endif
-# if !defined PRIuMAX || @PRI_MACROS_BROKEN@
-# undef PRIuMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define PRIuMAX PRIu64
-# else
-# define PRIuMAX "lu"
-# endif
+#endif
+#if !defined PRIuMAX || @PRI_MACROS_BROKEN@
+# undef PRIuMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define PRIuMAX PRIu64
+# else
+# define PRIuMAX "lu"
# endif
-# if !defined PRIxMAX || @PRI_MACROS_BROKEN@
-# undef PRIxMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define PRIxMAX PRIx64
-# else
-# define PRIxMAX "lx"
-# endif
+#endif
+#if !defined PRIxMAX || @PRI_MACROS_BROKEN@
+# undef PRIxMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define PRIxMAX PRIx64
+# else
+# define PRIxMAX "lx"
# endif
-# if !defined PRIXMAX || @PRI_MACROS_BROKEN@
-# undef PRIXMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define PRIXMAX PRIX64
-# else
-# define PRIXMAX "lX"
-# endif
+#endif
+#if !defined PRIXMAX || @PRI_MACROS_BROKEN@
+# undef PRIXMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define PRIXMAX PRIX64
+# else
+# define PRIXMAX "lX"
# endif
+#endif
-# if !defined PRIdPTR || @PRI_MACROS_BROKEN@
-# undef PRIdPTR
-# ifdef INTPTR_MAX
-# define PRIdPTR @PRIPTR_PREFIX@ "d"
-# endif
+#if !defined PRIdPTR || @PRI_MACROS_BROKEN@
+# undef PRIdPTR
+# ifdef INTPTR_MAX
+# define PRIdPTR @PRIPTR_PREFIX@ "d"
# endif
-# if !defined PRIiPTR || @PRI_MACROS_BROKEN@
-# undef PRIiPTR
-# ifdef INTPTR_MAX
-# define PRIiPTR @PRIPTR_PREFIX@ "i"
-# endif
+#endif
+#if !defined PRIiPTR || @PRI_MACROS_BROKEN@
+# undef PRIiPTR
+# ifdef INTPTR_MAX
+# define PRIiPTR @PRIPTR_PREFIX@ "i"
# endif
-# if !defined PRIoPTR || @PRI_MACROS_BROKEN@
-# undef PRIoPTR
-# ifdef UINTPTR_MAX
-# define PRIoPTR @PRIPTR_PREFIX@ "o"
-# endif
+#endif
+#if !defined PRIoPTR || @PRI_MACROS_BROKEN@
+# undef PRIoPTR
+# ifdef UINTPTR_MAX
+# define PRIoPTR @PRIPTR_PREFIX@ "o"
# endif
-# if !defined PRIuPTR || @PRI_MACROS_BROKEN@
-# undef PRIuPTR
-# ifdef UINTPTR_MAX
-# define PRIuPTR @PRIPTR_PREFIX@ "u"
-# endif
+#endif
+#if !defined PRIuPTR || @PRI_MACROS_BROKEN@
+# undef PRIuPTR
+# ifdef UINTPTR_MAX
+# define PRIuPTR @PRIPTR_PREFIX@ "u"
# endif
-# if !defined PRIxPTR || @PRI_MACROS_BROKEN@
-# undef PRIxPTR
-# ifdef UINTPTR_MAX
-# define PRIxPTR @PRIPTR_PREFIX@ "x"
-# endif
+#endif
+#if !defined PRIxPTR || @PRI_MACROS_BROKEN@
+# undef PRIxPTR
+# ifdef UINTPTR_MAX
+# define PRIxPTR @PRIPTR_PREFIX@ "x"
# endif
-# if !defined PRIXPTR || @PRI_MACROS_BROKEN@
-# undef PRIXPTR
-# ifdef UINTPTR_MAX
-# define PRIXPTR @PRIPTR_PREFIX@ "X"
-# endif
+#endif
+#if !defined PRIXPTR || @PRI_MACROS_BROKEN@
+# undef PRIXPTR
+# ifdef UINTPTR_MAX
+# define PRIXPTR @PRIPTR_PREFIX@ "X"
# endif
+#endif
-# if !defined SCNd8 || @PRI_MACROS_BROKEN@
-# undef SCNd8
-# ifdef INT8_MAX
-# define SCNd8 "hhd"
-# endif
+#if !defined SCNd8 || @PRI_MACROS_BROKEN@
+# undef SCNd8
+# ifdef INT8_MAX
+# define SCNd8 "hhd"
# endif
-# if !defined SCNi8 || @PRI_MACROS_BROKEN@
-# undef SCNi8
-# ifdef INT8_MAX
-# define SCNi8 "hhi"
-# endif
+#endif
+#if !defined SCNi8 || @PRI_MACROS_BROKEN@
+# undef SCNi8
+# ifdef INT8_MAX
+# define SCNi8 "hhi"
# endif
-# if !defined SCNo8 || @PRI_MACROS_BROKEN@
-# undef SCNo8
-# ifdef UINT8_MAX
-# define SCNo8 "hho"
-# endif
+#endif
+#if !defined SCNo8 || @PRI_MACROS_BROKEN@
+# undef SCNo8
+# ifdef UINT8_MAX
+# define SCNo8 "hho"
# endif
-# if !defined SCNu8 || @PRI_MACROS_BROKEN@
-# undef SCNu8
-# ifdef UINT8_MAX
-# define SCNu8 "hhu"
-# endif
+#endif
+#if !defined SCNu8 || @PRI_MACROS_BROKEN@
+# undef SCNu8
+# ifdef UINT8_MAX
+# define SCNu8 "hhu"
# endif
-# if !defined SCNx8 || @PRI_MACROS_BROKEN@
-# undef SCNx8
-# ifdef UINT8_MAX
-# define SCNx8 "hhx"
-# endif
+#endif
+#if !defined SCNx8 || @PRI_MACROS_BROKEN@
+# undef SCNx8
+# ifdef UINT8_MAX
+# define SCNx8 "hhx"
# endif
-# if !defined SCNd16 || @PRI_MACROS_BROKEN@
-# undef SCNd16
-# ifdef INT16_MAX
-# define SCNd16 "hd"
-# endif
+#endif
+#if !defined SCNd16 || @PRI_MACROS_BROKEN@
+# undef SCNd16
+# ifdef INT16_MAX
+# define SCNd16 "hd"
# endif
-# if !defined SCNi16 || @PRI_MACROS_BROKEN@
-# undef SCNi16
-# ifdef INT16_MAX
-# define SCNi16 "hi"
-# endif
+#endif
+#if !defined SCNi16 || @PRI_MACROS_BROKEN@
+# undef SCNi16
+# ifdef INT16_MAX
+# define SCNi16 "hi"
# endif
-# if !defined SCNo16 || @PRI_MACROS_BROKEN@
-# undef SCNo16
-# ifdef UINT16_MAX
-# define SCNo16 "ho"
-# endif
+#endif
+#if !defined SCNo16 || @PRI_MACROS_BROKEN@
+# undef SCNo16
+# ifdef UINT16_MAX
+# define SCNo16 "ho"
# endif
-# if !defined SCNu16 || @PRI_MACROS_BROKEN@
-# undef SCNu16
-# ifdef UINT16_MAX
-# define SCNu16 "hu"
-# endif
+#endif
+#if !defined SCNu16 || @PRI_MACROS_BROKEN@
+# undef SCNu16
+# ifdef UINT16_MAX
+# define SCNu16 "hu"
# endif
-# if !defined SCNx16 || @PRI_MACROS_BROKEN@
-# undef SCNx16
-# ifdef UINT16_MAX
-# define SCNx16 "hx"
-# endif
+#endif
+#if !defined SCNx16 || @PRI_MACROS_BROKEN@
+# undef SCNx16
+# ifdef UINT16_MAX
+# define SCNx16 "hx"
# endif
-# if !defined SCNd32 || @PRI_MACROS_BROKEN@
-# undef SCNd32
-# ifdef INT32_MAX
-# define SCNd32 "d"
-# endif
+#endif
+#if !defined SCNd32 || @PRI_MACROS_BROKEN@
+# undef SCNd32
+# ifdef INT32_MAX
+# define SCNd32 "d"
# endif
-# if !defined SCNi32 || @PRI_MACROS_BROKEN@
-# undef SCNi32
-# ifdef INT32_MAX
-# define SCNi32 "i"
-# endif
+#endif
+#if !defined SCNi32 || @PRI_MACROS_BROKEN@
+# undef SCNi32
+# ifdef INT32_MAX
+# define SCNi32 "i"
# endif
-# if !defined SCNo32 || @PRI_MACROS_BROKEN@
-# undef SCNo32
-# ifdef UINT32_MAX
-# define SCNo32 "o"
-# endif
+#endif
+#if !defined SCNo32 || @PRI_MACROS_BROKEN@
+# undef SCNo32
+# ifdef UINT32_MAX
+# define SCNo32 "o"
# endif
-# if !defined SCNu32 || @PRI_MACROS_BROKEN@
-# undef SCNu32
-# ifdef UINT32_MAX
-# define SCNu32 "u"
-# endif
+#endif
+#if !defined SCNu32 || @PRI_MACROS_BROKEN@
+# undef SCNu32
+# ifdef UINT32_MAX
+# define SCNu32 "u"
# endif
-# if !defined SCNx32 || @PRI_MACROS_BROKEN@
-# undef SCNx32
-# ifdef UINT32_MAX
-# define SCNx32 "x"
-# endif
+#endif
+#if !defined SCNx32 || @PRI_MACROS_BROKEN@
+# undef SCNx32
+# ifdef UINT32_MAX
+# define SCNx32 "x"
# endif
-# ifdef INT64_MAX
-# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @INT64_MAX_EQ_LONG_MAX@)
-# define _SCN64_PREFIX "l"
-# elif defined _MSC_VER || defined __MINGW32__
-# define _SCN64_PREFIX "I64"
-# elif @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
-# define _SCN64_PREFIX _LONG_LONG_FORMAT_PREFIX
-# endif
-# if !defined SCNd64 || @PRI_MACROS_BROKEN@
-# undef SCNd64
-# define SCNd64 _SCN64_PREFIX "d"
-# endif
-# if !defined SCNi64 || @PRI_MACROS_BROKEN@
-# undef SCNi64
-# define SCNi64 _SCN64_PREFIX "i"
-# endif
+#endif
+#ifdef INT64_MAX
+# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @INT64_MAX_EQ_LONG_MAX@)
+# define _SCN64_PREFIX "l"
+# elif defined _MSC_VER || defined __MINGW32__
+# define _SCN64_PREFIX "I64"
+# elif @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
+# define _SCN64_PREFIX _LONG_LONG_FORMAT_PREFIX
+# endif
+# if !defined SCNd64 || @PRI_MACROS_BROKEN@
+# undef SCNd64
+# define SCNd64 _SCN64_PREFIX "d"
+# endif
+# if !defined SCNi64 || @PRI_MACROS_BROKEN@
+# undef SCNi64
+# define SCNi64 _SCN64_PREFIX "i"
# endif
-# ifdef UINT64_MAX
-# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @UINT64_MAX_EQ_ULONG_MAX@)
-# define _SCNu64_PREFIX "l"
-# elif defined _MSC_VER || defined __MINGW32__
-# define _SCNu64_PREFIX "I64"
-# elif @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
-# define _SCNu64_PREFIX _LONG_LONG_FORMAT_PREFIX
-# endif
-# if !defined SCNo64 || @PRI_MACROS_BROKEN@
-# undef SCNo64
-# define SCNo64 _SCNu64_PREFIX "o"
-# endif
-# if !defined SCNu64 || @PRI_MACROS_BROKEN@
-# undef SCNu64
-# define SCNu64 _SCNu64_PREFIX "u"
-# endif
-# if !defined SCNx64 || @PRI_MACROS_BROKEN@
-# undef SCNx64
-# define SCNx64 _SCNu64_PREFIX "x"
-# endif
+#endif
+#ifdef UINT64_MAX
+# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @UINT64_MAX_EQ_ULONG_MAX@)
+# define _SCNu64_PREFIX "l"
+# elif defined _MSC_VER || defined __MINGW32__
+# define _SCNu64_PREFIX "I64"
+# elif @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
+# define _SCNu64_PREFIX _LONG_LONG_FORMAT_PREFIX
+# endif
+# if !defined SCNo64 || @PRI_MACROS_BROKEN@
+# undef SCNo64
+# define SCNo64 _SCNu64_PREFIX "o"
+# endif
+# if !defined SCNu64 || @PRI_MACROS_BROKEN@
+# undef SCNu64
+# define SCNu64 _SCNu64_PREFIX "u"
+# endif
+# if !defined SCNx64 || @PRI_MACROS_BROKEN@
+# undef SCNx64
+# define SCNx64 _SCNu64_PREFIX "x"
# endif
+#endif
-# if !defined SCNdLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNdLEAST8
-# define SCNdLEAST8 "hhd"
-# endif
-# if !defined SCNiLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNiLEAST8
-# define SCNiLEAST8 "hhi"
-# endif
-# if !defined SCNoLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNoLEAST8
-# define SCNoLEAST8 "hho"
-# endif
-# if !defined SCNuLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNuLEAST8
-# define SCNuLEAST8 "hhu"
-# endif
-# if !defined SCNxLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNxLEAST8
-# define SCNxLEAST8 "hhx"
-# endif
-# if !defined SCNdLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNdLEAST16
-# define SCNdLEAST16 "hd"
-# endif
-# if !defined SCNiLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNiLEAST16
-# define SCNiLEAST16 "hi"
-# endif
-# if !defined SCNoLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNoLEAST16
-# define SCNoLEAST16 "ho"
-# endif
-# if !defined SCNuLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNuLEAST16
-# define SCNuLEAST16 "hu"
-# endif
-# if !defined SCNxLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNxLEAST16
-# define SCNxLEAST16 "hx"
-# endif
-# if !defined SCNdLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNdLEAST32
-# define SCNdLEAST32 "d"
-# endif
-# if !defined SCNiLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNiLEAST32
-# define SCNiLEAST32 "i"
-# endif
-# if !defined SCNoLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNoLEAST32
-# define SCNoLEAST32 "o"
-# endif
-# if !defined SCNuLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNuLEAST32
-# define SCNuLEAST32 "u"
-# endif
-# if !defined SCNxLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNxLEAST32
-# define SCNxLEAST32 "x"
-# endif
-# ifdef INT64_MAX
-# if !defined SCNdLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNdLEAST64
-# define SCNdLEAST64 SCNd64
-# endif
-# if !defined SCNiLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNiLEAST64
-# define SCNiLEAST64 SCNi64
-# endif
+#if !defined SCNdLEAST8 || @PRI_MACROS_BROKEN@
+# undef SCNdLEAST8
+# define SCNdLEAST8 "hhd"
+#endif
+#if !defined SCNiLEAST8 || @PRI_MACROS_BROKEN@
+# undef SCNiLEAST8
+# define SCNiLEAST8 "hhi"
+#endif
+#if !defined SCNoLEAST8 || @PRI_MACROS_BROKEN@
+# undef SCNoLEAST8
+# define SCNoLEAST8 "hho"
+#endif
+#if !defined SCNuLEAST8 || @PRI_MACROS_BROKEN@
+# undef SCNuLEAST8
+# define SCNuLEAST8 "hhu"
+#endif
+#if !defined SCNxLEAST8 || @PRI_MACROS_BROKEN@
+# undef SCNxLEAST8
+# define SCNxLEAST8 "hhx"
+#endif
+#if !defined SCNdLEAST16 || @PRI_MACROS_BROKEN@
+# undef SCNdLEAST16
+# define SCNdLEAST16 "hd"
+#endif
+#if !defined SCNiLEAST16 || @PRI_MACROS_BROKEN@
+# undef SCNiLEAST16
+# define SCNiLEAST16 "hi"
+#endif
+#if !defined SCNoLEAST16 || @PRI_MACROS_BROKEN@
+# undef SCNoLEAST16
+# define SCNoLEAST16 "ho"
+#endif
+#if !defined SCNuLEAST16 || @PRI_MACROS_BROKEN@
+# undef SCNuLEAST16
+# define SCNuLEAST16 "hu"
+#endif
+#if !defined SCNxLEAST16 || @PRI_MACROS_BROKEN@
+# undef SCNxLEAST16
+# define SCNxLEAST16 "hx"
+#endif
+#if !defined SCNdLEAST32 || @PRI_MACROS_BROKEN@
+# undef SCNdLEAST32
+# define SCNdLEAST32 "d"
+#endif
+#if !defined SCNiLEAST32 || @PRI_MACROS_BROKEN@
+# undef SCNiLEAST32
+# define SCNiLEAST32 "i"
+#endif
+#if !defined SCNoLEAST32 || @PRI_MACROS_BROKEN@
+# undef SCNoLEAST32
+# define SCNoLEAST32 "o"
+#endif
+#if !defined SCNuLEAST32 || @PRI_MACROS_BROKEN@
+# undef SCNuLEAST32
+# define SCNuLEAST32 "u"
+#endif
+#if !defined SCNxLEAST32 || @PRI_MACROS_BROKEN@
+# undef SCNxLEAST32
+# define SCNxLEAST32 "x"
+#endif
+#ifdef INT64_MAX
+# if !defined SCNdLEAST64 || @PRI_MACROS_BROKEN@
+# undef SCNdLEAST64
+# define SCNdLEAST64 SCNd64
# endif
-# ifdef UINT64_MAX
-# if !defined SCNoLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNoLEAST64
-# define SCNoLEAST64 SCNo64
-# endif
-# if !defined SCNuLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNuLEAST64
-# define SCNuLEAST64 SCNu64
-# endif
-# if !defined SCNxLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNxLEAST64
-# define SCNxLEAST64 SCNx64
-# endif
+# if !defined SCNiLEAST64 || @PRI_MACROS_BROKEN@
+# undef SCNiLEAST64
+# define SCNiLEAST64 SCNi64
+# endif
+#endif
+#ifdef UINT64_MAX
+# if !defined SCNoLEAST64 || @PRI_MACROS_BROKEN@
+# undef SCNoLEAST64
+# define SCNoLEAST64 SCNo64
+# endif
+# if !defined SCNuLEAST64 || @PRI_MACROS_BROKEN@
+# undef SCNuLEAST64
+# define SCNuLEAST64 SCNu64
+# endif
+# if !defined SCNxLEAST64 || @PRI_MACROS_BROKEN@
+# undef SCNxLEAST64
+# define SCNxLEAST64 SCNx64
# endif
+#endif
-# if !defined SCNdFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNdFAST8
-# if INT_FAST8_MAX > INT32_MAX
-# define SCNdFAST8 SCNd64
-# elif INT_FAST8_MAX == 0x7fff
-# define SCNdFAST8 "hd"
-# elif INT_FAST8_MAX == 0x7f
-# define SCNdFAST8 "hhd"
-# else
-# define SCNdFAST8 "d"
-# endif
+#if !defined SCNdFAST8 || @PRI_MACROS_BROKEN@
+# undef SCNdFAST8
+# if INT_FAST8_MAX > INT32_MAX
+# define SCNdFAST8 SCNd64
+# elif INT_FAST8_MAX == 0x7fff
+# define SCNdFAST8 "hd"
+# elif INT_FAST8_MAX == 0x7f
+# define SCNdFAST8 "hhd"
+# else
+# define SCNdFAST8 "d"
# endif
-# if !defined SCNiFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNiFAST8
-# if INT_FAST8_MAX > INT32_MAX
-# define SCNiFAST8 SCNi64
-# elif INT_FAST8_MAX == 0x7fff
-# define SCNiFAST8 "hi"
-# elif INT_FAST8_MAX == 0x7f
-# define SCNiFAST8 "hhi"
-# else
-# define SCNiFAST8 "i"
-# endif
+#endif
+#if !defined SCNiFAST8 || @PRI_MACROS_BROKEN@
+# undef SCNiFAST8
+# if INT_FAST8_MAX > INT32_MAX
+# define SCNiFAST8 SCNi64
+# elif INT_FAST8_MAX == 0x7fff
+# define SCNiFAST8 "hi"
+# elif INT_FAST8_MAX == 0x7f
+# define SCNiFAST8 "hhi"
+# else
+# define SCNiFAST8 "i"
# endif
-# if !defined SCNoFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNoFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define SCNoFAST8 SCNo64
-# elif UINT_FAST8_MAX == 0xffff
-# define SCNoFAST8 "ho"
-# elif UINT_FAST8_MAX == 0xff
-# define SCNoFAST8 "hho"
-# else
-# define SCNoFAST8 "o"
-# endif
+#endif
+#if !defined SCNoFAST8 || @PRI_MACROS_BROKEN@
+# undef SCNoFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define SCNoFAST8 SCNo64
+# elif UINT_FAST8_MAX == 0xffff
+# define SCNoFAST8 "ho"
+# elif UINT_FAST8_MAX == 0xff
+# define SCNoFAST8 "hho"
+# else
+# define SCNoFAST8 "o"
# endif
-# if !defined SCNuFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNuFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define SCNuFAST8 SCNu64
-# elif UINT_FAST8_MAX == 0xffff
-# define SCNuFAST8 "hu"
-# elif UINT_FAST8_MAX == 0xff
-# define SCNuFAST8 "hhu"
-# else
-# define SCNuFAST8 "u"
-# endif
+#endif
+#if !defined SCNuFAST8 || @PRI_MACROS_BROKEN@
+# undef SCNuFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define SCNuFAST8 SCNu64
+# elif UINT_FAST8_MAX == 0xffff
+# define SCNuFAST8 "hu"
+# elif UINT_FAST8_MAX == 0xff
+# define SCNuFAST8 "hhu"
+# else
+# define SCNuFAST8 "u"
# endif
-# if !defined SCNxFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNxFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define SCNxFAST8 SCNx64
-# elif UINT_FAST8_MAX == 0xffff
-# define SCNxFAST8 "hx"
-# elif UINT_FAST8_MAX == 0xff
-# define SCNxFAST8 "hhx"
-# else
-# define SCNxFAST8 "x"
-# endif
+#endif
+#if !defined SCNxFAST8 || @PRI_MACROS_BROKEN@
+# undef SCNxFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define SCNxFAST8 SCNx64
+# elif UINT_FAST8_MAX == 0xffff
+# define SCNxFAST8 "hx"
+# elif UINT_FAST8_MAX == 0xff
+# define SCNxFAST8 "hhx"
+# else
+# define SCNxFAST8 "x"
# endif
-# if !defined SCNdFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNdFAST16
-# if INT_FAST16_MAX > INT32_MAX
-# define SCNdFAST16 SCNd64
-# elif INT_FAST16_MAX == 0x7fff
-# define SCNdFAST16 "hd"
-# else
-# define SCNdFAST16 "d"
-# endif
+#endif
+#if !defined SCNdFAST16 || @PRI_MACROS_BROKEN@
+# undef SCNdFAST16
+# if INT_FAST16_MAX > INT32_MAX
+# define SCNdFAST16 SCNd64
+# elif INT_FAST16_MAX == 0x7fff
+# define SCNdFAST16 "hd"
+# else
+# define SCNdFAST16 "d"
# endif
-# if !defined SCNiFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNiFAST16
-# if INT_FAST16_MAX > INT32_MAX
-# define SCNiFAST16 SCNi64
-# elif INT_FAST16_MAX == 0x7fff
-# define SCNiFAST16 "hi"
-# else
-# define SCNiFAST16 "i"
-# endif
+#endif
+#if !defined SCNiFAST16 || @PRI_MACROS_BROKEN@
+# undef SCNiFAST16
+# if INT_FAST16_MAX > INT32_MAX
+# define SCNiFAST16 SCNi64
+# elif INT_FAST16_MAX == 0x7fff
+# define SCNiFAST16 "hi"
+# else
+# define SCNiFAST16 "i"
# endif
-# if !defined SCNoFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNoFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define SCNoFAST16 SCNo64
-# elif UINT_FAST16_MAX == 0xffff
-# define SCNoFAST16 "ho"
-# else
-# define SCNoFAST16 "o"
-# endif
+#endif
+#if !defined SCNoFAST16 || @PRI_MACROS_BROKEN@
+# undef SCNoFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define SCNoFAST16 SCNo64
+# elif UINT_FAST16_MAX == 0xffff
+# define SCNoFAST16 "ho"
+# else
+# define SCNoFAST16 "o"
# endif
-# if !defined SCNuFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNuFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define SCNuFAST16 SCNu64
-# elif UINT_FAST16_MAX == 0xffff
-# define SCNuFAST16 "hu"
-# else
-# define SCNuFAST16 "u"
-# endif
+#endif
+#if !defined SCNuFAST16 || @PRI_MACROS_BROKEN@
+# undef SCNuFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define SCNuFAST16 SCNu64
+# elif UINT_FAST16_MAX == 0xffff
+# define SCNuFAST16 "hu"
+# else
+# define SCNuFAST16 "u"
# endif
-# if !defined SCNxFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNxFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define SCNxFAST16 SCNx64
-# elif UINT_FAST16_MAX == 0xffff
-# define SCNxFAST16 "hx"
-# else
-# define SCNxFAST16 "x"
-# endif
+#endif
+#if !defined SCNxFAST16 || @PRI_MACROS_BROKEN@
+# undef SCNxFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define SCNxFAST16 SCNx64
+# elif UINT_FAST16_MAX == 0xffff
+# define SCNxFAST16 "hx"
+# else
+# define SCNxFAST16 "x"
# endif
-# if !defined SCNdFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNdFAST32
-# if INT_FAST32_MAX > INT32_MAX
-# define SCNdFAST32 SCNd64
-# else
-# define SCNdFAST32 "d"
-# endif
+#endif
+#if !defined SCNdFAST32 || @PRI_MACROS_BROKEN@
+# undef SCNdFAST32
+# if INT_FAST32_MAX > INT32_MAX
+# define SCNdFAST32 SCNd64
+# else
+# define SCNdFAST32 "d"
# endif
-# if !defined SCNiFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNiFAST32
-# if INT_FAST32_MAX > INT32_MAX
-# define SCNiFAST32 SCNi64
-# else
-# define SCNiFAST32 "i"
-# endif
+#endif
+#if !defined SCNiFAST32 || @PRI_MACROS_BROKEN@
+# undef SCNiFAST32
+# if INT_FAST32_MAX > INT32_MAX
+# define SCNiFAST32 SCNi64
+# else
+# define SCNiFAST32 "i"
# endif
-# if !defined SCNoFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNoFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define SCNoFAST32 SCNo64
-# else
-# define SCNoFAST32 "o"
-# endif
+#endif
+#if !defined SCNoFAST32 || @PRI_MACROS_BROKEN@
+# undef SCNoFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define SCNoFAST32 SCNo64
+# else
+# define SCNoFAST32 "o"
# endif
-# if !defined SCNuFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNuFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define SCNuFAST32 SCNu64
-# else
-# define SCNuFAST32 "u"
-# endif
+#endif
+#if !defined SCNuFAST32 || @PRI_MACROS_BROKEN@
+# undef SCNuFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define SCNuFAST32 SCNu64
+# else
+# define SCNuFAST32 "u"
# endif
-# if !defined SCNxFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNxFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define SCNxFAST32 SCNx64
-# else
-# define SCNxFAST32 "x"
-# endif
+#endif
+#if !defined SCNxFAST32 || @PRI_MACROS_BROKEN@
+# undef SCNxFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define SCNxFAST32 SCNx64
+# else
+# define SCNxFAST32 "x"
# endif
-# ifdef INT64_MAX
-# if !defined SCNdFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNdFAST64
-# define SCNdFAST64 SCNd64
-# endif
-# if !defined SCNiFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNiFAST64
-# define SCNiFAST64 SCNi64
-# endif
+#endif
+#ifdef INT64_MAX
+# if !defined SCNdFAST64 || @PRI_MACROS_BROKEN@
+# undef SCNdFAST64
+# define SCNdFAST64 SCNd64
# endif
-# ifdef UINT64_MAX
-# if !defined SCNoFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNoFAST64
-# define SCNoFAST64 SCNo64
-# endif
-# if !defined SCNuFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNuFAST64
-# define SCNuFAST64 SCNu64
-# endif
-# if !defined SCNxFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNxFAST64
-# define SCNxFAST64 SCNx64
-# endif
+# if !defined SCNiFAST64 || @PRI_MACROS_BROKEN@
+# undef SCNiFAST64
+# define SCNiFAST64 SCNi64
+# endif
+#endif
+#ifdef UINT64_MAX
+# if !defined SCNoFAST64 || @PRI_MACROS_BROKEN@
+# undef SCNoFAST64
+# define SCNoFAST64 SCNo64
# endif
+# if !defined SCNuFAST64 || @PRI_MACROS_BROKEN@
+# undef SCNuFAST64
+# define SCNuFAST64 SCNu64
+# endif
+# if !defined SCNxFAST64 || @PRI_MACROS_BROKEN@
+# undef SCNxFAST64
+# define SCNxFAST64 SCNx64
+# endif
+#endif
-# if !defined SCNdMAX || @PRI_MACROS_BROKEN@
-# undef SCNdMAX
-# if @INT32_MAX_LT_INTMAX_MAX@
-# define SCNdMAX SCNd64
-# else
-# define SCNdMAX "ld"
-# endif
+#if !defined SCNdMAX || @PRI_MACROS_BROKEN@
+# undef SCNdMAX
+# if @INT32_MAX_LT_INTMAX_MAX@
+# define SCNdMAX SCNd64
+# else
+# define SCNdMAX "ld"
# endif
-# if !defined SCNiMAX || @PRI_MACROS_BROKEN@
-# undef SCNiMAX
-# if @INT32_MAX_LT_INTMAX_MAX@
-# define SCNiMAX SCNi64
-# else
-# define SCNiMAX "li"
-# endif
+#endif
+#if !defined SCNiMAX || @PRI_MACROS_BROKEN@
+# undef SCNiMAX
+# if @INT32_MAX_LT_INTMAX_MAX@
+# define SCNiMAX SCNi64
+# else
+# define SCNiMAX "li"
# endif
-# if !defined SCNoMAX || @PRI_MACROS_BROKEN@
-# undef SCNoMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define SCNoMAX SCNo64
-# else
-# define SCNoMAX "lo"
-# endif
+#endif
+#if !defined SCNoMAX || @PRI_MACROS_BROKEN@
+# undef SCNoMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define SCNoMAX SCNo64
+# else
+# define SCNoMAX "lo"
# endif
-# if !defined SCNuMAX || @PRI_MACROS_BROKEN@
-# undef SCNuMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define SCNuMAX SCNu64
-# else
-# define SCNuMAX "lu"
-# endif
+#endif
+#if !defined SCNuMAX || @PRI_MACROS_BROKEN@
+# undef SCNuMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define SCNuMAX SCNu64
+# else
+# define SCNuMAX "lu"
# endif
-# if !defined SCNxMAX || @PRI_MACROS_BROKEN@
-# undef SCNxMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define SCNxMAX SCNx64
-# else
-# define SCNxMAX "lx"
-# endif
+#endif
+#if !defined SCNxMAX || @PRI_MACROS_BROKEN@
+# undef SCNxMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define SCNxMAX SCNx64
+# else
+# define SCNxMAX "lx"
# endif
+#endif
-# if !defined SCNdPTR || @PRI_MACROS_BROKEN@
-# undef SCNdPTR
-# ifdef INTPTR_MAX
-# define SCNdPTR @PRIPTR_PREFIX@ "d"
-# endif
+#if !defined SCNdPTR || @PRI_MACROS_BROKEN@
+# undef SCNdPTR
+# ifdef INTPTR_MAX
+# define SCNdPTR @PRIPTR_PREFIX@ "d"
# endif
-# if !defined SCNiPTR || @PRI_MACROS_BROKEN@
-# undef SCNiPTR
-# ifdef INTPTR_MAX
-# define SCNiPTR @PRIPTR_PREFIX@ "i"
-# endif
+#endif
+#if !defined SCNiPTR || @PRI_MACROS_BROKEN@
+# undef SCNiPTR
+# ifdef INTPTR_MAX
+# define SCNiPTR @PRIPTR_PREFIX@ "i"
# endif
-# if !defined SCNoPTR || @PRI_MACROS_BROKEN@
-# undef SCNoPTR
-# ifdef UINTPTR_MAX
-# define SCNoPTR @PRIPTR_PREFIX@ "o"
-# endif
+#endif
+#if !defined SCNoPTR || @PRI_MACROS_BROKEN@
+# undef SCNoPTR
+# ifdef UINTPTR_MAX
+# define SCNoPTR @PRIPTR_PREFIX@ "o"
# endif
-# if !defined SCNuPTR || @PRI_MACROS_BROKEN@
-# undef SCNuPTR
-# ifdef UINTPTR_MAX
-# define SCNuPTR @PRIPTR_PREFIX@ "u"
-# endif
+#endif
+#if !defined SCNuPTR || @PRI_MACROS_BROKEN@
+# undef SCNuPTR
+# ifdef UINTPTR_MAX
+# define SCNuPTR @PRIPTR_PREFIX@ "u"
# endif
-# if !defined SCNxPTR || @PRI_MACROS_BROKEN@
-# undef SCNxPTR
-# ifdef UINTPTR_MAX
-# define SCNxPTR @PRIPTR_PREFIX@ "x"
-# endif
+#endif
+#if !defined SCNxPTR || @PRI_MACROS_BROKEN@
+# undef SCNxPTR
+# ifdef UINTPTR_MAX
+# define SCNxPTR @PRIPTR_PREFIX@ "x"
# endif
-
#endif
/* 7.8.2 Functions for greatest-width integer types */
@@ -1075,10 +1079,23 @@ _GL_WARN_ON_USE (imaxdiv, "imaxdiv is unportable - "
#endif
#if @GNULIB_STRTOIMAX@
-# if !@HAVE_DECL_STRTOIMAX@
-# undef strtoimax
-extern intmax_t strtoimax (const char *, char **, int) _GL_ARG_NONNULL ((1));
+# if @REPLACE_STRTOIMAX@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef strtoimax
+# define strtoimax rpl_strtoimax
+# endif
+_GL_FUNCDECL_RPL (strtoimax, intmax_t,
+ (const char *, char **, int) _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (strtoimax, intmax_t, (const char *, char **, int));
+# else
+# if !@HAVE_DECL_STRTOIMAX@
+# undef strtoimax
+_GL_FUNCDECL_SYS (strtoimax, intmax_t,
+ (const char *, char **, int) _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (strtoimax, intmax_t, (const char *, char **, int));
# endif
+_GL_CXXALIASWARN (strtoimax);
#elif defined GNULIB_POSIXCHECK
# undef strtoimax
# if HAVE_RAW_DECL_STRTOIMAX
@@ -1090,8 +1107,11 @@ _GL_WARN_ON_USE (strtoimax, "strtoimax is unportable - "
#if @GNULIB_STRTOUMAX@
# if !@HAVE_DECL_STRTOUMAX@
# undef strtoumax
-extern uintmax_t strtoumax (const char *, char **, int) _GL_ARG_NONNULL ((1));
+_GL_FUNCDECL_SYS (strtoumax, uintmax_t,
+ (const char *, char **, int) _GL_ARG_NONNULL ((1)));
# endif
+_GL_CXXALIAS_SYS (strtoumax, uintmax_t, (const char *, char **, int));
+_GL_CXXALIASWARN (strtoumax);
#elif defined GNULIB_POSIXCHECK
# undef strtoumax
# if HAVE_RAW_DECL_STRTOUMAX
diff --git a/lib/lstat.c b/lib/lstat.c
index d786288f2b7..db119a10d3f 100644
--- a/lib/lstat.c
+++ b/lib/lstat.c
@@ -1,6 +1,6 @@
/* Work around a bug of lstat on some systems
- Copyright (C) 1997-2006, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 1997-2006, 2008-2012 Free Software Foundation, Inc.
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
@@ -51,11 +51,11 @@ orig_lstat (const char *filename, struct stat *buf)
# include <errno.h>
/* lstat works differently on Linux and Solaris systems. POSIX (see
- `pathname resolution' in the glossary) requires that programs like
- `ls' take into consideration the fact that FILE has a trailing slash
+ "pathname resolution" in the glossary) requires that programs like
+ 'ls' take into consideration the fact that FILE has a trailing slash
when FILE is a symbolic link. On Linux and Solaris 10 systems, the
lstat function already has the desired semantics (in treating
- `lstat ("symlink/", sbuf)' just like `lstat ("symlink/.", sbuf)',
+ 'lstat ("symlink/", sbuf)' just like 'lstat ("symlink/.", sbuf)',
but on Solaris 9 and earlier it does not.
If FILE has a trailing slash and specifies a symbolic link,
diff --git a/lib/makefile.w32-in b/lib/makefile.w32-in
index d5304258879..67171e07900 100644
--- a/lib/makefile.w32-in
+++ b/lib/makefile.w32-in
@@ -1,5 +1,5 @@
-# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
-# Copyright (C) 2011 Free Software Foundation, Inc.
+# -*- Makefile -*- for GNU Emacs on the Microsoft Windows API.
+# Copyright (C) 2011-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -20,18 +20,31 @@ ALL = gnulib
.PHONY: $(ALL)
-LOCAL_FLAGS = -DHAVE_CONFIG_H=1 -I. -I../nt/inc -I../src
+LOCAL_FLAGS = -I. -I../nt/inc -I../src
LIBS =
-GNULIBOBJS = $(BLD)/dtoastr.$(O) \
+GNULIBOBJS = $(BLD)/c-ctype.$(O) \
+ $(BLD)/c-strcasecmp.$(O) \
+ $(BLD)/c-strncasecmp.$(O) \
+ $(BLD)/close-stream.$(O) \
+ $(BLD)/dtoastr.$(O) \
+ $(BLD)/dtotimespec.$(O) \
+ $(BLD)/execinfo.$(O) \
+ $(BLD)/fpending.$(O) \
$(BLD)/getopt.$(O) \
$(BLD)/getopt1.$(O) \
+ $(BLD)/gettime.$(O) \
$(BLD)/strftime.$(O) \
$(BLD)/time_r.$(O) \
+ $(BLD)/timespec-add.$(O) \
+ $(BLD)/timespec-sub.$(O) \
$(BLD)/md5.$(O) \
$(BLD)/sha1.$(O) \
$(BLD)/sha256.$(O) \
$(BLD)/sha512.$(O) \
+ $(BLD)/stat-time.$(O) \
+ $(BLD)/timespec.$(O) \
+ $(BLD)/u64.$(O) \
$(BLD)/filemode.$(O)
#
@@ -41,12 +54,12 @@ $(BLD)/libgnu.$(A): $(GNULIBOBJS)
- $(DEL) $@
$(AR) $(AR_OUT)$@ $(ALL_DEPS)
-gnulib: stamp_BLD $(BLD)/libgnu.$(A)
+gnulib: $(BLD)/libgnu.$(A)
#
# Build everything
#
-all: stamp_BLD $(ALL)
+all: $(ALL)
### TAGS ###
@@ -58,104 +71,178 @@ TAGS: FRC
### DEPENDENCIES ###
EMACS_ROOT = ..
-SRC = .
+GNU_LIB = .
+SRC = $(EMACS_ROOT)/src
+NT_INC = $(EMACS_ROOT)/nt/inc
+
+C_CTYPE_H = $(GNU_LIB)/c-ctype.h \
+ $(NT_INC)/stdbool.h
+MS_W32_H = $(NT_INC)/ms-w32.h \
+ $(NT_INC)/sys/stat.h
+CONF_POST_H = $(SRC)/conf_post.h \
+ $(MS_W32_H)
+CONFIG_H = $(SRC)/config.h \
+ $(CONF_POST_H)
+FILEMODE_H = $(GNU_LIB)/filemode.h \
+ $(NT_INC)/sys/stat.h
+FTOASTR_H = $(GNU_LIB)/ftoastr.h \
+ $(GNU_LIB)/intprops.h
+FTOASTR_C = $(GNU_LIB)/ftoastr.c \
+ $(CONFIG_H) \
+ $(FTOASTR_H)
+GETOPT_INT_H = $(GNU_LIB)/getopt_int.h \
+ $(GNU_LIB)/getopt.h
+MD5_H = $(GNU_LIB)/md5.h \
+ $(NT_INC)/stdint.h
+SHA1_H = $(GNU_LIB)/sha1.h \
+ $(NT_INC)/stdint.h
+SHA256_H = $(GNU_LIB)/sha256.h \
+ $(NT_INC)/stdint.h
+U64_H = $(GNU_LIB)/u64.h \
+ $(NT_INC)/stdint.h
+SHA512_H = $(GNU_LIB)/sha512.h \
+ $(U64_H)
+STAT_TIME_H = $(GNU_LIB)/stat-time.h \
+ $(NT_INC)/sys/stat.h
+
+$(BLD)/c-ctype.$(O) : \
+ $(GNU_LIB)/c-ctype.c \
+ $(CONFIG_H) \
+ $(C_CTYPE_H)
+
+$(BLD)/c-strcasecmp.$(O) : \
+ $(GNU_LIB)/c-strcasecmp.c \
+ $(GNU_LIB)/c-strcase.h \
+ $(CONFIG_H) \
+ $(C_CTYPE_H)
+
+$(BLD)/c-strncasecmp.$(O) : \
+ $(GNU_LIB)/c-strncasecmp.c \
+ $(GNU_LIB)/c-strcase.h \
+ $(CONFIG_H) \
+ $(C_CTYPE_H)
+
+$(BLD)/close-stream.$(O) : \
+ $(GNU_LIB)/close-stream.c \
+ $(GNU_LIB)/close-stream.h \
+ $(GNU_LIB)/fpending.h \
+ $(NT_INC)/stdbool.h \
+ $(CONFIG_H)
$(BLD)/dtoastr.$(O) : \
- $(SRC)/dtoastr.c \
- $(SRC)/ftoastr.c \
- $(SRC)/ftoastr.h \
- $(SRC)/intprops.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/dtoastr.c \
+ $(FTOASTR_C)
+
+$(BLD)/dtotimespec.$(O) : \
+ $(GNU_LIB)/dtotimespec.c \
+ $(GNU_LIB)/intprops.h \
+ $(GNU_LIB)/timespec.h \
+ $(CONFIG_H)
+
+$(BLD)/execinfo.$(O) : \
+ $(GNU_LIB)/execinfo.c \
+ $(GNU_LIB)/execinfo.h \
+ $(CONFIG_H)
+
+$(BLD)/fpending.$(O) : \
+ $(GNU_LIB)/fpending.c \
+ $(GNU_LIB)/fpending.h \
+ $(CONFIG_H)
$(BLD)/getopt.$(O) : \
- $(SRC)/getopt.c \
- $(SRC)/getopt.h \
- $(SRC)/getopt_int.h \
- $(SRC)/gettext.h \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/getopt.c \
+ $(GNU_LIB)/getopt.h \
+ $(GNU_LIB)/gettext.h \
+ $(NT_INC)/unistd.h \
+ $(CONFIG_H) \
+ $(GETOPT_INT_H)
$(BLD)/getopt1.$(O) : \
- $(SRC)/getopt1.c \
- $(SRC)/getopt.h \
- $(SRC)/getopt_int.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/getopt1.c \
+ $(GNU_LIB)/getopt.h \
+ $(CONFIG_H) \
+ $(GETOPT_INT_H)
+
+$(BLD)/gettime.$(O) : \
+ $(GNU_LIB)/gettime.c \
+ $(GNU_LIB)/timespec.h \
+ $(NT_INC)/sys/time.h \
+ $(CONFIG_H)
$(BLD)/strftime.$(O) : \
- $(SRC)/strftime.c \
- $(SRC)/strftime.h \
- $(EMACS_ROOT)/nt/inc/stdbool.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/strftime.c \
+ $(GNU_LIB)/strftime.h \
+ $(NT_INC)/stdbool.h \
+ $(CONFIG_H)
$(BLD)/time_r.$(O) : \
- $(SRC)/time_r.c \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/time_r.c \
+ $(CONFIG_H)
+
+$(BLD)/timespec-add.$(O) : \
+ $(GNU_LIB)/timespec-add.c \
+ $(GNU_LIB)/intprops.h \
+ $(GNU_LIB)/timespec.h \
+ $(CONFIG_H)
+
+$(BLD)/timespec-sub.$(O) : \
+ $(GNU_LIB)/timespec-sub.c \
+ $(GNU_LIB)/intprops.h \
+ $(GNU_LIB)/timespec.h \
+ $(CONFIG_H)
$(BLD)/md5.$(O) : \
- $(SRC)/md5.c \
- $(SRC)/md5.h \
- $(EMACS_ROOT)/nt/inc/stdint.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/md5.c \
+ $(NT_INC)/stdalign.h \
+ $(NT_INC)/stdint.h \
+ $(CONFIG_H) \
+ $(MD5_H)
$(BLD)/sha1.$(O) : \
- $(SRC)/sha1.c \
- $(SRC)/sha1.h \
- $(EMACS_ROOT)/nt/inc/stdint.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/sha1.c \
+ $(NT_INC)/stdalign.h \
+ $(NT_INC)/stdint.h \
+ $(CONFIG_H) \
+ $(SHA1_H)
$(BLD)/sha256.$(O) : \
- $(SRC)/sha256.c \
- $(SRC)/sha256.h \
- $(EMACS_ROOT)/nt/inc/stdint.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/sha256.c \
+ $(NT_INC)/stdalign.h \
+ $(NT_INC)/stdint.h \
+ $(CONFIG_H) \
+ $(SHA256_H)
$(BLD)/sha512.$(O) : \
- $(SRC)/sha512.c \
- $(SRC)/sha512.h \
- $(EMACS_ROOT)/nt/inc/stdint.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/sha512.c \
+ $(NT_INC)/stdalign.h \
+ $(NT_INC)/stdint.h \
+ $(CONFIG_H) \
+ $(SHA512_H)
+
+$(BLD)/stat-time.$(O) : \
+ $(GNU_LIB)/stat-time.c \
+ $(CONFIG_H) \
+ $(STAT_TIME_H)
+
+$(BLD)/timespec.$(O) : \
+ $(GNU_LIB)/timespec.c \
+ $(GNU_LIB)/timespec.h \
+ $(CONFIG_H)
+
+$(BLD)/u64.$(O) : \
+ $(GNU_LIB)/u64.c \
+ $(CONFIG_H) \
+ $(U64_H)
$(BLD)/filemode.$(O) : \
- $(SRC)/filemode.c \
- $(SRC)/filemode.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/filemode.c \
+ $(CONFIG_H) \
+ $(FILEMODE_H)
# The following dependencies are for supporting parallel builds, where
# we must make sure $(BLD) exists before any compilation starts.
#
-$(BLD)/dtoastr.$(O) $(BLD)/getopt.$(O) $(BLD)/getopt1.$(O): stamp_BLD
-$(BLD)/strftime.$(O) $(BLD)/time_r.$(O) $(BLD)/md5.$(O): stamp_BLD
-$(BLD)/filemode.$(O): stamp_BLD
+$(GNULIBOBJS): stamp_BLD
#
# Headers we would preprocess if we could.
@@ -212,7 +299,6 @@ getopt_.h-SH: doit
HAVE_GETOPT_H = HAVE_GETOPT_H
INCLUDE_NEXT = include_next
-PRAGMA_SYSTEM_HEADER = \#pragma GCC system_header
PRAGMA_COLUMNS =
NEXT_GETOPT_H = <getopt.h>
ARG_NONNULL_H = ../build-aux/snippet/arg-nonnull.h
@@ -233,3 +319,7 @@ getopt_h:
< getopt.in.h > getopt_.h-t
$(CP) getopt_.h-t getopt_.h
- $(DEL) getopt_.h-t
+
+execinfo.h: execinfo.in.h
+ $(CP) execinfo.in.h $@
+
diff --git a/lib/md5.c b/lib/md5.c
index b7fad633364..30b7e50e3ae 100644
--- a/lib/md5.c
+++ b/lib/md5.c
@@ -1,6 +1,6 @@
/* Functions to compute MD5 message digest of files or memory blocks.
according to the definition of MD5 in RFC 1321 from April 1992.
- Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2011 Free Software
+ Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2012 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
@@ -15,8 +15,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
/* Written by Ulrich Drepper <drepper@gnu.ai.mit.edu>, 1995. */
@@ -24,7 +23,8 @@
#include "md5.h"
-#include <stddef.h>
+#include <stdalign.h>
+#include <stdint.h>
#include <stdlib.h>
#include <string.h>
#include <sys/types.h>
@@ -254,8 +254,7 @@ md5_process_bytes (const void *buffer, size_t len, struct md5_ctx *ctx)
if (len >= 64)
{
#if !_STRING_ARCH_unaligned
-# define alignof(type) offsetof (struct { char c; type x; }, x)
-# define UNALIGNED_P(p) (((size_t) p) % alignof (uint32_t) != 0)
+# define UNALIGNED_P(p) ((uintptr_t) (p) % alignof (uint32_t) != 0)
if (UNALIGNED_P (buffer))
while (len > 64)
{
@@ -313,13 +312,13 @@ md5_process_block (const void *buffer, size_t len, struct md5_ctx *ctx)
uint32_t B = ctx->B;
uint32_t C = ctx->C;
uint32_t D = ctx->D;
+ uint32_t lolen = len;
/* First increment the byte count. RFC 1321 specifies the possible
length of the file up to 2^64 bits. Here we only compute the
number of bytes. Do a double word increment. */
- ctx->total[0] += len;
- if (ctx->total[0] < len)
- ++ctx->total[1];
+ ctx->total[0] += lolen;
+ ctx->total[1] += (len >> 31 >> 1) + (ctx->total[0] < lolen);
/* Process all bytes in the buffer with 64 bytes in each round of
the loop. */
diff --git a/lib/md5.h b/lib/md5.h
index 53e60480292..75d6bce5c33 100644
--- a/lib/md5.h
+++ b/lib/md5.h
@@ -1,6 +1,6 @@
/* Declaration of functions and data types used for MD5 sum computing
library functions.
- Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2011 Free Software
+ Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2012 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
@@ -15,8 +15,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#ifndef _MD5_H
#define _MD5_H 1
@@ -73,7 +72,7 @@ struct md5_ctx
/*
* The following three functions are build up the low level used in
- * the functions `md5_stream' and `md5_buffer'.
+ * the functions 'md5_stream' and 'md5_buffer'.
*/
/* Initialize structure containing state of computation.
diff --git a/lib/mktime.c b/lib/mktime.c
index c68ad9ba262..74d1b84949b 100644
--- a/lib/mktime.c
+++ b/lib/mktime.c
@@ -1,21 +1,21 @@
-/* Convert a `struct tm' to a time_t value.
- Copyright (C) 1993-1999, 2002-2007, 2009-2011 Free Software Foundation, Inc.
+/* Convert a 'struct tm' to a time_t value.
+ Copyright (C) 1993-2012 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Paul Eggert <eggert@twinsun.com>.
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 3, or (at your option)
- any later version.
+ The GNU C Library 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,
+ The GNU C Library 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.
+ 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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ You should have received a copy of the GNU General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
/* Define this to have a standalone program to test this implementation of
mktime. */
@@ -25,26 +25,8 @@
# include <config.h>
#endif
-/* Some of the code in this file assumes that signed integer overflow
- silently wraps around. This assumption can't easily be programmed
- around, nor can it be checked for portably at compile-time or
- easily eliminated at run-time.
-
- Define WRAPV to 1 if the assumption is valid. Otherwise, define it
- to 0; this forces the use of slower code that, while not guaranteed
- by the C Standard, works on all production platforms that we know
- about. */
-#ifndef WRAPV
-# if (__GNUC__ == 4 && 4 <= __GNUC_MINOR__) || 4 < __GNUC__
-# pragma GCC optimize ("wrapv")
-# define WRAPV 1
-# else
-# define WRAPV 0
-# endif
-#endif
-
/* Assume that leap seconds are possible, unless told otherwise.
- If the host has a `zic' command with a `-L leapsecondfilename' option,
+ If the host has a 'zic' command with a '-L leapsecondfilename' option,
then it supports leap seconds; otherwise it probably doesn't. */
#ifndef LEAP_SECONDS_POSSIBLE
# define LEAP_SECONDS_POSSIBLE 1
@@ -54,7 +36,7 @@
#include <limits.h>
-#include <string.h> /* For the real memcpy prototype. */
+#include <string.h> /* For the real memcpy prototype. */
#if DEBUG
# include <stdio.h>
@@ -64,6 +46,28 @@
# define mktime my_mktime
#endif /* DEBUG */
+/* Some of the code in this file assumes that signed integer overflow
+ silently wraps around. This assumption can't easily be programmed
+ around, nor can it be checked for portably at compile-time or
+ easily eliminated at run-time.
+
+ Define WRAPV to 1 if the assumption is valid and if
+ #pragma GCC optimize ("wrapv")
+ does not trigger GCC bug 51793
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=51793>.
+ Otherwise, define it to 0; this forces the use of slower code that,
+ while not guaranteed by the C Standard, works on all production
+ platforms that we know about. */
+#ifndef WRAPV
+# if (((__GNUC__ == 4 && 4 <= __GNUC_MINOR__) || 4 < __GNUC__) \
+ && defined __GLIBC__)
+# pragma GCC optimize ("wrapv")
+# define WRAPV 1
+# else
+# define WRAPV 0
+# endif
+#endif
+
/* Verify a requirement at compile-time (unlike assert, which is runtime). */
#define verify(name, assertion) struct name { char a[(assertion) ? 1 : -1]; }
@@ -112,12 +116,12 @@ verify (long_int_is_wide_enough, INT_MAX == INT_MAX * (long_int) 2 / 2);
your host. */
#define TYPE_MINIMUM(t) \
((t) (! TYPE_SIGNED (t) \
- ? (t) 0 \
- : ~ TYPE_MAXIMUM (t)))
+ ? (t) 0 \
+ : ~ TYPE_MAXIMUM (t)))
#define TYPE_MAXIMUM(t) \
((t) (! TYPE_SIGNED (t) \
- ? (t) -1 \
- : ((((t) 1 << (sizeof (t) * CHAR_BIT - 2)) - 1) * 2 + 1)))
+ ? (t) -1 \
+ : ((((t) 1 << (sizeof (t) * CHAR_BIT - 2)) - 1) * 2 + 1)))
#ifndef TIME_T_MIN
# define TIME_T_MIN TYPE_MINIMUM (time_t)
@@ -129,16 +133,16 @@ verify (long_int_is_wide_enough, INT_MAX == INT_MAX * (long_int) 2 / 2);
verify (time_t_is_integer, TYPE_IS_INTEGER (time_t));
verify (twos_complement_arithmetic,
- (TYPE_TWOS_COMPLEMENT (int)
- && TYPE_TWOS_COMPLEMENT (long_int)
- && TYPE_TWOS_COMPLEMENT (time_t)));
+ (TYPE_TWOS_COMPLEMENT (int)
+ && TYPE_TWOS_COMPLEMENT (long_int)
+ && TYPE_TWOS_COMPLEMENT (time_t)));
#define EPOCH_YEAR 1970
#define TM_YEAR_BASE 1900
verify (base_year_is_a_multiple_of_100, TM_YEAR_BASE % 100 == 0);
/* Return 1 if YEAR + TM_YEAR_BASE is a leap year. */
-static inline int
+static int
leapyear (long_int year)
{
/* Don't add YEAR to TM_YEAR_BASE, as that might overflow.
@@ -146,7 +150,7 @@ leapyear (long_int year)
return
((year & 3) == 0
&& (year % 100 != 0
- || ((year / 100) & 3) == (- (TM_YEAR_BASE / 100) & 3)));
+ || ((year / 100) & 3) == (- (TM_YEAR_BASE / 100) & 3)));
}
/* How many days come before each month (0-12). */
@@ -178,7 +182,7 @@ const unsigned short int __mon_yday[2][13] =
static int
isdst_differ (int a, int b)
{
- return (!a != !b) & (0 <= a) & (0 <= b);
+ return (!a != !b) && (0 <= a) && (0 <= b);
}
/* Return an integer value measuring (YEAR1-YDAY1 HOUR1:MIN1:SEC1) -
@@ -192,9 +196,9 @@ isdst_differ (int a, int b)
The result may overflow. It is the caller's responsibility to
detect overflow. */
-static inline time_t
+static time_t
ydhms_diff (long_int year1, long_int yday1, int hour1, int min1, int sec1,
- int year0, int yday0, int hour0, int min0, int sec0)
+ int year0, int yday0, int hour0, int min0, int sec0)
{
verify (C99_integer_division, -1 / 2 == 0);
@@ -275,15 +279,15 @@ time_t_int_add_ok (time_t a, int b)
yield a value equal to *T. */
static time_t
guess_time_tm (long_int year, long_int yday, int hour, int min, int sec,
- const time_t *t, const struct tm *tp)
+ const time_t *t, const struct tm *tp)
{
if (tp)
{
time_t d = ydhms_diff (year, yday, hour, min, sec,
- tp->tm_year, tp->tm_yday,
- tp->tm_hour, tp->tm_min, tp->tm_sec);
+ tp->tm_year, tp->tm_yday,
+ tp->tm_hour, tp->tm_min, tp->tm_sec);
if (time_t_add_ok (*t, d))
- return *t + d;
+ return *t + d;
}
/* Overflow occurred one way or another. Return the nearest result
@@ -292,8 +296,8 @@ guess_time_tm (long_int year, long_int yday, int hour, int min, int sec,
match; and don't oscillate between two values, as that would
confuse the spring-forward gap detector. */
return (*t < TIME_T_MIDPOINT
- ? (*t <= TIME_T_MIN + 1 ? *t + 1 : TIME_T_MIN)
- : (TIME_T_MAX - 1 <= *t ? *t - 1 : TIME_T_MAX));
+ ? (*t <= TIME_T_MIN + 1 ? *t + 1 : TIME_T_MIN)
+ : (TIME_T_MAX - 1 <= *t ? *t - 1 : TIME_T_MAX));
}
/* Use CONVERT to convert *T to a broken down time in *TP.
@@ -301,7 +305,7 @@ guess_time_tm (long_int year, long_int yday, int hour, int min, int sec,
it is the nearest in-range value and then convert that. */
static struct tm *
ranged_convert (struct tm *(*convert) (const time_t *, struct tm *),
- time_t *t, struct tm *tp)
+ time_t *t, struct tm *tp)
{
struct tm *r = convert (t, tp);
@@ -311,25 +315,25 @@ ranged_convert (struct tm *(*convert) (const time_t *, struct tm *),
time_t ok = 0;
/* BAD is a known unconvertible time_t, and OK is a known good one.
- Use binary search to narrow the range between BAD and OK until
- they differ by 1. */
+ Use binary search to narrow the range between BAD and OK until
+ they differ by 1. */
while (bad != ok + (bad < 0 ? -1 : 1))
- {
- time_t mid = *t = time_t_avg (ok, bad);
- r = convert (t, tp);
- if (r)
- ok = mid;
- else
- bad = mid;
- }
+ {
+ time_t mid = *t = time_t_avg (ok, bad);
+ r = convert (t, tp);
+ if (r)
+ ok = mid;
+ else
+ bad = mid;
+ }
if (!r && ok)
- {
- /* The last conversion attempt failed;
- revert to the most recent successful attempt. */
- *t = ok;
- r = convert (t, tp);
- }
+ {
+ /* The last conversion attempt failed;
+ revert to the most recent successful attempt. */
+ *t = ok;
+ r = convert (t, tp);
+ }
}
return r;
@@ -344,8 +348,8 @@ ranged_convert (struct tm *(*convert) (const time_t *, struct tm *),
This function is external because it is used also by timegm.c. */
time_t
__mktime_internal (struct tm *tp,
- struct tm *(*convert) (const time_t *, struct tm *),
- time_t *offset)
+ struct tm *(*convert) (const time_t *, struct tm *),
+ time_t *offset)
{
time_t t, gt, t0, t1, t2;
struct tm tm;
@@ -384,8 +388,8 @@ __mktime_internal (struct tm *tp,
/* Calculate day of year from year, month, and day of month.
The result need not be in range. */
int mon_yday = ((__mon_yday[leapyear (year)]
- [mon_remainder + 12 * negative_mon_remainder])
- - 1);
+ [mon_remainder + 12 * negative_mon_remainder])
+ - 1);
long_int lmday = mday;
long_int yday = mon_yday + lmday;
@@ -396,33 +400,33 @@ __mktime_internal (struct tm *tp,
if (LEAP_SECONDS_POSSIBLE)
{
/* Handle out-of-range seconds specially,
- since ydhms_tm_diff assumes every minute has 60 seconds. */
+ since ydhms_tm_diff assumes every minute has 60 seconds. */
if (sec < 0)
- sec = 0;
+ sec = 0;
if (59 < sec)
- sec = 59;
+ sec = 59;
}
/* Invert CONVERT by probing. First assume the same offset as last
time. */
t0 = ydhms_diff (year, yday, hour, min, sec,
- EPOCH_YEAR - TM_YEAR_BASE, 0, 0, 0, - guessed_offset);
+ EPOCH_YEAR - TM_YEAR_BASE, 0, 0, 0, - guessed_offset);
if (TIME_T_MAX / INT_MAX / 366 / 24 / 60 / 60 < 3)
{
/* time_t isn't large enough to rule out overflows, so check
- for major overflows. A gross check suffices, since if t0
- has overflowed, it is off by a multiple of TIME_T_MAX -
- TIME_T_MIN + 1. So ignore any component of the difference
- that is bounded by a small value. */
+ for major overflows. A gross check suffices, since if t0
+ has overflowed, it is off by a multiple of TIME_T_MAX -
+ TIME_T_MIN + 1. So ignore any component of the difference
+ that is bounded by a small value. */
/* Approximate log base 2 of the number of time units per
- biennium. A biennium is 2 years; use this unit instead of
- years to avoid integer overflow. For example, 2 average
- Gregorian years are 2 * 365.2425 * 24 * 60 * 60 seconds,
- which is 63113904 seconds, and rint (log2 (63113904)) is
- 26. */
+ biennium. A biennium is 2 years; use this unit instead of
+ years to avoid integer overflow. For example, 2 average
+ Gregorian years are 2 * 365.2425 * 24 * 60 * 60 seconds,
+ which is 63113904 seconds, and rint (log2 (63113904)) is
+ 26. */
int ALOG2_SECONDS_PER_BIENNIUM = 26;
int ALOG2_MINUTES_PER_BIENNIUM = 20;
int ALOG2_HOURS_PER_BIENNIUM = 14;
@@ -430,64 +434,64 @@ __mktime_internal (struct tm *tp,
int LOG2_YEARS_PER_BIENNIUM = 1;
int approx_requested_biennia =
- (SHR (year_requested, LOG2_YEARS_PER_BIENNIUM)
- - SHR (EPOCH_YEAR - TM_YEAR_BASE, LOG2_YEARS_PER_BIENNIUM)
- + SHR (mday, ALOG2_DAYS_PER_BIENNIUM)
- + SHR (hour, ALOG2_HOURS_PER_BIENNIUM)
- + SHR (min, ALOG2_MINUTES_PER_BIENNIUM)
- + (LEAP_SECONDS_POSSIBLE
- ? 0
- : SHR (sec, ALOG2_SECONDS_PER_BIENNIUM)));
+ (SHR (year_requested, LOG2_YEARS_PER_BIENNIUM)
+ - SHR (EPOCH_YEAR - TM_YEAR_BASE, LOG2_YEARS_PER_BIENNIUM)
+ + SHR (mday, ALOG2_DAYS_PER_BIENNIUM)
+ + SHR (hour, ALOG2_HOURS_PER_BIENNIUM)
+ + SHR (min, ALOG2_MINUTES_PER_BIENNIUM)
+ + (LEAP_SECONDS_POSSIBLE
+ ? 0
+ : SHR (sec, ALOG2_SECONDS_PER_BIENNIUM)));
int approx_biennia = SHR (t0, ALOG2_SECONDS_PER_BIENNIUM);
int diff = approx_biennia - approx_requested_biennia;
- int abs_diff = diff < 0 ? -1 - diff : diff;
+ int approx_abs_diff = diff < 0 ? -1 - diff : diff;
/* IRIX 4.0.5 cc miscalculates TIME_T_MIN / 3: it erroneously
- gives a positive value of 715827882. Setting a variable
- first then doing math on it seems to work.
- (ghazi@caip.rutgers.edu) */
+ gives a positive value of 715827882. Setting a variable
+ first then doing math on it seems to work.
+ (ghazi@caip.rutgers.edu) */
time_t time_t_max = TIME_T_MAX;
time_t time_t_min = TIME_T_MIN;
time_t overflow_threshold =
- (time_t_max / 3 - time_t_min / 3) >> ALOG2_SECONDS_PER_BIENNIUM;
-
- if (overflow_threshold < abs_diff)
- {
- /* Overflow occurred. Try repairing it; this might work if
- the time zone offset is enough to undo the overflow. */
- time_t repaired_t0 = -1 - t0;
- approx_biennia = SHR (repaired_t0, ALOG2_SECONDS_PER_BIENNIUM);
- diff = approx_biennia - approx_requested_biennia;
- abs_diff = diff < 0 ? -1 - diff : diff;
- if (overflow_threshold < abs_diff)
- return -1;
- guessed_offset += repaired_t0 - t0;
- t0 = repaired_t0;
- }
+ (time_t_max / 3 - time_t_min / 3) >> ALOG2_SECONDS_PER_BIENNIUM;
+
+ if (overflow_threshold < approx_abs_diff)
+ {
+ /* Overflow occurred. Try repairing it; this might work if
+ the time zone offset is enough to undo the overflow. */
+ time_t repaired_t0 = -1 - t0;
+ approx_biennia = SHR (repaired_t0, ALOG2_SECONDS_PER_BIENNIUM);
+ diff = approx_biennia - approx_requested_biennia;
+ approx_abs_diff = diff < 0 ? -1 - diff : diff;
+ if (overflow_threshold < approx_abs_diff)
+ return -1;
+ guessed_offset += repaired_t0 - t0;
+ t0 = repaired_t0;
+ }
}
/* Repeatedly use the error to improve the guess. */
for (t = t1 = t2 = t0, dst2 = 0;
(gt = guess_time_tm (year, yday, hour, min, sec, &t,
- ranged_convert (convert, &t, &tm)),
- t != gt);
+ ranged_convert (convert, &t, &tm)),
+ t != gt);
t1 = t2, t2 = t, t = gt, dst2 = tm.tm_isdst != 0)
if (t == t1 && t != t2
- && (tm.tm_isdst < 0
- || (isdst < 0
- ? dst2 <= (tm.tm_isdst != 0)
- : (isdst != 0) != (tm.tm_isdst != 0))))
+ && (tm.tm_isdst < 0
+ || (isdst < 0
+ ? dst2 <= (tm.tm_isdst != 0)
+ : (isdst != 0) != (tm.tm_isdst != 0))))
/* We can't possibly find a match, as we are oscillating
- between two values. The requested time probably falls
- within a spring-forward gap of size GT - T. Follow the common
- practice in this case, which is to return a time that is GT - T
- away from the requested time, preferring a time whose
- tm_isdst differs from the requested value. (If no tm_isdst
- was requested and only one of the two values has a nonzero
- tm_isdst, prefer that value.) In practice, this is more
- useful than returning -1. */
+ between two values. The requested time probably falls
+ within a spring-forward gap of size GT - T. Follow the common
+ practice in this case, which is to return a time that is GT - T
+ away from the requested time, preferring a time whose
+ tm_isdst differs from the requested value. (If no tm_isdst
+ was requested and only one of the two values has a nonzero
+ tm_isdst, prefer that value.) In practice, this is more
+ useful than returning -1. */
goto offset_found;
else if (--remaining_probes == 0)
return -1;
@@ -497,50 +501,50 @@ __mktime_internal (struct tm *tp,
if (isdst_differ (isdst, tm.tm_isdst))
{
/* tm.tm_isdst has the wrong value. Look for a neighboring
- time with the right value, and use its UTC offset.
+ time with the right value, and use its UTC offset.
- Heuristic: probe the adjacent timestamps in both directions,
- looking for the desired isdst. This should work for all real
- time zone histories in the tz database. */
+ Heuristic: probe the adjacent timestamps in both directions,
+ looking for the desired isdst. This should work for all real
+ time zone histories in the tz database. */
/* Distance between probes when looking for a DST boundary. In
- tzdata2003a, the shortest period of DST is 601200 seconds
- (e.g., America/Recife starting 2000-10-08 01:00), and the
- shortest period of non-DST surrounded by DST is 694800
- seconds (Africa/Tunis starting 1943-04-17 01:00). Use the
- minimum of these two values, so we don't miss these short
- periods when probing. */
+ tzdata2003a, the shortest period of DST is 601200 seconds
+ (e.g., America/Recife starting 2000-10-08 01:00), and the
+ shortest period of non-DST surrounded by DST is 694800
+ seconds (Africa/Tunis starting 1943-04-17 01:00). Use the
+ minimum of these two values, so we don't miss these short
+ periods when probing. */
int stride = 601200;
/* The longest period of DST in tzdata2003a is 536454000 seconds
- (e.g., America/Jujuy starting 1946-10-01 01:00). The longest
- period of non-DST is much longer, but it makes no real sense
- to search for more than a year of non-DST, so use the DST
- max. */
+ (e.g., America/Jujuy starting 1946-10-01 01:00). The longest
+ period of non-DST is much longer, but it makes no real sense
+ to search for more than a year of non-DST, so use the DST
+ max. */
int duration_max = 536454000;
/* Search in both directions, so the maximum distance is half
- the duration; add the stride to avoid off-by-1 problems. */
+ the duration; add the stride to avoid off-by-1 problems. */
int delta_bound = duration_max / 2 + stride;
int delta, direction;
for (delta = stride; delta < delta_bound; delta += stride)
- for (direction = -1; direction <= 1; direction += 2)
- if (time_t_int_add_ok (t, delta * direction))
- {
- time_t ot = t + delta * direction;
- struct tm otm;
- ranged_convert (convert, &ot, &otm);
- if (! isdst_differ (isdst, otm.tm_isdst))
- {
- /* We found the desired tm_isdst.
- Extrapolate back to the desired time. */
- t = guess_time_tm (year, yday, hour, min, sec, &ot, &otm);
- ranged_convert (convert, &t, &tm);
- goto offset_found;
- }
- }
+ for (direction = -1; direction <= 1; direction += 2)
+ if (time_t_int_add_ok (t, delta * direction))
+ {
+ time_t ot = t + delta * direction;
+ struct tm otm;
+ ranged_convert (convert, &ot, &otm);
+ if (! isdst_differ (isdst, otm.tm_isdst))
+ {
+ /* We found the desired tm_isdst.
+ Extrapolate back to the desired time. */
+ t = guess_time_tm (year, yday, hour, min, sec, &ot, &otm);
+ ranged_convert (convert, &t, &tm);
+ goto offset_found;
+ }
+ }
}
offset_found:
@@ -549,16 +553,16 @@ __mktime_internal (struct tm *tp,
if (LEAP_SECONDS_POSSIBLE && sec_requested != tm.tm_sec)
{
/* Adjust time to reflect the tm_sec requested, not the normalized value.
- Also, repair any damage from a false match due to a leap second. */
+ Also, repair any damage from a false match due to a leap second. */
int sec_adjustment = (sec == 0 && tm.tm_sec == 60) - sec;
if (! time_t_int_add_ok (t, sec_requested))
- return -1;
+ return -1;
t1 = t + sec_requested;
if (! time_t_int_add_ok (t1, sec_adjustment))
- return -1;
+ return -1;
t2 = t1 + sec_adjustment;
if (! convert (&t2, &tm))
- return -1;
+ return -1;
t = t2;
}
@@ -579,7 +583,7 @@ mktime (struct tm *tp)
{
#ifdef _LIBC
/* POSIX.1 8.1.1 requires that whenever mktime() is called, the
- time zone names contained in the external variable `tzname' shall
+ time zone names contained in the external variable 'tzname' shall
be set as if the tzset() function had been called. */
__tzset ();
#endif
@@ -602,13 +606,13 @@ static int
not_equal_tm (const struct tm *a, const struct tm *b)
{
return ((a->tm_sec ^ b->tm_sec)
- | (a->tm_min ^ b->tm_min)
- | (a->tm_hour ^ b->tm_hour)
- | (a->tm_mday ^ b->tm_mday)
- | (a->tm_mon ^ b->tm_mon)
- | (a->tm_year ^ b->tm_year)
- | (a->tm_yday ^ b->tm_yday)
- | isdst_differ (a->tm_isdst, b->tm_isdst));
+ | (a->tm_min ^ b->tm_min)
+ | (a->tm_hour ^ b->tm_hour)
+ | (a->tm_mday ^ b->tm_mday)
+ | (a->tm_mon ^ b->tm_mon)
+ | (a->tm_year ^ b->tm_year)
+ | (a->tm_yday ^ b->tm_yday)
+ | isdst_differ (a->tm_isdst, b->tm_isdst));
}
static void
@@ -616,9 +620,9 @@ print_tm (const struct tm *tp)
{
if (tp)
printf ("%04d-%02d-%02d %02d:%02d:%02d yday %03d wday %d isdst %d",
- tp->tm_year + TM_YEAR_BASE, tp->tm_mon + 1, tp->tm_mday,
- tp->tm_hour, tp->tm_min, tp->tm_sec,
- tp->tm_yday, tp->tm_wday, tp->tm_isdst);
+ tp->tm_year + TM_YEAR_BASE, tp->tm_mon + 1, tp->tm_mday,
+ tp->tm_hour, tp->tm_min, tp->tm_sec,
+ tp->tm_yday, tp->tm_wday, tp->tm_isdst);
else
printf ("0");
}
@@ -650,11 +654,11 @@ main (int argc, char **argv)
if ((argc == 3 || argc == 4)
&& (sscanf (argv[1], "%d-%d-%d%c",
- &tm.tm_year, &tm.tm_mon, &tm.tm_mday, &trailer)
- == 3)
+ &tm.tm_year, &tm.tm_mon, &tm.tm_mday, &trailer)
+ == 3)
&& (sscanf (argv[2], "%d:%d:%d%c",
- &tm.tm_hour, &tm.tm_min, &tm.tm_sec, &trailer)
- == 3))
+ &tm.tm_hour, &tm.tm_min, &tm.tm_sec, &trailer)
+ == 3))
{
tm.tm_year -= TM_YEAR_BASE;
tm.tm_mon--;
@@ -663,10 +667,10 @@ main (int argc, char **argv)
tl = mktime (&tmk);
lt = localtime (&tl);
if (lt)
- {
- tml = *lt;
- lt = &tml;
- }
+ {
+ tml = *lt;
+ lt = &tml;
+ }
printf ("mktime returns %ld == ", (long int) tl);
print_tm (&tmk);
printf ("\n");
@@ -679,51 +683,51 @@ main (int argc, char **argv)
time_t to = atol (argv[3]);
if (argc == 4)
- for (tl = from; by < 0 ? to <= tl : tl <= to; tl = tl1)
- {
- lt = localtime (&tl);
- if (lt)
- {
- tmk = tml = *lt;
- tk = mktime (&tmk);
- status |= check_result (tk, tmk, tl, &tml);
- }
- else
- {
- printf ("localtime (%ld) yields 0\n", (long int) tl);
- status = 1;
- }
- tl1 = tl + by;
- if ((tl1 < tl) != (by < 0))
- break;
- }
+ for (tl = from; by < 0 ? to <= tl : tl <= to; tl = tl1)
+ {
+ lt = localtime (&tl);
+ if (lt)
+ {
+ tmk = tml = *lt;
+ tk = mktime (&tmk);
+ status |= check_result (tk, tmk, tl, &tml);
+ }
+ else
+ {
+ printf ("localtime (%ld) yields 0\n", (long int) tl);
+ status = 1;
+ }
+ tl1 = tl + by;
+ if ((tl1 < tl) != (by < 0))
+ break;
+ }
else
- for (tl = from; by < 0 ? to <= tl : tl <= to; tl = tl1)
- {
- /* Null benchmark. */
- lt = localtime (&tl);
- if (lt)
- {
- tmk = tml = *lt;
- tk = tl;
- status |= check_result (tk, tmk, tl, &tml);
- }
- else
- {
- printf ("localtime (%ld) yields 0\n", (long int) tl);
- status = 1;
- }
- tl1 = tl + by;
- if ((tl1 < tl) != (by < 0))
- break;
- }
+ for (tl = from; by < 0 ? to <= tl : tl <= to; tl = tl1)
+ {
+ /* Null benchmark. */
+ lt = localtime (&tl);
+ if (lt)
+ {
+ tmk = tml = *lt;
+ tk = tl;
+ status |= check_result (tk, tmk, tl, &tml);
+ }
+ else
+ {
+ printf ("localtime (%ld) yields 0\n", (long int) tl);
+ status = 1;
+ }
+ tl1 = tl + by;
+ if ((tl1 < tl) != (by < 0))
+ break;
+ }
}
else
printf ("Usage:\
\t%s YYYY-MM-DD HH:MM:SS [ISDST] # Test given time.\n\
\t%s FROM BY TO # Test values FROM, FROM+BY, ..., TO.\n\
\t%s FROM BY TO - # Do not test those values (for benchmark).\n",
- argv[0], argv[0], argv[0]);
+ argv[0], argv[0], argv[0]);
return status;
}
diff --git a/lib/pathmax.h b/lib/pathmax.h
new file mode 100644
index 00000000000..03db7cb519b
--- /dev/null
+++ b/lib/pathmax.h
@@ -0,0 +1,83 @@
+/* Define PATH_MAX somehow. Requires sys/types.h.
+ Copyright (C) 1992, 1999, 2001, 2003, 2005, 2009-2012 Free Software
+ Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+#ifndef _PATHMAX_H
+# define _PATHMAX_H
+
+/* POSIX:2008 defines PATH_MAX to be the maximum number of bytes in a filename,
+ including the terminating NUL byte.
+ <http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/limits.h.html>
+ PATH_MAX is not defined on systems which have no limit on filename length,
+ such as GNU/Hurd.
+
+ This file does *not* define PATH_MAX always. Programs that use this file
+ can handle the GNU/Hurd case in several ways:
+ - Either with a package-wide handling, or with a per-file handling,
+ - Either through a
+ #ifdef PATH_MAX
+ or through a fallback like
+ #ifndef PATH_MAX
+ # define PATH_MAX 8192
+ #endif
+ or through a fallback like
+ #ifndef PATH_MAX
+ # define PATH_MAX pathconf ("/", _PC_PATH_MAX)
+ #endif
+ */
+
+# include <unistd.h>
+
+# include <limits.h>
+
+# ifndef _POSIX_PATH_MAX
+# define _POSIX_PATH_MAX 256
+# endif
+
+/* Don't include sys/param.h if it already has been. */
+# if defined HAVE_SYS_PARAM_H && !defined PATH_MAX && !defined MAXPATHLEN
+# include <sys/param.h>
+# endif
+
+# if !defined PATH_MAX && defined MAXPATHLEN
+# define PATH_MAX MAXPATHLEN
+# endif
+
+# ifdef __hpux
+/* On HP-UX, PATH_MAX designates the maximum number of bytes in a filename,
+ *not* including the terminating NUL byte, and is set to 1023.
+ Additionally, when _XOPEN_SOURCE is defined to 500 or more, PATH_MAX is
+ not defined at all any more. */
+# undef PATH_MAX
+# define PATH_MAX 1024
+# endif
+
+# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+/* The page "Naming Files, Paths, and Namespaces" on msdn.microsoft.com,
+ section "Maximum Path Length Limitation",
+ <http://msdn.microsoft.com/en-us/library/aa365247(v=vs.85).aspx#maxpath>
+ explains that the maximum size of a filename, including the terminating
+ NUL byte, is 260 = 3 + 256 + 1.
+ This is the same value as
+ - FILENAME_MAX in <stdio.h>,
+ - _MAX_PATH in <stdlib.h>,
+ - MAX_PATH in <windef.h>.
+ Undefine the original value, because mingw's <limits.h> gets it wrong. */
+# undef PATH_MAX
+# define PATH_MAX 260
+# endif
+
+#endif /* _PATHMAX_H */
diff --git a/lib/pselect.c b/lib/pselect.c
new file mode 100644
index 00000000000..1b6d099dccf
--- /dev/null
+++ b/lib/pselect.c
@@ -0,0 +1,110 @@
+/* pselect - synchronous I/O multiplexing
+
+ Copyright 2011-2012 Free Software Foundation, Inc.
+
+ This file is part of gnulib.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License along
+ with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+/* written by Paul Eggert */
+
+#include <config.h>
+
+#include <sys/select.h>
+
+#include <errno.h>
+#include <signal.h>
+
+/* Examine the size-NFDS file descriptor sets in RFDS, WFDS, and XFDS
+ to see whether some of their descriptors are ready for reading,
+ ready for writing, or have exceptions pending. Wait for at most
+ TIMEOUT seconds, and use signal mask SIGMASK while waiting. A null
+ pointer parameter stands for no descriptors, an infinite timeout,
+ or an unaffected signal mask. */
+
+#if !HAVE_PSELECT
+
+int
+pselect (int nfds, fd_set *restrict rfds,
+ fd_set *restrict wfds, fd_set *restrict xfds,
+ struct timespec const *restrict timeout,
+ sigset_t const *restrict sigmask)
+{
+ int select_result;
+ sigset_t origmask;
+ struct timeval tv, *tvp;
+
+ if (timeout)
+ {
+ if (! (0 <= timeout->tv_nsec && timeout->tv_nsec < 1000000000))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+
+ tv.tv_sec = timeout->tv_sec;
+ tv.tv_usec = (timeout->tv_nsec + 999) / 1000;
+ tvp = &tv;
+ }
+ else
+ tvp = NULL;
+
+ /* Signal mask munging should be atomic, but this is the best we can
+ do in this emulation. */
+ if (sigmask)
+ pthread_sigmask (SIG_SETMASK, sigmask, &origmask);
+
+ select_result = select (nfds, rfds, wfds, xfds, tvp);
+
+ if (sigmask)
+ {
+ int select_errno = errno;
+ pthread_sigmask (SIG_SETMASK, &origmask, NULL);
+ errno = select_errno;
+ }
+
+ return select_result;
+}
+
+#else /* HAVE_PSELECT */
+# include <unistd.h>
+# undef pselect
+
+int
+rpl_pselect (int nfds, fd_set *restrict rfds,
+ fd_set *restrict wfds, fd_set *restrict xfds,
+ struct timespec const *restrict timeout,
+ sigset_t const *restrict sigmask)
+{
+ int i;
+
+ /* FreeBSD 8.2 has a bug: it does not always detect invalid fds. */
+ if (nfds < 0 || nfds > FD_SETSIZE)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ for (i = 0; i < nfds; i++)
+ {
+ if (((rfds && FD_ISSET (i, rfds))
+ || (wfds && FD_ISSET (i, wfds))
+ || (xfds && FD_ISSET (i, xfds)))
+ && dup2 (i, i) != i)
+ return -1;
+ }
+
+ return pselect (nfds, rfds, wfds, xfds, timeout, sigmask);
+}
+
+#endif
diff --git a/lib/pthread_sigmask.c b/lib/pthread_sigmask.c
index 11d549cad41..80ab24bf0b1 100644
--- a/lib/pthread_sigmask.c
+++ b/lib/pthread_sigmask.c
@@ -1,5 +1,5 @@
/* POSIX compatible signal blocking for threads.
- Copyright (C) 2011 Free Software Foundation, Inc.
+ Copyright (C) 2011-2012 Free Software Foundation, Inc.
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
@@ -22,6 +22,10 @@
#include <errno.h>
#include <stddef.h>
+#if PTHREAD_SIGMASK_INEFFECTIVE
+# include <string.h>
+#endif
+
#if PTHREAD_SIGMASK_UNBLOCK_BUG
# include <unistd.h>
#endif
@@ -31,7 +35,22 @@ pthread_sigmask (int how, const sigset_t *new_mask, sigset_t *old_mask)
#undef pthread_sigmask
{
#if HAVE_PTHREAD_SIGMASK
- int ret = pthread_sigmask (how, new_mask, old_mask);
+ int ret;
+
+# if PTHREAD_SIGMASK_INEFFECTIVE
+ sigset_t omask, omask_copy;
+ sigset_t *old_mask_ptr = &omask;
+ sigemptyset (&omask);
+ /* Add a signal unlikely to be blocked, so that OMASK_COPY
+ is unlikely to match the actual mask. */
+ sigaddset (&omask, SIGILL);
+ memcpy (&omask_copy, &omask, sizeof omask);
+# else
+ sigset_t *old_mask_ptr = old_mask;
+# endif
+
+ ret = pthread_sigmask (how, new_mask, old_mask_ptr);
+
# if PTHREAD_SIGMASK_INEFFECTIVE
if (ret == 0)
{
@@ -39,12 +58,16 @@ pthread_sigmask (int how, const sigset_t *new_mask, sigset_t *old_mask)
Don't cache the information: libpthread.so could be dynamically
loaded after the program started and after pthread_sigmask was
called for the first time. */
- if (pthread_sigmask (1729, NULL, NULL) == 0)
+ if (memcmp (&omask_copy, &omask, sizeof omask) == 0
+ && pthread_sigmask (1729, &omask_copy, NULL) == 0)
{
/* pthread_sigmask is currently ineffective. The program is not
linked to -lpthread. So use sigprocmask instead. */
return (sigprocmask (how, new_mask, old_mask) < 0 ? errno : 0);
}
+
+ if (old_mask)
+ memcpy (old_mask, &omask, sizeof omask);
}
# endif
# if PTHREAD_SIGMASK_FAILS_WITH_ERRNO
diff --git a/lib/readlink.c b/lib/readlink.c
index 35d045b9a12..baac1322442 100644
--- a/lib/readlink.c
+++ b/lib/readlink.c
@@ -1,5 +1,5 @@
/* Stub for readlink().
- Copyright (C) 2003-2007, 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2003-2007, 2009-2012 Free Software Foundation, Inc.
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
diff --git a/lib/root-uid.h b/lib/root-uid.h
new file mode 100644
index 00000000000..2379773c291
--- /dev/null
+++ b/lib/root-uid.h
@@ -0,0 +1,30 @@
+/* The user ID that always has appropriate privileges in the POSIX sense.
+
+ Copyright 2012 Free Software Foundation, Inc.
+
+ 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/>.
+
+ Written by Paul Eggert. */
+
+#ifndef ROOT_UID_H_
+#define ROOT_UID_H_
+
+/* The user ID that always has appropriate privileges in the POSIX sense. */
+#ifdef __TANDEM
+# define ROOT_UID 65535
+#else
+# define ROOT_UID 0
+#endif
+
+#endif
diff --git a/lib/sha1.c b/lib/sha1.c
index f832d050574..0d82af14bc9 100644
--- a/lib/sha1.c
+++ b/lib/sha1.c
@@ -1,7 +1,7 @@
/* sha1.c - Functions to compute SHA1 message digest of files or
memory blocks according to the NIST specification FIPS-180-1.
- Copyright (C) 2000-2001, 2003-2006, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2000-2001, 2003-2006, 2008-2012 Free Software Foundation, Inc.
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
@@ -14,8 +14,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
/* Written by Scott G. Miller
Credits:
@@ -26,7 +25,8 @@
#include "sha1.h"
-#include <stddef.h>
+#include <stdalign.h>
+#include <stdint.h>
#include <stdlib.h>
#include <string.h>
@@ -241,8 +241,7 @@ sha1_process_bytes (const void *buffer, size_t len, struct sha1_ctx *ctx)
if (len >= 64)
{
#if !_STRING_ARCH_unaligned
-# define alignof(type) offsetof (struct { char c; type x; }, x)
-# define UNALIGNED_P(p) (((size_t) p) % alignof (uint32_t) != 0)
+# define UNALIGNED_P(p) ((uintptr_t) (p) % alignof (uint32_t) != 0)
if (UNALIGNED_P (buffer))
while (len > 64)
{
@@ -306,13 +305,13 @@ sha1_process_block (const void *buffer, size_t len, struct sha1_ctx *ctx)
uint32_t c = ctx->C;
uint32_t d = ctx->D;
uint32_t e = ctx->E;
+ uint32_t lolen = len;
/* First increment the byte count. RFC 1321 specifies the possible
length of the file up to 2^64 bits. Here we only compute the
number of bytes. Do a double word increment. */
- ctx->total[0] += len;
- if (ctx->total[0] < len)
- ++ctx->total[1];
+ ctx->total[0] += lolen;
+ ctx->total[1] += (len >> 31 >> 1) + (ctx->total[0] < lolen);
#define rol(x, n) (((x) << (n)) | ((uint32_t) (x) >> (32 - (n))))
diff --git a/lib/sha1.h b/lib/sha1.h
index 47b56f2adfb..0d9ced0298d 100644
--- a/lib/sha1.h
+++ b/lib/sha1.h
@@ -1,6 +1,6 @@
/* Declarations of functions and data types used for SHA1 sum
library functions.
- Copyright (C) 2000-2001, 2003, 2005-2006, 2008-2011 Free Software
+ Copyright (C) 2000-2001, 2003, 2005-2006, 2008-2012 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify it
@@ -14,8 +14,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#ifndef SHA1_H
# define SHA1_H 1
diff --git a/lib/sha256.c b/lib/sha256.c
index 4dbb5e91291..a8d29da18dd 100644
--- a/lib/sha256.c
+++ b/lib/sha256.c
@@ -1,7 +1,7 @@
/* sha256.c - Functions to compute SHA256 and SHA224 message digest of files or
memory blocks according to the NIST specification FIPS-180-2.
- Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-2012 Free Software Foundation, Inc.
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
@@ -24,7 +24,8 @@
#include "sha256.h"
-#include <stddef.h>
+#include <stdalign.h>
+#include <stdint.h>
#include <stdlib.h>
#include <string.h>
@@ -373,8 +374,7 @@ sha256_process_bytes (const void *buffer, size_t len, struct sha256_ctx *ctx)
if (len >= 64)
{
#if !_STRING_ARCH_unaligned
-# define alignof(type) offsetof (struct { char c; type x; }, x)
-# define UNALIGNED_P(p) (((size_t) p) % alignof (uint32_t) != 0)
+# define UNALIGNED_P(p) ((uintptr_t) (p) % alignof (uint32_t) != 0)
if (UNALIGNED_P (buffer))
while (len > 64)
{
@@ -454,13 +454,13 @@ sha256_process_block (const void *buffer, size_t len, struct sha256_ctx *ctx)
uint32_t f = ctx->state[5];
uint32_t g = ctx->state[6];
uint32_t h = ctx->state[7];
+ uint32_t lolen = len;
/* First increment the byte count. FIPS PUB 180-2 specifies the possible
length of the file up to 2^64 bits. Here we only compute the
number of bytes. Do a double word increment. */
- ctx->total[0] += len;
- if (ctx->total[0] < len)
- ++ctx->total[1];
+ ctx->total[0] += lolen;
+ ctx->total[1] += (len >> 31 >> 1) + (ctx->total[0] < lolen);
#define rol(x, n) (((x) << (n)) | ((x) >> (32 - (n))))
#define S0(x) (rol(x,25)^rol(x,14)^(x>>3))
diff --git a/lib/sha256.h b/lib/sha256.h
index 9f6bf14bf0c..d69b83fc9fc 100644
--- a/lib/sha256.h
+++ b/lib/sha256.h
@@ -1,6 +1,6 @@
/* Declarations of functions and data types used for SHA256 and SHA224 sum
library functions.
- Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-2012 Free Software Foundation, Inc.
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
diff --git a/lib/sha512.c b/lib/sha512.c
index 5c2e3ab9f81..cf62f2034e5 100644
--- a/lib/sha512.c
+++ b/lib/sha512.c
@@ -1,7 +1,7 @@
/* sha512.c - Functions to compute SHA512 and SHA384 message digest of files or
memory blocks according to the NIST specification FIPS-180-2.
- Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-2012 Free Software Foundation, Inc.
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
@@ -24,7 +24,8 @@
#include "sha512.h"
-#include <stddef.h>
+#include <stdalign.h>
+#include <stdint.h>
#include <stdlib.h>
#include <string.h>
@@ -381,8 +382,7 @@ sha512_process_bytes (const void *buffer, size_t len, struct sha512_ctx *ctx)
if (len >= 128)
{
#if !_STRING_ARCH_unaligned
-# define alignof(type) offsetof (struct { char c; type x; }, x)
-# define UNALIGNED_P(p) (((size_t) p) % alignof (u64) != 0)
+# define UNALIGNED_P(p) ((uintptr_t) (p) % alignof (u64) != 0)
if (UNALIGNED_P (buffer))
while (len > 128)
{
@@ -485,13 +485,15 @@ sha512_process_block (const void *buffer, size_t len, struct sha512_ctx *ctx)
u64 f = ctx->state[5];
u64 g = ctx->state[6];
u64 h = ctx->state[7];
+ u64 lolen = u64size (len);
/* First increment the byte count. FIPS PUB 180-2 specifies the possible
length of the file up to 2^128 bits. Here we only compute the
number of bytes. Do a double word increment. */
- ctx->total[0] = u64plus (ctx->total[0], u64lo (len));
- if (u64lt (ctx->total[0], u64lo (len)))
- ctx->total[1] = u64plus (ctx->total[1], u64lo (1));
+ ctx->total[0] = u64plus (ctx->total[0], lolen);
+ ctx->total[1] = u64plus (ctx->total[1],
+ u64plus (u64size (len >> 31 >> 31 >> 2),
+ u64lo (u64lt (ctx->total[0], lolen))));
#define S0(x) u64xor (u64rol(x, 63), u64xor (u64rol (x, 56), u64shr (x, 7)))
#define S1(x) u64xor (u64rol (x, 45), u64xor (u64rol (x, 3), u64shr (x, 6)))
diff --git a/lib/sha512.h b/lib/sha512.h
index af8b354ebd0..ddf91d6c726 100644
--- a/lib/sha512.h
+++ b/lib/sha512.h
@@ -1,6 +1,6 @@
/* Declarations of functions and data types used for SHA512 and SHA384 sum
library functions.
- Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-2012 Free Software Foundation, Inc.
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
diff --git a/lib/signal.in.h b/lib/signal.in.h
index e18e0b29832..8fb1ad119ad 100644
--- a/lib/signal.in.h
+++ b/lib/signal.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <signal.h>.
- Copyright (C) 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 2006-2012 Free Software Foundation, Inc.
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
@@ -55,7 +55,7 @@
#ifndef _@GUARD_PREFIX@_SIGNAL_H
#define _@GUARD_PREFIX@_SIGNAL_H
-/* MacOS X 10.3, FreeBSD 6.4, OpenBSD 3.8, OSF/1 4.0, Solaris 2.6 declare
+/* Mac OS X 10.3, FreeBSD 6.4, OpenBSD 3.8, OSF/1 4.0, Solaris 2.6 declare
pthread_sigmask in <pthread.h>, not in <signal.h>.
But avoid namespace pollution on glibc systems.*/
#if (@GNULIB_PTHREAD_SIGMASK@ || defined GNULIB_POSIXCHECK) \
@@ -197,7 +197,7 @@ typedef int verify_NSIG_constraint[NSIG <= 32 ? 1 : -1];
/* Test whether a given signal is contained in a signal set. */
# if @HAVE_POSIX_SIGNALBLOCKING@
-/* This function is defined as a macro on MacOS X. */
+/* This function is defined as a macro on Mac OS X. */
# if defined __cplusplus && defined GNULIB_NAMESPACE
# undef sigismember
# endif
@@ -210,7 +210,7 @@ _GL_CXXALIASWARN (sigismember);
/* Initialize a signal set to the empty set. */
# if @HAVE_POSIX_SIGNALBLOCKING@
-/* This function is defined as a macro on MacOS X. */
+/* This function is defined as a macro on Mac OS X. */
# if defined __cplusplus && defined GNULIB_NAMESPACE
# undef sigemptyset
# endif
@@ -222,7 +222,7 @@ _GL_CXXALIASWARN (sigemptyset);
/* Add a signal to a signal set. */
# if @HAVE_POSIX_SIGNALBLOCKING@
-/* This function is defined as a macro on MacOS X. */
+/* This function is defined as a macro on Mac OS X. */
# if defined __cplusplus && defined GNULIB_NAMESPACE
# undef sigaddset
# endif
@@ -235,7 +235,7 @@ _GL_CXXALIASWARN (sigaddset);
/* Remove a signal from a signal set. */
# if @HAVE_POSIX_SIGNALBLOCKING@
-/* This function is defined as a macro on MacOS X. */
+/* This function is defined as a macro on Mac OS X. */
# if defined __cplusplus && defined GNULIB_NAMESPACE
# undef sigdelset
# endif
@@ -248,7 +248,7 @@ _GL_CXXALIASWARN (sigdelset);
/* Fill a signal set with all possible signals. */
# if @HAVE_POSIX_SIGNALBLOCKING@
-/* This function is defined as a macro on MacOS X. */
+/* This function is defined as a macro on Mac OS X. */
# if defined __cplusplus && defined GNULIB_NAMESPACE
# undef sigfillset
# endif
diff --git a/lib/sigprocmask.c b/lib/sigprocmask.c
deleted file mode 100644
index e75c7576cdf..00000000000
--- a/lib/sigprocmask.c
+++ /dev/null
@@ -1,348 +0,0 @@
-/* POSIX compatible signal blocking.
- Copyright (C) 2006-2011 Free Software Foundation, Inc.
- Written by Bruno Haible <bruno@clisp.org>, 2006.
-
- 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/>. */
-
-#include <config.h>
-
-/* Specification. */
-#include <signal.h>
-
-#include <errno.h>
-#include <stdint.h>
-#include <stdlib.h>
-
-#if HAVE_MSVC_INVALID_PARAMETER_HANDLER
-# include "msvc-inval.h"
-#endif
-
-/* We assume that a platform without POSIX signal blocking functions
- also does not have the POSIX sigaction() function, only the
- signal() function. We also assume signal() has SysV semantics,
- where any handler is uninstalled prior to being invoked. This is
- true for Woe32 platforms. */
-
-/* We use raw signal(), but also provide a wrapper rpl_signal() so
- that applications can query or change a blocked signal. */
-#undef signal
-
-/* Provide invalid signal numbers as fallbacks if the uncatchable
- signals are not defined. */
-#ifndef SIGKILL
-# define SIGKILL (-1)
-#endif
-#ifndef SIGSTOP
-# define SIGSTOP (-1)
-#endif
-
-/* On native Windows, as of 2008, the signal SIGABRT_COMPAT is an alias
- for the signal SIGABRT. Only one signal handler is stored for both
- SIGABRT and SIGABRT_COMPAT. SIGABRT_COMPAT is not a signal of its own. */
-#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
-# undef SIGABRT_COMPAT
-# define SIGABRT_COMPAT 6
-#endif
-#ifdef SIGABRT_COMPAT
-# define SIGABRT_COMPAT_MASK (1U << SIGABRT_COMPAT)
-#else
-# define SIGABRT_COMPAT_MASK 0
-#endif
-
-typedef void (*handler_t) (int);
-
-#if HAVE_MSVC_INVALID_PARAMETER_HANDLER
-static inline handler_t
-signal_nothrow (int sig, handler_t handler)
-{
- handler_t result;
-
- TRY_MSVC_INVAL
- {
- result = signal (sig, handler);
- }
- CATCH_MSVC_INVAL
- {
- result = SIG_ERR;
- errno = EINVAL;
- }
- DONE_MSVC_INVAL;
-
- return result;
-}
-# define signal signal_nothrow
-#endif
-
-/* Handling of gnulib defined signals. */
-
-#if GNULIB_defined_SIGPIPE
-static handler_t SIGPIPE_handler = SIG_DFL;
-#endif
-
-#if GNULIB_defined_SIGPIPE
-static handler_t
-ext_signal (int sig, handler_t handler)
-{
- switch (sig)
- {
- case SIGPIPE:
- {
- handler_t old_handler = SIGPIPE_handler;
- SIGPIPE_handler = handler;
- return old_handler;
- }
- default: /* System defined signal */
- return signal (sig, handler);
- }
-}
-# undef signal
-# define signal ext_signal
-#endif
-
-int
-sigismember (const sigset_t *set, int sig)
-{
- if (sig >= 0 && sig < NSIG)
- {
- #ifdef SIGABRT_COMPAT
- if (sig == SIGABRT_COMPAT)
- sig = SIGABRT;
- #endif
-
- return (*set >> sig) & 1;
- }
- else
- return 0;
-}
-
-int
-sigemptyset (sigset_t *set)
-{
- *set = 0;
- return 0;
-}
-
-int
-sigaddset (sigset_t *set, int sig)
-{
- if (sig >= 0 && sig < NSIG)
- {
- #ifdef SIGABRT_COMPAT
- if (sig == SIGABRT_COMPAT)
- sig = SIGABRT;
- #endif
-
- *set |= 1U << sig;
- return 0;
- }
- else
- {
- errno = EINVAL;
- return -1;
- }
-}
-
-int
-sigdelset (sigset_t *set, int sig)
-{
- if (sig >= 0 && sig < NSIG)
- {
- #ifdef SIGABRT_COMPAT
- if (sig == SIGABRT_COMPAT)
- sig = SIGABRT;
- #endif
-
- *set &= ~(1U << sig);
- return 0;
- }
- else
- {
- errno = EINVAL;
- return -1;
- }
-}
-
-
-int
-sigfillset (sigset_t *set)
-{
- *set = ((2U << (NSIG - 1)) - 1) & ~ SIGABRT_COMPAT_MASK;
- return 0;
-}
-
-/* Set of currently blocked signals. */
-static volatile sigset_t blocked_set /* = 0 */;
-
-/* Set of currently blocked and pending signals. */
-static volatile sig_atomic_t pending_array[NSIG] /* = { 0 } */;
-
-/* Signal handler that is installed for blocked signals. */
-static void
-blocked_handler (int sig)
-{
- /* Reinstall the handler, in case the signal occurs multiple times
- while blocked. There is an inherent race where an asynchronous
- signal in between when the kernel uninstalled the handler and
- when we reinstall it will trigger the default handler; oh
- well. */
- signal (sig, blocked_handler);
- if (sig >= 0 && sig < NSIG)
- pending_array[sig] = 1;
-}
-
-int
-sigpending (sigset_t *set)
-{
- sigset_t pending = 0;
- int sig;
-
- for (sig = 0; sig < NSIG; sig++)
- if (pending_array[sig])
- pending |= 1U << sig;
- *set = pending;
- return 0;
-}
-
-/* The previous signal handlers.
- Only the array elements corresponding to blocked signals are relevant. */
-static volatile handler_t old_handlers[NSIG];
-
-int
-sigprocmask (int operation, const sigset_t *set, sigset_t *old_set)
-{
- if (old_set != NULL)
- *old_set = blocked_set;
-
- if (set != NULL)
- {
- sigset_t new_blocked_set;
- sigset_t to_unblock;
- sigset_t to_block;
-
- switch (operation)
- {
- case SIG_BLOCK:
- new_blocked_set = blocked_set | *set;
- break;
- case SIG_SETMASK:
- new_blocked_set = *set;
- break;
- case SIG_UNBLOCK:
- new_blocked_set = blocked_set & ~*set;
- break;
- default:
- errno = EINVAL;
- return -1;
- }
- to_unblock = blocked_set & ~new_blocked_set;
- to_block = new_blocked_set & ~blocked_set;
-
- if (to_block != 0)
- {
- int sig;
-
- for (sig = 0; sig < NSIG; sig++)
- if ((to_block >> sig) & 1)
- {
- pending_array[sig] = 0;
- if ((old_handlers[sig] = signal (sig, blocked_handler)) != SIG_ERR)
- blocked_set |= 1U << sig;
- }
- }
-
- if (to_unblock != 0)
- {
- sig_atomic_t received[NSIG];
- int sig;
-
- for (sig = 0; sig < NSIG; sig++)
- if ((to_unblock >> sig) & 1)
- {
- if (signal (sig, old_handlers[sig]) != blocked_handler)
- /* The application changed a signal handler while the signal
- was blocked, bypassing our rpl_signal replacement.
- We don't support this. */
- abort ();
- received[sig] = pending_array[sig];
- blocked_set &= ~(1U << sig);
- pending_array[sig] = 0;
- }
- else
- received[sig] = 0;
-
- for (sig = 0; sig < NSIG; sig++)
- if (received[sig])
- raise (sig);
- }
- }
- return 0;
-}
-
-/* Install the handler FUNC for signal SIG, and return the previous
- handler. */
-handler_t
-rpl_signal (int sig, handler_t handler)
-{
- /* We must provide a wrapper, so that a user can query what handler
- they installed even if that signal is currently blocked. */
- if (sig >= 0 && sig < NSIG && sig != SIGKILL && sig != SIGSTOP
- && handler != SIG_ERR)
- {
- #ifdef SIGABRT_COMPAT
- if (sig == SIGABRT_COMPAT)
- sig = SIGABRT;
- #endif
-
- if (blocked_set & (1U << sig))
- {
- /* POSIX states that sigprocmask and signal are both
- async-signal-safe. This is not true of our
- implementation - there is a slight data race where an
- asynchronous interrupt on signal A can occur after we
- install blocked_handler but before we have updated
- old_handlers for signal B, such that handler A can see
- stale information if it calls signal(B). Oh well -
- signal handlers really shouldn't try to manipulate the
- installed handlers of unrelated signals. */
- handler_t result = old_handlers[sig];
- old_handlers[sig] = handler;
- return result;
- }
- else
- return signal (sig, handler);
- }
- else
- {
- errno = EINVAL;
- return SIG_ERR;
- }
-}
-
-#if GNULIB_defined_SIGPIPE
-/* Raise the signal SIGPIPE. */
-int
-_gl_raise_SIGPIPE (void)
-{
- if (blocked_set & (1U << SIGPIPE))
- pending_array[SIGPIPE] = 1;
- else
- {
- handler_t handler = SIGPIPE_handler;
- if (handler == SIG_DFL)
- exit (128 + SIGPIPE);
- else if (handler != SIG_IGN)
- (*handler) (SIGPIPE);
- }
-}
-#endif
diff --git a/lib/stat-time.c b/lib/stat-time.c
new file mode 100644
index 00000000000..81b83ddb4fe
--- /dev/null
+++ b/lib/stat-time.c
@@ -0,0 +1,3 @@
+#include <config.h>
+#define _GL_STAT_TIME_INLINE _GL_EXTERN_INLINE
+#include "stat-time.h"
diff --git a/lib/stat-time.h b/lib/stat-time.h
new file mode 100644
index 00000000000..74dd00aeb3e
--- /dev/null
+++ b/lib/stat-time.h
@@ -0,0 +1,196 @@
+/* stat-related time functions.
+
+ Copyright (C) 2005, 2007, 2009-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* Written by Paul Eggert. */
+
+#ifndef STAT_TIME_H
+#define STAT_TIME_H 1
+
+#include <sys/stat.h>
+#include <time.h>
+
+_GL_INLINE_HEADER_BEGIN
+#ifndef _GL_STAT_TIME_INLINE
+# define _GL_STAT_TIME_INLINE _GL_INLINE
+#endif
+
+/* STAT_TIMESPEC (ST, ST_XTIM) is the ST_XTIM member for *ST of type
+ struct timespec, if available. If not, then STAT_TIMESPEC_NS (ST,
+ ST_XTIM) is the nanosecond component of the ST_XTIM member for *ST,
+ if available. ST_XTIM can be st_atim, st_ctim, st_mtim, or st_birthtim
+ for access, status change, data modification, or birth (creation)
+ time respectively.
+
+ These macros are private to stat-time.h. */
+#if defined HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC
+# ifdef TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC
+# define STAT_TIMESPEC(st, st_xtim) ((st)->st_xtim)
+# else
+# define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim.tv_nsec)
+# endif
+#elif defined HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC
+# define STAT_TIMESPEC(st, st_xtim) ((st)->st_xtim##espec)
+#elif defined HAVE_STRUCT_STAT_ST_ATIMENSEC
+# define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim##ensec)
+#elif defined HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC
+# define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim.st__tim.tv_nsec)
+#endif
+
+/* Return the nanosecond component of *ST's access time. */
+_GL_STAT_TIME_INLINE long int
+get_stat_atime_ns (struct stat const *st)
+{
+# if defined STAT_TIMESPEC
+ return STAT_TIMESPEC (st, st_atim).tv_nsec;
+# elif defined STAT_TIMESPEC_NS
+ return STAT_TIMESPEC_NS (st, st_atim);
+# else
+ return 0;
+# endif
+}
+
+/* Return the nanosecond component of *ST's status change time. */
+_GL_STAT_TIME_INLINE long int
+get_stat_ctime_ns (struct stat const *st)
+{
+# if defined STAT_TIMESPEC
+ return STAT_TIMESPEC (st, st_ctim).tv_nsec;
+# elif defined STAT_TIMESPEC_NS
+ return STAT_TIMESPEC_NS (st, st_ctim);
+# else
+ return 0;
+# endif
+}
+
+/* Return the nanosecond component of *ST's data modification time. */
+_GL_STAT_TIME_INLINE long int
+get_stat_mtime_ns (struct stat const *st)
+{
+# if defined STAT_TIMESPEC
+ return STAT_TIMESPEC (st, st_mtim).tv_nsec;
+# elif defined STAT_TIMESPEC_NS
+ return STAT_TIMESPEC_NS (st, st_mtim);
+# else
+ return 0;
+# endif
+}
+
+/* Return the nanosecond component of *ST's birth time. */
+_GL_STAT_TIME_INLINE long int
+get_stat_birthtime_ns (struct stat const *st)
+{
+# if defined HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC
+ return STAT_TIMESPEC (st, st_birthtim).tv_nsec;
+# elif defined HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC
+ return STAT_TIMESPEC_NS (st, st_birthtim);
+# else
+ /* Avoid a "parameter unused" warning. */
+ (void) st;
+ return 0;
+# endif
+}
+
+/* Return *ST's access time. */
+_GL_STAT_TIME_INLINE struct timespec
+get_stat_atime (struct stat const *st)
+{
+#ifdef STAT_TIMESPEC
+ return STAT_TIMESPEC (st, st_atim);
+#else
+ struct timespec t;
+ t.tv_sec = st->st_atime;
+ t.tv_nsec = get_stat_atime_ns (st);
+ return t;
+#endif
+}
+
+/* Return *ST's status change time. */
+_GL_STAT_TIME_INLINE struct timespec
+get_stat_ctime (struct stat const *st)
+{
+#ifdef STAT_TIMESPEC
+ return STAT_TIMESPEC (st, st_ctim);
+#else
+ struct timespec t;
+ t.tv_sec = st->st_ctime;
+ t.tv_nsec = get_stat_ctime_ns (st);
+ return t;
+#endif
+}
+
+/* Return *ST's data modification time. */
+_GL_STAT_TIME_INLINE struct timespec
+get_stat_mtime (struct stat const *st)
+{
+#ifdef STAT_TIMESPEC
+ return STAT_TIMESPEC (st, st_mtim);
+#else
+ struct timespec t;
+ t.tv_sec = st->st_mtime;
+ t.tv_nsec = get_stat_mtime_ns (st);
+ return t;
+#endif
+}
+
+/* Return *ST's birth time, if available; otherwise return a value
+ with tv_sec and tv_nsec both equal to -1. */
+_GL_STAT_TIME_INLINE struct timespec
+get_stat_birthtime (struct stat const *st)
+{
+ struct timespec t;
+
+#if (defined HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC \
+ || defined HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC)
+ t = STAT_TIMESPEC (st, st_birthtim);
+#elif defined HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC
+ t.tv_sec = st->st_birthtime;
+ t.tv_nsec = st->st_birthtimensec;
+#elif (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+ /* Native Windows platforms (but not Cygwin) put the "file creation
+ time" in st_ctime (!). See
+ <http://msdn2.microsoft.com/de-de/library/14h5k7ff(VS.80).aspx>. */
+ t.tv_sec = st->st_ctime;
+ t.tv_nsec = 0;
+#else
+ /* Birth time is not supported. */
+ t.tv_sec = -1;
+ t.tv_nsec = -1;
+ /* Avoid a "parameter unused" warning. */
+ (void) st;
+#endif
+
+#if (defined HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC \
+ || defined HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC \
+ || defined HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC)
+ /* FreeBSD and NetBSD sometimes signal the absence of knowledge by
+ using zero. Attempt to work around this problem. Alas, this can
+ report failure even for valid time stamps. Also, NetBSD
+ sometimes returns junk in the birth time fields; work around this
+ bug if it is detected. */
+ if (! (t.tv_sec && 0 <= t.tv_nsec && t.tv_nsec < 1000000000))
+ {
+ t.tv_sec = -1;
+ t.tv_nsec = -1;
+ }
+#endif
+
+ return t;
+}
+
+_GL_INLINE_HEADER_END
+
+#endif
diff --git a/lib/stat.c b/lib/stat.c
index 1397aa93290..75995408906 100644
--- a/lib/stat.c
+++ b/lib/stat.c
@@ -1,5 +1,5 @@
/* Work around platform bugs in stat.
- Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2009-2012 Free Software Foundation, Inc.
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
@@ -27,6 +27,21 @@
#include <sys/stat.h>
#undef __need_system_sys_stat_h
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+# if _GL_WINDOWS_64_BIT_ST_SIZE
+# undef stat /* avoid warning on mingw64 with _FILE_OFFSET_BITS=64 */
+# define stat _stati64
+# define REPLACE_FUNC_STAT_DIR 1
+# undef REPLACE_FUNC_STAT_FILE
+# elif REPLACE_FUNC_STAT_FILE
+/* mingw64 has a broken stat() function, based on _stat(), in libmingwex.a.
+ Bypass it. */
+# define stat _stat
+# define REPLACE_FUNC_STAT_DIR 1
+# undef REPLACE_FUNC_STAT_FILE
+# endif
+#endif
+
static inline int
orig_stat (const char *filename, struct stat *buf)
{
diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h
new file mode 100644
index 00000000000..8fba6943f69
--- /dev/null
+++ b/lib/stdalign.in.h
@@ -0,0 +1,90 @@
+/* A substitute for ISO C11 <stdalign.h>.
+
+ Copyright 2011-2012 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert and Bruno Haible. */
+
+#ifndef _GL_STDALIGN_H
+#define _GL_STDALIGN_H
+
+/* ISO C11 <stdalign.h> for platforms that lack it.
+
+ References:
+ ISO C11 (latest free draft
+ <http://www.open-std.org/jtc1/sc22/wg14/www/docs/n1570.pdf>)
+ sections 6.5.3.4, 6.7.5, 7.15.
+ C++11 (latest free draft
+ <http://www.open-std.org/jtc1/sc22/wg21/docs/papers/2011/n3242.pdf>)
+ section 18.10. */
+
+/* alignof (TYPE), also known as _Alignof (TYPE), yields the alignment
+ requirement of a structure member (i.e., slot or field) that is of
+ type TYPE, as an integer constant expression.
+
+ This differs from GCC's __alignof__ operator, which can yield a
+ better-performing alignment for an object of that type. For
+ example, on x86 with GCC, __alignof__ (double) and __alignof__
+ (long long) are 8, whereas alignof (double) and alignof (long long)
+ are 4 unless the option '-malign-double' is used.
+
+ The result cannot be used as a value for an 'enum' constant, if you
+ want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. */
+#include <stddef.h>
+#if defined __cplusplus
+ template <class __t> struct __alignof_helper { char __a; __t __b; };
+# define _Alignof(type) offsetof (__alignof_helper<type>, __b)
+#else
+# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b)
+#endif
+#define alignof _Alignof
+#define __alignof_is_defined 1
+
+/* alignas (A), also known as _Alignas (A), aligns a variable or type
+ to the alignment A, where A is an integer constant expression. For
+ example:
+
+ int alignas (8) foo;
+ struct s { int a; int alignas (8) bar; };
+
+ aligns the address of FOO and the offset of BAR to be multiples of 8.
+
+ A should be a power of two that is at least the type's alignment
+ and at most the implementation's alignment limit. This limit is
+ 2**28 on typical GNUish hosts, and 2**13 on MSVC. To be portable
+ to MSVC through at least version 10.0, A should be an integer
+ constant, as MSVC does not support expressions such as 1 << 3.
+ To be portable to Sun C 5.11, do not align auto variables to
+ anything stricter than their default alignment.
+
+ The following C11 requirements are not supported here:
+
+ - If A is zero, alignas has no effect.
+ - alignas can be used multiple times; the strictest one wins.
+ - alignas (TYPE) is equivalent to alignas (alignof (TYPE)).
+
+ */
+
+#if __GNUC__ || __IBMC__ || __IBMCPP__ || 0x5110 <= __SUNPRO_C
+# define _Alignas(a) __attribute__ ((__aligned__ (a)))
+#elif 1300 <= _MSC_VER
+# define _Alignas(a) __declspec (align (a))
+#endif
+#ifdef _Alignas
+# define alignas _Alignas
+# define __alignas_is_defined 1
+#endif
+
+#endif /* _GL_STDALIGN_H */
diff --git a/lib/stdarg.in.h b/lib/stdarg.in.h
index 43f96070708..53104a61923 100644
--- a/lib/stdarg.in.h
+++ b/lib/stdarg.in.h
@@ -1,5 +1,5 @@
/* Substitute for and wrapper around <stdarg.h>.
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
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
@@ -12,8 +12,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#ifndef _@GUARD_PREFIX@_STDARG_H
diff --git a/lib/stdbool.in.h b/lib/stdbool.in.h
index b64dc75b20c..1f8caee4f2d 100644
--- a/lib/stdbool.in.h
+++ b/lib/stdbool.in.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001-2003, 2006-2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001-2003, 2006-2012 Free Software Foundation, Inc.
Written by Bruno Haible <haible@clisp.cons.org>, 2001.
This program is free software; you can redistribute it and/or modify
@@ -12,8 +12,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#ifndef _GL_STDBOOL_H
#define _GL_STDBOOL_H
@@ -67,24 +66,19 @@
# undef true
#endif
-/* For the sake of symbolic names in gdb, we define true and false as
- enum constants, not only as macros.
- It is tempting to write
- typedef enum { false = 0, true = 1 } _Bool;
- so that gdb prints values of type 'bool' symbolically. But if we do
- this, values of type '_Bool' may promote to 'int' or 'unsigned int'
- (see ISO C 99 6.7.2.2.(4)); however, '_Bool' must promote to 'int'
- (see ISO C 99 6.3.1.1.(2)). So we add a negative value to the
- enum; this ensures that '_Bool' promotes to 'int'. */
-#if defined __cplusplus || (defined __BEOS__ && !defined __HAIKU__)
+#ifdef __cplusplus
+# define _Bool bool
+# define bool bool
+#else
+# if defined __BEOS__ && !defined __HAIKU__
/* A compiler known to have 'bool'. */
/* If the compiler already has both 'bool' and '_Bool', we can assume they
are the same types. */
-# if !@HAVE__BOOL@
+# if !@HAVE__BOOL@
typedef bool _Bool;
-# endif
-#else
-# if !defined __GNUC__
+# endif
+# else
+# if !defined __GNUC__
/* If @HAVE__BOOL@:
Some HP-UX cc and AIX IBM C compiler versions have compiler bugs when
the built-in _Bool type is used. See
@@ -104,19 +98,35 @@ typedef bool _Bool;
"Invalid enumerator. (badenum)" with HP-UX cc on Tru64.
The only benefit of the enum, debuggability, is not important
with these compilers. So use 'signed char' and no enum. */
-# define _Bool signed char
-# else
+# define _Bool signed char
+# else
/* With this compiler, trust the _Bool type if the compiler has it. */
-# if !@HAVE__BOOL@
+# if !@HAVE__BOOL@
+ /* For the sake of symbolic names in gdb, define true and false as
+ enum constants, not only as macros.
+ It is tempting to write
+ typedef enum { false = 0, true = 1 } _Bool;
+ so that gdb prints values of type 'bool' symbolically. But then
+ values of type '_Bool' might promote to 'int' or 'unsigned int'
+ (see ISO C 99 6.7.2.2.(4)); however, '_Bool' must promote to 'int'
+ (see ISO C 99 6.3.1.1.(2)). So add a negative value to the
+ enum; this ensures that '_Bool' promotes to 'int'. */
typedef enum { _Bool_must_promote_to_int = -1, false = 0, true = 1 } _Bool;
+# endif
# endif
# endif
+# define bool _Bool
#endif
-#define bool _Bool
/* The other macros must be usable in preprocessor directives. */
-#define false 0
-#define true 1
+#ifdef __cplusplus
+# define false false
+# define true true
+#else
+# define false 0
+# define true 1
+#endif
+
#define __bool_true_false_are_defined 1
#endif /* _GL_STDBOOL_H */
diff --git a/lib/stddef.in.h b/lib/stddef.in.h
index c7b98e7dcc5..17fcaea2bfe 100644
--- a/lib/stddef.in.h
+++ b/lib/stddef.in.h
@@ -1,6 +1,6 @@
/* A substitute for POSIX 2008 <stddef.h>, for platforms that have issues.
- Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2009-2012 Free Software Foundation, Inc.
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
@@ -13,8 +13,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
/* Written by Eric Blake. */
diff --git a/lib/stdint.in.h b/lib/stdint.in.h
index b6d08c754ae..e2a0eb19ac0 100644
--- a/lib/stdint.in.h
+++ b/lib/stdint.in.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001-2002, 2004-2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001-2002, 2004-2012 Free Software Foundation, Inc.
Written by Paul Eggert, Bruno Haible, Sam Steingold, Peter Burwood.
This file is part of gnulib.
@@ -13,8 +13,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
/*
* ISO C 99 <stdint.h> for platforms that lack it.
@@ -34,6 +33,16 @@
<inttypes.h>. */
#define _GL_JUST_INCLUDE_SYSTEM_INTTYPES_H
+/* On Android (Bionic libc), <sys/types.h> includes this file before
+ having defined 'time_t'. Therefore in this case avoid including
+ other system header files; just include the system's <stdint.h>.
+ Ideally we should test __BIONIC__ here, but it is only defined after
+ <sys/cdefs.h> has been included; hence test __ANDROID__ instead. */
+#if defined __ANDROID__ \
+ && defined _SYS_TYPES_H_ && !defined _SSIZE_T_DEFINED_
+# @INCLUDE_NEXT@ @NEXT_STDINT_H@
+#else
+
/* Get those types that are already defined in other system include
files, so that we can "#define int8_t signed char" below without
worrying about a later system include file containing a "typedef
@@ -49,6 +58,17 @@
diagnostics. */
# define __STDINT_H__
# endif
+
+ /* Some pre-C++11 <stdint.h> implementations need this. */
+# ifdef __cplusplus
+# ifndef __STDC_CONSTANT_MACROS
+# define __STDC_CONSTANT_MACROS 1
+# endif
+# ifndef __STDC_LIMIT_MACROS
+# define __STDC_LIMIT_MACROS 1
+# endif
+# endif
+
/* Other systems may have an incomplete or buggy <stdint.h>.
Include it before <inttypes.h>, since any "#include <stdint.h>"
in <inttypes.h> would reinclude us, skipping our contents because
@@ -63,14 +83,15 @@
/* <sys/types.h> defines some of the stdint.h types as well, on glibc,
IRIX 6.5, and OpenBSD 3.8 (via <machine/types.h>).
AIX 5.2 <sys/types.h> isn't needed and causes troubles.
- MacOS X 10.4.6 <sys/types.h> includes <stdint.h> (which is us), but
+ Mac OS X 10.4.6 <sys/types.h> includes <stdint.h> (which is us), but
relies on the system <stdint.h> definitions, so include
<sys/types.h> after @NEXT_STDINT_H@. */
#if @HAVE_SYS_TYPES_H@ && ! defined _AIX
# include <sys/types.h>
#endif
-/* Get LONG_MIN, LONG_MAX, ULONG_MAX. */
+/* Get SCHAR_MIN, SCHAR_MAX, UCHAR_MAX, INT_MIN, INT_MAX,
+ LONG_MIN, LONG_MAX, ULONG_MAX. */
#include <limits.h>
#if @HAVE_INTTYPES_H@
@@ -226,8 +247,9 @@ typedef unsigned long long int gl_uint64_t;
/* Here we assume a standard architecture where the hardware integer
types have 8, 16, 32, optionally 64 bits. Therefore the fastN_t types
- are taken from the same list of types. Assume that 'long int'
- is fast enough for all narrower integers. */
+ are taken from the same list of types. The following code normally
+ uses types consistent with glibc, as that lessens the chance of
+ incompatibility with older GNU hosts. */
#undef int_fast8_t
#undef uint_fast8_t
@@ -237,12 +259,21 @@ typedef unsigned long long int gl_uint64_t;
#undef uint_fast32_t
#undef int_fast64_t
#undef uint_fast64_t
-typedef long int gl_int_fast8_t;
-typedef unsigned long int gl_uint_fast8_t;
-typedef long int gl_int_fast16_t;
-typedef unsigned long int gl_uint_fast16_t;
+typedef signed char gl_int_fast8_t;
+typedef unsigned char gl_uint_fast8_t;
+
+#ifdef __sun
+/* Define types compatible with SunOS 5.10, so that code compiled under
+ earlier SunOS versions works with code compiled under SunOS 5.10. */
+typedef int gl_int_fast32_t;
+typedef unsigned int gl_uint_fast32_t;
+#else
typedef long int gl_int_fast32_t;
typedef unsigned long int gl_uint_fast32_t;
+#endif
+typedef gl_int_fast32_t gl_int_fast16_t;
+typedef gl_uint_fast32_t gl_uint_fast16_t;
+
#define int_fast8_t gl_int_fast8_t
#define uint_fast8_t gl_uint_fast8_t
#define int_fast16_t gl_int_fast16_t
@@ -313,8 +344,6 @@ typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t)
/* 7.18.2. Limits of specified-width integer types */
-#if ! defined __cplusplus || defined __STDC_LIMIT_MACROS
-
/* 7.18.2.1. Limits of exact-width integer types */
/* Here we assume a standard architecture where the hardware integer
@@ -400,23 +429,29 @@ typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t)
#undef INT_FAST8_MIN
#undef INT_FAST8_MAX
#undef UINT_FAST8_MAX
-#define INT_FAST8_MIN LONG_MIN
-#define INT_FAST8_MAX LONG_MAX
-#define UINT_FAST8_MAX ULONG_MAX
+#define INT_FAST8_MIN SCHAR_MIN
+#define INT_FAST8_MAX SCHAR_MAX
+#define UINT_FAST8_MAX UCHAR_MAX
#undef INT_FAST16_MIN
#undef INT_FAST16_MAX
#undef UINT_FAST16_MAX
-#define INT_FAST16_MIN LONG_MIN
-#define INT_FAST16_MAX LONG_MAX
-#define UINT_FAST16_MAX ULONG_MAX
+#define INT_FAST16_MIN INT_FAST32_MIN
+#define INT_FAST16_MAX INT_FAST32_MAX
+#define UINT_FAST16_MAX UINT_FAST32_MAX
#undef INT_FAST32_MIN
#undef INT_FAST32_MAX
#undef UINT_FAST32_MAX
-#define INT_FAST32_MIN LONG_MIN
-#define INT_FAST32_MAX LONG_MAX
-#define UINT_FAST32_MAX ULONG_MAX
+#ifdef __sun
+# define INT_FAST32_MIN INT_MIN
+# define INT_FAST32_MAX INT_MAX
+# define UINT_FAST32_MAX UINT_MAX
+#else
+# define INT_FAST32_MIN LONG_MIN
+# define INT_FAST32_MAX LONG_MAX
+# define UINT_FAST32_MAX ULONG_MAX
+#endif
#undef INT_FAST64_MIN
#undef INT_FAST64_MAX
@@ -534,12 +569,8 @@ typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t)
#define WINT_MAX \
_STDINT_MAX (@HAVE_SIGNED_WINT_T@, @BITSIZEOF_WINT_T@, 0@WINT_T_SUFFIX@)
-#endif /* !defined __cplusplus || defined __STDC_LIMIT_MACROS */
-
/* 7.18.4. Macros for integer constants */
-#if ! defined __cplusplus || defined __STDC_CONSTANT_MACROS
-
/* 7.18.4.1. Macros for minimum-width integer constants */
/* According to ISO C 99 Technical Corrigendum 1 */
@@ -600,7 +631,6 @@ typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t)
# endif
#endif
-#endif /* !defined __cplusplus || defined __STDC_CONSTANT_MACROS */
-
#endif /* _@GUARD_PREFIX@_STDINT_H */
+#endif /* !(defined __ANDROID__ && ...) */
#endif /* !defined _@GUARD_PREFIX@_STDINT_H && !defined _GL_JUST_INCLUDE_SYSTEM_STDINT_H */
diff --git a/lib/stdio.in.h b/lib/stdio.in.h
index ce00af574a8..b1b543dee72 100644
--- a/lib/stdio.in.h
+++ b/lib/stdio.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <stdio.h>.
- Copyright (C) 2004, 2007-2011 Free Software Foundation, Inc.
+ Copyright (C) 2004, 2007-2012 Free Software Foundation, Inc.
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
@@ -13,8 +13,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
@@ -53,7 +52,8 @@
#include <stddef.h>
/* Get off_t and ssize_t. Needed on many systems, including glibc 2.8
- and eglibc 2.11.2. */
+ and eglibc 2.11.2.
+ May also define off_t to a 64-bit type on native Windows. */
#include <sys/types.h>
/* The __attribute__ feature is available in gcc versions 2.5 and later.
@@ -186,7 +186,7 @@ _GL_CXXALIASWARN (fdopen);
#elif defined GNULIB_POSIXCHECK
# undef fdopen
/* Assume fdopen is always declared. */
-_GL_WARN_ON_USE (fdopen, "fdopen on Win32 platforms is not POSIX compatible - "
+_GL_WARN_ON_USE (fdopen, "fdopen on native Windows platforms is not POSIX compliant - "
"use gnulib module fdopen for portability");
#endif
@@ -259,7 +259,7 @@ _GL_CXXALIASWARN (fopen);
#elif defined GNULIB_POSIXCHECK
# undef fopen
/* Assume fopen is always declared. */
-_GL_WARN_ON_USE (fopen, "fopen on Win32 platforms is not POSIX compatible - "
+_GL_WARN_ON_USE (fopen, "fopen on native Windows platforms is not POSIX compliant - "
"use gnulib module fopen for portability");
#endif
@@ -387,7 +387,7 @@ _GL_CXXALIASWARN (freopen);
# undef freopen
/* Assume freopen is always declared. */
_GL_WARN_ON_USE (freopen,
- "freopen on Win32 platforms is not POSIX compatible - "
+ "freopen on native Windows platforms is not POSIX compliant - "
"use gnulib module freopen for portability");
#endif
@@ -699,22 +699,11 @@ _GL_WARN_ON_USE (getline, "getline is unportable - "
# endif
#endif
-#if @GNULIB_GETS@
-# if @REPLACE_STDIO_READ_FUNCS@ && @GNULIB_STDIO_H_NONBLOCKING@
-# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
-# undef gets
-# define gets rpl_gets
-# endif
-_GL_FUNCDECL_RPL (gets, char *, (char *s) _GL_ARG_NONNULL ((1)));
-_GL_CXXALIAS_RPL (gets, char *, (char *s));
-# else
-_GL_CXXALIAS_SYS (gets, char *, (char *s));
-# undef gets
-# endif
-_GL_CXXALIASWARN (gets);
/* It is very rare that the developer ever has full control of stdin,
- so any use of gets warrants an unconditional warning. Assume it is
- always declared, since it is required by C89. */
+ so any use of gets warrants an unconditional warning; besides, C11
+ removed it. */
+#undef gets
+#if HAVE_RAW_DECL_GETS
_GL_WARN_ON_USE (gets, "gets is a security hole - use fgets instead");
#endif
@@ -779,7 +768,7 @@ _GL_CXXALIASWARN (pclose);
#elif defined GNULIB_POSIXCHECK
# undef pclose
# if HAVE_RAW_DECL_PCLOSE
-_GL_WARN_ON_USE (pclose, "popen is unportable - "
+_GL_WARN_ON_USE (pclose, "pclose is unportable - "
"use gnulib module pclose for more portability");
# endif
#endif
@@ -1054,9 +1043,9 @@ _GL_WARN_ON_USE (snprintf, "snprintf is unportable - "
# endif
#endif
-/* Some people would argue that sprintf should be handled like gets
- (for example, OpenBSD issues a link warning for both functions),
- since both can cause security holes due to buffer overruns.
+/* Some people would argue that all sprintf uses should be warned about
+ (for example, OpenBSD issues a link warning for it),
+ since it can cause security holes due to buffer overruns.
However, we believe that sprintf can be used safely, and is more
efficient than snprintf in those safe cases; and as proof of our
belief, we use sprintf in several gnulib modules. So this header
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
index 047fac18b83..65558402bf3 100644
--- a/lib/stdlib.in.h
+++ b/lib/stdlib.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <stdlib.h>.
- Copyright (C) 1995, 2001-2004, 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2001-2004, 2006-2012 Free Software Foundation, Inc.
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
@@ -49,6 +49,11 @@
# include <sys/loadavg.h>
#endif
+/* Native Windows platforms declare mktemp() in <io.h>. */
+#if 0 && ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__)
+# include <io.h>
+#endif
+
#if @GNULIB_RANDOM_R@
/* OSF/1 5.1 declares 'struct random_data' in <random.h>, which is included
@@ -58,7 +63,7 @@
# include <random.h>
# endif
-# if !@HAVE_STRUCT_RANDOM_DATA@ || !@HAVE_RANDOM_R@
+# if !@HAVE_STRUCT_RANDOM_DATA@ || @REPLACE_RANDOM_R@ || !@HAVE_RANDOM_R@
# include <stdint.h>
# endif
@@ -82,13 +87,21 @@ struct random_data
#endif
#if (@GNULIB_MKSTEMP@ || @GNULIB_MKSTEMPS@ || @GNULIB_GETSUBOPT@ || defined GNULIB_POSIXCHECK) && ! defined __GLIBC__ && !((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__)
-/* On MacOS X 10.3, only <unistd.h> declares mkstemp. */
-/* On MacOS X 10.5, only <unistd.h> declares mkstemps. */
+/* On Mac OS X 10.3, only <unistd.h> declares mkstemp. */
+/* On Mac OS X 10.5, only <unistd.h> declares mkstemps. */
/* On Cygwin 1.7.1, only <unistd.h> declares getsubopt. */
/* But avoid namespace pollution on glibc systems and native Windows. */
# include <unistd.h>
#endif
+/* The __attribute__ feature is available in gcc versions 2.5 and later.
+ The attribute __pure__ was added in gcc 2.96. */
+#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
+# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+#else
+# define _GL_ATTRIBUTE_PURE /* empty */
+#endif
+
/* The definition of _Noreturn is copied here. */
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
@@ -133,7 +146,9 @@ _GL_WARN_ON_USE (_Exit, "_Exit is unportable - "
/* Parse a signed decimal integer.
Returns the value of the integer. Errors are not detected. */
# if !@HAVE_ATOLL@
-_GL_FUNCDECL_SYS (atoll, long long, (const char *string) _GL_ARG_NONNULL ((1)));
+_GL_FUNCDECL_SYS (atoll, long long, (const char *string)
+ _GL_ATTRIBUTE_PURE
+ _GL_ARG_NONNULL ((1)));
# endif
_GL_CXXALIAS_SYS (atoll, long long, (const char *string));
_GL_CXXALIASWARN (atoll);
@@ -247,7 +262,7 @@ _GL_CXXALIASWARN (grantpt);
#elif defined GNULIB_POSIXCHECK
# undef grantpt
# if HAVE_RAW_DECL_GRANTPT
-_GL_WARN_ON_USE (ptsname, "grantpt is not portable - "
+_GL_WARN_ON_USE (grantpt, "grantpt is not portable - "
"use gnulib module grantpt for portability");
# endif
#endif
@@ -423,13 +438,38 @@ _GL_WARN_ON_USE (mkstemps, "mkstemps is unportable - "
# endif
#endif
+#if @GNULIB_POSIX_OPENPT@
+/* Return an FD open to the master side of a pseudo-terminal. Flags should
+ include O_RDWR, and may also include O_NOCTTY. */
+# if !@HAVE_POSIX_OPENPT@
+_GL_FUNCDECL_SYS (posix_openpt, int, (int flags));
+# endif
+_GL_CXXALIAS_SYS (posix_openpt, int, (int flags));
+_GL_CXXALIASWARN (posix_openpt);
+#elif defined GNULIB_POSIXCHECK
+# undef posix_openpt
+# if HAVE_RAW_DECL_POSIX_OPENPT
+_GL_WARN_ON_USE (posix_openpt, "posix_openpt is not portable - "
+ "use gnulib module posix_openpt for portability");
+# endif
+#endif
+
#if @GNULIB_PTSNAME@
/* Return the pathname of the pseudo-terminal slave associated with
the master FD is open on, or NULL on errors. */
-# if !@HAVE_PTSNAME@
+# if @REPLACE_PTSNAME@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef ptsname
+# define ptsname rpl_ptsname
+# endif
+_GL_FUNCDECL_RPL (ptsname, char *, (int fd));
+_GL_CXXALIAS_RPL (ptsname, char *, (int fd));
+# else
+# if !@HAVE_PTSNAME@
_GL_FUNCDECL_SYS (ptsname, char *, (int fd));
-# endif
+# endif
_GL_CXXALIAS_SYS (ptsname, char *, (int fd));
+# endif
_GL_CXXALIASWARN (ptsname);
#elif defined GNULIB_POSIXCHECK
# undef ptsname
@@ -439,6 +479,32 @@ _GL_WARN_ON_USE (ptsname, "ptsname is not portable - "
# endif
#endif
+#if @GNULIB_PTSNAME_R@
+/* Set the pathname of the pseudo-terminal slave associated with
+ the master FD is open on and return 0, or set errno and return
+ non-zero on errors. */
+# if @REPLACE_PTSNAME_R@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef ptsname_r
+# define ptsname_r rpl_ptsname_r
+# endif
+_GL_FUNCDECL_RPL (ptsname_r, int, (int fd, char *buf, size_t len));
+_GL_CXXALIAS_RPL (ptsname_r, int, (int fd, char *buf, size_t len));
+# else
+# if !@HAVE_PTSNAME_R@
+_GL_FUNCDECL_SYS (ptsname_r, int, (int fd, char *buf, size_t len));
+# endif
+_GL_CXXALIAS_SYS (ptsname_r, int, (int fd, char *buf, size_t len));
+# endif
+_GL_CXXALIASWARN (ptsname_r);
+#elif defined GNULIB_POSIXCHECK
+# undef ptsname_r
+# if HAVE_RAW_DECL_PTSNAME_R
+_GL_WARN_ON_USE (ptsname_r, "ptsname_r is not portable - "
+ "use gnulib module ptsname_r for portability");
+# endif
+#endif
+
#if @GNULIB_PUTENV@
# if @REPLACE_PUTENV@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
@@ -462,12 +528,83 @@ _GL_CXXALIASWARN (putenv);
# endif
#endif
+
+#if @GNULIB_RANDOM@
+# if !@HAVE_RANDOM@
+_GL_FUNCDECL_SYS (random, long, (void));
+# endif
+_GL_CXXALIAS_SYS (random, long, (void));
+_GL_CXXALIASWARN (random);
+#elif defined GNULIB_POSIXCHECK
+# undef random
+# if HAVE_RAW_DECL_RANDOM
+_GL_WARN_ON_USE (random, "random is unportable - "
+ "use gnulib module random for portability");
+# endif
+#endif
+
+#if @GNULIB_RANDOM@
+# if !@HAVE_RANDOM@
+_GL_FUNCDECL_SYS (srandom, void, (unsigned int seed));
+# endif
+_GL_CXXALIAS_SYS (srandom, void, (unsigned int seed));
+_GL_CXXALIASWARN (srandom);
+#elif defined GNULIB_POSIXCHECK
+# undef srandom
+# if HAVE_RAW_DECL_SRANDOM
+_GL_WARN_ON_USE (srandom, "srandom is unportable - "
+ "use gnulib module random for portability");
+# endif
+#endif
+
+#if @GNULIB_RANDOM@
+# if !@HAVE_RANDOM@
+_GL_FUNCDECL_SYS (initstate, char *,
+ (unsigned int seed, char *buf, size_t buf_size)
+ _GL_ARG_NONNULL ((2)));
+# endif
+_GL_CXXALIAS_SYS (initstate, char *,
+ (unsigned int seed, char *buf, size_t buf_size));
+_GL_CXXALIASWARN (initstate);
+#elif defined GNULIB_POSIXCHECK
+# undef initstate
+# if HAVE_RAW_DECL_INITSTATE_R
+_GL_WARN_ON_USE (initstate, "initstate is unportable - "
+ "use gnulib module random for portability");
+# endif
+#endif
+
+#if @GNULIB_RANDOM@
+# if !@HAVE_RANDOM@
+_GL_FUNCDECL_SYS (setstate, char *, (char *arg_state) _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (setstate, char *, (char *arg_state));
+_GL_CXXALIASWARN (setstate);
+#elif defined GNULIB_POSIXCHECK
+# undef setstate
+# if HAVE_RAW_DECL_SETSTATE_R
+_GL_WARN_ON_USE (setstate, "setstate is unportable - "
+ "use gnulib module random for portability");
+# endif
+#endif
+
+
#if @GNULIB_RANDOM_R@
-# if !@HAVE_RANDOM_R@
+# if @REPLACE_RANDOM_R@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef random_r
+# define random_r rpl_random_r
+# endif
+_GL_FUNCDECL_RPL (random_r, int, (struct random_data *buf, int32_t *result)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (random_r, int, (struct random_data *buf, int32_t *result));
+# else
+# if !@HAVE_RANDOM_R@
_GL_FUNCDECL_SYS (random_r, int, (struct random_data *buf, int32_t *result)
_GL_ARG_NONNULL ((1, 2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (random_r, int, (struct random_data *buf, int32_t *result));
+# endif
_GL_CXXALIASWARN (random_r);
#elif defined GNULIB_POSIXCHECK
# undef random_r
@@ -478,13 +615,25 @@ _GL_WARN_ON_USE (random_r, "random_r is unportable - "
#endif
#if @GNULIB_RANDOM_R@
-# if !@HAVE_RANDOM_R@
+# if @REPLACE_RANDOM_R@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef srandom_r
+# define srandom_r rpl_srandom_r
+# endif
+_GL_FUNCDECL_RPL (srandom_r, int,
+ (unsigned int seed, struct random_data *rand_state)
+ _GL_ARG_NONNULL ((2)));
+_GL_CXXALIAS_RPL (srandom_r, int,
+ (unsigned int seed, struct random_data *rand_state));
+# else
+# if !@HAVE_RANDOM_R@
_GL_FUNCDECL_SYS (srandom_r, int,
(unsigned int seed, struct random_data *rand_state)
_GL_ARG_NONNULL ((2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (srandom_r, int,
(unsigned int seed, struct random_data *rand_state));
+# endif
_GL_CXXALIASWARN (srandom_r);
#elif defined GNULIB_POSIXCHECK
# undef srandom_r
@@ -495,15 +644,29 @@ _GL_WARN_ON_USE (srandom_r, "srandom_r is unportable - "
#endif
#if @GNULIB_RANDOM_R@
-# if !@HAVE_RANDOM_R@
+# if @REPLACE_RANDOM_R@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef initstate_r
+# define initstate_r rpl_initstate_r
+# endif
+_GL_FUNCDECL_RPL (initstate_r, int,
+ (unsigned int seed, char *buf, size_t buf_size,
+ struct random_data *rand_state)
+ _GL_ARG_NONNULL ((2, 4)));
+_GL_CXXALIAS_RPL (initstate_r, int,
+ (unsigned int seed, char *buf, size_t buf_size,
+ struct random_data *rand_state));
+# else
+# if !@HAVE_RANDOM_R@
_GL_FUNCDECL_SYS (initstate_r, int,
(unsigned int seed, char *buf, size_t buf_size,
struct random_data *rand_state)
_GL_ARG_NONNULL ((2, 4)));
-# endif
+# endif
_GL_CXXALIAS_SYS (initstate_r, int,
(unsigned int seed, char *buf, size_t buf_size,
struct random_data *rand_state));
+# endif
_GL_CXXALIASWARN (initstate_r);
#elif defined GNULIB_POSIXCHECK
# undef initstate_r
@@ -514,13 +677,25 @@ _GL_WARN_ON_USE (initstate_r, "initstate_r is unportable - "
#endif
#if @GNULIB_RANDOM_R@
-# if !@HAVE_RANDOM_R@
+# if @REPLACE_RANDOM_R@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef setstate_r
+# define setstate_r rpl_setstate_r
+# endif
+_GL_FUNCDECL_RPL (setstate_r, int,
+ (char *arg_state, struct random_data *rand_state)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (setstate_r, int,
+ (char *arg_state, struct random_data *rand_state));
+# else
+# if !@HAVE_RANDOM_R@
_GL_FUNCDECL_SYS (setstate_r, int,
(char *arg_state, struct random_data *rand_state)
_GL_ARG_NONNULL ((1, 2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (setstate_r, int,
(char *arg_state, struct random_data *rand_state));
+# endif
_GL_CXXALIASWARN (setstate_r);
#elif defined GNULIB_POSIXCHECK
# undef setstate_r
diff --git a/lib/strftime.c b/lib/strftime.c
index acebc9adfad..c7b8eb5ef7e 100644
--- a/lib/strftime.c
+++ b/lib/strftime.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991-2001, 2003-2007, 2009-2011 Free Software Foundation, Inc.
+/* Copyright (C) 1991-2001, 2003-2007, 2009-2012 Free Software Foundation, Inc.
NOTE: The canonical source of this file is maintained with the GNU C Library.
Bugs can be reported to bug-glibc@prep.ai.mit.edu.
@@ -40,7 +40,7 @@
extern char *tzname[];
#endif
-/* Do multibyte processing if multibytes are supported, unless
+/* Do multibyte processing if multibyte encodings are supported, unless
multibyte sequences are safe in formats. Multibyte sequences are
safe if they cannot contain byte sequences that look like format
conversion specifications. The multibyte encodings used by the
@@ -289,7 +289,7 @@ extern char *tzname[];
# define TOLOWER(Ch, L) tolower (Ch)
# endif
#endif
-/* We don't use `isdigit' here since the locale dependent
+/* We don't use 'isdigit' here since the locale dependent
interpretation is not what we want here. We only need to accept
the arabic digits in the ASCII range. One day there is perhaps a
more reliable way to accept other sets of digits. */
@@ -437,7 +437,7 @@ strftime_case_ (bool upcase, STREAM_OR_CHAR_T *s,
#ifdef _NL_CURRENT
/* We cannot make the following values variables since we must delay
the evaluation of these values until really needed since some
- expressions might not be valid in every situation. The `struct tm'
+ expressions might not be valid in every situation. The 'struct tm'
might be generated by a strptime() call that initialized
only a few elements. Dereference the pointers only if the format
requires this. Then it is ok to fail if the pointers are invalid. */
@@ -896,7 +896,7 @@ strftime_case_ (bool upcase, STREAM_OR_CHAR_T *s,
goto do_number_body;
do_number_spacepad:
- /* Force `_' flag unless overridden by `0' or `-' flag. */
+ /* Force '_' flag unless overridden by '0' or '-' flag. */
if (pad != L_('0') && pad != L_('-'))
pad = L_('_');
diff --git a/lib/strftime.h b/lib/strftime.h
index 3410568a9a4..d3b4cb28c52 100644
--- a/lib/strftime.h
+++ b/lib/strftime.h
@@ -1,6 +1,6 @@
/* declarations for strftime.c
- Copyright (C) 2002, 2004, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2004, 2008-2012 Free Software Foundation, Inc.
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
diff --git a/lib/strtoimax.c b/lib/strtoimax.c
index 497d15585ce..4f5fdbb5f22 100644
--- a/lib/strtoimax.c
+++ b/lib/strtoimax.c
@@ -1,6 +1,6 @@
/* Convert string representation of a number into an intmax_t value.
- Copyright (C) 1999, 2001-2004, 2006, 2009-2011 Free Software Foundation,
+ Copyright (C) 1999, 2001-2004, 2006, 2009-2012 Free Software Foundation,
Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/strtol.c b/lib/strtol.c
index 6c15d11e8f8..bf992a8c272 100644
--- a/lib/strtol.c
+++ b/lib/strtol.c
@@ -1,6 +1,6 @@
/* Convert string representation of a number into an integer value.
- Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2011 Free Software
+ Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2012 Free Software
Foundation, Inc.
NOTE: The canonical source of this file is maintained with the GNU C
@@ -40,7 +40,7 @@
# include "../locale/localeinfo.h"
#endif
-/* Nonzero if we are defining `strtoul' or `strtoull', operating on
+/* Nonzero if we are defining 'strtoul' or 'strtoull', operating on
unsigned integers. */
#ifndef UNSIGNED
# define UNSIGNED 0
@@ -110,8 +110,8 @@
# endif
#endif
-/* If QUAD is defined, we are defining `strtoll' or `strtoull',
- operating on `long long int's. */
+/* If QUAD is defined, we are defining 'strtoll' or 'strtoull',
+ operating on 'long long int's. */
#ifdef QUAD
# define LONG long long
# define STRTOL_LONG_MIN LLONG_MIN
@@ -227,7 +227,7 @@
-/* Convert NPTR to an `unsigned long int' or `long int' in base BASE.
+/* Convert NPTR to an 'unsigned long int' or 'long int' in base BASE.
If BASE is 0 the base is determined by the presence of a leading
zero, indicating octal or a leading "0x" or "0X", indicating hexadecimal.
If BASE is < 2 or > 36, it is reset to 10.
@@ -380,7 +380,7 @@ INTERNAL (strtol) (const STRING_TYPE *nptr, STRING_TYPE **endptr,
#if !UNSIGNED
/* Check for a value that is within the range of
- `unsigned LONG int', but outside the range of `LONG int'. */
+ 'unsigned LONG int', but outside the range of 'LONG int'. */
if (overflow == 0
&& i > (negative
? -((unsigned LONG int) (STRTOL_LONG_MIN + 1)) + 1
@@ -405,7 +405,7 @@ noconv:
/* We must handle a special case here: the base is 0 or 16 and the
first two characters are '0' and 'x', but the rest are no
hexadecimal digits. This is no error case. We return 0 and
- ENDPTR points to the `x`. */
+ ENDPTR points to the 'x'. */
if (endptr != NULL)
{
if (save - nptr >= 2 && TOUPPER (save[-1]) == L_('X')
diff --git a/lib/strtoll.c b/lib/strtoll.c
index 75afa4d9bc9..fdfceb01371 100644
--- a/lib/strtoll.c
+++ b/lib/strtoll.c
@@ -1,5 +1,5 @@
-/* Function to parse a `long long int' from text.
- Copyright (C) 1995-1997, 1999, 2001, 2009-2011 Free Software Foundation,
+/* Function to parse a 'long long int' from text.
+ Copyright (C) 1995-1997, 1999, 2001, 2009-2012 Free Software Foundation,
Inc.
This file is part of the GNU C Library.
diff --git a/lib/strtoul.c b/lib/strtoul.c
index 6fa6d0c2e01..e99da41edc0 100644
--- a/lib/strtoul.c
+++ b/lib/strtoul.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991, 1997, 2009-2011 Free Software Foundation, Inc.
+/* Copyright (C) 1991, 1997, 2009-2012 Free Software Foundation, Inc.
This file is part of the GNU C Library.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/strtoull.c b/lib/strtoull.c
index bf259958d6e..33c2c5d9afb 100644
--- a/lib/strtoull.c
+++ b/lib/strtoull.c
@@ -1,5 +1,5 @@
-/* Function to parse an `unsigned long long int' from text.
- Copyright (C) 1995-1997, 1999, 2009-2011 Free Software Foundation, Inc.
+/* Function to parse an 'unsigned long long int' from text.
+ Copyright (C) 1995-1997, 1999, 2009-2012 Free Software Foundation, Inc.
NOTE: The canonical source of this file is maintained with the GNU C
Library. Bugs can be reported to bug-glibc@gnu.org.
diff --git a/lib/symlink.c b/lib/symlink.c
index 2896cc9655b..642ca66b66c 100644
--- a/lib/symlink.c
+++ b/lib/symlink.c
@@ -1,5 +1,5 @@
/* Stub for symlink().
- Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2009-2012 Free Software Foundation, Inc.
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
diff --git a/lib/sys_select.in.h b/lib/sys_select.in.h
new file mode 100644
index 00000000000..ae8f90cae74
--- /dev/null
+++ b/lib/sys_select.in.h
@@ -0,0 +1,298 @@
+/* Substitute for <sys/select.h>.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+# if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+# endif
+@PRAGMA_COLUMNS@
+
+/* On OSF/1, <sys/types.h> and <sys/time.h> include <sys/select.h>.
+ Simply delegate to the system's header in this case. */
+#if @HAVE_SYS_SELECT_H@ && defined __osf__ && (defined _SYS_TYPES_H_ && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TYPES_H) && defined _OSF_SOURCE
+
+# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TYPES_H
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+#elif @HAVE_SYS_SELECT_H@ && defined __osf__ && (defined _SYS_TIME_H_ && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H) && defined _OSF_SOURCE
+
+# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+/* On IRIX 6.5, <sys/timespec.h> includes <sys/types.h>, which includes
+ <sys/bsd_types.h>, which includes <sys/select.h>. At this point we cannot
+ include <signal.h>, because that includes <internal/signal_core.h>, which
+ gives a syntax error because <sys/timespec.h> has not been completely
+ processed. Simply delegate to the system's header in this case. */
+#elif @HAVE_SYS_SELECT_H@ && defined __sgi && (defined _SYS_BSD_TYPES_H && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_BSD_TYPES_H)
+
+# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_BSD_TYPES_H
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+/* On OpenBSD 5.0, <pthread.h> includes <sys/types.h>, which includes
+ <sys/select.h>. At this point we cannot include <signal.h>, because that
+ includes gnulib's pthread.h override, which gives a syntax error because
+ /usr/include/pthread.h has not been completely processed. Simply delegate
+ to the system's header in this case. */
+#elif @HAVE_SYS_SELECT_H@ && defined __OpenBSD__ && (defined _PTHREAD_H_ && !defined PTHREAD_MUTEX_INITIALIZER)
+
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+#else
+
+#ifndef _@GUARD_PREFIX@_SYS_SELECT_H
+
+/* On many platforms, <sys/select.h> assumes prior inclusion of
+ <sys/types.h>. Also, mingw defines sigset_t there, instead of
+ in <signal.h> where it belongs. */
+#include <sys/types.h>
+
+#if @HAVE_SYS_SELECT_H@
+
+/* On OSF/1 4.0, <sys/select.h> provides only a forward declaration
+ of 'struct timeval', and no definition of this type.
+ Also, Mac OS X, AIX, HP-UX, IRIX, Solaris, Interix declare select()
+ in <sys/time.h>.
+ But avoid namespace pollution on glibc systems. */
+# ifndef __GLIBC__
+# include <sys/time.h>
+# endif
+
+/* On AIX 7 and Solaris 10, <sys/select.h> provides an FD_ZERO implementation
+ that relies on memset(), but without including <string.h>.
+ But in any case avoid namespace pollution on glibc systems. */
+# if (defined __OpenBSD__ || defined _AIX || defined __sun || defined __osf__ || defined __BEOS__) \
+ && ! defined __GLIBC__
+# include <string.h>
+# endif
+
+/* The include_next requires a split double-inclusion guard. */
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+#endif
+
+/* Get definition of 'sigset_t'.
+ But avoid namespace pollution on glibc systems.
+ Do this after the include_next (for the sake of OpenBSD 5.0) but before
+ the split double-inclusion guard (for the sake of Solaris). */
+#if !(defined __GLIBC__ && !defined __UCLIBC__)
+# include <signal.h>
+#endif
+
+#ifndef _@GUARD_PREFIX@_SYS_SELECT_H
+#define _@GUARD_PREFIX@_SYS_SELECT_H
+
+#if !@HAVE_SYS_SELECT_H@
+/* A platform that lacks <sys/select.h>. */
+/* Get the 'struct timeval' and 'fd_set' types and the FD_* macros
+ on most platforms. */
+# include <sys/time.h>
+/* On HP-UX 11, <sys/time.h> provides an FD_ZERO implementation
+ that relies on memset(), but without including <string.h>. */
+# if defined __hpux
+# include <string.h>
+# endif
+/* On native Windows platforms:
+ Get the 'fd_set' type.
+ Get the close() declaration before we override it. */
+# if @HAVE_WINSOCK2_H@
+# if !defined _GL_INCLUDING_WINSOCK2_H
+# define _GL_INCLUDING_WINSOCK2_H
+# include <winsock2.h>
+# undef _GL_INCLUDING_WINSOCK2_H
+# endif
+# include <io.h>
+# endif
+#endif
+
+/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
+
+/* The definition of _GL_WARN_ON_USE is copied here. */
+
+
+/* Fix some definitions from <winsock2.h>. */
+
+#if @HAVE_WINSOCK2_H@
+
+# if !GNULIB_defined_rpl_fd_isset
+
+/* Re-define FD_ISSET to avoid a WSA call while we are not using
+ network sockets. */
+static int
+rpl_fd_isset (SOCKET fd, fd_set * set)
+{
+ u_int i;
+ if (set == NULL)
+ return 0;
+
+ for (i = 0; i < set->fd_count; i++)
+ if (set->fd_array[i] == fd)
+ return 1;
+
+ return 0;
+}
+
+# define GNULIB_defined_rpl_fd_isset 1
+# endif
+
+# undef FD_ISSET
+# define FD_ISSET(fd, set) rpl_fd_isset(fd, set)
+
+#endif
+
+/* Hide some function declarations from <winsock2.h>. */
+
+#if @HAVE_WINSOCK2_H@
+# if !defined _@GUARD_PREFIX@_UNISTD_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef close
+# define close close_used_without_including_unistd_h
+# else
+ _GL_WARN_ON_USE (close,
+ "close() used without including <unistd.h>");
+# endif
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef gethostname
+# define gethostname gethostname_used_without_including_unistd_h
+# else
+ _GL_WARN_ON_USE (gethostname,
+ "gethostname() used without including <unistd.h>");
+# endif
+# endif
+# if !defined _@GUARD_PREFIX@_SYS_SOCKET_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef socket
+# define socket socket_used_without_including_sys_socket_h
+# undef connect
+# define connect connect_used_without_including_sys_socket_h
+# undef accept
+# define accept accept_used_without_including_sys_socket_h
+# undef bind
+# define bind bind_used_without_including_sys_socket_h
+# undef getpeername
+# define getpeername getpeername_used_without_including_sys_socket_h
+# undef getsockname
+# define getsockname getsockname_used_without_including_sys_socket_h
+# undef getsockopt
+# define getsockopt getsockopt_used_without_including_sys_socket_h
+# undef listen
+# define listen listen_used_without_including_sys_socket_h
+# undef recv
+# define recv recv_used_without_including_sys_socket_h
+# undef send
+# define send send_used_without_including_sys_socket_h
+# undef recvfrom
+# define recvfrom recvfrom_used_without_including_sys_socket_h
+# undef sendto
+# define sendto sendto_used_without_including_sys_socket_h
+# undef setsockopt
+# define setsockopt setsockopt_used_without_including_sys_socket_h
+# undef shutdown
+# define shutdown shutdown_used_without_including_sys_socket_h
+# else
+ _GL_WARN_ON_USE (socket,
+ "socket() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (connect,
+ "connect() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (accept,
+ "accept() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (bind,
+ "bind() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getpeername,
+ "getpeername() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getsockname,
+ "getsockname() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getsockopt,
+ "getsockopt() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (listen,
+ "listen() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (recv,
+ "recv() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (send,
+ "send() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (recvfrom,
+ "recvfrom() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (sendto,
+ "sendto() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (setsockopt,
+ "setsockopt() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (shutdown,
+ "shutdown() used without including <sys/socket.h>");
+# endif
+# endif
+#endif
+
+
+#if @GNULIB_PSELECT@
+# if @REPLACE_PSELECT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef pselect
+# define pselect rpl_pselect
+# endif
+_GL_FUNCDECL_RPL (pselect, int,
+ (int, fd_set *restrict, fd_set *restrict, fd_set *restrict,
+ struct timespec const *restrict, const sigset_t *restrict));
+_GL_CXXALIAS_RPL (pselect, int,
+ (int, fd_set *restrict, fd_set *restrict, fd_set *restrict,
+ struct timespec const *restrict, const sigset_t *restrict));
+# else
+# if !@HAVE_PSELECT@
+_GL_FUNCDECL_SYS (pselect, int,
+ (int, fd_set *restrict, fd_set *restrict, fd_set *restrict,
+ struct timespec const *restrict, const sigset_t *restrict));
+# endif
+_GL_CXXALIAS_SYS (pselect, int,
+ (int, fd_set *restrict, fd_set *restrict, fd_set *restrict,
+ struct timespec const *restrict, const sigset_t *restrict));
+# endif
+_GL_CXXALIASWARN (pselect);
+#elif defined GNULIB_POSIXCHECK
+# undef pselect
+# if HAVE_RAW_DECL_PSELECT
+_GL_WARN_ON_USE (pselect, "pselect is not portable - "
+ "use gnulib module pselect for portability");
+# endif
+#endif
+
+#if @GNULIB_SELECT@
+# if @REPLACE_SELECT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef select
+# define select rpl_select
+# endif
+_GL_FUNCDECL_RPL (select, int,
+ (int, fd_set *, fd_set *, fd_set *, struct timeval *));
+_GL_CXXALIAS_RPL (select, int,
+ (int, fd_set *, fd_set *, fd_set *, struct timeval *));
+# else
+_GL_CXXALIAS_SYS (select, int,
+ (int, fd_set *, fd_set *, fd_set *, struct timeval *));
+# endif
+_GL_CXXALIASWARN (select);
+#elif @HAVE_WINSOCK2_H@
+# undef select
+# define select select_used_without_requesting_gnulib_module_select
+#elif defined GNULIB_POSIXCHECK
+# undef select
+# if HAVE_RAW_DECL_SELECT
+_GL_WARN_ON_USE (select, "select is not always POSIX compliant - "
+ "use gnulib module select for portability");
+# endif
+#endif
+
+
+#endif /* _@GUARD_PREFIX@_SYS_SELECT_H */
+#endif /* _@GUARD_PREFIX@_SYS_SELECT_H */
+#endif /* OSF/1 */
diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h
index 77a7177ca64..2efc1e92e06 100644
--- a/lib/sys_stat.in.h
+++ b/lib/sys_stat.in.h
@@ -1,5 +1,5 @@
/* Provide a more complete sys/stat header file.
- Copyright (C) 2005-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2012 Free Software Foundation, Inc.
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
@@ -12,8 +12,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
/* Written by Eric Blake, Paul Eggert, and Jim Meyering. */
@@ -36,7 +35,8 @@
#ifndef _@GUARD_PREFIX@_SYS_STAT_H
-/* Get nlink_t. */
+/* Get nlink_t.
+ May also define off_t to a 64-bit type on native Windows. */
#include <sys/types.h>
/* Get struct timespec. */
@@ -62,6 +62,16 @@
# include <direct.h> /* mingw64, MSVC 9 */
#endif
+/* Native Windows platforms declare umask() in <io.h>. */
+#if 0 && ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__)
+# include <io.h>
+#endif
+
+/* Large File Support on native Windows. */
+#if @WINDOWS_64_BIT_ST_SIZE@
+# define stat _stati64
+#endif
+
#ifndef S_IFIFO
# ifdef _S_IFIFO
# define S_IFIFO _S_IFIFO
@@ -331,6 +341,9 @@ _GL_CXXALIAS_RPL (fstat, int, (int fd, struct stat *buf));
_GL_CXXALIAS_SYS (fstat, int, (int fd, struct stat *buf));
# endif
_GL_CXXALIASWARN (fstat);
+#elif @WINDOWS_64_BIT_ST_SIZE@
+/* Above, we define stat to _stati64. */
+# define fstat _fstati64
#elif defined GNULIB_POSIXCHECK
# undef fstat
# if HAVE_RAW_DECL_FSTAT
@@ -611,14 +624,55 @@ _GL_WARN_ON_USE (mknodat, "mknodat is not portable - "
/* We can't use the object-like #define stat rpl_stat, because of
struct stat. This means that rpl_stat will not be used if the user
does (stat)(a,b). Oh well. */
-# undef stat
-# ifdef _LARGE_FILES
+# if defined _AIX && defined stat && defined _LARGE_FILES
/* With _LARGE_FILES defined, AIX (only) defines stat to stat64,
so we have to replace stat64() instead of stat(). */
-# define stat stat64
# undef stat64
# define stat64(name, st) rpl_stat (name, st)
-# else /* !_LARGE_FILES */
+# elif @WINDOWS_64_BIT_ST_SIZE@
+ /* Above, we define stat to _stati64. */
+# if defined __MINGW32__ && defined _stati64
+# ifndef _USE_32BIT_TIME_T
+ /* The system headers define _stati64 to _stat64. */
+# undef _stat64
+# define _stat64(name, st) rpl_stat (name, st)
+# endif
+# elif defined _MSC_VER && defined _stati64
+# ifdef _USE_32BIT_TIME_T
+ /* The system headers define _stati64 to _stat32i64. */
+# undef _stat32i64
+# define _stat32i64(name, st) rpl_stat (name, st)
+# else
+ /* The system headers define _stati64 to _stat64. */
+# undef _stat64
+# define _stat64(name, st) rpl_stat (name, st)
+# endif
+# else
+# undef _stati64
+# define _stati64(name, st) rpl_stat (name, st)
+# endif
+# elif defined __MINGW32__ && defined stat
+# ifdef _USE_32BIT_TIME_T
+ /* The system headers define stat to _stat32i64. */
+# undef _stat32i64
+# define _stat32i64(name, st) rpl_stat (name, st)
+# else
+ /* The system headers define stat to _stat64. */
+# undef _stat64
+# define _stat64(name, st) rpl_stat (name, st)
+# endif
+# elif defined _MSC_VER && defined stat
+# ifdef _USE_32BIT_TIME_T
+ /* The system headers define stat to _stat32. */
+# undef _stat32
+# define _stat32(name, st) rpl_stat (name, st)
+# else
+ /* The system headers define stat to _stat64i32. */
+# undef _stat64i32
+# define _stat64i32(name, st) rpl_stat (name, st)
+# endif
+# else /* !(_AIX ||__MINGW32__ || _MSC_VER) */
+# undef stat
# define stat(name, st) rpl_stat (name, st)
# endif /* !_LARGE_FILES */
_GL_EXTERN_C int stat (const char *name, struct stat *buf)
diff --git a/lib/sys_time.in.h b/lib/sys_time.in.h
new file mode 100644
index 00000000000..d915cee467a
--- /dev/null
+++ b/lib/sys_time.in.h
@@ -0,0 +1,205 @@
+/* Provide a more complete sys/time.h.
+
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert. */
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+@PRAGMA_COLUMNS@
+
+#if defined _@GUARD_PREFIX@_SYS_TIME_H
+
+/* Simply delegate to the system's header, without adding anything. */
+# if @HAVE_SYS_TIME_H@
+# @INCLUDE_NEXT@ @NEXT_SYS_TIME_H@
+# endif
+
+#else
+
+# define _@GUARD_PREFIX@_SYS_TIME_H
+
+# if @HAVE_SYS_TIME_H@
+# @INCLUDE_NEXT@ @NEXT_SYS_TIME_H@
+# else
+# include <time.h>
+# endif
+
+/* On native Windows with MSVC, get the 'struct timeval' type.
+ Also, on native Windows with a 64-bit time_t, where we are overriding the
+ 'struct timeval' type, get all declarations of system functions whose
+ signature contains 'struct timeval'. */
+# if (defined _MSC_VER || @REPLACE_STRUCT_TIMEVAL@) && @HAVE_WINSOCK2_H@ && !defined _GL_INCLUDING_WINSOCK2_H
+# define _GL_INCLUDING_WINSOCK2_H
+# include <winsock2.h>
+# undef _GL_INCLUDING_WINSOCK2_H
+# endif
+
+/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
+
+/* The definition of _GL_ARG_NONNULL is copied here. */
+
+/* The definition of _GL_WARN_ON_USE is copied here. */
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+# if !@HAVE_STRUCT_TIMEVAL@ || @REPLACE_STRUCT_TIMEVAL@
+
+# if @REPLACE_STRUCT_TIMEVAL@
+# define timeval rpl_timeval
+# endif
+
+# if !GNULIB_defined_struct_timeval
+struct timeval
+{
+ time_t tv_sec;
+ long int tv_usec;
+};
+# define GNULIB_defined_struct_timeval 1
+# endif
+
+# endif
+
+# ifdef __cplusplus
+}
+# endif
+
+# if @GNULIB_GETTIMEOFDAY@
+# if @REPLACE_GETTIMEOFDAY@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef gettimeofday
+# define gettimeofday rpl_gettimeofday
+# endif
+_GL_FUNCDECL_RPL (gettimeofday, int,
+ (struct timeval *restrict, void *restrict)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (gettimeofday, int,
+ (struct timeval *restrict, void *restrict));
+# else
+# if !@HAVE_GETTIMEOFDAY@
+_GL_FUNCDECL_SYS (gettimeofday, int,
+ (struct timeval *restrict, void *restrict)
+ _GL_ARG_NONNULL ((1)));
+# endif
+/* Need to cast, because on glibc systems, by default, the second argument is
+ struct timezone *. */
+_GL_CXXALIAS_SYS_CAST (gettimeofday, int,
+ (struct timeval *restrict, void *restrict));
+# endif
+_GL_CXXALIASWARN (gettimeofday);
+# elif defined GNULIB_POSIXCHECK
+# undef gettimeofday
+# if HAVE_RAW_DECL_GETTIMEOFDAY
+_GL_WARN_ON_USE (gettimeofday, "gettimeofday is unportable - "
+ "use gnulib module gettimeofday for portability");
+# endif
+# endif
+
+/* Hide some function declarations from <winsock2.h>. */
+
+# if defined _MSC_VER && @HAVE_WINSOCK2_H@
+# if !defined _@GUARD_PREFIX@_UNISTD_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef close
+# define close close_used_without_including_unistd_h
+# else
+ _GL_WARN_ON_USE (close,
+ "close() used without including <unistd.h>");
+# endif
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef gethostname
+# define gethostname gethostname_used_without_including_unistd_h
+# else
+ _GL_WARN_ON_USE (gethostname,
+ "gethostname() used without including <unistd.h>");
+# endif
+# endif
+# if !defined _@GUARD_PREFIX@_SYS_SOCKET_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef socket
+# define socket socket_used_without_including_sys_socket_h
+# undef connect
+# define connect connect_used_without_including_sys_socket_h
+# undef accept
+# define accept accept_used_without_including_sys_socket_h
+# undef bind
+# define bind bind_used_without_including_sys_socket_h
+# undef getpeername
+# define getpeername getpeername_used_without_including_sys_socket_h
+# undef getsockname
+# define getsockname getsockname_used_without_including_sys_socket_h
+# undef getsockopt
+# define getsockopt getsockopt_used_without_including_sys_socket_h
+# undef listen
+# define listen listen_used_without_including_sys_socket_h
+# undef recv
+# define recv recv_used_without_including_sys_socket_h
+# undef send
+# define send send_used_without_including_sys_socket_h
+# undef recvfrom
+# define recvfrom recvfrom_used_without_including_sys_socket_h
+# undef sendto
+# define sendto sendto_used_without_including_sys_socket_h
+# undef setsockopt
+# define setsockopt setsockopt_used_without_including_sys_socket_h
+# undef shutdown
+# define shutdown shutdown_used_without_including_sys_socket_h
+# else
+ _GL_WARN_ON_USE (socket,
+ "socket() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (connect,
+ "connect() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (accept,
+ "accept() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (bind,
+ "bind() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getpeername,
+ "getpeername() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getsockname,
+ "getsockname() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getsockopt,
+ "getsockopt() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (listen,
+ "listen() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (recv,
+ "recv() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (send,
+ "send() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (recvfrom,
+ "recvfrom() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (sendto,
+ "sendto() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (setsockopt,
+ "setsockopt() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (shutdown,
+ "shutdown() used without including <sys/socket.h>");
+# endif
+# endif
+# if !defined _@GUARD_PREFIX@_SYS_SELECT_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef select
+# define select select_used_without_including_sys_select_h
+# else
+ _GL_WARN_ON_USE (select,
+ "select() used without including <sys/select.h>");
+# endif
+# endif
+# endif
+
+#endif /* _@GUARD_PREFIX@_SYS_TIME_H */
diff --git a/lib/sys_types.in.h b/lib/sys_types.in.h
new file mode 100644
index 00000000000..8139d98f6a6
--- /dev/null
+++ b/lib/sys_types.in.h
@@ -0,0 +1,51 @@
+/* Provide a more complete sys/types.h.
+
+ Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+@PRAGMA_COLUMNS@
+
+#ifndef _@GUARD_PREFIX@_SYS_TYPES_H
+
+/* The include_next requires a split double-inclusion guard. */
+#@INCLUDE_NEXT@ @NEXT_SYS_TYPES_H@
+
+#ifndef _@GUARD_PREFIX@_SYS_TYPES_H
+#define _@GUARD_PREFIX@_SYS_TYPES_H
+
+/* Override off_t if Large File Support is requested on native Windows. */
+#if @WINDOWS_64_BIT_OFF_T@
+/* Same as int64_t in <stdint.h>. */
+# if defined _MSC_VER
+# define off_t __int64
+# else
+# define off_t long long int
+# endif
+/* Indicator, for gnulib internal purposes. */
+# define _GL_WINDOWS_64_BIT_OFF_T 1
+#endif
+
+/* MSVC 9 defines size_t in <stddef.h>, not in <sys/types.h>. */
+/* But avoid namespace pollution on glibc systems. */
+#if ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__) \
+ && ! defined __GLIBC__
+# include <stddef.h>
+#endif
+
+#endif /* _@GUARD_PREFIX@_SYS_TYPES_H */
+#endif /* _@GUARD_PREFIX@_SYS_TYPES_H */
diff --git a/lib/time.in.h b/lib/time.in.h
index 1fbebf47beb..04cde057cf0 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -1,6 +1,6 @@
/* A more-standard <time.h>.
- Copyright (C) 2007-2011 Free Software Foundation, Inc.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
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
@@ -13,8 +13,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
diff --git a/lib/time_r.c b/lib/time_r.c
index 31d010e437b..74366a0f759 100644
--- a/lib/time_r.c
+++ b/lib/time_r.c
@@ -1,6 +1,6 @@
/* Reentrant time functions like localtime_r.
- Copyright (C) 2003, 2006-2007, 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2006-2007, 2010-2012 Free Software Foundation, Inc.
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
@@ -13,8 +13,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ with this program; if not, see <http://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/timespec-add.c b/lib/timespec-add.c
new file mode 100644
index 00000000000..4e5c641ac12
--- /dev/null
+++ b/lib/timespec-add.c
@@ -0,0 +1,71 @@
+/* Add two struct timespec values.
+
+ Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* Written by Paul Eggert. */
+
+/* Return the sum of two timespec values A and B. On overflow, return
+ an extremal value. This assumes 0 <= tv_nsec <= 999999999. */
+
+#include <config.h>
+#include "timespec.h"
+
+#include "intprops.h"
+
+struct timespec
+timespec_add (struct timespec a, struct timespec b)
+{
+ struct timespec r;
+ time_t rs = a.tv_sec;
+ time_t bs = b.tv_sec;
+ int ns = a.tv_nsec + b.tv_nsec;
+ int nsd = ns - 1000000000;
+ int rns = ns;
+
+ if (0 <= nsd)
+ {
+ rns = nsd;
+ if (rs == TYPE_MAXIMUM (time_t))
+ {
+ if (0 <= bs)
+ goto high_overflow;
+ bs++;
+ }
+ else
+ rs++;
+ }
+
+ if (INT_ADD_OVERFLOW (rs, bs))
+ {
+ if (rs < 0)
+ {
+ rs = TYPE_MINIMUM (time_t);
+ rns = 0;
+ }
+ else
+ {
+ high_overflow:
+ rs = TYPE_MAXIMUM (time_t);
+ rns = 999999999;
+ }
+ }
+ else
+ rs += bs;
+
+ r.tv_sec = rs;
+ r.tv_nsec = rns;
+ return r;
+}
diff --git a/lib/timespec-sub.c b/lib/timespec-sub.c
new file mode 100644
index 00000000000..7c4c781b7f6
--- /dev/null
+++ b/lib/timespec-sub.c
@@ -0,0 +1,71 @@
+/* Subtract two struct timespec values.
+
+ Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+/* Written by Paul Eggert. */
+
+/* Return the difference between two timespec values A and B. On
+ overflow, return an extremal value. This assumes 0 <= tv_nsec <=
+ 999999999. */
+
+#include <config.h>
+#include "timespec.h"
+
+#include "intprops.h"
+
+struct timespec
+timespec_sub (struct timespec a, struct timespec b)
+{
+ struct timespec r;
+ time_t rs = a.tv_sec;
+ time_t bs = b.tv_sec;
+ int ns = a.tv_nsec - b.tv_nsec;
+ int rns = ns;
+
+ if (ns < 0)
+ {
+ rns = ns + 1000000000;
+ if (rs == TYPE_MINIMUM (time_t))
+ {
+ if (bs <= 0)
+ goto low_overflow;
+ bs--;
+ }
+ else
+ rs--;
+ }
+
+ if (INT_SUBTRACT_OVERFLOW (rs, bs))
+ {
+ if (rs < 0)
+ {
+ low_overflow:
+ rs = TYPE_MINIMUM (time_t);
+ rns = 0;
+ }
+ else
+ {
+ rs = TYPE_MAXIMUM (time_t);
+ rns = 999999999;
+ }
+ }
+ else
+ rs -= bs;
+
+ r.tv_sec = rs;
+ r.tv_nsec = rns;
+ return r;
+}
diff --git a/lib/timespec.c b/lib/timespec.c
new file mode 100644
index 00000000000..2b6098ed7bd
--- /dev/null
+++ b/lib/timespec.c
@@ -0,0 +1,3 @@
+#include <config.h>
+#define _GL_TIMESPEC_INLINE _GL_EXTERN_INLINE
+#include "timespec.h"
diff --git a/lib/timespec.h b/lib/timespec.h
new file mode 100644
index 00000000000..d0a2194f61d
--- /dev/null
+++ b/lib/timespec.h
@@ -0,0 +1,92 @@
+/* timespec -- System time interface
+
+ Copyright (C) 2000, 2002, 2004-2005, 2007, 2009-2012 Free Software
+ Foundation, Inc.
+
+ 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/>. */
+
+#if ! defined TIMESPEC_H
+# define TIMESPEC_H
+
+# include <time.h>
+
+_GL_INLINE_HEADER_BEGIN
+#ifndef _GL_TIMESPEC_INLINE
+# define _GL_TIMESPEC_INLINE _GL_INLINE
+#endif
+
+/* Return negative, zero, positive if A < B, A == B, A > B, respectively.
+
+ For each time stamp T, this code assumes that either:
+
+ * T.tv_nsec is in the range 0..999999999; or
+ * T.tv_sec corresponds to a valid leap second on a host that supports
+ leap seconds, and T.tv_nsec is in the range 1000000000..1999999999; or
+ * T.tv_sec is the minimum time_t value and T.tv_nsec is -1; or
+ T.tv_sec is the maximum time_t value and T.tv_nsec is 2000000000.
+ This allows for special struct timespec values that are less or
+ greater than all possible valid time stamps.
+
+ In all these cases, it is safe to subtract two tv_nsec values and
+ convert the result to integer without worrying about overflow on
+ any platform of interest to the GNU project, since all such
+ platforms have 32-bit int or wider.
+
+ Replacing "(int) (a.tv_nsec - b.tv_nsec)" with something like
+ "a.tv_nsec < b.tv_nsec ? -1 : a.tv_nsec > b.tv_nsec" would cause
+ this function to work in some cases where the above assumption is
+ violated, but not in all cases (e.g., a.tv_sec==1, a.tv_nsec==-2,
+ b.tv_sec==0, b.tv_nsec==999999999) and is arguably not worth the
+ extra instructions. Using a subtraction has the advantage of
+ detecting some invalid cases on platforms that detect integer
+ overflow.
+
+ The (int) cast avoids a gcc -Wconversion warning. */
+
+_GL_TIMESPEC_INLINE int
+timespec_cmp (struct timespec a, struct timespec b)
+{
+ return (a.tv_sec < b.tv_sec ? -1
+ : a.tv_sec > b.tv_sec ? 1
+ : (int) (a.tv_nsec - b.tv_nsec));
+}
+
+/* Return -1, 0, 1, depending on the sign of A. A.tv_nsec must be
+ nonnegative. */
+_GL_TIMESPEC_INLINE int
+timespec_sign (struct timespec a)
+{
+ return a.tv_sec < 0 ? -1 : a.tv_sec || a.tv_nsec;
+}
+
+struct timespec timespec_add (struct timespec, struct timespec)
+ _GL_ATTRIBUTE_CONST;
+struct timespec timespec_sub (struct timespec, struct timespec)
+ _GL_ATTRIBUTE_CONST;
+struct timespec dtotimespec (double)
+ _GL_ATTRIBUTE_CONST;
+
+/* Return an approximation to A, of type 'double'. */
+_GL_TIMESPEC_INLINE double
+timespectod (struct timespec a)
+{
+ return a.tv_sec + a.tv_nsec / 1e9;
+}
+
+void gettime (struct timespec *);
+int settime (struct timespec const *);
+
+_GL_INLINE_HEADER_END
+
+#endif
diff --git a/lib/u64.c b/lib/u64.c
new file mode 100644
index 00000000000..04cf7a29946
--- /dev/null
+++ b/lib/u64.c
@@ -0,0 +1,3 @@
+#include <config.h>
+#define _GL_U64_INLINE _GL_EXTERN_INLINE
+#include "u64.h"
diff --git a/lib/u64.h b/lib/u64.h
index 182d64955aa..6a7d370c12b 100644
--- a/lib/u64.h
+++ b/lib/u64.h
@@ -1,6 +1,6 @@
/* uint64_t-like operations that work even on hosts lacking uint64_t
- Copyright (C) 2006, 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2009-2012 Free Software Foundation, Inc.
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
@@ -19,6 +19,11 @@
#include <stdint.h>
+_GL_INLINE_HEADER_BEGIN
+#ifndef _GL_U64_INLINE
+# define _GL_U64_INLINE _GL_INLINE
+#endif
+
/* Return X rotated left by N bits, where 0 < N < 64. */
#define u64rol(x, n) u64or (u64shl (x, n), u64shr (x, 64 - n))
@@ -30,6 +35,7 @@ typedef uint64_t u64;
# define u64hilo(hi, lo) ((u64) (((u64) (hi) << 32) + (lo)))
# define u64init(hi, lo) u64hilo (hi, lo)
# define u64lo(x) ((u64) (x))
+# define u64size(x) u64lo (x)
# define u64lt(x, y) ((x) < (y))
# define u64and(x, y) ((x) & (y))
# define u64or(x, y) ((x) | (y))
@@ -53,7 +59,7 @@ typedef struct { uint32_t lo, hi; } u64;
/* Given the high and low-order 32-bit quantities HI and LO, return a u64
value representing (HI << 32) + LO. */
-static inline u64
+_GL_U64_INLINE u64
u64hilo (uint32_t hi, uint32_t lo)
{
u64 r;
@@ -63,7 +69,7 @@ u64hilo (uint32_t hi, uint32_t lo)
}
/* Return a u64 value representing LO. */
-static inline u64
+_GL_U64_INLINE u64
u64lo (uint32_t lo)
{
u64 r;
@@ -72,15 +78,25 @@ u64lo (uint32_t lo)
return r;
}
+/* Return a u64 value representing SIZE. */
+_GL_U64_INLINE u64
+u64size (size_t size)
+{
+ u64 r;
+ r.hi = size >> 31 >> 1;
+ r.lo = size;
+ return r;
+}
+
/* Return X < Y. */
-static inline int
+_GL_U64_INLINE int
u64lt (u64 x, u64 y)
{
return x.hi < y.hi || (x.hi == y.hi && x.lo < y.lo);
}
/* Return X & Y. */
-static inline u64
+_GL_U64_INLINE u64
u64and (u64 x, u64 y)
{
u64 r;
@@ -90,7 +106,7 @@ u64and (u64 x, u64 y)
}
/* Return X | Y. */
-static inline u64
+_GL_U64_INLINE u64
u64or (u64 x, u64 y)
{
u64 r;
@@ -100,7 +116,7 @@ u64or (u64 x, u64 y)
}
/* Return X ^ Y. */
-static inline u64
+_GL_U64_INLINE u64
u64xor (u64 x, u64 y)
{
u64 r;
@@ -110,7 +126,7 @@ u64xor (u64 x, u64 y)
}
/* Return X + Y. */
-static inline u64
+_GL_U64_INLINE u64
u64plus (u64 x, u64 y)
{
u64 r;
@@ -120,7 +136,7 @@ u64plus (u64 x, u64 y)
}
/* Return X << N. */
-static inline u64
+_GL_U64_INLINE u64
u64shl (u64 x, int n)
{
u64 r;
@@ -138,7 +154,7 @@ u64shl (u64 x, int n)
}
/* Return X >> N. */
-static inline u64
+_GL_U64_INLINE u64
u64shr (u64 x, int n)
{
u64 r;
@@ -156,3 +172,5 @@ u64shr (u64 x, int n)
}
#endif
+
+_GL_INLINE_HEADER_END
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index 77e5675aad2..e904e512ee8 100644
--- a/lib/unistd.in.h
+++ b/lib/unistd.in.h
@@ -1,5 +1,5 @@
/* Substitute for and wrapper around <unistd.h>.
- Copyright (C) 2003-2011 Free Software Foundation, Inc.
+ Copyright (C) 2003-2012 Free Software Foundation, Inc.
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
@@ -12,8 +12,7 @@
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
@@ -84,12 +83,19 @@
#endif
/* Native Windows platforms declare chdir, getcwd, rmdir in
- <io.h> and/or <direct.h>, not in <unistd.h>. */
+ <io.h> and/or <direct.h>, not in <unistd.h>.
+ They also declare access(), chmod(), close(), dup(), dup2(), isatty(),
+ lseek(), read(), unlink(), write() in <io.h>. */
#if ((@GNULIB_CHDIR@ || @GNULIB_GETCWD@ || @GNULIB_RMDIR@ \
|| defined GNULIB_POSIXCHECK) \
&& ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__))
# include <io.h> /* mingw32, mingw64 */
# include <direct.h> /* mingw64, MSVC 9 */
+#elif (@GNULIB_CLOSE@ || @GNULIB_DUP@ || @GNULIB_DUP2@ || @GNULIB_ISATTY@ \
+ || @GNULIB_LSEEK@ || @GNULIB_READ@ || @GNULIB_UNLINK@ || @GNULIB_WRITE@ \
+ || defined GNULIB_POSIXCHECK) \
+ && ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__)
+# include <io.h>
#endif
/* AIX and OSF/1 5.1 declare getdomainname in <netdb.h>, not in <unistd.h>.
@@ -101,8 +107,9 @@
# include <netdb.h>
#endif
-/* MSVC defines off_t in <sys/types.h>. */
-#if !@HAVE_UNISTD_H@
+/* MSVC defines off_t in <sys/types.h>.
+ May also define off_t to a 64-bit type on native Windows. */
+#if !@HAVE_UNISTD_H@ || @WINDOWS_64_BIT_OFF_T@
/* Get off_t. */
# include <sys/types.h>
#endif
@@ -556,10 +563,19 @@ _GL_WARN_ON_USE (fsync, "fsync is unportable - "
Return 0 if successful, otherwise -1 and errno set.
See the POSIX:2008 specification
<http://pubs.opengroup.org/onlinepubs/9699919799/functions/ftruncate.html>. */
-# if !@HAVE_FTRUNCATE@
+# if @REPLACE_FTRUNCATE@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef ftruncate
+# define ftruncate rpl_ftruncate
+# endif
+_GL_FUNCDECL_RPL (ftruncate, int, (int fd, off_t length));
+_GL_CXXALIAS_RPL (ftruncate, int, (int fd, off_t length));
+# else
+# if !@HAVE_FTRUNCATE@
_GL_FUNCDECL_SYS (ftruncate, int, (int fd, off_t length));
-# endif
+# endif
_GL_CXXALIAS_SYS (ftruncate, int, (int fd, off_t length));
+# endif
_GL_CXXALIASWARN (ftruncate);
#elif defined GNULIB_POSIXCHECK
# undef ftruncate
@@ -935,6 +951,27 @@ _GL_WARN_ON_USE (group_member, "group_member is unportable - "
#endif
+#if @GNULIB_ISATTY@
+# if @REPLACE_ISATTY@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef isatty
+# define isatty rpl_isatty
+# endif
+_GL_FUNCDECL_RPL (isatty, int, (int fd));
+_GL_CXXALIAS_RPL (isatty, int, (int fd));
+# else
+_GL_CXXALIAS_SYS (isatty, int, (int fd));
+# endif
+_GL_CXXALIASWARN (isatty);
+#elif defined GNULIB_POSIXCHECK
+# undef isatty
+# if HAVE_RAW_DECL_ISATTY
+_GL_WARN_ON_USE (isatty, "isatty has portability problems on native Windows - "
+ "use gnulib module isatty for portability");
+# endif
+#endif
+
+
#if @GNULIB_LCHOWN@
/* Change the owner of FILE to UID (if UID is not -1) and the group of FILE
to GID (if GID is not -1). Do not follow symbolic links.
@@ -1268,6 +1305,33 @@ _GL_WARN_ON_USE (rmdir, "rmdir is unportable - "
#endif
+#if @GNULIB_SETHOSTNAME@
+/* Set the host name of the machine.
+ The host name may or may not be fully qualified.
+
+ Put LEN bytes of NAME into the host name.
+ Return 0 if successful, otherwise, set errno and return -1.
+
+ Platforms with no ability to set the hostname return -1 and set
+ errno = ENOSYS. */
+# if !@HAVE_SETHOSTNAME@ || !@HAVE_DECL_SETHOSTNAME@
+_GL_FUNCDECL_SYS (sethostname, int, (const char *name, size_t len)
+ _GL_ARG_NONNULL ((1)));
+# endif
+/* Need to cast, because on Solaris 11 2011-10, Mac OS X 10.5, IRIX 6.5
+ and FreeBSD 6.4 the second parameter is int. On Solaris 11
+ 2011-10, the first parameter is not const. */
+_GL_CXXALIAS_SYS_CAST (sethostname, int, (const char *name, size_t len));
+_GL_CXXALIASWARN (sethostname);
+#elif defined GNULIB_POSIXCHECK
+# undef sethostname
+# if HAVE_RAW_DECL_SETHOSTNAME
+_GL_WARN_ON_USE (sethostname, "sethostname is unportable - "
+ "use gnulib module sethostname for portability");
+# endif
+#endif
+
+
#if @GNULIB_SLEEP@
/* Pause the execution of the current thread for N seconds.
Returns the number of seconds left to sleep.
diff --git a/lib/utimens.c b/lib/utimens.c
new file mode 100644
index 00000000000..f06918cc23e
--- /dev/null
+++ b/lib/utimens.c
@@ -0,0 +1,534 @@
+/* Set file access and modification times.
+
+ Copyright (C) 2003-2012 Free Software Foundation, Inc.
+
+ 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 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/>. */
+
+/* Written by Paul Eggert. */
+
+/* derived from a function in touch.c */
+
+#include <config.h>
+
+#define _GL_UTIMENS_INLINE _GL_EXTERN_INLINE
+#include "utimens.h"
+
+#include <assert.h>
+#include <errno.h>
+#include <fcntl.h>
+#include <stdbool.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#include <unistd.h>
+
+#include "stat-time.h"
+#include "timespec.h"
+
+#if HAVE_UTIME_H
+# include <utime.h>
+#endif
+
+/* Some systems (even some that do have <utime.h>) don't declare this
+ structure anywhere. */
+#ifndef HAVE_STRUCT_UTIMBUF
+struct utimbuf
+{
+ long actime;
+ long modtime;
+};
+#endif
+
+/* Avoid recursion with rpl_futimens or rpl_utimensat. */
+#undef futimens
+#undef utimensat
+
+/* Solaris 9 mistakenly succeeds when given a non-directory with a
+ trailing slash. Force the use of rpl_stat for a fix. */
+#ifndef REPLACE_FUNC_STAT_FILE
+# define REPLACE_FUNC_STAT_FILE 0
+#endif
+
+#if HAVE_UTIMENSAT || HAVE_FUTIMENS
+/* Cache variables for whether the utimensat syscall works; used to
+ avoid calling the syscall if we know it will just fail with ENOSYS,
+ and to avoid unnecessary work in massaging timestamps if the
+ syscall will work. Multiple variables are needed, to distinguish
+ between the following scenarios on Linux:
+ utimensat doesn't exist, or is in glibc but kernel 2.6.18 fails with ENOSYS
+ kernel 2.6.22 and earlier rejects AT_SYMLINK_NOFOLLOW
+ kernel 2.6.25 and earlier reject UTIME_NOW/UTIME_OMIT with non-zero tv_sec
+ kernel 2.6.32 used with xfs or ntfs-3g fail to honor UTIME_OMIT
+ utimensat completely works
+ For each cache variable: 0 = unknown, 1 = yes, -1 = no. */
+static int utimensat_works_really;
+static int lutimensat_works_really;
+#endif /* HAVE_UTIMENSAT || HAVE_FUTIMENS */
+
+/* Validate the requested timestamps. Return 0 if the resulting
+ timespec can be used for utimensat (after possibly modifying it to
+ work around bugs in utimensat). Return a positive value if the
+ timespec needs further adjustment based on stat results: 1 if any
+ adjustment is needed for utimes, and 2 if any adjustment is needed
+ for Linux utimensat. Return -1, with errno set to EINVAL, if
+ timespec is out of range. */
+static int
+validate_timespec (struct timespec timespec[2])
+{
+ int result = 0;
+ int utime_omit_count = 0;
+ assert (timespec);
+ if ((timespec[0].tv_nsec != UTIME_NOW
+ && timespec[0].tv_nsec != UTIME_OMIT
+ && (timespec[0].tv_nsec < 0 || 1000000000 <= timespec[0].tv_nsec))
+ || (timespec[1].tv_nsec != UTIME_NOW
+ && timespec[1].tv_nsec != UTIME_OMIT
+ && (timespec[1].tv_nsec < 0 || 1000000000 <= timespec[1].tv_nsec)))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ /* Work around Linux kernel 2.6.25 bug, where utimensat fails with
+ EINVAL if tv_sec is not 0 when using the flag values of tv_nsec.
+ Flag a Linux kernel 2.6.32 bug, where an mtime of UTIME_OMIT
+ fails to bump ctime. */
+ if (timespec[0].tv_nsec == UTIME_NOW
+ || timespec[0].tv_nsec == UTIME_OMIT)
+ {
+ timespec[0].tv_sec = 0;
+ result = 1;
+ if (timespec[0].tv_nsec == UTIME_OMIT)
+ utime_omit_count++;
+ }
+ if (timespec[1].tv_nsec == UTIME_NOW
+ || timespec[1].tv_nsec == UTIME_OMIT)
+ {
+ timespec[1].tv_sec = 0;
+ result = 1;
+ if (timespec[1].tv_nsec == UTIME_OMIT)
+ utime_omit_count++;
+ }
+ return result + (utime_omit_count == 1);
+}
+
+/* Normalize any UTIME_NOW or UTIME_OMIT values in *TS, using stat
+ buffer STATBUF to obtain the current timestamps of the file. If
+ both times are UTIME_NOW, set *TS to NULL (as this can avoid some
+ permissions issues). If both times are UTIME_OMIT, return true
+ (nothing further beyond the prior collection of STATBUF is
+ necessary); otherwise return false. */
+static bool
+update_timespec (struct stat const *statbuf, struct timespec *ts[2])
+{
+ struct timespec *timespec = *ts;
+ if (timespec[0].tv_nsec == UTIME_OMIT
+ && timespec[1].tv_nsec == UTIME_OMIT)
+ return true;
+ if (timespec[0].tv_nsec == UTIME_NOW
+ && timespec[1].tv_nsec == UTIME_NOW)
+ {
+ *ts = NULL;
+ return false;
+ }
+
+ if (timespec[0].tv_nsec == UTIME_OMIT)
+ timespec[0] = get_stat_atime (statbuf);
+ else if (timespec[0].tv_nsec == UTIME_NOW)
+ gettime (&timespec[0]);
+
+ if (timespec[1].tv_nsec == UTIME_OMIT)
+ timespec[1] = get_stat_mtime (statbuf);
+ else if (timespec[1].tv_nsec == UTIME_NOW)
+ gettime (&timespec[1]);
+
+ return false;
+}
+
+/* Set the access and modification time stamps of FD (a.k.a. FILE) to be
+ TIMESPEC[0] and TIMESPEC[1], respectively.
+ FD must be either negative -- in which case it is ignored --
+ or a file descriptor that is open on FILE.
+ If FD is nonnegative, then FILE can be NULL, which means
+ use just futimes (or equivalent) instead of utimes (or equivalent),
+ and fail if on an old system without futimes (or equivalent).
+ If TIMESPEC is null, set the time stamps to the current time.
+ Return 0 on success, -1 (setting errno) on failure. */
+
+int
+fdutimens (int fd, char const *file, struct timespec const timespec[2])
+{
+ struct timespec adjusted_timespec[2];
+ struct timespec *ts = timespec ? adjusted_timespec : NULL;
+ int adjustment_needed = 0;
+ struct stat st;
+
+ if (ts)
+ {
+ adjusted_timespec[0] = timespec[0];
+ adjusted_timespec[1] = timespec[1];
+ adjustment_needed = validate_timespec (ts);
+ }
+ if (adjustment_needed < 0)
+ return -1;
+
+ /* Require that at least one of FD or FILE are potentially valid, to avoid
+ a Linux bug where futimens (AT_FDCWD, NULL) changes "." rather
+ than failing. */
+ if (fd < 0 && !file)
+ {
+ errno = EBADF;
+ return -1;
+ }
+
+ /* Some Linux-based NFS clients are buggy, and mishandle time stamps
+ of files in NFS file systems in some cases. We have no
+ configure-time test for this, but please see
+ <http://bugs.gentoo.org/show_bug.cgi?id=132673> for references to
+ some of the problems with Linux 2.6.16. If this affects you,
+ compile with -DHAVE_BUGGY_NFS_TIME_STAMPS; this is reported to
+ help in some cases, albeit at a cost in performance. But you
+ really should upgrade your kernel to a fixed version, since the
+ problem affects many applications. */
+
+#if HAVE_BUGGY_NFS_TIME_STAMPS
+ if (fd < 0)
+ sync ();
+ else
+ fsync (fd);
+#endif
+
+ /* POSIX 2008 added two interfaces to set file timestamps with
+ nanosecond resolution; newer Linux implements both functions via
+ a single syscall. We provide a fallback for ENOSYS (for example,
+ compiling against Linux 2.6.25 kernel headers and glibc 2.7, but
+ running on Linux 2.6.18 kernel). */
+#if HAVE_UTIMENSAT || HAVE_FUTIMENS
+ if (0 <= utimensat_works_really)
+ {
+ int result;
+# if __linux__
+ /* As recently as Linux kernel 2.6.32 (Dec 2009), several file
+ systems (xfs, ntfs-3g) have bugs with a single UTIME_OMIT,
+ but work if both times are either explicitly specified or
+ UTIME_NOW. Work around it with a preparatory [f]stat prior
+ to calling futimens/utimensat; fortunately, there is not much
+ timing impact due to the extra syscall even on file systems
+ where UTIME_OMIT would have worked. FIXME: Simplify this in
+ 2012, when file system bugs are no longer common. */
+ if (adjustment_needed == 2)
+ {
+ if (fd < 0 ? stat (file, &st) : fstat (fd, &st))
+ return -1;
+ if (ts[0].tv_nsec == UTIME_OMIT)
+ ts[0] = get_stat_atime (&st);
+ else if (ts[1].tv_nsec == UTIME_OMIT)
+ ts[1] = get_stat_mtime (&st);
+ /* Note that st is good, in case utimensat gives ENOSYS. */
+ adjustment_needed++;
+ }
+# endif /* __linux__ */
+# if HAVE_UTIMENSAT
+ if (fd < 0)
+ {
+ result = utimensat (AT_FDCWD, file, ts, 0);
+# ifdef __linux__
+ /* Work around a kernel bug:
+ http://bugzilla.redhat.com/442352
+ http://bugzilla.redhat.com/449910
+ It appears that utimensat can mistakenly return 280 rather
+ than -1 upon ENOSYS failure.
+ FIXME: remove in 2010 or whenever the offending kernels
+ are no longer in common use. */
+ if (0 < result)
+ errno = ENOSYS;
+# endif /* __linux__ */
+ if (result == 0 || errno != ENOSYS)
+ {
+ utimensat_works_really = 1;
+ return result;
+ }
+ }
+# endif /* HAVE_UTIMENSAT */
+# if HAVE_FUTIMENS
+ if (0 <= fd)
+ {
+ result = futimens (fd, ts);
+# ifdef __linux__
+ /* Work around the same bug as above. */
+ if (0 < result)
+ errno = ENOSYS;
+# endif /* __linux__ */
+ if (result == 0 || errno != ENOSYS)
+ {
+ utimensat_works_really = 1;
+ return result;
+ }
+ }
+# endif /* HAVE_FUTIMENS */
+ }
+ utimensat_works_really = -1;
+ lutimensat_works_really = -1;
+#endif /* HAVE_UTIMENSAT || HAVE_FUTIMENS */
+
+ /* The platform lacks an interface to set file timestamps with
+ nanosecond resolution, so do the best we can, discarding any
+ fractional part of the timestamp. */
+
+ if (adjustment_needed || (REPLACE_FUNC_STAT_FILE && fd < 0))
+ {
+ if (adjustment_needed != 3
+ && (fd < 0 ? stat (file, &st) : fstat (fd, &st)))
+ return -1;
+ if (ts && update_timespec (&st, &ts))
+ return 0;
+ }
+
+ {
+#if HAVE_FUTIMESAT || HAVE_WORKING_UTIMES
+ struct timeval timeval[2];
+ struct timeval *t;
+ if (ts)
+ {
+ timeval[0].tv_sec = ts[0].tv_sec;
+ timeval[0].tv_usec = ts[0].tv_nsec / 1000;
+ timeval[1].tv_sec = ts[1].tv_sec;
+ timeval[1].tv_usec = ts[1].tv_nsec / 1000;
+ t = timeval;
+ }
+ else
+ t = NULL;
+
+ if (fd < 0)
+ {
+# if HAVE_FUTIMESAT
+ return futimesat (AT_FDCWD, file, t);
+# endif
+ }
+ else
+ {
+ /* If futimesat or futimes fails here, don't try to speed things
+ up by returning right away. glibc can incorrectly fail with
+ errno == ENOENT if /proc isn't mounted. Also, Mandrake 10.0
+ in high security mode doesn't allow ordinary users to read
+ /proc/self, so glibc incorrectly fails with errno == EACCES.
+ If errno == EIO, EPERM, or EROFS, it's probably safe to fail
+ right away, but these cases are rare enough that they're not
+ worth optimizing, and who knows what other messed-up systems
+ are out there? So play it safe and fall back on the code
+ below. */
+
+# if (HAVE_FUTIMESAT && !FUTIMESAT_NULL_BUG) || HAVE_FUTIMES
+# if HAVE_FUTIMESAT && !FUTIMESAT_NULL_BUG
+# undef futimes
+# define futimes(fd, t) futimesat (fd, NULL, t)
+# endif
+ if (futimes (fd, t) == 0)
+ {
+# if __linux__ && __GLIBC__
+ /* Work around a longstanding glibc bug, still present as
+ of 2010-12-27. On older Linux kernels that lack both
+ utimensat and utimes, glibc's futimes rounds instead of
+ truncating when falling back on utime. The same bug
+ occurs in futimesat with a null 2nd arg. */
+ if (t)
+ {
+ bool abig = 500000 <= t[0].tv_usec;
+ bool mbig = 500000 <= t[1].tv_usec;
+ if ((abig | mbig) && fstat (fd, &st) == 0)
+ {
+ /* If these two subtractions overflow, they'll
+ track the overflows inside the buggy glibc. */
+ time_t adiff = st.st_atime - t[0].tv_sec;
+ time_t mdiff = st.st_mtime - t[1].tv_sec;
+
+ struct timeval *tt = NULL;
+ struct timeval truncated_timeval[2];
+ truncated_timeval[0] = t[0];
+ truncated_timeval[1] = t[1];
+ if (abig && adiff == 1 && get_stat_atime_ns (&st) == 0)
+ {
+ tt = truncated_timeval;
+ tt[0].tv_usec = 0;
+ }
+ if (mbig && mdiff == 1 && get_stat_mtime_ns (&st) == 0)
+ {
+ tt = truncated_timeval;
+ tt[1].tv_usec = 0;
+ }
+ if (tt)
+ futimes (fd, tt);
+ }
+ }
+# endif
+
+ return 0;
+ }
+# endif
+ }
+#endif /* HAVE_FUTIMESAT || HAVE_WORKING_UTIMES */
+
+ if (!file)
+ {
+#if ! ((HAVE_FUTIMESAT && !FUTIMESAT_NULL_BUG) \
+ || (HAVE_WORKING_UTIMES && HAVE_FUTIMES))
+ errno = ENOSYS;
+#endif
+ return -1;
+ }
+
+#if HAVE_WORKING_UTIMES
+ return utimes (file, t);
+#else
+ {
+ struct utimbuf utimbuf;
+ struct utimbuf *ut;
+ if (ts)
+ {
+ utimbuf.actime = ts[0].tv_sec;
+ utimbuf.modtime = ts[1].tv_sec;
+ ut = &utimbuf;
+ }
+ else
+ ut = NULL;
+
+ return utime (file, ut);
+ }
+#endif /* !HAVE_WORKING_UTIMES */
+ }
+}
+
+/* Set the access and modification time stamps of FILE to be
+ TIMESPEC[0] and TIMESPEC[1], respectively. */
+int
+utimens (char const *file, struct timespec const timespec[2])
+{
+ return fdutimens (-1, file, timespec);
+}
+
+/* Set the access and modification time stamps of FILE to be
+ TIMESPEC[0] and TIMESPEC[1], respectively, without dereferencing
+ symlinks. Fail with ENOSYS if the platform does not support
+ changing symlink timestamps, but FILE was a symlink. */
+int
+lutimens (char const *file, struct timespec const timespec[2])
+{
+ struct timespec adjusted_timespec[2];
+ struct timespec *ts = timespec ? adjusted_timespec : NULL;
+ int adjustment_needed = 0;
+ struct stat st;
+
+ if (ts)
+ {
+ adjusted_timespec[0] = timespec[0];
+ adjusted_timespec[1] = timespec[1];
+ adjustment_needed = validate_timespec (ts);
+ }
+ if (adjustment_needed < 0)
+ return -1;
+
+ /* The Linux kernel did not support symlink timestamps until
+ utimensat, in version 2.6.22, so we don't need to mimic
+ fdutimens' worry about buggy NFS clients. But we do have to
+ worry about bogus return values. */
+
+#if HAVE_UTIMENSAT
+ if (0 <= lutimensat_works_really)
+ {
+ int result;
+# if __linux__
+ /* As recently as Linux kernel 2.6.32 (Dec 2009), several file
+ systems (xfs, ntfs-3g) have bugs with a single UTIME_OMIT,
+ but work if both times are either explicitly specified or
+ UTIME_NOW. Work around it with a preparatory lstat prior to
+ calling utimensat; fortunately, there is not much timing
+ impact due to the extra syscall even on file systems where
+ UTIME_OMIT would have worked. FIXME: Simplify this in 2012,
+ when file system bugs are no longer common. */
+ if (adjustment_needed == 2)
+ {
+ if (lstat (file, &st))
+ return -1;
+ if (ts[0].tv_nsec == UTIME_OMIT)
+ ts[0] = get_stat_atime (&st);
+ else if (ts[1].tv_nsec == UTIME_OMIT)
+ ts[1] = get_stat_mtime (&st);
+ /* Note that st is good, in case utimensat gives ENOSYS. */
+ adjustment_needed++;
+ }
+# endif /* __linux__ */
+ result = utimensat (AT_FDCWD, file, ts, AT_SYMLINK_NOFOLLOW);
+# ifdef __linux__
+ /* Work around a kernel bug:
+ http://bugzilla.redhat.com/442352
+ http://bugzilla.redhat.com/449910
+ It appears that utimensat can mistakenly return 280 rather
+ than -1 upon ENOSYS failure.
+ FIXME: remove in 2010 or whenever the offending kernels
+ are no longer in common use. */
+ if (0 < result)
+ errno = ENOSYS;
+# endif
+ if (result == 0 || errno != ENOSYS)
+ {
+ utimensat_works_really = 1;
+ lutimensat_works_really = 1;
+ return result;
+ }
+ }
+ lutimensat_works_really = -1;
+#endif /* HAVE_UTIMENSAT */
+
+ /* The platform lacks an interface to set file timestamps with
+ nanosecond resolution, so do the best we can, discarding any
+ fractional part of the timestamp. */
+
+ if (adjustment_needed || REPLACE_FUNC_STAT_FILE)
+ {
+ if (adjustment_needed != 3 && lstat (file, &st))
+ return -1;
+ if (ts && update_timespec (&st, &ts))
+ return 0;
+ }
+
+ /* On Linux, lutimes is a thin wrapper around utimensat, so there is
+ no point trying lutimes if utimensat failed with ENOSYS. */
+#if HAVE_LUTIMES && !HAVE_UTIMENSAT
+ {
+ struct timeval timeval[2];
+ struct timeval *t;
+ int result;
+ if (ts)
+ {
+ timeval[0].tv_sec = ts[0].tv_sec;
+ timeval[0].tv_usec = ts[0].tv_nsec / 1000;
+ timeval[1].tv_sec = ts[1].tv_sec;
+ timeval[1].tv_usec = ts[1].tv_nsec / 1000;
+ t = timeval;
+ }
+ else
+ t = NULL;
+
+ result = lutimes (file, t);
+ if (result == 0 || errno != ENOSYS)
+ return result;
+ }
+#endif /* HAVE_LUTIMES && !HAVE_UTIMENSAT */
+
+ /* Out of luck for symlinks, but we still handle regular files. */
+ if (!(adjustment_needed || REPLACE_FUNC_STAT_FILE) && lstat (file, &st))
+ return -1;
+ if (!S_ISLNK (st.st_mode))
+ return fdutimens (-1, file, ts);
+ errno = ENOSYS;
+ return -1;
+}
diff --git a/lib/utimens.h b/lib/utimens.h
new file mode 100644
index 00000000000..f765d102b77
--- /dev/null
+++ b/lib/utimens.h
@@ -0,0 +1,46 @@
+/* Set file access and modification times.
+
+ Copyright 2012 Free Software Foundation, Inc.
+
+ 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 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/>. */
+
+/* Written by Paul Eggert. */
+
+#include <time.h>
+int fdutimens (int, char const *, struct timespec const [2]);
+int utimens (char const *, struct timespec const [2]);
+int lutimens (char const *, struct timespec const [2]);
+
+#if GNULIB_FDUTIMENSAT
+# include <fcntl.h>
+# include <sys/stat.h>
+
+_GL_INLINE_HEADER_BEGIN
+#ifndef _GL_UTIMENS_INLINE
+# define _GL_UTIMENS_INLINE _GL_INLINE
+#endif
+
+int fdutimensat (int fd, int dir, char const *name, struct timespec const [2],
+ int atflag);
+
+/* Using this function makes application code slightly more readable. */
+_GL_UTIMENS_INLINE int
+lutimensat (int dir, char const *file, struct timespec const times[2])
+{
+ return utimensat (dir, file, times, AT_SYMLINK_NOFOLLOW);
+}
+
+_GL_INLINE_HEADER_END
+
+#endif
diff --git a/lib/verify.h b/lib/verify.h
index 9a8caad001d..0c320b19ad4 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -1,6 +1,6 @@
/* Compile-time assert-like macros.
- Copyright (C) 2005-2006, 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2009-2012 Free Software Foundation, Inc.
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
@@ -21,13 +21,11 @@
# define _GL_VERIFY_H
-/* Define _GL_HAVE__STATIC_ASSERT to 1 if _Static_assert works as per the
- C1X draft N1548 section 6.7.10. This is supported by GCC 4.6.0 and
- later, in C mode, and its use here generates easier-to-read diagnostics
- when verify (R) fails.
+/* Define _GL_HAVE__STATIC_ASSERT to 1 if _Static_assert works as per C11.
+ This is supported by GCC 4.6.0 and later, in C mode, and its use
+ here generates easier-to-read diagnostics when verify (R) fails.
- Define _GL_HAVE_STATIC_ASSERT to 1 if static_assert works as per the
- C++0X draft N3242 section 7.(4).
+ Define _GL_HAVE_STATIC_ASSERT to 1 if static_assert works as per C++11.
This will likely be supported by future GCC versions, in C++ mode.
Use this only with GCC. If we were willing to slow 'configure'
@@ -127,7 +125,7 @@
extern int (*dummy (void)) [sizeof (struct {...})];
* GCC warns about duplicate declarations of the dummy function if
- -Wredundant_decls is used. GCC 4.3 and later have a builtin
+ -Wredundant-decls is used. GCC 4.3 and later have a builtin
__COUNTER__ macro that can let us generate unique identifiers for
each dummy function, to suppress this warning.
@@ -135,6 +133,10 @@
which do not support _Static_assert, also do not warn about the
last declaration mentioned above.
+ * GCC warns if -Wnested-externs is enabled and verify() is used
+ within a function body; but inside a function, you can always
+ arrange to use verify_expr() instead.
+
* In C++, any struct definition inside sizeof is invalid.
Use a template type to work around the problem. */
@@ -188,7 +190,7 @@ template <int w>
trailing ';'. If R is false, fail at compile-time, preferably
with a diagnostic that includes the string-literal DIAGNOSTIC.
- Unfortunately, unlike C1X, this implementation must appear as an
+ Unfortunately, unlike C11, this implementation must appear as an
ordinary declaration, and cannot appear inside struct { ... }. */
# ifdef _GL_HAVE__STATIC_ASSERT
@@ -205,7 +207,7 @@ template <int w>
# define _Static_assert(R, DIAGNOSTIC) _GL_VERIFY (R, DIAGNOSTIC)
# endif
# if !defined _GL_HAVE_STATIC_ASSERT && !defined static_assert
-# define static_assert _Static_assert /* Draft C1X requires this #define. */
+# define static_assert _Static_assert /* C11 requires this #define. */
# endif
# endif
diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h
new file mode 100644
index 00000000000..ad777d8dd79
--- /dev/null
+++ b/lib/xalloc-oversized.h
@@ -0,0 +1,38 @@
+/* xalloc-oversized.h -- memory allocation size checking
+
+ Copyright (C) 1990-2000, 2003-2004, 2006-2012 Free Software Foundation, Inc.
+
+ 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/>. */
+
+#ifndef XALLOC_OVERSIZED_H_
+# define XALLOC_OVERSIZED_H_
+
+# include <stddef.h>
+
+/* Return 1 if an array of N objects, each of size S, cannot exist due
+ to size arithmetic overflow. S must be positive and N must be
+ nonnegative. This is a macro, not a function, so that it
+ works correctly even when SIZE_MAX < N.
+
+ By gnulib convention, SIZE_MAX represents overflow in size
+ calculations, so the conservative dividend to use here is
+ SIZE_MAX - 1, since SIZE_MAX might represent an overflowed value.
+ However, malloc (SIZE_MAX) fails on all known hosts where
+ sizeof (ptrdiff_t) <= sizeof (size_t), so do not bother to test for
+ exactly-SIZE_MAX allocations on such hosts; this avoids a test and
+ branch when S is known to be 1. */
+# define xalloc_oversized(n, s) \
+ ((size_t) (sizeof (ptrdiff_t) <= sizeof (size_t) ? -1 : -2) / (s) < (n))
+
+#endif /* !XALLOC_OVERSIZED_H_ */
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f5b3c92f8c2..37291cfa774 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11983 @@
+2012-11-24 Jan Djärv <jan.h.d@swipnet.se>
+
+ * term/ns-win.el (ns-initialize-window-system): Move creation of
+ fontsets here (Bug#11964).
+
+2012-11-24 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el (ses-rename-cell): Correct bug on mode-line update after
+ cell renaming.
+
+2012-11-24 Chong Yidong <cyd@gnu.org>
+
+ * woman.el (woman-default-faces, woman-monochrome-faces): Mark as
+ obsolete.
+
+ * custom.el (custom-theme-set-variables): Use a topological sort
+ for ordering by custom dependencies (Bug#12952).
+ (custom--sort-vars, custom--sort-vars-1): New functions.
+
+2012-11-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (byte-compile-file): Setup default value for
+ lexical-binding (bug#12938).
+
+2012-11-24 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * image-mode.el (image-transform-check-size): Use assertions only
+ for images of type imagemagick.
+
+ Otherwise no error, image-transform-fit-to-{width,height} is
+ silently ignored, as before. Doc fix.
+
+2012-11-24 Chong Yidong <cyd@gnu.org>
+
+ * faces.el (color-defined-p): Doc fix (Bug#12853).
+
+2012-11-24 Juri Linkov <juri@jurta.org>
+
+ * dired.el (dired-mark): Add optional arg `interactive'.
+ Check for `use-region-p' if `interactive' is non-nil.
+ (dired-unmark, dired-flag-file-deletion): Add optional arg
+ `interactive'. Call `dired-mark' with the arg `interactive'.
+ (Bug#10624)
+
+ * wdired.el: Revert 2012-10-17 change partly and replace it with
+ Patch by Christopher Schmidt <christopher@ch.ristopher.com>.
+ (wdired-finish-edit): Add marks for new file names to
+ `wdired-old-marks'. Restore marks using `dired-mark-remembered'
+ after `revert-buffer'.
+ (wdired-do-renames): Remove calls to `dired-remove-file',
+ `dired-add-file', `dired-add-entry'. (Bug#11795)
+
+2012-11-24 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-defs.el (c-version): Bump to 5.32.4.
+
+ Fix bugs in the state cache. Enhance a debugging mechanism.
+ * progmodes/cc-engine.el (c-parse-state-get-strategy): Don't use
+ "brace at column zero" strategy for C++.
+ (c-append-lower-brace-pair-to-state-cache): Repair algorithm.
+ (c-parse-state-point): New variable.
+ (c-record-parse-state-state): Record old parse state with
+ `copy-tree'. Record previous value of point.
+ (c-debug-parse-state-double-cons): New debugging function.
+ (c-debug-parse-state): Call the above new function.
+ (c-toggle-parse-state-debug): Output a confirmatory message.
+
+ * progmodes/cc-mode.el (c-before-change, c-after-change):
+ Call c-invalidate-state-cache from `c-before-change' instead of
+ `c-after-change'.
+
+2012-11-23 Chong Yidong <cyd@gnu.org>
+
+ * find-cmd.el (find-constituents): Add executable, ipath,
+ readable, samefile, writable, daystart, regextype (Bug#12856).
+
+2012-11-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/ert.el, emacs-lisp/ert-x.el: Use cl-lib and lexical-binding.
+
+2012-11-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * calc/calc.el (calc-gregorian-switch): Move to after calc-refresh
+ definition. This fixes a bootstrap failure.
+ (calc-gregorian-switch): In menu, put dates before regions.
+ This is easier to follow, lines up better in the menu, and lets us
+ coalesce regions that switch at the same time. Give country
+ names, not "Vatican", as that's better for non-expert users.
+ Use names that are stable between the date of switch and now, e.g.,
+ Bohemia and Moravia (which existed then and now) and not
+ Czechoslovakia (which didn't exist then and doesn't exist now).
+ What is now the U.S. mostly did not switch at the same time as
+ Britain, so omit the U.S. Correct spelling of "Britain".
+ Catholic Switzerland was too much of a mess, so omit it.
+
+2012-11-22 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc.el (calc-gregorian-switch): Refresh the Calc buffer
+ after the variable is changed.
+
+2012-11-21 Daniel Colascione <dancol@dancol.org>
+
+ * progmodes/sql.el (sql-mode-font-lock-object-name): Support IF NOT EXISTS
+ in SQL declarations for font-lock.
+ (sql-imenu-generic-expression): Teach imenu about IF NOT EXISTS.
+
+2012-11-21 Glenn Morris <rgm@gnu.org>
+
+ * faces.el (face-underline-p, face-inverse-video-p, face-bold-p)
+ (face-italic-p): Add optional argument "inherit".
+
+ * faces.el (set-face-inverse-video, set-face-bold, set-face-italic):
+ Remove -p suffix from names, for consistency with other set-face-*.
+ (set-face-inverse-video): Fix interactive spec.
+ * play/gamegrid.el (gamegrid-make-mono-tty-face):
+ * textmodes/table.el (table--update-cell-face):
+ Use set-face-inverse-video rather than now obsolete alias.
+
+2012-11-21 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (line-move): Don't call line-move-partial if
+ scroll-conservatively is in effect. (Bug#12927)
+
+2012-11-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eshell/em-cmpl.el (eshell-pcomplete): Refine fix for bug#12838:
+ Fallback on completion-at-point rather than
+ pcomplete-expand-and-complete, and only if pcomplete actually failed.
+ (eshell-cmpl-initialize): Setup completion-at-point.
+
+ * pcomplete.el (pcomplete--entries): Obey pcomplete-ignore-case.
+
+ * emacs-lisp/ert.el (ert--expand-should-1): Adapt to cl-lib.
+
+2012-11-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-do-copy-or-rename-file): If both files
+ are remote, check out-of-band property for both.
+
+2012-11-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * window.el (switch-to-buffer): Re-add the warning that was lost in the
+ code rewrite.
+
+2012-11-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ More minor time fixes.
+ * calendar/time-date.el: Commentary fix.
+ * net/tramp-sh.el (tramp-do-file-attributes-with-ls): Undo last change;
+ too much other code depends on (0 0) time stamps.
+ * net/tramp.el (tramp-time-less-p, tramp-time-subtract):
+ Add a couple of FIXME comments.
+
+ Minor cleanup for times as lists of four integers.
+ * files.el (dir-locals-directory-cache):
+ * ps-bdf.el (bdf-file-mod-time, bdf-read-font-info):
+ Doc fixes.
+ * net/tramp-sh.el (tramp-do-file-attributes-with-ls):
+ * ps-bdf.el (bdf-file-newer-than-time):
+ Process four-integers time stamps, not two. Doc fixes.
+
+2012-11-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * uniquify.el (uniquify-managed): Use defvar-local.
+ (rename-buffer, create-file-buffer): Advise with advice-add.
+ (uniquify-unload-function): Unadvise accordingly.
+
+ * emacs-lisp/trace.el: Rewrite, use nadvice and lexical-binding.
+ (trace-buffer): Don't purecopy.
+ (trace-entry-message, trace-exit-message): Add `context' arg.
+ (trace--timer): New var.
+ (trace-make-advice): Adjust for use in nadvice.
+ Add `context' argument. Delay `display-buffer' via a timer.
+ (trace-function-internal): Use advice-add.
+ (trace--read-args): New function.
+ (trace-function-foreground, trace-function-background): Use it.
+ (trace-function): Rename to trace-function-foreground and redefine as
+ an alias to that new name.
+ (untrace-function, untrace-all): Adjust to the use of nadvice.
+
+ * emacs-lisp/bytecomp.el (byte-compile): Fix handling of closures.
+
+ * emacs-lisp/byte-run.el (defun-declarations-alist): Fix last change.
+
+ * subr.el (called-interactively-p-functions): New var.
+ (internal--called-interactively-p--get-frame): New macro.
+ (called-interactively-p, interactive-p): Rewrite in Lisp.
+ * emacs-lisp/nadvice.el (advice--called-interactively-skip): New fun.
+ (called-interactively-p-functions): Use it.
+ * emacs-lisp/edebug.el (edebug--called-interactively-skip): New fun.
+ (called-interactively-p-functions): Use it.
+ * allout.el (allout-called-interactively-p): Don't assume
+ called-interactively-p is a subr.
+
+2012-11-20 Glenn Morris <rgm@gnu.org>
+
+ * profiler.el (profiler-report-mode-map): Add a menu.
+ No need to bind `q' because we derive from special-mode.
+ (profiler-report-find-entry): Handle calls from the menu-bar.
+
+2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/byte-run.el (defun-declarations-alist):
+ Allow a compiler-macro to be a lambda expression.
+
+ * progmodes/python.el: Use cl-lib. Move var declarations outside of
+ eval-when-compile.
+ (python-syntax-context): Add compiler-macro.
+ (python-font-lock-keywords): Simplify with De Morgan.
+
+ * vc/diff-mode.el (diff-hunk): Don't make useless timers.
+
+ * files.el (load-file): Require match in minibuffer selection, as was
+ the case in Emacs-20 before we changed the spec to allow .elc files
+ (bug#12935).
+
+ * json.el: Don't require cl since we don't use it.
+ * color.el: Don't require cl.
+ (color-complement): `caddr' -> `nth 2'.
+
+ * calendar/time-date.el (time-to-seconds): De-obsolete.
+
+2012-11-19 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-forms.el (math-leap-year-p): Fix formula for negative
+ year numbers.
+ (math-date-to-julian-dt): Adjust the initial approximation for the
+ year to deal with the new definition of the DATE.
+
+2012-11-19 Daniel Colascione <dancol@dancol.org>
+
+ * term/w32-win.el (cygwin-convert-path-from-windows):
+ Accomodate rename of cygwin_convert_path* to cygwin_convert_file_name*.
+
+2012-11-18 Chong Yidong <cyd@gnu.org>
+
+ * filecache.el (file-cache--read-list): New function.
+ (file-cache-add-directory-list, file-cache-add-file-list)
+ (file-cache-delete-file-list, file-cache-delete-directory-list):
+ Use it to read a list of files or directories (Bug#12846).
+ (file-cache-add-file, file-cache-add-directory)
+ (file-cache-delete-file-list, file-cache-delete-file-regexp)
+ (file-cache-delete-directory): Print an message.
+
+2012-11-18 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-forms.el (math-date-to-dt): Use integer date when
+ calling `math-date-to-julian-dt' and 'math-date-to-gregorian-dt'.
+
+2012-11-18 Glenn Morris <rgm@gnu.org>
+
+ * image.el (insert-image, insert-sliced-image): Doc fix.
+
+2012-11-18 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/syntax.el (syntax-propertize-function): Doc fix
+ (Bug#12810).
+
+2012-11-18 OKAZAKI Tetsurou <okazaki.tetsurou@gmail.com> (tiny change)
+
+ * vc/vc-svn.el (vc-svn-merge-news): Properly parse the merge
+ response when the target file is in a subdirectory (Bug#12757).
+
+2012-11-18 Chong Yidong <cyd@gnu.org>
+
+ * filecache.el (file-cache-add-file-list): Doc fix (Bug#12694).
+
+2012-11-18 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/cl-lib.el (face-underline-p):
+ Use set-face-underline rather than the alias set-face-underline-p.
+
+ * window.el (with-temp-buffer-window): Doc fix.
+ * subr.el (with-output-to-temp-buffer):
+ Add doc xref to with-temp-buffer-window.
+
+2012-11-18 Juanma Barranquero <lekktu@gmail.com>
+
+ * woman.el (woman-non-underline-faces): Use `set-face-underline'.
+ * calc/calc.el (math-format-date-cache): Declare.
+
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Calc by default uses the Gregorian calendar for all dates (Bug#12633).
+ It also uses January 1, 1 AD as its day number 1.
+ * calc/calc-forms.el (math-julian-date-beginning)
+ (math-julian-date-beginning-int): Implement this.
+
+2012-11-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * descr-text.el (quail-find-key):
+ * dired.el (desktop-file-name):
+ * dirtrack.el (shell-prefixed-directory-name, shell-process-cd):
+ * generic-x.el (comint-mode, comint-exec):
+ * image-dired.el (widget-forward):
+ * info.el (speedbar-add-expansion-list, speedbar-center-buffer-smartly)
+ (speedbar-change-expand-button-char)
+ (speedbar-change-initial-expansion-list, speedbar-delete-subblock)
+ (speedbar-make-specialized-keymap, speedbar-make-tag-line):
+ * printing.el (easy-menu-add-item, easy-menu-remove-item)
+ (widget-field-action, widget-value-set):
+ * speedbar.el (imenu--make-index-alist):
+ * term.el (ring-empty-p, ring-ref, ring-insert-at-beginning)
+ (ring-length, ring-insert):
+ * vcursor.el (compare-windows-skip-whitespace):
+ * woman.el (dired-get-filename):
+ Declare functions.
+
+ * term/w32-win.el (cygwin-convert-path-from-windows): Fix declaration.
+
+2012-11-17 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc.el (calc-gregorian-switch): New variable.
+
+ * calc/calc-forms.el (math-day-in-year, math-dt-before-p)
+ (math-absolute-from-gregorian-dt, math-absolute-from-julian-dt)
+ (math-date-to-julian-dt, math-date-to-gregorian-dt): New functions.
+ (math-leap-year-p): Add option to distinguish between Julian
+ and Gregorian calendars.
+ (math-day-number): Use `math-day-in-year' to do the computations.
+ (math-absolute-from-dt): Rename from `math-absolute-from-date'.
+ Use `math-absolute-from-gregorian' and `math-absolute-from-julian'
+ to do the computations.
+ (math-date-to-dt): Use `math-date-to-julian-dt' and
+ `math-date-to-gregorian-dt' to do the computations.
+ (calcFunc-weekday, math-format-date-part): Use the new version of
+ the DATE to determine the weekday.
+ (calcFunc-newmonth, calcFunc-newyear): Use `calc-gregorian-switch'
+ when necessary.
+
+2012-11-17 Eli Zaretskii <eliz@gnu.org>
+
+ * term/w32-win.el (w32-handle-dropped-file): Use 'file://' only on
+ Cygwin; otherwise use 'file:'. (Bug#12914)
+ (cygwin-convert-path-from-windows): Declare, to avoid
+ byte-compiler warnings.
+
+2012-11-17 Andreas Politz <politza@fh-trier.de>
+
+ * ibuffer.el (ibuffer-mark-forward, ibuffer-unmark-forward)
+ (ibuffer-unmark-backward, ibuffer-mark-interactive): Support plain
+ prefix and negative numeric prefix args (Bug#12795).
+
+2012-11-17 Stephen Berman <stephen.berman@gmx.net>
+
+ * play/gamegrid.el (gamegrid-add-score-with-update-game-score-1):
+ Don't signal an error with a score that is too low to add to the
+ list of top scores. (Bug#12779)
+
+2012-11-17 Chong Yidong <cyd@gnu.org>
+
+ * help-mode.el (help-xref-interned): End on point-min (Bug#12737).
+
+ * filecache.el (file-cache-add-file): Handle relative file name in
+ the argument (Bug#12694).
+
+2012-11-16 Jürgen Hötzel <juergen@archlinux.org> (tiny change)
+
+ * eshell/em-unix.el (eshell/mkdir): Handle "--parents" (bug#12897).
+
+2012-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el (ad-make-advised-definition): Improve last fix.
+
+ * emacs-lisp/cl-lib.el: Set more meaningful version number.
+
+2012-11-16 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (enlarge-window, shrink-window): Don't mention return
+ value in doc-string (Bug#12896).
+ (window--display-buffer): Don't resize frames - it won't work
+ with all window managers and defeat pop-up-frame-alist.
+ (display-buffer-alist): In doc-string explain that CONDITION can
+ be a function and which arguments are passed to it (Bug#12854).
+ (display-buffer-assq-regexp): New argument ACTION. Handle lambda
+ expressions (Bug#12854).
+ (display-buffer): Pass ACTION argument to
+ display-buffer-assq-regexp.
+
+2012-11-16 Glenn Morris <rgm@gnu.org>
+
+ * window.el (fit-frame-to-buffer-bottom-margin)
+ (fit-frame-to-buffer, fit-window-to-buffer): Doc fixes.
+
+ * faces.el (face-underline-p): Use face-attribute-specified-or.
+
+2012-11-16 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp/cl-macs.el (cl-loop, cl-do, cl-do*): Doc fixes.
+
+2012-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-flet, cl-flet*): Fix docstring (bug#12895).
+
+2012-11-16 Glenn Morris <rgm@gnu.org>
+
+ * eshell/em-cmpl.el (eshell-pcomplete): New command. (Bug#12838)
+ (eshell-cmpl-initialize): Bind eshell-pcomplete to TAB, C-i.
+
+ * faces.el (face-underline-p): Doc fix. Handle :underline being
+ things other than `t' (a string, a list).
+ (face-inverse-video-p): Doc fix.
+ (set-face-underline): Rename it back from set-face-underline-p.
+ Doc fix. Allow interactive input of values other than t.
+ (read-face-attribute): Apply formatting to :underline,
+ since like :box and :stipple it can take list values.
+
+ * term.el (ansi-term): Don't let C-x escape-char binding
+ clobber the more standard C-c binding. (Bug#12842)
+
+ * subr.el (set-temporary-overlay-map): Doc fix.
+
+2012-11-16 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (record-window-buffer)
+ (display-buffer-record-window): When copying the markers to
+ window-point preserve window-point-insertion-type. (Bug#12588)
+
+2012-11-16 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke):
+ * net/tramp-gvfs.el (tramp-gvfs-dbus-event-error):
+ Use new names for hooks rather than obsolete aliases.
+
+2012-11-15 Daniel Colascione <dancol@dancol.org>
+
+ * term/w32-win.el (w32-handle-dropped-file): Use a "file://"
+ prefix instead of "file:" so that when FILE-NAME begins with "//",
+ as it does when the target file is on a network share, url-handler
+ isn't confused.
+
+2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el (ad-definition-type): Make sure we don't use
+ a preactivated advice from an old advice.el; they're not compatible!
+
+2012-11-15 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emacs-lisp/nadvice.el (advice--make-interactive-form):
+ Fix string-spec case.
+
+ * emacs-lisp/advice.el (ad-make-advised-definition): Fix undefined case.
+
+2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el: Add buffer-local support to add-function.
+ (advice--buffer-local-function-sample): New var.
+ (advice--set-buffer-local, advice--buffer-local): New functions.
+ (add-function, remove-function): Use them.
+
+2012-11-15 Drew Adams <drew.adams@oracle.com>
+
+ * imenu.el (imenu--split-submenus): Use imenu--subalist-p (bug#12717).
+
+2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl--transform-lambda): Defend against
+ potential binding of print-gensym to t, and prettify (back)quotes in
+ case they appear in args's default values (bug#12884).
+
+2012-11-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el: Add around advice for interactive specs.
+ (advice-eval-interactive-spec): New function.
+ (advice--make-interactive-form): Support around advice (bug#12844).
+
+2012-11-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-expr-beg): Make heredoc detection
+ more strict. Add docstring.
+ (ruby-expression-expansion-re): Extract from
+ `ruby-match-expression-expansion'.
+ (ruby-syntax-propertize-function): After everything else, search
+ for expansions in string literals, mark their insides as
+ whitespace syntax and save match data for font-lock.
+ (ruby-font-lock-keywords): Use the 2nd group from expression
+ expansion matches.
+ (ruby-match-expression-expansion): Use the match data saved to the
+ text property in ruby-syntax-propertize-function.
+
+2012-11-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/gv.el (setf): Fix debug spec for multiple assignments
+ (bug#12879).
+
+2012-11-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-move-to-block): Looks for a block
+ start/end keyword a bit harder. Works with different values of N.
+ Add more comments.
+ (ruby-end-of-block): Update accordingly.
+
+2012-11-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * woman.el (woman-file-name): Don't mess with unread-command-events
+ (bug#12861).
+
+ * emacs-lisp/advice.el: Layer on top of nadvice.el.
+ Remove out of date self-require hack.
+ (ad-do-advised-functions): Use simple `dolist'.
+ (ad-advice-name, ad-advice-protected, ad-advice-enabled)
+ (ad-advice-definition): Redefine as functions.
+ (ad-advice-classes): Move before first use.
+ (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition)
+ (ad-make-mapped-call, ad-make-advised-docstring,ad-make-plain-docstring)
+ (ad--defalias-fset): Remove functions.
+ (ad-make-advicefunname, ad-clear-advicefunname-definition): New funs.
+ (ad-get-orig-definition): Rewrite.
+ (ad-make-advised-definition-docstring): Change base docstring.
+ (ad-real-orig-definition): Rewrite.
+ (ad-map-arglists): Change name of called function.
+ (ad--make-advised-docstring): Redirect `function' from ad-Advice-...
+ (ad-make-advised-definition): Simplify.
+ (ad-assemble-advised-definition): Tweak for new calling context.
+ (ad-activate-advised-definition): Setup ad-Advice-* i.s.o ad-Orig-*.
+ (ad--defalias-fset): Rename from ad-handle-definition. Make it set the
+ function and call ad-activate if needed.
+ (ad-activate, ad-deactivate): Don't call ad-handle-definition any more.
+ (ad-recover): Clear ad-Advice-* instead of ad-Orig-*.
+ (ad-compile-function): Compile ad-Advice-*.
+ (ad-activate-on-top-level, ad-with-auto-activation-disabled): Remove.
+ (ad-start-advice, ad-stop-advice): Remove.
+
+2012-11-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-add-log-current-method): Print the
+ period before class method names, not after. Remove handling of
+ one impossible case. Add comments.
+
+2012-11-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el: Remove support for freezing.
+ (ad-make-freeze-docstring, ad-make-freeze-definition): Remove functions.
+ (ad-make-single-advice-docstring, ad-defadvice-flags, defadvice):
+ Remove support for `freeze'.
+
+ * emacs-lisp/cl.el (dolist, dotimes, declare): Use advice-add to
+ override the default.
+ * emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Rewrite without using
+ cl--dotimes/dolist.
+ * subr.el (dolist, dotimes, declare): Redefine them normally, even when
+ `cl' is loaded.
+
+ * emacs-lisp/nadvice.el (advice--normalize): New function, extracted
+ from add-advice.
+ (advice--strip-macro): New function.
+ (advice--defalias-fset): Use them to handle macros.
+ (advice-add): Use them.
+ (advice-member-p): Correctly handle macros.
+
+2012-11-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ Never font-lock the beginning of singleton class as heredoc.
+
+2012-11-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/gv.el (gv-define-simple-setter): One more fix (bug#12871).
+
+2012-11-13 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * ansi-color.el (ansi-color-apply-sequence): Implement SGR codes
+ 39 and 49 (bug#12792). Also, treat unimplemented parameters as 0,
+ thereby restoring the behavior of revisions prior to 2012-08-15T03:33:55Z!monnier@iro.umontreal.ca.
+
+2012-11-13 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Fix end-of-defun misbehavior.
+ * progmodes/python.el (python-nav-beginning-of-defun): Rename from
+ python-beginning-of-defun-function. Handle nested defuns
+ correctly.
+ (python-nav-end-of-defun): Rename from
+ python-end-of-defun-function. Ensure forward movement.
+ (python-info-current-defun): Reimplement to work as intended
+ with new fixed python-nav-{end,beginning}-of-defun. Stop scanning
+ parent defuns as soon as possible.
+
+2012-11-13 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/flymake.el (flymake-error-bitmap)
+ (flymake-warning-bitmap, flymake-fringe-indicator-position): Doc fixes.
+ (flymake-error-bitmap, flymake-warning-bitmap): Fix :types.
+
+2012-11-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-move-to-block): When moving
+ backward, always stop at indentation. Reverts the change from
+ 2012-08-12T22:06:56Z!monnier@iro.umontreal.ca (Bug#12851).
+
+2012-11-13 Glenn Morris <rgm@gnu.org>
+
+ * ibuffer.el (ibuffer-mode-map, ibuffer-mode):
+ Add ibuffer-filter-by-derived-mode.
+
+ * ibuffer.el (ibuffer-mode-map): Don't have two menu items with
+ the same name shadowing each other.
+
+ * window.el (with-temp-buffer-window): Doc tweak.
+
+ * emacs-lisp/debug.el (debugger-bury-or-kill): Doc tweak.
+
+ * help.el (temp-buffer-max-height):
+ * window.el (fit-frame-to-buffer, fit-frame-to-buffer-bottom-margin):
+ * emacs-lisp/debug.el (debugger-bury-or-kill): Fix :version.
+
+2012-11-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el: New package.
+ * subr.el (special-form-p): New function.
+ * emacs-lisp/elp.el: Use lexical-binding and advice-add.
+ (elp-all-instrumented-list): Remove var.
+ (elp-not-profilable): Remove elp-wrapper.
+ (elp-profilable-p): Use autoloadp and special-form-p.
+ (elp--advice-name): New const.
+ (elp-instrument-function): Use advice-add.
+ (elp--instrumented-p): New predicate.
+ (elp-restore-function): Use advice-remove.
+ (elp-restore-all, elp-reset-all): Use mapatoms.
+ (elp-set-master): Use elp--instrumented-p.
+ (elp--make-wrapper): Rename from elp-wrapper, return a function
+ suitable for advice-add. Use cl-inf.
+ (elp-results): Use mapatoms+elp--instrumented-p.
+ * emacs-lisp/debug.el: Use lexical-binding and advice-add.
+ (debug-function-list): Remove var.
+ (debug): Rename arg, and then let-bind it explicitly inside.
+ (debugger-setup-buffer): Rename arg.
+ (debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
+ (debugger-frame-number): Adjust to new debug-on-entry setup.
+ (debug--implement-debug-on-entry): Rename from
+ implement-debug-on-entry, add argument.
+ (debugger-special-form-p): Remove, use special-form-p instead.
+ (debug-on-entry): Use advice-add.
+ (debug--function-list): New function.
+ (cancel-debug-on-entry): Use it, along with advice-remove.
+ (debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
+ (debugger-list-functions): Use debug--function-list instead of
+ debug-function-list.
+ * emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
+ (ad-special-form-p): Remove, use special-form-p instead.
+ (ad-set-advice-info): Use add-function and remove-function.
+ (ad--defalias-fset): Adjust accordingly.
+
+2012-11-10 Glenn Morris <rgm@gnu.org>
+
+ * mail/emacsbug.el (report-emacs-bug-tracker-url)
+ (report-emacs-bug-bug-alist, report-emacs-bug-choice-widget)
+ (report-emacs-bug-create-existing-bugs-buffer)
+ (report-emacs-bug-parse-query-results)
+ (report-emacs-bug-query-existing-bugs): Remove. (Bug#7449)
+
+ * term.el (term-default-fg-color, term-default-bg-color):
+ Make obsolete, rather than just saying "deprecated" in the doc.
+
+ * term.el (term): Rename from `term-face'.
+ (term-current-face, ansi-term-color-vector)
+ (term-default-fg-color, term-default-bg-color, term-ansi-reset):
+ Update all users.
+
+2012-11-10 Jan Djärv <jan.h.d@swipnet.se>
+
+ * server.el (server-create-window-system-frame): Handle Nextstep
+ specially (Bug#12780).
+
+2012-11-10 Glenn Morris <rgm@gnu.org>
+
+ * mail/emacsbug.el (report-emacs-bug-query-existing-bugs):
+ Unautoload, and make obsolete. (Bug#7449)
+
+2012-11-10 Chong Yidong <cyd@gnu.org>
+
+ * vc/diff-mode.el (diff-delete-trailing-whitespace): Rewrite, and
+ rename from diff-remove-trailing-whitespace (Bug#12831).
+
+2012-11-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el: Require `cl-lib' at run-time to fix
+ miscompilation of trace.el.
+
+2012-11-10 Glenn Morris <rgm@gnu.org>
+
+ * vc/diff-mode.el (diff-remove-trailing-whitespace): Doc fix.
+
+2012-11-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/gv.el (gv-define-simple-setter): Fix last change
+ (bug#12812).
+
+2012-11-10 Chong Yidong <cyd@gnu.org>
+
+ * minibuf-eldef.el (minibuffer-eldef-shorten-default): Convert to
+ a defcustom with an appropriate :set function.
+ (minibuffer-default--in-prompt-regexps): New function.
+
+2012-11-10 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/cl.el (define-setf-expander, defsetf)
+ (define-modify-macro): Doc fixes.
+
+ * emacs-lisp/gv.el (gv-letplace): Fix doc typo.
+ (gv-define-simple-setter): Update doc of `fix-return'.
+
+2012-11-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/gv.el (gv-define-simple-setter): Don't evaluate `val'
+ twice when `fix-return' is set (bug#12813).
+
+ * emacs-lisp/cl.el (defsetf): Pass the third arg to
+ gv-define-simple-setter (bug#12812).
+
+ * woman.el (woman-decode-region): Disable adaptive-fill when rendering
+ (bug#12756).
+
+2012-11-10 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/gv.el (gv-define-setter): Fix doc typo.
+
+ * emacs-lisp/cl-extra.el (cl-prettyexpand):
+ * emacs-lisp/cl-lib.el (cl-proclaim, cl-declaim):
+ * emacs-lisp/cl-macs.el (cl-destructuring-bind, cl-locally)
+ (cl-the, cl-compiler-macroexpand): Add basic doc strings.
+
+ * emacs-lisp/cl-extra.el (cl-maplist, cl-mapcan): Doc fix.
+
+2012-11-10 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-set-matches-1): Improve flex matching performance by
+ removing backtracking in the regexp (suggested by Stefan). (Bug#12796)
+
+2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el (ad-set-advice-info): Set defalias-fset-function.
+ (ad--defalias-fset): New function.
+ (ad-safe-fset): Remove.
+ (ad-make-freeze-definition): Use cl-letf*.
+
+2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (dolist): Don't bind VAR in RESULT.
+
+ * emacs-lisp/advice.el: Miscellaneous cleanup. Use lexical-binding.
+ (fset, documentation): Don't save real def since we don't advise.
+ (ad-do-advised-functions): Remove problematic `result-form'.
+ (ad-safe-fset): `ad-real-fset' => `fset'.
+ (ad-read-advised-function): Don't assume that ad-do-advised-functions
+ uses CL's dolist internally.
+ (ad-arglist): Remove unused arg `name'.
+ (ad-docstring, ad-make-advised-docstring):
+ `ad-real-documentation' => `documentation'.
+ (warning-suppress-types): Declare.
+ (ad-set-arguments): Simple CSE.
+ (ad-recover-normality): Sanity check.
+
+ * emacs-lisp/bytecomp.el (byte-compile-out-toplevel): Don't turn
+ (funcall '(lambda ..) ..) into ((lambda ..) ..).
+
+2012-11-09 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el: symbol to coordinate mapping is made by symbol property
+ `ses-cell'. This means that the same mapping is done for all SES
+ sheets. That is good enough for cells with standard A1 names, but
+ not for named cell. So a hash map is added for the latter.
+ (defconst ses-localvars): Add local variable ses--named-cell-hashmap
+ (ses-sym-rowcol): Use hashmap for named cell.
+ (ses-is-cell-sym-p): New defun.
+ (ses-decode-cell-symbol): New defun.
+ (ses-create-cell-variable): Add cell to hashmap when name is not
+ A1-like.
+ (ses-rename-cell): Check that cell new name is not already in
+ spreadsheet with the use of ses-is-cell-sym-p
+ (ses-rename-cell): Use hash map for named cells, but accept also
+ renaming back to A1-like.
+
+2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el: Use new dynamic docstrings.
+ (ad-make-advised-definition-docstring, ad-advised-definition-p):
+ Use dynamic-docstring-function instead of ad-advice-info.
+ (ad--make-advised-docstring): New function extracted from
+ ad-make-advised-docstring.
+ (ad-make-advised-docstring): Use it.
+ * progmodes/sql.el (sql--make-help-docstring): New function, extracted
+ from sql-help.
+ (sql-help): Use it with dynamic-docstring-function.
+
+ * env.el (env--substitute-vars-regexp): Don't use rx (for bootstrap).
+
+2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files.el (hack-one-local-variable--obsolete): New function.
+ (hack-one-local-variable): Use it for obsolete settings.
+
+ * subr.el (locate-user-emacs-file): If both old and new name exist, use
+ the new name.
+
+ * progmodes/js.el (js--filling-paragraph): New var.
+ (c-forward-sws, c-backward-sws, c-beginning-of-macro): Advise.
+ (js-c-fill-paragraph): Prefer advice to cl-letf so the rebinding is
+ less sneaky.
+
+2012-11-08 Julien Danjou <julien@danjou.info>
+
+ * progmodes/ruby-mode.el (auto-mode-alist): Add Rakefile in
+ `auto-mode-alist' (Bug#12835).
+
+2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/perl-mode.el (perl-prettify-symbols): New defcustom.
+ (perl--prettify-symbols-alist): New const.
+ (perl--font-lock-compose-symbol, perl--font-lock-symbols-keywords):
+ New functions.
+ (perl-font-lock-keywords-2): Use them.
+ (perl-electric-noindent-p): New function.
+ (perl-mode): Use it to set up electric-indent-mode.
+ (perl-electric-terminator, perl-indent-command): Mark obsolete.
+ (perl-mode-map): Remove bindings for them.
+ (perl-imenu-generic-expression, perl-outline-level):
+ Match functions&packages in column>0.
+
+ * env.el (env--substitute-vars-regexp): New const.
+ (substitute-env-vars): Use it. Add `only-defined' arg.
+ * net/tramp.el (tramp-replace-environment-variables): Use it.
+
+ * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
+ Byte-compile *before* eval in eval-and-compile.
+ (byte-compile-log-warning): Remove redundant inhibit-read-only.
+ (byte-compile-file-form-autoload): Don't hide actual definition.
+ (byte-compile-maybe-guarded): Accept `functionp' as well.
+
+ * emacs-lisp/gv.el (gv-ref, gv-deref): New function and macro.
+
+2012-11-07 Michael Albinus <michael.albinus@gmx.de>
+
+ * notifications.el (notifications-get-server-information-method):
+ New defconst.
+ (notifications-get-capabilities): Fix docstring.
+ (notifications-get-server-information): New defun.
+
+2012-11-06 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-region): Standard re-indent for better
+ readability.
+
+ * textmodes/ispell.el: Experimental support for support debugging.
+ (ispell-create-debug-buffer): Create a `ispell-debug-buffer' debug
+ buffer for ispell.
+ (ispell-print-if-debug): New function to print stuff to
+ `ispell-debug-buffer' if debugging is enabled.
+ (ispell-region, ispell-process-line): Use `ispell-print-if-debug' to
+ show some debugging info.
+ (ispell-buffer-with-debug): New function that creates a debugging
+ buffer and calls `ispell-buffer' with debugging enabled.
+
+ * textmodes/ispell.el (ispell-region): Do not prefix sent string by
+ comment in autoconf mode. (Bug#12768)
+
+2012-11-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * emacs-lisp/byte-opt.el (toplevel): Add compare-window-configurations,
+ frame-first-window, frame-root-window, frame-selected-window,
+ minibuffer-selected-window, minibuffer-window,
+ window-absolute-pixel-edges, window-at, window-body-height,
+ window-body-width, window-display-table, window-combination-limit,
+ window-frame, window-fringes, window-inside-absolute-pixel-edges,
+ window-inside-edges, window-inside-pixel-edges, window-left-child,
+ window-left-column, window-margins, window-next-buffers,
+ window-next-sibling, window-new-normal, window-new-total,
+ window-normal-size, window-parameter, window-parameters, window-parent,
+ window-pixel-edges, window-point, window-prev-buffers,
+ window-prev-sibling, window-redisplay-end-trigger, window-scroll-bars,
+ window-start, window-text-height, window-top-child, window-top-line,
+ window-total-height, window-total-width and window-use-time to the list
+ of functions without side-effects.
+ (toplevel): Add window-valid-p to the list of error-free functions
+ without side-effects.
+
+2012-11-05 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-program-name):
+ Update spellchecker parameters when customized.
+
+2012-11-04 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-svn.el (vc-svn-state-heuristic): Avoid calling svn. (Bug#7850)
+
+2012-11-04 Chong Yidong <cyd@gnu.org>
+
+ * bookmark.el (bookmark-bmenu-switch-other-window): Avoid binding
+ same-window-* variables.
+
+2012-11-04 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-help-for-help, isearch-describe-bindings)
+ (isearch-describe-key, isearch-describe-mode): Use a display
+ action instead of binding same-window-* variables (Bug#10040).
+
+2012-11-03 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/cl-macs.el (cl-parse-loop-clause):
+ Rename handler properties back from cl-- to cl-. (Bug#12788)
+
+ * emacs-lisp/cl-macs.el (cl-do-all-symbols): Add doc string.
+
+2012-11-03 Eli Zaretskii <eliz@gnu.org>
+
+ * term/pc-win.el: Don't load term/internal from here.
+
+ * loadup.el: Load term/internal from here.
+
+2012-11-03 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (inferior-python-mode): Fix hang in
+ jit-lock (Bug#12645).
+
+2012-11-03 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (switch-to-visible-buffer)
+ (switch-to-buffer-preserve-window-point): Fix doc-strings.
+
+2012-11-03 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/cl-lib.el (cl--random-time):
+ Rename from cl-random-time. (Bug#12773)
+ (cl--gensym-counter, cl--random-state): Update callers.
+ * emacs-lisp/cl-extra.el (cl-make-random-state): Update callers.
+
+2012-11-03 Chong Yidong <cyd@gnu.org>
+
+ * cus-start.el: Make cursor-type customizable (Bug#11633).
+
+2012-11-02 Glenn Morris <rgm@gnu.org>
+
+ * filecache.el: No need to load find-lisp when compiling.
+ (find-lisp-find-files): Autoload it.
+ (file-cache-add-directory-recursively): Don't require find-lisp.
+
+ * image.el (image-type-from-file-name): Trivial simplification.
+
+ * emacs-lisp/bytecomp.el (byte-compile-eval):
+ Decouple "noruntime" and "cl-functions" warnings.
+
+2012-11-01 Stephen Berman <stephen.berman@gmx.net>
+
+ * play/gomoku.el (gomoku-display-statistics): Update mode line
+ only if in Gomoku buffer; don't capitalize "won" (Bug#12771).
+
+2012-10-31 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (quit-restore-window): If the window has been
+ created on an existing frame and ended up as the sole window on
+ that frame, do not delete it (Bug#12764).
+
+2012-10-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el (sh--inside-noncommand-expression):
+ Rename from sh--inside-arithmetic-expression, handle more cases
+ (bug#11263).
+
+ * progmodes/sh-script.el (sh--inside-arithmetic-expression): New func.
+ (sh-font-lock-open-heredoc): Use it (bug#12770).
+
+2012-10-30 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/cl-extra.el (cl-mapc): Add autoload cookie. Doc fix.
+
+ * emacs-lisp/cl.el (letf): Doc fix. (Bug#12760)
+
+2012-10-29 Chong Yidong <cyd@gnu.org>
+
+ * isearch.el (isearch-other-meta-char): Ensure that a reprocessed
+ function key is stored in a keyboard macro (Bug#4894).
+
+ * thingatpt.el (number-at-point): Apply a thing-at-point property.
+
+2012-10-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/diff-mode.el (diff-context->unified): Don't get confused by "hunk
+ header comments".
+ (diff-unified->context, diff-context->unified)
+ (diff-reverse-direction, diff-fixup-modifs): Use `use-region-p'.
+
+ * emacs-lisp/cl.el (letf): Add missing indent rules (bug#12759).
+
+ * files.el (find-alternate-file): Only ask one question (bug#12487).
+
+2012-10-29 Chong Yidong <cyd@gnu.org>
+
+ * vc/vc-hooks.el (vc-file-clearprops): Kill vc-parent-buffer.
+ Suggested by Dan Nicolaescu (Bug#6326).
+
+ * info.el (Info-complete-menu-item): Avoid duplicates (Bug#12705).
+
+ * startup.el (fancy-about-screen): Don't message (Bug#12680).
+
+ * thingatpt.el (thing-at-point): Doc fix (Bug#12691).
+
+ * imenu.el (imenu): Inhibit push-mark message (Bug#12726).
+
+ * face-remap.el (face-remap-add-relative): Handle the case where a
+ face-remapping-alist entry is a cons cell (Bug#12762).
+
+2012-10-29 Kevin Ryde <user42@zip.com.au>
+
+ * woman.el (woman-parse-numeric-value): Handle picas correctly
+ (Bug#12639).
+
+2012-10-29 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/cl.el (defsetf): Doc fix.
+
+2012-10-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el (sh-font-lock-paren): Also put punctuation
+ syntax to the matching opener, if any (bug#12547).
+ (sh-smie-sh-forward-token, sh-smie-sh-backward-token): Recognize this
+ matching open as a "case-(".
+ (sh-smie-rc-grammar): Add a corresponding rule for it.
+
+2012-10-28 Daniel Hackney <dan@haxney.org>
+
+ * emacs-lisp/package.el (package-generate-autoloads): Kill buffer
+ "PKGNAME-autoloads.el" in case we created it.
+
+2012-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion--sifn-requote): Rewrite to handle things
+ like Tramp's "/foo:~bar//baz" -> "/scpc:foo:/baz" mapping (bug#11714).
+ (completion--twq-all): Disable too-strict assertions.
+
+ * tmm.el (tmm-prompt): Use map-keymap (bug#12744).
+
+2012-10-27 Eli Zaretskii <eliz@gnu.org>
+
+ * profiler.el (profiler-report-make-entry-part): Fix help-echo
+ text to match the real keybindings.
+
+2012-10-27 Juri Linkov <juri@jurta.org>
+
+ * wdired.el (wdired-keep-marker-rename): New defcustom.
+ (wdired-do-renames): Use it instead of `dired-keep-marker-rename'.
+ (Bug#11795)
+
+ * dired.el (dired-keep-marker-rename): Add reference to
+ `wdired-keep-marker-rename' in the docstring.
+ Add default character value ?R to display initially in
+ Customization UI instead of ?@.
+
+2012-10-27 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer): In doc-string describe
+ window-height and window-width alist entries.
+
+ * time.el (display-time-world): Restore fit-window-to-buffer
+ behavior.
+
+2012-10-27 Chong Yidong <cyd@gnu.org>
+
+ * subr.el (insert-buffer-substring-as-yank): Doc fix.
+
+2012-10-26 Jambunathan K <kjambunathan@gmail.com>
+
+ * minibuffer.el (completion-category-overrides): New completion
+ category `bookmark' (bug#11131).
+
+2012-10-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el (ad-assemble-advised-definition):
+ Silence bogus compiler warnings for ad-do-it.
+
+ * bookmark.el (bookmark-completing-read): Set the completion category
+ to `bookmark' (bug#11131).
+
+2012-10-26 Bastien <bzg@altern.org>
+ Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * face-remap.el: Use lexical-binding.
+ (text-scale-adjust): Improve docstring. Use itself for the temporary
+ overlay-map bindings, so as to repeat the "Use..." message each time.
+
+2012-10-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexp--expand-all):
+ Obey byte-compile-warning-enabled-p (bug#12486).
+
+ * vc/diff-mode.el (diff-end-of-hunk): Also skip potential "no LF at eol".
+ (diff-refine-hunk): Similarly, handle the "no LF at eol" (bug#12584).
+
+2012-10-26 Martin Rudalics <rudalics@gmx.at>
+
+ * mouse.el (mouse-drag-line): Move last form into preceding when
+ clause (Bug#12731).
+
+ * help.el (resize-temp-buffer-window): Fix doc-string.
+
+2012-10-25 David Engster <deng@randomsample.de>
+
+ * emacs-lisp/eieio.el (eieio-update-lisp-imenu-expression):
+ Remove. This feature is already integrated in imenu.
+
+ * emacs-lisp/eieio-opt.el: Remove require for `button' since it is
+ always loaded. Require `speedbar' unconditionally.
+
+2012-10-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * dired.el (dired-get-marked-files): Allow ! on . and .. (bug#12725).
+
+ * minibuffer.el (minibuffer-force-complete): Fix thinko.
+
+ * net/ldap.el (ldap-search-internal): The official ldif format starts
+ with a "version: 1" header (bug#12724).
+
+ * emacs-lisp/package.el (package-installed-p): Warn if not ready
+ (bug#12721).
+
+2012-10-25 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/cl-macs.el (cl-progv): Doc fix.
+
+2012-10-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (minibuffer-force-complete): Use one more marker
+ for the temporary-overlay-map command (bug#12619).
+
+2012-10-24 Chong Yidong <cyd@gnu.org>
+
+ * time.el (display-time-world-mode): Derive from special-mode.
+ (display-time-world): Use display-buffer (Bug#12708).
+ (display-time-world-mode-map): Variable deleted.
+ (display-time-world-display): Wrap the final delete-char inside
+ inhibit-read-only.
+
+2012-10-24 Chong Yidong <cyd@gnu.org>
+
+ * dired.el (dired-mark, dired-unmark, dired-flag-file-deletion):
+ Doc fix.
+
+ * emacs-lisp/easymenu.el (easy-menu-define): Doc fix (Bug#12628).
+
+2012-10-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion--all-sorted-completions-location): New var.
+ (completion--cache-all-sorted-completions)
+ (completion--flush-all-sorted-completions): Use it.
+ (completion-in-region, completion-in-region--postch)
+ (completion-at-point, completion-help-at-point): Use markers in
+ completion-in-region--data (bug#12619).
+
+2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/compile.el (compilation-start): Try to handle common
+ quoting of `cd' argument (bug#12640).
+
+ * vc/diff-mode.el (diff-hunk): `save-excursion' while refining
+ (bug#12671).
+
+2012-10-23 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/gud.el (gud-menu-map):
+ Check gdb-active-process is bound. (Bug#12358)
+
+2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * repeat.el (repeat): Set real-this-command (bug#12232).
+
+ * htmlfontify.el (hfy-post-html-hook):
+ * filesets.el (filesets-cache-fill-content-hook):
+ * arc-mode.el (archive-extract-hook):
+ * progmodes/cc-mode.el (c-prepare-bug-report-hook):
+ * net/rcirc.el (rcirc-sentinel-functions)
+ (rcirc-receive-message-functions, rcirc-activity-functions)
+ (rcirc-print-functions):
+ * net/dbus.el (dbus-event-error-functions):
+ * emacs-lisp/eieio.el (eieio-pre-method-execution-functions):
+ * emacs-lisp/checkdoc.el (checkdoc-style-functions)
+ (checkdoc-comment-style-functions): Don't use "-hooks" suffix.
+ * term/sun.el (sun-raw-prefix-hooks):
+ * mail/sendmail.el (mail-yank-hooks): Use make-obsolete-variable.
+
+2012-10-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-smb.el (tramp-smb-maybe-open-connection):
+ Set `tramp-chunksize' to 1. This improves the performance.
+ (tramp-smb-wait-for-output): Add timeout to
+ `tramp-accept-process-output' calls.
+
+2012-10-23 Chong Yidong <cyd@gnu.org>
+
+ * faces.el (font-list-limit): Define as an obsolete variable.
+
+ * startup.el (command-line):
+ * cus-start.el: Don't refer to font-list-limit.
+
+ * newcomment.el (comment-normalize-vars): Doc fix (Bug#12583).
+
+2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (internal-temp-output-buffer-show): Rename from
+ temp-output-buffer-show, since previously compiled files expect this name.
+
+2012-10-23 Glenn Morris <rgm@gnu.org>
+
+ * image.el (image-type-from-file-name): If multiple types match,
+ return the first one that is supported. (Bug#9045)
+
+2012-10-22 Glenn Morris <rgm@gnu.org>
+
+ * image.el (imagemagick-enabled-types): Doc fix.
+
+2012-10-22 Takafumi Arakaki <aka.tkf@gmail.com> (tiny change)
+
+ * progmodes/which-func.el (which-func-current): The hash-table may have
+ an explicit nil (bug#12338).
+
+2012-10-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * electric.el (electric-pair-delete-selection-self-insert-function):
+ Rename to electric-pair-will-use-region, return a boolean.
+ (electric-pair-mode): Adjust accordingly. Don't require delsel.
+
+ * delsel.el (delete-selection-helper): Use a function instead of a hook.
+ (delete-selection-pre-hook): Use use-region-p.
+ (delete-selection-self-insert-function): Remove.
+ (self-insert-command): Obey self-insert-uses-region-functions.
+ (self-insert-iso): Revert to previous setting, since we don't actually
+ know what that command does.
+ (delete-selection-self-insert-hooks): Remove.
+
+2012-10-22 Simon Law <sfllaw@sfllaw.ca> (tiny change)
+
+ * delsel.el (delete-selection-helper): New function, extracted from
+ delete-selection-pre-hook.
+ (delete-selection-pre-hook): Use it.
+ (delete-selection-self-insert-function): New function.
+ (delete-selection-self-insert-hooks): New hook.
+ (self-insert-command, self-insert-iso): Use it.
+ * electric.el (electric-pair-syntax): New function, extracted from
+ electric-pair-post-self-insert-function.
+ (electric-pair-post-self-insert-function): Use it.
+ (electric-pair-delete-selection-self-insert-function): New function.
+ (electric-pair-mode): Require delsel and setup
+ delete-selection-self-insert-hooks (bug#11520).
+
+2012-10-20 Chong Yidong <cyd@gnu.org>
+
+ * vc/vc.el (vc-diff-internal): Set up Diff mode even if there are
+ no changes to show (Bug#12586).
+
+ * eshell/esh-cmd.el (eshell-rewrite-for-command): Copy the body
+ list explicitly (Bug#12571).
+
+2012-10-20 Arne Jørgensen <arne@arnested.dk>
+
+ * progmodes/flymake.el (flymake-create-temp-inplace):
+ Use file-truename.
+
+2012-10-20 Eli Zaretskii <eliz@gnu.org>
+
+ * loadup.el: Update comment about uncompiled Lisp files. (Bug#12395)
+
+2012-10-20 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-units.el (math-extract-units): Properly extract powers
+ of units.
+
+2012-10-20 Daniel Colascione <dancol@dancol.org>
+
+ * frame.el (make-frame): Set x-display-name as we used to in order
+ to unbreak creating an X11 frame from an Emacs daemon started
+ without a display.
+
+2012-10-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (minibuffer-force-complete): Make the next completion use
+ the same completion-field (bug#12221).
+
+2012-10-19 Martin Rudalics <rudalics@gmx.at>
+
+ * emacs-lisp/debug.el (debug): Record height of debugger window
+ also when debugger will be back (Bug#8789).
+
+2012-10-18 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-display-buffer-other-frame-action):
+ Convert to defcustom.
+ (gdb-get-source-file): Don't bind pop-up-windows.
+
+ * progmodes/gud.el (gud-display-line): Don't specially re-use
+ other frames for the gdb-mi case (Bug#12648).
+
+2012-10-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el: Clean up commentary a bit.
+ (ad-do-advised-functions, ad-with-originals): Use `declare'.
+ (byte-code-function-p): Never redefine.
+
+ * emacs-lisp/gv.el (cond): Same fix as before for `if'.
+
+2012-10-18 Glenn Morris <rgm@gnu.org>
+
+ * dired.el (dired-sort-toggle): Some ls implementations only allow
+ a single option string. (Bug#12666)
+
+ * minibuffer.el (completion-cycle-threshold): Doc fix.
+
+2012-10-17 Kenichi Handa <handa@gnu.org>
+
+ * international/mule.el (set-keyboard-coding-system):
+ Recover input meta mode when the new coding system doesn not use 8-bit.
+ Supply TERMINAL arg to set-input-meta-mode.
+
+2012-10-17 Michael Heerdegen <michael_heerdegen@web.de>
+
+ * wdired.el (wdired-old-marks): New variable.
+ (wdired-change-to-wdired-mode): Locally set wdired-old-marks.
+ (wdired-do-renames): Move point with renamed file and don't lose
+ mark status (Bug#11795).
+
+2012-10-16 Juri Linkov <juri@jurta.org>
+
+ * replace.el (query-replace-help): Mention multi-buffer replacement
+ keys in the Help message. (Bug#12655)
+
+2012-10-15 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/byte-run.el (defsubst): Doc fix.
+
+2012-10-14 Eli Zaretskii <eliz@gnu.org>
+
+ * window.el (display-buffer): Doc fix.
+
+ * progmodes/compile.el (compilation-error-regexp-alist-alist):
+ Adjust the msft regexp to the output of Studio 2010, and move msft
+ before edg-1. See the discussion on emacs-devel,
+ http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00579.html,
+ for the details.
+
+2012-10-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el (eieio-oset-default, eieio-oset, oset-default)
+ (oset): Move uses of object-class-fast macro after its definition.
+
+ * emacs-lisp/gv.el (if): Don't use closures in non-lexical-binding code.
+
+2012-10-13 Chong Yidong <cyd@gnu.org>
+
+ * textmodes/ispell.el (ispell-pdict-save): If flyspell-mode is
+ enabled, re-enable it (Bug#11963).
+
+2012-10-13 Martin Rudalics <rudalics@gmx.at>
+
+ * emacs-lisp/debug.el (debug): When debugger-will-be-back is
+ non-nil, restore window configuration (Bug#12623).
+
+2012-10-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help-fns.el (describe-variable, describe-function-1):
+ * help-mode.el (help-make-xrefs): Remove error handler, made unneeded.
+
+ * emacs-lisp/eieio.el (lisp-imenu-generic-expression): Fix typo.
+
+2012-10-12 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmailsum.el (rmail-header-summary):
+ Fix 2010-11-26 test for multiline Subject: field. (Bug#12625)
+
+2012-10-12 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (python-mode-map):
+ Replace subtitute-key-definition with proper command remapping.
+ (python-nav--up-list): Fix behavior for blocks on the same level.
+
+2012-10-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help-fns.el (describe-function-1): Handle autoloads w/o docstrings.
+
+ * emacs-lisp/bytecomp.el (byte-compile-eval): Adjust to long-ago
+ changes to the format of load-history.
+
+ * international/mule-cmds.el (read-char-by-name): Move let-binding of
+ completion-ignore-case in case that var is buffer-local (bug#12615).
+
+2012-10-11 Kenichi Handa <handa@gnu.org>
+
+ * international/eucjp-ms.el: Re-generated.
+
+2012-10-10 Kenichi Handa <handa@gnu.org>
+
+ * select.el (xselect--encode-string): If a coding is specified for
+ selection, and that is compatible with COMPOUND_TEXT, use it.
+
+2012-10-10 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (switch-to-buffer-preserve-window-point): New option.
+ (switch-to-buffer):
+ Obey `switch-to-buffer-preserve-window-point' (Bug#4041).
+
+2012-10-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * newcomment.el (comment-start-skip, comment-end-skip, comment-end):
+ Don't document nil as a useful value (bug#12583).
+
+2012-10-09 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-debug-message):
+ Remove "tramp-with-progress-reporter" from regexp of ignored functions.
+ (with-tramp-progress-reporter): Rename from
+ `tramp-with-progress-reporter'.
+ (with-tramp-file-property, with-tramp-connection-property):
+ Move from tramp-cache.el, rename from `with-file-property' and
+ `with-connection-property', respectively.
+
+ * net/tramp-cache.el: Remove `with-file-property' and
+ `with-connection-property'.
+
+ * net/tramp.el:
+ * net/tramp-gvfs.el:
+ * net/tramp-sh.el:
+ * net/tramp-smb.el: Adapt callees.
+
+ * net/trampver.el: Update release number.
+
+2012-10-09 Glenn Morris <rgm@gnu.org>
+
+ * w32-fns.el (set-message-beep):
+ * term/w32-win.el (set-message-beep): Update declarations.
+
+2012-10-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * bindings.el (mode-line-toggle-read-only, mode-line-toggle-modified)
+ (mode-line-widen, mode-line-input-method-map)
+ (mode-line-coding-system-map, mode-line-remote)
+ (mode-line-unbury-buffer, mode-line-bury-buffer)
+ (mode-line-next-buffer, mode-line-previous-buffer):
+ Replace save-selected-window+select-window => with-selected-window.
+
+ * progmodes/cc-bytecomp.el (cc-bytecomp-defmacro): Remove, unused.
+ * progmodes/cc-vars.el (bq-process): Remove, unused.
+
+ * emacs-lisp/cl-macs.el (cl-defstruct): Obey the :read-only property.
+
+2012-10-09 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Implemented `backward-up-list'-like navigation.
+ * progmodes/python.el (python-nav-up-list)
+ (python-nav-backward-up-list): New functions.
+ (python-mode-map): Define substitute key for backward-up-list to
+ python-nav-backward-up-list.
+
+2012-10-08 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (python-fill-paragraph): Rename from
+ python-fill-paragraph-function. Fixed fill-paragraph for
+ decorators (Bug#12605).
+
+2012-10-08 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (python-shell-output-filter): Handle extra
+ carriage return in OSX (Bug#12409).
+
+2012-10-08 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Fix shell handling of unbalanced quotes and parens in output.
+ * progmodes/python.el (python-rx-constituents): Add string-delimiter.
+ (python-syntax-propertize-function): Use it.
+ (python-shell-output-syntax-table): New var.
+ (inferior-python-mode): Prevent unbalanced parens/quotes from
+ previous output mess with current input context.
+
+2012-10-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * generic-x.el (javascript-generic-mode, javascript-generic-mode-hook):
+ Make obsolete aliases of js-mode and js-mode-hook (from js.el).
+
+2012-10-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * ffap.el (ffap-replace-file-component): Support Tramp file name
+ syntax, not only ange-ftp's one.
+
+2012-10-08 Glenn Morris <rgm@gnu.org>
+
+ * cus-start.el (message-log-max): Set :version.
+
+ * calendar/calendar.el (calendar-intermonth-header): Doc fix.
+
+2012-10-08 Martin Rudalics <rudalics@gmx.at>
+
+ * emacs-lisp/edebug.el (edebug-pop-to-buffer): Don't try to split
+ the minibuffer window (Bug#10851).
+
+2012-10-08 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Enhancements on forward-sexp movement.
+ * progmodes/python.el (python-nav-beginning-of-statement)
+ (python-nav-end-of-statement): Return point-marker.
+ (python-nav-forward-sexp): lisp-like forward-sexp behavior.
+ (python-info-current-symbol)
+ (python-info-statement-starts-block-p): Rename from
+ python-info-beginning-of-block-p.
+ (python-info-statement-ends-block-p): Rename from
+ python-info-end-of-block-p.
+ (python-info-beginning-of-statement-p)
+ (python-info-end-of-statement-p)
+ (python-info-beginning-of-block-p, python-info-end-of-block-p):
+ New functions.
+
+2012-10-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * comint.el (comint-preinput-scroll-to-bottom): Preserve the
+ frame-selected-windows.
+
+2012-10-08 Daniel Colascione <dancol@dancol.org>
+
+ * battery.el (battery-status-function): Check for
+ w32-battery-status itself, not system-time windows-nt.
+
+ * frame.el: Require cl-lib.
+ (display-format-alist): New variable mapping frame types to
+ functions that initialize them.
+ (window-system-for-display): New function: interprets
+ display-format-alist.
+ (make-frame-on-display): Remove existing display-selection logic
+ and just forward to make-frame, which will now DTRT.
+ (make-frame): Restructure to use window-system-for-display to
+ figure out how to create a frame on a given display.
+ (display-mouse-p): Look for frame-type w32, not a particular
+ system-type.
+
+ * loadup.el: Load w32 lisp code when we have the w32 feature.
+
+ * mouse.el (mouse-yank-primarY): Look for frame-type w32, not
+ system-type windows-nt.
+
+ * server.el (server-create-window-system-frame): Look for window
+ type.
+ (server-proces-filter): Only force a window system when windows-nt
+ _and_ w32. Explain why.
+
+ * simple.el (normal-erase-is-backspace-mode): Add w32 to the list
+ of window systems we configure for the mode.
+
+ * startup.el (command-line): Mark window system is initialized
+ after we've done it.
+
+ * common-win.el (x-select-text): Look for w32, not windows-nt.
+
+ * ns-win.el: Require cl-lib. Add ourselves to
+ display-format-alist.
+ (ns-initialize-window-system): Assert we're not initialized twice.
+
+ * w32-win.el: Enable lexical binding; require cl-lib; add
+ ourselves to display-format-alist.
+ (w32-handle-dropped-file): Convert incoming dropped files from
+ Windows paths to Cygwin ones before passing them on to the rest of
+ Emacs.
+ (w32-drag-n-drop): New paramter new-frame. Simplify logic.
+ (w32-initialize-window-system): Assert we're not initialized twice.
+
+ * x-win.el: Require cl-lib; add ourselves to display-format-alist.
+ (x-initialize-window-system): Assert we're not initialized twice.
+
+ * w32-common-fns.el: New File.
+ (w32-version, w32-using-nt, w32-get-clipboard-data)
+ (w32-set-clipboard-data, x-set-selection, x-get-selection)
+ (w32-charset-info-alist, x-last-selected, text)
+ (x-get-selection-value, x-selection-value): Move here.
+
+ * w32-fns.el: Require w32-common-fns.
+ (w32-version, w32-using-nt, w32-get-clipboard-data)
+ (w32-set-clipboard-data, x-set-selection, x-get-selection)
+ (w32-charset-info-alist, x-last-selected, text)
+ (x-get-selection-value, x-selection-value): Move to
+ w32-common-fns.
+
+ * w32-vars.el:
+ (w32-allow-system-shell, w32-system-shells): Define only in
+ non-cygwin case.
+
+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>
+
+ * shell.el (shell-file-name-chars, shell-file-name-quote-list)
+ (shell-dynamic-complete-functions): Convert to defcustom.
+ (shell-prompt-pattern, shell-completion-fignore): Doc fix.
+
+ * bookmark.el (bookmark-bmenu-toggle-filenames): Doc fixes.
+ * comint.el (comint-prompt-read-only):
+ * custom.el (defcustom):
+ * hi-lock.el (hi-lock-mode):
+ * ibuffer.el (ibuffer-formats):
+ * ielm.el (ielm-prompt-read-only):
+ * novice.el (disable-command):
+ * saveplace.el (toggle-save-place):
+ * speedbar.el (speedbar-supported-extension-expressions):
+ * startup.el (auto-save-list-file-prefix, init-file-user)
+ (after-init-hook, inhibit-startup-echo-area-message):
+ * strokes.el (strokes-help):
+ * time-stamp.el (time-stamp):
+ * calendar/calendar.el (calendar, diary-file):
+ * calendar/diary-lib.el (diary-mail-entries, diary)
+ (diary-list-entries-hook):
+ * calendar/holidays.el (holidays, calendar-holidays):
+ * calendar/lunar.el (lunar-phases):
+ * calendar/solar.el (sunrise-sunset):
+ * emulation/edt.el (edt-load-keys):
+ * emulation/viper.el (viper-mode):
+ * eshell/em-alias.el (eshell-command-aliases-list):
+ * eshell/esh-util.el (eshell-convert-numeric-arguments):
+ * international/ogonek.el (ogonek-information):
+ * net/tramp-cmds.el (tramp-bug):
+ * net/quickurl.el (quickurl-reread-hook-postfix):
+ * play/decipher.el (decipher-font-lock-keywords):
+ * progmodes/cc-styles.el (c-set-style):
+ * progmodes/idlw-shell.el (idlwave-shell-prompt-pattern):
+ * progmodes/inf-lisp.el (inferior-lisp-prompt):
+ * progmodes/octave-mod.el (octave-mode):
+ * progmodes/sql.el (sql-mode, sql-interactive-mode, sql-password):
+ * progmodes/verilog-mode.el (verilog-read-defines):
+ * textmodes/two-column.el (2C-mode): Likewise.
+
+2012-09-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mail/mailabbrev.el (mail-abbrev-expand-hook): Work for a mail aliasee
+ that holds many addresses.
+
+2012-09-16 Chong Yidong <cyd@gnu.org>
+
+ * align.el (align-areas): Call the indication function with
+ positions instead of markers for arguments (Bug#12343).
+
+ * files.el (parse-colon-path): Use split-string (Bug#12351).
+
+ * window.el (special-display-popup-frame): Doc fix (Bug#8853).
+ (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.
+ (compilation-error-regexp-alist): Doc fix.
+
+2012-09-15 Glenn Morris <rgm@gnu.org>
+
+ * version.el (emacs-bzr-version-bzr): New function.
+ (emacs-bzr-get-version): Add optional EXTERNAL argument.
+
+ * vc/vc-bzr.el (vc-bzr-working-revision): For lightweight local
+ checkouts, check the parent dirstate matches the branch.
+ Add "--tree" to "bzr revno" arguments. Don't try to shorten the
+ empty string.
+
+ * version.el (emacs-bzr-version): Doc fix.
+ (emacs-bzr-version-dirstate): New function.
+ (emacs-bzr-get-version): For lightweight checkouts, if the parent
+ is local try and check that it matches the branch. If not, just
+ use dirstate information. (Bug#12441)
+
+2012-09-14 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-do-chmod): Use `eq' to detect empty input.
+ (Bug#12399)
+
+2012-09-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el (ad-prognify): Remove, use macroexp-progn.
+
+ * emacs-lisp/edebug.el: Miscellaneous cleanup.
+ Remove obsolete byte-compiler hack that tried to silence some warnings.
+ (edebug-submit-bug-report): Remove.
+ (edebug-get-buffer-window, edebug-sit-for, edebug-input-pending-p):
+ Remove aliases, use the un-prefixed name instead.
+ (edebug-pop-to-buffer): Consider other frames.
+ (edebug-original-read):: Make it more obvious that it's always defined.
+ (edebug--make-form-data-entry, edebug--form-data-name)
+ (edebug--form-data-begin, edebug--form-data-end): Rename from the
+ single-dashed name, and implement with cl-defstruct.
+ (edebug-set-form-data-entry): Use the standard accessors.
+ (edebug-make-top-form-data-entry): Use push.
+ (edebug-no-match): Drop useless `funcall'.
+ (mapcar, mapconcat, mapatoms, apply, funcall): Don't add debug specs
+ to functions.
+ (defsubst, dont-compile, eval-when-compile, eval-and-compile)
+ (delay-mode-hooks, with-temp-file, with-temp-message, ad-dolist)
+ (with-syntax-table, push, pop, 1value, noreturn, defadvice)
+ (easy-menu-define, with-custom-print): Remove redundant specs.
+ (edebug-outside-overriding-local-map)
+ (edebug-outside-overriding-terminal-local-map): Remove, unused.
+ (edebug--display): Bind unread-command-events directly to nil rather
+ than binding it to unread-command-events and later setting it to nil.
+ (edebug--display): Kill edebug-eval-buffer here...
+ (edebug--recursive-edit): ...rather than here.
+ Bind standard-output and standard-input.
+ (edebug-eval): Check cl-macroexpand-all is fboundp.
+ (edebug-temp-display-freq-count): Fix last change.
+
+ * emacs-lisp/easymenu.el (easy-menu-define): Add `debug' spec.
+ * subr.el (noreturn, 1value): Add `debug' spec.
+ * emacs-lisp/advice.el: Require cl-lib.
+ (ad-copy-tree): Remove, use copy-tree instead.
+ (ad-dolist): Remove use dolist or cl-dolist instead.
+ (ad-do-return): Remove, use cl-return instead.
+ (defadvice): Add `debug' spec.
+
+2012-09-13 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-do-chxxx): Use `eq' to detect empty input.
+ (Bug#12399)
+
+2012-09-13 Glenn Morris <rgm@gnu.org>
+
+ * calc/calc.el (math-compose-expr):
+ * calc/calc-ext.el (math-compose-expr):
+ * progmodes/cc-defs.el (cl-macroexpand-all):
+ * progmodes/cc-langs.el (delete-duplicates, mapcan)
+ (cl-macroexpand-all): Update declarations.
+
+ * vc/vc.el: No need to require ediff.
+ (ediff-load-version-control): Declare.
+ (ediff-vc-internal): Fix declaration.
+ (vc-version-ediff): Require ediff.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use a more backwards-compatible timer format (Bug#12430).
+ * emacs-lisp/timer.el (timer): PSECS is now at the end, rather than
+ being right after USECS, as that better supports old code that
+ inadvisedly looked directly at the timer vector.
+
+2012-09-13 Kenichi Handa <handa@gnu.org>
+
+ * language/chinese.el ("Chinese-GB", "Chinese-BIG5")
+ ("Chinese-CNS", "Chinese-EUC-TW"): Add chinese-gbk to
+ `coding-priority' property of these language environment.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix glitches caused by addition of psec to timers (Bug#12430).
+ * image.el (image-animate-timer):
+ * time.el (display-time-world-timer):
+ Use timer--function and timer--args rather than raw access to
+ timer vector.
+
+2012-09-13 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-warning-prefix):
+ If not compiling a file, try using load-file-name.
+
+2012-09-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el (edebug-outside-unread-command-events):
+ Fix last change.
+ (edebug-update-eval-list): Use `push'.
+
+ * emacs-lisp/edebug.el: Use lexical-binding.
+ Remove the "edebug-" prefix from non-dynamically-scoped variables.
+ Mark unused args with underscore.
+ (edebug-save-restriction, edebug-outside-excursion): Use `declare'.
+ (edebug-form-data): Use defvar-local.
+ (edebug-make-before-and-after-form, edebug-make-after-form):
+ Use backquote.
+ (edebug-args, edebug-value, edebug-after-index, edebug-arg-mode):
+ Not dynamically scoped any more.
+ (edebug--enter-trace): Add arguments `function' and `args'.
+ Rename from edebug-enter-trace.
+ (edebug-enter): Call it accordingly. Bind edebug-function explicitly.
+ (edebug--update-coverage): Add `after-index' and `value' args.
+ Rename from edebug-update-coverage.
+ (edebug-slow-after): Call it accordingly.
+ (edebug--recursive-edit): Add arg `arg-mode'. Rename from
+ edebug-recursive-edit.
+ (edebug--display): Call it accordingly. Add args `value',
+ `offset-index', and `arg-mode'. Rename from edebug-display.
+ (edebug-debugger, edebug): Call it accordingly.
+ (edebug-eval-display-list): Use dolist.
+
+2012-09-12 Juri Linkov <juri@jurta.org>
+
+ * info.el (Info-search): Don't check for isearch-mode and
+ isearch-regexp before let-binding search-spaces-regexp to
+ Info-search-whitespace-regexp.
+ (Info-isearch-search): Let-bind Info-search-whitespace-regexp to
+ search-whitespace-regexp if isearch-lax-whitespace or
+ isearch-regexp-lax-whitespace is non-nil.
+ (Info-mode): Don't set local variable search-whitespace-regexp.
+ http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00811.html
+
+2012-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/debug.el (debugger-outer-unread-command-char, debug)
+ (debugger-env-macro): Remove support for unread-command-char.
+
+ * subr.el (set-temporary-overlay-map): Minimize slightly the impact of
+ the temporary map re-appearing on emulation-mode-map-alists.
+
+ * emacs-lisp/edebug.el (def-edebug-form-spec): Remove, it's been broken
+ since 22.1.
+
+ * ehelp.el (with-electric-help): Accept functions in
+ electric-help-form-to-execute.
+ (electric-help-execute-extended, electric-help-ctrl-x-prefix): Use it.
+ And replace unread-command-char -> unread-command-events.
+
+2012-09-12 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.6.
+
+ * net/tramp.el (tramp-accept-process-output): Don't use
+ JUST-THIS-ONE in the XEmacs case.
+
+ * net/trampver.el: Update release number.
+
+2012-09-12 Martin Rudalics <rudalics@gmx.at>
+
+ * emacs-lisp/debug.el (debugger-previous-window-height):
+ New variable.
+ (debug): When debugger-jumping-flag is non-nil try to restore
+ height of debugger window. (Bug#8789)
+
+2012-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el (edebug-enter): Don't mess with
+ overriding-local-map and pre/post-command-hook here.
+ (edebug-recursive-edit): Do it here instead (bug#12345).
+ (edebug-outside-unread-command-char): Remove all uses of
+ unread-command-char.
+
+ * emacs-lisp/debug.el (debug): Don't bind debug-on-error since
+ inhibit-debugger is bound instead.
+
+2012-09-11 Bastien Guerry <bzg@gnu.org>
+
+ * subr.el (set-temporary-overlay-map): Add a docstring.
+ (Bug#12346)
+
+2012-09-11 Bastien Guerry <bzg@gnu.org>
+
+ * minibuffer.el (completion-table-subvert): Fix docstring.
+ (Bug#12347)
+
+2012-09-11 Bastien Guerry <bzg@gnu.org>
+
+ * help-fns.el (describe-variable): Fix typo. (Bug#12346)
+
+2012-09-10 Michael R. Mauger <mmaug@yahoo.com>
+
+ * progmodes/sql.el: Version 3.1
+ (sql-db2-escape-newlines): New variable.
+ (sql-escape-newlines-filter): Use it.
+
+2012-09-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * custom.el (custom-theme-load-confirm): Remove unneeded assignment.
+
+2012-09-10 Dan Nicolaescu <dann@gnu.org>
+
+ * vc/diff-mode.el (diff-mode-menu):
+ Bind diff-remove-trailing-whitespace.
+
+2012-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp-mode.el (emacs-list-byte-code-comment-re): New var.
+ (emacs-lisp-byte-code-comment, emacs-lisp-byte-code-syntax-propertize)
+ (emacs-lisp-byte-code-mode): New functions.
+ (eval-sexp-add-defvars): Don't skip defvars in column >0.
+ (eval-defun-2): Remove bogus interactive spec.
+ (lisp-indent-line): Remove redundant whole-exp code, now done in
+ indent-according-to-mode.
+ (save-match-data): Remove redundant indent data.
+
+ * emacs-lisp/benchmark.el (benchmark-run, benchmark-run-compiled):
+ Use `declare'.
+
+2012-09-09 Juri Linkov <juri@jurta.org>
+
+ * replace.el (replace-regexp-lax-whitespace): New defcustom.
+ (replace-lax-whitespace, query-replace-regexp)
+ (query-replace-regexp-eval, replace-regexp): Doc fix.
+ (perform-replace, replace-highlight): Let-bind
+ isearch-lax-whitespace to replace-lax-whitespace and
+ isearch-regexp-lax-whitespace to replace-regexp-lax-whitespace.
+
+ * isearch.el (isearch-query-replace): Let-bind
+ replace-lax-whitespace to isearch-lax-whitespace and
+ replace-regexp-lax-whitespace to
+ isearch-regexp-lax-whitespace. (Bug#10885)
+
+2012-09-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eshell/em-unix.el (eshell/sudo): Explicitly drop return value.
+
+2012-09-09 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-engine.el (c-state-cache-init):
+ Initialise c-state-semi-nonlit-pos-cache\(-limit\)? properly.
+ (c-record-parse-state-state):
+ Record c-state-semi-nonlit-pos-cache\(-limit\)?.
+
+2012-09-09 Andreas Schwab <schwab@linux-m68k.org>
+
+ * register.el (register-separator): Rename from
+ separator-register. All uses changed. Doc fix.
+ (register): Fix version.
+
+2012-09-09 Chong Yidong <cyd@gnu.org>
+
+ * replace.el (query-replace-map): Bind four new symbols for
+ requesting window scrolling.
+
+ * subr.el (y-or-n-p): Handle the window-scrolling bindings in
+ query-replace-map (Bug#8948).
+
+ * custom.el (custom-theme-load-confirm): Use y-or-n-p.
+
+ * emacs-lisp/map-ynp.el (map-y-or-n-p): Don't bind scrolling keys
+ since they are now in query-replace-map.
+
+ * window.el (scroll-other-window-down): Make the arg optional.
+
+2012-09-09 Chong Yidong <cyd@gnu.org>
+
+ * files.el (hack-local-variables-confirm): Use quit-window to kill
+ the *Local Variables* buffer.
+
+2012-09-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-toggle-block): Guess the current block,
+ not just expect to be at its beginning. Adjust callees.
+ Succeed when do-end block has no space before the pipe character.
+ (ruby-brace-to-do-end): When the original block is one-liner,
+ convert to multiline. Reindent the result.
+
+2012-09-08 Jambunathan K <kjambunathan@gmail.com>
+
+ * register.el (register): New group.
+ (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
+ `separator-register'.
+
+2012-09-08 Alan Mackenzie <acm@muc.de>
+
+ AWK Mode: make auto-newline work when there's "==" in the pattern.
+ * progmodes/cc-cmds.el (c-point-syntax): Handle virtual semicolons
+ correctly.
+ * progmodes/cc-engine.el (c-guess-basic-syntax CASE 5A.3):
+ Test more rigorously for "=" token.
+
+2012-09-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-match-expression-expansion):
+ Only fail when reached LIMIT.
+
+2012-09-08 Chong Yidong <cyd@gnu.org>
+
+ * dired.el (dired-mode-map): Don't bind M-=.
+
+ * dired-aux.el (dired-diff): Use backup file as default.
+
+2012-09-08 Drew Adams <drew.adams@oracle.com>
+
+ * subr.el (add-to-history): Fix delete usage (Bug#12314).
+
+2012-09-08 Chong Yidong <cyd@gnu.org>
+
+ * subr.el (syntax-after, syntax-class): Doc fix.
+
+2012-09-08 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-in-previous-window): New buffer
+ display action function.
+
+ * emacs-lisp/debug.el (debugger-bury-or-kill): New option.
+ (debugger-previous-window): New variable.
+ (debug): Rewrite using display-buffer-in-previous-window,
+ quit-restore-window and debugger-bury-or-kill. (Bug#8789)
+
+2012-09-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/byte-run.el (defun): Tweak message. Simplify code.
+
+2012-09-07 Matt McClure <mlm@aya.yale.edu> (tiny change)
+
+ * progmodes/python.el (python-shell-send-string):
+ When default-directory is remote, create temp file on remote
+ filesystem.
+ (python-shell-send-file): When file is remote, pass local view of
+ file paths to remote Python interpreter. (Bug#12340)
+
+2012-09-07 Chong Yidong <cyd@gnu.org>
+
+ * window.el (switch-to-buffer): Doc fix (Bug#12181).
+
+ * files.el (after-find-file): Don't fail on a read-only buffer if
+ require-final-newline is `visit' or `visit-save' (Bug#11156).
+
+ * subr.el (read-char-choice): Allow quitting via ESC ESC.
+
+ * userlock.el (ask-user-about-supersession-threat):
+ Use read-char-choice (Bug#12093).
+
+2012-09-07 Chong Yidong <cyd@gnu.org>
+
+ * subr.el (buffer-narrowed-p): New function.
+
+ * ses.el (ses-widen):
+ * simple.el (count-words--buffer-message):
+ * net/browse-url.el (browse-url-of-buffer): Use it.
+
+ * simple.el (count-words-region): Don't signal an error if there
+ is a non-nil prefix arg and the mark is not set.
+
+ * help.el (describe-key-briefly): Allow the message to be seen
+ when invoked from the minibuffer (Bug#7014).
+
+2012-09-07 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-end-of-defun)
+ (ruby-beginning-of-defun): Simplify, allow indentation before
+ block beginning and end keywords.
+ (ruby-beginning-of-defun): Only consider 3 keywords defun beginners.
+ (ruby-end-of-defun): Expect that the point is at the beginning of
+ the defun.
+
+2012-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl--do-arglist): Understand _ on &key args
+ (bug#12367).
+ (cl--make-usage-args): Strip _ from argument names.
+
+2012-09-06 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * progmodes/vhdl-mode.el (vhdl-speedbar-initialize): Don't use
+ obsolete alias speedbar-key-map.
+ (vhdl-doc-variable, vhdl-doc-mode): Use called-interactively-p.
+ (vhdl-index-menu-init): Don't use obsolete variable
+ font-lock-maximum-size.
+
+2012-09-06 Chong Yidong <cyd@gnu.org>
+
+ * frame.el (window-system-version): Mark as obsolete.
+
+ * speedbar.el (speedbar-update-flag, speedbar-mode): Remove uses
+ of obsolete variable speedbar-key-map.
+
+2012-09-06 Juri Linkov <juri@jurta.org>
+
+ * replace.el (replace-lax-whitespace): New defcustom.
+ (query-replace, query-replace-regexp, query-replace-regexp-eval)
+ (replace-string, replace-regexp): Mention it in docstrings.
+ (perform-replace, replace-highlight): Let-bind
+ isearch-lax-whitespace and isearch-regexp-lax-whitespace according
+ to the values of replace-lax-whitespace and regexp-flag.
+ Don't let-bind search-whitespace-regexp. (Bug#10885)
+
+ * isearch.el (isearch-query-replace): Let-bind
+ replace-lax-whitespace instead of let-binding
+ replace-search-function and replace-re-search-function.
+ (isearch-lazy-highlight-search): Let-bind isearch-lax-whitespace
+ and isearch-regexp-lax-whitespace to lazy-highlight variables.
+ (isearch-toggle-symbol): Set isearch-regexp to nil
+ in isearch-word mode (like in isearch-toggle-word).
+
+2012-09-06 Juri Linkov <juri@jurta.org>
+
+ * replace.el (replace-search-function)
+ (replace-re-search-function): Set default values to nil.
+ (perform-replace): Let-bind isearch-related variables based on
+ replace-related values, call `isearch-search-fun' and let-bind
+ the result to `search-function'. Remove code that sets
+ `search-function' and `search-string' separately for
+ `delimited-flag'.
+ (replace-highlight): Add new argument `delimited-flag' and
+ rename other arguments to the names used in `perform-replace'.
+ Let-bind `isearch-word' to the argument `delimited-flag'.
+ (Bug#10885, bug#10887)
+
+2012-09-07 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-indent-beg-re): Add pieces from
+ ruby-beginning-of-indent, simplify, allow all keywords to have
+ indentation before them.
+ (ruby-beginning-of-indent): Adjust for above. Search until the
+ found point is not inside a string or comment.
+ (ruby-font-lock-keywords): Allow symbols to start with "@"
+ character, give them higher priority than variables.
+ (ruby-syntax-propertize-function)
+ (ruby-font-lock-syntactic-keywords): Remove the "not comments"
+ matchers. Expression expansions are not comments when inside a
+ string, and there comment syntax status is irrelevant.
+ (ruby-match-expression-expansion): New function. Check that
+ expression expansion is inside a string, and it's not escaped.
+ (ruby-font-lock-keywords): Use it.
+
+2012-09-05 Martin Rudalics <rudalics@gmx.at>
+
+ * help.el (temp-buffer-max-height): New default value.
+ (temp-buffer-resize-frames): New option.
+ (resize-temp-buffer-window): Optionally resize frame.
+
+ * window.el (fit-frame-to-buffer-bottom-margin): New option.
+ (fit-frame-to-buffer): New function.
+
+2012-09-05 Glenn Morris <rgm@gnu.org>
+
+ * emulation/cua-rect.el (cua--init-rectangles):
+ * textmodes/picture.el (picture-mode-map):
+ * play/blackbox.el (blackbox-mode-map): Remap right-char and left-char
+ like forward-char and backward-char. (Bug#12317)
+
+2012-09-05 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/flymake.el (flymake-warning-re): New variable.
+ (flymake-parse-line): Use it.
+
+2012-09-05 Glenn Morris <rgm@gnu.org>
+
+ * calendar/holidays.el (holiday-christian-holidays):
+ Rename an entry. (Bug#12289)
+
+2012-09-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el (sh-font-lock-paren): Don't burp at BOB
+ (bug#12222).
+
+2012-09-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * loadup.el: Load macroexp. Remove hack.
+ * emacs-lisp/macroexp.el (macroexp--eval-if-compile): New function.
+ (macroexp--expand-all): Use it to get better warnings.
+ (macroexp--backtrace, macroexp--trim-backtrace-frame)
+ (internal-macroexpand-for-load): New functions.
+ (macroexp--pending-eager-loads): New var.
+ (emacs-startup-hook): New hack to replace one in loadup.el.
+ * emacs-lisp/cl-macs.el (cl--compiler-macro-list*)
+ (cl--compiler-macro-cXXr): Move to top, before they can be used.
+ (cl-psetf): Simplify.
+ (cl-defstruct): Add indent rule.
+
+2012-09-04 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mail/smtpmail.el (smtpmail-send-it): Prefer the From: header
+ over `user-mail-address' for the SMTP MAIL FROM envelope.
+ (smtpmail-via-smtp): Ditto.
+
+2012-09-04 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el: Clean up keybindings.
+ (ruby-mode-map): Don't bind ruby-electric-brace,
+ ruby-beginning-of-defun, ruby-end-of-defun, ruby-mark-defun,
+ backward-kill-word, reindent-then-newline-and-indent.
+ (ruby-mark-defun): Remove.
+ (ruby-electric-brace): Remove. Obsoleted by electric-indent-chars.
+ (ruby-mode): Set local beginning-of-defun-function and
+ end-of-defun-function values.
+
+2012-09-03 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (temp-buffer-window-setup-hook)
+ (temp-buffer-window-show-hook): New hooks.
+ (temp-buffer-window-setup, temp-buffer-window-show)
+ (with-temp-buffer-window): New functions.
+ (fit-window-to-buffer): Remove unused optional argument OVERRIDE.
+ (special-display-popup-frame): Make sure the window used shows BUFFER.
+
+ * help.el (temp-buffer-resize-mode): Fix doc-string.
+ (resize-temp-buffer-window): New optional argument WINDOW.
+
+ * files.el (recover-file, save-buffers-kill-emacs):
+ * dired.el (dired-mark-pop-up): Use with-temp-buffer-window.
+
+2012-09-02 Michael Albinus <michael.albinus@gmx.de>
+
+ * eshell/em-unix.el (eshell/sudo): When we have an ad-hoc
+ remote definition of `default-directory', ensure we can connect.
+
+2012-09-02 Juri Linkov <juri@jurta.org>
+
+ Toggle whitespace matching mode with M-s SPC.
+ http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00008.html
+
+ * isearch.el (search-whitespace-regexp): Doc fix.
+ Remove cons cell customization.
+ (isearch-mode-map): Bind "\M-s " to isearch-toggle-lax-whitespace.
+ (isearch-lax-whitespace, isearch-regexp-lax-whitespace):
+ New variables.
+ (isearch-forward, isearch-forward-regexp): Doc fix.
+ (isearch-toggle-lax-whitespace): New command.
+ (search-forward-lax-whitespace, search-backward-lax-whitespace)
+ (re-search-forward-lax-whitespace)
+ (re-search-backward-lax-whitespace): New functions.
+ (isearch-whitespace-regexp): Remove function.
+ (isearch-query-replace): Let-bind replace-search-function and
+ replace-re-search-function.
+ (isearch-occur): Let-bind search-spaces-regexp according to the
+ value of isearch-lax-whitespace and isearch-regexp-lax-whitespace.
+ (isearch-quote-char): Check isearch-regexp-lax-whitespace in the
+ condition for C-q SPC.
+ (isearch-search-fun-default): Use new functions mentioned above.
+ (isearch-search-forward, isearch-search-backward): Remove functions.
+ (isearch-search): Don't let-bind search-spaces-regexp.
+ (isearch-lazy-highlight-space-regexp): Remove variable.
+ (isearch-lazy-highlight-lax-whitespace)
+ (isearch-lazy-highlight-regexp-lax-whitespace): New variables.
+ (isearch-lazy-highlight-new-loop): Use them.
+ (isearch-lazy-highlight-search): Don't let-bind search-spaces-regexp.
+
+2012-09-02 Chong Yidong <cyd@gnu.org>
+
+ * dired.el (dired-mode-map): Menu string fixes (Bug#11616).
+
+2012-09-02 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (undo): Tweak message in undo-only case. (Bug#12283)
+
+2012-09-01 Glenn Morris <rgm@gnu.org>
+
+ * term.el: Tidy up menu definitions.
+ (term-mode-map): Use easymenu for In/Out, Complete menus.
+ (term-pager-break-map): Initialize in the defvar.
+ (term-terminal-menu, term-signals-menu): Define with easymenu.
+ (term-terminal-menu): Also show it in line-mode. (Bug#11957)
+ (term-pager-menu): New, extracted from term-process-pager.
+ (term-mode, term-char-mode, term-process-pager): Use easymenu-add.
+ (term-update-mode-line): Propertize line/char and page items.
+ (term-process-pager): Move keymap initialization elsewhere.
+
+2012-09-01 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (switch-to-prev-buffer): Handle additional values of
+ BURY-OR-KILL argument. Don't switch in minibuffer window.
+ (switch-to-next-buffer): Don't switch in minibuffer window.
+ (quit-restore-window): New function based on quit-window.
+ Handle additional values of former KILL argument.
+ (quit-window): Call quit-restore-window with appropriate
+ interpretation of KILL argument.
+ (display-buffer-below-selected): New buffer display action
+ function.
+
+2012-09-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-at-point-functions): Complete docstring
+ (bug#12254).
+
+2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better seed support for (random).
+ * play/5x5.el, play/animate.el, play/cookie1.el, play/dissociate.el:
+ * play/doctor.el, play/dunnet.el, play/gomoku.el, play/landmark.el:
+ * play/mpuz.el, play/tetris.el, play/zone.el:
+ * calc/calc-comb.el (math-init-random-base):
+ * play/blackbox.el (bb-init-board):
+ * play/life.el (life):
+ * server.el (server-use-tcp):
+ * type-break.el (type-break):
+ Remove unnecessary call to (random t).
+ * net/sasl.el (sasl-unique-id-function):
+ Change (random t) to (random), now that the latter is more random.
+ * play/life.el (life-initialized): Remove no-longer-needed var.
+
+2012-08-31 Alp Aker <alp.tekin.aker@gmail.com>
+
+ * window.el (switch-to-prev-buffer, switch-to-next-buffer):
+ Consider frame's buffer predicate when choosing the buffer.
+ (Bug#12081)
+
+2012-08-30 Richard Stallman <rms@gnu.org>
+
+ * simple.el (special-mode-map): Delete binding for `z'.
+
+2012-08-30 Andreas Schwab <schwab@linux-m68k.org>
+
+ * progmodes/compile.el (compilation-always-kill): Doc fix.
+
+2012-08-30 Chong Yidong <cyd@gnu.org>
+
+ * window.el (display-buffer-reuse-frames): Make the obsolescence
+ message more informative.
+
+2012-08-30 Glenn Morris <rgm@gnu.org>
+
+ * paren.el (show-paren-delay):
+ Add a :set function. Doc fix. (Bug#12297)
+
+2012-08-29 Martin Blais <blais@furius.ca> (tiny change)
+
+ * progmodes/compile.el (compilation-always-kill): New var.
+ (compilation-start): Use it.
+
+2012-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (read-only-mode): Move from files.el for bootstrapping.
+ * files.el (read-only-mode): Move to simple.el.
+
+ * files.el (read-only-mode): New minor mode.
+ (toggle-read-only): Use it and mark obsolete.
+ (find-file--read-only):
+ * vc/vc.el (vc-next-action, vc-checkout):
+ * vc/vc-cvs.el (vc-cvs-checkout):
+ * obsolete/vc-mcvs.el (vc-mcvs-update):
+ * ffap.el (ffap--toggle-read-only): Update callers.
+
+2012-08-29 Michael Albinus <michael.albinus@gmx.de>
+
+ * eshell/esh-ext.el (eshell-external-command): Do not examine
+ remote shell scripts.
+ See <https://bugs.launchpad.net/ubuntu/+source/emacs23/+bug/1035790>.
+
+ * net/tramp-sh.el (tramp-remote-path): Add "/sbin" and
+ "/usr/local/sbin".
+
+2012-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el (buffer-string): Fix setter macro (bug#12293).
+
+2012-08-28 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/sh-script.el (sh-dynamic-complete-functions): Adapt to
+ completion-at-point. (Bug#12220)
+
+ * skeleton.el (skeleton-untabify): Change to nil (bug#12223).
+
+ * progmodes/sh-script.el (sh-indent-comment): Change to t (bug#12267).
+
+2012-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files.el (safe-local-eval-forms): Fix before-save-hook entry to
+ be buffer-local; add delete-trailing-whitespace (bug#12259).
+
+2012-08-28 Jeremy Moore <jmoore@ieee.org> (tiny change)
+
+ * progmodes/hideif.el (hif-compress-define-list):
+ Fix typo. (Bug#11951)
+
+2012-08-28 Dan Nicolaescu <dann@gnu.org>
+
+ * progmodes/hideshow.el (hs-block-end-regexp): Restore lost
+ buffer local setting.
+
+ * net/rcirc.el (rcirc-split-message): Fix for buffer-local
+ rcirc-encode-coding-system.
+
+2012-08-28 Leo Liu <sdl.web@gmail.com>
+
+ * net/rcirc.el (rcirc-split-message): New function.
+ (rcirc-send-message): Use it. (Bug#12051)
+
+2012-08-28 Juri Linkov <juri@jurta.org>
+
+ * info.el (Info-fontify-node): Hide empty lines at the end of
+ the node. (Bug#12272)
+
+2012-08-27 Drew Adams <drew.adams@oracle.com>
+
+ * dired.el (dired-pop-to-buffer): Make window start at beginning
+ of buffer (Bug#12281).
+
+2012-08-26 Chong Yidong <cyd@gnu.org>
+
+ * window.el (special-display-regexps, special-display-frame-alist)
+ (special-display-buffer-names, special-display-function)
+ (display-buffer-reuse-frames): Mark as obsolete.
+
+ * progmodes/compile.el: Don't use display-buffer-reuse-frames.
+
+ * help.el (help-print-return-message): Don't treat
+ display-buffer-reuse-frames specially.
+
+2012-08-26 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-display-buffer-other-frame-action):
+ New variable, replacing gdb-frame-parameters.
+ (gdb-frame-io-buffer, gdb-frame-breakpoints-buffer)
+ (gdb-frame-threads-buffer, gdb-frame-memory-buffer)
+ (gdb-frame-disassembly-buffer, gdb-frame-stack-buffer)
+ (gdb-frame-locals-buffer, gdb-frame-registers-buffer): Use it.
+ (def-gdb-frame-for-buffer): Macro deleted. It is easier to define
+ the functions directly with gdb-display-buffer-other-frame-action.
+ (gdb-display-breakpoints-buffer, gdb-display-threads-buffer)
+ (gdb-display-memory-buffer, gdb-display-disassembly-buffer)
+ (gdb-display-stack-buffer, gdb-display-locals-buffer)
+ (gdb-display-registers-buffer): Define directly.
+ (def-gdb-display-buffer): Macro deleted.
+ (gdb-display-buffer): Remove second and third args, callers don't
+ use them. Defer to the default display-buffer behavior, apart
+ from making windows dedicated.
+ (gdb-setup-windows): Don't call display-buffer unnecessarily.
+
+ * progmodes/gud.el (gud-display-line): Just use display-buffer.
+
+ * window.el (display-buffer-pop-up-frame): Handle a
+ pop-up-frame-parameters alist entry.
+ (display-buffer): Document it.
+
+2012-08-26 Chong Yidong <cyd@gnu.org>
+
+ * isearch.el (search-whitespace-regexp): Make string and nil
+ values apply to both ordinary and regexp search. Allow a cons
+ cell value to distinguish between the two.
+ (isearch-whitespace-regexp, isearch-search-forward)
+ (isearch-search-backward): New functions.
+ (isearch-occur, isearch-search-fun-default, isearch-search)
+ (isearch-lazy-highlight-new-loop): Use them.
+ (isearch-forward, isearch-forward-regexp): Doc fix.
+
+2012-08-26 Chong Yidong <cyd@gnu.org>
+
+ * faces.el (help-argument-name): Always inherit from italic
+ (Bug#12213).
+
+2012-08-25 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--even-window-heights): Even heights when
+ WINDOW and the selected window form a vertical combination.
+ (display-buffer-use-some-window): Provide that window used gets
+ sized back by quit-window. (Bug#11880) and (Bug#12091)
+
+2012-08-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix file time stamp problem with bzr and CVS (Bug#12001).
+ * vc/vc-cvs.el (vc-cvs-parse-entry): Ignore subsecond information
+ in the file's time stamp, since the version control system loses
+ that information.
+
+2012-08-22 Juri Linkov <juri@jurta.org>
+
+ * info.el (Info-fontify-node): Hide the suffix of the
+ Info file name in the header line. (Bug#12187)
+
+2012-08-22 Glenn Morris <rgm@gnu.org>
+
+ * calendar/cal-tex.el (cal-tex-weekly-common):
+ Restore leading blank page.
+
+2012-08-22 Le Wang <l26wang@gmail.com> (tiny change)
+
+ * misc.el (forward-to-word, backward-to-word): Activate or extend
+ the region under `shift-select-mode'. (Bug#12231)
+
+2012-08-22 Bastien Guerry <bzg@gnu.org>
+
+ * progmodes/executable.el (executable-prefix): Set to "#!" instead
+ of "#! ". http://www.in-ulm.de/~mascheck/various/shebang/#details
+ gives details on why the space is never needed.
+
+2012-08-22 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (walk-window-tree, window-with-parameter):
+ New optional argument MINIBUF to control whether these functions
+ should run on the minibuffer window.
+ (window-at-side-list): Don't operate on minibuffer window.
+ (window-in-direction): Simplify and rewrite doc-string.
+ (window--size-ignore): Rename to window--size-ignore-p.
+ Update callers.
+ (display-buffer-in-atom-window, window--major-non-side-window)
+ (window--major-side-window, display-buffer-in-major-side-window)
+ (delete-side-window, display-buffer-in-side-window):
+ New functions.
+ (window--side-check, window-deletable-p, delete-window)
+ (delete-other-windows, split-window): Handle side windows and
+ atomic windows appropriately.
+ (window--display-buffer): Call display-buffer-record-window also
+ when the window buffer did not change.
+
+2012-08-22 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * help-fns.el (help-fns--key-bindings):
+ Abbreviate non-symbol remap targets. (Bug#12174)
+
+2012-08-22 Martin Rudalics <rudalics@gmx.at>
+
+ * dired.el (dired-mark-remembered): Don't clobber point.
+ (Bug#11795)
+
+2012-08-22 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/bug-reference.el (bug-reference): New custom group.
+ (bug-reference-bug-regexp): Make it a defcustom.
+
+2012-08-22 Daiki Ueno <ueno@unixuser.org>
+
+ * progmodes/js.el (js-indent-level, js-expr-indent-offset)
+ (js-paren-indent-offset, js-square-indent-offset)
+ (js-curly-indent-offset): Add :safe (Bug#12257).
+
+2012-08-22 Edward O'Connor <hober0@gmail.com>
+
+ * json.el (json-key-format): Add error properties.
+ (json-encode-key): New function.
+ (json-encode-hash-table, json-encode-alist, json-encode-plist):
+ Use json-encode-key.
+
+2012-08-22 Glenn Morris <rgm@gnu.org>
+
+ * calendar/cal-tex.el (cal-tex-longday): New function, replacing...
+ (cal-tex-leftday, cal-tex-rightday): Remove functions.
+ (cal-tex-weekly-common, cal-tex-cursor-filofax-2week):
+ Update for above change.
+
+2012-08-21 Andreas Schwab <schwab@linux-m68k.org>
+
+ * cus-face.el (custom-face-attributes): Fix customize type for the
+ :underline attribute. (Bug#11805)
+
+2012-08-21 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-point-1, set-window-point-1): Remove.
+ (window-in-direction, record-window-buffer)
+ (set-window-buffer-start-and-point, split-window-below)
+ (window--state-get-1, display-buffer-record-window):
+ Replace calls to window-point-1 and set-window-point-1 by calls to
+ window-point and set-window-point respectively.
+
+2012-08-21 Glenn Morris <rgm@gnu.org>
+
+ * calendar/cal-tex.el (cal-tex-weekly-common): New function.
+ (cal-tex-cursor-week-at-a-glance, cal-tex-cursor-filofax-week):
+ Use it.
+
+ * calendar/cal-tex.el (cal-tex-rightday): Add optional funcname arg.
+ (cal-tex-shortday): New function.
+ (cal-tex-cursor-week-at-a-glance, cal-tex-cursor-filofax-week)
+ (cal-tex-cursor-filofax-daily): Use the above.
+
+ * calendar/cal-tex.el (cal-tex-leftday, cal-tex-rightday):
+ New functions.
+ (cal-tex-cursor-week-at-a-glance, cal-tex-cursor-filofax-2week)
+ (cal-tex-cursor-filofax-week): Use them.
+
+ * calendar/cal-tex.el (cal-tex-lefthead, cal-tex-righthead):
+ New constants.
+ (cal-tex-cursor-week-at-a-glance, cal-tex-cursor-filofax-2week)
+ (cal-tex-cursor-filofax-week, cal-tex-cursor-filofax-daily): Use them.
+
+ * calendar/cal-tex.el (cal-tex-preamble): Generate new buffers.
+ (cal-tex-end-document): Don't rely on buffer name.
+
+ * calendar/cal-tex.el (cal-tex-cursor-filofax-year):
+ Use cal-tex-vspace.
+ (cal-tex-vspace, cal-tex-hspace, cal-tex-em, cal-tex-bf)
+ (cal-tex-Huge-bf, cal-tex-large-bf): Use cal-tex-cmd.
+ (cal-tex-scriptsize, cal-tex-huge, cal-tex-Huge, cal-tex-large):
+ Use cal-tex-arg.
+
+ * calendar/cal-tex.el (cal-tex-cursor-filofax-year)
+ (cal-tex-cursor-week, cal-tex-cursor-week2)
+ (cal-tex-cursor-week-iso, cal-tex-cursor-week-at-a-glance)
+ (cal-tex-cursor-filofax-2week, cal-tex-cursor-filofax-week)
+ (cal-tex-cursor-filofax-daily, cal-tex-cursor-day)
+ (cal-tex-insert-preamble, cal-tex-b-document)
+ (cal-tex-e-document, cal-tex-b-center, cal-tex-e-center):
+ Improve cal-tex-cmd usage.
+
+ * calendar/cal-tex.el (cal-tex-filofax-paper): New function.
+ (cal-tex-cursor-filofax-year, cal-tex-cursor-filofax-2week)
+ (cal-tex-cursor-filofax-week, cal-tex-cursor-filofax-daily): Use it.
+ (cal-tex-weekly-paper): New function.
+ (cal-tex-cursor-week, cal-tex-cursor-week2)
+ (cal-tex-cursor-week-iso, cal-tex-cursor-week-monday)
+ (cal-tex-cursor-day): Use it.
+
+ * calendar/cal-tex.el (cal-tex-cursor-week-at-a-glance)
+ (cal-tex-cursor-filofax-week): Remove leading blank page.
+
+ * calendar/cal-tex.el (cal-tex-cursor-week-at-a-glance):
+ Add autoload cookie. For now at least, don't use color, since
+ no other cal-tex function does.
+
+ * calendar/cal-tex.el (cal-tex-cursor-week-iso)
+ (cal-tex-cursor-filofax-2week, cal-tex-cursor-filofax-week)
+ (cal-tex-cursor-filofax-daily): Correct start date for diary entries.
+
+2012-08-21 Juri Linkov <juri@jurta.org>
+
+ * info.el (Info-file-attributes): New variable.
+ (info-insert-file-contents): Add file attributes to
+ `Info-file-attributes'. Clear the caches `Info-index-nodes' and
+ `Info-toc-nodes' when previous modtime of the Info file is less
+ than new modtime.
+ (Info-toc-nodes, Info-index-nodes): Move definitions up to the top
+ of info.el. (Bug#12230)
+
+2012-08-20 Glenn Morris <rgm@gnu.org>
+
+ * calendar/diary-lib.el (diary-include-files, diary-sexp-entry):
+ * calendar/holidays.el (calendar-holiday-list):
+ Report errors with display-warning rather than beep'n'sleep.
+
+2012-08-20 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-accept-process-output): Accept only output
+ from PROC. Otherwise, process filters and sentinels might be
+ confused. (Bug#12145)
+
+2012-08-20 Chong Yidong <cyd@gnu.org>
+
+ * descr-text.el (describe-text-properties-1): Use overlays-in to
+ report on empty overlays (Bug#3322).
+
+2012-08-20 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmailout.el (rmail-output-read-file-name):
+ Trap and report errors in rmail-output-file-alist elements.
+
+ * font-lock.el (font-lock-add-keywords): Doc fix (quote face names
+ since most non-font-lock faces are not also variables).
+
+2012-08-20 Edward Reingold <reingold@iit.edu>
+
+ * calendar/cal-tex.el (cal-tex-cursor-week-at-a-glance):
+ New function. (Bug12160)
+
+2012-08-19 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmailout.el (rmail-output-read-file-name):
+ Fix previous change (when the alist is nil or does not match).
+
+2012-08-19 Chong Yidong <cyd@gnu.org>
+
+ * xml.el (xml-escape-string): Don't refer to xml-entity-alist
+ (Bug#12228).
+
+2012-08-18 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (yank-handled-properties): New defcustom.
+ (yank-excluded-properties): Add font-lock-face and category.
+ (yank): Doc fix.
+
+ * subr.el (remove-yank-excluded-properties):
+ Obey yank-handled-properties. The special handling of font-lock-face
+ and category is now done this way, instead of being hard-coded.
+ (insert-for-yank-1): Remove font-lock-face handling.
+ (yank-handle-font-lock-face-property)
+ (yank-handle-category-property): New function.
+
+2012-08-17 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmailout.el (rmail-output-read-file-name):
+ Check rmail-output-file-alist against the full message body
+ in the correct rmail buffer. (Bug#12214)
+
+2012-08-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-start-file-process):
+ Eliminate superfluous prompt. (Bug#12203)
+
+2012-08-17 Chong Yidong <cyd@gnu.org>
+
+ * mouse.el (mouse-appearance-menu): If x-select-font returns a
+ font spec, set the font directly (Bug#3228).
+
+2012-08-17 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (delete-window): Fix last fix.
+
+2012-08-16 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-valid-p): Move to window.c.
+ (window-child, window-child-count, window-last-child)
+ (window-normalize-window, window-combined-p)
+ (window-combinations, window-atom-root, window-min-size)
+ (window-sizable, window-sizable-p, window-size-fixed-p)
+ (window-min-delta, window-max-delta, window--resizable)
+ (window--resizable-p, window-resizable, window-total-size)
+ (window-full-height-p, window-full-width-p, window-body-size)
+ (window-at-side-p, adjust-window-trailing-edge, maximize-window)
+ (minimize-window, window-deletable-p, delete-window)
+ (delete-other-windows, set-window-buffer-start-and-point)
+ (next-buffer, previous-buffer, split-window, balance-windows-2)
+ (set-window-text-height, window-buffer-height)
+ (fit-window-to-buffer, shrink-window-if-larger-than-buffer)
+ (truncated-partial-width-window-p): Minor code adjustments.
+ In doc-strings state whether the argument window has to denote a
+ live, valid or any window.
+
+2012-08-16 Phil Sainty <psainty@orcon.net.nz> (tiny change)
+
+ * progmodes/subword.el (subword-forward-function)
+ (subword-backward-function, subword-forward-regexp)
+ (subword-backward-regexp): New variables.
+ (subword-forward, subword-forward-internal, subword-backward-internal):
+ Use new variables, eg so that different "word" definitions
+ can be easily used. (Bug#11411)
+
+2012-08-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-mtn.el (vc-mtn-revision-completion-table): Handle completion
+ for composite selectors.
+ * vc/vc.el (vc-diff-build-argument-list-internal): Don't prevent
+ operation just because we can't find a previous revision.
+
+2012-08-15 Chong Yidong <cyd@gnu.org>
+
+ * frame.el (set-frame-font): Accept font objects.
+
+2012-08-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/tex-mode.el (tex-insert-quote): ~ is a space (bug#12137).
+
+2012-08-15 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * man.el (Man-overstrike-face, Man-underline-face)
+ (Man-reverse-face): Remove variables.
+ (Man-overstrike, Man-underline, Man-reverse): New faces.
+ (Man-fontify-manpage): Use them instead of the variables.
+ (Man-cleanup-manpage): Comment change.
+ (Man-ansi-color-map): New variable.
+ (Man-fontify-manpage): Use it.
+ Call ansi-color-apply-on-region to replace ad hoc code (bug#12147).
+
+ Implement ANSI SGR parameters 22-27 (bug#12146).
+ * ansi-color.el (ansi-colors): Doc fix.
+ (ansi-color-context, ansi-color-context-region): Doc fix.
+ (ansi-color--find-face): New function.
+ (ansi-color-apply, ansi-color-apply-on-region): Use it.
+ Rename the local variable `face' to `codes' since it is now a list of
+ ansi codes. Doc fix.
+ (ansi-color-get-face): Remove.
+ (ansi-color-parse-sequence): New function, derived from
+ ansi-color-get-face.
+ (ansi-color-apply-sequence): Use it. Rewrite, and support ansi
+ codes 22-27.
+
+2012-08-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (read-passwd): Allow use from a minibuffer.
+
+2012-08-14 Eli Zaretskii <eliz@gnu.org>
+
+ * tooltip.el (tooltip-identifier-from-point): Don't treat tokens
+ inside comments and strings as identifiers.
+
+ * progmodes/gud.el (gud-tooltip-print-command): Quote the
+ expression to evaluate. This allows to evaluate expressions with
+ embedded whitespace.
+ (gud-tooltip-tips): Add a blank before the newline in the
+ message-box text, for the benefit of message-box emulation on
+ MS-Windows.
+
+ * progmodes/gdb-mi.el (gdb-tooltip-print): Don't ignore error
+ messages from GDB, pop them up in a tooltip to give feedback to
+ user.
+ (gdb-tooltip-print-1): Quote the expression to evaluate.
+ This allows to evaluate expressions with embedded whitespace.
+ (gdb-inferior-io--init-proc): Don't send "-inferior-tty" command
+ if the TTY name is nil or empty (which happens when communicating
+ with the inferior via pipes, e.g. on MS-Windows).
+ (gdb-internals): If GDB sends a "&\n" empty debugging message,
+ don't send that to the GUD buffer.
+
+2012-08-14 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-setq-default):
+ Optimize away setq-default with no args, as for setq. (Bug#12195)
+
+2012-08-14 Chong Yidong <cyd@gnu.org>
+
+ * minibuffer.el (read-file-name): Doc fix (Bug#10881).
+
+ * emacs-lisp/regexp-opt.el (regexp-opt-charset): Doc fix
+ (Bug#12085).
+
+2012-08-14 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-recompile-file): Doc fix.
+
+2012-08-14 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-open-shell): Cache the shell name.
+ (tramp-find-shell, tramp-open-connection-setup-interactive-shell):
+ Use cached shell name.
+
+2012-08-14 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (python-shell-send-string):
+ (python-shell-send-setup-code): Do not use `format' with `message'.
+
+2012-08-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el: Improve percent literals (bug#6286).
+ (ruby-percent-literal-beg-re): New constant.
+ (ruby-syntax-general-delimiters-goto-beg): Rename to
+ `ruby-syntax-enclosing-percent-literal', improve literal type check.
+ (ruby-syntax-propertize-general-delimiters): Rename to
+ `ruby-syntax-propertize-percent-literal', it's a shorter and more
+ popular term. Adjust comments everywhere.
+ (ruby-syntax-propertize-percent-literal): Only propertize when not
+ inside a simple string or comment. When the literal is unclosed,
+ leave the text after it unpropertized.
+ (ruby-syntax-methods-before-regexp): New constant.
+ (ruby-syntax-propertize-function): Use it to recognize regexps.
+ Don't look at the text after regexp, just use the whitelist.
+
+2012-08-14 Andreas Schwab <schwab@linux-m68k.org>
+
+ * emacs-lisp/bytecomp.el (byte-recompile-file): When LOAD is
+ non-nil always load the compiled file if it exists. (Bug#12197)
+
+2012-08-14 Chong Yidong <cyd@gnu.org>
+
+ * hi-lock.el (hi-lock-mode): Do not unilaterally enable font lock.
+ (hi-lock-set-pattern): When deciding whether to use font lock or
+ overlays, look at font-lock-mode instead of font-lock-fontified
+ (Bug#12168).
+ (hi-lock-mode, hi-lock-line-face-buffer, hi-lock-unface-buffer)
+ (hi-lock-face-buffer, hi-lock-face-phrase-buffer): Doc fix.
+
+2012-08-14 Daiki Ueno <ueno@unixuser.org>
+
+ * subr.el (internal--after-with-selected-window): Fix typo
+ (Bug#12193).
+
+2012-08-14 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Use `completion-table-dynamic' for completion functions.
+ * progmodes/python.el
+ (python-shell-completion--do-completion-at-point)
+ (python-shell-completion--get-completions):
+ Remove functions.
+ (python-shell-completion-complete-at-point): New function.
+ (python-completion-complete-at-point): Use it.
+
+2012-08-13 Jambunathan K <kjambunathan@gmail.com>
+
+ * vc/vc-dir.el (vc-dir-hide-state): New command (bug#12159).
+ (vc-dir-hide-up-to-date): Route it to `vc-dir-hide-state'.
+
+2012-08-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (function-get): Refine `autoload' arg so it can also
+ autoload functions for gv.el (bug#12191).
+ * emacs-lisp/edebug.el (get-edebug-spec): Adjust so it only
+ autoloads macros.
+
+ * color.el (color-xyz-to-lab, color-lab-to-xyz, color-cie-de2000):
+ Prefer pcase-let over destructuring-bind.
+ * vc/diff-mode.el (diff-remove-trailing-whitespace): Same.
+ Also, remove whitespace as we go, rather than after accumulating the
+ various places.
+
+ * subr.el (internal--before-with-selected-window)
+ (internal--after-with-selected-window): Fix typo seleted->selected.
+ (with-selected-window): Adjust callers.
+ Reported by Dmitry Gutov <dgutov@yandex.ru>.
+
+2012-08-13 Bastien Guerry <bzg@gnu.org>
+
+ * window.el (special-display-popup-frame): Minor docstring
+ enhancement. (Bug#12172)
+
+2012-08-13 Andreas Schwab <schwab@linux-m68k.org>
+
+ * tar-mode.el (tar-header-data-end): Only ignore size for files of
+ type 1-6.
+ (tar-header-block-summarize, tar-get-descriptor): Handle pax
+ extended headers.
+
+ * files.el (hack-local-variables-filter): Remove useless eval.
+
+2012-08-13 Martin Rudalics <rudalics@gmx.at>
+
+ * subr.el (with-selected-window): Fix last change.
+
+2012-08-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (internal--before-with-seleted-window)
+ (internal--after-with-seleted-window): New functions.
+ (with-selected-window): Use them, to replace dependency on
+ tty-top-frame.
+
+2012-08-12 Nobuyoshi Nakada <nobu@ruby-lang.org>
+
+ * progmodes/ruby-mode.el (ruby-mode-map): Remove unnecessary
+ binding for `newline'.
+ (ruby-move-to-block): When moving backward, stop at block opening,
+ not indentation.
+ * progmodes/ruby-mode.el (ruby-brace-to-do-end)
+ (ruby-do-end-to-brace, ruby-toggle-block): New functions.
+ * progmodes/ruby-mode.el (ruby-mode-map): Add binding for
+ `ruby-toggle-block'.
+
+2012-08-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ibuffer.el (ibuffer-do-toggle-read-only):
+ * dired.el (dired-toggle-read-only):
+ * buff-menu.el (Buffer-menu-toggle-read-only):
+ * bindings.el (mode-line-toggle-read-only):
+ * bs.el (bs-toggle-readonly): Call toggle-read-only interactively.
+
+2012-08-12 Andreas Schwab <schwab@linux-m68k.org>
+
+ * descr-text.el (describe-char): Put the overlays over the
+ "displayed as" character.
+
+2012-08-12 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-units.el (math-default-units-table): Give an
+ initial value.
+ (math-put-default-units): Add options to put composite units and
+ unit systems in the default units table.
+ (calc-convert-units): Send composite units to
+ `math-put-default-units' when appropriate.
+
+2012-08-11 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/copyright.el (copyright-update-directory): Logic fix.
+
+ * tutorial.el (help-with-tutorial):
+ * emacs-lisp/copyright.el (copyright-update-directory):
+ * emacs-lisp/autoload.el (autoload-find-generated-file)
+ (autoload-find-file): Disable local eval: (for insurance).
+
+ * files.el (hack-local-variables-filter): If an eval: form is not
+ known to be safe, and enable-local-variables is :safe, then ignore
+ the form totally, as is done for non-eval forms. (Bug#12155)
+ This is CVE-2012-3479.
+
+2012-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/rx.el (rx-constituents): Don't define as constant.
+ (rx-form): Simplify.
+
+2012-08-09 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-expr-beg, ruby-parse-partial):
+ ?, _, and : are symbol constituents, ! is not (but kinda should be).
+ (ruby-syntax-propertize-heredoc): Use ruby-singleton-class-p.
+ (ruby-syntax-propertize-function): Adjust for changes in
+ `ruby-syntax-propertize-heredoc'.
+
+2012-08-09 Nobuyoshi Nakada <nobu@ruby-lang.org>
+
+ * progmodes/ruby-mode.el (ruby-mode-map): Remove deprecated
+ binding (use `M-;' instead).
+ (ruby-singleton-class-p): New function.
+ (ruby-expr-beg, ruby-in-here-doc-p) Use it.
+
+2012-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-loop): Improve debug spec.
+
+2012-08-10 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/python.el (python-shell-get-process-name): Don't mess
+ with same-window-buffer-names.
+
+ * eshell/eshell.el (eshell-add-to-window-buffer-names)
+ (eshell-remove-from-window-buffer-names): Make obsolete.
+ (eshell-buffer-name, eshell-unload-hook): Don't use them.
+ (eshell): Just use pop-to-buffer-same-window instead.
+
+2012-08-10 Chong Yidong <cyd@gnu.org>
+
+ * bindings.el: Bind M-= back to count-words-region.
+
+ * simple.el (count-words-region): Accept a prefix arg for acting
+ on the entire buffer.
+ (count-words--buffer-message): New helper function.
+
+2012-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * term/x-win.el (x-menu-bar-open): Always pass last-nonmenu-event.
+ * subr.el (eventp): `nil' is not an event, and eventp is not hot.
+ (event-start, event-end): Use posn-at-point to return a more
+ informative posn.
+ (posnp): New function.
+ * mouse.el (popup-menu-normalize-position): Use it.
+
+2012-08-10 Masatake YAMATO <yamato@redhat.com>
+
+ * mouse.el (popup-menu-normalize-position): New function.
+ (popup-menu): Use `popup-menu-normalize-position' to normalize
+ the form for POSITION argument.
+
+ * term/x-win.el (x-menu-bar-open):
+ Use the value returend from (posn-at-point) as position
+ passed to `popup-menu'.
+
+2012-08-09 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calccomp.el (math-compose-expr): Add extra argument
+ indicating that parentheses should be put around products in
+ denominators. Give multiplication precedence over division during
+ composition.
+
+2012-08-09 Chong Yidong <cyd@gnu.org>
+
+ * man.el (Man-switches, Man-sed-command, Man-awk-command)
+ (Man-mode-hook, Man-cooked-hook, Man-untabify-command-args)
+ (Man-untabify-command, manual-program): Convert to defcustom
+ (Bug#10429).
+
+ * vc/add-log.el (change-log-mode): Bind comment-start to nil.
+
+ * descr-text.el (describe-char): Don't insert extra newlines
+ (Bug#10127).
+
+ * vc/log-view.el (log-view-diff): Use use-region-p (Bug#10133).
+ (log-view-diff-changeset, log-view-minor-wrap): Likewise.
+
+ * align.el (align-region): Delete temporary markers (Bug#10047).
+ Plus some code cleanups.
+
+2012-08-09 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (python-pdbtrack-tracked-buffer)
+ (python-pdbtrack-buffers-to-kill, python-shell-internal-buffer)
+ (python-shell-internal-last-output): Use make-local-variable
+ instead of make-variable-buffer-local.
+
+2012-08-09 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el: Enhancements to forward-sexp.
+ (python-nav-forward-sexp): Rename from
+ python-nav-forward-sexp-function.
+ (python-nav--forward-sexp, python-nav--backward-sexp):
+ New functions.
+
+2012-08-09 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-menu.el (calc-modes-menu): Add entries for matrix
+ modes and simplification modes.
+
+2012-08-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * delsel.el (delete-selection-pre-hook): Don't propagate the
+ file-supersession signals (bug#12161).
+
+2012-08-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl.el (cl-map-keymap-recursively, cl-map-intervals)
+ (cl-map-extents): Add compatibility aliases (bug#12135).
+
+2012-08-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-find-file-exists-command): Protect the
+ tests by `ignore-error'.
+ (tramp-find-shell): Open also a new shell, when cache is already
+ set. Reported by Carsten Bormann <cabo@tzi.org>. (Bug#12148)
+
+2012-08-08 Juri Linkov <juri@jurta.org>
+
+ * bookmark.el: Add `defaults' property to the bookmark record.
+ (bookmark-current-buffer): Doc fix.
+ (bookmark-make-record): Add `defaults' property with default values
+ to the bookmark record.
+ (bookmark-minibuffer-read-name-map): Remove key binding "\C-u"
+ with `bookmark-insert-current-bookmark'.
+ (bookmark-set): Get `defaults' property from the bookmark record
+ and use it in `read-from-minibuffer'.
+ (bookmark-insert-current-bookmark): Remove function.
+
+ * info.el (Info-bookmark-make-record): Add `defaults' property
+ with values of canonical Info node name, the current Info file
+ name and the current Info node name. (Bug#12107)
+
+2012-08-08 Juri Linkov <juri@jurta.org>
+
+ * files.el (basic-save-buffer): Use `buffer-name' as the default
+ of `read-file-name' when buffer is not visiting a file (bug#12128).
+
+2012-08-08 Juri Linkov <juri@jurta.org>
+
+ * info.el (Info-isearch-search): Doc fix.
+ (Info-search): Change search-failed message from "initial node" to
+ "end of node" (bug#12078).
+ (Info-isearch-search): Change `isearch-string-state' to
+ `isearch--state-string'.
+
+2012-08-08 Glenn Morris <rgm@gnu.org>
+
+ * language/persian.el: Remove file.
+ * language/misc-lang.el: Move unique part of persian.el here.
+ * loadup.el: Remove language/persian.
+
+2012-08-08 Óscar Fuentes <ofv@wanadoo.es>
+
+ * vc/diff-mode.el (diff-remove-trailing-whitespace): New function.
+
+2012-08-08 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el Fixed defsubst warning.
+ (python-syntax-context) Rename from python-info-ppss-context.
+ (python-syntax-context-type): Rename from
+ python-info-ppss-context-type.
+ (python-syntax-comment-or-string-p): Rename from
+ python-info-ppss-comment-or-string-p.
+
+2012-08-08 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-misc.el (calc-record-why): Don't record a message twice.
+
+2012-08-07 Andreas Schwab <schwab@linux-m68k.org>
+
+ * emacs-lisp/lisp-mode.el (eval-defun-1): Handle standard value of
+ a defcustom that is quoted with backquote.
+
+ * calc/calc-prog.el (math-do-defmath): Use backquote forms.
+ Fix handling of interactive spec when the body uses return.
+ (math-do-arg-check, math-define-function-body): Use backquote forms.
+ * calc/calc-ext.el (math-defcache): Likewise.
+ * calc/calc-rewr.el (math-rwfail, math-rweval): Likewise.
+ * allout.el (allout-new-exposure): Likewise.
+ * calc/calcalg2.el (math-tracing-integral): Likewise.
+ * info.el (Info-last-menu-item): Likewise.
+ * emulation/vip.el (vip-loop): Likewise.
+ * textmodes/artist.el (artist-funcall): Likewise.
+ * menu-bar.el (menu-bar-make-mm-toggle, menu-bar-make-toggle):
+ Construct menu-item directly.
+
+ * progmodes/autoconf.el (font-lock-syntactic-keywords):
+ Don't declare.
+
+2012-08-07 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (deactivate-mark): Preserve text properties when
+ saving the primary selection (Bug#8384).
+
+2012-08-07 Kevin Ryde <user42@zip.com.au>
+
+ * woman.el (woman0-if): Quietly treat ".if v" as false (Bug#12109).
+ (woman-parse-numeric-value): On a bad .IP line, issue a warning
+ and continue processing (Bug#12110).
+
+2012-08-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/cperl-mode.el (cperl-mode): Yet another fix for
+ syntax-propertize-function (bug#10095).
+
+2012-08-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help-fns.el (help-fns--key-bindings, help-fns--signature)
+ (help-fns--parent-mode, help-fns--obsolete): New funs, extracted from
+ describe-function-1.
+ (describe-function-1): Use them. Move compiler macro after sig.
+ (help-fns--compiler-macro): Use function-get. Assume we're already in
+ standard-output. Adjust layout to new call order.
+
+ * emacs-lisp/cl-macs.el (cl--sm-macroexpand): Fix handling of
+ re-binding a symbol that has a symbol-macro (bug#12119).
+
+2012-08-06 Mohsen BANAN <libre@mohsen.1.banan.byname.net>
+
+ * language/persian.el: New file. (Bug#11812)
+ * loadup.el: Add language/persian.el.
+
+2012-08-06 Chong Yidong <cyd@gnu.org>
+
+ * window.el (window--maybe-raise-frame): New function.
+ (window--display-buffer): Split off from here.
+ (display-buffer-reuse-window, display-buffer-pop-up-frame)
+ (display-buffer-pop-up-window, display-buffer-use-some-window):
+ Obey an inhibit-switch-frame action alist entry.
+ (display-buffer): Update doc.
+
+ * replace.el (occur-after-change-function): Avoid losing focus by
+ using the inhibit-switch-frame display parameter (Bug#12139).
+
+2012-08-06 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Make internal shell process buffer names start with space.
+ * progmodes/python.el (python-shell-make-comint): Add optional
+ argument INTERNAL.
+ (run-python-internal): Use it.
+ (python-shell-internal-get-or-create-process): Check for new
+ internal buffer names.
+
+2012-08-06 Glenn Morris <rgm@gnu.org>
+
+ * eshell/esh-ext.el (eshell/addpath): Use dolist and mapconcat.
+ Do less getting and setting of environment variables.
+
+2012-08-05 Chong Yidong <cyd@gnu.org>
+
+ * proced.el (proced): Add substitution string to docstring to
+ trigger autoloading of the proced library on C-h f (Bug#1768).
+
+ * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression):
+ Don't show defvars which have no second argument (Bug#8638).
+
+ * imenu.el (imenu-generic-expression): Move documentation here
+ from imenu--generic-function.
+ (imenu--generic-function): Refer to imenu-generic-expression.
+
+2012-08-05 Vegard Øye <vegard_oye@hotmail.com> (tiny change)
+
+ * emulation/viper-init.el (viper-deflocalvar): Add docstring and
+ indentation declaration.
+ (viper-loop): Add indentation declaration (Bug#7025).
+
+2012-08-05 Chong Yidong <cyd@gnu.org>
+
+ * help-fns.el (describe-variable): Add hyperlink for
+ directory-local variables files. Improve buffer-local and
+ permanent-local reporting; suggested by MON KEY (Bug#6644).
+
+ * help-mode.el (help-dir-local-var-def): New button type.
+
+ * files.el (kill-buffer-hook): Provide a defvar.
+
+2012-08-05 Glenn Morris <rgm@gnu.org>
+
+ * eshell/esh-ext.el (eshell/addpath):
+ Also update eshell-path-env. (Bug#12013)
+
+2012-08-05 Chong Yidong <cyd@gnu.org>
+
+ * wdired.el (wdired-mode, wdired-change-to-wdired-mode): Doc fixes.
+
+ * fringe.el (fringe-styles): Add docstring.
+ (fringe--check-mode): New function.
+ (set-fringe-mode, set-fringe-style): Use it.
+ (fringe-mode, set-fringe-style): Doc fixes (Bug#6480).
+
+ * files.el (set-auto-mode): Fix invalid setq call.
+
+2012-08-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * isearch.el: Misc simplification; use defstruct.
+ (isearch-mode-map): Dense maps now work like sparse ones.
+ (isearch--state): New defstruct.
+ (isearch-string-state, isearch-message-state, isearch-point-state)
+ (isearch-success-state, isearch-forward-state)
+ (isearch-other-end-state, isearch-word-state, isearch-error-state)
+ (isearch-wrapped-state, isearch-barrier-state)
+ (isearch-case-fold-search-state, isearch-pop-fun-state): Remove,
+ replaced by defstruct's accessors.
+ (isearch--set-state): Rename from isearch-top-state and change
+ calling convention.
+ (isearch-push-state): Use new isearch--get-state.
+ (isearch-toggle-word): Disable regexp when enabling word.
+ (isearch-message-prefix): Remove unused arg _c-q-hack.
+ (isearch-message-suffix): Remove unused arg _ellipsis.
+
+2012-08-04 Andreas Schwab <schwab@linux-m68k.org>
+
+ * simple.el (list-processes--refresh): For a server use :host or
+ :local as the address.
+ (list-processes): Doc fix.
+
+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.
+ Set mpc-proc variable instead of returning process.
+ (mpc-proc): Adjust accordingly.
+
+2012-08-03 Eli Zaretskii <eliz@gnu.org>
+
+ * whitespace.el (whitespace-display-mappings): Use Unicode
+ codepoints, instead of emacs-mule codepoints. See
+ http://lists.gnu.org/archive/html/help-gnu-emacs/2012-07/msg00366.html
+ for the details.
+
+ * files.el (file-truename): Don't skip symlink-chasing part on
+ windows-nt. Incorporate the resolution of 8+3 short aliases on
+ Windows into the loop that recursively chases symlinks.
+ Compare directory and its parent case-insensitively on MS-Windows and
+ MS-DOS.
+
+2012-08-03 Chong Yidong <cyd@gnu.org>
+
+ * menu-bar.el (menu-bar-tools-menu): Remove PCL-CVS.
+
+ * sort.el (sort-regexp-fields): Doc fix.
+
+2012-08-03 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex.el (reftex-compile-variables): Make keyvals
+ labels regex position point at the expected place.
+
+2012-08-03 MON KEY <monkey@sandpframing.com>
+
+ * net/imap.el (imap-interactive-login, imap-authenticate)
+ (imap-mailbox-lsub, imap-mailbox-list)
+ (imap-mailbox-status-asynch, imap-mailbox-acl-delete)
+ (imap-fetch, imap-message-flag-permanent-p, imap-envelope-from)
+ (imap-parse-response): Doc fix.
+
+2012-08-03 João Távora <joaotavora@gmail.com>
+
+ * textmodes/tex-mode.el (latex-forward-sexp): Terminate the loop
+ if sexp scanning does not move point (Bug#5734).
+
+2012-08-02 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-vars.el (reftex-default-label-alist-entries):
+ Add listings, minted, and ctable packages.
+ (reftex-label-alist-builtin): Move listings, minted, and ctable
+ entries before LaTeX.
+ (reftex-label-alist): Docfix.
+
+2012-08-02 Bastien Guerry <bzg@gnu.org>
+
+ * replace.el (occur): Fix docstring (bug#12122).
+
+2012-08-02 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-renamed-files-alist): Add ms-w32.h.
+
+2012-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Obsolete alias inactivate-current-input-method-function (Bug#10150).
+ * international/mule-cmds.el: Create
+ inactivate-current-input-method-function as an obsolete alias for
+ deactivate-current-input-method-function. See Katsumi Yamaoka in
+ <http://bugs.gnu.org/10150#46>.
+
+2012-08-01 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-mode.el (calc-set-simplify-mode): Use `cond' instead
+ of nested `if's.
+
+2012-08-01 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/autoconf.el (autoconf-definition-regexp):
+ Add AH_TEMPLATE, adjust submatch numbering.
+ (autoconf-font-lock-keywords, autoconf-imenu-generic-expression)
+ (autoconf-current-defun-function): Update for above change.
+ (autoconf-current-defun-function): First skip to end of current word.
+
+2012-08-01 Rupert Swarbrick <rswarbrick@gmail.com> (tiny change)
+
+ * calendar/cal-html.el (cal-html-insert-agenda-days):
+ Fix typo. (Bug#12018)
+
+2012-07-31 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Shell processes: enhancements to startup and CEDET compatibility.
+ * progmodes/python.el (python-shell-send-setup-max-wait): Delete var.
+ (python-shell-make-comint): accept-process-output at startup.
+ (run-python-internal): Set inferior-python-mode-hook to nil.
+ (python-shell-internal-get-or-create-process): call sit-for.
+ (python-preoutput-result): Add obsolete alias.
+ (python-shell-internal-send-string): Use it.
+ (python-shell-send-setup-code): Remove call to
+ accept-process-output.
+
+2012-07-31 Andreas Schwab <schwab@linux-m68k.org>
+
+ * buff-menu.el (list-buffers-noselect): Use prefix-numeric-value.
+ (Bug#12108)
+
+2012-07-31 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc-mode.el (calc-basic-simplification-mode): Rename from
+ `calc-limited-simplification-mode'.
+ (calc-alg-simplification-mode): New function.
+ (calc-set-simplify-mode): Adjust message.
+
+ * calc.el (calc-set-mode-line): Adjust mode line display for
+ basic simplification mode.
+
+ * calc-help.el (calc-m-prefix-help): Update help message.
+
+ * calc-ext.el (calc-init-extensions): Add bindings and autoloads
+ for `calc-basic-simplify-mode' and `calc-alg-simplify-mode'.
+
+2012-07-31 Bastien Guerry <bzg@gnu.org>
+
+ * man.el (man): Fix comment. (bug#12101)
+
+2012-07-31 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (switch-to-prev-buffer, switch-to-next-buffer):
+ Don't return a non-nil value when no suitable buffer was found.
+
+2012-07-31 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (run-python-internal): Disable font lock for
+ internal shells.
+
+2012-07-30 Stefan Merten <smerten@oekonux.de>
+
+ * 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.
+ (rst-mode-map): New key binding.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Update .PHONY listings in makefiles.
+ * Makefile.in (.PHONY): Add all, doit, custom-deps, finder-data,
+ autoloads, update-subdirs, updates, bzr-update, update-authors,
+ compile-onefile, compile-calc, backup-compiled-files,
+ compile-after-backup, compile-one-process, mh-autoloads,
+ bootstrap-clean, distclean, maintainer-clean.
+
+2012-07-29 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc.el (calc-simplify-mode): Make 'alg the default value.
+ (calc-set-mode-line): Don't display "AlgSimp ".
+
+ * calc/calc-mode.el (calc-alg-simplify-mode): Remove function.
+ (calc-lim-simplify-mode): New function.
+ (calc-set-simplify-mode): Default to 'alg.
+ (calc-default-simplify-mode): Make algebraic simplifications
+ the default.
+
+ * calc/calc-ext.el (calc-init-extensions): Remove binding for
+ `calc-alg-simplify-mode'. Add binding for `calc-lim-simplify-mode'.
+
+ * calc/calc-help.el (calc-m-prefix-help): Change messages to
+ indicate new simplification modes.
+
+ * calc/README: Mention new default simplification mode.
+
+ * calc/calc.el (math-normalize-error): New variable.
+ (math-normalize): Set `math-normalize-error' to t
+ when there's an error.
+
+ * calc/calc-alg.el (math-simplify): Don't simplify when
+ `math-normalize' returns an error.
+
+2012-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ * international/mule-cmds.el (set-locale-environment): Revert last
+ change, since display-graphic-p returns nil when this function is
+ called during startup. Instead...
+
+ * term/w32console.el (terminal-init-w32console): ...setup the
+ keyboard and terminal encoding for TTY sessions here. (Bug#12082)
+
+2012-07-29 Juri Linkov <juri@jurta.org>
+
+ * simple.el (goto-line): Don't display default line number in the
+ prompt because it should be displayed by `read-number' (bug#9952).
+ Add the current line number to the defaults of `goto-line' to
+ allow its easier modification by users with `M-n' (bug#9201).
+
+ * subr.el (read-number): Support multiple default values like in
+ other minibuffer reading functions. Replace `read' with
+ `string-to-number' for consistency with `number-to-string'.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ deactive->inactive, inactivate->deactivate spelling fixes (Bug#10150)
+ * emulation/viper-init.el (viper-deactivate-input-method-action):
+ Rename from viper-inactivate-input-method-action.
+ (viper-deactivate-input-method):
+ Rename from viper-inactivate-input-method.
+ * follow.el (follow-inactive-menu): Rename from follow-deactive-menu.
+ * international/mule-cmds.el (deactivate-input-method):
+ Rename from inactivate-input-method.
+ Also run input-method-deactivate-hook.
+ (deactivate-current-input-method-function):
+ Rename from inactivate-current-input-method-function.
+ (input-method-deactivate-hook): New hook.
+ (input-method-inactivate-hook): Mark obsolete.
+ (inactivate-input-method): Mark obsolete.
+
+ * international/quail.el (quail-activate):
+ Also run quail-deactivate-hook.
+ (quail-deactivate): Rename from quail-inactivate.
+ * international/robin.el (robin-activate):
+ Also run robin-deactivate-hook.
+ (robin-deactivate): Rename from robin-inactivate.
+
+2012-07-29 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (indicate-copied-region): New function.
+ (kill-ring-save): Split off from here.
+
+ * rect.el (copy-rectangle-as-kill): Call indicate-copied-region.
+ (kill-rectangle): Set deactivate-mark to t on read-only error.
+
+ * 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 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)
+
+2012-07-28 Eli Zaretskii <eliz@gnu.org>
+
+ * international/mule-cmds.el (set-locale-environment): In a
+ console session on MS-Windows, set up keyboard and terminal
+ encoding from the OEM codepage, not the ANSI codepage.
+ (Bug#12055)
+
+2012-07-28 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-place-breakpoints): Fix the call to
+ gdb-get-location.
+
+2012-07-28 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/cc-menus.el (cc-imenu-objc-function): Avoid leaving nil in
+ the alist (bug#12029).
+
+2012-07-28 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (custom-deps, finder-data, updates, compile)
+ (compile-always, compile-first)
+ ($(lisp)/calendar/cal-loaddefs.el)
+ ($(lisp)/calendar/diary-loaddefs.el)
+ ($(lisp)/calendar/hol-loaddefs.el, $(lisp)/mh-e/mh-loaddefs.el)
+ ($(lisp)/net/tramp-loaddefs.el, bootstrap)
+ ($(lisp)/progmodes/cc-mode.elc): Depend on $(lisp)subdirs.el,
+ instead of on update-subdirs.
+ (bootstrap-clean): Delete $(lisp)/subdirs.el.
+
+2012-07-28 Chong Yidong <cyd@gnu.org>
+
+ * vc/vc.el (vc-root-diff, vc-print-root-log): Prompt for a
+ directory if vc-deduce-backend returns nil (Bug#7350).
+
+ * simple.el (delete-trailing-lines): New option.
+ (delete-trailing-whitespace): Obey it (Bug#11879).
+
+2012-07-28 David Engster <deng@randomsample.de>
+
+ * xml.el (xml-node-name, xml-parse-file, xml-parse-region):
+ Explanation of new 'symbol-qnames feature in doc-strings.
+ (xml-maybe-do-ns): Return expanded names as plain symbols if
+ 'symbol-qnames was provided in XML-NS argument (Bug#11916).
+ (xml-parse-tag-1): Deal with new definition of PARSE-NS argument.
+
+2012-07-27 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Consistent completion in inferior python with emacs -nw.
+ * progmodes/python.el (inferior-python-mode): replace "<tab>"
+ binding in inferior-python-mode-map with "\t".
+ (python-shell-completion-complete-at-point)
+ (python-completion-complete-at-point): Remove interactive spec.
+
+2012-07-27 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calccomp.el (math-compose-expr): Undo previous change.
+
+2012-07-27 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (python-mode-map): Add keybinding for
+ run-python.
+ (python-shell-make-comint): Fix pop-to-buffer call.
+ (run-python): Autoload. New arg SHOW.
+ (python-shell-get-or-create-process): Do not pop python process
+ buffer.
+
+2012-07-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * notifications.el (notifications-on-action-signal)
+ (notifications-on-closed-signal): Use also the bus address for the map.
+ (notifications-notify, notifications-close-notification)
+ (notifications-get-capabilities): Add optional argument BUS.
+
+2012-07-27 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-vars.el (reftex-label-alist-builtin):
+ Add support for the lstlisting and minted environments, and for the
+ ctable macro.
+ * textmodes/reftex.el (reftex-compile-variables): Also recognize
+ labels written in keyvals syntax.
+
+2012-07-27 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calccomp.el (math-compose-expr): Use parentheses when
+ there is a product in the denominator of a fraction.
+
+2012-07-26 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in ($(lisp)/calendar/cal-loaddefs.el)
+ ($(lisp)/calendar/diary-loaddefs.el)
+ ($(lisp)/calendar/hol-loaddefs.el, $(lisp)/mh-e/mh-loaddefs.el)
+ ($(lisp)/net/tramp-loaddefs.el): Depend on update-subdirs.
+ Fixes failures in parallel bootstrap because subdirs.el is being
+ rewritten while the autoload files are built at the same time,
+ which needs to load subdirs.el.
+
+2012-07-26 Martin Rudalics <rudalics@gmx.at>
+
+ * mouse.el (popup-menu): Fix doc-string and re-indent code.
+ (mouse-drag-line): Don't exit tracking when a switch-frame or
+ switch-window event occurs (Bug#12006).
+
+2012-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mouse.el (popup-menu): Fix last change.
+
+2012-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Autoload from Lisp with more care. Follow aliases when looking for
+ function properties.
+ * subr.el (autoloadp): New function.
+ (symbol-file): Use it.
+ (function-get): New function.
+ * emacs-lisp/macroexp.el (macroexp--expand-all): Use function-get and
+ autoload-do-load.
+ * emacs-lisp/lisp-mode.el (lisp-font-lock-syntactic-face-function)
+ (lisp-indent-function):
+ * emacs-lisp/gv.el (gv-get):
+ * emacs-lisp/edebug.el (get-edebug-spec, edebug-basic-spec):
+ * emacs-lisp/byte-opt.el (byte-optimize-form):
+ * emacs-lisp/bytecomp.el (byte-compile-arglist-warn):
+ * emacs-lisp/autoload.el (make-autoload, autoload-print-form):
+ Use function-get.
+ * emacs-lisp/cl.el: Don't propagate function properties any more.
+
+ * speedbar.el (speedbar-add-localized-speedbar-support):
+ * emacs-lisp/disass.el (disassemble-internal):
+ * desktop.el (desktop-load-file):
+ * help-fns.el (help-function-arglist, find-lisp-object-file-name)
+ (describe-function-1):
+ * emacs-lisp/find-func.el (find-function-noselect):
+ * emacs-lisp/elp.el (elp-instrument-function):
+ * emacs-lisp/advice.el (ad-has-proper-definition):
+ * apropos.el (apropos-safe-documentation, apropos-macrop):
+ * emacs-lisp/debug.el (debug-on-entry):
+ * emacs-lisp/cl-macs.el (cl-compiler-macroexpand):
+ * emacs-lisp/byte-opt.el (byte-compile-inline-expand):
+ * calc/calc.el (name): Use autoloadp & autoload-do-load.
+
+2012-07-25 Alp Aker <alp.tekin.aker@gmail.com>
+
+ * international/mule-cmds.el (ucs-insert): Mark it as an obsolete
+ function, not an obsolete variable (Bug#12046).
+
+2012-07-25 Andreas Schwab <schwab@linux-m68k.org>
+
+ * faces.el (face-spec-reset-face): Fix last change. (Bug#12042)
+
+2012-07-25 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * emacs-lisp/pp.el (pp-display-expression): Select old selected
+ window only if it is still live (Bug#12034).
+
+2012-07-25 Martin Rudalics <rudalics@gmx.at>
+
+ * subr.el (redirect-frame-focus): Add advertised calling
+ convention (Bug#12030).
+
+2012-07-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer typical American spelling for "acknowledgment".
+ * vc/add-log.el (change-log-acknowledgment): Rename from
+ change-log-acknowledgement, with an alias for the old name.
+
+2012-07-25 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc-alg.el (math-simplify-divide): Don't cross multiply
+ in an equation when the lhs is a variable.
+
+2012-07-24 Julien Danjou <julien@danjou.info>
+
+ * net/netrc.el (netrc-find-service-number, netrc-store-data):
+ Remove, unused.
+
+2012-07-23 Eli Zaretskii <eliz@gnu.org>
+
+ * startup.el (command-line): Don't display an empty user name in
+ the error message about non-existent home directory, when
+ init-file-user was set to an empty string. See
+ http://lists.gnu.org/archive/html/bug-gnu-emacs/2012-07/msg00835.html
+ for the details and context.
+
+2012-07-22 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el (ses-cell-formula-aset): New macro.
+ (ses-cell-references-aset): New macro.
+ (ses-cell-p): New function.
+ (ses-rename-cell): Do no longer rely on complex operations like
+ ses-cell-set-formula or ses-set-cell to change the cell and handle
+ the undo at the same time, but rather use lower level new macros
+ `ses-cell-formula-aset' and `ses-cell-references-aset' and handle
+ the undo directly. Refresh the mode line.
+
+2012-07-21 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/cc-cmds.el (c-defun-name):
+ Use match-string-no-properties instead for consistency.
+
+2012-07-20 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/cc-cmds.el (c-defun-name): Handle objc selectors properly.
+ (Bug#7879)
+
+ * progmodes/cc-langs.el (c-symbol-start): Include char _ (bug#11986).
+
+2012-07-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * userlock.el, emacs-lisp/map-ynp.el: Declare part of `emacs' package.
+ * progmodes/bug-reference.el, misearch.el: Provide themselves
+ (bug#11915).
+
+ * progmodes/cperl-mode.el (cperl-unwind-to-safe): Don't inf-loop at end
+ of narrowed buffer (bug#11966).
+
+2012-07-20 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el (ses-rename-cell): Set new name also in reference list of
+ cells of which the renamed cell depends.
+
+2012-07-20 Masatake YAMATO <yamato@redhat.com>
+
+ * term/x-win.el (x-menu-bar-open): Use `frame-parameter'
+ to check whether menu-bar is shown or not. If not shown,
+ show the menu-bar as a popup menu instead of using tmm.
+ * mouse.el (popup-menu): Accept `point' as `position' argument.
+
+2012-07-20 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-parse-partial): No error when end
+ up inside string symbol literal (bug#11923).
+
+2012-07-20 Eli Zaretskii <eliz@gnu.org>
+
+ * startup.el (fancy-startup-text): Read the whole tutorial, not
+ just its first 256 bytes. Prevents gibberish in display of the
+ tutorial title.
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Drop idle buffer compaction due to an absence of the
+ proved efficiency.
+ * compact.el: Remove.
+
+2012-07-19 Sam Steingold <sds@gnu.org>
+
+ * vc/vc-dispatcher.el (vc-compilation-mode): Add, based on
+ vc-bzr-pull & vc-bzr-merge-branch.
+ * vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): Use it.
+ (vc-bzr-error-regexp-alist): Rename from vc-bzr-error-regex-alist
+ for consistency with compilation-error-regexp-alist.
+ * vc/vc-git.el (vc-git-error-regexp-alist): Add.
+ (vc-git-pull, vc-git-merge-branch): Call vc-compilation-mode.
+ * vc/vc-hg.el (vc-hg-error-regexp-alist): Add.
+ (vc-hg-pull, vc-hg-merge-branch): Call vc-compilation-mode.
+
+2012-07-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/chart.el: Use lexical-binding.
+ (chart-emacs-storage): Don't hardcode the list of entries.
+
+2012-07-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Next round of tweaks caused by Fgarbage_collect changes.
+ * emacs-lisp/chart.el (chart-emacs-storage): Adjust again.
+
+2012-07-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Compact buffers when idle.
+ * compact.el: New file.
+
+2012-07-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (eventp): Presume that if it looks vaguely like an event,
+ it's an event (bug#10190).
+
+2012-07-19 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Enhancements to ppss related code (thanks Stefan).
+ * progmodes/python.el (python-indent-context)
+ (python-indent-calculate-indentation, python-indent-dedent-line)
+ (python-indent-electric-colon, python-nav-forward-block)
+ (python-mode-abbrev-table)
+ (python-info-assignment-continuation-line-p): Simplify checks
+ for ppss context.
+ (python-info-continuation-line-p): Cleanup.
+ (python-info-ppss-context): Do not catch 'quote.
+ (python-info-ppss-context-type)
+ (python-info-ppss-comment-or-string-p): Simplify.
+
+2012-07-18 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el: Enhancements to eldoc support.
+ (python-info-current-symbol): New function.
+ (python-eldoc-at-point): Use python-info-current-symbol.
+ (python-info-current-defun): Fix cornercase on first defun scan.
+ (python-eldoc--get-doc-at-point): Use python-info-current-symbol
+ and signal error when no inferior python process is available.
+
+2012-07-18 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-git.el (vc-git-state): Don't call `vc-git-registered',
+ assume it's always t.
+ (vc-git-registered): Remove caching, the function is only called
+ once.
+ (vc-git-branches): Use `vc-git--call' instead of `call-process'.
+
+2012-07-18 Chong Yidong <cyd@gnu.org>
+
+ * subr.el (last-input-char, last-command-char): Remove (Bug#9195).
+
+ * simple.el (count-words): Report on narrowing (Bug#9959).
+
+ * bindings.el: Bind M-= to count-words.
+
+ * faces.el (face-spec-reset-face): Handle reverse video (Bug#4238).
+
+2012-07-18 Masatake YAMATO <yamato@redhat.com>
+
+ * progmodes/sh-script.el (sh-imenu-generic-expression):
+ Capture a function with `function' keyword and without parentheses
+ like "function FOO" (bug#11856).
+
+2012-07-18 Tassilo Horn <tassilo@member.fsf.org>
+
+ * window.el (split-window-sensibly): Make WINDOW argument
+ optional.
+
+2012-07-18 Chong Yidong <cyd@gnu.org>
+
+ * subr.el (keyboard-translate): Doc fix (Bug#7261).
+
+ * isearch.el (isearch-mode-map): Handle C-x 8 key translations,
+ and make C-x 8 RET exit isearch (Bug#11439).
+
+ * international/iso-transl.el: Move isearch-mode-map key
+ definitions to isearch.el.
+
+2012-07-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el: Adapt further to gv.el (bug#11970).
+ (eieio-defclass): Use gv-define-setter when possible.
+
+2012-07-18 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Reflect recent changes in Fgarbage_collect.
+ * emacs-lisp/chart.el (chart-emacs-storage): Change to
+ reflect new format of data returned by Fgarbage_collect.
+
+2012-07-17 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ New utility functions + python-info-ppss-context fix (Bug#11910).
+ * progmodes/python.el (python-info-beginning-of-block-statement-p)
+ (python-info-ppss-comment-or-string-p): New functions.
+ (python-info-ppss-context): Small fix for string check.
+
+2012-07-17 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-do-async-shell-command): Doc fix.
+ (dired-do-async-shell-command): Don't add `*' at the end of the
+ command (Bug#11815).
+ (dired-do-shell-command): Doc fix.
+ (dired-shell-stuff-it): Strip the trailing "&" and ";" if any.
+ Join the individual commands using either "&" or ";" as the
+ separator depending on the values of these trailing characters.
+ At the end re-add the trailing "&". (Bug#10598)
+
+ * simple.el (async-shell-command): Sync the interactive spec with
+ `shell-command'. Doc fix.
+ (shell-command): Doc fix.
+
+2012-07-17 Juri Linkov <juri@jurta.org>
+
+ * descr-text.el (describe-char): Fix format args. (Bug#10129)
+
+2012-07-17 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Final renames and doc fixes for movement commands (bug#11899).
+ * progmodes/python.el (python-nav-beginning-of-statement):
+ Rename from python-nav-statement-start.
+ (python-nav-end-of-statement): Rename from
+ python-nav-statement-end.
+ (python-nav-beginning-of-block): Rename from
+ python-nav-block-start.
+ (python-nav-end-of-block): Rename from python-nav-block-end.
+
+2012-07-17 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (python-shell-send-string-no-output):
+ Allow accept-process-output to quit, keeping shell process ready for
+ future interactions (Bug#11868).
+
+2012-07-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-progv): Use a properly prefixed var name.
+
+ * emacs-lisp/elint.el (elint-find-args-in-code):
+ Use help-function-arglist, so as to handle lexical byte-code.
+
+ * progmodes/sh-script.el (sh-syntax-propertize-function): Fix last
+ change (bug#11826).
+
+2012-07-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/cc-engine.el (c-forward-sws, c-backward-sws):
+ Avoid spuriously marking the buffer as modified because of c-is-sws.
+
+ * progmodes/sh-script.el (sh-syntax-propertize-function): Mark "${#VAR"
+ as not-a-comment (bug#11946).
+
+ * emacs-lisp/macroexp.el (macroexp-let2): Use more informative names
+ for uninterned vars.
+
+ * xt-mouse.el (xterm-mouse-translate-1, xterm-mouse-event-read):
+ Use read-event since we don't really want to read chars but bytes.
+
+ * textmodes/tex-mode.el (tex-font-lock-keywords-1): Highlight not only
+ $$..$$ but also $..$ using regexps (bug#11953).
+ Use tex-verbatim for \url and \path.
+ (tex-font-lock-keywords): Define as defconst like the others.
+ (tex-common-initialization): Don't use font-lock-syntax-table any more.
+
+2012-07-16 René Kyllingstad <Rene@Kyllingstad.com> (tiny change)
+
+ * international/mule-cmds.el (ucs-insert): Make it an obsolete
+ alias for insert-char.
+
+2012-07-16 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el: Simplified imenu implementation.
+ (python-nav-jump-to-defun): Remove command.
+ (python-mode-map): Use `imenu' instead.
+ (python-nav-list-defun-positions-cache)
+ (python-imenu-include-defun-type, python-imenu-make-tree)
+ (python-imenu-subtree-root-label, python-imenu-index-alist):
+ Remove vars.
+ (python-nav-list-defun-positions, python-nav-read-defun)
+ (python-imenu-tree-assoc, python-imenu-make-element-tree)
+ (python-imenu-make-tree, python-imenu-create-index):
+ Remove functions.
+ (python-mode): Update to interact with imenu by setting
+ `imenu-extract-index-name-function' only.
+
+2012-07-16 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el: Enhancements to navigation commands.
+ (python-nav-backward-sentence)
+ (python-nav-forward-sentence): Remove.
+ (python-nav-backward-statement, python-nav-forward-statement)
+ (python-nav-statement-start, python-nav-statement-end)
+ (python-nav-backward-block, python-nav-forward-block)
+ (python-nav-block-start, python-nav-block-end)
+ (python-nav-forward-sexp-function)
+ (python-info-current-line-comment-p)
+ (python-info-current-line-empty-p): New functions.
+ (python-indent-context): Use `python-nav-statement-start'.
+
+2012-07-16 Michael Albinus <michael.albinus@gmx.de>
+
+ * eshell/em-ls.el (eshell/ls): Use `apply'.
+
+ * eshell/em-unix.el (eshell/su, eshell/sudo): Apply Tramp's ad-hoc
+ multi-hops, instead of Tramp internals.
+
+ * vc/ediff.el (ediff-directories): Add trailing space to prompts.
+
+ * vc/ediff-diff.el (ediff-same-file-contents): Handle the case,
+ when F1 and F2 are located on different hosts.
+
+2012-07-14 Chong Yidong <cyd@gnu.org>
+
+ * xt-mouse.el: Implement extended mouse coordinates (Bug#10642).
+ (xterm-mouse-translate): Move code into xterm-mouse-translate-1.
+ (xterm-mouse-translate-extended, xterm-mouse-translate-1)
+ (xterm-mouse--read-event-sequence-1000)
+ (xterm-mouse--read-event-sequence-1006): New functions. For old
+ mouse protocol, handle M-mouse-X events correctly.
+ (xterm-mouse-event): New arg specifying mouse protocol.
+ (turn-on-xterm-mouse-tracking-on-terminal)
+ (turn-off-xterm-mouse-tracking-on-terminal): Send DEC 1006
+ sequence to toggle extended coordinates on newer XTerms.
+ This appears to be harmless on terminals which do not support this.
+
+2012-07-14 Leo Liu <sdl.web@gmail.com>
+
+ Add fringe bitmap indicators for flymake. (Bug#11253)
+ * progmodes/flymake.el (flymake-highlight-line): Use fringe bitmaps.
+ (flymake-make-overlay): New arg BITMAP.
+ (flymake-error-bitmap, flymake-warning-bitmap)
+ (flymake-fringe-indicator-position): New user variables.
+
+ * fringe.el: New bitmap exclamation-mark.
+
+2012-07-14 Jan Djärv <jan.h.d@swipnet.se>
+
+ * progmodes/cc-cmds.el (c-defun-name): Recognize Objective-C methods
+ also (Bug#7879).
+
+2012-07-14 Chong Yidong <cyd@gnu.org>
+
+ * electric.el (electric-pair-post-self-insert-function): Fix pair
+ insertion in empty-region case (Bug#11520).
+
+2012-07-14 Chong Yidong <cyd@gnu.org>
+
+ * bindings.el: Consolidate ctl-x-r-map bindings.
+ Bind copy-rectangle-as-kill to C-x r w.
+
+ * rect.el, register.el: Move bindings to bindings.el.
+
+2012-07-14 Reuben Thomas <rrt@sc3d.org>
+
+ * rect.el (copy-rectangle-as-kill): New command (Bug#739).
+
+2012-07-13 Andreas Schwab <schwab@linux-m68k.org>
+
+ * emacs-lisp/cl.el (labels): Remove spurious quote. (Bug#11938)
+
+2012-07-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * bindings.el (top): Use `mapc' instead of `mapcar'.
+
+ * loadup.el (top): Remove bogus `if' choice (brought by 2008-06-21T01:38:39Z!monnier@iro.umontreal.ca).
+
+2012-07-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * progmodes/sql.el (sql-comint): Suppress the check for program on
+ remote hosts. Reported by Francis Devereux <francis@devrx.org>.
+ (Bug#11908)
+
+2012-07-13 Chong Yidong <cyd@gnu.org>
+
+ * bindings.el: Assign a non-nil permanent-local property to
+ per-buffer variables which lack a default value (Bug#11930).
+
+ * help-fns.el (describe-variable): In the "automatically becomes
+ local" notice, take note of permanent-local variables.
+
+2012-07-13 Chong Yidong <cyd@gnu.org>
+
+ * files.el (toggle-read-only): Doc fix and code cleanup. New arg
+ to allow printing the message when called from Lisp.
+
+ * emacs-lisp/bytecomp.el (byte-compile-interactive-only-functions):
+ Remove toggle-read-only.
+
+ * bs.el (bs-toggle-readonly):
+ * buff-menu.el (Buffer-menu-toggle-read-only):
+ Remove with-no-warnings around toggle-read-only.
+
+ * ffap.el (ffap--toggle-read-only): Accept a list of buffers.
+ Remove with-no-warnings around toggle-read-only.
+ (ffap-read-only, ffap-read-only-other-window)
+ (ffap-read-only-other-frame): Callers changed.
+
+ * help-mode.el: Don't require view package.
+ (help-mode-finish): Set buffer-read-only instead of calling
+ toggle-read-only.
+
+ * bindings.el (mode-line-toggle-read-only):
+ * dired.el (dired-toggle-read-only):
+ * ibuffer.el (ibuffer-do-toggle-read-only): Call toggle-read-only
+ with non-nil second arg.
+
+ * emacs-lisp/eieio-custom.el (eieio-customize-object):
+ * vc/ediff.el (ediff-set-read-only-in-buf-A): Set buffer-read-only
+ directly.
+
+2012-07-12 Eli Zaretskii <eliz@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-recompile-directory): Use cl-incf,
+ not incf.
+
+2012-07-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ More CL cleanups and reduction of use of cl.el.
+ * woman.el, winner.el, vc/vc-rcs.el, vc/vc-hooks.el, vc/vc-hg.el:
+ * vc/vc-git.el, vc/vc-dir.el, vc/vc-bzr.el, vc/vc-annotate.el:
+ * textmodes/tex-mode.el, textmodes/sgml-mode.el, tar-mode.el:
+ * strokes.el, ses.el, server.el, progmodes/js.el, progmodes/gdb-mi.el:
+ * progmodes/flymake.el, progmodes/ebrowse.el, progmodes/compile.el:
+ * play/tetris.el, play/snake.el, play/pong.el, play/landmark.el:
+ * play/hanoi.el, play/decipher.el, play/5x5.el, nxml/nxml-mode.el:
+ * net/secrets.el, net/quickurl.el, midnight.el, mail/footnote.el:
+ * image-dired.el, ibuffer.el, ibuf-macs.el, ibuf-ext.el, hexl.el:
+ * eshell/eshell.el, eshell/esh-io.el, eshell/esh-ext.el:
+ * eshell/esh-cmd.el, eshell/em-ls.el, eshell/em-hist.el:
+ * eshell/em-cmpl.el, eshell/em-banner.el:
+ * calendar/parse-time.el: Use cl-lib.
+ * wid-browse.el, wdired.el, vc/vc.el, vc/vc-mtn.el, vc/vc-cvs.el:
+ * vc/vc-arch.el, tree-widget.el, textmodes/texinfo.el:
+ * textmodes/refill.el, textmodes/css-mode.el, term/tvi970.el:
+ * term/ns-win.el, term.el, shell.el, ps-samp.el:
+ * progmodes/perl-mode.el, progmodes/pascal.el, progmodes/gud.el:
+ * progmodes/glasses.el, progmodes/etags.el, progmodes/cwarn.el:
+ * play/gamegrid.el, play/bubbles.el, novice.el, notifications.el:
+ * net/zeroconf.el, net/xesam.el, net/snmp-mode.el, net/mairix.el:
+ * net/ldap.el, net/eudc.el, net/browse-url.el, man.el:
+ * mail/mailheader.el, mail/feedmail.el: Don't use CL.
+ * ibuf-ext.el (ibuffer-mark-old-buffers): Use float-time.
+ * eshell/esh-opt.el (eshell-eval-using-options): Quote code with
+ `lambda' rather than with `quote'.
+ (eshell-do-opt): Adjust accordingly.
+ (eshell-process-option): Simplify.
+ * eshell/esh-var.el:
+ * eshell/em-script.el: Require `esh-opt' for eshell-eval-using-options.
+ * emacs-lisp/pcase.el (pcase--dontcare-upats, pcase--let*)
+ (pcase--expand, pcase--u1): Rename pcase's internal `dontcare' pattern
+ to `pcase--dontcare'.
+ * emacs-lisp/cl.el (labels): Mark obsolete.
+ (cl--letf, letf): Move to cl-lib.
+ (cl--letf*, letf*): Remove.
+ * emacs-lisp/cl-lib.el (cl-nth-value): Use defalias.
+ * emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Add indent rule.
+ (cl-progv): Rewrite.
+ (cl--letf, cl-letf): Move from cl.el.
+ (cl-letf*): New macro.
+ * emacs-lisp/cl-extra.el (cl--progv-before, cl--progv-after): Remove.
+
+2012-07-11 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/ange-ftp.el (ange-ftp-cf1): Update the files cache.
+
+2012-07-11 Chong Yidong <cyd@gnu.org>
+
+ * vc/log-edit.el (log-edit-vc-backend): New variable.
+ (log-edit): Doc fix.
+
+ * vc/vc-dispatcher.el (vc-log-edit): New args. Use PARAMS
+ argument of log-edit to set up all local variables.
+ (vc-start-logentry): New optional arg specifying VC backend.
+
+ * vc/vc.el (vc-checkin): Use it.
+ (vc-deduce-fileset): Handle Log Edit buffers.
+ (vc-diff): Make first argument optional too.
+
+ * vc/log-view.el (log-view-vc-fileset, log-view-vc-backend): Doc fix.
+
+2012-07-10 Michael Albinus <michael.albinus@gmx.de>
+
+ * eshell/esh-ext.el (eshell-remote-command): Remove remote part of
+ command, just in case. The function is not needed anymore.
+ (eshell-external-command): Do not call `eshell-remote-command'.
+
+2012-07-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Reduce use of (require 'cl).
+ * vc/smerge-mode.el, vc/pcvs.el, vc/pcvs-util.el, vc/pcvs-info.el:
+ * vc/diff-mode.el, vc/cvs-status.el, uniquify.el, scroll-bar.el:
+ * register.el, progmodes/sh-script.el, net/gnutls.el, net/dbus.el:
+ * msb.el, mpc.el, minibuffer.el, international/ucs-normalize.el:
+ * international/quail.el, info-xref.el, imenu.el, image-mode.el:
+ * font-lock.el, filesets.el, edmacro.el, doc-view.el, bookmark.el:
+ * battery.el, avoid.el, abbrev.el: Use cl-lib.
+ * vc/pcvs-parse.el, vc/pcvs-defs.el, vc/log-view.el, vc/log-edit.el:
+ * vc/diff.el, simple.el, pcomplete.el, lpr.el, comint.el, loadhist.el:
+ * jit-lock.el, international/iso-ascii.el, info.el, frame.el, bs.el:
+ * emulation/crisp.el, electric.el, dired.el, cus-dep.el, composite.el:
+ * calculator.el, autorevert.el, apropos.el: Don't require CL.
+ * emacs-lisp/bytecomp.el (byte-recompile-directory, display-call-tree)
+ (byte-compile-unfold-bcf, byte-compile-check-variable):
+ * emacs-lisp/byte-opt.el (byte-compile-trueconstp)
+ (byte-compile-nilconstp):
+ * emacs-lisp/autoload.el (make-autoload): Use pcase.
+ * face-remap.el (text-scale-adjust): Simplify pcase patterns.
+
+ * emacs-lisp/gv.el (cond): Make it a valid place.
+ (if): Simplify slightly.
+
+ * emacs-lisp/pcase.el (pcase): Accept self-quoting exps as "upatterns".
+ (pcase--self-quoting-p): New function.
+ (pcase--u1): Use it.
+
+2012-07-10 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-fixed-entries):
+ (authors-renamed-files-alist): Update for configure.in -> configure.ac.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rename configure.in to configure.ac (Bug#11603).
+ * emacs-lisp/authors.el (authors-canonical-file-name):
+ * progmodes/autoconf.el (autoconf-mode):
+ Prefer configure.ac to configure.in.
+
+2012-07-08 Chong Yidong <cyd@gnu.org>
+
+ * mouse.el (mouse-drag-line): Rewrite the track-mouse loop.
+ Implement the mouse-1-click-follows-link handling properly.
+
+ * info.el (Info-link-keymap): Use follow-link mechanism for
+ header-line links (Bug#374).
+
+ * simple.el (deactivate-mark): Do not set the primary selection
+ if another program has acquired it (Bug#11772).
+
+2012-07-07 Kevin Ryde <user42@zip.com.au>
+
+ * woman.el (woman-strings): Fix double-quote handling (Bug#1151).
+ (woman-decode-region): Replace escaped-escapes without destroying
+ bold or underline (Bug#11552).
+ (woman2-process-escapes): Handle nofill regions (Bug#11591).
+
+2012-07-07 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (yank-pop-change-selection): Doc fix (Bug#11361).
+ (interprogram-cut-function, interprogram-paste-function):
+ Mention that we typically mean the clipboard.
+
+2012-07-06 Glenn Morris <rgm@gnu.org>
+
+ * kmacro.el (kmacro-call-macro): Restore repeat message. (Bug#11817)
+
+ * files.el (toggle-read-only): Restrict message to interactive use.
+
+2012-07-06 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-restricted-shell-hosts-alist): New defcustom.
+
+ * net/tramp-sh.el (tramp-maybe-open-connection): Handle it.
+
+2012-07-06 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (compile-one-process): Rename from "recompile".
+
+ * Makefile.in (bzr-update): "compile" is the same as "recompile
+ autoloads", but parallelizable, so use that instead.
+
+2012-07-06 Dmitry Gutov <dgutov@yandex.ru>
+
+ * window.el (quit-window): Always restore window height when
+ it's saved in quit-restore parameter (Bug#11810).
+
+2012-07-06 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (kill-whole-line): Doc tweak.
+
+2012-07-06 Eli Zaretskii <eliz@gnu.org>
+
+ * files.el (file-relative-name): Compare file names
+ case-insensitively if on MS-Windows or MS-DOS, or if
+ read-file-name-completion-ignore-case is non-nil. Don't use
+ case-fold-search for this purpose. (Bug#11827)
+
+2012-07-17 Andreas Schwab <schwab@linux-m68k.org>
+
+ * calendar/cal-dst.el (calendar-current-time-zone):
+ Return calendar-current-time-zone-cache if non-nil.
+
+2012-07-17 Masatake YAMATO <yamato@redhat.com>
+2012-07-06 Andreas Schwab <schwab@linux-m68k.org>
+
+ * calendar/cal-dst.el (calendar-current-time-zone):
+ Return calendar-current-time-zone-cache if non-nil.
+
+2012-07-06 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (cvs-update): Remove old alias.
+
+2012-07-05 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.6-pre.
+
+ * net/tramp.el (tramp-drop-volume-letter): Provide an XEmacs
+ compatible declaration.
+
+ * net/tramp-cmds.el (tramp-append-tramp-buffers):
+ Protect `list-load-path-shadows' call.
+
+ * net/tramp-compat.el (top): Require packages, which aren't
+ autoloaded anymore for XEmacs. Protect call of
+ `tramp-file-name-handler' by `tramp-compat-funcall', pacifying the
+ compiler. Do not require tramp-util.el and tramp-vc.el anymore,
+ it hurts at least for SXEmacs.
+ (tramp-compat-temporary-file-directory): In XEmacs, there is no
+ standard-value for `temporary-file-directory'.
+
+ * net/tramp-sh.el (tramp-do-directory-files-and-attributes-with-stat):
+ Redirect stderr to /dev/null.
+ (tramp-sh-handle-write-region): uid and gid can be floats.
+ Reported by Russell Sim <russell.sim@gmail.com>.
+ (tramp-sh-handle-vc-registered): Hide errors.
+ (tramp-vc-file-name-handler): Use dummy results for `process-file'
+ and `start-file-process'.
+ (tramp-maybe-open-connection): Check also whether `non-essential'
+ is bound.
+
+2012-07-04 Chong Yidong <cyd@gnu.org>
+
+ * xml.el (xml--parse-buffer): Use xml-syntax-table.
+ (xml-parse-tag): Likewise, and avoid changing entity tables.
+ (xml-syntax-table): Define from scratch, making sure not to give
+ x2000 and other Unicode spaces whitespace syntax, since those are
+ not spaces in XML.
+ (xml-parse-fragment): Delete unused function.
+ (xml-name-start-char-re, xml-name-char-re, xml-name-re)
+ (xml-names-re, xml-nmtoken-re, xml-nmtokens-re, xml-char-ref-re)
+ (xml-entity-ref, xml-pe-reference-re)
+ (xml-reference-re,xml-att-value-re, xml-tokenized-type-re)
+ (xml-notation-type-re, xml-enumeration-re, xml-enumerated-type-re)
+ (xml-att-type-re, xml-default-decl-re, xml-att-def-re)
+ (xml-entity-value-re): Use syntax references in regexps where
+ possible; no need to define inside a let-binding.
+ (xml-parse-dtd): Use xml-pe-reference-re.
+ (xml-entity-or-char-ref-re): New defconst.
+ (xml-parse-string, xml-substitute-special): Use it.
+
+2012-07-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files.el (locate-dominating-file): Allow `name' to be a predicate.
+ (find-file--read-only): New function.
+ (find-file-read-only, find-file-read-only-other-window)
+ (find-file-read-only-other-frame): Use it.
+ (insert-file-contents-literally): Don't `fset'.
+ (get-free-disk-space): Use locate-dominating-file.
+
+ * emacs-lisp/bytecomp.el (byte-compile): Don't signal an error if the
+ function is already compiled.
+
+ * xml.el (xml-name-regexp): Remove, redundant. Use xml-name-re.
+
+2012-07-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * vc/ediff-diff.el (ediff-same-file-contents): Fix it for remote
+ files on the same host.
+
+2012-07-03 Andreas Schwab <schwab@linux-m68k.org>
+
+ * help-fns.el (describe-function-1): Only call
+ help-fns--autoloaded-p when we have a file name. (Bug#11848)
+
+2012-07-03 Chong Yidong <cyd@gnu.org>
+
+ * xml.el: Protect parser against XML bombs.
+ (xml-entity-expansion-limit): New variable.
+ (xml-parse-string, xml-substitute-special): Use it.
+ (xml-parse-dtd): Avoid infloop if the DTD is not terminated.
+
+2012-07-03 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/bug-reference.el (bug-reference-bug-regexp):
+ Allow linking to specific messages in debbugs reports (eg 123#5).
+
+2012-07-02 Chong Yidong <cyd@gnu.org>
+
+ * xml.el: Fix entity and character reference expansion, allowing
+ them to expand into markup as per XML spec.
+ (xml-default-ns): New variable.
+ (xml-entity-alist): Use XML spec definitions for lt and amp.
+ (xml-parse-region): Make first two arguments optional.
+ Discard text properties.
+ (xml-parse-tag-1): New function, spun off from xml-parse-tag.
+ All callers changed.
+ (xml-parse-tag): Call xml-parse-tag-1. For backward
+ compatibility, this function should not modify buffer contents.
+ (xml-parse-tag-1): Fix opening-tag regexp.
+ (xml-parse-string): Rewrite, handling entity and character
+ references properly.
+ (xml--entity-replacement-text): Signal an error if a parameter
+ entity is undefined.
+
+2012-07-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * comint.el (comint-output-filter): Filter out repeated prompts.
+
+ * net/ange-ftp.el (ange-ftp-expand-file-name): Use ange-ftp-ftp-name
+ and file-name-absolute-p.
+ (ange-ftp-file-exists-p): Use ange-ftp-file-exists-p for
+ internal calls.
+
+2012-07-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes.
+ * emacs-lisp/bytecomp.el (byte-compile--reify-function):
+ Rename from byte-compile--refiy-function. All uses changed.
+
+2012-07-01 Chong Yidong <cyd@gnu.org>
+
+ * xml.el (xml--parse-buffer): New function. Move most of
+ xml-parse-region here.
+ (xml-parse-region): Copy region into a temporary buffer, since
+ parameter entity substitution requires changing buffer contents.
+ Use xml--parse-buffer.
+ (xml-parse-file): Use xml--parse-buffer.
+ (xml-parse-dtd): Make parameter entity substitution work right.
+ Use proper regexps for ELEMENT declarations (Bug#7172).
+
+2012-06-30 Glenn Morris <rgm@gnu.org>
+
+ * comint.el (follow-comint-scroll-to-bottom): Fix declaration.
+
+ * net/secrets.el, net/tramp-gvfs.el, net/xesam.el, net/zeroconf.el:
+ Remove outdated and unnecessary dbus declarations.
+
+2012-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ * emacs-lisp/timer.el (timer-until): Subtract results of
+ float-time, instead of taking float-time of the result of
+ time-subtract, since float-time signals an error for negative time
+ arguments.
+
+2012-06-30 Chong Yidong <cyd@gnu.org>
+
+ * xml.el (xml-*-re): Convert defvars into defconsts, and
+ eval-and-compile them so eval-and-compile works on derivatives.
+ (xml--entity-replacement-text): Use eval-and-comple.
+
+2012-06-30 Michael Albinus <michael.albinus@gmx.de>
+
+ * vc/vc-git.el (vc-git-registered): Use cache property
+ `git-registered'.
+ (vc-git-mode-line-string): Call `vc-working-revision' instead of
+ `vc-git-working-revision' in order to benefit from the cache.
+ (vc-git-root): Use cache property `git-root'. (Bug#11757)
+
+2012-06-30 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-hooks.el (vc-before-save): Clear cache if file has been
+ removed (likely outside Emacs). (Bug#11757)
+
+2012-06-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el: Require macroexp.
+
+2012-06-30 Chong Yidong <cyd@gnu.org>
+
+ * xml.el: Implement XML parameter entities.
+ (xml-parameter-entity-alist): New variable.
+ (xml-parse-region, xml-parse-fragment): Preserve previous values
+ of xml-entity-alist and xml-parameter-entity-alist, so that
+ repeated calls on different documents do not change them.
+ (xml-parse-tag): Fix doctype regexp.
+ (xml--entity-replacement-text): New function.
+ (xml-parse-dtd): Use it. Don't handle system entities; doing that
+ properly requires url retrieval which is unimplemented.
+ (xml-escape-string): Doc fix.
+
+2012-06-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el (cl-pushnew): Use macroexp-let2.
+
+2012-06-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * fringe.el (fringe-mode): Doc fix.
+
+2012-06-29 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/ange-ftp.el (ange-ftp-get-passwd): Throw if `non-essential'
+ is non-nil.
+ (ange-ftp-ignore-errors-if-non-essential): New defmacro.
+ (ange-ftp-file-name-all-completions): Use it. (Bug#11808)
+
+2012-06-29 Andreas Schwab <schwab@linux-m68k.org>
+
+ * calendar/cal-dst.el (calendar-current-time-zone):
+ Return calendar-current-time-zone-cache if non-nil.
+
+2012-06-29 Masatake YAMATO <yamato@redhat.com>
+
+ * progmodes/which-func.el (which-func-format):
+ Add mouse-face. (Bug#11698)
+
+2012-06-29 Leo Liu <sdl.web@gmail.com>
+
+ * textmodes/enriched.el (enriched-next-annotation): Use eq (Bug#11528).
+
+2012-06-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (minibuffer-confirm-exit-commands):
+ Add completion-at-point (bug#11725).
+
+2012-06-29 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/f90.el (f90-font-lock-keywords-2):
+ Add some preprocessor elements. (Bug#10499)
+
+2012-06-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/cperl-mode.el (cperl-update-syntaxification):
+ Use syntax-propertize (bug#11739).
+
+2012-06-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp/cl-lib.el (cl-pushnew): Don't capture X (bug#11811).
+
+2012-06-28 Julien Danjou <julien@danjou.info>
+
+ * term.el (term-handle-colors-array): Use a set of new faces to
+ color the terminal. Also uses :inverse-video property.
+ (term-default-fg-color): Set to nil by default, deprecate in favor
+ of `term-face'.
+ (term-default-bg-color): Set to nil by default, deprecate in favor
+ of `term-face'.
+ (term-current-face): Use `term-face' by default.
+ (term-bold-attribute): Variable deleted.
+
+2012-06-28 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (completion-list-mode-finish):
+ Don't use toggle-read-only. (Since completion-list-mode has
+ a special mode-class, it wasn't doing anything extra anyway.)
+
+2012-06-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Make inlining of other-mode interpreted functions work (bug#11799).
+ * emacs-lisp/bytecomp.el (byte-compile--refiy-function): New fun.
+ (byte-compile): Use it to fix compilation of lexical-binding closures.
+ * emacs-lisp/byte-opt.el (byte-compile-inline-expand): Compile the
+ function, if needed.
+
+2012-06-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help-mode.el (help-make-xrefs): Don't just withstand
+ cyclic-variable-indirection but any error in documentation-property.
+
+ * loadup.el (purify-flag): Pre-grow the hash-table to reduce the
+ memory use.
+ * bindings.el (bindings--define-key): New function.
+ * vc/vc-hooks.el, replace.el, menu-bar.el, international/mule-cmds.el:
+ * emacs-lisp/lisp-mode.el, buff-menu.el, bookmark.el:
+ * bindings.el: Use it to purecopy define-key bindings.
+
+ * textmodes/rst.el (rst-adornment-faces-alist): Avoid copy-list.
+
+ * emacs-lisp/cl.el (flet): Mark obsolete.
+ * emacs-lisp/cl-macs.el (cl-flet*): New macro.
+ * vc/vc-rcs.el (vc-rcs-annotate-command, vc-rcs-parse):
+ * progmodes/js.el (js-c-fill-paragraph):
+ * progmodes/ebrowse.el (ebrowse-switch-member-buffer-to-sibling-class)
+ (ebrowse-switch-member-buffer-to-derived-class):
+ * play/5x5.el (5x5-solver): Use cl-flet.
+
+ * emacs-lisp/cl.el: Use lexical-binding. Fix flet (bug#11780).
+ (cl--symbol-function): New macro.
+ (cl--letf, cl--letf*): Use it.
+
+ * emacs-lisp/easy-mmode.el (easy-mmode-pretty-mode-name):
+ Strip "toggle-" if any.
+
+2012-06-27 Glenn Morris <rgm@gnu.org>
+
+ * info.el (Info-default-directory-list): Move here from paths.el.
+ * paths.el: Remove file, which is now empty.
+ * loadup.el: No longer load "paths".
+
+ * custom.el (custom-initialize-delay): Doc fix.
+
+ * eshell/em-alias.el, eshell/em-banner.el, eshell/em-basic.el:
+ * eshell/em-cmpl.el, eshell/em-dirs.el, eshell/em-glob.el:
+ * eshell/em-hist.el, eshell/em-ls.el, eshell/em-pred.el:
+ * eshell/em-prompt.el, eshell/em-rebind.el, eshell/em-script.el:
+ * eshell/em-smart.el, eshell/em-term.el, eshell/em-unix.el:
+ * eshell/em-xtra.el: Replace eshell-defgroup with "(progn (defgroup".
+ * eshell/eshell.el (eshell-defgroup): Remove alias.
+
+2012-06-27 Chong Yidong <cyd@gnu.org>
+
+ * help.el (help-enable-auto-load): New variable.
+
+ * help-fns.el (help-fns--autoloaded-p): New function.
+ (describe-function-1): Refer to a function as "autoloaded" if it
+ was autoloaded at any time in the past. Perform autoloading if
+ help-enable-auto-load is non-nil.
+
+2012-06-26 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (compile, compile-always): Depend on
+ update-subdirs, not on subdirs.el. Otherwise, several different
+ sub-targets of 'bootstrap' running in parallel could
+ simultaneously write to subdirs.el, producing a garbled file.
+
+2012-06-26 Sam Steingold <sds@gnu.org>
+
+ * files.el (file-name-base): New convenience function.
+ * autoinsert.el, cus-dep.el, doc-view.el, image-dired.el:
+ * woman.el, eshell/esh-cmd.el, progmodes/ada-xref.el:
+ * progmodes/cc-defs.el, progmodes/cperl-mode.el:
+ * progmodes/flymake.el, progmodes/gud.el, progmodes/idlwave.el:
+ * textmodes/ispell.el, textmodes/reftex-ref.el:
+ * textmodes/tex-mode.el: Use it.
+ Did not touch cedet and org because they are maintained elsewhere.
+
+2012-06-26 Martin Rudalics <rudalics@gmx.at>
+
+ * calendar/calendar.el (calendar-exit): Don't try to delete or
+ iconify last frame. See:
+ http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00372.html
+
+2012-06-25 Jim Diamond <Jim.Diamond@AcadiaU.ca> (tiny change)
+
+ * server.el (server-process-filter): Remember dir in the
+ process's `server-client-directory' properties.
+
+2012-06-24 Chong Yidong <cyd@gnu.org>
+
+ * xml.el (xml-parse-tag): Correctly handle comment embedded in
+ non-tag text.
+
+2012-06-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (COMPILE_FIRST): Synch with changes in 2012-06-22T21:24:54Z!monnier@iro.umontreal.ca.
+
+2012-06-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help-fns.el (describe-variable): Don't croak when doc is not found.
+ * vc/pcvs.el (cvs-retrieve-revision): Avoid toggle-read-only.
+ * menu-bar.el (menu-bar-line-wrapping-menu): Purecopy a tiny bit more.
+ * emacs-lisp/syntax.el (syntax-ppss): Simplify with new `if' place.
+ * emacs-lisp/smie.el (smie-next-sexp): CSE.
+ * emacs-lisp/macroexp.el (macroexp-let2): Fix edebug spec and avoid
+ ((lambda ..) ..).
+ * emacs-lisp/eieio.el (eieio-oref, slot-value): Use simpler defsetf.
+
+2012-06-23 Chong Yidong <cyd@gnu.org>
+
+ * info.el (Info-mouse-follow-link): Accept symbol values of
+ link-args. Select window; suggested by Gerhard Kahl (Bug#11672).
+ (Info-fontify-node): Use Info-link-keymap for all navigation
+ buttons, with link-args property to perform the desired action.
+ (Info-link-keymap): Doc fix.
+ (Info-next-link-keymap, Info-prev-link-keymap)
+ (Info-up-link-keymap): Delete now-unused keymaps.
+
+2012-06-23 Chong Yidong <cyd@gnu.org>
+
+ * mouse.el (mouse-drag-track): Deactivate the mark before popping.
+
+ * progmodes/python.el (python-skeleton-define): Mark abbrevs as
+ system abbrevs.
+
+ * ansi-color.el (ansi-color-apply-on-region): Doc fix.
+
+2012-06-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl--make-usage-args): Handle improper lists
+ (bug#11719).
+
+ * minibuffer.el (completion--twq-try): Try to fail more gracefully when
+ the requote function doesn't work properly (bug#11714).
+
+2012-06-23 Glenn Morris <rgm@gnu.org>
+
+ * pcmpl-rpm.el (pcmpl-rpm-packages): Give status messages.
+
+2012-06-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Further GV/CL cleanups.
+ * emacs-lisp/gv.el (gv-get): Autoload functions to find their
+ gv-expander.
+ (gv--defun-declaration): New function.
+ (defun-declarations-alist): Use it.
+ (gv-define-modify-macro, gv-pushnew!, gv-inc!, gv-dec!): Remove.
+ (gv-place): Autoload.
+ * emacs-lisp/cl.el (cl--dotimes, cl--dolist): Remember subr.el's
+ original definition of dotimes and dolist.
+ * emacs-lisp/cl-macs.el (cl-expr-access-order): Remove unused.
+ (cl-dolist, cl-dotimes): Use `dolist' and `dotimes'.
+ * emacs-lisp/cl-lib.el: Move gv handlers from cl-macs to here.
+ (cl-fifth, cl-sixth, cl-seventh, cl-eighth)
+ (cl-ninth, cl-tenth): Move gv handler to the function's definition.
+ * emacs-lisp/cl-extra.el (cl-subseq, cl-get, cl-getf): Move gv handler
+ to the function's definition.
+ * Makefile.in (COMPILE_FIRST): Re-order to speed it up by about 50%.
+ * window.el:
+ * files.el:
+ * faces.el:
+ * env.el: Don't use CL.
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+
+ * calendar/time-date.el (with-decoded-time-value): New arg
+ PICO-SYMBOL in VARLIST. It's optional, for backward compatibility.
+ (encode-time-value): New optional arg PICO. New type 3.
+ (time-to-seconds) [!float-time]: Support the new picoseconds
+ component if it's used.
+ (seconds-to-time, time-subtract, time-add):
+ Support ps-resolution time stamps as well.
+
+ * emacs-lisp/timer.el (timer): New component psecs. All uses changed.
+ (timerp): Timer vectors now have length 9, not 8.
+ (timer--time): Support new-style (4-part) time stamps.
+ (timer-next-integral-multiple-of-time): Time stamps now have
+ picosecond resolution, so take a bit more care about rounding.
+ (timer-relative-time, timer-inc-time): New optional arg psecs.
+ (timer-set-time-with-usecs): Set psecs to 0.
+ (timer--activate): Check psecs component, too.
+
+ * proced.el (proced-time-lessp): Support ps-resolution stamps.
+
+2012-06-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * icomplete.el (icomplete-minibuffer-setup, icomplete-completions):
+ Move the non-essential binding to the post/pre-command-hook where it is
+ more obviously correct.
+
+ * subr.el (read-passwd): Don't use a history at all.
+ * savehist.el (savehist-save): Remove password saved accidentally
+ because of the above bug.
+
+2012-06-22 Bastien Guerry <bzg@gnu.org>
+
+ * files.el (toggle-read-only): Display a message telling whether
+ the buffer is read-only or not (bug#11726).
+
+2012-06-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/gv.el: New file.
+ * subr.el (push, pop): Extend to generalized variables.
+ * loadup.el (macroexp): Unload if preloaded and uncompiled (bug#11657).
+ * emacs-lisp/cl-lib.el (cl-pop, cl-push, cl--set-nthcdr): Remove.
+ * emacs-lisp/cl-macs.el: Require gv. Use gv-define-setter,
+ gv-define-simple-setter, and gv-define-expander.
+ Remove setf-methods defined in gv. Rename cl-setf -> setf.
+ (cl-setf, cl-do-pop, cl-get-setf-method): Remove.
+ (cl-letf, cl-letf*, cl-define-modify-macro, cl-defsetf)
+ (cl-define-setf-expander, cl-struct-setf-expander): Move to cl.el.
+ (cl-remf, cl-shiftf, cl-rotatef, cl-callf, cl-callf2): Rewrite with
+ gv-letplace.
+ (cl-defstruct): Don't define setf-method any more.
+ * emacs-lisp/cl.el (flet): Don't autoload.
+ (cl--letf, letf, cl--letf*, letf*, cl--gv-adapt)
+ (define-setf-expander, defsetf, define-modify-macro)
+ (cl-struct-setf-expander): Move from cl-lib.el.
+ * emacs-lisp/syntax.el:
+ * emacs-lisp/ewoc.el:
+ * emacs-lisp/smie.el:
+ * emacs-lisp/cconv.el:
+ * emacs-lisp/timer.el: Rename cl-setf -> setf, cl-push -> push.
+ (timer--time): Use gv-define-simple-setter.
+ * emacs-lisp/macroexp.el (macroexp-let2): Rename from macroexp-let²
+ to avoid coding-system problems in subr.el. Adjust all users.
+ (macroexp--maxsize, macroexp-small-p): New functions.
+ * emacs-lisp/bytecomp.el (byte-compile-file): Don't use cl-letf.
+ * scroll-bar.el (scroll-bar-mode):
+ * simple.el (auto-fill-mode, overwrite-mode, binary-overwrite-mode)
+ (normal-erase-is-backspace-mode): Don't use the `eq' place.
+ * winner.el (winner-configuration, winner-make-point-alist)
+ (winner-set-conf, winner-get-point, winner-set): Don't abuse letf.
+ * files.el (locate-file-completion-table): Avoid list*.
+
+2012-06-22 Chong Yidong <cyd@gnu.org>
+
+ * dired-aux.el (dired-do-create-files): Doc fix (Bug#11327).
+ (dired-create-files): Doc fix (Bug#11329).
+ (dired-do-copy): Doc fix (Bug#11334).
+ (dired-mark-read-string): Doc fix (Bug#11553).
+
+ * dired.el (dired-recursive-copies, dired-recursive-deletes):
+ Doc fix (Bug#11326).
+ (dired-make-relative): Doc fix (Bug#11332). Remove unused arg.
+ (dired-dwim-target): Doc fix.
+
+ * wdired.el (wdired-mode): Doc fix.
+
+2012-06-22 Glenn Morris <rgm@gnu.org>
+
+ * pcmpl-rpm.el (pcmpl-rpm-cache): New option.
+ (pcmpl-rpm-cache-stamp-file): New constant.
+ (pcmpl-rpm-cache-time, pcmpl-rpm-packages): New variables.
+ (pcmpl-rpm-packages): Optionally cache list of packages.
+
+ * pcmpl-rpm.el (pcmpl-rpm): New group.
+ (pcmpl-rpm-query-options): New option.
+ (pcmpl-rpm-packages): No need to inline it.
+ Use pcmpl-rpm-query-options.
+
+ * calendar/calendar.el (calendar-in-read-only-buffer):
+ Avoid some needless mode changes.
+
+2012-06-21 Chong Yidong <cyd@gnu.org>
+
+ * desktop.el (desktop-read): Don't prompt if daemon (Bug#11674).
+ (desktop-path): Remove . from the default value (Bug#10977).
+ (desktop-read): Use user-emacs-directory if desktop-path is nil.
+
+2012-06-20 Chong Yidong <cyd@gnu.org>
+
+ * term.el (term-send-raw-meta): Make C-M-<char> keys work (Bug#8172).
+
+2012-06-20 David Röthlisberger <david@rothlis.net> (tiny change)
+
+ * ido.el (ido-switch-buffer, ido-find-file): Fix up doc of C-j
+ (bug#11201).
+
+2012-06-20 Chong Yidong <cyd@gnu.org>
+
+ * term.el (term-window-width): Handle the case of a missing right
+ fringe (Bug#8837).
+ (term-check-size): Use window-text-height (Bug#5445).
+ (term-mode): Use define-derived-mode. Minor cleanups.
+ Set font-lock-defaults (Bug#7692).
+ (term-move-columns, term-insert-char, term-emulate-terminal)
+ (term-erase-in-line, term-insert-spaces): Use font-lock-face.
+
+2012-06-20 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/ange-ftp.el (ange-ftp-get-passwd):
+ Bind `enable-recursive-minibuffers'.
+ (ange-ftp-get-process): Throw if `non-essential' is non-nil.
+
+2012-06-19 David Röthlisberger <david@rothlis.net> (tiny change)
+
+ * ido.el (ido-find-file): Mention C-d binding in docstring (bug#11244).
+
+2012-06-19 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/python.el (python-mode): Derive from prog-mode.
+
+2012-06-19 Kevin Gallagher <Kevin.Gallagher@boeing.com>
+
+ * emulation/edt.el (edt-default-menu-bar-update-buffers)
+ (edt-user-menu-bar-update-buffers): New functions.
+ (edt-default-emulation-setup, edt-user-emulation-setup): Use them.
+
+2012-06-19 Chong Yidong <cyd@gnu.org>
+
+ * subr.el (with-selected-window): Preserve the selected window's
+ terminal's top-frame (Bug#4702).
+
+ * window.el (save-selected-window): Likewise.
+
+2012-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/python.el (python-rx-constituents): Move backquote.
+ (python-skeleton-define, python-define-auxiliary-skeleton):
+ Use `declare'.
+
+2012-06-18 Michael Albinus <michael.albinus@gmx.de>
+
+ * minibuffer.el (read-file-name-default): Revert the patch from
+ 2012-06-17.
+
+2012-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase--expand): Warn for unused pattern.
+ (pcase--u1, pcase--q1): Don't use apply-partially.
+
+2012-06-18 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/python.el (python-proc, python-buffer)
+ (python-send-receive, python-send-string): Fix obsolete versions.
+
+2012-06-18 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (special-display-p): Completely remove stringp
+ check. Suggested by Andreas Schwab <schwab@linux-m68k.org>.
+
+2012-06-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * minibuffer.el (read-file-name-default): Bind `non-essential' to `t'.
+
+ * net/tramp.el (tramp-file-name-handler): Catch 'non-essential.
+
+ * net/ange-ftp.el (ange-ftp-gwp-start, ange-ftp-start-process):
+ * net/tramp-sh.el (tramp-maybe-open-connection):
+ Throw if `non-essential' is non-nil.
+
+2012-06-17 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (special-display-p): Signal an error if BUFFER-NAME
+ is not a string (Bug#11713).
+
+2012-06-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * progmodes/python.el (python-info-beginning-of-backslash):
+ Rename from python-info-beginning-of-backlash, as a spelling fix.
+
+2012-06-17 Chong Yidong <cyd@gnu.org>
+
+ * term.el (term-emulate-terminal): If term-check-size is called,
+ move point to the process mark without resetting point (Bug#4635).
+
+2012-06-17 Glenn Morris <rgm@gnu.org>
+
+ * international/mule-cmds.el (mule-menu-keymap)
+ (set-language-environment, set-locale-environment): Doc tweaks.
+
+2012-06-16 Aurelien Aptel <aurelien.aptel@gmail.com>
+
+ * cus-face.el (custom-face-attributes): Add wave-style underline
+ attribute.
+ * faces.el (set-face-attribute): Update docstring to describe
+ wave-style underline attribute.
+
+2012-06-16 Chong Yidong <cyd@gnu.org>
+
+ * term/xterm.el (terminal-init-xterm): Discard input before
+ querying background mode (Bug#10959).
+
+2012-06-16 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Added and corrected some comments.
+ (rst-re-alist-def): Improve symbol syntax.
+ (rst-mode-syntax-table): Correct syntax entries.
+ (rst-cvs-header, rst-svn-rev, rst-svn-timestamp)
+ (rst-official-version, rst-official-cvs-rev): Update version
+ information.
+
+2012-06-15 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (COMPILE_FIRST): Synch with makefile.in changes
+ in 2008-06-22T13:57:28Z!monnier@iro.umontreal.ca.
+
+2012-06-15 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el: New python.el merge.
+ (python-guess-indent): Obsolete var.
+ (python-indent-guess-indent-offset): New defcustom.
+ (python-indent): Obsolete var.
+ (python-indent-offset): New defcustom.
+ (python-python-command, python-jython-command): Delete var.
+ (python-shell-interpreter): New defcustom.
+ (python-pdbtrack-do-tracking-p): Delete var.
+ (python-pdbtrack-activate): New defcustom.
+ (python-use-skeletons): Obsolete var.
+ (python-skeleton-autoinsert): New defcustom.
+ (inferior-python-filter-regexp, python-continuation-offset)
+ (python-honour-comment-indentation, python-indent-string-contents)
+ (python-jython-packages, python-mode-hook)
+ (python-pdbtrack-minor-mode-string, python-remove-cwd-from-path)
+ (python-shell-prompt-alist)
+ (python-source-modes): Delete defcustoms.
+ (python-check-buffer-name, python-eldoc-setup-code)
+ (python-eldoc-string-code, python-ffap-setup-code)
+ (python-ffap-string-code, python-fill-comment-function)
+ (python-fill-decorator-function, python-fill-paren-function)
+ (python-fill-string-function, python-imenu-include-defun-type)
+ (python-imenu-make-tree, python-imenu-subtree-root-label)
+ (python-pdbtrack-stacktrace-info-regexp, python-shell-buffer-name)
+ (python-shell-compilation-regexp-alist)
+ (python-shell-completion-module-string-code)
+ (python-shell-completion-pdb-string-code)
+ (python-shell-completion-setup-code)
+ (python-shell-completion-string-code)
+ (python-shell-enable-font-lock, python-shell-exec-path)
+ (python-shell-extra-pythonpaths)
+ (python-shell-internal-buffer-name, python-shell-interpreter-args)
+ (python-shell-process-environment)
+ (python-shell-prompt-block-regexp)
+ (python-shell-prompt-output-regexp)
+ (python-shell-prompt-pdb-regexp, python-shell-prompt-regexp)
+ (python-shell-send-setup-max-wait, python-shell-setup-codes)
+ (python-shell-virtualenv-path): New defcustoms.
+ (brm-menu, eldoc-documentation-function, inferior-python-mode-map)
+ (inferior-python-mode-syntax-table, python--prompt-regexp)
+ (python-buffer, python-command python-python-command)
+ (python-default-template, python-imports, python-indent-index)
+ (python-indent-list, python-indent-list-length)
+ (python-mode-running, python-pdbtrack-is-tracking-p)
+ (python-preoutput-continuation, python-preoutput-leftover)
+ (python-preoutput-result, python-preoutput-skip-next-prompt)
+ (python-prev-dir/file, python-recursing)
+ (python-saved-check-command, python-version-checked)
+ (python-which-func-length-limit)
+ (view-return-to-alist): Delete vars.
+ (python-check-custom-command, python-dotty-syntax-table)
+ (python-imenu-index-alist, python-indent-current-level)
+ (python-indent-dedenters, python-indent-levels)
+ (python-nav-beginning-of-defun-regexp)
+ (python-nav-list-defun-positions-cache)
+ (python-pdbtrack-buffers-to-kill, python-pdbtrack-tracked-buffer)
+ (python-shell-internal-buffer)
+ (python-skeleton-available): New vars.
+ (def-python-skeleton): Delete macro.
+ (python-skeleton-define): New macro.
+ (python-define-auxiliary-skeleton, python-rx): New macros.
+ (python-insert-class): Delete command.
+ (python-skeleton-class): New command.
+ (python-insert-def): Delete command.
+ (python-skeleton-def): New command.
+ (python-insert-for): Delete command.
+ (python-skeleton-for): New command.
+ (python-insert-if): Delete command.
+ (python-skeleton-if): New command.
+ (python-insert-try/except, python-insert-try/finally): Delete commands.
+ (python-skeleton-try): New command.
+ (python-insert-while): Delete command.
+ (python-skeleton-while): New command.
+ (python-backspace): Delete command.
+ (python-indent-dedent-line-backspace): New command.
+ (python-electric-colon): Delete command.
+ (python-indent-electric-colon): New command.
+ (python-guess-indent): Delete command.
+ (python-indent-guess-indent-offset): New command.
+ (python-shift-left): Delete command.
+ (python-indent-shift-left): New command.
+ (python-shift-right): Delete command.
+ (python-indent-shift-right): New command.
+ (python-find-function): Delete command.
+ (python-nav-jump-to-defun): New command.
+ (python-next-statement): Delete command.
+ (python-nav-forward-sentence): New command.
+ (python-previous-statement): Delete command.
+ (python-nav-backward-sentence): New command.
+ (python-fill-paragraph): Delete command.
+ (python-fill-paragraph-function): New command.
+ (python-send-buffer): Delete command.
+ (python-shell-send-buffer): New command.
+ (python-send-defun): Delete command.
+ (python-shell-send-defun): New command.
+ (python-send-region, python-send-region-and-go): Delete commands.
+ (python-shell-send-region)
+ (python-shell-switch-to-shell): New commands.
+ (python-send-string): Delete command.
+ (python-shell-send-string): New command.
+ (python-switch-to-python): Delete command.
+ (python-shell-switch-to-shell): New command.
+ (python-describe-symbol): Delete command.
+ (python-eldoc-at-point): New command.
+ (python--set-prompt-regexp, python-args-to-list)
+ (python-after-info-look, python-check-version)
+ (python-check-comint-prompt, python-find-imports)
+ (python-execute-file, turn-off-pdbtrack, turn-on-pdbtrack)
+ (python-unload-function, python-expand-template)
+ (python-maybe-jython, python-preoutput-filter)
+ (python-pdbtrack-get-source-buffer)
+ (python-pdbtrack-grub-for-buffer, python-pdbtrack-overlay-arrow)
+ (python-pdbtrack-toggle-stack-tracking)
+ (python-pdbtrack-track-stack-file, python-initial-text)
+ (python-first-word, python-comment-line-p, python-send-command)
+ (python-setup-brm, python-sentinel, python-set-proc)
+ (python-skip-out, python-input-filter, python-outdent-p)
+ (python-outline-level, python-backslash-continuation-line-p)
+ (python-end-of-block, python-end-of-statement, python-mark-block)
+ (python-beginning-of-block, python-beginning-of-statement)
+ (python-blank-line-p, python-beginning-of-string)
+ (python-open-block-statement-p): Delete functions.
+ (python-indent-line, python-indent-line-1): Delete functions.
+ (python-indent-line): New function.
+ (python-indentation-levels): Delete function.
+ (python-indent-calculate-levels): New function.
+ (python-proc): Delete function.
+ (python-shell-get-process): New function.
+ (python-send-receive): Delete function.
+ (python-shell-send-string-no-output): New function.
+ (python-module-path): Delete function.
+ (python-ffap-module-path): New function.
+ (python-completion-at-point)
+ (python-symbol-completions): Delete functions.
+ (python-completion-complete-at-point): New function.
+ (python-load-file): Delete function.
+ (python-shell-send-file): New function.
+ (python-calculate-indentation): Delete function.
+ (python-indent-calculate-indentation): New function.
+ (python-skip-comments/blanks): Delete function.
+ (python-util-forward-comment): New function.
+ (python-continuation-line-p): Delete function.
+ (python-info-continuation-line-p): New function.
+ (python-which-func, python-current-defun): Delete function.
+ (python-info-current-defun): New function.
+ (python-beginning-of-defun): Delete function.
+ (python-nav-beginning-of-defun): New function.
+ (python-close-block-statement-p)
+ (python-block-end-p): Delete function.
+ (python-info-closing-block): New function.
+ (python-comint-output-filter-function)
+ (python-eldoc--get-doc-at-point, python-end-of-defun-function)
+ (python-fill-comment, python-fill-decorator, python-fill-paren)
+ (python-fill-string, python-imenu-make-element-tree)
+ (python-imenu-make-tree, python-imenu-tree-assoc)
+ (python-indent-context, python-indent-dedent-line)
+ (python-indent-line-function)
+ (python-indent-post-self-insert-function)
+ (python-indent-toggle-levels)
+ (python-info-assignment-continuation-line-p)
+ (python-info-beginning-of-backlash)
+ (python-info-block-continuation-line-p)
+ (python-info-closing-block-message)
+ (python-info-line-ends-backslash-p)
+ (python-info-looking-at-beginning-of-defun)
+ (python-info-ppss-context, python-info-ppss-context-type)
+ (python-nav-list-defun-positions, python-nav-read-defun)
+ (python-nav-sentence-end, python-nav-sentence-start)
+ (python-pdbtrack-comint-output-filter-function)
+ (python-pdbtrack-set-tracked-buffer)
+ (python-shell-calculate-exec-path)
+ (python-shell-calculate-process-environment)
+ (python-shell-completion--do-completion-at-point)
+ (python-shell-completion--get-completions)
+ (python-shell-completion-complete-at-point)
+ (python-shell-completion-complete-or-indent)
+ (python-shell-get-or-create-process)
+ (python-shell-get-process-name)
+ (python-shell-internal-get-or-create-process)
+ (python-shell-internal-get-process-name)
+ (python-shell-internal-send-string, python-shell-make-comint)
+ (python-shell-parse-command, python-shell-send-setup-code)
+ (python-skeleton-add-menu-items)
+ (python-util-clone-local-variables, python-util-position)
+ (run-python-internal, python-indentation-levels)
+ (python-nav-beginning-of-defun)
+ (python-completion-complete-at-point): New functions.
+ (run-python): Change arguments. New API requirements.
+
+2012-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el (cl--defsubst-expand): Autoload inliner
+ (bug#11649).
+
+ * emacs-lisp/macroexp.el (macroexp--compiler-macro): New function.
+ (macroexp--expand-all): Use it.
+
+ * emacs-lisp/cl-macs.el (cl--transform-function-property): Remove.
+ (cl-define-setf-expander, cl-deftype, cl-define-compiler-macro):
+ Use `cl-function' instead.
+
+2012-06-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (COMPILE_FIRST): Remove subr.el.
+ Suggested by Stefan Monnier while discussing bug#11657.
+
+2012-06-14 Sam Steingold <sds@gnu.org>
+
+ * files.el (abort-if-file-too-large): Use `file-size-human-readable'.
+
+2012-06-14 Andreas Schwab <schwab@linux-m68k.org>
+
+ * play/doctor.el (doctor-doc): Remove parameter and use
+ doctor-sent instead of sent.
+ (doctor-read-print): Use doctor-sent instead of sent. (Bug#11708)
+
+2012-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files.el: Require cl-lib.
+ (file-name-non-special): Replace case -> cl-case.
+
+ * emacs-lisp/cl-macs.el (cl-defstruct): Don't add print-func.
+
+ * emacs-lisp/edebug.el (edebug-read-function): Remove old incorrect
+ mapping from #' to function*.
+
+2012-06-13 Chong Yidong <cyd@gnu.org>
+
+ * mouse.el (mouse-drag-track): Do not set the mark if the user
+ releases the mouse without selecting anything (Bug#11588).
+
+2012-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/tex-mode.el (latex-indent): Recognize tex-verbatim at EOB
+ as well (bug#11646).
+
+ * loadup.el: Count byte-code functions as well.
+
+ * emacs-lisp/byte-opt.el (featurep): Move compiler-macro...
+ * emacs-lisp/bytecomp.el (featurep): ...here (bug#11692).
+
+ * emacs-lisp/autoload.el (make-autoload): Accept nil doc-string-elt
+ (bug#11649). Add cl-defun and cl-defmacro.
+
+2012-06-13 Drew Adams <drew.adams@oracle.com>
+
+ * help-mode.el (help-bookmark-make-record, help-bookmark-jump):
+ Fix last change.
+
+2012-06-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus-call-method): Use timeout for `read-event'.
+ Otherwise, it blocks in batch mode.
+
+2012-06-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * help-mode.el (bookmark-make-record-default): Declare.
+
+2012-06-13 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/package.el (list-packages): Compute a list of
+ packages that are newly-available since the last list-packages
+ invocation.
+ (package-menu--new-package-list): New var.
+ (package-menu--generate, package-menu--print-info)
+ (package-menu--status-predicate, package-menu-mark-install):
+ Handle new status label "new".
+
+2012-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-remf): Fix error in recent
+ conversion to backquotes.
+
+2012-06-12 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/edebug.el (edebug-inhibit-emacs-lisp-mode-bindings):
+ Rename from gud-inhibit-global-bindings.
+
+ * emacs-lisp/eieio.el (eieio-pre-method-execution-hooks): Doc fix.
+
+ * nxml/nxml-glyph.el (nxml-glyph-set-functions): Rename abnormal
+ hook from nxml-glyph-set-hook.
+
+ * progmodes/cwarn.el (cwarn-mode): Remove redundant variable
+ declaration.
+
+ * progmodes/pascal.el (pascal-toggle-completions): Doc fix.
+
+ * textmodes/bibtex.el (bibtex-string-file-path, bibtex-file-path):
+ Convert to defcustom.
+
+2012-06-12 Drew Adams <drew.adams@oracle.com>
+
+ * help-mode.el (help-bookmark-make-record, help-bookmark-jump):
+ New functions.
+ (help-mode): Use them.
+
+2012-06-11 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/fortran.el (fortran-font-lock-keywords-3):
+ Use preprocessor face for directives.
+ (fortran-directive-re): Doc fix.
+
+2012-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-parse-loop-clause): Fix error in recent
+ conversion to backquotes (bug#11652).
+
+ Fix compiler-expansion of CL's cXXr functions (bug#11673).
+ * emacs-lisp/cl-lib.el (cl--defalias): New function.
+ (cl-values, cl-values-list, cl-copy-seq, cl-svref, cl-first)
+ (cl-second, cl-rest, cl-endp, cl-third, cl-fourth): Use it.
+ (cl-plusp, cl-minusp, cl-fifth, cl-sixth, cl-seventh, cl-eighth)
+ (cl-ninth, cl-tenth): Mark them as inlinable.
+ (cl-caaar, cl-caadr, cl-cadar, cl-caddr, cl-cdaar, cl-cdadr)
+ (cl-cddar, cl-cdddr, cl-caaaar, cl-caaadr, cl-caadar, cl-caaddr)
+ (cl-cadaar, cl-cadadr, cl-caddar, cl-cadddr, cl-cdaaar, cl-cdaadr)
+ (cl-cdadar, cl-cdaddr, cl-cddaar, cl-cddadr, cl-cdddar, cl-cddddr):
+ Add a compiler-macro declaration to use cl--compiler-macro-cXXr.
+ (cl-list*, cl-adjoin): Don't put an autoload manually.
+ * emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin)
+ (cl--compiler-macro-list*): Add autoload cookie.
+ (cl--compiler-macro-cXXr): New function.
+
+ * help-fns.el (help-fns--compiler-macro): New function extracted from
+ describe-function-1; follow aliases and use `compiler-macro' property.
+ (describe-function-1): Use it.
+
+2012-06-11 Chong Yidong <cyd@gnu.org>
+
+ * startup.el (fancy-splash-head): Use splash.svg even if librsvg
+ is uninstalled, if imagemagick is installed.
+
+2012-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el: Use lexical-binding.
+ (cl-map-extents, cl-maclisp-member): Remove.
+ (cl--set-elt, cl--set-nthcdr, cl--set-buffer-substring)
+ (cl--set-substring, cl--block-wrapper, cl--block-throw)
+ (cl--compiling-file, cl--mapcar-many, cl--do-subst): Use "cl--" prefix.
+ * emacs-lisp/cl-extra.el: Use lexical-binding.
+ (cl--mapcar-many, cl--map-keymap-recursively, cl--map-intervals)
+ (cl--map-overlays, cl--set-frame-visible-p, cl--progv-save)
+ (cl--progv-before, cl--progv-after, cl--finite-do, cl--set-getf)
+ (cl--do-remf, cl--do-prettyprint): Use "cl--" prefix.
+ * emacs-lisp/cl-seq.el: Use lexical-binding.
+ (cl--parsing-keywords, cl--check-key, cl--check-test-nokey)
+ (cl--check-test, cl--check-match): Use "cl--" prefix and backquotes.
+ (cl--alist, cl--sublis-rec, cl--nsublis-rec, cl--tree-equal-rec):
+ * emacs-lisp/cl-macs.el (cl--lambda-list-keywords): Use "cl--" prefix.
+ * edmacro.el (edmacro-mismatch): Simplify to remove dependence on
+ CL's internals.
+
+2012-06-11 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.6-pre.
+
+ * net/tramp-cache.el (tramp-dump-connection-properties): Let-bind
+ `print-length' and `print-level' to nil, in order to avoid
+ truncation. Reported by Christopher Schmidt
+ <christopher@ristopher.com>.
+
+ * net/tramp-cmds.el (tramp-cleanup-connection): Delete also process.
+
+ * net/tramp-compat.el (tramp-compat-condition-case-unless-debug):
+ New defmacro.
+ (tramp-compat-copy-directory): Add optional argument
+ COPY-CONTENTS. It is not handled yet.
+
+ * net/tramp-ftp.el (tramp-disable-ange-ftp): Fix docstring.
+ (tramp-ftp-file-name-p): Simplify.
+
+ * net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name):
+ * net/tramp-gw.el (tramp-gw-open-connection): Add hop to
+ connection vector.
+
+ * net/tramp-sh.el (tramp-copy-size-limit): Fix docstring.
+ (tramp-methods): Do not use `tramp-password-end-of-line'.
+ (tramp-completion-function-alist-putty): Handle UNIX case.
+ (tramp-remote-path): Add "/opt/bin", "/opt/sbin" and "/opt/local/bin".
+ (tramp-do-file-attributes-with-stat)
+ (tramp-do-directory-files-and-attributes-with-stat) Return uid and
+ gid as real numbers. They could run out of integer range on cygwin.
+ (tramp-do-copy-or-rename-file-out-of-band): Better trace format.
+ (tramp-sh-handle-expand-file-name): Handle hops.
+ (tramp-open-connection-setup-interactive-shell):
+ Use `tramp-cleanup'. Move check for busyboxes ...
+ (tramp-find-shell): ... here. Simplify implementation.
+ Set "remote-shell" property also for alternative shells.
+ (tramp-remote-coding-commands): Check "test -c /dev/stdout".
+ If failing, a regular file would be written otherwise.
+ Reported by Dmitry Kurochkin <dmitry.kurochkin@gmail.com>.
+ (tramp-find-inline-encoding): Cache the coding commands in the
+ process cache. Apply test command on the remote side, if defined.
+ (tramp-find-inline-compress): Cache the compress commands in the
+ process cache.
+ (tramp-compute-multi-hops): Save `tramp-default-proxies-alist'
+ when requested. Handle hops.
+ (tramp-current-connection): New defvar.
+ (tramp-maybe-open-connection): Use `tramp-cleanup'.
+ Throw `suppress', if there was a failed connection shortly before.
+ Handle user interrupt. (Bug#10187)
+ (tramp-get-inline-compress, tramp-get-inline-coding):
+ Read connection properties from the process cache.
+
+ * net/tramp-smb.el (tramp-smb-server-version)
+ (tramp-smb-wrong-passwd-regexp, tramp-smb-actions-with-tar):
+ New defconsts.
+ (tramp-smb-prompt): Extend for powershell prompt.
+ (tramp-smb-file-name-handler-alist): Add handlers for
+ `process-file', `shell-command' and `start-file-process'.
+ (tramp-smb-winexe-program, tramp-smb-winexe-shell-command)
+ (tramp-smb-winexe-shell-command-switch): New defcustoms.
+ (tramp-smb-file-name-p): Simplify.
+ (tramp-smb-action-with-tar, tramp-smb-handle-process-file)
+ (tramp-smb-kill-winexe-function, tramp-smb-call-winexe)
+ (tramp-smb-shell-quote-argument): New defuns.
+ (tramp-smb-handle-copy-directory): Add COPY-CONTENTS argument.
+ Implement using "tar". By this, time-stamps are preserved.
+ (tramp-smb-handle-copy-file): Handle also the case of directories.
+ (tramp-smb-do-file-attributes-with-stat)
+ (tramp-smb-get-file-entries, tramp-smb-get-cifs-capabilities):
+ Use `tramp-get-connection-buffer').
+ (tramp-smb-handle-rename-file): Use "rename", when source and
+ target are on the same share.
+ (tramp-smb-maybe-open-connection): Handle wrong passwords.
+ Use `tramp-smb-server-version'.
+ (tramp-smb-wait-for-output): Remove prompt.
+
+ * net/tramp.el (top): Require 'cl.
+ (tramp-methods, tramp-rsh-end-of-line):
+ Remove `tramp-password-end-of-line' from docstring.
+ (tramp-save-ad-hoc-proxies): New defcustom.
+ (tramp-completion-function-alist): Adapt docstring.
+ (tramp-default-password-end-of-line): Remove defcustom.
+ (tramp-shell-prompt-pattern): Allow "[]" style prompts. (Bug#11065)
+ (tramp-user-regexp, tramp-file-name-regexp-unified)
+ (tramp-file-name-regexp-url): Extend regexp by hop separator.
+ (tramp-postfix-hop-format, tramp-postfix-hop-regexp)
+ (tramp-remote-file-name-spec-regexp): New defconst.
+ (tramp-file-name-structure): Extend structure for hops.
+ (tramp-get-method-parameter): Move up.
+ (tramp-file-name-p, tramp-dissect-file-name)
+ (with-parsed-tramp-file-name): Handle hops.
+ (tramp-file-name-hop): New defun.
+ (tramp-make-tramp-file-name): New optional arg HOP.
+ (tramp-message-show-progress-reporter-message): New defvar.
+ (tramp-with-progress-reporter): Use it. We cannot use
+ `tramp-message-show-message' here, because this suppresses also
+ error buffers.
+ (tramp-error-with-buffer): Suppress buffer view, if
+ `tramp-message-show-message' is nil.
+ Use `tramp-get-connection-buffer'.
+ (tramp-cleanup): New defun.
+ (tramp-rfn-eshadow-update-overlay): Let-bind `non-essential' to `t'.
+ (tramp-file-name-handler): If `debug-on-error' is set, propagate
+ an error unchanged.
+ (tramp-completion-handle-file-name-all-completions): Handle hops.
+ Fix an error when called from ido.
+ (tramp-completion-dissect-file-name): Use better local variable
+ name. Add hop to the vector.
+ (tramp-handle-insert-file-contents): Use progress-reporter for the
+ whole scenario.
+ (tramp-action-password): Let-bind `enable-recursive-minibuffers'
+ to `t'.
+ (tramp-check-for-regexp): Simplify search.
+ (tramp-enter-password): Remove it. Move implementation ...
+ (tramp-action-password): ... here.
+ (tramp-mode-string-to-int, tramp-local-host-p)
+ (tramp-make-tramp-temp-file, tramp-read-passwd)
+ (tramp-clear-passwd, tramp-time-less-p, tramp-time-diff):
+ Set tramp-autoload cookie.
+
+ * net/trampver.el: Update release number.
+
+2012-06-11 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+ Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-set-completion-function): Fix docstring.
+ (tramp-parse-group, tramp-parse-file)
+ (tramp-parse-shostkeys-sknownhosts): New defuns.
+ (tramp-parse-rhosts, tramp-parse-rhosts-group, tramp-parse-shosts)
+ (tramp-parse-shosts-group, tramp-parse-sconfig)
+ (tramp-parse-sconfig-group, tramp-parse-shostkeys)
+ (tramp-parse-sknownhosts, tramp-parse-hosts)
+ (tramp-parse-hosts-group, tramp-parse-passwd, tramp-parse-netrc):
+ Use them.
+ (tramp-parse-passwd-group, tramp-parse-netrc-group)
+ (tramp-parse-putty-group): Don't narrow.
+ (tramp-parse-putty): Make a loop.
+ (tramp-file-name-handler): Catch the `suppress' signal.
+
+2012-06-11 Chong Yidong <cyd@gnu.org>
+
+ * image.el (imagemagick-register-types): Put the ImageMagick entry
+ at the end of image-type-file-name-regexps.
+
+2012-06-11 Johan Bockgård <bojohan@gnu.org>
+
+ * emacs-lisp/pcase.el (pcase-UPAT, pcase-QPAT): New edebug specs.
+ (pcase, pcase-let*, pcase-dolist): Use them.
+
+2012-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase--let*): New function.
+ (pcase-let*): Use it. Use pcase--memoize to avoid repeated expansions.
+ (pcase--expand): Use macroexp-let².
+
+2012-06-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/timer.el, emacs-lisp/syntax.el, emacs-lisp/smie.el:
+ * emacs-lisp/ewoc.el, emacs-lisp/cconv.el, emacs-lisp/bytecomp.el:
+ * emacs-lisp/byte-opt.el, emacs-lisp/autoload.el: Convert to cl-lib.
+ * emacs-lisp/easymenu.el, emacs-lisp/easy-mmode.el:
+ * emacs-lisp/derived.el: Use pcase instead of `cl'.
+ * emacs-lisp/cl-lib.el: Get rid of special cl-macs auto load.
+
+2012-06-10 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmail.el (rmail-yank-current-message): Leave point at
+ correct position. (Bug#11660)
+
+2012-06-10 Chong Yidong <cyd@gnu.org>
+
+ * allout-widgets.el: Fix code header.
+
+2012-06-10 Chong Yidong <cyd@gnu.org>
+
+ * cus-edit.el (customize-changed-options-previous-release):
+ Bump to 24.1.
+
+2012-06-09 Andreas Schwab <schwab@linux-m68k.org>
+
+ * Makefile.in (BIG_STACK_DEPTH): Enlarge to 2200.
+
+2012-06-09 Chong Yidong <cyd@gnu.org>
+
+ * ebuff-menu.el (electric-buffer-list): Preserve header line.
+
+2012-06-09 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (special-display-popup-frame): Don't use
+ window--display-buffer (Bug#11651).
+
+2012-06-09 Eli Zaretskii <eliz@gnu.org>
+
+ Fix parallel builds: make sure loaddefs.el is not being written
+ while Lisp files are compiled.
+ (compile): Don't depend on 'mh-autoloads'.
+ (compile-CMD, compile-SH): Depend on 'autoloads'.
+ (bootstrap): Don't depend on 'autoloads' and 'mh-autoloads'.
+
+ * makefile.w32-in (BIG_STACK_DEPTH): Enlarge to 2200. (Bug#11649)
+
+2012-06-09 Chong Yidong <cyd@gnu.org>
+
+ * face-remap.el (face-remap-add-relative, face-remap-set-base)
+ (buffer-face-set, buffer-face-toggle, buffer-face-mode-invoke):
+ Doc fixes (Bug#11225).
+
+2012-06-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexp--expand-all): Only autoload
+ a function if there's a clear indication that it has a compiler-macro.
+ * emacs-lisp/byte-run.el (defun-declarations-alist, defmacro, defun)
+ (macro-declarations-alist): Add arglist to declaration functions.
+ (defun-declarations-alist): Add `obsolete' and `compiler-macro'.
+ * emacs-lisp/cl-seq.el (cl-member, cl-assoc):
+ * emacs-lisp/cl-lib.el (cl-list*, cl-adjoin):
+ * emacs-lisp/cl-extra.el (cl-get): Use the new `declare' statement.
+ Also add autoload to find the compiler macro.
+ * emacs-lisp/cl-macs.el (eql) [compiler-macro]: Remove.
+ (cl--compiler-macro-member, cl--compiler-macro-assoc)
+ (cl--compiler-macro-adjoin, cl--compiler-macro-list*)
+ (cl--compiler-macro-get): New functions, replacing calls to
+ cl-define-compiler-macro.
+ (cl-typep) [compiler-macro]: Use macroexp-let².
+
+2012-06-08 Nick Dokos <nicholas.dokos@hp.com> (tiny change)
+
+ * calendar/icalendar.el (icalendar--parse-vtimezone): Import TZID
+ string properly, fixes Bug#11473.
+
+2012-06-08 Chong Yidong <cyd@gnu.org>
+
+ * faces.el (set-face-attribute): Doc fix.
+ (modify-face): Don't use :bold and :italic.
+ (error, warning, success): Tweak definitions.
+
+ * cus-edit.el (custom-modified, custom-invalid, custom-rogue)
+ (custom-modified, custom-set, custom-changed, custom-themed)
+ (custom-saved, custom-button, custom-button-mouse)
+ (custom-button-pressed, custom-state, custom-comment-tag)
+ (custom-variable-tag, custom-group-tag-1, custom-group-tag)
+ (custom-group-subtitle): Use new-style face specs.
+ (custom-invalid-face, custom-rogue-face, custom-modified-face)
+ (custom-set-face, custom-changed-face, custom-saved-face)
+ (custom-button-face, custom-button-pressed-face)
+ (custom-documentation-face, custom-state-face)
+ (custom-comment-face, custom-comment-tag-face)
+ (custom-variable-tag-face, custom-variable-button-face)
+ (custom-face-tag-face, custom-group-tag-face-1)
+ (custom-group-tag-face): Remove obsolete face alias.
+
+ * epa.el (epa-validity-high, epa-validity-medium)
+ (epa-validity-low, epa-mark, epa-field-name, epa-string)
+ (epa-field-name, epa-field-body):
+ * font-lock.el (font-lock-comment-face, font-lock-string-face)
+ (font-lock-keyword-face, font-lock-builtin-face)
+ (font-lock-function-name-face, font-lock-variable-name-face)
+ (font-lock-type-face, font-lock-constant-face):
+ * ido.el (ido-first-match, ido-only-match, ido-subdir)
+ (ido-virtual, ido-indicator, ido-incomplete-regexp):
+ * speedbar.el (speedbar-button-face, speedbar-file-face)
+ (speedbar-directory-face, speedbar-tag-face)
+ (speedbar-selected-face, speedbar-highlight-face)
+ (speedbar-separator-face):
+ * whitespace.el (whitespace-newline, whitespace-space)
+ (whitespace-hspace, whitespace-tab, whitespace-trailing)
+ (whitespace-line, whitespace-space-before-tab)
+ (whitespace-space-after-tab, whitespace-indentation)
+ (whitespace-empty):
+ * emulation/cua-base.el (cua-global-mark):
+ * eshell/em-prompt.el (eshell-prompt):
+ * net/newst-plainview.el (newsticker-new-item-face)
+ (newsticker-old-item-face, newsticker-immortal-item-face)
+ (newsticker-obsolete-item-face, newsticker-date-face)
+ (newsticker-statistics-face, newsticker-default-face):
+ * net/newst-reader.el (newsticker-feed-face)
+ (newsticker-extra-face, newsticker-enclosure-face):
+ * net/newst-treeview.el (newsticker-treeview-face)
+ (newsticker-treeview-new-face, newsticker-treeview-old-face)
+ (newsticker-treeview-immortal-face)
+ (newsticker-treeview-obsolete-face)
+ (newsticker-treeview-selection-face):
+ * net/rcirc.el (rcirc-my-nick, rcirc-other-nick)
+ (rcirc-bright-nick, rcirc-server, rcirc-timestamp)
+ (rcirc-nick-in-message, rcirc-nick-in-message-full-line)
+ (rcirc-prompt, rcirc-track-keyword, rcirc-url, rcirc-keyword):
+ * nxml/nxml-outln.el (nxml-heading, nxml-outline-indicator)
+ (nxml-outline-active-indicator, nxml-outline-ellipsis):
+ * play/mpuz.el (mpuz-unsolved, mpuz-solved, mpuz-trivial)
+ (mpuz-text):
+ * progmodes/vera-mode.el (vera-font-lock-number)
+ (vera-font-lock-function, vera-font-lock-interface):
+ * textmodes/table.el (table-cell): Use new-style face specs, and
+ don't use the old :bold and :italic attributes.
+
+ * progmodes/ebrowse.el (ebrowse-tree-mark, ebrowse-root-class)
+ (ebrowse-member-attribute, ebrowse-default, ebrowse-file-name)
+ (ebrowse-member-class, ebrowse-progress): Likewise.
+ (ebrowse-tree-mark-face, ebrowse-root-class-face)
+ (ebrowse-file-name-face, ebrowse-default-face)
+ (ebrowse-member-attribute-face, ebrowse-member-class-face)
+ (ebrowse-progress-face): Remove obsolete faces.
+
+ * progmodes/flymake.el (flymake-errline, flymake-warnline):
+ Inherit from error and warning faces respectively.
+
+ * textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate):
+ Likewise.
+ (flyspell-incorrect-face, flyspell-duplicate-face):
+ Remove obsolete aliases.
+
+2012-06-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-compat.el (tramp-compat-temporary-file-directory):
+ Avoid infloop.
+
+2012-06-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * startup.el (argv, argi): Make lexically scoped.
+ * emacs-lisp/float-sup.el (pi): Use internal-make-var-non-special.
+ * emacs-lisp/cl-macs.el: Use lexical-binding.
+ Rename cl-bind-* to cl--bind-*.
+ * files.el: Don't require `cl' since it doesn't use it.
+ * emacs-lisp/pcase.el, emacs-lisp/macroexp.el: Add coding cookie.
+
+2012-06-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * textmodes/texinfmt.el: Fix bug#11640 (reverts part of 2008-07-31T05:33:56Z!dann@ics.uci.edu).
+ (texinfo-format-printindex): Use `texinfo-sort-region' in all platforms,
+ instead of calling external sort utility.
+ (texinfo-sort-region, texinfo-sort-startkeyfun): Restore functions.
+
+2012-06-08 Eli Zaretskii <eliz@gnu.org>
+
+ * descr-text.el (describe-char): Mention how to insert the
+ character, if the current input method doesn't support it.
+ See the discussion in this thread for the details:
+ http://lists.gnu.org/archive/html/emacs-devel/2012-05/msg00533.html.
+
+2012-06-08 Sam Steingold <sds@gnu.org>
+
+ * bindings.el (global-map): Bind XF86Forward to next-buffer and
+ XF86Back to previous-buffer.
+ (minibuffer-local-map): Bind them to next-history-element and
+ previous-history-element respectively.
+ * help-mode.el (help-mode-map): Bind them to help-go-forward and
+ help-go-back respectively.
+ * info.el (Info-mode-map): Bind them to Info-history-forward and
+ Info-history-back respectively.
+ These are the keys next to Up on the ThinkPad keyboard.
+
+2012-06-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Get rid of cl-lexical-let, keeping only lexical-let for compatibility.
+ * emacs-lisp/cl-macs.el: Provide itself.
+ (cl--labels-convert-cache): New var.
+ (cl--labels-convert): New function.
+ (cl-flet, cl-labels): New implementation with new semantics, relying on
+ lexical-binding.
+ * emacs-lisp/cl.el: Mark compatibility aliases as obsolete.
+ (cl-closure-vars, cl--function-convert-cache)
+ (cl--function-convert): Move from cl-macs.el.
+ (lexical-let, lexical-let*, flet, labels): Move from cl-macs.el and
+ rename by removing the "cl-" prefix.
+ * emacs-lisp/macroexp.el (macroexp-unprogn): New function.
+
+2012-06-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl.el (cl-macroexpand, cl-macro-environment)
+ (cl-macroexpand-all, cl-not-hash-table, cl-builtin-gethash)
+ (cl-builtin-remhash, cl-builtin-clrhash, cl-builtin-maphash)
+ (cl-map-keymap, cl-copy-tree, cl-gethash, cl-puthash, cl-remhash)
+ (cl-clrhash, cl-maphash, cl-make-hash-table, cl-hash-table-p)
+ (cl-hash-table-count): Add old compatibility aliases.
+
+ * emacs-lisp/cl-macs.el (cl-macro-environment): Remove var.
+ Use macroexpand-all-environment instead.
+ (cl--old-macroexpand): New var.
+ (cl--sm-macroexpand): New function.
+ (cl-symbol-macrolet): Use it during macro expansion.
+ (cl--function-convert-cache): New var.
+ (cl--function-convert): New function, extracted from
+ cl-macroexpand-all.
+ (cl-lexical-let): Use it.
+
+ * emacs-lisp/cl-lib.el (cl-macro-environment): Remove decl.
+ (cl-macroexpand): Move to cl-macs.el and rename to cl--sm-macroexpand.
+ (cl-member): Remove old alias.
+
+ * emacs-lisp/cl-extra.el (cl-map-keymap, cl-copy-tree)
+ (cl-not-hash-table, cl-builtin-gethash, cl-builtin-remhash)
+ (cl-builtin-clrhash, cl-builtin-maphash, cl-gethash, cl-puthash)
+ (cl-remhash, cl-clrhash, cl-maphash, cl-make-hash-table)
+ (cl-hash-table-p, cl-hash-table-count): Move to cl.el.
+ (cl-macroexpand-cmacs): Remove var.
+ (cl-macroexpand-all, cl-macroexpand-body): Remove funs.
+ Use macroexpand-all instead.
+
+2012-06-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexp-progn, macroexp-let*, macroexp-if)
+ (macroexp-let², macroexp--const-symbol-p, macroexp-const-p)
+ (macroexp-copyable-p): New functions and macros.
+ * emacs-lisp/edebug.el (edebug-unwrap):
+ * emacs-lisp/disass.el (disassemble-internal): Use macroexp-progn.
+ * emacs-lisp/pcase.el: Use macroexp-let*, macroexp-if, ...
+ (pcase--let*): Remove.
+ * emacs-lisp/bytecomp.el (byte-compile-const-symbol-p)
+ (byte-compile-constp): Remove. Use macroexp--const-symbol-p and
+ macroexp-const-p instead.
+ * emacs-lisp/byte-opt.el: Use macroexp-const-p and macroexp-progn.
+
+ * emacs-lisp/cl-macs.el: Clean up the name space by using "cl--"
+ instead of "cl-" for internal definitions. Use macroexp-const-p.
+ (cl-old-bc-file-form): Remove var.
+ (cl-const-exprs-p): Remove fun.
+ (cl-labels, cl-macrolet): Use backquote.
+ (cl-lexical-let): Use cl-symbol-macrolet. Don't use cl-defun-expander.
+ (cl-defun-expander, cl-byte-compile-compiler-macro): Remove fun.
+ (cl-define-setf-expander): Rename from cl-define-setf-method.
+ * emacs-lisp/cl.el: Adjust alias for define-setf-method.
+
+ * international/mule-cmds.el: Don't require CL.
+ (view-hello-file): Don't use `letf'.
+
+2012-06-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * tmm.el (tmm-prompt): Use string-prefix-p.
+ (tmm-completion-delete-prompt): Don't affect current-buffer outside.
+ (tmm-add-prompt): Use minibuffer-completion-help.
+ (tmm-delete-map): Remove.
+
+ * subr.el (kbd): Make it its own function.
+
+2012-06-07 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Use `eval-when-compile' for requiring `cl.el'.
+ Silence compiler warnings. Fix versions.
+ (rst-position-if, rst-position, rst-some, rst-signum): New functions.
+ (rst-shift-region, rst-adornment-level, rst-compute-tabs)
+ (rst-indent-line, rst-shift-region, rst-forward-line): Use them.
+ (rst-package-emacs-version-alist): Correct Emacs version to
+ represent major merge with upstream.
+ (rst-transition, rst-adornment, rst-compile-toolsets): Fix versions.
+
+2012-06-06 Glenn Morris <rgm@gnu.org>
+
+ * mail/emacsbug.el (report-emacs-bug): Add relevant EMACS env-vars.
+ Only print environment variables if set.
+
+2012-06-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el: Don't require CL since we don't use it.
+ (macroexp--cons): Rename from maybe-cons.
+ (macroexp--accumulate): Rename from macroexp-accumulate.
+ (macroexp--all-forms): Rename from macroexpand-all-forms.
+ (macroexp--all-clauses): Rename from macroexpand-all-clauses.
+ (macroexp--expand-all): Rename from macroexpand-all-1.
+
+2012-06-06 Sam Steingold <sds@gnu.org>
+
+ * calendar/calendar.el (calendar-in-read-only-buffer):
+ Call `special-mode' to enable the standard read-only keybindings.
+
+2012-06-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexpand-all-1): Don't spam the output
+ with "loading" messages (bug#11635).
+
+2012-06-06 Michael Albinus <michael.albinus@gmx.de>
+
+ * files.el (enable-remote-dir-locals): New option.
+ (hack-dir-local-variables): Use it. (Bug#1933, Bug#6731)
+
+ * net/tramp-compat.el (tramp-compat-temporary-file-directory):
+ Ensure, that the temp directory is local.
+
+ * net/tramp-sh.el (tramp-sh-handle-write-region): Let-bind
+ `temporary-file-directory'.
+
+ * progmodes/python.el (python-send-region): Ensure, that the
+ temporary file is created also in the remote case.
+
+2012-06-06 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-rcs.el (vc-rcs-rcs2log-program): New.
+ (vc-rcs-update-changelog): Use it.
+
+ * emacs-lisp/authors.el (authors-fixed-entries): Remove vcdiff.
+
+ * vc/vc-sccs.el (vc-sccs-write-revision): New function.
+ (vc-sccs-workfile-unchanged-p): Use vc-sccs-write-revision.
+ (vc-sccs-diff): Replace use of the external vcdiff script.
+
+2012-06-05 Glenn Morris <rgm@gnu.org>
+
+ * ledit.el: Move to obsolete/.
+
+2012-06-05 Sam Steingold <sds@gnu.org>
+
+ * calendar/calendar.el (calendar-exit): Reinstate the 2012-03-28
+ patch (Bug#11140).
+
+2012-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cust-print.el: Move to obsolete.
+
+ * emacs-lisp/macroexp.el (macroexpand-all-1): Tolerate errors during
+ compiler-macro expansion.
+
+ Add native compiler-macro support.
+ * emacs-lisp/macroexp.el (macroexpand-all-1):
+ Support compiler-macros directly. Properly follow aliases and apply
+ the compiler macros more thoroughly.
+ * emacs-lisp/cl.el: Don't copy compiler-macro properties any more since
+ macroexpand now properly follows aliases.
+ * emacs-lisp/cl-macs.el (toplevel, cl-define-compiler-macro)
+ (cl-compiler-macroexpand): Use new prop.
+ * emacs-lisp/byte-opt.el (featurep): Optimize earlier.
+
+ * emacs-lisp/cl-lib.el (custom-print-functions): Add alias.
+
+2012-06-05 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (get-lru-window, get-mru-window, get-largest-window):
+ New argument NOT-SELECTED to avoid picking the selected window.
+ (window--display-buffer-1, window--display-buffer-2): Replace by
+ new function window--display-buffer
+ (display-buffer-same-window, display-buffer-reuse-window)
+ (display-buffer-pop-up-frame, display-buffer-pop-up-window):
+ Use window--display-buffer.
+ (display-buffer-use-some-window): Remove temporary dedication
+ hack by calling get-lru-window and get-largest-window with
+ NOT-SELECTED argument non-nil. Call window--display-buffer.
+
+2012-06-05 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-sccs.el (vc-sccs-workfile-unchanged-p):
+ Replace external vcdiff script.
+
+2012-06-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el (cl-values, cl-values-list): Fix up last change.
+
+2012-06-04 Chong Yidong <cyd@gnu.org>
+
+ * image.el (imagemagick-types-inhibit): Revert last change.
+ Add INFO and M.
+ (imagemagick-enabled-types): Remove CIN and EPS*.
+
+2012-06-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el: Rename from cl.el.
+ * emacs-lisp/cl.el: New compatibility file.
+ * emacs-lisp/cl-lib.el, emacs-lisp/cl-seq.el, emacs-lisp/cl-macs.el:
+ * emacs-lisp/cl-extra.el: Rename all top-level functions and variables
+ to obey the "cl-" prefix.
+ * emacs-lisp/macroexp.el (macroexpand-all-1): Adjust to new name.
+
+2012-06-03 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-aliases): Addition.
+
+ * cus-start.el (tool-bar-style, tool-bar-max-label-size):
+ Fix :version.
+
+2012-06-03 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Add comments.
+ (rst-transition, rst-adornment): New faces.
+ (rst-adornment-faces-alist): Make default safe to reevaluate.
+ Fixes
+ http://sourceforge.net/tracker/?func=detail&atid=422030&aid=3479603&group_id=38414.
+ Improve customization tags.
+ (rst-define-level-faces): Clarify meaning.
+
+2012-06-03 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/compile.el (compilation-mode-line-fail)
+ (compilation-mode-line-run, compilation-mode-line-exit):
+ New faces.
+ (compilation-start, compilation-handle-exit): Use them (Bug#11032).
+
+2012-06-03 Jack Duthen <duthen.mac.01@gmail.com> (tiny change)
+
+ * progmodes/which-func.el (which-func-update-ediff-windows):
+ New function. Use it in ediff-select-hook (Bug#11478).
+
+2012-06-03 Chong Yidong <cyd@gnu.org>
+
+ * bindings.el: Remove explicit help text from format-mode-line.
+ It is now supplied by mode-line-default-help-echo.
+ (mode-line-front-space, mode-line-end-spaces)
+ (mode-line-misc-info): New variables.
+ (mode-line-modes, mode-line-position): Move the default value to
+ the variable definition.
+ (mode-line-default-help-echo): New defcustom.
+ (mode-line-mule-info-help-echo, mode-line-read-only-help-echo)
+ (mode-line-modified-help-echo): New functions.
+ (mode-line-mule-info, mode-line-modified): Use them.
+ (mode-line-eol-desc, propertized-buffer-identification):
+ Consistency fixes for help text.
+ (mode-line-coding-system-map): Allow using mouse-3 to invoke
+ set-buffer-file-coding-system (Bug#289).
+ (mode-line-mule-info-help-echo): Update help text.
+
+2012-06-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (execute-extended-command): Set real-this-command
+ (bug#11506).
+
+2012-06-02 Chong Yidong <cyd@gnu.org>
+
+ Remove incorrect uses of "modeline" in comments, docstrings, and
+ function/variable names (Bug#10329).
+
+ * cus-edit.el (mode-line):
+ * dframe.el (dframe-mouse-hscroll):
+ * emacs-lisp/re-builder.el:
+ * emacs-lisp/easy-mmode.el (define-minor-mode):
+ * frame.el (set-frame-name):
+ * help.el (lookup-minor-mode-from-indicator):
+ * net/rcirc.el (rcirc-activity-string, rcirc-short-buffer-name):
+ * progmodes/cc-cmds.el (c-toggle-auto-newline)
+ (c-toggle-hungry-state):
+ * progmodes/antlr-mode.el (antlr-language-alist):
+ * progmodes/idlw-shell.el (idlwave-shell-electric-stop-line-face):
+ * progmodes/vhdl-mode.el (vhdl-mode):
+ * progmodes/which-func.el (which-func, which-func-cleanup-function):
+ * term/ns-win.el (ns-face-at-pos):
+ * term/sup-mouse.el (sup-mouse-report):
+ * textmodes/flyspell.el (flyspell-mode-line-string):
+ * textmodes/ispell.el (ispell-highlight-face):
+ * textmodes/reftex-global.el:
+ * vc/vc-arch.el (vc-arch-mode-line-string):
+ * vc/vc-cvs.el (vc-cvs-mode-line-string):
+ * vc/vc-git.el (vc-git-mode-line-string):
+ * vc/vc-hooks.el (vc-display-status)
+ (vc-default-mode-line-string):
+ * vc/vc-mtn.el (vc-mtn-mode-line-string): Doc fixes.
+
+ * ansi-color.el (ansi-color-faces-vector): Change default faces.
+
+ * dired.el (dired-sort-set-mode-line): Rename from
+ dired-sort-set-modeline. All callers changed.
+
+ * eshell/esh-mode.el (eshell-status-in-mode-line): Rename from
+ eshell-status-in-modeline.
+
+ * foldout.el (foldout-mode-line-string): Rename from
+ foldout-modeline-string. All callers changed.
+ (foldout-update-mode-line): Rename from foldout-update-modeline.
+
+ * subr.el (redraw-modeline): Make into obsolete alias.
+
+ * calendar/timeclock.el (timeclock-mode-line-display): Rename from
+ timeclock-modeline-display. Make old name an alias.
+ (timeclock-update-mode-line): Likewise. All callers changed.
+ (timeclock-mode-line-display): No need to check before using
+ add-hook.
+ (timeclock-relative, timeclock-day-over-hook)
+ (timeclock-use-elapsed, timeclock-mode-string)
+ (timeclock-mode-line-display): Doc fix, "modeline" -> "mode line".
+
+ * emulation/crisp.el (crisp-mode-mode-line-string): Rename from
+ crisp-mode-modeline-string.
+
+ * play/solitaire.el (solitaire-build-mode-line): Rename from
+ solitaire-build-modeline. All callers changed.
+
+ * play/zone.el (zone-hiding-mode-line): Rename from
+ zone-hiding-modeline. All callers changed.
+ (zone): Remove unusued `modeline-hidden-level' property.
+
+ * progmodes/xscheme.el (xscheme-mode-line-initialize): Rename from
+ xscheme-modeline-initialize. All callers changed.
+
+ * strokes.el (strokes-lighter): Rename from
+ strokes-modeline-string.
+
+ * textmodes/sgml-mode.el (html-face-tag-alist)
+ (html-tag-face-alist): Use mode-line face instead of obsolete
+ alias modeline.
+
+2012-06-02 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Always require `cl'.
+ (rst-mode-map): Fix meaning of C-M-a / C-M-e.
+
+2012-06-02 Chong Yidong <cyd@gnu.org>
+
+ * image.el (imagemagick-enabled-types): Rename from
+ imagemagick-types-enable. Add many more types.
+ (imagemagick-types-inhibit): Change default to nil.
+ (imagemagick-filter-types): Caller changed.
+
+2012-06-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el: Use backquotes.
+ (cl-transform-function-property): Use eval-and-compile rather than
+ abusing `require'.
+ (defstruct): Use declare-function instead of with-no-warnings.
+
+ * emacs-lisp/bytecomp.el: Fix last change (bug#11594).
+ (byte-compile-output-docform): Re-add the print-circle bindings.
+ (byte-compile-fix-header): Use #$ just because it's shorter.
+ (byte-compile-output-file-form): Remove defun/defmacro.
+
+2012-06-01 Martin Rudalics <rudalics@gmx.at>
+
+ * simple.el (choose-completion): Remove now obsolete binding for
+ owindow.
+
+2012-06-01 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-check-for-regexp): Search from buffer end,
+ in order to avoid "Stack overflow in regexp matcher".
+
+2012-05-31 Glenn Morris <rgm@gnu.org>
+
+ * image.el: For clarity, call imagemagick-register-types at
+ top-level, rather than relying on a custom :initialize.
+ (imagemagick-types-enable): New option. (Bug#11557)
+ (imagemagick-filter-types): New function. (Bug#7406)
+ (imagemagick-register-types): Use imagemagick-filter-types.
+ If disabling support, remove elements altogether rather
+ than using an impossible regexp.
+ (imagemagick-types-inhibit): Give it the default init function.
+
+2012-05-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (byte-compile-fix-header):
+ Handle arbitrary file name lengths (Bug#11585).
+
+2012-05-31 Martin Rudalics <rudalics@gmx.at>
+
+ * desktop.el (desktop-read): Clear previous and next buffers for
+ all windows and bury *Messages* buffer (bug#11556).
+
+2012-05-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Add `declare' for `defun'. Align `defmacro's with it.
+ * emacs-lisp/easy-mmode.el (define-minor-mode)
+ (define-globalized-minor-mode): Don't autoload the var definitions.
+ * emacs-lisp/byte-run.el: Use lexical-binding.
+ (defun-declarations-alist, macro-declarations-alist): New vars.
+ (defmacro, defun): Use them.
+ (make-obsolete, define-obsolete-function-alias)
+ (make-obsolete-variable, define-obsolete-variable-alias):
+ Use `declare'.
+ (macro-declaration-function): Mark obsolete.
+ * emacs-lisp/autoload.el: Use lexical-binding.
+ (make-autoload): Add `expansion' arg. Rely more on macro expansion.
+
+2012-05-30 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-with-no-warnings):
+ Define as a macro.
+ (ispell-kill-ispell, ispell-change-dictionary):
+ Use `called-interactively-p' for Emacs instead of obsolete
+ `interactive-p'.
+
+2012-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/byte-run.el (defmacro, defun): Move from C.
+ (macro-declaration-function): Move var from C code.
+ (macro-declaration-function): Define function with defalias.
+ * emacs-lisp/macroexp.el (macroexpand-all-1):
+ * emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form):
+ * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't handle
+ defun/defmacro any more.
+ * emacs-lisp/bytecomp.el (byte-compile-arglist-signature):
+ Provide fallback for unknown arglist.
+ (byte-compile-arglist-warn): Change calling convention.
+ (byte-compile-output-file-form): Move print-vars binding.
+ (byte-compile-output-docform): Simplify accordingly.
+ (byte-compile-file-form-defun, byte-compile-file-form-defmacro)
+ (byte-compile-defmacro-declaration): Remove.
+ (byte-compile-file-form-defmumble): Generalize to defalias.
+ (byte-compile-output-as-comment): Return byte-positions.
+ Simplify callers accordingly.
+ (byte-compile-lambda): Use `assert'.
+ (byte-compile-defun, byte-compile-defmacro): Remove.
+ (byte-compile-file-form-defalias):
+ Use byte-compile-file-form-defmumble.
+ (byte-compile-defalias-warn): Remove.
+
+2012-05-29 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Silence `checkdoc-ispell' errors where
+ possible. Fix authors. Improve comments. Improve loading of `cl'.
+
+ (rst-mode-abbrev-table): Merge definition.
+ (rst-mode): Make sure `font-lock-defaults' is buffer local.
+ (rst-define-key, rst-deprecated-keys, rst-call-deprecated): Refactor.
+
+2012-05-29 Ulf Jasper <ulf.jasper@web.de>
+
+ * calendar/icalendar.el
+ (icalendar-export-region): Export UID properly.
+
+2012-05-29 Leo Liu <sdl.web@gmail.com>
+ * calendar/icalendar.el (icalendar-import-format):
+ Add `icalendar-import-format-uid' (Bug#11525).
+ (icalendar-import-format-uid): New.
+ (icalendar--parse-summary-and-rest, icalendar--format-ical-event):
+ Export UID.
+
+2012-05-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase--expand): Accept different sets of vars in
+ different alternative patterns.
+ (pcase-codegen): Be more careful to preserve identity.
+ (pcase--u1): Don't forget to mark vars as used.
+
+ * emacs-lisp/bytecomp.el (byte-compile-constp): Treat #'v as a constant.
+ (byte-compile-close-variables): Bind byte-compile--outbuffer here...
+ (byte-compile-from-buffer): ...rather than here.
+
+ * emacs-lisp/byte-opt.el (byte-compile-inline-expand): Don't re-preprocess
+ functions from byte-compile-function-environment.
+
+2012-05-29 Troels Nielsen <bn.troels@gmail.com>
+
+ * window.el (window-deletable-p): Avoid deleting the root window
+ of a frame with an active minibuffer.
+
+2012-05-29 Martin Rudalics <rudalics@gmx.at>
+
+ * simple.el (choose-completion): Use quit-window (Bug#11567).
+
+2012-05-29 Chong Yidong <cyd@gnu.org>
+
+ * whitespace.el (whitespace-cleanup): Fix usage of
+ whitespace-empty-at-bob-regexp (Bug#11492).
+
+2012-05-29 Aaron S. Hawley <aaron.s.hawley@gmail.com>
+
+ * vc/vc.el (vc-revert, vc-rollback): Dont kill vc-diff buffer on
+ revert (Bug#11488).
+
+2012-05-29 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-mode-map): Bind `M-s _' to
+ `isearch-toggle-symbol'. Bind `M-s c' to
+ `isearch-toggle-case-fold'.
+ (search-map): Bind `M-s _' to `isearch-forward-symbol'.
+ (isearch-forward): Add `M-s _' to the docstring.
+ (isearch-forward-symbol, isearch-toggle-case-fold)
+ (isearch-symbol-regexp): New functions. (Bug#11381)
+
+2012-05-29 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-word): Add docstring. (Bug#11381)
+ (isearch-occur, isearch-search-and-update): If `isearch-word' is
+ a function, call it to get the regexp.
+ (isearch-message-prefix): If `isearch-word' holds a symbol, use its
+ property `isearch-message-prefix' instead of the string "word ".
+ (isearch-search-fun-default): For the case of `isearch-word',
+ return a lambda that calls re-search-forward/re-search-backward
+ with a regexp returned by `word-search-regexp' or by the function
+ in `isearch-word'.
+
+2012-05-29 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-search-fun-default): New function.
+ (isearch-search-fun): Move default part to the new function
+ `isearch-search-fun-default'.
+ (isearch-search-fun-function): Set the default value to
+ `isearch-search-fun-default'. (Bug#11381)
+
+ * comint.el (comint-history-isearch-end):
+ Use `isearch-search-fun-default'.
+ (comint-history-isearch-search): Use `isearch-search-fun-default'
+ and remove spacial case for `isearch-word'.
+ (comint-history-isearch-wrap): Remove spacial case for
+ `isearch-word'.
+
+ * hexl.el (hexl-isearch-search-function):
+ Use `isearch-search-fun-default'.
+
+ * info.el (Info-isearch-search): Use `isearch-search-fun-default'.
+ Use `word-search-regexp' for `isearch-word'.
+
+ * misearch.el (multi-isearch-search-fun):
+ Use `isearch-search-fun-default'.
+
+ * simple.el (minibuffer-history-isearch-search):
+ Use `isearch-search-fun-default' and remove spacial case for
+ `isearch-word'.
+ (minibuffer-history-isearch-wrap): Remove spacial case for
+ `isearch-word'.
+
+ * textmodes/reftex-global.el (reftex-isearch-wrap-function):
+ Remove spacial case for `isearch-word'.
+ (reftex-isearch-isearch-search): Use `isearch-search-fun-default'.
+
+2012-05-28 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ Decrease XEmacs incompatibilities.
+ * textmodes/flyspell.el (flyspell-check-pre-word-p):
+ Use `string-match'.
+ (flyspell-delete-region-overlays): Use alternative definition for
+ XEmacs.
+ (flyspell-delete-all-overlays): Use `flyspell-delete-region-overlays'.
+ (flyspell-word): Use `process-kill-without-query' if XEmacs.
+ (flyspell-mode-on): Use `interactive-p' if XEmacs.
+ (flyspell-incorrect-face, flyspell-duplicate-face): Do not use
+ `define-obsolete-face-alias' under XEmacs, but old method.
+
+ * textmodes/ispell.el (ispell-with-no-warnings): XEmacs alternative
+ `with-no-warnings' definition or Emacs alias.
+ (ispell-command-loop, ispell-message): Use `ispell-with-no-warnings'.
+ (ispell-word): Do not use `region-p' if XEmacs.
+
+2012-05-28 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-find-aspell-dictionaries):
+ Check for `ispell-dictionary-base-alist' instead of full
+ `ispell-dictionary-alist'.
+ (ispell-init-process): Show spellchecker when starting new Ispell
+ process.
+
+2012-05-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/vhdl-mode.el: Sync with upstream 3.33.28.
+ http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html#release-notes-3.33
+
+2012-05-27 Juanma Barranquero <lekktu@gmail.com>
+
+ * version.el (motif-version-string, gtk-version-string)
+ (ns-version-string): Declare.
+
+2012-05-27 Juri Linkov <juri@jurta.org>
+
+ * emacs-lisp/lisp-mode.el (eval-defun-2): Use `eval-sexp-add-defvars'
+ after the `eval-defun-1' specialcaseing
+ like in `edebug-eval-defun' (bug#10181).
+
+ * emacs-lisp/edebug.el (edebug-eval-defun): Set `face-documentation'
+ like in `eval-defun-1'.
+
+2012-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ * mail/sendmail.el (mail-yank-region):
+ Recognize rmail-yank-current-message in addition to insert-buffer.
+ Fixes mail-mode's "C-c C-r" that otherwise does nothing when invoked in
+ a *mail* buffer created through rmail-start-mail with sendmail as
+ mail-user-agent.
+
+2012-05-27 Chong Yidong <cyd@gnu.org>
+
+ * net/gnutls.el (gnutls-min-prime-bits): Improve docstring.
+ Default to 256 (Bug#11267).
+
+ * help.el (describe-mode): Doc fix.
+
+2012-05-26 Glenn Morris <rgm@gnu.org>
+
+ * w32-fns.el (w32-init-info): Remove.
+ * paths.el (Info-default-directory-list): Add w32-init-info equivalent.
+
+ * info.el (info-initialize): For self-contained NS builds, put the
+ included info/ directory at the front. (Bug#2791)
+
+ * paths.el (Info-default-directory-list): Make it a defcustom,
+ mainly so that we can use custom-initialize-delay.
+
+2012-05-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (buffer-has-markers-at): Mark obsolete.
+
+ * subr.el (lambda): Use declare.
+
+ * emacs-lisp/lisp-mode.el (lambda):
+ * emacs-lisp/edebug.el (lambda): Move properties to its definition.
+
+2012-05-26 Aaron S. Hawley <aaron.s.hawley@gmail.com>
+
+ * thingatpt.el (forward-same-syntax): Handle no ARG case. (Bug#11560)
+
+2012-05-26 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/cc-mode.el (auto-mode-alist): Fix typo.
+
+2012-05-25 Glenn Morris <rgm@gnu.org>
+
+ * paths.el: Remove no-byte-compile.
+ * loadup.el: No need to load paths.el uncompiled.
+
+ * image.el (imagemagick-types-inhibit): Doc fix.
+
+ * version.el: Remove no-byte-compile and associated formatting.
+ * loadup.el: No need to load version.el uncompiled. AFAICS, this
+ is ancient code from when there was an "inc-vers.el".
+
+2012-05-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/gdb-mi.el: Minor style changes.
+ (gdb-enable-debug, gdb-speedbar-auto-raise, gdb-many-windows):
+ Turn into minor modes.
+ (gdb--if-arrow): Rename from gdb-if-arrow, make it hygienic.
+ (gdb-mouse-until, gdb-mouse-jump): Adjust uses accordingly.
+ (gdb-shell): Remove unneeded let-binding.
+ (gdb-get-many-fields): Eliminate O(n²) behavior.
+
+2012-05-25 Eli Zaretskii <eliz@gnu.org>
+
+ * cus-start.el <vertical-centering-font-regexp>: Avoid warning on
+ platforms that don't link in fontset.c.
+
+2012-05-25 Juri Linkov <juri@jurta.org>
+
+ Use the same diff color scheme as in modern VCSes (bug#10181).
+
+ * vc/diff-mode.el (diff-header, diff-file-header): Remove "green"
+ to avoid confusion with `diff-added' that now uses green colors.
+ (diff-removed): Use shades of red.
+ (diff-added): Use shades of green.
+ (diff-changed): Leave just the yellow color.
+ (diff-use-changed-face): New variable.
+ (diff-font-lock-keywords): Use `diff-use-changed-face' to decide
+ how to highlight context diff changes.
+ (diff-refine-change): Use shades of yellow.
+ (diff-refine-removed): New face that uses shades of red.
+ (diff-refine-added): New face that uses shades of green.
+ (diff-refine-hunk): Use `diff-refine-change', `diff-refine-added',
+ `diff-refine-removed' in the call to `smerge-refine-subst'
+ depending on the value of `diff-use-changed-face'.
+
+ * vc/smerge-mode.el (smerge-mine): Use shades of red.
+ (smerge-other): Use shades of green.
+ (smerge-base): Use shades of yellow.
+ (smerge-refined-change): Empty face.
+ (smerge-refined-removed): New face that uses shades of red.
+ (smerge-refined-added): New face that uses shades of green.
+ (smerge-refine-subst): Rename arg `props' to `props-c'. Add new
+ args `props-r' and `props-a', and use them. Doc fix.
+ (smerge-refine): Evaluate `smerge-use-changed-face' and depending
+ on its value use different faces `smerge-refined-change',
+ `smerge-refined-removed', `smerge-refined-added' in the call to
+ `smerge-refine-subst'.
+
+ * vc/ediff-init.el (ediff-current-diff-A, ediff-fine-diff-A):
+ Add face condition `min-colors 88' with shades of red.
+ (ediff-current-diff-B, ediff-fine-diff-B): Add face condition
+ `min-colors 88' with shades of green.
+ (ediff-current-diff-C, ediff-fine-diff-C): Add face condition
+ `min-colors 88' with shades of yellow.
+
+2012-05-24 Glenn Morris <rgm@gnu.org>
+
+ * paths.el (prune-directory-list, remote-shell-program): Move to...
+ * files.el (prune-directory-list, remote-shell-program): ...here.
+ For the latter, delay initialization, prefer ssh, just search PATH.
+
+ * paths.el (term-file-prefix): Move to faces.el (the only user).
+ * faces.el (term-file-prefix): Move here, make it a defcustom.
+
+ * paths.el (news-directory, news-path, news-inews-program):
+ Move to gnus/nnspool.el.
+
+ * paths.el (gnus-default-nntp-server): Remove (gnus.el defines it).
+
+ * paths.el (rmail-file-name, rmail-spool-directory): Move from here...
+ * mail/rmail.el (rmail-file-name, rmail-spool-directory): ... to here.
+ Make the latter a defcustom, with a delayed initialization.
+
+ * paths.el (gnus-nntp-service, gnus-local-organization): Remove.
+ These were deleted from Gnus itself late 2010.
+
+2012-05-22 Juanma Barranquero <lekktu@gmail.com>
+
+ * progmodes/which-func.el (which-func-ff-hook):
+ Check against user-error, not error.
+
+ * emacs-lisp/edebug.el (top): Do not load or set up loading of
+ cl-specs.el, which no longer exists.
+
+2012-05-22 Glenn Morris <rgm@gnu.org>
+
+ * info.el (info-emacs-bug): New command.
+ * menu-bar.el (menu-bar-help-menu): Add "How to Report a Bug" to Help.
+ * mail/emacsbug.el (report-emacs-bug): Replace with info-emacs-bug.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * makefile.w32-in (update-subdirs-SH):
+ * Makefile.in (update-subdirs): Update for moved update-subdirs.
+
+2012-05-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * hi-lock.el (hi-lock-face-defaults): Move obsolete before definition.
+
+ * progmodes/compile.el (compilation-error-regexp-alist-alist):
+ Simplify Maven regexp, and make sure the file can't start with a space
+ (bug#11517).
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (setwins, setwins_almost, setwins_for_subdirs):
+ Scrap superfluous subshells.
+
+2012-05-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (byte-compile-root-dir): New var.
+ (byte-compile-warning-prefix, batch-byte-compile-file): Use it.
+
+2012-05-19 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc.el (calc-ensure-consistent-units): New variable.
+
+ * calc/calc-units.el (math-consistent-units-p)
+ (math-check-unit-consistency): New functions.
+ (calc-quick-units, calc-convert-units):
+ Use `math-check-unit-consistency' when `calc-ensure-consistent-units'
+ is non-nil.
+ (calc-extract-units): Fix typo.
+
+2012-05-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-bzr.el (vc-bzr-state-heuristic): Save match-data around sha1.
+
+ * textmodes/flyspell.el: Commenting style, plus code simplifications.
+ (flyspell-default-deplacement-commands): Don't spell check after
+ repeated window/frame switches (e.g. triggered by mouse-movement).
+ (flyspell-delay-commands, flyspell-deplacement-commands): Use mapc.
+ (flyspell-debug-signal-word-checked): Simplify and fit in 80 cols.
+ (flyspell-casechars-cache, flyspell-ispell-casechars-cache)
+ (flyspell-not-casechars-cache, flyspell-ispell-not-casechars-cache):
+ Remove unused vars.
+ (flyspell-get-casechars, flyspell-get-not-casechars):
+ Simplify; Don't bother removing a ] just to add it back.
+ * textmodes/ispell.el (ispell-program-name): Use executable-find.
+
+2012-05-18 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * calc/calc-lang.el (math-C-parse-bess, math-C-parse-fma):
+ New functions.
+ (math-function-table): Add support for more C functions.
+
+2012-05-18 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/flyspell.el (flyspell-check-pre-word-p)
+ (flyspell-check-word-p, flyspell-debug-signal-word-checked):
+ Protect delay handling for otherchars against empty otherchars.
+
+2012-05-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp-mode.el (doc-string-elt): Move those properties to
+ their respective macro declarations.
+ * skeleton.el (define-skeleton):
+ * progmodes/compile.el (define-compilation-mode):
+ * ibuf-macs.el (define-ibuffer-sorter, define-ibuffer-op)
+ (define-ibuffer-filter):
+ * emacs-lisp/generic.el (define-generic-mode):
+ * emacs-lisp/easy-mmode.el (define-minor-mode)
+ (define-globalized-minor-mode):
+ * emacs-lisp/cl-macs.el (defun*, defmacro*, defstruct, deftype):
+ * emacs-lisp/byte-run.el (defsubst):
+ * custom.el (deftheme): Add doc-string metadata.
+
+2012-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el, emacs-lisp/cl.el: Move indent info.
+
+2012-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase--u1): Avoid ((lambda ...) ...).
+
+ * emacs-lisp/cl.el: Add edebug specs from cl-specs.el.
+ * emacs-lisp/cl-macs.el: Idem.
+ * emacs-lisp/cl-specs.el: Remove.
+
+2012-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Minor renaming of internal CL functions and variables.
+ * emacs-lisp/cl-seq.el (cl--adjoin): Rename from cl-adjoin.
+ (cl--position): Rename from cl-position.
+ (cl--delete-duplicates): Rename from cl-delete-duplicates.
+ * emacs-lisp/cl.el (cl--gensym-counter): Rename from *gensym-counter*.
+ (cl--random-state): Rename from *random-state*.
+
+2012-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-transform-lambda): Don't add spurious
+ parens around the arg list (bug#11499).
+
+2012-05-17 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (word-search-regexp, word-search-backward)
+ (word-search-forward, word-search-backward-lax)
+ (word-search-forward-lax): Move functions from search.c
+ (bug#10145, bug#11381).
+
+2012-05-16 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/flyspell.el (flyspell-check-pre-word-p)
+ (flyspell-check-word-p, flyspell-debug-signal-word-checked):
+ Delay for otherchars as for normal word components.
+
+2012-05-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion--sifn-requote): Fix last change.
+ (minibuffer-local-must-match-filename-map):
+ Move define-obsolete-variable-alias before its var.
+
+2012-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase-let*, pcase-let): Fix edebug spec.
+
+ * minibuffer.el (completion--sifn-requote): Handle sifn's truncation
+ behavior.
+ (completion--string-equal-p): New function.
+ (completion--twq-all): Use it to get better assertion failure data.
+
+ Only handle ".." and '..' quoting in shell-mode (bug#11466).
+ * shell.el (shell--unquote&requote-argument, shell--unquote-argument)
+ (shell--requote-argument): New functions.
+ (shell-completion-vars): Use them.
+ (shell--parse-pcomplete-arguments): Rename from
+ shell-parse-pcomplete-arguments.
+ * comint.el (comint-word): Obey comint-file-name-quote-list. Simplify.
+ (comint--unquote&requote-argument): Don't handle ".." and '..' quoting.
+ Obey comint-file-name-quote-list.
+
+ * emacs-lisp/smie.el (smie-indent--bolp-1): New function.
+ (smie-indent-keyword): Use it.
+
+2012-05-14 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el (rst-re-alist): Fix loading (bug#11462).
+
+2012-05-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * net/rlogin.el (rlogin-mode-map): Fix last change.
+
+2012-05-14 Jason L. Wright <jason.wright@inl.gov> (tiny change)
+
+ * mail/smtpmail.el (smtpmail-send-command): Send the command and
+ the following \r\n using a single `process-send-string', since the
+ Lotus SMTP server refuses to accept any commands if they are sent
+ with two `process-send-string's (Bug#11444).
+
+2012-05-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * shell.el (shell-parse-pcomplete-arguments):
+ Obey pcomplete-arg-quote-list inside double-quoted args (Bug#11348).
+
+2012-05-14 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * image-mode.el: Fit to width/height for rotated images (Bug#11431).
+ (image-transform-scale, image-transform-right-angle-fudge): New vars.
+ (image-transform-width, image-transform-fit-width): New functions.
+ (image-transform-properties): Use them.
+ (image-transform-check-size): New function.
+ (image-toggle-display-image): Use it (for testing).
+ (image-transform-set-rotation): Reduce angle mod 360.
+ Delete obsolete comment.
+
+2012-05-14 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * image-mode.el: Fix scaling (bug#11399).
+ (image-transform-resize): Doc fix.
+ (image-transform-properties): Default scale is 1 and height should
+ be an integer.
+
+2012-05-13 Johan Bockgård <bojohan@gnu.org>
+
+ * emacs-lisp/smie.el (smie-next-sexp): Use accessor `op-forw' rather
+ than hard-coding `car', to fix misbehavior when moving forward.
+
+2012-05-13 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-format)
+ (tabulated-list-entries, tabulated-list-padding)
+ (tabulated-list-sort-key): Make permanent-local.
+
+ * ebuff-menu.el: Adapt to Buffer Menu changes (Bug#11455).
+ (electric-buffer-list): Put electric buffer menu
+ command descriptions in this docstring, instead of the docstring
+ of electric-buffer-menu-mode. Code cleanups.
+ (electric-buffer-menu-mode): Use define-derived-mode. Rename from
+ Electric-buffer-menu-mode.
+ (electric-buffer-update-highlight): Minor code cleanup.
+
+2012-05-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus-call-method): Restore events not from D-Bus.
+ (Bug#11447)
+
+2012-05-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Move define-obsolete-variable-alias before the var's definition.
+ * vc/log-edit.el (vc-comment-ring, vc-comment-ring-index):
+ * tooltip.el (tooltip-hook):
+ * textmodes/reftex-toc.el (reftex-toc-map):
+ * textmodes/reftex-sel.el (reftex-select-label-map)
+ (reftex-select-bib-map):
+ * textmodes/reftex-index.el (reftex-index-map)
+ (reftex-index-phrases-map):
+ * speedbar.el (speedbar-syntax-table, speedbar-key-map):
+ * progmodes/meta-mode.el (meta-mode-map):
+ * novice.el (disabled-command-hook):
+ * loadhist.el (unload-hook-features-list):
+ * frame.el (blink-cursor):
+ * files.el (find-file-not-found-hooks, write-file-hooks)
+ (write-contents-hooks):
+ * emulation/tpu-edt.el (GOLD-map):
+ * emacs-lock.el (emacs-lock-from-exiting):
+ * emacs-lisp/generic.el (generic-font-lock-defaults):
+ * emacs-lisp/chart.el (chart-map):
+ * dos-fns.el (register-name-alist):
+ * dired-x.el (dired-omit-files-p):
+ * desktop.el (desktop-enable):
+ * cus-edit.el (custom-mode-hook):
+ * buff-menu.el (buffer-menu-mode-hook):
+ * bookmark.el (bookmark-read-annotation-text-func)
+ (bookmark-exit-hooks):
+ * allout.el (allout-mode-deactivate-hook)
+ (allout-exposure-change-hook, allout-structure-added-hook)
+ (allout-structure-deleted-hook, allout-structure-shifted-hook):
+ * dirtrack.el (dirtrack-toggle, dirtrackp, dirtrack-debug-toggle)
+ (dirtrack-debug): Move call to define-obsolete-variable-alias so it
+ comes before the corresponding variable's definition.
+
+2012-05-12 Chong Yidong <cyd@gnu.org>
+
+ * buff-menu.el (Buffer-menu-buffer+size-width): Doc fix (Bug#11454).
+ (Buffer-menu-mouse-select): Restore function (Bug#11459).
+ (Buffer-menu-mode-map): Bind it.
+ (Buffer-menu--pretty-name): Add a mouse-face property.
+
+2012-05-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/prolog.el: Use SMIE. Cleanup regexp setup.
+ (prolog-upper-case-string, prolog-lower-case-string)
+ (prolog-atom-char-regexp, prolog-atom-regexp): Initialize in defconst.
+ (prolog-use-smie, prolog-smie-grammar): New vars.
+ (prolog-smie-forward-token, prolog-smie-backward-token)
+ (prolog-smie-rules): New funs.
+ (prolog-comment-indent): Remove.
+ (prolog-mode-variables): Use default comment indentation instead.
+ Setup SMIE.
+ (prolog-build-case-strings, prolog-set-atom-regexps): Remove.
+ (prolog-mode): Don't call them any more.
+ (prolog-electric-colon, prolog-electric-dash)
+ (prolog-edit-menu-insert-move): Use indent-according-to-mode.
+
+ * dabbrev.el (dabbrev-expand): Make "no expansion found" a user-error.
+
+ * minibuffer.el (completion--twq-all): Again, allow case differences.
+
+ * term.el: Move keymap initialization code to be more idiomatic.
+ (term-signals-menu, term-mode-map, term-raw-map, term-raw-escape-map)
+ (term-terminal-menu): Move initialization into declaration.
+ (term-escape-char): Let the user set it in her .emacs.
+
+ * progmodes/sh-script.el: Use post-self-insert-hook&electric-pair-mode.
+ Provide SMIE-based indentation (not enabled by default yet).
+ (sh-mode-map): Don't bind electric keys.
+ Use electric-pair-mode instead of skeleton-pair.
+ (sh-assignment-regexp): Fit within 80 columns.
+ (sh-indent-supported): Specify actual shell name instead of boolean.
+ (sh--maybe-here-document): New fun, from sh-maybe-here-document.
+ (sh-maybe-here-document): Use it. Make obsolete.
+ (sh-electric-here-document-mode) New minor mode.
+ (sh-mode): Use it. Don't set sh-indent-supported-here here.
+ (sh-smie-sh-grammar, sh-smie--sh-operators, sh-smie--sh-operators-re)
+ (sh-smie--sh-operators-back-re, sh-indent-after-continuation)
+ (sh-smie-rc-grammar, sh-use-smie): New vars.
+ (sh-smie--keyword-p, sh-smie--newline-semi-p, sh-smie--sh-keyword-p)
+ (sh-smie-sh-forward-token, sh-smie--looking-back-at-continuation-p)
+ (sh-smie-sh-backward-token, sh-smie--continuation-start-indent)
+ (sh-smie-sh-rules, sh-smie-rc-rules, sh-smie--sh-keyword-in-p)
+ (sh-smie--rc-after-special-arg-p, sh-smie-rc-backward-token)
+ (sh-smie-sh-rules, sh-smie--rc-newline-semi-p): New functions.
+ (sh-set-shell): Use smie-setup if requested.
+
+ * term.el (term-set-escape-char): Properly set term-escape-char.
+ See http://stackoverflow.com/questions/10524656.
+
+2012-05-10 Chong Yidong <cyd@gnu.org>
+
+ * ffap.el (ffap-url-unwrap-local): Make it work right (Bug#9131).
+ Use url-generic-parse-url, and handle host names and Windows
+ filenames properly.
+ (ffap-url-unwrap-remote): Use url-generic-parse-url.
+ (ffap-url-unwrap-remote): Accept list values, specifying a list of
+ URL schemes to work on.
+ (ffap--toggle-read-only): New function.
+ (ffap-read-only, ffap-read-only-other-window)
+ (ffap-read-only-other-frame): Use it.
+ (ffap-fixup-url): Don't check ffap-ftp-regexp, since it is not
+ necessary for ffap-url-unwrap-remote.
+
+2012-05-10 Dave Abrahams <dave@boostpro.com>
+
+ * cus-start.el (create-lockfiles): Add it.
+
+2012-05-09 Chong Yidong <cyd@gnu.org>
+
+ * net/browse-url.el (browse-url-url-encode-chars): Use upper-case.
+ (browse-url-encode-url): Encode spaces and quotes (Bug#6300).
+
+2012-05-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * shell.el (shell-completion-vars): Fix last change (bug#11348).
+
+2012-05-09 Chong Yidong <cyd@gnu.org>
+
+ * ansi-color.el (ansi-color-process-output): Check for validity of
+ comint-last-output-start before using it. This avoids a bad
+ interaction with gdb-mi's input/output buffer.
+
+2012-05-09 Glenn Morris <rgm@gnu.org>
+
+ * files.el (dir-locals-read-from-file):
+ Mention dir-locals in any error message.
+
+2012-05-09 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/package.el (package-built-in-p): Handle the `emacs'
+ package (Bug#11410).
+
+ * emacs-lisp/package.el (package-buffer-info): Avoid putting local
+ variables into description.
+
+2012-05-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * shell.el (shell-completion-vars): Set pcomplete-arg-quote-list like
+ shell-delimiter-argument-list (bug#11348).
+ (shell-parse-pcomplete-arguments): Obey pcomplete-arg-quote-list.
+
+2012-05-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * textmodes/rst.el: Silence byte-compiler warnings.
+ (rst-re-alist, rst-reset-section-caches): Move around.
+ (rst-re): Use `characterp', not `char-valid-p'.
+ (font-lock-beg, font-lock-end): Declare.
+
+ * progmodes/idlw-shell.el (specs): Remove reference to deleted
+ variable `idlwave-shell-activate-alt-keybindings' and simplify.
+
+ * eshell/esh-cmd.el (eshell-debug-command): Fix typo in previous change.
+
+2012-05-08 Glenn Morris <rgm@gnu.org>
+
+ * files.el (auto-mode-alist): Treat ".make" like ".mk".
+
+2012-05-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/log-edit.el: Add GNU coding standards highlighting.
+ (log-edit-font-lock-gnu-style)
+ (log-edit-font-lock-gnu-keywords): New vars.
+ (log-edit-font-lock-keywords): New fun.
+ (log-edit-mode): Don't fold case in font-lock.
+ (log-edit-font-lock-keywords): Do not assume case-folding.
+
+ * imenu.el: Misc cleanup. Make docstrings out of comments.
+ Use lexical-binding.
+ (imenu--index-alist, imenu--last-menubar-index-alist)
+ (imenu-menubar-modified-tick): Use defvar-local.
+ (imenu--split-menu): Remove unused var.
+ (imenu--cleanup-seen): Declare as global.
+ (imenu--cleanup): Use dolist.
+
+ * subr.el (defvar-local): Add debug spec and doc-string position.
+
+2012-05-08 Glenn Morris <rgm@gnu.org>
+
+ * language/burmese.el, language/cham.el, language/czech.el:
+ * language/english.el, language/georgian.el, language/greek.el:
+ * language/japanese.el, language/khmer.el, language/korean.el:
+ * language/lao.el, language/misc-lang.el, language/romanian.el:
+ * language/sinhala.el, language/slovak.el, language/tai-viet.el:
+ * language/thai.el, language/utf-8-lang.el:
+ Remove no-byte-compile setting.
+
+ * play/zone.el (zone-pgm-stress): Don't pollute kill-ring. (Bug#11388)
+
+2012-05-08 Aaron S. Hawley <aaron.s.hawley@gmail.com>
+
+ * progmodes/make-mode.el (makefile-browse):
+ Remove unnecessary interactive. (Bug#11324)
+
+2012-05-07 Glenn Morris <rgm@gnu.org>
+
+ * forms-d2.el, forms-pass.el: Move to ../etc/forms directory.
+
+ * international/mule.el (find-auto-coding): Make "unibyte: t" obsolete.
+
+2012-05-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * loadup.el: Preload newcomment.el.
+ * newcomment.el: Move autoload-only code to toplevel.
+
+ * buff-menu.el (list-buffers--refresh): Mark `size' as right-align.
+ * emacs-lisp/tabulated-list.el (tabulated-list-init-header):
+ Handle new :right-align column property.
+ (tabulated-list-print-col): Idem, plus use `display' text-property to
+ try and preserve alignment for variable pitch fonts.
+
+2012-05-07 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/tabulated-list.el: Add no-header-line alternative.
+ (tabulated-list-use-header-line): New var.
+ (tabulated-list-init-header): Use it.
+ (tabulated-list-print-fake-header): New function.
+ (tabulated-list-print): Use it.
+ (tabulated-list-sort-button-map): Add non-header-line commands.
+ (tabulated-list-init-header): Add column name property to basic
+ labels as well.
+ (tabulated-list-col-sort): Handle non-header-line button case.
+ (tabulated-list--sort-by-column-name): Fix a corner case.
+
+ * buff-menu.el (list-buffers--refresh):
+ Handle Buffer-menu-use-header-line.
+
+2012-05-06 Chong Yidong <cyd@gnu.org>
+
+ * buff-menu.el: Convert to Tabulated List mode.
+ (Buffer-menu-buffer+size-width): Make obsolete.
+ (Buffer-menu-name-width, Buffer-menu-size-width): New variables.
+ (Buffer-menu-mode-map): Inherit from tabulated-list-mode-map.
+ (Buffer-menu-mode): Derive from tabulated-list-mode. Move command
+ documentation into docstring of buffer-menu.
+ (Buffer-menu-toggle-files-only): Add an informative message.
+ (Buffer-menu-sort): Convert to alias for tabulated-list-sort.
+ (Buffer-menu-buffer, Buffer-menu-beginning, Buffer-menu-mark)
+ (Buffer-menu-unmark, Buffer-menu-backup-unmark)
+ (Buffer-menu-delete, Buffer-menu-save, Buffer-menu-not-modified)
+ (Buffer-menu-execute, Buffer-menu-select)
+ (Buffer-menu-marked-buffers, Buffer-menu-toggle-read-only)
+ (Buffer-menu-bury): Use Tabulated List machinery.
+ (Buffer-menu-mouse-select, Buffer-menu-sort-by-column)
+ (Buffer-menu-sort-button-map, Buffer-menu-make-sort-button):
+ Delete.
+ (list-buffers--refresh): New function.
+ (list-buffers-noselect): Use it.
+ (tabulated-list-entry-size->, Buffer-menu--pretty-name)
+ (Buffer-menu--pretty-file-name): New helper functions.
+
+ * loadup.el: Preload tabulated-list.
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-sort): Rename from
+ tabulated-list-sort-column.
+ (tabulated-list-init-header): Add the initial aligning space even
+ if tabulated-list-padding is zero.
+
+2012-05-06 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * emacs-lisp/cl-macs.el (cl-expr-contains): Handle cons cells
+ whose cdr is not a cons cell correctly (bug#11038).
+
+2012-05-06 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-format):
+ Accept additional plist in column descriptors.
+ (tabulated-list-init-header): Obey it.
+ (tabulated-list-get-entry): New function.
+ (tabulated-list-put-tag): Use it. Use string-width instead of
+ length.
+ (tabulated-list--column-number): New function.
+ (tabulated-list-print): Use it.
+ (tabulated-list-print-col): New function.
+ Set `tabulated-list-column-name' property on each column's text.
+ (tabulated-list-print-entry): Use it.
+ (tabulated-list-delete-entry, tabulated-list-set-col):
+ New functions.
+ (tabulated-list-sort-column): New command (Bug#11337).
+
+ * buff-menu.el (list-buffers): Move C-x C-b binding from
+ buff-menu.el to bindings.el.
+
+ * ebuff-menu.el (Electric-buffer-menu-undefined): Use the
+ :advertised-binding feature.
+
+2012-05-06 Troels Nielsen <bn.troels@gmail.com> (tiny change)
+
+ * progmodes/compile.el (compilation-internal-error-properties):
+ Calculate start position correctly when end-col is set but
+ end-line is not (Bug#11382).
+
+2012-05-06 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * man.el (Man-unindent): Use text-property-default-nonsticky to
+ prevent untabify from inheriting face properties (Bug#11408).
+
+2012-05-05 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Major merge with upstream development up to
+ Docutils SVN r7399 / rst.el V1.2.1.
+
+ Clarify maintainership and authors.
+
+ (rst-extract-version, rst-cvs-header, rst-cvs-rev)
+ (rst-cvs-timestamp, rst-svn-rev, rst-svn-timestamp)
+ (rst-official-version, rst-official-cvs-rev, rst-version)
+ (rst-package-emacs-version-alist): New functions and variables
+ for version information.
+
+ (rst-bullets, rst-uri-schemes, rst-adornment-chars)
+ (rst-max-inline-length, rst-re-alist-def, rst-re-alist)
+ (rst-mode-syntax-table, rst-mode): New and corrected functions
+ and variables representing reStructuredText features.
+
+ (rst-re): New function for reStructuredText regexes. Use in
+ many places.
+
+ (rst-deprecated-keys, rst-call-deprecated, rst-define-key)
+ (rst-mode-map): Rebind keys.
+
+ (rst-mode-lazy, rst-font-lock-keywords)
+ (rst-font-lock-extend-region)
+ (rst-font-lock-extend-region-internal)
+ (rst-font-lock-extend-region-extend)
+ (rst-font-lock-find-unindented-line-limit)
+ (rst-font-lock-find-unindented-line-match)
+ (rst-adornment-level, rst-font-lock-adornment-level)
+ (rst-font-lock-adornment-match)
+ (rst-font-lock-handle-adornment-pre-match-form)
+ (rst-font-lock-handle-adornment-matcher): Major revision of
+ font-locking. Integrate with other code. Use `jit-lock-mode'.
+
+ (rst-preferred-adornments, rst-adjust-hook)
+ (rst-new-adornment-down, rst-preferred-bullets)
+ (rst-preferred-bullets, rst-indent, rst-indent-width)
+ (rst-indent-field, rst-indent-literal-normal)
+ (rst-indent-literal-minimized, rst-indent-comment): Change,
+ extend and improve customization.
+
+ (rst-line-homogeneous-p, rst-line-homogeneous-nodent-p)
+ (rst-normalize-cursor-position, rst-get-decoration)
+ (rst-straighten-deco-spacing, rst-re-bullets, rst-re-items)
+ (rst-rstrip, rst-toc-insert-find-delete-contents)
+ (rst-shift-fill-region, rst-compute-bullet-tabs)
+ (rst-debug-print-tabs, rst-debug-mark-found)
+ (rst-shift-region-guts, rst-shift-region-right)
+ (rst-shift-region-left, rst-use-char-classes)
+ (rst-font-lock-keywords-function)
+ (rst-font-lock-indentation-point)
+ (rst-font-lock-find-unindented-line-begin)
+ (rst-font-lock-find-unindented-line-end)
+ (rst-font-lock-find-unindented-line)
+ (rst-font-lock-adornment-point, rst-font-lock-level)
+ (rst-adornment-level-alist): Remove functions and variables.
+
+ (rst-compare-adornments, rst-get-adornment-match)
+ (rst-suggest-new-adornment, rst-get-adornments-around)
+ (rst-adornment-complete-p, rst-get-next-adornment)
+ (rst-adjust-adornment, rst-display-adornments-hierarchy)
+ (rst-straighten-adornments): Standardize function names to
+ use "adornment" instead of "decoration". Correct callers.
+ Similar standardizing in many places.
+
+ (rst-update-section, rst-adjust, rst-promote-region)
+ (rst-enumerate-region, rst-bullet-list-region)
+ (rst-repeat-last-character): Correct use of `interactive'.
+
+ (rst-classify-adornment, rst-find-all-adornments)
+ (rst-get-hierarchy, rst-adjust-adornment, rst-toc-update)
+ (rst-find-leftmost-column, rst-repeat-last-character):
+ Refactor functions.
+
+ (rst-find-title-line, rst-reset-section-caches)
+ (rst-get-adornments-around, rst-adjust-adornment-work)
+ (rst-arabic-to-roman, rst-roman-to-arabic)
+ (rst-insert-list-pos, rst-insert-list-new-item)
+ (rst-insert-list-continue, rst-insert-list, rst-forward-line):
+ New functions.
+
+ (rst-all-sections, rst-section-hierarchy)
+ (rst-arabic-to-roman, rst-initial-enums, rst-initial-items):
+ New variables.
+
+ (rst-toc-return-wincfg, rst-toc-quit-window): Use window
+ configuration instead of only buffer. Change where necessary.
+
+ (rst-line-tabs, rst-compute-tabs, rst-indent-line)
+ (rst-shift-region, rst-adaptive-fill): New functions for
+ indentation and filling.
+
+ (rst-comment-line-break, rst-comment-indent)
+ (rst-comment-insert-comment, rst-comment-region)
+ (rst-uncomment-region): New functions for handling comments.
+
+ (rst-compile): Quote shell arguments.
+
+ (rst-compile-pdf-preview, rst-compile-slides-preview):
+ Delete temporary files after use.
+
+2012-05-05 Glenn Morris <rgm@gnu.org>
+
+ * calendar/cal-html.el: Optionally include holidays in the output.
+ Suggested by Ed Reingold <reingold@emr.cs.iit.edu>.
+ (cal-html-holidays): New option.
+ (cal-html-css-default): Add holiday entry.
+ (holiday-in-range): Autoload it.
+ (cal-html-htmlify-entry): Add optional class argument.
+ (cal-html-htmlify-list): Add optional holidays argument.
+ (cal-html-insert-agenda-days): Include holidays in the output.
+ (cal-html-one-month): Maybe include holidays.
+
+ * calendar/holidays.el (holiday-in-range):
+ Move here from cal-tex-list-holidays.
+ * calendar/cal-tex.el (cal-tex-list-holidays):
+ Make it an obsolete alias for holiday-in-range. Update all callers.
+
+2012-05-05 Chong Yidong <cyd@gnu.org>
+
+ * select.el (xselect--encode-string): Always use utf-8 for TEXT on
+ Nextstep.
+
+2012-05-05 Ransom Williams <auvergnerw@gmail.com> (tiny change)
+
+ * files.el (file-auto-mode-skip): New var.
+ (set-auto-mode-1): Use it.
+
+2012-05-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * repeat.el: Use lexical-binding.
+ (repeat-last-self-insert, repeat-num-input-keys-at-self-insert)
+ (repeat-undo-count): Remove.
+ (repeat):
+ * progmodes/octave-mod.el (octave-abbrev-start):
+ * progmodes/f90.el (f90-abbrev-start):
+ * face-remap.el (text-scale-adjust):
+ * kmacro.el (kmacro-call-macro): Use set-temporary-overlay-map.
+
+ * emacs-lisp/pcase.el (pcase--let*): New function.
+ (pcase--expand, pcase-codegen, pcase--q1): Use it to reduce nesting
+ a bit more.
+ (pcase--split-pred): Be more clever about ruling out overlap between
+ a predicate and some constant pattern.
+ (pcase--q1): Use `null' instead of (eq foo nil).
+
+ * subr.el (setq-local, defvar-local): New macros.
+ (kbd): Redefine as an alias.
+ (with-selected-window): Leave unrelated frames alone.
+ (set-temporary-overlay-map): New function.
+
+2012-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (user-error): New function.
+ * window.el (switch-to-buffer):
+ * vc/smerge-mode.el (smerge-resolve-function, smerge-resolve)
+ (smerge-match-conflict):
+ * simple.el (previous-matching-history-element)
+ (next-matching-history-element, goto-history-element, undo-more)
+ (undo-start):
+ * progmodes/etags.el (visit-tags-table-buffer, find-tag-tag)
+ (find-tag-noselect, find-tag-in-order, etags-goto-tag-location)
+ (next-file, tags-loop-scan, list-tags, complete-tag):
+ * progmodes/compile.el (compilation-loop):
+ * mouse.el (mouse-minibuffer-check):
+ * man.el (Man-bgproc-sentinel, Man-goto-page):
+ * info.el (Info-find-node-2, Info-extract-pointer, Info-history-back)
+ (Info-history-forward, Info-follow-reference, Info-menu)
+ (Info-extract-menu-item, Info-extract-menu-counting)
+ (Info-forward-node, Info-backward-node, Info-next-menu-item)
+ (Info-last-menu-item, Info-next-preorder, Info-last-preorder)
+ (Info-next-reference, Info-prev-reference, Info-index)
+ (Info-index-next, Info-follow-nearest-node)
+ (Info-copy-current-node-name):
+ * imenu.el (imenu--make-index-alist)
+ (imenu-default-create-index-function, imenu-add-to-menubar):
+ * files.el (basic-save-buffer, recover-file):
+ * emacs-lisp/easy-mmode.el (easy-mmode-define-navigation):
+ * emacs-lisp/checkdoc.el (checkdoc-continue, checkdoc-comments)
+ (checkdoc-message-text, checkdoc-defun):
+ * dabbrev.el (dabbrev-completion, dabbrev--abbrev-at-point):
+ * cus-edit.el (customize-changed-options, customize-rogue)
+ (customize-saved, custom-variable-set, custom-variable-mark-to-save)
+ (custom-variable-mark-to-reset-standard)
+ (custom-variable-reset-backup, custom-face-mark-to-reset-standard)
+ (custom-file):
+ * completion.el (check-completion-length):
+ * comint.el (comint-search-arg)
+ (comint-previous-matching-input-string-position)
+ (comint-previous-matching-input)
+ (comint-replace-by-expanded-history-before-point, comint-send-input)
+ (comint-copy-old-input, comint-backward-matching-input)
+ (comint-goto-process-mark, comint-set-process-mark):
+ * calendar/calendar.el (calendar-cursor-to-date): Use it.
+ * bindings.el (debug-ignored-errors): Remove regexps, add `user-error'.
+
+2012-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * dabbrev.el (dabbrev--ignore-case-p): New function.
+ (dabbrev-completion, dabbrev-expand, dabbrev--substitute-expansion):
+ Use it.
+
+ * files.el (automount-dir-prefix): Mark as obsolete.
+
+2012-05-04 Glenn Morris <rgm@gnu.org>
+
+ * patcomp.el, play/bruce.el: Move to obsolete/.
+
+2012-05-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor Y10k bugs.
+ * arc-mode.el (archive-unixdate):
+ * autoinsert.el (auto-insert-alist):
+ * calc/calc-forms.el (math-this-year):
+ * emacs-lisp/copyright.el (copyright-current-year)
+ (copyright-update-year, copyright):
+ * tar-mode.el (tar-clip-time-string):
+ * time.el (display-time-update):
+ Don't assume years have 4 digits.
+
+2012-05-04 Chong Yidong <cyd@gnu.org>
+
+ * dos-w32.el (file-name-buffer-file-type-alist)
+ (direct-print-region-use-command-dot-com):
+ * ffap.el (ffap-menu-regexp):
+ * find-file.el (ff-special-constructs):
+ * follow.el (follow-debug):
+ * forms.el (forms--debug):
+ * iswitchb.el (iswitchb-all-frames):
+ * ido.el (ido-all-frames):
+ * emacs-lisp/timer.el (timer-max-repeats):
+ * mail/feedmail.el (feedmail-mail-send-hook)
+ (feedmail-mail-send-hook-queued):
+ * mail/footnote.el (footnote-signature-separator):
+ * mail/mailabbrev.el (mail-alias-separator-string)
+ (mail-abbrev-mode-regexp):
+ * mail/rmail.el (rmail-speedbar-match-folder-regexp):
+ * progmodes/idlwave.el (idlwave-libinfo-file)
+ (idlwave-default-completion-case-is-down)
+ (idlwave-library-routines): Convert defvars to defcustoms.
+
+ * mail/rmail.el (rmail-decode-mime-charset):
+ * progmodes/idlw-shell.el (idlwave-shell-print-expression-function)
+ (idlwave-shell-fix-inserted-breaks)
+ (idlwave-shell-activate-alt-keybindings)
+ (idlwave-shell-use-breakpoint-glyph):
+ * facemenu.el (facemenu-unlisted-faces): Delete obsolete vars.
+
+2012-05-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion--twq-all): Beware completion-ignore-case.
+
+2012-05-03 Wilson Snyder <wsnyder@wsnyder.org>
+
+ * progmodes/verilog-mode.el (font-lock-keywords):
+ Fix mis-highligting auto. Reported by Craig Barner.
+ (verilog-auto, verilog-auto-undef): Add AUTOUNDEF to remove
+ defines from global name space. Reported by Dan Dever.
+ (verilog-auto-reset, verilog-auto-reset-widths)
+ (verilog-auto-tieoff): Support using unbased numbers for
+ AUTORESET and AUTOTIEOFF.
+ (verilog-submit-bug-report): Update variable list.
+ (verilog-read-auto-params): Fix AUTOINPUT regexps containing
+ parenthesis from not matching. Reported by Michael Rytting.
+ (verilog-auto-template-lint): Fix hash error when linting modules
+ with no used templates.
+ (verilog-warn, verilog-warn-error)
+ (verilog-warn-fatal): When non-interactive report multiple
+ warnings before exiting. Suggested by Brad Dobbie.
+ (verilog-auto-template-lint, verilog-auto-template-warn-unused)
+ (verilog-read-auto-template): Add `verilog-auto-template-warn-unused'
+ to report unused template errors. Reported by Brad Dobbie.
+ (verilog-read-decls): Fix AUTOWIRE etc on supply0, supply1 type
+ nets, bug438. Reported by Vns Blore.
+ (verilog-auto-inout-module, verilog-auto-reg)
+ (verilog-read-decls, verilog-read-sub-decls-sig)
+ (verilog-signals-edit-wire-reg, verilog-signals-with):
+ Fix passing of Verilog data types in ANSI input/output ports
+ such as "output logic" into the AUTOs. Special case "wire" and
+ "reg" for backwards compatibility presuming Verilog 2001.
+ (verilog-auto-ascii-enum): Add "auto enum" as alias.
+ (verilog-preprocess): Fix replication of preprocess output.
+ Reported by Brad Dobbie.
+ (verilog-auto-inst-interfaced-ports):
+ Create verilog-auto-inst-interfaced-ports, bug429.
+ Reported by Julian Gorfajn.
+ (verilog-after-save-font-hook)
+ (verilog-before-save-font-hook): New variable.
+ (verilog-modi-cache-results, verilog-save-font-mod-hooked)
+ (verilog-save-font-mods): Wrap disabling fontification, reported
+ by David Rogoff.
+ (verilog-do-indent, verilog-pretty-declarations-auto)
+ (verilog-sk-def-reg): Fix obeying `verilog-auto-lineup', bug305.
+ Reported by Pierre-David Pfister.
+ (verilog-set-auto-endcomments): Fix endtask auto comments outside
+ of class declarations, bug292. Reported by Kevin Heilman.
+ (verilog-read-decls): Fix 'parameter type' not appearing in
+ AUTOINSTPARAM, bug340. Reported by Jonathan Greenlaw.
+ (verilog-auto-logic): Fix when AUTOLOGIC present to properly do
+ AUTOINPUTs, bug411. Reported by Jonathan Greenlaw.
+ (verilog-read-auto-lisp): Avoid syntax-ppss warning on AUTOLISP.
+ Reported by David Kravitz.
+
+2012-05-03 Michael McNamara <mac@mail.brushroad.com>
+
+ * progmodes/verilog-mode.el (verilog-pretty-expr): Don't line up
+ assignment with tests in ifs and for loops.
+ (verilog-extended-complete-re, verilog-complete-reg): Change so
+ that DPI inport functions don't look like fuction declarations.
+ (verilog-pretty-expr): Don't line up assignment
+ operations to the test and increment in if and for loops
+ (verilog-extended-complete-re, verilog-complete-reg): Change so
+ that DPI inport functions don't look like fuction declarations.
+
+2012-05-03 Kenichi Handa <handa@m17n.org>
+
+ * mail/rmailmm.el (rmail-show-mime): Catch an error caused by text
+ decoding, and show a warning message without signaling an error
+ (Bug#11282).
+
+2012-05-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el
+ (byte-compile-file-form-custom-declare-variable): Compile all elements,
+ since cconv.el might have introduced :fun-body, internal-make-closure,
+ and friends for bytecomp to handle (bug#11391).
+ * custom.el (defcustom): Avoid ((λ ..) ..).
+
+2012-05-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (read-passwd): Better clean after ourselves (bug#11392).
+
+2012-05-02 Juanma Barranquero <lekktu@gmail.com>
+
+ * notifications.el (dbus-debug):
+ * term/linux.el (gpm-mouse-enable):
+ * term/screen.el (xterm-register-default-colors): Declare.
+
+2012-05-02 Chong Yidong <cyd@gnu.org>
+
+ * cus-start.el (gc-cons-percentage, exec-suffixes)
+ (dos-display-scancodes, dos-hyper-key, dos-super-key)
+ (dos-keypad-mode, debug-on-signal, vertical-centering-font-regexp)
+ (make-cursor-line-fully-visible, void-text-area-pointer)
+ (font-list-limit): Add customization data.
+
+ * allout.el (allout-exposure-change-functions)
+ (allout-structure-added-functions)
+ (allout-structure-deleted-functions)
+ (allout-structure-shifted-functions): Rename abnormal hooks from
+ *-hook, and convert to defcustoms.
+ (allout-after-copy-or-kill-hook, allout-post-undo-hook):
+ Convert to defcustoms.
+ (allout-mode-hook, allout-mode-deactivate-hook): Doc fix.
+
+ * allout-widgets.el: Hook callers changed.
+
+2012-05-02 Eli Zaretskii <eliz@gnu.org>
+
+ * mail/rmail.el (rmail-yank-current-message): Use the encoding of
+ the yanked message in preference to the default value of
+ buffer-file-coding-system.
+
+2012-05-02 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer--action-function-custom-type):
+ Fix entry.
+
+2012-05-02 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-defs.el (c-version): Update to 5.32.3.
+
+2012-05-01 Glenn Morris <rgm@gnu.org>
+
+ * cus-start.el (suggest-key-bindings): Remove, now it is in Lisp.
+
+ * eshell/esh-cmd.el (eshell-debug-command): Doc fix. Add :set.
+
+ * cus-edit.el (custom-variable-documentation): Simplify with format.
+
+2012-05-01 Aaron S. Hawley <aaron.s.hawley@gmail.com>
+ Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (suggest-key-bindings, execute-extended-command):
+ Move from keyboard.c.
+
+2012-05-01 Chong Yidong <cyd@gnu.org>
+
+ * follow.el: Eliminate advice.
+ (set-process-filter, process-filter, sit-for): Advice deleted.
+ (follow-mode-off-hook): Obsolete hook removed.
+ (follow-avoid-tail-recenter-p, follow-process-filter-alist):
+ Vars deleted.
+ (follow-auto): Use a :set function.
+ (follow-mode): Rewritten. Don't advise process filters.
+ (follow-switch-to-current-buffer-all, follow-scroll-up)
+ (follow-scroll-down): Assume follow-mode is bound.
+ (follow-comint-scroll-to-bottom)
+ (follow-align-compilation-windows): New functions.
+ (follow--window-sorter): New function.
+ (follow-all-followers): Use it to explicitly sort windows by their
+ positions; don't make assumptions about next-window order.
+ (follow-windows-start-end, follow-delete-other-windows-and-split)
+ (follow-calc-win-start): Doc fix.
+ (follow-windows-aligned-p, follow-select-if-visible): Don't call
+ vertical-motion unnecessarily.
+ (follow-adjust-window): New function.
+ (follow-post-command-hook): Use it.
+ (follow-call-set-process-filter, follow-call-process-filter)
+ (follow-intercept-process-output, follow-tidy-process-filter-alist)
+ (follow-stop-intercept-process-output, follow-generic-filter):
+ Functions deleted.
+ (follow-scroll-bar-toolkit-scroll, follow-scroll-bar-drag)
+ (follow-scroll-bar-scroll-up, follow-scroll-bar-scroll-down):
+ New functions, replacing advice on scroll-bar-* commands.
+ (follow-mwheel-scroll): New function (Bug#4112).
+
+ * comint.el (comint-adjust-point): New function.
+ (comint-postoutput-scroll-to-bottom): Use it.
+ Call follow-comint-scroll-to-bottom for Follow mode buffers.
+
+2012-05-01 Glenn Morris <rgm@gnu.org>
+
+ * term/AT386.el, term/apollo.el, term/bobcat.el, term/cygwin.el:
+ * term/iris-ansi.el, term/linux.el, term/lk201.el, term/news.el:
+ * term/screen.el, term/vt102.el, term/vt125.el, term/vt200.el:
+ * term/vt201.el, term/vt220.el, term/vt240.el, term/vt300.el:
+ * term/vt320.el, term/vt400.el, term/vt420.el, term/wyse50.el:
+ Remove no-byte-compile setting.
+
+2012-05-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-table-with-quoting): Fix compatibility
+ all-completions code to not return a number in the last cdr.
+
+2012-04-30 Leo Liu <sdl.web@gmail.com>
+
+ * ibuf-ext.el (ibuffer-diff-buffer-with-file-1): Avoid buffer
+ read-only error.
+
+2012-04-29 Chong Yidong <cyd@gnu.org>
+
+ * follow.el (follow-calc-win-end): Rewrite to handle partial
+ screen lines correctly (Bug#8390).
+ (follow-avoid-tail-recenter): Minor cleanup.
+
+2012-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Avoid the obsolete `assoc' package.
+ * speedbar.el (speedbar-refresh): Avoid adelete.
+ (speedbar-file-lists): Simplify and avoid aput.
+ * man.el (Man--sections, Man--refpages): New vars, replacing
+ Man-sections-alist and Man-refpages-alist.
+ (Man-build-section-alist, Man-build-references-alist):
+ Use them; avoid aput.
+ (Man--last-section, Man--last-refpage): New vars.
+ (Man-follow-manual-reference): Use them.
+ Use the `default' arg of completing-read.
+ (Man-goto-section): Idem. Move prompt to the `interactive' spec.
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * vc/diff.el (diff-sentinel): Go to bob (Bug#10259).
+
+ * startup.el (x-apply-session-resources): New function.
+
+ * term/ns-win.el (ns-initialize-window-system):
+ * term/w32-win.el (w32-initialize-window-system):
+ * term/x-win.el (x-initialize-window-system): Use it to properly
+ set menu-bar-mode and other vars from X resources, even if the
+ initial frame is not a window-system frame (Bug#2299).
+
+ * subr.el (read-key): Avoid running filter function when setting
+ up temporary tool bar entries (Bug#9922).
+
+2012-04-27 Andreas Schwab <schwab@linux-m68k.org>
+
+ * vc/vc-git.el (vc-git-state): Fix regexp matching diff output.
+ (Bug#11344)
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * select.el (xselect--encode-string): New function, split from
+ xselect-convert-to-string.
+ (xselect-convert-to-string): Use it.
+ (xselect-convert-to-filename, xselect-convert-to-os)
+ (xselect-convert-to-host, xselect-convert-to-user): Ensure that
+ returned strings are properly encoded (Bug#11315).
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (delete-active-region): Move to killing custom group.
+
+2012-04-27 Andreas Schwab <schwab@linux-m68k.org>
+
+ * progmodes/which-func.el (which-func-current): Quote %
+ characters for mode-line processing.
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * xml.el (xml-parse-region, xml-parse-tag): Avoid errors due to
+ reaching eob (Bug#11286).
+
+2012-04-27 Eli Zaretskii <eliz@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-control-level): New variable.
+ (gdb): Make it buffer-local and init to zero.
+ (gdb-control-commands-regexp): New variable.
+ (gdb-send): Don't wrap in "-interpreter-exec console" if
+ gdb-control-level is positive. Increment gdb-control-level
+ whenever the command matches gdb-control-commands-regexp, and
+ decrement it each time the command is "end". (Bug#11279)
+
+2012-04-27 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (adjust-window-trailing-edge, enlarge-window)
+ (shrink-window, window-resize):
+ * mouse.el (mouse-drag-line): Fix resizing of minibuffer
+ windows (Bug#11276).
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/pascal.el (pascal--extra-indent): Rename from ind, to
+ fix "missing prefix" warning. All callers changed.
+
+2012-04-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/assoc.el: Move to obsolete/.
+
+2012-04-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/assoc.el (aget): Fix dynamic-scoping issue (bug#11352).
+
+ * term/ns-win.el (ns-define-service):
+ * progmodes/pascal.el (pascal-goto-defun):
+ * progmodes/js.el (js--read-tab):
+ * progmodes/etags.el (tags-lazy-completion-table):
+ * emacs-lisp/syntax.el (syntax-propertize-via-font-lock):
+ * emacs-lisp/ewoc.el (ewoc--wrap):
+ * emacs-lisp/assoc.el (aput, adelete, amake):
+ * doc-view.el (doc-view-convert-current-doc):
+ * vc/diff.el (diff-no-select): Replace lexical-let by lexical-binding.
+
+2012-04-26 Chong Yidong <cyd@gnu.org>
+
+ * image.el (image-type-from-buffer): Only return supported image
+ type (Bug#9045).
+
+ * vc/diff-mode.el (diff-beginning-of-hunk): Return a meaningful
+ value, for symmetry with diff-end-of-hunk.
+ (diff-split-hunk, diff-find-source-location)
+ (diff-ignore-whitespace-hunk, diff-refine-hunk): Use it.
+ (diff-bounds-of-hunk, diff-bounds-of-file): New functions.
+ (diff-restrict-view, diff-hunk-kill, diff-file-kill): Use them to
+ compute the relevant hunk or file properly (Bug#6005).
+ (diff-file-junk-re): Add bzr's "modified file" tag (Bug#6041).
+
+2012-04-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-mtn.el:
+ * vc/vc-hg.el:
+ * vc/vc-git.el:
+ * vc/vc-dir.el:
+ * vc/vc-cvs.el:
+ * vc/vc-bzr.el:
+ * vc/vc-arch.el:
+ * vc/vc.el: Replace lexical-let by lexical-binding.
+ * minibuffer.el (lazy-completion-table): Avoid ((λ ...) ...).
+ * emacs-lisp/cl-macs.el (lexical-let): Fix use in lexical-binding.
+ * emacs-lisp/cconv.el (cconv-analyse-form): Warn use of ((λ ...) ...).
+
+2012-04-26 Chong Yidong <cyd@gnu.org>
+
+ * vc/diff-mode.el (diff-undo): New command (Bug#5302).
+ (diff-mode-shared-map): Bind it to / and [remap undo].
+
+ * vc/ediff-wind.el (ediff-setup-windows-default): New function.
+ (ediff-window-setup-function): Use it as the default, to set up
+ windows based on whether the current frame is graphical (Bug#2138).
+ (ediff-choose-window-setup-function-automatically): Make obsolete.
+
+ * vc/ediff-init.el: Always define ediff-pixel-width/height.
+
+2012-04-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ffap.el: Remove old code for obsolete package.
+ (ffap-complete-as-file-p): Remove.
+
+ Use completion-table-with-quoting for comint and pcomplete.
+ * comint.el (comint--unquote&requote-argument)
+ (comint--unquote-argument, comint--requote-argument): New functions.
+ (comint--unquote&expand-filename, comint-unquote-filename): Obsolete.
+ (comint-quote-filename): Use regexp-opt-charset.
+ (comint--common-suffix, comint--common-quoted-suffix)
+ (comint--table-subvert): Remove.
+ (comint-unquote-function, comint-requote-function): New vars.
+ (comint--complete-file-name-data): Use them with
+ completion-table-with-quoting.
+ * pcmpl-unix.el (pcomplete/scp): Use completion-table-subvert.
+ * pcomplete.el (pcomplete-arg-quote-list)
+ (pcomplete-quote-arg-hook, pcomplete-quote-argument): Obsolete.
+ (pcomplete-unquote-argument-function): Default to non-nil.
+ (pcomplete-unquote-argument): Simplify.
+ (pcomplete--common-quoted-suffix): Remove.
+ (pcomplete-requote-argument-function): New var.
+ (pcomplete--common-suffix): New function.
+ (pcomplete-completions-at-point): Use completion-table-with-quoting
+ and completion-table-subvert.
+
+ * minibuffer.el: Use completion-table-with-quoting for read-file-name.
+ (minibuffer--double-dollars): Preserve properties.
+ (completion--sifn-requote): New function.
+ (completion--file-name-table): Rewrite using it and c-t-with-quoting.
+
+ * minibuffer.el: Add support for completion of quoted/escaped data.
+ (completion-table-with-quoting, completion-table-subvert): New funs.
+ (completion--twq-try, completion--twq-all): New functions.
+ (completion--nth-completion): New function.
+ (completion-try-completion, completion-all-completions): Use it.
+
+2012-04-25 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/python.el (python-pdbtrack-get-source-buffer):
+ Use compilation-message if available to find real filename.
+
+2012-04-25 Chong Yidong <cyd@gnu.org>
+
+ * vc/diff-mode.el (diff-setup-whitespace): New function.
+ (diff-mode): Use it.
+
+ * vc/diff.el (diff-sentinel):
+ * vc/vc.el (vc-diff-finish): Call diff-setup-whitespace to assign
+ Whitespace mode variables based on diff style (Bug#8612).
+
+2012-04-25 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/python.el (python-send-region): Add suffix .py to the
+ temp file.
+
+ * files.el (auto-mode-alist): Use javascript-mode instead.
+
+2012-04-25 Alex Harsanyi <AlexHarsanyi@gmail.com>
+
+ Sync with soap-client repository. Support SOAP simpleType (Bug#10331).
+
+ * net/soap-client.el (soap-resolve-references-for-sequence-type)
+ (soap-resolve-references-for-array-type): Hack to prevent self
+ references, see Bug#9.
+ (soap-parse-envelope): Report the contents of the 'detail' node
+ when receiving a fault reply.
+ (soap-parse-envelope): Report the contents of the entire 'detail' node.
+
+ * net/soap-inspect.el (soap-sample-value-for-simple-type)
+ (soap-inspect-simple-type): New function.
+
+ * net/soap-client.el (soap-simple-type): New struct.
+ (soap-default-xsd-types, soap-default-soapenc-types)
+ (soap-decode-basic-type, soap-encode-basic-type):
+ support unsignedInt and double basic types.
+ (soap-resolve-references-for-simple-type)
+ (soap-parse-simple-type, soap-encode-simple-type): New function.
+ (soap-parse-schema): Parse xsd:simpleType declarations.
+
+ * net/soap-client.el (soap-default-xsd-types)
+ (soap-default-soapenc-types): Add integer, byte and anyURI types.
+ (soap-parse-complex-type-complex-content): Use `soap-wk2l' to find
+ the local name of "soapenc:Array".
+ (soap-decode-basic-type, soap-encode-basic-type): Support encoding
+ decoding integer, byte and anyURI xsd types.
+
+2012-04-25 Chong Yidong <cyd@gnu.org>
+
+ * cus-edit.el (custom-buffer-create-internal): Update header text.
+
+2012-04-25 Eli Zaretskii <eliz@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-init-1): Condition Windows-specific
+ settings on 'system-type', not on 'window-system'. On MS-Windows,
+ set interactive-mode on in GDB.
+
+2012-04-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/ruby-mode.el: Simplify last change, and cleanup code.
+ (ruby-syntax-propertize-regexp): Remove.
+ (ruby-syntax-propertize-function): Split regexp into chunks.
+ Match following code directly.
+
+2012-04-24 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el: Handle Cucumber defs (bug#6286).
+ (ruby-syntax-propertize-regexp): New function.
+ (ruby-syntax-propertize-function): Use it to handle regexp not preceded
+ by a special keyword.
+
+ * progmodes/ruby-mode.el: Handle general delimited literals (bug#6286).
+ (ruby-syntax-general-delimiters-goto-beg)
+ (ruby-syntax-propertize-general-delimiters): New functions.
+ (ruby-syntax-propertize-function): Use them to handle GDL.
+ (ruby-font-lock-keywords): Move old handling of GDL...
+ (ruby-font-lock-syntactic-keywords): .. to here.
+ (ruby-calculate-indent): Adjust indentation for GDL.
+
+2012-04-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * notifications.el (top): Remove unneeded declarations.
+ (notifications-specification-version): Change to "1.2".
+ (notifications-interface, notifications-notify-method)
+ (notifications-close-notification-method): Fix docstring.
+ (notifications-get-capabilities-method): New defconst.
+ (notifications-notify): Add :action-items, :resident and
+ :transient hints. Change "image_data" to "image-data" and
+ "image_path" to "image-path".
+ (notifications-get-capabilities): New defun.
+
+2012-04-24 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/python.el: Move hideshow setup to the end.
+
+2012-04-24 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (handle-select-window): Clear echo area since this is
+ no more done by read_char (Bug#11304).
+
+2012-04-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ibuffer.el (ibuffer-mode-map): Bind `/ m' to filter-used-mode
+ and `/ M' to filter-derived-mode.
+ * ibuf-ext.el (ibuffer-list-buffer-modes): Simplify; avoid add-to-list.
+ (ibuffer-filter-by-mode, ibuffer-filter-by-used-mode)
+ (ibuffer-mark-by-mode): Use default rather than initial-input.
+ (ibuffer-filter-by-derived-mode): Autoload and require-match.
+
+2012-04-24 Ivan Andrus <darthandrus@gmail.com> (tiny change)
+
+ * ibuf-ext.el (ibuffer-list-buffer-modes): Add `include-parents' arg.
+ (ibuffer-filter-by-derived-mode): New filter.
+ * ibuffer.el (ibuffer-mode-map): Bind to `/ w'.
+
+2012-04-23 Andreas Politz <politza@fh-trier.de>
+
+ * subr.el (accept-change-group): Fix arg usage (Bug#6095).
+
+2012-04-23 Chong Yidong <cyd@gnu.org>
+
+ * cus-edit.el (customize-apropos, customize-apropos-options):
+ Disable matching of non-option variables (Bug#11176).
+ (customize-option, customize-option-other-window)
+ (customize-changed-options): Doc fix.
+ (customize-apropos-options, customize-apropos-faces)
+ (customize-apropos-groups): Use apropos-read-pattern (Bug#11124).
+
+ * apropos.el (apropos-read-pattern): Make prompt less cryptic.
+ Fix word list splitting (Bug#11132).
+ (apropos-symbol, apropos-keybinding, apropos-label)
+ (apropos-property, apropos-function-button)
+ (apropos-variable-button, apropos-misc-button): New faces.
+ (apropos-symbol-face, apropos-keybinding-face)
+ (apropos-label-face, apropos-property-face, apropos-match-face):
+ Variables removed (Bug#8396).
+ (apropos-library-button, apropos-format-plist, apropos-print)
+ (apropos-print-doc, apropos-describe-plist): Callers changed.
+
+2012-04-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/xesam.el (xesam-mode-map): Use let-bound map in
+ initialization. (Bug#11292)
+
+2012-04-23 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ Preserve ispell session localwords when switching back to
+ original buffer.
+
+ * textmodes/ispell.el (ispell-buffer-session-localwords):
+ New buffer-local variable to hold buffer session localwords.
+ (ispell-kill-ispell): Add option 'clear to delete session
+ localwords.
+ (ispell-command-loop, ispell-change-dictionary)
+ (ispell-buffer-local-words): Preserve session localwords when
+ needed.
+
+ * textmodes/flyspell.el (flyspell-process-localwords)
+ (flyspell-do-correct): Preserve session localwords when needed.
+
+2012-04-23 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-insert-word) Remove unneeded function
+ using obsolete `translation-table-for-input'.
+ (ispell-word, ispell-process-line, ispell-complete-word):
+ Use plain `insert' instead of removed `ispell-insert-word'.
+
+2012-04-22 Chong Yidong <cyd@gnu.org>
+
+ * cus-edit.el (custom-variable-menu)
+ (custom-variable-reset-saved, custom-face-menu)
+ (custom-face-reset-saved): If there is no saved value, make the
+ "reset-saved" operation bring back the default (Bug#9509).
+ (custom-face-state): Properly detect themed faces.
+
+ * faces.el (face-spec-set): Stop supporting deprecated form of
+ third arg.
+
+2012-04-22 Michael Albinus <michael.albinus@gmx.de>
+
+ Move functions from C to Lisp. Make non-blocking method calls
+ the default. Implement further D-Bus standard interfaces.
+
+ * net/dbus.el (dbus-message-internal): Declare function.
+ Remove unneeded function declarations.
+ (defvar dbus-message-type-invalid, dbus-message-type-method-call)
+ (dbus-message-type-method-return, dbus-message-type-error)
+ (dbus-message-type-signal): Declare variables. Remove local
+ definitions.
+ (dbus-interface-dbus, dbus-interface-peer)
+ (dbus-interface-introspectable, dbus-interface-properties)
+ (dbus-path-emacs, dbus-interface-emacs, dbus-return-values-table):
+ Adapt docstring.
+ (dbus-interface-objectmanager): New defconst.
+ (dbus-call-method, dbus-call-method-asynchronously)
+ (dbus-send-signal, dbus-method-return-internal)
+ (dbus-method-error-internal, dbus-register-service)
+ (dbus-register-signal, dbus-register-method): New defuns, moved
+ from dbusbind.c
+ (dbus-call-method-handler, dbus-setenv)
+ (dbus-get-all-managed-objects, dbus-managed-objects-handler):
+ New defuns.
+ (dbus-call-method-non-blocking): Make it an obsolete function.
+ (dbus-unregister-object, dbus-unregister-service)
+ (dbus-handle-event, dbus-register-property)
+ (dbus-property-handler): Obey the new structure of
+ `bus-registered-objects'.
+ (dbus-introspect): Use `dbus-call-method'. Use a timeout.
+ (dbus-get-property, dbus-set-property, dbus-get-all-properties):
+ Use `dbus-call-method'.
+
+2012-04-22 Chong Yidong <cyd@gnu.org>
+
+ * cus-edit.el (custom-commands, custom-reset-menu)
+ (Custom-reset-standard): Tweak labels.
+ (custom-reset-button-menu): Change default to t.
+ (custom-buffer-create-internal): For the custom-reset-button-menu
+ case, put the revert button first.
+ (custom-group-subtitle): New face.
+ (custom-group-value-create): Align docstring to a specific column.
+
+ * wid-edit.el (widget-documentation-link-add): Don't handle
+ indentation in this function.
+ (widget-documentation-string-indent-to): New function.
+ (widget-documentation-string-value-create): Use it.
+
+ * autorevert.el (auto-revert):
+ * epg-config.el (epg):
+ * ibuffer.el (ibuffer):
+ * mpc.el (mpc):
+ * ses.el (ses):
+ * eshell/eshell.el (eshell):
+ * net/ange-ftp.el (ange-ftp):
+ * progmodes/ebnf2ps.el (postscript):
+ * progmodes/flymake.el (flymake):
+ * progmodes/prolog.el (prolog):
+ * progmodes/verilog-mode.el (verilog-mode):
+ * progmodes/which-func.el (which-func):
+ * term/xterm.el (xterm):
+ * textmodes/picture.el (picture):
+ * textmodes/tildify.el (tildify):
+ * vc/ediff.el (ediff): Tweak defgroups to improve presentation in
+ customization buffers.
+
+2012-04-22 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-engine.el (c-append-lower-brace-pair-to-state-cache):
+ Adding a ) can hide the resulting (..) from searches. Fix it.
+ Bound the backward search to the position of the existing (.
+
+2012-04-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * progmodes/verilog-mode.el (verilog-mode): Check whether
+ which-func-modes is t before adding verilog-mode.
+ Reported by Andy Moreton <andrewjmoreton@gmail.com>.
+
+2012-04-21 Leo Liu <sdl.web@gmail.com>
+
+ * net/rcirc.el (rcirc): Avoid error when process-contact returns t.
+
+2012-04-21 Michael Vehrs <Michael.Burschik@gmx.de>
+
+ * woman.el: Add support for "T{ T}" tbl syntax, and fix the
+ filling of the last column of a table (Bug#5635).
+ (woman-find-next-control-line): New arg, specifying an additional
+ regexp component for the control line.
+ (woman2-roff-buffer): Use it.
+ (woman-break-table): New function.
+ (woman2-TS): Use it.
+
+2012-04-21 Chong Yidong <cyd@gnu.org>
+
+ * woman.el (woman-set-buffer-display-table, woman-decode-region)
+ (woman-horizontal-escapes, woman-negative-vertical-space)
+ (woman-tab-to-tab-stop, woman2-fc, woman2-TS)
+ (WoMan-warn-ignored): Use ?\s instead of ?\ .
+
+2012-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-file-name-table): Complete user names.
+
+2012-04-20 Leo Liu <sdl.web@gmail.com>
+
+ * font-lock.el (lisp-font-lock-keywords-2): Add pcase, pcase-let
+ and pcase-let*.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * server.el (server-execute): Respect initial-buffer-choice if it
+ is a string and there are no files to open (Bug#2825).
+ (server-create-window-system-frame, server-create-tty-frame):
+ Don't switch buffers here.
+ (server-process-filter): Only try to open a window system frame if
+ compiled with graphical support (Bug#8314).
+
+2012-04-20 Dan Nicolaescu <dann@gnu.org>
+
+ * battery.el (battery-echo-area-format): Display remaining time
+ for sysfs backend too (Bug#11269).
+ (battery-linux-sysfs): Fix conditional for the charge.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb): Revert previous change.
+ (gdb-inferior-io--init-proc): New function.
+ (gdb-init-1): Use it.
+ (gdb-inferior-io-sentinel): New sentinel for the gdb-inferior pty,
+ responsible for allocating a new pty and hooking it to gdb when
+ the old pty gets an EIO due to process exit.
+ (gdb-delchar-or-quit): New command. Bind it in gdb-mi buffers.
+ (gdb-tooltip-print): Don't use obsolete tooltip-use-echo-area.
+ (gdb-inferior-io--maybe-delete-pty): Move into gdb-reset.
+
+2012-04-20 Eli Zaretskii <eliz@gnu.org>
+
+ * window.el (window-min-size, window-sizable, window-min-delta)
+ (window-max-delta, window--resizable, window-resizable)
+ (window-total-size, window-full-height-p, window-full-width-p)
+ (window-in-direction, window--resize-mini-window, window-resize)
+ (window--resize-child-windows-normal)
+ (window--resize-child-windows, window--resize-siblings)
+ (window--resize-this-window, adjust-window-trailing-edge)
+ (enlarge-window, shrink-window): Doc fixes.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-inferior-io--maybe-delete-pty):
+ New function to call delete-process on the gdb-inferior buffer's pty.
+ (gdb-reset): Use it, instead of relying on kill-buffer to kill the
+ pty process (Bug#11273).
+ (gdb-update): New arg to suppress talking to the gdb process.
+ (gdb-done-or-error): Use it.
+ (gdb-stopped-functions): Rename from gdb-stopped-hooks.
+ (gdb): Call gdb-inferior-io--maybe-delete-pty as a workaround for
+ sentinel not being called.
+
+ * comint.el (make-comint-in-buffer, comint-exec): Doc fix.
+
+ * progmodes/grep.el (grep, rgrep): Doc fix (Bug#11268).
+
+2012-04-20 Glenn Morris <rgm@gnu.org>
+
+ * net/network-stream.el (open-network-stream): Doc fix.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-print): Fix typos.
+
+2012-04-20 Alan Mackenzie <acm@muc.de>
+
+ Ensure searching for keywords is case sensitive.
+
+ * progmodes/cc-cmds.el (c-electric-brace, c-electric-lt-gt)
+ (c-electric-paren, c-beginning-of-defun, c-end-of-defun)
+ (c-defun-name, c-mark-function, c-cpp-define-name)
+ (c-comment-indent, c-scan-conditionals, c-indent-defun)
+ (c-context-line-break): Bind case-fold-search to nil.
+
+ * progmodes/cc-mode.el (c-font-lock-fontify-region):
+ Bind case-fold-search to nil.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * mail/sendmail.el (mail-bury): Call return action with the right
+ Rmail buffer (Bug#11242).
+
+ * server.el (server-process-filter): Handle corner case where both
+ tty and nowait options are present (Bug#11102).
+
+2012-04-20 Eli Zaretskii <eliz@gnu.org>
+
+ * version.el (emacs-bzr-version, emacs-bzr-get-version): Doc fixes.
+ (top level): Put into the executable the ident-style '$Id:' tag on
+ windows-nt as well.
+
+2012-04-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * electric.el (electric-indent-post-self-insert-function): Check that
+ electric-indent-mode is enabled in current buffer.
+
+2012-04-19 Juanma Barranquero <lekktu@gmail.com>
+
+ * imenu.el (imenu-progress-message): Restore; it is "used" in
+ erc/erc-imenu.el and net/snmp-mode.el.
+
+2012-04-19 Juanma Barranquero <lekktu@gmail.com>
+
+ * avoid.el (mouse-avoidance-mode): Mark unused arg.
+ (mouse-avoidance-nudge-mouse): Remove unused binding.
+
+ * bs.el (bs-toggle-readonly): Call `toggle-read-only' interactively.
+
+ * descr-text.el (describe-char):
+ * progmodes/python.el (python-describe-symbol):
+ Don't call `toggle-read-only', set `buffer-read-only'.
+
+ * imenu.el (imenu-default-goto-function): Mark unused args.
+ (imenu-progress-message): Remove obsolete macro; all callers changed.
+
+ * subr.el (keymap-canonicalize): Remove unused binding.
+ (read-passwd): Mark unused arg.
+
+ * tutorial.el (tutorial--display-changes): Remove unused binding.
+ (tutorial--save-tutorial-to): Remove unused variable.
+
+ * emacs-lisp/package.el (define-package, package-menu-mark-delete)
+ (package-menu-mark-install, package-menu-mark-unmark): Mark unused args.
+ (package-generate-autoloads, package-menu--generate)
+ (package-menu--find-upgrades): Remove unused bindings.
+
+ * emulation/cua-rect.el (cua-restrict-regexp-rectangle)
+ (cua-restrict-prefix-rectangle): Doc fixes. Remove unused bindings.
+ (cua--mouse-ignore, cua--delete-rectangle, cua--extract-rectangle)
+ (cua--indent-rectangle, cua-open-rectangle, cua-close-rectangle)
+ (cua-blank-rectangle, cua-string-rectangle, cua-replace-in-rectangle)
+ (cua-incr-rectangle, cua-sequence-rectangle, cua--convert-rectangle-as)
+ (cua--rectangle-aux-replace, cua--left-fill-rectangle)
+ (cua-scroll-rectangle-up, cua-scroll-rectangle-down)
+ (cua-delete-char-rectangle): Mark unused args.
+ (cua-align-rectangle): Remove unused binding.
+
+ * mail/rmail.el (compilation--message->loc)
+ (epa--find-coding-system-for-mime-charset): Declare.
+
+ * net/dbus.el (dbus-register-service): Declare.
+ (dbus-name-owner-changed-handler): Remove unused binding.
+
+ * nxml/nxml-mode.el (nxml-electric-slash, nxml-in-mixed-content-p)
+ (nxml-compute-indent-from-matching-start-tag): Remove unused variables.
+ (nxml-scan-backward-within): Mark unused arg.
+ (nxml-dynamic-markup-word): Remove unused binding.
+
+ * mouse.el (mouse-menu-major-mode-map):
+ * emacs-lisp/authors.el (authors-scan-change-log)
+ (authors-add-to-author-list):
+ * emacs-lisp/avl-tree.el (avl-tree--enter-balance):
+ * emacs-lisp/smie.el (smie-auto-fill):
+ * mail/sendmail.el (mail-bury):
+ * mail/unrmail.el (unrmail):
+ * net/tls.el (open-tls-stream):
+ * textmodes/picture.el (picture-mouse-set-point):
+ Remove unused bindings.
+
+2012-04-19 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-action-password): Let-bind
+ `enable-recursive-minibuffers' to t.
+
+2012-04-18 Sam Steingold <sds@gnu.org>
+
+ * progmodes/gud.el (gud-key-prefix): Use :type 'key-sequence
+ instead of 'string to accommodate values like [f11].
+ Always use `vconcat' instead of `concat' on it, like in `gud-def'.
+ * progmodes/gdb-mi.el: Likewise.
+
+2012-04-18 Leo Liu <sdl.web@gmail.com>
+
+ * abbrev.el (edit-abbrevs): Move point to the abbrev table of
+ current buffer.
+ (prepare-abbrev-list-buffer): Enter edit-abbrevs-mode only if
+ LOCAL is nil.
+
+2012-04-18 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (line-move): Use forward-line if in batch mode
+ (Bug#11053).
+
+2012-04-18 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * files.el (after-find-file): Do not try to add a final newline if
+ the buffer is read-only (Bug#11156).
+
+2012-04-17 Richard Stallman <rms@gnu.org>
+
+ * mail/rmail.el (rmail-start-mail):
+ Pass (rmail-mail-return...) for the return-action.
+ Pass (rmail-yank-current-message...) for the yank-action.
+ (rmail-yank-current-message): New function.
+ (rmail-mail): Pass the Rmail buffer, not view buffer, for replybuffer.
+ (rmail-reply): Likewise.
+ (rmail-forward): Pass the Rmail buffer, not nil, for replybuffer.
+
+ * mail/sendmail.el (mail-bury): Choose the first rmail-mode
+ buffer, not the last. Reject temp buffers. Use the rmail-mode
+ buffer, not newbuf.
+
+2012-04-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * server.el (server-ensure-safe-dir): Simplify.
+
+2012-04-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el: Provide smarter auto-filling.
+ (smie-auto-fill): New function.
+ (smie-setup): Use it.
+
+ * newcomment.el (comment-choose-indent): Obey comment-inline-offset.
+
+2012-04-17 Philipp Haselwarter <philipp.haselwarter@gmx.de> (tiny change)
+
+ * newcomment.el (comment-inline-offset): New custom var (bug#11090).
+ (comment-indent): Use it.
+
+2012-04-17 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el: The overall change is to add cell renaming, that is
+ setting fancy names for cell symbols other than name matching
+ "\\`[A-Z]+[0-9]+\\'" regexp .
+ (ses-localvars): Add ses--renamed-cell-symb-list.
+ (ses-create-cell-variable): New defun.
+ (ses-destroy-cell-variable-range): Respect ses--numrows, ses--numcols.
+ (ses-relocate-formula): Relocate formulas only for cells the
+ symbols of which are not renamed, i.e. symbols whose names do not
+ match regexp "\\`[A-Z]+[0-9]+\\'".
+ (ses-relocate-all): Relocate values only for cells the symbols of
+ which are not renamed.
+ (ses-load): Create cells variables as the (ses-cell ...) are read,
+ in order to check row col consistency with cell symbol name only
+ for cells that are not renamed.
+ (ses-replace-name-in-formula): New defun.
+ (ses-rename-cell): New defun.
+
+2012-04-17 Peter Oliver <bzr@mavit.org.uk> (tiny change)
+
+ * progmodes/perl-mode.el (perl-indent-parens-as-block):
+ New option (bug#11118).
+ (perl-calculate-indent): Respect it.
+
+2012-04-17 Glenn Morris <rgm@gnu.org>
+
+ * dired-aux.el (dired-mark-read-string): Doc fix.
+
+2012-04-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * dired-aux.el (dired-mark-read-string): Offer optional completion.
+ (dired-do-chxxx): Complete chown, chgrp over users, groups. (Bug#7900)
+
+2012-04-17 Glenn Morris <rgm@gnu.org>
+
+ * mouse.el (mouse-drag-track):
+ * speedbar.el (speedbar-frame-mode):
+ Use auto-hscroll-mode rather than the alias automatic-hscrolling.
+
+2012-04-16 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/python.el: Trivial cleanup.
+
+2012-04-16 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc.el (vc-string-prefix-p):
+ * vc/pcvs-util.el (cvs-string-prefix-p):
+ * textmodes/tex-mode.el (latex-string-prefix-p, tex-string-prefix-p):
+ * mpc.el (mpc-string-prefix-p):
+ Make all of these into obsolete aliases for string-prefix-p.
+ Update callers.
+ * vc/pcvs.el, vc/vc-dispatcher.el, vc/vc-dir.el: Update callers.
+
+ * textmodes/two-column.el: Move custom options to the start.
+ (frame-width): Remove compat definition.
+ (2C-associate-buffer, 2C-dissociate):
+ Use with-current-buffer rather than save-excursion.
+ (2C-dissociate): Force a mode-line update.
+ (2C-autoscroll): Use ignore-errors.
+
+ * emacs-lisp/eieio-opt.el (describe-class, describe-generic):
+ Autoload trivia.
+
+ * emacs-lisp/cl-extra.el (*random-state*):
+ Remove unnecessary declaration.
+
+ * calendar/cal-tex.el (cal-tex-end-document): Trivial clarification.
+
+ * play/cookie1.el (cookie-snarf):
+ Give an explicit error if input file cannot be read.
+
+ * play/yow.el (yow-file): Use expand-file-name rather than concat.
+
+ * progmodes/perl-mode.el (c-macro-expand):
+ Remove unnecessary autoload (it is in loaddefs.el).
+
+ * textmodes/picture.el (picture-desired-column)
+ (picture-update-desired-column): Convert comments to doc-strings.
+ (picture-substitute): Remove function.
+ (picture-mode-map): Initialize in the defvar.
+
+ * woman.el: Remove eval-after-load for tar-mode.
+ * tar-mode.el (tar-mode-map): Add woman binding and menu entry.
+ (woman-tar-extract-file): Autoload it.
+
+ * frame.el (automatic-hscrolling): Make this alias obsolete.
+
+2012-04-12 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-set-spellchecker-params): Post-process
+ `ispell-dictionary-alist' to use [:alpha:] and utf-8 if possible.
+ (ispell-dictionary-base-alist): Revert to original XEmacs
+ friendly version for default. [:alpha:] will be added in
+ `ispell-set-spellchecker-params' if needed.
+
+2012-04-16 Chong Yidong <cyd@gnu.org>
+
+ * image.el (imagemagick--file-regexp): New variable.
+ (imagemagick-register-types): Use it.
+ (imagemagick-types-inhibit): Add :set function. Allow new value
+ of t to inhibit all types.
+
+ * emacs-lisp/regexp-opt.el (regexp-opt-charset): Avoid cl macros,
+ so we can preload it.
+
+ * loadup.el (fboundp): Preload regexp-opt, needed by
+ imagemagick-register-types.
+
+2012-04-15 Chong Yidong <cyd@gnu.org>
+
+ * frame.el (scrolling): Remove nearly unused customization group.
+
+ * scroll-all.el (scroll-all-mode): Move to windows group.
+
+2012-04-15 Chong Yidong <cyd@gnu.org>
+
+ * bindings.el (goto-map): Bind goto-char to M-g c (Bug#11240).
+
+2012-04-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Avoid the use of ((lambda ...) ...) in lexical-binding code.
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Use funcall (bug#11241).
+
+2012-04-15 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (process-file-side-effects): Doc fix.
+
+2012-04-15 Glenn Morris <rgm@gnu.org>
+
+ * international/mule-cmds.el (set-language-environment): Doc fix.
+
+2012-04-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * server.el (server-auth-key, server-generate-key): Doc fixes.
+ (server-get-auth-key): Doc fix. Use `string-match-p'.
+ (server-start): Reflow docstring.
+
+2012-04-14 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * server.el (server-generate-key): `called-interactively-p'
+ requires a parameter.
+
+2012-04-14 Michal Nazarewicz <mina86@mina86.com>
+
+ * server.el (server-auth-key): New variable.
+ (server-generate-key, server-get-auth-key): New function.
+ (server-start): Use the new variable and functions to allow
+ setting a permanent server key (bug#9423).
+
+2012-04-14 Leo Liu <sdl.web@gmail.com>
+
+ * vc/diff-mode.el (diff-file-prev/next): Fix typo.
+
+2012-04-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes.
+ * hexl.el (hexl-rulerize): Rename from hexl-rulerise, since
+ Emacs uses American spelling.
+
+2012-04-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lock.el (emacs-lock-locked-buffer-functions): New hook.
+ (emacs-lock--exit-locked-buffer): Return the locked buffer. Doc fix.
+ (emacs-lock--kill-emacs-hook, emacs-lock--kill-emacs-query-functions)
+ (emacs-lock--kill-buffer-query-functions): Run new hook. (Bug#11017)
+
+2012-04-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/which-func.el (which-func-modes): Change default.
+
+2012-04-14 Kim F. Storm <storm@cua.dk>
+
+ * emulation/cua-base.el (cua-exchange-point-and-mark): Just call
+ exchange-point-and-mark if cua-enable-cua-keys is nil (Bug#11191).
+
+2012-04-14 Chong Yidong <cyd@gnu.org>
+
+ * custom.el (custom-theme-set-variables): Doc fix.
+
+2012-04-14 Glenn Morris <rgm@gnu.org>
+
+ * international/mule.el (set-auto-coding-for-load): Doc fix.
+
+2012-04-14 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-menus.el (cc-imenu-objc-generic-expression): Make
+ imenu work again for Objective C Mode. Correct the *-index values,
+ these having been disturbed by a previous change in 2011-08.
+
+ * progmodes/cc-engine.el (c-before-change-check-<>-operators):
+ Correct two search limits.
+
+2012-04-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * startup.el (command-line-1): Inhibit splash from daemon (bug#10996).
+
+2012-04-14 Andreas Schwab <schwab@linux-m68k.org>
+
+ * international/characters.el: Fix sorting.
+
+2012-04-14 Eli Zaretskii <eliz@gnu.org>
+
+ * international/characters.el: Add more missing Latin case pairs.
+
+2012-04-14 Glenn Morris <rgm@gnu.org>
+
+ * files.el (dir-locals-set-class-variables): Doc fix.
+
+2012-04-14 Eli Zaretskii <eliz@gnu.org>
+
+ * international/characters.el: Add set-case-syntax-pair call for
+ LATIN CAPITAL LETTER Y WITH DIAERESIS RET and its lower-case
+ counterpart. (Bug#11209)
+
+ * simple.el (shell-command-on-region): Doc fix. (Bug#11208)
+
+2012-04-14 Glenn Morris <rgm@gnu.org>
+
+ * calendar/holidays.el (calendar-check-holidays): Doc fix.
+
+2012-04-14 Eli Zaretskii <eliz@gnu.org>
+
+ * textmodes/ispell.el (ispell-dictionary-base-alist):
+ Add data for Hebrew.
+
+2012-04-14 Chong Yidong <cyd@gnu.org>
+
+ * net/rcirc.el (rcirc-cmd-quit):
+ Revert 2012-03-18 change (Bug#11192).
+
+2012-04-14 Glenn Morris <rgm@gnu.org>
+
+ * pcmpl-rpm.el (pcomplete/rpm): Handle -qf.
+
+2012-04-14 Eli Zaretskii <eliz@gnu.org>
+
+ * minibuffer.el (completion-in-region-mode-map):
+ Bind completion-help-at-point to M-? rather than ?. (Bug#11182)
+
+2012-04-13 Vivek Dasmohapatra <vivek@etla.org>
+
+ * hexl.el (hexl-insert-char): Make display sizes other than 16 work.
+
+2012-04-13 Masatake YAMATO <yamato@redhat.com>
+
+ * minibuffer.el (minibuffer-local-filename-syntax): New variable
+ to allow `C-M-f' and `C-M-b' to move to the nearest path
+ separator (bug#9511).
+
+2012-04-13 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * avoid.el: Require cl when compiling. And also move the
+ `provide' to the end.
+
+2012-04-13 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * avoid.el (mouse-avoidance-banish-position): New variable.
+ (mouse-avoidance-banish-destination): Use it (bug#10165).
+
+2012-04-13 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/which-func.el (which-func-modes): Add objc-mode.
+
+2012-04-13 Ken Brown <kbrown@cornell.edu>
+
+ * net/browse-url.el (browse-url-file-url): Remove Cygwin hack;
+ this is no longer needed now that cygstart understands file:// URLs.
+ (browse-url-filename-alist): For the same reason, don't modify
+ file:// URLs on Cygwin.
+
+2012-04-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emulation/cua-base.el (cua--pre-command-handler-1): Don't activate
+ the region on shift if the binding is already shifted (bug#11221).
+
+2012-04-12 Glenn Morris <rgm@gnu.org>
+
+ * mail/mailpost.el: Move to obsolete/.
+
+2012-04-12 Drew Adams <drew.adams@oracle.com>
+
+ * imenu.el (imenu--generic-function): Ignore invisible definitions
+ (bug#10123).
+
+2012-04-12 Vivek Dasmohapatra <vivek@etla.org>
+
+ * hexl.el (hexl-bits): New variable.
+ (hexl-options): Mention the variable in the doc string.
+ (hexl-rulerise, hexl-line-displen): New functions.
+ (hexl-mode): Mention the new variable.
+ (hexl-mode, hexl-current-address, hexl-current-address):
+ Use the displen.
+ (hexl-ascii-start-column): New function.
+ (hexl-address-to-marker, hexl-beginning-of-line, hexl-options)
+ (hexl-insert-char, hexl-mode-ruler): Use the displen (bug#4941).
+
+2012-04-12 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/flyspell.el (flyspell-large-region): For hunspell, use
+ '("-i" ENCODING), in 2 separate command-line arguments, to specify
+ the encoding, as expected by hunspell.
+
+2012-04-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * battery.el (battery--linux-sysfs-regexp): New const.
+ (battery-status-function): Use it. Remove yeeloong special case.
+ (battery-yeeloong-sysfs): Remove.
+ (battery-echo-area-format): Remove yeeloong special case.
+
+2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * imenu.el (imenu-add-to-menubar): `current-local-map' can be nil.
+ Reported by Noah Friedman.
+
+ * subr.el (read-passwd): Use read-string.
+
+2012-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * vcursor.el (vcursor-move): Increase the priority of the overlay
+ (bug#9663).
+
+2012-04-11 Deniz Dogan <deniz.a.m.dogan@gmail.com>
+
+ * net/rcirc.el (rcirc-kill-channel-buffers): New variable.
+ (rcirc-kill-buffer-hook): Use it to kill channel buffers (bug#5128).
+
+2012-04-11 William Stevenson <yhvh2000@gmail.com>
+
+ * textmodes/artist.el (artist-mode): Convert artist-mode to use
+ define-minor-mode (bug#10760).
+
+2012-04-11 Wolfgang Jenkner <wjenkner@inode.at> (tiny change)
+
+ * progmodes/grep.el (rgrep): Tweak the find command line so
+ that directories matching `grep-find-ignored-files' won't be
+ pruned (bug#10351).
+
+2012-04-11 Chong Yidong <cyd@gnu.org>
+
+ * startup.el (command-line): Remove support for long-obsolete
+ variable font-lock-face-attributes.
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-bzr.el (vc-bzr-status): Avoid condition-case-unless-debug.
+
+2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * window.el (window--state-get-1): Obey window-point-insertion-type.
+
+2012-04-11 Lennart Borgman <lennart.borgman@gmail.com>
+
+ * emacs-lisp/lisp.el (narrow-to-defun): `beginning-of-defun' goes
+ to previous function when point is on the first character of a
+ function. Take care of that in `narrow-to-defun' (bug#6157).
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-bzr.el (vc-bzr-status): Handle all errors,
+ not just file-errors.
+
+ * vc/vc-bzr.el (vc-bzr-sha1-program, sha1-program): Remove.
+ (vc-bzr-sha1): Use internal sha1.
+
+2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/flymake.el (flymake-mode): Beware read-only dirs (bug#8954).
+
+2012-04-10 Sébastien Gross <seb@chezwam.org> (tiny change)
+
+ * progmodes/hideshow.el (hs-hide-all): Don't infloop on comments
+ that start in the middle of the line (bug#10496).
+
+2012-04-10 Dan Nicolaescu <dann@gnu.org>
+
+ * battery.el (battery-linux-proc-acpi): Only one battery is
+ discharged at a time, but that seems to confuse battery.el when
+ computing `rate-type' for the battery not being discharged
+ (bug#10332).
+
+2012-04-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/autoload.el (autoload-make-program): Remove, unused.
+
+ * international/quail.el: Use dolist and simplify.
+ (quail-define-package, quail-update-keyboard-layout)
+ (quail-define-rules): Use dolist.
+ (quail-insert-kbd-layout, quail-get-translation): CSE.
+
+ * tmm.el: Use dolist, remove left over hook.
+ (tmm-prompt, tmm-define-keys, tmm-shortcut, tmm-get-keybind):
+ Use dolist.
+ (calendar-load-hook): Don't mess with it.
+
+ * vc/vc-annotate.el (vc-annotate-show-diff-revision-at-line-internal):
+ Use derived-mode-p. Run the diff asynchronously.
+
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * obsolete/mouse-sel.el: Add an Obsolete-since header.
+
+2012-04-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * misc.el: Display absolute path of loaded DLLs (bug#10424).
+ (list-dynamic-libraries--loaded): New function.
+ (list-dynamic-libraries--refresh): Use it.
+
+2012-04-10 Nathan Weizenbaum <nweiz@google.com>
+
+ * progmodes/python.el (python-fill-paragraph):
+ Make python-fill-region in a multiline string work when font-lock is
+ disabled (bug#7018).
+
+2012-04-10 Laimonas Vėbra <laimonas.vebra@gmail.com> (tiny change)
+
+ * language/european.el (cp775): Add oem/legacy (en)coding on
+ DOS/MS Windows for the Baltic languages. There are still plenty
+ of texts written in this encoding/codepage (bug#6519).
+
+2012-04-10 Glenn Morris <rgm@gnu.org>
+
+ * cus-start.el (eol-mnemonic-unix, eol-mnemonic-dos, eol-mnemonic-mac):
+ Add :standard values, reducing "rogue" customs in emacs -Q a bit more.
+
+2012-04-10 Florian Adamsky <florian@adamsky.it> (tiny change)
+
+ * recentf.el (recentf-dialog-mode-map): Add two keybindings for
+ next-line "n" and previous-line "p" in order to make recentf more
+ consistent with ibuffer, dired or org-mode (bug#9387).
+
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * image.el (put-image): Return the overlay created instead of the
+ optional input string (bug#7834). Note that this may break code
+ that is (for some reason or other) depending on `put-image'
+ returning the string.
+
+ * mouse-sel.el (mouse-sel-mode): Mark as obsolete (bug#6174).
+
+ * simple.el (zap-to-char): Allow zapping using input methods
+ (bug#1580).
+
+ * textmodes/fill.el (fill-region): Leave point and mark where they
+ were before filling (bug#5399).
+
+2012-04-09 Glenn Morris <rgm@gnu.org>
+
+ * version.el (emacs-bzr-get-version):
+ Handle lightweight checkouts of local branches.
+
+2012-04-09 Andreas Schwab <schwab@linux-m68k.org>
+
+ * international/characters.el: Recover lost case pairs. (Bug#11209)
+
+2012-04-09 Chong Yidong <cyd@gnu.org>
+
+ * custom.el (custom-variable-p): Return nil for non-symbol
+ arguments instead of signaling an error.
+ (user-variable-p): Obsolete alias for custom-variable-p.
+
+ * apropos.el (apropos-variable):
+ * files-x.el (read-file-local-variable):
+ * simple.el (set-variable):
+ * woman.el (woman-mini-help):
+ * emacs-lisp/byte-opt.el (side-effect-free-fns): Callers changed.
+
+2012-04-09 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (normal-top-level): Don't look for leim-list.el
+ in places where it will not be found. (Bug#910)
+
+ * international/mule-cmds.el (set-default-coding-systems):
+ * files.el (normal-mode):
+ Remove guarded calls to ucs-set-table-for-input. (Bug#9821)
+ This function was removed with ucs-tables.el in 2008.
+
+2012-04-08 Eli Zaretskii <eliz@gnu.org>
+
+ * textmodes/ispell.el (ispell-check-version): For hunspell, set
+ ispell-encoding8-command to "-i", without a trailing space.
+ (ispell-start-process): For hunspell, use '("-i" ENCODING), in 2
+ separate command-line arguments, to specify the encoding, since
+ that's how hunspell expects it.
+
+2012-04-08 Glenn Morris <rgm@gnu.org>
+
+ * loadup.el: Load bindings before cus-start.
+ This reduces somewhat the number of "rogue" settings in emacs -Q.
+
+2012-04-07 Glenn Morris <rgm@gnu.org>
+
+ * version.el (emacs-bzr-get-version): New function.
+ (emacs-bzr-version): New variable.
+ * loadup.el (emacs-bzr-version): Set it. (Bug#8054)
+ * mail/emacsbug.el (report-emacs-bug): Include bzr version.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * international/uni-bidi.el, international/uni-category.el:
+ * international/uni-combining.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-titlecase.el, international/uni-uppercase.el:
+ Update for Unicode 6.1.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * term/w32-win.el (dynamic-library-alist): Add libxml2 DLLs.
+
+2012-04-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * window.el (shrink-window): Mention the `window-min-height'
+ variable in the doc string.
+
+2012-04-05 Bastien Guerry <bzg@altern.org>
+
+ * color.el (color-lighten-name): Fix typo.
+
+2012-04-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * server.el (server--on-display-p): New function.
+ (server--on-display-p): Use it.
+
+2012-04-04 Gabor Vida <vidagabor@gmail.com> (tiny change)
+
+ * ido.el (ido-wide-find-dirs-or-files): Use file-name-absolute-p
+ (bug#11145).
+
+2012-04-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * comint.el (comint--common-quoted-suffix): Check string boundary
+ before comparing (bug#11158).
+ * pcomplete.el (pcomplete--common-quoted-suffix): Idem.
+
+2012-04-04 Chong Yidong <cyd@gnu.org>
+
+ * minibuffer.el (completion-extra-properties): Doc fix.
+
+ * subr.el (delayed-warnings-hook): Doc fix.
+
+2012-04-04 Daiki Ueno <ueno@unixuser.org>
+
+ * epa.el (epa--select-keys): Bind C-c C-c to finish the key
+ selection (Bug#11159).
+ (epa-insert-keys): Inform that the default public key will be
+ exported if no key is selected.
+
+2012-04-04 Richard Stallman <rms@gnu.org>
+
+ * mail/emacsbug.el (report-emacs-bug): Bind inhibit-read-only.
+
+2012-04-03 Chong Yidong <cyd@gnu.org>
+
+ * mail/sendmail.el (mail-mode-map): Bind C-c C-i to
+ mail-insert-file, not its obsolete alias mail-attach-file.
+
+2012-04-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * notifications.el (notifications-notify): Fix docstring.
+
+2012-04-02 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-aliases): Another addition.
+
+2012-04-02 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-gvfs.el (tramp-gvfs-send-command): Apply
+ `tramp-compat-call-process' instead of `tramp-local-call-process'.
+ Reported by Magnus Henoch <magnus.henoch@gmail.com>.
+
+2012-04-01 Chong Yidong <cyd@gnu.org>
+
+ * files.el (file-in-directory-p): Rename from file-subdir-of-p.
+ Handle root directory properly.
+ (copy-directory): Caller changed.
+
+ * dired-aux.el (dired-copy-file-recursive, dired-create-files):
+ * net/tramp.el (tramp-file-name-for-operation): Callers changed.
+
+2012-03-31 Glenn Morris <rgm@gnu.org>
+
+ * term/xterm.el (xterm-extra-capabilities): Doc fix.
+
+ * language/indian.el ("Devanagari"): Fix typo. (Bug#11103)
+
+ * calendar/calendar.el (calendar-window-list)
+ (calendar-hide-window): Restore. (Bug#11140)
+ (calendar-exit): Use calendar-window-list, calendar-hide-window again.
+
+ * emacs-lisp/edebug.el (edebug-unwrap-results): Doc fix.
+
+2012-03-30 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * dired-aux.el (dired-copy-file-recursive, dired-create-files):
+ Check if file is a symlink (Bug#10489).
+
+ * files.el (copy-directory): Likewise.
+
+2012-03-30 Chong Yidong <cyd@gnu.org>
+
+ * image.el (imagemagick-types-inhibit)
+ (imagemagick-register-types): Doc fix.
+
+2012-03-30 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-get-extended-character-mode):
+ Disable extended-char-mode for hunspell. hunspell does not support it
+ and treats ~word as ordinary words in pipe mode.
+
+2012-03-30 Glenn Morris <rgm@gnu.org>
+
+ * tutorial.el (help-with-tutorial): Ensure local variables don't
+ happen to make the buffer read-only. (Bug#11127)
+
+2012-03-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/perl-mode.el (perl-indent-line): Use `noindent' in strings.
+ (perl-calculate-indent): Return `noindent' in strings.
+
+2012-03-28 Sam Steingold <sds@gnu.org>
+
+ * calendar/calendar.el (calendar-exit): Use `quit-windows-on'
+ instead of the broken adhockery which does not prevent calendar
+ buffers from being displayed at random after exit.
+ (calendar-window-list, calendar-hide-window): Remove the broken
+ adhockery.
+
+2012-03-28 Glenn Morris <rgm@gnu.org>
+
+ * replace.el (query-replace-map): Doc fix.
+
+2012-03-28 Andreas Schwab <schwab@linux-m68k.org>
+
+ * vc/vc-git.el (vc-git-state): Don't try to match all of the diff
+ contents. (Bug#11109)
+
+2012-03-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/avl-tree.el (avl-tree--enter-balance): Fix paren typo
+ (bug#11077).
+ (avl-tree--check, avl-tree--check-node): New funs.
+
+2012-03-27 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (switch-to-visible-buffer): New option.
+ (switch-to-prev-buffer, switch-to-next-buffer):
+ Observe switch-to-visible-buffer. Make sure that checking for a window
+ showing a buffer already is done on the same frame.
+
+2012-03-27 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (mail-host-address): Doc fix.
+
+2012-03-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (byte-compile-constants-vector): Allow more
+ than 197 variables.
+
+2012-03-26 Ami Fischman <ami@fischman.org>
+
+ * vc/vc-git.el (vc-git-state): Avoid unnecessarily locking.
+
+2012-03-26 Glenn Morris <rgm@gnu.org>
+
+ * files.el (save-buffers-kill-emacs): Doc fix.
+
+ * startup.el (normal-top-level, command-line, command-line-1):
+ Give them doc strings.
+
+2012-03-25 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (install): Use $(DIRNAME)_same-dir.tst instead
+ of same-dir.tst, to avoid stepping on other (parallel) Make job's toes.
+
+2012-03-25 Chong Yidong <cyd@gnu.org>
+
+ * custom.el (load-theme): Even if NO-ENABLE arg is t, reenable the
+ theme if it was previously enabled before (Bug#11031).
+
+ * cus-theme.el (custom-theme-write-faces): Retrieve current face
+ spec with custom-face-get-current-spec if its :shown-value is not
+ determined yet (Bug#9337).
+ (customize-create-theme, custom-theme-revert): Doc fixes.
+
+ * button.el (button-at): Minor addition to docstring.
+
+2012-03-24 Simon Leinen <simon.leinen@gmail.com>
+
+ * vc/vc.el (vc-merge): Fix a prompt.
+
+2012-03-24 Chong Yidong <cyd@gnu.org>
+
+ * mwheel.el (mwheel-scroll): Call deactivate-mark at the right
+ point (Bug#9623).
+
+ * button.el (button-at): Minor addition to docstring.
+
+2012-03-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * newcomment.el (comment-choose-indent): No space after BOL.
+
+2012-03-22 Sam Steingold <sds@gnu.org>
+
+ * window.el (switch-to-prev-buffer): Revert last patch because the
+ bug turned out to be an advertised feature (Elisp manual 28.14).
+
+2012-03-22 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-bzr.el (vc-bzr-status-switches): New option. (Bug#6724)
+ (vc-bzr-command): If running "status", pass vc-bzr-status-switches.
+
+2012-03-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/network-stream.el (network-stream-open-starttls): Make error
+ message under Windows be less misleading.
+
+2012-03-22 Liang Wang <netcasper@gmail.com> (tiny change)
+
+ * progmodes/etags.el (etags-list-tags): Only use tags which goto-func
+ understands (bug#9942).
+
+2012-03-22 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (end-of-visible-line): Handle return value of
+ next-single-property-change properly (Bug#9371).
+
+2012-03-22 Kenichi Handa <handa@m17n.org>
+
+ * international/quail.el (quail-insert-kbd-layout): Fix previous
+ change. To avoid unwanted bidi reordering, use
+ bidi-string-mark-left-to-right instead of inserting LRO and PDF.
+
+2012-03-21 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el: Don't confuse "end:" for "end" (bug#10786).
+ (ruby-block-end-re, ruby-delimiter, ruby-parse-partial)
+ (ruby-beginning-of-indent): Be more careful with the difference
+ between word-boundary and symbol boundary.
+ (ruby-mode-syntax-table): Make : a symbol constituent.
+
+2012-03-21 Andreas Politz <politza@fh-trier.de>
+
+ * outline.el (outline-flag-region): Evaporate overlays (bug#10789).
+
+2012-03-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/etags.el (tags-completion-at-point-function):
+ Improve last fix.
+
+ * files.el (move-file-to-trash): Files aren't regexps (bug#11055).
+
+2012-03-21 Sam Steingold <sds@gnu.org>
+
+ * progmodes/etags.el (tags-completion-at-point-function):
+ Avoid the error when point is inside the pattern.
+
+2012-03-21 John Yates <john@yates-sheets.org> (tiny change)
+
+ * progmodes/hideshow.el (hs-inside-comment-p): Fix hiding of first
+ line (Bug#10855).
+
+2012-03-21 Drew Adams <drew.adams@oracle.com>
+
+ * info.el (Info-menu): Handle string value of FORK arg (Bug#10858).
+
+2012-03-21 Anmol Khirbat <anmol@khirbat.net> (tiny change)
+
+ * ido.el (ido-set-current-directory, ido-read-internal)
+ (ido-choose-completion-string, ido-completion-help): Handle nil
+ value of ido-completion-buffer (Bug#11008).
+
+2012-03-21 Sam Steingold <sds@gnu.org>
+
+ * window.el (switch-to-prev-buffer): Do not switch to a visible
+ window previous buffer, just like with the frame previous buffers.
+
+2012-03-21 Chong Yidong <cyd@gnu.org>
+
+ * faces.el (make-face, make-empty-face, copy-face):
+ * face-remap.el (face-remap-add-relative, face-remap-set-base):
+ Doc fixes.
+
+2012-03-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * wid-edit.el (widget-complete-field): Remove (bug#11051).
+ (widget-complete): Remove broken use of it.
+
+2012-03-20 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-print-entry):
+ Use string-width and truncate-string-width to handle arbitrary
+ characters.
+
+2012-03-20 Tassilo Horn <tassilo@member.fsf.org>
+
+ * textmodes/artist.el (artist-menu-map): Bind Rectangle menu item
+ to draw rectangles, not squares. (Regression introduced by revno
+ 2011-03-02T03:48:01Z!cyd@stupidchicken.com)
+
+2012-03-18 Chong Yidong <cyd@gnu.org>
+
+ * faces.el (face-spec-reset-face): Don't call display-graphic-p if
+ it is not yet defined (for temacs).
+
+2012-03-18 Leo Liu <sdl.web@gmail.com>
+
+ * net/rcirc.el (rcirc-cmd-quit): Allow quitting all servers with
+ prefix.
+
+2012-03-17 Eli Zaretskii <eliz@gnu.org>
+
+ * textmodes/ispell.el (ispell-skip-tib, ispell-keep-choices-win)
+ (ispell-choices-win-default-height, ispell-silently-savep)
+ (ispell-dictionary-alist, ispell-encoding8-command)
+ (ispell-check-version, ispell-aspell-find-dictionary)
+ (ispell-valid-dictionary-list, ispell-words-keyword)
+ (ispell-get-word, ispell-internal-change-dictionary)
+ (ispell-region, ispell-skip-region-list)
+ (ispell-begin-skip-region-regexp, ispell-ignore-fcc)
+ (ispell-process-line, ispell-minor-mode, ispell-minor-check)
+ (ispell-message-text-end, ispell-message)
+ (ispell-buffer-local-parsing): Doc fix.
+
+2012-03-13 Jambunathan K <kjambunathan@gmail.com>
+
+ * htmlfontify.el: Add support for code block fontification for ODT
+ export (Bug #9914).
+ (hfy-optimisations): Define new option
+ `body-text-only'
+ (hfy-fontify-buffer): Honor above setting.
+ (hfy-begin-span, hfy-end-span): New routines factored out form
+ `hfy-fontify-buffer'.
+ (hfy-begin-span-handler, hfy-end-span-handler): New variables
+ that permit insertion of custom tags.
+ (hfy-fontify-buffer): Use above handlers.
+ (hfy-face-to-css-default): Same as the earlier `hfy-face-to-css'.
+ (hfy-face-to-css): Re-defined to be a variable.
+ (hfy-compile-stylesheet): Modify. Allow stylesheet to be built
+ over multiple runs. This is made possible by having the caller let
+ bind a special variable `hfy-user-sheet-assoc'.
+ (htmlfontify-string): New defun.
+ (hfy-compile-face-map): Make sure that the last char in the
+ buffer is correctly fontified.
+ (hfy-face-resolve-face): Whitespace only change.
+
+2012-03-17 Eli Zaretskii <eliz@gnu.org>
+
+ * textmodes/ispell.el (ispell-get-decoded-string): Make the error
+ message more clear.
+
+2012-03-16 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/copyright.el (copyright-year-ranges): Fix typo.
+
+2012-03-16 Alan Mackenzie <acm@muc.de>
+
+ Further optimise the handling of large macros.
+
+ * progmodes/cc-engine.el (c-crosses-statement-barrier-p): Use a
+ limit to a call of `c-literal-limits'.
+ (c-determine-+ve-limit): New function.
+ (c-at-macro-vsemi-p): Move `c-in-literal' to the bottom of an `and'.
+ (c-guess-basic-syntax): In macros, restrict a search limit to 2000.
+ In CASE 5B, restrict a search limit to 500.
+ (c-just-after-func-arglist-p): Obviouly wrong `or' -> `and'.
+
+ * progmodes/cc-mode.el (c-neutralize-syntax-in-and-mark-CPP):
+ Restrict macro bounds to +-500 from after-change's BEG END.
+
+2012-03-16 Leo Liu <sdl.web@gmail.com>
+
+ * font-lock.el (lisp-font-lock-keywords-2): Add letrec.
+
+2012-03-16 Aaron S. Hawley <Aaron.S.Hawley@gmail.com>
+
+ * tar-mode.el (tar-mode): Fix saving by conditionally undoing
+ `special-mode' setting of `buffer-read-only'. (Bug#11010)
+
+2012-03-16 Glenn Morris <rgm@gnu.org>
+
+ * view.el (view-buffer, view-buffer-other-window)
+ (view-buffer-other-frame): Doc fixes re special mode-class.
+
+ * subr.el (eval-after-load): If named feature is provided not from
+ a file, run after-load forms. (Bug#10946)
+
+ * calendar/calendar.el (calendar-insert-at-column):
+ Handle non-unit-width characters a bit better. (Bug#10978)
+
+2012-03-15 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/ring.el (ring-extend): New function.
+ (ring-insert+extend): Extend the ring correctly (Bug#11019).
+
+ * comint.el (comint-read-input-ring)
+ (comint-add-to-input-history): Grow comint-input-ring lazily.
+
+2012-03-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/perl-mode.el (perl-syntax-propertize-special-constructs):
+ Fix up parsing of multiline twoarg non-paired elements (bug#11014).
+
+ * imenu.el: Fix multiple inheritance breakage (bug#9199).
+ (imenu-add-to-menubar): Don't add a redundant index.
+ (imenu-update-menubar): Handle a dynamically composed keymap.
+
+2012-03-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mail/sendmail.el (mail-encode-header):
+ Bind rfc2047-encode-encoded-words to nil.
+
+2012-03-13 Glenn Morris <rgm@gnu.org>
+
+ * calendar/calendar.el (calendar-string-spread):
+ Handle non-unit-width characters a bit better. (Bug#10978)
+
+2012-03-13 Leo Liu <sdl.web@gmail.com>
+
+ * vc/vc-hg.el (vc-hg-working-revision): Rework to work with both
+ directory and file as argument (Bug#10822).
+
+2012-03-13 Kaushik Srenevasan <ksrenevasan@gmail.com> (tiny change)
+
+ * progmodes/gdb-mi.el (gdb-invalidate-disassembly):
+ For dynamically generated code, follow $PC.
+ (gdb-disassembly-handler-custom): Handle no function name case.
+
+2012-03-13 Tim Landscheidt <tim@tim-landscheidt.de> (tiny change)
+
+ * calendar/icalendar.el (icalendar-export-file, icalendar-import-file):
+ * emulation/ws-mode.el (ws-query-replace):
+ * sort.el (sort-regexp-fields):
+ Fix missing trailing whitespace in interactive prompts. (Bug#11002)
+
+2012-03-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * dabbrev.el: Fix cycle completion order (bug#10963).
+ (dabbrev--last-obarray, dabbrev--last-completion-buffer): Remove.
+ (dabbrev-completion): Don't use an obarray; provide
+ a cycle-sort-function.
+
+2012-03-12 Leo Liu <sdl.web@gmail.com>
+
+ * simple.el (kill-new): Use equal-including-properties for comparison.
+ (kill-do-not-save-duplicates): Doc fix.
+
+2012-03-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * dabbrev.el: Fix cycle completion (bug#10963).
+ Use lexical binding and wrap to 80 columns.
+ (dabbrev-completion): Delay computing the list of completions.
+
+2012-03-12 Kenichi Handa <handa@m17n.org>
+
+ * international/quail.el (quail-insert-kbd-layout): Surround each
+ row by LRO and PDF instead of inserting many LRMs. Pad the left
+ and right of each non-spacing marks. Insert invisible space
+ between lower and upper characters to prevent composition.
+
+2012-03-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (minibuffer-complete): Don't get confused when the
+ function is run twice via different commands (bug#10958).
+ (complete-with-action): Fix docstring.
+
+2012-03-12 Chong Yidong <cyd@gnu.org>
+
+ * nxml/nxml-mode.el (nxml-mode-map): Do not bind C-RET (Bug#6776).
+ (nxml-completion-at-point-function): New function.
+ (nxml-mode): Use it.
+ (nxml-bind-meta-tab-to-complete-flag): Default to t.
+
+ * emacs-lisp/package.el (package-unpack, package-unpack-single):
+ Load generated autoloads file before byte compiling (Bug#10970).
+ (package--make-autoloads-and-compile): New helper fun.
+
+2012-03-12 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * ibuffer.el (ibuffer-redisplay): Remove another gratuitous error.
+
+2012-03-11 Michael Albinus <michael.albinus@gmx.de>
+
+ * autorevert.el (auto-revert-handler): Ensure, that
+ file-readable-p is applied only for local files or in
+ auto-revert-tail-mode.
+
+2012-03-11 Andreas Schwab <schwab@linux-m68k.org>
+
+ * server.el (server-eval-at): Handle non-tcp connections.
+ Decode result string.
+
+ * server.el (server-msg-size): New constant.
+ (server-reply-print): New function.
+ (server-eval-and-print): Use it.
+ (server-eval-at): Use server-quote-arg and server-unquote-arg.
+ Handle -print-nonl.
+
+2012-03-11 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * ibuffer.el (ibuffer-redisplay): Remove gratuitous error
+ (Bug#10987).
+
+2012-03-11 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (goto-line): Doc fix (Bug#9938).
+
+ * subr.el (save-window-excursion): Doc fix (Bug#9979).
+
+ * dabbrev.el (dabbrev--find-expansion): Update progress reporter
+ when finished (Bug#10963).
+
+2012-03-11 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (split-window-below): Fix bug in case where
+ split-window-keep-point is nil (Bug#10971).
+
+2012-03-11 Juri Linkov <juri@jurta.org>
+
+ * replace.el (replace-highlight): Set isearch-word to nil
+ unconditionally. (Bug#10887)
+
+2012-03-10 Eli Zaretskii <eliz@gnu.org>
+
+ * net/mairix.el (mairix-replace-invalid-chars): Rename from
+ mairix-replace-illegal-chars; all callers changed. Don't remove
+ ^, ~, and = characters: they are meaningful in mairix search specs.
+ (mairix-widget-create-query): Add usage information about mairix
+ search forms: negating words, searching for substrings, etc.
+
+2012-03-10 Jae-hyeon Park <jae-hyeon.park@desy.de> (tiny change)
+
+ * international/fontset.el (font-encoding-alist): Add an entry for
+ ksx1001 (Bug#5667).
+
+2012-03-10 Richard Stallman <rms@gnu.org>
+
+ * mail/sendmail.el (mail-encode-header):
+ Set rfc2047-encode-encoded-words.
+
+ * mail/mail-utils.el (mail-quote-printable): Quote multibyte chars.
+
+ * mail/rmail.el (rmail-buffers-swapped-p): Don't assume dead
+ view buffer means not swapped.
+ (rmail-view-buffer-kill-buffer-hook): Give buf name in error msg.
+ (rmail-write-region-annotate): Error if real text has disappeared.
+
+ * epa-mail.el (epa-mail-encrypt): Bind inhibit-read-only.
+
+2012-03-10 Chong Yidong <cyd@gnu.org>
+
+ * emulation/cua-rect.el (cua--init-rectangles):
+ * emulation/cua-base.el (cua--init-keymaps):
+ Add delete-forward-char to remappings (Bug#9666).
+
+2012-03-10 Martin Rudalics <rudalics@gmx.at>
+
+ * speedbar.el (speedbar-unhighlight-one-tag-line):
+ Avoid unhighlighting due to frame switching (Bug#10275).
+
+2012-03-10 Chong Yidong <cyd@gnu.org>
+
+ * minibuffer.el (completion-in-region, completion-help-at-point):
+ Give the completion field overlay a high priority (Bug#6830).
+
+ * dired.el (dired-goto-file): Recognize absolute file name
+ listings (Bug#7126).
+ (dired-goto-file-1): New helper function.
+ (dired-toggle-read-only): Inhibit warnings.
+
+2012-03-09 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus-property-handler): Return empty array if
+ there are no properties.
+
+2012-03-09 Leo Liu <sdl.web@gmail.com>
+
+ * savehist.el (savehist-printable): Stricter check for string
+ value (Bug#10937).
+
+2012-03-09 Eli Zaretskii <eliz@gnu.org>
+
+ * mail/smtpmail.el (smtpmail-send-it):
+ Bind coding-system-for-write to *-unix, so that FCC files are kept in
+ valid mbox format.
+
+2012-03-09 Glenn Morris <rgm@gnu.org>
+
+ * files.el (dir-locals-find-file):
+ Don't check result is regular, readable.
+ (dir-locals-read-from-file): Demote errors.
+
+2012-03-08 Eli Zaretskii <eliz@gnu.org>
+
+ * international/quail.el (quail-insert-kbd-layout):
+ Insert invisible LRM characters before each character in a keyboard
+ layout cell, to prevent their reordering by bidi display engine.
+ For details, see the discussion in
+ http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00085.html.
+
+2012-03-08 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-cmds.el (c-mark-function): Make it leave a mark at
+ the starting position; make it extend the marked region when
+ invoked repeatedly - all under appropriate circumstances.
+ Fixes bugs #5525, #10906.
+
+2012-03-08 Glenn Morris <rgm@gnu.org>
+
+ * files.el (locate-dominating-file, dir-locals-find-file):
+ Undo 2012-03-06 change.
+
+2012-03-07 Eli Zaretskii <eliz@gnu.org>
+
+ * international/quail.el (quail-help):
+ Force bidi-paragraph-direction be left-to-right. See discussion in
+ http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00062.html
+ for the reason.
+
+2012-03-07 Michael Albinus <michael.albinus@gmx.de>
+
+ Avoid superfluous registering of signals. (Bug#10807)
+
+ * notifications.el (notifications-on-action-object)
+ (notifications-on-close-object): New defvars.
+ (notifications-on-action-signal, notifications-on-closed-signal):
+ Unregister the signal if not needed any longer.
+ (notifications-notify): Register `notifications-action-signal' or
+ `notifications-closed-signal', if :on-action or :on-close has been
+ passed as argument.
+
+2012-03-07 Chong Yidong <cyd@gnu.org>
+
+ * cus-start.el: Avoid x-select-enable-clipboard-manager warning on
+ non-X platforms.
+
+2012-03-06 Glenn Morris <rgm@gnu.org>
+
+ * term/pc-win.el (x-selection-owner-p, x-own-selection-internal)
+ (x-disown-selection-internal, x-get-selection-internal):
+ Doc fix (add arglist signatures). (Bug#10783)
+
+2012-03-06 Kaushik Srenevasan <ksrenevasan@gmail.com> (tiny change)
+
+ * progmodes/gdb-mi.el (gdb-breakpoints-list-handler-custom):
+ Handle breakpoints with no "type".
+
+2012-03-06 Glenn Morris <rgm@gnu.org>
+
+ * files.el (locate-dominating-file): Add optional predicate argument.
+ (dir-locals-find-file): Make use of above change.
+
+2012-03-06 Thien-Thi Nguyen <ttn@gnuvola.org>
+
+ * info.el (Info-insert-dir): Also try "dir.gz".
+
+2012-03-06 Glenn Morris <rgm@gnu.org>
+
+ * files.el (dir-locals-find-file):
+ Ignore non-readable or non-regular files. (Bug#10928)
+
+ * files.el (locate-dominating-file): Doc fix.
+
+2012-03-06 Adam Spiers <emacs@adamspiers.org> (tiny change)
+
+ * calendar/calendar.el (calendar-set-mode-line):
+ `getenv' returns a string. (Bug#10951)
+
+2012-03-05 Leo Liu <sdl.web@gmail.com>
+
+ * simple.el (backward-delete-char-untabify): Constrain point to
+ field (Bug#10939).
+
+ * eshell/em-cmpl.el (eshell-cmpl-initialize): Fix shift-tab key.
+
+2012-03-05 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (count-words): If called from Lisp, return the word
+ count, for symmetry with `count-lines'. Arglist changed.
+ (count-words--message): Args changed. Consolidate counting code
+ from count-words and count-words-region.
+ (count-words-region): Caller changed.
+ (count-lines-region): Make it an obsolete alias.
+
+2012-03-04 Tassilo Horn <tassilo@member.fsf.org>
+
+ * saveplace.el (save-place-to-alist)
+ (save-place-ignore-files-regexp): Allow value nil to disable this
+ feature.
+
+2012-03-04 Chong Yidong <cyd@gnu.org>
+
+ * faces.el (face-spec-reset-face): For the default face, reset the
+ attributes to default values (Bug#10748).
+
+2012-03-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/emacsbug.el (report-emacs-bug-hook): Fix up thinko in
+ previous patch: Check `message-send-mail-function', and not the
+ default function (bug#10897).
+
+2012-03-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * notifications.el (notifications-on-action-signal)
+ (notifications-on-closed-signal): Check for unique service name of
+ incoming event. Fix error in removing entry.
+ (top): Register for signals with wildcard service name.
+ (notifications-notify): Use daemon unique service name for map entries.
+
+2012-03-04 Chong Yidong <cyd@gnu.org>
+
+ * cus-start.el: Make x-select-enable-clipboard-manager customizable.
+
+2012-03-04 Glenn Morris <rgm@gnu.org>
+
+ * abbrev.el (copy-abbrev-table, abbrev-table-p)
+ (abbrev-minor-mode-table-alist, define-abbrev, abbrev-insert)
+ (expand-abbrev, define-abbrev-table): Doc fixes.
+
+2012-03-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/emacsbug.el (report-emacs-bug-hook): Look at the value of
+ `message-default-send-mail-function' and not `send-mail-function'
+ when doing the prompting for `sendmail-query-once' before sending
+ in Message buffers (bug#10897).
+
+ * net/tls.el (open-tls-stream): Don't set the dont-query-on-exit flag.
+ This is inconsistent with all the other stream functions, which leave
+ the setting up to the higher levels (if so wanted) (bug#10931).
+
+2012-03-02 Alan Mackenzie <acm@muc.de>
+
+ Depessimize the handling of very large macros.
+
+ * progmodes/cc-engine.el (c-macro-cache, c-macro-cache-start-pos):
+ (c-macro-cache-syntactic): New variables to implement a one
+ element macro cache.
+ (c-invalidate-macro-cache): New function.
+ (c-beginning-of-macro, c-end-of-macro, c-syntactic-end-of-macro):
+ Adapt to use the new cache.
+ (c-state-safe-place): Use better the cache of safe positions.
+ (c-state-semi-nonlit-pos-cache)
+ (c-state-semi-nonlit-pos-cache-limit):
+ New variables for...
+ (c-state-semi-safe-place): New function. Here, in a macro is "safe".
+ (c-invalidate-state-cache-1): New stuff for c-state-semi-safe-place.
+ (c-in-literal, c-literal-limits, c-determine-limit-get-base):
+ Use c-state-semi-safe-place.
+
+ * progmodes/cc-langs.el (c-get-state-before-change-functions):
+ Add c-invalidate-macro-cache to the C, C++, Obj entries.
+
+2012-03-02 Michael Albinus <michael.albinus@gmx.de>
+
+ * jka-compr.el (jka-compr-call-process):
+ Apply `file-accessible-directory-p' only when the default directory is
+ not remote.
+
+2012-03-01 Michael Albinus <michael.albinus@gmx.de>
+
+ * files.el (file-equal-p): Fix docstring. Avoid unnecessary
+ access of FILE2, if FILE1 does not exist.
+
+ * net/tramp-sh.el (tramp-remote-process-environment): Add "PAGER=\"\"".
+ Reported by Robert Lupton the Good <rhl@astro.princeton.edu>.
+
+ * vc/vc-git.el (vc-git--call): Enable `inhibit-null-byte-detection'.
+ Add "PAGER=" to `process-environment'.
+
+2012-03-01 Michael R. Mauger <mmaug@yahoo.com>
+
+ * progmodes/sql.el: Bug fix
+ (sql-get-login-ext): Save login values in globals.
+ (sql-get-login): Use new version of `sql-get-login-ext'.
+ (sql-interactive-mode): Set global `sql-connection' to nil.
+ (sql-connect): Set global values for connection.
+ (sql-product-interactive): Save global values as buffer local.
+
+2012-02-29 Leo Liu <sdl.web@gmail.com>
+
+ * abbrev.el (define-abbrevs): Reset sys to nil.
+
+2012-02-28 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * files.el (file-equal-p): Rename from `files-equal-p'.
+ Return nil when one or both files don't exist.
+ (file-subdir-of-p): Now only top directory must exists,
+ return nil if it doesn't.
+ (copy-directory): No need to test with `file-subdir-of-p' after
+ creating dir.
+ * net/tramp.el (tramp-file-name-for-operation): Rename `files-equal-p'
+ to `file-equal-p'.
+
+2012-02-28 Glenn Morris <rgm@gnu.org>
+
+ * shell.el (shell-mode):
+ * progmodes/vhdl-mode.el (wildcard-to-regexp, file-expand-wildcards):
+ * play/landmark.el (landmark-font-lock-face-O):
+ * play/handwrite.el (handwrite):
+ * play/gomoku.el (gomoku-O):
+ * net/browse-url.el (browse-url-browser-display):
+ * international/mule.el (define-charset):
+ * htmlfontify.el (hfy-etags-cmd, hfy-face-attr-for-class):
+ * filesets.el (filesets-find-file-delay):
+ * eshell/em-xtra.el (eshell-xtra):
+ * eshell/em-unix.el (eshell-grep):
+ * emulation/viper.el (viper-mode):
+ * emacs-lisp/regexp-opt.el (regexp-opt-group):
+ * emacs-lisp/easymenu.el (easy-menu-define):
+ * calendar/timeclock.el (timeclock-use-display-time):
+ * bs.el (bs-mode):
+ * bookmark.el (bookmark-save-flag):
+ Doc fix (standardize possessive apostrophe usage).
+
+2012-02-27 Chong Yidong <cyd@gnu.org>
+
+ * emulation/viper-cmd.el (viper-intercept-ESC-key):
+ Fix key-binding lookup for ESC key (Bug#9146).
+
+ * font-lock.el (font-lock-specified-p): Rename from
+ font-lock-spec-present. Callers changed.
+
+2012-02-27 Daniel Hackney <dan@haxney.org>
+
+ * emacs-lisp/package.el (package-compute-transaction):
+ Handle holding a package version to t in package-load-list.
+
+2012-02-26 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-inodes, tramp-devices): Initialize with 0.
+ (tramp-get-inode, tramp-get-device): Use cached values.
+
+2012-02-26 Alan Mackenzie <acm@muc.de>
+
+ Check there is a font-lock specification before doing initial
+ fontification.
+
+ * font-core.el (font-lock-mode): Move the conditional from
+ :after-hook to font-lock-initial-fontify.
+ (font-lock-default-function): Move the check for a specification
+ to font-lock-spec-present.
+
+ * font-lock.el (font-lock-initial-fontify): Call ...
+ (font-lock-spec-present): New function.
+
+2012-02-26 Jim Blandy <jimb@red-bean.com>
+
+ * progmodes/gdb-mi.el (gdb-mi-quote): New function.
+ (gdb-send): Apply it to the operand of the '-interpreter-exec
+ console' command, so that we can pass arguments with (say) quotes
+ in them. Store exact string sent in gdb-debug-log (Bug#10765).
+
+2012-02-26 Chong Yidong <cyd@gnu.org>
+
+ * help-fns.el (describe-function-1): Clarify description of
+ remapping (Bug#10844).
+
+ * files.el (files-equal-p): Doc fix.
+ (file-subdir-of-p): Doc fix. Convert loop macro to plain Lisp,
+ and quit the loop once a mismatch is found.
+
+2012-02-25 Juanma Barranquero <lekktu@gmail.com>
+
+ * bs.el (bs--show-with-configuration): Don't throw an error
+ if the window cannot be split; otherwise, subsequent calls to
+ bs-show fail, restoring a stale window config. (Bug#10882)
+
+2012-02-25 Jan Djärv <jan.h.d@swipnet.se>
+
+ * term/ns-win.el (global-map): Bind ns-drag-file to
+ ns-find-file (Bug#5855, Bug#10050).
+
+2012-02-25 Andreas Schwab <schwab@linux-m68k.org>
+
+ * calendar/parse-time.el (parse-time-string): Allow extractor to
+ return nil.
+
+2012-02-25 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-file-name-for-operation):
+ Add `files-equal-p' and `file-subdir-of-p'.
+
+ * net/tramp-sh.el (tramp-sh-handle-copy-directory):
+ * net/tramp-smb.el (tramp-smb-handle-copy-directory):
+ Add COPY-CONTENTS argument.
+
+2012-02-25 Chong Yidong <cyd@gnu.org>
+
+ Add custom groups for VC backends, for consistency with vc-bzr.
+
+ * vc/vc-arch.el (vc-arch):
+ * vc/vc-cvs.el (vc-cvs):
+ * vc/vc-git.el (vc-git):
+ * vc/vc-hg.el (vc-hg):
+ * vc/vc-mtn.el (vc-mtn):
+ * vc/vc-rcs.el (vc-rcs):
+ * vc/vc-sccs.el (vc-sccs):
+ * vc/vc-svn.el (vc-svn): New customization group (Bug#10871).
+ All relevant defcustoms reassigned.
+
+2012-02-25 Chong Yidong <cyd@gnu.org>
+
+ * newcomment.el (comment-styles): Add autoload (Bug#10868).
+
+ * term/x-win.el (x-initialize-window-system): Reduce default for
+ x-selection-timeout to 5 seconds (Bug#8869).
+
+2012-02-24 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * files.el (files-equal-p, file-subdir-of-p): New functions.
+ (copy-directory): Error when trying to copy a directory on itself.
+ Add missing copy-contents arg to tramp handler.
+ * dired-aux.el (dired-copy-file-recursive): Same.
+ (dired-create-files): Modify destination when source is equal to
+ dest when copying files.
+ Return also when dest is a subdir of source. (Bug#10489)
+
+2012-02-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/ange-ftp.el (ange-ftp-parse-netrc): Suppress comment lines.
+ (Bug#10874)
+
+2012-02-23 Alan Mackenzie <acm@muc.de>
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Add extra
+ parameter "after-hook:" to allow the expansion to run code after
+ the execution of the mode hooks.
+
+ * font-lock.el (font-lock-initial-fontify): New function extracted
+ from font-lock-mode-internal.
+
+ * font-core.el (font-lock-mode): Call font-lock-initial-fontify in
+ :after-hook.
+
+2012-02-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el: Make sure cycling is reset upon edit with icomplete.el.
+ (completion--cache-all-sorted-completions): New function.
+ (completion-all-sorted-completions): Use it.
+ (completion--do-completion, minibuffer-force-complete):
+ Use it to re-instate the flush hook.
+
+ * icomplete.el (icomplete-completions): Replace last fix with a better
+ one (bug#10850).
+
+2012-02-23 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/lisp.el (beginning-of-defun-raw): Don't call end-of-defun
+ when it might call us back infinitely (bug#10797).
+
+2012-02-23 Glenn Morris <rgm@gnu.org>
+
+ * minibuffer.el (completion-category-overrides): Doc fix.
+
+2012-02-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-table-with-context): Fix inf-loop.
+ Reported by Aaron S. Hawley <aaron.s.hawley@gmail.com>.
+
+2012-02-23 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-aliases, authors-fixed-case)
+ (authors-obsolete-files-regexps, authors-ignored-files)
+ (authors-ambiguous-files, authors-renamed-files-alist):
+ Add more entries.
+
+2012-02-23 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-occur): Sync interactive spec with occur's
+ new feature in `occur-read-primary-args'. Doc fix. (Bug#10705)
+
+ * replace.el (occur-menu-map): Add menu item for `occur-edit-mode'.
+
+2012-02-22 Juri Linkov <juri@jurta.org>
+
+ * international/mule-cmds.el (read-char-by-name): Use \` and \'.
+ (ucs-insert): Doc fix. Check for hex digits in the string.
+ Don't display `nil' in the error message. (Bug#10857)
+
+2012-02-22 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-mode.el: Revert change #2012-02-06T22:08:41Z!larsi@gnus.org from 2012-02-06.
+
+2012-02-22 Glenn Morris <rgm@gnu.org>
+
+ * ffap.el (ffap-c-path):
+ * man.el (Man-header-file-path): Handle multiarch. (Bug#10702)
+
+2012-02-22 Chong Yidong <cyd@gnu.org>
+
+ * custom.el (load-theme): Doc fix.
+
+2012-02-22 Glenn Morris <rgm@gnu.org>
+
+ * dired-x.el (dired-guess-shell-alist-default):
+ Remove escape sequences from nroff output. (Bug#172)
+
+2012-02-21 Glenn Morris <rgm@gnu.org>
+
+ * vc/emerge.el (emerge-defvar-local):
+ Set `permanent-local' property rather than unused `preserved'.
+
+ * textmodes/picture.el (picture-delete-char): New alias.
+ (picture-mode-map): Use it. (Bug#10860)
+ (picture-mode): Doc fix.
+
+2012-02-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * newcomment.el (uncomment-region-default): Remove unused binding.
+
+2012-02-21 Glenn Morris <rgm@gnu.org>
+
+ * textmodes/picture.el (picture-motion, picture-motion-reverse)
+ (picture-self-insert, picture-tab-chars): Doc fix.
+ (picture-mode-map): Fix C-a, C-e.
+
+2012-02-20 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-aliases): Add another entry.
+
+2012-02-20 Leo Liu <sdl.web@gmail.com>
+
+ * icomplete.el (icomplete-completions): Check FROM arg before
+ passing to substring (Bug#10850).
+
+2012-02-19 Chong Yidong <cyd@gnu.org>
+
+ * comint.el: Require ansi-color.
+ (comint-output-filter-functions): Add ansi-color-process-output.
+
+ * ansi-color.el: Don't set comint-output-filter-functions; it is
+ now in the initial value defined in comint.el.
+ (ansi-color-apply-face-function): New variable.
+ (ansi-color-apply-on-region): Use it.
+ (ansi-color-apply-overlay-face): New function.
+
+ * shell.el (shell): No need to require ansi-color.
+ (shell-mode): Use ansi-color-apply-face-function to highlight
+ color escapes using font-lock-face property (Bug#10835).
+
+2012-02-19 Chong Yidong <cyd@gnu.org>
+
+ * vc/ediff-init.el (ediff-strip-mode-line-format): Handle non-list
+ mode-line formats (Bug#10839).
+
+2012-02-18 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmail.el (rmail-dont-reply-to-names): Mark as obsolete.
+
+ * mail/undigest.el (unforward-rmail-message): Doc fix.
+
+ * saveplace.el (save-place-ignore-files-regexp): Add :version.
+
+2012-02-18 Eli Zaretskii <eliz@gnu.org>
+
+ * international/characters.el (script-list): Sync with the latest
+ Unicode Character Database.
+
+2012-02-18 Andreas Schwab <schwab@linux-m68k.org>
+
+ * international/titdic-cnv.el: Remove duplicate coding tag.
+ * language/cham.el: Likewise.
+ * language/tai-viet.el: Likewise.
+
+2012-02-18 Glenn Morris <rgm@gnu.org>
+
+ * calendar/cal-menu.el (cal-menu-diary-menu, cal-menu-goto-menu):
+ * calendar/calendar.el (diary-file, diary-bahai-entry-symbol)
+ (calendar-bahai-all-holidays-flag, calendar-other-dates):
+ * calendar/diary-lib.el (diary-abbreviated-year-flag):
+ * calendar/holidays.el (holiday-bahai-holidays)
+ (calendar-holidays, list-holidays):
+ Use utf-8 Bahá'í in doc-strings, menus, etc.
+
+2012-02-17 Tassilo Horn <tassilo@member.fsf.org>
+
+ * saveplace.el (save-place-ignore-files-regexp): New variable
+ allowing for excluding files from saving their location of point.
+ The default value matches the temporary commit message editing
+ files from Git, SVN, Bazaar, and Mercurial.
+ (save-place-to-alist): Use it.
+
+2012-02-17 Lawrence Mitchell <wence@gmx.li>
+ Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * newcomment.el (uncomment-region-default): Don't leave extra space
+ when an arg is provided (bug#8150).
+
+2012-02-17 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/gnutls.el (gnutls-trustfiles): Fix Cygwin bundle location.
+
+2012-02-17 Glenn Morris <rgm@gnu.org>
+
+ * net/socks.el: Require network-stream. (Bug#10599)
+
+2012-02-17 Kenichi Handa <handa@m17n.org>
+
+ * international/charprop.el:
+ * international/uni-name.el:
+ * international/uni-old-name.el:
+ * international/uni-comment.el: Regenerate.
+
+2012-02-16 Glenn Morris <rgm@gnu.org>
+
+ * calendar/cal-hebrew.el (calendar-hebrew-list-yahrzeits):
+ Interactively in calendar buffer, give an error if not on a date.
+
+2012-02-15 Glenn Morris <rgm@gnu.org>
+
+ * shell.el (shell-delimiter-argument-list):
+ Revert 2011-02-17 change. (Bug#8027)
+
+2012-02-15 Chong Yidong <cyd@gnu.org>
+
+ * minibuffer.el (completion-at-point-functions): Doc fix.
+
+ * custom.el (defcustom): Doc fix; note use of defvar.
+
+2012-02-15 Glenn Morris <rgm@gnu.org>
+
+ * mail/smtpmail.el (smtpmail-smtp-user, smtpmail-stream-type):
+ Doc fixes.
+
+2012-02-14 Glenn Morris <rgm@gnu.org>
+
+ * mail/smtpmail.el (smtpmail-query-smtp-server): Give it a doc.
+
+2012-02-14 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mail/smtpmail.el (smtpmail-query-smtp-server): Fix typo in the
+ way the ports list is computed.
+ (smtpmail-query-smtp-server): Prompt the user for a port number if
+ we can't connect to any of the standard ports (bug#10810).
+
+2012-02-14 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/gnutls.el (gnutls-trustfiles): Add Cygwin location.
+
+2012-02-13 Glenn Morris <rgm@gnu.org>
+
+ * minibuffer.el (read-file-name): Doc fix. (Bug#10798)
+
+2012-02-13 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/gnutls.el (gnutls-trustfiles): New variable.
+ (gnutls-negotiate): Use it.
+
+2012-02-13 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * simple.el (mail-user-agent): Mention that `gnus-user-agent' only
+ does its stuff if Gnus is running.
+
+2012-02-13 Alan Mackenzie <acm@muc.de>
+
+ Fix a loop in c-set-fl-decl-start.
+
+ * progmodes/cc-engine.el (c-set-fl-decl-start): Add a check that
+ c-backward-syntactic-ws actually moves backwards.
+
+2012-02-13 Leo Liu <sdl.web@gmail.com>
+
+ * net/rcirc.el (rcirc-markup-attributes): Move point to the
+ beginning so that all \C-o chars are removed.
+
+2012-02-12 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/gnutls.el (gnutls-algorithm-priority): Add missing :group tag.
+
+2012-02-12 Alan Mackenzie <acm@muc.de>
+
+ Fix infinite loop with long macros.
+ * progmodes/cc-engine.el (c-state-safe-place): Handle macros properly.
+
+2012-02-12 Chong Yidong <cyd@gnu.org>
+
+ * window.el (display-buffer): Doc fix (Bug#10785).
+
+2012-02-12 Glenn Morris <rgm@gnu.org>
+
+ * term/pc-win.el (x-selection-owner-p, x-own-selection-internal)
+ (x-disown-selection-internal, x-get-selection-internal):
+ Sync docs with the xselect.c versions.
+
+ * allout-widgets.el: Add missing license notice.
+
+2012-02-11 Glenn Morris <rgm@gnu.org>
+
+ * select.el (x-get-selection-internal, x-own-selection-internal)
+ (x-disown-selection-internal):
+ * x-dnd.el (x-get-selection-internal): Update declarations.
+
+ * vc/log-view.el (vc-diff-internal): Remove unneeded declaration.
+
+ * window.el (window-sides-slots):
+ * tool-bar.el (tool-bar-position):
+ * term/xterm.el (xterm-extra-capabilities):
+ * ses.el (ses-self-reference-early-detection):
+ * progmodes/verilog-mode.el (verilog-auto-declare-nettype)
+ (verilog-auto-wire-type)
+ (verilog-auto-delete-trailing-whitespace)
+ (verilog-auto-reset-blocking-in-non, verilog-auto-inst-sort)
+ (verilog-auto-tieoff-declaration):
+ * progmodes/sql.el (sql-login-hook, sql-ansi-statement-starters)
+ (sql-oracle-statement-starters, sql-oracle-scan-on):
+ * progmodes/prolog.el (prolog-align-comments-flag)
+ (prolog-indent-mline-comments-flag, prolog-object-end-to-0-flag)
+ (prolog-left-indent-regexp, prolog-paren-indent-p)
+ (prolog-paren-indent, prolog-parse-mode, prolog-keywords)
+ (prolog-types, prolog-mode-specificators)
+ (prolog-determinism-specificators, prolog-directives)
+ (prolog-electric-newline-flag, prolog-hungry-delete-key-flag)
+ (prolog-electric-dot-flag)
+ (prolog-electric-dot-full-predicate-template)
+ (prolog-electric-underscore-flag, prolog-electric-tab-flag)
+ (prolog-electric-if-then-else-flag, prolog-electric-colon-flag)
+ (prolog-electric-dash-flag, prolog-old-sicstus-keys-flag)
+ (prolog-program-switches, prolog-prompt-regexp)
+ (prolog-debug-on-string, prolog-debug-off-string)
+ (prolog-trace-on-string, prolog-trace-off-string)
+ (prolog-zip-on-string, prolog-zip-off-string)
+ (prolog-use-standard-consult-compile-method-flag)
+ (prolog-use-prolog-tokenizer-flag, prolog-imenu-flag)
+ (prolog-imenu-max-lines, prolog-info-predicate-index)
+ (prolog-underscore-wordchar-flag, prolog-use-sicstus-sd)
+ (prolog-char-quote-workaround):
+ * progmodes/cc-vars.el (c-defun-tactic):
+ * net/tramp.el (tramp-encoding-command-interactive)
+ (tramp-local-end-of-line):
+ * net/soap-client.el (soap-client):
+ * net/netrc.el (netrc-file):
+ * net/gnutls.el (gnutls):
+ * minibuffer.el (completion-category-overrides)
+ (completion-cycle-threshold)
+ (completion-pcm-complete-word-inserts-delimiters):
+ * man.el (Man-name-local-regexp):
+ * mail/feedmail.el (feedmail-display-full-frame):
+ * international/characters.el (glyphless-char-display-control):
+ * eshell/em-ls.el (eshell-ls-date-format):
+ * emacs-lisp/cl-indent.el (lisp-lambda-list-keyword-alignment)
+ (lisp-lambda-list-keyword-parameter-indentation)
+ (lisp-lambda-list-keyword-parameter-alignment):
+ * doc-view.el (doc-view-image-width, doc-view-unoconv-program):
+ * dired-x.el (dired-omit-verbose):
+ * cus-theme.el (custom-theme-allow-multiple-selections):
+ * calc/calc.el (calc-highlight-selections-with-faces)
+ (calc-lu-field-reference, calc-lu-power-reference)
+ (calc-note-threshold):
+ * battery.el (battery-mode-line-limit):
+ * arc-mode.el (archive-7z-extract, archive-7z-expunge)
+ (archive-7z-update):
+ * allout.el (allout-prefixed-keybindings)
+ (allout-unprefixed-keybindings)
+ (allout-inhibit-auto-fill-on-headline)
+ (allout-flattened-numbering-abbreviation):
+ * allout-widgets.el (allout-widgets-auto-activation)
+ (allout-widgets-icons-dark-subdir)
+ (allout-widgets-icons-light-subdir, allout-widgets-icon-types)
+ (allout-widgets-theme-dark-background)
+ (allout-widgets-theme-light-background)
+ (allout-widgets-item-image-properties-emacs)
+ (allout-widgets-item-image-properties-xemacs)
+ (allout-widgets-run-unit-tests-on-load)
+ (allout-widgets-time-decoration-activity)
+ (allout-widgets-hook-error-post-time)
+ (allout-widgets-track-decoration):
+ Add missing :version tags to new defcustoms and defgroups.
+
+ * progmodes/sql.el (sql-ansi-statement-starters)
+ (sql-oracle-statement-starters): Add custom type.
+
+ * progmodes/prolog.el: Remove leading '*' from defcustom docs.
+ (prolog-system-version): Give it a type.
+
+2012-02-11 Eli Zaretskii <eliz@gnu.org>
+
+ * term/pc-win.el (x-select-text, x-selection-owner-p)
+ (x-own-selection-internal, x-disown-selection-internal)
+ (x-get-selection-internal): Sync doc strings and argument lists
+ with xselect.c, common-win.el and x-win.el. (Bug#10783)
+
+2012-02-11 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/python.el (python-end-of-statement): Fix infinite
+ loop. (Bug#10788)
+
+2012-02-10 Glenn Morris <rgm@gnu.org>
+
+ * international/mule-cmds.el (unify-8859-on-encoding-mode)
+ (unify-8859-on-decoding-mode): Properly mark as obsolete.
+
+2012-02-10 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mail/emacsbug.el (report-emacs-bug-hook): Query the user first
+ about SMTP before checking the From header.
+
+ * mail/sendmail.el (sendmail-query-user-about-smtp): Refactor out
+ into own function for reuse by emacsbug.el.
+
+2012-02-10 Leo Liu <sdl.web@gmail.com>
+
+ * subr.el (condition-case-unless-debug): Rename from
+ condition-case-no-debug. All callers changed.
+ (with-demoted-errors): Fix caller.
+
+ * vc/diff-mode.el (diff-auto-refine-mode, diff-hunk):
+ * nxml/rng-valid.el (rng-do-some-validation):
+ * emacs-lisp/package.el (package-refresh-contents)
+ (package-menu-execute):
+ * desktop.el (desktop-create-buffer):
+ * font-lock.el (lisp-font-lock-keywords-2): Caller changed.
+
+2012-02-10 Glenn Morris <rgm@gnu.org>
+
+ * textmodes/bibtex.el:
+ Add missing :version tags for new/changed defcustoms.
+
+ * files.el (remote-file-name-inhibit-cache): Doc fixes.
+
+2012-02-09 Lars Ingebrigtsen <larsi@rusty>
+
+ * mail/smtpmail.el (smtpmail-user-mail-address): New function.
+ (smtpmail-via-smtp): Use it, or fall back on the From address.
+ (smtpmail-send-it): Ditto.
+
+2012-02-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (byte-compile-file-form-defvar):
+ Don't fallback on byte-compile-defvar. Optimize (defvar foo) away.
+ (byte-compile-tmp-var): New const.
+ (byte-compile-defvar): Use it to minimize .elc size.
+ Just use `defvar' rather than simulate it (bug#10761).
+
+2012-02-09 Glenn Morris <rgm@gnu.org>
+
+ * files.el (rename-uniquely): Doc fix. (Bug#3806)
+
+ * progmodes/cc-guess.el (c-guess-offset-threshold, c-guess-region-max):
+ Add :version tags.
+
+ * progmodes/compile.el (compilation-error-screen-columns)
+ (compilation-first-column, compilation-filter-start): Doc fixes.
+
+ * vc/log-view.el (log-view-toggle-entry-display):
+ * vc/vc.el (vc-merge, vc-pull): Doc fixes.
+
+ * mail/emacsbug.el (report-emacs-bug-can-use-osx-open)
+ (report-emacs-bug-can-use-xdg-email):
+ (report-emacs-bug-insert-to-mailer): Doc fixes.
+ (report-emacs-bug): Message fix.
+
+ * net/browse-url.el (browse-url-can-use-xdg-open)
+ (browse-url-xdg-open): Doc fixes.
+
+ * electric.el (electric-indent-mode, electric-pair-mode)
+ (electric-layout-rules, electric-layout-mode): Doc fixes.
+ (electric-pair-pairs, electric-pair-skip-self): Add :version tags.
+
+2012-02-08 Martin Rudalics <rudalics@gmx.at>
+
+ * server.el (server-unselect-display): Don't inadvertently kill
+ the current buffer. (Bug#10729)
+
+2012-02-08 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/sql.el (sql-port, sql-connection-alist, sql-list-all)
+ (sql-list-table): Doc fixes.
+
+ * image-mode.el (image-transform-minor-mode-map, image-transform-mode):
+ Comment out (does nothing).
+
+ * completion.el (dynamic-completion-mode):
+ * dirtrack.el (dirtrack-debug-mode):
+ * electric.el (electric-layout-mode):
+ * epa-mail.el (epa-mail-mode, epa-global-mail-mode):
+ * face-remap.el (text-scale-mode, buffer-face-mode):
+ * iimage.el (iimage-mode):
+ * image-mode.el (image-transform-mode):
+ * minibuffer.el (completion-in-region-mode):
+ * scroll-lock.el (scroll-lock-mode):
+ * simple.el (next-error-follow-minor-mode):
+ * tar-mode.el (tar-subfile-mode):
+ * tooltip.el (tooltip-mode):
+ * vcursor.el (vcursor-use-vcursor-map):
+ * wid-browse.el (widget-minor-mode):
+ * emulation/tpu-edt.el (tpu-edt-mode):
+ * emulation/tpu-extras.el (tpu-cursor-free-mode):
+ * international/iso-ascii.el (iso-ascii-mode):
+ * language/thai-util.el (thai-word-mode):
+ * mail/supercite.el (sc-minor-mode):
+ * net/goto-addr.el (goto-address-mode):
+ * net/rcirc.el (rcirc-multiline-minor-mode, rcirc-track-minor-mode):
+ * progmodes/cwarn.el (cwarn-mode):
+ * progmodes/flymake.el (flymake-mode):
+ * progmodes/glasses.el (glasses-mode):
+ * progmodes/hideshow.el (hs-minor-mode):
+ * progmodes/pascal.el (pascal-outline-mode):
+ * textmodes/enriched.el (enriched-mode):
+ * vc/smerge-mode.el (smerge-mode):
+ Doc fixes (minor mode argument).
+
+2012-02-07 Eli Zaretskii <eliz@gnu.org>
+
+ * ls-lisp.el (ls-lisp-sanitize): New function.
+ (ls-lisp-insert-directory): Use it to fix or remove any elements
+ in file-alist with missing attributes. (Bug#4673)
+
+2012-02-07 Alan Mackenzie <acm@muc.de>
+
+ Fix spurious recognition of c-in-knr-argdecl.
+
+ * progmodes/cc-engine.el (c-in-knr-argdecl): Check for '=' in a
+ putative K&R region.
+
+2012-02-07 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-engine.el (c-forward-objc-directive):
+ Prevent looping in "#pragma mark @implementation".
+
+2012-02-07 Michael Albinus <michael.albinus@gmx.de>
+
+ * notifications.el (notifications-on-closed-signal): Make `reason'
+ optional. (Bug#10744)
+
+2012-02-07 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode):
+ Doc fixes for the macro and the mode it defines.
+
+ * image.el (imagemagick-types-inhibit): Doc fix.
+
+ * cus-start.el (imagemagick-render-type): Add it.
+
+2012-02-06 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * progmodes/cc-mode.el (c-standard-font-lock-fontify-region-function):
+ Set the default at load time, too, so that `font-lock-fontify-buffer'
+ can be called without setting up the entire mode first. This fixes
+ a bug in `mm-inline-text' with C MIME parts.
+
+2012-02-06 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (list-processes--refresh): Delete exited processes
+ (Bug#8094).
+
+ * comint.el (comint-next-prompt): next-single-char-property-change
+ and prev-single-char-property-change never return nil (Bug#8657).
+
+ * custom.el (defcustom): Doc fix (Bug#9711).
+
+2012-02-05 Chong Yidong <cyd@gnu.org>
+
+ * cus-edit.el (custom-variable-reset-backup): Quote the value
+ before storing it in the customized-value property (Bug#6712).
+ (custom-display): Add a customization type tag.
+ (custom-buffer-create-internal): Improve tooltip message.
+
+ * wid-edit.el (widget-field-value-get): New optional arg to
+ suppress trailing whitespace truncation.
+ (character): Use it (Bug#2689).
+
+2012-02-05 Andreas Schwab <schwab@linux-m68k.org>
+
+ * progmodes/gud.el (gud-pv): Use pv instead of pv1.
+ * progmodes/gdb-mi.el (gud-pp): Use pp instead of pp1.
+
+2012-02-05 Chong Yidong <cyd@gnu.org>
+
+ * cus-edit.el (custom-variable-value-create): For mismatched
+ types, show the current value (Bug#7600).
+
+ * custom.el (defcustom): Doc fix.
+
+2012-02-05 Glenn Morris <rgm@gnu.org>
+
+ * font-lock.el (lisp-font-lock-keywords-2): Add with-wrapper-hook.
+
+2012-02-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp/pp.el (pp-to-string): Use `with-temp-buffer'.
+ (pp-buffer): Use `ignore-errors', `looking-at-p'.
+ (pp-last-sexp): Use `looking-at-p'.
+
+2012-02-04 Glenn Morris <rgm@gnu.org>
+
+ * files.el (revert-buffer):
+ Doc fix (mention revert-buffer-in-progress-p).
+
+ * emacs-lisp/ert-x.el (ert-simulate-command):
+ Check deferred-action-list (which is obsolete) is bound.
+
+ * subr.el (with-wrapper-hook): Doc fixes.
+
+ * simple.el (filter-buffer-substring-functions)
+ (buffer-substring-filters, filter-buffer-substring): Doc fixes.
+
+2012-02-04 Lars Ljung <lars@matholka.se> (tiny change)
+
+ * eshell/esh-ext.el (eshell-windows-shell-file): Match "cmdproxy"
+ anywhere in shell-file-name, not just at the beginning. (Bug#10523)
+
+2012-02-04 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/smie.el: Fix dead link (Bug#10711).
+
+2012-02-04 Glenn Morris <rgm@gnu.org>
+
+ * image.el (image-extension-data): Add obsolete alias.
+
+ * isearch.el (isearch-update): Doc fix.
+
+ * facemenu.el (list-colors-display): Doc fix (minor rephrasing).
+
+ * ido.el (ido-find-file): Doc fix (ido-toggle-vc not on any key).
+
+2012-02-03 Glenn Morris <rgm@gnu.org>
+
+ * image.el (image-animated-p): Doc fix. Use image-animated-types.
+ (image-animate-timeout): Doc fix.
+
+ * image-mode.el (image-animate-loop, image-toggle-animation): Doc fixes.
+
+2012-02-02 Glenn Morris <rgm@gnu.org>
+
+ * server.el (server-auth-dir): Doc fix.
+ (server-eval-at): Doc fix. Give an explicit error if !server-use-tcp.
+
+ * subr.el (run-mode-hooks): Doc fix.
+
+2012-02-02 Juri Linkov <juri@jurta.org>
+
+ * image-mode.el (image-toggle-display-image): Remove tautological
+ `major-mode' from the `derived-mode-p' test.
+
+2012-02-02 Kenichi Handa <handa@m17n.org>
+
+ * composite.el (compose-region): Cancel previous change.
+
+2012-02-02 Kenichi Handa <handa@m17n.org>
+
+ * composite.el (compose-region, compose-string): Signal error for
+ a null string component (Bug#6988).
+
+2012-02-01 Chong Yidong <cyd@gnu.org>
+
+ * view.el (view-buffer-other-window, view-buffer-other-frame):
+ Handle special modes like view-buffer (Bug#10650).
+ (view-buffer): Simplify.
+
+ * frame.el (set-frame-font): Tweak meaning of third argument.
+
+ * dynamic-setting.el (font-setting-change-default-font):
+ Use set-frame-font (Bug#9982).
+
+2012-02-01 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/compile.el (compilation-internal-error-properties):
+ Respect compilation-first-column in the "*compilation*" buffer.
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode):
+ Relax :variable's test for a named function.
+
+2012-01-31 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-engine.el (c-guess-basic-syntax): CASE 5B.1: Fix an
+ off by one error.
+
+2012-01-31 Chong Yidong <cyd@gnu.org>
+
+ * frame.el (set-frame-font): New arg ALL-FRAMES.
+
+ * menu-bar.el (menu-set-font): Use set-frame-font.
+
+ * faces.el (face-spec-reset-face): Don't apply unspecified
+ attribute values to the default face.
+
+2012-01-31 Juanma Barranquero <lekktu@gmail.com>
+
+ * progmodes/cwarn.el (cwarn): Remove dead link.
+ (cwarn-configuration, cwarn-verbose, cwarn-mode-text, cwarn-load-hook):
+ Remove * from defcustom docstrings.
+ (turn-on-cwarn-mode): Make obsolete.
+ (c-at-toplevel-p): Remove compatibility code for Emacs 20.3 and older.
+ (turn-on-cwarn-mode-if-enabled): Call `cwarn-mode'.
+
+2012-01-31 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Doc fix.
+ Fix :variable handling of mode a symbol not equal to modefun.
+ Allow named functions to be used as the cdr of :variable.
+
+2012-01-30 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-fixed-entries):
+ Remove reference to deleted file rnewspost.el.
+
+2012-01-29 Juanma Barranquero <lekktu@gmail.com>
+
+ * window.el (window-with-parameter): Remove unused variable `windows'.
+ (window--side-check): Remove unused variable `code'.
+ (window--resize-siblings): Remove unused variable `first'.
+ (adjust-window-trailing-edge): Remove unused variable `failed'.
+ (window-deletable-p, window--delete): Remove unused variable `buffer'.
+ Use `let', not `let*'.
+ (balance-windows-2): Remove unused variable `found'.
+ (window--state-put-2): Remove unused variable `splits'.
+ (window-state-put): Remove unused variable `selected'.
+ (same-window-p): Use `string-match-p'.
+ (display-buffer-assq-regexp): Remove unused variable `value'.
+ (display-buffer-pop-up-frame, display-buffer-pop-up-window):
+ Mark argument ALIST as ignored.
+ (pop-to-buffer): Remove unused variable `old-window'.
+
+2012-01-29 Eli Zaretskii <eliz@gnu.org>
+
+ * jka-cmpr-hook.el (jka-compr-compression-info-list): Support .lz
+ and .lzma compressed files.
+
+2012-01-29 Chong Yidong <cyd@gnu.org>
+
+ * frame.el (window-system-default-frame-alist): Doc fix.
+
+ * dynamic-setting.el (font-setting-change-default-font): Don't
+ change the default face if SET-FONT argument is non-nil (Bug#9982).
+
+2012-01-29 Samuel Bronson <naesten@gmail.com> (tiny change)
+
+ * custom.el (defcustom): Add doc link to Lisp manual (Bug#10635).
+
+2012-01-29 Syver Enstad <syver.enstad@cisco.com> (tiny change)
+
+ * progmodes/gud.el (pdb): Give pdb full paths, to allow setting
+ breakpoints in files outside current directory (Bug#6098).
+
+2012-01-29 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/python.el: Require ansi-color at top-level.
+
+ * emacs-lisp/lisp-mode.el (emacs-lisp-mode-abbrev-table):
+ Define and use in Emacs Lisp mode (Bug#9360).
+ (lisp-mode-abbrev-table): Add doc.
+ (lisp-mode-variables): Don't set local-abbrev-table.
+ (lisp-interaction-mode): Use emacs-lisp-mode-abbrev-table.
+
+2012-01-28 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-vec-incr): Fix docstring.
+
+2012-01-28 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-entry-alist): New function.
+ (bibtex-set-dialect): Use it. Either set global values of
+ dialect-dependent variables or bind these variables buffer-locally
+ (Bug#10254).
+ (bibtex-mode): Call bibtex-set-dialect via
+ hack-local-variables-hook.
+ (bibtex-dialect): Update docstring.
+ Add safe-local-variable predicate.
+ (bibtex-entry-alist, bibtex-field-alist): Initialize via
+ bibtex-set-dialect.
+ (bibtex-mode-map): Define menu for each dialect.
+ (bibtex-entry): Fix docstring.
+
+2012-01-28 Chong Yidong <cyd@gnu.org>
+
+ * eshell/esh-arg.el (eshell-quote-argument): New function.
+
+ * eshell/esh-ext.el (eshell-invoke-batch-file):
+ * eshell/em-unix.el (eshell/cat, eshell/du): Use it to quote the
+ first arg to eshell-parse-command (Bug#10523).
+
+2012-01-28 Drew Adams <drew.adams@oracle.com>
+
+ * net/ange-ftp.el (ange-ftp-canonize-filename): Check, that
+ `default-directory' is non-nil.
+
+2012-01-28 Eli Zaretskii <eliz@gnu.org>
+
+ * mail/emacsbug.el (report-emacs-bug): Fill the potentially long
+ line that displays system-configuration-options. (Bug#9924)
+
+2012-01-28 Drew Adams <drew.adams@oracle.com>
+
+ * descr-text.el (describe-char): Show information about POS, in
+ addition to information about the character at POS. Improve and
+ update the doc string. Change "code point" to "code point in
+ charset", to avoid confusion with the character's Unicode code
+ point shown above that. (Bug#10129)
+
+2012-01-28 Eli Zaretskii <eliz@gnu.org>
+
+ * descr-text.el (describe-char): Show the raw character, not only
+ its display form at POS. Suggested by Kenichi Handa <handa@m17n.org>.
+ See http://lists.gnu.org/archive/html/emacs-devel/2012-01/msg00760.html
+ for the reasons.
+
+2012-01-28 Phil Hagelberg <phil@hagelb.org>
+
+ * emacs-lisp/package.el (package-install):
+ Run package-refresh-contents if there is no archive yet (Bug#9798).
+
+2012-01-28 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/package.el (package-maybe-load-descriptor):
+ New function, split from package-maybe-load-descriptor.
+ (package-maybe-load-descriptor): Use it.
+ (package-download-transaction): Fully load required packages
+ inside the loop, so that `require' calls work (Bug#10593).
+ (package-install): No need to call package-initialize now.
+
+2012-01-28 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (deactivate-mark): Doc fix (Bug#8614).
+
+ * tooltip.el (tooltip-mode): Doc fix.
+ (tooltip-use-echo-area): Mark as obsolete (Bug#6595).
+
+ * frame.el (set-cursor-color): Doc fix (Bug#352).
+
+ * mail/rmail.el (rmail-start-mail): Add send-action again (Bug#10625).
+ (rmail-mail-return): Switch to NEWBUF only if it is non-nil.
+
+ * cus-edit.el (custom-buffer-create-internal): Fix search button
+ action (Bug#10542).
+ (customize-unsaved, customize-saved): Doc fix (Bug#10541).
+
+2012-01-27 Eduard Wiebe <usenet@pusto.de>
+
+ * dired.el (dired-mark-files-regexp):
+ Include any subdirectory components. (Bug#10445)
+
+2012-01-27 Mike Lamb <mrlamb@gmail.com> (tiny change)
+
+ * pcmpl-unix.el (pcmpl-ssh-known-hosts):
+ Handle [host]:port syntax. (Bug#10533)
+
+2012-01-27 Alex Harsanyi <harsanyi@mac.com>
+
+ * xml.el (xml-parse-tag): Fix parsing of comments (Bug#10405).
+
+2012-01-26 Glenn Morris <rgm@gnu.org>
+
+ * dired-x.el (dired-bind-jump): Use ctl-x-map and ctl-x-4-map.
+ * term.el (term-raw-escape-map): Use Control-X-prefix.
+ * vc/vc-hooks.el (vc-prefix-map): Use ctl-x-map. (Bug#10566)
+
+2012-01-25 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-state-get, window--state-get-1): Don't deal
+ with fixed-sizeness of windows. Simplify code.
+
+2012-01-25 Jérémy Compostella <jeremy.compostella@gmail.com>
+
+ * window.el (window--state-get-1, window--state-put-2):
+ Don't save and restore the mark.
+
+2012-01-25 Chong Yidong <cyd@gnu.org>
+
+ * custom.el (custom-variable-p): Doc fix.
+
+2012-01-25 Glenn Morris <rgm@gnu.org>
+
+ * dired.el (dired-goto-file): Handle some of the more common
+ characters that `ls -b' escapes. (Bug#10596)
+
+ * progmodes/compile.el (compilation-next-error-function):
+ Respect compilation-first-column in the "*compilation*" buffer.
+ * progmodes/grep.el (grep-first-column): New variable. (Bug#10594)
+
+ * vc/vc.el (vc-modify-change-comment): Scoping fix. (Bug#10513)
+
+2012-01-24 Glenn Morris <rgm@gnu.org>
+
+ * pcmpl-gnu.el (pcomplete/tar): Handle " - ". (Bug#10457)
+
+2012-01-24 Julien Danjou <julien@danjou.info>
+
+ * color.el (color-rgb-to-hsl): Fix value computing.
+ (color-hue-to-rgb): New function.
+ (color-hsl-to-rgb): New function.
+ (color-clamp, color-saturate-hsl, color-saturate-name)
+ (color-desaturate-hsl, color-desaturate-name, color-lighten-hsl)
+ (color-lighten-name, color-darken-hsl, color-darken-name): New function.
+
+2012-01-24 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-rcs.el (vc-rcs-create-tag):
+ * vc/vc-sccs.el (vc-sccs-create-tag):
+ Fix argument spec to be what vc-create-tag expects. (Bug#10515)
+
+2012-01-23 Mike Lamb <mrlamb@gmail.com> (tiny change)
+
+ * eshell/esh-util.el (eshell-read-hosts-file):
+ Skip comment lines. (Bug#10549)
+
+ * eshell/em-unix.el (pcomplete/ssh): Remove. (Bug#10548)
+
+2012-01-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * subr.el (display-delayed-warnings): Doc fix.
+ (collapse-delayed-warnings): New function to collapse identical
+ adjacent warnings.
+ (delayed-warnings-hook): Add it.
+
+2012-01-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-action-login): Set connection property "login-as".
+
+ * net/tramp-sh.el (tramp-methods): Add user spec to "pscp" and "psftp".
+ (tramp-default-user-alist): Don't add "pscp".
+ (tramp-do-copy-or-rename-file-out-of-band): Use connection
+ property "login-as", if set. (Bug#10530)
+
+2012-01-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-default-user-alist): Don't add "plink",
+ "plink1" and "psftp". (Bug#10530)
+
+2012-01-21 Kenichi Handa <handa@m17n.org>
+
+ * international/mule-cmds.el (prefer-coding-system): Show a
+ warning message if the default value of file-name-coding-system
+ was not changed.
+
+2012-01-21 Jérémy Compostella <jeremy.compostella@gmail.com>
+
+ * windmove.el (windmove-reference-loc):
+ Fix windmove-reference-loc miscalculation.
+
+2012-01-21 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-units.el (math-put-default-units): Don't use "1" as a
+ default unit.
+
+2012-01-21 Glenn Morris <rgm@gnu.org>
+
+ * international/mule.el (auto-coding-alist): Add .tbz.
+
+ * files.el (local-enable-local-variables): Doc fix.
+ (inhibit-local-variables-regexps): Rename from
+ inhibit-first-line-modes-regexps. Keep old name as obsolete alias.
+ Doc fix. Add some extensions from auto-coding-alist.
+ (inhibit-local-variables-suffixes):
+ Rename from inhibit-first-line-modes-suffixes. Doc fix.
+ (inhibit-local-variables-p):
+ New function, extracted from set-auto-mode-1.
+ (set-auto-mode): Doc fix. Respect inhibit-local-variables-regexps.
+ (set-auto-mode-1): Doc fix. Use inhibit-local-variables-p.
+ (hack-local-variables): Doc fix. Make the mode-only case
+ respect enable-local-variables and friends.
+ Respect inhibit-local-variables-regexps for file-locals, but
+ not for directory-locals.
+ (set-visited-file-name):
+ Take account of inhibit-local-variables-regexps.
+ Whether it applies may change as the file name is changed.
+ * jka-cmpr-hook.el (jka-compr-install):
+ * jka-compr.el (jka-compr-uninstall):
+ Update for inhibit-first-line-modes-suffixes name change.
+
+2012-01-20 Martin Rudalics <rudalics@gmx.at>
+
+ * help-macro.el (make-help-screen): Temporarily restore original
+ binding for minor-mode-map-alist (Bug#10454).
+
+2012-01-19 Julien Danjou <julien@danjou.info>
+
+ * color.el (color-name-to-rgb): Use the white color to find the max
+ color component value and return correctly computed values.
+ (color-name-to-rgb): Add missing float conversion for max value.
+
+2012-01-19 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--state-get-1, window-state-get): Do not use
+ special state value for window-persistent-parameters.
+ Rename argument IGNORE to WRITABLE. Rewrite doc-string.
+ (window--state-put-2): Reset all window parameters to nil before
+ assigning values of persistent parameters.
+
+2012-01-18 Alan Mackenzie <acm@muc.de>
+
+ Eliminate sluggishness and hangs in fontification of "semicolon
+ deserts".
+
+ * progmodes/cc-engine.el (c-state-nonlit-pos-interval):
+ Change value 10000 -> 3000.
+ (c-state-safe-place): Reformulate so it doesn't stack up an
+ infinite number of wrong entries in c-state-nonlit-pos-cache.
+ (c-determine-limit-get-base, c-determine-limit): New functions to
+ determine backward search limits disregarding literals.
+ (c-find-decl-spots): Amend commenting.
+ (c-cheap-inside-bracelist-p): New function which detects "={".
+
+ * progmodes/cc-fonts.el
+ (c-make-font-lock-BO-decl-search-function): Give a limit to a
+ backward search.
+ (c-font-lock-declarations): Fix an occurrence of point being
+ undefined. Check additionally for point being in a bracelist or
+ near a macro invocation without a semicolon so as to avoid a
+ fruitless time consuming search for a declarator. Give a more
+ precise search limit for declarators using the new
+ c-determine-limit.
+
+2012-01-18 Glenn Morris <rgm@gnu.org>
+
+ * files.el (auto-mode-alist, inhibit-first-line-modes-regexps)
+ (set-auto-mode): Doc fixes.
+
+2012-01-17 Glenn Morris <rgm@gnu.org>
+
+ * isearch.el (search-nonincremental-instead): Fix doc typo.
+
+ * dired.el (dired-insert-directory): Handle newlines in directory name.
+ (dired-build-subdir-alist): Unescape newlines in directory name.
+
+2012-01-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-local-end-of-line): New defcustom.
+ (tramp-action-login, tramp-action-yesno, tramp-action-yn)
+ (tramp-action-terminal): Use it. (Bug#10530)
+
+2012-01-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion--replace): Strip properties (bug#10062).
+
+2012-01-16 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-state-ignored-parameters): Remove variable.
+ (window--state-get-1): Rename argument MARKERS to IGNORE.
+ Handle persistent window parameters. Make copy of clone-of
+ parameter only if requested. (Bug#10348)
+ (window--state-put-2): Install a window parameter only if it has
+ a non-nil value or an existing parameter shall be overwritten.
+
+2012-01-15 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-remote-path): Set tramp-autoload cookie.
+
+2012-01-14 Eli Zaretskii <eliz@gnu.org>
+
+ * info.el (Info-toc-build): If the Info file has no "Up" pointer,
+ don't pass the (nil) value of `upnode' to string-match.
+
+2012-01-14 Chong Yidong <cyd@gnu.org>
+
+ * startup.el (command-line): Fix X resource class for cursorColor.
+ Fix values recognized by the cursorBlink resource.
+
+2012-01-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * epg.el (epg--make-temp-file): Avoid permission race condition
+ when running on old Emacs versions (bug#10403).
+
+2012-01-14 Glenn Morris <rgm@gnu.org>
+
+ * dired.el (dired-get-filename): Fix 'verbatim case of previous change.
+
+2012-01-13 Alan Mackenzie <acm@muc.de>
+
+ Fix filling for when filladapt mode is enabled.
+
+ * progmodes/cc-cmds.el (c-fill-paragraph): In the invocation of
+ c-mask-paragraph, pass in `fill-paragraph' rather than
+ `fill-region-as-paragraph'. (This is a reversion of a previous
+ change.)
+ * progmodes/cc-mode.el (c-basic-common-init):
+ Make fill-paragraph-handle-comment buffer local and set it to nil.
+
+2012-01-13 Glenn Morris <rgm@gnu.org>
+
+ * dired.el (dired-switches-escape-p): New function.
+ (dired-insert-directory): Use dired-switches-escape-p.
+ (dired-get-filename): Undo "\ " quoting if needed. (Bug#10469)
+
+ * find-dired.el (find-ls-option): Doc fix. (Bug#10262)
+
+2012-01-12 Glenn Morris <rgm@gnu.org>
+
+ * mail/sendmail.el (mail-mode): Update paragraph-separate for
+ changes in adaptive-fill-regexp. (Bug#10276)
+
+2012-01-11 Alan Mackenzie <acm@muc.de>
+
+ Fix Emacs bug #10463 - put `widen's around the critical spots.
+
+ * progmodes/cc-engine.el (c-in-literal, c-literal-limits): Put a
+ widen around each invocation of c-state-pp-to-literal. Remove an
+ unused let variable.
+
+2012-01-11 Glenn Morris <rgm@gnu.org>
+
+ * dired-aux.el (dired-do-shell-command): Fix */? logic. (Bug#6561)
+ Doc fix.
+
+2012-01-10 Chong Yidong <cyd@gnu.org>
+
+ * net/network-stream.el (network-stream-open-starttls):
+ Avoid emitting a confusing error message when the server gives a bad
+ response to the capability command.
+
+2012-01-10 Glenn Morris <rgm@gnu.org>
+
+ * mail/unrmail.el (unrmail): Tweak previous change.
+
+2012-01-09 Chong Yidong <cyd@gnu.org>
+
+ * custom.el (custom-safe-themes): Use SHA-256 for hashing.
+
+2012-01-08 Alan Mackenzie <acm@muc.de>
+
+ Optimise font locking in long enum definitions.
+
+ * progmodes/cc-fonts.el (c-font-lock-declarations): Add an extra
+ arm to a cond form to handle enums.
+ * progmodes/cc-langs.el (c-enums-contain-decls): New lang variable.
+ * progmodes/cc-mode.el (c-font-lock-fontify-region): Correct a typo.
+
+2012-01-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ * files.el (move-file-to-trash): Preserve default file modes on error.
+ (Bug#10401)
+
+2012-01-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * faces.el (set-face-attribute): Clarify the meaning of the nil
+ frame (bug#10294).
+
+ * subr.el (with-selected-frame): Mention that the selected frame
+ is restored (bug#9980).
+
+ * ibuffer.el (ibuffer-mode): List the bindings in the corrent map
+ (bug#9759).
+
+ * mail/smtpmail.el (password-cache-add): Remove unused declaration.
+ (password-read): Don't autoload unused function.
+
+2012-01-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * progmodes/which-func.el (which-func-mode): Turn into a
+ non-interactive function and mark as obsolete (bug#10428).
+
+2012-01-06 Chong Yidong <cyd@gnu.org>
+
+ * files.el (hack-dir-local-variables-non-file-buffer): Add doc.
+ (hack-one-local-variable-eval-safep): Allow 0 arg for minor mode
+ functions, along with 1 and -1.
+
+2012-01-06 Eli Zaretskii <eliz@gnu.org>
+
+ * time.el (display-time-load-average)
+ (display-time-default-load-average): Doc fixes. See the thread
+ starting at
+ http://lists.gnu.org/archive/html/help-gnu-emacs/2012-01/msg00059.html
+ for the details.
+
+2012-01-06 Glenn Morris <rgm@gnu.org>
+
+ * mail/unrmail.el (unrmail): Give an explicit error if the input file
+ has no messages. (Bug#10377)
+
+ * info.el (Info-mode-map): Bind e to end-of-buffer, rather
+ than Info-edit. (Bug#10385)
+
+ * time.el (display-time-load-average, display-time-next-load-average):
+ Doc fixes.
+
+ * emacs-lisp/bytecomp.el (byte-compile-file): Do not propagate a file
+ local setting of buffer-read-only to the input buffer. (Bug#10419)
+
+ * calendar/calendar.el (calendar-mode):
+ Locally set scroll-margin to 0. (Bug#10379)
+
+2012-01-06 Ulrich Mueller <ulm@gentoo.org>
+
+ * play/doctor.el (doctor-death): Escape "," characters. (Bug#10370)
+
+2012-01-05 Glenn Morris <rgm@gnu.org>
+
+ * eshell/em-unix.el (diff-no-select): Autoload it.
+ (eshell/diff): Use diff-no-select. (Bug#10420)
+
+2012-01-05 Chong Yidong <cyd@gnu.org>
+
+ * shell.el (shell-dynamic-complete-functions): Revert last change.
+ (shell-command-completion-function): New function.
+ (shell-completion-vars): Use it to implement
+ shell-completion-execonly (Bug#10417).
+
+ * custom.el (enable-theme): Don't set custom-safe-themes.
+
+ * cus-theme.el (custom-theme-merge-theme):
+ Ignore custom-enabled-themes and custom-safe-themes.
+
+2012-01-05 Michael R. Mauger <mmaug@yahoo.com>
+
+ * progmodes/sql.el (sql-login-hook): Add hook to respond to the
+ first prompt in `sql-interacive-mode'.
+ (sql-mode-oracle-font-lock-keywords): Add CONNECT_BY_* builtin
+ keywords.
+ (sql-mode-mysql-font-lock-keywords): Add ELSEIF keyword.
+ (sql-product-interactive): Bug fix: Set `sql-buffer' in
+ context of original buffer. Invoke `sql-login-hook'.
+
+2012-01-04 Eli Zaretskii <eliz@gnu.org>
+
+ * mail/rmail.el (rmail-font-lock-keywords): Accept non-ASCII
+ letters in cite-prefix.
+
+2012-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/smtpmail.el (smtpmail-stream-type): Mention the `ssl' value.
+
+2012-01-03 Chong Yidong <cyd@gnu.org>
+
+ * shell.el (shell-dynamic-complete-functions):
+ Put pcomplete-completions-at-point, so as to try
+ comint-filename-completion first (Bug#10417).
+
+2012-01-02 Richard Stallman <rms@gnu.org>
+
+ * battery.el (battery-status-function):
+ Detect when to use battery-yeeloong-sysfs.
+ (battery-echo-area-format): Add string for Yeeloong.
+ (battery-linux-proc-apm, battery-linux-proc-acpi): Doc fixes.
+ (battery-yeeloong-sysfs): New function.
+
+2012-01-02 Chong Yidong <cyd@gnu.org>
+
+ * dirtrack.el (dirtrack-list): Eliminate unused third element.
+ (dirtrack): Merge code for handling relative filenames in prompt
+ from shell-dir-cookie-watcher.
+ (dirtrack-debug-message): New arg to avoid excess format calls.
+
+ * shell.el (shell-dir-cookie-re): Variable deleted.
+ (shell-dir-cookie-watcher): Function deleted.
+ (shell-mode): Don't use shell-dir-cookie-re, since it is redundant
+ with dirtrack-mode.
+
+2012-01-01 Eli Zaretskii <eliz@gnu.org>
+
+ * term/w32-win.el (dynamic-library-alist) <gnutls>:
+ Load libgnutls-28.dll, from GnuTLS version 3.x, in preference to
+ libgnutls-26.dll.
+
+2011-12-31 Andreas Schwab <schwab@linux-m68k.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-file): Fix indentation.
+
+2011-12-31 Eli Zaretskii <eliz@gnu.org>
+
+ * mail/rmail.el (rmail-show-message-1): Decode any RFC2047 encoded
+ headers of non-MIME messages, when rmail-enable-mime is non-nil.
+
+2011-12-29 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-find-shell): Set "remote-shell" property
+ also for alternative shells.
+ (tramp-open-connection-setup-interactive-shell): Check, whether
+ the shell is a busybox.
+ (tramp-send-command): Don't suppress multiple prompts for
+ busyboxes, it hurts.
+
+2011-12-28 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-get-source-file-list)
+ (gdb-get-source-file): Move mode line update to
+ gdb-get-source-file (Bug#10087).
+
2011-12-25 Chong Yidong <cyd@gnu.org>
* progmodes/gud.el (gud-gdb-fetch-lines-filter): Just use
@@ -15,33 +11995,32 @@
(gdb-var-delete-children, gdb-edit-value, gdb-var-update)
(gdb-stopped, def-gdb-auto-update-trigger)
(gdb-place-breakpoints, gdb-select-thread, gdb-select-frame)
- (gdb-get-changed-registers, gdb-get-main-selected-frame): Callers
- changed.
+ (gdb-get-changed-registers, gdb-get-main-selected-frame):
+ Callers changed.
(gud-gdbmi-completions): New function.
(gdb): Use it for generating the completion table.
2011-12-24 Alan Mackenzie <acm@muc.de>
Introduce a mechanism to widen the region used in context font
- locking. Use this to protect declarations from losing their
- contexts.
+ locking. Use this to protect declarations from losing their contexts.
- * progmodes/cc-langs.el (c-before-font-lock-functions): replace
- c-set-fl-decl-start with c-change-set-fl-decl-start (Renaming).
- (c-before-context-fontification-functions): new defvar, a list of
+ * progmodes/cc-langs.el (c-before-font-lock-functions):
+ Replace c-set-fl-decl-start with c-change-set-fl-decl-start (Renaming).
+ (c-before-context-fontification-functions): New defvar, a list of
functions to be run just before context (etc.) font locking.
* progmodes/cc-mode.el (c-extend-font-lock-region-for-macros):
- new, functionality extracted from
+ New, functionality extracted from
c-neutralize-syntax-in-and-mark-CPP.
- (c-in-after-change-fontification): new variable.
+ (c-in-after-change-fontification): New variable.
(c-after-change): Set c-in-after-change-fontification.
(c-set-fl-decl-start): Rejig its interface, so it can be called
from both after-change and context fontifying.
- (c-change-set-fl-decl-start, c-context-set-fl-decl-start): new
- functions.
- (c-standard-font-lock-fontify-region-function): new variable.
- (c-font-lock-fontify-region): new function.
+ (c-change-set-fl-decl-start, c-context-set-fl-decl-start):
+ New functions.
+ (c-standard-font-lock-fontify-region-function): New variable.
+ (c-font-lock-fontify-region): New function.
2011-12-24 Juri Linkov <juri@jurta.org>
@@ -57,17 +12036,17 @@
Fix unstable fontification inside templates.
- * progmodes/cc-langs.el (c-before-font-lock-functions): newly
- created from the singular version. The (c c++ objc) entry now
+ * progmodes/cc-langs.el (c-before-font-lock-functions):
+ Newly created from the singular version. The (c c++ objc) entry now
additionally has c-set-fl-decl-start. The other languages (apart
from AWK) have that as a single entry.
- * progmodes/cc-fonts.el (c-font-lock-enclosing-decls): The
- functionality for "local" declarations has been extracted to
+ * progmodes/cc-fonts.el (c-font-lock-enclosing-decls):
+ The functionality for "local" declarations has been extracted to
c-set-fl-decl-start.
- * progmodes/cc-mode.el: (c-common-init, c-after-change): Changes
- due to pluralisation of c-before-font-lock-functions.
+ * progmodes/cc-mode.el (c-common-init, c-after-change):
+ Changes due to pluralisation of c-before-font-lock-functions.
(c-set-fl-decl-start): New function, extracted from
c-font-lock-enclosing-decls and enhanced.
@@ -93,16 +12072,25 @@
2011-12-21 Teodor Zlatanov <tzz@lifelogs.com>
- * progmodes/cfengine.el: Add Version.
-
- Add CFEngine 3.x syntax highlighting and support with
- `cfengine3-mode', and rename the old `cfengine-mode' to
- `cfengine2-mode'. Make `cfengine-mode' an automatic content-based
- switcher between `cfengine3-mode' and `cfengine2-mode' by aliasing
- it to `cfengine-auto-mode'. Rename variables specific to
- `cfengine2-mode' from cfengine-* to cfengine2-*. Change the
- modeline indicator to "CFE2" and "CFE3" depending on the mode, to
- save space. Mark `cfengine-mode-abbrevs' as obsolete.
+ * progmodes/cfengine.el: Add Version. Improve CFEngine 3.x syntax
+ highlighting and support. Fix up comments for capitalization.
+ (cfengine-mode-debug): New var.
+ (cfengine3-mode): Change the modeline indicator to "CFE3".
+ (cfengine3-font-lock-keywords): Improve defun highlighting.
+ (cfengine2-actions): Rename from `cfengine-actions'.
+ (cfengine2-font-lock-keywords): Rename from
+ `cfengine-font-lock-keywords'.
+ (cfengine2-imenu-expression): Rename from
+ `cfengine-imenu-expression'.
+ (cfengine2-outline-level): Rename from `cfengine-outline-level'.
+ (cfengine2-beginning-of-defun): Rename from
+ `cfengine-beginning-of-defun'.
+ (cfengine2-end-of-defun): Rename from `cfengine-end-of-defun'.
+ (cfengine2-indent-line): Rename from `cfengine-indent-line'.
+ (cfengine2-mode): Rename from `cfengine-mode'. Change the
+ modeline indicator to "CFE2".
+ (cfengine-mode): Defalias to `cfengine-auto-mode'.
+ (cfengine-mode-abbrevs): Mark obsolete.
2011-12-21 Chong Yidong <cyd@gnu.org>
@@ -138,7 +12126,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>
@@ -165,27 +12153,24 @@
Add the switch statement to AWK Mode.
- * progmodes/cc-awk (awk-font-lock-keywords): Add "switch", "case",
+ * progmodes/cc-awk.el (awk-font-lock-keywords): Add "switch", "case",
"default" to the keywords regexp.
- * progmodes/cc-langs (c-label-kwds): Let AWK take the same
+ * progmodes/cc-langs.el (c-label-kwds): Let AWK take the same
expression as the rest.
- (c-nonlabel-token-key): Allow string literals for AWK. Refactor
- for the other modes.
+ (c-nonlabel-token-key): Allow string literals for AWK.
+ Refactor for the other modes.
Large brace-block initialisation makes CC Mode slow: Fix.
- Tidy up and accelerate c-in-literal, etc. by using the
- c-parse-state
+ Tidy up and accelerate c-in-literal, etc. by using the c-parse-state
routines. Limit backward searching in c-font-lock-enclosing.decl.
* progmodes/cc-engine.el (c-state-pp-to-literal): Return the
pp-state and literal type in addition to the limits.
- (c-state-safe-place): New defun, extracted from
- c-state-literal-at.
+ (c-state-safe-place): New defun, extracted from c-state-literal-at.
(c-state-literal-at): Use the above new defun.
- (c-slow-in-literal, c-fast-in-literal): Removed.
- (c-in-literal, c-literal-limits): Amended to use
- c-state-pp-to-literal.
+ (c-slow-in-literal, c-fast-in-literal): Remove.
+ (c-in-literal, c-literal-limits): Amend to use c-state-pp-to-literal.
* progmodes/cc-fonts.el (c-font-lock-enclosing-decls): Check for
being in a literal. Add a limit for backward searching.
@@ -259,8 +12244,8 @@
2011-12-10 Eli Zaretskii <eliz@gnu.org>
* mail/rmailsum.el (rmail-header-summary): RFC2047 decode the
- `from' or `to' address before taking its substring. Fixes
- incorrect display in Rmail summary buffer whereby an RFC2047
+ `from' or `to' address before taking its substring.
+ Fixes incorrect display in Rmail summary buffer whereby an RFC2047
encoded name is chopped in the middle of the encoded string, and
thus displayed encoded.
@@ -479,8 +12464,8 @@
(verilog-uvm-statement-re): Support UVM indentation and
highlighting, with old OVM keywords only.
(verilog-auto-tieoff, verilog-auto-tieoff-declaration):
- Support AUTOTIEOFF creating non-wire data types. Suggested by Jonathan
- Greenlaw.
+ Support AUTOTIEOFF creating non-wire data types.
+ Suggested by Jonathan Greenlaw.
(verilog-auto-insert-lisp, verilog-delete-to-paren)
(verilog-forward-sexp-cmt, verilog-forward-sexp-ign-cmt)
(verilog-inject-sense, verilog-read-inst-pins)
@@ -566,11 +12551,11 @@
Andrew Drake.
(verilog-auto-star-safe, verilog-delete-auto-star-implicit)
(verilog-inst-comment-re): Fix not deleting Interfaced comment
- when expanding .* in interfaces, bug320. Reported by Pierre-David
- Pfister.
+ when expanding .* in interfaces, bug320.
+ Reported by Pierre-David Pfister.
(verilog-read-module-name): Fix import statements between module
- name and open parenthesis, bug317. Reported by Pierre-David
- Pfister.
+ name and open parenthesis, bug317.
+ Reported by Pierre-David Pfister.
(verilog-simplify-range-expression): Fix simplification of
multiplications inside AUTOWIRE connections, bug303.
(verilog-auto-inst-port): Support parameter expansion in
@@ -824,8 +12809,7 @@
2011-11-19 Andreas Schwab <schwab@linux-m68k.org>
- * progmodes/sh-script.el (sh-assignment-regexp): Add entry for
- bash.
+ * progmodes/sh-script.el (sh-assignment-regexp): Add entry for bash.
2011-11-19 Juri Linkov <juri@jurta.org>
@@ -950,8 +12934,7 @@
* window.el (window-resize, delete-window, split-window):
Replace window-splits by window-combination-resize.
- * cus-start.el (window-splits): Replace by
- window-combination-resize.
+ * cus-start.el (window-splits): Replace by window-combination-resize.
2011-11-17 Glenn Morris <rgm@gnu.org>
@@ -960,9 +12943,6 @@
2011-11-16 Michael Albinus <michael.albinus@gmx.de>
- * net/tramp-cache.el (tramp-flush-file-property): Flush also
- properties of linked files. (Bug#9879)
-
* net/tramp-sh.el (tramp-sh-handle-file-truename): Cache only the
local file name.
@@ -1016,8 +12996,7 @@
* window.el (split-window, window-state-get-1)
(window-state-put-1, window-state-put-2): Rename occurrences of
window-nest to window-combination-limit.
- * cus-start.el (window-nest): Rename to
- window-combination-limit.
+ * cus-start.el (window-nest): Rename to window-combination-limit.
2011-11-16 Chong Yidong <cyd@gnu.org>
@@ -1209,7 +13188,7 @@
(window-list-no-nils): Remove.
(window-state-get-1, window-state-get): Use backquote instead.
-2011-11-08 thierry <thierry.volpiatto@gmail.com>
+2011-11-08 Thierry Volpiatto <thierry.volpiatto@gmail.com>
* emacs-lisp/find-func.el (find-function-read):
Fix incorrect use of default argument in `completing-read'.
@@ -2033,7 +14012,7 @@
2011-10-08 Thierry Volpiatto <thierry.volpiatto@gmail.com>
- * lisp/eshell/eshell.el (eshell-command): Avoid using hooks.
+ * eshell/eshell.el (eshell-command): Avoid using hooks.
2011-10-07 Chong Yidong <cyd@stupidchicken.com>
@@ -3253,7 +15232,7 @@
(tramp-completion-file-name-regexp-unified)
(tramp-completion-file-name-regexp-separate)
(tramp-completion-file-name-regexp-url): Don't use leading volume
- letter on win32 systems. (Bug#5303, Bug#9311)
+ letter on w32 systems. (Bug#5303, Bug#9311)
(tramp-drop-volume-letter): Simplify definition.
Suggested by Stefan Monnier <monnier@iro.umontreal.ca>.
@@ -3441,7 +15420,7 @@
* cus-start.el (all): Add entry for bidi-paragraph-direction.
- * international/uni-bidi.el: Regenerated.
+ * international/uni-bidi.el: Regenerate.
2011-08-23 Kenichi Handa <handa@m17n.org>
@@ -4359,7 +16338,7 @@
* printing.el: Add documentation to all the `pr-toggle-' commands.
-2011-07-11 Leo <sdl.web@gmail.com> (tiny change)
+2011-07-11 Leo Liu <sdl.web@gmail.com>
* files.el (toggle-read-only): Only do the `C-x C-q' warning on VC
backends where it makes sense (bug#2623).
@@ -4794,7 +16773,7 @@
insecure exception for current topic. Also note that auto-saves
are handled differently.
- (allout-auto-save-temporarily-disabled), (allout-just-did-undo):
+ (allout-auto-save-temporarily-disabled, allout-just-did-undo):
State variables for tracking auto-save inhibition situation.
(allout-write-contents-hook-handler): Rename from
@@ -5193,7 +17172,7 @@
* comint.el (comint-password-prompt-regexp): Accept "Response" as
a password-like phrase.
-2011-06-30 Mastake YAMATO <yamato@redhat.com>
+2011-06-30 Masatake YAMATO <yamato@redhat.com>
* progmodes/cc-guess.el: New file.
@@ -5668,7 +17647,7 @@
2011-06-22 Leo Liu <sdl.web@gmail.com>
* minibuffer.el (completing-read-function)
- (completing-read-default): Move from minibuf.c
+ (completing-read-default): Move from minibuf.c.
2011-06-22 Richard Stallman <rms@gnu.org>
@@ -6753,7 +18732,7 @@
* isearch.el (isearch-range-invisible): Use invisible-p (bug#8721).
-2009-11-23 Toby Cubitt <toby-predictive@dr-qubit.org>
+2011-05-27 Toby Cubitt <toby-predictive@dr-qubit.org>
* emacs-lisp/avl-tree.el: New avl-tree-stack datatype. Add new
traversal functions for avl-trees.
@@ -6771,8 +18750,6 @@
(avl-tree-stack, avl-tree-stack-pop, avl-tree-stack-first)
(avl-tree-stack-empty-p): New functions.
-2009-11-23 Toby Cubitt <toby-predictive@dr-qubit.org>
-
* emacs-lisp/avl-tree.el (avl-tree--del-balance): Rename from
avl-tree--del-balance1 and make it work both ways.
(avl-tree--del-balance2): Remove.
@@ -6943,7 +18920,7 @@
2011-05-23 Kevin Ryde <user42@zip.com.au>
* emacs-lisp/advice.el (ad-read-advised-function):
- Use `function-called-at-point' as the default default, if it has
+ Use `function-called-at-point' as the default, if it has
advice and passes PREDICATE.
2011-05-23 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -7243,8 +19220,8 @@
(newsticker--plainview-tool-bar-map): Move tool-bar icons to
etc/images/newsticker.
- * net/newst-backend.el (newsticker--do-run-auto-mark-filter),
- (newsticker--process-auto-mark-filter-match): : Tell user about
+ * net/newst-backend.el (newsticker--do-run-auto-mark-filter)
+ (newsticker--process-auto-mark-filter-match): Tell user about
auto-marking.
2011-05-13 Didier Verna <didier@xemacs.org>
@@ -7372,7 +19349,7 @@
* textmodes/reftex-dcr.el (reftex-view-crossref): at at -> at a
2011-05-10 Glenn Morris <rgm@gnu.org>
- Stefan Monnier <monnier@iro.umontreal.ca>
+ Stefan Monnier <monnier@iro.umontreal.ca>
* files.el (hack-one-local-variable-eval-safep):
Consider "eval: (foo-mode)" to be safe. (Bug#8613)
@@ -7527,7 +19504,7 @@
Remove unnecessary and incorrect declarations.
* emacs-lisp/check-declare.el (check-declare-scan):
- Handle byte-compile-initial-macro-environment in bytecomp.el
+ Handle byte-compile-initial-macro-environment in bytecomp.el.
2011-05-05 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -7769,7 +19746,7 @@
* net/gnutls.el (gnutls-negotiate): Add hostname, verify-flags,
verify-error, and verify-hostname-error parameters. Check whether
default trustfile exists before going to use it. Add missing
- argument to gnutls-message-maybe call. Return return value.
+ argument to gnutls-message-maybe call. Return value.
Reported by Claudio Bley <claudio.bley@gmail.com>.
(open-gnutls-stream): Add usage example.
@@ -9164,7 +21141,7 @@
* vc/log-view.el:
* vc/smerge-mode.el:
* textmodes/bibtex-style.el:
- * textmodes/css.el:
+ * textmodes/css-mode.el:
* startup.el:
* uniquify.el:
* minibuffer.el:
@@ -9393,7 +21370,7 @@
* calc/calc-menu.el (calc-units-menu): Add entries for logarithmic
units and musical notes.
-2011-03-20 Leo <sdl.web@gmail.com>
+2011-03-20 Leo Liu <sdl.web@gmail.com>
* ido.el (ido-read-internal): Use completing-read-default.
(ido-completing-read): Fix compatibility with completing-read.
@@ -9501,7 +21478,8 @@
(calc-lu-field-reference): Rename from
`calc-logunits-field-reference'.
- * calc/calc-help (calc-l-prefix-help): Mention musical note functions.
+ * calc/calc-help.el (calc-l-prefix-help):
+ Mention musical note functions.
2011-03-17 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -9677,7 +21655,7 @@
2011-03-09 Ken Manheimer <ken.manheimer@gmail.com>
- * allout.el Summary: Change so yank of distinctive-bullet items
+ * allout.el: Change so yank of distinctive-bullet items
preserves the existing header prefix, rebulleting it if necessary,
rather than replacing it. This is necessary for proper operation
of cooperative addons like allout-widgets.
@@ -9745,7 +21723,7 @@ See ChangeLog.15 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2011 Free Software Foundation, Inc.
+ Copyright (C) 2011-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.1 b/lisp/ChangeLog.1
index aac6e998a88..9958c6ccdb3 100644
--- a/lisp/ChangeLog.1
+++ b/lisp/ChangeLog.1
@@ -100,7 +100,7 @@
1986-03-31 Richard M. Stallman (rms@prep)
- * man.el: fix stupid error in arg to file-name-all-completions.
+ * man.el: Fix stupid error in arg to file-name-all-completions.
1986-03-28 Richard M. Stallman (rms@prep)
@@ -117,7 +117,7 @@
1986-03-26 Richard Mlynarik (mly@prep)
* indent.el (edit-tab-stops):
- Go to character 0 so editing happens in right place
+ Go to character 0 so editing happens in right place.
1986-03-24 Richard M. Stallman (rms@prep)
@@ -196,8 +196,8 @@
1986-03-12 Richard Mlynarik (mly@prep)
- * shell.el (shell)
- If no environment variable SHELL, default to /bin/sh
+ * shell.el (shell):
+ If no environment variable SHELL, default to /bin/sh.
1986-03-12 Leonard H. Tower Jr. (tower@prep)
@@ -226,16 +226,16 @@
1986-03-07 Sundar Narasimhan (sundar@prep)
- * rnews.el: fix bug in news-get-new-news. (news-current-news-group
+ * rnews.el: Fix bug in news-get-new-news. (news-current-news-group
should be nil on startup).
1986-03-07 Bill Rozas (jinx@prep)
- * scheme.el: autoloads from xscheme.el
+ * scheme.el: Autoloads from xscheme.el.
* xscheme.el: New file. Implements inferior-scheme-mode and
related commands. Similar (almost a query replace of)
- inferior-lisp-mode in shell.el
+ inferior-lisp-mode in shell.el.
1986-03-07 Richard M. Stallman (rms@prep)
@@ -267,8 +267,8 @@
1986-03-03 Leonard H. Tower Jr. (tower@prep)
- * rnews.el (news-add-news-group)
- Fixed bug that was putting "/"'s in newsgroups names in .newsrc
+ * rnews.el (news-add-news-group):
+ Fix bug that was putting "/"'s in newsgroups names in .newsrc
instead of "."'s.
1986-03-03 Richard M. Stallman (rms@prep)
@@ -320,8 +320,8 @@
1986-02-20 Richard Mlynarik (mly@prep)
* info.el (Info-validate):
- Node-names are case-insensitive, but assoc is case-sensitive
- Separate out function Info-validate-tags-table
+ Node-names are case-insensitive, but assoc is case-sensitive.
+ Separate out function Info-validate-tags-table.
1986-02-19 Richard M. Stallman (rms@prep)
@@ -404,7 +404,7 @@
* info.el:
Completely rewrite Info-find-node so that it doesn't
- blow out on nonexistent nodes/files
+ blow out on nonexistent nodes/files.
Rewrite Info-goto-node through the Magic of Regular Expressions.
@@ -426,7 +426,7 @@
1986-02-03 Richard Mlynarik (mly@prep)
- * info.el (Info-validate) Insert a missing space.
+ * info.el (Info-validate): Insert a missing space.
1986-02-03 Richard M. Stallman (rms@prep)
@@ -522,7 +522,7 @@
Set mode correctly for .~i~ backup files.
* shell.el (inferior-lisp-mode):
- Use \\{...} in doc. Fix up initialization of inferior-lisp-mode-map
+ Use \\{...} in doc. Fix up initialization of inferior-lisp-mode-map.
1986-01-21 Richard Mlynarik (mly@prep)
@@ -585,7 +585,7 @@
1986-01-09 Richard Mlynarik (mly@prep)
* mail-utils.el (mail-strip-quoted-names):
- Handle multi-line address lists
+ Handle multi-line address lists.
1986-01-08 Richard Mlynarik (mly@prep)
@@ -610,12 +610,12 @@
1986-01-07 Richard Mlynarik (mly@prep)
* tags.el (visit-tags-table):
- Barf if given a directory
+ Barf if given a directory.
1986-01-06 Richard Mlynarik (mly@prep)
* nroff-mode.el (electric-nroff-mode):
- set-minor-mode correctly
+ set-minor-mode correctly.
1986-01-02 Richard Mlynarik (mly@prep)
@@ -626,7 +626,7 @@
* info.el (Info-tagify, Info-validate):
(let ((case-fold-search t)) ...)
- for when these functions are used outside info mode
+ for when these functions are used outside info mode.
1985-12-30 Richard M. Stallman (rms@prep)
@@ -646,7 +646,7 @@
1985-12-30 Richard Mlynarik (mly@prep)
* files.el (backup-buffer):
- Don't backup `weird' (non-character or link) files
+ Don't backup `weird' (non-character or link) files.
1985-12-28 Richard M. Stallman (rms@prep)
@@ -749,7 +749,7 @@
1985-12-17 Richard Mlynarik (mly@prep)
* simple.el (goto-line):
- Accept either prefix arg or prompt in minibuffer
+ Accept either prefix arg or prompt in minibuffer.
1985-12-17 Richard M. Stallman (rms@prep)
@@ -772,7 +772,7 @@
* files.el (set-visited-file-name):
Work properly in case of arg = nil or = "".
- * debug.el (debugger-frame{,-clear})
+ * debug.el (debugger-frame{,-clear}):
Bind off read-only flag to change buffer.
1985-12-14 Richard M. Stallman (rms@prep)
@@ -812,8 +812,7 @@
modified in Rmail doesn't always correlate with
what the user is thinking about.
- * abbrev.el (prepare-abbrev-list-buffer, list-abbrevs,
- edit-abbrevs):
+ * abbrev.el (prepare-abbrev-list-buffer, list-abbrevs, edit-abbrevs):
Some cleanups. prepare-... now does all the work and
returns the buffer for the caller to select or display.
@@ -894,8 +893,8 @@
* files.el (switch-to-buffer-other-window):
Pass t as new second arg to pop-to-buffer.
- * indent.el (insert-tab):
- If indent-tabs-mode = nil, insert spaces instead.
+ * indent.el (insert-tab):
+ If indent-tabs-mode = nil, insert spaces instead.
* debug.el (debug):
Combine two unwind-protect's into one.
@@ -907,7 +906,7 @@
1985-12-09 Richard Mlynarik (mly@prep)
* rmail.el (rmail-save):
- Don't do possibly lengthy expunge if buffer not modified
+ Don't do possibly lengthy expunge if buffer not modified.
* loaddefs.el:
(fset 'TeX-mode 'tex-mode)
@@ -942,10 +941,10 @@
* info.el (Info-find-node):
Must search for "Node: Foo" not " Foo" or else would
- lose when there was a "Node: Bar Foo"
+ lose when there was a "Node: Bar Foo".
* dired.el (dired-copy-file):
- interactive "F" not "s"
+ interactive "F" not "s".
* man.el (manual-entry):
Allow user to specify "chdir(3)" to get entry from section
@@ -965,10 +964,10 @@
* info.el:
(Info-validate-node-name): Don't complain about nodes in other files.
- (Info-menu-sequence): fix typo in function name.
+ (Info-menu-sequence): Fix typo in function name.
* rmail.el:
- (rmail-save): new function; `s' and `q' commands now expunge.
+ (rmail-save): New function; `s' and `q' commands now expunge.
(rmail-set-attribute): Don't lose if buffer wasn't narrowed.
(rmail-undelete-previous-message):
Try current message first, then back up till deleted msg
@@ -1032,11 +1031,12 @@
1985-12-05 Richard Mlynarik (mly@prep)
- * abbrev.el, chistory.el, debug.el, doctor.el, indent.el, info.el, sendmail.el:
- Fix initialization of mode-maps
+ * abbrev.el, chistory.el, debug.el, doctor.el, indent.el:
+ * info.el, sendmail.el:
+ Fix initialization of mode-maps.
* sendmail.el (mail-position-on-field):
- Make this work
+ Make this work.
1985-12-05 Richard M. Stallman (rms@prep)
@@ -1091,18 +1091,18 @@
1985-12-03 Richard Mlynarik (mly@prep)
* bytecomp.el (byte-compile-file-form):
- Reduce noninteractive message verbosity
+ Reduce noninteractive message verbosity.
* ebuff-menu.el:
- Standardize initialization of Electric-buffer-menu-mode-map
- make digits, meta-digits and "-" be numeric args
+ Standardize initialization of Electric-buffer-menu-mode-map.
+ Make digits, meta-digits and "-" be numeric args.
(put 'Electric-buffer-menu-undefined 'suppress-keymap t)
* electric.el (Electric-command-loop):
- Set up this-command and last-command-char in command loop
+ Set up this-command and last-command-char in command loop.
* simple.el (prefix-arg-internal, negative-argument):
- Fix problem with negative-arguments and unreading
+ Fix problem with negative-arguments and unreading.
1985-12-03 Richard M. Stallman (rms@prep)
@@ -1114,9 +1114,8 @@
* rnews.el:
Remove stray "<" character introduced by mly.
- (news-move-to-group): give error message if no new group to move
- to.
- (news-next-message): with arg of 1 or -1, keep doing
+ (news-move-to-group): Give error message if no new group to move to.
+ (news-next-message): With arg of 1 or -1, keep doing
news-next-group or news-previous-group till reach nonempty group.
* x-mouse.el:
@@ -1146,14 +1145,14 @@
1985-11-26 Richard Mlynarik (mly@prep)
* view.el:
- Define c-x o
+ Define c-x o.
Rename interactive functions from view-* to View-* to improve m-x
completion.
- defvar, rather than defconst, view-mode-map
- Take old-emacs-version-compatibility out of view-file
+ defvar, rather than defconst, view-mode-map.
+ Take old-emacs-version-compatibility out of view-file.
- * helper.el (Helper-describe-mode, Helper-describe-bindings)
- Fix bit-rot
+ * helper.el (Helper-describe-mode, Helper-describe-bindings):
+ Fix bit-rot.
Hack C-l in Helper-help-scroller.
1985-11-25 Richard M. Stallman (rms@prep)
@@ -1207,26 +1206,26 @@
Make edit-options-1 inline.
* term-xterm.el:
- Fix documentation for x-switches
+ Fix documentation for x-switches.
1985-11-20 Richard Mlynarik (mly@prep)
* files.el, sendmail.el:
- New function delete-auto-save-file-if-necessary
- Make basic-save-file, mail-send call it
+ New function delete-auto-save-file-if-necessary.
+ Make basic-save-file, mail-send call it.
* startup.el (command-line-1):
- Reformat to make all extraneous bs fit in 80 columns
+ Reformat to make all extraneous bs fit in 80 columns.
* lisp-mode.el (calculate-lisp-indent):
Check for boundp lisp-indent-hook, not fboundp.
- * lisp.el, lisp-mode.el
+ * lisp.el, lisp-mode.el:
Move eval-last-sexp, eval-defun from lisp.el to lisp-mode.el since
all their usages occur in the latter file.
- * rnews.el
- Use `mail-header-separator'
+ * rnews.el:
+ Use `mail-header-separator'.
* term-xterm.el:
Define x-handle-switch-1 to modularize discarding of
@@ -1236,8 +1235,8 @@
Check for command-switch-alist before checking for builtin
switches.
- * bytecomp.el, term-xterm.el, tex-start.el
- Switches look for `command-line-args' rather than `args'
+ * bytecomp.el, term-xterm.el, tex-start.el:
+ Switches look for `command-line-args' rather than `args'.
1985-11-20 Richard M. Stallman (rms@prep)
@@ -1275,14 +1274,14 @@
1985-11-18 Richard Mlynarik (mly@prep)
- * bytecomp.el (batch-byte-compile):
+ * bytecomp.el (batch-byte-compile):
Print a message for the log before terminating self.
* simple.el (set-variable):
Fix thinko in help-form, and include current value.
* info.el (Info-find-node):
- If can't find node, say which node in error message
+ If can't find node, say which node in error message.
* rmailedit.el (rmail-edit-mode):
Improve documentation greatly, fix typo.
@@ -1303,8 +1302,8 @@
1985-11-14 Richard Mlynarik (mly@prep)
- * info.el
- Make "." be beginning-of-buffer
+ * info.el:
+ Make "." be beginning-of-buffer.
1985-11-13 Richard M. Stallman (rms@prep)
@@ -1332,19 +1331,19 @@
1985-11-08 Richard Mlynarik (mly@prep)
* startup.el (command-line):
- If noninteractive, don't load "term-*"
+ If noninteractive, don't load "term-*".
noninteractive => -q [Change this if you think it is a bad
idea rms -- every use of -batch I make is followed by -q...]
1985-11-07 Richard Mlynarik (mly@prep)
* files.el (after-find-file):
- If get error hacking mode or local-vars, say what sort of error
+ If get error hacking mode or local-vars, say what sort of error.
1985-11-06 Richard Mlynarik (mly@prep)
* bytecomp.el (byte-compile-lambda):
- Compile non-string `interactive' frobs
+ Compile non-string `interactive' frobs.
1985-11-05 Richard M. Stallman (rms@prep)
@@ -1359,18 +1358,18 @@
Don't use create-file-buffer for summary buffer!
* rmailsum.el (rmail-make-summary-line-1):
- Fix bug computing new summary line
+ Fix bug computing new summary line.
* debug.el (debug):
Make recursive calls to the debugger work.
- Make debugger buffer read-only
+ Make debugger buffer read-only.
* sendmail.el (mail-send, sendmail-send-it):
Move some stuff from sendmail-send-it to mail-send
- Delete auto-save #%*mail* file if `delete-auto-save-files'
+ Delete auto-save #%*mail* file if `delete-auto-save-files'.
* electric.el (Electric-command-loop):
- condition-case for `beginning-of-buffer'
+ condition-case for `beginning-of-buffer'.
1985-11-05 Richard M. Stallman (rms@prep)
@@ -1381,7 +1380,7 @@
1985-11-04 Richard Mlynarik (mly@prep)
* yow.el, loaddefs.el:
- Function yow. Depends on file emacs/etc/yow.lines
+ Function yow. Depends on file emacs/etc/yow.lines.
1985-11-04 Richard M. Stallman (rms@prep)
@@ -1423,7 +1422,7 @@
Some more bugs seem to remain in this code...
* dired.el:
- Both "e" and "f" are `dired-find-file'
+ Both "e" and "f" are `dired-find-file'.
1985-10-30 Richard Mlynarik (mly@prep)
@@ -1449,7 +1448,7 @@
1985-10-29 Richard Mlynarik (mly@prep)
* startup.el (command-line-1):
- "-l" switch loads wrt load-path, rather than wrt default-directory
+ "-l" switch loads wrt load-path, rather than wrt default-directory.
1985-10-29 Richard M. Stallman (rms@prep)
@@ -1491,7 +1490,7 @@
1985-10-23 Richard Mlynarik (mly@prep)
- * mouseinit.el
+ * mouseinit.el:
Delete this file. Put its contents in files
term-bg.el, term-bgnv.el, term-bgrv.el, term-bbn.el.
(Perhaps there should be a subdirectory emacs/lisp/term/ ??)
@@ -1504,10 +1503,10 @@
1985-10-22 Richard Mlynarik (mly@prep)
* debugger.el (debug):
- Bind variable `debugger-value' instead of `value'
+ Bind variable `debugger-value' instead of `value'.
* userlock.el:
- Give `file-locked' error-conditions and error-message props
+ Give `file-locked' error-conditions and error-message props.
1985-10-21 Richard M. Stallman (rms@mit-prep)
@@ -1522,10 +1521,10 @@
* sendmail.el (mail-do-fcc):
Do cretinous unix ">" `quoting' of "\nFrom " strings
- (this isn't transparent, but it's what other stupid programs expect)
+ (this isn't transparent, but it's what other stupid programs expect).
* mailalias.el (expand-mail-aliases):
- Hack case-fold-search as appropriate
+ Hack case-fold-search as appropriate.
1985-10-21 Richard M. Stallman (rms@mit-prep)
@@ -1570,7 +1569,7 @@
* sendmail.el:
Use new var mail-header-separator in place of constant --text...
- (mail-setup): fill the To and Cc text inserted.
+ (mail-setup): Fill the To and Cc text inserted.
Assume <...> constructs were handled by mail-strip-quoted-names.
(mail-fill-yanked-message): Add this and put on C-c q.
(mail-mode): Set up mail-mode-map when file is loaded.
@@ -1617,9 +1616,9 @@
* rnews.el (news-save-item-in-file):
Append to file, rather than overwriting.
- * isearch.el
+ * isearch.el:
Eliminate confused attempts at indicating that long isearch was
- `in progress'
+ `in progress'.
1985-10-15 Richard M. Stallman (rms@mit-prep)
@@ -1651,7 +1650,7 @@
1985-10-15 Richard Mlynarik (mly@mit-prep)
- * bytecomp.el (byte-compile-find-vars-1)
+ * bytecomp.el (byte-compile-find-vars-1):
Fix paren error.
1985-10-15 Richard M. Stallman (rms@mit-prep)
@@ -1786,7 +1785,6 @@
Initialize the local map when the file is loaded,
not when mode is invoked.
-
1985-10-04 Richard M. Stallman (rms@mit-prep)
* indent.el (indent-relative-maybe):
@@ -1810,12 +1808,12 @@
1985-10-03 Richard Mlynarik (mly@mit-prep)
- * simple.el
- Functions quit, keyboard-quit
+ * simple.el:
+ Functions quit, keyboard-quit.
* isearch.el:
"I-searching: foo..." in the middle of possibly lengthy
- search
+ search.
* files.el (set-auto-mode):
Don't hack auto-mode-alist at all if -*- mode -*- is specified.
@@ -2019,7 +2017,7 @@
1985-09-03 Richard Mlynarik (mly@mit-prep)
- * macros.el (kbd-macro-query)
+ * macros.el (kbd-macro-query):
Barf if not defining or executing keyboard macro.
1985-09-02 Richard M. Stallman (rms@mit-prep)
@@ -2052,7 +2050,7 @@
1985-08-31 Richard Mlynarik (mly@mit-prep)
- * simple.el (delete-indentation)
+ * simple.el (delete-indentation):
Don't err if on first line of buffer.
1985-08-30 Richard M. Stallman (rms@mit-prep)
@@ -2062,7 +2060,7 @@
1985-08-26 Richard Mlynarik (mly@mit-prep)
- * shell.el
+ * shell.el:
Sending empty line of input at the end of a buffer that is an
interaction with a promptless shell program copied previous input
rather than sending an empty line.
@@ -2070,46 +2068,46 @@
1985-08-20 Richard Mlynarik (mly@mit-prep)
- * dired.el, files.el, sendmail.el, compile.el
+ * dired.el, files.el, sendmail.el, compile.el:
Make *-other-window really do other window even if pop-up-windows
is set to nil.
1985-08-17 Richard Mlynarik (mly@mit-prep)
- * c-mode.el (c-indent-line)
+ * c-mode.el (c-indent-line):
Make "^[ \t]*#" indent to 0 (if not in string or comment)
- * startup.el (command-line)
+ * startup.el (command-line):
(or (getenv "USER") (getenv "LOGNAME")) for USG compatibility
(consider it a standard)
- * lpr.el
+ * lpr.el:
Typo (``format1'' for ``format'')
1985-08-12 Richard Mlynarik (mly@mit-prep)
- * buff-menu.el (Buffer-menu-buffer)
+ * buff-menu.el (Buffer-menu-buffer):
Win more often on `too-long' buffer names.
1985-08-11 Richard Mlynarik (mly@mit-prep)
- * make narrow-to-page be disabled by default.
+ * Make narrow-to-page be disabled by default.
- * rmail.el (rmail-insert-inbox-text)
- Hack case that /usr/spool/mail/user is a directory
+ * rmail.el (rmail-insert-inbox-text):
+ Hack case that /usr/spool/mail/user is a directory.
1985-08-10 Richard Mlynarik (mly@mit-prep)
- * isearch.el (isearch)
- Make isearch work in regexp case
+ * isearch.el (isearch):
+ Make isearch work in regexp case.
1985-08-09 Richard Mlynarik (mly@mit-prep)
- * c-mode.el (c-comment-indent)
- Return a valid value when used within a comment.
- (such as when indenting when comment-multi-line is non-nil)
+ * c-mode.el (c-comment-indent):
+ Return a valid value when used within a comment
+ (such as when indenting when comment-multi-line is non-nil).
Associated changes to
- c-indent-line, c-calculate-indent-within-comment
+ c-indent-line, c-calculate-indent-within-comment.
* debug.el (debug):
Use buffer "*Backtrace*", not " *Backtrace*" so that users can
@@ -2117,89 +2115,88 @@
Kill the buffer on exit so that users aren't tempted to lose
weirdly.
Rename "args" "debugger-args" so that common var isn't lambda-bound.
-
- Make "-" be negative-argument in debugger-mode-map
+ Make "-" be negative-argument in debugger-mode-map.
* rnews.el (news-convert-format):
Don't lose on empty messages.
- * term-vt100.el, term-vt200.el
+ * term-vt100.el, term-vt200.el:
Make "application mode" arrow keys ("\eOA"... "\eOD") do the right
thing.
1985-08-06 Richard Mlynarik (mly@mit-prep)
- * c-mode.el
- calculate-c-indent was ignoring parse-start arg
+ * c-mode.el:
+ calculate-c-indent was ignoring parse-start arg.
Inserted jdf@prep.mit.edu's `else' indentation code
Make C-j be reindent-then-newline-and-indent to take advantage
of this.
- * simple.el
- Added function reindent-then-newline-and-indent
+ * simple.el:
+ Add function reindent-then-newline-and-indent.
- * rnews.el
- Fix typo and supply function news-show-all-headers
+ * rnews.el:
+ Fix typo and supply function news-show-all-headers.
- * startup.el
+ * startup.el:
Make the value of args be the remaining command-line
arguments after the "-e" function name when the "-e" function
is called.
Make "-f" be the same as "-e" --- it's in the manual.
- * bytecomp.el
- Added batch-byte-compile written by crl@newton.purdue.edu
+ * bytecomp.el:
+ Add batch-byte-compile written by crl@newton.purdue.edu.
- * isearch.el
+ * isearch.el:
Typing C-s/C-r at start of isearch wasn't displaying search
string until it had completed the search.
- * indent.el (indent-relative)
- Losing when indentation point was beneath non-whitespace
+ * indent.el (indent-relative):
+ Losing when indentation point was beneath non-whitespace.
* c-mode.el (indent-c-exp):
Replace "2" with "c-continued-statement-offset"
Add (message "...")
- * mlsupport.el
- Fix typo in ml-current-indent
- Make kill-to-end-of-line work
+ * mlsupport.el:
+ Fix typo in ml-current-indent.
+ Make kill-to-end-of-line work.
- * mlconvert.el
- Hack "(forward-word)" => "(forward-word 1)"
+ * mlconvert.el:
+ Hack "(forward-word)" => "(forward-word 1)".
1985-08-05 Richard Mlynarik (mly@mit-prep)
- * c-mode.el
+ * c-mode.el:
Variable "c-continued-statement-indent" should have been
- "c-continued-statement-offset" as in the documentation and manual
+ "c-continued-statement-offset" as in the documentation and manual.
* rmail.el (rmail-find):
Hack default of last search string, hack reverse search.
(-ve prefix arg):
- Make "-" be negative-argument
+ Make "-" be negative-argument.
1985-07-23 Richard Mlynarik (mly@mit-prep)
* shell.el (shell-send-input):
cd/pushd hackery wasn't substitute-in/expand-file-name'ing
- (ie "cd $es" was losing)
+ (ie "cd $es" was losing).
1985-07-16 Richard Mlynarik (mly@mit-prep)
* view.el:
Add "c-x ]" and "c-x [" page-movement commands
- "c-x /" "c-x j" register save/jump
+ "c-x /" "c-x j" register save/jump.
Speed up more losingly slow calls to substitute-command-keys by
conditional substitution of constant string.
(view-helpful-message, view-undefined, view-mode-command-loop)
- * mail-utils.el
+ * mail-utils.el:
rmail-dont-reply-to was losing on multi-line fields.
- * simple.el
+ * simple.el:
delete-blank-lines was deleting too much if on an isolated blank line.
1985-07-12 Richard M. Stallman (rms@mit-prep)
@@ -2222,7 +2219,7 @@
1985-07-10 Richard Mlynarik (mly@mit-prep)
- * ebuff-menu.el (Electric-buffer-menu-undefined)
+ * ebuff-menu.el (Electric-buffer-menu-undefined):
Don't call substitute-command-keys if keybindings are default,
with resultant couple-of-orders-of-magnitude speedup.
RMS: this is what my changes to Fsubstitute_command_keys in doc.c
@@ -2385,8 +2382,8 @@
* compile.el (compile1.el):
If *compilation* is current buffer, put point at end.
- * simple.el (indent-for-comment, kill-comment, set-comment-column,
- indent-new-comment-line): use comment-start-skip to find comments.
+ * simple.el (indent-for-comment, kill-comment, set-comment-column)
+ (indent-new-comment-line): Use comment-start-skip to find comments.
Don't use find-comment-line any more.
* lisp-mode.el, c-mode.el, scheme.el, mim-mode.el:
@@ -2554,8 +2551,8 @@
1985-06-12 Richard Mlynarik (mly@mit-prep)
- * rmail (rmail-insert-inbox-text)
- file-name-directory includes a trailing "/"
+ * rmail (rmail-insert-inbox-text):
+ file-name-directory includes a trailing "/".
1985-06-12 K. Shane Hartman (shane@mit-prep)
@@ -2686,7 +2683,7 @@
describing help options. Add `v' command for viewing buffer and
returning to the Electric Buffer List.
- * loaddefs.el: autoload edit-picture.
+ * loaddefs.el: Autoload edit-picture.
* picture.el: New "Major" mode for editing pictures and tables.
@@ -2731,7 +2728,7 @@
* sendmail.el (sendmail-send-it):
Somewhat gratuitously deleting empty subject lines.
- /usr/lib/sendmail seems smart enough (!) to hack this itself
+ /usr/lib/sendmail seems smart enough (!) to hack this itself.
1985-06-04 K. Shane Hartman (shane@mit-prep)
@@ -2798,7 +2795,7 @@
Process exec-directory using expand-file-name
so as not to depend on whether it ends in /.
- * simple.el: define turn-on-auto-fill.
+ * simple.el: Define turn-on-auto-fill.
1985-06-01 K. Shane Hartman (shane@mit-prep)
@@ -2823,7 +2820,7 @@
1985-06-01 Richard M. Stallman (rms@mit-prep)
- * Many files: put in \\[...] where appropriate.
+ * Many files: Put in \\[...] where appropriate.
1985-06-01 K. Shane Hartman (shane@mit-prep)
@@ -2862,16 +2859,16 @@
1985-05-30 Richard Mlynarik (mly@mit-prep)
- * sendmail.el
- Typo made sendmail-send-it lose when mail-interactive
+ * sendmail.el:
+ Typo made sendmail-send-it lose when mail-interactive.
- * simple.el
+ * simple.el:
Aborting out of octal read in read-quoted-char restarts
"from the top."
- * startup.el
+ * startup.el:
Catch another place where \\[..] was needed
- Don't insert copyright info if noninteractive
+ Don't insert copyright info if noninteractive.
1985-05-30 K. Shane Hartman (shane@mit-prep)
@@ -2913,22 +2910,22 @@
* Rename some files so all .el & .elc file names are <= 14 chars.
syntax-check-mim.el => mim-syntax.el (change in mim-mode.el too).
new-version-level.el => grow-vers.el.
- scheme-mode.el => scheme.el
- compare-windows.el => compare-w.el
- electric-buffer-list.el => ebuff-menu.el
+ scheme-mode.el => scheme.el.
+ compare-windows.el => compare-w.el.
+ electric-buffer-list.el => ebuff-menu.el.
1985-05-28 Richard Mlynarik (mly@mit-prep)
- * simple.el (describe-function)
- bind enable-recursive-minibuffers to read fn name
- (useful when typing c-h f after m-esc)
+ * simple.el (describe-function):
+ Bind enable-recursive-minibuffers to read fn name
+ (useful when typing c-h f after m-esc).
- * files.el
- made create-file-buffer a lisp function (was in src/buffer.c)
+ * files.el:
+ Make create-file-buffer a lisp function (was in src/buffer.c).
- * electric-buffer-menu-mode.el
+ * electric-buffer-menu-mode.el:
If the first character typed is a space then quit, ie return to
- previous window/buffer configuration
+ previous window/buffer configuration.
1985-05-27 Richard M. Stallman (rms@mit-prep)
@@ -2967,30 +2964,30 @@
* lisp-mode.el:
Provide default definition of lisp-send-defun, to just get an error.
- * shell.el: rename lisp to run-lisp.
- * loaddefs.el: make run-lisp autoloading.
+ * shell.el: Rename lisp to run-lisp.
+ * loaddefs.el: Make run-lisp autoloading.
1985-05-23 Richard Mlynarik (mly@mit-prep)
- * files.el
+ * files.el:
FOO! Local-variables weren't working since hack-local-variables
- was searching for "\n^L" not "\n\^L"
+ was searching for "\n^L" not "\n\^L".
- * lisp-mode.el, loadup.el, startup.el
- renamed lisp-interaction-mode to elisp-interaction-mode
- Made elisp-mode call elisp-mode-hook, elisp-interaction-mode call
+ * lisp-mode.el, loadup.el, startup.el:
+ Rename lisp-interaction-mode to elisp-interaction-mode
+ Make elisp-mode call elisp-mode-hook, elisp-interaction-mode call
elisp-interaction-mode-hook. This will break people's init files!
- * loaddefs.el
- made ".lisp" suffixes get lisp mode. Toto, I don't think we're
+ * loaddefs.el:
+ Make ".lisp" suffixes get lisp mode. Toto, I don't think we're
using fourteen-character filenames anymore.
- Autoload scheme-mode
+ Autoload scheme-mode.
- * scheme-mode.el
- installed scheme-mode, courtesy MIT scheme people.
+ * scheme-mode.el:
+ Install scheme-mode, courtesy MIT scheme people.
- * lisp-mode.el
- made mode doc strings use \[...] substitute-command-keys technology
+ * lisp-mode.el:
+ Make mode doc strings use \[...] substitute-command-keys technology.
1985-05-23 Richard M. Stallman (rms@mit-prep)
@@ -3008,19 +3005,19 @@
1985-05-22 Richard Mlynarik (mly@mit-prep)
- * nrnews.el
+ * nrnews.el:
Foo. A distinct lack of communication here.
Fairly radical surgery --- many bug fixes and clarifications,
quite different from rnews.el Sigh
1985-05-22 K. Shane Hartman (shane@mit-prep)
- * view.el
+ * view.el:
Add new flavor of help. ?, h still give list of
commands. C-h understands m, c, k options. Make
help commands use pop up window with scroll on space.
- * loaddefs.el
+ * loaddefs.el:
Minor change for documentation of view-file and
view-buffer because C-h does not describe mode now.
@@ -3045,15 +3042,15 @@
1985-05-21 Richard Mlynarik (mly@mit-prep)
* mlsupport.el:
- Fix assorted typos where variable "bufname" was changed to "name"
+ Fix assorted typos where variable "bufname" was changed to "name".
- * view.el
+ * view.el:
Make M-<, M-> work. Fix documentation strings to work with the
combination of lisp quoting and substitute-command-keys quoting.
- * electric-buffer-list.el
+ * electric-buffer-list.el:
Call Buffer-menu-execute before selecting. (Why doesn't standard
- buffer-menu-mode do this?) Flush "x", "1" and "2" commands
+ buffer-menu-mode do this?) Flush "x", "1" and "2" commands.
* buff-menu.el:
Call bury-buffer after selecting new buffer.
@@ -3086,23 +3083,23 @@
1985-05-19 Richard Mlynarik (mly@mit-prep)
- * view.el, dired.el
- typos in viewing stuff
+ * view.el, dired.el:
+ Typos in viewing stuff.
- * simple.el, isearch.el
- Added prompt argument to read-quoted-char; improved isearch
+ * simple.el, isearch.el:
+ Add prompt argument to read-quoted-char; improve isearch
input echoing when reading quoted char.
- * sendmail.el, loaddefs.el
- added send-mail-function; initially sendmail-send-it
+ * sendmail.el, loaddefs.el:
+ Add send-mail-function; initially sendmail-send-it
(also, mail-yank-ignored-headers had a typo).
- * rmail.el (rmail-get-new-mail, convert-to-babyl-format, ...)
+ * rmail.el (rmail-get-new-mail, convert-to-babyl-format, ...):
* loaddefs.el:
Remodularize inbox parsing. Add support(?) for mmdf inboxes.
Note that I can't seem to define definitive documentation of
what this format is; however the code installed seems to work
- for all cases encountered
+ for all cases encountered.
1985-05-19 Richard M. Stallman (rms@mit-prep)
@@ -3130,15 +3127,15 @@
1985-05-17 Richard M. Stallman (rms@mit-prep)
* isearch.el:
- Preserve window-start on exit from save-window-excursion
+ Preserve window-start on exit from save-window-excursion.
1985-05-16 Richard M. Stallman (rms@mit-prep)
- * rmail.el: correct read-only suppression in rmail-new-summary.
+ * rmail.el: Correct read-only suppression in rmail-new-summary.
1985-05-16 K. Shane Hartman (shane@mit-prep)
- * loaddefs.el: Autoload more-mode, more-file, more-buffer.
+ * loaddefs.el: Autoload more-mode, more-file, more-buffer.
* more-mode.el: New tourist mode for files.
@@ -3149,7 +3146,7 @@
* simple.el: Make <help> i run info.
- * sundry changes to go with changes in src/fileio.c making
+ * Sundry changes to go with changes in src/fileio.c making
copy-file, rename-file, add-name take an optional third argument.
The only autoloaded system code this breaks is rmail ---
a condition-case for wrong-number-of-arguments kludge was installed
@@ -3158,7 +3155,7 @@
to remove the kludge at that time!
Mods to files.el, loadup.el, rmail.el.
- * added autoloading function electric-buffer-list.
+ * Add autoloading function electric-buffer-list.
* buff-menu.el: Make splitting screen between > 2 buffers work.
@@ -3184,7 +3181,7 @@
* inc-version.el: Kill Emacs at the end.
- * simple.el: fixed overflow problem in what-cursor-position.
+ * simple.el: Fix overflow problem in what-cursor-position.
* startup.el: Don't print a help message if noninteractive.
@@ -3247,7 +3244,7 @@
Set current buffer variables from defaults
in case user's init file has changed them.
- Copyright (C) 1985-1986, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10
index d6ac498c877..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.
@@ -23534,7 +23534,7 @@ See ChangeLog.9 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.11 b/lisp/ChangeLog.11
index dd1d113d665..8ea7d40c004 100644
--- a/lisp/ChangeLog.11
+++ b/lisp/ChangeLog.11
@@ -7234,7 +7234,7 @@
2004-05-10 Miles Bader <miles@gnu.org>
- * lisp/progmodes/gud.el (gud-common-init): Only consider an existing
+ * progmodes/gud.el (gud-common-init): Only consider an existing
buffer an error if the debugger process is actually running.
2004-05-10 Juanma Barranquero <lektu@terra.es>
@@ -7529,7 +7529,7 @@
2004-05-03 Michael Mauger <mmaug@yahoo.com>
- * emacs/lisp/progmodes/sql.el (sql-xemacs-p, sql-emacs19-p)
+ * progmodes/sql.el (sql-xemacs-p, sql-emacs19-p)
(sql-emacs20-p): Remove.
(sql-mode-syntax-table): Use shared GNU Emacs/XEmacs syntax.
(sql-builtin-face, sql-doc-face): Remove.
@@ -10889,7 +10889,7 @@
2004-01-29 Jari Aalto <jari.aalto@poboxes.com>
* progmodes/executable.el (executable-command-find-posix-p):
- New. Check if find handles arguments Posix-style.
+ New. Check if find handles arguments POSIX-style.
* progmodes/grep.el (grep-compute-defaults):
Use executable-command-find-posix-p.
diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12
index 55335533b7a..2361528abb3 100644
--- a/lisp/ChangeLog.12
+++ b/lisp/ChangeLog.12
@@ -12449,7 +12449,7 @@
* calendar/appt.el (diary-selective-display): Add defvar.
- * sort.el (sort-columns): Use Posix arg syntax for `sort'.
+ * sort.el (sort-columns): Use POSIX arg syntax for `sort'.
* isearch.el (search-whitespace-regexp): Fix custom type.
@@ -33346,7 +33346,7 @@ See ChangeLog.11 for earlier changes.
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 2005-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13
index 558718a5a5f..58fb2d541d9 100644
--- a/lisp/ChangeLog.13
+++ b/lisp/ChangeLog.13
@@ -1121,10 +1121,10 @@
* international/titdic-cnv.el (tit-process-header): Fix embedded
coding tag.
(titdic-convert): Bind coding-system-for-write to the coding
- system specfied in the map file. Remove `charset' property after
+ system specified in the map file. Remove `charset' property after
decoding.
(miscdic-convert): Bind coding-system-for-write to the coding
- system specfied for the map file. Fix LANGUAGE arg to
+ system specified for the map file. Fix LANGUAGE arg to
quail-define-package.
(batch-miscdic-convert): Check if a file is directory or not.
@@ -16697,7 +16697,7 @@ See ChangeLog.12 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2007-2011 Free Software Foundation, Inc.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14
index 5620b90a3f4..be50fc46672 100644
--- a/lisp/ChangeLog.14
+++ b/lisp/ChangeLog.14
@@ -569,7 +569,7 @@
* emacs-lisp/lisp-mode.el: Give `deftype' a doc-string-elt
property (Bug#2984).
-2009-04-16 Leo <sdl.web@gmail.com> (tiny change)
+2009-04-16 Leo Liu <sdl.web@gmail.com> (tiny change)
* ediff-wind.el (ediff-make-wide-display): Fix typo in frame
parameter alist.
@@ -604,7 +604,7 @@
* help-at-pt.el (help-at-pt-kbd-string): Reflow docstring.
(scan-buf-previous-region): Fix typo in docstring.
-2009-04-14 Edward Wiebe <usenet@pusto.de> (tiny change)
+2009-04-14 Eduard Wiebe <usenet@pusto.de> (tiny change)
* jit-lock.el (jit-lock-stealth-chunk-start): Fix typo in docstring.
@@ -1041,7 +1041,7 @@
* mail/supercite.el (sc-version): Doc fix.
-2009-03-19 Leo <sdl.web@gmail.com> (tiny change)
+2009-03-19 Leo Liu <sdl.web@gmail.com> (tiny change)
* mail/supercite.el (sc-version): Fix typo in interactive spec.
@@ -7114,7 +7114,7 @@
vc-default-mark-resolved.
(vc-default-mark-resolved): Change to an alias for ignore.
-2008-09-24 Andreas Politz <politza@fh-trier.de> (tiny change)
+2008-09-24 Andreas Politz <politza@fh-trier.de>
* term.el (term-emulate-terminal): Encode input string before
checking its length.
@@ -20551,7 +20551,7 @@ See ChangeLog.13 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index 6e13c1156ce..83657a98bfd 100644
--- a/lisp/ChangeLog.15
+++ b/lisp/ChangeLog.15
@@ -288,7 +288,7 @@
* emacs-lisp/ewoc.el (ewoc-goto-next): Give a more explicit error
if there is no node. (Bug#3261)
-2011-03-04 Leo <sdl.web@gmail.com>
+2011-03-04 Leo Liu <sdl.web@gmail.com>
* vc/diff-mode.el (diff-mode): Fix whitespace-style. (Bug#8139)
@@ -779,9 +779,9 @@
2011-02-17 Ken Manheimer <ken.manheimer@gmail.com>
- * lisp/allout-widgets.el (allout-widgets-icons-light-subdir)
+ * allout-widgets.el (allout-widgets-icons-light-subdir)
(allout-widgets-icons-dark-subdir): Track relocations of icons.
- * lisp/allout.el: Remove commentary about remove encryption
+ * allout.el: Remove commentary about remove encryption
passphrase mnemonic support and verification.
(allout-encrypt-string): Recognize epg failure to decrypt gpg2
armored text using gpg1, and indicate that the gpg version *might*
@@ -866,7 +866,7 @@
* net/soap-client.el:
* net/soap-inspect.el: New files.
-2011-02-16 Leo <sdl.web@gmail.com>
+2011-02-16 Leo Liu <sdl.web@gmail.com>
* dired-x.el (dired-mode-map, dired-extra-startup):
Remove dired-copy-filename-as-kill since it's already in dired.el.
@@ -1586,7 +1586,7 @@
* vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch):
Callers changed.
-2011-01-28 Leo <sdl.web@gmail.com>
+2011-01-28 Leo Liu <sdl.web@gmail.com>
* emacs-lisp/advice.el (ad-make-advised-docstring): Don't apply
highlighting to the "this function is advised" message.
@@ -2668,7 +2668,7 @@
* mail/rmail.el (rmail-show-message-1): If rmail-enable-mime is
non-nil, handle the header in rmail-show-mime-function.
-2011-01-02 Leo <sdl.web@gmail.com>
+2011-01-02 Leo Liu <sdl.web@gmail.com>
* help-fns.el (describe-variable): Fix previous change.
@@ -2699,7 +2699,7 @@
* mail/smtpmail.el (smtpmail-send-it): Write queued mail body with
Unix EOLs. (Bug#7589)
-2011-01-02 Leo <sdl.web@gmail.com>
+2011-01-02 Leo Liu <sdl.web@gmail.com>
* eshell/em-hist.el (eshell-previous-matching-input): Signal error
if point is not behind eshell-last-output-end (Bug#7585).
@@ -2867,7 +2867,7 @@
* obsolete/pgg-gpg.el, obsolete/pgg-def.el, obsolete/pgg.el:
Move from lisp/.
-2010-12-20 Leo <sdl.web@gmail.com>
+2010-12-20 Leo Liu <sdl.web@gmail.com>
* dnd.el (dnd-get-local-file-name): Unhex of file name shall
always be performed (Bug#7680).
@@ -2953,7 +2953,7 @@
* epa-file.el (epa-file-select-keys): Accept 'silent to inhibit
key selection prompt; make 'silent as default (Bug#7487).
-2010-12-16 Leo <sdl.web@gmail.com>
+2010-12-16 Leo Liu <sdl.web@gmail.com>
* eshell/eshell.el (eshell-directory-name):
Use locate-user-emacs-file (Bug#7578).
@@ -3081,7 +3081,7 @@
* diff-mode.el (diff-refine-hunk): Make it work when the hunk contains
empty lines without a leading space.
-2010-12-13 Leo <sdl.web@gmail.com>
+2010-12-13 Leo Liu <sdl.web@gmail.com>
* dired-aux.el (dired-do-redisplay): Postpone dired-after-readin-hook
while mapping over marks (Bug#6810).
@@ -3155,7 +3155,7 @@
(rmail-search-mime-message-function): Set to
rmail-search-mime-message.
-2010-12-13 Leo <sdl.web@gmail.com>
+2010-12-13 Leo Liu <sdl.web@gmail.com>
* ido.el (ido-common-initialization): New function. (bug#3274)
(ido-mode): Use it.
@@ -4990,7 +4990,7 @@
(minibuffer-force-complete): Set completion-cycling.
(completion-all-sorted-completions): Move declaration before first use.
-2010-10-28 Leo <sdl.web@gmail.com>
+2010-10-28 Leo Liu <sdl.web@gmail.com>
* iswitchb.el (iswitchb-kill-buffer): Avoid `iswitchb-make-buflist'
which changes the order of matches seen by users (bug#7231).
@@ -5279,7 +5279,7 @@
(set-cursor-color, set-mouse-color, set-border-color):
Use read-color.
-2010-10-24 Leo <sdl.web@gmail.com>
+2010-10-24 Leo Liu <sdl.web@gmail.com>
* eshell/em-unix.el (eshell-remove-entries): Use the TRASH
argument of delete-file and delete-directory (Bug#7011).
@@ -5876,7 +5876,7 @@
* vc-svn.el (vc-svn-merge-news): Use --non-interactive. (Bug#7152)
-2010-10-08 Leo <sdl.web@gmail.com>
+2010-10-08 Leo Liu <sdl.web@gmail.com>
* dnd.el (dnd-get-local-file-name): If MUST-EXIST is non-nil, only
return non-nil if the file exists (Bug#7090).
@@ -7038,7 +7038,7 @@
* subr.el (y-or-n-p): New function, moved from src/fns.c; use read-key.
-2010-09-12 Leo <sdl.web@gmail.com>
+2010-09-12 Leo Liu <sdl.web@gmail.com>
* net/rcirc.el (rcirc-server-commands, rcirc-client-commands)
(rcirc-completion-start): New variables.
@@ -7961,7 +7961,7 @@
* startup.el (command-line-1): Issue warning for ignored arguments
--unibyte, etc (Bug#6886).
-2010-08-22 Leo <sdl.web@gmail.com>
+2010-08-22 Leo Liu <sdl.web@gmail.com>
* net/rcirc.el (rcirc-add-or-remove): Accept a list of elements.
(ignore, bright, dim, keyword): Split list of nicknames before
@@ -7971,7 +7971,7 @@
* emacs-lisp/easy-mmode.el (define-minor-mode): Doc fix (Bug#6880).
-2010-08-22 Leo <sdl.web@gmail.com>
+2010-08-22 Leo Liu <sdl.web@gmail.com>
Fix buffer-list rename&refresh after killing a buffer in ido.
* ido.el: Revert Óscar's.
@@ -8429,7 +8429,7 @@
* emacs-lisp/syntax.el (syntax-ppss-toplevel-pos):
Fix typo in docstring (bug#6747).
-2010-08-08 Leo <sdl.web@gmail.com>
+2010-08-08 Leo Liu <sdl.web@gmail.com>
* eshell/esh-io.el (eshell-get-target): Better detection of
read-only file (Bug#6762).
@@ -8535,7 +8535,7 @@
(tramp-handle-start-file-process): Use it, in order to invalidate
file caches.
-2010-08-03 Leo <sdl.web@gmail.com>
+2010-08-03 Leo Liu <sdl.web@gmail.com>
* server.el (server-start): Simplify loop.
@@ -9023,7 +9023,7 @@
* bookmark.el (bookmark-show-annotation): Use `when' instead of `if'.
This is also from Thierry Volpiatto's patch in bug #6444. However,
because it was extraneous to the functional change in that patch,
- and causes a re-indendation, I am committing it separately.
+ and causes a re-indentation, I am committing it separately.
2010-07-13 Thierry Volpiatto <thierry.volpiatto@gmail.com>
@@ -9336,7 +9336,7 @@
* xml.el (xml-parse-region): Avoid infloop (Bug#5281).
-2010-06-29 Leo <sdl.web@gmail.com>
+2010-06-29 Leo Liu <sdl.web@gmail.com>
* emacs-lisp/rx.el (rx): Doc fix. (Bug#6537)
@@ -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.
@@ -14934,7 +14934,7 @@
* woman.el (woman-make-bufname): Handle man-pages with "." in the
name. (Bug#5038)
-2009-12-02 Andreas Politz <politza@fh-trier.de> (tiny change)
+2009-12-02 Andreas Politz <politza@fh-trier.de>
* ido.el (ido-file-internal): Handle filenames at point that do
not have a directory part. (Bug#5049)
@@ -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.
@@ -17621,7 +17621,7 @@
(batch-update-autoloads): Handle autoload-excludes on windows-nt.
* mail/rmailedit.el (rmail-cease-edit): Give an error if the end of
- the headers cannot be located. Simplify, subtracting superflous
+ the headers cannot be located. Simplify, subtracting superfluous
save-excursions.
2009-10-15 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -19360,7 +19360,7 @@
* eshell/em-dirs.el (eshell-complete-user-reference):
Declare pcomplete functions and variables to avoid compiler warnings.
-2009-09-13 Leo <sdl.web@gmail.com> (tiny change)
+2009-09-13 Leo Liu <sdl.web@gmail.com> (tiny change)
* eshell/em-script.el (eshell-login-script, eshell-rc-script):
* eshell/em-dirs.el (eshell-last-dir-ring-file-name):
@@ -19488,7 +19488,7 @@
(elint-log-message): Add optional argument. Use elint-output.
(elint-set-mode-line): New function.
-2009-09-12 Andreas Politz <politza@fh-trier.de> (tiny change)
+2009-09-12 Andreas Politz <politza@fh-trier.de>
* emacs-lisp/elp.el (elp-not-profilable): Add more
functions (Bug#4233).
@@ -19823,7 +19823,7 @@
* files.el (locate-file-completion-table): Make it provide boundary
information, so partial-completion works better.
-2009-09-04 Leo <sdl.web@gmail.com> (tiny change)
+2009-09-04 Leo Liu <sdl.web@gmail.com> (tiny change)
* mail/footnote.el (Footnote-text-under-cursor):
Check footnote-text-marker-alist before using it (bug#4324).
@@ -22792,7 +22792,7 @@ See ChangeLog.14 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2009-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.2 b/lisp/ChangeLog.2
index 957c9c7deff..3c3979f22cf 100644
--- a/lisp/ChangeLog.2
+++ b/lisp/ChangeLog.2
@@ -56,7 +56,7 @@
buffer or file has changed.
* abbrev.el: Doc fix.
- * files.el:
+ * files.el: ???
1988-08-03 Robert J. Chassell (bob@frosted-flakes.ai.mit.edu)
@@ -454,7 +454,7 @@
1988-04-09 Leonard H. Tower Jr. (tower@frosted-flakes.ai.mit.edu)
- * rnewspost.el (news-post-news, news-reply) No longer re-inits
+ * rnewspost.el (news-post-news, news-reply): No longer re-inits
*post-news* buffer, if buffer-modified-p.
1988-04-09 Richard Stallman (rms@frosted-flakes.ai.mit.edu)
@@ -852,7 +852,7 @@
* lisp-mode.el (eval-print-last-sexp):
* debug.el (debugger-mode):
* chistory.el (Command-history-setup):
- * options.el (Edit-options-mode):
+ * options.el (Edit-options-mode): ???
1987-12-01 Richard Stallman (rms@frosted-flakes)
@@ -1116,7 +1116,7 @@
1987-06-08 Richard M. Stallman (rms@prep)
- * version 18.46 released.
+ * Version 18.46 released.
* isearch.el (isearch): Typo (3 should be 2) in getting old
start-point in reverse regexp search made more liberal.
@@ -1131,7 +1131,7 @@
1987-05-31 Richard M. Stallman (rms@prep)
- * version 18.45.
+ * Version 18.45.
* informat.el (Info-split): Bind case-fold-search to t.
@@ -1319,7 +1319,7 @@
1987-04-15 Paul Rubin (phr@prep)
- * version 18.44 released.
+ * Version 18.44 released.
1987-04-14 Richard Mlynarik (mly@prep)
@@ -1910,7 +1910,7 @@
1987-01-16 Richard Mlynarik (mly@prep)
- * rmail.el (rmail-count-new-messages),
+ * rmail.el (rmail-count-new-messages):
* rmailout.el (rmail-output-to-rmail-file):
Add optional arg `nomsg' to former, which latter supplies,
so that rmail doesn't report counting one appended message.
@@ -2397,7 +2397,7 @@
1986-11-23 Richard M. Stallman (rms@prep)
- * version 18.31 released.
+ * Version 18.31 released.
* x-mouse.el: New mouse-command keys are C-x C-@.
@@ -2482,7 +2482,7 @@
1986-11-14 Richard M. Stallman (rms@prep)
- * Emacs version 18.30 *
+ * Emacs version 18.30.
* rmail.el (rmail-forward):
Use mail-other-window unless there is only one window visible.
@@ -2624,8 +2624,8 @@
1986-11-04 Richard M. Stallman (rms@prep)
- * various files (dired-mode, Edit-options-mode, rmail-mode,
- rmail-summary-mode, rmail-edit-mode, Buffer-menu-mode):
+ * various files (dired-mode, Edit-options-mode, rmail-mode)
+ (rmail-summary-mode, rmail-edit-mode, Buffer-menu-mode):
Give these symbols `special' as a `mode-class' property.
* dired.el (dired-mode): Take out local value for
@@ -3992,7 +3992,7 @@
See ChangeLog.1 for earlier changes.
- Copyright (C) 1986-1988, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1986-1988, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.3 b/lisp/ChangeLog.3
index e0f9bc9ade2..f23b1199a4e 100644
--- a/lisp/ChangeLog.3
+++ b/lisp/ChangeLog.3
@@ -533,7 +533,7 @@
1993-05-16 Richard Stallman (rms@geech.gnu.ai.mit.edu)
- * gnus.el, gnuspost.el, gnusmail.el, gnusmisc.el
+ * gnus.el, gnuspost.el, gnusmail.el, gnusmisc.el,
* nntp.el, nnspool.el, mhspool.el: Version 3.15 from Umeda.
* frame.el (toggle-scroll-bar): Renamed from toggle-vertical-scroll...
@@ -762,8 +762,8 @@
Fail more gracefully if we can't build bold, italic, etc,
versions of the default font.
- * faces.el (make-face-bold, make-face-italic,
- make-face-bold-italic, make-face-unbold, make-face-unitalic):
+ * faces.el (make-face-bold, make-face-italic)
+ (make-face-bold-italic, make-face-unbold, make-face-unitalic):
Implement NOERROR argument.
(x-initialize-frame-faces): Use the NOERROR argument to the
font manipulation functions to avoid errors while starting up.
@@ -1772,8 +1772,8 @@
1993-03-24 Jim Blandy (jimb@geech.gnu.ai.mit.edu)
- * calendar.el (calendar-standard-time-zone-name,
- calendar-daylight-time-zone-name): Initialize these at load-time,
+ * calendar.el (calendar-standard-time-zone-name)
+ (calendar-daylight-time-zone-name): Initialize these at load-time,
as well as calendar-time-zone.
* calendar.el (calendar-time-zone): Fix code which initializes
@@ -1827,7 +1827,7 @@
* help.el, register.el, replace.el, reposition.el, rfc822.el,
* rlogin.el, rot13.el, scribe.el, scroll-bar.el, sendmail.el,
* setenv.el, sgml-mode.el, simple.el, simula.el, sort.el, spell.el,
- * spook.el, studly.el, tabify.el, text-mode.el: Added or corrected
+ * spook.el, studly.el, tabify.el, text-mode.el: Add or correct
Commentary headers.
1993-03-22 Edward M. Reingold (reingold@emr.cs.uiuc.edu)
@@ -1840,7 +1840,7 @@
* man.el, mlconvert.el, mlsupport.el, modula2.el, mouse.el,
* mpuz.el, netunam.el, novice.el, nroff-mode.el, options.el,
* outline.el, page.el, paragraphs.el, picture.el, prolog.el,
- * rect.el: Added or corrected Commentary sections.
+ * rect.el: Add or correct Commentary sections.
1993-03-22 Eric S. Raymond (eric@geech.gnu.ai.mit.edu)
@@ -1857,7 +1857,7 @@
* mail-utils.el, mailalias.el, makefile.el, makesum.el, mim-mode.el,
* modula2.el, nroff-mode.el, perl-mode.el, prolog.el, scheme.el,
* sgml-mode.el, tex-mode.el:
- Added or corrected Commentary sections. There's more of this
+ Add or correct Commentary sections. There's more of this
coming; soon, the package finder will be able to browse Commentary
sections, and I want almost all packages to have useful ones.
@@ -1972,7 +1972,7 @@
* cust-print.el, find-dired.el, etags.el, electric.el, dired.el,
* dired-aux.el, cust-print.el, cmuscheme.el, cmulisp.el, cl.el,
* case-table.el, byte-run.el, ange-ftp.el, backquote.el:
- Added or corrected library header comments.
+ Add or correct library header comments.
1993-03-17 Eric S. Raymond (eric@mole.gnu.ai.mit.edu)
@@ -2186,8 +2186,8 @@
1993-03-10 Edward M. Reingold (reingold@emr.cs.uiuc.edu)
- * diary-insert.el (insert-anniversary-diary-entry,
- insert-block-diary-entry): Fix calendar-date-display-form used.
+ * diary-insert.el (insert-anniversary-diary-entry)
+ (insert-block-diary-entry): Fix calendar-date-display-form used.
1993-03-10 Jim Blandy (jimb@totoro.cs.oberlin.edu)
@@ -2383,8 +2383,8 @@
nonexistent function last-month-of-hebrew-year to the correct
function hebrew-calendar-last-month-of-year.
- * cal-mayan.el (calendar-mayan-haab-on-or-before,
- calendar-mayan-tzolkin-on-or-before): Change `mod' to `%'.
+ * cal-mayan.el (calendar-mayan-haab-on-or-before)
+ (calendar-mayan-tzolkin-on-or-before): Change `mod' to `%'.
* cal-mayan.el (calendar-next-tzolkin-date): Delete bogus second
defun.
@@ -2857,8 +2857,8 @@
* ehelp.el (electric-help-command-loop): Same.
* electric.el (Electric-command-loop): Same.
* emerge.el (emerge-show-file-name): Same.
- * fortran.el (fortran-abbrev-start,
- fortran-window-create-momentarily): Same.
+ * fortran.el (fortran-abbrev-start)
+ (fortran-window-create-momentarily): Same.
* gnus.el (gnus-Subject-next-article): Same.
* info.el (Info-summary): Same.
* isearch-mode.el (isearch-update, isearch-unread): Same.
@@ -12438,7 +12438,7 @@ See ChangeLog.2 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1989, 1993, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1989, 1993, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.4 b/lisp/ChangeLog.4
index 51e2661d89e..64564626c46 100644
--- a/lisp/ChangeLog.4
+++ b/lisp/ChangeLog.4
@@ -124,7 +124,7 @@
* server.el (server-kill-emacs-query-function): Ignore killed buffers.
-1994-05-24 Kenneth Manheimer (ken.manheimer@nist.gov)
+1994-05-24 Ken Manheimer (ken.manheimer@nist.gov)
* allout.el (outline-chart-subtree): Include outline-next-
heading in loop conditions to detect end-of-buffer (and avoid
@@ -342,7 +342,7 @@
* startup.el (precompute-menubar-bindings): Don't precompute menus
if not using x.
-1994-05-12 Kenneth Manheimer (klm@coil.nist.gov)
+1994-05-12 Ken Manheimer (klm@coil.nist.gov)
* allout.el (outline-mode): Use outline-this-or-next-heading.
* allout.el (outline-this-or-next-heading): New function.
@@ -421,7 +421,7 @@
1994-05-10 Karl Heuer (kwzh@hal.gnu.ai.mit.edu)
- * ediff.el (ediff-no-help-in-control-buffer): Renamed from
+ * ediff.el (ediff-no-help-in-control-buffer): Rename from
ediff-nix-help-in-control-buffer, to match doc and usage.
* autoload.el (update-file-autoloads): Delete leftover variable.
@@ -517,7 +517,7 @@
* cal-menu.el (calendar-mouse-set-mark): New function.
(calendar-mouse-date-menu): Bind it to key.
-1994-05-08 Kenneth Manheimer (klm@coil.nist.gov)
+1994-05-08 Ken Manheimer (klm@coil.nist.gov)
* allout.el (outline-init): New user interface for control of
outline-mode session setup, sets up `outline-find-file-hook',
@@ -958,9 +958,9 @@
* files.el (revert-buffer): Widen before replacing text.
-1994-04-29 Kenneth Manheimer (ken.manheimer@nist.gov)
+1994-04-29 Ken Manheimer (ken.manheimer@nist.gov)
- * allout.el: major code speedups, bug fixes, behavior
+ * allout.el: Major code speedups, bug fixes, behavior
refinements, doc-string clarification and elaboration, etc.
Prominent new features include:
- Exposure changes and navigation are greatly accelerated.
@@ -1689,7 +1689,7 @@
* saveplace.el (save-place-find-file-hook)
(save-place-kill-emacs-hook): New functions.
- (hooks for find-file-hooks,kill-emacs-hook): Use those new functions.
+ (hooks for find-file-hooks, kill-emacs-hook): Use those new functions.
* menu-bar.el (clipboard-yank, clipboard-kill-ring-save)
(clipboard-kill-region): New functions. Give them
@@ -3114,32 +3114,32 @@
(calendar-cursor-to-date): Add optional parameter to cause error
signal when cursor is not on a date---this allows lots of
simplifications throughout the code.
- (calendar-forward-month,calendar-set-mark)
- (calendar-exchange-point-and-mark,calendar-count-days-region)
- (calendar-print-day-of-year,calendar-print-iso-date)
- (calendar-print-julian-date,calendar-print-islamic-date)
- (calendar-print-hebrew-date,calendar-print-astro-day-number):
+ (calendar-forward-month, calendar-set-mark)
+ (calendar-exchange-point-and-mark, calendar-count-days-region)
+ (calendar-print-day-of-year, calendar-print-iso-date)
+ (calendar-print-julian-date, calendar-print-islamic-date)
+ (calendar-print-hebrew-date, calendar-print-astro-day-number):
Use simplification.
* holidays.el (calendar-cursor-holidays): Use new error arg
to calendar-cursor-to-date.
- * diary.el (view-diary-entries,diary-islamic-date): Use new error arg
+ * diary.el (view-diary-entries, diary-islamic-date): Use new error arg
to calendar-cursor-to-date.
- * diary-ins.el (insert-diary-entry,insert-weekly-diary-entry)
- (insert-monthly-diary-entry,insert-yearly-diary-entry)
- (insert-anniversary-diary-entry,insert-block-diary-entry)
- (insert-cyclic-diary-entry,insert-hebrew-diary-entry)
- (insert-monthly-hebrew-diary-entry,insert-yearly-hebrew-diary-entry)
- (insert-islamic-diary-entry,insert-monthly-islamic-diary-entry)
+ * diary-ins.el (insert-diary-entry, insert-weekly-diary-entry)
+ (insert-monthly-diary-entry, insert-yearly-diary-entry)
+ (insert-anniversary-diary-entry, insert-block-diary-entry)
+ (insert-cyclic-diary-entry, insert-hebrew-diary-entry)
+ (insert-monthly-hebrew-diary-entry, insert-yearly-hebrew-diary-entry)
+ (insert-islamic-diary-entry, insert-monthly-islamic-diary-entry)
(insert-yearly-islamic-diary-entry): Use new error arg
to calendar-cursor-to-date.
* solar.el (calendar-sunrise-sunset): Use new error arg
to calendar-cursor-to-date.
- * cal-french.el (calendar-print-french-date,diary-french-date):
+ * cal-french.el (calendar-print-french-date, diary-french-date):
Use new error arg to calendar-cursor-to-date.
* cal-mayan.el (calendar-print-mayan-date): Use new error arg
@@ -3516,16 +3516,18 @@
(diary-entry-marker, calendar-today-marker)
(calendar-holiday-marker): Don't autoload them; change definitions
to support monochrome and color workstations.
- (calendar-french-date-string,calendar-mayan-date-string): Autoload them.
+ (calendar-french-date-string, calendar-mayan-date-string):
+ Autoload them.
(calendar-day-of-year-string, calendar-iso-date-string)
- (calendar-julian-date-string,calendar-islamic-date-string)
- (calendar-hebrew-date-string,calendar-astro-date-string): New functions.
+ (calendar-julian-date-string, calendar-islamic-date-string)
+ (calendar-hebrew-date-string, calendar-astro-date-string):
+ New functions.
(calendar-print-day-of-year, calendar-print-iso-date)
- (calendar-print-iso-date,calendar-print-julian-date)
- (calendar-print-islamic-date,calendar-print-hebrew-date)
+ (calendar-print-iso-date, calendar-print-julian-date)
+ (calendar-print-islamic-date, calendar-print-hebrew-date)
(calendar-print-astro-day-number): Use them.
(calendar-mode-map): Add mouse support.
- (calendar-unmark,mark-visible-calendar-date,calendar-mark-today):
+ (calendar-unmark, mark-visible-calendar-date, calendar-mark-today):
Rewritten.
* diary.el (diary-day-of-year, diary-iso-date, diary-islamic-date)
@@ -5896,8 +5898,8 @@
* loaddefs.el (ctl-x-map): `C-x r c' now runs `clear-rectangle'.
- * texinfmt.el (texinfo-format-region texinfo-format-buffer): Add
- ###autoload cookies.
+ * texinfmt.el (texinfo-format-region texinfo-format-buffer):
+ Add ###autoload cookies.
(batch-texinfo-format): Use `buffer-disable-undo' instead of
obsolete function `buffer-flush-undo'.
@@ -5916,8 +5918,8 @@
1993-08-26 Jim Blandy (blandy@comano.cscs.ch)
- * add-log.el (add-log-full-name, add-log-mailing-address): New
- variables.
+ * add-log.el (add-log-full-name, add-log-mailing-address):
+ New variables.
(add-change-log-entry): Don't ask for the login name and site name
separately; instead, prompt for a mailing address; that's more
useful. Set add-log-full-name and add-log-mailing-address, so
@@ -8760,8 +8762,8 @@
calendar-time-display-form): Change Universal Time (UT) to
Coordinated Universal Time (UTC).
- *solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
- Universal Time (UT) to Coordinated Universal Time (UTC).
+ * solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset):
+ Change Universal Time (UT) to Coordinated Universal Time (UTC).
(solar-time-string): Use calendar-daylight-time-offset instead of
1 hr, and use calendar-daylight-savings-switchover-time instead of
midnight. Add an optional parameter to allow forcing the use of
@@ -8936,7 +8938,7 @@ See ChangeLog.3 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.5 b/lisp/ChangeLog.5
index b3e92b1a50a..4de10683352 100644
--- a/lisp/ChangeLog.5
+++ b/lisp/ChangeLog.5
@@ -4501,7 +4501,7 @@
(reporter-status-message, reporter-status-count): New variables.
* reporter.el (reporter-update-status, reporter-beautify-list)
- reporter-dump-variable): Now smarter about formatting variables
+ (reporter-dump-variable): Now smarter about formatting variables
with list values. Checks the value of reporter-dont-compact-list.
1994-12-23 Richard Stallman <rms@mole.gnu.ai.mit.edu>
@@ -4732,8 +4732,8 @@
1994-12-18 Lawrence R. Dodd (dodd@roebling.poly.edu)
- * fortran.el (fortran-end-if, fortran-end-do,
- fortran-beginning-if, fortran-beginning-do): New subroutines.
+ * fortran.el (fortran-end-if, fortran-end-do)
+ (fortran-beginning-if, fortran-beginning-do): New subroutines.
(fortran-blink-matching-if, fortran-blink-matching-do): Use them.
(fortran-mark-do, fortran-mark-if): New user functions.
(fortran-blink-matching-if, fortran-mode): Doc mod.
@@ -5249,8 +5249,8 @@
1994-11-09 Francesco Potortì (pot@cnuce.cnr.it)
- * man.el (Man-berkeley-sed-script, Man-sysv-sed-script,
- Man-cleanup-manpage, Man-fontify-manpage): Handle the "+\bo" form
+ * man.el (Man-berkeley-sed-script, Man-sysv-sed-script)
+ (Man-cleanup-manpage, Man-fontify-manpage): Handle the "+\bo" form
(used by aix) in addition to the "o\b+" one (used by sun).
1994-11-09 Karl Heuer <kwzh@hal.gnu.ai.mit.edu>
@@ -5285,8 +5285,8 @@
1994-11-08 Ed Reingold <reingold@albert.gnu.ai.mit.edu>
- * calendar.el (diary-entry-marker, calendar-today-marker,
- calendar-holiday-marker): Don't supersede attributes for faces
+ * calendar.el (diary-entry-marker, calendar-today-marker)
+ (calendar-holiday-marker): Don't supersede attributes for faces
`diary-face', `calendar-display-face', or `holiday-face' if they
are already defined.
@@ -5341,7 +5341,7 @@
* bytecomp.el (byte-compile-insert-header): Escape backslashes
in FILENAME when putting it inside a string constant.
-1994-10-31 voelker <voelker@cs.washington.edu>
+1994-10-31 Geoff Voelker <voelker@cs.washington.edu>
* makefile.nt: New file.
@@ -5634,8 +5634,8 @@
1994-10-22 Roland McGrath <roland@churchy.gnu.ai.mit.edu>
- * dired-aux.el (dired-do-tags-search,
- dired-do-tags-query-replace): New functions.
+ * dired-aux.el (dired-do-tags-search, dired-do-tags-query-replace):
+ New functions.
* dired.el (dired-mode-map): Bind A to dired-do-tags-search, Q to
dired-do-tags-query-replace.
@@ -5665,8 +5665,8 @@
1994-10-20 Noah Friedman <friedman@splode.com>
- * timer.el (timer-error, timer-abnormal-termination,
- timer-filter-error): New error conditions.
+ * timer.el (timer-error, timer-abnormal-termination)
+ (timer-filter-error): New error conditions.
(timer-process-filter, timer-process-sentinel): Signal an error,
don't just print a message.
@@ -5707,8 +5707,8 @@
1994-10-19 Boris Goldowsky <boris@cs.rochester.edu>
- * facemenu.el (facemenu-face-menu, facemenu-foreground-menu,
- facemenu-background-menu, facemenu-special-menu): New or renamed
+ * facemenu.el (facemenu-face-menu, facemenu-foreground-menu)
+ (facemenu-background-menu, facemenu-special-menu): New or renamed
variables for submenus.
* facemenu.el (facemenu-color-alist): Renamed from facemenu-colors.
* facemenu.el (facemenu-add-new-face): New function.
@@ -5901,8 +5901,8 @@
(facemenu-add-face, facemenu-discard-redundant-faces): New functions.
* facemenu.el (facemenu-set-foreground, facemenu-set-background)
- (facemenu-get-face, facemenu-foreground, facemenu-background): New
- functions and variables. Faces with names of the form fg:color
+ (facemenu-get-face, facemenu-foreground, facemenu-background):
+ New functions and variables. Faces with names of the form fg:color
and bg:color are now treated specially.
(facemenu-update): Updated for above.
@@ -6168,10 +6168,10 @@
* comint.el (comint-check-proc): Recognize `open'.
(comint-exec): Use open-network-stream if command is a cons pair.
- * font-lock.el (compilation-mode-font-lock-keywords,
- rmail-summary-font-lock-keywords, dired-font-lock-keywords,
- shell-font-lock-keywords, texi-font-lock-keywords,
- perl-font-lock-keywords): Deleted.
+ * font-lock.el (compilation-mode-font-lock-keywords)
+ (rmail-summary-font-lock-keywords, dired-font-lock-keywords)
+ (shell-font-lock-keywords, texi-font-lock-keywords)
+ (perl-font-lock-keywords): Delete.
* sh-script.el (sh-font-lock-keywords): Default to nil.
@@ -6232,7 +6232,7 @@
(Man-filter-list, Man-original-frame, Man-arguments)
(Man-fontify-manpage-flag, Man-sections-alist, Man-refpages-alist)
(Man-uses-untabify-flag, Man-page-mode-string, Man-sed-script):
- Added defvar's to keep the compiler quiet.
+ Add defvar's to keep the compiler quiet.
(Man-getpage-in-background): Start buffer name with "*Man ".
instead of "*man " to avoid conflict with "*mail*".
(Man-match-substring): Defsubst moved before first call.
@@ -7016,7 +7016,7 @@
* vc-hooks.el (vc-file-not-found-hook): Use save-excursion.
-1994-09-18 Kenneth Manheimer (klm@coil.nist.gov)
+1994-09-18 Ken Manheimer (klm@coil.nist.gov)
* icomplete.el: Major rewrite to behave more like a minor mode.
Doc fixes.
@@ -7233,14 +7233,14 @@
1994-09-14 Boris Goldowsky <boris@cs.rochester.edu>
- * simple.el (repeat-complex-command, next-history-element,
- previous-matching-history-element): Override print-level when
+ * simple.el (repeat-complex-command, next-history-element)
+ (previous-matching-history-element): Override print-level when
offering command lines to edit.
1994-09-13 Karl Heuer <kwzh@hal.gnu.ai.mit.edu>
- * faces.el (make-face-unbold, make-face-unitalic, make-face-bold,
- make-face-italic, make-face-bold-italic): Don't try to frob font
+ * faces.el (make-face-unbold, make-face-unitalic, make-face-bold)
+ (make-face-italic, make-face-bold-italic): Don't try to frob font
if it's nil.
1994-09-11 Richard Stallman <rms@mole.gnu.ai.mit.edu>
@@ -7967,8 +7967,8 @@
Now accommodates buffer identifications generated by
mode-line.el and uniquify.el.
- * ediff.el (ediff-current-diff-face-A/B,
- ediff-fine-diff-face-A/B,ediff-odd/even-diff-face-A/B):
+ * ediff.el (ediff-current-diff-face-A/B)
+ (ediff-fine-diff-face-A/B, ediff-odd/even-diff-face-A/B):
Variables changed to contain face names
instead of face internal representation.
@@ -8048,7 +8048,7 @@
1994-07-23 enami tsugutomo <enami@sys.ptg.sony.co.jp>
- * lisp/add-log.el (add-log-current-defun): Skip doc string
+ * add-log.el (add-log-current-defun): Skip doc string
correctly even if it ends with line that starts space.
1994-07-22 Ed Reingold <reingold@albert.gnu.ai.mit.edu>
@@ -8714,9 +8714,9 @@
1994-06-22 Noah Friedman (friedman@splode.com)
- * rsz-mini.el (resize-minibuffer-window-exactly,
- resize-minibuffer-frame, resize-minibuffer-frame-exactly): Doc
- fixes.
+ * rsz-mini.el (resize-minibuffer-window-exactly)
+ (resize-minibuffer-frame, resize-minibuffer-frame-exactly):
+ Doc fixes.
(resize-minibuffer-frame-exactly): Make default t.
(resize-minibuffer-frame-original-height): New variable.
(resize-minibuffer-setup): Set it locally in the minibuffer.
@@ -8912,8 +8912,8 @@
1994-06-17 Roland McGrath (roland@geech.gnu.ai.mit.edu)
- * etags.el (tags-table-computed-list,
- tags-table-computed-list-for): New variables.
+ * etags.el (tags-table-computed-list)
+ (tags-table-computed-list-for): New variables.
(tags-table-list-pointer, tags-table-list-started-at): Doc fixes.
(tags-table-parent-pointer-list): Variable removed.
(tags-table-check-computed-list, tags-table-extend-computed-list): New
@@ -9264,7 +9264,7 @@ See ChangeLog.4 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1994-1995, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1994-1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6
index fb6090b3583..5d79470bd2a 100644
--- a/lisp/ChangeLog.6
+++ b/lisp/ChangeLog.6
@@ -686,7 +686,7 @@
1996-06-23 Noah Friedman <friedman@splode.com>
- * rlogin.el (rlogin): make comint-output-filter-functions local
+ * rlogin.el (rlogin): Make comint-output-filter-functions local
before adding hooks.
1996-06-22 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -715,11 +715,11 @@
* ediff-diff.el (ediff-setup-fine-diff-regions):
Allow diff options to be passed to the diff program.
- (ediff-make-diff2-buffer): Don't run Posix diff on remote files.
+ (ediff-make-diff2-buffer): Don't run POSIX diff on remote files.
(ediff-make-diff2-buffer): Refuses to diff remote files.
(ediff-make-diff2-buffer, ediff-setup-diff-regions): Changed functions.
(ediff-make-diff2-buffer): New function.
- Added ^\C-m$ to ok-lines regexps
+ Add ^\C-m$ to ok-lines regexps.
* ediff-ptch.el: New file.
@@ -1478,8 +1478,8 @@
1996-04-18 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
- * gnus.el (gnus-summary-pipe-output, gnus-buffer-configuration,
- gnus-window-to-buffer): Pop up the shell buffer after piping
+ * gnus.el (gnus-summary-pipe-output, gnus-buffer-configuration)
+ (gnus-window-to-buffer): Pop up the shell buffer after piping
articles through a filter.
* gnus-ems.el: Make invisible text intangible as well.
@@ -2684,7 +2684,7 @@
determined in c-emacs-features.
* cc-mode.el:
- imenu is required in Emacs 19, but doesn't exist in XEmacs
+ imenu is required in Emacs 19, but doesn't exist in XEmacs.
* cc-mode.el (c-site-default-style): New variable.
@@ -2874,15 +2874,15 @@
1996-01-29 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
- * ada-mode.el (ada-indent-region, ada-check-matching-start,
- ada-check-defun-name): Fix error format string.
+ * ada-mode.el (ada-indent-region, ada-check-matching-start)
+ (ada-check-defun-name): Fix error format string.
* allout.el (outline-process-exposed): Likewise.
* bookmark.el (bookmark-load): Likewise.
* cpp.el (cpp-parse-error): Likewise.
* ediff-init.el (ediff-event-point, ediff-event-buffer):
Likewise.
- * etags.el (visit-tags-table-buffer, tags-loop-scan,
- complete-tag): Likewise.
+ * etags.el (visit-tags-table-buffer, tags-loop-scan)
+ (complete-tag): Likewise.
* forms.el (forms--process-format-list): Likewise.
* gnus-ems.el (gnus-summary-insert-pseudos-xemacs): Likewise.
* hexl.el (hexl-hex-char-to-integer, hexl-oct-char-to-integer):
@@ -3106,8 +3106,8 @@
* facemenu.el (list-text-properties-at): Likewise.
* finder.el (finder-summary): Likewise.
* flow-ctrl.el (enable-flow-control): Likewise.
- * forms.el (forms--help, forms-search-forward,
- forms-search-backward): Likewise.
+ * forms.el (forms--help, forms-search-forward)
+ (forms-search-backward): Likewise.
* help-macro.el (make-help-screen): Likewise.
* hippie-exp.el (hippie-expand): Likewise.
* holidays.el (calendar-cursor-holidays): Likewise.
@@ -3133,8 +3133,8 @@
* type-break.el (type-break-demo-life): Likewise.
* view.el (view-mode-enter, View-scroll-lines-forward): Likewise.
* viper-ex.el (ex-pwd, vip-info-on-file): Likewise.
- * viper-macs.el (ex-map-read-args, ex-unmap-read-args,
- vip-record-kbd-macro): Likewise.
+ * viper-macs.el (ex-map-read-args, ex-unmap-read-args)
+ (vip-record-kbd-macro): Likewise.
* viper-util.el (vip-save-setting): Likewise.
* ada-mode.el (ada-adjust-case-region, ada-indent-region): Delete
@@ -3146,14 +3146,14 @@
* enriched.el (enriched-next-annotation): Likewise.
* ispell4.el (ispell-point): Likewise.
* mh-e.el (mh-get-new-mail): Likewise.
- * saveplace.el (toggle-save-place, save-place-alist-to-file,
- load-save-place-alist-from-file): Likewise.
+ * saveplace.el (toggle-save-place, save-place-alist-to-file)
+ (load-save-place-alist-from-file): Likewise.
* shadow.el (list-load-path-shadows): Likewise.
* shadowfile.el (shadow-cancel, shadow-copy-file): Likewise.
* subr.el (read-quoted-char): Likewise.
* tpu-edt.el (tpu-y-or-n-p): Likewise.
- * vip.el (vip-replace-string, vip-search-forward,
- vip-search-backward): Likewise.
+ * vip.el (vip-replace-string, vip-search-forward)
+ (vip-search-backward): Likewise.
* viper-ex.el (ex-set): Likewise.
1996-01-24 Karl Heuer <kwzh@gnu.ai.mit.edu>
@@ -3176,9 +3176,9 @@
* solitaire.el (solitaire): Doc fix.
- * solar.el (solar-moment, solar-ephemeris-time,
- solar-equatorial-coordinates, solar-horizontal-coordinates): Doc
- fixes.
+ * solar.el (solar-moment, solar-ephemeris-time)
+ (solar-equatorial-coordinates, solar-horizontal-coordinates):
+ Doc fixes.
* lunar.el (lunar-new-moon-on-or-after): Doc fix.
@@ -3221,11 +3221,11 @@
* cal-tex.el (cal-tex-preamble): Add \hfuzz=1000pt to get rid of
overfull box messages.
- * solar.el (calendar-latitude, calendar-longitude,
- calendar-location-name, solar-sunrise-and-sunset): Fix doc strings.
+ * solar.el (calendar-latitude, calendar-longitude)
+ (calendar-location-name, solar-sunrise-and-sunset): Fix doc strings.
(solar-exact-local-noon, solar-sunrise-sunset): Refer to
(calendar-longitude) and (calendar-latitude) instead of
- calendar-longitude and
+ calendar-longitude and calendar-latitude.
1996-01-24 Richard Stallman <rms@mole.gnu.ai.mit.edu>
@@ -3743,67 +3743,67 @@
* custom.el (custom-default-validate): Fix message spelling.
* debug.el (debug): Likewise.
- * doctor.el (make-doctor-variables, doctor-othermodifierp,
- doctor-strangelove): Likewise.
+ * doctor.el (make-doctor-variables, doctor-othermodifierp)
+ (doctor-strangelove): Likewise.
* dunnet.el (dun-sauna-heat, dun-login): Likewise.
* gnus.el (gnus-summary-save-article): Likewise.
* hideshow.el (hs-hide-block): Likewise.
* hilit19.el (hilit-submit-feedback): Likewise.
- * mail-extr.el (mail-extr-nuke-outside-range,
- mail-extr-all-top-level-domains): Likewise.
+ * mail-extr.el (mail-extr-nuke-outside-range)
+ (mail-extr-all-top-level-domains): Likewise.
* simple.el (shell-command): Likewise.
* term.el (term-process-pager): Likewise.
* term/sun-mouse.el (describe-mouse-briefly): Likewise.
- * ada-mode.el (ada-case-keyword, ada-auto-case, ada-krunch-args,
- ada-call-pretty-printer): Doc fix.
- * allout.el (outline-primary-bullet, outline-numbered-bullet,
- outline-override-protect, outline-explicitly-deactivated,
- outline-init, outline-chart-subtree, outline-chart-spec,
- outline-make-topic-prefix, outline-open-topic,
- outline-reindent-body, outline-yank-processing, outline-yank,
- outlineify-sticky): Doc fix.
+ * ada-mode.el (ada-case-keyword, ada-auto-case, ada-krunch-args)
+ (ada-call-pretty-printer): Doc fix.
+ * allout.el (outline-primary-bullet, outline-numbered-bullet)
+ (outline-override-protect, outline-explicitly-deactivated)
+ (outline-init, outline-chart-subtree, outline-chart-spec)
+ (outline-make-topic-prefix, outline-open-topic)
+ (outline-reindent-body, outline-yank-processing, outline-yank)
+ (outlineify-sticky): Doc fix.
* apropos.el (apropos-files-scanned): Doc fix.
* arc-mode.el (archive-summarize-files): Doc fix.
* bib-mode.el (capitalize-title-stop-words): Doc fix.
* bibtex.el (bibtex-generate-autokey, bibtex-find-entry-location):
Doc fix.
- * bookmark.el (bookmark-save-flag, bookmark-read-annotation-text-func,
- bookmark-rename, bookmark-bmenu-mode, bookmark-menu-rename): Doc fix.
- * cc-mode.el (c-file-offsets, c++-mode, c-mode, objc-mode,
- c-postprocess-file-styles): Doc fix.
+ * bookmark.el (bookmark-save-flag, bookmark-read-annotation-text-func)
+ (bookmark-rename, bookmark-bmenu-mode, bookmark-menu-rename): Doc fix.
+ * cc-mode.el (c-file-offsets, c++-mode, c-mode, objc-mode)
+ (c-postprocess-file-styles): Doc fix.
* cl-extra.el (cl-copy-tree): Doc fix.
* comint.el (comint-ptyp, comint-completion-autolist): Doc fix.
* compile.el (compilation-error-list): Doc fix.
* cplus-md.el (c++-mode): Doc fix.
* cpp.el (cpp-unknown-face, cpp-face-mono-list, cpp-face-all-list):
Doc fix.
- * custom.el (rear-nonsticky, custom-property-set, custom-field-accept,
- custom-repeat-extract, custom-pair-extract, custom-list-extract,
- custom-choice-extract, custom-choice-validate, custom-mode-map):
+ * custom.el (rear-nonsticky, custom-property-set, custom-field-accept)
+ (custom-repeat-extract, custom-pair-extract, custom-list-extract)
+ (custom-choice-extract, custom-choice-validate, custom-mode-map):
Doc fix.
* dired-x.el (dired-mark-sexp): Doc fix.
* docref.el (docref-subst): Doc fix.
* edebug.el (edebug-read): Doc fix.
* ediff-init.el (ediff-keep-variants): Doc fix.
* ediff-wind.el (ediff-prefer-iconified-control-frame): Doc fix.
- * edt.el (edt-find-forward, edt-find-backward, edt-find,
- edt-find-next-forward, edt-find-next-backward, edt-find-next): Doc fix.
+ * edt.el (edt-find-forward, edt-find-backward, edt-find)
+ (edt-find-next-forward, edt-find-next-backward, edt-find-next): Doc fix.
* ffap.el (ffap-list-env): Doc fix.
* files.el (make-directory): Doc fix.
- * fill.el (fill-context-prefix, unjustify-current-line,
- unjustify-region): Doc fix.
+ * fill.el (fill-context-prefix, unjustify-current-line)
+ (unjustify-region): Doc fix.
* font-lock.el (font-lock-keywords): Doc fix.
* format.el (format-annotate-atomic-property-change): Doc fix.
* forms.el (forms-toggle-read-only, forms-enumerate): Doc fix.
gnus-cus.el: Doc fix.
* gnus-edit.el (gnus-score-custom-data): Doc fix.
* gnus-uu.el (gnus-uu-do-not-unpack-archives): Doc fix.
- * gnus.el (gnus-buffer-configuration,
- gnus-article-hide-headers-if-wanted): Doc fix.
- * hexl.el (hexl-program, hexl-beginning-of-1k-page,
- hexl-end-of-1k-page, hexl-beginning-of-512b-page,
- hexl-end-of-512b-page): Doc fix.
+ * gnus.el (gnus-buffer-configuration)
+ (gnus-article-hide-headers-if-wanted): Doc fix.
+ * hexl.el (hexl-program, hexl-beginning-of-1k-page)
+ (hexl-end-of-1k-page, hexl-beginning-of-512b-page)
+ (hexl-end-of-512b-page): Doc fix.
* hideshow.el (hs-unbalance-handler-method, hs-show-block): Doc fix.
* hilit19.el (hilit-lookup-face-create): Doc fix.
* icomplete.el (icomplete-simple-completing-p, icomplete-completions):
@@ -3814,8 +3814,8 @@
* iso-cvt.el (iso-fix-tex2iso): Doc fix.
* ispell4.el (ispell-gnu-look-still-broken-p, ispell-message-text-end):
Doc fix.
- * make-mode.el (makefile-insert-special-target,
- makefile-backslash-region): Doc fix.
+ * make-mode.el (makefile-insert-special-target)
+ (makefile-backslash-region): Doc fix.
* mh-e.el (mh-good-msg-regexp): Doc fix.
* modula2.el (m2-case, m2-for, m2-if): Doc fix.
* msb.el (msb-max-file-menu-items, msb-menu-cond): Doc fix.
@@ -3830,12 +3830,12 @@
* sh-script.el (sh-mode-syntax-table): Doc fix.
* simple.el (next-completion): Doc fix.
* skeleton.el (skeleton-insert): Doc fix.
- * supercite.el (sc-citation-nonnested-root-regexp,
- sc-add-citation-level, sc-no-blank-line-or-header): Doc fix.
+ * supercite.el (sc-citation-nonnested-root-regexp)
+ (sc-add-citation-level, sc-no-blank-line-or-header): Doc fix.
* tempo.el (tempo-local-tags, tempo-user-elements, tempo-use-tag-list):
Doc fix.
- * term.el (term-ptyp, term-termcap-format, term-scroll-region,
- term-completion-autolist): Doc fix.
+ * term.el (term-ptyp, term-termcap-format, term-scroll-region)
+ (term-completion-autolist): Doc fix.
* texinfo.el (texinfo-master-menu): Doc fix.
* texnfo-upd.el (texinfo-master-menu): Doc fix.
* thingatpt.el (read-from-whole-string): Doc fix.
@@ -3845,8 +3845,8 @@
* type-break.el (type-break-keystroke-threshold, type-break-mode):
Doc fix.
* vip.el (vip-shift-width): Doc fix.
- * viper.el (vip-insert-diehard-minor-mode, vip-toggle-search-style,
- vip-del-backward-char-in-replace, vip-query-replace): Doc fix.
+ * viper.el (vip-insert-diehard-minor-mode, vip-toggle-search-style)
+ (vip-del-backward-char-in-replace, vip-query-replace): Doc fix.
* vmsproc.el (display-subprocess-window): Doc fix.
* xscheme.el (xscheme-control-g-synchronization-p): Doc fix.
@@ -4389,9 +4389,9 @@
1995-12-19 Eli Zaretskii <eliz@is.elta.co.il>
- * time.el (display-time): make it work under ms-dos by setting the
+ * time.el (display-time): Make it work under MS-DOS by setting the
`dos-display-time' variable instead of invoking `wakeup' as
- asynchronous process (which doesn't work under ms-dos).
+ asynchronous process (which doesn't work under MS-DOS).
1995-12-19 Karl Heuer <kwzh@gnu.ai.mit.edu>
@@ -4419,8 +4419,8 @@
1995-12-14 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
- * gnus.el (gnus-summary-mode-line-format,
- gnus-article-mode-line-format, gnus-group-mode-line-format):
+ * gnus.el (gnus-summary-mode-line-format)
+ (gnus-article-mode-line-format, gnus-group-mode-line-format):
Include the buffer name in the default mode strings.
(gnus-mode-non-string-length): Changed the default to not
limit/pad mode line lengths.
@@ -4502,8 +4502,8 @@
(bibtex-font-lock-keywords): New variable with font-lock keywords
for BibTeX mode.
- * bibtex.el (bibtex-make-optional-field): Not longer interactive
- (suggested by Karl Eichwalder <karl@pertron.central.de>).
+ * bibtex.el (bibtex-make-optional-field): Not longer interactive.
+ Suggested by Karl Eichwalder <karl@pertron.central.de>.
* bibtex.el (bibtex-maintain-sorted-entries): Set to nil, since it
requires more user attention and more restricted files to have
@@ -4561,8 +4561,8 @@
to bibtex-completion-candidates).
(bibtex-complete-string): Made it use bibtex-string.
- * bibtex.el (bibtex-keys,
- bibtex-buffer-last-parsed-for-keys-tick): New buffer-local
+ * bibtex.el (bibtex-keys)
+ (bibtex-buffer-last-parsed-for-keys-tick): New buffer-local
variables to make parsing of BibTeX buffer for reference keys
(needed by TAB completion in minibuffer when entering key) more
occasional.
@@ -4708,17 +4708,17 @@
1995-11-29 Paul Eggert <eggert@twinsun.com>
- * cal-chinese.el (calendar-chinese-sexagesimal-name): Renamed from
+ * cal-chinese.el (calendar-chinese-sexagesimal-name): Rename from
calendar-chinese-sexagisimal-name to fix misspelling.
* cal-hebrew.el (holiday-rosh-hashanah-etc): Fix misspelled var.
* holidays.el (holiday-easter-etc): Fix misspelling of "Whitmonday".
* calendar.el (calendar-setup, calendar-basic-setup)
(calendar-next-calendar-round-date)
- (calendar-previous-calendar-round-date, cal-tex-cursor-year)
- * cal-julian.el (calendar-absolute-from-astro)
+ (calendar-previous-calendar-round-date, cal-tex-cursor-year):
+ * cal-julian.el (calendar-absolute-from-astro):
* cal-mayan.el (calendar-next-calendar-round-date)
- (calendar-previous-calendar-round-date)
- * diary-lib.el (list-sexp-diary-entries)
+ (calendar-previous-calendar-round-date):
+ * diary-lib.el (list-sexp-diary-entries):
* solar.el (solar-longitude): Doc fixes to fix misspellings.
1995-11-29 Richard Stallman <rms@mole.gnu.ai.mit.edu>
@@ -5010,8 +5010,8 @@
1995-11-14 Eric Ding <ericding@mit.edu>
* goto-addr.el (goto-address-highlight-p): New variable.
- (goto-address-fontify): Removed check for invisible text,
- set inhibit-point-motion-hooks instead
+ (goto-address-fontify): Remove check for invisible text,
+ set inhibit-point-motion-hooks instead.
1995-11-13 Richard Stallman <rms@mole.gnu.ai.mit.edu>
@@ -5980,7 +5980,7 @@
* help.el (print-help-return-message): Handle lists in
special-display-regexps and same-window-regexps. Also in
- special-display-buffer-names and same-window-buffer-names
+ special-display-buffer-names and same-window-buffer-names.
* files.el (interpreter-mode-alist): Handle nawk.
@@ -6157,8 +6157,8 @@
dates; fix astro date message.
(calendar-mouse-2-date-menu): Add dayname to menu.
- * cal-french.el (french-calendar-special-days-array,
- calendar-french-date-string): Fix accents.
+ * cal-french.el (french-calendar-special-days-array)
+ (calendar-french-date-string): Fix accents.
(calendar-goto-french-date): Use reverse instead of nreverse; fix
accents.
(french-calendar-epoch): New variable.
@@ -6168,8 +6168,8 @@
(dst-adjust-time): Moved and renamed from solar.el.
(dst-in-effect): New function.
- * solar.el (solar-equinoxes-solstices, solar-ephemeris-correction,
- solar-equinoxes/solstices): Rewritten.
+ * solar.el (solar-equinoxes-solstices, solar-ephemeris-correction)
+ (solar-equinoxes/solstices): Rewritten.
(solar-apparent-longitude-of-sun): Deleted.
(solar-longitude, solar-date-next-longitude): New functions.
(solar-adj-time-for-dst): Renamed dst-adjust-time and moved to
@@ -6178,31 +6178,30 @@
Take angle mod 360.0.
(solar-tangent-degrees): Change to macro.
- * calendar.el (calendar-mod, calendar-absolute-from-astro,
- calendar-astro-from-absolute): New functions.
- (calendar-astro-date-string, calendar-goto-astro-day-number): Use
- them. Autoload holiday-chinese-new-year,
+ * calendar.el (calendar-mod, calendar-absolute-from-astro)
+ (calendar-astro-from-absolute): New functions.
+ (calendar-astro-date-string, calendar-goto-astro-day-number):
+ Use them. Autoload holiday-chinese-new-year,
calendar-goto-chinese-date, calendar-print-chinese-date,
calendar-chinese-date-string, calendar-goto-coptic-date,
calendar-print-coptic-date, calendar-coptic-date-string,
calendar-goto-ethiopic-date, calendar-print-ethiopic-date,
calendar-ethiopic-date-string, calendar-one-frame-setup, and
- calendar-two-frame-setup. (oriental-holidays): New variable for
- Chinese New Year. (calendar-mode-map): Put Chinese and Coptic
- calendar functions on keys. (calendar-setup): Moved here from
- cal-x.el. (diary-file): Mention Chinese, Coptic, and Ethiopic
- dates. (calendar-goto-today, calendar-forward-month,
- calendar-forward-year, calendar-backward-month,
- calendar-backward-year, scroll-calendar-left,
- scroll-calendar-right, scroll-calendar-left-three-months,
- scroll-calendar-right-three-months,
- calendar-cursor-to-nearest-date, calendar-forward-day,
- calendar-backward-day, calendar-forward-week,
- calendar-backward-week, calendar-beginning-of-week,
- calendar-end-of-week, calendar-beginning-of-month,
- calendar-end-of-month, calendar-beginning-of-year,
- calendar-end-of-year, calendar-cursor-to-visible-date,
- calendar-goto-date, calendar-goto-iso-date): Moved to cal-move.el.
+ calendar-two-frame-setup.
+ (oriental-holidays): New variable for Chinese New Year.
+ (calendar-mode-map): Put Chinese and Coptic calendar functions on keys.
+ (calendar-setup): Moved here from cal-x.el.
+ (diary-file): Mention Chinese, Coptic, and Ethiopic dates.
+ (calendar-goto-today, calendar-forward-month, calendar-forward-year)
+ (calendar-backward-month, calendar-backward-year, scroll-calendar-left)
+ (scroll-calendar-right, scroll-calendar-left-three-months)
+ (scroll-calendar-right-three-months, calendar-cursor-to-nearest-date)
+ (calendar-forward-day, calendar-backward-day, calendar-forward-week)
+ (calendar-backward-week, calendar-beginning-of-week)
+ (calendar-end-of-week, calendar-beginning-of-month)
+ (calendar-end-of-month, calendar-beginning-of-year)
+ (calendar-end-of-year, calendar-cursor-to-visible-date)
+ (calendar-goto-date, calendar-goto-iso-date): Moved to cal-move.el.
(calendar-goto-julian-date): Moved to cal-julian.
(calendar-cursor-to-date, generate-calendar-month): Consider the
space next to a one-digit date as being on that date.
@@ -6210,8 +6209,8 @@
* cal-mayan.el (calendar-mayan-tzolkin-from-absolute): Use them.
(mayan-adjusted-mod): Moved to calendar.el and renamed calendar-mod.
- * lunar.el (lunar-new-moon-time, lunar-new-moon-on-or-after) New
- functions.
+ * lunar.el (lunar-new-moon-time, lunar-new-moon-on-or-after):
+ New functions.
1995-09-18 Richard Stallman <rms@whiz-bang.gnu.ai.mit.edu>
@@ -6863,7 +6862,7 @@
(skeleton-read): Don't quit and remove partial skeleton when empty
string entered for outer iterator. Added implicit argument `input'.
(define-skeleton, skeleton-insert, skeleton-internal-list): Use `x
- rather than backquote's (` x) or own (list 'x)
+ rather than backquote's (` x) or own (list 'x).
* sh-script.el (sh-test): New variable.
(sh-if, sh-until, sh-while): Use it.
@@ -7011,8 +7010,8 @@
1995-08-04 Stephen A. Wood <saw@hallc1.cebaf.gov>
- * fortran.el (fortran-auto-fill-mode, fortran-do-auto-fill,
- fortran-fill): Invoke auto filling only when past fill-column.
+ * fortran.el (fortran-auto-fill-mode, fortran-do-auto-fill)
+ (fortran-fill): Invoke auto filling only when past fill-column.
1995-08-04 Roland McGrath <roland@churchy.gnu.ai.mit.edu>
@@ -7287,7 +7286,7 @@
1995-07-25 Ake Stenhoff <etxaksf@aom.ericsson.se>
- * perl-mode.el (perl-imenu-generic-expression) New variable.
+ * perl-mode.el (perl-imenu-generic-expression): New variable.
(perl-mode): Set imenu-generic-expression.
* imenu.el (imenu-generic-expression): Call make-variable-buffer-local.
@@ -7640,7 +7639,7 @@
apropos-command in apropos.el.
* autoload.el (make-autoload): Generate `(autoload ...)' form for
- `(define-skeleton ...)'
+ `(define-skeleton ...)'.
* skeleton.el: Partly rewritten and extended.
(skeleton-filter, skeleton-untabify, skeleton-further-elements)
@@ -7702,7 +7701,7 @@
* two-column.el: Symbols renamed to be like mode-line indicator.
Supposed to now also work for Lucid.
(2C-mode-map): New name for `tc-mode-map'. Additionally bound to [f2].
- (2C-minor-mode-map) New variable.
+ (2C-minor-mode-map): New variable.
(2C-mode): New name for `tc-other'.
(2C-mode-line-format): New name for `tc-mode-line-format'.
(2C-other-buffer-hook): New variable.
@@ -7799,7 +7798,7 @@
1995-06-29 David M. Smith <D.M.Smith@lancaster.ac.uk>
* ielm.el (ielm-font-lock-keywords): New variable.
- (inferior-emacs-lisp-mode): Use it for font-lock support
+ (inferior-emacs-lisp-mode): Use it for font-lock support.
1995-06-29 Bryan O'Sullivan <bos@Eng.Sun.COM>
@@ -7944,7 +7943,7 @@
1995-06-24 Richard Stallman <rms@mole.gnu.ai.mit.edu>
- * rmail.el (rmail-revert): Use the default revert-buffer-function
+ * rmail.el (rmail-revert): Use the default revert-buffer-function.
* simple.el (newline): Put point at right place if insert gets error.
@@ -8022,7 +8021,7 @@ See ChangeLog.5 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1995-1996, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1995-1996, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7
index b05707abe5c..9976c45b307 100644
--- a/lisp/ChangeLog.7
+++ b/lisp/ChangeLog.7
@@ -1902,7 +1902,7 @@
(japanese-hankaku-region): Likewise.
(japanese-zenkaku-region): Likewise.
-1998-06-22 WJCarpenter <bill@carpenter.ORG>
+1998-06-22 WJ Carpenter <bill@carpenter.ORG>
* mail/feedmail.el: New file.
@@ -4115,7 +4115,7 @@
* ffap.el (dired-at-point): Add autoload cookie.
-1998-04-23 Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
+1998-04-23 Jens-Ulrik Petersen <petersen@kurims.kyoto-u.ac.jp>
* ffap.el (dired-at-point-require-prefix): New option.
(dired-at-point): New command.
@@ -5859,8 +5859,7 @@
1998-03-05 Sam Steingold <sds@usa.net>
- * lisp/simple.el (backward-delete-char-untabify-method):
- New user option.
+ * simple.el (backward-delete-char-untabify-method): New user option.
(backward-delete-char-untabify): Obey it.
This implements "hungry" delete.
@@ -7798,10 +7797,10 @@
1997-12-03 Kyle Jones <kyle_jones@wonderworks.com>
- * lisp/mail/sendmail.el (sendmail-send-it): Parse folded
- Resent-To header properly; don't ignore folded lines.
+ * mail/sendmail.el (sendmail-send-it):
+ Parse folded Resent-To header properly; don't ignore folded lines.
- * lisp/mail/mail-utils.el (mail-parse-comma-list):
+ * mail/mail-utils.el (mail-parse-comma-list):
Treat newlines and tabs as whitespace.
1997-12-03 Richard Stallman <rms@gnu.org>
@@ -13739,7 +13738,7 @@
(isearch-toggle-specified-input-method): Set the above variables.
(isearch-toggle-input-method): Likewise.
(isearch-process-search-multibyte-characters): Give
- iseach-input-method as arg to read-multilingual-string.
+ isearch-input-method as arg to read-multilingual-string.
* international/mule-cmds.el (read-multilingual-string): Adjusted
for the previous change of variables related to input methods.
@@ -23107,7 +23106,7 @@ See ChangeLog.6 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8
index cd685204766..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.
@@ -3571,7 +3571,7 @@
1999-08-15 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
- * lisp/texinfmt.el: Handle @ifnottex.
+ * texinfmt.el: Handle @ifnottex.
1999-08-15 Eli Zaretskii <eliz@gnu.org>
@@ -6906,7 +6906,7 @@
standard `print' and `nprint' programs, as well as `lpr' and
similar programs. Only write directly to the printer port if no
print program is specified. Work around a bug in Windows 9x
- affecting Win32 version of Emacs by invoking command.com to write
+ affecting the w32 version of Emacs by invoking command.com to write
to the printer port instead of writing directly.
(direct-print-region-function): Use direct-print-region-helper to
do most of the work.
@@ -8708,7 +8708,7 @@
1998-10-21 Markus Rost <rost@delysid.gnu.org>
- * lisp/info.el (Info-next-menu-item): Stay on top of node.
+ * info.el (Info-next-menu-item): Stay on top of node.
* mail/rmailout.el (rmail-output): Insert newline only if necessary.
@@ -9181,7 +9181,7 @@
* gnus-art.el (gnus-article-x-face-too-ugly): Fix type.
(gnus-saved-headers): Fix type.
- * lisp/textmodes/fill.el (fill-individual-paragraphs-prefix):
+ * textmodes/fill.el (fill-individual-paragraphs-prefix):
Avoid nil value of `two-lines-citation-part'.
1998-09-30 Roman Belenov <roman@nstl.nnov.ru>
@@ -9993,7 +9993,7 @@ See ChangeLog.7 for earlier changes.
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9
index 252b3854f7a..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
@@ -6100,7 +6100,7 @@
2001-01-25 Dave Love <fx@gnu.org>
- * lisp/international/mule-diag.el (describe-char-after): Doc fix.
+ * international/mule-diag.el (describe-char-after): Doc fix.
(describe-coding-system): Tweak the English text.
* loadup.el: Preload international/ccl for utf-8.
@@ -13936,7 +13936,7 @@
* international/mule-cmds.el (help-xref-mule-regexp-template): New
variable.
- (describe-input-method): Temporarily activate the specfied input
+ (describe-input-method): Temporarily activate the specified input
method to display the information.
(describe-language-environment): Hyperlinks to mule related items.
@@ -15884,8 +15884,8 @@
2000-07-16 John Wiegley <johnw@gnu.org>
- * lisp/align.el (align-newline-and-indent):
- Adding new function. for auto-aligning blocks of code on RET.
+ * align.el (align-newline-and-indent): Adding new function,
+ for auto-aligning blocks of code on RET.
(align-region): Fixed badly formatted minibuffer message.
2000-07-17 Kenichi Handa <handa@etl.go.jp>
@@ -17245,7 +17245,7 @@
(antlr-downcase-literals): New command.
(antlr-upcase-literals): Ditto.
- * antlr-mode.el: Minor changes: indendation, mode-name.
+ * antlr-mode.el: Minor changes: indentation, mode-name.
(antlr-indent-line): Indent cpp directive at column 0.
(antlr-mode): Use mode-name prefix "Antlr." instead of "Antlr/".
@@ -18753,8 +18753,7 @@
(network-connection-mode-setup): New function, saves host and
service information in local variables.
- * lisp/locate.el:
- (locate-word-at-point): Added this function.
+ * locate.el (locate-word-at-point): Added this function.
(locate): Default to using locate-word-at-point as input
Run dired-mode-hook
@@ -20672,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/Makefile.in b/lisp/Makefile.in
index d4ff6a4384b..643b698c6e8 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -1,5 +1,5 @@
# Maintenance productions for the Lisp directory
-# Copyright (C) 2000-2011 Free Software Foundation, Inc.
+# Copyright (C) 2000-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -86,19 +86,23 @@ AUTOGEN_VCS = \
# During bootstrapping the byte-compiler is run interpreted when compiling
# itself, and uses more stack than usual.
#
-BIG_STACK_DEPTH = 1200
+BIG_STACK_DEPTH = 2200
BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS)
# Files to compile before others during a bootstrap. This is done to
-# speed up the bootstrap process.
+# speed up the bootstrap process. They're ordered by size, so we use
+# the slowest-compiler on the smallest file and move to larger files as the
+# compiler gets faster. `autoload.elc' comes last because it is not used by
+# the compiler (so its compilation does not speed up subsequent compilations),
+# it's only placed here so as to speed up generation of the loaddefs.el file.
COMPILE_FIRST = \
- $(lisp)/emacs-lisp/bytecomp.elc \
- $(lisp)/emacs-lisp/byte-opt.elc \
$(lisp)/emacs-lisp/macroexp.elc \
- $(lisp)/emacs-lisp/cconv.elc \
+ $(lisp)/emacs-lisp/cconv.elc \
+ $(lisp)/emacs-lisp/byte-opt.elc \
+ $(lisp)/emacs-lisp/bytecomp.elc \
$(lisp)/emacs-lisp/autoload.elc
# The actual Emacs command run in the targets below.
@@ -106,7 +110,7 @@ COMPILE_FIRST = \
emacs = EMACSLOADPATH=$(lisp) LC_ALL=C $(EMACS) $(EMACSOPT)
# Common command to find subdirectories
-setwins=subdirs=`(find . -type d -print)`; \
+setwins=subdirs=`find . -type d -print`; \
for file in $$subdirs; do \
case $$file in */.* | */.*/* | */=* ) ;; \
*) wins="$$wins $$file" ;; \
@@ -114,7 +118,7 @@ setwins=subdirs=`(find . -type d -print)`; \
done
# Find all subdirectories except `obsolete' and `term'.
-setwins_almost=subdirs=`(find . -type d -print)`; \
+setwins_almost=subdirs=`find . -type d -print`; \
for file in $$subdirs; do \
case $$file in */.* | */.*/* | */=* | */obsolete | */term ) ;; \
*) wins="$$wins $$file" ;; \
@@ -122,21 +126,21 @@ setwins_almost=subdirs=`(find . -type d -print)`; \
done
# Find all subdirectories in which we might want to create subdirs.el
-setwins_for_subdirs=subdirs=`(find . -type d -print)`; \
+setwins_for_subdirs=subdirs=`find . -type d -print`; \
for file in $$subdirs; do \
case $$file in */.* | */.*/* | */=* | */cedet* ) ;; \
*) wins="$$wins $$file" ;; \
esac; \
done
-# `compile-main' tends to be slower than `recompile' but can be parallelized
-# with "make -j" and results in more deterministic compilation warnings.
# cus-load and finder-inf are not explicitly requested by anything, so
# we add them here to make sure they get built.
all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el
doit:
+.PHONY: all doit custom-deps finder-data autoloads update-subdirs
+
# custom-deps and finder-data both used to scan _all_ the *.el files.
# This could lead to problems in parallel builds if automatically
# generated *.el files (eg loaddefs etc) were being changed at the same time.
@@ -179,16 +183,21 @@ $(lisp)/subdirs.el:
update-subdirs: doit
cd $(lisp); $(setwins_for_subdirs); \
for file in $$wins; do \
- $(top_srcdir)/update-subdirs $$file; \
+ $(top_srcdir)/build-aux/update-subdirs $$file; \
done;
-updates: update-subdirs autoloads finder-data custom-deps
+.PHONY: updates bzr-update update-authors
-# This is useful after "bzr up".
-bzr-update: recompile autoloads finder-data custom-deps
+# Some modes of make-dist use this.
+updates: update-subdirs autoloads finder-data custom-deps
-# For backwards compatibility:
-cvs-update: bzr-update
+# This is useful after "bzr up"; but it doesn't do anything that a
+# plain "make" at top-level doesn't.
+# The only difference between this and this directory's "all" rule
+# is that this runs "autoloads" as well (because it uses "compile"
+# rather than "compile-main"). In a bootstrap, $(lisp) in src/Makefile
+# triggers this directory's autoloads rule.
+bzr-update: compile finder-data custom-deps
# Update the AUTHORS file.
@@ -210,6 +219,7 @@ TAGS TAGS-LISP: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptags
# src/Makefile.in to rebuild a particular Lisp file, no questions asked.
# Use byte-compile-refresh-preloaded to try and work around some of
# the most common problems of not bootstrapping from a clean state.
+.PHONY: compile-onefile
compile-onefile:
@echo Compiling $(THEFILE)
@# Use byte-compile-refresh-preloaded to try and work around some of
@@ -297,6 +307,8 @@ compile-always: doit
cd $(lisp); rm -f *.elc */*.elc */*/*.elc */*/*/*.elc
$(MAKE) $(MFLAGS) compile EMACS=$(EMACS)
+.PHONY: compile-calc backup-compiled-files compile-after-backup
+
compile-calc:
for el in $(lisp)/calc/*.el; do \
echo Compiling $$el; \
@@ -314,19 +326,23 @@ backup-compiled-files:
compile-after-backup: backup-compiled-files compile-always
-# Recompile all Lisp files which are newer than their .elc files and compile
-# new ones.
-# This has the same effect as compile-main. recompile has some advantages:
-# i) It is faster (on a single processor), since it only has to start
-# Emacs once. It was 33% faster on a test with a random 10% of the .el
-# files needing recompilation.
-# ii) The explicit cc-mode dependency.
-# recompile's disadvantages are:
-# i) Not parallelizable.
-# ii) Compiling multiple files in the same instance of Emacs is wrong,
-# since the environment of later files is affected by definitions in
-# earlier ones.
-recompile: doit $(LOADDEFS) compile-first $(lisp)/progmodes/cc-mode.elc
+# This does the same job as the "compile" rule, but in a different way.
+# Rather than spawning a separate Emacs instance to compile each file,
+# it uses the same Emacs instance to compile everything.
+# This is faster on a single core, since it avoids the overhead of
+# starting Emacs many times (it was 33% faster on a test with a
+# random 10% of the .el files needing recompilation).
+# Unlike compile, this is not parallelizable; so if you have more than
+# one core and use make -j#, compile will be (much) faster.
+# This rule also produces less accurate compilation warnings.
+# The environment of later files is affected by definitions in
+# earlier ones, so it does not produce some warnings that it should.
+# It can also produces spurious warnings about "invalid byte code" if
+# files that use byte-compile-dynamic are updated.
+# There is no reason to use this rule unless you only have a single
+# core and CPU time is an issue.
+.PHONY: compile-one-process
+compile-one-process: doit $(LOADDEFS) compile-first $(lisp)/progmodes/cc-mode.elc
$(emacs) $(BYTE_COMPILE_FLAGS) \
--eval "(batch-byte-recompile-directory 0)" $(lisp)
@@ -348,6 +364,7 @@ MH_E_SRC = $(MH_E_DIR)/mh-acros.el $(MH_E_DIR)/mh-alias.el \
$(MH_E_DIR)/mh-tool-bar.el $(MH_E_DIR)/mh-utils.el \
$(MH_E_DIR)/mh-xface.el
+.PHONY: mh-autoloads
mh-autoloads: $(MH_E_DIR)/mh-loaddefs.el
$(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC)
$(emacs) -l autoload \
@@ -410,18 +427,7 @@ $(CAL_DIR)/hol-loaddefs.el: $(CAL_SRC)
--eval "(setq make-backup-files nil)" \
-f batch-update-autoloads $(CAL_DIR)
-# Prepare a bootstrap in the lisp subdirectory.
-#
-# Build loaddefs.el to make sure it's up-to-date. If it's not, that
-# might lead to errors during the bootstrap because something fails to
-# autoload as expected. If there is no emacs binary, then we can't
-# build autoloads yet. In that case we have to use ldefs-boot.el.
-# Bootstrap should always work with ldefs-boot.el. Therefore,
-# whenever a new autoload cookie gets added that is necessary during
-# bootstrapping, ldefs-boot.el should be updated by overwriting it with
-# an up-to-date copy of loaddefs.el that is uncorrupted by
-# local changes. (Because loaddefs.el is an automatically generated
-# file, we don't want to store it in the source repository).
+.PHONY: bootstrap-clean distclean maintainer-clean
bootstrap-clean:
cd $(lisp); rm -f *.elc */*.elc */*/*.elc */*/*/*.elc $(AUTOGENEL)
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 395810772c5..114afd8c813 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -1,6 +1,6 @@
;;; abbrev.el --- abbrev mode commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: abbrev convenience
@@ -31,7 +31,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup abbrev-mode nil
"Word abbreviations mode."
@@ -81,7 +81,8 @@ be replaced by its expansion."
(clear-abbrev-table (symbol-value tablesym))))
(defun copy-abbrev-table (table)
- "Make a new abbrev-table with the same abbrevs as TABLE."
+ "Make a new abbrev-table with the same abbrevs as TABLE.
+Does not copy property lists."
(let ((new-table (make-abbrev-table)))
(mapatoms
(lambda (symbol)
@@ -133,10 +134,13 @@ Otherwise display all abbrevs."
(push table empty-tables)
(insert-abbrev-table-description table t)))
(dolist (table (nreverse empty-tables))
- (insert-abbrev-table-description table t))))
+ (insert-abbrev-table-description table t)))
+ ;; Note: `list-abbrevs' can display only local abbrevs, in
+ ;; which case editing could lose abbrevs of other tables. Thus
+ ;; enter `edit-abbrevs-mode' only if LOCAL is nil.
+ (edit-abbrevs-mode))
(goto-char (point-min))
(set-buffer-modified-p nil)
- (edit-abbrevs-mode)
(current-buffer))))
(defun edit-abbrevs-mode ()
@@ -151,7 +155,8 @@ Otherwise display all abbrevs."
(defun edit-abbrevs ()
"Alter abbrev definitions by editing a list of them.
-Selects a buffer containing a list of abbrev definitions.
+Selects a buffer containing a list of abbrev definitions with
+point located in the abbrev table of current buffer.
You can edit them and type \\<edit-abbrevs-map>\\[edit-abbrevs-redefine] to redefine abbrevs
according to your editing.
Buffer contains a header line for each abbrev table,
@@ -162,7 +167,12 @@ where NAME and EXPANSION are strings with quotes,
USECOUNT is an integer, and HOOK is any valid function
or may be omitted (it is usually omitted)."
(interactive)
- (switch-to-buffer (prepare-abbrev-list-buffer)))
+ (let ((table-name (abbrev-table-name local-abbrev-table)))
+ (switch-to-buffer (prepare-abbrev-list-buffer))
+ (when (and table-name
+ (search-forward
+ (concat "(" (symbol-name table-name) ")\n\n") nil t))
+ (goto-char (match-end 0)))))
(defun edit-abbrevs-redefine ()
"Redefine abbrevs according to current buffer contents."
@@ -191,7 +201,8 @@ the ones defined from the buffer now."
(not (eolp)))
(setq name (read buf) count (read buf))
(if (equal count '(sys))
- (setq sys t count (read buf)))
+ (setq sys t count (read buf))
+ (setq sys nil))
(setq exp (read buf))
(skip-chars-backward " \t\n\f")
(setq hook (if (not (eolp)) (read buf)))
@@ -446,6 +457,7 @@ PROPS is a list of properties."
table))
(defun abbrev-table-p (object)
+ "Return non-nil if OBJECT is an abbrev table."
(and (vectorp object)
(numberp (abbrev-table-get object :abbrev-table-modiff))))
@@ -471,7 +483,8 @@ for any particular abbrev defined in both.")
(defvar abbrev-minor-mode-table-alist nil
"Alist of abbrev tables to use for minor modes.
Each element looks like (VARIABLE . ABBREV-TABLE);
-ABBREV-TABLE is active whenever VARIABLE's value is non-nil.")
+ABBREV-TABLE is active whenever VARIABLE's value is non-nil.
+ABBREV-TABLE can also be a list of abbrev tables.")
(defvar fundamental-mode-abbrev-table
(let ((table (make-abbrev-table)))
@@ -527,7 +540,7 @@ the current abbrev table before abbrev lookup happens."
(dotimes (i (length table))
(aset table i 0))
;; Preserve the table's properties.
- (assert sym)
+ (cl-assert sym)
(let ((newsym (intern "" table)))
(set newsym nil) ; Make sure it won't be confused for an abbrev.
(setplist newsym (symbol-plist sym)))
@@ -547,6 +560,12 @@ If EXPANSION is not a string (and not nil), the abbrev is a
special one, which does not expand in the usual way but only
runs HOOK.
+If HOOK is a non-nil symbol with a non-nil `no-self-insert' property,
+it can control whether the character that triggered abbrev expansion
+is inserted. If such a HOOK returns non-nil, the character is not
+inserted. If such a HOOK returns nil, then so does `abbrev-insert'
+\(and `expand-abbrev'), as if no abbrev expansion had taken place.
+
PROPS is a property list. The following properties are special:
- `:count': the value for the abbrev's usage-count, which is incremented each
time the abbrev is used (the default is zero).
@@ -564,8 +583,8 @@ An obsolete but still supported calling form is:
\(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)."
(when (and (consp props) (or (null (car props)) (numberp (car props))))
;; Old-style calling convention.
- (setq props (list* :count (car props)
- (if (cadr props) (list :system (cadr props))))))
+ (setq props `(:count ,(car props)
+ ,@(if (cadr props) (list :system (cadr props))))))
(unless (plist-get props :count)
(setq props (plist-put props :count 0)))
(let ((system-flag (plist-get props :system))
@@ -602,7 +621,7 @@ current (if global is nil) or standard syntax table."
(let ((badchars ())
(pos 0))
(while (string-match "\\W" abbrev pos)
- (pushnew (aref abbrev (match-beginning 0)) badchars)
+ (cl-pushnew (aref abbrev (match-beginning 0)) badchars)
(setq pos (1+ pos)))
(error "Some abbrev characters (%s) are not word constituents %s"
(apply 'string (nreverse badchars))
@@ -745,7 +764,9 @@ If non-nil, NAME is the name by which this abbrev was found.
If non-nil, WORDSTART is the place where to insert the abbrev.
If WORDEND is non-nil, the abbrev replaces the previous text between
WORDSTART and WORDEND.
-Return ABBREV if the expansion should be considered as having taken place."
+Return ABBREV if the expansion should be considered as having taken place.
+The return value can be influenced by a `no-self-insert' property;
+see `define-abbrev' for details."
(unless name (setq name (symbol-name abbrev)))
(unless wordstart (setq wordstart (point)))
(unless wordend (setq wordend wordstart))
@@ -810,12 +831,12 @@ the abbrev symbol if expansion took place.")
(defun expand-abbrev ()
"Expand the abbrev before point, if there is an abbrev there.
Effective when explicitly called even when `abbrev-mode' is nil.
-Returns the abbrev symbol, if expansion took place."
+Returns the abbrev symbol, if expansion took place. (The actual
+return value is that of `abbrev-insert'.)"
(interactive)
(run-hooks 'pre-abbrev-expand-hook)
(with-wrapper-hook abbrev-expand-functions ()
- (destructuring-bind (&optional sym name wordstart wordend)
- (abbrev--before-point)
+ (pcase-let ((`(,sym ,name ,wordstart ,wordend) (abbrev--before-point)))
(when sym
(let ((startpos (copy-marker (point) t))
(endmark (copy-marker wordend t)))
@@ -933,9 +954,11 @@ Properties with special meaning:
abbreviations.
- `:case-fixed' non-nil means that abbreviations are looked up without
case-folding, and the expansion is not capitalized/upcased.
-- `:regexp' describes the form of abbrevs. It defaults to \\=\\<\\(\\w+\\)\\W* which
- means that an abbrev can only be a single word. The submatch 1 is treated
- as the potential name of an abbrev.
+- `:regexp' is a regular expression that specifies how to extract the
+ name of the abbrev before point. The submatch 1 is treated
+ as the potential name of an abbrev. If :regexp is nil, the default
+ behavior uses `backward-word' and `forward-word' to extract the name
+ of the abbrev, which can therefore only be a single word.
- `:enable-function' can be set to a function of no argument which returns
non-nil if and only if the abbrevs in this table should be used for this
instance of `expand-abbrev'."
diff --git a/lisp/align.el b/lisp/align.el
index 214c3add93f..0af5e56c668 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -1,6 +1,6 @@
;;; align.el --- align text to a specific column, by regexp
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: FSF
@@ -74,7 +74,7 @@
;; align-?-modes variables (for example, `align-dq-string-modes'), use
;; `add-to-list', or some similar function which checks first to see
;; if the value is already there. Since the user may customize that
-;; mode list, and then write your mode name into their .emacs file,
+;; mode list, and then write your mode name into their init file,
;; causing the symbol already to be present the next time they load
;; your package.
@@ -1201,7 +1201,10 @@ have been aligned. No changes will be made to the buffer."
(gocol col) cur)
(when area
(if func
- (funcall func (car area) (cdr area) change)
+ (funcall func
+ (marker-position (car area))
+ (marker-position (cdr area))
+ change)
(if (not (and justify
(consp (cdr area))))
(goto-char (cdr area))
@@ -1295,7 +1298,8 @@ aligner would have dealt with are."
(report (and (not func) align-large-region beg end
(>= (- end beg) align-large-region)))
(rule-index 1)
- (rule-count (length rules)))
+ (rule-count (length rules))
+ markers)
(if (and align-indent-before-aligning real-beg end-mark)
(indent-region real-beg end-mark nil))
(while rules
@@ -1315,14 +1319,14 @@ aligner would have dealt with are."
(thissep (if rulesep (cdr rulesep) separate))
same (eol 0)
search-start
- group group-c
+ groups group-c
spacing spacing-c
tab-stop tab-stop-c
repeat repeat-c
valid valid-c
first
regions index
- last-point b e
+ last-point
save-match-data
exclude-p
align-props)
@@ -1386,7 +1390,7 @@ aligner would have dealt with are."
(when (or (not func)
(funcall func beg end rule))
(unwind-protect
- (let (exclude-areas)
+ (let (rule-beg exclude-areas)
;; determine first of all where the exclusions
;; lie in this region
(when exclude-rules
@@ -1451,11 +1455,10 @@ aligner would have dealt with are."
;; lookup the `group' attribute the first time
;; that we need it
(unless group-c
- (setq group (or (cdr (assq 'group rule)) 1))
- (if (listp group)
- (setq first (car group))
- (setq first group group (list group)))
- (setq group-c t))
+ (setq groups (or (cdr (assq 'group rule)) 1))
+ (unless (listp groups)
+ (setq groups (list groups)))
+ (setq first (car groups)))
(unless spacing-c
(setq spacing (cdr (assq 'spacing rule))
@@ -1464,19 +1467,19 @@ aligner would have dealt with are."
(unless tab-stop-c
(setq tab-stop
(let ((rule-ts (assq 'tab-stop rule)))
- (if rule-ts
- (cdr rule-ts)
- (if (symbolp align-to-tab-stop)
- (symbol-value align-to-tab-stop)
- align-to-tab-stop)))
+ (cond (rule-ts
+ (cdr rule-ts))
+ ((symbolp align-to-tab-stop)
+ (symbol-value align-to-tab-stop))
+ (t
+ align-to-tab-stop)))
tab-stop-c t))
;; test whether we have found a match on the same
;; line as a previous match
- (if (> (point) eol)
- (progn
- (setq same nil)
- (align--set-marker eol (line-end-position))))
+ (when (> (point) eol)
+ (setq same nil)
+ (align--set-marker eol (line-end-position)))
;; lookup the `repeat' attribute the first time
(or repeat-c
@@ -1492,7 +1495,7 @@ aligner would have dealt with are."
;; match, and save the match-data, since either
;; the `valid' form, or the code that searches for
;; section separation, might alter it
- (setq b (match-beginning first)
+ (setq rule-beg (match-beginning first)
save-match-data (match-data))
;; unless the `valid' attribute is set, and tells
@@ -1504,15 +1507,13 @@ aligner would have dealt with are."
;; section. If so, we should align what we've
;; collected so far, and then begin collecting
;; anew for the next alignment section
- (if (and last-point
- (align-new-section-p last-point b
- thissep))
- (progn
- (align-regions regions align-props
- rule func)
- (setq regions nil)
- (setq align-props nil)))
- (align--set-marker last-point b t)
+ (when (and last-point
+ (align-new-section-p last-point rule-beg
+ thissep))
+ (align-regions regions align-props rule func)
+ (setq regions nil)
+ (setq align-props nil))
+ (align--set-marker last-point rule-beg t)
;; restore the match data
(set-match-data save-match-data)
@@ -1522,62 +1523,60 @@ aligner would have dealt with are."
(let ((excls exclude-areas))
(setq exclude-p nil)
(while excls
- (if (and (< (match-beginning (car group))
+ (if (and (< (match-beginning (car groups))
(cdar excls))
- (> (match-end (car (last group)))
+ (> (match-end (car (last groups)))
(caar excls)))
(setq exclude-p t
excls nil)
(setq excls (cdr excls)))))
- ;; go through the list of parenthesis groups
- ;; matching whitespace text to be
- ;; contracted/expanded (or possibly
- ;; justified, if the `justify' attribute was
- ;; set)
+ ;; go through the parenthesis groups
+ ;; matching whitespace to be contracted or
+ ;; expanded (or possibly justified, if the
+ ;; `justify' attribute was set)
(unless exclude-p
- (let ((g group))
- (while g
-
- ;; we have to use markers, since
- ;; `align-areas' may modify the buffer
- (setq b (copy-marker
- (match-beginning (car g)) t)
- e (copy-marker (match-end (car g)) t))
-
- ;; record this text region for alignment
+ (dolist (g groups)
+ ;; We must use markers, since
+ ;; `align-areas' may modify the buffer.
+ ;; Avoid polluting the markers.
+ (let* ((group-beg (copy-marker
+ (match-beginning g) t))
+ (group-end (copy-marker
+ (match-end g) t))
+ (region (cons group-beg group-end))
+ (props (cons (if (listp spacing)
+ (car spacing)
+ spacing)
+ (if (listp tab-stop)
+ (car tab-stop)
+ tab-stop))))
+ (push group-beg markers)
+ (push group-end markers)
(setq index (if same (1+ index) 0))
- (let ((region (cons b e))
- (props (cons
- (if (listp spacing)
- (car spacing)
- spacing)
- (if (listp tab-stop)
- (car tab-stop)
- tab-stop))))
- (if (nth index regions)
- (setcar (nthcdr index regions)
- (cons region
- (nth index regions)))
- (if regions
- (progn
- (nconc regions
- (list (list region)))
- (nconc align-props (list props)))
- (setq regions
- (list (list region)))
- (setq align-props (list props)))))
-
- ;; if any further rule matches are
- ;; found before `eol', then they are
- ;; on the same line as this one; this
- ;; can only happen if the `repeat'
- ;; attribute is non-nil
- (if (listp spacing)
- (setq spacing (cdr spacing)))
- (if (listp tab-stop)
- (setq tab-stop (cdr tab-stop)))
- (setq same t g (cdr g))))
+ (cond
+ ((nth index regions)
+ (setcar (nthcdr index regions)
+ (cons region
+ (nth index regions))))
+ (regions
+ (nconc regions
+ (list (list region)))
+ (nconc align-props (list props)))
+ (t
+ (setq regions
+ (list (list region)))
+ (setq align-props (list props)))))
+ ;; If any further rule matches are found
+ ;; before `eol', they are on the same
+ ;; line as this one; this can only
+ ;; happen if the `repeat' attribute is
+ ;; non-nil.
+ (if (listp spacing)
+ (setq spacing (cdr spacing)))
+ (if (listp tab-stop)
+ (setq tab-stop (cdr tab-stop)))
+ (setq same t))
;; if `repeat' has not been set, move to
;; the next line; don't bother searching
@@ -1598,6 +1597,11 @@ aligner would have dealt with are."
(setq case-fold-search current-case-fold)))))))
(setq rules (cdr rules)
rule-index (1+ rule-index)))
+ ;; This function can use a lot of temporary markers, so instead of
+ ;; waiting for the next GC we delete them immediately (Bug#10047).
+ (set-marker end-mark nil)
+ (dolist (m markers)
+ (set-marker m nil))
(if report
(message "Aligning...done"))))
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index 715879534b0..c5790603d11 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -1,6 +1,6 @@
;; allout-widgets.el --- Visually highlight allout outline structure.
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;; Author: Ken Manheimer <ken dot manheimer at gmail...>
;; Maintainer: Ken Manheimer <ken dot manheimer at gmail...>
@@ -9,6 +9,21 @@
;; Keywords: outlines
;; Website: http://myriadicity.net/software-and-systems/craft/emacs-allout
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
;;; Commentary:
;; This is an allout outline-mode add-on that highlights outline structure
@@ -49,7 +64,7 @@
;; systematically couple overlays, graphics, and other features with
;; allout-governed text.
-;;;_: Code (structured with comments that delineate an allout outline)
+;;; Code:
;;;_ : General Environment
(require 'allout)
@@ -131,13 +146,14 @@ explicitly invoke `allout-widgets-mode' in allout buffers where
you want allout widgets operation.
See `allout-widgets-mode' for allout widgets mode features."
+ :version "24.1"
:type 'boolean
:group 'allout-widgets
:set 'allout-widgets-setup
)
;; ;;;_ = allout-widgets-allow-unruly-edits
;; (defcustom allout-widgets-allow-unruly-edits nil
-;; "*Control whether manual edits are restricted to maintain outline integrity.
+;; "Control whether manual edits are restricted to maintain outline integrity.
;; When nil, manual edits must either be within an item's body or encompass
;; one or more items completely - eg, killing topics as entities, rather than
@@ -155,16 +171,19 @@ See `allout-widgets-mode' for allout widgets mode features."
;;;_ = allout-widgets-icons-dark-subdir
(defcustom allout-widgets-icons-dark-subdir "icons/allout-widgets/dark-bg/"
"Directory on `image-load-path' holding allout icons for dark backgrounds."
+ :version "24.1"
:type 'string
:group 'allout-widgets)
;;;_ = allout-widgets-icons-light-subdir
(defcustom allout-widgets-icons-light-subdir "icons/allout-widgets/light-bg/"
"Directory on `image-load-path' holding allout icons for light backgrounds."
+ :version "24.1"
:type 'string
:group 'allout-widgets)
;;;_ = allout-widgets-icon-types
(defcustom allout-widgets-icon-types '(xpm png)
"File extensions for the icon graphic format types, in order of preference."
+ :version "24.1"
:type '(repeat symbol)
:group 'allout-widgets)
@@ -172,29 +191,33 @@ See `allout-widgets-mode' for allout widgets mode features."
;;;_ = allout-widgets-theme-dark-background
(defcustom allout-widgets-theme-dark-background "allout-dark-bg"
"Identify the outline's icon theme to use with a dark background."
+ :version "24.1"
:type '(string)
:group 'allout-widgets)
;;;_ = allout-widgets-theme-light-background
(defcustom allout-widgets-theme-light-background "allout-light-bg"
"Identify the outline's icon theme to use with a light background."
+ :version "24.1"
:type '(string)
:group 'allout-widgets)
;;;_ = allout-widgets-item-image-properties-emacs
(defcustom allout-widgets-item-image-properties-emacs
'(:ascent center :mask (heuristic t))
- "*Default properties item widget images in mainline Emacs."
+ "Default properties item widget images in mainline Emacs."
+ :version "24.1"
:type 'plist
:group 'allout-widgets)
;;;_ = allout-widgets-item-image-properties-xemacs
(defcustom allout-widgets-item-image-properties-xemacs
nil
- "*Default properties item widget images in XEmacs."
+ "Default properties item widget images in XEmacs."
+ :version "24.1"
:type 'plist
:group 'allout-widgets)
;;;_ . Developer
;;;_ = allout-widgets-run-unit-tests-on-load
(defcustom allout-widgets-run-unit-tests-on-load nil
- "*When non-nil, unit tests will be run at end of loading allout-widgets.
+ "When non-nil, unit tests will be run at end of loading allout-widgets.
Generally, allout widgets code developers are the only ones who'll want to
set this.
@@ -204,37 +227,41 @@ doing byte-compilation with a repeat count, so the file is loaded after
compilation.)
See `allout-widgets-run-unit-tests' to see what's run."
+ :version "24.1"
:type 'boolean
:group 'allout-widgets-developer)
;;;_ = allout-widgets-time-decoration-activity
(defcustom allout-widgets-time-decoration-activity nil
- "*Retain timing info of the last cooperative redecoration.
+ "Retain timing info of the last cooperative redecoration.
The details are retained as the value of
`allout-widgets-last-decoration-timing'.
Generally, allout widgets code developers are the only ones who'll want to
set this."
+ :version "24.1"
:type 'boolean
:group 'allout-widgets-developer)
;;;_ = allout-widgets-hook-error-post-time 0
(defcustom allout-widgets-hook-error-post-time 0
- "*Amount of time to sit showing hook error messages.
+ "Amount of time to sit showing hook error messages.
0 is minimal, or nil to not post to the message area.
This is for debugging purposes."
+ :version "24.1"
:type 'integer
:group 'allout-widgets-developer)
;;;_ = allout-widgets-maintain-tally nil
(defcustom allout-widgets-maintain-tally nil
- "*If non-nil, maintain a collection of widgets, `allout-widgets-tally'.
+ "If non-nil, maintain a collection of widgets, `allout-widgets-tally'.
This is for debugging purposes.
The tally shows the total number of item widgets in the current
buffer, and tracking increases as new widgets are added and
decreases as obsolete widgets are garbage collected."
+ :version "24.1"
:type 'boolean
:group 'allout-widgets-developer)
(defvar allout-widgets-tally nil
@@ -263,11 +290,12 @@ The number varies according to the evanescence of objects on a
(format ":%s" (hash-table-count allout-widgets-tally))))
;;;_ = allout-widgets-track-decoration nil
(defcustom allout-widgets-track-decoration nil
- "*If non-nil, show cursor position of each item decoration.
+ "If non-nil, show cursor position of each item decoration.
This is for debugging purposes, and generally set at need in a
buffer rather than as a prevailing configuration \(but it's handy
to publicize it by making it a customization variable\)."
+ :version "24.1"
:type 'boolean
:group 'allout-widgets-developer)
(make-variable-buffer-local 'allout-widgets-track-decoration)
@@ -388,7 +416,7 @@ onto the front.")
;;;_ , Widget-specific outline text format
;;;_ = allout-escaped-prefix-regexp
(defvar allout-escaped-prefix-regexp ""
- "*Regular expression for body text that would look like an item prefix if
+ "Regular expression for body text that would look like an item prefix if
not altered with an escape sequence.")
(make-variable-buffer-local 'allout-escaped-prefix-regexp)
;;;_ , Widget element formatting
@@ -551,13 +579,13 @@ outline hot-spot navigation \(see `allout-mode')."
(if (current-local-map)
(set-keymap-parent allout-item-body-keymap (current-local-map)))
- (add-hook 'allout-exposure-change-hook
+ (add-hook 'allout-exposure-change-functions
'allout-widgets-exposure-change-recorder nil 'local)
- (add-hook 'allout-structure-added-hook
+ (add-hook 'allout-structure-added-functions
'allout-widgets-additions-recorder nil 'local)
- (add-hook 'allout-structure-deleted-hook
+ (add-hook 'allout-structure-deleted-functions
'allout-widgets-deletions-recorder nil 'local)
- (add-hook 'allout-structure-shifted-hook
+ (add-hook 'allout-structure-shifted-functions
'allout-widgets-shifts-recorder nil 'local)
(add-hook 'allout-after-copy-or-kill-hook
'allout-widgets-after-copy-or-kill-function nil 'local)
@@ -598,13 +626,13 @@ outline hot-spot navigation \(see `allout-mode')."
(remove-hook 'after-change-functions
'allout-widgets-after-change-handler 'local)
- (remove-hook 'allout-exposure-change-hook
+ (remove-hook 'allout-exposure-change-functions
'allout-widgets-exposure-change-recorder 'local)
- (remove-hook 'allout-structure-added-hook
+ (remove-hook 'allout-structure-added-functions
'allout-widgets-additions-recorder 'local)
- (remove-hook 'allout-structure-deleted-hook
+ (remove-hook 'allout-structure-deleted-functions
'allout-widgets-deletions-recorder 'local)
- (remove-hook 'allout-structure-shifted-hook
+ (remove-hook 'allout-structure-shifted-functions
'allout-widgets-shifts-recorder 'local)
(remove-hook 'allout-after-copy-or-kill-hook
'allout-widgets-after-copy-or-kill-function 'local)
@@ -964,7 +992,7 @@ Records changes in `allout-widgets-changes-record'."
(defun allout-widgets-exposure-change-processor (changes)
"Widgetize and adjust item widgets tracking allout outline exposure changes.
-Generally invoked via `allout-exposure-change-hook'."
+Generally invoked via `allout-exposure-change-functions'."
(let ((changes (sort changes (function (lambda (this next)
(< (cadr this) (cadr next))))))
@@ -1031,7 +1059,7 @@ Generally invoked via `allout-exposure-change-hook'."
(defun allout-widgets-additions-recorder (from to)
"Record allout item additions for tracking during post-command processing.
-Intended for use on `allout-structure-added-hook'.
+Intended for use on `allout-structure-added-functions'.
FROM point at the start of the first new item and TO is point at the start
of the last one.
@@ -1078,8 +1106,7 @@ Dispatched by `allout-widgets-post-command-business' in response to
;;;_ > allout-widgets-deletions-recorder (depth from)
(defun allout-widgets-deletions-recorder (depth from)
"Record allout item deletions for tracking during post-command processing.
-
-Intended for use on `allout-structure-deleted-hook'.
+Intended for use on `allout-structure-deleted-functions'.
DEPTH is the depth of the deleted subtree, and FROM is the point from which
the subtree was deleted.
@@ -1106,8 +1133,7 @@ Dispatched by `allout-widgets-post-command-business' in response to
;;;_ > allout-widgets-shifts-recorder (shifted-amount at)
(defun allout-widgets-shifts-recorder (shifted-amount at)
"Record outline subtree shifts for tracking during post-command processing.
-
-Intended for use on `allout-structure-shifted-hook'.
+Intended for use on `allout-structure-shifted-functions'.
SHIFTED-AMOUNT is the depth change and AT is the point at the start of the
subtree that's been shifted.
@@ -1348,7 +1374,6 @@ FROM and TO must be in increasing order, as must be the pairs in RANGES."
;; (time-trial
;; '(let ((size 10000)
;; doing)
-;; (random t)
;; (dotimes (count size)
;; (setq doing (random size))
;; (funcall try doing (+ doing (random 5)))
@@ -1635,7 +1660,7 @@ Use this to redecorate only the item, when you know that its
situation with respect to siblings, parent, and offspring is
unchanged from its last decoration. Use
`allout-decorate-item-and-context' instead to reassess and adjust
-relevent context, when suitable."
+relevant context, when suitable."
(if (not (equal (widget-get item-widget :last-decorated-tick)
allout-command-counter))
(let ((was-modified (buffer-modified-p))
diff --git a/lisp/allout.el b/lisp/allout.el
index 480c22d31e0..e93aefd12cc 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -1,6 +1,6 @@
;;; allout.el --- extensive outline mode for use alone and with other modes
-;; Copyright (C) 1992-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Ken Manheimer <ken dot manheimer at gmail...>
;; Maintainer: Ken Manheimer <ken dot manheimer at gmail...>
@@ -240,6 +240,7 @@ See the existing keys for examples.
Functions can be bound to multiple keys, but binding keys to
multiple functions will not work - the last binding for a key
prevails."
+ :version "24.1"
:type 'allout-keybindings-binding
:group 'allout-keybindings
:set 'allout-compose-and-institute-keymap
@@ -263,6 +264,7 @@ Use vector format for the keys:
parentheses, with the literal key, as above, preceded by the name(s)
of the modifiers, eg: [(control ?a)]
See the existing keys for examples."
+ :version "24.1"
:type 'allout-keybindings-binding
:group 'allout-keybindings
:set 'allout-compose-and-institute-keymap
@@ -402,6 +404,7 @@ else allout's special hanging-indent maintaining auto-fill function,
;;;_ = allout-inhibit-auto-fill-on-headline
(defcustom allout-inhibit-auto-fill-on-headline nil
"If non-nil, auto-fill will be inhibited while on topic's header line."
+ :version "24.1"
:type 'boolean
:group 'allout)
(make-variable-buffer-local 'allout-inhibit-auto-fill-on-headline)
@@ -764,6 +767,7 @@ Set this var to the bullet you want to use for file cross-references."
"If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic
numbers to minimal amount with some context. Otherwise, entire
numbers are always used."
+ :version "24.1"
:type 'boolean
:group 'allout)
@@ -941,7 +945,7 @@ case the value of `allout-default-layout' is used.")
;;;_ : Topic header format
;;;_ = allout-regexp
(defvar allout-regexp ""
- "*Regular expression to match the beginning of a heading line.
+ "Regular expression to match the beginning of a heading line.
Any line whose beginning matches this regexp is considered a
heading. This var is set according to the user configuration vars
@@ -961,7 +965,7 @@ and `allout-distinctive-bullets-string'.")
(make-variable-buffer-local 'allout-bullets-string-len)
;;;_ = allout-depth-specific-regexp
(defvar allout-depth-specific-regexp ""
- "*Regular expression to match a heading line prefix for a particular depth.
+ "Regular expression to match a heading line prefix for a particular depth.
This expression is used to search for depth-specific topic
headers at depth 2 and greater. Use `allout-depth-one-regexp'
@@ -974,7 +978,7 @@ topic prefix to be matched.")
(make-variable-buffer-local 'allout-depth-specific-regexp)
;;;_ = allout-depth-one-regexp
(defvar allout-depth-one-regexp ""
- "*Regular expression to match a heading line prefix for depth one.
+ "Regular expression to match a heading line prefix for depth one.
This var is set according to the user configuration vars by
`set-allout-regexp'. It is prepared with format strings for two
@@ -1399,19 +1403,21 @@ their settings before allout-mode was started."
,expr))
;;;_ = allout-mode-hook
(defvar allout-mode-hook nil
- "*Hook that's run when allout mode starts.")
+ "Hook run when allout mode starts.")
;;;_ = allout-mode-deactivate-hook
-(defvar allout-mode-deactivate-hook nil
- "*Hook that's run when allout mode ends.")
(define-obsolete-variable-alias 'allout-mode-deactivate-hook
'allout-mode-off-hook "24.1")
+(defvar allout-mode-deactivate-hook nil
+ "Hook run when allout mode ends.")
;;;_ = allout-exposure-category
(defvar allout-exposure-category nil
"Symbol for use as allout invisible-text overlay category.")
-;;;_ = allout-exposure-change-hook
-(defvar allout-exposure-change-hook nil
- "*Hook that's run after allout outline subtree exposure changes.
+;;;_ = allout-exposure-change-functions
+(define-obsolete-variable-alias 'allout-exposure-change-hook
+ 'allout-exposure-change-functions "24.3")
+(defcustom allout-exposure-change-functions nil
+ "Abnormal hook run after allout outline subtree exposure changes.
It is run at the conclusion of `allout-flag-region'.
Functions on the hook must take three arguments:
@@ -1420,21 +1426,31 @@ Functions on the hook must take three arguments:
- TO -- integer indicating the point of the end of the change.
- FLAG -- change mode: nil for exposure, otherwise concealment.
-This hook might be invoked multiple times by a single command.")
-;;;_ = allout-structure-added-hook
-(defvar allout-structure-added-hook nil
- "*Hook that's run after addition of items to the outline.
+This hook might be invoked multiple times by a single command."
+ :type 'hook
+ :group 'allout
+ :version "24.3")
+;;;_ = allout-structure-added-functions
+(define-obsolete-variable-alias 'allout-structure-added-hook
+ 'allout-structure-added-functions "24.3")
+(defcustom allout-structure-added-functions nil
+ "Abnormal hook run after adding items to an Allout outline.
Functions on the hook should take two arguments:
- NEW-START -- integer indicating position of start of the first new item.
- NEW-END -- integer indicating position of end of the last new item.
-This hook might be invoked multiple times by a single command.")
-;;;_ = allout-structure-deleted-hook
-(defvar allout-structure-deleted-hook nil
- "*Hook that's run after disciplined deletion of subtrees from the outline.
+This hook might be invoked multiple times by a single command."
+ :type 'hook
+ :group 'allout
+ :version "24.3")
+;;;_ = allout-structure-deleted-functions
+(define-obsolete-variable-alias 'allout-structure-deleted-hook
+ 'allout-structure-deleted-functions "24.3")
+(defcustom allout-structure-deleted-functions nil
+ "Abnormal hook run after deleting subtrees from an Allout outline.
Functions on the hook must take two arguments:
- DEPTH -- integer indicating the depth of the subtree that was deleted.
@@ -1443,11 +1459,16 @@ Functions on the hook must take two arguments:
Some edits that remove or invalidate items may be missed by this hook:
specifically edits that native allout routines do not control.
-This hook might be invoked multiple times by a single command.")
-;;;_ = allout-structure-shifted-hook
-(defvar allout-structure-shifted-hook nil
- "*Hook that's run after shifting of items in the outline.
+This hook might be invoked multiple times by a single command."
+ :type 'hook
+ :group 'allout
+ :version "24.3")
+;;;_ = allout-structure-shifted-functions
+(define-obsolete-variable-alias 'allout-structure-shifted-hook
+ 'allout-structure-shifted-functions "24.3")
+(defcustom allout-structure-shifted-functions nil
+ "Abnormal hook run after shifting items in an Allout outline.
Functions on the hook should take two arguments:
- DEPTH-CHANGE -- integer indicating depth increase, negative for decrease
@@ -1456,20 +1477,27 @@ Functions on the hook should take two arguments:
Some edits that shift items can be missed by this hook: specifically edits
that native allout routines do not control.
-This hook might be invoked multiple times by a single command.")
+This hook might be invoked multiple times by a single command."
+ :type 'hook
+ :group 'allout
+ :version "24.3")
+
;;;_ = allout-after-copy-or-kill-hook
-(defvar allout-after-copy-or-kill-hook nil
- "*Hook that's run after copying outline text.
+(defcustom allout-after-copy-or-kill-hook nil
+ "Normal hook run after copying outline text.."
+ :type 'hook
+ :group 'allout
+ :version "24.3")
-Functions on the hook should not require any arguments.")
;;;_ = allout-post-undo-hook
-(defvar allout-post-undo-hook nil
- "*Hook that's run after undo activity.
-
+(defcustom allout-post-undo-hook nil
+ "Normal hook run after undo activity.
The item that's current when the hook is run *may* be the one
-that was affected by the undo.
+that was affected by the undo.."
+ :type 'hook
+ :group 'allout
+ :version "24.3")
-Functions on the hook should not require any arguments.")
;;;_ = allout-outside-normal-auto-fill-function
(defvar allout-outside-normal-auto-fill-function nil
"Value of `normal-auto-fill-function' outside of allout mode.
@@ -1494,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
@@ -1510,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
@@ -1629,10 +1657,9 @@ and the place for the cursor after the decryption is done."
(defmacro allout-called-interactively-p ()
"A version of `called-interactively-p' independent of Emacs version."
;; ... to ease maintenance of allout without betraying deprecation.
- (if (equal (subr-arity (symbol-function 'called-interactively-p))
- '(0 . 0))
- '(called-interactively-p)
- '(called-interactively-p 'interactive)))
+ (if (ignore-errors (called-interactively-p 'interactive) t)
+ '(called-interactively-p 'interactive)
+ '(called-interactively-p)))
;;;_ = allout-inhibit-aberrance-doublecheck nil
;; In some exceptional moments, disparate topic depths need to be allowed
;; momentarily, eg when one topic is being yanked into another and they're
@@ -1660,11 +1687,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."
@@ -1879,10 +1905,10 @@ without changes to the allout core. Here are key ones:
`allout-mode-hook'
`allout-mode-deactivate-hook' (deprecated)
`allout-mode-off-hook'
-`allout-exposure-change-hook'
-`allout-structure-added-hook'
-`allout-structure-deleted-hook'
-`allout-structure-shifted-hook'
+`allout-exposure-change-functions'
+`allout-structure-added-functions'
+`allout-structure-deleted-functions'
+`allout-structure-shifted-functions'
`allout-after-copy-or-kill-hook'
`allout-post-undo-hook'
@@ -3841,7 +3867,7 @@ Nuances:
(allout-show-children)))
(end-of-line)
- (run-hook-with-args 'allout-structure-added-hook start end)
+ (run-hook-with-args 'allout-structure-added-functions start end)
)
)
)
@@ -3966,7 +3992,7 @@ Note that refill of indented paragraphs is not done."
nil ;;; number-control
nil ;;; index
t) ;;; do-successors
- (run-hook-with-args 'allout-exposure-change-hook
+ (run-hook-with-args 'allout-exposure-change-functions
from to t))
(setq arg (1- arg))
(if (<= arg 0)
@@ -4067,7 +4093,7 @@ this function."
(not (allout-encrypted-topic-p)))
(allout-reindent-body current-depth new-depth))
- (run-hook-with-args 'allout-exposure-change-hook mb me nil)
+ (run-hook-with-args 'allout-exposure-change-functions mb me nil)
;; Recursively rectify successive siblings of orig topic if
;; caller elected for it:
@@ -4329,7 +4355,7 @@ the file can be adjusted to any positive depth, however."
(allout-show-children))))))
(let ((where (point)))
(allout-rebullet-topic 1 (and (> arg 1) 'sans-offspring))
- (run-hook-with-args 'allout-structure-shifted-hook arg where))))
+ (run-hook-with-args 'allout-structure-shifted-functions arg where))))
;;;_ > allout-shift-out (arg)
(defun allout-shift-out (arg)
"Decrease depth of current heading and any topics collapsed within it.
@@ -4369,7 +4395,7 @@ subtopics into siblings of the item."
(goto-char child-point)
(allout-shift-out 1))))
(allout-rebullet-topic (* arg -1))))
- (run-hook-with-args 'allout-structure-shifted-hook (* arg -1) where))))
+ (run-hook-with-args 'allout-structure-shifted-functions (* arg -1) where))))
;;;_ : Surgery (kill-ring) functions with special provisions for outlines:
;;;_ > allout-kill-line (&optional arg)
(defun allout-kill-line (&optional arg)
@@ -4404,7 +4430,7 @@ subtopics into siblings of the item."
(if (not (save-match-data (looking-at allout-regexp)))
(allout-next-heading))
(allout-renumber-to-depth depth)))
- (run-hook-with-args 'allout-structure-deleted-hook depth (point))))))
+ (run-hook-with-args 'allout-structure-deleted-functions depth (point))))))
;;;_ > allout-copy-line-as-kill ()
(defun allout-copy-line-as-kill ()
"Like `allout-kill-topic', but save to kill ring instead of deleting."
@@ -4452,7 +4478,7 @@ Topic exposure is marked with text-properties, to be used by
(save-excursion
(allout-renumber-to-depth depth))
- (run-hook-with-args 'allout-structure-deleted-hook depth (point)))))
+ (run-hook-with-args 'allout-structure-deleted-functions depth (point)))))
;;;_ > allout-copy-topic-as-kill ()
(defun allout-copy-topic-as-kill ()
"Like `allout-kill-topic', but save to kill ring instead of deleting."
@@ -4664,7 +4690,7 @@ however, are left exactly like normal, non-allout-specific yanks."
(allout-deannotate-hidden (allout-mark-marker t) (point)))
(if (not resituate)
(exchange-point-and-mark))
- (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end))))
+ (run-hook-with-args 'allout-structure-added-functions subj-beg subj-end))))
;;;_ > allout-yank (&optional arg)
(defun allout-yank (&optional arg)
"`allout-mode' yank, with depth and numbering adjustment of yanked topics.
@@ -4761,9 +4787,9 @@ by pops to non-distinctive yanks. Bug..."
;;;_ > allout-flag-region (from to flag)
(defun allout-flag-region (from to flag)
"Conceal text between FROM and TO if FLAG is non-nil, else reveal it.
-
-Exposure-change hook `allout-exposure-change-hook' is run with the same
-arguments as this function, after the exposure changes are made."
+After the exposure changes are made, run the abnormal hook
+`allout-exposure-change-functions' with the same arguments as
+this function."
;; We use outline invisibility spec.
(remove-overlays from to 'category 'allout-exposure-category)
@@ -4779,7 +4805,7 @@ arguments as this function, after the exposure changes are made."
(overlay-put o (pop props) (pop props))
(error nil))))))
(setq allout-this-command-hid-text t))
- (run-hook-with-args 'allout-exposure-change-hook from to flag))
+ (run-hook-with-args 'allout-exposure-change-functions from to flag))
;;;_ > allout-flag-current-subtree (flag)
(defun allout-flag-current-subtree (flag)
"Conceal currently-visible topic's subtree if FLAG non-nil, else reveal it."
@@ -5284,11 +5310,11 @@ Examples:
Expose children and grandchildren of first topic at current
level, and expose children of subsequent topics at current
level *except* for the last, which should be opened completely."
- (list 'save-excursion
- '(if (not (or (allout-goto-prefix-doublechecked)
- (allout-next-heading)))
- (error "allout-new-exposure: Can't find any outline topics"))
- (list 'allout-expose-topic (list 'quote spec))))
+ `(save-excursion
+ (if (not (or (allout-goto-prefix-doublechecked)
+ (allout-next-heading)))
+ (error "allout-new-exposure: Can't find any outline topics"))
+ (allout-expose-topic ',spec)))
;;;_ #7 Systematic outline presentation -- copying, printing, flattening
@@ -6018,7 +6044,7 @@ See `allout-toggle-current-subtree-encryption' for more details."
(allout-inhibit-auto-save-info-for-decryption was-buffer-saved-size)
(allout-maybe-resume-auto-save-info-after-encryption))
- (run-hook-with-args 'allout-structure-added-hook
+ (run-hook-with-args 'allout-structure-added-functions
bullet-pos subtree-end))))
;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue
;;; &optional rejected)
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index abb6a961018..da2880c404c 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -1,6 +1,6 @@
;;; ansi-color.el --- translate ANSI escape sequences into faces
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Alex Schroeder <alex@gnu.org>
@@ -83,14 +83,14 @@
"Translating SGR control sequences to faces.
This translation effectively colorizes strings and regions based upon
SGR control sequences embedded in the text. SGR (Select Graphic
-Rendition) control sequences are defined in section 3.8.117 of the
+Rendition) control sequences are defined in section 8.3.117 of the
ECMA-48 standard \(identical to ISO/IEC 6429), which is freely available
as a PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>."
:version "21.1"
:group 'processes)
(defcustom ansi-color-faces-vector
- [default bold default italic underline bold bold-italic modeline]
+ [default bold default italic underline success warning error]
"Faces used for SGR control sequences determining a face.
This vector holds the faces used for SGR control sequence parameters 0
to 7.
@@ -101,9 +101,9 @@ Parameter Description Face used by default
2 faint default
3 italic italic
4 underlined underline
- 5 slowly blinking bold
- 6 rapidly blinking bold-italic
- 7 negative image modeline
+ 5 slowly blinking success
+ 6 rapidly blinking warning
+ 7 negative image error
Note that the symbol `default' is special: It will not be combined
with the current face.
@@ -183,6 +183,11 @@ in shell buffers. You set this variable by calling one of:
:group 'ansi-colors
:version "23.2")
+(defvar ansi-color-apply-face-function 'ansi-color-apply-overlay-face
+ "Function for applying an Ansi Color face to text in a buffer.
+This function should accept three arguments: BEG, END, and FACE,
+and it should apply face FACE to the text between BEG and END.")
+
;;;###autoload
(defun ansi-color-for-comint-mode-on ()
"Set `ansi-color-for-comint-mode' to t."
@@ -212,8 +217,12 @@ The comint output is assumed to lie between the marker
`comint-last-output-start' and the process-mark.
This is a good function to put in `comint-output-filter-functions'."
- (let ((start-marker (or comint-last-output-start
- (point-min-marker)))
+ (let ((start-marker (if (and (markerp comint-last-output-start)
+ (eq (marker-buffer comint-last-output-start)
+ (current-buffer))
+ (marker-position comint-last-output-start))
+ comint-last-output-start
+ (point-min-marker)))
(end-marker (process-mark (get-buffer-process (current-buffer)))))
(cond ((eq ansi-color-for-comint-mode nil))
((eq ansi-color-for-comint-mode 'filter)
@@ -221,18 +230,16 @@ This is a good function to put in `comint-output-filter-functions'."
(t
(ansi-color-apply-on-region start-marker end-marker)))))
-(add-hook 'comint-output-filter-functions
- 'ansi-color-process-output)
-
-(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
"Context saved between two calls to `ansi-color-apply'.
-This is a list of the form (FACES FRAGMENT) or nil. FACES is a list of
-faces the last call to `ansi-color-apply' ended with, and FRAGMENT is a
-string starting with an escape sequence, possibly the start of a new
+This is a list of the form (CODES FRAGMENT) or nil. CODES
+represents the state the last call to `ansi-color-apply' ended
+with, currently a list of ansi codes, and FRAGMENT is a string
+starting with an escape sequence, possibly the start of a new
escape sequence.")
(make-variable-buffer-local 'ansi-color-context)
@@ -264,6 +271,20 @@ This function can be added to `comint-preoutput-filter-functions'."
(setq ansi-color-context (if fragment (list nil fragment))))
result))
+(defun ansi-color--find-face (codes)
+ "Return the face corresponding to CODES."
+ (let (faces)
+ (while codes
+ (let ((face (ansi-color-get-face-1 (pop codes))))
+ ;; In the (default underline) face, say, the value of the
+ ;; "underline" attribute of the `default' face wins.
+ (unless (eq face 'default)
+ (push face faces))))
+ ;; Avoid some long-lived conses in the common case.
+ (if (cdr faces)
+ (nreverse faces)
+ (car faces))))
+
(defun ansi-color-apply (string)
"Translates SGR control sequences into text properties.
Delete all other control sequences without processing them.
@@ -274,12 +295,12 @@ are given in `ansi-color-faces-vector' and `ansi-color-names-vector'.
See function `ansi-color-apply-sequence' for details.
Every call to this function will set and use the buffer-local variable
-`ansi-color-context' to save partial escape sequences and current face.
+`ansi-color-context' to save partial escape sequences and current ansi codes.
This information will be used for the next call to `ansi-color-apply'.
Set `ansi-color-context' to nil if you don't want this.
This function can be added to `comint-preoutput-filter-functions'."
- (let ((face (car ansi-color-context))
+ (let ((codes (car ansi-color-context))
(start 0) end escape-sequence result
colorized-substring)
;; If context was saved and is a string, prepend it.
@@ -290,8 +311,8 @@ This function can be added to `comint-preoutput-filter-functions'."
(while (setq end (string-match ansi-color-regexp string start))
(setq escape-sequence (match-string 1 string))
;; Colorize the old block from start to end using old face.
- (when face
- (put-text-property start end 'font-lock-face face string))
+ (when codes
+ (put-text-property start end 'font-lock-face (ansi-color--find-face codes) string))
(setq colorized-substring (substring string start end)
start (match-end 0))
;; Eliminate unrecognized ANSI sequences.
@@ -300,10 +321,10 @@ This function can be added to `comint-preoutput-filter-functions'."
(replace-match "" nil nil colorized-substring)))
(push colorized-substring result)
;; Create new face, by applying escape sequence parameters.
- (setq face (ansi-color-apply-sequence escape-sequence face)))
+ (setq codes (ansi-color-apply-sequence escape-sequence codes)))
;; if the rest of the string should have a face, put it there
- (when face
- (put-text-property start (length string) 'font-lock-face face string))
+ (when codes
+ (put-text-property start (length string) 'font-lock-face (ansi-color--find-face codes) string))
;; save context, add the remainder of the string to the result
(let (fragment)
(if (string-match "\033" string start)
@@ -311,17 +332,18 @@ This function can be added to `comint-preoutput-filter-functions'."
(setq fragment (substring string pos))
(push (substring string start pos) result))
(push (substring string start) result))
- (setq ansi-color-context (if (or face fragment) (list face fragment))))
+ (setq ansi-color-context (if (or codes fragment) (list codes fragment))))
(apply 'concat (nreverse result))))
;; Working with regions
(defvar ansi-color-context-region nil
"Context saved between two calls to `ansi-color-apply-on-region'.
-This is a list of the form (FACES MARKER) or nil. FACES is a list of
-faces the last call to `ansi-color-apply-on-region' ended with, and
-MARKER is a buffer position within an escape sequence or the last
-position processed.")
+This is a list of the form (CODES MARKER) or nil. CODES
+represents the state the last call to `ansi-color-apply-on-region'
+ended with, currently a list of ansi codes, and MARKER is a
+buffer position within an escape sequence or the last position
+processed.")
(make-variable-buffer-local 'ansi-color-context-region)
(defun ansi-color-filter-region (begin end)
@@ -352,19 +374,21 @@ it will override BEGIN, the start of the region. Set
"Translates SGR control sequences into overlays or extents.
Delete all other control sequences without processing them.
-SGR control sequences are applied by setting foreground and
-background colors to the text between BEGIN and END using
-overlays. The colors used are given in `ansi-color-faces-vector'
-and `ansi-color-names-vector'. See `ansi-color-apply-sequence'
-for details.
-
-Every call to this function will set and use the buffer-local variable
-`ansi-color-context-region' to save position and current face. This
-information will be used for the next call to
-`ansi-color-apply-on-region'. Specifically, it will override BEGIN, the
-start of the region and set the face with which to start. Set
-`ansi-color-context-region' to nil if you don't want this."
- (let ((face (car ansi-color-context-region))
+SGR control sequences are applied by calling the function
+specified by `ansi-color-apply-face-function'. The default
+function sets foreground and background colors to the text
+between BEGIN and END, using overlays. The colors used are given
+in `ansi-color-faces-vector' and `ansi-color-names-vector'. See
+`ansi-color-apply-sequence' for details.
+
+Every call to this function will set and use the buffer-local
+variable `ansi-color-context-region' to save position and current
+ansi codes. This information will be used for the next call to
+`ansi-color-apply-on-region'. Specifically, it will override
+BEGIN, the start of the region and set the face with which to
+start. Set `ansi-color-context-region' to nil if you don't want
+this."
+ (let ((codes (car ansi-color-context-region))
(start-marker (or (cadr ansi-color-context-region)
(copy-marker begin)))
(end-marker (copy-marker end))
@@ -379,38 +403,37 @@ start of the region and set the face with which to start. Set
;; Find the next SGR sequence.
(while (re-search-forward ansi-color-regexp end-marker t)
;; Colorize the old block from start to end using old face.
- (when face
- (ansi-color-set-extent-face
- (ansi-color-make-extent start-marker (match-beginning 0))
- face))
+ (funcall ansi-color-apply-face-function
+ start-marker (match-beginning 0)
+ (ansi-color--find-face codes))
;; store escape sequence and new start position
(setq escape-sequence (match-string 1)
start-marker (copy-marker (match-end 0)))
;; delete the escape sequence
(replace-match "")
- ;; create new face by applying all the parameters in the escape
- ;; sequence
- (setq face (ansi-color-apply-sequence escape-sequence face)))
+ ;; Update the list of ansi codes.
+ (setq codes (ansi-color-apply-sequence escape-sequence codes)))
;; search for the possible start of a new escape sequence
(if (re-search-forward "\033" end-marker t)
(progn
;; if the rest of the region should have a face, put it there
- (when face
- (ansi-color-set-extent-face
- (ansi-color-make-extent start-marker (point))
- face))
- ;; save face and point
+ (funcall ansi-color-apply-face-function
+ start-marker (point) (ansi-color--find-face codes))
+ ;; save codes and point
(setq ansi-color-context-region
- (list face (copy-marker (match-beginning 0)))))
+ (list codes (copy-marker (match-beginning 0)))))
;; if the rest of the region should have a face, put it there
- (if face
- (progn
- (ansi-color-set-extent-face
- (ansi-color-make-extent start-marker end-marker)
- face)
- (setq ansi-color-context-region (list face)))
- ;; reset context
- (setq ansi-color-context-region nil))))))
+ (funcall ansi-color-apply-face-function
+ start-marker end-marker (ansi-color--find-face codes))
+ (setq ansi-color-context-region (if codes (list codes)))))))
+
+(defun ansi-color-apply-overlay-face (beg end face)
+ "Make an overlay from BEG to END, and apply face FACE.
+If FACE is nil, do nothing."
+ (when face
+ (ansi-color-set-extent-face
+ (ansi-color-make-extent beg end)
+ face)))
;; This function helps you look for overlapping overlays. This is
;; useful in comint-buffers. Overlapping overlays should not happen!
@@ -490,32 +513,61 @@ XEmacs uses `set-extent-face', Emacs uses `overlay-put'."
;; Helper functions
-(defun ansi-color-apply-sequence (escape-sequence faces)
- "Apply ESCAPE-SEQ to FACES and return the new list of faces.
-
-ESCAPE-SEQ is an escape sequences parsed by `ansi-color-get-face'.
+(defsubst ansi-color-parse-sequence (escape-seq)
+ "Return the list of all the parameters in ESCAPE-SEQ.
-If the new faces start with the symbol `default', then the new
-faces are returned. If the faces start with something else,
-they are appended to the front of the FACES list, and the new
-list of faces is returned.
+ESCAPE-SEQ is a SGR control sequences such as \\033[34m. The parameter
+34 is used by `ansi-color-get-face-1' to return a face definition.
-If `ansi-color-get-face' returns nil, then we either got a
-null-sequence, or we stumbled upon some garbage. In either
-case we return nil."
- (let ((new-faces (ansi-color-get-face escape-sequence)))
- (cond ((null new-faces)
- nil)
- ((eq (car new-faces) 'default)
- (cdr new-faces))
- (t
- ;; Like (append NEW-FACES FACES)
- ;; but delete duplicates in FACES.
- (let ((modified-faces (copy-sequence faces)))
- (dolist (face (nreverse new-faces))
- (setq modified-faces (delete face modified-faces))
- (push face modified-faces))
- modified-faces)))))
+Returns nil only if there's no match for `ansi-color-parameter-regexp'."
+ (let ((i 0)
+ codes val)
+ (while (string-match ansi-color-parameter-regexp escape-seq i)
+ (setq i (match-end 0)
+ val (string-to-number (match-string 1 escape-seq) 10))
+ ;; It so happens that (string-to-number "") => 0.
+ (push val codes))
+ (nreverse codes)))
+
+(defun ansi-color-apply-sequence (escape-sequence codes)
+ "Apply ESCAPE-SEQ to CODES and return the new list of codes.
+
+ESCAPE-SEQ is an escape sequence parsed by `ansi-color-parse-sequence'.
+
+For each new code, the following happens: if it is 1-7, add it to
+the list of codes; if it is 21-25 or 27, delete appropriate
+parameters from the list of codes; if it is 30-37 resp. 39, the
+foreground color code is replaced or added resp. deleted; if it
+is 40-47 resp. 49, the background color code is replaced or added
+resp. deleted; any other code is discarded together with the old
+codes. Finally, the so changed list of codes is returned."
+ (let ((new-codes (ansi-color-parse-sequence escape-sequence)))
+ (while new-codes
+ (let* ((new (pop new-codes))
+ (q (/ new 10)))
+ (setq codes
+ (pcase q
+ (0 (unless (memq new '(0 8 9))
+ (cons new (remq new codes))))
+ (2 (unless (memq new '(20 26 28 29))
+ ;; The standard says `21 doubly underlined' while
+ ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims
+ ;; `21 Bright/Bold: off or Underline: Double'.
+ (remq (- new 20) (pcase new
+ (22 (remq 1 codes))
+ (25 (remq 6 codes))
+ (_ codes)))))
+ ((or 3 4) (let ((r (mod new 10)))
+ (unless (= r 8)
+ (let (beg)
+ (while (and codes (/= q (/ (car codes) 10)))
+ (push (pop codes) beg))
+ (setq codes (nconc (nreverse beg) (cdr codes)))
+ (if (= r 9)
+ codes
+ (cons new codes))))))
+ (_ nil)))))
+ codes))
(defun ansi-color-make-color-map ()
"Creates a vector of face definitions and returns it.
@@ -581,28 +633,6 @@ ANSI-CODE is used as an index into the vector."
(aref ansi-color-map ansi-code)
(args-out-of-range nil)))
-(defun ansi-color-get-face (escape-seq)
- "Create a new face by applying all the parameters in ESCAPE-SEQ.
-
-Should any of the parameters result in the default face (usually this is
-the parameter 0), then the effect of all previous parameters is canceled.
-
-ESCAPE-SEQ is a SGR control sequences such as \\033[34m. The parameter
-34 is used by `ansi-color-get-face-1' to return a face definition."
- (let ((i 0)
- f val)
- (while (string-match ansi-color-parameter-regexp escape-seq i)
- (setq i (match-end 0)
- val (ansi-color-get-face-1
- (string-to-number (match-string 1 escape-seq) 10)))
- (cond ((not val))
- ((eq val 'default)
- (setq f (list val)))
- (t
- (unless (member val f)
- (push val f)))))
- f))
-
(provide 'ansi-color)
;;; ansi-color.el ends here
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 9a372f27991..88d5602a023 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1,6 +1,6 @@
;;; apropos.el --- apropos commands for users and programmers
-;; Copyright (C) 1989, 1994-1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1994-1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Joe Wells <jbw@bigbird.bu.edu>
;; Daniel Pfeiffer <occitan@esperanto.org> (rewrite)
@@ -36,12 +36,12 @@
;; Fixed bug, current-local-map can return nil.
;; Change, doesn't calculate key-bindings unless needed.
;; Added super-apropos capability, changed print functions.
-;;; Made fast-apropos and super-apropos share code.
-;;; Sped up fast-apropos again.
+;; Made fast-apropos and super-apropos share code.
+;; Sped up fast-apropos again.
;; Added apropos-do-all option.
-;;; Added fast-command-apropos.
+;; Added fast-command-apropos.
;; Changed doc strings to comments for helping functions.
-;;; Made doc file buffer read-only, buried it.
+;; Made doc file buffer read-only, buried it.
;; Only call substitute-command-keys if do-all set.
;; Optionally use configurable faces to make the output more legible.
@@ -57,7 +57,6 @@
;;; Code:
(require 'button)
-(eval-when-compile (require 'cl))
(defgroup apropos nil
"Apropos commands for users and programmers."
@@ -85,35 +84,48 @@ include key-binding information in its output."
:group 'apropos
:type 'boolean)
+(defface apropos-symbol
+ '((t (:inherit bold)))
+ "Face for the symbol name in Apropos output."
+ :group 'apropos
+ :version "24.3")
-(defcustom apropos-symbol-face 'bold
- "Face for symbol name in Apropos output, or nil for none."
+(defface apropos-keybinding
+ '((t (:inherit underline)))
+ "Face for lists of keybinding in Apropos output."
:group 'apropos
- :type 'face)
+ :version "24.3")
-(defcustom apropos-keybinding-face 'underline
- "Face for lists of keybinding in Apropos output, or nil for none."
+(defface apropos-property
+ '((t (:inherit font-lock-builtin-face)))
+ "Face for property name in apropos output, or nil for none."
:group 'apropos
- :type 'face)
+ :version "24.3")
-(defcustom apropos-label-face '(italic)
- "Face for label (`Command', `Variable' ...) in Apropos output.
-A value of nil means don't use any special font for them, and also
-turns off mouse highlighting."
+(defface apropos-function-button
+ '((t (:inherit (font-lock-function-name-face button))))
+ "Button face indicating a function, macro, or command in Apropos."
:group 'apropos
- :type 'face)
+ :version "24.3")
-(defcustom apropos-property-face 'bold-italic
- "Face for property name in apropos output, or nil for none."
+(defface apropos-variable-button
+ '((t (:inherit (font-lock-variable-name-face button))))
+ "Button face indicating a variable in Apropos."
:group 'apropos
- :type 'face)
+ :version "24.3")
+
+(defface apropos-misc-button
+ '((t (:inherit (font-lock-constant-face button))))
+ "Button face indicating a miscellaneous object type in Apropos."
+ :group 'apropos
+ :version "24.3")
(defcustom apropos-match-face 'match
"Face for matching text in Apropos documentation/value, or nil for none.
This applies when you look for matches in the documentation or variable value
for the pattern; the part that matches gets displayed in this font."
:group 'apropos
- :type 'face)
+ :version "24.3")
(defcustom apropos-sort-by-scores nil
"Non-nil means sort matches by scores; best match is shown first.
@@ -196,7 +208,7 @@ term, and the rest of the words are alternative terms.")
;;; Button types used by apropos
(define-button-type 'apropos-symbol
- 'face apropos-symbol-face
+ 'face 'apropos-symbol
'help-echo "mouse-2, RET: Display more help on this symbol"
'follow-link t
'action #'apropos-symbol-button-display-help)
@@ -210,7 +222,7 @@ term, and the rest of the words are alternative terms.")
(define-button-type 'apropos-function
'apropos-label "Function"
'apropos-short-label "f"
- 'face '(font-lock-function-name-face button)
+ 'face 'apropos-function-button
'help-echo "mouse-2, RET: Display more help on this function"
'follow-link t
'action (lambda (button)
@@ -219,7 +231,7 @@ term, and the rest of the words are alternative terms.")
(define-button-type 'apropos-macro
'apropos-label "Macro"
'apropos-short-label "m"
- 'face '(font-lock-function-name-face button)
+ 'face 'apropos-function-button
'help-echo "mouse-2, RET: Display more help on this macro"
'follow-link t
'action (lambda (button)
@@ -228,7 +240,7 @@ term, and the rest of the words are alternative terms.")
(define-button-type 'apropos-command
'apropos-label "Command"
'apropos-short-label "c"
- 'face '(font-lock-function-name-face button)
+ 'face 'apropos-function-button
'help-echo "mouse-2, RET: Display more help on this command"
'follow-link t
'action (lambda (button)
@@ -242,7 +254,7 @@ term, and the rest of the words are alternative terms.")
(define-button-type 'apropos-variable
'apropos-label "Variable"
'apropos-short-label "v"
- 'face '(font-lock-variable-name-face button)
+ 'face 'apropos-variable-button
'help-echo "mouse-2, RET: Display more help on this variable"
'follow-link t
'action (lambda (button)
@@ -260,7 +272,7 @@ term, and the rest of the words are alternative terms.")
(define-button-type 'apropos-group
'apropos-label "Group"
'apropos-short-label "g"
- 'face '(font-lock-builtin-face button)
+ 'face 'apropos-misc-button
'help-echo "mouse-2, RET: Display more help on this group"
'follow-link t
'action (lambda (button)
@@ -270,7 +282,7 @@ term, and the rest of the words are alternative terms.")
(define-button-type 'apropos-widget
'apropos-label "Widget"
'apropos-short-label "w"
- 'face '(font-lock-builtin-face button)
+ 'face 'apropos-misc-button
'help-echo "mouse-2, RET: Display more help on this widget"
'follow-link t
'action (lambda (button)
@@ -279,7 +291,7 @@ term, and the rest of the words are alternative terms.")
(define-button-type 'apropos-plist
'apropos-label "Properties"
'apropos-short-label "p"
- 'face '(font-lock-keyword-face button)
+ 'face 'apropos-misc-button
'help-echo "mouse-2, RET: Display more help on this plist"
'follow-link t
'action (lambda (button)
@@ -333,10 +345,10 @@ literally, or a string which is used as a regexp to search for.
SUBJECT is a string that is included in the prompt to identify what
kind of objects to search."
(let ((pattern
- (read-string (concat "Apropos " subject " (word list or regexp): "))))
+ (read-string (concat "Search for " subject " (word list or regexp): "))))
(if (string-equal (regexp-quote pattern) pattern)
;; Split into words
- (split-string pattern "[ \t]+")
+ (split-string pattern "[ \t]+" t)
pattern)))
(defun apropos-parse-pattern (pattern)
@@ -466,7 +478,7 @@ normal variables."
#'(lambda (symbol)
(and (boundp symbol)
(get symbol 'variable-documentation)))
- 'user-variable-p)))
+ 'custom-variable-p)))
;; For auld lang syne:
;;;###autoload
@@ -587,7 +599,7 @@ Returns list of symbols and documentation found."
(let ((name (copy-sequence (symbol-name sym))))
(make-text-button name nil
'type 'apropos-library
- 'face apropos-symbol-face
+ 'face 'apropos-symbol
'apropos-symbol name)
name)))
@@ -627,11 +639,11 @@ the output includes key-bindings of commands."
(setq lh (cdr lh)))))
(unless lh-entry (error "Unknown library `%s'" file)))
(dolist (x (cdr lh-entry))
- (case (car-safe x)
+ (pcase (car-safe x)
;; (autoload (push (cdr x) autoloads))
- (require (push (cdr x) requires))
- (provide (push (cdr x) provides))
- (t (push (or (cdr-safe x) x) symbols))))
+ (`require (push (cdr x) requires))
+ (`provide (push (cdr x) provides))
+ (_ (push (or (cdr-safe x) x) symbols))))
(let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal.
(apropos-symbols-internal
symbols apropos-do-all
@@ -837,9 +849,8 @@ Returns list of symbols and documentation found."
(while pl
(setq p (format "%s %S" (car pl) (nth 1 pl)))
(if (or (not compare) (string-match apropos-regexp p))
- (if apropos-property-face
- (put-text-property 0 (length (symbol-name (car pl)))
- 'face apropos-property-face p))
+ (put-text-property 0 (length (symbol-name (car pl)))
+ 'face 'apropos-property p)
(setq p nil))
(if p
(progn
@@ -969,7 +980,7 @@ Will return nil instead."
(setq function (if (byte-code-function-p function)
(if (> (length function) 4)
(aref function 4))
- (if (eq (car-safe function) 'autoload)
+ (if (autoloadp function)
(nth 2 function)
(if (eq (car-safe function) 'lambda)
(if (stringp (nth 2 function))
@@ -1031,10 +1042,7 @@ If non-nil TEXT is a string that will be printed as a heading."
(insert-text-button (symbol-name symbol)
'type 'apropos-symbol
'skip apropos-multi-type
- ;; Can't use default, since user may have
- ;; changed the variable!
- ;; Just say `no' to variables containing faces!
- 'face apropos-symbol-face)
+ 'face 'apropos-symbol)
(if (and (eq apropos-sort-by-scores 'verbose)
(cadr apropos-item))
(insert " (" (number-to-string (cadr apropos-item)) ") "))
@@ -1072,18 +1080,16 @@ If non-nil TEXT is a string that will be printed as a heading."
(setq key (condition-case ()
(key-description key)
(error)))
- (if apropos-keybinding-face
- (put-text-property 0 (length key)
- 'face apropos-keybinding-face
- key))
+ (put-text-property 0 (length key)
+ 'face 'apropos-keybinding
+ key)
key)
item ", "))
(insert "M-x ... RET")
- (when apropos-keybinding-face
- (put-text-property (- (point) 11) (- (point) 8)
- 'face apropos-keybinding-face)
- (put-text-property (- (point) 3) (point)
- 'face apropos-keybinding-face))))
+ (put-text-property (- (point) 11) (- (point) 8)
+ 'face 'apropos-keybinding)
+ (put-text-property (- (point) 3) (point)
+ 'face 'apropos-keybinding)))
(terpri))
(apropos-print-doc 2
(if (commandp symbol)
@@ -1108,7 +1114,7 @@ If non-nil TEXT is a string that will be printed as a heading."
(consp (setq symbol
(symbol-function symbol)))
(or (eq (car symbol) 'macro)
- (if (eq (car symbol) 'autoload)
+ (if (autoloadp symbol)
(memq (nth 4 symbol)
'(macro t))))))
@@ -1128,9 +1134,6 @@ If non-nil TEXT is a string that will be printed as a heading."
(format "<%s>" (button-type-get type 'apropos-short-label))
(button-type-get type 'apropos-label))
'type type
- ;; Can't use the default button face, since user may have changed the
- ;; variable! Just say `no' to variables containing faces!
- 'face (append button-face apropos-label-face)
'apropos-symbol (car apropos-item))
(insert (if apropos-compact-layout " " ": ")))
@@ -1177,9 +1180,8 @@ If non-nil TEXT is a string that will be printed as a heading."
(princ "Symbol ")
(prin1 symbol)
(princ "'s plist is\n (")
- (if apropos-symbol-face
- (put-text-property (+ (point-min) 7) (- (point) 14)
- 'face apropos-symbol-face))
+ (put-text-property (+ (point-min) 7) (- (point) 14)
+ 'face 'apropos-symbol)
(insert (apropos-format-plist symbol "\n "))
(princ ")")))
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 816291166fa..9fc91a242d2 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1,6 +1,6 @@
;;; arc-mode.el --- simple editing of archives
-;; Copyright (C) 1995, 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@gnu.org>
;; Keywords: files archives msdog editing major-mode
@@ -96,7 +96,7 @@
;;
;; archive-mode-hook
;; archive-foo-mode-hook
-;; archive-extract-hooks
+;; archive-extract-hook
;;; Code:
@@ -140,8 +140,10 @@ A local copy of the archive will be used when updating."
:type 'regexp
:group 'archive)
-(defcustom archive-extract-hooks nil
- "Hooks to run when an archive member has been extracted."
+(define-obsolete-variable-alias 'archive-extract-hooks
+ 'archive-extract-hook "24.3")
+(defcustom archive-extract-hook nil
+ "Hook run when an archive member has been extracted."
:type 'hook
:group 'archive)
;; ------------------------------
@@ -322,6 +324,7 @@ Archive and member name will be added."
"Program and its options to run in order to extract a 7z file member.
Extraction should happen to standard output. Archive and member name will
be added."
+ :version "24.1"
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
@@ -332,6 +335,7 @@ be added."
'("7z" "d")
"Program and its options to run in order to delete 7z file members.
Archive and member names will be added."
+ :version "24.1"
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
@@ -343,6 +347,7 @@ Archive and member names will be added."
"Program and its options to run in order to update a 7z file member.
Options should ensure that specified directory will be put into the 7z
file. Archive and member name will be added."
+ :version "24.1"
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
@@ -619,11 +624,12 @@ the mode is invalid. If ERROR is nil then nil will be returned."
(defun archive-unixdate (low high)
"Stringify Unix (LOW HIGH) date."
- (let ((str (current-time-string (cons high low))))
+ (let* ((time (cons high low))
+ (str (current-time-string time)))
(format "%s-%s-%s"
(substring str 8 10)
(substring str 4 7)
- (substring str 20 24))))
+ (format-time-string "%Y" time))))
(defun archive-unixtime (low high)
"Stringify Unix (LOW HIGH) time."
@@ -783,7 +789,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
@@ -1073,7 +1080,7 @@ using `make-temp-file', and the generated name is returned."
;; We will write out the archive ourselves if it is
;; part of another archive.
(remove-hook 'write-contents-functions 'archive-write-file t))
- (run-hooks 'archive-extract-hooks)
+ (run-hooks 'archive-extract-hook)
(if archive-read-only
(message "Note: altering this archive is not implemented."))))
(archive-maybe-update t))
@@ -1113,13 +1120,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."
@@ -2002,17 +2050,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.
@@ -2095,17 +2133,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/array.el b/lisp/array.el
index 211124964a5..64c57bc480e 100644
--- a/lisp/array.el
+++ b/lisp/array.el
@@ -1,6 +1,6 @@
;;; array.el --- array editing commands for GNU Emacs
-;; Copyright (C) 1987, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 2000-2012 Free Software Foundation, Inc.
;; Author: David M. Brown
;; Maintainer: FSF
diff --git a/lisp/autoarg.el b/lisp/autoarg.el
index 57f5bcd809c..c1b55f3b36e 100644
--- a/lisp/autoarg.el
+++ b/lisp/autoarg.el
@@ -1,6 +1,6 @@
;;; autoarg.el --- make digit keys supply prefix args
-;; Copyright (C) 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Created: 1998-09-04
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 6d002f4a217..21c35811ac3 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -1,6 +1,6 @@
;;; autoinsert.el --- automatic mode-dependent insertion of text into new files
-;; Copyright (C) 1985-1987, 1994-1995, 1998, 2000-2011
+;; Copyright (C) 1985-1987, 1994-1995, 1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Charlie Martin <crm@cs.duke.edu>
@@ -36,7 +36,7 @@
;; setq auto-insert-directory to an appropriate slash-terminated value
;;
;; You can also customize the variable `auto-insert-mode' to load the
-;; package. Alternatively, add the following to your .emacs file:
+;; package. Alternatively, add the following to your init file:
;; (auto-insert-mode 1)
;;
;; Author: Charlie Martin
@@ -135,19 +135,19 @@ If this contains a %s, that will be replaced by the matching rule."
(("\\.[1-9]\\'" . "Man page skeleton")
"Short description: "
- ".\\\" Copyright (C), " (substring (current-time-string) -4) " "
+ ".\\\" Copyright (C), " (format-time-string "%Y") " "
(getenv "ORGANIZATION") | (progn user-full-name)
"
.\\\" You may distribute this file under the terms of the GNU Free
.\\\" Documentation License.
-.TH " (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
+.TH " (file-name-base)
" " (file-name-extension (buffer-file-name))
" " (format-time-string "%Y-%m-%d ")
"\n.SH NAME\n"
- (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
+ (file-name-base)
" \\- " str
"\n.SH SYNOPSIS
-.B " (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
+.B " (file-name-base)
"\n"
_
"
@@ -166,7 +166,7 @@ If this contains a %s, that will be replaced by the matching rule."
"Short description: "
";;; " (file-name-nondirectory (buffer-file-name)) " --- " str "
-;; Copyright (C) " (substring (current-time-string) -4) " "
+;; Copyright (C) " (format-time-string "%Y") " "
(getenv "ORGANIZATION") | (progn user-full-name) "
;; Author: " (user-full-name)
@@ -207,7 +207,7 @@ If this contains a %s, that will be replaced by the matching rule."
\(provide '"
- (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
+ (file-name-base)
")
\;;; " (file-name-nondirectory (buffer-file-name)) " ends here\n")
(("\\.texi\\(nfo\\)?\\'" . "Texinfo file skeleton")
@@ -215,14 +215,13 @@ If this contains a %s, that will be replaced by the matching rule."
"\\input texinfo @c -*-texinfo-*-
@c %**start of header
@setfilename "
- (file-name-sans-extension
- (file-name-nondirectory (buffer-file-name))) ".info\n"
+ (file-name-base) ".info\n"
"@settitle " str "
@c %**end of header
@copying\n"
(setq short-description (read-string "Short description: "))
".\n\n"
- "Copyright @copyright{} " (substring (current-time-string) -4) " "
+ "Copyright @copyright{} " (format-time-string "%Y") " "
(getenv "ORGANIZATION") | (progn user-full-name) "
@quotation
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index f70025e9d3f..0f082d2ee9c 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -1,6 +1,6 @@
;;; autorevert.el --- revert buffers when files on disk change
-;; Copyright (C) 1997-1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Anders Lindgren <andersl@andersl.com>
;; Keywords: convenience
@@ -94,9 +94,6 @@
(require 'timer)
-(eval-when-compile (require 'cl))
-
-
;; Custom Group:
;;
;; The two modes will be placed next to Auto Save Mode under the
@@ -104,9 +101,8 @@
(defgroup auto-revert nil
"Revert individual buffers when files on disk change.
-
-Auto-Revert Mode can be activated for individual buffer.
-Global Auto-Revert Mode applies to all buffers."
+Auto-Revert mode enables auto-revert in individual buffers.
+Global Auto-Revert mode does so in all buffers."
:group 'files
:group 'convenience)
@@ -439,17 +435,18 @@ This is an internal function used by Auto-Revert Mode."
(let* ((buffer (current-buffer)) size
(revert
(or (and buffer-file-name
- (file-readable-p buffer-file-name)
(if auto-revert-tail-mode
;; Tramp caches the file attributes. Setting
;; `remote-file-name-inhibit-cache' forces Tramp
;; to reread the values.
(let ((remote-file-name-inhibit-cache t))
- (/= auto-revert-tail-pos
- (setq size
- (nth 7 (file-attributes
- buffer-file-name)))))
+ (and (file-readable-p buffer-file-name)
+ (/= auto-revert-tail-pos
+ (setq size
+ (nth 7 (file-attributes
+ buffer-file-name))))))
(and (not (file-remote-p buffer-file-name))
+ (file-readable-p buffer-file-name)
(not (verify-visited-file-modtime buffer)))))
(and (or auto-revert-mode
global-auto-revert-non-file-buffers)
diff --git a/lisp/avoid.el b/lisp/avoid.el
index 038927105ec..7f4b78bf5e0 100644
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -1,6 +1,6 @@
;;; avoid.el --- make mouse pointer stay out of the way of editing
-;; Copyright (C) 1993-1994, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: mouse
@@ -67,7 +67,7 @@
;;; Code:
-(provide 'avoid)
+(eval-when-compile (require 'cl-lib))
(defgroup avoid nil
"Make mouse pointer stay out of the way of editing."
@@ -80,7 +80,7 @@
See function `mouse-avoidance-mode' for possible values.
Setting this variable directly does not take effect;
use either \\[customize] or the function `mouse-avoidance-mode'."
- :set (lambda (symbol value)
+ :set (lambda (_symbol value)
;; 'none below prevents toggling when value is nil.
(mouse-avoidance-mode (or value 'none)))
:initialize 'custom-initialize-default
@@ -115,6 +115,24 @@ Only applies in Mouse Avoidance modes `animate' and `jump'."
:type 'integer
:group 'avoid)
+(defcustom mouse-avoidance-banish-position '((frame-or-window . frame)
+ (side . right)
+ (side-pos . 3)
+ (top-or-bottom . top)
+ (top-or-bottom-pos . 0))
+ "Position to which Mouse Avoidance mode `banish' moves the mouse.
+An alist where keywords mean:
+FRAME-OR-WINDOW: banish the mouse to corner of frame or window.
+SIDE: banish the mouse on right or left corner of frame or window.
+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)))
+
;; Internal variables
(defvar mouse-avoidance-state nil)
(defvar mouse-avoidance-pointer-shapes nil)
@@ -183,13 +201,45 @@ Acceptable distance is defined by `mouse-avoidance-threshold'."
(defun mouse-avoidance-banish-destination ()
"The position to which Mouse Avoidance mode `banish' moves the mouse.
-You can redefine this if you want the mouse banished to a different corner."
- (let* ((pos (window-edges)))
- (cons (- (nth 2 pos) 2)
- (nth 1 pos))))
+
+If you want the mouse banished to a different corner set
+`mouse-avoidance-banish-position' as you need."
+ (let* ((fra-or-win (assoc-default
+ 'frame-or-window
+ mouse-avoidance-banish-position 'eq))
+ (list-values (pcase fra-or-win
+ (`frame (list 0 0 (frame-width) (frame-height)))
+ (`window (window-edges))))
+ (alist (cl-loop for v in list-values
+ for k in '(left top right bottom)
+ collect (cons k v)))
+ (side (assoc-default
+ 'side
+ mouse-avoidance-banish-position #'eq))
+ (side-dist (assoc-default
+ 'side-pos
+ mouse-avoidance-banish-position #'eq))
+ (top-or-bottom (assoc-default
+ 'top-or-bottom
+ mouse-avoidance-banish-position #'eq))
+ (top-or-bottom-dist (assoc-default
+ 'top-or-bottom-pos
+ mouse-avoidance-banish-position #'eq))
+ (side-fn (pcase side
+ (`left '+)
+ (`right '-)))
+ (top-or-bottom-fn (pcase top-or-bottom
+ (`top '+)
+ (`bottom '-))))
+ (cons (funcall side-fn ; -/+
+ (assoc-default side alist 'eq) ; right or left
+ side-dist) ; distance from side
+ (funcall top-or-bottom-fn ; -/+
+ (assoc-default top-or-bottom alist 'eq) ; top/bottom
+ top-or-bottom-dist)))) ; distance from top/bottom
(defun mouse-avoidance-banish-mouse ()
- ;; Put the mouse pointer in the upper-right corner of the current frame.
+ "Put the mouse pointer to `mouse-avoidance-banish-position'."
(mouse-avoidance-set-mouse-position (mouse-avoidance-banish-destination)))
(defsubst mouse-avoidance-delta (cur delta dist var min max)
@@ -218,7 +268,6 @@ You can redefine this if you want the mouse banished to a different corner."
;; For these modes, state keeps track of the total offset that we've
;; accumulated, and tries to keep it close to zero.
(let* ((cur (mouse-position))
- (cur-frame (car cur))
(cur-pos (cdr cur))
(pos (window-edges))
(wleft (pop pos))
@@ -408,4 +457,6 @@ definition of \"random distance\".)"
(if mouse-avoidance-mode
(mouse-avoidance-mode mouse-avoidance-mode))
+(provide 'avoid)
+
;;; avoid.el ends here
diff --git a/lisp/battery.el b/lisp/battery.el
index bb899f2beae..69d25643bb9 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -1,6 +1,6 @@
;;; battery.el --- display battery status information -*- coding: iso-8859-1 -*-
-;; Copyright (C) 1997-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Ralph Schleicher <rs@nunatak.allgaeu.org>
;; Keywords: hardware
@@ -31,14 +31,16 @@
;;; Code:
(require 'timer)
-(eval-when-compile (require 'cl))
-
+(eval-when-compile (require 'cl-lib))
(defgroup battery nil
"Display battery status information."
:prefix "battery-"
:group 'hardware)
+;; Either BATn or yeeloong-bat, basically.
+(defconst battery--linux-sysfs-regexp "[bB][aA][tT][0-9]?$")
+
(defcustom battery-status-function
(cond ((and (eq system-type 'gnu/linux)
(file-readable-p "/proc/apm"))
@@ -48,7 +50,8 @@
'battery-linux-proc-acpi)
((and (eq system-type 'gnu/linux)
(file-directory-p "/sys/class/power_supply/")
- (directory-files "/sys/class/power_supply/" nil "BAT[0-9]$"))
+ (directory-files "/sys/class/power_supply/" nil
+ battery--linux-sysfs-regexp))
'battery-linux-sysfs)
((and (eq system-type 'darwin)
(condition-case nil
@@ -57,7 +60,7 @@
(> (buffer-size) 0)))
(error nil)))
'battery-pmset)
- ((eq system-type 'windows-nt)
+ ((fboundp 'w32-battery-status)
'w32-battery-status))
"Function for getting battery status information.
The function has to return an alist of conversion definitions.
@@ -74,7 +77,7 @@ introduced by a `%' character in a control string."
(cond ((eq battery-status-function 'battery-linux-proc-acpi)
"Power %L, battery %B at %r (%p%% load, remaining time %t)")
((eq battery-status-function 'battery-linux-sysfs)
- "Power %L, battery %B (%p%% load)")
+ "Power %L, battery %B (%p%% load, remaining time %t)")
((eq battery-status-function 'battery-pmset)
"%L power, battery %B (%p%% load, remaining time %t)")
(battery-status-function
@@ -104,6 +107,7 @@ string are substituted as defined by the current value of the variable
(defcustom battery-mode-line-limit 100
"Percentage of full battery load below which display battery status"
+ :version "24.1"
:type 'integer
:group 'battery)
@@ -226,7 +230,7 @@ seconds."
"Regular expression matching contents of `/proc/apm'.")
(defun battery-linux-proc-apm ()
- "Get APM status information from Linux kernel.
+ "Get APM status information from Linux (the kernel).
This function works only with the new `/proc/apm' format introduced
in Linux version 1.3.58.
@@ -297,7 +301,7 @@ The following %-sequences are provided:
;;; `/proc/acpi/' interface for Linux.
(defun battery-linux-proc-acpi ()
- "Get ACPI status information from Linux kernel.
+ "Get ACPI status information from Linux (the kernel).
This function works only with the `/proc/acpi/' format introduced
in Linux version 2.4.20 and 2.6.0.
@@ -337,14 +341,15 @@ The following %-sequences are provided:
(setq charging-state (match-string 1)))
(when (re-search-forward "present rate: +\\([0-9]+\\) \\(m[AW]\\)$"
nil t)
- (setq rate (+ (or rate 0) (string-to-number (match-string 1)))
- rate-type (or (and rate-type
+ (setq rate (+ (or rate 0) (string-to-number (match-string 1))))
+ (when (> rate 0)
+ (setq rate-type (or (and rate-type
(if (string= rate-type (match-string 2))
rate-type
(error
"Inconsistent rate types (%s vs. %s)"
rate-type (match-string 2))))
- (match-string 2))))
+ (match-string 2)))))
(when (re-search-forward "remaining capacity: +\\([0-9]+\\) m[AW]h$"
nil t)
(setq capacity
@@ -354,16 +359,16 @@ The following %-sequences are provided:
(when (re-search-forward "present: +yes$" nil t)
(when (re-search-forward "design capacity: +\\([0-9]+\\) m[AW]h$"
nil t)
- (incf design-capacity (string-to-number (match-string 1))))
+ (cl-incf design-capacity (string-to-number (match-string 1))))
(when (re-search-forward "last full capacity: +\\([0-9]+\\) m[AW]h$"
nil t)
- (incf last-full-capacity (string-to-number (match-string 1))))
+ (cl-incf last-full-capacity (string-to-number (match-string 1))))
(when (re-search-forward
"design capacity warning: +\\([0-9]+\\) m[AW]h$" nil t)
- (incf warn (string-to-number (match-string 1))))
+ (cl-incf warn (string-to-number (match-string 1))))
(when (re-search-forward "design capacity low: +\\([0-9]+\\) m[AW]h$"
nil t)
- (incf low (string-to-number (match-string 1)))))))
+ (cl-incf low (string-to-number (match-string 1)))))))
(setq full-capacity (if (> last-full-capacity 0)
last-full-capacity design-capacity))
(and capacity rate
@@ -440,7 +445,8 @@ The following %-sequences are provided:
(with-temp-buffer
(dolist (dir (ignore-errors
(directory-files
- "/sys/class/power_supply/" t "BAT[0-9]$")))
+ "/sys/class/power_supply/" t
+ battery--linux-sysfs-regexp)))
(erase-buffer)
(ignore-errors (insert-file-contents
(expand-file-name "uevent" dir)))
@@ -502,7 +508,7 @@ The following %-sequences are provided:
"N/A"))
(cons ?d (or temperature "N/A"))
(cons ?B (or charging-state "N/A"))
- (cons ?p (cond ((> charge-full 0)
+ (cons ?p (cond ((and (> charge-full 0) (> charge-now 0))
(format "%.1f"
(/ (* 100 charge-now) charge-full)))
((> energy-full 0)
@@ -517,8 +523,6 @@ The following %-sequences are provided:
"AC"
"BAT")
"N/A")))))
-
-
;;; `pmset' interface for Darwin (OS X).
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 1a10d117987..de5dd48c291 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1,6 +1,6 @@
;;; bindings.el --- define standard key bindings and some variables
-;; Copyright (C) 1985-1987, 1992-1996, 1999-2011
+;; Copyright (C) 1985-1987, 1992-1996, 1999-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -38,64 +38,55 @@ corresponding to the mode line clicked."
(defun mode-line-toggle-read-only (event)
"Like `toggle-read-only', for the mode-line."
(interactive "e")
- (save-selected-window
- (select-window (posn-window (event-start event)))
- (toggle-read-only)
- (force-mode-line-update)))
-
+ (with-selected-window (posn-window (event-start event))
+ (read-only-mode 'toggle)))
(defun mode-line-toggle-modified (event)
"Toggle the buffer-modified flag from the mode-line."
(interactive "e")
- (save-selected-window
- (select-window (posn-window (event-start event)))
+ (with-selected-window (posn-window (event-start event))
(set-buffer-modified-p (not (buffer-modified-p)))
(force-mode-line-update)))
-
(defun mode-line-widen (event)
"Widen a buffer from the mode-line."
(interactive "e")
- (save-selected-window
- (select-window (posn-window (event-start event)))
+ (with-selected-window (posn-window (event-start event))
(widen)
(force-mode-line-update)))
-
(defvar mode-line-input-method-map
(let ((map (make-sparse-keymap)))
(define-key map [mode-line mouse-2]
(lambda (e)
(interactive "e")
- (save-selected-window
- (select-window
- (posn-window (event-start e)))
+ (with-selected-window (posn-window (event-start e))
(toggle-input-method)
(force-mode-line-update))))
(define-key map [mode-line mouse-3]
(lambda (e)
(interactive "e")
- (save-selected-window
- (select-window
- (posn-window (event-start e)))
+ (with-selected-window (posn-window (event-start e))
(describe-current-input-method))))
(purecopy map)))
-
(defvar mode-line-coding-system-map
(let ((map (make-sparse-keymap)))
(define-key map [mode-line mouse-1]
(lambda (e)
(interactive "e")
- (save-selected-window
- (select-window (posn-window (event-start e)))
+ (with-selected-window (posn-window (event-start e))
(when (and enable-multibyte-characters
buffer-file-coding-system)
(describe-coding-system buffer-file-coding-system)))))
+ (define-key map [mode-line mouse-3]
+ (lambda (e)
+ (interactive "e")
+ (with-selected-window (posn-window (event-start e))
+ (call-interactively 'set-buffer-file-coding-system))))
(purecopy map))
"Local keymap for the coding-system part of the mode line.")
-
(defun mode-line-change-eol (event)
"Cycle through the various possible kinds of end-of-line styles."
(interactive "e")
@@ -116,7 +107,7 @@ corresponding to the mode line clicked."
(setq desc
(propertize
mnemonic
- 'help-echo (format "End-of-line style: %s\nmouse-1 to cycle"
+ 'help-echo (format "End-of-line style: %s\nmouse-1: Cycle"
(if (eq eol 0) "Unix-style LF"
(if (eq eol 1) "DOS-style CRLF"
(if (eq eol 2) "Mac-style CR"
@@ -130,13 +121,39 @@ corresponding to the mode line clicked."
(push (cons eol (cons mnemonic desc)) mode-line-eol-desc-cache)
desc)))
-(defvar mode-line-client
- `(""
- (:propertize ("" (:eval (if (frame-parameter nil 'client) "@" "")))
- help-echo ,(purecopy "emacsclient frame")))
- "Mode-line control for identifying emacsclient frames.")
-;;;###autoload
-(put 'mode-line-client 'risky-local-variable t)
+
+;;; Mode line contents
+
+(defcustom mode-line-default-help-echo
+ "mouse-1: Select (drag to resize)\n\
+mouse-2: Make current window occupy the whole frame\n\
+mouse-3: Remove current window from display"
+ "Default help text for the mode line.
+If the value is a string, it specifies the tooltip or echo area
+message to display when the mouse is moved over the mode line.
+If the text at the mouse position has a `help-echo' text
+property, that overrides this variable."
+ :type '(choice (const :tag "No help" :value nil) string)
+ :version "24.3"
+ :group 'mode-line)
+
+(defvar mode-line-front-space '(:eval (if (display-graphic-p) " " "-"))
+ "Mode line construct to put at the front of the mode line.
+By default, this construct is displayed right at the beginning of
+the mode line, except that if there is a memory-full message, it
+is displayed first.")
+(put 'mode-line-front-space 'risky-local-variable t)
+
+(defun mode-line-mule-info-help-echo (window _object _point)
+ "Return help text specifying WINDOW's buffer coding system."
+ (with-current-buffer (window-buffer window)
+ (if buffer-file-coding-system
+ (format "Buffer coding system (%s): %s
+mouse-1: Describe coding system
+mouse-3: Set coding system"
+ (if enable-multibyte-characters "multi-byte" "unibyte")
+ (symbol-name buffer-file-coding-system))
+ "Buffer coding system: none specified")))
(defvar mode-line-mule-info
`(""
@@ -152,88 +169,55 @@ mouse-3: Describe current input method"))
mouse-face mode-line-highlight))
,(propertize
"%z"
- 'help-echo
- (lambda (window _object _point)
- (with-current-buffer (window-buffer window)
- ;; Don't show this tip if the coding system is nil,
- ;; it reads like a bug, and is not useful anyway.
- (when buffer-file-coding-system
- (format "Buffer coding system %s\nmouse-1: describe coding system"
- (if enable-multibyte-characters
- (concat "(multi-byte): "
- (symbol-name buffer-file-coding-system))
- (concat "(unibyte): "
- (symbol-name buffer-file-coding-system)))))))
+ 'help-echo 'mode-line-mule-info-help-echo
'mouse-face 'mode-line-highlight
'local-map mode-line-coding-system-map)
(:eval (mode-line-eol-desc)))
- "Mode-line control for displaying information of multilingual environment.
+ "Mode line construct to report the multilingual environment.
Normally it displays current input method (if any activated) and
mnemonics of the following coding systems:
coding system for saving or writing the current buffer
- coding system for keyboard input (if Emacs is running on terminal)
- coding system for terminal output (if Emacs is running on terminal)"
- ;; Currently not:
- ;; coding system for decoding output of buffer process (if any)
- ;; coding system for encoding text to send to buffer process (if any)."
-)
-
+ coding system for keyboard input (on a text terminal)
+ coding system for terminal output (on a text terminal)")
;;;###autoload
(put 'mode-line-mule-info 'risky-local-variable t)
(make-variable-buffer-local 'mode-line-mule-info)
-;; MSDOS frames have window-system, but want the Fn identification.
-(defun mode-line-frame-control ()
- "Compute mode-line control for frame identification.
-Value is used for `mode-line-frame-identification', which see."
- (if (or (null window-system)
- (eq window-system 'pc))
- "-%F "
- " "))
-
-;; We need to defer the call to mode-line-frame-control to the time
-;; the mode line is actually displayed.
-(defvar mode-line-frame-identification '(:eval (mode-line-frame-control))
- "Mode-line control to describe the current frame.")
+(defvar mode-line-client
+ `(""
+ (:propertize ("" (:eval (if (frame-parameter nil 'client) "@" "")))
+ help-echo ,(purecopy "emacsclient frame")))
+ "Mode line construct for identifying emacsclient frames.")
;;;###autoload
-(put 'mode-line-frame-identification 'risky-local-variable t)
+(put 'mode-line-client 'risky-local-variable t)
-(defvar mode-line-process nil "\
-Mode-line control for displaying info on process status.
-Normally nil in most modes, since there is no process to display.")
+(defun mode-line-read-only-help-echo (window _object _point)
+ "Return help text specifying WINDOW's buffer read-only status."
+ (format "Buffer is %s\nmouse-1: Toggle"
+ (if (buffer-local-value 'buffer-read-only (window-buffer window))
+ "read-only"
+ "writable")))
-;;;###autoload
-(put 'mode-line-process 'risky-local-variable t)
-(make-variable-buffer-local 'mode-line-process)
+(defun mode-line-modified-help-echo (window _object _point)
+ "Return help text specifying WINDOW's buffer modification status."
+ (format "Buffer is %smodified\nmouse-1: Toggle modification state"
+ (if (buffer-modified-p (window-buffer window)) "" "not ")))
(defvar mode-line-modified
(list (propertize
"%1*"
- 'help-echo (purecopy (lambda (window _object _point)
- (format "Buffer is %s\nmouse-1 toggles"
- (save-selected-window
- (select-window window)
- (if buffer-read-only
- "read-only"
- "writable")))))
+ 'help-echo 'mode-line-read-only-help-echo
'local-map (purecopy (make-mode-line-mouse-map
'mouse-1
#'mode-line-toggle-read-only))
'mouse-face 'mode-line-highlight)
(propertize
"%1+"
- 'help-echo (purecopy (lambda (window _object _point)
- (format "Buffer is %sodified\nmouse-1 toggles modified state"
- (save-selected-window
- (select-window window)
- (if (buffer-modified-p)
- "m"
- "not m")))))
+ 'help-echo 'mode-line-modified-help-echo
'local-map (purecopy (make-mode-line-mouse-map
'mouse-1 #'mode-line-toggle-modified))
'mouse-face 'mode-line-highlight))
- "Mode-line control for displaying whether current buffer is modified.")
-
+ "Mode line construct for displaying whether current buffer is modified.")
;;;###autoload
(put 'mode-line-modified 'risky-local-variable t)
(make-variable-buffer-local 'mode-line-modified)
@@ -244,40 +228,68 @@ Normally nil in most modes, since there is no process to display.")
'mouse-face 'mode-line-highlight
'help-echo (purecopy (lambda (window _object _point)
(format "%s"
- (save-selected-window
- (select-window window)
+ (with-selected-window window
(concat
(if (file-remote-p default-directory)
"Current directory is remote: "
"Current directory is local: ")
default-directory)))))))
- "Mode-line flag to show if default-directory for current buffer is remote.")
+ "Mode line construct to indicate a remote buffer.")
;;;###autoload
(put 'mode-line-remote 'risky-local-variable t)
-
(make-variable-buffer-local 'mode-line-remote)
-;; Actual initialization is below.
-(defvar mode-line-position nil
- "Mode-line control for displaying the position in the buffer.
-Normally displays the buffer percentage and, optionally, the
-buffer size, the line number and the column number.")
+;; MSDOS frames have window-system, but want the Fn identification.
+(defun mode-line-frame-control ()
+ "Compute mode line construct for frame identification.
+Value is used for `mode-line-frame-identification', which see."
+ (if (or (null window-system)
+ (eq window-system 'pc))
+ "-%F "
+ " "))
+
+;; We need to defer the call to mode-line-frame-control to the time
+;; the mode line is actually displayed.
+(defvar mode-line-frame-identification '(:eval (mode-line-frame-control))
+ "Mode line construct to describe the current frame.")
;;;###autoload
-(put 'mode-line-position 'risky-local-variable t)
+(put 'mode-line-frame-identification 'risky-local-variable t)
-(defvar mode-line-modes nil
- "Mode-line control for displaying major and minor modes.")
+(defvar mode-line-process nil
+ "Mode line construct for displaying info on process status.
+Normally nil in most modes, since there is no process to display.")
;;;###autoload
-(put 'mode-line-modes 'risky-local-variable t)
+(put 'mode-line-process 'risky-local-variable t)
+(make-variable-buffer-local 'mode-line-process)
+
+(defun bindings--define-key (map key item)
+ "Make as much as possible of the menus pure."
+ (declare (indent 2))
+ (define-key map key
+ (cond
+ ((not (consp item)) item) ;Not sure that could be other than a symbol.
+ ;; Keymaps can't be made pure otherwise users can't remove/add elements
+ ;; from/to them any more.
+ ((keymapp item) item)
+ ((stringp (car item))
+ (if (keymapp (cdr item))
+ (cons (purecopy (car item)) (cdr item))
+ (purecopy item)))
+ ((eq 'menu-item (car item))
+ (if (keymapp (nth 2 item))
+ `(menu-item ,(purecopy (nth 1 item)) ,(nth 2 item)
+ ,@(purecopy (nthcdr 3 item)))
+ (purecopy item)))
+ (t (message "non-menu-item: %S" item) item))))
(defvar mode-line-mode-menu (make-sparse-keymap "Minor Modes") "\
Menu of mode operations in the mode line.")
(defvar mode-line-major-mode-keymap
(let ((map (make-sparse-keymap)))
- (define-key map [mode-line down-mouse-1]
- `(menu-item ,(purecopy "Menu Bar") ignore
- :filter (lambda (_) (mouse-menu-major-mode-map))))
+ (bindings--define-key map [mode-line down-mouse-1]
+ `(menu-item "Menu Bar" ignore
+ :filter ,(lambda (_) (mouse-menu-major-mode-map))))
(define-key map [mode-line mouse-2] 'describe-mode)
(define-key map [mode-line down-mouse-3] mode-line-mode-menu)
map) "\
@@ -292,129 +304,91 @@ Keymap to display on major mode.")
map) "\
Keymap to display on minor modes.")
+(defvar mode-line-modes
+ (let ((recursive-edit-help-echo "Recursive edit, type C-M-c to get out"))
+ (list (propertize "%[" 'help-echo recursive-edit-help-echo)
+ "("
+ `(:propertize ("" mode-name)
+ help-echo "Major mode\n\
+mouse-1: Display major mode menu\n\
+mouse-2: Show help for major mode\n\
+mouse-3: Toggle minor modes"
+ mouse-face mode-line-highlight
+ local-map ,mode-line-major-mode-keymap)
+ '("" mode-line-process)
+ `(:propertize ("" minor-mode-alist)
+ mouse-face mode-line-highlight
+ help-echo "Minor mode\n\
+mouse-1: Display minor mode menu\n\
+mouse-2: Show help for minor mode\n\
+mouse-3: Toggle minor modes"
+ local-map ,mode-line-minor-mode-keymap)
+ (propertize "%n" 'help-echo "mouse-2: Remove narrowing from buffer"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (make-mode-line-mouse-map
+ 'mouse-2 #'mode-line-widen))
+ ")"
+ (propertize "%]" 'help-echo recursive-edit-help-echo)
+ " "))
+ "Mode line construct for displaying major and minor modes.")
+(put 'mode-line-modes 'risky-local-variable t)
+
(defvar mode-line-column-line-number-mode-map
(let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap "Toggle Line and Column Number Display")))
- (define-key menu-map [line-number-mode]
- `(menu-item ,(purecopy "Display Line Numbers") line-number-mode
- :help ,(purecopy "Toggle displaying line numbers in the mode-line")
+ (bindings--define-key menu-map [line-number-mode]
+ '(menu-item "Display Line Numbers" line-number-mode
+ :help "Toggle displaying line numbers in the mode-line"
:button (:toggle . line-number-mode)))
- (define-key menu-map [column-number-mode]
- `(menu-item ,(purecopy "Display Column Numbers") column-number-mode
- :help ,(purecopy "Toggle displaying column numbers in the mode-line")
+ (bindings--define-key menu-map [column-number-mode]
+ '(menu-item "Display Column Numbers" column-number-mode
+ :help "Toggle displaying column numbers in the mode-line"
:button (:toggle . column-number-mode)))
(define-key map [mode-line down-mouse-1] menu-map)
map) "\
Keymap to display on column and line numbers.")
-(let* ((help-echo
- ;; The multi-line message doesn't work terribly well on the
- ;; bottom mode line... Better ideas?
- ;; "\
- ;; mouse-1: select window, mouse-2: delete others, mouse-3: delete,
- ;; drag-mouse-1: resize, C-mouse-2: split horizontally"
- "mouse-1: Select (drag to resize)\n\
-mouse-2: Make current window occupy the whole frame\n\
-mouse-3: Remove current window from display")
- (recursive-edit-help-echo "Recursive edit, type C-M-c to get out")
- (spaces (propertize " " 'help-echo help-echo))
- (standard-mode-line-format
- (list
- "%e"
- `(:eval (if (display-graphic-p)
- ,(propertize " " 'help-echo help-echo)
- ,(propertize "-" 'help-echo help-echo)))
- 'mode-line-mule-info
- 'mode-line-client
- 'mode-line-modified
- 'mode-line-remote
- 'mode-line-frame-identification
- 'mode-line-buffer-identification
- (propertize " " 'help-echo help-echo)
- 'mode-line-position
- '(vc-mode vc-mode)
- (propertize " " 'help-echo help-echo)
- 'mode-line-modes
- `(which-func-mode ("" which-func-format ,spaces))
- `(global-mode-string ("" global-mode-string ,spaces))
- `(:eval (unless (display-graphic-p)
- ,(propertize "-%-" 'help-echo help-echo)))))
- (standard-mode-line-modes
- (list
- (propertize "%[" 'help-echo recursive-edit-help-echo)
- (propertize "(" 'help-echo help-echo)
- `(:propertize ("" mode-name)
- help-echo "Major mode\n\
-mouse-1: Display major mode menu\n\
-mouse-2: Show help for major mode\n\
-mouse-3: Toggle minor modes"
- mouse-face mode-line-highlight
- local-map ,mode-line-major-mode-keymap)
- '("" mode-line-process)
- `(:propertize ("" minor-mode-alist)
- mouse-face mode-line-highlight
- help-echo "Minor mode\n\
-mouse-1: Display minor mode menu\n\
-mouse-2: Show help for minor mode\n\
-mouse-3: Toggle minor modes"
- local-map ,mode-line-minor-mode-keymap)
- (propertize "%n" 'help-echo "mouse-2: Remove narrowing from the current buffer"
- 'mouse-face 'mode-line-highlight
- 'local-map (make-mode-line-mouse-map
- 'mouse-2 #'mode-line-widen))
- (propertize ")" 'help-echo help-echo)
- (propertize "%]" 'help-echo recursive-edit-help-echo)
- spaces))
-
- (standard-mode-line-position
- `((-3 ,(propertize
- "%p"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- ;; XXX needs better description
- 'help-echo "Size indication mode\n\
+(defvar mode-line-position
+ `((-3 ,(propertize
+ "%p"
+ 'local-map mode-line-column-line-number-mode-map
+ 'mouse-face 'mode-line-highlight
+ ;; XXX needs better description
+ 'help-echo "Size indication mode\n\
mouse-1: Display Line and Column Mode Menu"))
- (size-indication-mode
- (8 ,(propertize
- " of %I"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- ;; XXX needs better description
- 'help-echo "Size indication mode\n\
+ (size-indication-mode
+ (8 ,(propertize
+ " of %I"
+ 'local-map mode-line-column-line-number-mode-map
+ 'mouse-face 'mode-line-highlight
+ ;; XXX needs better description
+ 'help-echo "Size indication mode\n\
mouse-1: Display Line and Column Mode Menu")))
- (line-number-mode
- ((column-number-mode
- (10 ,(propertize
- " (%l,%c)"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Line number and Column number\n\
+ (line-number-mode
+ ((column-number-mode
+ (10 ,(propertize
+ " (%l,%c)"
+ 'local-map mode-line-column-line-number-mode-map
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "Line number and Column number\n\
mouse-1: Display Line and Column Mode Menu"))
- (6 ,(propertize
- " L%l"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Line Number\n\
+ (6 ,(propertize
+ " L%l"
+ 'local-map mode-line-column-line-number-mode-map
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "Line Number\n\
mouse-1: Display Line and Column Mode Menu"))))
- ((column-number-mode
- (5 ,(propertize
- " C%c"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Column number\n\
-mouse-1: Display Line and Column Mode Menu"))))))))
-
- (setq-default mode-line-format standard-mode-line-format)
- (put 'mode-line-format 'standard-value
- (list `(quote ,standard-mode-line-format)))
-
- (setq-default mode-line-modes standard-mode-line-modes)
- (put 'mode-line-modes 'standard-value
- (list `(quote ,standard-mode-line-modes)))
-
- (setq-default mode-line-position standard-mode-line-position)
- (put 'mode-line-position 'standard-value
- (list `(quote ,standard-mode-line-position))))
+ ((column-number-mode
+ (5 ,(propertize
+ " C%c"
+ 'local-map mode-line-column-line-number-mode-map
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "Column number\n\
+mouse-1: Display Line and Column Mode Menu"))))))
+ "Mode line construct for displaying the position in the buffer.
+Normally displays the buffer percentage and, optionally, the
+buffer size, the line number and the column number.")
+(put 'mode-line-position 'risky-local-variable t)
(defvar mode-line-buffer-identification-keymap
;; Add menu of buffer operations to the buffer identification part
@@ -438,34 +412,65 @@ text properties for face, help-echo, and local-map to it."
(list (propertize fmt
'face 'mode-line-buffer-id
'help-echo
- (purecopy "Buffer name\n\
-mouse-1: previous buffer\n\
-mouse-3: next buffer")
+ (purecopy "Buffer name
+mouse-1: Previous buffer\nmouse-3: Next buffer")
'mouse-face 'mode-line-highlight
'local-map mode-line-buffer-identification-keymap)))
-(defvar mode-line-buffer-identification (propertized-buffer-identification "%12b") "\
-Mode-line control for identifying the buffer being displayed.
+(defvar mode-line-buffer-identification
+ (propertized-buffer-identification "%12b")
+ "Mode line construct for identifying the buffer being displayed.
Its default value is (\"%12b\") with some text properties added.
Major modes that edit things other than ordinary files may change this
\(e.g. Info, Dired,...)")
-
;;;###autoload
(put 'mode-line-buffer-identification 'risky-local-variable t)
(make-variable-buffer-local 'mode-line-buffer-identification)
+(defvar mode-line-misc-info
+ '((which-func-mode ("" which-func-format " "))
+ (global-mode-string ("" global-mode-string " ")))
+ "Mode line construct for miscellaneous information.
+By default, this shows the information specified by
+`which-func-mode' and `global-mode-string'.")
+(put 'mode-line-misc-info 'risky-local-variable t)
+
+(defvar mode-line-end-spaces '(:eval (unless (display-graphic-p) "-%-"))
+ "Mode line construct to put at the end of the mode line.")
+(put 'mode-line-end-spaces 'risky-local-variable t)
+
+;; Default value of the top-level `mode-line-format' variable:
+(let ((standard-mode-line-format
+ (list "%e"
+ 'mode-line-front-space
+ 'mode-line-mule-info
+ 'mode-line-client
+ 'mode-line-modified
+ 'mode-line-remote
+ 'mode-line-frame-identification
+ 'mode-line-buffer-identification
+ " "
+ 'mode-line-position
+ '(vc-mode vc-mode)
+ " "
+ 'mode-line-modes
+ 'mode-line-misc-info
+ 'mode-line-end-spaces)))
+ (setq-default mode-line-format standard-mode-line-format)
+ (put 'mode-line-format 'standard-value
+ (list `(quote ,standard-mode-line-format))))
+
+
(defun mode-line-unbury-buffer (event) "\
Call `unbury-buffer' in this window."
(interactive "e")
- (save-selected-window
- (select-window (posn-window (event-start event)))
+ (with-selected-window (posn-window (event-start event))
(unbury-buffer)))
(defun mode-line-bury-buffer (event) "\
Like `bury-buffer', but temporarily select EVENT's window."
(interactive "e")
- (save-selected-window
- (select-window (posn-window (event-start event)))
+ (with-selected-window (posn-window (event-start event))
(bury-buffer)))
(defun mode-line-other-buffer () "\
@@ -476,15 +481,13 @@ Switch to the most recently selected buffer other than the current one."
(defun mode-line-next-buffer (event)
"Like `next-buffer', but temporarily select EVENT's window."
(interactive "e")
- (save-selected-window
- (select-window (posn-window (event-start event)))
+ (with-selected-window (posn-window (event-start event))
(next-buffer)))
(defun mode-line-previous-buffer (event)
"Like `previous-buffer', but temporarily select EVENT's window."
(interactive "e")
- (save-selected-window
- (select-window (posn-window (event-start event)))
+ (with-selected-window (posn-window (event-start event))
(previous-buffer)))
(defmacro bound-and-true-p (var)
@@ -493,51 +496,51 @@ Switch to the most recently selected buffer other than the current one."
;; Use mode-line-mode-menu for local minor-modes only.
;; Global ones can go on the menubar (Options --> Show/Hide).
-(define-key mode-line-mode-menu [overwrite-mode]
- `(menu-item ,(purecopy "Overwrite (Ovwrt)") overwrite-mode
- :help ,(purecopy "Overwrite mode: typed characters replace existing text")
+(bindings--define-key mode-line-mode-menu [overwrite-mode]
+ '(menu-item "Overwrite (Ovwrt)" overwrite-mode
+ :help "Overwrite mode: typed characters replace existing text"
:button (:toggle . overwrite-mode)))
-(define-key mode-line-mode-menu [outline-minor-mode]
- `(menu-item ,(purecopy "Outline (Outl)") outline-minor-mode
+(bindings--define-key mode-line-mode-menu [outline-minor-mode]
+ '(menu-item "Outline (Outl)" outline-minor-mode
;; XXX: This needs a good, brief description.
- :help ,(purecopy "")
+ :help ""
:button (:toggle . (bound-and-true-p outline-minor-mode))))
-(define-key mode-line-mode-menu [highlight-changes-mode]
- `(menu-item ,(purecopy "Highlight changes (Chg)") highlight-changes-mode
- :help ,(purecopy "Show changes in the buffer in a distinctive color")
+(bindings--define-key mode-line-mode-menu [highlight-changes-mode]
+ '(menu-item "Highlight changes (Chg)" highlight-changes-mode
+ :help "Show changes in the buffer in a distinctive color"
:button (:toggle . (bound-and-true-p highlight-changes-mode))))
-(define-key mode-line-mode-menu [hide-ifdef-mode]
- `(menu-item ,(purecopy "Hide ifdef (Ifdef)") hide-ifdef-mode
- :help ,(purecopy "Show/Hide code within #ifdef constructs")
+(bindings--define-key mode-line-mode-menu [hide-ifdef-mode]
+ '(menu-item "Hide ifdef (Ifdef)" hide-ifdef-mode
+ :help "Show/Hide code within #ifdef constructs"
:button (:toggle . (bound-and-true-p hide-ifdef-mode))))
-(define-key mode-line-mode-menu [glasses-mode]
- `(menu-item ,(purecopy "Glasses (o^o)") glasses-mode
- :help ,(purecopy "Insert virtual separators to make long identifiers easy to read")
+(bindings--define-key mode-line-mode-menu [glasses-mode]
+ '(menu-item "Glasses (o^o)" glasses-mode
+ :help "Insert virtual separators to make long identifiers easy to read"
:button (:toggle . (bound-and-true-p glasses-mode))))
-(define-key mode-line-mode-menu [font-lock-mode]
- `(menu-item ,(purecopy "Font Lock") font-lock-mode
- :help ,(purecopy "Syntax coloring")
+(bindings--define-key mode-line-mode-menu [font-lock-mode]
+ '(menu-item "Font Lock" font-lock-mode
+ :help "Syntax coloring"
:button (:toggle . font-lock-mode)))
-(define-key mode-line-mode-menu [flyspell-mode]
- `(menu-item ,(purecopy "Flyspell (Fly)") flyspell-mode
- :help ,(purecopy "Spell checking on the fly")
+(bindings--define-key mode-line-mode-menu [flyspell-mode]
+ '(menu-item "Flyspell (Fly)" flyspell-mode
+ :help "Spell checking on the fly"
:button (:toggle . (bound-and-true-p flyspell-mode))))
-(define-key mode-line-mode-menu [auto-revert-tail-mode]
- `(menu-item ,(purecopy "Auto revert tail (Tail)") auto-revert-tail-mode
- :help ,(purecopy "Revert the tail of the buffer when buffer grows")
+(bindings--define-key mode-line-mode-menu [auto-revert-tail-mode]
+ '(menu-item "Auto revert tail (Tail)" auto-revert-tail-mode
+ :help "Revert the tail of the buffer when buffer grows"
:enable (buffer-file-name)
:button (:toggle . (bound-and-true-p auto-revert-tail-mode))))
-(define-key mode-line-mode-menu [auto-revert-mode]
- `(menu-item ,(purecopy "Auto revert (ARev)") auto-revert-mode
- :help ,(purecopy "Revert the buffer when the file on disk changes")
+(bindings--define-key mode-line-mode-menu [auto-revert-mode]
+ '(menu-item "Auto revert (ARev)" auto-revert-mode
+ :help "Revert the buffer when the file on disk changes"
:button (:toggle . (bound-and-true-p auto-revert-mode))))
-(define-key mode-line-mode-menu [auto-fill-mode]
- `(menu-item ,(purecopy "Auto fill (Fill)") auto-fill-mode
- :help ,(purecopy "Automatically insert new lines")
+(bindings--define-key mode-line-mode-menu [auto-fill-mode]
+ '(menu-item "Auto fill (Fill)" auto-fill-mode
+ :help "Automatically insert new lines"
:button (:toggle . auto-fill-function)))
-(define-key mode-line-mode-menu [abbrev-mode]
- `(menu-item ,(purecopy "Abbrev (Abbrev)") abbrev-mode
- :help ,(purecopy "Automatically expand abbreviations")
+(bindings--define-key mode-line-mode-menu [abbrev-mode]
+ '(menu-item "Abbrev (Abbrev)" abbrev-mode
+ :help "Automatically expand abbreviations"
:button (:toggle . abbrev-mode)))
(defun mode-line-minor-mode-help (event)
@@ -551,8 +554,8 @@ Alist saying how to show minor modes in the mode line.
Each element looks like (VARIABLE STRING);
STRING is included in the mode line if VARIABLE's value is non-nil.
-Actually, STRING need not be a string; any possible mode-line element
-is okay. See `mode-line-format'.")
+Actually, STRING need not be a string; any mode-line construct is
+okay. See `mode-line-format'.")
;;;###autoload
(put 'minor-mode-alist 'risky-local-variable t)
;; Don't use purecopy here--some people want to change these strings.
@@ -623,29 +626,31 @@ is okay. See `mode-line-format'.")
;; Packages should add to this list appropriately when they are
;; loaded, rather than listing everything here.
(setq debug-ignored-errors
+ ;; FIXME: Maybe beginning-of-line, beginning-of-buffer, end-of-line,
+ ;; end-of-buffer, end-of-file, buffer-read-only, and
+ ;; file-supersession should all be user-errors!
`(beginning-of-line beginning-of-buffer end-of-line
end-of-buffer end-of-file buffer-read-only
file-supersession
- ,(purecopy "^Previous command was not a yank$")
- ,(purecopy "^Minibuffer window is not active$")
- ,(purecopy "^No previous history search regexp$")
- ,(purecopy "^No later matching history item$")
- ,(purecopy "^No earlier matching history item$")
- ,(purecopy "^End of history; no default available$")
- ,(purecopy "^End of defaults; no next item$")
- ,(purecopy "^Beginning of history; no preceding item$")
- ,(purecopy "^No recursive edit is in progress$")
- ,(purecopy "^Changes to be undone are outside visible portion of buffer$")
- ,(purecopy "^No undo information in this buffer$")
- ,(purecopy "^No further undo information")
- ,(purecopy "^Save not confirmed$")
- ,(purecopy "^Recover-file cancelled\\.$")
- ,(purecopy "^Cannot switch buffers in a dedicated window$")
+ user-error ;; That's the main one!
))
-
(make-variable-buffer-local 'indent-tabs-mode)
+;; These per-buffer variables are never reset by
+;; `kill-all-local-variables', because they have no default value.
+;; For consistency, we give them the `permanent-local' property, even
+;; though `kill-all-local-variables' does not actually consult it.
+
+(mapc (lambda (sym) (put sym 'permanent-local t))
+ '(buffer-file-name default-directory buffer-backed-up
+ buffer-saved-size buffer-auto-save-file-name
+ buffer-read-only buffer-undo-list mark-active
+ point-before-scroll buffer-file-truename
+ buffer-file-format buffer-auto-save-file-format
+ buffer-display-count buffer-display-time
+ enable-multibyte-characters))
+
;; We have base64, md5 and sha1 functions built in now.
(provide 'base64)
(provide 'md5)
@@ -797,16 +802,20 @@ if `inhibit-field-text-motion' is non-nil."
(define-key ctl-x-map [right] 'next-buffer)
(define-key ctl-x-map [C-right] 'next-buffer)
+(define-key global-map [XF86Forward] 'next-buffer)
(define-key ctl-x-map [left] 'previous-buffer)
(define-key ctl-x-map [C-left] 'previous-buffer)
+(define-key global-map [XF86Back] 'previous-buffer)
(let ((map minibuffer-local-map))
(define-key map "\en" 'next-history-element)
(define-key map [next] 'next-history-element)
(define-key map [down] 'next-history-element)
+ (define-key map [XF86Forward] 'next-history-element)
(define-key map "\ep" 'previous-history-element)
(define-key map [prior] 'previous-history-element)
(define-key map [up] 'previous-history-element)
+ (define-key map [XF86Back] 'previous-history-element)
(define-key map "\es" 'next-matching-history-element)
(define-key map "\er" 'previous-matching-history-element)
;; Override the global binding (which calls indent-relative via
@@ -868,12 +877,14 @@ if `inhibit-field-text-motion' is non-nil."
"Keymap for navigation commands.")
(define-key esc-map "g" goto-map)
+(define-key goto-map "c" 'goto-char)
(define-key goto-map "g" 'goto-line)
(define-key goto-map "\M-g" 'goto-line)
(define-key goto-map "n" 'next-error)
(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.")
@@ -1158,7 +1169,30 @@ if `inhibit-field-text-motion' is non-nil."
(define-key ctl-x-5-map "m" 'compose-mail-other-frame)
-(defvar ctl-x-r-map (make-sparse-keymap)
+(defvar ctl-x-r-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "c" 'clear-rectangle)
+ (define-key map "k" 'kill-rectangle)
+ (define-key map "d" 'delete-rectangle)
+ (define-key map "y" 'yank-rectangle)
+ (define-key map "o" 'open-rectangle)
+ (define-key map "t" 'string-rectangle)
+ (define-key map "N" 'rectangle-number-lines)
+ (define-key map "\M-w" 'copy-rectangle-as-kill)
+ (define-key map "\C-@" 'point-to-register)
+ (define-key map [?\C-\ ] 'point-to-register)
+ (define-key map " " 'point-to-register)
+ (define-key map "j" 'jump-to-register)
+ (define-key map "s" 'copy-to-register)
+ (define-key map "x" 'copy-to-register)
+ (define-key map "i" 'insert-register)
+ (define-key map "g" 'insert-register)
+ (define-key map "r" 'copy-rectangle-to-register)
+ (define-key map "n" 'number-to-register)
+ (define-key map "+" 'increment-register)
+ (define-key map "w" 'window-configuration-to-register)
+ (define-key map "f" 'frame-configuration-to-register)
+ map)
"Keymap for subcommands of C-x r.")
(define-key ctl-x-map "r" ctl-x-r-map)
@@ -1200,6 +1234,7 @@ if `inhibit-field-text-motion' is non-nil."
;; (define-key ctl-x-map "\-" 'inverse-add-global-abbrev)
(define-key esc-map "'" 'abbrev-prefix-mark)
(define-key ctl-x-map "'" 'expand-abbrev)
+(define-key ctl-x-map "\C-b" 'list-buffers)
(define-key ctl-x-map "z" 'repeat)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 4d93e01fb2e..e3fdf1847b8 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -1,6 +1,6 @@
;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later
-;; Copyright (C) 1993-1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Maintainer: Karl Fogel <kfogel@red-bean.com>
@@ -33,7 +33,7 @@
;;; Code:
(require 'pp)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; Misc comments:
;;
@@ -65,7 +65,7 @@
--> t means save bookmarks when Emacs is killed.
--> Otherwise, it should be a number that is the frequency with which
the bookmark list is saved (i.e.: the number of times which
- Emacs' bookmark list may be modified before it is automatically
+ Emacs's bookmark list may be modified before it is automatically
saved.). If it is a number, Emacs will also automatically save
bookmarks when it is killed.
@@ -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)
@@ -144,10 +146,7 @@ You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookma
(defcustom bookmark-bmenu-toggle-filenames t
"Non-nil means show filenames when listing bookmarks.
-This may result in truncated bookmark names. To disable this, put the
-following in your `.emacs' file:
-
-\(setq bookmark-bmenu-toggle-filenames nil)"
+A non-nil value may result in truncated bookmark names."
:type 'boolean
:group 'bookmark)
@@ -277,8 +276,8 @@ through a file easier.")
(defvar bookmark-current-buffer nil
"The buffer in which a bookmark is currently being set or renamed.
Functions that insert strings into the minibuffer use this to know
-the source buffer for that information; see `bookmark-yank-word' and
-`bookmark-insert-current-bookmark' for example.")
+the source buffer for that information; see `bookmark-yank-word'
+for example.")
(defvar bookmark-yank-point 0
@@ -434,7 +433,11 @@ the empty string."
": ")))
(str
(completing-read prompt
- bookmark-alist
+ (lambda (string pred action)
+ (if (eq action 'metadata)
+ '(metadata (category . bookmark))
+ (complete-with-action
+ action bookmark-alist string pred)))
nil
0
nil
@@ -473,6 +476,12 @@ equivalently just return ALIST without NAME.")
(defun bookmark-make-record ()
"Return a new bookmark record (NAME . ALIST) for the current location."
(let ((record (funcall bookmark-make-record-function)))
+ ;; Set up defaults.
+ (bookmark-prop-set
+ record 'defaults
+ (delq nil (delete-dups (append (bookmark-prop-get record 'defaults)
+ (list bookmark-current-bookmark
+ (bookmark-buffer-name))))))
;; Set up default name.
(if (stringp (car record))
;; The function already provided a default name.
@@ -738,10 +747,6 @@ This expects to be called from `point-min' in a bookmark file."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(define-key map "\C-w" 'bookmark-yank-word)
- ;; This C-u binding might not be very useful any more now that we
- ;; provide access to the default via the standard M-n binding.
- ;; Maybe we should just remove it? --Stef-08
- (define-key map "\C-u" 'bookmark-insert-current-bookmark)
map))
;;;###autoload
@@ -772,7 +777,19 @@ the list of bookmarks.)"
(interactive (list nil current-prefix-arg))
(unwind-protect
(let* ((record (bookmark-make-record))
- (default (car record)))
+ ;; `defaults' is a transient element of the
+ ;; extensible format described above in the section
+ ;; `File format stuff'. Bookmark record functions
+ ;; can use it to specify a list of default values
+ ;; accessible via M-n while reading a bookmark name.
+ (defaults (bookmark-prop-get record 'defaults))
+ (default (if (consp defaults) (car defaults) defaults)))
+
+ (if defaults
+ ;; Don't store default values in the record.
+ (setq record (assq-delete-all 'defaults record))
+ ;; When no defaults in the record, use its first element.
+ (setq defaults (car record) default defaults))
(bookmark-maybe-load-default-file)
;; Don't set `bookmark-yank-point' and `bookmark-current-buffer'
@@ -788,7 +805,7 @@ the list of bookmarks.)"
(format "Set bookmark (%s): " default)
nil
bookmark-minibuffer-read-name-map
- nil nil default))))
+ nil nil defaults))))
(and (string-equal str "") (setq str default))
(bookmark-store str (cdr record) no-overwrite)
@@ -828,11 +845,11 @@ annotations."
"# Date: " (current-time-string) "\n"))
+(define-obsolete-variable-alias 'bookmark-read-annotation-text-func
+ 'bookmark-edit-annotation-text-func "23.1")
(defvar bookmark-edit-annotation-text-func 'bookmark-default-annotation-text
"Function to return default text to use for a bookmark annotation.
It takes one argument, the name of the bookmark, as a string.")
-(define-obsolete-variable-alias 'bookmark-read-annotation-text-func
- 'bookmark-edit-annotation-text-func "23.1")
(defvar bookmark-edit-annotation-mode-map
(let ((map (make-sparse-keymap)))
@@ -888,18 +905,6 @@ Lines beginning with `#' are ignored."
(bookmark-edit-annotation-mode bookmark-name-or-record))
-(defun bookmark-insert-current-bookmark ()
- "Insert into the bookmark name currently being set the value of
-`bookmark-current-bookmark' in `bookmark-current-buffer', defaulting
-to the buffer's file name if `bookmark-current-bookmark' is nil."
- (interactive)
- (let ((str
- (with-current-buffer bookmark-current-buffer
- (or bookmark-current-bookmark
- (bookmark-buffer-name)))))
- (insert str)))
-
-
(defun bookmark-buffer-name ()
"Return the name of the current buffer in a form usable as a bookmark name.
If the buffer is associated with a file or directory, use that name."
@@ -1049,12 +1054,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,
@@ -1359,7 +1363,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.
@@ -1864,10 +1873,8 @@ With a prefix arg, prompts for a file to save them in."
The current window remains selected."
(interactive)
(let ((bookmark (bookmark-bmenu-bookmark))
- (pop-up-windows t)
- same-window-buffer-names
- same-window-regexps)
- (bookmark--jump-via bookmark 'display-buffer)))
+ (fun (lambda (b) (display-buffer b t))))
+ (bookmark--jump-via bookmark fun)))
(defun bookmark-bmenu-other-window-with-mouse (event)
"Select bookmark at the mouse pointer in other window, leaving bookmark menu visible."
@@ -2005,38 +2012,12 @@ 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))))
- (case char
- ((?\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
- (t
- (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
- (loop for i in bookmark-alist
- when (string-match regexp (car i)) collect i into new
- finally return new)))
+ (cl-loop for i in bookmark-alist
+ when (string-match regexp (car i)) collect i into new
+ finally return new)))
(bookmark-bmenu-list)))
@@ -2045,19 +2026,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."
@@ -2115,36 +2100,36 @@ strings returned are not."
;;;###autoload
(defvar menu-bar-bookmark-map
(let ((map (make-sparse-keymap "Bookmark functions")))
- (define-key map [load]
- `(menu-item ,(purecopy "Load a Bookmark File...") bookmark-load
- :help ,(purecopy "Load bookmarks from a bookmark file)")))
- (define-key map [write]
- `(menu-item ,(purecopy "Save Bookmarks As...") bookmark-write
- :help ,(purecopy "Write bookmarks to a file (reading the file name with the minibuffer)")))
- (define-key map [save]
- `(menu-item ,(purecopy "Save Bookmarks") bookmark-save
- :help ,(purecopy "Save currently defined bookmarks")))
- (define-key map [edit]
- `(menu-item ,(purecopy "Edit Bookmark List") bookmark-bmenu-list
- :help ,(purecopy "Display a list of existing bookmarks")))
- (define-key map [delete]
- `(menu-item ,(purecopy "Delete Bookmark...") bookmark-delete
- :help ,(purecopy "Delete a bookmark from the bookmark list")))
- (define-key map [rename]
- `(menu-item ,(purecopy "Rename Bookmark...") bookmark-rename
- :help ,(purecopy "Change the name of a bookmark")))
- (define-key map [locate]
- `(menu-item ,(purecopy "Insert Location...") bookmark-locate
- :help ,(purecopy "Insert the name of the file associated with a bookmark")))
- (define-key map [insert]
- `(menu-item ,(purecopy "Insert Contents...") bookmark-insert
- :help ,(purecopy "Insert the text of the file pointed to by a bookmark")))
- (define-key map [set]
- `(menu-item ,(purecopy "Set Bookmark...") bookmark-set
- :help ,(purecopy "Set a bookmark named inside a file.")))
- (define-key map [jump]
- `(menu-item ,(purecopy "Jump to Bookmark...") bookmark-jump
- :help ,(purecopy "Jump to a bookmark (a point in some file)")))
+ (bindings--define-key map [load]
+ '(menu-item "Load a Bookmark File..." bookmark-load
+ :help "Load bookmarks from a bookmark file)"))
+ (bindings--define-key map [write]
+ '(menu-item "Save Bookmarks As..." bookmark-write
+ :help "Write bookmarks to a file (reading the file name with the minibuffer)"))
+ (bindings--define-key map [save]
+ '(menu-item "Save Bookmarks" bookmark-save
+ :help "Save currently defined bookmarks"))
+ (bindings--define-key map [edit]
+ '(menu-item "Edit Bookmark List" bookmark-bmenu-list
+ :help "Display a list of existing bookmarks"))
+ (bindings--define-key map [delete]
+ '(menu-item "Delete Bookmark..." bookmark-delete
+ :help "Delete a bookmark from the bookmark list"))
+ (bindings--define-key map [rename]
+ '(menu-item "Rename Bookmark..." bookmark-rename
+ :help "Change the name of a bookmark"))
+ (bindings--define-key map [locate]
+ '(menu-item "Insert Location..." bookmark-locate
+ :help "Insert the name of the file associated with a bookmark"))
+ (bindings--define-key map [insert]
+ '(menu-item "Insert Contents..." bookmark-insert
+ :help "Insert the text of the file pointed to by a bookmark"))
+ (bindings--define-key map [set]
+ '(menu-item "Set Bookmark..." bookmark-set
+ :help "Set a bookmark named inside a file."))
+ (bindings--define-key map [jump]
+ '(menu-item "Jump to Bookmark..." bookmark-jump
+ :help "Jump to a bookmark (a point in some file)"))
map))
;;;###autoload
@@ -2164,11 +2149,11 @@ strings returned are not."
"Hook run at the end of loading library `bookmark.el'.")
;; Exit Hook, called from kill-emacs-hook
+(define-obsolete-variable-alias 'bookmark-exit-hooks
+ 'bookmark-exit-hook "22.1")
(defvar bookmark-exit-hook nil
"Hook run when Emacs exits.")
-(define-obsolete-variable-alias 'bookmark-exit-hooks 'bookmark-exit-hook "22.1")
-
(defun bookmark-exit-hook-internal ()
"Save bookmark state, if necessary, at Emacs exit time.
This also runs `bookmark-exit-hook'."
diff --git a/lisp/bs.el b/lisp/bs.el
index 2a31b05a31f..a84c951acfe 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -1,6 +1,6 @@
;;; bs.el --- menu for selecting and displaying buffers -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Olaf Sylvester <Olaf.Sylvester@netsurf.de>
;; Maintainer: Olaf Sylvester <Olaf.Sylvester@netsurf.de>
;; Keywords: convenience
@@ -124,8 +124,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
;; ----------------------------------------------------------------------
;; Globals for customization
;; ----------------------------------------------------------------------
@@ -618,7 +616,7 @@ Used from `window-size-change-functions'."
(put 'bs-mode 'mode-class 'special)
(define-derived-mode bs-mode nil "Buffer-Selection-Menu"
- "Major mode for editing a subset of Emacs' buffers.
+ "Major mode for editing a subset of Emacs's buffers.
\\<bs-mode-map>
Aside from two header lines each line describes one buffer.
Move to a line representing the buffer you want to edit and select
@@ -830,10 +828,10 @@ See `visit-tags-table'."
(interactive)
(let ((res
(with-current-buffer (bs--current-buffer)
- (setq bs-buffer-show-mark (case bs-buffer-show-mark
- ((nil) 'never)
- ((never) 'always)
- (t nil))))))
+ (setq bs-buffer-show-mark (pcase bs-buffer-show-mark
+ (`nil 'never)
+ (`never 'always)
+ (_ nil))))))
(bs--update-current-line)
(bs--set-window-height)
(bs--show-config-message res)))
@@ -964,7 +962,7 @@ Default is `bs--current-sort-function'."
Uses function `toggle-read-only'."
(interactive)
(with-current-buffer (bs--current-buffer)
- (toggle-read-only))
+ (read-only-mode 'toggle))
(bs--update-current-line))
(defun bs-clear-modified ()
@@ -1414,7 +1412,8 @@ for buffer selection."
(bs--restore-window-config)
(setq bs--window-config-coming-from (current-window-configuration))
(when (> (window-height (selected-window)) 7)
- (select-window (split-window-below))))
+ ;; Errors would mess with the window configuration (bug#10882).
+ (ignore-errors (select-window (split-window-below)))))
(bs-show-in-buffer liste)
(bs-message-without-log "%s" (bs--current-config-message)))))
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 291430d4393..6ab6e548ab5 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -1,6 +1,6 @@
-;;; buff-menu.el --- buffer menu main function and support functions -*- coding:utf-8 -*-
+;;; buff-menu.el --- Interface for viewing and manipulating buffers
-;; Copyright (C) 1985-1987, 1993-1995, 2000-2011
+;; Copyright (C) 1985-1987, 1993-1995, 2000-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -24,44 +24,13 @@
;;; Commentary:
-;; Edit, delete, or change attributes of all currently active Emacs
-;; buffers from a list summarizing their state. A good way to browse
-;; any special or scratch buffers you have loaded, since you can't find
-;; them by filename. The single entry point is `list-buffers',
-;; normally bound to C-x C-b.
-
-;;; Change Log:
-
-;; Buffer-menu-view: New function
-;; Buffer-menu-view-other-window: New function
-
-;; Merged by esr with recent mods to Emacs 19 buff-menu, 23 Mar 1993
-;;
-;; Modified by Bob Weiner, Motorola, Inc., 4/14/89
-;;
-;; Added optional backup argument to 'Buffer-menu-unmark' to make it undelete
-;; current entry and then move to previous one.
-;;
-;; Based on FSF code dating back to 1985.
+;; The Buffer Menu is used to view, edit, delete, or change attributes
+;; of buffers. The entry points are C-x C-b (`list-buffers') and
+;; M-x buffer-menu.
;;; Code:
-;;Trying to preserve the old window configuration works well in
-;;simple scenarios, when you enter the buffer menu, use it, and exit it.
-;;But it does strange things when you switch back to the buffer list buffer
-;;with C-x b, later on, when the window configuration is different.
-;;The choice seems to be, either restore the window configuration
-;;in all cases, or in no cases.
-;;I decided it was better not to restore the window config at all. -- rms.
-
-;;But since then, I changed buffer-menu to use the selected window,
-;;so q now once again goes back to the previous window configuration.
-
-;;(defvar Buffer-menu-window-config nil
-;; "Window configuration saved from entry to `buffer-menu'.")
-
-;; Put buffer *Buffer List* into proper mode right away
-;; so that from now on even list-buffers is enough to get a buffer menu.
+(require 'tabulated-list)
(defgroup Buffer-menu nil
"Show a menu of all buffers in a buffer."
@@ -69,23 +38,45 @@
:group 'convenience)
(defcustom Buffer-menu-use-header-line t
- "Non-nil means to use an immovable header-line."
+ "If non-nil, use the header line to display Buffer Menu column titles."
:type 'boolean
:group 'Buffer-menu)
(defface buffer-menu-buffer
'((t (:weight bold)))
- "Face used to highlight buffer names in the buffer menu."
+ "Face for buffer names in the Buffer Menu."
:group 'Buffer-menu)
(put 'Buffer-menu-buffer 'face-alias 'buffer-menu-buffer)
-(defcustom Buffer-menu-buffer+size-width 26
- "How wide to jointly make the buffer name and size columns."
+(defcustom Buffer-menu-buffer+size-width nil
+ "Combined width of buffer name and size columns in Buffer Menu.
+If nil, use `Buffer-menu-name-width' and `Buffer-menu-size-width'.
+
+If non-nil, the value of `Buffer-menu-name-width' is overridden;
+the name column is assigned width `Buffer-menu-buffer+size-width'
+minus `Buffer-menu-size-width'. This use is deprecated."
:type 'number
- :group 'Buffer-menu)
+ :group 'Buffer-menu
+ :version "24.3")
+
+(make-obsolete-variable 'Buffer-menu-buffer+size-width
+ "`Buffer-menu-name-width' and `Buffer-menu-size-width'"
+ "24.3")
+
+(defcustom Buffer-menu-name-width 19
+ "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 size column in the Buffer Menu."
+ :type 'number
+ :group 'Buffer-menu
+ :version "24.3")
(defcustom Buffer-menu-mode-width 16
- "How wide to make the mode name column."
+ "Width of mode name column in the Buffer Menu."
:type 'number
:group 'Buffer-menu)
@@ -99,35 +90,19 @@ as it is by default."
:group 'Buffer-menu
:version "22.1")
-;; This should get updated & resorted when you click on a column heading
-(defvar Buffer-menu-sort-column nil
- "Which column to sort the menu on.
-Use 2 to sort by buffer names, or 5 to sort by file names.
-A nil value means sort by visited order (the default).")
-
-(defconst Buffer-menu-buffer-column 4)
-
(defvar Buffer-menu-files-only nil
- "Non-nil if the current buffer-menu lists only file buffers.
-This variable determines whether reverting the buffer lists only
-file buffers. It affects both manual reverting and reverting by
-Auto Revert Mode.")
+ "Non-nil if the current Buffer Menu lists only file buffers.
+This is set by the prefix argument to `buffer-menu' and related
+commands.")
(make-variable-buffer-local 'Buffer-menu-files-only)
-(defvar Buffer-menu--buffers nil
- "If non-nil, list of buffers shown in the current buffer-menu.
-This variable determines whether reverting the buffer lists only
-these buffers. It affects both manual reverting and reverting by
-Auto Revert Mode.")
-(make-variable-buffer-local 'Buffer-menu--buffers)
-
-(defvar Info-current-file) ;; from info.el
-(defvar Info-current-node) ;; from info.el
+(defvar Info-current-file) ; from info.el
+(defvar Info-current-node) ; from info.el
(defvar Buffer-menu-mode-map
- (let ((map (make-keymap))
+ (let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap)))
- (suppress-keymap map t)
+ (set-keymap-parent map tabulated-list-mode-map)
(define-key map "v" 'Buffer-menu-select)
(define-key map "2" 'Buffer-menu-2-window)
(define-key map "1" 'Buffer-menu-1-window)
@@ -139,12 +114,10 @@ Auto Revert Mode.")
(define-key map "s" 'Buffer-menu-save)
(define-key map "d" 'Buffer-menu-delete)
(define-key map "k" 'Buffer-menu-delete)
- (define-key map "\C-d" 'Buffer-menu-delete-backwards)
(define-key map "\C-k" 'Buffer-menu-delete)
+ (define-key map "\C-d" 'Buffer-menu-delete-backwards)
(define-key map "x" 'Buffer-menu-execute)
(define-key map " " 'next-line)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
(define-key map "\177" 'Buffer-menu-backup-unmark)
(define-key map "~" 'Buffer-menu-not-modified)
(define-key map "u" 'Buffer-menu-unmark)
@@ -154,213 +127,196 @@ Auto Revert Mode.")
(define-key map "b" 'Buffer-menu-bury)
(define-key map "V" 'Buffer-menu-view)
(define-key map "T" 'Buffer-menu-toggle-files-only)
- (define-key map [mouse-2] 'Buffer-menu-mouse-select)
- (define-key map [follow-link] 'mouse-face)
(define-key map (kbd "M-s a C-s") 'Buffer-menu-isearch-buffers)
(define-key map (kbd "M-s a M-C-s") 'Buffer-menu-isearch-buffers-regexp)
+
+ (define-key map [mouse-2] 'Buffer-menu-mouse-select)
+ (define-key map [follow-link] 'mouse-face)
+
(define-key map [menu-bar Buffer-menu-mode] (cons (purecopy "Buffer-Menu") menu-map))
- (define-key menu-map [quit]
- `(menu-item ,(purecopy "Quit") quit-window
- :help ,(purecopy "Remove the buffer menu from the display")))
- (define-key menu-map [rev]
- `(menu-item ,(purecopy "Refresh") revert-buffer
- :help ,(purecopy "Refresh the *Buffer List* buffer contents")))
- (define-key menu-map [s0] menu-bar-separator)
- (define-key menu-map [tf]
- `(menu-item ,(purecopy "Show Only File Buffers") Buffer-menu-toggle-files-only
+ (bindings--define-key menu-map [quit]
+ '(menu-item "Quit" quit-window
+ :help "Remove the buffer menu from the display"))
+ (bindings--define-key menu-map [rev]
+ '(menu-item "Refresh" revert-buffer
+ :help "Refresh the *Buffer List* buffer contents"))
+ (bindings--define-key menu-map [s0] menu-bar-separator)
+ (bindings--define-key menu-map [tf]
+ '(menu-item "Show Only File Buffers" Buffer-menu-toggle-files-only
:button (:toggle . Buffer-menu-files-only)
- :help ,(purecopy "Toggle whether the current buffer-menu displays only file buffers")))
- (define-key menu-map [s1] menu-bar-separator)
+ :help "Toggle whether the current buffer-menu displays only file buffers"))
+ (bindings--define-key menu-map [s1] menu-bar-separator)
;; FIXME: The "Select" entries could use better names...
- (define-key menu-map [sel]
- `(menu-item ,(purecopy "Select Marked") Buffer-menu-select
- :help ,(purecopy "Select this line's buffer; also display buffers marked with `>'")))
- (define-key menu-map [bm2]
- `(menu-item ,(purecopy "Select Two") Buffer-menu-2-window
- :help ,(purecopy "Select this line's buffer, with previous buffer in second window")))
- (define-key menu-map [bm1]
- `(menu-item ,(purecopy "Select Current") Buffer-menu-1-window
- :help ,(purecopy "Select this line's buffer, alone, in full frame")))
- (define-key menu-map [ow]
- `(menu-item ,(purecopy "Select in Other Window") Buffer-menu-other-window
- :help ,(purecopy "Select this line's buffer in other window, leaving buffer menu visible")))
- (define-key menu-map [tw]
- `(menu-item ,(purecopy "Select in Current Window") Buffer-menu-this-window
- :help ,(purecopy "Select this line's buffer in this window")))
- (define-key menu-map [s2] menu-bar-separator)
- (define-key menu-map [is]
- `(menu-item ,(purecopy "Regexp Isearch Marked Buffers...") Buffer-menu-isearch-buffers-regexp
- :help ,(purecopy "Search for a regexp through all marked buffers using Isearch")))
- (define-key menu-map [ir]
- `(menu-item ,(purecopy "Isearch Marked Buffers...") Buffer-menu-isearch-buffers
- :help ,(purecopy "Search for a string through all marked buffers using Isearch")))
- (define-key menu-map [s3] menu-bar-separator)
- (define-key menu-map [by]
- `(menu-item ,(purecopy "Bury") Buffer-menu-bury
- :help ,(purecopy "Bury the buffer listed on this line")))
- (define-key menu-map [vt]
- `(menu-item ,(purecopy "Set Unmodified") Buffer-menu-not-modified
- :help ,(purecopy "Mark buffer on this line as unmodified (no changes to save)")))
- (define-key menu-map [ex]
- `(menu-item ,(purecopy "Execute") Buffer-menu-execute
- :help ,(purecopy "Save and/or delete buffers marked with s or k commands")))
- (define-key menu-map [s4] menu-bar-separator)
- (define-key menu-map [delb]
- `(menu-item ,(purecopy "Mark for Delete and Move Backwards") Buffer-menu-delete-backwards
- :help ,(purecopy "Mark buffer on this line to be deleted by x command and move up one line")))
- (define-key menu-map [del]
- `(menu-item ,(purecopy "Mark for Delete") Buffer-menu-delete
- :help ,(purecopy "Mark buffer on this line to be deleted by x command")))
-
- (define-key menu-map [sv]
- `(menu-item ,(purecopy "Mark for Save") Buffer-menu-save
- :help ,(purecopy "Mark buffer on this line to be saved by x command")))
- (define-key menu-map [umk]
- `(menu-item ,(purecopy "Unmark") Buffer-menu-unmark
- :help ,(purecopy "Cancel all requested operations on buffer on this line and move down")))
- (define-key menu-map [mk]
- `(menu-item ,(purecopy "Mark") Buffer-menu-mark
- :help ,(purecopy "Mark buffer on this line for being displayed by v command")))
+ (bindings--define-key menu-map [sel]
+ '(menu-item "Select Marked" Buffer-menu-select
+ :help "Select this line's buffer; also display buffers marked with `>'"))
+ (bindings--define-key menu-map [bm2]
+ '(menu-item "Select Two" Buffer-menu-2-window
+ :help "Select this line's buffer, with previous buffer in second window"))
+ (bindings--define-key menu-map [bm1]
+ '(menu-item "Select Current" Buffer-menu-1-window
+ :help "Select this line's buffer, alone, in full frame"))
+ (bindings--define-key menu-map [ow]
+ '(menu-item "Select in Other Window" Buffer-menu-other-window
+ :help "Select this line's buffer in other window, leaving buffer menu visible"))
+ (bindings--define-key menu-map [tw]
+ '(menu-item "Select in Current Window" Buffer-menu-this-window
+ :help "Select this line's buffer in this window"))
+ (bindings--define-key menu-map [s2] menu-bar-separator)
+ (bindings--define-key menu-map [is]
+ '(menu-item "Regexp Isearch Marked Buffers..." Buffer-menu-isearch-buffers-regexp
+ :help "Search for a regexp through all marked buffers using Isearch"))
+ (bindings--define-key menu-map [ir]
+ '(menu-item "Isearch Marked Buffers..." Buffer-menu-isearch-buffers
+ :help "Search for a string through all marked buffers using Isearch"))
+ (bindings--define-key menu-map [s3] menu-bar-separator)
+ (bindings--define-key menu-map [by]
+ '(menu-item "Bury" Buffer-menu-bury
+ :help "Bury the buffer listed on this line"))
+ (bindings--define-key menu-map [vt]
+ '(menu-item "Set Unmodified" Buffer-menu-not-modified
+ :help "Mark buffer on this line as unmodified (no changes to save)"))
+ (bindings--define-key menu-map [ex]
+ '(menu-item "Execute" Buffer-menu-execute
+ :help "Save and/or delete buffers marked with s or k commands"))
+ (bindings--define-key menu-map [s4] menu-bar-separator)
+ (bindings--define-key menu-map [delb]
+ '(menu-item "Mark for Delete and Move Backwards" Buffer-menu-delete-backwards
+ :help "Mark buffer on this line to be deleted by x command and move up one line"))
+ (bindings--define-key menu-map [del]
+ '(menu-item "Mark for Delete" Buffer-menu-delete
+ :help "Mark buffer on this line to be deleted by x command"))
+
+ (bindings--define-key menu-map [sv]
+ '(menu-item "Mark for Save" Buffer-menu-save
+ :help "Mark buffer on this line to be saved by x command"))
+ (bindings--define-key menu-map [umk]
+ '(menu-item "Unmark" Buffer-menu-unmark
+ :help "Cancel all requested operations on buffer on this line and move down"))
+ (bindings--define-key menu-map [mk]
+ '(menu-item "Mark" Buffer-menu-mark
+ :help "Mark buffer on this line for being displayed by v command"))
map)
"Local keymap for `Buffer-menu-mode' buffers.")
-;; Buffer Menu mode is suitable only for specially formatted data.
-(put 'Buffer-menu-mode 'mode-class 'special)
+(define-obsolete-variable-alias 'buffer-menu-mode-hook
+ 'Buffer-menu-mode-hook "23.1")
-(define-derived-mode Buffer-menu-mode special-mode "Buffer Menu"
- "Major mode for editing a list of buffers.
-Each line describes one of the buffers in Emacs.
-Letters do not insert themselves; instead, they are commands.
-\\<Buffer-menu-mode-map>
-\\[Buffer-menu-mouse-select] -- select buffer you click on, in place of the buffer menu.
-\\[Buffer-menu-this-window] -- select current line's buffer in place of the buffer menu.
-\\[Buffer-menu-other-window] -- select that buffer in another window,
- so the buffer menu buffer remains visible in its window.
-\\[Buffer-menu-view] -- select current line's buffer, but in view-mode.
-\\[Buffer-menu-view-other-window] -- select that buffer in
- another window, in view-mode.
-\\[Buffer-menu-switch-other-window] -- make another window display that buffer.
-\\[Buffer-menu-mark] -- mark current line's buffer to be displayed.
-\\[Buffer-menu-select] -- select current line's buffer.
- Also show buffers marked with m, in other windows.
-\\[Buffer-menu-1-window] -- select that buffer in full-frame window.
-\\[Buffer-menu-2-window] -- select that buffer in one window,
- together with buffer selected before this one in another window.
-\\[Buffer-menu-isearch-buffers] -- Do incremental search in the marked buffers.
-\\[Buffer-menu-isearch-buffers-regexp] -- Isearch for regexp in the marked buffers.
-\\[Buffer-menu-visit-tags-table] -- visit-tags-table this buffer.
-\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
-\\[Buffer-menu-save] -- mark that buffer to be saved, and move down.
-\\[Buffer-menu-delete] -- mark that buffer to be deleted, and move down.
-\\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted, and move up.
-\\[Buffer-menu-execute] -- delete or save marked buffers.
-\\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
- With prefix argument, also move up one line.
-\\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
-\\[Buffer-menu-toggle-read-only] -- toggle read-only status of buffer on this line.
-\\[revert-buffer] -- update the list of buffers.
-\\[Buffer-menu-toggle-files-only] -- toggle whether the menu displays only file buffers.
-\\[Buffer-menu-bury] -- bury the buffer listed on this line."
- (set (make-local-variable 'revert-buffer-function)
- 'Buffer-menu-revert-function)
+(define-derived-mode Buffer-menu-mode tabulated-list-mode "Buffer Menu"
+ "Major mode for Buffer Menu buffers.
+The Buffer Menu is invoked by the commands \\[list-buffers], \\[buffer-menu], and
+\\[buffer-menu-other-window]. See `buffer-menu' for details."
(set (make-local-variable 'buffer-stale-function)
(lambda (&optional _noconfirm) 'fast))
- (setq truncate-lines t)
- (setq buffer-read-only t)
- ;; Force L2R direction, to avoid messing the display if the first
- ;; buffer in the list happens to begin with a strong R2L character.
- (setq bidi-paragraph-direction 'left-to-right))
+ (add-hook 'tabulated-list-revert-hook 'list-buffers--refresh nil t))
-(define-obsolete-variable-alias 'buffer-menu-mode-hook
- 'Buffer-menu-mode-hook "23.1")
+(defun buffer-menu (&optional arg)
+ "Switch to the Buffer Menu.
+By default, all buffers are listed except those whose names start
+with a space (which are for internal use). With prefix argument
+ARG, show only buffers that are visiting files.
-(defun Buffer-menu-revert-function (_ignore1 _ignore2)
- (or (eq buffer-undo-list t)
- (setq buffer-undo-list nil))
- ;; We can not use save-excursion here. The buffer gets erased.
- (let ((opoint (point))
- (eobp (eobp))
- (ocol (current-column))
- (oline (progn (move-to-column Buffer-menu-buffer-column)
- (get-text-property (point) 'buffer)))
- (prop (point-min))
- ;; do not make undo records for the reversion.
- (buffer-undo-list t))
- ;; We can be called by Auto Revert Mode with the "*Buffer Menu*"
- ;; temporarily the current buffer. Make sure that the
- ;; interactively current buffer is correctly identified with a `.'
- ;; by `list-buffers-noselect'.
- (with-current-buffer (window-buffer)
- (list-buffers-noselect Buffer-menu-files-only Buffer-menu--buffers))
- (if oline
- (while (setq prop (next-single-property-change prop 'buffer))
- (when (eq (get-text-property prop 'buffer) oline)
- (goto-char prop)
- (move-to-column ocol)))
- (goto-char (if eobp (point-max) opoint)))))
+The first column (denoted \"C\") shows \".\" for the buffer from
+which you came. It shows \">\" for buffers you mark to be
+displayed, and \"D\" for those you mark for deletion.
-(defun Buffer-menu-toggle-files-only (arg)
- "Toggle whether the current buffer-menu displays only file buffers.
-With a positive ARG display only file buffers. With zero or
-negative ARG, display other buffers as well."
- (interactive "P")
- (setq Buffer-menu-files-only
- (cond ((not arg) (not Buffer-menu-files-only))
- ((> (prefix-numeric-value arg) 0) t)))
- (revert-buffer))
+The \"R\" column has a \"%\" if the buffer is read-only.
+The \"M\" column has a \"*\" if it is modified, or \"S\" if you
+have marked it for saving.
-
-(defun Buffer-menu-buffer (error-if-non-existent-p)
- "Return buffer described by this line of buffer menu."
- (let* ((where (+ (line-beginning-position) Buffer-menu-buffer-column))
- (name (and (not (eobp)) (get-text-property where 'buffer-name)))
- (buf (and (not (eobp)) (get-text-property where 'buffer))))
- (if name
- (or (get-buffer name)
- (and buf (buffer-name buf) buf)
- (if error-if-non-existent-p
- (error "No buffer named `%s'" name)
- nil))
- (or (and buf (buffer-name buf) buf)
- (if error-if-non-existent-p
- (error "No buffer on this line")
- nil)))))
-
-(defun buffer-menu (&optional arg)
- "Make a menu of buffers so you can save, delete or select them.
-With argument, show only buffers that are visiting files.
-Type ? after invocation to get help on commands available.
-Type q to remove the buffer menu from the display.
-
-The first column shows `>' for a buffer you have
-marked to be displayed, `D' for one you have marked for
-deletion, and `.' for the current buffer.
-
-The C column has a `.' for the buffer from which you came.
-The R column has a `%' if the buffer is read-only.
-The M column has a `*' if it is modified,
-or `S' if you have marked it for saving.
-After this come the buffer name, its size in characters,
-its major mode, and the visited file name (if any)."
+After this come the buffer name, its size in characters, its
+major mode, and the visited file name (if any).
+
+
+In the Buffer Menu, the following commands are defined:
+\\<Buffer-menu-mode-map>
+\\[quit-window] Remove the Buffer Menu from the display.
+\\[Buffer-menu-this-window] Select current line's buffer in place of the buffer menu.
+\\[Buffer-menu-other-window] Select that buffer in another window,
+ so the Buffer Menu remains visible in its window.
+\\[Buffer-menu-view] Select current line's buffer, in View mode.
+\\[Buffer-menu-view-other-window] Select that buffer in
+ another window, in view-mode.
+\\[Buffer-menu-switch-other-window] Make another window display that buffer.
+\\[Buffer-menu-mark] Mark current line's buffer to be displayed.
+\\[Buffer-menu-select] Select current line's buffer.
+ Also show buffers marked with m, in other windows.
+\\[Buffer-menu-1-window] Select that buffer in full-frame window.
+\\[Buffer-menu-2-window] Select that buffer in one window, together with the
+ buffer selected before this one in another window.
+\\[Buffer-menu-isearch-buffers] Incremental search in the marked buffers.
+\\[Buffer-menu-isearch-buffers-regexp] Isearch for regexp in the marked buffers.
+\\[Buffer-menu-visit-tags-table] visit-tags-table this buffer.
+\\[Buffer-menu-not-modified] Clear modified-flag on that buffer.
+\\[Buffer-menu-save] Mark that buffer to be saved, and move down.
+\\[Buffer-menu-delete] Mark that buffer to be deleted, and move down.
+\\[Buffer-menu-delete-backwards] Mark that buffer to be deleted, and move up.
+\\[Buffer-menu-execute] Delete or save marked buffers.
+\\[Buffer-menu-unmark] Remove all marks from current line.
+ With prefix argument, also move up one line.
+\\[Buffer-menu-backup-unmark] Back up a line and remove marks.
+\\[Buffer-menu-toggle-read-only] Toggle read-only status of buffer on this line.
+\\[revert-buffer] Update the list of buffers.
+\\[Buffer-menu-toggle-files-only] Toggle whether the menu displays only file buffers.
+\\[Buffer-menu-bury] Bury the buffer listed on this line."
(interactive "P")
-;;; (setq Buffer-menu-window-config (current-window-configuration))
(switch-to-buffer (list-buffers-noselect arg))
(message
"Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
(defun buffer-menu-other-window (&optional arg)
- "Display a list of buffers in another window.
-With the buffer list buffer, you can save, delete or select the buffers.
-With argument, show only buffers that are visiting files.
-Type ? after invocation to get help on commands available.
-Type q to remove the buffer menu from the display.
-For more information, see the function `buffer-menu'."
+ "Display the Buffer Menu in another window.
+See `buffer-menu' for a description of the Buffer Menu.
+
+By default, all buffers are listed except those whose names start
+with a space (which are for internal use). With prefix argument
+ARG, show only buffers that are visiting files."
(interactive "P")
-;;; (setq Buffer-menu-window-config (current-window-configuration))
(switch-to-buffer-other-window (list-buffers-noselect arg))
(message
"Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
+;;;###autoload
+(defun list-buffers (&optional arg)
+ "Display a list of existing buffers.
+The list is displayed in a buffer named \"*Buffer List*\".
+See `buffer-menu' for details about the Buffer Menu buffer.
+
+By default, all buffers are listed except those whose names start
+with a space (which are for internal use). With prefix argument
+ARG, show only buffers that are visiting files."
+ (interactive "P")
+ (display-buffer (list-buffers-noselect arg)))
+
+(defun Buffer-menu-toggle-files-only (arg)
+ "Toggle whether the current buffer-menu displays only file buffers.
+With a positive ARG, display only file buffers. With zero or
+negative ARG, display other buffers as well."
+ (interactive "P")
+ (setq Buffer-menu-files-only
+ (cond ((not arg) (not Buffer-menu-files-only))
+ ((> (prefix-numeric-value arg) 0) t)))
+ (message (if Buffer-menu-files-only
+ "Showing only file-visiting buffers."
+ "Showing all non-internal buffers."))
+ (revert-buffer))
+
+(defalias 'Buffer-menu-sort 'tabulated-list-sort)
+
+
+(defun Buffer-menu-buffer (&optional error-if-non-existent-p)
+ "Return the buffer described by the current Buffer Menu line.
+If there is no buffer here, return nil if ERROR-IF-NON-EXISTENT-P
+is nil or omitted, and signal an error otherwise."
+ (let ((buffer (tabulated-list-get-id)))
+ (cond ((null buffer)
+ (if error-if-non-existent-p
+ (error "No buffer on this line")))
+ ((not (buffer-live-p buffer))
+ (if error-if-non-existent-p
+ (error "This buffer has been killed")))
+ (t buffer))))
+
(defun Buffer-menu-no-header ()
(beginning-of-line)
(if (or Buffer-menu-use-header-line
@@ -370,166 +326,140 @@ For more information, see the function `buffer-menu'."
(forward-line 1)
nil))
+(defun Buffer-menu-beginning ()
+ (goto-char (point-min))
+ (unless Buffer-menu-use-header-line
+ (forward-line)))
+
+
+;;; Commands for modifying Buffer Menu entries.
+
(defun Buffer-menu-mark ()
- "Mark buffer on this line for being displayed by \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command."
+ "Mark the Buffer menu entry at point for later display.
+It will be displayed by the \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command."
(interactive)
- (when (Buffer-menu-no-header)
- (let ((inhibit-read-only t))
- (delete-char 1)
- (insert ?>)
- (forward-line 1))))
+ (tabulated-list-set-col 0 ">" t)
+ (forward-line))
(defun Buffer-menu-unmark (&optional backup)
"Cancel all requested operations on buffer on this line and move down.
Optional prefix arg means move up."
(interactive "P")
- (when (Buffer-menu-no-header)
- (let* ((buf (Buffer-menu-buffer t))
- (mod (buffer-modified-p buf))
- (readonly (with-current-buffer buf buffer-read-only))
- (inhibit-read-only t))
- (delete-char 3)
- (insert (if readonly (if mod " %*" " % ") (if mod " *" " ")))))
+ (tabulated-list-set-col 0 " " t)
(forward-line (if backup -1 1)))
(defun Buffer-menu-backup-unmark ()
"Move up and cancel all requested operations on buffer on line above."
(interactive)
(forward-line -1)
- (Buffer-menu-unmark)
- (forward-line -1))
+ (tabulated-list-set-col 0 " " t))
(defun Buffer-menu-delete (&optional arg)
- "Mark buffer on this line to be deleted by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command.
-Prefix arg is how many buffers to delete.
-Negative arg means delete backwards."
+ "Mark the buffer on this Buffer Menu buffer line for deletion.
+A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]' command
+will delete it.
+
+If prefix argument ARG is non-nil, it specifies the number of
+buffers to delete; a negative ARG means to delete backwards."
(interactive "p")
- (when (Buffer-menu-no-header)
- (let ((inhibit-read-only t))
- (if (or (null arg) (= arg 0))
- (setq arg 1))
- (while (> arg 0)
- (delete-char 1)
- (insert ?D)
- (forward-line 1)
- (setq arg (1- arg)))
- (while (and (< arg 0)
- (Buffer-menu-no-header))
- (delete-char 1)
- (insert ?D)
- (forward-line -1)
- (setq arg (1+ arg))))))
+ (if (or (null arg) (= arg 0))
+ (setq arg 1))
+ (while (> arg 0)
+ (when (Buffer-menu-buffer)
+ (tabulated-list-set-col 0 "D" t))
+ (forward-line 1)
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (when (Buffer-menu-buffer)
+ (tabulated-list-set-col 0 "D" t))
+ (forward-line -1)
+ (setq arg (1+ arg))))
(defun Buffer-menu-delete-backwards (&optional arg)
- "Mark buffer on this line to be deleted by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command
-and then move up one line. Prefix arg means move that many lines."
+ "Mark the buffer on this Buffer Menu line for deletion, and move up.
+Prefix ARG means move that many lines."
(interactive "p")
(Buffer-menu-delete (- (or arg 1))))
(defun Buffer-menu-save ()
- "Mark buffer on this line to be saved by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command."
+ "Mark the buffer on this Buffer Menu line for saving.
+A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]' command
+will save it."
(interactive)
- (when (Buffer-menu-no-header)
- (let ((inhibit-read-only t))
- (forward-char 2)
- (delete-char 1)
- (insert ?S)
- (forward-line 1))))
+ (when (Buffer-menu-buffer)
+ (tabulated-list-set-col 2 "S" t)
+ (forward-line 1)))
(defun Buffer-menu-not-modified (&optional arg)
- "Mark buffer on this line as unmodified (no changes to save)."
+ "Mark the buffer on this line as unmodified (no changes to save).
+If ARG is non-nil (interactively, with a prefix argument), mark
+it as modified."
(interactive "P")
(with-current-buffer (Buffer-menu-buffer t)
(set-buffer-modified-p arg))
- (save-excursion
- (beginning-of-line)
- (forward-char 2)
- (if (= (char-after) (if arg ?\s ?*))
- (let ((inhibit-read-only t))
- (delete-char 1)
- (insert (if arg ?* ?\s))))))
-
-(defun Buffer-menu-beginning ()
- (goto-char (point-min))
- (unless Buffer-menu-use-header-line
- (forward-line)))
+ (tabulated-list-set-col 2 (if arg "*" " ") t))
(defun Buffer-menu-execute ()
- "Save and/or delete buffers marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-save] or \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
+ "Save and/or delete marked buffers in the Buffer Menu.
+Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-save]' are saved.
+Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-delete]' are deleted."
(interactive)
(save-excursion
(Buffer-menu-beginning)
- (while (re-search-forward "^..S" nil t)
- (let ((modp nil))
- (with-current-buffer (Buffer-menu-buffer t)
- (save-buffer)
- (setq modp (buffer-modified-p)))
- (let ((inhibit-read-only t))
- (delete-char -1)
- (insert (if modp ?* ?\s))))))
- (save-excursion
- (Buffer-menu-beginning)
- (let ((buff-menu-buffer (current-buffer))
- (inhibit-read-only t))
- (while (re-search-forward "^D" nil t)
- (forward-char -1)
- (let ((buf (Buffer-menu-buffer nil)))
- (or (eq buf nil)
- (eq buf buff-menu-buffer)
- (save-excursion (kill-buffer buf)))
- (if (and buf (buffer-name buf))
- (progn (delete-char 1)
- (insert ?\s))
- (delete-region (point) (progn (forward-line 1) (point)))
- (unless (bobp)
- (forward-char -1))))))))
+ (while (not (eobp))
+ (let ((buffer (tabulated-list-get-id))
+ (entry (tabulated-list-get-entry)))
+ (cond ((null entry)
+ (forward-line 1))
+ ((not (buffer-live-p buffer))
+ (tabulated-list-delete-entry))
+ (t
+ (let ((delete (eq (char-after) ?D)))
+ (when (equal (aref entry 2) "S")
+ (condition-case nil
+ (progn
+ (with-current-buffer buffer
+ (save-buffer))
+ (tabulated-list-set-col 2 " " t))
+ (error (warn "Error saving %s" buffer))))
+ (if delete
+ (unless (eq buffer (current-buffer))
+ (kill-buffer buffer)
+ (tabulated-list-delete-entry))
+ (forward-line 1)))))))))
(defun Buffer-menu-select ()
- "Select this line's buffer; also display buffers marked with `>'.
-You can mark buffers with the \\<Buffer-menu-mode-map>\\[Buffer-menu-mark] command.
+ "Select this line's buffer; also, display buffers marked with `>'.
+You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' command.
This command deletes and replaces all the previously existing windows
in the selected frame."
(interactive)
- (let ((buff (Buffer-menu-buffer t))
- (menu (current-buffer))
- (others ())
- tem)
- (Buffer-menu-beginning)
- (while (re-search-forward "^>" nil t)
- (setq tem (Buffer-menu-buffer t))
- (let ((inhibit-read-only t))
- (delete-char -1)
- (insert ?\s))
- (or (eq tem buff) (memq tem others) (setq others (cons tem others))))
- (setq others (nreverse others)
- tem (/ (1- (frame-height)) (1+ (length others))))
+ (let* ((this-buffer (Buffer-menu-buffer t))
+ (menu-buffer (current-buffer))
+ (others (delq this-buffer (Buffer-menu-marked-buffers t)))
+ (height (/ (1- (frame-height)) (1+ (length others)))))
(delete-other-windows)
- (switch-to-buffer buff)
- (or (eq menu buff)
- (bury-buffer menu))
- (if (equal (length others) 0)
- (progn
-;;; ;; Restore previous window configuration before displaying
-;;; ;; selected buffers.
-;;; (if Buffer-menu-window-config
-;;; (progn
-;;; (set-window-configuration Buffer-menu-window-config)
-;;; (setq Buffer-menu-window-config nil)))
- (switch-to-buffer buff))
- (while others
- (split-window nil tem)
- (other-window 1)
- (switch-to-buffer (car others))
- (setq others (cdr others)))
- (other-window 1) ;back to the beginning!
-)))
-
-(defun Buffer-menu-marked-buffers ()
- "Return a list of buffers marked with the \\<Buffer-menu-mode-map>\\[Buffer-menu-mark] command."
+ (switch-to-buffer this-buffer)
+ (unless (eq menu-buffer this-buffer)
+ (bury-buffer menu-buffer))
+ (dolist (buffer others)
+ (split-window nil height)
+ (other-window 1)
+ (switch-to-buffer buffer))
+ ;; Back to the beginning!
+ (other-window 1)))
+
+(defun Buffer-menu-marked-buffers (&optional unmark)
+ "Return the list of buffers marked with `Buffer-menu-mark'.
+If UNMARK is non-nil, unmark them."
(let (buffers)
(Buffer-menu-beginning)
(while (re-search-forward "^>" nil t)
- (setq buffers (cons (Buffer-menu-buffer t) buffers)))
+ (let ((buffer (Buffer-menu-buffer)))
+ (if (and buffer unmark)
+ (tabulated-list-set-col 0 " " t))
+ (if (buffer-live-p buffer)
+ (push buffer buffers))))
(nreverse buffers)))
(defun Buffer-menu-isearch-buffers ()
@@ -558,20 +488,6 @@ in the selected frame."
(bury-buffer (other-buffer))
(delete-other-windows))
-(defun Buffer-menu-mouse-select (event)
- "Select the buffer whose line you click on."
- (interactive "e")
- (let (buffer)
- (with-current-buffer (window-buffer (posn-window (event-end event)))
- (save-excursion
- (goto-char (posn-point (event-end event)))
- (setq buffer (Buffer-menu-buffer t))))
- (select-window (posn-window (event-end event)))
- (if (and (window-dedicated-p (selected-window))
- (eq (selected-window) (frame-root-window)))
- (switch-to-buffer-other-frame buffer)
- (switch-to-buffer buffer))))
-
(defun Buffer-menu-this-window ()
"Select this line's buffer in this window."
(interactive)
@@ -599,343 +515,146 @@ The current window remains selected."
(bury-buffer menu)))
(defun Buffer-menu-toggle-read-only ()
- "Toggle read-only status of buffer on this line, perhaps via version control."
+ "Toggle read-only status of buffer on this line.
+This behaves like invoking \\[toggle-read-only] in that buffer."
(interactive)
- (let (char)
- (with-current-buffer (Buffer-menu-buffer t)
- (toggle-read-only)
- (setq char (if buffer-read-only ?% ?\s)))
- (save-excursion
- (beginning-of-line)
- (forward-char 1)
- (if (/= (following-char) char)
- (let ((inhibit-read-only t))
- (delete-char 1)
- (insert char))))))
+ (let ((read-only
+ (with-current-buffer (Buffer-menu-buffer t)
+ (read-only-mode 'toggle)
+ buffer-read-only)))
+ (tabulated-list-set-col 1 (if read-only "%" " ") t)))
(defun Buffer-menu-bury ()
"Bury the buffer listed on this line."
(interactive)
- (when (Buffer-menu-no-header)
- (save-excursion
- (beginning-of-line)
- (bury-buffer (Buffer-menu-buffer t))
- (let ((line (buffer-substring (point) (progn (forward-line 1) (point))))
- (inhibit-read-only t))
- (delete-region (point) (progn (forward-line -1) (point)))
- (goto-char (point-max))
- (insert line))
- (message "Buried buffer moved to the end"))))
-
+ (let ((buffer (tabulated-list-get-id)))
+ (cond ((null buffer))
+ ((buffer-live-p buffer)
+ (bury-buffer buffer)
+ (save-excursion
+ (let ((elt (tabulated-list-delete-entry)))
+ (goto-char (point-max))
+ (apply 'tabulated-list-print-entry elt)))
+ (message "Buffer buried."))
+ (t
+ (tabulated-list-delete-entry)
+ (message "Buffer is dead; removing from list.")))))
(defun Buffer-menu-view ()
"View this line's buffer in View mode."
(interactive)
(view-buffer (Buffer-menu-buffer t)))
-
(defun Buffer-menu-view-other-window ()
"View this line's buffer in View mode in another window."
(interactive)
(view-buffer-other-window (Buffer-menu-buffer t)))
+;;; Functions for populating the Buffer Menu.
;;;###autoload
-(define-key ctl-x-map "\C-b" 'list-buffers)
-
-;;;###autoload
-(defun list-buffers (&optional files-only)
- "Display a list of names of existing buffers.
-The list is displayed in a buffer named `*Buffer List*'.
-Note that buffers with names starting with spaces are omitted.
-Non-null optional arg FILES-ONLY means mention only file buffers.
-
-For more information, see the function `buffer-menu'."
- (interactive "P")
- (display-buffer (list-buffers-noselect files-only)))
-
-(defconst Buffer-menu-short-ellipsis
- ;; This file is preloaded, so we can't use char-displayable-p here
- ;; because we don't know yet what display we're going to connect to.
- ":" ;; (if (char-displayable-p ?…) "…" ":")
- )
-
-(defun Buffer-menu-buffer+size (name size &optional name-props size-props)
- (if (> (+ (string-width name) (string-width size) 2)
- Buffer-menu-buffer+size-width)
- (setq name
- (let ((tail
- (if (string-match "<[0-9]+>$" name)
- (match-string 0 name)
- "")))
- (concat (truncate-string-to-width
- name
- (- Buffer-menu-buffer+size-width
- (max (string-width size) 3)
- (string-width tail)
- 2))
- Buffer-menu-short-ellipsis
- tail)))
- ;; Don't put properties on (buffer-name).
- (setq name (copy-sequence name)))
- (add-text-properties 0 (length name) name-props name)
- (add-text-properties 0 (length size) size-props size)
- (let ((name+space-width (- Buffer-menu-buffer+size-width
- (string-width size))))
- (concat name
- (propertize (make-string (- name+space-width (string-width name))
- ?\s)
- 'display `(space :align-to
- ,(+ Buffer-menu-buffer-column
- name+space-width)))
- size)))
-
-(defun Buffer-menu-sort (column)
- "Sort the buffer menu by COLUMN."
- (interactive "P")
- (when column
- (setq column (prefix-numeric-value column))
- (if (< column 2) (setq column 2))
- (if (> column 5) (setq column 5)))
- (setq Buffer-menu-sort-column column)
- (let ((inhibit-read-only t) l buf m1 m2)
- (save-excursion
- (Buffer-menu-beginning)
- (while (not (eobp))
- (when (buffer-live-p
- (setq buf (get-text-property
- (+ (point)
- Buffer-menu-buffer-column)
- 'buffer)))
- (setq m1 (char-after)
- m1 (if (memq m1 '(?> ?D)) m1)
- m2 (char-after (+ (point) 2))
- m2 (if (eq m2 ?S) m2))
- (if (or m1 m2)
- (push (list buf m1 m2) l)))
- (forward-line)))
- (revert-buffer)
- (save-excursion
- (Buffer-menu-beginning)
- (while (not (eobp))
- (when (setq buf (assq (get-text-property (+ (point)
- Buffer-menu-buffer-column)
- 'buffer) l))
- (setq m1 (cadr buf)
- m2 (cadr (cdr buf)))
- (when m1
- (delete-char 1)
- (insert m1)
- (backward-char 1))
- (when m2
- (forward-char 2)
- (delete-char 1)
- (insert m2)))
- (forward-line)))))
-
-(defun Buffer-menu-sort-by-column (&optional e)
- "Sort the buffer menu by the column clicked on."
- (interactive (list last-input-event))
- (if e (mouse-select-window e))
- (let* ((pos (event-start e))
- (obj (posn-object pos))
- (col (if obj
- (get-text-property (cdr obj) 'column (car obj))
- (get-text-property (posn-point pos) 'column))))
- (Buffer-menu-sort col)))
-
-(defvar Buffer-menu-sort-button-map
- (let ((map (make-sparse-keymap)))
- ;; This keymap handles both nil and non-nil values for
- ;; Buffer-menu-use-header-line.
- (define-key map [header-line mouse-1] 'Buffer-menu-sort-by-column)
- (define-key map [header-line mouse-2] 'Buffer-menu-sort-by-column)
- (define-key map [mouse-2] 'Buffer-menu-sort-by-column)
- (define-key map [follow-link] 'mouse-face)
- (define-key map "\C-m" 'Buffer-menu-sort-by-column)
- map)
- "Local keymap for Buffer menu sort buttons.")
-
-(defun Buffer-menu-make-sort-button (name column)
- (if (equal column Buffer-menu-sort-column) (setq column nil))
- (propertize name
- 'column column
- 'help-echo (concat
- (if Buffer-menu-use-header-line
- "mouse-1, mouse-2: sort by "
- "mouse-2, RET: sort by ")
- (if column (downcase name) "visited order"))
- 'mouse-face 'highlight
- 'keymap Buffer-menu-sort-button-map))
-
(defun list-buffers-noselect (&optional files-only buffer-list)
- "Create and return a buffer with a list of names of existing buffers.
-The buffer is named `*Buffer List*'.
-Note that buffers with names starting with spaces are omitted.
-Non-null optional arg FILES-ONLY means mention only file buffers.
-
-If BUFFER-LIST is non-nil, it should be a list of buffers;
-it means list those buffers and no others.
-
-For more information, see the function `buffer-menu'."
- (let* ((old-buffer (current-buffer))
- (standard-output standard-output)
- (mode-end (make-string (- Buffer-menu-mode-width 2) ?\s))
- (header (concat "CRM "
- (Buffer-menu-buffer+size
- (Buffer-menu-make-sort-button "Buffer" 2)
- (Buffer-menu-make-sort-button "Size" 3))
- " "
- (Buffer-menu-make-sort-button "Mode" 4) mode-end
- (Buffer-menu-make-sort-button "File" 5) "\n"))
- list desired-point)
- (when Buffer-menu-use-header-line
- (let ((pos 0))
- ;; Turn whitespace chars in the header into stretch specs so
- ;; they work regardless of the header-line face.
- (while (string-match "[ \t\n]+" header pos)
- (setq pos (match-end 0))
- (put-text-property (match-beginning 0) pos 'display
- ;; Assume fixed-size chars in the buffer.
- (list 'space :align-to pos)
- header)))
- ;; Try to better align the one-char headers.
- (put-text-property 0 3 'face 'fixed-pitch header)
- ;; Add a "dummy" leading space to align the beginning of the header
- ;; line with the beginning of the text (rather than with the left
- ;; scrollbar or the left fringe). --Stef
- (setq header (concat (propertize " " 'display '(space :align-to 0))
- header)))
- (with-current-buffer (get-buffer-create "*Buffer List*")
- (setq buffer-read-only nil)
- (erase-buffer)
- (setq standard-output (current-buffer))
- ;; Force L2R direction, to avoid messing the display if the
- ;; first buffer in the list happens to begin with a strong R2L
- ;; character.
- (setq bidi-paragraph-direction 'left-to-right)
- (unless Buffer-menu-use-header-line
- ;; Use U+2014 (EM DASH) to underline if possible, else use ASCII
- ;; (i.e. U+002D, HYPHEN-MINUS).
- (let ((underline (if (char-displayable-p ?\u2014) ?\u2014 ?-)))
- (insert header
- (apply 'string
- (mapcar (lambda (c)
- (if (memq c '(?\n ?\s)) c underline))
- header)))))
- ;; Collect info for every buffer we're interested in.
- (dolist (buffer (or buffer-list
- (buffer-list
- (when Buffer-menu-use-frame-buffer-list
- (selected-frame)))))
- (with-current-buffer buffer
- (let ((name (buffer-name))
- (file buffer-file-name))
- (unless (and (not buffer-list)
- (or
- ;; Don't mention internal buffers.
- (and (string= (substring name 0 1) " ") (null file))
- ;; Maybe don't mention buffers without files.
- (and files-only (not file))
- (string= name "*Buffer List*")))
- ;; Otherwise output info.
- (let ((mode (concat (format-mode-line mode-name nil nil buffer)
- (if mode-line-process
- (format-mode-line mode-line-process
- nil nil buffer))))
- (bits (string
- (if (eq buffer old-buffer) ?. ?\s)
- ;; Handle readonly status. The output buffer
- ;; is special cased to appear readonly; it is
- ;; actually made so at a later date.
- (if (or (eq buffer standard-output)
- buffer-read-only)
- ?% ?\s)
- ;; Identify modified buffers.
- (if (buffer-modified-p) ?* ?\s)
- ;; Space separator.
- ?\s)))
- (unless file
- ;; No visited file. Check local value of
- ;; list-buffers-directory and, for Info buffers,
- ;; Info-current-file.
- (cond ((and (boundp 'list-buffers-directory)
- list-buffers-directory)
- (setq file list-buffers-directory))
- ((eq major-mode 'Info-mode)
- (setq file Info-current-file)
- (cond
- ((equal file "dir")
- (setq file "*Info Directory*"))
- ((eq file 'apropos)
- (setq file "*Info Apropos*"))
- ((eq file 'history)
- (setq file "*Info History*"))
- ((eq file 'toc)
- (setq file "*Info TOC*"))
- ((not (stringp file)) ;; avoid errors
- (setq file nil))
- (t
- (setq file (concat "("
- (file-name-nondirectory file)
- ") "
- Info-current-node)))))))
- (push (list buffer bits name (buffer-size) mode file)
- list))))))
- ;; Preserve the original buffer-list ordering, just in case.
- (setq list (nreverse list))
- ;; Place the buffers's info in the output buffer, sorted if necessary.
- (dolist (buffer
- (if Buffer-menu-sort-column
- (sort list
- (if (eq Buffer-menu-sort-column 3)
- (lambda (a b)
- (< (nth Buffer-menu-sort-column a)
- (nth Buffer-menu-sort-column b)))
- (lambda (a b)
- (string< (nth Buffer-menu-sort-column a)
- (nth Buffer-menu-sort-column b)))))
- list))
- (if (eq (car buffer) old-buffer)
- (setq desired-point (point)))
- (insert (cadr buffer)
- ;; Put the buffer name into a text property
- ;; so we don't have to extract it from the text.
- ;; This way we avoid problems with unusual buffer names.
- (let ((name (nth 2 buffer))
- (size (int-to-string (nth 3 buffer))))
- (Buffer-menu-buffer+size name size
- `(buffer-name ,name
- buffer ,(car buffer)
- font-lock-face buffer-menu-buffer
- mouse-face highlight
- help-echo
- ,(if (>= (length name)
- (- Buffer-menu-buffer+size-width
- (max (length size) 3)
- 2))
- name
- "mouse-2: select this buffer"))))
- " "
- (if (> (string-width (nth 4 buffer)) Buffer-menu-mode-width)
- (truncate-string-to-width (nth 4 buffer)
- Buffer-menu-mode-width)
- (nth 4 buffer)))
- (when (nth 5 buffer)
- (indent-to (+ Buffer-menu-buffer-column Buffer-menu-buffer+size-width
- Buffer-menu-mode-width 4) 1)
- (princ (abbreviate-file-name (nth 5 buffer))))
- (princ "\n"))
+ "Create and return a Buffer Menu buffer.
+This is called by `buffer-menu' and others as a subroutine.
+
+If FILES-ONLY is non-nil, show only file-visiting buffers.
+If BUFFER-LIST is non-nil, it should be a list of buffers; it
+means list those buffers and no others."
+ (let ((old-buffer (current-buffer))
+ (buffer (get-buffer-create "*Buffer List*")))
+ (with-current-buffer buffer
(Buffer-menu-mode)
- (when Buffer-menu-use-header-line
- (setq header-line-format header))
- ;; DESIRED-POINT doesn't have to be set; it is not when the
- ;; current buffer is not displayed for some reason.
- (and desired-point
- (goto-char desired-point))
- (setq Buffer-menu-files-only files-only)
- (setq Buffer-menu--buffers buffer-list)
- (set-buffer-modified-p nil)
- (current-buffer))))
+ (setq Buffer-menu-files-only
+ (and files-only (>= (prefix-numeric-value files-only) 0)))
+ (list-buffers--refresh buffer-list old-buffer)
+ (tabulated-list-print))
+ buffer))
+
+(defun Buffer-menu-mouse-select (event)
+ "Select the buffer whose line you click on."
+ (interactive "e")
+ (select-window (posn-window (event-end event)))
+ (let ((buffer (tabulated-list-get-id (posn-point (event-end event)))))
+ (when (buffer-live-p buffer)
+ (if (and (window-dedicated-p (selected-window))
+ (eq (selected-window) (frame-root-window)))
+ (switch-to-buffer-other-frame buffer)
+ (switch-to-buffer buffer)))))
+
+(defun list-buffers--refresh (&optional buffer-list old-buffer)
+ ;; Set up `tabulated-list-format'.
+ (let ((name-width Buffer-menu-name-width)
+ (size-width Buffer-menu-size-width))
+ ;; Handle obsolete variable:
+ (if Buffer-menu-buffer+size-width
+ (setq name-width (- Buffer-menu-buffer+size-width size-width)))
+ (setq tabulated-list-format
+ (vector '("C" 1 t :pad-right 0)
+ '("R" 1 t :pad-right 0)
+ '("M" 1 t)
+ `("Buffer" ,name-width t)
+ `("Size" ,size-width tabulated-list-entry-size->
+ :right-align t)
+ `("Mode" ,Buffer-menu-mode-width t)
+ '("File" 1 t))))
+ (setq tabulated-list-use-header-line Buffer-menu-use-header-line)
+ ;; Collect info for each buffer we're interested in.
+ (let ((buffer-menu-buffer (current-buffer))
+ (show-non-file (not Buffer-menu-files-only))
+ entries)
+ (dolist (buffer (or buffer-list
+ (buffer-list (if Buffer-menu-use-frame-buffer-list
+ (selected-frame)))))
+ (with-current-buffer buffer
+ (let* ((name (buffer-name))
+ (file buffer-file-name))
+ (when (and (buffer-live-p buffer)
+ (or buffer-list
+ (and (not (string= (substring name 0 1) " "))
+ (not (eq buffer buffer-menu-buffer))
+ (or file show-non-file))))
+ (push (list buffer
+ (vector (if (eq buffer old-buffer) "." " ")
+ (if buffer-read-only "%" " ")
+ (if (buffer-modified-p) "*" " ")
+ (Buffer-menu--pretty-name name)
+ (number-to-string (buffer-size))
+ (concat (format-mode-line mode-name nil nil buffer)
+ (if mode-line-process
+ (format-mode-line mode-line-process
+ nil nil buffer)))
+ (Buffer-menu--pretty-file-name file)))
+ entries)))))
+ (setq tabulated-list-entries (nreverse entries)))
+ (tabulated-list-init-header))
+
+(defun tabulated-list-entry-size-> (entry1 entry2)
+ (> (string-to-number (aref (cadr entry1) 4))
+ (string-to-number (aref (cadr entry2) 4))))
+
+(defun Buffer-menu--pretty-name (name)
+ (propertize name
+ 'font-lock-face 'buffer-menu-buffer
+ 'mouse-face 'highlight))
+
+(defun Buffer-menu--pretty-file-name (file)
+ (cond (file
+ (abbreviate-file-name file))
+ ((and (boundp 'list-buffers-directory)
+ list-buffers-directory)
+ list-buffers-directory)
+ ((eq major-mode 'Info-mode)
+ (Buffer-menu-info-node-description Info-current-file))
+ (t "")))
+
+(defun Buffer-menu-info-node-description (file)
+ (cond
+ ((equal file "dir") "*Info Directory*")
+ ((eq file 'apropos) "*Info Apropos*")
+ ((eq file 'history) "*Info History*")
+ ((eq file 'toc) "*Info TOC*")
+ ((not (stringp file)) "") ; Avoid errors
+ (t
+ (concat "(" (file-name-nondirectory file) ") " Info-current-node))))
;;; buff-menu.el ends here
diff --git a/lisp/button.el b/lisp/button.el
index 262a19c1806..3cf38fa64c6 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -1,6 +1,6 @@
;;; button.el --- clickable buttons
;;
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: extensions
@@ -349,7 +349,9 @@ Also see `make-text-button'."
;; Finding buttons in a buffer
(defun button-at (pos)
- "Return the button at position POS in the current buffer, or nil."
+ "Return the button at position POS in the current buffer, or nil.
+If the button at POS is a text property button, the return value
+is a marker pointing to POS."
(let ((button (get-char-property pos 'button)))
(if (or (overlayp button) (null button))
button
diff --git a/lisp/calc/README b/lisp/calc/README
index 308b5115aa2..638b482a60a 100644
--- a/lisp/calc/README
+++ b/lisp/calc/README
@@ -1,11 +1,11 @@
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
This directory contains Calc, an advanced desk calculator for GNU
Emacs.
-"Calc" Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+"Calc" Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
Written by:
Dave Gillespie
@@ -70,6 +70,19 @@ opinions.
Summary of changes to "Calc"
------- -- ------- -- ----
+Emacs 24.4
+
+* The date forms use the Gregorian calendar for all dates.
+ (Previously they were a combination of Julian and Gregorian
+ dates.) This can be configured with the customizable variable
+ `calc-gregorian-switch'.
+
+Emacs 24.3
+
+* Algebraic simplification mode is now the default.
+ To restrict to the limited simplifications given by the former
+ default simplification mode, use `m I'.
+
Emacs 24.1
* Support for musical notes added.
diff --git a/lisp/calc/README.prev b/lisp/calc/README.prev
index 69da211efc2..bc1189a7065 100644
--- a/lisp/calc/README.prev
+++ b/lisp/calc/README.prev
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 00e07aba6a5..4cca7fb7e7f 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -1,6 +1,6 @@
;;; calc-aent.el --- algebraic entry functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -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-alg.el b/lisp/calc/calc-alg.el
index 5ad1e58b45c..3182e85a8c6 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -1,6 +1,6 @@
;;; calc-alg.el --- algebraic functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -356,6 +356,8 @@
;; math-simplify-step, which is called by math-simplify.
(defvar math-top-only)
+;; math-normalize-error is declared in calc.el.
+(defvar math-normalize-error)
(defun math-simplify (top-expr)
(let ((math-simplifying t)
(math-top-only (consp calc-simplify-mode))
@@ -383,10 +385,12 @@
(calc-with-default-simplification
(while (let ((r simp-rules))
(setq res (math-normalize top-expr))
- (while r
- (setq res (math-rewrite res (car r))
- r (cdr r)))
- (not (equal top-expr (setq res (math-simplify-step res)))))
+ (if (not math-normalize-error)
+ (progn
+ (while r
+ (setq res (math-rewrite res (car r))
+ r (cdr r)))
+ (not (equal top-expr (setq res (math-simplify-step res)))))))
(setq top-expr res)))))
top-expr)
@@ -530,7 +534,10 @@
(not (Math-realp (nth 1 math-simplify-expr))))
(math-common-constant-factor (nth 1 math-simplify-expr))))
(if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n))
- (progn
+ (unless (and (eq (car-safe math-simplify-expr) 'calcFunc-eq)
+ (eq (car-safe (nth 1 math-simplify-expr)) 'var)
+ (not (math-expr-contains (nth 2 math-simplify-expr)
+ (nth 1 math-simplify-expr))))
(setcar (cdr math-simplify-expr)
(math-mul (nth 2 nn) (nth 1 math-simplify-expr)))
(setcar (cdr (cdr math-simplify-expr))
diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el
index a557e5fb92d..ad807e9a2de 100644
--- a/lisp/calc/calc-arith.el
+++ b/lisp/calc/calc-arith.el
@@ -1,6 +1,6 @@
;;; calc-arith.el --- arithmetic functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index 44354f0822f..7e1c69ffcfa 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -1,6 +1,6 @@
;;; calc-bin.el --- binary functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index da5bae69803..431ea18f580 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -1,6 +1,6 @@
;;; calc-comb.el --- combinatoric functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -77,7 +77,7 @@
4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973
4987 4993 4999 5003])
-;; The variable math-prime-factors-finished is set by calcFunc-prfac to
+;; The variable math-prime-factors-finished is set by calcFunc-prfac to
;; indicate whether factoring is complete, and used by calcFunc-factors,
;; calcFunc-totient and calcFunc-moebius.
(defvar math-prime-factors-finished)
@@ -510,8 +510,8 @@
(while (<= (length math-stirling-local-cache) n)
(let ((i (1- (length math-stirling-local-cache)))
row)
- (setq math-stirling-local-cache
- (vconcat math-stirling-local-cache
+ (setq math-stirling-local-cache
+ (vconcat math-stirling-local-cache
(make-vector (length math-stirling-local-cache) nil)))
(aset math-stirling-cache k math-stirling-local-cache)
(while (< (setq i (1+ i)) (length math-stirling-local-cache))
@@ -572,7 +572,6 @@
(let ((i 200))
(while (> (setq i (1- i)) 0)
(math-random-base))))
- (random t)
(setq var-RandSeed nil
math-random-cache nil
math-random-shift -4) ; assume RAND_MAX >= 16383
@@ -629,7 +628,7 @@
(i (/ (+ n slop) 3))
(rnum 0))
(while (> i 0)
- (setq rnum
+ (setq rnum
(math-add
(math-random-three-digit-number)
(math-mul rnum 1000)))
@@ -823,11 +822,11 @@
(setq sum (%
(+
sum
- (calcFunc-mod
+ (calcFunc-mod
q 1000000))
111111))
- (setq q
- (math-quotient
+ (setq q
+ (math-quotient
q 1000000)))
(cond ((= (% sum 3) 0) '(nil 3))
((= (% sum 7) 0) '(nil 7))
diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el
index f2e0c493144..e05204764bc 100644
--- a/lisp/calc/calc-cplx.el
+++ b/lisp/calc/calc-cplx.el
@@ -1,6 +1,6 @@
;;; calc-cplx.el --- Complex number functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el
index f1f79252857..954e5d0b72f 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -1,6 +1,6 @@
;;; calc-embed.el --- embed Calc in a buffer
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 5429509af86..c7d93530fd7 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -1,6 +1,6 @@
;;; calc-ext.el --- various extension functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -61,7 +61,7 @@
(declare-function math-vector-is-string "calccomp" (a))
(declare-function math-vector-to-string "calccomp" (a &optional quoted))
(declare-function math-format-radix-float "calc-bin" (a prec))
-(declare-function math-compose-expr "calccomp" (a prec))
+(declare-function math-compose-expr "calccomp" (a prec &optional div))
(declare-function math-abs "calc-arith" (a))
(declare-function math-format-bignum-binary "calc-bin" (a))
(declare-function math-format-bignum-octal "calc-bin" (a))
@@ -460,6 +460,7 @@
(define-key calc-mode-map "mD" 'calc-default-simplify-mode)
(define-key calc-mode-map "mE" 'calc-ext-simplify-mode)
(define-key calc-mode-map "mF" 'calc-settings-file-name)
+ (define-key calc-mode-map "mI" 'calc-basic-simplify-mode)
(define-key calc-mode-map "mM" 'calc-more-recursion-depth)
(define-key calc-mode-map "mN" 'calc-num-simplify-mode)
(define-key calc-mode-map "mO" 'calc-no-simplify-mode)
@@ -1095,11 +1096,11 @@ calc-tan calc-tanh calc-to-degrees calc-to-radians)
("calc-mode" calc-alg-simplify-mode calc-algebraic-mode
calc-always-load-extensions calc-auto-recompute calc-auto-why
-calc-bin-simplify-mode calc-break-vectors calc-center-justify
-calc-default-simplify-mode calc-display-raw calc-eng-notation
-calc-ext-simplify-mode calc-fix-notation calc-full-trail-vectors
-calc-full-vectors calc-get-modes calc-group-char calc-group-digits
-calc-infinite-mode calc-left-justify calc-left-label
+calc-basic-simplify-mode calc-bin-simplify-mode calc-break-vectors
+calc-center-justify calc-default-simplify-mode calc-display-raw
+calc-eng-notation calc-ext-simplify-mode calc-fix-notation
+calc-full-trail-vectors calc-full-vectors calc-get-modes calc-group-char
+calc-group-digits calc-infinite-mode calc-left-justify calc-left-label
calc-line-breaking calc-line-numbering calc-matrix-brackets
calc-matrix-center-justify calc-matrix-left-justify calc-matrix-mode
calc-matrix-right-justify calc-mode-record-mode calc-no-simplify-mode
@@ -1996,51 +1997,36 @@ calc-kill calc-kill-region calc-yank))))
(cache-val (intern (concat (symbol-name name) "-cache")))
(last-prec (intern (concat (symbol-name name) "-last-prec")))
(last-val (intern (concat (symbol-name name) "-last"))))
- (list 'progn
-; (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100))
- (list 'defvar cache-prec
- `(cond
- ((consp ,init) (math-numdigs (nth 1 ,init)))
- (,init
- (nth 1 (math-numdigs (eval ,init))))
- (t
- -100)))
- (list 'defvar cache-val
- `(cond
- ((consp ,init) ,init)
- (,init (eval ,init))
- (t ,init)))
- (list 'defvar last-prec -100)
- (list 'defvar last-val nil)
- (list 'setq 'math-cache-list
- (list 'cons
- (list 'quote cache-prec)
- (list 'cons
- (list 'quote last-prec)
- 'math-cache-list)))
- (list 'defun
- name ()
- (list 'or
- (list '= last-prec 'calc-internal-prec)
- (list 'setq
- last-val
- (list 'math-normalize
- (list 'progn
- (list 'or
- (list '>= cache-prec
- 'calc-internal-prec)
- (list 'setq
- cache-val
- (list 'let
- '((calc-internal-prec
- (+ calc-internal-prec
- 4)))
- form)
- cache-prec
- '(+ calc-internal-prec 2)))
- cache-val))
- last-prec 'calc-internal-prec))
- last-val))))
+ `(progn
+; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100))
+ (defvar ,cache-prec (cond
+ ((consp ,init) (math-numdigs (nth 1 ,init)))
+ (,init
+ (nth 1 (math-numdigs (eval ,init))))
+ (t
+ -100)))
+ (defvar ,cache-val (cond ((consp ,init) ,init)
+ (,init (eval ,init))
+ (t ,init)))
+ (defvar ,last-prec -100)
+ (defvar ,last-val nil)
+ (setq math-cache-list
+ (cons ',cache-prec
+ (cons ',last-prec
+ math-cache-list)))
+ (defun ,name ()
+ (or (= ,last-prec calc-internal-prec)
+ (setq ,last-val
+ (math-normalize
+ (progn (or (>= ,cache-prec calc-internal-prec)
+ (setq ,cache-val
+ (let ((calc-internal-prec
+ (+ calc-internal-prec 4)))
+ ,form)
+ ,cache-prec (+ calc-internal-prec 2)))
+ ,cache-val))
+ ,last-prec calc-internal-prec))
+ ,last-val))))
(put 'math-defcache 'lisp-indent-hook 2)
;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public]
@@ -3497,7 +3483,7 @@ If X is not an error form, return 1."
(substring str i))))
str))
-;;; Users can redefine this in their .emacs files.
+;;; Users can redefine this in their init files.
(defvar calc-keypad-user-menu nil
"If non-nil, this describes an additional menu for calc-keypad.
It should contain a list of three rows.
diff --git a/lisp/calc/calc-fin.el b/lisp/calc/calc-fin.el
index 2e1d072dfb8..36165eaab63 100644
--- a/lisp/calc/calc-fin.el
+++ b/lisp/calc/calc-fin.el
@@ -1,6 +1,6 @@
;;; calc-fin.el --- financial functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index 912bbc7f78d..98b22550f75 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -1,6 +1,6 @@
;;; calc-forms.el --- data format conversion functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -369,17 +369,68 @@
;;; Some of these functions are adapted from Edward Reingold's "calendar.el".
;;; These versions are rewritten to use arbitrary-size integers.
-;;; The Julian calendar is used up to 9/2/1752, after which the Gregorian
-;;; calendar is used; the first day after 9/2/1752 is 9/14/1752.
;;; A numerical date is the number of days since midnight on
-;;; the morning of January 1, 1 A.D. If the date is a non-integer,
-;;; it represents a specific date and time.
+;;; the morning of December 31, 1 B.C. (Gregorian) or January 2, 1 A.D. (Julian).
+;;; Emacs's calendar refers to such a date as an absolute date, some Calc function
+;;; names also use that terminology. If the date is a non-integer, it represents
+;;; a specific date and time.
;;; A "dt" is a list of the form, (year month day), corresponding to
;;; an integer code, or (year month day hour minute second), corresponding
;;; to a non-integer code.
+(defun math-date-to-gregorian-dt (date)
+ "Return the day (YEAR MONTH DAY) in the Gregorian calendar.
+DATE is the number of days since December 31, -1 in the Gregorian calendar."
+ (let* ((month 1)
+ day
+ (year (math-quotient (math-add date (if (Math-lessp date 711859)
+ 365 ; for speed, we take
+ -108)) ; >1950 as a special case
+ (if (math-negp date) 366 365)))
+ ; this result may be an overestimate
+ temp)
+ (while (Math-lessp date (setq temp (math-absolute-from-gregorian-dt year 1 1)))
+ (setq year (math-add year -1)))
+ (if (eq year 0) (setq year -1))
+ (setq date (1+ (math-sub date temp)))
+ (setq temp
+ (if (math-leap-year-p year)
+ [1 32 61 92 122 153 183 214 245 275 306 336 999]
+ [1 32 60 91 121 152 182 213 244 274 305 335 999]))
+ (while (>= date (aref temp month))
+ (setq month (1+ month)))
+ (setq day (1+ (- date (aref temp (1- month)))))
+ (list year month day)))
+
+(defun math-date-to-julian-dt (date)
+ "Return the day (YEAR MONTH DAY) in the Julian calendar.
+DATE is the number of days since December 31, -1 in the Gregorian calendar."
+ (let* ((month 1)
+ day
+ (year (math-quotient (math-add date (if (Math-lessp date 711859)
+ 367 ; for speed, we take
+ -106)) ; >1950 as a special case
+ (if (math-negp date) 366 365)))
+ ; this result may be an overestimate
+ temp)
+ (while (Math-lessp date (setq temp (math-absolute-from-julian-dt year 1 1)))
+ (setq year (math-add year -1)))
+ (if (eq year 0) (setq year -1))
+ (setq date (1+ (math-sub date temp)))
+ (setq temp
+ (if (math-leap-year-p year t)
+ [1 32 61 92 122 153 183 214 245 275 306 336 999]
+ [1 32 60 91 121 152 182 213 244 274 305 335 999]))
+ (while (>= date (aref temp month))
+ (setq month (1+ month)))
+ (setq day (1+ (- date (aref temp (1- month)))))
+ (list year month day)))
+
(defun math-date-to-dt (value)
+ "Return the day and time of VALUE.
+The integer part of VALUE is the number of days since Dec 31, -1
+in the Gregorian calendar and the remaining part determines the time."
(if (eq (car-safe value) 'date)
(setq value (nth 1 value)))
(or (math-realp value)
@@ -387,32 +438,21 @@
(let* ((parts (math-date-parts value))
(date (car parts))
(time (nth 1 parts))
- (month 1)
- day
- (year (math-quotient (math-add date (if (Math-lessp date 711859)
- 365 ; for speed, we take
- -108)) ; >1950 as a special case
- (if (math-negp value) 366 365)))
- ; this result may be an overestimate
- temp)
- (while (Math-lessp date (setq temp (math-absolute-from-date year 1 1)))
- (setq year (math-add year -1)))
- (if (eq year 0) (setq year -1))
- (setq date (1+ (math-sub date temp)))
- (and (eq year 1752) (>= date 247)
- (setq date (+ date 11)))
- (setq temp (if (math-leap-year-p year)
- [1 32 61 92 122 153 183 214 245 275 306 336 999]
- [1 32 60 91 121 152 182 213 244 274 305 335 999]))
- (while (>= date (aref temp month))
- (setq month (1+ month)))
- (setq day (1+ (- date (aref temp (1- month)))))
+ (dt (if (and calc-gregorian-switch
+ (Math-lessp value
+ (or
+ (nth 3 calc-gregorian-switch)
+ (apply 'math-absolute-from-gregorian-dt calc-gregorian-switch))
+))
+ (math-date-to-julian-dt date)
+ (math-date-to-gregorian-dt date))))
(if (math-integerp value)
- (list year month day)
- (list year month day
- (/ time 3600)
- (% (/ time 60) 60)
- (math-add (% time 60) (nth 2 parts))))))
+ dt
+ (append dt
+ (list
+ (/ time 3600)
+ (% (/ time 60) 60)
+ (math-add (% time 60) (nth 2 parts)))))))
(defun math-dt-to-date (dt)
(or (integerp (nth 1 dt))
@@ -423,7 +463,7 @@
(math-reject-arg (nth 2 dt) 'fixnump))
(if (or (< (nth 2 dt) 1) (> (nth 2 dt) 31))
(math-reject-arg (nth 2 dt) "Day value is out of range"))
- (let ((date (math-absolute-from-date (car dt) (nth 1 dt) (nth 2 dt))))
+ (let ((date (math-absolute-from-dt (car dt) (nth 1 dt) (nth 2 dt))))
(if (nth 3 dt)
(math-add (math-float date)
(math-div (math-add (+ (* (nth 3 dt) 3600)
@@ -444,13 +484,19 @@
(defun math-this-year ()
- (string-to-number (substring (current-time-string) -4)))
-
-(defun math-leap-year-p (year)
- (if (Math-lessp year 1752)
+ (nth 5 (decode-time)))
+
+(defun math-leap-year-p (year &optional julian)
+ "Non-nil if YEAR is a leap year.
+If JULIAN is non-nil, then use the criterion for leap years
+in the Julian calendar, otherwise use the criterion in the
+Gregorian calendar."
+ (if julian
(if (math-negp year)
(= (math-imod (math-neg year) 4) 1)
(= (math-imod year 4) 0))
+ (if (math-negp year)
+ (setq year (math-sub -1 year)))
(setq year (math-imod year 400))
(or (and (= (% year 4) 0) (/= (% year 100) 0))
(= year 0))))
@@ -460,41 +506,106 @@
29
(aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
-(defun math-day-number (year month day)
+(defun math-day-in-year (year month day &optional julian)
+ "Return the number of days of the year up to YEAR MONTH DAY.
+The count includes the given date.
+If JULIAN is non-nil, use the Julian calendar, otherwise
+use the Gregorian calendar."
(let ((day-of-year (+ day (* 31 (1- month)))))
(if (> month 2)
(progn
(setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
- (if (math-leap-year-p year)
+ (if (math-leap-year-p year julian)
(setq day-of-year (1+ day-of-year)))))
- (and (eq year 1752)
- (or (> month 9)
- (and (= month 9) (>= day 14)))
- (setq day-of-year (- day-of-year 11)))
day-of-year))
-(defun math-absolute-from-date (year month day)
+(defun math-day-number (year month day)
+ "Return the number of days of the year up to YEAR MONTH DAY.
+The count includes the given date."
+ (if calc-gregorian-switch
+ (cond ((eq year (nth 0 calc-gregorian-switch))
+ (1+
+ (- (math-absolute-from-dt year month day)
+ (math-absolute-from-dt year 1 1))))
+ ((Math-lessp year (nth 0 calc-gregorian-switch))
+ (math-day-in-year year month day t))
+ (t
+ (math-day-in-year year month day)))
+ (math-day-in-year year month day)))
+
+(defun math-dt-before-p (dt1 dt2)
+ "Non-nil if DT1 occurs before DT2.
+A DT is a list of the form (YEAR MONTH DAY)."
+ (or (Math-lessp (nth 0 dt1) (nth 0 dt2))
+ (and (equal (nth 0 dt1) (nth 0 dt2))
+ (or (< (nth 1 dt1) (nth 1 dt2))
+ (and (= (nth 1 dt1) (nth 1 dt2))
+ (< (nth 2 dt1) (nth 2 dt2)))))))
+
+(defun math-absolute-from-gregorian-dt (year month day)
+ "Return the DATE of the day given by the Gregorian day YEAR MONTH DAY.
+Recall that DATE is the number of days since December 31, -1
+in the Gregorian calendar."
+ (if (eq year 0) (setq year -1))
+ (let ((yearm1 (math-sub year 1)))
+ (math-sub
+ ;; Add the number of days of the year and the numbers of days
+ ;; in the previous years (leap year days to be added separately)
+ (math-add (math-day-in-year year month day)
+ (math-add (math-mul 365 yearm1)
+ ;; Add the number of Julian leap years
+ (if (math-posp year)
+ (math-quotient yearm1 4)
+ (math-sub 365
+ (math-quotient (math-sub 3 year)
+ 4)))))
+ ;; Subtract the number of Julian leap years which are not
+ ;; Gregorian leap years. In C=4N+r centuries, there will
+ ;; be 3N+r of these days. The following will compute
+ ;; 3N+r.
+ (let* ((correction (math-mul (math-quotient yearm1 100) 3))
+ (res (math-idivmod correction 4)))
+ (math-add (if (= (cdr res) 0)
+ 0
+ 1)
+ (car res))))))
+
+(defun math-absolute-from-julian-dt (year month day)
+ "Return the DATE of the day given by the Julian day YEAR MONTH DAY.
+Recall that DATE is the number of days since December 31, -1
+in the Gregorian calendar."
(if (eq year 0) (setq year -1))
(let ((yearm1 (math-sub year 1)))
- (math-sub (math-add (math-day-number year month day)
- (math-add (math-mul 365 yearm1)
- (if (math-posp year)
- (math-quotient yearm1 4)
- (math-sub 365
- (math-quotient (math-sub 3 year)
- 4)))))
- (if (or (Math-lessp year 1753)
- (and (eq year 1752) (<= month 9)))
- 1
- (let ((correction (math-mul (math-quotient yearm1 100) 3)))
- (let ((res (math-idivmod correction 4)))
- (math-add (if (= (cdr res) 0)
- -1
- 0)
- (car res))))))))
-
-
-;;; It is safe to redefine these in your .emacs file to use a different
+ (math-sub
+ ;; Add the number of days of the year and the numbers of days
+ ;; in the previous years (leap year days to be added separately)
+ (math-add (math-day-in-year year month day)
+ (math-add (math-mul 365 yearm1)
+ ;; Add the number of Julian leap years
+ (if (math-posp year)
+ (math-quotient yearm1 4)
+ (math-sub 365
+ (math-quotient (math-sub 3 year)
+ 4)))))
+ ;; Adjustment, since January 1, 1 (Julian) is absolute day -1
+ 2)))
+
+;; calc-gregorian-switch is a customizable variable defined in calc.el
+(defvar calc-gregorian-switch)
+
+
+(defun math-absolute-from-dt (year month day)
+ "Return the DATE of the day given by the day YEAR MONTH DAY.
+Recall that DATE is the number of days since December 31, -1
+in the Gregorian calendar."
+ (if (and calc-gregorian-switch
+ ;; The next few lines determine if the given date
+ ;; occurs before the switch to the Gregorian calendar.
+ (math-dt-before-p (list year month day) calc-gregorian-switch))
+ (math-absolute-from-julian-dt year month day)
+ (math-absolute-from-gregorian-dt year month day)))
+
+;;; It is safe to redefine these in your init file to use a different
;;; language.
(defvar math-long-weekday-names '( "Sunday" "Monday" "Tuesday" "Wednesday"
@@ -548,13 +659,13 @@
(setcdr math-fd-dt nil))
fmt))))
-(defconst math-julian-date-beginning '(float 17214235 -1)
- "The beginning of the Julian calendar,
-as measured in the number of days before January 1 of the year 1AD.")
+(defconst math-julian-date-beginning '(float 17214225 -1)
+ "The beginning of the Julian date calendar,
+as measured in the number of days before December 31, 1 BC (Gregorian).")
-(defconst math-julian-date-beginning-int 1721424
- "The beginning of the Julian calendar,
-as measured in the integer number of days before January 1 of the year 1AD.")
+(defconst math-julian-date-beginning-int 1721423
+ "The beginning of the Julian date calendar,
+as measured in the integer number of days before December 31, 1 BC (Gregorian).")
(defun math-format-date-part (x)
(cond ((stringp x)
@@ -585,8 +696,7 @@ as measured in the integer number of days before January 1 of the year 1AD.")
math-fd-year (car math-fd-dt)
math-fd-month (nth 1 math-fd-dt)
math-fd-day (nth 2 math-fd-dt)
- math-fd-weekday (math-mod
- (math-add (math-floor math-fd-date) 6) 7)
+ math-fd-weekday (math-mod (math-floor math-fd-date) 7)
math-fd-hour (nth 3 math-fd-dt)
math-fd-minute (nth 4 math-fd-dt)
math-fd-second (nth 5 math-fd-dt))
@@ -1098,7 +1208,7 @@ as measured in the integer number of days before January 1 of the year 1AD.")
(setq date (nth 1 date)))
(or (math-realp date)
(math-reject-arg date 'datep))
- (math-mod (math-add (math-floor date) 6) 7))
+ (math-mod (math-floor date) 7))
(defun calcFunc-yearday (date)
(let ((dt (math-date-to-dt date)))
@@ -1298,7 +1408,7 @@ second, the number of seconds offset for daylight savings."
0)))
(rounded-abs-date
(+
- (calendar-absolute-from-gregorian
+ (calendar-absolute-from-gregorian
(list (nth 1 dt) (nth 2 dt) (nth 0 dt)))
(/ (round (* 60 time)) 60.0 24.0))))
(if (dst-in-effect rounded-abs-date)
@@ -1434,28 +1544,100 @@ and ends on the last Sunday of October at 2 a.m."
(and (math-messy-integerp day) (setq day (math-trunc day)))
(or (integerp day) (math-reject-arg day 'fixnump))
(and (or (< day 0) (> day 31)) (math-reject-arg day 'range))
- (let ((dt (math-date-to-dt date)))
- (if (or (= day 0) (> day (math-days-in-month (car dt) (nth 1 dt))))
- (setq day (math-days-in-month (car dt) (nth 1 dt))))
- (and (eq (car dt) 1752) (= (nth 1 dt) 9)
- (if (>= day 14) (setq day (- day 11))))
- (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1))
- (1- day)))))
+ (let* ((dt (math-date-to-dt date))
+ (dim (math-days-in-month (car dt) (nth 1 dt)))
+ (julian (if calc-gregorian-switch
+ (math-date-to-dt (math-sub
+ (or (nth 3 calc-gregorian-switch)
+ (apply 'math-absolute-from-gregorian-dt calc-gregorian-switch))
+ 1)))))
+ (if (or (= day 0) (> day dim))
+ (setq day (1- dim))
+ (setq day (1- day)))
+ ;; Adjust if this occurs near the switch to the Gregorian calendar
+ (if calc-gregorian-switch
+ (cond
+ ((and (math-dt-before-p (list (car dt) (nth 1 dt) 1) calc-gregorian-switch)
+ (math-dt-before-p julian (list (car dt) (nth 1 dt) 1)))
+ ;; In this case, CALC-GREGORIAN-SWITCH is the first day of the month
+ (list 'date
+ (math-dt-to-date (list (car calc-gregorian-switch)
+ (nth 1 calc-gregorian-switch)
+ (if (> (+ (nth 2 calc-gregorian-switch) day) dim)
+ dim
+ (+ (nth 2 calc-gregorian-switch) day))))))
+ ((and (eq (car dt) (car calc-gregorian-switch))
+ (= (nth 1 dt) (nth 1 calc-gregorian-switch)))
+ ;; In this case, the switch to the Gregorian calendar occurs in the given month
+ (if (< (+ (nth 2 julian) day) (nth 2 calc-gregorian-switch))
+ ;; If the DAYth day occurs before the switch, use it
+ (list 'date (math-dt-to-date (list (car dt) (nth 1 dt) (1+ day))))
+ ;; Otherwise do some computations
+ (let ((tm (+ day (- (nth 2 calc-gregorian-switch) (nth 2 julian)))))
+ (list 'date (math-dt-to-date
+ (list (car dt)
+ (nth 1 dt)
+ ;;
+ (if (> tm dim) dim tm)))))))
+ ((and (eq (car dt) (car julian))
+ (= (nth 1 dt) (nth 1 julian)))
+ ;; In this case, the current month is truncated because of the switch
+ ;; to the Gregorian calendar
+ (list 'date (math-dt-to-date
+ (list (car dt)
+ (nth 1 dt)
+ (if (>= day (nth 2 julian))
+ (nth 2 julian)
+ (1+ day))))))
+ (t
+ ;; The default
+ (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) day))))
+ (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) day)))))
(defun calcFunc-newyear (date &optional day)
+ (if (eq (car-safe date) 'date) (setq date (nth 1 date)))
(or day (setq day 1))
(and (math-messy-integerp day) (setq day (math-trunc day)))
(or (integerp day) (math-reject-arg day 'fixnump))
- (let ((dt (math-date-to-dt date)))
+ (let* ((dt (math-date-to-dt date))
+ (gregbeg (if calc-gregorian-switch
+ (or (nth 3 calc-gregorian-switch)
+ (apply 'math-absolute-from-gregorian-dt calc-gregorian-switch))))
+ (julianend (if calc-gregorian-switch (math-sub gregbeg 1)))
+ (julian (if calc-gregorian-switch
+ (math-date-to-dt julianend))))
(if (and (>= day 0) (<= day 366))
- (let ((max (if (eq (car dt) 1752) 355
- (if (math-leap-year-p (car dt)) 366 365))))
+ (let ((max (if (math-leap-year-p (car dt)) 366 365)))
(if (or (= day 0) (> day max)) (setq day max))
- (list 'date (math-add (math-dt-to-date (list (car dt) 1 1))
- (1- day))))
+ (if calc-gregorian-switch
+ ;; Now to break this down into cases
+ (cond
+ ((and (math-dt-before-p (list (car dt) 1 1) calc-gregorian-switch)
+ (math-dt-before-p julian (list (car dt) 1 1)))
+ ;; In this case, CALC-GREGORIAN-SWITCH is the first day of the year
+ (list 'date (math-min (math-add gregbeg (1- day))
+ (math-dt-to-date (list (car calc-gregorian-switch) 12 31)))))
+ ((eq (car dt) (car julian))
+ ;; In this case, the switch to the Gregorian calendar occurs in the given year
+ (if (Math-lessp (car julian) (car calc-gregorian-switch))
+ ;; Here, the last Julian day is the last day of the year.
+ (list 'date (math-min (math-add (math-dt-to-date (list (car dt) 1 1)) (1- day))
+ julianend))
+ ;; Otherwise, just make sure the date doesn't go past the end of the year
+ (list 'date (math-min (math-add (math-dt-to-date (list (car dt) 1 1)) (1- day))
+ (math-dt-to-date (list (car dt) 12 31))))))
+ (t
+ (list 'date (math-add (math-dt-to-date (list (car dt) 1 1))
+ (1- day)))))
+ (list 'date (math-add (math-dt-to-date (list (car dt) 1 1))
+ (1- day)))))
(if (and (>= day -12) (<= day -1))
- (list 'date (math-dt-to-date (list (car dt) (- day) 1)))
- (math-reject-arg day 'range)))))
+ (if (and calc-gregorian-switch
+ (math-dt-before-p (list (car dt) (- day) 1) calc-gregorian-switch)
+ (math-dt-before-p julian (list (car dt) (- day) 1)))
+ (list 'date gregbeg)
+ (list 'date (math-dt-to-date (list (car dt) (- day) 1))))
+ (math-reject-arg day 'range)))))
(defun calcFunc-incmonth (date &optional step)
(or step (setq step 1))
diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el
index 30894b406b5..5b7c2cb3366 100644
--- a/lisp/calc/calc-frac.el
+++ b/lisp/calc/calc-frac.el
@@ -1,6 +1,6 @@
;;; calc-frac.el --- fraction functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el
index e065493562e..b5857a8bbbf 100644
--- a/lisp/calc/calc-funcs.el
+++ b/lisp/calc/calc-funcs.el
@@ -1,6 +1,6 @@
;;; calc-funcs.el --- well-known functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 4fd5045f54b..c127b70a80d 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -1,6 +1,6 @@
;;; calc-graph.el --- graph output functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index 66e9c002a47..b17c6b4e3b8 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -1,6 +1,6 @@
;;; calc-help.el --- help display functions for Calc,
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -642,7 +642,7 @@ C-w Describe how there is no warranty for Calc."
'("Deg, Rad, HMS; Frac; Polar; Inf; Alg, Total; Symb; Vec/mat"
"Working; Xtensions; Mode-save; preserve Embedded modes"
"SHIFT + Shifted-prefixes, mode-Filename; Record; reCompute"
- "SHIFT + simplify: Off, Num, Default, Bin, Alg, Ext, Units")
+ "SHIFT + simplify: Off, Num, basIc, Algebraic, Bin, Ext, Units")
"mode" ?m))
diff --git a/lisp/calc/calc-incom.el b/lisp/calc/calc-incom.el
index a9cf89e6058..f39bf291613 100644
--- a/lisp/calc/calc-incom.el
+++ b/lisp/calc/calc-incom.el
@@ -1,6 +1,6 @@
;;; calc-incom.el --- complex data type input functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el
index cc10d9e993c..3a59f6927a6 100644
--- a/lisp/calc/calc-keypd.el
+++ b/lisp/calc/calc-keypd.el
@@ -1,6 +1,6 @@
;;; calc-keypd.el --- mouse-capable keypad input for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index 7e3a08a1459..ec4c497a1c6 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -1,6 +1,6 @@
;;; calc-lang.el --- calc language functions
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -133,8 +133,39 @@
( asin . calcFunc-arcsin )
( asinh . calcFunc-arcsinh )
( atan . calcFunc-arctan )
- ( atan2 . calcFunc-arctan2 )
- ( atanh . calcFunc-arctanh )))
+ ( atan2 . calcFunc-arctan2 )
+ ( atanh . calcFunc-arctanh )
+ ( fma . (math-C-parse-fma))
+ ( fmax . calcFunc-max )
+ ( j0 . (math-C-parse-bess))
+ ( jn . calcFunc-besJ )
+ ( j1 . (math-C-parse-bess))
+ ( yn . calcFunc-besY )
+ ( y0 . (math-C-parse-bess))
+ ( y1 . (math-C-parse-bess))
+ ( tgamma . calcFunc-gamma )))
+
+(defun math-C-parse-bess (f val)
+ "Parse C's j0, j1, y0, y1 functions."
+ (let ((args (math-read-expr-list)))
+ (math-read-token)
+ (append
+ (cond ((eq val 'j0) '(calcFunc-besJ 0))
+ ((eq val 'j1) '(calcFunc-besJ 1))
+ ((eq val 'y0) '(calcFunc-besY 0))
+ ((eq val 'y1) '(calcFunc-besY 1)))
+ args)))
+
+(defun math-C-parse-fma (f val)
+ "Parse C's fma function fma(x,y,z) => (x * y + z)."
+ (let ((args (math-read-expr-list)))
+ (math-read-token)
+ (list 'calcFunc-add
+ (list 'calcFunc-mul
+ (nth 0 args)
+ (nth 1 args))
+ (nth 2 args))))
+
(put 'c 'math-variable-table
'( ( M_PI . var-pi )
diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el
index f922687e7fa..7f3ff9f012e 100644
--- a/lisp/calc/calc-macs.el
+++ b/lisp/calc/calc-macs.el
@@ -1,6 +1,6 @@
;;; calc-macs.el --- important macros for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el
index 2ea4de20293..9276e1a7832 100644
--- a/lisp/calc/calc-map.el
+++ b/lisp/calc/calc-map.el
@@ -1,6 +1,6 @@
;;; calc-map.el --- higher-order functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -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-math.el b/lisp/calc/calc-math.el
index 076dab31fd9..d5a341ee482 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -1,6 +1,6 @@
;;; calc-math.el --- mathematical functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el
index d8c01656784..9437c8bc105 100644
--- a/lisp/calc/calc-menu.el
+++ b/lisp/calc/calc-menu.el
@@ -1,6 +1,6 @@
;;; calc-menu.el --- a menu for Calc
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -1201,6 +1201,63 @@
:keys "v ."
:style toggle
:selected (not calc-full-vectors)]
+ (list "Simplification"
+ ["No simplification mode"
+ (progn
+ (require 'calc-mode)
+ (calc-no-simplify-mode t))
+ :keys "m O"
+ :style radio
+ :selected (eq calc-simplify-mode 'none)
+ :help "No simplifications are done automatically"]
+ ["Numeric simplification mode"
+ (progn
+ (require 'calc-mode)
+ (calc-num-simplify-mode t))
+ :keys "m N"
+ :style radio
+ :selected (eq calc-simplify-mode 'num)
+ :help "Only numeric simplifications are done automatically"]
+ ["Basic simplification mode"
+ (progn
+ (require 'calc-mode)
+ (calc-basic-simplify-mode t))
+ :keys "m I"
+ :style radio
+ :selected (eq calc-simplify-mode nil)
+ :help "Only basic simplifications are done automatically"]
+ ["Binary simplification mode"
+ (progn
+ (require 'calc-mode)
+ (calc-bin-simplify-mode t))
+ :keys "m B"
+ :style radio
+ :selected (eq calc-simplify-mode 'binary)
+ :help "Basic simplifications with binary clipping are done automatically"]
+ ["Algebraic simplification mode"
+ (progn
+ (require 'calc-mode)
+ (calc-alg-simplify-mode t))
+ :keys "m A"
+ :style radio
+ :selected (eq calc-simplify-mode 'alg)
+ :help "Standard algebraic simplifications are done automatically"]
+ ["Extended simplification mode"
+ (progn
+ (require 'calc-mode)
+ (calc-ext-simplify-mode t))
+ :keys "m E"
+ :style radio
+ :selected (eq calc-simplify-mode 'ext)
+ :help "Extended (unsafe) simplifications are done automatically"]
+ ["Units simplification mode"
+ (progn
+ (require 'calc-mode)
+ (calc-units-simplify-mode t))
+ :keys "m U"
+ :style radio
+ :selected (eq calc-simplify-mode 'units)
+ :help "Algebraic and unit simplifications are done automatically"])
(list "Angle Measure"
["Radians"
(progn
@@ -1412,6 +1469,45 @@
:style radio
:selected (eq calc-algebraic-mode 'total)
:help "All regular letters and punctuation begin algebraic entry"])
+ (list "Matrix"
+ ["Off"
+ (progn
+ (require 'calc-mode)
+ (calc-matrix-mode -1))
+ :style radio
+ :selected (eq calc-matrix-mode nil)
+ :help "Variables are not assumed to be matrix or scalar"]
+ ["Matrix mode"
+ (progn
+ (require 'calc-mode)
+ (calc-matrix-mode -2))
+ :style radio
+ :selected (eq calc-matrix-mode 'matrix)
+ :help "Variables are assumed to be matrices"]
+ ["Square matrix mode"
+ (progn
+ (require 'calc-mode)
+ (calc-matrix-mode '(4)))
+ :style radio
+ :selected (eq calc-matrix-mode 'sqmatrix)
+ :help "Variables are assumed to be square matrices"]
+ ["Dimensioned matrix mode"
+ (let ((dim (string-to-number (read-from-minibuffer "Dimension: "))))
+ (if (natnump dim)
+ (progn
+ (require 'calc-mode)
+ (calc-matrix-mode dim))
+ (error "The dimension must be a positive integer")))
+ :style radio
+ :selected (and (integerp calc-matrix-mode) (> calc-matrix-mode 0))
+ :help "Variables are assumed to be NxN matrices"]
+ ["Scalar mode"
+ (progn
+ (require 'calc-mode)
+ (calc-matrix-mode 0))
+ :style radio
+ :selected (eq calc-matrix-mode 'scalar)
+ :help "Variables are assumed to be scalars"])
(list "Language"
["Normal"
(progn
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index d8bdc614e67..1d9c02a47a5 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -1,6 +1,6 @@
;;; calc-misc.el --- miscellaneous functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -305,7 +305,8 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
(string-match "\\`\\*" (car stuff)))
(setq stuff (cons '* (cons (substring (car stuff) 1)
(cdr stuff)))))))
- (setq calc-next-why (cons stuff calc-next-why))
+ (unless (member stuff calc-next-why)
+ (setq calc-next-why (cons stuff calc-next-why)))
nil)
;; True if A is a constant or vector of constants. [P x] [Public]
diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el
index 856dfad882d..f64e37dc0bf 100644
--- a/lisp/calc/calc-mode.el
+++ b/lisp/calc/calc-mode.el
@@ -1,6 +1,6 @@
;;; calc-mode.el --- calculator modes for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -497,37 +497,40 @@
(defun calc-set-simplify-mode (mode arg msg)
(calc-change-mode 'calc-simplify-mode
- (if arg
- (and (> (prefix-numeric-value arg) 0)
- mode)
- (and (not (eq calc-simplify-mode mode))
- mode)))
+ (cond
+ (arg mode)
+ ((eq calc-simplify-mode mode)
+ 'alg)
+ (t mode)))
(message "%s" (if (eq calc-simplify-mode mode)
msg
- "Default simplifications enabled")))
+ "Algebraic simplification occurs by default")))
(defun calc-no-simplify-mode (arg)
(interactive "P")
(calc-wrapper
(calc-set-simplify-mode 'none arg
- "All default simplifications are disabled")))
+ "Simplification is disabled")))
(defun calc-num-simplify-mode (arg)
(interactive "P")
(calc-wrapper
(calc-set-simplify-mode 'num arg
- "Default simplifications apply only if arguments are numeric")))
+ "Basic simplifications apply only if arguments are numeric")))
(defun calc-default-simplify-mode (arg)
- (interactive "p")
- (cond ((= arg 1)
+ (interactive "P")
+ (cond ((or (not arg) (= arg 3))
+ (calc-wrapper
+ (calc-set-simplify-mode
+ 'alg nil "Algebraic simplification occurs by default")))
+ ((= arg 1)
(calc-wrapper
(calc-set-simplify-mode
- nil nil "Usual default simplifications are enabled")))
+ nil nil "Only basic simplifications occur by default")))
((= arg 0) (calc-num-simplify-mode 1))
((< arg 0) (calc-no-simplify-mode 1))
((= arg 2) (calc-bin-simplify-mode 1))
- ((= arg 3) (calc-alg-simplify-mode 1))
((= arg 4) (calc-ext-simplify-mode 1))
((= arg 5) (calc-units-simplify-mode 1))
(t (error "Prefix argument out of range"))))
@@ -539,6 +542,12 @@
(format "Binary simplification occurs by default (word size=%d)"
calc-word-size))))
+(defun calc-basic-simplify-mode (arg)
+ (interactive "P")
+ (calc-wrapper
+ (calc-set-simplify-mode nil arg
+ "Only basic simplifications occur by default")))
+
(defun calc-alg-simplify-mode (arg)
(interactive "P")
(calc-wrapper
diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el
index 5ec15005b48..6fc2d9463d4 100644
--- a/lisp/calc/calc-mtx.el
+++ b/lisp/calc/calc-mtx.el
@@ -1,6 +1,6 @@
;;; calc-mtx.el --- matrix functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el
index bd162866c31..937d0177259 100644
--- a/lisp/calc/calc-nlfit.el
+++ b/lisp/calc/calc-nlfit.el
@@ -1,6 +1,6 @@
;;; calc-nlfit.el --- nonlinear curve fitting for Calc
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el
index e21a095c821..f106e8310a2 100644
--- a/lisp/calc/calc-poly.el
+++ b/lisp/calc/calc-poly.el
@@ -1,6 +1,6 @@
;;; calc-poly.el --- polynomial functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 0d3fbe8586a..411f55a24e6 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -1,6 +1,6 @@
;;; calc-prog.el --- user programmability functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -1792,89 +1792,63 @@ Redefine the corresponding command."
(defun math-do-defmath (func args body)
(require 'calc-macs)
(let* ((fname (intern (concat "calcFunc-" (symbol-name func))))
- (doc (if (stringp (car body)) (list (car body))))
+ (doc (if (stringp (car body))
+ (prog1 (list (car body))
+ (setq body (cdr body)))))
(clargs (mapcar 'math-clean-arg args))
- (body (math-define-function-body
- (if (stringp (car body)) (cdr body) body)
- clargs)))
- (list 'progn
- (if (and (consp (car body))
- (eq (car (car body)) 'interactive))
- (let ((inter (car body)))
- (setq body (cdr body))
- (if (or (> (length inter) 2)
- (integerp (nth 1 inter)))
- (let ((hasprefix nil) (hasmulti nil))
- (if (stringp (nth 1 inter))
- (progn
- (cond ((equal (nth 1 inter) "p")
- (setq hasprefix t))
- ((equal (nth 1 inter) "m")
- (setq hasmulti t))
- (t (error
- "Can't handle interactive code string \"%s\""
- (nth 1 inter))))
- (setq inter (cdr inter))))
- (if (not (integerp (nth 1 inter)))
- (error
- "Expected an integer in interactive specification"))
- (append (list 'defun
- (intern (concat "calc-"
- (symbol-name func)))
- (if (or hasprefix hasmulti)
- '(&optional n)
- ()))
- doc
- (if (or hasprefix hasmulti)
- '((interactive "P"))
- '((interactive)))
- (list
- (append
- '(calc-slow-wrapper)
- (and hasmulti
- (list
- (list 'setq
- 'n
- (list 'if
- 'n
- (list 'prefix-numeric-value
- 'n)
- (nth 1 inter)))))
- (list
- (list 'calc-enter-result
- (if hasmulti 'n (nth 1 inter))
- (nth 2 inter)
- (if hasprefix
- (list 'append
- (list 'quote (list fname))
- (list 'calc-top-list-n
- (nth 1 inter))
- (list 'and
- 'n
- (list
- 'list
- (list
- 'math-normalize
- (list
- 'prefix-numeric-value
- 'n)))))
- (list 'cons
- (list 'quote fname)
- (list 'calc-top-list-n
- (if hasmulti
- 'n
- (nth 1 inter)))))))))))
- (append (list 'defun
- (intern (concat "calc-" (symbol-name func)))
- args)
- doc
- (list
- inter
- (cons 'calc-wrapper body))))))
- (append (list 'defun fname clargs)
- doc
- (math-do-arg-list-check args nil nil)
- body))))
+ (inter (if (and (consp (car body))
+ (eq (car (car body)) 'interactive))
+ (prog1 (car body)
+ (setq body (cdr body))))))
+ (setq body (math-define-function-body body clargs))
+ `(progn
+ ,(if inter
+ (if (or (> (length inter) 2)
+ (integerp (nth 1 inter)))
+ (let ((hasprefix nil) (hasmulti nil))
+ (when (stringp (nth 1 inter))
+ (cond ((equal (nth 1 inter) "p")
+ (setq hasprefix t))
+ ((equal (nth 1 inter) "m")
+ (setq hasmulti t))
+ (t (error
+ "Can't handle interactive code string \"%s\""
+ (nth 1 inter))))
+ (setq inter (cdr inter)))
+ (unless (integerp (nth 1 inter))
+ (error "Expected an integer in interactive specification"))
+ `(defun ,(intern (concat "calc-" (symbol-name func)))
+ ,(if (or hasprefix hasmulti) '(&optional n) ())
+ ,@doc
+ (interactive ,@(if (or hasprefix hasmulti) '("P")))
+ (calc-slow-wrapper
+ ,@(if hasmulti
+ `((setq n (if n
+ (prefix-numeric-value n)
+ ,(nth 1 inter)))))
+ (calc-enter-result
+ ,(if hasmulti 'n (nth 1 inter))
+ ,(nth 2 inter)
+ ,(if hasprefix
+ `(append '(,fname)
+ (calc-top-list-n ,(nth 1 inter))
+ (and n
+ (list
+ (math-normalize
+ (prefix-numeric-value n)))))
+ `(cons ',fname
+ (calc-top-list-n
+ ,(if hasmulti
+ 'n
+ (nth 1 inter)))))))))
+ `(defun ,(intern (concat "calc-" (symbol-name func))) ,clargs
+ ,@doc
+ ,inter
+ (calc-wrapper ,@body))))
+ (defun ,fname ,clargs
+ ,@doc
+ ,@(math-do-arg-list-check args nil nil)
+ ,@body))))
(defun math-clean-arg (arg)
(if (consp arg)
@@ -1887,56 +1861,42 @@ Redefine the corresponding command."
(list (cons 'and
(cons var
(if (cdr chk)
- (setq chk (list (cons 'progn chk)))
+ `((progn ,@chk))
chk)))))
- (and (consp arg)
- (let* ((rest (math-do-arg-check (nth 1 arg) var is-opt is-rest))
- (qual (car arg))
- (qqual (list 'quote qual))
- (qual-name (symbol-name qual))
- (chk (intern (concat "math-check-" qual-name))))
- (if (fboundp chk)
- (append rest
- (list
+ (when (consp arg)
+ (let* ((rest (math-do-arg-check (nth 1 arg) var is-opt is-rest))
+ (qual (car arg))
+ (qual-name (symbol-name qual))
+ (chk (intern (concat "math-check-" qual-name))))
+ (if (fboundp chk)
+ (append rest
+ (if is-rest
+ `((setq ,var (mapcar ',chk ,var)))
+ `((setq ,var (,chk ,var)))))
+ (if (fboundp (setq chk (intern (concat "math-" qual-name))))
+ (append rest
+ (if is-rest
+ `((mapcar #'(lambda (x)
+ (or (,chk x)
+ (math-reject-arg x ',qual)))
+ ,var))
+ `((or (,chk ,var)
+ (math-reject-arg ,var ',qual)))))
+ (if (and (string-match "\\`not-\\(.*\\)\\'" qual-name)
+ (fboundp (setq chk (intern
+ (concat "math-"
+ (math-match-substring
+ qual-name 1))))))
+ (append rest
(if is-rest
- (list 'setq var
- (list 'mapcar (list 'quote chk) var))
- (list 'setq var (list chk var)))))
- (if (fboundp (setq chk (intern (concat "math-" qual-name))))
- (append rest
- (list
- (if is-rest
- (list 'mapcar
- (list 'function
- (list 'lambda '(x)
- (list 'or
- (list chk 'x)
- (list 'math-reject-arg
- 'x qqual))))
- var)
- (list 'or
- (list chk var)
- (list 'math-reject-arg var qqual)))))
- (if (and (string-match "\\`not-\\(.*\\)\\'" qual-name)
- (fboundp (setq chk (intern
- (concat "math-"
- (math-match-substring
- qual-name 1))))))
- (append rest
- (list
- (if is-rest
- (list 'mapcar
- (list 'function
- (list 'lambda '(x)
- (list 'and
- (list chk 'x)
- (list 'math-reject-arg
- 'x qqual))))
- var)
- (list 'and
- (list chk var)
- (list 'math-reject-arg var qqual)))))
- (error "Unknown qualifier `%s'" qual-name))))))))
+ `((mapcar #'(lambda (x)
+ (and (,chk x)
+ (math-reject-arg x ',qual)))
+ ,var))
+ `((and
+ (,chk ,var)
+ (math-reject-arg ,var ',qual)))))
+ (error "Unknown qualifier `%s'" qual-name))))))))
(defun math-do-arg-list-check (args is-opt is-rest)
(cond ((null args) nil)
@@ -1980,7 +1940,7 @@ Redefine the corresponding command."
(defun math-define-function-body (body env)
(let ((body (math-define-body body env)))
(if (math-body-refers-to body 'math-return)
- (list (cons 'catch (cons '(quote math-return) body)))
+ `((catch 'math-return ,@body))
body)))
;; The variable math-exp-env is local to math-define-body, but is
diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el
index 1498b622e1f..eed8a756e8e 100644
--- a/lisp/calc/calc-rewr.el
+++ b/lisp/calc/calc-rewr.el
@@ -1,6 +1,6 @@
;;; calc-rewr.el --- rewriting functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -1439,21 +1439,19 @@
(put 'calcFunc-vxor 'math-rewrite-default '(vec))
(defmacro math-rwfail (&optional back)
- (list 'setq 'pc
- (list 'and
- (if back
- '(setq btrack (cdr btrack))
- 'btrack)
- ''((backtrack)))))
+ `(setq pc (and ,(if back
+ '(setq btrack (cdr btrack))
+ 'btrack)
+ '((backtrack)))))
;; This monstrosity is necessary because the use of static vectors of
;; registers makes rewrite rules non-reentrant. Yucko!
(defmacro math-rweval (form)
- (list 'let '((orig (car rules)))
- '(setcar rules (quote (nil nil nil no-phase)))
- (list 'unwind-protect
- form
- '(setcar rules orig))))
+ `(let ((orig (car rules)))
+ (setcar rules '(nil nil nil no-phase))
+ (unwind-protect
+ ,form
+ (setcar rules orig))))
(defvar math-rewrite-phase 1)
diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el
index fa57a350729..4332753c228 100644
--- a/lisp/calc/calc-rules.el
+++ b/lisp/calc/calc-rules.el
@@ -1,6 +1,6 @@
;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el
index 26834a44598..bdacf65603c 100644
--- a/lisp/calc/calc-sel.el
+++ b/lisp/calc/calc-sel.el
@@ -1,6 +1,6 @@
;;; calc-sel.el --- data selection functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-stat.el b/lisp/calc/calc-stat.el
index 83ce71a2376..04b0298dc88 100644
--- a/lisp/calc/calc-stat.el
+++ b/lisp/calc/calc-stat.el
@@ -1,6 +1,6 @@
;;; calc-stat.el --- statistical functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index 2da551ee215..64df10a40ca 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -1,6 +1,6 @@
;;; calc-store.el --- value storage functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -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-stuff.el b/lisp/calc/calc-stuff.el
index 0558d8d2285..591bd89c3b8 100644
--- a/lisp/calc/calc-stuff.el
+++ b/lisp/calc/calc-stuff.el
@@ -1,6 +1,6 @@
;;; calc-stuff.el --- miscellaneous functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-trail.el b/lisp/calc/calc-trail.el
index eec4cd2af58..4e513b8241f 100644
--- a/lisp/calc/calc-trail.el
+++ b/lisp/calc/calc-trail.el
@@ -1,6 +1,6 @@
;;; calc-trail.el --- functions for manipulating the Calc "trail"
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el
index 9168d9b0947..6f69f99b5a2 100644
--- a/lisp/calc/calc-undo.el
+++ b/lisp/calc/calc-undo.el
@@ -1,6 +1,6 @@
;;; calc-undo.el --- undo functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 86e8cbbc73a..58646ea114c 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -1,6 +1,6 @@
;;; calc-units.el --- unit conversion functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -302,7 +302,7 @@
(defvar math-additional-units nil
- "*Additional units table for user-defined units.
+ "Additional units table for user-defined units.
Must be formatted like `math-standard-units'.
If you change this, be sure to set `math-units-table' to nil to ensure
that the combined units table will be rebuilt.")
@@ -356,6 +356,8 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
(math-to-standard-units (calc-top-n 1)
nil))))))
+(defvar calc-ensure-consistent-units)
+
(defun calc-quick-units ()
(interactive)
(calc-slow-wrapper
@@ -370,8 +372,11 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
(unless (< pos (length units))
(error "Unit number %d not defined" pos))
(if (math-units-in-expr-p expr nil)
- (calc-enter-result 1 (format "cun%d" num)
- (math-convert-units expr (nth pos units)))
+ (progn
+ (if calc-ensure-consistent-units
+ (math-check-unit-consistency expr (nth pos units)))
+ (calc-enter-result 1 (format "cun%d" num)
+ (math-convert-units expr (nth pos units))))
(calc-enter-result 1 (format "*un%d" num)
(math-simplify-units
(math-mul expr (nth pos units))))))))
@@ -399,7 +404,7 @@ If EXPR is nil, return nil."
(math-composition-to-string cexpr))))))
(defvar math-default-units-table
- (make-hash-table :test 'equal)
+ #s(hash-table test equal data (1 (1)))
"A table storing previously converted units.")
(defun math-get-default-units (expr)
@@ -413,21 +418,24 @@ If EXPR is nil, return nil."
(math-make-unit-string (cadr default-units))
(math-make-unit-string (car default-units)))))
-(defun math-put-default-units (expr)
- "Put the units in EXPR in the default units table."
- (let* ((units (math-get-units expr))
- (standard-units (math-get-standard-units expr))
- (default-units (gethash
- standard-units
- math-default-units-table)))
- (cond
- ((not default-units)
- (puthash standard-units (list units) math-default-units-table))
- ((not (equal units (car default-units)))
- (puthash standard-units
- (list units (car default-units))
- math-default-units-table)))))
-
+(defun math-put-default-units (expr &optional comp std)
+ "Put the units in EXPR in the default units table.
+If COMP or STD is non-nil, put that in the units table instead."
+ (let* ((new-units (or comp std (math-get-units expr)))
+ (standard-units (math-get-standard-units
+ (cond
+ (comp (math-simplify-units expr))
+ (std expr)
+ (t new-units))))
+ (default-units (gethash standard-units math-default-units-table)))
+ (unless (eq standard-units 1)
+ (cond
+ ((not default-units)
+ (puthash standard-units (list new-units) math-default-units-table))
+ ((not (equal new-units (car default-units)))
+ (puthash standard-units
+ (list new-units (car default-units))
+ math-default-units-table))))))
(defun calc-convert-units (&optional old-units new-units)
(interactive)
@@ -451,45 +459,48 @@ If EXPR is nil, return nil."
(when (eq (car-safe uold) 'error)
(error "Bad format in units expression: %s" (nth 1 uold)))
(setq expr (math-mul expr uold))))
- (unless new-units
- (setq defunits (math-get-default-units expr))
- (setq new-units
- (read-string (concat
- (if uoldname
- (concat "Old units: "
- uoldname
- ", new units")
- "New units")
- (if defunits
- (concat
- " (default "
- defunits
- "): ")
- ": "))))
-
- (if (and
- (string= new-units "")
- defunits)
- (setq new-units defunits)))
- (when (string-match "\\` */" new-units)
- (setq new-units (concat "1" new-units)))
- (setq units (math-read-expr new-units))
- (when (eq (car-safe units) 'error)
- (error "Bad format in units expression: %s" (nth 2 units)))
- (math-put-default-units units)
- (let ((unew (math-units-in-expr-p units t))
- (std (and (eq (car-safe units) 'var)
- (assq (nth 1 units) math-standard-units-systems))))
- (if std
- (calc-enter-result 1 "cvun" (math-simplify-units
- (math-to-standard-units expr
- (nth 1 std))))
- (unless unew
+ (setq defunits (math-get-default-units expr))
+ (if (equal defunits "1")
+ (progn
+ (calc-enter-result 1 "cvun" (math-simplify-units expr))
+ (message "All units in expression cancel"))
+ (unless new-units
+ (setq new-units
+ (read-string (concat
+ (if uoldname
+ (concat "Old units: "
+ uoldname
+ ", new units")
+ "New units")
+ (if defunits
+ (concat
+ " (default "
+ defunits
+ "): ")
+ ": "))))
+ (if (and
+ (string= new-units "")
+ defunits)
+ (setq new-units defunits)))
+ (when (string-match "\\` */" new-units)
+ (setq new-units (concat "1" new-units)))
+ (setq units (math-read-expr new-units))
+ (when (eq (car-safe units) 'error)
+ (error "Bad format in units expression: %s" (nth 2 units)))
+ (if calc-ensure-consistent-units
+ (math-check-unit-consistency expr units))
+ (let ((unew (math-units-in-expr-p units t))
+ (std (and (eq (car-safe units) 'var)
+ (assq (nth 1 units) math-standard-units-systems)))
+ (comp (eq (car-safe units) '+)))
+ (unless (or unew std)
(error "No units specified"))
- (calc-enter-result 1 "cvun"
- (math-convert-units
- expr units
- (and uoldname (not (equal uoldname "1"))))))))))
+ (let ((res
+ (if std
+ (math-simplify-units (math-to-standard-units expr (nth 1 std)))
+ (math-convert-units expr units (and uoldname (not (equal uoldname "1")))))))
+ (math-put-default-units res (if comp units))
+ (calc-enter-result 1 "cvun" res)))))))
(defun calc-autorange-units (arg)
(interactive "P")
@@ -559,7 +570,7 @@ If EXPR is nil, return nil."
(defun calc-extract-units ()
(interactive)
(calc-slow-wrapper
- (calc-enter-result 1 "rmun" (math-simplify-units
+ (calc-enter-result 1 "exun" (math-simplify-units
(math-extract-units (calc-top-n 1))))))
;; The variables calc-num-units and calc-den-units are local to
@@ -913,6 +924,20 @@ If EXPR is nil, return nil."
(math-single-units-in-expr-p (nth 1 expr))))
(t 'wrong)))
+(defun math-consistent-units-p (expr newunits)
+ "Non-nil if EXPR and NEWUNITS have consistent units."
+ (or
+ (and (eq (car-safe newunits) 'var)
+ (assq (nth 1 newunits) math-standard-units-systems))
+ (math-numberp (math-get-units (list '/ expr newunits)))))
+
+(defun math-check-unit-consistency (expr units)
+ "Give an error if EXPR and UNITS do not have consistent units."
+ (unless (math-consistent-units-p expr units)
+ (error "New units (%s) are inconsistent with current units (%s)"
+ (math-format-value units)
+ (math-format-value (math-get-units expr)))))
+
(defun math-check-unit-name (v)
(and (eq (car-safe v) 'var)
(or (assq (nth 1 v) (or math-units-table (math-build-units-table)))
@@ -1456,10 +1481,16 @@ If EXPR is nil, return nil."
(mapcar 'math-remove-units (cdr expr))))))
(defun math-extract-units (expr)
- (if (memq (car-safe expr) '(* /))
- (cons (car expr)
- (mapcar 'math-extract-units (cdr expr)))
- (if (math-check-unit-name expr) expr 1)))
+ (cond
+ ((memq (car-safe expr) '(* /))
+ (cons (car expr)
+ (mapcar 'math-extract-units (cdr expr))))
+ ((and
+ (eq (car-safe expr) '^)
+ (math-check-unit-name (nth 1 expr)))
+ expr)
+ ((math-check-unit-name expr) expr)
+ (t 1)))
(defun math-build-units-table-buffer (enter-buffer)
(if (not (and math-units-table math-units-table-buffer-valid
diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el
index 47ef3241b3e..d117cd6c19a 100644
--- a/lisp/calc/calc-vec.el
+++ b/lisp/calc/calc-vec.el
@@ -1,6 +1,6 @@
;;; calc-vec.el --- vector functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index 135ea0bae40..1a6c53351f2 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -1,6 +1,6 @@
;;; calc-yank.el --- kill-ring functionality for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 23f955afe7c..58eabf9bcec 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1,6 +1,6 @@
;;; calc.el --- the GNU Emacs calculator
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -199,7 +199,7 @@
(declare-function calc-div-fractions "calc-frac" (a b))
(declare-function math-div-objects-fancy "calc-arith" (a b))
(declare-function math-div-symb-fancy "calc-arith" (a b))
-(declare-function math-compose-expr "calccomp" (a prec))
+(declare-function math-compose-expr "calccomp" (a prec &optional div))
(declare-function math-comp-width "calccomp" (c))
(declare-function math-composition-to-string "calccomp" (c &optional width))
(declare-function math-stack-value-offset-fancy "calccomp" ())
@@ -222,7 +222,7 @@
(defgroup calc nil
- "GNU Calc."
+ "Advanced desk calculator and mathematical tool."
:prefix "calc-"
:tag "Calc"
:group 'applications)
@@ -418,6 +418,14 @@ in normal mode."
:group 'calc
:type 'boolean)
+(defcustom calc-ensure-consistent-units
+ nil
+ "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
100
"The number of undo steps that will be preserved when Calc is quit."
@@ -431,27 +439,33 @@ If `calc-show-selections' is non-nil, then selected sub-formulas are shown
by displaying the rest of the formula in `calc-nonselected-face'.
If `calc-show-selections' is nil, then selected sub-formulas are shown
by displaying the sub-formula in `calc-selected-face'."
+ :version "24.1"
:group 'calc
:type 'boolean)
(defcustom calc-lu-field-reference
"20 uPa"
"The default reference level for logarithmic units (field)."
+ :version "24.1"
:group 'calc
:type '(string))
(defcustom calc-lu-power-reference
"mW"
"The default reference level for logarithmic units (power)."
+ :version "24.1"
:group 'calc
:type '(string))
(defcustom calc-note-threshold "1"
"The number of cents that a frequency should be near a note
to be identified as that note."
+ :version "24.1"
:type 'string
:group 'calc)
+(defvar math-format-date-cache) ; calc-forms.el
+
(defface calc-nonselected-face
'((t :inherit shadow
:slant italic))
@@ -687,11 +701,11 @@ If `C' is present, display outer brackets for matrices (centered).")
(defcalcmodevar calc-previous-modulo nil
"Most recently used value of M in a modulo form.")
-(defcalcmodevar calc-simplify-mode nil
+(defcalcmodevar calc-simplify-mode 'alg
"Type of simplification applied to results.
If `none', results are not simplified when pushed on the stack.
If `num', functions are simplified only when args are constant.
-If nil, only fast simplifications are applied.
+If nil, only limited simplifications are applied.
If `binary', `math-clip' is applied if appropriate.
If `alg', `math-simplify' is applied.
If `ext', `math-simplify-extended' is applied.
@@ -813,7 +827,7 @@ If nil, selections displayed but ignored.")
Used by `calc-user-invocation'.")
(defcalcmodevar calc-show-banner t
- "*If non-nil, show a friendly greeting above the stack.")
+ "If non-nil, show a friendly greeting above the stack.")
(defconst calc-local-var-list '(calc-stack
calc-stack-top
@@ -901,35 +915,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)
- (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload)
- (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)
@@ -1342,12 +1327,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)
@@ -1384,7 +1369,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))))
@@ -1746,10 +1731,10 @@ See calc-keypad for details."
((eq calc-simplify-mode 'num) "NumSimp ")
((eq calc-simplify-mode 'binary)
(format "BinSimp%d " calc-word-size))
- ((eq calc-simplify-mode 'alg) "AlgSimp ")
+ ((eq calc-simplify-mode 'alg) "")
((eq calc-simplify-mode 'ext) "ExtSimp ")
((eq calc-simplify-mode 'units) "UnitSimp ")
- (t ""))
+ (t "BasicSimp "))
;; Display modes
(cond ((= calc-number-radix 10) "")
@@ -1932,8 +1917,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)
@@ -1950,9 +1934,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)
@@ -1963,7 +1947,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
@@ -2037,6 +2022,50 @@ See calc-keypad for details."
(calc-refresh align)))
(setq calc-refresh-count (1+ calc-refresh-count)))
+;; Dates that are built-in options for `calc-gregorian-switch' should be
+;; (YEAR MONTH DAY math-date-from-gregorian-dt(YEAR MONTH DAY)) for speed.
+(defcustom calc-gregorian-switch nil
+ "The first day the Gregorian calendar is used by Calc's date forms.
+This is `nil' (the default) if the Gregorian calendar is the only one used.
+Otherwise, it should be a list `(YEAR MONTH DAY)' when Calc begins to use
+the Gregorian calendar; Calc will use the Julian calendar for earlier dates.
+The dates in which different regions of the world began to use the
+Gregorian calendar vary quite a bit, even within a single country.
+If you want Calc's date forms to switch between the Julian and
+Gregorian calendar, you can specify the date or choose from several
+common choices. Some of these choices should be taken with a grain
+of salt; for example different parts of France changed calendars at
+different times, and Sweden's change to the Gregorian calendar was
+complicated. Also, the boundaries of the countries were different at
+the times of the calendar changes than they are now.
+The Vatican decided that the Gregorian calendar should take effect
+on 15 October 1582 (Gregorian), and many Catholic countries made
+the change then. Great Britain and its colonies had the Gregorian
+calendar take effect on 14 September 1752 (Gregorian); this includes
+the United States."
+ :group 'calc
+ :version "24.4"
+ :type '(choice (const :tag "Always use the Gregorian calendar" nil)
+ (const :tag "1582-10-15 - Italy, Poland, Portugal, Spain" (1582 10 15 577736))
+ (const :tag "1582-12-20 - France" (1582 12 20 577802))
+ (const :tag "1582-12-25 - Luxemburg" (1582 12 25 577807))
+ (const :tag "1584-01-17 - Bohemia and Moravia" (1584 1 17 578195))
+ (const :tag "1587-11-01 - Hungary" (1587 11 1 579579))
+ (const :tag "1700-03-01 - Denmark" (1700 3 1 620607))
+ (const :tag "1701-01-12 - Protestant Switzerland" (1701 1 12 620924))
+ (const :tag "1752-09-14 - Great Britain and dominions" (1752 9 14 639797))
+ (const :tag "1753-03-01 - Sweden" (1753 3 1 639965))
+ (const :tag "1918-02-14 - Russia" (1918 2 14 700214))
+ (const :tag "1919-04-14 - Romania" (1919 4 14 700638))
+ (list :tag "(YEAR MONTH DAY)"
+ (integer :tag "Year")
+ (integer :tag "Month (integer)")
+ (integer :tag "Day")))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (setq math-format-date-cache nil)
+ (calc-refresh)))
+
;;;; The Calc Trail buffer.
(defun calc-check-trail-aligned ()
@@ -2572,7 +2601,11 @@ largest Emacs integer.")
;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public]
(defvar math-normalize-a)
+(defvar math-normalize-error nil
+ "Non-nil if the last call the `math-normalize' returned an error.")
+
(defun math-normalize (math-normalize-a)
+ (setq math-normalize-error nil)
(cond
((not (consp math-normalize-a))
(if (integerp math-normalize-a)
@@ -2661,31 +2694,38 @@ largest Emacs integer.")
(fboundp (car math-normalize-a))))
(apply (car math-normalize-a) args)))))
(wrong-number-of-arguments
+ (setq math-normalize-error t)
(calc-record-why "*Wrong number of arguments"
(cons (car math-normalize-a) args))
nil)
(wrong-type-argument
+ (setq math-normalize-error t)
(or calc-next-why
(calc-record-why "Wrong type of argument"
(cons (car math-normalize-a) args)))
nil)
(args-out-of-range
+ (setq math-normalize-error t)
(calc-record-why "*Argument out of range"
(cons (car math-normalize-a) args))
nil)
(inexact-result
+ (setq math-normalize-error t)
(calc-record-why "No exact representation for result"
(cons (car math-normalize-a) args))
nil)
(math-overflow
+ (setq math-normalize-error t)
(calc-record-why "*Floating-point overflow occurred"
(cons (car math-normalize-a) args))
nil)
(math-underflow
+ (setq math-normalize-error t)
(calc-record-why "*Floating-point underflow occurred"
(cons (car math-normalize-a) args))
nil)
(void-variable
+ (setq math-normalize-error t)
(if (eq (nth 1 err) 'var-EvalRules)
(progn
(setq var-EvalRules nil)
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index 25b51fc89f6..5fd5b35654c 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -1,6 +1,6 @@
;;; calcalg2.el --- more algebraic functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -667,21 +667,18 @@
(defvar math-integral-limit)
(defmacro math-tracing-integral (&rest parts)
- (list 'and
- 'trace-buffer
- (list 'with-current-buffer
- 'trace-buffer
- '(goto-char (point-max))
- (list 'and
- '(bolp)
- '(insert (make-string (- math-integral-limit
- math-integ-level) 32)
- (format "%2d " math-integ-depth)
- (make-string math-integ-level 32)))
- ;;(list 'condition-case 'err
- (cons 'insert parts)
- ;; '(error (insert (prin1-to-string err))))
- '(sit-for 0))))
+ `(and trace-buffer
+ (with-current-buffer trace-buffer
+ (goto-char (point-max))
+ (and (bolp)
+ (insert (make-string (- math-integral-limit
+ math-integ-level) 32)
+ (format "%2d " math-integ-depth)
+ (make-string math-integ-level 32)))
+ ;;(condition-case err
+ (insert ,@parts)
+ ;; (error (insert (prin1-to-string err))))
+ (sit-for 0))))
;;; The following wrapper caches results and avoids infinite recursion.
;;; Each cache entry is: ( A B ) Integral of A is B;
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index a9118964b46..9e6cdda057f 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -1,6 +1,6 @@
;;; calcalg3.el --- more algebraic functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 906517ac503..2f1c95b7668 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -1,6 +1,6 @@
;;; calccomp.el --- composition functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -86,8 +86,11 @@
(setq sn (math-to-underscores sn)))
sn)))
-(defun math-compose-expr (a prec)
- (let ((math-compose-level (1+ math-compose-level))
+;;; Give multiplication precedence when composing to avoid
+;;; writing a*(b c) instead of a b c
+(defun math-compose-expr (a prec &optional div)
+ (let ((calc-multiplication-has-precedence t)
+ (math-compose-level (1+ math-compose-level))
(math-expr-opers (math-expr-ops))
spfn)
(cond
@@ -591,7 +594,9 @@
(or (= (length a) 3) (eq (car a) 'calcFunc-if))
(/= (nth 3 op) -1))
(cond
- ((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op))))
+ ((or
+ (> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op))))
+ (and div (eq (car a) '*)))
(if (and (memq calc-language '(tex latex))
(not (math-tex-expr-is-flat a)))
(if (eq (car-safe a) '/)
@@ -631,7 +636,7 @@
nil)
math-compose-level))
(lhs (math-compose-expr (nth 1 a) (nth 2 op)))
- (rhs (math-compose-expr (nth 2 a) (nth 3 op))))
+ (rhs (math-compose-expr (nth 2 a) (nth 3 op) (eq (nth 1 op) '/))))
(and (equal (car op) "^")
(eq (math-comp-first-char lhs) ?-)
(setq lhs (list 'horiz "(" lhs ")")))
diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el
index f44da07763f..770420f8deb 100644
--- a/lisp/calc/calcsel2.el
+++ b/lisp/calc/calcsel2.el
@@ -1,6 +1,6 @@
;;; calcsel2.el --- selection functions for Calc
-;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calculator.el b/lisp/calculator.el
index faf62424729..b1a3f9e0759 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -1,6 +1,6 @@
;;; calculator.el --- a [not so] simple calculator for Emacs
-;; Copyright (C) 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Eli Barzilay <eli@barzilay.org>
;; Keywords: tools, convenience
@@ -43,8 +43,6 @@
;;; History:
;; I hate history.
-(eval-when-compile (require 'cl))
-
;;;=====================================================================
;;; Customization:
@@ -717,17 +715,17 @@ See the documentation for `calculator-mode' for more information."
(cond
((not (get-buffer-window calculator-buffer))
(let ((window-min-height 2))
- ;; maybe leave two lines for our window because of the normal
- ;; `raised' modeline in Emacs 21
+ ;; maybe leave two lines for our window because of the
+ ;; normal `raised' mode line
(select-window
(split-window-below
- ;; If the modeline might interfere with the calculator buffer,
- ;; use 3 lines instead.
+ ;; If the mode line might interfere with the calculator
+ ;; buffer, use 3 lines instead.
(if (and (fboundp 'face-attr-construct)
(let* ((dh (plist-get (face-attr-construct 'default) :height))
- (mf (face-attr-construct 'modeline))
+ (mf (face-attr-construct 'mode-line))
(mh (plist-get mf :height)))
- ;; If the modeline is shorter than the default,
+ ;; If the mode line is shorter than the default,
;; stick with 2 lines. (It may be necessary to
;; check how much shorter.)
(and
@@ -739,7 +737,7 @@ See the documentation for `calculator-mode' for more information."
(not (integerp mh))
(< mh 1))))
(or
- ;; If the modeline is taller than the default,
+ ;; If the mode line is taller than the default,
;; use 3 lines.
(and (integerp dh)
(integerp mh)
@@ -747,7 +745,7 @@ See the documentation for `calculator-mode' for more information."
(and (numberp mh)
(not (integerp mh))
(> mh 1))
- ;; If the modeline has a box with non-negative line-width,
+ ;; If the mode line has a box with non-negative line-width,
;; use 3 lines.
(let* ((bx (plist-get mf :box))
(lh (plist-get bx :line-width)))
@@ -755,8 +753,8 @@ See the documentation for `calculator-mode' for more information."
(or
(not lh)
(> lh 0))))
- ;; If the modeline has an overline, use 3 lines.
- (plist-get (face-attr-construct 'modeline) :overline)))))
+ ;; If the mode line has an overline, use 3 lines.
+ (plist-get (face-attr-construct 'mode-line) :overline)))))
-3 -2)))
(switch-to-buffer calculator-buffer)))
((not (eq (current-buffer) calculator-buffer))
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index 230366da2b0..28e8948af9b 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -1,6 +1,6 @@
;;; appt.el --- appointment notification functions
-;; Copyright (C) 1989-1990, 1994, 1998, 2001-2011
+;; Copyright (C) 1989-1990, 1994, 1998, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index ae5dc02862d..6101e472952 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -1,6 +1,6 @@
;;; cal-bahai.el --- calendar functions for the Bahá'í calendar.
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Keywords: calendar
diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el
index d17c2c71f8a..03a4b320059 100644
--- a/lisp/calendar/cal-china.el
+++ b/lisp/calendar/cal-china.el
@@ -1,6 +1,6 @@
;;; cal-china.el --- calendar functions for the Chinese calendar
-;; Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
index 4db2743777f..f51f6687881 100644
--- a/lisp/calendar/cal-coptic.el
+++ b/lisp/calendar/cal-coptic.el
@@ -1,6 +1,6 @@
;;; cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars
-;; Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index ffb367a70f6..4af3ea53ab3 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -1,6 +1,6 @@
;;; cal-dst.el --- calendar functions for daylight saving rules
-;; Copyright (C) 1993-1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Paul Eggert <eggert@twinsun.com>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -347,8 +347,8 @@ DST-ZONE are equal, and all the DST-* integer variables are 0.
Some operating systems cannot provide all this information to Emacs; in this
case, `calendar-current-time-zone' returns a list containing nil for the data
it can't find."
- (unless calendar-current-time-zone-cache
- (setq calendar-current-time-zone-cache (calendar-dst-find-data))))
+ (or calendar-current-time-zone-cache
+ (setq calendar-current-time-zone-cache (calendar-dst-find-data))))
;; Following options should be set based on conditions when the code
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el
index ef1ce8767ab..936fd1778a2 100644
--- a/lisp/calendar/cal-french.el
+++ b/lisp/calendar/cal-french.el
@@ -1,6 +1,6 @@
;;; cal-french.el --- calendar functions for the French Revolutionary calendar
-;; Copyright (C) 1988-1989, 1992, 1994-1995, 1997, 2001-2011
+;; Copyright (C) 1988-1989, 1992, 1994-1995, 1997, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index 52bf442915f..9db77d7bd87 100644
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -1,6 +1,6 @@
;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
-;; Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -731,7 +731,7 @@ from the cursor position."
(interactive
(let* ((death-date
(if (equal (current-buffer) (get-buffer calendar-buffer))
- (calendar-cursor-to-date)
+ (calendar-cursor-to-date t)
(let* ((today (calendar-current-date))
(year (calendar-read
"Year of death (>0): "
diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el
index 580b953170c..dff370460af 100644
--- a/lisp/calendar/cal-html.el
+++ b/lisp/calendar/cal-html.el
@@ -1,6 +1,6 @@
;;; cal-html.el --- functions for printing HTML calendars
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Anna M. Bigatti <bigatti@dima.unige.it>
;; Keywords: calendar
@@ -66,6 +66,12 @@
(string :tag "Sat"))
:group 'calendar-html)
+(defcustom cal-html-holidays t
+ "If non-nil, include holidays as well as diary entries."
+ :version "24.3"
+ :type 'boolean
+ :group 'calendar-html)
+
(defcustom cal-html-css-default
(concat
"<STYLE TYPE=\"text/css\">\n"
@@ -82,9 +88,11 @@
" SPAN.NO-YEAR { color: #0b3; font-weight: bold; }\n"
" SPAN.ANN { color: #0bb; font-weight: bold; }\n"
" SPAN.BLOCK { color: #048; font-style: italic; }\n"
+ " SPAN.HOLIDAY { color: #f00; font-weight: bold; }\n"
"</STYLE>\n\n")
"Default cal-html css style. You can override this with a \"cal.css\" file."
:type 'string
+ :version "24.3" ; added SPAN.HOLIDAY
:group 'calendar-html)
;;; End customizable variables.
@@ -227,6 +235,8 @@ Contains links to previous and next month and year, and current minical."
;;------------------------------------------------------------
;; minical: a small month calendar with links
;;------------------------------------------------------------
+(autoload 'holiday-in-range "holidays")
+
(defun cal-html-insert-minical (month year)
"Insert a minical for numeric MONTH of YEAR."
(let* ((blank-days ; at start of month
@@ -313,10 +323,12 @@ Characters are replaced according to `cal-html-html-subst-list'."
""))
-(defun cal-html-htmlify-entry (entry)
- "Convert a diary entry ENTRY to html with the appropriate class specifier."
+(defun cal-html-htmlify-entry (entry &optional class)
+ "Convert a diary entry ENTRY to html with the appropriate class specifier.
+Optional argument CLASS is the class specifier to use."
(let ((start
(cond
+ (class)
((string-match "block" (nth 2 entry)) "BLOCK")
((string-match "anniversary" (nth 2 entry)) "ANN")
((not (string-match
@@ -328,10 +340,12 @@ Characters are replaced according to `cal-html-html-subst-list'."
(cal-html-htmlify-string (cadr entry)))))
-(defun cal-html-htmlify-list (date-list date)
+(defun cal-html-htmlify-list (date-list date &optional holidays)
"Return a string of concatenated, HTML-ified diary entries.
-DATE-LIST is a list of diary entries. Return only those matching DATE."
- (mapconcat (lambda (x) (cal-html-htmlify-entry x))
+DATE-LIST is a list of diary entries. Return only those matching DATE.
+Optional argument HOLIDAYS non-nil means the input is actually a list
+of holidays, rather than diary entries."
+ (mapconcat (lambda (x) (cal-html-htmlify-entry x (if holidays "HOLIDAY")))
(let (result)
(dolist (p date-list (reverse result))
(and (car p)
@@ -351,11 +365,11 @@ DATE-LIST is a list of diary entries. Return only those matching DATE."
(diary-list-entries (calendar-gregorian-from-absolute d1)
(1+ (- d2 d1)) t))
-
-(defun cal-html-insert-agenda-days (month year diary-list)
+(defun cal-html-insert-agenda-days (month year diary-list holiday-list)
"Insert HTML commands for a range of days in monthly calendars.
HTML commands are inserted for the days of the numeric MONTH in
-four-digit YEAR. Diary entries in DIARY-LIST are included."
+four-digit YEAR. Includes diary entries in DIARY-LIST, and
+holidays in HOLIDAY-LIST."
(let ((blank-days ; at start of month
(mod (- (calendar-day-of-week (list month 1 year))
calendar-week-start-day)
@@ -381,6 +395,8 @@ four-digit YEAR. Diary entries in DIARY-LIST are included."
cal-html-e-tableheader-string
;; Diary entries.
cal-html-b-tabledata-string
+ (cal-html-htmlify-list holiday-list date t)
+ (if (and holiday-list diary-list) "<BR>\n" "")
(cal-html-htmlify-list diary-list date)
cal-html-e-tabledata-string
cal-html-e-tablerow-string)
@@ -395,16 +411,17 @@ four-digit YEAR. Diary entries in DIARY-LIST are included."
(defun cal-html-one-month (month year dir)
"Write an HTML calendar file for numeric MONTH of YEAR in directory DIR."
- (let ((diary-list (cal-html-list-diary-entries
- (calendar-absolute-from-gregorian (list month 1 year))
- (calendar-absolute-from-gregorian
+ (let* ((d1 (calendar-absolute-from-gregorian (list month 1 year)))
+ (d2 (calendar-absolute-from-gregorian
(list month
(calendar-last-day-of-month month year)
- year)))))
+ year)))
+ (diary-list (cal-html-list-diary-entries d1 d2))
+ (holiday-list (if cal-html-holidays (holiday-in-range d1 d2))))
(with-temp-buffer
(insert cal-html-b-document-string)
(cal-html-insert-month-header month year)
- (cal-html-insert-agenda-days month year diary-list)
+ (cal-html-insert-agenda-days month year diary-list holiday-list)
(insert cal-html-e-document-string)
(write-file (expand-file-name
(cal-html-monthpage-name month year) dir)))))
diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el
index e69a2389e6c..cdfb5e523b9 100644
--- a/lisp/calendar/cal-islam.el
+++ b/lisp/calendar/cal-islam.el
@@ -1,6 +1,6 @@
;;; cal-islam.el --- calendar functions for the Islamic calendar
-;; Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el
index e745b6264e0..04c28967fc6 100644
--- a/lisp/calendar/cal-iso.el
+++ b/lisp/calendar/cal-iso.el
@@ -1,6 +1,6 @@
;;; cal-iso.el --- calendar functions for the ISO calendar
-;; Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
index e0f85b36d44..2afd0edd70d 100644
--- a/lisp/calendar/cal-julian.el
+++ b/lisp/calendar/cal-julian.el
@@ -1,6 +1,6 @@
;;; cal-julian.el --- calendar functions for the Julian calendar
-;; Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el
index 283c68cb32d..e7a02194101 100644
--- a/lisp/calendar/cal-mayan.el
+++ b/lisp/calendar/cal-mayan.el
@@ -1,6 +1,6 @@
;;; cal-mayan.el --- calendar functions for the Mayan calendars
-;; Copyright (C) 1992-1993, 1995, 1997, 2001-2011
+;; Copyright (C) 1992-1993, 1995, 1997, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Stewart M. Clamen <clamen@cs.cmu.edu>
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
index d8de171c0a1..52c82b661e8 100644
--- a/lisp/calendar/cal-menu.el
+++ b/lisp/calendar/cal-menu.el
@@ -1,6 +1,6 @@
;;; cal-menu.el --- calendar functions for menu bar and popup menu support
-;; Copyright (C) 1994-1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Lara Rios <lrios@coewl.cen.uiuc.edu>
@@ -52,7 +52,7 @@
["Insert Anniversary" diary-insert-anniversary-entry]
["Insert Block" diary-insert-block-entry]
["Insert Cyclic" diary-insert-cyclic-entry]
- ("Insert Baha'i"
+ ("Insert Bahá'í"
["One time" diary-bahai-insert-entry]
["Monthly" diary-bahai-insert-monthly-entry]
["Yearly" diary-bahai-insert-yearly-entry])
@@ -127,7 +127,7 @@
["Astronomical Date" calendar-astro-goto-day-number]
["Hebrew Date" calendar-hebrew-goto-date]
["Persian Date" calendar-persian-goto-date]
- ["Baha'i Date" calendar-bahai-goto-date]
+ ["Bahá'í Date" calendar-bahai-goto-date]
["Islamic Date" calendar-islamic-goto-date]
["Julian Date" calendar-julian-goto-date]
["Chinese Date" calendar-chinese-goto-date]
@@ -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]
@@ -282,4 +283,8 @@ is non-nil."
(provide 'cal-menu)
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
;;; cal-menu.el ends here
diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el
index 72b34beda6b..a6991e4ddd3 100644
--- a/lisp/calendar/cal-move.el
+++ b/lisp/calendar/cal-move.el
@@ -1,6 +1,6 @@
;;; cal-move.el --- calendar functions for movement in the calendar
-;; Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
index a8b3f180e0f..b8313e07704 100644
--- a/lisp/calendar/cal-persia.el
+++ b/lisp/calendar/cal-persia.el
@@ -1,6 +1,6 @@
;;; cal-persia.el --- calendar functions for the Persian calendar
-;; Copyright (C) 1996-1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index 89e265aeb7e..e4c2765940a 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -1,6 +1,6 @@
;;; cal-tex.el --- calendar functions for printing calendars with LaTeX
-;; Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Steve Fisk <fisk@bowdoin.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -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)
@@ -237,31 +236,17 @@ The names are taken from `calendar-day-name-array'.")
"LaTeX code to insert one box with date info in calendar.
This definition is the heart of the calendar!")
-(autoload 'calendar-holiday-list "holidays")
-
-(defun cal-tex-list-holidays (d1 d2)
- "Generate a list of all holidays from absolute date D1 to D2."
- (let* ((start (calendar-gregorian-from-absolute d1))
- (displayed-month (calendar-extract-month start))
- (displayed-year (calendar-extract-year start))
- (end (calendar-gregorian-from-absolute d2))
- (end-month (calendar-extract-month end))
- (end-year (calendar-extract-year end))
- (number-of-intervals
- (1+ (/ (calendar-interval displayed-month displayed-year
- end-month end-year)
- 3)))
- holidays in-range a)
- (calendar-increment-month displayed-month displayed-year 1)
- (dotimes (_idummy number-of-intervals)
- (setq holidays (append holidays (calendar-holiday-list)))
- (calendar-increment-month displayed-month displayed-year 3))
- (dolist (hol holidays)
- (and (car hol)
- (setq a (calendar-absolute-from-gregorian (car hol)))
- (and (<= d1 a) (<= a d2))
- (setq in-range (append (list hol) in-range))))
- in-range))
+(defconst cal-tex-lefthead
+ "\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}\n"
+ "LaTeX code for left header.")
+
+(defconst cal-tex-righthead
+ "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}\n"
+ "LaTeX code for right header.")
+
+(autoload 'holiday-in-range "holidays")
+
+(define-obsolete-function-alias 'cal-tex-list-holidays 'holiday-in-range "24.3")
(autoload 'diary-list-entries "diary-lib")
@@ -275,14 +260,14 @@ This definition is the heart of the calendar!")
"Insert the LaTeX calendar preamble into `cal-tex-buffer'.
Preamble includes initial definitions for various LaTeX commands.
Optional string ARGS are included as options for the article document class."
- ;; FIXME use generate-new-buffer, and adjust cal-tex-end-document.
- (set-buffer (get-buffer-create cal-tex-buffer))
+ (set-buffer (generate-new-buffer cal-tex-buffer))
(insert (format "\\documentclass%s{article}\n"
(if (stringp args)
(format "[%s]" args)
"")))
(if (stringp cal-tex-preamble-extra)
(insert cal-tex-preamble-extra "\n"))
+ ;; FIXME boxwidth and boxheight unused?
(insert "\\hbadness 20000
\\hfuzz=1000pt
\\vbadness 20000
@@ -366,6 +351,54 @@ landscape mode with three rows of four months each."
(run-hooks 'cal-tex-year-hook))
(run-hooks 'cal-tex-hook))
+
+(defun cal-tex-filofax-paper (&optional year)
+ "Insert some page size settings for filofax layouts."
+ (insert "\\textwidth 3.25in
+\\textheight 6.5in
+\\headheight -0.875in
+\\topmargin 0pt
+")
+ (insert
+ ;; Why is this one subtly different? Who knows...
+ (if year "\\oddsidemargin 1.675in
+\\evensidemargin 1.675in
+"
+ "\\oddsidemargin 1.75in
+\\evensidemargin 1.5in
+\\headsep 0.125in
+\\footskip 0.125in
+")))
+
+(defun cal-tex-longday (funcname height)
+ "Insert LaTeX code for a long day function."
+ (insert "\\long\\def\\" funcname "#1#2#3#4#5{%
+ \\rule{\\textwidth}{0.3pt}\\\\%
+ \\hbox to \\textwidth{%
+ \\vbox to " height "{%
+ \\vspace*{2pt}%
+ \\hbox to \\textwidth{"
+ (if (string-equal funcname "leftday")
+ "\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}%\n"
+ "\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%\n")
+ " \\hbox to \\textwidth{\\vbox {\\"
+ (if (string-equal funcname "leftday") "noindent" "raggedleft")
+ " \\footnotesize \\em #4}}%
+ \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}\n"))
+
+(defun cal-tex-shortday (funcname)
+ "Insert LaTeX code for a short day function."
+ (insert "\\long\\def\\" funcname "#1#2#3{%
+ \\rule{\\textwidth}{0.3pt}\\\\%
+ \\hbox to \\textwidth{%
+ \\vbox {%
+ \\vspace*{2pt}%
+ \\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
+ \\hbox to \\textwidth{\\vbox {\\"
+ (if (string-equal funcname "rightday") "raggedleft" "noindent")
+ " \\em #2}}%
+ \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}\n"))
+
;;;###cal-autoload
(defun cal-tex-cursor-filofax-year (&optional n event)
"Make a Filofax one page yearly calendar of year indicated by cursor.
@@ -376,16 +409,11 @@ Optional EVENT indicates a buffer position to use instead of point."
(or n (setq n 1))
(let ((year (calendar-extract-year (calendar-cursor-to-date t event))))
(cal-tex-preamble "twoside")
- (cal-tex-cmd "\\textwidth 3.25in")
- (cal-tex-cmd "\\textheight 6.5in")
- (cal-tex-cmd "\\oddsidemargin 1.675in")
- (cal-tex-cmd "\\evensidemargin 1.675in")
- (cal-tex-cmd "\\topmargin 0pt")
- (cal-tex-cmd "\\headheight -0.875in")
+ (cal-tex-filofax-paper 'year)
(cal-tex-cmd "\\fboxsep 0.5mm")
- (cal-tex-cmd "\\pagestyle{empty}")
+ (cal-tex-cmd "\\pagestyle" "empty")
(cal-tex-b-document)
- (cal-tex-cmd "\\vspace*{0.25in}")
+ (cal-tex-vspace "0.25in")
(dotimes (j n)
(insert (format "\\hfil \\textbf{\\Large %s} \\hfil\\\\\n" year))
(cal-tex-b-center)
@@ -413,7 +441,7 @@ Optional EVENT indicates a buffer position to use instead of point."
(if (= j (1- n))
(cal-tex-end-document)
(cal-tex-newpage)
- (cal-tex-cmd "\\vspace*{0.25in}"))
+ (cal-tex-vspace "0.25in"))
(run-hooks 'cal-tex-year-hook))
(run-hooks 'cal-tex-hook)))
@@ -446,7 +474,7 @@ Optional EVENT indicates a buffer position to use instead of point."
(calendar-last-day-of-month end-month end-year)
end-year))))
(diary-list (if cal-tex-diary (cal-tex-list-diary-entries d1 d2)))
- (holidays (if cal-tex-holidays (cal-tex-list-holidays d1 d2)))
+ (holidays (if cal-tex-holidays (holiday-in-range d1 d2)))
other-month other-year small-months-at-start)
(cal-tex-insert-preamble (cal-tex-number-weeks month year 1) t "12pt")
(cal-tex-cmd cal-tex-cal-one-month)
@@ -516,7 +544,7 @@ indicates a buffer position to use instead of point."
(calendar-last-day-of-month end-month end-year)
end-year))))
(diary-list (if cal-tex-diary (cal-tex-list-diary-entries d1 d2)))
- (holidays (if cal-tex-holidays (cal-tex-list-holidays d1 d2))))
+ (holidays (if cal-tex-holidays (holiday-in-range d1 d2))))
(cal-tex-insert-preamble (cal-tex-number-weeks month year n) nil "12pt")
(if (> n 1)
(cal-tex-cmd cal-tex-cal-multi-month)
@@ -675,15 +703,28 @@ this is only an upper bound."
{\\makebox[2em]{\\rule{0cm}{#2ex}#1}\\rule{3in}{.15mm}}\n"
"One hour and a line on the right.")
+(defun cal-tex-weekly-paper (&optional nomargins)
+ "Insert some page size settings for weekly layouts."
+ (insert "\\textwidth 6.5in
+\\textheight 10.5in
+")
+ (or nomargins (insert "\\oddsidemargin 0in
+\\evensidemargin 0in
+")))
+
;; TODO cal-tex-diary-support.
;; 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))
@@ -697,15 +738,12 @@ entries are not shown). The calendar shows the hours 8-12am, 1-5pm."
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
- (cal-tex-list-holidays d1 d2))))
+ (holiday-in-range d1 d2))))
(cal-tex-preamble "11pt")
- (cal-tex-cmd "\\textwidth 6.5in")
- (cal-tex-cmd "\\textheight 10.5in")
- (cal-tex-cmd "\\oddsidemargin 0in")
- (cal-tex-cmd "\\evensidemargin 0in")
+ (cal-tex-weekly-paper)
(insert cal-tex-LaTeX-hourbox)
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}")
+ (cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(cal-tex-vspace "-1.5in")
(cal-tex-b-center)
@@ -733,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))
@@ -752,15 +793,12 @@ Optional EVENT indicates a buffer position to use instead of point."
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
- (cal-tex-list-holidays d1 d2))))
+ (holiday-in-range d1 d2))))
(cal-tex-preamble "12pt")
- (cal-tex-cmd "\\textwidth 6.5in")
- (cal-tex-cmd "\\textheight 10.5in")
- (cal-tex-cmd "\\oddsidemargin 0in")
- (cal-tex-cmd "\\evensidemargin 0in")
+ (cal-tex-weekly-paper)
(insert cal-tex-LaTeX-hourbox)
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}")
+ (cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(cal-tex-vspace "-1.5in")
(cal-tex-b-center)
@@ -816,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))
@@ -836,20 +877,14 @@ position to use instead of point."
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
- (cal-tex-list-holidays d1 d2)))
+ (holiday-in-range d1 d2)))
(diary-list (if cal-tex-diary
- (cal-tex-list-diary-entries
- ;; FIXME d1?
- (calendar-absolute-from-gregorian (list month 1 year))
- d2)))
+ (cal-tex-list-diary-entries d1 d2)))
s)
(cal-tex-preamble "11pt")
- (cal-tex-cmd "\\textwidth 6.5in")
- (cal-tex-cmd "\\textheight 10.5in")
- (cal-tex-cmd "\\oddsidemargin 0in")
- (cal-tex-cmd "\\evensidemargin 0in")
+ (cal-tex-weekly-paper)
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}")
+ (cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(cal-tex-vspace "-1.5in")
(cal-tex-b-center)
@@ -950,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))
@@ -966,10 +1004,7 @@ to use instead of point."
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event))))))
(cal-tex-preamble "11pt")
- (cal-tex-cmd "\\textwidth 6.5in")
- (cal-tex-cmd "\\textheight 10.5in")
- (cal-tex-cmd "\\oddsidemargin 0in")
- (cal-tex-cmd "\\evensidemargin 0in")
+ (cal-tex-weekly-paper)
(cal-tex-b-document)
(dotimes (i n)
(cal-tex-vspace "-1cm")
@@ -1031,112 +1066,8 @@ shown are hard-coded to 8-12, 13-17."
(cal-tex-e-framebox)
(cal-tex-hspace "1cm")))
-;;;###cal-autoload
-(defun cal-tex-cursor-filofax-2week (&optional n event)
- "Two-weeks-at-a-glance Filofax style calendar for week cursor is in.
-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.
-Optional EVENT indicates a buffer position to use instead of point."
- (interactive (list (prefix-numeric-value current-prefix-arg)
- last-nonmenu-event))
- (or n (setq n 1))
- (let* ((date (calendar-gregorian-from-absolute
- (calendar-dayname-on-or-before
- calendar-week-start-day
- (calendar-absolute-from-gregorian
- (calendar-cursor-to-date t event)))))
- (month (calendar-extract-month date))
- (year (calendar-extract-year date))
- (day (calendar-extract-day date))
- (d1 (calendar-absolute-from-gregorian date))
- (d2 (+ (* 7 n) d1))
- (holidays (if cal-tex-holidays
- (cal-tex-list-holidays d1 d2)))
- (diary-list (if cal-tex-diary
- (cal-tex-list-diary-entries
- ;; FIXME d1?
- (calendar-absolute-from-gregorian (list month 1 year))
- d2))))
- (cal-tex-preamble "twoside")
- (cal-tex-cmd "\\textwidth 3.25in")
- (cal-tex-cmd "\\textheight 6.5in")
- (cal-tex-cmd "\\oddsidemargin 1.75in")
- (cal-tex-cmd "\\evensidemargin 1.5in")
- (cal-tex-cmd "\\topmargin 0pt")
- (cal-tex-cmd "\\headheight -0.875in")
- (cal-tex-cmd "\\headsep 0.125in")
- (cal-tex-cmd "\\footskip .125in")
- (insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}
-\\long\\def\\rightday#1#2#3#4#5{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox to 0.7in{%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%
- \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%
- \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
-\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}
-\\long\\def\\leftday#1#2#3#4#5{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox to 0.7in{%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize \\em #4}}%
- \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
-")
- (cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}")
- (dotimes (i n)
- (if (zerop (mod i 2))
- (insert "\\righthead")
- (insert "\\lefthead"))
- (cal-tex-arg
- (let ((d (cal-tex-incr-date date 6)))
- (if (= (calendar-extract-month date)
- (calendar-extract-month d))
- (format "%s %s"
- (cal-tex-month-name (calendar-extract-month date))
- (calendar-extract-year date))
- (if (= (calendar-extract-year date)
- (calendar-extract-year d))
- (format "%s---%s %s"
- (cal-tex-month-name (calendar-extract-month date))
- (cal-tex-month-name (calendar-extract-month d))
- (calendar-extract-year date))
- (format "%s %s---%s %s"
- (cal-tex-month-name (calendar-extract-month date))
- (calendar-extract-year date)
- (cal-tex-month-name (calendar-extract-month d))
- (calendar-extract-year d))))))
- (insert "%\n")
- (dotimes (_jdummy 7)
- (if (zerop (mod i 2))
- (insert "\\rightday")
- (insert "\\leftday"))
- (cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
- (cal-tex-arg (number-to-string (calendar-extract-day date)))
- (cal-tex-arg (cal-tex-latexify-list diary-list date))
- (cal-tex-arg (cal-tex-latexify-list holidays date))
- (cal-tex-arg (eval cal-tex-daily-string))
- (insert "%\n")
- (setq date (cal-tex-incr-date date)))
- (unless (= i (1- n))
- (run-hooks 'cal-tex-week-hook)
- (cal-tex-newpage)))
- (cal-tex-end-document)
- (run-hooks 'cal-tex-hook)))
-
-;;;###cal-autoload
-(defun cal-tex-cursor-filofax-week (&optional n event)
- "One-week-at-a-glance Filofax style 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.
-Optional EVENT indicates a buffer position to use instead of point."
- (interactive (list (prefix-numeric-value current-prefix-arg)
- last-nonmenu-event))
+(defun cal-tex-weekly-common (n event &optional filofax)
+ "Common code for weekly calendars."
(or n (setq n 1))
(let* ((date (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before
@@ -1149,50 +1080,40 @@ Optional EVENT indicates a buffer position to use instead of point."
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
- (cal-tex-list-holidays d1 d2)))
+ (holiday-in-range d1 d2)))
(diary-list (if cal-tex-diary
- (cal-tex-list-diary-entries
- ;; FIXME d1?
- (calendar-absolute-from-gregorian (list month 1 year))
- d2))))
- (cal-tex-preamble "twoside")
- (cal-tex-cmd "\\textwidth 3.25in")
- (cal-tex-cmd "\\textheight 6.5in")
- (cal-tex-cmd "\\oddsidemargin 1.75in")
- (cal-tex-cmd "\\evensidemargin 1.5in")
- (cal-tex-cmd "\\topmargin 0pt")
- (cal-tex-cmd "\\headheight -0.875in")
- (cal-tex-cmd "\\headsep 0.125in")
- (cal-tex-cmd "\\footskip .125in")
- (insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}
-\\long\\def\\rightday#1#2#3#4#5{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox to 1.85in{%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%
- \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%
- \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
-\\long\\def\\weekend#1#2#3#4#5{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox to .8in{%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%
- \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%
- \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
-\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}
-\\long\\def\\leftday#1#2#3#4#5{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox to 1.85in{%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize \\em #4}}%
- \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
+ (cal-tex-list-diary-entries d1 d2))))
+ (if filofax
+ (progn
+ (cal-tex-preamble "twoside")
+ (cal-tex-filofax-paper)
+ (insert cal-tex-righthead)
+ (cal-tex-longday "rightday" "1.85in")
+ (cal-tex-longday "weekend" "0.8in")
+ (insert cal-tex-lefthead)
+ (cal-tex-longday "leftday" "1.85in"))
+ (cal-tex-preamble "twoside,12pt")
+ (insert "\\textwidth 7in
+\\textheight 10.5in
+\\oddsidemargin 0in
+\\evensidemargin 0in
+\\topmargin 0pt
+\\headheight -0.875in
+\\headsep 0.125in
+\\footskip .125in
")
+ (insert cal-tex-righthead)
+ (cal-tex-longday "rightday" "2.75in")
+ (cal-tex-longday "weekend" "1.8in")
+ (insert cal-tex-lefthead)
+ (cal-tex-longday "leftday" "2.75in"))
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}\\ ")
+ (cal-tex-cmd "\\pagestyle" "empty")
+ ;; 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
+ ;; versions of various functions as applicable to even and odd pages.
(cal-tex-newpage)
(dotimes (i n)
(insert "\\lefthead")
@@ -1225,12 +1146,35 @@ Optional EVENT indicates a buffer position to use instead of point."
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n")
+ (unless filofax
+ (cal-tex-nl)
+ (insert (cal-tex-mini-calendar
+ (calendar-extract-month (cal-tex-previous-month date))
+ (calendar-extract-year (cal-tex-previous-month date))
+ "lastmonth" "1.1in" "1in"))
+ (insert (cal-tex-mini-calendar
+ (calendar-extract-month date)
+ (calendar-extract-year date)
+ "thismonth" "1.1in" "1in"))
+ (insert (cal-tex-mini-calendar
+ (calendar-extract-month (cal-tex-next-month date))
+ (calendar-extract-year (cal-tex-next-month date))
+ "nextmonth" "1.1in" "1in"))
+ (insert "\\hbox to \\textwidth{")
+ (cal-tex-hfill)
+ (insert "\\lastmonth")
+ (cal-tex-hfill)
+ (insert "\\thismonth")
+ (cal-tex-hfill)
+ (insert "\\nextmonth")
+ (cal-tex-hfill)
+ (insert "}"))
(cal-tex-newpage)
(insert "\\righthead")
(cal-tex-arg
(let ((d (cal-tex-incr-date date 3)))
(if (= (calendar-extract-month date)
- (calendar-extract-month d))
+ (calendar-extract-month d))
(format "%s %s"
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date))
@@ -1271,6 +1215,104 @@ Optional EVENT indicates a buffer position to use instead of point."
(run-hooks 'cal-tex-hook)))
;;;###cal-autoload
+(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))
+
+;;;###cal-autoload
+(defun cal-tex-cursor-filofax-2week (&optional n event)
+ "Two-weeks-at-a-glance Filofax style calendar for week cursor is in.
+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.
+Optional EVENT indicates a buffer position to use instead of point."
+ (interactive (list (prefix-numeric-value current-prefix-arg)
+ last-nonmenu-event))
+ (or n (setq n 1))
+ (let* ((date (calendar-gregorian-from-absolute
+ (calendar-dayname-on-or-before
+ calendar-week-start-day
+ (calendar-absolute-from-gregorian
+ (calendar-cursor-to-date t event)))))
+ (month (calendar-extract-month date))
+ (year (calendar-extract-year date))
+ (day (calendar-extract-day date))
+ (d1 (calendar-absolute-from-gregorian date))
+ (d2 (+ (* 7 n) d1))
+ (holidays (if cal-tex-holidays
+ (holiday-in-range d1 d2)))
+ (diary-list (if cal-tex-diary
+ (cal-tex-list-diary-entries d1 d2))))
+ (cal-tex-preamble "twoside")
+ (cal-tex-filofax-paper)
+ (insert cal-tex-righthead)
+ (cal-tex-longday "rightday" "0.7in")
+ (insert cal-tex-lefthead)
+ (cal-tex-longday "leftday" "0.7in")
+ (cal-tex-b-document)
+ (cal-tex-cmd "\\pagestyle" "empty")
+ (dotimes (i n)
+ (if (zerop (mod i 2))
+ (insert "\\righthead")
+ (insert "\\lefthead"))
+ (cal-tex-arg
+ (let ((d (cal-tex-incr-date date 6)))
+ (if (= (calendar-extract-month date)
+ (calendar-extract-month d))
+ (format "%s %s"
+ (cal-tex-month-name (calendar-extract-month date))
+ (calendar-extract-year date))
+ (if (= (calendar-extract-year date)
+ (calendar-extract-year d))
+ (format "%s---%s %s"
+ (cal-tex-month-name (calendar-extract-month date))
+ (cal-tex-month-name (calendar-extract-month d))
+ (calendar-extract-year date))
+ (format "%s %s---%s %s"
+ (cal-tex-month-name (calendar-extract-month date))
+ (calendar-extract-year date)
+ (cal-tex-month-name (calendar-extract-month d))
+ (calendar-extract-year d))))))
+ (insert "%\n")
+ (dotimes (_jdummy 7)
+ (if (zerop (mod i 2))
+ (insert "\\rightday")
+ (insert "\\leftday"))
+ (cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
+ (cal-tex-arg (number-to-string (calendar-extract-day date)))
+ (cal-tex-arg (cal-tex-latexify-list diary-list date))
+ (cal-tex-arg (cal-tex-latexify-list holidays date))
+ (cal-tex-arg (eval cal-tex-daily-string))
+ (insert "%\n")
+ (setq date (cal-tex-incr-date date)))
+ (unless (= i (1- n))
+ (run-hooks 'cal-tex-week-hook)
+ (cal-tex-newpage)))
+ (cal-tex-end-document)
+ (run-hooks 'cal-tex-hook)))
+
+;;;###cal-autoload
+(defun cal-tex-cursor-filofax-week (&optional n event)
+ "One-week-at-a-glance Filofax style 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.
+Optional EVENT indicates a buffer position to use instead of point."
+ (interactive (list (prefix-numeric-value current-prefix-arg)
+ last-nonmenu-event))
+ (cal-tex-weekly-common n event t))
+
+;;;###cal-autoload
(defun cal-tex-cursor-filofax-daily (&optional n event)
"Day-per-page Filofax style calendar for week indicated by cursor.
Optional prefix argument N specifies number of weeks (default 1),
@@ -1292,54 +1334,23 @@ Optional EVENT indicates a buffer position to use instead of point."
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
- (cal-tex-list-holidays d1 d2)))
+ (holiday-in-range d1 d2)))
(diary-list (if cal-tex-diary
- (cal-tex-list-diary-entries
- ;; FIXME d1?
- (calendar-absolute-from-gregorian (list month 1 year))
- d2))))
+ (cal-tex-list-diary-entries d1 d2))))
(cal-tex-preamble "twoside")
- (cal-tex-cmd "\\textwidth 3.25in")
- (cal-tex-cmd "\\textheight 6.5in")
- (cal-tex-cmd "\\oddsidemargin 1.75in")
- (cal-tex-cmd "\\evensidemargin 1.5in")
- (cal-tex-cmd "\\topmargin 0pt")
- (cal-tex-cmd "\\headheight -0.875in")
- (cal-tex-cmd "\\headsep 0.125in")
- (cal-tex-cmd "\\footskip .125in")
- (insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}
-\\long\\def\\rightday#1#2#3{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox {%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
- \\hbox to \\textwidth{\\vbox {\\raggedleft \\em #2}}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
-\\long\\def\\weekend#1#2#3{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox {%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\em #2}}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
-\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}
-\\long\\def\\leftday#1#2#3{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox {%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\em #2}}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
-\\newbox\\LineBox
+ (cal-tex-filofax-paper)
+ (insert cal-tex-righthead)
+ (cal-tex-shortday "rightday")
+ (cal-tex-shortday "weekend")
+ (insert cal-tex-lefthead)
+ (cal-tex-shortday "leftday")
+ (insert "\\newbox\\LineBox
\\setbox\\LineBox=\\hbox to\\textwidth{%
\\vrule height.2in width0pt\\leaders\\hrule\\hfill}
\\def\\linesfill{\\par\\leaders\\copy\\LineBox\\vfill}
")
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}")
+ (cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(dotimes (j 4)
(let ((even (zerop (% j 2))))
@@ -1399,10 +1410,9 @@ a buffer position to use instead of point."
(let ((date (calendar-absolute-from-gregorian
(calendar-cursor-to-date t event))))
(cal-tex-preamble "12pt")
- (cal-tex-cmd "\\textwidth 6.5in")
- (cal-tex-cmd "\\textheight 10.5in")
+ (cal-tex-weekly-paper 'nomargins)
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}")
+ (cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(cal-tex-vspace "-1.7in")
(cal-tex-daily-page (calendar-gregorian-from-absolute date))
@@ -1588,8 +1598,7 @@ informative header, and run HOOK."
(cal-tex-e-document)
(or (and cal-tex-preamble-extra
(string-match "inputenc" cal-tex-preamble-extra))
- (not (re-search-backward "[^[:ascii:]]" nil 'move))
- (progn
+ (when (re-search-backward "[^[:ascii:]]" nil 'move)
(goto-char (point-min))
(when (search-forward "documentclass" nil t)
(forward-line 1)
@@ -1597,7 +1606,7 @@ informative header, and run HOOK."
;; FIXME latin1 might not always be right.
(insert "\\usepackage[latin1]{inputenc}\n"))))
(latex-mode)
- (pop-to-buffer cal-tex-buffer)
+ (pop-to-buffer (current-buffer))
(goto-char (point-min))
;; FIXME auctex equivalents?
(cal-tex-comment
@@ -1622,16 +1631,16 @@ non-nil, means add to end of buffer without erasing current contents."
(if (not landscape)
(progn
(cal-tex-cmd "\\oddsidemargin -1.75cm")
- (cal-tex-cmd "\\def\\holidaymult{.06}"))
- (cal-tex-cmd "\\special{landscape}")
+ (cal-tex-cmd "\\def\\holidaymult" ".06"))
+ (cal-tex-cmd "\\special" "landscape")
(cal-tex-cmd "\\textwidth 9.5in")
(cal-tex-cmd "\\textheight 7in")
(cal-tex-comment)
- (cal-tex-cmd "\\def\\holidaymult{.08}"))
+ (cal-tex-cmd "\\def\\holidaymult" ".08"))
(cal-tex-cmd cal-tex-caldate)
(cal-tex-cmd cal-tex-myday)
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}"))
+ (cal-tex-cmd "\\pagestyle" "empty"))
(cal-tex-cmd "\\setlength{\\cellwidth}" width)
(insert (format "\\setlength{\\cellwidth}{%f\\cellwidth}\n"
(/ 1.1 (length cal-tex-which-days))))
@@ -1694,13 +1703,11 @@ non-nil, means add to end of buffer without erasing current contents."
(defun cal-tex-vspace (space)
"Insert vspace command to move SPACE vertically."
- (insert "\\vspace*{" space "}")
- (cal-tex-comment))
+ (cal-tex-cmd "\\vspace*" space))
(defun cal-tex-hspace (space)
"Insert hspace command to move SPACE horizontally."
- (insert "\\hspace*{" space "}")
- (cal-tex-comment))
+ (cal-tex-cmd "\\hspace*" space))
(defun cal-tex-comment (&optional comment)
"Insert `% ', followed by optional string COMMENT, followed by newline.
@@ -1739,20 +1746,20 @@ Add trailing COMMENT if present."
(defun cal-tex-b-document ()
"Insert beginning of document."
- (cal-tex-cmd "\\begin{document}"))
+ (cal-tex-cmd "\\begin" "document"))
(defun cal-tex-e-document ()
"Insert end of document."
- (cal-tex-cmd "\\end{document}"))
+ (cal-tex-cmd "\\end" "document"))
(defun cal-tex-b-center ()
"Insert beginning of centered block."
- (cal-tex-cmd "\\begin{center}"))
+ (cal-tex-cmd "\\begin" "center"))
(defun cal-tex-e-center ()
"Insert end of centered block."
(cal-tex-comment)
- (cal-tex-cmd "\\end{center}"))
+ (cal-tex-cmd "\\end" "center"))
;;;
@@ -1807,35 +1814,35 @@ Add trailing COMMENT if present."
(defun cal-tex-em (string)
"Insert STRING in italic font."
- (insert "\\textit{" string "}"))
+ (cal-tex-cmd "\\textit" string))
(defun cal-tex-bf (string)
"Insert STRING in bf font."
- (insert "\\textbf{ " string "}"))
+ (cal-tex-cmd "\\textbf" string))
(defun cal-tex-scriptsize (string)
"Insert STRING in scriptsize font."
- (insert "{\\scriptsize " string "}"))
+ (cal-tex-arg (concat "\\scriptsize " string)))
(defun cal-tex-huge (string)
"Insert STRING in huge font."
- (insert "{\\huge " string "}"))
+ (cal-tex-arg (concat "\\huge " string)))
(defun cal-tex-Huge (string)
"Insert STRING in Huge font."
- (insert "{\\Huge " string "}"))
+ (cal-tex-arg (concat "\\Huge " string)))
(defun cal-tex-Huge-bf (string)
"Insert STRING in Huge bf font."
- (insert "\\textbf{\\Huge " string "}"))
+ (cal-tex-cmd "\\textbf" (concat "\\Huge " string)))
(defun cal-tex-large (string)
"Insert STRING in large font."
- (insert "{\\large " string "}"))
+ (cal-tex-arg (concat "\\large " string)))
(defun cal-tex-large-bf (string)
"Insert STRING in large bf font."
- (insert "\\textbf{\\large " string "}"))
+ (cal-tex-cmd "\\textbf" (concat "\\large " string)))
(provide 'cal-tex)
diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el
index e95d284a36b..6fba7fb7423 100644
--- a/lisp/calendar/cal-x.el
+++ b/lisp/calendar/cal-x.el
@@ -1,6 +1,6 @@
;;; cal-x.el --- calendar windows in dedicated frames
-;; Copyright (C) 1994-1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -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 a59e28811d3..02d1e3b54e9 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1,6 +1,6 @@
;;; calendar.el --- calendar functions
-;; Copyright (C) 1988-1995, 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988-1995, 1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
@@ -41,7 +41,7 @@
;; can be translated from the (usual) Gregorian calendar to the day of
;; the year/days remaining in year, to the ISO commercial calendar, to
;; the Julian (old style) calendar, to the Hebrew calendar, to the
-;; Islamic calendar, to the Baha'i calendar, to the French
+;; Islamic calendar, to the Bahá'í calendar, to the French
;; Revolutionary calendar, to the Mayan calendar, to the Chinese
;; calendar, to the Coptic calendar, to the Ethiopic calendar, and to
;; the astronomical (Julian) day number. Times of sunrise/sunset can
@@ -52,7 +52,7 @@
;; The following files are part of the calendar/diary code:
;; appt.el Appointment notification
-;; cal-bahai.el Baha'i calendar
+;; cal-bahai.el Bahá'í calendar
;; cal-china.el Chinese calendar
;; cal-coptic.el Coptic/Ethiopic calendars
;; cal-dst.el Daylight saving time rules
@@ -511,7 +511,7 @@ Must be at least one less than `calendar-column-width'."
:version "23.1")
(defcustom calendar-intermonth-header nil
- "Header text display in the space to the left of each calendar month.
+ "Header text to display in the space to the left of each calendar month.
See `calendar-intermonth-text'."
:group 'calendar
:initialize 'custom-initialize-default
@@ -593,7 +593,7 @@ You can customize `diary-date-forms' to your preferred format.
Three default styles are provided: `diary-american-date-forms',
`diary-european-date-forms', and `diary-iso-date-forms'.
You can choose between these by setting `calendar-date-style' in your
-.emacs file, or by using `calendar-set-date-style' when in the calendar.
+init file, or by using `calendar-set-date-style' when in the calendar.
A diary entry can be preceded by the character `diary-nonmarking-symbol'
\(ordinarily `&') to make that entry nonmarking--that is, it will not be
@@ -642,7 +642,7 @@ causes the diary entry \"Vacation\" to appear from November 1 through
November 10, 1990. See the documentation for the function
`diary-list-sexp-entries' for more details.
-Diary entries based on the Hebrew, the Islamic and/or the Baha'i
+Diary entries based on the Hebrew, the Islamic and/or the Bahá'í
calendar are also possible, but because these are somewhat slow, they
are ignored unless you set the `diary-nongregorian-listing-hook' and
the `diary-nongregorian-marking-hook' appropriately. See the
@@ -679,7 +679,7 @@ details, see the documentation for the variable `diary-list-entries-hook'."
'diary-bahai-entry-symbol "23.1")
(defcustom diary-bahai-entry-symbol "B"
- "Symbol indicating a diary entry according to the Baha'i calendar."
+ "Symbol indicating a diary entry according to the Bahá'í calendar."
:type 'string
:group 'diary)
@@ -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")
@@ -1005,9 +1064,9 @@ calendar."
'calendar-bahai-all-holidays-flag "23.1")
(defcustom calendar-bahai-all-holidays-flag nil
- "If nil, show only major holidays from the Baha'i calendar.
+ "If nil, show only major holidays from the Bahá'í calendar.
These are the days on which work and school must be suspended.
-Otherwise, show all the holidays that would appear in a complete Baha'i
+Otherwise, show all the holidays that would appear in a complete Bahá'í
calendar."
:type 'boolean
:group 'holidays)
@@ -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)))
@@ -1105,14 +1163,14 @@ inclusive. The standard macro `dotimes' is preferable in most cases."
,index (1+ ,index)))
sum))
-;; FIXME bind q to bury-buffer?
(defmacro calendar-in-read-only-buffer (buffer &rest body)
- "Switch to BUFFER and executes the forms in BODY.
+ "Switch to BUFFER and execute the forms in BODY.
First creates or erases BUFFER as needed. Leaves BUFFER read-only,
with disabled undo. Leaves point at point-min, displays BUFFER."
(declare (indent 1) (debug t))
`(progn
(set-buffer (get-buffer-create ,buffer))
+ (or (derived-mode-p 'special-mode) (special-mode))
(setq buffer-read-only nil
buffer-undo-list t)
(erase-buffer)
@@ -1276,7 +1334,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."
(interactive "P")
;; Avoid loading cal-x unless it will be used.
(if (and (memq calendar-setup '(one-frame two-frames calendar-only))
@@ -1424,16 +1482,24 @@ Optional integers MON and YR are used instead of today's date."
"Move to column INDENT, adding spaces as needed.
Inserts STRING so that it ends at INDENT. STRING is either a
literal string, or a sexp to evaluate to return such. Truncates
-STRING to length TRUNCATE, ensure a trailing space."
+STRING to length TRUNCATE, and ensures a trailing space."
(if (not (ignore-errors (stringp (setq string (eval string)))))
(calendar-move-to-column indent)
- (if (> (length string) truncate)
- (setq string (substring string 0 truncate)))
+ (if (> (string-width string) truncate)
+ (setq string (truncate-string-to-width string truncate)))
(or (string-match " $" string)
- (if (= (length string) truncate)
- (aset string (1- truncate) ?\s)
- (setq string (concat string " "))))
- (calendar-move-to-column (- indent (length string)))
+ (setq string (concat (if (= (string-width string) truncate)
+ (substring string 0 -1)
+ string)
+ ;; Avoid inserting text properties unless
+ ;; we have to (ie, non-unit-width chars).
+ ;; This is by no means essential.
+ (if (= (string-width string) (length string))
+ " "
+ ;; Cribbed from buff-menu.el.
+ (propertize
+ " " 'display `(space :align-to ,indent))))))
+ (calendar-move-to-column (- indent (string-width string)))
(insert string)))
(defun calendar-generate-month (month year indent)
@@ -1455,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.
@@ -1618,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)
@@ -1730,6 +1796,7 @@ For a complete description, see the info node `Calendar/Diary'.
(setq buffer-read-only t
buffer-undo-list t
indent-tabs-mode nil)
+ (set (make-local-variable 'scroll-margin) 0) ; bug#10379
(calendar-update-mode-line)
(make-local-variable 'calendar-mark-ring)
(make-local-variable 'displayed-month) ; month in middle of window
@@ -1755,8 +1822,8 @@ the STRINGS are just concatenated and the result truncated."
(if (< (length strings) 2)
(append (list "") strings (list ""))
strings)))
- (n (- length (length (apply 'concat strings))))
- (m (1- (length strings)))
+ (n (- length (string-width (apply 'concat strings))))
+ (m (* (1- (length strings)) (char-width char)))
(s (car strings))
(strings (cdr strings))
(i 0))
@@ -1765,7 +1832,7 @@ the STRINGS are just concatenated and the result truncated."
(make-string (max 0 (/ (+ n i) m)) char)
string)
i (1+ i)))
- (substring s 0 length)))
+ (truncate-string-to-width s length)))
(defun calendar-update-mode-line ()
"Update the calendar mode line with the current date and date style."
@@ -1784,19 +1851,6 @@ the STRINGS are just concatenated and the result truncated."
?\s (- calendar-right-margin (1- start))))))
(force-mode-line-update))))
-(defun calendar-window-list ()
- "List of all calendar-related windows."
- (let ((calendar-buffers (calendar-buffer-list))
- list)
- ;; Using 0 rather than t for last argument - see bug#2199.
- ;; This is only used with calendar-hide-window, which ignores
- ;; iconified frames anyway, so could use 'visible rather than 0.
- (walk-windows (lambda (w)
- (if (memq (window-buffer w) calendar-buffers)
- (push w list)))
- nil 0)
- list))
-
(defun calendar-buffer-list ()
"List of all calendar-related buffers (as buffers, not strings)."
(let (buffs)
@@ -1808,41 +1862,30 @@ the STRINGS are just concatenated and the result truncated."
(push b buffs)))
buffs))
-(defun calendar-exit ()
+(defun calendar-exit (&optional kill)
"Get out of the calendar window and hide it and related buffers."
- (interactive)
- (let ((diary-buffer (get-file-buffer diary-file)))
- (if (or (not diary-buffer)
- (not (buffer-modified-p diary-buffer))
- (yes-or-no-p
- "Diary modified; do you really want to exit the calendar? "))
- ;; Need to do this multiple times because one time can replace some
- ;; calendar-related buffers with other calendar-related buffers.
- (mapc (lambda (x)
- (mapc 'calendar-hide-window (calendar-window-list)))
- (calendar-window-list)))))
+ (interactive "P")
+ (let ((diary-buffer (get-file-buffer diary-file))
+ (calendar-buffers (calendar-buffer-list)))
+ (when (or (not diary-buffer)
+ (not (buffer-modified-p diary-buffer))
+ (yes-or-no-p
+ "Diary modified; do you really want to exit the calendar? "))
+ (if (and calendar-setup (display-multi-frame-p))
+ ;; FIXME: replace this cruft with the `quit-restore' window property
+ (dolist (w (window-list-1 nil nil t))
+ (if (and (memq (window-buffer w) calendar-buffers)
+ (window-dedicated-p w))
+ (if (eq (window-deletable-p w) 'frame)
+ (if calendar-remove-frame-by-deleting
+ (delete-frame (window-frame w))
+ (iconify-frame (window-frame w)))
+ (quit-window kill w))))
+ (dolist (b calendar-buffers)
+ (quit-windows-on b kill))))))
(define-obsolete-function-alias 'exit-calendar 'calendar-exit "23.1")
-(defun calendar-hide-window (window)
- "Hide WINDOW if it is calendar-related."
- (let ((buffer (if (window-live-p window) (window-buffer window))))
- (if (memq buffer (calendar-buffer-list))
- (cond
- ((and (display-multi-frame-p)
- (eq 'icon (cdr (assoc 'visibility
- (frame-parameters
- (window-frame window))))))
- nil)
- ((and (display-multi-frame-p) (window-dedicated-p window))
- (if calendar-remove-frame-by-deleting
- (delete-frame (window-frame window))
- (iconify-frame (window-frame window))))
- ((not (and (select-window window) (one-window-p window)))
- (delete-window window))
- (t (set-buffer buffer)
- (bury-buffer))))))
-
(defun calendar-current-date (&optional offset)
"Return the current date in a list (month day year).
Optional integer OFFSET is a number of days from the current date."
@@ -1879,7 +1922,7 @@ use instead of point."
;; or on or before the digit of a 1-digit date.
(if (not (and (looking-at "[ 0-9]?[0-9][^0-9]")
(get-text-property (point) 'date)))
- (if error (error "Not on a date!"))
+ (if error (user-error "Not on a date!"))
;; Convert segment to real month and year.
(if (zerop month) (setq month 12))
;; Go back to before the first date digit.
@@ -1894,8 +1937,6 @@ use instead of point."
((and (= 1 month) (= segment 2)) (1+ displayed-year))
(t displayed-year))))))))
-(add-to-list 'debug-ignored-errors "Not on a date!")
-
;; The following version of calendar-gregorian-from-absolute is preferred for
;; reasons of clarity, BUT it's much slower than the version that follows it.
@@ -2239,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)
@@ -2252,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)
@@ -2551,7 +2595,7 @@ DATE is (month day year). Calendars that do not apply are omitted."
(unless (string-equal
(setq odate (calendar-bahai-date-string date))
"")
- (format "Baha'i date: %s" odate))
+ (format "Bahá'í date: %s" odate))
(format "Chinese date: %s"
(calendar-chinese-date-string date))
(unless (string-equal
@@ -2601,7 +2645,7 @@ If called by a mouse-event, pops up a menu with the result."
;; If no frame exists yet, we have no idea what width to use.
(and (= width 10)
(not window-system)
- (setq width (or (getenv "COLUMNS") 80)))
+ (setq width (string-to-number (or (getenv "COLUMNS") "80"))))
(setq mode-line-format
(if buffer-file-name
`("-" mode-line-modified
@@ -2609,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)
@@ -2623,6 +2661,7 @@ If called by a mouse-event, pops up a menu with the result."
;; Local variables:
;; byte-compile-dynamic: t
+;; coding: utf-8
;; End:
;;; calendar.el ends here
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index d161602bec0..27c6f76581c 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -1,6 +1,6 @@
;;; diary-lib.el --- diary functions
-;; Copyright (C) 1989-1990, 1992-1995, 2001-2011
+;; Copyright (C) 1989-1990, 1992-1995, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -200,19 +200,21 @@ holidays), or hard copy output."
'diary-list-entries-hook "23.1")
(defcustom diary-list-entries-hook nil
- "List of functions called after diary file is culled for relevant entries.
-You might wish to add `diary-include-other-diary-files', in which case
-you will probably also want to add `diary-mark-included-diary-files' to
-`diary-mark-entries-hook'. For example, you could use
+ "Hook run after diary file is culled for relevant entries.
+
+If you add `diary-include-other-diary-files' to this hook, you
+will probably also want to add `diary-mark-included-diary-files'
+to `diary-mark-entries-hook'. For example, to cause the fancy
+diary buffer to be displayed with diary entries from various
+included files, each day's entries sorted into lexicographic
+order, add the following to your init file:
(setq diary-display-function 'diary-fancy-display)
(add-hook 'diary-list-entries-hook 'diary-include-other-diary-files)
(add-hook 'diary-list-entries-hook 'diary-sort-entries t)
-in your `.emacs' file to cause the fancy diary buffer to be displayed with
-diary entries from various included files, each day's entries sorted into
-lexicographic order. Note how the sort function is placed last,
-so that it can sort the entries included from other files.
+Note how the sort function is placed last, so that it can sort
+the entries included from other files.
This hook runs after `diary-nongregorian-listing-hook'. These two hooks
differ only if you are using included diary files. In that case,
@@ -337,7 +339,7 @@ expressions that can involve the keywords `days' (a number), `date'
(defcustom diary-abbreviated-year-flag t
"Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.
-This applies to the Gregorian, Hebrew, Islamic, and Baha'i calendars.
+This applies to the Gregorian, Hebrew, Islamic, and Bahá'í calendars.
When the current century is added to a two-digit year, if the result
is more than 50 years in the future, the previous century is assumed.
If the result is more than 50 years in the past, the next century is assumed.
@@ -532,7 +534,7 @@ If so, return the expanded file name, otherwise signal an error."
"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."
(interactive "P")
(diary-check-diary-file)
(diary-list-entries (calendar-current-date)
@@ -951,12 +953,12 @@ This is recursive; that is, included files may include other files."
(setq diary-entries-list
(append diary-entries-list
(diary-list-entries original-date number t)))))
- (beep)
- (message "Can't read included diary file %s" diary-file)
- (sleep-for 2))
- (beep)
- (message "Can't find included diary file %s" diary-file)
- (sleep-for 2))))
+ (display-warning
+ :error
+ (format "Can't read included diary file %s\n" diary-file)))
+ (display-warning
+ :error
+ (format "Can't find included diary file %s\n" diary-file)))))
(goto-char (point-min)))
(defun diary-include-other-diary-files ()
@@ -1230,8 +1232,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
@@ -1456,14 +1458,17 @@ marks. This is intended to deal with deleted diary entries."
(let ((result (if calendar-debug-sexp
(let ((debug-on-error t))
(eval (car (read-from-string sexp))))
- (condition-case nil
- (eval (car (read-from-string sexp)))
- (error
- (beep)
- (message "Bad sexp at line %d in %s: %s"
- (count-lines (point-min) (point))
- diary-file sexp)
- (sleep-for 2))))))
+ (let (err)
+ (condition-case err
+ (eval (car (read-from-string sexp)))
+ (error
+ (display-warning
+ :error
+ (format "Bad diary sexp at line %d in %s:\n%s\n\
+Error: %s\n"
+ (count-lines (point-min) (point))
+ diary-file sexp err))
+ nil))))))
(cond ((stringp result) result)
((and (consp result)
(stringp (cdr result))) result)
@@ -2395,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
@@ -2406,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
@@ -2477,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)
@@ -2624,4 +2629,8 @@ user is asked to confirm its addition."
(provide 'diary-lib)
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
;;; diary-lib.el ends here
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 42c95f39faa..b94815f98ea 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -1,6 +1,6 @@
;;; holidays.el --- holiday functions for the calendar package
-;; Copyright (C) 1989-1990, 1992-1994, 1997, 2001-2011
+;; Copyright (C) 1989-1990, 1992-1994, 1997, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -250,7 +250,7 @@ See the documentation for `calendar-holidays' for details."
(if calendar-christian-all-holidays-flag
(append
(holiday-fixed 1 6 "Epiphany")
- (holiday-julian 12 25 "Eastern Orthodox Christmas")
+ (holiday-julian 12 25 "Christmas (Julian calendar)")
(holiday-greek-orthodox-easter)
(holiday-fixed 8 15 "Assumption")
(holiday-advent 0 "Advent")))))
@@ -292,16 +292,16 @@ See the documentation for `calendar-holidays' for details."
(mapcar 'purecopy
'((holiday-bahai-new-year)
(holiday-bahai-ridvan) ; respects calendar-bahai-all-holidays-flag
- (holiday-fixed 5 23 "Declaration of the Bab")
- (holiday-fixed 5 29 "Ascension of Baha'u'llah")
- (holiday-fixed 7 9 "Martyrdom of the Bab")
- (holiday-fixed 10 20 "Birth of the Bab")
- (holiday-fixed 11 12 "Birth of Baha'u'llah")
+ (holiday-fixed 5 23 "Declaration of the Báb")
+ (holiday-fixed 5 29 "Ascension of Bahá'u'lláh")
+ (holiday-fixed 7 9 "Martyrdom of the Báb")
+ (holiday-fixed 10 20 "Birth of the Báb")
+ (holiday-fixed 11 12 "Birth of Bahá'u'lláh")
(if calendar-bahai-all-holidays-flag
(append
(holiday-fixed 11 26 "Day of the Covenant")
- (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha")))))
- "Baha'i holidays.
+ (holiday-fixed 11 28 "Ascension of `Abdu'l-Bahá")))))
+ "Bahá'í holidays.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
@@ -343,12 +343,12 @@ See the documentation for `calendar-holidays' for details."
"List of notable days for the command \\[holidays].
Additional holidays are easy to add to the list, just put them in the
-list `holiday-other-holidays' in your .emacs file. Similarly, by setting
+list `holiday-other-holidays' in your init file. Similarly, by setting
any of `holiday-general-holidays', `holiday-local-holidays',
`holiday-christian-holidays', `holiday-hebrew-holidays',
`holiday-islamic-holidays', `holiday-bahai-holidays',
`holiday-oriental-holidays', or `holiday-solar-holidays' to nil in your
-.emacs file, you can eliminate unwanted categories of holidays.
+init file, you can eliminate unwanted categories of holidays.
The aforementioned variables control the holiday choices offered
by the function `holiday-list' when it is called interactively.
@@ -376,7 +376,7 @@ Several basic functions are provided for this purpose:
K>0, and MONTH's last day otherwise.
(holiday-hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar
(holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar
- (holiday-bahai MONTH DAY STRING) a fixed date on the Baha'i calendar
+ (holiday-bahai MONTH DAY STRING) a fixed date on the Bahá'í calendar
(holiday-julian MONTH DAY STRING) a fixed date on the Julian calendar
(holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression
in the variable `year'; if it evaluates to
@@ -404,11 +404,11 @@ To add the Islamic feast celebrating Mohammed's birthday, use
(holiday-islamic 3 12 \"Mohammed's Birthday\")
since the Islamic months are numbered from 1 starting with Muharram.
-To add an entry for the Baha'i festival of Ridvan, use
+To add an entry for the Bahá'í festival of Ridvan, use
(holiday-bahai 2 13 \"Festival of Ridvan\")
-since the Baha'i months are numbered from 1 starting with Baha.
+since the Bahá'í months are numbered from 1 starting with Bahá.
To add Thomas Jefferson's birthday, April 2, 1743 (Julian), use
(holiday-julian 4 2 \"Jefferson's Birthday\")
@@ -458,17 +458,20 @@ with descriptive strings such as
(defun calendar-holiday-list ()
"Form the list of holidays that occur on dates in the calendar window.
The holidays are those in the list `calendar-holidays'."
- (let (res h)
+ (let (res h err)
(sort
(dolist (p calendar-holidays res)
(if (setq h (if calendar-debug-sexp
(let ((debug-on-error t))
(eval p))
- (condition-case nil
+ (condition-case err
(eval p)
- (error (beep)
- (message "Bad holiday list item: %s" p)
- (sleep-for 2)))))
+ (error
+ (display-warning
+ :error
+ (format "Bad holiday list item: %s\nError: %s\n"
+ p err))
+ nil))))
(setq res (append h res))))
'calendar-date-compare)))
@@ -520,7 +523,7 @@ use instead of point."
(defun holidays (&optional arg)
"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."
(interactive "P")
(save-excursion
(let* ((completion-ignore-case t)
@@ -582,7 +585,7 @@ The optional LABEL is used to label the buffer created."
(if holiday-islamic-holidays
(cons "Islamic" holiday-islamic-holidays))
(if holiday-bahai-holidays
- (cons "Baha'i" holiday-bahai-holidays))
+ (cons "Bahá'í" holiday-bahai-holidays))
(if holiday-oriental-holidays
(cons "Oriental" holiday-oriental-holidays))
(if holiday-solar-holidays
@@ -634,7 +637,7 @@ The optional LABEL is used to label the buffer created."
"Check the list of holidays for any that occur on DATE.
DATE is a list (month day year). This function considers the
holidays from the list `calendar-holidays', and returns a list of
-strings describing those holidays that apply on DATE."
+strings describing those holidays that apply on DATE, or nil if none do."
(let ((displayed-month (calendar-extract-month date))
(displayed-year (calendar-extract-year date))
holiday-list)
@@ -645,6 +648,33 @@ strings describing those holidays that apply on DATE."
(define-obsolete-function-alias
'check-calendar-holidays 'calendar-check-holidays "23.1")
+
+;; Formerly cal-tex-list-holidays.
+(defun holiday-in-range (d1 d2)
+ "Generate a list of all holidays in range from absolute date D1 to D2."
+ (let* ((start (calendar-gregorian-from-absolute d1))
+ (displayed-month (calendar-extract-month start))
+ (displayed-year (calendar-extract-year start))
+ (end (calendar-gregorian-from-absolute d2))
+ (end-month (calendar-extract-month end))
+ (end-year (calendar-extract-year end))
+ (number-of-intervals
+ (1+ (/ (calendar-interval displayed-month displayed-year
+ end-month end-year)
+ 3)))
+ holidays in-range a)
+ (calendar-increment-month displayed-month displayed-year 1)
+ (dotimes (_idummy number-of-intervals)
+ (setq holidays (append holidays (calendar-holiday-list)))
+ (calendar-increment-month displayed-month displayed-year 3))
+ (dolist (hol holidays)
+ (and (car hol)
+ (setq a (calendar-absolute-from-gregorian (car hol)))
+ (and (<= d1 a) (<= a d2))
+ (setq in-range (append (list hol) in-range))))
+ in-range))
+
+
(declare-function x-popup-menu "menu.c" (position menu))
;;;###cal-autoload
@@ -920,4 +950,8 @@ is non-nil)."
(provide 'holidays)
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
;;; holidays.el ends here
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 62bea11e82e..27e7261263e 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -1,6 +1,6 @@
;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Created: August 2002
@@ -130,6 +130,7 @@ In case of a formatting STRING the following specifiers can be used:
%s Summary, see `icalendar-import-format-summary'
%t Status, see `icalendar-import-format-status'
%u URL, see `icalendar-import-format-url'
+%U UID, see `icalendar-import-format-uid'
A formatting FUNCTION will be called with a VEVENT as its only
argument. It must return a string. See
@@ -179,6 +180,15 @@ the URL."
:type 'string
:group 'icalendar)
+(defcustom icalendar-import-format-uid
+ "\n UID: %s"
+ "Format string defining how the UID element is formatted.
+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
"\n Status: %s"
"Format string defining how the status element is formatted.
@@ -491,7 +501,8 @@ The strings are suitable for assembling into a TZ variable."
(defun icalendar--parse-vtimezone (alist)
"Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
Return nil if timezone cannot be parsed."
- (let* ((tz-id (icalendar--get-event-property alist 'TZID))
+ (let* ((tz-id (icalendar--convert-string-for-import
+ (icalendar--get-event-property alist 'TZID)))
(daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT))))
(day (and daylight (icalendar--convert-tz-offset daylight t)))
(standard (cadr (cdar (icalendar--get-children alist 'STANDARD))))
@@ -915,14 +926,14 @@ would be \"pm\"."
"Export diary file to iCalendar format.
All diary entries in the file DIARY-FILENAME are converted to iCalendar
format. The result is appended to the file ICAL-FILENAME."
- (interactive "FExport diary data from file:
+ (interactive "FExport diary data from file: \n\
Finto iCalendar file: ")
(save-current-buffer
(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.")
@@ -1017,7 +1028,8 @@ FExport diary data into iCalendar file: ")
(org (cdr (assoc 'org other-elements)))
(sta (cdr (assoc 'sta other-elements)))
(sum (cdr (assoc 'sum other-elements)))
- (url (cdr (assoc 'url other-elements))))
+ (url (cdr (assoc 'url other-elements)))
+ (uid (cdr (assoc 'uid other-elements))))
(if cla
(setq contents (concat contents "\nCLASS:" cla)))
(if des
@@ -1031,10 +1043,12 @@ FExport diary data into iCalendar file: ")
;;(if sum
;; (setq contents (concat contents "\nSUMMARY:" sum)))
(if url
- (setq contents (concat contents "\nURL:" url))))
+ (setq contents (concat contents "\nURL:" url)))
- (setq header (concat "\nBEGIN:VEVENT\nUID:"
- (icalendar--create-uid entry-full contents)))
+ (setq header (concat "\nBEGIN:VEVENT\nUID:"
+ (or uid
+ (icalendar--create-uid entry-full
+ contents)))))
(setq result (concat result header contents "\nEND:VEVENT")))
;; handle errors
(error
@@ -1098,7 +1112,8 @@ Returns an alist."
;; can't do anything
nil
;; split summary-and-rest
- (let* ((s icalendar-import-format)
+ (let* ((case-fold-search nil)
+ (s icalendar-import-format)
(p-cla (or (string-match "%c" icalendar-import-format) -1))
(p-des (or (string-match "%d" icalendar-import-format) -1))
(p-loc (or (string-match "%l" icalendar-import-format) -1))
@@ -1106,9 +1121,10 @@ Returns an alist."
(p-sum (or (string-match "%s" icalendar-import-format) -1))
(p-sta (or (string-match "%t" icalendar-import-format) -1))
(p-url (or (string-match "%u" icalendar-import-format) -1))
- (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url) '<))
+ (p-uid (or (string-match "%U" icalendar-import-format) -1))
+ (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url p-uid) '<))
(ct 0)
- pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url)
+ pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url pos-uid)
(dotimes (i (length p-list))
;; Use 'ct' to keep track of current position in list
(cond ((and (>= p-cla 0) (= (nth i p-list) p-cla))
@@ -1131,7 +1147,10 @@ Returns an alist."
(setq pos-sum (* 2 ct)))
((and (>= p-url 0) (= (nth i p-list) p-url))
(setq ct (+ ct 1))
- (setq pos-url (* 2 ct)))) )
+ (setq pos-url (* 2 ct)))
+ ((and (>= p-uid 0) (= (nth i p-list) p-uid))
+ (setq ct (+ ct 1))
+ (setq pos-uid (* 2 ct)))) )
(mapc (lambda (ij)
(setq s (icalendar--rris (car ij) (cadr ij) s t t)))
(list
@@ -1149,13 +1168,15 @@ Returns an alist."
(list "%t"
(concat "\\(" icalendar-import-format-status "\\)??"))
(list "%u"
- (concat "\\(" icalendar-import-format-url "\\)??"))))
+ (concat "\\(" icalendar-import-format-url "\\)??"))
+ (list "%U"
+ (concat "\\(" icalendar-import-format-uid "\\)??"))))
;; Need the \' regexp in order to detect multi-line items
(setq s (concat "\\`"
(icalendar--rris "%s" "\\(.*?\\)" s nil t)
"\\'"))
(if (string-match s summary-and-rest)
- (let (cla des loc org sta sum url)
+ (let (cla des loc org sta sum url uid)
(if (and pos-sum (match-beginning pos-sum))
(setq sum (substring summary-and-rest
(match-beginning pos-sum)
@@ -1184,13 +1205,18 @@ Returns an alist."
(setq url (substring summary-and-rest
(match-beginning pos-url)
(match-end pos-url))))
+ (if (and pos-uid (match-beginning pos-uid))
+ (setq uid (substring summary-and-rest
+ (match-beginning pos-uid)
+ (match-end pos-uid))))
(list (if cla (cons 'cla cla) nil)
(if des (cons 'des des) nil)
(if loc (cons 'loc loc) nil)
(if org (cons 'org org) nil)
(if sta (cons 'sta sta) nil)
;;(if sum (cons 'sum sum) nil)
- (if url (cons 'url url) nil))))))))
+ (if url (cons 'url url) nil)
+ (if uid (cons 'uid uid) nil))))))))
;; subroutines for icalendar-export-region
(defun icalendar--convert-ordinary-to-ical (nonmarker entry-main)
@@ -1794,7 +1820,7 @@ Argument ICAL-FILENAME output iCalendar file.
Argument DIARY-FILENAME input `diary-file'.
Optional argument NON-MARKING determines whether events are created as
non-marking or not."
- (interactive "fImport iCalendar data from file:
+ (interactive "fImport iCalendar data from file: \n\
Finto diary file:
p")
;; clean up the diary file
@@ -1856,14 +1882,15 @@ 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."
(if (functionp icalendar-import-format)
(funcall icalendar-import-format event)
(let ((string icalendar-import-format)
+ (case-fold-search nil)
(conversion-list
'(("%c" CLASS icalendar-import-format-class)
("%d" DESCRIPTION icalendar-import-format-description)
@@ -1871,7 +1898,8 @@ buffer `*icalendar-errors*'."
("%o" ORGANIZER icalendar-import-format-organizer)
("%s" SUMMARY icalendar-import-format-summary)
("%t" STATUS icalendar-import-format-status)
- ("%u" URL icalendar-import-format-url))))
+ ("%u" URL icalendar-import-format-url)
+ ("%U" UID icalendar-import-format-uid))))
;; convert the specifiers in the format string
(mapc (lambda (i)
(let* ((spec (car i))
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
index e2ec46215be..2761df0bdb1 100644
--- a/lisp/calendar/lunar.el
+++ b/lisp/calendar/lunar.el
@@ -1,6 +1,6 @@
;;; lunar.el --- calendar functions for phases of the moon
-;; Copyright (C) 1992-1993, 1995, 1997, 2001-2011
+;; Copyright (C) 1992-1993, 1995, 1997, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -236,7 +236,7 @@ use instead of point."
(defun lunar-phases (&optional arg)
"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."
(interactive "P")
(save-excursion
(let* ((date (if arg (calendar-read-date t)
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index 52f13c82f5a..f8f4c7b3fac 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -1,6 +1,6 @@
;;; parse-time.el --- parsing time strings
-;; Copyright (C) 1996, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2000-2012 Free Software Foundation, Inc.
;; Author: Erik Naggum <erik@naggum.no>
;; Keywords: util
@@ -34,7 +34,7 @@
;;; Code:
-(eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it
+(eval-when-compile (require 'cl-lib))
(defvar parse-time-digits (make-vector 256 nil))
@@ -43,8 +43,8 @@
(defvar parse-time-val)
(unless (aref parse-time-digits ?0)
- (loop for i from ?0 to ?9
- do (aset parse-time-digits i (- i ?0))))
+ (cl-loop for i from ?0 to ?9
+ do (aset parse-time-digits i (- i ?0))))
(defsubst digit-char-p (char)
(aref parse-time-digits char))
@@ -92,11 +92,11 @@
(index 0)
(c nil))
(while (< index end)
- (while (and (< index end) ;skip invalid characters
+ (while (and (< index end) ;Skip invalid characters.
(not (setq c (parse-time-string-chars (aref string index)))))
- (incf index))
+ (cl-incf index))
(setq start index all-digits (eq c ?0))
- (while (and (< (incf index) end) ;scan valid characters
+ (while (and (< (cl-incf index) end) ;Scan valid characters.
(setq c (parse-time-string-chars (aref string index))))
(setq all-digits (and all-digits (eq c ?0))))
(if (<= index end)
@@ -193,28 +193,29 @@ unknown are returned as nil."
(predicate (pop rule))
(parse-time-val))
(when (and (not (nth (car slots) time)) ;not already set
- (setq parse-time-val (cond ((and (consp predicate)
- (not (eq (car predicate)
- 'lambda)))
- (and (numberp parse-time-elt)
- (<= (car predicate) parse-time-elt)
- (<= parse-time-elt (cadr predicate))
- parse-time-elt))
- ((symbolp predicate)
- (cdr (assoc parse-time-elt
- (symbol-value predicate))))
- ((funcall predicate)))))
+ (setq parse-time-val
+ (cond ((and (consp predicate)
+ (not (eq (car predicate)
+ 'lambda)))
+ (and (numberp parse-time-elt)
+ (<= (car predicate) parse-time-elt)
+ (<= parse-time-elt (cadr predicate))
+ parse-time-elt))
+ ((symbolp predicate)
+ (cdr (assoc parse-time-elt
+ (symbol-value predicate))))
+ ((funcall predicate)))))
(setq exit t)
(while slots
- (let ((new-val (and rule
- (let ((this (pop rule)))
- (if (vectorp this)
- (parse-integer
- parse-time-elt
- (aref this 0) (aref this 1))
- (funcall this))))))
- (rplaca (nthcdr (pop slots) time)
- (or new-val parse-time-val)))))))))
+ (let ((new-val (if rule
+ (let ((this (pop rule)))
+ (if (vectorp this)
+ (parse-integer
+ parse-time-elt
+ (aref this 0) (aref this 1))
+ (funcall this)))
+ parse-time-val)))
+ (rplaca (nthcdr (pop slots) time) new-val))))))))
time))
(provide 'parse-time)
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index b841ed4ab73..3ccdf135fb6 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -1,6 +1,6 @@
;;; solar.el --- calendar functions for solar events
-;; Copyright (C) 1992-1993, 1995, 1997, 2001-2011
+;; Copyright (C) 1992-1993, 1995, 1997, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -797,7 +797,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."
(interactive "p")
(or arg (setq arg 1))
(if (and (< arg 16)
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 70d096c4108..9cac659d848 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -1,6 +1,6 @@
;;; time-date.el --- Date and time handling functions
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu Umeda <umerin@mse.kyutech.ac.jp>
@@ -23,18 +23,17 @@
;;; Commentary:
-;; Time values come in three formats. The oldest format is a cons
+;; Time values come in several formats. The oldest format is a cons
;; cell of the form (HIGH . LOW). This format is obsolete, but still
-;; supported. The two other formats are the lists (HIGH LOW) and
-;; (HIGH LOW MICRO). The first two formats specify HIGH * 2^16 + LOW
-;; seconds; the third format specifies HIGH * 2^16 + LOW + MICRO /
-;; 1000000 seconds. We should have 0 <= MICRO < 1000000 and 0 <= LOW
-;; < 2^16. If the time value represents a point in time, then HIGH is
-;; nonnegative. If the time value is a time difference, then HIGH can
-;; be negative as well. The macro `with-decoded-time-value' and the
-;; function `encode-time-value' make it easier to deal with these
-;; three formats. See `time-subtract' for an example of how to use
-;; them.
+;; supported. The other formats are the lists (HIGH LOW), (HIGH LOW
+;; USEC), and (HIGH LOW USEC PSEC). These formats specify the time
+;; value equal to HIGH * 2^16 + LOW + USEC * 10^-6 + PSEC * 10^-12
+;; seconds, where missing components are treated as zero. HIGH can be
+;; negative, either because the value is a time difference, or because
+;; the machine supports negative time stamps that fall before the epoch.
+;; The macro `with-decoded-time-value' and the function
+;; `encode-time-value' make it easier to deal with these formats.
+;; See `time-subtract' for an example of how to use them.
;;; Code:
@@ -44,13 +43,15 @@
The value of the last form in BODY is returned.
Each element of the list VARLIST is a list of the form
-\(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [TYPE-SYMBOL] TIME-VALUE).
+\(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [PICO-SYMBOL [TYPE-SYMBOL]] TIME-VALUE).
The time value TIME-VALUE is decoded and the result it bound to
the symbols HIGH-SYMBOL, LOW-SYMBOL and MICRO-SYMBOL.
+The optional PICO-SYMBOL is bound to the picoseconds part.
The optional TYPE-SYMBOL is bound to the type of the time value.
Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH
-LOW), and type 2 is the list (HIGH LOW MICRO)."
+LOW), type 2 is the list (HIGH LOW MICRO), and type 3 is the
+list (HIGH LOW MICRO PICO)."
(declare (indent 1)
(debug ((&rest (symbolp symbolp symbolp &or [symbolp form] form))
body)))
@@ -59,6 +60,8 @@ LOW), and type 2 is the list (HIGH LOW MICRO)."
(high (pop elt))
(low (pop elt))
(micro (pop elt))
+ (pico (unless (<= (length elt) 2)
+ (pop elt)))
(type (unless (eq (length elt) 1)
(pop elt)))
(time-value (car elt))
@@ -66,28 +69,44 @@ LOW), and type 2 is the list (HIGH LOW MICRO)."
`(let* ,(append `((,gensym ,time-value)
(,high (pop ,gensym))
,low ,micro)
+ (when pico `(,pico))
(when type `(,type)))
(if (consp ,gensym)
(progn
(setq ,low (pop ,gensym))
(if ,gensym
- ,(append `(setq ,micro (car ,gensym))
- (when type `(,type 2)))
+ (progn
+ (setq ,micro (car ,gensym))
+ ,(cond (pico
+ `(if (cdr ,gensym)
+ ,(append `(setq ,pico (cadr ,gensym))
+ (when type `(,type 3)))
+ ,(append `(setq ,pico 0)
+ (when type `(,type 2)))))
+ (type
+ `(setq type 2))))
,(append `(setq ,micro 0)
+ (when pico `(,pico 0))
(when type `(,type 1)))))
,(append `(setq ,low ,gensym ,micro 0)
+ (when pico `(,pico 0))
(when type `(,type 0))))
(with-decoded-time-value ,varlist ,@body)))
`(progn ,@body)))
-(defun encode-time-value (high low micro type)
- "Encode HIGH, LOW, and MICRO into a time value of type TYPE.
+(defun encode-time-value (high low micro pico &optional type)
+ "Encode HIGH, LOW, MICRO, and PICO into a time value of type TYPE.
Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH LOW),
-and type 2 is the list (HIGH LOW MICRO)."
+type 2 is (HIGH LOW MICRO), and type 3 is (HIGH LOW MICRO PICO).
+
+For backward compatibility, if only four arguments are given,
+it is assumed that PICO was omitted and should be treated as zero."
(cond
((eq type 0) (cons high low))
((eq type 1) (list high low))
- ((eq type 2) (list high low micro))))
+ ((eq type 2) (list high low micro))
+ ((eq type 3) (list high low micro pico))
+ ((null type) (encode-time-value high low micro 0 pico))))
(autoload 'parse-time-string "parse-time")
(autoload 'timezone-make-date-arpa-standard "timezone")
@@ -114,9 +133,7 @@ If DATE lacks timezone information, GMT is assumed."
;;;###autoload(if (or (featurep 'emacs)
;;;###autoload (and (fboundp 'float-time)
;;;###autoload (subrp (symbol-function 'float-time))))
-;;;###autoload (progn
-;;;###autoload (defalias 'time-to-seconds 'float-time)
-;;;###autoload (make-obsolete 'time-to-seconds 'float-time "21.1"))
+;;;###autoload (defalias 'time-to-seconds 'float-time)
;;;###autoload (autoload 'time-to-seconds "time-date"))
(eval-when-compile
@@ -125,28 +142,45 @@ If DATE lacks timezone information, GMT is assumed."
(subrp (symbol-function 'float-time)))
(defun time-to-seconds (time)
"Convert time value TIME to a floating point number."
- (with-decoded-time-value ((high low micro time))
+ (with-decoded-time-value ((high low micro pico type time))
(+ (* 1.0 high 65536)
low
- (/ micro 1000000.0))))))
+ (/ (+ (* micro 1e6) pico) 1e12))))))
;;;###autoload
(defun seconds-to-time (seconds)
"Convert SECONDS (a floating point number) to a time value."
- (list (floor seconds 65536)
- (floor (mod seconds 65536))
- (floor (* (- seconds (ffloor seconds)) 1000000))))
+ (let* ((usec (* 1000000 (mod seconds 1)))
+ (ps (round (* 1000000 (mod usec 1))))
+ (us (floor usec))
+ (lo (floor (mod seconds 65536)))
+ (hi (floor seconds 65536)))
+ (if (eq ps 1000000)
+ (progn
+ (setq ps 0)
+ (setq us (1+ us))
+ (if (eq us 1000000)
+ (progn
+ (setq us 0)
+ (setq lo (1+ lo))
+ (if (eq lo 65536)
+ (progn
+ (setq lo 0)
+ (setq hi (1+ hi))))))))
+ (list hi lo us ps)))
;;;###autoload
(defun time-less-p (t1 t2)
"Return non-nil if time value T1 is earlier than time value T2."
- (with-decoded-time-value ((high1 low1 micro1 t1)
- (high2 low2 micro2 t2))
+ (with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1)
+ (high2 low2 micro2 pico2 type2 t2))
(or (< high1 high2)
(and (= high1 high2)
(or (< low1 low2)
(and (= low1 low2)
- (< micro1 micro2)))))))
+ (or (< micro1 micro2)
+ (and (= micro1 micro2)
+ (< pico1 pico2)))))))))
;;;###autoload
(defun days-to-time (days)
@@ -173,36 +207,44 @@ TIME should be either a time value or a date-time string."
(defun time-subtract (t1 t2)
"Subtract two time values, T1 minus T2.
Return the difference in the format of a time value."
- (with-decoded-time-value ((high low micro type t1)
- (high2 low2 micro2 type2 t2))
+ (with-decoded-time-value ((high low micro pico type t1)
+ (high2 low2 micro2 pico2 type2 t2))
(setq high (- high high2)
low (- low low2)
micro (- micro micro2)
+ pico (- pico pico2)
type (max type type2))
+ (when (< pico 0)
+ (setq micro (1- micro)
+ pico (+ pico 1000000)))
(when (< micro 0)
(setq low (1- low)
micro (+ micro 1000000)))
(when (< low 0)
(setq high (1- high)
low (+ low 65536)))
- (encode-time-value high low micro type)))
+ (encode-time-value high low micro pico type)))
;;;###autoload
(defun time-add (t1 t2)
"Add two time values T1 and T2. One should represent a time difference."
- (with-decoded-time-value ((high low micro type t1)
- (high2 low2 micro2 type2 t2))
+ (with-decoded-time-value ((high low micro pico type t1)
+ (high2 low2 micro2 pico2 type2 t2))
(setq high (+ high high2)
low (+ low low2)
micro (+ micro micro2)
+ pico (+ pico pico2)
type (max type type2))
+ (when (>= pico 1000000)
+ (setq micro (1+ micro)
+ pico (- pico 1000000)))
(when (>= micro 1000000)
(setq low (1+ low)
micro (- micro 1000000)))
(when (>= low 65536)
(setq high (1+ high)
low (- low 65536)))
- (encode-time-value high low micro type)))
+ (encode-time-value high low micro pico type)))
;;;###autoload
(defun date-to-day (date)
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index c9b8fdac613..7e7a737549f 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -1,6 +1,6 @@
;;; timeclock.el --- mode for keeping track of how much you work
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Created: 25 Mar 1999
@@ -43,24 +43,24 @@
;; (define-key ctl-x-map "to" 'timeclock-out)
;; (define-key ctl-x-map "tc" 'timeclock-change)
;; (define-key ctl-x-map "tr" 'timeclock-reread-log)
-;; (define-key ctl-x-map "tu" 'timeclock-update-modeline)
+;; (define-key ctl-x-map "tu" 'timeclock-update-mode-line)
;; (define-key ctl-x-map "tw" 'timeclock-when-to-leave-string)
;; If you want Emacs to display the amount of time "left" to your
-;; workday in the modeline, you can either set the value of
-;; `timeclock-modeline-display' to t using M-x customize, or you
-;; can add this code to your .emacs file:
+;; workday in the mode-line, you can either set the value of
+;; `timeclock-mode-line-display' to t using M-x customize, or you can
+;; add this code to your init file:
;;
;; (require 'timeclock)
-;; (timeclock-modeline-display)
+;; (timeclock-mode-line-display)
;;
-;; To cancel this modeline display at any time, just call
-;; `timeclock-modeline-display' again.
+;; To cancel this mode line display at any time, just call
+;; `timeclock-mode-line-display' again.
;; You may also want Emacs to ask you before exiting, if you are
;; currently working on a project. This can be done either by setting
;; `timeclock-ask-before-exiting' to t using M-x customize (this is
-;; the default), or by adding the following to your .emacs file:
+;; the default), or by adding the following to your init file:
;;
;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
@@ -98,7 +98,7 @@ work four hours on Monday, then the amount of time \"remaining\" on
Tuesday is twelve hours -- relative to an averaged work period of
eight hours -- or eight hours, non-relative. So relative time takes
into account any discrepancy of time under-worked or over-worked on
-previous days. This only affects the timeclock modeline display."
+previous days. This only affects the timeclock mode line display."
:type 'boolean
:group 'timeclock)
@@ -145,39 +145,39 @@ This variable only has effect if set with \\[customize]."
;; For byte-compiler.
(defvar display-time-hook)
-(defvar timeclock-modeline-display)
+(defvar timeclock-mode-line-display)
(defcustom timeclock-use-display-time t
- "If non-nil, use `display-time-hook' for doing modeline updates.
+ "If non-nil, use `display-time-hook' for doing mode line updates.
The advantage of this is that one less timer has to be set running
-amok in Emacs' process space. The disadvantage is that it requires
+amok in Emacs's process space. The disadvantage is that it requires
you to have `display-time' running. If you don't want to use
-`display-time', but still want the modeline to show how much time is
+`display-time', but still want the mode line to show how much time is
left, set this variable to nil. Changing the value of this variable
-while timeclock information is being displayed in the modeline has no
-effect. You should call the function `timeclock-modeline-display' with
+while timeclock information is being displayed in the mode line has no
+effect. You should call the function `timeclock-mode-line-display' with
a positive argument to force an update."
:set (lambda (symbol value)
(let ((currently-displaying
- (and (boundp 'timeclock-modeline-display)
- timeclock-modeline-display)))
+ (and (boundp 'timeclock-mode-line-display)
+ timeclock-mode-line-display)))
;; if we're changing to the state that
- ;; `timeclock-modeline-display' is already using, don't
+ ;; `timeclock-mode-line-display' is already using, don't
;; bother toggling it. This happens on the initial loading
;; of timeclock.el.
(if (and currently-displaying
(or (and value
(boundp 'display-time-hook)
- (memq 'timeclock-update-modeline
+ (memq 'timeclock-update-mode-line
display-time-hook))
(and (not value)
timeclock-update-timer)))
(setq currently-displaying nil))
(and currently-displaying
- (set-variable 'timeclock-modeline-display nil))
+ (set-variable 'timeclock-mode-line-display nil))
(setq timeclock-use-display-time value)
(and currently-displaying
- (set-variable 'timeclock-modeline-display t))
+ (set-variable 'timeclock-mode-line-display t))
timeclock-use-display-time))
:type 'boolean
:group 'timeclock
@@ -205,7 +205,7 @@ to today."
(defcustom timeclock-day-over-hook nil
"A hook that is run when the workday has been completed.
This hook is only run if the current time remaining is being displayed
-in the modeline. See the variable `timeclock-modeline-display'."
+in the mode line. See the variable `timeclock-mode-line-display'."
:type 'hook
:group 'timeclock)
@@ -251,7 +251,7 @@ worked so far today. Also, if `timeclock-relative' is nil, this value
will be the same as `timeclock-discrepancy'.")
(defvar timeclock-use-elapsed nil
- "Non-nil if the modeline should display time elapsed, not remaining.")
+ "Non-nil if the mode line should display time elapsed, not remaining.")
(defvar timeclock-last-period nil
"Integer representing the number of seconds in the last period.
@@ -259,7 +259,7 @@ Note that you shouldn't access this value, but instead should use the
function `timeclock-last-period'.")
(defvar timeclock-mode-string nil
- "The timeclock string (optionally) displayed in the modeline.
+ "The timeclock string (optionally) displayed in the mode line.
The time is bracketed by <> if you are clocked in, otherwise by [].")
(defvar timeclock-day-over nil
@@ -267,15 +267,18 @@ The time is bracketed by <> if you are clocked in, otherwise by [].")
;;; User Functions:
+(define-obsolete-function-alias 'timeclock-modeline-display
+ 'timeclock-mode-line-display "24.3")
+
;;;###autoload
-(defun timeclock-modeline-display (&optional arg)
- "Toggle display of the amount of time left today in the modeline.
+(defun timeclock-mode-line-display (&optional arg)
+ "Toggle display of the amount of time left today in the mode line.
If `timeclock-use-display-time' is non-nil (the default), then
-the function `display-time-mode' must be active, and the modeline
+the function `display-time-mode' must be active, and the mode line
will be updated whenever the time display is updated. Otherwise,
the timeclock will use its own sixty second timer to do its
-updating. With prefix ARG, turn modeline display on if and only
-if ARG is positive. Returns the new status of timeclock modeline
+updating. With prefix ARG, turn mode line display on if and only
+if ARG is positive. Returns the new status of timeclock mode line
display (non-nil means on)."
(interactive "P")
;; cf display-time-mode.
@@ -283,49 +286,52 @@ display (non-nil means on)."
(or global-mode-string (setq global-mode-string '("")))
(let ((on-p (if arg
(> (prefix-numeric-value arg) 0)
- (not timeclock-modeline-display))))
+ (not timeclock-mode-line-display))))
(if on-p
(progn
(or (memq 'timeclock-mode-string global-mode-string)
(setq global-mode-string
(append global-mode-string '(timeclock-mode-string))))
- (unless (memq 'timeclock-update-modeline timeclock-event-hook)
- (add-hook 'timeclock-event-hook 'timeclock-update-modeline))
+ (add-hook 'timeclock-event-hook 'timeclock-update-mode-line)
(when timeclock-update-timer
(cancel-timer timeclock-update-timer)
(setq timeclock-update-timer nil))
(if (boundp 'display-time-hook)
- (remove-hook 'display-time-hook 'timeclock-update-modeline))
+ (remove-hook 'display-time-hook 'timeclock-update-mode-line))
(if timeclock-use-display-time
(progn
;; Update immediately so there is a visible change
;; on calling this function.
- (if display-time-mode (timeclock-update-modeline)
+ (if display-time-mode
+ (timeclock-update-mode-line)
(message "Activate `display-time-mode' or turn off \
`timeclock-use-display-time' to see timeclock information"))
- (add-hook 'display-time-hook 'timeclock-update-modeline))
+ (add-hook 'display-time-hook 'timeclock-update-mode-line))
(setq timeclock-update-timer
- (run-at-time nil 60 'timeclock-update-modeline))))
+ (run-at-time nil 60 'timeclock-update-mode-line))))
(setq global-mode-string
(delq 'timeclock-mode-string global-mode-string))
- (remove-hook 'timeclock-event-hook 'timeclock-update-modeline)
+ (remove-hook 'timeclock-event-hook 'timeclock-update-mode-line)
(if (boundp 'display-time-hook)
(remove-hook 'display-time-hook
- 'timeclock-update-modeline))
+ 'timeclock-update-mode-line))
(when timeclock-update-timer
(cancel-timer timeclock-update-timer)
(setq timeclock-update-timer nil)))
(force-mode-line-update)
- (setq timeclock-modeline-display on-p)))
+ (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-modeline-display' is known to the "set" function.
-(defcustom timeclock-modeline-display nil
- "Toggle modeline display of time remaining.
+;; `timeclock-mode-line-display' is known to the "set" function.
+(defcustom timeclock-mode-line-display nil
+ "Toggle mode line display of time remaining.
You must modify via \\[customize] for this variable to have an effect."
:set (lambda (symbol value)
- (setq timeclock-modeline-display
- (timeclock-modeline-display (or value 0))))
+ (setq timeclock-mode-line-display
+ (timeclock-mode-line-display (or value 0))))
:type 'boolean
:group 'timeclock
:require 'timeclock)
@@ -477,8 +483,8 @@ Returns the new value of `timeclock-discrepancy'."
(interactive)
(setq timeclock-discrepancy nil)
(timeclock-find-discrep)
- (if (and timeclock-discrepancy timeclock-modeline-display)
- (timeclock-update-modeline))
+ (if (and timeclock-discrepancy timeclock-mode-line-display)
+ (timeclock-update-mode-line))
timeclock-discrepancy)
(defun timeclock-seconds-to-string (seconds &optional show-seconds
@@ -645,8 +651,11 @@ arguments of `completing-read'."
(timeclock-completing-read "Reason for clocking out: "
(mapcar 'list timeclock-reason-list)))
-(defun timeclock-update-modeline ()
- "Update the `timeclock-mode-string' displayed in the modeline.
+(define-obsolete-function-alias 'timeclock-update-modeline
+ 'timeclock-update-mode-line "24.3")
+
+(defun timeclock-update-mode-line ()
+ "Update the `timeclock-mode-string' displayed in the mode line.
The value of `timeclock-relative' affects the display as described in
that variable's documentation."
(interactive)
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index de232c25e3f..957ac2c6946 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -1,6 +1,6 @@
;;; todo-mode.el --- major mode for editing TODO list files
-;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Oliver Seidel <privat@os10000.net>
;; Maintainer: Stephen Berman <stephen.berman@gmx.net>
diff --git a/lisp/case-table.el b/lisp/case-table.el
index a1bb862788e..3c00719f52e 100644
--- a/lisp/case-table.el
+++ b/lisp/case-table.el
@@ -1,6 +1,6 @@
;;; case-table.el --- code to extend the character set and support case tables
-;; Copyright (C) 1988, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: FSF
diff --git a/lisp/cdl.el b/lisp/cdl.el
index 8377e7a5796..2c4fbb19157 100644
--- a/lisp/cdl.el
+++ b/lisp/cdl.el
@@ -1,6 +1,6 @@
;;; cdl.el --- Common Data Language (CDL) utility functions for GNU Emacs
-;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
;; Author: ATAE@spva.physics.imperial.ac.uk (Ata Etemadi)
;; Maintainer: FSF
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog
index 0e46ba73e6e..cdfb357b646 100644
--- a/lisp/cedet/ChangeLog
+++ b/lisp/cedet/ChangeLog
@@ -1,3 +1,714 @@
+2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/fw.el (semantic-make-local-hook, semantic-mode-line-update):
+ Simplify via CSE.
+
+2012-11-16 David Engster <deng@randomsample.de>
+
+ * semantic/symref/list.el (semantic-symref-symbol):
+ Use `semantic-complete-read-tag-project' instead of
+ `semantic-complete-read-tag-buffer-deep', since the latter is not
+ working correctly.
+
+ * semantic/symref.el (semantic-symref-result-get-tags):
+ Use `find-buffer-visiting' to follow symbolic links.
+
+ * semantic/fw.el (semantic-find-file-noselect): Always set
+ `enable-local-variables' to `:safe' when loading files.
+
+2012-11-16 Glenn Morris <rgm@gnu.org>
+
+ * semantic/lex-spp.el (semantic-lex-spp-lex-text-string):
+ * semantic/util.el (semantic-describe-buffer):
+ * semantic/bovine/c.el (semantic-c-parse-lexical-token)
+ (semantic-default-c-setup):
+ Use new names for hooks rather than obsolete aliases.
+
+2012-11-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/mru-bookmark.el (semantic-mru-bookmark-mode):
+ * semantic/grammar.el (semantic-grammar-mode):
+ * semantic/util-modes.el (semantic-highlight-edits-mode)
+ (semantic-show-parser-state-mode): Avoid obsolete name
+ semantic-edits-new-change-hooks (bug#12869).
+
+2012-11-13 Glenn Morris <rgm@gnu.org>
+
+ * srecode/srt-mode.el (srecode-template-mode):
+ Don't change global values of comment-start, comment-end. (Bug#12781)
+
+2012-10-25 David Engster <deng@randomsample.de>
+
+ * semantic/analyze.el (semantic-analyze-dereference-alias):
+ New function to dereference aliases.
+ (semantic-analyze-current-context-default): Use it.
+
+ * semantic/grammar.el (semantic-grammar-create-package):
+ * srecode/compile.el (srecode-compile-templates): Throw a proper
+ error if semantic-mode is not enabled (bug#9968).
+
+ Compiler warning fixes:
+
+ * semantic.el (semantic-elapsed-time): Make it a defsubst.
+
+ * srecode/dictionary.el (srecode-adebug-dictionary):
+ Remove require for `semantic'.
+
+ * srecode/map.el:
+ * srecode/insert.el: Declare functions from `data-debug'.
+
+ * semantic/grammar.el: Require `help-fns'. Declare functions from
+ `eldoc', which is required in function body.
+
+ * srecode/java.el:
+ * semantic/texi.el:
+ * semantic/grammar-wy.el:
+ * semantic/db-file.el:
+ * semantic/db-el.el:
+ * semantic/chart.el: Fix requires.
+
+ * ede/locate.el: Remove useless requires. Declare functions
+ instead and require in functions when needed.
+
+2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/db-file.el (semanticdb-save-database-functions):
+ * semantic/lex.el (semantic-lex-reset-functions):
+ * semantic/edit.el (semantic-change-functions)
+ (semantic-edits-new-change-functions)
+ (semantic-edits-delete-change-functions)
+ (semantic-edits-reparse-change-functions): Don't use "-hooks" suffix.
+
+2012-10-14 David Engster <deng@randomsample.de>
+
+ * semantic.el (semantic-error-if-unparsed): New function.
+ Raise error if buffer was not parsed by Semantic (bug #12045).
+ (navigate-menu, edit-menu, cedet-menu-map): Enable Semantic items
+ only if buffer was parsed. Also, replace ':active' with ':enable'
+ where necessary.
+
+ * semantic/wisent/python.el
+ (semantic-python-get-system-include-path):
+ Use `python-shell-internal-send-string' if available to query Python
+ for system paths.
+
+ * semantic/senator.el (senator-next-tag, senator-previous-tag)
+ (senator-go-to-up-reference): Use `semantic-error-if-unparsed'.
+
+ * semantic/complete.el (semantic-complete-jump-local)
+ (semantic-complete-jump, semantic-complete-jump-local-members)
+ (semantic-complete-self-insert): Use `semantic-error-if-unparsed'.
+ (semantic-complete-inline-project): Fix autoload cookie.
+
+ * semantic/analyze/complete.el
+ (semantic-analyze-possible-completions): Check if buffer was
+ parsed. Only raise an error if function was called interactively,
+ otherwise silently return nil.
+
+ * cedet.el (cedet-menu-map): Fix copy&paste typo in menu creation.
+
+2012-10-08 David Engster <deng@randomsample.de>
+
+ * semantic/bovine/el.el: Add `semantic-default-elisp-setup' to
+ `emacs-lisp-mode-hook'. This was accidentally removed during the
+ CEDET update (2012-10-01T18:10:29Z!cyd@gnu.org).
+
+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 infinite loop (bug#12458).
+
+ * semantic/ede-grammar.el (project-compile-target): Fix grammar
+ compilation after introduction of %provide statement.
+
+ * 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): Rename 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.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ inaccessable -> inaccessible spelling fix (Bug#10052)
+ * semantic/wisent/comp.el (wisent-inaccessible-symbols):
+ Rename from wisent-inaccessable-symbols, fixing a misspelling.
+ Caller changed.
+
+2012-07-09 Andreas Schwab <schwab@linux-m68k.org>
+
+ * ede/project-am.el: Fix typo.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rename configure.in to configure.ac (Bug#11603).
+ * ede/autoconf-edit.el (autoconf-find-query-for-program)
+ (autoconf-new-program):
+ * ede/emacs.el (ede-emacs-version):
+ * ede/proj.el (ede-proj-setup-buildenvironment):
+ * ede/project-am.el (project-am-autoconf-file-options):
+ Prefer configure.ac to configure.in.
+
+2012-03-12 David Engster <deng@randomsample.de>
+
+ * semantic/db-find.el
+ (semanticdb-find-translate-path-brutish-default): If we don't yet
+ have a proper table for PATH, use `semanticdb-current-database'
+ instead (bug #10343).
+
+2012-03-11 David Engster <deng@randomsample.de>
+
+ * semantic/wisent/javascript.el (js-mode): Define `js-mode' as
+ child-mode of `javascript-mode' (bug #8445).
+
+2012-02-28 Glenn Morris <rgm@gnu.org>
+
+ * semantic/db.el (semanticdb-search-results-table):
+ Doc fix (standardize possessive apostrophe usage).
+
+2012-02-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * ede/auto.el (ede-directory-safe-p, ede-add-project-to-global-list):
+ Add declarations.
+
+2012-01-29 David Engster <deng@randomsample.de>
+
+ Fix require error when using srecode-insert (Bug#9967).
+ * srecode/insert.el: Require srecode/filters.
+ * srecode/filters.el: Drop two requires.
+
+2012-01-09 Eric Ludlam <zappo@gnu.org>
+
+ * ede.el (ede-project-directories): New option.
+ (ede-directory-safe-p): Check it.
+ (ede-initialize-state-current-buffer, ede, ede-new)
+ (ede-check-project-directory, ede-rescan-toplevel)
+ (ede-load-project-file, ede-parent-project, ede-current-project):
+ (ede-target-parent): Avoid loading in a project unless it is safe,
+ since it may involve malicious code. This security flaw was
+ pointed out by Hiroshi Oota.
+
+ * ede/auto.el (ede-project-autoload): Add safe-p slot.
+ (ede-project-class-files): Projects using Project.ede are unsafe.
+ (ede-auto-load-project): New method.
+
+ * ede/simple.el (ede-project-class-files): Mark as unsafe.
+
2011-12-19 Sam Steingold <sds@gnu.org>
* semantic/edit.el (semantic-edits-incremental-parser): Add the
@@ -123,8 +834,8 @@
2011-07-30 Chong Yidong <cyd@stupidchicken.com>
- * semantic/grammar.el (semantic-grammar-insert-defanalyzers): Fix
- require.
+ * semantic/grammar.el (semantic-grammar-insert-defanalyzers):
+ Fix require.
2011-07-04 Darren Hoo <darren.hoo@gmail.com> (tiny change)
@@ -371,7 +1082,7 @@
(ede-customize-forms-menu): Prevent error if there is no project.
(ede-load-project-file): Set ede-constructing to the thing being
constructed, instead of t.
- (ede-project-force-load): Deleted.
+ (ede-project-force-load): Delete.
* ede/base.el:
* ede/auto.el:
@@ -381,7 +1092,7 @@
(autoconf-parameters-for-macro): Parse multiline parameters of
macros. Optionally ignore case and at bol for macro.
(autoconf-parameter-strip): Use greedy match for newlines.
- (autoconf-new-automake-string): Deleted.
+ (autoconf-new-automake-string): Delete.
(autoconf-new-program): Use SRecode to fill an empty file.
* ede/cpp-root.el (ede-create-lots-of-projects-under-dir):
@@ -416,7 +1127,7 @@
(project-am-scan-for-targets): Scan also over
project-am-meta-type-alist.
(ede-system-include-path): Simple implementation.
- (ede-find-target): Deleted. EDE core takes care of this.
+ (ede-find-target): Delete. EDE core takes care of this.
(ede-buffer-mine): Create the searched filename as relative.
(project-am-load): Simplify, using autoconf-edit.
(project-am-extract-package-info): Fix separators.
@@ -433,7 +1144,7 @@
(ede-proj-target-makefile-objectcode): Quote initforms.
Support lex and yacc.
- * ede/proj-prog.el (ede-proj-makefile-insert-rules): Removed.
+ * ede/proj-prog.el (ede-proj-makefile-insert-rules): Remove.
(ede-proj-makefile-insert-variables): New, add LDDEPS.
(ede-proj-makefile-insert-automake-post-variables): Add LDADD
variable. Use ldlibs-local slot. Add a -l to ldlibs strings.
@@ -528,7 +1239,7 @@
* semantic/util.el (semantic-hack-search)
(semantic-recursive-find-nonterminal-by-name)
- (semantic-current-tag-interactive): Deleted.
+ (semantic-current-tag-interactive): Delete.
(semantic-describe-buffer): Fix expand-nonterminal.
Add lex-syntax-mods, type relation separator char, and command
separation char.
@@ -561,7 +1272,7 @@
(semantic-idle-truncate-long-summaries): New option.
* semantic/ia.el (semantic-ia-cache)
- (semantic-ia-get-completions): Deleted. Callers changed.
+ (semantic-ia-get-completions): Delete. Callers changed.
(semantic-ia-show-variants): New command.
(semantic-ia-show-doc): If doc is empty, don't make a temp buffer.
(semantic-ia-show-summary): If there isn't anything to show, say so.
@@ -887,6 +1598,7 @@
(srecode-template-inserter-ask, srecode-template-inserter-width)
(srecode-template-inserter-section-start)
(srecode-template-inserter-section-end, srecode-insert-method):
+ Fix typos in docstrings.
2010-01-12 Juanma Barranquero <lekktu@gmail.com>
@@ -1690,7 +2402,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2009-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el
index 71942698c5f..fe954a07712 100644
--- a/lisp/cedet/cedet-cscope.el
+++ b/lisp/cedet/cedet-cscope.el
@@ -1,6 +1,6 @@
;;; cedet-cscope.el --- CScope support for CEDET
-;;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Package: cedet
@@ -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-files.el b/lisp/cedet/cedet-files.el
index 6f40ee7030f..2cd28081b95 100644
--- a/lisp/cedet/cedet-files.el
+++ b/lisp/cedet/cedet-files.el
@@ -1,6 +1,6 @@
;;; cedet-files.el --- Common routines dealing with file names.
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Package: cedet
diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el
index aa18c0d2f42..d953d8c0980 100644
--- a/lisp/cedet/cedet-global.el
+++ b/lisp/cedet/cedet-global.el
@@ -1,6 +1,6 @@
;;; cedet-global.el --- GNU Global support for CEDET.
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Package: cedet
@@ -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 ee8e432ddd9..db9f3c08c7e 100644
--- a/lisp/cedet/cedet-idutils.el
+++ b/lisp/cedet/cedet-idutils.el
@@ -1,6 +1,6 @@
;;; cedet-idutils.el --- ID Utils support for CEDET.
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Version: 0.2
@@ -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 9ccf74de27a..327a72f9dc7 100644
--- a/lisp/cedet/cedet.el
+++ b/lisp/cedet/cedet.el
@@ -1,6 +1,6 @@
;;; cedet.el --- Setup CEDET environment
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: Eric M. Ludlam <zappo@gnu.org>
@@ -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")))
@@ -56,7 +59,7 @@
(define-key map [navigate-menu] 'undefined)
(define-key map [semantic-options-separator] 'undefined)
(define-key map [global-semantic-highlight-func-mode] 'undefined)
- (define-key map [global-semantic-highlight-func-mode] 'undefined)
+ (define-key map [global-semantic-stickyfunc-mode] 'undefined)
(define-key map [global-semantic-decoration-mode] 'undefined)
(define-key map [global-semantic-idle-completions-mode] 'undefined)
(define-key map [global-semantic-idle-summary-mode] 'undefined)
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index d553c433fc4..19d0e98aa00 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -1,6 +1,6 @@
;;; data-debug.el --- Datastructure Debugger
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.2
@@ -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)
@@ -872,7 +883,7 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
"Keymap used in data-debug.")
(defcustom data-debug-mode-hook nil
- "*Hook run when data-debug starts."
+ "Hook run when data-debug starts."
:group 'data-debug
:type 'hook)
@@ -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 741e1ffbe5f..22fe362d5d9 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -1,10 +1,10 @@
;;; ede.el --- Emacs Development Environment gloss
-;; Copyright (C) 1998-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
-;; Version: 1.0pre7
+;; Version: 1.0
;; This file is part of GNU Emacs.
@@ -94,6 +94,42 @@ target willing to take the file. 'never means never perform the check."
:group 'ede
:type 'sexp) ; make this be a list of options some day
+(defcustom ede-project-directories nil
+ "Directories in which EDE may search for project files.
+If the value is t, EDE may search in any directory.
+
+If the value is a function, EDE calls that function with one
+argument, the directory name; the function should return t iff
+EDE should look for project files in the directory.
+
+Otherwise, the value should be a list of fully-expanded directory
+names. EDE searches for project files only in those directories.
+If you invoke the commands \\[ede] or \\[ede-new] on a directory
+that is not listed, Emacs will offer to add it to the list.
+
+Any other value disables searching for EDE project files."
+ :group 'ede
+ :type '(choice (const :tag "Any directory" t)
+ (repeat :tag "List of directories"
+ (directory))
+ (function :tag "Predicate"))
+ :version "23.4"
+ :risky t)
+
+(defun ede-directory-safe-p (dir)
+ "Return non-nil if DIR is a safe directory to load projects from.
+Projects that do not load a project definition as Emacs Lisp code
+are safe, and can be loaded automatically. Other project types,
+such as those created with Project.ede files, are safe only if
+specified by `ede-project-directories'."
+ (setq dir (directory-file-name (expand-file-name dir)))
+ ;; Load only if allowed by `ede-project-directories'.
+ (or (eq ede-project-directories t)
+ (and (functionp ede-project-directories)
+ (funcall ede-project-directories dir))
+ (and (listp ede-project-directories)
+ (member dir ede-project-directories))))
+
;;; Management variables
@@ -158,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)
@@ -216,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."
@@ -307,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
))
@@ -314,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."
@@ -341,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)))
@@ -379,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)
)
@@ -420,28 +496,46 @@ provided `global-ede-mode' is enabled."
Sets buffer local variables for EDE."
(let* ((ROOT nil)
(proj (ede-directory-get-open-project default-directory
- 'ROOT)))
+ 'ROOT))
+ (projauto nil))
+
(when (or proj ROOT
- (ede-directory-project-p default-directory t))
+ ;; If there is no open project, look up the project
+ ;; autoloader to see if we should initialize.
+ (setq projauto (ede-directory-project-p default-directory t)))
+
+ (when (and (not proj) projauto)
+
+ ;; No project was loaded, but we have a project description
+ ;; object. This means that we can check if it is a safe
+ ;; project to load before requesting it to be loaded.
+
+ (when (or (oref projauto safe-p)
+ ;; The project style is not safe, so check if it is
+ ;; in `ede-project-directories'.
+ (let ((top (ede-toplevel-project default-directory)))
+ (ede-directory-safe-p top)))
- (when (not proj)
- ;; @todo - this could be wasteful.
- (setq proj (ede-load-project-file default-directory 'ROOT)))
+ ;; The project is safe, so load it in.
+ (setq proj (ede-load-project-file default-directory 'ROOT))))
- (setq ede-object (ede-buffer-object (current-buffer)
+ ;; Only initialize EDE state in this buffer if we found a project.
+ (when proj
+
+ (setq ede-object (ede-buffer-object (current-buffer)
'ede-object-project))
- (setq ede-object-root-project
- (or ROOT (ede-project-root ede-object-project)))
+ (setq ede-object-root-project
+ (or ROOT (ede-project-root ede-object-project)))
- (if (and (not ede-object) ede-object-project)
- (ede-auto-add-to-target))
+ (if (and (not ede-object) ede-object-project)
+ (ede-auto-add-to-target))
- (ede-apply-target-options))))
+ (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))
@@ -479,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)
@@ -489,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$"
@@ -557,13 +651,72 @@ of objects with the `ede-want-file-p' method."
;;; Interactive method invocations
;;
-(defun ede (file)
- "Start up EDE on something.
-Argument FILE is the file or directory to load a project from."
- (interactive "fProject File: ")
- (if (not (file-exists-p file))
- (ede-new file)
- (ede-load-project-file (file-name-directory file))))
+(defun ede (dir)
+ "Start up EDE for directory DIR.
+If DIR has an existing project file, load it.
+Otherwise, create a new project for DIR."
+ (interactive
+ ;; When choosing a directory to turn on, and we see some directory here,
+ ;; provide that as the default.
+ (let* ((top (ede-toplevel-project default-directory))
+ (promptdflt (or top default-directory)))
+ (list (read-directory-name "Project directory: "
+ promptdflt promptdflt t))))
+ (unless (file-directory-p dir)
+ (error "%s is not a directory" dir))
+ (when (ede-directory-get-open-project dir)
+ (error "%s already has an open project associated with it" dir))
+
+ ;; Check if the directory has been added to the list of safe
+ ;; directories. It can also add the directory to the safe list if
+ ;; the user chooses.
+ (if (ede-check-project-directory dir)
+ (progn
+ ;; Load the project in DIR, or make one.
+ (ede-load-project-file dir)
+
+ ;; Check if we loaded anything on the previous line.
+ (if (ede-current-project dir)
+
+ ;; We successfully opened an existing project. Some open
+ ;; 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)
+
+ ;; ELSE
+ ;; There was no project, so switch to `ede-new' which is how
+ ;; a user can select a new kind of project to create.
+ (let ((default-directory (expand-file-name dir)))
+ (call-interactively 'ede-new))))
+
+ ;; If the proposed directory isn't safe, then say so.
+ (error "%s is not an allowed project directory in `ede-project-directories'"
+ dir)))
+
+(defun ede-check-project-directory (dir)
+ "Check if DIR should be in `ede-project-directories'.
+If it is not, try asking the user if it should be added; if so,
+add it and save `ede-project-directories' via Customize.
+Return nil iff DIR should not be in `ede-project-directories'."
+ (setq dir (directory-file-name (expand-file-name dir))) ; strip trailing /
+ (or (eq ede-project-directories t)
+ (and (functionp ede-project-directories)
+ (funcall ede-project-directories dir))
+ ;; If `ede-project-directories' is a list, maybe add it.
+ (when (listp ede-project-directories)
+ (or (member dir ede-project-directories)
+ (when (y-or-n-p (format "`%s' is not listed in `ede-project-directories'.
+Add it to the list of allowed project directories? "
+ dir))
+ (push dir ede-project-directories)
+ ;; If possible, save `ede-project-directories'.
+ (if (or custom-file user-init-file)
+ (let ((coding-system-for-read nil))
+ (customize-save-variable
+ 'ede-project-directories
+ ede-project-directories)))
+ t)))))
(defun ede-new (type &optional name)
"Create a new project starting from project type TYPE.
@@ -598,6 +751,11 @@ Optional argument NAME is the name to give this project."
(error "Cannot create project in non-existent directory %s" default-directory))
(when (not (file-writable-p default-directory))
(error "No write permissions for %s" default-directory))
+ (unless (ede-check-project-directory default-directory)
+ (error "%s is not an allowed project directory in `ede-project-directories'"
+ default-directory))
+ ;; Make sure the project directory is loadable in the future.
+ (ede-check-project-directory default-directory)
;; Create the project
(let* ((obj (object-assoc type 'name ede-project-class-files))
(nobj (let ((f (oref obj file))
@@ -631,6 +789,10 @@ Optional argument NAME is the name to give this project."
(ede-add-subproject pp nobj)
(ede-commit-project pp)))
(ede-commit-project nobj))
+ ;; Once the project is created, load it again. This used to happen
+ ;; lazily, but with project loading occurring less often and with
+ ;; security in mind, this is now the safe time to reload.
+ (ede-load-project-file default-directory)
;; Have the menu appear
(setq ede-minor-mode t)
;; Allert the user
@@ -653,11 +815,16 @@ ARGS are additional arguments to pass to method SYM."
(defun ede-rescan-toplevel ()
"Rescan all project files."
(interactive)
- (let ((toppath (ede-toplevel-project default-directory))
- (ede-deep-rescan t))
- (project-rescan (ede-load-project-file toppath))
- (ede-reset-all-buffers 1)
- ))
+ (if (not (ede-directory-get-open-project default-directory))
+ ;; This directory isn't open. Can't rescan.
+ (error "Attempt to rescan a project that isn't open")
+
+ ;; Continue
+ (let ((toppath (ede-toplevel-project default-directory))
+ (ede-deep-rescan t))
+
+ (project-rescan (ede-load-project-file toppath))
+ (ede-reset-all-buffers))))
(defun ede-new-target (&rest args)
"Create a new target specific to this type of project file.
@@ -666,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."
@@ -709,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))
@@ -893,7 +1065,7 @@ Optional ROOTRETURN will return the root project for DIR."
;; Do the load
;;(message "EDE LOAD : %S" file)
(let* ((file dir)
- (path (expand-file-name (file-name-directory file)))
+ (path (file-name-as-directory (expand-file-name dir)))
(pfc (ede-directory-project-p path))
(toppath nil)
(o nil))
@@ -922,13 +1094,11 @@ Optional ROOTRETURN will return the root project for DIR."
;; See if it's been loaded before
(setq o (object-assoc (ede-dir-to-projectfile pfc toppath) 'file
ede-projects))
- (if (not o)
- ;; If not, get it now.
- (let ((ede-constructing pfc))
- (setq o (funcall (oref pfc load-type) toppath))
- (when (not o)
- (error "Project type error: :load-type failed to create a project"))
- (ede-add-project-to-global-list o)))
+
+ ;; If not open yet, load it.
+ (unless o
+ (let ((ede-constructing pfc))
+ (setq o (ede-auto-load-project pfc toppath))))
;; Return the found root project.
(when rootreturn (set rootreturn o))
@@ -982,13 +1152,7 @@ Optional argument OBJ is an object to find the parent of."
(and root
(ede-find-subproject-for-directory root updir))
;; Try the all structure based search.
- (ede-directory-get-open-project updir)
- ;; Load up the project file as a last resort.
- ;; Last resort since it uses file-truename, and other
- ;; slow features.
- (and (ede-directory-project-p updir)
- (ede-load-project-file
- (file-name-as-directory updir))))))))))
+ (ede-directory-get-open-project updir))))))))
(defun ede-current-project (&optional dir)
"Return the current project file.
@@ -1002,11 +1166,7 @@ If optional DIR is provided, get the project for DIR instead."
;; No current project.
(when (not ans)
(let* ((ldir (or dir default-directory)))
- (setq ans (ede-directory-get-open-project ldir))
- (or ans
- ;; No open project, if this dir pass project-p, then load.
- (when (ede-directory-project-p ldir)
- (setq ans (ede-load-project-file ldir))))))
+ (setq ans (ede-directory-get-open-project ldir))))
;; Return what we found.
ans))
@@ -1061,26 +1221,35 @@ If TARGET belongs to a subproject, return that project file."
"Return the project which is the parent of TARGET.
It is recommended you track the project a different way as this function
could become slow in time."
- ;; @todo - use ede-object-project as a starting point.
- (let ((ans nil) (projs ede-projects))
- (while (and (not ans) projs)
- (setq ans (ede-target-in-project-p (car projs) target)
- projs (cdr projs)))
- ans))
+ (or ede-object-project
+ ;; If not cached, derive it from the current directory of the target.
+ (let ((ans nil) (projs ede-projects))
+ (while (and (not ans) projs)
+ (setq ans (ede-target-in-project-p (car projs) target)
+ projs (cdr projs)))
+ ans)))
(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.
@@ -1108,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))
@@ -1184,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)
@@ -1207,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."
@@ -1235,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 d08ab543b82..152f8130ad7 100644
--- a/lisp/cedet/ede/auto.el
+++ b/lisp/cedet/ede/auto.el
@@ -1,6 +1,6 @@
;;; ede/auto.el --- Autoload features for EDE
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -31,6 +31,87 @@
(require 'eieio)
+(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")
@@ -38,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.
@@ -54,10 +142,22 @@ 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
"Non-nil if this is an option when a user creates a project.")
+ (safe-p :initarg :safe-p
+ :initform t
+ :documentation
+ "Non-nil if the project load files are \"safe\".
+An unsafe project is one that loads project variables via Emacs
+Lisp code. A safe project is one that loads project variables by
+scanning files without loading Lisp code from them.")
)
"Class representing minimal knowledge set to run preliminary EDE functions.
When more advanced functionality is needed from a project type, that projects
@@ -69,21 +169,70 @@ type is required and the load function used.")
:name "Make" :file 'ede/proj
:proj-file "Project.ede"
:load-type 'ede-proj-load
- :class-sym 'ede-proj-project)
+ :class-sym 'ede-proj-project
+ :safe-p nil)
(ede-project-autoload "edeproject-automake"
:name "Automake" :file 'ede/proj
:proj-file "Project.ede"
:initializers '(:makefile-type Makefile.am)
:load-type 'ede-proj-load
- :class-sym 'ede-proj-project)
+ :class-sym 'ede-proj-project
+ :safe-p nil)
(ede-project-autoload "automake"
:name "automake" :file 'ede/project-am
: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))
@@ -91,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.
@@ -100,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)
@@ -114,14 +302,37 @@ 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)))
+(defmethod ede-auto-load-project ((this ede-project-autoload) dir)
+ "Load in the project associated with THIS project autoload description.
+THIS project description should be valid for DIR, where the project will
+be loaded."
+ ;; Last line of defense: don't load unsafe projects.
+ (when (not (or (oref this :safe-p)
+ (ede-directory-safe-p dir)))
+ (error "Attempt to load an unsafe project (bug elsewhere in EDE)"))
+ ;; Things are good - so load the project.
+ (let ((o (funcall (oref this load-type) dir)))
+ (when (not o)
+ (error "Project type error: :load-type failed to create a project"))
+ (ede-add-project-to-global-list o)))
(provide 'ede/auto)
diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el
index c6545dd9015..ebfb4154d81 100644
--- a/lisp/cedet/ede/autoconf-edit.el
+++ b/lisp/cedet/ede/autoconf-edit.el
@@ -1,6 +1,6 @@
;;; ede/autoconf-edit.el --- Keymap for autoconf
-;; Copyright (C) 1998-2000, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2000, 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project
@@ -31,7 +31,7 @@
(declare-function ede-srecode-insert "ede/srecode")
(defun autoconf-new-program (rootdir program testfile)
- "Initialize a new configure.in in ROOTDIR for PROGRAM using TESTFILE.
+ "Initialize a new configure.ac in ROOTDIR for PROGRAM using TESTFILE.
ROOTDIR is the root directory of a given autoconf controlled project.
PROGRAM is the program to be configured.
TESTFILE is the file used with AC_INIT.
@@ -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)
@@ -325,7 +328,7 @@ Optional argument PARAM is the parameter to pass to the macro as one string."
"Position the cursor where PROG is queried.
PROG is the VARIABLE to use in autoconf to identify the program.
PROG excludes the _PROG suffix. Thus if PROG were EMACS, then the
-variable in configure.in would be EMACS_PROG."
+variable in configure.ac would be EMACS_PROG."
(let ((op (point))
(found t)
(builtin (assoc prog autoconf-program-builtin)))
@@ -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 8b0bd261daf..fe12720500b 100644
--- a/lisp/cedet/ede/base.el
+++ b/lisp/cedet/ede/base.el
@@ -1,6 +1,6 @@
;;; ede/base.el --- Baseclasses for EDE.
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -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)
@@ -285,22 +285,15 @@ All specific project types must derive from this project."
;;
(defmacro ede-with-projectfile (obj &rest forms)
"For the project in which OBJ resides, execute FORMS."
- (list 'save-window-excursion
- (list 'let* (list
- (list 'pf
- (list 'if (list '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.
- (list 'ede-load-project-file
- (list 'oref obj 'path))
- obj))
- '(dbka (get-file-buffer (oref pf file))))
- '(if (not dbka) (find-file (oref pf file))
- (switch-to-buffer dbka))
- (cons 'progn forms)
- '(if (not dbka) (kill-buffer (current-buffer))))))
+ `(save-window-excursion
+ (let* ((pf (if (obj-of-class-p ,obj ede-target)
+ (ede-target-parent ,obj)
+ ,obj))
+ (dbka (get-file-buffer (oref pf file))))
+ (if (not dbka) (find-file (oref pf file))
+ (switch-to-buffer dbka))
+ ,@forms
+ (if (not dbka) (kill-buffer (current-buffer))))))
(put 'ede-with-projectfile 'lisp-indent-function 1)
;;; The EDE persistent cache.
diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el
index e4d1bf205ec..48b83f30bb0 100644
--- a/lisp/cedet/ede/cpp-root.el
+++ b/lisp/cedet/ede/cpp-root.el
@@ -1,6 +1,6 @@
;;; ede/cpp-root.el --- A simple way to wrap a C++ project with a single root
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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/custom.el b/lisp/cedet/ede/custom.el
index ac0907e8e7f..ce851a9cd4f 100644
--- a/lisp/cedet/ede/custom.el
+++ b/lisp/cedet/ede/custom.el
@@ -1,6 +1,6 @@
;;; ede/custom.el --- customization of EDE projects.
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el
index b7a98271ff3..fa56a9ac5ca 100644
--- a/lisp/cedet/ede/dired.el
+++ b/lisp/cedet/ede/dired.el
@@ -1,6 +1,6 @@
;;; ede/dired.el --- EDE extensions to dired.
-;; Copyright (C) 1998-2000, 2003, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2000, 2003, 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.4
@@ -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 c1ca8b69208..e3a5789cf3b 100644
--- a/lisp/cedet/ede/emacs.el
+++ b/lisp/cedet/ede/emacs.el
@@ -1,6 +1,6 @@
;;; ede/emacs.el --- Special project for Emacs
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -74,13 +74,16 @@ DIR is the directory to search from."
"Find the Emacs version for the Emacs src in DIR.
Return a tuple of ( EMACSNAME . VERSION )."
(let ((buff (get-buffer-create " *emacs-query*"))
+ (configure_ac "configure.ac")
(emacs "Emacs")
(ver ""))
(with-current-buffer buff
(erase-buffer)
(setq default-directory (file-name-as-directory dir))
+ (or (file-exists-p configure_ac)
+ (setq configure_ac "configure.in"))
;(call-process "egrep" nil buff nil "-n" "-e" "^version=" "Makefile")
- (call-process "egrep" nil buff nil "-n" "-e" "AC_INIT" "configure.in")
+ (call-process "egrep" nil buff nil "-n" "-e" "AC_INIT" configure_ac)
(goto-char (point-min))
;(re-search-forward "version=\\([0-9.]+\\)")
(cond
@@ -96,11 +99,22 @@ 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?
(t
- (insert-file-contents "configure.in")
+ (insert-file-contents configure_ac)
(goto-char (point-min))
(re-search-forward "AC_INIT(emacs,\\s-*\\([0-9.]+\\)\\s-*)")
(setq ver (match-string 1))
@@ -122,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 f17dfd85fdf..e5d75234b49 100644
--- a/lisp/cedet/ede/files.el
+++ b/lisp/cedet/ede/files.el
@@ -1,6 +1,6 @@
;;; ede/files.el --- Associate projects with files and directories.
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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 69570771546..c4fc5c6b6a9 100644
--- a/lisp/cedet/ede/generic.el
+++ b/lisp/cedet/ede/generic.el
@@ -1,6 +1,6 @@
;;; ede/generic.el --- Base Support for generic build systems
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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 0ed9c3054ef..5c708039ec4 100644
--- a/lisp/cedet/ede/linux.el
+++ b/lisp/cedet/ede/linux.el
@@ -1,6 +1,6 @@
;;; ede/linux.el --- Special project for Linux
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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/locate.el b/lisp/cedet/ede/locate.el
index 427b87d2bc0..03227907af4 100644
--- a/lisp/cedet/ede/locate.el
+++ b/lisp/cedet/ede/locate.el
@@ -1,6 +1,6 @@
;;; ede/locate.el --- Locate support
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -49,13 +49,7 @@
;; when it is available.
(require 'ede)
-(eval-when-compile (require 'data-debug)
- (require 'eieio-datadebug)
- (require 'cedet-global)
- (require 'cedet-idutils)
- (require 'cedet-cscope))
-
-(require 'locate)
+(eval-when-compile (require 'locate))
;;; Code:
(defcustom ede-locate-setup-options
@@ -214,6 +208,12 @@ that created this EDE locate object."
;;; GLOBAL
;;
+
+(declare-function cedet-gnu-global-version-check "cedet-global")
+(declare-function cedet-gnu-global-root "cedet-global")
+(declare-function cedet-gnu-global-expand-filename "cedet-global")
+(declare-function cedet-gnu-global-create/update-database "cedet-global")
+
(defclass ede-locate-global (ede-locate-base)
()
"EDE Locator using GNU Global.
@@ -260,6 +260,12 @@ that created this EDE locate object."
;;; IDUTILS
;;
+
+(declare-function cedet-idutils-version-check "cedet-idutils")
+(declare-function cedet-idutils-support-for-directory "cedet-idutils")
+(declare-function cedet-idutils-expand-filename "cedet-idutils")
+(declare-function cedet-idutils-create/update-database "cedet-idutils")
+
(defclass ede-locate-idutils (ede-locate-base)
()
"EDE Locator using IDUtils.
@@ -303,6 +309,12 @@ that created this EDE locate object."
;;; CSCOPE
;;
+
+(declare-function cedet-cscope-version-check "cedet-scope")
+(declare-function cedet-cscope-support-for-directory "cedet-scope")
+(declare-function cedet-cscope-expand-filename "cedet-cscope")
+(declare-function cedet-cscope-create/update-database "cedet-cscope")
+
(defclass ede-locate-cscope (ede-locate-base)
()
"EDE Locator using Cscope.
@@ -315,6 +327,7 @@ file name searching variable `cedet-cscope-file-command'.")
;; Get ourselves initialized.
(call-next-method)
;; Do the checks.
+ (require 'cedet-cscope)
(cedet-cscope-version-check)
(when (not (cedet-cscope-support-for-directory (oref loc root)))
(error "Cannot use Cscope in %s"
@@ -324,6 +337,7 @@ file name searching variable `cedet-cscope-file-command'.")
(defmethod ede-locate-ok-in-project :static ((loc ede-locate-cscope)
root)
"Is it ok to use this project type under ROOT."
+ (require 'cedet-cscope)
(cedet-cscope-version-check)
(when (cedet-cscope-support-for-directory root)
root))
@@ -334,11 +348,13 @@ file name searching variable `cedet-cscope-file-command'.")
Searches are done under the current root of the EDE project
that created this EDE locate object."
(let ((default-directory (oref loc root)))
+ (require 'cedet-cscope)
(cedet-cscope-expand-filename filesubstring)))
(defmethod ede-locate-create/update-root-database :STATIC
((loc ede-locate-cscope) root)
"Create or update the GNU Global database for the current project."
+ (require 'cedet-cscope)
(cedet-cscope-create/update-database root))
(provide 'ede/locate)
diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el
index 1c1bcd47d75..b795977a9c6 100644
--- a/lisp/cedet/ede/make.el
+++ b/lisp/cedet/ede/make.el
@@ -1,6 +1,6 @@
;;; ede/make.el --- General information about "make"
-;;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/ede/makefile-edit.el b/lisp/cedet/ede/makefile-edit.el
index 718fdf58b11..739b774ee52 100644
--- a/lisp/cedet/ede/makefile-edit.el
+++ b/lisp/cedet/ede/makefile-edit.el
@@ -1,6 +1,6 @@
;;; makefile-edit.el --- Makefile editing/scanning commands.
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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/pconf.el b/lisp/cedet/ede/pconf.el
index ae503e836d8..2e44379b809 100644
--- a/lisp/cedet/ede/pconf.el
+++ b/lisp/cedet/ede/pconf.el
@@ -1,6 +1,6 @@
;;; ede/pconf.el --- configure.ac maintenance for EDE
-;;; Copyright (C) 1998-2000, 2005, 2008-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 1998-2000, 2005, 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project
diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el
index 4065b848f54..c638a5f0307 100644
--- a/lisp/cedet/ede/pmake.el
+++ b/lisp/cedet/ede/pmake.el
@@ -1,6 +1,6 @@
;;; ede-pmake.el --- EDE Generic Project Makefile code generator.
-;; Copyright (C) 1998-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -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-archive.el b/lisp/cedet/ede/proj-archive.el
index 23ef4850b6a..e07415a6723 100644
--- a/lisp/cedet/ede/proj-archive.el
+++ b/lisp/cedet/ede/proj-archive.el
@@ -1,6 +1,6 @@
;;; ede/proj-archive.el --- EDE Generic Project archive support
-;; Copyright (C) 1998-2001, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2001, 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/ede/proj-aux.el b/lisp/cedet/ede/proj-aux.el
index 2a8f1de65e2..f5b43e1542c 100644
--- a/lisp/cedet/ede/proj-aux.el
+++ b/lisp/cedet/ede/proj-aux.el
@@ -1,6 +1,6 @@
;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support
-;; Copyright (C) 1998-2000, 2007, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2000, 2007, 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el
index 84bf8ebf1a0..87a722ef9be 100644
--- a/lisp/cedet/ede/proj-comp.el
+++ b/lisp/cedet/ede/proj-comp.el
@@ -1,6 +1,6 @@
;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver
-;; Copyright (C) 1999-2001, 2004-2005, 2007, 2009-2011
+;; Copyright (C) 1999-2001, 2004-2005, 2007, 2009-2012
;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -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 66c71063363..db8803fa002 100644
--- a/lisp/cedet/ede/proj-elisp.el
+++ b/lisp/cedet/ede/proj-elisp.el
@@ -1,6 +1,6 @@
;;; ede-proj-elisp.el --- EDE Generic Project Emacs Lisp support
-;; Copyright (C) 1998-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -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-info.el b/lisp/cedet/ede/proj-info.el
index d943e609528..80d55232949 100644
--- a/lisp/cedet/ede/proj-info.el
+++ b/lisp/cedet/ede/proj-info.el
@@ -1,6 +1,6 @@
;;; ede-proj-info.el --- EDE Generic Project texinfo support
-;;; Copyright (C) 1998-2001, 2004, 2007-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 1998-2001, 2004, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/ede/proj-misc.el b/lisp/cedet/ede/proj-misc.el
index 1c9b9bea0f4..590e0894db4 100644
--- a/lisp/cedet/ede/proj-misc.el
+++ b/lisp/cedet/ede/proj-misc.el
@@ -1,6 +1,6 @@
;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support
-;; Copyright (C) 1998-2001, 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2001, 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/ede/proj-obj.el b/lisp/cedet/ede/proj-obj.el
index 7e7d289a59a..5b7e64b6aa1 100644
--- a/lisp/cedet/ede/proj-obj.el
+++ b/lisp/cedet/ede/proj-obj.el
@@ -1,6 +1,6 @@
;;; ede/proj-obj.el --- EDE Generic Project Object code generation support
-;;; Copyright (C) 1998-2000, 2005, 2008-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 1998-2000, 2005, 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/ede/proj-prog.el b/lisp/cedet/ede/proj-prog.el
index f33f5327beb..18a00def986 100644
--- a/lisp/cedet/ede/proj-prog.el
+++ b/lisp/cedet/ede/proj-prog.el
@@ -1,6 +1,6 @@
;;; ede-proj-prog.el --- EDE Generic Project program support
-;; Copyright (C) 1998-2001, 2005, 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2001, 2005, 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/ede/proj-scheme.el b/lisp/cedet/ede/proj-scheme.el
index 6a08d4fadd1..9817d0fb60b 100644
--- a/lisp/cedet/ede/proj-scheme.el
+++ b/lisp/cedet/ede/proj-scheme.el
@@ -1,6 +1,6 @@
;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support
-;; Copyright (C) 1998-2000, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2000, 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make, scheme
diff --git a/lisp/cedet/ede/proj-shared.el b/lisp/cedet/ede/proj-shared.el
index 7268fb95646..5b192baf374 100644
--- a/lisp/cedet/ede/proj-shared.el
+++ b/lisp/cedet/ede/proj-shared.el
@@ -1,6 +1,6 @@
;;; ede-proj-shared.el --- EDE Generic Project shared library support
-;;; Copyright (C) 1998-2000, 2009-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 1998-2000, 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index a77bb02218b..8d81b825565 100644
--- a/lisp/cedet/ede/proj.el
+++ b/lisp/cedet/ede/proj.el
@@ -1,6 +1,6 @@
;;; ede/proj.el --- EDE Generic Project file driver
-;; Copyright (C) 1998-2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2003, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -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."
@@ -642,7 +661,7 @@ MFILENAME is the makefile to generate."
(defmethod ede-proj-setup-buildenvironment ((this ede-proj-project)
&optional force)
"Setup the build environment for project THIS.
-Handles the Makefile, or a Makefile.am configure.in combination.
+Handles the Makefile, or a Makefile.am configure.ac combination.
Optional argument FORCE will force items to be regenerated."
(if (not force)
(ede-proj-makefile-create-maybe this (ede-proj-dist-makefile this))
@@ -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 033a486f1a7..5053701192e 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -1,6 +1,6 @@
;;; project-am.el --- A project management scheme based on automake files.
-;; Copyright (C) 1998-2000, 2003, 2005, 2007-2011
+;; Copyright (C) 1998-2000, 2003, 2005, 2007-2012
;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -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)
@@ -896,10 +896,10 @@ files in the project."
out))
-;;; Configure.in queries.
+;;; Configure.ac queries.
;;
(defvar project-am-autoconf-file-options
- '("configure.in" "configure.ac")
+ '("configure.ac" "configure.in")
"List of possible configure files to look in for project info.")
(defun project-am-autoconf-file (dir)
@@ -948,7 +948,7 @@ Kill the Configure buffer if it was not already in a buffer."
(configfiles nil)
)
(cond
- ;; Try configure.in or configure.ac
+ ;; Try configure.ac or configure.in
(conf-in
(project-am-with-config-current conf-in
(let ((aci (autoconf-parameters-for-macro "AC_INIT"))
diff --git a/lisp/cedet/ede/shell.el b/lisp/cedet/ede/shell.el
index 194b7285a0b..526f30e8aa9 100644
--- a/lisp/cedet/ede/shell.el
+++ b/lisp/cedet/ede/shell.el
@@ -1,6 +1,6 @@
;;; ede/shell.el --- A shell controlled by EDE.
;;
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;;
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/ede/simple.el b/lisp/cedet/ede/simple.el
index 8d77cea6529..5cfa750c63f 100644
--- a/lisp/cedet/ede/simple.el
+++ b/lisp/cedet/ede/simple.el
@@ -1,6 +1,6 @@
;;; ede/simple.el --- Overlay an EDE structure on an existing project
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -50,7 +50,8 @@
:name "Simple" :file 'ede/simple
:proj-file 'ede-simple-projectfile-for-dir
:load-type 'ede-simple-load
- :class-sym 'ede-simple-project)
+ :class-sym 'ede-simple-project
+ :safe-p nil)
t)
(defcustom ede-simple-save-directory "~/.ede"
diff --git a/lisp/cedet/ede/source.el b/lisp/cedet/ede/source.el
index e5dc12d064f..956ebb43a27 100644
--- a/lisp/cedet/ede/source.el
+++ b/lisp/cedet/ede/source.el
@@ -1,6 +1,6 @@
;; ede/source.el --- EDE source code object
-;; Copyright (C) 2000, 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el
index fdf61b51b68..57e5f9f2e9b 100644
--- a/lisp/cedet/ede/speedbar.el
+++ b/lisp/cedet/ede/speedbar.el
@@ -1,6 +1,6 @@
;;; ede/speedbar.el --- Speedbar viewing of EDE projects
-;; Copyright (C) 1998-2001, 2003, 2005, 2007-2011
+;; Copyright (C) 1998-2001, 2003, 2005, 2007-2012
;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/srecode.el b/lisp/cedet/ede/srecode.el
index f7428bae04f..ccf9459cae7 100644
--- a/lisp/cedet/ede/srecode.el
+++ b/lisp/cedet/ede/srecode.el
@@ -1,6 +1,6 @@
;;; ede/srecode.el --- EDE utilities on top of SRecoder
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/ede/system.el b/lisp/cedet/ede/system.el
index b69938af4ab..4b28303a1c4 100644
--- a/lisp/cedet/ede/system.el
+++ b/lisp/cedet/ede/system.el
@@ -1,6 +1,6 @@
;;; ede-system.el --- EDE working with the system (VC, FTP, ETC)
-;; Copyright (C) 2001-2003, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2003, 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make, vc
diff --git a/lisp/cedet/ede/util.el b/lisp/cedet/ede/util.el
index 053180d4a8b..489c4d3dbf1 100644
--- a/lisp/cedet/ede/util.el
+++ b/lisp/cedet/ede/util.el
@@ -1,6 +1,6 @@
;;; ede/util.el --- EDE utilities
-;; Copyright (C) 2000, 2005, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2005, 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -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 35841d2a6b2..6b0f007916b 100644
--- a/lisp/cedet/inversion.el
+++ b/lisp/cedet/inversion.el
@@ -1,6 +1,6 @@
;;; inversion.el --- When you need something in version XX.XX
-;;; Copyright (C) 2002-2003, 2005-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2003, 2005-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.2
@@ -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/mode-local.el b/lisp/cedet/mode-local.el
index 511a3cd1d8b..11968f3fa35 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -1,6 +1,6 @@
;;; mode-local.el --- Support for mode local facilities
;;
-;; Copyright (C) 2004-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2005, 2007-2012 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -522,6 +522,9 @@ See also the function `define-overload'."
(list (mode-local--override name args body))
result)))
+;;;###autoload
+(put 'define-overloadable-function 'doc-string-elt 3)
+
(defmacro define-overloadable-function (name args docstring &rest body)
"Define a new function, as with `defun', which can be overloaded.
NAME is the name of the function to create.
@@ -546,6 +549,7 @@ defined. The default is to call the function `NAME-default' with the
appropriate arguments deduced from ARGS.
OVERARGS is a list of arguments passed to the override and
`NAME-default' function, in place of those deduced from ARGS."
+ (declare (doc-string 3))
`(eval-and-compile
(defun ,name ,args
,docstring
diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
index 4929feb0302..8f367d918dc 100644
--- a/lisp/cedet/pulse.el
+++ b/lisp/cedet/pulse.el
@@ -1,6 +1,6 @@
;;; pulse.el --- Pulsing Overlays
-;;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Version: 1.0
@@ -77,7 +77,7 @@ this flag is ignored."
(:background "#AAAA33"))
(((class color) (background light))
(:background "#FFFFAA")))
- "*Face used at beginning of a highlight."
+ "Face used at beginning of a highlight."
:group 'pulse)
(defface pulse-highlight-face
@@ -85,7 +85,7 @@ this flag is ignored."
(:background "#AAAA33"))
(((class color) (background light))
(:background "#FFFFAA")))
- "*Face used during a pulse for display. *DO NOT CUSTOMIZE*
+ "Face used during a pulse for display. *DO NOT CUSTOMIZE*
Face used for temporary highlighting of tags for effect."
:group 'pulse)
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 337413caf75..01d3206f662 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -1,6 +1,6 @@
;;; semantic.el --- Semantic buffer evaluator.
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax tools
@@ -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)
@@ -318,6 +319,11 @@ a parse of the buffer.")
"Return non-nil if the current buffer was set up for parsing."
semantic-new-buffer-fcn-was-run)
+(defsubst semantic-error-if-unparsed ()
+ "Raise an error if current buffer was not parsed by Semantic."
+ (unless semantic-new-buffer-fcn-was-run
+ (error "Buffer was not parsed by Semantic.")))
+
(defsubst semantic--umatched-syntax-needs-refresh-p ()
"Return non-nil if the unmatched syntax cache needs a refresh.
That is, if it is dirty or if the current parse tree isn't up to date."
@@ -376,7 +382,7 @@ to use Semantic, and `semantic-init-hook' is run."
"When non-nil, activate the interactive parsing debugger.
Do not set this yourself. Call `semantic-debug'.")
-(defun semantic-elapsed-time (start end)
+(defsubst semantic-elapsed-time (start end)
"Copied from elp.el. Was `elp-elapsed-time'.
Arguments START and END bound the time being calculated."
(float-time (time-subtract end start)))
@@ -550,14 +556,14 @@ is requested."
)
(defvar semantic-working-type 'percent
- "*The type of working message to use when parsing.
+ "The type of working message to use when parsing.
'percent means we are doing a linear parse through the buffer.
'dynamic means we are reparsing specific tags.")
(semantic-varalias-obsolete 'semantic-bovination-working-type
'semantic-working-type "23.2")
(defvar semantic-minimum-working-buffer-size (* 1024 5)
- "*The minimum size of a buffer before working messages are displayed.
+ "The minimum size of a buffer before working messages are displayed.
Buffers smaller than this will parse silently.
Buffers larger than this will display the working progress bar.")
@@ -623,16 +629,18 @@ was marked unparseable, then do nothing, and return the cache."
;;;; Parse the whole system.
((semantic-parse-tree-needs-rebuild-p)
- ;; Use Emacs' 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!
@@ -762,7 +770,7 @@ This function returns semantic tags without overlays."
;; Designated to ignore.
(setq stream (car nontermsym))
(if stream
- ;; Use Emacs' built-in progress reporter:
+ ;; Use Emacs's built-in progress reporter:
(and (boundp 'semantic--progress-reporter)
semantic--progress-reporter
(eq semantic-working-type 'percent)
@@ -904,75 +912,91 @@ Throw away all the old tags, and recreate the tag database."
;; Edit Tags submenu:
(define-key edit-menu [semantic-analyze-possible-completions]
'(menu-item "List Completions" semantic-analyze-possible-completions
+ :enable (semantic-active-p)
:help "Display a list of completions for the tag at point"))
(define-key edit-menu [semantic-complete-analyze-inline]
'(menu-item "Complete Tag Inline" semantic-complete-analyze-inline
+ :enable (semantic-active-p)
:help "Display inline completion for the tag at point"))
(define-key edit-menu [semantic-completion-separator]
'("--"))
(define-key edit-menu [senator-transpose-tags-down]
'(menu-item "Transpose Tags Down" senator-transpose-tags-down
- :active (semantic-current-tag)
+ :enable (and (semantic-active-p)
+ (semantic-current-tag))
:help "Transpose the current tag and the next tag"))
(define-key edit-menu [senator-transpose-tags-up]
'(menu-item "Transpose Tags Up" senator-transpose-tags-up
- :active (semantic-current-tag)
+ :enable (and (semantic-active-p)
+ (semantic-current-tag))
:help "Transpose the current tag and the previous tag"))
(define-key edit-menu [semantic-edit-separator]
'("--"))
(define-key edit-menu [senator-yank-tag]
'(menu-item "Yank Tag" senator-yank-tag
- :active (not (ring-empty-p senator-tag-ring))
+ :enable (not (ring-empty-p senator-tag-ring))
:help "Yank the head of the tag ring into the buffer"))
(define-key edit-menu [senator-copy-tag-to-register]
'(menu-item "Copy Tag To Register" senator-copy-tag-to-register
- :active (semantic-current-tag)
+ :enable (and (semantic-active-p)
+ (semantic-current-tag))
:help "Yank the head of the tag ring into the buffer"))
(define-key edit-menu [senator-copy-tag]
'(menu-item "Copy Tag" senator-copy-tag
- :active (semantic-current-tag)
+ :enable (and (semantic-active-p)
+ (semantic-current-tag))
:help "Copy the current tag to the tag ring"))
(define-key edit-menu [senator-kill-tag]
'(menu-item "Kill Tag" senator-kill-tag
- :active (semantic-current-tag)
+ :enable (and (semantic-active-p)
+ (semantic-current-tag))
:help "Kill the current tag, and copy it to the tag ring"))
;; Navigate Tags submenu:
(define-key navigate-menu [senator-narrow-to-defun]
'(menu-item "Narrow to Tag" senator-narrow-to-defun
- :active (semantic-current-tag)
+ :enable (and (semantic-active-p)
+ (semantic-current-tag))
:help "Narrow the buffer to the bounds of the current tag"))
(define-key navigate-menu [semantic-narrow-to-defun-separator]
'("--"))
(define-key navigate-menu [semantic-symref-symbol]
'(menu-item "Find Tag References..." semantic-symref-symbol
+ :enable (semantic-active-p)
:help "Read a tag and list the references to it"))
(define-key navigate-menu [semantic-complete-jump]
'(menu-item "Find Tag Globally..." semantic-complete-jump
+ :enable (semantic-active-p)
:help "Read a tag name and find it in the current project"))
(define-key navigate-menu [semantic-complete-jump-local-members]
'(menu-item "Find Local Members ..." semantic-complete-jump-local-members
+ :enable (semantic-active-p)
:help "Read a tag name and find a local member with that name"))
(define-key navigate-menu [semantic-complete-jump-local]
'(menu-item "Find Tag in This Buffer..." semantic-complete-jump-local
+ :enable (semantic-active-p)
:help "Read a tag name and find it in this buffer"))
(define-key navigate-menu [semantic-navigation-separator]
'("--"))
(define-key navigate-menu [senator-go-to-up-reference]
'(menu-item "Parent Tag" senator-go-to-up-reference
+ :enable (semantic-active-p)
:help "Navigate up one reference by tag"))
(define-key navigate-menu [senator-next-tag]
'(menu-item "Next Tag" senator-next-tag
+ :enable (semantic-active-p)
:help "Go to the next tag"))
(define-key navigate-menu [senator-previous-tag]
'(menu-item "Previous Tag" senator-previous-tag
+ :enable (semantic-active-p)
:help "Go to the previous tag"))
;; Top level menu items:
(define-key cedet-menu-map [semantic-force-refresh]
'(menu-item "Reparse Buffer" semantic-force-refresh
:help "Force a full reparse of the current buffer"
- :visible semantic-mode))
+ :visible semantic-mode
+ :enable (semantic-active-p)))
(define-key cedet-menu-map [semantic-edit-menu]
`(menu-item "Edit Tags" ,edit-menu
:visible semantic-mode))
@@ -986,6 +1010,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 +1061,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 +1083,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 +1140,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 +1197,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.el b/lisp/cedet/semantic/analyze.el
index ef09ea13b42..d03c72a5983 100644
--- a/lisp/cedet/semantic/analyze.el
+++ b/lisp/cedet/semantic/analyze.el
@@ -1,6 +1,6 @@
;;; semantic/analyze.el --- Analyze semantic tags against local context
-;; Copyright (C) 2000-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -527,7 +527,7 @@ Returns an object based on symbol `semantic-analyze-context'."
(function nil)
(fntag nil)
arg fntagend argtag
- assign asstag
+ assign asstag newseq
)
;; Pattern for Analysis:
@@ -601,16 +601,26 @@ Returns an object based on symbol `semantic-analyze-context'."
(if debug-on-error
(catch 'unfindable
- ;; If debug on error is on, allow debugging in this fcn.
(setq prefix (semantic-analyze-find-tag-sequence
- prefix scope 'prefixtypes 'unfindable)))
+ prefix scope 'prefixtypes 'unfindable))
+ ;; If there's an alias, dereference it and analyze
+ ;; sequence again.
+ (when (setq newseq
+ (semantic-analyze-dereference-alias prefix))
+ (setq prefix (semantic-analyze-find-tag-sequence
+ newseq scope 'prefixtypes 'unfindable))))
;; Debug on error is off. Capture errors and move on
(condition-case err
;; NOTE: This line is duplicated in
;; semantic-analyzer-debug-global-symbol
;; You will need to update both places.
- (setq prefix (semantic-analyze-find-tag-sequence
- prefix scope 'prefixtypes))
+ (progn
+ (setq prefix (semantic-analyze-find-tag-sequence
+ prefix scope 'prefixtypes))
+ (when (setq newseq
+ (semantic-analyze-dereference-alias prefix))
+ (setq prefix (semantic-analyze-find-tag-sequence
+ newseq scope 'prefixtypes))))
(error (semantic-analyze-push-error err))))
)
@@ -679,6 +689,20 @@ Returns an object based on symbol `semantic-analyze-context'."
;; Return our context.
context-return))
+(defun semantic-analyze-dereference-alias (taglist)
+ "Dereference first tag in TAGLIST if it is an alias.
+Returns a sequence of names which can then be fed again into
+`semantic-analyze-find-tag-sequence'.
+Returns nil if no alias was found."
+ (when (eq (semantic-tag-get-attribute (car taglist) :kind) 'alias)
+ (let ((tagname
+ (semantic-analyze-split-name
+ (semantic-tag-name
+ (car (semantic-tag-get-attribute (car taglist) :members))))))
+ (append (if (listp tagname)
+ tagname
+ (list tagname))
+ (cdr taglist)))))
(defun semantic-adebug-analyze (&optional ctxt)
"Perform `semantic-analyze-current-context'.
diff --git a/lisp/cedet/semantic/analyze/complete.el b/lisp/cedet/semantic/analyze/complete.el
index 89937f45ec8..a83f4ff0ac8 100644
--- a/lisp/cedet/semantic/analyze/complete.el
+++ b/lisp/cedet/semantic/analyze/complete.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/complete.el --- Smart Completions
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -87,20 +87,25 @@ in a buffer."
;; In theory, we don't need the below since the context will
;; do it for us.
;;(semantic-refresh-tags-safe)
- (with-syntax-table semantic-lex-syntax-table
- (let* ((context (if (semantic-analyze-context-child-p context)
- context
- (semantic-analyze-current-context context)))
- (ans (if (not context)
- (error "Nothing to complete")
- (:override))))
- ;; If interactive, display them.
- (when (called-interactively-p 'any)
- (with-output-to-temp-buffer "*Possible Completions*"
- (semantic-analyze-princ-sequence ans "" (current-buffer)))
- (shrink-window-if-larger-than-buffer
- (get-buffer-window "*Possible Completions*")))
- ans)))
+ (if (semantic-active-p)
+ (with-syntax-table semantic-lex-syntax-table
+ (let* ((context (if (semantic-analyze-context-child-p context)
+ context
+ (semantic-analyze-current-context context)))
+ (ans (if (not context)
+ (error "Nothing to complete")
+ (:override))))
+ ;; If interactive, display them.
+ (when (called-interactively-p 'any)
+ (with-output-to-temp-buffer "*Possible Completions*"
+ (semantic-analyze-princ-sequence ans "" (current-buffer)))
+ (shrink-window-if-larger-than-buffer
+ (get-buffer-window "*Possible Completions*")))
+ ans))
+ ;; Buffer was not parsed by Semantic.
+ ;; Raise error if called interactively.
+ (when (called-interactively-p 'any)
+ (error "Buffer was not parsed by Semantic."))))
(defun semantic-analyze-possible-completions-default (context &optional flags)
"Default method for producing smart completions.
diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el
index ce8e79b19dc..19c61cb74c7 100644
--- a/lisp/cedet/semantic/analyze/debug.el
+++ b/lisp/cedet/semantic/analyze/debug.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/debug.el --- Debug the analyzer
-;;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -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 967e5c59cda..d780327b7e9 100644
--- a/lisp/cedet/semantic/analyze/fcn.el
+++ b/lisp/cedet/semantic/analyze/fcn.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/fcn.el --- Analyzer support functions.
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -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 9a4459f037f..05ac56eac69 100644
--- a/lisp/cedet/semantic/analyze/refs.el
+++ b/lisp/cedet/semantic/analyze/refs.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/refs.el --- Analysis of the references between tags.
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -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.el b/lisp/cedet/semantic/bovine.el
index 036a6f38724..56bd1227993 100644
--- a/lisp/cedet/semantic/bovine.el
+++ b/lisp/cedet/semantic/bovine.el
@@ -1,6 +1,6 @@
;;; semantic/bovine.el --- LL Parser/Analyzer core.
-;; Copyright (C) 1999-2004, 2006-2007, 2009-2011
+;; Copyright (C) 1999-2004, 2006-2007, 2009-2012
;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/bovine/c-by.el b/lisp/cedet/semantic/bovine/c-by.el
index 99429f01acd..96e12bba900 100644
--- a/lisp/cedet/semantic/bovine/c-by.el
+++ b/lisp/cedet/semantic/bovine/c-by.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/c-by.el --- Generated parser support file
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -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 4da23498cfc..a3d57108d1d 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/c.el --- Semantic details for C
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -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,14 +923,16 @@ 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.
(setq semantic-new-buffer-fcn-was-run t)
(semantic-lex-init)
(semantic-clear-toplevel-cache)
- (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook
- t)
+ (remove-hook 'semantic-lex-reset-functions
+ 'semantic-lex-spp-reset-hook t)
)
;; Get the macro symbol table right.
(setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms)
@@ -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."
@@ -1735,7 +2073,9 @@ 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)
+ (add-hook 'semantic-lex-reset-functions '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/debug.el b/lisp/cedet/semantic/bovine/debug.el
index 684db1e7bbf..3680247484d 100644
--- a/lisp/cedet/semantic/bovine/debug.el
+++ b/lisp/cedet/semantic/bovine/debug.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/debug.el --- Debugger support for bovinator
-;; Copyright (C) 2003, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index 1a2061d01e7..ea99df9edb9 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp
-;; Copyright (C) 1999-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -956,7 +956,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 acbbb13170e..842ef0914fd 100644
--- a/lisp/cedet/semantic/bovine/gcc.el
+++ b/lisp/cedet/semantic/bovine/gcc.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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/admin/grammars/bovine-grammar.el b/lisp/cedet/semantic/bovine/grammar.el
index a7fe955acf4..cc27c5b0646 100644
--- a/admin/grammars/bovine-grammar.el
+++ b/lisp/cedet/semantic/bovine/grammar.el
@@ -1,6 +1,6 @@
-;;; bovine-grammar.el --- Bovine's input grammar mode
+;;; semantic/bovine/grammar.el --- Bovine's input grammar mode
;;
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -109,14 +109,6 @@ NAME, ALIASCLASS, DEFINITION and ATTRIBUTES."
;; Cache of macro definitions currently in use.
(defvar bovine--grammar-macros nil)
-;; Detect if we have an Emacs with newstyle unquotes allowed outside
-;; of backquote.
-;; This should probably be changed to a test to (= emacs-major-version 24)
-;; when it is released, but at the moment it might be possible that people
-;; are using an older snapshot.
-(defvar bovine--grammar-newstyle-unquote
- (equal '(\, test) (read ",test")))
-
(defun bovine-grammar-expand-form (form quotemode &optional inplace)
"Expand FORM into a new one suitable to the bovine parser.
FORM is a list in which we are substituting.
@@ -151,8 +143,8 @@ expanded from elsewhere."
(setq first (car form)
form (cdr form))
;; Hack for dealing with new reading of unquotes outside of
- ;; backquote (introduced in rev. 102591 in emacs-bzr).
- (when (and bovine--grammar-newstyle-unquote
+ ;; 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) '\,@)))
@@ -421,18 +413,17 @@ manual."
""))))
(defvar bovine-grammar-menu
- '("BY Grammar"
- )
+ '("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)
- )))
+ (grammar-setupcode-builder . bovine-grammar-setupcode-builder))))
(add-to-list 'auto-mode-alist '("\\.by\\'" . bovine-grammar-mode))
@@ -452,10 +443,9 @@ Menu items are appended to the common grammar menu.")
)
"Semantic grammar macros used in bovine grammars.")
-(provide 'semantic/bovine/grammar)
-
(defun bovine-make-parsers ()
"Generate Emacs' built-in Bovine-based parser files."
+ (interactive)
(semantic-mode 1)
;; Loop through each .by file in current directory, and run
;; `semantic-grammar-batch-build-one-package' to build the grammar.
@@ -465,13 +455,14 @@ Menu items are appended to the common grammar menu.")
(with-current-buffer (find-file-noselect f)
(semantic-grammar-create-package))
(error (message "%s" (error-message-string err)) nil)))
- lang)
+ lang filename)
(when (and packagename
- (string-match "^semantic-\\(.*\\)-by\\.el\\'" packagename))
+ (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename))
(setq lang (match-string 1 packagename))
+ (setq filename (concat lang "-by.el"))
(with-temp-buffer
- (insert-file-contents packagename)
- (setq buffer-file-name (expand-file-name packagename))
+ (insert-file-contents filename)
+ (setq buffer-file-name (expand-file-name filename))
;; Fix copyright header:
(goto-char (point-min))
(re-search-forward "^;; Author:")
@@ -500,20 +491,16 @@ Menu items are appended to the common grammar menu.")
lang ".by.
;;; Code:
-
-\(require 'semantic/lex)
-\(eval-when-compile (require 'semantic/bovine))\n")
+")
(goto-char (point-min))
(delete-region (point-min) (line-end-position))
- (insert ";;; semantic/bovine/" lang
- "-by.el --- Generated parser support file")
+ (insert ";;; " packagename
+ " --- Generated parser support file")
(delete-trailing-whitespace)
- ;; Fix footer:
- (goto-char (point-max))
- (re-search-backward ".\n;;; Analyzers")
- (delete-region (point) (point-max))
- (insert "(provide 'semantic/bovine/" lang "-by)\n\n")
- (insert ";;; semantic/bovine/" lang "-by.el ends here\n")
+ (re-search-forward ";;; \\(.*\\) ends here")
+ (replace-match packagename nil nil nil 1)
(save-buffer))))))
-;;; bovine-grammar.el ends here
+(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 41da728d537..59738188bbe 100644
--- a/lisp/cedet/semantic/bovine/make-by.el
+++ b/lisp/cedet/semantic/bovine/make-by.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/make-by.el --- Generated parser support file
-;; Copyright (C) 1999-2004, 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2004, 2008-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -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 e132b48441a..041e1f11902 100644
--- a/lisp/cedet/semantic/bovine/make.el
+++ b/lisp/cedet/semantic/bovine/make.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/make.el --- Makefile parsing rules.
-;; Copyright (C) 2000-2004, 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2004, 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -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 8dd170384bc..476945fa8a3 100644
--- a/lisp/cedet/semantic/bovine/scm-by.el
+++ b/lisp/cedet/semantic/bovine/scm-by.el
@@ -1,6 +1,6 @@
-;;; semantic-scm-by.el --- Generated parser support file
+;;; semantic/bovine/scm-by.el --- Generated parser support file
-;; Copyright (C) 2001, 2003, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2003, 2009-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -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 0bdd8722db1..cf2b1f0e212 100644
--- a/lisp/cedet/semantic/bovine/scm.el
+++ b/lisp/cedet/semantic/bovine/scm.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/scm.el --- Semantic details for Scheme (guile)
-;;; Copyright (C) 2001-2004, 2008-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2001-2004, 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -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/chart.el b/lisp/cedet/semantic/chart.el
index 1c08cb04d15..2c6f7344acf 100644
--- a/lisp/cedet/semantic/chart.el
+++ b/lisp/cedet/semantic/chart.el
@@ -1,6 +1,6 @@
;;; semantic/chart.el --- Utilities for use with semantic tag tables
-;; Copyright (C) 1999-2001, 2003, 2005, 2008-2011
+;; Copyright (C) 1999-2001, 2003, 2005, 2008-2012
;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -26,12 +26,9 @@
;; the output of the semantic parser.
;;
-(require 'semantic)
(require 'chart)
(require 'semantic/db)
-(require 'semantic/tag)
-
-(eval-when-compile (require 'semantic/find))
+(require 'semantic/find)
;;; Code:
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index 7e01b88f60b..59d17f2f8bb 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -1,6 +1,6 @@
;;; semantic/complete.el --- Routines for performing tag completion
-;; Copyright (C) 2003-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -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)
)
@@ -2023,6 +2088,7 @@ completion works."
(defun semantic-complete-jump-local ()
"Jump to a local semantic symbol."
(interactive)
+ (semantic-error-if-unparsed)
(let ((tag (semantic-complete-read-tag-buffer-deep "Jump to symbol: ")))
(when (semantic-tag-p tag)
(push-mark)
@@ -2036,6 +2102,7 @@ completion works."
(defun semantic-complete-jump ()
"Jump to a semantic symbol."
(interactive)
+ (semantic-error-if-unparsed)
(let* ((tag (semantic-complete-read-tag-project "Jump to symbol: ")))
(when (semantic-tag-p tag)
(push-mark)
@@ -2050,6 +2117,7 @@ completion works."
(defun semantic-complete-jump-local-members ()
"Jump to a semantic symbol."
(interactive)
+ (semantic-error-if-unparsed)
(let* ((tag (semantic-complete-read-tag-local-members "Jump to symbol: ")))
(when (semantic-tag-p tag)
(let ((start (condition-case nil (semantic-tag-start tag)
@@ -2151,6 +2219,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/ctxt.el b/lisp/cedet/semantic/ctxt.el
index 4fef5937bc3..717b261984c 100644
--- a/lisp/cedet/semantic/ctxt.el
+++ b/lisp/cedet/semantic/ctxt.el
@@ -1,6 +1,6 @@
;;; semantic/ctxt.el --- Context calculations for Semantic tools.
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/db-debug.el b/lisp/cedet/semantic/db-debug.el
index 7d1abe11dd1..e73929382bf 100644
--- a/lisp/cedet/semantic/db-debug.el
+++ b/lisp/cedet/semantic/db-debug.el
@@ -1,6 +1,6 @@
;;; semantic/db-debug.el --- Extra level debugging routines for Semantic
-;;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el
index fe5f3c193df..28e5649a865 100644
--- a/lisp/cedet/semantic/db-ebrowse.el
+++ b/lisp/cedet/semantic/db-ebrowse.el
@@ -1,6 +1,6 @@
;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse.
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;; Authors: Eric M. Ludlam <zappo@gnu.org>
;; Joakim Verona
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index 0cbff54fd1d..dbb3bfae34d 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -1,6 +1,6 @@
;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp
-;;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -31,14 +31,10 @@
;;
(require 'semantic/db)
-
-(eval-when-compile
- ;; For generic function searching.
- (require 'eieio)
- (require 'eieio-opt)
- (require 'eieio-base))
+(require 'eieio-opt)
(declare-function semantic-elisp-desymbolify "semantic/bovine/el")
+(declare-function semantic-tag-similar-p "semantic/tag-ls")
;;; Code:
@@ -57,6 +53,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 +67,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
@@ -132,7 +142,7 @@ For Emacs Lisp system DB, there isn't one."
"Convert one TAG, originating from Emacs OBJ, into standardized form.
If Emacs cannot resolve this symbol to a particular file, then return nil."
;; Here's the idea. For each tag, get the name, then use
- ;; Emacs' `symbol-file' to get the source. Once we have that,
+ ;; Emacs's `symbol-file' to get the source. Once we have that,
;; we can use more typical semantic searching techniques to
;; get a regularly parsed tag.
(let* ((type (cond ((semantic-tag-of-class-p tag 'function)
@@ -159,9 +169,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 +181,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 +200,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 9df240a3681..905c62a89dd 100644
--- a/lisp/cedet/semantic/db-file.el
+++ b/lisp/cedet/semantic/db-file.el
@@ -1,6 +1,6 @@
;;; semantic/db-file.el --- Save a semanticdb to a cache file.
-;;; Copyright (C) 2000-2005, 2007-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2000-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -25,9 +25,9 @@
;; A set of semanticdb classes for persistently saving caches on disk.
;;
-(require 'semantic)
(require 'semantic/db)
(require 'cedet-files)
+(require 'data-debug)
(defvar semanticdb-file-version semantic-version
"Version of semanticdb we are writing files to disk with.")
@@ -67,7 +67,9 @@ passes a list of predicates in `semanticdb-project-predicate-functions'."
:group 'semanticdb
:type nil)
-(defcustom semanticdb-save-database-hooks nil
+(define-obsolete-variable-alias 'semanticdb-save-database-hooks
+ 'semanticdb-save-database-functions "24.3")
+(defcustom semanticdb-save-database-functions nil
"Abnormal hook run after a database is saved.
Each function is called with one argument, the object representing
the database recently written."
@@ -140,7 +142,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 +156,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))
@@ -248,7 +250,7 @@ If DB is not specified, then use the current database."
(message "Save Error: %S: %s" (car (cdr foo))
objname)
(error "%S" (car (cdr foo))))))))
- (run-hook-with-args 'semanticdb-save-database-hooks
+ (run-hook-with-args 'semanticdb-save-database-functions
(or DB semanticdb-current-database))
;;(message "Saving tag summary for %s...done" objname)
)
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index a651e08d53c..d42ecf7c4fc 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -1,6 +1,6 @@
;;; semantic/db-find.el --- Searching through semantic databases.
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -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)
@@ -325,8 +328,10 @@ Default action as described in `semanticdb-find-translate-path'."
(cond ((null path) semanticdb-current-database)
((semanticdb-table-p path) (oref path parent-db))
(t (let ((tt (semantic-something-to-tag-table path)))
- ;; @todo - What does this DO ??!?!
- (with-current-buffer (semantic-tag-buffer (car tt))
+ (if tt
+ ;; @todo - What does this DO ??!?!
+ (with-current-buffer (semantic-tag-buffer (car tt))
+ semanticdb-current-database)
semanticdb-current-database))))))
(apply
#'nconc
@@ -877,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))
)
@@ -1320,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 7f3d616203e..a7bb130810e 100644
--- a/lisp/cedet/semantic/db-global.el
+++ b/lisp/cedet/semantic/db-global.el
@@ -1,6 +1,6 @@
;;; semantic/db-global.el --- Semantic database extensions for GLOBAL
-;; Copyright (C) 2002-2006, 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2006, 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -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-javascript.el b/lisp/cedet/semantic/db-javascript.el
index e662290340d..a7aaccf401d 100644
--- a/lisp/cedet/semantic/db-javascript.el
+++ b/lisp/cedet/semantic/db-javascript.el
@@ -1,6 +1,6 @@
;;; semantic/db-javascript.el --- Semantic database extensions for javascript
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Joakim Verona
diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el
index 8b656592603..56ce6cf06e6 100644
--- a/lisp/cedet/semantic/db-mode.el
+++ b/lisp/cedet/semantic/db-mode.el
@@ -1,6 +1,6 @@
;;; semantic/db-mode.el --- Semanticdb Minor Mode
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/db-ref.el b/lisp/cedet/semantic/db-ref.el
index 6f5489ef7ef..a021e3aff68 100644
--- a/lisp/cedet/semantic/db-ref.el
+++ b/lisp/cedet/semantic/db-ref.el
@@ -1,6 +1,6 @@
;;; semantic/db-ref.el --- Handle cross-db file references
-;;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el
index 7d23ad17009..0da98a6d357 100644
--- a/lisp/cedet/semantic/db-typecache.el
+++ b/lisp/cedet/semantic/db-typecache.el
@@ -1,6 +1,6 @@
;;; semantic/db-typecache.el --- Manage Datatypes
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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 c159a26dc1e..afac974d7fb 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -1,6 +1,6 @@
;;; semantic/db.el --- Semantic tag database manager
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -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,11 +216,10 @@ 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' own symbol table, or from external libraries.")
+Emacs's own symbol table, or from external libraries.")
(defmethod semanticdb-refresh-table ((obj semanticdb-search-results-table) &optional force)
"If the tag list associated with OBJ is loaded, refresh it.
@@ -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 6db47f8b0be..3c0bf877728 100644
--- a/lisp/cedet/semantic/debug.el
+++ b/lisp/cedet/semantic/debug.el
@@ -1,6 +1,6 @@
;;; semantic/debug.el --- Language Debugger framework
-;; Copyright (C) 2003-2005, 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005, 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -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.el b/lisp/cedet/semantic/decorate.el
index 4eeac8de141..7d1f0fb2f63 100644
--- a/lisp/cedet/semantic/decorate.el
+++ b/lisp/cedet/semantic/decorate.el
@@ -1,6 +1,6 @@
;;; semantic/decorate.el --- Utilities for decorating/highlighting tokens.
-;;; Copyright (C) 1999-2003, 2005-2007, 2009-2011
+;;; Copyright (C) 1999-2003, 2005-2007, 2009-2012
;;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el
index 766a13023e8..0c2c5e3ce37 100644
--- a/lisp/cedet/semantic/decorate/include.el
+++ b/lisp/cedet/semantic/decorate/include.el
@@ -1,6 +1,6 @@
;;; semantic/decorate/include.el --- Decoration modes for include statements
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -45,7 +45,7 @@
(defvar semantic-decoratiton-mouse-3 (if (featurep 'xemacs) [ button3 ] [ mouse-3 ])
"The keybinding lisp object to use for binding the right mouse button.")
-;;; Includes that that are in a happy state!
+;;; Includes that are in a happy state!
;;
(defface semantic-decoration-on-includes
nil
@@ -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 ea4df472afd..69dfa119167 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -1,6 +1,6 @@
;;; semantic/decorate/mode.el --- Minor mode for decorating tags
-;; Copyright (C) 2000-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -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/dep.el b/lisp/cedet/semantic/dep.el
index e47f82f391f..27ee00e8fbc 100644
--- a/lisp/cedet/semantic/dep.el
+++ b/lisp/cedet/semantic/dep.el
@@ -1,6 +1,6 @@
;;; semantic/dep.el --- Methods for tracking dependencies (include files)
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el
index ec3b5878c63..8a4e61fbad2 100644
--- a/lisp/cedet/semantic/doc.el
+++ b/lisp/cedet/semantic/doc.el
@@ -1,6 +1,6 @@
;;; semantic/doc.el --- Routines for documentation strings
-;; Copyright (C) 1999-2003, 2005, 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2003, 2005, 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -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 3a30a931d95..16cf0ca96a2 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -1,6 +1,6 @@
;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files
-;; Copyright (C) 2003-2004, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -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/edit.el b/lisp/cedet/semantic/edit.el
index d33454eb56b..5b39dec2628 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -1,6 +1,6 @@
;;; semantic/edit.el --- Edit Management for Semantic
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -72,7 +72,9 @@ updated in the current buffer.
For language specific hooks, make sure you define this as a local hook.")
-(defvar semantic-change-hooks
+(define-obsolete-variable-alias 'semantic-change-hooks
+ 'semantic-change-functions "24.3")
+(defvar semantic-change-functions
'(semantic-edits-change-function-handle-changes)
"Abnormal hook run when semantic detects a change in a buffer.
Each hook function must take three arguments, identical to the
@@ -89,11 +91,15 @@ If the hook returns non-nil, then declare that a reparse is needed.
For language specific hooks, make sure you define this as a local hook.
Not used yet; part of the next generation reparse mechanism.")
-(defvar semantic-edits-new-change-hooks nil
+(define-obsolete-variable-alias 'semantic-edits-new-change-hooks
+ 'semantic-edits-new-change-functions "24.3")
+(defvar semantic-edits-new-change-functions nil
"Abnormal hook run when a new change is found.
Functions must take one argument representing an overlay on that change.")
-(defvar semantic-edits-delete-change-hooks nil
+(define-obsolete-variable-alias 'semantic-edits-delete-change-hooks
+ 'semantic-edits-delete-change-functions "24.3")
+(defvar semantic-edits-delete-change-functions nil
"Abnormal hook run before a change overlay is deleted.
Deleted changes occur when multiple changes are merged.
Functions must take one argument representing an overlay being deleted.")
@@ -104,7 +110,9 @@ Changes move when a new change overlaps an old change. The old change
will be moved.
Functions must take one argument representing an overlay being moved.")
-(defvar semantic-edits-reparse-change-hooks nil
+(define-obsolete-variable-alias 'semantic-edits-reparse-change-hooks
+ 'semantic-edits-reparse-change-functions "24.3")
+(defvar semantic-edits-reparse-change-functions nil
"Abnormal hook run after a change results in a reparse.
Functions are called before the overlay is deleted, and after the
incremental reparse.")
@@ -133,7 +141,7 @@ Argument START, END, and LENGTH specify the bounds of the change."
(setq semantic-unmatched-syntax-cache-check t)
(let ((inhibit-point-motion-hooks t)
)
- (run-hook-with-args 'semantic-change-hooks start end length)
+ (run-hook-with-args 'semantic-change-functions start end length)
))
(defun semantic-changes-in-region (start end &optional buffer)
@@ -168,7 +176,7 @@ Argument START, END, and LENGTH specify the bounds of the change."
;; function will be removed from the list of active change
;; functions.
(condition-case nil
- (run-hook-with-args 'semantic-edits-new-change-hooks o)
+ (run-hook-with-args 'semantic-edits-new-change-functions o)
(error nil)))
(let ((tmp changes-in-change))
;; Find greatest bounds of all changes
@@ -188,7 +196,7 @@ Argument START, END, and LENGTH specify the bounds of the change."
;; Delete other changes. They are now all bound here.
(while changes-in-change
(condition-case nil
- (run-hook-with-args 'semantic-edits-delete-change-hooks
+ (run-hook-with-args 'semantic-edits-delete-change-functions
(car changes-in-change))
(error nil))
(semantic-overlay-delete (car changes-in-change))
@@ -198,7 +206,7 @@ Argument START, END, and LENGTH specify the bounds of the change."
(defsubst semantic-edits-flush-change (change)
"Flush the CHANGE overlay."
(condition-case nil
- (run-hook-with-args 'semantic-edits-delete-change-hooks
+ (run-hook-with-args 'semantic-edits-delete-change-functions
change)
(error nil))
(semantic-overlay-delete change))
diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el
index a6d86691206..5c724a96d40 100644
--- a/lisp/cedet/semantic/find.el
+++ b/lisp/cedet/semantic/find.el
@@ -1,6 +1,6 @@
;;; semantic/find.el --- Search routines for Semantic
-;; Copyright (C) 1999-2005, 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -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/format.el b/lisp/cedet/semantic/format.el
index 876ec9bbd4a..158c32b15c3 100644
--- a/lisp/cedet/semantic/format.el
+++ b/lisp/cedet/semantic/format.el
@@ -1,6 +1,6 @@
;;; semantic/format.el --- Routines for formatting tags
-;; Copyright (C) 1999-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index 479044ec518..6dd85309967 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -1,6 +1,6 @@
;;; semantic/fw.el --- Framework for Semantic
-;;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -33,42 +33,138 @@
(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)))))
+ )
+
+
+ (defalias 'semantic-make-local-hook
+ (if (and (not (featurep 'xemacs))
+ (>= emacs-major-version 21))
+ #'identity #'make-local-hook))
+
+ (defalias 'semantic-mode-line-update
+ (if (featurep 'xemacs) #'redraw-modeline #'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 +234,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 +274,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 +292,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 +389,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,21 +409,17 @@ 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
(auto-insert nil)
;; We don't want emacs to query about unsafe local variables
- (enable-local-variables
- (if (featurep 'xemacs)
- ;; XEmacs only has nil as an option?
- nil
- ;; Emacs 23 has the spiffy :safe option, nil otherwise.
- (if (>= emacs-major-version 22)
- nil
- :safe)))
+ (enable-local-variables :safe)
;; ... or eval variables
(enable-local-eval nil)
)
diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el
index 879fdd92331..a926f636b4b 100644
--- a/lisp/cedet/semantic/grammar-wy.el
+++ b/lisp/cedet/semantic/grammar-wy.el
@@ -1,9 +1,6 @@
;;; semantic/grammar-wy.el --- Generated parser support file
-;; Copyright (C) 2002-2004, 2009-2011 Free Software Foundation, Inc.
-
-;; Author: David Ponce <david@dponce.com>
-;; Keywords: syntax
+;; Copyright (C) 2002-2004, 2009-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -26,7 +23,10 @@
;;; Code:
-(require 'semantic/lex)
+(require 'semantic)
+
+;;; Prologue
+;;
(defvar semantic-grammar-lex-c-char-re)
;; Current parsed nonterminal name.
@@ -45,6 +45,7 @@
("%left" . LEFT)
("%nonassoc" . NONASSOC)
("%package" . PACKAGE)
+ ("%provide" . PROVIDE)
("%prec" . PREC)
("%put" . PUT)
("%quotemode" . QUOTEMODE)
@@ -109,7 +110,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 +134,7 @@
((no_default_prec_decl))
((languagemode_decl))
((package_decl))
+ ((provide_decl))
((precedence_decl))
((put_decl))
((quotemode_decl))
@@ -161,6 +163,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 +417,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 +443,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 +469,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 1a79adc650d..8535c067e09 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -1,6 +1,6 @@
;;; semantic/grammar.el --- Major mode framework for Semantic grammars
-;; Copyright (C) 2002-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -30,10 +30,13 @@
;;; Code:
(require 'semantic)
+(require 'semantic/wisent)
(require 'semantic/ctxt)
(require 'semantic/format)
(require 'semantic/grammar-wy)
(require 'semantic/idle)
+(require 'help-fns)
+
(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 +45,11 @@
(eval-when-compile
(require 'eldoc)
(require 'semantic/edit)
- (require 'semantic/find))
+ (require 'semantic/find)
+ (require 'semantic/db))
+
+(declare-function semantic-grammar-wy--install-parser
+ "semantic/gram-wy-fallback")
;;;;
@@ -451,7 +458,7 @@ Also load the specified macro libraries."
',(semantic-grammar-keyword-properties keywords))))
(define-overloadable-function semantic-grammar-keywordtable-builder ()
- "Return the keyword table table value.")
+ "Return the keyword table value.")
;;; Token table builder
;;
@@ -488,33 +495,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 +593,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 +646,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 +753,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 +804,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)
@@ -827,16 +829,22 @@ Does nothing if the Lisp code seems up to date.
If optional argument FORCE is non-nil, unconditionally re-generate the
Lisp code."
(interactive "P")
+ (unless (semantic-active-p)
+ (error "You have to activate semantic-mode to create a package."))
(setq force (or force current-prefix-arg))
(semantic-fetch-tags)
(let* (
;; 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 +855,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 +973,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 +1012,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))
@@ -1322,8 +1333,8 @@ the change bounds to encompass the whole nonterminal tag."
(add-hook 'before-change-functions
'semantic--grammar-clear-macros-regexp-2 nil t)
;; Handle safe re-parse of grammar rules.
- (semantic-make-local-hook 'semantic-edits-new-change-hooks)
- (add-hook 'semantic-edits-new-change-hooks
+ (semantic-make-local-hook 'semantic-edits-new-change-functions)
+ (add-hook 'semantic-edits-new-change-functions
'semantic-grammar-edits-new-change-hook-fcn
nil t)
(semantic-run-mode-hooks 'semantic-grammar-mode-hook))
@@ -1631,6 +1642,12 @@ Select the buffer containing the tag's definition, and move point there."
)
"Association of syntax elements, and the corresponding help.")
+(declare-function eldoc-function-argstring "eldoc")
+(declare-function eldoc-docstring-format-sym-doc "eldoc")
+(declare-function eldoc-last-data-store "eldoc")
+(declare-function eldoc-get-fnsym-args-string "eldoc")
+(declare-function eldoc-get-var-docstring "eldoc")
+
(defun semantic-grammar-eldoc-get-macro-docstring (macro expander)
"Return a one-line docstring for the given grammar MACRO.
EXPANDER is the name of the function that expands MACRO."
diff --git a/lisp/cedet/semantic/html.el b/lisp/cedet/semantic/html.el
index a7d150ec4a9..5fec7fcdb1e 100644
--- a/lisp/cedet/semantic/html.el
+++ b/lisp/cedet/semantic/html.el
@@ -1,6 +1,6 @@
;;; semantic/html.el --- Semantic details for html files
-;; Copyright (C) 2004-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/ia-sb.el b/lisp/cedet/semantic/ia-sb.el
index edd62cc5ca5..f898b6565fd 100644
--- a/lisp/cedet/semantic/ia-sb.el
+++ b/lisp/cedet/semantic/ia-sb.el
@@ -1,6 +1,6 @@
;;; semantic/ia-sb.el --- Speedbar analysis display interactor
-;;; Copyright (C) 2002-2004, 2006, 2008-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2004, 2006, 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el
index 2aae39d4b21..9f6a82159e8 100644
--- a/lisp/cedet/semantic/ia.el
+++ b/lisp/cedet/semantic/ia.el
@@ -1,6 +1,6 @@
;;; semantic/ia.el --- Interactive Analysis functions
-;;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -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 c60ca4b4b6a..57cb17a233e 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -1,6 +1,6 @@
;;; idle.el --- Schedule parsing tasks in idle time
-;; Copyright (C) 2003-2006, 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2006, 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -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/imenu.el b/lisp/cedet/semantic/imenu.el
index 7566c08f13a..22a23e526a2 100644
--- a/lisp/cedet/semantic/imenu.el
+++ b/lisp/cedet/semantic/imenu.el
@@ -1,6 +1,6 @@
;;; semantic/imenu.el --- Use Semantic as an imenu tag generator
-;;; Copyright (C) 2000-2005, 2007-2008, 2010-2011
+;;; Copyright (C) 2000-2005, 2007-2008, 2010-2012
;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el
index c3075634242..e560e6ecab2 100644
--- a/lisp/cedet/semantic/java.el
+++ b/lisp/cedet/semantic/java.el
@@ -1,6 +1,6 @@
;;; semantic/java.el --- Semantic functions for Java
-;;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
@@ -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 cf82da303ce..ad366c2b94f 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -1,6 +1,6 @@
;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -30,7 +30,7 @@
;; If you use SPP in your language, be sure to specify this in your
;; semantic language setup function:
;;
-;; (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t)
+;; (add-hook 'semantic-lex-reset-functions 'semantic-lex-spp-reset-hook nil t)
;;
;;
;; Special Lexical Tokens:
@@ -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 segement 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,14 +936,19 @@ 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.
(setq semantic-new-buffer-fcn-was-run t)
(semantic-lex-init)
(semantic-clear-toplevel-cache)
- (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook
- t)
+ (remove-hook 'semantic-lex-reset-functions
+ 'semantic-lex-spp-reset-hook t)
))
;; Second Cheat: copy key variables regarding macro state from the
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index f8e72c1027c..274df355901 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -1,6 +1,6 @@
;;; semantic/lex.el --- Lexical Analyzer builder
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -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.
@@ -743,7 +729,9 @@ This is an alist of (ANCHOR . STREAM) elements where ANCHOR is the
start position of the block, and STREAM is the list of tokens in that
block.")
-(defvar semantic-lex-reset-hooks nil
+(define-obsolete-variable-alias 'semantic-lex-reset-hooks
+ 'semantic-lex-reset-functions "24.3")
+(defvar semantic-lex-reset-functions nil
"Abnormal hook used by major-modes to reset lexical analyzers.
Hook functions are called with START and END values for the
current lexical pass. Should be set with `add-hook', specifying
@@ -754,6 +742,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.
@@ -771,7 +773,7 @@ analyzer which might mistake a number for as a symbol."
;; Make sure the state of block parsing starts over.
(setq semantic-lex-block-streams nil)
;; Allow specialty reset items.
- (run-hook-with-args 'semantic-lex-reset-hooks start end)
+ (run-hook-with-args 'semantic-lex-reset-functions start end)
;; Lexing state.
(let* (;(starttime (current-time))
(starting-position (point))
@@ -1205,11 +1207,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 47915e8ad58..1358fc7d062 100644
--- a/lisp/cedet/semantic/mru-bookmark.el
+++ b/lisp/cedet/semantic/mru-bookmark.el
@@ -1,6 +1,6 @@
;;; semantic/mru-bookmark.el --- Automatic bookmark tracking
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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
;;
@@ -291,13 +292,13 @@ minor mode is enabled."
(setq semantic-mru-bookmark-mode nil)
(error "Buffer %s was not set up for parsing"
(buffer-name)))
- (semantic-make-local-hook 'semantic-edits-new-change-hooks)
- (add-hook 'semantic-edits-new-change-hooks
+ (semantic-make-local-hook 'semantic-edits-new-change-functions)
+ (add-hook 'semantic-edits-new-change-functions
'semantic-mru-bookmark-change-hook-fcn nil t)
(add-hook 'semantic-edits-move-change-hooks
'semantic-mru-bookmark-change-hook-fcn nil t))
;; Remove hooks
- (remove-hook 'semantic-edits-new-change-hooks
+ (remove-hook 'semantic-edits-new-change-functions
'semantic-mru-bookmark-change-hook-fcn t)
(remove-hook 'semantic-edits-move-change-hooks
'semantic-mru-bookmark-change-hook-fcn t)))
@@ -363,7 +364,7 @@ Argument PROMPT is the prompt to use when reading."
(setq ans (assoc ans alist))
(if ans
(cdr ans)
- ;; no match. Custom word. Look it up somwhere?
+ ;; no match. Custom word. Look it up somewhere?
nil)
)))
diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el
index 8c3d6c17cf4..1da0003db8e 100644
--- a/lisp/cedet/semantic/sb.el
+++ b/lisp/cedet/semantic/sb.el
@@ -1,6 +1,6 @@
;;; semantic/sb.el --- Semantic tag display for speedbar
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index 937936032d2..0882120fc65 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -1,6 +1,6 @@
;;; semantic/scope.el --- Analyzer Scope Calculations
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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/senator.el b/lisp/cedet/semantic/senator.el
index b4618d1c18f..1138c13096a 100644
--- a/lisp/cedet/semantic/senator.el
+++ b/lisp/cedet/semantic/senator.el
@@ -1,6 +1,6 @@
;;; semantic/senator.el --- SEmantic NAvigaTOR
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: FSF
@@ -255,6 +255,7 @@ TEXT, BOUND, NOERROR, and COUNT arguments are interpreted."
"Navigate to the next Semantic tag.
Return the tag or nil if at end of buffer."
(interactive)
+ (semantic-error-if-unparsed)
(let ((pos (point))
(tag (semantic-current-tag))
where)
@@ -294,6 +295,7 @@ Return the tag or nil if at end of buffer."
"Navigate to the previous Semantic tag.
Return the tag or nil if at beginning of buffer."
(interactive)
+ (semantic-error-if-unparsed)
(let ((pos (point))
(tag (semantic-current-tag))
where)
@@ -519,6 +521,7 @@ If that parent which is only a reference in the function tag
is found, we can jump to it.
Some tags such as includes have other reference features."
(interactive)
+ (semantic-error-if-unparsed)
(let ((result (semantic-up-reference (or tag (semantic-current-tag)))))
(if (not result)
(error "No up reference found")
diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el
index a4126e1384b..61218ffd3a9 100644
--- a/lisp/cedet/semantic/sort.el
+++ b/lisp/cedet/semantic/sort.el
@@ -1,6 +1,6 @@
;;; semantic/sort.el --- Utilities for sorting and re-arranging tag tables.
-;;; Copyright (C) 1999-2005, 2007-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el
index cbae9f85573..ad897680d7f 100644
--- a/lisp/cedet/semantic/symref.el
+++ b/lisp/cedet/semantic/symref.el
@@ -1,6 +1,6 @@
;;; semantic/symref.el --- Symbol Reference API
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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.
@@ -356,7 +356,7 @@ already."
(lambda (hit)
(let* ((line (car hit))
(file (cdr hit))
- (buff (get-file-buffer file))
+ (buff (find-buffer-visiting file))
(tag nil)
)
(cond
@@ -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/cscope.el b/lisp/cedet/semantic/symref/cscope.el
index b74b0501c28..e999c35e28d 100644
--- a/lisp/cedet/semantic/symref/cscope.el
+++ b/lisp/cedet/semantic/symref/cscope.el
@@ -1,6 +1,6 @@
;;; semantic/symref/cscope.el --- Semantic-symref support via cscope.
-;;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/symref/filter.el b/lisp/cedet/semantic/symref/filter.el
index 1676e0764d9..c6aa48bfbc3 100644
--- a/lisp/cedet/semantic/symref/filter.el
+++ b/lisp/cedet/semantic/symref/filter.el
@@ -1,6 +1,6 @@
;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy.
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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/global.el b/lisp/cedet/semantic/symref/global.el
index 5af42a96581..7aa46fd6c17 100644
--- a/lisp/cedet/semantic/symref/global.el
+++ b/lisp/cedet/semantic/symref/global.el
@@ -1,6 +1,6 @@
;;; semantic/symref/global.el --- Use GNU Global for symbol references
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el
index da250e66bb5..675a4476e2d 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -1,6 +1,6 @@
;;; semantic/symref/grep.el --- Symref implementation using find/grep
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/symref/idutils.el b/lisp/cedet/semantic/symref/idutils.el
index 6098f0265ef..0fdcc0396dc 100644
--- a/lisp/cedet/semantic/symref/idutils.el
+++ b/lisp/cedet/semantic/symref/idutils.el
@@ -1,6 +1,6 @@
;;; semantic/symref/idutils.el --- Symref implementation for idutils
-;;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el
index 53422541c47..729bd8e153c 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -1,6 +1,6 @@
;;; semantic/symref/list.el --- Symref Output List UI.
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -69,7 +69,7 @@ current project to find references to the input SYM. The
references are organized by file and the name of the function
they are used in.
Display the references in `semantic-symref-results-mode'."
- (interactive (list (semantic-tag-name (semantic-complete-read-tag-buffer-deep
+ (interactive (list (semantic-tag-name (semantic-complete-read-tag-project
"Symrefs for: "))))
(semantic-fetch-tags)
(let ((res nil)
@@ -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-file.el b/lisp/cedet/semantic/tag-file.el
index 86fa382a766..8a126c3a6f9 100644
--- a/lisp/cedet/semantic/tag-file.el
+++ b/lisp/cedet/semantic/tag-file.el
@@ -1,6 +1,6 @@
;;; semantic/tag-file.el --- Routines that find files based on tags.
-;; Copyright (C) 1999-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el
index 2f585cbdf45..094ea554287 100644
--- a/lisp/cedet/semantic/tag-ls.el
+++ b/lisp/cedet/semantic/tag-ls.el
@@ -1,6 +1,6 @@
;;; semantic/tag-ls.el --- Language Specific override functions for tags
-;; Copyright (C) 1999-2004, 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -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 d54d007f221..69d26245850 100644
--- a/lisp/cedet/semantic/tag-write.el
+++ b/lisp/cedet/semantic/tag-write.el
@@ -1,6 +1,6 @@
;;; semantic/tag-write.el --- Write tags to a text stream
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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 f8538ef7901..38166871cea 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -1,6 +1,6 @@
;;; semantic/tag.el --- tag creation and access
-;; Copyright (C) 1999-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -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 78d5569c2a7..d79e71bb265 100644
--- a/lisp/cedet/semantic/texi.el
+++ b/lisp/cedet/semantic/texi.el
@@ -1,6 +1,6 @@
;;; semantic/texi.el --- Semantic details for Texinfo files
-;; Copyright (C) 2001-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -26,17 +26,11 @@
;; parser plug-in is the function `semantic-texi-parse-region' that
;; overrides `semantic-parse-region'.
-(require 'semantic)
+(require 'semantic/db-find)
(require 'semantic/format)
+(require 'semantic/ctxt)
(require 'texinfo)
-(eval-when-compile
- (require 'semantic/db)
- (require 'semantic/db-find)
- (require 'semantic/ctxt)
- (require 'semantic/find)
- (require 'semantic/doc))
-
(defvar ede-minor-mode)
(declare-function lookup-words "ispell")
(declare-function ede-current-project "ede")
@@ -451,6 +445,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 +682,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-modes.el b/lisp/cedet/semantic/util-modes.el
index 13836f64b85..744d37ff189 100644
--- a/lisp/cedet/semantic/util-modes.el
+++ b/lisp/cedet/semantic/util-modes.el
@@ -1,6 +1,6 @@
;;; semantic/util-modes.el --- Semantic minor modes
-;; Copyright (C) 2000-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2012 Free Software Foundation, Inc.
;; Authors: Eric M. Ludlam <zappo@gnu.org>
;; David Ponce <david@dponce.com>
@@ -221,11 +221,11 @@ minor mode is enabled."
(setq semantic-highlight-edits-mode nil)
(error "Buffer %s was not set up for parsing"
(buffer-name)))
- (semantic-make-local-hook 'semantic-edits-new-change-hooks)
- (add-hook 'semantic-edits-new-change-hooks
+ (semantic-make-local-hook 'semantic-edits-new-change-functions)
+ (add-hook 'semantic-edits-new-change-functions
'semantic-highlight-edits-new-change-hook-fcn nil t))
;; Remove hooks
- (remove-hook 'semantic-edits-new-change-hooks
+ (remove-hook 'semantic-edits-new-change-functions
'semantic-highlight-edits-new-change-hook-fcn t)))
(semantic-add-minor-mode 'semantic-highlight-edits-mode
@@ -460,8 +460,8 @@ minor mode is enabled."
(append mode-line-modified
'(semantic-show-parser-state-string))))
;; Add hooks
- (semantic-make-local-hook 'semantic-edits-new-change-hooks)
- (add-hook 'semantic-edits-new-change-hooks
+ (semantic-make-local-hook 'semantic-edits-new-change-functions)
+ (add-hook 'semantic-edits-new-change-functions
'semantic-show-parser-state-marker nil t)
(semantic-make-local-hook 'semantic-edits-incremental-reparse-failed-hook)
(add-hook 'semantic-edits-incremental-reparse-failed-hook
@@ -491,7 +491,7 @@ minor mode is enabled."
(setq mode-line-modified
(delq 'semantic-show-parser-state-string mode-line-modified))
;; Remove hooks
- (remove-hook 'semantic-edits-new-change-hooks
+ (remove-hook 'semantic-edits-new-change-functions
'semantic-show-parser-state-marker t)
(remove-hook 'semantic-edits-incremental-reparse-failed-hook
'semantic-show-parser-state-marker t)
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index acf5f95a217..f3d30f6af5c 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -1,6 +1,6 @@
;;; semantic/util.el --- Utilities for use with semantic tag tables
-;;; Copyright (C) 1999-2005, 2007-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -280,7 +280,7 @@ If TAG is not specified, use the tag at point."
semantic-parser-name
semantic-parse-tree-state
semantic-lex-analyzer
- semantic-lex-reset-hooks
+ semantic-lex-reset-functions
semantic-lex-syntax-modifications
)))
(dolist (V vars)
@@ -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.el b/lisp/cedet/semantic/wisent.el
index 04669b99660..f12ca3753b8 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -1,6 +1,6 @@
;;; semantic/wisent.el --- Wisent - Semantic gateway
-;; Copyright (C) 2001-2007, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2007, 2009-2012 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index 0aff8325252..388c8f332a4 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/comp.el --- GNU Bison for Emacs - Grammar compiler
-;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000-2007, 2009-2011
+;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000-2007, 2009-2012
;; Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
@@ -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))
@@ -550,7 +553,7 @@ S must be a vector of integers."
N Ns)))
(setq N Np)))
-(defun wisent-inaccessable-symbols ()
+(defun wisent-inaccessible-symbols ()
"Find out which productions are reachable and which symbols are used."
;; Starting with an empty set of productions and a set of symbols
;; which only has the start symbol in it, iterate over all
@@ -709,7 +712,7 @@ S must be a vector of integers."
nuseless-productions 0)
(wisent-useless-nonterminals)
- (wisent-inaccessable-symbols)
+ (wisent-inaccessible-symbols)
(when (> (+ nuseless-nonterminals nuseless-productions) 0)
(wisent-total-useless)
@@ -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/admin/grammars/wisent-grammar.el b/lisp/cedet/semantic/wisent/grammar.el
index 66045c2294d..6fa52dc2adc 100644
--- a/admin/grammars/wisent-grammar.el
+++ b/lisp/cedet/semantic/wisent/grammar.el
@@ -1,6 +1,6 @@
-;;; wisent-grammar.el --- Wisent's input grammar mode
+;;; semantic/wisent/grammar.el --- Wisent's input grammar mode
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -209,15 +209,15 @@ See also the function `wisent-skip-token'."
"Return the list of terminal symbols.
Keep order of declaration in the WY file without duplicates."
(let (terms)
- (mapcar
+ (mapc
#'(lambda (tag)
- (mapcar #'(lambda (name)
- (add-to-list 'terms (intern name)))
- (cons (semantic-tag-name tag)
- (semantic-tag-get-attribute tag :rest))))
+ (mapcar #'(lambda (name)
+ (add-to-list 'terms (intern name)))
+ (cons (semantic-tag-name tag)
+ (semantic-tag-get-attribute tag :rest))))
(semantic--find-tags-by-function
#'(lambda (tag)
- (memq (semantic-tag-class tag) '(token keyword)))
+ (memq (semantic-tag-class tag) '(token keyword)))
(current-buffer)))
(nreverse terms)))
@@ -323,15 +323,13 @@ Return the expanded expression."
"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)
- )))
-
-(add-to-list 'auto-mode-alist '("\\.wy\\'" . wisent-grammar-mode))
+ (grammar-setupcode-builder . wisent-grammar-setupcode-builder))))
(defvar-mode-local wisent-grammar-mode semantic-grammar-macros
'(
@@ -464,23 +462,20 @@ Menu items are appended to the common grammar menu.")
;; DAMAGE.")
(defvar wisent-make-parsers--parser-file-name
- `(("semantic-grammar-wy.el"
- "semantic/grammar-wy")
- ("srecode-template-wy.el"
- "srecode/srt-wy")
- ("wisent-javascript-jv-wy.el"
- "semantic/wisent/js-wy"
- "Copyright (C) 1998-2011 Ecma International"
+ `(("semantic/grammar-wy.el")
+ ("srecode/srt-wy.el")
+ ("semantic/wisent/js-wy.el"
+ "Copyright (C) 1998-2011 Ecma International."
,wisent-make-parsers--ecmascript-license)
- ("wisent-java-tags-wy.el"
- "semantic/wisent/javat-wy")
- ("wisent-python-wy.el"
- "semantic/wisent/python-wy"
- "Copyright (C) 2001-2010 Python Software Foundation"
+ ("semantic/wisent/javat-wy.el")
+ ("semantic/wisent/python-wy.el"
+ "Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+\;; 2009, 2010 Python Software Foundation; All Rights Reserved"
,wisent-make-parsers--python-license)))
(defun wisent-make-parsers ()
"Generate Emacs' built-in Wisent-based parser files."
+ (interactive)
(semantic-mode 1)
;; Loop through each .wy file in current directory, and run
;; `semantic-grammar-batch-build-one-package' to build the grammar.
@@ -492,13 +487,13 @@ Menu items are appended to the common grammar menu.")
(error (message "%s" (error-message-string err)) nil)))
output-data)
(when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name))
- (let ((require-name (nth 1 output-data))
- (additional-copyright (nth 2 output-data))
- (additional-license (nth 3 output-data))
+ (let ((additional-copyright (nth 1 output-data))
+ (additional-license (nth 2 output-data))
+ (filename (progn (string-match ".*/\\(.*\\)" packagename) (match-string 1 packagename)))
copyright-end)
;; Touch up the generated parsers for Emacs integration.
(with-temp-buffer
- (insert-file-contents packagename)
+ (insert-file-contents filename)
;; Fix copyright header:
(goto-char (point-min))
(when additional-copyright
@@ -516,22 +511,16 @@ Menu items are appended to the common grammar menu.")
f ".")
(when additional-license
(insert "\n" additional-license))
- (insert "\n\n;;; Code:\n
-\(require 'semantic/lex)\n")
+ (insert "\n\n;;; Code:\n")
(goto-char (point-min))
(delete-region (point-min) (line-end-position))
- (insert ";;; " require-name
- ".el --- Generated parser support file")
+ (insert ";;; " packagename
+ " --- Generated parser support file")
+ (re-search-forward ";;; \\(.*\\) ends here")
+ (replace-match packagename nil nil nil 1)
(delete-trailing-whitespace)
- (re-search-forward ";;\n(require 'semantic/lex)\n")
- (delete-region (match-beginning 0) (match-end 0))
- ;; Fix footer:
- (goto-char (point-max))
- (re-search-backward "^(provide")
- (delete-region (match-beginning 0) (point-max))
- (goto-char (point-max))
- (insert "(provide '" require-name ")\n\n")
- (insert ";;; " require-name ".el ends here\n")
- (write-region nil nil (expand-file-name packagename))))))))
-
-;;; wisent-grammar.el ends here
+ (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 f3d11d38512..a85935ad83b 100644
--- a/lisp/cedet/semantic/wisent/java-tags.el
+++ b/lisp/cedet/semantic/wisent/java-tags.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs
-;; Copyright (C) 2001-2006, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2006, 2009-2012 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -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 16b729f3925..610df0edc86 100644
--- a/lisp/cedet/semantic/wisent/javascript.el
+++ b/lisp/cedet/semantic/wisent/javascript.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/javascript.el --- javascript parser support
-;; Copyright (C) 2005, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -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,60 @@ 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.
+(define-child-mode js-mode javascript-mode)
;; In semantic-imenu.el, not part of Emacs.
(defvar semantic-imenu-summary-function)
diff --git a/lisp/cedet/semantic/wisent/javat-wy.el b/lisp/cedet/semantic/wisent/javat-wy.el
index 562b0da6caa..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 c8dded08d1f..92c5aa6b0d2 100644
--- a/lisp/cedet/semantic/wisent/js-wy.el
+++ b/lisp/cedet/semantic/wisent/js-wy.el
@@ -1,7 +1,7 @@
;;; semantic/wisent/js-wy.el --- Generated parser support file
-;; Copyright (C) 2005, 2009-2011 Free Software Foundation, Inc.
-;; Copyright (C) 1998-2011 Ecma International
+;; Copyright (C) 2005, 2009-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2011 Ecma International.
;; This file is part of GNU Emacs.
@@ -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 2445d7162a7..d215a4b2414 100644
--- a/lisp/cedet/semantic/wisent/python-wy.el
+++ b/lisp/cedet/semantic/wisent/python-wy.el
@@ -1,7 +1,8 @@
;;; semantic/wisent/python-wy.el --- Generated parser support file
-;; Copyright (C) 2002-2004, 2007, 2010-2011 Free Software Foundation, Inc.
-;; Copyright (C) 2001-2010 Python Software Foundation
+;; 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
;; This file is part of GNU Emacs.
@@ -76,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
;;
@@ -113,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")
@@ -155,6 +161,7 @@
("string"
(STRING_LITERAL))
("punctuation"
+ (AT . "@")
(BACKQUOTE . "`")
(ASSIGN . "=")
(COMMA . ",")
@@ -225,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))
@@ -363,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)
@@ -416,6 +425,7 @@
((while_stmt))
((for_stmt))
((try_stmt))
+ ((with_stmt))
((funcdef))
((class_declaration)))
(if_stmt
@@ -475,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
@@ -504,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)))
@@ -725,7 +762,7 @@
;;; Analyzers
-
+;;
(define-lex-block-type-analyzer wisent-python-wy--<block>-block-analyzer
"block analyzer for <block> tokens."
"\\s(\\|\\s)"
@@ -737,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 . ";")
@@ -780,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 c73033ce0ac..89c0499b7da 100644
--- a/lisp/cedet/semantic/wisent/python.el
+++ b/lisp/cedet/semantic/wisent/python.el
@@ -1,6 +1,6 @@
;;; wisent-python.el --- Semantic support for Python
-;; Copyright (C) 2002, 2004, 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Richard Kim <emacs18@gmail.com>
;; Maintainer: Richard Kim <emacs18@gmail.com>
@@ -28,27 +28,81 @@
;;; 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."
+ (delq nil
+ (mapcar
+ (lambda (dir)
+ (when (file-directory-p dir)
+ dir))
+ (split-string
+ (python-shell-internal-send-string
+ "import sys;print ('\\n'.join(sys.path))")
+ "\n" t))))
+
+(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 +114,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 +167,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 +191,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 +269,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 +296,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 +335,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 +463,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 +493,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 +528,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/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el
index 8c17d4ccab4..452628f8f1e 100644
--- a/lisp/cedet/semantic/wisent/wisent.el
+++ b/lisp/cedet/semantic/wisent/wisent.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/wisent.el --- GNU Bison for Emacs - Runtime
-;;; Copyright (C) 2002-2007, 2009-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2007, 2009-2012 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el
index 5527273a3a5..17121c7547e 100644
--- a/lisp/cedet/srecode.el
+++ b/lisp/cedet/srecode.el
@@ -1,10 +1,10 @@
;;; srecode.el --- Semantic buffer evaluator.
-;;; Copyright (C) 2005, 2007-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2005, 2007-2012 Free Software Foundation, Inc.
;; 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/args.el b/lisp/cedet/srecode/args.el
index 73445fbf13d..0960912e827 100644
--- a/lisp/cedet/srecode/args.el
+++ b/lisp/cedet/srecode/args.el
@@ -1,6 +1,6 @@
;;; srecode/args.el --- Provide some simple template arguments
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el
index d3623d6022f..8457e35abe5 100644
--- a/lisp/cedet/srecode/compile.el
+++ b/lisp/cedet/srecode/compile.el
@@ -1,6 +1,6 @@
;;; srecode/compile --- Compilation of srecode template files.
-;; Copyright (C) 2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: codegeneration
@@ -199,6 +199,8 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(defun srecode-compile-templates ()
"Compile a semantic recode template file into a mode-local variable."
(interactive)
+ (unless (semantic-active-p)
+ (error "You have to activate semantic-mode to compile SRecode templates."))
(require 'srecode/insert)
(message "Compiling template %s..."
(file-name-nondirectory (buffer-file-name)))
@@ -210,6 +212,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 +256,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 +324,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 +381,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 +527,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 +575,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 a46e8369c6c..d63e1a7a49f 100644
--- a/lisp/cedet/srecode/cpp.el
+++ b/lisp/cedet/srecode/cpp.el
@@ -1,6 +1,6 @@
;;; srecode/cpp.el --- C++ specific handlers for Semantic Recoder
-;; Copyright (C) 2007, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Jan Moringen <scymtym@users.sourceforge.net>
@@ -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/ctxt.el b/lisp/cedet/srecode/ctxt.el
index 11d84e96f41..45f0d2b3afb 100644
--- a/lisp/cedet/srecode/ctxt.el
+++ b/lisp/cedet/srecode/ctxt.el
@@ -1,6 +1,6 @@
;;; srecode/ctxt.el --- Derive a context from the source buffer.
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -41,7 +41,7 @@
(define-overload srecode-calculate-context ()
"Calculate the context at the current point.
The returned context is a list, with the top-most context first.
-Each returned context is a string that that would show up in a `context'
+Each returned context is a string that would show up in a `context'
statement in an `.srt' file.
Some useful context values used by the provided srecode templates are:
diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el
index 1575ce7ae3b..2b6bbb51eaa 100644
--- a/lisp/cedet/srecode/dictionary.el
+++ b/lisp/cedet/srecode/dictionary.el
@@ -1,6 +1,6 @@
;;; srecode/dictionary.el --- Dictionary code for the semantic recoder.
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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.
@@ -635,7 +604,6 @@ STATE is the current compiler state."
"Run data-debug on this mode's dictionary."
(interactive)
(require 'eieio-datadebug)
- (require 'semantic)
(require 'srecode/find)
(let* ((modesym major-mode)
(start (current-time))
diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el
index e25905ead83..1431508fd6d 100644
--- a/lisp/cedet/srecode/document.el
+++ b/lisp/cedet/srecode/document.el
@@ -1,6 +1,6 @@
;;; srecode/document.el --- Documentation (comment) generation
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -167,7 +167,7 @@ doesn't always work correctly."
("str\\(ing\\)?" . "string")
("use?r" . "user")
("num\\(ber\\)?" . "number")
- ("\\(^\\|\\s-\\)id\\($\\|\\s-\\)" . "Identifier") ;complex cause ;common sylable
+ ("\\(^\\|\\s-\\)id\\($\\|\\s-\\)" . "Identifier") ;complex cause ;common syllable
)
"List of common English abbreviations or full words.
These are nouns (as opposed to verbs) for use in creating expanded
diff --git a/lisp/cedet/srecode/el.el b/lisp/cedet/srecode/el.el
index 03ea9773666..bd3f73e0729 100644
--- a/lisp/cedet/srecode/el.el
+++ b/lisp/cedet/srecode/el.el
@@ -1,6 +1,6 @@
;;; srecode/el.el --- Emacs Lisp specific arguments
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/expandproto.el b/lisp/cedet/srecode/expandproto.el
index 89dc9adcefc..1ddaa1acdea 100644
--- a/lisp/cedet/srecode/expandproto.el
+++ b/lisp/cedet/srecode/expandproto.el
@@ -1,6 +1,6 @@
;;; srecode/expandproto.el --- Expanding prototypes.
-;; Copyright (C) 2007, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/extract.el b/lisp/cedet/srecode/extract.el
index d87dc315829..be3d703339c 100644
--- a/lisp/cedet/srecode/extract.el
+++ b/lisp/cedet/srecode/extract.el
@@ -1,6 +1,6 @@
;;; srecode/extract.el --- Extract content from previously inserted macro.
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el
index f4d34a0f2ab..476dd37ae06 100644
--- a/lisp/cedet/srecode/fields.el
+++ b/lisp/cedet/srecode/fields.el
@@ -1,6 +1,6 @@
;;; srecode/fields.el --- Handling type-in fields in a buffer.
;;
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;;
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/filters.el b/lisp/cedet/srecode/filters.el
index cc942e53ffd..d4a7e542770 100644
--- a/lisp/cedet/srecode/filters.el
+++ b/lisp/cedet/srecode/filters.el
@@ -1,6 +1,6 @@
;;; srecode/filters.el --- Filters for use in template variables.
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -26,8 +26,9 @@
;;; Code:
(require 'newcomment)
-(require 'srecode/table)
-(require 'srecode/insert)
+
+(declare-function srecode-dictionary-lookup-name "srecode/dictionary")
+(defvar srecode-inserter-variable-current-dictionary)
(defun srecode-comment-prefix (str)
"Prefix each line of STR with the comment prefix characters."
diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el
index b947c63f4dd..f621c5e82d5 100644
--- a/lisp/cedet/srecode/find.el
+++ b/lisp/cedet/srecode/find.el
@@ -1,6 +1,6 @@
;;;; srecode/find.el --- Tools for finding templates in the database.
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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 9a6c27dcd73..49d913a099a 100644
--- a/lisp/cedet/srecode/getset.el
+++ b/lisp/cedet/srecode/getset.el
@@ -1,6 +1,6 @@
;;; srecode/getset.el --- Package for inserting new get/set methods.
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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 bbf8b881c4d..f099c0ca6eb 100644
--- a/lisp/cedet/srecode/insert.el
+++ b/lisp/cedet/srecode/insert.el
@@ -1,6 +1,6 @@
;;; srecode/insert.el --- Insert srecode templates to an output stream.
-;; Copyright (C) 2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -33,6 +33,7 @@
(require 'srecode/find)
(require 'srecode/dictionary)
(require 'srecode/args)
+(require 'srecode/filters)
(defvar srecode-template-inserter-point)
(declare-function srecode-overlaid-activate "srecode/fields")
@@ -194,6 +195,36 @@ Buffer based features related to change hooks is handled one level up."
;; area. Return value is not important.
))
+(declare-function data-debug-new-buffer "data-debug")
+(declare-function data-debug-insert-stuff-list "data-debug")
+(declare-function data-debug-insert-thing dictionary "data-debug")
+
+(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
@@ -434,8 +465,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)
@@ -466,19 +499,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
@@ -558,19 +592,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)
@@ -646,26 +686,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)
@@ -757,13 +804,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)
@@ -773,14 +822,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)))))
@@ -875,11 +928,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
@@ -919,11 +974,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 4e76c15e300..43e9273da76 100644
--- a/lisp/cedet/srecode/java.el
+++ b/lisp/cedet/srecode/java.el
@@ -1,6 +1,6 @@
;;; srecode/java.el --- Srecode Java support
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -26,6 +26,7 @@
;;; Code:
(require 'srecode/dictionary)
+(require 'semantic/find)
;;;###autoload
(defun srecode-semantic-handle-:java (dict)
@@ -33,7 +34,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 +45,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 126f41eb7f7..7fb5c16a1f3 100644
--- a/lisp/cedet/srecode/map.el
+++ b/lisp/cedet/srecode/map.el
@@ -1,6 +1,6 @@
;;; srecode/map.el --- Manage a template file map
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -215,7 +215,8 @@ Optional argument RESET forces a reset of the current map."
;; Eventually, I want to return many maps to search through.
(list srecode-current-map)))
-(eval-when-compile (require 'data-debug))
+(declare-function data-debug-new-buffer "data-debug")
+(declare-function data-debug-insert-stuff-list "data-debug")
(defun srecode-adebug-maps ()
"Run ADEBUG on the output of `srecode-get-maps'."
@@ -297,7 +298,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 23d09bc9a4b..805e324a8bd 100644
--- a/lisp/cedet/srecode/mode.el
+++ b/lisp/cedet/srecode/mode.el
@@ -1,6 +1,6 @@
;;; srecode/mode.el --- Minor mode for managing and using SRecode templates
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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 956bdfbd97a..877f6796c76 100644
--- a/lisp/cedet/srecode/semantic.el
+++ b/lisp/cedet/srecode/semantic.el
@@ -1,6 +1,6 @@
;;; srecode/semantic.el --- Semantic specific extensions to SRecode.
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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 ed2b0e2cfdb..298c8949435 100644
--- a/lisp/cedet/srecode/srt-mode.el
+++ b/lisp/cedet/srecode/srt-mode.el
@@ -1,6 +1,6 @@
;;; srecode/srt-mode.el --- Major mode for writing screcode macros
-;; Copyright (C) 2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -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-+\""
@@ -185,8 +189,8 @@ we can tell font lock about them.")
;;;###autoload
(define-derived-mode srecode-template-mode fundamental-mode "SRecorder"
"Major-mode for writing SRecode macros."
- (setq comment-start ";;"
- comment-end "")
+ (set (make-local-variable 'comment-start) ";;")
+ (set (make-local-variable 'comment-end) "")
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'comment-start-skip)
"\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
diff --git a/lisp/cedet/srecode/srt-wy.el b/lisp/cedet/srecode/srt-wy.el
index 5bd202093e9..6f5d73aa312 100644
--- a/lisp/cedet/srecode/srt-wy.el
+++ b/lisp/cedet/srecode/srt-wy.el
@@ -1,6 +1,6 @@
;;; srecode/srt-wy.el --- Generated parser support file
-;; Copyright (C) 2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -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/srt.el b/lisp/cedet/srecode/srt.el
index 4ea554f1def..b08f3687459 100644
--- a/lisp/cedet/srecode/srt.el
+++ b/lisp/cedet/srecode/srt.el
@@ -1,6 +1,6 @@
;;; srecode/srt.el --- argument handlers for SRT files
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el
index 52a7765c857..37403c4fb9e 100644
--- a/lisp/cedet/srecode/table.el
+++ b/lisp/cedet/srecode/table.el
@@ -1,6 +1,6 @@
;;; srecode/table.el --- Tables of Semantic Recoders
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -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/cedet/srecode/template.el b/lisp/cedet/srecode/template.el
index 5dd32a85786..75a5928ea33 100644
--- a/lisp/cedet/srecode/template.el
+++ b/lisp/cedet/srecode/template.el
@@ -1,6 +1,6 @@
;;; srecode/template.el --- SRecoder template language parser support.
-;; Copyright (C) 2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/srecode/texi.el b/lisp/cedet/srecode/texi.el
index df90f6c464f..9f2c457ef79 100644
--- a/lisp/cedet/srecode/texi.el
+++ b/lisp/cedet/srecode/texi.el
@@ -1,6 +1,6 @@
;;; srecode/texi.el --- Srecode texinfo support.
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/chistory.el b/lisp/chistory.el
index 09f6e205cdd..efbd16e324e 100644
--- a/lisp/chistory.el
+++ b/lisp/chistory.el
@@ -1,6 +1,6 @@
;;; chistory.el --- list command history
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: FSF
diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
index 7c1351eefd4..0024b52a764 100644
--- a/lisp/cmuscheme.el
+++ b/lisp/cmuscheme.el
@@ -1,6 +1,6 @@
;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el
-;; Copyright (C) 1988, 1994, 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Olin Shivers <olin.shivers@cs.cmu.edu>
;; Maintainer: FSF
diff --git a/lisp/color.el b/lisp/color.el
index 96b79a4ace2..e1563ea474c 100644
--- a/lisp/color.el
+++ b/lisp/color.el
@@ -1,6 +1,6 @@
-;;; color.el --- Color manipulation library -*- coding: utf-8; -*-
+;;; color.el --- Color manipulation library -*- coding: utf-8; lexical-binding:t -*-
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Authors: Julien Danjou <julien@danjou.info>
;; Drew Adams <drew.adams@oracle.com>
@@ -33,9 +33,6 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
-
;; Emacs < 23.3
(eval-and-compile
(unless (boundp 'float-pi)
@@ -50,14 +47,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."
- (mapcar (lambda (x) (/ x 65535.0)) (color-values color frame)))
+ ;; `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.
+ (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)))
@@ -66,14 +66,14 @@ RED GREEN BLUE must be numbers between 0.0 and 1.0 inclusive."
COLOR-NAME should be a string naming a color (e.g. \"white\"), or
a string specifying a color's RGB components (e.g. \"#ff12ec\")."
(let ((color (color-name-to-rgb color-name)))
- (list (- 1.0 (car color))
- (- 1.0 (cadr color))
- (- 1.0 (caddr color)))))
+ (list (- 1.0 (nth 0 color))
+ (- 1.0 (nth 1 color))
+ (- 1.0 (nth 2 color)))))
(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))
@@ -82,21 +82,46 @@ resulting list."
(g-step (/ (- (nth 1 stop) g) (1+ step-number)))
(b-step (/ (- (nth 2 stop) b) (1+ step-number)))
result)
- (dotimes (n step-number)
+ (dotimes (_ step-number)
(push (list (setq r (+ r r-step))
(setq g (+ g g-step))
(setq b (+ b b-step)))
result))
(nreverse result)))
+(defun color-hue-to-rgb (v1 v2 h)
+ "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)
+ ((< h (/ 2.0 3)) (+ v1 (* (- v2 v1) (- (/ 2.0 3) h) 6.0)))
+ (t v1)))
+
+(defun color-hsl-to-rgb (H S L)
+ "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)
+ (* L (+ 1.0 S))
+ (- (+ L S) (* L S))))
+ (m1 (- (* 2.0 L) m2)))
+ (list
+ (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 (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))
@@ -124,13 +149,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)
@@ -138,27 +160,25 @@ inclusive."
(min (min r g b))
(delta (- max min))
(l (/ (+ max min) 2.0)))
- (list
- (if (< (- max min) 1e-8)
- 0
- (* 2 float-pi
- (/ (cond ((= max r)
- (+ (/ (- g b) delta) (if (< g b) 6 0)))
- ((= max g)
- (+ (/ (- b r) delta) 2))
- (t
- (+ (/ (- r g) delta) 4)))
- 6)))
- (if (= max min)
- 0
- (if (> l 0.5)
- (/ delta (- 2 (+ max min)))
- (/ delta (+ max min))))
- l)))
+ (if (= delta 0)
+ (list 0.0 0.0 l)
+ (let* ((s (if (<= l 0.5) (/ delta (+ max min))
+ (/ delta (- 2.0 max min))))
+ (rc (/ (- max r) delta))
+ (gc (/ (- max g) delta))
+ (bc (/ (- max b) delta))
+ (h (mod
+ (/
+ (cond
+ ((= r max) (- bc gc))
+ ((= g max) (+ 2.0 rc (- bc)))
+ (t (+ 4.0 gc (- rc))))
+ 6.0) 1.0)))
+ (list h s l)))))
(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)))
@@ -196,9 +216,9 @@ 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'."
- (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
- (let* ((xr (/ X Xr))
+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-ε)
@@ -213,14 +233,14 @@ conversion. If omitted or nil, use `color-d65-xyz'."
(list
(- (* 116 fy) 16) ; L
(* 500 (- fx fy)) ; a
- (* 200 (- fy fz)))))) ; b
+ (* 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'."
- (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
- (let* ((fy (/ (+ L 16) 116.0))
+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-ε)
@@ -234,7 +254,7 @@ conversion. If omitted or nil, use `color-d65-xyz'."
(/ (- (* 116 fz) 16) color-cie-κ))))
(list (* xr Xr) ; X
(* yr Yr) ; Y
- (* zr Zr))))) ; Z
+ (* zr Zr)))) ; Z
(defun color-srgb-to-lab (red green blue)
"Convert RGB to CIE L*a*b*."
@@ -248,67 +268,136 @@ conversion. If omitted or nil, use `color-d65-xyz'."
"Return the CIEDE2000 color distance between COLOR1 and COLOR2.
Both COLOR1 and COLOR2 should be in CIE L*a*b* format, as
returned by `color-srgb-to-lab' or `color-xyz-to-lab'."
- (destructuring-bind (L₁ a₁ b₁) color1
- (destructuring-bind (L₂ a₂ b₂) color2
- (let* ((kL (or kL 1))
- (kC (or kC 1))
- (kH (or kH 1))
- (C₁ (sqrt (+ (expt a₁ 2.0) (expt b₁ 2.0))))
- (C₂ (sqrt (+ (expt a₂ 2.0) (expt b₂ 2.0))))
- (C̄ (/ (+ C₁ C₂) 2.0))
- (G (* 0.5 (- 1 (sqrt (/ (expt C̄ 7.0) (+ (expt C̄ 7.0) (expt 25 7.0)))))))
- (a′₁ (* (+ 1 G) a₁))
- (a′₂ (* (+ 1 G) a₂))
- (C′₁ (sqrt (+ (expt a′₁ 2.0) (expt b₁ 2.0))))
- (C′₂ (sqrt (+ (expt a′₂ 2.0) (expt b₂ 2.0))))
- (h′₁ (if (and (= b₁ 0) (= a′₁ 0))
- 0
- (let ((v (atan b₁ a′₁)))
- (if (< v 0)
- (+ v (* 2 float-pi))
- v))))
- (h′₂ (if (and (= b₂ 0) (= a′₂ 0))
- 0
- (let ((v (atan b₂ a′₂)))
- (if (< v 0)
- (+ v (* 2 float-pi))
- v))))
- (ΔL′ (- L₂ L₁))
- (ΔC′ (- C′₂ C′₁))
- (Δh′ (cond ((= (* C′₁ C′₂) 0)
- 0)
- ((<= (abs (- h′₂ h′₁)) float-pi)
- (- h′₂ h′₁))
- ((> (- h′₂ h′₁) float-pi)
- (- (- h′₂ h′₁) (* 2 float-pi)))
- ((< (- h′₂ h′₁) (- float-pi))
- (+ (- h′₂ h′₁) (* 2 float-pi)))))
- (ΔH′ (* 2 (sqrt (* C′₁ C′₂)) (sin (/ Δh′ 2.0))))
- (L̄′ (/ (+ L₁ L₂) 2.0))
- (C̄′ (/ (+ C′₁ C′₂) 2.0))
- (h̄′ (cond ((= (* C′₁ C′₂) 0)
- (+ h′₁ h′₂))
- ((<= (abs (- h′₁ h′₂)) float-pi)
- (/ (+ h′₁ h′₂) 2.0))
- ((< (+ h′₁ h′₂) (* 2 float-pi))
- (/ (+ h′₁ h′₂ (* 2 float-pi)) 2.0))
- ((>= (+ h′₁ h′₂) (* 2 float-pi))
- (/ (+ h′₁ h′₂ (* -2 float-pi)) 2.0))))
- (T (+ 1
- (- (* 0.17 (cos (- h̄′ (degrees-to-radians 30)))))
- (* 0.24 (cos (* h̄′ 2)))
- (* 0.32 (cos (+ (* h̄′ 3) (degrees-to-radians 6))))
- (- (* 0.20 (cos (- (* h̄′ 4) (degrees-to-radians 63)))))))
- (Δθ (* (degrees-to-radians 30) (exp (- (expt (/ (- h̄′ (degrees-to-radians 275)) (degrees-to-radians 25)) 2.0)))))
- (Rc (* 2 (sqrt (/ (expt C̄′ 7.0) (+ (expt C̄′ 7.0) (expt 25.0 7.0))))))
- (Sl (+ 1 (/ (* 0.015 (expt (- L̄′ 50) 2.0)) (sqrt (+ 20 (expt (- L̄′ 50) 2.0))))))
- (Sc (+ 1 (* C̄′ 0.045)))
- (Sh (+ 1 (* 0.015 C̄′ T)))
- (Rt (- (* (sin (* Δθ 2)) Rc))))
+ (pcase-let*
+ ((`(,L₁ ,a₁ ,b₁) color1)
+ (`(,L₂ ,a₂ ,b₂) color2)
+ (kL (or kL 1))
+ (kC (or kC 1))
+ (kH (or kH 1))
+ (C₁ (sqrt (+ (expt a₁ 2.0) (expt b₁ 2.0))))
+ (C₂ (sqrt (+ (expt a₂ 2.0) (expt b₂ 2.0))))
+ (C̄ (/ (+ C₁ C₂) 2.0))
+ (G (* 0.5 (- 1 (sqrt (/ (expt C̄ 7.0)
+ (+ (expt C̄ 7.0) (expt 25 7.0)))))))
+ (a′₁ (* (+ 1 G) a₁))
+ (a′₂ (* (+ 1 G) a₂))
+ (C′₁ (sqrt (+ (expt a′₁ 2.0) (expt b₁ 2.0))))
+ (C′₂ (sqrt (+ (expt a′₂ 2.0) (expt b₂ 2.0))))
+ (h′₁ (if (and (= b₁ 0) (= a′₁ 0))
+ 0
+ (let ((v (atan b₁ a′₁)))
+ (if (< v 0)
+ (+ v (* 2 float-pi))
+ v))))
+ (h′₂ (if (and (= b₂ 0) (= a′₂ 0))
+ 0
+ (let ((v (atan b₂ a′₂)))
+ (if (< v 0)
+ (+ v (* 2 float-pi))
+ v))))
+ (ΔL′ (- L₂ L₁))
+ (ΔC′ (- C′₂ C′₁))
+ (Δh′ (cond ((= (* C′₁ C′₂) 0)
+ 0)
+ ((<= (abs (- h′₂ h′₁)) float-pi)
+ (- h′₂ h′₁))
+ ((> (- h′₂ h′₁) float-pi)
+ (- (- h′₂ h′₁) (* 2 float-pi)))
+ ((< (- h′₂ h′₁) (- float-pi))
+ (+ (- h′₂ h′₁) (* 2 float-pi)))))
+ (ΔH′ (* 2 (sqrt (* C′₁ C′₂)) (sin (/ Δh′ 2.0))))
+ (L̄′ (/ (+ L₁ L₂) 2.0))
+ (C̄′ (/ (+ C′₁ C′₂) 2.0))
+ (h̄′ (cond ((= (* C′₁ C′₂) 0)
+ (+ h′₁ h′₂))
+ ((<= (abs (- h′₁ h′₂)) float-pi)
+ (/ (+ h′₁ h′₂) 2.0))
+ ((< (+ h′₁ h′₂) (* 2 float-pi))
+ (/ (+ h′₁ h′₂ (* 2 float-pi)) 2.0))
+ ((>= (+ h′₁ h′₂) (* 2 float-pi))
+ (/ (+ h′₁ h′₂ (* -2 float-pi)) 2.0))))
+ (T (+ 1
+ (- (* 0.17 (cos (- h̄′ (degrees-to-radians 30)))))
+ (* 0.24 (cos (* h̄′ 2)))
+ (* 0.32 (cos (+ (* h̄′ 3) (degrees-to-radians 6))))
+ (- (* 0.20 (cos (- (* h̄′ 4) (degrees-to-radians 63)))))))
+ (Δθ (* (degrees-to-radians 30)
+ (exp (- (expt (/ (- h̄′ (degrees-to-radians 275))
+ (degrees-to-radians 25)) 2.0)))))
+ (Rc (* 2 (sqrt (/ (expt C̄′ 7.0) (+ (expt C̄′ 7.0) (expt 25.0 7.0))))))
+ (Sl (+ 1 (/ (* 0.015 (expt (- L̄′ 50) 2.0))
+ (sqrt (+ 20 (expt (- L̄′ 50) 2.0))))))
+ (Sc (+ 1 (* C̄′ 0.045)))
+ (Sh (+ 1 (* 0.015 C̄′ T)))
+ (Rt (- (* (sin (* Δθ 2)) Rc))))
(sqrt (+ (expt (/ ΔL′ (* Sl kL)) 2.0)
(expt (/ ΔC′ (* Sc kC)) 2.0)
(expt (/ ΔH′ (* Sh kH)) 2.0)
- (* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH)))))))))
+ (* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH)))))))
+
+(defun color-clamp (value)
+ "Make sure VALUE is a number between 0.0 and 1.0 inclusive."
+ (min 1.0 (max 0.0 value)))
+
+(defun color-saturate-hsl (H S L percent)
+ "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)
+ "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
+ (apply 'color-saturate-hsl
+ (append
+ (apply 'color-rgb-to-hsl
+ (color-name-to-rgb name))
+ (list percent))))))
+
+(defun color-desaturate-hsl (H S L percent)
+ "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)
+ "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)
+ "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)
+ "Make a color with a specified NAME lighter by PERCENT.
+See `color-lighten-hsl'."
+ (apply 'color-rgb-to-hex
+ (apply 'color-hsl-to-rgb
+ (apply 'color-lighten-hsl
+ (append
+ (apply 'color-rgb-to-hsl
+ (color-name-to-rgb name))
+ (list percent))))))
+
+(defun color-darken-hsl (H S L percent)
+ "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)
+ "Make a color with a specified NAME darker by PERCENT.
+See `color-darken-hsl'."
+ (color-lighten-name name (- percent)))
(provide 'color)
diff --git a/lisp/comint.el b/lisp/comint.el
index 77734b69af6..cff9afee0df 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1,6 +1,6 @@
;;; comint.el --- general command interpreter in a window stuff -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 1990, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1990, 1992-2012 Free Software Foundation, Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
;; Simon Marshall <simon@gnu.org>
@@ -101,8 +101,9 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'ring)
+(require 'ansi-color)
+(require 'regexp-opt) ;For regexp-opt-charset.
;; Buffer Local Variables:
;;============================================================================
@@ -180,7 +181,7 @@ override the read-only-ness of comint prompts is to call
`comint-kill-whole-line' or `comint-kill-region' with no
narrowing in effect. This way you will be certain that none of
the remaining prompts will be accidentally messed up. You may
-wish to put something like the following in your `.emacs' file:
+wish to put something like the following in your init file:
\(add-hook 'comint-mode-hook
(lambda ()
@@ -385,7 +386,7 @@ history list. Default is to save anything that isn't all whitespace.")
These functions get one argument, a string containing the text to send.")
;;;###autoload
-(defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)
+(defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)
"Functions to call after output is inserted into the buffer.
One possible function is `comint-postoutput-scroll-to-bottom'.
These functions get one argument, a string containing the text as originally
@@ -698,16 +699,21 @@ BUFFER can be either a buffer or the name of one."
(defun make-comint-in-buffer (name buffer program &optional startfile &rest switches)
"Make a Comint process NAME in BUFFER, running PROGRAM.
If BUFFER is nil, it defaults to NAME surrounded by `*'s.
-PROGRAM should be either a string denoting an executable program to create
-via `start-file-process', or a cons pair of the form (HOST . SERVICE) denoting
-a TCP connection to be opened via `open-network-stream'. If there is already
-a running process in that buffer, it is not restarted. Optional fourth arg
-STARTFILE is the name of a file, whose contents are sent to the
-process as its initial input.
+If there is a running process in BUFFER, it is not restarted.
+
+PROGRAM should be one of the following:
+- a string, denoting an executable program to create via
+ `start-file-process'
+- a cons pair of the form (HOST . SERVICE), denoting a TCP
+ connection to be opened via `open-network-stream'
+- nil, denoting a newly-allocated pty.
+
+Optional fourth arg STARTFILE is the name of a file, whose
+contents are sent to the process as its initial input.
If PROGRAM is a string, any more args are arguments to PROGRAM.
-Returns the (possibly newly created) process buffer."
+Return the (possibly newly created) process buffer."
(or (fboundp 'start-file-process)
(error "Multi-processing is not supported for this system"))
(setq buffer (get-buffer-create (or buffer (concat "*" name "*"))))
@@ -751,9 +757,18 @@ See `make-comint' and `comint-exec'."
(defun comint-exec (buffer name command startfile switches)
"Start up a process named NAME in buffer BUFFER for Comint modes.
Runs the given COMMAND with SWITCHES, and initial input from STARTFILE.
-Blasts any old process running in the buffer. Doesn't set the buffer mode.
-You can use this to cheaply run a series of processes in the same Comint
-buffer. The hook `comint-exec-hook' is run after each exec."
+
+COMMAND should be one of the following:
+- a string, denoting an executable program to create via
+ `start-file-process'
+- a cons pair of the form (HOST . SERVICE), denoting a TCP
+ connection to be opened via `open-network-stream'
+- nil, denoting a newly-allocated pty.
+
+This function blasts any old process running in the buffer, and
+does not set the buffer mode. You can use this to cheaply run a
+series of processes in the same Comint buffer. The hook
+`comint-exec-hook' is run after each exec."
(with-current-buffer buffer
(let ((proc (get-buffer-process buffer))) ; Blast any old process.
(if proc (delete-process proc)))
@@ -921,15 +936,18 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
(t
(let* ((file comint-input-ring-file-name)
(count 0)
- (size comint-input-ring-size)
- (ring (make-ring size)))
+ ;; Some users set HISTSIZE or `comint-input-ring-size'
+ ;; to huge numbers. Don't allocate a huge ring right
+ ;; away; there might not be that much history.
+ (ring-size (min 1500 comint-input-ring-size))
+ (ring (make-ring ring-size)))
(with-temp-buffer
(insert-file-contents file)
;; Save restriction in case file is already visited...
;; Watch for those date stamps in history files!
(goto-char (point-max))
(let (start end history)
- (while (and (< count size)
+ (while (and (< count comint-input-ring-size)
(re-search-backward comint-input-ring-separator
nil t)
(setq end (match-beginning 0)))
@@ -940,15 +958,18 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
(point-min)))
(setq history (buffer-substring start end))
(goto-char start)
- (if (and (not (string-match comint-input-history-ignore
- history))
- (or (null comint-input-ignoredups)
- (ring-empty-p ring)
- (not (string-equal (ring-ref ring 0)
- history))))
- (progn
- (ring-insert-at-beginning ring history)
- (setq count (1+ count)))))))
+ (when (and (not (string-match comint-input-history-ignore
+ history))
+ (or (null comint-input-ignoredups)
+ (ring-empty-p ring)
+ (not (string-equal (ring-ref ring 0)
+ history))))
+ (when (= count ring-size)
+ (ring-extend ring (min (- comint-input-ring-size ring-size)
+ ring-size))
+ (setq ring-size (ring-size ring)))
+ (ring-insert-at-beginning ring history)
+ (setq count (1+ count))))))
(setq comint-input-ring ring
comint-input-ring-index nil)))))
@@ -1054,10 +1075,10 @@ See also `comint-read-input-ring'."
(defun comint-search-arg (arg)
;; First make sure there is a ring and that we are after the process mark
(cond ((not (comint-after-pmark-p))
- (error "Not at command line"))
+ (user-error "Not at command line"))
((or (null comint-input-ring)
(ring-empty-p comint-input-ring))
- (error "Empty input ring"))
+ (user-error "Empty input ring"))
((zerop arg)
;; arg of zero resets search from beginning, and uses arg of 1
(setq comint-input-ring-index nil)
@@ -1124,7 +1145,7 @@ Moves relative to `comint-input-ring-index'."
Moves relative to START, or `comint-input-ring-index'."
(if (or (not (ring-p comint-input-ring))
(ring-empty-p comint-input-ring))
- (error "No history"))
+ (user-error "No history"))
(let* ((len (ring-length comint-input-ring))
(motion (if (> arg 0) 1 -1))
(n (mod (- (or start (comint-search-start arg)) motion) len))
@@ -1164,7 +1185,7 @@ If N is negative, find the next or Nth next match."
(let ((pos (comint-previous-matching-input-string-position regexp n)))
;; Has a match been found?
(if (null pos)
- (error "Not found")
+ (user-error "Not found")
;; If leaving the edit line, save partial input
(if (null comint-input-ring-index) ;not yet on ring
(setq comint-stored-incomplete-input
@@ -1350,7 +1371,7 @@ actual side-effect."
(goto-char (match-beginning 0))
(if (not (search-forward old pos t))
(or silent
- (error "Not found"))
+ (user-error "Not found"))
(replace-match new t t)
(message "History item: substituted"))))
(t
@@ -1419,7 +1440,7 @@ Intended to be added to `isearch-mode-hook' in `comint-mode'."
(if comint-history-isearch-message-overlay
(delete-overlay comint-history-isearch-message-overlay))
(setq isearch-message-prefix-add nil)
- (setq isearch-search-fun-function nil)
+ (setq isearch-search-fun-function 'isearch-search-fun-default)
(setq isearch-message-function nil)
(setq isearch-wrap-function nil)
(setq isearch-push-state-function nil)
@@ -1441,67 +1462,59 @@ Intended to be added to `isearch-mode-hook' in `comint-mode'."
(defun comint-history-isearch-search ()
"Return the proper search function, for Isearch in input history."
- (cond
- (isearch-word
- (if isearch-forward 'word-search-forward 'word-search-backward))
- (t
- (lambda (string bound noerror)
- (let ((search-fun
- ;; Use standard functions to search within comint text
- (cond
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward))))
- found)
- ;; Avoid lazy-highlighting matches in the comint prompt and in the
- ;; output when searching forward. Lazy-highlight calls this lambda
- ;; with the bound arg, so skip the prompt and the output.
- (if (and bound isearch-forward (not (comint-after-pmark-p)))
- (goto-char (process-mark (get-buffer-process (current-buffer)))))
- (or
- ;; 1. First try searching in the initial comint text
- (funcall search-fun string
- (if isearch-forward bound (comint-line-beginning-position))
- noerror)
- ;; 2. If the above search fails, start putting next/prev history
- ;; elements in the comint successively, and search the string
- ;; in them. Do this only when bound is nil (i.e. not while
- ;; lazy-highlighting search strings in the current comint text).
- (unless bound
- (condition-case nil
- (progn
- (while (not found)
- (cond (isearch-forward
- ;; Signal an error here explicitly, because
- ;; `comint-next-input' doesn't signal an error.
- (when (null comint-input-ring-index)
- (error "End of history; no next item"))
- (comint-next-input 1)
- (goto-char (comint-line-beginning-position)))
- (t
- ;; Signal an error here explicitly, because
- ;; `comint-previous-input' doesn't signal an error.
- (when (eq comint-input-ring-index
- (1- (ring-length comint-input-ring)))
- (error "Beginning of history; no preceding item"))
- (comint-previous-input 1)
- (goto-char (point-max))))
- (setq isearch-barrier (point) isearch-opoint (point))
- ;; After putting the next/prev history element, search
- ;; the string in them again, until comint-next-input
- ;; or comint-previous-input raises an error at the
- ;; beginning/end of history.
- (setq found (funcall search-fun string
- (unless isearch-forward
- ;; For backward search, don't search
- ;; in the comint prompt
- (comint-line-beginning-position))
- noerror)))
- ;; Return point of the new search result
- (point))
- ;; Return nil on the error "no next/preceding item"
- (error nil)))))))))
+ (lambda (string bound noerror)
+ (let ((search-fun
+ ;; Use standard functions to search within comint text
+ (isearch-search-fun-default))
+ found)
+ ;; Avoid lazy-highlighting matches in the comint prompt and in the
+ ;; output when searching forward. Lazy-highlight calls this lambda
+ ;; with the bound arg, so skip the prompt and the output.
+ (if (and bound isearch-forward (not (comint-after-pmark-p)))
+ (goto-char (process-mark (get-buffer-process (current-buffer)))))
+ (or
+ ;; 1. First try searching in the initial comint text
+ (funcall search-fun string
+ (if isearch-forward bound (comint-line-beginning-position))
+ noerror)
+ ;; 2. If the above search fails, start putting next/prev history
+ ;; elements in the comint successively, and search the string
+ ;; in them. Do this only when bound is nil (i.e. not while
+ ;; lazy-highlighting search strings in the current comint text).
+ (unless bound
+ (condition-case nil
+ (progn
+ (while (not found)
+ (cond (isearch-forward
+ ;; Signal an error here explicitly, because
+ ;; `comint-next-input' doesn't signal an error.
+ (when (null comint-input-ring-index)
+ (error "End of history; no next item"))
+ (comint-next-input 1)
+ (goto-char (comint-line-beginning-position)))
+ (t
+ ;; Signal an error here explicitly, because
+ ;; `comint-previous-input' doesn't signal an error.
+ (when (eq comint-input-ring-index
+ (1- (ring-length comint-input-ring)))
+ (error "Beginning of history; no preceding item"))
+ (comint-previous-input 1)
+ (goto-char (point-max))))
+ (setq isearch-barrier (point) isearch-opoint (point))
+ ;; After putting the next/prev history element, search
+ ;; the string in them again, until comint-next-input
+ ;; or comint-previous-input raises an error at the
+ ;; beginning/end of history.
+ (setq found (funcall search-fun string
+ (unless isearch-forward
+ ;; For backward search, don't search
+ ;; in the comint prompt
+ (comint-line-beginning-position))
+ noerror)))
+ ;; Return point of the new search result
+ (point))
+ ;; Return nil on the error "no next/preceding item"
+ (error nil)))))))
(defun comint-history-isearch-message (&optional c-q-hack ellipsis)
"Display the input history search prompt.
@@ -1534,14 +1547,13 @@ Otherwise, it displays the standard Isearch message returned from
"Wrap the input history search when search fails.
Move point to the first history element for a forward search,
or to the last history element for a backward search."
- (unless isearch-word
- ;; When `comint-history-isearch-search' fails on reaching the
- ;; beginning/end of the history, wrap the search to the first/last
- ;; input history element.
- (if isearch-forward
- (comint-goto-input (1- (ring-length comint-input-ring)))
- (comint-goto-input nil))
- (setq isearch-success t))
+ ;; When `comint-history-isearch-search' fails on reaching the
+ ;; beginning/end of the history, wrap the search to the first/last
+ ;; input history element.
+ (if isearch-forward
+ (comint-goto-input (1- (ring-length comint-input-ring)))
+ (comint-goto-input nil))
+ (setq isearch-success t)
(goto-char (if isearch-forward (comint-line-beginning-position) (point-max))))
(defun comint-history-isearch-push-state ()
@@ -1690,13 +1702,18 @@ Argument 0 is the command name."
(defun comint-add-to-input-history (cmd)
"Add CMD to the input history.
Ignore duplicates if `comint-input-ignoredups' is non-nil."
- (if (and (funcall comint-input-filter cmd)
- (or (null comint-input-ignoredups)
- (not (ring-p comint-input-ring))
- (ring-empty-p comint-input-ring)
- (not (string-equal (ring-ref comint-input-ring 0)
- cmd))))
- (ring-insert comint-input-ring cmd)))
+ (when (and (funcall comint-input-filter cmd)
+ (or (null comint-input-ignoredups)
+ (not (ring-p comint-input-ring))
+ (ring-empty-p comint-input-ring)
+ (not (string-equal (ring-ref comint-input-ring 0) cmd))))
+ ;; If `comint-input-ring' is full, maybe grow it.
+ (let ((size (ring-size comint-input-ring)))
+ (and (= size (ring-length comint-input-ring))
+ (< size comint-input-ring-size)
+ (ring-extend comint-input-ring
+ (min size (- comint-input-ring-size size)))))
+ (ring-insert comint-input-ring cmd)))
(defun comint-send-input (&optional no-newline artificial)
"Send input to process.
@@ -1750,7 +1767,7 @@ Similarly for Soar, Scheme, etc."
(interactive)
;; Note that the input string does not include its terminal newline.
(let ((proc (get-buffer-process (current-buffer))))
- (if (not proc) (error "Current buffer has no process")
+ (if (not proc) (user-error "Current buffer has no process")
(widen)
(let* ((pmark (process-mark proc))
(intxt (if (>= (point) (marker-position pmark))
@@ -1988,6 +2005,20 @@ Make backspaces delete the previous character."
(goto-char (process-mark process))
(set-marker comint-last-output-start (point))
+ ;; Try to skip repeated prompts, which can occur as a result of
+ ;; commands sent without inserting them in the buffer.
+ (let ((bol (save-excursion (forward-line 0) (point)))) ;No fields.
+ (when (and (not (bolp))
+ (looking-back comint-prompt-regexp bol))
+ (let* ((prompt (buffer-substring bol (point)))
+ (prompt-re (concat "\\`" (regexp-quote prompt))))
+ (while (string-match prompt-re string)
+ (setq string (substring string (match-end 0)))))))
+ (while (string-match (concat "\\(^" comint-prompt-regexp
+ "\\)\\1+")
+ string)
+ (setq string (replace-match "\\1" nil nil string)))
+
;; insert-before-markers is a bad thing. XXX
;; Luckily we don't have to use it any more, we use
;; window-point-insertion-type instead.
@@ -2057,8 +2088,7 @@ This function should be a pre-command hook."
(if (and comint-scroll-to-bottom-on-input
(memq this-command '(self-insert-command comint-magic-space yank
hilit-yank)))
- (let* ((selected (selected-window))
- (current (current-buffer))
+ (let* ((current (current-buffer))
(process (get-buffer-process current))
(scroll comint-scroll-to-bottom-on-input))
(if (and process (< (point) (process-mark process)))
@@ -2068,49 +2098,55 @@ This function should be a pre-command hook."
(lambda (window)
(if (and (eq (window-buffer window) current)
(or (eq scroll t) (eq scroll 'all)))
- (progn
- (select-window window)
- (goto-char (point-max))
- (select-window selected))))
+ (with-selected-window window
+ (goto-char (point-max)))))
nil t))))))
+(defvar follow-mode)
+(declare-function follow-comint-scroll-to-bottom "follow" (&optional window))
+
(defun comint-postoutput-scroll-to-bottom (_string)
"Go to the end of buffer in some or all windows showing it.
-Does not scroll if the current line is the last line in the buffer.
+Do not scroll if the current line is the last line in the buffer.
Depends on the value of `comint-move-point-for-output' and
`comint-scroll-show-maximum-output'.
This function should be in the list `comint-output-filter-functions'."
- (let* ((selected (selected-window))
- (current (current-buffer))
- (process (get-buffer-process current))
- (scroll comint-move-point-for-output))
+ (let* ((current (current-buffer))
+ (process (get-buffer-process current)))
(unwind-protect
- (if process
- (walk-windows
- (lambda (window)
- (when (eq (window-buffer window) current)
- (select-window window)
- (if (and (< (point) (process-mark process))
- (or (eq scroll t) (eq scroll 'all)
- ;; Maybe user wants point to jump to end.
- (and (eq scroll 'this) (eq selected window))
- (and (eq scroll 'others) (not (eq selected window)))
- ;; If point was at the end, keep it at end.
- (and (marker-position comint-last-output-start)
- (>= (point) comint-last-output-start))))
- (goto-char (process-mark process)))
- ;; Optionally scroll so that the text
- ;; ends at the bottom of the window.
- (if (and comint-scroll-show-maximum-output
- (= (point) (point-max)))
- (save-excursion
- (goto-char (point-max))
- (recenter (- -1 scroll-margin))))
- (select-window selected)))
- nil t))
+ (cond
+ ((null process))
+ ((bound-and-true-p follow-mode)
+ (follow-comint-scroll-to-bottom))
+ (t
+ (let ((selected (selected-window)))
+ (dolist (w (get-buffer-window-list current nil t))
+ (select-window w)
+ (unwind-protect
+ (progn
+ (comint-adjust-point selected)
+ ;; Optionally scroll to the bottom of the window.
+ (and comint-scroll-show-maximum-output
+ (eobp)
+ (recenter (- -1 scroll-margin))))
+ (select-window selected))))))
(set-buffer current))))
+(defun comint-adjust-point (selected)
+ "Move point in the selected window based on Comint settings.
+SELECTED is the window that was originally selected."
+ (let ((process (get-buffer-process (current-buffer))))
+ (and (< (point) (process-mark process))
+ (or (memq comint-move-point-for-output '(t all))
+ ;; Maybe user wants point to jump to end.
+ (eq comint-move-point-for-output
+ (if (eq (selected-window) selected) 'this 'others))
+ ;; If point was at the end, keep it at end.
+ (and (marker-position comint-last-output-start)
+ (>= (point) comint-last-output-start)))
+ (goto-char (process-mark process)))))
+
(defun comint-truncate-buffer (&optional _string)
"Truncate the buffer to `comint-buffer-maximum-size'.
This function could be on `comint-output-filter-functions' or bound to a key."
@@ -2166,7 +2202,7 @@ Calls `comint-get-old-input' to get old input."
(let ((input (funcall comint-get-old-input))
(process (get-buffer-process (current-buffer))))
(if (not process)
- (error "Current buffer has no process")
+ (user-error "Current buffer has no process")
(goto-char (process-mark process))
(insert input))))
@@ -2473,7 +2509,7 @@ If N is negative, find the next or Nth next match."
(save-excursion
(while (/= n 0)
(unless (re-search-backward regexp nil t dir)
- (error "Not found"))
+ (user-error "Not found"))
(unless (get-char-property (point) 'field)
(setq n (- n dir))))
(field-beginning))))
@@ -2513,7 +2549,7 @@ text matching `comint-prompt-regexp'."
(if (> n 0)
(next-single-char-property-change pos 'field)
(previous-single-char-property-change pos 'field)))
- (cond ((or (null pos) (= pos prev-pos))
+ (cond ((= pos prev-pos)
;; Ran off the end of the buffer.
(when (> n 0)
;; There's always an input field at the end of the
@@ -2646,6 +2682,7 @@ prompts should stay at the beginning of a line. If this is not
the case, this command just calls `kill-region' with all
read-only properties intact. The read-only status of newlines is
updated using `comint-update-fence', if necessary."
+ (declare (advertised-calling-convention (beg end) "23.3"))
(interactive "r")
(save-excursion
(let* ((true-beg (min beg end))
@@ -2664,8 +2701,6 @@ updated using `comint-update-fence', if necessary."
(let ((inhibit-read-only t))
(kill-region beg end yank-handler)
(comint-update-fence))))))
-(set-advertised-calling-convention 'comint-kill-region '(beg end) "23.3")
-
;; Support for source-file processing commands.
;;============================================================================
@@ -2745,11 +2780,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."
@@ -2933,19 +2965,20 @@ This is a good thing to set in mode hooks.")
"Return the word of WORD-CHARS at point, or nil if none is found.
Word constituents are considered to be those in WORD-CHARS, which is like the
inside of a \"[...]\" (see `skip-chars-forward'), plus all non-ASCII characters."
+ ;; FIXME: Need to handle "..." and '...' quoting in shell.el!
+ ;; This should be combined with completion parsing somehow.
(save-excursion
(let ((here (point))
giveup)
(while (not giveup)
(let ((startpoint (point)))
(skip-chars-backward (concat "\\\\" word-chars))
- ;; Fixme: This isn't consistent with Bash, at least -- not
- ;; all non-ASCII chars should be word constituents.
- (if (and (> (- (point) 2) (point-min))
- (= (char-after (- (point) 2)) ?\\))
+ (if (and comint-file-name-quote-list
+ (eq (char-before (1- (point))) ?\\))
(forward-char -2))
- (if (and (> (- (point) 1) (point-min))
- (>= (char-after (- (point) 1)) 128))
+ ;; FIXME: This isn't consistent with Bash, at least -- not
+ ;; all non-ASCII chars should be word constituents.
+ (if (and (not (bobp)) (>= (char-before) 128))
(forward-char -1))
(if (= (point) startpoint)
(setq giveup t))))
@@ -2974,26 +3007,53 @@ interpreter (e.g., the percent notation of cmd.exe on Windows)."
See `comint-word'."
(comint-word comint-file-name-chars))
-(defun comint--unquote&expand-filename (filename)
- ;; FIXME: The code below does unquote-then-expand which means that "\\$HOME"
- ;; gets expanded to the same as "$HOME"
- (comint-substitute-in-file-name
- (comint-unquote-filename filename)))
+(defun comint--unquote&requote-argument (qstr &optional upos)
+ (unless upos (setq upos 0))
+ (let* ((qpos 0)
+ (ustrs '())
+ (re (concat
+ "\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
+ "\\|{\\(?1:[^{}]+\\)}\\)"
+ (when (memq system-type '(ms-dos windows-nt))
+ "\\|%\\(?1:[^\\\\/]*\\)%")
+ (when comint-file-name-quote-list
+ "\\|\\\\\\(.\\)")))
+ (qupos nil)
+ (push (lambda (str end)
+ (push str ustrs)
+ (setq upos (- upos (length str)))
+ (unless (or qupos (> upos 0))
+ (setq qupos (if (< end 0) (- end) (+ upos end))))))
+ match)
+ (while (setq match (string-match re qstr qpos))
+ (funcall push (substring qstr qpos match) match)
+ (cond
+ ((match-beginning 2) (funcall push (match-string 2 qstr) (match-end 0)))
+ ((match-beginning 1) (funcall push (getenv (match-string 1 qstr))
+ (- (match-end 0))))
+ (t (error "Unexpected case in comint--unquote&requote-argument!")))
+ (setq qpos (match-end 0)))
+ (funcall push (substring qstr qpos) (length qstr))
+ (list (mapconcat #'identity (nreverse ustrs) "")
+ qupos #'comint-quote-filename)))
+
+(defun comint--unquote-argument (str)
+ (car (comint--unquote&requote-argument str)))
+(define-obsolete-function-alias 'comint--unquote&expand-filename
+ #'comint--unquote-argument "24.3")
(defun comint-match-partial-filename ()
"Return the unquoted&expanded filename at point, or nil if none is found.
Environment variables are substituted. See `comint-word'."
(let ((filename (comint--match-partial-filename)))
- (and filename (comint--unquote&expand-filename filename))))
+ (and filename (comint--unquote-argument filename))))
(defun comint-quote-filename (filename)
"Return FILENAME with magic characters quoted.
Magic characters are those in `comint-file-name-quote-list'."
(if (null comint-file-name-quote-list)
filename
- (let ((regexp
- (format "[%s]"
- (mapconcat 'char-to-string comint-file-name-quote-list ""))))
+ (let ((regexp (regexp-opt-charset comint-file-name-quote-list)))
(save-match-data
(let ((i 0))
(while (string-match regexp filename i)
@@ -3003,11 +3063,17 @@ 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))))
+(defun comint--requote-argument (upos qstr)
+ ;; See `completion-table-with-quoting'.
+ (let ((res (comint--unquote&requote-argument qstr upos)))
+ (cons (nth 1 res) (nth 2 res))))
+
(defun comint-completion-at-point ()
(run-hook-with-args-until-success 'comint-dynamic-complete-functions))
@@ -3040,86 +3106,6 @@ Returns t if successful."
(when (comint--match-partial-filename)
(comint--complete-file-name-data)))
-;; FIXME: comint--common-suffix, comint--common-quoted-suffix, and
-;; comint--table-subvert don't fully solve the problem, since
-;; selecting a file from *Completions* won't quote it, among several
-;; other problems.
-
-(defun comint--common-suffix (s1 s2)
- (assert (not (or (string-match "\n" s1) (string-match "\n" s2))))
- ;; Since S2 is expected to be the "unquoted/expanded" version of S1,
- ;; there shouldn't be any case difference, even if the completion is
- ;; case-insensitive.
- (let ((case-fold-search nil))
- (string-match ".*?\\(.*\\)\n.*\\1\\'" (concat s1 "\n" s2))
- (- (match-end 1) (match-beginning 1))))
-
-(defun comint--common-quoted-suffix (s1 s2)
- ;; FIXME: Copied in pcomplete.el.
- "Find the common suffix between S1 and S2 where S1 is the expanded S2.
-S1 is expected to be the unquoted and expanded version of S1.
-Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that
-S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and
-SS1 = (unquote SS2)."
- (let* ((cs (comint--common-suffix s1 s2))
- (ss1 (substring s1 (- (length s1) cs)))
- (qss1 (comint-quote-filename ss1))
- qc)
- (if (and (not (equal ss1 qss1))
- (setq qc (comint-quote-filename (substring ss1 0 1)))
- (eq t (compare-strings s2 (- (length s2) cs (length qc) -1)
- (- (length s2) cs -1)
- qc nil nil)))
- ;; The difference found is just that one char is quoted in S2
- ;; but not in S1, keep looking before this difference.
- (comint--common-quoted-suffix
- (substring s1 0 (- (length s1) cs))
- (substring s2 0 (- (length s2) cs (length qc) -1)))
- (cons (substring s1 0 (- (length s1) cs))
- (substring s2 0 (- (length s2) cs))))))
-
-(defun comint--table-subvert (table s1 s2 &optional quote-fun unquote-fun)
- "Completion table that replaces the prefix S1 with S2 in STRING.
-The result is a completion table which completes strings of the
-form (concat S1 S) in the same way as TABLE completes strings of
-the form (concat S2 S)."
- (lambda (string pred action)
- (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
- completion-ignore-case))
- (let ((rest (substring string (length s1))))
- (concat s2 (if unquote-fun
- (funcall unquote-fun rest) rest)))))
- (res (if str (complete-with-action action table str pred))))
- (when res
- (cond
- ((and (eq (car-safe action) 'boundaries))
- (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0)))
- (list* 'boundaries
- (max (length s1)
- ;; FIXME: Adjust because of quoting/unquoting.
- (+ beg (- (length s1) (length s2))))
- (and (eq (car-safe res) 'boundaries) (cddr res)))))
- ((stringp res)
- (if (eq t (compare-strings res 0 (length s2) s2 nil nil
- completion-ignore-case))
- (let ((rest (substring res (length s2))))
- (concat s1 (if quote-fun (funcall quote-fun rest) rest)))))
- ((eq action t)
- (let ((bounds (completion-boundaries str table pred "")))
- (if (>= (car bounds) (length s2))
- (if quote-fun (mapcar quote-fun res) res)
- (let ((re (concat "\\`"
- (regexp-quote (substring s2 (car bounds))))))
- (delq nil
- (mapcar (lambda (c)
- (if (string-match re c)
- (let ((str (substring c (match-end 0))))
- (if quote-fun
- (funcall quote-fun str) str))))
- res))))))
- ;; E.g. action=nil and it's the only completion.
- (res))))))
-
(defun comint-completion-file-name-table (string pred action)
(if (not (file-name-absolute-p string))
(completion-file-name-table string pred action)
@@ -3138,6 +3124,13 @@ the form (concat S2 S)."
res)))
(t (completion-file-name-table string pred action)))))
+(defvar comint-unquote-function #'comint--unquote-argument
+ "Function to use for completion of quoted data.
+See `completion-table-with-quoting' and `comint-requote-function'.")
+(defvar comint-requote-function #'comint--requote-argument
+ "Function to use for completion of quoted data.
+See `completion-table-with-quoting' and `comint-unquote-function'.")
+
(defun comint--complete-file-name-data ()
"Return the completion data for file name at point."
(let* ((filesuffix (cond ((not comint-completion-addsuffix) "")
@@ -3148,14 +3141,11 @@ the form (concat S2 S)."
(filename (comint--match-partial-filename))
(filename-beg (if filename (match-beginning 0) (point)))
(filename-end (if filename (match-end 0) (point)))
- (unquoted (if filename (comint--unquote&expand-filename filename) ""))
(table
- (let ((prefixes (comint--common-quoted-suffix
- unquoted filename)))
- (comint--table-subvert
- #'comint-completion-file-name-table
- (cdr prefixes) (car prefixes)
- #'comint-quote-filename #'comint-unquote-filename))))
+ (completion-table-with-quoting
+ #'comint-completion-file-name-table
+ comint-unquote-function
+ comint-requote-function)))
(nconc
(list
filename-beg filename-end
@@ -3165,8 +3155,8 @@ the form (concat S2 S)."
(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)))))))))
@@ -3174,10 +3164,9 @@ the form (concat S2 S)."
(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.
@@ -3208,6 +3197,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) "")
@@ -3250,8 +3240,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."
@@ -3363,7 +3351,7 @@ The process mark separates output, and input already sent,
from input that has not yet been sent."
(interactive)
(let ((proc (or (get-buffer-process (current-buffer))
- (error "Current buffer has no process"))))
+ (user-error "Current buffer has no process"))))
(goto-char (process-mark proc))
(when (called-interactively-p 'interactive)
(message "Point is now at the process mark"))))
@@ -3388,7 +3376,7 @@ the process mark is at the beginning of the accumulated input."
"Set the process mark at point."
(interactive)
(let ((proc (or (get-buffer-process (current-buffer))
- (error "Current buffer has no process"))))
+ (user-error "Current buffer has no process"))))
(set-marker (process-mark proc) (point))
(message "Process mark set")))
@@ -3740,14 +3728,6 @@ REGEXP-GROUP is the regular expression group in REGEXP to use."
(match-end regexp-group))
results))
results)))
-
-(dolist (x '("^Not at command line$"
- "^Empty input ring$"
- "^No history$"
- "^Not found$" ; Too common?
- "^Current buffer has no process$"))
- (add-to-list 'debug-ignored-errors x))
-
;; Converting process modes to use comint mode
;; ===========================================================================
diff --git a/lisp/completion.el b/lisp/completion.el
index ad7e781bb7a..05358ad7711 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -1,6 +1,6 @@
;;; completion.el --- dynamic word-completion code
-;; Copyright (C) 1990, 1993, 1995, 1997, 2001-2011
+;; Copyright (C) 1990, 1993, 1995, 1997, 2001-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -228,7 +228,7 @@
;; superior to that of the LISPM version.
;;
;;-----------------------------------------------
-;; Acknowledgements
+;; Acknowledgments
;;-----------------------------------------------
;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com),
;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu,
@@ -344,18 +344,18 @@ are automatically added to the completion database."
:group 'completion)
;;(defvar *record-cmpl-statistics-p* nil
-;; "*If non-nil, record completion statistics.")
+;; "If non-nil, record completion statistics.")
;;(defvar *completion-auto-save-period* 1800
-;; "*The period in seconds to wait for emacs to be idle before autosaving
+;; "The period in seconds to wait for emacs to be idle before autosaving
;;the completions. Default is a 1/2 hour.")
(defvar completion-min-length 6
- "*The minimum length of a stored completion.
+ "The minimum length of a stored completion.
DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
(defvar completion-max-length 200
- "*The maximum length of a stored completion.
+ "The maximum length of a stored completion.
DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
(defvar completion-prefix-min-length 3
@@ -1301,8 +1301,8 @@ String must be longer than `completion-prefix-min-length'."
(defun check-completion-length (string)
(if (< (length string) completion-min-length)
- (error "The string `%s' is too short to be saved as a completion"
- string)
+ (user-error "The string `%s' is too short to be saved as a completion"
+ string)
(list string)))
(defun add-completion (string &optional num-uses last-use-time)
@@ -2337,7 +2337,10 @@ TYPE is the type of the wrapper to be added. Can be :before or :under."
;;;###autoload
(define-minor-mode dynamic-completion-mode
- "Enable dynamic word-completion."
+ "Toggle dynamic word-completion on or off.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
:global t
;; This is always good, not specific to dynamic-completion-mode.
(define-key function-key-map [C-return] [?\C-\r])
@@ -2464,10 +2467,6 @@ TYPE is the type of the wrapper to be added. Can be :before or :under."
(defvaralias 'cmpl-syntax-table 'completion-syntax-table)
(defalias 'initialize-completions 'completion-initialize)
-(dolist (x '("^To complete, the point must be after a symbol at least [0-9]* character long\\.$"
- "^The string \".*\" is too short to be saved as a completion\\.$"))
- (add-to-list 'debug-ignored-errors x))
-
(provide 'completion)
;;; completion.el ends here
diff --git a/lisp/composite.el b/lisp/composite.el
index 72317ac470e..4832848cb90 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -29,8 +29,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(defconst reference-point-alist
'((tl . 0) (tc . 1) (tr . 2)
(Bl . 3) (Bc . 4) (Br . 5)
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index 091f832c092..bfe3ae36c7e 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -1,6 +1,6 @@
;;; cus-dep.el --- find customization dependencies
;;
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: internal
@@ -25,7 +25,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'widget)
(require 'cus-face)
@@ -53,9 +52,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(default-directory (expand-file-name subdir))
(preloaded (concat "\\`"
(regexp-opt (mapcar
- (lambda (f)
- (file-name-sans-extension
- (file-name-nondirectory f)))
+ 'file-name-base
preloaded-file-list) t)
"\\.el\\'")))
(dolist (file files)
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 3d5ae69fe3d..8e06b16bd12 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1,6 +1,6 @@
;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
;;
-;; Copyright (C) 1996-1997, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2012 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
@@ -223,7 +223,7 @@
:group 'emacs)
(defgroup languages nil
- "Specialized modes for editing programming languages."
+ "Modes for editing programming languages."
:group 'programming)
(defgroup lisp nil
@@ -255,7 +255,7 @@
:group 'applications)
(defgroup news nil
- "Support for netnews reading and posting."
+ "Reading and posting to newsgroups."
:link '(custom-manual "(gnus)")
:group 'applications)
@@ -297,7 +297,7 @@
:group 'environment)
(defgroup unix nil
- "Front-ends/assistants for, or emulators of, UNIX features."
+ "Interfaces, assistants, and emulators for UNIX features."
:group 'environment)
(defgroup i18n nil
@@ -371,7 +371,7 @@
:group 'editing)
(defgroup mode-line nil
- "Content of the modeline."
+ "Contents of the mode line."
:group 'environment)
(defgroup editing-basics nil
@@ -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)
@@ -544,12 +547,6 @@ WIDGET is the widget to apply the filter entries of MENU on."
(erase-buffer)
(princ symbol (current-buffer))
(goto-char (point-min))
- ;; FIXME: Boolean variables are not predicates, so they shouldn't
- ;; end with `-p'. -stef
- ;; (when (and (eq (get symbol 'custom-type) 'boolean)
- ;; (re-search-forward "-p\\'" nil t))
- ;; (replace-match "" t t)
- ;; (goto-char (point-min)))
(if custom-unlispify-remove-prefixes
(let ((prefixes custom-prefix-list)
prefix)
@@ -732,26 +729,26 @@ groups after non-groups, if nil do not order groups at all."
;; `custom-buffer-create-internal' if `custom-buffer-verbose-help' is non-nil.
(defvar custom-commands
- '((" Set for current session " Custom-set t
- "Apply all settings in this buffer to the current session"
+ '((" Apply " Custom-set t
+ "Apply settings (for the current session only)"
"index"
"Apply")
- (" Save for future sessions " Custom-save
+ (" Apply and Save " Custom-save
(or custom-file user-init-file)
- "Apply all settings in this buffer and save them for future Emacs sessions."
+ "Apply settings and save for future sessions."
"save"
"Save")
- (" Undo edits " Custom-reset-current t
- "Restore all settings in this buffer to reflect their current values."
+ (" Undo Edits " Custom-reset-current t
+ "Restore customization buffer to reflect existing settings."
"refresh"
"Undo")
- (" Reset to saved " Custom-reset-saved t
- "Restore all settings in this buffer to their saved values (if any)."
+ (" Reset Customizations " Custom-reset-saved t
+ "Undo any settings applied only for the current session."
"undo"
"Reset")
- (" Erase customizations " Custom-reset-standard
+ (" Erase Customizations " Custom-reset-standard
(or custom-file user-init-file)
- "Un-customize all settings in this buffer and save them with standard values."
+ "Un-customize settings in this and future sessions."
"delete"
"Uncustomize")
(" Help for Customize " Custom-help t
@@ -766,9 +763,9 @@ groups after non-groups, if nil do not order groups at all."
(info "(emacs)Easy Customization"))
(defvar custom-reset-menu
- '(("Undo Edits" . Custom-reset-current)
- ("Reset to Saved" . Custom-reset-saved)
- ("Erase Customizations (use standard values)" . Custom-reset-standard))
+ '(("Undo Edits in Customization Buffer" . Custom-reset-current)
+ ("Revert This Session's Customizations" . Custom-reset-saved)
+ ("Erase Customizations" . Custom-reset-standard))
"Alist of actions for the `Reset' button.
The key is a string containing the name of the action, the value is a
Lisp function taking the widget as an element which will be called
@@ -901,7 +898,8 @@ making them as if they had never been customized at all."
(memq (widget-get widget :custom-state)
'(modified set changed saved rogue))
(widget-apply widget :custom-mark-to-reset-standard)))
- "Erase all customizations for settings in this buffer? " t)
+ "The settings will revert to their default values, in this
+and future sessions. Really erase customizations? " t)
(custom-reset-standard-save-and-update)))
;;; The Customize Commands
@@ -1136,7 +1134,7 @@ If OTHER-WINDOW is non-nil, display in another window."
;;;###autoload
(defun customize-option (symbol)
- "Customize SYMBOL, which must be a user option variable."
+ "Customize SYMBOL, which must be a user option."
(interactive (custom-variable-prompt))
(unless symbol
(error "No variable specified"))
@@ -1152,7 +1150,7 @@ If OTHER-WINDOW is non-nil, display in another window."
;;;###autoload
(defun customize-option-other-window (symbol)
- "Customize SYMBOL, which must be a user option variable.
+ "Customize SYMBOL, which must be a user option.
Show the buffer in another window, but don't select it."
(interactive (custom-variable-prompt))
(unless symbol
@@ -1164,7 +1162,7 @@ Show the buffer in another window, but don't select it."
(unless (eq symbol basevar)
(message "`%s' is an alias for `%s'" symbol basevar))))
-(defvar customize-changed-options-previous-release "23.1"
+(defvar customize-changed-options-previous-release "24.1"
"Version for `customize-changed-options' to refer back to by default.")
;; Packages will update this variable, so make it available.
@@ -1206,9 +1204,10 @@ the official name of the package, such as MH-E or Gnus.")
;;;###autoload
(defun customize-changed-options (&optional since-version)
"Customize all settings whose meanings have changed in Emacs itself.
-This includes new user option variables and faces, and new
-customization groups, as well as older options and faces whose meanings
-or default values have changed since the previous major Emacs release.
+This includes new user options and faces, and new customization
+groups, as well as older options and faces whose meanings or
+default values have changed since the previous major Emacs
+release.
With argument SINCE-VERSION (a string), customize all settings
that were added or redefined since that version."
@@ -1258,8 +1257,8 @@ that were added or redefined since that version."
(if found
(custom-buffer-create (custom-sort-items found t 'first)
"*Customize Changed Options*")
- (error "No user option defaults have been changed since Emacs %s"
- since-version))))
+ (user-error "No user option defaults have been changed since Emacs %s"
+ since-version))))
(defun customize-package-emacs-version (symbol package-version)
"Return the Emacs version in which SYMBOL's meaning last changed.
@@ -1357,7 +1356,7 @@ suggest to customize that face, if it's customizable."
;;;###autoload
(defun customize-unsaved ()
- "Customize all user options set in this session but not saved."
+ "Customize all options and faces set in this session but not saved."
(interactive)
(let ((found nil))
(mapatoms (lambda (symbol)
@@ -1390,12 +1389,12 @@ suggest to customize that face, if it's customizable."
(default-value symbol))))
(push (list symbol 'custom-variable) found)))))
(if (not found)
- (error "No rogue user options")
+ (user-error "No rogue user options")
(custom-buffer-create (custom-sort-items found t nil)
"*Customize Rogue*"))))
;;;###autoload
(defun customize-saved ()
- "Customize all already saved user options."
+ "Customize all saved options and faces."
(interactive)
(let ((found nil))
(mapatoms (lambda (symbol)
@@ -1407,8 +1406,8 @@ suggest to customize that face, if it's customizable."
(get symbol 'saved-variable-comment))
(boundp symbol)
(push (list symbol 'custom-variable) found))))
- (if (not found )
- (error "No saved user options")
+ (if (not found)
+ (user-error "No saved user options")
(custom-buffer-create (custom-sort-items found t nil)
"*Customize Saved*"))))
@@ -1416,7 +1415,7 @@ suggest to customize that face, if it's customizable."
;;;###autoload
(defun customize-apropos (pattern &optional type)
- "Customize all loaded options, faces and groups matching PATTERN.
+ "Customize loaded options, faces and groups matching PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
or a regexp (using some regexp special characters). If it is a word,
search for matches for that word as a substring. If it is a list of words,
@@ -1424,62 +1423,50 @@ search for matches for any two (or more) of those words.
If TYPE is `options', include only options.
If TYPE is `faces', include only faces.
-If TYPE is `groups', include only groups.
-If TYPE is t (interactively, with prefix arg), include variables
-that are not customizable options, as well as faces and groups
-\(but we recommend using `apropos-variable' instead)."
- (interactive (list (apropos-read-pattern "symbol") current-prefix-arg))
+If TYPE is `groups', include only groups."
+ (interactive (list (apropos-read-pattern "symbol") nil))
(require 'apropos)
+ (unless (memq type '(nil options faces groups))
+ (error "Invalid setting type %s" (symbol-name type)))
(apropos-parse-pattern pattern)
(let (found)
(mapatoms
`(lambda (symbol)
(when (string-match apropos-regexp (symbol-name symbol))
- ,(if (not (memq type '(faces options)))
+ ,(if (memq type '(nil groups))
'(if (get symbol 'custom-group)
(push (list symbol 'custom-group) found)))
- ,(if (not (memq type '(options groups)))
+ ,(if (memq type '(nil faces))
'(if (custom-facep symbol)
(push (list symbol 'custom-face) found)))
- ,(if (not (memq type '(groups faces)))
+ ,(if (memq type '(nil options))
`(if (and (boundp symbol)
(eq (indirect-variable symbol) symbol)
(or (get symbol 'saved-value)
- (custom-variable-p symbol)
- ,(if (not (memq type '(nil options)))
- '(get symbol 'variable-documentation))))
+ (custom-variable-p symbol)))
(push (list symbol 'custom-variable) found))))))
- (if (not found)
- (error "No %s matching %s"
- (if (eq type t)
- "items"
- (format "customizable %s"
- (if (memq type '(options faces groups))
- (symbol-name type)
- "items")))
- pattern)
- (custom-buffer-create
- (custom-sort-items found t custom-buffer-order-groups)
- "*Customize Apropos*"))))
+ (unless found
+ (error "No customizable %s matching %s" (symbol-name type) pattern))
+ (custom-buffer-create
+ (custom-sort-items found t custom-buffer-order-groups)
+ "*Customize Apropos*")))
;;;###autoload
-(defun customize-apropos-options (regexp &optional arg)
- "Customize all loaded customizable options matching REGEXP.
-With prefix ARG, include variables that are not customizable options
-\(but it is better to use `apropos-variable' if you want to find those)."
- (interactive "sCustomize options (regexp): \nP")
- (customize-apropos regexp (or arg 'options)))
+(defun customize-apropos-options (regexp &optional ignored)
+ "Customize all loaded customizable options matching REGEXP."
+ (interactive (list (apropos-read-pattern "options")))
+ (customize-apropos regexp 'options))
;;;###autoload
(defun customize-apropos-faces (regexp)
"Customize all loaded faces matching REGEXP."
- (interactive "sCustomize faces (regexp): \n")
+ (interactive (list (apropos-read-pattern "faces")))
(customize-apropos regexp 'faces))
;;;###autoload
(defun customize-apropos-groups (regexp)
"Customize all loaded groups matching REGEXP."
- (interactive "sCustomize groups (regexp): \n")
+ (interactive (list (apropos-read-pattern "groups")))
(customize-apropos regexp 'groups))
;;; Buffer.
@@ -1552,11 +1539,12 @@ that option."
(switch-to-buffer-other-window (custom-get-fresh-buffer name))
(custom-buffer-create-internal options description))
-(defcustom custom-reset-button-menu nil
+(defcustom custom-reset-button-menu t
"If non-nil, only show a single reset button in customize buffers.
This button will have a menu with all three reset operations."
:type 'boolean
- :group 'custom-buffer)
+ :group 'custom-buffer
+ :version "24.3")
(defcustom custom-buffer-verbose-help t
"If non-nil, include explanatory text in the customization buffer."
@@ -1606,13 +1594,12 @@ Otherwise use brackets."
(let ((init-file (or custom-file user-init-file)))
;; Insert verbose help at the top of the custom buffer.
(when custom-buffer-verbose-help
- (widget-insert (if init-file
- "To apply changes, use the Save or Set buttons."
- "Custom settings cannot be saved; maybe you started Emacs with `-q'.")
- "\nFor details, see ")
+ (unless init-file
+ (widget-insert "Custom settings cannot be saved; maybe you started Emacs with `-q'.\n"))
+ (widget-insert "For help using this buffer, see ")
(widget-create 'custom-manual
- :tag "Saving Customizations"
- "(emacs)Saving Customizations")
+ :tag "Easy Customization"
+ "(emacs)Easy Customization")
(widget-insert " in the ")
(widget-create 'custom-manual
:tag "Emacs manual"
@@ -1624,7 +1611,9 @@ Otherwise use brackets."
;; Insert the search field.
(when custom-search-field
(widget-insert "\n")
- (let* ((echo "Search for custom items")
+ (let* ((echo "Search for custom items.
+You can enter one or more words separated by spaces,
+or a regular expression.")
(search-widget
(widget-create
'editable-field
@@ -1637,7 +1626,7 @@ Otherwise use brackets."
:tag " Search "
:help-echo echo :action
(lambda (widget &optional _event)
- (customize-apropos (widget-value (widget-get widget :parent)))))
+ (customize-apropos (split-string (widget-value (widget-get widget :parent))))))
(widget-insert "\n")))
;; The custom command buttons are also in the toolbar, so for a
@@ -1649,29 +1638,30 @@ Otherwise use brackets."
;; So now the buttons are always inserted in the buffer. (Bug#1326)
(if custom-buffer-verbose-help
(widget-insert "
- Operate on all settings in this buffer:\n"))
+Operate on all settings in this buffer:\n"))
(let ((button (lambda (tag action active help _icon _label)
(widget-insert " ")
(if (eval active)
(widget-create 'push-button :tag tag
:help-echo help :action action))))
(commands custom-commands))
- (apply button (pop commands)) ; Set for current session
- (apply button (pop commands)) ; Save for future sessions
(if custom-reset-button-menu
(progn
- (widget-insert " ")
(widget-create 'push-button
- :tag "Reset buffer"
+ :tag " Revert... "
:help-echo "Show a menu with reset operations."
:mouse-down-action 'ignore
- :action 'custom-reset))
+ :action 'custom-reset)
+ (apply button (pop commands)) ; Apply
+ (apply button (pop commands))) ; Apply and Save
+ (apply button (pop commands)) ; Apply
+ (apply button (pop commands)) ; Apply and Save
(widget-insert "\n")
- (apply button (pop commands)) ; Undo edits
- (apply button (pop commands)) ; Reset to saved
- (apply button (pop commands)) ; Erase customization
+ (apply button (pop commands)) ; Undo
+ (apply button (pop commands)) ; Reset
+ (apply button (pop commands)) ; Erase
(widget-insert " ")
- (pop commands) ; Help (omitted)
+ (pop commands) ; Help (omitted)
(apply button (pop commands)))) ; Exit
(widget-insert "\n\n"))
@@ -1866,64 +1856,52 @@ item in another window.\n\n"))
:group 'custom-buffer)
(defface custom-invalid '((((class color))
- (:foreground "yellow1" :background "red1"))
- (t
- (:weight bold :slant italic :underline t)))
+ :foreground "yellow1" :background "red1")
+ (t :weight bold :slant italic :underline t))
"Face used when the customize item is invalid."
:group 'custom-magic-faces)
-(define-obsolete-face-alias 'custom-invalid-face 'custom-invalid "22.1")
(defface custom-rogue '((((class color))
- (:foreground "pink" :background "black"))
- (t
- (:underline t)))
+ :foreground "pink" :background "black")
+ (t :underline t))
"Face used when the customize item is not defined for customization."
:group 'custom-magic-faces)
-(define-obsolete-face-alias 'custom-rogue-face 'custom-rogue "22.1")
(defface custom-modified '((((min-colors 88) (class color))
- (:foreground "white" :background "blue1"))
+ :foreground "white" :background "blue1")
(((class color))
- (:foreground "white" :background "blue"))
- (t
- (:slant italic :bold)))
+ :foreground "white" :background "blue")
+ (t :slant italic))
"Face used when the customize item has been modified."
:group 'custom-magic-faces)
-(define-obsolete-face-alias 'custom-modified-face 'custom-modified "22.1")
(defface custom-set '((((min-colors 88) (class color))
- (:foreground "blue1" :background "white"))
+ :foreground "blue1" :background "white")
(((class color))
- (:foreground "blue" :background "white"))
- (t
- (:slant italic)))
+ :foreground "blue" :background "white")
+ (t :slant italic))
"Face used when the customize item has been set."
:group 'custom-magic-faces)
-(define-obsolete-face-alias 'custom-set-face 'custom-set "22.1")
(defface custom-changed '((((min-colors 88) (class color))
- (:foreground "white" :background "blue1"))
+ :foreground "white" :background "blue1")
(((class color))
- (:foreground "white" :background "blue"))
- (t
- (:slant italic)))
+ :foreground "white" :background "blue")
+ (t :slant italic))
"Face used when the customize item has been changed."
:group 'custom-magic-faces)
-(define-obsolete-face-alias 'custom-changed-face 'custom-changed "22.1")
(defface custom-themed '((((min-colors 88) (class color))
- (:foreground "white" :background "blue1"))
- (((class color))
- (:foreground "white" :background "blue"))
- (t
- (:slant italic)))
+ :foreground "white" :background "blue1")
+ (((class color))
+ :foreground "white" :background "blue")
+ (t :slant italic))
"Face used when the customize item has been set by a theme."
:group 'custom-magic-faces)
-(defface custom-saved '((t (:underline t)))
+(defface custom-saved '((t :underline t))
"Face used when the customize item has been saved."
:group 'custom-magic-faces)
-(define-obsolete-face-alias 'custom-saved-face 'custom-saved "22.1")
(defconst custom-magic-alist
'((nil "#" underline "\
@@ -2114,25 +2092,22 @@ and `face'."
;;; The `custom' Widget.
(defface custom-button
- '((((type x w32 ns) (class color)) ; Like default modeline
- (:box (:line-width 2 :style released-button)
- :background "lightgrey" :foreground "black"))
- (t
- nil))
+ '((((type x w32 ns) (class color)) ; Like default mode line
+ :box (:line-width 2 :style released-button)
+ :background "lightgrey" :foreground "black"))
"Face for custom buffer buttons if `custom-raised-buttons' is non-nil."
:version "21.1"
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-button-face 'custom-button "22.1")
(defface custom-button-mouse
'((((type x w32 ns) (class color))
- (:box (:line-width 2 :style released-button)
- :background "grey90" :foreground "black"))
+ :box (:line-width 2 :style released-button)
+ :background "grey90" :foreground "black")
(t
;; This is for text terminals that support mouse, like GPM mouse
;; or the MS-DOS terminal: inverse-video makes the button stand
;; out on mouse-over.
- (:inverse-video t)))
+ :inverse-video t))
"Mouse face for custom buffer buttons if `custom-raised-buttons' is non-nil."
:version "22.1"
:group 'custom-faces)
@@ -2151,15 +2126,12 @@ and `face'."
(defface custom-button-pressed
'((((type x w32 ns) (class color))
- (:box (:line-width 2 :style pressed-button)
- :background "lightgrey" :foreground "black"))
- (t
- (:inverse-video t)))
+ :box (:line-width 2 :style pressed-button)
+ :background "lightgrey" :foreground "black")
+ (t :inverse-video t))
"Face for pressed custom buttons if `custom-raised-buttons' is non-nil."
:version "21.1"
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-button-pressed-face
- 'custom-button-pressed "22.1")
(defface custom-button-pressed-unraised
'((default :inherit custom-button-unraised)
@@ -2177,22 +2149,15 @@ and `face'."
(defface custom-documentation '((t nil))
"Face used for documentation strings in customization buffers."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-documentation-face
- 'custom-documentation "22.1")
-
-(defface custom-state '((((class color)
- (background dark))
- (:foreground "lime green"))
- (((class color)
- (background light))
- (:foreground "dark green"))
- (t nil))
+
+(defface custom-state '((((class color) (background dark))
+ :foreground "lime green")
+ (((class color) (background light))
+ :foreground "dark green"))
"Face used for State descriptions in the customize buffer."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-state-face 'custom-state "22.1")
-(defface custom-link
- '((t :inherit link))
+(defface custom-link '((t :inherit link))
"Face for links in customization buffers."
:version "22.1"
:group 'custom-faces)
@@ -2263,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)
@@ -2389,20 +2354,18 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
"Face used for comments on variables or faces."
:version "21.1"
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-comment-face 'custom-comment "22.1")
;; like font-lock-comment-face
(defface custom-comment-tag
- '((((class color) (background dark)) (:foreground "gray80"))
- (((class color) (background light)) (:foreground "blue4"))
+ '((((class color) (background dark)) :foreground "gray80")
+ (((class color) (background light)) :foreground "blue4")
(((class grayscale) (background light))
- (:foreground "DimGray" :weight bold :slant italic))
+ :foreground "DimGray" :weight bold :slant italic)
(((class grayscale) (background dark))
- (:foreground "LightGray" :weight bold :slant italic))
- (t (:weight bold)))
+ :foreground "LightGray" :weight bold :slant italic)
+ (t :weight bold))
"Face used for the comment tag on variables or faces."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-comment-tag-face 'custom-comment-tag "22.1")
(define-widget 'custom-comment 'string
"User comment."
@@ -2441,26 +2404,19 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
;;; The `custom-variable' Widget.
(defface custom-variable-tag
- `((((class color)
- (background dark))
- (:foreground "light blue" :weight bold))
- (((min-colors 88) (class color)
- (background light))
- (:foreground "blue1" :weight bold))
- (((class color)
- (background light))
- (:foreground "blue" :weight bold))
- (t (:weight bold)))
+ `((((class color) (background dark))
+ :foreground "light blue" :weight bold)
+ (((min-colors 88) (class color) (background light))
+ :foreground "blue1" :weight bold)
+ (((class color) (background light))
+ :foreground "blue" :weight bold)
+ (t :weight bold))
"Face used for unpushable variable tags."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-variable-tag-face
- 'custom-variable-tag "22.1")
-(defface custom-variable-button '((t (:underline t :weight bold)))
+(defface custom-variable-button '((t :underline t :weight bold))
"Face used for pushable variable tags."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-variable-button-face
- 'custom-variable-button "22.1")
(defcustom custom-variable-default-form 'edit
"Default form of displaying variable values."
@@ -2473,15 +2429,15 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
"Return documentation of VARIABLE for use in Custom buffer.
Normally just return the docstring. But if VARIABLE automatically
becomes buffer local when set, append a message to that effect."
- (if (and (local-variable-if-set-p variable)
- (or (not (local-variable-p variable))
- (with-temp-buffer
- (local-variable-if-set-p variable))))
- (concat (documentation-property variable 'variable-documentation)
+ (format "%s%s" (documentation-property variable 'variable-documentation)
+ (if (and (local-variable-if-set-p variable)
+ (or (not (local-variable-p variable))
+ (with-temp-buffer
+ (local-variable-if-set-p variable))))
"\n
This variable automatically becomes buffer-local when set outside Custom.
-However, setting it through Custom sets the default value.")
- (documentation-property variable 'variable-documentation)))
+However, setting it through Custom sets the default value."
+ "")))
(define-widget 'custom-variable 'custom
"A widget for displaying a Custom variable.
@@ -2599,7 +2555,6 @@ try matching its doc string against `custom-guess-doc-alist'."
:parent widget)
buttons))
((memq form '(lisp mismatch))
- ;; In lisp mode edit the saved value when possible.
(push (widget-create-child-and-convert
widget 'custom-visibility
:help-echo "Hide the value of this option."
@@ -2611,11 +2566,10 @@ try matching its doc string against `custom-guess-doc-alist'."
t)
buttons)
(insert " ")
- (let* ((value (cond ((get symbol 'saved-value)
- (car (get symbol 'saved-value)))
- ((get symbol 'standard-value)
- (car (get symbol 'standard-value)))
- ((default-boundp symbol)
+ ;; This used to try presenting the saved value or the
+ ;; standard value, but it seems more intuitive to present
+ ;; the current value (Bug#7600).
+ (let* ((value (cond ((default-boundp symbol)
(custom-quote (funcall get symbol)))
(t
(custom-quote (widget-get conv :value))))))
@@ -2824,12 +2778,10 @@ If STATE is nil, the value is computed by `custom-variable-state'."
(lambda (widget)
(and (default-boundp (widget-value widget))
(memq (widget-get widget :custom-state) '(modified changed)))))
- ("Reset to Saved" custom-variable-reset-saved
+ ("Revert This Session's Customization" custom-variable-reset-saved
(lambda (widget)
- (and (or (get (widget-value widget) 'saved-value)
- (get (widget-value widget) 'saved-variable-comment))
- (memq (widget-get widget :custom-state)
- '(modified set changed rogue)))))
+ (memq (widget-get widget :custom-state)
+ '(modified set changed rogue))))
,@(when (or custom-file init-file-user)
'(("Erase Customization" custom-variable-reset-standard
(lambda (widget)
@@ -2896,7 +2848,7 @@ Optional EVENT is the location for the menu."
(comment (widget-value comment-widget))
val)
(cond ((eq state 'hidden)
- (error "Cannot set hidden variable"))
+ (user-error "Cannot set hidden variable"))
((setq val (widget-apply child :validate))
(goto-char (widget-get val :from))
(error "%s" (widget-get val :error)))
@@ -2938,7 +2890,7 @@ Optional EVENT is the location for the menu."
(comment (widget-value comment-widget))
val)
(cond ((eq state 'hidden)
- (error "Cannot set hidden variable"))
+ (user-error "Cannot set hidden variable"))
((setq val (widget-apply child :validate))
(goto-char (widget-get val :from))
(error "Saving %s: %s" symbol (widget-get val :error)))
@@ -2980,23 +2932,25 @@ Optional EVENT is the location for the menu."
(custom-variable-state-set-and-redraw widget))
(defun custom-variable-reset-saved (widget)
- "Restore the saved value for the variable being edited by WIDGET.
-This also updates the buffer to show that value.
-The value that was current before this operation
-becomes the backup value, so you can get it again."
+ "Restore the value of the variable being edited by WIDGET.
+If there is a saved value, restore it; otherwise reset to the
+uncustomized (themed or standard) value.
+
+Update the widget to show that value. The value that was current
+before this operation becomes the backup value."
(let* ((symbol (widget-value widget))
- (set (or (get symbol 'custom-set) 'set-default))
- (value (get symbol 'saved-value))
+ (saved-value (get symbol 'saved-value))
(comment (get symbol 'saved-variable-comment)))
- (cond ((or value comment)
- (put symbol 'variable-comment comment)
- (custom-variable-backup-value widget)
- (custom-push-theme 'theme-value symbol 'user 'set (car-safe value))
- (condition-case nil
- (funcall set symbol (eval (car value)))
- (error nil)))
- (t
- (error "No saved value for %s" symbol)))
+ (custom-variable-backup-value widget)
+ (if (not (or saved-value comment))
+ ;; If there is no saved value, remove the setting.
+ (custom-push-theme 'theme-value symbol 'user 'reset)
+ ;; Otherwise, apply the saved value.
+ (put symbol 'variable-comment comment)
+ (custom-push-theme 'theme-value symbol 'user 'set (car-safe saved-value))
+ (ignore-errors
+ (funcall (or (get symbol 'custom-set) 'set-default)
+ symbol (eval (car saved-value)))))
(put symbol 'customized-value nil)
(put symbol 'customized-variable-comment nil)
(widget-put widget :custom-state 'unknown)
@@ -3010,7 +2964,7 @@ redraw the widget immediately."
(let* ((symbol (widget-value widget)))
(if (get symbol 'standard-value)
(custom-variable-backup-value widget)
- (error "No standard setting known for %S" symbol))
+ (user-error "No standard setting known for %S" symbol))
(put symbol 'variable-comment nil)
(put symbol 'customized-value nil)
(put symbol 'customized-variable-comment nil)
@@ -3072,8 +3026,8 @@ to switch between two values."
(condition-case nil
(funcall set symbol (car value))
(error nil)))
- (error "No backup value for %s" symbol))
- (put symbol 'customized-value (list (car value)))
+ (user-error "No backup value for %s" symbol))
+ (put symbol 'customized-value (list (custom-quote (car value))))
(put symbol 'variable-comment comment)
(put symbol 'customized-variable-comment comment)
(custom-variable-state-set widget)
@@ -3251,6 +3205,7 @@ Also change :reverse-video to :inverse-video."
:args '((const :tag "all" t)
(const :tag "defaults" default)
(checklist
+ :tag "specific display"
:offset 0
:extra-offset 9
:args ((group :sibling-args (:help-echo "\
@@ -3328,10 +3283,9 @@ Only match frames that support the specified face attributes.")
;;; The `custom-face' Widget.
(defface custom-face-tag
- `((t :inherit custom-variable-tag))
+ '((t :inherit custom-variable-tag))
"Face used for face tags."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-face-tag-face 'custom-face-tag "22.1")
(defcustom custom-face-default-form 'selected
"Default form of displaying face definition."
@@ -3619,10 +3573,9 @@ the present value is saved to its :shown-value property instead."
("Undo Edits" custom-redraw
(lambda (widget)
(memq (widget-get widget :custom-state) '(modified changed))))
- ("Reset to Saved" custom-face-reset-saved
+ ("Revert This Session's Customization" custom-face-reset-saved
(lambda (widget)
- (or (get (widget-value widget) 'saved-face)
- (get (widget-value widget) 'saved-face-comment))))
+ (memq (widget-get widget :custom-state) '(modified set changed))))
,@(when (or custom-file init-file-user)
'(("Erase Customization" custom-face-reset-standard
(lambda (widget)
@@ -3677,18 +3630,17 @@ This is one of `set', `saved', `changed', `themed', or `rogue'."
'changed))
((or (get face 'saved-face)
(get face 'saved-face-comment))
- (if (equal (get face 'saved-face-comment) comment)
- (cond
- ((eq 'user (caar (get face 'theme-face)))
- 'saved)
- ((eq 'changed (caar (get face 'theme-face)))
- 'changed)
- (t 'themed))
- 'changed))
+ (cond ((not (equal (get face 'saved-face-comment) comment))
+ 'changed)
+ ((eq 'user (caar (get face 'theme-face)))
+ 'saved)
+ ((eq 'changed (caar (get face 'theme-face)))
+ 'changed)
+ (t 'themed)))
((get face 'face-defface-spec)
- (if (equal comment nil)
- 'standard
- 'changed))
+ (cond (comment 'changed)
+ ((get face 'theme-face) 'themed)
+ (t 'standard)))
(t 'rogue))))
;; If the user called set-face-attribute to change the default for
;; new frames, this face is "set outside of Customize".
@@ -3778,24 +3730,26 @@ Optional EVENT is the location for the menu."
"22.1")
(defun custom-face-reset-saved (widget)
- "Restore WIDGET to the face's default attributes."
- (let* ((symbol (widget-value widget))
+ "Restore WIDGET to the face's default attributes.
+If there is a saved face, restore it; otherwise reset to the
+uncustomized (themed or standard) face."
+ (let* ((face (widget-value widget))
(child (car (widget-get widget :children)))
- (value (get symbol 'saved-face))
- (comment (get symbol 'saved-face-comment))
+ (saved-face (get face 'saved-face))
+ (comment (get face 'saved-face-comment))
(comment-widget (widget-get widget :comment-widget)))
- (unless (or value comment)
- (error "No saved value for this face"))
- (put symbol 'customized-face nil)
- (put symbol 'customized-face-comment nil)
- (custom-push-theme 'theme-face symbol 'user 'set value)
- (face-spec-set symbol value t)
- (put symbol 'face-comment comment)
- (widget-value-set child value)
+ (put face 'customized-face nil)
+ (put face 'customized-face-comment nil)
+ (custom-push-theme 'theme-face face 'user
+ (if saved-face 'set 'reset)
+ saved-face)
+ (face-spec-set face saved-face t)
+ (put face 'face-comment comment)
+ (widget-value-set child saved-face)
;; This call manages the comment visibility
(widget-value-set comment-widget (or comment ""))
(custom-face-state-set widget)
- (custom-redraw-magic widget)))
+ (custom-redraw widget)))
(defun custom-face-standard-value (widget)
(get (widget-value widget) 'face-defface-spec))
@@ -3809,7 +3763,7 @@ redraw the widget immediately."
(value (get symbol 'face-defface-spec))
(comment-widget (widget-get widget :comment-widget)))
(unless value
- (error "No standard setting for this face"))
+ (user-error "No standard setting for this face"))
(put symbol 'customized-face nil)
(put symbol 'customized-face-comment nil)
(custom-push-theme 'theme-face symbol 'user 'reset)
@@ -3939,8 +3893,6 @@ restoring it to the state of a face that has never been customized."
;;; The `custom-group' Widget.
(defcustom custom-group-tag-faces nil
- ;; In XEmacs, this ought to play games with font size.
- ;; Fixme: make it do so in Emacs.
"Face used for group tags.
The first member is used for level 1 groups, the second for level 2,
and so forth. The remaining group tags are shown with `custom-group-tag'."
@@ -3948,34 +3900,28 @@ and so forth. The remaining group tags are shown with `custom-group-tag'."
:group 'custom-faces)
(defface custom-group-tag-1
- `((((class color)
- (background dark))
- (:foreground "pink" :weight bold :height 1.2 :inherit variable-pitch))
- (((min-colors 88) (class color)
- (background light))
- (:foreground "red1" :weight bold :height 1.2 :inherit variable-pitch))
- (((class color)
- (background light))
- (:foreground "red" :weight bold :height 1.2 :inherit variable-pitch))
- (t (:weight bold)))
- "Face used for group tags."
+ '((default :weight bold :height 1.2 :inherit variable-pitch)
+ (((class color) (background dark)) :foreground "pink")
+ (((min-colors 88) (class color) (background light)) :foreground "red1")
+ (((class color) (background light)) :foreground "red"))
+ "Face for group tags."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-group-tag-face-1 'custom-group-tag-1 "22.1")
(defface custom-group-tag
- `((((class color)
- (background dark))
- (:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch))
- (((min-colors 88) (class color)
- (background light))
- (:foreground "blue1" :weight bold :height 1.2 :inherit variable-pitch))
- (((class color)
- (background light))
- (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch))
- (t (:weight bold)))
- "Face used for low level group tags."
+ '((default :weight bold :height 1.2 :inherit variable-pitch)
+ (((class color) (background dark)) :foreground "light blue")
+ (((min-colors 88) (class color) (background light)) :foreground "blue1")
+ (((class color) (background light)) :foreground "blue")
+ (t :weight bold))
+ "Face for low level group tags."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-group-tag-face 'custom-group-tag "22.1")
+
+(defface custom-group-subtitle
+ '((t :weight bold))
+ "Face for the \"Subgroups:\" subtitle in Custom buffers."
+ :group 'custom-faces)
+
+(defvar custom-group-doc-align-col 20)
(define-widget 'custom-group 'custom
"Customize group."
@@ -4042,11 +3988,9 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
(custom-browse-insert-prefix prefix)
(push (widget-create-child-and-convert
widget 'custom-browse-visibility
- ;; :tag-glyph "plus"
:tag "+")
buttons)
(insert "-- ")
- ;; (widget-glyph-insert nil "-- " "horizontal")
(push (widget-create-child-and-convert
widget 'custom-browse-group-tag)
buttons)
@@ -4056,8 +4000,6 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
(zerop (length members)))
(custom-browse-insert-prefix prefix)
(insert "[ ]-- ")
- ;; (widget-glyph-insert nil "[ ]" "empty")
- ;; (widget-glyph-insert nil "-- " "horizontal")
(push (widget-create-child-and-convert
widget 'custom-browse-group-tag)
buttons)
@@ -4135,7 +4077,8 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
:action 'custom-toggle-parent
(not (eq state 'hidden)))
buttons))
- (insert " : ")
+ (if (>= (current-column) custom-group-doc-align-col)
+ (insert " "))
;; Create magic button.
(let ((magic (widget-create-child-and-convert
widget 'custom-magic nil)))
@@ -4145,7 +4088,8 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
(widget-put widget :buttons buttons)
;; Insert documentation.
(if (and (eq custom-buffer-style 'links) (> level 1))
- (widget-put widget :documentation-indent 0))
+ (widget-put widget :documentation-indent
+ custom-group-doc-align-col))
(widget-add-documentation-string-button
widget :visibility-widget 'custom-visibility))
@@ -4223,25 +4167,34 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
(count 0)
(reporter (make-progress-reporter
"Creating group entries..." 0 len))
+ (have-subtitle (and (not (eq symbol 'emacs))
+ (eq custom-buffer-order-groups 'last)))
+ prev-type
children)
- (setq children
- (mapcar
- (lambda (entry)
- (widget-insert "\n")
- (progress-reporter-update reporter (setq count (1+ count)))
- (let ((sym (nth 0 entry))
- (type (nth 1 entry)))
- (prog1
- (widget-create-child-and-convert
- widget type
- :group widget
- :tag (custom-unlispify-tag-name sym)
- :custom-prefixes custom-prefix-list
- :custom-level (1+ level)
- :value sym)
- (unless (eq (preceding-char) ?\n)
- (widget-insert "\n")))))
- members))
+
+ (dolist (entry members)
+ (unless (eq prev-type 'custom-group)
+ (widget-insert "\n"))
+ (progress-reporter-update reporter (setq count (1+ count)))
+ (let ((sym (nth 0 entry))
+ (type (nth 1 entry)))
+ (when (and have-subtitle (eq type 'custom-group))
+ (setq have-subtitle nil)
+ (widget-insert
+ (propertize "Subgroups:\n" 'face 'custom-group-subtitle)))
+ (setq prev-type type)
+ (push (widget-create-child-and-convert
+ widget type
+ :group widget
+ :tag (custom-unlispify-tag-name sym)
+ :custom-prefixes custom-prefix-list
+ :custom-level (1+ level)
+ :value sym)
+ children)
+ (unless (eq (preceding-char) ?\n)
+ (widget-insert "\n"))))
+
+ (setq children (nreverse children))
(mapc 'custom-magic-reset children)
(widget-put widget :children children)
(custom-group-state-update widget)
@@ -4266,7 +4219,7 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
("Undo Edits" custom-group-reset-current
(lambda (widget)
(memq (widget-get widget :custom-state) '(modified))))
- ("Reset to Saved" custom-group-reset-saved
+ ("Revert This Session's Customizations" custom-group-reset-saved
(lambda (widget)
(memq (widget-get widget :custom-state) '(modified set))))
,@(when (or custom-file init-file-user)
@@ -4416,7 +4369,7 @@ if only the first line of the docstring is shown."))
;; sense.
(if no-error
nil
- (error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
+ (user-error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
(file-chase-links (or custom-file user-init-file))))
;; If recentf-mode is non-nil, this is defined.
@@ -4827,6 +4780,7 @@ If several parents are listed, go to the first of them."
(set (make-local-variable 'widget-link-suffix) ""))
(setq show-trailing-whitespace nil))
+(define-obsolete-variable-alias 'custom-mode-hook 'Custom-mode-hook "23.1")
(define-derived-mode Custom-mode nil "Custom"
"Major mode for editing customization buffers.
@@ -4869,26 +4823,9 @@ 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-variable-alias 'custom-mode-hook 'Custom-mode-hook "23.1")
+(define-obsolete-function-alias 'custom-mode 'Custom-mode "23.1")
-(dolist (regexp
- '("^No user option defaults have been changed since Emacs "
- "^Invalid face:? "
- "^No \\(?:customized\\|rogue\\|saved\\) user options"
- "^No customizable items matching "
- "^There are unset changes"
- "^Cannot set hidden variable"
- "^No \\(?:saved\\|backup\\) value for "
- "^No standard setting known for "
- "^No standard setting for this face"
- "^Saving settings from \"emacs -q\" would overwrite existing customizations"))
- (add-to-list 'debug-ignored-errors regexp))
+(add-to-list 'debug-ignored-errors "^Invalid face:? ")
;;; The End.
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index c23632ab885..06fd10149d3 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -1,6 +1,6 @@
;;; cus-face.el --- customization support for faces
;;
-;; Copyright (C) 1996-1997, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2012 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
@@ -135,8 +135,37 @@
(choice :tag "Underline"
:help-echo "Control text underlining."
(const :tag "Off" nil)
- (const :tag "On" t)
- (color :tag "Colored")))
+ (list :tag "On"
+ :value (:color foreground-color :style line)
+ (const :format "" :value :color)
+ (choice :tag "Color"
+ (const :tag "Foreground Color" foreground-color)
+ color)
+ (const :format "" :value :style)
+ (choice :tag "Style"
+ (const :tag "Line" line)
+ (const :tag "Wave" wave))))
+ ;; filter to make value suitable for customize
+ (lambda (real-value)
+ (and real-value
+ (let ((color
+ (or (and (consp real-value) (plist-get real-value :color))
+ (and (stringp real-value) real-value)
+ 'foreground-color))
+ (style
+ (or (and (consp real-value) (plist-get real-value :style))
+ 'line)))
+ (list :color color :style style))))
+ ;; filter to make customized-value suitable for storing
+ (lambda (cus-value)
+ (and cus-value
+ (let ((color (plist-get cus-value :color))
+ (style (plist-get cus-value :style)))
+ (cond ((eq style 'line)
+ ;; Use simple value for default style
+ (if (eq color 'foreground-color) t color))
+ (t
+ `(:color ,color :style ,style)))))))
(:overline
(choice :tag "Overline"
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 1d6b42f48e6..5e81e1545b6 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -1,7 +1,7 @@
;;; cus-start.el --- define customization properties of builtins
-;;
-;; Copyright (C) 1997, 1999-2011 Free Software Foundation, Inc.
-;;
+
+;; Copyright (C) 1997, 1999-2012 Free Software Foundation, Inc.
+
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: internal
;; Package: emacs
@@ -22,7 +22,7 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
-;;
+
;; This file adds customize support for built-in variables.
;; While dumping Emacs, this file is loaded, but it only records
@@ -48,8 +48,22 @@
;; :tag - custom-tag property
(let ((all '(;; alloc.c
(gc-cons-threshold alloc integer)
+ (gc-cons-percentage alloc float)
(garbage-collection-messages alloc boolean)
;; buffer.c
+ (cursor-type
+ display
+ (choice
+ (const :tag "Frame default" t)
+ (const :tag "Filled box" box)
+ (const :tag "Hollow cursor" hollow)
+ (const :tag "Vertical bar" bar)
+ (cons :tag "Vertical bar with specified width"
+ (const bar) integer)
+ (const :tag "Horizontal bar" hbar)
+ (cons :tag "Horizontal bar with specified width"
+ (const hbar) integer)
+ (const :tag "None "nil)))
(mode-line-format mode-line sexp) ;Hard to do right.
(major-mode internal function)
(case-fold-search matching boolean)
@@ -132,15 +146,25 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(exec-path execute
(repeat (choice (const :tag "default directory" nil)
(directory :format "%v"))))
+ (exec-suffixes execute (repeat string))
;; charset.c
(charset-map-path installation
(repeat (directory :format "%v")))
;; coding.c
(inhibit-eol-conversion mule boolean)
(eol-mnemonic-undecided mule string)
- (eol-mnemonic-unix mule string)
- (eol-mnemonic-dos mule string)
- (eol-mnemonic-mac mule string)
+ ;; startup.el fiddles with the values. IMO, would be
+ ;; simpler to just use #ifdefs in coding.c.
+ (eol-mnemonic-unix mule string nil
+ :standard
+ (if (memq system-type '(ms-dos windows-nt))
+ "(Unix)" ":"))
+ (eol-mnemonic-dos mule string nil
+ :standard
+ (if (memq system-type '(ms-dos windows-nt))
+ "\\" "(DOS)"))
+ (eol-mnemonic-mac mule string nil
+ :standard "(Mac)")
(file-coding-system-alist
mule
(alist
@@ -165,6 +189,13 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(inverse-video display boolean)
(visible-bell display boolean)
(no-redraw-on-reenter display boolean)
+
+ ;; dosfns.c
+ (dos-display-scancodes display boolean)
+ (dos-hyper-key keyboard integer)
+ (dos-super-key keyboard integer)
+ (dos-keypad-mode keyboard integer)
+
;; editfns.c
(user-full-name mail string)
;; eval.c
@@ -181,10 +212,12 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(const :tag "always" t)))
(debug-ignored-errors debug (repeat (choice symbol regexp)))
(debug-on-quit debug boolean)
- ;; fileio.c
- (delete-by-moving-to-trash auto-save boolean "23.1")
+ (debug-on-signal debug boolean)
+ ;; fileio.c
+ (delete-by-moving-to-trash auto-save boolean "23.1")
(auto-save-visited-file-name auto-save boolean)
;; filelock.c
+ (create-lockfiles files boolean "24.3")
(temporary-file-directory
;; Darwin section added 24.1, does not seem worth :version bump.
files directory nil
@@ -218,6 +251,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(use-dialog-box menu boolean "21.1")
(use-file-dialog menu boolean "22.1")
(focus-follows-mouse frames boolean "20.3")
+ ;; fontset.c
+ (vertical-centering-font-regexp display regexp)
;; frame.c
(default-frame-alist frames
(repeat (cons :format "%v"
@@ -237,6 +272,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
:set custom-set-minor-mode)
;; fringe.c
(overflow-newline-into-fringe fringe boolean)
+ ;; image.c
+ (imagemagick-render-type image integer "24.1")
;; indent.c
(indent-tabs-mode indent boolean)
;; keyboard.c
@@ -258,9 +295,6 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(const :tag "only shift-selection or mouse-drag" only)
(const :tag "off" nil))
"24.1")
- (suggest-key-bindings keyboard (choice (const :tag "off" nil)
- (integer :tag "time" 2)
- (other :tag "on")))
(debug-on-event debug
(choice (const :tag "None" nil)
(const :tag "When sent SIGUSR1" sigusr1)
@@ -401,7 +435,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)
@@ -411,7 +455,7 @@ since it could result in memory overflow and make Emacs crash."
(hscroll-margin windows integer "22.1")
(hscroll-step windows number "22.1")
(truncate-partial-width-windows display boolean "23.1")
- (mode-line-inverse-video mode-line boolean)
+ (make-cursor-line-fully-visible windows boolean)
(mode-line-in-non-selected-windows mode-line boolean "22.1")
(line-number-display-limit display
(choice integer
@@ -421,7 +465,8 @@ since it could result in memory overflow and make Emacs crash."
(message-log-max debug (choice (const :tag "Disable" nil)
(integer :menu-tag "lines"
:format "%v")
- (other :tag "Unlimited" t)))
+ (other :tag "Unlimited" t))
+ "24.3")
(unibyte-display-via-language-environment mule boolean)
(blink-cursor-alist cursor alist "22.1")
(overline-margin display integer "22.1")
@@ -438,9 +483,19 @@ since it could result in memory overflow and make Emacs crash."
(const :tag "Both" :value both)
(const :tag "Both-horiz" :value both-horiz)
(const :tag "Text-image-horiz" :value text-image-horiz)
- (const :tag "System default" :value nil)) "23.3")
- (tool-bar-max-label-size frames integer "23.3")
+ (const :tag "System default" :value nil)) "24.1")
+ (tool-bar-max-label-size frames integer "24.1")
(auto-hscroll-mode scrolling boolean "21.1")
+ (void-text-area-pointer cursor
+ (choice
+ (const :tag "Standard (text pointer)" :value nil)
+ (const :tag "Arrow" :value arrow)
+ (const :tag "Text pointer" :value text)
+ (const :tag "Hand" :value hand)
+ (const :tag "Vertical dragger" :value vdrag)
+ (const :tag "Horizontal dragger" :value hdrag)
+ (const :tag "Same as mode line" :value modeline)
+ (const :tag "Hourglass" :value hourglass)))
(display-hourglass cursor boolean)
(hourglass-delay cursor number)
@@ -458,6 +513,8 @@ since it could result in memory overflow and make Emacs crash."
(x-use-underline-position-properties display boolean "22.1")
(x-underline-at-descent-line display boolean "22.1")
(x-stretch-cursor display boolean "21.1")
+ ;; xselect.c
+ (x-select-enable-clipboard-manager killing boolean "24.1")
;; xsettings.c
(font-use-system-font font-selection boolean "23.2")))
this symbol group type standard version native-p rest prop propval
@@ -498,18 +555,26 @@ since it could result in memory overflow and make Emacs crash."
(featurep 'ns))
((string-match "\\`x-.*gtk" (symbol-name symbol))
(featurep 'gtk))
+ ((string-match "clipboard-manager" (symbol-name symbol))
+ (boundp 'x-select-enable-clipboard-manager))
((string-match "\\`x-" (symbol-name symbol))
(fboundp 'x-create-frame))
((string-match "selection" (symbol-name symbol))
(fboundp 'x-selection-exists-p))
((string-match "fringe" (symbol-name symbol))
(fboundp 'define-fringe-bitmap))
+ ((string-match "\\`imagemagick" (symbol-name symbol))
+ (fboundp 'imagemagick-types))
((equal "font-use-system-font" (symbol-name symbol))
(featurep 'system-font-setting))
;; Conditioned on x-create-frame, because that's
;; the condition for loadup.el to preload tool-bar.el.
((string-match "tool-bar-" (symbol-name symbol))
(fboundp 'x-create-frame))
+ ((equal "vertical-centering-font-regexp"
+ (symbol-name symbol))
+ ;; Any function from fontset.c will do.
+ (fboundp 'new-fontset))
(t t))))
(if (not (boundp symbol))
;; If variables are removed from C code, give an error here!
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index 1f33c3e8256..606033f915c 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -1,6 +1,6 @@
;;; cus-theme.el -- custom theme creation user interface
;;
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;;
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: FSF
@@ -81,7 +81,9 @@ Do not call this mode function yourself. It is meant for internal use."
(defun customize-create-theme (&optional theme buffer)
"Create or edit a custom theme.
THEME, if non-nil, should be an existing theme to edit. If THEME
-is `user', provide an option to remove these as custom settings.
+is `user', the resulting *Custom Theme* buffer also contains a
+checkbox for removing the theme settings specified in the buffer
+from the Custom save file.
BUFFER, if non-nil, should be a buffer to use; the default is
named *Custom Theme*."
(interactive)
@@ -209,6 +211,8 @@ remove them from your saved Custom file.\n\n"))
(message "")))
(defun custom-theme-revert (_ignore-auto noconfirm)
+ "Revert the current *Custom Theme* buffer.
+This is the `revert-buffer-function' for `custom-new-theme-mode'."
(when (or noconfirm (y-or-n-p "Discard current changes? "))
(customize-create-theme custom-theme--save-name (current-buffer))))
@@ -329,11 +333,16 @@ SPEC, if non-nil, should be a face spec to which to set the widget."
(load-theme theme nil t))
(let ((settings (reverse (get theme 'theme-settings))))
(dolist (setting settings)
- (funcall (if (eq (car setting) 'theme-value)
- 'custom-theme-add-variable
- 'custom-theme-add-face)
- (nth 1 setting)
- (nth 3 setting))))
+ (let ((option (eq (car setting) 'theme-value))
+ (name (nth 1 setting))
+ (value (nth 3 setting)))
+ (unless (and option
+ (memq name '(custom-enabled-themes
+ custom-safe-themes)))
+ (funcall (if option
+ 'custom-theme-add-variable
+ 'custom-theme-add-face)
+ name value)))))
theme)
;; From cus-edit.el
@@ -432,14 +441,17 @@ It includes all faces in list FACES."
(princ theme)
(princ "\n")
(dolist (spec faces)
+ ;; Insert the face iff the checkbox widget is checked.
(when (widget-get (nth 1 spec) :value)
(let* ((symbol (nth 0 spec))
(widget (nth 2 spec))
(value
- (if (car-safe (widget-get widget :children))
- (custom-face-widget-to-spec widget)
- ;; Child is null if the widget is closed (hidden).
- (widget-get widget :shown-value))))
+ (cond
+ ((car-safe (widget-get widget :children))
+ (custom-face-widget-to-spec widget))
+ ;; Child is null if the widget is closed (hidden).
+ ((widget-get widget :shown-value))
+ (t (custom-face-get-current-spec symbol)))))
(when (and (facep symbol) value)
(princ (if (bolp) " '(" "\n '("))
(prin1 symbol)
@@ -516,6 +528,7 @@ It includes all faces in list FACES."
(defcustom custom-theme-allow-multiple-selections nil
"Whether to allow multi-selections in the *Custom Themes* buffer."
+ :version "24.1"
:type 'boolean
:group 'custom-buffer)
diff --git a/lisp/custom.el b/lisp/custom.el
index a1d53720b7d..8dfcf4bc14c 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1,6 +1,6 @@
;;; custom.el --- tools for declaring and initializing options
;;
-;; Copyright (C) 1996-1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999, 2001-2012 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
@@ -120,7 +120,9 @@ the :set function.
For variables in preloaded files, you can simply use this
function for the :initialize property. For autoloaded variables,
you will also need to add an autoload stanza calling this
-function, and another one setting the standard-value property."
+function, and another one setting the standard-value property.
+Or you can wrap the defcustom in a progn, to force the autoloader
+to include all of it." ; see eg vc-sccs-search-project-dir
;; No longer true:
;; "See `send-mail-function' in sendmail.el for an example."
@@ -198,13 +200,21 @@ set to nil, as the value is no longer rogue."
(run-hooks 'custom-define-hook)
symbol)
-(defmacro defcustom (symbol value doc &rest args)
- "Declare SYMBOL as a customizable variable that defaults to VALUE.
+(defmacro defcustom (symbol standard doc &rest args)
+ "Declare SYMBOL as a customizable variable.
+SYMBOL is the variable name; it should not be quoted.
+STANDARD is an expression specifying the variable's standard
+value. It should not be quoted. It is evaluated once by
+`defcustom', and the value is assigned to SYMBOL if the variable
+is unbound. The expression itself is also stored, so that
+Customize can re-evaluate it later to get the standard value.
DOC is the variable documentation.
-Neither SYMBOL nor VALUE need to be quoted.
-If SYMBOL is not already bound, initialize it to VALUE.
-The remaining arguments should have the form
+This macro uses `defvar' as a subroutine, which also marks the
+variable as \"special\", so that it is always dynamically bound
+even when `lexical-binding' is t.
+
+The remaining arguments to `defcustom' should have the form
[KEYWORD VALUE]...
@@ -227,10 +237,14 @@ The following keywords are meaningful:
is `default-value'.
:require
VALUE should be a feature symbol. If you save a value
- for this option, then when your `.emacs' file loads the value,
+ for this option, then when your init file loads the value,
it does (require VALUE) first.
+:set-after VARIABLES
+ Specifies that SYMBOL should be set after the list of variables
+ VARIABLES when both have been customized.
:risky Set SYMBOL's `risky-local-variable' property to VALUE.
:safe Set SYMBOL's `safe-local-variable' property to VALUE.
+ See Info node `(elisp) File Local Variables'.
The following common keywords are also meaningful.
@@ -299,9 +313,6 @@ The following common keywords are also meaningful.
Load file FILE (a string) before displaying this customization
item. Loading is done with `load', and only if the file is
not already loaded.
-:set-after VARIABLES
- Specifies that SYMBOL should be set after the list of variables
- VARIABLES when both have been customized.
If SYMBOL has a local binding, then this form affects the local
binding. This is normally not what you want. Thus, if you need
@@ -319,14 +330,15 @@ for more information."
`(custom-declare-variable
',symbol
,(if lexical-binding ;FIXME: This is not reliable, but is all we have.
- ;; The `default' arg should be an expression that evaluates to
- ;; the value to use. The use of `eval' for it is spread over
- ;; many different places and hence difficult to eliminate, yet
- ;; we want to make sure that the `value' expression is checked by the
- ;; byte-compiler, and that lexical-binding is obeyed, so quote the
- ;; expression with `lambda' rather than with `quote'.
- `(list (lambda () ,value))
- `',value)
+ ;; The STANDARD arg should be an expression that evaluates to
+ ;; the standard value. The use of `eval' for it is spread
+ ;; over many different places and hence difficult to
+ ;; eliminate, yet we want to make sure that the `standard'
+ ;; expression is checked by the byte-compiler, and that
+ ;; lexical-binding is obeyed, so quote the expression with
+ ;; `lambda' rather than with `quote'.
+ ``(funcall #',(lambda () ,standard))
+ `',standard)
,doc
,@args))
@@ -338,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
@@ -589,13 +595,17 @@ If NOSET is non-nil, don't bother autoloading LOAD when setting the variable."
(put symbol 'custom-autoload (if noset 'noset t))
(custom-add-load symbol load))
-;; This test is also in the C code of `user-variable-p'.
(defun custom-variable-p (variable)
- "Return non-nil if VARIABLE is a custom variable.
-This recursively follows aliases."
- (setq variable (indirect-variable variable))
- (or (get variable 'standard-value)
- (get variable 'custom-autoload)))
+ "Return non-nil if VARIABLE is a customizable variable.
+A customizable variable is either (i) a variable whose property
+list contains a non-nil `standard-value' or `custom-autoload'
+property, or (ii) an alias for another customizable variable."
+ (when (symbolp variable)
+ (setq variable (indirect-variable variable))
+ (or (get variable 'standard-value)
+ (get variable 'custom-autoload))))
+
+(define-obsolete-function-alias 'user-variable-p 'custom-variable-p "24.3")
(defun custom-note-var-changed (variable)
"Inform Custom that VARIABLE has been set (changed).
@@ -922,18 +932,22 @@ Each of the arguments in ARGS should be a list of this form:
(SYMBOL EXP [NOW [REQUEST [COMMENT]]])
-This stores EXP (without evaluating it) as the saved value for SYMBOL.
-If NOW is present and non-nil, then also evaluate EXP and set
-the default value for the SYMBOL to the value of EXP.
+SYMBOL is the variable name, and EXP is an expression which
+evaluates to the customized value. EXP will also be stored,
+without evaluating it, in SYMBOL's `saved-value' property, so
+that it can be restored via the Customize interface. It is also
+added to the alist in SYMBOL's `theme-value' property \(by
+calling `custom-push-theme').
-REQUEST is a list of features we must require in order to
-handle SYMBOL properly.
-COMMENT is a comment string about SYMBOL.
+NOW, if present and non-nil, means to install the variable's
+value directly now, even if its `defcustom' declaration has not
+been executed. This is for internal use only.
-EXP itself is saved unevaluated as SYMBOL property `saved-value' and
-in SYMBOL's list property `theme-value' \(using `custom-push-theme')."
- (custom-check-theme theme)
+REQUEST is a list of features to `require' (which are loaded
+prior to evaluating EXP).
+COMMENT is a comment string about SYMBOL."
+ (custom-check-theme theme)
;; Process all the needed autoloads before anything else, so that the
;; subsequent code has all the info it needs (e.g. which var corresponds
;; to a minor mode), regardless of the ordering of the variables.
@@ -943,29 +957,7 @@ in SYMBOL's list property `theme-value' \(using `custom-push-theme')."
(memq (get symbol 'custom-autoload) '(nil noset)))
;; This symbol needs to be autoloaded, even just for a `set'.
(custom-load-symbol symbol))))
-
- ;; Move minor modes and variables with explicit requires to the end.
- (setq args
- (sort args
- (lambda (a1 a2)
- (let* ((sym1 (car a1))
- (sym2 (car a2))
- (1-then-2 (memq sym1 (get sym2 'custom-dependencies)))
- (2-then-1 (memq sym2 (get sym1 'custom-dependencies))))
- (cond ((and 1-then-2 2-then-1)
- (error "Circular custom dependency between `%s' and `%s'"
- sym1 sym2))
- (2-then-1 nil)
- ;; 1 is a dependency of 2, so needs to be set first.
- (1-then-2)
- ;; Put minor modes and symbols with :require last.
- ;; Putting minor modes last ensures that the mode
- ;; function will see other customized values rather
- ;; than default values.
- (t (or (nth 3 a2)
- (eq (get sym2 'custom-set)
- 'custom-set-minor-mode))))))))
-
+ (setq args (custom--sort-vars args))
(dolist (entry args)
(unless (listp entry)
(error "Incompatible Custom theme spec"))
@@ -999,6 +991,60 @@ in SYMBOL's list property `theme-value' \(using `custom-push-theme')."
(and (or now (default-boundp symbol))
(put symbol 'variable-comment comment)))))))
+(defvar custom--sort-vars-table)
+(defvar custom--sort-vars-result)
+
+(defun custom--sort-vars (vars)
+ "Sort VARS based on custom dependencies.
+VARS is a list whose elements have the same form as the ARGS
+arguments to `custom-theme-set-variables'. Return the sorted
+list, in which A occurs before B if B was defined with a
+`:set-after' keyword specifying A (see `defcustom')."
+ (let ((custom--sort-vars-table (make-hash-table))
+ (dependants (make-hash-table))
+ (custom--sort-vars-result nil)
+ last)
+ ;; Construct a pair of tables keyed with the symbols of VARS.
+ (dolist (var vars)
+ (puthash (car var) (cons t var) custom--sort-vars-table)
+ (puthash (car var) var dependants))
+ ;; From the second table, remove symbols that are depended-on.
+ (dolist (var vars)
+ (dolist (dep (get (car var) 'custom-dependencies))
+ (remhash dep dependants)))
+ ;; If a variable is "stand-alone", put it last if it's a minor
+ ;; mode or has a :require flag. This is not really necessary, but
+ ;; putting minor modes last helps ensure that the mode function
+ ;; sees other customized values rather than default values.
+ (maphash (lambda (sym var)
+ (when (and (null (get sym 'custom-dependencies))
+ (or (nth 3 var)
+ (eq (get sym 'custom-set)
+ 'custom-set-minor-mode)))
+ (remhash sym dependants)
+ (push var last)))
+ dependants)
+ ;; The remaining symbols depend on others but are not
+ ;; depended-upon. Do a depth-first topological sort.
+ (maphash #'custom--sort-vars-1 dependants)
+ (nreverse (append last custom--sort-vars-result))))
+
+(defun custom--sort-vars-1 (sym &optional _ignored)
+ (let ((elt (gethash sym custom--sort-vars-table)))
+ ;; The car of the hash table value is nil if the variable has
+ ;; already been processed, `dependant' if it is a dependant in the
+ ;; current graph descent, and t otherwise.
+ (when elt
+ (cond
+ ((eq (car elt) 'dependant)
+ (error "Circular custom dependency on `%s'" sym))
+ ((car elt)
+ (setcar elt 'dependant)
+ (dolist (dep (get sym 'custom-dependencies))
+ (custom--sort-vars-1 dep))
+ (setcar elt nil)
+ (push (cdr elt) custom--sort-vars-result))))))
+
;;; Defining themes.
@@ -1029,6 +1075,7 @@ The optional argument DOC is a doc string describing the theme.
Any theme `foo' should be defined in a file called `foo-theme.el';
see `custom-make-theme-feature' for more information."
+ (declare (doc-string 2))
(let ((feature (custom-make-theme-feature theme)))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
@@ -1105,12 +1152,14 @@ property `theme-feature' (which is usually a symbol created by
(defcustom custom-safe-themes '(default)
"Themes that are considered safe to load.
-If the value is a list, each element should be either the `sha1'
+If the value is a list, each element should be either the SHA-256
hash of a safe theme file, or the symbol `default', which stands
for any theme in the built-in Emacs theme directory (a directory
named \"themes\" in `data-directory').
-If the value is t, Emacs treats all themes as safe."
+If the value is t, Emacs treats all themes as safe.
+
+This variable cannot be set in a Custom theme."
:type '(choice (repeat :tag "List of safe themes"
(choice string
(const :tag "Built-in themes" default)))
@@ -1124,12 +1173,14 @@ If the value is t, Emacs treats all themes as safe."
The theme file is named THEME-theme.el, in one of the directories
specified by `custom-theme-load-path'.
-If optional arg NO-CONFIRM is non-nil, and THEME is not
-considered safe according to `custom-safe-themes', prompt the
-user for confirmation.
+If the theme is not considered safe by `custom-safe-themes',
+prompt the user for confirmation before loading it. But if
+optional arg NO-CONFIRM is non-nil, load the theme without
+prompting.
-Normally, this function also enables THEME; if optional arg
-NO-ENABLE is non-nil, load the theme but don't enable it.
+Normally, this function also enables THEME. If optional arg
+NO-ENABLE is non-nil, load the theme but don't enable it, unless
+the theme was already enabled.
This function is normally called through Customize when setting
`custom-enabled-themes'. If used directly in your init file, it
@@ -1145,6 +1196,10 @@ Return t if THEME was successfully loaded, nil otherwise."
nil nil))
(unless (custom-theme-name-valid-p theme)
(error "Invalid theme name `%s'" theme))
+ ;; If THEME is already enabled, re-enable it after loading, even if
+ ;; NO-ENABLE is t.
+ (if no-enable
+ (setq no-enable (not (custom-theme-enabled-p theme))))
;; If reloading, clear out the old theme settings.
(when (custom-theme-p theme)
(disable-theme theme)
@@ -1159,7 +1214,7 @@ Return t if THEME was successfully loaded, nil otherwise."
(error "Unable to find theme file for `%s'" theme))
(with-temp-buffer
(insert-file-contents fn)
- (setq hash (sha1 (current-buffer)))
+ (setq hash (secure-hash 'sha256 (current-buffer)))
;; Check file safety with `custom-safe-themes', prompting the
;; user if necessary.
(when (or no-confirm
@@ -1169,7 +1224,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
@@ -1193,38 +1249,19 @@ Return t if THEME was successfully loaded, nil otherwise."
"Query the user about loading a Custom theme that may not be safe.
The theme should be in the current buffer. If the user agrees,
query also about adding HASH to `custom-safe-themes'."
- (if noninteractive
- nil
- (let ((exit-chars '(?y ?n ?\s))
- window prompt char)
- (save-window-excursion
- (rename-buffer "*Custom Theme*" t)
- (emacs-lisp-mode)
- (setq window (display-buffer (current-buffer)))
- (setq prompt
- (format "Loading a theme can run Lisp code. Really load?%s"
- (if (and window
- (< (line-number-at-pos (point-max))
- (window-body-height)))
- " (y or n) "
- (push ?\C-v exit-chars)
- "\nType y or n, or C-v to scroll: ")))
- (goto-char (point-min))
- (while (null char)
- (setq char (read-char-choice prompt exit-chars))
- (when (eq char ?\C-v)
- (if window
- (with-selected-window window
- (condition-case nil
- (scroll-up)
- (error (goto-char (point-min))))))
- (setq char nil)))
- (when (memq char '(?\s ?y))
- ;; Offer to save to `custom-safe-themes'.
- (and (or custom-file user-init-file)
- (y-or-n-p "Treat this theme as safe in future sessions? ")
- (customize-push-and-save 'custom-safe-themes (list hash)))
- t)))))
+ (unless noninteractive
+ (save-window-excursion
+ (rename-buffer "*Custom Theme*" t)
+ (emacs-lisp-mode)
+ (pop-to-buffer (current-buffer))
+ (goto-char (point-min))
+ (prog1 (when (y-or-n-p "Loading a theme can run Lisp code. Really load? ")
+ ;; Offer to save to `custom-safe-themes'.
+ (and (or custom-file user-init-file)
+ (y-or-n-p "Treat this theme as safe in future sessions? ")
+ (customize-push-and-save 'custom-safe-themes (list hash)))
+ t)
+ (quit-window)))))
(defun custom-theme-name-valid-p (name)
"Return t if NAME is a valid name for a Custom theme, nil otherwise.
@@ -1285,8 +1322,8 @@ precedence (after `user')."
((eq prop 'theme-face)
(custom-theme-recalc-face symbol))
((eq prop 'theme-value)
- ;; Don't change `custom-enabled-themes'; that's special.
- (unless (eq symbol 'custom-enabled-themes)
+ ;; Ignore `custom-enabled-themes' and `custom-safe-themes'.
+ (unless (memq symbol '(custom-enabled-themes custom-safe-themes))
(custom-theme-recalc-variable symbol)))))))
(unless (eq theme 'user)
(setq custom-enabled-themes
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
index 540b93faad8..ab886edac25 100644
--- a/lisp/dabbrev.el
+++ b/lisp/dabbrev.el
@@ -1,6 +1,6 @@
-;;; dabbrev.el --- dynamic abbreviation package
+;;; dabbrev.el --- dynamic abbreviation package -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1992, 1994, 1996-1997, 2000-2011
+;; Copyright (C) 1985-1986, 1992, 1994, 1996-1997, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Don Morrison
@@ -291,9 +291,6 @@ this list."
;; Internal variables
;;----------------------------------------------------------------
-;; Last obarray of completions in `dabbrev-completion'
-(defvar dabbrev--last-obarray nil)
-
;; Table of expansions seen so far
(defvar dabbrev--last-table nil)
@@ -321,9 +318,6 @@ this list."
;; The buffer we found the expansion last time.
(defvar dabbrev--last-buffer-found nil)
-;; The buffer we last did a completion in.
-(defvar dabbrev--last-completion-buffer nil)
-
;; If non-nil, a function to use when copying successive words.
;; It should be `upcase' or `downcase'.
(defvar dabbrev--last-case-pattern nil)
@@ -367,6 +361,13 @@ this list."
;;??? Do we want this?
;;;###autoload (define-key esc-map [?\C-/] 'dabbrev-completion)
+(defun dabbrev--ignore-case-p (abbrev)
+ (and (if (eq dabbrev-case-fold-search 'case-fold-search)
+ case-fold-search
+ dabbrev-case-fold-search)
+ (or (not dabbrev-upcase-means-case-search)
+ (string= abbrev (downcase abbrev)))))
+
;;;###autoload
(defun dabbrev-completion (&optional arg)
"Completion on current word.
@@ -387,49 +388,41 @@ then it searches *all* buffers."
(abbrev (dabbrev--abbrev-at-point))
(beg (progn (search-backward abbrev) (point)))
(end (progn (search-forward abbrev) (point)))
- (ignore-case-p (and (if (eq dabbrev-case-fold-search 'case-fold-search)
- case-fold-search
- dabbrev-case-fold-search)
- (or (not dabbrev-upcase-means-case-search)
- (string= abbrev (downcase abbrev)))))
- (my-obarray dabbrev--last-obarray))
- (save-excursion
- ;;--------------------------------
- ;; New abbreviation to expand.
- ;;--------------------------------
- (setq dabbrev--last-abbreviation abbrev)
- ;; Find all expansion
- (let ((completion-list
- (dabbrev--find-all-expansions abbrev ignore-case-p))
- (completion-ignore-case ignore-case-p))
- ;; Make an obarray with all expansions
- (setq my-obarray (make-vector (length completion-list) 0))
- (or (> (length my-obarray) 0)
- (error "No dynamic expansion for \"%s\" found%s"
- abbrev
- (if dabbrev--check-other-buffers "" " in this-buffer")))
- (cond
- ((or (not ignore-case-p)
- (not dabbrev-case-replace))
- (mapc (function (lambda (string)
- (intern string my-obarray)))
- completion-list))
- ((string= abbrev (upcase abbrev))
- (mapc (function (lambda (string)
- (intern (upcase string) my-obarray)))
- completion-list))
- ((string= (substring abbrev 0 1)
- (upcase (substring abbrev 0 1)))
- (mapc (function (lambda (string)
- (intern (capitalize string) my-obarray)))
- completion-list))
- (t
- (mapc (function (lambda (string)
- (intern (downcase string) my-obarray)))
- completion-list)))
- (setq dabbrev--last-obarray my-obarray)
- (setq dabbrev--last-completion-buffer (current-buffer))))
- (completion-in-region beg end my-obarray)))
+ (ignore-case-p (dabbrev--ignore-case-p abbrev))
+ (list 'uninitialized)
+ (table
+ (lambda (s p a)
+ (if (eq a 'metadata)
+ `(metadata (cycle-sort-function . ,#'identity)
+ (category . dabbrev))
+ (when (eq list 'uninitialized)
+ (save-excursion
+ ;;--------------------------------
+ ;; New abbreviation to expand.
+ ;;--------------------------------
+ (setq dabbrev--last-abbreviation abbrev)
+ ;; Find all expansion
+ (let ((completion-list
+ (dabbrev--find-all-expansions abbrev ignore-case-p))
+ (completion-ignore-case ignore-case-p))
+ (or (consp completion-list)
+ (user-error "No dynamic expansion for \"%s\" found%s"
+ abbrev
+ (if dabbrev--check-other-buffers
+ "" " in this-buffer")))
+ (setq list
+ (cond
+ ((not (and ignore-case-p dabbrev-case-replace))
+ completion-list)
+ ((string= abbrev (upcase abbrev))
+ (mapcar #'upcase completion-list))
+ ((string= (substring abbrev 0 1)
+ (upcase (substring abbrev 0 1)))
+ (mapcar #'capitalize completion-list))
+ (t
+ (mapcar #'downcase completion-list)))))))
+ (complete-with-action a list s p)))))
+ (completion-in-region beg end table)))
;;;###autoload
(defun dabbrev-expand (arg)
@@ -521,12 +514,9 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]."
;;--------------------------------
(or expansion
(setq expansion
- (dabbrev--find-expansion abbrev direction
- (and (if (eq dabbrev-case-fold-search 'case-fold-search)
- case-fold-search
- dabbrev-case-fold-search)
- (or (not dabbrev-upcase-means-case-search)
- (string= abbrev (downcase abbrev))))))))
+ (dabbrev--find-expansion
+ abbrev direction
+ (dabbrev--ignore-case-p abbrev)))))
(cond
((not expansion)
(dabbrev--reset-global-variables)
@@ -537,8 +527,8 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]."
(search-backward old)
(insert abbrev)
(delete-region (point) (+ (point) (length old)))))
- (error "No%s dynamic expansion for `%s' found"
- (if old " further" "") abbrev))
+ (user-error "No%s dynamic expansion for `%s' found"
+ (if old " further" "") abbrev))
(t
(if (not (or (eq dabbrev--last-buffer dabbrev--last-buffer-found)
(minibuffer-window-active-p (selected-window))))
@@ -595,7 +585,7 @@ all skip characters."
"Extract the symbol at point to serve as abbreviation."
;; Check for error
(if (bobp)
- (error "No possible abbreviation preceding point"))
+ (user-error "No possible abbreviation preceding point"))
;; Return abbrev at point
(save-excursion
;; Record the end of the abbreviation.
@@ -613,7 +603,7 @@ all skip characters."
"\\sw\\|\\s_")
nil t)
(forward-char 1)
- (error "No possible abbreviation preceding point"))))
+ (user-error "No possible abbreviation preceding point"))))
;; Now find the beginning of that one.
(dabbrev--goto-start-of-abbrev)
(buffer-substring-no-properties
@@ -621,8 +611,6 @@ all skip characters."
(defun dabbrev--reset-global-variables ()
"Initialize all global variables."
- ;; dabbrev--last-obarray and dabbrev--last-completion-buffer
- ;; must not be reset here.
(setq dabbrev--last-table nil
dabbrev--last-abbreviation nil
dabbrev--last-abbrev-location nil
@@ -667,13 +655,13 @@ of the expansion in `dabbrev--last-expansion-location'."
(let ((case-fold-search ignore-case)
(count n))
(while (and (> count 0)
- (setq expansion (dabbrev--search abbrev
- reverse
- (and ignore-case
- (if (eq dabbrev-case-distinction 'case-replace)
- case-replace
- dabbrev-case-distinction))
- )))
+ (setq expansion (dabbrev--search
+ abbrev reverse
+ (and ignore-case
+ (if (eq dabbrev-case-distinction
+ 'case-replace)
+ case-replace
+ dabbrev-case-distinction)))))
(setq count (1- count))))
(and expansion
(setq dabbrev--last-expansion-location (point)))
@@ -763,6 +751,7 @@ of the start of the occurrence."
(- (length dabbrev--friend-buffer-list)))
(setq dabbrev--last-expansion-location (point-min))
(setq expansion (dabbrev--try-find abbrev nil 1 ignore-case)))
+ (progress-reporter-done dabbrev--progress-reporter)
expansion)))))
;; Compute the list of buffers to scan.
@@ -828,14 +817,11 @@ EXPANSION is the expansion substring to be used this time.
RECORD-CASE-PATTERN, if non-nil, means set `dabbrev--last-case-pattern'
to record whether we upcased the expansion, downcased it, or did neither."
;;(undo-boundary)
- (let ((use-case-replace (and (if (eq dabbrev-case-fold-search 'case-fold-search)
- case-fold-search
- dabbrev-case-fold-search)
- (or (not dabbrev-upcase-means-case-search)
- (string= abbrev (downcase abbrev)))
- (if (eq dabbrev-case-replace 'case-replace)
- case-replace
- dabbrev-case-replace))))
+ (let ((use-case-replace
+ (and (dabbrev--ignore-case-p abbrev)
+ (if (eq dabbrev-case-replace 'case-replace)
+ case-replace
+ dabbrev-case-replace))))
;; If we upcased or downcased the original expansion,
;; do likewise for the subsequent words when we copy them.
@@ -861,12 +847,13 @@ to record whether we upcased the expansion, downcased it, or did neither."
(let ((expansion-rest (substring expansion 1))
(first-letter-position (string-match "[[:alpha:]]" abbrev)))
(if (or (null first-letter-position)
- (and (not (and (or (string= expansion-rest (downcase expansion-rest))
- (string= expansion-rest (upcase expansion-rest)))
- (or (string= abbrev (downcase abbrev))
- (and (string= abbrev (upcase abbrev))
- (> (- (length abbrev) first-letter-position)
- 1)))))
+ (and (not
+ (and (or (string= expansion-rest (downcase expansion-rest))
+ (string= expansion-rest (upcase expansion-rest)))
+ (or (string= abbrev (downcase abbrev))
+ (and (string= abbrev (upcase abbrev))
+ (> (- (length abbrev) first-letter-position)
+ 1)))))
(string= abbrev
(substring expansion 0 (length abbrev)))))
(setq use-case-replace nil)))
@@ -950,9 +937,9 @@ Leaves point at the location of the start of the expansion."
;; Limited search.
(save-restriction
(and dabbrev-limit
- (narrow-to-region dabbrev--last-expansion-location
- (+ (point)
- (if reverse (- dabbrev-limit) dabbrev-limit))))
+ (narrow-to-region
+ dabbrev--last-expansion-location
+ (+ (point) (if reverse (- dabbrev-limit) dabbrev-limit))))
;;--------------------------------
;; Look for a distinct expansion, using dabbrev--last-table.
;;--------------------------------
@@ -987,11 +974,6 @@ Leaves point at the location of the start of the expansion."
(cons found-string dabbrev--last-table))
result)))))
-(dolist (mess '("^No dynamic expansion for .* found"
- "^No further dynamic expansion for .* found$"
- "^No possible abbreviation preceding point$"))
- (add-to-list 'debug-ignored-errors mess))
-
(provide 'dabbrev)
;;; dabbrev.el ends here
diff --git a/lisp/delim-col.el b/lisp/delim-col.el
index a0a8af80389..936b0bff019 100644
--- a/lisp/delim-col.el
+++ b/lisp/delim-col.el
@@ -1,6 +1,6 @@
;;; delim-col.el --- prettify all columns in a region or rectangle
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/delsel.el b/lisp/delsel.el
index fcd45f1a148..2ed82676189 100644
--- a/lisp/delsel.el
+++ b/lisp/delsel.el
@@ -1,6 +1,6 @@
;;; delsel.el --- delete selection if you insert
-;; Copyright (C) 1992, 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Matthieu Devin <devin@lucid.com>
;; Maintainer: FSF
@@ -44,9 +44,12 @@
;; `kill-region' is used on the selection, rather than
;; `delete-region'. (Text selected with the mouse will typically
;; be yankable anyhow.)
-;; non-nil
+;; t
;; The normal case: delete the active region prior to executing
;; the command which will insert replacement text.
+;; <function>
+;; For commands which need to dynamically determine this behaviour.
+;; The function should return one of the above values or nil.
;;; Code:
@@ -71,65 +74,96 @@ any selection."
(transient-mark-mode t)))
(defun delete-active-region (&optional killp)
+ "Delete the active region.
+If KILLP in not-nil, the active region is killed instead of deleted."
(if killp
(kill-region (point) (mark))
(delete-region (point) (mark)))
t)
+(defun delete-selection-helper (type)
+ "Delete selection according to TYPE:
+ `yank'
+ For commands which do a yank; ensures the region about to be
+ deleted isn't yanked.
+ `supersede'
+ Delete the active region and ignore the current command,
+ i.e. the command will just delete the region.
+ `kill'
+ `kill-region' is used on the selection, rather than
+ `delete-region'. (Text selected with the mouse will typically
+ be yankable anyhow.)
+ t
+ The normal case: delete the active region prior to executing
+ the command which will insert replacement text.
+ FUNCTION
+ For commands which need to dynamically determine this behaviour.
+ FUNCTION should take no argument and return one of the above values or nil."
+ (condition-case data
+ (cond ((eq type 'kill)
+ (delete-active-region t))
+ ((eq type 'yank)
+ ;; Before a yank command, make sure we don't yank the
+ ;; head of the kill-ring that really comes from the
+ ;; currently active region we are going to delete.
+ ;; That would make yank a no-op.
+ (when (and (string= (buffer-substring-no-properties
+ (point) (mark))
+ (car kill-ring))
+ (fboundp 'mouse-region-match)
+ (mouse-region-match))
+ (current-kill 1))
+ (delete-active-region))
+ ((eq type 'supersede)
+ (let ((empty-region (= (point) (mark))))
+ (delete-active-region)
+ (unless empty-region
+ (setq this-command 'ignore))))
+ ((functionp type) (delete-selection-helper (funcall type)))
+ (type
+ (delete-active-region)
+ (if (and overwrite-mode
+ (eq this-command 'self-insert-command))
+ (let ((overwrite-mode nil))
+ (self-insert-command
+ (prefix-numeric-value current-prefix-arg))
+ (setq this-command 'ignore)))))
+ ;; If ask-user-about-supersession-threat signals an error,
+ ;; stop safe_run_hooks from clearing out pre-command-hook.
+ (file-supersession (message "%s" (cadr data)) (ding))
+ (text-read-only
+ ;; This signal may come either from `delete-active-region' or
+ ;; `self-insert-command' (when `overwrite-mode' is non-nil).
+ ;; To avoid clearing out `pre-command-hook' we handle this case
+ ;; by issuing a simple message. Note, however, that we do not
+ ;; handle all related problems: When read-only text ends before
+ ;; the end of the region, the latter is not deleted but any
+ ;; subsequent insertion will succeed. We could avoid this case
+ ;; by doing a (setq this-command 'ignore) here. This would,
+ ;; however, still not handle the case where read-only text ends
+ ;; precisely where the region starts: In that case the deletion
+ ;; would succeed but the subsequent insertion would fail with a
+ ;; text-read-only error. To handle that case we would have to
+ ;; investigate text properties at both ends of the region and
+ ;; skip the deletion when inserting text is forbidden there.
+ (message "Text is read-only") (ding))))
+
(defun delete-selection-pre-hook ()
- (when (and delete-selection-mode transient-mark-mode mark-active
+ "Function run before commands that delete selections are executed.
+Commands which will delete the selection need a `delete-selection'
+property on their symbol; commands which insert text but don't
+have this property won't delete the selection.
+See `delete-selection-helper'."
+ (when (and delete-selection-mode (use-region-p)
(not buffer-read-only))
- (let ((type (and (symbolp this-command)
- (get this-command 'delete-selection))))
- (condition-case data
- (cond ((eq type 'kill)
- (delete-active-region t))
- ((eq type 'yank)
- ;; Before a yank command, make sure we don't yank the
- ;; head of the kill-ring that really comes from the
- ;; currently active region we are going to delete.
- ;; That would make yank a no-op.
- (when (and (string= (buffer-substring-no-properties (point) (mark))
- (car kill-ring))
- (fboundp 'mouse-region-match)
- (mouse-region-match))
- (current-kill 1))
- (delete-active-region))
- ((eq type 'supersede)
- (let ((empty-region (= (point) (mark))))
- (delete-active-region)
- (unless empty-region
- (setq this-command 'ignore))))
- (type
- (delete-active-region)
- (if (and overwrite-mode (eq this-command 'self-insert-command))
- (let ((overwrite-mode nil))
- (self-insert-command (prefix-numeric-value current-prefix-arg))
- (setq this-command 'ignore)))))
- (file-supersession
- ;; If ask-user-about-supersession-threat signals an error,
- ;; stop safe_run_hooks from clearing out pre-command-hook.
- (and (eq inhibit-quit 'pre-command-hook)
- (setq inhibit-quit 'delete-selection-dummy))
- (signal 'file-supersession (cdr data)))
- (text-read-only
- ;; This signal may come either from `delete-active-region' or
- ;; `self-insert-command' (when `overwrite-mode' is non-nil).
- ;; To avoid clearing out `pre-command-hook' we handle this case
- ;; by issuing a simple message. Note, however, that we do not
- ;; handle all related problems: When read-only text ends before
- ;; the end of the region, the latter is not deleted but any
- ;; subsequent insertion will succeed. We could avoid this case
- ;; by doing a (setq this-command 'ignore) here. This would,
- ;; however, still not handle the case where read-only text ends
- ;; precisely where the region starts: In that case the deletion
- ;; would succeed but the subsequent insertion would fail with a
- ;; text-read-only error. To handle that case we would have to
- ;; investigate text properties at both ends of the region and
- ;; skip the deletion when inserting text is forbidden there.
- (message "Text is read-only") (ding))))))
-
-(put 'self-insert-command 'delete-selection t)
+ (delete-selection-helper (and (symbolp this-command)
+ (get this-command 'delete-selection)))))
+
+(put 'self-insert-command 'delete-selection
+ (lambda ()
+ (not (run-hook-with-args-until-success
+ 'self-insert-uses-region-functions))))
+
(put 'self-insert-iso 'delete-selection t)
(put 'yank 'delete-selection 'yank)
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 47f96e8d68f..c384b96df86 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -1,6 +1,6 @@
;;; descr-text.el --- describe text mode
-;; Copyright (C) 1994-1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Maintainer: FSF
@@ -140,7 +140,7 @@ otherwise."
(defun describe-text-properties-1 (pos output-buffer)
(let* ((properties (text-properties-at pos))
- (overlays (overlays-at pos))
+ (overlays (overlays-in pos (1+ pos)))
(wid-field (get-char-property pos 'field))
(wid-button (get-char-property pos 'button))
(wid-doc (get-char-property pos 'widget-doc))
@@ -374,14 +374,25 @@ This function is semi-obsolete. Use `get-char-code-property'."
(format "%c:%s" x doc)))
mnemonics ", ")))))
+(declare-function quail-find-key "quail" (char))
+
;;;###autoload
(defun describe-char (pos &optional buffer)
- "Describe the character after POS (interactively, the character after point).
-Is POS is taken to be in buffer BUFFER or current buffer if nil.
-The information includes character code, charset and code points in it,
-syntax, category, how the character is encoded in a file,
-character composition information (if relevant),
-as well as widgets, buttons, overlays, and text properties."
+ "Describe position POS (interactively, point) and the char after POS.
+POS is taken to be in BUFFER, or the current buffer if BUFFER is nil.
+The information is displayed in buffer `*Help*'.
+
+The position information includes POS; the total size of BUFFER; the
+region limits, if narrowed; the column number; and the horizontal
+scroll amount, if the buffer is horizontally scrolled.
+
+The character information includes the character code; charset and
+code points in it; syntax; category; how the character is encoded in
+BUFFER and in BUFFER's file; character composition information (if
+relevant); the font and font glyphs used to display the character;
+the character's canonical name and other properties defined by the
+Unicode Data Base; and widgets, buttons, overlays, and text properties
+relevant to POS."
(interactive "d")
(unless (buffer-live-p buffer) (setq buffer (current-buffer)))
(let ((src-buf (current-buffer)))
@@ -511,8 +522,27 @@ as well as widgets, buttons, overlays, and text properties."
(setq composition nil)))
(setq item-list
- `(("character"
- ,(format "%s (%d, #o%o, #x%x)"
+ `(("position"
+ ,(let* ((beg (point-min))
+ (end (point-max))
+ (total (buffer-size))
+ (percent (if (> total 50000) ; Avoid overflow multiplying by 100
+ (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
+ (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
+ (hscroll (if (= (window-hscroll) 0)
+ ""
+ (format ", Hscroll: %d" (window-hscroll))))
+ (col (current-column)))
+ (if (or (/= beg 1) (/= end (1+ total)))
+ (format "%d of %d (%d%%), restriction: <%d-%d>, column: %d%s"
+ pos total percent beg end col hscroll)
+ (if (= pos end)
+ (format "%d of %d (EOB), column: %d%s" pos total col hscroll)
+ (format "%d of %d (%d%%), column: %d%s"
+ pos total percent col hscroll)))))
+ ("character"
+ ,(format "%s (displayed as %s) (codepoint %d, #o%o, #x%x)"
+ char-description
(apply 'propertize char-description
(text-properties-at pos))
char char char))
@@ -521,7 +551,7 @@ as well as widgets, buttons, overlays, and text properties."
,(symbol-name charset)
'type 'help-character-set 'help-args '(,charset))
,(format "(%s)" (charset-description charset)))
- ("code point"
+ ("code point in charset"
,(let ((str (if (integerp code)
(format (if (< code 256) "0x%02X" "0x%04X")
code)
@@ -569,7 +599,10 @@ as well as widgets, buttons, overlays, and text properties."
`(insert-text-button
,current-input-method
'type 'help-input-method
- 'help-args '(,current-input-method)))))))
+ 'help-args '(,current-input-method))
+ "input method")
+ (list
+ "type \"C-x 8 RET HEX-CODEPOINT\" or \"C-x 8 RET NAME\"")))))
("buffer code"
,(if multibyte-p
(encoded-string-description
@@ -648,23 +681,17 @@ as well as widgets, buttons, overlays, and text properties."
(when (cadr elt)
(insert (format formatter (car elt)))
(dolist (clm (cdr elt))
- (if (eq (car-safe clm) 'insert-text-button)
- (progn (insert " ") (eval clm))
- (when (>= (+ (current-column)
- (or (string-match-p "\n" clm)
- (string-width clm))
- 1)
- (window-width))
- (insert "\n")
- (indent-to (1+ max-width)))
- (unless (zerop (length clm))
- (insert " " clm))))
+ (cond ((eq (car-safe clm) 'insert-text-button)
+ (insert " ")
+ (eval clm))
+ ((not (zerop (length clm)))
+ (insert " " clm))))
(insert "\n"))))
(when overlays
(save-excursion
(goto-char (point-min))
- (re-search-forward "character:[ \t\n]+")
+ (re-search-forward "(displayed as ")
(let ((end (+ (point) (length char-description))))
(mapc (lambda (props)
(let ((o (make-overlay (point) end)))
@@ -778,7 +805,7 @@ as well as widgets, buttons, overlays, and text properties."
(format " %s: %s\n" elt val)))))))
(if text-props-desc (insert text-props-desc))
- (toggle-read-only 1))))))
+ (setq buffer-read-only t))))))
(define-obsolete-function-alias 'describe-char-after 'describe-char "22.1")
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 34a51eb51dc..c8023bb43ed 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -1,6 +1,6 @@
;;; desktop.el --- save partial status of Emacs when killed
-;; Copyright (C) 1993-1995, 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
;; Keywords: convenience
@@ -34,7 +34,7 @@
;; - some local variables
;; To use this, use customize to turn on desktop-save-mode or add the
-;; following line somewhere in your .emacs file:
+;; following line somewhere in your init file:
;;
;; (desktop-save-mode 1)
;;
@@ -145,6 +145,8 @@ backward compatibility.")
"Save status of Emacs when you exit."
:group 'frames)
+;; Maintained for backward compatibility
+(define-obsolete-variable-alias 'desktop-enable 'desktop-save-mode "22.1")
;;;###autoload
(define-minor-mode desktop-save-mode
"Toggle desktop saving (Desktop Save mode).
@@ -158,10 +160,6 @@ one session to another. See variable `desktop-save' and function
:global t
:group 'desktop)
-;; Maintained for backward compatibility
-(define-obsolete-variable-alias 'desktop-enable
- 'desktop-save-mode "22.1")
-
(defun desktop-save-mode-off ()
"Disable `desktop-save-mode'. Provided for use in hooks."
(desktop-save-mode 0))
@@ -222,7 +220,7 @@ the normal hook `desktop-not-loaded-hook' is run."
:group 'desktop
:version "22.2")
-(defcustom desktop-path (list "." user-emacs-directory "~")
+(defcustom desktop-path (list user-emacs-directory "~")
"List of directories to search for the desktop file.
The base name of the file is specified in `desktop-base-file-name'."
:type '(repeat directory)
@@ -412,8 +410,7 @@ is passed as the argument DESKTOP-BUFFER-MISC to functions in
'desktop-save-buffer "22.1")
;;;###autoload
-(defvar desktop-buffer-mode-handlers
- nil
+(defvar desktop-buffer-mode-handlers nil
"Alist of major mode specific functions to restore a desktop buffer.
Functions listed are called by `desktop-create-buffer' when `desktop-read'
evaluates the desktop file. List elements must have the form
@@ -473,8 +470,7 @@ this table. See also `desktop-minor-mode-handlers'."
:group 'desktop)
;;;###autoload
-(defvar desktop-minor-mode-handlers
- nil
+(defvar desktop-minor-mode-handlers nil
"Alist of functions to restore non-standard minor modes.
Functions are called by `desktop-create-buffer' to restore minor modes.
List elements must have the form
@@ -970,8 +966,8 @@ It returns t if a desktop file was loaded, nil otherwise."
(and dirs (car dirs)))
;; If not found and `desktop-path' is non-nil, use its first element.
(and desktop-path (car desktop-path))
- ;; Default: Home directory.
- "~"))))
+ ;; Default: .emacs.d.
+ user-emacs-directory))))
(if (file-exists-p (desktop-full-file-name))
;; Desktop file found, but is it already in use?
(let ((desktop-first-buffer nil)
@@ -983,6 +979,7 @@ It returns t if a desktop file was loaded, nil otherwise."
(if (and owner
(memq desktop-load-locked-desktop '(nil ask))
(or (null desktop-load-locked-desktop)
+ (daemonp)
(not (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\n\
Using it may cause conflicts. Use it anyway? " owner)))))
(let ((default-directory desktop-dirname))
@@ -1022,6 +1019,18 @@ Using it may cause conflicts. Use it anyway? " owner)))))
(format ", %d to restore lazily"
(length desktop-buffer-args-list))
""))
+ ;; Bury the *Messages* buffer to not reshow it when burying
+ ;; the buffer we switched to above.
+ (when (buffer-live-p (get-buffer "*Messages*"))
+ (bury-buffer "*Messages*"))
+ ;; Clear all windows' previous and next buffers, these have
+ ;; been corrupted by the `switch-to-buffer' calls in
+ ;; `desktop-restore-file-buffer' (bug#11556). This is a
+ ;; brute force fix and should be replaced by a more subtle
+ ;; strategy eventually.
+ (walk-window-tree (lambda (window)
+ (set-window-prev-buffers window nil)
+ (set-window-next-buffers window nil)))
t))
;; No desktop file found.
(desktop-clear)
@@ -1036,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
@@ -1110,11 +1118,8 @@ directory DIRNAME."
(defun desktop-load-file (function)
"Load the file where auto loaded FUNCTION is defined."
- (when function
- (let ((fcell (and (fboundp function) (symbol-function function))))
- (when (and (listp fcell)
- (eq 'autoload (car fcell)))
- (load (cadr fcell))))))
+ (when (fboundp function)
+ (autoload-do-load (symbol-function function) function)))
;; ----------------------------------------------------------------------------
;; Create a buffer, load its file, set its mode, ...;
@@ -1158,7 +1163,7 @@ directory DIRNAME."
(desktop-load-file desktop-buffer-major-mode)
(let ((buffer-list (buffer-list))
(result
- (condition-case-no-debug err
+ (condition-case-unless-debug err
(funcall (or (cdr (assq desktop-buffer-major-mode
desktop-buffer-mode-handlers))
'desktop-restore-file-buffer)
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 728f08d135d..59849e98c9e 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -1,6 +1,6 @@
;;; dframe --- dedicate frame support modes
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
@@ -157,22 +157,22 @@ selected frame and the focus will change to that frame."
:type 'hook)
(defvar dframe-track-mouse-function nil
- "*A function to call when the mouse is moved in the given frame.
+ "A function to call when the mouse is moved in the given frame.
Typically used to display info about the line under the mouse.")
(make-variable-buffer-local 'dframe-track-mouse-function)
(defvar dframe-help-echo-function nil
- "*A function to call when help-echo is used in newer versions of Emacs.
+ "A function to call when help-echo is used in newer versions of Emacs.
Typically used to display info about the line under the mouse.")
(make-variable-buffer-local 'dframe-help-echo-function)
(defvar dframe-mouse-click-function nil
- "*A function to call when the mouse is clicked.
+ "A function to call when the mouse is clicked.
Valid clicks are mouse 2, our double mouse 1.")
(make-variable-buffer-local 'dframe-mouse-click-function)
(defvar dframe-mouse-position-function nil
- "*A function to call to position the cursor for a mouse click.")
+ "A function to call to position the cursor for a mouse click.")
(make-variable-buffer-local 'dframe-mouse-position-function)
(defvar dframe-power-click nil
@@ -516,7 +516,7 @@ LOCATION can be one of 'random, 'left-right, or 'top-bottom."
(defun dframe-needed-height (&optional frame)
"The needed height for the tool bar FRAME (in characters)."
(or frame (setq frame (selected-frame)))
- ;; The 1 is the missing modeline/minibuffer
+ ;; The 1 is the missing mode line or minibuffer
(+ 1 (/ (frame-pixel-height frame)
;; This obscure code avoids a byte compiler warning in Emacs.
(let ((f 'face-height))
@@ -969,7 +969,7 @@ broken because of the dedicated frame."
(switch-to-buffer buffer)
(call-interactively 'switch-to-buffer nil nil)))
-;; XEmacs: this can be implemented using modeline keymaps, but there
+;; XEmacs: this can be implemented using mode line keymaps, but there
;; is no use, as we have horizontal scrollbar (as the docstring
;; hints.)
(defun dframe-mouse-hscroll (e)
@@ -987,8 +987,7 @@ mode-line. This is only useful for non-XEmacs."
((> click-col (- (window-width) 5))
(scroll-right 2))
(t (dframe-message
- "Click on the edge of the modeline to scroll left/right")))
- ))
+ "Click on the edge of the mode line to scroll left/right")))))
(provide 'dframe)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 757e814dba1..afa0e32b3af 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1,6 +1,6 @@
;;; dired-aux.el --- less commonly used parts of dired
-;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2011
+;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
@@ -54,29 +54,38 @@ 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'.
-FILE defaults to the file at the mark. (That's the mark set by
-\\[set-mark-command], not by Dired's \\[dired-mark] command.)
-The prompted-for 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'."
+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'.
+
+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))
+ ;; Get the latest existing backup file.
+ (oldf (diff-latest-backup-file current))
;; Get the file at the mark.
- (file-at-mark (if (mark t)
+ (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 the current dir or the mark is active.
- (default (if (and (not (equal file-at-mark current))
+ ;; 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))
- mark-active))
- file-at-mark))
+ default-file))
+ default-file))
(target-dir (if default
(dired-current-directory)
(dired-dwim-target-directory)))
(defaults (dired-dwim-target-defaults (list current) target-dir)))
- (require 'diff)
(list
(minibuffer-with-setup-hook
(lambda ()
@@ -236,16 +245,27 @@ 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): "
": ")))
(new-attribute (dired-mark-read-string prompt nil op-symbol
- arg files default))
+ arg files default
+ (cond ((eq op-symbol 'chown)
+ (system-users))
+ ((eq op-symbol 'chgrp)
+ (system-groups)))))
(operation (concat program " " new-attribute))
failures)
(setq failures
@@ -253,7 +273,10 @@ List has a form of (file-name full-file-name (attribute-list))."
(function dired-check-process)
(append
(list operation program)
- (unless (string-equal new-attribute "")
+ (unless (or (string-equal new-attribute "")
+ ;; Use `eq' instead of `equal'
+ ;; to detect empty input (bug#12399).
+ (eq new-attribute default))
(if (eq op-symbol 'touch)
(list "-t" new-attribute)
(list new-attribute)))
@@ -269,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)
@@ -287,7 +314,10 @@ Symbolic modes like `g+w' are allowed."
"Change mode of %s to: "
nil 'chmod arg files default))
num-modes)
- (cond ((equal modes "")
+ (cond ((or (equal modes "")
+ ;; Use `eq' instead of `equal'
+ ;; to detect empty input (bug#12399).
+ (eq modes default))
;; We used to treat empty input as DEFAULT, but that is not
;; such a good idea (Bug#9361).
(error "No file mode specified"))
@@ -303,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"))
@@ -311,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"))
@@ -320,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))
@@ -385,23 +421,25 @@ Uses the shell command coming from variables `lpr-command' and
(dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
(defun dired-mark-read-string (prompt initial op-symbol arg files
- &optional default-value)
+ &optional default-value collection)
"Read args for a Dired marked-files command, prompting with PROMPT.
Return the user input (a string).
INITIAL, if non-nil, is the initial minibuffer input.
OP-SYMBOL is an operation symbol (see `dired-no-confirm').
-ARG is normally the prefix argument for the calling command.
-FILES should be a list of file names.
+ARG is normally the prefix argument for the calling command;
+it is passed as the first argument to `dired-mark-prompt'.
+FILES should be a list of marked files' names.
-DEFAULT-VALUE, if non-nil, should be a \"standard\" value or list
-of such values, available via history commands. Note that if the
-user enters empty input, this function returns the empty string,
-not DEFAULT-VALUE."
+Optional arg DEFAULT-VALUE is a default value or list of default
+values, passed as the seventh arg to `completing-read'.
+
+Optional arg COLLECTION is a collection of possible completions,
+passed as the second arg to `completing-read'."
(dired-mark-pop-up nil op-symbol files
- 'read-from-minibuffer
+ 'completing-read
(format prompt (dired-mark-prompt arg files))
- initial nil nil nil default-value))
+ collection nil nil initial nil default-value nil))
;;; Cleaning a directory: flagging some backups for deletion.
@@ -539,8 +577,17 @@ offer a smarter default choice of shell command."
(defun dired-do-async-shell-command (command &optional arg file-list)
"Run a shell command COMMAND on the marked files asynchronously.
-Like `dired-do-shell-command' but if COMMAND doesn't end in ampersand,
-adds `* &' surrounded by whitespace and executes the command asynchronously.
+Like `dired-do-shell-command', but adds `&' at the end of COMMAND
+to execute it asynchronously.
+
+When operating on multiple files, asynchronous commands
+are executed in the background on each file in parallel.
+In shell syntax this means separating the individual commands
+with `&'. However, when COMMAND ends in `;' or `;&' then commands
+are executed in the background on each file sequentially waiting
+for each command to terminate before running the next command.
+In shell syntax this means separating the individual commands with `;'.
+
The output appears in the buffer `*Async Shell Command*'."
(interactive
(let ((files (dired-get-marked-files t current-prefix-arg)))
@@ -549,18 +596,14 @@ The output appears in the buffer `*Async Shell Command*'."
(dired-read-shell-command "& on %s: " current-prefix-arg files)
current-prefix-arg
files)))
- (unless (string-match "[*?][ \t]*\\'" command)
- (setq command (concat command " *")))
(unless (string-match "&[ \t]*\\'" command)
(setq command (concat command " &")))
(dired-do-shell-command command arg file-list))
-;; The in-background argument is only needed in Emacs 18 where
-;; shell-command doesn't understand an appended ampersand `&'.
;;;###autoload
(defun dired-do-shell-command (command &optional arg file-list)
"Run a shell command COMMAND on the marked files.
-If no files are marked or a specific numeric prefix arg is given,
+If no files are marked or a numeric prefix arg is given,
the next ARG files are used. Just \\[universal-argument] means the current file.
The prompt mentions the file(s) or the marker, as appropriate.
@@ -576,10 +619,23 @@ file name added at the end of COMMAND (separated by a space).
`*' and `?' when not surrounded by whitespace have no special
significance for `dired-do-shell-command', and are passed through
-normally to the shell, but you must confirm first. To pass `*' by
-itself to the shell as a wildcard, type `*\"\"'.
+normally to the shell, but you must confirm first.
+
+If you want to use `*' as a shell wildcard with whitespace around
+it, write `*\"\"' in place of just `*'. This is equivalent to just
+`*' in the shell, but avoids Dired's special handling.
-If COMMAND produces output, it goes to a separate buffer.
+If COMMAND ends in `&', `;', or `;&', it is executed in the
+background asynchronously, and the output appears in the buffer
+`*Async Shell Command*'. When operating on multiple files and COMMAND
+ends in `&', the shell command is executed on each file in parallel.
+However, when COMMAND ends in `;' or `;&' then commands are executed
+in the background on each file sequentially waiting for each command
+to terminate before running the next command. You can also use
+`dired-do-async-shell-command' that automatically adds `&'.
+
+Otherwise, COMMAND is executed synchronously, and the output
+appears in the buffer `*Shell Command Output*'.
This feature does not try to redisplay Dired buffers afterward, as
there's no telling what files COMMAND may have changed.
@@ -598,23 +654,20 @@ can be produced by `dired-get-marked-files', for example."
(let ((files (dired-get-marked-files t current-prefix-arg)))
(list
;; Want to give feedback whether this file or marked files are used:
- (dired-read-shell-command (concat "! on "
- "%s: ")
- current-prefix-arg
- files)
+ (dired-read-shell-command "! on %s: " current-prefix-arg files)
current-prefix-arg
files)))
(let* ((on-each (not (string-match dired-star-subst-regexp command)))
- (subst (not (string-match dired-quark-subst-regexp command)))
- (star (not (string-match "\\*" command)))
- (qmark (not (string-match "\\?" command))))
+ (no-subst (not (string-match dired-quark-subst-regexp command)))
+ (star (string-match "\\*" command))
+ (qmark (string-match "\\?" command)))
;; Get confirmation for wildcards that may have been meant
;; to control substitution of a file name or the file name list.
- (if (cond ((not (or on-each subst))
+ (if (cond ((not (or on-each no-subst))
(error "You can not combine `*' and `?' substitution marks"))
- ((and star (not on-each))
+ ((and star on-each)
(y-or-n-p "Confirm--do you mean to use `*' as a wildcard? "))
- ((and qmark (not subst))
+ ((and qmark no-subst)
(y-or-n-p "Confirm--do you mean to use `?' as a wildcard? "))
(t))
(if on-each
@@ -645,23 +698,34 @@ can be produced by `dired-get-marked-files', for example."
;; Might be redefined for smarter things and could then use RAW-ARG
;; (coming from interactive P and currently ignored) to decide what to do.
;; Smart would be a way to access basename or extension of file names.
- (let ((stuff-it
- (if (or (string-match dired-star-subst-regexp command)
- (string-match dired-quark-subst-regexp command))
- (lambda (x)
- (let ((retval command))
- (while (string-match
- "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval)
- (setq retval (replace-match x t t retval 2)))
- retval))
- (lambda (x) (concat command dired-mark-separator x)))))
- (if on-each
- (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";")
- (let ((files (mapconcat 'shell-quote-argument
- file-list dired-mark-separator)))
- (if (> (length file-list) 1)
- (setq files (concat dired-mark-prefix files dired-mark-postfix)))
- (funcall stuff-it files)))))
+ (let* ((in-background (string-match "[ \t]*&[ \t]*\\'" command))
+ (command (if in-background
+ (substring command 0 (match-beginning 0))
+ command))
+ (sequentially (string-match "[ \t]*;[ \t]*\\'" command))
+ (command (if sequentially
+ (substring command 0 (match-beginning 0))
+ command))
+ (stuff-it
+ (if (or (string-match dired-star-subst-regexp command)
+ (string-match dired-quark-subst-regexp command))
+ (lambda (x)
+ (let ((retval command))
+ (while (string-match
+ "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval)
+ (setq retval (replace-match x t t retval 2)))
+ retval))
+ (lambda (x) (concat command dired-mark-separator x)))))
+ (concat
+ (if on-each
+ (mapconcat stuff-it (mapcar 'shell-quote-argument file-list)
+ (if (and in-background (not sequentially)) "&" ";"))
+ (let ((files (mapconcat 'shell-quote-argument
+ file-list dired-mark-separator)))
+ (if (> (length file-list) 1)
+ (setq files (concat dired-mark-prefix files dired-mark-postfix)))
+ (funcall stuff-it files)))
+ (if in-background "&" ""))))
;; This is an extra function so that it can be redefined by ange-ftp.
;;;###autoload
@@ -1261,6 +1325,9 @@ Special value `always' suppresses confirmation."
(defun dired-copy-file-recursive (from to ok-flag &optional
preserve-time top recursive)
+ (when (and (eq t (car (file-attributes from)))
+ (file-in-directory-p to from))
+ (error "Cannot copy `%s' into its subdirectory `%s'" from to))
(let ((attrs (file-attributes from)))
(if (and recursive
(eq t (car attrs))
@@ -1395,9 +1462,9 @@ NAME-CONSTRUCTOR should be a function accepting a single
argument, the name of an old file, and returning either the
corresponding new file name or nil to skip.
-Optional MARKER-CHAR is a character with which to mark every
-newfile's entry, or t to use the current marker character if the
-old file was marked."
+If optional argument MARKER-CHAR is non-nil, mark each
+newly-created file's Dired entry with the character MARKER-CHAR,
+or with the current marker character if MARKER-CHAR is t."
(let (dired-create-files-failures failures
skipped (success-count 0) (total (length fn-list)))
(let (to overwrite-query
@@ -1427,10 +1494,32 @@ ESC or `q' to not overwrite any of the remaining files,
(cond ((integerp marker-char) marker-char)
(marker-char (dired-file-marker from)) ; slow
(t nil))))
- (when (and (file-directory-p from)
- (file-directory-p to)
- (eq file-creator 'dired-copy-file))
- (setq to (file-name-directory to)))
+ ;; Handle the `dired-copy-file' file-creator specially
+ ;; When copying a directory to another directory or
+ ;; possibly to itself or one of its subdirectories.
+ ;; e.g "~/foo/" => "~/test/"
+ ;; or "~/foo/" =>"~/foo/"
+ ;; or "~/foo/ => ~/foo/bar/")
+ ;; In this case the 'name-constructor' have set the destination
+ ;; TO to "~/test/foo" because the old emacs23 behavior
+ ;; of `copy-directory' was to not create the subdirectory
+ ;; and instead copy the contents.
+ ;; With the new behavior of `copy-directory'
+ ;; (similar to the `cp' shell command) we don't
+ ;; need such a construction of the target directory,
+ ;; so modify the destination TO to "~/test/" instead of "~/test/foo/".
+ (let ((destname (file-name-directory to)))
+ (when (and (file-directory-p from)
+ (file-directory-p to)
+ (eq file-creator 'dired-copy-file))
+ (setq to destname))
+ ;; If DESTNAME is a subdirectory of FROM, not a symlink,
+ ;; and the method in use is copying, signal an error.
+ (and (eq t (car (file-attributes destname)))
+ (eq file-creator 'dired-copy-file)
+ (file-in-directory-p destname from)
+ (error "Cannot copy `%s' into its subdirectory `%s'"
+ from to)))
(condition-case err
(progn
(funcall file-creator from to dired-overwrite-confirmed)
@@ -1478,10 +1567,11 @@ ESC or `q' to not overwrite any of the remaining files,
&optional marker-char op1
how-to)
"Create a new file for each marked file.
-Prompts user for target, which is a directory in which to create
- the new files. Target may also be a plain file if only one marked
- file exists. The way the default for the target directory is
- computed depends on the value of `dired-dwim-target-directory'.
+Prompt user for a target directory in which to create the new
+ files. The target may also be a non-directory file, if only
+ one file is marked. The initial suggestion for target is the
+ Dired buffer's current directory (or, if `dired-dwim-target' is
+ non-nil, the current directory of a neighboring Dired window).
OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
will determine whether pop-ups are appropriate for this OP-SYMBOL.
FILE-CREATOR and OPERATION as in `dired-create-files'.
@@ -1686,16 +1776,21 @@ See HOW-TO argument for `dired-do-create-files'.")
;;;###autoload
(defun dired-do-copy (&optional arg)
"Copy all marked (or next ARG) files, or copy the current file.
-This normally preserves the last-modified date when copying.
-When operating on just the current file, you specify the new name.
-When operating on multiple or marked files, you specify a directory,
-and new copies of these files are made in that directory
-with the same names that the files currently have. The default
-suggested for the target directory depends on the value of
-`dired-dwim-target', which see.
+When operating on just the current file, prompt for the new name.
+
+When operating on multiple or marked files, prompt for a target
+directory, and make the new copies in that directory, with the
+same names as the original files. The initial suggestion for the
+target directory is the Dired buffer's current directory (or, if
+`dired-dwim-target' is non-nil, the current directory of a
+neighboring Dired window).
-This command copies symbolic links by creating new ones,
-like `cp -d'."
+If `dired-copy-preserve-time' is non-nil, this command preserves
+the modification time of each old file in the copy, similar to
+the \"-p\" option for the \"cp\" shell command.
+
+This command copies symbolic links by creating new ones, similar
+to the \"-d\" option for the \"cp\" shell command."
(interactive "P")
(let ((dired-recursive-copies dired-recursive-copies))
(dired-do-create-files 'copy (function dired-copy-file)
@@ -1961,9 +2056,10 @@ See Info node `(emacs)Subdir switches' for more details."
;;;###autoload
(defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
- "Insert this subdirectory into the same dired buffer.
-If it is already present, overwrites previous entry,
- else inserts it at its natural place (as `ls -lR' would have done).
+ "Insert this subdirectory into the same Dired buffer.
+If it is already present, overwrite the previous entry;
+ otherwise, insert it at its natural place (as `ls -lR' would
+ have done).
With a prefix arg, you may edit the `ls' switches used for this listing.
You can add `R' to the switches to expand the whole tree starting at
this subdirectory.
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 0863cc1abac..1237eef86cf 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -1,6 +1,6 @@
;;; dired-x.el --- extra Dired functionality
-;; Copyright (C) 1993-1994, 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Lawrence R. Dodd <dodd@roebling.poly.edu>
@@ -85,12 +85,12 @@ use \\[customize]."
:set (lambda (sym val)
(if (set sym val)
(progn
- (define-key global-map "\C-x\C-j" 'dired-jump)
- (define-key global-map "\C-x4\C-j" 'dired-jump-other-window))
- (if (eq 'dired-jump (lookup-key global-map "\C-x\C-j"))
- (define-key global-map "\C-x\C-j" nil))
- (if (eq 'dired-jump-other-window (lookup-key global-map "\C-x4\C-j"))
- (define-key global-map "\C-x4\C-j" nil))))
+ (define-key ctl-x-map "\C-j" 'dired-jump)
+ (define-key ctl-x-4-map "\C-j" 'dired-jump-other-window))
+ (if (eq 'dired-jump (lookup-key ctl-x-map "\C-j"))
+ (define-key ctl-x-map "\C-j" nil))
+ (if (eq 'dired-jump-other-window (lookup-key ctl-x-4-map "\C-j"))
+ (define-key ctl-x-4-map "\C-j" nil))))
:group 'dired-keys)
(defcustom dired-bind-man t
@@ -132,6 +132,8 @@ If nil, there is no maximum size."
:type '(choice (const :tag "no maximum" nil) integer)
:group 'dired-x)
+;; For backward compatibility
+(define-obsolete-variable-alias 'dired-omit-files-p 'dired-omit-mode "22.1")
(define-minor-mode dired-omit-mode
"Toggle omission of uninteresting files in Dired (Dired-Omit mode).
With a prefix argument ARG, enable Dired-Omit mode if ARG is
@@ -157,9 +159,6 @@ See Info node `(dired-x) Omitting Variables' for more information."
(put 'dired-omit-mode 'safe-local-variable 'booleanp)
-;; For backward compatibility
-(define-obsolete-variable-alias 'dired-omit-files-p 'dired-omit-mode "22.1")
-
(defcustom dired-omit-files "^\\.?#\\|^\\.$\\|^\\.\\.$"
"Filenames matching this regexp will not be displayed.
This only has effect when `dired-omit-mode' is t. See interactive function
@@ -172,6 +171,7 @@ files and lock files."
(defcustom dired-omit-verbose t
"When non-nil, show messages when omitting files.
When nil, don't show messages."
+ :version "24.1"
:type 'boolean
:group 'dired-x)
@@ -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))
@@ -800,17 +799,15 @@ See also `dired-enable-local-variables'."
(hack-local-variables))
;; Delete this stuff: `eobp' is used to find last subdir by dired.el.
(delete-region opoint (point-max)))
- ;; Make sure that the modeline shows the proper information.
- (dired-sort-set-modeline))))
-
-(make-obsolete 'dired-hack-local-variables
- 'hack-dir-local-variables-non-file-buffer "24.1")
+ ;; Make sure that the mode line shows the proper information.
+ (dired-sort-set-mode-line))))
;; 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.
@@ -963,24 +958,26 @@ replace it with a dir-locals-file `./%s'"
;; FIXME "man ./" does not work with dired-do-shell-command,
;; because there seems to be no way for us to modify the filename,
;; only the command. Hmph. `dired-man' works though.
- (list "\\.\\(?:[0-9]\\|man\\)\\'" '(let ((loc (Man-support-local-filenames)))
- (cond ((eq loc 'man-db) "man -l")
- ((eq loc 'man) "man ./")
- (t
- "cat * | tbl | nroff -man -h"))))
+ (list "\\.\\(?:[0-9]\\|man\\)\\'"
+ '(let ((loc (Man-support-local-filenames)))
+ (cond ((eq loc 'man-db) "man -l")
+ ((eq loc 'man) "man ./")
+ (t
+ "cat * | tbl | nroff -man -h | col -b"))))
(list "\\.\\(?:[0-9]\\|man\\)\\.g?z\\'"
'(let ((loc (Man-support-local-filenames)))
(cond ((eq loc 'man-db)
"man -l")
((eq loc 'man)
"man ./")
- (t "gunzip -qc * | tbl | nroff -man -h")))
+ (t "gunzip -qc * | tbl | nroff -man -h | col -b")))
;; Optional decompression.
'(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q")))
- (list "\\.[0-9]\\.Z\\'" '(let ((loc (Man-support-local-filenames)))
- (cond ((eq loc 'man-db) "man -l")
- ((eq loc 'man) "man ./")
- (t "zcat * | tbl | nroff -man -h")))
+ (list "\\.[0-9]\\.Z\\'"
+ '(let ((loc (Man-support-local-filenames)))
+ (cond ((eq loc 'man-db) "man -l")
+ ((eq loc 'man) "man ./")
+ (t "zcat * | tbl | nroff -man -h | col -b")))
;; Optional conversion to gzip format.
'(concat "znew" (if dired-guess-shell-gzip-quiet " -q")
" " dired-guess-shell-znew-switches))
diff --git a/lisp/dired.el b/lisp/dired.el
index 3a82ebcf504..1d6c667e1dd 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1,6 +1,6 @@
;;; dired.el --- directory-browsing commands -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1992-1997, 2000-2011
+;; Copyright (C) 1985-1986, 1992-1997, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
@@ -34,8 +34,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
;;; Customizable variables
(defgroup dired nil
@@ -139,9 +137,12 @@ A value of t means move to first file."
"Controls marking of renamed files.
If t, files keep their previous marks when they are renamed.
If a character, renamed files (whether previously marked or not)
-are afterward marked with that character."
+are afterward marked with that character.
+This option affects only files renamed by `dired-do-rename' and
+`dired-do-rename-regexp'. See `wdired-keep-marker-rename'
+if you want to do the same for files renamed in WDired mode."
:type '(choice (const :tag "Keep" t)
- (character :tag "Mark"))
+ (character :tag "Mark" :value ?R))
:group 'dired-mark)
(defcustom dired-keep-marker-copy ?C
@@ -170,8 +171,9 @@ If a character, new links are unconditionally marked with that character."
(defcustom dired-dwim-target nil
"If non-nil, Dired tries to guess a default target directory.
-This means: if there is a dired buffer displayed in the next window,
-use its current subdir, instead of the current subdir of this dired buffer.
+This means: if there is a Dired buffer displayed in the next
+window, use its current directory, instead of this Dired buffer's
+current directory.
The target is used in the prompt for file copy, rename etc."
:type 'boolean
@@ -249,6 +251,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)
@@ -617,7 +623,7 @@ Don't use that together with FILTER."
(let* ((all-of-them
(save-excursion
(dired-map-over-marks
- (dired-get-filename localp)
+ (dired-get-filename localp 'no-error-if-not-filep)
arg nil distinguish-one-marked)))
result)
(if (not filter)
@@ -670,31 +676,31 @@ Don't use that together with FILTER."
;; (dolist (ext completion-ignored-extensions)
;; (if (eq ?/ (aref ext (1- (length ext)))) (push ext cie)))
;; (setq cie (concat (regexp-opt cie "\\(?:") "\\'"))
-;; (lexical-let* ((default (and buffer-file-name
-;; (abbreviate-file-name buffer-file-name)))
-;; (cie cie)
-;; (completion-table
-;; ;; We need a mix of read-file-name and
-;; ;; read-directory-name so that completion to directories
-;; ;; is preferred, but if the user wants to enter a global
-;; ;; pattern, he can still use completion on filenames to
-;; ;; help him write the pattern.
-;; ;; Essentially, we want to use
-;; ;; (completion-table-with-predicate
-;; ;; 'read-file-name-internal 'file-directory-p nil)
-;; ;; but that doesn't work because read-file-name-internal
-;; ;; does not obey its `predicate' argument.
-;; (completion-table-in-turn
-;; (lambda (str pred action)
-;; (let ((read-file-name-predicate
-;; (lambda (f)
-;; (and (not (member f '("./" "../")))
-;; ;; Hack! Faster than file-directory-p!
-;; (eq (aref f (1- (length f))) ?/)
-;; (not (string-match cie f))))))
-;; (complete-with-action
-;; action 'read-file-name-internal str nil)))
-;; 'read-file-name-internal)))
+;; (let* ((default (and buffer-file-name
+;; (abbreviate-file-name buffer-file-name)))
+;; (cie cie)
+;; (completion-table
+;; ;; We need a mix of read-file-name and
+;; ;; read-directory-name so that completion to directories
+;; ;; is preferred, but if the user wants to enter a global
+;; ;; pattern, he can still use completion on filenames to
+;; ;; help him write the pattern.
+;; ;; Essentially, we want to use
+;; ;; (completion-table-with-predicate
+;; ;; 'read-file-name-internal 'file-directory-p nil)
+;; ;; but that doesn't work because read-file-name-internal
+;; ;; does not obey its `predicate' argument.
+;; (completion-table-in-turn
+;; (lambda (str pred action)
+;; (let ((read-file-name-predicate
+;; (lambda (f)
+;; (and (not (member f '("./" "../")))
+;; ;; Hack! Faster than file-directory-p!
+;; (eq (aref f (1- (length f))) ?/)
+;; (not (string-match cie f))))))
+;; (complete-with-action
+;; action 'read-file-name-internal str nil)))
+;; 'read-file-name-internal)))
;; (minibuffer-with-setup-hook
;; (lambda ()
;; (setq minibuffer-default default)
@@ -1111,6 +1117,11 @@ BEG..END is the line where the file info is located."
(defvar ls-lisp-use-insert-directory-program)
+(defun dired-switches-escape-p (switches)
+ "Return non-nil if the string SWITCHES contains -b or --escape."
+ ;; Do not match things like "--block-size" that happen to contain "b".
+ (string-match "\\(\\`\\| \\)-[[:alnum:]]*b\\|--escape\\>" switches))
+
(defun dired-insert-directory (dir switches &optional file-list wildcard hdr)
"Insert a directory listing of DIR, Dired style.
Use SWITCHES to make the listings.
@@ -1152,7 +1163,7 @@ see `dired-use-ls-dired' for more details.")
(dired-align-file beg (point))))
(insert-directory dir switches wildcard (not wildcard)))
;; Quote certain characters, unless ls quoted them for us.
- (if (not (string-match "b" dired-actual-switches))
+ (if (not (dired-switches-escape-p dired-actual-switches))
(save-excursion
(setq end (point-marker))
(goto-char opoint)
@@ -1167,7 +1178,22 @@ see `dired-use-ls-dired' for more details.")
"\\015"
(text-properties-at (match-beginning 0)))
nil t))
- (set-marker end nil)))
+ (set-marker end nil))
+ ;; Replace any newlines in DIR with literal "\n"s, for the sake
+ ;; of the header line. To disambiguate a literal "\n" in the
+ ;; actual dirname, we also replace "\" with "\\".
+ ;; Personally, I think this should always be done, irrespective
+ ;; of the value of dired-actual-switches, because:
+ ;; i) Dired simply does not work with an unescaped newline in
+ ;; the directory name used in the header (bug=10469#28), and
+ ;; ii) "\" is always replaced with "\\" in the listing, so doing
+ ;; it in the header as well makes things consistent.
+ ;; But at present it is only done if "-b" is in ls-switches,
+ ;; because newlines in dirnames are uncommon, and people may
+ ;; have gotten used to seeing unescaped "\" in the headers.
+ ;; Note: adjust dired-build-subdir-alist if you change this.
+ (setq dir (replace-regexp-in-string "\\\\" "\\\\" dir nil t)
+ dir (replace-regexp-in-string "\n" "\\n" dir nil t)))
(dired-insert-set-properties opoint (point))
;; If we used --dired and it worked, the lines are already indented.
;; Otherwise, indent them.
@@ -1312,16 +1338,16 @@ DIRED-FILENAME WINDOW-POINT)."
"Mark all files remembered in ALIST.
Each element of ALIST looks like (FILE . MARKERCHAR)."
(let (elt fil chr)
- (while alist
- (setq elt (car alist)
- alist (cdr alist)
- fil (car elt)
- chr (cdr elt))
- (if (dired-goto-file fil)
- (save-excursion
- (beginning-of-line)
- (delete-char 1)
- (insert chr))))))
+ (save-excursion
+ (while alist
+ (setq elt (car alist)
+ alist (cdr alist)
+ fil (car elt)
+ chr (cdr elt))
+ (when (dired-goto-file fil)
+ (beginning-of-line)
+ (delete-char 1)
+ (insert chr))))))
(defun dired-remember-hidden ()
"Return a list of names of subdirs currently hidden."
@@ -1391,7 +1417,6 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(define-key map "&" 'dired-do-async-shell-command)
;; Comparison commands
(define-key map "=" 'dired-diff)
- (define-key map "\M-=" 'dired-backup-diff)
;; Tree Dired commands
(define-key map "\M-\C-?" 'dired-unmark-all-files)
(define-key map "\M-\C-d" 'dired-tree-down)
@@ -1475,6 +1500,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)
@@ -1720,7 +1747,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(define-key map
[menu-bar operate epa-dired-do-decrypt]
- '(menu-item "Decrypt" epa-dired-do-decrypt
+ '(menu-item "Decrypt..." epa-dired-do-decrypt
:help "Decrypt file at cursor"))
(define-key map
@@ -1730,12 +1757,12 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(define-key map
[menu-bar operate epa-dired-do-sign]
- '(menu-item "Sign" epa-dired-do-sign
+ '(menu-item "Sign..." epa-dired-do-sign
:help "Create digital signature of file at cursor"))
(define-key map
[menu-bar operate epa-dired-do-encrypt]
- '(menu-item "Encrypt" epa-dired-do-encrypt
+ '(menu-item "Encrypt..." epa-dired-do-encrypt
:help "Encrypt file at cursor"))
(define-key map [menu-bar operate dashes-3]
@@ -1857,7 +1884,6 @@ for more info):
`dired-listing-switches'
`dired-trivial-filenames'
- `dired-shrink-to-fit'
`dired-marker-char'
`dired-del-marker'
`dired-keep-marker-rename'
@@ -1937,14 +1963,14 @@ You can use it to recover marks, killed lines or subdirs."
Actual changes in files cannot be undone by Emacs."))
(defun dired-toggle-read-only ()
- "Edit dired buffer with Wdired, or set it read-only.
-Call `wdired-change-to-wdired-mode' in dired buffers whose editing is
-supported by Wdired (the major mode of the dired buffer is `dired-mode').
-Otherwise, for buffers inheriting from dired-mode, call `toggle-read-only'."
+ "Edit Dired buffer with Wdired, or make it read-only.
+If the current buffer can be edited with Wdired, (i.e. the major
+mode is `dired-mode'), call `wdired-change-to-wdired-mode'.
+Otherwise, call `toggle-read-only'."
(interactive)
- (if (eq major-mode 'dired-mode)
+ (if (derived-mode-p 'dired-mode)
(wdired-change-to-wdired-mode)
- (toggle-read-only)))
+ (read-only-mode 'toggle)))
(defun dired-next-line (arg)
"Move down lines then position at filename.
@@ -2099,7 +2125,18 @@ Otherwise, an error occurs in these cases."
;; with quotation marks in their names.
(while (string-match "\\(?:[^\\]\\|\\`\\)\\(\"\\)" file)
(setq file (replace-match "\\\"" nil t file 1)))
-
+ ;; Unescape any spaces escaped by ls -b (bug#10469).
+ ;; Other -b quotes, eg \t, \n, work transparently.
+ (if (dired-switches-escape-p dired-actual-switches)
+ (let ((start 0)
+ (rep "")
+ (shift -1))
+ (if (eq localp 'verbatim)
+ (setq rep "\\\\"
+ shift +1))
+ (while (string-match "\\(\\\\\\) " file start)
+ (setq file (replace-match rep nil t file 1)
+ start (+ shift (match-end 0))))))
(when (eq system-type 'windows-nt)
(save-match-data
(let ((start 0))
@@ -2107,6 +2144,7 @@ Otherwise, an error occurs in these cases."
(aset file (match-beginning 0) ?/)
(setq start (match-end 0))))))
+ ;; Hence we don't need to worry about converting `\\' back to `\'.
(setq file (read (concat "\"" file "\"")))
;; The above `read' will return a unibyte string if FILE
;; contains eight-bit-control/graphic characters.
@@ -2176,10 +2214,11 @@ Optional arg GLOBAL means to replace all matches."
;; dired-get-filename.
(concat (or dir default-directory) file))
-(defun dired-make-relative (file &optional dir _ignore)
+(defun dired-make-relative (file &optional dir)
"Convert FILE (an absolute file name) to a name relative to DIR.
-If this is impossible, return FILE unchanged.
-DIR must be a directory name, not a file name."
+If DIR is omitted or nil, it defaults to `default-directory'.
+If FILE is not in the directory tree of DIR, return FILE
+unchanged."
(or dir (setq dir default-directory))
;; This case comes into play if default-directory is set to
;; use ~.
@@ -2187,8 +2226,6 @@ DIR must be a directory name, not a file name."
(setq dir (expand-file-name dir)))
(if (string-match (concat "^" (regexp-quote dir)) file)
(substring file (match-end 0))
-;;; (or no-error
-;;; (error "%s: not in directory tree growing at %s" file dir))
file))
;;; Functions for finding the file name in a dired buffer line.
@@ -2434,8 +2471,6 @@ You can then feed the file name(s) to other commands with \\[yank]."
dired-subdir-alist))))
cur-dir))))
-;(defun dired-get-subdir-min (elt)
-; (cdr elt))
;; can't use macro, must be redefinable for other alist format in dired-nstd.
(defalias 'dired-get-subdir-min 'cdr)
@@ -2524,12 +2559,31 @@ instead of `dired-actual-switches'."
(delete-region (point) (match-end 1))
(insert new-dir-name))
(setq count (1+ count))
+ ;; Undo any escaping of newlines and \ by dired-insert-directory.
+ ;; Convert "n" preceded by odd number of \ to newline, and \\ to \.
+ (when (and (dired-switches-escape-p switches)
+ (string-match-p "\\\\" new-dir-name))
+ (let (temp res)
+ (mapc (lambda (char)
+ (cond ((equal char ?\\)
+ (if temp
+ (setq res (concat res "\\")
+ temp nil)
+ (setq temp "\\")))
+ ((and temp (equal char ?n))
+ (setq res (concat res "\n")
+ temp nil))
+ (t
+ (setq res (concat res temp (char-to-string char))
+ temp nil))))
+ new-dir-name)
+ (setq new-dir-name res)))
(dired-alist-add-1 new-dir-name
- ;; Place a sub directory boundary between lines.
- (save-excursion
- (goto-char (match-beginning 0))
- (beginning-of-line)
- (point-marker)))))
+ ;; Place a sub directory boundary between lines.
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (beginning-of-line)
+ (point-marker)))))
(if (and (> count 1) (called-interactively-p 'interactive))
(message "Buffer includes %d directories" count)))
;; We don't need to sort it because it is in buffer order per
@@ -2571,44 +2625,61 @@ instead of `dired-actual-switches'."
(read-file-name "Goto file: "
(dired-current-directory))))
(push-mark)))
- (setq file (directory-file-name file)) ; does no harm if no directory
- (let (found case-fold-search dir)
- (setq dir (or (file-name-directory file)
- (error "File name `%s' is not absolute" file)))
- (save-excursion
- ;; The hair here is to get the result of dired-goto-subdir
- ;; without really calling it if we don't have any subdirs.
- (if (if (string= dir (expand-file-name default-directory))
- (goto-char (point-min))
- (and (cdr dired-subdir-alist)
- (dired-goto-subdir dir)))
- (let ((base (file-name-nondirectory file))
- search-string
- (boundary (dired-subdir-max)))
- (setq search-string
- (replace-regexp-in-string "\^m" "\\^m" base nil t))
- (setq search-string
- (replace-regexp-in-string "\\\\" "\\\\" search-string nil t))
- (while (and (not found)
- ;; filenames are preceded by SPC, this makes
- ;; the search faster (e.g. for the filename "-"!).
- (search-forward (concat " " search-string)
- boundary 'move))
- ;; Match could have BASE just as initial substring or
- ;; or in permission bits or date or
- ;; not be a proper filename at all:
- (if (equal base (dired-get-filename 'no-dir t))
- ;; Must move to filename since an (actually
- ;; correct) match could have been elsewhere on the
- ;; ;; line (e.g. "-" would match somewhere in the
- ;; permission bits).
- (setq found (dired-move-to-filename))
- ;; If this isn't the right line, move forward to avoid
- ;; trying this line again.
- (forward-line 1))))))
- (and found
- ;; return value of point (i.e., FOUND):
- (goto-char found))))
+ (unless (file-name-absolute-p file)
+ (error "File name `%s' is not absolute" file))
+ (setq file (directory-file-name file)) ; does no harm if not a directory
+ (let* ((case-fold-search nil)
+ (dir (file-name-directory file))
+ (found (or
+ ;; First, look for a listing under the absolute name.
+ (save-excursion
+ (goto-char (point-min))
+ (dired-goto-file-1 file file (point-max)))
+ ;; Otherwise, look for it as a relative name. The
+ ;; hair is to get the result of `dired-goto-subdir'
+ ;; without calling it if we don't have any subdirs.
+ (save-excursion
+ (when (if (string= dir (expand-file-name default-directory))
+ (goto-char (point-min))
+ (and (cdr dired-subdir-alist)
+ (dired-goto-subdir dir)))
+ (dired-goto-file-1 (file-name-nondirectory file)
+ file
+ (dired-subdir-max)))))))
+ ;; Return buffer position, if found.
+ (if found
+ (goto-char found))))
+
+(defun dired-goto-file-1 (file full-name limit)
+ "Advance to the Dired listing labeled by FILE; return its position.
+Return nil if the listing is not found. If FILE contains
+characters that would not appear in a Dired buffer, search using
+the quoted forms of those characters.
+
+FULL-NAME specifies the actual file name the listing must have,
+as returned by `dired-get-filename'. LIMIT is the search limit."
+ (let (str)
+ (setq str (replace-regexp-in-string "\^m" "\\^m" file nil t))
+ (setq str (replace-regexp-in-string "\\\\" "\\\\" str nil t))
+ (and (dired-switches-escape-p dired-actual-switches)
+ (string-match "[ \t\n]" str)
+ ;; FIXME: to fix this for embedded control characters etc, we
+ ;; should escape everything that `ls -b' does.
+ (setq str (replace-regexp-in-string " " "\\ " str nil t)
+ str (replace-regexp-in-string "\t" "\\t" str nil t)
+ str (replace-regexp-in-string "\n" "\\n" str nil t)))
+ (let ((found nil)
+ ;; filenames are preceded by SPC, this makes the search faster
+ ;; (e.g. for the filename "-").
+ (search-string (concat " " str)))
+ (while (and (not found)
+ (search-forward search-string limit 'move))
+ ;; Check that we are in the right place. Match could have
+ ;; BASE just as initial substring or in permission bits etc.
+ (if (equal full-name (dired-get-filename nil t))
+ (setq found (dired-move-to-filename))
+ (forward-line 1)))
+ found)))
(defvar dired-find-subdir)
@@ -2661,12 +2732,14 @@ Optional argument means return a file name relative to `default-directory'."
;; Deleting files
(defcustom dired-recursive-deletes 'top
- "Decide whether recursive deletes are allowed.
-A value of nil means no recursive deletes.
-`always' means delete recursively without asking. This is DANGEROUS!
-`top' means ask for each directory at top level, but delete its subdirectories
-without asking.
-Anything else means ask for each directory."
+ "Whether Dired deletes directories recursively.
+If nil, Dired will not delete non-empty directories.
+`always' means to delete non-empty directories recursively,
+without asking. This is dangerous!
+`top' means to ask for each top-level directory specified by the
+Dired deletion command, and delete its subdirectories without
+asking.
+Any other value means to ask for each directory."
:type '(choice :tag "Delete non-empty directories"
(const :tag "Yes" always)
(const :tag "No--only delete empty directories" nil)
@@ -2873,6 +2946,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))
@@ -2884,6 +2958,8 @@ or \"* [3 files]\"."
(split-window-sensibly window))))
pop-up-frames)
(pop-to-buffer (get-buffer-create buf)))
+ ;; See Bug#12281.
+ (set-window-start nil (point-min))
;; If dired-shrink-to-fit is t, make its window fit its contents.
(when dired-shrink-to-fit
;; Try to not delete window when we want to display less than
@@ -2905,36 +2981,49 @@ If t, confirmation is never needed."
(const shell) (const symlink) (const touch)
(const uncompress))))
-(defun dired-mark-pop-up (bufname op-symbol files function &rest args)
+(defun dired-mark-pop-up (buffer-or-name op-symbol files function &rest args)
"Return FUNCTION's result on ARGS after showing which files are marked.
-Displays the file names in a buffer named BUFNAME;
- nil gives \" *Marked Files*\".
-This uses function `dired-pop-to-buffer' to do that.
-
-FUNCTION should not manipulate files, just read input
- (an argument or confirmation).
-The window is not shown if there is just one file or
- OP-SYMBOL is a member of the list in `dired-no-confirm'.
+Displays the file names in a window showing a buffer named
+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."
- (or bufname (setq bufname " *Marked Files*"))
+just the current file.
+
+FUNCTION should not manipulate files, just read input \(an
+argument or confirmation)."
(if (or (eq dired-no-confirm t)
(memq op-symbol dired-no-confirm)
;; If FILES defaulted to the current line's file.
(= (length files) 1))
(apply function args)
- (with-current-buffer (get-buffer-create bufname)
- (erase-buffer)
- ;; Handle (t FILE) just like (FILE), here.
- ;; That value is used (only in some cases), to mean
- ;; just one file that was marked, rather than the current line file.
- (dired-format-columns-of-files (if (eq (car files) t) (cdr files) files))
- (remove-text-properties (point-min) (point-max)
- '(mouse-face nil help-echo nil)))
- (save-window-excursion
- (dired-pop-to-buffer bufname)
- (apply function args))))
+ (let ((buffer (get-buffer-create (or buffer-or-name " *Marked Files*"))))
+ (with-current-buffer buffer
+ (let ((split-height-threshold 0))
+ (with-temp-buffer-window
+ buffer
+ (cons 'display-buffer-below-selected
+ '((window-height . fit-window-to-buffer)))
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (apply function args)
+ (when (window-live-p window)
+ (quit-restore-window window 'kill)))))
+ ;; Handle (t FILE) just like (FILE), here. That value is
+ ;; used (only in some cases), to mean just one file that was
+ ;; marked, rather than the current line file.
+ (dired-format-columns-of-files
+ (if (eq (car files) t) (cdr files) files))
+ (remove-text-properties (point-min) (point-max)
+ '(mouse-face nil help-echo nil))))))))
(defun dired-format-columns-of-files (files)
(let ((beg (point)))
@@ -3020,41 +3109,66 @@ just the current file."
(insert dired-marker-char)))
(forward-line 1))))
-(defun dired-mark (arg)
- "Mark the current (or next ARG) files.
+(defun dired-mark (arg &optional interactive)
+ "Mark the file at point in the Dired buffer.
+If the region is active, mark all files in the region.
+Otherwise, with a prefix arg, mark files on the next ARG lines.
+
If on a subdir headerline, mark all its files except `.' and `..'.
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))
+ (interactive (list current-prefix-arg t))
+ (cond
+ ;; Mark files in the active region.
+ ((and interactive (use-region-p))
+ (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 `..'."
- (interactive "P")
+(defun dired-unmark (arg &optional interactive)
+ "Unmark the file at point in the Dired buffer.
+If the region is active, unmark all files in the region.
+Otherwise, with a prefix arg, unmark files on the next ARG lines.
+
+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 (list current-prefix-arg t))
(let ((dired-marker-char ?\040))
- (dired-mark arg)))
+ (dired-mark arg interactive)))
-(defun dired-flag-file-deletion (arg)
+(defun dired-flag-file-deletion (arg &optional interactive)
"In Dired, flag the current line's file for deletion.
-With prefix arg, repeat over several lines.
+If the region is active, flag all files in the region.
+Otherwise, with a prefix arg, flag files on the next ARG lines.
-If on a subdir headerline, mark all its files except `.' and `..'."
- (interactive "P")
+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 (list current-prefix-arg t))
(let ((dired-marker-char dired-del-marker))
- (dired-mark arg)))
+ (dired-mark arg interactive)))
(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)))
@@ -3085,8 +3199,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.
@@ -3103,8 +3217,8 @@ object files--just `.o' will mark more than you might think."
(dired-mark-if
(and (not (looking-at dired-re-dot))
(not (eolp)) ; empty line
- (let ((fn (dired-get-filename nil t)))
- (and fn (string-match regexp (file-name-nondirectory fn)))))
+ (let ((fn (dired-get-filename t t)))
+ (and fn (string-match regexp fn))))
"matching file")))
(defun dired-mark-files-containing-regexp (regexp &optional marker-char)
@@ -3391,9 +3505,9 @@ format, use `\\[universal-argument] \\[dired]'.")
"Non-nil means the Dired sort command is disabled.
The idea is to set this buffer-locally in special dired buffers.")
-(defun dired-sort-set-modeline ()
- ;; Set modeline display according to dired-actual-switches.
- ;; Modeline display of "by name" or "by date" guarantees the user a
+(defun dired-sort-set-mode-line ()
+ ;; Set mode line display according to dired-actual-switches.
+ ;; Mode line display of "by name" or "by date" guarantees the user a
;; match with the corresponding regexps. Non-matching switches are
;; shown literally.
(when (eq major-mode 'dired-mode)
@@ -3409,6 +3523,9 @@ The idea is to set this buffer-locally in special dired buffers.")
(concat "Dired " dired-actual-switches)))))
(force-mode-line-update)))
+(define-obsolete-function-alias 'dired-sort-set-modeline
+ 'dired-sort-set-mode-line "24.3")
+
(defun dired-sort-toggle-or-edit (&optional arg)
"Toggle sorting by date, and refresh the Dired buffer.
With a prefix argument, edit the current listing switches instead."
@@ -3438,9 +3555,16 @@ With a prefix argument, edit the current listing switches instead."
(setq dired-actual-switches
(replace-match "" t t dired-actual-switches 3))))
;; Now, if we weren't sorting by date before, add the -t switch.
+ ;; Some simple-minded ls implementations (eg ftp servers) only
+ ;; allow a single option string, so try not to add " -t" if possible.
(unless sorting-by-date
- (setq dired-actual-switches (concat dired-actual-switches " -t"))))
- (dired-sort-set-modeline)
+ (setq dired-actual-switches
+ (concat dired-actual-switches
+ (if (string-match-p "\\`-[[:alnum:]]+\\'"
+ dired-actual-switches)
+ "t"
+ " -t")))))
+ (dired-sort-set-mode-line)
(revert-buffer))
;; Some user code loads dired especially for this.
@@ -3463,7 +3587,7 @@ set the minor mode accordingly, others appear literally in the mode line.
With optional second arg NO-REVERT, don't refresh the listing afterwards."
(dired-sort-R-check switches)
(setq dired-actual-switches switches)
- (dired-sort-set-modeline)
+ (dired-sort-set-mode-line)
(or no-revert (revert-buffer)))
(defvar dired-subdir-alist-pre-R nil
@@ -3505,11 +3629,11 @@ To be called first in body of `dired-sort-other', etc."
;;;; Drag and drop support
(defcustom dired-recursive-copies 'top
- "Decide whether recursive copies are allowed.
-A value of nil means no recursive copies.
-`always' means copy recursively without asking.
-`top' means ask for each directory at top level.
-Anything else means ask for each directory."
+ "Whether Dired copies directories recursively.
+If nil, never copy recursively.
+`always' means to copy recursively without asking.
+`top' means to ask for each directory at top level.
+Any other value means to ask for each directory."
:type '(choice :tag "Copy directories"
(const :tag "No recursive copies" nil)
(const :tag "Ask for each directory" t)
@@ -3608,6 +3732,7 @@ Ask means pop up a menu for the user to select one of copy, move or link."
;;;; Desktop support
(eval-when-compile (require 'desktop))
+(declare-function desktop-file-name "desktop" (filename dirname))
(defun dired-desktop-buffer-misc-data (dirname)
"Auxiliary information to be saved in desktop file."
@@ -3667,16 +3792,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" "2301de52aab0488c60d2b4841b6f597f")
+;;;;;; 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'.
-FILE defaults to the file at the mark. (That's the mark set by
-\\[set-mark-command], not by Dired's \\[dired-mark] command.)
-The prompted-for 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'.
+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'.
+
+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)
@@ -3720,22 +3851,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)
@@ -3760,15 +3899,24 @@ with a prefix argument.
(autoload 'dired-do-async-shell-command "dired-aux" "\
Run a shell command COMMAND on the marked files asynchronously.
-Like `dired-do-shell-command' but if COMMAND doesn't end in ampersand,
-adds `* &' surrounded by whitespace and executes the command asynchronously.
+Like `dired-do-shell-command', but adds `&' at the end of COMMAND
+to execute it asynchronously.
+
+When operating on multiple files, asynchronous commands
+are executed in the background on each file in parallel.
+In shell syntax this means separating the individual commands
+with `&'. However, when COMMAND ends in `;' or `;&' then commands
+are executed in the background on each file sequentially waiting
+for each command to terminate before running the next command.
+In shell syntax this means separating the individual commands with `;'.
+
The output appears in the buffer `*Async Shell Command*'.
\(fn COMMAND &optional ARG FILE-LIST)" t nil)
(autoload 'dired-do-shell-command "dired-aux" "\
Run a shell command COMMAND on the marked files.
-If no files are marked or a specific numeric prefix arg is given,
+If no files are marked or a numeric prefix arg is given,
the next ARG files are used. Just \\[universal-argument] means the current file.
The prompt mentions the file(s) or the marker, as appropriate.
@@ -3784,10 +3932,23 @@ file name added at the end of COMMAND (separated by a space).
`*' and `?' when not surrounded by whitespace have no special
significance for `dired-do-shell-command', and are passed through
-normally to the shell, but you must confirm first. To pass `*' by
-itself to the shell as a wildcard, type `*\"\"'.
+normally to the shell, but you must confirm first.
+
+If you want to use `*' as a shell wildcard with whitespace around
+it, write `*\"\"' in place of just `*'. This is equivalent to just
+`*' in the shell, but avoids Dired's special handling.
-If COMMAND produces output, it goes to a separate buffer.
+If COMMAND ends in `&', `;', or `;&', it is executed in the
+background asynchronously, and the output appears in the buffer
+`*Async Shell Command*'. When operating on multiple files and COMMAND
+ends in `&', the shell command is executed on each file in parallel.
+However, when COMMAND ends in `;' or `;&' then commands are executed
+in the background on each file sequentially waiting for each command
+to terminate before running the next command. You can also use
+`dired-do-async-shell-command' that automatically adds `&'.
+
+Otherwise, COMMAND is executed synchronously, and the output
+appears in the buffer `*Shell Command Output*'.
This feature does not try to redisplay Dired buffers afterward, as
there's no telling what files COMMAND may have changed.
@@ -3904,16 +4065,21 @@ If DIRECTORY already exists, signal an error.
(autoload 'dired-do-copy "dired-aux" "\
Copy all marked (or next ARG) files, or copy the current file.
-This normally preserves the last-modified date when copying.
-When operating on just the current file, you specify the new name.
-When operating on multiple or marked files, you specify a directory,
-and new copies of these files are made in that directory
-with the same names that the files currently have. The default
-suggested for the target directory depends on the value of
-`dired-dwim-target', which see.
+When operating on just the current file, prompt for the new name.
-This command copies symbolic links by creating new ones,
-like `cp -d'.
+When operating on multiple or marked files, prompt for a target
+directory, and make the new copies in that directory, with the
+same names as the original files. The initial suggestion for the
+target directory is the Dired buffer's current directory (or, if
+`dired-dwim-target' is non-nil, the current directory of a
+neighboring Dired window).
+
+If `dired-copy-preserve-time' is non-nil, this command preserves
+the modification time of each old file in the copy, similar to
+the \"-p\" option for the \"cp\" shell command.
+
+This command copies symbolic links by creating new ones, similar
+to the \"-d\" option for the \"cp\" shell command.
\(fn &optional ARG)" t nil)
@@ -4016,9 +4182,10 @@ See Info node `(emacs)Subdir switches' for more details.
\(fn DIRNAME &optional SWITCHES NO-ERROR-IF-NOT-DIR-P)" t nil)
(autoload 'dired-insert-subdir "dired-aux" "\
-Insert this subdirectory into the same dired buffer.
-If it is already present, overwrites previous entry,
- else inserts it at its natural place (as `ls -lR' would have done).
+Insert this subdirectory into the same Dired buffer.
+If it is already present, overwrite the previous entry;
+ otherwise, insert it at its natural place (as `ls -lR' would
+ have done).
With a prefix arg, you may edit the `ls' switches used for this listing.
You can add `R' to the switches to expand the whole tree starting at
this subdirectory.
@@ -4128,7 +4295,7 @@ instead.
;;;***
;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump)
-;;;;;; "dired-x" "dired-x.el" "a542cdbf155ff79f36331bae217f3b28")
+;;;;;; "dired-x" "dired-x.el" "a4e6844421c2c5e6fde90e959fbcc26f")
;;; Generated autoloads from dired-x.el
(autoload 'dired-jump "dired-x" "\
diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el
index eef8c111da5..a66fc23dec1 100644
--- a/lisp/dirtrack.el
+++ b/lisp/dirtrack.el
@@ -1,6 +1,6 @@
;;; dirtrack.el --- Directory Tracking by watching the prompt
-;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Sun Nov 17 1996
@@ -122,13 +122,11 @@
(defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1)
"List for directory tracking.
First item is a regexp that describes where to find the path in a prompt.
-Second is a number, the regexp group to match. Optional third item is
-whether the prompt is multi-line. If nil or omitted, prompt is assumed to
-be on a single line."
+Second is a number, the regexp group to match."
:group 'dirtrack
:type '(sexp (regexp :tag "Prompt Expression")
- (integer :tag "Regexp Group")
- (boolean :tag "Multiline Prompt")))
+ (integer :tag "Regexp Group"))
+ :version "24.1")
(make-variable-buffer-local 'dirtrack-list)
@@ -181,6 +179,8 @@ and ends with a forward slash."
dir))
+(define-obsolete-function-alias 'dirtrack-toggle 'dirtrack-mode "23.1")
+(define-obsolete-variable-alias 'dirtrackp 'dirtrack-mode "23.1")
;;;###autoload
(define-minor-mode dirtrack-mode
"Toggle directory tracking in shell buffers (Dirtrack mode).
@@ -188,88 +188,95 @@ With a prefix argument ARG, enable Dirtrack mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-This method requires that your shell prompt contain the full
-current working directory at all times, and that `dirtrack-list'
-is set to match the prompt. This is an alternative to
-`shell-dirtrack-mode', which works differently, by tracking `cd'
-and similar commands which change the shell working directory."
+This method requires that your shell prompt contain the current
+working directory at all times, and that you set the variable
+`dirtrack-list' to match the prompt.
+
+This is an alternative to `shell-dirtrack-mode', which works by
+tracking `cd' and similar commands which change the shell working
+directory."
nil nil nil
(if dirtrack-mode
(add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)
(remove-hook 'comint-preoutput-filter-functions 'dirtrack t)))
-(define-obsolete-function-alias 'dirtrack-toggle 'dirtrack-mode "23.1")
-(define-obsolete-variable-alias 'dirtrackp 'dirtrack-mode "23.1")
-
+(define-obsolete-function-alias 'dirtrack-debug-toggle 'dirtrack-debug-mode
+ "23.1")
+(define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1")
(define-minor-mode dirtrack-debug-mode
- "Toggle Dirtrack debugging."
+ "Toggle Dirtrack debugging.
+With a prefix argument ARG, enable Dirtrack debugging if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil."
nil nil nil
(if dirtrack-debug-mode
(display-buffer (get-buffer-create dirtrack-debug-buffer))))
-(define-obsolete-function-alias 'dirtrack-debug-toggle 'dirtrack-debug-mode
- "23.1")
-(define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1")
-
-
-(defun dirtrack-debug-message (string)
- "Insert string at the end of `dirtrack-debug-buffer'."
+(defun dirtrack-debug-message (msg1 msg2)
+ "Insert strings at the end of `dirtrack-debug-buffer'."
(when dirtrack-debug-mode
(with-current-buffer (get-buffer-create dirtrack-debug-buffer)
(goto-char (point-max))
- (insert (concat string "\n")))))
+ (insert msg1 msg2 "\n"))))
+
+(declare-function shell-prefixed-directory-name "shell" (dir))
+(declare-function shell-process-cd "shell" (arg))
;;;###autoload
(defun dirtrack (input)
- "Determine the current directory by scanning the process output for a prompt.
-The prompt to look for is the first item in `dirtrack-list'.
-
-You can toggle directory tracking by using the function `dirtrack-mode'.
-
-If directory tracking does not seem to be working, you can use the
-function `dirtrack-debug-mode' to turn on debugging output."
- (unless (or (null dirtrack-mode)
- (eq (point) (point-min))) ; no output?
- (let (prompt-path orig-prompt-path
- (current-dir default-directory)
- (dirtrack-regexp (nth 0 dirtrack-list))
- (match-num (nth 1 dirtrack-list)))
- ;; Currently unimplemented, it seems. --Stef
- ;; (multi-line (nth 2 dirtrack-list)))
- (save-excursion
- ;; No match
- (if (not (string-match dirtrack-regexp input))
- (dirtrack-debug-message
- (format "Input `%s' failed to match `dirtrack-list'" input))
- (setq prompt-path (match-string match-num input))
- ;; Empty string
- (if (not (> (length prompt-path) 0))
- (dirtrack-debug-message "Match is empty string")
- ;; Transform prompts into canonical forms
- (setq orig-prompt-path (funcall dirtrack-directory-function
- prompt-path)
- prompt-path (shell-prefixed-directory-name orig-prompt-path)
- current-dir (funcall dirtrack-canonicalize-function
- current-dir))
- (dirtrack-debug-message
- (format "Prompt is %s\nCurrent directory is %s"
- prompt-path current-dir))
- ;; Compare them
- (if (or (string= current-dir prompt-path)
- (string= current-dir (abbreviate-file-name prompt-path)))
- (dirtrack-debug-message (format "Not changing directory"))
- ;; It's possible that Emacs will think the directory
- ;; won't exist (eg, rlogin buffers)
- (if (file-accessible-directory-p prompt-path)
- ;; Change directory. shell-process-cd adds the prefix, so we
- ;; need to give it the original (un-prefixed) path.
- (and (shell-process-cd orig-prompt-path)
- (run-hooks 'dirtrack-directory-change-hook)
- (dirtrack-debug-message
- (format "Changing directory to %s" prompt-path)))
- (warn "Directory %s does not exist" prompt-path)))
- )))))
+ "Determine the current directory from the process output for a prompt.
+This filter function is used by `dirtrack-mode'. It looks for
+the prompt specified by `dirtrack-list', and calls
+`shell-process-cd' if the directory seems to have changed away
+from `default-directory'."
+ (when (and dirtrack-mode
+ (not (eq (point) (point-min)))) ; there must be output
+ (save-excursion ; What's this for? -- cyd
+ (if (not (string-match (nth 0 dirtrack-list) input))
+ ;; No match
+ (dirtrack-debug-message
+ "Input failed to match `dirtrack-list': " input)
+ (let ((prompt-path (match-string (nth 1 dirtrack-list) input))
+ temp)
+ (cond
+ ;; Don't do anything for empty string
+ ((string-equal prompt-path "")
+ (dirtrack-debug-message "Prompt match gives empty string: " input))
+ ;; If the prompt contains an absolute file name, call
+ ;; `shell-process-cd' if the directory has changed.
+ ((file-name-absolute-p prompt-path)
+ ;; Transform prompts into canonical forms
+ (let ((orig-prompt-path (funcall dirtrack-directory-function
+ prompt-path))
+ (current-dir (funcall dirtrack-canonicalize-function
+ default-directory)))
+ (setq prompt-path (shell-prefixed-directory-name orig-prompt-path))
+ ;; Compare them
+ (if (or (string-equal current-dir prompt-path)
+ (string-equal (expand-file-name current-dir)
+ (expand-file-name prompt-path)))
+ (dirtrack-debug-message "Not changing directory: " current-dir)
+ ;; It's possible that Emacs thinks the directory
+ ;; doesn't exist (e.g. rlogin buffers)
+ (if (file-accessible-directory-p prompt-path)
+ ;; `shell-process-cd' adds the prefix, so we need
+ ;; to give it the original (un-prefixed) path.
+ (progn
+ (shell-process-cd orig-prompt-path)
+ (run-hooks 'dirtrack-directory-change-hook)
+ (dirtrack-debug-message "Changing directory to "
+ prompt-path))
+ (dirtrack-debug-message "Not changing to non-existent directory: "
+ prompt-path)))))
+ ;; If the file name is non-absolute, try and see if it
+ ;; seems to be up or down from where we were.
+ ((string-match "\\`\\(.*\\)\\(?:/.*\\)?\n\\(.*/\\)\\1\\(?:/.*\\)?\\'"
+ (setq temp
+ (concat prompt-path "\n" default-directory)))
+ (shell-process-cd (concat (match-string 2 temp)
+ prompt-path))
+ (run-hooks 'dirtrack-directory-change-hook)))))))
input)
(provide 'dirtrack)
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 3befedac256..a900ab2f966 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -1,6 +1,6 @@
;;; disp-table.el --- functions for dealing with char tables
-;; Copyright (C) 1987, 1994-1995, 1999, 2001-2011
+;; Copyright (C) 1987, 1994-1995, 1999, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Erik Naggum <erik@naggum.no>
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 2d0c6fc31cd..0c33feab1b7 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -1,6 +1,6 @@
;;; dnd.el --- drag and drop support. -*- coding: utf-8 -*-
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;; Author: Jan Djärv <jan.h.d@swipnet.se>
;; Maintainer: FSF
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 7e4329234e3..f8975a57b7b 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -1,10 +1,10 @@
;;; doc-view.el --- View PDF/PostScript/DVI files in Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; 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).
@@ -133,7 +137,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'dired)
(require 'image-mode)
(require 'jka-compr)
@@ -172,6 +176,7 @@ Higher values result in larger images."
(defcustom doc-view-image-width 850
"Default image width.
Has only an effect if imagemagick support is compiled into emacs."
+ :version "24.1"
:type 'number
:group 'doc-view)
@@ -201,6 +206,7 @@ If this and `doc-view-dvipdfm-program' are set,
"Program to convert any file type readable by OpenOffice.org to PDF.
Needed for viewing OpenOffice.org (and MS Office) files."
+ :version "24.1"
:type 'file
:group 'doc-view)
@@ -249,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
- (assert (eq (overlay-buffer ol) (current-buffer)))
- (setq ol (copy-overlay ol)))
- (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
@@ -338,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)
@@ -379,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]
"---"
@@ -552,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)
@@ -655,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."
@@ -735,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)
@@ -754,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)
@@ -887,33 +904,33 @@ 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)
- (case doc-view-doc-type
- (pdf
+ (pcase doc-view-doc-type
+ (`pdf
;; Doc is a PDF, so convert it to TXT
(doc-view-pdf->txt doc-view-buffer-file-name txt callback))
- (ps
+ (`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
+ (`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))
- (odf
+ (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))
- (t (error "DocView doesn't know what to do"))))
+ (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)
"Convert PS to PDF asynchronously and call CALLBACK when finished."
@@ -948,23 +965,21 @@ Those files are saved in the directory given by the function
(let ((png-file (expand-file-name "page-%d.png"
(doc-view-current-cache-dir))))
(make-directory (doc-view-current-cache-dir) t)
- (case doc-view-doc-type
- (dvi
+ (pcase doc-view-doc-type
+ (`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
;; ODF files have to be converted to PDF before Ghostscript can
;; process it.
- (lexical-let
- ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir))
- (opdf (expand-file-name (concat (file-name-sans-extension
- (file-name-nondirectory doc-view-buffer-file-name))
- ".pdf")
- doc-view-current-cache-dir))
- (png-file png-file))
+ (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))
+ (png-file png-file))
;; The unoconv tool only supports a output directory, but no
;; file name. It's named like the input file with the
;; extension replaced by pdf.
@@ -973,11 +988,11 @@ Those files are saved in the directory given by the function
;; Rename to doc.pdf
(rename-file opdf pdf)
(doc-view-pdf/ps->png pdf png-file)))))
- (pdf
+ (`pdf
(let ((pages (doc-view-active-pages)))
;; Convert PDF to PNG images starting with the active pages.
(doc-view-pdf->png doc-view-buffer-file-name png-file pages)))
- (t
+ (_
;; Convert to PNG images.
(doc-view-pdf/ps->png doc-view-buffer-file-name png-file)))))
@@ -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
- (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/dos-fns.el b/lisp/dos-fns.el
index 629360b1c18..c317bf84db6 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -1,6 +1,6 @@
;;; dos-fns.el --- MS-Dos specific functions
-;; Copyright (C) 1991, 1993, 1995-1996, 2001-2011
+;; Copyright (C) 1991, 1993, 1995-1996, 2001-2012
;; Free Software Foundation, Inc.
;; Maintainer: Morten Welinder <terra@diku.dk>
@@ -233,15 +233,15 @@ returned unaltered."
(add-hook 'before-init-hook 'dos-reevaluate-defcustoms)
+(define-obsolete-variable-alias
+ 'register-name-alist 'dos-register-name-alist "24.1")
+
(defvar dos-register-name-alist
'((ax . 0) (bx . 1) (cx . 2) (dx . 3) (si . 4) (di . 5)
(cflag . 6) (flags . 7)
(al . (0 . 0)) (bl . (1 . 0)) (cl . (2 . 0)) (dl . (3 . 0))
(ah . (0 . 1)) (bh . (1 . 1)) (ch . (2 . 1)) (dh . (3 . 1))))
-(define-obsolete-variable-alias
- 'register-name-alist 'dos-register-name-alist "24.1")
-
(defun dos-make-register ()
(make-vector 8 0))
diff --git a/lisp/dos-vars.el b/lisp/dos-vars.el
index 7de2ecb75a6..eef871215f4 100644
--- a/lisp/dos-vars.el
+++ b/lisp/dos-vars.el
@@ -1,6 +1,6 @@
;;; dos-vars.el --- MS-Dos specific user options
-;; Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index 5dac6d22722..4839d6b9239 100644
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -1,6 +1,6 @@
;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms
-;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: Geoff Voelker <voelker@cs.washington.edu>
;; Keywords: internal
@@ -38,9 +38,8 @@
(setq null-device "NUL")
;; For distinguishing file types based upon suffixes.
-(defvar file-name-buffer-file-type-alist
- '(
- ("[:/].*config.sys$" . nil) ; config.sys text
+(defcustom file-name-buffer-file-type-alist
+ '(("[:/].*config.sys$" . nil) ; config.sys text
("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|bin\\|ico\\|pif\\|class\\)$" . t)
; MS-Dos stuff
("\\.\\(dll\\|drv\\|386\\|vxd\\|fon\\|fnt\\|fot\\|ttf\\|grp\\)$" . t)
@@ -55,9 +54,12 @@
("\\.tp[ulpw]$" . t) ; borland Pascal stuff
("[:/]tags$" . nil) ; emacs TAGS file
)
- "*Alist for distinguishing text files from binary files.
+ "Alist for distinguishing text files from binary files.
Each element has the form (REGEXP . TYPE), where REGEXP is matched
-against the file name, and TYPE is nil for text, t for binary.")
+against the file name, and TYPE is nil for text, t for binary."
+ :type '(repeat (cons regexp boolean))
+ :group 'dos-fns
+ :group 'w32)
;; Return the pair matching filename on file-name-buffer-file-type-alist,
;; or nil otherwise.
@@ -282,8 +284,11 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
;;; Support for printing under DOS/Windows, see lpr.el and ps-print.el.
-(defvar direct-print-region-use-command-dot-com t
- "*Control whether command.com is used to print on Windows 9x.")
+(defcustom direct-print-region-use-command-dot-com t
+ "If non-nil, use command.com to print on Windows 9x."
+ :type 'boolean
+ :group 'dos-fns
+ :group 'w32)
;; Function to actually send data to the printer port.
;; Supports writing directly, and using various programs.
@@ -356,7 +361,7 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
(apply 'call-process lpr-prog nil errbuf nil rest))
;; Run command.com to access printer port on Windows 9x, unless
;; we are supposed to append to an existing (non-empty) file,
- ;; to work around a bug in Windows 9x that prevents Win32
+ ;; to work around a bug in Windows 9x that prevents Windows
;; programs from accessing LPT ports reliably.
((and (eq system-type 'windows-nt)
(getenv "winbootdir")
diff --git a/lisp/double.el b/lisp/double.el
index 2a845f61942..59e6bb856a6 100644
--- a/lisp/double.el
+++ b/lisp/double.el
@@ -1,6 +1,6 @@
;;; double.el --- support for keyboard remapping with double clicking
-;; Copyright (C) 1994, 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: i18n
diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el
index 167da69d1ca..e967ddce332 100644
--- a/lisp/dynamic-setting.el
+++ b/lisp/dynamic-setting.el
@@ -1,6 +1,6 @@
;;; dynamic-setting.el --- Support dynamic changes
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Jan Djärv <jan.h.d@swipnet.se>
;; Maintainer: FSF
@@ -42,44 +42,28 @@ If DISPLAY-OR-FRAME is a frame, the display is the one for that frame.
If SET-FONT is non-nil, change the font for frames. Otherwise re-apply the
current form for the frame (i.e. hinting or somesuch changed)."
-
(let ((new-font (and (fboundp 'font-get-system-font)
- (font-get-system-font))))
- (when new-font
- ;; Be careful here: when set-face-attribute is called for the
- ;; :font attribute, Emacs tries to guess the best matching font
- ;; by examining the other face attributes (Bug#2476).
-
+ (font-get-system-font)))
+ (frame-list (frames-on-display-list display-or-frame)))
+ (when (and new-font (display-graphic-p display-or-frame))
(clear-font-cache)
- ;; Set for current frames. Only change font for those that have
- ;; the old font now. If they don't have the old font, the user
- ;; probably changed it.
- (dolist (f (frames-on-display-list display-or-frame))
- (if (display-graphic-p f)
- (let* ((frame-font
- (or (font-get (face-attribute 'default :font f
- 'default) :user-spec)
- (frame-parameter f 'font-parameter)))
- (font-to-set
- (if set-font new-font
- ;; else set font again, hinting etc. may have changed.
- frame-font)))
- (if font-to-set
- (progn
- (set-frame-parameter f 'font-parameter font-to-set)
- (set-face-attribute 'default f
- :width 'normal
- :weight 'normal
- :slant 'normal
- :font font-to-set))))))
-
- ;; Set for future frames.
- (set-face-attribute 'default t :font new-font)
- (let ((spec (list (list t (face-attr-construct 'default)))))
- (progn
- (put 'default 'customized-face spec)
- (custom-push-theme 'theme-face 'default 'user 'set spec)
- (put 'default 'face-modified nil))))))
+ (if set-font
+ ;; Set the font on all current and future frames, as though
+ ;; the `default' face had been "set for this session":
+ (set-frame-font new-font nil frame-list)
+ ;; Just redraw the existing fonts on all frames:
+ (dolist (f frame-list)
+ (let ((frame-font
+ (or (font-get (face-attribute 'default :font f 'default)
+ :user-spec)
+ (frame-parameter f 'font-parameter))))
+ (when frame-font
+ (set-frame-parameter f 'font-parameter frame-font)
+ (set-face-attribute 'default f
+ :width 'normal
+ :weight 'normal
+ :slant 'normal
+ :font frame-font))))))))
(defun dynamic-setting-handle-config-changed-event (event)
"Handle config-changed-event on the display in EVENT.
diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el
index 8ab974be574..5d9ddc1a318 100644
--- a/lisp/ebuff-menu.el
+++ b/lisp/ebuff-menu.el
@@ -1,6 +1,6 @@
;;; ebuff-menu.el --- electric-buffer-list mode
-;; Copyright (C) 1985-1986, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Richard Mlynarik <mly@ai.mit.edu>
;; Maintainer: FSF
@@ -31,9 +31,6 @@
(require 'electric)
-;; this depends on the format of list-buffers (from src/buffer.c) and
-;; on stuff in lisp/buff-menu.el
-
(defvar electric-buffer-menu-mode-map
(let ((map (make-keymap)))
(fillarray (car (cdr map)) 'Electric-buffer-menu-undefined)
@@ -85,43 +82,57 @@
(define-key map [mouse-2] 'Electric-buffer-menu-mouse-select)
map))
+(put 'Electric-buffer-menu-quit :advertised-binding "\C-c\C-c")
+(put 'Electric-buffer-menu-select :advertised-binding " ")
+(put 'Helper-help :advertised-binding (char-to-string help-char))
+(put 'Helper-describe-bindings :advertised-binding "?")
+
(defvar electric-buffer-menu-mode-hook nil
- "Normal hook run by `electric-buffer-list'.")
+ "Normal hook run by `electric-buffer-menu-mode'.")
;;;###autoload
(defun electric-buffer-list (arg)
- "Pop up a buffer describing the set of Emacs buffers.
-Vaguely like ITS lunar select buffer; combining typeoutoid buffer
-listing with menuoid buffer selection.
-
-If the very next character typed is a space then the buffer list
-window disappears. Otherwise, one may move around in the buffer list
-window, marking buffers to be selected, saved or deleted.
-
-To exit and select a new buffer, type a space when the cursor is on
-the appropriate line of the buffer-list window. Other commands are
-much like those of `Buffer-menu-mode'.
+ "Pop up the Buffer Menu in an \"electric\" window.
+If you type SPC or RET (`Electric-buffer-menu-select'), that
+selects the buffer at point and quits the \"electric\" window.
+Otherwise, you can move around in the Buffer Menu, marking
+buffers to be selected, saved or deleted; these other commands
+are much like those of `Buffer-menu-mode'.
Run hooks in `electric-buffer-menu-mode-hook' on entry.
-\\{electric-buffer-menu-mode-map}"
+\\<electric-buffer-menu-mode-map>
+\\[keyboard-quit] or \\[Electric-buffer-menu-quit] -- exit buffer menu, returning to previous window and buffer
+ configuration. If the very first character typed is a space, it
+ also has this effect.
+\\[Electric-buffer-menu-select] -- select buffer of line point is on.
+ Also show buffers marked with m in other windows,
+ deletes buffers marked with \"D\", and saves those marked with \"S\".
+\\[Buffer-menu-mark] -- mark buffer to be displayed.
+\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
+\\[Buffer-menu-save] -- mark that buffer to be saved.
+\\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted.
+\\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
+\\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done.
+\\[Buffer-menu-backup-unmark] -- back up a line and remove marks."
(interactive "P")
(let (select buffer)
(save-window-excursion
(setq buffer (list-buffers-noselect arg))
(Electric-pop-up-window buffer)
(unwind-protect
- (progn
+ (let ((header header-line-format))
(set-buffer buffer)
- (Electric-buffer-menu-mode)
+ (electric-buffer-menu-mode)
+ (setq header-line-format header)
+ (goto-char (point-min))
+ (if (search-forward "\n." nil t)
+ (forward-char -1))
(electric-buffer-update-highlight)
(setq select
(catch 'electric-buffer-menu-select
- (message "<<< Press Return to bury the buffer list >>>")
- (if (eq (setq unread-command-events (list (read-event)))
- ?\s)
- (progn (setq unread-command-events nil)
- (throw 'electric-buffer-menu-select nil)))
+ (message "<<< Type SPC or RET to bury the buffer list >>>")
+ (setq unread-command-events (list (read-event)))
(let ((start-point (point))
(first (progn (goto-char (point-min))
(unless Buffer-menu-use-header-line
@@ -145,15 +156,16 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry.
(Buffer-menu-mode)
(bury-buffer) ;Get rid of window, if dedicated.
(message "")))
- (if select
- (progn (set-buffer buffer)
- (let ((opoint (point-marker)))
- (Buffer-menu-execute)
- (goto-char (point-min))
- (if (prog1 (search-forward "\n>" nil t)
- (goto-char opoint) (set-marker opoint nil))
- (Buffer-menu-select)
- (switch-to-buffer (Buffer-menu-buffer t))))))))
+ (when select
+ (set-buffer buffer)
+ (let ((opoint (point-marker)))
+ (Buffer-menu-execute)
+ (goto-char (point-min))
+ (if (prog1 (search-forward "\n>" nil t)
+ (goto-char opoint)
+ (set-marker opoint nil))
+ (Buffer-menu-select)
+ (switch-to-buffer (Buffer-menu-buffer t)))))))
(defun electric-buffer-menu-looper (state condition)
(cond ((and condition
@@ -174,50 +186,27 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry.
(defvar Helper-return-blurb)
-(put 'Electric-buffer-menu-mode 'mode-class 'special)
-(defun Electric-buffer-menu-mode ()
- "Major mode for editing a list of buffers.
-Each line describes one of the buffers in Emacs.
-Letters do not insert themselves; instead, they are commands.
-\\<electric-buffer-menu-mode-map>
-\\[keyboard-quit] or \\[Electric-buffer-menu-quit] -- exit buffer menu, returning to previous window and buffer
- configuration. If the very first character typed is a space, it
- also has this effect.
-\\[Electric-buffer-menu-select] -- select buffer of line point is on.
- Also show buffers marked with m in other windows,
- deletes buffers marked with \"D\", and saves those marked with \"S\".
-\\[Buffer-menu-mark] -- mark buffer to be displayed.
-\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
-\\[Buffer-menu-save] -- mark that buffer to be saved.
-\\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted.
-\\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
-\\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done.
-\\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
+(define-derived-mode electric-buffer-menu-mode Buffer-menu-mode
+ "Electric Buffer Menu"
+ "Toggle Electric Buffer Menu mode in this buffer.
+With a prefix argument ARG, enable Long Lines mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
-\\{electric-buffer-menu-mode-map}
-
-Entry to this mode via command `electric-buffer-list' calls the value of
-`electric-buffer-menu-mode-hook'."
- (let ((saved header-line-format))
- (kill-all-local-variables)
- (setq header-line-format saved))
- (use-local-map electric-buffer-menu-mode-map)
- (setq mode-name "Electric Buffer Menu")
+Electric Buffer Menu mode is a minor mode which is automatically
+enabled and disabled by the \\[electric-buffer-list] command.
+See the documentation of `electric-buffer-list' for details."
(setq mode-line-buffer-identification "Electric Buffer List")
- (make-local-variable 'Helper-return-blurb)
- (setq Helper-return-blurb "return to buffer editing")
- (setq truncate-lines t)
- (setq buffer-read-only t)
- (setq major-mode 'Electric-buffer-menu-mode)
- (goto-char (point-min))
- (if (search-forward "\n." nil t) (forward-char -1))
- (run-mode-hooks 'electric-buffer-menu-mode-hook))
+ (set (make-local-variable 'Helper-return-blurb)
+ "return to buffer editing"))
+
+(define-obsolete-function-alias 'Electric-buffer-menu-mode
+ 'electric-buffer-menu-mode "24.3")
;; generally the same as Buffer-menu-mode-map
;; (except we don't indirect to global-map)
(put 'Electric-buffer-menu-undefined 'suppress-keymap t)
-
(defun Electric-buffer-menu-exit ()
(interactive)
(setq unread-command-events (listify-key-sequence (this-command-keys)))
@@ -251,15 +240,10 @@ Skip execution of select, save, and delete commands."
(interactive)
(ding)
(message "%s"
- (if (and (eq (key-binding "\C-c\C-c") 'Electric-buffer-menu-quit)
- (eq (key-binding " ") 'Electric-buffer-menu-select)
- (eq (key-binding (char-to-string help-char)) 'Helper-help)
- (eq (key-binding "?") 'Helper-describe-bindings))
- (substitute-command-keys "Type C-c C-c to exit, Space to select, \\[Helper-help] for help, ? for commands")
- (substitute-command-keys "\
+ (substitute-command-keys "\
Type \\[Electric-buffer-menu-quit] to exit, \
\\[Electric-buffer-menu-select] to select, \
-\\[Helper-help] for help, \\[Helper-describe-bindings] for commands.")))
+\\[Helper-help] for help, \\[Helper-describe-bindings] for commands."))
(sit-for 4))
(defun Electric-buffer-menu-mode-view-buffer ()
@@ -274,13 +258,13 @@ Return to Electric Buffer Menu when done."
(sit-for 4))))
(defvar electric-buffer-overlay nil)
+
(defun electric-buffer-update-highlight ()
- (when (eq major-mode 'Electric-buffer-menu-mode)
+ (when (derived-mode-p 'electric-buffer-menu-mode)
;; Make sure we have an overlay to use.
(or electric-buffer-overlay
- (progn
- (make-local-variable 'electric-buffer-overlay)
- (setq electric-buffer-overlay (make-overlay (point) (point)))))
+ (set (make-local-variable 'electric-buffer-overlay)
+ (make-overlay (point) (point))))
(move-overlay electric-buffer-overlay
(line-beginning-position)
(line-end-position))
diff --git a/lisp/echistory.el b/lisp/echistory.el
index d5ee3003d68..2c7ef677578 100644
--- a/lisp/echistory.el
+++ b/lisp/echistory.el
@@ -1,6 +1,6 @@
;;; echistory.el --- Electric Command History Mode
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: FSF
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index f6c39062d1c..b1a24bc88a6 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -1,6 +1,6 @@
;;; edmacro.el --- keyboard macro editor
-;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Maintainer: Dave Gillespie <daveg@synaptics.com>
@@ -63,8 +63,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'kmacro)
@@ -319,17 +318,18 @@ or nil, use a compact 80-column format."
mac))))
(if no-keys
(when cmd
- (loop for key in (where-is-internal cmd '(keymap)) do
- (global-unset-key key)))
+ (cl-loop for key in (where-is-internal cmd '(keymap)) do
+ (global-unset-key key)))
(when keys
(if (= (length mac) 0)
- (loop for key in keys do (global-unset-key key))
- (loop for key in keys do
- (global-set-key key
- (or cmd
- (if (and mac-counter mac-format)
- (kmacro-lambda-form mac mac-counter mac-format)
- mac))))))))))
+ (cl-loop for key in keys do (global-unset-key key))
+ (cl-loop for key in keys do
+ (global-set-key key
+ (or cmd
+ (if (and mac-counter mac-format)
+ (kmacro-lambda-form
+ mac mac-counter mac-format)
+ mac))))))))))
(kill-buffer buf)
(when (buffer-name obuf)
(switch-to-buffer obuf))
@@ -437,9 +437,9 @@ doubt, use whitespace."
(one-line (eq verbose 1)))
(if one-line (setq verbose nil))
(when (stringp macro)
- (loop for i below (length macro) do
- (when (>= (aref rest-mac i) 128)
- (incf (aref rest-mac i) (- ?\M-\^@ 128)))))
+ (cl-loop for i below (length macro) do
+ (when (>= (aref rest-mac i) 128)
+ (cl-incf (aref rest-mac i) (- ?\M-\^@ 128)))))
(while (not (eq (aref rest-mac 0) 'end-macro))
(let* ((prefix
(or (and (integerp (aref rest-mac 0))
@@ -448,57 +448,58 @@ doubt, use whitespace."
'(digit-argument negative-argument))
(let ((i 1))
(while (memq (aref rest-mac i) (cdr mdigs))
- (incf i))
+ (cl-incf i))
(and (not (memq (aref rest-mac i) pkeys))
(prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ")
- (callf edmacro-subseq rest-mac i)))))
+ (cl-callf edmacro-subseq rest-mac i)))))
(and (eq (aref rest-mac 0) ?\C-u)
(eq (key-binding [?\C-u]) 'universal-argument)
(let ((i 1))
(while (eq (aref rest-mac i) ?\C-u)
- (incf i))
+ (cl-incf i))
(and (not (memq (aref rest-mac i) pkeys))
- (prog1 (loop repeat i concat "C-u ")
- (callf edmacro-subseq rest-mac i)))))
+ (prog1 (cl-loop repeat i concat "C-u ")
+ (cl-callf edmacro-subseq rest-mac i)))))
(and (eq (aref rest-mac 0) ?\C-u)
(eq (key-binding [?\C-u]) 'universal-argument)
(let ((i 1))
(when (eq (aref rest-mac i) ?-)
- (incf i))
+ (cl-incf i))
(while (memq (aref rest-mac i)
'(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
- (incf i))
+ (cl-incf i))
(and (not (memq (aref rest-mac i) pkeys))
(prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ")
- (callf edmacro-subseq rest-mac i)))))))
+ (cl-callf edmacro-subseq rest-mac i)))))))
(bind-len (apply 'max 1
- (loop for map in maps
- for b = (lookup-key map rest-mac)
- when b collect b)))
+ (cl-loop for map in maps
+ for b = (lookup-key map rest-mac)
+ when b collect b)))
(key (edmacro-subseq rest-mac 0 bind-len))
(fkey nil) tlen tkey
- (bind (or (loop for map in maps for b = (lookup-key map key)
- thereis (and (not (integerp b)) b))
+ (bind (or (cl-loop for map in maps for b = (lookup-key map key)
+ thereis (and (not (integerp b)) b))
(and (setq fkey (lookup-key local-function-key-map rest-mac))
(setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen)
fkey (lookup-key local-function-key-map tkey))
- (loop for map in maps
- for b = (lookup-key map fkey)
- when (and (not (integerp b)) b)
- do (setq bind-len tlen key tkey)
- and return b
- finally do (setq fkey nil)))))
+ (cl-loop for map in maps
+ for b = (lookup-key map fkey)
+ when (and (not (integerp b)) b)
+ do (setq bind-len tlen key tkey)
+ and return b
+ finally do (setq fkey nil)))))
(first (aref key 0))
- (text (loop for i from bind-len below (length rest-mac)
- for ch = (aref rest-mac i)
- while (and (integerp ch)
- (> ch 32) (< ch maxkey) (/= ch 92)
- (eq (key-binding (char-to-string ch))
- 'self-insert-command)
- (or (> i (- (length rest-mac) 2))
- (not (eq ch (aref rest-mac (+ i 1))))
- (not (eq ch (aref rest-mac (+ i 2))))))
- finally return i))
+ (text
+ (cl-loop for i from bind-len below (length rest-mac)
+ for ch = (aref rest-mac i)
+ while (and (integerp ch)
+ (> ch 32) (< ch maxkey) (/= ch 92)
+ (eq (key-binding (char-to-string ch))
+ 'self-insert-command)
+ (or (> i (- (length rest-mac) 2))
+ (not (eq ch (aref rest-mac (+ i 1))))
+ (not (eq ch (aref rest-mac (+ i 2))))))
+ finally return i))
desc)
(if (stringp bind) (setq bind nil))
(cond ((and (eq bind 'self-insert-command) (not prefix)
@@ -509,7 +510,7 @@ doubt, use whitespace."
(setq desc (concat (edmacro-subseq rest-mac 0 text)))
(when (string-match "^[ACHMsS]-." desc)
(setq text 2)
- (callf substring desc 0 2))
+ (cl-callf substring desc 0 2))
(not (string-match
"^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*."
desc))))
@@ -535,17 +536,17 @@ doubt, use whitespace."
(cond
((integerp ch)
(concat
- (loop for pf across "ACHMsS"
- for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
- ?\M-\^@ ?\s-\^@ ?\S-\^@)
- when (/= (logand ch bit) 0)
- concat (format "%c-" pf))
+ (cl-loop for pf across "ACHMsS"
+ for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
+ ?\M-\^@ ?\s-\^@ ?\S-\^@)
+ when (/= (logand ch bit) 0)
+ concat (format "%c-" pf))
(let ((ch2 (logand ch (1- (lsh 1 18)))))
(cond ((<= ch2 32)
- (case ch2
+ (pcase ch2
(0 "NUL") (9 "TAB") (10 "LFD")
(13 "RET") (27 "ESC") (32 "SPC")
- (t
+ (_
(format "C-%c"
(+ (if (<= ch2 26) 96 64)
ch2)))))
@@ -563,30 +564,30 @@ doubt, use whitespace."
(let ((times 1) (pos bind-len))
(while (not (edmacro-mismatch rest-mac rest-mac
0 bind-len pos (+ bind-len pos)))
- (incf times)
- (incf pos bind-len))
+ (cl-incf times)
+ (cl-incf pos bind-len))
(when (> times 1)
(setq desc (format "%d*%s" times desc))
(setq bind-len (* bind-len times)))))
(setq rest-mac (edmacro-subseq rest-mac bind-len))
(if verbose
(progn
- (unless (equal res "") (callf concat res "\n"))
- (callf concat res desc)
+ (unless (equal res "") (cl-callf concat res "\n"))
+ (cl-callf concat res desc)
(when (and bind (or (stringp bind) (symbolp bind)))
- (callf concat res
+ (cl-callf concat res
(make-string (max (- 3 (/ (length desc) 8)) 1) 9)
";; " (if (stringp bind) bind (symbol-name bind))))
(setq len 0))
(if (and (> (+ len (length desc) 2) 72) (not one-line))
(progn
- (callf concat res "\n ")
+ (cl-callf concat res "\n ")
(setq len 1))
(unless (equal res "")
- (callf concat res " ")
- (incf len)))
- (callf concat res desc)
- (incf len (length desc)))))
+ (cl-callf concat res " ")
+ (cl-incf len)))
+ (cl-callf concat res desc)
+ (cl-incf len (length desc)))))
res))
(defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2)
@@ -594,28 +595,19 @@ doubt, use whitespace."
Return nil if the sequences match. If one sequence is a prefix of the
other, the return value indicates the end of the shorted sequence.
\n(fn SEQ1 SEQ2 START1 END1 START2 END2)"
- (let (cl-test cl-test-not cl-key cl-from-end)
- (or cl-end1 (setq cl-end1 (length cl-seq1)))
- (or cl-end2 (setq cl-end2 (length cl-seq2)))
- (if cl-from-end
- (progn
- (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
- (cl-check-match (elt cl-seq1 (1- cl-end1))
- (elt cl-seq2 (1- cl-end2))))
- (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
- (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
- (1- cl-end1)))
- (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
- (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
- (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
- (cl-check-match (if cl-p1 (car cl-p1)
- (aref cl-seq1 cl-start1))
- (if cl-p2 (car cl-p2)
- (aref cl-seq2 cl-start2))))
- (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
- cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
- (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
- cl-start1)))))
+ (or cl-end1 (setq cl-end1 (length cl-seq1)))
+ (or cl-end2 (setq cl-end2 (length cl-seq2)))
+ (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
+ (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
+ (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
+ (eql (if cl-p1 (car cl-p1)
+ (aref cl-seq1 cl-start1))
+ (if cl-p2 (car cl-p2)
+ (aref cl-seq2 cl-start2))))
+ (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
+ cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
+ (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
+ cl-start1)))
(defun edmacro-subseq (seq start &optional end)
"Return the subsequence of SEQ from START to END.
@@ -647,9 +639,9 @@ If START or END is negative, it counts from the end."
The string represents the same events; Meta is indicated by bit 7.
This function assumes that the events can be stored in a string."
(setq seq (copy-sequence seq))
- (loop for i below (length seq) do
- (when (logand (aref seq i) 128)
- (setf (aref seq i) (logand (aref seq i) 127))))
+ (cl-loop for i below (length seq) do
+ (when (logand (aref seq i) 128)
+ (setf (aref seq i) (logand (aref seq i) 127))))
seq)
(defun edmacro-fix-menu-commands (macro &optional noerror)
@@ -664,7 +656,7 @@ This function assumes that the events can be stored in a string."
((eq (car ev) 'switch-frame))
((equal ev '(menu-bar))
(push 'menu-bar result))
- ((equal (cadadr ev) '(menu-bar))
+ ((equal (cl-cadadr ev) '(menu-bar))
(push (vector 'menu-bar (car ev)) result))
;; It would be nice to do pop-up menus, too, but not enough
;; info is recorded in macros to make this possible.
@@ -724,30 +716,31 @@ This function assumes that the events can be stored in a string."
(t
(let ((orig-word word) (prefix 0) (bits 0))
(while (string-match "^[ACHMsS]-." word)
- (incf bits (cdr (assq (aref word 0)
+ (cl-incf bits (cdr (assq (aref word 0)
'((?A . ?\A-\^@) (?C . ?\C-\^@)
(?H . ?\H-\^@) (?M . ?\M-\^@)
(?s . ?\s-\^@) (?S . ?\S-\^@)))))
- (incf prefix 2)
- (callf substring word 2))
+ (cl-incf prefix 2)
+ (cl-callf substring word 2))
(when (string-match "^\\^.$" word)
- (incf bits ?\C-\^@)
- (incf prefix)
- (callf substring word 1))
+ (cl-incf bits ?\C-\^@)
+ (cl-incf prefix)
+ (cl-callf substring word 1))
(let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
("LFD" . "\n") ("TAB" . "\t")
("ESC" . "\e") ("SPC" . " ")
("DEL" . "\177")))))
(when found (setq word (cdr found))))
(when (string-match "^\\\\[0-7]+$" word)
- (loop for ch across word
- for n = 0 then (+ (* n 8) ch -48)
- finally do (setq word (vector n))))
+ (cl-loop for ch across word
+ for n = 0 then (+ (* n 8) ch -48)
+ finally do (setq word (vector n))))
(cond ((= bits 0)
(setq key word))
((and (= bits ?\M-\^@) (stringp word)
(string-match "^-?[0-9]+$" word))
- (setq key (loop for x across word collect (+ x bits))))
+ (setq key (cl-loop for x across word
+ collect (+ x bits))))
((/= (length word) 1)
(error "%s must prefix a single character, not %s"
(substring orig-word 0 prefix) word))
@@ -761,7 +754,7 @@ This function assumes that the events can be stored in a string."
(t
(setq key (list (+ bits (aref word 0)))))))))
(when key
- (loop repeat times do (callf vconcat res key)))))
+ (cl-loop repeat times do (cl-callf vconcat res key)))))
(when (and (>= (length res) 4)
(eq (aref res 0) ?\C-x)
(eq (aref res 1) ?\()
@@ -769,13 +762,13 @@ This function assumes that the events can be stored in a string."
(eq (aref res (- (length res) 1)) ?\)))
(setq res (edmacro-subseq res 2 -2)))
(if (and (not need-vector)
- (loop for ch across res
- always (and (characterp ch)
- (let ((ch2 (logand ch (lognot ?\M-\^@))))
- (and (>= ch2 0) (<= ch2 127))))))
- (concat (loop for ch across res
- collect (if (= (logand ch ?\M-\^@) 0)
- ch (+ ch 128))))
+ (cl-loop for ch across res
+ always (and (characterp ch)
+ (let ((ch2 (logand ch (lognot ?\M-\^@))))
+ (and (>= ch2 0) (<= ch2 127))))))
+ (concat (cl-loop for ch across res
+ collect (if (= (logand ch ?\M-\^@) 0)
+ ch (+ ch 128))))
res)))
(provide 'edmacro)
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index b2bcf1f85cb..a1bd4d65385 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -1,6 +1,6 @@
;;; ehelp.el --- bindings for electric-help mode -*- lexical-binding: t -*-
-;; Copyright (C) 1986, 1995, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1995, 2000-2012 Free Software Foundation, Inc.
;; Author: Richard Mlynarik
;; (according to ack.texi and authors.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)
@@ -193,7 +195,9 @@ BUFFER is put back into its original major mode."
(replace-buffer-in-windows buffer)
;; must do this outside of save-window-excursion
(bury-buffer buffer))
- (eval electric-help-form-to-execute))))
+ (if (functionp electric-help-form-to-execute)
+ (funcall electric-help-form-to-execute)
+ (eval electric-help-form-to-execute)))))
(defun electric-help-command-loop ()
(catch 'exit
@@ -349,14 +353,19 @@ will select it.)"
;; continues with execute-extended-command.
(defun electric-help-execute-extended (_prefixarg)
(interactive "p")
- (setq electric-help-form-to-execute '(execute-extended-command nil))
+ (setq electric-help-form-to-execute
+ (lambda () (execute-extended-command nil)))
(electric-help-retain))
;; This is to be buond to C-x in ehelp mode. Retains ehelp buffer and then
;; continues with ctrl-x prefix.
(defun electric-help-ctrl-x-prefix (_prefixarg)
(interactive "p")
- (setq electric-help-form-to-execute '(progn (message nil) (setq unread-command-char ?\C-x)))
+ (setq electric-help-form-to-execute
+ (lambda ()
+ (message nil)
+ (setq unread-command-events
+ (append unread-command-events '(?\C-x)))))
(electric-help-retain))
diff --git a/lisp/electric.el b/lisp/electric.el
index cec1b5d2000..abf5a72ecaf 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -1,6 +1,6 @@
;;; electric.el --- window maker and Command loop for `electric' modes
-;; Copyright (C) 1985-1986, 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: FSF
@@ -38,8 +38,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
;; This loop is the guts for non-standard modes which retain control
;; until some event occurs. It is a `do-forever', the only way out is
;; to throw. It assumes that you have set up the keymap, window, and
@@ -215,6 +213,7 @@ point right after that char, and it should return t to cause indentation,
;; it looks challenging.
(let (pos)
(when (and
+ electric-indent-mode
;; Don't reindent while inserting spaces at beginning of line.
(or (not (memq last-command-event '(?\s ?\t)))
(save-excursion (skip-chars-backward " \t") (not (bolp))))
@@ -260,9 +259,9 @@ With a prefix argument ARG, enable Electric Indent mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-Electric Indent mode is a global minor mode. When enabled,
-reindentation is triggered whenever you insert a character listed
-in `electric-indent-chars'."
+This is a global minor mode. When enabled, it reindents whenever
+the hook `electric-indent-functions' returns non-nil, or you
+insert a character from `electric-indent-chars'."
:global t
:group 'electricity
(if (not electric-indent-mode)
@@ -288,6 +287,8 @@ in `electric-indent-chars'."
(defcustom electric-pair-pairs
'((?\" . ?\"))
"Alist of pairs that should be used regardless of major mode."
+ :group 'electricity
+ :version "24.1"
:type '(repeat (cons character character)))
(defcustom electric-pair-skip-self t
@@ -296,16 +297,21 @@ When inserting a closing paren character right before the same character,
just skip that character instead, so that hitting ( followed by ) results
in \"()\" rather than \"())\".
This can be convenient for people who find it easier to hit ) than C-f."
+ :group 'electricity
+ :version "24.1"
:type 'boolean)
+(defun electric-pair-syntax (command-event)
+ (and electric-pair-mode
+ (let ((x (assq command-event electric-pair-pairs)))
+ (cond
+ (x (if (eq (car x) (cdr x)) ?\" ?\())
+ ((rassq command-event electric-pair-pairs) ?\))
+ (t (char-syntax command-event))))))
+
(defun electric-pair-post-self-insert-function ()
(let* ((syntax (and (eq (char-before) last-command-event) ; Sanity check.
- electric-pair-mode
- (let ((x (assq last-command-event electric-pair-pairs)))
- (cond
- (x (if (eq (car x) (cdr x)) ?\" ?\())
- ((rassq last-command-event electric-pair-pairs) ?\))
- (t (char-syntax last-command-event))))))
+ (electric-pair-syntax last-command-event)))
;; FIXME: when inserting the closer, we should maybe use
;; self-insert-command, although it may prove tricky running
;; post-self-insert-hook recursively, and we wouldn't want to trigger
@@ -319,12 +325,13 @@ This can be convenient for people who find it easier to hit ) than C-f."
((and (memq syntax '(?\( ?\" ?\$)) (use-region-p))
(if (> (mark) (point))
(goto-char (mark))
- ;; We already inserted the open-paren but at the end of the region,
- ;; so we have to remove it and start over.
- (delete-char -1)
- (save-excursion
+ ;; We already inserted the open-paren but at the end of the
+ ;; region, so we have to remove it and start over.
+ (delete-char -1)
+ (save-excursion
(goto-char (mark))
- (insert last-command-event)))
+ ;; Do not insert after `save-excursion' marker (Bug#11520).
+ (insert-before-markers last-command-event)))
(insert closer))
;; Backslash-escaped: no pairing, no skipping.
((save-excursion
@@ -351,6 +358,10 @@ This can be convenient for people who find it easier to hit ) than C-f."
(eq (char-syntax (following-char)) ?w)))
(save-excursion (insert closer))))))
+(defun electric-pair-will-use-region ()
+ (and (use-region-p)
+ (memq (electric-pair-syntax last-command-event) '(?\( ?\" ?\$))))
+
;;;###autoload
(define-minor-mode electric-pair-mode
"Toggle automatic parens pairing (Electric Pair mode).
@@ -360,14 +371,21 @@ the mode if ARG is omitted or nil.
Electric Pair mode is a global minor mode. When enabled, typing
an open parenthesis automatically inserts the corresponding
-closing parenthesis. \(Likewise for brackets, etc.)"
+closing parenthesis. \(Likewise for brackets, etc.)
+
+See options `electric-pair-pairs' and `electric-pair-skip-self'."
:global t
:group 'electricity
(if electric-pair-mode
- (add-hook 'post-self-insert-hook
- #'electric-pair-post-self-insert-function)
+ (progn
+ (add-hook 'post-self-insert-hook
+ #'electric-pair-post-self-insert-function)
+ (add-hook 'self-insert-uses-region-functions
+ #'electric-pair-will-use-region))
(remove-hook 'post-self-insert-hook
- #'electric-pair-post-self-insert-function)))
+ #'electric-pair-post-self-insert-function)
+ (remove-hook 'self-insert-uses-region-functions
+ #'electric-pair-will-use-region)))
;; Automatically add newlines after/before/around some chars.
@@ -375,8 +393,8 @@ closing parenthesis. \(Likewise for brackets, etc.)"
"List of rules saying where to automatically insert newlines.
Each rule has the form (CHAR . WHERE) where CHAR is the char
that was just inserted and WHERE specifies where to insert newlines
-and can be: nil, `before', `after', `around', or a function that returns
-one of those symbols.")
+and can be: nil, `before', `after', `around', or a function of no
+arguments that returns one of those symbols.")
(defun electric-layout-post-self-insert-function ()
(let* ((rule (cdr (assq last-command-event electric-layout-rules)))
@@ -387,16 +405,16 @@ one of those symbols.")
(not (nth 8 (save-excursion (syntax-ppss pos)))))
(let ((end (copy-marker (point) t)))
(goto-char pos)
- (case (if (functionp rule) (funcall rule) rule)
+ (pcase (if (functionp rule) (funcall rule) rule)
;; FIXME: we used `newline' down here which called
;; self-insert-command and ran post-self-insert-hook recursively.
;; It happened to make electric-indent-mode work automatically with
;; electric-layout-mode (at the cost of re-indenting lines
;; multiple times), but I'm not sure it's what we want.
- (before (goto-char (1- pos)) (skip-chars-backward " \t")
+ (`before (goto-char (1- pos)) (skip-chars-backward " \t")
(unless (bolp) (insert "\n")))
- (after (insert "\n")) ; FIXME: check eolp before inserting \n?
- (around (save-excursion
+ (`after (insert "\n")) ; FIXME: check eolp before inserting \n?
+ (`around (save-excursion
(goto-char (1- pos)) (skip-chars-backward " \t")
(unless (bolp) (insert "\n")))
(insert "\n"))) ; FIXME: check eolp before inserting \n?
@@ -404,7 +422,11 @@ one of those symbols.")
;;;###autoload
(define-minor-mode electric-layout-mode
- "Automatically insert newlines around some chars."
+ "Automatically insert newlines around some chars.
+With a prefix argument ARG, enable Electric Layout mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+The variable `electric-layout-rules' says when and how to insert newlines."
:global t
:group 'electricity
(if electric-layout-mode
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index 5d640f629e8..fdea1c2614d 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -1,6 +1,6 @@
;;; elide-head.el --- hide headers in files
-;; Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: outlines tools
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index ae2900775ac..c2ebb3bbdc6 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1,6 +1,6 @@
-;;; advice.el --- an overloading mechanism for Emacs Lisp functions
+;;; advice.el --- An overloading mechanism for Emacs Lisp functions -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1994, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
;; Maintainer: FSF
@@ -31,10 +31,6 @@
;;; Commentary:
-;; NOTE: This documentation is slightly out of date. In particular, all the
-;; references to Emacs-18 are obsolete now, because it is not any longer
-;; supported by this version of Advice.
-
;; Advice is documented in the Emacs Lisp Manual.
;; @ Introduction:
@@ -51,14 +47,12 @@
;; @ Highlights:
;; =============
;; - Clean definition of multiple, named before/around/after advices
-;; for functions, macros, subrs and special forms
+;; for functions and macros.
;; - Full control over the arguments an advised function will receive,
;; the binding environment in which it will be executed, as well as the
;; value it will return.
-;; - Allows re/definition of interactive behavior for functions and subrs
-;; - Every piece of advice can have its documentation string which will be
-;; combined with the original documentation of the advised function at
-;; call-time of `documentation' for proper command-key substitution.
+;; - Allows re/definition of interactive behavior for commands.
+;; - Every piece of advice can have its documentation string.
;; - The execution of every piece of advice can be protected against error
;; and non-local exits in preceding code or advices.
;; - Simple argument access either by name, or, more portable but as
@@ -67,7 +61,7 @@
;; version of a function.
;; - Advised functions can be byte-compiled either at file-compile time
;; (see preactivation) or activation time.
-;; - Separation of advice definition and activation
+;; - Separation of advice definition and activation.
;; - Forward advice is possible, that is
;; as yet undefined or autoload functions can be advised without having to
;; preload the file in which they are defined.
@@ -81,23 +75,12 @@
;; - En/disablement mechanism allows the use of different "views" of advised
;; functions depending on what pieces of advice are currently en/disabled
;; - Provides manipulation mechanisms for sets of advised functions via
-;; regular expressions that match advice names
-
-;; @ How to get Advice for Emacs-18:
-;; =================================
-;; `advice18.el', a version of Advice that also works in Emacs-18 is available
-;; either via anonymous ftp from `ftp.cs.buffalo.edu (128.205.32.9)' with
-;; pathname `/pub/Emacs/advice18.el', or from one of the Emacs Lisp archive
-;; sites, or send email to <hans@cs.buffalo.edu> and I'll mail it to you.
+;; regular expressions that match advice names.
;; @ Overview, or how to read this file:
;; =====================================
-;; NOTE: This documentation is slightly out of date. In particular, all the
-;; references to Emacs-18 are obsolete now, because it is not any longer
-;; supported by this version of Advice. An up-to-date version will soon be
-;; available as an info file (thanks to the kind help of Jack Vinson and
-;; David M. Smith). Until then you can use `outline-mode' to help you read
-;; this documentation (set `outline-regexp' to `";; @+"').
+;; You can use `outline-mode' to help you read this documentation (set
+;; `outline-regexp' to `";; @+"').
;;
;; The four major sections of this file are:
;;
@@ -111,9 +94,6 @@
;; @ Restrictions:
;; ===============
-;; - This version of Advice only works for Emacs 19.26 and later. It uses
-;; new versions of the built-in functions `fset/defalias' which are not
-;; yet available in Lucid Emacs, hence, it won't work there.
;; - Advised functions/macros/subrs will only exhibit their advised behavior
;; when they are invoked via their function cell. This means that advice will
;; not work for the following:
@@ -131,23 +111,12 @@
;; others come from the various Lisp advice mechanisms I've come across
;; so far, and a few are simply mine.
-;; @ Comments, suggestions, bug reports:
-;; =====================================
-;; If you find any bugs, have suggestions for new advice features, find the
-;; documentation wrong, confusing, incomplete, or otherwise unsatisfactory,
-;; have any questions about Advice, or have otherwise enlightening
-;; comments feel free to send me email at <hans@cs.buffalo.edu>.
-
;; @ Safety Rules and Emergency Exits:
;; ===================================
;; Before we begin: CAUTION!!
;; Advice provides you with a lot of rope to hang yourself on very
;; easily accessible trees, so, here are a few important things you
-;; should know: Once Advice has been started with `ad-start-advice'
-;; (which happens automatically when you load this file), it
-;; generates an advised definition of the `documentation' function, and
-;; it will enable automatic advice activation when functions get defined.
-;; All of this can be undone at any time with `M-x ad-stop-advice'.
+;; should know:
;;
;; If you experience any strange behavior/errors etc. that you attribute to
;; Advice or to some ill-advised function do one of the following:
@@ -155,45 +124,37 @@
;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what
;; function gives you problems)
;; - M-x ad-deactivate-all (if you don't have a clue what's going wrong)
-;; - M-x ad-stop-advice (if you think the problem is related to the
-;; advised functions used by Advice itself)
;; - M-x ad-recover-normality (for real emergencies)
;; - If none of the above solves your Advice-related problem go to another
;; terminal, kill your Emacs process and send me some hate mail.
-;; The first three measures have restarts, i.e., once you've figured out
+;; The first two measures have restarts, i.e., once you've figured out
;; the problem you can reactivate advised functions with either `ad-activate',
-;; `ad-activate-all', or `ad-start-advice'. `ad-recover-normality' unadvises
+;; or `ad-activate-all'. `ad-recover-normality' unadvises
;; everything so you won't be able to reactivate any advised functions, you'll
;; have to stick with their standard incarnations for the rest of the session.
-;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before
-;; you byte-compile a file, because advised special forms and macros can lead
-;; to unwanted compilation results. When you are done compiling use
-;; `M-x ad-activate-all' to go back to the advised state of all your
-;; advised functions.
-
;; RELAX: Advice is pretty safe even if you are oblivious to the above.
;; I use it extensively and haven't run into any serious trouble in a long
-;; time. Just wanted you to be warned.
+;; time. Just wanted you to be warned.
;; @ Customization:
;; ================
;; Look at the documentation of `ad-redefinition-action' for possible values
-;; of this variable. Its default value is `warn' which will print a warning
+;; of this variable. Its default value is `warn' which will print a warning
;; message when an already defined advised function gets redefined with a
;; new original definition and de/activated.
;; Look at the documentation of `ad-default-compilation-action' for possible
-;; values of this variable. Its default value is `maybe' which will compile
+;; values of this variable. Its default value is `maybe' which will compile
;; advised definitions during activation in case the byte-compiler is already
-;; loaded. Otherwise, it will leave them uncompiled.
+;; loaded. Otherwise, it will leave them uncompiled.
;; @ Motivation:
;; =============
;; Before I go on explaining how advice works, here are four simple examples
-;; how this package can be used. The first three are very useful, the last one
+;; how this package can be used. The first three are very useful, the last one
;; is just a joke:
;;(defadvice switch-to-buffer (before existing-buffers-only activate)
@@ -224,18 +185,12 @@
;; @ Advice documentation:
;; =======================
-;; Below is general documentation of the various features of advice. For more
+;; Below is general documentation of the various features of advice. For more
;; concrete examples check the corresponding sections in the tutorial part.
;; @@ Terminology:
;; ===============
-;; - Emacs, Emacs-19: Emacs as released by the GNU Project
-;; - Lemacs: Lucid's version of Emacs with major version 19
-;; - v18: Any Emacs with major version 18 or built as an extension to that
-;; (such as Epoch)
-;; - v19: Any Emacs with major version 19
-;; - jwz: Jamie Zawinski - former keeper of Lemacs and creator of the optimizing
-;; byte-compiler used in v19s.
+;; - Emacs: Emacs as released by the GNU Project
;; - Advice: The name of this package.
;; - advices: Short for "pieces of advice".
@@ -259,22 +214,22 @@
;; <name> is the name of the advice which has to be a non-nil symbol.
;; Names uniquely identify a piece of advice in a certain advice class,
;; hence, advices can be redefined by defining an advice with the same class
-;; and name. Advice names are global symbols, hence, the same name space
+;; and name. Advice names are global symbols, hence, the same name space
;; conventions used for function names should be applied.
;; An optional <position> specifies where in the current list of advices of
-;; the specified <class> this new advice will be placed. <position> has to
+;; the specified <class> this new advice will be placed. <position> has to
;; be either `first', `last' or a number that specifies a zero-based
-;; position (`first' is equivalent to 0). If no position is specified
-;; `first' will be used as a default. If this call to `defadvice' redefines
+;; position (`first' is equivalent to 0). If no position is specified
+;; `first' will be used as a default. If this call to `defadvice' redefines
;; an already existing advice (see above) then the position argument will
;; be ignored and the position of the already existing advice will be used.
;; An optional <arglist> which has to be a list can be used to define the
-;; argument list of the advised function. This argument list should of
+;; argument list of the advised function. This argument list should of
;; course be compatible with the argument list of the original function,
;; otherwise functions that call the advised function with the original
-;; argument list in mind will break. If more than one advice specify an
+;; argument list in mind will break. If more than one advice specify an
;; argument list then the first one (the one with the smallest position)
;; found in the list of before/around/after advices will be used.
@@ -290,32 +245,31 @@
;; `disable': Specifies that the defined advice should be disabled, hence,
;; it will not be used in an activation until somebody enables it.
;; `preactivate': Specifies that the advised function should get preactivated
-;; at macro-expansion/compile time of this `defadvice'. This
+;; at macro-expansion/compile time of this `defadvice'. This
;; generates a compiled advised definition according to the
;; current advice state which will be used during activation
-;; if appropriate. Only use this if the `defadvice' gets
-;; actually compiled (with a v18 byte-compiler put the `defadvice'
-;; into the body of a `defun' to accomplish proper compilation).
+;; if appropriate. Only use this if the `defadvice' gets
+;; actually compiled.
;; An optional <documentation-string> can be supplied to document the advice.
;; On call of the `documentation' function it will be combined with the
;; documentation strings of the original function and other advices.
;; An optional <interactive-form> form can be supplied to change/add
-;; interactive behavior of the original function. If more than one advice
+;; interactive behavior of the original function. If more than one advice
;; has an `(interactive ...)' specification then the first one (the one
;; with the smallest position) found in the list of before/around/after
;; advices will be used.
;; A possibly empty list of <body-forms> specifies the body of the advice in
-;; an implicit progn. The body of an advice can access/change arguments,
+;; an implicit progn. The body of an advice can access/change arguments,
;; the return value, the binding environment, and can have all sorts of
;; other side effects.
;; @@ Assembling advised definitions:
;; ==================================
;; Suppose a function/macro/subr/special-form has N pieces of before advice,
-;; M pieces of around advice and K pieces of after advice. Assuming none of
+;; M pieces of around advice and K pieces of after advice. Assuming none of
;; the advices is protected, its advised definition will look like this
;; (body-form indices correspond to the position of the respective advice in
;; that advice class):
@@ -348,20 +302,17 @@
;; first argument list defined in the list of before/around/after advices.
;; The values of <arglist> variables can be accessed/changed in the body of
;; an advice by simply referring to them by their original name, however,
-;; more portable argument access macros are also provided (see below). For
-;; subrs/special-forms for which neither explicit argument list definitions
-;; are available, nor their documentation strings contain such definitions
-;; (as they do v19s), `(&rest ad-subr-args)' will be used.
+;; more portable argument access macros are also provided (see below).
;; <advised-docstring> is an optional, special documentation string which will
;; be expanded into a proper documentation string upon call of `documentation'.
;; (interactive ...) is an optional interactive form either taken from the
-;; original function or from a before/around/after advice. For advised
+;; original function or from a before/around/after advice. For advised
;; interactive subrs that do not have an interactive form specified in any
;; advice we have to use (interactive) and then call the subr interactively
;; if the advised function was called interactively, because the
-;; interactive specification of subrs is not accessible. This is the only
+;; interactive specification of subrs is not accessible. This is the only
;; case where changing the values of arguments will not have an affect
;; because they will be reset by the interactive specification of the subr.
;; If this is a problem one can always specify an interactive form in a
@@ -370,48 +321,44 @@
;;
;; Then the body forms of the various advices in the various classes of advice
;; are assembled in order. The forms of around advice L are normally part of
-;; one of the forms of around advice L-1. An around advice can specify where
+;; one of the forms of around advice L-1. An around advice can specify where
;; the forms of the wrapped or surrounded forms should go with the special
-;; keyword `ad-do-it', which will be substituted with a `progn' containing the
-;; forms of the surrounded code.
+;; keyword `ad-do-it', which will run the forms of the surrounded code.
;; The innermost part of the around advice onion is
;; <apply original definition to <arglist>>
-;; whose form depends on the type of the original function. The variable
-;; `ad-return-value' will be set to its result. This variable is visible to
+;; whose form depends on the type of the original function. The variable
+;; `ad-return-value' will be set to its result. This variable is visible to
;; all pieces of advice which can access and modify it before it gets returned.
;;
;; The semantic structure of advised functions that contain protected pieces
-;; of advice is the same. The only difference is that `unwind-protect' forms
+;; of advice is the same. The only difference is that `unwind-protect' forms
;; make sure that the protected advice gets executed even if some previous
-;; piece of advice had an error or a non-local exit. If any around advice is
+;; piece of advice had an error or a non-local exit. If any around advice is
;; protected then the whole around advice onion will be protected.
;; @@ Argument access in advised functions:
;; ========================================
;; As already mentioned, the simplest way to access the arguments of an
-;; advised function in the body of an advice is to refer to them by name. To
-;; do that, the advice programmer needs to know either the names of the
+;; advised function in the body of an advice is to refer to them by name.
+;; To do that, the advice programmer needs to know either the names of the
;; argument variables of the original function, or the names used in the
-;; argument list redefinition given in a piece of advice. While this simple
+;; argument list redefinition given in a piece of advice. While this simple
;; method might be sufficient in many cases, it has the disadvantage that it
;; is not very portable because it hardcodes the argument names into the
;; advice. If the definition of the original function changes the advice
-;; might break even though the code might still be correct. Situations like
+;; might break even though the code might still be correct. Situations like
;; that arise, for example, if one advises a subr like `eval-region' which
;; gets redefined in a non-advice style into a function by the edebug
-;; package. If the advice assumes `eval-region' to be a subr it might break
-;; once edebug is loaded. Similar situations arise when one wants to use the
-;; same piece of advice across different versions of Emacs. Some subrs in a
-;; v18 Emacs are functions in v19 and vice versa, but for the most part the
-;; semantics remain the same, hence, the same piece of advice might be usable
-;; in both Emacs versions.
+;; package. If the advice assumes `eval-region' to be a subr it might break
+;; once edebug is loaded. Similar situations arise when one wants to use the
+;; same piece of advice across different versions of Emacs.
;; As a solution to that advice provides argument list access macros that get
;; translated into the proper access forms at activation time, i.e., when the
-;; advised definition gets constructed. Access macros access actual arguments
+;; advised definition gets constructed. Access macros access actual arguments
;; by position regardless of how these actual argument get distributed onto
-;; the argument variables of a function. The rational behind this is that in
+;; the argument variables of a function. The rational behind this is that in
;; Emacs Lisp the semantics of an argument is strictly determined by its
;; position (there are no keyword arguments).
@@ -423,9 +370,9 @@
;;
;; (foo 0 1 2 3 4 5 6)
-;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that
-;; the semantics of an actual argument is determined by its position. It is
-;; this semantics that has to be known by the advice programmer. Then s/he
+;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that
+;; the semantics of an actual argument is determined by its position. It is
+;; this semantics that has to be known by the advice programmer. Then s/he
;; can access these arguments in a piece of advice with some of the
;; following macros (the arrows indicate what value they will return):
@@ -438,17 +385,17 @@
;; `(ad-get-arg <position>)' will return the actual argument that was supplied
;; at <position>, `(ad-get-args <position>)' will return the list of actual
-;; arguments supplied starting at <position>. Note that these macros can be
+;; arguments supplied starting at <position>. Note that these macros can be
;; used without any knowledge about the form of the actual argument list of
;; the original function.
;; Similarly, `(ad-set-arg <position> <value-form>)' can be used to set the
-;; value of the actual argument at <position> to <value-form>. For example,
+;; value of the actual argument at <position> to <value-form>. For example,
;;
;; (ad-set-arg 5 "five")
;;
;; will have the effect that R=(3 4 "five" 6) once the original function is
-;; called. `(ad-set-args <position> <value-list-form>)' can be used to set
+;; called. `(ad-set-args <position> <value-list-form>)' can be used to set
;; the list of actual arguments starting at <position> to <value-list-form>.
;; For example,
;;
@@ -457,7 +404,7 @@
;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original
;; function is called.
-;; All these access macros are text macros rather than real Lisp macros. When
+;; All these access macros are text macros rather than real Lisp macros. When
;; the advised definition gets constructed they get replaced with actual access
;; forms depending on the argument list of the advised function, i.e., after
;; that argument access is in most cases as efficient as using the argument
@@ -467,7 +414,7 @@
;; =======================================================
;; Some functions (such as `trace-function' defined in trace.el) need a
;; method of accessing the names and bindings of the arguments of an
-;; arbitrary advised function. To do that within an advice one can use the
+;; arbitrary advised function. To do that within an advice one can use the
;; special keyword `ad-arg-bindings' which is a text macro that will be
;; substituted with a form that will evaluate to a list of binding
;; specifications, one for every argument variable. These binding
@@ -491,26 +438,23 @@
;; @@@ Argument list mapping:
;; ==========================
-;; Because `defadvice' allows the specification of the argument list of the
-;; advised function we need a mapping mechanism that maps this argument list
-;; onto that of the original function. For example, somebody might specify
-;; `(sym newdef)' as the argument list of `fset', while advice might use
-;; `(&rest ad-subr-args)' as the argument list of the original function
-;; (depending on what Emacs version is used). Hence SYM and NEWDEF have to
-;; be properly mapped onto the &rest variable when the original definition is
-;; called. Advice automatically takes care of that mapping, hence, the advice
-;; programmer can specify an argument list without having to know about the
-;; exact structure of the original argument list as long as the new argument
-;; list takes a compatible number/magnitude of actual arguments.
+;; Because `defadvice' allows the specification of the argument list
+;; of the advised function we need a mapping mechanism that maps this
+;; argument list onto that of the original function. Hence SYM and
+;; NEWDEF have to be properly mapped onto the &rest variable when the
+;; original definition is called. Advice automatically takes care of
+;; that mapping, hence, the advice programmer can specify an argument
+;; list without having to know about the exact structure of the
+;; original argument list as long as the new argument list takes a
+;; compatible number/magnitude of actual arguments.
;; @@ Activation and deactivation:
;; ===============================
;; The definition of an advised function does not change until all its advice
-;; gets actually activated. Activation can either happen with the `activate'
+;; gets actually activated. Activation can either happen with the `activate'
;; flag specified in the `defadvice', with an explicit call or interactive
-;; invocation of `ad-activate', or if forward advice is enabled (i.e., the
-;; value of `ad-activate-on-definition' is t) at the time an already advised
-;; function gets defined.
+;; invocation of `ad-activate', or at the time an already advised function
+;; gets defined.
;; When a function gets first activated its original definition gets saved,
;; all defined and enabled pieces of advice will get combined with the
@@ -528,7 +472,7 @@
;; the file that contained the `defadvice' with the `preactivate' flag.
;; `ad-deactivate' can be used to back-define an advised function to its
-;; original definition. It can be called interactively or directly. Because
+;; original definition. It can be called interactively or directly. Because
;; `ad-activate' caches the advised definition the function can be
;; reactivated via `ad-activate' with only minor overhead (it is checked
;; whether the current advice state is consistent with the cached
@@ -536,12 +480,12 @@
;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate
;; all currently advised function that have a piece of advice with a name that
-;; contains a match for a regular expression. These functions can be used to
+;; contains a match for a regular expression. These functions can be used to
;; de/activate sets of functions depending on certain advice naming
;; conventions.
;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to
-;; de/activate all currently advised functions. These are useful to
+;; de/activate all currently advised functions. These are useful to
;; (temporarily) return to an un/advised state.
;; @@@ Reasons for the separation of advice definition and activation:
@@ -553,31 +497,26 @@
;; The advantage of this is that various pieces of advice can be defined
;; before they get combined into an advised definition which avoids
-;; unnecessary constructions of intermediate advised definitions. The more
+;; unnecessary constructions of intermediate advised definitions. The more
;; important advantage is that it allows the implementation of forward advice.
;; Advice information for a certain function accumulates as the value of the
-;; `advice-info' property of the function symbol. This accumulation is
+;; `advice-info' property of the function symbol. This accumulation is
;; completely independent of the fact that that function might not yet be
-;; defined. The special forms `defun' and `defmacro' have been advised to
-;; check whether the function/macro they defined had advice information
-;; associated with it. If so and forward advice is enabled, the original
-;; definition will be saved, and then the advice will be activated. When a
-;; file is loaded in a v18 Emacs the functions/macros it defines are also
-;; defined with calls to `defun/defmacro'. Hence, we can forward advise
-;; functions/macros which will be defined later during a load/autoload of some
-;; file (for compiled files generated by jwz's byte-compiler in a v19 Emacs
-;; this is slightly more complicated but the basic idea is the same).
+;; defined. The macros `defun' and `defmacro' check whether the
+;; function/macro they defined had advice information
+;; associated with it. If so and forward advice is enabled, the original
+;; definition will be saved, and then the advice will be activated.
;; @@ Enabling/disabling pieces or sets of advice:
;; ===============================================
;; A major motivation for the development of this advice package was to bring
;; a little bit more structure into the function overloading chaos in Emacs
-;; Lisp. Many packages achieve some of their functionality by adding a little
+;; Lisp. Many packages achieve some of their functionality by adding a little
;; bit (or a lot) to the standard functionality of some Emacs Lisp function.
-;; ange-ftp is a very popular package that achieves its magic by overloading
-;; most Emacs Lisp functions that deal with files. A popular function that's
-;; overloaded by many packages is `expand-file-name'. The situation that one
-;; function is multiply overloaded can arise easily.
+;; ange-ftp is a very popular package that used to achieve its magic by
+;; overloading most Emacs Lisp functions that deal with files. A popular
+;; function that's overloaded by many packages is `expand-file-name'.
+;; The situation that one function is multiply overloaded can arise easily.
;; Once in a while it would be desirable to be able to disable some/all
;; overloads of a particular package while keeping all the rest. Ideally -
@@ -585,7 +524,7 @@
;; I know I am dreaming right now... In that ideal case the enable/disable
;; mechanism of advice could be used to achieve just that.
-;; Every piece of advice is associated with an enablement flag. When the
+;; Every piece of advice is associated with an enablement flag. When the
;; advised definition of a particular function gets constructed (e.g., during
;; activation) only the currently enabled pieces of advice will be considered.
;; This mechanism allows one to have different "views" of an advised function
@@ -593,17 +532,15 @@
;; Another motivation for this mechanism is that it allows one to define a
;; piece of advice for some function yet keep it dormant until a certain
-;; condition is met. Until then activation of the function will not make use
-;; of that piece of advice. Once the condition is met the advice can be
+;; condition is met. Until then activation of the function will not make use
+;; of that piece of advice. Once the condition is met the advice can be
;; enabled and a reactivation of the function will add its functionality as
-;; part of the new advised definition. For example, the advices of `defun'
-;; etc. used by advice itself will stay disabled until `ad-start-advice' is
-;; called and some variables have the proper values. Hence, if somebody
+;; part of the new advised definition. Hence, if somebody
;; else advised these functions too and activates them the advices defined
;; by advice will get used only if they are intended to be used.
;; The main interface to this mechanism are the interactive functions
-;; `ad-enable-advice' and `ad-disable-advice'. For example, the following
+;; `ad-enable-advice' and `ad-disable-advice'. For example, the following
;; would disable a particular advice of the function `foo':
;;
;; (ad-disable-advice 'foo 'before 'my-advice)
@@ -613,28 +550,28 @@
;;
;; (ad-activate 'foo)
;;
-;; or interactively. To disable whole sets of advices one can use a regular
-;; expression mechanism. For example, let us assume that ange-ftp actually
+;; or interactively. To disable whole sets of advices one can use a regular
+;; expression mechanism. For example, let us assume that ange-ftp actually
;; used advice to overload all its functions, and that it used the
;; "ange-ftp-" prefix for all its advice names, then we could temporarily
;; disable all its advices with
;;
-;; (ad-disable-regexp "^ange-ftp-")
+;; (ad-disable-regexp "\\`ange-ftp-")
;;
;; and the following call would put that actually into effect:
;;
-;; (ad-activate-regexp "^ange-ftp-")
+;; (ad-activate-regexp "\\`ange-ftp-")
;;
;; A safer way would have been to use
;;
-;; (ad-update-regexp "^ange-ftp-")
+;; (ad-update-regexp "\\`ange-ftp-")
;;
;; instead which would have only reactivated currently actively advised
-;; functions, but not functions that were currently inactive. All these
+;; functions, but not functions that were currently inactive. All these
;; functions can also be called interactively.
;; A certain piece of advice is considered a match if its name contains a
-;; match for the regular expression. To enable ange-ftp again we would use
+;; match for the regular expression. To enable ange-ftp again we would use
;; `ad-enable-regexp' and then activate or update again.
;; @@ Forward advice, automatic advice activation:
@@ -653,7 +590,7 @@
;; of advice definition and activation that makes it possible to accumulate
;; advice information without having the original function already defined,
;; 2) special versions of the built-in functions `fset/defalias' which check
-;; for advice information whenever they define a function. If advice
+;; for advice information whenever they define a function. If advice
;; information was found then the advice will immediately get activated when
;; the function gets defined.
@@ -662,16 +599,11 @@
;; file, and the function has some advice-info stored with it then that
;; advice will get activated right away.
-;; @@@ Enabling automatic advice activation:
-;; =========================================
-;; Automatic advice activation is enabled by default. It can be disabled with
-;; `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'.
-
;; @@ Caching of advised definitions:
;; ==================================
;; After an advised definition got constructed it gets cached as part of the
;; advised function's advice-info so it can be reused, for example, after an
-;; intermediate deactivation. Because the advice-info of a function might
+;; intermediate deactivation. Because the advice-info of a function might
;; change between the time of caching and reuse a cached definition gets
;; a cache-id associated with it so it can be verified whether the cached
;; definition is still valid (the main application of this is preactivation
@@ -679,19 +611,19 @@
;; When an advised function gets activated and a verifiable cached definition
;; is available, then that definition will be used instead of creating a new
-;; advised definition from scratch. If you want to make sure that a new
+;; advised definition from scratch. If you want to make sure that a new
;; definition gets constructed then you should use `ad-clear-cache' before you
;; activate the advised function.
;; @@ Preactivation:
;; =================
-;; Constructing an advised definition is moderately expensive. In a situation
+;; Constructing an advised definition is moderately expensive. In a situation
;; where one package defines a lot of advised functions it might be
;; prohibitively expensive to do all the advised definition construction at
-;; runtime. Preactivation is a mechanism that allows compile-time construction
+;; runtime. Preactivation is a mechanism that allows compile-time construction
;; of compiled advised definitions that can be activated cheaply during
-;; runtime. Preactivation uses the caching mechanism to do that. Here's how it
-;; works:
+;; runtime. Preactivation uses the caching mechanism to do that. Here's how
+;; it works:
;; When the byte-compiler compiles a `defadvice' that has the `preactivate'
;; flag specified, it uses the current original definition of the advised
@@ -699,32 +631,30 @@
;; specified as disabled) and all other currently enabled pieces of advice to
;; construct an advised definition and an identifying cache-id and makes them
;; part of the `defadvice' expansion which will then be compiled by the
-;; byte-compiler (to ensure that in a v18 emacs you have to put the
-;; `defadvice' inside a `defun' to get it compiled and then you have to call
-;; that compiled `defun' in order to actually execute the `defadvice'). When
-;; the file with the compiled, preactivating `defadvice' gets loaded the
+;; byte-compiler.
+;; When the file with the compiled, preactivating `defadvice' gets loaded the
;; precompiled advised definition will be cached on the advised function's
-;; advice-info. When it gets activated (can be immediately on execution of the
+;; advice-info. When it gets activated (can be immediately on execution of the
;; `defadvice' or any time later) the cache-id gets checked against the
;; current state of advice and if it is verified the precompiled definition
-;; will be used directly (the verification is pretty cheap). If it couldn't get
-;; verified a new advised definition for that function will be built from
-;; scratch, hence, the efficiency added by the preactivation mechanism does
-;; not at all impair the flexibility of the advice mechanism.
+;; will be used directly (the verification is pretty cheap). If it couldn't
+;; get verified a new advised definition for that function will be built from
+;; scratch, hence, the efficiency added by the preactivation mechanism does not
+;; at all impair the flexibility of the advice mechanism.
;; MORAL: In order get all the efficiency out of preactivation the advice
;; state of an advised function at the time the file with the
;; preactivating `defadvice' gets byte-compiled should be exactly
;; the same as it will be when the advice of that function gets
-;; actually activated. If it is not there is a high chance that the
+;; actually activated. If it is not there is a high chance that the
;; cache-id will not match and hence a new advised definition will
;; have to be constructed at runtime.
-;; Preactivation and forward advice do not contradict each other. It is
+;; Preactivation and forward advice do not contradict each other. It is
;; perfectly ok to load a file with a preactivating `defadvice' before the
-;; original definition of the advised function is available. The constructed
+;; original definition of the advised function is available. The constructed
;; advised definition will be used once the original function gets defined and
-;; its advice gets activated. The only constraint is that at the time the
+;; its advice gets activated. The only constraint is that at the time the
;; file with the preactivating `defadvice' got compiled the original function
;; definition was available.
@@ -736,18 +666,18 @@
;; - `byte-compile' is part of the `features' variable even though you
;; did not use the byte-compiler
;; Right now advice does not provide an elegant way to find out whether
-;; and why a preactivation failed. What you can do is to trace the
+;; and why a preactivation failed. What you can do is to trace the
;; function `ad-cache-id-verification-code' (with the function
;; `trace-function-background' defined in my trace.el package) before
-;; any of your advised functions get activated. After they got
+;; any of your advised functions get activated. After they got
;; activated check whether all calls to `ad-cache-id-verification-code'
-;; returned `verified' as a result. Other values indicate why the
+;; returned `verified' as a result. Other values indicate why the
;; verification failed which should give you enough information to
;; fix your preactivation/compile/load/activation sequence.
;; IMPORTANT: There is one case (that I am aware of) that can make
;; preactivation fail, i.e., a preconstructed advised definition that does
-;; NOT match the current state of advice gets used nevertheless. That case
+;; NOT match the current state of advice gets used nevertheless. That case
;; arises if one package defines a certain piece of advice which gets used
;; during preactivation, and another package incompatibly redefines that
;; very advice (i.e., same function/class/name), and it is the second advice
@@ -759,30 +689,20 @@
;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with
;; George Walker Bush), and why would you redefine your own advice anyway?
;; Advice is a mechanism to facilitate function redefinition, not advice
-;; redefinition (wait until I write Meta-Advice :-). If you really have
-;; to undo somebody else's advice try to write a "neutralizing" advice.
+;; redefinition (wait until I write Meta-Advice :-). If you really have
+;; to undo somebody else's advice, try to write a "neutralizing" advice.
-;; @@ Advising macros and special forms and other dangerous things:
-;; ================================================================
+;; @@ Advising macros and other dangerous things:
+;; ==============================================
;; Look at the corresponding tutorial sections for more information on
-;; these topics. Here it suffices to point out that the special treatment
-;; of macros and special forms by the byte-compiler can lead to problems
-;; when they get advised. Macros can create problems because they get
-;; expanded at compile time, hence, they might not have all the necessary
-;; runtime support and such advice cannot be de/activated or changed as
-;; it is possible for functions. Special forms create problems because they
-;; have to be advised "into" macros, i.e., an advised special form is a
-;; implemented as a macro, hence, in most cases the byte-compiler will
-;; not recognize it as a special form anymore which can lead to very strange
-;; results.
-;;
-;; MORAL: - Only advise macros or special forms when you are absolutely sure
-;; what you are doing.
-;; - As a safety measure, always do `ad-deactivate-all' before you
-;; byte-compile a file to make sure that even if some inconsiderate
-;; person advised some special forms you'll get proper compilation
-;; results. After compilation do `ad-activate-all' to get back to
-;; the previous state.
+;; these topics. Here it suffices to point out that the special treatment
+;; of macros can lead to problems when they get advised. Macros can create
+;; problems because they get expanded at compile or load time, hence, they
+;; might not have all the necessary runtime support and such advice cannot be
+;; de/activated or changed as it is possible for functions.
+;; Special forms cannot be advised.
+;;
+;; MORAL: - Only advise macros when you are absolutely sure what you are doing.
;; @@ Adding a piece of advice with `ad-add-advice':
;; =================================================
@@ -793,12 +713,11 @@
;; @@ Activation/deactivation advices, file load hooks:
;; ====================================================
;; There are two special classes of advice called `activation' and
-;; `deactivation'. The body forms of these advices are not included into the
+;; `deactivation'. The body forms of these advices are not included into the
;; advised definition of a function, rather they are assembled into a hook
;; form which will be evaluated whenever the advice-info of the advised
-;; function gets activated or deactivated. One application of this mechanism
-;; is to define file load hooks for files that do not provide such hooks
-;; (v19s already come with a general file-load-hook mechanism, v18s don't).
+;; function gets activated or deactivated. One application of this mechanism
+;; is to define file load hooks for files that do not provide such hooks.
;; For example, suppose you want to print a message whenever `file-x' gets
;; loaded, and suppose the last function defined in `file-x' is
;; `file-x-last-fn'. Then we can define the following advice:
@@ -809,7 +728,7 @@
;;
;; This will constitute a forward advice for function `file-x-last-fn' which
;; will get activated when `file-x' is loaded (only if forward advice is
-;; enabled of course). Because there are no "real" pieces of advice
+;; enabled of course). Because there are no "real" pieces of advice
;; available for it, its definition will not be changed, but the activation
;; advice will be run during its activation which is equivalent to having a
;; file load hook for `file-x'.
@@ -824,14 +743,14 @@
;; enabled advices are considered during construction of an advised
;; definition.
;; - Activation:
-;; Redefine an advised function with its advised definition. Constructs
+;; Redefine an advised function with its advised definition. Constructs
;; an advised definition from scratch if no verifiable cached advised
;; definition is available and caches it.
;; - Deactivation:
;; Back-define an advised function to its original definition.
;; - Update:
;; Reactivate an advised function but only if its advice is currently
-;; active. This can be used to bring all currently advised function up
+;; active. This can be used to bring all currently advised function up
;; to date with the current state of advice without also activating
;; currently inactive functions.
;; - Caching:
@@ -840,7 +759,7 @@
;; - Preactivation:
;; Is the construction of an advised definition according to the current
;; state of advice during byte-compilation of a file with a preactivating
-;; `defadvice'. That advised definition can then rather cheaply be used
+;; `defadvice'. That advised definition can then rather cheaply be used
;; during activation without having to construct an advised definition
;; from scratch at runtime.
@@ -884,9 +803,6 @@
;; @@ Summary of forms with special meanings when used within an advice:
;; =====================================================================
;; ad-return-value name of the return value variable (get/settable)
-;; ad-subr-args name of &rest argument variable used for advised
-;; subrs whose actual argument list cannot be
-;; determined (get/settable)
;; (ad-get-arg <pos>), (ad-get-args <pos>),
;; (ad-set-arg <pos> <value>), (ad-set-args <pos> <value-list>)
;; argument access text macros to get/set the values of
@@ -903,12 +819,8 @@
;; @ Foo games: An advice tutorial
;; ===============================
-;; The following tutorial was created in Emacs 18.59. Left-justified
+;; The following tutorial was created in Emacs 18.59. Left-justified
;; s-expressions are input forms followed by one or more result forms.
-;; First we have to start the advice magic:
-;;
-;; (ad-start-advice)
-;; nil
;;
;; We start by defining an innocent looking function `foo' that simply
;; adds 1 to its argument X:
@@ -1031,19 +943,6 @@
;; (call-interactively 'foo)
;; 6
;;
-;; Let's have a look at what the definition of `foo' looks like now
-;; (indentation added by hand for legibility):
-;;
-;; (symbol-function 'foo)
-;; (lambda (x)
-;; "$ad-doc: foo$"
-;; (interactive (list 5))
-;; (let (ad-return-value)
-;; (setq x (1- x))
-;; (setq x (1+ x))
-;; (setq ad-return-value (ad-Orig-foo x))
-;; ad-return-value))
-;;
;; @@ Around advices:
;; ==================
;; Now we'll try some `around' advices. An around advice is a wrapper around
@@ -1081,20 +980,6 @@
;; (foo 3)
;; 8
;;
-;; Again, let's see what the definition of `foo' looks like so far:
-;;
-;; (symbol-function 'foo)
-;; (lambda (x)
-;; "$ad-doc: foo$"
-;; (interactive (list 5))
-;; (let (ad-return-value)
-;; (setq x (1- x))
-;; (setq x (1+ x))
-;; (let ((x (* x 2)))
-;; (let ((x (1+ x)))
-;; (setq ad-return-value (ad-Orig-foo x))))
-;; ad-return-value))
-;;
;; @@ Controlling advice activation:
;; =================================
;; In every `defadvice' so far we have used the flag `activate' to activate
@@ -1114,9 +999,9 @@
;; 8
;;
;; Now we define another advice and activate which will also activate the
-;; previous advice `fg-times-x'. Note the use of the special variable
+;; previous advice `fg-times-x'. Note the use of the special variable
;; `ad-return-value' in the body of the advice which is set to the result of
-;; the original function. If we change its value then the value returned by
+;; the original function. If we change its value then the value returned by
;; the advised function will be changed accordingly:
;;
;; (defadvice foo (after fg-times-x-again act)
@@ -1164,24 +1049,6 @@
;; "Let's clean up now!"
;; error-in-foo
;;
-;; Again, let's see what `foo' looks like:
-;;
-;; (symbol-function 'foo)
-;; (lambda (x)
-;; "$ad-doc: foo$"
-;; (interactive (list 5))
-;; (let (ad-return-value)
-;; (unwind-protect
-;; (progn (setq x (1- x))
-;; (setq x (1+ x))
-;; (let ((x (* x 2)))
-;; (let ((x (1+ x)))
-;; (setq ad-return-value (ad-Orig-foo x))))
-;; (setq ad-return-value (* ad-return-value x))
-;; (setq ad-return-value (* ad-return-value x)))
-;; (print "Let's clean up now!"))
-;; ad-return-value))
-;;
;; @@ Compilation of advised definitions:
;; ======================================
;; Finally, we can specify the `compile' keyword in a `defadvice' to say
@@ -1193,13 +1060,10 @@
;; (print "Let's clean up now!"))
;; foo
;;
-;; Now `foo' is byte-compiled:
+;; Now `foo's advice is byte-compiled:
;;
-;; (symbol-function 'foo)
-;; (lambda (x)
-;; "$ad-doc: foo$"
-;; (interactive (byte-code "....." [5] 1))
-;; (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6))
+;; (byte-code-function-p 'ad-Advice-foo)
+;; t
;;
;; (foo 3)
;; "Let's clean up now!"
@@ -1305,7 +1169,7 @@
;; deactivate functions that have a piece of advice defined by a certain
;; package (we save the old definition to check out caching):
;;
-;; (setq old-definition (symbol-function 'foo))
+;; (setq old-definition (symbol-function 'ad-Advice-foo))
;; (lambda (x) ....)
;;
;; (ad-deactivate-regexp "^fg-")
@@ -1317,7 +1181,7 @@
;; (ad-activate-regexp "^fg-")
;; nil
;;
-;; (eq old-definition (symbol-function 'foo))
+;; (eq old-definition (symbol-function 'ad-Advice-foo))
;; t
;;
;; (foo 3)
@@ -1326,14 +1190,6 @@
;;
;; @@ Forward advice:
;; ==================
-;; To enable automatic activation of forward advice we first have to set
-;; `ad-activate-on-definition' to t and restart advice:
-;;
-;; (setq ad-activate-on-definition t)
-;; t
-;;
-;; (ad-start-advice)
-;; (ad-activate-defined-function)
;;
;; Let's define a piece of advice for an undefined function:
;;
@@ -1346,9 +1202,7 @@
;; (fboundp 'bar)
;; nil
;;
-;; Now we define it and the forward advice will get activated (only because
-;; `ad-activate-on-definition' was t when we started advice above with
-;; `ad-start-advice'):
+;; Now we define it and the forward advice will get activated:
;;
;; (defun bar (x)
;; "Subtract 1 from X."
@@ -1400,7 +1254,7 @@
;; (ad-activate 'fie)
;; fie
;;
-;; (eq cached-definition (symbol-function 'fie))
+;; (eq cached-definition (symbol-function 'ad-Advice-fie))
;; t
;;
;; (fie 2)
@@ -1408,8 +1262,8 @@
;;
;; If you put a preactivating `defadvice' into a Lisp file that gets byte-
;; compiled then the constructed advised definition will get compiled by
-;; the byte-compiler. For that to occur in a v18 emacs you have to put the
-;; `defadvice' inside a `defun' because the v18 compiler does not compile
+;; the byte-compiler. For that to occur in a v18 Emacs you had to put the
+;; `defadvice' inside a `defun' because the v18 compiler did not compile
;; top-level forms other than `defun' or `defmacro', for example,
;;
;; (defun fg-defadvice-fum ()
@@ -1450,18 +1304,16 @@
;; constructed during preactivation was used, even though we did not specify
;; the `compile' flag:
;;
-;; (symbol-function 'fum)
-;; (lambda (x)
-;; "$ad-doc: fum$"
-;; (byte-code "....." [ad-return-value x nil * 2 ad-Orig-fum] 4))
+;; (byte-code-function-p 'ad-Advice-fum)
+;; t
;;
;; (fum 2)
;; 8
;;
;; A preactivated definition will only be used if it matches the current
-;; function definition and advice information. If it does not match it
+;; function definition and advice information. If it does not match it
;; will simply be discarded and a new advised definition will be constructed
-;; from scratch. For example, let's first remove all advice-info for `fum':
+;; from scratch. For example, let's first remove all advice-info for `fum':
;;
;; (ad-unadvise 'fum)
;; (("fie") ("bar") ("foo") ...)
@@ -1474,7 +1326,7 @@
;; fum
;;
;; When we now try to use a preactivation it will not be used because the
-;; current advice state is different from the one at preactivation time. This
+;; current advice state is different from the one at preactivation time. This
;; is no tragedy, everything will work as expected just not as efficient,
;; because a new advised definition has to be constructed from scratch:
;;
@@ -1483,7 +1335,7 @@
;;
;; A new uncompiled advised definition got constructed:
;;
-;; (ad-compiled-p (symbol-function 'fum))
+;; (byte-code-function-p 'ad-Advice-fum)
;; nil
;;
;; (fum 2)
@@ -1491,7 +1343,7 @@
;;
;; MORAL: To get all the efficiency out of preactivation the function
;; definition and advice state at preactivation time must be the same as the
-;; state at activation time. Preactivation does work with forward advice, all
+;; state at activation time. Preactivation does work with forward advice, all
;; that's necessary is that the definition of the forward advised function is
;; available when the `defadvice' with the preactivation gets compiled.
;;
@@ -1504,10 +1356,7 @@
;; if one advises a subr such as `eval-region' which then gets redefined by
;; some package (e.g., edebug) into a function with different argument names,
;; then a piece of advice written for `eval-region' that was written with
-;; the subr arguments in mind will break. Similar situations arise when one
-;; switches between major Emacs versions, e.g., certain subrs in v18 are
-;; functions in v19 and vice versa. Also, in v19s subr argument lists
-;; are available and will be used, while they are not available in v18.
+;; the subr arguments in mind will break.
;;
;; Argument access text macros allow one to access arguments of an advised
;; function in a portable way without having to worry about all these
@@ -1748,13 +1597,9 @@
;; @@ Compilation idiosyncrasies:
;; ==============================
-;; `defadvice' expansion needs quite a few advice functions and variables,
-;; hence, I need to preload the file before it can be compiled. To avoid
-;; interference of bogus compiled files I always preload the source file:
-(provide 'advice-preload)
-;; During a normal load this is a noop:
-(require 'advice-preload "advice.el")
-
+(require 'macroexp)
+;; At run-time also, since ad-do-advised-functions returns code that uses it.
+(eval-when-compile (require 'cl-lib))
;; @@ Variable definitions:
;; ========================
@@ -1820,84 +1665,6 @@ generates a copy of TREE."
(funcall fUnCtIoN tReE))
(t tReE)))
-;; this is just faster than `ad-substitute-tree':
-(defun ad-copy-tree (tree)
- "Return a copy of the list structure of TREE."
- (cond ((consp tree)
- (cons (ad-copy-tree (car tree))
- (ad-copy-tree (cdr tree))))
- (t tree)))
-
-(defmacro ad-dolist (varform &rest body)
- "A Common-Lisp-style dolist iterator with the following syntax:
-
- (ad-dolist (VAR INIT-FORM [RESULT-FORM])
- BODY-FORM...)
-
-which will iterate over the list yielded by INIT-FORM binding VAR to the
-current head at every iteration. If RESULT-FORM is supplied its value will
-be returned at the end of the iteration, nil otherwise. The iteration can be
-exited prematurely with `(ad-do-return [VALUE])'."
- (let ((expansion
- `(let ((ad-dO-vAr ,(car (cdr varform)))
- ,(car varform))
- (while ad-dO-vAr
- (setq ,(car varform) (car ad-dO-vAr))
- ,@body
- ;;work around a backquote bug:
- ;;(` ((,@ '(foo)) (bar))) => (append '(foo) '(((bar)))) wrong
- ;;(` ((,@ '(foo)) (, '(bar)))) => (append '(foo) (list '(bar)))
- ,'(setq ad-dO-vAr (cdr ad-dO-vAr)))
- ,(car (cdr (cdr varform))))))
- ;;ok, this wastes some cons cells but only during compilation:
- (if (catch 'contains-return
- (ad-substitute-tree
- (function (lambda (subtree)
- (cond ((eq (car-safe subtree) 'ad-dolist))
- ((eq (car-safe subtree) 'ad-do-return)
- (throw 'contains-return t)))))
- 'identity body)
- nil)
- `(catch 'ad-dO-eXiT ,expansion)
- expansion)))
-
-(defmacro ad-do-return (value)
- `(throw 'ad-dO-eXiT ,value))
-
-(if (not (get 'ad-dolist 'lisp-indent-hook))
- (put 'ad-dolist 'lisp-indent-hook 1))
-
-
-;; @@ Save real definitions of subrs used by Advice:
-;; =================================================
-;; Advice depends on the real, unmodified functionality of various subrs,
-;; we save them here so advised versions will not interfere (eventually,
-;; we will save all subrs used in code generated by Advice):
-
-(defmacro ad-save-real-definition (function)
- (let ((saved-function (intern (format "ad-real-%s" function))))
- ;; Make sure the compiler is loaded during macro expansion:
- (require 'byte-compile "bytecomp")
- `(if (not (fboundp ',saved-function))
- (progn (fset ',saved-function (symbol-function ',function))
- ;; Copy byte-compiler properties:
- ,@(if (get function 'byte-compile)
- `((put ',saved-function 'byte-compile
- ',(get function 'byte-compile))))
- ,@(if (get function 'byte-opcode)
- `((put ',saved-function 'byte-opcode
- ',(get function 'byte-opcode))))))))
-
-(defun ad-save-real-definitions ()
- ;; Macro expansion will hardcode the values of the various byte-compiler
- ;; properties into the compiled version of this function such that the
- ;; proper values will be available at runtime without loading the compiler:
- (ad-save-real-definition fset)
- (ad-save-real-definition documentation))
-
-(ad-save-real-definitions)
-
-
;; @@ Advice info access fns:
;; ==========================
@@ -1911,7 +1678,7 @@ exited prematurely with `(ad-do-return [VALUE])'."
;; (after adv1 adv2 ...)
;; (activation adv1 adv2 ...)
;; (deactivation adv1 adv2 ...)
-;; (origname . <symbol fbound to origdef>)
+;; (advicefunname . <symbol fbound to assembled advice function>)
;; (cache . (<advised-definition> . <id>)))
;; List of currently advised though not necessarily activated functions
@@ -1932,19 +1699,15 @@ exited prematurely with `(ad-do-return [VALUE])'."
ad-advised-functions)))
(defmacro ad-do-advised-functions (varform &rest body)
- "`ad-dolist'-style iterator that maps over `ad-advised-functions'.
-\(ad-do-advised-functions (VAR [RESULT-FORM])
+ "`dolist'-style iterator that maps over advised functions.
+\(ad-do-advised-functions (VAR)
BODY-FORM...)
On each iteration VAR will be bound to the name of an advised function
\(a symbol)."
- `(ad-dolist (,(car varform)
- ad-advised-functions
- ,(car (cdr varform)))
- (setq ,(car varform) (intern (car ,(car varform))))
- ,@body))
-
-(if (not (get 'ad-do-advised-functions 'lisp-indent-hook))
- (put 'ad-do-advised-functions 'lisp-indent-hook 1))
+ (declare (indent 1))
+ `(dolist (,(car varform) ad-advised-functions)
+ (setq ,(car varform) (intern (car ,(car varform))))
+ ,@body))
(defun ad-get-advice-info (function)
(get function 'ad-advice-info))
@@ -1952,16 +1715,23 @@ On each iteration VAR will be bound to the name of an advised function
(defmacro ad-get-advice-info-macro (function)
`(get ,function 'ad-advice-info))
-(defmacro ad-set-advice-info (function advice-info)
- `(put ,function 'ad-advice-info ,advice-info))
+(defsubst ad-set-advice-info (function advice-info)
+ (cond
+ (advice-info
+ (add-function :around (get function 'defalias-fset-function)
+ #'ad--defalias-fset))
+ ((get function 'defalias-fset-function)
+ (remove-function (get function 'defalias-fset-function)
+ #'ad--defalias-fset)))
+ (put function 'ad-advice-info advice-info))
(defmacro ad-copy-advice-info (function)
- `(ad-copy-tree (get ,function 'ad-advice-info)))
+ `(copy-tree (get ,function 'ad-advice-info)))
(defmacro ad-is-advised (function)
"Return non-nil if FUNCTION has any advice info associated with it.
This does not mean that the advice is also active."
- (list 'ad-get-advice-info-macro function))
+ `(ad-get-advice-info-macro ,function))
(defun ad-initialize-advice-info (function)
"Initialize the advice info for FUNCTION.
@@ -2001,18 +1771,17 @@ either t or nil, and DEFINITION should be a list of the form
;; ad-find-advice uses the alist structure directly ->
;; change if this data structure changes!!
-(defmacro ad-advice-name (advice)
- (list 'car advice))
-(defmacro ad-advice-protected (advice)
- (list 'nth 1 advice))
-(defmacro ad-advice-enabled (advice)
- (list 'nth 2 advice))
-(defmacro ad-advice-definition (advice)
- (list 'nth 3 advice))
+(defsubst ad-advice-name (advice) (car advice))
+(defsubst ad-advice-protected (advice) (nth 1 advice))
+(defsubst ad-advice-enabled (advice) (nth 2 advice))
+(defsubst ad-advice-definition (advice) (nth 3 advice))
(defun ad-advice-set-enabled (advice flag)
(rplaca (cdr (cdr advice)) flag))
+(defvar ad-advice-classes '(before around after activation deactivation)
+ "List of defined advice classes.")
+
(defun ad-class-p (thing)
(memq thing ad-advice-classes))
(defun ad-name-p (thing)
@@ -2025,13 +1794,10 @@ either t or nil, and DEFINITION should be a list of the form
;; @@ Advice access functions:
;; ===========================
-;; List of defined advice classes:
-(defvar ad-advice-classes '(before around after activation deactivation))
-
(defun ad-has-enabled-advice (function class)
"True if at least one of FUNCTION's advices in CLASS is enabled."
- (ad-dolist (advice (ad-get-advice-info-field function class))
- (if (ad-advice-enabled advice) (ad-do-return t))))
+ (cl-dolist (advice (ad-get-advice-info-field function class))
+ (if (ad-advice-enabled advice) (cl-return t))))
(defun ad-has-redefining-advice (function)
"True if FUNCTION's advice info defines at least 1 redefining advice.
@@ -2044,14 +1810,14 @@ Redefining advices affect the construction of an advised definition."
(defun ad-has-any-advice (function)
"True if the advice info of FUNCTION defines at least one advice."
(and (ad-is-advised function)
- (ad-dolist (class ad-advice-classes nil)
+ (cl-dolist (class ad-advice-classes)
(if (ad-get-advice-info-field function class)
- (ad-do-return t)))))
+ (cl-return t)))))
(defun ad-get-enabled-advices (function class)
"Return the list of enabled advices of FUNCTION in CLASS."
(let (enabled-advices)
- (ad-dolist (advice (ad-get-advice-info-field function class))
+ (dolist (advice (ad-get-advice-info-field function class))
(if (ad-advice-enabled advice)
(push advice enabled-advices)))
(reverse enabled-advices)))
@@ -2060,76 +1826,30 @@ Redefining advices affect the construction of an advised definition."
;; @@ Dealing with automatic advice activation via `fset/defalias':
;; ================================================================
-;; Since Emacs 19.26 the built-in versions of `fset' and `defalias'
-;; take care of automatic advice activation, hence, we don't have to
-;; hack it anymore by advising `fset/defun/defmacro/byte-code/etc'.
+;; Automatic activation happens when a function gets defined via `defalias',
+;; which calls the `defalias-fset-function' (which we set to
+;; `ad--defalias-fset') instead of `fset', if non-nil.
-;; The functionality of the new `fset' is as follows:
-;;
-;; fset(sym,newdef)
-;; assign NEWDEF to SYM
-;; if (get SYM 'ad-advice-info)
-;; ad-activate-internal(SYM, nil)
-;; return (symbol-function SYM)
-;;
;; Whether advised definitions created by automatic activations will be
;; compiled depends on the value of `ad-default-compilation-action'.
-;; Since calling `ad-activate-internal' in the built-in definition of `fset' can
-;; create major disasters we have to be a bit careful. One precaution is
-;; to provide a dummy definition for `ad-activate-internal' which can be used to
-;; turn off automatic advice activation (e.g., when `ad-stop-advice' or
-;; `ad-recover-normality' are called). Another is to avoid recursive calls
-;; to `ad-activate' by using `ad-with-auto-activation-disabled' where
-;; appropriate, especially in a safe version of `fset'.
+(defalias 'ad-activate-internal 'ad-activate)
-;; For now define `ad-activate-internal' to the dummy definition:
-(defun ad-activate-internal (function &optional compile)
- "Automatic advice activation is disabled. `ad-start-advice' enables it."
- nil)
+(defun ad-make-advicefunname (function)
+ "Make name to be used to call the assembled advice function."
+ (intern (format "ad-Advice-%s" function)))
-;; This is just a copy of the above:
-(defun ad-activate-internal-off (function &optional compile)
- "Automatic advice activation is disabled. `ad-start-advice' enables it."
- nil)
+(defun ad-get-orig-definition (function) ;FIXME: Rename to "-unadvised-".
+ (if (symbolp function)
+ (setq function (if (fboundp function)
+ (advice--strip-macro (symbol-function function)))))
+ (while (advice--p function) (setq function (advice--cdr function)))
+ function)
-;; This will be t for top-level calls to `ad-activate-internal-on':
-(defvar ad-activate-on-top-level t)
-
-(defmacro ad-with-auto-activation-disabled (&rest body)
- `(let ((ad-activate-on-top-level nil))
- ,@body))
-
-(defun ad-safe-fset (symbol definition)
- "A safe `fset' which will never call `ad-activate-internal' recursively."
- (ad-with-auto-activation-disabled
- (ad-real-fset symbol definition)))
-
-
-;; @@ Access functions for original definitions:
-;; ============================================
-;; The advice-info of an advised function contains its `origname' which is
-;; a symbol that is fbound to the original definition available at the first
-;; proper activation of the function after a valid re/definition. If the
-;; original was defined via fcell indirection then `origname' will be defined
-;; just so. Hence, to get hold of the actual original definition of a function
-;; we need to use `ad-real-orig-definition'.
-
-(defun ad-make-origname (function)
- "Make name to be used to call the original FUNCTION."
- (intern (format "ad-Orig-%s" function)))
-
-(defmacro ad-get-orig-definition (function)
- `(let ((origname (ad-get-advice-info-field ,function 'origname)))
- (if (fboundp origname)
- (symbol-function origname))))
-
-(defmacro ad-set-orig-definition (function definition)
- `(ad-safe-fset
- (ad-get-advice-info-field ,function 'origname) ,definition))
-
-(defmacro ad-clear-orig-definition (function)
- `(fmakunbound (ad-get-advice-info-field ,function 'origname)))
+(defun ad-clear-advicefunname-definition (function)
+ (let ((advicefunname (ad-get-advice-info-field function 'advicefunname)))
+ (advice-remove function advicefunname)
+ (fmakunbound advicefunname)))
;; @@ Interactive input functions:
@@ -2147,7 +1867,7 @@ function at point for which PREDICATE returns non-nil)."
(error "ad-read-advised-function: There are no advised functions"))
(setq default
(or default
- ;; Prefer func name at point, if it's in ad-advised-functions etc.
+ ;; Prefer func name at point, if it's an advised function etc.
(let ((function (progn
(require 'help)
(function-called-at-point))))
@@ -2156,24 +1876,20 @@ function at point for which PREDICATE returns non-nil)."
(or (null predicate)
(funcall predicate function))
function))
- (ad-do-advised-functions (function)
- (if (or (null predicate)
- (funcall predicate function))
- (ad-do-return function)))
+ (cl-block nil
+ (ad-do-advised-functions (function)
+ (if (or (null predicate)
+ (funcall predicate function))
+ (cl-return function))))
(error "ad-read-advised-function: %s"
"There are no qualifying advised functions")))
- (let* ((ad-pReDiCaTe predicate)
- (function
+ (let* ((function
(completing-read
(format "%s (default %s): " (or prompt "Function") default)
ad-advised-functions
(if predicate
- (function
- (lambda (function)
- ;; Oops, no closures - the joys of dynamic scoping:
- ;; `predicate' clashed with the `predicate' argument
- ;; of Lemacs' `completing-read'.....
- (funcall ad-pReDiCaTe (intern (car function))))))
+ (lambda (function)
+ (funcall predicate (intern (car function)))))
t)))
(if (equal function "")
(if (ad-is-advised default)
@@ -2192,9 +1908,9 @@ be returned on empty input (defaults to the first non-empty advice
class of FUNCTION)."
(setq default
(or default
- (ad-dolist (class ad-advice-classes)
+ (cl-dolist (class ad-advice-classes)
(if (ad-get-advice-info-field function class)
- (ad-do-return class)))
+ (cl-return class)))
(error "ad-read-advice-class: `%s' has no advices" function)))
(let ((class (completing-read
(format "%s (default %s): " (or prompt "Class") default)
@@ -2263,18 +1979,18 @@ NAME can be a symbol or a regular expression matching part of an advice name.
If CLASS is `any' all valid advice classes will be checked."
(if (ad-is-advised function)
(let (found-advice)
- (ad-dolist (advice-class ad-advice-classes)
+ (cl-dolist (advice-class ad-advice-classes)
(if (or (eq class 'any) (eq advice-class class))
(setq found-advice
- (ad-dolist (advice (ad-get-advice-info-field
+ (cl-dolist (advice (ad-get-advice-info-field
function advice-class))
(if (or (and (stringp name)
(string-match
name (symbol-name
(ad-advice-name advice))))
(eq name (ad-advice-name advice)))
- (ad-do-return advice)))))
- (if found-advice (ad-do-return found-advice))))))
+ (cl-return advice)))))
+ (if found-advice (cl-return found-advice))))))
(defun ad-enable-advice-internal (function class name flag)
"Set enable FLAG of FUNCTION's advices in CLASS matching NAME.
@@ -2285,10 +2001,10 @@ considered. The number of changed advices will be returned (or nil if
FUNCTION was not advised)."
(if (ad-is-advised function)
(let ((matched-advices 0))
- (ad-dolist (advice-class ad-advice-classes)
+ (dolist (advice-class ad-advice-classes)
(if (or (eq class 'any) (eq advice-class class))
- (ad-dolist (advice (ad-get-advice-info-field
- function advice-class))
+ (dolist (advice (ad-get-advice-info-field
+ function advice-class))
(cond ((or (and (stringp name)
(string-match
name (symbol-name (ad-advice-name advice))))
@@ -2393,7 +2109,7 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
(cond ((not (ad-is-advised function))
(ad-initialize-advice-info function)
(ad-set-advice-info-field
- function 'origname (ad-make-origname function))))
+ function 'advicefunname (ad-make-advicefunname function))))
(let* ((previous-position
(ad-advice-position function class (ad-advice-name advice)))
(advices (ad-get-advice-info-field function class))
@@ -2426,12 +2142,6 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
"Take a macro function DEFINITION and make a lambda out of it."
`(cdr ,definition))
-(defun ad-special-form-p (definition)
- "Non-nil if and only if DEFINITION is a special form."
- (if (and (symbolp definition) (fboundp definition))
- (setq definition (indirect-function definition)))
- (and (subrp definition) (eq (cdr (subr-arity definition)) 'unevalled)))
-
(defmacro ad-subr-p (definition)
;;"non-nil if DEFINITION is a subr."
(list 'subrp definition))
@@ -2449,12 +2159,6 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
;;"non-nil if DEFINITION is a piece of advice."
`(eq (car-safe ,definition) 'advice))
-;; Emacs/Lemacs cross-compatibility
-;; (compiled-function-p is an obsolete function in Emacs):
-(if (and (not (fboundp 'byte-code-function-p))
- (fboundp 'compiled-function-p))
- (ad-safe-fset 'byte-code-function-p 'compiled-function-p))
-
(defmacro ad-compiled-p (definition)
"Return non-nil if DEFINITION is a compiled byte-code object."
`(or (byte-code-function-p ,definition)
@@ -2477,10 +2181,8 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
(cdr definition))
(t nil)))
-(defun ad-arglist (definition &optional name)
- "Return the argument list of DEFINITION.
-If DEFINITION could be from a subr then its NAME should be
-supplied to make subr arglist lookup more efficient."
+(defun ad-arglist (definition)
+ "Return the argument list of DEFINITION."
(require 'help-fns)
(help-function-arglist
(if (or (ad-macro-p definition) (ad-advice-p definition))
@@ -2492,7 +2194,7 @@ supplied to make subr arglist lookup more efficient."
"Return the unexpanded docstring of DEFINITION."
(let ((docstring
(if (ad-compiled-p definition)
- (ad-real-documentation definition t)
+ (documentation definition t)
(car (cdr (cdr (ad-lambda-expression definition)))))))
(if (or (stringp docstring)
(natnump docstring))
@@ -2515,13 +2217,16 @@ Like `interactive-form', but also works on pieces of advice."
(if (ad-interactive-form definition) 1 0))
(cdr (cdr (ad-lambda-expression definition)))))))
-(defun ad-make-advised-definition-docstring (function)
+(defun ad-make-advised-definition-docstring (_function)
"Make an identifying docstring for the advised definition of FUNCTION.
Put function name into the documentation string so we can infer
the name of the advised function from the docstring. This is needed
to generate a proper advised docstring even if we are just given a
definition (see the code for `documentation')."
- (propertize "Advice doc string" 'ad-advice-info function))
+ (eval-when-compile
+ (propertize "Advice function assembled by advice.el."
+ 'dynamic-docstring-function
+ #'ad--make-advised-docstring)))
(defun ad-advised-definition-p (definition)
"Return non-nil if DEFINITION was generated from advice information."
@@ -2530,27 +2235,26 @@ definition (see the code for `documentation')."
(ad-compiled-p definition))
(let ((docstring (ad-docstring definition)))
(and (stringp docstring)
- (get-text-property 0 'ad-advice-info docstring)))))
+ (get-text-property 0 'dynamic-docstring-function docstring)))))
(defun ad-definition-type (definition)
"Return symbol that describes the type of DEFINITION."
+ ;; These symbols are only ever used to check a cache entry's validity.
+ ;; The suffix `2' reflects the fact that we're using version 2 of advice
+ ;; representations, so cache entries preactivated with version
+ ;; 1 can't be used.
(cond
- ((ad-macro-p definition) 'macro)
- ((ad-subr-p definition)
- (if (ad-special-form-p definition)
- 'special-form
- 'subr))
- ((or (ad-lambda-p definition)
- (ad-compiled-p definition))
- 'function)
- ((ad-advice-p definition) 'advice)))
+ ((ad-macro-p definition) 'macro2)
+ ((ad-subr-p definition) 'subr2)
+ ((or (ad-lambda-p definition) (ad-compiled-p definition)) 'fun2)
+ ((ad-advice-p definition) 'advice2))) ;; FIXME: Can this ever happen?
(defun ad-has-proper-definition (function)
"True if FUNCTION is a symbol with a proper definition.
For that it has to be fbound with a non-autoload definition."
(and (symbolp function)
(fboundp function)
- (not (eq (car-safe (symbol-function function)) 'autoload))))
+ (not (autoloadp (symbol-function function)))))
;; The following two are necessary for the sake of packages such as
;; ange-ftp which redefine functions via fcell indirection:
@@ -2563,9 +2267,9 @@ For that it has to be fbound with a non-autoload definition."
definition))))
(defun ad-real-orig-definition (function)
- "Find FUNCTION's real original definition starting from its `origname'."
- (if (ad-is-advised function)
- (ad-real-definition (ad-get-advice-info-field function 'origname))))
+ (let* ((fun1 (ad-get-orig-definition function))
+ (fun2 (indirect-function fun1)))
+ (unless (autoloadp fun2) fun2)))
(defun ad-is-compilable (function)
"True if FUNCTION has an interpreted definition that can be compiled."
@@ -2574,60 +2278,17 @@ For that it has to be fbound with a non-autoload definition."
(ad-macro-p (symbol-function function)))
(not (ad-compiled-p (symbol-function function)))))
+(defvar warning-suppress-types) ;From warnings.el.
(defun ad-compile-function (function)
- "Byte-compiles FUNCTION (or macro) if it is not yet compiled."
- (interactive "aByte-compile function: ")
- (if (ad-is-compilable function)
- ;; Need to turn off auto-activation
- ;; because `byte-compile' uses `fset':
- (ad-with-auto-activation-disabled
- (require 'bytecomp)
- (require 'warnings) ;To define warning-suppress-types
- ;before we let-bind it.
- (let ((symbol (make-symbol "advice-compilation"))
- (byte-compile-warnings byte-compile-warnings)
- ;; Don't pop up windows showing byte-compiler warnings.
- (warning-suppress-types '((bytecomp))))
- (if (featurep 'cl)
- (byte-compile-disable-warning 'cl-functions))
- (fset symbol (symbol-function function))
- (byte-compile symbol)
- (fset function (symbol-function symbol))))))
-
-
-;; @@ Constructing advised definitions:
-;; ====================================
-;;
-;; Main design decisions about the form of advised definitions:
-;;
-;; A) How will original definitions be called?
-;; B) What will argument lists of advised functions look like?
-;;
-;; Ad A)
-;; I chose to use function indirection for all four types of original
-;; definitions (functions, macros, subrs and special forms), i.e., create
-;; a unique symbol `ad-Orig-<name>' which is fbound to the original
-;; definition and call it according to type and arguments. Functions and
-;; subrs that don't have any &rest arguments can be called directly in a
-;; `(ad-Orig-<name> ....)' form. If they have a &rest argument we have to
-;; use `apply'. Macros will be called with
-;; `(macroexpand '(ad-Orig-<name> ....))', and special forms also need a
-;; form like that with `eval' instead of `macroexpand'.
-;;
-;; Ad B)
-;; Use original arguments where possible and `(&rest ad-subr-args)'
-;; otherwise, even though this seems to be more complicated and less
-;; uniform than a general `(&rest args)' approach. My reason to still
-;; do it that way is that in most cases my approach leads to the more
-;; efficient form for the advised function, and portability (e.g., to
-;; make the same advice work regardless of whether something is a
-;; function or a subr) can still be achieved with argument access macros.
-
-
-(defun ad-prognify (forms)
- (cond ((<= (length forms) 1)
- (car forms))
- (t (cons 'progn forms))))
+ "Byte-compile the assembled advice function."
+ (require 'bytecomp)
+ (require 'warnings) ;To define warning-suppress-types before we let-bind it.
+ (let ((byte-compile-warnings byte-compile-warnings)
+ ;; Don't pop up windows showing byte-compiler warnings.
+ (warning-suppress-types '((bytecomp))))
+ (if (featurep 'cl)
+ (byte-compile-disable-warning 'cl-functions))
+ (byte-compile (ad-get-advice-info-field function 'advicefunname))))
;; @@@ Accessing argument lists:
;; =============================
@@ -2739,24 +2400,20 @@ The assignment starts at position INDEX."
(let ((values-index 0)
argument-access set-forms)
(while (setq argument-access (ad-access-argument arglist index))
- (if (symbolp argument-access)
- (setq set-forms
- (cons (ad-set-argument
- arglist index
- (ad-element-access values-index 'ad-vAlUeS))
- set-forms))
- (setq set-forms
- (cons (if (= (car argument-access) 0)
- (list 'setq
- (car (cdr argument-access))
- (ad-list-access values-index 'ad-vAlUeS))
- (list 'setcdr
- (ad-list-access (1- (car argument-access))
- (car (cdr argument-access)))
- (ad-list-access values-index 'ad-vAlUeS)))
- set-forms))
- ;; terminate loop
- (setq arglist nil))
+ (push (if (symbolp argument-access)
+ (ad-set-argument
+ arglist index
+ (ad-element-access values-index 'ad-vAlUeS))
+ (setq arglist nil) ;; Terminate loop.
+ (if (= (car argument-access) 0)
+ `(setq
+ ,(car (cdr argument-access))
+ ,(ad-list-access values-index 'ad-vAlUeS))
+ `(setcdr
+ ,(ad-list-access (1- (car argument-access))
+ (car (cdr argument-access)))
+ ,(ad-list-access values-index 'ad-vAlUeS))))
+ set-forms)
(setq index (1+ index))
(setq values-index (1+ values-index)))
(if (null set-forms)
@@ -2765,8 +2422,8 @@ The assignment starts at position INDEX."
(if (= (length set-forms) 1)
;; For exactly one set-form we can use values-form directly,...
(ad-substitute-tree
- (function (lambda (form) (eq form 'ad-vAlUeS)))
- (function (lambda (form) values-form))
+ (lambda (form) (eq form 'ad-vAlUeS))
+ (lambda (_form) values-form)
(car set-forms))
;; ...if we have more we have to bind it to a variable:
`(let ((ad-vAlUeS ,values-form))
@@ -2818,7 +2475,7 @@ Excess source arguments will be neglected, missing source arguments will be
supplied as nil. Returns a `funcall' or `apply' form with the second element
being `function' which has to be replaced by an actual function argument.
Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
- `(funcall function a (car args) (car (cdr args)) (nth 2 args))'."
+ `(funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))'."
(let* ((parsed-source-arglist (ad-parse-arglist source-arglist))
(source-reqopt-args (append (nth 0 parsed-source-arglist)
(nth 1 parsed-source-arglist)))
@@ -2832,15 +2489,14 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
;; This produces ``error-proof'' target function calls with the exception
;; of a case like (&rest a) mapped onto (x &rest y) where the actual args
;; supplied to A might not be enough to supply the required target arg X
- (append (list (if need-apply 'apply 'funcall) 'function)
+ (append (list (if need-apply 'apply 'funcall) 'ad--addoit-function)
(cond (need-apply
;; `apply' can take care of that directly:
(append source-reqopt-args (list source-rest-arg)))
- (t (mapcar (function
- (lambda (arg)
- (setq target-arg-index (1+ target-arg-index))
- (ad-get-argument
- source-arglist target-arg-index)))
+ (t (mapcar (lambda (_arg)
+ (setq target-arg-index (1+ target-arg-index))
+ (ad-get-argument
+ source-arglist target-arg-index))
(append target-reqopt-args
(and target-rest-arg
;; If we have a rest arg gobble up
@@ -2848,13 +2504,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
(nthcdr (length target-reqopt-args)
source-reqopt-args)))))))))
-(defun ad-make-mapped-call (source-arglist target-arglist target-function)
- "Make form to call TARGET-FUNCTION with args from SOURCE-ARGLIST."
- (let ((mapped-form (ad-map-arglists source-arglist target-arglist)))
- (if (eq (car mapped-form) 'funcall)
- (cons target-function (cdr (cdr mapped-form)))
- (prog1 mapped-form
- (setcar (cdr mapped-form) (list 'quote target-function))))))
;; @@@ Making an advised documentation string:
;; ===========================================
@@ -2871,11 +2520,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
(let ((advice-docstring (ad-docstring (ad-advice-definition advice))))
(cond ((eq style 'plain)
advice-docstring)
- ((eq style 'freeze)
- (format "Permanent %s-advice `%s':%s%s"
- class (ad-advice-name advice)
- (if advice-docstring "\n" "")
- (or advice-docstring "")))
(t (if advice-docstring
(format "%s-advice `%s':\n%s"
(capitalize (symbol-name class))
@@ -2887,27 +2531,24 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
(require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage.
-(defun ad-make-advised-docstring (function &optional style)
+(defun ad--make-advised-docstring (origdoc function &optional style)
"Construct a documentation string for the advised FUNCTION.
It concatenates the original documentation with the documentation
strings of the individual pieces of advice which will be formatted
-according to STYLE. STYLE can be `plain' or `freeze', everything else
+according to STYLE. STYLE can be `plain', everything else
will be interpreted as `default'. The order of the advice documentation
strings corresponds to before/around/after and the individual ordering
in any of these classes."
- (let* ((origdef (ad-real-orig-definition function))
- (origtype (symbol-name (ad-definition-type origdef)))
- (origdoc
- ;; Retrieve raw doc, key substitution will be taken care of later:
- (ad-real-documentation origdef t))
- (usage (help-split-fundoc origdoc function))
- paragraphs advice-docstring ad-usage)
+ (if (and (symbolp function)
+ (string-match "\\`ad-+Advice-" (symbol-name function)))
+ (setq function
+ (intern (substring (symbol-name function) (match-end 0)))))
+ (let* ((usage (help-split-fundoc origdoc function))
+ paragraphs advice-docstring)
(setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage)))
(if origdoc (setq paragraphs (list origdoc)))
- (unless (eq style 'plain)
- (push (concat "This " origtype " is advised.") paragraphs))
- (ad-dolist (class ad-advice-classes)
- (ad-dolist (advice (ad-get-enabled-advices function class))
+ (dolist (class ad-advice-classes)
+ (dolist (advice (ad-get-enabled-advices function class))
(setq advice-docstring
(ad-make-single-advice-docstring advice class style))
(if advice-docstring
@@ -2916,37 +2557,35 @@ in any of these classes."
(propertize
;; separate paragraphs with blank lines:
(mapconcat 'identity (nreverse paragraphs) "\n\n")
- 'ad-advice-info function)))
+ ;; FIXME: what is this for?
+ 'dynamic-docstring-function
+ #'ad--make-advised-docstring)))
(help-add-fundoc-usage origdoc usage)))
-(defun ad-make-plain-docstring (function)
- (ad-make-advised-docstring function 'plain))
-(defun ad-make-freeze-docstring (function)
- (ad-make-advised-docstring function 'freeze))
;; @@@ Accessing overriding arglists and interactive forms:
;; ========================================================
(defun ad-advised-arglist (function)
"Find first defined arglist in FUNCTION's redefining advices."
- (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
+ (cl-dolist (advice (append (ad-get-enabled-advices function 'before)
(ad-get-enabled-advices function 'around)
(ad-get-enabled-advices function 'after)))
(let ((arglist (ad-arglist (ad-advice-definition advice))))
(if arglist
;; We found the first one, use it:
- (ad-do-return arglist)))))
+ (cl-return arglist)))))
(defun ad-advised-interactive-form (function)
"Find first interactive form in FUNCTION's redefining advices."
- (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
+ (cl-dolist (advice (append (ad-get-enabled-advices function 'before)
(ad-get-enabled-advices function 'around)
(ad-get-enabled-advices function 'after)))
(let ((interactive-form
(ad-interactive-form (ad-advice-definition advice))))
(if interactive-form
;; We found the first one, use it:
- (ad-do-return interactive-form)))))
+ (cl-return interactive-form)))))
;; @@@ Putting it all together:
;; ============================
@@ -2956,64 +2595,18 @@ in any of these classes."
(if (and (ad-is-advised function)
(ad-has-redefining-advice function))
(let* ((origdef (ad-real-orig-definition function))
- (origname (ad-get-advice-info-field function 'origname))
- (orig-interactive-p (commandp origdef))
- (orig-subr-p (ad-subr-p origdef))
- (orig-special-form-p (ad-special-form-p origdef))
- (orig-macro-p (ad-macro-p origdef))
;; Construct the individual pieces that we need for assembly:
- (orig-arglist (ad-arglist origdef function))
+ (orig-arglist (let ((args (ad-arglist origdef)))
+ ;; The arglist may still be unknown.
+ (if (listp args) args '(&rest args))))
(advised-arglist (or (ad-advised-arglist function)
orig-arglist))
- (advised-interactive-form (ad-advised-interactive-form function))
- (interactive-form
- (cond (orig-macro-p nil)
- (advised-interactive-form)
- ((interactive-form origdef)
- (interactive-form
- (if (and (symbolp function) (get function 'elp-info))
- (aref (get function 'elp-info) 2)
- origdef)))))
+ (interactive-form (ad-advised-interactive-form function))
(orig-form
- (cond ((or orig-special-form-p orig-macro-p)
- ;; Special forms and macros will be advised into macros.
- ;; The trick is to construct an expansion for the advised
- ;; macro that does the correct thing when it gets eval'ed.
- ;; For macros we'll just use the expansion of the original
- ;; macro and return that. This way compiled advised macros
- ;; will be expanded into something useful. Note that after
- ;; advices have full control over whether they want to
- ;; evaluate the expansion (the value of `ad-return-value')
- ;; at macro expansion time or not. For special forms there
- ;; is no solution that interacts reasonably with the
- ;; compiler, hence we just evaluate the original at macro
- ;; expansion time and return the result. The moral of that
- ;; is that one should always deactivate advised special
- ;; forms before one byte-compiles a file.
- `(,(if orig-macro-p 'macroexpand 'eval)
- (cons ',origname
- ,(ad-get-arguments advised-arglist 0))))
- ((and orig-subr-p
- orig-interactive-p
- (not interactive-form)
- (not advised-interactive-form))
- ;; Check whether we were called interactively
- ;; in order to do proper prompting:
- `(if (called-interactively-p 'any)
- (call-interactively ',origname)
- ,(ad-make-mapped-call advised-arglist
- orig-arglist
- origname)))
- ;; And now for normal functions and non-interactive subrs
- ;; (or subrs whose interactive behavior was advised):
- (t (ad-make-mapped-call
- advised-arglist orig-arglist origname)))))
+ (ad-map-arglists advised-arglist orig-arglist)))
;; Finally, build the sucker:
(ad-assemble-advised-definition
- (cond (orig-macro-p 'macro)
- (orig-special-form-p 'special-form)
- (t 'function))
advised-arglist
(ad-make-advised-definition-docstring function)
interactive-form
@@ -3023,71 +2616,67 @@ in any of these classes."
(ad-get-enabled-advices function 'after)))))
(defun ad-assemble-advised-definition
- (type args docstring interactive orig &optional befores arounds afters)
-
- "Assembles an original and its advices into an advised function.
-It constructs a function or macro definition according to TYPE which has to
-be either `macro', `function' or `special-form'. ARGS is the argument list
-that has to be used, DOCSTRING if non-nil defines the documentation of the
-definition, INTERACTIVE if non-nil is the interactive form to be used,
+ (args docstring interactive orig &optional befores arounds afters)
+ "Assemble the advices into an overall advice function.
+ARGS is the argument list that has to be used,
+DOCSTRING if non-nil defines the documentation of the definition,
+INTERACTIVE if non-nil is the interactive form to be used,
ORIG is a form that calls the body of the original unadvised function,
and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG
should be modified. The assembled function will be returned."
-
- (let (before-forms around-form around-form-protected after-forms definition)
- (ad-dolist (advice befores)
- (cond ((and (ad-advice-protected advice)
- before-forms)
- (setq before-forms
- `((unwind-protect
- ,(ad-prognify before-forms)
- ,@(ad-body-forms
- (ad-advice-definition advice))))))
- (t (setq before-forms
- (append before-forms
- (ad-body-forms (ad-advice-definition advice)))))))
-
- (setq around-form `(setq ad-return-value ,orig))
- (ad-dolist (advice (reverse arounds))
- ;; If any of the around advices is protected then we
- ;; protect the complete around advice onion:
- (if (ad-advice-protected advice)
- (setq around-form-protected t))
- (setq around-form
- (ad-substitute-tree
- (function (lambda (form) (eq form 'ad-do-it)))
- (function (lambda (form) around-form))
- (ad-prognify (ad-body-forms (ad-advice-definition advice))))))
+ ;; The ad-do-it call should always have the right number of arguments,
+ ;; but the compiler might signal a bogus warning because it checks the call
+ ;; against the advertised calling convention.
+ (let ((around-form `(setq ad-return-value (with-no-warnings ,orig)))
+ before-forms around-form-protected after-forms definition)
+ (dolist (advice befores)
+ (cond ((and (ad-advice-protected advice)
+ before-forms)
+ (setq before-forms
+ `((unwind-protect
+ ,(macroexp-progn before-forms)
+ ,@(ad-body-forms
+ (ad-advice-definition advice))))))
+ (t (setq before-forms
+ (append before-forms
+ (ad-body-forms (ad-advice-definition advice)))))))
+
+ (dolist (advice (reverse arounds))
+ ;; If any of the around advices is protected then we
+ ;; protect the complete around advice onion:
+ (if (ad-advice-protected advice)
+ (setq around-form-protected t))
+ (setq around-form
+ (ad-substitute-tree
+ (lambda (form) (eq form 'ad-do-it))
+ (lambda (_form) around-form)
+ (macroexp-progn (ad-body-forms (ad-advice-definition advice))))))
(setq after-forms
(if (and around-form-protected before-forms)
`((unwind-protect
- ,(ad-prognify before-forms)
+ ,(macroexp-progn before-forms)
,around-form))
(append before-forms (list around-form))))
- (ad-dolist (advice afters)
- (cond ((and (ad-advice-protected advice)
- after-forms)
- (setq after-forms
- `((unwind-protect
- ,(ad-prognify after-forms)
- ,@(ad-body-forms
- (ad-advice-definition advice))))))
- (t (setq after-forms
- (append after-forms
- (ad-body-forms (ad-advice-definition advice)))))))
+ (dolist (advice afters)
+ (cond ((and (ad-advice-protected advice)
+ after-forms)
+ (setq after-forms
+ `((unwind-protect
+ ,(macroexp-progn after-forms)
+ ,@(ad-body-forms
+ (ad-advice-definition advice))))))
+ (t (setq after-forms
+ (append after-forms
+ (ad-body-forms (ad-advice-definition advice)))))))
(setq definition
- `(,@(if (memq type '(macro special-form)) '(macro))
- lambda
- ,args
+ `(lambda (ad--addoit-function ,@args)
,@(if docstring (list docstring))
,@(if interactive (list interactive))
(let (ad-return-value)
,@after-forms
- ,(if (eq type 'special-form)
- '(list 'quote ad-return-value)
- 'ad-return-value))))
+ ad-return-value)))
(ad-insert-argument-access-forms definition args)))
@@ -3099,7 +2688,7 @@ should be modified. The assembled function will be returned."
(ad-body-forms (ad-advice-definition advice))))
(ad-get-enabled-advices function hook-name))))
(if hook-forms
- (ad-prognify (apply 'append hook-forms)))))
+ (macroexp-progn (apply 'append hook-forms)))))
;; @@ Caching:
@@ -3184,17 +2773,17 @@ advised definition from scratch."
"Generate an identifying image of the current advices of FUNCTION."
(let ((original-definition (ad-real-orig-definition function))
(cached-definition (ad-get-cache-definition function)))
- (list (mapcar (function (lambda (advice) (ad-advice-name advice)))
+ (list (mapcar #'ad-advice-name
(ad-get-enabled-advices function 'before))
- (mapcar (function (lambda (advice) (ad-advice-name advice)))
+ (mapcar #'ad-advice-name
(ad-get-enabled-advices function 'around))
- (mapcar (function (lambda (advice) (ad-advice-name advice)))
+ (mapcar #'ad-advice-name
(ad-get-enabled-advices function 'after))
(ad-definition-type original-definition)
- (if (equal (ad-arglist original-definition function)
+ (if (equal (ad-arglist original-definition)
(ad-arglist cached-definition))
t
- (ad-arglist original-definition function))
+ (ad-arglist original-definition))
(if (eq (ad-definition-type original-definition) 'function)
(equal (interactive-form original-definition)
(interactive-form cached-definition))))))
@@ -3209,11 +2798,11 @@ advised definition from scratch."
(nth 2 cache-id)))))
(defun ad-verify-cache-class-id (cache-class-id advices)
- (ad-dolist (advice advices (null cache-class-id))
+ (cl-dolist (advice advices (null cache-class-id))
(if (ad-advice-enabled advice)
(if (eq (car cache-class-id) (ad-advice-name advice))
(setq cache-class-id (cdr cache-class-id))
- (ad-do-return nil)))))
+ (cl-return nil)))))
;; There should be a way to monitor if and why a cache verification failed
;; in order to determine whether a certain preactivation could be used or
@@ -3239,7 +2828,7 @@ advised definition from scratch."
(and (eq (nth 3 cache-id) (ad-definition-type original-definition))
(setq code 'arglist-mismatch)
(equal (if (eq (nth 4 cache-id) t)
- (ad-arglist original-definition function)
+ (ad-arglist original-definition)
(nth 4 cache-id) )
(ad-arglist cached-definition))
(setq code 'interactive-form-mismatch)
@@ -3298,94 +2887,10 @@ advised definition from scratch."
(ad-set-advice-info function old-advice-info)
;; Don't `fset' function to nil if it was previously unbound:
(if function-defined-p
- (ad-safe-fset function old-definition)
+ (fset function old-definition)
(fmakunbound function)))))
-;; @@ Freezing:
-;; ============
-;; Freezing transforms a `defadvice' into a redefining `defun/defmacro'
-;; for the advised function without keeping any advice information. This
-;; feature was jwz's idea: It generates a dumpable function definition
-;; whose documentation can be written to the DOC file, and the generated
-;; code does not need any Advice runtime support. Of course, frozen advices
-;; cannot be undone.
-
-;; Freezing only considers the advice of the particular `defadvice', other
-;; already existing advices for the same function will be ignored. To ensure
-;; proper interaction when an already advised function gets redefined with
-;; a frozen advice, frozen advices always use the actual original definition
-;; of the function, i.e., they are always at the core of the onion. E.g., if
-;; an already advised function gets redefined with a frozen advice and then
-;; unadvised, the frozen advice remains as the new definition of the function.
-
-;; While multiple freeze advices for a single function or freeze-advising
-;; of an already advised function are possible, they are better avoided,
-;; because definition/compile/load ordering is relevant, and it becomes
-;; incomprehensible pretty quickly.
-
-(defun ad-make-freeze-definition (function advice class position)
- (if (not (ad-has-proper-definition function))
- (error
- "ad-make-freeze-definition: `%s' is not yet defined"
- function))
- (let* ((name (ad-advice-name advice))
- ;; With a unique origname we can have multiple freeze advices
- ;; for the same function, each overloading the previous one:
- (unique-origname
- (intern (format "%s-%s-%s" (ad-make-origname function) class name)))
- (orig-definition
- ;; If FUNCTION is already advised, we'll use its current origdef
- ;; as the original definition of the frozen advice:
- (or (ad-get-orig-definition function)
- (symbol-function function)))
- (old-advice-info
- (if (ad-is-advised function)
- (ad-copy-advice-info function)))
- (real-docstring-fn
- (symbol-function 'ad-make-advised-definition-docstring))
- (real-origname-fn
- (symbol-function 'ad-make-origname))
- (frozen-definition
- (unwind-protect
- (progn
- ;; Make sure we construct a proper docstring:
- (ad-safe-fset 'ad-make-advised-definition-docstring
- 'ad-make-freeze-docstring)
- ;; Make sure `unique-origname' is used as the origname:
- (ad-safe-fset 'ad-make-origname (lambda (x) unique-origname))
- ;; No we reset all current advice information to nil and
- ;; generate an advised definition that's solely determined
- ;; by ADVICE and the current origdef of FUNCTION:
- (ad-set-advice-info function nil)
- (ad-add-advice function advice class position)
- ;; The following will provide proper real docstrings as
- ;; well as a definition that will make the compiler happy:
- (ad-set-orig-definition function orig-definition)
- (ad-make-advised-definition function))
- ;; Restore the old advice state:
- (ad-set-advice-info function old-advice-info)
- ;; Restore functions:
- (ad-safe-fset
- 'ad-make-advised-definition-docstring real-docstring-fn)
- (ad-safe-fset 'ad-make-origname real-origname-fn))))
- (if frozen-definition
- (let* ((macro-p (ad-macro-p frozen-definition))
- (body (cdr (if macro-p
- (ad-lambdafy frozen-definition)
- frozen-definition))))
- `(progn
- (if (not (fboundp ',unique-origname))
- (fset ',unique-origname
- ;; avoid infinite recursion in case the function
- ;; we want to freeze is already advised:
- (or (ad-get-orig-definition ',function)
- (symbol-function ',function))))
- (,(if macro-p 'defmacro 'defun)
- ,function
- ,@body))))))
-
-
;; @@ Activation and definition handling:
;; ======================================
@@ -3415,25 +2920,32 @@ The resulting FUNCTION will be compiled if `ad-should-compile' returns t.
The current definition and its cache-id will be put into the cache."
(let ((verified-cached-definition
(if (ad-verify-cache-id function)
- (ad-get-cache-definition function))))
- (ad-safe-fset function
- (or verified-cached-definition
- (ad-make-advised-definition function)))
+ (ad-get-cache-definition function)))
+ (advicefunname (ad-get-advice-info-field function 'advicefunname)))
+ (fset advicefunname
+ (or verified-cached-definition
+ (ad-make-advised-definition function)))
+ (advice-add function :around advicefunname)
(if (ad-should-compile function compile)
- (ad-compile-function function))
+ (byte-compile advicefunname))
(if verified-cached-definition
- (if (not (eq verified-cached-definition (symbol-function function)))
+ (if (not (eq verified-cached-definition
+ (symbol-function advicefunname)))
;; we must have compiled, cache the compiled definition:
- (ad-set-cache
- function (symbol-function function) (ad-get-cache-id function)))
+ (ad-set-cache function (symbol-function advicefunname)
+ (ad-get-cache-id function)))
;; We created a new advised definition, cache it with a proper id:
(ad-clear-cache function)
;; ad-make-cache-id needs the new cached definition:
- (ad-set-cache function (symbol-function function) nil)
+ (ad-set-cache function (symbol-function advicefunname) nil)
(ad-set-cache
- function (symbol-function function) (ad-make-cache-id function)))))
+ function (symbol-function advicefunname) (ad-make-cache-id function)))))
-(defun ad-handle-definition (function)
+(defun ad--defalias-fset (fsetfun function newdef)
+ ;; Besides ad-redefinition-action we use this defalias-fset-function hook
+ ;; for two other reasons:
+ ;; - for `activation/deactivation' advices.
+ ;; - to rebuild the ad-Advice-* function with the right argument names.
"Handle re/definition of an advised FUNCTION during de/activation.
If FUNCTION does not have an original definition associated with it and
the current definition is usable, then it will be stored as FUNCTION's
@@ -3445,33 +2957,27 @@ associated with it but got redefined with a new definition and then
de/activated. If you do not like the current redefinition action change
the value of `ad-redefinition-action' and de/activate again."
(let ((original-definition (ad-get-orig-definition function))
- (current-definition (if (ad-real-definition function)
- (symbol-function function))))
+ (current-definition (ad-get-orig-definition newdef)))
(if original-definition
(if current-definition
- (if (and (not (eq current-definition original-definition))
- ;; Redefinition with an advised definition from a
- ;; different function won't count as such:
- (not (ad-advised-definition-p current-definition)))
- ;; we have a redefinition:
+ (if (not (eq current-definition original-definition))
+ ;; We have a redefinition:
(if (not (memq ad-redefinition-action '(accept discard warn)))
- (error "ad-handle-definition (see its doc): `%s' %s"
+ (error "ad-redefinition-action: `%s' %s"
function "invalidly redefined")
(if (eq ad-redefinition-action 'discard)
- (ad-safe-fset function original-definition)
- (ad-set-orig-definition function current-definition)
+ nil ;; Just drop it!
+ (funcall (or fsetfun #'fset) function newdef)
+ (ad-activate-internal function)
(if (eq ad-redefinition-action 'warn)
(message "ad-handle-definition: `%s' got redefined"
function))))
;; either advised def or correct original is in place:
nil)
- ;; we have an undefinition, ignore it:
- nil)
- (if current-definition
- ;; we have a first definition, save it as original:
- (ad-set-orig-definition function current-definition)
- ;; we don't have anything noteworthy:
- nil))))
+ ;; We have an undefinition, ignore it:
+ (funcall (or fsetfun #'fset) function newdef))
+ (funcall (or fsetfun #'fset) function newdef)
+ (when current-definition (ad-activate-internal function)))))
;; @@ The top-level advice interface:
@@ -3497,24 +3003,20 @@ definition will always be cached for later usage."
(interactive
(list (ad-read-advised-function "Activate advice of")
current-prefix-arg))
- (if ad-activate-on-top-level
- ;; avoid recursive calls to `ad-activate':
- (ad-with-auto-activation-disabled
- (if (not (ad-is-advised function))
- (error "ad-activate: `%s' is not advised" function)
- (ad-handle-definition function)
- ;; Just return for forward advised and not yet defined functions:
- (if (ad-get-orig-definition function)
- (if (not (ad-has-any-advice function))
- (ad-unadvise function)
- ;; Otherwise activate the advice:
- (cond ((ad-has-redefining-advice function)
- (ad-activate-advised-definition function compile)
- (ad-set-advice-info-field function 'active t)
- (eval (ad-make-hook-form function 'activation))
- function)
- ;; Here we are if we have all disabled advices:
- (t (ad-deactivate function)))))))))
+ (if (not (ad-is-advised function))
+ (error "ad-activate: `%s' is not advised" function)
+ ;; Just return for forward advised and not yet defined functions:
+ (if (ad-get-orig-definition function)
+ (if (not (ad-has-any-advice function))
+ (ad-unadvise function)
+ ;; Otherwise activate the advice:
+ (cond ((ad-has-redefining-advice function)
+ (ad-activate-advised-definition function compile)
+ (ad-set-advice-info-field function 'active t)
+ (eval (ad-make-hook-form function 'activation))
+ function)
+ ;; Here we are if we have all disabled advices:
+ (t (ad-deactivate function)))))))
(defalias 'ad-activate-on 'ad-activate)
@@ -3529,11 +3031,10 @@ a call to `ad-activate'."
(if (not (ad-is-advised function))
(error "ad-deactivate: `%s' is not advised" function)
(cond ((ad-is-active function)
- (ad-handle-definition function)
(if (not (ad-get-orig-definition function))
(error "ad-deactivate: `%s' has no original definition"
function)
- (ad-safe-fset function (ad-get-orig-definition function))
+ (ad-clear-advicefunname-definition function)
(ad-set-advice-info-field function 'active nil)
(eval (ad-make-hook-form function 'deactivation))
function)))))
@@ -3555,7 +3056,7 @@ If FUNCTION was not advised this will be a noop."
(cond ((ad-is-advised function)
(if (ad-is-active function)
(ad-deactivate function))
- (ad-clear-orig-definition function)
+ (ad-clear-advicefunname-definition function)
(ad-set-advice-info function nil)
(ad-pop-advised-function function))))
@@ -3570,9 +3071,7 @@ Use in emergencies."
(list (intern
(completing-read "Recover advised function: " obarray nil t))))
(cond ((ad-is-advised function)
- (cond ((ad-get-orig-definition function)
- (ad-safe-fset function (ad-get-orig-definition function))
- (ad-clear-orig-definition function)))
+ (ad-clear-advicefunname-definition function)
(ad-set-advice-info function nil)
(ad-pop-advised-function function))))
@@ -3652,7 +3151,7 @@ deactivation, which might run hooks and get into other trouble."
;; Completion alist of valid `defadvice' flags
(defvar ad-defadvice-flags
'(("protect") ("disable") ("activate")
- ("compile") ("preactivate") ("freeze")))
+ ("compile") ("preactivate")))
;;;###autoload
(defmacro defadvice (function args &rest body)
@@ -3671,7 +3170,7 @@ POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first',
ARGLIST ::= An optional argument list to be used for the advised function
instead of the argument list of the original. The first one found in
before/around/after-advices will be used.
-FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'.
+FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'.
All flags can be specified with unambiguous initial substrings.
DOCSTRING ::= Optional documentation for this piece of advice.
INTERACTIVE-FORM ::= Optional interactive form to be used for the advised
@@ -3697,18 +3196,20 @@ time. This generates a compiled advised definition according to the current
advice state that will be used during activation if appropriate. Only use
this if the `defadvice' gets actually compiled.
-`freeze': Expands the `defadvice' into a redefining `defun/defmacro' according
-to this particular single advice. No other advice information will be saved.
-Frozen advices cannot be undone, they behave like a hard redefinition of
-the advised function. `freeze' implies `activate' and `preactivate'. The
-documentation of the advised function can be dumped onto the `DOC' file
-during preloading.
-
See Info node `(elisp)Advising Functions' for comprehensive documentation.
usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
[DOCSTRING] [INTERACTIVE-FORM]
BODY...)"
- (declare (doc-string 3))
+ (declare (doc-string 3)
+ (debug (&define name ;; thing being advised.
+ (name ;; class is [&or "before" "around" "after"
+ ;; "activation" "deactivation"]
+ name ;; name of advice
+ &rest sexp ;; optional position and flags
+ )
+ [&optional stringp]
+ [&optional ("interactive" interactive)]
+ def-body)))
(if (not (ad-name-p function))
(error "defadvice: Invalid function name: %s" function))
(let* ((class (car args))
@@ -3744,29 +3245,24 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
(ad-preactivate-advice
function advice class position))))
;; Now for the things to be done at evaluation time:
- (if (memq 'freeze flags)
- ;; jwz's idea: Freeze the advised definition into a dumpable
- ;; defun/defmacro whose docs can be written to the DOC file:
- (ad-make-freeze-definition function advice class position)
- ;; the normal case:
- `(progn
- (ad-add-advice ',function ',advice ',class ',position)
- ,@(if preactivation
- `((ad-set-cache
- ',function
- ;; the function will get compiled:
- ,(cond ((ad-macro-p (car preactivation))
- `(ad-macrofy
- (function
- ,(ad-lambdafy
- (car preactivation)))))
- (t `(function
- ,(car preactivation))))
- ',(car (cdr preactivation)))))
- ,@(if (memq 'activate flags)
- `((ad-activate ',function
- ,(if (memq 'compile flags) t))))
- ',function))))
+ `(progn
+ (ad-add-advice ',function ',advice ',class ',position)
+ ,@(if preactivation
+ `((ad-set-cache
+ ',function
+ ;; the function will get compiled:
+ ,(cond ((ad-macro-p (car preactivation))
+ `(ad-macrofy
+ (function
+ ,(ad-lambdafy
+ (car preactivation)))))
+ (t `(function
+ ,(car preactivation))))
+ ',(car (cdr preactivation)))))
+ ,@(if (memq 'activate flags)
+ `((ad-activate ',function
+ ,(if (memq 'compile flags) t))))
+ ',function)))
;; @@ Tools:
@@ -3777,6 +3273,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
For any members of FUNCTIONS that are not currently advised the rebinding will
be a noop. Any modifications done to the definitions of FUNCTIONS will be
undone on exit of this macro."
+ (declare (indent 1))
(let* ((index -1)
;; Make let-variables to store current definitions:
(current-bindings
@@ -3793,67 +3290,35 @@ undone on exit of this macro."
;; Make forms to redefine functions to their
;; original definitions if they are advised:
(setq index -1)
- (mapcar
- (function
- (lambda (function)
- (setq index (1+ index))
- `(ad-safe-fset
- ',function
- (or (ad-get-orig-definition ',function)
- ,(car (nth index current-bindings))))))
- functions))
+ (mapcar (lambda (function)
+ (setq index (1+ index))
+ `(fset ',function
+ (or (ad-get-orig-definition ',function)
+ ,(car (nth index current-bindings)))))
+ functions))
,@body)
,@(progn
;; Make forms to back-define functions to the definitions
;; they had outside this macro call:
(setq index -1)
- (mapcar
- (function
- (lambda (function)
- (setq index (1+ index))
- `(ad-safe-fset
- ',function
- ,(car (nth index current-bindings)))))
- functions))))))
+ (mapcar (lambda (function)
+ (setq index (1+ index))
+ `(fset ',function
+ ,(car (nth index current-bindings))))
+ functions))))))
-(if (not (get 'ad-with-originals 'lisp-indent-hook))
- (put 'ad-with-originals 'lisp-indent-hook 1))
-
-
-;; @@ Advising `documentation':
-;; ============================
-;; Use the advice mechanism to advise `documentation' to make it
-;; generate proper documentation strings for advised definitions:
;; @@ Starting, stopping and recovering from the advice package magic:
;; ===================================================================
-(defun ad-start-advice ()
- "Start the automatic advice handling magic."
- (interactive)
- ;; Advising `ad-activate-internal' means death!!
- (ad-set-advice-info 'ad-activate-internal nil)
- (ad-safe-fset 'ad-activate-internal 'ad-activate))
-
-(defun ad-stop-advice ()
- "Stop the automatic advice handling magic.
-You should only need this in case of Advice-related emergencies."
- (interactive)
- ;; Advising `ad-activate-internal' means death!!
- (ad-set-advice-info 'ad-activate-internal nil)
- (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off))
-
(defun ad-recover-normality ()
"Undo all advice related redefinitions and unadvises everything.
Use only in REAL emergencies."
(interactive)
- ;; Advising `ad-activate-internal' means death!!
- (ad-set-advice-info 'ad-activate-internal nil)
- (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off)
(ad-recover-all)
- (setq ad-advised-functions nil))
-
-(ad-start-advice)
+ (ad-do-advised-functions (function)
+ (message "Oops! Left over advised function %S" function)
+ (ad-pop-advised-function function)))
(provide 'advice)
diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el
index 596b32f24c3..6c70642ba83 100644
--- a/lisp/emacs-lisp/authors.el
+++ b/lisp/emacs-lisp/authors.el
@@ -1,6 +1,6 @@
-;;; authors.el --- utility for maintaining Emacs' AUTHORS file -*-coding: utf-8;-*-
+;;; authors.el --- utility for maintaining Emacs's AUTHORS file -*-coding: utf-8 -*-
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Maintainer: Kim F. Storm <storm@cua.dk>
@@ -25,7 +25,7 @@
;;; Commentary:
;; Use M-x authors RET to create an *Authors* buffer that can used as
-;; or merged with Emacs' AUTHORS file.
+;; or merged with Emacs's AUTHORS file.
;;; Code:
@@ -41,23 +41,28 @@ files.")
(defconst authors-aliases
'(
("Aaron S. Hawley" "Aaron Hawley")
+ ("Alexandru Harsanyi" "Alex Harsanyi")
("Andrew Csillag" "Drew Csillag")
("Anna M. Bigatti" "Anna Bigatti")
("Barry A. Warsaw" "Barry A. Warsaw, Century Computing, Inc."
"Barry A. Warsaw, ITB" "Barry Warsaw")
+ ("Bill Carpenter" "WJ Carpenter")
("Bill Mann" "William F. Mann")
("Bill Rozas" "Guillermo J. Rozas")
("Björn Torkelsson" "Bjorn Torkelsson")
("Brian Fox" "Brian J. Fox")
+ ("Brian Sniffen" "Brian T. Sniffen")
("Christoph Wedler" "Christoph.Wedler@sap.com")
("Daniel Pfeiffer" "<Daniel.Pfeiffer@Informatik.START.db.de>"
"<Daniel.Pfeiffer@Informatik.START.dbp.de>")
+ ("David Abrahams" "Dave Abrahams")
("David De La Harpe Golden" "David Golden")
("David Gillespie" "Dave Gillespie")
("David Kågedal" "David K..edal")
("David M. Koppelman" "David M. Koppelman, Koppel@Ec?e.Lsu.Edu"
"David Koppelman")
("David M. Smith" "David Smith" "David M Smith")
+ ("David O'Toole" "David T. O'Toole")
("Deepak Goel" "D. Goel")
("Ed L. Cashin" "Ed L Cashin")
("Edward M. Reingold" "Ed Reingold" "Edward M Reingold"
@@ -76,6 +81,8 @@ files.")
("Gerd Möllmann" "Gerd Moellmann")
("Hallvard B. Furuseth" "Hallvard B Furuseth" "Hallvard Furuseth")
("Hrvoje Nikšić" "Hrvoje Niksic")
+ ;; lisp/org/ChangeLog 2010-11-11.
+ (nil "aaa bbb")
;; src/ChangeLog.4, 1994-01-11, since fixed.
;;; (nil "(afs@hplb.hpl.hp.com)")
;; lisp/gnus/ChangeLog.1, 1998-01-15.
@@ -92,6 +99,7 @@ files.")
("Jens-Ulrik Holger Petersen" "Jens-Ulrik Petersen")
("Jeremy Bertram Maitin-Shepard" "Jeremy Maitin-Shepard")
("Johan Bockgård" "Johan Bockgard")
+ ("John J Foerch" "John Foerch")
("John W. Eaton" "John Eaton")
("Jonathan I. Kamens" "Jonathan Kamens")
("Joseph Arceneaux" "Joe Arceneaux")
@@ -109,10 +117,11 @@ files.")
("Kevin Greiner" "Kevin J. Greiner")
("Kim F. Storm" "Kim Storm")
("Kyle Jones" "Kyle E. Jones")
+ ("Lars Magne Ingebrigtsen" "Lars Ingebrigtsen")
("Marcus G. Daniels" "Marcus Daniels")
("Mark D. Baushke" "Mark D Baushke")
("Marko Kohtala" "Kohtala Marko")
- ("Agustín Martín" "Agustin Martin")
+ ("Agustín Martín" "Agustin Martin" "Agustín Martín Domingo")
("Martin Lorentzon" "Martin Lorentzson")
("Matt Swift" "Matthew Swift")
("Maxime Edouard Robert Froumentin" "Max Froumentin")
@@ -124,12 +133,14 @@ files.")
("Michael Sperber" "Michael Sperber \\[Mr. Preprocessor\\]")
("Mikio Nakajima" "Nakajima Mikio")
("Nelson Jose dos Santos Ferreira" "Nelson Ferreira")
+ ("Noorul Islam" "Noorul Islam K M")
("Paul Eggert" "eggert")
("Paul Reilly" "(pmr@legacy.pajato.com)")
("Pavel Janík" "Pavel Janík Ml." "Pavel Janik Ml." "Pavel Janik" "Pavel Janík" "Pavel@Janik.Cz")
("Pavel Kobiakov" "Pavel Kobyakov")
("Per Abrahamsen" "Per Abhiddenware")
("Per Starbäck" "Per Starback")
+ ("Peter J. Weisberg" "PJ Weisberg")
("Peter S. Galbraith" "Peter Galbraith")
("Peter Runestig" "Peter 'luna' Runestig")
("Peter S. Galbraith" "Peter S Galbraith")
@@ -144,23 +155,28 @@ files.")
("Sacha Chua" "Sandra Jean Chua")
("Sam Steingold" "Sam Shteingold")
("Satyaki Das" "Indexed search by Satyaki Das")
+ ("Sébastien Vauban" "Sebastien Vauban")
;; There are other Stefans.
;;; ("Stefan Monnier" "Stefan")
("Stephen A. Wood" "(saw@cebaf.gov)")
("Steven L. Baur" "SL Baur" "Steven L Baur")
("Stewart M. Clamen" "Stewart Clamen")
("Stuart D. Herring" "Stuart Herring" "Davis Herring")
+ ("T.V. Raman" "T\\. V\\. Raman")
("Taichi Kawabata" "KAWABATA,? Taichi")
("Takaaki Ota" "Tak Ota")
("Takahashi Naoto" "Naoto Takahashi")
("Teodor Zlatanov" "Ted Zlatanov")
+ ("Thomas Dye" "Tom Dye")
("Thomas Horsley" "Tom Horsley") ; FIXME ?
("Thomas Wurgler" "Tom Wurgler")
+ ("Toby Cubitt" "Toby S\\. Cubitt")
("Tomohiko Morioka" "MORIOKA Tomohiko")
("Torbjörn Axelsson" "Torbjvrn Axelsson")
("Torbjörn Einarsson" "Torbj.*rn Einarsson")
("Toru Tomabechi" "Toru Tomabechi,")
("Tsugutomo Enami" "enami tsugutomo")
+ ("Ulrich Müller" "Ulrich Mueller")
("Vincent Del Vecchio" "Vince Del Vecchio")
("William M. Perry" "Bill Perry")
("Wlodzimierz Bzyl" "W.*dek Bzyl")
@@ -174,6 +190,7 @@ Each entry is of the form (REALNAME REGEXP...). If an author's name
matches one of the REGEXPs, use REALNAME instead.
If REALNAME is nil, ignore that author.")
+;; FIXME seems it would be less fragile to check for O', Mc, etc.
(defconst authors-fixed-case
'("Bryan O'Sullivan"
"Christian von Roques"
@@ -182,6 +199,7 @@ If REALNAME is nil, ignore that author.")
"David J. MacKenzie"
"David McCabe"
"David O'Toole"
+ "Devon Sean McCullough"
"Dominique de Waleffe"
"Edward O'Connor"
"Exal de Jesus Garcia Carrillo"
@@ -194,8 +212,11 @@ If REALNAME is nil, ignore that author.")
"Nelson Jose dos Santos Ferreira"
"Peter von der Ahe"
"Peter O'Gorman"
+ "Piet van Oostrum"
"Roland McGrath"
- "Sean O'Rourke")
+ "Sean O'Halpin"
+ "Sean O'Rourke"
+ "Tijs van Bakel")
"List of authors whose names cannot be simply capitalized.")
(defvar authors-public-domain-files
@@ -222,11 +243,12 @@ If REALNAME is nil, ignore that author.")
".*loaddefs.el$" ; not obsolete, but auto-generated
"\\.\\(cvs\\|git\\)ignore$" ; obsolete or uninteresting
"\\.arch-inventory$"
+ ;; TODO lib/? Matches other things?
+ "build-aux/" "m4/" "Emacs.xcodeproj" "charsets" "mapfiles"
"preferences\\.\\(nib\\|gorm\\)"
"vc-\\(rcs\\|cvs\\|sccs\\)-hooks\\.el$")
"List of regexps matching obsolete files.
-Changes to files matching one of the regexps in this list are not
-listed.")
+Changes to files matching one of the regexps in this list are not listed.")
(defconst authors-ignored-files
'("external-lisp"
@@ -257,7 +279,12 @@ listed.")
"*.el"
;; Autogen:
"cus-load.el" "finder-inf.el" "ldefs-boot.el"
+ "compile" "config.guess" "config.sub" "depcomp"
+ ;; Only existed briefly, then renamed:
+ "images/icons/allout-widgets-dark-bg"
+ "images/icons/allout-widgets-light-bg"
;; Never had any meaningful changes logged, now deleted:
+ "unidata/bidimirror.awk" "unidata/biditype.awk"
"split-man" "Xkeymap.txt" "ms-7bkermit" "ulimit.hack"
"gnu-hp300" "refcard.bit" "ledit.l" "forms.README" "forms-d2.dat"
"CXTERM-DIC/PY.tit" "CXTERM-DIC/ZIRANMA.tit"
@@ -308,29 +335,47 @@ Changes to files in this list are not listed.")
"complete.el"
"cpp.el"
"ctxt.el"
+ "custom.el"
+ "cyrillic.el"
+ "czech.el"
"debug.el"
"dired.el"
"el.el"
+ "eshell.el"
+ "ethiopic.el"
+ "f90.el"
"files.el"
"find.el"
"format.el"
+ "generic.el"
+ "georgian.el"
+ "greek.el"
"grep.el"
+ "hebrew.el"
"imenu.el"
+ "indian.el"
+ "japanese.el"
"java.el"
+ "lao.el"
"linux.el"
"locate.el"
"make.el"
"mode.el"
"python.el"
+ "rmailmm.el"
"semantic.el"
"shell.el"
"simple.el"
+ "slovak.el"
"sort.el"
"speedbar.el"
"srecode.el"
"table.el"
"texi.el"
+ "thai.el"
+ "tibetan.el"
"util.el"
+ "vc-bzr.el"
"wisent.el")
"List of basenames occurring more than once in the source.")
@@ -354,7 +399,7 @@ Changes to files in this list are not listed.")
("Lawrence R. Dodd" :cowrote "dired-x.el")
;; No longer distributed.
;;; ("Viktor Dukhovni" :wrote "unexsunos4.c")
- ("Paul Eggert" :wrote "rcs2log" "vcdiff")
+ ("Paul Eggert" :wrote "rcs2log") ; "vcdiff"
("Fred Fish" :changed "unexcoff.c")
;; No longer distributed.
;;; ("Tim Fleehart" :wrote "makefile.nt")
@@ -382,7 +427,7 @@ Changes to files in this list are not listed.")
;; No longer distributed.
;;; ("Ishikawa Chiaki" :changed "aviion.h" "dgux.h")
;; ymakefile no longer distributed.
- ("Michael K. Johnson" :changed "configure.in" "emacs.c" "intel386.h"
+ ("Michael K. Johnson" :changed "configure.ac" "emacs.c" "intel386.h"
"mem-limits.h" "process.c" "template.h" "sysdep.c" "syssignal.h"
"systty.h" "unexcoff.c" "linux.h")
;; No longer distributed.
@@ -421,7 +466,8 @@ Changes to files in this list are not listed.")
"vt220.el" "vt240.el")
("Motorola" :changed "buff-menu.el")
("Hiroshi Nakano" :changed "ralloc.c")
- ("Sundar Narasimhan" :changed "rnewspost.el")
+ ;; File removed in Emacs 24.1.
+;;; ("Sundar Narasimhan" :changed "rnewspost.el")
;; No longer distributed.
;;; ("NeXT, Inc." :wrote "unexnext.c")
("Mark Neale" :changed "fortran.el")
@@ -452,7 +498,7 @@ Changes to files in this list are not listed.")
("William Sommerfeld" :wrote "emacsclient.c" "scribe.el")
;; No longer distributed: emacsserver.c.
("Leigh Stoller" :changed "emacsclient.c" "server.el")
- ("Steve Strassman" :wrote "spook.el")
+ ("Steve Strassmann" :wrote "spook.el")
("Shinichirou Sugou" :changed "etags.c")
;; No longer distributed: emacsserver.c.
("Sun Microsystems, Inc" :changed "emacsclient.c" "server.el"
@@ -532,8 +578,10 @@ in the repository.")
("w32console.c" . "w32term.c")
("unexnt.c" . "unexw32.c")
("s/windowsnt.h" . "s/ms-w32.h")
+ ("s/ms-w32.h" . "inc/ms-w32.h")
("winnt.el" . "w32-fns.el")
("config.emacs" . "configure")
+ ("configure.in" . "configure.ac")
("config.h.dist" . "config.in")
("config.h-dist" . "config.in")
("config.h.in" . "config.in")
@@ -587,6 +635,7 @@ in the repository.")
("texi/url.txi" . "url.texi")
("edt-user.doc" . "edt.texi")
("DEV-NOTES" . "nextstep")
+ ("org/COPYRIGHT-AND-LICENSE" . "org/README")
;; Moved to different directories.
("ctags.1" . "ctags.1")
("etags.1" . "etags.1")
@@ -655,7 +704,7 @@ or is on the list of removed files. Returns the non-directory part of
the file name. Only uses the LOG-FILE position POS and associated AUTHOR
to print a message if FILE is not found."
;; FILE should be re-checked in every different directory associated
- ;; with a LOG-FILE. Eg configure.in from src/ChangeLog is not the
+ ;; with a LOG-FILE. Eg configure.ac from src/ChangeLog is not the
;; same as that from top-level/ChangeLog.
(let* ((fullname (expand-file-name file (file-name-directory log-file)))
(entry (assoc fullname authors-checked-files-alist))
@@ -783,7 +832,7 @@ with the file and the number of each action:
(enable-local-eval nil)
(existing-buffer (get-file-buffer log-file))
(buffer (find-file-noselect log-file))
- authors file pos)
+ authors pos)
(with-current-buffer buffer
(save-restriction
(widen)
@@ -897,8 +946,7 @@ and changed by AUTHOR."
(file (car change))
(filestat (if (authors-public-domain-p file)
(concat file " (public domain)")
- file))
- slot)
+ file)))
(cond ((assq :wrote actions)
(setq wrote-list (cons filestat wrote-list)))
((assq :cowrote actions)
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 19a4d44273d..382e25f3121 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -1,6 +1,6 @@
-;; autoload.el --- maintain autoloads in loaddefs.el
+;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
-;; Copyright (C) 1991-1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Keywords: maint
@@ -32,7 +32,7 @@
(require 'lisp-mode) ;for `doc-string-elt' properties.
(require 'help-fns) ;for help-add-fundoc-usage.
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defvar generated-autoload-file nil
"File into which to write autoload definitions.
@@ -86,78 +86,100 @@ that text will be copied verbatim to `generated-autoload-file'.")
(defvar autoload-modified-buffers) ;Dynamically scoped var.
-(defun make-autoload (form file)
+(defun make-autoload (form file &optional expansion)
"Turn FORM into an autoload or defvar for source file FILE.
Returns nil if FORM is not a special autoload form (i.e. a function definition
-or macro definition or a defcustom)."
+or macro definition or a defcustom).
+If EXPANSION is non-nil, we're processing the macro expansion of an
+expression, in which case we want to handle forms differently."
(let ((car (car-safe form)) expand)
(cond
+ ((and expansion (eq car 'defalias))
+ (pcase-let*
+ ((`(,_ ,_ ,arg . ,rest) form)
+ ;; `type' is non-nil if it defines a macro.
+ ;; `fun' is the function part of `arg' (defaults to `arg').
+ ((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t))
+ (and (let fun arg) (let type nil)))
+ arg)
+ ;; `lam' is the lambda expression in `fun' (or nil if not
+ ;; recognized).
+ (lam (if (memq (car-safe fun) '(quote function)) (cadr fun)))
+ ;; `args' is the list of arguments (or t if not recognized).
+ ;; `body' is the body of `lam' (or t if not recognized).
+ ((or `(lambda ,args . ,body)
+ (and (let args t) (let body t)))
+ lam)
+ ;; Get the `doc' from `body' or `rest'.
+ (doc (cond ((stringp (car-safe body)) (car body))
+ ((stringp (car-safe rest)) (car rest))))
+ ;; Look for an interactive spec.
+ (interactive (pcase body
+ ((or `((interactive . ,_) . ,_)
+ `(,_ (interactive . ,_) . ,_)) t))))
+ ;; Add the usage form at the end where describe-function-1
+ ;; can recover it.
+ (when (listp args) (setq doc (help-add-fundoc-usage doc args)))
+ ;; (message "autoload of %S" (nth 1 form))
+ `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))
+
+ ((and expansion (memq car '(progn prog1)))
+ (let ((end (memq :autoload-end form)))
+ (when end ;Cut-off anything after the :autoload-end marker.
+ (setq form (copy-sequence form))
+ (setcdr (memq :autoload-end form) nil))
+ (let ((exps (delq nil (mapcar (lambda (form)
+ (make-autoload form file expansion))
+ (cdr form)))))
+ (when exps (cons 'progn exps)))))
+
;; For complex cases, try again on the macro-expansion.
((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
- define-globalized-minor-mode
+ define-globalized-minor-mode defun defmacro
+ ;; FIXME: we'd want `defmacro*' here as well, so as
+ ;; to handle its `declare', but when autoload is run
+ ;; CL is not loaded so macroexpand doesn't know how
+ ;; to expand it!
easy-mmode-define-minor-mode define-minor-mode))
(setq expand (let ((load-file-name file)) (macroexpand form)))
- (eq (car expand) 'progn)
- (memq :autoload-end expand))
- (let ((end (memq :autoload-end expand)))
- ;; Cut-off anything after the :autoload-end marker.
- (setcdr end nil)
- (cons 'progn
- (mapcar (lambda (form) (make-autoload form file))
- (cdr expand)))))
+ (memq (car expand) '(progn prog1 defalias)))
+ (make-autoload expand file 'expansion)) ;Recurse on the expansion.
;; For special function-like operators, use the `autoload' function.
- ((memq car '(defun define-skeleton defmacro define-derived-mode
+ ((memq car '(define-skeleton define-derived-mode
define-compilation-mode define-generic-mode
easy-mmode-define-global-mode define-global-minor-mode
define-globalized-minor-mode
easy-mmode-define-minor-mode define-minor-mode
- defun* defmacro* define-overloadable-function))
- (let* ((macrop (memq car '(defmacro defmacro*)))
+ cl-defun defun* cl-defmacro defmacro*
+ define-overloadable-function))
+ (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*)))
(name (nth 1 form))
- (args (case car
- ((defun defmacro defun* defmacro*
- define-overloadable-function) (nth 2 form))
- ((define-skeleton) '(&optional str arg))
- ((define-generic-mode define-derived-mode
- define-compilation-mode) nil)
- (t)))
- (body (nthcdr (get car 'doc-string-elt) form))
+ (args (pcase car
+ ((or `defun `defmacro
+ `defun* `defmacro* `cl-defun `cl-defmacro
+ `define-overloadable-function) (nth 2 form))
+ (`define-skeleton '(&optional str arg))
+ ((or `define-generic-mode `define-derived-mode
+ `define-compilation-mode) nil)
+ (_ t)))
+ (body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
(doc (if (stringp (car body)) (pop body))))
- (when (listp args)
- ;; Add the usage form at the end where describe-function-1
- ;; can recover it.
- (setq doc (help-add-fundoc-usage doc args)))
- (let ((exp
- ;; `define-generic-mode' quotes the name, so take care of that
- (list 'autoload (if (listp name) name (list 'quote name))
- file doc
- (or (and (memq car '(define-skeleton define-derived-mode
- define-generic-mode
- easy-mmode-define-global-mode
- define-global-minor-mode
- define-globalized-minor-mode
- easy-mmode-define-minor-mode
- define-minor-mode)) t)
- (eq (car-safe (car body)) 'interactive))
- (if macrop (list 'quote 'macro) nil))))
- (when macrop
- ;; Special case to autoload some of the macro's declarations.
- (let ((decls (nth (if (stringp (nth 3 form)) 4 3) form))
- (exps '()))
- (when (eq (car-safe decls) 'declare)
- ;; FIXME: We'd like to reuse macro-declaration-function,
- ;; but we can't since it doesn't return anything.
- (dolist (decl decls)
- (case (car-safe decl)
- (indent
- (push `(put ',name 'lisp-indent-function ',(cadr decl))
- exps))
- (doc-string
- (push `(put ',name 'doc-string-elt ',(cadr decl)) exps))))
- (when exps
- (setq exp `(progn ,exp ,@exps))))))
- exp)))
+ ;; Add the usage form at the end where describe-function-1
+ ;; can recover it.
+ (when (listp args) (setq doc (help-add-fundoc-usage doc args)))
+ ;; `define-generic-mode' quotes the name, so take care of that
+ `(autoload ,(if (listp name) name (list 'quote name))
+ ,file ,doc
+ ,(or (and (memq car '(define-skeleton define-derived-mode
+ define-generic-mode
+ easy-mmode-define-global-mode
+ define-global-minor-mode
+ define-globalized-minor-mode
+ easy-mmode-define-minor-mode
+ define-minor-mode)) t)
+ (eq (car-safe (car body)) 'interactive))
+ ,(if macrop ''macro nil))))
;; For defclass forms, use `eieio-defclass-autoload'.
((eq car 'defclass)
@@ -190,6 +212,11 @@ or macro definition or a defcustom)."
(if (member ',file loads) nil
(put ',groupname 'custom-loads (cons ',file loads))))))
+ ;; When processing a macro expansion, any expression
+ ;; before a :autoload-end should be included. These are typically (put
+ ;; 'fun 'prop val) and things like that.
+ ((and expansion (consp form)) form)
+
;; nil here indicates that this is not a special autoload form.
(t nil))))
@@ -201,7 +228,8 @@ or macro definition or a defcustom)."
(defun autoload-find-generated-file ()
"Visit the autoload file for the current buffer, and return its buffer.
If a buffer is visiting the desired autoload file, return it."
- (let ((enable-local-variables :safe))
+ (let ((enable-local-variables :safe)
+ (enable-local-eval nil))
;; We used to use `raw-text' to read this file, but this causes
;; problems when the file contains non-ASCII characters.
(find-file-noselect
@@ -250,7 +278,7 @@ put the output in."
;; Symbols at the toplevel are meaningless.
((symbolp form) nil)
(t
- (let ((doc-string-elt (get (car-safe form) 'doc-string-elt))
+ (let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt))
(outbuf autoload-print-form-outbuf))
(if (and doc-string-elt (stringp (nth doc-string-elt form)))
;; We need to hack the printing because the
@@ -329,7 +357,7 @@ not be relied upon."
"Insert the section-header line,
which lists the file name and which functions are in it, etc."
(insert generate-autoload-section-header)
- (prin1 (list 'autoloads autoloads load-name file time)
+ (prin1 `(autoloads ,autoloads ,load-name ,file ,time)
outbuf)
(terpri outbuf)
;; Break that line at spaces, to avoid very long lines.
@@ -355,7 +383,8 @@ which lists the file name and which functions are in it, etc."
(emacs-lisp-mode)
(setq default-directory (file-name-directory file))
(insert-file-contents file nil)
- (let ((enable-local-variables :safe))
+ (let ((enable-local-variables :safe)
+ (enable-local-eval nil))
(hack-local-variables))
(current-buffer)))
@@ -481,7 +510,7 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
(search-forward generate-autoload-cookie)
(skip-chars-forward " \t")
(if (eolp)
- (condition-case err
+ (condition-case-unless-debug err
;; Read the next form and make an autoload.
(let* ((form (prog1 (read (current-buffer))
(or (bolp) (forward-line 1))))
@@ -521,7 +550,7 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
(save-excursion
;; Insert the section-header line which lists the file name
;; and which functions are in it, etc.
- (assert (= ostart output-start))
+ (cl-assert (= ostart output-start))
(goto-char output-start)
(let ((relfile (file-relative-name absfile)))
(autoload-insert-section-header
@@ -671,9 +700,9 @@ file binds `generated-autoload-file' as a file-local variable,
write its autoloads into the specified file instead."
(interactive "DUpdate autoloads from directory: ")
(let* ((files-re (let ((tmp nil))
- (dolist (suf (get-load-suffixes)
- (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))
- (unless (string-match "\\.elc" suf) (push suf tmp)))))
+ (dolist (suf (get-load-suffixes))
+ (unless (string-match "\\.elc" suf) (push suf tmp)))
+ (concat "^[^=.].*" (regexp-opt tmp t) "\\'")))
(files (apply 'nconc
(mapcar (lambda (dir)
(directory-files (expand-file-name dir)
@@ -762,9 +791,6 @@ write its autoloads into the specified file instead."
(define-obsolete-function-alias 'update-autoloads-from-directories
'update-directory-autoloads "22.1")
-(defvar autoload-make-program (or (getenv "MAKE") "make")
- "Name of the make program in use during the Emacs build process.")
-
;;;###autoload
(defun batch-update-autoloads ()
"Update loaddefs.el autoloads in batch mode.
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el
index bc1efc118ef..1f00677cd00 100644
--- a/lisp/emacs-lisp/avl-tree.el
+++ b/lisp/emacs-lisp/avl-tree.el
@@ -1,6 +1,6 @@
;;; avl-tree.el --- balanced binary trees, AVL-trees
-;; Copyright (C) 1995, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2007-2012 Free Software Foundation, Inc.
;; Author: Per Cederqvist <ceder@lysator.liu.se>
;; Inge Wallin <inge@lysator.liu.se>
@@ -31,7 +31,7 @@
;; deleting, and retrieving data from an AVL tree containing n elements
;; is O(log n). It is somewhat more rigidly balanced than other
;; self-balancing binary trees (such as red-black trees and AA trees),
-;; making insertion slighty slower, deletion somewhat slower, and
+;; making insertion slightly slower, deletion somewhat slower, and
;; retrieval somewhat faster (the asymptotic scaling is of course the
;; same for all types). Thus it may be a good choice when the tree will
;; be relatively static, i.e. data will be retrieved more often than
@@ -260,7 +260,7 @@ Return t if the height of the tree has grown."
(opp (avl-tree--switch-dir dir))
;; direction 0,1 -> sign factor -1,+1
(sgn (avl-tree--dir-to-sign dir))
- p1 p2 b2 result)
+ p1 p2 b2)
(cond
((< (* sgn (avl-tree--node-balance br)) 0)
(setf (avl-tree--node-balance br) 0)
@@ -295,9 +295,9 @@ Return t if the height of the tree has grown."
(if (> (* sgn b2) 0) (- sgn) 0)
(avl-tree--node-balance p1)
(if (< (* sgn b2) 0) sgn 0)
- (avl-tree--node-branch node branch) p2
- (avl-tree--node-balance
- (avl-tree--node-branch node branch)) 0))
+ (avl-tree--node-branch node branch) p2))
+ (setf (avl-tree--node-balance
+ (avl-tree--node-branch node branch)) 0)
nil))))
(defun avl-tree--do-enter (cmpfun root branch data &optional updatefun)
@@ -339,6 +339,16 @@ inserted data."
(cons nil newdata)) ; return value
))))
+(defun avl-tree--check (tree)
+ "Check the tree's balance."
+ (avl-tree--check-node (avl-tree--root tree)))
+(defun avl-tree--check-node (node)
+ (if (null node) 0
+ (let ((dl (avl-tree--check-node (avl-tree--node-left node)))
+ (dr (avl-tree--check-node (avl-tree--node-right node))))
+ (assert (= (- dr dl) (avl-tree--node-balance node)))
+ (1+ (max dl dr)))))
+
;; ----------------------------------------------------------------
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
index 34e316b2e48..870127ceac8 100644
--- a/lisp/emacs-lisp/backquote.el
+++ b/lisp/emacs-lisp/backquote.el
@@ -1,6 +1,6 @@
;;; backquote.el --- implement the ` Lisp construct
-;; Copyright (C) 1990, 1992, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1992, 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Rick Sladkey <jrs@world.std.com>
;; Maintainer: FSF
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index aa84a075b76..9029c81f279 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -1,6 +1,6 @@
;;; benchmark.el --- support for benchmarking code
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: lisp, extensions
@@ -53,6 +53,7 @@ FORMS once.
Return a list of the total elapsed time for execution, the number of
garbage collections that ran, and the time taken by garbage collection.
See also `benchmark-run-compiled'."
+ (declare (indent 1) (debug t))
(unless (natnump repetitions)
(setq forms (cons repetitions forms)
repetitions 1))
@@ -69,8 +70,6 @@ See also `benchmark-run-compiled'."
`(benchmark-elapse ,@forms))
(- gcs-done ,gcs)
(- gc-elapsed ,gc)))))
-(put 'benchmark-run 'edebug-form-spec t)
-(put 'benchmark-run 'lisp-indent-function 2)
;;;###autoload
(defmacro benchmark-run-compiled (&optional repetitions &rest forms)
@@ -78,6 +77,7 @@ See also `benchmark-run-compiled'."
This is like `benchmark-run', but what is timed is a funcall of the
byte code obtained by wrapping FORMS in a `lambda' and compiling the
result. The overhead of the `lambda's is accounted for."
+ (declare (indent 1) (debug t))
(unless (natnump repetitions)
(setq forms (cons repetitions forms)
repetitions 1))
@@ -96,8 +96,6 @@ result. The overhead of the `lambda's is accounted for."
(funcall ,lambda-code))))
`(benchmark-elapse (funcall ,code)))
(- gcs-done ,gcs) (- gc-elapsed ,gc)))))
-(put 'benchmark-run-compiled 'edebug-form-spec t)
-(put 'benchmark-run-compiled 'lisp-indent-function 2)
;;;###autoload
(defun benchmark (repetitions form)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index fd98b5f41a7..03d55f376af 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -1,6 +1,6 @@
;;; bindat.el --- binary data structure packing and unpacking.
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Assignment name: struct.el
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index c9027fb663d..07e95e7e4cd 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1,6 +1,6 @@
;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler -*- lexical-binding: t -*-
-;; Copyright (C) 1991, 1994, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994, 2000-2012 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
@@ -183,7 +183,8 @@
;;; Code:
(require 'bytecomp)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+(require 'macroexp)
(defun byte-compile-log-lap-1 (format &rest args)
;; Newer byte codes for stack-ref make the slot 0 non-nil again.
@@ -248,8 +249,8 @@
(let* ((name (car form))
(localfn (cdr (assq name byte-compile-function-environment)))
(fn (or localfn (and (fboundp name) (symbol-function name)))))
- (when (and (consp fn) (eq (car fn) 'autoload))
- (load (nth 1 fn))
+ (when (autoloadp fn)
+ (autoload-do-load fn)
(setq fn (or (and (fboundp name) (symbol-function name))
(cdr (assq name byte-compile-function-environment)))))
(pcase fn
@@ -265,38 +266,30 @@
;; (message "Inlining byte-code for %S!" name)
;; The byte-code will be really inlined in byte-compile-unfold-bcf.
`(,fn ,@(cdr form)))
- ((or (and `(lambda ,args . ,body) (let env nil))
- `(closure ,env ,args . ,body))
+ ((or `(lambda . ,_) `(closure . ,_))
(if (not (or (eq fn localfn) ;From the same file => same mode.
- (eq (not lexical-binding) (not env)))) ;Same mode.
+ (eq (car fn) ;Same mode.
+ (if lexical-binding 'closure 'lambda))))
;; While byte-compile-unfold-bcf can inline dynbind byte-code into
;; letbind byte-code (or any other combination for that matter), we
;; can only inline dynbind source into dynbind source or letbind
;; source into letbind source.
- ;; FIXME: we could of course byte-compile the inlined function
- ;; first, and then inline its byte-code.
- form
- (let ((renv ()))
- ;; Turn the function's closed vars (if any) into local let bindings.
- (dolist (binding env)
- (cond
- ((consp binding)
- ;; We check shadowing by the args, so that the `let' can be
- ;; moved within the lambda, which can then be unfolded.
- ;; FIXME: Some of those bindings might be unused in `body'.
- (unless (memq (car binding) args) ;Shadowed.
- (push `(,(car binding) ',(cdr binding)) renv)))
- ((eq binding t))
- (t (push `(defvar ,binding) body))))
- (let ((newfn (byte-compile-preprocess
- (if (null renv)
- `(lambda ,args ,@body)
- `(lambda ,args (let ,(nreverse renv) ,@body))))))
- (if (eq (car-safe newfn) 'function)
- (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
- (byte-compile-log-warning
- (format "Inlining closure %S failed" name))
- form)))))
+ (progn
+ ;; We can of course byte-compile the inlined function
+ ;; first, and then inline its byte-code.
+ (byte-compile name)
+ `(,(symbol-function name) ,@(cdr form)))
+ (let ((newfn (if (eq fn localfn)
+ ;; If `fn' is from the same file, it has already
+ ;; been preprocessed!
+ `(function ,fn)
+ (byte-compile-preprocess
+ (byte-compile--reify-function fn)))))
+ (if (eq (car-safe newfn) 'function)
+ (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
+ (byte-compile-log-warning
+ (format "Inlining closure %S failed" name))
+ form))))
(t ;; Give up on inlining.
form))))
@@ -430,11 +423,9 @@
clause))
(cdr form))))
((eq fn 'progn)
- ;; as an extra added bonus, this simplifies (progn <x>) --> <x>
+ ;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
(if (cdr (cdr form))
- (progn
- (setq tmp (byte-optimize-body (cdr form) for-effect))
- (if (cdr tmp) (cons 'progn tmp) (car tmp)))
+ (macroexp-progn (byte-optimize-body (cdr form) for-effect))
(byte-optimize-form (nth 1 form) for-effect)))
((eq fn 'prog1)
(if (cdr (cdr form))
@@ -496,7 +487,7 @@
(prin1-to-string form))
nil)
- ((memq fn '(defun defmacro function condition-case))
+ ((memq fn '(function condition-case))
;; These forms are compiled as constants or by breaking out
;; all the subexpressions and compiling them separately.
form)
@@ -573,10 +564,10 @@
(cons fn args)))))))
(defun byte-optimize-all-constp (list)
- "Non-nil if all elements of LIST satisfy `byte-compile-constp'."
+ "Non-nil if all elements of LIST satisfy `macroexp-const-p"
(let ((constant t))
(while (and list constant)
- (unless (byte-compile-constp (car list))
+ (unless (macroexp-const-p (car list))
(setq constant nil))
(setq list (cdr list)))
constant))
@@ -595,10 +586,11 @@
(let (opt new)
(if (and (consp form)
(symbolp (car form))
- (or (and for-effect
- ;; we don't have any of these yet, but we might.
- (setq opt (get (car form) 'byte-for-effect-optimizer)))
- (setq opt (get (car form) 'byte-optimizer)))
+ (or ;; (and for-effect
+ ;; ;; We don't have any of these yet, but we might.
+ ;; (setq opt (get (car form)
+ ;; 'byte-for-effect-optimizer)))
+ (setq opt (function-get (car form) 'byte-optimizer)))
(not (eq form (setq new (funcall opt form)))))
(progn
;; (if (equal form new) (error "bogus optimizer -- %s" opt))
@@ -639,10 +631,10 @@
(while (eq (car-safe form) 'progn)
(setq form (car (last (cdr form)))))
(cond ((consp form)
- (case (car form)
- (quote (cadr form))
+ (pcase (car form)
+ (`quote (cadr form))
;; Can't use recursion in a defsubst.
- ;; (progn (byte-compile-trueconstp (car (last (cdr form)))))
+ ;; (`progn (byte-compile-trueconstp (car (last (cdr form)))))
))
((not (symbolp form)))
((eq form t))
@@ -653,10 +645,10 @@
(while (eq (car-safe form) 'progn)
(setq form (car (last (cdr form)))))
(cond ((consp form)
- (case (car form)
- (quote (null (cadr form)))
+ (pcase (car form)
+ (`quote (null (cadr form)))
;; Can't use recursion in a defsubst.
- ;; (progn (byte-compile-nilconstp (car (last (cdr form)))))
+ ;; (`progn (byte-compile-nilconstp (car (last (cdr form)))))
))
((not (symbolp form)) nil)
((null form))))
@@ -866,8 +858,8 @@
(defun byte-optimize-binary-predicate (form)
- (if (byte-compile-constp (nth 1 form))
- (if (byte-compile-constp (nth 2 form))
+ (if (macroexp-const-p (nth 1 form))
+ (if (macroexp-const-p (nth 2 form))
(condition-case ()
(list 'quote (eval form))
(error form))
@@ -879,7 +871,7 @@
(let ((ok t)
(rest (cdr form)))
(while (and rest ok)
- (setq ok (byte-compile-constp (car rest))
+ (setq ok (macroexp-const-p (car rest))
rest (cdr rest)))
(if ok
(condition-case ()
@@ -945,7 +937,7 @@
(defun byte-optimize-quote (form)
(if (or (consp (nth 1 form))
(and (symbolp (nth 1 form))
- (not (byte-compile-const-symbol-p form))))
+ (not (macroexp--const-symbol-p form))))
form
(nth 1 form)))
@@ -1155,16 +1147,6 @@
;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
;; string-make-multibyte for constant args.
-(put 'featurep 'byte-optimizer 'byte-optimize-featurep)
-(defun byte-optimize-featurep (form)
- ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so we
- ;; can safely optimize away this test.
- (if (member (cdr-safe form) '(((quote xemacs)) ((quote sxemacs))))
- nil
- (if (member (cdr-safe form) '(((quote emacs))))
- t
- form)))
-
(put 'set 'byte-optimizer 'byte-optimize-set)
(defun byte-optimize-set (form)
(let ((var (car-safe (cdr-safe form))))
@@ -1205,8 +1187,8 @@
boundp buffer-file-name buffer-local-variables buffer-modified-p
buffer-substring byte-code-function-p
capitalize car-less-than-car car cdr ceiling char-after char-before
- char-equal char-to-string char-width
- compare-strings concat coordinates-in-window-p
+ char-equal char-to-string char-width compare-strings
+ compare-window-configurations concat coordinates-in-window-p
copy-alist copy-sequence copy-marker cos count-lines
decode-char
decode-time default-boundp default-value documentation downcase
@@ -1214,17 +1196,18 @@
fboundp fceiling featurep ffloor
file-directory-p file-exists-p file-locked-p file-name-absolute-p
file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
- float float-time floor format format-time-string frame-visible-p
- fround ftruncate
+ float float-time floor format format-time-string frame-first-window
+ frame-root-window frame-selected-window
+ frame-visible-p fround ftruncate
get gethash get-buffer get-buffer-window getenv get-file-buffer
hash-table-count
int-to-string intern-soft
keymap-parent
length local-variable-if-set-p local-variable-p log log10 logand
logb logior lognot logxor lsh langinfo
- make-list make-string make-symbol
- marker-buffer max member memq min mod multibyte-char-to-unibyte
- next-window nth nthcdr number-to-string
+ make-list make-string make-symbol marker-buffer max member memq min
+ minibuffer-selected-window minibuffer-window
+ mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string
parse-colon-path plist-get plist-member
prefix-numeric-value previous-window prin1-to-string propertize
degrees-to-radians
@@ -1237,11 +1220,21 @@
string-to-multibyte
tan truncate
unibyte-char-to-multibyte upcase user-full-name
- user-login-name user-original-login-name user-variable-p
+ user-login-name user-original-login-name custom-variable-p
vconcat
- window-buffer window-dedicated-p window-edges window-height
- window-hscroll window-minibuffer-p window-width
- zerop))
+ window-absolute-pixel-edges window-at window-body-height
+ window-body-width window-buffer window-dedicated-p window-display-table
+ window-combination-limit window-edges window-frame window-fringes
+ window-height window-hscroll window-inside-edges
+ window-inside-absolute-pixel-edges window-inside-pixel-edges
+ window-left-child window-left-column window-margins window-minibuffer-p
+ window-next-buffers window-next-sibling window-new-normal
+ window-new-total window-normal-size window-parameter window-parameters
+ window-parent window-pixel-edges window-point window-prev-buffers
+ window-prev-sibling window-redisplay-end-trigger window-scroll-bars
+ window-start window-text-height window-top-child window-top-line
+ window-total-height window-total-width window-use-time window-vscroll
+ window-width zerop))
(side-effect-and-error-free-fns
'(arrayp atom
bobp bolp bool-vector-p
@@ -1274,7 +1267,8 @@
this-single-command-raw-keys
user-real-login-name user-real-uid user-uid
vector vectorp visible-frame-list
- wholenump window-configuration-p window-live-p windowp)))
+ wholenump window-configuration-p window-live-p
+ window-valid-p windowp)))
(while side-effect-free-fns
(put (car side-effect-free-fns) 'side-effect-free t)
(setq side-effect-free-fns (cdr side-effect-free-fns)))
@@ -1373,7 +1367,7 @@
;; This uses dynamic-scope magic.
offset (disassemble-offset bytes))
(let ((opcode (aref byte-code-vector bytedecomp-op)))
- (assert opcode)
+ (cl-assert opcode)
(setq bytedecomp-op opcode))
(cond ((memq bytedecomp-op byte-goto-ops)
;; It's a pc.
@@ -1574,7 +1568,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
;; stack-set-X+1 stack-ref-X --> dup stack-set-X+2
;; but this is a very minor gain, since dup is stack-ref-0,
;; i.e. it's only better if X>5, and even then it comes
- ;; at the cost cost of an extra stack slot. Let's not bother.
+ ;; at the cost of an extra stack slot. Let's not bother.
((and (eq 'byte-varref (car lap2))
(eq (cdr lap1) (cdr lap2))
(memq (car lap1) '(byte-varset byte-varbind)))
@@ -1582,13 +1576,13 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
(not (eq (car lap0) 'byte-constant)))
nil
(setq keep-going t)
- (if (memq (car lap0) '(byte-constant byte-dup))
- (progn
- (setq tmp (if (or (not tmp)
- (byte-compile-const-symbol-p
- (car (cdr lap0))))
- (cdr lap0)
- (byte-compile-get-constant t)))
+ (if (memq (car lap0) '(byte-constant byte-dup))
+ (progn
+ (setq tmp (if (or (not tmp)
+ (macroexp--const-symbol-p
+ (car (cdr lap0))))
+ (cdr lap0)
+ (byte-compile-get-constant t)))
(byte-compile-log-lap " %s %s %s\t-->\t%s %s %s"
lap0 lap1 lap2 lap0 lap1
(cons (car lap0) tmp))
@@ -1616,7 +1610,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
(byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1)
(setq keep-going t
rest (cdr rest))
- (if (eq 'byte-stack-set (car lap1)) (decf (cdr lap1)))
+ (if (eq 'byte-stack-set (car lap1)) (cl-decf (cdr lap1)))
(setq lap (delq lap0 (delq lap2 lap))))
;;
;; not goto-X-if-nil --> goto-X-if-non-nil
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index f79add14836..b4582a41d6c 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -1,6 +1,6 @@
-;;; byte-run.el --- byte-compiler support for inlining
+;;; byte-run.el --- byte-compiler support for inlining -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
@@ -30,37 +30,181 @@
;;; Code:
-;; We define macro-declaration-function here because it is needed to
-;; handle declarations in macro definitions and this is the first file
-;; loaded by loadup.el that uses declarations in macros.
+;; `macro-declaration-function' are both obsolete (as marked at the end of this
+;; file) but used in many .elc files.
+
+(defvar macro-declaration-function #'macro-declaration-function
+ "Function to process declarations in a macro definition.
+The function will be called with two args MACRO and DECL.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The value the function returns is not used.")
-(defun macro-declaration-function (macro decl)
- "Process a declaration found in a macro definition.
+(defalias 'macro-declaration-function
+ #'(lambda (macro decl)
+ "Process a declaration found in a macro definition.
This is set as the value of the variable `macro-declaration-function'.
MACRO is the name of the macro being defined.
DECL is a list `(declare ...)' containing the declarations.
The return value of this function is not used."
- ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
- (let (d)
- ;; Ignore the first element of `decl' (it's always `declare').
- (while (setq decl (cdr decl))
- (setq d (car decl))
- (if (and (consp d)
- (listp (cdr d))
- (null (cdr (cdr d))))
- (cond ((eq (car d) 'indent)
- (put macro 'lisp-indent-function (car (cdr d))))
- ((eq (car d) 'debug)
- (put macro 'edebug-form-spec (car (cdr d))))
- ((eq (car d) 'doc-string)
- (put macro 'doc-string-elt (car (cdr d))))
- (t
- (message "Unknown declaration %s" d)))
- (message "Invalid declaration %s" d)))))
-
-
-(setq macro-declaration-function 'macro-declaration-function)
+ ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
+ (let (d)
+ ;; Ignore the first element of `decl' (it's always `declare').
+ (while (setq decl (cdr decl))
+ (setq d (car decl))
+ (if (and (consp d)
+ (listp (cdr d))
+ (null (cdr (cdr d))))
+ (cond ((eq (car d) 'indent)
+ (put macro 'lisp-indent-function (car (cdr d))))
+ ((eq (car d) 'debug)
+ (put macro 'edebug-form-spec (car (cdr d))))
+ ((eq (car d) 'doc-string)
+ (put macro 'doc-string-elt (car (cdr d))))
+ (t
+ (message "Unknown declaration %s" d)))
+ (message "Invalid declaration %s" d))))))
+
+;; We define macro-declaration-alist here because it is needed to
+;; handle declarations in macro definitions and this is the first file
+;; loaded by loadup.el that uses declarations in macros.
+(defvar defun-declarations-alist
+ (list
+ ;; We can only use backquotes inside the lambdas and not for those
+ ;; properties that are used by functions loaded before backquote.el.
+ (list 'advertised-calling-convention
+ #'(lambda (f _args arglist when)
+ (list 'set-advertised-calling-convention
+ (list 'quote f) (list 'quote arglist) (list 'quote when))))
+ (list 'obsolete
+ #'(lambda (f _args new-name when)
+ `(make-obsolete ',f ',new-name ,when)))
+ (list 'compiler-macro
+ #'(lambda (f args compiler-function)
+ ;; FIXME: Make it possible to just reuse `args'.
+ `(eval-and-compile
+ (put ',f 'compiler-macro
+ ,(if (eq (car-safe compiler-function) 'lambda)
+ `(lambda ,(append (cadr compiler-function) args)
+ ,@(cddr compiler-function))
+ `#',compiler-function)))))
+ (list 'doc-string
+ #'(lambda (f _args pos)
+ (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos))))
+ (list 'indent
+ #'(lambda (f _args val)
+ (list 'put (list 'quote f)
+ ''lisp-indent-function (list 'quote val)))))
+ "List associating function properties to their macro expansion.
+Each element of the list takes the form (PROP FUN) where FUN is
+a function. For each (PROP . VALUES) in a function's declaration,
+the FUN corresponding to PROP is called with the function name,
+the function's arglist, and the VALUES and should return the code to use
+to set this property.")
+
+(defvar macro-declarations-alist
+ (cons
+ (list 'debug
+ #'(lambda (name _args spec)
+ (list 'progn :autoload-end
+ (list 'put (list 'quote name)
+ ''edebug-form-spec (list 'quote spec)))))
+ defun-declarations-alist)
+ "List associating properties of macros to their macro expansion.
+Each element of the list takes the form (PROP FUN) where FUN is
+a function. For each (PROP . VALUES) in a macro's declaration,
+the FUN corresponding to PROP is called with the function name
+and the VALUES and should return the code to use to set this property.")
+
+(put 'defmacro 'doc-string-elt 3)
+(defalias 'defmacro
+ (cons
+ 'macro
+ #'(lambda (name arglist &optional docstring decl &rest body)
+ "Define NAME as a macro.
+When the macro is called, as in (NAME ARGS...),
+the function (lambda ARGLIST BODY...) is applied to
+the list ARGS... as it appears in the expression,
+and the result should be a form to be evaluated instead of the original.
+DECL is a declaration, optional, of the form (declare DECLS...) where
+DECLS is a list of elements of the form (PROP . VALUES). These are
+interpreted according to `macro-declarations-alist'.
+The return value is undefined."
+ (if (stringp docstring) nil
+ (if decl (setq body (cons decl body)))
+ (setq decl docstring)
+ (setq docstring nil))
+ (if (or (null decl) (eq 'declare (car-safe decl))) nil
+ (setq body (cons decl body))
+ (setq decl nil))
+ (if (null body) (setq body '(nil)))
+ (if docstring (setq body (cons docstring body)))
+ ;; Can't use backquote because it's not defined yet!
+ (let* ((fun (list 'function (cons 'lambda (cons arglist body))))
+ (def (list 'defalias
+ (list 'quote name)
+ (list 'cons ''macro fun)))
+ (declarations
+ (mapcar
+ #'(lambda (x)
+ (let ((f (cdr (assq (car x) macro-declarations-alist))))
+ (if f (apply (car f) name arglist (cdr x))
+ (message "Warning: Unknown macro property %S in %S"
+ (car x) name))))
+ (cdr decl))))
+ (if declarations
+ (cons 'prog1 (cons def declarations))
+ def)))))
+
+;; Now that we defined defmacro we can use it!
+(defmacro defun (name arglist &optional docstring &rest body)
+ "Define NAME as a function.
+The definition is (lambda ARGLIST [DOCSTRING] BODY...).
+See also the function `interactive'.
+DECL is a declaration, optional, of the form (declare DECLS...) where
+DECLS is a list of elements of the form (PROP . VALUES). These are
+interpreted according to `defun-declarations-alist'.
+The return value is undefined.
+
+\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
+ ;; We can't just have `decl' as an &optional argument, because we need
+ ;; to distinguish
+ ;; (defun foo (arg) (toto) nil)
+ ;; from
+ ;; (defun foo (arg) (toto)).
+ (declare (doc-string 3))
+ (let ((decls (cond
+ ((eq (car-safe docstring) 'declare)
+ (prog1 (cdr docstring) (setq docstring nil)))
+ ((eq (car-safe (car body)) 'declare)
+ (prog1 (cdr (car body)) (setq body (cdr body)))))))
+ (if docstring (setq body (cons docstring body))
+ (if (null body) (setq body '(nil))))
+ (let ((declarations
+ (mapcar
+ #'(lambda (x)
+ (let ((f (cdr (assq (car x) defun-declarations-alist))))
+ (cond
+ (f (apply (car f) name arglist (cdr x)))
+ ;; Yuck!!
+ ((and (featurep 'cl)
+ (memq (car x) ;C.f. cl-do-proclaim.
+ '(special inline notinline optimize warn)))
+ (push (list 'declare x)
+ (if (stringp docstring) (cdr body) body))
+ nil)
+ (t (message "Warning: Unknown defun property `%S' in %S"
+ (car x) name)))))
+ decls))
+ (def (list 'defalias
+ (list 'quote name)
+ (list 'function
+ (cons 'lambda
+ (cons arglist body))))))
+ (if declarations
+ (cons 'prog1 (cons def declarations))
+ def))))
;; Redefined in byte-optimize.el.
;; This is not documented--it's not clear that we should promote it.
@@ -93,10 +237,10 @@ The return value of this function is not used."
;; (list 'put x ''byte-optimizer nil)))
;; fns)))
-;; This has a special byte-hunk-handler in bytecomp.el.
(defmacro defsubst (name arglist &rest body)
- "Define an inline function. The syntax is just like that of `defun'."
- (declare (debug defun))
+ "Define an inline function. The syntax is just like that of `defun'.
+\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
+ (declare (debug defun) (doc-string 3))
(or (memq (get name 'byte-optimizer)
'(nil byte-compile-inline-expand))
(error "`%s' is a primitive" name))
@@ -107,7 +251,7 @@ The return value of this function is not used."
(defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key))
-(defun set-advertised-calling-convention (function signature when)
+(defun set-advertised-calling-convention (function signature _when)
"Set the advertised SIGNATURE of FUNCTION.
This will allow the byte-compiler to warn the programmer when she uses
an obsolete calling convention. WHEN specifies since when the calling
@@ -116,21 +260,23 @@ 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).
WHEN should be a string indicating when the function
was first made obsolete, for example a date or a release number."
+ (declare (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when) "23.1"))
(interactive "aMake function obsolete: \nxObsoletion replacement: ")
(put obsolete-name 'byte-obsolete-info
;; The second entry used to hold the `byte-compile' handler, but
;; is not used any more nowadays.
(purecopy (list current-name nil when)))
obsolete-name)
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'make-obsolete '(obsolete-name current-name when) "23.1")
(defmacro define-obsolete-function-alias (obsolete-name current-name
&optional when docstring)
@@ -144,14 +290,13 @@ is equivalent to the following two lines of code:
\(make-obsolete 'old-fun 'new-fun \"22.1\")
See the docstrings of `defalias' and `make-obsolete' for more details."
- (declare (doc-string 4))
+ (declare (doc-string 4)
+ (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when &optional docstring) "23.1"))
`(progn
(defalias ,obsolete-name ,current-name ,docstring)
(make-obsolete ,obsolete-name ,current-name ,when)))
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'define-obsolete-function-alias
- '(obsolete-name current-name when &optional docstring) "23.1")
(defun make-obsolete-variable (obsolete-name current-name &optional when access-type)
"Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
@@ -161,13 +306,13 @@ WHEN should be a string indicating when the variable
was first made obsolete, for example a date or a release number.
ACCESS-TYPE if non-nil should specify the kind of access that will trigger
obsolescence warnings; it can be either `get' or `set'."
+ (declare (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when &optional access-type) "23.1"))
(put obsolete-name 'byte-obsolete-variable
(purecopy (list current-name access-type when)))
obsolete-name)
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'make-obsolete-variable
- '(obsolete-name current-name when &optional access-type) "23.1")
+
(defmacro define-obsolete-variable-alias (obsolete-name current-name
&optional when docstring)
@@ -176,7 +321,7 @@ This uses `defvaralias' and `make-obsolete-variable' (which see).
See the Info node `(elisp)Variable Aliases' for more details.
If CURRENT-NAME is a defcustom (more generally, any variable
-where OBSOLETE-NAME may be set, e.g. in a .emacs file, before the
+where OBSOLETE-NAME may be set, e.g. in an init file, before the
alias is defined), then the define-obsolete-variable-alias
statement should be evaluated before the defcustom, if user
customizations are to be respected. The simplest way to achieve
@@ -190,7 +335,10 @@ For the benefit of `custom-set-variables', if OBSOLETE-NAME has
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:
'saved-value, 'saved-variable-comment."
- (declare (doc-string 4))
+ (declare (doc-string 4)
+ (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when &optional docstring) "23.1"))
`(progn
(defvaralias ,obsolete-name ,current-name ,docstring)
;; See Bug#4706.
@@ -199,10 +347,6 @@ CURRENT-NAME, if it does not already have them:
(null (get ,current-name prop))
(put ,current-name prop (get ,obsolete-name prop))))
(make-obsolete-variable ,obsolete-name ,current-name ,when)))
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'define-obsolete-variable-alias
- '(obsolete-name current-name when &optional docstring) "23.1")
;; FIXME This is only defined in this file because the variable- and
;; function- versions are too. Unlike those two, this one is not used
@@ -283,4 +427,9 @@ In interpreted code, this is entirely equivalent to `progn'."
;; (file-format emacs19))"
;; nil)
+(make-obsolete-variable 'macro-declaration-function
+ 'macro-declarations-alist "24.3")
+(make-obsolete 'macro-declaration-function
+ 'macro-declarations-alist "24.3")
+
;;; byte-run.el ends here
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 29c5f3f092b..5867cfb7064 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1,6 +1,6 @@
;;; bytecomp.el --- compilation of Lisp code into byte code -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2011
+;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
@@ -120,7 +120,7 @@
(require 'backquote)
(require 'macroexp)
(require 'cconv)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(or (fboundp 'defsubst)
;; This really ought to be loaded already!
@@ -355,7 +355,7 @@ else the global value will be modified."
(defvar byte-compile-interactive-only-functions
'(beginning-of-buffer end-of-buffer replace-string replace-regexp
insert-file insert-buffer insert-file-literally previous-line next-line
- goto-line comint-run delete-backward-char toggle-read-only)
+ goto-line comint-run delete-backward-char)
"List of commands that are not meant to be called from Lisp.")
(defvar byte-compile-not-obsolete-vars nil
@@ -419,8 +419,8 @@ This list lives partly on the stack.")
(defconst byte-compile-initial-macro-environment
'(
-;; (byte-compiler-options . (lambda (&rest forms)
-;; (apply 'byte-compiler-options-handler forms)))
+ ;; (byte-compiler-options . (lambda (&rest forms)
+ ;; (apply 'byte-compiler-options-handler forms)))
(declare-function . byte-compile-macroexpand-declare-function)
(eval-when-compile . (lambda (&rest body)
(list
@@ -429,8 +429,19 @@ This list lives partly on the stack.")
(byte-compile-top-level
(byte-compile-preprocess (cons 'progn body)))))))
(eval-and-compile . (lambda (&rest body)
- (byte-compile-eval-before-compile (cons 'progn body))
- (cons 'progn body))))
+ ;; Byte compile before running it. Do it piece by
+ ;; piece, in case further expressions need earlier
+ ;; ones to be evaluated already, as is the case in
+ ;; eieio.el.
+ `(progn
+ ,@(mapcar (lambda (exp)
+ (let ((cexp
+ (byte-compile-top-level
+ (byte-compile-preprocess
+ exp))))
+ (eval cexp)
+ cexp))
+ body)))))
"The default macro-environment passed to macroexpand by the compiler.
Placing a macro here will cause a macro to have different semantics when
expanded by the compiler as when expanded by the interpreter.")
@@ -731,14 +742,16 @@ otherwise pop it")
;; Also, this lets us notice references to free variables.
(defmacro byte-compile-push-bytecodes (&rest args)
- "Push BYTE... onto BYTES, and increment PC by the number of bytes pushed.
-ARGS is of the form (BYTE... BYTES PC), where BYTES and PC are variable names.
-BYTES and PC are updated after evaluating all the arguments."
+ "Push bytes onto BVAR, and increment CVAR by the number of bytes pushed.
+BVAR and CVAR are variables which are updated after evaluating
+all the arguments.
+
+\(fn BYTE1 BYTE2 ... BYTEn BVAR CVAR)"
(let ((byte-exprs (butlast args 2))
(bytes-var (car (last args 2)))
(pc-var (car (last args))))
`(setq ,bytes-var ,(if (null (cdr byte-exprs))
- `(progn (assert (<= 0 ,(car byte-exprs)))
+ `(progn (cl-assert (<= 0 ,(car byte-exprs)))
(cons ,@byte-exprs ,bytes-var))
`(nconc (list ,@(reverse byte-exprs)) ,bytes-var))
,pc-var (+ ,(length byte-exprs) ,pc-var))))
@@ -846,7 +859,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.
@@ -863,25 +876,14 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(let ((xs (pop hist-new))
old-autoloads)
;; Make sure the file was not already loaded before.
- (unless (or (assoc (car xs) hist-orig)
- ;; Don't give both the "noruntime" and
- ;; "cl-functions" warning for the same function.
- ;; FIXME This seems incorrect - these are two
- ;; independent warnings. For example, you may be
- ;; choosing to see the cl warnings but ignore them.
- ;; You probably don't want to ignore noruntime in the
- ;; same way.
- (and (byte-compile-warning-enabled-p 'cl-functions)
- (byte-compile-cl-file-p (car xs))))
+ (unless (assoc (car xs) hist-orig)
(dolist (s xs)
(cond
- ((symbolp s)
- (unless (memq s old-autoloads)
- (push s byte-compile-noruntime-functions)))
((and (consp s) (eq t (car s)))
(push (cdr s) old-autoloads))
- ((and (consp s) (eq 'autoload (car s)))
- (push (cdr s) byte-compile-noruntime-functions)))))))
+ ((and (consp s) (memq (car s) '(autoload defun)))
+ (unless (memq (cdr s) old-autoloads)
+ (push (cdr s) byte-compile-noruntime-functions))))))))
;; Go through current-load-list for the locally defined funs.
(let (old-autoloads)
(while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
@@ -1002,18 +1004,32 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(defvar byte-compile-last-warned-form nil)
(defvar byte-compile-last-logged-file nil)
+(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 default-directory)
+ (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:"
(buffer-name byte-compile-current-file)))
+ ;; We might be simply loading a file that
+ ;; contains explicit calls to byte-compile functions.
+ ((stringp load-file-name)
+ (format "%s:" (byte-compile-abbreviate-file
+ load-file-name dir)))
(t "")))
(pos (if (and byte-compile-current-file
(integerp byte-compile-read-position))
@@ -1094,8 +1110,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(defun byte-compile-log-warning (string &optional fill level)
(let ((warning-prefix-function 'byte-compile-warning-prefix)
(warning-type-format "")
- (warning-fill-prefix (if fill " "))
- (inhibit-read-only t))
+ (warning-fill-prefix (if fill " ")))
(display-warning 'bytecomp string level byte-compile-log-buffer)))
(defun byte-compile-warn (format &rest args)
@@ -1109,18 +1124,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."
@@ -1167,12 +1176,14 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(t fn)))))))
(defun byte-compile-arglist-signature (arglist)
- (if (integerp arglist)
- ;; New style byte-code arglist.
- (cons (logand arglist 127) ;Mandatory.
- (if (zerop (logand arglist 128)) ;No &rest.
- (lsh arglist -8))) ;Nonrest.
- ;; Old style byte-code, or interpreted function.
+ (cond
+ ;; New style byte-code arglist.
+ ((integerp arglist)
+ (cons (logand arglist 127) ;Mandatory.
+ (if (zerop (logand arglist 128)) ;No &rest.
+ (lsh arglist -8)))) ;Nonrest.
+ ;; Old style byte-code, or interpreted function.
+ ((listp arglist)
(let ((args 0)
opts
restp)
@@ -1188,7 +1199,9 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(setq opts (1+ opts))
(setq args (1+ args)))))
(setq arglist (cdr arglist)))
- (cons args (if restp nil (if opts (+ args opts) args))))))
+ (cons args (if restp nil (if opts (+ args opts) args)))))
+ ;; Unknown arglist.
+ (t '(0))))
(defun byte-compile-arglist-signatures-congruent-p (old new)
@@ -1248,8 +1261,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
;; and/or remember its arity if it's unknown.
(or (and (or def (fboundp (car form))) ; might be a subr or autoload.
(not (memq (car form) byte-compile-noruntime-functions)))
- (eq (car form) byte-compile-current-form) ; ## this doesn't work
- ; with recursion.
+ (eq (car form) byte-compile-current-form) ; ## This doesn't work
+ ; with recursion.
;; It's a currently-undefined function.
;; Remember number of args in call.
(let ((cons (assq (car form) byte-compile-unresolved-functions))
@@ -1314,9 +1327,8 @@ extra args."
;; Warn if the function or macro is being redefined with a different
;; number of arguments.
-(defun byte-compile-arglist-warn (form macrop)
- (let* ((name (nth 1 form))
- (old (byte-compile-fdefinition name macrop))
+(defun byte-compile-arglist-warn (name arglist macrop)
+ (let* ((old (byte-compile-fdefinition name macrop))
(initial (and macrop
(cdr (assq name
byte-compile-initial-macro-environment)))))
@@ -1335,12 +1347,12 @@ extra args."
(`(closure ,_ ,args . ,_) args)
((pred byte-code-function-p) (aref old 0))
(t '(&rest def)))))
- (sig2 (byte-compile-arglist-signature (nth 2 form))))
+ (sig2 (byte-compile-arglist-signature arglist)))
(unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
(byte-compile-set-symbol-position name)
(byte-compile-warn
"%s %s used to take %s %s, now takes %s"
- (if (eq (car form) 'defun) "function" "macro")
+ (if macrop "macro" "function")
name
(byte-compile-arglist-signature-string sig1)
(if (equal sig1 '(1 . 1)) "argument" "arguments")
@@ -1350,11 +1362,11 @@ extra args."
nums sig min max)
(when calls
(when (and (symbolp name)
- (eq (get name 'byte-optimizer)
+ (eq (function-get name 'byte-optimizer)
'byte-compile-inline-expand))
(byte-compile-warn "defsubst `%s' was used before it was defined"
name))
- (setq sig (byte-compile-arglist-signature (nth 2 form))
+ (setq sig (byte-compile-arglist-signature arglist)
nums (sort (copy-sequence (cdr calls)) (function <))
min (car nums)
max (car (nreverse nums)))
@@ -1394,18 +1406,18 @@ extra args."
;; These aren't all aliases of subrs, so not trivial to
;; avoid hardwiring the list.
(not (memq func
- '(cl-block-wrapper cl-block-throw
+ '(cl--block-wrapper cl--block-throw
multiple-value-call nth-value
copy-seq first second rest endp cl-member
;; These are included in generated code
;; that can't be called except at compile time
;; or unless cl is loaded anyway.
- cl-defsubst-expand cl-struct-setf-expander
+ cl--defsubst-expand cl-struct-setf-expander
;; These would sometimes be warned about
;; but such warnings are never useful,
;; so don't warn about them.
macroexpand cl-macroexpand-all
- cl-compiling-file))))
+ cl--compiling-file))))
(byte-compile-warn "function `%s' from cl package called at runtime"
func)))
form)
@@ -1459,57 +1471,40 @@ extra args."
nil)
-(defsubst byte-compile-const-symbol-p (symbol &optional any-value)
- "Non-nil if SYMBOL is constant.
-If ANY-VALUE is nil, only return non-nil if the value of the symbol is the
-symbol itself."
- (or (memq symbol '(nil t))
- (keywordp symbol)
- (if any-value
- (or (memq symbol byte-compile-const-variables)
- ;; FIXME: We should provide a less intrusive way to find out
- ;; if a variable is "constant".
- (and (boundp symbol)
- (condition-case nil
- (progn (set symbol (symbol-value symbol)) nil)
- (setting-constant t)))))))
-
-(defmacro byte-compile-constp (form)
- "Return non-nil if FORM is a constant."
- `(cond ((consp ,form) (eq (car ,form) 'quote))
- ((not (symbolp ,form)))
- ((byte-compile-const-symbol-p ,form))))
+;; Dynamically bound in byte-compile-from-buffer.
+;; NB also used in cl.el and cl-macs.el.
+(defvar byte-compile--outbuffer)
(defmacro byte-compile-close-variables (&rest body)
(declare (debug t))
- (cons 'let
- (cons '(;;
- ;; Close over these variables to encapsulate the
- ;; compilation state
- ;;
- (byte-compile-macro-environment
- ;; Copy it because the compiler may patch into the
- ;; macroenvironment.
- (copy-alist byte-compile-initial-macro-environment))
- (byte-compile-function-environment nil)
- (byte-compile-bound-variables nil)
- (byte-compile-const-variables nil)
- (byte-compile-free-references nil)
- (byte-compile-free-assignments nil)
- ;;
- ;; Close over these variables so that `byte-compiler-options'
- ;; can change them on a per-file basis.
- ;;
- (byte-compile-verbose byte-compile-verbose)
- (byte-optimize byte-optimize)
- (byte-compile-dynamic byte-compile-dynamic)
- (byte-compile-dynamic-docstrings
- byte-compile-dynamic-docstrings)
-;; (byte-compile-generate-emacs19-bytecodes
-;; byte-compile-generate-emacs19-bytecodes)
- (byte-compile-warnings byte-compile-warnings)
- )
- body)))
+ `(let (;;
+ ;; Close over these variables to encapsulate the
+ ;; compilation state
+ ;;
+ (byte-compile-macro-environment
+ ;; Copy it because the compiler may patch into the
+ ;; macroenvironment.
+ (copy-alist byte-compile-initial-macro-environment))
+ (byte-compile--outbuffer nil)
+ (byte-compile-function-environment nil)
+ (byte-compile-bound-variables nil)
+ (byte-compile-const-variables nil)
+ (byte-compile-free-references nil)
+ (byte-compile-free-assignments nil)
+ ;;
+ ;; Close over these variables so that `byte-compiler-options'
+ ;; can change them on a per-file basis.
+ ;;
+ (byte-compile-verbose byte-compile-verbose)
+ (byte-optimize byte-optimize)
+ (byte-compile-dynamic byte-compile-dynamic)
+ (byte-compile-dynamic-docstrings
+ byte-compile-dynamic-docstrings)
+ ;; (byte-compile-generate-emacs19-bytecodes
+ ;; byte-compile-generate-emacs19-bytecodes)
+ (byte-compile-warnings byte-compile-warnings)
+ )
+ ,@body))
(defmacro displaying-byte-compile-warnings (&rest body)
(declare (debug t))
@@ -1603,10 +1598,11 @@ that already has a `.elc' file."
(not (auto-save-file-name-p source))
(not (string-equal dir-locals-file
(file-name-nondirectory source))))
- (progn (case (byte-recompile-file source force arg)
- (no-byte-compile (setq skip-count (1+ skip-count)))
- ((t) (setq file-count (1+ file-count)))
- ((nil) (setq fail-count (1+ fail-count))))
+ (progn (cl-incf
+ (pcase (byte-recompile-file source force arg)
+ (`no-byte-compile skip-count)
+ (`t file-count)
+ (_ fail-count)))
(or noninteractive
(message "Checking %s..." directory))
(if (not (eq last-dir directory))
@@ -1632,21 +1628,20 @@ This is normally set in local file variables at the end of the elisp file:
"Recompile FILENAME file if it needs recompilation.
This happens when its `.elc' file is older than itself.
-If the `.elc' file exists and is up-to-date, normally this
-function *does not* compile FILENAME. However, if the
-prefix argument FORCE is set, that means do compile
-FILENAME even if the destination already exists and is
-up-to-date.
+If the `.elc' file exists and is up-to-date, normally this function
+*does not* compile FILENAME. If the prefix argument FORCE is non-nil,
+however, it compiles FILENAME even if the destination already
+exists and is up-to-date.
-If the `.elc' file does not exist, normally this function *does
-not* compile FILENAME. If ARG is 0, that means
-compile the file even if it has never been compiled before.
-A nonzero ARG means ask the user.
+If the `.elc' file does not exist, normally this function *does not*
+compile FILENAME. If optional argument ARG is 0, it compiles
+the input file even if the `.elc' file does not exist.
+Any other non-nil value of ARG means to ask the user.
-If LOAD is set, `load' the file after compiling.
+If optional argument LOAD is non-nil, loads the file after compiling.
-The value returned is the value returned by `byte-compile-file',
-or 'no-byte-compile if the file did not need recompilation."
+If compilation is needed, this functions returns the result of
+`byte-compile-file'; otherwise it returns 'no-byte-compile."
(interactive
(let ((file buffer-file-name)
(file-name nil)
@@ -1676,7 +1671,8 @@ or 'no-byte-compile if the file did not need recompilation."
(if (and noninteractive (not byte-compile-verbose))
(message "Compiling %s..." filename))
(byte-compile-file filename load))
- (when load (load filename))
+ (when load
+ (load (if (file-exists-p dest) dest filename)))
'no-byte-compile)))
;;;###autoload
@@ -1737,15 +1733,24 @@ The value is non-nil if there were no errors, nil if errors."
(set-buffer-multibyte nil))
;; Run hooks including the uncompression hook.
;; If they change the file name, then change it for the output also.
- (letf ((buffer-file-name filename)
- ((default-value 'major-mode) 'emacs-lisp-mode)
- ;; Ignore unsafe local variables.
- ;; We only care about a few of them for our purposes.
- (enable-local-variables :safe)
- (enable-local-eval nil))
- ;; Arg of t means don't alter enable-local-variables.
- (normal-mode t)
- (setq filename buffer-file-name))
+ (let ((buffer-file-name filename)
+ (dmm (default-value 'major-mode))
+ ;; Ignore unsafe local variables.
+ ;; We only care about a few of them for our purposes.
+ (enable-local-variables :safe)
+ (enable-local-eval nil))
+ (unwind-protect
+ (progn
+ (setq-default major-mode 'emacs-lisp-mode)
+ ;; Arg of t means don't alter enable-local-variables.
+ (normal-mode t))
+ (setq-default major-mode dmm))
+ ;; There may be a file local variable setting (bug#10419).
+ (setq buffer-read-only nil
+ filename buffer-file-name))
+ ;; Don't inherit lexical-binding from caller (bug#12938).
+ (unless (local-variable-p 'lexical-binding)
+ (setq-local lexical-binding nil))
;; Set the default directory, in case an eval-when-compile uses it.
(setq default-directory (file-name-directory filename)))
;; Check if the file's local variables explicitly specify not to
@@ -1753,11 +1758,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.
@@ -1779,37 +1784,37 @@ The value is non-nil if there were no errors, nil if errors."
(with-current-buffer output-buffer
(goto-char (point-max))
(insert "\n") ; aaah, unix.
- (if (file-writable-p target-file)
- ;; We must disable any code conversion here.
- (let* ((coding-system-for-write 'no-conversion)
- ;; Write to a tempfile so that if another Emacs
- ;; process is trying to load target-file (eg in a
- ;; parallel bootstrap), it does not risk getting a
- ;; half-finished file. (Bug#4196)
- (tempfile (make-temp-name target-file))
- (kill-emacs-hook
- (cons (lambda () (ignore-errors (delete-file tempfile)))
- kill-emacs-hook)))
- (if (memq system-type '(ms-dos 'windows-nt))
- (setq buffer-file-type t))
- (write-region (point-min) (point-max) tempfile nil 1)
- ;; This has the intentional side effect that any
- ;; hard-links to target-file continue to
- ;; point to the old file (this makes it possible
- ;; for installed files to share disk space with
- ;; the build tree, without causing problems when
- ;; emacs-lisp files in the build tree are
- ;; recompiled). Previously this was accomplished by
- ;; deleting target-file before writing it.
- (rename-file tempfile target-file t)
- (message "Wrote %s" target-file))
- ;; This is just to give a better error message than write-region
- (signal 'file-error
- (list "Opening output file"
- (if (file-exists-p target-file)
- "cannot overwrite file"
- "directory not writable or nonexistent")
- target-file)))
+ (if (file-writable-p target-file)
+ ;; We must disable any code conversion here.
+ (let* ((coding-system-for-write 'no-conversion)
+ ;; Write to a tempfile so that if another Emacs
+ ;; process is trying to load target-file (eg in a
+ ;; parallel bootstrap), it does not risk getting a
+ ;; half-finished file. (Bug#4196)
+ (tempfile (make-temp-name target-file))
+ (kill-emacs-hook
+ (cons (lambda () (ignore-errors (delete-file tempfile)))
+ kill-emacs-hook)))
+ (if (memq system-type '(ms-dos 'windows-nt))
+ (setq buffer-file-type t))
+ (write-region (point-min) (point-max) tempfile nil 1)
+ ;; This has the intentional side effect that any
+ ;; hard-links to target-file continue to
+ ;; point to the old file (this makes it possible
+ ;; for installed files to share disk space with
+ ;; the build tree, without causing problems when
+ ;; emacs-lisp files in the build tree are
+ ;; recompiled). Previously this was accomplished by
+ ;; deleting target-file before writing it.
+ (rename-file tempfile target-file t)
+ (message "Wrote %s" target-file))
+ ;; This is just to give a better error message than write-region
+ (signal 'file-error
+ (list "Opening output file"
+ (if (file-exists-p target-file)
+ "cannot overwrite file"
+ "directory not writable or nonexistent")
+ target-file)))
(kill-buffer (current-buffer)))
(if (and byte-compile-generate-call-tree
(or (eq t byte-compile-generate-call-tree)
@@ -1848,13 +1853,8 @@ With argument ARG, insert value in current buffer after the form."
(insert "\n"))
((message "%s" (prin1-to-string value)))))))
-;; Dynamically bound in byte-compile-from-buffer.
-;; NB also used in cl.el and cl-macs.el.
-(defvar byte-compile--outbuffer)
-
(defun byte-compile-from-buffer (inbuffer)
- (let (byte-compile--outbuffer
- (byte-compile-current-buffer inbuffer)
+ (let ((byte-compile-current-buffer inbuffer)
(byte-compile-read-position nil)
(byte-compile-last-position nil)
;; Prevent truncation of flonums and lists as we read and print them
@@ -1926,10 +1926,10 @@ and will be removed soon. See (elisp)Backquote in the manual."))
;; if the buffer contains multibyte characters.
(and byte-compile-current-file
(with-current-buffer byte-compile--outbuffer
- (byte-compile-fix-header byte-compile-current-file)))))
- byte-compile--outbuffer))
+ (byte-compile-fix-header byte-compile-current-file))))
+ byte-compile--outbuffer)))
-(defun byte-compile-fix-header (filename)
+(defun byte-compile-fix-header (_filename)
"If the current buffer has any multibyte characters, insert a version test."
(when (< (point-max) (position-bytes (point-max)))
(goto-char (point-min))
@@ -1954,12 +1954,10 @@ and will be removed soon. See (elisp)Backquote in the manual."))
;; don't try to check the version number.
" (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
(format " (string-lessp emacs-version \"%s\")\n" minimum-version)
- " (error \"`"
- ;; prin1-to-string is used to quote backslashes.
- (substring (prin1-to-string (file-name-nondirectory filename))
- 1 -1)
- (format "' was compiled for Emacs %s or later\"))\n\n"
- minimum-version))
+ ;; Because the header must fit in a fixed width, we cannot
+ ;; insert arbitrary-length file names (Bug#11585).
+ " (error \"`%s' was compiled for "
+ (format "Emacs %s or later\" #$))\n\n" minimum-version))
;; Now compensate for any change in size, to make sure all
;; positions in the file remain valid.
(setq delta (- (point-max) old-header-end))
@@ -2016,31 +2014,30 @@ Call from the source buffer."
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))))
(defun byte-compile-output-file-form (form)
- ;; writes the given form to the output buffer, being careful of docstrings
- ;; in defun, defmacro, defvar, defvaralias, defconst, autoload and
+ ;; Write the given form to the output buffer, being careful of docstrings
+ ;; in defvar, defvaralias, defconst, autoload and
;; custom-declare-variable because make-docfile is so amazingly stupid.
;; defalias calls are output directly by byte-compile-file-form-defmumble;
;; it does not pay to first build the defalias in defmumble and then parse
;; it here.
- (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst
- autoload custom-declare-variable))
- (stringp (nth 3 form)))
- (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
- (memq (car form)
- '(defvaralias autoload
- custom-declare-variable)))
- (let ((print-escape-newlines t)
- (print-length nil)
- (print-level nil)
- (print-quoted t)
- (print-gensym t)
- (print-circle ; handle circular data structures
- (not byte-compile-disable-print-circle)))
+ (let ((print-escape-newlines t)
+ (print-length nil)
+ (print-level nil)
+ (print-quoted t)
+ (print-gensym t)
+ (print-circle ; Handle circular data structures.
+ (not byte-compile-disable-print-circle)))
+ (if (and (memq (car-safe form) '(defvar defvaralias defconst
+ autoload custom-declare-variable))
+ (stringp (nth 3 form)))
+ (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
+ (memq (car form)
+ '(defvaralias autoload
+ custom-declare-variable)))
(princ "\n" byte-compile--outbuffer)
(prin1 form byte-compile--outbuffer)
nil)))
-(defvar print-gensym-alist) ;Used before print-circle existed.
(defvar byte-compile--for-effect)
(defun byte-compile-output-docform (preface name info form specindex quoted)
@@ -2070,7 +2067,6 @@ list that represents a doc string reference.
(setq position
(byte-compile-output-as-comment
(nth (nth 1 info) form) nil))
- (setq position (- (position-bytes position) (point-min) -1))
;; If the doc string starts with * (a user variable),
;; negate POSITION.
(if (and (stringp (nth (nth 1 info) form))
@@ -2083,19 +2079,18 @@ list that represents a doc string reference.
(insert preface)
(prin1 name byte-compile--outbuffer)))
(insert (car info))
- (let ((print-escape-newlines t)
- (print-quoted t)
- ;; For compatibility with code before print-circle,
- ;; use a cons cell to say that we want
- ;; print-gensym-alist not to be cleared
- ;; between calls to print functions.
- (print-gensym '(t))
- (print-circle ; handle circular data structures
- (not byte-compile-disable-print-circle))
- print-gensym-alist ; was used before print-circle existed.
- (print-continuous-numbering t)
+ (let ((print-continuous-numbering t)
print-number-table
- (index 0))
+ (index 0)
+ ;; FIXME: The bindings below are only needed for when we're
+ ;; called from ...-defmumble.
+ (print-escape-newlines t)
+ (print-length nil)
+ (print-level nil)
+ (print-quoted t)
+ (print-gensym t)
+ (print-circle ; Handle circular data structures.
+ (not byte-compile-disable-print-circle)))
(prin1 (car form) byte-compile--outbuffer)
(while (setq form (cdr form))
(setq index (1+ index))
@@ -2116,8 +2111,6 @@ list that represents a doc string reference.
(byte-compile-output-as-comment
(cons (car form) (nth 1 form))
t)))
- (setq position (- (position-bytes position)
- (point-min) -1))
(princ (format "(#$ . %d) nil" position)
byte-compile--outbuffer)
(setq form (cdr form))
@@ -2203,7 +2196,7 @@ list that represents a doc string reference.
(put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload)
(defun byte-compile-file-form-autoload (form)
(and (let ((form form))
- (while (if (setq form (cdr form)) (byte-compile-constp (car form))))
+ (while (if (setq form (cdr form)) (macroexp-const-p (car form))))
(null form)) ;Constants only
(eval (nth 5 form)) ;Macro
(eval form)) ;Define the autoload.
@@ -2211,7 +2204,10 @@ list that represents a doc string reference.
(when (and (consp (nth 1 form))
(eq (car (nth 1 form)) 'quote)
(consp (cdr (nth 1 form)))
- (symbolp (nth 1 (nth 1 form))))
+ (symbolp (nth 1 (nth 1 form)))
+ ;; Don't add it if it's already defined. Otherwise, it might
+ ;; hide the actual definition.
+ (not (fboundp (nth 1 (nth 1 form)))))
(push (cons (nth 1 (nth 1 form))
(cons 'autoload (cdr (cdr form))))
byte-compile-function-environment)
@@ -2235,22 +2231,21 @@ list that represents a doc string reference.
(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
(defun byte-compile-file-form-defvar (form)
- (if (null (nth 3 form))
- ;; Since there is no doc string, we can compile this as a normal form,
- ;; and not do a file-boundary.
- (byte-compile-keep-pending form)
- (when (and (symbolp (nth 1 form))
- (not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
- (byte-compile-warning-enabled-p 'lexical))
- (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
- (nth 1 form)))
- (push (nth 1 form) byte-compile-bound-variables)
- (if (eq (car form) 'defconst)
- (push (nth 1 form) byte-compile-const-variables))
+ (when (and (symbolp (nth 1 form))
+ (not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
+ (byte-compile-warning-enabled-p 'lexical))
+ (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
+ (nth 1 form)))
+ (push (nth 1 form) byte-compile-bound-variables)
+ (if (eq (car form) 'defconst)
+ (push (nth 1 form) byte-compile-const-variables))
+ (if (and (null (cddr form)) ;No `value' provided.
+ (eq (car form) 'defvar)) ;Just a declaration.
+ nil
(cond ((consp (nth 2 form))
- (setq form (copy-sequence form))
- (setcar (cdr (cdr form))
- (byte-compile-top-level (nth 2 form) nil 'file))))
+ (setq form (copy-sequence form))
+ (setcar (cdr (cdr form))
+ (byte-compile-top-level (nth 2 form) nil 'file))))
form))
(put 'define-abbrev-table 'byte-hunk-handler
@@ -2266,19 +2261,7 @@ list that represents a doc string reference.
(when (byte-compile-warning-enabled-p 'callargs)
(byte-compile-nogroup-warn form))
(push (nth 1 (nth 1 form)) byte-compile-bound-variables)
- ;; Don't compile the expression because it may be displayed to the user.
- ;; (when (eq (car-safe (nth 2 form)) 'quote)
- ;; ;; (nth 2 form) is meant to evaluate to an expression, so if we have the
- ;; ;; final value already, we can byte-compile it.
- ;; (setcar (cdr (nth 2 form))
- ;; (byte-compile-top-level (cadr (nth 2 form)) nil 'file)))
- (let ((tail (nthcdr 4 form)))
- (while tail
- (unless (keywordp (car tail)) ;No point optimizing keywords.
- ;; Compile the keyword arguments.
- (setcar tail (byte-compile-top-level (car tail) nil 'file)))
- (setq tail (cdr tail))))
- form)
+ (byte-compile-keep-pending form))
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
@@ -2325,143 +2308,132 @@ list that represents a doc string reference.
(nth 1 (nth 1 form))
(byte-compile-keep-pending form)))
-(put 'defun 'byte-hunk-handler 'byte-compile-file-form-defun)
-(defun byte-compile-file-form-defun (form)
- (byte-compile-file-form-defmumble form nil))
-
-(put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro)
-(defun byte-compile-file-form-defmacro (form)
- (byte-compile-file-form-defmumble form t))
-
-(defun byte-compile-defmacro-declaration (form)
- "Generate code for declarations in macro definitions.
-Remove declarations from the body of the macro definition
-by side-effects."
- (let ((tail (nthcdr 2 form))
- (res '()))
- (when (stringp (car (cdr tail)))
- (setq tail (cdr tail)))
- (while (and (consp (car (cdr tail)))
- (eq (car (car (cdr tail))) 'declare))
- (let ((declaration (car (cdr tail))))
- (setcdr tail (cdr (cdr tail)))
- (push `(if macro-declaration-function
- (funcall macro-declaration-function
- ',(car (cdr form)) ',declaration))
- res)))
- res))
-
-(defun byte-compile-file-form-defmumble (form macrop)
- (let* ((name (car (cdr form)))
- (this-kind (if macrop 'byte-compile-macro-environment
- 'byte-compile-function-environment))
- (that-kind (if macrop 'byte-compile-function-environment
- 'byte-compile-macro-environment))
- (this-one (assq name (symbol-value this-kind)))
- (that-one (assq name (symbol-value that-kind)))
- (byte-compile-free-references nil)
- (byte-compile-free-assignments nil))
+(defun byte-compile-file-form-defmumble (name macro arglist body rest)
+ "Process a `defalias' for NAME.
+If MACRO is non-nil, the definition is known to be a macro.
+ARGLIST is the list of arguments, if it was recognized or t otherwise.
+BODY of the definition, or t if not recognized.
+Return non-nil if everything went as planned, or nil to imply that it decided
+not to take responsibility for the actual compilation of the code."
+ (let* ((this-kind (if macro 'byte-compile-macro-environment
+ 'byte-compile-function-environment))
+ (that-kind (if macro 'byte-compile-function-environment
+ 'byte-compile-macro-environment))
+ (this-one (assq name (symbol-value this-kind)))
+ (that-one (assq name (symbol-value that-kind)))
+ (byte-compile-current-form name)) ; For warnings.
+
(byte-compile-set-symbol-position name)
;; When a function or macro is defined, add it to the call tree so that
;; we can tell when functions are not used.
(if byte-compile-generate-call-tree
- (or (assq name byte-compile-call-tree)
- (setq byte-compile-call-tree
- (cons (list name nil nil) byte-compile-call-tree))))
+ (or (assq name byte-compile-call-tree)
+ (setq byte-compile-call-tree
+ (cons (list name nil nil) byte-compile-call-tree))))
- (setq byte-compile-current-form name) ; for warnings
(if (byte-compile-warning-enabled-p 'redefine)
- (byte-compile-arglist-warn form macrop))
+ (byte-compile-arglist-warn name arglist macro))
+
(if byte-compile-verbose
- (message "Compiling %s... (%s)"
- (or byte-compile-current-file "") (nth 1 form)))
- (cond (that-one
- (if (and (byte-compile-warning-enabled-p 'redefine)
- ;; don't warn when compiling the stubs in byte-run...
- (not (assq (nth 1 form)
- byte-compile-initial-macro-environment)))
- (byte-compile-warn
+ (message "Compiling %s... (%s)"
+ (or byte-compile-current-file "") name))
+ (cond ((not (or macro (listp body)))
+ ;; We do not know positively if the definition is a macro
+ ;; or a function, so we shouldn't emit warnings.
+ ;; This also silences "multiple definition" warnings for defmethods.
+ nil)
+ (that-one
+ (if (and (byte-compile-warning-enabled-p 'redefine)
+ ;; Don't warn when compiling the stubs in byte-run...
+ (not (assq name byte-compile-initial-macro-environment)))
+ (byte-compile-warn
"`%s' defined multiple times, as both function and macro"
- (nth 1 form)))
- (setcdr that-one nil))
- (this-one
- (when (and (byte-compile-warning-enabled-p 'redefine)
- ;; hack: don't warn when compiling the magic internal
+ name))
+ (setcdr that-one nil))
+ (this-one
+ (when (and (byte-compile-warning-enabled-p 'redefine)
+ ;; Hack: Don't warn when compiling the magic internal
;; byte-compiler macros in byte-run.el...
- (not (assq (nth 1 form)
- byte-compile-initial-macro-environment)))
- (byte-compile-warn "%s `%s' defined multiple times in this file"
- (if macrop "macro" "function")
- (nth 1 form))))
- ((and (fboundp name)
- (eq (car-safe (symbol-function name))
- (if macrop 'lambda 'macro)))
- (when (byte-compile-warning-enabled-p 'redefine)
- (byte-compile-warn "%s `%s' being redefined as a %s"
- (if macrop "function" "macro")
- (nth 1 form)
- (if macrop "macro" "function")))
- ;; shadow existing definition
- (set this-kind
- (cons (cons name nil)
- (symbol-value this-kind))))
- )
- (let ((body (nthcdr 3 form)))
- (when (and (stringp (car body))
- (symbolp (car-safe (cdr-safe body)))
- (car-safe (cdr-safe body))
- (stringp (car-safe (cdr-safe (cdr-safe body)))))
- (byte-compile-set-symbol-position (nth 1 form))
- (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
- (nth 1 form))))
-
- ;; Generate code for declarations in macro definitions.
- ;; Remove declarations from the body of the macro definition.
- (when macrop
- (dolist (decl (byte-compile-defmacro-declaration form))
- (prin1 decl byte-compile--outbuffer)))
-
- (let* ((code (byte-compile-lambda (nthcdr 2 form) t)))
- (if this-one
- ;; A definition in b-c-initial-m-e should always take precedence
- ;; during compilation, so don't let it be redefined. (Bug#8647)
- (or (and macrop
- (assq name byte-compile-initial-macro-environment))
- (setcdr this-one code))
- (set this-kind
- (cons (cons name code)
- (symbol-value this-kind))))
- (byte-compile-flush-pending)
- (if (not (stringp (nth 3 form)))
- ;; No doc string. Provide -1 as the "doc string index"
- ;; so that no element will be treated as a doc string.
- (byte-compile-output-docform
- "\n(defalias '"
- name
- (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))
- (append code nil) ; Turn byte-code-function-p into list.
- (and (atom code) byte-compile-dynamic
- 1)
- nil)
- ;; Output the form by hand, that's much simpler than having
- ;; b-c-output-file-form analyze the defalias.
- (byte-compile-output-docform
- "\n(defalias '"
- name
- (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))
- (append code nil) ; Turn byte-code-function-p into list.
- (and (atom code) byte-compile-dynamic
- 1)
- nil))
- (princ ")" byte-compile--outbuffer)
- nil)))
+ (not (assq name byte-compile-initial-macro-environment)))
+ (byte-compile-warn "%s `%s' defined multiple times in this file"
+ (if macro "macro" "function")
+ name)))
+ ((and (fboundp name)
+ (eq (car-safe (symbol-function name))
+ (if macro 'lambda 'macro)))
+ (when (byte-compile-warning-enabled-p 'redefine)
+ (byte-compile-warn "%s `%s' being redefined as a %s"
+ (if macro "function" "macro")
+ name
+ (if macro "macro" "function")))
+ ;; Shadow existing definition.
+ (set this-kind
+ (cons (cons name nil)
+ (symbol-value this-kind))))
+ )
+
+ (when (and (listp body)
+ (stringp (car body))
+ (symbolp (car-safe (cdr-safe body)))
+ (car-safe (cdr-safe body))
+ (stringp (car-safe (cdr-safe (cdr-safe body)))))
+ ;; FIXME: We've done that already just above, so this looks wrong!
+ ;;(byte-compile-set-symbol-position name)
+ (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
+ name))
+
+ (if (not (listp body))
+ ;; The precise definition requires evaluation to find out, so it
+ ;; will only be known at runtime.
+ ;; For a macro, that means we can't use that macro in the same file.
+ (progn
+ (unless macro
+ (push (cons name (if (listp arglist) `(declared ,arglist) t))
+ byte-compile-function-environment))
+ ;; Tell the caller that we didn't compile it yet.
+ nil)
+
+ (let* ((code (byte-compile-lambda (cons arglist body) t)))
+ (if this-one
+ ;; A definition in b-c-initial-m-e should always take precedence
+ ;; during compilation, so don't let it be redefined. (Bug#8647)
+ (or (and macro
+ (assq name byte-compile-initial-macro-environment))
+ (setcdr this-one code))
+ (set this-kind
+ (cons (cons name code)
+ (symbol-value this-kind))))
+
+ (if rest
+ ;; There are additional args to `defalias' (like maybe a docstring)
+ ;; that the code below can't handle: punt!
+ nil
+ ;; Otherwise, we have a bona-fide defun/defmacro definition, and use
+ ;; special code to allow dynamic docstrings and byte-code.
+ (byte-compile-flush-pending)
+ (let ((index
+ ;; If there's no doc string, provide -1 as the "doc string
+ ;; index" so that no element will be treated as a doc string.
+ (if (not (stringp (car body))) -1 4)))
+ ;; Output the form by hand, that's much simpler than having
+ ;; b-c-output-file-form analyze the defalias.
+ (byte-compile-output-docform
+ "\n(defalias '"
+ name
+ (if macro `(" '(macro . #[" ,index "])") `(" #[" ,index "]"))
+ (append code nil) ; Turn byte-code-function-p into list.
+ (and (atom code) byte-compile-dynamic
+ 1)
+ nil))
+ (princ ")" byte-compile--outbuffer)
+ t)))))
-;; Print Lisp object EXP in the output file, inside a comment,
-;; and return the file position it will have.
-;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting.
(defun byte-compile-output-as-comment (exp quoted)
- (let ((position (point)))
- (with-current-buffer byte-compile--outbuffer
+ "Print Lisp object EXP in the output file, inside a comment,
+and return the file (byte) position it will have.
+If QUOTED is non-nil, print with quoting; otherwise, print without quoting."
+ (with-current-buffer byte-compile--outbuffer
+ (let ((position (point)))
;; Insert EXP, and make it a comment with #@LENGTH.
(insert " ")
@@ -2486,15 +2458,33 @@ by side-effects."
(position-bytes position))))
;; Save the file position of the object.
- ;; Note we should add 1 to skip the space
- ;; that we inserted before the actual doc string,
- ;; and subtract 1 to convert from an 1-origin Emacs position
- ;; to a file position; they cancel.
- (setq position (point))
- (goto-char (point-max)))
- position))
-
-
+ ;; Note we add 1 to skip the space that we inserted before the actual doc
+ ;; string, and subtract point-min to convert from an 1-origin Emacs
+ ;; position to a file position.
+ (prog1
+ (- (position-bytes (point)) (point-min) -1)
+ (goto-char (point-max))))))
+
+(defun byte-compile--reify-function (fun)
+ "Return an expression which will evaluate to a function value FUN.
+FUN should be either a `lambda' value or a `closure' value."
+ (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil))
+ `(closure ,env ,args . ,body)) fun)
+ (renv ()))
+ ;; Turn the function's closed vars (if any) into local let bindings.
+ (dolist (binding env)
+ (cond
+ ((consp binding)
+ ;; We check shadowing by the args, so that the `let' can be moved
+ ;; within the lambda, which can then be unfolded. FIXME: Some of those
+ ;; bindings might be unused in `body'.
+ (unless (memq (car binding) args) ;Shadowed.
+ (push `(,(car binding) ',(cdr binding)) renv)))
+ ((eq binding t))
+ (t (push `(defvar ,binding) body))))
+ (if (null renv)
+ `(lambda ,args ,@body)
+ `(lambda ,args (let ,(nreverse renv) ,@body)))))
;;;###autoload
(defun byte-compile (form)
@@ -2502,23 +2492,39 @@ by side-effects."
If FORM is a lambda or a macro, byte-compile it as a function."
(displaying-byte-compile-warnings
(byte-compile-close-variables
- (let* ((fun (if (symbolp form)
+ (let* ((lexical-binding lexical-binding)
+ (fun (if (symbolp form)
(and (fboundp form) (symbol-function form))
form))
(macro (eq (car-safe fun) 'macro)))
(if macro
(setq fun (cdr fun)))
- (cond ((eq (car-safe fun) 'lambda)
- ;; Expand macros.
- (setq fun (byte-compile-preprocess fun))
- ;; Get rid of the `function' quote added by the `lambda' macro.
- (if (eq (car-safe fun) 'function) (setq fun (cadr fun)))
- (setq fun (if macro
- (cons 'macro (byte-compile-lambda fun))
- (byte-compile-lambda fun)))
- (if (symbolp form)
- (defalias form fun)
- fun)))))))
+ (cond
+ ;; Up until Emacs-24.1, byte-compile silently did nothing when asked to
+ ;; compile something invalid. So let's tune down the complaint from an
+ ;; error to a simple message for the known case where signaling an error
+ ;; causes problems.
+ ((byte-code-function-p fun)
+ (message "Function %s is already compiled"
+ (if (symbolp form) form "provided"))
+ fun)
+ (t
+ (when (symbolp form)
+ (unless (memq (car-safe fun) '(closure lambda))
+ (error "Don't know how to compile %S" fun))
+ (setq lexical-binding (eq (car fun) 'closure))
+ (setq fun (byte-compile--reify-function fun)))
+ (unless (eq (car-safe fun) 'lambda)
+ (error "Don't know how to compile %S" fun))
+ ;; Expand macros.
+ (setq fun (byte-compile-preprocess fun))
+ ;; Get rid of the `function' quote added by the `lambda' macro.
+ (if (eq (car-safe fun) 'function) (setq fun (cadr fun)))
+ (setq fun (byte-compile-lambda fun))
+ (if macro (push 'macro fun))
+ (if (symbolp form)
+ (fset form fun)
+ fun)))))))
(defun byte-compile-sexp (sexp)
"Compile and return SEXP."
@@ -2534,7 +2540,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(when (symbolp arg)
(byte-compile-set-symbol-position arg))
(cond ((or (not (symbolp arg))
- (byte-compile-const-symbol-p arg t))
+ (macroexp--const-symbol-p arg t))
(error "Invalid lambda variable %s" arg))
((eq arg '&rest)
(unless (cdr list)
@@ -2589,14 +2595,15 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(lsh nonrest 8)
(lsh rest 7)))))
-;; Byte-compile a lambda-expression and return a valid function.
-;; The value is usually a compiled function but may be the original
-;; lambda-expression.
-;; When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
-;; of the list FUN and `byte-compile-set-symbol-position' is not called.
-;; Use this feature to avoid calling `byte-compile-set-symbol-position'
-;; for symbols generated by the byte compiler itself.
+
(defun byte-compile-lambda (fun &optional add-lambda reserved-csts)
+ "Byte-compile a lambda-expression and return a valid function.
+The value is usually a compiled function but may be the original
+lambda-expression.
+When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
+of the list FUN and `byte-compile-set-symbol-position' is not called.
+Use this feature to avoid calling `byte-compile-set-symbol-position'
+for symbols generated by the byte compiler itself."
(if add-lambda
(setq fun (cons 'lambda fun))
(unless (eq 'lambda (car-safe fun))
@@ -2657,24 +2664,23 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(byte-compile-make-lambda-lexenv fun))
reserved-csts)))
;; Build the actual byte-coded function.
- (if (eq 'byte-code (car-safe compiled))
- (apply 'make-byte-code
- (if lexical-binding
- (byte-compile-make-args-desc arglist)
- arglist)
- (append
- ;; byte-string, constants-vector, stack depth
- (cdr compiled)
- ;; optionally, the doc string.
- (cond (lexical-binding
- (require 'help-fns)
- (list (help-add-fundoc-usage doc arglist)))
- ((or doc int)
- (list doc)))
- ;; optionally, the interactive spec.
- (if int
- (list (nth 1 int)))))
- (error "byte-compile-top-level did not return byte-code")))))
+ (cl-assert (eq 'byte-code (car-safe compiled)))
+ (apply #'make-byte-code
+ (if lexical-binding
+ (byte-compile-make-args-desc arglist)
+ arglist)
+ (append
+ ;; byte-string, constants-vector, stack depth
+ (cdr compiled)
+ ;; optionally, the doc string.
+ (cond (lexical-binding
+ (require 'help-fns)
+ (list (help-add-fundoc-usage doc arglist)))
+ ((or doc int)
+ (list doc)))
+ ;; optionally, the interactive spec.
+ (if int
+ (list (nth 1 int))))))))
(defvar byte-compile-reserved-constants 0)
@@ -2693,22 +2699,23 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(limits '(5 ; Use the 1-byte varref codes,
63 ; 1-constlim ; 1-byte byte-constant codes,
255 ; 2-byte varref codes,
- 65535)) ; 3-byte codes for the rest.
+ 65535 ; 3-byte codes for the rest.
+ 65535)) ; twice since we step when we swap.
limit)
(while (or rest other)
(setq limit (car limits))
(while (and rest (< i limit))
(cond
((numberp (car rest))
- (assert (< (car rest) byte-compile-reserved-constants)))
+ (cl-assert (< (car rest) byte-compile-reserved-constants)))
((setq tmp (assq (car (car rest)) ret))
(setcdr (car rest) (cdr tmp)))
(t
(setcdr (car rest) (setq i (1+ i)))
(setq ret (cons (car rest) ret))))
(setq rest (cdr rest)))
- (setq limits (cdr limits)
- rest (prog1 other
+ (setq limits (cdr limits) ;Step
+ rest (prog1 other ;&Swap.
(setq other rest))))
(apply 'vector (nreverse (mapcar 'car ret)))))
@@ -2802,7 +2809,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(if (if (eq (car (car rest)) 'byte-constant)
(or (consp tmp)
(and (symbolp tmp)
- (not (byte-compile-const-symbol-p tmp)))))
+ (not (macroexp--const-symbol-p tmp)))))
(if maycall
(setq body (cons (list 'quote tmp) body)))
(setq body (cons tmp body))))
@@ -2819,7 +2826,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(setq body (nreverse body))
(setq body (list
(if (and (eq tmp 'funcall)
- (eq (car-safe (car body)) 'quote))
+ (eq (car-safe (car body)) 'quote)
+ (symbolp (nth 1 (car body))))
(cons (nth 1 (car body)) (cdr body))
(cons tmp body))))
(or (eq output-type 'file)
@@ -2847,7 +2855,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(push (cons fn
(if (and (consp args) (listp (car args)))
(list 'declared (car args))
- t)) ; arglist not specified
+ t)) ; Arglist not specified.
byte-compile-function-environment)
;; We are stating that it _will_ be defined at runtime.
(setq byte-compile-noruntime-functions
@@ -2873,7 +2881,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(let ((byte-compile--for-effect for-effect))
(cond
((not (consp form))
- (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
+ (cond ((or (not (symbolp form)) (macroexp--const-symbol-p form))
(when (symbolp form)
(byte-compile-set-symbol-position form))
(byte-compile-constant form))
@@ -2886,7 +2894,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
((symbolp (car form))
(let* ((fn (car form))
(handler (get fn 'byte-compile)))
- (when (byte-compile-const-symbol-p fn)
+ (when (macroexp--const-symbol-p fn)
(byte-compile-warn "`%s' called as a function" fn))
(and (byte-compile-warning-enabled-p 'interactive-only)
(memq fn byte-compile-interactive-only-functions)
@@ -2897,14 +2905,12 @@ That command is designed for interactive use only" fn))
(byte-compile-log-warning
(format "Forgot to expand macro %s" (car form)) nil :error))
(if (and handler
- ;; Make sure that function exists. This is important
- ;; for CL compiler macros since the symbol may be
- ;; `cl-byte-compile-compiler-macro' but if CL isn't
- ;; loaded, this function doesn't exist.
- (and (not (eq handler
- ;; Already handled by macroexpand-all.
- 'cl-byte-compile-compiler-macro))
- (functionp handler)))
+ ;; Make sure that function exists.
+ (and (functionp handler)
+ ;; Ignore obsolete byte-compile function used by former
+ ;; CL code to handle compiler macros (we do it
+ ;; differently now).
+ (not (eq handler 'cl-byte-compile-compiler-macro))))
(funcall handler form)
(byte-compile-normal-call form))
(if (byte-compile-warning-enabled-p 'cl-functions)
@@ -2981,14 +2987,14 @@ That command is designed for interactive use only" fn))
(mapc 'byte-compile-form (cdr form))
(unless fmax2
;; Old-style byte-code.
- (assert (listp fargs))
+ (cl-assert (listp fargs))
(while fargs
- (case (car fargs)
- (&optional (setq fargs (cdr fargs)))
- (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1))
+ (pcase (car fargs)
+ (`&optional (setq fargs (cdr fargs)))
+ (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1))
(push (cadr fargs) dynbinds)
(setq fargs nil))
- (t (push (pop fargs) dynbinds))))
+ (_ (push (pop fargs) dynbinds))))
(unless fmax2 (setq fmax2 (* 2 (length dynbinds)))))
(cond
((<= (+ alen alen) fmax2)
@@ -3002,7 +3008,7 @@ That command is designed for interactive use only" fn))
(t
;; Turn &rest args into a list.
(let ((n (- alen (/ (1- fmax2) 2))))
- (assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n)
+ (cl-assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n)
(if (< n 5)
(byte-compile-out
(aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n))
@@ -3015,14 +3021,14 @@ That command is designed for interactive use only" fn))
;; Unbind dynamic variables.
(when dynbinds
(byte-compile-out 'byte-unbind (length dynbinds)))
- (assert (eq byte-compile-depth (1+ start-depth))
+ (cl-assert (eq byte-compile-depth (1+ start-depth))
nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth)))
(defun byte-compile-check-variable (var access-type)
"Do various error checks before a use of the variable VAR."
(when (symbolp var)
(byte-compile-set-symbol-position var))
- (cond ((or (not (symbolp var)) (byte-compile-const-symbol-p var))
+ (cond ((or (not (symbolp var)) (macroexp--const-symbol-p var))
(when (byte-compile-warning-enabled-p 'constants)
(byte-compile-warn (if (eq access-type 'let-bind)
"attempt to let-bind %s `%s`"
@@ -3033,10 +3039,10 @@ That command is designed for interactive use only" fn))
(and od
(not (memq var byte-compile-not-obsolete-vars))
(not (memq var byte-compile-global-not-obsolete-vars))
- (or (case (nth 1 od)
- (set (not (eq access-type 'reference)))
- (get (eq access-type 'reference))
- (t t)))))
+ (or (pcase (nth 1 od)
+ (`set (not (eq access-type 'reference)))
+ (`get (eq access-type 'reference))
+ (_ t)))))
(byte-compile-warn-obsolete var))))
(defsubst byte-compile-dynamic-variable-op (base-op var)
@@ -3073,9 +3079,9 @@ That command is designed for interactive use only" fn))
(byte-compile-check-variable var 'assign)
(let ((lex-binding (assq var byte-compile--lexical-environment)))
(if lex-binding
- ;; VAR is lexically bound
+ ;; VAR is lexically bound.
(byte-compile-stack-set (cdr lex-binding))
- ;; VAR is dynamically bound
+ ;; VAR is dynamically bound.
(unless (or (not (byte-compile-warning-enabled-p 'free-vars))
(boundp var)
(memq var byte-compile-bound-variables)
@@ -3360,7 +3366,8 @@ discarding."
(body (nthcdr 3 form))
(fun
(byte-compile-lambda `(lambda ,vars . ,body) nil (length env))))
- (assert (byte-code-function-p fun))
+ (cl-assert (> (length env) 0)) ;Otherwise, we don't need a closure.
+ (cl-assert (byte-code-function-p fun))
(byte-compile-form `(make-byte-code
',(aref fun 0) ',(aref fun 1)
(vconcat (vector . ,env) ',(aref fun 2))
@@ -3585,20 +3592,22 @@ discarding."
(defun byte-compile-setq-default (form)
(setq form (cdr form))
- (if (> (length form) 2)
- (let ((setters ()))
- (while (consp form)
- (push `(setq-default ,(pop form) ,(pop form)) setters))
- (byte-compile-form (cons 'progn (nreverse setters))))
- (let ((var (car form)))
- (and (or (not (symbolp var))
- (byte-compile-const-symbol-p var t))
- (byte-compile-warning-enabled-p 'constants)
- (byte-compile-warn
- "variable assignment to %s `%s'"
- (if (symbolp var) "constant" "nonvariable")
- (prin1-to-string var)))
- (byte-compile-normal-call `(set-default ',var ,@(cdr form))))))
+ (if (null form) ; (setq-default), with no arguments
+ (byte-compile-form nil byte-compile--for-effect)
+ (if (> (length form) 2)
+ (let ((setters ()))
+ (while (consp form)
+ (push `(setq-default ,(pop form) ,(pop form)) setters))
+ (byte-compile-form (cons 'progn (nreverse setters))))
+ (let ((var (car form)))
+ (and (or (not (symbolp var))
+ (macroexp--const-symbol-p var t))
+ (byte-compile-warning-enabled-p 'constants)
+ (byte-compile-warn
+ "variable assignment to %s `%s'"
+ (if (symbolp var) "constant" "nonvariable")
+ (prin1-to-string var)))
+ (byte-compile-normal-call `(set-default ',var ,@(cdr form)))))))
(byte-defop-compiler-1 set-default)
(defun byte-compile-set-default (form)
@@ -3699,10 +3708,10 @@ If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs),
that suppresses all warnings during execution of BODY."
(declare (indent 1) (debug t))
`(let* ((fbound-list (byte-compile-find-bound-condition
- ,condition (list 'fboundp)
+ ,condition '(fboundp functionp)
byte-compile-unresolved-functions))
(bound-list (byte-compile-find-bound-condition
- ,condition (list 'boundp 'default-boundp)))
+ ,condition '(boundp default-boundp)))
;; Maybe add to the bound list.
(byte-compile-bound-variables
(append bound-list byte-compile-bound-variables)))
@@ -3725,7 +3734,7 @@ that suppresses all warnings during execution of BODY."
(defun byte-compile-if (form)
(byte-compile-form (car (cdr form)))
;; Check whether we have `(if (fboundp ...' or `(if (boundp ...'
- ;; and avoid warnings about the relevent symbols in the consequent.
+ ;; and avoid warnings about the relevant symbols in the consequent.
(let ((clause (nth 1 form))
(donetag (byte-compile-make-tag)))
(if (null (nthcdr 3 form))
@@ -3938,8 +3947,8 @@ binding slots have been popped."
(if lexical-binding
;; Unbind both lexical and dynamic variables.
(progn
- (assert (or (eq byte-compile-depth init-stack-depth)
- (eq byte-compile-depth (1+ init-stack-depth))))
+ (cl-assert (or (eq byte-compile-depth init-stack-depth)
+ (eq byte-compile-depth (1+ init-stack-depth))))
(byte-compile-unbind clauses init-lexenv (> byte-compile-depth
init-stack-depth)))
;; Unbind dynamic variables.
@@ -4081,36 +4090,11 @@ binding slots have been popped."
;;; top-level forms elsewhere
-(byte-defop-compiler-1 defun)
-(byte-defop-compiler-1 defmacro)
(byte-defop-compiler-1 defvar)
(byte-defop-compiler-1 defconst byte-compile-defvar)
(byte-defop-compiler-1 autoload)
(byte-defop-compiler-1 lambda byte-compile-lambda-form)
-(defun byte-compile-defun (form)
- ;; This is not used for file-level defuns with doc strings.
- (if (symbolp (car form))
- (byte-compile-set-symbol-position (car form))
- (byte-compile-set-symbol-position 'defun)
- (error "defun name must be a symbol, not %s" (car form)))
- (byte-compile-push-constant 'defalias)
- (byte-compile-push-constant (nth 1 form))
- (byte-compile-push-constant (byte-compile-lambda (cdr (cdr form)) t))
- (byte-compile-out 'byte-call 2))
-
-(defun byte-compile-defmacro (form)
- ;; This is not used for file-level defmacros with doc strings.
- (byte-compile-body-do-effect
- (let ((decls (byte-compile-defmacro-declaration form))
- (code (byte-compile-lambda (cdr (cdr form)) t)))
- `((defalias ',(nth 1 form)
- ,(if (eq (car-safe code) 'make-byte-code)
- `(cons 'macro ,code)
- `'(macro . ,(eval code))))
- ,@decls
- ',(nth 1 form)))))
-
;; If foo.el declares `toto' as obsolete, it is likely that foo.el will
;; actually use `toto' in order for this obsolete variable to still work
;; correctly, so paradoxically, while byte-compiling foo.el, the presence
@@ -4122,8 +4106,10 @@ binding slots have been popped."
(push (nth 1 (nth 1 form)) byte-compile-global-not-obsolete-vars))
(byte-compile-normal-call form))
+(defconst byte-compile-tmp-var (make-symbol "def-tmp-var"))
+
(defun byte-compile-defvar (form)
- ;; This is not used for file-level defvar/consts with doc strings.
+ ;; This is not used for file-level defvar/consts.
(when (and (symbolp (nth 1 form))
(not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
(byte-compile-warning-enabled-p 'lexical))
@@ -4146,37 +4132,26 @@ binding slots have been popped."
(push var byte-compile-bound-variables)
(if (eq fun 'defconst)
(push var byte-compile-const-variables))
- (byte-compile-body-do-effect
- (list
- ;; Put the defined variable in this library's load-history entry
- ;; just as a real defvar would, but only in top-level forms.
- (when (and (cddr form) (null byte-compile-current-form))
- `(setq current-load-list (cons ',var current-load-list)))
- (when (> (length form) 3)
- (when (and string (not (stringp string)))
- (byte-compile-warn "third arg to `%s %s' is not a string: %s"
- fun var string))
- `(put ',var 'variable-documentation ,string))
- (if (cddr form) ; `value' provided
- (let ((byte-compile-not-obsolete-vars (list var)))
- (if (eq fun 'defconst)
- ;; `defconst' sets `var' unconditionally.
- (let ((tmp (make-symbol "defconst-tmp-var")))
- ;; Quote with `quote' to prevent byte-compiling the body,
- ;; which would lead to an inf-loop.
- `(funcall '(lambda (,tmp) (defconst ,var ,tmp))
- ,value))
- ;; `defvar' sets `var' only when unbound.
- `(if (not (default-boundp ',var)) (setq-default ,var ,value))))
- (when (eq fun 'defconst)
- ;; This will signal an appropriate error at runtime.
- `(eval ',form)))
- `',var))))
+ (when (and string (not (stringp string)))
+ (byte-compile-warn "third arg to `%s %s' is not a string: %s"
+ fun var string))
+ (byte-compile-form-do-effect
+ (if (cddr form) ; `value' provided
+ ;; Quote with `quote' to prevent byte-compiling the body,
+ ;; which would lead to an inf-loop.
+ `(funcall '(lambda (,byte-compile-tmp-var)
+ (,fun ,var ,byte-compile-tmp-var ,@(nthcdr 3 form)))
+ ,value)
+ (if (eq fun 'defconst)
+ ;; This will signal an appropriate error at runtime.
+ `(eval ',form)
+ ;; A simple (defvar foo) just returns foo.
+ `',var)))))
(defun byte-compile-autoload (form)
(byte-compile-set-symbol-position 'autoload)
- (and (byte-compile-constp (nth 1 form))
- (byte-compile-constp (nth 5 form))
+ (and (macroexp-const-p (nth 1 form))
+ (macroexp-const-p (nth 5 form))
(eval (nth 5 form)) ; macro-p
(not (fboundp (eval (nth 1 form))))
(byte-compile-warn
@@ -4195,38 +4170,53 @@ binding slots have been popped."
(put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias)
;; Used for eieio--defalias as well.
(defun byte-compile-file-form-defalias (form)
- (if (and (consp (cdr form)) (consp (nth 1 form))
- (eq (car (nth 1 form)) 'quote)
- (consp (cdr (nth 1 form)))
- (symbolp (nth 1 (nth 1 form))))
- (let ((constant
- (and (consp (nthcdr 2 form))
- (consp (nth 2 form))
- (eq (car (nth 2 form)) 'quote)
- (consp (cdr (nth 2 form)))
- (symbolp (nth 1 (nth 2 form))))))
- (byte-compile-defalias-warn (nth 1 (nth 1 form)))
- (push (cons (nth 1 (nth 1 form))
- (if constant (nth 1 (nth 2 form)) t))
- byte-compile-function-environment)))
- ;; We used to just do: (byte-compile-normal-call form)
- ;; But it turns out that this fails to optimize the code.
- ;; So instead we now do the same as what other byte-hunk-handlers do,
- ;; which is to call back byte-compile-file-form and then return nil.
- ;; Except that we can't just call byte-compile-file-form since it would
- ;; call us right back.
- (byte-compile-keep-pending form)
- ;; Return nil so the form is not output twice.
- nil)
-
-;; Turn off warnings about prior calls to the function being defalias'd.
-;; This could be smarter and compare those calls with
-;; the function it is being aliased to.
-(defun byte-compile-defalias-warn (new)
- (let ((calls (assq new byte-compile-unresolved-functions)))
- (if calls
- (setq byte-compile-unresolved-functions
- (delq calls byte-compile-unresolved-functions)))))
+ ;; For the compilation itself, we could largely get rid of this hunk-handler,
+ ;; if it weren't for the fact that we need to figure out when a defalias
+ ;; defines a macro, so as to add it to byte-compile-macro-environment.
+ ;;
+ ;; FIXME: we also use this hunk-handler to implement the function's dynamic
+ ;; docstring feature. We could actually implement it more elegantly in
+ ;; byte-compile-lambda so it applies to all lambdas, but the problem is that
+ ;; the resulting .elc format will not be recognized by make-docfile, so
+ ;; either we stop using DOC for the docstrings of preloaded elc files (at the
+ ;; cost of around 24KB on 32bit hosts, double on 64bit hosts) or we need to
+ ;; build DOC in a more clever way (e.g. handle anonymous elements).
+ (let ((byte-compile-free-references nil)
+ (byte-compile-free-assignments nil))
+ (pcase form
+ ;; Decompose `form' into:
+ ;; - `name' is the name of the defined function.
+ ;; - `arg' is the expression to which it is defined.
+ ;; - `rest' is the rest of the arguments.
+ (`(,_ ',name ,arg . ,rest)
+ (pcase-let*
+ ;; `macro' is non-nil if it defines a macro.
+ ;; `fun' is the function part of `arg' (defaults to `arg').
+ (((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let macro t))
+ (and (let fun arg) (let macro nil)))
+ arg)
+ ;; `lam' is the lambda expression in `fun' (or nil if not
+ ;; recognized).
+ ((or `(,(or `quote `function) ,lam) (let lam nil))
+ fun)
+ ;; `arglist' is the list of arguments (or t if not recognized).
+ ;; `body' is the body of `lam' (or t if not recognized).
+ ((or `(lambda ,arglist . ,body)
+ ;; `(closure ,_ ,arglist . ,body)
+ (and `(internal-make-closure ,arglist . ,_) (let body t))
+ (and (let arglist t) (let body t)))
+ lam))
+ (unless (byte-compile-file-form-defmumble
+ name macro arglist body rest)
+ (byte-compile-keep-pending form))))
+
+ ;; We used to just do: (byte-compile-normal-call form)
+ ;; But it turns out that this fails to optimize the code.
+ ;; So instead we now do the same as what other byte-hunk-handlers do,
+ ;; which is to call back byte-compile-file-form and then return nil.
+ ;; Except that we can't just call byte-compile-file-form since it would
+ ;; call us right back.
+ (t (byte-compile-keep-pending form)))))
(byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
(defun byte-compile-no-warnings (form)
@@ -4378,21 +4368,21 @@ invoked interactively."
(if byte-compile-call-tree-sort
(setq byte-compile-call-tree
(sort byte-compile-call-tree
- (case byte-compile-call-tree-sort
- (callers
+ (pcase byte-compile-call-tree-sort
+ (`callers
(lambda (x y) (< (length (nth 1 x))
(length (nth 1 y)))))
- (calls
+ (`calls
(lambda (x y) (< (length (nth 2 x))
(length (nth 2 y)))))
- (calls+callers
+ (`calls+callers
(lambda (x y) (< (+ (length (nth 1 x))
(length (nth 2 x)))
(+ (length (nth 1 y))
(length (nth 2 y))))))
- (name
+ (`name
(lambda (x y) (string< (car x) (car y))))
- (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
+ (_ (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
byte-compile-call-tree-sort))))))
(message "Generating call tree...")
(let ((rest byte-compile-call-tree)
@@ -4534,29 +4524,30 @@ already up-to-date."
(kill-emacs (if error 1 0))))
(defun batch-byte-compile-file (file)
- (if debug-on-error
- (byte-compile-file file)
- (condition-case err
- (byte-compile-file file)
- (file-error
- (message (if (cdr err)
- ">>Error occurred processing %s: %s (%s)"
- ">>Error occurred processing %s: %s")
- file
- (get (car err) 'error-message)
- (prin1-to-string (cdr err)))
- (let ((destfile (byte-compile-dest-file file)))
- (if (file-exists-p destfile)
- (delete-file destfile)))
- nil)
- (error
- (message (if (cdr err)
- ">>Error occurred processing %s: %s (%s)"
- ">>Error occurred processing %s: %s")
- file
- (get (car err) 'error-message)
- (prin1-to-string (cdr err)))
- nil))))
+ (let ((byte-compile-root-dir (or byte-compile-root-dir default-directory)))
+ (if debug-on-error
+ (byte-compile-file file)
+ (condition-case err
+ (byte-compile-file file)
+ (file-error
+ (message (if (cdr err)
+ ">>Error occurred processing %s: %s (%s)"
+ ">>Error occurred processing %s: %s")
+ file
+ (get (car err) 'error-message)
+ (prin1-to-string (cdr err)))
+ (let ((destfile (byte-compile-dest-file file)))
+ (if (file-exists-p destfile)
+ (delete-file destfile)))
+ nil)
+ (error
+ (message (if (cdr err)
+ ">>Error occurred processing %s: %s (%s)"
+ ">>Error occurred processing %s: %s")
+ file
+ (get (car err) 'error-message)
+ (prin1-to-string (cdr err)))
+ nil)))))
(defun byte-compile-refresh-preloaded ()
"Reload any Lisp file that was changed since Emacs was dumped.
@@ -4604,6 +4595,16 @@ and corresponding effects."
(setq command-line-args-left (cdr command-line-args-left)))
(kill-emacs 0))
+;;; Core compiler macros.
+
+(put 'featurep 'compiler-macro
+ (lambda (form feature &rest _ignore)
+ ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so
+ ;; we can safely optimize away this test.
+ (if (member feature '('xemacs 'sxemacs 'emacs))
+ (eval form)
+ form)))
+
(provide 'byte-compile)
(provide 'bytecomp)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index daafd2226ec..5a1d6265848 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -1,6 +1,6 @@
;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t; coding: utf-8 -*-
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Igor Kuzmin <kzuminig@iro.umontreal.ca>
;; Maintainer: FSF
@@ -73,8 +73,6 @@
;; since afterwards they can because obnoxious (warnings about an "unused
;; variable" should not be emitted when the variable use has simply been
;; optimized away).
-;; - turn defun and defmacro into macros (and remove special handling of
-;; `declare' afterwards).
;; - let macros specify that some let-bindings come from the same source,
;; so the unused warning takes all uses into account.
;; - let interactive specs return a function to build the args (to stash into
@@ -112,7 +110,7 @@
;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
;; binders)))
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defconst cconv-liftwhen 6
"Try to do lambda lifting if the number of arguments + free variables
@@ -175,7 +173,7 @@ Returns a form where all lambdas don't have any free variables."
;; Here we assume that X appears at most once in M.
(let* ((b (assq x m))
(res (if b (remq b m) m)))
- (assert (null (assq x res))) ;; Check the assumption was warranted.
+ (cl-assert (null (assq x res))) ;; Check the assumption was warranted.
res))
(defun cconv--map-diff-set (m s)
@@ -187,7 +185,7 @@ Returns a form where all lambdas don't have any free variables."
(nreverse res)))
(defun cconv--convert-function (args body env parentform)
- (assert (equal body (caar cconv-freevars-alist)))
+ (cl-assert (equal body (caar cconv-freevars-alist)))
(let* ((fvs (cdr (pop cconv-freevars-alist)))
(body-new '())
(letbind '())
@@ -253,11 +251,11 @@ ENV is a list where each entry takes the shape either:
EXTEND is a list of variables which might need to be accessed even from places
where they are shadowed, because some part of ENV causes them to be used at
places where they originally did not directly appear."
- (assert (not (delq nil (mapcar (lambda (mapping)
- (if (eq (cadr mapping) 'apply-partially)
- (cconv--set-diff (cdr (cddr mapping))
- extend)))
- env))))
+ (cl-assert (not (delq nil (mapcar (lambda (mapping)
+ (if (eq (cadr mapping) 'apply-partially)
+ (cconv--set-diff (cdr (cddr mapping))
+ extend)))
+ env))))
;; What's the difference between fvrs and envs?
;; Suppose that we have the code
@@ -289,10 +287,10 @@ places where they originally did not directly appear."
;; Check if var is a candidate for lambda lifting.
((and (member (cons binder form) cconv-lambda-candidates)
(progn
- (assert (and (eq (car value) 'function)
- (eq (car (cadr value)) 'lambda)))
- (assert (equal (cddr (cadr value))
- (caar cconv-freevars-alist)))
+ (cl-assert (and (eq (car value) 'function)
+ (eq (car (cadr value)) 'lambda)))
+ (cl-assert (equal (cddr (cadr value))
+ (caar cconv-freevars-alist)))
;; Peek at the freevars to decide whether to λ-lift.
(let* ((fvs (cdr (car cconv-freevars-alist)))
(fun (cadr value))
@@ -309,7 +307,7 @@ places where they originally did not directly appear."
(funcbody-env ()))
(push `(,var . (apply-partially ,var . ,fvs)) new-env)
(dolist (fv fvs)
- (pushnew fv new-extend)
+ (cl-pushnew fv new-extend)
(if (and (eq 'car (car-safe (cdr (assq fv env))))
(not (memq fv funargs)))
(push `(,fv . (car ,fv)) funcbody-env)))
@@ -347,14 +345,14 @@ places where they originally did not directly appear."
(mapcar (lambda (mapping)
(if (not (eq (cadr mapping) 'apply-partially))
mapping
- (assert (eq (car mapping) (nth 2 mapping)))
- (list* (car mapping)
- 'apply-partially
- (car mapping)
- (mapcar (lambda (arg)
- (if (eq var arg)
- closedsym arg))
- (nthcdr 3 mapping)))))
+ (cl-assert (eq (car mapping) (nth 2 mapping)))
+ `(,(car mapping)
+ apply-partially
+ ,(car mapping)
+ ,@(mapcar (lambda (arg)
+ (if (eq var arg)
+ closedsym arg))
+ (nthcdr 3 mapping)))))
new-env))
(setq new-extend (remq var new-extend))
(push closedsym new-extend)
@@ -410,20 +408,6 @@ places where they originally did not directly appear."
. ,(mapcar (lambda (form) (cconv-convert form env extend))
forms)))
- ;defun, defmacro
- (`(,(and sym (or `defun `defmacro))
- ,func ,args . ,body)
- (assert (equal body (caar cconv-freevars-alist)))
- (assert (null (cdar cconv-freevars-alist)))
-
- (let ((new (cconv--convert-function args body env form)))
- (pcase new
- (`(function (lambda ,newargs . ,new-body))
- (assert (equal args newargs))
- `(,sym ,func ,args . ,new-body))
- (t (byte-compile-report-error
- (format "Internal error in cconv of (%s %s ...)" sym func))))))
-
;condition-case
(`(condition-case ,var ,protected-form . ,handlers)
(let ((newform (cconv--convert-function
@@ -471,7 +455,7 @@ places where they originally did not directly appear."
(let ((mapping (cdr (assq fun env))))
(pcase mapping
(`(apply-partially ,_ . ,(and fvs `(,_ . ,_)))
- (assert (eq (cadr mapping) fun))
+ (cl-assert (eq (cadr mapping) fun))
`(,callsym ,fun
,@(mapcar (lambda (fv)
(let ((exp (or (cdr (assq fv env)) fv)))
@@ -567,7 +551,7 @@ FORM is the parent form that binds this var."
;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
;; and compute free variables.
(while env
- (assert (and envcopy (eq (caar env) (caar envcopy))))
+ (cl-assert (and envcopy (eq (caar env) (caar envcopy))))
(let ((free nil)
(x (cdr (car env)))
(y (cdr (car envcopy))))
@@ -618,15 +602,6 @@ and updates the data stored in ENV."
(dolist (vardata newvars)
(cconv--analyse-use vardata form "variable"))))
- ; defun special form
- (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms)
- (when env
- (byte-compile-log-warning
- (format "Function %S will ignore its context %S"
- func (mapcar #'car env))
- t :warning))
- (cconv--analyse-function vrs body-forms nil form))
-
(`(function (lambda ,vrs . ,body-forms))
(cconv--analyse-function vrs body-forms env form))
@@ -639,7 +614,9 @@ and updates the data stored in ENV."
(cconv-analyse-form (cadr forms) env)
(setq forms (cddr forms))))
- (`((lambda . ,_) . ,_) ; first element is lambda expression
+ (`((lambda . ,_) . ,_) ; First element is lambda expression.
+ (byte-compile-log-warning
+ "Use of deprecated ((lambda ...) ...) form" t :warning)
(dolist (exp `((function ,(car form)) . ,(cdr form)))
(cconv-analyse-form exp env)))
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index e9f2ec54601..31aeb1f8076 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -1,6 +1,6 @@
-;;; chart.el --- Draw charts (bar charts, etc)
+;;; chart.el --- Draw charts (bar charts, etc) -*- lexical-binding: t -*-
-;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2011
+;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2012
;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -62,8 +62,8 @@
(require 'eieio)
;;; Code:
-(defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.")
(define-obsolete-variable-alias 'chart-map 'chart-mode-map "24.1")
+(defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.")
(defvar chart-local-object nil
"Local variable containing the locally displayed chart object.")
@@ -82,7 +82,7 @@ Colors will be the background color.")
Useful if new Emacs is used on B&W display.")
(defcustom chart-face-use-pixmaps nil
- "*Non-nil to use fancy pixmaps in the background of chart face colors."
+ "Non-nil to use fancy pixmaps in the background of chart face colors."
:group 'eieio
:type 'boolean)
@@ -156,7 +156,7 @@ Returns the newly created buffer."
)
"Superclass for all charts to be displayed in an Emacs buffer.")
-(defmethod initialize-instance :AFTER ((obj chart) &rest fields)
+(defmethod initialize-instance :AFTER ((obj chart) &rest _fields)
"Initialize the chart OBJ being created with FIELDS.
Make sure the width/height is correct."
(oset obj x-width (- (window-width) 10))
@@ -276,7 +276,7 @@ START and END represent the boundary."
(float (- (cdr range) (car range)))))))))
)
-(defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone start end)
+(defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone _start _end)
"Draw axis information based upon a range to be spread along the edge.
A is the chart to draw. DIR is the direction.
MARGIN, ZONE, START, and END specify restrictions in chart space."
@@ -329,7 +329,7 @@ Automatically compensates for direction."
(+ m -1 (round (* lpn (+ 1.0 (float n))))))
))
-(defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone start end)
+(defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone _start _end)
"Draw axis information based upon A range to be spread along the edge.
Optional argument DIR is the direction of the chart.
Optional arguments MARGIN, ZONE, START and END specify boundaries of the drawing."
@@ -675,28 +675,14 @@ SORT-PRED if desired."
(defun chart-emacs-storage ()
"Chart the current storage requirements of Emacs."
(interactive)
- (let* ((data (garbage-collect))
- (names '("strings/2" "vectors"
- "conses" "free cons"
- "syms" "free syms"
- "markers" "free mark"
- ;; "floats" "free flt"
- ))
- (nums (list (/ (nth 3 data) 2)
- (nth 4 data)
- (car (car data)) ; conses
- (cdr (car data))
- (car (nth 1 data)) ; syms
- (cdr (nth 1 data))
- (car (nth 2 data)) ; markers
- (cdr (nth 2 data))
- ;(car (nth 5 data)) ; floats are Emacs only
- ;(cdr (nth 5 data))
- )))
+ (let* ((data (garbage-collect)))
;; Let's create the chart!
(chart-bar-quickie 'vertical "Emacs Runtime Storage Usage"
- names "Storage Items"
- nums "Objects")))
+ (mapcar (lambda (x) (symbol-name (car x))) data)
+ "Storage Items"
+ (mapcar (lambda (x) (* (nth 1 x) (nth 2 x)))
+ data)
+ "Bytes")))
(defun chart-emacs-lists ()
"Chart out the size of various important lists."
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index e15920ef009..d4213899ef6 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -1,6 +1,6 @@
;;; check-declare.el --- Check declare-function statements
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Glenn Morris <rgm@gnu.org>
;; Keywords: lisp, tools, maint
@@ -28,7 +28,7 @@
;; checks that all such statements in a file or directory are accurate.
;; The entry points are `check-declare-file' and `check-declare-directory'.
-;; For more information, see Info node `elisp(Declaring Functions)'.
+;; For more information, see Info node `(elisp)Declaring Functions'.
;;; TODO:
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 9b708d4bbd2..1cbed17cbab 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1,6 +1,6 @@
;;; checkdoc.el --- check documentation strings for style requirements
-;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.6.2
@@ -124,7 +124,7 @@
;; Adding your own checks:
;;
;; You can experiment with adding your own checks by setting the
-;; hooks `checkdoc-style-hooks' and `checkdoc-comment-style-hooks'.
+;; hooks `checkdoc-style-functions' and `checkdoc-comment-style-functions'.
;; Return a string which is the error you wish to report. The cursor
;; position should be preserved.
;;
@@ -274,17 +274,21 @@ made in the style guide relating to order."
:type 'boolean)
;;;###autoload(put 'checkdoc-arguments-in-order-flag 'safe-local-variable 'booleanp)
-(defvar checkdoc-style-hooks nil
- "Hooks called after the standard style check is completed.
-All hooks must return nil or a string representing the error found.
+(define-obsolete-variable-alias 'checkdoc-style-hooks
+ 'checkdoc-style-functions "24.3")
+(defvar checkdoc-style-functions nil
+ "Hook run after the standard style check is completed.
+All functions must return nil or a string representing the error found.
Useful for adding new user implemented commands.
Each hook is called with two parameters, (DEFUNINFO ENDPOINT).
DEFUNINFO is the return value of `checkdoc-defun-info'. ENDPOINT is the
location of end of the documentation string.")
-(defvar checkdoc-comment-style-hooks nil
- "Hooks called after the standard comment style check is completed.
+(define-obsolete-variable-alias 'checkdoc-comment-style-hooks
+ 'checkdoc-comment-style-functions "24.3")
+(defvar checkdoc-comment-style-functions nil
+ "Hook run after the standard comment style check is completed.
Must return nil if no errors are found, or a string describing the
problem discovered. This is useful for adding additional checks.")
@@ -916,7 +920,7 @@ is the starting location. If this is nil, `point-min' is used instead."
(progn
(goto-char wrong)
(if (not take-notes)
- (error "%s" (checkdoc-error-text msg)))))
+ (user-error "%s" (checkdoc-error-text msg)))))
(checkdoc-show-diagnostics)
(if (called-interactively-p 'interactive)
(message "No style warnings."))))
@@ -949,7 +953,7 @@ if there is one."
(e (checkdoc-file-comments-engine))
(checkdoc-generate-compile-warnings-flag
(or take-notes checkdoc-generate-compile-warnings-flag)))
- (if e (error "%s" (checkdoc-error-text e)))
+ (if e (user-error "%s" (checkdoc-error-text e)))
(checkdoc-show-diagnostics)
e))
@@ -987,7 +991,7 @@ Optional argument TAKE-NOTES causes all errors to be logged."
(if (not (called-interactively-p 'interactive))
e
(if e
- (error "%s" (checkdoc-error-text e))
+ (user-error "%s" (checkdoc-error-text e))
(checkdoc-show-diagnostics)))
(goto-char p))
(if (called-interactively-p 'interactive)
@@ -1027,19 +1031,14 @@ space at the end of each line."
(car (memq checkdoc-spellcheck-documentation-flag
'(defun t))))
(beg (save-excursion (beginning-of-defun) (point)))
- (end (save-excursion (end-of-defun) (point)))
- (msg (checkdoc-this-string-valid)))
- (if msg (if no-error
- (message "%s" (checkdoc-error-text msg))
- (error "%s" (checkdoc-error-text msg)))
- (setq msg (checkdoc-message-text-search beg end))
- (if msg (if no-error
- (message "%s" (checkdoc-error-text msg))
- (error "%s" (checkdoc-error-text msg)))
- (setq msg (checkdoc-rogue-space-check-engine beg end))
- (if msg (if no-error
- (message "%s" (checkdoc-error-text msg))
- (error "%s" (checkdoc-error-text msg))))))
+ (end (save-excursion (end-of-defun) (point))))
+ (dolist (fun (list #'checkdoc-this-string-valid
+ (lambda () (checkdoc-message-text-search beg end))
+ (lambda () (checkdoc-rogue-space-check-engine beg end))))
+ (let ((msg (funcall fun)))
+ (if msg (if no-error
+ (message "%s" (checkdoc-error-text msg))
+ (user-error "%s" (checkdoc-error-text msg))))))
(if (called-interactively-p 'interactive)
(message "Checkdoc: done."))))))
@@ -1848,7 +1847,7 @@ Replace with \"%s\"? " original replace)
;; and reliance on the Ispell program.
(checkdoc-ispell-docstring-engine e)
;; User supplied checks
- (save-excursion (checkdoc-run-hooks 'checkdoc-style-hooks fp e))
+ (save-excursion (checkdoc-run-hooks 'checkdoc-style-functions fp e))
;; Done!
)))
@@ -1943,7 +1942,7 @@ from the comment."
A code fragment is identified by an open parenthesis followed by a
symbol which is a valid function or a word in all CAPS, or a parenthesis
that is quoted with the ' character. Only the region from START to LIMIT
-is is allowed while searching for the bounding parenthesis."
+is allowed while searching for the bounding parenthesis."
(save-match-data
(save-restriction
(narrow-to-region start limit)
@@ -2358,7 +2357,7 @@ Code:, and others referenced in the style guide."
err
(or
;; Generic Full-file checks (should be comment related)
- (checkdoc-run-hooks 'checkdoc-comment-style-hooks)
+ (checkdoc-run-hooks 'checkdoc-comment-style-functions)
err))
;; Done with full file comment checks
err)))
@@ -2644,12 +2643,6 @@ function called to create the messages."
(custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
-(add-to-list 'debug-ignored-errors
- "Argument `.*' should appear (as .*) in the doc string")
-(add-to-list 'debug-ignored-errors
- "Lisp symbol `.*' should appear in quotes")
-(add-to-list 'debug-ignored-errors "Disambiguate .* by preceding .*")
-
(provide 'checkdoc)
;;; checkdoc.el ends here
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 8ea58b2e07c..7c25972835b 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -1,6 +1,6 @@
-;;; cl-extra.el --- Common Lisp features, part 2
+;;; cl-extra.el --- Common Lisp features, part 2 -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2000-2012 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Keywords: extensions
@@ -37,12 +37,12 @@
;;; Code:
-(require 'cl)
+(require 'cl-lib)
;;; Type coercion.
;;;###autoload
-(defun coerce (x type)
+(defun cl-coerce (x type)
"Coerce OBJECT to type TYPE.
TYPE is a Common Lisp type specifier.
\n(fn OBJECT TYPE)"
@@ -51,16 +51,16 @@ TYPE is a Common Lisp type specifier.
((eq type 'string) (if (stringp x) x (concat x)))
((eq type 'array) (if (arrayp x) x (vconcat x)))
((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0))
- ((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type))
+ ((and (eq type 'character) (symbolp x)) (cl-coerce (symbol-name x) type))
((eq type 'float) (float x))
- ((typep x type) x)
+ ((cl-typep x type) x)
(t (error "Can't coerce %s to type %s" x type))))
;;; Predicates.
;;;###autoload
-(defun equalp (x y)
+(defun cl-equalp (x y)
"Return t if two Lisp objects have similar structures and contents.
This is like `equal', except that it accepts numerically equal
numbers of different types (float vs. integer), and also compares
@@ -73,14 +73,14 @@ strings case-insensitively."
((numberp x)
(and (numberp y) (= x y)))
((consp x)
- (while (and (consp x) (consp y) (equalp (car x) (car y)))
+ (while (and (consp x) (consp y) (cl-equalp (car x) (car y)))
(setq x (cdr x) y (cdr y)))
- (and (not (consp x)) (equalp x y)))
+ (and (not (consp x)) (cl-equalp x y)))
((vectorp x)
(and (vectorp y) (= (length x) (length y))
(let ((i (length x)))
(while (and (>= (setq i (1- i)) 0)
- (equalp (aref x i) (aref y i))))
+ (cl-equalp (aref x i) (aref y i))))
(< i 0))))
(t (equal x y))))
@@ -88,7 +88,7 @@ strings case-insensitively."
;;; Control structures.
;;;###autoload
-(defun cl-mapcar-many (cl-func cl-seqs)
+(defun cl--mapcar-many (cl-func cl-seqs)
(if (cdr (cdr cl-seqs))
(let* ((cl-res nil)
(cl-n (apply 'min (mapcar 'length cl-seqs)))
@@ -115,23 +115,23 @@ strings case-insensitively."
(cl-i -1))
(while (< (setq cl-i (1+ cl-i)) cl-n)
(push (funcall cl-func
- (if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
- (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))
- cl-res)))
+ (if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
+ (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))
+ cl-res)))
(nreverse cl-res))))
;;;###autoload
-(defun map (cl-type cl-func cl-seq &rest cl-rest)
+(defun cl-map (cl-type cl-func cl-seq &rest cl-rest)
"Map a FUNCTION across one or more SEQUENCEs, returning a sequence.
TYPE is the sequence type to return.
\n(fn TYPE FUNCTION SEQUENCE...)"
- (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest)))
- (and cl-type (coerce cl-res cl-type))))
+ (let ((cl-res (apply 'cl-mapcar cl-func cl-seq cl-rest)))
+ (and cl-type (cl-coerce cl-res cl-type))))
;;;###autoload
-(defun maplist (cl-func cl-list &rest cl-rest)
+(defun cl-maplist (cl-func cl-list &rest cl-rest)
"Map FUNCTION to each sublist of LIST or LISTs.
-Like `mapcar', except applies to lists and their cdr's rather than to
+Like `cl-mapcar', except applies to lists and their cdr's rather than to
the elements themselves.
\n(fn FUNCTION LIST...)"
(if cl-rest
@@ -149,44 +149,45 @@ the elements themselves.
(setq cl-list (cdr cl-list)))
(nreverse cl-res))))
+;;;###autoload
(defun cl-mapc (cl-func cl-seq &rest cl-rest)
- "Like `mapcar', but does not accumulate values returned by the function.
+ "Like `cl-mapcar', but does not accumulate values returned by the function.
\n(fn FUNCTION SEQUENCE...)"
(if cl-rest
- (progn (apply 'map nil cl-func cl-seq cl-rest)
+ (progn (apply 'cl-map nil cl-func cl-seq cl-rest)
cl-seq)
(mapc cl-func cl-seq)))
;;;###autoload
-(defun mapl (cl-func cl-list &rest cl-rest)
- "Like `maplist', but does not accumulate values returned by the function.
+(defun cl-mapl (cl-func cl-list &rest cl-rest)
+ "Like `cl-maplist', but does not accumulate values returned by the function.
\n(fn FUNCTION LIST...)"
(if cl-rest
- (apply 'maplist cl-func cl-list cl-rest)
+ (apply 'cl-maplist cl-func cl-list cl-rest)
(let ((cl-p cl-list))
(while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p)))))
cl-list)
;;;###autoload
-(defun mapcan (cl-func cl-seq &rest cl-rest)
- "Like `mapcar', but nconc's together the values returned by the function.
+(defun cl-mapcan (cl-func cl-seq &rest cl-rest)
+ "Like `cl-mapcar', but nconc's together the values returned by the function.
\n(fn FUNCTION SEQUENCE...)"
- (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest)))
+ (apply 'nconc (apply 'cl-mapcar cl-func cl-seq cl-rest)))
;;;###autoload
-(defun mapcon (cl-func cl-list &rest cl-rest)
- "Like `maplist', but nconc's together the values returned by the function.
+(defun cl-mapcon (cl-func cl-list &rest cl-rest)
+ "Like `cl-maplist', but nconc's together the values returned by the function.
\n(fn FUNCTION LIST...)"
- (apply 'nconc (apply 'maplist cl-func cl-list cl-rest)))
+ (apply 'nconc (apply 'cl-maplist cl-func cl-list cl-rest)))
;;;###autoload
-(defun some (cl-pred cl-seq &rest cl-rest)
+(defun cl-some (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is true of any element of SEQ or SEQs.
If so, return the true (non-nil) value returned by PREDICATE.
\n(fn PREDICATE SEQ...)"
(if (or cl-rest (nlistp cl-seq))
(catch 'cl-some
- (apply 'map nil
+ (apply 'cl-map nil
(function (lambda (&rest cl-x)
(let ((cl-res (apply cl-pred cl-x)))
(if cl-res (throw 'cl-some cl-res)))))
@@ -196,12 +197,12 @@ If so, return the true (non-nil) value returned by PREDICATE.
cl-x)))
;;;###autoload
-(defun every (cl-pred cl-seq &rest cl-rest)
+(defun cl-every (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is true of every element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
(if (or cl-rest (nlistp cl-seq))
(catch 'cl-every
- (apply 'map nil
+ (apply 'cl-map nil
(function (lambda (&rest cl-x)
(or (apply cl-pred cl-x) (throw 'cl-every nil))))
cl-seq cl-rest) t)
@@ -210,23 +211,19 @@ If so, return the true (non-nil) value returned by PREDICATE.
(null cl-seq)))
;;;###autoload
-(defun notany (cl-pred cl-seq &rest cl-rest)
+(defun cl-notany (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is false of every element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
- (not (apply 'some cl-pred cl-seq cl-rest)))
+ (not (apply 'cl-some cl-pred cl-seq cl-rest)))
;;;###autoload
-(defun notevery (cl-pred cl-seq &rest cl-rest)
+(defun cl-notevery (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is false of some element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
- (not (apply 'every cl-pred cl-seq cl-rest)))
-
-;;; Support for `loop'.
-;;;###autoload
-(defalias 'cl-map-keymap 'map-keymap)
+ (not (apply 'cl-every cl-pred cl-seq cl-rest)))
;;;###autoload
-(defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
+(defun cl--map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
(or cl-base
(setq cl-base (copy-sequence [0])))
(map-keymap
@@ -234,14 +231,14 @@ If so, return the true (non-nil) value returned by PREDICATE.
(lambda (cl-key cl-bind)
(aset cl-base (1- (length cl-base)) cl-key)
(if (keymapp cl-bind)
- (cl-map-keymap-recursively
+ (cl--map-keymap-recursively
cl-func-rec cl-bind
(vconcat cl-base (list 0)))
(funcall cl-func-rec cl-base cl-bind))))
cl-map))
;;;###autoload
-(defun cl-map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end)
+(defun cl--map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end)
(or cl-what (setq cl-what (current-buffer)))
(if (bufferp cl-what)
(let (cl-mark cl-mark2 (cl-next t) cl-next2)
@@ -269,7 +266,7 @@ If so, return the true (non-nil) value returned by PREDICATE.
(setq cl-start cl-next)))))
;;;###autoload
-(defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg)
+(defun cl--map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg)
(or cl-buffer (setq cl-buffer (current-buffer)))
(if (fboundp 'overlay-lists)
@@ -311,36 +308,17 @@ If so, return the true (non-nil) value returned by PREDICATE.
;;; Support for `setf'.
;;;###autoload
-(defun cl-set-frame-visible-p (frame val)
+(defun cl--set-frame-visible-p (frame val)
(cond ((null val) (make-frame-invisible frame))
((eq val 'icon) (iconify-frame frame))
(t (make-frame-visible frame)))
val)
-;;; Support for `progv'.
-(defvar cl-progv-save)
-;;;###autoload
-(defun cl-progv-before (syms values)
- (while syms
- (push (if (boundp (car syms))
- (cons (car syms) (symbol-value (car syms)))
- (car syms)) cl-progv-save)
- (if values
- (set (pop syms) (pop values))
- (makunbound (pop syms)))))
-
-(defun cl-progv-after ()
- (while cl-progv-save
- (if (consp (car cl-progv-save))
- (set (car (car cl-progv-save)) (cdr (car cl-progv-save)))
- (makunbound (car cl-progv-save)))
- (pop cl-progv-save)))
-
;;; Numbers.
;;;###autoload
-(defun gcd (&rest args)
+(defun cl-gcd (&rest args)
"Return the greatest common divisor of the arguments."
(let ((a (abs (or (pop args) 0))))
(while args
@@ -349,18 +327,18 @@ If so, return the true (non-nil) value returned by PREDICATE.
a))
;;;###autoload
-(defun lcm (&rest args)
+(defun cl-lcm (&rest args)
"Return the least common multiple of the arguments."
(if (memq 0 args)
0
(let ((a (abs (or (pop args) 1))))
(while args
(let ((b (abs (pop args))))
- (setq a (* (/ a (gcd a b)) b))))
+ (setq a (* (/ a (cl-gcd a b)) b))))
a)))
;;;###autoload
-(defun isqrt (x)
+(defun cl-isqrt (x)
"Return the integer square root of the argument."
(if (and (integerp x) (> x 0))
(let ((g (cond ((<= x 100) 10) ((<= x 10000) 100)
@@ -372,35 +350,35 @@ If so, return the true (non-nil) value returned by PREDICATE.
(if (eq x 0) 0 (signal 'arith-error nil))))
;;;###autoload
-(defun floor* (x &optional y)
+(defun cl-floor (x &optional y)
"Return a list of the floor of X and the fractional part of X.
With two arguments, return floor and remainder of their quotient."
(let ((q (floor x y)))
(list q (- x (if y (* y q) q)))))
;;;###autoload
-(defun ceiling* (x &optional y)
+(defun cl-ceiling (x &optional y)
"Return a list of the ceiling of X and the fractional part of X.
With two arguments, return ceiling and remainder of their quotient."
- (let ((res (floor* x y)))
+ (let ((res (cl-floor x y)))
(if (= (car (cdr res)) 0) res
(list (1+ (car res)) (- (car (cdr res)) (or y 1))))))
;;;###autoload
-(defun truncate* (x &optional y)
+(defun cl-truncate (x &optional y)
"Return a list of the integer part of X and the fractional part of X.
With two arguments, return truncation and remainder of their quotient."
(if (eq (>= x 0) (or (null y) (>= y 0)))
- (floor* x y) (ceiling* x y)))
+ (cl-floor x y) (cl-ceiling x y)))
;;;###autoload
-(defun round* (x &optional y)
+(defun cl-round (x &optional y)
"Return a list of X rounded to the nearest integer and the remainder.
With two arguments, return rounding and remainder of their quotient."
(if y
(if (and (integerp x) (integerp y))
(let* ((hy (/ y 2))
- (res (floor* (+ x hy) y)))
+ (res (cl-floor (+ x hy) y)))
(if (and (= (car (cdr res)) 0)
(= (+ hy hy) y)
(/= (% (car res) 2) 0))
@@ -413,29 +391,28 @@ With two arguments, return rounding and remainder of their quotient."
(list q (- x q))))))
;;;###autoload
-(defun mod* (x y)
+(defun cl-mod (x y)
"The remainder of X divided by Y, with the same sign as Y."
- (nth 1 (floor* x y)))
+ (nth 1 (cl-floor x y)))
;;;###autoload
-(defun rem* (x y)
+(defun cl-rem (x y)
"The remainder of X divided by Y, with the same sign as X."
- (nth 1 (truncate* x y)))
+ (nth 1 (cl-truncate x y)))
;;;###autoload
-(defun signum (x)
+(defun cl-signum (x)
"Return 1 if X is positive, -1 if negative, 0 if zero."
(cond ((> x 0) 1) ((< x 0) -1) (t 0)))
;; Random numbers.
-(defvar *random-state*)
;;;###autoload
-(defun random* (lim &optional state)
+(defun cl-random (lim &optional state)
"Return a random nonnegative number less than LIM, an integer or float.
Optional second arg STATE is a random-state object."
- (or state (setq state *random-state*))
+ (or state (setq state cl--random-state))
;; Inspired by "ran3" from Numerical Recipes. Additive congruential method.
(let ((vec (aref state 3)))
(if (integerp vec)
@@ -444,29 +421,29 @@ Optional second arg STATE is a random-state object."
(aset vec 0 j)
(while (> (setq i (% (+ i 21) 55)) 0)
(aset vec i (setq j (prog1 k (setq k (- j k))))))
- (while (< (setq i (1+ i)) 200) (random* 2 state))))
+ (while (< (setq i (1+ i)) 200) (cl-random 2 state))))
(let* ((i (aset state 1 (% (1+ (aref state 1)) 55)))
(j (aset state 2 (% (1+ (aref state 2)) 55)))
(n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j))))))
(if (integerp lim)
(if (<= lim 512) (% n lim)
- (if (> lim 8388607) (setq n (+ (lsh n 9) (random* 512 state))))
+ (if (> lim 8388607) (setq n (+ (lsh n 9) (cl-random 512 state))))
(let ((mask 1023))
(while (< mask (1- lim)) (setq mask (1+ (+ mask mask))))
- (if (< (setq n (logand n mask)) lim) n (random* lim state))))
+ (if (< (setq n (logand n mask)) lim) n (cl-random lim state))))
(* (/ n '8388608e0) lim)))))
;;;###autoload
-(defun make-random-state (&optional state)
- "Return a copy of random-state STATE, or of `*random-state*' if omitted.
+(defun cl-make-random-state (&optional state)
+ "Return a copy of random-state STATE, or of the internal state if omitted.
If STATE is t, return a new state object seeded from the time of day."
- (cond ((null state) (make-random-state *random-state*))
- ((vectorp state) (cl-copy-tree state t))
+ (cond ((null state) (cl-make-random-state cl--random-state))
+ ((vectorp state) (copy-tree state t))
((integerp state) (vector 'cl-random-state-tag -1 30 state))
- (t (make-random-state (cl-random-time)))))
+ (t (cl-make-random-state (cl--random-time)))))
;;;###autoload
-(defun random-state-p (object)
+(defun cl-random-state-p (object)
"Return t if OBJECT is a random-state object."
(and (vectorp object) (= (length object) 4)
(eq (aref object 0) 'cl-random-state-tag)))
@@ -474,8 +451,8 @@ If STATE is t, return a new state object seeded from the time of day."
;; Implementation limits.
-(defun cl-finite-do (func a b)
- (condition-case err
+(defun cl--finite-do (func a b)
+ (condition-case _
(let ((res (funcall func a b))) ; check for IEEE infinity
(and (numberp res) (/= res (/ res 2)) res))
(arith-error nil)))
@@ -483,51 +460,55 @@ If STATE is t, return a new state object seeded from the time of day."
;;;###autoload
(defun cl-float-limits ()
"Initialize the Common Lisp floating-point parameters.
-This sets the values of: `most-positive-float', `most-negative-float',
-`least-positive-float', `least-negative-float', `float-epsilon',
-`float-negative-epsilon', `least-positive-normalized-float', and
-`least-negative-normalized-float'."
- (or most-positive-float (not (numberp '2e1))
+This sets the values of: `cl-most-positive-float', `cl-most-negative-float',
+`cl-least-positive-float', `cl-least-negative-float', `cl-float-epsilon',
+`cl-float-negative-epsilon', `cl-least-positive-normalized-float', and
+`cl-least-negative-normalized-float'."
+ (or cl-most-positive-float (not (numberp '2e1))
(let ((x '2e0) y z)
;; Find maximum exponent (first two loops are optimizations)
- (while (cl-finite-do '* x x) (setq x (* x x)))
- (while (cl-finite-do '* x (/ x 2)) (setq x (* x (/ x 2))))
- (while (cl-finite-do '+ x x) (setq x (+ x x)))
+ (while (cl--finite-do '* x x) (setq x (* x x)))
+ (while (cl--finite-do '* x (/ x 2)) (setq x (* x (/ x 2))))
+ (while (cl--finite-do '+ x x) (setq x (+ x x)))
(setq z x y (/ x 2))
- ;; Now fill in 1's in the mantissa.
- (while (and (cl-finite-do '+ x y) (/= (+ x y) x))
+ ;; Now cl-fill in 1's in the mantissa.
+ (while (and (cl--finite-do '+ x y) (/= (+ x y) x))
(setq x (+ x y) y (/ y 2)))
- (setq most-positive-float x
- most-negative-float (- x))
+ (setq cl-most-positive-float x
+ cl-most-negative-float (- x))
;; Divide down until mantissa starts rounding.
(setq x (/ x z) y (/ 16 z) x (* x y))
- (while (condition-case err (and (= x (* (/ x 2) 2)) (> (/ y 2) 0))
+ (while (condition-case _ (and (= x (* (/ x 2) 2)) (> (/ y 2) 0))
(arith-error nil))
(setq x (/ x 2) y (/ y 2)))
- (setq least-positive-normalized-float y
- least-negative-normalized-float (- y))
+ (setq cl-least-positive-normalized-float y
+ cl-least-negative-normalized-float (- y))
;; Divide down until value underflows to zero.
(setq x (/ 1 z) y x)
- (while (condition-case err (> (/ x 2) 0) (arith-error nil))
+ (while (condition-case _ (> (/ x 2) 0) (arith-error nil))
(setq x (/ x 2)))
- (setq least-positive-float x
- least-negative-float (- x))
+ (setq cl-least-positive-float x
+ cl-least-negative-float (- x))
(setq x '1e0)
(while (/= (+ '1e0 x) '1e0) (setq x (/ x 2)))
- (setq float-epsilon (* x 2))
+ (setq cl-float-epsilon (* x 2))
(setq x '1e0)
(while (/= (- '1e0 x) '1e0) (setq x (/ x 2)))
- (setq float-negative-epsilon (* x 2))))
+ (setq cl-float-negative-epsilon (* x 2))))
nil)
;;; Sequence functions.
;;;###autoload
-(defun subseq (seq start &optional end)
+(defun cl-subseq (seq start &optional end)
"Return the subsequence of SEQ from START to END.
If END is omitted, it defaults to the length of the sequence.
If START or END is negative, it counts from the end."
+ (declare (gv-setter
+ (lambda (new)
+ `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end)
+ ,new))))
(if (stringp seq) (substring seq start end)
(let (len)
(and end (< end 0) (setq end (+ end (setq len (length seq)))))
@@ -550,7 +531,7 @@ If START or END is negative, it counts from the end."
res))))))
;;;###autoload
-(defun concatenate (type &rest seqs)
+(defun cl-concatenate (type &rest seqs)
"Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
\n(fn TYPE SEQUENCE...)"
(cond ((eq type 'vector) (apply 'vconcat seqs))
@@ -562,17 +543,17 @@ If START or END is negative, it counts from the end."
;;; List functions.
;;;###autoload
-(defun revappend (x y)
+(defun cl-revappend (x y)
"Equivalent to (append (reverse X) Y)."
(nconc (reverse x) y))
;;;###autoload
-(defun nreconc (x y)
+(defun cl-nreconc (x y)
"Equivalent to (nconc (nreverse X) Y)."
(nconc (nreverse x) y))
;;;###autoload
-(defun list-length (x)
+(defun cl-list-length (x)
"Return the length of list X. Return nil if list is circular."
(let ((n 0) (fast x) (slow x))
(while (and (cdr fast) (not (and (eq fast slow) (> n 0))))
@@ -580,51 +561,62 @@ If START or END is negative, it counts from the end."
(if fast (if (cdr fast) nil (1+ n)) n)))
;;;###autoload
-(defun tailp (sublist list)
+(defun cl-tailp (sublist list)
"Return true if SUBLIST is a tail of LIST."
(while (and (consp list) (not (eq sublist list)))
(setq list (cdr list)))
(if (numberp sublist) (equal sublist list) (eq sublist list)))
-(defalias 'cl-copy-tree 'copy-tree)
-
-
;;; Property lists.
;;;###autoload
-(defun get* (sym tag &optional def) ; See compiler macro in cl-macs.el
+(defun cl-get (sym tag &optional def)
"Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
\n(fn SYMBOL PROPNAME &optional DEFAULT)"
+ (declare (compiler-macro cl--compiler-macro-get)
+ (gv-setter (lambda (store) `(put ,sym ,tag ,store))))
(or (get sym tag)
(and def
+ ;; Make sure `def' is really absent as opposed to set to nil.
(let ((plist (symbol-plist sym)))
(while (and plist (not (eq (car plist) tag)))
(setq plist (cdr (cdr plist))))
(if plist (car (cdr plist)) def)))))
+(autoload 'cl--compiler-macro-get "cl-macs")
;;;###autoload
-(defun getf (plist tag &optional def)
+(defun cl-getf (plist tag &optional def)
"Search PROPLIST for property PROPNAME; return its value or DEFAULT.
PROPLIST is a list of the sort returned by `symbol-plist'.
\n(fn PROPLIST PROPNAME &optional DEFAULT)"
+ (declare (gv-expander
+ (lambda (do)
+ (gv-letplace (getter setter) plist
+ (macroexp-let2 nil k tag
+ (macroexp-let2 nil d def
+ (funcall do `(cl-getf ,getter ,k ,d)
+ (lambda (v)
+ (funcall setter
+ `(cl--set-getf ,getter ,k ,v))))))))))
(setplist '--cl-getf-symbol-- plist)
(or (get '--cl-getf-symbol-- tag)
- ;; Originally we called get* here,
- ;; but that fails, because get* has a compiler macro
+ ;; Originally we called cl-get here,
+ ;; but that fails, because cl-get has a compiler macro
;; definition that uses getf!
(when def
+ ;; Make sure `def' is really absent as opposed to set to nil.
(while (and plist (not (eq (car plist) tag)))
(setq plist (cdr (cdr plist))))
(if plist (car (cdr plist)) def))))
;;;###autoload
-(defun cl-set-getf (plist tag val)
+(defun cl--set-getf (plist tag val)
(let ((p plist))
(while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p))))
- (if p (progn (setcar (cdr p) val) plist) (list* tag val plist))))
+ (if p (progn (setcar (cdr p) val) plist) (cl-list* tag val plist))))
;;;###autoload
-(defun cl-do-remf (plist tag)
+(defun cl--do-remf (plist tag)
(let ((p (cdr plist)))
(while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p))))
(and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
@@ -636,41 +628,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(let ((plist (symbol-plist sym)))
(if (and plist (eq tag (car plist)))
(progn (setplist sym (cdr (cdr plist))) t)
- (cl-do-remf plist tag))))
-;;;###autoload
-(defalias 'remprop 'cl-remprop)
-
-
-
-;;; Hash tables.
-;; This is just kept for compatibility with code byte-compiled by Emacs-20.
-
-;; No idea if this might still be needed.
-(defun cl-not-hash-table (x &optional y &rest z)
- (signal 'wrong-type-argument (list 'cl-hash-table-p (or y x))))
-
-(defvar cl-builtin-gethash (symbol-function 'gethash))
-(defvar cl-builtin-remhash (symbol-function 'remhash))
-(defvar cl-builtin-clrhash (symbol-function 'clrhash))
-(defvar cl-builtin-maphash (symbol-function 'maphash))
-
-;;;###autoload
-(defalias 'cl-gethash 'gethash)
-;;;###autoload
-(defalias 'cl-puthash 'puthash)
-;;;###autoload
-(defalias 'cl-remhash 'remhash)
-;;;###autoload
-(defalias 'cl-clrhash 'clrhash)
-;;;###autoload
-(defalias 'cl-maphash 'maphash)
-;; These three actually didn't exist in Emacs-20.
-;;;###autoload
-(defalias 'cl-make-hash-table 'make-hash-table)
-;;;###autoload
-(defalias 'cl-hash-table-p 'hash-table-p)
-;;;###autoload
-(defalias 'cl-hash-table-count 'hash-table-count)
+ (cl--do-remf plist tag))))
;;; Some debugging aids.
@@ -686,15 +644,15 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(forward-sexp)
(delete-char 1))
(goto-char (1+ pt))
- (cl-do-prettyprint)))
+ (cl--do-prettyprint)))
-(defun cl-do-prettyprint ()
+(defun cl--do-prettyprint ()
(skip-chars-forward " ")
(if (looking-at "(")
(let ((skip (or (looking-at "((") (looking-at "(prog")
(looking-at "(unwind-protect ")
(looking-at "(function (")
- (looking-at "(cl-block-wrapper ")))
+ (looking-at "(cl--block-wrapper ")))
(two (or (looking-at "(defun ") (looking-at "(defmacro ")))
(let (or (looking-at "(let\\*? ") (looking-at "(while ")))
(set (looking-at "(p?set[qf] ")))
@@ -704,104 +662,27 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(and (>= (current-column) 78) (progn (backward-sexp) t))))
(let ((nl t))
(forward-char 1)
- (cl-do-prettyprint)
- (or skip (looking-at ")") (cl-do-prettyprint))
- (or (not two) (looking-at ")") (cl-do-prettyprint))
+ (cl--do-prettyprint)
+ (or skip (looking-at ")") (cl--do-prettyprint))
+ (or (not two) (looking-at ")") (cl--do-prettyprint))
(while (not (looking-at ")"))
(if set (setq nl (not nl)))
(if nl (insert "\n"))
(lisp-indent-line)
- (cl-do-prettyprint))
+ (cl--do-prettyprint))
(forward-char 1))))
(forward-sexp)))
-(defvar cl-macroexpand-cmacs nil)
-(defvar cl-closure-vars nil)
-
-;;;###autoload
-(defun cl-macroexpand-all (form &optional env)
- "Expand all macro calls through a Lisp FORM.
-This also does some trivial optimizations to make the form prettier."
- (while (or (not (eq form (setq form (macroexpand form env))))
- (and cl-macroexpand-cmacs
- (not (eq form (setq form (compiler-macroexpand form)))))))
- (cond ((not (consp form)) form)
- ((memq (car form) '(let let*))
- (if (null (nth 1 form))
- (cl-macroexpand-all (cons 'progn (cddr form)) env)
- (let ((letf nil) (res nil) (lets (cadr form)))
- (while lets
- (push (if (consp (car lets))
- (let ((exp (cl-macroexpand-all (caar lets) env)))
- (or (symbolp exp) (setq letf t))
- (cons exp (cl-macroexpand-body (cdar lets) env)))
- (let ((exp (cl-macroexpand-all (car lets) env)))
- (if (symbolp exp) exp
- (setq letf t) (list exp nil)))) res)
- (setq lets (cdr lets)))
- (list* (if letf (if (eq (car form) 'let) 'letf 'letf*) (car form))
- (nreverse res) (cl-macroexpand-body (cddr form) env)))))
- ((eq (car form) 'cond)
- (cons (car form)
- (mapcar (function (lambda (x) (cl-macroexpand-body x env)))
- (cdr form))))
- ((eq (car form) 'condition-case)
- (list* (car form) (nth 1 form) (cl-macroexpand-all (nth 2 form) env)
- (mapcar (function
- (lambda (x)
- (cons (car x) (cl-macroexpand-body (cdr x) env))))
- (cdddr form))))
- ((memq (car form) '(quote function))
- (if (eq (car-safe (nth 1 form)) 'lambda)
- (let ((body (cl-macroexpand-body (cddadr form) env)))
- (if (and cl-closure-vars (eq (car form) 'function)
- (cl-expr-contains-any body cl-closure-vars))
- (let* ((new (mapcar 'gensym cl-closure-vars))
- (sub (pairlis cl-closure-vars new)) (decls nil))
- (while (or (stringp (car body))
- (eq (car-safe (car body)) 'interactive))
- (push (list 'quote (pop body)) decls))
- (put (car (last cl-closure-vars)) 'used t)
- `(list 'lambda '(&rest --cl-rest--)
- ,@(sublis sub (nreverse decls))
- (list 'apply
- (list 'quote
- #'(lambda ,(append new (cadadr form))
- ,@(sublis sub body)))
- ,@(nconc (mapcar (lambda (x) `(list 'quote ,x))
- cl-closure-vars)
- '((quote --cl-rest--))))))
- (list (car form) (list* 'lambda (cadadr form) body))))
- (let ((found (assq (cadr form) env)))
- (if (and found (ignore-errors
- (eq (cadr (caddr found)) 'cl-labels-args)))
- (cl-macroexpand-all (cadr (caddr (cadddr found))) env)
- form))))
- ((memq (car form) '(defun defmacro))
- (list* (car form) (nth 1 form) (cl-macroexpand-body (cddr form) env)))
- ((and (eq (car form) 'progn) (not (cddr form)))
- (cl-macroexpand-all (nth 1 form) env))
- ((eq (car form) 'setq)
- (let* ((args (cl-macroexpand-body (cdr form) env)) (p args))
- (while (and p (symbolp (car p))) (setq p (cddr p)))
- (if p (cl-macroexpand-all (cons 'setf args)) (cons 'setq args))))
- ((consp (car form))
- (cl-macroexpand-all (list* 'funcall
- (list 'function (car form))
- (cdr form))
- env))
- (t (cons (car form) (cl-macroexpand-body (cdr form) env)))))
-
-(defun cl-macroexpand-body (body &optional env)
- (mapcar (function (lambda (x) (cl-macroexpand-all x env))) body))
-
;;;###autoload
(defun cl-prettyexpand (form &optional full)
+ "Expand macros in FORM and insert the pretty-printed result.
+Optional argument FULL non-nil means to expand all macros,
+including `cl-block' and `cl-eval-when'."
(message "Expanding...")
- (let ((cl-macroexpand-cmacs full) (cl-compiling-file full)
+ (let ((cl--compiling-file full)
(byte-compile-macro-environment nil))
- (setq form (cl-macroexpand-all form
- (and (not full) '((block) (eval-when)))))
+ (setq form (macroexpand-all form
+ (and (not full) '((cl-block) (cl-eval-when)))))
(message "Formatting...")
(prog1 (cl-prettyprint form)
(message ""))))
@@ -812,7 +693,6 @@ This also does some trivial optimizations to make the form prettier."
;; 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-indent.el b/lisp/emacs-lisp/cl-indent.el
index 81af2030ebe..01bdfbf4bf2 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -1,6 +1,6 @@
;;; cl-indent.el --- enhanced lisp-indent mode
-;; Copyright (C) 1987, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 2000-2012 Free Software Foundation, Inc.
;; Author: Richard Mlynarik <mly@eddie.mit.edu>
;; Created: July 1987
@@ -104,6 +104,7 @@ If non-nil, alignment is done with the first keyword
\(defun foo (arg1 arg2 &rest rest
&key key1 key2)
#|...|#)"
+ :version "24.1"
:type 'boolean
:group 'lisp-indent)
@@ -111,6 +112,7 @@ If non-nil, alignment is done with the first keyword
"Indentation of lambda list keyword parameters.
See `lisp-lambda-list-keyword-parameter-alignment'
for more information."
+ :version "24.1"
:type 'integer
:group 'lisp-indent)
@@ -130,6 +132,7 @@ If non-nil, alignment is done with the first parameter
\(defun foo (arg1 arg2 &key key1 key2
key3 key4)
#|...|#)"
+ :version "24.1"
:type 'boolean
:group 'lisp-indent)
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
new file mode 100644
index 00000000000..d5e5f4bbfbc
--- /dev/null
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -0,0 +1,756 @@
+;;; cl-lib.el --- Common Lisp extensions for Emacs -*- lexical-binding: t -*-
+
+;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
+
+;; Author: Dave Gillespie <daveg@synaptics.com>
+;; Version: 1.0
+;; Keywords: extensions
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; These are extensions to Emacs Lisp that provide a degree of
+;; Common Lisp compatibility, beyond what is already built-in
+;; in Emacs Lisp.
+;;
+;; This package was written by Dave Gillespie; it is a complete
+;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
+;;
+;; Bug reports, comments, and suggestions are welcome!
+
+;; This file contains the portions of the Common Lisp extensions
+;; package which should always be present.
+
+
+;;; Future notes:
+
+;; Once Emacs 19 becomes standard, many things in this package which are
+;; messy for reasons of compatibility can be greatly simplified. For now,
+;; I prefer to maintain one unified version.
+
+
+;;; Change Log:
+
+;; Version 2.02 (30 Jul 93):
+;; * Added "cl-compat.el" file, extra compatibility with old package.
+;; * Added `lexical-let' and `lexical-let*'.
+;; * Added `define-modify-macro', `callf', and `callf2'.
+;; * Added `ignore-errors'.
+;; * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero.
+;; * Merged `*gentemp-counter*' into `*gensym-counter*'.
+;; * Extended `subseq' to allow negative START and END like `substring'.
+;; * Added `in-ref', `across-ref', `elements of-ref' loop clauses.
+;; * Added `concat', `vconcat' loop clauses.
+;; * Cleaned up a number of compiler warnings.
+
+;; Version 2.01 (7 Jul 93):
+;; * Added support for FSF version of Emacs 19.
+;; * Added `add-hook' for Emacs 18 users.
+;; * Added `defsubst*' and `symbol-macrolet'.
+;; * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'.
+;; * Added `map', `concatenate', `reduce', `merge'.
+;; * Added `revappend', `nreconc', `tailp', `tree-equal'.
+;; * Added `assert', `check-type', `typecase', `typep', and `deftype'.
+;; * Added destructuring and `&environment' support to `defmacro*'.
+;; * Added destructuring to `loop', and added the following clauses:
+;; `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'.
+;; * Renamed `delete' to `delete*' and `remove' to `remove*'.
+;; * Completed support for all keywords in `remove*', `substitute', etc.
+;; * Added `most-positive-float' and company.
+;; * Fixed hash tables to work with latest Lucid Emacs.
+;; * `proclaim' forms are no longer compile-time-evaluating; use `declaim'.
+;; * Syntax for `warn' declarations has changed.
+;; * Improved implementation of `random*'.
+;; * Moved most sequence functions to a new file, cl-seq.el.
+;; * Moved `eval-when' into cl-macs.el.
+;; * Moved `pushnew' and `adjoin' to cl.el for most common cases.
+;; * Moved `provide' forms down to ends of files.
+;; * Changed expansion of `pop' to something that compiles to better code.
+;; * Changed so that no patch is required for Emacs 19 byte compiler.
+;; * Made more things dependent on `optimize' declarations.
+;; * Added a partial implementation of struct print functions.
+;; * Miscellaneous minor changes.
+
+;; Version 2.00:
+;; * First public release of this package.
+
+
+;;; Code:
+
+(require 'macroexp)
+
+(defvar cl-optimize-speed 1)
+(defvar cl-optimize-safety 1)
+
+;;;###autoload
+(define-obsolete-variable-alias
+ ;; This alias is needed for compatibility with .elc files that use defstruct
+ ;; and were compiled with Emacs<24.3.
+ 'custom-print-functions 'cl-custom-print-functions "24.3")
+
+;;;###autoload
+(defvar cl-custom-print-functions nil
+ "This is a list of functions that format user objects for printing.
+Each function is called in turn with three arguments: the object, the
+stream, and the print level (currently ignored). If it is able to
+print the object it returns true; otherwise it returns nil and the
+printer proceeds to the next function on the list.
+
+This variable is not used at present, but it is defined in hopes that
+a future Emacs interpreter will be able to use it.")
+
+(defun cl-unload-function ()
+ "Stop unloading of the Common Lisp extensions."
+ (message "Cannot unload the feature `cl'")
+ ;; Stop standard unloading!
+ t)
+
+;;; Generalized variables.
+;; These macros are defined here so that they
+;; can safely be used in init files.
+
+(defmacro cl-incf (place &optional x)
+ "Increment PLACE by X (1 by default).
+PLACE may be a symbol, or any generalized variable allowed by `setf'.
+The return value is the incremented value of PLACE."
+ (declare (debug (place &optional form)))
+ (if (symbolp place)
+ (list 'setq place (if x (list '+ place x) (list '1+ place)))
+ (list 'cl-callf '+ place (or x 1))))
+
+(defmacro cl-decf (place &optional x)
+ "Decrement PLACE by X (1 by default).
+PLACE may be a symbol, or any generalized variable allowed by `setf'.
+The return value is the decremented value of PLACE."
+ (declare (debug cl-incf))
+ (if (symbolp place)
+ (list 'setq place (if x (list '- place x) (list '1- place)))
+ (list 'cl-callf '- place (or x 1))))
+
+(defmacro cl-pushnew (x place &rest keys)
+ "(cl-pushnew X PLACE): insert X at the head of the list if not already there.
+Like (push X PLACE), except that the list is unmodified if X is `eql' to
+an element already on the list.
+\nKeywords supported: :test :test-not :key
+\n(fn X PLACE [KEYWORD VALUE]...)"
+ (declare (debug
+ (form place &rest
+ &or [[&or ":test" ":test-not" ":key"] function-form]
+ [keywordp form])))
+ (if (symbolp place)
+ (if (null keys)
+ (macroexp-let2 nil var x
+ `(if (memql ,var ,place)
+ ;; This symbol may later on expand to actual code which then
+ ;; trigger warnings like "value unused" since cl-pushnew's
+ ;; return value is rarely used. It should not matter that
+ ;; other warnings may be silenced, since `place' is used
+ ;; earlier and should have triggered them already.
+ (with-no-warnings ,place)
+ (setq ,place (cons ,var ,place))))
+ (list 'setq place (cl-list* 'cl-adjoin x place keys)))
+ (cl-list* 'cl-callf2 'cl-adjoin x place keys)))
+
+(defun cl--set-elt (seq n val)
+ (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
+
+(defun cl--set-buffer-substring (start end val)
+ (save-excursion (delete-region start end)
+ (goto-char start)
+ (insert val)
+ val))
+
+(defun cl--set-substring (str start end val)
+ (if end (if (< end 0) (cl-incf end (length str)))
+ (setq end (length str)))
+ (if (< start 0) (cl-incf start (length str)))
+ (concat (and (> start 0) (substring str 0 start))
+ val
+ (and (< end (length str)) (substring str end))))
+
+
+;;; Blocks and exits.
+
+(defalias 'cl--block-wrapper 'identity)
+(defalias 'cl--block-throw 'throw)
+
+
+;;; Multiple values.
+;; True multiple values are not supported, or even
+;; simulated. Instead, cl-multiple-value-bind and friends simply expect
+;; the target form to return the values as a list.
+
+(defun cl--defalias (cl-f el-f &optional doc)
+ (defalias cl-f el-f doc)
+ (put cl-f 'byte-optimizer 'byte-compile-inline-expand))
+
+(cl--defalias 'cl-values #'list
+ "Return multiple values, Common Lisp style.
+The arguments of `cl-values' are the values
+that the containing function should return.
+
+\(fn &rest VALUES)")
+
+(cl--defalias 'cl-values-list #'identity
+ "Return multiple values, Common Lisp style, taken from a list.
+LIST specifies the list of values
+that the containing function should return.
+
+\(fn LIST)")
+
+(defsubst cl-multiple-value-list (expression)
+ "Return a list of the multiple values produced by EXPRESSION.
+This handles multiple values in Common Lisp style, but it does not
+work right when EXPRESSION calls an ordinary Emacs Lisp function
+that returns just one value."
+ expression)
+
+(defsubst cl-multiple-value-apply (function expression)
+ "Evaluate EXPRESSION to get multiple values and apply FUNCTION to them.
+This handles multiple values in Common Lisp style, but it does not work
+right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
+one value."
+ (apply function expression))
+
+(defalias 'cl-multiple-value-call 'apply
+ "Apply FUNCTION to ARGUMENTS, taking multiple values into account.
+This implementation only handles the case where there is only one argument.")
+
+(cl--defalias 'cl-nth-value #'nth
+ "Evaluate EXPRESSION to get multiple values and return the Nth one.
+This handles multiple values in Common Lisp style, but it does not work
+right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
+one value.
+
+\(fn N EXPRESSION)")
+
+;;; Declarations.
+
+(defvar cl--compiling-file nil)
+(defun cl--compiling-file ()
+ (or cl--compiling-file
+ (and (boundp 'byte-compile--outbuffer)
+ (bufferp (symbol-value 'byte-compile--outbuffer))
+ (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
+ " *Compiler Output*"))))
+
+(defvar cl-proclaims-deferred nil)
+
+(defun cl-proclaim (spec)
+ "Record a global declaration specified by SPEC."
+ (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t)
+ (push spec cl-proclaims-deferred))
+ nil)
+
+(defmacro cl-declaim (&rest specs)
+ "Like `cl-proclaim', but takes any number of unevaluated, unquoted arguments.
+Puts `(cl-eval-when (compile load eval) ...)' around the declarations
+so that they are registered at compile-time as well as run-time."
+ (let ((body (mapcar (function (lambda (x)
+ (list 'cl-proclaim (list 'quote x))))
+ specs)))
+ (if (cl--compiling-file) (cl-list* 'cl-eval-when '(compile load eval) body)
+ (cons 'progn body)))) ; avoid loading cl-macs.el for cl-eval-when
+
+
+;;; Symbols.
+
+(defun cl--random-time ()
+ (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
+ (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i))))
+ v))
+
+(defvar cl--gensym-counter (* (logand (cl--random-time) 1023) 100))
+
+
+;;; Numbers.
+
+(defun cl-floatp-safe (object)
+ "Return t if OBJECT is a floating point number.
+On Emacs versions that lack floating-point support, this function
+always returns nil."
+ (and (numberp object) (not (integerp object))))
+
+(defsubst cl-plusp (number)
+ "Return t if NUMBER is positive."
+ (> number 0))
+
+(defsubst cl-minusp (number)
+ "Return t if NUMBER is negative."
+ (< number 0))
+
+(defun cl-oddp (integer)
+ "Return t if INTEGER is odd."
+ (eq (logand integer 1) 1))
+
+(defun cl-evenp (integer)
+ "Return t if INTEGER is even."
+ (eq (logand integer 1) 0))
+
+(defvar cl--random-state (vector 'cl-random-state-tag -1 30 (cl--random-time)))
+
+(defconst cl-most-positive-float nil
+ "The largest value that a Lisp float can hold.
+If your system supports infinities, this is the largest finite value.
+For IEEE machines, this is approximately 1.79e+308.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-most-negative-float nil
+ "The largest negative value that a Lisp float can hold.
+This is simply -`cl-most-positive-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-least-positive-float nil
+ "The smallest value greater than zero that a Lisp float can hold.
+For IEEE machines, it is about 4.94e-324 if denormals are supported,
+or 2.22e-308 if they are not.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-least-negative-float nil
+ "The smallest value less than zero that a Lisp float can hold.
+This is simply -`cl-least-positive-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-least-positive-normalized-float nil
+ "The smallest normalized Lisp float greater than zero.
+This is the smallest value for which IEEE denormalization does not lose
+precision. For IEEE machines, this value is about 2.22e-308.
+For machines that do not support the concept of denormalization
+and gradual underflow, this constant equals `cl-least-positive-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-least-negative-normalized-float nil
+ "The smallest normalized Lisp float less than zero.
+This is simply -`cl-least-positive-normalized-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-float-epsilon nil
+ "The smallest positive float that adds to 1.0 to give a distinct value.
+Adding a number less than this to 1.0 returns 1.0 due to roundoff.
+For IEEE machines, epsilon is about 2.22e-16.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-float-negative-epsilon nil
+ "The smallest positive float that subtracts from 1.0 to give a distinct value.
+For IEEE machines, it is about 1.11e-16.
+Call `cl-float-limits' to set this.")
+
+
+;;; Sequence functions.
+
+(cl--defalias 'cl-copy-seq 'copy-sequence)
+
+(declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs))
+
+(defun cl-mapcar (cl-func cl-x &rest cl-rest)
+ "Apply FUNCTION to each element of SEQ, and make a list of the results.
+If there are several SEQs, FUNCTION is called with that many arguments,
+and mapping stops as soon as the shortest list runs out. With just one
+SEQ, this is like `mapcar'. With several, it is like the Common Lisp
+`mapcar' function extended to arbitrary sequence types.
+\n(fn FUNCTION SEQ...)"
+ (if cl-rest
+ (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
+ (cl--mapcar-many cl-func (cons cl-x cl-rest))
+ (let ((cl-res nil) (cl-y (car cl-rest)))
+ (while (and cl-x cl-y)
+ (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
+ (nreverse cl-res)))
+ (mapcar cl-func cl-x)))
+
+(cl--defalias 'cl-svref 'aref)
+
+;;; List functions.
+
+(cl--defalias 'cl-first 'car)
+(cl--defalias 'cl-second 'cadr)
+(cl--defalias 'cl-rest 'cdr)
+(cl--defalias 'cl-endp 'null)
+
+(cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.")
+(cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.")
+
+(defsubst cl-fifth (x)
+ "Return the fifth element of the list X."
+ (declare (gv-setter (lambda (store) `(setcar (nthcdr 4 ,x) ,store))))
+ (nth 4 x))
+
+(defsubst cl-sixth (x)
+ "Return the sixth element of the list X."
+ (declare (gv-setter (lambda (store) `(setcar (nthcdr 5 ,x) ,store))))
+ (nth 5 x))
+
+(defsubst cl-seventh (x)
+ "Return the seventh element of the list X."
+ (declare (gv-setter (lambda (store) `(setcar (nthcdr 6 ,x) ,store))))
+ (nth 6 x))
+
+(defsubst cl-eighth (x)
+ "Return the eighth element of the list X."
+ (declare (gv-setter (lambda (store) `(setcar (nthcdr 7 ,x) ,store))))
+ (nth 7 x))
+
+(defsubst cl-ninth (x)
+ "Return the ninth element of the list X."
+ (declare (gv-setter (lambda (store) `(setcar (nthcdr 8 ,x) ,store))))
+ (nth 8 x))
+
+(defsubst cl-tenth (x)
+ "Return the tenth element of the list X."
+ (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store))))
+ (nth 9 x))
+
+(defun cl-caaar (x)
+ "Return the `car' of the `car' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (car (car x))))
+
+(defun cl-caadr (x)
+ "Return the `car' of the `car' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (car (cdr x))))
+
+(defun cl-cadar (x)
+ "Return the `car' of the `cdr' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (cdr (car x))))
+
+(defun cl-caddr (x)
+ "Return the `car' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (cdr (cdr x))))
+
+(defun cl-cdaar (x)
+ "Return the `cdr' of the `car' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (car (car x))))
+
+(defun cl-cdadr (x)
+ "Return the `cdr' of the `car' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (car (cdr x))))
+
+(defun cl-cddar (x)
+ "Return the `cdr' of the `cdr' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (cdr (car x))))
+
+(defun cl-cdddr (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (cdr (cdr x))))
+
+(defun cl-caaaar (x)
+ "Return the `car' of the `car' of the `car' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (car (car (car x)))))
+
+(defun cl-caaadr (x)
+ "Return the `car' of the `car' of the `car' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (car (car (cdr x)))))
+
+(defun cl-caadar (x)
+ "Return the `car' of the `car' of the `cdr' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (car (cdr (car x)))))
+
+(defun cl-caaddr (x)
+ "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (car (cdr (cdr x)))))
+
+(defun cl-cadaar (x)
+ "Return the `car' of the `cdr' of the `car' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (cdr (car (car x)))))
+
+(defun cl-cadadr (x)
+ "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (cdr (car (cdr x)))))
+
+(defun cl-caddar (x)
+ "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (cdr (cdr (car x)))))
+
+(defun cl-cadddr (x)
+ "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (cdr (cdr (cdr x)))))
+
+(defun cl-cdaaar (x)
+ "Return the `cdr' of the `car' of the `car' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (car (car (car x)))))
+
+(defun cl-cdaadr (x)
+ "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (car (car (cdr x)))))
+
+(defun cl-cdadar (x)
+ "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (car (cdr (car x)))))
+
+(defun cl-cdaddr (x)
+ "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (car (cdr (cdr x)))))
+
+(defun cl-cddaar (x)
+ "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (cdr (car (car x)))))
+
+(defun cl-cddadr (x)
+ "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (cdr (car (cdr x)))))
+
+(defun cl-cdddar (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (cdr (cdr (car x)))))
+
+(defun cl-cddddr (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (cdr (cdr (cdr x)))))
+
+;;(defun last* (x &optional n)
+;; "Returns the last link in the list LIST.
+;;With optional argument N, returns Nth-to-last link (default 1)."
+;; (if n
+;; (let ((m 0) (p x))
+;; (while (consp p) (cl-incf m) (pop p))
+;; (if (<= n 0) p
+;; (if (< n m) (nthcdr (- m n) x) x)))
+;; (while (consp (cdr x)) (pop x))
+;; x))
+
+(defun cl-list* (arg &rest rest)
+ "Return a new list with specified ARGs as elements, consed to last ARG.
+Thus, `(cl-list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
+`(cons A (cons B (cons C D)))'.
+\n(fn ARG...)"
+ (declare (compiler-macro cl--compiler-macro-list*))
+ (cond ((not rest) arg)
+ ((not (cdr rest)) (cons arg (car rest)))
+ (t (let* ((n (length rest))
+ (copy (copy-sequence rest))
+ (last (nthcdr (- n 2) copy)))
+ (setcdr last (car (cdr last)))
+ (cons arg copy)))))
+
+(defun cl-ldiff (list sublist)
+ "Return a copy of LIST with the tail SUBLIST removed."
+ (let ((res nil))
+ (while (and (consp list) (not (eq list sublist)))
+ (push (pop list) res))
+ (nreverse res)))
+
+(defun cl-copy-list (list)
+ "Return a copy of LIST, which may be a dotted list.
+The elements of LIST are not copied, just the list structure itself."
+ (if (consp list)
+ (let ((res nil))
+ (while (consp list) (push (pop list) res))
+ (prog1 (nreverse res) (setcdr res list)))
+ (car list)))
+
+;; Autoloaded, but we have not loaded cl-loaddefs yet.
+(declare-function cl-floor "cl-extra" (x &optional y))
+(declare-function cl-ceiling "cl-extra" (x &optional y))
+(declare-function cl-truncate "cl-extra" (x &optional y))
+(declare-function cl-round "cl-extra" (x &optional y))
+(declare-function cl-mod "cl-extra" (x y))
+
+(defun cl-adjoin (cl-item cl-list &rest cl-keys)
+ "Return ITEM consed onto the front of LIST only if it's not already there.
+Otherwise, return LIST unmodified.
+\nKeywords supported: :test :test-not :key
+\n(fn ITEM LIST [KEYWORD VALUE]...)"
+ (declare (compiler-macro cl--compiler-macro-adjoin))
+ (cond ((or (equal cl-keys '(:test eq))
+ (and (null cl-keys) (not (numberp cl-item))))
+ (if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
+ ((or (equal cl-keys '(:test equal)) (null cl-keys))
+ (if (member cl-item cl-list) cl-list (cons cl-item cl-list)))
+ (t (apply 'cl--adjoin cl-item cl-list cl-keys))))
+
+(defun cl-subst (cl-new cl-old cl-tree &rest cl-keys)
+ "Substitute NEW for OLD everywhere in TREE (non-destructively).
+Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
+\nKeywords supported: :test :test-not :key
+\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
+ (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old))))
+ (apply 'cl-sublis (list (cons cl-old cl-new)) cl-tree cl-keys)
+ (cl--do-subst cl-new cl-old cl-tree)))
+
+(defun cl--do-subst (cl-new cl-old cl-tree)
+ (cond ((eq cl-tree cl-old) cl-new)
+ ((consp cl-tree)
+ (let ((a (cl--do-subst cl-new cl-old (car cl-tree)))
+ (d (cl--do-subst cl-new cl-old (cdr cl-tree))))
+ (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree)))
+ cl-tree (cons a d))))
+ (t cl-tree)))
+
+(defun cl-acons (key value alist)
+ "Add KEY and VALUE to ALIST.
+Return a new list with (cons KEY VALUE) as car and ALIST as cdr."
+ (cons (cons key value) alist))
+
+(defun cl-pairlis (keys values &optional alist)
+ "Make an alist from KEYS and VALUES.
+Return a new alist composed by associating KEYS to corresponding VALUES;
+the process stops as soon as KEYS or VALUES run out.
+If ALIST is non-nil, the new pairs are prepended to it."
+ (nconc (cl-mapcar 'cons keys values) alist))
+
+
+;;; Generalized variables.
+
+;; These used to be in cl-macs.el since all macros that use them (like setf)
+;; were autoloaded from cl-macs.el. But now that setf, push, and pop are in
+;; core Elisp, they need to either be right here or be autoloaded via
+;; cl-loaddefs.el, which is more trouble than it is worth.
+
+;; Some more Emacs-related place types.
+(gv-define-simple-setter buffer-file-name set-visited-file-name t)
+(gv-define-setter buffer-modified-p (flag &optional buf)
+ `(with-current-buffer ,buf
+ (set-buffer-modified-p ,flag)))
+(gv-define-simple-setter buffer-name rename-buffer t)
+(gv-define-setter buffer-string (store)
+ `(insert (prog1 ,store (erase-buffer))))
+(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
+(gv-define-simple-setter current-buffer set-buffer)
+(gv-define-simple-setter current-case-table set-case-table)
+(gv-define-simple-setter current-column move-to-column t)
+(gv-define-simple-setter current-global-map use-global-map t)
+(gv-define-setter current-input-mode (store)
+ `(progn (apply #'set-input-mode ,store) ,store))
+(gv-define-simple-setter current-local-map use-local-map t)
+(gv-define-simple-setter current-window-configuration
+ set-window-configuration t)
+(gv-define-simple-setter default-file-modes set-default-file-modes t)
+(gv-define-simple-setter documentation-property put)
+(gv-define-setter face-background (x f &optional s)
+ `(set-face-background ,f ,x ,s))
+(gv-define-setter face-background-pixmap (x f &optional s)
+ `(set-face-background-pixmap ,f ,x ,s))
+(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s))
+(gv-define-setter face-foreground (x f &optional s)
+ `(set-face-foreground ,f ,x ,s))
+(gv-define-setter face-underline-p (x f &optional s)
+ `(set-face-underline ,f ,x ,s))
+(gv-define-simple-setter file-modes set-file-modes t)
+(gv-define-simple-setter frame-height set-screen-height t)
+(gv-define-simple-setter frame-parameters modify-frame-parameters t)
+(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p)
+(gv-define-simple-setter frame-width set-screen-width t)
+(gv-define-simple-setter getenv setenv t)
+(gv-define-simple-setter get-register set-register)
+(gv-define-simple-setter global-key-binding global-set-key)
+(gv-define-simple-setter local-key-binding local-set-key)
+(gv-define-simple-setter mark set-mark t)
+(gv-define-simple-setter mark-marker set-mark t)
+(gv-define-simple-setter marker-position set-marker t)
+(gv-define-setter mouse-position (store scr)
+ `(set-mouse-position ,scr (car ,store) (cadr ,store)
+ (cddr ,store)))
+(gv-define-simple-setter point goto-char)
+(gv-define-simple-setter point-marker goto-char t)
+(gv-define-setter point-max (store)
+ `(progn (narrow-to-region (point-min) ,store) ,store))
+(gv-define-setter point-min (store)
+ `(progn (narrow-to-region ,store (point-max)) ,store))
+(gv-define-setter read-mouse-position (store scr)
+ `(set-mouse-position ,scr (car ,store) (cdr ,store)))
+(gv-define-simple-setter screen-height set-screen-height t)
+(gv-define-simple-setter screen-width set-screen-width t)
+(gv-define-simple-setter selected-window select-window)
+(gv-define-simple-setter selected-screen select-screen)
+(gv-define-simple-setter selected-frame select-frame)
+(gv-define-simple-setter standard-case-table set-standard-case-table)
+(gv-define-simple-setter syntax-table set-syntax-table)
+(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t)
+(gv-define-setter window-height (store)
+ `(progn (enlarge-window (- ,store (window-height))) ,store))
+(gv-define-setter window-width (store)
+ `(progn (enlarge-window (- ,store (window-width)) t) ,store))
+(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
+(gv-define-simple-setter x-get-selection x-own-selection t)
+
+;; More complex setf-methods.
+
+;; This is a hack that allows (setf (eq a 7) B) to mean either
+;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
+;; This is useful when you have control over the PLACE but not over
+;; the VALUE, as is the case in define-minor-mode's :variable.
+;; It turned out that :variable needed more flexibility anyway, so
+;; this doesn't seem too useful now.
+(gv-define-expander eq
+ (lambda (do place val)
+ (gv-letplace (getter setter) place
+ (macroexp-let2 nil val val
+ (funcall do `(eq ,getter ,val)
+ (lambda (v)
+ `(cond
+ (,v ,(funcall setter val))
+ ((eq ,getter ,val) ,(funcall setter `(not ,val))))))))))
+
+(gv-define-expander substring
+ (lambda (do place from &optional to)
+ (gv-letplace (getter setter) place
+ (macroexp-let2 nil start from
+ (macroexp-let2 nil end to
+ (funcall do `(substring ,getter ,start ,end)
+ (lambda (v)
+ (funcall setter `(cl--set-substring
+ ,getter ,start ,end ,v)))))))))
+
+;;; Miscellaneous.
+
+;;;###autoload
+(progn
+ ;; Make sure functions defined with cl-defsubst can be inlined even in
+ ;; packages which do not require CL. We don't put an autoload cookie
+ ;; directly on that function, since those cookies only go to cl-loaddefs.
+ (autoload 'cl--defsubst-expand "cl-macs")
+ ;; Autoload, so autoload.el and font-lock can use it even when CL
+ ;; is not loaded.
+ (put 'cl-defun 'doc-string-elt 3)
+ (put 'cl-defmacro 'doc-string-elt 3)
+ (put 'cl-defsubst 'doc-string-elt 3)
+ (put 'cl-defstruct 'doc-string-elt 2))
+
+(load "cl-loaddefs" nil 'quiet)
+
+(provide 'cl-lib)
+
+(run-hooks 'cl-load-hook)
+
+;; Local variables:
+;; byte-compile-dynamic: t
+;; End:
+
+;;; cl-lib.el ends here
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index 1cd953d9e18..69882e36f22 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -3,23 +3,24 @@
;;; Code:
-;;;### (autoloads (cl-prettyexpand cl-macroexpand-all cl-remprop
-;;;;;; cl-do-remf cl-set-getf getf get* tailp list-length nreconc
-;;;;;; revappend concatenate subseq cl-float-limits random-state-p
-;;;;;; make-random-state random* signum rem* mod* round* truncate*
-;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p
-;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively
-;;;;;; notevery notany every some mapcon mapcan mapl maplist map
-;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "15a5e127e1c9c9c3d1f398963b66cde7")
+;;;### (autoloads (cl-prettyexpand cl-remprop cl--do-remf cl--set-getf
+;;;;;; cl-getf cl-get cl-tailp cl-list-length cl-nreconc cl-revappend
+;;;;;; cl-concatenate cl-subseq cl-float-limits cl-random-state-p
+;;;;;; cl-make-random-state cl-random cl-signum cl-rem cl-mod cl-round
+;;;;;; cl-truncate cl-ceiling cl-floor cl-isqrt cl-lcm cl-gcd cl--set-frame-visible-p
+;;;;;; 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-mapc cl-maplist cl-map cl--mapcar-many cl-equalp
+;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "8e9fee941c465ac0fee9b92a92d64154")
;;; Generated autoloads from cl-extra.el
-(autoload 'coerce "cl-extra" "\
+(autoload 'cl-coerce "cl-extra" "\
Coerce OBJECT to type TYPE.
TYPE is a Common Lisp type specifier.
\(fn OBJECT TYPE)" nil nil)
-(autoload 'equalp "cl-extra" "\
+(autoload 'cl-equalp "cl-extra" "\
Return t if two Lisp objects have similar structures and contents.
This is like `equal', except that it accepts numerically equal
numbers of different types (float vs. integer), and also compares
@@ -27,216 +28,216 @@ strings case-insensitively.
\(fn X Y)" nil nil)
-(autoload 'cl-mapcar-many "cl-extra" "\
+(autoload 'cl--mapcar-many "cl-extra" "\
\(fn CL-FUNC CL-SEQS)" nil nil)
-(autoload 'map "cl-extra" "\
+(autoload 'cl-map "cl-extra" "\
Map a FUNCTION across one or more SEQUENCEs, returning a sequence.
TYPE is the sequence type to return.
\(fn TYPE FUNCTION SEQUENCE...)" nil nil)
-(autoload 'maplist "cl-extra" "\
+(autoload 'cl-maplist "cl-extra" "\
Map FUNCTION to each sublist of LIST or LISTs.
-Like `mapcar', except applies to lists and their cdr's rather than to
+Like `cl-mapcar', except applies to lists and their cdr's rather than to
the elements themselves.
\(fn FUNCTION LIST...)" nil nil)
-(autoload 'mapl "cl-extra" "\
-Like `maplist', but does not accumulate values returned by the function.
+(autoload 'cl-mapc "cl-extra" "\
+Like `cl-mapcar', but does not accumulate values returned by the function.
+
+\(fn FUNCTION SEQUENCE...)" nil nil)
+
+(autoload 'cl-mapl "cl-extra" "\
+Like `cl-maplist', but does not accumulate values returned by the function.
\(fn FUNCTION LIST...)" nil nil)
-(autoload 'mapcan "cl-extra" "\
-Like `mapcar', but nconc's together the values returned by the function.
+(autoload 'cl-mapcan "cl-extra" "\
+Like `cl-mapcar', but nconc's together the values returned by the function.
\(fn FUNCTION SEQUENCE...)" nil nil)
-(autoload 'mapcon "cl-extra" "\
-Like `maplist', but nconc's together the values returned by the function.
+(autoload 'cl-mapcon "cl-extra" "\
+Like `cl-maplist', but nconc's together the values returned by the function.
\(fn FUNCTION LIST...)" nil nil)
-(autoload 'some "cl-extra" "\
+(autoload 'cl-some "cl-extra" "\
Return true if PREDICATE is true of any element of SEQ or SEQs.
If so, return the true (non-nil) value returned by PREDICATE.
\(fn PREDICATE SEQ...)" nil nil)
-(autoload 'every "cl-extra" "\
+(autoload 'cl-every "cl-extra" "\
Return true if PREDICATE is true of every element of SEQ or SEQs.
\(fn PREDICATE SEQ...)" nil nil)
-(autoload 'notany "cl-extra" "\
+(autoload 'cl-notany "cl-extra" "\
Return true if PREDICATE is false of every element of SEQ or SEQs.
\(fn PREDICATE SEQ...)" nil nil)
-(autoload 'notevery "cl-extra" "\
+(autoload 'cl-notevery "cl-extra" "\
Return true if PREDICATE is false of some element of SEQ or SEQs.
\(fn PREDICATE SEQ...)" nil nil)
-(defalias 'cl-map-keymap 'map-keymap)
-
-(autoload 'cl-map-keymap-recursively "cl-extra" "\
+(autoload 'cl--map-keymap-recursively "cl-extra" "\
\(fn CL-FUNC-REC CL-MAP &optional CL-BASE)" nil nil)
-(autoload 'cl-map-intervals "cl-extra" "\
+(autoload 'cl--map-intervals "cl-extra" "\
\(fn CL-FUNC &optional CL-WHAT CL-PROP CL-START CL-END)" nil nil)
-(autoload 'cl-map-overlays "cl-extra" "\
+(autoload 'cl--map-overlays "cl-extra" "\
\(fn CL-FUNC &optional CL-BUFFER CL-START CL-END CL-ARG)" nil nil)
-(autoload 'cl-set-frame-visible-p "cl-extra" "\
+(autoload 'cl--set-frame-visible-p "cl-extra" "\
\(fn FRAME VAL)" nil nil)
-(autoload 'cl-progv-before "cl-extra" "\
-
-
-\(fn SYMS VALUES)" nil nil)
-
-(autoload 'gcd "cl-extra" "\
+(autoload 'cl-gcd "cl-extra" "\
Return the greatest common divisor of the arguments.
\(fn &rest ARGS)" nil nil)
-(autoload 'lcm "cl-extra" "\
+(autoload 'cl-lcm "cl-extra" "\
Return the least common multiple of the arguments.
\(fn &rest ARGS)" nil nil)
-(autoload 'isqrt "cl-extra" "\
+(autoload 'cl-isqrt "cl-extra" "\
Return the integer square root of the argument.
\(fn X)" nil nil)
-(autoload 'floor* "cl-extra" "\
+(autoload 'cl-floor "cl-extra" "\
Return a list of the floor of X and the fractional part of X.
With two arguments, return floor and remainder of their quotient.
\(fn X &optional Y)" nil nil)
-(autoload 'ceiling* "cl-extra" "\
+(autoload 'cl-ceiling "cl-extra" "\
Return a list of the ceiling of X and the fractional part of X.
With two arguments, return ceiling and remainder of their quotient.
\(fn X &optional Y)" nil nil)
-(autoload 'truncate* "cl-extra" "\
+(autoload 'cl-truncate "cl-extra" "\
Return a list of the integer part of X and the fractional part of X.
With two arguments, return truncation and remainder of their quotient.
\(fn X &optional Y)" nil nil)
-(autoload 'round* "cl-extra" "\
+(autoload 'cl-round "cl-extra" "\
Return a list of X rounded to the nearest integer and the remainder.
With two arguments, return rounding and remainder of their quotient.
\(fn X &optional Y)" nil nil)
-(autoload 'mod* "cl-extra" "\
+(autoload 'cl-mod "cl-extra" "\
The remainder of X divided by Y, with the same sign as Y.
\(fn X Y)" nil nil)
-(autoload 'rem* "cl-extra" "\
+(autoload 'cl-rem "cl-extra" "\
The remainder of X divided by Y, with the same sign as X.
\(fn X Y)" nil nil)
-(autoload 'signum "cl-extra" "\
+(autoload 'cl-signum "cl-extra" "\
Return 1 if X is positive, -1 if negative, 0 if zero.
\(fn X)" nil nil)
-(autoload 'random* "cl-extra" "\
+(autoload 'cl-random "cl-extra" "\
Return a random nonnegative number less than LIM, an integer or float.
Optional second arg STATE is a random-state object.
\(fn LIM &optional STATE)" nil nil)
-(autoload 'make-random-state "cl-extra" "\
-Return a copy of random-state STATE, or of `*random-state*' if omitted.
+(autoload 'cl-make-random-state "cl-extra" "\
+Return a copy of random-state STATE, or of the internal state if omitted.
If STATE is t, return a new state object seeded from the time of day.
\(fn &optional STATE)" nil nil)
-(autoload 'random-state-p "cl-extra" "\
+(autoload 'cl-random-state-p "cl-extra" "\
Return t if OBJECT is a random-state object.
\(fn OBJECT)" nil nil)
(autoload 'cl-float-limits "cl-extra" "\
Initialize the Common Lisp floating-point parameters.
-This sets the values of: `most-positive-float', `most-negative-float',
-`least-positive-float', `least-negative-float', `float-epsilon',
-`float-negative-epsilon', `least-positive-normalized-float', and
-`least-negative-normalized-float'.
+This sets the values of: `cl-most-positive-float', `cl-most-negative-float',
+`cl-least-positive-float', `cl-least-negative-float', `cl-float-epsilon',
+`cl-float-negative-epsilon', `cl-least-positive-normalized-float', and
+`cl-least-negative-normalized-float'.
\(fn)" nil nil)
-(autoload 'subseq "cl-extra" "\
+(autoload 'cl-subseq "cl-extra" "\
Return the subsequence of SEQ from START to END.
If END is omitted, it defaults to the length of the sequence.
If START or END is negative, it counts from the end.
\(fn SEQ START &optional END)" nil nil)
-(autoload 'concatenate "cl-extra" "\
+(autoload 'cl-concatenate "cl-extra" "\
Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
\(fn TYPE SEQUENCE...)" nil nil)
-(autoload 'revappend "cl-extra" "\
+(autoload 'cl-revappend "cl-extra" "\
Equivalent to (append (reverse X) Y).
\(fn X Y)" nil nil)
-(autoload 'nreconc "cl-extra" "\
+(autoload 'cl-nreconc "cl-extra" "\
Equivalent to (nconc (nreverse X) Y).
\(fn X Y)" nil nil)
-(autoload 'list-length "cl-extra" "\
+(autoload 'cl-list-length "cl-extra" "\
Return the length of list X. Return nil if list is circular.
\(fn X)" nil nil)
-(autoload 'tailp "cl-extra" "\
+(autoload 'cl-tailp "cl-extra" "\
Return true if SUBLIST is a tail of LIST.
\(fn SUBLIST LIST)" nil nil)
-(autoload 'get* "cl-extra" "\
+(autoload 'cl-get "cl-extra" "\
Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
\(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil)
-(autoload 'getf "cl-extra" "\
+(put 'cl-get 'compiler-macro #'cl--compiler-macro-get)
+
+(autoload 'cl-getf "cl-extra" "\
Search PROPLIST for property PROPNAME; return its value or DEFAULT.
PROPLIST is a list of the sort returned by `symbol-plist'.
\(fn PROPLIST PROPNAME &optional DEFAULT)" nil nil)
-(autoload 'cl-set-getf "cl-extra" "\
+(autoload 'cl--set-getf "cl-extra" "\
\(fn PLIST TAG VAL)" nil nil)
-(autoload 'cl-do-remf "cl-extra" "\
+(autoload 'cl--do-remf "cl-extra" "\
\(fn PLIST TAG)" nil nil)
@@ -246,136 +247,146 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
\(fn SYMBOL PROPNAME)" nil nil)
-(defalias 'remprop 'cl-remprop)
-
-(defalias 'cl-gethash 'gethash)
-
-(defalias 'cl-puthash 'puthash)
-
-(defalias 'cl-remhash 'remhash)
-
-(defalias 'cl-clrhash 'clrhash)
-
-(defalias 'cl-maphash 'maphash)
+(autoload 'cl-prettyexpand "cl-extra" "\
+Expand macros in FORM and insert the pretty-printed result.
+Optional argument FULL non-nil means to expand all macros,
+including `cl-block' and `cl-eval-when'.
-(defalias 'cl-make-hash-table 'make-hash-table)
+\(fn FORM &optional FULL)" nil nil)
-(defalias 'cl-hash-table-p 'hash-table-p)
+;;;***
+
+;;;### (autoloads (cl--compiler-macro-adjoin cl-defsubst cl-compiler-macroexpand
+;;;;;; cl-define-compiler-macro cl-assert cl-check-type cl-typep
+;;;;;; cl-deftype cl-defstruct cl-callf2 cl-callf cl-letf* cl-letf
+;;;;;; cl-rotatef cl-shiftf cl-remf cl-psetf cl-declare cl-the cl-locally
+;;;;;; cl-multiple-value-setq cl-multiple-value-bind cl-symbol-macrolet
+;;;;;; cl-macrolet cl-labels cl-flet* cl-flet cl-progv cl-psetq
+;;;;;; cl-do-all-symbols cl-do-symbols cl-dotimes cl-dolist cl-do*
+;;;;;; cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase
+;;;;;; 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" "a7d9b56ea588b869813de8ed7ec1fbcd")
+;;; Generated autoloads from cl-macs.el
-(defalias 'cl-hash-table-count 'hash-table-count)
+(autoload 'cl--compiler-macro-list* "cl-macs" "\
-(autoload 'cl-macroexpand-all "cl-extra" "\
-Expand all macro calls through a Lisp FORM.
-This also does some trivial optimizations to make the form prettier.
-\(fn FORM &optional ENV)" nil nil)
+\(fn FORM ARG &rest OTHERS)" nil nil)
-(autoload 'cl-prettyexpand "cl-extra" "\
+(autoload 'cl--compiler-macro-cXXr "cl-macs" "\
-\(fn FORM &optional FULL)" nil nil)
+\(fn FORM X)" nil nil)
-;;;***
-
-;;;### (autoloads (defsubst* compiler-macroexpand define-compiler-macro
-;;;;;; assert check-type typep deftype cl-struct-setf-expander defstruct
-;;;;;; define-modify-macro callf2 callf letf* letf rotatef shiftf
-;;;;;; remf cl-do-pop psetf setf get-setf-method defsetf define-setf-method
-;;;;;; declare the locally multiple-value-setq multiple-value-bind
-;;;;;; lexical-let* lexical-let symbol-macrolet macrolet labels
-;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist
-;;;;;; do* do loop return-from return block etypecase typecase ecase
-;;;;;; case load-time-value eval-when destructuring-bind function*
-;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "cc8cbd8c86e2facbe61986e992e6c508")
-;;; Generated autoloads from cl-macs.el
-
-(autoload 'gensym "cl-macs" "\
+(autoload 'cl-gensym "cl-macs" "\
Generate a new uninterned symbol.
The name is made by appending a number to PREFIX, default \"G\".
\(fn &optional PREFIX)" nil nil)
-(autoload 'gentemp "cl-macs" "\
+(autoload 'cl-gentemp "cl-macs" "\
Generate a new interned symbol with a unique name.
The name is made by appending a number to PREFIX, default \"G\".
\(fn &optional PREFIX)" nil nil)
-(autoload 'defun* "cl-macs" "\
+(autoload 'cl-defun "cl-macs" "\
Define NAME as a function.
Like normal `defun', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...).
+and BODY is implicitly surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t)
-\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro))
+(put 'cl-defun 'doc-string-elt '3)
-(autoload 'defmacro* "cl-macs" "\
+(put 'cl-defun 'lisp-indent-function '2)
+
+(autoload 'cl-defmacro "cl-macs" "\
Define NAME as a macro.
Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...).
+and BODY is implicitly surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t)
+
+(put 'cl-defmacro 'doc-string-elt '3)
-\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro))
+(put 'cl-defmacro 'lisp-indent-function '2)
-(autoload 'function* "cl-macs" "\
+(autoload 'cl-function "cl-macs" "\
Introduce a function.
Like normal `function', except that if argument is a lambda form,
its argument list allows full Common Lisp conventions.
-\(fn FUNC)" nil (quote macro))
+\(fn FUNC)" nil t)
-(autoload 'destructuring-bind "cl-macs" "\
+(autoload 'cl-destructuring-bind "cl-macs" "\
+Bind the variables in ARGS to the result of EXPR and execute BODY.
+\(fn ARGS EXPR &rest BODY)" nil t)
-\(fn ARGS EXPR &rest BODY)" nil (quote macro))
+(put 'cl-destructuring-bind 'lisp-indent-function '2)
-(autoload 'eval-when "cl-macs" "\
+(autoload 'cl-eval-when "cl-macs" "\
Control when BODY is evaluated.
If `compile' is in WHEN, BODY is evaluated when compiled at top-level.
If `load' is in WHEN, BODY is evaluated when loaded after top-level compile.
If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
-\(fn (WHEN...) BODY...)" nil (quote macro))
+\(fn (WHEN...) BODY...)" nil t)
-(autoload 'load-time-value "cl-macs" "\
+(put 'cl-eval-when 'lisp-indent-function '1)
+
+(autoload 'cl-load-time-value "cl-macs" "\
Like `progn', but evaluates the body at load time.
The result of the body appears to the compiler as a quoted constant.
-\(fn FORM &optional READ-ONLY)" nil (quote macro))
+\(fn FORM &optional READ-ONLY)" nil t)
-(autoload 'case "cl-macs" "\
+(autoload 'cl-case "cl-macs" "\
Eval EXPR and choose among clauses on that value.
Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared
against each key in each KEYLIST; the corresponding BODY is evaluated.
-If no clause succeeds, case returns nil. A single atom may be used in
+If no clause succeeds, cl-case returns nil. A single atom may be used in
place of a KEYLIST of one atom. A KEYLIST of t or `otherwise' is
allowed only in the final clause, and matches if no other keys match.
Key values are compared by `eql'.
-\(fn EXPR (KEYLIST BODY...)...)" nil (quote macro))
+\(fn EXPR (KEYLIST BODY...)...)" nil t)
+
+(put 'cl-case 'lisp-indent-function '1)
-(autoload 'ecase "cl-macs" "\
-Like `case', but error if no case fits.
+(autoload 'cl-ecase "cl-macs" "\
+Like `cl-case', but error if no case fits.
`otherwise'-clauses are not allowed.
-\(fn EXPR (KEYLIST BODY...)...)" nil (quote macro))
+\(fn EXPR (KEYLIST BODY...)...)" nil t)
+
+(put 'cl-ecase 'lisp-indent-function '1)
-(autoload 'typecase "cl-macs" "\
+(autoload 'cl-typecase "cl-macs" "\
Evals EXPR, chooses among clauses on that value.
Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it
satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds,
-typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
+cl-typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
final clause, and matches if no other keys match.
-\(fn EXPR (TYPE BODY...)...)" nil (quote macro))
+\(fn EXPR (TYPE BODY...)...)" nil t)
-(autoload 'etypecase "cl-macs" "\
-Like `typecase', but error if no case fits.
+(put 'cl-typecase 'lisp-indent-function '1)
+
+(autoload 'cl-etypecase "cl-macs" "\
+Like `cl-typecase', but error if no case fits.
`otherwise'-clauses are not allowed.
-\(fn EXPR (TYPE BODY...)...)" nil (quote macro))
+\(fn EXPR (TYPE BODY...)...)" nil t)
+
+(put 'cl-etypecase 'lisp-indent-function '1)
-(autoload 'block "cl-macs" "\
+(autoload 'cl-block "cl-macs" "\
Define a lexically-scoped block named NAME.
-NAME may be any symbol. Code inside the BODY forms can call `return-from'
+NAME may be any symbol. Code inside the BODY forms can call `cl-return-from'
to jump prematurely out of the block. This differs from `catch' and `throw'
in two respects: First, the NAME is an unevaluated symbol rather than a
quoted symbol or other form; and second, NAME is lexically rather than
@@ -383,24 +394,28 @@ dynamically scoped: Only references to it within BODY will work. These
references may appear inside macro expansions, but not inside functions
called from BODY.
-\(fn NAME &rest BODY)" nil (quote macro))
+\(fn NAME &rest BODY)" nil t)
-(autoload 'return "cl-macs" "\
+(put 'cl-block 'lisp-indent-function '1)
+
+(autoload 'cl-return "cl-macs" "\
Return from the block named nil.
-This is equivalent to `(return-from nil RESULT)'.
+This is equivalent to `(cl-return-from nil RESULT)'.
-\(fn &optional RESULT)" nil (quote macro))
+\(fn &optional RESULT)" nil t)
-(autoload 'return-from "cl-macs" "\
+(autoload 'cl-return-from "cl-macs" "\
Return from the block named NAME.
-This jumps out to the innermost enclosing `(block NAME ...)' form,
+This jumps out to the innermost enclosing `(cl-block NAME ...)' form,
returning RESULT from that form (or nil if RESULT is omitted).
This is compatible with Common Lisp, but note that `defun' and
`defmacro' do not create implicit blocks as they do in Common Lisp.
-\(fn NAME &optional RESULT)" nil (quote macro))
+\(fn NAME &optional RESULT)" nil t)
+
+(put 'cl-return-from 'lisp-indent-function '1)
-(autoload 'loop "cl-macs" "\
+(autoload 'cl-loop "cl-macs" "\
The Common Lisp `loop' macro.
Valid clauses are:
for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
@@ -414,230 +429,194 @@ Valid clauses are:
do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR,
finally return EXPR, named NAME.
-\(fn CLAUSE...)" nil (quote macro))
+\(fn CLAUSE...)" nil t)
-(autoload 'do "cl-macs" "\
+(autoload 'cl-do "cl-macs" "\
The Common Lisp `do' loop.
-\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro))
+\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t)
+
+(put 'cl-do 'lisp-indent-function '2)
-(autoload 'do* "cl-macs" "\
+(autoload 'cl-do* "cl-macs" "\
The Common Lisp `do*' loop.
-\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro))
+\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t)
-(autoload 'dolist "cl-macs" "\
+(put 'cl-do* 'lisp-indent-function '2)
+
+(autoload 'cl-dolist "cl-macs" "\
Loop over a list.
Evaluate BODY with VAR bound to each `car' from LIST, in turn.
Then evaluate RESULT to get return value, default nil.
An implicit nil block is established around the loop.
-\(fn (VAR LIST [RESULT]) BODY...)" nil (quote macro))
+\(fn (VAR LIST [RESULT]) BODY...)" nil t)
+
+(put 'cl-dolist 'lisp-indent-function '1)
-(autoload 'dotimes "cl-macs" "\
+(autoload 'cl-dotimes "cl-macs" "\
Loop a certain number of times.
Evaluate BODY with VAR bound to successive integers from 0, inclusive,
to COUNT, exclusive. Then evaluate RESULT to get return value, default
nil.
-\(fn (VAR COUNT [RESULT]) BODY...)" nil (quote macro))
+\(fn (VAR COUNT [RESULT]) BODY...)" nil t)
-(autoload 'do-symbols "cl-macs" "\
+(put 'cl-dotimes 'lisp-indent-function '1)
+
+(autoload 'cl-do-symbols "cl-macs" "\
Loop over all symbols.
Evaluate BODY with VAR bound to each interned symbol, or to each symbol
from OBARRAY.
-\(fn (VAR [OBARRAY [RESULT]]) BODY...)" nil (quote macro))
+\(fn (VAR [OBARRAY [RESULT]]) BODY...)" nil t)
+
+(put 'cl-do-symbols 'lisp-indent-function '1)
-(autoload 'do-all-symbols "cl-macs" "\
+(autoload 'cl-do-all-symbols "cl-macs" "\
+Like `cl-do-symbols', but use the default obarray.
+\(fn (VAR [RESULT]) BODY...)" nil t)
-\(fn SPEC &rest BODY)" nil (quote macro))
+(put 'cl-do-all-symbols 'lisp-indent-function '1)
-(autoload 'psetq "cl-macs" "\
+(autoload 'cl-psetq "cl-macs" "\
Set SYMs to the values VALs in parallel.
This is like `setq', except that all VAL forms are evaluated (in order)
before assigning any symbols SYM to the corresponding values.
-\(fn SYM VAL SYM VAL ...)" nil (quote macro))
+\(fn SYM VAL SYM VAL ...)" nil t)
-(autoload 'progv "cl-macs" "\
+(autoload 'cl-progv "cl-macs" "\
Bind SYMBOLS to VALUES dynamically in BODY.
The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists.
Each symbol in the first list is bound to the corresponding value in the
-second list (or made unbound if VALUES is shorter than SYMBOLS); then the
+second list (or to nil if VALUES is shorter than SYMBOLS); then the
BODY forms are executed and their result is returned. This is much like
a `let' form, except that the list of symbols can be computed at run-time.
-\(fn SYMBOLS VALUES &rest BODY)" nil (quote macro))
+\(fn SYMBOLS VALUES &rest BODY)" nil t)
+
+(put 'cl-progv 'lisp-indent-function '2)
+
+(autoload 'cl-flet "cl-macs" "\
+Make local function definitions.
+Like `cl-labels' but the definitions are not recursive.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
-(autoload 'flet "cl-macs" "\
-Make temporary function definitions.
-This is an analogue of `let' that operates on the function cell of FUNC
-rather than its value cell. The FORMs are evaluated with the specified
-function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof).
+(put 'cl-flet 'lisp-indent-function '1)
-\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro))
+(autoload 'cl-flet* "cl-macs" "\
+Make local function definitions.
+Like `cl-flet' but the definitions can refer to previous ones.
-(autoload 'labels "cl-macs" "\
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
+
+(put 'cl-flet* 'lisp-indent-function '1)
+
+(autoload 'cl-labels "cl-macs" "\
Make temporary function bindings.
-This is like `flet', except the bindings are lexical instead of dynamic.
-Unlike `flet', this macro is fully compliant with the Common Lisp standard.
+The bindings can be recursive and the scoping is lexical, but capturing them
+in closures will only work if `lexical-binding' is in use.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
-\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro))
+(put 'cl-labels 'lisp-indent-function '1)
-(autoload 'macrolet "cl-macs" "\
+(autoload 'cl-macrolet "cl-macs" "\
Make temporary macro definitions.
-This is like `flet', but for macros instead of functions.
+This is like `cl-flet', but for macros instead of functions.
-\(fn ((NAME ARGLIST BODY...) ...) FORM...)" nil (quote macro))
+\(fn ((NAME ARGLIST BODY...) ...) FORM...)" nil t)
-(autoload 'symbol-macrolet "cl-macs" "\
+(put 'cl-macrolet 'lisp-indent-function '1)
+
+(autoload 'cl-symbol-macrolet "cl-macs" "\
Make symbol macro definitions.
Within the body FORMs, references to the variable NAME will be replaced
by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
-\(fn ((NAME EXPANSION) ...) FORM...)" nil (quote macro))
-
-(autoload 'lexical-let "cl-macs" "\
-Like `let', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp.
-
-\(fn BINDINGS BODY)" nil (quote macro))
+\(fn ((NAME EXPANSION) ...) FORM...)" nil t)
-(autoload 'lexical-let* "cl-macs" "\
-Like `let*', but lexically scoped.
-The main visible difference is that lambdas inside BODY, and in
-successive bindings within BINDINGS, will create lexical closures
-as in Common Lisp. This is similar to the behavior of `let*' in
-Common Lisp.
+(put 'cl-symbol-macrolet 'lisp-indent-function '1)
-\(fn BINDINGS BODY)" nil (quote macro))
-
-(autoload 'multiple-value-bind "cl-macs" "\
+(autoload 'cl-multiple-value-bind "cl-macs" "\
Collect multiple return values.
FORM must return a list; the BODY is then executed with the first N elements
of this list bound (`let'-style) to each of the symbols SYM in turn. This
-is analogous to the Common Lisp `multiple-value-bind' macro, using lists to
-simulate true multiple return values. For compatibility, (values A B C) is
+is analogous to the Common Lisp `cl-multiple-value-bind' macro, using lists to
+simulate true multiple return values. For compatibility, (cl-values A B C) is
a synonym for (list A B C).
-\(fn (SYM...) FORM BODY)" nil (quote macro))
+\(fn (SYM...) FORM BODY)" nil t)
+
+(put 'cl-multiple-value-bind 'lisp-indent-function '2)
-(autoload 'multiple-value-setq "cl-macs" "\
+(autoload 'cl-multiple-value-setq "cl-macs" "\
Collect multiple return values.
FORM must return a list; the first N elements of this list are stored in
each of the symbols SYM in turn. This is analogous to the Common Lisp
-`multiple-value-setq' macro, using lists to simulate true multiple return
-values. For compatibility, (values A B C) is a synonym for (list A B C).
+`cl-multiple-value-setq' macro, using lists to simulate true multiple return
+values. For compatibility, (cl-values A B C) is a synonym for (list A B C).
-\(fn (SYM...) FORM)" nil (quote macro))
+\(fn (SYM...) FORM)" nil t)
-(autoload 'locally "cl-macs" "\
+(put 'cl-multiple-value-setq 'lisp-indent-function '1)
+(autoload 'cl-locally "cl-macs" "\
+Equivalent to `progn'.
-\(fn &rest BODY)" nil (quote macro))
+\(fn &rest BODY)" nil t)
-(autoload 'the "cl-macs" "\
+(autoload 'cl-the "cl-macs" "\
+At present this ignores _TYPE and is simply equivalent to FORM.
+\(fn TYPE FORM)" nil t)
-\(fn TYPE FORM)" nil (quote macro))
+(put 'cl-the 'lisp-indent-function '1)
-(autoload 'declare "cl-macs" "\
+(autoload 'cl-declare "cl-macs" "\
Declare SPECS about the current function while compiling.
For instance
- (declare (warn 0))
+ (cl-declare (warn 0))
will turn off byte-compile warnings in the function.
See Info node `(cl)Declarations' for details.
-\(fn &rest SPECS)" nil (quote macro))
-
-(autoload 'define-setf-method "cl-macs" "\
-Define a `setf' method.
-This method shows how to handle `setf's to places of the form (NAME ARGS...).
-The argument forms ARGS are bound according to ARGLIST, as if NAME were
-going to be expanded as a macro, then the BODY forms are executed and must
-return a list of five elements: a temporary-variables list, a value-forms
-list, a store-variables list (of length one), a store-form, and an access-
-form. See `defsetf' for a simpler way to define most setf-methods.
-
-\(fn NAME ARGLIST BODY...)" nil (quote macro))
-
-(autoload 'defsetf "cl-macs" "\
-Define a `setf' method.
-This macro is an easy-to-use substitute for `define-setf-method' that works
-well for simple place forms. In the simple `defsetf' form, `setf's of
-the form (setf (NAME ARGS...) VAL) are transformed to function or macro
-calls of the form (FUNC ARGS... VAL). Example:
+\(fn &rest SPECS)" nil t)
- (defsetf aref aset)
-
-Alternate form: (defsetf NAME ARGLIST (STORE) BODY...).
-Here, the above `setf' call is expanded by binding the argument forms ARGS
-according to ARGLIST, binding the value form VAL to STORE, then executing
-BODY, which must return a Lisp form that does the necessary `setf' operation.
-Actually, ARGLIST and STORE may be bound to temporary variables which are
-introduced automatically to preserve proper execution order of the arguments.
-Example:
-
- (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))
-
-\(fn NAME [FUNC | ARGLIST (STORE) BODY...])" nil (quote macro))
-
-(autoload 'get-setf-method "cl-macs" "\
-Return a list of five values describing the setf-method for PLACE.
-PLACE may be any Lisp form which can appear as the PLACE argument to
-a macro like `setf' or `incf'.
-
-\(fn PLACE &optional ENV)" nil nil)
-
-(autoload 'setf "cl-macs" "\
-Set each PLACE to the value of its VAL.
-This is a generalized version of `setq'; the PLACEs may be symbolic
-references such as (car x) or (aref x i), as well as plain symbols.
-For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y).
-The return value is the last VAL in the list.
-
-\(fn PLACE VAL PLACE VAL ...)" nil (quote macro))
-
-(autoload 'psetf "cl-macs" "\
+(autoload 'cl-psetf "cl-macs" "\
Set PLACEs to the values VALs in parallel.
This is like `setf', except that all VAL forms are evaluated (in order)
before assigning any PLACEs to the corresponding values.
-\(fn PLACE VAL PLACE VAL ...)" nil (quote macro))
-
-(autoload 'cl-do-pop "cl-macs" "\
-
+\(fn PLACE VAL PLACE VAL ...)" nil t)
-\(fn PLACE)" nil nil)
-
-(autoload 'remf "cl-macs" "\
+(autoload 'cl-remf "cl-macs" "\
Remove TAG from property list PLACE.
PLACE may be a symbol, or any generalized variable allowed by `setf'.
The form returns true if TAG was found and removed, nil otherwise.
-\(fn PLACE TAG)" nil (quote macro))
+\(fn PLACE TAG)" nil t)
-(autoload 'shiftf "cl-macs" "\
+(autoload 'cl-shiftf "cl-macs" "\
Shift left among PLACEs.
-Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
+Example: (cl-shiftf A B C) sets A to B, B to C, and returns the old A.
Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
-\(fn PLACE... VAL)" nil (quote macro))
+\(fn PLACE... VAL)" nil t)
-(autoload 'rotatef "cl-macs" "\
+(autoload 'cl-rotatef "cl-macs" "\
Rotate left among PLACEs.
-Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil.
+Example: (cl-rotatef A B C) sets A to B, B to C, and C to A. It returns nil.
Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
-\(fn PLACE...)" nil (quote macro))
+\(fn PLACE...)" nil t)
-(autoload 'letf "cl-macs" "\
+(autoload 'cl-letf "cl-macs" "\
Temporarily bind to PLACEs.
This is the analogue of `let', but with generalized variables (in the
sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
@@ -647,41 +626,37 @@ values. Note that this macro is *not* available in Common Lisp.
As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
the PLACE is not modified before executing BODY.
-\(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro))
+\(fn ((PLACE VALUE) ...) BODY...)" nil t)
+
+(put 'cl-letf 'lisp-indent-function '1)
-(autoload 'letf* "cl-macs" "\
+(autoload 'cl-letf* "cl-macs" "\
Temporarily bind to PLACEs.
-This is the analogue of `let*', but with generalized variables (in the
-sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
-VALUE, then the BODY forms are executed. On exit, either normally or
-because of a `throw' or error, the PLACEs are set back to their original
-values. Note that this macro is *not* available in Common Lisp.
-As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
-the PLACE is not modified before executing BODY.
+Like `cl-letf' but where the bindings are performed one at a time,
+rather than all at the end (i.e. like `let*' rather than like `let').
+
+\(fn BINDINGS &rest BODY)" nil t)
-\(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro))
+(put 'cl-letf* 'lisp-indent-function '1)
-(autoload 'callf "cl-macs" "\
+(autoload 'cl-callf "cl-macs" "\
Set PLACE to (FUNC PLACE ARGS...).
FUNC should be an unquoted function name. PLACE may be a symbol,
or any generalized variable allowed by `setf'.
-\(fn FUNC PLACE ARGS...)" nil (quote macro))
+\(fn FUNC PLACE &rest ARGS)" nil t)
-(autoload 'callf2 "cl-macs" "\
-Set PLACE to (FUNC ARG1 PLACE ARGS...).
-Like `callf', but PLACE is the second argument of FUNC, not the first.
+(put 'cl-callf 'lisp-indent-function '2)
-\(fn FUNC ARG1 PLACE ARGS...)" nil (quote macro))
+(autoload 'cl-callf2 "cl-macs" "\
+Set PLACE to (FUNC ARG1 PLACE ARGS...).
+Like `cl-callf', but PLACE is the second argument of FUNC, not the first.
-(autoload 'define-modify-macro "cl-macs" "\
-Define a `setf'-like modify macro.
-If NAME is called, it combines its PLACE argument with the other arguments
-from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)
+\(fn FUNC ARG1 PLACE ARGS...)" nil t)
-\(fn NAME ARGLIST FUNC &optional DOC)" nil (quote macro))
+(put 'cl-callf2 'lisp-indent-function '3)
-(autoload 'defstruct "cl-macs" "\
+(autoload 'cl-defstruct "cl-macs" "\
Define a struct type.
This macro defines a new data type called NAME that stores data
in SLOTs. It defines a `make-NAME' constructor, a `copy-NAME'
@@ -689,49 +664,51 @@ 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
one keyword is supported, `:read-only'. If this has a non-nil
value, that slot cannot be set via `setf'.
-\(fn NAME SLOTS...)" nil (quote macro))
+\(fn NAME SLOTS...)" nil t)
-(autoload 'cl-struct-setf-expander "cl-macs" "\
+(put 'cl-defstruct 'doc-string-elt '2)
+(put 'cl-defstruct 'lisp-indent-function '1)
-\(fn X NAME ACCESSOR PRED-FORM POS)" nil nil)
-
-(autoload 'deftype "cl-macs" "\
+(autoload 'cl-deftype "cl-macs" "\
Define NAME as a new data type.
-The type name can then be used in `typecase', `check-type', etc.
+The type name can then be used in `cl-typecase', `cl-check-type', etc.
+
+\(fn NAME ARGLIST &rest BODY)" nil t)
-\(fn NAME ARGLIST &rest BODY)" nil (quote macro))
+(put 'cl-deftype 'doc-string-elt '3)
-(autoload 'typep "cl-macs" "\
+(autoload 'cl-typep "cl-macs" "\
Check that OBJECT is of type TYPE.
TYPE is a Common Lisp-style type specifier.
\(fn OBJECT TYPE)" nil nil)
-(autoload 'check-type "cl-macs" "\
+(autoload 'cl-check-type "cl-macs" "\
Verify that FORM is of type TYPE; signal an error if not.
STRING is an optional description of the desired type.
-\(fn FORM TYPE &optional STRING)" nil (quote macro))
+\(fn FORM TYPE &optional STRING)" nil t)
-(autoload 'assert "cl-macs" "\
+(autoload 'cl-assert "cl-macs" "\
Verify that FORM returns non-nil; signal an error if not.
Second arg SHOW-ARGS means to include arguments of FORM in message.
Other args STRING and ARGS... are arguments to be passed to `error'.
They are not evaluated unless the assertion fails. If STRING is
omitted, a default message listing FORM itself is used.
-\(fn FORM &optional SHOW-ARGS STRING &rest ARGS)" nil (quote macro))
+\(fn FORM &optional SHOW-ARGS STRING &rest ARGS)" nil t)
-(autoload 'define-compiler-macro "cl-macs" "\
+(autoload 'cl-define-compiler-macro "cl-macs" "\
Define a compiler-only macro.
This is like `defmacro', but macro expansion occurs only if the call to
FUNC is compiled (i.e., not interpreted). Compiler macros should be used
@@ -743,51 +720,63 @@ possible. Unlike regular macros, BODY can decide to \"punt\" and leave the
original function call alone by declaring an initial `&whole foo' parameter
and then returning foo.
-\(fn FUNC ARGS &rest BODY)" nil (quote macro))
-
-(autoload 'compiler-macroexpand "cl-macs" "\
+\(fn FUNC ARGS &rest BODY)" nil t)
+(autoload 'cl-compiler-macroexpand "cl-macs" "\
+Like `macroexpand', but for compiler macros.
+Expands FORM repeatedly until no further expansion is possible.
+Returns FORM unchanged if it has no compiler macro, or if it has a
+macro that returns its `&whole' argument.
\(fn FORM)" nil nil)
-(autoload 'defsubst* "cl-macs" "\
+(autoload 'cl-defsubst "cl-macs" "\
Define NAME as a function.
Like `defun', except the function is automatically declared `inline',
ARGLIST allows full Common Lisp conventions, and BODY is implicitly
-surrounded by (block NAME ...).
+surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t)
+
+(put 'cl-defsubst 'lisp-indent-function '2)
-\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro))
+(autoload 'cl--compiler-macro-adjoin "cl-macs" "\
+
+
+\(fn FORM A LIST &rest KEYS)" nil nil)
;;;***
-;;;### (autoloads (tree-equal nsublis sublis nsubst-if-not nsubst-if
-;;;;;; nsubst subst-if-not subst-if subsetp nset-exclusive-or set-exclusive-or
-;;;;;; nset-difference set-difference nintersection intersection
-;;;;;; nunion union rassoc-if-not rassoc-if rassoc* assoc-if-not
-;;;;;; assoc-if assoc* cl-adjoin member-if-not member-if member*
-;;;;;; merge stable-sort sort* search mismatch count-if-not count-if
-;;;;;; count position-if-not position-if position find-if-not find-if
-;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not
-;;;;;; substitute-if substitute delete-duplicates remove-duplicates
-;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove*
-;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "df375ddc313f0c1c262cacab5cffd3e4")
+;;;### (autoloads (cl-tree-equal cl-nsublis cl-sublis cl-nsubst-if-not
+;;;;;; cl-nsubst-if cl-nsubst cl-subst-if-not cl-subst-if cl-subsetp
+;;;;;; cl-nset-exclusive-or cl-set-exclusive-or cl-nset-difference
+;;;;;; cl-set-difference cl-nintersection cl-intersection cl-nunion
+;;;;;; cl-union cl-rassoc-if-not cl-rassoc-if cl-rassoc cl-assoc-if-not
+;;;;;; cl-assoc-if cl-assoc cl--adjoin cl-member-if-not cl-member-if
+;;;;;; cl-member cl-merge cl-stable-sort cl-sort cl-search cl-mismatch
+;;;;;; cl-count-if-not cl-count-if cl-count cl-position-if-not cl-position-if
+;;;;;; cl-position cl-find-if-not cl-find-if cl-find cl-nsubstitute-if-not
+;;;;;; 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" "4c1e1191e82dc8d5449a5ec4d59efc10")
;;; Generated autoloads from cl-seq.el
-(autoload 'reduce "cl-seq" "\
+(autoload 'cl-reduce "cl-seq" "\
Reduce two-argument FUNCTION across SEQ.
Keywords supported: :start :end :from-end :initial-value :key
\(fn FUNCTION SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'fill "cl-seq" "\
+(autoload 'cl-fill "cl-seq" "\
Fill the elements of SEQ with ITEM.
Keywords supported: :start :end
\(fn SEQ ITEM [KEYWORD VALUE]...)" nil nil)
-(autoload 'replace "cl-seq" "\
+(autoload 'cl-replace "cl-seq" "\
Replace the elements of SEQ1 with the elements of SEQ2.
SEQ1 is destructively modified, then returned.
@@ -795,7 +784,7 @@ Keywords supported: :start1 :end1 :start2 :end2
\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'remove* "cl-seq" "\
+(autoload 'cl-remove "cl-seq" "\
Remove all occurrences of ITEM in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
@@ -804,7 +793,7 @@ Keywords supported: :test :test-not :key :count :start :end :from-end
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'remove-if "cl-seq" "\
+(autoload 'cl-remove-if "cl-seq" "\
Remove all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
@@ -813,7 +802,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'remove-if-not "cl-seq" "\
+(autoload 'cl-remove-if-not "cl-seq" "\
Remove all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
@@ -822,7 +811,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'delete* "cl-seq" "\
+(autoload 'cl-delete "cl-seq" "\
Remove all occurrences of ITEM in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
@@ -830,7 +819,7 @@ Keywords supported: :test :test-not :key :count :start :end :from-end
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'delete-if "cl-seq" "\
+(autoload 'cl-delete-if "cl-seq" "\
Remove all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
@@ -838,7 +827,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'delete-if-not "cl-seq" "\
+(autoload 'cl-delete-if-not "cl-seq" "\
Remove all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
@@ -846,21 +835,21 @@ Keywords supported: :key :count :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'remove-duplicates "cl-seq" "\
+(autoload 'cl-remove-duplicates "cl-seq" "\
Return a copy of SEQ with all duplicate elements removed.
Keywords supported: :test :test-not :key :start :end :from-end
\(fn SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'delete-duplicates "cl-seq" "\
+(autoload 'cl-delete-duplicates "cl-seq" "\
Remove all duplicate elements from SEQ (destructively).
Keywords supported: :test :test-not :key :start :end :from-end
\(fn SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'substitute "cl-seq" "\
+(autoload 'cl-substitute "cl-seq" "\
Substitute NEW for OLD in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
@@ -869,7 +858,7 @@ Keywords supported: :test :test-not :key :count :start :end :from-end
\(fn NEW OLD SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'substitute-if "cl-seq" "\
+(autoload 'cl-substitute-if "cl-seq" "\
Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
@@ -878,7 +867,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'substitute-if-not "cl-seq" "\
+(autoload 'cl-substitute-if-not "cl-seq" "\
Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
@@ -887,7 +876,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsubstitute "cl-seq" "\
+(autoload 'cl-nsubstitute "cl-seq" "\
Substitute NEW for OLD in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
@@ -895,7 +884,7 @@ Keywords supported: :test :test-not :key :count :start :end :from-end
\(fn NEW OLD SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsubstitute-if "cl-seq" "\
+(autoload 'cl-nsubstitute-if "cl-seq" "\
Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
@@ -903,7 +892,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsubstitute-if-not "cl-seq" "\
+(autoload 'cl-nsubstitute-if-not "cl-seq" "\
Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
@@ -911,7 +900,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'find "cl-seq" "\
+(autoload 'cl-find "cl-seq" "\
Find the first occurrence of ITEM in SEQ.
Return the matching ITEM, or nil if not found.
@@ -919,7 +908,7 @@ Keywords supported: :test :test-not :key :start :end :from-end
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'find-if "cl-seq" "\
+(autoload 'cl-find-if "cl-seq" "\
Find the first item satisfying PREDICATE in SEQ.
Return the matching item, or nil if not found.
@@ -927,7 +916,7 @@ Keywords supported: :key :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'find-if-not "cl-seq" "\
+(autoload 'cl-find-if-not "cl-seq" "\
Find the first item not satisfying PREDICATE in SEQ.
Return the matching item, or nil if not found.
@@ -935,7 +924,7 @@ Keywords supported: :key :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'position "cl-seq" "\
+(autoload 'cl-position "cl-seq" "\
Find the first occurrence of ITEM in SEQ.
Return the index of the matching item, or nil if not found.
@@ -943,7 +932,7 @@ Keywords supported: :test :test-not :key :start :end :from-end
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'position-if "cl-seq" "\
+(autoload 'cl-position-if "cl-seq" "\
Find the first item satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found.
@@ -951,7 +940,7 @@ Keywords supported: :key :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'position-if-not "cl-seq" "\
+(autoload 'cl-position-if-not "cl-seq" "\
Find the first item not satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found.
@@ -959,28 +948,28 @@ Keywords supported: :key :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'count "cl-seq" "\
+(autoload 'cl-count "cl-seq" "\
Count the number of occurrences of ITEM in SEQ.
Keywords supported: :test :test-not :key :start :end
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'count-if "cl-seq" "\
+(autoload 'cl-count-if "cl-seq" "\
Count the number of items satisfying PREDICATE in SEQ.
Keywords supported: :key :start :end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'count-if-not "cl-seq" "\
+(autoload 'cl-count-if-not "cl-seq" "\
Count the number of items not satisfying PREDICATE in SEQ.
Keywords supported: :key :start :end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'mismatch "cl-seq" "\
+(autoload 'cl-mismatch "cl-seq" "\
Compare SEQ1 with SEQ2, return index of first mismatching element.
Return nil if the sequences match. If one sequence is a prefix of the
other, the return value indicates the end of the shorter sequence.
@@ -989,7 +978,7 @@ Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'search "cl-seq" "\
+(autoload 'cl-search "cl-seq" "\
Search for SEQ1 as a subsequence of SEQ2.
Return the index of the leftmost element of the first match found;
return nil if there are no matches.
@@ -998,7 +987,7 @@ Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'sort* "cl-seq" "\
+(autoload 'cl-sort "cl-seq" "\
Sort the argument SEQ according to PREDICATE.
This is a destructive function; it reuses the storage of SEQ if possible.
@@ -1006,7 +995,7 @@ Keywords supported: :key
\(fn SEQ PREDICATE [KEYWORD VALUE]...)" nil nil)
-(autoload 'stable-sort "cl-seq" "\
+(autoload 'cl-stable-sort "cl-seq" "\
Sort the argument SEQ stably according to PREDICATE.
This is a destructive function; it reuses the storage of SEQ if possible.
@@ -1014,7 +1003,7 @@ Keywords supported: :key
\(fn SEQ PREDICATE [KEYWORD VALUE]...)" nil nil)
-(autoload 'merge "cl-seq" "\
+(autoload 'cl-merge "cl-seq" "\
Destructively merge the two sequences to produce a new sequence.
TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument
sequences, and PREDICATE is a `less-than' predicate on the elements.
@@ -1023,7 +1012,7 @@ Keywords supported: :key
\(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)" nil nil)
-(autoload 'member* "cl-seq" "\
+(autoload 'cl-member "cl-seq" "\
Find the first occurrence of ITEM in LIST.
Return the sublist of LIST whose car is ITEM.
@@ -1031,7 +1020,9 @@ Keywords supported: :test :test-not :key
\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'member-if "cl-seq" "\
+(put 'cl-member 'compiler-macro #'cl--compiler-macro-member)
+
+(autoload 'cl-member-if "cl-seq" "\
Find the first item satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches.
@@ -1039,7 +1030,7 @@ Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'member-if-not "cl-seq" "\
+(autoload 'cl-member-if-not "cl-seq" "\
Find the first item not satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches.
@@ -1047,54 +1038,56 @@ Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'cl-adjoin "cl-seq" "\
-Not documented
+(autoload 'cl--adjoin "cl-seq" "\
+
\(fn CL-ITEM CL-LIST &rest CL-KEYS)" nil nil)
-(autoload 'assoc* "cl-seq" "\
+(autoload 'cl-assoc "cl-seq" "\
Find the first item whose car matches ITEM in LIST.
Keywords supported: :test :test-not :key
\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'assoc-if "cl-seq" "\
+(put 'cl-assoc 'compiler-macro #'cl--compiler-macro-assoc)
+
+(autoload 'cl-assoc-if "cl-seq" "\
Find the first item whose car satisfies PREDICATE in LIST.
Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'assoc-if-not "cl-seq" "\
+(autoload 'cl-assoc-if-not "cl-seq" "\
Find the first item whose car does not satisfy PREDICATE in LIST.
Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'rassoc* "cl-seq" "\
+(autoload 'cl-rassoc "cl-seq" "\
Find the first item whose cdr matches ITEM in LIST.
Keywords supported: :test :test-not :key
\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'rassoc-if "cl-seq" "\
+(autoload 'cl-rassoc-if "cl-seq" "\
Find the first item whose cdr satisfies PREDICATE in LIST.
Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'rassoc-if-not "cl-seq" "\
+(autoload 'cl-rassoc-if-not "cl-seq" "\
Find the first item whose cdr does not satisfy PREDICATE in LIST.
Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'union "cl-seq" "\
+(autoload 'cl-union "cl-seq" "\
Combine LIST1 and LIST2 using a set-union operation.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
@@ -1104,7 +1097,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'nunion "cl-seq" "\
+(autoload 'cl-nunion "cl-seq" "\
Combine LIST1 and LIST2 using a set-union operation.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -1114,7 +1107,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'intersection "cl-seq" "\
+(autoload 'cl-intersection "cl-seq" "\
Combine LIST1 and LIST2 using a set-intersection operation.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
@@ -1124,7 +1117,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'nintersection "cl-seq" "\
+(autoload 'cl-nintersection "cl-seq" "\
Combine LIST1 and LIST2 using a set-intersection operation.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -1134,7 +1127,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'set-difference "cl-seq" "\
+(autoload 'cl-set-difference "cl-seq" "\
Combine LIST1 and LIST2 using a set-difference operation.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
@@ -1144,7 +1137,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'nset-difference "cl-seq" "\
+(autoload 'cl-nset-difference "cl-seq" "\
Combine LIST1 and LIST2 using a set-difference operation.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -1154,7 +1147,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'set-exclusive-or "cl-seq" "\
+(autoload 'cl-set-exclusive-or "cl-seq" "\
Combine LIST1 and LIST2 using a set-exclusive-or operation.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
@@ -1164,7 +1157,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'nset-exclusive-or "cl-seq" "\
+(autoload 'cl-nset-exclusive-or "cl-seq" "\
Combine LIST1 and LIST2 using a set-exclusive-or operation.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -1174,7 +1167,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'subsetp "cl-seq" "\
+(autoload 'cl-subsetp "cl-seq" "\
Return true if LIST1 is a subset of LIST2.
I.e., if every element of LIST1 also appears in LIST2.
@@ -1182,7 +1175,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'subst-if "cl-seq" "\
+(autoload 'cl-subst-if "cl-seq" "\
Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced by NEW.
@@ -1190,7 +1183,7 @@ Keywords supported: :key
\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'subst-if-not "cl-seq" "\
+(autoload 'cl-subst-if-not "cl-seq" "\
Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all non-matching elements replaced by NEW.
@@ -1198,7 +1191,7 @@ Keywords supported: :key
\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsubst "cl-seq" "\
+(autoload 'cl-nsubst "cl-seq" "\
Substitute NEW for OLD everywhere in TREE (destructively).
Any element of TREE which is `eql' to OLD is changed to NEW (via a call
to `setcar').
@@ -1207,7 +1200,7 @@ Keywords supported: :test :test-not :key
\(fn NEW OLD TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsubst-if "cl-seq" "\
+(autoload 'cl-nsubst-if "cl-seq" "\
Substitute NEW for elements matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar').
@@ -1215,7 +1208,7 @@ Keywords supported: :key
\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsubst-if-not "cl-seq" "\
+(autoload 'cl-nsubst-if-not "cl-seq" "\
Substitute NEW for elements not matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar').
@@ -1223,7 +1216,7 @@ Keywords supported: :key
\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'sublis "cl-seq" "\
+(autoload 'cl-sublis "cl-seq" "\
Perform substitutions indicated by ALIST in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced.
@@ -1231,7 +1224,7 @@ Keywords supported: :test :test-not :key
\(fn ALIST TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsublis "cl-seq" "\
+(autoload 'cl-nsublis "cl-seq" "\
Perform substitutions indicated by ALIST in TREE (destructively).
Any matching element of TREE is changed via a call to `setcar'.
@@ -1239,7 +1232,7 @@ Keywords supported: :test :test-not :key
\(fn ALIST TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'tree-equal "cl-seq" "\
+(autoload 'cl-tree-equal "cl-seq" "\
Return t if trees TREE1 and TREE2 have `eql' leaves.
Atoms are compared by `eql'; cons cells are compared recursively.
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index d9531cc5261..918e992512c 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1,6 +1,6 @@
-;;; cl-macs.el --- Common Lisp macros
+;;; cl-macs.el --- Common Lisp macros -*- lexical-binding: t; coding: utf-8 -*-
-;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 2.02
@@ -43,268 +43,215 @@
;;; Code:
-(require 'cl)
+(require 'cl-lib)
+(require 'macroexp)
+;; `gv' is required here because cl-macs can be loaded before loaddefs.el.
+(require 'gv)
(defmacro cl-pop2 (place)
- (list 'prog1 (list 'car (list 'cdr place))
- (list 'setq place (list 'cdr (list 'cdr place)))))
-(put 'cl-pop2 'edebug-form-spec 'edebug-sexps)
+ (declare (debug edebug-sexps))
+ `(prog1 (car (cdr ,place))
+ (setq ,place (cdr (cdr ,place)))))
(defvar cl-optimize-safety)
(defvar cl-optimize-speed)
-
-;; This kludge allows macros which use cl-transform-function-property
-;; to be called at compile-time.
-
-(require
- (progn
- (or (fboundp 'cl-transform-function-property)
- (defalias 'cl-transform-function-property
- (function (lambda (n p f)
- (list 'put (list 'quote n) (list 'quote p)
- (list 'function (cons 'lambda f)))))))
- (car (or features (setq features (list 'cl-kludge))))))
-
-
;;; Initialization.
-(defvar cl-old-bc-file-form nil)
+;; Place compiler macros at the beginning, otherwise uses of the corresponding
+;; functions can lead to recursive-loads that prevent the calls from
+;; being optimized.
-;;; Some predicates for analyzing Lisp forms. These are used by various
-;;; macro expanders to optimize the results in certain common cases.
+;;;###autoload
+(defun cl--compiler-macro-list* (_form arg &rest others)
+ (let* ((args (reverse (cons arg others)))
+ (form (car args)))
+ (while (setq args (cdr args))
+ (setq form `(cons ,(car args) ,form)))
+ form))
-(defconst cl-simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max
+;;;###autoload
+(defun cl--compiler-macro-cXXr (form x)
+ (let* ((head (car form))
+ (n (symbol-name (car form)))
+ (i (- (length n) 2)))
+ (if (not (string-match "c[ad]+r\\'" n))
+ (if (and (fboundp head) (symbolp (symbol-function head)))
+ (cl--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
+ x)
+ (error "Compiler macro for cXXr applied to non-cXXr form"))
+ (while (> i (match-beginning 0))
+ (setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
+ (setq i (1- i)))
+ x)))
+
+;;; Some predicates for analyzing Lisp forms.
+;; These are used by various
+;; macro expanders to optimize the results in certain common cases.
+
+(defconst cl--simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max
car-safe cdr-safe progn prog1 prog2))
-(defconst cl-safe-funcs '(* / % length memq list vector vectorp
+(defconst cl--safe-funcs '(* / % length memq list vector vectorp
< > <= >= = error))
-;;; Check if no side effects, and executes quickly.
-(defun cl-simple-expr-p (x &optional size)
+(defun cl--simple-expr-p (x &optional size)
+ "Check if no side effects, and executes quickly."
(or size (setq size 10))
- (if (and (consp x) (not (memq (car x) '(quote function function*))))
+ (if (and (consp x) (not (memq (car x) '(quote function cl-function))))
(and (symbolp (car x))
- (or (memq (car x) cl-simple-funcs)
+ (or (memq (car x) cl--simple-funcs)
(get (car x) 'side-effect-free))
(progn
(setq size (1- size))
(while (and (setq x (cdr x))
- (setq size (cl-simple-expr-p (car x) size))))
+ (setq size (cl--simple-expr-p (car x) size))))
(and (null x) (>= size 0) size)))
(and (> size 0) (1- size))))
-(defun cl-simple-exprs-p (xs)
- (while (and xs (cl-simple-expr-p (car xs)))
+(defun cl--simple-exprs-p (xs)
+ (while (and xs (cl--simple-expr-p (car xs)))
(setq xs (cdr xs)))
(not xs))
-;;; Check if no side effects.
-(defun cl-safe-expr-p (x)
- (or (not (and (consp x) (not (memq (car x) '(quote function function*)))))
+(defun cl--safe-expr-p (x)
+ "Check if no side effects."
+ (or (not (and (consp x) (not (memq (car x) '(quote function cl-function)))))
(and (symbolp (car x))
- (or (memq (car x) cl-simple-funcs)
- (memq (car x) cl-safe-funcs)
+ (or (memq (car x) cl--simple-funcs)
+ (memq (car x) cl--safe-funcs)
(get (car x) 'side-effect-free))
(progn
- (while (and (setq x (cdr x)) (cl-safe-expr-p (car x))))
+ (while (and (setq x (cdr x)) (cl--safe-expr-p (car x))))
(null x)))))
;;; Check if constant (i.e., no side effects or dependencies).
-(defun cl-const-expr-p (x)
+(defun cl--const-expr-p (x)
(cond ((consp x)
(or (eq (car x) 'quote)
- (and (memq (car x) '(function function*))
+ (and (memq (car x) '(function cl-function))
(or (symbolp (nth 1 x))
(and (eq (car-safe (nth 1 x)) 'lambda) 'func)))))
((symbolp x) (and (memq x '(nil t)) t))
(t t)))
-(defun cl-const-exprs-p (xs)
- (while (and xs (cl-const-expr-p (car xs)))
- (setq xs (cdr xs)))
- (not xs))
-
-(defun cl-const-expr-val (x)
- (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x)))
-
-(defun cl-expr-access-order (x v)
- ;; This apparently tries to return nil iff the expression X evaluates
- ;; the variables V in the same order as they appear in V (so as to
- ;; be able to replace those vars with the expressions they're bound
- ;; to).
- ;; FIXME: This is very naive, it doesn't even check to see if those
- ;; variables appear more than once.
- (if (cl-const-expr-p x) v
- (if (consp x)
- (progn
- (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v)))
- v)
- (if (eq x (car v)) (cdr v) '(t)))))
+(defun cl--const-expr-val (x)
+ (and (macroexp-const-p x) (if (consp x) (nth 1 x) x)))
-;;; Count number of times X refers to Y. Return nil for 0 times.
-(defun cl-expr-contains (x y)
+(defun cl--expr-contains (x y)
+ "Count number of times X refers to Y. Return nil for 0 times."
+ ;; FIXME: This is naive, and it will cl-count Y as referred twice in
+ ;; (let ((Y 1)) Y) even though it should be 0. Also it is often called on
+ ;; non-macroexpanded code, so it may also miss some occurrences that would
+ ;; only appear in the expanded code.
(cond ((equal y x) 1)
- ((and (consp x) (not (memq (car-safe x) '(quote function function*))))
+ ((and (consp x) (not (memq (car x) '(quote function cl-function))))
(let ((sum 0))
- (while x
- (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0))))
+ (while (consp x)
+ (setq sum (+ sum (or (cl--expr-contains (pop x) y) 0))))
+ (setq sum (+ sum (or (cl--expr-contains x y) 0)))
(and (> sum 0) sum)))
(t nil)))
-(defun cl-expr-contains-any (x y)
- (while (and y (not (cl-expr-contains x (car y)))) (pop y))
+(defun cl--expr-contains-any (x y)
+ (while (and y (not (cl--expr-contains x (car y)))) (pop y))
y)
-;;; Check whether X may depend on any of the symbols in Y.
-(defun cl-expr-depends-p (x y)
- (and (not (cl-const-expr-p x))
- (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y))))
+(defun cl--expr-depends-p (x y)
+ "Check whether X may depend on any of the symbols in Y."
+ (and (not (macroexp-const-p x))
+ (or (not (cl--safe-expr-p x)) (cl--expr-contains-any x y))))
;;; Symbols.
-(defvar *gensym-counter*)
+(defvar cl--gensym-counter)
;;;###autoload
-(defun gensym (&optional prefix)
+(defun cl-gensym (&optional prefix)
"Generate a new uninterned symbol.
The name is made by appending a number to PREFIX, default \"G\"."
(let ((pfix (if (stringp prefix) prefix "G"))
(num (if (integerp prefix) prefix
- (prog1 *gensym-counter*
- (setq *gensym-counter* (1+ *gensym-counter*))))))
+ (prog1 cl--gensym-counter
+ (setq cl--gensym-counter (1+ cl--gensym-counter))))))
(make-symbol (format "%s%d" pfix num))))
;;;###autoload
-(defun gentemp (&optional prefix)
+(defun cl-gentemp (&optional prefix)
"Generate a new interned symbol with a unique name.
The name is made by appending a number to PREFIX, default \"G\"."
(let ((pfix (if (stringp prefix) prefix "G"))
name)
- (while (intern-soft (setq name (format "%s%d" pfix *gensym-counter*)))
- (setq *gensym-counter* (1+ *gensym-counter*)))
+ (while (intern-soft (setq name (format "%s%d" pfix cl--gensym-counter)))
+ (setq cl--gensym-counter (1+ cl--gensym-counter)))
(intern name)))
;;; Program structure.
-;;;###autoload
-(defmacro defun* (name args &rest body)
- "Define NAME as a function.
-Like normal `defun', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...).
+(def-edebug-spec cl-declarations
+ (&rest ("cl-declare" &rest sexp)))
-\(fn NAME ARGLIST [DOCSTRING] BODY...)"
- (let* ((res (cl-transform-lambda (cons args body) name))
- (form (list* 'defun name (cdr res))))
- (if (car res) (list 'progn (car res) form) form)))
+(def-edebug-spec cl-declarations-or-string
+ (&or stringp cl-declarations))
-;;;###autoload
-(defmacro defmacro* (name args &rest body)
- "Define NAME as a macro.
-Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...).
+(def-edebug-spec cl-lambda-list
+ (([&rest arg]
+ [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
+ [&optional ["&rest" arg]]
+ [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (symbolp &optional def-form) symbolp]]
+ )))
-\(fn NAME ARGLIST [DOCSTRING] BODY...)"
- (let* ((res (cl-transform-lambda (cons args body) name))
- (form (list* 'defmacro name (cdr res))))
- (if (car res) (list 'progn (car res) form) form)))
+(def-edebug-spec cl-&optional-arg
+ (&or (arg &optional def-form arg) arg))
-;;;###autoload
-(defmacro function* (func)
- "Introduce a function.
-Like normal `function', except that if argument is a lambda form,
-its argument list allows full Common Lisp conventions."
- (if (eq (car-safe func) 'lambda)
- (let* ((res (cl-transform-lambda (cdr func) 'cl-none))
- (form (list 'function (cons 'lambda (cdr res)))))
- (if (car res) (list 'progn (car res) form) form))
- (list 'function func)))
-
-(defun cl-transform-function-property (func prop form)
- (let ((res (cl-transform-lambda form func)))
- (append '(progn) (cdr (cdr (car res)))
- (list (list 'put (list 'quote func) (list 'quote prop)
- (list 'function (cons 'lambda (cdr res))))))))
-
-(defconst lambda-list-keywords
- '(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
+(def-edebug-spec cl-&key-arg
+ (&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
-(defvar cl-macro-environment nil
- "Keep the list of currently active macros.
-It is a list of elements of the form either:
-- (SYMBOL . FUNCTION) where FUNCTION is the macro expansion function.
-- (SYMBOL-NAME . EXPANSION) where SYMBOL-NAME is the name of a symbol macro.")
-(defvar bind-block) (defvar bind-defs) (defvar bind-enquote)
-(defvar bind-inits) (defvar bind-lets) (defvar bind-forms)
+(defconst cl--lambda-list-keywords
+ '(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
-(declare-function help-add-fundoc-usage "help-fns" (docstring arglist))
+(defvar cl--bind-block) (defvar cl--bind-defs) (defvar cl--bind-enquote)
+(defvar cl--bind-inits) (defvar cl--bind-lets) (defvar cl--bind-forms)
-(defun cl--make-usage-var (x)
- "X can be a var or a (destructuring) lambda-list."
- (cond
- ((symbolp x) (make-symbol (upcase (symbol-name x))))
- ((consp x) (cl--make-usage-args x))
- (t x)))
-
-(defun cl--make-usage-args (arglist)
- ;; `orig-args' can contain &cl-defs (an internal
- ;; CL thingy I don't understand), so remove it.
- (let ((x (memq '&cl-defs arglist)))
- (when x (setq arglist (delq (car x) (remq (cadr x) arglist)))))
- (let ((state nil))
- (mapcar (lambda (x)
- (cond
- ((symbolp x)
- (if (eq ?\& (aref (symbol-name x) 0))
- (setq state x)
- (make-symbol (upcase (symbol-name x)))))
- ((not (consp x)) x)
- ((memq state '(nil &rest)) (cl--make-usage-args x))
- (t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR).
- (list*
- (if (and (consp (car x)) (eq state '&key))
- (list (caar x) (cl--make-usage-var (nth 1 (car x))))
- (cl--make-usage-var (car x)))
- (nth 1 x) ;INITFORM.
- (cl--make-usage-args (nthcdr 2 x)) ;SVAR.
- ))))
- arglist)))
-
-(defun cl-transform-lambda (form bind-block)
+(defun cl--transform-lambda (form bind-block)
(let* ((args (car form)) (body (cdr form)) (orig-args args)
- (bind-defs nil) (bind-enquote nil)
- (bind-inits nil) (bind-lets nil) (bind-forms nil)
+ (cl--bind-block bind-block) (cl--bind-defs nil) (cl--bind-enquote nil)
+ (cl--bind-inits nil) (cl--bind-lets nil) (cl--bind-forms nil)
(header nil) (simple-args nil))
(while (or (stringp (car body))
- (memq (car-safe (car body)) '(interactive declare)))
+ (memq (car-safe (car body)) '(interactive cl-declare)))
(push (pop body) header))
- (setq args (if (listp args) (copy-list args) (list '&rest args)))
+ (setq args (if (listp args) (cl-copy-list args) (list '&rest args)))
(let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
- (if (setq bind-defs (cadr (memq '&cl-defs args)))
- (setq args (delq '&cl-defs (delq bind-defs args))
- bind-defs (cadr bind-defs)))
- (if (setq bind-enquote (memq '&cl-quote args))
+ (if (setq cl--bind-defs (cadr (memq '&cl-defs args)))
+ (setq args (delq '&cl-defs (delq cl--bind-defs args))
+ cl--bind-defs (cadr cl--bind-defs)))
+ (if (setq cl--bind-enquote (memq '&cl-quote args))
(setq args (delq '&cl-quote args)))
(if (memq '&whole args) (error "&whole not currently implemented"))
- (let* ((p (memq '&environment args)) (v (cadr p)))
+ (let* ((p (memq '&environment args)) (v (cadr p))
+ (env-exp 'macroexpand-all-environment))
(if p (setq args (nconc (delq (car p) (delq v args))
- (list '&aux (list v 'cl-macro-environment))))))
+ (list '&aux (list v env-exp))))))
(while (and args (symbolp (car args))
(not (memq (car args) '(nil &rest &body &key &aux)))
(not (and (eq (car args) '&optional)
- (or bind-defs (consp (cadr args))))))
+ (or cl--bind-defs (consp (cadr args))))))
(push (pop args) simple-args))
- (or (eq bind-block 'cl-none)
- (setq body (list (list* 'block bind-block body))))
+ (or (eq cl--bind-block 'cl-none)
+ (setq body (list `(cl-block ,cl--bind-block ,@body))))
(if (null args)
- (list* nil (nreverse simple-args) (nconc (nreverse header) body))
+ (cl-list* nil (nreverse simple-args) (nconc (nreverse header) body))
(if (memq '&optional simple-args) (push '&optional args))
- (cl-do-arglist args nil (- (length simple-args)
- (if (memq '&optional simple-args) 1 0)))
- (setq bind-lets (nreverse bind-lets))
- (list* (and bind-inits (list* 'eval-when '(compile load eval)
- (nreverse bind-inits)))
+ (cl--do-arglist args nil (- (length simple-args)
+ (if (memq '&optional simple-args) 1 0)))
+ (setq cl--bind-lets (nreverse cl--bind-lets))
+ (cl-list* (and cl--bind-inits `(cl-eval-when (compile load eval)
+ ,@(nreverse cl--bind-inits)))
(nconc (nreverse simple-args)
- (list '&rest (car (pop bind-lets))))
+ (list '&rest (car (pop cl--bind-lets))))
(nconc (let ((hdr (nreverse header)))
;; Macro expansion can take place in the middle of
;; apparently harmless computation, so it should not
@@ -313,236 +260,385 @@ It is a list of elements of the form either:
(require 'help-fns)
(cons (help-add-fundoc-usage
(if (stringp (car hdr)) (pop hdr))
- (format "(fn %S)"
- (cl--make-usage-args orig-args)))
+ ;; Be careful with make-symbol and (back)quote,
+ ;; see bug#12884.
+ (let ((print-gensym nil) (print-quoted t))
+ (format "%S" (cons 'fn (cl--make-usage-args
+ orig-args)))))
hdr)))
- (list (nconc (list 'let* bind-lets)
- (nreverse bind-forms) body)))))))
+ (list `(let* ,cl--bind-lets
+ ,@(nreverse cl--bind-forms)
+ ,@body)))))))
+
+;;;###autoload
+(defmacro cl-defun (name args &rest body)
+ "Define NAME as a function.
+Like normal `defun', except ARGLIST allows full Common Lisp conventions,
+and BODY is implicitly surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)"
+ (declare (debug
+ ;; Same as defun but use cl-lambda-list.
+ (&define [&or name ("setf" :name setf name)]
+ cl-lambda-list
+ cl-declarations-or-string
+ [&optional ("interactive" interactive)]
+ def-body))
+ (doc-string 3)
+ (indent 2))
+ (let* ((res (cl--transform-lambda (cons args body) name))
+ (form `(defun ,name ,@(cdr res))))
+ (if (car res) `(progn ,(car res) ,form) form)))
+
+;; The lambda list for macros is different from that of normal lambdas.
+;; Note that &environment is only allowed as first or last items in the
+;; top level list.
+
+(def-edebug-spec cl-macro-list
+ (([&optional "&environment" arg]
+ [&rest cl-macro-arg]
+ [&optional ["&optional" &rest
+ &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
+ [&optional [[&or "&rest" "&body"] cl-macro-arg]]
+ [&optional ["&key" [&rest
+ [&or ([&or (symbolp cl-macro-arg) arg]
+ &optional def-form cl-macro-arg)
+ arg]]
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (symbolp &optional def-form) symbolp]]
+ [&optional "&environment" arg]
+ )))
+
+(def-edebug-spec cl-macro-arg
+ (&or arg cl-macro-list1))
+
+(def-edebug-spec cl-macro-list1
+ (([&optional "&whole" arg] ;; only allowed at lower levels
+ [&rest cl-macro-arg]
+ [&optional ["&optional" &rest
+ &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
+ [&optional [[&or "&rest" "&body"] cl-macro-arg]]
+ [&optional ["&key" [&rest
+ [&or ([&or (symbolp cl-macro-arg) arg]
+ &optional def-form cl-macro-arg)
+ arg]]
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (symbolp &optional def-form) symbolp]]
+ . [&or arg nil])))
+
+;;;###autoload
+(defmacro cl-defmacro (name args &rest body)
+ "Define NAME as a macro.
+Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
+and BODY is implicitly surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)"
+ (declare (debug
+ (&define name cl-macro-list cl-declarations-or-string def-body))
+ (doc-string 3)
+ (indent 2))
+ (let* ((res (cl--transform-lambda (cons args body) name))
+ (form `(defmacro ,name ,@(cdr res))))
+ (if (car res) `(progn ,(car res) ,form) form)))
+
+(def-edebug-spec cl-lambda-expr
+ (&define ("lambda" cl-lambda-list
+ ;;cl-declarations-or-string
+ ;;[&optional ("interactive" interactive)]
+ def-body)))
+
+;; Redefine function-form to also match cl-function
+(def-edebug-spec function-form
+ ;; form at the end could also handle "function",
+ ;; but recognize it specially to avoid wrapping function forms.
+ (&or ([&or "quote" "function"] &or symbolp lambda-expr)
+ ("cl-function" cl-function)
+ form))
+
+;;;###autoload
+(defmacro cl-function (func)
+ "Introduce a function.
+Like normal `function', except that if argument is a lambda form,
+its argument list allows full Common Lisp conventions."
+ (declare (debug (&or symbolp cl-lambda-expr)))
+ (if (eq (car-safe func) 'lambda)
+ (let* ((res (cl--transform-lambda (cdr func) 'cl-none))
+ (form `(function (lambda . ,(cdr res)))))
+ (if (car res) `(progn ,(car res) ,form) form))
+ `(function ,func)))
+
+(declare-function help-add-fundoc-usage "help-fns" (docstring arglist))
+
+(defun cl--make-usage-var (x)
+ "X can be a var or a (destructuring) lambda-list."
+ (cond
+ ((symbolp x) (make-symbol (upcase (symbol-name x))))
+ ((consp x) (cl--make-usage-args x))
+ (t x)))
-(defun cl-do-arglist (args expr &optional num) ; uses bind-*
+(defun cl--make-usage-args (arglist)
+ (if (cdr-safe (last arglist)) ;Not a proper list.
+ (let* ((last (last arglist))
+ (tail (cdr last)))
+ (unwind-protect
+ (progn
+ (setcdr last nil)
+ (nconc (cl--make-usage-args arglist) (cl--make-usage-var tail)))
+ (setcdr last tail)))
+ ;; `orig-args' can contain &cl-defs (an internal
+ ;; CL thingy I don't understand), so remove it.
+ (let ((x (memq '&cl-defs arglist)))
+ (when x (setq arglist (delq (car x) (remq (cadr x) arglist)))))
+ (let ((state nil))
+ (mapcar (lambda (x)
+ (cond
+ ((symbolp x)
+ (let ((first (aref (symbol-name x) 0)))
+ (if (eq ?\& first)
+ (setq state x)
+ ;; Strip a leading underscore, since it only
+ ;; means that this argument is unused.
+ (make-symbol (upcase (if (eq ?_ first)
+ (substring (symbol-name x) 1)
+ (symbol-name x)))))))
+ ((not (consp x)) x)
+ ((memq state '(nil &rest)) (cl--make-usage-args x))
+ (t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR).
+ (cl-list*
+ (if (and (consp (car x)) (eq state '&key))
+ (list (caar x) (cl--make-usage-var (nth 1 (car x))))
+ (cl--make-usage-var (car x)))
+ (nth 1 x) ;INITFORM.
+ (cl--make-usage-args (nthcdr 2 x)) ;SVAR.
+ ))))
+ arglist))))
+
+(defun cl--do-arglist (args expr &optional num) ; uses bind-*
(if (nlistp args)
- (if (or (memq args lambda-list-keywords) (not (symbolp args)))
+ (if (or (memq args cl--lambda-list-keywords) (not (symbolp args)))
(error "Invalid argument name: %s" args)
- (push (list args expr) bind-lets))
- (setq args (copy-list args))
+ (push (list args expr) cl--bind-lets))
+ (setq args (cl-copy-list args))
(let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
(let ((p (memq '&body args))) (if p (setcar p '&rest)))
(if (memq '&environment args) (error "&environment used incorrectly"))
(let ((save-args args)
(restarg (memq '&rest args))
- (safety (if (cl-compiling-file) cl-optimize-safety 3))
+ (safety (if (cl--compiling-file) cl-optimize-safety 3))
(keys nil)
(laterarg nil) (exactarg nil) minarg)
(or num (setq num 0))
(if (listp (cadr restarg))
(setq restarg (make-symbol "--cl-rest--"))
(setq restarg (cadr restarg)))
- (push (list restarg expr) bind-lets)
+ (push (list restarg expr) cl--bind-lets)
(if (eq (car args) '&whole)
- (push (list (cl-pop2 args) restarg) bind-lets))
+ (push (list (cl-pop2 args) restarg) cl--bind-lets))
(let ((p args))
(setq minarg restarg)
- (while (and p (not (memq (car p) lambda-list-keywords)))
+ (while (and p (not (memq (car p) cl--lambda-list-keywords)))
(or (eq p args) (setq minarg (list 'cdr minarg)))
(setq p (cdr p)))
(if (memq (car p) '(nil &aux))
- (setq minarg (list '= (list 'length restarg)
- (length (ldiff args p)))
+ (setq minarg `(= (length ,restarg)
+ ,(length (cl-ldiff args p)))
exactarg (not (eq args p)))))
- (while (and args (not (memq (car args) lambda-list-keywords)))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car)
restarg)))
- (cl-do-arglist
+ (cl--do-arglist
(pop args)
(if (or laterarg (= safety 0)) poparg
- (list 'if minarg poparg
- (list 'signal '(quote wrong-number-of-arguments)
- (list 'list (and (not (eq bind-block 'cl-none))
- (list 'quote bind-block))
- (list 'length restarg)))))))
+ `(if ,minarg ,poparg
+ (signal 'wrong-number-of-arguments
+ (list ,(and (not (eq cl--bind-block 'cl-none))
+ `',cl--bind-block)
+ (length ,restarg)))))))
(setq num (1+ num) laterarg t))
(while (and (eq (car args) '&optional) (pop args))
- (while (and args (not (memq (car args) lambda-list-keywords)))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(let ((arg (pop args)))
(or (consp arg) (setq arg (list arg)))
- (if (cddr arg) (cl-do-arglist (nth 2 arg) (list 'and restarg t)))
+ (if (cddr arg) (cl--do-arglist (nth 2 arg) `(and ,restarg t)))
(let ((def (if (cdr arg) (nth 1 arg)
- (or (car bind-defs)
- (nth 1 (assq (car arg) bind-defs)))))
- (poparg (list 'pop restarg)))
- (and def bind-enquote (setq def (list 'quote def)))
- (cl-do-arglist (car arg)
- (if def (list 'if restarg poparg def) poparg))
+ (or (car cl--bind-defs)
+ (nth 1 (assq (car arg) cl--bind-defs)))))
+ (poparg `(pop ,restarg)))
+ (and def cl--bind-enquote (setq def `',def))
+ (cl--do-arglist (car arg)
+ (if def `(if ,restarg ,poparg ,def) poparg))
(setq num (1+ num))))))
(if (eq (car args) '&rest)
(let ((arg (cl-pop2 args)))
- (if (consp arg) (cl-do-arglist arg restarg)))
+ (if (consp arg) (cl--do-arglist arg restarg)))
(or (eq (car args) '&key) (= safety 0) exactarg
- (push (list 'if restarg
- (list 'signal '(quote wrong-number-of-arguments)
- (list 'list
- (and (not (eq bind-block 'cl-none))
- (list 'quote bind-block))
- (list '+ num (list 'length restarg)))))
- bind-forms)))
+ (push `(if ,restarg
+ (signal 'wrong-number-of-arguments
+ (list
+ ,(and (not (eq cl--bind-block 'cl-none))
+ `',cl--bind-block)
+ (+ ,num (length ,restarg)))))
+ cl--bind-forms)))
(while (and (eq (car args) '&key) (pop args))
- (while (and args (not (memq (car args) lambda-list-keywords)))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(let ((arg (pop args)))
(or (consp arg) (setq arg (list arg)))
(let* ((karg (if (consp (car arg)) (caar arg)
- (intern (format ":%s" (car arg)))))
- (varg (if (consp (car arg)) (cadar arg) (car arg)))
+ (let ((name (symbol-name (car arg))))
+ ;; Strip a leading underscore, since it only
+ ;; means that this argument is unused, but
+ ;; shouldn't affect the key's name (bug#12367).
+ (if (eq ?_ (aref name 0))
+ (setq name (substring name 1)))
+ (intern (format ":%s" name)))))
+ (varg (if (consp (car arg)) (cl-cadar arg) (car arg)))
(def (if (cdr arg) (cadr arg)
- (or (car bind-defs) (cadr (assq varg bind-defs)))))
- (look (list 'memq (list 'quote karg) restarg)))
- (and def bind-enquote (setq def (list 'quote def)))
+ (or (car cl--bind-defs) (cadr (assq varg cl--bind-defs)))))
+ (look `(memq ',karg ,restarg)))
+ (and def cl--bind-enquote (setq def `',def))
(if (cddr arg)
(let* ((temp (or (nth 2 arg) (make-symbol "--cl-var--")))
- (val (list 'car (list 'cdr temp))))
- (cl-do-arglist temp look)
- (cl-do-arglist varg
- (list 'if temp
- (list 'prog1 val (list 'setq temp t))
- def)))
- (cl-do-arglist
+ (val `(car (cdr ,temp))))
+ (cl--do-arglist temp look)
+ (cl--do-arglist varg
+ `(if ,temp
+ (prog1 ,val (setq ,temp t))
+ ,def)))
+ (cl--do-arglist
varg
- (list 'car
- (list 'cdr
- (if (null def)
+ `(car (cdr ,(if (null def)
look
- (list 'or look
- (if (eq (cl-const-expr-p def) t)
- (list
- 'quote
- (list nil (cl-const-expr-val def)))
- (list 'list nil def))))))))
+ `(or ,look
+ ,(if (eq (cl--const-expr-p def) t)
+ `'(nil ,(cl--const-expr-val def))
+ `(list nil ,def))))))))
(push karg keys)))))
(setq keys (nreverse keys))
(or (and (eq (car args) '&allow-other-keys) (pop args))
(null keys) (= safety 0)
(let* ((var (make-symbol "--cl-keys--"))
(allow '(:allow-other-keys))
- (check (list
- 'while var
- (list
- 'cond
- (list (list 'memq (list 'car var)
- (list 'quote (append keys allow)))
- (list 'setq var (list 'cdr (list 'cdr var))))
- (list (list 'car
- (list 'cdr
- (list 'memq (cons 'quote allow)
- restarg)))
- (list 'setq var nil))
- (list t
- (list
- 'error
- (format "Keyword argument %%s not one of %s"
- keys)
- (list 'car var)))))))
- (push (list 'let (list (list var restarg)) check) bind-forms)))
+ (check `(while ,var
+ (cond
+ ((memq (car ,var) ',(append keys allow))
+ (setq ,var (cdr (cdr ,var))))
+ ((car (cdr (memq (quote ,@allow) ,restarg)))
+ (setq ,var nil))
+ (t
+ (error
+ ,(format "Keyword argument %%s not one of %s"
+ keys)
+ (car ,var)))))))
+ (push `(let ((,var ,restarg)) ,check) cl--bind-forms)))
(while (and (eq (car args) '&aux) (pop args))
- (while (and args (not (memq (car args) lambda-list-keywords)))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(if (consp (car args))
- (if (and bind-enquote (cadar args))
- (cl-do-arglist (caar args)
- (list 'quote (cadr (pop args))))
- (cl-do-arglist (caar args) (cadr (pop args))))
- (cl-do-arglist (pop args) nil))))
+ (if (and cl--bind-enquote (cl-cadar args))
+ (cl--do-arglist (caar args)
+ `',(cadr (pop args)))
+ (cl--do-arglist (caar args) (cadr (pop args))))
+ (cl--do-arglist (pop args) nil))))
(if args (error "Malformed argument list %s" save-args)))))
-(defun cl-arglist-args (args)
+(defun cl--arglist-args (args)
(if (nlistp args) (list args)
(let ((res nil) (kind nil) arg)
(while (consp args)
(setq arg (pop args))
- (if (memq arg lambda-list-keywords) (setq kind arg)
+ (if (memq arg cl--lambda-list-keywords) (setq kind arg)
(if (eq arg '&cl-defs) (pop args)
(and (consp arg) kind (setq arg (car arg)))
(and (consp arg) (cdr arg) (eq kind '&key) (setq arg (cadr arg)))
- (setq res (nconc res (cl-arglist-args arg))))))
+ (setq res (nconc res (cl--arglist-args arg))))))
(nconc res (and args (list args))))))
;;;###autoload
-(defmacro destructuring-bind (args expr &rest body)
- (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil)
- (bind-defs nil) (bind-block 'cl-none) (bind-enquote nil))
- (cl-do-arglist (or args '(&aux)) expr)
- (append '(progn) bind-inits
- (list (nconc (list 'let* (nreverse bind-lets))
- (nreverse bind-forms) body)))))
+(defmacro cl-destructuring-bind (args expr &rest body)
+ "Bind the variables in ARGS to the result of EXPR and execute BODY."
+ (declare (indent 2)
+ (debug (&define cl-macro-list def-form cl-declarations def-body)))
+ (let* ((cl--bind-lets nil) (cl--bind-forms nil) (cl--bind-inits nil)
+ (cl--bind-defs nil) (cl--bind-block 'cl-none) (cl--bind-enquote nil))
+ (cl--do-arglist (or args '(&aux)) expr)
+ (append '(progn) cl--bind-inits
+ (list `(let* ,(nreverse cl--bind-lets)
+ ,@(nreverse cl--bind-forms) ,@body)))))
-;;; The `eval-when' form.
+;;; The `cl-eval-when' form.
(defvar cl-not-toplevel nil)
;;;###autoload
-(defmacro eval-when (when &rest body)
+(defmacro cl-eval-when (when &rest body)
"Control when BODY is evaluated.
If `compile' is in WHEN, BODY is evaluated when compiled at top-level.
If `load' is in WHEN, BODY is evaluated when loaded after top-level compile.
If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
\(fn (WHEN...) BODY...)"
- (if (and (fboundp 'cl-compiling-file) (cl-compiling-file)
+ (declare (indent 1) (debug ((&rest &or "compile" "load" "eval") body)))
+ (if (and (fboundp 'cl--compiling-file) (cl--compiling-file)
(not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge
(let ((comp (or (memq 'compile when) (memq :compile-toplevel when)))
(cl-not-toplevel t))
(if (or (memq 'load when) (memq :load-toplevel when))
- (if comp (cons 'progn (mapcar 'cl-compile-time-too body))
- (list* 'if nil nil body))
+ (if comp (cons 'progn (mapcar 'cl--compile-time-too body))
+ `(if nil nil ,@body))
(progn (if comp (eval (cons 'progn body))) nil)))
(and (or (memq 'eval when) (memq :execute when))
(cons 'progn body))))
-(defun cl-compile-time-too (form)
+(defun cl--compile-time-too (form)
(or (and (symbolp (car-safe form)) (get (car-safe form) 'byte-hunk-handler))
(setq form (macroexpand
- form (cons '(eval-when) byte-compile-macro-environment))))
+ form (cons '(cl-eval-when) byte-compile-macro-environment))))
(cond ((eq (car-safe form) 'progn)
- (cons 'progn (mapcar 'cl-compile-time-too (cdr form))))
- ((eq (car-safe form) 'eval-when)
+ (cons 'progn (mapcar 'cl--compile-time-too (cdr form))))
+ ((eq (car-safe form) 'cl-eval-when)
(let ((when (nth 1 form)))
(if (or (memq 'eval when) (memq :execute when))
- (list* 'eval-when (cons 'compile when) (cddr form))
+ `(cl-eval-when (compile ,@when) ,@(cddr form))
form)))
(t (eval form) form)))
;;;###autoload
-(defmacro load-time-value (form &optional read-only)
+(defmacro cl-load-time-value (form &optional _read-only)
"Like `progn', but evaluates the body at load time.
The result of the body appears to the compiler as a quoted constant."
- (if (cl-compiling-file)
- (let* ((temp (gentemp "--cl-load-time--"))
- (set (list 'set (list 'quote temp) form)))
+ (declare (debug (form &optional sexp)))
+ (if (cl--compiling-file)
+ (let* ((temp (cl-gentemp "--cl-load-time--"))
+ (set `(set ',temp ,form)))
(if (and (fboundp 'byte-compile-file-form-defmumble)
(boundp 'this-kind) (boundp 'that-one))
(fset 'byte-compile-file-form
- (list 'lambda '(form)
- (list 'fset '(quote byte-compile-file-form)
- (list 'quote
- (symbol-function 'byte-compile-file-form)))
- (list 'byte-compile-file-form (list 'quote set))
- '(byte-compile-file-form form)))
+ `(lambda (form)
+ (fset 'byte-compile-file-form
+ ',(symbol-function 'byte-compile-file-form))
+ (byte-compile-file-form ',set)
+ (byte-compile-file-form form)))
(print set (symbol-value 'byte-compile--outbuffer)))
- (list 'symbol-value (list 'quote temp)))
- (list 'quote (eval form))))
+ `(symbol-value ',temp))
+ `',(eval form)))
;;; Conditional control structures.
;;;###autoload
-(defmacro case (expr &rest clauses)
+(defmacro cl-case (expr &rest clauses)
"Eval EXPR and choose among clauses on that value.
Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared
against each key in each KEYLIST; the corresponding BODY is evaluated.
-If no clause succeeds, case returns nil. A single atom may be used in
+If no clause succeeds, cl-case returns nil. A single atom may be used in
place of a KEYLIST of one atom. A KEYLIST of t or `otherwise' is
allowed only in the final clause, and matches if no other keys match.
Key values are compared by `eql'.
\n(fn EXPR (KEYLIST BODY...)...)"
- (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
+ (declare (indent 1) (debug (form &rest (sexp body))))
+ (let* ((temp (if (cl--simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
(head-list nil)
(body (cons
'cond
@@ -550,39 +646,42 @@ Key values are compared by `eql'.
(function
(lambda (c)
(cons (cond ((memq (car c) '(t otherwise)) t)
- ((eq (car c) 'ecase-error-flag)
- (list 'error "ecase failed: %s, %s"
- temp (list 'quote (reverse head-list))))
+ ((eq (car c) 'cl--ecase-error-flag)
+ `(error "cl-ecase failed: %s, %s"
+ ,temp ',(reverse head-list)))
((listp (car c))
(setq head-list (append (car c) head-list))
- (list 'member* temp (list 'quote (car c))))
+ `(cl-member ,temp ',(car c)))
(t
(if (memq (car c) head-list)
(error "Duplicate key in case: %s"
(car c)))
(push (car c) head-list)
- (list 'eql temp (list 'quote (car c)))))
+ `(eql ,temp ',(car c))))
(or (cdr c) '(nil)))))
clauses))))
(if (eq temp expr) body
- (list 'let (list (list temp expr)) body))))
+ `(let ((,temp ,expr)) ,body))))
;;;###autoload
-(defmacro ecase (expr &rest clauses)
- "Like `case', but error if no case fits.
+(defmacro cl-ecase (expr &rest clauses)
+ "Like `cl-case', but error if no case fits.
`otherwise'-clauses are not allowed.
\n(fn EXPR (KEYLIST BODY...)...)"
- (list* 'case expr (append clauses '((ecase-error-flag)))))
+ (declare (indent 1) (debug cl-case))
+ `(cl-case ,expr ,@clauses (cl--ecase-error-flag)))
;;;###autoload
-(defmacro typecase (expr &rest clauses)
+(defmacro cl-typecase (expr &rest clauses)
"Evals EXPR, chooses among clauses on that value.
Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it
satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds,
-typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
+cl-typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
final clause, and matches if no other keys match.
\n(fn EXPR (TYPE BODY...)...)"
- (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
+ (declare (indent 1)
+ (debug (form &rest ([&or cl-type-spec "otherwise"] body))))
+ (let* ((temp (if (cl--simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
(type-list nil)
(body (cons
'cond
@@ -590,70 +689,75 @@ final clause, and matches if no other keys match.
(function
(lambda (c)
(cons (cond ((eq (car c) 'otherwise) t)
- ((eq (car c) 'ecase-error-flag)
- (list 'error "etypecase failed: %s, %s"
- temp (list 'quote (reverse type-list))))
+ ((eq (car c) 'cl--ecase-error-flag)
+ `(error "cl-etypecase failed: %s, %s"
+ ,temp ',(reverse type-list)))
(t
(push (car c) type-list)
- (cl-make-type-test temp (car c))))
+ (cl--make-type-test temp (car c))))
(or (cdr c) '(nil)))))
clauses))))
(if (eq temp expr) body
- (list 'let (list (list temp expr)) body))))
+ `(let ((,temp ,expr)) ,body))))
;;;###autoload
-(defmacro etypecase (expr &rest clauses)
- "Like `typecase', but error if no case fits.
+(defmacro cl-etypecase (expr &rest clauses)
+ "Like `cl-typecase', but error if no case fits.
`otherwise'-clauses are not allowed.
\n(fn EXPR (TYPE BODY...)...)"
- (list* 'typecase expr (append clauses '((ecase-error-flag)))))
+ (declare (indent 1) (debug cl-typecase))
+ `(cl-typecase ,expr ,@clauses (cl--ecase-error-flag)))
;;; Blocks and exits.
;;;###autoload
-(defmacro block (name &rest body)
+(defmacro cl-block (name &rest body)
"Define a lexically-scoped block named NAME.
-NAME may be any symbol. Code inside the BODY forms can call `return-from'
+NAME may be any symbol. Code inside the BODY forms can call `cl-return-from'
to jump prematurely out of the block. This differs from `catch' and `throw'
in two respects: First, the NAME is an unevaluated symbol rather than a
quoted symbol or other form; and second, NAME is lexically rather than
dynamically scoped: Only references to it within BODY will work. These
references may appear inside macro expansions, but not inside functions
called from BODY."
- (if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body)
- (list 'cl-block-wrapper
- (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name)))
- body))))
+ (declare (indent 1) (debug (symbolp body)))
+ (if (cl--safe-expr-p `(progn ,@body)) `(progn ,@body)
+ `(cl--block-wrapper
+ (catch ',(intern (format "--cl-block-%s--" name))
+ ,@body))))
;;;###autoload
-(defmacro return (&optional result)
+(defmacro cl-return (&optional result)
"Return from the block named nil.
-This is equivalent to `(return-from nil RESULT)'."
- (list 'return-from nil result))
+This is equivalent to `(cl-return-from nil RESULT)'."
+ (declare (debug (&optional form)))
+ `(cl-return-from nil ,result))
;;;###autoload
-(defmacro return-from (name &optional result)
+(defmacro cl-return-from (name &optional result)
"Return from the block named NAME.
-This jumps out to the innermost enclosing `(block NAME ...)' form,
+This jumps out to the innermost enclosing `(cl-block NAME ...)' form,
returning RESULT from that form (or nil if RESULT is omitted).
This is compatible with Common Lisp, but note that `defun' and
`defmacro' do not create implicit blocks as they do in Common Lisp."
+ (declare (indent 1) (debug (symbolp &optional form)))
(let ((name2 (intern (format "--cl-block-%s--" name))))
- (list 'cl-block-throw (list 'quote name2) result)))
+ `(cl--block-throw ',name2 ,result)))
-;;; The "loop" macro.
+;;; The "cl-loop" macro.
-(defvar loop-args) (defvar loop-accum-var) (defvar loop-accum-vars)
-(defvar loop-bindings) (defvar loop-body) (defvar loop-destr-temps)
-(defvar loop-finally) (defvar loop-finish-flag) (defvar loop-first-flag)
-(defvar loop-initially) (defvar loop-map-form) (defvar loop-name)
-(defvar loop-result) (defvar loop-result-explicit)
-(defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs)
+(defvar cl--loop-args) (defvar cl--loop-accum-var) (defvar cl--loop-accum-vars)
+(defvar cl--loop-bindings) (defvar cl--loop-body) (defvar cl--loop-destr-temps)
+(defvar cl--loop-finally) (defvar cl--loop-finish-flag)
+(defvar cl--loop-first-flag)
+(defvar cl--loop-initially) (defvar cl--loop-map-form) (defvar cl--loop-name)
+(defvar cl--loop-result) (defvar cl--loop-result-explicit)
+(defvar cl--loop-result-var) (defvar cl--loop-steps) (defvar cl--loop-symbol-macs)
;;;###autoload
-(defmacro loop (&rest loop-args)
+(defmacro cl-loop (&rest loop-args)
"The Common Lisp `loop' macro.
Valid clauses are:
for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
@@ -668,119 +772,286 @@ Valid clauses are:
finally return EXPR, named NAME.
\(fn CLAUSE...)"
- (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list loop-args))))))
- (list 'block nil (list* 'while t loop-args))
- (let ((loop-name nil) (loop-bindings nil)
- (loop-body nil) (loop-steps nil)
- (loop-result nil) (loop-result-explicit nil)
- (loop-result-var nil) (loop-finish-flag nil)
- (loop-accum-var nil) (loop-accum-vars nil)
- (loop-initially nil) (loop-finally nil)
- (loop-map-form nil) (loop-first-flag nil)
- (loop-destr-temps nil) (loop-symbol-macs nil))
- (setq loop-args (append loop-args '(cl-end-loop)))
- (while (not (eq (car loop-args) 'cl-end-loop)) (cl-parse-loop-clause))
- (if loop-finish-flag
- (push `((,loop-finish-flag t)) loop-bindings))
- (if loop-first-flag
- (progn (push `((,loop-first-flag t)) loop-bindings)
- (push `(setq ,loop-first-flag nil) loop-steps)))
- (let* ((epilogue (nconc (nreverse loop-finally)
- (list (or loop-result-explicit loop-result))))
- (ands (cl-loop-build-ands (nreverse loop-body)))
- (while-body (nconc (cadr ands) (nreverse loop-steps)))
+ (declare (debug (&rest &or
+ ;; These are usually followed by a symbol, but it can
+ ;; actually be any destructuring-bind pattern, which
+ ;; would erroneously match `form'.
+ [[&or "for" "as" "with" "and"] sexp]
+ ;; These are followed by expressions which could
+ ;; erroneously match `symbolp'.
+ [[&or "from" "upfrom" "downfrom" "to" "upto" "downto"
+ "above" "below" "by" "in" "on" "=" "across"
+ "repeat" "while" "until" "always" "never"
+ "thereis" "collect" "append" "nconc" "sum"
+ "count" "maximize" "minimize" "if" "unless"
+ "return"] form]
+ ;; Simple default, which covers 99% of the cases.
+ symbolp form)))
+ (if (not (memq t (mapcar 'symbolp (delq nil (delq t (cl-copy-list loop-args))))))
+ `(cl-block nil (while t ,@loop-args))
+ (let ((cl--loop-args loop-args) (cl--loop-name nil) (cl--loop-bindings nil)
+ (cl--loop-body nil) (cl--loop-steps nil)
+ (cl--loop-result nil) (cl--loop-result-explicit nil)
+ (cl--loop-result-var nil) (cl--loop-finish-flag nil)
+ (cl--loop-accum-var nil) (cl--loop-accum-vars nil)
+ (cl--loop-initially nil) (cl--loop-finally nil)
+ (cl--loop-map-form nil) (cl--loop-first-flag nil)
+ (cl--loop-destr-temps nil) (cl--loop-symbol-macs nil))
+ (setq cl--loop-args (append cl--loop-args '(cl-end-loop)))
+ (while (not (eq (car cl--loop-args) 'cl-end-loop)) (cl-parse-loop-clause))
+ (if cl--loop-finish-flag
+ (push `((,cl--loop-finish-flag t)) cl--loop-bindings))
+ (if cl--loop-first-flag
+ (progn (push `((,cl--loop-first-flag t)) cl--loop-bindings)
+ (push `(setq ,cl--loop-first-flag nil) cl--loop-steps)))
+ (let* ((epilogue (nconc (nreverse cl--loop-finally)
+ (list (or cl--loop-result-explicit cl--loop-result))))
+ (ands (cl--loop-build-ands (nreverse cl--loop-body)))
+ (while-body (nconc (cadr ands) (nreverse cl--loop-steps)))
(body (append
- (nreverse loop-initially)
- (list (if loop-map-form
- (list 'block '--cl-finish--
- (subst
- (if (eq (car ands) t) while-body
- (cons `(or ,(car ands)
- (return-from --cl-finish--
- nil))
- while-body))
- '--cl-map loop-map-form))
- (list* 'while (car ands) while-body)))
- (if loop-finish-flag
- (if (equal epilogue '(nil)) (list loop-result-var)
- `((if ,loop-finish-flag
- (progn ,@epilogue) ,loop-result-var)))
+ (nreverse cl--loop-initially)
+ (list (if cl--loop-map-form
+ `(cl-block --cl-finish--
+ ,(cl-subst
+ (if (eq (car ands) t) while-body
+ (cons `(or ,(car ands)
+ (cl-return-from --cl-finish--
+ nil))
+ while-body))
+ '--cl-map cl--loop-map-form))
+ `(while ,(car ands) ,@while-body)))
+ (if cl--loop-finish-flag
+ (if (equal epilogue '(nil)) (list cl--loop-result-var)
+ `((if ,cl--loop-finish-flag
+ (progn ,@epilogue) ,cl--loop-result-var)))
epilogue))))
- (if loop-result-var (push (list loop-result-var) loop-bindings))
- (while loop-bindings
- (if (cdar loop-bindings)
- (setq body (list (cl-loop-let (pop loop-bindings) body t)))
+ (if cl--loop-result-var (push (list cl--loop-result-var) cl--loop-bindings))
+ (while cl--loop-bindings
+ (if (cdar cl--loop-bindings)
+ (setq body (list (cl--loop-let (pop cl--loop-bindings) body t)))
(let ((lets nil))
- (while (and loop-bindings
- (not (cdar loop-bindings)))
- (push (car (pop loop-bindings)) lets))
- (setq body (list (cl-loop-let lets body nil))))))
- (if loop-symbol-macs
- (setq body (list (list* 'symbol-macrolet loop-symbol-macs body))))
- (list* 'block loop-name body)))))
+ (while (and cl--loop-bindings
+ (not (cdar cl--loop-bindings)))
+ (push (car (pop cl--loop-bindings)) lets))
+ (setq body (list (cl--loop-let lets body nil))))))
+ (if cl--loop-symbol-macs
+ (setq body (list `(cl-symbol-macrolet ,cl--loop-symbol-macs ,@body))))
+ `(cl-block ,cl--loop-name ,@body)))))
+
+;; Below is a complete spec for cl-loop, in several parts that correspond
+;; to the syntax given in CLtL2. The specs do more than specify where
+;; the forms are; it also specifies, as much as Edebug allows, all the
+;; syntactically valid cl-loop clauses. The disadvantage of this
+;; completeness is rigidity, but the "for ... being" clause allows
+;; arbitrary extensions of the form: [symbolp &rest &or symbolp form].
+
+;; (def-edebug-spec cl-loop
+;; ([&optional ["named" symbolp]]
+;; [&rest
+;; &or
+;; ["repeat" form]
+;; loop-for-as
+;; loop-with
+;; loop-initial-final]
+;; [&rest loop-clause]
+;; ))
+
+;; (def-edebug-spec loop-with
+;; ("with" loop-var
+;; loop-type-spec
+;; [&optional ["=" form]]
+;; &rest ["and" loop-var
+;; loop-type-spec
+;; [&optional ["=" form]]]))
+
+;; (def-edebug-spec loop-for-as
+;; ([&or "for" "as"] loop-for-as-subclause
+;; &rest ["and" loop-for-as-subclause]))
+
+;; (def-edebug-spec loop-for-as-subclause
+;; (loop-var
+;; loop-type-spec
+;; &or
+;; [[&or "in" "on" "in-ref" "across-ref"]
+;; form &optional ["by" function-form]]
+
+;; ["=" form &optional ["then" form]]
+;; ["across" form]
+;; ["being"
+;; [&or "the" "each"]
+;; &or
+;; [[&or "element" "elements"]
+;; [&or "of" "in" "of-ref"] form
+;; &optional "using" ["index" symbolp]];; is this right?
+;; [[&or "hash-key" "hash-keys"
+;; "hash-value" "hash-values"]
+;; [&or "of" "in"]
+;; hash-table-p &optional ["using" ([&or "hash-value" "hash-values"
+;; "hash-key" "hash-keys"] sexp)]]
+
+;; [[&or "symbol" "present-symbol" "external-symbol"
+;; "symbols" "present-symbols" "external-symbols"]
+;; [&or "in" "of"] package-p]
+
+;; ;; Extensions for Emacs Lisp, including Lucid Emacs.
+;; [[&or "frame" "frames"
+;; "screen" "screens"
+;; "buffer" "buffers"]]
+
+;; [[&or "window" "windows"]
+;; [&or "of" "in"] form]
+
+;; [[&or "overlay" "overlays"
+;; "extent" "extents"]
+;; [&or "of" "in"] form
+;; &optional [[&or "from" "to"] form]]
+
+;; [[&or "interval" "intervals"]
+;; [&or "in" "of"] form
+;; &optional [[&or "from" "to"] form]
+;; ["property" form]]
+
+;; [[&or "key-code" "key-codes"
+;; "key-seq" "key-seqs"
+;; "key-binding" "key-bindings"]
+;; [&or "in" "of"] form
+;; &optional ["using" ([&or "key-code" "key-codes"
+;; "key-seq" "key-seqs"
+;; "key-binding" "key-bindings"]
+;; sexp)]]
+;; ;; For arbitrary extensions, recognize anything else.
+;; [symbolp &rest &or symbolp form]
+;; ]
+
+;; ;; arithmetic - must be last since all parts are optional.
+;; [[&optional [[&or "from" "downfrom" "upfrom"] form]]
+;; [&optional [[&or "to" "downto" "upto" "below" "above"] form]]
+;; [&optional ["by" form]]
+;; ]))
+
+;; (def-edebug-spec loop-initial-final
+;; (&or ["initially"
+;; ;; [&optional &or "do" "doing"] ;; CLtL2 doesn't allow this.
+;; &rest loop-non-atomic-expr]
+;; ["finally" &or
+;; [[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
+;; ["return" form]]))
+
+;; (def-edebug-spec loop-and-clause
+;; (loop-clause &rest ["and" loop-clause]))
+
+;; (def-edebug-spec loop-clause
+;; (&or
+;; [[&or "while" "until" "always" "never" "thereis"] form]
+
+;; [[&or "collect" "collecting"
+;; "append" "appending"
+;; "nconc" "nconcing"
+;; "concat" "vconcat"] form
+;; [&optional ["into" loop-var]]]
+
+;; [[&or "count" "counting"
+;; "sum" "summing"
+;; "maximize" "maximizing"
+;; "minimize" "minimizing"] form
+;; [&optional ["into" loop-var]]
+;; loop-type-spec]
+
+;; [[&or "if" "when" "unless"]
+;; form loop-and-clause
+;; [&optional ["else" loop-and-clause]]
+;; [&optional "end"]]
+
+;; [[&or "do" "doing"] &rest loop-non-atomic-expr]
+
+;; ["return" form]
+;; loop-initial-final
+;; ))
+
+;; (def-edebug-spec loop-non-atomic-expr
+;; ([&not atom] form))
+
+;; (def-edebug-spec loop-var
+;; ;; The symbolp must be last alternative to recognize e.g. (a b . c)
+;; ;; loop-var =>
+;; ;; (loop-var . [&or nil loop-var])
+;; ;; (symbolp . [&or nil loop-var])
+;; ;; (symbolp . loop-var)
+;; ;; (symbolp . (symbolp . [&or nil loop-var]))
+;; ;; (symbolp . (symbolp . loop-var))
+;; ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp)
+;; (&or (loop-var . [&or nil loop-var]) [gate symbolp]))
+
+;; (def-edebug-spec loop-type-spec
+;; (&optional ["of-type" loop-d-type-spec]))
+
+;; (def-edebug-spec loop-d-type-spec
+;; (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
+
+
(defun cl-parse-loop-clause () ; uses loop-*
- (let ((word (pop loop-args))
+ (let ((word (pop cl--loop-args))
(hash-types '(hash-key hash-keys hash-value hash-values))
(key-types '(key-code key-codes key-seq key-seqs
key-binding key-bindings)))
(cond
- ((null loop-args)
- (error "Malformed `loop' macro"))
+ ((null cl--loop-args)
+ (error "Malformed `cl-loop' macro"))
((eq word 'named)
- (setq loop-name (pop loop-args)))
+ (setq cl--loop-name (pop cl--loop-args)))
((eq word 'initially)
- (if (memq (car loop-args) '(do doing)) (pop loop-args))
- (or (consp (car loop-args)) (error "Syntax error on `initially' clause"))
- (while (consp (car loop-args))
- (push (pop loop-args) loop-initially)))
+ (if (memq (car cl--loop-args) '(do doing)) (pop cl--loop-args))
+ (or (consp (car cl--loop-args)) (error "Syntax error on `initially' clause"))
+ (while (consp (car cl--loop-args))
+ (push (pop cl--loop-args) cl--loop-initially)))
((eq word 'finally)
- (if (eq (car loop-args) 'return)
- (setq loop-result-explicit (or (cl-pop2 loop-args) '(quote nil)))
- (if (memq (car loop-args) '(do doing)) (pop loop-args))
- (or (consp (car loop-args)) (error "Syntax error on `finally' clause"))
- (if (and (eq (caar loop-args) 'return) (null loop-name))
- (setq loop-result-explicit (or (nth 1 (pop loop-args)) '(quote nil)))
- (while (consp (car loop-args))
- (push (pop loop-args) loop-finally)))))
+ (if (eq (car cl--loop-args) 'return)
+ (setq cl--loop-result-explicit (or (cl-pop2 cl--loop-args) '(quote nil)))
+ (if (memq (car cl--loop-args) '(do doing)) (pop cl--loop-args))
+ (or (consp (car cl--loop-args)) (error "Syntax error on `finally' clause"))
+ (if (and (eq (caar cl--loop-args) 'return) (null cl--loop-name))
+ (setq cl--loop-result-explicit (or (nth 1 (pop cl--loop-args)) '(quote nil)))
+ (while (consp (car cl--loop-args))
+ (push (pop cl--loop-args) cl--loop-finally)))))
((memq word '(for as))
(let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil)
(ands nil))
(while
- ;; Use `gensym' rather than `make-symbol'. It's important that
+ ;; Use `cl-gensym' rather than `make-symbol'. It's important that
;; (not (eq (symbol-name var1) (symbol-name var2))) because
- ;; these vars get added to the cl-macro-environment.
- (let ((var (or (pop loop-args) (gensym "--cl-var--"))))
- (setq word (pop loop-args))
- (if (eq word 'being) (setq word (pop loop-args)))
- (if (memq word '(the each)) (setq word (pop loop-args)))
+ ;; these vars get added to the macro-environment.
+ (let ((var (or (pop cl--loop-args) (cl-gensym "--cl-var--"))))
+ (setq word (pop cl--loop-args))
+ (if (eq word 'being) (setq word (pop cl--loop-args)))
+ (if (memq word '(the each)) (setq word (pop cl--loop-args)))
(if (memq word '(buffer buffers))
- (setq word 'in loop-args (cons '(buffer-list) loop-args)))
+ (setq word 'in cl--loop-args (cons '(buffer-list) cl--loop-args)))
(cond
((memq word '(from downfrom upfrom to downto upto
above below by))
- (push word loop-args)
- (if (memq (car loop-args) '(downto above))
- (error "Must specify `from' value for downward loop"))
- (let* ((down (or (eq (car loop-args) 'downfrom)
- (memq (caddr loop-args) '(downto above))))
- (excl (or (memq (car loop-args) '(above below))
- (memq (caddr loop-args) '(above below))))
- (start (and (memq (car loop-args) '(from upfrom downfrom))
- (cl-pop2 loop-args)))
- (end (and (memq (car loop-args)
+ (push word cl--loop-args)
+ (if (memq (car cl--loop-args) '(downto above))
+ (error "Must specify `from' value for downward cl-loop"))
+ (let* ((down (or (eq (car cl--loop-args) 'downfrom)
+ (memq (cl-caddr cl--loop-args) '(downto above))))
+ (excl (or (memq (car cl--loop-args) '(above below))
+ (memq (cl-caddr cl--loop-args) '(above below))))
+ (start (and (memq (car cl--loop-args) '(from upfrom downfrom))
+ (cl-pop2 cl--loop-args)))
+ (end (and (memq (car cl--loop-args)
'(to upto downto above below))
- (cl-pop2 loop-args)))
- (step (and (eq (car loop-args) 'by) (cl-pop2 loop-args)))
- (end-var (and (not (cl-const-expr-p end))
+ (cl-pop2 cl--loop-args)))
+ (step (and (eq (car cl--loop-args) 'by) (cl-pop2 cl--loop-args)))
+ (end-var (and (not (macroexp-const-p end))
(make-symbol "--cl-var--")))
- (step-var (and (not (cl-const-expr-p step))
+ (step-var (and (not (macroexp-const-p step))
(make-symbol "--cl-var--"))))
(and step (numberp step) (<= step 0)
(error "Loop `by' value is not positive: %s" step))
@@ -791,7 +1062,7 @@ Valid clauses are:
(if end
(push (list
(if down (if excl '> '>=) (if excl '< '<=))
- var (or end-var end)) loop-body))
+ var (or end-var end)) cl--loop-body))
(push (list var (list (if down '- '+) var
(or step-var step 1)))
loop-for-steps)))
@@ -800,44 +1071,44 @@ Valid clauses are:
(let* ((on (eq word 'on))
(temp (if (and on (symbolp var))
var (make-symbol "--cl-var--"))))
- (push (list temp (pop loop-args)) loop-for-bindings)
- (push (list 'consp temp) loop-body)
+ (push (list temp (pop cl--loop-args)) loop-for-bindings)
+ (push `(consp ,temp) cl--loop-body)
(if (eq word 'in-ref)
- (push (list var (list 'car temp)) loop-symbol-macs)
+ (push (list var `(car ,temp)) cl--loop-symbol-macs)
(or (eq temp var)
(progn
(push (list var nil) loop-for-bindings)
- (push (list var (if on temp (list 'car temp)))
+ (push (list var (if on temp `(car ,temp)))
loop-for-sets))))
(push (list temp
- (if (eq (car loop-args) 'by)
- (let ((step (cl-pop2 loop-args)))
+ (if (eq (car cl--loop-args) 'by)
+ (let ((step (cl-pop2 cl--loop-args)))
(if (and (memq (car-safe step)
'(quote function
- function*))
+ cl-function))
(symbolp (nth 1 step)))
(list (nth 1 step) temp)
- (list 'funcall step temp)))
- (list 'cdr temp)))
+ `(funcall ,step ,temp)))
+ `(cdr ,temp)))
loop-for-steps)))
((eq word '=)
- (let* ((start (pop loop-args))
- (then (if (eq (car loop-args) 'then) (cl-pop2 loop-args) start)))
+ (let* ((start (pop cl--loop-args))
+ (then (if (eq (car cl--loop-args) 'then) (cl-pop2 cl--loop-args) start)))
(push (list var nil) loop-for-bindings)
- (if (or ands (eq (car loop-args) 'and))
+ (if (or ands (eq (car cl--loop-args) 'and))
(progn
(push `(,var
- (if ,(or loop-first-flag
- (setq loop-first-flag
+ (if ,(or cl--loop-first-flag
+ (setq cl--loop-first-flag
(make-symbol "--cl-var--")))
,start ,var))
loop-for-sets)
(push (list var then) loop-for-steps))
(push (list var
(if (eq start then) start
- `(if ,(or loop-first-flag
- (setq loop-first-flag
+ `(if ,(or cl--loop-first-flag
+ (setq cl--loop-first-flag
(make-symbol "--cl-var--")))
,start ,then)))
loop-for-sets))))
@@ -845,80 +1116,79 @@ Valid clauses are:
((memq word '(across across-ref))
(let ((temp-vec (make-symbol "--cl-vec--"))
(temp-idx (make-symbol "--cl-idx--")))
- (push (list temp-vec (pop loop-args)) loop-for-bindings)
+ (push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
(push (list temp-idx -1) loop-for-bindings)
- (push (list '< (list 'setq temp-idx (list '1+ temp-idx))
- (list 'length temp-vec)) loop-body)
+ (push `(< (setq ,temp-idx (1+ ,temp-idx))
+ (length ,temp-vec)) cl--loop-body)
(if (eq word 'across-ref)
- (push (list var (list 'aref temp-vec temp-idx))
- loop-symbol-macs)
+ (push (list var `(aref ,temp-vec ,temp-idx))
+ cl--loop-symbol-macs)
(push (list var nil) loop-for-bindings)
- (push (list var (list 'aref temp-vec temp-idx))
+ (push (list var `(aref ,temp-vec ,temp-idx))
loop-for-sets))))
((memq word '(element elements))
- (let ((ref (or (memq (car loop-args) '(in-ref of-ref))
- (and (not (memq (car loop-args) '(in of)))
+ (let ((ref (or (memq (car cl--loop-args) '(in-ref of-ref))
+ (and (not (memq (car cl--loop-args) '(in of)))
(error "Expected `of'"))))
- (seq (cl-pop2 loop-args))
+ (seq (cl-pop2 cl--loop-args))
(temp-seq (make-symbol "--cl-seq--"))
- (temp-idx (if (eq (car loop-args) 'using)
- (if (and (= (length (cadr loop-args)) 2)
- (eq (caadr loop-args) 'index))
- (cadr (cl-pop2 loop-args))
+ (temp-idx (if (eq (car cl--loop-args) 'using)
+ (if (and (= (length (cadr cl--loop-args)) 2)
+ (eq (cl-caadr cl--loop-args) 'index))
+ (cadr (cl-pop2 cl--loop-args))
(error "Bad `using' clause"))
(make-symbol "--cl-idx--"))))
(push (list temp-seq seq) loop-for-bindings)
(push (list temp-idx 0) loop-for-bindings)
(if ref
(let ((temp-len (make-symbol "--cl-len--")))
- (push (list temp-len (list 'length temp-seq))
+ (push (list temp-len `(length ,temp-seq))
loop-for-bindings)
- (push (list var (list 'elt temp-seq temp-idx))
- loop-symbol-macs)
- (push (list '< temp-idx temp-len) loop-body))
+ (push (list var `(elt ,temp-seq ,temp-idx))
+ cl--loop-symbol-macs)
+ (push `(< ,temp-idx ,temp-len) cl--loop-body))
(push (list var nil) loop-for-bindings)
- (push (list 'and temp-seq
- (list 'or (list 'consp temp-seq)
- (list '< temp-idx
- (list 'length temp-seq))))
- loop-body)
- (push (list var (list 'if (list 'consp temp-seq)
- (list 'pop temp-seq)
- (list 'aref temp-seq temp-idx)))
+ (push `(and ,temp-seq
+ (or (consp ,temp-seq)
+ (< ,temp-idx (length ,temp-seq))))
+ cl--loop-body)
+ (push (list var `(if (consp ,temp-seq)
+ (pop ,temp-seq)
+ (aref ,temp-seq ,temp-idx)))
loop-for-sets))
- (push (list temp-idx (list '1+ temp-idx))
+ (push (list temp-idx `(1+ ,temp-idx))
loop-for-steps)))
((memq word hash-types)
- (or (memq (car loop-args) '(in of)) (error "Expected `of'"))
- (let* ((table (cl-pop2 loop-args))
- (other (if (eq (car loop-args) 'using)
- (if (and (= (length (cadr loop-args)) 2)
- (memq (caadr loop-args) hash-types)
- (not (eq (caadr loop-args) word)))
- (cadr (cl-pop2 loop-args))
+ (or (memq (car cl--loop-args) '(in of)) (error "Expected `of'"))
+ (let* ((table (cl-pop2 cl--loop-args))
+ (other (if (eq (car cl--loop-args) 'using)
+ (if (and (= (length (cadr cl--loop-args)) 2)
+ (memq (cl-caadr cl--loop-args) hash-types)
+ (not (eq (cl-caadr cl--loop-args) word)))
+ (cadr (cl-pop2 cl--loop-args))
(error "Bad `using' clause"))
(make-symbol "--cl-var--"))))
(if (memq word '(hash-value hash-values))
(setq var (prog1 other (setq other var))))
- (setq loop-map-form
+ (setq cl--loop-map-form
`(maphash (lambda (,var ,other) . --cl-map) ,table))))
((memq word '(symbol present-symbol external-symbol
symbols present-symbols external-symbols))
- (let ((ob (and (memq (car loop-args) '(in of)) (cl-pop2 loop-args))))
- (setq loop-map-form
+ (let ((ob (and (memq (car cl--loop-args) '(in of)) (cl-pop2 cl--loop-args))))
+ (setq cl--loop-map-form
`(mapatoms (lambda (,var) . --cl-map) ,ob))))
((memq word '(overlay overlays extent extents))
(let ((buf nil) (from nil) (to nil))
- (while (memq (car loop-args) '(in of from to))
- (cond ((eq (car loop-args) 'from) (setq from (cl-pop2 loop-args)))
- ((eq (car loop-args) 'to) (setq to (cl-pop2 loop-args)))
- (t (setq buf (cl-pop2 loop-args)))))
- (setq loop-map-form
- `(cl-map-extents
+ (while (memq (car cl--loop-args) '(in of from to))
+ (cond ((eq (car cl--loop-args) 'from) (setq from (cl-pop2 cl--loop-args)))
+ ((eq (car cl--loop-args) 'to) (setq to (cl-pop2 cl--loop-args)))
+ (t (setq buf (cl-pop2 cl--loop-args)))))
+ (setq cl--loop-map-form
+ `(cl--map-overlays
(lambda (,var ,(make-symbol "--cl-var--"))
(progn . --cl-map) nil)
,buf ,from ,to))))
@@ -927,246 +1197,248 @@ Valid clauses are:
(let ((buf nil) (prop nil) (from nil) (to nil)
(var1 (make-symbol "--cl-var1--"))
(var2 (make-symbol "--cl-var2--")))
- (while (memq (car loop-args) '(in of property from to))
- (cond ((eq (car loop-args) 'from) (setq from (cl-pop2 loop-args)))
- ((eq (car loop-args) 'to) (setq to (cl-pop2 loop-args)))
- ((eq (car loop-args) 'property)
- (setq prop (cl-pop2 loop-args)))
- (t (setq buf (cl-pop2 loop-args)))))
+ (while (memq (car cl--loop-args) '(in of property from to))
+ (cond ((eq (car cl--loop-args) 'from) (setq from (cl-pop2 cl--loop-args)))
+ ((eq (car cl--loop-args) 'to) (setq to (cl-pop2 cl--loop-args)))
+ ((eq (car cl--loop-args) 'property)
+ (setq prop (cl-pop2 cl--loop-args)))
+ (t (setq buf (cl-pop2 cl--loop-args)))))
(if (and (consp var) (symbolp (car var)) (symbolp (cdr var)))
(setq var1 (car var) var2 (cdr var))
- (push (list var (list 'cons var1 var2)) loop-for-sets))
- (setq loop-map-form
- `(cl-map-intervals
+ (push (list var `(cons ,var1 ,var2)) loop-for-sets))
+ (setq cl--loop-map-form
+ `(cl--map-intervals
(lambda (,var1 ,var2) . --cl-map)
,buf ,prop ,from ,to))))
((memq word key-types)
- (or (memq (car loop-args) '(in of)) (error "Expected `of'"))
- (let ((map (cl-pop2 loop-args))
- (other (if (eq (car loop-args) 'using)
- (if (and (= (length (cadr loop-args)) 2)
- (memq (caadr loop-args) key-types)
- (not (eq (caadr loop-args) word)))
- (cadr (cl-pop2 loop-args))
+ (or (memq (car cl--loop-args) '(in of)) (error "Expected `of'"))
+ (let ((cl-map (cl-pop2 cl--loop-args))
+ (other (if (eq (car cl--loop-args) 'using)
+ (if (and (= (length (cadr cl--loop-args)) 2)
+ (memq (cl-caadr cl--loop-args) key-types)
+ (not (eq (cl-caadr cl--loop-args) word)))
+ (cadr (cl-pop2 cl--loop-args))
(error "Bad `using' clause"))
(make-symbol "--cl-var--"))))
(if (memq word '(key-binding key-bindings))
(setq var (prog1 other (setq other var))))
- (setq loop-map-form
+ (setq cl--loop-map-form
`(,(if (memq word '(key-seq key-seqs))
- 'cl-map-keymap-recursively 'map-keymap)
- (lambda (,var ,other) . --cl-map) ,map))))
+ 'cl--map-keymap-recursively 'map-keymap)
+ (lambda (,var ,other) . --cl-map) ,cl-map))))
((memq word '(frame frames screen screens))
(let ((temp (make-symbol "--cl-var--")))
(push (list var '(selected-frame))
loop-for-bindings)
(push (list temp nil) loop-for-bindings)
- (push (list 'prog1 (list 'not (list 'eq var temp))
- (list 'or temp (list 'setq temp var)))
- loop-body)
- (push (list var (list 'next-frame var))
+ (push `(prog1 (not (eq ,var ,temp))
+ (or ,temp (setq ,temp ,var)))
+ cl--loop-body)
+ (push (list var `(next-frame ,var))
loop-for-steps)))
((memq word '(window windows))
- (let ((scr (and (memq (car loop-args) '(in of)) (cl-pop2 loop-args)))
+ (let ((scr (and (memq (car cl--loop-args) '(in of)) (cl-pop2 cl--loop-args)))
(temp (make-symbol "--cl-var--"))
(minip (make-symbol "--cl-minip--")))
(push (list var (if scr
- (list 'frame-selected-window scr)
+ `(frame-selected-window ,scr)
'(selected-window)))
loop-for-bindings)
;; If we started in the minibuffer, we need to
;; ensure that next-window will bring us back there
;; at some point. (Bug#7492).
- ;; (Consider using walk-windows instead of loop if
+ ;; (Consider using walk-windows instead of cl-loop if
;; you care about such things.)
(push (list minip `(minibufferp (window-buffer ,var)))
loop-for-bindings)
(push (list temp nil) loop-for-bindings)
- (push (list 'prog1 (list 'not (list 'eq var temp))
- (list 'or temp (list 'setq temp var)))
- loop-body)
- (push (list var (list 'next-window var minip))
+ (push `(prog1 (not (eq ,var ,temp))
+ (or ,temp (setq ,temp ,var)))
+ cl--loop-body)
+ (push (list var `(next-window ,var ,minip))
loop-for-steps)))
(t
+ ;; This is an advertised interface: (info "(cl)Other Clauses").
(let ((handler (and (symbolp word)
(get word 'cl-loop-for-handler))))
(if handler
(funcall handler var)
(error "Expected a `for' preposition, found %s" word)))))
- (eq (car loop-args) 'and))
+ (eq (car cl--loop-args) 'and))
(setq ands t)
- (pop loop-args))
+ (pop cl--loop-args))
(if (and ands loop-for-bindings)
- (push (nreverse loop-for-bindings) loop-bindings)
- (setq loop-bindings (nconc (mapcar 'list loop-for-bindings)
- loop-bindings)))
+ (push (nreverse loop-for-bindings) cl--loop-bindings)
+ (setq cl--loop-bindings (nconc (mapcar 'list loop-for-bindings)
+ cl--loop-bindings)))
(if loop-for-sets
- (push (list 'progn
- (cl-loop-let (nreverse loop-for-sets) 'setq ands)
- t) loop-body))
+ (push `(progn
+ ,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
+ t) cl--loop-body))
(if loop-for-steps
- (push (cons (if ands 'psetq 'setq)
+ (push (cons (if ands 'cl-psetq 'setq)
(apply 'append (nreverse loop-for-steps)))
- loop-steps))))
+ cl--loop-steps))))
((eq word 'repeat)
(let ((temp (make-symbol "--cl-var--")))
- (push (list (list temp (pop loop-args))) loop-bindings)
- (push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body)))
+ (push (list (list temp (pop cl--loop-args))) cl--loop-bindings)
+ (push `(>= (setq ,temp (1- ,temp)) 0) cl--loop-body)))
((memq word '(collect collecting))
- (let ((what (pop loop-args))
- (var (cl-loop-handle-accum nil 'nreverse)))
- (if (eq var loop-accum-var)
- (push (list 'progn (list 'push what var) t) loop-body)
- (push (list 'progn
- (list 'setq var (list 'nconc var (list 'list what)))
- t) loop-body))))
+ (let ((what (pop cl--loop-args))
+ (var (cl--loop-handle-accum nil 'nreverse)))
+ (if (eq var cl--loop-accum-var)
+ (push `(progn (push ,what ,var) t) cl--loop-body)
+ (push `(progn
+ (setq ,var (nconc ,var (list ,what)))
+ t) cl--loop-body))))
((memq word '(nconc nconcing append appending))
- (let ((what (pop loop-args))
- (var (cl-loop-handle-accum nil 'nreverse)))
- (push (list 'progn
- (list 'setq var
- (if (eq var loop-accum-var)
- (list 'nconc
- (list (if (memq word '(nconc nconcing))
- 'nreverse 'reverse)
- what)
- var)
- (list (if (memq word '(nconc nconcing))
- 'nconc 'append)
- var what))) t) loop-body)))
+ (let ((what (pop cl--loop-args))
+ (var (cl--loop-handle-accum nil 'nreverse)))
+ (push `(progn
+ (setq ,var
+ ,(if (eq var cl--loop-accum-var)
+ `(nconc
+ (,(if (memq word '(nconc nconcing))
+ #'nreverse #'reverse)
+ ,what)
+ ,var)
+ `(,(if (memq word '(nconc nconcing))
+ #'nconc #'append)
+ ,var ,what))) t) cl--loop-body)))
((memq word '(concat concating))
- (let ((what (pop loop-args))
- (var (cl-loop-handle-accum "")))
- (push (list 'progn (list 'callf 'concat var what) t) loop-body)))
+ (let ((what (pop cl--loop-args))
+ (var (cl--loop-handle-accum "")))
+ (push `(progn (cl-callf concat ,var ,what) t) cl--loop-body)))
((memq word '(vconcat vconcating))
- (let ((what (pop loop-args))
- (var (cl-loop-handle-accum [])))
- (push (list 'progn (list 'callf 'vconcat var what) t) loop-body)))
+ (let ((what (pop cl--loop-args))
+ (var (cl--loop-handle-accum [])))
+ (push `(progn (cl-callf vconcat ,var ,what) t) cl--loop-body)))
((memq word '(sum summing))
- (let ((what (pop loop-args))
- (var (cl-loop-handle-accum 0)))
- (push (list 'progn (list 'incf var what) t) loop-body)))
+ (let ((what (pop cl--loop-args))
+ (var (cl--loop-handle-accum 0)))
+ (push `(progn (cl-incf ,var ,what) t) cl--loop-body)))
((memq word '(count counting))
- (let ((what (pop loop-args))
- (var (cl-loop-handle-accum 0)))
- (push (list 'progn (list 'if what (list 'incf var)) t) loop-body)))
+ (let ((what (pop cl--loop-args))
+ (var (cl--loop-handle-accum 0)))
+ (push `(progn (if ,what (cl-incf ,var)) t) cl--loop-body)))
((memq word '(minimize minimizing maximize maximizing))
- (let* ((what (pop loop-args))
- (temp (if (cl-simple-expr-p what) what (make-symbol "--cl-var--")))
- (var (cl-loop-handle-accum nil))
+ (let* ((what (pop cl--loop-args))
+ (temp (if (cl--simple-expr-p what) what (make-symbol "--cl-var--")))
+ (var (cl--loop-handle-accum nil))
(func (intern (substring (symbol-name word) 0 3)))
- (set (list 'setq var (list 'if var (list func var temp) temp))))
- (push (list 'progn (if (eq temp what) set
- (list 'let (list (list temp what)) set))
- t) loop-body)))
+ (set `(setq ,var (if ,var (,func ,var ,temp) ,temp))))
+ (push `(progn ,(if (eq temp what) set
+ `(let ((,temp ,what)) ,set))
+ t) cl--loop-body)))
((eq word 'with)
(let ((bindings nil))
- (while (progn (push (list (pop loop-args)
- (and (eq (car loop-args) '=) (cl-pop2 loop-args)))
+ (while (progn (push (list (pop cl--loop-args)
+ (and (eq (car cl--loop-args) '=) (cl-pop2 cl--loop-args)))
bindings)
- (eq (car loop-args) 'and))
- (pop loop-args))
- (push (nreverse bindings) loop-bindings)))
+ (eq (car cl--loop-args) 'and))
+ (pop cl--loop-args))
+ (push (nreverse bindings) cl--loop-bindings)))
((eq word 'while)
- (push (pop loop-args) loop-body))
+ (push (pop cl--loop-args) cl--loop-body))
((eq word 'until)
- (push (list 'not (pop loop-args)) loop-body))
+ (push `(not ,(pop cl--loop-args)) cl--loop-body))
((eq word 'always)
- (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--")))
- (push (list 'setq loop-finish-flag (pop loop-args)) loop-body)
- (setq loop-result t))
+ (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+ (push `(setq ,cl--loop-finish-flag ,(pop cl--loop-args)) cl--loop-body)
+ (setq cl--loop-result t))
((eq word 'never)
- (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--")))
- (push (list 'setq loop-finish-flag (list 'not (pop loop-args)))
- loop-body)
- (setq loop-result t))
+ (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+ (push `(setq ,cl--loop-finish-flag (not ,(pop cl--loop-args)))
+ cl--loop-body)
+ (setq cl--loop-result t))
((eq word 'thereis)
- (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--")))
- (or loop-result-var (setq loop-result-var (make-symbol "--cl-var--")))
- (push (list 'setq loop-finish-flag
- (list 'not (list 'setq loop-result-var (pop loop-args))))
- loop-body))
+ (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+ (or cl--loop-result-var (setq cl--loop-result-var (make-symbol "--cl-var--")))
+ (push `(setq ,cl--loop-finish-flag
+ (not (setq ,cl--loop-result-var ,(pop cl--loop-args))))
+ cl--loop-body))
((memq word '(if when unless))
- (let* ((cond (pop loop-args))
- (then (let ((loop-body nil))
+ (let* ((cond (pop cl--loop-args))
+ (then (let ((cl--loop-body nil))
(cl-parse-loop-clause)
- (cl-loop-build-ands (nreverse loop-body))))
- (else (let ((loop-body nil))
- (if (eq (car loop-args) 'else)
- (progn (pop loop-args) (cl-parse-loop-clause)))
- (cl-loop-build-ands (nreverse loop-body))))
+ (cl--loop-build-ands (nreverse cl--loop-body))))
+ (else (let ((cl--loop-body nil))
+ (if (eq (car cl--loop-args) 'else)
+ (progn (pop cl--loop-args) (cl-parse-loop-clause)))
+ (cl--loop-build-ands (nreverse cl--loop-body))))
(simple (and (eq (car then) t) (eq (car else) t))))
- (if (eq (car loop-args) 'end) (pop loop-args))
+ (if (eq (car cl--loop-args) 'end) (pop cl--loop-args))
(if (eq word 'unless) (setq then (prog1 else (setq else then))))
(let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then))
(if simple (nth 1 else) (list (nth 2 else))))))
- (if (cl-expr-contains form 'it)
+ (if (cl--expr-contains form 'it)
(let ((temp (make-symbol "--cl-var--")))
- (push (list temp) loop-bindings)
- (setq form (list* 'if (list 'setq temp cond)
- (subst temp 'it form))))
- (setq form (list* 'if cond form)))
- (push (if simple (list 'progn form t) form) loop-body))))
+ (push (list temp) cl--loop-bindings)
+ (setq form `(if (setq ,temp ,cond)
+ ,@(cl-subst temp 'it form))))
+ (setq form `(if ,cond ,@form)))
+ (push (if simple `(progn ,form t) form) cl--loop-body))))
((memq word '(do doing))
(let ((body nil))
- (or (consp (car loop-args)) (error "Syntax error on `do' clause"))
- (while (consp (car loop-args)) (push (pop loop-args) body))
- (push (cons 'progn (nreverse (cons t body))) loop-body)))
+ (or (consp (car cl--loop-args)) (error "Syntax error on `do' clause"))
+ (while (consp (car cl--loop-args)) (push (pop cl--loop-args) body))
+ (push (cons 'progn (nreverse (cons t body))) cl--loop-body)))
((eq word 'return)
- (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-var--")))
- (or loop-result-var (setq loop-result-var (make-symbol "--cl-var--")))
- (push (list 'setq loop-result-var (pop loop-args)
- loop-finish-flag nil) loop-body))
+ (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-var--")))
+ (or cl--loop-result-var (setq cl--loop-result-var (make-symbol "--cl-var--")))
+ (push `(setq ,cl--loop-result-var ,(pop cl--loop-args)
+ ,cl--loop-finish-flag nil) cl--loop-body))
(t
+ ;; This is an advertised interface: (info "(cl)Other Clauses").
(let ((handler (and (symbolp word) (get word 'cl-loop-handler))))
- (or handler (error "Expected a loop keyword, found %s" word))
+ (or handler (error "Expected a cl-loop keyword, found %s" word))
(funcall handler))))
- (if (eq (car loop-args) 'and)
- (progn (pop loop-args) (cl-parse-loop-clause)))))
+ (if (eq (car cl--loop-args) 'and)
+ (progn (pop cl--loop-args) (cl-parse-loop-clause)))))
-(defun cl-loop-let (specs body par) ; uses loop-*
+(defun cl--loop-let (specs body par) ; uses loop-*
(let ((p specs) (temps nil) (new nil))
- (while (and p (or (symbolp (car-safe (car p))) (null (cadar p))))
+ (while (and p (or (symbolp (car-safe (car p))) (null (cl-cadar p))))
(setq p (cdr p)))
(and par p
(progn
(setq par nil p specs)
(while p
- (or (cl-const-expr-p (cadar p))
+ (or (macroexp-const-p (cl-cadar p))
(let ((temp (make-symbol "--cl-var--")))
- (push (list temp (cadar p)) temps)
+ (push (list temp (cl-cadar p)) temps)
(setcar (cdar p) temp)))
(setq p (cdr p)))))
(while specs
(if (and (consp (car specs)) (listp (caar specs)))
(let* ((spec (caar specs)) (nspecs nil)
(expr (cadr (pop specs)))
- (temp (cdr (or (assq spec loop-destr-temps)
+ (temp (cdr (or (assq spec cl--loop-destr-temps)
(car (push (cons spec (or (last spec 0)
(make-symbol "--cl-var--")))
- loop-destr-temps))))))
+ cl--loop-destr-temps))))))
(push (list temp expr) new)
(while (consp spec)
(push (list (pop spec)
@@ -1175,29 +1447,36 @@ Valid clauses are:
(setq specs (nconc (nreverse nspecs) specs)))
(push (pop specs) new)))
(if (eq body 'setq)
- (let ((set (cons (if par 'psetq 'setq) (apply 'nconc (nreverse new)))))
- (if temps (list 'let* (nreverse temps) set) set))
- (list* (if par 'let 'let*)
- (nconc (nreverse temps) (nreverse new)) body))))
-
-(defun cl-loop-handle-accum (def &optional func) ; uses loop-*
- (if (eq (car loop-args) 'into)
- (let ((var (cl-pop2 loop-args)))
- (or (memq var loop-accum-vars)
- (progn (push (list (list var def)) loop-bindings)
- (push var loop-accum-vars)))
+ (let ((set (cons (if par 'cl-psetq 'setq) (apply 'nconc (nreverse new)))))
+ (if temps `(let* ,(nreverse temps) ,set) set))
+ `(,(if par 'let 'let*)
+ ,(nconc (nreverse temps) (nreverse new)) ,@body))))
+
+(defun cl--loop-handle-accum (def &optional func) ; uses loop-*
+ (if (eq (car cl--loop-args) 'into)
+ (let ((var (cl-pop2 cl--loop-args)))
+ (or (memq var cl--loop-accum-vars)
+ (progn (push (list (list var def)) cl--loop-bindings)
+ (push var cl--loop-accum-vars)))
var)
- (or loop-accum-var
+ (or cl--loop-accum-var
(progn
- (push (list (list (setq loop-accum-var (make-symbol "--cl-var--")) def))
- loop-bindings)
- (setq loop-result (if func (list func loop-accum-var)
- loop-accum-var))
- loop-accum-var))))
-
-(defun cl-loop-build-ands (clauses)
+ (push (list (list (setq cl--loop-accum-var (make-symbol "--cl-var--")) def))
+ cl--loop-bindings)
+ (setq cl--loop-result (if func (list func cl--loop-accum-var)
+ cl--loop-accum-var))
+ cl--loop-accum-var))))
+
+(defun cl--loop-build-ands (clauses)
+ "Return various representations of (and . CLAUSES).
+CLAUSES is a list of Elisp expressions, where clauses of the form
+\(progn E1 E2 E3 .. t) are the focus of particular optimizations.
+The return value has shape (COND BODY COMBO)
+such that COMBO is equivalent to (and . CLAUSES)."
(let ((ands nil)
(body nil))
+ ;; Look through `clauses', trying to optimize (progn ,@A t) (progn ,@B) ,@C
+ ;; into (progn ,@A ,@B) ,@C.
(while clauses
(if (and (eq (car-safe (car clauses)) 'progn)
(eq (car (last (car clauses))) t))
@@ -1205,9 +1484,10 @@ Valid clauses are:
(setq clauses (cons (nconc (butlast (car clauses))
(if (eq (car-safe (cadr clauses))
'progn)
- (cdadr clauses)
+ (cl-cdadr clauses)
(list (cadr clauses))))
(cddr clauses)))
+ ;; A final (progn ,@A t) is moved outside of the `and'.
(setq body (cdr (butlast (pop clauses)))))
(push (pop clauses) ands)))
(setq ands (or (nreverse ands) (list t)))
@@ -1222,363 +1502,401 @@ Valid clauses are:
;;; Other iteration control structures.
;;;###autoload
-(defmacro do (steps endtest &rest body)
+(defmacro cl-do (steps endtest &rest body)
"The Common Lisp `do' loop.
\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
+ (declare (indent 2)
+ (debug
+ ((&rest &or symbolp (symbolp &optional form form))
+ (form body)
+ cl-declarations body)))
(cl-expand-do-loop steps endtest body nil))
;;;###autoload
-(defmacro do* (steps endtest &rest body)
+(defmacro cl-do* (steps endtest &rest body)
"The Common Lisp `do*' loop.
\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
+ (declare (indent 2) (debug cl-do))
(cl-expand-do-loop steps endtest body t))
(defun cl-expand-do-loop (steps endtest body star)
- (list 'block nil
- (list* (if star 'let* 'let)
- (mapcar (function (lambda (c)
- (if (consp c) (list (car c) (nth 1 c)) c)))
- steps)
- (list* 'while (list 'not (car endtest))
- (append body
- (let ((sets (mapcar
- (function
- (lambda (c)
- (and (consp c) (cdr (cdr c))
- (list (car c) (nth 2 c)))))
- steps)))
- (setq sets (delq nil sets))
- (and sets
- (list (cons (if (or star (not (cdr sets)))
- 'setq 'psetq)
- (apply 'append sets)))))))
- (or (cdr endtest) '(nil)))))
+ `(cl-block nil
+ (,(if star 'let* 'let)
+ ,(mapcar (lambda (c) (if (consp c) (list (car c) (nth 1 c)) c))
+ steps)
+ (while (not ,(car endtest))
+ ,@body
+ ,@(let ((sets (mapcar (lambda (c)
+ (and (consp c) (cdr (cdr c))
+ (list (car c) (nth 2 c))))
+ steps)))
+ (setq sets (delq nil sets))
+ (and sets
+ (list (cons (if (or star (not (cdr sets)))
+ 'setq 'cl-psetq)
+ (apply 'append sets))))))
+ ,@(or (cdr endtest) '(nil)))))
;;;###autoload
-(defmacro dolist (spec &rest body)
+(defmacro cl-dolist (spec &rest body)
"Loop over a list.
Evaluate BODY with VAR bound to each `car' from LIST, in turn.
Then evaluate RESULT to get return value, default nil.
An implicit nil block is established around the loop.
\(fn (VAR LIST [RESULT]) BODY...)"
- (let ((temp (make-symbol "--cl-dolist-temp--")))
- ;; FIXME: Copy&pasted from subr.el.
- `(block nil
- ;; This is not a reliable test, but it does not matter because both
- ;; semantics are acceptable, tho one is slightly faster with dynamic
- ;; scoping and the other is slightly faster (and has cleaner semantics)
- ;; with lexical scoping.
- ,(if lexical-binding
- `(let ((,temp ,(nth 1 spec)))
- (while ,temp
- (let ((,(car spec) (car ,temp)))
- ,@body
- (setq ,temp (cdr ,temp))))
- ,@(if (cdr (cdr spec))
- ;; FIXME: This let often leads to "unused var" warnings.
- `((let ((,(car spec) nil)) ,@(cdr (cdr spec))))))
- `(let ((,temp ,(nth 1 spec))
- ,(car spec))
- (while ,temp
- (setq ,(car spec) (car ,temp))
- ,@body
- (setq ,temp (cdr ,temp)))
- ,@(if (cdr (cdr spec))
- `((setq ,(car spec) nil) ,@(cddr spec))))))))
+ (declare (debug ((symbolp form &optional form) cl-declarations body))
+ (indent 1))
+ (let ((loop `(dolist ,spec ,@body)))
+ (if (advice-member-p #'cl--wrap-in-nil-block 'dolist)
+ loop `(cl-block nil ,loop))))
;;;###autoload
-(defmacro dotimes (spec &rest body)
+(defmacro cl-dotimes (spec &rest body)
"Loop a certain number of times.
Evaluate BODY with VAR bound to successive integers from 0, inclusive,
to COUNT, exclusive. Then evaluate RESULT to get return value, default
nil.
\(fn (VAR COUNT [RESULT]) BODY...)"
- (let ((temp (make-symbol "--cl-dotimes-temp--"))
- (end (nth 1 spec)))
- ;; FIXME: Copy&pasted from subr.el.
- `(block nil
- ;; This is not a reliable test, but it does not matter because both
- ;; semantics are acceptable, tho one is slightly faster with dynamic
- ;; scoping and the other has cleaner semantics.
- ,(if lexical-binding
- (let ((counter '--dotimes-counter--))
- `(let ((,temp ,end)
- (,counter 0))
- (while (< ,counter ,temp)
- (let ((,(car spec) ,counter))
- ,@body)
- (setq ,counter (1+ ,counter)))
- ,@(if (cddr spec)
- ;; FIXME: This let often leads to "unused var" warnings.
- `((let ((,(car spec) ,counter)) ,@(cddr spec))))))
- `(let ((,temp ,end)
- (,(car spec) 0))
- (while (< ,(car spec) ,temp)
- ,@body
- (incf ,(car spec)))
- ,@(cdr (cdr spec)))))))
+ (declare (debug cl-dolist) (indent 1))
+ (let ((loop `(dotimes ,spec ,@body)))
+ (if (advice-member-p #'cl--wrap-in-nil-block 'dotimes)
+ loop `(cl-block nil ,loop))))
;;;###autoload
-(defmacro do-symbols (spec &rest body)
+(defmacro cl-do-symbols (spec &rest body)
"Loop over all symbols.
Evaluate BODY with VAR bound to each interned symbol, or to each symbol
from OBARRAY.
\(fn (VAR [OBARRAY [RESULT]]) BODY...)"
+ (declare (indent 1)
+ (debug ((symbolp &optional form form) cl-declarations body)))
;; Apparently this doesn't have an implicit block.
- (list 'block nil
- (list 'let (list (car spec))
- (list* 'mapatoms
- (list 'function (list* 'lambda (list (car spec)) body))
- (and (cadr spec) (list (cadr spec))))
- (caddr spec))))
+ `(cl-block nil
+ (let (,(car spec))
+ (mapatoms #'(lambda (,(car spec)) ,@body)
+ ,@(and (cadr spec) (list (cadr spec))))
+ ,(cl-caddr spec))))
;;;###autoload
-(defmacro do-all-symbols (spec &rest body)
- (list* 'do-symbols (list (car spec) nil (cadr spec)) body))
+(defmacro cl-do-all-symbols (spec &rest body)
+ "Like `cl-do-symbols', but use the default obarray.
+
+\(fn (VAR [RESULT]) BODY...)"
+ (declare (indent 1) (debug ((symbolp &optional form) cl-declarations body)))
+ `(cl-do-symbols (,(car spec) nil ,(cadr spec)) ,@body))
;;; Assignments.
;;;###autoload
-(defmacro psetq (&rest args)
+(defmacro cl-psetq (&rest args)
"Set SYMs to the values VALs in parallel.
This is like `setq', except that all VAL forms are evaluated (in order)
before assigning any symbols SYM to the corresponding values.
\(fn SYM VAL SYM VAL ...)"
- (cons 'psetf args))
+ (declare (debug setq))
+ (cons 'cl-psetf args))
;;; Binding control structures.
;;;###autoload
-(defmacro progv (symbols values &rest body)
+(defmacro cl-progv (symbols values &rest body)
"Bind SYMBOLS to VALUES dynamically in BODY.
The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists.
Each symbol in the first list is bound to the corresponding value in the
-second list (or made unbound if VALUES is shorter than SYMBOLS); then the
+second list (or to nil if VALUES is shorter than SYMBOLS); then the
BODY forms are executed and their result is returned. This is much like
a `let' form, except that the list of symbols can be computed at run-time."
- (list 'let '((cl-progv-save nil))
- (list 'unwind-protect
- (list* 'progn (list 'cl-progv-before symbols values) body)
- '(cl-progv-after))))
+ (declare (indent 2) (debug (form form body)))
+ (let ((bodyfun (make-symbol "cl--progv-body"))
+ (binds (make-symbol "binds"))
+ (syms (make-symbol "syms"))
+ (vals (make-symbol "vals")))
+ `(progn
+ (defvar ,bodyfun)
+ (let* ((,syms ,symbols)
+ (,vals ,values)
+ (,bodyfun (lambda () ,@body))
+ (,binds ()))
+ (while ,syms
+ (push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds))
+ (eval (list 'let ,binds '(funcall ,bodyfun)))))))
+
+(defvar cl--labels-convert-cache nil)
+
+(defun cl--labels-convert (f)
+ "Special macro-expander to rename (function F) references in `cl-labels'."
+ (cond
+ ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
+ ;; *after* handling `function', but we want to stop macroexpansion from
+ ;; being applied infinitely, so we use a cache to return the exact `form'
+ ;; being expanded even though we don't receive it.
+ ((eq f (car cl--labels-convert-cache)) (cdr cl--labels-convert-cache))
+ (t
+ (let ((found (assq f macroexpand-all-environment)))
+ (if (and found (ignore-errors
+ (eq (cadr (cl-caddr found)) 'cl-labels-args)))
+ (cadr (cl-caddr (cl-cadddr found)))
+ (let ((res `(function ,f)))
+ (setq cl--labels-convert-cache (cons f res))
+ res))))))
+
+;;;###autoload
+(defmacro cl-flet (bindings &rest body)
+ "Make local function definitions.
+Like `cl-labels' but the definitions are not recursive.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+ (declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body)))
+ (let ((binds ()) (newenv macroexpand-all-environment))
+ (dolist (binding bindings)
+ (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+ (push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+ (push (cons (car binding)
+ `(lambda (&rest cl-labels-args)
+ (cl-list* 'funcall ',var
+ cl-labels-args)))
+ newenv)))
+ `(let ,(nreverse binds)
+ ,@(macroexp-unprogn
+ (macroexpand-all
+ `(progn ,@body)
+ ;; Don't override lexical-let's macro-expander.
+ (if (assq 'function newenv) newenv
+ (cons (cons 'function #'cl--labels-convert) newenv)))))))
-;;; This should really have some way to shadow 'byte-compile properties, etc.
;;;###autoload
-(defmacro flet (bindings &rest body)
- "Make temporary function definitions.
-This is an analogue of `let' that operates on the function cell of FUNC
-rather than its value cell. The FORMs are evaluated with the specified
-function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof).
+(defmacro cl-flet* (bindings &rest body)
+ "Make local function definitions.
+Like `cl-flet' but the definitions can refer to previous ones.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
- (list* 'letf*
- (mapcar
- (function
- (lambda (x)
- (if (or (and (fboundp (car x))
- (eq (car-safe (symbol-function (car x))) 'macro))
- (cdr (assq (car x) cl-macro-environment)))
- (error "Use `labels', not `flet', to rebind macro names"))
- (let ((func (list 'function*
- (list 'lambda (cadr x)
- (list* 'block (car x) (cddr x))))))
- (when (cl-compiling-file)
- ;; Bug#411. It would be nice to fix this.
- (and (get (car x) 'byte-compile)
- (error "Byte-compiling a redefinition of `%s' \
-will not work - use `labels' instead" (symbol-name (car x))))
- ;; FIXME This affects the rest of the file, when it
- ;; should be restricted to the flet body.
- (and (boundp 'byte-compile-function-environment)
- (push (cons (car x) (eval func))
- byte-compile-function-environment)))
- (list (list 'symbol-function (list 'quote (car x))) func))))
- bindings)
- body))
+ (declare (indent 1) (debug cl-flet))
+ (cond
+ ((null bindings) (macroexp-progn body))
+ ((null (cdr bindings)) `(cl-flet ,bindings ,@body))
+ (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body)))))
;;;###autoload
-(defmacro labels (bindings &rest body)
+(defmacro cl-labels (bindings &rest body)
"Make temporary function bindings.
-This is like `flet', except the bindings are lexical instead of dynamic.
-Unlike `flet', this macro is fully compliant with the Common Lisp standard.
+The bindings can be recursive and the scoping is lexical, but capturing them
+in closures will only work if `lexical-binding' is in use.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
- (let ((vars nil) (sets nil) (cl-macro-environment cl-macro-environment))
- (while bindings
- ;; Use `gensym' rather than `make-symbol'. It's important that
- ;; (not (eq (symbol-name var1) (symbol-name var2))) because these
- ;; vars get added to the cl-macro-environment.
- (let ((var (gensym "--cl-var--")))
- (push var vars)
- (push (list 'function* (cons 'lambda (cdar bindings))) sets)
- (push var sets)
- (push (list (car (pop bindings)) 'lambda '(&rest cl-labels-args)
- (list 'list* '(quote funcall) (list 'quote var)
- 'cl-labels-args))
- cl-macro-environment)))
- (cl-macroexpand-all (list* 'lexical-let vars (cons (cons 'setq sets) body))
- cl-macro-environment)))
+ (declare (indent 1) (debug cl-flet))
+ (let ((binds ()) (newenv macroexpand-all-environment))
+ (dolist (binding bindings)
+ (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+ (push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+ (push (cons (car binding)
+ `(lambda (&rest cl-labels-args)
+ (cl-list* 'funcall ',var
+ cl-labels-args)))
+ newenv)))
+ (macroexpand-all `(letrec ,(nreverse binds) ,@body)
+ ;; Don't override lexical-let's macro-expander.
+ (if (assq 'function newenv) newenv
+ (cons (cons 'function #'cl--labels-convert) newenv)))))
;; The following ought to have a better definition for use with newer
;; byte compilers.
;;;###autoload
-(defmacro macrolet (bindings &rest body)
+(defmacro cl-macrolet (bindings &rest body)
"Make temporary macro definitions.
-This is like `flet', but for macros instead of functions.
+This is like `cl-flet', but for macros instead of functions.
\(fn ((NAME ARGLIST BODY...) ...) FORM...)"
+ (declare (indent 1)
+ (debug
+ ((&rest (&define name (&rest arg) cl-declarations-or-string
+ def-body))
+ cl-declarations body)))
(if (cdr bindings)
- (list 'macrolet
- (list (car bindings)) (list* 'macrolet (cdr bindings) body))
+ `(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body))
(if (null bindings) (cons 'progn body)
(let* ((name (caar bindings))
- (res (cl-transform-lambda (cdar bindings) name)))
+ (res (cl--transform-lambda (cdar bindings) name)))
(eval (car res))
- (cl-macroexpand-all (cons 'progn body)
- (cons (list* name 'lambda (cdr res))
- cl-macro-environment))))))
+ (macroexpand-all (cons 'progn body)
+ (cons (cons name `(lambda ,@(cdr res)))
+ macroexpand-all-environment))))))
+
+(defconst cl--old-macroexpand
+ (if (and (boundp 'cl--old-macroexpand)
+ (eq (symbol-function 'macroexpand)
+ #'cl--sm-macroexpand))
+ cl--old-macroexpand
+ (symbol-function 'macroexpand)))
+
+(defun cl--sm-macroexpand (exp &optional env)
+ "Special macro expander used inside `cl-symbol-macrolet'.
+This function replaces `macroexpand' during macro expansion
+of `cl-symbol-macrolet', and does the same thing as `macroexpand'
+except that it additionally expands symbol macros."
+ (let ((macroexpand-all-environment env))
+ (while
+ (progn
+ (setq exp (funcall cl--old-macroexpand exp env))
+ (pcase exp
+ ((pred symbolp)
+ ;; Perform symbol-macro expansion.
+ (when (cdr (assq (symbol-name exp) env))
+ (setq exp (cadr (assq (symbol-name exp) env)))))
+ (`(setq . ,_)
+ ;; Convert setq to setf if required by symbol-macro expansion.
+ (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env))
+ (cdr exp)))
+ (p args))
+ (while (and p (symbolp (car p))) (setq p (cddr p)))
+ (if p (setq exp (cons 'setf args))
+ (setq exp (cons 'setq args))
+ ;; Don't loop further.
+ nil)))
+ (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare))
+ ;; CL's symbol-macrolet treats re-bindings as candidates for
+ ;; expansion (turning the let into a letf if needed), contrary to
+ ;; Common-Lisp where such re-bindings hide the symbol-macro.
+ (let ((letf nil) (found nil) (nbs ()))
+ (dolist (binding bindings)
+ (let* ((var (if (symbolp binding) binding (car binding)))
+ (sm (assq (symbol-name var) env)))
+ (push (if (not (cdr sm))
+ binding
+ (let ((nexp (cadr sm)))
+ (setq found t)
+ (unless (symbolp nexp) (setq letf t))
+ (cons nexp (cdr-safe binding))))
+ nbs)))
+ (when found
+ (setq exp `(,(if letf
+ (if (eq (car exp) 'let) 'cl-letf 'cl-letf*)
+ (car exp))
+ ,(nreverse nbs)
+ ,@body)))))
+ ;; FIXME: The behavior of CL made sense in a dynamically scoped
+ ;; language, but for lexical scoping, Common-Lisp's behavior might
+ ;; make more sense (and indeed, CL behaves like Common-Lisp w.r.t
+ ;; lexical-let), so maybe we should adjust the behavior based on
+ ;; the use of lexical-binding.
+ ;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare))
+ ;; (let ((nbs ()) (found nil))
+ ;; (dolist (binding bindings)
+ ;; (let* ((var (if (symbolp binding) binding (car binding)))
+ ;; (name (symbol-name var))
+ ;; (val (and found (consp binding) (eq 'let* (car exp))
+ ;; (list (macroexpand-all (cadr binding)
+ ;; env)))))
+ ;; (push (if (assq name env)
+ ;; ;; This binding should hide its symbol-macro,
+ ;; ;; but given the way macroexpand-all works, we
+ ;; ;; can't prevent application of `env' to the
+ ;; ;; sub-expressions, so we need to α-rename this
+ ;; ;; variable instead.
+ ;; (let ((nvar (make-symbol
+ ;; (copy-sequence name))))
+ ;; (setq found t)
+ ;; (push (list name nvar) env)
+ ;; (cons nvar (or val (cdr-safe binding))))
+ ;; (if val (cons var val) binding))
+ ;; nbs)))
+ ;; (when found
+ ;; (setq exp `(,(car exp)
+ ;; ,(nreverse nbs)
+ ;; ,@(macroexp-unprogn
+ ;; (macroexpand-all (macroexp-progn body)
+ ;; env)))))
+ ;; nil))
+ )))
+ exp))
;;;###autoload
-(defmacro symbol-macrolet (bindings &rest body)
+(defmacro cl-symbol-macrolet (bindings &rest body)
"Make symbol macro definitions.
Within the body FORMs, references to the variable NAME will be replaced
by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
\(fn ((NAME EXPANSION) ...) FORM...)"
- (if (cdr bindings)
- (list 'symbol-macrolet
- (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body))
- (if (null bindings) (cons 'progn body)
- (cl-macroexpand-all (cons 'progn body)
- (cons (list (symbol-name (caar bindings))
- (cadar bindings))
- cl-macro-environment)))))
-
-(defvar cl-closure-vars nil)
-;;;###autoload
-(defmacro lexical-let (bindings &rest body)
- "Like `let', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp.
-\n(fn BINDINGS BODY)"
- (let* ((cl-closure-vars cl-closure-vars)
- (vars (mapcar (function
- (lambda (x)
- (or (consp x) (setq x (list x)))
- (push (make-symbol (format "--cl-%s--" (car x)))
- cl-closure-vars)
- (set (car cl-closure-vars) [bad-lexical-ref])
- (list (car x) (cadr x) (car cl-closure-vars))))
- bindings))
- (ebody
- (cl-macroexpand-all
- (cons 'progn body)
- (nconc (mapcar (function (lambda (x)
- (list (symbol-name (car x))
- (list 'symbol-value (caddr x))
- t))) vars)
- (list '(defun . cl-defun-expander))
- cl-macro-environment))))
- (if (not (get (car (last cl-closure-vars)) 'used))
- (list 'let (mapcar (function (lambda (x)
- (list (caddr x) (cadr x)))) vars)
- (sublis (mapcar (function (lambda (x)
- (cons (caddr x)
- (list 'quote (caddr x)))))
- vars)
- ebody))
- (list 'let (mapcar (function (lambda (x)
- (list (caddr x)
- (list 'make-symbol
- (format "--%s--" (car x))))))
- vars)
- (apply 'append '(setf)
- (mapcar (function
- (lambda (x)
- (list (list 'symbol-value (caddr x)) (cadr x))))
- vars))
- ebody))))
-
-;;;###autoload
-(defmacro lexical-let* (bindings &rest body)
- "Like `let*', but lexically scoped.
-The main visible difference is that lambdas inside BODY, and in
-successive bindings within BINDINGS, will create lexical closures
-as in Common Lisp. This is similar to the behavior of `let*' in
-Common Lisp.
-\n(fn BINDINGS BODY)"
- (if (null bindings) (cons 'progn body)
- (setq bindings (reverse bindings))
- (while bindings
- (setq body (list (list* 'lexical-let (list (pop bindings)) body))))
- (car body)))
-
-(defun cl-defun-expander (func &rest rest)
- (list 'progn
- (list 'defalias (list 'quote func)
- (list 'function (cons 'lambda rest)))
- (list 'quote func)))
-
+ (declare (indent 1) (debug ((&rest (symbol sexp)) cl-declarations body)))
+ (cond
+ ((cdr bindings)
+ `(cl-symbol-macrolet (,(car bindings))
+ (cl-symbol-macrolet ,(cdr bindings) ,@body)))
+ ((null bindings) (macroexp-progn body))
+ (t
+ (let ((previous-macroexpand (symbol-function 'macroexpand)))
+ (unwind-protect
+ (progn
+ (fset 'macroexpand #'cl--sm-macroexpand)
+ ;; FIXME: For N bindings, this will traverse `body' N times!
+ (macroexpand-all (cons 'progn body)
+ (cons (list (symbol-name (caar bindings))
+ (cl-cadar bindings))
+ macroexpand-all-environment)))
+ (fset 'macroexpand previous-macroexpand))))))
;;; Multiple values.
;;;###autoload
-(defmacro multiple-value-bind (vars form &rest body)
+(defmacro cl-multiple-value-bind (vars form &rest body)
"Collect multiple return values.
FORM must return a list; the BODY is then executed with the first N elements
of this list bound (`let'-style) to each of the symbols SYM in turn. This
-is analogous to the Common Lisp `multiple-value-bind' macro, using lists to
-simulate true multiple return values. For compatibility, (values A B C) is
+is analogous to the Common Lisp `cl-multiple-value-bind' macro, using lists to
+simulate true multiple return values. For compatibility, (cl-values A B C) is
a synonym for (list A B C).
\(fn (SYM...) FORM BODY)"
+ (declare (indent 2) (debug ((&rest symbolp) form body)))
(let ((temp (make-symbol "--cl-var--")) (n -1))
- (list* 'let* (cons (list temp form)
- (mapcar (function
- (lambda (v)
- (list v (list 'nth (setq n (1+ n)) temp))))
- vars))
- body)))
+ `(let* ((,temp ,form)
+ ,@(mapcar (lambda (v)
+ (list v `(nth ,(setq n (1+ n)) ,temp)))
+ vars))
+ ,@body)))
;;;###autoload
-(defmacro multiple-value-setq (vars form)
+(defmacro cl-multiple-value-setq (vars form)
"Collect multiple return values.
FORM must return a list; the first N elements of this list are stored in
each of the symbols SYM in turn. This is analogous to the Common Lisp
-`multiple-value-setq' macro, using lists to simulate true multiple return
-values. For compatibility, (values A B C) is a synonym for (list A B C).
+`cl-multiple-value-setq' macro, using lists to simulate true multiple return
+values. For compatibility, (cl-values A B C) is a synonym for (list A B C).
\(fn (SYM...) FORM)"
- (cond ((null vars) (list 'progn form nil))
- ((null (cdr vars)) (list 'setq (car vars) (list 'car form)))
+ (declare (indent 1) (debug ((&rest symbolp) form)))
+ (cond ((null vars) `(progn ,form nil))
+ ((null (cdr vars)) `(setq ,(car vars) (car ,form)))
(t
(let* ((temp (make-symbol "--cl-var--")) (n 0))
- (list 'let (list (list temp form))
- (list 'prog1 (list 'setq (pop vars) (list 'car temp))
- (cons 'setq (apply 'nconc
- (mapcar (function
- (lambda (v)
- (list v (list
- 'nth
- (setq n (1+ n))
- temp))))
- vars)))))))))
+ `(let ((,temp ,form))
+ (prog1 (setq ,(pop vars) (car ,temp))
+ (setq ,@(apply #'nconc
+ (mapcar (lambda (v)
+ (list v `(nth ,(setq n (1+ n))
+ ,temp)))
+ vars)))))))))
;;; Declarations.
;;;###autoload
-(defmacro locally (&rest body) (cons 'progn body))
+(defmacro cl-locally (&rest body)
+ "Equivalent to `progn'."
+ (declare (debug t))
+ (cons 'progn body))
;;;###autoload
-(defmacro the (type form) form)
+(defmacro cl-the (_type form)
+ "At present this ignores _TYPE and is simply equivalent to FORM."
+ (declare (indent 1) (debug (cl-type-spec form)))
+ form)
(defvar cl-proclaim-history t) ; for future compilers
(defvar cl-declare-stack t) ; for future compilers
@@ -1617,7 +1935,7 @@ values. For compatibility, (values A B C) is a synonym for (list A B C).
((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings))
(while (setq spec (cdr spec))
(if (consp (car spec))
- (if (eq (cadar spec) 0)
+ (if (eq (cl-cadar spec) 0)
(byte-compile-disable-warning (caar spec))
(byte-compile-enable-warning (caar spec)))))))
nil)
@@ -1629,514 +1947,159 @@ values. For compatibility, (values A B C) is a synonym for (list A B C).
(setq cl-proclaims-deferred nil))
;;;###autoload
-(defmacro declare (&rest specs)
+(defmacro cl-declare (&rest specs)
"Declare SPECS about the current function while compiling.
For instance
- \(declare (warn 0))
+ \(cl-declare (warn 0))
will turn off byte-compile warnings in the function.
See Info node `(cl)Declarations' for details."
- (if (cl-compiling-file)
+ (if (cl--compiling-file)
(while specs
(if (listp cl-declare-stack) (push (car specs) cl-declare-stack))
(cl-do-proclaim (pop specs) nil)))
nil)
-
-
-;;; Generalized variables.
-
-;;;###autoload
-(defmacro define-setf-method (func args &rest body)
- "Define a `setf' method.
-This method shows how to handle `setf's to places of the form (NAME ARGS...).
-The argument forms ARGS are bound according to ARGLIST, as if NAME were
-going to be expanded as a macro, then the BODY forms are executed and must
-return a list of five elements: a temporary-variables list, a value-forms
-list, a store-variables list (of length one), a store-form, and an access-
-form. See `defsetf' for a simpler way to define most setf-methods.
-
-\(fn NAME ARGLIST BODY...)"
- (append '(eval-when (compile load eval))
- (if (stringp (car body))
- (list (list 'put (list 'quote func) '(quote setf-documentation)
- (pop body))))
- (list (cl-transform-function-property
- func 'setf-method (cons args body)))))
-(defalias 'define-setf-expander 'define-setf-method)
-
-;;;###autoload
-(defmacro defsetf (func arg1 &rest args)
- "Define a `setf' method.
-This macro is an easy-to-use substitute for `define-setf-method' that works
-well for simple place forms. In the simple `defsetf' form, `setf's of
-the form (setf (NAME ARGS...) VAL) are transformed to function or macro
-calls of the form (FUNC ARGS... VAL). Example:
-
- (defsetf aref aset)
-
-Alternate form: (defsetf NAME ARGLIST (STORE) BODY...).
-Here, the above `setf' call is expanded by binding the argument forms ARGS
-according to ARGLIST, binding the value form VAL to STORE, then executing
-BODY, which must return a Lisp form that does the necessary `setf' operation.
-Actually, ARGLIST and STORE may be bound to temporary variables which are
-introduced automatically to preserve proper execution order of the arguments.
-Example:
-
- (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))
-
-\(fn NAME [FUNC | ARGLIST (STORE) BODY...])"
- (if (and (listp arg1) (consp args))
- (let* ((largs nil) (largsr nil)
- (temps nil) (tempsr nil)
- (restarg nil) (rest-temps nil)
- (store-var (car (prog1 (car args) (setq args (cdr args)))))
- (store-temp (intern (format "--%s--temp--" store-var)))
- (lets1 nil) (lets2 nil)
- (docstr nil) (p arg1))
- (if (stringp (car args))
- (setq docstr (prog1 (car args) (setq args (cdr args)))))
- (while (and p (not (eq (car p) '&aux)))
- (if (eq (car p) '&rest)
- (setq p (cdr p) restarg (car p))
- (or (memq (car p) '(&optional &key &allow-other-keys))
- (setq largs (cons (if (consp (car p)) (car (car p)) (car p))
- largs)
- temps (cons (intern (format "--%s--temp--" (car largs)))
- temps))))
- (setq p (cdr p)))
- (setq largs (nreverse largs) temps (nreverse temps))
- (if restarg
- (setq largsr (append largs (list restarg))
- rest-temps (intern (format "--%s--temp--" restarg))
- tempsr (append temps (list rest-temps)))
- (setq largsr largs tempsr temps))
- (let ((p1 largs) (p2 temps))
- (while p1
- (setq lets1 (cons `(,(car p2)
- (make-symbol ,(format "--cl-%s--" (car p1))))
- lets1)
- lets2 (cons (list (car p1) (car p2)) lets2)
- p1 (cdr p1) p2 (cdr p2))))
- (if restarg (setq lets2 (cons (list restarg rest-temps) lets2)))
- `(define-setf-method ,func ,arg1
- ,@(and docstr (list docstr))
- (let*
- ,(nreverse
- (cons `(,store-temp
- (make-symbol ,(format "--cl-%s--" store-var)))
- (if restarg
- `((,rest-temps
- (mapcar (lambda (_) (make-symbol "--cl-var--"))
- ,restarg))
- ,@lets1)
- lets1)))
- (list ; 'values
- (,(if restarg 'list* 'list) ,@tempsr)
- (,(if restarg 'list* 'list) ,@largsr)
- (list ,store-temp)
- (let*
- ,(nreverse
- (cons (list store-var store-temp)
- lets2))
- ,@args)
- (,(if restarg 'list* 'list)
- ,@(cons (list 'quote func) tempsr))))))
- `(defsetf ,func (&rest args) (store)
- ,(let ((call `(cons ',arg1
- (append args (list store)))))
- (if (car args)
- `(list 'progn ,call store)
- call)))))
-
-;;; Some standard place types from Common Lisp.
-(defsetf aref aset)
-(defsetf car setcar)
-(defsetf cdr setcdr)
-(defsetf caar (x) (val) (list 'setcar (list 'car x) val))
-(defsetf cadr (x) (val) (list 'setcar (list 'cdr x) val))
-(defsetf cdar (x) (val) (list 'setcdr (list 'car x) val))
-(defsetf cddr (x) (val) (list 'setcdr (list 'cdr x) val))
-(defsetf elt (seq n) (store)
- (list 'if (list 'listp seq) (list 'setcar (list 'nthcdr n seq) store)
- (list 'aset seq n store)))
-(defsetf get put)
-(defsetf get* (x y &optional d) (store) (list 'put x y store))
-(defsetf gethash (x h &optional d) (store) (list 'puthash x store h))
-(defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store))
-(defsetf subseq (seq start &optional end) (new)
- (list 'progn (list 'replace seq new :start1 start :end1 end) new))
-(defsetf symbol-function fset)
-(defsetf symbol-plist setplist)
-(defsetf symbol-value set)
-
-;;; Various car/cdr aliases. Note that `cadr' is handled specially.
-(defsetf first setcar)
-(defsetf second (x) (store) (list 'setcar (list 'cdr x) store))
-(defsetf third (x) (store) (list 'setcar (list 'cddr x) store))
-(defsetf fourth (x) (store) (list 'setcar (list 'cdddr x) store))
-(defsetf fifth (x) (store) (list 'setcar (list 'nthcdr 4 x) store))
-(defsetf sixth (x) (store) (list 'setcar (list 'nthcdr 5 x) store))
-(defsetf seventh (x) (store) (list 'setcar (list 'nthcdr 6 x) store))
-(defsetf eighth (x) (store) (list 'setcar (list 'nthcdr 7 x) store))
-(defsetf ninth (x) (store) (list 'setcar (list 'nthcdr 8 x) store))
-(defsetf tenth (x) (store) (list 'setcar (list 'nthcdr 9 x) store))
-(defsetf rest setcdr)
-
-;;; Some more Emacs-related place types.
-(defsetf buffer-file-name set-visited-file-name t)
-(defsetf buffer-modified-p (&optional buf) (flag)
- (list 'with-current-buffer buf
- (list 'set-buffer-modified-p flag)))
-(defsetf buffer-name rename-buffer t)
-(defsetf buffer-string () (store)
- (list 'progn '(erase-buffer) (list 'insert store)))
-(defsetf buffer-substring cl-set-buffer-substring)
-(defsetf current-buffer set-buffer)
-(defsetf current-case-table set-case-table)
-(defsetf current-column move-to-column t)
-(defsetf current-global-map use-global-map t)
-(defsetf current-input-mode () (store)
- (list 'progn (list 'apply 'set-input-mode store) store))
-(defsetf current-local-map use-local-map t)
-(defsetf current-window-configuration set-window-configuration t)
-(defsetf default-file-modes set-default-file-modes t)
-(defsetf default-value set-default)
-(defsetf documentation-property put)
-(defsetf face-background (f &optional s) (x) (list 'set-face-background f x s))
-(defsetf face-background-pixmap (f &optional s) (x)
- (list 'set-face-background-pixmap f x s))
-(defsetf face-font (f &optional s) (x) (list 'set-face-font f x s))
-(defsetf face-foreground (f &optional s) (x) (list 'set-face-foreground f x s))
-(defsetf face-underline-p (f &optional s) (x)
- (list 'set-face-underline-p f x s))
-(defsetf file-modes set-file-modes t)
-(defsetf frame-height set-screen-height t)
-(defsetf frame-parameters modify-frame-parameters t)
-(defsetf frame-visible-p cl-set-frame-visible-p)
-(defsetf frame-width set-screen-width t)
-(defsetf frame-parameter set-frame-parameter t)
-(defsetf terminal-parameter set-terminal-parameter)
-(defsetf getenv setenv t)
-(defsetf get-register set-register)
-(defsetf global-key-binding global-set-key)
-(defsetf keymap-parent set-keymap-parent)
-(defsetf local-key-binding local-set-key)
-(defsetf mark set-mark t)
-(defsetf mark-marker set-mark t)
-(defsetf marker-position set-marker t)
-(defsetf match-data set-match-data t)
-(defsetf mouse-position (scr) (store)
- (list 'set-mouse-position scr (list 'car store) (list 'cadr store)
- (list 'cddr store)))
-(defsetf overlay-get overlay-put)
-(defsetf overlay-start (ov) (store)
- (list 'progn (list 'move-overlay ov store (list 'overlay-end ov)) store))
-(defsetf overlay-end (ov) (store)
- (list 'progn (list 'move-overlay ov (list 'overlay-start ov) store) store))
-(defsetf point goto-char)
-(defsetf point-marker goto-char t)
-(defsetf point-max () (store)
- (list 'progn (list 'narrow-to-region '(point-min) store) store))
-(defsetf point-min () (store)
- (list 'progn (list 'narrow-to-region store '(point-max)) store))
-(defsetf process-buffer set-process-buffer)
-(defsetf process-filter set-process-filter)
-(defsetf process-sentinel set-process-sentinel)
-(defsetf process-get process-put)
-(defsetf read-mouse-position (scr) (store)
- (list 'set-mouse-position scr (list 'car store) (list 'cdr store)))
-(defsetf screen-height set-screen-height t)
-(defsetf screen-width set-screen-width t)
-(defsetf selected-window select-window)
-(defsetf selected-screen select-screen)
-(defsetf selected-frame select-frame)
-(defsetf standard-case-table set-standard-case-table)
-(defsetf syntax-table set-syntax-table)
-(defsetf visited-file-modtime set-visited-file-modtime t)
-(defsetf window-buffer set-window-buffer t)
-(defsetf window-display-table set-window-display-table t)
-(defsetf window-dedicated-p set-window-dedicated-p t)
-(defsetf window-height () (store)
- (list 'progn (list 'enlarge-window (list '- store '(window-height))) store))
-(defsetf window-hscroll set-window-hscroll)
-(defsetf window-parameter set-window-parameter)
-(defsetf window-point set-window-point)
-(defsetf window-start set-window-start)
-(defsetf window-width () (store)
- (list 'progn (list 'enlarge-window (list '- store '(window-width)) t) store))
-(defsetf x-get-secondary-selection x-own-secondary-selection t)
-(defsetf x-get-selection x-own-selection t)
-
-;; This is a hack that allows (setf (eq a 7) B) to mean either
-;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
-;; This is useful when you have control over the PLACE but not over
-;; the VALUE, as is the case in define-minor-mode's :variable.
-(define-setf-method eq (place val)
- (let ((method (get-setf-method place cl-macro-environment))
- (val-temp (make-symbol "--eq-val--"))
- (store-temp (make-symbol "--eq-store--")))
- (list (append (nth 0 method) (list val-temp))
- (append (nth 1 method) (list val))
- (list store-temp)
- `(let ((,(car (nth 2 method))
- (if ,store-temp ,val-temp (not ,val-temp))))
- ,(nth 3 method) ,store-temp)
- `(eq ,(nth 4 method) ,val-temp))))
-
-;;; More complex setf-methods.
-;; These should take &environment arguments, but since full arglists aren't
-;; available while compiling cl-macs, we fake it by referring to the global
-;; variable cl-macro-environment directly.
-
-(define-setf-method apply (func arg1 &rest rest)
- (or (and (memq (car-safe func) '(quote function function*))
- (symbolp (car-safe (cdr-safe func))))
- (error "First arg to apply in setf is not (function SYM): %s" func))
- (let* ((form (cons (nth 1 func) (cons arg1 rest)))
- (method (get-setf-method form cl-macro-environment)))
- (list (car method) (nth 1 method) (nth 2 method)
- (cl-setf-make-apply (nth 3 method) (cadr func) (car method))
- (cl-setf-make-apply (nth 4 method) (cadr func) (car method)))))
-
-(defun cl-setf-make-apply (form func temps)
- (if (eq (car form) 'progn)
- (list* 'progn (cl-setf-make-apply (cadr form) func temps) (cddr form))
- (or (equal (last form) (last temps))
- (error "%s is not suitable for use with setf-of-apply" func))
- (list* 'apply (list 'quote (car form)) (cdr form))))
-
-(define-setf-method nthcdr (n place)
- (let ((method (get-setf-method place cl-macro-environment))
- (n-temp (make-symbol "--cl-nthcdr-n--"))
- (store-temp (make-symbol "--cl-nthcdr-store--")))
- (list (cons n-temp (car method))
- (cons n (nth 1 method))
- (list store-temp)
- (list 'let (list (list (car (nth 2 method))
- (list 'cl-set-nthcdr n-temp (nth 4 method)
- store-temp)))
- (nth 3 method) store-temp)
- (list 'nthcdr n-temp (nth 4 method)))))
-
-(define-setf-method getf (place tag &optional def)
- (let ((method (get-setf-method place cl-macro-environment))
- (tag-temp (make-symbol "--cl-getf-tag--"))
- (def-temp (make-symbol "--cl-getf-def--"))
- (store-temp (make-symbol "--cl-getf-store--")))
- (list (append (car method) (list tag-temp def-temp))
- (append (nth 1 method) (list tag def))
- (list store-temp)
- (list 'let (list (list (car (nth 2 method))
- (list 'cl-set-getf (nth 4 method)
- tag-temp store-temp)))
- (nth 3 method) store-temp)
- (list 'getf (nth 4 method) tag-temp def-temp))))
-
-(define-setf-method substring (place from &optional to)
- (let ((method (get-setf-method place cl-macro-environment))
- (from-temp (make-symbol "--cl-substring-from--"))
- (to-temp (make-symbol "--cl-substring-to--"))
- (store-temp (make-symbol "--cl-substring-store--")))
- (list (append (car method) (list from-temp to-temp))
- (append (nth 1 method) (list from to))
- (list store-temp)
- (list 'let (list (list (car (nth 2 method))
- (list 'cl-set-substring (nth 4 method)
- from-temp to-temp store-temp)))
- (nth 3 method) store-temp)
- (list 'substring (nth 4 method) from-temp to-temp))))
-
-;;; Getting and optimizing setf-methods.
-;;;###autoload
-(defun get-setf-method (place &optional env)
- "Return a list of five values describing the setf-method for PLACE.
-PLACE may be any Lisp form which can appear as the PLACE argument to
-a macro like `setf' or `incf'."
- (if (symbolp place)
- (let ((temp (make-symbol "--cl-setf--")))
- (list nil nil (list temp) (list 'setq place temp) place))
- (or (and (symbolp (car place))
- (let* ((func (car place))
- (name (symbol-name func))
- (method (get func 'setf-method))
- (case-fold-search nil))
- (or (and method
- (let ((cl-macro-environment env))
- (setq method (apply method (cdr place))))
- (if (and (consp method) (= (length method) 5))
- method
- (error "Setf-method for %s returns malformed method"
- func)))
- (and (string-match-p "\\`c[ad][ad][ad]?[ad]?r\\'" name)
- (get-setf-method (compiler-macroexpand place)))
- (and (eq func 'edebug-after)
- (get-setf-method (nth (1- (length place)) place)
- env)))))
- (if (eq place (setq place (macroexpand place env)))
- (if (and (symbolp (car place)) (fboundp (car place))
- (symbolp (symbol-function (car place))))
- (get-setf-method (cons (symbol-function (car place))
- (cdr place)) env)
- (error "No setf-method known for %s" (car place)))
- (get-setf-method place env)))))
-
-(defun cl-setf-do-modify (place opt-expr)
- (let* ((method (get-setf-method place cl-macro-environment))
- (temps (car method)) (values (nth 1 method))
- (lets nil) (subs nil)
- (optimize (and (not (eq opt-expr 'no-opt))
- (or (and (not (eq opt-expr 'unsafe))
- (cl-safe-expr-p opt-expr))
- (cl-setf-simple-store-p (car (nth 2 method))
- (nth 3 method)))))
- (simple (and optimize (consp place) (cl-simple-exprs-p (cdr place)))))
- (while values
- (if (or simple (cl-const-expr-p (car values)))
- (push (cons (pop temps) (pop values)) subs)
- (push (list (pop temps) (pop values)) lets)))
- (list (nreverse lets)
- (cons (car (nth 2 method)) (sublis subs (nth 3 method)))
- (sublis subs (nth 4 method)))))
-
-(defun cl-setf-do-store (spec val)
- (let ((sym (car spec))
- (form (cdr spec)))
- (if (or (cl-const-expr-p val)
- (and (cl-simple-expr-p val) (eq (cl-expr-contains form sym) 1))
- (cl-setf-simple-store-p sym form))
- (subst val sym form)
- (list 'let (list (list sym val)) form))))
-
-(defun cl-setf-simple-store-p (sym form)
- (and (consp form) (eq (cl-expr-contains form sym) 1)
- (eq (nth (1- (length form)) form) sym)
- (symbolp (car form)) (fboundp (car form))
- (not (eq (car-safe (symbol-function (car form))) 'macro))))
-
;;; The standard modify macros.
-;;;###autoload
-(defmacro setf (&rest args)
- "Set each PLACE to the value of its VAL.
-This is a generalized version of `setq'; the PLACEs may be symbolic
-references such as (car x) or (aref x i), as well as plain symbols.
-For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y).
-The return value is the last VAL in the list.
-\(fn PLACE VAL PLACE VAL ...)"
- (if (cdr (cdr args))
- (let ((sets nil))
- (while args (push (list 'setf (pop args) (pop args)) sets))
- (cons 'progn (nreverse sets)))
- (if (symbolp (car args))
- (and args (cons 'setq args))
- (let* ((method (cl-setf-do-modify (car args) (nth 1 args)))
- (store (cl-setf-do-store (nth 1 method) (nth 1 args))))
- (if (car method) (list 'let* (car method) store) store)))))
+;; `setf' is now part of core Elisp, defined in gv.el.
;;;###autoload
-(defmacro psetf (&rest args)
+(defmacro cl-psetf (&rest args)
"Set PLACEs to the values VALs in parallel.
This is like `setf', except that all VAL forms are evaluated (in order)
before assigning any PLACEs to the corresponding values.
\(fn PLACE VAL PLACE VAL ...)"
+ (declare (debug setf))
(let ((p args) (simple t) (vars nil))
(while p
- (if (or (not (symbolp (car p))) (cl-expr-depends-p (nth 1 p) vars))
+ (if (or (not (symbolp (car p))) (cl--expr-depends-p (nth 1 p) vars))
(setq simple nil))
(if (memq (car p) vars)
(error "Destination duplicated in psetf: %s" (car p)))
(push (pop p) vars)
- (or p (error "Odd number of arguments to psetf"))
+ (or p (error "Odd number of arguments to cl-psetf"))
(pop p))
(if simple
- (list 'progn (cons 'setf args) nil)
+ `(progn (setq ,@args) nil)
(setq args (reverse args))
- (let ((expr (list 'setf (cadr args) (car args))))
+ (let ((expr `(setf ,(cadr args) ,(car args))))
(while (setq args (cddr args))
- (setq expr (list 'setf (cadr args) (list 'prog1 (car args) expr))))
- (list 'progn expr nil)))))
-
-;;;###autoload
-(defun cl-do-pop (place)
- (if (cl-simple-expr-p place)
- (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place)))
- (let* ((method (cl-setf-do-modify place t))
- (temp (make-symbol "--cl-pop--")))
- (list 'let*
- (append (car method)
- (list (list temp (nth 2 method))))
- (list 'prog1
- (list 'car temp)
- (cl-setf-do-store (nth 1 method) (list 'cdr temp)))))))
+ (setq expr `(setf ,(cadr args) (prog1 ,(car args) ,expr))))
+ `(progn ,expr nil)))))
;;;###autoload
-(defmacro remf (place tag)
+(defmacro cl-remf (place tag)
"Remove TAG from property list PLACE.
PLACE may be a symbol, or any generalized variable allowed by `setf'.
The form returns true if TAG was found and removed, nil otherwise."
- (let* ((method (cl-setf-do-modify place t))
- (tag-temp (and (not (cl-const-expr-p tag)) (make-symbol "--cl-remf-tag--")))
- (val-temp (and (not (cl-simple-expr-p place))
- (make-symbol "--cl-remf-place--")))
- (ttag (or tag-temp tag))
- (tval (or val-temp (nth 2 method))))
- (list 'let*
- (append (car method)
- (and val-temp (list (list val-temp (nth 2 method))))
- (and tag-temp (list (list tag-temp tag))))
- (list 'if (list 'eq ttag (list 'car tval))
- (list 'progn
- (cl-setf-do-store (nth 1 method) (list 'cddr tval))
- t)
- (list 'cl-do-remf tval ttag)))))
+ (declare (debug (place form)))
+ (gv-letplace (tval setter) place
+ (macroexp-let2 macroexp-copyable-p ttag tag
+ `(if (eq ,ttag (car ,tval))
+ (progn ,(funcall setter `(cddr ,tval))
+ t)
+ (cl--do-remf ,tval ,ttag)))))
;;;###autoload
-(defmacro shiftf (place &rest args)
+(defmacro cl-shiftf (place &rest args)
"Shift left among PLACEs.
-Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
+Example: (cl-shiftf A B C) sets A to B, B to C, and returns the old A.
Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
\(fn PLACE... VAL)"
+ (declare (debug (&rest place)))
(cond
((null args) place)
- ((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args))))
+ ((symbolp place) `(prog1 ,place (setq ,place (cl-shiftf ,@args))))
(t
- (let ((method (cl-setf-do-modify place 'unsafe)))
- `(let* ,(car method)
- (prog1 ,(nth 2 method)
- ,(cl-setf-do-store (nth 1 method) `(shiftf ,@args))))))))
+ (gv-letplace (getter setter) place
+ `(prog1 ,getter
+ ,(funcall setter `(cl-shiftf ,@args)))))))
;;;###autoload
-(defmacro rotatef (&rest args)
+(defmacro cl-rotatef (&rest args)
"Rotate left among PLACEs.
-Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil.
+Example: (cl-rotatef A B C) sets A to B, B to C, and C to A. It returns nil.
Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
\(fn PLACE...)"
+ (declare (debug (&rest place)))
(if (not (memq nil (mapcar 'symbolp args)))
(and (cdr args)
(let ((sets nil)
(first (car args)))
(while (cdr args)
(setq sets (nconc sets (list (pop args) (car args)))))
- (nconc (list 'psetf) sets (list (car args) first))))
+ `(cl-psetf ,@sets ,(car args) ,first)))
(let* ((places (reverse args))
(temp (make-symbol "--cl-rotatef--"))
(form temp))
(while (cdr places)
- (let ((method (cl-setf-do-modify (pop places) 'unsafe)))
- (setq form (list 'let* (car method)
- (list 'prog1 (nth 2 method)
- (cl-setf-do-store (nth 1 method) form))))))
- (let ((method (cl-setf-do-modify (car places) 'unsafe)))
- (list 'let* (append (car method) (list (list temp (nth 2 method))))
- (cl-setf-do-store (nth 1 method) form) nil)))))
+ (setq form
+ (gv-letplace (getter setter) (pop places)
+ `(prog1 ,getter ,(funcall setter form)))))
+ (gv-letplace (getter setter) (car places)
+ (macroexp-let* `((,temp ,getter))
+ `(progn ,(funcall setter form) nil))))))
+
+;; FIXME: `letf' is unsatisfactory because it does not really "restore" the
+;; previous state. If the getter/setter loses information, that info is
+;; not recovered.
+
+(defun cl--letf (bindings simplebinds binds body)
+ ;; It's not quite clear what the semantics of cl-letf should be.
+ ;; E.g. in (cl-letf ((PLACE1 VAL1) (PLACE2 VAL2)) BODY), while it's clear
+ ;; that the actual assignments ("bindings") should only happen after
+ ;; evaluating VAL1 and VAL2, it's not clear when the sub-expressions of
+ ;; PLACE1 and PLACE2 should be evaluated. Should we have
+ ;; PLACE1; VAL1; PLACE2; VAL2; bind1; bind2
+ ;; or
+ ;; VAL1; VAL2; PLACE1; PLACE2; bind1; bind2
+ ;; or
+ ;; VAL1; VAL2; PLACE1; bind1; PLACE2; bind2
+ ;; Common-Lisp's `psetf' does the first, so we'll do the same.
+ (if (null bindings)
+ (if (and (null binds) (null simplebinds)) (macroexp-progn body)
+ `(let* (,@(mapcar (lambda (x)
+ (pcase-let ((`(,vold ,getter ,_setter ,_vnew) x))
+ (list vold getter)))
+ binds)
+ ,@simplebinds)
+ (unwind-protect
+ ,(macroexp-progn
+ (append
+ (delq nil
+ (mapcar (lambda (x)
+ (pcase x
+ ;; If there's no vnew, do nothing.
+ (`(,_vold ,_getter ,setter ,vnew)
+ (funcall setter vnew))))
+ binds))
+ body))
+ ,@(mapcar (lambda (x)
+ (pcase-let ((`(,vold ,_getter ,setter ,_vnew) x))
+ (funcall setter vold)))
+ binds))))
+ (let ((binding (car bindings)))
+ (gv-letplace (getter setter) (car binding)
+ (macroexp-let2 nil vnew (cadr binding)
+ (if (symbolp (car binding))
+ ;; Special-case for simple variables.
+ (cl--letf (cdr bindings)
+ (cons `(,getter ,(if (cdr binding) vnew getter))
+ simplebinds)
+ binds body)
+ (cl--letf (cdr bindings) simplebinds
+ (cons `(,(make-symbol "old") ,getter ,setter
+ ,@(if (cdr binding) (list vnew)))
+ binds)
+ body)))))))
;;;###autoload
-(defmacro letf (bindings &rest body)
+(defmacro cl-letf (bindings &rest body)
"Temporarily bind to PLACEs.
This is the analogue of `let', but with generalized variables (in the
sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
@@ -2147,119 +2110,53 @@ As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
the PLACE is not modified before executing BODY.
\(fn ((PLACE VALUE) ...) BODY...)"
+ (declare (indent 1) (debug ((&rest (gate gv-place &optional form)) body)))
(if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings)))
- (list* 'let bindings body)
- (let ((lets nil) (sets nil)
- (unsets nil) (rev (reverse bindings)))
- (while rev
- (let* ((place (if (symbolp (caar rev))
- (list 'symbol-value (list 'quote (caar rev)))
- (caar rev)))
- (value (cadar rev))
- (method (cl-setf-do-modify place 'no-opt))
- (save (make-symbol "--cl-letf-save--"))
- (bound (and (memq (car place) '(symbol-value symbol-function))
- (make-symbol "--cl-letf-bound--")))
- (temp (and (not (cl-const-expr-p value)) (cdr bindings)
- (make-symbol "--cl-letf-val--"))))
- (setq lets (nconc (car method)
- (if bound
- (list (list bound
- (list (if (eq (car place)
- 'symbol-value)
- 'boundp 'fboundp)
- (nth 1 (nth 2 method))))
- (list save (list 'and bound
- (nth 2 method))))
- (list (list save (nth 2 method))))
- (and temp (list (list temp value)))
- lets)
- body (list
- (list 'unwind-protect
- (cons 'progn
- (if (cdr (car rev))
- (cons (cl-setf-do-store (nth 1 method)
- (or temp value))
- body)
- body))
- (if bound
- (list 'if bound
- (cl-setf-do-store (nth 1 method) save)
- (list (if (eq (car place) 'symbol-value)
- 'makunbound 'fmakunbound)
- (nth 1 (nth 2 method))))
- (cl-setf-do-store (nth 1 method) save))))
- rev (cdr rev))))
- (list* 'let* lets body))))
+ `(let ,bindings ,@body)
+ (cl--letf bindings () () body)))
;;;###autoload
-(defmacro letf* (bindings &rest body)
+(defmacro cl-letf* (bindings &rest body)
"Temporarily bind to PLACEs.
-This is the analogue of `let*', but with generalized variables (in the
-sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
-VALUE, then the BODY forms are executed. On exit, either normally or
-because of a `throw' or error, the PLACEs are set back to their original
-values. Note that this macro is *not* available in Common Lisp.
-As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
-the PLACE is not modified before executing BODY.
-
-\(fn ((PLACE VALUE) ...) BODY...)"
- (if (null bindings)
- (cons 'progn body)
- (setq bindings (reverse bindings))
- (while bindings
- (setq body (list (list* 'letf (list (pop bindings)) body))))
- (car body)))
+Like `cl-letf' but where the bindings are performed one at a time,
+rather than all at the end (i.e. like `let*' rather than like `let')."
+ (declare (indent 1) (debug cl-letf))
+ (dolist (binding (reverse bindings))
+ (setq body (list `(cl-letf (,binding) ,@body))))
+ (macroexp-progn body))
;;;###autoload
-(defmacro callf (func place &rest args)
+(defmacro cl-callf (func place &rest args)
"Set PLACE to (FUNC PLACE ARGS...).
FUNC should be an unquoted function name. PLACE may be a symbol,
-or any generalized variable allowed by `setf'.
-
-\(fn FUNC PLACE ARGS...)"
- (let* ((method (cl-setf-do-modify place (cons 'list args)))
- (rargs (cons (nth 2 method) args)))
- (list 'let* (car method)
- (cl-setf-do-store (nth 1 method)
- (if (symbolp func) (cons func rargs)
- (list* 'funcall (list 'function func)
- rargs))))))
+or any generalized variable allowed by `setf'."
+ (declare (indent 2) (debug (cl-function place &rest form)))
+ (gv-letplace (getter setter) place
+ (let* ((rargs (cons getter args)))
+ (funcall setter
+ (if (symbolp func) (cons func rargs)
+ `(funcall #',func ,@rargs))))))
;;;###autoload
-(defmacro callf2 (func arg1 place &rest args)
+(defmacro cl-callf2 (func arg1 place &rest args)
"Set PLACE to (FUNC ARG1 PLACE ARGS...).
-Like `callf', but PLACE is the second argument of FUNC, not the first.
+Like `cl-callf', but PLACE is the second argument of FUNC, not the first.
\(fn FUNC ARG1 PLACE ARGS...)"
- (if (and (cl-safe-expr-p arg1) (cl-simple-expr-p place) (symbolp func))
- (list 'setf place (list* func arg1 place args))
- (let* ((method (cl-setf-do-modify place (cons 'list args)))
- (temp (and (not (cl-const-expr-p arg1)) (make-symbol "--cl-arg1--")))
- (rargs (list* (or temp arg1) (nth 2 method) args)))
- (list 'let* (append (and temp (list (list temp arg1))) (car method))
- (cl-setf-do-store (nth 1 method)
- (if (symbolp func) (cons func rargs)
- (list* 'funcall (list 'function func)
- rargs)))))))
-
-;;;###autoload
-(defmacro define-modify-macro (name arglist func &optional doc)
- "Define a `setf'-like modify macro.
-If NAME is called, it combines its PLACE argument with the other arguments
-from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
- (if (memq '&key arglist) (error "&key not allowed in define-modify-macro"))
- (let ((place (make-symbol "--cl-place--")))
- (list 'defmacro* name (cons place arglist) doc
- (list* (if (memq '&rest arglist) 'list* 'list)
- '(quote callf) (list 'quote func) place
- (cl-arglist-args arglist)))))
-
+ (declare (indent 3) (debug (cl-function form place &rest form)))
+ (if (and (cl--safe-expr-p arg1) (cl--simple-expr-p place) (symbolp func))
+ `(setf ,place (,func ,arg1 ,place ,@args))
+ (macroexp-let2 nil a1 arg1
+ (gv-letplace (getter setter) place
+ (let* ((rargs (cl-list* a1 getter args)))
+ (funcall setter
+ (if (symbolp func) (cons func rargs)
+ `(funcall #',func ,@rargs))))))))
;;; Structures.
;;;###autoload
-(defmacro defstruct (struct &rest descs)
+(defmacro cl-defstruct (struct &rest descs)
"Define a struct type.
This macro defines a new data type called NAME that stores data
in SLOTs. It defines a `make-NAME' constructor, a `copy-NAME'
@@ -2267,8 +2164,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
@@ -2276,6 +2174,26 @@ one keyword is supported, `:read-only'. If this has a non-nil
value, that slot cannot be set via `setf'.
\(fn NAME SLOTS...)"
+ (declare (doc-string 2) (indent 1)
+ (debug
+ (&define ;Makes top-level form not be wrapped.
+ [&or symbolp
+ (gate
+ symbolp &rest
+ (&or [":conc-name" symbolp]
+ [":constructor" symbolp &optional cl-lambda-list]
+ [":copier" symbolp]
+ [":predicate" symbolp]
+ [":include" symbolp &rest sexp] ;; Not finished.
+ ;; The following are not supported.
+ ;; [":print-function" ...]
+ ;; [":type" ...]
+ ;; [":initial-offset" ...]
+ ))]
+ [&optional stringp]
+ ;; All the above is for the following def-form.
+ &rest &or symbolp (symbolp def-form
+ &optional ":read-only" sexp))))
(let* ((name (if (consp struct) (car struct) struct))
(opts (cdr-safe struct))
(slots nil)
@@ -2286,7 +2204,7 @@ value, that slot cannot be set via `setf'.
(copier (intern (format "copy-%s" name)))
(predicate (intern (format "%s-p" name)))
(print-func nil) (print-auto nil)
- (safety (if (cl-compiling-file) cl-optimize-safety 3))
+ (safety (if (cl--compiling-file) cl-optimize-safety 3))
(include nil)
(tag (intern (format "cl-struct-%s" name)))
(tag-symbol (intern (format "cl-struct-%s-tags" name)))
@@ -2297,8 +2215,8 @@ value, that slot cannot be set via `setf'.
(forms nil)
pred-form pred-check)
(if (stringp (car descs))
- (push (list 'put (list 'quote name) '(quote structure-documentation)
- (pop descs)) forms))
+ (push `(put ',name 'structure-documentation
+ ,(pop descs)) forms))
(setq descs (cons '(cl-tag-slot)
(mapcar (function (lambda (x) (if (consp x) x (list x))))
descs)))
@@ -2340,15 +2258,13 @@ value, that slot cannot be set via `setf'.
(t
(error "Slot option %s unrecognized" opt)))))
(if print-func
- (setq print-func (list 'progn
- (list 'funcall (list 'function print-func)
- 'cl-x 'cl-s 'cl-n) t))
+ (setq print-func
+ `(progn (funcall #',print-func cl-x cl-s cl-n) t))
(or type (and include (not (get include 'cl-struct-print)))
(setq print-auto t
print-func (and (or (not (or include type)) (null print-func))
- (list 'progn
- (list 'princ (format "#S(%s" name)
- 'cl-s))))))
+ `(progn
+ (princ ,(format "#S(%s" name) cl-s))))))
(if include
(let ((inc-type (get include 'cl-struct-type))
(old-descs (get include 'cl-struct-slots)))
@@ -2367,9 +2283,9 @@ value, that slot cannot be set via `setf'.
(if (cadr inc-type) (setq tag name named t))
(let ((incl include))
(while incl
- (push (list 'pushnew (list 'quote tag)
- (intern (format "cl-struct-%s-tags" incl)))
- forms)
+ (push `(cl-pushnew ',tag
+ ,(intern (format "cl-struct-%s-tags" incl)))
+ forms)
(setq incl (get incl 'cl-struct-include)))))
(if type
(progn
@@ -2378,25 +2294,23 @@ value, that slot cannot be set via `setf'.
(if named (setq tag name)))
(setq type 'vector named 'true)))
(or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
- (push (list 'defvar tag-symbol) forms)
+ (push `(defvar ,tag-symbol) forms)
(setq pred-form (and named
(let ((pos (- (length descs)
(length (memq (assq 'cl-tag-slot descs)
descs)))))
(if (eq type 'vector)
- (list 'and '(vectorp cl-x)
- (list '>= '(length cl-x) (length descs))
- (list 'memq (list 'aref 'cl-x pos)
- tag-symbol))
+ `(and (vectorp cl-x)
+ (>= (length cl-x) ,(length descs))
+ (memq (aref cl-x ,pos) ,tag-symbol))
(if (= pos 0)
- (list 'memq '(car-safe cl-x) tag-symbol)
- (list 'and '(consp cl-x)
- (list 'memq (list 'nth pos 'cl-x)
- tag-symbol))))))
+ `(memq (car-safe cl-x) ,tag-symbol)
+ `(and (consp cl-x)
+ (memq (nth ,pos cl-x) ,tag-symbol))))))
pred-check (and pred-form (> safety 0)
- (if (and (eq (caadr pred-form) 'vectorp)
+ (if (and (eq (cl-caadr pred-form) 'vectorp)
(= safety 1))
- (cons 'and (cdddr pred-form)) pred-form)))
+ (cons 'and (cl-cdddr pred-form)) pred-form)))
(let ((pos 0) (descp descs))
(while descp
(let* ((desc (pop descp))
@@ -2404,54 +2318,60 @@ value, that slot cannot be set via `setf'.
(if (memq slot '(cl-tag-slot cl-skip-slot))
(progn
(push nil slots)
- (push (and (eq slot 'cl-tag-slot) (list 'quote tag))
+ (push (and (eq slot 'cl-tag-slot) `',tag)
defaults))
(if (assq slot descp)
(error "Duplicate slots named %s in %s" slot name))
(let ((accessor (intern (format "%s%s" conc-name slot))))
(push slot slots)
(push (nth 1 desc) defaults)
- (push (list*
- 'defsubst* accessor '(cl-x)
- (append
- (and pred-check
- (list (list 'or pred-check
- `(error "%s accessing a non-%s"
- ',accessor ',name))))
- (list (if (eq type 'vector) (list 'aref 'cl-x pos)
- (if (= pos 0) '(car cl-x)
- (list 'nth pos 'cl-x)))))) forms)
+ (push `(cl-defsubst ,accessor (cl-x)
+ ,@(and pred-check
+ (list `(or ,pred-check
+ (error "%s accessing a non-%s"
+ ',accessor ',name))))
+ ,(if (eq type 'vector) `(aref cl-x ,pos)
+ (if (= pos 0) '(car cl-x)
+ `(nth ,pos cl-x)))) forms)
(push (cons accessor t) side-eff)
- (push (list 'define-setf-method accessor '(cl-x)
- (if (cadr (memq :read-only (cddr desc)))
- (list 'progn '(ignore cl-x)
- `(error "%s is a read-only slot"
- ',accessor))
- ;; If cl is loaded only for compilation,
- ;; the call to cl-struct-setf-expander would
- ;; cause a warning because it may not be
- ;; defined at run time. Suppress that warning.
- (list 'with-no-warnings
- (list 'cl-struct-setf-expander 'cl-x
- (list 'quote name) (list 'quote accessor)
- (and pred-check (list 'quote pred-check))
- pos))))
- forms)
+ (if (cadr (memq :read-only (cddr desc)))
+ (push `(gv-define-expander ,accessor
+ (lambda (_cl-do _cl-x)
+ (error "%s is a read-only slot" ',accessor)))
+ forms)
+ ;; For normal slots, we don't need to define a setf-expander,
+ ;; since gv-get can use the compiler macro to get the
+ ;; same result.
+ ;; (push `(gv-define-setter ,accessor (cl-val cl-x)
+ ;; ;; If cl is loaded only for compilation,
+ ;; ;; the call to cl--struct-setf-expander would
+ ;; ;; cause a warning because it may not be
+ ;; ;; defined at run time. Suppress that warning.
+ ;; (progn
+ ;; (declare-function
+ ;; cl--struct-setf-expander "cl-macs"
+ ;; (x name accessor pred-form pos))
+ ;; (cl--struct-setf-expander
+ ;; cl-val cl-x ',name ',accessor
+ ;; ,(and pred-check `',pred-check)
+ ;; ,pos)))
+ ;; forms)
+ )
(if print-auto
(nconc print-func
- (list (list 'princ (format " %s" slot) 'cl-s)
- (list 'prin1 (list accessor 'cl-x) 'cl-s)))))))
+ (list `(princ ,(format " %s" slot) cl-s)
+ `(prin1 (,accessor cl-x) cl-s)))))))
(setq pos (1+ pos))))
(setq slots (nreverse slots)
defaults (nreverse defaults))
(and predicate pred-form
- (progn (push (list 'defsubst* predicate '(cl-x)
- (if (eq (car pred-form) 'and)
- (append pred-form '(t))
- (list 'and pred-form t))) forms)
+ (progn (push `(cl-defsubst ,predicate (cl-x)
+ ,(if (eq (car pred-form) 'and)
+ (append pred-form '(t))
+ `(and ,pred-form t))) forms)
(push (cons predicate 'error-free) side-eff)))
(and copier
- (progn (push (list 'defun copier '(x) '(copy-sequence x)) forms)
+ (progn (push `(defun ,copier (x) (copy-sequence x)) forms)
(push (cons copier t) side-eff)))
(if constructor
(push (list constructor
@@ -2460,85 +2380,60 @@ value, that slot cannot be set via `setf'.
(while constrs
(let* ((name (caar constrs))
(args (cadr (pop constrs)))
- (anames (cl-arglist-args args))
- (make (mapcar* (function (lambda (s d) (if (memq s anames) s d)))
+ (anames (cl--arglist-args args))
+ (make (cl-mapcar (function (lambda (s d) (if (memq s anames) s d)))
slots defaults)))
- (push (list 'defsubst* name
- (list* '&cl-defs (list 'quote (cons nil descs)) args)
- (cons type make)) forms)
- (if (cl-safe-expr-p (cons 'progn (mapcar 'second descs)))
+ (push `(cl-defsubst ,name
+ (&cl-defs '(nil ,@descs) ,@args)
+ (,type ,@make)) forms)
+ (if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
(push (cons name t) side-eff))))
(if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
- (if print-func
- (push `(push
- ;; The auto-generated function does not pay attention to
- ;; the depth argument cl-n.
- (lambda (cl-x cl-s ,(if print-auto '_cl-n 'cl-n))
- (and ,pred-form ,print-func))
- custom-print-functions)
- forms))
- (push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms)
- (push (list* 'eval-when '(compile load eval)
- (list 'put (list 'quote name) '(quote cl-struct-slots)
- (list 'quote descs))
- (list 'put (list 'quote name) '(quote cl-struct-type)
- (list 'quote (list type (eq named t))))
- (list 'put (list 'quote name) '(quote cl-struct-include)
- (list 'quote include))
- (list 'put (list 'quote name) '(quote cl-struct-print)
- print-auto)
- (mapcar (function (lambda (x)
- (list 'put (list 'quote (car x))
- '(quote side-effect-free)
- (list 'quote (cdr x)))))
- side-eff))
- forms)
- (cons 'progn (nreverse (cons (list 'quote name) forms)))))
-
-;;;###autoload
-(defun cl-struct-setf-expander (x name accessor pred-form pos)
- (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-store--")))
- (list (list temp) (list x) (list store)
- (append '(progn)
- (and pred-form
- (list (list 'or (subst temp 'cl-x pred-form)
- (list 'error
- (format
- "%s storing a non-%s" accessor name)))))
- (list (if (eq (car (get name 'cl-struct-type)) 'vector)
- (list 'aset temp pos store)
- (list 'setcar
- (if (<= pos 5)
- (let ((xx temp))
- (while (>= (setq pos (1- pos)) 0)
- (setq xx (list 'cdr xx)))
- xx)
- (list 'nthcdr pos temp))
- store))))
- (list accessor temp))))
-
+ ;; Don't bother adding to cl-custom-print-functions since it's not used
+ ;; by anything anyway!
+ ;;(if print-func
+ ;; (push `(if (boundp 'cl-custom-print-functions)
+ ;; (push
+ ;; ;; The auto-generated function does not pay attention to
+ ;; ;; the depth argument cl-n.
+ ;; (lambda (cl-x cl-s ,(if print-auto '_cl-n 'cl-n))
+ ;; (and ,pred-form ,print-func))
+ ;; cl-custom-print-functions))
+ ;; forms))
+ (push `(setq ,tag-symbol (list ',tag)) forms)
+ (push `(cl-eval-when (compile load eval)
+ (put ',name 'cl-struct-slots ',descs)
+ (put ',name 'cl-struct-type ',(list type (eq named t)))
+ (put ',name 'cl-struct-include ',include)
+ (put ',name 'cl-struct-print ,print-auto)
+ ,@(mapcar (lambda (x)
+ `(put ',(car x) 'side-effect-free ',(cdr x)))
+ side-eff))
+ forms)
+ `(progn ,@(nreverse (cons `',name forms)))))
;;; Types and assertions.
;;;###autoload
-(defmacro deftype (name arglist &rest body)
+(defmacro cl-deftype (name arglist &rest body)
"Define NAME as a new data type.
-The type name can then be used in `typecase', `check-type', etc."
- (list 'eval-when '(compile load eval)
- (cl-transform-function-property
- name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) arglist) body))))
+The type name can then be used in `cl-typecase', `cl-check-type', etc."
+ (declare (debug cl-defmacro) (doc-string 3))
+ `(cl-eval-when (compile load eval)
+ (put ',name 'cl-deftype-handler
+ (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body)))))
-(defun cl-make-type-test (val type)
+(defun cl--make-type-test (val type)
(if (symbolp type)
(cond ((get type 'cl-deftype-handler)
- (cl-make-type-test val (funcall (get type 'cl-deftype-handler))))
+ (cl--make-type-test val (funcall (get type 'cl-deftype-handler))))
((memq type '(nil t)) type)
((eq type 'null) `(null ,val))
((eq type 'atom) `(atom ,val))
- ((eq type 'float) `(floatp-safe ,val))
+ ((eq type 'float) `(cl-floatp-safe ,val))
((eq type 'real) `(numberp ,val))
((eq type 'fixnum) `(integerp ,val))
- ;; FIXME: Should `character' accept things like ?\C-\M-a ? -stef
+ ;; FIXME: Should `character' accept things like ?\C-\M-a ? --Stef
((memq type '(character string-char)) `(characterp ,val))
(t
(let* ((name (symbol-name type))
@@ -2546,73 +2441,77 @@ The type name can then be used in `typecase', `check-type', etc."
(if (fboundp namep) (list namep val)
(list (intern (concat name "-p")) val)))))
(cond ((get (car type) 'cl-deftype-handler)
- (cl-make-type-test val (apply (get (car type) 'cl-deftype-handler)
+ (cl--make-type-test val (apply (get (car type) 'cl-deftype-handler)
(cdr type))))
((memq (car type) '(integer float real number))
- (delq t (list 'and (cl-make-type-test val (car type))
- (if (memq (cadr type) '(* nil)) t
- (if (consp (cadr type)) (list '> val (caadr type))
- (list '>= val (cadr type))))
- (if (memq (caddr type) '(* nil)) t
- (if (consp (caddr type)) (list '< val (caaddr type))
- (list '<= val (caddr type)))))))
+ (delq t `(and ,(cl--make-type-test val (car type))
+ ,(if (memq (cadr type) '(* nil)) t
+ (if (consp (cadr type)) `(> ,val ,(cl-caadr type))
+ `(>= ,val ,(cadr type))))
+ ,(if (memq (cl-caddr type) '(* nil)) t
+ (if (consp (cl-caddr type)) `(< ,val ,(cl-caaddr type))
+ `(<= ,val ,(cl-caddr type)))))))
((memq (car type) '(and or not))
(cons (car type)
- (mapcar (function (lambda (x) (cl-make-type-test val x)))
+ (mapcar (function (lambda (x) (cl--make-type-test val x)))
(cdr type))))
- ((memq (car type) '(member member*))
- (list 'and (list 'member* val (list 'quote (cdr type))) t))
+ ((memq (car type) '(member cl-member))
+ `(and (cl-member ,val ',(cdr type)) t))
((eq (car type) 'satisfies) (list (cadr type) val))
(t (error "Bad type spec: %s" type)))))
+(defvar cl--object)
;;;###autoload
-(defun typep (object type) ; See compiler macro below.
+(defun cl-typep (object type) ; See compiler macro below.
"Check that OBJECT is of type TYPE.
TYPE is a Common Lisp-style type specifier."
- (eval (cl-make-type-test 'object type)))
+ (let ((cl--object object)) ;; Yuck!!
+ (eval (cl--make-type-test 'cl--object type))))
;;;###autoload
-(defmacro check-type (form type &optional string)
+(defmacro cl-check-type (form type &optional string)
"Verify that FORM is of type TYPE; signal an error if not.
STRING is an optional description of the desired type."
- (and (or (not (cl-compiling-file))
+ (declare (debug (place cl-type-spec &optional stringp)))
+ (and (or (not (cl--compiling-file))
(< cl-optimize-speed 3) (= cl-optimize-safety 3))
- (let* ((temp (if (cl-simple-expr-p form 3)
+ (let* ((temp (if (cl--simple-expr-p form 3)
form (make-symbol "--cl-var--")))
- (body (list 'or (cl-make-type-test temp type)
- (list 'signal '(quote wrong-type-argument)
- (list 'list (or string (list 'quote type))
- temp (list 'quote form))))))
- (if (eq temp form) (list 'progn body nil)
- (list 'let (list (list temp form)) body nil)))))
+ (body `(or ,(cl--make-type-test temp type)
+ (signal 'wrong-type-argument
+ (list ,(or string `',type)
+ ,temp ',form)))))
+ (if (eq temp form) `(progn ,body nil)
+ `(let ((,temp ,form)) ,body nil)))))
;;;###autoload
-(defmacro assert (form &optional show-args string &rest args)
+(defmacro cl-assert (form &optional show-args string &rest args)
+ ;; FIXME: This is actually not compatible with Common-Lisp's `assert'.
"Verify that FORM returns non-nil; signal an error if not.
Second arg SHOW-ARGS means to include arguments of FORM in message.
Other args STRING and ARGS... are arguments to be passed to `error'.
They are not evaluated unless the assertion fails. If STRING is
omitted, a default message listing FORM itself is used."
- (and (or (not (cl-compiling-file))
+ (declare (debug (form &rest form)))
+ (and (or (not (cl--compiling-file))
(< cl-optimize-speed 3) (= cl-optimize-safety 3))
(let ((sargs (and show-args
- (delq nil (mapcar
- (lambda (x)
- (unless (cl-const-expr-p x)
- x))
- (cdr form))))))
- (list 'progn
- (list 'or form
- (if string
- (list* 'error string (append sargs args))
- (list 'signal '(quote cl-assertion-failed)
- (list* 'list (list 'quote form) sargs))))
- nil))))
+ (delq nil (mapcar (lambda (x)
+ (unless (macroexp-const-p x)
+ x))
+ (cdr form))))))
+ `(progn
+ (or ,form
+ ,(if string
+ `(error ,string ,@sargs ,@args)
+ `(signal 'cl-assertion-failed
+ (list ',form ,@sargs))))
+ nil))))
;;; Compiler macros.
;;;###autoload
-(defmacro define-compiler-macro (func args &rest body)
+(defmacro cl-define-compiler-macro (func args &rest body)
"Define a compiler-only macro.
This is like `defmacro', but macro expansion occurs only if the call to
FUNC is compiled (i.e., not interpreted). Compiler macros should be used
@@ -2623,58 +2522,49 @@ compiler macros are expanded repeatedly until no further expansions are
possible. Unlike regular macros, BODY can decide to \"punt\" and leave the
original function call alone by declaring an initial `&whole foo' parameter
and then returning foo."
+ (declare (debug cl-defmacro))
(let ((p args) (res nil))
(while (consp p) (push (pop p) res))
(setq args (nconc (nreverse res) (and p (list '&rest p)))))
- (list 'eval-when '(compile load eval)
- (cl-transform-function-property
- func 'cl-compiler-macro
- (cons (if (memq '&whole args) (delq '&whole args)
- (cons '_cl-whole-arg args)) body))
- (list 'or (list 'get (list 'quote func) '(quote byte-compile))
- (list 'progn
- (list 'put (list 'quote func) '(quote byte-compile)
- '(quote cl-byte-compile-compiler-macro))
- ;; This is so that describe-function can locate
- ;; the macro definition.
- (list 'let
- (list (list
- 'file
- (or buffer-file-name
- (and (boundp 'byte-compile-current-file)
- (stringp byte-compile-current-file)
- byte-compile-current-file))))
- (list 'if 'file
- (list 'put (list 'quote func)
- '(quote compiler-macro-file)
- '(purecopy (file-name-nondirectory file)))))))))
+ `(cl-eval-when (compile load eval)
+ (put ',func 'compiler-macro
+ (cl-function (lambda ,(if (memq '&whole args) (delq '&whole args)
+ (cons '_cl-whole-arg args))
+ ,@body)))
+ ;; This is so that describe-function can locate
+ ;; the macro definition.
+ (let ((file ,(or buffer-file-name
+ (and (boundp 'byte-compile-current-file)
+ (stringp byte-compile-current-file)
+ byte-compile-current-file))))
+ (if file (put ',func 'compiler-macro-file
+ (purecopy (file-name-nondirectory file)))))))
;;;###autoload
-(defun compiler-macroexpand (form)
+(defun cl-compiler-macroexpand (form)
+ "Like `macroexpand', but for compiler macros.
+Expands FORM repeatedly until no further expansion is possible.
+Returns FORM unchanged if it has no compiler macro, or if it has a
+macro that returns its `&whole' argument."
(while
(let ((func (car-safe form)) (handler nil))
(while (and (symbolp func)
- (not (setq handler (get func 'cl-compiler-macro)))
+ (not (setq handler (get func 'compiler-macro)))
(fboundp func)
- (or (not (eq (car-safe (symbol-function func)) 'autoload))
- (load (nth 1 (symbol-function func)))))
+ (or (not (autoloadp (symbol-function func)))
+ (autoload-do-load (symbol-function func) func)))
(setq func (symbol-function func)))
(and handler
(not (eq form (setq form (apply handler form (cdr form))))))))
form)
-(defun cl-byte-compile-compiler-macro (form)
- (if (eq form (setq form (compiler-macroexpand form)))
- (byte-compile-normal-call form)
- (byte-compile-form form)))
-
;; Optimize away unused block-wrappers.
-(defvar cl-active-block-names nil)
+(defvar cl--active-block-names nil)
-(define-compiler-macro cl-block-wrapper (cl-form)
+(cl-define-compiler-macro cl--block-wrapper (cl-form)
(let* ((cl-entry (cons (nth 1 (nth 1 cl-form)) nil))
- (cl-active-block-names (cons cl-entry cl-active-block-names))
+ (cl--active-block-names (cons cl-entry cl--active-block-names))
(cl-body (macroexpand-all ;Performs compiler-macro expansions.
(cons 'progn (cddr cl-form))
macroexpand-all-environment)))
@@ -2684,52 +2574,52 @@ and then returning foo."
`(catch ,(nth 1 cl-form) ,@(cdr cl-body))
cl-body)))
-(define-compiler-macro cl-block-throw (cl-tag cl-value)
- (let ((cl-found (assq (nth 1 cl-tag) cl-active-block-names)))
+(cl-define-compiler-macro cl--block-throw (cl-tag cl-value)
+ (let ((cl-found (assq (nth 1 cl-tag) cl--active-block-names)))
(if cl-found (setcdr cl-found t)))
`(throw ,cl-tag ,cl-value))
;;;###autoload
-(defmacro defsubst* (name args &rest body)
+(defmacro cl-defsubst (name args &rest body)
"Define NAME as a function.
Like `defun', except the function is automatically declared `inline',
ARGLIST allows full Common Lisp conventions, and BODY is implicitly
-surrounded by (block NAME ...).
+surrounded by (cl-block NAME ...).
\(fn NAME ARGLIST [DOCSTRING] BODY...)"
- (let* ((argns (cl-arglist-args args)) (p argns)
+ (declare (debug cl-defun) (indent 2))
+ (let* ((argns (cl--arglist-args args)) (p argns)
(pbody (cons 'progn body))
- (unsafe (not (cl-safe-expr-p pbody))))
- (while (and p (eq (cl-expr-contains args (car p)) 1)) (pop p))
- (list 'progn
- (if p nil ; give up if defaults refer to earlier args
- (list 'define-compiler-macro name
- (if (memq '&key args)
- (list* '&whole 'cl-whole '&cl-quote args)
- (cons '&cl-quote args))
- (list* 'cl-defsubst-expand (list 'quote argns)
- (list 'quote (list* 'block name body))
- ;; We used to pass `simple' as
- ;; (not (or unsafe (cl-expr-access-order pbody argns)))
- ;; But this is much too simplistic since it
- ;; does not pay attention to the argvs (and
- ;; cl-expr-access-order itself is also too naive).
- nil
- (and (memq '&key args) 'cl-whole) unsafe argns)))
- (list* 'defun* name args body))))
-
-(defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs)
- (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole
- (if (cl-simple-exprs-p argvs) (setq simple t))
+ (unsafe (not (cl--safe-expr-p pbody))))
+ (while (and p (eq (cl--expr-contains args (car p)) 1)) (pop p))
+ `(progn
+ ,(if p nil ; give up if defaults refer to earlier args
+ `(cl-define-compiler-macro ,name
+ ,(if (memq '&key args)
+ `(&whole cl-whole &cl-quote ,@args)
+ (cons '&cl-quote args))
+ (cl--defsubst-expand
+ ',argns '(cl-block ,name ,@body)
+ ;; We used to pass `simple' as
+ ;; (not (or unsafe (cl-expr-access-order pbody argns)))
+ ;; But this is much too simplistic since it
+ ;; does not pay attention to the argvs (and
+ ;; cl-expr-access-order itself is also too naive).
+ nil
+ ,(and (memq '&key args) 'cl-whole) ,unsafe ,@argns)))
+ (cl-defun ,name ,args ,@body))))
+
+(defun cl--defsubst-expand (argns body simple whole unsafe &rest argvs)
+ (if (and whole (not (cl--safe-expr-p (cons 'progn argvs)))) whole
+ (if (cl--simple-exprs-p argvs) (setq simple t))
(let* ((substs ())
(lets (delq nil
- (mapcar* (function
- (lambda (argn argv)
- (if (or simple (cl-const-expr-p argv))
- (progn (push (cons argn argv) substs)
- (and unsafe (list argn argv)))
- (list argn argv))))
- argns argvs))))
+ (cl-mapcar (lambda (argn argv)
+ (if (or simple (macroexp-const-p argv))
+ (progn (push (cons argn argv) substs)
+ (and unsafe (list argn argv)))
+ (list argn argv)))
+ argns argvs))))
;; FIXME: `sublis/subst' will happily substitute the symbol
;; `argn' in places where it's not used as a reference
;; to a variable.
@@ -2737,128 +2627,86 @@ surrounded by (block NAME ...).
;; scope, leading to name capture.
(setq body (cond ((null substs) body)
((null (cdr substs))
- (subst (cdar substs) (caar substs) body))
- (t (sublis substs body))))
- (if lets (list 'let lets body) body))))
+ (cl-subst (cdar substs) (caar substs) body))
+ (t (cl-sublis substs body))))
+ (if lets `(let ,lets ,body) body))))
;; Compile-time optimizations for some functions defined in this package.
-;; Note that cl.el arranges to force cl-macs to be loaded at compile-time,
-;; mainly to make sure these macros will be present.
-
-(put 'eql 'byte-compile nil)
-(define-compiler-macro eql (&whole form a b)
- (cond ((eq (cl-const-expr-p a) t)
- (let ((val (cl-const-expr-val a)))
- (if (and (numberp val) (not (integerp val)))
- (list 'equal a b)
- (list 'eq a b))))
- ((eq (cl-const-expr-p b) t)
- (let ((val (cl-const-expr-val b)))
- (if (and (numberp val) (not (integerp val)))
- (list 'equal a b)
- (list 'eq a b))))
- ((cl-simple-expr-p a 5)
- (list 'if (list 'numberp a)
- (list 'equal a b)
- (list 'eq a b)))
- ((and (cl-safe-expr-p a)
- (cl-simple-expr-p b 5))
- (list 'if (list 'numberp b)
- (list 'equal a b)
- (list 'eq a b)))
- (t form)))
-
-(define-compiler-macro member* (&whole form a list &rest keys)
+
+(defun cl--compiler-macro-member (form a list &rest keys)
(let ((test (and (= (length keys) 2) (eq (car keys) :test)
- (cl-const-expr-val (nth 1 keys)))))
- (cond ((eq test 'eq) (list 'memq a list))
- ((eq test 'equal) (list 'member a list))
- ((or (null keys) (eq test 'eql)) (list 'memql a list))
+ (cl--const-expr-val (nth 1 keys)))))
+ (cond ((eq test 'eq) `(memq ,a ,list))
+ ((eq test 'equal) `(member ,a ,list))
+ ((or (null keys) (eq test 'eql)) `(memql ,a ,list))
(t form))))
-(define-compiler-macro assoc* (&whole form a list &rest keys)
+(defun cl--compiler-macro-assoc (form a list &rest keys)
(let ((test (and (= (length keys) 2) (eq (car keys) :test)
- (cl-const-expr-val (nth 1 keys)))))
- (cond ((eq test 'eq) (list 'assq a list))
- ((eq test 'equal) (list 'assoc a list))
- ((and (eq (cl-const-expr-p a) t) (or (null keys) (eq test 'eql)))
- (if (floatp-safe (cl-const-expr-val a))
- (list 'assoc a list) (list 'assq a list)))
+ (cl--const-expr-val (nth 1 keys)))))
+ (cond ((eq test 'eq) `(assq ,a ,list))
+ ((eq test 'equal) `(assoc ,a ,list))
+ ((and (macroexp-const-p a) (or (null keys) (eq test 'eql)))
+ (if (cl-floatp-safe (cl--const-expr-val a))
+ `(assoc ,a ,list) `(assq ,a ,list)))
(t form))))
-(define-compiler-macro adjoin (&whole form a list &rest keys)
- (if (and (cl-simple-expr-p a) (cl-simple-expr-p list)
+;;;###autoload
+(defun cl--compiler-macro-adjoin (form a list &rest keys)
+ (if (and (cl--simple-expr-p a) (cl--simple-expr-p list)
(not (memq :key keys)))
- (list 'if (list* 'member* a list keys) list (list 'cons a list))
+ `(if (cl-member ,a ,list ,@keys) ,list (cons ,a ,list))
form))
-(define-compiler-macro list* (arg &rest others)
- (let* ((args (reverse (cons arg others)))
- (form (car args)))
- (while (setq args (cdr args))
- (setq form (list 'cons (car args) form)))
- form))
-
-(define-compiler-macro get* (sym prop &optional def)
+(defun cl--compiler-macro-get (_form sym prop &optional def)
(if def
- (list 'getf (list 'symbol-plist sym) prop def)
- (list 'get sym prop)))
-
-(define-compiler-macro typep (&whole form val type)
- (if (cl-const-expr-p type)
- (let ((res (cl-make-type-test val (cl-const-expr-val type))))
- (if (or (memq (cl-expr-contains res val) '(nil 1))
- (cl-simple-expr-p val)) res
- (let ((temp (make-symbol "--cl-var--")))
- (list 'let (list (list temp val)) (subst temp val res)))))
- form))
+ `(cl-getf (symbol-plist ,sym) ,prop ,def)
+ `(get ,sym ,prop)))
+(cl-define-compiler-macro cl-typep (&whole form val type)
+ (if (macroexp-const-p type)
+ (macroexp-let2 macroexp-copyable-p temp val
+ (cl--make-type-test temp (cl--const-expr-val type)))
+ form))
-(mapc (lambda (y)
- (put (car y) 'side-effect-free t)
- (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro)
- (put (car y) 'cl-compiler-macro
- `(lambda (w x)
- ,(if (symbolp (cadr y))
- `(list ',(cadr y)
- (list ',(caddr y) x))
- (cons 'list (cdr y))))))
- '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x)
- (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x)
- (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x)
- (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0)
- (caaar car caar) (caadr car cadr) (cadar car cdar)
- (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr)
- (cddar cdr cdar) (cdddr cdr cddr) (caaaar car caaar)
- (caaadr car caadr) (caadar car cadar) (caaddr car caddr)
- (cadaar car cdaar) (cadadr car cdadr) (caddar car cddar)
- (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr)
- (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar)
- (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr) ))
+(dolist (y '(cl-first cl-second cl-third cl-fourth
+ cl-fifth cl-sixth cl-seventh
+ cl-eighth cl-ninth cl-tenth
+ cl-rest cl-endp cl-plusp cl-minusp
+ cl-caaar cl-caadr cl-cadar
+ cl-caddr cl-cdaar cl-cdadr
+ cl-cddar cl-cdddr cl-caaaar
+ cl-caaadr cl-caadar cl-caaddr
+ cl-cadaar cl-cadadr cl-caddar
+ cl-cadddr cl-cdaaar cl-cdaadr
+ cl-cdadar cl-cdaddr cl-cddaar
+ cl-cddadr cl-cdddar cl-cddddr))
+ (put y 'side-effect-free t))
;;; Things that are inline.
-(proclaim '(inline floatp-safe acons map concatenate notany notevery
- cl-set-elt revappend nreconc gethash))
+(cl-proclaim '(inline cl-floatp-safe cl-acons cl-map cl-concatenate cl-notany
+ cl-notevery cl--set-elt cl-revappend cl-nreconc gethash))
;;; Things that are side-effect-free.
(mapc (lambda (x) (put x 'side-effect-free t))
- '(oddp evenp signum last butlast ldiff pairlis gcd lcm
- isqrt floor* ceiling* truncate* round* mod* rem* subseq
- list-length get* getf))
+ '(cl-oddp cl-evenp cl-signum last butlast cl-ldiff cl-pairlis cl-gcd cl-lcm
+ cl-isqrt cl-floor cl-ceiling cl-truncate cl-round cl-mod cl-rem cl-subseq
+ cl-list-length cl-get cl-getf))
;;; Things that are side-effect-and-error-free.
(mapc (lambda (x) (put x 'side-effect-free 'error-free))
- '(eql floatp-safe list* subst acons equalp random-state-p
- copy-tree sublis))
+ '(eql cl-floatp-safe cl-list* cl-subst cl-acons cl-equalp cl-random-state-p
+ copy-tree cl-sublis))
(run-hooks 'cl-macs-load-hook)
;; Local variables:
;; byte-compile-dynamic: t
-;; byte-compile-warnings: (not cl-functions)
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
+(provide 'cl-macs)
+
;;; cl-macs.el ends here
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index 1c578556835..1fa562e328a 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -1,6 +1,6 @@
-;;; cl-seq.el --- Common Lisp features, part 3
+;;; cl-seq.el --- Common Lisp features, part 3 -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 2.02
@@ -41,109 +41,101 @@
;;; Code:
-(require 'cl)
+(require 'cl-lib)
-;;; Keyword parsing. This is special-cased here so that we can compile
-;;; this file independent from cl-macs.
+;; Keyword parsing.
+;; This is special-cased here so that we can compile
+;; this file independent from cl-macs.
-(defmacro cl-parsing-keywords (kwords other-keys &rest body)
+(defmacro cl--parsing-keywords (kwords other-keys &rest body)
(declare (indent 2) (debug (sexp sexp &rest form)))
- (cons
- 'let*
- (cons (mapcar
- (function
- (lambda (x)
- (let* ((var (if (consp x) (car x) x))
- (mem (list 'car (list 'cdr (list 'memq (list 'quote var)
- 'cl-keys)))))
- (if (eq var :test-not)
- (setq mem (list 'and mem (list 'setq 'cl-test mem) t)))
- (if (eq var :if-not)
- (setq mem (list 'and mem (list 'setq 'cl-if mem) t)))
- (list (intern
- (format "cl-%s" (substring (symbol-name var) 1)))
- (if (consp x) (list 'or mem (car (cdr x))) mem)))))
- kwords)
- (append
- (and (not (eq other-keys t))
- (list
- (list 'let '((cl-keys-temp cl-keys))
- (list 'while 'cl-keys-temp
- (list 'or (list 'memq '(car cl-keys-temp)
- (list 'quote
- (mapcar
- (function
- (lambda (x)
- (if (consp x)
- (car x) x)))
- (append kwords
- other-keys))))
- '(car (cdr (memq (quote :allow-other-keys)
- cl-keys)))
- '(error "Bad keyword argument %s"
- (car cl-keys-temp)))
- '(setq cl-keys-temp (cdr (cdr cl-keys-temp)))))))
- body))))
-
-(defmacro cl-check-key (x)
+ `(let* ,(mapcar
+ (lambda (x)
+ (let* ((var (if (consp x) (car x) x))
+ (mem `(car (cdr (memq ',var cl-keys)))))
+ (if (eq var :test-not)
+ (setq mem `(and ,mem (setq cl-test ,mem) t)))
+ (if (eq var :if-not)
+ (setq mem `(and ,mem (setq cl-if ,mem) t)))
+ (list (intern
+ (format "cl-%s" (substring (symbol-name var) 1)))
+ (if (consp x) `(or ,mem ,(car (cdr x))) mem))))
+ kwords)
+ ,@(append
+ (and (not (eq other-keys t))
+ (list
+ (list 'let '((cl-keys-temp cl-keys))
+ (list 'while 'cl-keys-temp
+ (list 'or (list 'memq '(car cl-keys-temp)
+ (list 'quote
+ (mapcar
+ (function
+ (lambda (x)
+ (if (consp x)
+ (car x) x)))
+ (append kwords
+ other-keys))))
+ '(car (cdr (memq (quote :allow-other-keys)
+ cl-keys)))
+ '(error "Bad keyword argument %s"
+ (car cl-keys-temp)))
+ '(setq cl-keys-temp (cdr (cdr cl-keys-temp)))))))
+ body)))
+
+(defmacro cl--check-key (x) ;Expects `cl-key' in context of generated code.
(declare (debug edebug-forms))
- (list 'if 'cl-key (list 'funcall 'cl-key x) x))
+ `(if cl-key (funcall cl-key ,x) ,x))
-(defmacro cl-check-test-nokey (item x)
+(defmacro cl--check-test-nokey (item x) ;cl-test cl-if cl-test-not cl-if-not.
(declare (debug edebug-forms))
- (list 'cond
- (list 'cl-test
- (list 'eq (list 'not (list 'funcall 'cl-test item x))
- 'cl-test-not))
- (list 'cl-if
- (list 'eq (list 'not (list 'funcall 'cl-if x)) 'cl-if-not))
- (list 't (list 'if (list 'numberp item)
- (list 'equal item x) (list 'eq item x)))))
-
-(defmacro cl-check-test (item x)
+ `(cond
+ (cl-test (eq (not (funcall cl-test ,item ,x))
+ cl-test-not))
+ (cl-if (eq (not (funcall cl-if ,x)) cl-if-not))
+ (t (eql ,item ,x))))
+
+(defmacro cl--check-test (item x) ;all of the above.
(declare (debug edebug-forms))
- (list 'cl-check-test-nokey item (list 'cl-check-key x)))
+ `(cl--check-test-nokey ,item (cl--check-key ,x)))
-(defmacro cl-check-match (x y)
+(defmacro cl--check-match (x y) ;cl-key cl-test cl-test-not
(declare (debug edebug-forms))
- (setq x (list 'cl-check-key x) y (list 'cl-check-key y))
- (list 'if 'cl-test
- (list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not)
- (list 'if (list 'numberp x)
- (list 'equal x y) (list 'eq x y))))
+ (setq x `(cl--check-key ,x) y `(cl--check-key ,y))
+ `(if cl-test
+ (eq (not (funcall cl-test ,x ,y)) cl-test-not)
+ (eql ,x ,y)))
(defvar cl-test) (defvar cl-test-not)
(defvar cl-if) (defvar cl-if-not)
(defvar cl-key)
-
;;;###autoload
-(defun reduce (cl-func cl-seq &rest cl-keys)
+(defun cl-reduce (cl-func cl-seq &rest cl-keys)
"Reduce two-argument FUNCTION across SEQ.
\nKeywords supported: :start :end :from-end :initial-value :key
\n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
+ (cl--parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
(or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
- (setq cl-seq (subseq cl-seq cl-start cl-end))
+ (setq cl-seq (cl-subseq cl-seq cl-start cl-end))
(if cl-from-end (setq cl-seq (nreverse cl-seq)))
(let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)
- (cl-seq (cl-check-key (pop cl-seq)))
+ (cl-seq (cl--check-key (pop cl-seq)))
(t (funcall cl-func)))))
(if cl-from-end
(while cl-seq
- (setq cl-accum (funcall cl-func (cl-check-key (pop cl-seq))
+ (setq cl-accum (funcall cl-func (cl--check-key (pop cl-seq))
cl-accum)))
(while cl-seq
(setq cl-accum (funcall cl-func cl-accum
- (cl-check-key (pop cl-seq))))))
+ (cl--check-key (pop cl-seq))))))
cl-accum)))
;;;###autoload
-(defun fill (seq item &rest cl-keys)
+(defun cl-fill (seq item &rest cl-keys)
"Fill the elements of SEQ with ITEM.
\nKeywords supported: :start :end
\n(fn SEQ ITEM [KEYWORD VALUE]...)"
- (cl-parsing-keywords ((:start 0) :end) ()
+ (cl--parsing-keywords ((:start 0) :end) ()
(if (listp seq)
(let ((p (nthcdr cl-start seq))
(n (if cl-end (- cl-end cl-start) 8000000)))
@@ -159,19 +151,19 @@
seq))
;;;###autoload
-(defun replace (cl-seq1 cl-seq2 &rest cl-keys)
+(defun cl-replace (cl-seq1 cl-seq2 &rest cl-keys)
"Replace the elements of SEQ1 with the elements of SEQ2.
SEQ1 is destructively modified, then returned.
\nKeywords supported: :start1 :end1 :start2 :end2
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
- (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
+ (cl--parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
(if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
(or (= cl-start1 cl-start2)
(let* ((cl-len (length cl-seq1))
(cl-n (min (- (or cl-end1 cl-len) cl-start1)
(- (or cl-end2 cl-len) cl-start2))))
(while (>= (setq cl-n (1- cl-n)) 0)
- (cl-set-elt cl-seq1 (+ cl-start1 cl-n)
+ (cl--set-elt cl-seq1 (+ cl-start1 cl-n)
(elt cl-seq2 (+ cl-start2 cl-n))))))
(if (listp cl-seq1)
(let ((cl-p1 (nthcdr cl-start1 cl-seq1))
@@ -202,21 +194,21 @@ SEQ1 is destructively modified, then returned.
cl-seq1))
;;;###autoload
-(defun remove* (cl-item cl-seq &rest cl-keys)
+(defun cl-remove (cl-item cl-seq &rest cl-keys)
"Remove all occurrences of ITEM in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
+ (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
(:start 0) :end) ()
(if (<= (or cl-count (setq cl-count 8000000)) 0)
cl-seq
(if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000)))
- (let ((cl-i (cl-position cl-item cl-seq cl-start cl-end
- cl-from-end)))
+ (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end
+ cl-from-end)))
(if cl-i
- (let ((cl-res (apply 'delete* cl-item (append cl-seq nil)
+ (let ((cl-res (apply 'cl-delete cl-item (append cl-seq nil)
(append (if cl-from-end
(list :end (1+ cl-i))
(list :start cl-i))
@@ -227,20 +219,20 @@ to avoid corrupting the original SEQ.
(setq cl-end (- (or cl-end 8000000) cl-start))
(if (= cl-start 0)
(while (and cl-seq (> cl-end 0)
- (cl-check-test cl-item (car cl-seq))
+ (cl--check-test cl-item (car cl-seq))
(setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
(> (setq cl-count (1- cl-count)) 0))))
(if (and (> cl-count 0) (> cl-end 0))
(let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq)
(setq cl-end (1- cl-end)) (cdr cl-seq))))
(while (and cl-p (> cl-end 0)
- (not (cl-check-test cl-item (car cl-p))))
+ (not (cl--check-test cl-item (car cl-p))))
(setq cl-p (cdr cl-p) cl-end (1- cl-end)))
(if (and cl-p (> cl-end 0))
- (nconc (ldiff cl-seq cl-p)
+ (nconc (cl-ldiff cl-seq cl-p)
(if (= cl-count 1) (cdr cl-p)
(and (cdr cl-p)
- (apply 'delete* cl-item
+ (apply 'cl-delete cl-item
(copy-sequence (cdr cl-p))
:start 0 :end (1- cl-end)
:count (1- cl-count) cl-keys))))
@@ -248,30 +240,30 @@ to avoid corrupting the original SEQ.
cl-seq)))))
;;;###autoload
-(defun remove-if (cl-pred cl-list &rest cl-keys)
+(defun cl-remove-if (cl-pred cl-list &rest cl-keys)
"Remove all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'remove* nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-remove nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun remove-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-remove-if-not (cl-pred cl-list &rest cl-keys)
"Remove all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'remove* nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-remove nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun delete* (cl-item cl-seq &rest cl-keys)
+(defun cl-delete (cl-item cl-seq &rest cl-keys)
"Remove all occurrences of ITEM in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
+ (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
(:start 0) :end) ()
(if (<= (or cl-count (setq cl-count 8000000)) 0)
cl-seq
@@ -279,8 +271,8 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
(if (and cl-from-end (< cl-count 4000000))
(let (cl-i)
(while (and (>= (setq cl-count (1- cl-count)) 0)
- (setq cl-i (cl-position cl-item cl-seq cl-start
- cl-end cl-from-end)))
+ (setq cl-i (cl--position cl-item cl-seq cl-start
+ cl-end cl-from-end)))
(if (= cl-i 0) (setq cl-seq (cdr cl-seq))
(let ((cl-tail (nthcdr (1- cl-i) cl-seq)))
(setcdr cl-tail (cdr (cdr cl-tail)))))
@@ -291,7 +283,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
(progn
(while (and cl-seq
(> cl-end 0)
- (cl-check-test cl-item (car cl-seq))
+ (cl--check-test cl-item (car cl-seq))
(setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
(> (setq cl-count (1- cl-count)) 0)))
(setq cl-end (1- cl-end)))
@@ -299,7 +291,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
(if (and (> cl-count 0) (> cl-end 0))
(let ((cl-p (nthcdr cl-start cl-seq)))
(while (and (cdr cl-p) (> cl-end 0))
- (if (cl-check-test cl-item (car (cdr cl-p)))
+ (if (cl--check-test cl-item (car (cdr cl-p)))
(progn
(setcdr cl-p (cdr (cdr cl-p)))
(if (= (setq cl-count (1- cl-count)) 0)
@@ -307,49 +299,49 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
(setq cl-p (cdr cl-p)))
(setq cl-end (1- cl-end)))))
cl-seq)
- (apply 'remove* cl-item cl-seq cl-keys)))))
+ (apply 'cl-remove cl-item cl-seq cl-keys)))))
;;;###autoload
-(defun delete-if (cl-pred cl-list &rest cl-keys)
+(defun cl-delete-if (cl-pred cl-list &rest cl-keys)
"Remove all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'delete* nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-delete nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun delete-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-delete-if-not (cl-pred cl-list &rest cl-keys)
"Remove all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'delete* nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-delete nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun remove-duplicates (cl-seq &rest cl-keys)
+(defun cl-remove-duplicates (cl-seq &rest cl-keys)
"Return a copy of SEQ with all duplicate elements removed.
\nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn SEQ [KEYWORD VALUE]...)"
- (cl-delete-duplicates cl-seq cl-keys t))
+ (cl--delete-duplicates cl-seq cl-keys t))
;;;###autoload
-(defun delete-duplicates (cl-seq &rest cl-keys)
+(defun cl-delete-duplicates (cl-seq &rest cl-keys)
"Remove all duplicate elements from SEQ (destructively).
\nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn SEQ [KEYWORD VALUE]...)"
- (cl-delete-duplicates cl-seq cl-keys nil))
+ (cl--delete-duplicates cl-seq cl-keys nil))
-(defun cl-delete-duplicates (cl-seq cl-keys cl-copy)
+(defun cl--delete-duplicates (cl-seq cl-keys cl-copy)
(if (listp cl-seq)
- (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if)
+ (cl--parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if)
()
(if cl-from-end
(let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
(setq cl-end (- (or cl-end (length cl-seq)) cl-start))
(while (> cl-end 1)
(setq cl-i 0)
- (while (setq cl-i (cl-position (cl-check-key (car cl-p))
- (cdr cl-p) cl-i (1- cl-end)))
+ (while (setq cl-i (cl--position (cl--check-key (car cl-p))
+ (cdr cl-p) cl-i (1- cl-end)))
(if cl-copy (setq cl-seq (copy-sequence cl-seq)
cl-p (nthcdr cl-start cl-seq) cl-copy nil))
(let ((cl-tail (nthcdr cl-i cl-p)))
@@ -360,14 +352,14 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
cl-seq)
(setq cl-end (- (or cl-end (length cl-seq)) cl-start))
(while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
- (cl-position (cl-check-key (car cl-seq))
- (cdr cl-seq) 0 (1- cl-end)))
+ (cl--position (cl--check-key (car cl-seq))
+ (cdr cl-seq) 0 (1- cl-end)))
(setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
(let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
(setq cl-end (1- cl-end) cl-start 1) cl-seq)))
(while (and (cdr (cdr cl-p)) (> cl-end 1))
- (if (cl-position (cl-check-key (car (cdr cl-p)))
- (cdr (cdr cl-p)) 0 (1- cl-end))
+ (if (cl--position (cl--check-key (car (cdr cl-p)))
+ (cdr (cdr cl-p)) 0 (1- cl-end))
(progn
(if cl-copy (setq cl-seq (copy-sequence cl-seq)
cl-p (nthcdr (1- cl-start) cl-seq)
@@ -376,63 +368,63 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
(setq cl-p (cdr cl-p)))
(setq cl-end (1- cl-end) cl-start (1+ cl-start)))
cl-seq)))
- (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil)))
+ (let ((cl-res (cl--delete-duplicates (append cl-seq nil) cl-keys nil)))
(if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
;;;###autoload
-(defun substitute (cl-new cl-old cl-seq &rest cl-keys)
+(defun cl-substitute (cl-new cl-old cl-seq &rest cl-keys)
"Substitute NEW for OLD in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not :count
+ (cl--parsing-keywords (:test :test-not :key :if :if-not :count
(:start 0) :end :from-end) ()
(if (or (eq cl-old cl-new)
(<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0))
cl-seq
- (let ((cl-i (cl-position cl-old cl-seq cl-start cl-end)))
+ (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end)))
(if (not cl-i)
cl-seq
(setq cl-seq (copy-sequence cl-seq))
(or cl-from-end
- (progn (cl-set-elt cl-seq cl-i cl-new)
+ (progn (cl--set-elt cl-seq cl-i cl-new)
(setq cl-i (1+ cl-i) cl-count (1- cl-count))))
- (apply 'nsubstitute cl-new cl-old cl-seq :count cl-count
+ (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count
:start cl-i cl-keys))))))
;;;###autoload
-(defun substitute-if (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-substitute-if (cl-new cl-pred cl-list &rest cl-keys)
"Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-substitute cl-new nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
"Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-substitute cl-new nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
+(defun cl-nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
"Substitute NEW for OLD in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not :count
+ (cl--parsing-keywords (:test :test-not :key :if :if-not :count
(:start 0) :end :from-end) ()
(or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0)
(if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000)))
(let ((cl-p (nthcdr cl-start cl-seq)))
(setq cl-end (- (or cl-end 8000000) cl-start))
(while (and cl-p (> cl-end 0) (> cl-count 0))
- (if (cl-check-test cl-old (car cl-p))
+ (if (cl--check-test cl-old (car cl-p))
(progn
(setcar cl-p cl-new)
(setq cl-count (1- cl-count))))
@@ -441,12 +433,12 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
(if cl-from-end
(while (and (< cl-start cl-end) (> cl-count 0))
(setq cl-end (1- cl-end))
- (if (cl-check-test cl-old (elt cl-seq cl-end))
+ (if (cl--check-test cl-old (elt cl-seq cl-end))
(progn
- (cl-set-elt cl-seq cl-end cl-new)
+ (cl--set-elt cl-seq cl-end cl-new)
(setq cl-count (1- cl-count)))))
(while (and (< cl-start cl-end) (> cl-count 0))
- (if (cl-check-test cl-old (aref cl-seq cl-start))
+ (if (cl--check-test cl-old (aref cl-seq cl-start))
(progn
(aset cl-seq cl-start cl-new)
(setq cl-count (1- cl-count))))
@@ -454,63 +446,63 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
cl-seq))
;;;###autoload
-(defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
"Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
"Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun find (cl-item cl-seq &rest cl-keys)
+(defun cl-find (cl-item cl-seq &rest cl-keys)
"Find the first occurrence of ITEM in SEQ.
Return the matching ITEM, or nil if not found.
\nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (let ((cl-pos (apply 'position cl-item cl-seq cl-keys)))
+ (let ((cl-pos (apply 'cl-position cl-item cl-seq cl-keys)))
(and cl-pos (elt cl-seq cl-pos))))
;;;###autoload
-(defun find-if (cl-pred cl-list &rest cl-keys)
+(defun cl-find-if (cl-pred cl-list &rest cl-keys)
"Find the first item satisfying PREDICATE in SEQ.
Return the matching item, or nil if not found.
\nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'find nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-find nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun find-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-find-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item not satisfying PREDICATE in SEQ.
Return the matching item, or nil if not found.
\nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'find nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-find nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun position (cl-item cl-seq &rest cl-keys)
+(defun cl-position (cl-item cl-seq &rest cl-keys)
"Find the first occurrence of ITEM in SEQ.
Return the index of the matching item, or nil if not found.
\nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not
+ (cl--parsing-keywords (:test :test-not :key :if :if-not
(:start 0) :end :from-end) ()
- (cl-position cl-item cl-seq cl-start cl-end cl-from-end)))
+ (cl--position cl-item cl-seq cl-start cl-end cl-from-end)))
-(defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
+(defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
(if (listp cl-seq)
(let ((cl-p (nthcdr cl-start cl-seq)))
(or cl-end (setq cl-end 8000000))
(let ((cl-res nil))
(while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end))
- (if (cl-check-test cl-item (car cl-p))
+ (if (cl--check-test cl-item (car cl-p))
(setq cl-res cl-start))
(setq cl-p (cdr cl-p) cl-start (1+ cl-start)))
cl-res))
@@ -518,73 +510,73 @@ Return the index of the matching item, or nil if not found.
(if cl-from-end
(progn
(while (and (>= (setq cl-end (1- cl-end)) cl-start)
- (not (cl-check-test cl-item (aref cl-seq cl-end)))))
+ (not (cl--check-test cl-item (aref cl-seq cl-end)))))
(and (>= cl-end cl-start) cl-end))
(while (and (< cl-start cl-end)
- (not (cl-check-test cl-item (aref cl-seq cl-start))))
+ (not (cl--check-test cl-item (aref cl-seq cl-start))))
(setq cl-start (1+ cl-start)))
(and (< cl-start cl-end) cl-start))))
;;;###autoload
-(defun position-if (cl-pred cl-list &rest cl-keys)
+(defun cl-position-if (cl-pred cl-list &rest cl-keys)
"Find the first item satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found.
\nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'position nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-position nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun position-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-position-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item not satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found.
\nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'position nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-position nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun count (cl-item cl-seq &rest cl-keys)
+(defun cl-count (cl-item cl-seq &rest cl-keys)
"Count the number of occurrences of ITEM in SEQ.
\nKeywords supported: :test :test-not :key :start :end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
+ (cl--parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
(let ((cl-count 0) cl-x)
(or cl-end (setq cl-end (length cl-seq)))
(if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
(while (< cl-start cl-end)
(setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
- (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
+ (if (cl--check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
(setq cl-start (1+ cl-start)))
cl-count)))
;;;###autoload
-(defun count-if (cl-pred cl-list &rest cl-keys)
+(defun cl-count-if (cl-pred cl-list &rest cl-keys)
"Count the number of items satisfying PREDICATE in SEQ.
\nKeywords supported: :key :start :end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'count nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-count nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun count-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-count-if-not (cl-pred cl-list &rest cl-keys)
"Count the number of items not satisfying PREDICATE in SEQ.
\nKeywords supported: :key :start :end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'count nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-count nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun mismatch (cl-seq1 cl-seq2 &rest cl-keys)
+(defun cl-mismatch (cl-seq1 cl-seq2 &rest cl-keys)
"Compare SEQ1 with SEQ2, return index of first mismatching element.
Return nil if the sequences match. If one sequence is a prefix of the
other, the return value indicates the end of the shorter sequence.
\nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :from-end
+ (cl--parsing-keywords (:test :test-not :key :from-end
(:start1 0) :end1 (:start2 0) :end2) ()
(or cl-end1 (setq cl-end1 (length cl-seq1)))
(or cl-end2 (setq cl-end2 (length cl-seq2)))
(if cl-from-end
(progn
(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
- (cl-check-match (elt cl-seq1 (1- cl-end1))
+ (cl--check-match (elt cl-seq1 (1- cl-end1))
(elt cl-seq2 (1- cl-end2))))
(setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
(and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
@@ -592,7 +584,7 @@ other, the return value indicates the end of the shorter sequence.
(let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
(cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
- (cl-check-match (if cl-p1 (car cl-p1)
+ (cl--check-match (if cl-p1 (car cl-p1)
(aref cl-seq1 cl-start1))
(if cl-p2 (car cl-p2)
(aref cl-seq2 cl-start2))))
@@ -602,26 +594,26 @@ other, the return value indicates the end of the shorter sequence.
cl-start1)))))
;;;###autoload
-(defun search (cl-seq1 cl-seq2 &rest cl-keys)
+(defun cl-search (cl-seq1 cl-seq2 &rest cl-keys)
"Search for SEQ1 as a subsequence of SEQ2.
Return the index of the leftmost element of the first match found;
return nil if there are no matches.
\nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :from-end
+ (cl--parsing-keywords (:test :test-not :key :from-end
(:start1 0) :end1 (:start2 0) :end2) ()
(or cl-end1 (setq cl-end1 (length cl-seq1)))
(or cl-end2 (setq cl-end2 (length cl-seq2)))
(if (>= cl-start1 cl-end1)
(if cl-from-end cl-end2 cl-start2)
(let* ((cl-len (- cl-end1 cl-start1))
- (cl-first (cl-check-key (elt cl-seq1 cl-start1)))
+ (cl-first (cl--check-key (elt cl-seq1 cl-start1)))
(cl-if nil) cl-pos)
(setq cl-end2 (- cl-end2 (1- cl-len)))
(while (and (< cl-start2 cl-end2)
- (setq cl-pos (cl-position cl-first cl-seq2
- cl-start2 cl-end2 cl-from-end))
- (apply 'mismatch cl-seq1 cl-seq2
+ (setq cl-pos (cl--position cl-first cl-seq2
+ cl-start2 cl-end2 cl-from-end))
+ (apply 'cl-mismatch cl-seq1 cl-seq2
:start1 (1+ cl-start1) :end1 cl-end1
:start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
:from-end nil cl-keys))
@@ -629,14 +621,14 @@ return nil if there are no matches.
(and (< cl-start2 cl-end2) cl-pos)))))
;;;###autoload
-(defun sort* (cl-seq cl-pred &rest cl-keys)
+(defun cl-sort (cl-seq cl-pred &rest cl-keys)
"Sort the argument SEQ according to PREDICATE.
This is a destructive function; it reuses the storage of SEQ if possible.
\nKeywords supported: :key
\n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
(if (nlistp cl-seq)
- (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys))
- (cl-parsing-keywords (:key) ()
+ (cl-replace cl-seq (apply 'cl-sort (append cl-seq nil) cl-pred cl-keys))
+ (cl--parsing-keywords (:key) ()
(if (memq cl-key '(nil identity))
(sort cl-seq cl-pred)
(sort cl-seq (function (lambda (cl-x cl-y)
@@ -644,15 +636,15 @@ This is a destructive function; it reuses the storage of SEQ if possible.
(funcall cl-key cl-y)))))))))
;;;###autoload
-(defun stable-sort (cl-seq cl-pred &rest cl-keys)
+(defun cl-stable-sort (cl-seq cl-pred &rest cl-keys)
"Sort the argument SEQ stably according to PREDICATE.
This is a destructive function; it reuses the storage of SEQ if possible.
\nKeywords supported: :key
\n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
- (apply 'sort* cl-seq cl-pred cl-keys))
+ (apply 'cl-sort cl-seq cl-pred cl-keys))
;;;###autoload
-(defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
+(defun cl-merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
"Destructively merge the two sequences to produce a new sequence.
TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument
sequences, and PREDICATE is a `less-than' predicate on the elements.
@@ -660,115 +652,117 @@ sequences, and PREDICATE is a `less-than' predicate on the elements.
\n(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)"
(or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
(or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
- (cl-parsing-keywords (:key) ()
+ (cl--parsing-keywords (:key) ()
(let ((cl-res nil))
(while (and cl-seq1 cl-seq2)
- (if (funcall cl-pred (cl-check-key (car cl-seq2))
- (cl-check-key (car cl-seq1)))
+ (if (funcall cl-pred (cl--check-key (car cl-seq2))
+ (cl--check-key (car cl-seq1)))
(push (pop cl-seq2) cl-res)
(push (pop cl-seq1) cl-res)))
- (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
+ (cl-coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
-;;; See compiler macro in cl-macs.el
;;;###autoload
-(defun member* (cl-item cl-list &rest cl-keys)
+(defun cl-member (cl-item cl-list &rest cl-keys)
"Find the first occurrence of ITEM in LIST.
Return the sublist of LIST whose car is ITEM.
\nKeywords supported: :test :test-not :key
\n(fn ITEM LIST [KEYWORD VALUE]...)"
+ (declare (compiler-macro cl--compiler-macro-member))
(if cl-keys
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
- (while (and cl-list (not (cl-check-test cl-item (car cl-list))))
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
+ (while (and cl-list (not (cl--check-test cl-item (car cl-list))))
(setq cl-list (cdr cl-list)))
cl-list)
(if (and (numberp cl-item) (not (integerp cl-item)))
(member cl-item cl-list)
(memq cl-item cl-list))))
+(autoload 'cl--compiler-macro-member "cl-macs")
;;;###autoload
-(defun member-if (cl-pred cl-list &rest cl-keys)
+(defun cl-member-if (cl-pred cl-list &rest cl-keys)
"Find the first item satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
- (apply 'member* nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-member nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun member-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-member-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item not satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
- (apply 'member* nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-member nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun cl-adjoin (cl-item cl-list &rest cl-keys)
- (if (cl-parsing-keywords (:key) t
- (apply 'member* (cl-check-key cl-item) cl-list cl-keys))
+(defun cl--adjoin (cl-item cl-list &rest cl-keys)
+ (if (cl--parsing-keywords (:key) t
+ (apply 'cl-member (cl--check-key cl-item) cl-list cl-keys))
cl-list
(cons cl-item cl-list)))
-;;; See compiler macro in cl-macs.el
;;;###autoload
-(defun assoc* (cl-item cl-alist &rest cl-keys)
+(defun cl-assoc (cl-item cl-alist &rest cl-keys)
"Find the first item whose car matches ITEM in LIST.
\nKeywords supported: :test :test-not :key
\n(fn ITEM LIST [KEYWORD VALUE]...)"
+ (declare (compiler-macro cl--compiler-macro-assoc))
(if cl-keys
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
(while (and cl-alist
(or (not (consp (car cl-alist)))
- (not (cl-check-test cl-item (car (car cl-alist))))))
+ (not (cl--check-test cl-item (car (car cl-alist))))))
(setq cl-alist (cdr cl-alist)))
(and cl-alist (car cl-alist)))
(if (and (numberp cl-item) (not (integerp cl-item)))
(assoc cl-item cl-alist)
(assq cl-item cl-alist))))
+(autoload 'cl--compiler-macro-assoc "cl-macs")
;;;###autoload
-(defun assoc-if (cl-pred cl-list &rest cl-keys)
+(defun cl-assoc-if (cl-pred cl-list &rest cl-keys)
"Find the first item whose car satisfies PREDICATE in LIST.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
- (apply 'assoc* nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-assoc nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun assoc-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-assoc-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item whose car does not satisfy PREDICATE in LIST.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
- (apply 'assoc* nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-assoc nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun rassoc* (cl-item cl-alist &rest cl-keys)
+(defun cl-rassoc (cl-item cl-alist &rest cl-keys)
"Find the first item whose cdr matches ITEM in LIST.
\nKeywords supported: :test :test-not :key
\n(fn ITEM LIST [KEYWORD VALUE]...)"
(if (or cl-keys (numberp cl-item))
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
(while (and cl-alist
(or (not (consp (car cl-alist)))
- (not (cl-check-test cl-item (cdr (car cl-alist))))))
+ (not (cl--check-test cl-item (cdr (car cl-alist))))))
(setq cl-alist (cdr cl-alist)))
(and cl-alist (car cl-alist)))
(rassq cl-item cl-alist)))
;;;###autoload
-(defun rassoc-if (cl-pred cl-list &rest cl-keys)
+(defun cl-rassoc-if (cl-pred cl-list &rest cl-keys)
"Find the first item whose cdr satisfies PREDICATE in LIST.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
- (apply 'rassoc* nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-rassoc nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun rassoc-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-rassoc-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item whose cdr does not satisfy PREDICATE in LIST.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
- (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-rassoc nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun union (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-union (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-union operation.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
@@ -782,14 +776,14 @@ to avoid corrupting the original LIST1 and LIST2.
(setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
(while cl-list2
(if (or cl-keys (numberp (car cl-list2)))
- (setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys))
+ (setq cl-list1 (apply 'cl-adjoin (car cl-list2) cl-list1 cl-keys))
(or (memq (car cl-list2) cl-list1)
(push (car cl-list2) cl-list1)))
(pop cl-list2))
cl-list1)))
;;;###autoload
-(defun nunion (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nunion (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-union operation.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -797,10 +791,10 @@ whenever possible.
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
- (t (apply 'union cl-list1 cl-list2 cl-keys))))
+ (t (apply 'cl-union cl-list1 cl-list2 cl-keys))))
;;;###autoload
-(defun intersection (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-intersection (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-intersection operation.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
@@ -809,13 +803,13 @@ to avoid corrupting the original LIST1 and LIST2.
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(and cl-list1 cl-list2
(if (equal cl-list1 cl-list2) cl-list1
- (cl-parsing-keywords (:key) (:test :test-not)
+ (cl--parsing-keywords (:key) (:test :test-not)
(let ((cl-res nil))
(or (>= (length cl-list1) (length cl-list2))
(setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
(while cl-list2
(if (if (or cl-keys (numberp (car cl-list2)))
- (apply 'member* (cl-check-key (car cl-list2))
+ (apply 'cl-member (cl--check-key (car cl-list2))
cl-list1 cl-keys)
(memq (car cl-list2) cl-list1))
(push (car cl-list2) cl-res))
@@ -823,17 +817,17 @@ to avoid corrupting the original LIST1 and LIST2.
cl-res)))))
;;;###autoload
-(defun nintersection (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nintersection (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-intersection operation.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible.
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
- (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys)))
+ (and cl-list1 cl-list2 (apply 'cl-intersection cl-list1 cl-list2 cl-keys)))
;;;###autoload
-(defun set-difference (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-set-difference (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-difference operation.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
@@ -841,11 +835,11 @@ to avoid corrupting the original LIST1 and LIST2.
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(if (or (null cl-list1) (null cl-list2)) cl-list1
- (cl-parsing-keywords (:key) (:test :test-not)
+ (cl--parsing-keywords (:key) (:test :test-not)
(let ((cl-res nil))
(while cl-list1
(or (if (or cl-keys (numberp (car cl-list1)))
- (apply 'member* (cl-check-key (car cl-list1))
+ (apply 'cl-member (cl--check-key (car cl-list1))
cl-list2 cl-keys)
(memq (car cl-list1) cl-list2))
(push (car cl-list1) cl-res))
@@ -853,7 +847,7 @@ to avoid corrupting the original LIST1 and LIST2.
cl-res))))
;;;###autoload
-(defun nset-difference (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nset-difference (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-difference operation.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -861,10 +855,10 @@ whenever possible.
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(if (or (null cl-list1) (null cl-list2)) cl-list1
- (apply 'set-difference cl-list1 cl-list2 cl-keys)))
+ (apply 'cl-set-difference cl-list1 cl-list2 cl-keys)))
;;;###autoload
-(defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-exclusive-or operation.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
@@ -873,11 +867,11 @@ to avoid corrupting the original LIST1 and LIST2.
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
((equal cl-list1 cl-list2) nil)
- (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys)
- (apply 'set-difference cl-list2 cl-list1 cl-keys)))))
+ (t (append (apply 'cl-set-difference cl-list1 cl-list2 cl-keys)
+ (apply 'cl-set-difference cl-list2 cl-list1 cl-keys)))))
;;;###autoload
-(defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-exclusive-or operation.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -886,134 +880,136 @@ whenever possible.
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
((equal cl-list1 cl-list2) nil)
- (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys)
- (apply 'nset-difference cl-list2 cl-list1 cl-keys)))))
+ (t (nconc (apply 'cl-nset-difference cl-list1 cl-list2 cl-keys)
+ (apply 'cl-nset-difference cl-list2 cl-list1 cl-keys)))))
;;;###autoload
-(defun subsetp (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-subsetp (cl-list1 cl-list2 &rest cl-keys)
"Return true if LIST1 is a subset of LIST2.
I.e., if every element of LIST1 also appears in LIST2.
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) t) ((null cl-list2) nil)
((equal cl-list1 cl-list2) t)
- (t (cl-parsing-keywords (:key) (:test :test-not)
+ (t (cl--parsing-keywords (:key) (:test :test-not)
(while (and cl-list1
- (apply 'member* (cl-check-key (car cl-list1))
+ (apply 'cl-member (cl--check-key (car cl-list1))
cl-list2 cl-keys))
(pop cl-list1))
(null cl-list1)))))
;;;###autoload
-(defun subst-if (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-subst-if (cl-new cl-pred cl-tree &rest cl-keys)
"Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced by NEW.
\nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
- (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
+ (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
;;;###autoload
-(defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
"Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all non-matching elements replaced by NEW.
\nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
- (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
+ (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
;;;###autoload
-(defun nsubst (cl-new cl-old cl-tree &rest cl-keys)
+(defun cl-nsubst (cl-new cl-old cl-tree &rest cl-keys)
"Substitute NEW for OLD everywhere in TREE (destructively).
Any element of TREE which is `eql' to OLD is changed to NEW (via a call
to `setcar').
\nKeywords supported: :test :test-not :key
\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
- (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
+ (apply 'cl-nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
;;;###autoload
-(defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
"Substitute NEW for elements matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar').
\nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
- (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
+ (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
;;;###autoload
-(defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
"Substitute NEW for elements not matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar').
\nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
- (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
+ (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
+
+(defvar cl--alist)
;;;###autoload
-(defun sublis (cl-alist cl-tree &rest cl-keys)
+(defun cl-sublis (cl-alist cl-tree &rest cl-keys)
"Perform substitutions indicated by ALIST in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced.
\nKeywords supported: :test :test-not :key
\n(fn ALIST TREE [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
- (cl-sublis-rec cl-tree)))
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
+ (let ((cl--alist cl-alist))
+ (cl--sublis-rec cl-tree))))
-(defvar cl-alist)
-(defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if*
- (let ((cl-temp (cl-check-key cl-tree)) (cl-p cl-alist))
- (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
+(defun cl--sublis-rec (cl-tree) ;Uses cl--alist cl-key/test*/if*.
+ (let ((cl-temp (cl--check-key cl-tree)) (cl-p cl--alist))
+ (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
(setq cl-p (cdr cl-p)))
(if cl-p (cdr (car cl-p))
(if (consp cl-tree)
- (let ((cl-a (cl-sublis-rec (car cl-tree)))
- (cl-d (cl-sublis-rec (cdr cl-tree))))
+ (let ((cl-a (cl--sublis-rec (car cl-tree)))
+ (cl-d (cl--sublis-rec (cdr cl-tree))))
(if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree)))
cl-tree
(cons cl-a cl-d)))
cl-tree))))
;;;###autoload
-(defun nsublis (cl-alist cl-tree &rest cl-keys)
+(defun cl-nsublis (cl-alist cl-tree &rest cl-keys)
"Perform substitutions indicated by ALIST in TREE (destructively).
Any matching element of TREE is changed via a call to `setcar'.
\nKeywords supported: :test :test-not :key
\n(fn ALIST TREE [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
- (let ((cl-hold (list cl-tree)))
- (cl-nsublis-rec cl-hold)
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
+ (let ((cl-hold (list cl-tree))
+ (cl--alist cl-alist))
+ (cl--nsublis-rec cl-hold)
(car cl-hold))))
-(defun cl-nsublis-rec (cl-tree) ; uses cl-alist/temp/p/key/test*/if*
+(defun cl--nsublis-rec (cl-tree) ;Uses cl--alist cl-key/test*/if*.
(while (consp cl-tree)
- (let ((cl-temp (cl-check-key (car cl-tree))) (cl-p cl-alist))
- (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
+ (let ((cl-temp (cl--check-key (car cl-tree))) (cl-p cl--alist))
+ (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
(setq cl-p (cdr cl-p)))
(if cl-p (setcar cl-tree (cdr (car cl-p)))
- (if (consp (car cl-tree)) (cl-nsublis-rec (car cl-tree))))
- (setq cl-temp (cl-check-key (cdr cl-tree)) cl-p cl-alist)
- (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
+ (if (consp (car cl-tree)) (cl--nsublis-rec (car cl-tree))))
+ (setq cl-temp (cl--check-key (cdr cl-tree)) cl-p cl--alist)
+ (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
(setq cl-p (cdr cl-p)))
(if cl-p
(progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil))
(setq cl-tree (cdr cl-tree))))))
;;;###autoload
-(defun tree-equal (cl-x cl-y &rest cl-keys)
+(defun cl-tree-equal (cl-x cl-y &rest cl-keys)
"Return t if trees TREE1 and TREE2 have `eql' leaves.
Atoms are compared by `eql'; cons cells are compared recursively.
\nKeywords supported: :test :test-not :key
\n(fn TREE1 TREE2 [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key) ()
- (cl-tree-equal-rec cl-x cl-y)))
+ (cl--parsing-keywords (:test :test-not :key) ()
+ (cl--tree-equal-rec cl-x cl-y)))
-(defun cl-tree-equal-rec (cl-x cl-y)
+(defun cl--tree-equal-rec (cl-x cl-y) ;Uses cl-key/test*.
(while (and (consp cl-x) (consp cl-y)
- (cl-tree-equal-rec (car cl-x) (car cl-y)))
+ (cl--tree-equal-rec (car cl-x) (car cl-y)))
(setq cl-x (cdr cl-x) cl-y (cdr cl-y)))
- (and (not (consp cl-x)) (not (consp cl-y)) (cl-check-match cl-x cl-y)))
+ (and (not (consp cl-x)) (not (consp cl-y)) (cl--check-match cl-x cl-y)))
(run-hooks 'cl-seq-load-hook)
;; 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-specs.el b/lisp/emacs-lisp/cl-specs.el
deleted file mode 100644
index 3556b6c1ecf..00000000000
--- a/lisp/emacs-lisp/cl-specs.el
+++ /dev/null
@@ -1,471 +0,0 @@
-;;; cl-specs.el --- Edebug specs for cl.el -*- no-byte-compile: t -*-
-
-;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
-;; Author: Daniel LaLiberte <liberte@holonexus.org>
-;; Keywords: lisp, tools, maint
-;; Package: emacs
-
-;; LCD Archive Entry:
-;; cl-specs.el|Daniel LaLiberte|liberte@holonexus.org
-;; |Edebug specs for cl.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; These specs are to be used with edebug.el version 3.3 or later and
-;; cl.el version 2.03 or later, by Dave Gillespie <daveg@synaptics.com>.
-
-;; This file need not be byte-compiled, but it shouldn't hurt.
-
-;;; Code:
-
-(provide 'cl-specs)
-;; Do the above provide before the following require.
-;; Otherwise if you load this before edebug if cl is already loaded
-;; an infinite loading loop would occur.
-(require 'edebug)
-
-;; Blocks
-
-(def-edebug-spec block (symbolp body))
-(def-edebug-spec return (&optional form))
-(def-edebug-spec return-from (symbolp &optional form))
-
-;; Loops
-
-(def-edebug-spec case (form &rest (sexp body)))
-(def-edebug-spec ecase case)
-(def-edebug-spec do
- ((&rest &or symbolp (symbolp &optional form form))
- (form body)
- cl-declarations body))
-(def-edebug-spec do* do)
-(def-edebug-spec dolist
- ((symbolp form &optional form) cl-declarations body))
-(def-edebug-spec dotimes dolist)
-(def-edebug-spec do-symbols
- ((symbolp &optional form form) cl-declarations body))
-(def-edebug-spec do-all-symbols
- ((symbolp &optional form) cl-declarations body))
-
-;; Multiple values
-
-(def-edebug-spec multiple-value-list (form))
-(def-edebug-spec multiple-value-call (function-form body))
-(def-edebug-spec multiple-value-bind
- ((&rest symbolp) form body))
-(def-edebug-spec multiple-value-setq ((&rest symbolp) form))
-(def-edebug-spec multiple-value-prog1 (form body))
-
-;; Bindings
-
-(def-edebug-spec lexical-let let)
-(def-edebug-spec lexical-let* let)
-
-(def-edebug-spec psetq setq)
-(def-edebug-spec progv (form form body))
-
-(def-edebug-spec flet ((&rest (defun*)) cl-declarations body))
-(def-edebug-spec labels flet)
-
-(def-edebug-spec macrolet
- ((&rest (&define name (&rest arg) cl-declarations-or-string def-body))
- cl-declarations body))
-
-(def-edebug-spec symbol-macrolet
- ((&rest (symbol sexp)) cl-declarations body))
-
-(def-edebug-spec destructuring-bind
- (&define cl-macro-list def-form cl-declarations def-body))
-
-;; Setf
-
-(def-edebug-spec setf (&rest [place form])) ;; sexp is not specific enough
-(def-edebug-spec psetf setf)
-
-(def-edebug-spec letf ;; *not* available in Common Lisp
- ((&rest (gate place &optional form))
- body))
-(def-edebug-spec letf* letf)
-
-
-(def-edebug-spec defsetf
- (&define name
- [&or [symbolp &optional stringp]
- [cl-lambda-list (symbolp)]]
- cl-declarations-or-string def-body))
-
-(def-edebug-spec define-setf-method
- (&define name cl-lambda-list cl-declarations-or-string def-body))
-
-(def-edebug-spec define-modify-macro
- (&define name cl-lambda-list ;; should exclude &key
- symbolp &optional stringp))
-
-(def-edebug-spec callf (function* place &rest form))
-(def-edebug-spec callf2 (function* form place &rest form))
-
-;; Other operations on places
-
-(def-edebug-spec remf (place form))
-
-(def-edebug-spec incf (place &optional form))
-(def-edebug-spec decf incf)
-(def-edebug-spec push (form place)) ; different for CL
-(def-edebug-spec pushnew
- (form place &rest
- &or [[&or ":test" ":test-not" ":key"] function-form]
- [keywordp form]))
-(def-edebug-spec pop (place)) ; different for CL
-
-(def-edebug-spec shiftf (&rest place)) ;; really [&rest place] form
-(def-edebug-spec rotatef (&rest place))
-
-
-;; Functions with function args. These are only useful if the
-;; function arg is quoted with ' instead of function.
-
-(def-edebug-spec some (function-form form &rest form))
-(def-edebug-spec every some)
-(def-edebug-spec notany some)
-(def-edebug-spec notevery some)
-
-;; Mapping
-
-(def-edebug-spec map (form function-form form &rest form))
-(def-edebug-spec maplist (function-form form &rest form))
-(def-edebug-spec mapc maplist)
-(def-edebug-spec mapl maplist)
-(def-edebug-spec mapcan maplist)
-(def-edebug-spec mapcon maplist)
-
-;; Sequences
-
-(def-edebug-spec reduce (function-form form &rest form))
-
-;; Types and assertions
-
-(def-edebug-spec cl-type-spec (sexp)) ;; not worth the trouble to specify, yet.
-
-(def-edebug-spec deftype defmacro*)
-(def-edebug-spec check-type (place cl-type-spec &optional stringp))
-;; (def-edebug-spec assert (form &optional form stringp &rest form))
-(def-edebug-spec assert (form &rest form))
-(def-edebug-spec typecase (form &rest ([&or cl-type-spec "otherwise"] body)))
-(def-edebug-spec etypecase typecase)
-
-(def-edebug-spec ignore-errors t)
-
-;; Time of Evaluation
-
-(def-edebug-spec eval-when
- ((&rest &or "compile" "load" "eval") body))
-(def-edebug-spec load-time-value (form &optional &or "t" "nil"))
-
-;; Declarations
-
-(def-edebug-spec cl-decl-spec
- ((symbolp &rest sexp)))
-
-(def-edebug-spec cl-declarations
- (&rest ("declare" &rest cl-decl-spec)))
-
-(def-edebug-spec cl-declarations-or-string
- (&or stringp cl-declarations))
-
-(def-edebug-spec declaim (&rest cl-decl-spec))
-(def-edebug-spec declare (&rest cl-decl-spec)) ;; probably not needed.
-(def-edebug-spec locally (cl-declarations &rest form))
-(def-edebug-spec the (cl-type-spec form))
-
-;;======================================================
-;; Lambda things
-
-(def-edebug-spec cl-lambda-list
- (([&rest arg]
- [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
- [&optional ["&rest" arg]]
- [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
- )))
-
-(def-edebug-spec cl-&optional-arg
- (&or (arg &optional def-form arg) arg))
-
-(def-edebug-spec cl-&key-arg
- (&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
-
-;; The lambda list for macros is different from that of normal lambdas.
-;; Note that &environment is only allowed as first or last items in the
-;; top level list.
-
-(def-edebug-spec cl-macro-list
- (([&optional "&environment" arg]
- [&rest cl-macro-arg]
- [&optional ["&optional" &rest
- &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
- [&optional [[&or "&rest" "&body"] cl-macro-arg]]
- [&optional ["&key" [&rest
- [&or ([&or (symbolp cl-macro-arg) arg]
- &optional def-form cl-macro-arg)
- arg]]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
- [&optional "&environment" arg]
- )))
-
-(def-edebug-spec cl-macro-arg
- (&or arg cl-macro-list1))
-
-(def-edebug-spec cl-macro-list1
- (([&optional "&whole" arg] ;; only allowed at lower levels
- [&rest cl-macro-arg]
- [&optional ["&optional" &rest
- &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
- [&optional [[&or "&rest" "&body"] cl-macro-arg]]
- [&optional ["&key" [&rest
- [&or ([&or (symbolp cl-macro-arg) arg]
- &optional def-form cl-macro-arg)
- arg]]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
- . [&or arg nil])))
-
-
-(def-edebug-spec defun*
- ;; Same as defun but use cl-lambda-list.
- (&define [&or name
- ("setf" :name setf name)]
- cl-lambda-list
- cl-declarations-or-string
- [&optional ("interactive" interactive)]
- def-body))
-(def-edebug-spec defsubst* defun*)
-
-(def-edebug-spec defmacro*
- (&define name cl-macro-list cl-declarations-or-string def-body))
-(def-edebug-spec define-compiler-macro defmacro*)
-
-
-(def-edebug-spec function*
- (&or symbolp cl-lambda-expr))
-
-(def-edebug-spec cl-lambda-expr
- (&define ("lambda" cl-lambda-list
- ;;cl-declarations-or-string
- ;;[&optional ("interactive" interactive)]
- def-body)))
-
-;; Redefine function-form to also match function*
-(def-edebug-spec function-form
- ;; form at the end could also handle "function",
- ;; but recognize it specially to avoid wrapping function forms.
- (&or ([&or "quote" "function"] &or symbolp lambda-expr)
- ("function*" function*)
- form))
-
-;;======================================================
-;; Structures
-;; (def-edebug-spec defstruct (&rest sexp)) would be sufficient, but...
-
-;; defstruct may contain forms that are evaluated when a structure is created.
-(def-edebug-spec defstruct
- (&define ; makes top-level form not be wrapped
- [&or symbolp
- (gate
- symbolp &rest
- (&or [":conc-name" symbolp]
- [":constructor" symbolp &optional cl-lambda-list]
- [":copier" symbolp]
- [":predicate" symbolp]
- [":include" symbolp &rest sexp];; not finished
- ;; The following are not supported.
- ;; [":print-function" ...]
- ;; [":type" ...]
- ;; [":initial-offset" ...]
- ))]
- [&optional stringp]
- ;; All the above is for the following def-form.
- &rest &or symbolp (symbolp def-form &optional ":read-only" sexp)))
-
-;;======================================================
-;; Loop
-
-;; The loop macro is very complex, and a full spec is found below.
-;; The following spec only minimally specifies that
-;; parenthesized forms are executable, but single variables used as
-;; expressions will be missed. You may want to use this if the full
-;; spec causes problems for you.
-
-(def-edebug-spec loop
- (&rest &or symbolp form))
-
-;; Below is a complete spec for loop, in several parts that correspond
-;; to the syntax given in CLtL2. The specs do more than specify where
-;; the forms are; it also specifies, as much as Edebug allows, all the
-;; syntactically valid loop clauses. The disadvantage of this
-;; completeness is rigidity, but the "for ... being" clause allows
-;; arbitrary extensions of the form: [symbolp &rest &or symbolp form].
-
-(def-edebug-spec loop
- ([&optional ["named" symbolp]]
- [&rest
- &or
- ["repeat" form]
- loop-for-as
- loop-with
- loop-initial-final]
- [&rest loop-clause]
- ))
-
-(def-edebug-spec loop-with
- ("with" loop-var
- loop-type-spec
- [&optional ["=" form]]
- &rest ["and" loop-var
- loop-type-spec
- [&optional ["=" form]]]))
-
-(def-edebug-spec loop-for-as
- ([&or "for" "as"] loop-for-as-subclause
- &rest ["and" loop-for-as-subclause]))
-
-(def-edebug-spec loop-for-as-subclause
- (loop-var
- loop-type-spec
- &or
- [[&or "in" "on" "in-ref" "across-ref"]
- form &optional ["by" function-form]]
-
- ["=" form &optional ["then" form]]
- ["across" form]
- ["being"
- [&or "the" "each"]
- &or
- [[&or "element" "elements"]
- [&or "of" "in" "of-ref"] form
- &optional "using" ["index" symbolp]];; is this right?
- [[&or "hash-key" "hash-keys"
- "hash-value" "hash-values"]
- [&or "of" "in"]
- hash-table-p &optional ["using" ([&or "hash-value" "hash-values"
- "hash-key" "hash-keys"] sexp)]]
-
- [[&or "symbol" "present-symbol" "external-symbol"
- "symbols" "present-symbols" "external-symbols"]
- [&or "in" "of"] package-p]
-
- ;; Extensions for Emacs Lisp, including Lucid Emacs.
- [[&or "frame" "frames"
- "screen" "screens"
- "buffer" "buffers"]]
-
- [[&or "window" "windows"]
- [&or "of" "in"] form]
-
- [[&or "overlay" "overlays"
- "extent" "extents"]
- [&or "of" "in"] form
- &optional [[&or "from" "to"] form]]
-
- [[&or "interval" "intervals"]
- [&or "in" "of"] form
- &optional [[&or "from" "to"] form]
- ["property" form]]
-
- [[&or "key-code" "key-codes"
- "key-seq" "key-seqs"
- "key-binding" "key-bindings"]
- [&or "in" "of"] form
- &optional ["using" ([&or "key-code" "key-codes"
- "key-seq" "key-seqs"
- "key-binding" "key-bindings"]
- sexp)]]
- ;; For arbitrary extensions, recognize anything else.
- [symbolp &rest &or symbolp form]
- ]
-
- ;; arithmetic - must be last since all parts are optional.
- [[&optional [[&or "from" "downfrom" "upfrom"] form]]
- [&optional [[&or "to" "downto" "upto" "below" "above"] form]]
- [&optional ["by" form]]
- ]))
-
-(def-edebug-spec loop-initial-final
- (&or ["initially"
- ;; [&optional &or "do" "doing"] ;; CLtL2 doesn't allow this.
- &rest loop-non-atomic-expr]
- ["finally" &or
- [[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
- ["return" form]]))
-
-(def-edebug-spec loop-and-clause
- (loop-clause &rest ["and" loop-clause]))
-
-(def-edebug-spec loop-clause
- (&or
- [[&or "while" "until" "always" "never" "thereis"] form]
-
- [[&or "collect" "collecting"
- "append" "appending"
- "nconc" "nconcing"
- "concat" "vconcat"] form
- [&optional ["into" loop-var]]]
-
- [[&or "count" "counting"
- "sum" "summing"
- "maximize" "maximizing"
- "minimize" "minimizing"] form
- [&optional ["into" loop-var]]
- loop-type-spec]
-
- [[&or "if" "when" "unless"]
- form loop-and-clause
- [&optional ["else" loop-and-clause]]
- [&optional "end"]]
-
- [[&or "do" "doing"] &rest loop-non-atomic-expr]
-
- ["return" form]
- loop-initial-final
- ))
-
-(def-edebug-spec loop-non-atomic-expr
- ([&not atom] form))
-
-(def-edebug-spec loop-var
- ;; The symbolp must be last alternative to recognize e.g. (a b . c)
- ;; loop-var =>
- ;; (loop-var . [&or nil loop-var])
- ;; (symbolp . [&or nil loop-var])
- ;; (symbolp . loop-var)
- ;; (symbolp . (symbolp . [&or nil loop-var]))
- ;; (symbolp . (symbolp . loop-var))
- ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp)
- (&or (loop-var . [&or nil loop-var]) [gate symbolp]))
-
-(def-edebug-spec loop-type-spec
- (&optional ["of-type" loop-d-type-spec]))
-
-(def-edebug-spec loop-d-type-spec
- (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
-
-;;; cl-specs.el ends here
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 16eb31c1209..40d12358b17 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -1,9 +1,8 @@
-;;; cl.el --- Common Lisp extensions for Emacs
+;;; cl.el --- Compatibility aliases for the old CL library. -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2012 Free Software Foundation, Inc.
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions
;; This file is part of GNU Emacs.
@@ -23,699 +22,717 @@
;;; Commentary:
-;; These are extensions to Emacs Lisp that provide a degree of
-;; Common Lisp compatibility, beyond what is already built-in
-;; in Emacs Lisp.
-;;
-;; This package was written by Dave Gillespie; it is a complete
-;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
-;;
-;; Bug reports, comments, and suggestions are welcome!
-
-;; This file contains the portions of the Common Lisp extensions
-;; package which should always be present.
-
-
-;;; Future notes:
-
-;; Once Emacs 19 becomes standard, many things in this package which are
-;; messy for reasons of compatibility can be greatly simplified. For now,
-;; I prefer to maintain one unified version.
-
-
-;;; Change Log:
-
-;; Version 2.02 (30 Jul 93):
-;; * Added "cl-compat.el" file, extra compatibility with old package.
-;; * Added `lexical-let' and `lexical-let*'.
-;; * Added `define-modify-macro', `callf', and `callf2'.
-;; * Added `ignore-errors'.
-;; * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero.
-;; * Merged `*gentemp-counter*' into `*gensym-counter*'.
-;; * Extended `subseq' to allow negative START and END like `substring'.
-;; * Added `in-ref', `across-ref', `elements of-ref' loop clauses.
-;; * Added `concat', `vconcat' loop clauses.
-;; * Cleaned up a number of compiler warnings.
-
-;; Version 2.01 (7 Jul 93):
-;; * Added support for FSF version of Emacs 19.
-;; * Added `add-hook' for Emacs 18 users.
-;; * Added `defsubst*' and `symbol-macrolet'.
-;; * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'.
-;; * Added `map', `concatenate', `reduce', `merge'.
-;; * Added `revappend', `nreconc', `tailp', `tree-equal'.
-;; * Added `assert', `check-type', `typecase', `typep', and `deftype'.
-;; * Added destructuring and `&environment' support to `defmacro*'.
-;; * Added destructuring to `loop', and added the following clauses:
-;; `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'.
-;; * Renamed `delete' to `delete*' and `remove' to `remove*'.
-;; * Completed support for all keywords in `remove*', `substitute', etc.
-;; * Added `most-positive-float' and company.
-;; * Fixed hash tables to work with latest Lucid Emacs.
-;; * `proclaim' forms are no longer compile-time-evaluating; use `declaim'.
-;; * Syntax for `warn' declarations has changed.
-;; * Improved implementation of `random*'.
-;; * Moved most sequence functions to a new file, cl-seq.el.
-;; * Moved `eval-when' into cl-macs.el.
-;; * Moved `pushnew' and `adjoin' to cl.el for most common cases.
-;; * Moved `provide' forms down to ends of files.
-;; * Changed expansion of `pop' to something that compiles to better code.
-;; * Changed so that no patch is required for Emacs 19 byte compiler.
-;; * Made more things dependent on `optimize' declarations.
-;; * Added a partial implementation of struct print functions.
-;; * Miscellaneous minor changes.
-
-;; Version 2.00:
-;; * First public release of this package.
-
+;; This is a compatibility file which provides the old names provided by CL
+;; before we cleaned up its namespace usage.
;;; Code:
-(defvar cl-optimize-speed 1)
-(defvar cl-optimize-safety 1)
-
-
-;;;###autoload
-(defvar custom-print-functions nil
- "This is a list of functions that format user objects for printing.
-Each function is called in turn with three arguments: the object, the
-stream, and the print level (currently ignored). If it is able to
-print the object it returns true; otherwise it returns nil and the
-printer proceeds to the next function on the list.
-
-This variable is not used at present, but it is defined in hopes that
-a future Emacs interpreter will be able to use it.")
-
-(defun cl-unload-function ()
- "Stop unloading of the Common Lisp extensions."
- (message "Cannot unload the feature `cl'")
- ;; stop standard unloading!
- t)
-
-;;; Generalized variables.
-;; These macros are defined here so that they
-;; can safely be used in .emacs files.
-
-(defmacro incf (place &optional x)
- "Increment PLACE by X (1 by default).
-PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The return value is the incremented value of PLACE."
- (if (symbolp place)
- (list 'setq place (if x (list '+ place x) (list '1+ place)))
- (list 'callf '+ place (or x 1))))
-
-(defmacro decf (place &optional x)
- "Decrement PLACE by X (1 by default).
-PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The return value is the decremented value of PLACE."
- (if (symbolp place)
- (list 'setq place (if x (list '- place x) (list '1- place)))
- (list 'callf '- place (or x 1))))
-
-;; Autoloaded, but we haven't loaded cl-loaddefs yet.
-(declare-function cl-do-pop "cl-macs" (place))
-
-(defmacro pop (place)
- "Remove and return the head of the list stored in PLACE.
-Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more
-careful about evaluating each argument only once and in the right order.
-PLACE may be a symbol, or any generalized variable allowed by `setf'."
- (if (symbolp place)
- (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))
- (cl-do-pop place)))
-
-(defmacro push (x place)
- "Insert X at the head of the list stored in PLACE.
-Analogous to (setf PLACE (cons X PLACE)), though more careful about
-evaluating each argument only once and in the right order. PLACE may
-be a symbol, or any generalized variable allowed by `setf'."
- (if (symbolp place) (list 'setq place (list 'cons x place))
- (list 'callf2 'cons x place)))
-
-(defmacro pushnew (x place &rest keys)
- "(pushnew X PLACE): insert X at the head of the list if not already there.
-Like (push X PLACE), except that the list is unmodified if X is `eql' to
-an element already on the list.
-\nKeywords supported: :test :test-not :key
-\n(fn X PLACE [KEYWORD VALUE]...)"
- (if (symbolp place)
- (if (null keys)
- `(let ((x ,x))
- (if (memql x ,place)
- ;; This symbol may later on expand to actual code which then
- ;; trigger warnings like "value unused" since pushnew's return
- ;; value is rarely used. It should not matter that other
- ;; warnings may be silenced, since `place' is used earlier and
- ;; should have triggered them already.
- (with-no-warnings ,place)
- (setq ,place (cons x ,place))))
- (list 'setq place (list* 'adjoin x place keys)))
- (list* 'callf2 'adjoin x place keys)))
-
-(defun cl-set-elt (seq n val)
- (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
-
-(defsubst cl-set-nthcdr (n list x)
- (if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list))
-
-(defun cl-set-buffer-substring (start end val)
- (save-excursion (delete-region start end)
- (goto-char start)
- (insert val)
- val))
-
-(defun cl-set-substring (str start end val)
- (if end (if (< end 0) (incf end (length str)))
- (setq end (length str)))
- (if (< start 0) (incf start (length str)))
- (concat (and (> start 0) (substring str 0 start))
- val
- (and (< end (length str)) (substring str end))))
-
-
-;;; Control structures.
-
-;; These macros are so simple and so often-used that it's better to have
-;; them all the time than to load them from cl-macs.el.
-
-(defun cl-map-extents (&rest cl-args)
- (apply 'cl-map-overlays cl-args))
-
-
-;;; Blocks and exits.
-
-(defalias 'cl-block-wrapper 'identity)
-(defalias 'cl-block-throw 'throw)
-
-
-;;; Multiple values.
-;; True multiple values are not supported, or even
-;; simulated. Instead, multiple-value-bind and friends simply expect
-;; the target form to return the values as a list.
-
-(defsubst values (&rest values)
- "Return multiple values, Common Lisp style.
-The arguments of `values' are the values
-that the containing function should return."
- values)
-
-(defsubst values-list (list)
- "Return multiple values, Common Lisp style, taken from a list.
-LIST specifies the list of values
-that the containing function should return."
- list)
-
-(defsubst multiple-value-list (expression)
- "Return a list of the multiple values produced by EXPRESSION.
-This handles multiple values in Common Lisp style, but it does not
-work right when EXPRESSION calls an ordinary Emacs Lisp function
-that returns just one value."
- expression)
-
-(defsubst multiple-value-apply (function expression)
- "Evaluate EXPRESSION to get multiple values and apply FUNCTION to them.
-This handles multiple values in Common Lisp style, but it does not work
-right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
-one value."
- (apply function expression))
-
-(defalias 'multiple-value-call 'apply
- "Apply FUNCTION to ARGUMENTS, taking multiple values into account.
-This implementation only handles the case where there is only one argument.")
-
-(defsubst nth-value (n expression)
- "Evaluate EXPRESSION to get multiple values and return the Nth one.
-This handles multiple values in Common Lisp style, but it does not work
-right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
-one value."
- (nth n expression))
-
-;;; Macros.
-
-(defvar cl-macro-environment)
-(defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand)
- (defalias 'macroexpand 'cl-macroexpand)))
-
-(defun cl-macroexpand (cl-macro &optional cl-env)
- "Return result of expanding macros at top level of FORM.
-If FORM is not a macro call, it is returned unchanged.
-Otherwise, the macro is expanded and the expansion is considered
-in place of FORM. When a non-macro-call results, it is returned.
-
-The second optional arg ENVIRONMENT specifies an environment of macro
-definitions to shadow the loaded ones for use in file byte-compilation.
-\n(fn FORM &optional ENVIRONMENT)"
- (let ((cl-macro-environment cl-env))
- (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env))
- (and (symbolp cl-macro)
- (cdr (assq (symbol-name cl-macro) cl-env))))
- (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env))))
- cl-macro))
-
-
-;;; Declarations.
-
-(defvar cl-compiling-file nil)
-(defun cl-compiling-file ()
- (or cl-compiling-file
- (and (boundp 'byte-compile--outbuffer)
- (bufferp (symbol-value 'byte-compile--outbuffer))
- (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
- " *Compiler Output*"))))
-
-(defvar cl-proclaims-deferred nil)
-
-(defun proclaim (spec)
- (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t)
- (push spec cl-proclaims-deferred))
- nil)
-
-(defmacro declaim (&rest specs)
- (let ((body (mapcar (function (lambda (x) (list 'proclaim (list 'quote x))))
- specs)))
- (if (cl-compiling-file) (list* 'eval-when '(compile load eval) body)
- (cons 'progn body)))) ; avoid loading cl-macs.el for eval-when
-
-
-;;; Symbols.
-
-(defun cl-random-time ()
- (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
- (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i))))
- v))
-
-(defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100))
-
-
-;;; Numbers.
-
-(defun floatp-safe (object)
- "Return t if OBJECT is a floating point number.
-On Emacs versions that lack floating-point support, this function
-always returns nil."
- (and (numberp object) (not (integerp object))))
-
-(defun plusp (number)
- "Return t if NUMBER is positive."
- (> number 0))
-
-(defun minusp (number)
- "Return t if NUMBER is negative."
- (< number 0))
-
-(defun oddp (integer)
- "Return t if INTEGER is odd."
- (eq (logand integer 1) 1))
-
-(defun evenp (integer)
- "Return t if INTEGER is even."
- (eq (logand integer 1) 0))
-
-(defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
-
-(defconst most-positive-float nil
- "The largest value that a Lisp float can hold.
-If your system supports infinities, this is the largest finite value.
-For IEEE machines, this is approximately 1.79e+308.
-Call `cl-float-limits' to set this.")
-
-(defconst most-negative-float nil
- "The largest negative value that a Lisp float can hold.
-This is simply -`most-positive-float'.
-Call `cl-float-limits' to set this.")
-
-(defconst least-positive-float nil
- "The smallest value greater than zero that a Lisp float can hold.
-For IEEE machines, it is about 4.94e-324 if denormals are supported,
-or 2.22e-308 if they are not.
-Call `cl-float-limits' to set this.")
-
-(defconst least-negative-float nil
- "The smallest value less than zero that a Lisp float can hold.
-This is simply -`least-positive-float'.
-Call `cl-float-limits' to set this.")
-
-(defconst least-positive-normalized-float nil
- "The smallest normalized Lisp float greater than zero.
-This is the smallest value for which IEEE denormalization does not lose
-precision. For IEEE machines, this value is about 2.22e-308.
-For machines that do not support the concept of denormalization
-and gradual underflow, this constant equals `least-positive-float'.
-Call `cl-float-limits' to set this.")
-
-(defconst least-negative-normalized-float nil
- "The smallest normalized Lisp float less than zero.
-This is simply -`least-positive-normalized-float'.
-Call `cl-float-limits' to set this.")
-
-(defconst float-epsilon nil
- "The smallest positive float that adds to 1.0 to give a distinct value.
-Adding a number less than this to 1.0 returns 1.0 due to roundoff.
-For IEEE machines, epsilon is about 2.22e-16.
-Call `cl-float-limits' to set this.")
-
-(defconst float-negative-epsilon nil
- "The smallest positive float that subtracts from 1.0 to give a distinct value.
-For IEEE machines, it is about 1.11e-16.
-Call `cl-float-limits' to set this.")
-
-
-;;; Sequence functions.
-
-(defalias 'copy-seq 'copy-sequence)
-
-(declare-function cl-mapcar-many "cl-extra" (cl-func cl-seqs))
-
-(defun mapcar* (cl-func cl-x &rest cl-rest)
- "Apply FUNCTION to each element of SEQ, and make a list of the results.
-If there are several SEQs, FUNCTION is called with that many arguments,
-and mapping stops as soon as the shortest list runs out. With just one
-SEQ, this is like `mapcar'. With several, it is like the Common Lisp
-`mapcar' function extended to arbitrary sequence types.
-\n(fn FUNCTION SEQ...)"
- (if cl-rest
- (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
- (cl-mapcar-many cl-func (cons cl-x cl-rest))
- (let ((cl-res nil) (cl-y (car cl-rest)))
- (while (and cl-x cl-y)
- (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
- (nreverse cl-res)))
- (mapcar cl-func cl-x)))
-
-(defalias 'svref 'aref)
-
-;;; List functions.
-
-(defalias 'first 'car)
-(defalias 'second 'cadr)
-(defalias 'rest 'cdr)
-(defalias 'endp 'null)
-
-(defun third (x)
- "Return the third element of the list X."
- (car (cdr (cdr x))))
-
-(defun fourth (x)
- "Return the fourth element of the list X."
- (nth 3 x))
-
-(defun fifth (x)
- "Return the fifth element of the list X."
- (nth 4 x))
-
-(defun sixth (x)
- "Return the sixth element of the list X."
- (nth 5 x))
-
-(defun seventh (x)
- "Return the seventh element of the list X."
- (nth 6 x))
-
-(defun eighth (x)
- "Return the eighth element of the list X."
- (nth 7 x))
-
-(defun ninth (x)
- "Return the ninth element of the list X."
- (nth 8 x))
-
-(defun tenth (x)
- "Return the tenth element of the list X."
- (nth 9 x))
-
-(defun caaar (x)
- "Return the `car' of the `car' of the `car' of X."
- (car (car (car x))))
-
-(defun caadr (x)
- "Return the `car' of the `car' of the `cdr' of X."
- (car (car (cdr x))))
-
-(defun cadar (x)
- "Return the `car' of the `cdr' of the `car' of X."
- (car (cdr (car x))))
-
-(defun caddr (x)
- "Return the `car' of the `cdr' of the `cdr' of X."
- (car (cdr (cdr x))))
-
-(defun cdaar (x)
- "Return the `cdr' of the `car' of the `car' of X."
- (cdr (car (car x))))
-
-(defun cdadr (x)
- "Return the `cdr' of the `car' of the `cdr' of X."
- (cdr (car (cdr x))))
-
-(defun cddar (x)
- "Return the `cdr' of the `cdr' of the `car' of X."
- (cdr (cdr (car x))))
-
-(defun cdddr (x)
- "Return the `cdr' of the `cdr' of the `cdr' of X."
- (cdr (cdr (cdr x))))
-
-(defun caaaar (x)
- "Return the `car' of the `car' of the `car' of the `car' of X."
- (car (car (car (car x)))))
-
-(defun caaadr (x)
- "Return the `car' of the `car' of the `car' of the `cdr' of X."
- (car (car (car (cdr x)))))
-
-(defun caadar (x)
- "Return the `car' of the `car' of the `cdr' of the `car' of X."
- (car (car (cdr (car x)))))
-
-(defun caaddr (x)
- "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
- (car (car (cdr (cdr x)))))
-
-(defun cadaar (x)
- "Return the `car' of the `cdr' of the `car' of the `car' of X."
- (car (cdr (car (car x)))))
-
-(defun cadadr (x)
- "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
- (car (cdr (car (cdr x)))))
-
-(defun caddar (x)
- "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
- (car (cdr (cdr (car x)))))
-
-(defun cadddr (x)
- "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
- (car (cdr (cdr (cdr x)))))
-
-(defun cdaaar (x)
- "Return the `cdr' of the `car' of the `car' of the `car' of X."
- (cdr (car (car (car x)))))
-
-(defun cdaadr (x)
- "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
- (cdr (car (car (cdr x)))))
-
-(defun cdadar (x)
- "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
- (cdr (car (cdr (car x)))))
-
-(defun cdaddr (x)
- "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
- (cdr (car (cdr (cdr x)))))
-
-(defun cddaar (x)
- "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
- (cdr (cdr (car (car x)))))
-
-(defun cddadr (x)
- "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
- (cdr (cdr (car (cdr x)))))
-
-(defun cdddar (x)
- "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
- (cdr (cdr (cdr (car x)))))
-
-(defun cddddr (x)
- "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
- (cdr (cdr (cdr (cdr x)))))
-
-;;(defun last* (x &optional n)
-;; "Returns the last link in the list LIST.
-;;With optional argument N, returns Nth-to-last link (default 1)."
-;; (if n
-;; (let ((m 0) (p x))
-;; (while (consp p) (incf m) (pop p))
-;; (if (<= n 0) p
-;; (if (< n m) (nthcdr (- m n) x) x)))
-;; (while (consp (cdr x)) (pop x))
-;; x))
-
-(defun list* (arg &rest rest) ; See compiler macro in cl-macs.el
- "Return a new list with specified ARGs as elements, consed to last ARG.
-Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
-`(cons A (cons B (cons C D)))'.
-\n(fn ARG...)"
- (cond ((not rest) arg)
- ((not (cdr rest)) (cons arg (car rest)))
- (t (let* ((n (length rest))
- (copy (copy-sequence rest))
- (last (nthcdr (- n 2) copy)))
- (setcdr last (car (cdr last)))
- (cons arg copy)))))
-
-(defun ldiff (list sublist)
- "Return a copy of LIST with the tail SUBLIST removed."
- (let ((res nil))
- (while (and (consp list) (not (eq list sublist)))
- (push (pop list) res))
- (nreverse res)))
-
-(defun copy-list (list)
- "Return a copy of LIST, which may be a dotted list.
-The elements of LIST are not copied, just the list structure itself."
- (if (consp list)
- (let ((res nil))
- (while (consp list) (push (pop list) res))
- (prog1 (nreverse res) (setcdr res list)))
- (car list)))
+(require 'cl-lib)
+(require 'macroexp)
+
+;; (defun cl--rename ()
+;; (let ((vdefs ())
+;; (fdefs ())
+;; (case-fold-search nil)
+;; (files '("cl.el" "cl-macs.el" "cl-seq.el" "cl-extra.el")))
+;; (dolist (file files)
+;; (with-current-buffer (find-file-noselect file)
+;; (goto-char (point-min))
+;; (while (re-search-forward
+;; "^(\\(def[^ \t\n]*\\) +'?\\(\\(\\sw\\|\\s_\\)+\\)" nil t)
+;; (let ((name (match-string-no-properties 2))
+;; (type (match-string-no-properties 1)))
+;; (unless (string-match-p "\\`cl-" name)
+;; (cond
+;; ((member type '("defvar" "defconst"))
+;; (unless (member name vdefs) (push name vdefs)))
+;; ((member type '("defun" "defsubst" "defalias" "defmacro"))
+;; (unless (member name fdefs) (push name fdefs)))
+;; ((member type '("def-edebug-spec" "defsetf" "define-setf-method"
+;; "define-compiler-macro"))
+;; nil)
+;; (t (error "Unknown type %S" type))))))))
+;; (let ((re (concat "\\_<" (regexp-opt (append vdefs fdefs)) "\\_>"))
+;; (conflicts ()))
+;; (dolist (file files)
+;; (with-current-buffer (find-file-noselect file)
+;; (goto-char (point-min))
+;; (while (re-search-forward re nil t)
+;; (replace-match "cl-\\&"))
+;; (save-buffer))))
+;; (with-current-buffer (find-file-noselect "cl-rename.el")
+;; (dolist (def vdefs)
+;; (insert (format "(defvaralias '%s 'cl-%s)\n" def def)))
+;; (dolist (def fdefs)
+;; (insert (format "(defalias '%s 'cl-%s)\n" def def)))
+;; (save-buffer))))
+
+;; (defun cl--unrename ()
+;; ;; Taken from "Naming Conventions" node of the doc.
+;; (let* ((names '(defun* defsubst* defmacro* function* member*
+;; assoc* rassoc* get* remove* delete*
+;; mapcar* sort* floor* ceiling* truncate*
+;; round* mod* rem* random*))
+;; (files '("cl.el" "cl-lib.el" "cl-macs.el" "cl-seq.el" "cl-extra.el"))
+;; (re (concat "\\_<cl-" (regexp-opt (mapcar #'symbol-name names))
+;; "\\_>")))
+;; (dolist (file files)
+;; (with-current-buffer (find-file-noselect file)
+;; (goto-char (point-min))
+;; (while (re-search-forward re nil t)
+;; (delete-region (1- (point)) (point)))
+;; (save-buffer)))))
+
+;;; Aliases to cl-lib's features.
+
+(dolist (var '(
+ ;; loop-result-var
+ ;; loop-result
+ ;; loop-initially
+ ;; loop-finally
+ ;; loop-bindings
+ ;; loop-args
+ ;; bind-inits
+ ;; bind-block
+ ;; lambda-list-keywords
+ float-negative-epsilon
+ float-epsilon
+ least-negative-normalized-float
+ least-positive-normalized-float
+ least-negative-float
+ least-positive-float
+ most-negative-float
+ most-positive-float
+ ;; custom-print-functions
+ ))
+ (defvaralias var (intern (format "cl-%s" var))))
+
+(dolist (fun '(
+ (get* . cl-get)
+ (random* . cl-random)
+ (rem* . cl-rem)
+ (mod* . cl-mod)
+ (round* . cl-round)
+ (truncate* . cl-truncate)
+ (ceiling* . cl-ceiling)
+ (floor* . cl-floor)
+ (rassoc* . cl-rassoc)
+ (assoc* . cl-assoc)
+ (member* . cl-member)
+ (delete* . cl-delete)
+ (remove* . cl-remove)
+ (defsubst* . cl-defsubst)
+ (sort* . cl-sort)
+ (function* . cl-function)
+ (defmacro* . cl-defmacro)
+ (defun* . cl-defun)
+ (mapcar* . cl-mapcar)
+
+ remprop
+ getf
+ tailp
+ list-length
+ nreconc
+ revappend
+ concatenate
+ subseq
+ random-state-p
+ make-random-state
+ signum
+ isqrt
+ lcm
+ gcd
+ notevery
+ notany
+ every
+ some
+ mapcon
+ mapcan
+ mapl
+ maplist
+ map
+ equalp
+ coerce
+ tree-equal
+ nsublis
+ sublis
+ nsubst-if-not
+ nsubst-if
+ nsubst
+ subst-if-not
+ subst-if
+ subsetp
+ nset-exclusive-or
+ set-exclusive-or
+ nset-difference
+ set-difference
+ nintersection
+ intersection
+ nunion
+ union
+ rassoc-if-not
+ rassoc-if
+ assoc-if-not
+ assoc-if
+ member-if-not
+ member-if
+ merge
+ stable-sort
+ search
+ mismatch
+ count-if-not
+ count-if
+ count
+ position-if-not
+ position-if
+ position
+ find-if-not
+ find-if
+ find
+ nsubstitute-if-not
+ nsubstitute-if
+ nsubstitute
+ substitute-if-not
+ substitute-if
+ substitute
+ delete-duplicates
+ remove-duplicates
+ delete-if-not
+ delete-if
+ remove-if-not
+ remove-if
+ replace
+ fill
+ reduce
+ compiler-macroexpand
+ define-compiler-macro
+ assert
+ check-type
+ typep
+ deftype
+ defstruct
+ callf2
+ callf
+ letf*
+ ;; letf
+ rotatef
+ shiftf
+ remf
+ psetf
+ (define-setf-method . define-setf-expander)
+ the
+ locally
+ multiple-value-setq
+ multiple-value-bind
+ symbol-macrolet
+ macrolet
+ progv
+ psetq
+ do-all-symbols
+ do-symbols
+ do*
+ do
+ loop
+ return-from
+ return
+ block
+ etypecase
+ typecase
+ ecase
+ case
+ load-time-value
+ eval-when
+ destructuring-bind
+ gentemp
+ gensym
+ pairlis
+ acons
+ subst
+ adjoin
+ copy-list
+ ldiff
+ list*
+ cddddr
+ cdddar
+ cddadr
+ cddaar
+ cdaddr
+ cdadar
+ cdaadr
+ cdaaar
+ cadddr
+ caddar
+ cadadr
+ cadaar
+ caaddr
+ caadar
+ caaadr
+ caaaar
+ cdddr
+ cddar
+ cdadr
+ cdaar
+ caddr
+ cadar
+ caadr
+ caaar
+ tenth
+ ninth
+ eighth
+ seventh
+ sixth
+ fifth
+ fourth
+ third
+ endp
+ rest
+ second
+ first
+ svref
+ copy-seq
+ evenp
+ oddp
+ minusp
+ plusp
+ floatp-safe
+ declaim
+ proclaim
+ nth-value
+ multiple-value-call
+ multiple-value-apply
+ multiple-value-list
+ values-list
+ values
+ pushnew
+ decf
+ incf
+ ))
+ (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun)))
+ (intern (format "cl-%s" fun)))))
+ (defalias fun new)))
+
+(defun cl--wrap-in-nil-block (fun &rest args)
+ `(cl-block nil ,(apply fun args)))
+(advice-add 'dolist :around #'cl--wrap-in-nil-block)
+(advice-add 'dotimes :around #'cl--wrap-in-nil-block)
+
+(defun cl--pass-args-to-cl-declare (&rest specs)
+ (macroexpand `(cl-declare ,@specs)))
+(advice-add 'declare :after #'cl--pass-args-to-cl-declare)
+
+;;; Features provided a bit differently in Elisp.
+
+;; First, the old lexical-let is now better served by `lexical-binding', tho
+;; it's not 100% compatible.
+
+(defvar cl-closure-vars nil)
+(defvar cl--function-convert-cache nil)
+
+(defun cl--function-convert (f)
+ "Special macro-expander for special cases of (function F).
+The two cases that are handled are:
+- closure-conversion of lambda expressions for `lexical-let'.
+- renaming of F when it's a function defined via `cl-labels' or `labels'."
+ (require 'cl-macs)
+ (declare-function cl--expr-contains-any "cl-macs" (x y))
+ (cond
+ ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
+ ;; *after* handling `function', but we want to stop macroexpansion from
+ ;; being applied infinitely, so we use a cache to return the exact `form'
+ ;; being expanded even though we don't receive it.
+ ((eq f (car cl--function-convert-cache)) (cdr cl--function-convert-cache))
+ ((eq (car-safe f) 'lambda)
+ (let ((body (mapcar (lambda (f)
+ (macroexpand-all f macroexpand-all-environment))
+ (cddr f))))
+ (if (and cl-closure-vars
+ (cl--expr-contains-any body cl-closure-vars))
+ (let* ((new (mapcar 'cl-gensym cl-closure-vars))
+ (sub (cl-pairlis cl-closure-vars new)) (decls nil))
+ (while (or (stringp (car body))
+ (eq (car-safe (car body)) 'interactive))
+ (push (list 'quote (pop body)) decls))
+ (put (car (last cl-closure-vars)) 'used t)
+ `(list 'lambda '(&rest --cl-rest--)
+ ,@(cl-sublis sub (nreverse decls))
+ (list 'apply
+ (list 'quote
+ #'(lambda ,(append new (cadr f))
+ ,@(cl-sublis sub body)))
+ ,@(nconc (mapcar (lambda (x) `(list 'quote ,x))
+ cl-closure-vars)
+ '((quote --cl-rest--))))))
+ (let* ((newf `(lambda ,(cadr f) ,@body))
+ (res `(function ,newf)))
+ (setq cl--function-convert-cache (cons newf res))
+ res))))
+ (t
+ (let ((found (assq f macroexpand-all-environment)))
+ (if (and found (ignore-errors
+ (eq (cadr (cl-caddr found)) 'cl-labels-args)))
+ (cadr (cl-caddr (cl-cadddr found)))
+ (let ((res `(function ,f)))
+ (setq cl--function-convert-cache (cons f res))
+ res))))))
+
+(defmacro lexical-let (bindings &rest body)
+ "Like `let', but lexically scoped.
+The main visible difference is that lambdas inside BODY will create
+lexical closures as in Common Lisp.
+\n(fn BINDINGS BODY)"
+ (declare (indent 1) (debug let))
+ (let* ((cl-closure-vars cl-closure-vars)
+ (vars (mapcar (function
+ (lambda (x)
+ (or (consp x) (setq x (list x)))
+ (push (make-symbol (format "--cl-%s--" (car x)))
+ cl-closure-vars)
+ (set (car cl-closure-vars) [bad-lexical-ref])
+ (list (car x) (cadr x) (car cl-closure-vars))))
+ bindings))
+ (ebody
+ (macroexpand-all
+ `(cl-symbol-macrolet
+ ,(mapcar (lambda (x)
+ `(,(car x) (symbol-value ,(cl-caddr x))))
+ vars)
+ ,@body)
+ (cons (cons 'function #'cl--function-convert)
+ macroexpand-all-environment))))
+ (if (not (get (car (last cl-closure-vars)) 'used))
+ ;; Turn (let ((foo (cl-gensym)))
+ ;; (set foo <val>) ...(symbol-value foo)...)
+ ;; into (let ((foo <val>)) ...(symbol-value 'foo)...).
+ ;; This is good because it's more efficient but it only works with
+ ;; dynamic scoping, since with lexical scoping we'd need
+ ;; (let ((foo <val>)) ...foo...).
+ `(progn
+ ,@(mapcar (lambda (x) `(defvar ,(cl-caddr x))) vars)
+ (let ,(mapcar (lambda (x) (list (cl-caddr x) (cadr x))) vars)
+ ,(cl-sublis (mapcar (lambda (x)
+ (cons (cl-caddr x)
+ `',(cl-caddr x)))
+ vars)
+ ebody)))
+ `(let ,(mapcar (lambda (x)
+ (list (cl-caddr x)
+ `(make-symbol ,(format "--%s--" (car x)))))
+ vars)
+ (setf ,@(apply #'append
+ (mapcar (lambda (x)
+ (list `(symbol-value ,(cl-caddr x)) (cadr x)))
+ vars)))
+ ,ebody))))
+
+(defmacro lexical-let* (bindings &rest body)
+ "Like `let*', but lexically scoped.
+The main visible difference is that lambdas inside BODY, and in
+successive bindings within BINDINGS, will create lexical closures
+as in Common Lisp. This is similar to the behavior of `let*' in
+Common Lisp.
+\n(fn BINDINGS BODY)"
+ (declare (indent 1) (debug let))
+ (if (null bindings) (cons 'progn body)
+ (setq bindings (reverse bindings))
+ (while bindings
+ (setq body (list `(lexical-let (,(pop bindings)) ,@body))))
+ (car body)))
+
+;; This should really have some way to shadow 'byte-compile properties, etc.
+(defmacro flet (bindings &rest body)
+ "Make temporary overriding function definitions.
+This is an analogue of a dynamically scoped `let' that operates on the function
+cell of FUNCs rather than their value cell.
+If you want the Common-Lisp style of `flet', you should use `cl-flet'.
+The FORMs are evaluated with the specified function definitions in place,
+then the definitions are undone (the FUNCs go back to their previous
+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"))
+ `(letf ,(mapcar
+ (lambda (x)
+ (if (or (and (fboundp (car x))
+ (eq (car-safe (symbol-function (car x))) 'macro))
+ (cdr (assq (car x) macroexpand-all-environment)))
+ (error "Use `labels', not `flet', to rebind macro names"))
+ (let ((func `(cl-function
+ (lambda ,(cadr x)
+ (cl-block ,(car x) ,@(cddr x))))))
+ (when (cl--compiling-file)
+ ;; Bug#411. It would be nice to fix this.
+ (and (get (car x) 'byte-compile)
+ (error "Byte-compiling a redefinition of `%s' \
+will not work - use `labels' instead" (symbol-name (car x))))
+ ;; FIXME This affects the rest of the file, when it
+ ;; should be restricted to the flet body.
+ (and (boundp 'byte-compile-function-environment)
+ (push (cons (car x) (eval func))
+ byte-compile-function-environment)))
+ (list `(symbol-function ',(car x)) func)))
+ bindings)
+ ,@body))
+
+(defmacro labels (bindings &rest body)
+ "Make temporary function bindings.
+Like `cl-labels' except that the lexical scoping is handled via `lexical-let'
+rather than relying on `lexical-binding'."
+ (declare (indent 1) (debug cl-flet) (obsolete cl-labels "24.3"))
+ (let ((vars nil) (sets nil) (newenv macroexpand-all-environment))
+ (dolist (binding bindings)
+ ;; It's important that (not (eq (symbol-name var1) (symbol-name var2)))
+ ;; because these var's *names* get added to the macro-environment.
+ (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+ (push var vars)
+ (push `(cl-function (lambda . ,(cdr binding))) sets)
+ (push var sets)
+ (push (cons (car binding)
+ `(lambda (&rest cl-labels-args)
+ (cl-list* 'funcall ',var
+ cl-labels-args)))
+ newenv)))
+ (macroexpand-all `(lexical-let ,vars (setq ,@sets) ,@body) newenv)))
+
+;; Generalized variables are provided by gv.el, but some details are
+;; not 100% compatible: not worth the trouble to add them to cl-lib.el, but we
+;; still need to support old users of cl.el.
+
+(defmacro cl--symbol-function (symbol)
+ "Like `symbol-function' but return `cl--unbound' if not bound."
+ ;; (declare (gv-setter (lambda (store)
+ ;; `(if (eq ,store 'cl--unbound)
+ ;; (fmakunbound ,symbol) (fset ,symbol ,store)))))
+ `(if (fboundp ,symbol) (symbol-function ,symbol) 'cl--unbound))
+(gv-define-setter cl--symbol-function (store symbol)
+ `(if (eq ,store 'cl--unbound) (fmakunbound ,symbol) (fset ,symbol ,store)))
+
+(defmacro letf (bindings &rest body)
+ "Dynamically scoped let-style bindings for places.
+For more details, see `cl-letf'. This macro behaves like that one
+in almost every respect (apart from details that relate to some
+deprecated usage of `symbol-function' in place forms)." ; bug#12760
+ (declare (indent 1) (debug cl-letf))
+ ;; Like cl-letf, but with special handling of symbol-function.
+ `(cl-letf ,(mapcar (lambda (x) (if (eq (car-safe (car x)) 'symbol-function)
+ `((cl--symbol-function ,@(cdar x)) ,@(cdr x))
+ x))
+ bindings)
+ ,@body))
+
+(defun cl--gv-adapt (cl-gv do)
+ ;; This function is used by all .elc files that use define-setf-expander and
+ ;; were compiled with Emacs>=24.3.
+ (let ((vars (nth 0 cl-gv))
+ (vals (nth 1 cl-gv))
+ (binds ())
+ (substs ()))
+ ;; Use cl-sublis as was done in cl-setf-do-modify.
+ (while vars
+ (if (macroexp-copyable-p (car vals))
+ (push (cons (pop vars) (pop vals)) substs)
+ (push (list (pop vars) (pop vals)) binds)))
+ (macroexp-let*
+ binds
+ (funcall do (cl-sublis substs (nth 4 cl-gv))
+ ;; We'd like to do something like
+ ;; (lambda ,(nth 2 cl-gv) ,(nth 3 cl-gv)).
+ (lambda (exp)
+ (macroexp-let2 macroexp-copyable-p v exp
+ (cl-sublis (cons (cons (car (nth 2 cl-gv)) v)
+ substs)
+ (nth 3 cl-gv))))))))
+
+(defmacro define-setf-expander (name arglist &rest body)
+ "Define a `setf' method.
+This method shows how to handle `setf's to places of the form
+\(NAME ARGS...). The argument forms ARGS are bound according to
+ARGLIST, as if NAME were going to be expanded as a macro, then
+the BODY forms are executed and must return a list of five elements:
+a temporary-variables list, a value-forms list, a store-variables list
+\(of length one), a store-form, and an access- form.
+
+See `gv-define-expander', and `gv-define-setter' for better and
+simpler ways to define setf-methods."
+ (declare (debug
+ (&define name cl-lambda-list cl-declarations-or-string def-body)))
+ `(progn
+ ,@(if (stringp (car body))
+ (list `(put ',name 'setf-documentation ,(pop body))))
+ (gv-define-expander ,name
+ (cl-function
+ (lambda (do ,@arglist)
+ (cl--gv-adapt (progn ,@body) do))))))
+
+(defmacro defsetf (name arg1 &rest args)
+ "Define a `setf' method.
+This macro is an easy-to-use substitute for `define-setf-expander'
+that works well for simple place forms.
+
+In the simple `defsetf' form, `setf's of the form (setf (NAME
+ARGS...) VAL) are transformed to function or macro calls of the
+form (FUNC ARGS... VAL). For example:
+
+ (defsetf aref aset)
+
+You can replace this form with `gv-define-simple-setter'.
+
+Alternate form: (defsetf NAME ARGLIST (STORE) BODY...).
+
+Here, the above `setf' call is expanded by binding the argument
+forms ARGS according to ARGLIST, binding the value form VAL to
+STORE, then executing BODY, which must return a Lisp form that
+does the necessary `setf' operation. Actually, ARGLIST and STORE
+may be bound to temporary variables which are introduced
+automatically to preserve proper execution order of the arguments.
+For example:
+
+ (defsetf nth (n x) (v) `(setcar (nthcdr ,n ,x) ,v))
+
+You can replace this form with `gv-define-setter'.
+
+\(fn NAME [FUNC | ARGLIST (STORE) BODY...])"
+ (declare (debug
+ (&define name
+ [&or [symbolp &optional stringp]
+ [cl-lambda-list (symbolp)]]
+ cl-declarations-or-string def-body)))
+ (if (and (listp arg1) (consp args))
+ ;; Like `gv-define-setter' but with `cl-function'.
+ `(gv-define-expander ,name
+ (lambda (do &rest args)
+ (gv--defsetter ',name
+ (cl-function
+ (lambda (,@(car args) ,@arg1) ,@(cdr args)))
+ do args)))
+ `(gv-define-simple-setter ,name ,arg1 ,(car args))))
+
+;; FIXME: CL used to provide a setf method for `apply', but I haven't been able
+;; to find a case where it worked. The code below tries to handle it as well.
+;; (defun cl--setf-apply (form last-witness last)
+;; (cond
+;; ((not (consp form)) form)
+;; ((eq (ignore-errors (car (last form))) last-witness)
+;; `(apply #',(car form) ,@(butlast (cdr form)) ,last))
+;; ((and (memq (car form) '(let let*))
+;; (rassoc (list last-witness) (cadr form)))
+;; (let ((rebind (rassoc (list last-witness) (cadr form))))
+;; `(,(car form) ,(remq rebind (cadr form))
+;; ,@(mapcar (lambda (form) (cl--setf-apply form (car rebind) last))
+;; (cddr form)))))
+;; (t (mapcar (lambda (form) (cl--setf-apply form last-witness last)) form))))
+;; (gv-define-setter apply (val fun &rest args)
+;; (pcase fun (`#',(and (pred symbolp) f) (setq fun f))
+;; (_ (error "First arg to apply in setf is not #'SYM: %S" fun)))
+;; (let* ((butlast (butlast args))
+;; (last (car (last args)))
+;; (last-witness (make-symbol "--cl-tailarg--"))
+;; (setter (macroexpand `(setf (,fun ,@butlast ,last-witness) ,val)
+;; macroexpand-all-environment)))
+;; (cl--setf-apply setter last-witness last)))
+
+
+;; FIXME: CL used to provide get-setf-method, which was used by some
+;; setf-expanders, but now that we use gv.el, it is a lot more difficult
+;; and in general impossible to provide get-setf-method. Hopefully, it
+;; won't be needed. If needed, we'll have to do something nasty along the
+;; lines of
+;; (defun get-setf-method (place &optional env)
+;; (let* ((witness (list 'cl-gsm))
+;; (expansion (gv-letplace (getter setter) place
+;; `(,witness ,getter ,(funcall setter witness)))))
+;; ...find "let prefix" of expansion, extract getter and setter from
+;; ...the rest, and build the 5-tuple))
+(make-obsolete 'get-setf-method 'gv-letplace "24.3")
+
+(defmacro define-modify-macro (name arglist func &optional doc)
+ "Define a `setf'-like modify macro.
+If NAME is called, it combines its PLACE argument with the other
+arguments from ARGLIST using FUNC. For example:
+
+ (define-modify-macro incf (&optional (n 1)) +)
+
+You can replace this macro with `gv-letplace'."
+ (declare (debug
+ (&define name cl-lambda-list ;; should exclude &key
+ symbolp &optional stringp)))
+ (if (memq '&key arglist)
+ (error "&key not allowed in define-modify-macro"))
+ (let ((place (make-symbol "--cl-place--")))
+ `(cl-defmacro ,name (,place ,@arglist)
+ ,doc
+ (,(if (memq '&rest arglist) #'cl-list* #'list)
+ #'cl-callf ',func ,place
+ ,@(cl--arglist-args arglist)))))
+
+;;; Additional compatibility code.
+;; For names that were clean but really aren't needed any more.
+
+(define-obsolete-function-alias 'cl-macroexpand 'macroexpand "24.3")
+(define-obsolete-variable-alias 'cl-macro-environment
+ 'macroexpand-all-environment "24.3")
+(define-obsolete-function-alias 'cl-macroexpand-all 'macroexpand-all "24.3")
+
+;;; Hash tables.
+;; This is just kept for compatibility with code byte-compiled by Emacs-20.
+
+;; No idea if this might still be needed.
+(defun cl-not-hash-table (x &optional y &rest _z)
+ (declare (obsolete nil "24.3"))
+ (signal 'wrong-type-argument (list 'cl-hash-table-p (or y x))))
+
+(defvar cl-builtin-gethash (symbol-function 'gethash))
+(make-obsolete-variable 'cl-builtin-gethash nil "24.3")
+(defvar cl-builtin-remhash (symbol-function 'remhash))
+(make-obsolete-variable 'cl-builtin-remhash nil "24.3")
+(defvar cl-builtin-clrhash (symbol-function 'clrhash))
+(make-obsolete-variable 'cl-builtin-clrhash nil "24.3")
+(defvar cl-builtin-maphash (symbol-function 'maphash))
+
+(make-obsolete-variable 'cl-builtin-maphash nil "24.3")
+(define-obsolete-function-alias 'cl-map-keymap 'map-keymap "24.3")
+(define-obsolete-function-alias 'cl-copy-tree 'copy-tree "24.3")
+(define-obsolete-function-alias 'cl-gethash 'gethash "24.3")
+(define-obsolete-function-alias 'cl-puthash 'puthash "24.3")
+(define-obsolete-function-alias 'cl-remhash 'remhash "24.3")
+(define-obsolete-function-alias 'cl-clrhash 'clrhash "24.3")
+(define-obsolete-function-alias 'cl-maphash 'maphash "24.3")
+(define-obsolete-function-alias 'cl-make-hash-table 'make-hash-table "24.3")
+(define-obsolete-function-alias 'cl-hash-table-p 'hash-table-p "24.3")
+(define-obsolete-function-alias 'cl-hash-table-count 'hash-table-count "24.3")
+
+(define-obsolete-function-alias 'cl-map-keymap-recursively
+ 'cl--map-keymap-recursively "24.3")
+(define-obsolete-function-alias 'cl-map-intervals 'cl--map-intervals "24.3")
+(define-obsolete-function-alias 'cl-map-extents 'cl--map-overlays "24.3")
(defun cl-maclisp-member (item list)
+ (declare (obsolete member "24.3"))
(while (and list (not (equal item (car list)))) (setq list (cdr list)))
list)
-(defalias 'cl-member 'memq) ; for compatibility with old CL package
-
-;; Autoloaded, but we have not loaded cl-loaddefs yet.
-(declare-function floor* "cl-extra" (x &optional y))
-(declare-function ceiling* "cl-extra" (x &optional y))
-(declare-function truncate* "cl-extra" (x &optional y))
-(declare-function round* "cl-extra" (x &optional y))
-(declare-function mod* "cl-extra" (x y))
-
-(defalias 'cl-floor 'floor*)
-(defalias 'cl-ceiling 'ceiling*)
-(defalias 'cl-truncate 'truncate*)
-(defalias 'cl-round 'round*)
-(defalias 'cl-mod 'mod*)
-
-(defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs
- "Return ITEM consed onto the front of LIST only if it's not already there.
-Otherwise, return LIST unmodified.
-\nKeywords supported: :test :test-not :key
-\n(fn ITEM LIST [KEYWORD VALUE]...)"
- (cond ((or (equal cl-keys '(:test eq))
- (and (null cl-keys) (not (numberp cl-item))))
- (if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
- ((or (equal cl-keys '(:test equal)) (null cl-keys))
- (if (member cl-item cl-list) cl-list (cons cl-item cl-list)))
- (t (apply 'cl-adjoin cl-item cl-list cl-keys))))
-
-(defun subst (cl-new cl-old cl-tree &rest cl-keys)
- "Substitute NEW for OLD everywhere in TREE (non-destructively).
-Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
-\nKeywords supported: :test :test-not :key
-\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
- (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old))))
- (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys)
- (cl-do-subst cl-new cl-old cl-tree)))
-
-(defun cl-do-subst (cl-new cl-old cl-tree)
- (cond ((eq cl-tree cl-old) cl-new)
- ((consp cl-tree)
- (let ((a (cl-do-subst cl-new cl-old (car cl-tree)))
- (d (cl-do-subst cl-new cl-old (cdr cl-tree))))
- (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree)))
- cl-tree (cons a d))))
- (t cl-tree)))
-
-(defun acons (key value alist)
- "Add KEY and VALUE to ALIST.
-Return a new list with (cons KEY VALUE) as car and ALIST as cdr."
- (cons (cons key value) alist))
-
-(defun pairlis (keys values &optional alist)
- "Make an alist from KEYS and VALUES.
-Return a new alist composed by associating KEYS to corresponding VALUES;
-the process stops as soon as KEYS or VALUES run out.
-If ALIST is non-nil, the new pairs are prepended to it."
- (nconc (mapcar* 'cons keys values) alist))
-
-
-;;; Miscellaneous.
-
-;; Define data for indentation and edebug.
-(dolist (entry
- '(((defun* defmacro*) 2)
- ((function*) nil
- (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form)))
- ((eval-when) 1 (sexp &rest form))
- ((declare) nil (&rest sexp))
- ((the) 1 (sexp &rest form))
- ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form)))
- ((block return-from) 1 (sexp &rest form))
- ((return) nil (&optional form))
- ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form))
- (form &rest form)
- &rest form))
- ((do-symbols) 1 ((symbolp form &optional form form) &rest form))
- ((do-all-symbols) 1 ((symbolp form &optional form) &rest form))
- ((psetq setf psetf) nil edebug-setq-form)
- ((progv) 2 (&rest form))
- ((flet labels macrolet) 1
- ((&rest (sexp sexp &rest form)) &rest form))
- ((symbol-macrolet lexical-let lexical-let*) 1
- ((&rest &or symbolp (symbolp form)) &rest form))
- ((multiple-value-bind) 2 ((&rest symbolp) &rest form))
- ((multiple-value-setq) 1 ((&rest symbolp) &rest form))
- ((incf decf remf pushnew shiftf rotatef) nil (&rest form))
- ((letf letf*) 1 ((&rest (&rest form)) &rest form))
- ((callf destructuring-bind) 2 (sexp form &rest form))
- ((callf2) 3 (sexp form form &rest form))
- ((loop) nil (&rest &or symbolp form))
- ((ignore-errors) 0 (&rest form))))
- (dolist (func (car entry))
- (put func 'lisp-indent-function (nth 1 entry))
- (put func 'lisp-indent-hook (nth 1 entry))
- (or (get func 'edebug-form-spec)
- (put func 'edebug-form-spec (nth 2 entry)))))
-
-;; Autoload the other portions of the package.
-;; We want to replace the basic versions of dolist, dotimes, declare below.
-(fmakunbound 'dolist)
-(fmakunbound 'dotimes)
-(fmakunbound 'declare)
-(load "cl-loaddefs" nil 'quiet)
-
-;; This goes here so that cl-macs can find it if it loads right now.
-(provide 'cl)
-
-;; Things to do after byte-compiler is loaded.
-
-(defvar cl-hacked-flag nil)
-(defun cl-hack-byte-compiler ()
- (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form)
- (progn
- (setq cl-hacked-flag t) ; Do it first, to prevent recursion.
- (load "cl-macs" nil t)
- (run-hooks 'cl-hack-bytecomp-hook))))
-
-;; Try it now in case the compiler has already been loaded.
-(cl-hack-byte-compiler)
-
-;; Also make a hook in case compiler is loaded after this file.
-(add-hook 'bytecomp-load-hook 'cl-hack-byte-compiler)
-
-
-;; The following ensures that packages which expect the old-style cl.el
-;; will be happy with this one.
+;; Used in the expansion of the old `defstruct'.
+(defun cl-struct-setf-expander (x name accessor pred-form pos)
+ (declare (obsolete nil "24.3"))
+ (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-store--")))
+ (list (list temp) (list x) (list store)
+ `(progn
+ ,@(and pred-form
+ (list `(or ,(cl-subst temp 'cl-x pred-form)
+ (error ,(format
+ "%s storing a non-%s"
+ accessor name)))))
+ ,(if (eq (car (get name 'cl-struct-type)) 'vector)
+ `(aset ,temp ,pos ,store)
+ `(setcar
+ ,(if (<= pos 5)
+ (let ((xx temp))
+ (while (>= (setq pos (1- pos)) 0)
+ (setq xx `(cdr ,xx)))
+ xx)
+ `(nthcdr ,pos ,temp))
+ ,store)))
+ (list accessor temp))))
(provide 'cl)
-
-(run-hooks 'cl-load-hook)
-
-;; Local variables:
-;; byte-compile-dynamic: t
-;; byte-compile-warnings: (not cl-functions)
-;; End:
-
;;; cl.el ends here
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index 582785a0e90..c3616c6e490 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -1,6 +1,6 @@
;;; copyright.el --- update the copyright notice in current buffer
-;; Copyright (C) 1991-1995, 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1995, 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: maint, tools
@@ -85,7 +85,7 @@ The second \\( \\) construct must match the years."
"Non-nil if individual consecutive years should be replaced with a range.
For example: 2005, 2006, 2007, 2008 might be replaced with 2005-2008.
If you use ranges, you should add an explanatory note in a README file.
-The function `copyright-fix-year' respects this variable."
+The function `copyright-fix-years' respects this variable."
:group 'copyright
:type 'boolean
:version "24.1")
@@ -110,7 +110,7 @@ When this is `function', only ask when called non-interactively."
;; This is a defvar rather than a defconst, because the year can
;; change during the Emacs session.
-(defvar copyright-current-year (substring (current-time-string) -4)
+(defvar copyright-current-year (format-time-string "%Y")
"String representing the current year.")
(defsubst copyright-limit () ; re-search-forward BOUND
@@ -181,8 +181,7 @@ skips to the end of all the years."
;; This uses the match-data from copyright-find-copyright/end.
(goto-char (match-end 1))
(copyright-find-end)
- ;; Note that `current-time-string' isn't locale-sensitive.
- (setq copyright-current-year (substring (current-time-string) -4))
+ (setq copyright-current-year (format-time-string "%Y"))
(unless (string= (buffer-substring (- (match-end 3) 2) (match-end 3))
(substring copyright-current-year -2))
(if (or noquery
@@ -347,7 +346,7 @@ independently replaces consecutive years with a range."
"Insert a copyright by $ORGANIZATION notice at cursor."
"Company: "
comment-start
- "Copyright (C) " `(substring (current-time-string) -4) " by "
+ "Copyright (C) " `(format-time-string "%Y") " by "
(or (getenv "ORGANIZATION")
str)
'(if (copyright-offset-too-large-p)
@@ -363,10 +362,11 @@ If FIX is non-nil, run `copyright-fix-years' instead."
(dolist (file (directory-files directory t match nil))
(unless (file-directory-p file)
(message "Updating file `%s'" file)
- (find-file file)
- (let ((inhibit-read-only t)
- (enable-local-variables :safe)
- copyright-query)
+ ;; FIXME we should not use find-file+save+kill.
+ (let ((enable-local-variables :safe)
+ (enable-local-eval nil))
+ (find-file file))
+ (let ((inhibit-read-only t))
(if fix
(copyright-fix-years)
(copyright-update)))
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index 3848ab7e6ea..87c9b280bea 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -1,6 +1,6 @@
;;; crm.el --- read multiple strings with completion
-;; Copyright (C) 1985-1986, 1993-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1993-2012 Free Software Foundation, Inc.
;; Author: Sen Nagata <sen@eccosys.com>
;; Keywords: completion, minibuffer, multiple elements
@@ -143,7 +143,7 @@ nil if none.
The value of FLAG is used to specify the type of completion operation.
A value of nil specifies `try-completion'. A value of t specifies
-`all-completions'. A value of lambda specifes a test for an exact match.
+`all-completions'. A value of lambda specifies a test for an exact match.
For more information on STRING, PREDICATE, and FLAG, see the Elisp
Reference sections on 'Programmed Completion' and 'Basic Completion
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index d05a518e590..a378941a5a4 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -1,6 +1,6 @@
-;;; debug.el --- debuggers and related commands for Emacs
+;;; debug.el --- debuggers and related commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1994, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: lisp, tools, maint
@@ -48,8 +48,38 @@ the middle is discarded, and just the beginning and end are displayed."
:group 'debugger
:version "21.1")
-(defvar debug-function-list nil
- "List of functions currently set for debug on entry.")
+(defcustom debugger-bury-or-kill 'bury
+ "What to do with the debugger buffer when exiting `debug'.
+The value affects the behavior of operations on any window
+previously showing the debugger buffer.
+
+`nil' means that if its window is not deleted when exiting the
+ debugger, invoking `switch-to-prev-buffer' will usually show
+ the debugger buffer again.
+
+`append' means that if the window is not deleted, the debugger
+ buffer moves to the end of the window's previous buffers so
+ it's less likely that a future invocation of
+ `switch-to-prev-buffer' will switch to it. Also, it moves the
+ buffer to the end of the frame's buffer list.
+
+`bury' means that if the window is not deleted, its buffer is
+ removed from the window's list of previous buffers. Also, it
+ moves the buffer to the end of the frame's buffer list. This
+ value provides the most reliable remedy to not have
+ `switch-to-prev-buffer' switch to the debugger buffer again
+ without killing the buffer.
+
+`kill' means to kill 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))
+ :group 'debugger
+ :version "24.3")
(defvar debugger-step-after-exit nil
"Non-nil means \"single-step\" after the debugger exits.")
@@ -60,6 +90,12 @@ the middle is discarded, and just the beginning and end are displayed."
(defvar debugger-old-buffer nil
"This is the buffer that was current when the debugger was entered.")
+(defvar debugger-previous-window nil
+ "This is the window last showing the debugger buffer.")
+
+(defvar debugger-previous-window-height nil
+ "The last recorded height of `debugger-previous-window'.")
+
(defvar debugger-previous-backtrace nil
"The contents of the previous backtrace (including text properties).
This is to optimize `debugger-make-xrefs'.")
@@ -71,10 +107,6 @@ This is to optimize `debugger-make-xrefs'.")
(defvar debugger-outer-track-mouse)
(defvar debugger-outer-last-command)
(defvar debugger-outer-this-command)
-;; unread-command-char is obsolete,
-;; but we still save and restore it
-;; in case some user program still tries to set it.
-(defvar debugger-outer-unread-command-char)
(defvar debugger-outer-unread-command-events)
(defvar debugger-outer-unread-post-input-method-events)
(defvar debugger-outer-last-input-event)
@@ -111,7 +143,7 @@ where CAUSE can be:
;;;###autoload
(setq debugger 'debug)
;;;###autoload
-(defun debug (&rest debugger-args)
+(defun debug (&rest args)
"Enter debugger. \\<debugger-mode-map>`\\[debugger-continue]' returns from the debugger.
Arguments are mainly for use when this is called from the internals
of the evaluator.
@@ -126,14 +158,14 @@ first will be printed into the backtrace buffer."
(unless noninteractive
(message "Entering debugger..."))
(let (debugger-value
- (debug-on-error nil)
- (debug-on-quit nil)
(debugger-previous-state
(if (get-buffer "*Backtrace*")
(with-current-buffer (get-buffer "*Backtrace*")
(list major-mode (buffer-string)))))
+ (debugger-args args)
(debugger-buffer (get-buffer-create "*Backtrace*"))
(debugger-old-buffer (current-buffer))
+ (debugger-window nil)
(debugger-step-after-exit nil)
(debugger-will-be-back nil)
;; Don't keep reading from an executing kbd macro!
@@ -148,8 +180,6 @@ first will be printed into the backtrace buffer."
(debugger-outer-track-mouse track-mouse)
(debugger-outer-last-command last-command)
(debugger-outer-this-command this-command)
- (debugger-outer-unread-command-char
- (with-no-warnings unread-command-char))
(debugger-outer-unread-command-events unread-command-events)
(debugger-outer-unread-post-input-method-events
unread-post-input-method-events)
@@ -181,81 +211,86 @@ first will be printed into the backtrace buffer."
(or enable-recursive-minibuffers (> (minibuffer-depth) 0)))
(standard-input t) (standard-output t)
inhibit-redisplay
- (cursor-in-echo-area nil))
+ (cursor-in-echo-area nil)
+ (window-configuration (current-window-configuration)))
(unwind-protect
(save-excursion
- (save-window-excursion
- (with-no-warnings
- (setq unread-command-char -1))
- (when (eq (car debugger-args) 'debug)
- ;; Skip the frames for backtrace-debug, byte-code,
- ;; and implement-debug-on-entry.
- (backtrace-debug 4 t)
- ;; Place an extra debug-on-exit for macro's.
- (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
- (backtrace-debug 5 t)))
- (pop-to-buffer debugger-buffer)
- (debugger-mode)
- (debugger-setup-buffer debugger-args)
- (when noninteractive
- ;; If the backtrace is long, save the beginning
- ;; and the end, but discard the middle.
- (when (> (count-lines (point-min) (point-max))
- debugger-batch-max-lines)
- (goto-char (point-min))
- (forward-line (/ 2 debugger-batch-max-lines))
- (let ((middlestart (point)))
- (goto-char (point-max))
- (forward-line (- (/ 2 debugger-batch-max-lines)
- debugger-batch-max-lines))
- (delete-region middlestart (point)))
- (insert "...\n"))
+ (when (eq (car debugger-args) 'debug)
+ ;; Skip the frames for backtrace-debug, byte-code,
+ ;; debug--implement-debug-on-entry and the advice's `apply'.
+ (backtrace-debug 4 t)
+ ;; Place an extra debug-on-exit for macro's.
+ (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
+ (backtrace-debug 5 t)))
+ (pop-to-buffer
+ debugger-buffer
+ `((display-buffer-reuse-window
+ display-buffer-in-previous-window)
+ . (,(when debugger-previous-window
+ `(previous-window . ,debugger-previous-window)))))
+ (setq debugger-window (selected-window))
+ (if (eq debugger-previous-window debugger-window)
+ (when debugger-jumping-flag
+ ;; Try to restore previous height of debugger
+ ;; window.
+ (condition-case nil
+ (window-resize
+ debugger-window
+ (- debugger-previous-window-height
+ (window-total-size debugger-window)))
+ (error nil)))
+ (setq debugger-previous-window debugger-window))
+ (debugger-mode)
+ (debugger-setup-buffer debugger-args)
+ (when noninteractive
+ ;; If the backtrace is long, save the beginning
+ ;; and the end, but discard the middle.
+ (when (> (count-lines (point-min) (point-max))
+ debugger-batch-max-lines)
(goto-char (point-min))
- (message "%s" (buffer-string))
- (kill-emacs -1))
+ (forward-line (/ 2 debugger-batch-max-lines))
+ (let ((middlestart (point)))
+ (goto-char (point-max))
+ (forward-line (- (/ 2 debugger-batch-max-lines)
+ debugger-batch-max-lines))
+ (delete-region middlestart (point)))
+ (insert "...\n"))
+ (goto-char (point-min))
+ (message "%s" (buffer-string))
+ (kill-emacs -1))
+ (message "")
+ (let ((standard-output nil)
+ (buffer-read-only t))
(message "")
- (let ((standard-output nil)
- (buffer-read-only t))
- (message "")
- ;; Make sure we unbind buffer-read-only in the right buffer.
- (save-excursion
- (recursive-edit)))))
- ;; Kill or at least neuter the backtrace buffer, so that users
- ;; don't try to execute debugger commands in an invalid context.
- (if (get-buffer-window debugger-buffer 0)
- ;; Still visible despite the save-window-excursion? Maybe it
- ;; it's in a pop-up frame. It would be annoying to delete and
- ;; recreate it every time the debugger stops, so instead we'll
- ;; erase it (and maybe hide it) but keep it alive.
- (with-current-buffer debugger-buffer
- (with-selected-window (get-buffer-window debugger-buffer 0)
- (when (and (window-dedicated-p (selected-window))
- (not debugger-will-be-back))
- ;; If the window is not dedicated, burying the buffer
- ;; will mean that the frame created for it is left
- ;; around showing some random buffer, and next time we
- ;; pop to the debugger buffer we'll create yet
- ;; another frame.
- ;; If debugger-will-be-back is non-nil, the frame
- ;; would need to be de-iconified anyway immediately
- ;; after when we re-enter the debugger, so iconifying it
- ;; here would cause flashing.
- ;; Drew Adams is not happy with this: he wants to frame
- ;; to be left at the top-level, still working on how
- ;; best to do that.
- (bury-buffer))))
- (unless debugger-previous-state
- (kill-buffer debugger-buffer)))
- ;; Restore the previous state of the debugger-buffer, in case we were
- ;; in a recursive invocation of the debugger.
- (when (buffer-live-p debugger-buffer)
- (with-current-buffer debugger-buffer
- (let ((inhibit-read-only t))
- (erase-buffer)
- (if (null debugger-previous-state)
- (fundamental-mode)
- (insert (nth 1 debugger-previous-state))
- (funcall (nth 0 debugger-previous-state))))))
+ ;; Make sure we unbind buffer-read-only in the right buffer.
+ (save-excursion
+ (recursive-edit))))
+ (when (and (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)))
+ (if debugger-will-be-back
+ ;; Restore previous window configuration (Bug#12623).
+ (set-window-configuration window-configuration)
+ (when (and (window-live-p debugger-window)
+ (eq (window-buffer debugger-window) debugger-buffer))
+ (progn
+ ;; Unshow debugger-buffer.
+ (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.
+ (when (buffer-live-p debugger-buffer)
+ (with-current-buffer debugger-buffer
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (if (null debugger-previous-state)
+ (fundamental-mode)
+ (insert (nth 1 debugger-previous-state))
+ (funcall (nth 0 debugger-previous-state))))))
(with-timeout-unsuspend debugger-with-timeout-suspend)
(set-match-data debugger-outer-match-data)))
;; Put into effect the modified values of these variables
@@ -267,8 +302,6 @@ first will be printed into the backtrace buffer."
(setq track-mouse debugger-outer-track-mouse)
(setq last-command debugger-outer-last-command)
(setq this-command debugger-outer-this-command)
- (with-no-warnings
- (setq unread-command-char debugger-outer-unread-command-char))
(setq unread-command-events debugger-outer-unread-command-events)
(setq unread-post-input-method-events
debugger-outer-unread-post-input-method-events)
@@ -283,7 +316,7 @@ first will be printed into the backtrace buffer."
(setq debug-on-next-call debugger-step-after-exit)
debugger-value)))
-(defun debugger-setup-buffer (debugger-args)
+(defun debugger-setup-buffer (args)
"Initialize the `*Backtrace*' buffer for entry to the debugger.
That buffer should be current already."
(setq buffer-read-only nil)
@@ -299,20 +332,22 @@ That buffer should be current already."
(delete-region (point)
(progn
(search-forward "\n debug(")
- (forward-line (if (eq (car debugger-args) 'debug)
- 2 ; Remove implement-debug-on-entry frame.
+ (forward-line (if (eq (car args) 'debug)
+ ;; Remove debug--implement-debug-on-entry
+ ;; and the advice's `apply' frame.
+ 3
1))
(point)))
(insert "Debugger entered")
;; lambda is for debug-on-call when a function call is next.
;; debug is for debug-on-entry function called.
- (pcase (car debugger-args)
+ (pcase (car args)
((or `lambda `debug)
(insert "--entering a function:\n"))
;; Exiting a function.
(`exit
(insert "--returning value: ")
- (setq debugger-value (nth 1 debugger-args))
+ (setq debugger-value (nth 1 args))
(prin1 debugger-value (current-buffer))
(insert ?\n)
(delete-char 1)
@@ -321,7 +356,7 @@ That buffer should be current already."
;; Debugger entered for an error.
(`error
(insert "--Lisp error: ")
- (prin1 (nth 1 debugger-args) (current-buffer))
+ (prin1 (nth 1 args) (current-buffer))
(insert ?\n))
;; debug-on-call, when the next thing is an eval.
(`t
@@ -329,8 +364,8 @@ That buffer should be current already."
;; User calls debug directly.
(_
(insert ": ")
- (prin1 (if (eq (car debugger-args) 'nil)
- (cdr debugger-args) debugger-args)
+ (prin1 (if (eq (car args) 'nil)
+ (cdr args) args)
(current-buffer))
(insert ?\n)))
;; After any frame that uses eval-buffer,
@@ -490,9 +525,10 @@ removes itself from that hook."
(count 0))
(while (not (eq (cadr (backtrace-frame count)) 'debug))
(setq count (1+ count)))
- ;; Skip implement-debug-on-entry frame.
- (when (eq 'implement-debug-on-entry (cadr (backtrace-frame (1+ count))))
- (setq count (1+ count)))
+ ;; Skip debug--implement-debug-on-entry frame.
+ (when (eq 'debug--implement-debug-on-entry
+ (cadr (backtrace-frame (1+ count))))
+ (setq count (+ 2 count)))
(goto-char (point-min))
(when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")
(goto-char (match-end 0))
@@ -570,16 +606,7 @@ Applies to the frame whose line point is on in the backtrace."
(cursor-in-echo-area debugger-outer-cursor-in-echo-area))
(set-match-data debugger-outer-match-data)
(prog1
- (let ((save-ucc (with-no-warnings unread-command-char)))
- (unwind-protect
- (progn
- (with-no-warnings
- (setq unread-command-char debugger-outer-unread-command-char))
- (prog1 (progn ,@body)
- (with-no-warnings
- (setq debugger-outer-unread-command-char unread-command-char))))
- (with-no-warnings
- (setq unread-command-char save-ucc))))
+ (progn ,@body)
(setq debugger-outer-match-data (match-data))
(setq debugger-outer-load-read-function load-read-function)
(setq debugger-outer-overriding-terminal-local-map
@@ -668,10 +695,10 @@ Applies to the frame whose line point is on in the backtrace."
:help "Continue to exit from this frame, with all debug-on-entry suspended"))
(define-key menu-map [deb-cont]
'(menu-item "Continue" debugger-continue
- :help "Continue, evaluating this expression without stopping"))
+ :help "Continue, evaluating this expression without stopping"))
(define-key menu-map [deb-step]
'(menu-item "Step through" debugger-step-through
- :help "Proceed, stepping through subexpressions of this expression"))
+ :help "Proceed, stepping through subexpressions of this expression"))
map))
(put 'debugger-mode 'mode-class 'special)
@@ -751,7 +778,7 @@ For the cross-reference format, see `help-make-xrefs'."
;; When you change this, you may also need to change the number of
;; frames that the debugger skips.
-(defun implement-debug-on-entry ()
+(defun debug--implement-debug-on-entry (&rest _ignore)
"Conditionally call the debugger.
A call to this function is inserted by `debug-on-entry' to cause
functions to break on entry."
@@ -759,12 +786,6 @@ functions to break on entry."
nil
(funcall debugger 'debug)))
-(defun debugger-special-form-p (symbol)
- "Return whether SYMBOL is a special form."
- (and (fboundp symbol)
- (subrp (symbol-function symbol))
- (eq (cdr (subr-arity (symbol-function symbol))) 'unevalled)))
-
;;;###autoload
(defun debug-on-entry (function)
"Request FUNCTION to invoke debugger each time it is called.
@@ -782,7 +803,7 @@ Use \\[cancel-debug-on-entry] to cancel the effect of this command.
Redefining FUNCTION also cancels it."
(interactive
(let ((fn (function-called-at-point)) val)
- (when (debugger-special-form-p fn)
+ (when (special-form-p fn)
(setq fn nil))
(setq val (completing-read
(if fn
@@ -791,36 +812,21 @@ Redefining FUNCTION also cancels it."
obarray
#'(lambda (symbol)
(and (fboundp symbol)
- (not (debugger-special-form-p symbol))))
+ (not (special-form-p symbol))))
t nil nil (symbol-name fn)))
(list (if (equal val "") fn (intern val)))))
- ;; FIXME: Use advice.el.
- (when (debugger-special-form-p function)
- (error "Function %s is a special form" function))
- (if (or (symbolp (symbol-function function))
- (subrp (symbol-function function)))
- ;; The function is built-in or aliased to another function.
- ;; Create a wrapper in which we can add the debug call.
- (fset function `(lambda (&rest debug-on-entry-args)
- ,(interactive-form (symbol-function function))
- (apply ',(symbol-function function)
- debug-on-entry-args)))
- (when (eq (car-safe (symbol-function function)) 'autoload)
- ;; The function is autoloaded. Load its real definition.
- (load (cadr (symbol-function function)) nil noninteractive nil t))
- (when (or (not (consp (symbol-function function)))
- (and (eq (car (symbol-function function)) 'macro)
- (not (consp (cdr (symbol-function function))))))
- ;; The function is byte-compiled. Create a wrapper in which
- ;; we can add the debug call.
- (debug-convert-byte-code function)))
- (unless (consp (symbol-function function))
- (error "Definition of %s is not a list" function))
- (fset function (debug-on-entry-1 function t))
- (unless (memq function debug-function-list)
- (push function debug-function-list))
+ (advice-add function :before #'debug--implement-debug-on-entry)
function)
+(defun debug--function-list ()
+ "List of functions currently set for debug on entry."
+ (let ((funs '()))
+ (mapatoms
+ (lambda (s)
+ (when (advice-member-p #'debug--implement-debug-on-entry s)
+ (push s funs))))
+ funs))
+
;;;###autoload
(defun cancel-debug-on-entry (&optional function)
"Undo effect of \\[debug-on-entry] on FUNCTION.
@@ -831,80 +837,16 @@ To specify a nil argument interactively, exit with an empty minibuffer."
(list (let ((name
(completing-read
"Cancel debug on entry to function (default all functions): "
- (mapcar 'symbol-name debug-function-list) nil t)))
+ (mapcar #'symbol-name (debug--function-list)) nil t)))
(when name
(unless (string= name "")
(intern name))))))
- (if (and function
- (not (string= function ""))) ; Pre 22.1 compatibility test.
+ (if function
(progn
- (let ((defn (debug-on-entry-1 function nil)))
- (condition-case nil
- (when (and (equal (nth 1 defn) '(&rest debug-on-entry-args))
- (eq (car (nth 3 defn)) 'apply))
- ;; `defn' is a wrapper introduced in debug-on-entry.
- ;; Get rid of it since we don't need it any more.
- (setq defn (nth 1 (nth 1 (nth 3 defn)))))
- (error nil))
- (fset function defn))
- (setq debug-function-list (delq function debug-function-list))
+ (advice-remove function #'debug--implement-debug-on-entry)
function)
(message "Cancelling debug-on-entry for all functions")
- (mapcar 'cancel-debug-on-entry debug-function-list)))
-
-(defun debug-arglist (definition)
- ;; FIXME: copied from ad-arglist.
- "Return the argument list of DEFINITION."
- (require 'help-fns)
- (help-function-arglist definition 'preserve-names))
-
-(defun debug-convert-byte-code (function)
- (let* ((defn (symbol-function function))
- (macro (eq (car-safe defn) 'macro)))
- (when macro (setq defn (cdr defn)))
- (when (byte-code-function-p defn)
- (let* ((args (debug-arglist defn))
- (body
- `((,(if (memq '&rest args) #'apply #'funcall)
- ,defn
- ,@(remq '&rest (remq '&optional args))))))
- (if (> (length defn) 5)
- ;; The mere presence of field 5 is sufficient to make
- ;; it interactive.
- (push `(interactive ,(aref defn 5)) body))
- (if (and (> (length defn) 4) (aref defn 4))
- ;; Use `documentation' here, to get the actual string,
- ;; in case the compiled function has a reference
- ;; to the .elc file.
- (setq body (cons (documentation function) body)))
- (setq defn `(closure (t) ,args ,@body)))
- (when macro (setq defn (cons 'macro defn)))
- (fset function defn))))
-
-(defun debug-on-entry-1 (function flag)
- (let* ((defn (symbol-function function))
- (tail defn))
- (when (eq (car-safe tail) 'macro)
- (setq tail (cdr tail)))
- (if (not (memq (car-safe tail) '(closure lambda)))
- ;; Only signal an error when we try to set debug-on-entry.
- ;; When we try to clear debug-on-entry, we are now done.
- (when flag
- (error "%s is not a user-defined Lisp function" function))
- (if (eq (car tail) 'closure) (setq tail (cdr tail)))
- (setq tail (cdr tail))
- ;; Skip the docstring.
- (when (and (stringp (cadr tail)) (cddr tail))
- (setq tail (cdr tail)))
- ;; Skip the interactive form.
- (when (eq 'interactive (car-safe (cadr tail)))
- (setq tail (cdr tail)))
- (unless (eq flag (equal (cadr tail) '(implement-debug-on-entry)))
- ;; Add/remove debug statement as needed.
- (setcdr tail (if flag
- (cons '(implement-debug-on-entry) (cdr tail))
- (cddr tail)))))
- defn))
+ (mapcar #'cancel-debug-on-entry (debug--function-list))))
(defun debugger-list-functions ()
"Display a list of all the functions now set to debug on entry."
@@ -914,17 +856,18 @@ To specify a nil argument interactively, exit with an empty minibuffer."
(called-interactively-p 'interactive))
(with-output-to-temp-buffer (help-buffer)
(with-current-buffer standard-output
- (if (null debug-function-list)
- (princ "No debug-on-entry functions now\n")
- (princ "Functions set to debug on entry:\n\n")
- (dolist (fun debug-function-list)
- (make-text-button (point) (progn (prin1 fun) (point))
- 'type 'help-function
- 'help-args (list fun))
- (terpri))
- (terpri)
- (princ "Note: if you have redefined a function, then it may no longer\n")
- (princ "be set to debug on entry, even if it is in the list.")))))
+ (let ((funs (debug--function-list)))
+ (if (null funs)
+ (princ "No debug-on-entry functions now\n")
+ (princ "Functions set to debug on entry:\n\n")
+ (dolist (fun funs)
+ (make-text-button (point) (progn (prin1 fun) (point))
+ 'type 'help-function
+ 'help-args (list fun))
+ (terpri))
+ (terpri)
+ (princ "Note: if you have redefined a function, then it may no longer\n")
+ (princ "be set to debug on entry, even if it is in the list."))))))
(provide 'debug)
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 55ea102ed2a..8c8d37b2194 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -1,7 +1,7 @@
;;; derived.el --- allow inheritance of major modes
;; (formerly mode-clone.el)
-;; Copyright (C) 1993-1994, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: David Megginson (dmeggins@aix1.uottawa.ca)
;; Maintainer: FSF
@@ -90,8 +90,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
;;; PRIVATE: defsubst must be defined before they are first used
(defsubst derived-mode-hook-name (mode)
@@ -183,11 +181,11 @@ See Info node `(elisp)Derived Modes' for more details."
;; Process the keyword args.
(while (keywordp (car body))
- (case (pop body)
- (:group (setq group (pop body)))
- (:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
- (:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
- (t (pop body))))
+ (pcase (pop body)
+ (`:group (setq group (pop body)))
+ (`:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
+ (`:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
+ (_ (pop body))))
(setq docstring (derived-mode-make-docstring
parent child docstring syntax abbrev))
@@ -278,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/disass.el b/lisp/emacs-lisp/disass.el
index 2a41e611dc0..206166bc77a 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -1,6 +1,6 @@
;;; disass.el --- disassembler for compiled Emacs Lisp code
-;; Copyright (C) 1986, 1991, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1991, 2002-2012 Free Software Foundation, Inc.
;; Author: Doug Cutting <doug@csli.stanford.edu>
;; Jamie Zawinski <jwz@lucid.com>
@@ -35,6 +35,8 @@
;;; Code:
+(require 'macroexp)
+
;;; The variable byte-code-vector is defined by the new bytecomp.el.
;;; The function byte-decompile-lapcode is defined in byte-opt.el.
;;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt.
@@ -78,14 +80,10 @@ redefine OBJECT if it is a symbol."
obj (symbol-function obj)))
(if (subrp obj)
(error "Can't disassemble #<subr %s>" name))
- (when (and (listp obj) (eq (car obj) 'autoload))
- (load (nth 1 obj))
- (setq obj (symbol-function name)))
- (if (eq (car-safe obj) 'macro) ;handle macros
+ (setq obj (autoload-do-load obj name))
+ (if (eq (car-safe obj) 'macro) ;Handle macros.
(setq macro t
obj (cdr obj)))
- (when (and (listp obj) (eq (car obj) 'closure))
- (error "Don't know how to compile an interpreted closure"))
(if (and (listp obj) (eq (car obj) 'byte-code))
(setq obj (list 'lambda nil obj)))
(if (and (listp obj) (not (eq (car obj) 'lambda)))
@@ -155,7 +153,7 @@ redefine OBJECT if it is a symbol."
(t
(insert "Uncompiled body: ")
(let ((print-escape-newlines t))
- (prin1 (if (cdr obj) (cons 'progn obj) (car obj))
+ (prin1 (macroexp-progn obj)
(current-buffer))))))
(if interactive-p
(message "")))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index fae4d9adc38..4951368aebe 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -1,6 +1,6 @@
;;; easy-mmode.el --- easy definition for major and minor modes
-;; Copyright (C) 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -51,8 +51,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(defun easy-mmode-pretty-mode-name (mode &optional lighter)
"Turn the symbol MODE into a string intended for the user.
If provided, LIGHTER will be used to help choose capitalization by,
@@ -67,7 +65,8 @@ replacing its case-insensitive matches with the literal string in LIGHTER."
;; "foo-bar-minor" -> "Foo-Bar-Minor"
(capitalize (replace-regexp-in-string
;; "foo-bar-minor-mode" -> "foo-bar-minor"
- "-mode\\'" "" (symbol-name mode))))
+ "toggle-\\|-mode\\'" ""
+ (symbol-name mode))))
" mode")))
(if (not (stringp lighter)) name
;; Strip leading and trailing whitespace from LIGHTER.
@@ -86,11 +85,25 @@ replacing its case-insensitive matches with the literal string in LIGHTER."
;;;###autoload
(defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body)
"Define a new minor mode MODE.
-This defines the control variable MODE and the toggle command MODE.
+This defines the toggle command MODE and (by default) a control variable
+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.
+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 modeline when the mode is on.
+Optional LIGHTER is displayed in the mode line when the mode is on.
Optional KEYMAP is the default keymap bound to the mode keymap.
If non-nil, it should be a variable name (whose value is a keymap),
or an expression that returns either a keymap or a list of
@@ -113,21 +126,28 @@ BODY contains code to execute each time the mode is enabled or disabled.
buffer-local, so don't make the variable MODE buffer-local.
By default, the mode is buffer-local.
:init-value VAL Same as the INIT-VALUE argument.
+ Not used if you also specify :variable.
:lighter SPEC Same as the LIGHTER argument.
:keymap MAP Same as the KEYMAP argument.
:require SYM Same as in `defcustom'.
-:variable PLACE The location (as can be used with `setf') to use instead
- of the variable MODE to store the state of the mode. PLACE
- can also be of the form (GET . SET) where GET is an expression
- that returns the current state and SET is a function that takes
- a new state and sets it. If you specify a :variable, this
- function assumes it is defined elsewhere.
+:variable PLACE The location to use instead of the variable MODE to store
+ the state of the mode. This can be simply a different
+ named variable, or more generally anything that can be used
+ with the CL macro `setf'. PLACE can also be of the form
+ \(GET . SET), where GET is an expression that returns the
+ current state, and SET is a function that takes one argument,
+ the new state, and sets it. If you specify a :variable,
+ this function does not define a MODE variable (nor any of
+ the terms used in :variable).
+:after-hook A single lisp form which is evaluated after the mode hooks
+ have been run. It should not be quoted.
For example, you could write
(define-minor-mode foo-mode \"If enabled, foo on you!\"
:lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
...BODY CODE...)"
- (declare (debug (&define name stringp
+ (declare (doc-string 2)
+ (debug (&define name stringp
[&optional [&not keywordp] sexp
&optional [&not keywordp] sexp
&optional [&not keywordp] sexp]
@@ -137,10 +157,10 @@ For example, you could write
;; Allow skipping the first three args.
(cond
((keywordp init-value)
- (setq body (list* init-value lighter keymap body)
+ (setq body `(,init-value ,lighter ,keymap ,@body)
init-value nil lighter nil keymap nil))
((keywordp lighter)
- (setq body (list* lighter keymap body) lighter nil keymap nil))
+ (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
((keywordp keymap) (push keymap body) (setq keymap nil)))
(let* ((last-message (make-symbol "last-message"))
@@ -157,32 +177,36 @@ For example, you could write
(setter nil) ;The function (if any) to set the mode var.
(modefun mode) ;The minor mode function name we're defining.
(require t)
+ (after-hook nil)
(hook (intern (concat mode-name "-hook")))
(hook-on (intern (concat mode-name "-on-hook")))
(hook-off (intern (concat mode-name "-off-hook")))
- keyw keymap-sym)
+ keyw keymap-sym tmp)
;; Check keys.
(while (keywordp (setq keyw (car body)))
(setq body (cdr body))
- (case keyw
- (:init-value (setq init-value (pop body)))
- (:lighter (setq lighter (purecopy (pop body))))
- (:global (setq globalp (pop body)))
- (:extra-args (setq extra-args (pop body)))
- (:set (setq set (list :set (pop body))))
- (:initialize (setq initialize (list :initialize (pop body))))
- (:group (setq group (nconc group (list :group (pop body)))))
- (:type (setq type (list :type (pop body))))
- (:require (setq require (pop body)))
- (:keymap (setq keymap (pop body)))
- (:variable (setq variable (pop body))
- (if (not (functionp (cdr-safe variable)))
+ (pcase keyw
+ (`:init-value (setq init-value (pop body)))
+ (`:lighter (setq lighter (purecopy (pop body))))
+ (`:global (setq globalp (pop body)))
+ (`:extra-args (setq extra-args (pop body)))
+ (`:set (setq set (list :set (pop body))))
+ (`:initialize (setq initialize (list :initialize (pop body))))
+ (`:group (setq group (nconc group (list :group (pop body)))))
+ (`:type (setq type (list :type (pop body))))
+ (`:require (setq require (pop body)))
+ (`:keymap (setq keymap (pop body)))
+ (`:variable (setq variable (pop body))
+ (if (not (and (setq tmp (cdr-safe variable))
+ (or (symbolp tmp)
+ (functionp tmp))))
;; PLACE is not of the form (GET . SET).
(setq mode variable)
(setq mode (car variable))
(setq setter (cdr variable))))
- (t (push keyw extra-keywords) (push (pop body) extra-keywords))))
+ (`:after-hook (setq after-hook (pop body)))
+ (_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
(setq keymap-sym (if (and keymap (symbolp keymap)) keymap
(intern (concat mode-name "-map"))))
@@ -209,6 +233,7 @@ For example, you could write
(variable nil)
((not globalp)
`(progn
+ :autoload-end
(defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
Use the command `%s' to change this variable." pretty-name mode))
(make-variable-buffer-local ',mode)))
@@ -235,13 +260,13 @@ or call the function `%s'."))))
(format (concat "Toggle %s on or off.
With a prefix argument ARG, enable %s if ARG is
positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
+the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
\\{%s}") pretty-name pretty-name keymap-sym))
;; Use `toggle' rather than (if ,mode 0 1) so that using
;; repeat-command still does the toggling correctly.
(interactive (list (or current-prefix-arg 'toggle)))
(let ((,last-message (current-message)))
- (,@(if setter (list setter)
+ (,@(if setter `(funcall #',setter)
(list (if (symbolp mode) 'setq 'setf) mode))
(if (eq arg 'toggle)
(not ,mode)
@@ -260,7 +285,8 @@ the mode if ARG is omitted or nil.
(not (equal ,last-message
(current-message))))
(message ,(format "%s %%sabled" pretty-name)
- (if ,mode "en" "dis"))))))
+ (if ,mode "en" "dis")))))
+ ,@(when after-hook `(,after-hook)))
(force-mode-line-update)
;; Return the new setting.
,mode)
@@ -286,7 +312,7 @@ the mode if ARG is omitted or nil.
,(if keymap keymap-sym
`(if (boundp ',keymap-sym) ,keymap-sym))
nil
- ,(unless (eq mode modefun) 'modefun)))))))
+ ,(unless (eq mode modefun) `',modefun)))))))
;;;
;;; make global minor mode
@@ -315,7 +341,7 @@ enabled, then disabling and reenabling MODE should make MODE work
correctly with the current major mode. This is important to
prevent problems with derived modes, that is, major modes that
call another major mode in their body."
-
+ (declare (doc-string 2))
(let* ((global-mode-name (symbol-name global-mode))
(pretty-name (easy-mmode-pretty-mode-name mode))
(pretty-global-name (easy-mmode-pretty-mode-name global-mode))
@@ -333,10 +359,10 @@ call another major mode in their body."
;; Check keys.
(while (keywordp (setq keyw (car keys)))
(setq keys (cdr keys))
- (case keyw
- (:group (setq group (nconc group (list :group (pop keys)))))
- (:global (setq keys (cdr keys)))
- (t (push keyw extra-keywords) (push (pop keys) extra-keywords))))
+ (pcase keyw
+ (`:group (setq group (nconc group (list :group (pop keys)))))
+ (`:global (setq keys (cdr keys)))
+ (_ (push keyw extra-keywords) (push (pop keys) extra-keywords))))
(unless group
;; We might as well provide a best-guess default group.
@@ -345,8 +371,10 @@ call another major mode in their body."
"-mode\\'" "" (symbol-name mode))))))
`(progn
- (defvar ,MODE-major-mode nil)
- (make-variable-buffer-local ',MODE-major-mode)
+ (progn
+ :autoload-end
+ (defvar ,MODE-major-mode nil)
+ (make-variable-buffer-local ',MODE-major-mode))
;; The actual global minor-mode
(define-minor-mode ,global-mode
;; Very short lines to avoid too long lines in the generated
@@ -455,13 +483,13 @@ Valid keywords and arguments are:
(while args
(let ((key (pop args))
(val (pop args)))
- (case key
- (:name (setq name val))
- (:dense (setq dense val))
- (:inherit (setq inherit val))
- (:suppress (setq suppress val))
- (:group)
- (t (message "Unknown argument %s in defmap" key)))))
+ (pcase key
+ (`:name (setq name val))
+ (`:dense (setq dense val))
+ (`:inherit (setq inherit val))
+ (`:suppress (setq suppress val))
+ (`:group)
+ (_ (message "Unknown argument %s in defmap" key)))))
(unless (keymapp m)
(setq bs (append m bs))
(setq m (if dense (make-keymap name) (make-sparse-keymap name))))
@@ -552,8 +580,6 @@ BODY is executed after moving to the destination location."
(when was-narrowed (,narrowfun)))))))
(unless name (setq name base-name))
`(progn
- (add-to-list 'debug-ignored-errors
- ,(concat "^No \\(previous\\|next\\) " (regexp-quote name)))
(defun ,next-sym (&optional count)
,(format "Go to the next COUNT'th %s." name)
(interactive "p")
@@ -564,7 +590,7 @@ BODY is executed after moving to the destination location."
`(if (not (re-search-forward ,re nil t count))
(if (looking-at ,re)
(goto-char (or ,(if endfun `(,endfun)) (point-max)))
- (error "No next %s" ,name))
+ (user-error "No next %s" ,name))
(goto-char (match-beginning 0))
(when (and (eq (current-buffer) (window-buffer (selected-window)))
(called-interactively-p 'interactive))
@@ -583,7 +609,7 @@ BODY is executed after moving to the destination location."
(if (< count 0) (,next-sym (- count))
,(funcall when-narrowed
`(unless (re-search-backward ,re nil t count)
- (error "No previous %s" ,name)))
+ (user-error "No previous %s" ,name)))
,@body))
(put ',prev-sym 'definition-name ',base))))
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 79573437146..26a1fce2309 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -1,6 +1,6 @@
;;; easymenu.el --- support the easymenu interface for defining a menu
-;; Copyright (C) 1994, 1996, 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1996, 1998-2012 Free Software Foundation, Inc.
;; Keywords: emulations
;; Author: Richard Stallman <rms@gnu.org>
@@ -29,8 +29,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(defvar easy-menu-precalculate-equivalent-keybindings nil
"Determine when equivalent key bindings are computed for easy-menu menus.
It can take some time to calculate the equivalent key bindings that are shown
@@ -46,111 +44,102 @@ menus, turn this variable off, otherwise it is probably better to keep it on.")
;;;###autoload
(defmacro easy-menu-define (symbol maps doc menu)
- "Define a menu bar submenu in maps MAPS, according to MENU.
-
-If SYMBOL is non-nil, store the menu keymap in the value of SYMBOL,
-and define SYMBOL as a function to pop up the menu, with DOC as its doc string.
-If SYMBOL is nil, just store the menu keymap into MAPS.
-
-The first element of MENU must be a string. It is the menu bar item name.
-It may be followed by the following keyword argument pairs
-
- :filter FUNCTION
+ "Define a pop-up menu and/or menu bar menu specified by MENU.
+If SYMBOL is non-nil, define SYMBOL as a function to pop up the
+submenu defined by MENU, with DOC as its doc string.
-FUNCTION is a function with one argument, the rest of menu items.
-It returns the remaining items of the displayed menu.
+MAPS, if non-nil, should be a keymap or a list of keymaps; add
+the submenu defined by MENU to the keymap or each of the keymaps,
+as a top-level menu bar item.
- :visible INCLUDE
+The first element of MENU must be a string. It is the menu bar
+item name. It may be followed by the following keyword argument
+pairs:
-INCLUDE is an expression; this menu is only visible if this
-expression has a non-nil value. `:included' is an alias for `:visible'.
+ :filter FUNCTION
+ FUNCTION must be a function which, if called with one
+ argument---the list of the other menu items---returns the
+ items to actually display.
- :active ENABLE
+ :visible INCLUDE
+ INCLUDE is an expression. The menu is visible if the
+ expression evaluates to a non-nil value. `:included' is an
+ alias for `:visible'.
-ENABLE is an expression; the menu is enabled for selection whenever
-this expression's value is non-nil. `:enable' is an alias for `:active'.
+ :active ENABLE
+ ENABLE is an expression. The menu is enabled for selection
+ if the expression evaluates to a non-nil value. `:enable' is
+ an alias for `:active'.
-The rest of the elements in MENU, are menu items.
+The rest of the elements in MENU are menu items.
+A menu item can be a vector of three elements:
-A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE]
+ [NAME CALLBACK ENABLE]
NAME is a string--the menu item name.
-CALLBACK is a command to run when the item is chosen,
-or a list to evaluate when the item is chosen.
+CALLBACK is a command to run when the item is chosen, or an
+expression to evaluate when the item is chosen.
-ENABLE is an expression; the item is enabled for selection
-whenever this expression's value is non-nil.
+ENABLE is an expression; the item is enabled for selection if the
+expression evaluates to a non-nil value.
Alternatively, a menu item may have the form:
- [ NAME CALLBACK [ KEYWORD ARG ] ... ]
-
-Where KEYWORD is one of the symbols defined below.
-
- :keys KEYS
-
-KEYS is a string; a complex keyboard equivalent to this menu item.
-This is normally not needed because keyboard equivalents are usually
-computed automatically.
-KEYS is expanded with `substitute-command-keys' before it is used.
-
- :key-sequence KEYS
-
-KEYS is nil, a string or a vector; nil or a keyboard equivalent to this
-menu item.
-This is a hint that will considerably speed up Emacs' first display of
-a menu. Use `:key-sequence nil' when you know that this menu item has no
-keyboard equivalent.
-
- :active ENABLE
-
-ENABLE is an expression; the item is enabled for selection whenever
-this expression's value is non-nil. `:enable' is an alias for `:active'.
-
- :visible INCLUDE
-
-INCLUDE is an expression; this item is only visible if this
-expression has a non-nil value. `:included' is an alias for `:visible'.
-
- :label FORM
+ [ NAME CALLBACK [ KEYWORD ARG ]... ]
-FORM is an expression that will be dynamically evaluated and whose
-value will be used for the menu entry's text label (the default is NAME).
+where NAME and CALLBACK have the same meanings as above, and each
+optional KEYWORD and ARG pair should be one of the following:
- :suffix FORM
+ :keys KEYS
+ KEYS is a string; a keyboard equivalent to the menu item.
+ This is normally not needed because keyboard equivalents are
+ usually computed automatically. KEYS is expanded with
+ `substitute-command-keys' before it is used.
-FORM is an expression that will be dynamically evaluated and whose
-value will be concatenated to the menu entry's label.
+ :key-sequence KEYS
+ KEYS is a hint for speeding up Emacs's first display of the
+ menu. It should be nil if you know that the menu item has no
+ keyboard equivalent; otherwise it should be a string or
+ vector specifying a keyboard equivalent for the menu item.
- :style STYLE
+ :active ENABLE
+ ENABLE is an expression; the item is enabled for selection
+ whenever this expression's value is non-nil. `:enable' is an
+ alias for `:active'.
-STYLE is a symbol describing the type of menu item. The following are
-defined:
+ :visible INCLUDE
+ INCLUDE is an expression; this item is only visible if this
+ expression has a non-nil value. `:included' is an alias for
+ `:visible'.
-toggle: A checkbox.
- Prepend the name with `(*) ' or `( ) ' depending on if selected or not.
-radio: A radio button.
- Prepend the name with `[X] ' or `[ ] ' depending on if selected or not.
-button: Surround the name with `[' and `]'. Use this for an item in the
- menu bar itself.
-anything else means an ordinary menu item.
+ :label FORM
+ FORM is an expression that is dynamically evaluated and whose
+ value serves as the menu item's label (the default is NAME).
- :selected SELECTED
+ :suffix FORM
+ FORM is an expression that is dynamically evaluated and whose
+ value is concatenated with the menu entry's label.
-SELECTED is an expression; the checkbox or radio button is selected
-whenever this expression's value is non-nil.
+ :style STYLE
+ STYLE is a symbol describing the type of menu item; it should
+ be `toggle' (a checkbox), or `radio' (a radio button), or any
+ other value (meaning an ordinary menu item).
- :help HELP
+ :selected SELECTED
+ SELECTED is an expression; the checkbox or radio button is
+ selected whenever the expression's value is non-nil.
-HELP is a string, the help to display for the menu item.
+ :help HELP
+ HELP is a string, the help to display for the menu item.
-A menu item can be a string. Then that string appears in the menu as
-unselectable text. A string consisting solely of hyphens is displayed
-as a solid horizontal line.
+Alternatively, a menu item can be a string. Then that string
+appears in the menu as unselectable text. A string consisting
+solely of dashes is displayed as a menu separator.
-A menu item can be a list with the same format as MENU. This is a submenu."
- (declare (indent defun))
+Alternatively, a menu item can be a list with the same format as
+MENU. This is a submenu."
+ (declare (indent defun) (debug (symbolp body)))
`(progn
,(if symbol `(defvar ,symbol nil ,doc))
(easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
@@ -236,14 +225,14 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
(keywordp (setq keyword (car menu-items))))
(setq arg (cadr menu-items))
(setq menu-items (cddr menu-items))
- (case keyword
- (:filter
+ (pcase keyword
+ (`:filter
(setq filter `(lambda (menu)
(easy-menu-filter-return (,arg menu) ,menu-name))))
- ((:enable :active) (setq enable (or arg ''nil)))
- (:label (setq label arg))
- (:help (setq help arg))
- ((:included :visible) (setq visible (or arg ''nil)))))
+ ((or `:enable `:active) (setq enable (or arg ''nil)))
+ (`:label (setq label arg))
+ (`:help (setq help arg))
+ ((or `:included `:visible) (setq visible (or arg ''nil)))))
(if (equal visible ''nil)
nil ; Invisible menu entry, return nil.
(if (and visible (not (easy-menu-always-true-p visible)))
@@ -334,16 +323,16 @@ ITEM defines an item as in `easy-menu-define'."
(setq keyword (aref item count))
(setq arg (aref item (1+ count)))
(setq count (+ 2 count))
- (case keyword
- ((:included :visible) (setq visible (or arg ''nil)))
- (:key-sequence (setq cache arg cache-specified t))
- (:keys (setq keys arg no-name nil))
- (:label (setq label arg))
- ((:active :enable) (setq active (or arg ''nil)))
- (:help (setq prop (cons :help (cons arg prop))))
- (:suffix (setq suffix arg))
- (:style (setq style arg))
- (:selected (setq selected (or arg ''nil)))))
+ (pcase keyword
+ ((or `:included `:visible) (setq visible (or arg ''nil)))
+ (`:key-sequence (setq cache arg cache-specified t))
+ (`:keys (setq keys arg no-name nil))
+ (`:label (setq label arg))
+ ((or `:active `:enable) (setq active (or arg ''nil)))
+ (`:help (setq prop (cons :help (cons arg prop))))
+ (`:suffix (setq suffix arg))
+ (`:style (setq style arg))
+ (`:selected (setq selected (or arg ''nil)))))
(if suffix
(setq label
(if (stringp suffix)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index d7cfcfb870a..12311711fe0 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1,6 +1,6 @@
-;;; edebug.el --- a source-level debugger for Emacs Lisp
+;;; edebug.el --- a source-level debugger for Emacs Lisp -*- lexical-binding: t -*-
-;; Copyright (C) 1988-1995, 1997, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988-1995, 1997, 1999-2012 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@holonexus.org>
;; Maintainer: FSF
@@ -51,9 +51,8 @@
;;; Code:
-;;; Bug reporting
-
-(defalias 'edebug-submit-bug-report 'report-emacs-bug)
+(require 'macroexp)
+(eval-when-compile (require 'cl-lib))
;;; Options
@@ -191,6 +190,7 @@ Use this with caution since it is not debugged."
(defcustom edebug-unwrap-results nil
"Non-nil if Edebug should unwrap results of expressions.
+That is, Edebug will try to remove its own instrumentation from the result.
This is useful when debugging macros where the results of expressions
are instrumented expressions. But don't do this when results might be
circular or an infinite loop will result."
@@ -232,21 +232,18 @@ If the result is non-nil, then break. Errors are ignored."
;;; Form spec utilities.
-(defmacro def-edebug-form-spec (symbol spec-form)
- "For compatibility with old version."
- (def-edebug-spec symbol (eval spec-form)))
-(make-obsolete 'def-edebug-form-spec 'def-edebug-spec "22.1")
-
(defun get-edebug-spec (symbol)
;; Get the spec of symbol resolving all indirection.
- (let ((edebug-form-spec (get symbol 'edebug-form-spec))
- indirect)
- (while (and (symbolp edebug-form-spec)
- (setq indirect (get edebug-form-spec 'edebug-form-spec)))
+ (let ((spec nil)
+ (indirect symbol))
+ (while
+ (progn
+ (and (symbolp indirect)
+ (setq indirect
+ (function-get indirect 'edebug-form-spec 'macro))))
;; (edebug-trace "indirection: %s" edebug-form-spec)
- (setq edebug-form-spec indirect))
- edebug-form-spec
- ))
+ (setq spec indirect))
+ spec))
;;;###autoload
(defun edebug-basic-spec (spec)
@@ -260,7 +257,7 @@ An extant spec symbol is a symbol that is not a function and has a
(setq spec (cdr spec)))
t))
((symbolp spec)
- (unless (functionp spec) (get spec 'edebug-form-spec)))))
+ (unless (functionp spec) (function-get spec 'edebug-form-spec)))))
;;; Utilities
@@ -336,9 +333,7 @@ A lambda list keyword is a symbol that starts with `&'."
(lambda (e1 e2)
(funcall function (car e1) (car e2))))))
-;;(def-edebug-spec edebug-save-restriction t)
-
-;; Not used. If it is used, def-edebug-spec must be defined before use.
+;; Not used.
'(defmacro edebug-save-restriction (&rest body)
"Evaluate BODY while saving the current buffers restriction.
BODY may change buffer outside of current restriction, unlike
@@ -346,6 +341,7 @@ save-restriction. BODY may change the current buffer,
and the restriction will be restored to the original buffer,
and the current buffer remains current.
Return the result of the last expression in BODY."
+ (declare (debug t))
`(let ((edebug:s-r-beg (point-min-marker))
(edebug:s-r-end (point-max-marker)))
(unwind-protect
@@ -363,6 +359,7 @@ Return the result of the last expression in BODY."
;; Select WINDOW if it is provided and still exists. Otherwise,
;; if buffer is currently shown in several windows, choose one.
;; Otherwise, find a new window, possibly splitting one.
+ ;; FIXME: We should probably just be using `pop-to-buffer'.
(setq window
(cond
((and (edebug-window-live-p window)
@@ -371,10 +368,10 @@ Return the result of the last expression in BODY."
((eq (window-buffer (selected-window)) buffer)
;; Selected window already displays BUFFER.
(selected-window))
- ((edebug-get-buffer-window buffer))
+ ((get-buffer-window buffer 0))
((one-window-p 'nomini)
;; When there's one window only, split it.
- (split-window))
+ (split-window (minibuffer-selected-window)))
((let ((trace-window (get-buffer-window edebug-trace-buffer)))
(catch 'found
(dolist (elt (window-list nil 'nomini))
@@ -385,13 +382,10 @@ Return the result of the last expression in BODY."
(throw 'found elt))))))
;; All windows are dedicated or show `edebug-trace-buffer', split
;; selected one.
- (t (split-window))))
- (select-window window)
+ (t (split-window (minibuffer-selected-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.
@@ -444,18 +438,14 @@ Return the result of the last expression in BODY."
window-info)
(set-window-configuration window-info)))
-(defalias 'edebug-get-buffer-window 'get-buffer-window)
-(defalias 'edebug-sit-for 'sit-for)
-(defalias 'edebug-input-pending-p 'input-pending-p)
-
-
;;; Redefine read and eval functions
;; read is redefined to maybe instrument forms.
;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
;; Save the original read function
-(or (fboundp 'edebug-original-read)
- (defalias 'edebug-original-read (symbol-function 'read)))
+(defalias 'edebug-original-read
+ (symbol-function (if (fboundp 'edebug-original-read)
+ 'edebug-original-read 'read)))
(defun edebug-read (&optional stream)
"Read one Lisp expression as text from STREAM, return as Lisp object.
@@ -526,6 +516,7 @@ the minibuffer."
(setq face-new-frame-defaults
(assq-delete-all (nth 1 form) face-new-frame-defaults))
(put (nth 1 form) 'face-defface-spec nil)
+ (put (nth 1 form) 'face-documentation (nth 3 form))
;; See comments in `eval-defun-1' for purpose of code below
(setq form (prog1 `(prog1 ,form
(put ',(nth 1 form) 'saved-face
@@ -619,36 +610,29 @@ already is one.)"
;; The internal data that is needed for edebugging is kept in the
;; buffer-local variable `edebug-form-data'.
-(make-variable-buffer-local 'edebug-form-data)
-
-(defvar edebug-form-data nil)
-;; A list of entries associating symbols with buffer regions.
-;; This is an automatic buffer local variable. Each entry looks like:
-;; @code{(@var{symbol} @var{begin-marker} @var{end-marker}). The markers
-;; are at the beginning and end of an entry level form and @var{symbol} is
-;; a symbol that holds all edebug related information for the form on its
-;; property list.
-
-;; In the future, the symbol will be irrelevant and edebug data will
-;; be stored in the definitions themselves rather than in the property
-;; list of a symbol.
-
-(defun edebug-make-form-data-entry (symbol begin end)
- (list symbol begin end))
-
-(defsubst edebug-form-data-name (entry)
- (car entry))
-
-(defsubst edebug-form-data-begin (entry)
- (nth 1 entry))
-
-(defsubst edebug-form-data-end (entry)
- (nth 2 entry))
+(defvar-local edebug-form-data nil
+ "A list of entries associating symbols with buffer regions.
+Each entry is an `edebug--form-data' struct with fields:
+SYMBOL, BEGIN-MARKER, and END-MARKER. The markers
+are at the beginning and end of an entry level form and SYMBOL is
+a symbol that holds all edebug related information for the form on its
+property list.
+
+In the future (haha!), the symbol will be irrelevant and edebug data will
+be stored in the definitions themselves rather than in the property
+list of a symbol.")
+
+(cl-defstruct (edebug--form-data
+ ;; Some callers expect accessors to return nil when passed nil.
+ (:type list)
+ (:constructor edebug--make-form-data-entry (name begin end))
+ (:predicate nil) (:constructor nil) (:copier nil))
+ name begin end)
(defsubst edebug-set-form-data-entry (entry name begin end)
- (setcar entry name);; in case name is changed
- (set-marker (nth 1 entry) begin)
- (set-marker (nth 2 entry) end))
+ (setf (edebug--form-data-name entry) name) ;; In case name is changed.
+ (set-marker (edebug--form-data-begin entry) begin)
+ (set-marker (edebug--form-data-end entry) end))
(defun edebug-get-form-data-entry (pnt &optional end-point)
;; Find the edebug form data entry which is closest to PNT.
@@ -656,17 +640,17 @@ already is one.)"
;; Return `nil' if none found.
(let ((rest edebug-form-data)
closest-entry
- (closest-dist 999999)) ;; need maxint here
+ (closest-dist 999999)) ;; Need maxint here.
(while (and rest (< 0 closest-dist))
(let* ((entry (car rest))
- (begin (edebug-form-data-begin entry))
+ (begin (edebug--form-data-begin entry))
(dist (- pnt begin)))
(setq rest (cdr rest))
(if (and (<= 0 dist)
(< dist closest-dist)
(or (not end-point)
- (= end-point (edebug-form-data-end entry)))
- (<= pnt (edebug-form-data-end entry)))
+ (= end-point (edebug--form-data-end entry)))
+ (<= pnt (edebug--form-data-end entry)))
(setq closest-dist dist
closest-entry entry))))
closest-entry))
@@ -675,19 +659,19 @@ already is one.)"
;; and find an entry given a symbol, which should be just assq.
(defun edebug-form-data-symbol ()
-;; Return the edebug data symbol of the form where point is in.
-;; If point is not inside a edebuggable form, cause error.
- (or (edebug-form-data-name (edebug-get-form-data-entry (point)))
+ "Return the edebug data symbol of the form where point is in.
+If point is not inside a edebuggable form, cause error."
+ (or (edebug--form-data-name (edebug-get-form-data-entry (point)))
(error "Not inside instrumented form")))
(defun edebug-make-top-form-data-entry (new-entry)
;; Make NEW-ENTRY the first element in the `edebug-form-data' list.
(edebug-clear-form-data-entry new-entry)
- (setq edebug-form-data (cons new-entry edebug-form-data)))
+ (push new-entry edebug-form-data))
(defun edebug-clear-form-data-entry (entry)
-;; If non-nil, clear ENTRY out of the form data.
-;; Maybe clear the markers and delete the symbol's edebug property?
+ "If non-nil, clear ENTRY out of the form data.
+Maybe clear the markers and delete the symbol's edebug property?"
(if entry
(progn
;; Instead of this, we could just find all contained forms.
@@ -915,8 +899,7 @@ already is one.)"
(cond ((eq ?\' (following-char))
(forward-char 1)
(list
- (edebug-storing-offsets (- (point) 2)
- (if (featurep 'cl) 'function* 'function))
+ (edebug-storing-offsets (- (point) 2) 'function)
(edebug-read-storing-offsets stream)))
((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6
?7 ?8 ?9 ?0))
@@ -1080,7 +1063,8 @@ already is one.)"
;; If it gets an error, make it nil.
(let ((temp-hook edebug-setup-hook))
(setq edebug-setup-hook nil)
- (run-hooks 'temp-hook))
+ (if (functionp temp-hook) (funcall temp-hook)
+ (mapc #'funcall temp-hook)))
(let (result
edebug-top-window-data
@@ -1217,8 +1201,8 @@ already is one.)"
(defvar edebug-offset-list) ; the list of offset positions.
(defun edebug-inc-offset (offset)
- ;; modifies edebug-offset-index and edebug-offset-list
- ;; accesses edebug-func-marc and buffer point
+ ;; Modifies edebug-offset-index and edebug-offset-list
+ ;; accesses edebug-func-marc and buffer point.
(prog1
edebug-offset-index
(setq edebug-offset-list (cons (- offset edebug-form-begin-marker)
@@ -1231,13 +1215,11 @@ already is one.)"
;; given FORM. Looks like:
;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM)
;; Also increment the offset index for subsequent use.
- (list 'edebug-after
- (list 'edebug-before before-index)
- after-index form))
+ `(edebug-after (edebug-before ,before-index) ,after-index ,form))
(defun edebug-make-after-form (form after-index)
;; Like edebug-make-before-and-after-form, but only after.
- (list 'edebug-after 0 after-index form))
+ `(edebug-after 0 ,after-index ,form))
(defun edebug-unwrap (sexp)
@@ -1249,10 +1231,7 @@ expressions; a `progn' form will be returned enclosing these forms."
((eq 'edebug-after (car sexp))
(nth 3 sexp))
((eq 'edebug-enter (car sexp))
- (let ((forms (nthcdr 2 (nth 1 (nth 3 sexp)))))
- (if (> (length forms) 1)
- (cons 'progn forms) ;; could return (values forms) instead.
- (car forms))))
+ (macroexp-progn (nthcdr 2 (nth 1 (nth 3 sexp)))))
(t sexp);; otherwise it is not wrapped, so just return it.
)
sexp))
@@ -1290,7 +1269,7 @@ expressions; a `progn' form will be returned enclosing these forms."
;; Set this marker before parsing.
(edebug-form-begin-marker
(if form-data-entry
- (edebug-form-data-begin form-data-entry)
+ (edebug--form-data-begin form-data-entry)
;; Buffer must be current-buffer for this to work:
(set-marker (make-marker) form-begin))))
@@ -1300,7 +1279,7 @@ expressions; a `progn' form will be returned enclosing these forms."
;; For definitions.
;; (edebug-containing-def-name edebug-def-name)
;; Get name from form-data, if any.
- (edebug-old-def-name (edebug-form-data-name form-data-entry))
+ (edebug-old-def-name (edebug--form-data-name form-data-entry))
edebug-def-name
edebug-def-args
edebug-def-interactive
@@ -1330,7 +1309,7 @@ expressions; a `progn' form will be returned enclosing these forms."
;; In the latter case, pointers to the entry remain eq.
(if (not form-data-entry)
(setq form-data-entry
- (edebug-make-form-data-entry
+ (edebug--make-form-data-entry
edebug-def-name
edebug-form-begin-marker
;; Buffer must be current-buffer.
@@ -1516,18 +1495,18 @@ expressions; a `progn' form will be returned enclosing these forms."
;; Otherwise it signals an error. The place of the error is found
;; with the two before- and after-offset functions.
-(defun edebug-no-match (cursor &rest edebug-args)
+(defun edebug-no-match (cursor &rest args)
;; Throw a no-match, or signal an error immediately if gate is active.
;; Remember this point in case we need to report this error.
(setq edebug-error-point (or edebug-error-point
(edebug-before-offset cursor))
- edebug-best-error (or edebug-best-error edebug-args))
+ edebug-best-error (or edebug-best-error args))
(if (and edebug-gate (not edebug-&optional))
(progn
(if edebug-error-point
(goto-char edebug-error-point))
- (apply 'edebug-syntax-error edebug-args))
- (funcall 'throw 'no-match edebug-args)))
+ (apply 'edebug-syntax-error args))
+ (throw 'no-match args)))
(defun edebug-match (cursor specs)
@@ -1754,7 +1733,7 @@ expressions; a `progn' form will be returned enclosing these forms."
specs))))
-(defun edebug-match-gate (cursor)
+(defun edebug-match-gate (_cursor)
;; Simply set the gate to prevent backtracking at this level.
(setq edebug-gate t)
nil)
@@ -1843,7 +1822,7 @@ expressions; a `progn' form will be returned enclosing these forms."
nil))
-(defun edebug-match-function (cursor)
+(defun edebug-match-function (_cursor)
(error "Use function-form instead of function in edebug spec"))
(defun edebug-match-&define (cursor specs)
@@ -1900,7 +1879,7 @@ expressions; a `progn' form will be returned enclosing these forms."
(edebug-move-cursor cursor)
(list name)))
-(defun edebug-match-colon-name (cursor spec)
+(defun edebug-match-colon-name (_cursor spec)
;; Set the edebug-def-name to the spec.
(setq edebug-def-name
(if edebug-def-name
@@ -1937,7 +1916,6 @@ expressions; a `progn' form will be returned enclosing these forms."
;;;; Edebug Form Specs
;;; ==========================================================
-;;; See cl-specs.el for common lisp specs.
;;;;* Spec for def-edebug-spec
;;; Out of date.
@@ -1986,6 +1964,8 @@ expressions; a `progn' form will be returned enclosing these forms."
def-body))
;; FIXME? Isn't this missing the doc-string? Cf defun.
(def-edebug-spec defmacro
+ ;; FIXME: Improve `declare' so we can Edebug gv-expander and
+ ;; gv-setter declarations.
(&define name lambda-list [&optional ("declare" &rest sexp)] def-body))
(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list.
@@ -2010,25 +1990,17 @@ expressions; a `progn' form will be returned enclosing these forms."
;; A macro is allowed by Emacs.
(def-edebug-spec function (&or symbolp lambda-expr))
-;; lambda is a macro in emacs 19.
-(def-edebug-spec lambda (&define lambda-list
- [&optional stringp]
- [&optional ("interactive" interactive)]
- def-body))
-
;; A macro expression is a lambda expression with "macro" prepended.
(def-edebug-spec macro (&define "lambda" lambda-list def-body))
;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro])))
;; Standard functions that take function-forms arguments.
-(def-edebug-spec mapcar (function-form form))
-(def-edebug-spec mapconcat (function-form form form))
-(def-edebug-spec mapatoms (function-form &optional form))
-(def-edebug-spec apply (function-form &rest form))
-(def-edebug-spec funcall (function-form &rest form))
-;; FIXME? The manual has a gate here.
+;; FIXME? The manual uses this form (maybe that's just for illustration?):
+;; (def-edebug-spec let
+;; ((&rest &or symbolp (gate symbolp &optional form))
+;; body))
(def-edebug-spec let
((&rest &or (symbolp &optional form) symbolp)
body))
@@ -2089,49 +2061,12 @@ expressions; a `progn' form will be returned enclosing these forms."
&or ("quote" edebug-\`) def-form))
;; New byte compiler.
-(def-edebug-spec defsubst defun)
-(def-edebug-spec dont-compile t)
-(def-edebug-spec eval-when-compile t)
-(def-edebug-spec eval-and-compile t)
(def-edebug-spec save-selected-window t)
(def-edebug-spec save-current-buffer t)
-(def-edebug-spec delay-mode-hooks t)
-(def-edebug-spec with-temp-file t)
-(def-edebug-spec with-temp-message t)
-(def-edebug-spec with-syntax-table t)
-(def-edebug-spec push (form sexp))
-(def-edebug-spec pop (sexp))
-
-(def-edebug-spec 1value (form))
-(def-edebug-spec noreturn (form))
-
;; Anything else?
-
-;; Some miscellaneous specs for macros in public packages.
-;; Send me yours.
-
-;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu)
-
-(def-edebug-spec ad-dolist ((symbolp form &optional form) body))
-(def-edebug-spec defadvice
- (&define name ;; thing being advised.
- (name ;; class is [&or "before" "around" "after"
- ;; "activation" "deactivation"]
- name ;; name of advice
- &rest sexp ;; optional position and flags
- )
- [&optional stringp]
- [&optional ("interactive" interactive)]
- def-body))
-
-(def-edebug-spec easy-menu-define (symbolp body))
-
-(def-edebug-spec with-custom-print body)
-
-
;;; The debugger itself
(defvar edebug-active nil) ;; Non-nil when edebug is active
@@ -2168,10 +2103,7 @@ expressions; a `progn' form will be returned enclosing these forms."
;; Dynamically bound variables, declared globally but left unbound.
(defvar edebug-function) ; the function being executed. change name!!
-(defvar edebug-args) ; the arguments of the function
(defvar edebug-data) ; the edebug data for the function
-(defvar edebug-value) ; the result of the expression
-(defvar edebug-after-index)
(defvar edebug-def-mark) ; the mark for the definition
(defvar edebug-freq-count) ; the count of expression visits.
(defvar edebug-coverage) ; the coverage results of each expression of function.
@@ -2187,8 +2119,6 @@ expressions; a `progn' form will be returned enclosing these forms."
(defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside
(defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside
-(defvar edebug-outside-overriding-local-map)
-(defvar edebug-outside-overriding-terminal-local-map)
(defvar edebug-outside-pre-command-hook)
(defvar edebug-outside-post-command-hook)
@@ -2197,7 +2127,7 @@ expressions; a `progn' form will be returned enclosing these forms."
;;; Handling signals
-(defun edebug-signal (edebug-signal-name edebug-signal-data)
+(defun edebug-signal (signal-name signal-data)
"Signal an error. Args are SIGNAL-NAME, and associated DATA.
A signal name is a symbol with an `error-conditions' property
that is a list of condition names.
@@ -2211,19 +2141,18 @@ See `condition-case'.
This is the Edebug replacement for the standard `signal'. It should
only be active while Edebug is. It checks `debug-on-error' to see
whether it should call the debugger. When execution is resumed, the
-error is signaled again.
-\n(fn SIGNAL-NAME DATA)"
- (if (and (listp debug-on-error) (memq edebug-signal-name debug-on-error))
- (edebug 'error (cons edebug-signal-name edebug-signal-data)))
+error is signaled again."
+ (if (and (listp debug-on-error) (memq signal-name debug-on-error))
+ (edebug 'error (cons signal-name signal-data)))
;; If we reach here without another non-local exit, then send signal again.
;; i.e. the signal is not continuable, yet.
;; Avoid infinite recursion.
(let ((signal-hook-function nil))
- (signal edebug-signal-name edebug-signal-data)))
+ (signal signal-name signal-data)))
;;; Entering Edebug
-(defun edebug-enter (edebug-function edebug-args edebug-body)
+(defun edebug-enter (function args body)
;; Entering FUNC. The arguments are ARGS, and the body is BODY.
;; Setup edebug variables and evaluate BODY. This function is called
;; when a function evaluated with edebug-eval-top-level-form is entered.
@@ -2232,83 +2161,51 @@ error is signaled again.
;; Is this the first time we are entering edebug since
;; lower-level recursive-edit command?
;; More precisely, this tests whether Edebug is currently active.
- (if (not edebug-entered)
- (let ((edebug-entered t)
- ;; Binding max-lisp-eval-depth here is OK,
- ;; but not inside an unwind-protect.
- ;; Doing it here also keeps it from growing too large.
- (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
- (max-specpdl-size (+ 200 max-specpdl-size))
-
- (debugger edebug-debugger) ; only while edebug is active.
- (edebug-outside-debug-on-error debug-on-error)
- (edebug-outside-debug-on-quit debug-on-quit)
- ;; Binding these may not be the right thing to do.
- ;; We want to allow the global values to be changed.
- (debug-on-error (or debug-on-error edebug-on-error))
- (debug-on-quit edebug-on-quit)
-
- ;; Lexical bindings must be uncompiled for this to work.
- (cl-lexical-debug t)
-
- (edebug-outside-overriding-local-map overriding-local-map)
- (edebug-outside-overriding-terminal-local-map
- overriding-terminal-local-map)
-
- ;; Save the outside value of executing macro. (here??)
- (edebug-outside-executing-macro executing-kbd-macro)
- (edebug-outside-pre-command-hook
- (edebug-var-status 'pre-command-hook))
- (edebug-outside-post-command-hook
- (edebug-var-status 'post-command-hook)))
- (unwind-protect
- (let (;; Don't keep reading from an executing kbd macro
- ;; within edebug unless edebug-continue-kbd-macro is
- ;; non-nil. Again, local binding may not be best.
- (executing-kbd-macro
- (if edebug-continue-kbd-macro executing-kbd-macro))
-
- ;; Don't get confused by the user's keymap changes.
- (overriding-local-map nil)
- (overriding-terminal-local-map nil)
-
- (signal-hook-function 'edebug-signal)
-
- ;; Disable command hooks. This is essential when
- ;; a hook function is instrumented - to avoid infinite loop.
- ;; This may be more than we need, however.
- (pre-command-hook nil)
- (post-command-hook nil))
- (setq edebug-execution-mode (or edebug-next-execution-mode
- edebug-initial-mode
- edebug-execution-mode)
- edebug-next-execution-mode nil)
- (edebug-enter edebug-function edebug-args edebug-body))
- ;; Reset global variables in case outside value was changed.
- (setq executing-kbd-macro edebug-outside-executing-macro)
- (edebug-restore-status
- 'post-command-hook edebug-outside-post-command-hook)
- (edebug-restore-status
- 'pre-command-hook edebug-outside-pre-command-hook)))
-
- (let* ((edebug-data (get edebug-function 'edebug))
- (edebug-def-mark (car edebug-data)) ; mark at def start
- (edebug-freq-count (get edebug-function 'edebug-freq-count))
- (edebug-coverage (get edebug-function 'edebug-coverage))
- (edebug-buffer (marker-buffer edebug-def-mark))
-
- (edebug-stack (cons edebug-function edebug-stack))
- (edebug-offset-indices (cons 0 edebug-offset-indices))
- )
- (if (get edebug-function 'edebug-on-entry)
- (progn
- (setq edebug-execution-mode 'step)
- (if (eq (get edebug-function 'edebug-on-entry) 'temp)
- (put edebug-function 'edebug-on-entry nil))))
- (if edebug-trace
- (edebug-enter-trace edebug-body)
- (funcall edebug-body))
- )))
+ (let ((edebug-function function))
+ (if (not edebug-entered)
+ (let ((edebug-entered t)
+ ;; Binding max-lisp-eval-depth here is OK,
+ ;; but not inside an unwind-protect.
+ ;; Doing it here also keeps it from growing too large.
+ (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
+ (max-specpdl-size (+ 200 max-specpdl-size))
+
+ (debugger edebug-debugger) ; only while edebug is active.
+ (edebug-outside-debug-on-error debug-on-error)
+ (edebug-outside-debug-on-quit debug-on-quit)
+ ;; Binding these may not be the right thing to do.
+ ;; We want to allow the global values to be changed.
+ (debug-on-error (or debug-on-error edebug-on-error))
+ (debug-on-quit edebug-on-quit)
+
+ ;; Lexical bindings must be uncompiled for this to work.
+ (cl-lexical-debug t))
+ (unwind-protect
+ (let ((signal-hook-function 'edebug-signal))
+ (setq edebug-execution-mode (or edebug-next-execution-mode
+ edebug-initial-mode
+ edebug-execution-mode)
+ edebug-next-execution-mode nil)
+ (edebug-enter function args body))))
+
+ (let* ((edebug-data (get function 'edebug))
+ (edebug-def-mark (car edebug-data)) ; mark at def start
+ (edebug-freq-count (get function 'edebug-freq-count))
+ (edebug-coverage (get function 'edebug-coverage))
+ (edebug-buffer (marker-buffer edebug-def-mark))
+
+ (edebug-stack (cons function edebug-stack))
+ (edebug-offset-indices (cons 0 edebug-offset-indices))
+ )
+ (if (get function 'edebug-on-entry)
+ (progn
+ (setq edebug-execution-mode 'step)
+ (if (eq (get function 'edebug-on-entry) 'temp)
+ (put function 'edebug-on-entry nil))))
+ (if edebug-trace
+ (edebug--enter-trace function args body)
+ (funcall body))
+ ))))
(defun edebug-var-status (var)
"Return a cons cell describing the status of VAR's current binding.
@@ -2335,14 +2232,14 @@ STATUS should be a list returned by `edebug-var-status'."
(t
(set var value)))))
-(defun edebug-enter-trace (edebug-body)
+(defun edebug--enter-trace (function args body)
(let ((edebug-stack-depth (1+ edebug-stack-depth))
edebug-result)
(edebug-print-trace-before
- (format "%s args: %s" edebug-function edebug-args))
- (prog1 (setq edebug-result (funcall edebug-body))
+ (format "%s args: %s" function args))
+ (prog1 (setq edebug-result (funcall body))
(edebug-print-trace-after
- (format "%s result: %s" edebug-function edebug-result)))))
+ (format "%s result: %s" function edebug-result)))))
(def-edebug-spec edebug-tracing (form body))
@@ -2370,49 +2267,49 @@ MSG is printed after `::::} '."
-(defun edebug-slow-before (edebug-before-index)
+(defun edebug-slow-before (before-index)
(unless edebug-active
;; Debug current function given BEFORE position.
;; Called from functions compiled with edebug-eval-top-level-form.
;; Return the before index.
- (setcar edebug-offset-indices edebug-before-index)
+ (setcar edebug-offset-indices before-index)
;; Increment frequency count
- (aset edebug-freq-count edebug-before-index
- (1+ (aref edebug-freq-count edebug-before-index)))
+ (aset edebug-freq-count before-index
+ (1+ (aref edebug-freq-count before-index)))
(if (or (not (memq edebug-execution-mode '(Go-nonstop next)))
- (edebug-input-pending-p))
- (edebug-debugger edebug-before-index 'before nil)))
- edebug-before-index)
+ (input-pending-p))
+ (edebug-debugger before-index 'before nil)))
+ before-index)
-(defun edebug-fast-before (edebug-before-index)
+(defun edebug-fast-before (_before-index)
;; Do nothing.
)
-(defun edebug-slow-after (edebug-before-index edebug-after-index edebug-value)
+(defun edebug-slow-after (_before-index after-index value)
(if edebug-active
- edebug-value
+ value
;; Debug current function given AFTER position and VALUE.
;; Called from functions compiled with edebug-eval-top-level-form.
;; Return VALUE.
- (setcar edebug-offset-indices edebug-after-index)
+ (setcar edebug-offset-indices after-index)
;; Increment frequency count
- (aset edebug-freq-count edebug-after-index
- (1+ (aref edebug-freq-count edebug-after-index)))
- (if edebug-test-coverage (edebug-update-coverage))
+ (aset edebug-freq-count after-index
+ (1+ (aref edebug-freq-count after-index)))
+ (if edebug-test-coverage (edebug--update-coverage after-index value))
(if (and (eq edebug-execution-mode 'Go-nonstop)
- (not (edebug-input-pending-p)))
+ (not (input-pending-p)))
;; Just return result.
- edebug-value
- (edebug-debugger edebug-after-index 'after edebug-value)
+ value
+ (edebug-debugger after-index 'after value)
)))
-(defun edebug-fast-after (edebug-before-index edebug-after-index edebug-value)
+(defun edebug-fast-after (_before-index _after-index value)
;; Do nothing but return the value.
- edebug-value)
+ value)
(defun edebug-run-slow ()
(defalias 'edebug-before 'edebug-slow-before)
@@ -2426,19 +2323,18 @@ MSG is printed after `::::} '."
(edebug-run-slow)
-(defun edebug-update-coverage ()
- (let ((old-result (aref edebug-coverage edebug-after-index)))
+(defun edebug--update-coverage (after-index value)
+ (let ((old-result (aref edebug-coverage after-index)))
(cond
((eq 'ok-coverage old-result))
((eq 'unknown old-result)
- (aset edebug-coverage edebug-after-index edebug-value))
+ (aset edebug-coverage after-index value))
;; Test if a different result.
- ((not (eq edebug-value old-result))
- (aset edebug-coverage edebug-after-index 'ok-coverage)))))
+ ((not (eq value old-result))
+ (aset edebug-coverage after-index 'ok-coverage)))))
;; Dynamically declared unbound variables.
-(defvar edebug-arg-mode) ; the mode, either before, after, or error
(defvar edebug-breakpoints)
(defvar edebug-break-data) ; break data for current function.
(defvar edebug-break) ; whether a break occurred.
@@ -2449,16 +2345,16 @@ MSG is printed after `::::} '."
(defvar edebug-global-break-result nil)
-(defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-value)
+(defun edebug-debugger (offset-index arg-mode value)
(if inhibit-redisplay
;; Don't really try to enter edebug within an eval from redisplay.
- edebug-value
+ value
;; Check breakpoints and pending input.
- ;; If edebug display should be updated, call edebug-display.
- ;; Return edebug-value.
+ ;; If edebug display should be updated, call edebug--display.
+ ;; Return value.
(let* ( ;; This needs to be here since breakpoints may be changed.
(edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints
- (edebug-break-data (assq edebug-offset-index edebug-breakpoints))
+ (edebug-break-data (assq offset-index edebug-breakpoints))
(edebug-break-condition (car (cdr edebug-break-data)))
(edebug-global-break
(if edebug-global-break-condition
@@ -2469,7 +2365,7 @@ MSG is printed after `::::} '."
(error nil))))
(edebug-break))
-;;; (edebug-trace "exp: %s" edebug-value)
+ ;;(edebug-trace "exp: %s" value)
;; Test whether we should break.
(setq edebug-break
(or edebug-global-break
@@ -2489,11 +2385,10 @@ MSG is printed after `::::} '."
;; or break, or input is pending,
(if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))
edebug-break
- (edebug-input-pending-p))
- (edebug-display)) ; <--------------- display
+ (input-pending-p))
+ (edebug--display value offset-index arg-mode)) ; <---------- display
- edebug-value
- )))
+ value)))
;; window-start now stored with each function.
@@ -2525,8 +2420,9 @@ MSG is printed after `::::} '."
;; Emacs 19 adds an arg to mark and mark-marker.
(defalias 'edebug-mark-marker 'mark-marker)
+(defvar edebug-outside-unread-command-events)
-(defun edebug-display ()
+(defun edebug--display (value offset-index arg-mode)
(unless (marker-position edebug-def-mark)
;; The buffer holding the source has been killed.
;; Let's at least show a backtrace so the user can figure out
@@ -2535,11 +2431,11 @@ MSG is printed after `::::} '."
;; Setup windows for edebug, determine mode, maybe enter recursive-edit.
;; Uses local variables of edebug-enter, edebug-before, edebug-after
;; and edebug-debugger.
- (let ((edebug-active t) ; for minor mode alist
+ (let ((edebug-active t) ; For minor mode alist.
(edebug-with-timeout-suspend (with-timeout-suspend))
- edebug-stop ; should we enter recursive-edit
+ edebug-stop ; Should we enter recursive-edit?
(edebug-point (+ edebug-def-mark
- (aref (nth 2 edebug-data) edebug-offset-index)))
+ (aref (nth 2 edebug-data) offset-index)))
edebug-buffer-outside-point ; current point in edebug-buffer
;; window displaying edebug-buffer
(edebug-window-data (nth 3 edebug-data))
@@ -2548,12 +2444,12 @@ MSG is printed after `::::} '."
(edebug-outside-point (point))
(edebug-outside-mark (edebug-mark))
(edebug-outside-unread-command-events unread-command-events)
- edebug-outside-windows ; window or screen configuration
+ edebug-outside-windows ; Window or screen configuration.
edebug-buffer-points
- edebug-eval-buffer ; declared here so we can kill it below
- (edebug-eval-result-list (and edebug-eval-list
- (edebug-eval-result-list)))
+ edebug-eval-buffer ; Declared here so we can kill it below.
+ (eval-result-list (and edebug-eval-list
+ (edebug-eval-result-list)))
edebug-trace-window
edebug-trace-window-start
@@ -2566,7 +2462,7 @@ MSG is printed after `::::} '."
(let ((overlay-arrow-position overlay-arrow-position)
(overlay-arrow-string overlay-arrow-string)
(cursor-in-echo-area nil)
- (unread-command-events unread-command-events)
+ (unread-command-events nil)
;; any others??
)
(setq-default cursor-in-non-selected-windows t)
@@ -2574,9 +2470,9 @@ MSG is printed after `::::} '."
(let ((debug-on-error nil))
(error "Buffer defining %s not found" edebug-function)))
- (if (eq 'after edebug-arg-mode)
+ (if (eq 'after arg-mode)
;; Compute result string now before windows are modified.
- (edebug-compute-previous-result edebug-value))
+ (edebug-compute-previous-result value))
(if edebug-save-windows
;; Save windows now before we modify them.
@@ -2600,7 +2496,7 @@ MSG is printed after `::::} '."
;; Now display eval list, if any.
;; This is done after the pop to edebug-buffer
;; so that buffer-window correspondence is correct after quitting.
- (edebug-eval-display edebug-eval-result-list)
+ (edebug-eval-display eval-result-list)
;; The evaluation list better not have deleted edebug-window-data.
(select-window (car edebug-window-data))
(set-buffer edebug-buffer)
@@ -2608,7 +2504,7 @@ MSG is printed after `::::} '."
(setq edebug-buffer-outside-point (point))
(goto-char edebug-point)
- (if (eq 'before edebug-arg-mode)
+ (if (eq 'before arg-mode)
;; Check whether positions are up-to-date.
;; This assumes point is never before symbol.
(if (not (memq (following-char) '(?\( ?\# ?\` )))
@@ -2621,7 +2517,7 @@ MSG is printed after `::::} '."
(edebug-adjust-window (cdr edebug-window-data)))
;; Test if there is input, not including keyboard macros.
- (if (edebug-input-pending-p)
+ (if (input-pending-p)
(progn
(setq edebug-execution-mode 'step
edebug-stop t)
@@ -2632,14 +2528,14 @@ MSG is printed after `::::} '."
(edebug-overlay-arrow)
(cond
- ((eq 'error edebug-arg-mode)
+ ((eq 'error arg-mode)
;; Display error message
(setq edebug-execution-mode 'step)
(edebug-overlay-arrow)
(beep)
- (if (eq 'quit (car edebug-value))
+ (if (eq 'quit (car value))
(message "Quit")
- (edebug-report-error edebug-value)))
+ (edebug-report-error value)))
(edebug-break
(cond
(edebug-global-break
@@ -2656,41 +2552,40 @@ MSG is printed after `::::} '."
(t (message "")))
- (setq unread-command-events nil)
- (if (eq 'after edebug-arg-mode)
+ (if (eq 'after arg-mode)
(progn
;; Display result of previous evaluation.
(if (and edebug-break
(not (eq edebug-execution-mode 'Continue-fast)))
- (edebug-sit-for edebug-sit-for-seconds)) ; Show message.
+ (sit-for edebug-sit-for-seconds)) ; Show message.
(edebug-previous-result)))
(cond
(edebug-break
(cond
((eq edebug-execution-mode 'continue)
- (edebug-sit-for edebug-sit-for-seconds))
- ((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0))
+ (sit-for edebug-sit-for-seconds))
+ ((eq edebug-execution-mode 'Continue-fast) (sit-for 0))
(t (setq edebug-stop t))))
;; not edebug-break
((eq edebug-execution-mode 'trace)
- (edebug-sit-for edebug-sit-for-seconds)) ; Force update and pause.
+ (sit-for edebug-sit-for-seconds)) ; Force update and pause.
((eq edebug-execution-mode 'Trace-fast)
- (edebug-sit-for 0))) ; Force update and continue.
+ (sit-for 0))) ; Force update and continue.
(unwind-protect
(if (or edebug-stop
(memq edebug-execution-mode '(step next))
- (eq edebug-arg-mode 'error))
+ (eq arg-mode 'error))
(progn
;; (setq edebug-execution-mode 'step)
;; (edebug-overlay-arrow) ; This doesn't always show up.
- (edebug-recursive-edit))) ; <---------- Recursive edit
+ (edebug--recursive-edit arg-mode))) ; <----- Recursive edit
;; Reset the edebug-window-data to whatever it is now.
(let ((window (if (eq (window-buffer) edebug-buffer)
(selected-window)
- (edebug-get-buffer-window edebug-buffer))))
+ (get-buffer-window edebug-buffer))))
;; Remember window-start for edebug-buffer, if still displayed.
(if window
(progn
@@ -2768,6 +2663,8 @@ MSG is printed after `::::} '."
(goto-char edebug-buffer-outside-point))
;; ... nothing more.
)
+ ;; Could be an option to keep eval display up.
+ (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
(with-timeout-unsuspend edebug-with-timeout-suspend)
;; Reset global variables to outside values in case they were changed.
(setq
@@ -2805,26 +2702,15 @@ MSG is printed after `::::} '."
;; in versions where the variable is *not* built-in.
;; Emacs 18 FIXME
-(defvar edebug-outside-unread-command-char)
;; Emacs 19.
(defvar edebug-outside-last-command-event)
-(defvar edebug-outside-unread-command-events)
(defvar edebug-outside-last-input-event)
(defvar edebug-outside-last-event-frame)
(defvar edebug-outside-last-nonmenu-event)
(defvar edebug-outside-track-mouse)
-;; Disable byte compiler warnings about unread-command-char and -event
-;; (maybe works with byte-compile-version 2.22 at least)
-(defvar edebug-unread-command-char-warning)
-(defvar edebug-unread-command-event-warning)
-(eval-when-compile ; FIXME
- (setq edebug-unread-command-char-warning
- (get 'unread-command-char 'byte-obsolete-variable))
- (put 'unread-command-char 'byte-obsolete-variable nil))
-
-(defun edebug-recursive-edit ()
+(defun edebug--recursive-edit (arg-mode)
;; Start up a recursive edit inside of edebug.
;; The current buffer is the edebug-buffer, which is put into edebug-mode.
;; Assume that none of the variables below are buffer-local.
@@ -2845,14 +2731,20 @@ MSG is printed after `::::} '."
(edebug-outside-map (current-local-map))
- (edebug-outside-standard-output standard-output)
+ ;; Save the outside value of executing macro. (here??)
+ (edebug-outside-executing-macro executing-kbd-macro)
+ (edebug-outside-pre-command-hook
+ (edebug-var-status 'pre-command-hook))
+ (edebug-outside-post-command-hook
+ (edebug-var-status 'post-command-hook))
+
+ (edebug-outside-standard-output standard-output)
(edebug-outside-standard-input standard-input)
(edebug-outside-defining-kbd-macro defining-kbd-macro)
(edebug-outside-last-command last-command)
(edebug-outside-this-command this-command)
- (edebug-outside-unread-command-char unread-command-char) ; FIXME
(edebug-outside-current-prefix-arg current-prefix-arg)
(edebug-outside-last-input-event last-input-event)
@@ -2868,9 +2760,6 @@ MSG is printed after `::::} '."
;; We could set these to the values for previous edebug call.
(last-command last-command)
(this-command this-command)
-
- ;; Assume no edebug command sets unread-command-char.
- (unread-command-char -1)
(current-prefix-arg nil)
;; More for Emacs 19
@@ -2880,7 +2769,20 @@ MSG is printed after `::::} '."
(last-nonmenu-event nil)
(track-mouse nil)
- ;; Bind again to outside values.
+ (standard-output t)
+ (standard-input t)
+
+ ;; Don't keep reading from an executing kbd macro
+ ;; within edebug unless edebug-continue-kbd-macro is
+ ;; non-nil. Again, local binding may not be best.
+ (executing-kbd-macro
+ (if edebug-continue-kbd-macro executing-kbd-macro))
+
+ ;; Don't get confused by the user's keymap changes.
+ (overriding-local-map nil)
+ (overriding-terminal-local-map nil)
+
+ ;; Bind again to outside values.
(debug-on-error edebug-outside-debug-on-error)
(debug-on-quit edebug-outside-debug-on-quit)
@@ -2888,11 +2790,17 @@ MSG is printed after `::::} '."
(defining-kbd-macro
(if edebug-continue-kbd-macro defining-kbd-macro))
+ ;; Disable command hooks. This is essential when
+ ;; a hook function is instrumented - to avoid infinite loop.
+ ;; This may be more than we need, however.
+ (pre-command-hook nil)
+ (post-command-hook nil)
+
;; others??
)
(if (and (eq edebug-execution-mode 'go)
- (not (memq edebug-arg-mode '(after error))))
+ (not (memq arg-mode '(after error))))
(message "Break"))
(setq buffer-read-only t)
@@ -2906,8 +2814,6 @@ MSG is printed after `::::} '."
(setq signal-hook-function 'edebug-signal)
(if edebug-backtrace-buffer
(kill-buffer edebug-backtrace-buffer))
- ;; Could be an option to keep eval display up.
- (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
;; Remember selected-window after recursive-edit.
;; (setq edebug-inside-window (selected-window))
@@ -2934,7 +2840,6 @@ MSG is printed after `::::} '."
last-command-event edebug-outside-last-command-event
last-command edebug-outside-last-command
this-command edebug-outside-this-command
- unread-command-char edebug-outside-unread-command-char
current-prefix-arg edebug-outside-current-prefix-arg
last-input-event edebug-outside-last-input-event
last-event-frame edebug-outside-last-event-frame
@@ -2943,17 +2848,21 @@ MSG is printed after `::::} '."
standard-output edebug-outside-standard-output
standard-input edebug-outside-standard-input
- defining-kbd-macro edebug-outside-defining-kbd-macro
- ))
- ))
+ defining-kbd-macro edebug-outside-defining-kbd-macro)
+
+ (setq executing-kbd-macro edebug-outside-executing-macro)
+ (edebug-restore-status
+ 'post-command-hook edebug-outside-post-command-hook)
+ (edebug-restore-status
+ 'pre-command-hook edebug-outside-pre-command-hook))))
;;; Display related functions
(defun edebug-adjust-window (old-start)
;; If pos is not visible, adjust current window to fit following context.
-;;; (message "window: %s old-start: %s window-start: %s pos: %s"
-;;; (selected-window) old-start (window-start) (point)) (sit-for 5)
+ ;; (message "window: %s old-start: %s window-start: %s pos: %s"
+ ;; (selected-window) old-start (window-start) (point)) (sit-for 5)
(if (not (pos-visible-in-window-p))
(progn
;; First try old-start
@@ -2961,7 +2870,7 @@ MSG is printed after `::::} '."
(set-window-start (selected-window) old-start))
(if (not (pos-visible-in-window-p))
(progn
-;; (message "resetting window start") (sit-for 2)
+ ;; (message "resetting window start") (sit-for 2)
(set-window-start
(selected-window)
(save-excursion
@@ -3058,7 +2967,6 @@ Otherwise, toggle for all windows."
(edebug-toggle-save-selected-window)
(edebug-toggle-save-all-windows)))
-
(defun edebug-where ()
"Show the debug windows and where we stopped in the program."
(interactive)
@@ -3101,12 +3009,12 @@ before returning. The default is one second."
(current-buffer) (point)
(if (marker-buffer (edebug-mark-marker))
(marker-position (edebug-mark-marker)) "<not set>"))
- (edebug-sit-for arg)
+ (sit-for arg)
(edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))
;; Joe Wells, here is a start at your idea of adding a buffer to the internal
-;; display list. Still need to use this list in edebug-display.
+;; display list. Still need to use this list in edebug--display.
'(defvar edebug-display-buffer-list nil
"List of buffers that edebug will display when it is active.")
@@ -3428,7 +3336,7 @@ function or macro is called, Edebug will be called there as well."
(save-excursion
(down-list 1)
(if (looking-at "\(")
- (edebug-form-data-name
+ (edebug--form-data-name
(edebug-get-form-data-entry (point)))
(edebug-original-read (current-buffer))))))
(edebug-instrument-function func))))
@@ -3541,11 +3449,10 @@ edebug-mode."
;;; Evaluation of expressions
-(def-edebug-spec edebug-outside-excursion t)
-
(defmacro edebug-outside-excursion (&rest body)
"Evaluate an expression list in the outside context.
Return the result of the last expression."
+ (declare (debug t))
`(save-excursion ; of current-buffer
(if edebug-save-windows
(progn
@@ -3564,7 +3471,6 @@ Return the result of the last expression."
(last-command-event edebug-outside-last-command-event)
(last-command edebug-outside-last-command)
(this-command edebug-outside-this-command)
- (unread-command-char edebug-outside-unread-command-char)
(unread-command-events edebug-outside-unread-command-events)
(current-prefix-arg edebug-outside-current-prefix-arg)
(last-input-event edebug-outside-last-input-event)
@@ -3580,7 +3486,7 @@ Return the result of the last expression."
(pre-command-hook (cdr edebug-outside-pre-command-hook))
(post-command-hook (cdr edebug-outside-post-command-hook))
- ;; See edebug-display
+ ;; See edebug-display.
(overlay-arrow-position edebug-outside-o-a-p)
(overlay-arrow-string edebug-outside-o-a-s)
(cursor-in-echo-area edebug-outside-c-i-e-a)
@@ -3604,7 +3510,6 @@ Return the result of the last expression."
edebug-outside-last-command-event last-command-event
edebug-outside-last-command last-command
edebug-outside-this-command this-command
- edebug-outside-unread-command-char unread-command-char
edebug-outside-unread-command-events unread-command-events
edebug-outside-current-prefix-arg current-prefix-arg
edebug-outside-last-input-event last-input-event
@@ -3635,18 +3540,19 @@ Return the result of the last expression."
(defvar cl-debug-env) ; defined in cl; non-nil when lexical env used.
-(defun edebug-eval (edebug-expr)
+(defun edebug-eval (expr)
;; Are there cl lexical variables active?
- (eval (if (bound-and-true-p cl-debug-env)
- (cl-macroexpand-all edebug-expr cl-debug-env)
- edebug-expr)
+ (eval (if (and (bound-and-true-p cl-debug-env)
+ (fboundp 'cl-macroexpand-all))
+ (cl-macroexpand-all expr cl-debug-env)
+ expr)
lexical-binding))
-(defun edebug-safe-eval (edebug-expr)
+(defun edebug-safe-eval (expr)
;; Evaluate EXPR safely.
;; If there is an error, a string is returned describing the error.
(condition-case edebug-err
- (edebug-eval edebug-expr)
+ (edebug-eval expr)
(error (edebug-format "%s: %s" ;; could
(get (car edebug-err) 'error-message)
(car (cdr edebug-err))))))
@@ -3654,17 +3560,17 @@ Return the result of the last expression."
;;; Printing
-(defun edebug-report-error (edebug-value)
+(defun edebug-report-error (value)
;; Print an error message like command level does.
;; This also prints the error name if it has no error-message.
(message "%s: %s"
- (or (get (car edebug-value) 'error-message)
- (format "peculiar error (%s)" (car edebug-value)))
+ (or (get (car value) 'error-message)
+ (format "peculiar error (%s)" (car value)))
(mapconcat (function (lambda (edebug-arg)
;; continuing after an error may
;; complain about edebug-arg. why??
(prin1-to-string edebug-arg)))
- (cdr edebug-value) ", ")))
+ (cdr value) ", ")))
(defvar print-readably) ; defined by lemacs
;; Alternatively, we could change the definition of
@@ -3680,14 +3586,14 @@ Return the result of the last expression."
(edebug-prin1-to-string value)
(error "#Apparently circular structure#"))))
-(defun edebug-compute-previous-result (edebug-previous-value)
+(defun edebug-compute-previous-result (previous-value)
(if edebug-unwrap-results
- (setq edebug-previous-value
- (edebug-unwrap* edebug-previous-value)))
+ (setq previous-value
+ (edebug-unwrap* previous-value)))
(setq edebug-previous-result
(concat "Result: "
- (edebug-safe-prin1-to-string edebug-previous-value)
- (eval-expression-print-format edebug-previous-value))))
+ (edebug-safe-prin1-to-string previous-value)
+ (eval-expression-print-format previous-value))))
(defun edebug-previous-result ()
"Print the previous result."
@@ -3702,7 +3608,7 @@ Return the result of the last expression."
(defalias 'edebug-format 'format)
(defalias 'edebug-message 'message)
-(defun edebug-eval-expression (edebug-expr)
+(defun edebug-eval-expression (expr)
"Evaluate an expression in the outside environment.
If interactive, prompt for the expression.
Print result in minibuffer."
@@ -3711,7 +3617,7 @@ Print result in minibuffer."
'read-expression-history)))
(princ
(edebug-outside-excursion
- (setq values (cons (edebug-eval edebug-expr) values))
+ (setq values (cons (edebug-eval expr) values))
(concat (edebug-safe-prin1-to-string (car values))
(eval-expression-print-format (car values))))))
@@ -3725,25 +3631,29 @@ Print value in minibuffer."
"Evaluate sexp before point in outside environment; insert value.
This prints the value into current buffer."
(interactive)
- (let* ((edebug-form (edebug-last-sexp))
- (edebug-result-string
+ (let* ((form (edebug-last-sexp))
+ (result-string
(edebug-outside-excursion
- (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form))))
+ (edebug-safe-prin1-to-string (edebug-safe-eval form))))
(standard-output (current-buffer)))
(princ "\n")
;; princ the string to get rid of quotes.
- (princ edebug-result-string)
+ (princ result-string)
(princ "\n")
))
;;; Edebug Minor Mode
-;; FIXME eh?
-(defvar gud-inhibit-global-bindings
- "*Non-nil means don't do global rebindings of C-x C-a subcommands.")
+(defvar edebug-inhibit-emacs-lisp-mode-bindings nil
+ "If non-nil, inhibit Edebug bindings on the C-x C-a key.
+By default, loading the `edebug' library causes these bindings to
+be installed in `emacs-lisp-mode-map'.")
+
+(define-obsolete-variable-alias 'gud-inhibit-global-bindings
+ 'edebug-inhibit-emacs-lisp-mode-bindings "24.3")
;; Global GUD bindings for all emacs-lisp-mode buffers.
-(unless gud-inhibit-global-bindings
+(unless edebug-inhibit-emacs-lisp-mode-bindings
(define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
(define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
(define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
@@ -3920,44 +3830,38 @@ Options:
(edebug-trace nil))
(mapcar 'edebug-safe-eval edebug-eval-list)))
-(defun edebug-eval-display-list (edebug-eval-result-list)
+(defun edebug-eval-display-list (eval-result-list)
;; Assumes edebug-eval-buffer exists.
- (let ((edebug-eval-list-temp edebug-eval-list)
- (standard-output edebug-eval-buffer)
+ (let ((standard-output edebug-eval-buffer)
(edebug-comment-line
(format ";%s\n" (make-string (- (window-width) 2) ?-))))
(set-buffer edebug-eval-buffer)
(erase-buffer)
- (while edebug-eval-list-temp
- (prin1 (car edebug-eval-list-temp)) (terpri)
- (prin1 (car edebug-eval-result-list)) (terpri)
- (princ edebug-comment-line)
- (setq edebug-eval-list-temp (cdr edebug-eval-list-temp))
- (setq edebug-eval-result-list (cdr edebug-eval-result-list)))
+ (dolist (exp edebug-eval-list)
+ (prin1 exp) (terpri)
+ (prin1 (pop eval-result-list)) (terpri)
+ (princ edebug-comment-line))
(edebug-pop-to-buffer edebug-eval-buffer)
))
(defun edebug-create-eval-buffer ()
- (if (not (and edebug-eval-buffer (buffer-name edebug-eval-buffer)))
- (progn
- (set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*")))
- (edebug-eval-mode))))
+ (unless (and edebug-eval-buffer (buffer-name edebug-eval-buffer))
+ (set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*")))
+ (edebug-eval-mode)))
;; Should generalize this to be callable outside of edebug
;; with calls in user functions, e.g. (edebug-eval-display)
-(defun edebug-eval-display (edebug-eval-result-list)
- "Display expressions and evaluations in EDEBUG-EVAL-RESULT-LIST.
+(defun edebug-eval-display (eval-result-list)
+ "Display expressions and evaluations in EVAL-RESULT-LIST.
It modifies the context by popping up the eval display."
- (if edebug-eval-result-list
- (progn
- (edebug-create-eval-buffer)
- (edebug-eval-display-list edebug-eval-result-list)
- )))
+ (when eval-result-list
+ (edebug-create-eval-buffer)
+ (edebug-eval-display-list eval-result-list)))
(defun edebug-eval-redisplay ()
"Redisplay eval list in outside environment.
-May only be called from within `edebug-recursive-edit'."
+May only be called from within `edebug--recursive-edit'."
(edebug-create-eval-buffer)
(edebug-outside-excursion
(edebug-eval-display-list (edebug-eval-result-list))
@@ -3981,7 +3885,7 @@ May only be called from within `edebug-recursive-edit'."
(if (not (eobp))
(progn
(forward-sexp 1)
- (setq new-list (cons (edebug-last-sexp) new-list))))
+ (push (edebug-last-sexp) new-list)))
(while (re-search-forward "^;" nil t)
(forward-line 1)
@@ -3990,7 +3894,7 @@ May only be called from within `edebug-recursive-edit'."
(not (eobp)))
(progn
(forward-sexp 1)
- (setq new-list (cons (edebug-last-sexp) new-list)))))
+ (push (edebug-last-sexp) new-list))))
(setq edebug-eval-list (nreverse new-list))
(edebug-eval-redisplay)
@@ -4019,8 +3923,8 @@ May only be called from within `edebug-recursive-edit'."
(define-key map "\C-c\C-u" 'edebug-update-eval-list)
(define-key map "\C-x\C-e" 'edebug-eval-last-sexp)
(define-key map "\C-j" 'edebug-eval-print-last-sexp)
- map)
-"Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.")
+ map)
+ "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.")
(put 'edebug-eval-mode 'mode-class 'special)
@@ -4047,32 +3951,32 @@ Global commands prefixed by `global-edebug-prefix':
;; since they depend on the backtrace looking a certain way. But
;; edebug is not dependent on this, yet.
-(defun edebug (&optional edebug-arg-mode &rest debugger-args)
+(defun edebug (&optional arg-mode &rest args)
"Replacement for `debug'.
If we are running an edebugged function, show where we last were.
Otherwise call `debug' normally."
-;; (message "entered: %s depth: %s edebug-recursion-depth: %s"
-;; edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1)
+ ;;(message "entered: %s depth: %s edebug-recursion-depth: %s"
+ ;; edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1)
(if (and edebug-entered ; anything active?
(eq (recursion-depth) edebug-recursion-depth))
(let (;; Where were we before the error occurred?
- (edebug-offset-index (car edebug-offset-indices))
- ;; Bind variables required by edebug-display
- (edebug-value (car debugger-args))
+ (offset-index (car edebug-offset-indices))
+ (value (car args))
+ ;; Bind variables required by edebug--display.
edebug-breakpoints
edebug-break-data
edebug-break-condition
edebug-global-break
- (edebug-break (null edebug-arg-mode)) ;; if called explicitly
+ (edebug-break (null arg-mode)) ;; If called explicitly.
)
- (edebug-display)
- (if (eq edebug-arg-mode 'error)
+ (edebug--display value offset-index arg-mode)
+ (if (eq arg-mode 'error)
nil
- edebug-value))
+ value))
;; Otherwise call debug normally.
;; Still need to remove extraneous edebug calls from stack.
- (apply 'debug edebug-arg-mode debugger-args)
+ (apply 'debug arg-mode args)
))
@@ -4083,7 +3987,7 @@ Otherwise call `debug' normally."
(null (buffer-name edebug-backtrace-buffer)))
(setq edebug-backtrace-buffer
(generate-new-buffer "*Backtrace*"))
- ;; else, could just display edebug-backtrace-buffer
+ ;; Else, could just display edebug-backtrace-buffer.
)
(with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer)
(setq edebug-backtrace-buffer standard-output)
@@ -4105,7 +4009,7 @@ Otherwise call `debug' normally."
(beginning-of-line)
(cond
((looking-at "^ \(edebug-after")
- ;; Previous lines may contain code, so just delete this line
+ ;; Previous lines may contain code, so just delete this line.
(setq last-ok-point (point))
(forward-line 1)
(delete-region last-ok-point (point)))
@@ -4123,15 +4027,15 @@ Otherwise call `debug' normally."
"In buffer BUF-NAME, display FMT and ARGS at the end and make it visible.
The buffer is created if it does not exist.
You must include newlines in FMT to break lines, but one newline is appended."
-;; e.g.
-;; (edebug-trace-display "*trace-point*"
-;; "saving: point = %s window-start = %s"
-;; (point) (window-start))
+ ;; e.g.
+ ;; (edebug-trace-display "*trace-point*"
+ ;; "saving: point = %s window-start = %s"
+ ;; (point) (window-start))
(let* ((oldbuf (current-buffer))
(selected-window (selected-window))
(buffer (get-buffer-create buf-name))
buf-window)
-;; (message "before pop-to-buffer") (sit-for 1)
+ ;; (message "before pop-to-buffer") (sit-for 1)
(edebug-pop-to-buffer buffer)
(setq truncate-lines t)
(setq buf-window (selected-window))
@@ -4141,8 +4045,8 @@ You must include newlines in FMT to break lines, but one newline is appended."
(vertical-motion (- 1 (window-height)))
(set-window-start buf-window (point))
(goto-char (point-max))
-;; (set-window-point buf-window (point))
-;; (edebug-sit-for 0)
+ ;; (set-window-point buf-window (point))
+ ;; (sit-for 0)
(bury-buffer buffer)
(select-window selected-window)
(set-buffer oldbuf))
@@ -4157,6 +4061,8 @@ You must include newlines in FMT to break lines, but one newline is appended."
;;; Frequency count and coverage
;; FIXME should this use overlays instead?
+;; Definitely, IMO. The current business with undo in
+;; edebug-temp-display-freq-count is horrid.
(defun edebug-display-freq-count ()
"Display the frequency count data for each line of the current definition.
The frequency counts are inserted as comment lines after each line,
@@ -4203,8 +4109,8 @@ reinstrument it."
;; Insert all the indices for this line.
(forward-line 1)
(setq start-of-count-line (point)
- first-index i ; really last index for line above this one.
- last-count -1) ; cause first count to always appear.
+ first-index i ; Really, last index for line above this one.
+ last-count -1) ; Cause first count to always appear.
(insert ";#")
;; i == first-index still
(while (<= (setq i (1+ i)) last-index)
@@ -4226,6 +4132,8 @@ reinstrument it."
(insert "\n")
(setq i first-index)))))
+;; FIXME this does not work very well. Eg if you press an arrow key,
+;; or make a mouse-click, it fails with "Non-character input-event".
(defun edebug-temp-display-freq-count ()
"Temporarily display the frequency count data for the current definition.
It is removed when you hit any char."
@@ -4234,7 +4142,9 @@ It is removed when you hit any char."
(let ((buffer-read-only nil))
(undo-boundary)
(edebug-display-freq-count)
- (setq unread-command-char (read-char))
+ (setq unread-command-events
+ (append unread-command-events (list (read-event))))
+ ;; Yuck! This doesn't seem to work at all for me.
(undo)))
@@ -4345,96 +4255,8 @@ With prefix argument, make it a temporary breakpoint."
(easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
-;;; Byte-compiler
-
-;; Extension for bytecomp to resolve undefined function references.
-;; Requires new byte compiler.
-
-;; Reenable byte compiler warnings about unread-command-char and -event.
-;; Disabled before edebug-recursive-edit.
-(eval-when-compile
- (if edebug-unread-command-char-warning
- (put 'unread-command-char 'byte-obsolete-variable
- edebug-unread-command-char-warning)))
-
-(eval-when-compile
- ;; The body of eval-when-compile seems to get evaluated with eval-defun.
- ;; We only want to evaluate when actually byte compiling.
- ;; But it is OK to evaluate as long as byte-compiler has been loaded.
- (if (featurep 'byte-compile) (progn
-
- (defun byte-compile-resolve-functions (funcs)
- "Say it is OK for the named functions to be unresolved."
- (mapc
- (function
- (lambda (func)
- (setq byte-compile-unresolved-functions
- (delq (assq func byte-compile-unresolved-functions)
- byte-compile-unresolved-functions))))
- funcs)
- nil)
-
- '(defun byte-compile-resolve-free-references (vars)
- "Say it is OK for the named variables to be referenced."
- (mapcar
- (function
- (lambda (var)
- (setq byte-compile-free-references
- (delq var byte-compile-free-references))))
- vars)
- nil)
-
- '(defun byte-compile-resolve-free-assignments (vars)
- "Say it is OK for the named variables to be assigned."
- (mapcar
- (function
- (lambda (var)
- (setq byte-compile-free-assignments
- (delq var byte-compile-free-assignments))))
- vars)
- nil)
-
- (byte-compile-resolve-functions
- '(reporter-submit-bug-report
- edebug-gensym ;; also in cl.el
- ;; Interfaces to standard functions.
- edebug-original-eval-defun
- edebug-original-read
- edebug-get-buffer-window
- edebug-mark
- edebug-mark-marker
- edebug-input-pending-p
- edebug-sit-for
- edebug-prin1-to-string
- edebug-format
- ;; lemacs
- zmacs-deactivate-region
- popup-menu
- ;; CL
- cl-macroexpand-all
- ;; And believe it or not, the byte compiler doesn't know about:
- byte-compile-resolve-functions
- ))
-
- '(byte-compile-resolve-free-references
- '(read-expression-history
- read-expression-map))
-
- '(byte-compile-resolve-free-assignments
- '(read-expression-history))
-
- )))
-
-
;;; Autoloading of Edebug accessories
-(if (featurep 'cl)
- (add-hook 'edebug-setup-hook
- (function (lambda () (require 'cl-specs))))
- ;; The following causes cl-specs to be loaded if you load cl.el.
- (add-hook 'cl-load-hook
- (function (lambda () (require 'cl-specs)))))
-
;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu
(if (featurep 'cl-read)
(add-hook 'edebug-setup-hook
@@ -4446,6 +4268,21 @@ With prefix argument, make it a temporary breakpoint."
;;; Finalize Loading
+;; When edebugging a function, some of the sub-expressions are
+;; wrapped in (edebug-enter (lambda () ..)), so we need to teach
+;; called-interactively-p that calls within the inner lambda should refer to
+;; the outside function.
+(add-hook 'called-interactively-p-functions
+ #'edebug--called-interactively-skip)
+(defun edebug--called-interactively-skip (i frame1 frame2)
+ (when (and (eq (car-safe (nth 1 frame1)) 'lambda)
+ (eq (nth 1 (nth 1 frame1)) '())
+ (eq (nth 1 frame2) 'edebug-enter))
+ ;; `edebug-enter' calls itself on its first invocation.
+ (if (eq (nth 1 (internal--called-interactively-p--get-frame i))
+ 'edebug-enter)
+ 2 1)))
+
;; Finally, hook edebug into the rest of Emacs.
;; There are probably some other things that could go here.
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 278dff0f085..69fe762887f 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -1,10 +1,9 @@
;;; eieio-base.el --- Base classes for EIEIO.
-;;; Copyright (C) 2000-2002, 2004-2005, 2007-2011
+;;; Copyright (C) 2000-2002, 2004-2005, 2007-2012
;;; 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 e8d7bea50fa..cab9caad108 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -1,6 +1,6 @@
;;; eieio-custom.el -- eieio object customization
-;; Copyright (C) 1999-2001, 2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2001, 2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.2
@@ -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.
@@ -345,8 +355,9 @@ These groups are specified with the `:group' slot flag."
(concat "*CUSTOMIZE "
(object-name obj) " "
(symbol-name g) "*")))
- (toggle-read-only -1)
+ (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 60510e1816c..a1db1972b83 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -1,6 +1,6 @@
;;; eieio-datadebug.el --- EIEIO extensions to the data debugger.
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: OO, lisp
@@ -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))
@@ -132,7 +131,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
(defun eieio-debug-methodinvoke (method class)
"Show the method invocation order for METHOD with CLASS object."
(interactive "aMethod: \nXClass Expression: ")
- (let* ((eieio-pre-method-execution-hooks
+ (let* ((eieio-pre-method-execution-functions
(lambda (l) (throw 'moose l) ))
(data
(catch 'moose (eieio-generic-call
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 8869530dc23..c8bdd7758fa 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -1,10 +1,9 @@
;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar)
-;; Copyright (C) 1996, 1998-2003, 2005, 2008-2011
+;; Copyright (C) 1996, 1998-2003, 2005, 2008-2012
;; 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 'find-func)
+(require 'speedbar)
+(require 'help-mode)
;;; Code:
;;;###autoload
@@ -72,8 +74,7 @@ Argument CH-PREFIX is another character prefix to display."
;;; CLASS COMPLETION / DOCUMENTATION
-;;;###autoload
-(defalias 'describe-class 'eieio-describe-class)
+;;;###autoload(defalias 'describe-class 'eieio-describe-class)
;;;###autoload
(defun eieio-describe-class (class &optional headerfcn)
@@ -86,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)))
@@ -252,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)
@@ -263,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.
@@ -271,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))
@@ -305,8 +327,7 @@ are not abstract."
;;; METHOD COMPLETION / DOC
(defalias 'describe-method 'eieio-describe-generic)
-;;;###autoload
-(defalias 'describe-generic 'eieio-describe-generic)
+;;;###autoload(defalias 'describe-generic 'eieio-describe-generic)
(defalias 'eieio-describe-method 'eieio-describe-generic)
;;;###autoload
@@ -344,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 ")
@@ -359,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)))
@@ -377,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)))
@@ -556,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."
@@ -599,14 +686,30 @@ 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
;;
-(eval-when-compile
- (condition-case nil
- (require 'speedbar)
- (error (message "Error loading speedbar... ignored"))))
(defvar eieio-class-speedbar-key-map nil
"Keymap used when working with a project in speedbar.")
@@ -700,8 +803,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 4ff3cc01978..327e5ced0e3 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -1,9 +1,8 @@
;;; eieio-speedbar.el -- Classes for managing speedbar displays.
-;; Copyright (C) 1999-2002, 2005, 2007-2011 Free Software Foundation, Inc.
+;; 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 170d3fb0bf8..3f7b49bde25 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -1,7 +1,7 @@
;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects
;;; or maybe Eric's Implementation of Emacs Interpreted Objects
-;; Copyright (C) 1995-1996, 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 1998-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.3
@@ -44,8 +44,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
(defvar eieio-version "1.3"
"Current version of EIEIO.")
@@ -79,7 +78,7 @@
;;
(defvar eieio-hook nil
- "*This hook is executed, then cleared each time `defclass' is called.")
+ "This hook is executed, then cleared each time `defclass' is called.")
(defvar eieio-error-unsupported-class-tags nil
"Non-nil to throw an error if an encountered tag is unsupported.
@@ -87,7 +86,7 @@ This may prevent classes from CLOS applications from being used with EIEIO
since EIEIO does not support all CLOS tags.")
(defvar eieio-skip-typecheck nil
- "*If non-nil, skip all slot typechecking.
+ "If non-nil, skip all slot typechecking.
Set this to t permanently if a program is functioning well to get a
small speed increase. This variable is also used internally to handle
default setting for optimization purposes.")
@@ -95,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.")
@@ -411,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)
))))
@@ -431,10 +416,10 @@ See `defclass' for more information."
(run-hooks 'eieio-hook)
(setq eieio-hook nil)
- (if (not (symbolp cname)) (signal 'wrong-type-argument '(symbolp cname)))
- (if (not (listp superclasses)) (signal 'wrong-type-argument '(listp superclasses)))
+ (if (not (listp superclasses))
+ (signal 'wrong-type-argument '(listp superclasses)))
- (let* ((pname (if superclasses superclasses nil))
+ (let* ((pname superclasses)
(newc (make-vector class-num-slots nil))
(oldc (when (class-p cname) (class-v cname)))
(groups nil) ;; list of groups id'd from slots
@@ -540,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
@@ -553,8 +555,8 @@ See `defclass' for more information."
(put cname 'cl-deftype-handler
(list 'lambda () `(list 'satisfies (quote ,csym)))))
- ;; before adding new slots, let's add all the methods and classes
- ;; in from the parent class
+ ;; Before adding new slots, let's add all the methods and classes
+ ;; in from the parent class.
(eieio-copy-parents-into-subclass newc superclasses)
;; Store the new class vector definition into the symbol. We need to
@@ -652,9 +654,9 @@ See `defclass' for more information."
;; We need to id the group, and store them in a group list attribute.
(mapc (lambda (cg) (add-to-list 'groups cg)) customg)
- ;; anyone can have an accessor function. This creates a function
+ ;; Anyone can have an accessor function. This creates a function
;; of the specified name, and also performs a `defsetf' if applicable
- ;; so that users can `setf' the space returned by this function
+ ;; so that users can `setf' the space returned by this function.
(if acces
(progn
(eieio--defmethod
@@ -668,18 +670,26 @@ See `defclass' for more information."
;; Else - Some error? nil?
nil)))
- ;; Provide a setf method. It would be cleaner to use
- ;; defsetf, but that would require CL at runtime.
- (put acces 'setf-method
- `(lambda (widget)
- (let* ((--widget-sym-- (make-symbol "--widget--"))
- (--store-sym-- (make-symbol "--store--")))
- (list
- (list --widget-sym--)
- (list widget)
- (list --store-sym--)
- (list 'eieio-oset --widget-sym-- '',name --store-sym--)
- (list 'getfoo --widget-sym--)))))))
+ (if (fboundp 'gv-define-setter)
+ ;; FIXME: We should move more of eieio-defclass into the
+ ;; defclass macro so we don't have to use `eval' and require
+ ;; `gv' at run-time.
+ (eval `(gv-define-setter ,acces (eieio--store eieio--object)
+ (list 'eieio-oset eieio--object '',name
+ eieio--store)))
+ ;; Provide a setf method. It would be cleaner to use
+ ;; defsetf, but that would require CL at runtime.
+ (put acces 'setf-method
+ `(lambda (widget)
+ (let* ((--widget-sym-- (make-symbol "--widget--"))
+ (--store-sym-- (make-symbol "--store--")))
+ (list
+ (list --widget-sym--)
+ (list widget)
+ (list --store-sym--)
+ (list 'eieio-oset --widget-sym-- '',name
+ --store-sym--)
+ (list 'getfoo --widget-sym--))))))))
;; If a writer is defined, then create a generic method of that
;; name whose purpose is to set the value of the slot.
@@ -702,7 +712,8 @@ See `defclass' for more information."
)
(setq slots (cdr slots)))
- ;; Now that everything has been loaded up, all our lists are backwards! Fix that up now.
+ ;; Now that everything has been loaded up, all our lists are backwards!
+ ;; Fix that up now.
(aset newc class-public-a (nreverse (aref newc class-public-a)))
(aset newc class-public-d (nreverse (aref newc class-public-d)))
(aset newc class-public-doc (nreverse (aref newc class-public-doc)))
@@ -773,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)
@@ -1246,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)
@@ -1533,71 +1556,6 @@ Fills in OBJ's SLOT with its default value."
;; return it verbatim
(t val)))
-;;; Object Set macros
-;;
-(defmacro oset (obj slot value)
- "Set the value in OBJ for slot SLOT to VALUE.
-SLOT is the slot name as specified in `defclass' or the tag created
-with in the :initarg slot. VALUE can be any Lisp object."
- `(eieio-oset ,obj (quote ,slot) ,value))
-
-(defun eieio-oset (obj slot value)
- "Do the work for the macro `oset'.
-Fills in OBJ's SLOT with VALUE."
- (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj)))
- (if (not (symbolp slot)) (signal 'wrong-type-argument (list 'symbolp slot)))
- (let ((c (eieio-slot-name-index (object-class-fast obj) obj slot)))
- (if (not c)
- ;; It might be missing because it is a :class allocated slot.
- ;; Let's check that info out.
- (if (setq c
- (eieio-class-slot-name-index (aref obj object-class) slot))
- ;; Oset that slot.
- (progn
- (eieio-validate-class-slot-value (object-class-fast obj) c value slot)
- (aset (aref (class-v (aref obj object-class))
- class-class-allocation-values)
- c value))
- ;; See oref for comment on `slot-missing'
- (slot-missing obj slot 'oset value)
- ;;(signal 'invalid-slot-name (list (object-name obj) slot))
- )
- (eieio-validate-slot-value (object-class-fast obj) c value slot)
- (aset obj c value))))
-
-(defmacro oset-default (class slot value)
- "Set the default slot in CLASS for SLOT to VALUE.
-The default value is usually set with the :initform tag during class
-creation. This allows users to change the default behavior of classes
-after they are created."
- `(eieio-oset-default ,class (quote ,slot) ,value))
-
-(defun eieio-oset-default (class slot value)
- "Do the work for the macro `oset-default'.
-Fills in the default value in CLASS' in SLOT with VALUE."
- (if (not (class-p class)) (signal 'wrong-type-argument (list 'class-p class)))
- (if (not (symbolp slot)) (signal 'wrong-type-argument (list 'symbolp slot)))
- (let* ((scoped-class class)
- (c (eieio-slot-name-index class nil slot)))
- (if (not c)
- ;; It might be missing because it is a :class allocated slot.
- ;; Let's check that info out.
- (if (setq c (eieio-class-slot-name-index class slot))
- (progn
- ;; Oref that slot.
- (eieio-validate-class-slot-value class c value slot)
- (aset (aref (class-v class) class-class-allocation-values) c
- value))
- (signal 'invalid-slot-name (list (class-name class) slot)))
- (eieio-validate-slot-value class c value slot)
- ;; Set this into the storage for defaults.
- (setcar (nthcdr (- c 3) (aref (class-v class) class-public-d))
- value)
- ;; Take the value, and put it into our cache object.
- (eieio-oset (aref (class-v class) class-default-object-cache)
- slot value)
- )))
-
;;; Handy CLOS macros
;;
(defmacro with-slots (spec-list object &rest body)
@@ -1848,6 +1806,71 @@ method invocation orders of the involved classes."
(setq ia (cdr ia)))
f))
+;;; Object Set macros
+;;
+(defmacro oset (obj slot value)
+ "Set the value in OBJ for slot SLOT to VALUE.
+SLOT is the slot name as specified in `defclass' or the tag created
+with in the :initarg slot. VALUE can be any Lisp object."
+ `(eieio-oset ,obj (quote ,slot) ,value))
+
+(defun eieio-oset (obj slot value)
+ "Do the work for the macro `oset'.
+Fills in OBJ's SLOT with VALUE."
+ (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj)))
+ (if (not (symbolp slot)) (signal 'wrong-type-argument (list 'symbolp slot)))
+ (let ((c (eieio-slot-name-index (object-class-fast obj) obj slot)))
+ (if (not c)
+ ;; It might be missing because it is a :class allocated slot.
+ ;; Let's check that info out.
+ (if (setq c
+ (eieio-class-slot-name-index (aref obj object-class) slot))
+ ;; Oset that slot.
+ (progn
+ (eieio-validate-class-slot-value (object-class-fast obj) c value slot)
+ (aset (aref (class-v (aref obj object-class))
+ class-class-allocation-values)
+ c value))
+ ;; See oref for comment on `slot-missing'
+ (slot-missing obj slot 'oset value)
+ ;;(signal 'invalid-slot-name (list (object-name obj) slot))
+ )
+ (eieio-validate-slot-value (object-class-fast obj) c value slot)
+ (aset obj c value))))
+
+(defmacro oset-default (class slot value)
+ "Set the default slot in CLASS for SLOT to VALUE.
+The default value is usually set with the :initform tag during class
+creation. This allows users to change the default behavior of classes
+after they are created."
+ `(eieio-oset-default ,class (quote ,slot) ,value))
+
+(defun eieio-oset-default (class slot value)
+ "Do the work for the macro `oset-default'.
+Fills in the default value in CLASS' in SLOT with VALUE."
+ (if (not (class-p class)) (signal 'wrong-type-argument (list 'class-p class)))
+ (if (not (symbolp slot)) (signal 'wrong-type-argument (list 'symbolp slot)))
+ (let* ((scoped-class class)
+ (c (eieio-slot-name-index class nil slot)))
+ (if (not c)
+ ;; It might be missing because it is a :class allocated slot.
+ ;; Let's check that info out.
+ (if (setq c (eieio-class-slot-name-index class slot))
+ (progn
+ ;; Oref that slot.
+ (eieio-validate-class-slot-value class c value slot)
+ (aset (aref (class-v class) class-class-allocation-values) c
+ value))
+ (signal 'invalid-slot-name (list (class-name class) slot)))
+ (eieio-validate-slot-value class c value slot)
+ ;; Set this into the storage for defaults.
+ (setcar (nthcdr (- c 3) (aref (class-v class) class-public-d))
+ value)
+ ;; Take the value, and put it into our cache object.
+ (eieio-oset (aref (class-v class) class-default-object-cache)
+ slot value)
+ )))
+
;;; CLOS queries into classes and slots
;;
(defun slot-boundp (object slot)
@@ -2000,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))
@@ -2043,8 +2066,10 @@ Keys are a number representing :before, :primary, and :after methods.")
During executions, the list is first generated, then as each next method
is called, the next method is popped off the stack.")
-(defvar eieio-pre-method-execution-hooks nil
- "*Hooks run just before a method is executed.
+(define-obsolete-variable-alias 'eieio-pre-method-execution-hooks
+ 'eieio-pre-method-execution-functions "24.3")
+(defvar eieio-pre-method-execution-functions nil
+ "Abnormal hook run just before an EIEIO method is executed.
The hook function must accept one argument, the list of forms
about to be executed.")
@@ -2149,7 +2174,7 @@ This should only be called from a generic function."
(eieiomt-method-list method method-primary nil)))
)
- (run-hook-with-args 'eieio-pre-method-execution-hooks
+ (run-hook-with-args 'eieio-pre-method-execution-functions
primarymethodlist)
;; Now loop through all occurrences forms which we must execute
@@ -2254,7 +2279,7 @@ for this common case to improve performance."
;; Do the regular implementation here.
- (run-hook-with-args 'eieio-pre-method-execution-hooks
+ (run-hook-with-args 'eieio-pre-method-execution-functions
lambdas)
(setq lastval (apply (car lambdas) newargs))
@@ -2311,7 +2336,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))
@@ -2395,6 +2420,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)))
@@ -2543,8 +2580,13 @@ This is usually a symbol that starts with `:'."
;;; Here are some CLOS items that need the CL package
;;
-(defsetf slot-value (obj slot) (store) (list 'eieio-oset obj slot store))
-(defsetf eieio-oref (obj slot) (store) (list 'eieio-oset obj slot store))
+(defsetf eieio-oref eieio-oset)
+
+(if (eval-when-compile (fboundp 'gv-define-expander))
+ ;; Not needed for Emacs>=24.3 since gv.el's setf expands macros and
+ ;; follows aliases.
+ nil
+(defsetf slot-value eieio-oset)
;; The below setf method was written by Arnd Kohrs <kohrs@acm.org>
(define-setf-method oref (obj slot)
@@ -2558,7 +2600,7 @@ This is usually a symbol that starts with `:'."
(list store-temp)
(list 'set-slot-value obj-temp slot-temp
store-temp)
- (list 'slot-value obj-temp slot-temp)))))
+ (list 'slot-value obj-temp slot-temp))))))
;;;
@@ -2710,7 +2752,7 @@ This method signals `no-next-method' by default. Override this
method to not throw an error, and its return value becomes the
return value of `call-next-method'."
(signal 'no-next-method (list (object-name object) args))
-)
+ )
(defgeneric clone (obj &rest params)
"Make a copy of OBJ, and then supply PARAMS.
@@ -2794,9 +2836,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))
@@ -2863,7 +2905,6 @@ of `eq'."
)
-
;;; Obsolete backward compatibility functions.
;; Needed to run byte-code compiled with the EIEIO of Emacs-23.
@@ -3008,29 +3049,6 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
)
)
-;;; Interfacing with imenu in emacs lisp mode
-;; (Only if the expression is defined)
-;;
-(if (eval-when-compile (boundp 'list-imenu-generic-expression))
-(progn
-
-(defun eieio-update-lisp-imenu-expression ()
- "Examine `lisp-imenu-generic-expression' and modify it to find `defmethod'."
- (let ((exp lisp-imenu-generic-expression))
- (while exp
- ;; it's of the form '( ( title expr indx ) ... )
- (let* ((subcar (cdr (car exp)))
- (substr (car subcar)))
- (if (and (not (string-match "|method\\\\" substr))
- (string-match "|advice\\\\" substr))
- (setcar subcar
- (replace-match "|advice\\|method\\" t t substr 0))))
- (setq exp (cdr exp)))))
-
-(eieio-update-lisp-imenu-expression)
-
-))
-
;;; Autoloading some external symbols, and hooking into the help system
;;
@@ -3038,7 +3056,7 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
;;; Start of automatically extracted autoloads.
;;;### (autoloads (customize-object) "eieio-custom" "eieio-custom.el"
-;;;;;; "cf1bd64c76a6e6406545e8c5a5530d43")
+;;;;;; "928623502e8bf40454822355388542b5")
;;; Generated autoloads from eieio-custom.el
(autoload 'customize-object "eieio-custom" "\
@@ -3051,7 +3069,7 @@ Optional argument GROUP is the sub-group of slots to display.
;;;### (autoloads (eieio-help-mode-augmentation-maybee eieio-describe-generic
;;;;;; eieio-describe-constructor eieio-describe-class eieio-browse)
-;;;;;; "eieio-opt" "eieio-opt.el" "4fb6625c3a007438aab4e8e77b6c73c2")
+;;;;;; "eieio-opt" "eieio-opt.el" "d808328f9c0156ecbd412d77ba8c569e")
;;; Generated autoloads from eieio-opt.el
(autoload 'eieio-browse "eieio-opt" "\
@@ -3060,7 +3078,6 @@ If optional ROOT-CLASS, then start with that, otherwise start with
variable `eieio-default-superclass'.
\(fn &optional ROOT-CLASS)" t nil)
-
(defalias 'describe-class 'eieio-describe-class)
(autoload 'eieio-describe-class "eieio-opt" "\
@@ -3075,7 +3092,6 @@ Describe the constructor function FCN.
Uses `eieio-describe-class' to describe the class being constructed.
\(fn FCN)" t nil)
-
(defalias 'describe-generic 'eieio-describe-generic)
(autoload 'eieio-describe-generic "eieio-opt" "\
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 9822b556f34..6e5b8e92fb8 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -1,6 +1,6 @@
;;; eldoc.el --- show function arglist or variable docstring in echo area
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Noah Friedman <friedman@splode.com>
;; Maintainer: friedman@splode.com
diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el
index ce6f8348a6b..2ff0ace9f4c 100644
--- a/lisp/emacs-lisp/elint.el
+++ b/lisp/emacs-lisp/elint.el
@@ -1,6 +1,6 @@
;;; elint.el --- Lint Emacs Lisp
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Peter Liljenberg <petli@lysator.liu.se>
;; Created: May 1997
@@ -46,6 +46,8 @@
;;; Code:
+(require 'help-fns)
+
(defgroup elint nil
"Linting for Emacs Lisp."
:prefix "elint-"
@@ -357,6 +359,8 @@ Returns the forms."
(set (make-local-variable 'elint-buffer-env)
(elint-init-env elint-buffer-forms))
(if elint-preloaded-env
+ ;; FIXME: This doesn't do anything! Should we setq the result to
+ ;; elint-buffer-env?
(elint-env-add-env elint-preloaded-env elint-buffer-env))
(set (make-local-variable 'elint-last-env-time) (buffer-modified-tick))
elint-buffer-forms))
@@ -464,6 +468,9 @@ Return nil if there are no more forms, t otherwise."
(add-to-list 'elint-features name)
;; cl loads cl-macs in an opaque manner.
;; Since cl-macs requires cl, we can just process cl-macs.
+ ;; FIXME: AFAIK, `cl' now behaves properly and does not need any
+ ;; special treatment any more. Can someone who understands this
+ ;; code confirm? --Stef
(and (eq name 'cl) (not elint-doing-cl)
;; We need cl if elint-form is to be able to expand cl macros.
(require 'cl)
@@ -708,14 +715,8 @@ Returns `unknown' if we couldn't find arguments."
(defun elint-find-args-in-code (code)
"Extract the arguments from CODE.
CODE can be a lambda expression, a macro, or byte-compiled code."
- (cond
- ((byte-code-function-p code)
- (aref code 0))
- ((and (listp code) (eq (car code) 'lambda))
- (car (cdr code)))
- ((and (listp code) (eq (car code) 'macro))
- (elint-find-args-in-code (cdr code)))
- (t 'unknown)))
+ (let ((args (help-function-arglist code)))
+ (if (listp args) args 'unknown)))
;;;
;;; Functions to check some special forms
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index b89b6decfc9..067b45f5cd8 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -1,6 +1,6 @@
-;;; elp.el --- Emacs Lisp Profiler
+;;; elp.el --- Emacs Lisp Profiler -*- lexical-binding: t -*-
-;; Copyright (C) 1994-1995, 1997-1998, 2001-2011
+;; Copyright (C) 1994-1995, 1997-1998, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Barry A. Warsaw
@@ -124,6 +124,7 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
;; start of user configuration variables
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
@@ -148,9 +149,9 @@ Results are displayed with the `elp-results' command."
"Non-nil specifies ELP results sorting function.
These functions are currently available:
- elp-sort-by-call-count -- sort by the highest call count
- elp-sort-by-total-time -- sort by the highest total time
- elp-sort-by-average-time -- sort by the highest average times
+ `elp-sort-by-call-count' -- sort by the highest call count
+ `elp-sort-by-total-time' -- sort by the highest total time
+ `elp-sort-by-average-time' -- sort by the highest average times
You can write your own sort function. It should adhere to the
interface specified by the PREDICATE argument for `sort'.
@@ -167,7 +168,7 @@ If a number, no function that has been called fewer than that number
of times will be displayed in the output buffer. If nil, all
functions will be displayed."
:type '(choice integer
- (const :tag "Show All" nil))
+ (const :tag "Show All" nil))
:group 'elp)
(defcustom elp-use-standard-output nil
@@ -193,9 +194,6 @@ In other words, a new unique buffer is create every time you run
(defconst elp-timer-info-property 'elp-info
"ELP information property name.")
-(defvar elp-all-instrumented-list nil
- "List of all functions currently being instrumented.")
-
(defvar elp-record-p t
"Controls whether functions should record times or not.
This variable is set by the master function.")
@@ -205,7 +203,7 @@ This variable is set by the master function.")
(defvar elp-not-profilable
;; First, the functions used inside each instrumented function:
- '(elp-wrapper called-interactively-p
+ '(called-interactively-p
;; Then the functions used by the above functions. I used
;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x))
;; (aref (symbol-function 'elp-wrapper) 2)))
@@ -223,60 +221,21 @@ them would thus lead to infinite recursion.")
(fboundp fun)
(not (or (memq fun elp-not-profilable)
(keymapp fun)
- (memq (car-safe (symbol-function fun)) '(autoload macro))
- (condition-case nil
- (when (subrp (indirect-function fun))
- (eq 'unevalled
- (cdr (subr-arity (indirect-function fun)))))
- (error nil))))))
+ (autoloadp (symbol-function fun)) ;FIXME: Why not just load it?
+ (special-form-p fun)))))
+(defconst elp--advice-name 'ELP-instrumentation\ )
;;;###autoload
(defun elp-instrument-function (funsym)
"Instrument FUNSYM for profiling.
FUNSYM must be a symbol of a defined function."
(interactive "aFunction to instrument: ")
- ;; restore the function. this is necessary to avoid infinite
- ;; recursion of already instrumented functions (i.e. elp-wrapper
- ;; calling elp-wrapper ad infinitum). it is better to simply
- ;; restore the function than to throw an error. this will work
- ;; properly in the face of eval-defun because if the function was
- ;; redefined, only the timer info will be nil'd out since
- ;; elp-restore-function is smart enough not to trash the new
- ;; definition.
- (elp-restore-function funsym)
- (let* ((funguts (symbol-function funsym))
- (infovec (vector 0 0 funguts))
- (newguts '(lambda (&rest args))))
- ;; we cannot profile macros
- (and (eq (car-safe funguts) 'macro)
- (error "ELP cannot profile macro: %s" funsym))
- ;; TBD: at some point it might be better to load the autoloaded
- ;; function instead of throwing an error. if we do this, then we
- ;; probably want elp-instrument-package to be updated with the
- ;; newly loaded list of functions. i'm not sure it's smart to do
- ;; the autoload here, since that could have side effects, and
- ;; elp-instrument-function is similar (in my mind) to defun-ish
- ;; type functionality (i.e. it shouldn't execute the function).
- (and (eq (car-safe funguts) 'autoload)
- (error "ELP cannot profile autoloaded function: %s" funsym))
+ (let* ((infovec (vector 0 0)))
;; We cannot profile functions used internally during profiling.
(unless (elp-profilable-p funsym)
(error "ELP cannot profile the function: %s" funsym))
- ;; put rest of newguts together
- (if (commandp funsym)
- (setq newguts (append newguts '((interactive)))))
- (setq newguts (append newguts `((elp-wrapper
- (quote ,funsym)
- ,(when (commandp funsym)
- '(called-interactively-p 'any))
- args))))
- ;; to record profiling times, we set the symbol's function
- ;; definition so that it runs the elp-wrapper function with the
- ;; function symbol as an argument. We place the old function
- ;; definition on the info vector.
- ;;
- ;; The info vector data structure is a 3 element vector. The 0th
+ ;; The info vector data structure is a 2 element vector. The 0th
;; element is the call-count, i.e. the total number of times this
;; function has been entered. This value is bumped up on entry to
;; the function so that non-local exists are still recorded. TBD:
@@ -285,72 +244,45 @@ FUNSYM must be a symbol of a defined function."
;; The 1st element is the total amount of time in seconds that has
;; been spent inside this function. This number is added to on
;; function exit.
- ;;
- ;; The 2nd element is the old function definition list. This gets
- ;; funcall'd in between start/end time retrievals. I believe that
- ;; this lets us profile even byte-compiled functions.
- ;; put the info vector on the property list
+ ;; Put the info vector on the property list.
(put funsym elp-timer-info-property infovec)
;; Set the symbol's new profiling function definition to run
- ;; elp-wrapper.
- (let ((advice-info (get funsym 'ad-advice-info)))
- (if advice-info
- (progn
- ;; If function is advised, don't let Advice change
- ;; its definition from under us during the `fset'.
- (put funsym 'ad-advice-info nil)
- (fset funsym newguts)
- (put funsym 'ad-advice-info advice-info))
- (fset funsym newguts)))
-
- ;; add this function to the instrumentation list
- (unless (memq funsym elp-all-instrumented-list)
- (push funsym elp-all-instrumented-list))))
+ ;; ELP wrapper.
+ (advice-add funsym :around (elp--make-wrapper funsym)
+ `((name . ,elp--advice-name)))))
+
+(defun elp--instrumented-p (sym)
+ (advice-member-p elp--advice-name sym))
(defun elp-restore-function (funsym)
"Restore an instrumented function to its original definition.
Argument FUNSYM is the symbol of a defined function."
- (interactive "aFunction to restore: ")
- (let ((info (get funsym elp-timer-info-property)))
- ;; delete the function from the all instrumented list
- (setq elp-all-instrumented-list
- (delq funsym elp-all-instrumented-list))
-
- ;; if the function was the master, reset the master
- (if (eq funsym elp-master)
- (setq elp-master nil
- elp-record-p t))
-
- ;; zap the properties
- (put funsym elp-timer-info-property nil)
-
- ;; restore the original function definition, but if the function
- ;; wasn't instrumented do nothing. we do this after the above
- ;; because its possible the function got un-instrumented due to
- ;; circumstances beyond our control. Also, check to make sure
- ;; that the current function symbol points to elp-wrapper. If
- ;; not, then the user probably did an eval-defun, or loaded a
- ;; byte-compiled version, while the function was instrumented and
- ;; we don't want to destroy the new definition. can it ever be
- ;; the case that a lisp function can be compiled instrumented?
- (and info
- (functionp funsym)
- (not (byte-code-function-p (symbol-function funsym)))
- (assq 'elp-wrapper (symbol-function funsym))
- (fset funsym (aref info 2)))))
+ (interactive
+ (list
+ (intern
+ (completing-read "Function to restore: " obarray
+ #'elp--instrumented-p t))))
+ ;; If the function was the master, reset the master.
+ (if (eq funsym elp-master)
+ (setq elp-master nil
+ elp-record-p t))
+
+ ;; Zap the properties.
+ (put funsym elp-timer-info-property nil)
+
+ (advice-remove funsym elp--advice-name))
;;;###autoload
(defun elp-instrument-list (&optional list)
"Instrument, for profiling, all functions in `elp-function-list'.
Use optional LIST if provided instead.
If called interactively, read LIST using the minibuffer."
- (interactive "PList of functions to instrument: ")
+ (interactive "PList of functions to instrument: ") ;FIXME: Doesn't work?!
(unless (listp list)
(signal 'wrong-type-argument (list 'listp list)))
- (let ((list (or list elp-function-list)))
- (mapcar 'elp-instrument-function list)))
+ (mapcar #'elp-instrument-function (or list elp-function-list)))
;;;###autoload
(defun elp-instrument-package (prefix)
@@ -371,15 +303,13 @@ For example, to instrument all ELP functions, do the following:
(defun elp-restore-list (&optional list)
"Restore the original definitions for all functions in `elp-function-list'.
Use optional LIST if provided instead."
- (interactive "PList of functions to restore: ")
- (let ((list (or list elp-function-list)))
- (mapcar 'elp-restore-function list)))
+ (interactive "PList of functions to restore: ") ;FIXME: Doesn't work!?
+ (mapcar #'elp-restore-function (or list elp-function-list)))
(defun elp-restore-all ()
"Restore the original definitions of all functions being profiled."
(interactive)
- (elp-restore-list elp-all-instrumented-list))
-
+ (mapatoms #'elp-restore-function))
(defun elp-reset-function (funsym)
"Reset the profiling information for FUNSYM."
@@ -395,30 +325,36 @@ Use optional LIST if provided instead."
(defun elp-reset-list (&optional list)
"Reset the profiling information for all functions in `elp-function-list'.
Use optional LIST if provided instead."
- (interactive "PList of functions to reset: ")
+ (interactive "PList of functions to reset: ") ;FIXME: Doesn't work!?
(let ((list (or list elp-function-list)))
(mapcar 'elp-reset-function list)))
(defun elp-reset-all ()
"Reset the profiling information for all functions being profiled."
(interactive)
- (elp-reset-list elp-all-instrumented-list))
+ (mapatoms (lambda (sym)
+ (if (get sym elp-timer-info-property)
+ (elp-reset-function sym)))))
(defun elp-set-master (funsym)
"Set the master function for profiling."
- (interactive "aMaster function: ")
- ;; when there's a master function, recording is turned off by
- ;; default
+ (interactive
+ (list
+ (intern
+ (completing-read "Master function: " obarray
+ #'elp--instrumented-p
+ t nil nil (if elp-master (symbol-name elp-master))))))
+ ;; When there's a master function, recording is turned off by default.
(setq elp-master funsym
elp-record-p nil)
- ;; make sure master function is instrumented
- (or (memq funsym elp-all-instrumented-list)
+ ;; Make sure master function is instrumented.
+ (or (elp--instrumented-p funsym)
(elp-instrument-function funsym)))
(defun elp-unset-master ()
"Unset the master function."
(interactive)
- ;; when there's no master function, recording is turned on by default.
+ ;; When there's no master function, recording is turned on by default.
(setq elp-master nil
elp-record-p t))
@@ -426,49 +362,40 @@ Use optional LIST if provided instead."
(defsubst elp-elapsed-time (start end)
(float-time (time-subtract end start)))
-(defun elp-wrapper (funsym interactive-p args)
- "This function has been instrumented for profiling by the ELP.
+(defun elp--make-wrapper (funsym)
+ "Make the piece of advice that instruments FUNSYM."
+ (lambda (func &rest args)
+ "This function has been instrumented for profiling by the ELP.
ELP is the Emacs Lisp Profiler. To restore the function to its
original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
- ;; turn on recording if this is the master function
- (if (and elp-master
- (eq funsym elp-master))
- (setq elp-record-p t))
- ;; get info vector and original function symbol
- (let* ((info (get funsym elp-timer-info-property))
- (func (aref info 2))
- result)
- (or func
- (error "%s is not instrumented for profiling" funsym))
- (if (not elp-record-p)
- ;; when not recording, just call the original function symbol
- ;; and return the results.
- (setq result
- (if interactive-p
- (call-interactively func)
- (apply func args)))
- ;; we are recording times
- (let (enter-time exit-time)
- ;; increment the call-counter
- (aset info 0 (1+ (aref info 0)))
- ;; now call the old symbol function, checking to see if it
- ;; should be called interactively. make sure we return the
- ;; correct value
- (if interactive-p
- (setq enter-time (current-time)
- result (call-interactively func)
- exit-time (current-time))
+ ;; turn on recording if this is the master function
+ (if (and elp-master
+ (eq funsym elp-master))
+ (setq elp-record-p t))
+ ;; get info vector and original function symbol
+ (let* ((info (get funsym elp-timer-info-property))
+ result)
+ (or func
+ (error "%s is not instrumented for profiling" funsym))
+ (if (not elp-record-p)
+ ;; when not recording, just call the original function symbol
+ ;; and return the results.
+ (setq result (apply func args))
+ ;; we are recording times
+ (let (enter-time exit-time)
+ ;; increment the call-counter
+ (cl-incf (aref info 0))
(setq enter-time (current-time)
result (apply func args)
- exit-time (current-time)))
- ;; calculate total time in function
- (aset info 1 (+ (aref info 1) (elp-elapsed-time enter-time exit-time)))
- ))
- ;; turn off recording if this is the master function
- (if (and elp-master
- (eq funsym elp-master))
- (setq elp-record-p nil))
- result))
+ exit-time (current-time))
+ ;; calculate total time in function
+ (cl-incf (aref info 1) (elp-elapsed-time enter-time exit-time))
+ ))
+ ;; turn off recording if this is the master function
+ (if (and elp-master
+ (eq funsym elp-master))
+ (setq elp-record-p nil))
+ result)))
;; shut the byte-compiler up
@@ -582,57 +509,58 @@ displayed."
(elp-et-len (length et-header))
(at-header "Average Time")
(elp-at-len (length at-header))
- (resvec
- (mapcar
- (function
- (lambda (funsym)
- (let* ((info (get funsym elp-timer-info-property))
- (symname (format "%s" funsym))
- (cc (aref info 0))
- (tt (aref info 1)))
- (if (not info)
- (insert "No profiling information found for: "
- symname)
- (setq longest (max longest (length symname)))
- (vector cc tt (if (zerop cc)
- 0.0 ;avoid arithmetic div-by-zero errors
- (/ (float tt) (float cc)))
- symname)))))
- elp-all-instrumented-list))
+ (resvec '())
) ; end let*
+ (mapatoms
+ (lambda (funsym)
+ (when (elp--instrumented-p funsym)
+ (let* ((info (get funsym elp-timer-info-property))
+ (symname (format "%s" funsym))
+ (cc (aref info 0))
+ (tt (aref info 1)))
+ (if (not info)
+ (insert "No profiling information found for: "
+ symname)
+ (setq longest (max longest (length symname)))
+ (push
+ (vector cc tt (if (zerop cc)
+ 0.0 ;avoid arithmetic div-by-zero errors
+ (/ (float tt) (float cc)))
+ symname)
+ resvec))))))
;; If printing to stdout, insert the header so it will print.
;; Otherwise use header-line-format.
(setq elp-field-len (max titlelen longest))
(if (or elp-use-standard-output noninteractive)
- (progn
- (insert title)
- (if (> longest titlelen)
- (progn
- (insert-char 32 (- longest titlelen))))
- (insert " " cc-header " " et-header " " at-header "\n")
- (insert-char ?= elp-field-len)
- (insert " ")
- (insert-char ?= elp-cc-len)
- (insert " ")
- (insert-char ?= elp-et-len)
- (insert " ")
- (insert-char ?= elp-at-len)
- (insert "\n"))
- (let ((column 0))
- (setq header-line-format
- (mapconcat
- (lambda (title)
- (prog1
- (concat
- (propertize " "
- 'display (list 'space :align-to column)
- 'face 'fixed-pitch)
- title)
- (setq column (+ column 2
- (if (= column 0)
- elp-field-len
- (length title))))))
- (list title cc-header et-header at-header) ""))))
+ (progn
+ (insert title)
+ (if (> longest titlelen)
+ (progn
+ (insert-char 32 (- longest titlelen))))
+ (insert " " cc-header " " et-header " " at-header "\n")
+ (insert-char ?= elp-field-len)
+ (insert " ")
+ (insert-char ?= elp-cc-len)
+ (insert " ")
+ (insert-char ?= elp-et-len)
+ (insert " ")
+ (insert-char ?= elp-at-len)
+ (insert "\n"))
+ (let ((column 0))
+ (setq header-line-format
+ (mapconcat
+ (lambda (title)
+ (prog1
+ (concat
+ (propertize " "
+ 'display (list 'space :align-to column)
+ 'face 'fixed-pitch)
+ title)
+ (setq column (+ column 2
+ (if (= column 0)
+ elp-field-len
+ (length title))))))
+ (list title cc-header et-header at-header) ""))))
;; if sorting is enabled, then sort the results list. in either
;; case, call elp-output-result to output the result in the
;; buffer
@@ -644,7 +572,7 @@ displayed."
(pop-to-buffer resultsbuf)
;; copy results to standard-output?
(if (or elp-use-standard-output noninteractive)
- (princ (buffer-substring (point-min) (point-max)))
+ (princ (buffer-substring (point-min) (point-max)))
(goto-char (point-min)))
;; reset profiling info if desired
(and elp-reset-after-results
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 39d4a4e814a..60d74774e87 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -1,24 +1,24 @@
-;;; ert-x.el --- Staging area for experimental extensions to ERT
+;;; ert-x.el --- Staging area for experimental extensions to ERT -*- lexical-binding: t -*-
-;; Copyright (C) 2008, 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc.
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
-;; Author: Christian Ohler <ohler@gnu.org>
+;; Christian Ohler <ohler@gnu.org>
;; 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:
@@ -28,8 +28,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'ert)
@@ -90,8 +89,8 @@ ERT--THUNK with that buffer as current."
(kill-buffer ert--buffer)
(remhash ert--buffer ert--test-buffers))))
-(defmacro* ert-with-test-buffer ((&key ((:name name-form)))
- &body body)
+(cl-defmacro ert-with-test-buffer ((&key ((:name name-form)))
+ &body body)
"Create a test buffer and run BODY in that buffer.
To be used in ERT tests. If BODY finishes successfully, the test
@@ -116,10 +115,10 @@ the name of the test and the result of NAME-FORM."
"Kill all test buffers that are still live."
(interactive)
(let ((count 0))
- (maphash (lambda (buffer dummy)
+ (maphash (lambda (buffer _dummy)
(when (or (not (buffer-live-p buffer))
(kill-buffer buffer))
- (incf count)))
+ (cl-incf count)))
ert--test-buffers)
(message "%s out of %s test buffers killed"
count (hash-table-count ert--test-buffers)))
@@ -149,9 +148,9 @@ the rest are arguments to the command.
NOTE: Since the command is not called by `call-interactively'
test for `called-interactively' in the command will fail."
- (assert (listp command) t)
- (assert (commandp (car command)) t)
- (assert (not unread-command-events) t)
+ (cl-assert (listp command) t)
+ (cl-assert (commandp (car command)) t)
+ (cl-assert (not unread-command-events) t)
(let (return-value)
;; For the order of things here see command_loop_1 in keyboard.c.
;;
@@ -167,14 +166,15 @@ test for `called-interactively' in the command will fail."
(run-hooks 'pre-command-hook)
(setq return-value (apply (car command) (cdr command)))
(run-hooks 'post-command-hook)
- (when deferred-action-list
- (run-hooks 'deferred-action-function))
+ (and (boundp 'deferred-action-list)
+ deferred-action-list
+ (run-hooks 'deferred-action-function))
(setq real-last-command (car command)
last-command this-command)
(when (boundp 'last-repeatable-command)
(setq last-repeatable-command real-last-command))
(when (and deactivate-mark transient-mark-mode) (deactivate-mark))
- (assert (not unread-command-events) t)
+ (cl-assert (not unread-command-events) t)
return-value))
(defun ert-run-idle-timers ()
@@ -197,7 +197,7 @@ rather than the entire match."
(with-temp-buffer
(insert s)
(dolist (x regexps)
- (destructuring-bind (regexp subexp) (if (listp x) x `(,x nil))
+ (cl-destructuring-bind (regexp subexp) (if (listp x) x `(,x nil))
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(replace-match "" t t nil subexp))))
@@ -223,15 +223,15 @@ would return the string \"foo bar baz quux\" where the substring
None of the ARGS are modified, but the return value may share
structure with the plists in ARGS."
(with-temp-buffer
- (loop with current-plist = nil
- for x in args do
- (etypecase x
- (string (let ((begin (point)))
- (insert x)
- (set-text-properties begin (point) current-plist)))
- (list (unless (zerop (mod (length x) 2))
- (error "Odd number of args in plist: %S" x))
- (setq current-plist x))))
+ (cl-loop with current-plist = nil
+ for x in args do
+ (cl-etypecase x
+ (string (let ((begin (point)))
+ (insert x)
+ (set-text-properties begin (point) current-plist)))
+ (list (unless (zerop (mod (length x) 2))
+ (error "Odd number of args in plist: %S" x))
+ (setq current-plist x))))
(buffer-string)))
@@ -244,8 +244,8 @@ buffer, and renames the original buffer back to BUFFER-NAME.
This is useful if THUNK has undesirable side-effects on an Emacs
buffer with a fixed name such as *Messages*."
- (lexical-let ((new-buffer-name (generate-new-buffer-name
- (format "%s orig buffer" buffer-name))))
+ (let ((new-buffer-name (generate-new-buffer-name
+ (format "%s orig buffer" buffer-name))))
(with-current-buffer (get-buffer-create buffer-name)
(rename-buffer new-buffer-name))
(unwind-protect
@@ -257,7 +257,7 @@ buffer with a fixed name such as *Messages*."
(with-current-buffer new-buffer-name
(rename-buffer buffer-name)))))
-(defmacro* ert-with-buffer-renamed ((buffer-name-form) &body body)
+(cl-defmacro ert-with-buffer-renamed ((buffer-name-form) &body body)
"Protect the buffer named BUFFER-NAME from side-effects and run BODY.
See `ert-call-with-buffer-renamed' for details."
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 820519e92d8..ab6dcb58143 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1,24 +1,24 @@
-;;; ert.el --- Emacs Lisp Regression Testing
+;;; ert.el --- Emacs Lisp Regression Testing -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2008, 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc.
;; Author: Christian Ohler <ohler@gnu.org>
;; Keywords: lisp, tools
;; 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:
@@ -54,8 +54,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'button)
(require 'debug)
(require 'easymenu)
@@ -105,33 +104,33 @@
"A reimplementation of `remove-if-not'.
ERT-PRED is a predicate, ERT-LIST is the input list."
- (loop for ert-x in ert-list
- if (funcall ert-pred ert-x)
- collect ert-x))
+ (cl-loop for ert-x in ert-list
+ if (funcall ert-pred ert-x)
+ collect ert-x))
(defun ert--intersection (a b)
"A reimplementation of `intersection'. Intersect the sets A and B.
Elements are compared using `eql'."
- (loop for x in a
- if (memql x b)
- collect x))
+ (cl-loop for x in a
+ if (memql x b)
+ collect x))
(defun ert--set-difference (a b)
"A reimplementation of `set-difference'. Subtract the set B from the set A.
Elements are compared using `eql'."
- (loop for x in a
- unless (memql x b)
- collect x))
+ (cl-loop for x in a
+ unless (memql x b)
+ collect x))
(defun ert--set-difference-eq (a b)
"A reimplementation of `set-difference'. Subtract the set B from the set A.
Elements are compared using `eq'."
- (loop for x in a
- unless (memq x b)
- collect x))
+ (cl-loop for x in a
+ unless (memq x b)
+ collect x))
(defun ert--union (a b)
"A reimplementation of `union'. Compute the union of the sets A and B.
@@ -149,7 +148,7 @@ Elements are compared using `eql'."
(make-symbol (format "%s%s"
prefix
(prog1 ert--gensym-counter
- (incf ert--gensym-counter))))))
+ (cl-incf ert--gensym-counter))))))
(defun ert--coerce-to-vector (x)
"Coerce X to a vector."
@@ -158,19 +157,19 @@ Elements are compared using `eql'."
x
(vconcat x)))
-(defun* ert--remove* (x list &key key test)
+(cl-defun ert--remove* (x list &key key test)
"Does not support all the keywords of remove*."
(unless key (setq key #'identity))
(unless test (setq test #'eql))
- (loop for y in list
- unless (funcall test x (funcall key y))
- collect y))
+ (cl-loop for y in list
+ unless (funcall test x (funcall key y))
+ collect y))
(defun ert--string-position (c s)
"Return the position of the first occurrence of C in S, or nil if none."
- (loop for i from 0
- for x across s
- when (eql x c) return i))
+ (cl-loop for i from 0
+ for x across s
+ when (eql x c) return i))
(defun ert--mismatch (a b)
"Return index of first element that differs between A and B.
@@ -184,29 +183,30 @@ Like `mismatch'. Uses `equal' for comparison."
(t
(let ((la (length a))
(lb (length b)))
- (assert (arrayp a) t)
- (assert (arrayp b) t)
- (assert (<= la lb) t)
- (loop for i below la
- when (not (equal (aref a i) (aref b i))) return i
- finally (return (if (/= la lb)
- la
- (assert (equal a b) t)
- nil)))))))
+ (cl-assert (arrayp a) t)
+ (cl-assert (arrayp b) t)
+ (cl-assert (<= la lb) t)
+ (cl-loop for i below la
+ when (not (equal (aref a i) (aref b i))) return i
+ finally (cl-return (if (/= la lb)
+ la
+ (cl-assert (equal a b) t)
+ nil)))))))
(defun ert--subseq (seq start &optional end)
"Return a subsequence of SEQ from START to END."
(when (char-table-p seq) (error "Not supported"))
(let ((vector (substring (ert--coerce-to-vector seq) start end)))
- (etypecase seq
+ (cl-etypecase seq
(vector vector)
(string (concat vector))
(list (append vector nil))
- (bool-vector (loop with result = (make-bool-vector (length vector) nil)
- for i below (length vector) do
- (setf (aref result i) (aref vector i))
- finally (return result)))
- (char-table (assert nil)))))
+ (bool-vector (cl-loop with result
+ = (make-bool-vector (length vector) nil)
+ for i below (length vector) do
+ (setf (aref result i) (aref vector i))
+ finally (cl-return result)))
+ (char-table (cl-assert nil)))))
(defun ert-equal-including-properties (a b)
"Return t if A and B have similar structure and contents.
@@ -225,10 +225,10 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'."
;;; Defining and locating tests.
;; The data structure that represents a test case.
-(defstruct ert-test
+(cl-defstruct ert-test
(name nil)
(documentation nil)
- (body (assert nil))
+ (body (cl-assert nil))
(most-recent-result nil)
(expected-result-type ':passed)
(tags '()))
@@ -273,7 +273,7 @@ Returns a two-element list containing the keys-and-values plist
and the body."
(let ((extracted-key-accu '())
(remaining keys-and-body))
- (while (and (consp remaining) (keywordp (first remaining)))
+ (while (keywordp (car-safe remaining))
(let ((keyword (pop remaining)))
(unless (consp remaining)
(error "Value expected after keyword %S in %S"
@@ -283,13 +283,13 @@ and the body."
keys-and-body))
(push (cons keyword (pop remaining)) extracted-key-accu)))
(setq extracted-key-accu (nreverse extracted-key-accu))
- (list (loop for (key . value) in extracted-key-accu
- collect key
- collect value)
+ (list (cl-loop for (key . value) in extracted-key-accu
+ collect key
+ collect value)
remaining)))
;;;###autoload
-(defmacro* ert-deftest (name () &body docstring-keys-and-body)
+(cl-defmacro ert-deftest (name () &body docstring-keys-and-body)
"Define NAME (a symbol) as a test.
BODY is evaluated as a `progn' when the test is run. It should
@@ -313,12 +313,13 @@ description of valid values for RESULT-TYPE.
(indent 2))
(let ((documentation nil)
(documentation-supplied-p nil))
- (when (stringp (first docstring-keys-and-body))
+ (when (stringp (car docstring-keys-and-body))
(setq documentation (pop docstring-keys-and-body)
documentation-supplied-p t))
- (destructuring-bind ((&key (expected-result nil expected-result-supplied-p)
- (tags nil tags-supplied-p))
- body)
+ (cl-destructuring-bind
+ ((&key (expected-result nil expected-result-supplied-p)
+ (tags nil tags-supplied-p))
+ body)
(ert--parse-keys-and-body docstring-keys-and-body)
`(progn
(ert-set-test ',name
@@ -388,16 +389,11 @@ DATA is displayed to the user and should state the reason of the failure."
(defun ert--expand-should-1 (whole form inner-expander)
"Helper function for the `should' macro and its variants."
(let ((form
- ;; If `cl-macroexpand' isn't bound, the code that we're
- ;; compiling doesn't depend on cl and thus doesn't need an
- ;; environment arg for `macroexpand'.
- (if (fboundp 'cl-macroexpand)
- ;; Suppress warning about run-time call to cl function: we
- ;; only call it if it's fboundp.
- (with-no-warnings
- (cl-macroexpand form (and (boundp 'cl-macro-environment)
- cl-macro-environment)))
- (macroexpand form))))
+ (macroexpand form (cond
+ ((boundp 'macroexpand-all-environment)
+ macroexpand-all-environment)
+ ((boundp 'cl-macro-environment)
+ cl-macro-environment)))))
(cond
((or (atom form) (ert--special-operator-p (car form)))
(let ((value (ert--gensym "value-")))
@@ -410,10 +406,10 @@ DATA is displayed to the user and should state the reason of the failure."
(t
(let ((fn-name (car form))
(arg-forms (cdr form)))
- (assert (or (symbolp fn-name)
- (and (consp fn-name)
- (eql (car fn-name) 'lambda)
- (listp (cdr fn-name)))))
+ (cl-assert (or (symbolp fn-name)
+ (and (consp fn-name)
+ (eql (car fn-name) 'lambda)
+ (listp (cdr fn-name)))))
(let ((fn (ert--gensym "fn-"))
(args (ert--gensym "args-"))
(value (ert--gensym "value-"))
@@ -451,35 +447,34 @@ should return code that calls INNER-FORM and performs the checks
and error signaling specific to the particular variant of
`should'. The code that INNER-EXPANDER returns must not call
FORM-DESCRIPTION-FORM before it has called INNER-FORM."
- (lexical-let ((inner-expander inner-expander))
- (ert--expand-should-1
- whole form
- (lambda (inner-form form-description-form value-var)
- (let ((form-description (ert--gensym "form-description-")))
- `(let (,form-description)
- ,(funcall inner-expander
- `(unwind-protect
- ,inner-form
- (setq ,form-description ,form-description-form)
- (ert--signal-should-execution ,form-description))
- `,form-description
- value-var)))))))
-
-(defmacro* should (form)
+ (ert--expand-should-1
+ whole form
+ (lambda (inner-form form-description-form value-var)
+ (let ((form-description (ert--gensym "form-description-")))
+ `(let (,form-description)
+ ,(funcall inner-expander
+ `(unwind-protect
+ ,inner-form
+ (setq ,form-description ,form-description-form)
+ (ert--signal-should-execution ,form-description))
+ `,form-description
+ value-var))))))
+
+(cl-defmacro should (form)
"Evaluate FORM. If it returns nil, abort the current test as failed.
Returns the value of FORM."
(ert--expand-should `(should ,form) form
- (lambda (inner-form form-description-form value-var)
+ (lambda (inner-form form-description-form _value-var)
`(unless ,inner-form
(ert-fail ,form-description-form)))))
-(defmacro* should-not (form)
+(cl-defmacro should-not (form)
"Evaluate FORM. If it returns non-nil, abort the current test as failed.
Returns nil."
(ert--expand-should `(should-not ,form) form
- (lambda (inner-form form-description-form value-var)
+ (lambda (inner-form form-description-form _value-var)
`(unless (not ,inner-form)
(ert-fail ,form-description-form)))))
@@ -490,10 +485,10 @@ Returns nil."
Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES,
and aborts the current test as failed if it doesn't."
(let ((signaled-conditions (get (car condition) 'error-conditions))
- (handled-conditions (etypecase type
+ (handled-conditions (cl-etypecase type
(list type)
(symbol (list type)))))
- (assert signaled-conditions)
+ (cl-assert signaled-conditions)
(unless (ert--intersection signaled-conditions handled-conditions)
(ert-fail (append
(funcall form-description-fn)
@@ -512,7 +507,7 @@ and aborts the current test as failed if it doesn't."
;; FIXME: The expansion will evaluate the keyword args (if any) in
;; nonstandard order.
-(defmacro* should-error (form &rest keys &key type exclude-subtypes)
+(cl-defmacro should-error (form &rest keys &key type exclude-subtypes)
"Evaluate FORM and check that it signals an error.
The error signaled needs to match TYPE. TYPE should be a list
@@ -560,19 +555,19 @@ failed."
(defun ert--proper-list-p (x)
"Return non-nil if X is a proper list, nil otherwise."
- (loop
+ (cl-loop
for firstp = t then nil
for fast = x then (cddr fast)
for slow = x then (cdr slow) do
- (when (null fast) (return t))
- (when (not (consp fast)) (return nil))
- (when (null (cdr fast)) (return t))
- (when (not (consp (cdr fast))) (return nil))
- (when (and (not firstp) (eq fast slow)) (return nil))))
+ (when (null fast) (cl-return t))
+ (when (not (consp fast)) (cl-return nil))
+ (when (null (cdr fast)) (cl-return t))
+ (when (not (consp (cdr fast))) (cl-return nil))
+ (when (and (not firstp) (eq fast slow)) (cl-return nil))))
(defun ert--explain-format-atom (x)
"Format the atom X for `ert--explain-equal'."
- (typecase x
+ (cl-typecase x
(fixnum (list x (format "#x%x" x) (format "?%c" x)))
(t x)))
@@ -581,7 +576,7 @@ failed."
Returns nil if they are."
(if (not (equal (type-of a) (type-of b)))
`(different-types ,a ,b)
- (etypecase a
+ (cl-etypecase a
(cons
(let ((a-proper-p (ert--proper-list-p a))
(b-proper-p (ert--proper-list-p b)))
@@ -593,19 +588,19 @@ Returns nil if they are."
,a ,b
first-mismatch-at
,(ert--mismatch a b))
- (loop for i from 0
- for ai in a
- for bi in b
- for xi = (ert--explain-equal-rec ai bi)
- do (when xi (return `(list-elt ,i ,xi)))
- finally (assert (equal a b) t)))
+ (cl-loop for i from 0
+ for ai in a
+ for bi in b
+ for xi = (ert--explain-equal-rec ai bi)
+ do (when xi (cl-return `(list-elt ,i ,xi)))
+ finally (cl-assert (equal a b) t)))
(let ((car-x (ert--explain-equal-rec (car a) (car b))))
(if car-x
`(car ,car-x)
(let ((cdr-x (ert--explain-equal-rec (cdr a) (cdr b))))
(if cdr-x
`(cdr ,cdr-x)
- (assert (equal a b) t)
+ (cl-assert (equal a b) t)
nil))))))))
(array (if (not (equal (length a) (length b)))
`(arrays-of-different-length ,(length a) ,(length b)
@@ -613,12 +608,12 @@ Returns nil if they are."
,@(unless (char-table-p a)
`(first-mismatch-at
,(ert--mismatch a b))))
- (loop for i from 0
- for ai across a
- for bi across b
- for xi = (ert--explain-equal-rec ai bi)
- do (when xi (return `(array-elt ,i ,xi)))
- finally (assert (equal a b) t))))
+ (cl-loop for i from 0
+ for ai across a
+ for bi across b
+ for xi = (ert--explain-equal-rec ai bi)
+ do (when xi (cl-return `(array-elt ,i ,xi)))
+ finally (cl-assert (equal a b) t))))
(atom (if (not (equal a b))
(if (and (symbolp a) (symbolp b) (string= a b))
`(different-symbols-with-the-same-name ,a ,b)
@@ -637,10 +632,10 @@ Returns nil if they are."
(defun ert--significant-plist-keys (plist)
"Return the keys of PLIST that have non-null values, in order."
- (assert (zerop (mod (length plist) 2)) t)
- (loop for (key value . rest) on plist by #'cddr
- unless (or (null value) (memq key accu)) collect key into accu
- finally (return accu)))
+ (cl-assert (zerop (mod (length plist) 2)) t)
+ (cl-loop for (key value . rest) on plist by #'cddr
+ unless (or (null value) (memq key accu)) collect key into accu
+ finally (cl-return accu)))
(defun ert--plist-difference-explanation (a b)
"Return a programmer-readable explanation of why A and B are different plists.
@@ -648,8 +643,8 @@ Returns nil if they are."
Returns nil if they are equivalent, i.e., have the same value for
each key, where absent values are treated as nil. The order of
key/value pairs in each list does not matter."
- (assert (zerop (mod (length a) 2)) t)
- (assert (zerop (mod (length b) 2)) t)
+ (cl-assert (zerop (mod (length a) 2)) t)
+ (cl-assert (zerop (mod (length b) 2)) t)
;; Normalizing the plists would be another way to do this but it
;; requires a total ordering on all lisp objects (since any object
;; is valid as a text property key). Perhaps defining such an
@@ -659,21 +654,21 @@ key/value pairs in each list does not matter."
(keys-b (ert--significant-plist-keys b))
(keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b))
(keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a)))
- (flet ((explain-with-key (key)
- (let ((value-a (plist-get a key))
- (value-b (plist-get b key)))
- (assert (not (equal value-a value-b)) t)
- `(different-properties-for-key
- ,key ,(ert--explain-equal-including-properties value-a
- value-b)))))
+ (cl-flet ((explain-with-key (key)
+ (let ((value-a (plist-get a key))
+ (value-b (plist-get b key)))
+ (cl-assert (not (equal value-a value-b)) t)
+ `(different-properties-for-key
+ ,key ,(ert--explain-equal-including-properties value-a
+ value-b)))))
(cond (keys-in-a-not-in-b
- (explain-with-key (first keys-in-a-not-in-b)))
+ (explain-with-key (car keys-in-a-not-in-b)))
(keys-in-b-not-in-a
- (explain-with-key (first keys-in-b-not-in-a)))
+ (explain-with-key (car keys-in-b-not-in-a)))
(t
- (loop for key in keys-a
- when (not (equal (plist-get a key) (plist-get b key)))
- return (explain-with-key key)))))))
+ (cl-loop for key in keys-a
+ when (not (equal (plist-get a key) (plist-get b key)))
+ return (explain-with-key key)))))))
(defun ert--abbreviate-string (s len suffixp)
"Shorten string S to at most LEN chars.
@@ -697,29 +692,30 @@ Returns a programmer-readable explanation of why A and B are not
`ert-equal-including-properties', or nil if they are."
(if (not (equal a b))
(ert--explain-equal a b)
- (assert (stringp a) t)
- (assert (stringp b) t)
- (assert (eql (length a) (length b)) t)
- (loop for i from 0 to (length a)
- for props-a = (text-properties-at i a)
- for props-b = (text-properties-at i b)
- for difference = (ert--plist-difference-explanation props-a props-b)
- do (when difference
- (return `(char ,i ,(substring-no-properties a i (1+ i))
- ,difference
- context-before
- ,(ert--abbreviate-string
- (substring-no-properties a 0 i)
- 10 t)
- context-after
- ,(ert--abbreviate-string
- (substring-no-properties a (1+ i))
- 10 nil))))
- ;; TODO(ohler): Get `equal-including-properties' fixed in
- ;; Emacs, delete `ert-equal-including-properties', and
- ;; re-enable this assertion.
- ;;finally (assert (equal-including-properties a b) t)
- )))
+ (cl-assert (stringp a) t)
+ (cl-assert (stringp b) t)
+ (cl-assert (eql (length a) (length b)) t)
+ (cl-loop for i from 0 to (length a)
+ for props-a = (text-properties-at i a)
+ for props-b = (text-properties-at i b)
+ for difference = (ert--plist-difference-explanation
+ props-a props-b)
+ do (when difference
+ (cl-return `(char ,i ,(substring-no-properties a i (1+ i))
+ ,difference
+ context-before
+ ,(ert--abbreviate-string
+ (substring-no-properties a 0 i)
+ 10 t)
+ context-after
+ ,(ert--abbreviate-string
+ (substring-no-properties a (1+ i))
+ 10 nil))))
+ ;; TODO(ohler): Get `equal-including-properties' fixed in
+ ;; Emacs, delete `ert-equal-including-properties', and
+ ;; re-enable this assertion.
+ ;;finally (cl-assert (equal-including-properties a b) t)
+ )))
(put 'ert-equal-including-properties
'ert-explainer
'ert--explain-equal-including-properties)
@@ -734,8 +730,8 @@ Returns a programmer-readable explanation of why A and B are not
Bound dynamically. This is a list of (PREFIX . MESSAGE) pairs.")
-(defmacro* ert-info ((message-form &key ((:prefix prefix-form) "Info: "))
- &body body)
+(cl-defmacro ert-info ((message-form &key ((:prefix prefix-form) "Info: "))
+ &body body)
"Evaluate MESSAGE-FORM and BODY, and report the message if BODY fails.
To be used within ERT tests. MESSAGE-FORM should evaluate to a
@@ -755,18 +751,19 @@ and is displayed in front of the value of MESSAGE-FORM."
"Non-nil means enter debugger when a test fails or terminates with an error.")
;; The data structures that represent the result of running a test.
-(defstruct ert-test-result
+(cl-defstruct ert-test-result
(messages nil)
(should-forms nil)
)
-(defstruct (ert-test-passed (:include ert-test-result)))
-(defstruct (ert-test-result-with-condition (:include ert-test-result))
- (condition (assert nil))
- (backtrace (assert nil))
- (infos (assert nil)))
-(defstruct (ert-test-quit (:include ert-test-result-with-condition)))
-(defstruct (ert-test-failed (:include ert-test-result-with-condition)))
-(defstruct (ert-test-aborted-with-non-local-exit (:include ert-test-result)))
+(cl-defstruct (ert-test-passed (:include ert-test-result)))
+(cl-defstruct (ert-test-result-with-condition (:include ert-test-result))
+ (condition (cl-assert nil))
+ (backtrace (cl-assert nil))
+ (infos (cl-assert nil)))
+(cl-defstruct (ert-test-quit (:include ert-test-result-with-condition)))
+(cl-defstruct (ert-test-failed (:include ert-test-result-with-condition)))
+(cl-defstruct (ert-test-aborted-with-non-local-exit
+ (:include ert-test-result)))
(defun ert--record-backtrace ()
@@ -779,7 +776,7 @@ and is displayed in front of the value of MESSAGE-FORM."
;; `ert-results-pop-to-backtrace-for-test-at-point' given that we
;; already have `ert-results-rerun-test-debugging-errors-at-point'.
;; For batch use, however, printing the backtrace may be useful.
- (loop
+ (cl-loop
;; 6 is the number of frames our own debugger adds (when
;; compiled; more when interpreted). FIXME: Need to describe a
;; procedure for determining this constant.
@@ -796,33 +793,33 @@ and is displayed in front of the value of MESSAGE-FORM."
(print-level 8)
(print-length 50))
(dolist (frame backtrace)
- (ecase (first frame)
+ (cl-ecase (car frame)
((nil)
;; Special operator.
- (destructuring-bind (special-operator &rest arg-forms)
+ (cl-destructuring-bind (special-operator &rest arg-forms)
(cdr frame)
(insert
- (format " %S\n" (list* special-operator arg-forms)))))
+ (format " %S\n" (cons special-operator arg-forms)))))
((t)
;; Function call.
- (destructuring-bind (fn &rest args) (cdr frame)
+ (cl-destructuring-bind (fn &rest args) (cdr frame)
(insert (format " %S(" fn))
- (loop for firstp = t then nil
- for arg in args do
- (unless firstp
- (insert " "))
- (insert (format "%S" arg)))
+ (cl-loop for firstp = t then nil
+ for arg in args do
+ (unless firstp
+ (insert " "))
+ (insert (format "%S" arg)))
(insert ")\n")))))))
;; A container for the state of the execution of a single test and
;; environment data needed during its execution.
-(defstruct ert--test-execution-info
- (test (assert nil))
- (result (assert nil))
+(cl-defstruct ert--test-execution-info
+ (test (cl-assert nil))
+ (result (cl-assert nil))
;; A thunk that may be called when RESULT has been set to its final
;; value and test execution should be terminated. Should not
;; return.
- (exit-continuation (assert nil))
+ (exit-continuation (cl-assert nil))
;; The binding of `debugger' outside of the execution of the test.
next-debugger
;; The binding of `ert-debug-on-error' that is in effect for the
@@ -831,7 +828,7 @@ and is displayed in front of the value of MESSAGE-FORM."
;; don't remember whether this feature is important.)
ert-debug-on-error)
-(defun ert--run-test-debugger (info debugger-args)
+(defun ert--run-test-debugger (info args)
"During a test run, `debugger' is bound to a closure that calls this function.
This function records failures and errors and either terminates
@@ -839,21 +836,21 @@ the test silently or calls the interactive debugger, as
appropriate.
INFO is the ert--test-execution-info corresponding to this test
-run. DEBUGGER-ARGS are the arguments to `debugger'."
- (destructuring-bind (first-debugger-arg &rest more-debugger-args)
- debugger-args
- (ecase first-debugger-arg
+run. ARGS are the arguments to `debugger'."
+ (cl-destructuring-bind (first-debugger-arg &rest more-debugger-args)
+ args
+ (cl-ecase first-debugger-arg
((lambda debug t exit nil)
- (apply (ert--test-execution-info-next-debugger info) debugger-args))
+ (apply (ert--test-execution-info-next-debugger info) args))
(error
- (let* ((condition (first more-debugger-args))
- (type (case (car condition)
+ (let* ((condition (car more-debugger-args))
+ (type (cl-case (car condition)
((quit) 'quit)
(otherwise 'failed)))
(backtrace (ert--record-backtrace))
(infos (reverse ert--infos)))
(setf (ert--test-execution-info-result info)
- (ecase type
+ (cl-ecase type
(quit
(make-ert-test-quit :condition condition
:backtrace backtrace
@@ -862,41 +859,44 @@ run. DEBUGGER-ARGS are the arguments to `debugger'."
(make-ert-test-failed :condition condition
:backtrace backtrace
:infos infos))))
- ;; Work around Emacs' heuristic (in eval.c) for detecting
+ ;; Work around Emacs's heuristic (in eval.c) for detecting
;; errors in the debugger.
- (incf num-nonmacro-input-events)
+ (cl-incf num-nonmacro-input-events)
;; FIXME: We should probably implement more fine-grained
;; control a la non-t `debug-on-error' here.
(cond
((ert--test-execution-info-ert-debug-on-error info)
- (apply (ert--test-execution-info-next-debugger info) debugger-args))
+ (apply (ert--test-execution-info-next-debugger info) args))
(t))
(funcall (ert--test-execution-info-exit-continuation info)))))))
-(defun ert--run-test-internal (ert-test-execution-info)
- "Low-level function to run a test according to ERT-TEST-EXECUTION-INFO.
+(defun ert--run-test-internal (test-execution-info)
+ "Low-level function to run a test according to TEST-EXECUTION-INFO.
This mainly sets up debugger-related bindings."
- (lexical-let ((info ert-test-execution-info))
- (setf (ert--test-execution-info-next-debugger info) debugger
- (ert--test-execution-info-ert-debug-on-error info) ert-debug-on-error)
- (catch 'ert--pass
- ;; For now, each test gets its own temp buffer and its own
- ;; window excursion, just to be safe. If this turns out to be
- ;; too expensive, we can remove it.
- (with-temp-buffer
- (save-window-excursion
- (let ((debugger (lambda (&rest debugger-args)
- (ert--run-test-debugger info debugger-args)))
- (debug-on-error t)
- (debug-on-quit t)
- ;; FIXME: Do we need to store the old binding of this
- ;; and consider it in `ert--run-test-debugger'?
- (debug-ignored-errors nil)
- (ert--infos '()))
- (funcall (ert-test-body (ert--test-execution-info-test info))))))
- (ert-pass))
- (setf (ert--test-execution-info-result info) (make-ert-test-passed)))
+ (setf (ert--test-execution-info-next-debugger test-execution-info) debugger
+ (ert--test-execution-info-ert-debug-on-error test-execution-info)
+ ert-debug-on-error)
+ (catch 'ert--pass
+ ;; For now, each test gets its own temp buffer and its own
+ ;; window excursion, just to be safe. If this turns out to be
+ ;; too expensive, we can remove it.
+ (with-temp-buffer
+ (save-window-excursion
+ (let ((debugger (lambda (&rest args)
+ (ert--run-test-debugger test-execution-info
+ args)))
+ (debug-on-error t)
+ (debug-on-quit t)
+ ;; FIXME: Do we need to store the old binding of this
+ ;; and consider it in `ert--run-test-debugger'?
+ (debug-ignored-errors nil)
+ (ert--infos '()))
+ (funcall (ert-test-body (ert--test-execution-info-test
+ test-execution-info))))))
+ (ert-pass))
+ (setf (ert--test-execution-info-result test-execution-info)
+ (make-ert-test-passed))
nil)
(defun ert--force-message-log-buffer-truncation ()
@@ -934,18 +934,18 @@ The elements are of type `ert-test'.")
Returns the result and stores it in ERT-TEST's `most-recent-result' slot."
(setf (ert-test-most-recent-result ert-test) nil)
- (block error
- (lexical-let ((begin-marker
- (with-current-buffer (get-buffer-create "*Messages*")
- (set-marker (make-marker) (point-max)))))
+ (cl-block error
+ (let ((begin-marker
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (set-marker (make-marker) (point-max)))))
(unwind-protect
- (lexical-let ((info (make-ert--test-execution-info
- :test ert-test
- :result
- (make-ert-test-aborted-with-non-local-exit)
- :exit-continuation (lambda ()
- (return-from error nil))))
- (should-form-accu (list)))
+ (let ((info (make-ert--test-execution-info
+ :test ert-test
+ :result
+ (make-ert-test-aborted-with-non-local-exit)
+ :exit-continuation (lambda ()
+ (cl-return-from error nil))))
+ (should-form-accu (list)))
(unwind-protect
(let ((ert--should-execution-observer
(lambda (form-description)
@@ -987,32 +987,32 @@ t -- Always matches.
RESULT."
;; It would be easy to add `member' and `eql' types etc., but I
;; haven't bothered yet.
- (etypecase result-type
+ (cl-etypecase result-type
((member nil) nil)
((member t) t)
((member :failed) (ert-test-failed-p result))
((member :passed) (ert-test-passed-p result))
(cons
- (destructuring-bind (operator &rest operands) result-type
- (ecase operator
+ (cl-destructuring-bind (operator &rest operands) result-type
+ (cl-ecase operator
(and
- (case (length operands)
+ (cl-case (length operands)
(0 t)
(t
- (and (ert-test-result-type-p result (first operands))
- (ert-test-result-type-p result `(and ,@(rest operands)))))))
+ (and (ert-test-result-type-p result (car operands))
+ (ert-test-result-type-p result `(and ,@(cdr operands)))))))
(or
- (case (length operands)
+ (cl-case (length operands)
(0 nil)
(t
- (or (ert-test-result-type-p result (first operands))
- (ert-test-result-type-p result `(or ,@(rest operands)))))))
+ (or (ert-test-result-type-p result (car operands))
+ (ert-test-result-type-p result `(or ,@(cdr operands)))))))
(not
- (assert (eql (length operands) 1))
- (not (ert-test-result-type-p result (first operands))))
+ (cl-assert (eql (length operands) 1))
+ (not (ert-test-result-type-p result (car operands))))
(satisfies
- (assert (eql (length operands) 1))
- (funcall (first operands) result)))))))
+ (cl-assert (eql (length operands) 1))
+ (funcall (car operands) result)))))))
(defun ert-test-result-expected-p (test result)
"Return non-nil if TEST's expected result type matches RESULT."
@@ -1053,9 +1053,9 @@ set implied by them without checking whether it is really
contained in UNIVERSE."
;; This code needs to match the etypecase in
;; `ert-insert-human-readable-selector'.
- (etypecase selector
+ (cl-etypecase selector
((member nil) nil)
- ((member t) (etypecase universe
+ ((member t) (cl-etypecase universe
(list universe)
((member t) (ert-select-tests "" universe))))
((member :new) (ert-select-tests
@@ -1083,7 +1083,7 @@ contained in UNIVERSE."
universe))
((member :unexpected) (ert-select-tests `(not :expected) universe))
(string
- (etypecase universe
+ (cl-etypecase universe
((member t) (mapcar #'ert-get-test
(apropos-internal selector #'ert-test-boundp)))
(list (ert--remove-if-not (lambda (test)
@@ -1093,51 +1093,51 @@ contained in UNIVERSE."
universe))))
(ert-test (list selector))
(symbol
- (assert (ert-test-boundp selector))
+ (cl-assert (ert-test-boundp selector))
(list (ert-get-test selector)))
(cons
- (destructuring-bind (operator &rest operands) selector
- (ecase operator
+ (cl-destructuring-bind (operator &rest operands) selector
+ (cl-ecase operator
(member
(mapcar (lambda (purported-test)
- (etypecase purported-test
- (symbol (assert (ert-test-boundp purported-test))
+ (cl-etypecase purported-test
+ (symbol (cl-assert (ert-test-boundp purported-test))
(ert-get-test purported-test))
(ert-test purported-test)))
operands))
(eql
- (assert (eql (length operands) 1))
+ (cl-assert (eql (length operands) 1))
(ert-select-tests `(member ,@operands) universe))
(and
;; Do these definitions of AND, NOT and OR satisfy de
;; Morgan's laws? Should they?
- (case (length operands)
+ (cl-case (length operands)
(0 (ert-select-tests 't universe))
- (t (ert-select-tests `(and ,@(rest operands))
- (ert-select-tests (first operands)
+ (t (ert-select-tests `(and ,@(cdr operands))
+ (ert-select-tests (car operands)
universe)))))
(not
- (assert (eql (length operands) 1))
+ (cl-assert (eql (length operands) 1))
(let ((all-tests (ert-select-tests 't universe)))
(ert--set-difference all-tests
- (ert-select-tests (first operands)
+ (ert-select-tests (car operands)
all-tests))))
(or
- (case (length operands)
+ (cl-case (length operands)
(0 (ert-select-tests 'nil universe))
- (t (ert--union (ert-select-tests (first operands) universe)
- (ert-select-tests `(or ,@(rest operands))
+ (t (ert--union (ert-select-tests (car operands) universe)
+ (ert-select-tests `(or ,@(cdr operands))
universe)))))
(tag
- (assert (eql (length operands) 1))
- (let ((tag (first operands)))
+ (cl-assert (eql (length operands) 1))
+ (let ((tag (car operands)))
(ert-select-tests `(satisfies
,(lambda (test)
(member tag (ert-test-tags test))))
universe)))
(satisfies
- (assert (eql (length operands) 1))
- (ert--remove-if-not (first operands)
+ (cl-assert (eql (length operands) 1))
+ (ert--remove-if-not (car operands)
(ert-select-tests 't universe))))))))
(defun ert--insert-human-readable-selector (selector)
@@ -1146,26 +1146,27 @@ contained in UNIVERSE."
;; `backtrace' slot of the result objects in the
;; `most-recent-result' slots of test case objects in (eql ...) or
;; (member ...) selectors.
- (labels ((rec (selector)
- ;; This code needs to match the etypecase in `ert-select-tests'.
- (etypecase selector
- ((or (member nil t
- :new :failed :passed
- :expected :unexpected)
- string
- symbol)
- selector)
- (ert-test
- (if (ert-test-name selector)
- (make-symbol (format "<%S>" (ert-test-name selector)))
- (make-symbol "<unnamed test>")))
- (cons
- (destructuring-bind (operator &rest operands) selector
- (ecase operator
- ((member eql and not or)
- `(,operator ,@(mapcar #'rec operands)))
- ((member tag satisfies)
- selector)))))))
+ (cl-labels ((rec (selector)
+ ;; This code needs to match the etypecase in
+ ;; `ert-select-tests'.
+ (cl-etypecase selector
+ ((or (member nil t
+ :new :failed :passed
+ :expected :unexpected)
+ string
+ symbol)
+ selector)
+ (ert-test
+ (if (ert-test-name selector)
+ (make-symbol (format "<%S>" (ert-test-name selector)))
+ (make-symbol "<unnamed test>")))
+ (cons
+ (cl-destructuring-bind (operator &rest operands) selector
+ (cl-ecase operator
+ ((member eql and not or)
+ `(,operator ,@(mapcar #'rec operands)))
+ ((member tag satisfies)
+ selector)))))))
(insert (format "%S" (rec selector)))))
@@ -1182,21 +1183,21 @@ contained in UNIVERSE."
;; that corresponds to this run in order to be able to update the
;; statistics correctly when a test is re-run interactively and has a
;; different result than before.
-(defstruct ert--stats
- (selector (assert nil))
+(cl-defstruct ert--stats
+ (selector (cl-assert nil))
;; The tests, in order.
- (tests (assert nil) :type vector)
+ (tests (cl-assert nil) :type vector)
;; A map of test names (or the test objects themselves for unnamed
;; tests) to indices into the `tests' vector.
- (test-map (assert nil) :type hash-table)
+ (test-map (cl-assert nil) :type hash-table)
;; The results of the tests during this run, in order.
- (test-results (assert nil) :type vector)
+ (test-results (cl-assert nil) :type vector)
;; The start times of the tests, in order, as reported by
;; `current-time'.
- (test-start-times (assert nil) :type vector)
+ (test-start-times (cl-assert nil) :type vector)
;; The end times of the tests, in order, as reported by
;; `current-time'.
- (test-end-times (assert nil) :type vector)
+ (test-end-times (cl-assert nil) :type vector)
(passed-expected 0)
(passed-unexpected 0)
(failed-expected 0)
@@ -1246,21 +1247,25 @@ Also changes the counters in STATS to match."
(results (ert--stats-test-results stats))
(old-test (aref tests pos))
(map (ert--stats-test-map stats)))
- (flet ((update (d)
- (if (ert-test-result-expected-p (aref tests pos)
- (aref results pos))
- (etypecase (aref results pos)
- (ert-test-passed (incf (ert--stats-passed-expected stats) d))
- (ert-test-failed (incf (ert--stats-failed-expected stats) d))
- (null)
- (ert-test-aborted-with-non-local-exit)
- (ert-test-quit))
- (etypecase (aref results pos)
- (ert-test-passed (incf (ert--stats-passed-unexpected stats) d))
- (ert-test-failed (incf (ert--stats-failed-unexpected stats) d))
- (null)
- (ert-test-aborted-with-non-local-exit)
- (ert-test-quit)))))
+ (cl-flet ((update (d)
+ (if (ert-test-result-expected-p (aref tests pos)
+ (aref results pos))
+ (cl-etypecase (aref results pos)
+ (ert-test-passed
+ (cl-incf (ert--stats-passed-expected stats) d))
+ (ert-test-failed
+ (cl-incf (ert--stats-failed-expected stats) d))
+ (null)
+ (ert-test-aborted-with-non-local-exit)
+ (ert-test-quit))
+ (cl-etypecase (aref results pos)
+ (ert-test-passed
+ (cl-incf (ert--stats-passed-unexpected stats) d))
+ (ert-test-failed
+ (cl-incf (ert--stats-failed-unexpected stats) d))
+ (null)
+ (ert-test-aborted-with-non-local-exit)
+ (ert-test-quit)))))
;; Adjust counters to remove the result that is currently in stats.
(update -1)
;; Put new test and result into stats.
@@ -1278,11 +1283,11 @@ Also changes the counters in STATS to match."
SELECTOR is the selector that was used to select TESTS."
(setq tests (ert--coerce-to-vector tests))
(let ((map (make-hash-table :size (length tests))))
- (loop for i from 0
- for test across tests
- for key = (ert--stats-test-key test) do
- (assert (not (gethash key map)))
- (setf (gethash key map) i))
+ (cl-loop for i from 0
+ for test across tests
+ for key = (ert--stats-test-key test) do
+ (cl-assert (not (gethash key map)))
+ (setf (gethash key map) i))
(make-ert--stats :selector selector
:tests tests
:test-map map
@@ -1324,8 +1329,8 @@ SELECTOR is the selector that was used to select TESTS."
(force-mode-line-update)
(unwind-protect
(progn
- (loop for test in tests do
- (ert-run-or-rerun-test stats test listener))
+ (cl-loop for test in tests do
+ (ert-run-or-rerun-test stats test listener))
(setq abortedp nil))
(setf (ert--stats-aborted-p stats) abortedp)
(setf (ert--stats-end-time stats) (current-time))
@@ -1349,7 +1354,7 @@ SELECTOR is the selector that was used to select TESTS."
"Return a character that represents the test result RESULT.
EXPECTEDP specifies whether the result was expected."
- (let ((s (etypecase result
+ (let ((s (cl-etypecase result
(ert-test-passed ".P")
(ert-test-failed "fF")
(null "--")
@@ -1361,7 +1366,7 @@ EXPECTEDP specifies whether the result was expected."
"Return a string that represents the test result RESULT.
EXPECTEDP specifies whether the result was expected."
- (let ((s (etypecase result
+ (let ((s (cl-etypecase result
(ert-test-passed '("passed" "PASSED"))
(ert-test-failed '("failed" "FAILED"))
(null '("unknown" "UNKNOWN"))
@@ -1383,9 +1388,9 @@ Ensures a final newline is inserted."
"Insert `ert-info' infos from RESULT into current buffer.
RESULT must be an `ert-test-result-with-condition'."
- (check-type result ert-test-result-with-condition)
+ (cl-check-type result ert-test-result-with-condition)
(dolist (info (ert-test-result-with-condition-infos result))
- (destructuring-bind (prefix . message) info
+ (cl-destructuring-bind (prefix . message) info
(let ((begin (point))
(indentation (make-string (+ (length prefix) 4) ?\s))
(end nil))
@@ -1405,7 +1410,7 @@ RESULT must be an `ert-test-result-with-condition'."
;;; Running tests in batch mode.
(defvar ert-batch-backtrace-right-margin 70
- "*The maximum line length for printing backtraces in `ert-run-tests-batch'.")
+ "The maximum line length for printing backtraces in `ert-run-tests-batch'.")
;;;###autoload
(defun ert-run-tests-batch (&optional selector)
@@ -1421,14 +1426,14 @@ Returns the stats object."
(ert-run-tests
selector
(lambda (event-type &rest event-args)
- (ecase event-type
+ (cl-ecase event-type
(run-started
- (destructuring-bind (stats) event-args
+ (cl-destructuring-bind (stats) event-args
(message "Running %s tests (%s)"
(length (ert--stats-tests stats))
(ert--format-time-iso8601 (ert--stats-start-time stats)))))
(run-ended
- (destructuring-bind (stats abortedp) event-args
+ (cl-destructuring-bind (stats abortedp) event-args
(let ((unexpected (ert-stats-completed-unexpected stats))
(expected-failures (ert--stats-failed-expected stats)))
(message "\n%sRan %s tests, %s results as expected%s (%s)%s\n"
@@ -1446,19 +1451,19 @@ Returns the stats object."
(format "\n%s expected failures" expected-failures)))
(unless (zerop unexpected)
(message "%s unexpected results:" unexpected)
- (loop for test across (ert--stats-tests stats)
- for result = (ert-test-most-recent-result test) do
- (when (not (ert-test-result-expected-p test result))
- (message "%9s %S"
- (ert-string-for-test-result result nil)
- (ert-test-name test))))
+ (cl-loop for test across (ert--stats-tests stats)
+ for result = (ert-test-most-recent-result test) do
+ (when (not (ert-test-result-expected-p test result))
+ (message "%9s %S"
+ (ert-string-for-test-result result nil)
+ (ert-test-name test))))
(message "%s" "")))))
(test-started
)
(test-ended
- (destructuring-bind (stats test result) event-args
+ (cl-destructuring-bind (stats test result) event-args
(unless (ert-test-result-expected-p test result)
- (etypecase result
+ (cl-etypecase result
(ert-test-passed
(message "Test %S passed unexpectedly" (ert-test-name test)))
(ert-test-result-with-condition
@@ -1484,7 +1489,7 @@ Returns the stats object."
(ert--pp-with-indentation-and-newline
(ert-test-result-with-condition-condition result)))
(goto-char (1- (point-max)))
- (assert (looking-at "\n"))
+ (cl-assert (looking-at "\n"))
(delete-char 1)
(message "Test %S condition:" (ert-test-name test))
(message "%s" (buffer-string))))
@@ -1532,7 +1537,7 @@ the tests)."
(1 font-lock-keyword-face nil t)
(2 font-lock-function-name-face nil t)))))
-(defun* ert--remove-from-list (list-var element &key key test)
+(cl-defun ert--remove-from-list (list-var element &key key test)
"Remove ELEMENT from the value of LIST-VAR if present.
This can be used as an inverse of `add-to-list'."
@@ -1557,7 +1562,7 @@ If ADD-DEFAULT-TO-PROMPT is non-nil, PROMPT will be modified to
include the default, if any.
Signals an error if no test name was read."
- (etypecase default
+ (cl-etypecase default
(string (let ((symbol (intern-soft default)))
(unless (and symbol (ert-test-boundp symbol))
(setq default nil))))
@@ -1614,11 +1619,11 @@ Nothing more than an interactive interface to `ert-make-test-unbound'."
;;; Display of test progress and results.
;; An entry in the results buffer ewoc. There is one entry per test.
-(defstruct ert--ewoc-entry
- (test (assert nil))
+(cl-defstruct ert--ewoc-entry
+ (test (cl-assert nil))
;; If the result of this test was expected, its ewoc entry is hidden
;; initially.
- (hidden-p (assert nil))
+ (hidden-p (cl-assert nil))
;; An ewoc entry may be collapsed to hide details such as the error
;; condition.
;;
@@ -1694,7 +1699,7 @@ Also sets `ert--results-progress-bar-button-begin'."
((ert--stats-current-test stats) 'running)
((ert--stats-end-time stats) 'finished)
(t 'preparing))))
- (ecase state
+ (cl-ecase state
(preparing
(insert ""))
(aborted
@@ -1705,12 +1710,12 @@ Also sets `ert--results-progress-bar-button-begin'."
(t
(insert "Aborted."))))
(running
- (assert (ert--stats-current-test stats))
+ (cl-assert (ert--stats-current-test stats))
(insert "Running test: ")
(ert-insert-test-name-button (ert-test-name
(ert--stats-current-test stats))))
(finished
- (assert (not (ert--stats-current-test stats)))
+ (cl-assert (not (ert--stats-current-test stats)))
(insert "Finished.")))
(insert "\n")
(if (ert--stats-end-time stats)
@@ -1813,7 +1818,7 @@ non-nil, returns the face for expected results.."
(defun ert-face-for-stats (stats)
"Return a face that represents STATS."
(cond ((ert--stats-aborted-p stats) 'nil)
- ((plusp (ert-stats-completed-unexpected stats))
+ ((cl-plusp (ert-stats-completed-unexpected stats))
(ert-face-for-test-result nil))
((eql (ert-stats-completed-expected stats) (ert-stats-total stats))
(ert-face-for-test-result t))
@@ -1824,7 +1829,7 @@ non-nil, returns the face for expected results.."
(let* ((test (ert--ewoc-entry-test entry))
(stats ert--results-stats)
(result (let ((pos (ert--stats-test-pos stats test)))
- (assert pos)
+ (cl-assert pos)
(aref (ert--stats-test-results stats) pos)))
(hiddenp (ert--ewoc-entry-hidden-p entry))
(expandedp (ert--ewoc-entry-expanded-p entry))
@@ -1850,7 +1855,7 @@ non-nil, returns the face for expected results.."
(ert--string-first-line (ert-test-documentation test))
'font-lock-face 'font-lock-doc-face)
"\n"))
- (etypecase result
+ (cl-etypecase result
(ert-test-passed
(if (ert-test-result-expected-p test result)
(insert " passed\n")
@@ -1908,9 +1913,10 @@ BUFFER-NAME, if non-nil, is the buffer name to use."
(make-string (ert-stats-total stats)
(ert-char-for-test-result nil t)))
(set (make-local-variable 'ert--results-listener) listener)
- (loop for test across (ert--stats-tests stats) do
- (ewoc-enter-last ewoc
- (make-ert--ewoc-entry :test test :hidden-p t)))
+ (cl-loop for test across (ert--stats-tests stats) do
+ (ewoc-enter-last ewoc
+ (make-ert--ewoc-entry :test test
+ :hidden-p t)))
(ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats)
(goto-char (1- (point-max)))
buffer)))))
@@ -1945,21 +1951,21 @@ and how to display message."
default nil))
nil))
(unless message-fn (setq message-fn 'message))
- (lexical-let ((output-buffer-name output-buffer-name)
- buffer
- listener
- (message-fn message-fn))
+ (let ((output-buffer-name output-buffer-name)
+ buffer
+ listener
+ (message-fn message-fn))
(setq listener
(lambda (event-type &rest event-args)
- (ecase event-type
+ (cl-ecase event-type
(run-started
- (destructuring-bind (stats) event-args
+ (cl-destructuring-bind (stats) event-args
(setq buffer (ert--setup-results-buffer stats
listener
output-buffer-name))
(pop-to-buffer buffer)))
(run-ended
- (destructuring-bind (stats abortedp) event-args
+ (cl-destructuring-bind (stats abortedp) event-args
(funcall message-fn
"%sRan %s tests, %s results were as expected%s"
(if (not abortedp)
@@ -1976,19 +1982,19 @@ and how to display message."
ert--results-ewoc)
stats)))
(test-started
- (destructuring-bind (stats test) event-args
+ (cl-destructuring-bind (stats test) event-args
(with-current-buffer buffer
(let* ((ewoc ert--results-ewoc)
(pos (ert--stats-test-pos stats test))
(node (ewoc-nth ewoc pos)))
- (assert node)
+ (cl-assert node)
(setf (ert--ewoc-entry-test (ewoc-data node)) test)
(aset ert--results-progress-bar-string pos
(ert-char-for-test-result nil t))
(ert--results-update-stats-display-maybe ewoc stats)
(ewoc-invalidate ewoc node)))))
(test-ended
- (destructuring-bind (stats test result) event-args
+ (cl-destructuring-bind (stats test result) event-args
(with-current-buffer buffer
(let* ((ewoc ert--results-ewoc)
(pos (ert--stats-test-pos stats test))
@@ -2020,28 +2026,28 @@ and how to display message."
(define-derived-mode ert-results-mode special-mode "ERT-Results"
"Major mode for viewing results of ERT test runs.")
-(loop for (key binding) in
- '(;; Stuff that's not in the menu.
- ("\t" forward-button)
- ([backtab] backward-button)
- ("j" ert-results-jump-between-summary-and-result)
- ("L" ert-results-toggle-printer-limits-for-test-at-point)
- ("n" ert-results-next-test)
- ("p" ert-results-previous-test)
- ;; Stuff that is in the menu.
- ("R" ert-results-rerun-all-tests)
- ("r" ert-results-rerun-test-at-point)
- ("d" ert-results-rerun-test-at-point-debugging-errors)
- ("." ert-results-find-test-at-point-other-window)
- ("b" ert-results-pop-to-backtrace-for-test-at-point)
- ("m" ert-results-pop-to-messages-for-test-at-point)
- ("l" ert-results-pop-to-should-forms-for-test-at-point)
- ("h" ert-results-describe-test-at-point)
- ("D" ert-delete-test)
- ("T" ert-results-pop-to-timings)
- )
- do
- (define-key ert-results-mode-map key binding))
+(cl-loop for (key binding) in
+ '( ;; Stuff that's not in the menu.
+ ("\t" forward-button)
+ ([backtab] backward-button)
+ ("j" ert-results-jump-between-summary-and-result)
+ ("L" ert-results-toggle-printer-limits-for-test-at-point)
+ ("n" ert-results-next-test)
+ ("p" ert-results-previous-test)
+ ;; Stuff that is in the menu.
+ ("R" ert-results-rerun-all-tests)
+ ("r" ert-results-rerun-test-at-point)
+ ("d" ert-results-rerun-test-at-point-debugging-errors)
+ ("." ert-results-find-test-at-point-other-window)
+ ("b" ert-results-pop-to-backtrace-for-test-at-point)
+ ("m" ert-results-pop-to-messages-for-test-at-point)
+ ("l" ert-results-pop-to-should-forms-for-test-at-point)
+ ("h" ert-results-describe-test-at-point)
+ ("D" ert-delete-test)
+ ("T" ert-results-pop-to-timings)
+ )
+ do
+ (define-key ert-results-mode-map key binding))
(easy-menu-define ert-results-mode-menu ert-results-mode-map
"Menu for `ert-results-mode'."
@@ -2121,15 +2127,15 @@ To be used in the ERT results buffer."
EWOC-FN specifies the direction and should be either `ewoc-prev'
or `ewoc-next'. If there are no more nodes in that direction, an
error is signaled with the message ERROR-MESSAGE."
- (loop
+ (cl-loop
(setq node (funcall ewoc-fn ert--results-ewoc node))
(when (null node)
(error "%s" error-message))
(unless (ert--ewoc-entry-hidden-p (ewoc-data node))
(goto-char (ewoc-location node))
- (return))))
+ (cl-return))))
-(defun ert--results-expand-collapse-button-action (button)
+(defun ert--results-expand-collapse-button-action (_button)
"Expand or collapse the test node BUTTON belongs to."
(let* ((ewoc ert--results-ewoc)
(node (save-excursion
@@ -2158,11 +2164,11 @@ To be used in the ERT results buffer."
(defun ert--ewoc-position (ewoc node)
;; checkdoc-order: nil
"Return the position of NODE in EWOC, or nil if NODE is not in EWOC."
- (loop for i from 0
- for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here)
- do (when (eql node node-here)
- (return i))
- finally (return nil)))
+ (cl-loop for i from 0
+ for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here)
+ do (when (eql node node-here)
+ (cl-return i))
+ finally (cl-return nil)))
(defun ert-results-jump-between-summary-and-result ()
"Jump back and forth between the test run summary and individual test results.
@@ -2210,7 +2216,7 @@ To be used in the ERT results buffer."
"Return the test at point, or nil.
To be used in the ERT results buffer."
- (assert (eql major-mode 'ert-results-mode))
+ (cl-assert (eql major-mode 'ert-results-mode))
(if (ert--results-test-node-or-null-at-point)
(let* ((node (ert--results-test-node-at-point))
(test (ert--ewoc-entry-test (ewoc-data node))))
@@ -2282,9 +2288,9 @@ definition."
(point))
((eventp last-command-event)
(posn-point (event-start last-command-event)))
- (t (assert nil))))
+ (t (cl-assert nil))))
-(defun ert--results-progress-bar-button-action (button)
+(defun ert--results-progress-bar-button-action (_button)
"Jump to details for the test represented by the character clicked in BUTTON."
(goto-char (ert--button-action-position))
(ert-results-jump-between-summary-and-result))
@@ -2294,7 +2300,7 @@ definition."
To be used in the ERT results buffer."
(interactive)
- (assert (eql major-mode 'ert-results-mode))
+ (cl-assert (eql major-mode 'ert-results-mode))
(let ((selector (ert--stats-selector ert--results-stats)))
(ert-run-tests-interactively selector (buffer-name))))
@@ -2303,13 +2309,13 @@ To be used in the ERT results buffer."
To be used in the ERT results buffer."
(interactive)
- (destructuring-bind (test redefinition-state)
+ (cl-destructuring-bind (test redefinition-state)
(ert--results-test-at-point-allow-redefinition)
(when (null test)
(error "No test at point"))
(let* ((stats ert--results-stats)
(progress-message (format "Running %stest %S"
- (ecase redefinition-state
+ (cl-ecase redefinition-state
((nil) "")
(redefined "new definition of ")
(deleted "deleted "))
@@ -2350,7 +2356,7 @@ To be used in the ERT results buffer."
(stats ert--results-stats)
(pos (ert--stats-test-pos stats test))
(result (aref (ert--stats-test-results stats) pos)))
- (etypecase result
+ (cl-etypecase result
(ert-test-passed (error "Test passed, no backtrace available"))
(ert-test-result-with-condition
(let ((backtrace (ert-test-result-with-condition-backtrace result))
@@ -2408,13 +2414,14 @@ To be used in the ERT results buffer."
(ert-simple-view-mode)
(if (null (ert-test-result-should-forms result))
(insert "\n(No should forms during this test.)\n")
- (loop for form-description in (ert-test-result-should-forms result)
- for i from 1 do
- (insert "\n")
- (insert (format "%s: " i))
- (let ((begin (point)))
- (ert--pp-with-indentation-and-newline form-description)
- (ert--make-xrefs-region begin (point)))))
+ (cl-loop for form-description
+ in (ert-test-result-should-forms result)
+ for i from 1 do
+ (insert "\n")
+ (insert (format "%s: " i))
+ (let ((begin (point)))
+ (ert--pp-with-indentation-and-newline form-description)
+ (ert--make-xrefs-region begin (point)))))
(goto-char (point-min))
(insert "`should' forms executed during test `")
(ert-insert-test-name-button (ert-test-name test))
@@ -2443,17 +2450,16 @@ To be used in the ERT results buffer."
To be used in the ERT results buffer."
(interactive)
(let* ((stats ert--results-stats)
- (start-times (ert--stats-test-start-times stats))
- (end-times (ert--stats-test-end-times stats))
(buffer (get-buffer-create "*ERT timings*"))
- (data (loop for test across (ert--stats-tests stats)
- for start-time across (ert--stats-test-start-times stats)
- for end-time across (ert--stats-test-end-times stats)
- collect (list test
- (float-time (subtract-time end-time
- start-time))))))
+ (data (cl-loop for test across (ert--stats-tests stats)
+ for start-time across (ert--stats-test-start-times
+ stats)
+ for end-time across (ert--stats-test-end-times stats)
+ collect (list test
+ (float-time (subtract-time
+ end-time start-time))))))
(setq data (sort data (lambda (a b)
- (> (second a) (second b)))))
+ (> (cl-second a) (cl-second b)))))
(pop-to-buffer buffer)
(let ((inhibit-read-only t))
(buffer-disable-undo)
@@ -2462,13 +2468,13 @@ To be used in the ERT results buffer."
(if (null data)
(insert "(No data)\n")
(insert (format "%-3s %8s %8s\n" "" "time" "cumul"))
- (loop for (test time) in data
- for cumul-time = time then (+ cumul-time time)
- for i from 1 do
- (let ((begin (point)))
- (insert (format "%3s: %8.3f %8.3f " i time cumul-time))
- (ert-insert-test-name-button (ert-test-name test))
- (insert "\n"))))
+ (cl-loop for (test time) in data
+ for cumul-time = time then (+ cumul-time time)
+ for i from 1 do
+ (progn
+ (insert (format "%3s: %8.3f %8.3f " i time cumul-time))
+ (ert-insert-test-name-button (ert-test-name test))
+ (insert "\n"))))
(goto-char (point-min))
(insert "Tests by run time (seconds):\n\n")
(forward-line 1))))
@@ -2481,7 +2487,7 @@ To be used in the ERT results buffer."
(error "Requires Emacs 24"))
(let (test-name
test-definition)
- (etypecase test-or-test-name
+ (cl-etypecase test-or-test-name
(symbol (setq test-name test-or-test-name
test-definition (ert-get-test test-or-test-name)))
(ert-test (setq test-name (ert-test-name test-or-test-name)
diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el
index a71f3c7244c..5de3da65174 100644
--- a/lisp/emacs-lisp/ewoc.el
+++ b/lisp/emacs-lisp/ewoc.el
@@ -1,6 +1,6 @@
-;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer
+;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer -*- lexical-binding: t -*-
-;; Copyright (C) 1991-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2012 Free Software Foundation, Inc.
;; Author: Per Cederqvist <ceder@lysator.liu.se>
;; Inge Wallin <inge@lysator.liu.se>
@@ -26,7 +26,7 @@
;;; Commentary:
;; Ewoc Was Once Cookie
-;; But now it's Emacs' Widget for Object Collections
+;; But now it's Emacs's Widget for Object Collections
;; As the name implies this derives from the `cookie' package (part
;; of Elib). The changes are pervasive though mostly superficial:
@@ -96,11 +96,11 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;; The doubly linked list is implemented as a circular list with a dummy
;; node first and last. The dummy node is used as "the dll".
-(defstruct (ewoc--node
+(cl-defstruct (ewoc--node
(:type vector) ;ewoc--node-nth needs this
(:constructor nil)
(:constructor ewoc--node-create (start-marker data)))
@@ -140,7 +140,7 @@ and (ewoc--node-nth dll -1) returns the last node."
;;; The ewoc data type
-(defstruct (ewoc
+(cl-defstruct (ewoc
(:constructor nil)
(:constructor ewoc--create (buffer pretty-printer dll))
(:conc-name ewoc--))
@@ -216,10 +216,9 @@ NODE and leaving the new node's start there. Return the new node."
(ewoc--adjust m (point) R dll)))
(defun ewoc--wrap (func)
- (lexical-let ((ewoc--user-pp func))
- (lambda (data)
- (funcall ewoc--user-pp data)
- (insert "\n"))))
+ (lambda (data)
+ (funcall func data)
+ (insert "\n")))
;;; ===========================================================================
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 070faca8d91..e1e153d9117 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -1,6 +1,6 @@
;;; find-func.el --- find the definition of the Emacs Lisp function near point
-;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
;; Maintainer: petersen@kurims.kyoto-u.ac.jp
@@ -347,8 +347,7 @@ in `load-path'."
(if aliases
(message "%s" aliases))
(let ((library
- (cond ((eq (car-safe def) 'autoload)
- (nth 1 def))
+ (cond ((autoloadp def) (nth 1 def))
((subrp def)
(if lisp-only
(error "%s is a built-in function" function))
diff --git a/lisp/emacs-lisp/find-gc.el b/lisp/emacs-lisp/find-gc.el
index 1de38625243..39797fb5433 100644
--- a/lisp/emacs-lisp/find-gc.el
+++ b/lisp/emacs-lisp/find-gc.el
@@ -1,6 +1,6 @@
;;; find-gc.el --- detect functions that call the garbage collector
-;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el
index 7e40fdad352..f7d6cdc3b75 100644
--- a/lisp/emacs-lisp/float-sup.el
+++ b/lisp/emacs-lisp/float-sup.el
@@ -1,6 +1,6 @@
;;; float-sup.el --- define some constants useful for floating point numbers.
-;; Copyright (C) 1985-1987, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
@@ -28,13 +28,9 @@
;; Provide an easy hook to tell if we are running with floats or not.
;; Define pi and e via math-lib calls (much less prone to killer typos).
(defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...).")
-(progn
- ;; Simulate a defconst that doesn't declare the variable dynamically bound.
- (setq-default pi float-pi)
- (put 'pi 'variable-documentation
- "Obsolete since Emacs-23.3. Use `float-pi' instead.")
- (put 'pi 'risky-local-variable t)
- (push 'pi current-load-list))
+(defconst pi float-pi
+ "Obsolete since Emacs-23.3. Use `float-pi' instead.")
+(internal-make-var-non-special 'pi)
(defconst float-e (exp 1) "The value of e (2.7182818...).")
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index 770fe01f91c..80b6122822e 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -1,6 +1,6 @@
;;; generic.el --- defining simple major modes with comment and font-lock
;;
-;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc.
;;
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Fri Sep 27 1996
@@ -97,10 +97,11 @@
;; Internal Variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-obsolete-variable-alias 'generic-font-lock-defaults
+ 'generic-font-lock-keywords "22.1")
(defvar generic-font-lock-keywords nil
"Keywords for `font-lock-defaults' in a generic mode.")
(make-variable-buffer-local 'generic-font-lock-keywords)
-(define-obsolete-variable-alias 'generic-font-lock-defaults 'generic-font-lock-keywords "22.1")
;;;###autoload
(defvar generic-mode-list nil
@@ -150,7 +151,8 @@ mode hook `MODE-hook'.
See the file generic-x.el for some examples of `define-generic-mode'."
(declare (debug (sexp def-form def-form def-form form def-form
[&optional stringp] &rest [keywordp form]))
- (indent 1))
+ (indent 1)
+ (doc-string 7))
;; Backward compatibility.
(when (eq (car-safe mode) 'quote)
diff --git a/lisp/emacs-lisp/gulp.el b/lisp/emacs-lisp/gulp.el
index eca5470fd69..859b7d32b9e 100644
--- a/lisp/emacs-lisp/gulp.el
+++ b/lisp/emacs-lisp/gulp.el
@@ -1,6 +1,6 @@
;;; gulp.el --- ask for updates for Lisp packages
-;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Sam Shteingold <shteingd@math.ucla.edu>
;; Maintainer: FSF
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
new file mode 100644
index 00000000000..5488330a1a4
--- /dev/null
+++ b/lisp/emacs-lisp/gv.el
@@ -0,0 +1,482 @@
+;;; 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 file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a re-implementation of the setf machinery using a different
+;; underlying approach than the one used earlier in CL, which was based on
+;; define-setf-expander.
+;; `define-setf-expander' makes every "place-expander" return a 5-tuple
+;; (VARS VALUES STORES GETTER SETTER)
+;; where STORES is a list with a single variable (Common-Lisp allows multiple
+;; variables for use with multiple-return-values, but this is rarely used and
+;; not applicable to Elisp).
+;; It basically says that GETTER is an expression that returns the place's
+;; value, and (lambda STORES SETTER) is an expression that assigns the value(s)
+;; passed to that function to the place, and that you need to wrap the whole
+;; thing within a `(let* ,(zip VARS VALUES) ...).
+;;
+;; Instead, we use here a higher-order approach: instead
+;; of a 5-tuple, a place-expander returns a function.
+;; If you think about types, the old approach return things of type
+;; {vars: List Var, values: List Exp,
+;; stores: List Var, getter: Exp, setter: Exp}
+;; whereas the new approach returns a function of type
+;; (do: ((getter: Exp, setter: ((store: Exp) -> Exp)) -> Exp)) -> Exp.
+;; You can get the new function from the old 5-tuple with something like:
+;; (lambda (do)
+;; `(let* ,(zip VARS VALUES)
+;; (funcall do GETTER (lambda ,STORES ,SETTER))))
+;; You can't easily do the reverse, because this new approach is more
+;; expressive than the old one, so we can't provide a backward-compatible
+;; get-setf-method.
+;;
+;; While it may seem intimidating for people not used to higher-order
+;; functions, you will quickly see that its use (especially with the
+;; `gv-letplace' macro) is actually much easier and more elegant than the old
+;; approach which is clunky and often leads to unreadable code.
+
+;; Food for thought: the syntax of places does not actually conflict with the
+;; pcase patterns. The `cons' gv works just like a `(,a . ,b) pcase
+;; pattern, and actually the `logand' gv is even closer since it should
+;; arguably fail when trying to set a value outside of the mask.
+;; Generally, places are used for destructors (gethash, aref, car, ...)
+;; whereas pcase patterns are used for constructors (backquote, constants,
+;; vectors, ...).
+
+;;; Code:
+
+(require 'macroexp)
+
+;; What we call a "gvar" is basically a function of type "(getter * setter ->
+;; code) -> code", where "getter" is code and setter is "code -> code".
+
+;; (defvar gv--macro-environment nil
+;; "Macro expanders for generalized variables.")
+
+;;;###autoload
+(defun gv-get (place do)
+ "Build the code that applies DO to PLACE.
+PLACE must be a valid generalized variable.
+DO must be a function; it will be called with 2 arguments: GETTER and SETTER,
+where GETTER is a (copyable) Elisp expression that returns the value of PLACE,
+and SETTER is a function which returns the code to set PLACE when called
+with a (not necessarily copyable) Elisp expression that returns the value to
+set it to.
+DO must return an Elisp expression."
+ (if (symbolp place)
+ (funcall do place (lambda (v) `(setq ,place ,v)))
+ (let* ((head (car place))
+ (gf (function-get head 'gv-expander 'autoload)))
+ (if gf (apply gf do (cdr place))
+ (let ((me (macroexpand place ;FIXME: expand one step at a time!
+ ;; (append macroexpand-all-environment
+ ;; gv--macro-environment)
+ macroexpand-all-environment)))
+ (if (and (eq me place) (get head 'compiler-macro))
+ ;; Expand compiler macros: this takes care of all the accessors
+ ;; defined via cl-defsubst, such as cXXXr and defstruct slots.
+ (setq me (apply (get head 'compiler-macro) place (cdr place))))
+ (if (and (eq me place) (fboundp head)
+ (symbolp (symbol-function head)))
+ ;; Follow aliases.
+ (setq me (cons (symbol-function head) (cdr place))))
+ (if (eq me place)
+ (error "%S is not a valid place expression" place)
+ (gv-get me do)))))))
+
+;;;###autoload
+(defmacro gv-letplace (vars place &rest body)
+ "Build the code manipulating the generalized variable PLACE.
+GETTER will be bound to a copyable expression that returns the value
+of PLACE.
+SETTER will be bound to a function that takes an expression V and returns
+a new expression that sets PLACE to V.
+BODY should return some Elisp expression E manipulating PLACE via GETTER
+and SETTER.
+The returned value will then be an Elisp expression that first evaluates
+all the parts of PLACE that can be evaluated and then runs E.
+
+\(fn (GETTER SETTER) PLACE &rest BODY)"
+ (declare (indent 2) (debug (sexp form body)))
+ `(gv-get ,place (lambda ,vars ,@body)))
+
+;; Different ways to declare a generalized variable.
+;;;###autoload
+(defmacro gv-define-expander (name handler)
+ "Use HANDLER to handle NAME as a generalized var.
+NAME is a symbol: the name of a function, macro, or special form.
+HANDLER is a function which takes an argument DO followed by the same
+arguments as NAME. DO is a function as defined in `gv-get'."
+ (declare (indent 1) (debug (sexp form)))
+ ;; Use eval-and-compile so the method can be used in the same file as it
+ ;; is defined.
+ ;; FIXME: Just like byte-compile-macro-environment, we should have something
+ ;; like byte-compile-symbolprop-environment so as to handle these things
+ ;; cleanly without affecting the running Emacs.
+ `(eval-and-compile (put ',name 'gv-expander ,handler)))
+
+;;;###autoload
+(defun gv--defun-declaration (symbol name args handler &optional fix)
+ `(progn
+ ;; No need to autoload this part, since gv-get will auto-load the
+ ;; function's definition before checking the `gv-expander' property.
+ :autoload-end
+ ,(pcase (cons symbol handler)
+ (`(gv-expander . (lambda (,do) . ,body))
+ `(gv-define-expander ,name (lambda (,do ,@args) ,@body)))
+ (`(gv-expander . ,(pred symbolp))
+ `(gv-define-expander ,name #',handler))
+ (`(gv-setter . (lambda (,store) . ,body))
+ `(gv-define-setter ,name (,store ,@args) ,@body))
+ (`(gv-setter . ,(pred symbolp))
+ `(gv-define-simple-setter ,name ,handler ,fix))
+ ;; (`(expand ,expander) `(gv-define-expand ,name ,expander))
+ (_ (message "Unknown %s declaration %S" symbol handler) nil))))
+
+;;;###autoload
+(push `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander))
+ defun-declarations-alist)
+;;;###autoload
+(push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter))
+ defun-declarations-alist)
+
+;; (defmacro gv-define-expand (name expander)
+;; "Use EXPANDER to handle NAME as a generalized var.
+;; NAME is a symbol: the name of a function, macro, or special form.
+;; EXPANDER is a function that will be called as a macro-expander to reduce
+;; uses of NAME to some other generalized variable."
+;; (declare (debug (sexp form)))
+;; `(eval-and-compile
+;; (if (not (boundp 'gv--macro-environment))
+;; (setq gv--macro-environment nil))
+;; (push (cons ',name ,expander) gv--macro-environment)))
+
+(defun gv--defsetter (name setter do args &optional vars)
+ "Helper function used by code generated by `gv-define-setter'.
+NAME is the name of the getter function.
+SETTER is a function that generates the code for the setter.
+NAME accept ARGS as arguments and SETTER accepts (NEWVAL . ARGS).
+VARS is used internally for recursive calls."
+ (if (null args)
+ (let ((vars (nreverse vars)))
+ (funcall do `(,name ,@vars) (lambda (v) (apply setter v vars))))
+ ;; FIXME: Often it would be OK to skip this `let', but in general,
+ ;; `do' may have all kinds of side-effects.
+ (macroexp-let2 nil v (car args)
+ (gv--defsetter name setter do (cdr args) (cons v vars)))))
+
+;;;###autoload
+(defmacro gv-define-setter (name arglist &rest body)
+ "Define a setter method for generalized variable NAME.
+This macro is an easy-to-use substitute for `gv-define-expander' that works
+well for simple place forms.
+Assignments of VAL to (NAME ARGS...) are expanded by binding the argument
+forms (VAL ARGS...) according to ARGLIST, then executing BODY, which must
+return a Lisp form that does the assignment.
+The first arg in ARGLIST (the one that receives VAL) receives an expression
+which can do arbitrary things, whereas the other arguments are all guaranteed
+to be pure and copyable. Example use:
+ (gv-define-setter aref (v a i) `(aset ,a ,i ,v))"
+ (declare (indent 2) (debug (&define name sexp body)))
+ `(gv-define-expander ,name
+ (lambda (do &rest args)
+ (gv--defsetter ',name (lambda ,arglist ,@body) do args))))
+
+;;;###autoload
+(defmacro gv-define-simple-setter (name setter &optional fix-return)
+ "Define a simple setter method for generalized variable NAME.
+This macro is an easy-to-use substitute for `gv-define-expander' that works
+well for simple place forms. Assignments of VAL to (NAME ARGS...) are
+turned into calls of the form (SETTER ARGS... VAL).
+
+If FIX-RETURN is non-nil, then SETTER is not assumed to return VAL and
+instead the assignment is turned into something equivalent to
+ \(let ((temp VAL))
+ (SETTER ARGS... temp)
+ temp)
+so as to preserve the semantics of `setf'."
+ (declare (debug (sexp (&or symbolp lambda-expr) &optional sexp)))
+ `(gv-define-setter ,name (val &rest args)
+ ,(if fix-return
+ `(macroexp-let2 nil v val
+ `(progn
+ (,',setter ,@(append args (list v)))
+ ,v))
+ `(cons ',setter (append args (list val))))))
+
+;;; Typical operations on generalized variables.
+
+;;;###autoload
+(defmacro setf (&rest args)
+ "Set each PLACE to the value of its VAL.
+This is a generalized version of `setq'; the PLACEs may be symbolic
+references such as (car x) or (aref x i), as well as plain symbols.
+For example, (setf (cadr x) y) is equivalent to (setcar (cdr x) y).
+The return value is the last VAL in the list.
+
+\(fn PLACE VAL PLACE VAL ...)"
+ (declare (debug (&rest [gv-place form])))
+ (if (and args (null (cddr args)))
+ (let ((place (pop args))
+ (val (car args)))
+ (gv-letplace (_getter setter) place
+ (funcall setter val)))
+ (let ((sets nil))
+ (while args (push `(setf ,(pop args) ,(pop args)) sets))
+ (cons 'progn (nreverse sets)))))
+
+;; (defmacro gv-pushnew! (val place)
+;; "Like `gv-push!' but only adds VAL if it's not yet in PLACE.
+;; Presence is checked with `member'.
+;; The return value is unspecified."
+;; (declare (debug (form gv-place)))
+;; (macroexp-let2 macroexp-copyable-p v val
+;; (gv-letplace (getter setter) place
+;; `(if (member ,v ,getter) nil
+;; ,(funcall setter `(cons ,v ,getter))))))
+
+;; (defmacro gv-inc! (place &optional val)
+;; "Increment PLACE by VAL (default to 1)."
+;; (declare (debug (gv-place &optional form)))
+;; (gv-letplace (getter setter) place
+;; (funcall setter `(+ ,getter ,(or val 1)))))
+
+;; (defmacro gv-dec! (place &optional val)
+;; "Decrement PLACE by VAL (default to 1)."
+;; (declare (debug (gv-place &optional form)))
+;; (gv-letplace (getter setter) place
+;; (funcall setter `(- ,getter ,(or val 1)))))
+
+;; For Edebug, the idea is to let Edebug instrument gv-places just like it does
+;; for normal expressions, and then give it a gv-expander to DTRT.
+;; Maybe this should really be in edebug.el rather than here.
+
+;; Autoload this `put' since a user might use C-u C-M-x on an expression
+;; containing a non-trivial `push' even before gv.el was loaded.
+;;;###autoload
+(put 'gv-place 'edebug-form-spec 'edebug-match-form)
+;; CL did the equivalent of:
+;;(gv-define-macroexpand edebug-after (lambda (before index place) place))
+
+(put 'edebug-after 'gv-expander
+ (lambda (do before index place)
+ (gv-letplace (getter setter) place
+ (funcall do `(edebug-after ,before ,index ,getter)
+ setter))))
+
+;;; The common generalized variables.
+
+(gv-define-simple-setter aref aset)
+(gv-define-simple-setter car setcar)
+(gv-define-simple-setter cdr setcdr)
+;; FIXME: add compiler-macros for `cXXr' instead!
+(gv-define-setter caar (val x) `(setcar (car ,x) ,val))
+(gv-define-setter cadr (val x) `(setcar (cdr ,x) ,val))
+(gv-define-setter cdar (val x) `(setcdr (car ,x) ,val))
+(gv-define-setter cddr (val x) `(setcdr (cdr ,x) ,val))
+(gv-define-setter elt (store seq n)
+ `(if (listp ,seq) (setcar (nthcdr ,n ,seq) ,store)
+ (aset ,seq ,n ,store)))
+(gv-define-simple-setter get put)
+(gv-define-setter gethash (val k h &optional _d) `(puthash ,k ,val ,h))
+
+;; (gv-define-expand nth (lambda (idx list) `(car (nthcdr ,idx ,list))))
+(put 'nth 'gv-expander
+ (lambda (do idx list)
+ (macroexp-let2 nil c `(nthcdr ,idx ,list)
+ (funcall do `(car ,c) (lambda (v) `(setcar ,c ,v))))))
+(gv-define-simple-setter symbol-function fset)
+(gv-define-simple-setter symbol-plist setplist)
+(gv-define-simple-setter symbol-value set)
+
+(put 'nthcdr 'gv-expander
+ (lambda (do n place)
+ (macroexp-let2 nil idx n
+ (gv-letplace (getter setter) place
+ (funcall do `(nthcdr ,idx ,getter)
+ (lambda (v) `(if (<= ,idx 0) ,(funcall setter v)
+ (setcdr (nthcdr (1- ,idx) ,getter) ,v))))))))
+
+;;; Elisp-specific generalized variables.
+
+(gv-define-simple-setter default-value set-default)
+(gv-define-simple-setter frame-parameter set-frame-parameter 'fix)
+(gv-define-simple-setter terminal-parameter set-terminal-parameter)
+(gv-define-simple-setter keymap-parent set-keymap-parent)
+(gv-define-simple-setter match-data set-match-data 'fix)
+(gv-define-simple-setter overlay-get overlay-put)
+(gv-define-setter overlay-start (store ov)
+ `(progn (move-overlay ,ov ,store (overlay-end ,ov)) ,store))
+(gv-define-setter overlay-end (store ov)
+ `(progn (move-overlay ,ov (overlay-start ,ov) ,store) ,store))
+(gv-define-simple-setter process-buffer set-process-buffer)
+(gv-define-simple-setter process-filter set-process-filter)
+(gv-define-simple-setter process-sentinel set-process-sentinel)
+(gv-define-simple-setter process-get process-put)
+(gv-define-simple-setter window-buffer set-window-buffer)
+(gv-define-simple-setter window-display-table set-window-display-table 'fix)
+(gv-define-simple-setter window-dedicated-p set-window-dedicated-p)
+(gv-define-simple-setter window-hscroll set-window-hscroll)
+(gv-define-simple-setter window-parameter set-window-parameter)
+(gv-define-simple-setter window-point set-window-point)
+(gv-define-simple-setter window-start set-window-start)
+
+;;; Some occasionally handy extensions.
+
+;; While several of the "places" below are not terribly useful for direct use,
+;; they can show up as the output of the macro expansion of reasonable places,
+;; such as struct-accessors.
+
+(put 'progn 'gv-expander
+ (lambda (do &rest exps)
+ (let ((start (butlast exps))
+ (end (car (last exps))))
+ (if (null start) (gv-get end do)
+ `(progn ,@start ,(gv-get end do))))))
+
+(let ((let-expander
+ (lambda (letsym)
+ (lambda (do bindings &rest body)
+ `(,letsym ,bindings
+ ,@(macroexp-unprogn
+ (gv-get (macroexp-progn body) do)))))))
+ (put 'let 'gv-expander (funcall let-expander 'let))
+ (put 'let* 'gv-expander (funcall let-expander 'let*)))
+
+(put 'if 'gv-expander
+ (lambda (do test then &rest else)
+ (if (or (not lexical-binding) ;The other code requires lexical-binding.
+ (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))))
+ ;; This duplicates the `do' code, which is a problem if that
+ ;; code is large, but otherwise results in more efficient code.
+ `(if ,test ,(gv-get then do)
+ ,@(macroexp-unprogn (gv-get (macroexp-progn else) do)))
+ (let ((v (make-symbol "v")))
+ (macroexp-let2 nil
+ gv `(if ,test ,(gv-letplace (getter setter) then
+ `(cons (lambda () ,getter)
+ (lambda (,v) ,(funcall setter v))))
+ ,(gv-letplace (getter setter) (macroexp-progn else)
+ `(cons (lambda () ,getter)
+ (lambda (,v) ,(funcall setter v)))))
+ (funcall do `(funcall (car ,gv))
+ (lambda (v) `(funcall (cdr ,gv) ,v))))))))
+
+(put 'cond 'gv-expander
+ (lambda (do &rest branches)
+ (if (or (not lexical-binding) ;The other code requires lexical-binding.
+ (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))))
+ ;; This duplicates the `do' code, which is a problem if that
+ ;; code is large, but otherwise results in more efficient code.
+ `(cond
+ ,@(mapcar (lambda (branch)
+ (if (cdr branch)
+ (cons (car branch)
+ (macroexp-unprogn
+ (gv-get (macroexp-progn (cdr branch)) do)))
+ (gv-get (car branch) do)))
+ branches))
+ (let ((v (make-symbol "v")))
+ (macroexp-let2 nil
+ gv `(cond
+ ,@(mapcar
+ (lambda (branch)
+ (if (cdr branch)
+ `(,(car branch)
+ ,@(macroexp-unprogn
+ (gv-letplace (getter setter)
+ (macroexp-progn (cdr branch))
+ `(cons (lambda () ,getter)
+ (lambda (,v) ,(funcall setter v))))))
+ (gv-letplace (getter setter)
+ (car branch)
+ `(cons (lambda () ,getter)
+ (lambda (,v) ,(funcall setter v))))))
+ branches))
+ (funcall do `(funcall (car ,gv))
+ (lambda (v) `(funcall (cdr ,gv) ,v))))))))
+
+;;; Even more debatable extensions.
+
+(put 'cons 'gv-expander
+ (lambda (do a d)
+ (gv-letplace (agetter asetter) a
+ (gv-letplace (dgetter dsetter) d
+ (funcall do
+ `(cons ,agetter ,dgetter)
+ (lambda (v) `(progn
+ ,(funcall asetter `(car ,v))
+ ,(funcall dsetter `(cdr ,v)))))))))
+
+(put 'logand 'gv-expander
+ (lambda (do place &rest masks)
+ (gv-letplace (getter setter) place
+ (macroexp-let2 macroexp-copyable-p
+ mask (if (cdr masks) `(logand ,@masks) (car masks))
+ (funcall
+ do `(logand ,getter ,mask)
+ (lambda (v)
+ (funcall setter
+ `(logior (logand ,v ,mask)
+ (logand ,getter (lognot ,mask))))))))))
+
+;;; References
+
+;;;###autoload
+(defmacro gv-ref (place)
+ "Return a reference to PLACE.
+This is like the `&' operator of the C language."
+ (gv-letplace (getter setter) place
+ `(cons (lambda () ,getter)
+ (lambda (gv--val) ,(funcall setter 'gv--val)))))
+
+(defsubst gv-deref (ref)
+ "Dereference REF, returning the referenced value.
+This is like the `*' operator of the C language.
+REF must have been previously obtained with `gv-ref'."
+ (funcall (car ref)))
+;; Don't use `declare' because it seems to introduce circularity problems:
+;; Warning: Eager macro-expansion skipped due to cycle:
+;; … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el")
+(gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v))
+
+;;; Vaguely related definitions that should be moved elsewhere.
+
+;; (defun alist-get (key alist)
+;; "Get the value associated to KEY in ALIST."
+;; (declare
+;; (gv-expander
+;; (lambda (do)
+;; (macroexp-let2 macroexp-copyable-p k key
+;; (gv-letplace (getter setter) alist
+;; (macroexp-let2 nil p `(assoc ,k ,getter)
+;; (funcall do `(cdr ,p)
+;; (lambda (v)
+;; `(if ,p (setcdr ,p ,v)
+;; ,(funcall setter
+;; `(cons (cons ,k ,v) ,getter)))))))))))
+;; (cdr (assoc key alist)))
+
+(provide 'gv)
+;;; gv.el ends here
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
index 113f5849364..e10cbdb3b6e 100644
--- a/lisp/emacs-lisp/helper.el
+++ b/lisp/emacs-lisp/helper.el
@@ -1,6 +1,6 @@
;;; helper.el --- utility help package supporting help in electric modes
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: FSF
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index 4d0cacf4ee1..f9a1c5dbf83 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -1,6 +1,6 @@
;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers
-;; Copyright (C) 1992, 1994, 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: FSF
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 44e87e171d1..64aac4b81db 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -1,6 +1,6 @@
;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands
-;; Copyright (C) 1985-1986, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1999-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: lisp, languages
@@ -34,8 +34,14 @@
(defvar font-lock-string-face)
(defvar lisp-mode-abbrev-table nil)
+(define-abbrev-table 'lisp-mode-abbrev-table ()
+ "Abbrev table for Lisp mode.")
-(define-abbrev-table 'lisp-mode-abbrev-table ())
+(defvar emacs-lisp-mode-abbrev-table nil)
+(define-abbrev-table 'emacs-lisp-mode-abbrev-table ()
+ "Abbrev table for Emacs Lisp mode.
+It has `lisp-mode-abbrev-table' as its parent."
+ :parents (list lisp-mode-abbrev-table))
(defvar emacs-lisp-mode-syntax-table
(let ((table (make-syntax-table))
@@ -111,10 +117,15 @@
(purecopy (concat "^\\s-*("
(eval-when-compile
(regexp-opt
- '("defvar" "defconst" "defconstant" "defcustom"
+ '("defconst" "defconstant" "defcustom"
"defparameter" "define-symbol-macro") t))
"\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
2)
+ ;; For `defvar', we ignore (defvar FOO) constructs.
+ (list (purecopy "Variables")
+ (purecopy (concat "^\\s-*(defvar\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"
+ "[[:space:]\n]+[^)]"))
+ 1)
(list (purecopy "Types")
(purecopy (concat "^\\s-*("
(eval-when-compile
@@ -129,35 +140,12 @@
;; This was originally in autoload.el and is still used there.
(put 'autoload 'doc-string-elt 3)
-(put 'defun 'doc-string-elt 3)
-(put 'defun* 'doc-string-elt 3)
(put 'defmethod 'doc-string-elt 3)
(put 'defvar 'doc-string-elt 3)
-(put 'defcustom 'doc-string-elt 3)
-(put 'deftheme 'doc-string-elt 2)
-(put 'deftype 'doc-string-elt 3)
(put 'defconst 'doc-string-elt 3)
-(put 'defmacro 'doc-string-elt 3)
-(put 'defmacro* 'doc-string-elt 3)
-(put 'defsubst 'doc-string-elt 3)
-(put 'defstruct 'doc-string-elt 2)
-(put 'define-skeleton 'doc-string-elt 2)
-(put 'define-derived-mode 'doc-string-elt 4)
-(put 'define-compilation-mode 'doc-string-elt 3)
-(put 'easy-mmode-define-minor-mode 'doc-string-elt 2)
-(put 'define-minor-mode 'doc-string-elt 2)
-(put 'easy-mmode-define-global-mode 'doc-string-elt 2)
-(put 'define-global-minor-mode 'doc-string-elt 2)
-(put 'define-globalized-minor-mode 'doc-string-elt 2)
-(put 'define-generic-mode 'doc-string-elt 7)
-(put 'define-ibuffer-filter 'doc-string-elt 2)
-(put 'define-ibuffer-op 'doc-string-elt 3)
-(put 'define-ibuffer-sorter 'doc-string-elt 2)
-(put 'lambda 'doc-string-elt 2)
(put 'defalias 'doc-string-elt 3)
(put 'defvaralias 'doc-string-elt 3)
(put 'define-category 'doc-string-elt 2)
-(put 'define-overloadable-function 'doc-string-elt 3)
(defvar lisp-doc-string-elt-property 'doc-string-elt
"The symbol property that holds the docstring position info.")
@@ -175,7 +163,8 @@
(goto-char listbeg)
(and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
(match-string 1)))))
- (docelt (and firstsym (get (intern-soft firstsym)
+ (docelt (and firstsym
+ (function-get (intern-soft firstsym)
lisp-doc-string-elt-property))))
(if (and docelt
;; It's a string in a form that can have a docstring.
@@ -206,7 +195,6 @@ score-mode.el. KEYWORDS-CASE-INSENSITIVE non-nil means that for
font-lock keywords will not be case sensitive."
(when lisp-syntax
(set-syntax-table lisp-mode-syntax-table))
- (setq local-abbrev-table lisp-mode-abbrev-table)
(make-local-variable 'paragraph-ignore-fill-prefix)
(setq paragraph-ignore-fill-prefix t)
(make-local-variable 'fill-paragraph-function)
@@ -282,110 +270,111 @@ font-lock keywords will not be case sensitive."
(define-key map "\e\t" 'completion-at-point)
(define-key map "\e\C-x" 'eval-defun)
(define-key map "\e\C-q" 'indent-pp-sexp)
- (define-key map [menu-bar emacs-lisp] (cons (purecopy "Emacs-Lisp") menu-map))
- (define-key menu-map [eldoc]
- `(menu-item ,(purecopy "Auto-Display Documentation Strings") eldoc-mode
+ (bindings--define-key map [menu-bar emacs-lisp]
+ (cons "Emacs-Lisp" menu-map))
+ (bindings--define-key menu-map [eldoc]
+ '(menu-item "Auto-Display Documentation Strings" eldoc-mode
:button (:toggle . (bound-and-true-p eldoc-mode))
- :help ,(purecopy "Display the documentation string for the item under cursor")))
- (define-key menu-map [checkdoc]
- `(menu-item ,(purecopy "Check Documentation Strings") checkdoc
- :help ,(purecopy "Check documentation strings for style requirements")))
- (define-key menu-map [re-builder]
- `(menu-item ,(purecopy "Construct Regexp") re-builder
- :help ,(purecopy "Construct a regexp interactively")))
- (define-key menu-map [tracing] (cons (purecopy "Tracing") tracing-map))
- (define-key tracing-map [tr-a]
- `(menu-item ,(purecopy "Untrace All") untrace-all
- :help ,(purecopy "Untrace all currently traced functions")))
- (define-key tracing-map [tr-uf]
- `(menu-item ,(purecopy "Untrace Function...") untrace-function
- :help ,(purecopy "Untrace function, and possibly activate all remaining advice")))
- (define-key tracing-map [tr-sep] menu-bar-separator)
- (define-key tracing-map [tr-q]
- `(menu-item ,(purecopy "Trace Function Quietly...") trace-function-background
- :help ,(purecopy "Trace the function with trace output going quietly to a buffer")))
- (define-key tracing-map [tr-f]
- `(menu-item ,(purecopy "Trace Function...") trace-function
- :help ,(purecopy "Trace the function given as an argument")))
- (define-key menu-map [profiling] (cons (purecopy "Profiling") prof-map))
- (define-key prof-map [prof-restall]
- `(menu-item ,(purecopy "Remove Instrumentation for All Functions") elp-restore-all
- :help ,(purecopy "Restore the original definitions of all functions being profiled")))
- (define-key prof-map [prof-restfunc]
- `(menu-item ,(purecopy "Remove Instrumentation for Function...") elp-restore-function
- :help ,(purecopy "Restore an instrumented function to its original definition")))
-
- (define-key prof-map [sep-rem] menu-bar-separator)
- (define-key prof-map [prof-resall]
- `(menu-item ,(purecopy "Reset Counters for All Functions") elp-reset-all
- :help ,(purecopy "Reset the profiling information for all functions being profiled")))
- (define-key prof-map [prof-resfunc]
- `(menu-item ,(purecopy "Reset Counters for Function...") elp-reset-function
- :help ,(purecopy "Reset the profiling information for a function")))
- (define-key prof-map [prof-res]
- `(menu-item ,(purecopy "Show Profiling Results") elp-results
- :help ,(purecopy "Display current profiling results")))
- (define-key prof-map [prof-pack]
- `(menu-item ,(purecopy "Instrument Package...") elp-instrument-package
- :help ,(purecopy "Instrument for profiling all function that start with a prefix")))
- (define-key prof-map [prof-func]
- `(menu-item ,(purecopy "Instrument Function...") elp-instrument-function
- :help ,(purecopy "Instrument a function for profiling")))
- (define-key menu-map [lint] (cons (purecopy "Linting") lint-map))
- (define-key lint-map [lint-di]
- `(menu-item ,(purecopy "Lint Directory...") elint-directory
- :help ,(purecopy "Lint a directory")))
- (define-key lint-map [lint-f]
- `(menu-item ,(purecopy "Lint File...") elint-file
- :help ,(purecopy "Lint a file")))
- (define-key lint-map [lint-b]
- `(menu-item ,(purecopy "Lint Buffer") elint-current-buffer
- :help ,(purecopy "Lint the current buffer")))
- (define-key lint-map [lint-d]
- `(menu-item ,(purecopy "Lint Defun") elint-defun
- :help ,(purecopy "Lint the function at point")))
- (define-key menu-map [edebug-defun]
- `(menu-item ,(purecopy "Instrument Function for Debugging") edebug-defun
- :help ,(purecopy "Evaluate the top level form point is in, stepping through with Edebug")
- :keys ,(purecopy "C-u C-M-x")))
- (define-key menu-map [separator-byte] menu-bar-separator)
- (define-key menu-map [disas]
- `(menu-item ,(purecopy "Disassemble Byte Compiled Object...") disassemble
- :help ,(purecopy "Print disassembled code for OBJECT in a buffer")))
- (define-key menu-map [byte-recompile]
- `(menu-item ,(purecopy "Byte-recompile Directory...") byte-recompile-directory
- :help ,(purecopy "Recompile every `.el' file in DIRECTORY that needs recompilation")))
- (define-key menu-map [emacs-byte-compile-and-load]
- `(menu-item ,(purecopy "Byte-compile and Load") emacs-lisp-byte-compile-and-load
- :help ,(purecopy "Byte-compile the current file (if it has changed), then load compiled code")))
- (define-key menu-map [byte-compile]
- `(menu-item ,(purecopy "Byte-compile This File") emacs-lisp-byte-compile
- :help ,(purecopy "Byte compile the file containing the current buffer")))
- (define-key menu-map [separator-eval] menu-bar-separator)
- (define-key menu-map [ielm]
- `(menu-item ,(purecopy "Interactive Expression Evaluation") ielm
- :help ,(purecopy "Interactively evaluate Emacs Lisp expressions")))
- (define-key menu-map [eval-buffer]
- `(menu-item ,(purecopy "Evaluate Buffer") eval-buffer
- :help ,(purecopy "Execute the current buffer as Lisp code")))
- (define-key menu-map [eval-region]
- `(menu-item ,(purecopy "Evaluate Region") eval-region
- :help ,(purecopy "Execute the region as Lisp code")
+ :help "Display the documentation string for the item under cursor"))
+ (bindings--define-key menu-map [checkdoc]
+ '(menu-item "Check Documentation Strings" checkdoc
+ :help "Check documentation strings for style requirements"))
+ (bindings--define-key menu-map [re-builder]
+ '(menu-item "Construct Regexp" re-builder
+ :help "Construct a regexp interactively"))
+ (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map))
+ (bindings--define-key tracing-map [tr-a]
+ '(menu-item "Untrace All" untrace-all
+ :help "Untrace all currently traced functions"))
+ (bindings--define-key tracing-map [tr-uf]
+ '(menu-item "Untrace Function..." untrace-function
+ :help "Untrace function, and possibly activate all remaining advice"))
+ (bindings--define-key tracing-map [tr-sep] menu-bar-separator)
+ (bindings--define-key tracing-map [tr-q]
+ '(menu-item "Trace Function Quietly..." trace-function-background
+ :help "Trace the function with trace output going quietly to a buffer"))
+ (bindings--define-key tracing-map [tr-f]
+ '(menu-item "Trace Function..." trace-function
+ :help "Trace the function given as an argument"))
+ (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map))
+ (bindings--define-key prof-map [prof-restall]
+ '(menu-item "Remove Instrumentation for All Functions" elp-restore-all
+ :help "Restore the original definitions of all functions being profiled"))
+ (bindings--define-key prof-map [prof-restfunc]
+ '(menu-item "Remove Instrumentation for Function..." elp-restore-function
+ :help "Restore an instrumented function to its original definition"))
+
+ (bindings--define-key prof-map [sep-rem] menu-bar-separator)
+ (bindings--define-key prof-map [prof-resall]
+ '(menu-item "Reset Counters for All Functions" elp-reset-all
+ :help "Reset the profiling information for all functions being profiled"))
+ (bindings--define-key prof-map [prof-resfunc]
+ '(menu-item "Reset Counters for Function..." elp-reset-function
+ :help "Reset the profiling information for a function"))
+ (bindings--define-key prof-map [prof-res]
+ '(menu-item "Show Profiling Results" elp-results
+ :help "Display current profiling results"))
+ (bindings--define-key prof-map [prof-pack]
+ '(menu-item "Instrument Package..." elp-instrument-package
+ :help "Instrument for profiling all function that start with a prefix"))
+ (bindings--define-key prof-map [prof-func]
+ '(menu-item "Instrument Function..." elp-instrument-function
+ :help "Instrument a function for profiling"))
+ (bindings--define-key menu-map [lint] (cons "Linting" lint-map))
+ (bindings--define-key lint-map [lint-di]
+ '(menu-item "Lint Directory..." elint-directory
+ :help "Lint a directory"))
+ (bindings--define-key lint-map [lint-f]
+ '(menu-item "Lint File..." elint-file
+ :help "Lint a file"))
+ (bindings--define-key lint-map [lint-b]
+ '(menu-item "Lint Buffer" elint-current-buffer
+ :help "Lint the current buffer"))
+ (bindings--define-key lint-map [lint-d]
+ '(menu-item "Lint Defun" elint-defun
+ :help "Lint the function at point"))
+ (bindings--define-key menu-map [edebug-defun]
+ '(menu-item "Instrument Function for Debugging" edebug-defun
+ :help "Evaluate the top level form point is in, stepping through with Edebug"
+ :keys "C-u C-M-x"))
+ (bindings--define-key menu-map [separator-byte] menu-bar-separator)
+ (bindings--define-key menu-map [disas]
+ '(menu-item "Disassemble Byte Compiled Object..." disassemble
+ :help "Print disassembled code for OBJECT in a buffer"))
+ (bindings--define-key menu-map [byte-recompile]
+ '(menu-item "Byte-recompile Directory..." byte-recompile-directory
+ :help "Recompile every `.el' file in DIRECTORY that needs recompilation"))
+ (bindings--define-key menu-map [emacs-byte-compile-and-load]
+ '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load
+ :help "Byte-compile the current file (if it has changed), then load compiled code"))
+ (bindings--define-key menu-map [byte-compile]
+ '(menu-item "Byte-compile This File" emacs-lisp-byte-compile
+ :help "Byte compile the file containing the current buffer"))
+ (bindings--define-key menu-map [separator-eval] menu-bar-separator)
+ (bindings--define-key menu-map [ielm]
+ '(menu-item "Interactive Expression Evaluation" ielm
+ :help "Interactively evaluate Emacs Lisp expressions"))
+ (bindings--define-key menu-map [eval-buffer]
+ '(menu-item "Evaluate Buffer" eval-buffer
+ :help "Execute the current buffer as Lisp code"))
+ (bindings--define-key menu-map [eval-region]
+ '(menu-item "Evaluate Region" eval-region
+ :help "Execute the region as Lisp code"
:enable mark-active))
- (define-key menu-map [eval-sexp]
- `(menu-item ,(purecopy "Evaluate Last S-expression") eval-last-sexp
- :help ,(purecopy "Evaluate sexp before point; print value in minibuffer")))
- (define-key menu-map [separator-format] menu-bar-separator)
- (define-key menu-map [comment-region]
- `(menu-item ,(purecopy "Comment Out Region") comment-region
- :help ,(purecopy "Comment or uncomment each line in the region")
+ (bindings--define-key menu-map [eval-sexp]
+ '(menu-item "Evaluate Last S-expression" eval-last-sexp
+ :help "Evaluate sexp before point; print value in minibuffer"))
+ (bindings--define-key menu-map [separator-format] menu-bar-separator)
+ (bindings--define-key menu-map [comment-region]
+ '(menu-item "Comment Out Region" comment-region
+ :help "Comment or uncomment each line in the region"
:enable mark-active))
- (define-key menu-map [indent-region]
- `(menu-item ,(purecopy "Indent Region") indent-region
- :help ,(purecopy "Indent each nonblank line in the region")
+ (bindings--define-key menu-map [indent-region]
+ '(menu-item "Indent Region" indent-region
+ :help "Indent each nonblank line in the region"
:enable mark-active))
- (define-key menu-map [indent-line]
- `(menu-item ,(purecopy "Indent Line") lisp-indent-line))
+ (bindings--define-key menu-map [indent-line]
+ '(menu-item "Indent Line" lisp-indent-line))
map)
"Keymap for Emacs Lisp mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
@@ -442,22 +431,77 @@ if that value is non-nil."
(add-hook 'completion-at-point-functions
'lisp-completion-at-point nil 'local))
+;;; Emacs Lisp Byte-Code mode
+
+(eval-and-compile
+ (defconst emacs-list-byte-code-comment-re
+ (concat "\\(#\\)@\\([0-9]+\\) "
+ ;; Make sure it's a docstring and not a lazy-loaded byte-code.
+ "\\(?:[^(]\\|([^\"]\\)")))
+
+(defun emacs-lisp-byte-code-comment (end &optional _point)
+ "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
+ (let ((ppss (syntax-ppss)))
+ (when (and (nth 4 ppss)
+ (eq (char-after (nth 8 ppss)) ?#))
+ (let* ((n (save-excursion
+ (goto-char (nth 8 ppss))
+ (when (looking-at emacs-list-byte-code-comment-re)
+ (string-to-number (match-string 2)))))
+ ;; `maxdiff' tries to make sure the loop below terminates.
+ (maxdiff n))
+ (when n
+ (let* ((bchar (match-end 2))
+ (b (position-bytes bchar)))
+ (goto-char (+ b n))
+ (while (let ((diff (- (position-bytes (point)) b n)))
+ (unless (zerop diff)
+ (when (> diff maxdiff) (setq diff maxdiff))
+ (forward-char (- diff))
+ (setq maxdiff (if (> diff 0) diff
+ (max (1- maxdiff) 1)))
+ t))))
+ (if (<= (point) end)
+ (put-text-property (1- (point)) (point)
+ 'syntax-table
+ (string-to-syntax "> b"))
+ (goto-char end)))))))
+
+(defun emacs-lisp-byte-code-syntax-propertize (start end)
+ (emacs-lisp-byte-code-comment end (point))
+ (funcall
+ (syntax-propertize-rules
+ (emacs-list-byte-code-comment-re
+ (1 (prog1 "< b" (emacs-lisp-byte-code-comment end (point))))))
+ start end))
+
+(add-to-list 'auto-mode-alist '("\\.elc\\'" . emacs-lisp-byte-code-mode))
+(define-derived-mode emacs-lisp-byte-code-mode emacs-lisp-mode
+ "Elisp-Byte-Code"
+ "Major mode for *.elc files."
+ ;; TODO: Add way to disassemble byte-code under point.
+ (setq-local open-paren-in-column-0-is-defun-start nil)
+ (setq-local syntax-propertize-function
+ #'emacs-lisp-byte-code-syntax-propertize))
+
+;;; Generic Lisp mode.
+
(defvar lisp-mode-map
(let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap "Lisp")))
(set-keymap-parent map lisp-mode-shared-map)
(define-key map "\e\C-x" 'lisp-eval-defun)
(define-key map "\C-c\C-z" 'run-lisp)
- (define-key map [menu-bar lisp] (cons (purecopy "Lisp") menu-map))
- (define-key menu-map [run-lisp]
- `(menu-item ,(purecopy "Run inferior Lisp") run-lisp
- :help ,(purecopy "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'")))
- (define-key menu-map [ev-def]
- `(menu-item ,(purecopy "Eval defun") lisp-eval-defun
- :help ,(purecopy "Send the current defun to the Lisp process made by M-x run-lisp")))
- (define-key menu-map [ind-sexp]
- `(menu-item ,(purecopy "Indent sexp") indent-sexp
- :help ,(purecopy "Indent each line of the list starting just after point")))
+ (bindings--define-key map [menu-bar lisp] (cons "Lisp" menu-map))
+ (bindings--define-key menu-map [run-lisp]
+ '(menu-item "Run inferior Lisp" run-lisp
+ :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'"))
+ (bindings--define-key menu-map [ev-def]
+ '(menu-item "Eval defun" lisp-eval-defun
+ :help "Send the current defun to the Lisp process made by M-x run-lisp"))
+ (bindings--define-key menu-map [ind-sexp]
+ '(menu-item "Indent sexp" indent-sexp
+ :help "Indent each line of the list starting just after point"))
map)
"Keymap for ordinary Lisp mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
@@ -505,23 +549,24 @@ if that value is non-nil."
(define-key map "\e\C-q" 'indent-pp-sexp)
(define-key map "\e\t" 'completion-at-point)
(define-key map "\n" 'eval-print-last-sexp)
- (define-key map [menu-bar lisp-interaction] (cons (purecopy "Lisp-Interaction") menu-map))
- (define-key menu-map [eval-defun]
- `(menu-item ,(purecopy "Evaluate Defun") eval-defun
- :help ,(purecopy "Evaluate the top-level form containing point, or after point")))
- (define-key menu-map [eval-print-last-sexp]
- `(menu-item ,(purecopy "Evaluate and Print") eval-print-last-sexp
- :help ,(purecopy "Evaluate sexp before point; print value into current buffer")))
- (define-key menu-map [edebug-defun-lisp-interaction]
- `(menu-item ,(purecopy "Instrument Function for Debugging") edebug-defun
- :help ,(purecopy "Evaluate the top level form point is in, stepping through with Edebug")
- :keys ,(purecopy "C-u C-M-x")))
- (define-key menu-map [indent-pp-sexp]
- `(menu-item ,(purecopy "Indent or Pretty-Print") indent-pp-sexp
- :help ,(purecopy "Indent each line of the list starting just after point, or prettyprint it")))
- (define-key menu-map [complete-symbol]
- `(menu-item ,(purecopy "Complete Lisp Symbol") completion-at-point
- :help ,(purecopy "Perform completion on Lisp symbol preceding point")))
+ (bindings--define-key map [menu-bar lisp-interaction]
+ (cons "Lisp-Interaction" menu-map))
+ (bindings--define-key menu-map [eval-defun]
+ '(menu-item "Evaluate Defun" eval-defun
+ :help "Evaluate the top-level form containing point, or after point"))
+ (bindings--define-key menu-map [eval-print-last-sexp]
+ '(menu-item "Evaluate and Print" eval-print-last-sexp
+ :help "Evaluate sexp before point; print value into current buffer"))
+ (bindings--define-key menu-map [edebug-defun-lisp-interaction]
+ '(menu-item "Instrument Function for Debugging" edebug-defun
+ :help "Evaluate the top level form point is in, stepping through with Edebug"
+ :keys "C-u C-M-x"))
+ (bindings--define-key menu-map [indent-pp-sexp]
+ '(menu-item "Indent or Pretty-Print" indent-pp-sexp
+ :help "Indent each line of the list starting just after point, or prettyprint it"))
+ (bindings--define-key menu-map [complete-symbol]
+ '(menu-item "Complete Lisp Symbol" completion-at-point
+ :help "Perform completion on Lisp symbol preceding point"))
map)
"Keymap for Lisp Interaction mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
@@ -540,7 +585,8 @@ Semicolons start comments.
\\{lisp-interaction-mode-map}
Entry to this mode calls the value of `lisp-interaction-mode-hook'
-if that value is non-nil.")
+if that value is non-nil."
+ :abbrev-table nil)
(defun eval-print-last-sexp ()
"Evaluate sexp before point; print value into current buffer.
@@ -739,10 +785,12 @@ POS specifies the starting position where EXP was found and defaults to point."
(let ((vars ()))
(goto-char (point-min))
(while (re-search-forward
- "^(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
+ "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
pos t)
(let ((var (intern (match-string 1))))
- (unless (special-variable-p var)
+ (and (not (special-variable-p var))
+ (save-excursion
+ (zerop (car (syntax-ppss (match-beginning 0)))))
(push var vars))))
`(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
@@ -785,7 +833,12 @@ Reinitialize the face according to the `defface' specification."
(default-boundp (eval (nth 1 form) lexical-binding)))
;; Force variable to be bound.
(set-default (eval (nth 1 form) lexical-binding)
- (eval (nth 1 (nth 2 form)) lexical-binding))
+ ;; The second arg is an expression that evaluates to
+ ;; an expression. The second evaluation is the one
+ ;; normally performed not be normal execution but by
+ ;; custom-initialize-set (for example), which does not
+ ;; use lexical-binding.
+ (eval (eval (nth 2 form) lexical-binding)))
form)
;; `defface' is macroexpanded to `custom-declare-face'.
((eq (car form) 'custom-declare-face)
@@ -824,7 +877,6 @@ if it already has a value.\)
With argument, insert value in current buffer after the defun.
Return the result of evaluation."
- (interactive "P")
;; FIXME: the print-length/level bindings should only be applied while
;; printing, not while evaluating.
(let ((debug-on-error eval-expression-debug-on-error)
@@ -844,10 +896,10 @@ Return the result of evaluation."
(end-of-defun)
(beginning-of-defun)
(setq beg (point))
- (setq form (eval-sexp-add-defvars (read (current-buffer))))
+ (setq form (read (current-buffer)))
(setq end (point)))
;; Alter the form if necessary.
- (setq form (eval-defun-1 (macroexpand form)))
+ (setq form (eval-sexp-add-defvars (eval-defun-1 (macroexpand form))))
(list beg end standard-output
`(lambda (ignore)
;; Skipping to the end of the specified region
@@ -929,6 +981,7 @@ rigidly along with this one."
(if (or (null indent) (looking-at "\\s<\\s<\\s<"))
;; Don't alter indentation of a ;;; comment line
;; or a line that starts in a string.
+ ;; FIXME: inconsistency: comment-indent moves ;;; to column 0.
(goto-char (- (point-max) pos))
(if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
;; Single-semicolon comment lines should be indented
@@ -943,18 +996,7 @@ rigidly along with this one."
;; If initial point was within line's indentation,
;; position after the indentation. Else stay at same point in text.
(if (> (- (point-max) pos) (point))
- (goto-char (- (point-max) pos)))
- ;; If desired, shift remaining lines of expression the same amount.
- (and whole-exp (not (zerop shift-amt))
- (save-excursion
- (goto-char beg)
- (forward-sexp 1)
- (setq end (point))
- (goto-char beg)
- (forward-line 1)
- (setq beg (point))
- (> end beg))
- (indent-code-rigidly beg end shift-amt)))))
+ (goto-char (- (point-max) pos))))))
(defvar calculate-lisp-indent-last-sexp)
@@ -1150,7 +1192,8 @@ Lisp function does not specify a special indentation."
(let ((function (buffer-substring (point)
(progn (forward-sexp 1) (point))))
method)
- (setq method (or (get (intern-soft function) 'lisp-indent-function)
+ (setq method (or (function-get (intern-soft function)
+ 'lisp-indent-function)
(get (intern-soft function) 'lisp-indent-hook)))
(cond ((or (eq method 'defun)
(and (null method)
@@ -1227,14 +1270,12 @@ Lisp function does not specify a special indentation."
;; like defun if the first form is placed on the next line, otherwise
;; it is indented like any other form (i.e. forms line up under first).
-(put 'lambda 'lisp-indent-function 'defun)
(put 'autoload 'lisp-indent-function 'defun)
(put 'progn 'lisp-indent-function 0)
(put 'prog1 'lisp-indent-function 1)
(put 'prog2 'lisp-indent-function 2)
(put 'save-excursion 'lisp-indent-function 0)
(put 'save-restriction 'lisp-indent-function 0)
-(put 'save-match-data 'lisp-indent-function 0)
(put 'save-current-buffer 'lisp-indent-function 0)
(put 'let 'lisp-indent-function 1)
(put 'let* 'lisp-indent-function 1)
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index db6a03333d4..bcb7fab026b 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -1,6 +1,6 @@
;;; lisp.el --- Lisp editing commands for Emacs
-;; Copyright (C) 1985-1986, 1994, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1994, 2000-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: lisp, languages
@@ -257,9 +257,8 @@ is called as a function to find the defun's beginning."
(if (> arg 0)
(dotimes (i arg)
(funcall beginning-of-defun-function))
- ;; Better not call end-of-defun-function directly, in case
- ;; it's not defined.
- (end-of-defun (- arg))))))
+ (dotimes (i (- arg))
+ (funcall end-of-defun-function))))))
((or defun-prompt-regexp open-paren-in-column-0-is-defun-start)
(and (< arg 0) (not (eobp)) (forward-char 1))
@@ -448,7 +447,21 @@ Optional ARG is ignored."
;; Try first in this order for the sake of languages with nested
;; functions where several can end at the same place as with
;; the offside rule, e.g. Python.
- (beginning-of-defun)
+
+ ;; Finding the start of the function is a bit problematic since
+ ;; `beginning-of-defun' when we are on the first character of
+ ;; the function might go to the previous function.
+ ;;
+ ;; Therefore we first move one character forward and then call
+ ;; `beginning-of-defun'. However now we must check that we did
+ ;; not move into the next function.
+ (let ((here (point)))
+ (unless (eolp)
+ (forward-char))
+ (beginning-of-defun)
+ (when (< (point) here)
+ (goto-char here)
+ (beginning-of-defun)))
(setq beg (point))
(end-of-defun)
(setq end (point))
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index ccfdf2e0551..2a3730745c6 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -1,6 +1,6 @@
-;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t -*-
+;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t; coding: utf-8 -*-
;;
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: lisp, compiler, macros
@@ -29,13 +29,11 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
;; Bound by the top-level `macroexpand-all', and modified to include any
;; macros defined by `defmacro'.
(defvar macroexpand-all-environment nil)
-(defun maybe-cons (car cdr original-cons)
+(defun macroexp--cons (car cdr original-cons)
"Return (CAR . CDR), using ORIGINAL-CONS if possible."
(if (and (eq car (car original-cons)) (eq cdr (cdr original-cons)))
original-cons
@@ -43,9 +41,9 @@
;; We use this special macro to iteratively process forms and share list
;; structure of the result with the input. Doing so recursively using
-;; `maybe-cons' results in excessively deep recursion for very long
+;; `macroexp--cons' results in excessively deep recursion for very long
;; input forms.
-(defmacro macroexp-accumulate (var+list &rest body)
+(defmacro macroexp--accumulate (var+list &rest body)
"Return a list of the results of evaluating BODY for each element of LIST.
Evaluate BODY with VAR bound to each `car' from LIST, in turn.
Return a list of the values of the final form in BODY.
@@ -65,7 +63,7 @@ result will be eq to LIST).
(,unshared nil)
(,tail ,shared)
,var ,new-el)
- (while ,tail
+ (while (consp ,tail)
(setq ,var (car ,tail)
,new-el (progn ,@body))
(unless (eq ,var ,new-el)
@@ -76,27 +74,69 @@ result will be eq to LIST).
(setq ,tail (cdr ,tail)))
(nconc (nreverse ,unshared) ,shared))))
-(defun macroexpand-all-forms (forms &optional skip)
+(defun macroexp--all-forms (forms &optional skip)
"Return FORMS with macros expanded. FORMS is a list of forms.
If SKIP is non-nil, then don't expand that many elements at the start of
FORMS."
- (macroexp-accumulate (form forms)
+ (macroexp--accumulate (form forms)
(if (or (null skip) (zerop skip))
- (macroexpand-all-1 form)
+ (macroexp--expand-all form)
(setq skip (1- skip))
form)))
-(defun macroexpand-all-clauses (clauses &optional skip)
+(defun macroexp--all-clauses (clauses &optional skip)
"Return CLAUSES with macros expanded.
CLAUSES is a list of lists of forms; any clause that's not a list is ignored.
If SKIP is non-nil, then don't expand that many elements at the start of
each clause."
- (macroexp-accumulate (clause clauses)
+ (macroexp--accumulate (clause clauses)
(if (listp clause)
- (macroexpand-all-forms clause skip)
+ (macroexp--all-forms clause skip)
clause)))
-(defun macroexpand-all-1 (form)
+(defun macroexp--compiler-macro (handler form)
+ (condition-case err
+ (apply handler form (cdr form))
+ (error (message "Compiler-macro error for %S: %S" (car form) err)
+ form)))
+
+(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--funcall-if-compiled 'byte-compile
+ (lambda (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'.
Assumes the caller has bound `macroexpand-all-environment'."
@@ -105,61 +145,57 @@ Assumes the caller has bound `macroexpand-all-environment'."
;; generates exceedingly deep expansions from relatively shallow input
;; forms. We just process it `in reverse' -- first we expand all the
;; arguments, _then_ we expand the top-level definition.
- (macroexpand (macroexpand-all-forms form 1)
+ (macroexpand (macroexp--all-forms form 1)
macroexpand-all-environment)
;; Normal form; get its expansion, and then expand arguments.
- (let ((new-form (macroexpand form macroexpand-all-environment)))
- (when (and (not (eq form new-form)) ;It was a macro call.
- (car-safe form)
- (symbolp (car form))
- (get (car form) 'byte-obsolete-info)
- (fboundp 'byte-compile-warn-obsolete))
- (byte-compile-warn-obsolete (car form)))
- (setq form new-form))
+ (let ((new-form
+ (macroexpand form macroexpand-all-environment)))
+ (setq form
+ (if (and (not (eq form new-form)) ;It was a macro call.
+ (car-safe form)
+ (symbolp (car form))
+ (get (car form) 'byte-obsolete-info)
+ (or (not (fboundp 'byte-compile-warning-enabled-p))
+ (byte-compile-warning-enabled-p 'obsolete)))
+ (let* ((fun (car form))
+ (obsolete (get fun 'byte-obsolete-info)))
+ (macroexp--warn-and-return
+ (macroexp--obsolete-warning
+ fun obsolete
+ (if (symbolp (symbol-function fun))
+ "alias" "macro"))
+ new-form))
+ new-form)))
(pcase form
(`(cond . ,clauses)
- (maybe-cons 'cond (macroexpand-all-clauses clauses) form))
+ (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
(`(condition-case . ,(or `(,err ,body . ,handlers) dontcare))
- (maybe-cons
+ (macroexp--cons
'condition-case
- (maybe-cons err
- (maybe-cons (macroexpand-all-1 body)
- (macroexpand-all-clauses handlers 1)
+ (macroexp--cons err
+ (macroexp--cons (macroexp--expand-all body)
+ (macroexp--all-clauses handlers 1)
(cddr form))
(cdr form))
form))
- (`(defmacro ,name . ,args-and-body)
- (push (cons name (cons 'lambda args-and-body))
- macroexpand-all-environment)
- (let ((n 3))
- ;; Don't macroexpand `declare' since it should really be "expanded"
- ;; away when `defmacro' is expanded, but currently defmacro is not
- ;; itself a macro. So both `defmacro' and `declare' need to be
- ;; handled directly in bytecomp.el.
- ;; FIXME: Maybe a simpler solution is to (defalias 'declare 'quote).
- (while (or (stringp (nth n form))
- (eq (car-safe (nth n form)) 'declare))
- (setq n (1+ n)))
- (macroexpand-all-forms form n)))
- (`(defun . ,_) (macroexpand-all-forms form 3))
- (`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2))
+ (`(,(or `defvar `defconst) . ,_) (macroexp--all-forms form 2))
(`(function ,(and f `(lambda . ,_)))
- (maybe-cons 'function
- (maybe-cons (macroexpand-all-forms f 2)
+ (macroexp--cons 'function
+ (macroexp--cons (macroexp--all-forms f 2)
nil
(cdr form))
form))
(`(,(or `function `quote) . ,_) form)
(`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare))
- (maybe-cons fun
- (maybe-cons (macroexpand-all-clauses bindings 1)
- (macroexpand-all-forms body)
+ (macroexp--cons fun
+ (macroexp--cons (macroexp--all-clauses bindings 1)
+ (macroexp--all-forms body)
(cdr form))
form))
(`(,(and fun `(lambda . ,_)) . ,args)
;; Embedded lambda in function position.
- (maybe-cons (macroexpand-all-forms fun 2)
- (macroexpand-all-forms args)
+ (macroexp--cons (macroexp--all-forms fun 2)
+ (macroexp--all-forms args)
form))
;; The following few cases are for normal function calls that
;; are known to funcall one of their arguments. The byte
@@ -171,45 +207,44 @@ 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 `maybe-cons' since there's clearly a change.
- (cons fun
- (cons (macroexpand-all-1 (list 'function f))
- (macroexpand-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 `maybe-cons' since there's clearly a change.
- (cons fun
- (cons (macroexpand-all-1 arg1)
- (cons (macroexpand-all-1
- (list 'function f))
- (macroexpand-all-forms args)))))
- ;; Macro expand compiler macros. This cannot be delayed to
- ;; byte-optimize-form because the output of the compiler-macro can
- ;; use macros.
- ;; FIXME: Don't depend on CL.
- (`(,(pred (lambda (fun)
- (and (symbolp fun)
- (eq (get fun 'byte-compile)
- 'cl-byte-compile-compiler-macro)
- (functionp 'compiler-macroexpand))))
- . ,_)
- (let ((newform (with-no-warnings (compiler-macroexpand form))))
- (if (eq form newform)
- (macroexpand-all-forms form 1)
- (macroexpand-all-1 newform))))
- (`(,_ . ,_)
- ;; For every other list, we just expand each argument (for
- ;; setq/setq-default this works alright because the variable names
- ;; are symbols).
- (macroexpand-all-forms form 1))
+ (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
+ ;; use macros.
+ (let ((handler (function-get func 'compiler-macro)))
+ (if (null handler)
+ ;; No compiler macro. We just expand each argument (for
+ ;; setq/setq-default this works alright because the variable names
+ ;; are symbols).
+ (macroexp--all-forms form 1)
+ ;; If the handler is not loaded yet, try (auto)loading the
+ ;; function itself, which may in turn load the handler.
+ (unless (functionp handler)
+ (ignore-errors
+ (autoload-do-load (indirect-function func) func)))
+ (let ((newform (macroexp--compiler-macro handler form)))
+ (if (eq form newform)
+ ;; The compiler macro did not find anything to do.
+ (if (equal form (setq newform (macroexp--all-forms form 1)))
+ form
+ ;; Maybe after processing the args, some new opportunities
+ ;; appeared, so let's try the compiler macro again.
+ (setq form (macroexp--compiler-macro handler newform))
+ (if (eq newform form)
+ newform
+ (macroexp--expand-all newform)))
+ (macroexp--expand-all newform))))))
+
(t form))))
;;;###autoload
@@ -219,7 +254,190 @@ 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."
(let ((macroexpand-all-environment environment))
- (macroexpand-all-1 form)))
+ (macroexp--expand-all form)))
+
+;;; Handy functions to use in macros.
+
+(defun macroexp-progn (exps)
+ "Return an expression equivalent to `(progn ,@EXPS)."
+ (if (cdr exps) `(progn ,@exps) (car exps)))
+
+(defun macroexp-unprogn (exp)
+ "Turn EXP into a list of expressions to execute in sequence."
+ (if (eq (car-safe exp) 'progn) (cdr exp) (list exp)))
+
+(defun macroexp-let* (bindings exp)
+ "Return an expression equivalent to `(let* ,bindings ,exp)."
+ (cond
+ ((null bindings) exp)
+ ((eq 'let* (car-safe exp)) `(let* (,@bindings ,@(cadr exp)) ,@(cddr exp)))
+ (t `(let* ,bindings ,exp))))
+
+(defun macroexp-if (test then else)
+ "Return an expression equivalent to `(if ,test ,then ,else)."
+ (cond
+ ((eq (car-safe else) 'if)
+ (if (equal test (nth 1 else))
+ ;; Doing a test a second time: get rid of the redundancy.
+ `(if ,test ,then ,@(nthcdr 3 else))
+ `(cond (,test ,then)
+ (,(nth 1 else) ,(nth 2 else))
+ (t ,@(nthcdr 3 else)))))
+ ((eq (car-safe else) 'cond)
+ `(cond (,test ,then)
+ ;; Doing a test a second time: get rid of the redundancy, as above.
+ ,@(remove (assoc test else) (cdr else))))
+ ;; Invert the test if that lets us reduce the depth of the tree.
+ ((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then))
+ (t `(if ,test ,then ,else))))
+
+(defmacro macroexp-let2 (test var exp &rest exps)
+ "Bind VAR to a copyable expression that returns the value of EXP.
+This is like `(let ((v ,EXP)) ,EXPS) except that `v' is a new generated
+symbol which EXPS can find in VAR.
+TEST should be the name of a predicate on EXP checking whether the `let' can
+be skipped; if nil, as is usual, `macroexp-const-p' is used."
+ (declare (indent 3) (debug (sexp sexp form body)))
+ (let ((bodysym (make-symbol "body"))
+ (expsym (make-symbol "exp")))
+ `(let* ((,expsym ,exp)
+ (,var (if (funcall #',(or test #'macroexp-const-p) ,expsym)
+ ,expsym (make-symbol ,(symbol-name var))))
+ (,bodysym ,(macroexp-progn exps)))
+ (if (eq ,var ,expsym) ,bodysym
+ (macroexp-let* (list (list ,var ,expsym))
+ ,bodysym)))))
+
+(defun macroexp--maxsize (exp size)
+ (cond ((< size 0) size)
+ ((symbolp exp) (1- size))
+ ((stringp exp) (- size (/ (length exp) 16)))
+ ((vectorp exp)
+ (dotimes (i (length exp))
+ (setq size (macroexp--maxsize (aref exp i) size)))
+ (1- size))
+ ((consp exp)
+ ;; We could try to be more clever with quote&function,
+ ;; but it is difficult to do so correctly, and it's not obvious that
+ ;; it would be worth the effort.
+ (dolist (e exp)
+ (setq size (macroexp--maxsize e size)))
+ (1- size))
+ (t -1)))
+
+(defun macroexp-small-p (exp)
+ "Return non-nil if EXP can be considered small."
+ (> (macroexp--maxsize exp 10) 0))
+
+(defsubst macroexp--const-symbol-p (symbol &optional any-value)
+ "Non-nil if SYMBOL is constant.
+If ANY-VALUE is nil, only return non-nil if the value of the symbol is the
+symbol itself."
+ (or (memq symbol '(nil t))
+ (keywordp symbol)
+ (if any-value
+ (or (memq symbol byte-compile-const-variables)
+ ;; FIXME: We should provide a less intrusive way to find out
+ ;; if a variable is "constant".
+ (and (boundp symbol)
+ (condition-case nil
+ (progn (set symbol (symbol-value symbol)) nil)
+ (setting-constant t)))))))
+
+(defun macroexp-const-p (exp)
+ "Return non-nil if EXP will always evaluate to the same value."
+ (cond ((consp exp) (or (eq (car exp) 'quote)
+ (and (eq (car exp) 'function)
+ (symbolp (cadr exp)))))
+ ;; It would sometimes make sense to pass `any-value', but it's not
+ ;; always safe since a "constant" variable may not actually always have
+ ;; the same value.
+ ((symbolp exp) (macroexp--const-symbol-p exp))
+ (t t)))
+
+(defun macroexp-copyable-p (exp)
+ "Return non-nil if EXP can be copied without extra cost."
+ (or (symbolp exp) (macroexp-const-p exp)))
+
+;;; Load-time macro-expansion.
+
+;; Because macro-expansion used to be more lazy, eager macro-expansion
+;; tends to bump into previously harmless/unnoticeable cyclic-dependencies.
+;; So, we have to delay macro-expansion like we used to when we detect
+;; such a cycle, and we also want to help coders resolve those cycles (since
+;; they can be non-obvious) by providing a usefully trimmed backtrace
+;; (hopefully) highlighting the problem.
+
+(defun macroexp--backtrace ()
+ "Return the Elisp backtrace, more recent frames first."
+ (let ((bt ())
+ (i 0))
+ (while
+ (let ((frame (backtrace-frame i)))
+ (when frame
+ (push frame bt)
+ (setq i (1+ i)))))
+ (nreverse bt)))
+
+(defun macroexp--trim-backtrace-frame (frame)
+ (pcase frame
+ (`(,_ macroexpand (,head . ,_) . ,_) `(macroexpand (,head …)))
+ (`(,_ internal-macroexpand-for-load (,head ,second . ,_) . ,_)
+ (if (or (symbolp second)
+ (and (eq 'quote (car-safe second))
+ (symbolp (cadr second))))
+ `(macroexpand-all (,head ,second …))
+ '(macroexpand-all …)))
+ (`(,_ load-with-code-conversion ,name . ,_)
+ `(load ,(file-name-nondirectory name)))))
+
+(defvar macroexp--pending-eager-loads nil
+ "Stack of files currently undergoing eager macro-expansion.")
+
+(defun internal-macroexpand-for-load (form)
+ ;; Called from the eager-macroexpansion in readevalloop.
+ (cond
+ ;; Don't repeat the same warning for every top-level element.
+ ((eq 'skip (car macroexp--pending-eager-loads)) form)
+ ;; If we detect a cycle, skip macro-expansion for now, and output a warning
+ ;; with a trimmed backtrace.
+ ((and load-file-name (member load-file-name macroexp--pending-eager-loads))
+ (let* ((bt (delq nil
+ (mapcar #'macroexp--trim-backtrace-frame
+ (macroexp--backtrace))))
+ (elem `(load ,(file-name-nondirectory load-file-name)))
+ (tail (member elem (cdr (member elem bt)))))
+ (if tail (setcdr tail (list '…)))
+ (if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
+ (message "Warning: Eager macro-expansion skipped due to cycle:\n %s"
+ (mapconcat #'prin1-to-string (nreverse bt) " => "))
+ (push 'skip macroexp--pending-eager-loads)
+ form))
+ (t
+ (condition-case err
+ (let ((macroexp--pending-eager-loads
+ (cons load-file-name macroexp--pending-eager-loads)))
+ (macroexpand-all form))
+ (error
+ ;; Hopefully this shouldn't happen thanks to the cycle detection,
+ ;; but in case it does happen, let's catch the error and give the
+ ;; code a chance to macro-expand later.
+ (message "Eager macro-expansion failure: %S" err)
+ form)))))
+
+;; ¡¡¡ Big Ugly Hack !!!
+;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
+;; macroexp, bytecomp, cconv, and byte-opt to be fast. Generally this is done
+;; by compiling those files first, but this only makes a difference if those
+;; files are not preloaded. But macroexp.el is preloaded so we reload it if
+;; the current version is interpreted and there's a compiled version available.
+(eval-when-compile
+ (add-hook 'emacs-startup-hook
+ (lambda ()
+ (and (not (byte-code-function-p
+ (symbol-function 'macroexpand-all)))
+ (locate-library "macroexp.elc")
+ (load "macroexp.elc")))))
(provide 'macroexp)
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index 6ef26fef89c..289751f4944 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -1,10 +1,11 @@
;;; map-ynp.el --- general-purpose boolean question-asker
-;; Copyright (C) 1991-1995, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1995, 2000-2012 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Maintainer: FSF
;; Keywords: lisp, extensions
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -122,16 +123,6 @@ Returns the number of actions taken."
map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map query-replace-map)
- (define-key map [?\C-\M-v] 'scroll-other-window)
- (define-key map [M-next] 'scroll-other-window)
- (define-key map [?\C-\M-\S-v] 'scroll-other-window-down)
- (define-key map [M-prior] 'scroll-other-window-down)
- ;; The above are rather inconvenient, so maybe we should
- ;; provide the non-other keys for the other-scroll as well.
- ;; (define-key map [?\C-v] 'scroll-other-window)
- ;; (define-key map [next] 'scroll-other-window)
- ;; (define-key map [?\M-v] 'scroll-other-window-down)
- ;; (define-key map [prior] 'scroll-other-window-down)
(dolist (elt action-alist)
(define-key map (vector (car elt)) (vector (nth 1 elt))))
map)))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
new file mode 100644
index 00000000000..d9c5316b1b8
--- /dev/null
+++ b/lisp/emacs-lisp/nadvice.el
@@ -0,0 +1,457 @@
+;;; nadvice.el --- Light-weight advice primitives for Elisp functions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords: extensions, lisp, tools
+;; Package: 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.
+
+;; 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:
+
+;; This package lets you add behavior (which we call "piece of advice") to
+;; existing functions, like the old `advice.el' package, but with much fewer
+;; bells ans whistles. It comes in 2 parts:
+;;
+;; - The first part lets you add/remove functions, similarly to
+;; add/remove-hook, from any "place" (i.e. as accepted by `setf') that
+;; holds a function.
+;; This part provides mainly 2 macros: `add-function' and `remove-function'.
+;;
+;; - The second part provides `advice-add' and `advice-remove' which are
+;; refined version of the previous macros specially tailored for the case
+;; where the place that we want to modify is a `symbol-function'.
+
+;;; Code:
+
+;;;; Lightweight advice/hook
+(defvar advice--where-alist
+ '((:around "\300\301\302\003#\207" 5)
+ (:before "\300\301\002\"\210\300\302\002\"\207" 4)
+ (:after "\300\302\002\"\300\301\003\"\210\207" 5)
+ (:after-until "\300\302\002\"\206\013\000\300\301\002\"\207" 4)
+ (:after-while "\300\302\002\"\205\013\000\300\301\002\"\207" 4)
+ (:before-until "\300\301\002\"\206\013\000\300\302\002\"\207" 4)
+ (:before-while "\300\301\002\"\205\013\000\300\302\002\"\207" 4))
+ "List of descriptions of how to add a function.
+Each element has the form (WHERE BYTECODE STACK) where:
+ WHERE is a keyword indicating where the function is added.
+ BYTECODE is the corresponding byte-code that will be used.
+ STACK is the amount of stack space needed by the byte-code.")
+
+(defvar advice--bytecodes (mapcar #'cadr advice--where-alist))
+
+(defun advice--p (object)
+ (and (byte-code-function-p object)
+ (eq 128 (aref object 0))
+ (memq (length object) '(5 6))
+ (memq (aref object 1) advice--bytecodes)
+ (eq #'apply (aref (aref object 2) 0))))
+
+(defsubst advice--car (f) (aref (aref f 2) 1))
+(defsubst advice--cdr (f) (aref (aref f 2) 2))
+(defsubst advice--props (f) (aref (aref f 2) 3))
+
+(defun advice--make-docstring (_string function)
+ "Build the raw doc-string of SYMBOL, presumably advised."
+ (let ((flist (indirect-function function))
+ (docstring nil))
+ (if (eq 'macro (car-safe flist)) (setq flist (cdr flist)))
+ (while (advice--p flist)
+ (let ((bytecode (aref flist 1))
+ (where nil))
+ (dolist (elem advice--where-alist)
+ (if (eq bytecode (cadr elem)) (setq where (car elem))))
+ (setq docstring
+ (concat
+ docstring
+ (propertize (format "%s advice: " where)
+ 'face 'warning)
+ (let ((fun (advice--car flist)))
+ (if (symbolp fun) (format "`%S'" fun)
+ (let* ((name (cdr (assq 'name (advice--props flist))))
+ (doc (documentation fun t))
+ (usage (help-split-fundoc doc function)))
+ (if usage (setq doc (cdr usage)))
+ (if name
+ (if doc
+ (format "%s\n%s" name doc)
+ (format "%s" name))
+ (or doc "No documentation")))))
+ "\n")))
+ (setq flist (advice--cdr flist)))
+ (if docstring (setq docstring (concat docstring "\n")))
+ (let* ((origdoc (unless (eq function flist) ;Avoid inf-loops.
+ (documentation flist t)))
+ (usage (help-split-fundoc origdoc function)))
+ (setq usage (if (null usage)
+ (let ((arglist (help-function-arglist flist)))
+ (format "%S" (help-make-usage function arglist)))
+ (setq origdoc (cdr usage)) (car usage)))
+ (help-add-fundoc-usage (concat docstring origdoc) usage))))
+
+(defvar advice--docstring
+ ;; Can't eval-when-compile nor use defconst because it then gets pure-copied,
+ ;; which drops the text-properties.
+ ;;(eval-when-compile
+ (propertize "Advised function"
+ 'dynamic-docstring-function #'advice--make-docstring)) ;; )
+
+(defun advice-eval-interactive-spec (spec)
+ "Evaluate the interactive spec SPEC."
+ (cond
+ ((stringp spec)
+ ;; There's no direct access to the C code (in call-interactively) that
+ ;; processes those specs, but that shouldn't stop us, should it?
+ ;; FIXME: Despite appearances, this is not faithful: SPEC and
+ ;; (advice-eval-interactive-spec SPEC) will behave subtly differently w.r.t
+ ;; command-history (and maybe a few other details).
+ (call-interactively `(lambda (&rest args) (interactive ,spec) args)))
+ ;; ((functionp spec) (funcall spec))
+ (t (eval spec))))
+
+(defun advice--make-interactive-form (function main)
+ ;; TODO: make it so that interactive spec can be a constant which
+ ;; dynamically checks the advice--car/cdr to do its job.
+ ;; For that, advice-eval-interactive-spec needs to be more faithful.
+ ;; FIXME: The calls to interactive-form below load autoloaded functions
+ ;; too eagerly.
+ (let ((fspec (cadr (interactive-form function))))
+ (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda?
+ (setq fspec (nth 1 fspec)))
+ (if (functionp fspec)
+ `(funcall ',fspec
+ ',(cadr (interactive-form main)))
+ (cadr (or (interactive-form function)
+ (interactive-form main))))))
+
+(defsubst advice--make-1 (byte-code stack-depth function main props)
+ "Build a function value that adds FUNCTION to MAIN."
+ (let ((adv-sig (gethash main advertised-signature-table))
+ (advice
+ (apply #'make-byte-code 128 byte-code
+ (vector #'apply function main props) stack-depth
+ advice--docstring
+ (when (or (commandp function) (commandp main))
+ (list (advice--make-interactive-form
+ function main))))))
+ (when adv-sig (puthash advice adv-sig advertised-signature-table))
+ advice))
+
+(defun advice--make (where function main props)
+ "Build a function value that adds FUNCTION to MAIN at WHERE.
+WHERE is a symbol to select an entry in `advice--where-alist'."
+ (let ((desc (assq where advice--where-alist)))
+ (unless desc (error "Unknown add-function location `%S'" where))
+ (advice--make-1 (nth 1 desc) (nth 2 desc)
+ function main props)))
+
+(defun advice--member-p (function definition)
+ (let ((found nil))
+ (while (and (not found) (advice--p definition))
+ (if (or (equal function (advice--car definition))
+ (equal function (cdr (assq 'name (advice--props definition)))))
+ (setq found t)
+ (setq definition (advice--cdr definition))))
+ found))
+
+;;;###autoload
+(defun advice--remove-function (flist function)
+ (if (not (advice--p flist))
+ flist
+ (let ((first (advice--car flist))
+ (props (advice--props flist)))
+ (if (or (equal function first)
+ (equal function (cdr (assq 'name props))))
+ (advice--cdr flist)
+ (let* ((rest (advice--cdr flist))
+ (nrest (advice--remove-function rest function)))
+ (if (eq rest nrest) flist
+ (advice--make-1 (aref flist 1) (aref flist 3)
+ first nrest props)))))))
+
+(defvar advice--buffer-local-function-sample nil)
+
+(defun advice--set-buffer-local (var val)
+ (if (function-equal val advice--buffer-local-function-sample)
+ (kill-local-variable var)
+ (set (make-local-variable var) val)))
+
+;;;###autoload
+(defun advice--buffer-local (var)
+ "Buffer-local value of VAR, presumed to contain a function."
+ (declare (gv-setter advice--set-buffer-local))
+ (if (local-variable-p var) (symbol-value var)
+ (setq advice--buffer-local-function-sample
+ (lambda (&rest args) (apply (default-value var) args)))))
+
+;;;###autoload
+(defmacro add-function (where place function &optional props)
+ ;; TODO:
+ ;; - obsolete with-wrapper-hook (mostly requires buffer-local support).
+ ;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP
+ ;; and tracing want to stay first.
+ ;; - maybe let `where' specify some kind of predicate and use it
+ ;; to implement things like mode-local or eieio-defmethod.
+ ;; Of course, that only makes sense if the predicates of all advices can
+ ;; be combined and made more efficient.
+ ;; :before is like a normal add-hook on a normal hook.
+ ;; :before-while is like add-hook on run-hook-with-args-until-failure.
+ ;; :before-until is like add-hook on run-hook-with-args-until-success.
+ ;; Same with :after-* but for (add-hook ... 'append).
+ "Add a piece of advice on the function stored at PLACE.
+FUNCTION describes the code to add. WHERE describes where to add it.
+WHERE can be explained by showing the resulting new function, as the
+result of combining FUNCTION and the previous value of PLACE, which we
+call OLDFUN here:
+`:before' (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r))
+`:after' (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r)))
+`:around' (lambda (&rest r) (apply FUNCTION OLDFUN r))
+`:before-while' (lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r)))
+`:before-until' (lambda (&rest r) (or (apply FUNCTION r) (apply OLDFUN r)))
+`:after-while' (lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r)))
+`:after-until' (lambda (&rest r) (or (apply OLDFUN r) (apply FUNCTION r)))
+If FUNCTION was already added, do nothing.
+PROPS is an alist of additional properties, among which the following have
+a special meaning:
+- `name': a string or symbol. It can be used to refer to this piece of advice.
+
+PLACE cannot be a simple variable. Instead it should either be
+\(default-value 'VAR) or (local 'VAR) depending on whether FUNCTION
+should be applied to VAR buffer-locally or globally.
+
+If one of FUNCTION or OLDFUN is interactive, then the resulting function
+is also interactive. There are 3 cases:
+- FUNCTION is not interactive: the interactive spec of OLDFUN is used.
+- The interactive spec of FUNCTION is itself a function: it should take one
+ argument (the interactive spec of OLDFUN, which it can pass to
+ `advice-eval-interactive-spec') and return the list of arguments to use.
+- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN."
+ (declare (debug t)) ;;(indent 2)
+ (cond ((eq 'local (car-safe place))
+ (setq place `(advice--buffer-local ,@(cdr place))))
+ ((symbolp place)
+ (error "Use (default-value '%S) or (local '%S)" place place)))
+ `(advice--add-function ,where (gv-ref ,place) ,function ,props))
+
+;;;###autoload
+(defun advice--add-function (where ref function props)
+ (unless (advice--member-p function (gv-deref ref))
+ (setf (gv-deref ref)
+ (advice--make where function (gv-deref ref) props))))
+
+(defmacro remove-function (place function)
+ "Remove the FUNCTION piece of advice from PLACE.
+If FUNCTION was not added to PLACE, do nothing.
+Instead of FUNCTION being the actual function, it can also be the `name'
+of the piece of advice."
+ (declare (debug t))
+ (cond ((eq 'local (car-safe place))
+ (setq place `(advice--buffer-local ,@(cdr place))))
+ ((symbolp place)
+ (error "Use (default-value '%S) or (local '%S)" place place)))
+ (gv-letplace (getter setter) place
+ (macroexp-let2 nil new `(advice--remove-function ,getter ,function)
+ `(unless (eq ,new ,getter) ,(funcall setter new)))))
+
+;;;; Specific application of add-function to `symbol-function' for advice.
+
+(defun advice--subst-main (old new)
+ (if (not (advice--p old))
+ new
+ (let* ((first (advice--car old))
+ (rest (advice--cdr old))
+ (props (advice--props old))
+ (nrest (advice--subst-main rest new)))
+ (if (equal rest nrest) old
+ (advice--make-1 (aref old 1) (aref old 3)
+ first nrest props)))))
+
+(defun advice--normalize (symbol def)
+ (cond
+ ((special-form-p def)
+ ;; Not worth the trouble trying to handle this, I think.
+ (error "advice-add failure: %S is a special form" symbol))
+ ((and (symbolp def)
+ (eq 'macro (car-safe (ignore-errors (indirect-function def)))))
+ (let ((newval (cons 'macro (cdr (indirect-function def)))))
+ (put symbol 'advice--saved-rewrite (cons def newval))
+ newval))
+ ;; `f' might be a pure (hence read-only) cons!
+ ((and (eq 'macro (car-safe def))
+ (not (ignore-errors (setcdr def (cdr def)) t)))
+ (cons 'macro (cdr def)))
+ (t def)))
+
+(defsubst advice--strip-macro (x)
+ (if (eq 'macro (car-safe x)) (cdr x) x))
+
+(defun advice--defalias-fset (fsetfun symbol newdef)
+ (when (get symbol 'advice--saved-rewrite)
+ (put symbol 'advice--saved-rewrite nil))
+ (setq newdef (advice--normalize symbol newdef))
+ (let* ((olddef (advice--strip-macro
+ (if (fboundp symbol) (symbol-function symbol))))
+ (oldadv
+ (cond
+ ((null (get symbol 'advice--pending))
+ (or olddef
+ (progn
+ (message "Delayed advice activation failed for %s: no data"
+ symbol)
+ nil)))
+ ((or (not olddef) (autoloadp olddef))
+ (prog1 (get symbol 'advice--pending)
+ (put symbol 'advice--pending nil)))
+ (t (message "Dropping left-over advice--pending for %s" symbol)
+ (put symbol 'advice--pending nil)
+ olddef))))
+ (let* ((snewdef (advice--strip-macro newdef))
+ (snewadv (advice--subst-main oldadv snewdef)))
+ (funcall (or fsetfun #'fset) symbol
+ (if (eq snewdef newdef) snewadv (cons 'macro snewadv))))))
+
+
+;;;###autoload
+(defun advice-add (symbol where function &optional props)
+ "Like `add-function' but for the function named SYMBOL.
+Contrary to `add-function', this will properly handle the cases where SYMBOL
+is defined as a macro, alias, command, ..."
+ ;; TODO:
+ ;; - record the advice location, to display in describe-function.
+ ;; - change all defadvice in lisp/**/*.el.
+ ;; - rewrite advice.el on top of this.
+ ;; - obsolete advice.el.
+ (let* ((f (and (fboundp symbol) (symbol-function symbol)))
+ (nf (advice--normalize symbol f)))
+ (unless (eq f nf) ;; Most importantly, if nf == nil!
+ (fset symbol nf))
+ (add-function where (cond
+ ((eq (car-safe nf) 'macro) (cdr nf))
+ ;; Reasons to delay installation of the advice:
+ ;; - If the function is not yet defined, installing
+ ;; the advice would affect `fboundp'ness.
+ ;; - If it's an autoloaded command,
+ ;; advice--make-interactive-form would end up
+ ;; loading the command eagerly.
+ ;; - `autoload' does nothing if the function is
+ ;; not an autoload or undefined.
+ ((or (not nf) (autoloadp nf))
+ (get symbol 'advice--pending))
+ (t (symbol-function symbol)))
+ function props)
+ (add-function :around (get symbol 'defalias-fset-function)
+ #'advice--defalias-fset))
+ nil)
+
+;;;###autoload
+(defun advice-remove (symbol function)
+ "Like `remove-function' but for the function named SYMBOL.
+Contrary to `remove-function', this will work also when SYMBOL is a macro
+and it will not signal an error if SYMBOL is not `fboundp'.
+Instead of the actual function to remove, FUNCTION can also be the `name'
+of the piece of advice."
+ (when (fboundp symbol)
+ (let ((f (symbol-function symbol)))
+ ;; Can't use the `if' place here, because the body is too large,
+ ;; resulting in use of code that only works with lexical-scoping.
+ (remove-function (if (eq (car-safe f) 'macro)
+ (cdr f)
+ (symbol-function symbol))
+ function)
+ (unless (advice--p
+ (if (eq (car-safe f) 'macro) (cdr f) (symbol-function symbol)))
+ ;; Not advised any more.
+ (remove-function (get symbol 'defalias-fset-function)
+ #'advice--defalias-fset)
+ (if (eq (symbol-function symbol)
+ (cdr (get symbol 'advice--saved-rewrite)))
+ (fset symbol (car (get symbol 'advice--saved-rewrite))))))
+ nil))
+
+;; (defun advice-mapc (fun symbol)
+;; "Apply FUN to every function added as advice to SYMBOL.
+;; FUN is called with a two arguments: the function that was added, and the
+;; properties alist that was specified when it was added."
+;; (let ((def (or (get symbol 'advice--pending)
+;; (if (fboundp symbol) (symbol-function symbol)))))
+;; (while (advice--p def)
+;; (funcall fun (advice--car def) (advice--props def))
+;; (setq def (advice--cdr def)))))
+
+;;;###autoload
+(defun advice-member-p (advice function-name)
+ "Return non-nil if ADVICE has been added to FUNCTION-NAME.
+Instead of ADVICE being the actual function, it can also be the `name'
+of the piece of advice."
+ (advice--member-p advice
+ (or (get function-name 'advice--pending)
+ (advice--strip-macro
+ (if (fboundp function-name)
+ (symbol-function function-name))))))
+
+;; When code is advised, called-interactively-p needs to be taught to skip
+;; the advising frames.
+;; FIXME: This Major Ugly Hack won't handle calls to called-interactively-p
+;; done from the advised function if the deepest advice is an around advice!
+;; In other cases (calls from an advice or calls from the advised function when
+;; the deepest advice is not an around advice), it should hopefully get
+;; it right.
+(add-hook 'called-interactively-p-functions
+ #'advice--called-interactively-skip)
+(defun advice--called-interactively-skip (origi frame1 frame2)
+ (let* ((i origi)
+ (get-next-frame
+ (lambda ()
+ (setq frame1 frame2)
+ (setq frame2 (internal--called-interactively-p--get-frame i))
+ ;; (message "Advice Frame %d = %S" i frame2)
+ (setq i (1+ i)))))
+ (when (and (eq (nth 1 frame2) 'apply)
+ (progn
+ (funcall get-next-frame)
+ (advice--p (indirect-function (nth 1 frame2)))))
+ (funcall get-next-frame)
+ ;; If we now have the symbol, this was the head advice and
+ ;; we're done.
+ (while (advice--p (nth 1 frame1))
+ ;; This was an inner advice called from some earlier advice.
+ ;; The stack frames look different depending on the particular
+ ;; kind of the earlier advice.
+ (let ((inneradvice (nth 1 frame1)))
+ (if (and (eq (nth 1 frame2) 'apply)
+ (progn
+ (funcall get-next-frame)
+ (advice--p (indirect-function
+ (nth 1 frame2)))))
+ ;; The earlier advice was something like a before/after
+ ;; advice where the "next" code is called directly by the
+ ;; advice--p object.
+ (funcall get-next-frame)
+ ;; It's apparently an around advice, where the "next" is
+ ;; called by the body of the advice in any way it sees fit,
+ ;; so we need to skip the frames of that body.
+ (while
+ (progn
+ (funcall get-next-frame)
+ (not (and (eq (nth 1 frame2) 'apply)
+ (eq (nth 3 frame2) inneradvice)))))
+ (funcall get-next-frame)
+ (funcall get-next-frame))))
+ (- i origi 1))))
+
+
+(provide 'nadvice)
+;;; nadvice.el ends here
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index cd4b5ee231c..0b6fd277ae2 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -1,6 +1,6 @@
;;; package-x.el --- Package extras
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Created: 10 Mar 2007
@@ -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 a1513039a98..6629410a1f1 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1,18 +1,18 @@
;;; package.el --- Simple package system for Emacs
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Created: 10 Mar 2007
-;; Version: 0.9
+;; Version: 1.0
;; Keywords: tools
;; 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:
@@ -382,30 +380,37 @@ controls which package subdirectories may be loaded.
In each valid package subdirectory, this function loads the
description file containing a call to `define-package', which
updates `package-alist' and `package-obsolete-alist'."
- (let ((all (memq 'all package-load-list))
- (regexp (concat "\\`" package-subdirectory-regexp "\\'"))
- name version force)
+ (let ((regexp (concat "\\`" package-subdirectory-regexp "\\'")))
(dolist (dir (cons package-user-dir package-directory-list))
(when (file-directory-p dir)
(dolist (subdir (directory-files dir))
- (when (and (file-directory-p (expand-file-name subdir dir))
- (string-match regexp subdir))
- (setq name (intern (match-string 1 subdir))
- version (match-string 2 subdir)
- force (assq name package-load-list))
- (when (cond
- ((null force)
- all) ; not in package-load-list
- ((null (setq force (cadr force)))
- nil) ; disabled
- ((eq force t)
- t)
- ((stringp force) ; held
- (version-list-= (version-to-list version)
- (version-to-list force)))
- (t
- (error "Invalid element in `package-load-list'")))
- (package-load-descriptor dir subdir))))))))
+ (when (string-match regexp subdir)
+ (package-maybe-load-descriptor (match-string 1 subdir)
+ (match-string 2 subdir)
+ dir)))))))
+
+(defun package-maybe-load-descriptor (name version dir)
+ "Maybe load a specific package from directory DIR.
+NAME and VERSION are the package's name and version strings.
+This function checks `package-load-list', before actually loading
+the package by calling `package-load-descriptor'."
+ (let ((force (assq (intern name) package-load-list))
+ (subdir (concat name "-" version)))
+ (and (file-directory-p (expand-file-name subdir dir))
+ ;; Check `package-load-list':
+ (cond ((null force)
+ (memq 'all package-load-list))
+ ((null (setq force (cadr force)))
+ nil) ; disabled
+ ((eq force t)
+ t)
+ ((stringp force) ; held
+ (version-list-= (version-to-list version)
+ (version-to-list force)))
+ (t
+ (error "Invalid element in `package-load-list'")))
+ ;; Actually load the descriptor:
+ (package-load-descriptor dir subdir))))
(defsubst package-desc-vers (desc)
"Extract version from a package description vector."
@@ -462,8 +467,11 @@ NAME and VERSION are both strings."
Optional arg MIN-VERSION, if non-nil, should be a version list
specifying the minimum acceptable version."
(require 'finder-inf nil t) ; For `package--builtins'.
- (let ((elt (assq package package--builtins)))
- (and elt (version-list-<= min-version (package-desc-vers (cdr elt))))))
+ (if (eq package 'emacs)
+ (version-list-<= min-version (version-to-list emacs-version))
+ (let ((elt (assq package package--builtins)))
+ (and elt (version-list-<= min-version
+ (package-desc-vers (cdr elt)))))))
;; This function goes ahead and activates a newer version of a package
;; if an older one was already activated. This is not ideal; we'd at
@@ -517,7 +525,7 @@ Required package `%s-%s' is unavailable"
(defun define-package (name-string version-string
&optional docstring requirements
- &rest extra-properties)
+ &rest _extra-properties)
"Define a new package.
NAME-STRING is the name of the package, as a string.
VERSION-STRING is the version of the package, as a string.
@@ -577,12 +585,14 @@ EXTRA-PROPERTIES is currently unused."
(defun package-generate-autoloads (name pkg-dir)
(require 'autoload) ;Load before we let-bind generated-autoload-file!
(let* ((auto-name (concat name "-autoloads.el"))
- (ignore-name (concat name "-pkg.el"))
+ ;;(ignore-name (concat name "-pkg.el"))
(generated-autoload-file (expand-file-name auto-name pkg-dir))
(version-control 'never))
(unless (fboundp 'autoload-ensure-default-file)
(package-autoload-ensure-default-file generated-autoload-file))
- (update-directory-autoloads pkg-dir)))
+ (update-directory-autoloads pkg-dir)
+ (let ((buf (find-buffer-visiting generated-autoload-file)))
+ (when buf (kill-buffer buf)))))
(defvar tar-parse-info)
(declare-function tar-untar-buffer "tar-mode" ())
@@ -600,16 +610,25 @@ untar into a directory named DIR; otherwise, signal an error."
(error "Package does not untar cleanly into directory %s/" dir))))
(tar-untar-buffer))
-(defun package-unpack (name version)
- (let* ((dirname (concat (symbol-name name) "-" version))
+(defun package-unpack (package version)
+ (let* ((name (symbol-name package))
+ (dirname (concat name "-" version))
(pkg-dir (expand-file-name dirname package-user-dir)))
(make-directory package-user-dir t)
;; FIXME: should we delete PKG-DIR if it exists?
(let* ((default-directory (file-name-as-directory package-user-dir)))
(package-untar-buffer dirname)
- (package-generate-autoloads (symbol-name name) pkg-dir)
- (let ((load-path (cons pkg-dir load-path)))
- (byte-recompile-directory pkg-dir 0 t)))))
+ (package--make-autoloads-and-compile name pkg-dir))))
+
+(defun package--make-autoloads-and-compile (name pkg-dir)
+ "Generate autoloads and do byte-compilation for package named NAME.
+PKG-DIR is the name of the package directory."
+ (package-generate-autoloads name pkg-dir)
+ (let ((load-path (cons pkg-dir load-path)))
+ ;; We must load the autoloads file before byte compiling, in
+ ;; case there are magic cookies to set up non-trivial paths.
+ (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t)
+ (byte-recompile-directory pkg-dir 0 t)))
(defun package--write-file-no-coding (file-name)
(let ((buffer-file-coding-system 'no-conversion))
@@ -649,9 +668,7 @@ untar into a directory named DIR; otherwise, signal an error."
nil
pkg-file
nil nil nil 'excl))
- (package-generate-autoloads file-name pkg-dir)
- (let ((load-path (cons pkg-dir load-path)))
- (byte-recompile-directory pkg-dir 0 t)))))
+ (package--make-autoloads-and-compile file-name pkg-dir))))
(defmacro package--with-work-buffer (location file &rest body)
"Run BODY in a buffer containing the contents of FILE at LOCATION.
@@ -713,6 +730,7 @@ It will move point to somewhere in the headers."
(defun package-installed-p (package &optional min-version)
"Return true if PACKAGE, of MIN-VERSION or newer, is installed.
MIN-VERSION should be a version list."
+ (unless package--initialized (error "package.el is not yet initialized!"))
(let ((pkg-desc (assq package package-alist)))
(if pkg-desc
(version-list-<= min-version
@@ -743,7 +761,8 @@ not included in this list."
hold)
(when (setq hold (assq next-pkg package-load-list))
(setq hold (cadr hold))
- (cond ((eq hold nil)
+ (cond ((eq hold t))
+ ((eq hold nil)
(error "Required package '%s' is disabled"
(symbol-name next-pkg)))
((null (stringp hold))
@@ -861,7 +880,13 @@ using `package-compute-transaction'."
(package-desc-doc desc)
(package-desc-reqs desc)))
(t
- (error "Unknown package kind: %s" (symbol-name kind)))))))
+ (error "Unknown package kind: %s" (symbol-name kind))))
+ ;; If package A depends on package B, then A may `require' B
+ ;; during byte compilation. So we need to activate B before
+ ;; unpacking A.
+ (package-maybe-load-descriptor (symbol-name elt) v-string
+ package-user-dir)
+ (package-activate elt (version-to-list v-string)))))
(defvar package--initialized nil)
@@ -876,6 +901,8 @@ archive in `package-archives'. Interactively, prompt for NAME."
;; symbols for completion.
(unless package--initialized
(package-initialize t))
+ (unless package-archive-contents
+ (package-refresh-contents))
(list (intern (completing-read
"Install package: "
(mapcar (lambda (elt)
@@ -889,9 +916,7 @@ archive in `package-archives'. Interactively, prompt for NAME."
(symbol-name name)))
(package-download-transaction
(package-compute-transaction (list name)
- (package-desc-reqs (cdr pkg-desc)))))
- ;; Try to activate it.
- (package-initialize))
+ (package-desc-reqs (cdr pkg-desc))))))
(defun package-strip-rcs-id (str)
"Strip RCS version ID from the version string STR.
@@ -922,7 +947,7 @@ If the buffer does not contain a conforming package, signal an
error. If there is a package, narrow the buffer to the file's
boundaries."
(goto-char (point-min))
- (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t)
+ (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
(error "Packages lacks a file header"))
(let ((file-name (match-string-no-properties 1))
(desc (match-string-no-properties 2))
@@ -1090,7 +1115,7 @@ makes them available for download."
(unless (file-exists-p package-user-dir)
(make-directory package-user-dir t))
(dolist (archive package-archives)
- (condition-case-no-debug nil
+ (condition-case-unless-debug nil
(package--download-one-archive archive "archive-contents")
(error (message "Failed to download `%s' archive."
(car archive)))))
@@ -1338,6 +1363,9 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
map)
"Local keymap for `package-menu-mode' buffers.")
+(defvar package-menu--new-package-list nil
+ "List of newly-available packages since `list-packages' was last called.")
+
(define-derived-mode package-menu-mode tabulated-list-mode "Package Menu"
"Major mode for browsing a list of packages.
Letters do not insert themselves; instead, they are commands.
@@ -1368,7 +1396,7 @@ If REMEMBER-POS is non-nil, keep point on the same entry.
PACKAGES should be t, which means to display all known packages,
or a list of package names (symbols) to display."
;; Construct list of ((PACKAGE . VERSION) STATUS DESCRIPTION).
- (let (info-list name builtin)
+ (let (info-list name)
;; Installed packages:
(dolist (elt package-alist)
(setq name (car elt))
@@ -1391,9 +1419,10 @@ or a list of package names (symbols) to display."
(when (or (eq packages t) (memq name packages))
(let ((hold (assq name package-load-list)))
(package--push name (cdr elt)
- (if (and hold (null (cadr hold)))
- "disabled"
- "available")
+ (cond
+ ((and hold (null (cadr hold))) "disabled")
+ ((memq name package-menu--new-package-list) "new")
+ (t "available"))
info-list))))
;; Obsolete packages:
@@ -1418,6 +1447,7 @@ identifier (NAME . VERSION-LIST)."
(face (cond
((string= status "built-in") 'font-lock-builtin-face)
((string= status "available") 'default)
+ ((string= status "new") 'bold)
((string= status "held") 'font-lock-constant-face)
((string= status "disabled") 'font-lock-warning-face)
((string= status "installed") 'font-lock-comment-face)
@@ -1453,21 +1483,21 @@ If optional arg BUTTON is non-nil, describe its associated package."
(describe-package package))))
;; fixme numeric argument
-(defun package-menu-mark-delete (&optional num)
+(defun package-menu-mark-delete (&optional _num)
"Mark a package for deletion and move to the next line."
(interactive "p")
(if (member (package-menu-get-status) '("installed" "obsolete"))
(tabulated-list-put-tag "D" t)
(forward-line)))
-(defun package-menu-mark-install (&optional num)
+(defun package-menu-mark-install (&optional _num)
"Mark a package for installation and move to the next line."
(interactive "p")
- (if (string-equal (package-menu-get-status) "available")
+ (if (member (package-menu-get-status) '("available" "new"))
(tabulated-list-put-tag "I" t)
(forward-line)))
-(defun package-menu-mark-unmark (&optional num)
+(defun package-menu-mark-unmark (&optional _num)
"Clear any marks on a package and move to the next line."
(interactive "p")
(tabulated-list-put-tag " " t))
@@ -1509,11 +1539,10 @@ If optional arg BUTTON is non-nil, describe its associated package."
(dolist (entry tabulated-list-entries)
;; ENTRY is ((NAME . VERSION) [NAME VERSION STATUS DOC])
(let ((pkg (car entry))
- (status (aref (cadr entry) 2))
- old)
+ (status (aref (cadr entry) 2)))
(cond ((equal status "installed")
(push pkg installed))
- ((equal status "available")
+ ((member status '("available" "new"))
(push pkg available)))))
;; Loop through list of installed packages, finding upgrades
(dolist (pkg installed)
@@ -1595,7 +1624,7 @@ packages marked for deletion are removed."
delete-list
", "))))
(dolist (elt delete-list)
- (condition-case-no-debug err
+ (condition-case-unless-debug err
(package-delete (car elt) (cdr elt))
(error (message (cadr err)))))
(error "Aborted")))
@@ -1619,16 +1648,18 @@ packages marked for deletion are removed."
(sB (aref (cadr B) 2)))
(cond ((string= sA sB)
(package-menu--name-predicate A B))
- ((string= sA "available") t)
+ ((string= sA "new") t)
+ ((string= sB "new") nil)
+ ((string= sA "available") t)
((string= sB "available") nil)
- ((string= sA "installed") t)
+ ((string= sA "installed") t)
((string= sB "installed") nil)
- ((string= sA "held") t)
+ ((string= sA "held") t)
((string= sB "held") nil)
- ((string= sA "built-in") t)
+ ((string= sA "built-in") t)
((string= sB "built-in") nil)
- ((string= sA "obsolete") t)
- ((string= sB "obsolete") nil)
+ ((string= sA "obsolete") t)
+ ((string= sB "obsolete") nil)
(t (string< sA sB)))))
(defun package-menu--description-predicate (A B)
@@ -1653,22 +1684,36 @@ The list is displayed in a buffer named `*Packages*'."
;; Initialize the package system if necessary.
(unless package--initialized
(package-initialize t))
- (unless no-fetch
- (package-refresh-contents))
- (let ((buf (get-buffer-create "*Packages*")))
- (with-current-buffer buf
- (package-menu-mode)
- (package-menu--generate nil t))
- ;; The package menu buffer has keybindings. If the user types
- ;; `M-x list-packages', that suggests it should become current.
- (switch-to-buffer buf))
- (let ((upgrades (package-menu--find-upgrades)))
- (if upgrades
- (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
- (length upgrades)
- (if (= (length upgrades) 1) "" "s")
- (substitute-command-keys "\\[package-menu-mark-upgrades]")
- (if (= (length upgrades) 1) "it" "them")))))
+ (let (old-archives new-packages)
+ (unless no-fetch
+ ;; Read the locally-cached archive-contents.
+ (package-read-all-archive-contents)
+ (setq old-archives package-archive-contents)
+ ;; Fetch the remote list of packages.
+ (package-refresh-contents)
+ ;; Find which packages are new.
+ (dolist (elt package-archive-contents)
+ (unless (assq (car elt) old-archives)
+ (push (car elt) new-packages))))
+
+ ;; Generate the Package Menu.
+ (let ((buf (get-buffer-create "*Packages*")))
+ (with-current-buffer buf
+ (package-menu-mode)
+ (set (make-local-variable 'package-menu--new-package-list)
+ new-packages)
+ (package-menu--generate nil t))
+ ;; The package menu buffer has keybindings. If the user types
+ ;; `M-x list-packages', that suggests it should become current.
+ (switch-to-buffer buf))
+
+ (let ((upgrades (package-menu--find-upgrades)))
+ (if upgrades
+ (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
+ (length upgrades)
+ (if (= (length upgrades) 1) "" "s")
+ (substitute-command-keys "\\[package-menu-mark-upgrades]")
+ (if (= (length upgrades) 1) "it" "them"))))))
;;;###autoload
(defalias 'package-list-packages 'list-packages)
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 6931ce75cb5..1312fc3731d 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -1,6 +1,6 @@
-;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t -*-
+;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t; coding: utf-8 -*-
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
@@ -39,25 +39,55 @@
;; - along these lines, provide patterns to match CL structs.
;; - provide something like (setq VAR) so a var can be set rather than
;; let-bound.
-;; - provide a way to fallthrough to subsequent cases.
+;; - provide a way to fallthrough to subsequent cases (not sure what I meant by
+;; this :-()
;; - try and be more clever to reduce the size of the decision tree, and
;; to reduce the number of leaves that need to be turned into function:
;; - first, do the tests shared by all remaining branches (it will have
-;; to be performed anyway, so better so it first so it's shared).
+;; to be performed anyway, so better do it first so it's shared).
;; - then choose the test that discriminates more (?).
+;; - provide Agda's `with' (along with its `...' companion).
+;; - implement (not UPAT). This might require a significant redesign.
;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to
;; generate a lex-style DFA to decide whether to run E1 or E2.
;;; Code:
+(require 'macroexp)
+
;; Macro-expansion of pcase is reasonably fast, so it's not a problem
;; when byte-compiling a file, but when interpreting the code, if the pcase
;; is in a loop, the repeated macro-expansion becomes terribly costly, so we
;; memoize previous macro expansions to try and avoid recomputing them
;; over and over again.
+;; FIXME: Now that macroexpansion is also performed when loading an interpreted
+;; file, this is not a real problem any more.
(defconst pcase--memoize (make-hash-table :weakness 'key :test 'eq))
-
-(defconst pcase--dontcare-upats '(t _ dontcare))
+;; (defconst pcase--memoize-1 (make-hash-table :test 'eq))
+;; (defconst pcase--memoize-2 (make-hash-table :weakness 'key :test 'equal))
+
+(defconst pcase--dontcare-upats '(t _ pcase--dontcare))
+
+(def-edebug-spec
+ pcase-UPAT
+ (&or symbolp
+ ("or" &rest pcase-UPAT)
+ ("and" &rest pcase-UPAT)
+ ("`" pcase-QPAT)
+ ("guard" form)
+ ("let" pcase-UPAT form)
+ ("pred"
+ &or lambda-expr
+ ;; Punt on macros/special forms.
+ (functionp &rest form)
+ sexp)
+ sexp))
+
+(def-edebug-spec
+ pcase-QPAT
+ (&or ("," pcase-UPAT)
+ (pcase-QPAT . pcase-QPAT)
+ sexp))
;;;###autoload
(defmacro pcase (exp &rest cases)
@@ -66,6 +96,7 @@ CASES is a list of elements of the form (UPATTERN CODE...).
UPatterns can take the following forms:
_ matches anything.
+ SELFQUOTING matches itself. This includes keywords, numbers, and strings.
SYMBOL matches anything and binds it to SYMBOL.
(or UPAT...) matches if any of the patterns matches.
(and UPAT...) matches if all the patterns match.
@@ -85,13 +116,14 @@ QPatterns for vectors are not implemented yet.
PRED can take the form
FUNCTION in which case it gets called with one argument.
- (FUN ARG1 .. ARGN) in which case it gets called with N+1 arguments.
+ (FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument
+ which is the value being matched.
A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION).
PRED patterns can refer to variables bound earlier in the pattern.
E.g. you can match pairs where the cdr is larger than the car with a pattern
like `(,a . ,(pred (< a))) or, with more checks:
`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))"
- (declare (indent 1) (debug case)) ;FIXME: edebug `guard' and vars.
+ (declare (indent 1) (debug (form &rest (pcase-UPAT body))))
;; We want to use a weak hash table as a cache, but the key will unavoidably
;; be based on `exp' and `cases', yet `cases' is a fresh new list each time
;; we're called so it'll be immediately GC'd. So we use (car cases) as key
@@ -102,37 +134,57 @@ like `(,a . ,(pred (< a))) or, with more checks:
(if (and (equal exp (car data)) (equal cases (cadr data)))
;; We have the right expansion.
(cddr data)
+ ;; (when (gethash (car cases) pcase--memoize-1)
+ ;; (message "pcase-memoize failed because of weak key!!"))
+ ;; (when (gethash (car cases) pcase--memoize-2)
+ ;; (message "pcase-memoize failed because of eq test on %S"
+ ;; (car cases)))
(when data
(message "pcase-memoize: equal first branch, yet different"))
(let ((expansion (pcase--expand exp cases)))
- (puthash (car cases) (cons exp (cons cases expansion)) pcase--memoize)
+ (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize)
+ ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-1)
+ ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
expansion))))
+(defun pcase--let* (bindings body)
+ (cond
+ ((null bindings) (macroexp-progn body))
+ ((pcase--trivial-upat-p (caar bindings))
+ (macroexp-let* `(,(car bindings)) (pcase--let* (cdr bindings) body)))
+ (t
+ (let ((binding (pop bindings)))
+ (pcase--expand
+ (cadr binding)
+ `((,(car binding) ,(pcase--let* bindings body))
+ ;; We can either signal an error here, or just use `pcase--dontcare'
+ ;; which generates more efficient code. In practice, if we use
+ ;; `pcase--dontcare' we will still often get an error and the few
+ ;; cases where we don't do not matter that much, so
+ ;; it's a better choice.
+ (pcase--dontcare nil)))))))
+
;;;###autoload
(defmacro pcase-let* (bindings &rest body)
"Like `let*' but where you can use `pcase' patterns for bindings.
BODY should be an expression, and BINDINGS should be a list of bindings
of the form (UPAT EXP)."
- (declare (indent 1) (debug let))
- (cond
- ((null bindings) (if (> (length body) 1) `(progn ,@body) (car body)))
- ((pcase--trivial-upat-p (caar bindings))
- `(let (,(car bindings)) (pcase-let* ,(cdr bindings) ,@body)))
- (t
- `(pcase ,(cadr (car bindings))
- (,(caar bindings) (pcase-let* ,(cdr bindings) ,@body))
- ;; We can either signal an error here, or just use `dontcare' which
- ;; generates more efficient code. In practice, if we use `dontcare' we
- ;; will still often get an error and the few cases where we don't do not
- ;; matter that much, so it's a better choice.
- (dontcare nil)))))
+ (declare (indent 1)
+ (debug ((&rest (pcase-UPAT &optional form)) body)))
+ (let ((cached (gethash bindings pcase--memoize)))
+ ;; cached = (BODY . EXPANSION)
+ (if (equal (car cached) body)
+ (cdr cached)
+ (let ((expansion (pcase--let* bindings body)))
+ (puthash bindings (cons body expansion) pcase--memoize)
+ expansion))))
;;;###autoload
(defmacro pcase-let (bindings &rest body)
"Like `let' but where you can use `pcase' patterns for bindings.
BODY should be a list of expressions, and BINDINGS should be a list of bindings
of the form (UPAT EXP)."
- (declare (indent 1) (debug let))
+ (declare (indent 1) (debug pcase-let*))
(if (null (cdr bindings))
`(pcase-let* ,bindings ,@body)
(let ((matches '()))
@@ -148,6 +200,7 @@ of the form (UPAT EXP)."
`(let ,(nreverse bindings) (pcase-let* ,matches ,@body)))))
(defmacro pcase-dolist (spec &rest body)
+ (declare (indent 1) (debug ((pcase-UPAT form) body)))
(if (pcase--trivial-upat-p (car spec))
`(dolist ,spec ,@body)
(let ((tmpvar (make-symbol "x")))
@@ -162,64 +215,78 @@ of the form (UPAT EXP)."
(defun pcase--expand (exp cases)
;; (message "pid=%S (pcase--expand %S ...hash=%S)"
;; (emacs-pid) exp (sxhash cases))
- (let* ((defs (if (symbolp exp) '()
- (let ((sym (make-symbol "x")))
- (prog1 `((,sym ,exp)) (setq exp sym)))))
- (seen '())
- (codegen
- (lambda (code vars)
- (let ((prev (assq code seen)))
- (if (not prev)
- (let ((res (pcase-codegen code vars)))
- (push (list code vars res) seen)
- res)
- ;; Since we use a tree-based pattern matching
- ;; technique, the leaves (the places that contain the
- ;; code to run once a pattern is matched) can get
- ;; copied a very large number of times, so to avoid
- ;; code explosion, we need to keep track of how many
- ;; times we've used each leaf and move it
- ;; to a separate function if that number is too high.
- ;;
- ;; We've already used this branch. So it is shared.
- (let* ((code (car prev)) (cdrprev (cdr prev))
- (prevvars (car cdrprev)) (cddrprev (cdr cdrprev))
- (res (car cddrprev)))
- (unless (symbolp res)
- ;; This is the first repeat, so we have to move
- ;; the branch to a separate function.
- (let ((bsym
- (make-symbol (format "pcase-%d" (length defs)))))
- (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code)) defs)
- (setcar res 'funcall)
- (setcdr res (cons bsym (mapcar #'cdr prevvars)))
- (setcar (cddr prev) bsym)
- (setq res bsym)))
- (setq vars (copy-sequence vars))
- (let ((args (mapcar (lambda (pa)
- (let ((v (assq (car pa) vars)))
- (setq vars (delq v vars))
- (cdr v)))
- prevvars)))
- (when vars ;New additional vars.
- (error "The vars %s are only bound in some paths"
- (mapcar #'car vars)))
- `(funcall ,res ,@args)))))))
- (main
- (pcase--u
- (mapcar (lambda (case)
- `((match ,exp . ,(car case))
- ,(apply-partially
- (if (pcase--small-branch-p (cdr case))
- ;; Don't bother sharing multiple
- ;; occurrences of this leaf since it's small.
- #'pcase-codegen codegen)
- (cdr case))))
- cases))))
- (if (null defs) main
- `(let ,defs ,main))))
+ (macroexp-let2 macroexp-copyable-p val exp
+ (let* ((defs ())
+ (seen '())
+ (codegen
+ (lambda (code vars)
+ (let ((prev (assq code seen)))
+ (if (not prev)
+ (let ((res (pcase-codegen code vars)))
+ (push (list code vars res) seen)
+ res)
+ ;; Since we use a tree-based pattern matching
+ ;; technique, the leaves (the places that contain the
+ ;; code to run once a pattern is matched) can get
+ ;; copied a very large number of times, so to avoid
+ ;; code explosion, we need to keep track of how many
+ ;; times we've used each leaf and move it
+ ;; to a separate function if that number is too high.
+ ;;
+ ;; We've already used this branch. So it is shared.
+ (let* ((code (car prev)) (cdrprev (cdr prev))
+ (prevvars (car cdrprev)) (cddrprev (cdr cdrprev))
+ (res (car cddrprev)))
+ (unless (symbolp res)
+ ;; This is the first repeat, so we have to move
+ ;; the branch to a separate function.
+ (let ((bsym
+ (make-symbol (format "pcase-%d" (length defs)))))
+ (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code))
+ defs)
+ (setcar res 'funcall)
+ (setcdr res (cons bsym (mapcar #'cdr prevvars)))
+ (setcar (cddr prev) bsym)
+ (setq res bsym)))
+ (setq vars (copy-sequence vars))
+ (let ((args (mapcar (lambda (pa)
+ (let ((v (assq (car pa) vars)))
+ (setq vars (delq v vars))
+ (cdr v)))
+ prevvars)))
+ ;; If some of `vars' were not found in `prevvars', that's
+ ;; OK it just means those vars aren't present in all
+ ;; branches, so they can be used within the pattern
+ ;; (e.g. by a `guard/let/pred') but not in the branch.
+ ;; FIXME: But if some of `prevvars' are not in `vars' we
+ ;; should remove them from `prevvars'!
+ `(funcall ,res ,@args)))))))
+ (used-cases ())
+ (main
+ (pcase--u
+ (mapcar (lambda (case)
+ `((match ,val . ,(car case))
+ ,(lambda (vars)
+ (unless (memq case used-cases)
+ ;; Keep track of the cases that are used.
+ (push case used-cases))
+ (funcall
+ (if (pcase--small-branch-p (cdr case))
+ ;; Don't bother sharing multiple
+ ;; occurrences of this leaf since it's small.
+ #'pcase-codegen codegen)
+ (cdr case)
+ vars))))
+ cases))))
+ (dolist (case cases)
+ (unless (or (memq case used-cases) (eq (car case) 'pcase--dontcare))
+ (message "Redundant pcase pattern: %S" (car case))))
+ (macroexp-let* defs main))))
(defun pcase-codegen (code vars)
+ ;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding
+ ;; let* which might prevent the setcar/setcdr in pcase--expand's fancy
+ ;; codegen from later metamorphosing this let into a funcall.
`(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars)
,@code))
@@ -237,23 +304,7 @@ of the form (UPAT EXP)."
(cond
((eq else :pcase--dontcare) then)
((eq then :pcase--dontcare) (debug) else) ;Can/should this ever happen?
- ((eq (car-safe else) 'if)
- (if (equal test (nth 1 else))
- ;; Doing a test a second time: get rid of the redundancy.
- ;; FIXME: ideally, this should never happen because the pcase--split-*
- ;; funs should have eliminated such things, but pcase--split-member
- ;; is imprecise, so in practice it can happen occasionally.
- `(if ,test ,then ,@(nthcdr 3 else))
- `(cond (,test ,then)
- (,(nth 1 else) ,(nth 2 else))
- (t ,@(nthcdr 3 else)))))
- ((eq (car-safe else) 'cond)
- `(cond (,test ,then)
- ;; Doing a test a second time: get rid of the redundancy, as above.
- ,@(remove (assoc test else) (cdr else))))
- ;; Invert the test if that lets us reduce the depth of the tree.
- ((memq (car-safe then) '(if cond)) (pcase--if `(not ,test) else then))
- (t `(if ,test ,then ,else))))
+ (t (macroexp-if test then else))))
(defun pcase--upat (qpattern)
(cond
@@ -433,26 +484,26 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase--split-pred (upat pat)
;; FIXME: For predicates like (pred (> a)), two such predicates may
;; actually refer to different variables `a'.
- (cond
- ((equal upat pat) (cons :pcase--succeed :pcase--fail))
- ((and (eq 'pred (car upat))
- (eq 'pred (car-safe pat))
- (or (member (cons (cadr upat) (cadr pat))
- pcase-mutually-exclusive-predicates)
- (member (cons (cadr pat) (cadr upat))
- pcase-mutually-exclusive-predicates)))
- (cons :pcase--fail nil))
- ;; ((and (eq 'pred (car upat))
- ;; (eq '\` (car-safe pat))
- ;; (symbolp (cadr upat))
- ;; (or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat)))
- ;; (get (cadr upat) 'side-effect-free)
- ;; (progn (message "Trying predicate %S" (cadr upat))
- ;; (ignore-errors
- ;; (funcall (cadr upat) (cadr pat)))))
- ;; (message "Simplify pred %S against %S" upat pat)
- ;; (cons nil :pcase--fail))
- ))
+ (let (test)
+ (cond
+ ((equal upat pat) (cons :pcase--succeed :pcase--fail))
+ ((and (eq 'pred (car upat))
+ (eq 'pred (car-safe pat))
+ (or (member (cons (cadr upat) (cadr pat))
+ pcase-mutually-exclusive-predicates)
+ (member (cons (cadr pat) (cadr upat))
+ pcase-mutually-exclusive-predicates)))
+ (cons :pcase--fail nil))
+ ((and (eq 'pred (car upat))
+ (eq '\` (car-safe pat))
+ (symbolp (cadr upat))
+ (or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat)))
+ (get (cadr upat) 'side-effect-free)
+ (ignore-errors
+ (setq test (list (funcall (cadr upat) (cadr pat))))))
+ (if (car test)
+ (cons nil :pcase--fail)
+ (cons :pcase--fail nil))))))
(defun pcase--fgrep (vars sexp)
"Check which of the symbols VARS appear in SEXP."
@@ -463,6 +514,13 @@ MATCH is the pattern that needs to be matched, of the form:
(and (memq sexp vars) (not (memq sexp res)) (push sexp res))
res))
+(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)
@@ -525,12 +583,12 @@ Otherwise, it defers to REST which is a list of branches of the form
(upat (cdr cdrpopmatches)))
(cond
((memq upat '(t _)) (pcase--u1 matches code vars rest))
- ((eq upat 'dontcare) :pcase--dontcare)
+ ((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 (apply-partially #'pcase--split-pred upat) rest))
+ sym (lambda (pat) (pcase--split-pred upat pat)) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
(pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat)))
@@ -548,7 +606,8 @@ Otherwise, it defers to REST which is a list of branches of the form
(let ((newsym (make-symbol "x")))
(push (list newsym sym) env)
(setq sym newsym)))
- (if (functionp exp) `(,exp ,sym)
+ (if (functionp exp)
+ `(funcall #',exp ,sym)
`(,@exp ,sym)))))
(if (null vs)
call
@@ -558,8 +617,11 @@ Otherwise, it defers to REST which is a list of branches of the form
`(let* ,env ,call))))
(pcase--u1 matches code vars then-rest)
(pcase--u else-rest))))
+ ((pcase--self-quoting-p upat)
+ (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.
@@ -570,42 +632,41 @@ Otherwise, it defers to REST which is a list of branches of the form
;; A upat of the form (let VAR EXP).
;; (pcase--u1 matches code
;; (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest)
- (let* ((exp
- (let* ((exp (nth 2 upat))
- (found (assq exp vars)))
- (if found (cdr found)
- (let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
- (env (mapcar (lambda (v) (list v (cdr (assq v vars))))
- vs)))
- (if env `(let* ,env ,exp) exp)))))
- (sym (if (symbolp exp) exp (make-symbol "x")))
- (body
- (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches)
- code vars rest)))
- (if (eq sym exp)
- body
- `(let* ((,sym ,exp)) ,body))))
+ (macroexp-let2
+ macroexp-copyable-p sym
+ (let* ((exp (nth 2 upat))
+ (found (assq exp vars)))
+ (if found (cdr found)
+ (let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
+ (env (mapcar (lambda (v) (list v (cdr (assq v vars))))
+ vs)))
+ (if env (macroexp-let* env exp) exp))))
+ (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))
(memq-fine t))
(when all
(dolist (alt (cdr upat))
- (unless (and (eq (car-safe alt) '\`)
- (or (symbolp (cadr alt)) (integerp (cadr alt))
- (setq memq-fine nil)
- (stringp (cadr alt))))
+ (unless (or (pcase--self-quoting-p alt)
+ (and (eq (car-safe alt) '\`)
+ (or (symbolp (cadr alt)) (integerp (cadr alt))
+ (setq memq-fine nil)
+ (stringp (cadr alt)))))
(setq all nil))))
(if all
;; Use memq for (or `a `b `c `d) rather than a big tree.
- (let* ((elems (mapcar 'cadr (cdr upat)))
+ (let* ((elems (mapcar (lambda (x) (if (consp x) (cadr x) x))
+ (cdr upat)))
(splitrest
(pcase--split-rest
- sym (apply-partially #'pcase--split-member elems) rest))
+ sym (lambda (pat) (pcase--split-member elems pat)) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
+ (pcase--mark-used sym)
(pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems)
(pcase--u1 matches code vars then-rest)
(pcase--u else-rest)))
@@ -659,7 +720,7 @@ Otherwise, it defers to REST which is a list of branches of the form
(symd (make-symbol "xcdr"))
(splitrest (pcase--split-rest
sym
- (apply-partially #'pcase--split-consp syma symd)
+ (lambda (pat) (pcase--split-consp syma symd pat))
rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest))
@@ -673,19 +734,25 @@ Otherwise, it defers to REST which is a list of branches of the form
;; The byte-compiler could do that for us, but it would have to pay
;; attention to the `consp' test in order to figure out that car/cdr
;; can't signal errors and our byte-compiler is not that clever.
- `(let (,@(if (get syma 'pcase-used) `((,syma (car ,sym))))
+ ;; FIXME: Some of those let bindings occur too early (they are used in
+ ;; `then-body', but only within some sub-branch).
+ (macroexp-let*
+ `(,@(if (get syma 'pcase-used) `((,syma (car ,sym))))
,@(if (get symd 'pcase-used) `((,symd (cdr ,sym)))))
- ,then-body)
+ then-body)
(pcase--u else-rest))))
((or (integerp qpat) (symbolp qpat) (stringp qpat))
(let* ((splitrest (pcase--split-rest
- sym (apply-partially 'pcase--split-equal qpat) rest))
+ sym (lambda (pat) (pcase--split-equal qpat pat)) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
- (pcase--if `(,(if (stringp qpat) #'equal #'eq) ,sym ',qpat)
+ (pcase--if (cond
+ ((stringp qpat) `(equal ,sym ,qpat))
+ ((null qpat) `(null ,sym))
+ (t `(eq ,sym ',qpat)))
(pcase--u1 matches code vars then-rest)
(pcase--u else-rest))))
- (t (error "Unkown QPattern %s" qpat))))
+ (t (error "Unknown QPattern %s" qpat))))
(provide 'pcase)
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index 2d1b8860a3c..30c16b51b9e 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -1,6 +1,6 @@
;;; pp.el --- pretty printer for Emacs Lisp
-;; Copyright (C) 1989, 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1993, 2001-2012 Free Software Foundation, Inc.
;; Author: Randal Schwartz <merlyn@stonehenge.com>
;; Keywords: lisp
@@ -41,17 +41,14 @@
"Return a string containing the pretty-printed representation of OBJECT.
OBJECT can be any Lisp object. Quoting characters are used as needed
to make output that `read' can handle, whenever this is possible."
- (with-current-buffer (generate-new-buffer " pp-to-string")
- (unwind-protect
- (progn
- (lisp-mode-variables nil)
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (let ((print-escape-newlines pp-escape-newlines)
- (print-quoted t))
- (prin1 object (current-buffer)))
- (pp-buffer)
- (buffer-string))
- (kill-buffer (current-buffer)))))
+ (with-temp-buffer
+ (lisp-mode-variables nil)
+ (set-syntax-table emacs-lisp-mode-syntax-table)
+ (let ((print-escape-newlines pp-escape-newlines)
+ (print-quoted t))
+ (prin1 object (current-buffer)))
+ (pp-buffer)
+ (buffer-string)))
;;;###autoload
(defun pp-buffer ()
@@ -60,9 +57,7 @@ to make output that `read' can handle, whenever this is possible."
(while (not (eobp))
;; (message "%06d" (- (point-max) (point)))
(cond
- ((condition-case err-var
- (prog1 t (down-list 1))
- (error nil))
+ ((ignore-errors (down-list 1) t)
(save-excursion
(backward-char 1)
(skip-chars-backward "'`#^")
@@ -71,10 +66,8 @@ to make output that `read' can handle, whenever this is possible."
(point)
(progn (skip-chars-backward " \t\n") (point)))
(insert "\n"))))
- ((condition-case err-var
- (prog1 t (up-list 1))
- (error nil))
- (while (looking-at "\\s)")
+ ((ignore-errors (up-list 1) t)
+ (while (looking-at-p "\\s)")
(forward-char 1))
(delete-region
(point)
@@ -117,7 +110,8 @@ after OUT-BUFFER-NAME."
(progn
(select-window window)
(run-hooks 'temp-buffer-show-hook))
- (select-window old-selected)
+ (when (window-live-p old-selected)
+ (select-window old-selected))
(message "See buffer %s." out-buffer-name)))
(message "%s" (buffer-substring (point-min) (point)))
))))))
@@ -154,7 +148,7 @@ Also add the value to the front of the list in the variable `values'."
(save-excursion
(forward-sexp -1)
;; If first line is commented, ignore all leading comments:
- (if (save-excursion (beginning-of-line) (looking-at "[ \t]*;"))
+ (if (save-excursion (beginning-of-line) (looking-at-p "[ \t]*;"))
(progn
(setq exp (buffer-substring (point) pt))
(while (string-match "\n[ \t]*;+" exp start)
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index ebbd6ff1fdf..05bb7577d22 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -1,6 +1,6 @@
;;; re-builder.el --- building Regexps with visual feedback -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Detlev Zundel <dzu@gnu.org>
;; Keywords: matching, lisp, tools
@@ -38,7 +38,7 @@
;; the target buffer are marked automatically with colored overlays
;; (for non-color displays see below) giving you feedback over the
;; extents of the matched (sub) expressions. The (non-)validity is
-;; shown only in the modeline without throwing the errors at you. If
+;; shown only in the mode line without throwing the errors at you. If
;; you want to know the reason why RE Builder considers it as invalid
;; call `reb-force-update' ("\C-c\C-u") which should reveal the error.
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index b538a7a2943..8c64327c0ff 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -1,6 +1,6 @@
;;; regexp-opt.el --- generate efficient regexps to match strings
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Author: Simon Marshall <simon@gnu.org>
;; Maintainer: FSF
@@ -136,14 +136,11 @@ This means the number of non-shy regexp grouping constructs
;;; Workhorse functions.
-(eval-when-compile
- (require 'cl))
-
(defun regexp-opt-group (strings &optional paren lax)
"Return a regexp to match a string in the sorted list STRINGS.
If PAREN non-nil, output regexp parentheses around returned regexp.
If LAX non-nil, don't output parentheses if it doesn't require them.
-Merges keywords to avoid backtracking in Emacs' regexp matcher."
+Merges keywords to avoid backtracking in Emacs's regexp matcher."
;; The basic idea is to find the shortest common prefix or suffix, remove it
;; and recurse. If there is no prefix, we divide the list into two so that
;; \(at least) one half will have at least a one-character common prefix.
@@ -237,7 +234,8 @@ Merges keywords to avoid backtracking in Emacs' regexp matcher."
(defun regexp-opt-charset (chars)
- "Return a regexp to match a character in CHARS."
+ "Return a regexp to match a character in CHARS.
+CHARS should be a list of characters."
;; The basic idea is to find character ranges. Also we take care in the
;; position of character set meta characters in the character set regexp.
;;
@@ -248,15 +246,15 @@ Merges keywords to avoid backtracking in Emacs' regexp matcher."
;;
;; Make a character map but extract character set meta characters.
(dolist (char chars)
- (case char
- (?\]
- (setq bracket "]"))
- (?^
- (setq caret "^"))
- (?-
- (setq dash "-"))
- (otherwise
- (aset charmap char t))))
+ (cond
+ ((eq char ?\])
+ (setq bracket "]"))
+ ((eq char ?^)
+ (setq caret "^"))
+ ((eq char ?-)
+ (setq dash "-"))
+ (t
+ (aset charmap char t))))
;;
;; Make a character set from the map using ranges where applicable.
(map-char-table
@@ -268,14 +266,14 @@ Merges keywords to avoid backtracking in Emacs' regexp matcher."
(setq charset (format "%s%c-%c" charset start end))
(while (>= end start)
(setq charset (format "%s%c" charset start))
- (incf start)))
+ (setq start (1+ start))))
(setq start (car c) end (cdr c)))
(if (= (1- c) end) (setq end c)
(if (> end (+ start 2))
(setq charset (format "%s%c-%c" charset start end))
(while (>= end start)
(setq charset (format "%s%c" charset start))
- (incf start)))
+ (setq start (1+ start))))
(setq start c end c)))))
charmap)
(when (>= end start)
@@ -283,7 +281,7 @@ Merges keywords to avoid backtracking in Emacs' regexp matcher."
(setq charset (format "%s%c-%c" charset start end))
(while (>= end start)
(setq charset (format "%s%c" charset start))
- (incf start))))
+ (setq start (1+ start)))))
;;
;; Make sure a caret is not first and a dash is first or last.
(if (and (string-equal charset "") (string-equal bracket ""))
diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el
index 6905589e5be..a68c67246ff 100644
--- a/lisp/emacs-lisp/regi.el
+++ b/lisp/emacs-lisp/regi.el
@@ -1,6 +1,6 @@
;;; regi.el --- REGular expression Interpreting engine
-;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
;; Maintainer: bwarsaw@cen.com
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index affaa9ce32e..cee6a43df86 100644
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -1,6 +1,6 @@
;;; ring.el --- handle rings of items
-;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: extensions
@@ -185,26 +185,31 @@ Raise error if ITEM is not in the RING."
(unless curr-index (error "Item is not in the ring: `%s'" item))
(ring-ref ring (ring-minus1 curr-index (ring-length ring)))))
+(defun ring-extend (ring x)
+ "Increase the size of RING by X."
+ (when (and (integerp x) (> x 0))
+ (let* ((hd (car ring))
+ (length (ring-length ring))
+ (size (ring-size ring))
+ (old-vec (cddr ring))
+ (new-vec (make-vector (+ size x) nil)))
+ (setcdr ring (cons length new-vec))
+ ;; If the ring is wrapped, the existing elements must be written
+ ;; out in the right order.
+ (dotimes (j length)
+ (aset new-vec j (aref old-vec (mod (+ hd j) size))))
+ (setcar ring 0))))
+
(defun ring-insert+extend (ring item &optional grow-p)
"Like `ring-insert', but if GROW-P is non-nil, then enlarge ring.
Insert onto ring RING the item ITEM, as the newest (last) item.
If the ring is full, behavior depends on GROW-P:
If GROW-P is non-nil, enlarge the ring to accommodate the new item.
If GROW-P is nil, dump the oldest item to make room for the new."
- (let* ((vec (cddr ring))
- (veclen (length vec))
- (hd (car ring))
- (ringlen (ring-length ring)))
- (prog1
- (cond ((and grow-p (= ringlen veclen)) ; Full ring. Enlarge it.
- (setq veclen (1+ veclen))
- (setcdr ring (cons (setq ringlen (1+ ringlen))
- (setq vec (vconcat vec (vector item)))))
- (setcar ring hd))
- (t (aset vec (mod (+ hd ringlen) veclen) item)))
- (if (= ringlen veclen)
- (setcar ring (ring-plus1 hd veclen))
- (setcar (cdr ring) (1+ ringlen))))))
+ (and grow-p
+ (= (ring-length ring) (ring-size ring))
+ (ring-extend ring 1))
+ (ring-insert ring item))
(defun ring-remove+insert+extend (ring item &optional grow-p)
"`ring-remove' ITEM from RING, then `ring-insert+extend' it.
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 2e388d20114..774c6cd2c38 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1,6 +1,6 @@
;;; rx.el --- sexp notation for regular expressions
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Maintainer: FSF
@@ -35,9 +35,8 @@
;; that the `repeat' form can't have multiple regexp args.
;; Now alternative forms are provided for a degree of compatibility
-;; with Shivers' attempted definitive SRE notation
-;; <URL:http://www.ai.mit.edu/~/shivers/sre.txt>. SRE forms not
-;; catered for include: dsm, uncase, w/case, w/nocase, ,@<exp>,
+;; with Olin Shivers' attempted definitive SRE notation. SRE forms
+;; not catered for include: dsm, uncase, w/case, w/nocase, ,@<exp>,
;; ,<exp>, (word ...), word+, posix-string, and character class forms.
;; Some forms are inconsistent with SRE, either for historical reasons
;; or because of the implementation -- simple translation into Emacs
@@ -108,7 +107,9 @@
;;; Code:
-(defconst rx-constituents
+;; FIXME: support macros.
+
+(defvar rx-constituents ;Not `const' because some modes extend it.
'((and . (rx-and 1 nil))
(seq . and) ; SRE
(: . and) ; SRE
@@ -832,27 +833,28 @@ If FORM is '(minimal-match FORM1)', non-greedy versions of `*',
FORM is a regular expression in sexp form.
RX-PARENT shows which type of expression calls and controls putting of
shy groups around the result and some more in other functions."
- (if (stringp form)
- (rx-group-if (regexp-quote form)
- (if (and (eq rx-parent '*) (< 1 (length form)))
- rx-parent))
- (cond ((integerp form)
- (regexp-quote (char-to-string form)))
- ((symbolp form)
- (let ((info (rx-info form nil)))
- (cond ((stringp info)
- info)
- ((null info)
- (error "Unknown rx form `%s'" form))
- (t
- (funcall (nth 0 info) form)))))
- ((consp form)
- (let ((info (rx-info (car form) 'head)))
- (unless (consp info)
- (error "Unknown rx form `%s'" (car form)))
- (funcall (nth 0 info) form)))
- (t
- (error "rx syntax error at `%s'" form)))))
+ (cond
+ ((stringp form)
+ (rx-group-if (regexp-quote form)
+ (if (and (eq rx-parent '*) (< 1 (length form)))
+ rx-parent)))
+ ((integerp form)
+ (regexp-quote (char-to-string form)))
+ ((symbolp form)
+ (let ((info (rx-info form nil)))
+ (cond ((stringp info)
+ info)
+ ((null info)
+ (error "Unknown rx form `%s'" form))
+ (t
+ (funcall (nth 0 info) form)))))
+ ((consp form)
+ (let ((info (rx-info (car form) 'head)))
+ (unless (consp info)
+ (error "Unknown rx form `%s'" (car form)))
+ (funcall (nth 0 info) form)))
+ (t
+ (error "rx syntax error at `%s'" form))))
;;;###autoload
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index d5bba20b1cd..bceec296ad8 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -1,6 +1,6 @@
;;; shadow.el --- locate Emacs Lisp file shadowings
-;; Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Terry Jones <terry@santafe.edu>
;; Keywords: lisp
@@ -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/smie.el b/lisp/emacs-lisp/smie.el
index afc8c7faa47..9fa8a108236 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -1,6 +1,6 @@
;;; smie.el --- Simple Minded Indentation Engine -*- lexical-binding: t -*-
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: languages, lisp, internal, parsing, indentation
@@ -56,7 +56,7 @@
;; building the 2D precedence tables and then computing the precedence levels
;; from it) can be found in pages 187-194 of "Parsing techniques" by Dick Grune
;; and Ceriel Jacobs (BookBody.pdf available at
-;; http://www.cs.vu.nl/~dick/PTAPG.html).
+;; http://dickgrune.com/Books/PTAPG_1st_Edition/).
;;
;; OTOH we had to kill many chickens, read many coffee grounds, and practice
;; untold numbers of black magic spells, to come up with the indentation code.
@@ -121,7 +121,7 @@
;; - smie-indent-comment doesn't interact well with mis-indented lines (where
;; the indent rules don't do what the user wants). Not sure what to do.
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup smie nil
"Simple Minded Indentation Engine."
@@ -155,7 +155,7 @@
(defvar smie-warning-count 0)
(defun smie-set-prec2tab (table x y val &optional override)
- (assert (and x y))
+ (cl-assert (and x y))
(let* ((key (cons x y))
(old (gethash key table)))
(if (and old (not (eq old val)))
@@ -166,7 +166,7 @@
;; don't hide real conflicts.
(puthash key (gethash key override) table)
(display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y))
- (incf smie-warning-count))
+ (cl-incf smie-warning-count))
(puthash key val table))))
(put 'smie-precs->prec2 'pure t)
@@ -268,8 +268,8 @@ be either:
(unless (consp rhs)
(signal 'wrong-type-argument `(consp ,rhs)))
(if (not (member (car rhs) nts))
- (pushnew (car rhs) first-ops)
- (pushnew (car rhs) first-nts)
+ (cl-pushnew (car rhs) first-ops)
+ (cl-pushnew (car rhs) first-nts)
(when (consp (cdr rhs))
;; If the first is not an OP we add the second (which
;; should be an OP if BNF is an "operator grammar").
@@ -282,16 +282,16 @@ be either:
(when (member (cadr rhs) nts)
(error "Adjacent non-terminals: %s %s"
(car rhs) (cadr rhs)))
- (pushnew (cadr rhs) first-ops)))
+ (cl-pushnew (cadr rhs) first-ops)))
(let ((shr (reverse rhs)))
(if (not (member (car shr) nts))
- (pushnew (car shr) last-ops)
- (pushnew (car shr) last-nts)
+ (cl-pushnew (car shr) last-ops)
+ (cl-pushnew (car shr) last-nts)
(when (consp (cdr shr))
(when (member (cadr shr) nts)
(error "Adjacent non-terminals: %s %s"
(cadr shr) (car shr)))
- (pushnew (cadr shr) last-ops)))))
+ (cl-pushnew (cadr shr) last-ops)))))
(push (cons nt first-ops) first-ops-table)
(push (cons nt last-ops) last-ops-table)
(push (cons nt first-nts) first-nts-table)
@@ -416,12 +416,12 @@ from the table, e.g. the table will not include things like (\"if\" . \"else\").
(if no-inners
(let ((last (car (last rhs))))
(unless (member last nts)
- (pushnew (cons (car rhs) last) alist :test #'equal)))
+ (cl-pushnew (cons (car rhs) last) alist :test #'equal)))
;; Reverse so that the "real" closer gets there first,
;; which is important for smie-close-block.
(dolist (term (reverse (cdr rhs)))
(unless (member term nts)
- (pushnew (cons (car rhs) term) alist :test #'equal)))))))
+ (cl-pushnew (cons (car rhs) term) alist :test #'equal)))))))
(nreverse alist)))
(defun smie-bnf--set-class (table token class)
@@ -483,7 +483,7 @@ CSTS is a list of pairs representing arcs in a graph."
(push (concat "." (car elem)) res))
(if (eq (cddr elem) val)
(push (concat (car elem) ".") res)))
- (assert res)
+ (cl-assert res)
res))
cycle)))
(mapconcat
@@ -498,9 +498,9 @@ CSTS is a list of pairs representing arcs in a graph."
;; (right (nth 1 (assoc (cdr k) grammar))))
;; (when (and left right)
;; (cond
-;; ((< left right) (assert (eq v '<)))
-;; ((> left right) (assert (eq v '>)))
-;; (t (assert (eq v '=))))))))
+;; ((< left right) (cl-assert (eq v '<)))
+;; ((> left right) (cl-assert (eq v '>)))
+;; (t (cl-assert (eq v '=))))))))
;; prec2))
(put 'smie-prec2->grammar 'pure t)
@@ -514,25 +514,28 @@ PREC2 is a table as returned by `smie-precs->prec2' or
;; final `table'. The value of each "variable" is kept in the `car'.
(let ((table ())
(csts ())
- (eqs ())
- tmp x y)
+ (eqs ()))
;; From `prec2' we construct a list of constraints between
;; variables (aka "precedence levels"). These can be either
;; equality constraints (in `eqs') or `<' constraints (in `csts').
(maphash (lambda (k v)
(when (consp k)
- (if (setq tmp (assoc (car k) table))
- (setq x (cddr tmp))
- (setq x (cons nil nil))
- (push (cons (car k) (cons nil x)) table))
- (if (setq tmp (assoc (cdr k) table))
- (setq y (cdr tmp))
- (setq y (cons nil (cons nil nil)))
- (push (cons (cdr k) y) table))
- (ecase v
- (= (push (cons x y) eqs))
- (< (push (cons x y) csts))
- (> (push (cons y x) csts)))))
+ (let ((tmp (assoc (car k) table))
+ x y)
+ (if tmp
+ (setq x (cddr tmp))
+ (setq x (cons nil nil))
+ (push (cons (car k) (cons nil x)) table))
+ (if (setq tmp (assoc (cdr k) table))
+ (setq y (cdr tmp))
+ (setq y (cons nil (cons nil nil)))
+ (push (cons (cdr k) y) table))
+ (pcase v
+ (`= (push (cons x y) eqs))
+ (`< (push (cons x y) csts))
+ (`> (push (cons y x) csts))
+ (_ (error "SMIE error: prec2 has %S↦%S which ∉ {<,+,>}"
+ k v))))))
prec2)
;; First process the equality constraints.
(let ((eqs eqs))
@@ -572,13 +575,13 @@ PREC2 is a table as returned by `smie-precs->prec2' or
(unless (caar cst)
(setcar (car cst) i)
;; (smie-check-grammar table prec2 'step1)
- (incf i))
+ (cl-incf i))
(setq csts (delq cst csts))))
(unless progress
(error "Can't resolve the precedence cycle: %s"
(smie-debug--describe-cycle
table (smie-debug--prec2-cycle csts)))))
- (incf i 10))
+ (cl-incf i 10))
;; Propagate equality constraints back to their sources.
(dolist (eq (nreverse eqs))
(when (null (cadr eq))
@@ -589,8 +592,8 @@ PREC2 is a table as returned by `smie-precs->prec2' or
;; So set it here rather than below since doing it below
;; makes it more difficult to obey the equality constraints.
(setcar (cdr eq) i)
- (incf i))
- (assert (or (null (caar eq)) (eq (caar eq) (cadr eq))))
+ (cl-incf i))
+ (cl-assert (or (null (caar eq)) (eq (caar eq) (cadr eq))))
(setcar (car eq) (cadr eq))
;; (smie-check-grammar table prec2 'step2)
)
@@ -599,17 +602,17 @@ PREC2 is a table as returned by `smie-precs->prec2' or
(dolist (x table)
(unless (nth 1 x)
(setf (nth 1 x) i)
- (incf i)) ;See other (incf i) above.
+ (cl-incf i)) ;See other (cl-incf i) above.
(unless (nth 2 x)
(setf (nth 2 x) i)
- (incf i)))) ;See other (incf i) above.
+ (cl-incf i)))) ;See other (cl-incf i) above.
;; Mark closers and openers.
(dolist (x (gethash :smie-open/close-alist prec2))
(let* ((token (car x))
- (cons (case (cdr x)
- (closer (cddr (assoc token table)))
- (opener (cdr (assoc token table))))))
- (assert (numberp (car cons)))
+ (cons (pcase (cdr x)
+ (`closer (cddr (assoc token table)))
+ (`opener (cdr (assoc token table))))))
+ (cl-assert (numberp (car cons)))
(setf (car cons) (list (car cons)))))
(let ((ca (gethash :smie-closer-alist prec2)))
(when ca (push (cons :smie-closer-alist ca) table)))
@@ -688,6 +691,7 @@ Possible return values:
is too high. FORW-LEVEL is the forw-level of TOKEN,
POS is its start position in the buffer.
(t POS TOKEN): same thing when we bump on the wrong side of a paren.
+ Instead of t, the `car' can also be some other non-nil non-number value.
(nil POS TOKEN): we skipped over a paren-like pair.
nil: we skipped over an identifier, matched parentheses, ..."
(catch 'return
@@ -704,20 +708,19 @@ Possible return values:
(when (zerop (length token))
(condition-case err
(progn (goto-char pos) (funcall next-sexp 1) nil)
- (scan-error (throw 'return
- (list t (caddr err)
- (buffer-substring-no-properties
- (caddr err)
- (+ (caddr err)
- (if (< (point) (caddr err))
- -1 1)))))))
+ (scan-error
+ (let ((pos (nth 2 err)))
+ (throw 'return
+ (list t pos
+ (buffer-substring-no-properties
+ pos (+ pos (if (< (point) pos) -1 1))))))))
(if (eq pos (point))
;; We did not move, so let's abort the loop.
(throw 'return (list t (point))))))
((not (numberp (funcall op-back toklevels)))
;; A token like a paren-close.
- (assert (numberp ; Otherwise, why mention it in smie-grammar.
- (funcall op-forw toklevels)))
+ (cl-assert (numberp ; Otherwise, why mention it in smie-grammar.
+ (funcall op-forw toklevels)))
(push toklevels levels))
(t
(while (and levels (< (funcall op-back toklevels)
@@ -728,7 +731,8 @@ Possible return values:
(if (and halfsexp (numberp (funcall op-forw toklevels)))
(push toklevels levels)
(throw 'return
- (prog1 (list (or (car toklevels) t) (point) token)
+ (prog1 (list (or (funcall op-forw toklevels) t)
+ (point) token)
(goto-char pos)))))
(t
(let ((lastlevels levels))
@@ -773,7 +777,8 @@ Possible return values:
((and lastlevels
(smie--associative-p (car lastlevels)))
(throw 'return
- (prog1 (list (or (car toklevels) t) (point) token)
+ (prog1 (list (or (funcall op-forw toklevels) t)
+ (point) token)
(goto-char pos))))
;; - it's an associative operator within a larger construct
;; (e.g. an "elsif"), so we should just ignore it and keep
@@ -793,6 +798,7 @@ Possible return values:
is too high. LEFT-LEVEL is the left-level of TOKEN,
POS is its start position in the buffer.
(t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
+ Instead of t, the `car' can also be some other non-nil non-number value.
(nil POS TOKEN): we skipped over a paren-like pair.
nil: we skipped over an identifier, matched parentheses, ..."
(smie-next-sexp
@@ -812,7 +818,8 @@ Possible return values:
(RIGHT-LEVEL POS TOKEN): we couldn't skip TOKEN because its left-level
is too high. RIGHT-LEVEL is the right-level of TOKEN,
POS is its end position in the buffer.
- (t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
+ (t POS TOKEN): same thing but for a close-paren or the end of buffer.
+ Instead of t, the `car' can also be some other non-nil non-number value.
(nil POS TOKEN): we skipped over a paren-like pair.
nil: we skipped over an identifier, matched parentheses, ..."
(smie-next-sexp
@@ -1074,6 +1081,16 @@ the beginning of a line."
"Return non-nil if the current token is the first on the line."
(save-excursion (skip-chars-backward " \t") (bolp)))
+(defun smie-indent--bolp-1 ()
+ ;; Like smie-indent--bolp but also returns non-nil if it's the first
+ ;; non-comment token. Maybe we should simply always use this?
+ "Return non-nil if the current token is the first on the line.
+Comments are treated as spaces."
+ (let ((bol (line-beginning-position)))
+ (save-excursion
+ (forward-comment (- (point)))
+ (<= (point) bol))))
+
;; Dynamically scoped.
(defvar smie--parent) (defvar smie--after) (defvar smie--token)
@@ -1350,9 +1367,12 @@ should not be computed on the basis of the following token."
;; - middle-of-line: "trust current position".
(cond
((smie-indent--rule :before token))
- ((smie-indent--bolp) ;I.e. non-virtual indent.
+ ((smie-indent--bolp-1) ;I.e. non-virtual indent.
;; For an open-paren-like thingy at BOL, always indent only
;; based on other rules (typically smie-indent-after-keyword).
+ ;; FIXME: we do the same if after a comment, since we may be trying
+ ;; to compute the indentation of this comment and we shouldn't indent
+ ;; based on the indentation of subsequent code.
nil)
(t
;; By default use point unless we're hanging.
@@ -1453,6 +1473,12 @@ should not be computed on the basis of the following token."
(save-excursion
(forward-comment (point-max))
(skip-chars-forward " \t\r\n")
+ ;; FIXME: We assume here that smie-indent-calculate will compute the
+ ;; indentation of the next token based on text before the comment, but
+ ;; this is not guaranteed, so maybe we should let
+ ;; smie-indent-calculate return some info about which buffer position
+ ;; was used as the "indentation base" and check that this base is
+ ;; before `pos'.
(smie-indent-calculate))))
(defun smie-indent-comment-continue ()
@@ -1602,6 +1628,36 @@ to which that point should be aligned, if we were to reindent it.")
(save-excursion (indent-line-to indent))
(indent-line-to indent)))))
+(defun smie-auto-fill ()
+ (let ((fc (current-fill-column)))
+ (while (and fc (> (current-column) fc))
+ (cond
+ ((not (or (nth 8 (save-excursion
+ (syntax-ppss (line-beginning-position))))
+ (nth 8 (syntax-ppss))))
+ (save-excursion
+ (beginning-of-line)
+ (smie-indent-forward-token)
+ (let ((bsf (point))
+ (gain 0)
+ curcol)
+ (while (<= (setq curcol (current-column)) fc)
+ ;; FIXME? `smie-indent-calculate' can (and often will)
+ ;; return a result that actually depends on the presence/absence
+ ;; of a newline, so the gain computed here may not be accurate,
+ ;; but in practice it seems to works well enough.
+ (let* ((newcol (smie-indent-calculate))
+ (newgain (- curcol newcol)))
+ (when (> newgain gain)
+ (setq gain newgain)
+ (setq bsf (point))))
+ (smie-indent-forward-token))
+ (when (> gain 0)
+ (goto-char bsf)
+ (newline-and-indent)))))
+ (t (do-auto-fill))))))
+
+
(defun smie-setup (grammar rules-function &rest keywords)
"Setup SMIE navigation and indentation.
GRAMMAR is a grammar table generated by `smie-prec2->grammar'.
@@ -1612,17 +1668,18 @@ KEYWORDS are additional arguments, which can use the following keywords:
(set (make-local-variable 'smie-rules-function) rules-function)
(set (make-local-variable 'smie-grammar) grammar)
(set (make-local-variable 'indent-line-function) 'smie-indent-line)
+ (set (make-local-variable 'normal-auto-fill-function) 'smie-auto-fill)
(set (make-local-variable 'forward-sexp-function)
'smie-forward-sexp-command)
(while keywords
(let ((k (pop keywords))
(v (pop keywords)))
- (case k
- (:forward-token
+ (pcase k
+ (`:forward-token
(set (make-local-variable 'smie-forward-token-function) v))
- (:backward-token
+ (`:backward-token
(set (make-local-variable 'smie-backward-token-function) v))
- (t (message "smie-setup: ignoring unknown keyword %s" k)))))
+ (_ (message "smie-setup: ignoring unknown keyword %s" k)))))
(let ((ca (cdr (assq :smie-closer-alist grammar))))
(when ca
(set (make-local-variable 'smie-closer-alist) ca)
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 85fa4772eb6..592cb1b0174 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -1,6 +1,6 @@
-;;; syntax.el --- helper functions to find syntactic context
+;;; syntax.el --- helper functions to find syntactic context -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
@@ -41,7 +41,7 @@
;; Note: PPSS stands for `parse-partial-sexp state'
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defvar font-lock-beginning-of-syntax-function)
@@ -55,12 +55,18 @@
;; have to flush that cache between each function, and we couldn't use
;; syntax-ppss-flush-cache since that would not only flush the cache but also
;; reset syntax-propertize--done which should not be done in this case).
- "Mode-specific function to apply the syntax-table properties.
-Called with two arguments: START and END.
-This function can call `syntax-ppss' on any position before END, but it
-should not call `syntax-ppss-flush-cache', which means that it should not
-call `syntax-ppss' on some position and later modify the buffer on some
-earlier position.")
+ "Mode-specific function to apply `syntax-table' text properties.
+The value of this variable is a function to be called by Font
+Lock mode, prior to performing syntactic fontification on a
+stretch of text. It is given two arguments, START and END: the
+start and end of the text to be fontified. Major modes can
+specify a custom function to apply `syntax-table' properties to
+override the default syntax table in special cases.
+
+The specified function may call `syntax-ppss' on any position
+before END, but it should not call `syntax-ppss-flush-cache',
+which means that it should not call `syntax-ppss' on some
+position and later modify the buffer on some earlier position.")
(defvar syntax-propertize-chunk-size 500)
@@ -118,7 +124,7 @@ The arg RULES can be of the same form as in `syntax-propertize-rules'.
The return value is an object that can be passed as a rule to
`syntax-propertize-rules'.
I.e. this is useful only when you want to share rules among several
-syntax-propertize-functions."
+`syntax-propertize-function's."
(declare (debug syntax-propertize-rules))
;; Precompile? Yeah, right!
;; Seriously, tho, this is a macro for 2 reasons:
@@ -181,7 +187,7 @@ Note: back-references in REGEXPs do not work."
;; If there's more than 1 rule, and the rule want to apply
;; highlight to match 0, create an extra group to be able to
;; tell when *this* match 0 has succeeded.
- (incf offset)
+ (cl-incf offset)
(setq re (concat "\\(" re "\\)")))
(setq re (syntax-propertize--shift-groups re offset))
(let ((code '())
@@ -215,7 +221,7 @@ Note: back-references in REGEXPs do not work."
(setq offset 0)))
;; Now construct the code for each subgroup rules.
(dolist (case (cdr rule))
- (assert (null (cddr case)))
+ (cl-assert (null (cddr case)))
(let* ((gn (+ offset (car case)))
(action (nth 1 case))
(thiscode
@@ -260,7 +266,7 @@ Note: back-references in REGEXPs do not work."
code))))
(push (cons condition (nreverse code))
branches))
- (incf offset (regexp-opt-depth orig-re))
+ (cl-incf offset (regexp-opt-depth orig-re))
re))
rules
"\\|")))
@@ -274,13 +280,12 @@ Note: back-references in REGEXPs do not work."
"Propertize for syntax in START..END using font-lock syntax.
KEYWORDS obeys the format used in `font-lock-syntactic-keywords'.
The return value is a function suitable for `syntax-propertize-function'."
- (lexical-let ((keywords keywords))
- (lambda (start end)
- (with-no-warnings
- (let ((font-lock-syntactic-keywords keywords))
- (font-lock-fontify-syntactic-keywords-region start end)
- ;; In case it was eval'd/compiled.
- (setq keywords font-lock-syntactic-keywords))))))
+ (lambda (start end)
+ (with-no-warnings
+ (let ((font-lock-syntactic-keywords keywords))
+ (font-lock-fontify-syntactic-keywords-region start end)
+ ;; In case it was eval'd/compiled.
+ (setq keywords font-lock-syntactic-keywords)))))
(defun syntax-propertize (pos)
"Ensure that syntax-table properties are set until POS."
@@ -419,8 +424,8 @@ Point is at POS when this function returns."
(* 2 (/ (cdr (aref syntax-ppss-stats 5))
(1+ (car (aref syntax-ppss-stats 5)))))))
(progn
- (incf (car (aref syntax-ppss-stats 0)))
- (incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))
+ (cl-incf (car (aref syntax-ppss-stats 0)))
+ (cl-incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))
(parse-partial-sexp old-pos pos nil nil old-ppss))
(cond
@@ -436,8 +441,8 @@ Point is at POS when this function returns."
(setq pt-min (or (syntax-ppss-toplevel-pos old-ppss)
(nth 2 old-ppss)))
(<= pt-min pos) (< (- pos pt-min) syntax-ppss-max-span))
- (incf (car (aref syntax-ppss-stats 1)))
- (incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min))
+ (cl-incf (car (aref syntax-ppss-stats 1)))
+ (cl-incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min))
(setq ppss (parse-partial-sexp pt-min pos)))
;; The OLD-* data can't be used. Consult the cache.
(t
@@ -465,8 +470,8 @@ Point is at POS when this function returns."
;; Use the best of OLD-POS and CACHE.
(if (or (not old-pos) (< old-pos pt-min))
(setq pt-best pt-min ppss-best ppss)
- (incf (car (aref syntax-ppss-stats 4)))
- (incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos))
+ (cl-incf (car (aref syntax-ppss-stats 4)))
+ (cl-incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos))
(setq pt-best old-pos ppss-best old-ppss))
;; Use the `syntax-begin-function' if available.
@@ -491,31 +496,29 @@ Point is at POS when this function returns."
(not (memq (get-text-property (point) 'face)
'(font-lock-string-face font-lock-doc-face
font-lock-comment-face))))
- (incf (car (aref syntax-ppss-stats 5)))
- (incf (cdr (aref syntax-ppss-stats 5)) (- pos (point)))
+ (cl-incf (car (aref syntax-ppss-stats 5)))
+ (cl-incf (cdr (aref syntax-ppss-stats 5)) (- pos (point)))
(setq pt-best (point) ppss-best nil))
(cond
;; Quick case when we found a nearby pos.
((< (- pos pt-best) syntax-ppss-max-span)
- (incf (car (aref syntax-ppss-stats 2)))
- (incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best))
+ (cl-incf (car (aref syntax-ppss-stats 2)))
+ (cl-incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best))
(setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best)))
;; Slow case: compute the state from some known position and
;; populate the cache so we won't need to do it again soon.
(t
- (incf (car (aref syntax-ppss-stats 3)))
- (incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min))
+ (cl-incf (car (aref syntax-ppss-stats 3)))
+ (cl-incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min))
;; If `pt-min' is too far, add a few intermediate entries.
(while (> (- pos pt-min) (* 2 syntax-ppss-max-span))
(setq ppss (parse-partial-sexp
pt-min (setq pt-min (/ (+ pt-min pos) 2))
nil nil ppss))
- (let ((pair (cons pt-min ppss)))
- (if cache-pred
- (push pair (cdr cache-pred))
- (push pair syntax-ppss-cache))))
+ (push (cons pt-min ppss)
+ (if cache-pred (cdr cache-pred) syntax-ppss-cache)))
;; Compute the actual return value.
(setq ppss (parse-partial-sexp pt-min pos nil nil ppss))
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 32ec2bbf7ee..8aa722521eb 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -1,16 +1,16 @@
-;;; tabulated-list.el --- generic major mode for tabulated lists.
+;;; tabulated-list.el --- generic major mode for tabulated lists -*- lexical-binding: t -*-
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Chong Yidong <cyd@stupidchicken.com>
;; Keywords: extensions, lisp
;; 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
@@ -22,22 +22,31 @@
;;; Commentary:
-;; This file defines `tabulated-list-mode', a generic major mode for displaying
-;; lists of tabulated data, intended for other major modes to inherit from. It
-;; provides several utility routines, e.g. for pretty-printing lines of
-;; tabulated data to fit into the appropriate columns.
+;; This file defines Tabulated List mode, a generic major mode for
+;; displaying lists of tabulated data, intended for other major modes
+;; to inherit from. It provides several utility routines, e.g. for
+;; pretty-printing lines of tabulated data to fit into the appropriate
+;; columns.
;; For usage information, see the documentation of `tabulated-list-mode'.
-;; This package originated from Tom Tromey's Package Menu mode, extended and
-;; generalized to be used by other modes.
+;; This package originated from Tom Tromey's Package Menu mode,
+;; extended and generalized to be used by other modes.
;;; Code:
+;; The reason `tabulated-list-format' and other variables are
+;; permanent-local is to make it convenient to switch to a different
+;; major mode, switch back, and have the original Tabulated List data
+;; still valid. See, for example, ebuff-menu.el.
+
(defvar tabulated-list-format nil
"The format of the current Tabulated List mode buffer.
-This should be a vector of elements (NAME WIDTH SORT), where:
+This should be a vector of elements (NAME WIDTH SORT . PROPS),
+where:
- NAME is a string describing the column.
+ This is the label for the column in the header line.
+ Different columns must have non-`equal' names.
- WIDTH is the width to reserve for the column.
For the final element, its numerical value is ignored.
- SORT specifies how to sort entries by this column.
@@ -45,8 +54,18 @@ This should be a vector of elements (NAME WIDTH SORT), where:
If t, sort by comparing the string value printed in the column.
Otherwise, it should be a predicate function suitable for
`sort', accepting arguments with the same form as the elements
- of `tabulated-list-entries'.")
+ of `tabulated-list-entries'.
+ - PROPS is a plist of additional column properties.
+ Currently supported properties are:
+ - `:right-align': if non-nil, the column should be right-aligned.
+ - `:pad-right': Number of additional padding spaces to the
+ right of the column (defaults to 1 if omitted).")
(make-variable-buffer-local 'tabulated-list-format)
+(put 'tabulated-list-format 'permanent-local t)
+
+(defvar tabulated-list-use-header-line t
+ "Whether the Tabulated List buffer should use a header line.")
+(make-variable-buffer-local 'tabulated-list-use-header-line)
(defvar tabulated-list-entries nil
"Entries displayed in the current Tabulated List buffer.
@@ -67,12 +86,14 @@ where:
If `tabulated-list-entries' is a function, it is called with no
arguments and must return a list of the above form.")
(make-variable-buffer-local 'tabulated-list-entries)
+(put 'tabulated-list-entries 'permanent-local t)
(defvar tabulated-list-padding 0
"Number of characters preceding each Tabulated List mode entry.
By default, lines are padded with spaces, but you can use the
function `tabulated-list-put-tag' to change this.")
(make-variable-buffer-local 'tabulated-list-padding)
+(put 'tabulated-list-padding 'permanent-local t)
(defvar tabulated-list-revert-hook nil
"Hook run before reverting a Tabulated List buffer.
@@ -94,13 +115,20 @@ NAME is a string matching one of the column names in
`tabulated-list-format' then specifies how to sort). FLIP, if
non-nil, means to invert the resulting sort.")
(make-variable-buffer-local 'tabulated-list-sort-key)
+(put 'tabulated-list-sort-key 'permanent-local t)
-(defun tabulated-list-get-id (&optional pos)
- "Obtain the entry ID of the Tabulated List mode entry at POS.
-This is an ID object from `tabulated-list-entries', or nil.
+(defsubst tabulated-list-get-id (&optional pos)
+ "Return the entry ID of the Tabulated List entry at POS.
+The value is an ID object from `tabulated-list-entries', or nil.
POS, if omitted or nil, defaults to point."
(get-text-property (or pos (point)) 'tabulated-list-id))
+(defsubst tabulated-list-get-entry (&optional pos)
+ "Return the Tabulated List entry at POS.
+The value is a vector of column descriptors, or nil if there is
+no entry at POS. POS, if omitted or nil, defaults to point."
+ (get-text-property (or pos (point)) 'tabulated-list-entry))
+
(defun tabulated-list-put-tag (tag &optional advance)
"Put TAG in the padding area of the current line.
TAG should be a string, with length <= `tabulated-list-padding'.
@@ -111,16 +139,16 @@ If ADVANCE is non-nil, move forward by one line afterwards."
(error "Unable to tag the current line"))
(save-excursion
(beginning-of-line)
- (when (get-text-property (point) 'tabulated-list-id)
+ (when (tabulated-list-get-entry)
(let ((beg (point))
(inhibit-read-only t))
(forward-char tabulated-list-padding)
(insert-and-inherit
- (if (<= (length tag) tabulated-list-padding)
- (concat tag
- (make-string (- tabulated-list-padding (length tag))
- ?\s))
- (substring tag 0 tabulated-list-padding)))
+ (let ((width (string-width tag)))
+ (if (<= width tabulated-list-padding)
+ (concat tag
+ (make-string (- tabulated-list-padding width) ?\s))
+ (truncate-string-to-width tag tabulated-list-padding))))
(delete-region beg (+ beg tabulated-list-padding)))))
(if advance
(forward-line)))
@@ -130,6 +158,7 @@ If ADVANCE is non-nil, move forward by one line afterwards."
(set-keymap-parent map button-buffer-map)
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
+ (define-key map "S" 'tabulated-list-sort)
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'mouse-select-window)
map)
@@ -139,6 +168,9 @@ If ADVANCE is non-nil, move forward by one line afterwards."
(let ((map (make-sparse-keymap)))
(define-key map [header-line mouse-1] 'tabulated-list-col-sort)
(define-key map [header-line mouse-2] 'tabulated-list-col-sort)
+ (define-key map [mouse-1] 'tabulated-list-col-sort)
+ (define-key map [mouse-2] 'tabulated-list-col-sort)
+ (define-key map "\C-m" 'tabulated-list-sort)
(define-key map [follow-link] 'mouse-face)
map)
"Local keymap for `tabulated-list-mode' sort buttons.")
@@ -152,50 +184,79 @@ If ADVANCE is non-nil, move forward by one line afterwards."
table)
"The `glyphless-char-display' table in Tabulated List buffers.")
+(defvar tabulated-list--header-string nil)
+(defvar tabulated-list--header-overlay nil)
+
(defun tabulated-list-init-header ()
"Set up header line for the Tabulated List buffer."
- (let ((x tabulated-list-padding)
+ ;; FIXME: Should share code with tabulated-list-print-col!
+ (let ((x (max tabulated-list-padding 0))
(button-props `(help-echo "Click to sort by column"
mouse-face highlight
keymap ,tabulated-list-sort-button-map))
(cols nil))
- (if (> tabulated-list-padding 0)
- (push (propertize " " 'display `(space :align-to ,x)) cols))
+ (push (propertize " " 'display `(space :align-to ,x)) cols)
(dotimes (n (length tabulated-list-format))
(let* ((col (aref tabulated-list-format n))
+ (label (nth 0 col))
(width (nth 1 col))
- (label (car col)))
- (setq x (+ x 1 width))
- (and (<= tabulated-list-padding 0)
- (= n 0)
- (setq label (concat " " label)))
+ (props (nthcdr 3 col))
+ (pad-right (or (plist-get props :pad-right) 1))
+ (right-align (plist-get props :right-align))
+ (next-x (+ x pad-right width)))
(push
(cond
;; An unsortable column
- ((not (nth 2 col)) label)
+ ((not (nth 2 col))
+ (propertize label 'tabulated-list-column-name label))
;; The selected sort column
((equal (car col) (car tabulated-list-sort-key))
(apply 'propertize
(concat label
(cond
- ((> (+ 2 (length label)) width)
- "")
- ((cdr tabulated-list-sort-key)
- " ▲")
+ ((> (+ 2 (length label)) width) "")
+ ((cdr tabulated-list-sort-key) " ▲")
(t " ▼")))
'face 'bold
- 'tabulated-list-column-name (car col)
+ 'tabulated-list-column-name label
button-props))
;; Unselected sortable column.
(t (apply 'propertize label
- 'tabulated-list-column-name (car col)
+ 'tabulated-list-column-name label
button-props)))
- cols))
- (push (propertize " "
- 'display (list 'space :align-to x)
- 'face 'fixed-pitch)
- cols))
- (setq header-line-format (mapconcat 'identity (nreverse cols) ""))))
+ cols)
+ (when right-align
+ (let ((shift (- width (string-width (car cols)))))
+ (when (> shift 0)
+ (setq cols
+ (cons (car cols)
+ (cons (propertize (make-string shift ?\s)
+ 'display
+ `(space :align-to ,(+ x shift)))
+ (cdr cols))))
+ (setq x (+ x shift)))))
+ (if (> pad-right 0)
+ (push (propertize " "
+ 'display `(space :align-to ,next-x)
+ 'face 'fixed-pitch)
+ cols))
+ (setq x next-x)))
+ (setq cols (apply 'concat (nreverse cols)))
+ (if tabulated-list-use-header-line
+ (setq header-line-format cols)
+ (setq header-line-format nil)
+ (set (make-local-variable 'tabulated-list--header-string) cols))))
+
+(defun tabulated-list-print-fake-header ()
+ "Insert a fake Tabulated List \"header line\" at the start of the buffer."
+ (goto-char (point-min))
+ (let ((inhibit-read-only t))
+ (insert tabulated-list--header-string "\n")
+ (if tabulated-list--header-overlay
+ (move-overlay tabulated-list--header-overlay (point-min) (point))
+ (set (make-local-variable 'tabulated-list--header-overlay)
+ (make-overlay (point-min) (point))))
+ (overlay-put tabulated-list--header-overlay 'face 'underline)))
(defun tabulated-list-revert (&rest ignored)
"The `revert-buffer-function' for `tabulated-list-mode'.
@@ -206,6 +267,17 @@ It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
(run-hooks 'tabulated-list-revert-hook)
(tabulated-list-print t))
+(defun tabulated-list--column-number (name)
+ (let ((len (length tabulated-list-format))
+ (n 0)
+ found)
+ (while (and (< n len) (null found))
+ (if (equal (car (aref tabulated-list-format n)) name)
+ (setq found n))
+ (setq n (1+ n)))
+ (or found
+ (error "No column named %s" name))))
+
(defun tabulated-list-print (&optional remember-pos)
"Populate the current Tabulated List mode buffer.
This sorts the `tabulated-list-entries' list if sorting is
@@ -215,7 +287,7 @@ buffer and inserts the entries with `tabulated-list-printer'.
Optional argument REMEMBER-POS, if non-nil, means to move point
to the entry with the same ID element as the current line."
(let ((inhibit-read-only t)
- (entries (if (functionp 'tabulated-list-entries)
+ (entries (if (functionp tabulated-list-entries)
(funcall tabulated-list-entries)
tabulated-list-entries))
entry-id saved-pt saved-col)
@@ -223,19 +295,16 @@ to the entry with the same ID element as the current line."
(setq entry-id (tabulated-list-get-id))
(setq saved-col (current-column)))
(erase-buffer)
- ;; Sort the buffers, if necessary.
- (when tabulated-list-sort-key
- (let ((sort-column (car tabulated-list-sort-key))
- (len (length tabulated-list-format))
- (n 0)
- sorter)
- ;; Which column is to be sorted?
- (while (and (< n len)
- (not (equal (car (aref tabulated-list-format n))
- sort-column)))
- (setq n (1+ n)))
- (when (< n len)
- (setq sorter (nth 2 (aref tabulated-list-format n)))
+ (unless tabulated-list-use-header-line
+ (tabulated-list-print-fake-header))
+ ;; Sort the entries, if necessary.
+ (when (and tabulated-list-sort-key
+ (car tabulated-list-sort-key))
+ (let* ((sort-column (car tabulated-list-sort-key))
+ (n (tabulated-list--column-number sort-column))
+ (sorter (nth 2 (aref tabulated-list-format n))))
+ ;; Is the specified column sortable?
+ (when sorter
(when (eq sorter t)
(setq sorter ; Default sorter checks column N:
(lambda (A B)
@@ -246,7 +315,7 @@ to the entry with the same ID element as the current line."
(setq entries (sort entries sorter))
(if (cdr tabulated-list-sort-key)
(setq entries (nreverse entries)))
- (unless (functionp 'tabulated-list-entries)
+ (unless (functionp tabulated-list-entries)
(setq tabulated-list-entries entries)))))
;; Print the resulting list.
(dolist (elt entries)
@@ -267,54 +336,153 @@ to the entry with the same ID element as the current line."
This is the default `tabulated-list-printer' function. ID is a
Lisp object identifying the entry to print, and COLS is a vector
of column descriptors."
- (let ((beg (point))
- (x (max tabulated-list-padding 0))
- (len (length tabulated-list-format)))
+ (let ((beg (point))
+ (x (max tabulated-list-padding 0))
+ (ncols (length tabulated-list-format))
+ (inhibit-read-only t))
(if (> tabulated-list-padding 0)
(insert (make-string x ?\s)))
- (dotimes (n len)
- (let* ((format (aref tabulated-list-format n))
- (desc (aref cols n))
- (width (nth 1 format))
- (label (if (stringp desc) desc (car desc)))
- (help-echo (concat (car format) ": " label)))
- ;; Truncate labels if necessary.
- (and (> width 6)
- (> (length label) width)
- (setq label (concat (substring label 0 (- width 3))
- "...")))
- (setq label (bidi-string-mark-left-to-right label))
- (if (stringp desc)
- (insert (propertize label 'help-echo help-echo))
- (apply 'insert-text-button label (cdr desc)))
- (setq x (+ x 1 width)))
- ;; No need to append any spaces if this is the last column.
- (if (< (1+ n) len)
- (indent-to x 1)))
+ (dotimes (n ncols)
+ (setq x (tabulated-list-print-col n (aref cols n) x)))
(insert ?\n)
- (put-text-property beg (point) 'tabulated-list-id id)))
+ (put-text-property beg (point) 'tabulated-list-id id)
+ (put-text-property beg (point) 'tabulated-list-entry cols)))
+
+(defun tabulated-list-print-col (n col-desc x)
+ "Insert a specified Tabulated List entry at point.
+N is the column number, COL-DESC is a column descriptor \(see
+`tabulated-list-entries'), and X is the column number at point.
+Return the column number after insertion."
+ ;; TODO: don't truncate to `width' if the next column is align-right
+ ;; and has some space left.
+ (let* ((format (aref tabulated-list-format n))
+ (name (nth 0 format))
+ (width (nth 1 format))
+ (props (nthcdr 3 format))
+ (pad-right (or (plist-get props :pad-right) 1))
+ (right-align (plist-get props :right-align))
+ (label (if (stringp col-desc) col-desc (car col-desc)))
+ (label-width (string-width label))
+ (help-echo (concat (car format) ": " label))
+ (opoint (point))
+ (not-last-col (< (1+ n) (length tabulated-list-format))))
+ ;; Truncate labels if necessary (except last column).
+ (and not-last-col
+ (> label-width width)
+ (setq label (truncate-string-to-width label width nil nil t)
+ label-width width))
+ (setq label (bidi-string-mark-left-to-right label))
+ (when (and right-align (> width label-width))
+ (let ((shift (- width label-width)))
+ (insert (propertize (make-string shift ?\s)
+ 'display `(space :align-to ,(+ x shift))))
+ (setq width (- width shift))
+ (setq x (+ x shift))))
+ (if (stringp col-desc)
+ (insert (propertize label 'help-echo help-echo))
+ (apply 'insert-text-button label (cdr col-desc)))
+ (let ((next-x (+ x pad-right width)))
+ ;; No need to append any spaces if this is the last column.
+ (when not-last-col
+ (when (> pad-right 0) (insert (make-string pad-right ?\s)))
+ (insert (propertize
+ (make-string (- next-x x label-width pad-right) ?\s)
+ 'display `(space :align-to ,next-x))))
+ (put-text-property opoint (point) 'tabulated-list-column-name name)
+ next-x)))
+
+(defun tabulated-list-delete-entry ()
+ "Delete the Tabulated List entry at point.
+Return a list (ID COLS), where ID is the ID of the deleted entry
+and COLS is a vector of its column descriptors. Move point to
+the beginning of the deleted entry. Return nil if there is no
+entry at point.
+
+This function only changes the buffer contents; it does not alter
+`tabulated-list-entries'."
+ ;; Assume that each entry occupies one line.
+ (let* ((id (tabulated-list-get-id))
+ (cols (tabulated-list-get-entry))
+ (inhibit-read-only t))
+ (when cols
+ (delete-region (line-beginning-position) (1+ (line-end-position)))
+ (list id cols))))
+
+(defun tabulated-list-set-col (col desc &optional change-entry-data)
+ "Change the Tabulated List entry at point, setting COL to DESC.
+COL is the column number to change, or the name of the column to change.
+DESC is the new column descriptor, which is inserted via
+`tabulated-list-print-col'.
+
+If CHANGE-ENTRY-DATA is non-nil, modify the underlying entry data
+by setting the appropriate slot of the vector originally used to
+print this entry. If `tabulated-list-entries' has a list value,
+this is the vector stored within it."
+ (let* ((opoint (point))
+ (eol (line-end-position))
+ (pos (line-beginning-position))
+ (id (tabulated-list-get-id pos))
+ (entry (tabulated-list-get-entry pos))
+ (prop 'tabulated-list-column-name)
+ (inhibit-read-only t)
+ name)
+ (cond ((numberp col)
+ (setq name (car (aref tabulated-list-format col))))
+ ((stringp col)
+ (setq name col
+ col (tabulated-list--column-number col)))
+ (t
+ (error "Invalid column %s" col)))
+ (unless entry
+ (error "No Tabulated List entry at position %s" opoint))
+ (unless (equal (get-text-property pos prop) name)
+ (while (and (setq pos
+ (next-single-property-change pos prop nil eol))
+ (< pos eol)
+ (not (equal (get-text-property pos prop) name)))))
+ (when (< pos eol)
+ (delete-region pos (next-single-property-change pos prop nil eol))
+ (goto-char pos)
+ (tabulated-list-print-col col desc (current-column))
+ (if change-entry-data
+ (aset entry col desc))
+ (put-text-property pos (point) 'tabulated-list-id id)
+ (put-text-property pos (point) 'tabulated-list-entry entry)
+ (goto-char opoint))))
(defun tabulated-list-col-sort (&optional e)
"Sort Tabulated List entries by the column of the mouse click E."
(interactive "e")
(let* ((pos (event-start e))
- (obj (posn-object pos))
- (name (get-text-property (if obj (cdr obj) (posn-point pos))
- 'tabulated-list-column-name
- (car obj))))
+ (obj (posn-object pos)))
(with-current-buffer (window-buffer (posn-window pos))
- (when (derived-mode-p 'tabulated-list-mode)
- ;; Flip the sort order on a second click.
- (if (equal name (car tabulated-list-sort-key))
- (setcdr tabulated-list-sort-key
- (not (cdr tabulated-list-sort-key)))
- (setq tabulated-list-sort-key (cons name nil)))
- (tabulated-list-init-header)
- (tabulated-list-print t)))))
+ (tabulated-list--sort-by-column-name
+ (get-text-property (if obj (cdr obj) (posn-point pos))
+ 'tabulated-list-column-name
+ (car obj))))))
+
+(defun tabulated-list-sort (&optional n)
+ "Sort Tabulated List entries by the column at point.
+With a numeric prefix argument N, sort the Nth column."
+ (interactive "P")
+ (let ((name (if n
+ (car (aref tabulated-list-format n))
+ (get-text-property (point)
+ 'tabulated-list-column-name))))
+ (tabulated-list--sort-by-column-name name)))
+
+(defun tabulated-list--sort-by-column-name (name)
+ (when (and name (derived-mode-p 'tabulated-list-mode))
+ ;; Flip the sort order on a second click.
+ (if (equal name (car tabulated-list-sort-key))
+ (setcdr tabulated-list-sort-key
+ (not (cdr tabulated-list-sort-key)))
+ (setq tabulated-list-sort-key (cons name nil)))
+ (tabulated-list-init-header)
+ (tabulated-list-print t)))
;;; The mode definition:
-;;;###autoload
(define-derived-mode tabulated-list-mode special-mode "Tabulated"
"Generic major mode for browsing a list of items.
This mode is usually not used directly; instead, other major
@@ -362,7 +530,6 @@ as the ewoc pretty-printer."
;; Local Variables:
;; coding: utf-8
-;; lexical-binding: t
;; End:
;;; tabulated-list.el ends here
diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index b91b96b83e5..79251bfd6e1 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -1,6 +1,6 @@
;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@engineer.com>
;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
diff --git a/lisp/emacs-lisp/tcover-unsafep.el b/lisp/emacs-lisp/tcover-unsafep.el
index 7144138445c..2de6e6c5bc0 100644
--- a/lisp/emacs-lisp/tcover-unsafep.el
+++ b/lisp/emacs-lisp/tcover-unsafep.el
@@ -1,6 +1,6 @@
;;;; testcover-unsafep.el -- Use testcover to test unsafep's code coverage
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@engineer.com>
;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index a5a6f71d79e..5fdc8c55a85 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -1,6 +1,6 @@
;;;; testcover.el -- Visual code-coverage tool
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
@@ -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 706c6fd0ba3..284c591fc61 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -1,6 +1,6 @@
;;; timer.el --- run a function with args at some time in future
-;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Package: emacs
@@ -29,40 +29,48 @@
;; Layout of a timer vector:
;; [triggered-p high-seconds low-seconds usecs repeat-delay
-;; function args idle-delay]
+;; function args idle-delay psecs]
;; triggered-p is nil if the timer is active (waiting to be triggered),
;; t if it is inactive ("already triggered", in theory)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
-(defstruct (timer
+(cl-defstruct (timer
(:constructor nil)
(:copier nil)
(:constructor timer-create ())
(:type vector)
(:conc-name timer--))
(triggered t)
- high-seconds low-seconds usecs repeat-delay function args idle-delay)
+ high-seconds low-seconds usecs repeat-delay function args idle-delay psecs)
(defun timerp (object)
"Return t if OBJECT is a timer."
- (and (vectorp object) (= (length object) 8)))
+ (and (vectorp object) (= (length object) 9)))
;; Pseudo field `time'.
(defun timer--time (timer)
(list (timer--high-seconds timer)
(timer--low-seconds timer)
- (timer--usecs timer)))
+ (timer--usecs timer)
+ (timer--psecs timer)))
-(defsetf timer--time
+(gv-define-simple-setter timer--time
(lambda (timer time)
(or (timerp timer) (error "Invalid timer"))
(setf (timer--high-seconds timer) (pop time))
- (setf (timer--low-seconds timer)
- (if (consp time) (car time) time))
- (setf (timer--usecs timer) (or (and (consp time) (consp (cdr time))
- (cadr time))
- 0))))
+ (let ((low time) (usecs 0) (psecs 0))
+ (if (consp time)
+ (progn
+ (setq low (pop time))
+ (if time
+ (progn
+ (setq usecs (pop time))
+ (if time
+ (setq psecs (car time)))))))
+ (setf (timer--low-seconds timer) low)
+ (setf (timer--usecs timer) usecs)
+ (setf (timer--psecs timer) psecs))))
(defun timer-set-time (timer time &optional delta)
@@ -77,7 +85,7 @@ fire repeatedly that many seconds apart."
(defun timer-set-idle-time (timer secs &optional repeat)
"Set the trigger idle time of TIMER to SECS.
SECS may be an integer, floating point number, or the internal
-time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'.
+time format returned by, e.g., `current-idle-time'.
If optional third argument REPEAT is non-nil, make the timer
fire each time Emacs is idle for that many seconds."
(if (consp secs)
@@ -91,41 +99,46 @@ fire each time Emacs is idle for that many seconds."
"Yield the next value after TIME that is an integral multiple of SECS.
More precisely, the next value, after TIME, that is an integral multiple
of SECS seconds since the epoch. SECS may be a fraction."
- (let ((time-base (ash 1 16)))
- ;; Use floating point, taking care to not lose precision.
- (let* ((float-time-base (float time-base))
- (million 1000000.0)
- (time-usec (+ (* million
- (+ (* float-time-base (nth 0 time))
- (nth 1 time)))
- (nth 2 time)))
- (secs-usec (* million secs))
- (mod-usec (mod time-usec secs-usec))
- (next-usec (+ (- time-usec mod-usec) secs-usec))
- (time-base-million (* float-time-base million)))
- (list (floor next-usec time-base-million)
- (floor (mod next-usec time-base-million) million)
- (floor (mod next-usec million))))))
-
-(defun timer-relative-time (time secs &optional usecs)
- "Advance TIME by SECS seconds and optionally USECS microseconds.
-SECS may be either an integer or a floating point number."
+ (let* ((trillion 1e12)
+ (time-sec (+ (nth 1 time)
+ (* 65536.0 (nth 0 time))))
+ (delta-sec (mod (- time-sec) secs))
+ (next-sec (+ time-sec (ffloor delta-sec)))
+ (next-sec-psec (ffloor (* trillion (mod delta-sec 1))))
+ (sub-time-psec (+ (or (nth 3 time) 0)
+ (* 1e6 (nth 2 time))))
+ (psec-diff (- sub-time-psec next-sec-psec)))
+ (if (and (<= next-sec time-sec) (< 0 psec-diff))
+ (setq next-sec-psec (+ sub-time-psec
+ (mod (- psec-diff) (* trillion secs)))))
+ (setq next-sec (+ next-sec (floor next-sec-psec trillion)))
+ (setq next-sec-psec (mod next-sec-psec trillion))
+ (list (floor next-sec 65536)
+ (floor (mod next-sec 65536))
+ (floor next-sec-psec 1000000)
+ (floor (mod next-sec-psec 1000000)))))
+
+(defun timer-relative-time (time secs &optional usecs psecs)
+ "Advance TIME by SECS seconds and optionally USECS nanoseconds
+and PSECS picoseconds. SECS may be either an integer or a
+floating point number."
(let ((delta (if (floatp secs)
(seconds-to-time secs)
(list (floor secs 65536) (mod secs 65536)))))
- (if usecs
- (setq delta (time-add delta (list 0 0 usecs))))
+ (if (or usecs psecs)
+ (setq delta (time-add delta (list 0 0 (or usecs 0) (or psecs 0)))))
(time-add time delta)))
(defun timer--time-less-p (t1 t2)
"Say whether time value T1 is less than time value T2."
(time-less-p (timer--time t1) (timer--time t2)))
-(defun timer-inc-time (timer secs &optional usecs)
- "Increment the time set in TIMER by SECS seconds and USECS microseconds.
-SECS may be a fraction. If USECS is omitted, that means it is zero."
+(defun timer-inc-time (timer secs &optional usecs psecs)
+ "Increment the time set in TIMER by SECS seconds, USECS nanoseconds,
+and PSECS picoseconds. SECS may be a fraction. If USECS or PSECS are
+omitted, they are treated as zero."
(setf (timer--time timer)
- (timer-relative-time (timer--time timer) secs usecs)))
+ (timer-relative-time (timer--time timer) secs usecs psecs)))
(defun timer-set-time-with-usecs (timer time usecs &optional delta)
"Set the trigger time of TIMER to TIME plus USECS.
@@ -133,13 +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."
@@ -154,6 +167,7 @@ fire repeatedly that many seconds apart."
(integerp (timer--high-seconds timer))
(integerp (timer--low-seconds timer))
(integerp (timer--usecs timer))
+ (integerp (timer--psecs timer))
(timer--function timer))
(let ((timers (if idle timer-idle-list timer-list))
last)
@@ -190,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)
@@ -240,18 +261,20 @@ and idle timers such as are scheduled by `run-with-idle-timer'."
(defvar timer-event-last-2 nil
"Third-to-last timer that was run.")
-(defvar timer-max-repeats 10
- "*Maximum number of times to repeat a timer, if many repeats are delayed.
+(defcustom timer-max-repeats 10
+ "Maximum number of times to repeat a timer, if many repeats are delayed.
Timer invocations can be delayed because Emacs is suspended or busy,
or because the system's time changes. If such an occurrence makes it
appear that many invocations are overdue, this variable controls
-how many will really happen.")
+how many will really happen."
+ :type 'integer
+ :group 'internal)
(defun timer-until (timer time)
"Calculate number of seconds from when TIMER will run, until TIME.
TIMER is a timer, and stands for the time when its next repeat is scheduled.
TIME is a time-list."
- (float-time (time-subtract time (timer--time timer))))
+ (- (float-time time) (float-time (timer--time timer))))
(defun timer-event-handler (timer)
"Call the handler for the timer TIMER.
@@ -384,9 +407,11 @@ This function is for compatibility; see also `run-with-timer'."
"Perform an action the next time Emacs is idle for SECS seconds.
The action is to call FUNCTION with arguments ARGS.
SECS may be an integer, a floating point number, or the internal
-time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'.
+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).
@@ -425,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-lisp/tq.el b/lisp/emacs-lisp/tq.el
index 3d3b371ad5c..0d13a3caed0 100644
--- a/lisp/emacs-lisp/tq.el
+++ b/lisp/emacs-lisp/tq.el
@@ -1,6 +1,6 @@
;;; tq.el --- utility to maintain a transaction queue
-;; Copyright (C) 1985-1987, 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992, 2001-2012 Free Software Foundation, Inc.
;; Author: Scott Draves <spot@cs.cmu.edu>
;; Maintainer: FSF
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index 22c1f0e7ea7..722e6270e95 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -1,6 +1,6 @@
-;;; trace.el --- tracing facility for Emacs Lisp functions
+;;; trace.el --- tracing facility for Emacs Lisp functions -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
;; Maintainer: FSF
@@ -151,18 +151,15 @@
;;; Code:
-(require 'advice)
-
(defgroup trace nil
"Tracing facility for Emacs Lisp functions."
:prefix "trace-"
:group 'lisp)
;;;###autoload
-(defcustom trace-buffer (purecopy "*trace-output*")
+(defcustom trace-buffer "*trace-output*"
"Trace output will by default go to that buffer."
- :type 'string
- :group 'trace)
+ :type 'string)
;; Current level of traced function invocation:
(defvar trace-level 0)
@@ -176,78 +173,109 @@
(defvar inhibit-trace nil
"If non-nil, all tracing is temporarily inhibited.")
-(defun trace-entry-message (function level argument-bindings)
- ;; Generates a string that describes that FUNCTION has been entered at
- ;; trace LEVEL with ARGUMENT-BINDINGS.
- (format "%s%s%d -> %s: %s\n"
- (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
- (if (> level 1) " " "")
- level
- function
- (let ((print-circle t))
- (mapconcat (lambda (binding)
- (concat
- (symbol-name (ad-arg-binding-field binding 'name))
- "="
- ;; do this so we'll see strings:
- (prin1-to-string
- (ad-arg-binding-field binding 'value))))
- argument-bindings
- " "))))
-
-(defun trace-exit-message (function level value)
- ;; Generates a string that describes that FUNCTION has been exited at
- ;; trace LEVEL and that it returned VALUE.
- (format "%s%s%d <- %s: %s\n"
- (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
- (if (> level 1) " " "")
- level
- function
- ;; do this so we'll see strings:
- (let ((print-circle t)) (prin1-to-string value))))
-
-(defun trace-make-advice (function buffer background)
- ;; Builds the piece of advice to be added to FUNCTION's advice info
- ;; so that it will generate the proper trace output in BUFFER
- ;; (quietly if BACKGROUND is t).
- (ad-make-advice
- trace-advice-name nil t
- `(advice
- lambda ()
- (let ((trace-level (1+ trace-level))
- (trace-buffer (get-buffer-create ,buffer)))
- (unless inhibit-trace
- (with-current-buffer trace-buffer
- (set (make-local-variable 'window-point-insertion-type) t)
- ,(unless background '(display-buffer trace-buffer))
- (goto-char (point-max))
- ;; Insert a separator from previous trace output:
- (if (= trace-level 1) (insert trace-separator))
- (insert
- (trace-entry-message
- ',function trace-level ad-arg-bindings))))
- ad-do-it
- (unless inhibit-trace
- (with-current-buffer trace-buffer
- ,(unless background '(display-buffer trace-buffer))
- (goto-char (point-max))
- (insert
- (trace-exit-message
- ',function trace-level ad-return-value))))))))
-
-(defun trace-function-internal (function buffer background)
- ;; Adds trace advice for FUNCTION and activates it.
- (ad-add-advice
- function
- (trace-make-advice function (or buffer trace-buffer) background)
- 'around 'last)
- (ad-activate function nil))
+(defun trace-entry-message (function level args context)
+ "Generate a string that describes that FUNCTION has been entered.
+LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION,
+and CONTEXT is a string describing the dynamic context (e.g. values of
+some global variables)."
+ (let ((print-circle t))
+ (format "%s%s%d -> %S%s\n"
+ (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
+ (if (> level 1) " " "")
+ level
+ (cons function args)
+ context)))
+
+(defun trace-exit-message (function level value context)
+ "Generate a string that describes that FUNCTION has exited.
+LEVEL is the trace level, VALUE value returned by FUNCTION,
+and CONTEXT is a string describing the dynamic context (e.g. values of
+some global variables)."
+ (let ((print-circle t))
+ (format "%s%s%d <- %s: %S%s\n"
+ (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
+ (if (> level 1) " " "")
+ level
+ function
+ ;; Do this so we'll see strings:
+ value
+ context)))
+
+(defvar trace--timer nil)
+
+(defun trace-make-advice (function buffer background context)
+ "Build the piece of advice to be added to trace FUNCTION.
+FUNCTION is the name of the traced function.
+BUFFER is the buffer where the trace should be printed.
+BACKGROUND if nil means to display BUFFER.
+CONTEXT if non-nil should be a function that returns extra info that should
+be printed along with the arguments in the trace."
+ (lambda (body &rest args)
+ (let ((trace-level (1+ trace-level))
+ (trace-buffer (get-buffer-create buffer))
+ (ctx (funcall context)))
+ (unless inhibit-trace
+ (with-current-buffer trace-buffer
+ (set (make-local-variable 'window-point-insertion-type) t)
+ (unless (or background trace--timer
+ (get-buffer-window trace-buffer 'visible))
+ (setq trace--timer
+ ;; Postpone the display to some later time, in case we
+ ;; can't actually do it now.
+ (run-with-timer 0 nil
+ (lambda ()
+ (setq trace--timer nil)
+ (display-buffer trace-buffer)))))
+ (goto-char (point-max))
+ ;; Insert a separator from previous trace output:
+ (if (= trace-level 1) (insert trace-separator))
+ (insert
+ (trace-entry-message
+ function trace-level args ctx))))
+ (let ((result))
+ (unwind-protect
+ (setq result (list (apply body args)))
+ (unless inhibit-trace
+ (let ((ctx (funcall context)))
+ (with-current-buffer trace-buffer
+ (unless background (display-buffer trace-buffer))
+ (goto-char (point-max))
+ (insert
+ (trace-exit-message
+ function
+ trace-level
+ (if result (car result) '\!non-local\ exit\!)
+ ctx))))))
+ (car result)))))
+
+(defun trace-function-internal (function buffer background context)
+ "Add trace advice for FUNCTION."
+ (advice-add
+ function :around
+ (trace-make-advice function (or buffer trace-buffer) background
+ (or context (lambda () "")))
+ `((name . ,trace-advice-name))))
(defun trace-is-traced (function)
- (ad-find-advice function 'around trace-advice-name))
+ (advice-member-p trace-advice-name function))
+
+(defun trace--read-args (prompt)
+ (cons
+ (intern (completing-read prompt obarray 'fboundp t))
+ (when current-prefix-arg
+ (list
+ (read-buffer "Output to buffer: " trace-buffer)
+ (let ((exp
+ (let ((minibuffer-completing-symbol t))
+ (read-from-minibuffer "Context expression: "
+ nil read-expression-map t
+ 'read-expression-history))))
+ `(lambda ()
+ (let ((print-circle t))
+ (concat " [" (prin1-to-string ,exp) "]"))))))))
;;;###autoload
-(defun trace-function (function &optional buffer)
+(defun trace-function-foreground (function &optional buffer context)
"Traces FUNCTION with trace output going to BUFFER.
For every call of FUNCTION Lisp-style trace messages that display argument
and return values will be inserted into BUFFER. This function generates the
@@ -255,14 +283,11 @@ trace advice for FUNCTION and activates it together with any other advice
there might be!! The trace BUFFER will popup whenever FUNCTION is called.
Do not use this to trace functions that switch buffers or do any other
display oriented stuff, use `trace-function-background' instead."
- (interactive
- (list
- (intern (completing-read "Trace function: " obarray 'fboundp t))
- (read-buffer "Output to buffer: " trace-buffer)))
- (trace-function-internal function buffer nil))
+ (interactive (trace--read-args "Trace function: "))
+ (trace-function-internal function buffer nil context))
;;;###autoload
-(defun trace-function-background (function &optional buffer)
+(defun trace-function-background (function &optional buffer context)
"Traces FUNCTION with trace output going quietly to BUFFER.
When this tracing is enabled, every call to FUNCTION writes
a Lisp-style trace message (showing the arguments and return value)
@@ -272,12 +297,11 @@ The trace output goes to BUFFER quietly, without changing
the window or buffer configuration.
BUFFER defaults to `trace-buffer'."
- (interactive
- (list
- (intern
- (completing-read "Trace function in background: " obarray 'fboundp t))
- (read-buffer "Output to buffer: " trace-buffer)))
- (trace-function-internal function buffer t))
+ (interactive (trace--read-args "Trace function in background: "))
+ (trace-function-internal function buffer t context))
+
+;;;###autoload
+(defalias 'trace-function 'trace-function-foreground)
(defun untrace-function (function)
"Untraces FUNCTION and possibly activates all remaining advice.
@@ -285,16 +309,14 @@ Activation is performed with `ad-update', hence remaining advice will get
activated only if the advice of FUNCTION is currently active. If FUNCTION
was not traced this is a noop."
(interactive
- (list (ad-read-advised-function "Untrace function: " 'trace-is-traced)))
- (when (trace-is-traced function)
- (ad-remove-advice function 'around trace-advice-name)
- (ad-update function)))
+ (list (intern (completing-read "Untrace function: "
+ obarray #'trace-is-traced t))))
+ (advice-remove function trace-advice-name))
(defun untrace-all ()
"Untraces all currently traced functions."
(interactive)
- (ad-do-advised-functions (function)
- (untrace-function function)))
+ (mapatoms #'untrace-function))
(provide 'trace)
diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el
index 0f08d77d4c3..11256c294d9 100644
--- a/lisp/emacs-lisp/unsafep.el
+++ b/lisp/emacs-lisp/unsafep.el
@@ -1,6 +1,6 @@
;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 7f3657bbbe6..ab35d8f3d8f 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -1,6 +1,6 @@
;;; warnings.el --- log and display warnings
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el
index f2c93473015..b20ec13fa81 100644
--- a/lisp/emacs-lock.el
+++ b/lisp/emacs-lock.el
@@ -1,6 +1,6 @@
;;; emacs-lock.el --- protect buffers against killing or exiting -*- lexical-binding: t -*-
-;; Copyright (C) 2011 Free Software Foundation, Inc
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Juanma Barranquero <lekktu@gmail.com>
;; Inspired by emacs-lock.el by Tom Wurgler <twurgler@goodyear.com>
@@ -81,6 +81,13 @@ for both actions (NOT RECOMMENDED)."
:group 'emacs-lock
:version "24.1")
+(defcustom emacs-lock-locked-buffer-functions nil
+ "Abnormal hook run when Emacs Lock prevents exiting Emacs, or killing a buffer.
+The functions get one argument, the first locked buffer found."
+ :type 'hook
+ :group 'emacs-lock
+ :version "24.3")
+
(defvar emacs-lock-mode nil
"If non-nil, the current buffer is locked.
It can be one of the following values:
@@ -119,40 +126,45 @@ See `emacs-lock-unlockable-modes'."
(or (eq unlock 'all) (eq unlock action))))))
(defun emacs-lock--exit-locked-buffer ()
- "Return the name of the first exit-locked buffer found."
+ "Return the first exit-locked buffer found."
(save-current-buffer
(catch :found
(dolist (buffer (buffer-list))
(set-buffer buffer)
(unless (or (emacs-lock--can-auto-unlock 'exit)
(memq emacs-lock-mode '(nil kill)))
- (throw :found (buffer-name))))
+ (throw :found buffer)))
nil)))
(defun emacs-lock--kill-emacs-hook ()
"Signal an error if any buffer is exit-locked.
Used from `kill-emacs-hook' (which see)."
- (let ((buffer-name (emacs-lock--exit-locked-buffer)))
- (when buffer-name
- (error "Emacs cannot exit because buffer %S is locked" buffer-name))))
+ (let ((locked (emacs-lock--exit-locked-buffer)))
+ (when locked
+ (run-hook-with-args 'emacs-lock-locked-buffer-functions locked)
+ (error "Emacs cannot exit because buffer %S is locked"
+ (buffer-name locked)))))
(defun emacs-lock--kill-emacs-query-functions ()
"Display a message if any buffer is exit-locked.
Return a value appropriate for `kill-emacs-query-functions' (which see)."
(let ((locked (emacs-lock--exit-locked-buffer)))
- (or (not locked)
- (progn
- (message "Emacs cannot exit because buffer %S is locked" locked)
- nil))))
+ (if (not locked)
+ t
+ (run-hook-with-args 'emacs-lock-locked-buffer-functions locked)
+ (message "Emacs cannot exit because buffer %S is locked"
+ (buffer-name locked))
+ nil)))
(defun emacs-lock--kill-buffer-query-functions ()
"Display a message if the current buffer is kill-locked.
Return a value appropriate for `kill-buffer-query-functions' (which see)."
- (or (emacs-lock--can-auto-unlock 'kill)
- (memq emacs-lock-mode '(nil exit))
- (progn
- (message "Buffer %S is locked and cannot be killed" (buffer-name))
- nil)))
+ (if (or (emacs-lock--can-auto-unlock 'kill)
+ (memq emacs-lock-mode '(nil exit)))
+ t
+ (run-hook-with-args 'emacs-lock-locked-buffer-functions (current-buffer))
+ (message "Buffer %S is locked and cannot be killed" (buffer-name))
+ nil))
(defun emacs-lock--set-mode (mode arg)
"Setter function for `emacs-lock-mode'."
@@ -174,6 +186,8 @@ Return a value appropriate for `kill-buffer-query-functions' (which see)."
;; anything else (turn off)
mode))))
+(define-obsolete-variable-alias 'emacs-lock-from-exiting
+ 'emacs-lock-mode "24.1")
;;;###autoload
(define-minor-mode emacs-lock-mode
"Toggle Emacs Lock mode in the current buffer.
@@ -233,13 +247,11 @@ Other values are interpreted as usual."
;;; Compatibility
-(define-obsolete-variable-alias 'emacs-lock-from-exiting 'emacs-lock-mode "24.1")
-
(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 71e607140de..01d202f87b5 100644
--- a/lisp/emulation/crisp.el
+++ b/lisp/emulation/crisp.el
@@ -1,6 +1,6 @@
;;; crisp.el --- CRiSP/Brief Emacs emulator
-;; Copyright (C) 1997-1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Gary D. Foster <Gary.Foster@Corp.Sun.COM>
;; Keywords: emulations brief crisp
@@ -44,9 +44,9 @@
;; by default run `save-buffers-kill-emacs' instead of the command
;; `execute-extended-command'.
-;; Finally, if you want to change the string displayed in the modeline
-;; when this mode is in effect, override the definition of
-;; `crisp-mode-modeline-string' in your .emacs. The default value is
+;; Finally, if you want to change the string displayed in the mode
+;; line when this mode is in effect, override the definition of
+;; `crisp-mode-mode-line-string' in your .emacs. The default value is
;; " *Crisp*" which may be a bit lengthy if you have a lot of things
;; being displayed there.
@@ -54,8 +54,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
;; local variables
(defgroup crisp nil
@@ -173,8 +171,11 @@
All the bindings are done here instead of globally to try and be
nice to the world.")
-(defcustom crisp-mode-modeline-string " *CRiSP*"
- "String to display in the modeline when CRiSP emulation mode is enabled."
+(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)
@@ -354,11 +355,11 @@ With a prefix argument ARG, enable CRiSP mode if ARG is positive,
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil."
:keymap crisp-mode-map
- :lighter crisp-mode-modeline-string
+ :lighter crisp-mode-mode-line-string
(when crisp-mode
;; Make menu entries show M-u or f14 in preference to C-x u.
(put 'undo :advertised-binding
- (list* [?\M-u] [f14] (get 'undo :advertised-binding)))
+ `([?\M-u] [f14] ,@(get 'undo :advertised-binding)))
;; Force transient-mark-mode, so that the marking routines work as
;; expected. If the user turns off transient mark mode, most
;; things will still work fine except the crisp-(copy|kill)
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index b17fa6b1471..6b9ae35141c 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -1,6 +1,6 @@
;;; cua-base.el --- emulate CUA key bindings
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulations convenience cua
@@ -84,7 +84,7 @@
;; If you have just replaced a highlighted region with typed text,
;; you can repeat the replace with M-v. This will search forward
-;; for a streach of text identical to the previous contents of the
+;; for a stretch of text identical to the previous contents of the
;; region (i.e. the contents of register 0) and replace it with the
;; text you typed to replace the original region. Repeating M-v will
;; replace the next matching region and so on.
@@ -116,7 +116,7 @@
;; CUA register support
;; --------------------
-;; Emacs' standard register support is also based on a separate set of
+;; Emacs's standard register support is also based on a separate set of
;; "register commands".
;;
;; CUA's register support is activated by providing a numeric
@@ -134,7 +134,7 @@
;; CUA rectangle support
;; ---------------------
-;; Emacs' normal rectangle support is based on interpreting the region
+;; Emacs's normal rectangle support is based on interpreting the region
;; between the mark and point as a "virtual rectangle", and using a
;; completely separate set of "rectangle commands" [C-x r ...] on the
;; region to copy, kill, fill a.s.o. the virtual rectangle.
@@ -463,7 +463,7 @@ Must be set prior to enabling CUA."
(defface cua-global-mark
'((((min-colors 88)(class color)) :foreground "black" :background "yellow1")
(((class color)) :foreground "black" :background "yellow")
- (t :bold t))
+ (t :weight bold))
"Font used by CUA for highlighting the global mark."
:group 'cua)
@@ -1002,15 +1002,21 @@ behavior, see `cua-paste-pop-rotate-temporarily'."
(setq this-command 'cua-paste-pop))))
(defun cua-exchange-point-and-mark (arg)
- "Exchanges point and mark, but don't activate the mark.
-Activates the mark if a prefix argument is given."
+ "Exchange point and mark.
+Don't activate the mark if `cua-enable-cua-keys' is non-nil.
+Otherwise, just activate the mark if a prefix ARG is given.
+
+See also `exchange-point-and-mark'."
(interactive "P")
- (if arg
- (setq mark-active t)
- (let (mark-active)
- (exchange-point-and-mark)
- (if cua--rectangle
- (cua--rectangle-corner 0)))))
+ (cond ((null cua-enable-cua-keys)
+ (exchange-point-and-mark arg))
+ (arg
+ (setq mark-active t))
+ (t
+ (let (mark-active)
+ (exchange-point-and-mark)
+ (if cua--rectangle
+ (cua--rectangle-corner 0))))))
;; Typed text that replaced the highlighted region.
(defvar cua--repeat-replace-text nil)
@@ -1246,22 +1252,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
;; (and region not started with C-SPC).
;; If rectangle is active, expand rectangle in specified direction and
;; ignore the movement.
- ((if window-system
- ;; Shortcut for window-system, assuming that input-decode-map is empty.
- (memq 'shift (event-modifiers
- (aref (this-single-command-raw-keys) 0)))
- (or
- ;; Check if the final key-sequence was shifted.
- (memq 'shift (event-modifiers
- (aref (this-single-command-keys) 0)))
- ;; If not, maybe the raw key-sequence was mapped by input-decode-map
- ;; to a shifted key (and then mapped down to its unshifted form).
- (let* ((keys (this-single-command-raw-keys))
- (ev (lookup-key input-decode-map keys)))
- (or (and (vector ev) (memq 'shift (event-modifiers (aref ev 0))))
- ;; Or maybe, the raw key-sequence was not an escape sequence
- ;; and was shifted (and then mapped down to its unshifted form).
- (memq 'shift (event-modifiers (aref keys 0)))))))
+ (this-command-keys-shift-translated
(unless mark-active
(push-mark-command nil t))
(setq cua--last-region-shifted t)
@@ -1478,6 +1469,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(define-key cua--region-keymap [remap backward-delete-char] 'cua-delete-region)
(define-key cua--region-keymap [remap backward-delete-char-untabify] 'cua-delete-region)
(define-key cua--region-keymap [remap delete-char] 'cua-delete-region)
+ (define-key cua--region-keymap [remap delete-forward-char] 'cua-delete-region)
;; kill region
(define-key cua--region-keymap [remap kill-region] 'cua-cut-region)
(define-key cua--region-keymap [remap clipboard-kill-region] 'cua-cut-region)
diff --git a/lisp/emulation/cua-gmrk.el b/lisp/emulation/cua-gmrk.el
index b6a3a977909..408d90618aa 100644
--- a/lisp/emulation/cua-gmrk.el
+++ b/lisp/emulation/cua-gmrk.el
@@ -1,6 +1,6 @@
;;; cua-gmrk.el --- CUA unified global mark support
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulations convenience cua mark
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 00aec2d0bf9..f63d79adf47 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -1,6 +1,6 @@
;;; cua-rect.el --- CUA unified rectangle support
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulations convenience CUA
@@ -21,7 +21,7 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;;; Acknowledgements
+;;; Acknowledgments
;; The rectangle handling and display code borrows from the standard
;; GNU emacs rect.el package and the rect-mark.el package by Rick
@@ -465,7 +465,7 @@ If command is repeated at same position, delete the rectangle."
(cua-copy-rectangle arg)
(setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle)))))
-(defun cua--mouse-ignore (event)
+(defun cua--mouse-ignore (_event)
(interactive "e")
(setq this-command last-command))
@@ -609,12 +609,12 @@ If command is repeated at same position, delete the rectangle."
(let ((lines 0))
(if (not (cua--rectangle-virtual-edges))
(cua--rectangle-operation nil nil t 2 t
- (lambda (s e l r v)
+ (lambda (s e _l _r _v)
(setq lines (1+ lines))
(if (and (> e s) (<= e (point-max)))
(delete-region s e))))
(cua--rectangle-operation nil 1 t nil t
- (lambda (s e l r v)
+ (lambda (s e _l _r _v)
(setq lines (1+ lines))
(when (and (> e s) (<= e (point-max)))
(delete-region s e)))))
@@ -624,10 +624,10 @@ If command is repeated at same position, delete the rectangle."
(let (rect)
(if (not (cua--rectangle-virtual-edges))
(cua--rectangle-operation nil nil nil nil nil ; do not tabify
- (lambda (s e l r)
+ (lambda (s e _l _r)
(setq rect (cons (cua--filter-buffer-noprops s e) rect))))
(cua--rectangle-operation nil 1 nil nil nil ; do not tabify
- (lambda (s e l r v)
+ (lambda (s e l r _v)
(let ((copy t) (bs 0) (as 0) row)
(if (= s e) (setq e (1+ e)))
(goto-char s)
@@ -840,7 +840,7 @@ If command is repeated at same position, delete the rectangle."
(pad (cua--rectangle-virtual-edges))
indent)
(cua--rectangle-operation (if clear 'clear 'corners) nil t pad nil
- (lambda (s e l r)
+ (lambda (_s _e l _r)
(move-to-column col pad)
(if (and (eolp)
(< (current-column) col))
@@ -905,10 +905,10 @@ With prefix argument, activate previous rectangle if possible."
(cua-help-for-region t))))
(defun cua-restrict-regexp-rectangle (arg)
- "Restrict rectangle to lines (not) matching REGEXP.
-With prefix argument, the toggle restriction."
+ "Restrict rectangle to lines (not) matching regexp.
+With prefix argument, toggle restriction."
(interactive "P")
- (let ((r (cua--rectangle-restriction)) regexp)
+ (let ((r (cua--rectangle-restriction)))
(if (and r (null (car (cdr r))))
(if arg
(cua--rectangle-restriction (car r) nil (not (car (cdr (cdr r)))))
@@ -919,9 +919,9 @@ With prefix argument, the toggle restriction."
(defun cua-restrict-prefix-rectangle (arg)
"Restrict rectangle to lines (not) starting with CHAR.
-With prefix argument, the toggle restriction."
+With prefix argument, toggle restriction."
(interactive "P")
- (let ((r (cua--rectangle-restriction)) regexp)
+ (let ((r (cua--rectangle-restriction)))
(if (and r (car (cdr r)))
(if arg
(cua--rectangle-restriction (car r) t (not (car (cdr (cdr r)))))
@@ -1000,7 +1000,7 @@ The text previously in the region is not overwritten by the blanks,
but instead winds up to the right of the rectangle."
(interactive)
(cua--rectangle-operation 'corners nil t 1 nil
- (lambda (s e l r)
+ (lambda (_s _e l r)
(skip-chars-forward " \t")
(let ((ws (- (current-column) l))
(p (point)))
@@ -1015,7 +1015,7 @@ at that column is deleted.
With prefix arg, also delete whitespace to the left of that column."
(interactive "P")
(cua--rectangle-operation 'clear nil t 1 nil
- (lambda (s e l r)
+ (lambda (s _e _l _r)
(when arg
(skip-syntax-backward " " (line-beginning-position))
(setq s (point)))
@@ -1027,7 +1027,7 @@ With prefix arg, also delete whitespace to the left of that column."
The text previously in the rectangle is overwritten by the blanks."
(interactive)
(cua--rectangle-operation 'keep nil nil 1 nil
- (lambda (s e l r)
+ (lambda (s e _l _r)
(goto-char e)
(skip-syntax-forward " " (line-end-position))
(setq e (point))
@@ -1040,20 +1040,19 @@ The text previously in the rectangle is overwritten by the blanks."
(defun cua-align-rectangle ()
"Align rectangle lines to left column."
(interactive)
- (let (x)
- (cua--rectangle-operation 'clear nil t t nil
- (lambda (s e l r)
- (let ((b (line-beginning-position)))
- (skip-syntax-backward "^ " b)
- (skip-syntax-backward " " b)
- (setq s (point)))
- (skip-syntax-forward " " (line-end-position))
- (delete-region s (point))
- (indent-to l))
- (lambda (l r)
- (move-to-column l)
- ;; (setq cua-save-point (point))
- ))))
+ (cua--rectangle-operation 'clear nil t t nil
+ (lambda (s _e l _r)
+ (let ((b (line-beginning-position)))
+ (skip-syntax-backward "^ " b)
+ (skip-syntax-backward " " b)
+ (setq s (point)))
+ (skip-syntax-forward " " (line-end-position))
+ (delete-region s (point))
+ (indent-to l))
+ (lambda (l _r)
+ (move-to-column l)
+ ;; (setq cua-save-point (point))
+ )))
(declare-function cua--cut-rectangle-to-global-mark "cua-gmrk" (as-text))
(declare-function cua--copy-rectangle-to-global-mark "cua-gmrk" (as-text))
@@ -1087,7 +1086,7 @@ The text previously in the rectangle is overwritten by the blanks."
The length of STRING need not be the same as the rectangle width."
(interactive "sString rectangle: ")
(cua--rectangle-operation 'keep nil t t nil
- (lambda (s e l r)
+ (lambda (s e l _r)
(delete-region s e)
(skip-chars-forward " \t")
(let ((ws (- (current-column) l)))
@@ -1095,7 +1094,7 @@ The length of STRING need not be the same as the rectangle width."
(insert string)
(indent-to (+ (current-column) ws))))
(unless (cua--rectangle-restriction)
- (lambda (l r)
+ (lambda (l _r)
(cua--rectangle-right (max l (+ l (length string) -1)))))))
(defun cua-fill-char-rectangle (character)
@@ -1113,7 +1112,7 @@ The length of STRING need not be the same as the rectangle width."
(if buffer-read-only
(message "Cannot replace in read-only buffer")
(cua--rectangle-operation 'keep nil t 1 nil
- (lambda (s e l r)
+ (lambda (_s e _l _r)
(if (re-search-forward regexp e t)
(replace-match newtext nil nil))))))
@@ -1121,7 +1120,7 @@ The length of STRING need not be the same as the rectangle width."
"Increment each line of CUA rectangle by prefix amount."
(interactive "p")
(cua--rectangle-operation 'keep nil t 1 nil
- (lambda (s e l r)
+ (lambda (_s e _l _r)
(cond
((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t)
(let* ((txt (cua--filter-buffer-noprops (match-beginning 1) (match-end 1)))
@@ -1154,14 +1153,14 @@ The numbers are formatted according to the FORMAT string."
(setq format cua--rectangle-seq-format)
(setq cua--rectangle-seq-format format))
(cua--rectangle-operation 'clear nil t 1 nil
- (lambda (s e l r)
+ (lambda (s e _l _r)
(delete-region s e)
(insert (format format first))
(setq first (+ first incr)))))
(defmacro cua--convert-rectangle-as (command tabify)
`(cua--rectangle-operation 'clear nil nil nil ,tabify
- (lambda (s e l r)
+ (lambda (s e _l _r)
(,command s e))))
(defun cua-upcase-rectangle ()
@@ -1218,7 +1217,7 @@ The numbers are formatted according to the FORMAT string."
(if cua--debug
(print z auxbuf))
(cua--rectangle-operation nil nil t pad nil
- (lambda (s e l r)
+ (lambda (s e l _r)
(let (cc)
(goto-char e)
(skip-chars-forward " \t")
@@ -1249,7 +1248,7 @@ The numbers are formatted according to the FORMAT string."
(put 'cua--rectangle-aux-replace 'lisp-indent-function 4)
-(defun cua--left-fill-rectangle (start end)
+(defun cua--left-fill-rectangle (_start _end)
(beginning-of-line)
(while (< (point) (point-max))
(delete-horizontal-space nil)
@@ -1298,7 +1297,7 @@ With prefix arg, replace rectangle with output from command."
"Remove the first line of the rectangle and scroll remaining lines up."
(interactive)
(cua--rectangle-aux-replace 0 t t t t
- (lambda (s e)
+ (lambda (s _e)
(if (= (forward-line 1) 0)
(delete-region s (point))))))
@@ -1307,7 +1306,7 @@ With prefix arg, replace rectangle with output from command."
The remaining lines are scrolled down, losing the last line."
(interactive)
(cua--rectangle-aux-replace 0 t t t t
- (lambda (s e)
+ (lambda (s _e)
(goto-char s)
(insert "\n"))))
@@ -1337,7 +1336,7 @@ With prefix arg, indent to that column."
(pad (cua--rectangle-virtual-edges))
indent)
(cua--rectangle-operation 'corners nil t pad nil
- (lambda (s e l r)
+ (lambda (_s _e l r)
(move-to-column
(if (cua--rectangle-right-side t)
(max (1+ r) col) l)
@@ -1420,10 +1419,13 @@ With prefix arg, indent to that column."
(define-key cua--rectangle-keymap [remap kill-ring-save] 'cua-copy-rectangle)
(define-key cua--rectangle-keymap [remap kill-region] 'cua-cut-rectangle)
(define-key cua--rectangle-keymap [remap delete-char] 'cua-delete-rectangle)
+ (define-key cua--rectangle-keymap [remap delete-forward-char] 'cua-delete-rectangle)
(define-key cua--rectangle-keymap [remap set-mark-command] 'cua-toggle-rectangle-mark)
(define-key cua--rectangle-keymap [remap forward-char] 'cua-resize-rectangle-right)
+ (define-key cua--rectangle-keymap [remap right-char] 'cua-resize-rectangle-right)
(define-key cua--rectangle-keymap [remap backward-char] 'cua-resize-rectangle-left)
+ (define-key cua--rectangle-keymap [remap left-char] 'cua-resize-rectangle-left)
(define-key cua--rectangle-keymap [remap next-line] 'cua-resize-rectangle-down)
(define-key cua--rectangle-keymap [remap previous-line] 'cua-resize-rectangle-up)
(define-key cua--rectangle-keymap [remap end-of-line] 'cua-resize-rectangle-eol)
diff --git a/lisp/emulation/edt-lk201.el b/lisp/emulation/edt-lk201.el
index 6132b455faf..987e1aa72e9 100644
--- a/lisp/emulation/edt-lk201.el
+++ b/lisp/emulation/edt-lk201.el
@@ -1,6 +1,6 @@
;;; edt-lk201.el --- enhanced EDT keypad mode emulation for LK-201 keyboards
-;; Copyright (C) 1986, 1992-1993, 1995, 2001-2011
+;; Copyright (C) 1986, 1992-1993, 1995, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com>
diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el
index e58656d7941..87b6bcf0aa9 100644
--- a/lisp/emulation/edt-mapper.el
+++ b/lisp/emulation/edt-mapper.el
@@ -1,6 +1,6 @@
;;; edt-mapper.el --- create an EDT LK-201 map file for X-Windows Emacs
-;; Copyright (C) 1994-1995, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2000-2012 Free Software Foundation, Inc.
;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com>
;; Maintainer: Kevin Gallagher <Kevin.Gallagher@boeing.com>
@@ -61,7 +61,7 @@
;; emacs -q -l edt-mapper.el
-;; The "-q" option prevents loading of your .emacs file (commands
+;; The "-q" option prevents loading of your init file (commands
;; therein might confuse this program).
;; An instruction screen showing the typical LK-201 terminal
@@ -74,7 +74,7 @@
;; and loaded automatically when the EDT emulation is started. If
;; you specify a different file name, you will need to set the
;; variable "edt-keys-file" before starting the EDT emulation.
-;; Here's how you might go about doing that in your .emacs file.
+;; Here's how you might go about doing that in your init file:
;; (setq edt-keys-file (expand-file-name "~/.my-emacs-keys"))
diff --git a/lisp/emulation/edt-pc.el b/lisp/emulation/edt-pc.el
index a51ecd34045..75dc81ea90d 100644
--- a/lisp/emulation/edt-pc.el
+++ b/lisp/emulation/edt-pc.el
@@ -1,6 +1,6 @@
;;; edt-pc.el --- enhanced EDT keypad mode emulation for PC 101 keyboards
-;; Copyright (C) 1986, 1994-1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1994-1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com>
;; Maintainer: Kevin Gallagher <Kevin.Gallagher@boeing.com>
diff --git a/lisp/emulation/edt-vt100.el b/lisp/emulation/edt-vt100.el
index 1dca1f19dfc..25bdfe55064 100644
--- a/lisp/emulation/edt-vt100.el
+++ b/lisp/emulation/edt-vt100.el
@@ -1,6 +1,6 @@
;;; edt-vt100.el --- enhanced EDT keypad mode emulation for VT series terminals
-;; Copyright (C) 1986, 1992-1993, 1995, 2002-2011
+;; Copyright (C) 1986, 1992-1993, 1995, 2002-2012
;; Free Software Foundation, Inc.
;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com>
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index acdc3caa449..3810dcccbb3 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -1,6 +1,6 @@
;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs
-;; Copyright (C) 1986, 1992-1995, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1992-1995, 2000-2012 Free Software Foundation, Inc.
;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com>
;; Maintainer: Kevin Gallagher <Kevin.Gallagher@boeing.com>
@@ -48,7 +48,7 @@
;; You can have the EDT Emulation start up automatically, each time
;; you initiate a GNU Emacs session, by adding the following line to
-;; your .emacs file:
+;; your init file:
;;
;; (add-hook term-setup-hook 'edt-emulation-on)
@@ -75,7 +75,7 @@
;; default, this feature is enabled, with the top margin set to
;; 10% of the window and the bottom margin set to 15% of the
;; window. To change these settings, you can invoke the function
-;; edt-set-scroll-margins in your .emacs file. For example, the
+;; edt-set-scroll-margins in your init file. For example, the
;; following line
;;
;; (edt-set-scroll-margins "20%" "25%")
@@ -363,7 +363,7 @@ This means that an edt-user.el file was found in the user's `load-path'.")
;;;
;;; (setq edt-keep-current-page-delimiter t)
;;;
-;;; in your .emacs file.
+;;; in your init file.
(defun edt-page-forward (num)
"Move forward to just after next page delimiter.
@@ -1961,14 +1961,14 @@ created."
Ack!! You're running the Enhanced EDT Emulation without loading an
EDT key mapping file. To create an EDT key mapping file, run the
edt-mapper program. It is safest to run it from an Emacs loaded
- without any of your own customizations found in your .emacs file, etc.
+ without any of your own customizations found in your init file, etc.
The reason for this is that some user customizations confuse edt-mapper.
You can do this by quitting Emacs and then invoking Emacs again as
follows:
emacs -q -l edt-mapper
- [NOTE: If you do nothing out of the ordinary in your .emacs file, and
+ [NOTE: If you do nothing out of the ordinary in your init file, and
the search for edt-mapper is successful, you can try running it now.]
The library edt-mapper includes these same directions on how to
@@ -2071,6 +2071,20 @@ created."
(setq transient-mark-mode edt-orig-transient-mark-mode))
(message "Original key bindings restored; EDT Emulation disabled"))
+(defun edt-default-menu-bar-update-buffers ()
+ ;; Update edt-default-global-map with latest copy of
+ ;; `global-buffers-menu-map' each time `menu-bar-update-buffers'
+ ;; updates global-map.
+ (define-key edt-default-global-map [menu-bar buffer]
+ (cons "Buffers" global-buffers-menu-map)))
+
+(defun edt-user-menu-bar-update-buffers ()
+ ;; We need to update edt-user-global-map with latest copy of
+ ;; `global-buffers-menu-map' each time `menu-bar-update-buffers'
+ ;; updates global-map.
+ (define-key edt-user-global-map [menu-bar buffer]
+ (cons "Buffers" global-buffers-menu-map)))
+
(defun edt-default-emulation-setup (&optional user-setup)
"Setup emulation of DEC's EDT editor.
Optional argument USER-SETUP non-nil means called from function
@@ -2110,10 +2124,8 @@ Optional argument USER-SETUP non-nil means called from function
(progn
(fset 'edt-emulation-on (symbol-function 'edt-select-default-global-map))
(edt-select-default-global-map)))
- ;; We need to share `global-buffers-menu-map' with the saved global
- ;; keymap, because `menu-bar-update-buffers' directly changes it.
- (define-key (current-global-map) [menu-bar buffer]
- (cons "Buffers" global-buffers-menu-map)))
+ ;; Keep the menu bar Buffers menu up-to-date in edt-default-global-map.
+ (add-hook 'menu-bar-update-hook 'edt-default-menu-bar-update-buffers))
(defun edt-user-emulation-setup ()
"Setup user custom emulation of DEC's EDT editor."
@@ -2134,7 +2146,9 @@ Optional argument USER-SETUP non-nil means called from function
;; See Info node `edt' for more details, and sample edt-user.el file.
(if (fboundp 'edt-setup-user-bindings)
(edt-setup-user-bindings))
- (edt-select-user-global-map))
+ (edt-select-user-global-map)
+ ;; Keep the menu bar Buffers menu up-to-date in edt-user-global-map.
+ (add-hook 'menu-bar-update-hook 'edt-user-menu-bar-update-buffers))
(defun edt-select-default-global-map()
"Select default EDT emulation key bindings."
diff --git a/lisp/emulation/keypad.el b/lisp/emulation/keypad.el
index 0156e54f90f..4e2c3b1e886 100644
--- a/lisp/emulation/keypad.el
+++ b/lisp/emulation/keypad.el
@@ -1,6 +1,6 @@
;;; keypad.el --- simplified keypad bindings
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard convenience
@@ -27,7 +27,7 @@
;;
;; With the following setup, the keypad can be used for numeric data
;; entry when NumLock is off, and to give numeric prefix arguments to
-;; emacs commands, when NumLock on on.
+;; emacs commands, when NumLock is on.
;;
;; keypad-setup => Plain Numeric Keypad
;; keypad-numlock-setup => Prefix numeric args
diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el
index e2ad5d81d27..d375725af56 100644
--- a/lisp/emulation/tpu-edt.el
+++ b/lisp/emulation/tpu-edt.el
@@ -1,6 +1,6 @@
;;; tpu-edt.el --- Emacs emulating TPU emulating EDT
-;; Copyright (C) 1993-1995, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2012 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
@@ -89,7 +89,7 @@
;; details.
;; Like TPU, Emacs uses multiple buffers. Some buffers are used to hold
-;; files you are editing; other "internal" buffers are used for Emacs' own
+;; files you are editing; other "internal" buffers are used for Emacs's own
;; purposes (like showing you help). Here are some commands for dealing
;; with buffers.
@@ -163,8 +163,8 @@
;; and type `tpu-edt' followed by a carriage return.
;; If you like TPU-edt and want to use it all the time, you can start
-;; TPU-edt using the Emacs initialization file, .emacs. Simply create
-;; a .emacs file in your home directory containing the line:
+;; TPU-edt using the Emacs initialization file, .emacs. Simply add
+;; the following line to your init file:
;; (tpu-edt)
@@ -197,7 +197,7 @@
;; ; Emacs uses Control-s and Control-q. Problems can occur when using
;; ; Emacs on terminals that use these codes for flow control (Xon/Xoff
-;; ; flow control). These lines disable Emacs' use of these characters.
+;; ; flow control). These lines disable Emacs's use of these characters.
;; (global-unset-key "\C-s")
;; (global-unset-key "\C-q")
@@ -315,6 +315,7 @@ Otherwise, use `spell-region'."
;;; Global Keymaps
;;;
+(define-obsolete-variable-alias 'GOLD-map 'tpu-gold-map "23.1")
(defvar tpu-gold-map
(let ((map (make-keymap)))
;; Previously we used escape sequences here. We now instead presume
@@ -494,7 +495,6 @@ Otherwise, use `spell-region'."
map)
"Maps the function keys on the VT100 keyboard preceded by PF1.
GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
-(define-obsolete-variable-alias 'GOLD-map 'tpu-gold-map "23.1")
(defvar tpu-global-map
(let ((map (make-sparse-keymap)))
@@ -979,7 +979,10 @@ and the total number of lines in the buffer."
;;;
;;;###autoload
(define-minor-mode tpu-edt-mode
- "TPU/edt emulation."
+ "Toggle TPU/edt emulation on or off.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
:global t
(if tpu-edt-mode (tpu-edt-on) (tpu-edt-off)))
@@ -2437,11 +2440,14 @@ If FILE is nil, try to load a default file. The default file names are
;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins
-;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "0d2f0cd1c728d2eb9028a6e01b1a5df1")
+;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "bf5e7322f9a2c324a3bb306415813374")
;;; Generated autoloads from tpu-extras.el
(autoload 'tpu-cursor-free-mode "tpu-extras" "\
Minor mode to allow the cursor to move freely about the screen.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
\(fn &optional ARG)" t nil)
diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el
index 235b16e92b1..4cf9eee037b 100644
--- a/lisp/emulation/tpu-extras.el
+++ b/lisp/emulation/tpu-extras.el
@@ -1,6 +1,6 @@
;;; tpu-extras.el --- scroll margins and free cursor mode for TPU-edt
-;; Copyright (C) 1993-1995, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2012 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
@@ -26,7 +26,7 @@
;; Use the functions defined here to customize TPU-edt to your tastes by
;; setting scroll margins and/or turning on free cursor mode. Here's an
-;; example for your .emacs file.
+;; example for your init file.
;; (tpu-set-cursor-free) ; Set cursor free.
;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins.
@@ -132,7 +132,10 @@ the previous line when starting from a line beginning."
;;;###autoload
(define-minor-mode tpu-cursor-free-mode
- "Minor mode to allow the cursor to move freely about the screen."
+ "Minor mode to allow the cursor to move freely about the screen.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
:init-value nil
(if (not tpu-cursor-free-mode)
(tpu-trim-line-ends))
diff --git a/lisp/emulation/tpu-mapper.el b/lisp/emulation/tpu-mapper.el
index 15417a137f8..9cced60816c 100644
--- a/lisp/emulation/tpu-mapper.el
+++ b/lisp/emulation/tpu-mapper.el
@@ -1,6 +1,6 @@
;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file
-;; Copyright (C) 1993-1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
@@ -81,7 +81,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)
diff --git a/lisp/emulation/vi.el b/lisp/emulation/vi.el
index 9bf108c8c38..a59dd610c21 100644
--- a/lisp/emulation/vi.el
+++ b/lisp/emulation/vi.el
@@ -28,7 +28,7 @@
;; (if (not (or (eq major-mode 'Info-mode)
;; (eq major-mode 'vi-mode)))
;; (vi-mode))))))
-;; 3) In your .emacs file you can define the command "vi-mode" to be "autoload"
+;; 3) In your init file you can define the command "vi-mode" to be "autoload"
;; or you can execute the "load" command to load "vi" directly.
;; 4) Read the comments for command "vi-mode" before you start using it.
diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el
index 1298e5424ac..c313a97f726 100644
--- a/lisp/emulation/vip.el
+++ b/lisp/emulation/vip.el
@@ -1,6 +1,6 @@
;;; vip.el --- a VI Package for GNU Emacs
-;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2011
+;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Masahiko Sato <ms@sail.stanford.edu>
@@ -307,10 +307,10 @@ If nil then it is bound to `delete-backward-char'."
(defmacro vip-loop (count body)
"(COUNT BODY) Execute BODY COUNT times."
- (list 'let (list (list 'count count))
- (list 'while (list '> 'count 0)
- body
- (list 'setq 'count (list '1- 'count)))))
+ `(let ((count ,count))
+ (while (> count 0)
+ ,body
+ (setq count (1- count)))))
(defun vip-push-mark-silent (&optional location)
"Set mark at LOCATION (point, by default) and push old mark on mark ring.
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index b6d487704f4..dc767f72e62 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -1,6 +1,6 @@
;;; viper-cmd.el --- Vi command support for Viper
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -1086,8 +1086,17 @@ as a Meta key and any number of multiple escapes are allowed."
(defun viper-intercept-ESC-key ()
"Function that implements ESC key in Viper emulation of Vi."
(interactive)
- (let ((cmd (or (key-binding (viper-envelop-ESC-key))
- (lambda () (interactive) (error "Viper bell")))))
+ ;; `key-binding' needs to be called in a context where Viper's
+ ;; minor-mode map(s) have been temporarily disabled so the ESC
+ ;; binding to viper-intercept-ESC-key doesn't hide the binding we're
+ ;; looking for (Bug#9146):
+ (let* ((event (viper-envelop-ESC-key))
+ (cmd (cond ((equal event viper-ESC-key)
+ 'viper-intercept-ESC-key)
+ ((let ((emulation-mode-map-alists nil))
+ (key-binding event)))
+ (t
+ (error "Viper bell")))))
;; call the actual function to execute ESC (if no other symbols followed)
;; or the key bound to the ESC sequence (if the sequence was issued
@@ -2110,7 +2119,7 @@ Undo previous insertion and inserts new."
(defcustom viper-smart-suffix-list
'("" "tex" "c" "cc" "C" "java" "el" "html" "htm" "xml"
"pl" "flr" "P" "p" "h" "H")
- "*List of suffixes that Viper tries to append to filenames ending with a `.'.
+ "List of suffixes that Viper tries to append to filenames ending with a `.'.
This is useful when the current directory contains files with the same
prefix and many different suffixes. Usually, only one of the suffixes
represents an editable file. However, file completion will stop at the `.'
@@ -3453,7 +3462,7 @@ controlled by the sign of prefix numeric value."
(defun viper-adjust-window ()
(let ((win-height (if (featurep 'xemacs)
(window-displayed-height)
- (1- (window-height)))) ; adjust for modeline
+ (1- (window-height)))) ; adjust for mode line
(pt (point))
at-top-p at-bottom-p
min-scroll direction)
@@ -4397,7 +4406,7 @@ cursor move past the beginning of line."
(defun viper-query-replace ()
"Query replace.
-If a null string is suplied as the string to be replaced,
+If a null string is supplied as the string to be replaced,
the query replace mode will toggle between string replace
and regexp replace."
(interactive)
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 3e21e77a77b..acaedde3004 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -1,6 +1,6 @@
;;; viper-ex.el --- functions implementing the Ex commands for Viper
-;; Copyright (C) 1994-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -368,14 +368,14 @@ corresponding function symbol."
(defvar viper-keep-reading-filename nil)
(defcustom ex-cycle-other-window t
- "*If t, :n and :b cycles through files and buffers in other window.
+ "If t, :n and :b cycles through files and buffers in other window.
Then :N and :B cycles in the current window. If nil, this behavior is
reversed."
:type 'boolean
:group 'viper-ex)
(defcustom ex-cycle-through-non-files nil
- "*Cycle through *scratch* and other buffers that don't visit any file."
+ "Cycle through *scratch* and other buffers that don't visit any file."
:type 'boolean
:group 'viper-ex)
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index 2fc8dc599cb..c482a88de1a 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -1,6 +1,6 @@
;;; viper-init.el --- some common definitions for Viper
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -96,6 +96,10 @@ In all likelihood, you don't need to bother with this setting."
;;; Macros
(defmacro viper-deflocalvar (var default-value &optional documentation)
+ "Define VAR as a buffer-local variable.
+DEFAULT-VALUE is the default value, and DOCUMENTATION is the
+docstring. The variable becomes buffer-local whenever set."
+ (declare (indent defun))
`(progn
(defvar ,var ,default-value
,(format "%s\n\(buffer local\)" documentation))
@@ -103,6 +107,7 @@ In all likelihood, you don't need to bother with this setting."
;; (viper-loop COUNT BODY) Execute BODY COUNT times.
(defmacro viper-loop (count &rest body)
+ (declare (indent defun))
`(let ((count ,count))
(while (> count 0)
,@body
@@ -316,7 +321,7 @@ Use `M-x viper-set-expert-level' to change this.")
))
;; viper hook to run on input-method deactivation
-(defun viper-inactivate-input-method-action ()
+(defun viper-deactivate-input-method-action ()
(if (null viper-mule-hook-flag)
()
(setq viper-special-input-method nil)
@@ -328,9 +333,9 @@ Use `M-x viper-set-expert-level' to change this.")
(or current-input-method default-input-method))
"")))))
-(defun viper-inactivate-input-method ()
- (cond ((and (featurep 'emacs) (fboundp 'inactivate-input-method))
- (inactivate-input-method))
+(defun viper-deactivate-input-method ()
+ (cond ((and (featurep 'emacs) (fboundp 'deactivate-input-method))
+ (deactivate-input-method))
((and (featurep 'xemacs) (boundp 'current-input-method))
;; XEmacs had broken quail-mode for some time, so we are working around
;; it here
@@ -339,7 +344,9 @@ Use `M-x viper-set-expert-level' to change this.")
(quail-delete-overlays))
(setq describe-current-input-method-function nil)
(setq current-input-method nil)
- (run-hooks 'input-method-inactivate-hook)
+ (run-hooks
+ 'input-method-inactivate-hook ; for backward compatibility
+ 'input-method-deactivate-hook)
(force-mode-line-update))
))
(defun viper-activate-input-method ()
@@ -356,7 +363,7 @@ Use `M-x viper-set-expert-level' to change this.")
;; activate input method
(viper-activate-input-method))
(t ; deactivate input method
- (viper-inactivate-input-method)))
+ (viper-deactivate-input-method)))
))
@@ -372,7 +379,7 @@ Use `M-x viper-set-expert-level' to change this.")
(defconst viper-buffer-undo-list-mark 'viper)
(defcustom viper-keep-point-on-undo nil
- "*Non-nil means not to move point while undoing commands.
+ "Non-nil means not to move point while undoing commands.
This style is different from Emacs and Vi. Try it to see if
it better fits your working style."
:type 'boolean
@@ -403,7 +410,7 @@ delete the text being replaced, as in standard Vi."
:group 'viper)
(defcustom viper-replace-overlay-cursor-color "Red"
- "*Cursor color when Viper is in Replace state."
+ "Cursor color when Viper is in Replace state."
:type 'string
:group 'viper)
@@ -450,7 +457,7 @@ is non-nil."
(defcustom viper-use-replace-region-delimiters
(or (not (viper-has-face-support-p))
(and (featurep 'xemacs) (eq (viper-device-type) 'tty)))
- "*If non-nil, Viper will always use `viper-replace-region-end-delimiter' and
+ "If non-nil, Viper will always use `viper-replace-region-end-delimiter' and
`viper-replace-region-start-delimiter' to delimit replacement regions, even on
color displays. By default, the delimiters are used only on TTYs."
:type 'boolean
@@ -519,7 +526,7 @@ text."
;; Fast keyseq and ESC keyseq timeouts
(defcustom viper-fast-keyseq-timeout 200
- "*Key sequence separated by no more than this many milliseconds is viewed as a Vi-style macro, if such a macro is defined.
+ "Key sequence separated by no more than this many milliseconds is viewed as a Vi-style macro, if such a macro is defined.
Setting this too high may slow down your typing. Setting this value too low
will make it hard to use Vi-style timeout macros."
:type 'integer
@@ -549,14 +556,14 @@ will make it hard to use Vi-style timeout macros."
(viper-deflocalvar viper-auto-indent nil "")
(defcustom viper-auto-indent nil
- "*Enable autoindent, if t.
+ "Enable autoindent, if t.
This is a buffer-local variable."
:type 'boolean
:group 'viper)
(viper-deflocalvar viper-electric-mode t "")
(defcustom viper-electric-mode t
- "*If t, electrify Viper.
+ "If t, electrify Viper.
Currently, this only electrifies auto-indentation, making it appropriate to the
mode of the buffer.
This means that auto-indentation will depart from standard Vi and will indent
@@ -566,7 +573,7 @@ programs and LaTeX documents."
:group 'viper)
(defcustom viper-shift-width 8
- "*The value of the shiftwidth.
+ "The value of the shiftwidth.
This determines the number of columns by which the Ctl-t moves the cursor in
the Insert state."
:type 'integer
@@ -575,7 +582,7 @@ the Insert state."
;; Variables for repeating destructive commands
(defcustom viper-keep-point-on-repeat t
- "*If t, don't move point when repeating previous command.
+ "If t, don't move point when repeating previous command.
This is useful for doing repeated changes with the '.' key.
The user can change this to nil, if she likes when the cursor moves
to a new place after repeating previous Vi command."
@@ -668,18 +675,18 @@ to a new place after repeating previous Vi command."
(defvar viper-s-forward nil)
(defcustom viper-case-fold-search nil
- "*If not nil, search ignores cases."
+ "If not nil, search ignores cases."
:type 'boolean
:group 'viper-search)
(defcustom viper-re-search t
- "*If not nil, search is regexp search, otherwise vanilla search."
+ "If not nil, search is regexp search, otherwise vanilla search."
:type 'boolean
:tag "Regexp Search"
:group 'viper-search)
(defcustom viper-search-scroll-threshold 2
- "*If search lands within this threshold from the window top/bottom,
+ "If search lands within this threshold from the window top/bottom,
the window will be scrolled up or down appropriately, to reveal context.
If you want Viper search to behave as usual in Vi, set this variable to a
negative number."
@@ -687,32 +694,32 @@ negative number."
:group 'viper-search)
(defcustom viper-re-query-replace t
- "*If t then do regexp replace, if nil then do string replace."
+ "If t then do regexp replace, if nil then do string replace."
:type 'boolean
:tag "Regexp Query Replace"
:group 'viper-search)
(defcustom viper-re-replace t
- "*If t, do regexp replace. nil means do string replace."
+ "If t, do regexp replace. nil means do string replace."
:type 'boolean
:tag "Regexp Replace"
:group 'viper-search)
(defcustom viper-parse-sexp-ignore-comments t
- "*If t, `%' ignores the parentheses that occur inside comments."
+ "If t, `%' ignores the parentheses that occur inside comments."
:type 'boolean
:group 'viper)
(viper-deflocalvar viper-ex-style-motion t "")
(defcustom viper-ex-style-motion t
- "*If t, the commands l,h do not cross lines, etc (Ex-style).
+ "If t, the commands l,h do not cross lines, etc (Ex-style).
If nil, these commands cross line boundaries."
:type 'boolean
:group 'viper)
(viper-deflocalvar viper-ex-style-editing t "")
(defcustom viper-ex-style-editing t
- "*If t, Ex-style behavior while editing in Vi command and insert states.
+ "If t, Ex-style behavior while editing in Vi command and insert states.
`Backspace' and `Delete' don't cross line boundaries in insert.
`X' and `x' can't delete characters across line boundary in Vi, etc.
Note: this doesn't preclude `Backspace' and `Delete' from deleting characters
@@ -724,32 +731,32 @@ If nil, the above commands can work across lines."
(viper-deflocalvar viper-ESC-moves-cursor-back viper-ex-style-editing "")
(defcustom viper-ESC-moves-cursor-back nil
- "*If t, ESC moves cursor back when changing from insert to vi state.
+ "If t, ESC moves cursor back when changing from insert to vi state.
If nil, the cursor stays where it was when ESC was hit."
:type 'boolean
:group 'viper)
(viper-deflocalvar viper-delete-backwards-in-replace nil "")
(defcustom viper-delete-backwards-in-replace nil
- "*If t, DEL key will delete characters while moving the cursor backwards.
+ "If t, DEL key will delete characters while moving the cursor backwards.
If nil, the cursor will move backwards without deleting anything."
:type 'boolean
:group 'viper)
(defcustom viper-buffer-search-char nil
- "*Key used for buffer-searching. Must be a character type, e.g., ?g."
+ "Key used for buffer-searching. Must be a character type, e.g., ?g."
:type '(choice (const nil) character)
:group 'viper-search)
(defcustom viper-search-wrap-around t
- "*If t, search wraps around."
+ "If t, search wraps around."
:type 'boolean
:tag "Search Wraps Around"
:group 'viper-search)
(viper-deflocalvar viper-related-files-and-buffers-ring nil "")
(defcustom viper-related-files-and-buffers-ring nil
- "*List of file and buffer names that are considered to be related to the current buffer.
+ "List of file and buffer names that are considered to be related to the current buffer.
Related buffers can be cycled through via :R and :P commands."
:type 'boolean
:group 'viper-misc)
@@ -771,7 +778,7 @@ Related buffers can be cycled through via :R and :P commands."
"^\\\\[sb][a-z]*{.*}\\s-*$\\|" ; latex
"^@node\\|@table\\|^@m?enu\\|^@itemize\\|^@if\\|" ; texinfo
"^.+:-") ; prolog
- "*Regexps for Headings. Used by \[\[ and \]\].")
+ "Regexps for Headings. Used by \[\[ and \]\].")
(defvar viper-heading-end
(concat "^}\\|" ; C/C++
@@ -826,7 +833,7 @@ Related buffers can be cycled through via :R and :P commands."
(defface viper-search
'((((class color)) (:foreground "Black" :background "khaki"))
(t (:underline t :stipple "gray3")))
- "*Face used to flash out the search pattern."
+ "Face used to flash out the search pattern."
:group 'viper-highlighting)
;; An internal variable. Viper takes the face from here.
(defvar viper-search-face 'viper-search
@@ -838,7 +845,7 @@ this variable represents.")
(defface viper-replace-overlay
'((((class color)) (:foreground "Black" :background "darkseagreen2"))
(t (:underline t :stipple "gray3")))
- "*Face for highlighting replace regions on a window display."
+ "Face for highlighting replace regions on a window display."
:group 'viper-highlighting)
;; An internal variable. Viper takes the face from here.
(defvar viper-replace-overlay-face 'viper-replace-overlay
@@ -946,19 +953,19 @@ Should be set in `~/.viper' file."
:group 'viper)
(defcustom viper-vi-state-hook 'viper-restore-cursor-type
- "*Hooks run just before the switch to Vi mode is completed."
+ "Hooks run just before the switch to Vi mode is completed."
:type 'hook
:group 'viper-hooks)
(defcustom viper-insert-state-hook 'viper-set-insert-cursor-type
- "*Hooks run just before the switch to Insert mode is completed."
+ "Hooks run just before the switch to Insert mode is completed."
:type 'hook
:group 'viper-hooks)
(defcustom viper-replace-state-hook 'viper-restore-cursor-type
- "*Hooks run just before the switch to Replace mode is completed."
+ "Hooks run just before the switch to Replace mode is completed."
:type 'hook
:group 'viper-hooks)
(defcustom viper-emacs-state-hook 'viper-restore-cursor-type
- "*Hooks run just before the switch to Emacs mode is completed."
+ "Hooks run just before the switch to Emacs mode is completed."
:type 'hook
:group 'viper-hooks)
@@ -980,7 +987,7 @@ Should be set in `~/.viper' file."
(setq cursor-type '(bar . 2))))
(defun viper-ESC-keyseq-timeout ()
- "*Key sequence beginning with ESC and separated by no more than this many milliseconds is considered to be generated by a keyboard function key.
+ "Key sequence beginning with ESC and separated by no more than this many milliseconds is considered to be generated by a keyboard function key.
Setting this too high may slow down switching from insert to vi state. Setting
this value too low will make it impossible to use function keys in insert mode
on a dumb terminal."
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index f3bd6bece6e..ad1e32b5546 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -1,6 +1,6 @@
;;; viper-keym.el --- Viper keymaps
-;; Copyright (C) 1994-1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -48,19 +48,19 @@
;;; Emacs keys in other states.
(defcustom viper-want-emacs-keys-in-insert t
- "*Set to nil if you want complete Vi compatibility in insert mode.
+ "Set to nil if you want complete Vi compatibility in insert mode.
Complete compatibility with Vi is not recommended for power use of Viper."
:type 'boolean
:group 'viper)
(defcustom viper-want-emacs-keys-in-vi t
- "*Set to nil if you want complete Vi compatibility in Vi mode.
+ "Set to nil if you want complete Vi compatibility in Vi mode.
Full Vi compatibility is not recommended for power use of Viper."
:type 'boolean
:group 'viper)
(defcustom viper-no-multiple-ESC t
- "*If true, multiple ESC in Vi mode will cause bell to ring.
+ "If true, multiple ESC in Vi mode will cause bell to ring.
This is set to t on a windowing terminal and to 'twice on a dumb
terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this
enables cursor keys and is generally more convenient, as terminals usually
@@ -71,7 +71,7 @@ as is allowed by the major mode in effect."
:group 'viper)
(defcustom viper-want-ctl-h-help nil
- "*If non-nil, C-h gets bound to help-command; otherwise, C-h gets the usual Vi bindings."
+ "If non-nil, C-h gets bound to help-command; otherwise, C-h gets the usual Vi bindings."
:type 'boolean
:group 'viper)
diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el
index 2704bdc5b40..0b96793deb7 100644
--- a/lisp/emulation/viper-macs.el
+++ b/lisp/emulation/viper-macs.el
@@ -1,6 +1,6 @@
;;; viper-macs.el --- functions implementing keyboard macros for Viper
-;; Copyright (C) 1994-1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el
index a99ffdea558..eda1a7ec937 100644
--- a/lisp/emulation/viper-mous.el
+++ b/lisp/emulation/viper-mous.el
@@ -1,6 +1,6 @@
;;; viper-mous.el --- mouse support for Viper
-;; Copyright (C) 1994-1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -63,7 +63,7 @@
(defvar viper-current-frame-saved (selected-frame))
(defcustom viper-surrounding-word-function 'viper-surrounding-word
- "*Function that determines what constitutes a word for clicking events.
+ "Function that determines what constitutes a word for clicking events.
Takes two parameters: a COUNT, indicating how many words to return,
and CLICK-COUNT, telling whether this is the first click, a double-click,
or a triple-click."
@@ -77,7 +77,7 @@ or a triple-click."
mouse-track-multi-click-time
double-click-time)
500)
- "*Time interval in millisecond within which successive mouse clicks are
+ "Time interval in millisecond within which successive mouse clicks are
considered related."
:type 'integer
:group 'viper-mouse)
@@ -624,7 +624,7 @@ bindings in the Viper manual."
(defcustom viper-mouse-search-key '(meta shift 1)
- "*Key used to click-search in Viper.
+ "Key used to click-search in Viper.
This must be a list that specifies the mouse button and modifiers.
The supported modifiers are `meta', `shift', and `control'.
For instance, `(meta shift 1)' means that holding the meta and shift
@@ -640,7 +640,7 @@ This buffer may be different from the one where the click occurred."
:group 'viper-mouse)
(defcustom viper-mouse-insert-key '(meta shift 2)
- "*Key used to click-insert in Viper.
+ "Key used to click-insert in Viper.
Must be a list that specifies the mouse button and modifiers.
The supported modifiers are `meta', `shift', and `control'.
For instance, `(meta shift 2)' means that holding the meta and shift keys
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index fcab8b57c1e..4afa379f389 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -1,6 +1,6 @@
;;; viper-util.el --- Utilities used by viper.el
-;; Copyright (C) 1994-1997, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 1999-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -295,7 +295,7 @@ Otherwise return the normal value."
result))
;; Emacs used to count each multibyte character as several positions in the buffer,
-;; so we had to use Emacs' chars-in-region to count characters. Since 20.3,
+;; so we had to use Emacs's chars-in-region to count characters. Since 20.3,
;; Emacs counts multibyte characters as 1 position. XEmacs has always been
;; counting each char as just one pos. So, now we can simply subtract beg from
;; end to determine the number of characters in a region.
@@ -1112,7 +1112,7 @@ Otherwise return the normal value."
lis)))
-;; Smooths out the difference between Emacs' unread-command-events
+;; Smooths out the difference between Emacs's unread-command-events
;; and XEmacs unread-command-event. Arg is a character, an event, a list of
;; events or a sequence of keys.
;;
@@ -1323,7 +1323,7 @@ sets the default value."
(viper-update-syntax-classes))
(defcustom viper-syntax-preference 'reformed-vi
- "*Syntax type characterizing Viper's alphanumeric symbols.
+ "Syntax type characterizing Viper's alphanumeric symbols.
Affects movement and change commands that deal with Vi-style words.
Works best when set in the hooks to various major modes.
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 3704725b8dd..8de253d19b0 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -3,7 +3,7 @@
;; and a venomous VI PERil.
;; Viper Is also a Package for Emacs Rebels.
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Keywords: emulations
@@ -87,7 +87,7 @@
;; facility in the original Vi.
;; First, one can execute any Emacs command while defining a
;; macro, not just the Vi commands. Second, macros are defined in a
-;; WYSYWYG mode, using an interface to Emacs' WYSIWYG style of defining
+;; WYSYWYG mode, using an interface to Emacs's WYSIWYG style of defining
;; macros. Third, in Viper, one can define macros that are specific to
;; a given buffer, a given major mode, or macros defined for all buffers.
;; The same macro name can have several different definitions:
@@ -103,8 +103,8 @@
;; (require 'viper)
;;
-;;; Acknowledgements:
-;; -----------------
+;;; Acknowledgments:
+;; ----------------
;; Bug reports and ideas contributed by many users have helped
;; improve Viper and the various versions of VIP.
;; See the on-line manual for a complete list of contributors.
@@ -351,7 +351,7 @@ user decide when to invoke Viper in a major mode."
If t, viperize Emacs. If nil -- don't. If `ask', ask the user.
This variable is used primarily when Viper is being loaded.
-Must be set in `~/.emacs' before Viper is loaded.
+Must be set in your init file before Viper is loaded.
DO NOT set this variable interactively, unless you are using the customization
widget."
:type '(choice (const nil) (const t) (const ask))
@@ -435,7 +435,7 @@ widget."
view-mode
vm-mode
vm-summary-mode)
- "*A list of major modes that should come up in Emacs state.
+ "A list of major modes that should come up in Emacs state.
Normally, Viper would bring buffers up in Emacs state, unless the corresponding
major mode has been placed on `viper-vi-state-mode-list' or
`viper-insert-state-mode-list'. So, don't place a new mode on this list,
@@ -451,7 +451,7 @@ unless it is coming up in a wrong Viper state."
erc-mode
eshell-mode
shell-mode)
- "*A list of major modes that should come up in Vi Insert state."
+ "A list of major modes that should come up in Vi Insert state."
:type '(repeat symbol)
:group 'viper-misc)
@@ -561,7 +561,7 @@ and improving upon much of it.
use Emacs productively, you are advised to reach user level 3 or higher.
At user level 2 or higher, ^X and ^C have Emacs, not Vi, bindings;
- ^Z toggles Vi/Emacs states; ^G is Emacs' keyboard-quit (like ^C in Vi).
+ ^Z toggles Vi/Emacs states; ^G is Emacs's keyboard-quit (like ^C in Vi).
2. Vi exit functions (e.g., :wq, ZZ) work on INDIVIDUAL files -- they
do not cause Emacs to quit, except at user level 1 (for a novice).
@@ -971,9 +971,9 @@ It also can't undo some Viper settings."
(if (featurep 'emacs)
(eval-after-load "mule-cmds"
'(progn
- (defadvice inactivate-input-method (after viper-mule-advice activate)
+ (defadvice deactivate-input-method (after viper-mule-advice activate)
"Set viper-special-input-method to disable intl. input methods."
- (viper-inactivate-input-method-action))
+ (viper-deactivate-input-method-action))
(defadvice activate-input-method (after viper-mule-advice activate)
"Set viper-special-input-method to enable intl. input methods."
(viper-activate-input-method-action))
@@ -985,14 +985,14 @@ It also can't undo some Viper settings."
'(progn
(add-hook 'input-method-activate-hook
'viper-activate-input-method-action t)
- (add-hook 'input-method-inactivate-hook
- 'viper-inactivate-input-method-action t)))
+ (add-hook 'input-method-deactivate-hook
+ 'viper-deactivate-input-method-action t)))
)
(eval-after-load "mule-cmds"
'(defadvice toggle-input-method (around viper-mule-advice activate)
"Adjust input-method toggling in vi-state."
(if (and viper-special-input-method (eq viper-current-state 'vi-state))
- (viper-inactivate-input-method)
+ (viper-deactivate-input-method)
ad-do-it)))
) ; viper-set-hooks
@@ -1173,7 +1173,7 @@ If you wish to Viperize AND make this your way of life, please put
(setq viper-mode t)
(require 'viper)
-in your .emacs file (preferably, close to the top).
+in your init file (preferably, close to the top).
These two lines must come in the order given.
** Viper users:
diff --git a/lisp/emulation/ws-mode.el b/lisp/emulation/ws-mode.el
index 886b4d6d4c4..0c7be145751 100644
--- a/lisp/emulation/ws-mode.el
+++ b/lisp/emulation/ws-mode.el
@@ -1,6 +1,6 @@
;;; ws-mode.el --- WordStar emulation mode for GNU Emacs
-;; Copyright (C) 1991, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 2001-2012 Free Software Foundation, Inc.
;; Author: Juergen Nickelsen <nickel@cs.tu-berlin.de>
;; Version: 0.7
@@ -716,7 +716,7 @@ This will only work for errors raised by WordStar mode functions."
(defun ws-query-replace (from to)
"In WordStar mode: Search string, remember string for repetition."
- (interactive "sReplace:
+ (interactive "sReplace: \n\
sWith: " )
(setq ws-search-string from)
(setq ws-search-direction t)
diff --git a/lisp/env.el b/lisp/env.el
index 5e915eb3126..5f7c61b719a 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -1,6 +1,6 @@
;;; env.el --- functions to manipulate environment variables
-;; Copyright (C) 1991, 1994, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994, 2000-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: processes, unix
@@ -34,8 +34,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
;; History list for environment variable names.
(defvar read-envvar-name-history nil)
@@ -59,31 +57,28 @@ If it is also not t, RET does not exit if it does non-null completion."
;; History list for VALUE argument to setenv.
(defvar setenv-history nil)
+(defconst env--substitute-vars-regexp
+ "\\$\\(?:\\(?1:[[:alnum:]_]+\\)\\|{\\(?1:[^{}]+\\)}\\|\\$\\)")
-(defun substitute-env-vars (string)
+(defun substitute-env-vars (string &optional only-defined)
"Substitute environment variables referred to in STRING.
`$FOO' where FOO is an environment variable name means to substitute
the value of that variable. The variable name should be terminated
with a character not a letter, digit or underscore; otherwise, enclose
the entire variable name in braces. For instance, in `ab$cd-x',
`$cd' is treated as an environment variable.
+If ONLY-DEFINED is nil, references to undefined environment variables
+are replaced by the empty string; if it is non-nil, they are left unchanged.
Use `$$' to insert a single dollar sign."
(let ((start 0))
- (while (string-match
- (eval-when-compile
- (rx (or (and "$" (submatch (1+ (regexp "[[:alnum:]_]"))))
- (and "${" (submatch (minimal-match (0+ anything))) "}")
- "$$")))
- string start)
+ (while (string-match env--substitute-vars-regexp string start)
(cond ((match-beginning 1)
(let ((value (getenv (match-string 1 string))))
+ (if (and (null value) only-defined)
+ (setq start (match-end 0))
(setq string (replace-match (or value "") t t string)
- start (+ (match-beginning 0) (length value)))))
- ((match-beginning 2)
- (let ((value (getenv (match-string 2 string))))
- (setq string (replace-match (or value "") t t string)
- start (+ (match-beginning 0) (length value)))))
+ start (+ (match-beginning 0) (length value))))))
(t
(setq string (replace-match "$" t t string)
start (+ (match-beginning 0) 1)))))
@@ -187,7 +182,7 @@ VARIABLE should be a string. Value is nil if VARIABLE is undefined in
the environment. Otherwise, value is a string.
If optional parameter FRAME is non-nil, then it should be a
-frame. This function will look up VARIABLE in its 'environment
+frame. This function will look up VARIABLE in its `environment'
parameter.
Otherwise, this function searches `process-environment' for
diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el
index d51045a5e37..a79b471f06b 100644
--- a/lisp/epa-dired.el
+++ b/lisp/epa-dired.el
@@ -1,5 +1,5 @@
;;; epa-dired.el --- the EasyPG Assistant, dired extension -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index 4d05563719d..eccdc073970 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -1,5 +1,5 @@
;;; epa-file.el --- the EasyPG Assistant, transparent file encryption -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el
index ea036e836e4..ea19d2a6699 100644
--- a/lisp/epa-hook.el
+++ b/lisp/epa-hook.el
@@ -1,5 +1,5 @@
;;; epa-hook.el --- preloaded code to enable epa-file.el -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index 9d7542b3980..a16fa5abdd4 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -1,5 +1,5 @@
;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG, mail, message
@@ -47,7 +47,10 @@
;;;###autoload
(define-minor-mode epa-mail-mode
- "A minor-mode for composing encrypted/clearsigned mails."
+ "A minor-mode for composing encrypted/clearsigned mails.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
nil " epa-mail" epa-mail-mode-map)
(defun epa-mail--find-usable-key (keys usage)
@@ -167,29 +170,33 @@ Don't use this command in Lisp programs!"
If no one is selected, symmetric encryption will be performed. "
recipients)
(if recipients
- (mapcar
- (lambda (recipient)
- (setq recipient-key
- (epa-mail--find-usable-key
- (epg-list-keys
- (epg-make-context epa-protocol)
- (if (string-match "@" recipient)
- (concat "<" recipient ">")
- recipient))
- 'encrypt))
- (unless (or recipient-key
- (y-or-n-p
- (format
- "No public key for %s; skip it? "
- recipient)))
- (error "No public key for %s" recipient))
- recipient-key)
- recipients)))
+ (apply
+ 'nconc
+ (mapcar
+ (lambda (recipient)
+ (setq recipient-key
+ (epa-mail--find-usable-key
+ (epg-list-keys
+ (epg-make-context epa-protocol)
+ (if (string-match "@" recipient)
+ (concat "<" recipient ">")
+ recipient))
+ 'encrypt))
+ (unless (or recipient-key
+ (y-or-n-p
+ (format
+ "No public key for %s; skip it? "
+ recipient)))
+ (error "No public key for %s" recipient))
+ (if recipient-key (list recipient-key)))
+ recipients))))
(setq sign (if verbose (y-or-n-p "Sign? ")))
(if sign
(epa-select-keys context
"Select keys for signing. "))))))
- (epa-encrypt-region start end recipients sign signers))
+ ;; Don't let some read-only text stop us from encrypting.
+ (let ((inhibit-read-only t))
+ (epa-encrypt-region start end recipients sign signers)))
;;;###autoload
(defun epa-mail-import-keys ()
@@ -202,7 +209,10 @@ Don't use this command in Lisp programs!"
;;;###autoload
(define-minor-mode epa-global-mail-mode
- "Minor mode to hook EasyPG into Mail mode."
+ "Minor mode to hook EasyPG into Mail mode.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
:global t :init-value nil :group 'epa-mail :version "23.1"
(remove-hook 'mail-mode-hook 'epa-mail-mode)
(if epa-global-mail-mode
diff --git a/lisp/epa.el b/lisp/epa.el
index 229138bd455..ecc27c4d299 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -1,6 +1,6 @@
;;; epa.el --- the EasyPG Assistant -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
@@ -50,97 +50,51 @@ the separate window."
:group 'epa)
(defface epa-validity-high
- `((((class color) (background dark))
- (:foreground "PaleTurquoise"
- ,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t))))
- (t
- (,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t)))))
- "Face used for displaying the high validity."
+ '((default :weight bold)
+ (((class color) (background dark)) :foreground "PaleTurquoise"))
+ "Face for high validity EPA information."
:group 'epa-faces)
(defface epa-validity-medium
- `((((class color) (background dark))
- (:foreground "PaleTurquoise"
- ,@(if (assq ':slant custom-face-attributes)
- '(:slant italic)
- '(:italic t))))
- (t
- (,@(if (assq ':slant custom-face-attributes)
- '(:slant italic)
- '(:italic t)))))
- "Face used for displaying the medium validity."
+ '((default :slant italic)
+ (((class color) (background dark)) :foreground "PaleTurquoise"))
+ "Face for medium validity EPA information."
:group 'epa-faces)
(defface epa-validity-low
- `((t
- (,@(if (assq ':slant custom-face-attributes)
- '(:slant italic)
- '(:italic t)))))
+ '((t :slant italic))
"Face used for displaying the low validity."
:group 'epa-faces)
(defface epa-validity-disabled
- `((t
- (,@(if (assq ':slant custom-face-attributes)
- '(:slant italic)
- '(:italic t))
- :inverse-video t)))
+ '((t :slant italic :inverse-video t))
"Face used for displaying the disabled validity."
:group 'epa-faces)
(defface epa-string
'((((class color) (background dark))
- (:foreground "lightyellow"))
+ :foreground "lightyellow")
(((class color) (background light))
- (:foreground "blue4")))
+ :foreground "blue4"))
"Face used for displaying the string."
:group 'epa-faces)
(defface epa-mark
- `((((class color) (background dark))
- (:foreground "orange"
- ,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t))))
- (((class color) (background light))
- (:foreground "red"
- ,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t))))
- (t
- (,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t)))))
+ '((default :weight bold)
+ (((class color) (background dark)) :foreground "orange")
+ (((class color) (background light)) :foreground "red"))
"Face used for displaying the high validity."
:group 'epa-faces)
(defface epa-field-name
- `((((class color) (background dark))
- (:foreground "PaleTurquoise"
- ,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t))))
- (t
- (,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t)))))
+ '((default :weight bold)
+ (((class color) (background dark)) :foreground "PaleTurquoise"))
"Face for the name of the attribute field."
:group 'epa)
(defface epa-field-body
- `((((class color) (background dark))
- (:foreground "turquoise"
- ,@(if (assq ':slant custom-face-attributes)
- '(:slant italic)
- '(:italic t))))
- (t
- (,@(if (assq ':slant custom-face-attributes)
- '(:slant italic)
- '(:italic t)))))
+ '((default :slant italic)
+ (((class color) (background dark)) :foreground "turquoise"))
"Face for the body of the attribute field."
:group 'epa)
@@ -177,18 +131,18 @@ the separate window."
(20 . ?G)))
(defvar epa-protocol 'OpenPGP
- "*The default protocol.
+ "The default protocol.
The value can be either OpenPGP or CMS.
You should bind this variable with `let', but do not set it globally.")
(defvar epa-armor nil
- "*If non-nil, epa commands create ASCII armored output.
+ "If non-nil, epa commands create ASCII armored output.
You should bind this variable with `let', but do not set it globally.")
(defvar epa-textmode nil
- "*If non-nil, epa commands treat input files as text.
+ "If non-nil, epa commands treat input files as text.
You should bind this variable with `let', but do not set it globally.")
@@ -482,6 +436,8 @@ If ARG is non-nil, mark the key."
(setq epa-keys-buffer (generate-new-buffer "*Keys*")))
(with-current-buffer epa-keys-buffer
(epa-key-list-mode)
+ ;; C-c C-c is the usual way to finish the selection (bug#11159).
+ (define-key (current-local-map) "\C-c\C-c" 'exit-recursive-edit)
(let ((inhibit-read-only t)
buffer-read-only)
(erase-buffer)
@@ -629,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)
@@ -1236,7 +1192,8 @@ between START and END."
"Insert selected KEYS after the point."
(interactive
(list (epa-select-keys (epg-make-context epa-protocol)
- "Select keys to export. ")))
+ "Select keys to export.
+If no one is selected, default public key is exported. ")))
(let ((context (epg-make-context epa-protocol)))
;;(epg-context-set-armor context epa-armor)
(epg-context-set-armor context t)
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index 38f7dbdaa73..aa052206bec 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -1,6 +1,6 @@
;;; epg-config.el --- configuration of the EasyPG Library
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
@@ -33,9 +33,11 @@
"Report bugs to this address.")
(defgroup epg ()
- "The EasyPG library."
+ "Interface to the GNU Privacy Guard (GnuPG)."
+ :tag "EasyPG"
:version "23.1"
- :group 'data)
+ :group 'data
+ :group 'external)
(defcustom epg-gpg-program (or (executable-find "gpg")
(executable-find "gpg2")
diff --git a/lisp/epg.el b/lisp/epg.el
index 133e76da96c..b0e01bc3721 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1,5 +1,5 @@
;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2000, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
@@ -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))
@@ -1951,7 +1949,8 @@ The returned file name (created by appending some random characters at the end
of PREFIX, and expanding against `temporary-file-directory' if necessary),
is guaranteed to point to a newly created empty file.
You can then use `write-region' to write new data into the file."
- (let (tempdir tempfile)
+ (let ((orig-modes (default-file-modes))
+ tempdir tempfile)
(setq prefix (expand-file-name prefix
(if (featurep 'xemacs)
(temp-directory)
@@ -1959,6 +1958,7 @@ You can then use `write-region' to write new data into the file."
(unwind-protect
(let (file)
;; First, create a temporary directory.
+ (set-default-file-modes #o700)
(while (condition-case ()
(progn
(setq tempdir (make-temp-name
@@ -1969,14 +1969,12 @@ You can then use `write-region' to write new data into the file."
(make-directory tempdir))
;; let's try again.
(file-already-exists t)))
- (set-file-modes tempdir 448)
;; Second, create a temporary file in the tempdir.
;; There *is* a race condition between `make-temp-name'
;; and `write-region', but we don't care it since we are
;; in a private directory now.
(setq tempfile (make-temp-name (concat tempdir "/EMU")))
(write-region "" nil tempfile nil 'silent)
- (set-file-modes tempfile 384)
;; Finally, make a hard-link from the tempfile.
(while (condition-case ()
(progn
@@ -1986,6 +1984,7 @@ You can then use `write-region' to write new data into the file."
;; let's try again.
(file-already-exists t)))
file)
+ (set-default-file-modes orig-modes)
;; Cleanup the tempfile.
(and tempfile
(file-exists-p tempfile)
@@ -2561,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
@@ -2571,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)
@@ -2585,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 1b67835cb07..3f9824545cf 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,3 +1,197 @@
+2012-11-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc-backend.el: Fix last change that missed calls to `second'
+ (bug#12970).
+
+2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Use cl-lib instead of cl, and interactive-p => called-interactively-p.
+ * erc-track.el, erc-networks.el, erc-netsplit.el, erc-dcc.el:
+ * erc-backend.el: Use cl-lib, nth, pcase, and called-interactively-p
+ instead of cl.
+ * erc-speedbar.el, erc-services.el, erc-pcomplete.el, erc-notify.el:
+ * erc-match.el, erc-log.el, erc-join.el, erc-ezbounce.el:
+ * erc-capab.el: Don't require cl since we don't use it.
+ * erc.el: Use cl-lib, nth, pcase, and called-interactively-p i.s.o cl.
+ (erc-lurker-ignore-chars, erc-common-server-suffixes):
+ Move before first use.
+
+2012-11-16 Glenn Morris <rgm@gnu.org>
+
+ * erc.el (erc-modules): Add "notifications". Tweak "hecomplete" doc.
+
+2012-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc-backend.el: Only require `erc' during compilation (bug#12740).
+
+2012-10-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc-backend.el: Require `erc' instead of autoloading its macros
+ (bug#12669).
+
+2012-10-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc.el (erc-log): Make it into a defsubst.
+ (erc-with-server-buffer, define-erc-module, erc-with-buffer)
+ (erc-with-all-buffers-of-server): Use `declare'.
+ * erc-backend.el (erc-log): Adjust autoload accordingly.
+
+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)
+
+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>
+
+ * erc-join.el (erc-autojoin-timing): Fix defcustom type.
+
+2012-08-21 Julien Danjou <julien@danjou.info>
+
+ * erc-match.el (erc-match-message):
+ Use `erc-match-exclude-server-buffer' not
+ `erc-track-exclude-server-buffer'.
+
+2012-08-20 Josh Feinstein <jlf@foxtail.org>
+
+ * erc.el (erc-display-message): Abstract message hiding decision
+ to new function erc-hide-current-message-p.
+ (erc-lurker): New customization group.
+ (erc-lurker-state, erc-lurker-trim-nicks, erc-lurker-ignore-chars)
+ (erc-lurker-hide-list, erc-lurker-cleanup-interval)
+ (erc-lurker-threshold-time): New variables.
+ (erc-lurker-maybe-trim, erc-lurker-initialize, erc-lurker-cleanup)
+ (erc-hide-current-message-p, erc-canonicalize-server-name)
+ (erc-lurker-update-status, erc-lurker-p): New functions.
+ Together they maintain state about which users have spoken in the last
+ erc-lurker-threshold-time, with all other users being considered
+ lurkers whose messages of types in erc-lurker-hide-list will not
+ be displayed by erc-display-message.
+
+2012-08-06 Julien Danjou <julien@danjou.info>
+
+ * erc-match.el (erc-match-exclude-server-buffer)
+ (erc-match-message): Add new option to exclude server buffer from
+ matching.
+
+2012-07-21 Julien Danjou <julien@danjou.info>
+
+ * erc-notifications.el: New file.
+
+2012-06-15 Julien Danjou <julien@danjou.info>
+
+ * erc.el (erc-open): Use `auth-source' for password retrieval when
+ possible.
+
+2012-06-12 Chong Yidong <cyd@gnu.org>
+
+ * erc-dcc.el (erc-dcc-chat-filter-functions): Rename from
+ erc-dcc-chat-filter-hook, since this is an abnormal hook.
+
+2012-06-08 Chong Yidong <cyd@gnu.org>
+
+ * erc.el (erc-direct-msg-face, erc-header-line, erc-input-face)
+ (erc-command-indicator-face, erc-notice-face, erc-action-face)
+ (erc-error-face, erc-my-nick-face, erc-nick-default-face)
+ (erc-nick-msg-face): Use new-style face specs, and avoid :bold.
+
+ * erc-button.el (erc-button):
+ * erc-goodies.el (erc-bold-face, erc-inverse-face)
+ (erc-underline-face, fg:erc-color-*):
+ * erc-match.el (erc-current-nick-face, erc-dangerous-host-face)
+ (erc-pal-face, erc-fool-face, erc-keyword-face):
+ * erc-stamp.el (erc-timestamp-face): Likewise.
+
+2012-06-02 Chong Yidong <cyd@gnu.org>
+
+ * erc-track.el (erc-track, erc-track-faces-priority-list)
+ (erc-track-faces-normal-list, erc-track-find-face)
+ (erc-track-modified-channels): Fix modeline -> mode line in docs.
+
+2012-05-14 Mike Kazantsev <mk.fraggod@gmail.com> (tiny change)
+
+ * erc-dcc.el (erc-dcc-handle-ctcp-send): Fix a regression
+ introduced on 2011-11-28 when fixing quoted filenames matching,
+ the regex group was not corrected.
+
+2012-05-13 Teemu Likonen <tlikonen@iki.fi>
+
+ * erc-backend.el (erc-server-timestamp-format): New variable to
+ allow specifying the timestamp format (bug#10779).
+
+2012-04-11 Vivek Dasmohapatra <vivek@etla.org>
+
+ * erc-services.el (erc-nickserv-passwords): Don't display the
+ password (bug#4459).
+
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * erc-join.el (erc-server-join-channel): New function to look up
+ the channel password via auth-source.
+ (erc-autojoin-channels): Use it.
+ (erc-autojoin-after-ident): Ditto.
+ (erc-autojoin-channels-alist): Mention auth-source.
+
+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
+ all text back to the prompt given that it's on a single line
+ (bug#10841).
+
+2012-04-09 Chong Yidong <cyd@gnu.org>
+
+ * erc.el (erc-cmd-SET): Call custom-variable-p instead of
+ user-variable-p.
+
+2012-02-08 Glenn Morris <rgm@gnu.org>
+
+ * erc-backend.el (erc-coding-system-precedence):
+ * erc-join.el (erc-autojoin-delay, erc-autojoin-timing):
+ Add missing :version settings.
+
+2012-01-06 Glenn Morris <rgm@gnu.org>
+
+ * erc.el (erc-tls): Add autoload cookie. (Bug#10333)
+
+2011-12-31 Antoine Levitt <antoine.levitt@gmail.com>
+
+ * erc-goodies.el (erc-scroll-to-bottom): Use post-command-hook
+ rather than window-scroll-functions. Fixes a bug with word-wrap on
+ a tty. (Bug#9246)
+
2011-11-28 Mike Kazantsev <mk.fraggod@gmail.com> (tiny change)
* erc-dcc.el (erc-dcc-ctcp-query-send-regexp): Updated regexp to
@@ -36,7 +230,7 @@
* erc.el (erc-ssl): Made into a synonym for erc-tls, which
provides a superset of the same functionality.
- (erc-open-ssl-stream): Removed.
+ (erc-open-ssl-stream): Remove.
(erc-open-tls-stream): Use `open-network-stream' instead of
`open-tls-stream' directly to be able to use the built-in TLS
support.
@@ -75,6 +269,10 @@
erc-button-next.
(button, erc-button-next): Use it.
+2011-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc-hecomplete.el: Move to ../obsolete.
+
2011-03-07 Chong Yidong <cyd@stupidchicken.com>
* Version 23.3 released.
@@ -236,7 +434,7 @@
See ChangeLog.08 for earlier changes.
- Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2009-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/erc/ChangeLog.01 b/lisp/erc/ChangeLog.01
index 2b29acf5a25..da7d0ae52d0 100644
--- a/lisp/erc/ChangeLog.01
+++ b/lisp/erc/ChangeLog.01
@@ -1034,7 +1034,7 @@
* erc-speak.el, erc.el: New file.
- Copyright (C) 2001, 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001, 2006-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/erc/ChangeLog.02 b/lisp/erc/ChangeLog.02
index d20b6ca35a7..de76c113320 100644
--- a/lisp/erc/ChangeLog.02
+++ b/lisp/erc/ChangeLog.02
@@ -51,7 +51,7 @@
2002-12-29 Damien Elmes <erc@repose.cx>
* erc-track.el:
- * (erc-track-get-active-buffer): remove superflous (+ arg 0)
+ * (erc-track-get-active-buffer): remove superfluous (+ arg 0)
2002-12-29 Alex Schroeder <alex@gnu.org>
@@ -2596,7 +2596,7 @@
See ChangeLog.01 for earlier changes.
- Copyright (C) 2002, 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2006-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/erc/ChangeLog.03 b/lisp/erc/ChangeLog.03
index 3e687202d38..f9b4506b784 100644
--- a/lisp/erc/ChangeLog.03
+++ b/lisp/erc/ChangeLog.03
@@ -200,7 +200,7 @@
* erc-autoaway.el(erc-mode):
Reset idletime on connect. Fixes an annoying bug which
- flooded the server with aways on reconnect.
+ flooded the server with always on reconnect.
(erc-autoway-reset-idletime): Accept optional args so we can hook it
onto erc-server-001-hook.
@@ -2141,7 +2141,7 @@
See ChangeLog.02 for earlier changes.
- Copyright (C) 2003, 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2006-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/erc/ChangeLog.04 b/lisp/erc/ChangeLog.04
index ff47372b8e3..922fb0c90dd 100644
--- a/lisp/erc/ChangeLog.04
+++ b/lisp/erc/ChangeLog.04
@@ -1926,7 +1926,7 @@
* erc.el: erc-send-whitespace-lines: New variable.
(erc-send-current-line): Use erc-send-whitespace-lines. Also,
- removed superflous test for empty line in the mapc, since the
+ removed superfluous test for empty line in the mapc, since the
blank line test should find all. I do like to be able to send an
empty line when i want to!
(erc-send-current-line): Check for point being in input line
@@ -2072,7 +2072,7 @@
See ChangeLog.03 for earlier changes.
- Copyright (C) 2004, 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 2004, 2006-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -2092,4 +2092,3 @@ See ChangeLog.03 for earlier changes.
;; Local Variables:
;; coding: utf-8
;; End:
-
diff --git a/lisp/erc/ChangeLog.05 b/lisp/erc/ChangeLog.05
index fd5fde00a4a..584d9829ee7 100644
--- a/lisp/erc/ChangeLog.05
+++ b/lisp/erc/ChangeLog.05
@@ -1217,7 +1217,7 @@
See ChangeLog.04 for earlier changes.
- Copyright (C) 2005-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/erc/ChangeLog.06 b/lisp/erc/ChangeLog.06
index e3026c96a4d..5dd77d5dfd8 100644
--- a/lisp/erc/ChangeLog.06
+++ b/lisp/erc/ChangeLog.06
@@ -18,7 +18,7 @@
(erc-nickserv-identify-on-connect)
(erc-nickserv-identify-on-nick-change): Handle 'both method.
-2006-12-28 Leo <sdl.web@gmail.com> (tiny change)
+2006-12-28 Leo Liu <sdl.web@gmail.com> (tiny change)
* erc.el (erc-iswitchb): Wrap body in unwind-protect so that
hitting C-g does not leave iswitchb-mode on.
@@ -51,7 +51,7 @@
* erc.el (erc-open): Restore old point correctly, or at least get
closer to doing so than before.
-2006-12-13 Leo <sdl.web@gmail.com> (tiny change)
+2006-12-13 Leo Liu <sdl.web@gmail.com> (tiny change)
* erc.el (erc-iswitchb): Temporarily enable iswitchb mode if it
isn't active already, instead of leaving it on.
@@ -1430,7 +1430,7 @@
See ChangeLog.05 for earlier changes.
- Copyright (C) 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 2006-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/erc/ChangeLog.07 b/lisp/erc/ChangeLog.07
index b32155bbce4..09886ad4a72 100644
--- a/lisp/erc/ChangeLog.07
+++ b/lisp/erc/ChangeLog.07
@@ -812,7 +812,7 @@
See ChangeLog.06 for earlier changes.
- Copyright (C) 2007-2011 Free Software Foundation, Inc.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/erc/ChangeLog.08 b/lisp/erc/ChangeLog.08
index feff487fa6e..d0a30163aa3 100644
--- a/lisp/erc/ChangeLog.08
+++ b/lisp/erc/ChangeLog.08
@@ -405,7 +405,7 @@
See ChangeLog.07 for earlier changes.
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el
index 74172b2573f..fd9ac69aa3a 100644
--- a/lisp/erc/erc-autoaway.el
+++ b/lisp/erc/erc-autoaway.el
@@ -1,8 +1,9 @@
;;; erc-autoaway.el --- Provides autoaway for ERC
-;; Copyright (C) 2002-2004, 2006-2011 Free Software Foundation, Inc.
+;; 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.
@@ -138,7 +139,7 @@ Related variables: `erc-public-away-p' and `erc-away-nickname'."
(remove-hook 'erc-server-305-functions 'erc-autoaway-reset-indicators))))
(defcustom erc-autoaway-idle-method 'user
- "*The method used to determine how long you have been idle.
+ "The method used to determine how long you have been idle.
If 'user, the time of the last command sent to Emacs is used.
If 'emacs, the idle time in Emacs is used.
If 'irc, the time of the last IRC command is used.
@@ -160,7 +161,7 @@ definitions of being idle."
(set sym val))))
(defcustom erc-auto-set-away t
- "*If non-nil, set away after `erc-autoaway-idle-seconds' seconds of idling.
+ "If non-nil, set away after `erc-autoaway-idle-seconds' seconds of idling.
ERC autoaway mode can set you away when you idle, and set you no
longer away when you type something. This variable controls whether
you will be set away when you idle. See `erc-auto-discard-away' for
@@ -169,7 +170,7 @@ the other half."
:type 'boolean)
(defcustom erc-auto-discard-away t
- "*If non-nil, sending anything when away automatically discards away state.
+ "If non-nil, sending anything when away automatically discards away state.
ERC autoaway mode can set you away when you idle, and set you no
longer away when you type something. This variable controls whether
you will be set no longer away when you type something. See
@@ -179,13 +180,13 @@ See also `erc-autoaway-no-auto-discard-regexp'."
:type 'boolean)
(defcustom erc-autoaway-no-auto-discard-regexp "^/g?away.*$"
- "*Input that matches this will not automatically discard away status.
+ "Input that matches this will not automatically discard away status.
See `erc-auto-discard-away'."
:group 'erc-autoaway
:type 'regexp)
(defcustom erc-autoaway-idle-seconds 1800
- "*Number of seconds after which ERC will set you automatically away.
+ "Number of seconds after which ERC will set you automatically away.
If you are changing this variable using lisp instead of customizing it,
you have to run `erc-autoaway-reestablish-idletimer' afterwards."
:group 'erc-autoaway
@@ -197,7 +198,7 @@ you have to run `erc-autoaway-reestablish-idletimer' afterwards."
(defcustom erc-autoaway-message
"I'm gone (autoaway after %i seconds of idletime)"
- "*Message ERC will use when setting you automatically away.
+ "Message ERC will use when setting you automatically away.
It is used as a `format' string with the argument of the idletime
in seconds."
:group 'erc-autoaway
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 112091af219..9b28916623b 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1,9 +1,10 @@
;;; erc-backend.el --- Backend network communication for ERC
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Filename: erc-backend.el
;; Author: Lawrence Mitchell <wence@gmx.li>
+;; Maintainer: FSF
;; Created: 2004-05-7
;; Keywords: IRC chat client internet
@@ -97,16 +98,18 @@
;;; Code:
(require 'erc-compat)
-(eval-when-compile (require 'cl))
-(autoload 'erc-with-buffer "erc" nil nil 'macro)
-(autoload 'erc-log "erc" nil nil 'macro)
+(eval-when-compile (require 'cl-lib))
+;; There's a fairly strong mutual dependency between erc.el and erc-backend.el.
+;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the
+;; reverse is true:
+(eval-when-compile (provide 'erc-backend) (require 'erc))
;;;; Variables and options
(defvar erc-server-responses (make-hash-table :test #'equal)
"Hashtable mapping server responses to their handler hooks.")
-(defstruct (erc-response (:conc-name erc-response.))
+(cl-defstruct (erc-response (:conc-name erc-response.))
(unparsed "" :type string)
(sender "" :type string)
(command "" :type string)
@@ -311,7 +314,7 @@ If a key is pressed while ERC is waiting, it will stop waiting."
:type 'number)
(defcustom erc-split-line-length 440
- "*The maximum length of a single message.
+ "The maximum length of a single message.
If a message exceeds this size, it is broken into multiple ones.
IRC allows for lines up to 512 bytes. Two of them are CR LF.
@@ -329,6 +332,7 @@ Good luck."
This will only be consulted if the coding system in
`erc-server-coding-system' is `undecided'."
:group 'erc-server
+ :version "24.1"
:type '(repeat coding-system))
(defcustom erc-server-coding-system (if (and (fboundp 'coding-system-p)
@@ -378,27 +382,34 @@ It should take same arguments as `open-network-stream' does."
:type 'function)
(defcustom erc-server-prevent-duplicates '("301")
- "*Either nil or a list of strings.
+ "Either nil or a list of strings.
Each string is a IRC message type, like PRIVMSG or NOTICE.
All Message types in that list of subjected to duplicate prevention."
:type '(choice (const nil) (list string))
:group 'erc-server)
(defcustom erc-server-duplicate-timeout 60
- "*The time allowed in seconds between duplicate messages.
+ "The time allowed in seconds between duplicate messages.
If two identical messages arrive within this value of one another, the second
isn't displayed."
:type 'integer
:group 'erc-server)
+(defcustom erc-server-timestamp-format "%Y-%m-%d %T"
+ "Timestamp format used with server response messages.
+This string is processed using `format-time-string'."
+ :version "24.3"
+ :type 'string
+ :group 'erc-server)
+
;;; Flood-related
;; Most of this is courtesy of Jorgen Schaefer and Circe
;; (http://www.nongnu.org/circe)
(defcustom erc-server-flood-margin 10
- "*A margin on how much excess data we send.
+ "A margin on how much excess data we send.
The flood protection algorithm of ERC works like the one
detailed in RFC 2813, section 5.8 \"Flood control of clients\".
@@ -422,14 +433,14 @@ protection algorithm."
;; Ping handling
(defcustom erc-server-send-ping-interval 30
- "*Interval of sending pings to the server, in seconds.
+ "Interval of sending pings to the server, in seconds.
If this is set to nil, pinging the server is disabled."
:group 'erc-server
:type '(choice (const :tag "Disabled" nil)
(integer :tag "Seconds")))
(defcustom erc-server-send-ping-timeout 120
- "*If the time between ping and response is greater than this, reconnect.
+ "If the time between ping and response is greater than this, reconnect.
The time is in seconds.
This must be greater than or equal to the value for
@@ -939,7 +950,7 @@ PROCs `process-buffer' is `current-buffer' when this function is called."
(push str (erc-response.command-args msg))))
(setf (erc-response.contents msg)
- (first (erc-response.command-args msg)))
+ (car (erc-response.command-args msg)))
(setf (erc-response.command-args msg)
(nreverse (erc-response.command-args msg)))
@@ -1034,7 +1045,7 @@ Finds hooks by looking in the `erc-server-responses' hashtable."
(name &rest name)
&optional sexp sexp def-body))
-(defmacro* define-erc-response-handler ((name &rest aliases)
+(cl-defmacro define-erc-response-handler ((name &rest aliases)
&optional extra-fn-doc extra-var-doc
&rest fn-body)
"Define an ERC handler hook/function pair.
@@ -1143,11 +1154,11 @@ add things to `%s' instead."
"")
name hook-name))
(fn-alternates
- (loop for alias in aliases
- collect (intern (format "erc-server-%s" alias))))
+ (cl-loop for alias in aliases
+ collect (intern (format "erc-server-%s" alias))))
(var-alternates
- (loop for alias in aliases
- collect (intern (format "erc-server-%s-functions" alias)))))
+ (cl-loop for alias in aliases
+ collect (intern (format "erc-server-%s-functions" alias)))))
`(prog2
;; Normal hook variable.
(defvar ,hook-name ',fn-name ,(format hook-doc name))
@@ -1161,19 +1172,19 @@ add things to `%s' instead."
(put ',hook-name 'definition-name ',name)
;; Hashtable map of responses to hook variables
- ,@(loop for response in (cons name aliases)
- for var in (cons hook-name var-alternates)
- collect `(puthash ,(format "%s" response) ',var
- erc-server-responses))
+ ,@(cl-loop for response in (cons name aliases)
+ for var in (cons hook-name var-alternates)
+ collect `(puthash ,(format "%s" response) ',var
+ erc-server-responses))
;; Alternates.
;; Functions are defaliased, hook variables are defvared so we
;; can add hooks to one alias, but not another.
- ,@(loop for fn in fn-alternates
- for var in var-alternates
- for a in aliases
- nconc (list `(defalias ',fn ',fn-name)
- `(defvar ,var ',fn-name ,(format hook-doc a))
- `(put ',var 'definition-name ',hook-name))))))
+ ,@(cl-loop for fn in fn-alternates
+ for var in var-alternates
+ for a in aliases
+ nconc (list `(defalias ',fn ',fn-name)
+ `(defvar ,var ',fn-name ,(format hook-doc a))
+ `(put ',var 'definition-name ',hook-name))))))
(define-erc-response-handler (ERROR)
"Handle an ERROR command from the server." nil
@@ -1185,10 +1196,10 @@ add things to `%s' instead."
(define-erc-response-handler (INVITE)
"Handle invitation messages."
nil
- (let ((target (first (erc-response.command-args parsed)))
+ (let ((target (car (erc-response.command-args parsed)))
(chnl (erc-response.contents parsed)))
- (multiple-value-bind (nick login host)
- (values-list (erc-parse-user (erc-response.sender parsed)))
+ (pcase-let ((`(,nick ,login ,host)
+ (erc-parse-user (erc-response.sender parsed))))
(setq erc-invitation chnl)
(when (string= target (erc-current-nick))
(erc-display-message
@@ -1201,8 +1212,8 @@ add things to `%s' instead."
nil
(let ((chnl (erc-response.contents parsed))
(buffer nil))
- (multiple-value-bind (nick login host)
- (values-list (erc-parse-user (erc-response.sender parsed)))
+ (pcase-let ((`(,nick ,login ,host)
+ (erc-parse-user (erc-response.sender parsed))))
;; strip the stupid combined JOIN facility (IRC 2.9)
(if (string-match "^\\(.*\\)?\^g.*$" chnl)
(setq chnl (match-string 1 chnl)))
@@ -1238,12 +1249,12 @@ add things to `%s' instead."
(define-erc-response-handler (KICK)
"Handle kick messages received from the server." nil
- (let* ((ch (first (erc-response.command-args parsed)))
- (tgt (second (erc-response.command-args parsed)))
+ (let* ((ch (nth 0 (erc-response.command-args parsed)))
+ (tgt (nth 1 (erc-response.command-args parsed)))
(reason (erc-trim-string (erc-response.contents parsed)))
(buffer (erc-get-buffer ch proc)))
- (multiple-value-bind (nick login host)
- (values-list (erc-parse-user (erc-response.sender parsed)))
+ (pcase-let ((`(,nick ,login ,host)
+ (erc-parse-user (erc-response.sender parsed))))
(erc-remove-channel-member buffer tgt)
(cond
((string= tgt (erc-current-nick))
@@ -1266,11 +1277,11 @@ add things to `%s' instead."
(define-erc-response-handler (MODE)
"Handle server mode changes." nil
- (let ((tgt (first (erc-response.command-args parsed)))
+ (let ((tgt (car (erc-response.command-args parsed)))
(mode (mapconcat 'identity (cdr (erc-response.command-args parsed))
" ")))
- (multiple-value-bind (nick login host)
- (values-list (erc-parse-user (erc-response.sender parsed)))
+ (pcase-let ((`(,nick ,login ,host)
+ (erc-parse-user (erc-response.sender parsed))))
(erc-log (format "MODE: %s -> %s: %s" nick tgt mode))
;; dirty hack
(let ((buf (cond ((erc-channel-p tgt)
@@ -1294,8 +1305,8 @@ add things to `%s' instead."
"Handle nick change messages." nil
(let ((nn (erc-response.contents parsed))
bufs)
- (multiple-value-bind (nick login host)
- (values-list (erc-parse-user (erc-response.sender parsed)))
+ (pcase-let ((`(,nick ,login ,host)
+ (erc-parse-user (erc-response.sender parsed))))
(setq bufs (erc-buffer-list-with-nick nick proc))
(erc-log (format "NICK: %s -> %s" nick nn))
;; if we had a query with this user, make sure future messages will be
@@ -1307,7 +1318,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)
@@ -1329,11 +1340,11 @@ add things to `%s' instead."
(define-erc-response-handler (PART)
"Handle part messages." nil
- (let* ((chnl (first (erc-response.command-args parsed)))
+ (let* ((chnl (car (erc-response.command-args parsed)))
(reason (erc-trim-string (erc-response.contents parsed)))
(buffer (erc-get-buffer chnl proc)))
- (multiple-value-bind (nick login host)
- (values-list (erc-parse-user (erc-response.sender parsed)))
+ (pcase-let ((`(,nick ,login ,host)
+ (erc-parse-user (erc-response.sender parsed))))
(erc-remove-channel-member buffer nick)
(erc-display-message parsed 'notice buffer
'PART ?n nick ?u login
@@ -1350,7 +1361,7 @@ add things to `%s' instead."
(define-erc-response-handler (PING)
"Handle ping messages." nil
- (let ((pinger (first (erc-response.command-args parsed))))
+ (let ((pinger (car (erc-response.command-args parsed))))
(erc-log (format "PING: %s" pinger))
;; ping response to the server MUST be forced, or you can lose big
(erc-server-send (format "PONG :%s" pinger) t)
@@ -1368,7 +1379,7 @@ add things to `%s' instead."
(when erc-verbose-server-ping
(erc-display-message
parsed 'notice proc 'PONG
- ?h (first (erc-response.command-args parsed)) ?i erc-server-lag
+ ?h (car (erc-response.command-args parsed)) ?i erc-server-lag
?s (if (/= erc-server-lag 1) "s" "")))
(erc-update-mode-line))))
@@ -1440,8 +1451,8 @@ add things to `%s' instead."
"Another user has quit IRC." nil
(let ((reason (erc-response.contents parsed))
bufs)
- (multiple-value-bind (nick login host)
- (values-list (erc-parse-user (erc-response.sender parsed)))
+ (pcase-let ((`(,nick ,login ,host)
+ (erc-parse-user (erc-response.sender parsed))))
(setq bufs (erc-buffer-list-with-nick nick proc))
(erc-remove-user nick)
(setq reason (erc-wash-quit-reason reason nick login host))
@@ -1451,11 +1462,12 @@ add things to `%s' instead."
(define-erc-response-handler (TOPIC)
"The channel topic has changed." nil
- (let* ((ch (first (erc-response.command-args parsed)))
+ (let* ((ch (car (erc-response.command-args parsed)))
(topic (erc-trim-string (erc-response.contents parsed)))
- (time (format-time-string "%T %m/%d/%y" (current-time))))
- (multiple-value-bind (nick login host)
- (values-list (erc-parse-user (erc-response.sender parsed)))
+ (time (format-time-string erc-server-timestamp-format
+ (current-time))))
+ (pcase-let ((`(,nick ,login ,host)
+ (erc-parse-user (erc-response.sender parsed))))
(erc-update-channel-member ch nick nick nil nil nil host login)
(erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time))
(erc-display-message parsed 'notice (erc-get-buffer ch proc)
@@ -1465,8 +1477,8 @@ add things to `%s' instead."
(define-erc-response-handler (WALLOPS)
"Display a WALLOPS message." nil
(let ((message (erc-response.contents parsed)))
- (multiple-value-bind (nick login host)
- (values-list (erc-parse-user (erc-response.sender parsed)))
+ (pcase-let ((`(,nick ,login ,host)
+ (erc-parse-user (erc-response.sender parsed))))
(erc-display-message
parsed 'notice nil
'WALLOPS ?n nick ?m message))))
@@ -1474,7 +1486,7 @@ add things to `%s' instead."
(define-erc-response-handler (001)
"Set `erc-server-current-nick' to reflect server settings and display the welcome message."
nil
- (erc-set-current-nick (first (erc-response.command-args parsed)))
+ (erc-set-current-nick (car (erc-response.command-args parsed)))
(erc-update-mode-line) ; needed here?
(setq erc-nick-change-attempt-count 0)
(setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
@@ -1495,16 +1507,16 @@ add things to `%s' instead."
(define-erc-response-handler (004)
"Display the server's identification." nil
- (multiple-value-bind (server-name server-version)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,server-name ,server-version)
+ (cdr (erc-response.command-args parsed))))
(setq erc-server-version server-version)
(setq erc-server-announced-name server-name)
(erc-update-mode-line-buffer (process-buffer proc))
(erc-display-message
parsed 'notice proc
's004 ?s server-name ?v server-version
- ?U (fourth (erc-response.command-args parsed))
- ?C (fifth (erc-response.command-args parsed)))))
+ ?U (nth 3 (erc-response.command-args parsed))
+ ?C (nth 4 (erc-response.command-args parsed)))))
(define-erc-response-handler (005)
"Set the variable `erc-server-parameters' and display the received message.
@@ -1535,7 +1547,7 @@ A server may send more than one 005 message."
(define-erc-response-handler (221)
"Display the current user modes." nil
- (let* ((nick (first (erc-response.command-args parsed)))
+ (let* ((nick (car (erc-response.command-args parsed)))
(modes (mapconcat 'identity
(cdr (erc-response.command-args parsed)) " ")))
(erc-set-modes nick modes)
@@ -1544,17 +1556,17 @@ A server may send more than one 005 message."
(define-erc-response-handler (252)
"Display the number of IRC operators online." nil
(erc-display-message parsed 'notice 'active 's252
- ?i (second (erc-response.command-args parsed))))
+ ?i (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (253)
"Display the number of unknown connections." nil
(erc-display-message parsed 'notice 'active 's253
- ?i (second (erc-response.command-args parsed))))
+ ?i (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (254)
"Display the number of channels formed." nil
(erc-display-message parsed 'notice 'active 's254
- ?i (second (erc-response.command-args parsed))))
+ ?i (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (250 251 255 256 257 258 259 265 266 377 378)
"Generic display of server messages as notices.
@@ -1564,8 +1576,8 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (275)
"Display secure connection message." nil
- (multiple-value-bind (nick user message)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,nick ,user ,message)
+ (cdr (erc-response.command-args parsed))))
(erc-display-message
parsed 'notice 'active 's275
?n nick
@@ -1578,13 +1590,13 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (301)
"AWAY notice." nil
(erc-display-message parsed 'notice 'active 's301
- ?n (second (erc-response.command-args parsed))
+ ?n (cadr (erc-response.command-args parsed))
?r (erc-response.contents parsed)))
(define-erc-response-handler (303)
"ISON reply" nil
(erc-display-message parsed 'notice 'active 's303
- ?n (second (erc-response.command-args parsed))))
+ ?n (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (305)
"Return from AWAYness." nil
@@ -1600,8 +1612,8 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (307)
"Display nick-identified message." nil
- (multiple-value-bind (nick user message)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,nick ,user ,message)
+ (cdr (erc-response.command-args parsed))))
(erc-display-message
parsed 'notice 'active 's307
?n nick
@@ -1612,8 +1624,8 @@ See `erc-display-server-message'." nil
"WHOIS/WHOWAS notices." nil
(let ((fname (erc-response.contents parsed))
(catalog-entry (intern (format "s%s" (erc-response.command parsed)))))
- (multiple-value-bind (nick user host)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,nick ,user ,host)
+ (cdr (erc-response.command-args parsed))))
(erc-update-user-nick nick nick host nil fname user)
(erc-display-message
parsed 'notice 'active catalog-entry
@@ -1621,8 +1633,8 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (312)
"Server name response in WHOIS." nil
- (multiple-value-bind (nick server-host)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,nick ,server-host))
+ (cdr (erc-response.command-args parsed)))
(erc-display-message
parsed 'notice 'active 's312
?n nick ?s server-host ?c (erc-response.contents parsed))))
@@ -1631,7 +1643,7 @@ See `erc-display-server-message'." nil
"IRC Operator response in WHOIS." nil
(erc-display-message
parsed 'notice 'active 's313
- ?n (second (erc-response.command-args parsed))))
+ ?n (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (315 318 323 369)
;; 315 - End of WHO
@@ -1643,10 +1655,10 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (317)
"IDLE notice." nil
- (multiple-value-bind (nick seconds-idle on-since time)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,nick ,seconds-idle ,on-since ,time)
+ (cdr (erc-response.command-args parsed))))
(setq time (when on-since
- (format-time-string "%T %Y/%m/%d"
+ (format-time-string erc-server-timestamp-format
(erc-string-to-emacs-time on-since))))
(erc-update-user-nick nick nick nil nil nil
(and time (format "on since %s" time)))
@@ -1662,14 +1674,14 @@ See `erc-display-server-message'." nil
"Channel names in WHOIS response." nil
(erc-display-message
parsed 'notice 'active 's319
- ?n (second (erc-response.command-args parsed))
+ ?n (cadr (erc-response.command-args parsed))
?c (erc-response.contents parsed)))
(define-erc-response-handler (320)
"Identified user in WHOIS." nil
(erc-display-message
parsed 'notice 'active 's320
- ?n (second (erc-response.command-args parsed))))
+ ?n (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (321)
"LIST header." nil
@@ -1684,16 +1696,16 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (322)
"LIST notice." nil
(let ((topic (erc-response.contents parsed)))
- (multiple-value-bind (channel num-users)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,channel ,num-users)
+ (cdr (erc-response.command-args parsed))))
(add-to-list 'erc-channel-list (list channel))
(erc-update-channel-topic channel topic))))
(defun erc-server-322-message (proc parsed)
"Display a message for the 322 event."
(let ((topic (erc-response.contents parsed)))
- (multiple-value-bind (channel num-users)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,channel ,num-users)
+ (cdr (erc-response.command-args parsed))))
(erc-display-message
parsed 'notice proc 's322
?c channel ?u num-users ?t (or topic "")))))
@@ -1701,7 +1713,7 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (324)
"Channel or nick modes." nil
- (let ((channel (second (erc-response.command-args parsed)))
+ (let ((channel (cadr (erc-response.command-args parsed)))
(modes (mapconcat 'identity (cddr (erc-response.command-args parsed))
" ")))
(erc-set-modes channel modes)
@@ -1711,19 +1723,20 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (328)
"Channel URL (on freenode network)." nil
- (let ((channel (second (erc-response.command-args parsed)))
+ (let ((channel (cadr (erc-response.command-args parsed)))
(url (erc-response.contents parsed)))
(erc-display-message parsed 'notice (erc-get-buffer channel proc)
's328 ?c channel ?u url)))
(define-erc-response-handler (329)
"Channel creation date." nil
- (let ((channel (second (erc-response.command-args parsed)))
+ (let ((channel (cadr (erc-response.command-args parsed)))
(time (erc-string-to-emacs-time
- (third (erc-response.command-args parsed)))))
+ (nth 2 (erc-response.command-args parsed)))))
(erc-display-message
parsed 'notice (erc-get-buffer channel proc)
- 's329 ?c channel ?t (format-time-string "%A %Y/%m/%d %X" time))))
+ 's329 ?c channel ?t (format-time-string erc-server-timestamp-format
+ time))))
(define-erc-response-handler (330)
"Nick is authed as (on Quakenet network)." nil
@@ -1735,22 +1748,22 @@ See `erc-display-server-message'." nil
;; authaccount == (aref parsed 4)
;; authmsg == (aref parsed 5)
;; The guesses below are, well, just that. -- Lawrence 2004/05/10
- (let ((nick (second (erc-response.command-args parsed)))
- (authaccount (third (erc-response.command-args parsed)))
+ (let ((nick (cadr (erc-response.command-args parsed)))
+ (authaccount (nth 2 (erc-response.command-args parsed)))
(authmsg (erc-response.contents parsed)))
(erc-display-message parsed 'notice 'active 's330
?n nick ?a authmsg ?i authaccount)))
(define-erc-response-handler (331)
"No topic set for channel." nil
- (let ((channel (second (erc-response.command-args parsed)))
+ (let ((channel (cadr (erc-response.command-args parsed)))
(topic (erc-response.contents parsed)))
(erc-display-message parsed 'notice (erc-get-buffer channel proc)
's331 ?c channel)))
(define-erc-response-handler (332)
"TOPIC notice." nil
- (let ((channel (second (erc-response.command-args parsed)))
+ (let ((channel (cadr (erc-response.command-args parsed)))
(topic (erc-response.contents parsed)))
(erc-update-channel-topic channel topic)
(erc-display-message parsed 'notice (erc-get-buffer channel proc)
@@ -1758,9 +1771,9 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (333)
"Who set the topic, and when." nil
- (multiple-value-bind (channel nick time)
- (values-list (cdr (erc-response.command-args parsed)))
- (setq time (format-time-string "%T %Y/%m/%d"
+ (pcase-let ((`(,channel ,nick ,time)
+ (cdr (erc-response.command-args parsed))))
+ (setq time (format-time-string erc-server-timestamp-format
(erc-string-to-emacs-time time)))
(erc-update-channel-topic channel
(format "\C-o (%s, %s)" nick time)
@@ -1771,15 +1784,15 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (341)
"Let user know when an INVITE attempt has been sent successfully."
nil
- (multiple-value-bind (nick channel)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,nick ,channel)
+ (cdr (erc-response.command-args parsed))))
(erc-display-message parsed 'notice (erc-get-buffer channel proc)
's341 ?n nick ?c channel)))
(define-erc-response-handler (352)
"WHO notice." nil
- (multiple-value-bind (channel user host server nick away-flag)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,channel ,user ,host ,server ,nick ,away-flag)
+ (cdr (erc-response.command-args parsed))))
(let ((full-name (erc-response.contents parsed))
hopcount)
(when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name)
@@ -1793,7 +1806,7 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (353)
"NAMES notice." nil
- (let ((channel (third (erc-response.command-args parsed)))
+ (let ((channel (nth 2 (erc-response.command-args parsed)))
(users (erc-response.contents parsed)))
(erc-display-message parsed 'notice (or (erc-get-buffer channel proc)
'active)
@@ -1803,13 +1816,13 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (366)
"End of NAMES." nil
- (erc-with-buffer ((second (erc-response.command-args parsed)) proc)
+ (erc-with-buffer ((cadr (erc-response.command-args parsed)) proc)
(erc-channel-end-receiving-names)))
(define-erc-response-handler (367)
"Channel ban list entries." nil
- (multiple-value-bind (channel banmask setter time)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,channel ,banmask ,setter ,time)
+ (cdr (erc-response.command-args parsed))))
;; setter and time are not standard
(if setter
(erc-display-message parsed 'notice 'active 's367-set-by
@@ -1823,7 +1836,7 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (368)
"End of channel ban list." nil
- (let ((channel (second (erc-response.command-args parsed))))
+ (let ((channel (cadr (erc-response.command-args parsed))))
(erc-display-message parsed 'notice 'active 's368
?c channel)))
@@ -1832,8 +1845,8 @@ See `erc-display-server-message'." nil
;; FIXME: Yet more magic numbers in original code, I'm guessing this
;; command takes two arguments, and doesn't have any "contents". --
;; Lawrence 2004/05/10
- (multiple-value-bind (from to)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,from ,to)
+ (cdr (erc-response.command-args parsed))))
(erc-display-message parsed 'notice 'active
's379 ?c from ?f to)))
@@ -1841,12 +1854,12 @@ See `erc-display-server-message'." nil
"Server's time string." nil
(erc-display-message
parsed 'notice 'active
- 's391 ?s (second (erc-response.command-args parsed))
- ?t (third (erc-response.command-args parsed))))
+ 's391 ?s (cadr (erc-response.command-args parsed))
+ ?t (nth 2 (erc-response.command-args parsed))))
(define-erc-response-handler (401)
"No such nick/channel." nil
- (let ((nick/channel (second (erc-response.command-args parsed))))
+ (let ((nick/channel (cadr (erc-response.command-args parsed))))
(when erc-whowas-on-nosuchnick
(erc-log (format "cmd: WHOWAS: %s" nick/channel))
(erc-server-send (format "WHOWAS %s 1" nick/channel)))
@@ -1856,23 +1869,23 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (403)
"No such channel." nil
(erc-display-message parsed '(notice error) 'active
- 's403 ?c (second (erc-response.command-args parsed))))
+ 's403 ?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (404)
"Cannot send to channel." nil
(erc-display-message parsed '(notice error) 'active
- 's404 ?c (second (erc-response.command-args parsed))))
+ 's404 ?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (405)
"Can't join that many channels." nil
(erc-display-message parsed '(notice error) 'active
- 's405 ?c (second (erc-response.command-args parsed))))
+ 's405 ?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (406)
"No such nick." nil
(erc-display-message parsed '(notice error) 'active
- 's406 ?n (second (erc-response.command-args parsed))))
+ 's406 ?n (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (412)
"No text to send." nil
@@ -1881,33 +1894,33 @@ See `erc-display-server-message'." nil
(define-erc-response-handler (421)
"Unknown command." nil
(erc-display-message parsed '(notice error) 'active 's421
- ?c (second (erc-response.command-args parsed))))
+ ?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (432)
"Bad nick." nil
(erc-display-message parsed '(notice error) 'active 's432
- ?n (second (erc-response.command-args parsed))))
+ ?n (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (433)
"Login-time \"nick in use\"." nil
- (erc-nickname-in-use (second (erc-response.command-args parsed))
+ (erc-nickname-in-use (cadr (erc-response.command-args parsed))
"already in use"))
(define-erc-response-handler (437)
"Nick temporarily unavailable (on IRCnet)." nil
- (let ((nick/channel (second (erc-response.command-args parsed))))
+ (let ((nick/channel (cadr (erc-response.command-args parsed))))
(unless (erc-channel-p nick/channel)
(erc-nickname-in-use nick/channel "temporarily unavailable"))))
(define-erc-response-handler (442)
"Not on channel." nil
(erc-display-message parsed '(notice error) 'active 's442
- ?c (second (erc-response.command-args parsed))))
+ ?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (461)
"Not enough parameters for command." nil
(erc-display-message parsed '(notice error) 'active 's461
- ?c (second (erc-response.command-args parsed))
+ ?c (cadr (erc-response.command-args parsed))
?m (erc-response.contents parsed)))
(define-erc-response-handler (465)
@@ -1923,37 +1936,37 @@ See `erc-display-server-message'." nil
(erc-display-message parsed '(notice error) nil
(intern (format "s%s"
(erc-response.command parsed)))
- ?c (second (erc-response.command-args parsed))))
+ ?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (475)
"Channel key needed." nil
(erc-display-message parsed '(notice error) nil 's475
- ?c (second (erc-response.command-args parsed)))
+ ?c (cadr (erc-response.command-args parsed)))
(when erc-prompt-for-channel-key
- (let ((channel (second (erc-response.command-args parsed)))
+ (let ((channel (cadr (erc-response.command-args parsed)))
(key (read-from-minibuffer
(format "Channel %s is mode +k. Enter key (RET to cancel): "
- (second (erc-response.command-args parsed))))))
+ (cadr (erc-response.command-args parsed))))))
(when (and key (> (length key) 0))
(erc-cmd-JOIN channel key)))))
(define-erc-response-handler (477)
"Channel doesn't support modes." nil
- (let ((channel (second (erc-response.command-args parsed)))
+ (let ((channel (cadr (erc-response.command-args parsed)))
(message (erc-response.contents parsed)))
(erc-display-message parsed 'notice (erc-get-buffer channel proc)
(format "%s: %s" channel message))))
(define-erc-response-handler (482)
"You need to be a channel operator to do that." nil
- (let ((channel (second (erc-response.command-args parsed)))
+ (let ((channel (cadr (erc-response.command-args parsed)))
(message (erc-response.contents parsed)))
(erc-display-message parsed '(error notice) 'active 's482
?c channel ?m message)))
(define-erc-response-handler (671)
"Secure connection response in WHOIS." nil
- (let ((nick (second (erc-response.command-args parsed)))
+ (let ((nick (cadr (erc-response.command-args parsed)))
(securemsg (erc-response.contents parsed)))
(erc-display-message parsed 'notice 'active 's671
?n nick ?a securemsg)))
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 7fbbbc317d0..433ffc05340 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -1,8 +1,9 @@
;; erc-button.el --- A way of buttonizing certain things in ERC buffers
-;; Copyright (C) 1996-2004, 2006-2011 Free Software Foundation, Inc.
+;; 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
@@ -25,7 +26,7 @@
;; Heavily borrowed from gnus-art.el. Thanks to the original authors.
;; This buttonizes nicks and other stuff to make it all clickable.
-;; To enable, add to your ~/.emacs:
+;; To enable, add to your init file:
;; (require 'erc-button)
;; (erc-button-mode 1)
;;
@@ -66,7 +67,7 @@
;;; Variables
-(defface erc-button '((t (:bold t)))
+(defface erc-button '((t :weight bold))
"ERC button face."
:group 'erc-faces)
@@ -115,13 +116,13 @@ longer than `erc-fill-column'."
:type 'boolean)
(defcustom erc-button-rfc-url "http://www.faqs.org/rfcs/rfc%s.html"
- "*URL used to browse rfc references.
+ "URL used to browse rfc references.
%s is replaced by the number."
:group 'erc-button
:type 'string)
(defcustom erc-button-google-url "http://www.google.com/search?q=%s"
- "*URL used to browse Google search references.
+ "URL used to browse Google search references.
%s is replaced by the search string."
:group 'erc-button
:type 'string)
@@ -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
@@ -155,7 +156,7 @@ longer than `erc-fill-column'."
1)
;; other
("\\s-\\(@\\([0-9][0-9][0-9]\\)\\)" 1 t erc-button-beats-to-time 2))
- "*Alist of regexps matching buttons in ERC buffers.
+ "Alist of regexps matching buttons in ERC buffers.
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
REGEXP is the string matching text around the button or a symbol
@@ -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"
@@ -198,12 +200,12 @@ PAR is a number of a regexp grouping whose text will be passed to
(integer :tag "Regexp section number")))))
(defcustom erc-emacswiki-url "http://www.emacswiki.org/cgi-bin/wiki.pl?"
- "*URL of the EmacsWiki Homepage."
+ "URL of the EmacsWiki Homepage."
:group 'erc-button
:type 'string)
(defcustom erc-emacswiki-lisp-url "http://www.emacswiki.org/elisp/"
- "*URL of the EmacsWiki ELisp area."
+ "URL of the EmacsWiki ELisp area."
:group 'erc-button
:type 'string)
@@ -488,7 +490,7 @@ For use on `completion-at-point-functions'."
("Query" . (erc-cmd-QUERY nick))
("Whois" . (erc-cmd-WHOIS nick))
("Lastlog" . (erc-cmd-LASTLOG nick)))
- "*An alist of possible actions to take on a nickname.
+ "An alist of possible actions to take on a nickname.
An entry looks like (\"Action\" . SEXP) where SEXP is evaluated with
the variable `nick' bound to the nick in question.
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index 6b76c4246ad..e8201f2ea43 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -1,6 +1,10 @@
;;; erc-capab.el --- support for dancer-ircd and hyperion's CAPAB
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; 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
@@ -48,7 +52,7 @@
;;; Usage:
-;; Put the following in your ~/.emacs file.
+;; Put the following in your init file.
;; (require 'erc-capab)
;; (erc-capab-identify-mode 1)
@@ -64,7 +68,6 @@
;;; Code:
(require 'erc)
-(eval-when-compile (require 'cl))
;;; Customization:
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 792c8dd88b3..1e299407fe9 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -1,8 +1,9 @@
;;; erc-compat.el --- ERC compatibility code for XEmacs
-;; Copyright (C) 2002-2003, 2005-2011 Free Software Foundation, Inc.
+;; 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.
@@ -70,7 +71,7 @@ See `erc-encoding-coding-alist'."
are placed.
Note that this should end with a directory separator.")
-;; XEmacs' `replace-match' does not replace matching subexpressions in strings.
+;; XEmacs's `replace-match' does not replace matching subexpressions in strings.
(defun erc-replace-match-subexpression-in-string
(newtext string match subexp start &optional fixedcase literal)
"Replace the subexpression SUBEXP of the last match in STRING with NEWTEXT.
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index fce22aadcc4..e31416f0e1a 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -1,12 +1,12 @@
;;; erc-dcc.el --- CTCP DCC module for ERC
-;; Copyright (C) 1993-1995, 1998, 2002-2004, 2006-2011
+;; Copyright (C) 1993-1995, 1998, 2002-2004, 2006-2012
;; Free Software Foundation, Inc.
;; 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
@@ -54,9 +54,7 @@
;;; Code:
(require 'erc)
-(eval-when-compile
- (require 'cl)
- (require 'pcomplete))
+(eval-when-compile (require 'pcomplete))
;;;###autoload (autoload 'erc-dcc-mode "erc-dcc")
(define-erc-module dcc nil
@@ -75,7 +73,7 @@ IRC users."
:group 'erc)
(defcustom erc-dcc-verbose nil
- "*If non-nil, be verbose about DCC activity reporting."
+ "If non-nil, be verbose about DCC activity reporting."
:group 'erc-dcc
:type 'boolean)
@@ -277,7 +275,7 @@ Argument IP is the address as a string. The result is also a string."
(* (nth 1 ips) 65536.0)
(* (nth 2 ips) 256.0)
(nth 3 ips))))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%s is %.0f" ip res)
(format "%.0f" res)))))
@@ -316,7 +314,7 @@ Should be set to a string or nil. If nil, use the value of
:valid-regexp erc-dcc-ipv4-regexp)))
(defcustom erc-dcc-send-request 'ask
- "*How to treat incoming DCC Send requests.
+ "How to treat incoming DCC Send requests.
'ask - Report the Send request, and wait for the user to manually accept it
You might want to set `erc-dcc-auto-masks' for this.
'auto - Automatically accept the request and begin downloading the file
@@ -380,8 +378,8 @@ created subprocess, or nil."
(with-no-warnings ; obsolete since 23.1
(set-process-filter-multibyte process nil)))))
(file-error
- (unless (and (string= "Cannot bind server socket" (cadr err))
- (string= "address already in use" (caddr err)))
+ (unless (and (string= "Cannot bind server socket" (nth 1 err))
+ (string= "address already in use" (nth 2 err)))
(signal (car err) (cdr err)))
(setq port (1+ port))
(unless (< port upper)
@@ -405,7 +403,7 @@ the accepted connection."
;;; Interactive command handling
(defcustom erc-dcc-get-default-directory nil
- "*Default directory for incoming DCC file transfers.
+ "Default directory for incoming DCC file transfers.
If this is nil, then the current value of `default-directory' is used."
:group 'erc-dcc
:type '(choice (const nil :tag "Default directory") directory))
@@ -434,38 +432,38 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
(pcomplete-here (append '("chat" "close" "get" "list")
(when (fboundp 'make-network-process) '("send"))))
(pcomplete-here
- (case (intern (downcase (pcomplete-arg 1)))
- (chat (mapcar (lambda (elt) (plist-get elt :nick))
+ (pcase (intern (downcase (pcomplete-arg 1)))
+ (`chat (mapcar (lambda (elt) (plist-get elt :nick))
+ (erc-remove-if-not
+ #'(lambda (elt)
+ (eq (plist-get elt :type) 'CHAT))
+ erc-dcc-list)))
+ (`close (erc-delete-dups
+ (mapcar (lambda (elt) (symbol-name (plist-get elt :type)))
+ erc-dcc-list)))
+ (`get (mapcar #'erc-dcc-nick
(erc-remove-if-not
#'(lambda (elt)
- (eq (plist-get elt :type) 'CHAT))
+ (eq (plist-get elt :type) 'GET))
erc-dcc-list)))
- (close (erc-delete-dups
- (mapcar (lambda (elt) (symbol-name (plist-get elt :type)))
- erc-dcc-list)))
- (get (mapcar #'erc-dcc-nick
- (erc-remove-if-not
- #'(lambda (elt)
- (eq (plist-get elt :type) 'GET))
- erc-dcc-list)))
- (send (pcomplete-erc-all-nicks))))
+ (`send (pcomplete-erc-all-nicks))))
(pcomplete-here
- (case (intern (downcase (pcomplete-arg 2)))
- (get (mapcar (lambda (elt) (plist-get elt :file))
- (erc-remove-if-not
- #'(lambda (elt)
- (and (eq (plist-get elt :type) 'GET)
- (erc-nick-equal-p (erc-extract-nick
- (plist-get elt :nick))
- (pcomplete-arg 1))))
- erc-dcc-list)))
- (close (mapcar #'erc-dcc-nick
- (erc-remove-if-not
- #'(lambda (elt)
- (eq (plist-get elt :type)
- (intern (upcase (pcomplete-arg 1)))))
- erc-dcc-list)))
- (send (pcomplete-entries)))))
+ (pcase (intern (downcase (pcomplete-arg 2)))
+ (`get (mapcar (lambda (elt) (plist-get elt :file))
+ (erc-remove-if-not
+ #'(lambda (elt)
+ (and (eq (plist-get elt :type) 'GET)
+ (erc-nick-equal-p (erc-extract-nick
+ (plist-get elt :nick))
+ (pcomplete-arg 1))))
+ erc-dcc-list)))
+ (`close (mapcar #'erc-dcc-nick
+ (erc-remove-if-not
+ #'(lambda (elt)
+ (eq (plist-get elt :type)
+ (intern (upcase (pcomplete-arg 1)))))
+ erc-dcc-list)))
+ (`send (pcomplete-entries)))))
(defun erc-dcc-do-CHAT-command (proc &optional nick)
(when nick
@@ -627,7 +625,7 @@ separated by a space."
;;;###autoload
(defvar erc-ctcp-query-DCC-hook '(erc-ctcp-query-DCC)
- "Hook variable for CTCP DCC queries")
+ "Hook variable for CTCP DCC queries.")
(defvar erc-dcc-query-handler-alist
'(("SEND" . erc-dcc-handle-ctcp-send)
@@ -674,7 +672,7 @@ It extracts the information about the dcc request and adds it to
?r "SEND" ?n nick ?u login ?h host))
((string-match erc-dcc-ctcp-query-send-regexp query)
(let ((filename
- (or (match-string 3 query)
+ (or (match-string 5 query)
(erc-dcc-unquote-filename (match-string 2 query))))
(ip (erc-decimal-to-ip (match-string 6 query)))
(port (match-string 7 query))
@@ -719,7 +717,7 @@ match, returns that regexp and nil otherwise."
"^DCC CHAT +chat +\\([0-9]+\\) +\\([0-9]+\\)")
(defcustom erc-dcc-chat-request 'ask
- "*How to treat incoming DCC Chat requests.
+ "How to treat incoming DCC Chat requests.
'ask - Report the Chat request, and wait for the user to manually accept it
'auto - Automatically accept the request and open a new chat window
'ignore - Ignore incoming DCC chat requests completely."
@@ -777,12 +775,12 @@ match, returns that regexp and nil otherwise."
;;; SEND handling
(defcustom erc-dcc-block-size 1024
- "*Block size to use for DCC SEND sessions."
+ "Block size to use for DCC SEND sessions."
:group 'erc-dcc
:type 'integer)
(defcustom erc-dcc-pump-bytes nil
- "*If set to an integer, keep sending until that number of bytes are
+ "If set to an integer, keep sending until that number of bytes are
unconfirmed."
:group 'erc-dcc
:type '(choice (const nil) integer))
@@ -856,7 +854,7 @@ bytes sent."
(defcustom erc-dcc-send-connect-hook
'(erc-dcc-display-send erc-dcc-send-block)
- "*Hook run whenever the remote end of a DCC SEND offer connected to your
+ "Hook run whenever the remote end of a DCC SEND offer connected to your
listening port."
:group 'erc-dcc
:type 'hook)
@@ -1046,12 +1044,12 @@ transfer is complete."
;;; CHAT handling
(defcustom erc-dcc-chat-buffer-name-format "DCC-CHAT-%s"
- "*Format to use for DCC Chat buffer names."
+ "Format to use for DCC Chat buffer names."
:group 'erc-dcc
:type 'string)
(defcustom erc-dcc-chat-mode-hook nil
- "*Hook calls when `erc-dcc-chat-mode' finished setting up the buffer."
+ "Hook calls when `erc-dcc-chat-mode' finished setting up the buffer."
:group 'erc-dcc
:type 'hook)
@@ -1099,8 +1097,13 @@ Possible values are: ask, auto, ignore."
(pcomplete-here '("auto" "ask" "ignore")))
(defalias 'pcomplete/erc-mode/SREQ 'pcomplete/erc-mode/CREQ)
-(defvar erc-dcc-chat-filter-hook '(erc-dcc-chat-parse-output)
- "*Hook to run after doing parsing (and possible insertion) of DCC messages.")
+(defvar erc-dcc-chat-filter-functions '(erc-dcc-chat-parse-output)
+ "Abnormal hook run after parsing (and maybe inserting) a DCC message.
+Each function is called with two arguments: the ERC process and
+the unprocessed output.")
+
+(define-obsolete-variable-alias 'erc-dcc-chat-filter-hook
+ 'erc-dcc-chat-filter-functions "24.3")
(defvar erc-dcc-chat-mode-map
(let ((map (make-sparse-keymap)))
@@ -1195,8 +1198,8 @@ other client."
(set-buffer (process-buffer proc))
(setq erc-dcc-unprocessed-output
(concat erc-dcc-unprocessed-output str))
- (run-hook-with-args 'erc-dcc-chat-filter-hook proc
- erc-dcc-unprocessed-output))
+ (run-hook-with-args 'erc-dcc-chat-filter-functions
+ proc erc-dcc-unprocessed-output))
(set-buffer orig-buffer))))
(defun erc-dcc-chat-parse-output (proc str)
@@ -1243,7 +1246,7 @@ other client."
(defun erc-dcc-no-such-nick (proc parsed)
"Detect and handle no-such-nick replies from the IRC server."
- (let* ((elt (erc-dcc-member :nick (second (erc-response.command-args parsed))
+ (let* ((elt (erc-dcc-member :nick (nth 1 (erc-response.command-args parsed))
:parent proc))
(peer (plist-get elt :peer)))
(when (or (and (processp peer) (not (eq (process-status peer) 'open)))
diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el
new file mode 100644
index 00000000000..2cc3c80a8ea
--- /dev/null
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -0,0 +1,91 @@
+;; erc-desktop-notifications.el -- Send notification on PRIVMSG or mentions
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Julien Danjou <julien@danjou.info>
+;; Keywords: comm
+
+;; 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 implements notifications using `notifications-notify' on
+;; PRIVMSG received and on public nickname mentions.
+
+;;; Code:
+
+(require 'erc)
+(require 'xml)
+(require 'notifications)
+(require 'erc-match)
+(require 'dbus)
+
+(defgroup erc-notifications nil
+ "Send notifications on PRIVMSG or mentions."
+ :version "24.3"
+ :group 'erc)
+
+(defvar erc-notifications-last-notification nil
+ "Last notification id.")
+
+(defcustom erc-notifications-icon nil
+ "Icon to use for notification."
+ :group 'erc-notifications
+ :type 'file)
+
+(defun erc-notifications-notify (nick msg)
+ "Notify that NICK send some MSG.
+This will replace the last notification sent with this function."
+ (dbus-ignore-errors
+ (setq erc-notifications-last-notification
+ (notifications-notify :title (xml-escape-string nick)
+ :body (xml-escape-string msg)
+ :replaces-id erc-notifications-last-notification
+ :app-icon erc-notifications-icon))))
+
+(defun erc-notifications-PRIVMSG (proc parsed)
+ (let ((nick (car (erc-parse-user (erc-response.sender parsed))))
+ (target (car (erc-response.command-args parsed)))
+ (msg (erc-response.contents parsed)))
+ (when (and (erc-current-nick-p target)
+ (not (and (boundp 'erc-track-exclude)
+ (member nick erc-track-exclude)))
+ (not (erc-is-message-ctcp-and-not-action-p msg)))
+ (erc-notifications-notify nick msg)))
+ ;; Return nil to continue processing by ERC
+ nil)
+
+(defun erc-notifications-notify-on-match (match-type nickuserhost msg)
+ (when (eq match-type 'current-nick)
+ (let ((nick (nth 0 (erc-parse-user nickuserhost))))
+ (unless (or (string-match-p "^Server:" nick)
+ (when (boundp 'erc-track-exclude)
+ (member nick erc-track-exclude)))
+ (erc-notifications-notify nick msg)))))
+
+;;;###autoload(autoload 'erc-notifications-mode "erc-desktop-notifications" "" t)
+(define-erc-module notifications nil
+ "Send notifications on private message reception and mentions."
+ ;; Enable
+ ((add-hook 'erc-server-PRIVMSG-functions 'erc-notifications-PRIVMSG)
+ (add-hook 'erc-text-matched-hook 'erc-notifications-notify-on-match))
+ ;; Disable
+ ((remove-hook 'erc-server-PRIVMSG-functions 'erc-notifications-PRIVMSG)
+ (remove-hook 'erc-text-matched-hook 'erc-notifications-notify-on-match)))
+
+(provide 'erc-desktop-notifications)
+
+;;; erc-desktop-notifications.el ends here
diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el
index b480d83e283..6bcc17e4bc0 100644
--- a/lisp/erc/erc-ezbounce.el
+++ b/lisp/erc/erc-ezbounce.el
@@ -1,8 +1,9 @@
;;; erc-ezbounce.el --- Handle EZBounce bouncer commands
-;; Copyright (C) 2002, 2004, 2006-2011 Free Software Foundation, Inc.
+;; 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.
@@ -25,7 +26,6 @@
;;; Code:
(require 'erc)
-(eval-when-compile (require 'cl))
(defgroup erc-ezbounce nil
"Interface to the EZBounce IRC bouncer (a virtual IRC server)"
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 3940cfbc9a4..35e14eb0e29 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -1,9 +1,10 @@
;;; erc-fill.el --- Filling IRC messages in various ways
-;; Copyright (C) 2001-2004, 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2004, 2006-2012 Free Software Foundation, Inc.
;; 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 b2cf9e35622..892f82e2eba 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -1,8 +1,9 @@
;; erc-goodies.el --- Collection of ERC modules
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; 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.
@@ -60,7 +61,7 @@ argument to `recenter'."
((remove-hook 'erc-mode-hook 'erc-add-scroll-to-bottom)
(dolist (buffer (erc-buffer-list))
(with-current-buffer buffer
- (remove-hook 'window-scroll-functions 'erc-scroll-to-bottom t)))))
+ (remove-hook 'post-command-hook 'erc-scroll-to-bottom t)))))
(defun erc-add-scroll-to-bottom ()
"A hook function for `erc-mode-hook' to recenter output at bottom of window.
@@ -70,35 +71,29 @@ the value of `erc-input-line-position'.
This works whenever scrolling happens, so it's added to
`window-scroll-functions' rather than `erc-insert-post-hook'."
- ;;(make-local-hook 'window-scroll-functions)
- (add-hook 'window-scroll-functions 'erc-scroll-to-bottom nil t))
+ (add-hook 'post-command-hook 'erc-scroll-to-bottom nil t))
-(defun erc-scroll-to-bottom (window display-start)
+(defun erc-scroll-to-bottom ()
"Recenter WINDOW so that `point' is on the last line.
This is added to `window-scroll-functions' by `erc-add-scroll-to-bottom'.
You can control which line is recentered to by customizing the
-variable `erc-input-line-position'.
-
-DISPLAY-START is ignored."
- (if (window-live-p window)
+variable `erc-input-line-position'."
;; Temporarily bind resize-mini-windows to nil so that users who have it
;; set to a non-nil value will not suffer from premature minibuffer
;; shrinkage due to the below recenter call. I have no idea why this
;; works, but it solves the problem, and has no negative side effects.
;; (Fran Litterio, 2003/01/07)
- (let ((resize-mini-windows nil))
- (erc-with-selected-window window
- (save-restriction
- (widen)
- (when (and erc-insert-marker
- ;; we're editing a line. Scroll.
- (> (point) erc-insert-marker))
- (save-excursion
- (goto-char (point-max))
- (recenter (or erc-input-line-position -1))
- (sit-for 0))))))))
+ (let ((resize-mini-windows nil))
+ (save-restriction
+ (widen)
+ (when (and erc-insert-marker
+ ;; we're editing a line. Scroll.
+ (> (point) erc-insert-marker))
+ (save-excursion
+ (goto-char (point-max))
+ (recenter (or erc-input-line-position -1)))))))
;;; Make read only
(define-erc-module readonly nil
@@ -189,7 +184,7 @@ themselves."
:group 'erc)
(defcustom erc-interpret-controls-p t
- "*If non-nil, display IRC colors and other highlighting effects.
+ "If non-nil, display IRC colors and other highlighting effects.
If this is set to the symbol `remove', ERC removes all IRC colors and
highlighting effects. When this variable is non-nil, it can cause Emacs to run
@@ -202,7 +197,7 @@ emergency (message flood) it can be turned off to save processing time. See
(const :tag "Display raw control characters" nil)))
(defcustom erc-interpret-mirc-color nil
- "*If non-nil, ERC will interpret mIRC color codes."
+ "If non-nil, ERC will interpret mIRC color codes."
:group 'erc-control-characters
:type 'boolean)
@@ -212,112 +207,114 @@ The value `erc-interpret-controls-p' must also be t for this to work."
:group 'erc-control-characters
:type 'boolean)
-(defface erc-bold-face '((t (:bold t)))
+(defface erc-bold-face '((t :weight bold))
"ERC bold face."
:group 'erc-faces)
+
(defface erc-inverse-face
- '((t (:foreground "White" :background "Black")))
+ '((t :foreground "White" :background "Black"))
"ERC inverse face."
:group 'erc-faces)
-(defface erc-underline-face '((t (:underline t)))
+
+(defface erc-underline-face '((t :underline t))
"ERC underline face."
:group 'erc-faces)
-(defface fg:erc-color-face0 '((t (:foreground "White")))
+(defface fg:erc-color-face0 '((t :foreground "White"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face1 '((t (:foreground "black")))
+(defface fg:erc-color-face1 '((t :foreground "black"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face2 '((t (:foreground "blue4")))
+(defface fg:erc-color-face2 '((t :foreground "blue4"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face3 '((t (:foreground "green4")))
+(defface fg:erc-color-face3 '((t :foreground "green4"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face4 '((t (:foreground "red")))
+(defface fg:erc-color-face4 '((t :foreground "red"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face5 '((t (:foreground "brown")))
+(defface fg:erc-color-face5 '((t :foreground "brown"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face6 '((t (:foreground "purple")))
+(defface fg:erc-color-face6 '((t :foreground "purple"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face7 '((t (:foreground "orange")))
+(defface fg:erc-color-face7 '((t :foreground "orange"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face8 '((t (:foreground "yellow")))
+(defface fg:erc-color-face8 '((t :foreground "yellow"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face9 '((t (:foreground "green")))
+(defface fg:erc-color-face9 '((t :foreground "green"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face10 '((t (:foreground "lightblue1")))
+(defface fg:erc-color-face10 '((t :foreground "lightblue1"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face11 '((t (:foreground "cyan")))
+(defface fg:erc-color-face11 '((t :foreground "cyan"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face12 '((t (:foreground "blue")))
+(defface fg:erc-color-face12 '((t :foreground "blue"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face13 '((t (:foreground "deeppink")))
+(defface fg:erc-color-face13 '((t :foreground "deeppink"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face14 '((t (:foreground "gray50")))
+(defface fg:erc-color-face14 '((t :foreground "gray50"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face15 '((t (:foreground "gray90")))
+(defface fg:erc-color-face15 '((t :foreground "gray90"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face0 '((t (:background "White")))
+(defface bg:erc-color-face0 '((t :background "White"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face1 '((t (:background "black")))
+(defface bg:erc-color-face1 '((t :background "black"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face2 '((t (:background "blue4")))
+(defface bg:erc-color-face2 '((t :background "blue4"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face3 '((t (:background "green4")))
+(defface bg:erc-color-face3 '((t :background "green4"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face4 '((t (:background "red")))
+(defface bg:erc-color-face4 '((t :background "red"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face5 '((t (:background "brown")))
+(defface bg:erc-color-face5 '((t :background "brown"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face6 '((t (:background "purple")))
+(defface bg:erc-color-face6 '((t :background "purple"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face7 '((t (:background "orange")))
+(defface bg:erc-color-face7 '((t :background "orange"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face8 '((t (:background "yellow")))
+(defface bg:erc-color-face8 '((t :background "yellow"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face9 '((t (:background "green")))
+(defface bg:erc-color-face9 '((t :background "green"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face10 '((t (:background "lightblue1")))
+(defface bg:erc-color-face10 '((t :background "lightblue1"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face11 '((t (:background "cyan")))
+(defface bg:erc-color-face11 '((t :background "cyan"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face12 '((t (:background "blue")))
+(defface bg:erc-color-face12 '((t :background "blue"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face13 '((t (:background "deeppink")))
+(defface bg:erc-color-face13 '((t :background "deeppink"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face14 '((t (:background "gray50")))
+(defface bg:erc-color-face14 '((t :background "gray50"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face15 '((t (:background "gray90")))
+(defface bg:erc-color-face15 '((t :background "gray90"))
"ERC face."
:group 'erc-faces)
diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el
index 9d658eec2f0..d1e74fd4c54 100644
--- a/lisp/erc/erc-ibuffer.el
+++ b/lisp/erc/erc-ibuffer.el
@@ -1,8 +1,9 @@
;;; erc-ibuffer.el --- ibuffer integration with ERC
-;; Copyright (C) 2002, 2004, 2006-2011 Free Software Foundation, Inc.
+;; 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 140802deff0..9586dd698a0 100644
--- a/lisp/erc/erc-identd.el
+++ b/lisp/erc/erc-identd.el
@@ -1,8 +1,9 @@
;;; erc-identd.el --- RFC1413 (identd authentication protocol) server
-;; Copyright (C) 2003, 2006-2011 Free Software Foundation, Inc.
+;; 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 3e6e853ff70..7346fca1b8a 100644
--- a/lisp/erc/erc-imenu.el
+++ b/lisp/erc/erc-imenu.el
@@ -1,8 +1,9 @@
;;; erc-imenu.el -- Imenu support for ERC
-;; Copyright (C) 2001-2002, 2004, 2006-2011 Free Software Foundation, Inc.
+;; 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 c158c47ab64..e285cfb4ec5 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -1,8 +1,9 @@
;;; erc-join.el --- autojoin channels on connect and reconnects
-;; Copyright (C) 2002-2004, 2006-2011 Free Software Foundation, Inc.
+;; 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
@@ -32,7 +33,7 @@
;;; Code:
(require 'erc)
-(eval-when-compile (require 'cl))
+(require 'auth-source)
(defgroup erc-autojoin nil
"Enable autojoining."
@@ -56,6 +57,13 @@ Every element in the alist has the form (SERVER . CHANNELS).
SERVER is a regexp matching the server, and channels is the
list of channels to join.
+If the channel(s) require channel keys for joining, the passwords
+are found via auth-source. For instance, if you use ~/.authinfo
+as your auth-source backend, then put something like the
+following in that file:
+
+machine irc.example.net login \"#fsf\" password sEcReT
+
Customize this variable to set the value for your first connect.
Once you are connected and join and part channels, this alist
keeps track of what channels you are on, and will join them
@@ -75,8 +83,9 @@ If the value is `ident', autojoin after successful NickServ
identification, or after `erc-autojoin-delay' seconds.
Any other value means the same as `connect'."
:group 'erc-autojoin
- :type '(choice (const :tag "On Connection" 'connect)
- (const :tag "When Identified" 'ident)))
+ :version "24.1"
+ :type '(choice (const :tag "On Connection" connect)
+ (const :tag "When Identified" ident)))
(defcustom erc-autojoin-delay 30
"Number of seconds to wait before attempting to autojoin channels.
@@ -84,6 +93,7 @@ This only takes effect if `erc-autojoin-timing' is `ident'.
If NickServ identification occurs before this delay expires, ERC
autojoins immediately at that time."
:group 'erc-autojoin
+ :version "24.1"
:type 'integer)
(defcustom erc-autojoin-domain-only t
@@ -129,7 +139,7 @@ This function is run from `erc-nickserv-identified-hook'."
(when (string-match (car l) server)
(dolist (chan (cdr l))
(unless (erc-member-ignore-case chan joined)
- (erc-server-send (concat "join " chan))))))))
+ (erc-server-join-channel server chan)))))))
nil)
(defun erc-autojoin-channels (server nick)
@@ -146,10 +156,25 @@ This function is run from `erc-nickserv-identified-hook'."
(dolist (l erc-autojoin-channels-alist)
(when (string-match (car l) server)
(dolist (chan (cdr l))
- (erc-server-send (concat "join " chan))))))
+ (erc-server-join-channel server chan)))))
;; Return nil to avoid stomping on any other hook funcs.
nil)
+(defun erc-server-join-channel (server channel)
+ (let* ((secret (plist-get (nth 0 (auth-source-search
+ :max 1
+ :host server
+ :port "irc"
+ :user channel))
+ :secret))
+ (password (if (functionp secret)
+ (funcall secret)
+ secret)))
+ (erc-server-send (concat "join " channel
+ (if password
+ (concat " " password)
+ "")))))
+
(defun erc-autojoin-add (proc parsed)
"Add the channel being joined to `erc-autojoin-channels-alist'."
(let* ((chnl (erc-response.contents parsed))
diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el
index 84a4c60816e..2d7f555971e 100644
--- a/lisp/erc/erc-lang.el
+++ b/lisp/erc/erc-lang.el
@@ -1,9 +1,9 @@
;;; erc-lang.el --- provide the LANG command to ERC
-;; Copyright (C) 2002, 2004, 2006-2011 Free Software Foundation, Inc.
+;; 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 b8eb5a4aa19..19afe2e79ee 100644
--- a/lisp/erc/erc-list.el
+++ b/lisp/erc/erc-list.el
@@ -1,8 +1,9 @@
;;; erc-list.el --- /list support for ERC
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; 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 f1754afd1ac..1ff2951e09e 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -1,8 +1,9 @@
;;; erc-log.el --- Logging facilities for ERC.
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; 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
@@ -92,16 +93,14 @@
;;; Code:
(require 'erc)
-(eval-when-compile
- (require 'erc-networks)
- (require 'cl))
+(eval-when-compile (require 'erc-networks))
(defgroup erc-log nil
"Logging facilities for ERC."
:group 'erc)
(defcustom erc-generate-log-file-name-function 'erc-generate-log-file-name-long
- "*A function to generate a log filename.
+ "A function to generate a log filename.
The function must take five arguments: BUFFER, TARGET, NICK, SERVER and PORT.
BUFFER is the buffer to be saved,
TARGET is the name of the channel, or the target of the query,
@@ -113,11 +112,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
@@ -157,12 +158,12 @@ arguments."
(const :tag "Disable logging" nil)))
(defcustom erc-log-insert-log-on-open nil
- "*Insert log file contents into the buffer if a log file exists."
+ "Insert log file contents into the buffer if a log file exists."
:group 'erc-log
:type 'boolean)
(defcustom erc-save-buffer-on-part t
- "*Save the channel buffer content using `erc-save-buffer-in-logs' on PART.
+ "Save the channel buffer content using `erc-save-buffer-in-logs' on PART.
If you set this to nil, you may want to enable both
`erc-log-write-after-send' and `erc-log-write-after-insert'."
@@ -170,7 +171,7 @@ If you set this to nil, you may want to enable both
:type 'boolean)
(defcustom erc-save-queries-on-quit t
- "*Save all query (also channel) buffers of the server on QUIT.
+ "Save all query (also channel) buffers of the server on QUIT.
If you set this to nil, you may want to enable both
`erc-log-write-after-send' and `erc-log-write-after-insert'."
@@ -178,7 +179,7 @@ If you set this to nil, you may want to enable both
:type 'boolean)
(defcustom erc-log-write-after-send nil
- "*If non-nil, write to log file after every message you send.
+ "If non-nil, write to log file after every message you send.
If you set this to nil, you may want to enable both
`erc-save-buffer-on-part' and `erc-save-queries-on-quit'."
@@ -186,7 +187,7 @@ If you set this to nil, you may want to enable both
:type 'boolean)
(defcustom erc-log-write-after-insert nil
- "*If non-nil, write to log file when new text is added to a
+ "If non-nil, write to log file when new text is added to a
logged ERC buffer.
If you set this to nil, you may want to enable both
@@ -197,14 +198,14 @@ If you set this to nil, you may want to enable both
(defcustom erc-log-file-coding-system (if (featurep 'xemacs)
'binary
'emacs-mule)
- "*The coding system ERC should use for writing log files.
+ "The coding system ERC should use for writing log files.
This should ideally, be a \"catch-all\" coding system, like
`emacs-mule', or `iso-2022-7bit'."
:group 'erc-log)
(defcustom erc-log-filter-function nil
- "*If non-nil, pass text through the given function before writing it to
+ "If non-nil, pass text through the given function before writing it to
a log file.
The function should take one argument, which is the text to filter."
@@ -426,7 +427,8 @@ You can save every individual message by putting this function on
file t 'nomessage))))
(let ((coding-system-for-write coding-system))
(write-region start end file t 'nomessage))))
- (if (and erc-truncate-buffer-on-save (interactive-p))
+ (if (and erc-truncate-buffer-on-save
+ (called-interactively-p 'interactive))
(progn
(let ((inhibit-read-only t)) (erase-buffer))
(move-marker erc-last-saved-position (point-max))
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 7e567bd1648..f1219427360 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -1,8 +1,9 @@
;;; erc-match.el --- Highlight messages matching certain regexps
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; 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
@@ -29,12 +30,11 @@
;; customizable variables.
;; Usage:
-;; Put (erc-match-mode 1) into your ~/.emacs file.
+;; Put (erc-match-mode 1) into your init file.
;;; Code:
(require 'erc)
-(eval-when-compile (require 'cl))
;; Customization:
@@ -83,7 +83,7 @@ Useful to mark nicks from dangerous hosts."
:type '(repeat regexp))
(defcustom erc-current-nick-highlight-type 'keyword
- "*Determines how to highlight text in which your current nickname appears
+ "Determines how to highlight text in which your current nickname appears
\(does not apply to text sent by you\).
The following values are allowed:
@@ -105,7 +105,7 @@ Any other value disables highlighting of current nickname altogether."
(const all)))
(defcustom erc-pal-highlight-type 'nick
- "*Determines how to highlight messages by pals.
+ "Determines how to highlight messages by pals.
See `erc-pals'.
The following values are allowed:
@@ -121,7 +121,7 @@ Any other value disables pal highlighting altogether."
(const all)))
(defcustom erc-fool-highlight-type 'nick
- "*Determines how to highlight messages by fools.
+ "Determines how to highlight messages by fools.
See `erc-fools'.
The following values are allowed:
@@ -137,7 +137,7 @@ Any other value disables fool highlighting altogether."
(const all)))
(defcustom erc-keyword-highlight-type 'keyword
- "*Determines how to highlight messages containing keywords.
+ "Determines how to highlight messages containing keywords.
See variable `erc-keywords'.
The following values are allowed:
@@ -152,7 +152,7 @@ Any other value disables keyword highlighting altogether."
(const all)))
(defcustom erc-dangerous-host-highlight-type 'nick
- "*Determines how to highlight messages by nicks from dangerous-hosts.
+ "Determines how to highlight messages by nicks from dangerous-hosts.
See `erc-dangerous-hosts'.
The following values are allowed:
@@ -232,6 +232,14 @@ current-nick, keyword, pal, dangerous-host, fool"
:group 'erc-match
:type 'hook)
+(defcustom erc-match-exclude-server-buffer nil
+ "If true, don't perform match on the server buffer; this is
+useful for excluding all the things like MOTDs from the server
+and other miscellaneous functions."
+ :group 'erc-match
+ :version "24.3"
+ :type 'boolean)
+
;; Internal variables:
;; This is exactly the same as erc-button-syntax-table. Should we
@@ -258,26 +266,26 @@ constituents.")
;; Faces:
-(defface erc-current-nick-face '((t (:bold t :foreground "DarkTurquoise")))
+(defface erc-current-nick-face '((t :weight bold :foreground "DarkTurquoise"))
"ERC face for occurrences of your current nickname."
:group 'erc-faces)
-(defface erc-dangerous-host-face '((t (:foreground "red")))
+(defface erc-dangerous-host-face '((t :foreground "red"))
"ERC face for people on dangerous hosts.
See `erc-dangerous-hosts'."
:group 'erc-faces)
-(defface erc-pal-face '((t (:bold t :foreground "Magenta")))
+(defface erc-pal-face '((t :weight bold :foreground "Magenta"))
"ERC face for your pals.
See `erc-pals'."
:group 'erc-faces)
-(defface erc-fool-face '((t (:foreground "dim gray")))
+(defface erc-fool-face '((t :foreground "dim gray"))
"ERC face for fools on the channel.
See `erc-fools'."
:group 'erc-faces)
-(defface erc-keyword-face '((t (:bold t :foreground "pale green")))
+(defface erc-keyword-face '((t :weight bold :foreground "pale green"))
"ERC face for your keywords.
Note that this is the default face to use if
`erc-keywords' does not specify another."
@@ -449,7 +457,9 @@ Use this defun with `erc-insert-modify-hook'."
(+ 2 nick-end)
(point-min))
(point-max))))
- (when vector
+ (when (and vector
+ (not (and erc-match-exclude-server-buffer
+ (erc-server-buffer-p))))
(mapc
(lambda (match-type)
(goto-char (point-min))
diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el
index ea4ed399a64..1aec2ad417f 100644
--- a/lisp/erc/erc-menu.el
+++ b/lisp/erc/erc-menu.el
@@ -1,8 +1,9 @@
;; erc-menu.el -- Menu-bar definitions for ERC
-;; Copyright (C) 2001-2002, 2004-2011 Free Software Foundation, Inc.
+;; 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 d5f4ec48ba9..cbaf62b1a61 100644
--- a/lisp/erc/erc-netsplit.el
+++ b/lisp/erc/erc-netsplit.el
@@ -1,8 +1,9 @@
;;; erc-netsplit.el --- Reduce JOIN/QUIT messages on netsplits
-;; Copyright (C) 2002-2004, 2006-2011 Free Software Foundation, Inc.
+;; 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.
@@ -23,14 +24,13 @@
;;; Commentary:
;; This module hides quit/join messages if a netsplit occurs.
-;; To enable, add the following to your ~/.emacs:
+;; To enable, add the following to your init file:
;; (require 'erc-netsplit)
;; (erc-netsplit-mode 1)
;;; Code:
(require 'erc)
-(eval-when-compile (require 'cl))
(defgroup erc-netsplit nil
"Netsplit detection tries to automatically figure when a
@@ -106,7 +106,7 @@ join from that split has been detected or not.")
(dolist (elt erc-netsplit-list)
(if (member nick (nthcdr 3 elt))
(progn
- (if (not (caddr elt))
+ (if (not (nth 2 elt))
(progn
(erc-display-message
parsed 'notice (process-buffer proc)
@@ -148,7 +148,7 @@ join from that split has been detected or not.")
;; element for this netsplit exists already
(progn
(setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass)))
- (when (caddr ass)
+ (when (nth 2 ass)
;; There was already a netjoin for this netsplit, it
;; seems like the old one didn't get finished...
(erc-display-message
@@ -193,7 +193,7 @@ join from that split has been detected or not.")
nil 'notice 'active
'netsplit-wholeft ?s (car elt)
?n (mapconcat 'erc-extract-nick (nthcdr 3 elt) " ")
- ?t (if (caddr elt)
+ ?t (if (nth 2 elt)
"(joining)"
"")))))
t)
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 1f94ef44093..5089ff6b4ba 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1,8 +1,9 @@
;;; erc-networks.el --- IRC networks
-;; Copyright (C) 2002, 2004-2011 Free Software Foundation, Inc.
+;; 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.
@@ -39,7 +40,7 @@
;;; Code:
(require 'erc)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;; Variables
@@ -728,10 +729,10 @@ search for a match in `erc-networks-alist'."
(or
;; Loop through `erc-networks-alist' looking for a match.
(let ((server (or erc-server-announced-name erc-session-server)))
- (loop for (name matcher) in erc-networks-alist
- when (and matcher
- (string-match (concat matcher "\\'") server))
- do (return name)))
+ (cl-loop for (name matcher) in erc-networks-alist
+ when (and matcher
+ (string-match (concat matcher "\\'") server))
+ do (cl-return name)))
'Unknown)))
(defun erc-network ()
@@ -788,8 +789,8 @@ As an example:
(cond ((numberp p)
(push p result))
((listp p)
- (setq result (nconc (loop for i from (cadr p) downto (car p)
- collect i)
+ (setq result (nconc (cl-loop for i from (cadr p) downto (car p)
+ collect i)
result)))))
(nreverse result)))
diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el
index 10f6806ec12..b9d7ff78cd8 100644
--- a/lisp/erc/erc-notify.el
+++ b/lisp/erc/erc-notify.el
@@ -1,8 +1,9 @@
;;; erc-notify.el --- Online status change notification
-;; Copyright (C) 2002-2004, 2006-2011 Free Software Foundation, Inc.
+;; 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.
@@ -29,9 +30,7 @@
(require 'erc)
(require 'erc-networks)
-(eval-when-compile
- (require 'cl)
- (require 'pcomplete))
+(eval-when-compile (require 'pcomplete))
;;;; Customizable variables
@@ -40,19 +39,19 @@
:group 'erc)
(defcustom erc-notify-list nil
- "*List of nicknames you want to be notified about online/offline
+ "List of nicknames you want to be notified about online/offline
status change."
:group 'erc-notify
:type '(repeat string))
(defcustom erc-notify-interval 60
- "*Time interval (in seconds) for checking online status of notified
+ "Time interval (in seconds) for checking online status of notified
people."
:group 'erc-notify
:type 'integer)
(defcustom erc-notify-signon-hook nil
- "*Hook run after someone on `erc-notify-list' has signed on.
+ "Hook run after someone on `erc-notify-list' has signed on.
Two arguments are passed to the function, SERVER and NICK, both
strings."
:group 'erc-notify
@@ -60,7 +59,7 @@ strings."
:options '(erc-notify-signon))
(defcustom erc-notify-signoff-hook nil
- "*Hook run after someone on `erc-notify-list' has signed off.
+ "Hook run after someone on `erc-notify-list' has signed off.
Two arguments are passed to the function, SERVER and NICK, both
strings."
:group 'erc-notify
diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el
index 5776dd6fc1a..8eae6c83d15 100644
--- a/lisp/erc/erc-page.el
+++ b/lisp/erc/erc-page.el
@@ -1,6 +1,8 @@
;; erc-page.el - CTCP PAGE support for ERC
-;; Copyright (C) 2002, 2004, 2006-2011 Free Software Foundation
+;; Copyright (C) 2002, 2004, 2006-2012 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
;; This file is part of GNU Emacs.
@@ -45,7 +47,7 @@ If nil, this prints the page message in the minibuffer and calls
`beep'. If non-nil, it must be a function that takes two arguments:
SENDER and MSG, both strings.
-Example for your ~/.emacs file:
+Example for your init file:
\(setq erc-page-function
(lambda (sender msg)
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index a390fcfe84d..d6bb8019b15 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -1,8 +1,9 @@
;;; erc-pcomplete.el --- Provides programmable completion for ERC
-;; Copyright (C) 2002-2004, 2006-2011 Free Software Foundation, Inc.
+;; 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
@@ -42,14 +43,13 @@
(require 'erc)
(require 'erc-compat)
(require 'time-date)
-(eval-when-compile (require 'cl))
(defgroup erc-pcomplete nil
"Programmable completion for ERC"
:group 'erc)
(defcustom erc-pcomplete-nick-postfix ":"
- "*When `pcomplete' is used in the first word after the prompt,
+ "When `pcomplete' is used in the first word after the prompt,
add this string to nicks completed."
:group 'erc-pcomplete
:type 'string)
diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el
index 4d3ba1e230d..3d4a5d311b1 100644
--- a/lisp/erc/erc-replace.el
+++ b/lisp/erc/erc-replace.el
@@ -1,9 +1,9 @@
;; erc-replace.el -- wash and massage messages inserted into the buffer
-;; Copyright (C) 2001-2002, 2004, 2006-2011 Free Software Foundation, Inc.
+;; 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.
@@ -25,7 +25,7 @@
;; This module allows you to systematically replace text in incoming
;; messages. Load erc-replace, and customize `erc-replace-alist'.
-;; Then add to your ~/.emacs:
+;; Then add to your init file:
;; (require 'erc-replace)
;; (erc-replace-mode 1)
diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el
index 345c636fa79..6b3f3e3c3aa 100644
--- a/lisp/erc/erc-ring.el
+++ b/lisp/erc/erc-ring.el
@@ -1,8 +1,9 @@
;; erc-ring.el -- Command history handling for erc using ring.el
-;; Copyright (C) 2001-2004, 2006-2011 Free Software Foundation, Inc.
+;; 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 3acc600b425..b75ad8e9517 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -1,6 +1,8 @@
;;; erc-services.el --- Identify to NickServ
-;; Copyright (C) 2002-2004, 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
;; This file is part of GNU Emacs.
@@ -60,7 +62,7 @@
(require 'erc)
(require 'erc-networks)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;; Customization:
@@ -195,7 +197,8 @@ Example of use:
(repeat :tag "Nickname and password"
(cons :tag "Identity"
(string :tag "Nick")
- (string :tag "Password"))))))
+ (string :tag "Password"
+ :secret ?*))))))
;; Variables:
diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el
index 3253aec3386..55336a68cfe 100644
--- a/lisp/erc/erc-sound.el
+++ b/lisp/erc/erc-sound.el
@@ -1,6 +1,8 @@
;;; erc-sound.el --- CTCP SOUND support for ERC
-;; Copyright (C) 2002-2003, 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2006-2012 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
;; This file is part of GNU Emacs.
@@ -62,7 +64,7 @@ and play sound files as requested."
:group 'erc)
(defcustom erc-play-sound t
- "*Play sounds when you receive CTCP SOUND requests."
+ "Play sounds when you receive CTCP SOUND requests."
:group 'erc-sound
:type 'boolean)
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index 3d80371cc68..22053945159 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -1,9 +1,10 @@
;;; erc-speedbar.el --- Speedbar support for ERC
-;; Copyright (C) 2001-2004, 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Contributor: Eric M. Ludlam <eric@siege-engine.com>
+;; Maintainer: FSF
;; This file is part of GNU Emacs.
@@ -37,7 +38,6 @@
(require 'erc)
(require 'speedbar)
(condition-case nil (require 'dframe) (error nil))
-(eval-when-compile (require 'cl))
;;; Customization:
diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el
index 5bb3c877dbe..5f40cc39e89 100644
--- a/lisp/erc/erc-spelling.el
+++ b/lisp/erc/erc-spelling.el
@@ -1,8 +1,9 @@
;;; erc-spelling.el --- use flyspell in ERC
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; 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 cfe8616ab65..4fa3f9f5915 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -1,8 +1,9 @@
;;; erc-stamp.el --- Timestamping for ERC messages
-;; Copyright (C) 2002-2004, 2006-2011 Free Software Foundation, Inc.
+;; 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
@@ -43,11 +44,11 @@ group provides settings related to the format and display
of timestamp information in `erc-mode' buffer.
For timestamping to be activated, you just need to load `erc-stamp'
-in your .emacs file or interactively using `load-library'."
+in your init file or interactively using `load-library'."
:group 'erc)
(defcustom erc-timestamp-format "[%H:%M]"
- "*If set to a string, messages will be timestamped.
+ "If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
@@ -57,7 +58,7 @@ If nil, timestamping is turned off."
(string)))
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
- "*If set to a string, messages will be timestamped.
+ "If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
@@ -71,7 +72,7 @@ If nil, timestamping is turned off."
(string)))
(defcustom erc-timestamp-format-right " [%H:%M]"
- "*If set to a string, messages will be timestamped.
+ "If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
@@ -85,7 +86,7 @@ If nil, timestamping is turned off."
(string)))
(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right
- "*Function to use to insert timestamps.
+ "Function to use to insert timestamps.
It takes a single argument STRING which is the final string
which all text-properties already appended. This function only cares about
@@ -102,7 +103,7 @@ You will probably want to set
function))
(defcustom erc-away-timestamp-format "<%H:%M>"
- "*Timestamp format used when marked as being away.
+ "Timestamp format used when marked as being away.
If nil, timestamping is turned off when away unless `erc-timestamp-format'
is set.
@@ -114,7 +115,7 @@ If `erc-timestamp-format' is set, this will not be used."
(defcustom erc-insert-away-timestamp-function
'erc-insert-timestamp-left-and-right
- "*Function to use to insert the away timestamp.
+ "Function to use to insert the away timestamp.
See `erc-insert-timestamp-function' for details."
:group 'erc-stamp
@@ -124,7 +125,7 @@ See `erc-insert-timestamp-function' for details."
function))
(defcustom erc-hide-timestamps nil
- "*If non-nil, timestamps will be invisible.
+ "If non-nil, timestamps will be invisible.
This is useful for logging, because, although timestamps will be
hidden, they will still be present in the logs."
@@ -132,7 +133,7 @@ hidden, they will still be present in the logs."
:type 'boolean)
(defcustom erc-echo-timestamps nil
- "*If non-nil, print timestamp in the minibuffer when point is moved.
+ "If non-nil, print timestamp in the minibuffer when point is moved.
Using this variable, you can turn off normal timestamping,
and simply move point to an irc message to see its timestamp
printed in the minibuffer."
@@ -140,19 +141,19 @@ printed in the minibuffer."
:type 'boolean)
(defcustom erc-echo-timestamp-format "Timestamped %A, %H:%M:%S"
- "*Format string to be used when `erc-echo-timestamps' is non-nil.
+ "Format string to be used when `erc-echo-timestamps' is non-nil.
This string specifies the format of the timestamp being echoed in
the minibuffer."
:group 'erc-stamp
:type 'string)
(defcustom erc-timestamp-intangible t
- "*Whether the timestamps should be intangible, i.e. prevent the point
+ "Whether the timestamps should be intangible, i.e. prevent the point
from entering them and instead jump over them."
:group 'erc-stamp
:type 'boolean)
-(defface erc-timestamp-face '((t (:bold t :foreground "green")))
+(defface erc-timestamp-face '((t :weight bold :foreground "green"))
"ERC timestamp face."
:group 'erc-faces)
@@ -205,7 +206,7 @@ This is used when `erc-insert-timestamp-function' is set to
(make-variable-buffer-local 'erc-timestamp-last-inserted-right)
(defcustom erc-timestamp-only-if-changed-flag t
- "*Insert timestamp only if its value changed since last insertion.
+ "Insert timestamp only if its value changed since last insertion.
If `erc-insert-timestamp-function' is `erc-insert-timestamp-left', a
string of spaces which is the same size as the timestamp is added to
the beginning of the line in its place. If you use
@@ -215,7 +216,7 @@ timestamp."
:type 'boolean)
(defcustom erc-timestamp-right-column nil
- "*If non-nil, the column at which the timestamp is inserted,
+ "If non-nil, the column at which the timestamp is inserted,
if the timestamp is to be printed to the right. If nil,
`erc-insert-timestamp-right' will use other means to determine
the correct column."
@@ -227,7 +228,7 @@ the correct column."
(defcustom erc-timestamp-use-align-to (and (not (featurep 'xemacs))
(>= emacs-major-version 22)
(eq window-system 'x))
- "*If non-nil, use the :align-to display property to align the stamp.
+ "If non-nil, use the :align-to display property to align the stamp.
This gives better results when variable-width characters (like
Asian language characters and math symbols) precede a timestamp.
Unfortunately, it only works in Emacs 22 and when using the X
@@ -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 e2e5fa1c4f2..976d2a21030 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -1,8 +1,9 @@
;;; erc-track.el --- Track modified channel buffers
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; 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
@@ -24,7 +25,7 @@
;;; Commentary:
;; Highlights keywords and pals (friends), and hides or highlights fools
-;; (using a dark color). Add to your ~/.emacs:
+;; (using a dark color). Add to your init file:
;; (require 'erc-track)
;; (erc-track-mode 1)
@@ -33,7 +34,7 @@
;; * Add extensibility so that custom functions can track
;; custom modification types.
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'erc)
(require 'erc-compat)
(require 'erc-match)
@@ -41,7 +42,7 @@
;;; Code:
(defgroup erc-track nil
- "Track active buffers and show activity in the modeline."
+ "Track active buffers and show activity in the mode line."
:group 'erc)
(defcustom erc-track-enable-keybindings 'ask
@@ -93,13 +94,13 @@ Activity means that there was no user input in the last 10 seconds."
:type '(repeat string))
(defcustom erc-track-remove-disconnected-buffers nil
- "*If true, remove buffers associated with a server that is
+ "If true, remove buffers associated with a server that is
disconnected from `erc-modified-channels-alist'."
:group 'erc-track
:type 'boolean)
(defcustom erc-track-exclude-types '("NICK" "333" "353")
- "*List of message types to be ignored.
+ "List of message types to be ignored.
This list could look like '(\"JOIN\" \"PART\").
By default, exclude changes of nicknames (NICK), display of who
@@ -109,7 +110,7 @@ channel (353)."
:type 'erc-message-type)
(defcustom erc-track-exclude-server-buffer nil
- "*If true, don't perform tracking on the server buffer; this is
+ "If true, don't perform tracking on the server buffer; this is
useful for excluding all the things like MOTDs from the server and
other miscellaneous functions."
:group 'erc-track
@@ -127,7 +128,7 @@ the mode-line should be reduced to."
:type 'number)
(defcustom erc-track-shorten-aggressively nil
- "*If non-nil, channel names will be shortened more aggressively.
+ "If non-nil, channel names will be shortened more aggressively.
Usually, names are not shortened if this will save only one character.
Example: If there are two channels, #linux-de and #linux-fr, then
normally these will not be shortened. When shortening aggressively,
@@ -150,7 +151,7 @@ This setting is used by `erc-track-shorten-names'."
(const :tag "Max" max)))
(defcustom erc-track-shorten-function 'erc-track-shorten-names
- "*This function will be used to reduce the channel names before display.
+ "This function will be used to reduce the channel names before display.
It takes one argument, CHANNEL-NAMES which is a list of strings.
It should return a list of strings of the same number of elements.
If nil instead of a function, shortening is disabled."
@@ -169,7 +170,7 @@ notification of channel activity."
:type 'hook)
(defcustom erc-track-use-faces t
- "*Use faces in the mode-line.
+ "Use faces in the mode-line.
The faces used are the same as used for text in the buffers.
\(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)"
:group 'erc-track
@@ -196,7 +197,7 @@ The faces used are the same as used for text in the buffers.
erc-notice-face
erc-input-face
erc-prompt-face)
- "A list of faces used to highlight active buffer names in the modeline.
+ "A list of faces used to highlight active buffer names in the mode line.
If a message contains one of the faces in this list, the buffer name will
be highlighted using that face. The first matching face is used."
:group 'erc-track
@@ -228,10 +229,10 @@ setting this variable might not be very useful."
erc-default-face
erc-action-face)
"A list of faces considered to be part of normal conversations.
-This list is used to highlight active buffer names in the modeline.
+This list is used to highlight active buffer names in the mode line.
If a message contains one of the faces in this list, and the
-previous modeline face for this buffer is also in this list, then
+previous mode line face for this buffer is also in this list, then
the buffer name will be highlighted using the face from the
message. This gives a rough indication that active conversations
are occurring in these channels.
@@ -483,7 +484,7 @@ START is the minimum length of the name used."
;;; Test:
-(assert
+(cl-assert
(and
;; verify examples from the doc strings
(equal (let ((erc-track-shorten-aggressively nil))
@@ -868,11 +869,11 @@ Use `erc-make-mode-line-buffer-name' to create buttons."
(setq erc-modified-channels-alist
(delete (assq buffer erc-modified-channels-alist)
erc-modified-channels-alist))
- (when (interactive-p)
+ (when (called-interactively-p 'interactive)
(erc-modified-channels-display)))
(defun erc-track-find-face (faces)
- "Return the face to use in the modeline from the faces in FACES.
+ "Return the face to use in the mode line from the faces in FACES.
If `erc-track-faces-priority-list' is set, the one from FACES who
is first in that list will be used. If nothing matches or if
`erc-track-faces-priority-list' is not set, the default mode-line
@@ -906,7 +907,7 @@ element."
(defun erc-track-modified-channels ()
"Hook function for `erc-insert-post-hook' to check if the current
-buffer should be added to the modeline as a hidden, modified
+buffer should be added to the mode line as a hidden, modified
channel. Assumes it will only be called when current-buffer
is in `erc-mode'."
(let ((this-channel (or (erc-default-target)
@@ -979,7 +980,7 @@ is in `erc-mode'."
(add-to-list 'faces cur)))
faces))
-(assert
+(cl-assert
(let ((str "is bold"))
(put-text-property 3 (length str)
'face '(bold erc-current-nick-face)
@@ -1029,17 +1030,17 @@ relative to `erc-track-switch-direction'"
(let ((dir erc-track-switch-direction)
offset)
(when (< arg 0)
- (setq dir (case dir
- (oldest 'newest)
- (newest 'oldest)
- (mostactive 'leastactive)
- (leastactive 'mostactive)
- (importance 'oldest)))
+ (setq dir (pcase dir
+ (`oldest 'newest)
+ (`newest 'oldest)
+ (`mostactive 'leastactive)
+ (`leastactive 'mostactive)
+ (`importance 'oldest)))
(setq arg (- arg)))
- (setq offset (case dir
- ((oldest leastactive)
+ (setq offset (pcase dir
+ ((or `oldest `leastactive)
(- (length erc-modified-channels-alist) arg))
- (t (1- arg))))
+ (_ (1- arg))))
;; normalize out of range user input
(cond ((>= offset (length erc-modified-channels-alist))
(setq offset (1- (length erc-modified-channels-alist))))
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index 46668508637..8a219500ecb 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -1,8 +1,9 @@
;;; erc-truncate.el --- Functions for truncating ERC buffers
-;; Copyright (C) 2003-2004, 2006-2011 Free Software Foundation, Inc.
+;; 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.
@@ -36,7 +37,7 @@
:group 'erc)
(defcustom erc-max-buffer-size 30000
- "*Maximum size in chars of each ERC buffer.
+ "Maximum size in chars of each ERC buffer.
Used only when auto-truncation is enabled.
\(see `erc-truncate-buffer' and `erc-insert-post-hook')."
:group 'erc-truncate
diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el
index f4f75c15206..85356b39033 100644
--- a/lisp/erc/erc-xdcc.el
+++ b/lisp/erc/erc-xdcc.el
@@ -1,8 +1,9 @@
;;; erc-xdcc.el --- XDCC file-server support for ERC
-;; Copyright (C) 2003-2004, 2006-2011 Free Software Foundation, Inc.
+;; 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.
@@ -29,13 +30,13 @@
(require 'erc-dcc)
(defcustom erc-xdcc-files nil
- "*List of files to offer via XDCC.
+ "List of files to offer via XDCC.
Your friends should issue \"/ctcp yournick XDCC list\" to see this."
:group 'erc-dcc
:type '(repeat file))
(defcustom erc-xdcc-verbose-flag t
- "*Report XDCC CTCP requests in the server buffer."
+ "Report XDCC CTCP requests in the server buffer."
:group 'erc-dcc
:type 'boolean)
@@ -43,7 +44,7 @@ Your friends should issue \"/ctcp yournick XDCC list\" to see this."
'(("help" . erc-xdcc-help)
("list" . erc-xdcc-list)
("send" . erc-xdcc-send))
- "*Sub-command handler alist for XDCC CTCP queries."
+ "Sub-command handler alist for XDCC CTCP queries."
:group 'erc-dcc
:type '(alist :key-type (string :tag "Sub-command") :value-type function))
@@ -54,7 +55,7 @@ Your friends should issue \"/ctcp yournick XDCC list\" to see this."
("Type \"/ctcp " (erc-current-nick)
" XDCC list\" to see the list of offered files, then type \"/ctcp "
(erc-current-nick) " XDCC send #\" to get a particular file number."))
- "*Help text sent in response to XDCC help command.
+ "Help text sent in response to XDCC help command.
A list of messages, each consisting of strings and expressions, expressions
being evaluated and should return strings."
:group 'erc-dcc
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 0eff33f1e75..cec9718e751 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1,6 +1,6 @@
;; erc.el --- An Emacs Internet Relay Chat client
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Author: Alexander L. Belikoff (alexander@belikoff.net)
;; Contributors: Sergey Berezin (sergey.berezin@cs.cmu.edu),
@@ -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
@@ -67,10 +67,11 @@
(defconst erc-version-string "Version 5.3"
"ERC version. This is used by function `erc-version'.")
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'font-lock)
(require 'pp)
(require 'thingatpt)
+(require 'auth-source)
(require 'erc-compat)
(defvar erc-official-location
@@ -99,6 +100,11 @@
"Ignoring certain messages"
:group 'erc)
+(defgroup erc-lurker nil
+ "Hide specified message types sent by lurkers"
+ :version "24.3"
+ :group 'erc-ignore)
+
(defgroup erc-query nil
"Using separate buffers for private discussions"
:group 'erc)
@@ -134,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
@@ -255,7 +261,7 @@ If nil, only \"> \" will be shown."
(repeat :inline t :tag "Others" (string :tag "IRC Message Type"))))
(defcustom erc-hide-list nil
- "*List of IRC type messages to hide.
+ "List of IRC type messages to hide.
A typical value would be '(\"JOIN\" \"PART\" \"QUIT\")."
:group 'erc-ignore
:type 'erc-message-type)
@@ -356,15 +362,14 @@ nicknames with erc-server-user struct instances.")
(defmacro erc-with-server-buffer (&rest body)
"Execute BODY in the current ERC server buffer.
If no server buffer exists, return nil."
+ (declare (indent 0) (debug (body)))
(let ((buffer (make-symbol "buffer")))
`(let ((,buffer (erc-server-buffer)))
(when (buffer-live-p ,buffer)
(with-current-buffer ,buffer
,@body)))))
-(put 'erc-with-server-buffer 'lisp-indent-function 0)
-(put 'erc-with-server-buffer 'edebug-form-spec '(body))
-(defstruct (erc-server-user (:type vector) :named)
+(cl-defstruct (erc-server-user (:type vector) :named)
;; User data
nickname host login full-name info
;; Buffers
@@ -374,7 +379,7 @@ If no server buffer exists, return nil."
(buffers nil)
)
-(defstruct (erc-channel-user (:type vector) :named)
+(cl-defstruct (erc-channel-user (:type vector) :named)
op voice
;; Last message time (in the form of the return value of
;; (current-time)
@@ -653,12 +658,12 @@ This only has any meaning if the variable `erc-command-indicator' is non-nil."
prompt))))
(defcustom erc-notice-prefix "*** "
- "*Prefix for all notices."
+ "Prefix for all notices."
:group 'erc-display
:type 'string)
(defcustom erc-notice-highlight-type 'all
- "*Determines how to highlight notices.
+ "Determines how to highlight notices.
See `erc-notice-prefix'.
The following values are allowed:
@@ -673,7 +678,7 @@ Any other value disables notice's highlighting altogether."
(const :tag "don't highlight notices at all" nil)))
(defcustom erc-echo-notice-hook nil
- "*Specifies a list of functions to call to echo a private
+ "Specifies a list of functions to call to echo a private
notice. Each function is called with four arguments, the string
to display, the parsed server message, the target buffer (or
nil), and the sender. The functions are called in order, until a
@@ -704,7 +709,7 @@ See also: `erc-echo-notice-always-hook',
(defcustom erc-echo-notice-always-hook
'(erc-echo-notice-in-default-buffer)
- "*Specifies a list of functions to call to echo a private
+ "Specifies a list of functions to call to echo a private
notice. Each function is called with four arguments, the string
to display, the parsed server message, the target buffer (or
nil), and the sender. The functions are called in order, and all
@@ -736,17 +741,17 @@ See also: `erc-echo-notice-hook',
;; other tunable parameters
(defcustom erc-whowas-on-nosuchnick nil
- "*If non-nil, do a whowas on a nick if no such nick."
+ "If non-nil, do a whowas on a nick if no such nick."
:group 'erc
:type 'boolean)
(defcustom erc-verbose-server-ping nil
- "*If non-nil, show every time you get a PING or PONG from the server."
+ "If non-nil, show every time you get a PING or PONG from the server."
:group 'erc-paranoia
:type 'boolean)
(defcustom erc-public-away-p nil
- "*Let others know you are back when you are no longer marked away.
+ "Let others know you are back when you are no longer marked away.
This happens in this form:
* <nick> is back (gone for <time>)
@@ -755,7 +760,7 @@ Many consider it impolite to do so automatically."
:type 'boolean)
(defcustom erc-away-nickname nil
- "*The nickname to take when you are marked as being away."
+ "The nickname to take when you are marked as being away."
:group 'erc
:type '(choice (const nil)
string))
@@ -796,7 +801,7 @@ If nil, ERC will call `system-name' to get this information."
string))
(defcustom erc-ignore-list nil
- "*List of regexps matching user identifiers to ignore.
+ "List of regexps matching user identifiers to ignore.
A user identifier has the form \"nick!login@host\". If an
identifier matches, the message from the person will not be
@@ -806,7 +811,7 @@ processed."
(make-variable-buffer-local 'erc-ignore-list)
(defcustom erc-ignore-reply-list nil
- "*List of regexps matching user identifiers to ignore completely.
+ "List of regexps matching user identifiers to ignore completely.
This differs from `erc-ignore-list' in that it also ignores any
messages directed at the user.
@@ -824,7 +829,7 @@ people. You can update the ERC internal info using /WHO *."
:type '(repeat regexp))
(defvar erc-flood-protect t
- "*If non-nil, flood protection is enabled.
+ "If non-nil, flood protection is enabled.
Flooding is sending too much information to the server in too
short of an interval, which may cause the server to terminate the
connection.
@@ -854,7 +859,7 @@ directory in the list."
:type '(repeat directory))
(defcustom erc-script-echo t
- "*If non-nil, echo the IRC script commands locally."
+ "If non-nil, echo the IRC script commands locally."
:group 'erc-scripts
:type 'boolean)
@@ -929,7 +934,7 @@ will be used as the part message."
:type '(repeat (list regexp (choice (string) (function)))))
(defcustom erc-quit-reason 'erc-quit-reason-normal
- "*A function which returns the reason for quitting.
+ "A function which returns the reason for quitting.
The function is passed a single argument, the string typed by the
user after \"/quit\"."
@@ -1140,61 +1145,58 @@ which the local user typed."
"ERC default face."
:group 'erc-faces)
-(defface erc-direct-msg-face '((t (:foreground "IndianRed")))
+(defface erc-direct-msg-face '((t :foreground "IndianRed"))
"ERC face used for messages you receive in the main erc buffer."
:group 'erc-faces)
(defface erc-header-line
- '((t (:foreground "grey20" :background "grey90")))
+ '((t :foreground "grey20" :background "grey90"))
"ERC face used for the header line.
This will only be used if `erc-header-line-face-method' is non-nil."
:group 'erc-faces)
-(defface erc-input-face '((t (:foreground "brown")))
+(defface erc-input-face '((t :foreground "brown"))
"ERC face used for your input."
:group 'erc-faces)
(defface erc-prompt-face
- '((t (:bold t :foreground "Black" :background "lightBlue2")))
+ '((t :weight bold :foreground "Black" :background "lightBlue2"))
"ERC face for the prompt."
:group 'erc-faces)
(defface erc-command-indicator-face
- '((t (:bold t)))
+ '((t :weight bold))
"ERC face for the command indicator.
See the variable `erc-command-indicator'."
:group 'erc-faces)
(defface erc-notice-face
- (if (or (featurep 'xemacs)
- (< emacs-major-version 22))
- '((t (:bold t :foreground "blue")))
- '((((class color) (min-colors 88))
- (:bold t :foreground "SlateBlue"))
- (t (:bold t :foreground "blue"))))
+ '((default :weight bold)
+ (((class color) (min-colors 88)) :foreground "SlateBlue")
+ (t :foreground "blue"))
"ERC face for notices."
:group 'erc-faces)
-(defface erc-action-face '((t (:bold t)))
+(defface erc-action-face '((t :weight bold))
"ERC face for actions generated by /ME."
:group 'erc-faces)
-(defface erc-error-face '((t (:foreground "red")))
+(defface erc-error-face '((t :foreground "red"))
"ERC face for errors."
:group 'erc-faces)
;; same default color as `erc-input-face'
-(defface erc-my-nick-face '((t (:bold t :foreground "brown")))
+(defface erc-my-nick-face '((t :weight bold :foreground "brown"))
"ERC face for your current nickname in messages sent by you.
See also `erc-show-my-nick'."
:group 'erc-faces)
-(defface erc-nick-default-face '((t (:bold t)))
+(defface erc-nick-default-face '((t :weight bold))
"ERC nickname default face."
:group 'erc-faces)
-(defface erc-nick-msg-face '((t (:bold t :foreground "IndianRed")))
+(defface erc-nick-msg-face '((t :weight bold :foreground "IndianRed"))
"ERC nickname face for private messages."
:group 'erc-faces)
@@ -1233,6 +1235,7 @@ Example:
'erc-replace-insert))
((remove-hook 'erc-insert-modify-hook
'erc-replace-insert)))"
+ (declare (doc-string 3))
(let* ((sn (symbol-name name))
(mode (intern (format "erc-%s-mode" (downcase sn))))
(group (intern (format "erc-%s" (downcase sn))))
@@ -1278,8 +1281,6 @@ if ARG is omitted or nil.
(put ',enable 'definition-name ',name)
(put ',disable 'definition-name ',name))))
-(put 'define-erc-module 'doc-string-elt 3)
-
(defun erc-once-with-server-event (event &rest forms)
"Execute FORMS the next time EVENT occurs in the `current-buffer'.
@@ -1331,10 +1332,10 @@ connection over which the data was received that triggered EVENT."
(add-hook hook fun nil nil)
fun))
-(defmacro erc-log (string)
+(defsubst erc-log (string)
"Logs STRING if logging is on (see `erc-log-p')."
- `(when erc-log-p
- (erc-log-aux ,string)))
+ (when erc-log-p
+ (erc-log-aux string)))
(defun erc-server-buffer ()
"Return the server buffer for the current buffer's process.
@@ -1385,7 +1386,7 @@ If BUFFER is nil, the current buffer is used."
t))
(erc-server-send (format "ISON %s" nick))
(while (eq erc-online-p 'unknown) (accept-process-output))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%s is %sonline"
(or erc-online-p nick)
(if erc-online-p "" "not "))
@@ -1480,7 +1481,7 @@ The available choices are:
(const :tag "Use current buffer" t)))
(defcustom erc-frame-alist nil
- "*Alist of frame parameters for creating erc frames.
+ "Alist of frame parameters for creating erc frames.
A value of nil means to use `default-frame-alist'."
:group 'erc-buffers
:type '(repeat (cons :format "%v"
@@ -1488,13 +1489,13 @@ A value of nil means to use `default-frame-alist'."
(sexp :tag "Value"))))
(defcustom erc-frame-dedicated-flag nil
- "*Non-nil means the erc frames are dedicated to that buffer.
+ "Non-nil means the erc frames are dedicated to that buffer.
This only has effect when `erc-join-buffer' is set to `frame'."
:group 'erc-buffers
:type 'boolean)
(defcustom erc-reuse-frames t
- "*Determines whether new frames are always created.
+ "Determines whether new frames are always created.
Non-nil means that a new frame is not created to display an ERC
buffer if there is already a window displaying it. This only has
effect when `erc-join-buffer' is set to `frame'."
@@ -1511,7 +1512,7 @@ effect when `erc-join-buffer' is set to `frame'."
(t nil)))
(defcustom erc-reuse-buffers t
- "*If nil, create new buffers on joining a channel/query.
+ "If nil, create new buffers on joining a channel/query.
If non-nil, a new buffer will only be created when you join
channels with same names on different servers, or have query buffers
open with nicks of the same name on different servers. Otherwise,
@@ -1618,6 +1619,7 @@ See `erc-get-buffer' for details.
See also `with-current-buffer'.
\(fn (TARGET [PROCESS]) BODY...)"
+ (declare (indent 1) (debug ((form &optional form) body)))
(let ((buf (make-symbol "buf"))
(proc (make-symbol "proc"))
(target (make-symbol "target"))
@@ -1634,8 +1636,6 @@ See also `with-current-buffer'.
(when (buffer-live-p ,buf)
(with-current-buffer ,buf
,@body)))))
-(put 'erc-with-buffer 'lisp-indent-function 1)
-(put 'erc-with-buffer 'edebug-form-spec '((form &optional form) body))
(defun erc-get-buffer (target &optional proc)
"Return the buffer matching TARGET in the process PROC.
@@ -1685,6 +1685,7 @@ needs to match PROC."
FORMS will be evaluated in all buffers having the process PROCESS and
where PRED matches or in all buffers of the server process if PRED is
nil."
+ (declare (indent 1) (debug (form form body)))
;; Make the evaluation have the correct order
(let ((pre (make-symbol "pre"))
(pro (make-symbol "pro")))
@@ -1698,8 +1699,6 @@ nil."
;; Silence the byte-compiler by binding the result of mapcar to
;; a variable.
res)))
-(put 'erc-with-all-buffers-of-server 'lisp-indent-function 1)
-(put 'erc-with-all-buffers-of-server 'edebug-form-spec '(form form body))
;; (iswitchb-mode) will autoload iswitchb.el
(defvar iswitchb-temp-buflist)
@@ -1844,7 +1843,7 @@ removed from the list will be disabled."
capab-identify)
(const :tag "completion: Complete nicknames and commands (programmable)"
completion)
- (const :tag "hecomplete: Complete nicknames and commands (old)" hecomplete)
+ (const :tag "hecomplete: Complete nicknames and commands (obsolete, use \"completion\")" hecomplete)
(const :tag "dcc: Provide Direct Client-to-Client support" dcc)
(const :tag "fill: Wrap long lines" fill)
(const :tag "identd: Launch an identd server on port 8113" identd)
@@ -1864,6 +1863,8 @@ removed from the list will be disabled."
(const :tag
"notify: Notify when the online status of certain users changes"
notify)
+ (const :tag "notifications: Send notifications on PRIVMSG or nickname mentions"
+ notifications)
(const :tag "page: Process CTCP PAGE requests from IRC" page)
(const :tag "readonly: Make displayed lines read-only" readonly)
(const :tag "replace: Replace text in messages" replace)
@@ -2009,7 +2010,19 @@ Returns the buffer for the given server or channel."
;; The local copy of `erc-nick' - the list of nicks to choose
(setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
;; password stuff
- (setq erc-session-password passwd)
+ (setq erc-session-password (or passwd
+ (let ((secret
+ (plist-get
+ (nth 0
+ (auth-source-search :host server
+ :max 1
+ :user nick
+ :port port
+ :require '(:secret)))
+ :secret)))
+ (if (functionp secret)
+ (funcall secret)
+ secret))))
;; debug output buffer
(setq erc-dbuf
(when erc-log-p
@@ -2144,11 +2157,11 @@ functions in here get called with the parameters SERVER and NICK."
(list :server server :port port :nick nick :password passwd)))
;;;###autoload
-(defun* erc (&key (server (erc-compute-server))
- (port (erc-compute-port))
- (nick (erc-compute-nick))
- password
- (full-name (erc-compute-full-name)))
+(cl-defun erc (&key (server (erc-compute-server))
+ (port (erc-compute-port))
+ (nick (erc-compute-nick))
+ password
+ (full-name (erc-compute-full-name)))
"ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC.
@@ -2175,6 +2188,7 @@ be invoked for the values of the other parameters."
(defalias 'erc-select 'erc)
(defalias 'erc-ssl 'erc-tls)
+;;;###autoload
(defun erc-tls (&rest r)
"Interactively select TLS connection parameters and run ERC.
Arguments are the same as for `erc'."
@@ -2369,24 +2383,24 @@ If STRING is nil, the function does nothing."
(while list
(setq elt (car list))
(cond ((integerp elt) ; POSITION
- (incf (car list) shift))
+ (cl-incf (car list) shift))
((or (atom elt) ; nil, EXTENT
;; (eq t (car elt)) ; (t . TIME)
(markerp (car elt))) ; (MARKER . DISTANCE)
nil)
((integerp (car elt)) ; (BEGIN . END)
- (incf (car elt) shift)
- (incf (cdr elt) shift))
+ (cl-incf (car elt) shift)
+ (cl-incf (cdr elt) shift))
((stringp (car elt)) ; (TEXT . POSITION)
- (incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift)))
+ (cl-incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift)))
((null (car elt)) ; (nil PROPERTY VALUE BEG . END)
(let ((cons (nthcdr 3 elt)))
- (incf (car cons) shift)
- (incf (cdr cons) shift)))
+ (cl-incf (car cons) shift)
+ (cl-incf (cdr cons) shift)))
((and (featurep 'xemacs)
(extentp (car elt))) ; (EXTENT START END)
- (incf (nth 1 elt) shift)
- (incf (nth 2 elt) shift)))
+ (cl-incf (nth 1 elt) shift)
+ (cl-incf (nth 2 elt) shift)))
(setq list (cdr list))))))
(defvar erc-valid-nick-regexp "[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*"
@@ -2444,6 +2458,186 @@ See also `erc-make-notice'."
string)
string)))
+(defvar erc-lurker-state nil
+ "Track the time of the last PRIVMSG for each (server,nick) pair.
+
+This is implemented as a hash of hashes, where the outer key is
+the canonicalized server name (as returned by
+`erc-canonicalize-server-name') and the outer value is a hash
+table mapping nicks (as returned by `erc-lurker-maybe-trim') to
+the times of their most recently received PRIVMSG on any channel
+on the given server.")
+
+(defcustom erc-lurker-trim-nicks t
+ "If t, trim trailing `erc-lurker-ignore-chars' from nicks.
+
+This causes e.g. nick and nick` to be considered as the same
+individual for activity tracking and lurkiness detection
+purposes."
+ :group 'erc-lurker
+ :type 'boolean)
+
+(defcustom erc-lurker-ignore-chars "`_"
+ "Characters at the end of a nick to strip for activity tracking purposes.
+
+See also `erc-lurker-trim-nicks'."
+ :group 'erc-lurker
+ :type 'string)
+
+(defun erc-lurker-maybe-trim (nick)
+ "Maybe trim trailing `erc-lurker-ignore-chars' from NICK.
+
+Returns NICK unmodified unless `erc-lurker-trim-nicks' is
+non-nil."
+ (if erc-lurker-trim-nicks
+ (replace-regexp-in-string
+ (format "[%s]"
+ (mapconcat (lambda (char)
+ (regexp-quote (char-to-string char)))
+ erc-lurker-ignore-chars ""))
+ "" nick)
+ nick))
+
+(defcustom erc-lurker-hide-list nil
+ "List of IRC type messages to hide when sent by lurkers.
+
+A typical value would be '(\"JOIN\" \"PART\" \"QUIT\").
+See also `erc-lurker-p' and `erc-hide-list'."
+ :group 'erc-lurker
+ :type 'erc-message-type)
+
+(defcustom erc-lurker-threshold-time (* 60 60 24) ; 24h by default
+ "Nicks from which no PRIVMSGs have been received within this
+interval (in units of seconds) are considered lurkers by
+`erc-lurker-p' and as a result their messages of types in
+`erc-lurker-hide-list' will be hidden."
+ :group 'erc-lurker
+ :type 'integer)
+
+(defun erc-lurker-initialize ()
+ "Initialize ERC lurker tracking functionality.
+
+This function adds `erc-lurker-update-status' to
+`erc-insert-pre-hook' in order to record the time of each nick's
+most recent PRIVMSG as well as initializing the state variable
+storing this information."
+ (setq erc-lurker-state (make-hash-table :test 'equal))
+ (add-hook 'erc-insert-pre-hook 'erc-lurker-update-status))
+
+(defun erc-lurker-cleanup ()
+ "Remove all last PRIVMSG state older than `erc-lurker-threshold-time'.
+
+This should be called regularly to avoid excessive resource
+consumption for long-lived IRC or Emacs sessions."
+ (maphash
+ (lambda (server hash)
+ (maphash
+ (lambda (nick last-PRIVMSG-time)
+ (when
+ (> (time-to-seconds (time-subtract
+ (current-time)
+ last-PRIVMSG-time))
+ erc-lurker-threshold-time)
+ (remhash nick hash)))
+ hash)
+ (if (zerop (hash-table-count hash))
+ (remhash server erc-lurker-state)))
+ erc-lurker-state))
+
+(defvar erc-lurker-cleanup-count 0
+ "Internal counter variable for use with `erc-lurker-cleanup-interval'.")
+
+(defvar erc-lurker-cleanup-interval 100
+ "Specifies frequency of cleaning up stale erc-lurker state.
+
+`erc-lurker-update-status' calls `erc-lurker-cleanup' once for
+every `erc-lurker-cleanup-interval' updates to
+`erc-lurker-state'. This is designed to limit the memory
+consumption of lurker state during long Emacs sessions and/or ERC
+sessions with large numbers of incoming PRIVMSGs.")
+
+(defun erc-lurker-update-status (message)
+ "Update `erc-lurker-state' if necessary.
+
+This function is called from `erc-insert-pre-hook'. If the
+current message is a PRIVMSG, update `erc-lurker-state' to
+reflect the fact that its sender has issued a PRIVMSG at the
+current time. Otherwise, take no action.
+
+This function depends on the fact that `erc-display-message'
+dynamically binds `parsed', which is used to check if the current
+message is a PRIVMSG and to determine its sender. See also
+`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'.
+
+In order to limit memory consumption, this function also calls
+`erc-lurker-cleanup' once every `erc-lurker-cleanup-interval'
+updates of `erc-lurker-state'."
+ (when (and (boundp 'parsed) (erc-response-p parsed))
+ (let* ((command (erc-response.command parsed))
+ (sender
+ (erc-lurker-maybe-trim
+ (car (erc-parse-user (erc-response.sender parsed)))))
+ (server
+ (erc-canonicalize-server-name erc-server-announced-name)))
+ (when (equal command "PRIVMSG")
+ (when (>= (cl-incf erc-lurker-cleanup-count)
+ erc-lurker-cleanup-interval)
+ (setq erc-lurker-cleanup-count 0)
+ (erc-lurker-cleanup))
+ (unless (gethash server erc-lurker-state)
+ (puthash server (make-hash-table :test 'equal) erc-lurker-state))
+ (puthash sender (current-time)
+ (gethash server erc-lurker-state))))))
+
+(defun erc-lurker-p (nick)
+ "Predicate indicating NICK's lurking status on the current server.
+
+Lurking is the condition where NICK has issued no PRIVMSG on this
+server within `erc-lurker-threshold-time'. See also
+`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'."
+ (unless erc-lurker-state (erc-lurker-initialize))
+ (let* ((server
+ (erc-canonicalize-server-name erc-server-announced-name))
+ (last-PRIVMSG-time
+ (gethash (erc-lurker-maybe-trim nick)
+ (gethash server erc-lurker-state (make-hash-table)))))
+ (or (null last-PRIVMSG-time)
+ (> (time-to-seconds
+ (time-subtract (current-time) last-PRIVMSG-time))
+ erc-lurker-threshold-time))))
+
+(defcustom erc-common-server-suffixes
+ '(("openprojects.net$" . "OPN")
+ ("freenode.net$" . "freenode")
+ ("oftc.net$" . "OFTC"))
+ "Alist of common server name suffixes.
+This variable is used in mode-line display to save screen
+real estate. Set it to nil if you want to avoid changing
+displayed hostnames."
+ :group 'erc-mode-line-and-header
+ :type 'alist)
+
+(defun erc-canonicalize-server-name (server)
+ "Returns the canonical network name for SERVER if any,
+otherwise `erc-server-announced-name'. SERVER is matched against
+`erc-common-server-suffixes'."
+ (when server
+ (or (cdar (erc-remove-if-not
+ (lambda (net) (string-match (car net) server))
+ erc-common-server-suffixes))
+ erc-server-announced-name)))
+
+(defun erc-hide-current-message-p (parsed)
+ "Predicate indicating whether the parsed ERC response PARSED should be hidden.
+
+Messages are always hidden if the message type of PARSED appears in
+`erc-hide-list'. In addition, messages whose type is a member of
+`erc-lurker-hide-list' are hidden if `erc-lurker-p' returns true."
+ (let* ((command (erc-response.command parsed))
+ (sender (car (erc-parse-user (erc-response.sender parsed)))))
+ (or (member command erc-hide-list)
+ (and (member command erc-lurker-hide-list) (erc-lurker-p sender)))))
+
(defun erc-display-message (parsed type buffer msg &rest args)
"Display MSG in BUFFER.
@@ -2468,7 +2662,7 @@ See also `erc-format-message' and `erc-display-line'."
(if (not (erc-response-p parsed))
(erc-display-line string buffer)
- (unless (member (erc-response.command parsed) erc-hide-list)
+ (unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
(erc-put-text-property 0 (length string) 'rear-sticky t string)
(erc-display-line string buffer)))))
@@ -2615,7 +2809,7 @@ VALUE is computed by evaluating the rest of LINE in Lisp."
(if (consp val)
(concat "\n" (pp-to-string val))
(format " %S\n" val)))))
- (apropos-internal "^erc-" 'user-variable-p))))
+ (apropos-internal "^erc-" 'custom-variable-p))))
(current-buffer)) t)
(t nil)))
(defalias 'erc-cmd-VAR 'erc-cmd-SET)
@@ -2933,37 +3127,37 @@ If SERVER is non-nil, use that, rather than the current server."
(add-to-list 'symlist
(cons (erc-once-with-server-event
311 `(string= ,nick
- (second
+ (nth 1
(erc-response.command-args parsed))))
'erc-server-311-functions))
(add-to-list 'symlist
(cons (erc-once-with-server-event
312 `(string= ,nick
- (second
+ (nth 1
(erc-response.command-args parsed))))
'erc-server-312-functions))
(add-to-list 'symlist
(cons (erc-once-with-server-event
318 `(string= ,nick
- (second
+ (nth 1
(erc-response.command-args parsed))))
'erc-server-318-functions))
(add-to-list 'symlist
(cons (erc-once-with-server-event
319 `(string= ,nick
- (second
+ (nth 1
(erc-response.command-args parsed))))
'erc-server-319-functions))
(add-to-list 'symlist
(cons (erc-once-with-server-event
320 `(string= ,nick
- (second
+ (nth 1
(erc-response.command-args parsed))))
'erc-server-320-functions))
(add-to-list 'symlist
(cons (erc-once-with-server-event
330 `(string= ,nick
- (second
+ (nth 1
(erc-response.command-args parsed))))
'erc-server-330-functions))
(add-to-list 'symlist
@@ -3645,6 +3839,7 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
'start-open t ; XEmacs
'rear-nonsticky t ; Emacs
'erc-prompt t
+ 'field t
'front-sticky t
'read-only t))
(erc-put-text-property 0 (1- (length prompt))
@@ -3798,7 +3993,7 @@ This places `point' just after the prompt, or at the beginning of the line."
(defcustom erc-default-server-hook '(erc-debug-missing-hooks
erc-default-server-handler)
- "*Default for server messages which aren't covered by `erc-server-hooks'."
+ "Default for server messages which aren't covered by `erc-server-hooks'."
:group 'erc-server-hooks
:type 'hook)
@@ -4016,7 +4211,7 @@ and as second argument the event parsed as a vector."
str))
(defcustom erc-format-nick-function 'erc-format-nick
- "*Function to format a nickname for message display."
+ "Function to format a nickname for message display."
:group 'erc-display
:type 'function)
@@ -4145,8 +4340,8 @@ See also: `erc-echo-notice-in-user-buffers',
(defun erc-banlist-store (proc parsed)
"Record ban entries for a channel."
- (multiple-value-bind (channel mask whoset)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,channel ,mask ,whoset)
+ (cdr (erc-response.command-args parsed))))
;; Determine to which buffer the message corresponds
(let ((buffer (erc-get-buffer channel proc)))
(with-current-buffer buffer
@@ -4157,7 +4352,7 @@ See also: `erc-echo-notice-in-user-buffers',
(defun erc-banlist-finished (proc parsed)
"Record that we have received the banlist."
- (let* ((channel (second (erc-response.command-args parsed)))
+ (let* ((channel (nth 1 (erc-response.command-args parsed)))
(buffer (erc-get-buffer channel proc)))
(with-current-buffer buffer
(put 'erc-channel-banlist 'received-from-server t)))
@@ -4166,7 +4361,7 @@ See also: `erc-echo-notice-in-user-buffers',
(defun erc-banlist-update (proc parsed)
"Check MODE commands for bans and update the banlist appropriately."
;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11
- (let* ((tgt (first (erc-response.command-args parsed)))
+ (let* ((tgt (car (erc-response.command-args parsed)))
(mode (erc-response.contents parsed))
(whoset (erc-response.sender parsed))
(buffer (erc-get-buffer tgt proc)))
@@ -4574,7 +4769,7 @@ channel."
(run-hooks 'erc-channel-members-changed-hook)))
(defcustom erc-channel-members-changed-hook nil
- "*This hook is called every time the variable `channel-members' changes.
+ "This hook is called every time the variable `channel-members' changes.
The buffer where the change happened is current while this hook is called."
:group 'erc-hooks
:type 'hook)
@@ -5817,7 +6012,7 @@ entry of `channel-members'."
(if cuser
(setq op (erc-channel-user-op cuser)
voice (erc-channel-user-voice cuser)))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%s is %s@%s%s%s"
nick login host
(if full-name (format " (%s)" full-name) "")
@@ -5905,17 +6100,6 @@ Otherwise, use the `erc-header-line' face."
:group 'erc-paranoia
:type 'boolean)
-(defcustom erc-common-server-suffixes
- '(("openprojects.net$" . "OPN")
- ("freenode.net$" . "freenode")
- ("oftc.net$" . "OFTC"))
- "Alist of common server name suffixes.
-This variable is used in mode-line display to save screen
-real estate. Set it to nil if you want to avoid changing
-displayed hostnames."
- :group 'erc-mode-line-and-header
- :type 'alist)
-
(defcustom erc-mode-line-away-status-format
"(AWAY since %a %b %d %H:%M) "
"When you're away on a server, this is shown in the mode line.
@@ -6119,7 +6303,7 @@ If optional argument HERE is non-nil, insert version number at point."
(format "ERC %s (GNU Emacs %s)" erc-version-string emacs-version)))
(if here
(insert version-string)
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%s" version-string)
version-string))))
@@ -6139,7 +6323,7 @@ If optional argument HERE is non-nil, insert version number at point."
", ")))
(if here
(insert string)
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%s" string)
string))))
@@ -6385,17 +6569,17 @@ See also `format-spec'."
(add-hook 'kill-buffer-hook 'erc-kill-buffer-function)
(defcustom erc-kill-server-hook '(erc-kill-server)
- "*Invoked whenever a server-buffer is killed via `kill-buffer'."
+ "Invoked whenever a server-buffer is killed via `kill-buffer'."
:group 'erc-hooks
:type 'hook)
(defcustom erc-kill-channel-hook '(erc-kill-channel)
- "*Invoked whenever a channel-buffer is killed via `kill-buffer'."
+ "Invoked whenever a channel-buffer is killed via `kill-buffer'."
:group 'erc-hooks
:type 'hook)
(defcustom erc-kill-buffer-hook nil
- "*Hook run whenever a non-server or channel buffer is killed.
+ "Hook run whenever a non-server or channel buffer is killed.
See also `kill-buffer'."
:group 'erc-hooks
diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el
index 04ba19d407d..940056b6438 100644
--- a/lisp/eshell/em-alias.el
+++ b/lisp/eshell/em-alias.el
@@ -1,6 +1,6 @@
;;; em-alias.el --- creation and management of command aliases
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -95,11 +95,12 @@
(require 'eshell)
;;;###autoload
-(eshell-defgroup eshell-alias nil
+(progn
+(defgroup eshell-alias nil
"Command aliases allow for easy definition of alternate commands."
:tag "Command aliases"
;; :link '(info-link "(eshell)Command aliases")
- :group 'eshell-module)
+ :group 'eshell-module))
(defcustom eshell-aliases-file (expand-file-name "alias" eshell-directory-name)
"The file in which aliases are kept.
@@ -132,10 +133,10 @@ Each element of this alias is a list of the form:
Where NAME is the textual name of the alias, and DEFINITION is the
command string to replace that command with.
-Note: this list should not be modified in your '.emacs' file. Rather,
-any desired alias definitions should be declared using the `alias'
-command, which will automatically write them to the file named by
-`eshell-aliases-file'.")
+Note: this list should not be modified in your init file.
+Rather, any desired alias definitions should be declared using
+the `alias' command, which will automatically write them to the
+file named by `eshell-aliases-file'.")
(put 'eshell-command-aliases-list 'risky-local-variable t)
diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el
index ce987f132e3..8fdad66f3f0 100644
--- a/lisp/eshell/em-banner.el
+++ b/lisp/eshell/em-banner.el
@@ -1,6 +1,6 @@
;;; em-banner.el --- sample module that displays a login banner
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -39,20 +39,21 @@
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'esh-mode)
(require 'eshell))
(require 'esh-util)
;;;###autoload
-(eshell-defgroup eshell-banner nil
+(progn
+(defgroup eshell-banner nil
"This sample module displays a welcome banner at login.
It exists so that others wishing to create their own Eshell extension
modules may have a simple template to begin with."
:tag "Login banner"
;; :link '(info-link "(eshell)Login banner")
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
@@ -76,10 +77,10 @@ This can be any sexp, and should end with at least two newlines."
;; `insert', because `insert' doesn't know how to interact with the
;; I/O code used by Eshell
(unless eshell-non-interactive-p
- (assert eshell-mode)
- (assert eshell-banner-message)
+ (cl-assert eshell-mode)
+ (cl-assert eshell-banner-message)
(let ((msg (eval eshell-banner-message)))
- (assert msg)
+ (cl-assert msg)
(eshell-interactive-print msg))))
(provide 'em-banner)
diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el
index df1987e13ee..e07bc75f89a 100644
--- a/lisp/eshell/em-basic.el
+++ b/lisp/eshell/em-basic.el
@@ -1,6 +1,6 @@
;;; em-basic.el --- basic shell builtin commands
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -66,14 +66,15 @@
(require 'esh-opt)
;;;###autoload
-(eshell-defgroup eshell-basic nil
+(progn
+(defgroup eshell-basic nil
"The \"basic\" code provides a set of convenience functions which
are traditionally considered shell builtins. Since all of the
functionality provided by them is accessible through Lisp, they are
not really builtins at all, but offer a command-oriented way to do the
same thing."
:tag "Basic shell commands"
- :group 'eshell-module)
+ :group 'eshell-module))
(defcustom eshell-plain-echo-behavior nil
"If non-nil, `echo' tries to behave like an ordinary shell echo.
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index c551684210c..b4c86e39e86 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -1,6 +1,6 @@
;;; em-cmpl.el --- completion using the TAB key
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -70,17 +70,18 @@
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'eshell))
(require 'esh-util)
;;;###autoload
-(eshell-defgroup eshell-cmpl nil
+(progn
+(defgroup eshell-cmpl nil
"This module provides a programmable completion function bound to
the TAB key, which allows for completing command names, file names,
variable names, arguments, etc."
:tag "Argument completion"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
@@ -294,13 +295,14 @@ to writing a completion function."
'pcomplete-expand-and-complete)
(define-key eshell-command-map [space] 'pcomplete-expand)
(define-key eshell-command-map [? ] 'pcomplete-expand)
- (define-key eshell-mode-map [tab] 'pcomplete)
- (define-key eshell-mode-map [(control ?i)] 'pcomplete)
+ (define-key eshell-mode-map [tab] 'eshell-pcomplete)
+ (define-key eshell-mode-map [(control ?i)] 'eshell-pcomplete)
+ (add-hook 'completion-at-point-functions
+ #'pcomplete-completions-at-point nil t)
;; jww (1999-10-19): Will this work on anything but X?
(if (featurep 'xemacs)
(define-key eshell-mode-map [iso-left-tab] 'pcomplete-reverse)
- (define-key eshell-mode-map [(shift iso-lefttab)] 'pcomplete-reverse)
- (define-key eshell-mode-map [(shift control ?i)] 'pcomplete-reverse))
+ (define-key eshell-mode-map [backtab] 'pcomplete-reverse))
(define-key eshell-mode-map [(meta ??)] 'pcomplete-list))
(defun eshell-completion-command-name ()
@@ -358,7 +360,7 @@ to writing a completion function."
(nconc posns (list pos)))
(setq pos (1+ pos))))
(setq posns (cdr posns))
- (assert (= (length args) (length posns)))
+ (cl-assert (= (length args) (length posns)))
(let ((a args)
(i 0)
l final)
@@ -370,7 +372,7 @@ to writing a completion function."
(and l
(setq args (nthcdr (1+ l) args)
posns (nthcdr (1+ l) posns))))
- (assert (= (length args) (length posns)))
+ (cl-assert (= (length args) (length posns)))
(when (and args (eq (char-syntax (char-before end)) ? )
(not (eq (char-before (1- end)) ?\\)))
(nconc args (list ""))
@@ -383,7 +385,7 @@ to writing a completion function."
(let ((result
(eshell-do-eval
(list 'eshell-commands arg) t)))
- (assert (eq (car result) 'quote))
+ (cl-assert (eq (car result) 'quote))
(cadr result))
arg)))
(if (numberp val)
@@ -449,6 +451,13 @@ to writing a completion function."
(all-completions filename obarray 'functionp))
completions)))))))
+(defun eshell-pcomplete ()
+ "Eshell wrapper for `pcomplete'."
+ (interactive)
+ (condition-case nil
+ (pcomplete)
+ (text-read-only (completion-at-point)))) ; Workaround for bug#12838.
+
(provide 'em-cmpl)
;; Local Variables:
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index cab84951143..4a3fa54626b 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -1,6 +1,6 @@
;;; em-dirs.el --- directory navigation commands
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -47,14 +47,15 @@
(require 'esh-opt)
;;;###autoload
-(eshell-defgroup eshell-dirs nil
+(progn
+(defgroup eshell-dirs nil
"Directory navigation involves changing directories, examining the
current directory, maintaining a directory stack, and also keeping
track of a history of the last directory locations the user was in.
Emacs does provide standard Lisp definitions of `pwd' and `cd', but
they lack somewhat in feel from the typical shell equivalents."
:tag "Directory navigation"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index df1f7b67e29..288aa9b773b 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -1,6 +1,6 @@
;;; em-glob.el --- extended file name globbing
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -53,11 +53,12 @@
(require 'esh-util)
;;;###autoload
-(eshell-defgroup eshell-glob nil
+(progn
+(defgroup eshell-glob nil
"This module provides extended globbing syntax, similar what is used
by zsh for filename generation."
:tag "Extended filename globbing"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 5e44e541526..64a7ad94c53 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -1,6 +1,6 @@
;;; em-hist.el --- history list management
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -54,8 +54,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'ring)
(require 'esh-opt)
@@ -63,10 +62,11 @@
(require 'eshell)
;;;###autoload
-(eshell-defgroup eshell-hist nil
+(progn
+(defgroup eshell-hist nil
"This module provides command history management."
:tag "History list management"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
@@ -559,8 +559,8 @@ See also `eshell-read-history'."
(forward-char))
(setq posb (cdr posb)
pose (cdr pose))
- (assert (= (length posb) (length args)))
- (assert (<= (length posb) (length pose))))
+ (cl-assert (= (length posb) (length args)))
+ (cl-assert (<= (length posb) (length pose))))
(setq hist (buffer-substring-no-properties begin end))
(let ((b posb) (e pose))
(while b
@@ -570,7 +570,7 @@ See also `eshell-read-history'."
(setq b (cdr b)
e (cdr e))))
(setq textargs (cdr textargs))
- (assert (= (length textargs) (length args)))
+ (cl-assert (= (length textargs) (length args)))
(list textargs posb pose))))
(defun eshell-expand-history-references (beg end)
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 17dbe3fbaf2..2dd92ba3530 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -1,6 +1,6 @@
;;; em-ls.el --- implementation of ls in Lisp
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -27,20 +27,21 @@
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'eshell))
(require 'esh-util)
(require 'esh-opt)
;;;###autoload
-(eshell-defgroup eshell-ls nil
+(progn
+(defgroup eshell-ls nil
"This module implements the \"ls\" utility fully in Lisp. If it is
passed any unrecognized command switches, it will revert to the
operating system's version. This version of \"ls\" uses text
properties to colorize its output based on the setting of
`eshell-ls-use-colors'."
:tag "Implementation of `ls' in Lisp"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
@@ -61,6 +62,7 @@ properties to colorize its output based on the setting of
"How to display time information in `eshell-ls-file'.
This is passed to `format-time-string' as a format string.
To display the date using the current locale, use \"%b \%e\"."
+ :version "24.1"
:type 'string
:group 'eshell-ls)
@@ -310,7 +312,7 @@ instead."
(let ((insert-func 'eshell-buffered-print)
(error-func 'eshell-error)
(flush-func 'eshell-flush))
- (eshell-do-ls args)))
+ (apply 'eshell-do-ls args)))
(put 'eshell/ls 'eshell-no-numeric-conversions t)
@@ -461,7 +463,7 @@ name should be displayed as, etc. Think of it as cooking a FILEINFO."
(progn
(setcdr fileinfo attr)
(setcar fileinfo (eshell-ls-decorated-name fileinfo)))
- (assert (eq listing-style 'long-listing))
+ (cl-assert (eq listing-style 'long-listing))
(setcar fileinfo
(concat (eshell-ls-decorated-name fileinfo) " -> "
(eshell-ls-decorated-name
@@ -696,7 +698,7 @@ Each member of FILES is either a string or a cons cell of the form
(let* ((col-vals
(if (eq listing-style 'by-columns)
(eshell-ls-find-column-lengths display-files)
- (assert (eq listing-style 'by-lines))
+ (cl-assert (eq listing-style 'by-lines))
(eshell-ls-find-column-widths display-files)))
(col-widths (car col-vals))
(display-files (cdr col-vals))
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index e45b36e3511..fc23c0099e8 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -1,6 +1,6 @@
;;; em-pred.el --- argument predicates and modifiers (ala zsh)
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -49,13 +49,14 @@
(eval-when-compile (require 'eshell))
;;;###autoload
-(eshell-defgroup eshell-pred nil
+(progn
+(defgroup eshell-pred nil
"This module allows for predicates to be applied to globbing
patterns (similar to zsh), in addition to string modifiers which can
be applied either to globbing results, variable references, or just
ordinary strings."
:tag "Value modifiers and predicates"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index 3e87acc6d1e..f4701ec35ea 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -1,6 +1,6 @@
;;; em-prompt.el --- command prompts
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -29,11 +29,12 @@
(eval-when-compile (require 'eshell))
;;;###autoload
-(eshell-defgroup eshell-prompt nil
+(progn
+(defgroup eshell-prompt nil
"This module provides command prompts, and navigation between them,
as is common with most shells."
:tag "Command prompts"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
@@ -69,9 +70,9 @@ re-entered for it to take effect."
:group 'eshell-prompt)
(defface eshell-prompt
- '((((class color) (background light)) (:foreground "Red" :bold t))
- (((class color) (background dark)) (:foreground "Pink" :bold t))
- (t (:bold t)))
+ '((default :weight bold)
+ (((class color) (background light)) :foreground "Red")
+ (((class color) (background dark)) :foreground "Pink"))
"The face used to highlight prompt strings.
For highlighting other kinds of strings -- similar to shell mode's
behavior -- simply use an output filer which changes text properties."
diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el
index b6f12e1ff2e..929b74d789d 100644
--- a/lisp/eshell/em-rebind.el
+++ b/lisp/eshell/em-rebind.el
@@ -1,6 +1,6 @@
;;; em-rebind.el --- rebind keys when point is at current input
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -26,7 +26,8 @@
(eval-when-compile (require 'eshell))
;;;###autoload
-(eshell-defgroup eshell-rebind nil
+(progn
+(defgroup eshell-rebind nil
"This module allows for special keybindings that only take effect
while the point is in a region of input text. By default, it binds
C-a to move to the beginning of the input text (rather than just the
@@ -37,7 +38,7 @@ commands to cause the point to leave the input area, such as
`backward-word', `previous-line', etc. This module intends to mimic
the behavior of normal shells while the user editing new input text."
:tag "Rebind keys at input"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
index d76e19cdd07..f219a4b6f12 100644
--- a/lisp/eshell/em-script.el
+++ b/lisp/eshell/em-script.el
@@ -1,6 +1,6 @@
;;; em-script.el --- Eshell script files
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -24,13 +24,15 @@
;;; Code:
(require 'eshell)
+(require 'esh-opt)
;;;###autoload
-(eshell-defgroup eshell-script nil
+(progn
+(defgroup eshell-script nil
"This module allows for the execution of files containing Eshell
commands, as a script file."
:tag "Running script files."
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index 259072d9750..b427fe69ea4 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -1,6 +1,6 @@
;;; em-smart.el --- smart display of output
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -71,7 +71,8 @@
(eval-when-compile (require 'eshell))
;;;###autoload
-(eshell-defgroup eshell-smart nil
+(progn
+(defgroup eshell-smart nil
"This module combines the facility of normal, modern shells with
some of the edit/review concepts inherent in the design of Plan 9's
9term. See the docs for more details.
@@ -80,7 +81,7 @@ Most likely you will have to turn this option on and play around with
it to get a real sense of how it works."
:tag "Smart display of output"
;; :link '(info-link "(eshell)Smart display of output")
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el
index bd575a0f809..ef59f6d1d35 100644
--- a/lisp/eshell/em-term.el
+++ b/lisp/eshell/em-term.el
@@ -1,6 +1,6 @@
;;; em-term.el --- running visual commands
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -35,14 +35,15 @@
(require 'term)
;;;###autoload
-(eshell-defgroup eshell-term nil
+(progn
+(defgroup eshell-term nil
"This module causes visual commands (e.g., 'vi') to be executed by
the `term' package, which comes with Emacs. This package handles most
of the ANSI control codes, allowing curses-based applications to run
within an Emacs window. The variable `eshell-visual-commands' defines
which commands are considered visual in nature."
:tag "Running visual commands"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
@@ -62,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/em-unix.el b/lisp/eshell/em-unix.el
index 707f2ebc2ce..32744c702a6 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -1,6 +1,6 @@
;;; em-unix.el --- UNIX command aliases
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -40,7 +40,8 @@
(require 'pcomplete)
;;;###autoload
-(eshell-defgroup eshell-unix nil
+(progn
+(defgroup eshell-unix nil
"This module defines many of the more common UNIX utilities as
aliases implemented in Lisp. These include mv, ln, cp, rm, etc. If
the user passes arguments which are too complex, or are unrecognized
@@ -51,7 +52,7 @@ with Eshell makes them more versatile than their traditional cousins
\(such as being able to use `kill' to kill Eshell background processes
by name)."
:tag "UNIX commands in Lisp"
- :group 'eshell-module)
+ :group 'eshell-module))
(defcustom eshell-unix-load-hook nil
"A list of functions to run when `eshell-unix' is loaded."
@@ -305,12 +306,13 @@ Remove (unlink) the FILE(s).")
(eshell-eval-using-options
"mkdir" args
'((?h "help" nil nil "show this usage screen")
+ (?p "parents" nil em-parents "make parent directories as needed")
:external "mkdir"
:show-usage
:usage "[OPTION] DIRECTORY...
Create the DIRECTORY(ies), if they do not already exist.")
(while args
- (eshell-funcalln 'make-directory (car args))
+ (eshell-funcalln 'make-directory (car args) em-parents)
(setq args (cdr args)))
nil))
@@ -599,7 +601,7 @@ symlink, then revert to the system's definition of cat."
(let ((ext-cat (eshell-search-path "cat")))
(if ext-cat
(throw 'eshell-replace-command
- (eshell-parse-command ext-cat args))
+ (eshell-parse-command (eshell-quote-argument ext-cat) args))
(if eshell-in-pipeline-p
(error "Eshell's `cat' does not work in pipelines")
(error "Eshell's `cat' cannot display one of the files given"))))
@@ -712,7 +714,7 @@ available..."
(defun eshell-grep (command args &optional maybe-use-occur)
"Generic service function for the various grep aliases.
-It calls Emacs' grep utility if the command is not redirecting output,
+It calls Emacs's grep utility if the command is not redirecting output,
and if it's not part of a command pipeline. Otherwise, it calls the
external command."
(if (and maybe-use-occur eshell-no-grep-available)
@@ -792,8 +794,6 @@ external command."
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
-(defalias 'pcomplete/ssh 'pcomplete/rsh)
-
(defvar block-size)
(defvar by-bytes)
(defvar dereference-links)
@@ -857,7 +857,7 @@ external command."
(file-remote-p (expand-file-name arg) 'method) "ftp")
(throw 'have-ange-path t))))))
(throw 'eshell-replace-command
- (eshell-parse-command ext-du args))
+ (eshell-parse-command (eshell-quote-argument ext-du) args))
(eshell-eval-using-options
"du" args
'((?a "all" nil show-all
@@ -965,6 +965,8 @@ Show wall-clock time elapsed during execution of COMMAND.")
((string-match "[^[:blank:]]" string) string)
(nil)))
+(autoload 'diff-no-select "diff")
+
(defun eshell/diff (&rest args)
"Alias \"diff\" to call Emacs `diff' function."
(let ((orig-args (eshell-stringify-list (eshell-flatten-list args))))
@@ -986,8 +988,9 @@ Show wall-clock time elapsed during execution of COMMAND.")
(setcdr (last args 3) nil))
(with-current-buffer
(condition-case err
- (diff old new
- (nil-blank-string (eshell-flatten-and-stringify args)))
+ (diff-no-select
+ old new
+ (nil-blank-string (eshell-flatten-and-stringify args)))
(error
(throw 'eshell-replace-command
(eshell-parse-command "*diff" orig-args))))
@@ -1035,12 +1038,8 @@ Show wall-clock time elapsed during execution of COMMAND.")
(put 'eshell/occur 'eshell-no-numeric-conversions t)
-;; Pacify the byte-compiler.
-(defvar tramp-default-proxies-alist)
-
(defun eshell/su (&rest args)
"Alias \"su\" to call Tramp."
- (require 'tramp)
(setq args (eshell-stringify-list (eshell-flatten-list args)))
(let ((orig-args (copy-tree args)))
(eshell-eval-using-options
@@ -1055,29 +1054,29 @@ Become another USER during a login session.")
(host (or (file-remote-p default-directory 'host)
"localhost"))
(dir (or (file-remote-p default-directory 'localname)
- (expand-file-name default-directory))))
+ (expand-file-name default-directory)))
+ (prefix (file-remote-p default-directory)))
(dolist (arg args)
(if (string-equal arg "-") (setq login t) (setq user arg)))
;; `eshell-eval-using-options' does not handle "-".
(if (member "-" orig-args) (setq login t))
(if login (setq dir "~/"))
- (if (and (file-remote-p default-directory)
+ (if (and prefix
(or
(not (string-equal
"su" (file-remote-p default-directory 'method)))
(not (string-equal
user (file-remote-p default-directory 'user)))))
- (add-to-list
- 'tramp-default-proxies-alist
- (list host user (file-remote-p default-directory))))
- (eshell-parse-command
- "cd" (list (format "/su:%s@%s:%s" user host dir))))))))
+ (eshell-parse-command
+ "cd" (list (format "%s|su:%s@%s:%s"
+ (substring prefix 0 -1) user host dir)))
+ (eshell-parse-command
+ "cd" (list (format "/su:%s@%s:%s" user host dir)))))))))
(put 'eshell/su 'eshell-no-numeric-conversions t)
(defun eshell/sudo (&rest args)
"Alias \"sudo\" to call Tramp."
- (require 'tramp)
(setq args (eshell-stringify-list (eshell-flatten-list args)))
(let ((orig-args (copy-tree args)))
(eshell-eval-using-options
@@ -1092,21 +1091,28 @@ Execute a COMMAND as the superuser or another USER.")
(host (or (file-remote-p default-directory 'host)
"localhost"))
(dir (or (file-remote-p default-directory 'localname)
- (expand-file-name default-directory))))
+ (expand-file-name default-directory)))
+ (prefix (file-remote-p default-directory)))
;; `eshell-eval-using-options' reads options of COMMAND.
(while (and (stringp (car orig-args))
(member (car orig-args) '("-u" "--user")))
(setq orig-args (cddr orig-args)))
- (if (and (file-remote-p default-directory)
- (or
- (not (string-equal
- "sudo" (file-remote-p default-directory 'method)))
- (not (string-equal
- user (file-remote-p default-directory 'user)))))
- (add-to-list
- 'tramp-default-proxies-alist
- (list host user (file-remote-p default-directory))))
- (let ((default-directory (format "/sudo:%s@%s:%s" user host dir)))
+ (let ((default-directory
+ (if (and prefix
+ (or
+ (not
+ (string-equal
+ "sudo"
+ (file-remote-p default-directory 'method)))
+ (not
+ (string-equal
+ user
+ (file-remote-p default-directory 'user)))))
+ (format "%s|sudo:%s@%s:%s"
+ (substring prefix 0 -1) user host dir)
+ (format "/sudo:%s@%s:%s" user host dir))))
+ ;; Ensure, that Tramp has connected to that construct already.
+ (ignore (file-exists-p default-directory))
(eshell-named-command (car orig-args) (cdr orig-args))))))))
(put 'eshell/sudo 'eshell-no-numeric-conversions t)
diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el
index 50bda108e95..2e7a813cb75 100644
--- a/lisp/eshell/em-xtra.el
+++ b/lisp/eshell/em-xtra.el
@@ -1,6 +1,6 @@
;;; em-xtra.el --- extra alias functions
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -29,13 +29,14 @@
(require 'compile)
;;;###autoload
-(eshell-defgroup eshell-xtra nil
+(progn
+(defgroup eshell-xtra nil
"This module defines some extra alias functions which are entirely
optional. They can be viewed as samples for how to write Eshell alias
-functions, or as aliases which make some of Emacs' behavior more
+functions, or as aliases which make some of Emacs's behavior more
naturally accessible within Emacs."
:tag "Extra alias functions"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; Functions:
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index dcb23967645..ad52a5d4a71 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -1,6 +1,6 @@
;;; esh-arg.el --- argument processing
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -202,6 +202,18 @@ If POS is nil, the location of point is checked."
(or (= pos (point-max))
(memq (char-after pos) eshell-delimiter-argument-list))))
+(defun eshell-quote-argument (string)
+ "Return STRING with magic characters quoted.
+Magic characters are those in `eshell-special-chars-outside-quoting'."
+ (let ((index 0))
+ (mapconcat (lambda (c)
+ (prog1
+ (or (eshell-quote-backslash string index)
+ (char-to-string c))
+ (setq index (1+ index))))
+ string
+ "")))
+
;; Argument parsing
(defun eshell-parse-arguments (beg end)
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 7b90797eb43..e6e89d83b7c 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -1,6 +1,6 @@
;;; esh-cmd.el --- command invocation
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -108,7 +108,7 @@
(require 'esh-ext)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'pcomplete))
@@ -236,10 +236,14 @@ return non-nil if the command is complex."
:group 'eshell-cmd)
(defcustom eshell-debug-command nil
- "If non-nil, enable debugging code. SSLLOOWW.
-This option is only useful for reporting bugs. If you enable it, you
-will have to visit the file 'eshell-cmd.el' and run the command
-\\[eval-buffer]."
+ "If non-nil, enable Eshell debugging code.
+This is slow, and only useful for debugging problems with Eshell.
+If you change this without using customize after Eshell has loaded,
+you must re-load 'esh-cmd.el'."
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (set symbol value)
+ (load-library "esh-cmd"))
:type 'boolean
:group 'eshell-cmd)
@@ -480,20 +484,22 @@ implemented via rewriting, rather than as a function."
(let ((body (car (last terms))))
(setcdr (last terms 2) nil)
`(let ((for-items
- (append
- ,@(mapcar
- (lambda (elem)
- (if (listp elem)
- elem
- `(list ,elem)))
- (cdr (cddr terms)))))
- (eshell-command-body '(nil))
+ (copy-tree
+ (append
+ ,@(mapcar
+ (lambda (elem)
+ (if (listp elem)
+ elem
+ `(list ,elem)))
+ (cdr (cddr terms))))))
+ (eshell-command-body '(nil))
(eshell-test-body '(nil)))
- (while (consp for-items)
- (let ((,(intern (cadr terms)) (car for-items)))
- (eshell-protect
- ,(eshell-invokify-arg body t)))
- (setq for-items (cdr for-items)))
+ (while (car for-items)
+ (let ((,(intern (cadr terms)) (car for-items)))
+ (eshell-protect
+ ,(eshell-invokify-arg body t)))
+ (setcar for-items (cadr for-items))
+ (setcdr for-items (cddr for-items)))
(eshell-close-handles
eshell-last-command-status
(list 'quote eshell-last-command-result))))))
@@ -600,7 +606,7 @@ For an external command, it means an exit code of 0."
(list
(if (<= (length pieces) 1)
(car pieces)
- (assert (not eshell-in-pipeline-p))
+ (cl-assert (not eshell-in-pipeline-p))
`(eshell-execute-pipeline (quote ,pieces))))))
(setq bp (cdr bp))))
;; `results' might be empty; this happens in the case of
@@ -611,7 +617,7 @@ For an external command, it means an exit code of 0."
results (cdr results)
sep-terms (nreverse sep-terms))
(while results
- (assert (car sep-terms))
+ (cl-assert (car sep-terms))
(setq final (eshell-structure-basic-command
'if (string= (car sep-terms) "&&") "if"
`(eshell-protect ,(car results))
@@ -1022,7 +1028,7 @@ be finished later after the completion of an asynchronous subprocess."
;; `eshell-copy-tree' is needed here so that the test argument
;; doesn't get modified and thus always yield the same result.
(when (car eshell-command-body)
- (assert (not synchronous-p))
+ (cl-assert (not synchronous-p))
(eshell-do-eval (car eshell-command-body))
(setcar eshell-command-body nil)
(setcar eshell-test-body nil))
@@ -1042,7 +1048,7 @@ be finished later after the completion of an asynchronous subprocess."
;; doesn't get modified and thus always yield the same result.
(if (car eshell-command-body)
(progn
- (assert (not synchronous-p))
+ (cl-assert (not synchronous-p))
(eshell-do-eval (car eshell-command-body)))
(unless (car eshell-test-body)
(setcar eshell-test-body (eshell-copy-tree (car args))))
@@ -1197,7 +1203,7 @@ COMMAND may result in an alias being executed, or a plain command."
(setq eshell-last-arguments args
eshell-last-command-name (eshell-stringify command))
(run-hook-with-args 'eshell-prepare-command-hook)
- (assert (stringp eshell-last-command-name))
+ (cl-assert (stringp eshell-last-command-name))
(if eshell-last-command-name
(or (run-hook-with-args-until-success
'eshell-named-command-hook eshell-last-command-name
@@ -1212,13 +1218,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-sans-extension
- (file-name-nondirectory
- (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-ext.el b/lisp/eshell/esh-ext.el
index 3acbeac0b89..e48213c54d6 100644
--- a/lisp/eshell/esh-ext.el
+++ b/lisp/eshell/esh-ext.el
@@ -1,6 +1,6 @@
;;; esh-ext.el --- commands external to Eshell
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -34,9 +34,10 @@
(provide 'esh-ext)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'esh-cmd))
(require 'esh-util)
+(require 'esh-opt)
(defgroup eshell-ext nil
"External commands are invoked when operating system executables are
@@ -91,7 +92,7 @@ since nothing else but Eshell will be able to understand
(defcustom eshell-windows-shell-file
(if (eshell-under-windows-p)
- (if (string-match "\\(\\`cmdproxy\\|sh\\)\\.\\(com\\|exe\\)"
+ (if (string-match "\\(cmdproxy\\|sh\\)\\.\\(com\\|exe\\)"
shell-file-name)
(or (eshell-search-path "cmd.exe")
(eshell-search-path "command.com"))
@@ -108,7 +109,9 @@ wholly ignored."
;; argument...
(setcar args (subst-char-in-string ?/ ?\\ (car args)))
(throw 'eshell-replace-command
- (eshell-parse-command eshell-windows-shell-file (cons "/c" args))))
+ (eshell-parse-command
+ (eshell-quote-argument eshell-windows-shell-file)
+ (cons "/c" args))))
(defcustom eshell-interpreter-alist
(if (eshell-under-windows-p)
@@ -186,6 +189,7 @@ all the output from the remote command, and sends it all at once,
causing the user to wonder if anything's really going on..."
(let ((outbuf (generate-new-buffer " *eshell remote output*"))
(errbuf (generate-new-buffer " *eshell remote error*"))
+ (command (or (file-remote-p command 'localname) command))
(exitcode 1))
(unwind-protect
(progn
@@ -203,10 +207,15 @@ causing the user to wonder if anything's really going on..."
(defun eshell-external-command (command args)
"Insert output from an external COMMAND, using ARGS."
(setq args (eshell-stringify-list (eshell-flatten-list args)))
- (if (file-remote-p default-directory)
- (eshell-remote-command command args))
- (let ((interp (eshell-find-interpreter command)))
- (assert interp)
+ (let ((interp (eshell-find-interpreter
+ command
+ ;; `eshell-find-interpreter' does not work correctly
+ ;; for Tramp file name syntax. But we don't need to
+ ;; know the interpreter in that case, therefore the
+ ;; check is suppressed.
+ (or (and (stringp command) (file-remote-p command))
+ (file-remote-p default-directory)))))
+ (cl-assert interp)
(if (functionp (car interp))
(apply (car interp) (append (cdr interp) args))
(eshell-gather-process-output
@@ -222,20 +231,15 @@ causing the user to wonder if anything's really going on..."
Adds the given PATH to $PATH.")
(if args
(progn
- (if prepend
- (setq args (nreverse args)))
- (while args
- (setenv "PATH"
- (if prepend
- (concat (car args) path-separator
- (getenv "PATH"))
- (concat (getenv "PATH") path-separator
- (car args))))
- (setq args (cdr args))))
- (let ((paths (parse-colon-path (getenv "PATH"))))
- (while paths
- (eshell-printn (car paths))
- (setq paths (cdr paths)))))))
+ (setq eshell-path-env (getenv "PATH")
+ args (mapconcat 'identity args path-separator)
+ eshell-path-env
+ (if prepend
+ (concat args path-separator eshell-path-env)
+ (concat eshell-path-env path-separator args)))
+ (setenv "PATH" eshell-path-env))
+ (dolist (dir (parse-colon-path (getenv "PATH")))
+ (eshell-printn dir)))))
(put 'eshell/addpath 'eshell-no-numeric-conversions t)
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index 71fae34b360..9f3cfe0f6d0 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -1,6 +1,6 @@
;;; esh-io.el --- I/O management
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -59,7 +59,7 @@
(provide 'esh-io)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'eshell))
(defgroup eshell-io nil
@@ -298,7 +298,7 @@ completed successfully. RESULT is the quoted value of the last
command. If nil, then the meta variables for keeping track of the
last execution result should not be changed."
(let ((idx 0))
- (assert (or (not result) (eq (car result) 'quote)))
+ (cl-assert (or (not result) (eq (car result) 'quote)))
(setq eshell-last-command-status exit-code
eshell-last-command-result (cadr result))
(while (< idx eshell-number-of-handles)
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index 43d56a5b89f..673632400f2 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -1,6 +1,6 @@
;;; esh-mode.el --- user interface
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -193,8 +193,11 @@ This is used by `eshell-watch-for-password-prompt'."
:type '(choice (const nil) function)
:group 'eshell-mode)
-(defcustom eshell-status-in-modeline t
- "If non-nil, let the user know a command is running in the modeline."
+(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)
@@ -314,14 +317,14 @@ and the hook `eshell-exit-hook'."
(setq eshell-mode-map (make-sparse-keymap))
(use-local-map eshell-mode-map)
- (when eshell-status-in-modeline
+ (when eshell-status-in-mode-line
(make-local-variable 'eshell-command-running-string)
(let ((fmt (copy-sequence mode-line-format)))
(make-local-variable 'mode-line-format)
(setq mode-line-format fmt))
- (let ((modeline (memq 'mode-line-modified mode-line-format)))
- (if modeline
- (setcar modeline 'eshell-command-running-string))))
+ (let ((mode-line-elt (memq 'mode-line-modified mode-line-format)))
+ (if mode-line-elt
+ (setcar mode-line-elt 'eshell-command-running-string))))
(define-key eshell-mode-map [return] 'eshell-send-input)
(define-key eshell-mode-map [(control ?m)] 'eshell-send-input)
@@ -434,7 +437,7 @@ and the hook `eshell-exit-hook'."
(when eshell-scroll-show-maximum-output
(set (make-local-variable 'scroll-conservatively) 1000))
- (when eshell-status-in-modeline
+ (when eshell-status-in-mode-line
(add-hook 'eshell-pre-command-hook 'eshell-command-started nil t)
(add-hook 'eshell-post-command-hook 'eshell-command-finished nil t))
@@ -448,12 +451,12 @@ and the hook `eshell-exit-hook'."
(put 'eshell-mode 'mode-class 'special)
(defun eshell-command-started ()
- "Indicate in the modeline that a command has started."
+ "Indicate in the mode line that a command has started."
(setq eshell-command-running-string "**")
(force-mode-line-update))
(defun eshell-command-finished ()
- "Indicate in the modeline that a command has finished."
+ "Indicate in the mode line that a command has finished."
(setq eshell-command-running-string "--")
(force-mode-line-update))
diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el
index 1581d05889e..2e3c6b8b7b5 100644
--- a/lisp/eshell/esh-module.el
+++ b/lisp/eshell/esh-module.el
@@ -1,6 +1,6 @@
;;; esh-module.el --- Eshell modules
-;; Copyright (C) 1999-2000, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Keywords: processes
@@ -36,7 +36,9 @@ customizing the variable `eshell-modules-list'."
;; load the defgroup's for the standard extension modules, so that
;; documentation can be provided when the user customize's
-;; `eshell-modules-list'.
+;; `eshell-modules-list'. We use "(progn (defgroup ..." in each file
+;; to force the autoloader into including the entire defgroup, rather
+;; than an abbreviated version.
(load "esh-groups" nil 'nomessage)
;;; User Variables:
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el
index 91d3cac198a..fed2d8f1c62 100644
--- a/lisp/eshell/esh-opt.el
+++ b/lisp/eshell/esh-opt.el
@@ -1,6 +1,6 @@
;;; esh-opt.el --- command options processing
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -106,7 +106,9 @@ interned variable `args' (created using a `let' form)."
(and (listp opt) (nth 3 opt)))
(cadr options)))
'(usage-msg last-value ext-command args))
- (eshell-do-opt ,name ,options (quote ,body-forms)))))
+ ;; FIXME: `options' ends up hiding some variable names under `quote',
+ ;; which is incompatible with lexical scoping!!
+ (eshell-do-opt ,name ,options (lambda () ,@body-forms)))))
;;; Internal Functions:
@@ -117,7 +119,7 @@ interned variable `args' (created using a `let' form)."
;; Documented part of the interface; see eshell-eval-using-options.
(defvar args)
-(defun eshell-do-opt (name options body-forms)
+(defun eshell-do-opt (name options body-fun)
"Helper function for `eshell-eval-using-options'.
This code doesn't really need to be macro expanded everywhere."
(setq args temp-args)
@@ -133,8 +135,7 @@ This code doesn't really need to be macro expanded everywhere."
(throw 'eshell-usage
(eshell-show-usage name options)))
(setq args (eshell-process-args name args options)
- last-value (eval (append (list 'progn)
- body-forms)))
+ last-value (funcall body-fun))
nil))
(error "%s" usage-msg))))
(throw 'eshell-external
@@ -218,10 +219,8 @@ switch is unrecognized."
found)
(while opts
(if (and (listp (car opts))
- (nth kind (car opts))
- (if (= kind 0)
- (eq switch (nth kind (car opts)))
- (string= switch (nth kind (car opts)))))
+ (nth kind (car opts))
+ (equal switch (nth kind (car opts))))
(progn
(eshell-set-option name ai (car opts) options)
(setq found t opts nil))
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index eeaccc4b890..f510f4b5329 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -1,6 +1,6 @@
;;; esh-proc.el --- process management
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index b508fd5352f..01df5fced62 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -1,6 +1,6 @@
;;; esh-util.el --- general utilities
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -84,7 +84,7 @@ Numeric form is tested using the regular expression
NOTE: If you find that numeric conversions are interfering with the
specification of filenames (for example, in calling `find-file', or
some other Lisp function that deals with files, not numbers), add the
-following in your .emacs file:
+following in your init file:
(put 'find-file 'eshell-no-numeric-conversions t)
@@ -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)))
@@ -483,7 +481,7 @@ list."
(insert-file-contents eshell-hosts-file)
(goto-char (point-min))
(while (re-search-forward
- "^\\(\\S-+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?" nil t)
+ "^\\([^#[:space:]]+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?" nil t)
(if (match-string 1)
(add-to-list 'hosts (match-string 1)))
(if (match-string 2)
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 03774396485..6a0e159e82e 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -1,6 +1,6 @@
;;; esh-var.el --- handling of variables
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -110,8 +110,8 @@
(eval-when-compile
(require 'pcomplete)
(require 'esh-util)
- (require 'esh-opt)
(require 'esh-mode))
+(require 'esh-opt)
(require 'env)
(require 'ring)
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index 0c1c03941e5..a9a854221a4 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -1,6 +1,6 @@
;;; eshell.el --- the Emacs command shell
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Version: 2.4.2
@@ -140,12 +140,12 @@
;; paragraph wasn't discovered until two months after I wrote the
;; text; it was not intentional).
;;
-;; @ Emacs' register and bookmarking facilities can be used for
+;; @ Emacs's register and bookmarking facilities can be used for
;; remembering where you've been, and what you've seen -- to varying
;; levels of persistence. They could perhaps even be tied to
;; specific "moments" during eshell execution, which would include
;; the environment at that time, as well as other variables.
-;; Although this would require functionality orthogonal to Emacs'
+;; Although this would require functionality orthogonal to Emacs's
;; own bookmarking facilities, the interface used could be made to
;; operate very similarly.
;;
@@ -222,36 +222,33 @@
;; things up.
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'esh-util))
(require 'esh-util)
(require 'esh-mode)
(defgroup eshell nil
- "A command shell implemented entirely in Emacs Lisp.
+ "Command shell implemented entirely in Emacs Lisp.
It invokes no external processes beyond those requested by the
user, and is intended to be a functional replacement for command
shells such as bash, zsh, rc, 4dos."
- :tag "The Emacs shell"
:link '(info-link "(eshell)Top")
:version "21.1"
:group 'applications)
-;; This is hack to force make-autoload to put the whole definition
-;; into the autoload file (see esh-module.el).
-(defalias 'eshell-defgroup 'defgroup)
-
;;;_* User Options
;;
;; The following user options modify the behavior of Eshell overall.
(defvar eshell-buffer-name)
-(defsubst eshell-add-to-window-buffer-names ()
+(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))
-(defsubst eshell-remove-from-window-buffer-names ()
+(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)))
@@ -260,23 +257,13 @@ shells such as bash, zsh, rc, 4dos."
:type 'hook
:group 'eshell)
-(defcustom eshell-unload-hook
- '(eshell-remove-from-window-buffer-names
- eshell-unload-all-modules)
+(defcustom eshell-unload-hook '(eshell-unload-all-modules)
"A hook run when Eshell is unloaded from memory."
:type 'hook
:group 'eshell)
(defcustom eshell-buffer-name "*eshell*"
"The basename used for Eshell buffers."
- :set (lambda (symbol value)
- ;; remove the old value of `eshell-buffer-name', if present
- (if (boundp 'eshell-buffer-name)
- (eshell-remove-from-window-buffer-names))
- (set symbol value)
- ;; add the new value
- (eshell-add-to-window-buffer-names)
- value)
:type 'string
:group 'eshell)
@@ -303,7 +290,7 @@ switches to the session with that number, creating it if necessary. A
nonnumeric prefix arg means to create a new session. Returns the
buffer selected (or created)."
(interactive "P")
- (assert eshell-buffer-name)
+ (cl-assert eshell-buffer-name)
(let ((buf (cond ((numberp arg)
(get-buffer-create (format "%s<%d>"
eshell-buffer-name
@@ -312,13 +299,8 @@ buffer selected (or created)."
(generate-new-buffer eshell-buffer-name))
(t
(get-buffer-create eshell-buffer-name)))))
- ;; Simply calling `pop-to-buffer' will not mimic the way that
- ;; shell-mode buffers appear, since they always reuse the same
- ;; window that that command was invoked from. To achieve this,
- ;; it's necessary to add `eshell-buffer-name' to the variable
- ;; `same-window-buffer-names', which is done when Eshell is loaded
- (assert (and buf (buffer-live-p buf)))
- (pop-to-buffer buf)
+ (cl-assert (and buf (buffer-live-p buf)))
+ (pop-to-buffer-same-window buf)
(unless (eq major-mode 'eshell-mode)
(eshell-mode))
buf))
@@ -385,11 +367,11 @@ With prefix ARG, insert output into the current buffer at point."
(when intr
(if (eshell-interactive-process)
(eshell-wait-for-process (eshell-interactive-process)))
- (assert (not (eshell-interactive-process)))
+ (cl-assert (not (eshell-interactive-process)))
(goto-char (point-max))
(while (and (bolp) (not (bobp)))
(delete-char -1)))
- (assert (and buf (buffer-live-p buf)))
+ (cl-assert (and buf (buffer-live-p buf)))
(unless arg
(let ((len (if (not intr) 2
(count-lines (point-min) (point-max)))))
@@ -429,7 +411,7 @@ corresponding to a successful execution."
(list 'eshell-commands
(list 'eshell-command-to-value
(eshell-parse-command command))) t)))
- (assert (eq (car result) 'quote))
+ (cl-assert (eq (car result) 'quote))
(if (and status-var (symbolp status-var))
(set status-var eshell-last-command-status))
(cadr result))))))
diff --git a/lisp/expand.el b/lisp/expand.el
index beb76321781..18f2c390798 100644
--- a/lisp/expand.el
+++ b/lisp/expand.el
@@ -1,6 +1,6 @@
;;; expand.el --- make abbreviations more usable
-;; Copyright (C) 1995-1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Frederic Lepied <Frederic.Lepied@sugix.frmug.org>
;; Maintainer: Frederic Lepied <Frederic.Lepied@sugix.frmug.org>
diff --git a/lisp/ezimage.el b/lisp/ezimage.el
index d0bbdfb2f8a..346b69d9912 100644
--- a/lisp/ezimage.el
+++ b/lisp/ezimage.el
@@ -1,6 +1,6 @@
;;; ezimage --- Generalized Image management
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index bfd973a299f..903c12a787e 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -1,6 +1,6 @@
-;;; face-remap.el --- Functions for managing `face-remapping-alist'
+;;; face-remap.el --- Functions for managing `face-remapping-alist' -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: faces, face remapping, display, user commands
@@ -106,21 +106,25 @@ The list structure of ENTRY may be destructively modified."
;;;###autoload
(defun face-remap-add-relative (face &rest specs)
"Add a face remapping entry of FACE to SPECS in the current buffer.
-
-Return a cookie which can be used to delete the remapping with
+Return a cookie which can be used to delete this remapping with
`face-remap-remove-relative'.
-SPECS can be any value suitable for the `face' text property,
-including a face name, a list of face names, or a face-attribute
-property list. The attributes given by SPECS will be merged with
-any other currently active face remappings of FACE, and with the
-global definition of FACE. An attempt is made to sort multiple
-entries so that entries with relative face-attributes are applied
-after entries with absolute face-attributes.
-
-The base (lowest priority) remapping may be set to a specific
-value, instead of the default of the global face definition,
-using `face-remap-set-base'."
+The remaining arguments, SPECS, should form a list of faces.
+Each list element should be either a face name or a property list
+of face attribute/value pairs. If more than one face is listed,
+that specifies an aggregate face, in the same way as in a `face'
+text property, except for possible priority changes noted below.
+
+The face remapping specified by SPECS takes effect alongside the
+remappings from other calls to `face-remap-add-relative' for the
+same FACE, as well as the normal definition of FACE (at lowest
+priority). This function tries to sort multiple remappings for
+the same face, so that remappings specifying relative face
+attributes are applied after remappings specifying absolute face
+attributes.
+
+The base (lowest priority) remapping may be set to something
+other than the normal definition of FACE via `face-remap-set-base'."
(while (and (consp specs) (null (cdr specs)))
(setq specs (car specs)))
(make-local-variable 'face-remapping-alist)
@@ -128,7 +132,10 @@ using `face-remap-set-base'."
(when (null entry)
(setq entry (list face face)) ; explicitly merge with global def
(push entry face-remapping-alist))
- (setcdr entry (face-remap-order (cons specs (cdr entry))))
+ (let ((faces (cdr entry)))
+ (if (symbolp faces)
+ (setq faces (list faces)))
+ (setcdr entry (face-remap-order (cons specs faces))))
(cons face specs)))
(defun face-remap-remove-relative (cookie)
@@ -148,7 +155,9 @@ COOKIE should be the return value from that function."
;;;###autoload
(defun face-remap-reset-base (face)
- "Set the base remapping of FACE to inherit from FACE's global definition."
+ "Set the base remapping of FACE to the normal definition of FACE.
+This causes the remappings specified by `face-remap-add-relative'
+to apply on top of the normal definition of FACE."
(let ((entry (assq face face-remapping-alist)))
(when entry
;; If there's nothing except a base remapping, we simply remove
@@ -163,10 +172,17 @@ COOKIE should be the return value from that function."
;;;###autoload
(defun face-remap-set-base (face &rest specs)
"Set the base remapping of FACE in the current buffer to SPECS.
-If SPECS is empty, the default base remapping is restored, which
-inherits from the global definition of FACE; note that this is
-different from SPECS containing a single value `nil', which does
-not inherit from the global definition of FACE."
+This causes the remappings specified by `face-remap-add-relative'
+to apply on top of the face specification given by SPECS.
+
+The remaining arguments, SPECS, should form a list of faces.
+Each list element should be either a face name or a property list
+of face attribute/value pairs, like in a `face' text property.
+
+If SPECS is empty, call `face-remap-reset-base' to use the normal
+definition of FACE as the base remapping; note that this is
+different from SPECS containing a single value `nil', which means
+not to inherit from the global definition of FACE at all."
(while (and (consp specs) (not (null (car specs))) (null (cdr specs)))
(setq specs (car specs)))
(if (or (null specs)
@@ -205,6 +221,9 @@ Each positive or negative step scales the default face height by this amount."
(define-minor-mode text-scale-mode
"Minor mode for displaying buffer text in a larger/smaller font.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
The amount of scaling is determined by the variable
`text-scale-mode-amount': one step scales the global default
@@ -269,7 +288,9 @@ See `text-scale-increase' for more details."
;;;###autoload (define-key ctl-x-map [(control ?0)] 'text-scale-adjust)
;;;###autoload
(defun text-scale-adjust (inc)
- "Increase or decrease the height of the default face in the current buffer.
+ "Adjust the height of the default face by INC.
+
+INC may be passed as a numeric prefix argument.
The actual adjustment made depends on the final component of the
key-binding used to invoke the command, with all modifiers removed:
@@ -278,9 +299,11 @@ key-binding used to invoke the command, with all modifiers removed:
- Decrease the default face height by one step
0 Reset the default face height to the global default
-Then, continue to read input events and further adjust the face
-height as long as the input event read (with all modifiers removed)
-is one of the above.
+When adjusting with `+' or `-', continue to read input events and
+further adjust the face height as long as the input event read
+\(with all modifiers removed) is `+' or `-'.
+
+When adjusting with `0', immediately finish.
Each step scales the height of the default face by the variable
`text-scale-mode-step' (a negative number of steps decreases the
@@ -293,27 +316,25 @@ even when it is bound in a non-top-level keymap. For binding in
a top-level keymap, `text-scale-increase' or
`text-scale-decrease' may be more appropriate."
(interactive "p")
- (let ((first t)
- (step t)
- (ev last-command-event)
+ (let ((ev last-command-event)
(echo-keystrokes nil))
- (while step
- (let ((base (event-basic-type ev)))
- (cond ((or (eq base ?+) (eq base ?=))
- (setq step inc))
- ((eq base ?-)
- (setq step (- inc)))
- ((eq base ?0)
- (setq step 0))
- (first
- (setq step inc))
- (t
- (setq step nil))))
- (when step
- (text-scale-increase step)
- (setq inc 1 first nil)
- (setq ev (read-event "+,-,0 for further adjustment: "))))
- (push ev unread-command-events)))
+ (let* ((base (event-basic-type ev))
+ (step
+ (pcase base
+ ((or ?+ ?=) inc)
+ (?- (- inc))
+ (?0 0)
+ (t inc))))
+ (text-scale-increase step)
+ ;; (unless (zerop step)
+ (message "Use +,-,0 for further adjustment")
+ (set-temporary-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (mods '(() (control)))
+ (dolist (key '(?- ?+ ?= ?0)) ;; = is often unshifted +.
+ (define-key map (vector (append mods (list key)))
+ (lambda () (interactive) (text-scale-adjust (abs inc))))))
+ map))))) ;; )
;; ----------------------------------------------------------------
@@ -334,8 +355,10 @@ plist, etc."
;;;###autoload
(define-minor-mode buffer-face-mode
"Minor mode for a buffer-specific default face.
-When enabled, the face specified by the variable
-`buffer-face-mode-face' is used to display the buffer text."
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil. When enabled, the face specified by the
+variable `buffer-face-mode-face' is used to display the buffer text."
:lighter " BufFace"
(when buffer-face-mode-remapping
(face-remap-remove-relative buffer-face-mode-remapping))
@@ -347,12 +370,14 @@ When enabled, the face specified by the variable
;;;###autoload
(defun buffer-face-set (&rest specs)
"Enable `buffer-face-mode', using face specs SPECS.
-SPECS can be any value suitable for the `face' text property,
-including a face name, a list of face names, or a face-attribute
-If SPECS is nil, then `buffer-face-mode' is disabled.
-
-This function will make the variable `buffer-face-mode-face'
-buffer local, and set it to FACE."
+Each argument in SPECS should be a face, i.e. either a face name
+or a property list of face attributes and values. If more than
+one face is listed, that specifies an aggregate face, like in a
+`face' text property. If SPECS is nil or omitted, disable
+`buffer-face-mode'.
+
+This function makes the variable `buffer-face-mode-face' buffer
+local, and sets it to FACE."
(interactive (list (read-face-name "Set buffer face")))
(while (and (consp specs) (null (cdr specs)))
(setq specs (car specs)))
@@ -364,8 +389,10 @@ buffer local, and set it to FACE."
;;;###autoload
(defun buffer-face-toggle (&rest specs)
"Toggle `buffer-face-mode', using face specs SPECS.
-SPECS can be any value suitable for the `face' text property,
-including a face name, a list of face names, or a face-attribute
+Each argument in SPECS should be a face, i.e. either a face name
+or a property list of face attributes and values. If more than
+one face is listed, that specifies an aggregate face, like in a
+`face' text property.
If `buffer-face-mode' is already enabled, and is currently using
the face specs SPECS, then it is disabled; if buffer-face-mode is
@@ -388,10 +415,12 @@ buffer local, and set it to SPECS."
ARG controls whether the mode is enabled or disabled, and is
interpreted in the usual manner for minor-mode commands.
-SPECS can be any value suitable for the `face' text property,
-including a face name, a list of face names, or a face-attribute
+SPECS can be any value suitable for a `face' text property,
+including a face name, a plist of face attributes and values, or
+a list of faces.
-If INTERACTIVE is non-nil, a message will be displayed describing the result.
+If INTERACTIVE is non-nil, display a message describing the
+result.
This is a wrapper function which calls `buffer-face-set' or
`buffer-face-toggle' (depending on ARG), and prints a status
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 4f9db02b5e1..88b9ddc7f54 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -1,6 +1,6 @@
;;; facemenu.el --- create a face menu for interactively adding fonts to text
-;; Copyright (C) 1994-1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: faces
@@ -127,15 +127,6 @@ just before \"Other\" at the end."
:type 'boolean
:group 'facemenu)
-(defvar facemenu-unlisted-faces
- `(modeline region secondary-selection highlight scratch-face
- ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-")
- ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-")
- ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-"))
- "*List of faces that are of no interest to the user.")
-(make-obsolete-variable 'facemenu-unlisted-faces 'facemenu-listed-faces
- "22.1,\n and has no effect on the Face menu")
-
(defcustom facemenu-listed-faces nil
"List of faces to include in the Face menu.
Each element should be a symbol, the name of a face.
@@ -473,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)
@@ -483,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")
@@ -513,23 +506,25 @@ 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.
If the optional argument LIST is non-nil, it should be a list of
colors to display. Otherwise, this command computes a list of
-colors that the current display can handle.
+colors that the current display can handle. Customize
+`list-colors-sort' to change the order in which colors are shown.
-If the optional argument BUFFER-NAME is nil, it defaults to
-*Colors*.
+If the optional argument BUFFER-NAME is nil, it defaults to *Colors*.
If the optional argument CALLBACK is non-nil, it should be a
function to call each time the user types RET or clicks on a
-color. The function should accept a single argument, the color
-name.
-
-You can change the color sort order by customizing `list-colors-sort'."
+color. The function should accept a single argument, the color name."
(interactive)
(when (and (null list) (> (display-color-cells) 0))
(setq list (list-colors-duplicates (defined-colors)))
diff --git a/lisp/faces.el b/lisp/faces.el
index 21193589deb..928174c3954 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1,6 +1,6 @@
;;; faces.el --- Lisp faces
-;; Copyright (C) 1992-1996, 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
@@ -25,8 +25,15 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(defcustom term-file-prefix (purecopy "term/")
+ "If non-nil, Emacs startup performs terminal-specific initialization.
+It does this by: (load (concat term-file-prefix (getenv \"TERM\")))
+
+You may set this variable to nil in your init file if you do not wish
+the terminal-initialization file to be loaded."
+ :type '(choice (const :tag "No terminal-specific initialization" nil)
+ (string :tag "Name of directory with term files"))
+ :group 'terminals)
(declare-function xw-defined-colors "term/common-win" (&optional frame))
@@ -89,7 +96,7 @@ ALTERNATIVE2 etc."
;; This is defined originally in xfaces.c.
(defcustom face-font-registry-alternatives
(mapcar (lambda (arg) (mapcar 'purecopy arg))
- (if (eq system-type 'windows-nt)
+ (if (featurep 'w32)
'(("iso8859-1" "ms-oemlatin")
("gb2312.1980" "gb2312" "gbk" "gb18030")
("jisx0208.1990" "jisx0208.1983" "jisx0208.1978")
@@ -122,15 +129,13 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
"Return a list of all defined faces."
(mapcar #'car face-new-frame-defaults))
-
-;;; ### If not frame-local initialize by what X resources?
-
(defun make-face (face &optional no-init-from-resources)
"Define a new face with name FACE, a symbol.
-NO-INIT-FROM-RESOURCES non-nil means don't initialize frame-local
-variants of FACE from X resources. (X resources recognized are found
-in the global variable `face-x-resources'.) If FACE is already known
-as a face, leave it unmodified. Value is FACE."
+Do not call this directly from Lisp code; use `defface' instead.
+
+If NO-INIT-FROM-RESOURCES is non-nil, don't initialize face
+attributes from X resources. If FACE is already known as a face,
+leave it unmodified. Return FACE."
(interactive (list (read-from-minibuffer
"Make face: " nil nil t 'face-name-history)))
(unless (facep face)
@@ -145,31 +150,30 @@ as a face, leave it unmodified. Value is FACE."
(make-face-x-resource-internal face)))
face)
-
(defun make-empty-face (face)
"Define a new, empty face with name FACE.
-If the face already exists, it is left unmodified. Value is FACE."
+Do not call this directly from Lisp code; use `defface' instead."
(interactive (list (read-from-minibuffer
"Make empty face: " nil nil t 'face-name-history)))
(make-face face 'no-init-from-resources))
-
(defun copy-face (old-face new-face &optional frame new-frame)
- "Define a face just like OLD-FACE, with name NEW-FACE.
-
-If NEW-FACE already exists as a face, it is modified to be like
-OLD-FACE. If it doesn't already exist, it is created.
-
-If the optional argument FRAME is given as a frame, NEW-FACE is
-changed on FRAME only.
-If FRAME is t, the frame-independent default specification for OLD-FACE
-is copied to NEW-FACE.
-If FRAME is nil, copying is done for the frame-independent defaults
-and for each existing frame.
-
-If the optional fourth argument NEW-FRAME is given,
-copy the information from face OLD-FACE on frame FRAME
-to NEW-FACE on frame NEW-FRAME. In this case, FRAME may not be nil."
+ "Define a face named NEW-FACE, which is a copy of OLD-FACE.
+This function does not copy face customization data, so NEW-FACE
+will not be made customizable. Most Lisp code should not call
+this function; use `defface' with :inherit instead.
+
+If NEW-FACE already exists as a face, modify it to be like
+OLD-FACE. If NEW-FACE doesn't already exist, create it.
+
+If the optional argument FRAME is a frame, change NEW-FACE on
+FRAME only. If FRAME is t, copy the frame-independent default
+specification for OLD-FACE to NEW-FACE. If FRAME is nil, copy
+the defaults as well as the faces on each existing frame.
+
+If the optional fourth argument NEW-FRAME is given, copy the
+information from face OLD-FACE on frame FRAME to NEW-FACE on
+frame NEW-FRAME. In this case, FRAME must not be nil."
(let ((inhibit-quit t))
(if (null frame)
(progn
@@ -483,39 +487,44 @@ with the `default' face (which is always completely specified)."
(defalias 'face-background-pixmap 'face-stipple)
-(defun face-underline-p (face &optional frame)
- "Return non-nil if FACE is underlined.
+(defun face-underline-p (face &optional frame inherit)
+ "Return non-nil if FACE specifies a non-nil underlining.
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
-If FRAME is omitted or nil, use the selected frame."
- (eq (face-attribute face :underline frame) t))
+If FRAME is omitted or nil, use the selected frame.
+Optional argument INHERIT is passed to `face-attribute'."
+ (face-attribute-specified-or
+ (face-attribute face :underline frame inherit) nil))
-(defun face-inverse-video-p (face &optional frame)
- "Return non-nil if FACE is in inverse video on FRAME.
+(defun face-inverse-video-p (face &optional frame inherit)
+ "Return non-nil if FACE specifies a non-nil inverse-video.
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
-If FRAME is omitted or nil, use the selected frame."
- (eq (face-attribute face :inverse-video frame) t))
+If FRAME is omitted or nil, use the selected frame.
+Optional argument INHERIT is passed to `face-attribute'."
+ (eq (face-attribute face :inverse-video frame inherit) t))
-(defun face-bold-p (face &optional frame)
+(defun face-bold-p (face &optional frame inherit)
"Return non-nil if the font of FACE is bold on FRAME.
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
If FRAME is omitted or nil, use the selected frame.
+Optional argument INHERIT is passed to `face-attribute'.
Use `face-attribute' for finer control."
- (let ((bold (face-attribute face :weight frame)))
+ (let ((bold (face-attribute face :weight frame inherit)))
(memq bold '(semi-bold bold extra-bold ultra-bold))))
-(defun face-italic-p (face &optional frame)
+(defun face-italic-p (face &optional frame inherit)
"Return non-nil if the font of FACE is italic on FRAME.
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
If FRAME is omitted or nil, use the selected frame.
+Optional argument INHERIT is passed to `face-attribute'.
Use `face-attribute' for finer control."
- (let ((italic (face-attribute face :slant frame)))
+ (let ((italic (face-attribute face :slant frame inherit)))
(memq italic '(italic oblique))))
@@ -556,22 +565,23 @@ If FACE is a face-alias, get the documentation for the target face."
(defun set-face-attribute (face frame &rest args)
"Set attributes of FACE on FRAME from ARGS.
+This function overrides the face attributes specified by FACE's
+face spec. It is mostly intended for internal use only.
-FRAME nil means change attributes on all frames. FRAME t means change
-the default for new frames (this is done automatically each time an
-attribute is changed on all frames).
+If FRAME is nil, set the attributes for all existing frames, as
+well as the default for new frames. If FRAME is t, change the
+default for new frames only.
-ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a valid
-face attribute name. All attributes can be set to `unspecified';
-this fact is not further mentioned below.
+ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a
+valid face attribute name. All attributes can be set to
+`unspecified'; this fact is not further mentioned below.
The following attributes are recognized:
`:family'
-VALUE must be a string specifying the font family, e.g. ``monospace'',
-or a fontset alias name. If a font family is specified, wild-cards `*'
-and `?' are allowed.
+VALUE must be a string specifying the font family
+\(e.g. \"Monospace\") or a fontset.
`:foundry'
@@ -588,13 +598,13 @@ It must be one of the symbols `ultra-condensed', `extra-condensed',
`:height'
-VALUE specifies the height of the font, in either absolute or relative
-terms. An absolute height is an integer, and specifies font height in
-units of 1/10 pt. A relative height is either a floating point number,
+VALUE specifies the relative or absolute height of the font. An
+absolute height is an integer, and specifies font height in units
+of 1/10 pt. A relative height is either a floating point number,
which specifies a scaling factor for the underlying face height;
-or a function that takes a single argument (the underlying face height)
-and returns the new height. Note that for the `default' face,
-you can only specify an absolute height (since there is nothing
+or a function that takes a single argument (the underlying face
+height) and returns the new height. Note that for the `default'
+face, you must specify an absolute height (since there is nothing
for it to be relative to).
`:weight'
@@ -615,10 +625,21 @@ VALUE must be a color name, a string.
`:underline'
-VALUE specifies whether characters in FACE should be underlined. If
-VALUE is t, underline with foreground color of the face. If VALUE is
-a string, underline with that color. If VALUE is nil, explicitly
-don't underline.
+VALUE specifies whether characters in FACE should be underlined.
+If VALUE is t, underline with foreground color of the face.
+If VALUE is a string, underline with that color.
+If VALUE is nil, explicitly don't underline.
+
+Otherwise, VALUE must be a property list of the form:
+
+`(:color COLOR :style STYLE)'.
+
+COLOR can be a either a color name string or `foreground-color'.
+STYLE can be either `line' or `wave'.
+If a keyword/value pair is missing from the property list, a
+default value will be used for the value.
+The default value of COLOR is the foreground color of the face.
+The default value of STYLE is `line'.
`:overline'
@@ -676,19 +697,26 @@ from an X font name:
`:font'
-Set font-related face attributes from VALUE. VALUE must be a valid
-XLFD font name. If it is a font name pattern, the first matching font
-will be used.
-
-For compatibility with Emacs 20, keywords `:bold' and `:italic' can
-be used to specify that a bold or italic font should be used. VALUE
-must be t or nil in that case. A value of `unspecified' is not allowed.
+Set font-related face attributes from VALUE. VALUE must be a
+valid font name or font object. Setting this attribute will also
+set the `:family', `:foundry', `:width', `:height', `:weight',
+and `:slant' attributes.
`:inherit'
-VALUE is the name of a face from which to inherit attributes, or a list
-of face names. Attributes from inherited faces are merged into the face
-like an underlying face would be, with higher priority than underlying faces."
+VALUE is the name of a face from which to inherit attributes, or
+a list of face names. Attributes from inherited faces are merged
+into the face like an underlying face would be, with higher
+priority than underlying faces.
+
+For backward compatibility, the keywords `:bold' and `:italic'
+can be used to specify weight and slant respectively. This usage
+is considered obsolete. For these two keywords, the VALUE must
+be either t or nil. A value of t for `:bold' is equivalent to
+setting `:weight' to `bold', and a value of t for `:italic' is
+equivalent to setting `:slant' to `italic'. But if `:weight' is
+specified in the face spec, `:bold' is ignored, and if `:slant'
+is specified, `:italic' is ignored."
(setq args (purecopy args))
(let ((where (if (null frame) 0 frame))
(spec args)
@@ -814,24 +842,27 @@ and DATA is a string, containing the raw bits of the bitmap."
(set-face-attribute face frame :stipple (or stipple 'unspecified)))
-(defun set-face-underline-p (face underline &optional frame)
+(defun set-face-underline (face underline &optional frame)
"Specify whether face FACE is underlined.
UNDERLINE nil means FACE explicitly doesn't underline.
-UNDERLINE non-nil means FACE explicitly does underlining
-with the same of the foreground color.
-If UNDERLINE is a string, underline with the color named UNDERLINE.
+UNDERLINE t means FACE underlines with its foreground color.
+If UNDERLINE is a string, underline with that color.
+
+UNDERLINE may also be a list of the form (:color COLOR :style STYLE),
+where COLOR is a string or `foreground-color', and STYLE is either
+`line' or `wave'. :color may be omitted, which means to use the
+foreground color. :style may be omitted, which means to use a line.
+
FRAME nil or not specified means change face on all frames.
Use `set-face-attribute' to ``unspecify'' underlining."
- (interactive
- (let ((list (read-face-and-attribute :underline)))
- (list (car list) (eq (car (cdr list)) t))))
+ (interactive (read-face-and-attribute :underline))
(set-face-attribute face frame :underline underline))
-(define-obsolete-function-alias 'set-face-underline
- 'set-face-underline-p "22.1")
+(define-obsolete-function-alias 'set-face-underline-p
+ 'set-face-underline "24.3")
-(defun set-face-inverse-video-p (face inverse-video-p &optional frame)
+(defun set-face-inverse-video (face inverse-video-p &optional frame)
"Specify whether face FACE is in inverse video.
INVERSE-VIDEO-P non-nil means FACE displays explicitly in inverse video.
INVERSE-VIDEO-P nil means FACE explicitly is not in inverse video.
@@ -839,11 +870,13 @@ FRAME nil or not specified means change face on all frames.
Use `set-face-attribute' to ``unspecify'' the inverse video attribute."
(interactive
(let ((list (read-face-and-attribute :inverse-video)))
- (list (car list) (eq (car (cdr list)) t))))
+ (list (car list) (if (cadr list) t))))
(set-face-attribute face frame :inverse-video inverse-video-p))
+(define-obsolete-function-alias 'set-face-inverse-video-p
+ 'set-face-inverse-video "24.4")
-(defun set-face-bold-p (face bold-p &optional frame)
+(defun set-face-bold (face bold-p &optional frame)
"Specify whether face FACE is bold.
BOLD-P non-nil means FACE should explicitly display bold.
BOLD-P nil means FACE should explicitly display non-bold.
@@ -853,8 +886,10 @@ Use `set-face-attribute' or `modify-face' for finer control."
(make-face-unbold face frame)
(make-face-bold face frame)))
+(define-obsolete-function-alias 'set-face-bold-p 'set-face-bold "24.4")
-(defun set-face-italic-p (face italic-p &optional frame)
+
+(defun set-face-italic (face italic-p &optional frame)
"Specify whether face FACE is italic.
ITALIC-P non-nil means FACE should explicitly display italic.
ITALIC-P nil means FACE should explicitly display non-italic.
@@ -864,6 +899,8 @@ Use `set-face-attribute' or `modify-face' for finer control."
(make-face-unitalic face frame)
(make-face-italic face frame)))
+(define-obsolete-function-alias 'set-face-italic-p 'set-face-italic "24.4")
+
(defalias 'set-face-background-pixmap 'set-face-stipple)
@@ -892,13 +929,25 @@ of the default face. Value is FACE."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun read-face-name (prompt &optional default multiple)
- "Read a face, defaulting to the face or faces on the char after point.
-If it has the property `read-face-name', that overrides the `face' property.
-PROMPT should be a string that describes what the caller will do with the face;
-it should not end in a space.
+ "Read a face, defaulting to the face or faces at point.
+If the text at point has the property `read-face-name', that
+overrides the `face' property for determining the default.
+
+PROMPT should be a string that describes what the caller will do
+with the face; it should not end in a space.
+
+
+This function uses `completing-read-multiple' with \",\" as the
+separator character, i.e.
+
+
+
+
+
The optional argument DEFAULT provides the value to display in the
minibuffer prompt that is returned if the user just types RET
unless DEFAULT is a string (in which case nil is returned).
+
If MULTIPLE is non-nil, return a list of faces (possibly only one).
Otherwise, return a single face."
(let ((faceprop (or (get-char-property (point) 'read-face-name)
@@ -970,28 +1019,28 @@ Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value out
of a set of discrete values. Value is `integerp' if ATTRIBUTE expects
an integer value."
(let ((valid
- (case attribute
- (:family
+ (pcase attribute
+ (`:family
(if (window-system frame)
(mapcar (lambda (x) (cons x x))
(font-family-list))
;; Only one font on TTYs.
(list (cons "default" "default"))))
- (:foundry
+ (`:foundry
(list nil))
- (:width
+ (`:width
(mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-width-table))
- (:weight
+ (`:weight
(mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-weight-table))
- (:slant
+ (`:slant
(mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-slant-table))
- (:inverse-video
+ (`:inverse-video
(mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute)))
- ((:underline :overline :strike-through :box)
+ ((or `:underline `:overline `:strike-through `:box)
(if (window-system frame)
(nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))
@@ -999,12 +1048,12 @@ an integer value."
(defined-colors frame)))
(mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))))
- ((:foreground :background)
+ ((or `:foreground `:background)
(mapcar #'(lambda (c) (cons c c))
(defined-colors frame)))
- ((:height)
+ (`:height
'integerp)
- (:stipple
+ (`:stipple
(and (memq (window-system frame) '(x ns)) ; No stipple on w32
(mapcar #'list
(apply #'nconc
@@ -1013,11 +1062,11 @@ an integer value."
(file-directory-p dir)
(directory-files dir)))
x-bitmap-file-path)))))
- (:inherit
+ (`:inherit
(cons '("none" . nil)
(mapcar #'(lambda (c) (cons (symbol-name c) c))
(face-list))))
- (t
+ (_
(error "Internal error")))))
(if (and (listp valid) (not (memq attribute '(:inherit))))
(nconc (list (cons "unspecified" 'unspecified)) valid)
@@ -1091,6 +1140,9 @@ name of the attribute for prompting. Value is the new attribute value."
(string-to-number new-value)))))
+;; FIXME this does allow you to enter the list forms of :box,
+;; :stipple, or :underline, because face-valid-attribute-values does
+;; not return those forms.
(defun read-face-attribute (face attribute &optional frame)
"Interactively read a new value for FACE's ATTRIBUTE.
Optional argument FRAME nil or unspecified means read an attribute value
@@ -1102,12 +1154,11 @@ of a global face. Value is the new attribute value."
;; Represent complex attribute values as strings by printing them
;; out. Stipple can be a vector; (WIDTH HEIGHT DATA). Box can be
;; a list `(:width WIDTH :color COLOR)' or `(:width WIDTH :shadow
- ;; SHADOW)'.
- (when (and (or (eq attribute :stipple)
- (eq attribute :box))
- (or (consp old-value)
- (vectorp old-value)))
- (setq old-value (prin1-to-string old-value)))
+ ;; SHADOW)'. Underline can be `(:color COLOR :style STYLE)'.
+ (and (memq attribute '(:box :stipple :underline))
+ (or (consp old-value)
+ (vectorp old-value))
+ (setq old-value (prin1-to-string old-value)))
(cond ((listp valid)
(let ((default
(or (car (rassoc old-value valid))
@@ -1137,11 +1188,10 @@ of a global face. Value is the new attribute value."
;; Convert stipple and box value text we read back to a list or
;; vector if it looks like one. This makes the assumption that a
;; pixmap file name won't start with an open-paren.
- (when (and (or (eq attribute :stipple)
- (eq attribute :box))
- (stringp new-value)
- (string-match "^[[(]" new-value))
- (setq new-value (read new-value)))
+ (and (memq attribute '(:stipple :box :underline))
+ (stringp new-value)
+ (string-match "^[[(]" new-value)
+ (setq new-value (read new-value)))
new-value))
(declare-function fontset-list "fontset.c" ())
@@ -1180,8 +1230,8 @@ and the face and its settings are obtained by querying the user."
:foreground (or foreground 'unspecified)
:background (or background 'unspecified)
:stipple stipple
- :bold bold-p
- :italic italic-p
+ :weight (if bold-p 'bold 'normal)
+ :slant (if italic-p 'italic 'normal)
:underline underline
:inverse-video inverse-p)
(setq face (read-face-name "Modify face"))
@@ -1214,7 +1264,7 @@ Value is a list (FACE NEW-VALUE) where FACE is the face read
(defconst list-faces-sample-text
"abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- "*Text string to display as the sample text for `list-faces-display'.")
+ "Text string to display as the sample text for `list-faces-display'.")
;; The name list-faces would be more consistent, but let's avoid a
@@ -1512,42 +1562,55 @@ If SPEC is nil, return nil."
(defun face-spec-reset-face (face &optional frame)
"Reset all attributes of FACE on FRAME to unspecified."
- (let (reset-args)
- (dolist (attr-and-name face-attribute-name-alist)
- (push 'unspecified reset-args)
- (push (car attr-and-name) reset-args))
- (apply 'set-face-attribute face frame reset-args)))
+ (apply 'set-face-attribute face frame
+ (if (eq face 'default)
+ ;; For the default face, avoid making any attribute
+ ;; unspecified. Instead, set attributes to default values
+ ;; (see also realize_default_face in xfaces.c).
+ (append
+ '(:underline nil :overline nil :strike-through nil
+ :box nil :inverse-video nil :stipple nil :inherit nil)
+ ;; `display-graphic-p' is unavailable when running
+ ;; temacs, prior to loading frame.el.
+ (unless (and (fboundp 'display-graphic-p)
+ (display-graphic-p frame))
+ `(:family "default" :foundry "default" :width normal
+ :height 1 :weight normal :slant normal
+ :foreground ,(if (frame-parameter nil 'reverse)
+ "unspecified-bg"
+ "unspecified-fg")
+ :background ,(if (frame-parameter nil 'reverse)
+ "unspecified-fg"
+ "unspecified-bg"))))
+ ;; For all other faces, unspecify all attributes.
+ (apply 'append
+ (mapcar (lambda (x) (list (car x) 'unspecified))
+ face-attribute-name-alist)))))
(defun face-spec-set (face spec &optional for-defface)
- "Set FACE's face spec, which controls its appearance, to SPEC.
-If FOR-DEFFACE is t, set the base spec, the one that `defface'
- and Custom set. (In that case, the caller must put it in the
- appropriate property, because that depends on the caller.)
-If FOR-DEFFACE is nil, set the overriding spec (and store it
- in the `face-override-spec' property of FACE).
-
-The appearance of FACE is controlled by the base spec,
-by any custom theme specs on top of that, and by the
-overriding spec on top of all the rest.
-
-FOR-DEFFACE can also be a frame, in which case we set the
-frame-specific attributes of FACE for that frame based on SPEC.
-That usage is deprecated.
-
-See `defface' for information about the format and meaning of SPEC."
- (if (framep for-defface)
- ;; Handle the deprecated case where third arg is a frame.
- (face-spec-set-2 face for-defface spec)
- (if for-defface
- ;; When we reset the face based on its custom spec, then it is
- ;; unmodified as far as Custom is concerned.
- (put (or (get face 'face-alias) face) 'face-modified nil)
- ;; When we change a face based on a spec from outside custom,
- ;; record it for future frames.
- (put (or (get face 'face-alias) face) 'face-override-spec spec))
- ;; Reset each frame according to the rules implied by all its specs.
- (dolist (frame (frame-list))
- (face-spec-recalc face frame))))
+ "Set and apply the face spec for FACE.
+If the optional argument FOR-DEFFACE is omitted or nil, set the
+overriding spec to SPEC, recording it in the `face-override-spec'
+property of FACE. See `defface' for the format of SPEC.
+
+If FOR-DEFFACE is non-nil, set the base spec (the one set by
+`defface' and Custom). In this case, SPEC is ignored; the caller
+is responsible for putting the face spec in the `saved-face',
+`customized-face', or `face-defface-spec', as appropriate.
+
+The appearance of FACE is controlled by the base spec, by any
+custom theme specs on top of that, and by the overriding spec on
+top of all the rest."
+ (if for-defface
+ ;; When we reset the face based on its custom spec, then it is
+ ;; unmodified as far as Custom is concerned.
+ (put (or (get face 'face-alias) face) 'face-modified nil)
+ ;; When we change a face based on a spec from outside custom,
+ ;; record it for future frames.
+ (put (or (get face 'face-alias) face) 'face-override-spec spec))
+ ;; Reset each frame according to the rules implied by all its specs.
+ (dolist (frame (frame-list))
+ (face-spec-recalc face frame)))
(defun face-spec-recalc (face frame)
"Reset the face attributes of FACE on FRAME according to its specs.
@@ -1641,12 +1704,16 @@ If FRAME is nil, that stands for the selected frame."
(declare-function xw-color-defined-p "xfns.c" (color &optional frame))
(defun color-defined-p (color &optional frame)
- "Return non-nil if color COLOR is supported on frame FRAME.
-If FRAME is omitted or nil, use the selected frame.
-If COLOR is the symbol `unspecified' or one of the strings
-\"unspecified-fg\" or \"unspecified-bg\", the value is nil."
- (if (member color '(unspecified "unspecified-bg" "unspecified-fg"))
- nil
+ "Return non-nil if COLOR is supported on frame FRAME.
+COLOR should be a string naming a color (e.g. \"white\"), or a
+string specifying a color's RGB components (e.g. \"#ff12ec\"), or
+the symbol `unspecified'.
+
+This function returns nil if COLOR is the symbol `unspecified',
+or one of the strings \"unspecified-fg\" or \"unspecified-bg\".
+
+If FRAME is omitted or nil, use the selected frame."
+ (unless (member color '(unspecified "unspecified-bg" "unspecified-fg"))
(if (member (framep (or frame (selected-frame))) '(x w32 ns))
(xw-color-defined-p color frame)
(numberp (tty-color-translate color frame)))))
@@ -1831,6 +1898,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.
@@ -2235,8 +2303,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
@@ -2408,7 +2474,7 @@ Note: Other faces cannot inherit from the cursor face."
:group 'menu
:group 'basic-faces)
-(defface help-argument-name '((((supports :slant italic)) :inherit italic))
+(defface help-argument-name '((t :inherit italic))
"Face to highlight argument names in *Help* buffers."
:group 'help)
@@ -2422,33 +2488,31 @@ It is used for characters of no fonts too."
:group 'basic-faces)
(defface error
- '((((class color) (min-colors 88) (background light)) (:foreground "Red1" :weight bold))
- (((class color) (min-colors 88) (background dark)) (:foreground "Pink" :weight bold))
- (((class color) (min-colors 16) (background light)) (:foreground "Red1" :weight bold))
- (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :weight bold))
- (((class color) (min-colors 8)) (:foreground "red"))
- (t (:inverse-video t :weight bold)))
+ '((default :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "Red1")
+ (((class color) (min-colors 88) (background dark)) :foreground "Pink")
+ (((class color) (min-colors 16) (background light)) :foreground "Red1")
+ (((class color) (min-colors 16) (background dark)) :foreground "Pink")
+ (((class color) (min-colors 8)) :foreground "red")
+ (t :inverse-video t))
"Basic face used to highlight errors and to denote failure."
:version "24.1"
:group 'basic-faces)
(defface warning
- '((((class color) (min-colors 16)) (:foreground "DarkOrange" :weight bold))
- (((class color)) (:foreground "yellow" :weight bold))
- (t (:weight bold)))
+ '((default :weight bold)
+ (((class color) (min-colors 16)) :foreground "DarkOrange")
+ (((class color)) :foreground "yellow"))
"Basic face used to highlight warnings."
:version "24.1"
:group 'basic-faces)
(defface success
- '((((class color) (min-colors 16) (background light))
- (:foreground "ForestGreen" :weight bold))
- (((class color) (min-colors 88) (background dark))
- (:foreground "Green1" :weight bold))
- (((class color) (min-colors 16) (background dark))
- (:foreground "Green" :weight bold))
- (((class color)) (:foreground "green" :weight bold))
- (t (:weight bold)))
+ '((default :weight bold)
+ (((class color) (min-colors 16) (background light)) :foreground "ForestGreen")
+ (((class color) (min-colors 88) (background dark)) :foreground "Green1")
+ (((class color) (min-colors 16) (background dark)) :foreground "Green")
+ (((class color)) :foreground "green"))
"Basic face used to indicate successful operation."
:version "24.1"
:group 'basic-faces)
@@ -2539,6 +2603,12 @@ also the same size as FACE on FRAME, or fail."
(car fonts))
(cdr (assq 'font (frame-parameters (selected-frame))))))
+(defcustom font-list-limit 100
+ "This variable is obsolete and has no effect."
+ :type 'integer
+ :group 'display)
+(make-obsolete-variable 'font-list-limit nil "24.3")
+
(provide 'faces)
;;; faces.el ends here
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 74df9883324..4c75609fe01 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1,6 +1,6 @@
;;; ffap.el --- find file (or url) at point
-;; Copyright (C) 1995-1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
;; Maintainer: FSF
@@ -34,7 +34,7 @@
;; README's, MANIFEST's, and so on. Submit bugs or suggestions with
;; M-x ffap-bug.
;;
-;; For the default installation, add this line to your .emacs file:
+;; For the default installation, add this line to your init file:
;;
;; (ffap-bindings) ; do default key bindings
;;
@@ -105,6 +105,8 @@
;;; Code:
+(require 'url-parse)
+
(define-obsolete-variable-alias 'ffap-version 'emacs-version "23.2")
(defgroup ffap nil
@@ -136,10 +138,7 @@ If nil, ffap doesn't do shell prompt stripping."
regexp)
:group 'ffap)
-(defcustom ffap-ftp-regexp
- ;; This used to test for ange-ftp or efs being present, but it should be
- ;; harmless (and simpler) to give it this value unconditionally.
- "\\`/[^/:]+:"
+(defcustom ffap-ftp-regexp "\\`/[^/:]+:"
"File names matching this regexp are treated as remote ffap.
If nil, ffap neither recognizes nor generates such names."
:type '(choice (const :tag "Disable" nil)
@@ -148,15 +147,20 @@ If nil, ffap neither recognizes nor generates such names."
:group 'ffap)
(defcustom ffap-url-unwrap-local t
- "If non-nil, convert `file:' URL to local file name before prompting."
+ "If non-nil, convert some URLs to local file names before prompting.
+Only \"file:\" and \"ftp:\" URLs are converted, and only if they
+do not specify a host, or the host is either \"localhost\" or
+equal to `system-name'."
:type 'boolean
:group 'ffap)
-(defcustom ffap-url-unwrap-remote t
- "If non-nil, convert `ftp:' URL to remote file name before prompting.
-This is ignored if `ffap-ftp-regexp' is nil."
- :type 'boolean
- :group 'ffap)
+(defcustom ffap-url-unwrap-remote '("ftp")
+ "If non-nil, convert URLs to remote file names before prompting.
+If the value is a list of strings, that specifies a list of URL
+schemes (e.g. \"ftp\"); in that case, only convert those URLs."
+ :type '(choice (repeat string) boolean)
+ :group 'ffap
+ :version "24.3")
(defcustom ffap-ftp-default-user "anonymous"
"User name in ftp file names generated by `ffap-host-to-path'.
@@ -202,7 +206,7 @@ Sensible values are nil, \"news\", or \"mailto\"."
;; those features interesting but not clear winners (a matter of
;; personal taste) I try to leave options to enable them. Read
;; through this section for features that you like, put an appropriate
-;; enabler in your .emacs file.
+;; enabler in your init file.
(defcustom ffap-dired-wildcards "[*?][^/]*\\'"
"A regexp matching filename wildcard characters, or nil.
@@ -247,14 +251,14 @@ ffap most of the time."
(defcustom ffap-file-finder 'find-file
"The command called by `find-file-at-point' to find a file."
:type 'function
- :group 'ffap)
-(put 'ffap-file-finder 'risky-local-variable t)
+ :group 'ffap
+ :risky t)
(defcustom ffap-directory-finder 'dired
"The command called by `dired-at-point' to find a directory."
:type 'function
- :group 'ffap)
-(put 'ffap-directory-finder 'risky-local-variable t)
+ :group 'ffap
+ :risky t)
(defcustom ffap-url-fetcher
(if (fboundp 'browse-url)
@@ -271,8 +275,28 @@ For a fancy alternative, get `ffap-url.el'."
(const browse-url-netscape)
(const browse-url-mosaic)
function)
+ :group 'ffap
+ :risky t)
+
+(defcustom ffap-next-regexp
+ ;; If you want ffap-next to find URL's only, try this:
+ ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
+ ;; (concat "\\<" (substring ffap-url-regexp 2))))
+ ;;
+ ;; It pays to put a big fancy regexp here, since ffap-guesser is
+ ;; much more time-consuming than regexp searching:
+ "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
+ "Regular expression governing movements of `ffap-next'."
+ :type 'regexp
:group 'ffap)
-(put 'ffap-url-fetcher 'risky-local-variable t)
+
+(defcustom dired-at-point-require-prefix nil
+ "If non-nil, reverse the prefix argument to `dired-at-point'.
+This is nil so neophytes notice FFAP. Experts may prefer to
+disable FFAP most of the time."
+ :type 'boolean
+ :group 'ffap
+ :version "20.3")
;;; Compatibility:
@@ -293,18 +317,6 @@ For a fancy alternative, get `ffap-url.el'."
;; then, broke it up into ffap-next-guess (noninteractive) and
;; ffap-next (a command). It now work on files as well as url's.
-(defcustom ffap-next-regexp
- ;; If you want ffap-next to find URL's only, try this:
- ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
- ;; (concat "\\<" (substring ffap-url-regexp 2))))
- ;;
- ;; It pays to put a big fancy regexp here, since ffap-guesser is
- ;; much more time-consuming than regexp searching:
- "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
- "Regular expression governing movements of `ffap-next'."
- :type 'regexp
- :group 'ffap)
-
(defvar ffap-next-guess nil
"Last value returned by `ffap-next-guess'.")
@@ -470,18 +482,12 @@ Returned values:
(defun ffap-replace-file-component (fullname name)
"In remote FULLNAME, replace path with NAME. May return nil."
- ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
- (let (found)
- (mapc
- (function (lambda (sym) (and (fboundp sym) (setq found sym))))
- '(
- efs-replace-path-component
- ange-ftp-replace-path-component
- ange-ftp-replace-name-component
- ))
- (and found
- (fset 'ffap-replace-file-component found)
- (funcall found fullname name))))
+ ;; Use efs if loaded, but do not load it otherwise.
+ (if (fboundp 'efs-replace-path-component)
+ (funcall efs-replace-path-component fullname name)
+ (and (stringp fullname)
+ (stringp name)
+ (concat (file-remote-p fullname) name))))
;; (ffap-replace-file-component "/who@foo.com:/whatever" "/new")
(defun ffap-file-suffix (file)
@@ -606,28 +612,45 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
string)))
;; Broke these out of ffap-fixup-url, for use of ffap-url package.
-(defsubst ffap-url-unwrap-local (url)
- "Return URL as a local file, or nil. Ignores `ffap-url-regexp'."
- (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url)
- (substring url (1+ (match-end 1)))))
-(defsubst ffap-url-unwrap-remote (url)
- "Return URL as a remote file, or nil. Ignores `ffap-url-regexp'."
- (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
- (concat
- (ffap-host-to-filename (substring url (match-beginning 2) (match-end 2)))
- (substring url (match-beginning 3) (match-end 3)))))
-;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")
+(defun ffap-url-unwrap-local (url)
+ "Return URL as a local file name, or nil."
+ (let* ((obj (url-generic-parse-url url))
+ (host (url-host obj))
+ (filename (car (url-path-and-query obj))))
+ (when (and (member (url-type obj) '("ftp" "file"))
+ (member host `("" "localhost" ,(system-name))))
+ ;; On Windows, "file:///C:/foo" should unwrap to "C:/foo"
+ (if (and (memq system-type '(ms-dos windows-nt cygwin))
+ (string-match "\\`/[a-zA-Z]:" filename))
+ (substring filename 1)
+ filename))))
+
+(defun ffap-url-unwrap-remote (url)
+ "Return URL as a remote file name, or nil."
+ (let* ((obj (url-generic-parse-url url))
+ (scheme (url-type obj))
+ (valid-schemes (if (listp ffap-url-unwrap-remote)
+ ffap-url-unwrap-remote
+ '("ftp")))
+ (host (url-host obj))
+ (port (url-port-if-non-default obj))
+ (user (url-user obj))
+ (filename (car (url-path-and-query obj))))
+ (when (and (member scheme valid-schemes)
+ (string-match "\\`[a-zA-Z][-a-zA-Z0-9+.]*\\'" scheme)
+ (not (equal host "")))
+ (concat "/" scheme ":"
+ (if user (concat user "@"))
+ host
+ (if port (concat "#" (number-to-string port)))
+ ":" filename))))
(defun ffap-fixup-url (url)
"Clean up URL and return it, maybe as a file name."
(cond
((not (stringp url)) nil)
- ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
- ((and ffap-url-unwrap-remote ffap-ftp-regexp
- (ffap-url-unwrap-remote url)))
- ;; All this seems to do is remove any trailing "#anchor" part (Bug#898).
-;;; ((fboundp 'url-normalize-url) ; may autoload url (part of w3)
-;;; (url-normalize-url url))
+ ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
+ ((and ffap-url-unwrap-remote (ffap-url-unwrap-remote url)))
(url)))
@@ -850,9 +873,24 @@ URL, or nil. If nil, search the alist for further matches.")
(and (not (string-match "\\.el\\'" name))
(ffap-locate-file name '(".el") load-path)))
+;; FIXME this duplicates the logic of Man-header-file-path.
+;; There should be a single central variable or function for this.
+;; See also (bug#10702):
+;; cc-search-directories, semantic-c-dependency-system-include-path,
+;; semantic-gcc-setup
(defvar ffap-c-path
- ;; Need smarter defaults here! Suggestions welcome.
- '("/usr/include" "/usr/local/include"))
+ (let ((arch (with-temp-buffer
+ (when (eq 0 (ignore-errors
+ (call-process "gcc" nil '(t nil) nil
+ "-print-multiarch")))
+ (goto-char (point-min))
+ (buffer-substring (point) (line-end-position)))))
+ (base '("/usr/include" "/usr/local/include")))
+ (if (zerop (length arch))
+ base
+ (append base (list (expand-file-name arch "/usr/include")))))
+ "List of directories to search for include files.")
+
(defun ffap-c-mode (name)
(ffap-locate-file name t ffap-c-path))
@@ -1061,38 +1099,33 @@ Assumes the buffer has not changed."
;; ignore non-relative links, trim punctuation. The other will
;; actually look back if point is in whitespace, but I would rather
;; ffap be less aggressive in such situations.
- (and
- ffap-url-regexp
- (or
- ;; In a w3 buffer button?
- (and (eq major-mode 'w3-mode)
- ;; interface recommended by wmperry:
- (w3-view-this-url t))
- ;; Is there a reason not to strip trailing colon?
- (let ((name (ffap-string-at-point 'url)))
- (cond
- ((string-match "^url:" name) (setq name (substring name 4)))
- ((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name)
- ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
- ;; Without "<>" it must be "mailto". Otherwise could be
- ;; either, so consult `ffap-foo-at-bar-prefix'.
- (let ((prefix (if (and (equal (ffap-string-around) "<>")
- ;; Expect some odd characters:
- (string-match "[$.0-9].*[$.0-9].*@" name))
- ;; Could be news:
- ffap-foo-at-bar-prefix
- "mailto")))
- (and prefix (setq name (concat prefix ":" name))))))
- ((ffap-newsgroup-p name) (setq name (concat "news:" name)))
- ((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody>
- (equal (ffap-string-around) "<>")
- ;; (ffap-user-p name):
- (not (string-match "~" (expand-file-name (concat "~" name))))
- )
- (setq name (concat "mailto:" name)))
- )
- (and (ffap-url-p name) name)
- ))))
+ (when ffap-url-regexp
+ (or (and (eq major-mode 'w3-mode) ; In a w3 buffer button?
+ (w3-view-this-url t))
+ ;; Is there a reason not to strip trailing colon?
+ (let ((name (ffap-string-at-point 'url)))
+ (cond
+ ((string-match "^url:" name) (setq name (substring name 4)))
+ ((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name)
+ ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
+ ;; Without "<>" it must be "mailto". Otherwise could be
+ ;; either, so consult `ffap-foo-at-bar-prefix'.
+ (let ((prefix (if (and (equal (ffap-string-around) "<>")
+ ;; Expect some odd characters:
+ (string-match "[$.0-9].*[$.0-9].*@" name))
+ ;; Could be news:
+ ffap-foo-at-bar-prefix
+ "mailto")))
+ (and prefix (setq name (concat prefix ":" name))))))
+ ((ffap-newsgroup-p name) (setq name (concat "news:" name)))
+ ((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody>
+ (equal (ffap-string-around) "<>")
+ ;; (ffap-user-p name):
+ (not (string-match "~" (expand-file-name (concat "~" name)))))
+ (setq name (concat "mailto:" name))))
+
+ (if (ffap-url-p name)
+ name)))))
(defvar ffap-gopher-regexp
"^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
@@ -1325,24 +1358,8 @@ which may actually result in an URL rather than a filename."
;; We must inform complete about whether our completion function
;; will do filename style completion.
-(defun ffap-complete-as-file-p ()
- ;; Will `minibuffer-completion-table' complete the minibuffer
- ;; contents as a filename? Assumes the minibuffer is current.
- ;; Note: t and non-nil mean somewhat different reasons.
- (if (eq minibuffer-completion-table 'ffap-read-file-or-url-internal)
- (not (ffap-url-p (buffer-string))) ; t
- (and minibuffer-completing-file-name '(t)))) ;list
-
-(and
- (featurep 'complete)
- (if (boundp 'PC-completion-as-file-name-predicate)
- ;; modern version of complete.el, just set the variable:
- (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p)))
-
;;; Highlighting (`ffap-highlight'):
-;;
-;; Based on overlay highlighting in Emacs 19.28 isearch.el.
(defvar ffap-highlight t
"If non-nil, ffap highlights the current buffer substring.")
@@ -1456,10 +1473,12 @@ and the functions `ffap-file-at-point' and `ffap-url-at-point'."
;;; Menu support (`ffap-menu'):
-(defvar ffap-menu-regexp nil
- "*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'.
+(defcustom ffap-menu-regexp nil
+ "If non-nil, regexp overriding `ffap-next-regexp' in `ffap-menu'.
Make this more restrictive for faster menu building.
-For example, try \":/\" for URL (and some ftp) references.")
+For example, try \":/\" for URL (and some ftp) references."
+ :type '(choice (const nil) regexp)
+ :group 'ffap)
(defvar ffap-menu-alist nil
"Buffer local cache of menu presented by `ffap-menu'.")
@@ -1673,6 +1692,13 @@ Only intended for interactive use."
(set-window-dedicated-p win wdp))
value))
+(defun ffap--toggle-read-only (buffer-or-list)
+ (dolist (buffer (if (listp buffer-or-list)
+ buffer-or-list
+ (list buffer-or-list)))
+ (with-current-buffer buffer
+ (read-only-mode 1))))
+
(defun ffap-read-only ()
"Like `ffap', but mark buffer as read-only.
Only intended for interactive use."
@@ -1680,8 +1706,7 @@ Only intended for interactive use."
(let ((value (call-interactively 'ffap)))
(unless (or (bufferp value) (bufferp (car-safe value)))
(setq value (current-buffer)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
+ (ffap--toggle-read-only value)
value))
(defun ffap-read-only-other-window ()
@@ -1689,8 +1714,7 @@ Only intended for interactive use."
Only intended for interactive use."
(interactive)
(let ((value (ffap-other-window)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
+ (ffap--toggle-read-only value)
value))
(defun ffap-read-only-other-frame ()
@@ -1698,8 +1722,7 @@ Only intended for interactive use."
Only intended for interactive use."
(interactive)
(let ((value (ffap-other-frame)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
+ (ffap--toggle-read-only value)
value))
(defun ffap-alternate-file ()
@@ -1740,8 +1763,7 @@ Only intended for interactive use."
(defun ffap-ro-mode-hook ()
"Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
(local-set-key "\M-l" 'ffap-next)
- (local-set-key "\M-m" 'ffap-menu)
- )
+ (local-set-key "\M-m" 'ffap-menu))
(defun ffap-gnus-hook ()
"Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
@@ -1785,13 +1807,6 @@ Only intended for interactive use."
(interactive) (ffap-gnus-wrapper '(ffap-menu)))
-(defcustom dired-at-point-require-prefix nil
- "If set, reverses the prefix argument to `dired-at-point'.
-This is nil so neophytes notice ffap. Experts may prefer to disable
-ffap most of the time."
- :type 'boolean
- :group 'ffap
- :version "20.3")
;;;###autoload
(defun dired-at-point (&optional filename)
@@ -1898,7 +1913,7 @@ Only intended for interactive use."
;;; Hooks to put in `file-name-at-point-functions':
;;;###autoload
-(progn (defun ffap-guess-file-name-at-point ()
+(defun ffap-guess-file-name-at-point ()
"Try to get a file name at point.
This hook is intended to be put in `file-name-at-point-functions'."
(when (fboundp 'ffap-guesser)
@@ -1915,14 +1930,13 @@ This hook is intended to be put in `file-name-at-point-functions'."
(when guess
(if (file-directory-p guess)
(file-name-as-directory guess)
- guess))))))
+ guess)))))
;;; Offer default global bindings (`ffap-bindings'):
(defvar ffap-bindings
- '(
- (global-set-key [S-mouse-3] 'ffap-at-mouse)
+ '((global-set-key [S-mouse-3] 'ffap-at-mouse)
(global-set-key [C-S-mouse-3] 'ffap-menu)
(global-set-key "\C-x\C-f" 'find-file-at-point)
@@ -1942,9 +1956,7 @@ This hook is intended to be put in `file-name-at-point-functions'."
(add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
(add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
(add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
- (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
- ;; (setq dired-x-hands-off-my-keys t) ; the default
- )
+ (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook))
"List of binding forms evaluated by function `ffap-bindings'.
A reasonable ffap installation needs just this one line:
(ffap-bindings)
diff --git a/lisp/filecache.el b/lisp/filecache.el
index ef41fb41907..bc77c24fe63 100644
--- a/lisp/filecache.el
+++ b/lisp/filecache.el
@@ -1,6 +1,6 @@
;;; filecache.el --- find files using a pre-loaded cache
-;; Copyright (C) 1996, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2000-2012 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Sun Nov 10 1996
@@ -139,9 +139,6 @@
;;; Code:
-(eval-when-compile
- (require 'find-lisp))
-
(defgroup file-cache nil
"Find files using a pre-loaded cache."
:group 'files
@@ -270,42 +267,63 @@ files of names DIRNAME1/FILENAME, DIRNAME2/FILENAME, ...")
;; Functions to add files to the cache
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun file-cache--read-list (file op-prompt)
+ (let* ((fun (if file 'read-file-name 'read-directory-name))
+ (type (if file "file" "directory"))
+ (prompt-1 (concat op-prompt " " type ": "))
+ (prompt-2 (concat op-prompt " another " type "?"))
+ (continue t)
+ result)
+ (while continue
+ (push (funcall fun prompt-1 nil nil t) result)
+ (setq continue (y-or-n-p prompt-2)))
+ (nreverse result)))
+
;;;###autoload
(defun file-cache-add-directory (directory &optional regexp)
- "Add DIRECTORY to the file cache.
-If the optional REGEXP argument is non-nil, only files which match it will
-be added to the cache."
- (interactive "DAdd files from directory: ")
+ "Add all files in DIRECTORY to the file cache.
+If called from Lisp with a non-nil REGEXP argument is non-nil,
+only add files whose names match REGEXP."
+ (interactive (list (read-directory-name "Add files from directory: "
+ nil nil t)
+ nil))
;; Not an error, because otherwise we can't use load-paths that
;; contain non-existent directories.
- (if (not (file-accessible-directory-p directory))
- (message "Directory %s does not exist" directory)
+ (when (file-accessible-directory-p directory)
(let* ((dir (expand-file-name directory))
(dir-files (directory-files dir t regexp)))
;; Filter out files we don't want to see
(dolist (file dir-files)
- (if (file-directory-p file)
- (setq dir-files (delq file dir-files))
- (dolist (regexp file-cache-filter-regexps)
- (if (string-match regexp file)
- (setq dir-files (delq file dir-files))))))
+ (if (file-directory-p file)
+ (setq dir-files (delq file dir-files))
+ (dolist (regexp file-cache-filter-regexps)
+ (if (string-match regexp file)
+ (setq dir-files (delq file dir-files))))))
(file-cache-add-file-list dir-files))))
;;;###autoload
-(defun file-cache-add-directory-list (directory-list &optional regexp)
- "Add DIRECTORY-LIST (a list of directory names) to the file cache.
+(defun file-cache-add-directory-list (directories &optional regexp)
+ "Add DIRECTORIES (a list of directory names) to the file cache.
+If called interactively, read the directory names one by one.
If the optional REGEXP argument is non-nil, only files which match it
will be added to the cache. Note that the REGEXP is applied to the
files in each directory, not to the directory list itself."
- (interactive "XAdd files from directory list: ")
- (mapcar
- (lambda (dir) (file-cache-add-directory dir regexp))
- directory-list))
-
-(defun file-cache-add-file-list (file-list)
- "Add FILE-LIST (a list of files names) to the file cache."
- (interactive "XFile List: ")
- (mapcar 'file-cache-add-file file-list))
+ (interactive (list (file-cache--read-list nil "Add")))
+ (dolist (dir directories)
+ (file-cache-add-directory dir regexp))
+ (let ((n (length directories)))
+ (message "Filecache: cached file names from %d director%s."
+ n (if (= n 1) "y" "ies"))))
+
+(defun file-cache-add-file-list (files)
+ "Add FILES (a list of file names) to the file cache.
+If called interactively, read the file names one by one."
+ (interactive (list (file-cache--read-list t "Add")))
+ (dolist (f files)
+ (file-cache-add-file f))
+ (let ((n (length files)))
+ (message "Filecache: cached %d file name%s."
+ n (if (= n 1) "" "s"))))
;; Workhorse function
@@ -313,23 +331,25 @@ files in each directory, not to the directory list itself."
(defun file-cache-add-file (file)
"Add FILE to the file cache."
(interactive "fAdd File: ")
- (if (not (file-exists-p file))
- (message "Filecache: file %s does not exist" file)
- (let* ((file-name (file-name-nondirectory file))
- (dir-name (file-name-directory file))
- (the-entry (assoc-string
- file-name file-cache-alist
- file-cache-ignore-case)))
- ;; Does the entry exist already?
- (if the-entry
- (if (or (and (stringp (cdr the-entry))
- (string= dir-name (cdr the-entry)))
- (and (listp (cdr the-entry))
- (member dir-name (cdr the-entry))))
- nil
- (setcdr the-entry (cons dir-name (cdr the-entry))))
- ;; If not, add it to the cache
- (push (list file-name dir-name) file-cache-alist)))))
+ (setq file (file-truename file))
+ (unless (file-exists-p file)
+ (error "Filecache: file %s does not exist" file))
+ (let* ((file-name (file-name-nondirectory file))
+ (dir-name (file-name-directory file))
+ (the-entry (assoc-string file-name file-cache-alist
+ file-cache-ignore-case)))
+ (cond ((null the-entry)
+ ;; If the entry wasn't in the cache, add it.
+ (push (list file-name dir-name) file-cache-alist)
+ (if (called-interactively-p 'interactive)
+ (message "Filecache: cached file name %s." file)))
+ ((not (member dir-name (cdr the-entry)))
+ (setcdr the-entry (cons dir-name (cdr the-entry)))
+ (if (called-interactively-p 'interactive)
+ (message "Filecache: cached file name %s." file)))
+ (t
+ (if (called-interactively-p 'interactive)
+ (message "Filecache: %s is already cached." file))))))
;;;###autoload
(defun file-cache-add-directory-using-find (directory)
@@ -366,6 +386,8 @@ STRING is passed as an argument to the locate command."
string)
(file-cache-add-from-file-cache-buffer))
+(autoload 'find-lisp-find-files "find-lisp")
+
;;;###autoload
(defun file-cache-add-directory-recursively (dir &optional regexp)
"Adds DIR and any subdirectories to the file-cache.
@@ -374,18 +396,16 @@ If the optional REGEXP argument is non-nil, only files which match it
will be added to the cache. Note that the REGEXP is applied to the
files in each directory, not to the directory list itself."
(interactive "DAdd directory: ")
- (require 'find-lisp)
(mapcar
- (function
- (lambda (file)
- (or (file-directory-p file)
- (let (filtered)
- (dolist (regexp file-cache-filter-regexps)
- (and (string-match regexp file)
- (setq filtered t)))
- filtered)
- (file-cache-add-file file))))
- (find-lisp-find-files dir (if regexp regexp "^"))))
+ (lambda (file)
+ (or (file-directory-p file)
+ (let (filtered)
+ (dolist (regexp file-cache-filter-regexps)
+ (and (string-match regexp file)
+ (setq filtered t)))
+ filtered)
+ (file-cache-add-file file)))
+ (find-lisp-find-files dir (or regexp "^"))))
(defun file-cache-add-from-file-cache-buffer (&optional regexp)
"Add any entries found in the file cache buffer.
@@ -415,17 +435,26 @@ or the optional REGEXP argument."
;; This clears *all* files with the given name
(defun file-cache-delete-file (file)
- "Delete FILE from the file cache."
+ "Delete FILE (a relative file name) from the file cache.
+Return nil if FILE was not in the file cache, non-nil otherwise."
(interactive
(list (completing-read "Delete file from cache: " file-cache-alist)))
- (setq file-cache-alist
- (delq (assoc-string file file-cache-alist file-cache-ignore-case)
- file-cache-alist)))
-
-(defun file-cache-delete-file-list (file-list)
- "Delete FILE-LIST (a list of files) from the file cache."
- (interactive "XFile List: ")
- (mapcar 'file-cache-delete-file file-list))
+ (let ((elt (assoc-string file file-cache-alist file-cache-ignore-case)))
+ (setq file-cache-alist (delq elt file-cache-alist))
+ elt))
+
+(defun file-cache-delete-file-list (files &optional message)
+ "Delete FILES (a list of files) from the file cache.
+If called interactively, read the file names one by one.
+If MESSAGE is non-nil, or if called interactively, print a
+message reporting the number of file names deleted."
+ (interactive (list (file-cache--read-list t "Uncache") t))
+ (let ((n 0))
+ (dolist (f files)
+ (if (file-cache-delete-file f)
+ (setq n (1+ n))))
+ (message "Filecache: uncached %d file name%s."
+ n (if (= n 1) "" "s"))))
(defun file-cache-delete-file-regexp (regexp)
"Delete files matching REGEXP from the file cache."
@@ -434,21 +463,18 @@ or the optional REGEXP argument."
(dolist (elt file-cache-alist)
(and (string-match regexp (car elt))
(push (car elt) delete-list)))
- (file-cache-delete-file-list delete-list)
- (message "Filecache: deleted %d files from file cache"
- (length delete-list))))
+ (file-cache-delete-file-list delete-list)))
(defun file-cache-delete-directory (directory)
"Delete DIRECTORY from the file cache."
(interactive "DDelete directory from file cache: ")
(let ((dir (expand-file-name directory))
- (result 0))
+ (n 0))
(dolist (entry file-cache-alist)
(if (file-cache-do-delete-directory dir entry)
- (setq result (1+ result))))
- (if (zerop result)
- (error "Filecache: no entries containing %s found in cache" directory)
- (message "Filecache: deleted %d entries" result))))
+ (setq n (1+ n))))
+ (message "Filecache: uncached %d file name%s."
+ n (if (= n 1) "" "s"))))
(defun file-cache-do-delete-directory (dir entry)
(let ((directory-list (cdr entry))
@@ -459,10 +485,12 @@ or the optional REGEXP argument."
(delq entry file-cache-alist))
(setcdr entry (delete directory directory-list))))))
-(defun file-cache-delete-directory-list (directory-list)
- "Delete DIRECTORY-LIST (a list of directories) from the file cache."
- (interactive "XDirectory List: ")
- (mapcar 'file-cache-delete-directory directory-list))
+(defun file-cache-delete-directory-list (directories)
+ "Delete DIRECTORIES (a list of directory names) from the file cache.
+If called interactively, read the directory names one by one."
+ (interactive (list (file-cache--read-list nil "Uncache")))
+ (dolist (d directories)
+ (file-cache-delete-directory d)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utility functions
diff --git a/lisp/files-x.el b/lisp/files-x.el
index ca847097184..e28e2ba83e3 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -1,6 +1,6 @@
;;; files-x.el --- extended file handling commands
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Juri Linkov <juri@jurta.org>
;; Maintainer: FSF
@@ -49,7 +49,7 @@ Intended to be used in the `interactive' spec of
(format "%s: " prompt))
obarray
(lambda (sym)
- (or (user-variable-p sym)
+ (or (custom-variable-p sym)
(get sym 'safe-local-variable)
(memq sym '(mode eval coding unibyte))))
nil nil nil default nil))
diff --git a/lisp/files.el b/lisp/files.el
index 0f7386511f6..496f9bf8fa4 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1,6 +1,6 @@
;;; files.el --- file input and output commands for Emacs
-;; Copyright (C) 1985-1987, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Package: emacs
@@ -28,8 +28,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(defvar font-lock-keywords)
(defgroup backup nil
@@ -415,13 +413,13 @@ location of point in the current buffer."
;;;It is not useful to make this a local variable.
;;;(put 'find-file-not-found-hooks 'permanent-local t)
+(define-obsolete-variable-alias 'find-file-not-found-hooks
+ 'find-file-not-found-functions "22.1")
(defvar find-file-not-found-functions nil
"List of functions to be called for `find-file' on nonexistent file.
These functions are called as soon as the error is detected.
Variable `buffer-file-name' is already set up.
The functions are called in the order given until one of them returns non-nil.")
-(define-obsolete-variable-alias 'find-file-not-found-hooks
- 'find-file-not-found-functions "22.1")
;;;It is not useful to make this a local variable.
;;;(put 'find-file-hooks 'permanent-local t)
@@ -435,6 +433,7 @@ functions are called."
:options '(auto-insert)
:version "22.1")
+(define-obsolete-variable-alias 'write-file-hooks 'write-file-functions "22.1")
(defvar write-file-functions nil
"List of functions to be called before writing out a buffer to a file.
If one of them returns non-nil, the file is considered already written
@@ -451,13 +450,14 @@ coding system and setting mode bits. (See Info
node `(elisp)Saving Buffers'.) To perform various checks or
updates before the buffer is saved, use `before-save-hook'.")
(put 'write-file-functions 'permanent-local t)
-(define-obsolete-variable-alias 'write-file-hooks 'write-file-functions "22.1")
(defvar local-write-file-hooks nil)
(make-variable-buffer-local 'local-write-file-hooks)
(put 'local-write-file-hooks 'permanent-local t)
(make-obsolete-variable 'local-write-file-hooks 'write-file-functions "22.1")
+(define-obsolete-variable-alias 'write-contents-hooks
+ 'write-contents-functions "22.1")
(defvar write-contents-functions nil
"List of functions to be called before writing out a buffer to a file.
If one of them returns non-nil, the file is considered already written
@@ -475,8 +475,6 @@ For hooks that _do_ pertain to the particular visited file, use
To perform various checks or updates before the buffer is saved,
use `before-save-hook'.")
(make-variable-buffer-local 'write-contents-functions)
-(define-obsolete-variable-alias 'write-contents-hooks
- 'write-contents-functions "22.1")
(defcustom enable-local-variables t
"Control use of local variables in files you visit.
@@ -510,14 +508,36 @@ and ignores this variable."
(other :tag "Query" other))
:group 'find-file)
+;; This is an odd variable IMO.
+;; You might wonder why it is needed, when we could just do:
+;; (set (make-local-variable 'enable-local-variables) nil)
+;; These two are not precisely the same.
+;; Setting this variable does not cause -*- mode settings to be
+;; ignored, whereas setting enable-local-variables does.
+;; Only three places in Emacs use this variable: tar and arc modes,
+;; and rmail. The first two don't need it. They already use
+;; inhibit-local-variables-regexps, which is probably enough, and
+;; could also just set enable-local-variables locally to nil.
+;; Them setting it has the side-effect that dir-locals cannot apply to
+;; eg tar files (?). FIXME Is this appropriate?
+;; AFAICS, rmail is the only thing that needs this, and the only
+;; reason it uses it is for BABYL files (which are obsolete).
+;; These contain "-*- rmail -*-" in the first line, which rmail wants
+;; to respect, so that find-file on a BABYL file will switch to
+;; rmail-mode automatically (this is nice, but hardly essential,
+;; since most people are used to explicitly running a command to
+;; access their mail; M-x gnus etc). Rmail files may happen to
+;; contain Local Variables sections in messages, which Rmail wants to
+;; ignore. So AFAICS the only reason this variable exists is for a
+;; minor convenience feature for handling of an obsolete Rmail file format.
(defvar local-enable-local-variables t
"Like `enable-local-variables' but meant for buffer-local bindings.
The meaningful values are nil and non-nil. The default is non-nil.
If a major mode sets this to nil, buffer-locally, then any local
-variables list in the file will be ignored.
+variables list in a file visited in that mode will be ignored.
-This variable does not affect the use of major modes
-specified in a -*- line.")
+This variable does not affect the use of major modes specified
+in a -*- line.")
(defcustom enable-local-eval 'maybe
"Control processing of the \"variable\" `eval' in a file's local variables.
@@ -638,22 +658,13 @@ Not actually set up until the first time you use it.")
(defun parse-colon-path (search-path)
"Explode a search path into a list of directory names.
-Directories are separated by occurrences of `path-separator'
-\(which is colon in GNU and GNU-like systems)."
- ;; We could use split-string here.
- (and search-path
- (let (cd-list (cd-start 0) cd-colon)
- (setq search-path (concat search-path path-separator))
- (while (setq cd-colon (string-match path-separator search-path cd-start))
- (setq cd-list
- (nconc cd-list
- (list (if (= cd-start cd-colon)
- nil
- (substitute-in-file-name
- (file-name-as-directory
- (substring search-path cd-start cd-colon)))))))
- (setq cd-start (+ cd-colon 1)))
- cd-list)))
+Directories are separated by `path-separator' (which is colon in
+GNU and Unix systems). Substitute environment variables into the
+resulting list of directory names."
+ (when (stringp search-path)
+ (mapcar (lambda (f)
+ (substitute-in-file-name (file-name-as-directory f)))
+ (split-string search-path path-separator t))))
(defun cd-absolute (dir)
"Change current directory to given absolute file name DIR."
@@ -719,7 +730,7 @@ The path separator is colon in GNU and GNU-like systems."
;; This is a case where .elc makes a lot of sense.
(interactive (list (let ((completion-ignored-extensions
(remove ".elc" completion-ignored-extensions)))
- (read-file-name "Load file: "))))
+ (read-file-name "Load file: " nil nil 'lambda))))
(load (expand-file-name file) nil nil t))
(defun locate-file (filename path &optional suffixes predicate)
@@ -760,10 +771,10 @@ one or more of those symbols."
(read-file-name-internal string pred action))
((eq (car-safe action) 'boundaries)
(let ((suffix (cdr action)))
- (list* 'boundaries
- (length (file-name-directory string))
- (let ((x (file-name-directory suffix)))
- (if x (1- (length x)) (length suffix))))))
+ `(boundaries
+ ,(length (file-name-directory string))
+ ,@(let ((x (file-name-directory suffix)))
+ (if x (1- (length x)) (length suffix))))))
(t
(let ((names '())
;; If we have files like "foo.el" and "foo.elc", we could load one of
@@ -810,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\\|\\.\\.\\.\\)/\\)\\'")
@@ -856,9 +867,12 @@ or mount points potentially requiring authentication as a different user.")
;; nil)))
(defun locate-dominating-file (file name)
- "Look up the directory hierarchy from FILE for a file named NAME.
+ "Look up the directory hierarchy from FILE for a directory containing NAME.
Stop at the first parent directory containing a file NAME,
-and return the directory. Return nil if not found."
+and return the directory. Return nil if not found.
+Instead of a string, NAME can also be a predicate taking one argument
+\(a directory) and returning a non-nil value if that directory is the one for
+which we're looking."
;; We used to use the above locate-dominating-files code, but the
;; directory-files call is very costly, so we're much better off doing
;; multiple calls using the code in here.
@@ -885,12 +899,14 @@ and return the directory. Return nil if not found."
;; (setq user (nth 2 (file-attributes file)))
;; (and prev-user (not (equal user prev-user))))
(string-match locate-dominating-stop-dir-regexp file)))
- (setq try (file-exists-p (expand-file-name name file)))
+ (setq try (if (stringp name)
+ (file-exists-p (expand-file-name name file))
+ (funcall name file)))
(cond (try (setq root file))
((equal file (setq file (file-name-directory
(directory-file-name file))))
(setq file nil))))
- root))
+ (if root (file-name-as-directory root))))
(defun executable-find (command)
@@ -957,22 +973,43 @@ Tip: You can use this expansion of remote identifier components
(funcall handler 'file-remote-p file identification connected)
nil)))
+;; Probably this entire variable should be obsolete now, in favor of
+;; something Tramp-related (?). It is not used in many places.
+;; It's not clear what the best file for this to be in is, but given
+;; it uses custom-initialize-delay, it is easier if it is preloaded
+;; rather than autoloaded.
+(defcustom remote-shell-program
+ ;; This used to try various hard-coded places for remsh, rsh, and
+ ;; rcmd, trying to guess based on location whether "rsh" was
+ ;; "restricted shell" or "remote shell", but I don't see the point
+ ;; in this day and age. Almost everyone will use ssh, and have
+ ;; whatever command they want to use in PATH.
+ (purecopy
+ (let ((list '("ssh" "remsh" "rcmd" "rsh")))
+ (while (and list
+ (not (executable-find (car list)))
+ (setq list (cdr list))))
+ (or (car list) "ssh")))
+ "Program to use to execute commands on a remote host (e.g. ssh or rsh)."
+ :version "24.3" ; ssh rather than rsh, etc
+ :initialize 'custom-initialize-delay
+ :group 'environment
+ :type 'file)
+
(defcustom remote-file-name-inhibit-cache 10
"Whether to use the remote file-name cache for read access.
+When `nil', never expire cached values (caution)
+When `t', never use the cache (safe, but may be slow)
+A number means use cached values for that amount of seconds since caching.
-When `nil', always use the cached values.
-When `t', never use them.
-A number means use them for that amount of seconds since they were
-cached.
+The attributes of remote files are cached for better performance.
+If they are changed outside of Emacs's control, the cached values
+become invalid, and must be reread. If you are sure that nothing
+other than Emacs changes the files, you can set this variable to `nil'.
-File attributes of remote files are cached for better performance.
-If they are changed out of Emacs' control, the cached values
-become invalid, and must be invalidated.
-
-In case a remote file is checked regularly, it might be
-reasonable to let-bind this variable to a value less then the
-time period between two checks.
-Example:
+If a remote file is checked regularly, it might be a good idea to
+let-bind this variable to a value less than the interval between
+consecutive checks. For example:
(defun display-time-file-nonempty-p (file)
(let ((remote-file-name-inhibit-cache (- display-time-interval 5)))
@@ -1033,9 +1070,7 @@ containing it, until no links are left at any level.
(delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
(or prev-dirs (setq prev-dirs (list nil)))
- ;; andrewi@harlequin.co.uk - none of the following code (except for
- ;; invoking the file-name handler) currently applies on Windows
- ;; (ie. there are no native symlinks), but there is an issue with
+ ;; andrewi@harlequin.co.uk - on Windows, there is an issue with
;; case differences being ignored by the OS, and short "8.3 DOS"
;; name aliases existing for all files. (The short names are not
;; reported by directory-files, but can be used to refer to files.)
@@ -1045,31 +1080,15 @@ containing it, until no links are left at any level.
;; it is stored on disk (expanding short name aliases with the full
;; name in the process).
(if (eq system-type 'windows-nt)
- (let ((handler (find-file-name-handler filename 'file-truename)))
- ;; For file name that has a special handler, call handler.
- ;; This is so that ange-ftp can save time by doing a no-op.
- (if handler
- (setq filename (funcall handler 'file-truename filename))
- ;; If filename contains a wildcard, newname will be the old name.
- (unless (string-match "[[*?]" filename)
- ;; If filename exists, use the long name. If it doesn't exist,
- ;; drill down until we find a directory that exists, and use
- ;; the long name of that, with the extra non-existent path
- ;; components concatenated.
- (let ((longname (w32-long-file-name filename))
- missing rest)
- (if longname
- (setq filename longname)
- ;; Include the preceding directory separator in the missing
- ;; part so subsequent recursion on the rest works.
- (setq missing (concat "/" (file-name-nondirectory filename)))
- (let ((length (length missing)))
- (setq rest
- (if (> length (length filename))
- ""
- (substring filename 0 (- length)))))
- (setq filename (concat (file-truename rest) missing))))))
- (setq done t)))
+ (unless (string-match "[[*?]" filename)
+ ;; If filename exists, use its long name. If it doesn't
+ ;; exist, the recursion below on the directory of filename
+ ;; will drill down until we find a directory that exists,
+ ;; and use the long name of that, with the extra
+ ;; non-existent path components concatenated.
+ (let ((longname (w32-long-file-name filename)))
+ (if longname
+ (setq filename longname)))))
;; If this file directly leads to a link, process that iteratively
;; so that we don't use lots of stack.
@@ -1089,6 +1108,8 @@ containing it, until no links are left at any level.
(setq dirfile (directory-file-name dir))
;; If these are equal, we have the (or a) root directory.
(or (string= dir dirfile)
+ (and (memq system-type '(windows-nt ms-dos cygwin))
+ (eq (compare-strings dir 0 nil dirfile 0 nil t) t))
;; If this is the same dir we last got the truename for,
;; save time--don't recalculate.
(if (assoc dir (car prev-dirs))
@@ -1419,23 +1440,26 @@ file names with wildcards."
(find-file filename)
(current-buffer)))
-(defun find-file-read-only (filename &optional wildcards)
- "Edit file FILENAME but don't allow changes.
-Like \\[find-file], but marks buffer as read-only.
-Use \\[toggle-read-only] to permit editing."
- (interactive
- (find-file-read-args "Find file read-only: "
- (confirm-nonexistent-file-or-buffer)))
+(defun find-file--read-only (fun filename wildcards)
(unless (or (and wildcards find-file-wildcards
(not (string-match "\\`/:" filename))
(string-match "[[*?]" filename))
(file-exists-p filename))
(error "%s does not exist" filename))
- (let ((value (find-file filename wildcards)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
+ (let ((value (funcall fun filename wildcards)))
+ (mapc (lambda (b) (with-current-buffer b (read-only-mode 1)))
(if (listp value) value (list value)))
value))
+(defun find-file-read-only (filename &optional wildcards)
+ "Edit file FILENAME but don't allow changes.
+Like \\[find-file], but marks buffer as read-only.
+Use \\[toggle-read-only] to permit editing."
+ (interactive
+ (find-file-read-args "Find file read-only: "
+ (confirm-nonexistent-file-or-buffer)))
+ (find-file--read-only #'find-file filename wildcards))
+
(defun find-file-read-only-other-window (filename &optional wildcards)
"Edit file FILENAME in another window but don't allow changes.
Like \\[find-file-other-window], but marks buffer as read-only.
@@ -1443,15 +1467,7 @@ Use \\[toggle-read-only] to permit editing."
(interactive
(find-file-read-args "Find file read-only other window: "
(confirm-nonexistent-file-or-buffer)))
- (unless (or (and wildcards find-file-wildcards
- (not (string-match "\\`/:" filename))
- (string-match "[[*?]" filename))
- (file-exists-p filename))
- (error "%s does not exist" filename))
- (let ((value (find-file-other-window filename wildcards)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
- value))
+ (find-file--read-only #'find-file-other-window filename wildcards))
(defun find-file-read-only-other-frame (filename &optional wildcards)
"Edit file FILENAME in another frame but don't allow changes.
@@ -1460,15 +1476,7 @@ Use \\[toggle-read-only] to permit editing."
(interactive
(find-file-read-args "Find file read-only other frame: "
(confirm-nonexistent-file-or-buffer)))
- (unless (or (and wildcards find-file-wildcards
- (not (string-match "\\`/:" filename))
- (string-match "[[*?]" filename))
- (file-exists-p filename))
- (error "%s does not exist" filename))
- (let ((value (find-file-other-frame filename wildcards)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
- value))
+ (find-file--read-only #'find-file-other-frame filename wildcards))
(defun find-alternate-file-other-window (filename &optional wildcards)
"Find file FILENAME as a replacement for the file in the next window.
@@ -1497,7 +1505,11 @@ expand wildcards (if any) and replace the file with multiple files."
(other-window 1)
(find-alternate-file filename wildcards))))
-(defvar kill-buffer-hook) ; from buffer.c
+;; Defined and used in buffer.c, but not as a DEFVAR_LISP.
+(defvar kill-buffer-hook nil
+ "Hook run when a buffer is killed.
+The buffer being killed is current while the hook is running.
+See `kill-buffer'.")
(defun find-alternate-file (filename &optional wildcards)
"Find file FILENAME, select its buffer, kill previous buffer.
@@ -1525,12 +1537,9 @@ killed."
t)))
(unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
(error "Aborted"))
- (when (and (buffer-modified-p) buffer-file-name)
- (if (yes-or-no-p (format "Buffer %s is modified; save it first? "
- (buffer-name)))
- (save-buffer)
- (unless (yes-or-no-p "Kill and replace the buffer without saving it? ")
- (error "Aborted"))))
+ (and (buffer-modified-p) buffer-file-name
+ (not (yes-or-no-p "Kill and replace the buffer without saving it? "))
+ (error "Aborted"))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
(onum buffer-file-number)
@@ -1600,6 +1609,7 @@ Choose the buffer's name using `generate-new-buffer-name'."
"Regexp to match the automounter prefix in a directory name."
:group 'files
:type 'regexp)
+(make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.3")
(defvar abbreviated-home-dir nil
"The user's homedir abbreviated according to `directory-abbrev-alist'.")
@@ -1725,9 +1735,9 @@ When nil, never request confirmation."
OP-TYPE specifies the file operation being performed (for message to user)."
(when (and large-file-warning-threshold size
(> size large-file-warning-threshold)
- (not (y-or-n-p (format "File %s is large (%dMB), really %s? "
+ (not (y-or-n-p (format "File %s is large (%s), really %s? "
(file-name-nondirectory filename)
- (/ size 1048576) op-type))))
+ (file-size-human-readable size) op-type))))
(error "Aborted")))
(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
@@ -1971,6 +1981,8 @@ Do you want to revisit the file normally now? ")
(after-find-file error (not nowarn)))
(current-buffer))))
+(defvar file-name-buffer-file-type-alist) ;From dos-w32.el.
+
(defun insert-file-contents-literally (filename &optional visit beg end replace)
"Like `insert-file-contents', but only reads in the file literally.
A buffer may be modified in several ways after reading into the buffer,
@@ -1982,21 +1994,14 @@ This function ensures that none of these modifications will take place."
(after-insert-file-functions nil)
(coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion)
- (find-buffer-file-type-function
- (if (fboundp 'find-buffer-file-type)
- (symbol-function 'find-buffer-file-type)
- nil))
+ (file-name-buffer-file-type-alist '(("" . t)))
(inhibit-file-name-handlers
+ ;; FIXME: Yuck!! We should turn insert-file-contents-literally
+ ;; into a file operation instead!
(append '(jka-compr-handler image-file-handler epa-file-handler)
inhibit-file-name-handlers))
(inhibit-file-name-operation 'insert-file-contents))
- (unwind-protect
- (progn
- (fset 'find-buffer-file-type (lambda (_filename) t))
- (insert-file-contents filename visit beg end replace))
- (if find-buffer-file-type-function
- (fset 'find-buffer-file-type find-buffer-file-type-function)
- (fmakunbound 'find-buffer-file-type)))))
+ (insert-file-contents filename visit beg end replace)))
(defun insert-file-1 (filename insert-func)
(if (file-directory-p filename)
@@ -2125,9 +2130,10 @@ unless NOMODES is non-nil."
(/= (char-after (1- (point-max))) ?\n)
(not (and (eq selective-display t)
(= (char-after (1- (point-max))) ?\r)))
+ (not buffer-read-only)
(save-excursion
(goto-char (point-max))
- (insert "\n")))
+ (ignore-errors (insert "\n"))))
(when (and buffer-read-only
view-read-only
(not (eq (get major-mode 'mode-class) 'special)))
@@ -2178,10 +2184,7 @@ in that case, this function acts as if `enable-local-variables' were t."
(boundp 'font-lock-keywords)
(eq (car font-lock-keywords) t))
(setq font-lock-keywords (cadr font-lock-keywords))
- (font-lock-mode 1))
-
- (if (fboundp 'ucs-set-table-for-input) ; don't lose when building
- (ucs-set-table-for-input)))
+ (font-lock-mode 1)))
(defcustom auto-mode-case-fold t
"Non-nil means to try second pass through `auto-mode-alist'.
@@ -2236,9 +2239,11 @@ since only a single case-insensitive search through the alist is made."
("\\.makepp\\'" . makefile-makepp-mode)
,@(if (memq system-type '(berkeley-unix darwin))
'(("\\.mk\\'" . makefile-bsdmake-mode)
+ ("\\.make\\'" . makefile-bsdmake-mode)
("GNUmakefile\\'" . makefile-gmake-mode)
("[Mm]akefile\\'" . makefile-bsdmake-mode))
'(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
+ ("\\.make\\'" . makefile-gmake-mode)
("[Mm]akefile\\'" . makefile-gmake-mode)))
("\\.am\\'" . makefile-automake-mode)
;; Less common extensions come here
@@ -2315,9 +2320,11 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode)
("\\.dbk\\'" . xml-mode)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
- ("\\.js\\'" . js-mode) ; javascript-mode would be better
- ("\\.json\\'" . js-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)
@@ -2405,9 +2412,6 @@ If the element has the form (REGEXP FUNCTION NON-NIL), then after
calling FUNCTION (if it's not nil), we delete the suffix that matched
REGEXP and search the list again for another match.
-If the file name matches `inhibit-first-line-modes-regexps',
-then `auto-mode-alist' is not processed.
-
The extensions whose FUNCTION is `archive-mode' should also
appear in `auto-coding-alist' with `no-conversion' coding system.
@@ -2478,16 +2482,55 @@ of a script, mode MODE is enabled.
See also `auto-mode-alist'.")
-(defvar inhibit-first-line-modes-regexps
- (mapcar 'purecopy '("\\.tar\\'" "\\.tgz\\'" "\\.tiff?\\'"
- "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'"))
- "List of regexps; if one matches a file name, don't look for `-*-'.")
-
-(defvar inhibit-first-line-modes-suffixes nil
- "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
-When checking `inhibit-first-line-modes-regexps', we first discard
+(define-obsolete-variable-alias 'inhibit-first-line-modes-regexps
+ 'inhibit-file-local-variables-regexps "24.1")
+
+;; TODO really this should be a list of modes (eg tar-mode), not regexps,
+;; because we are duplicating info from auto-mode-alist.
+;; TODO many elements of this list are also in auto-coding-alist.
+(defvar inhibit-local-variables-regexps
+ (mapcar 'purecopy '("\\.tar\\'" "\\.t[bg]z\\'"
+ "\\.arc\\'" "\\.zip\\'" "\\.lzh\\'" "\\.lha\\'"
+ "\\.zoo\\'" "\\.[jew]ar\\'" "\\.xpi\\'" "\\.rar\\'"
+ "\\.7z\\'"
+ "\\.sx[dmicw]\\'" "\\.odt\\'"
+ "\\.tiff?\\'" "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'"))
+ "List of regexps matching file names in which to ignore local variables.
+This includes `-*-' lines as well as trailing \"Local Variables\" sections.
+Files matching this list are typically binary file formats.
+They may happen to contain sequences that look like local variable
+specifications, but are not really, or they may be containers for
+member files with their own local variable sections, which are
+not appropriate for the containing file.
+See also `inhibit-local-variables-suffixes'.")
+
+(define-obsolete-variable-alias 'inhibit-first-line-modes-suffixes
+ 'inhibit-local-variables-suffixes "24.1")
+
+(defvar inhibit-local-variables-suffixes nil
+ "List of regexps matching suffixes to remove from file names.
+When checking `inhibit-local-variables-regexps', we first discard
from the end of the file name anything that matches one of these regexps.")
+;; TODO explicitly add case-fold-search t?
+(defun inhibit-local-variables-p ()
+ "Return non-nil if file local variables should be ignored.
+This checks the file (or buffer) name against `inhibit-local-variables-regexps'
+and `inhibit-local-variables-suffixes'."
+ (let ((temp inhibit-local-variables-regexps)
+ (name (if buffer-file-name
+ (file-name-sans-versions buffer-file-name)
+ (buffer-name))))
+ (while (let ((sufs inhibit-local-variables-suffixes))
+ (while (and sufs (not (string-match (car sufs) name)))
+ (setq sufs (cdr sufs)))
+ sufs)
+ (setq name (substring name 0 (match-beginning 0))))
+ (while (and temp
+ (not (string-match (car temp) name)))
+ (setq temp (cdr temp)))
+ temp))
+
(defvar auto-mode-interpreter-regexp
(purecopy "#![ \t]?\\([^ \t\n]*\
/bin/env[ \t]\\)?\\([^ \t\n]+\\)")
@@ -2550,21 +2593,24 @@ Also applies to `magic-fallback-mode-alist'.")
(defun set-auto-mode (&optional keep-mode-if-same)
"Select major mode appropriate for current buffer.
-To find the right major mode, this function checks for a -*- mode tag,
+To find the right major mode, this function checks for a -*- mode tag
checks for a `mode:' entry in the Local Variables section of the file,
checks if it uses an interpreter listed in `interpreter-mode-alist',
matches the buffer beginning against `magic-mode-alist',
compares the filename against the entries in `auto-mode-alist',
then matches the buffer beginning against `magic-fallback-mode-alist'.
-If `enable-local-variables' is nil, this function does not check for
-any mode: tag anywhere in the file.
+If `enable-local-variables' is nil, or if the file name matches
+`inhibit-local-variables-regexps', this function does not check
+for any mode: tag anywhere in the file. If `local-enable-local-variables'
+is nil, then the only mode: tag that can be relevant is a -*- one.
If the optional argument KEEP-MODE-IF-SAME is non-nil, then we
set the major mode only if that would change it. In other words
we don't actually set it to the same mode the buffer already has."
;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
- (let (end done mode modes)
+ (let ((try-locals (not (inhibit-local-variables-p)))
+ end done mode modes)
;; Once we drop the deprecated feature where mode: is also allowed to
;; specify minor-modes (ie, there can be more than one "mode:"), we can
;; remove this section and just let (hack-local-variables t) handle it.
@@ -2572,7 +2618,9 @@ we don't actually set it to the same mode the buffer already has."
(save-excursion
(goto-char (point-min))
(skip-chars-forward " \t\n")
+ ;; Note by design local-enable-local-variables does not matter here.
(and enable-local-variables
+ try-locals
(setq end (set-auto-mode-1))
(if (save-excursion (search-forward ":" end t))
;; Find all specifications for the `mode:' variable
@@ -2603,8 +2651,12 @@ we don't actually set it to the same mode the buffer already has."
(or (set-auto-mode-0 mode keep-mode-if-same)
;; continuing would call minor modes again, toggling them off
(throw 'nop nil))))))
+ ;; hack-local-variables checks local-enable-local-variables etc, but
+ ;; we might as well be explicit here for the sake of clarity.
(and (not done)
enable-local-variables
+ local-enable-local-variables
+ try-locals
(setq mode (hack-local-variables t))
(not (memq mode modes)) ; already tried and failed
(if (not (functionp mode))
@@ -2676,7 +2728,7 @@ we don't actually set it to the same mode the buffer already has."
(cadr mode))
(setq mode (car mode)
name (substring name 0 (match-beginning 0)))
- (setq name))
+ (setq name nil))
(when mode
(set-auto-mode-0 mode keep-mode-if-same)
(setq done t))))))
@@ -2711,43 +2763,34 @@ same, do nothing and return nil."
(funcall mode)
mode)))
+(defvar file-auto-mode-skip "^\\(#!\\|'\\\\\"\\)"
+ "Regexp of lines to skip when looking for file-local settings.
+If the first line matches this regular expression, then the -*-...-*- file-
+local settings will be consulted on the second line instead of the first.")
+
(defun set-auto-mode-1 ()
"Find the -*- spec in the buffer.
Call with point at the place to start searching from.
-If one is found, set point to the beginning
-and return the position of the end.
-Otherwise, return nil; point may be changed."
+If one is found, set point to the beginning and return the position
+of the end. Otherwise, return nil; may change point.
+The variable `inhibit-local-variables-regexps' can cause a -*- spec to
+be ignored; but `enable-local-variables' and `local-enable-local-variables'
+have no effect."
(let (beg end)
(and
;; Don't look for -*- if this file name matches any
- ;; of the regexps in inhibit-first-line-modes-regexps.
- (let ((temp inhibit-first-line-modes-regexps)
- (name (if buffer-file-name
- (file-name-sans-versions buffer-file-name)
- (buffer-name))))
- (while (let ((sufs inhibit-first-line-modes-suffixes))
- (while (and sufs (not (string-match (car sufs) name)))
- (setq sufs (cdr sufs)))
- sufs)
- (setq name (substring name 0 (match-beginning 0))))
- (while (and temp
- (not (string-match (car temp) name)))
- (setq temp (cdr temp)))
- (not temp))
-
+ ;; of the regexps in inhibit-local-variables-regexps.
+ (not (inhibit-local-variables-p))
(search-forward "-*-" (line-end-position
- ;; If the file begins with "#!"
- ;; (exec interpreter magic), look
- ;; for mode frobs in the first two
- ;; lines. You cannot necessarily
- ;; put them in the first line of
- ;; such a file without screwing up
- ;; the interpreter invocation.
- ;; The same holds for
- ;; '\"
- ;; in man pages (preprocessor
+ ;; If the file begins with "#!" (exec
+ ;; interpreter magic), look for mode frobs
+ ;; in the first two lines. You cannot
+ ;; necessarily put them in the first line
+ ;; of such a file without screwing up the
+ ;; interpreter invocation. The same holds
+ ;; for '\" in man pages (preprocessor
;; magic for the `man' program).
- (and (looking-at "^\\(#!\\|'\\\\\"\\)") 2)) t)
+ (and (looking-at file-auto-mode-skip) 2)) t)
(progn
(skip-chars-forward " \t")
(setq beg (point))
@@ -2784,7 +2827,8 @@ symbol and VAL is a value that is considered safe."
;; This should be here at least as long as Emacs supports write-file-hooks.
'((add-hook 'write-file-hooks 'time-stamp)
(add-hook 'write-file-functions 'time-stamp)
- (add-hook 'before-save-hook 'time-stamp))
+ (add-hook 'before-save-hook 'time-stamp nil t)
+ (add-hook 'before-save-hook 'delete-trailing-whitespace nil t))
"Expressions that are considered safe in an `eval:' local variable.
Add expressions to this list if you want Emacs to evaluate them, when
they appear in an `eval' local variable specification, without first
@@ -2897,20 +2941,16 @@ UNSAFE-VARS is the list of those that aren't marked as safe or risky.
RISKY-VARS is the list of those that are marked as risky.
If these settings come from directory-local variables, then
DIR-NAME is the name of the associated directory. Otherwise it is nil."
- (if noninteractive
- nil
- (save-window-excursion
- (let* ((name (or dir-name
- (if buffer-file-name
- (file-name-nondirectory buffer-file-name)
- (concat "buffer " (buffer-name)))))
- (offer-save (and (eq enable-local-variables t)
- unsafe-vars))
- (exit-chars
- (if offer-save '(?! ?y ?n ?\s ?\C-g) '(?y ?n ?\s ?\C-g)))
- (buf (pop-to-buffer "*Local Variables*"))
- prompt char)
- (set (make-local-variable 'cursor-type) nil)
+ (unless noninteractive
+ (let ((name (cond (dir-name)
+ (buffer-file-name
+ (file-name-nondirectory buffer-file-name))
+ ((concat "buffer " (buffer-name)))))
+ (offer-save (and (eq enable-local-variables t)
+ unsafe-vars))
+ (buf (get-buffer-create "*Local Variables*")))
+ ;; Set up the contents of the *Local Variables* buffer.
+ (with-current-buffer buf
(erase-buffer)
(cond
(unsafe-vars
@@ -2945,25 +2985,35 @@ n -- to ignore the local variables list.")
(let ((print-escape-newlines t))
(prin1 (cdr elt) buf))
(insert "\n"))
- (setq prompt
- (format "Please type %s%s: "
- (if offer-save "y, n, or !" "y or n")
- (if (< (line-number-at-pos) (window-body-height))
- ""
- (push ?\C-v exit-chars)
- ", or C-v to scroll")))
- (goto-char (point-min))
- (while (null char)
- (setq char (read-char-choice prompt exit-chars t))
- (when (eq char ?\C-v)
- (condition-case nil
- (scroll-up)
- (error (goto-char (point-min))))
- (setq char nil)))
- (kill-buffer buf)
- (when (and offer-save (= char ?!) unsafe-vars)
- (customize-push-and-save 'safe-local-variable-values unsafe-vars))
- (memq char '(?! ?\s ?y))))))
+ (set (make-local-variable 'cursor-type) nil)
+ (set-buffer-modified-p nil)
+ (goto-char (point-min)))
+
+ ;; Display the buffer and read a choice.
+ (save-window-excursion
+ (pop-to-buffer buf)
+ (let* ((exit-chars '(?y ?n ?\s ?\C-g ?\C-v))
+ (prompt (format "Please type %s%s: "
+ (if offer-save "y, n, or !" "y or n")
+ (if (< (line-number-at-pos (point-max))
+ (window-body-height))
+ ""
+ (push ?\C-v exit-chars)
+ ", or C-v to scroll")))
+ char)
+ (if offer-save (push ?! exit-chars))
+ (while (null char)
+ (setq char (read-char-choice prompt exit-chars t))
+ (when (eq char ?\C-v)
+ (condition-case nil
+ (scroll-up)
+ (error (goto-char (point-min))
+ (recenter 1)))
+ (setq char nil)))
+ (when (and offer-save (= char ?!) unsafe-vars)
+ (customize-push-and-save 'safe-local-variable-values unsafe-vars))
+ (prog1 (memq char '(?! ?\s ?y))
+ (quit-window t)))))))
(defun hack-local-variables-prop-line (&optional mode-only)
"Return local variables specified in the -*- line.
@@ -3049,11 +3099,15 @@ DIR-NAME is the name of the associated directory. Otherwise it is nil."
;; Obey `enable-local-eval'.
((eq var 'eval)
(when enable-local-eval
- (push elt all-vars)
- (or (eq enable-local-eval t)
- (hack-one-local-variable-eval-safep (eval (quote val)))
- (safe-local-variable-p var val)
- (push elt unsafe-vars))))
+ (let ((safe (or (hack-one-local-variable-eval-safep val)
+ ;; In case previously marked safe (bug#5636).
+ (safe-local-variable-p var val))))
+ ;; If not safe and e-l-v = :safe, ignore totally.
+ (when (or safe (not (eq enable-local-variables :safe)))
+ (push elt all-vars)
+ (or (eq enable-local-eval t)
+ safe
+ (push elt unsafe-vars))))))
;; Ignore duplicates (except `mode') in the present list.
((and (assq var all-vars) (not (eq var 'mode))) nil)
;; Accept known-safe variables.
@@ -3090,19 +3144,41 @@ Uses `hack-local-variables-apply' to apply the variables.
If MODE-ONLY is non-nil, all we do is check whether a \"mode:\"
is specified, and return the corresponding mode symbol, or nil.
In this case, we try to ignore minor-modes, and only return a
-major-mode."
+major-mode.
+
+If `enable-local-variables' or `local-enable-local-variables' is nil,
+this function does nothing. If `inhibit-local-variables-regexps'
+applies to the file in question, the file is not scanned for
+local variables, but directory-local variables may still be applied."
+ ;; We don't let inhibit-local-variables-p influence the value of
+ ;; enable-local-variables, because then it would affect dir-local
+ ;; variables. We don't want to search eg tar files for file local
+ ;; variable sections, but there is no reason dir-locals cannot apply
+ ;; to them. The real meaning of inhibit-local-variables-p is "do
+ ;; not scan this file for local variables".
(let ((enable-local-variables
(and local-enable-local-variables enable-local-variables))
result)
(unless mode-only
(setq file-local-variables-alist nil)
(report-errors "Directory-local variables error: %s"
+ ;; Note this is a no-op if enable-local-variables is nil.
(hack-dir-local-variables)))
- (when (or mode-only enable-local-variables)
- ;; If MODE-ONLY is non-nil, and the prop line specifies a mode,
- ;; then we're done, and have no need to scan further.
- (unless (and (setq result (hack-local-variables-prop-line mode-only))
- mode-only)
+ ;; This entire function is basically a no-op if enable-local-variables
+ ;; is nil. All it does is set file-local-variables-alist to nil.
+ (when enable-local-variables
+ ;; This part used to ignore enable-local-variables when mode-only
+ ;; was non-nil. That was inappropriate, eg consider the
+ ;; (artificial) example of:
+ ;; (setq local-enable-local-variables nil)
+ ;; Open a file foo.txt that contains "mode: sh".
+ ;; It correctly opens in text-mode.
+ ;; M-x set-visited-file name foo.c, and it incorrectly stays in text-mode.
+ (unless (or (inhibit-local-variables-p)
+ ;; If MODE-ONLY is non-nil, and the prop line specifies a
+ ;; mode, then we're done, and have no need to scan further.
+ (and (setq result (hack-local-variables-prop-line mode-only))
+ mode-only))
;; Look for "Local variables:" line in last page.
(save-excursion
(goto-char (point-max))
@@ -3192,14 +3268,13 @@ major-mode."
(indirect-variable var))
val) result)
(error nil)))))
- (forward-line 1)))))))))
- ;; Now we've read all the local variables.
- ;; If MODE-ONLY is non-nil, return whether the mode was specified.
- (cond (mode-only result)
- ;; Otherwise, set the variables.
- (enable-local-variables
- (hack-local-variables-filter result nil)
- (hack-local-variables-apply)))))
+ (forward-line 1))))))))
+ ;; Now we've read all the local variables.
+ ;; If MODE-ONLY is non-nil, return whether the mode was specified.
+ (if mode-only result
+ ;; Otherwise, set the variables.
+ (hack-local-variables-filter result nil)
+ (hack-local-variables-apply)))))
(defun hack-local-variables-apply ()
"Apply the elements of `file-local-variables-alist'.
@@ -3294,7 +3369,7 @@ It is dangerous if either of these conditions are met:
(and (symbolp (car exp))
;; Allow (minor)-modes calls with no arguments.
;; This obsoletes the use of "mode:" for such things. (Bug#8613)
- (or (and (member (cdr exp) '(nil (1) (-1)))
+ (or (and (member (cdr exp) '(nil (1) (0) (-1)))
(string-match "-mode\\'" (symbol-name (car exp))))
(let ((prop (get (car exp) 'safe-local-eval-function)))
(cond ((eq prop t)
@@ -3312,30 +3387,39 @@ It is dangerous if either of these conditions are met:
(setq ok t)))
ok))))))))
+(defun hack-one-local-variable--obsolete (var)
+ (let ((o (get var 'byte-obsolete-variable)))
+ (when o
+ (let ((instead (nth 0 o))
+ (since (nth 2 o)))
+ (message "%s is obsolete%s; %s"
+ var (if since (format " (since %s)" since))
+ (if (stringp instead) instead
+ (format "use `%s' instead" instead)))))))
+
(defun hack-one-local-variable (var val)
"Set local variable VAR with value VAL.
If VAR is `mode', call `VAL-mode' as a function unless it's
already the major mode."
- (cond ((eq var 'mode)
- (let ((mode (intern (concat (downcase (symbol-name val))
- "-mode"))))
- (unless (eq (indirect-function mode)
- (indirect-function major-mode))
- (if (memq mode minor-mode-list)
- ;; A minor mode must be passed an argument.
- ;; Otherwise, if the user enables the minor mode in a
- ;; major mode hook, this would toggle it off.
- (funcall mode 1)
- (funcall mode)))))
- ((eq var 'eval)
- (save-excursion (eval val)))
- (t
- ;; Make sure the string has no text properties.
- ;; Some text properties can get evaluated in various ways,
- ;; so it is risky to put them on with a local variable list.
- (if (stringp val)
- (set-text-properties 0 (length val) nil val))
- (set (make-local-variable var) val))))
+ (pcase var
+ (`mode
+ (let ((mode (intern (concat (downcase (symbol-name val))
+ "-mode"))))
+ (unless (eq (indirect-function mode)
+ (indirect-function major-mode))
+ (funcall mode))))
+ (`eval
+ (pcase val
+ (`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook)))
+ (save-excursion (eval val)))
+ (_
+ (hack-one-local-variable--obsolete var)
+ ;; Make sure the string has no text properties.
+ ;; Some text properties can get evaluated in various ways,
+ ;; so it is risky to put them on with a local variable list.
+ (if (stringp val)
+ (set-text-properties 0 (length val) nil val))
+ (set (make-local-variable var) val))))
;;; Handling directory-local variables, aka project settings.
@@ -3349,7 +3433,7 @@ DIR is the name of the directory.
CLASS is the name of a variable class (a symbol).
MTIME is the recorded modification time of the directory-local
variables file associated with this entry. This time is a list
-of two integers (the same format as `file-attributes'), and is
+of integers (the same format as `file-attributes'), and is
used to test whether the cache entry is still valid.
Alternatively, MTIME can be nil, which means the entry is always
considered valid.")
@@ -3447,7 +3531,7 @@ LIST is a list of the form accepted by the function.
When a file is visited, the file's class is found. A directory
may be assigned a class using `dir-locals-set-directory-class'.
Then variables are set in the file's buffer according to the
-class' LIST. The list is processed in order.
+VARIABLES list of the class. The list is processed in order.
* If the element is of the form (MAJOR-MODE . ALIST), and the
buffer's major mode is derived from MAJOR-MODE (as determined
@@ -3494,8 +3578,15 @@ of no valid cache entry."
(locals-file (locate-dominating-file file dir-locals-file-name))
(dir-elt nil))
;; `locate-dominating-file' may have abbreviated the name.
- (if locals-file
- (setq locals-file (expand-file-name dir-locals-file-name locals-file)))
+ (and locals-file
+ (setq locals-file (expand-file-name dir-locals-file-name locals-file)))
+ ;; Let dir-locals-read-from-file inform us via demoted-errors
+ ;; about unreadable files, etc.
+ ;; Maybe we'd want to keep searching though - that is
+ ;; a locate-dominating-file issue.
+;;; (or (not (file-readable-p locals-file))
+;;; (not (file-regular-p locals-file)))
+;;; (setq locals-file nil))
;; Find the best cached value in `dir-locals-directory-cache'.
(dolist (elt dir-locals-directory-cache)
(when (and (eq t (compare-strings file nil (length (car elt))
@@ -3537,24 +3628,39 @@ FILE is the name of the file holding the variables to apply.
The new class name is the same as the directory in which FILE
is found. Returns the new class name."
(with-temp-buffer
- (insert-file-contents file)
- (let* ((dir-name (file-name-directory file))
- (class-name (intern dir-name))
- (variables (let ((read-circle nil))
- (read (current-buffer)))))
- (dir-locals-set-class-variables class-name variables)
- (dir-locals-set-directory-class dir-name class-name
- (nth 5 (file-attributes file)))
- class-name)))
+ ;; This is with-demoted-errors, but we want to mention dir-locals
+ ;; in any error message.
+ (let (err)
+ (condition-case err
+ (progn
+ (insert-file-contents file)
+ (let* ((dir-name (file-name-directory file))
+ (class-name (intern dir-name))
+ (variables (let ((read-circle nil))
+ (read (current-buffer)))))
+ (dir-locals-set-class-variables class-name variables)
+ (dir-locals-set-directory-class dir-name class-name
+ (nth 5 (file-attributes file)))
+ class-name))
+ (error (message "Error reading dir-locals: %S" err) nil)))))
+
+(defcustom enable-remote-dir-locals nil
+ "Non-nil means dir-local variables will be applied to remote files."
+ :version "24.3"
+ :type 'boolean
+ :group 'find-file)
(defun hack-dir-local-variables ()
"Read per-directory local variables for the current buffer.
Store the directory-local variables in `dir-local-variables-alist'
and `file-local-variables-alist', without applying them."
(when (and enable-local-variables
- (not (file-remote-p (or (buffer-file-name) default-directory))))
+ (or enable-remote-dir-locals
+ (not (file-remote-p (or (buffer-file-name)
+ default-directory)))))
;; Find the variables file.
- (let ((variables-file (dir-locals-find-file (or (buffer-file-name) default-directory)))
+ (let ((variables-file (dir-locals-find-file
+ (or (buffer-file-name) default-directory)))
(class nil)
(dir-name nil))
(cond
@@ -3577,6 +3683,10 @@ and `file-local-variables-alist', without applying them."
(hack-local-variables-filter variables dir-name)))))))
(defun hack-dir-local-variables-non-file-buffer ()
+ "Apply directory-local variables to a non-file buffer.
+For non-file buffers, such as Dired buffers, directory-local
+variables are looked for in `default-directory' and its parent
+directories."
(hack-dir-local-variables)
(hack-local-variables-apply))
@@ -3607,7 +3717,7 @@ the old visited file has been renamed to the new name FILENAME."
(interactive "FSet visited file name: ")
(if (buffer-base-buffer)
(error "An indirect buffer cannot visit a file"))
- (let (truename)
+ (let (truename old-try-locals)
(if filename
(setq filename
(if (string-equal filename "")
@@ -3632,7 +3742,8 @@ the old visited file has been renamed to the new name FILENAME."
(progn
(and filename (lock-buffer filename))
(unlock-buffer)))
- (setq buffer-file-name filename)
+ (setq old-try-locals (not (inhibit-local-variables-p))
+ buffer-file-name filename)
(if filename ; make buffer name reflect filename.
(let ((new-name (file-name-nondirectory buffer-file-name)))
(setq default-directory (file-name-directory buffer-file-name))
@@ -3652,59 +3763,63 @@ the old visited file has been renamed to the new name FILENAME."
(setq buffer-file-number
(if filename
(nthcdr 10 (file-attributes buffer-file-name))
- nil)))
- ;; write-file-functions is normally used for things like ftp-find-file
- ;; that visit things that are not local files as if they were files.
- ;; Changing to visit an ordinary local file instead should flush the hook.
- (kill-local-variable 'write-file-functions)
- (kill-local-variable 'local-write-file-hooks)
- (kill-local-variable 'revert-buffer-function)
- (kill-local-variable 'backup-inhibited)
- ;; If buffer was read-only because of version control,
- ;; that reason is gone now, so make it writable.
- (if vc-mode
- (setq buffer-read-only nil))
- (kill-local-variable 'vc-mode)
- ;; Turn off backup files for certain file names.
- ;; Since this is a permanent local, the major mode won't eliminate it.
- (and buffer-file-name
- backup-enable-predicate
- (not (funcall backup-enable-predicate buffer-file-name))
- (progn
- (make-local-variable 'backup-inhibited)
- (setq backup-inhibited t)))
- (let ((oauto buffer-auto-save-file-name))
- ;; If auto-save was not already on, turn it on if appropriate.
- (if (not buffer-auto-save-file-name)
- (and buffer-file-name auto-save-default
- (auto-save-mode t))
- ;; If auto save is on, start using a new name.
- ;; We deliberately don't rename or delete the old auto save
- ;; for the old visited file name. This is because perhaps
- ;; the user wants to save the new state and then compare with the
- ;; previous state from the auto save file.
- (setq buffer-auto-save-file-name
- (make-auto-save-file-name)))
- ;; Rename the old auto save file if any.
- (and oauto buffer-auto-save-file-name
- (file-exists-p oauto)
- (rename-file oauto buffer-auto-save-file-name t)))
- (and buffer-file-name
- (not along-with-file)
- (set-buffer-modified-p t))
- ;; Update the major mode, if the file name determines it.
- (condition-case nil
- ;; Don't change the mode if it is special.
- (or (not change-major-mode-with-file-name)
- (get major-mode 'mode-class)
- ;; Don't change the mode if the local variable list specifies it.
- (hack-local-variables t)
- ;; TODO consider making normal-mode handle this case.
- (let ((old major-mode))
- (set-auto-mode t)
- (or (eq old major-mode)
- (hack-local-variables))))
- (error nil)))
+ nil))
+ ;; write-file-functions is normally used for things like ftp-find-file
+ ;; that visit things that are not local files as if they were files.
+ ;; Changing to visit an ordinary local file instead should flush the hook.
+ (kill-local-variable 'write-file-functions)
+ (kill-local-variable 'local-write-file-hooks)
+ (kill-local-variable 'revert-buffer-function)
+ (kill-local-variable 'backup-inhibited)
+ ;; If buffer was read-only because of version control,
+ ;; that reason is gone now, so make it writable.
+ (if vc-mode
+ (setq buffer-read-only nil))
+ (kill-local-variable 'vc-mode)
+ ;; Turn off backup files for certain file names.
+ ;; Since this is a permanent local, the major mode won't eliminate it.
+ (and buffer-file-name
+ backup-enable-predicate
+ (not (funcall backup-enable-predicate buffer-file-name))
+ (progn
+ (make-local-variable 'backup-inhibited)
+ (setq backup-inhibited t)))
+ (let ((oauto buffer-auto-save-file-name))
+ ;; If auto-save was not already on, turn it on if appropriate.
+ (if (not buffer-auto-save-file-name)
+ (and buffer-file-name auto-save-default
+ (auto-save-mode t))
+ ;; If auto save is on, start using a new name.
+ ;; We deliberately don't rename or delete the old auto save
+ ;; for the old visited file name. This is because perhaps
+ ;; the user wants to save the new state and then compare with the
+ ;; previous state from the auto save file.
+ (setq buffer-auto-save-file-name
+ (make-auto-save-file-name)))
+ ;; Rename the old auto save file if any.
+ (and oauto buffer-auto-save-file-name
+ (file-exists-p oauto)
+ (rename-file oauto buffer-auto-save-file-name t)))
+ (and buffer-file-name
+ (not along-with-file)
+ (set-buffer-modified-p t))
+ ;; Update the major mode, if the file name determines it.
+ (condition-case nil
+ ;; Don't change the mode if it is special.
+ (or (not change-major-mode-with-file-name)
+ (get major-mode 'mode-class)
+ ;; Don't change the mode if the local variable list specifies it.
+ ;; The file name can influence whether the local variables apply.
+ (and old-try-locals
+ ;; h-l-v also checks it, but might as well be explicit.
+ (not (inhibit-local-variables-p))
+ (hack-local-variables t))
+ ;; TODO consider making normal-mode handle this case.
+ (let ((old major-mode))
+ (set-auto-mode t)
+ (or (eq old major-mode)
+ (hack-local-variables))))
+ (error nil))))
(defun write-file (filename &optional confirm)
"Write current buffer into file FILENAME.
@@ -3946,6 +4061,12 @@ the value is \"\"."
(if period
"")))))
+(defun file-name-base (&optional filename)
+ "Return the base name of the FILENAME: no directory, no extension.
+FILENAME defaults to `buffer-file-name'."
+ (file-name-sans-extension
+ (file-name-nondirectory (or filename (buffer-file-name)))))
+
(defcustom make-backup-file-name-function nil
"A function to use instead of the default `make-backup-file-name'.
A value of nil gives the default `make-backup-file-name' behavior.
@@ -4209,7 +4330,9 @@ on a DOS/Windows machine, it returns FILENAME in expanded form."
default-directory))))
(setq filename (expand-file-name filename))
(let ((fremote (file-remote-p filename))
- (dremote (file-remote-p directory)))
+ (dremote (file-remote-p directory))
+ (fold-case (or (memq system-type '(ms-dos cygwin windows-nt))
+ read-file-name-completion-ignore-case)))
(if ;; Conditions for separate trees
(or
;; Test for different filesystems on DOS/Windows
@@ -4218,7 +4341,7 @@ on a DOS/Windows machine, it returns FILENAME in expanded form."
(memq system-type '(ms-dos cygwin windows-nt))
(or
;; Test for different drive letters
- (not (eq t (compare-strings filename 0 2 directory 0 2)))
+ (not (eq t (compare-strings filename 0 2 directory 0 2 fold-case)))
;; Test for UNCs on different servers
(not (eq t (compare-strings
(progn
@@ -4243,16 +4366,16 @@ on a DOS/Windows machine, it returns FILENAME in expanded form."
(while (not
(or
(eq t (compare-strings filename-dir nil (length directory)
- directory nil nil case-fold-search))
+ directory nil nil fold-case))
(eq t (compare-strings filename nil (length directory)
- directory nil nil case-fold-search))))
+ directory nil nil fold-case))))
(setq directory (file-name-directory (substring directory 0 -1))
ancestor (if (equal ancestor ".")
".."
(concat "../" ancestor))))
;; Now ancestor is empty, or .., or ../.., etc.
(if (eq t (compare-strings filename nil (length directory)
- directory nil nil case-fold-search))
+ directory nil nil fold-case))
;; We matched within FILENAME's directory part.
;; Add the rest of FILENAME onto ANCESTOR.
(let ((rest (substring filename (length directory))))
@@ -4375,7 +4498,8 @@ Before and after saving the buffer, this function runs
(or buffer-file-name
(let ((filename
(expand-file-name
- (read-file-name "File to save in: ") nil)))
+ (read-file-name "File to save in: "
+ nil (expand-file-name (buffer-name))))))
(if (file-exists-p filename)
(if (file-directory-p filename)
;; Signal an error if the user specified the name of an
@@ -4398,7 +4522,7 @@ Before and after saving the buffer, this function runs
(format
"%s has changed since visited or saved. Save anyway? "
(file-name-nondirectory buffer-file-name)))
- (error "Save not confirmed"))
+ (user-error "Save not confirmed"))
(save-restriction
(widen)
(save-excursion
@@ -4699,37 +4823,12 @@ prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
"Modification-flag cleared"))
(set-buffer-modified-p arg))
-(defun toggle-read-only (&optional arg)
- "Change whether this buffer is read-only.
-With prefix argument ARG, make the buffer read-only if ARG is
-positive, otherwise make it writable. If buffer is read-only
-and `view-read-only' is non-nil, enter view mode.
-
-This function is usually the wrong thing to use in a Lisp program.
-It can have side-effects beyond changing the read-only status of a buffer
-\(e.g., enabling view mode), and does not affect read-only regions that
-are caused by text properties. To make a buffer read-only in Lisp code,
-set `buffer-read-only'. To ignore read-only status (whether due to text
-properties or buffer state) and make changes, temporarily bind
-`inhibit-read-only'."
- (interactive "P")
- (if (and arg
- (if (> (prefix-numeric-value arg) 0) buffer-read-only
- (not buffer-read-only))) ; If buffer-read-only is set correctly,
- nil ; do nothing.
- ;; Toggle.
- (cond
- ((and buffer-read-only view-mode)
- (View-exit-and-edit)
- (make-local-variable 'view-read-only)
- (setq view-read-only t)) ; Must leave view mode.
- ((and (not buffer-read-only) view-read-only
- ;; If view-mode is already active, `view-mode-enter' is a nop.
- (not view-mode)
- (not (eq (get major-mode 'mode-class) 'special)))
- (view-mode-enter))
- (t (setq buffer-read-only (not buffer-read-only))
- (force-mode-line-update)))))
+(defun toggle-read-only (&optional arg interactive)
+ (declare (obsolete read-only-mode "24.3"))
+ (interactive (list current-prefix-arg t))
+ (if interactive
+ (call-interactively 'read-only-mode)
+ (read-only-mode (or arg 'toggle))))
(defun insert-file (filename)
"Insert contents of file FILENAME into buffer after point.
@@ -4780,7 +4879,13 @@ like `write-region' does."
(defun rename-uniquely ()
"Rename current buffer to a similar name not already taken.
This function is useful for creating multiple shell process buffers
-or multiple mail buffers, etc."
+or multiple mail buffers, etc.
+
+Note that some commands, in particular those based on `compilation-mode'
+\(`compile', `grep', etc.) will reuse the current buffer if it has the
+appropriate mode even if it has been renamed. So as well as renaming
+the buffer, you also need to switch buffers before running another
+instance of such commands."
(interactive)
(save-match-data
(let ((base-name (buffer-name)))
@@ -4898,6 +5003,42 @@ given. With a prefix argument, TRASH is nil."
directory 'full directory-files-no-dot-files-regexp)))
(delete-directory-internal directory)))))
+(defun file-equal-p (file1 file2)
+ "Return non-nil if files FILE1 and FILE2 name the same file.
+If FILE1 or FILE2 does not exist, the return value is unspecified."
+ (let ((handler (or (find-file-name-handler file1 'file-equal-p)
+ (find-file-name-handler file2 'file-equal-p))))
+ (if handler
+ (funcall handler 'file-equal-p file1 file2)
+ (let (f1-attr f2-attr)
+ (and (setq f1-attr (file-attributes (file-truename file1)))
+ (setq f2-attr (file-attributes (file-truename file2)))
+ (equal f1-attr f2-attr))))))
+
+(defun file-in-directory-p (file dir)
+ "Return non-nil if FILE is in DIR or a subdirectory of DIR.
+A directory is considered to be \"in\" itself.
+Return nil if DIR is not an existing directory."
+ (let ((handler (or (find-file-name-handler file 'file-in-directory-p)
+ (find-file-name-handler dir 'file-in-directory-p))))
+ (if handler
+ (funcall handler 'file-in-directory-p file dir)
+ (when (file-directory-p dir) ; DIR must exist.
+ (setq file (file-truename file)
+ dir (file-truename dir))
+ (let ((ls1 (split-string file "/" t))
+ (ls2 (split-string dir "/" t))
+ (root (if (string-match "\\`/" file) "/" ""))
+ (mismatch nil))
+ (while (and ls1 ls2 (not mismatch))
+ (if (string-equal (car ls1) (car ls2))
+ (setq root (concat root (car ls1) "/"))
+ (setq mismatch t))
+ (setq ls1 (cdr ls1)
+ ls2 (cdr ls2)))
+ (unless mismatch
+ (file-equal-p root dir)))))))
+
(defun copy-directory (directory newname &optional keep-time parents copy-contents)
"Copy DIRECTORY to NEWNAME. Both args must be strings.
This function always sets the file modes of the output files to match
@@ -4924,12 +5065,16 @@ directly into NEWNAME instead."
(format "Copy directory %s to: " dir)
default-directory default-directory nil nil)
current-prefix-arg t nil)))
+ (when (file-in-directory-p newname directory)
+ (error "Cannot copy `%s' into its subdirectory `%s'"
+ directory newname))
;; If default-directory is a remote directory, make sure we find its
;; copy-directory handler.
(let ((handler (or (find-file-name-handler directory 'copy-directory)
(find-file-name-handler newname 'copy-directory))))
(if handler
- (funcall handler 'copy-directory directory newname keep-time parents)
+ (funcall handler 'copy-directory directory
+ newname keep-time parents copy-contents)
;; Compute target name.
(setq directory (directory-file-name (expand-file-name directory))
@@ -4957,19 +5102,38 @@ directly into NEWNAME instead."
;; We do not want to copy "." and "..".
(directory-files directory 'full
directory-files-no-dot-files-regexp))
- (if (file-directory-p file)
- (copy-directory file newname keep-time parents)
- (let ((target (expand-file-name (file-name-nondirectory file) newname))
- (attrs (file-attributes file)))
- (if (stringp (car attrs)) ; Symbolic link
- (make-symbolic-link (car attrs) target t)
- (copy-file file target t keep-time)))))
+ (let ((target (expand-file-name (file-name-nondirectory file) newname))
+ (filetype (car (file-attributes file))))
+ (cond
+ ((eq filetype t) ; Directory but not a symlink.
+ (copy-directory file newname keep-time parents))
+ ((stringp filetype) ; Symbolic link
+ (make-symbolic-link filetype target t))
+ ((copy-file file target t keep-time)))))
;; Set directory attributes.
(let ((modes (file-modes directory))
(times (and keep-time (nth 5 (file-attributes directory)))))
(if modes (set-file-modes newname modes))
(if times (set-file-times newname times))))))
+
+
+;; At time of writing, only info uses this.
+(defun prune-directory-list (dirs &optional keep reject)
+ "Return a copy of DIRS with all non-existent directories removed.
+The optional argument KEEP is a list of directories to retain even if
+they don't exist, and REJECT is a list of directories to remove from
+DIRS, even if they exist; REJECT takes precedence over KEEP.
+
+Note that membership in REJECT and KEEP is checked using simple string
+comparison."
+ (apply #'nconc
+ (mapcar (lambda (dir)
+ (and (not (member dir reject))
+ (or (member dir keep) (file-directory-p dir))
+ (list dir)))
+ dirs)))
+
(put 'revert-buffer-function 'permanent-local t)
(defvar revert-buffer-function nil
@@ -5048,6 +5212,8 @@ revert buffers without querying for confirmation.)
Optional third argument PRESERVE-MODES non-nil means don't alter
the files modes. Normally we reinitialize them using `normal-mode'.
+This function binds `revert-buffer-in-progress-p' non-nil while it operates.
+
If the value of `revert-buffer-function' is non-nil, it is called to
do all the work for this command. Otherwise, the hooks
`before-revert-hook' and `after-revert-hook' are run at the beginning
@@ -5125,7 +5291,7 @@ non-nil, it is called instead of rereading visited file contents."
(unlock-buffer)))
(widen)
(let ((coding-system-for-read
- ;; Auto-saved file should be read by Emacs'
+ ;; Auto-saved file should be read by Emacs's
;; internal coding.
(if auto-save-p 'auto-save-coding
(or coding-system-for-read
@@ -5189,23 +5355,26 @@ non-nil, it is called instead of rereading visited file contents."
(not (file-exists-p file-name)))
(error "Auto-save file %s not current"
(abbreviate-file-name file-name)))
- ((save-window-excursion
- (with-output-to-temp-buffer "*Directory*"
- (buffer-disable-undo standard-output)
- (save-excursion
- (let ((switches dired-listing-switches))
- (if (file-symlink-p file)
- (setq switches (concat switches " -L")))
- (set-buffer standard-output)
- ;; Use insert-directory-safely, not insert-directory,
- ;; because these files might not exist. In particular,
- ;; FILE might not exist if the auto-save file was for
- ;; a buffer that didn't visit a file, such as "*mail*".
- ;; The code in v20.x called `ls' directly, so we need
- ;; to emulate what `ls' did in that case.
- (insert-directory-safely file switches)
- (insert-directory-safely file-name switches))))
- (yes-or-no-p (format "Recover auto save file %s? " file-name)))
+ ((with-temp-buffer-window
+ "*Directory*" nil
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (yes-or-no-p (format "Recover auto save file %s? " file-name))
+ (when (window-live-p window)
+ (quit-restore-window window 'kill)))))
+ (with-current-buffer standard-output
+ (let ((switches dired-listing-switches))
+ (if (file-symlink-p file)
+ (setq switches (concat switches " -L")))
+ ;; Use insert-directory-safely, not insert-directory,
+ ;; because these files might not exist. In particular,
+ ;; FILE might not exist if the auto-save file was for
+ ;; a buffer that didn't visit a file, such as "*mail*".
+ ;; The code in v20.x called `ls' directly, so we need
+ ;; to emulate what `ls' did in that case.
+ (insert-directory-safely file switches)
+ (insert-directory-safely file-name switches))))
(switch-to-buffer (find-file-noselect file t))
(let ((inhibit-read-only t)
;; Keep the current buffer-file-coding-system.
@@ -5216,7 +5385,7 @@ non-nil, it is called instead of rereading visited file contents."
(insert-file-contents file-name nil)
(set-buffer-file-coding-system coding-system))
(after-find-file nil nil t))
- (t (error "Recover-file cancelled")))))
+ (t (user-error "Recover-file cancelled")))))
(defun recover-session ()
"Recover auto save files from a previous Emacs session.
@@ -5745,11 +5914,12 @@ returns nil."
(when (and directory-free-space-program
;; Avoid failure if the default directory does
;; not exist (Bug#2631, Bug#3911).
- (let ((default-directory "/"))
- (eq (call-process directory-free-space-program
+ (let ((default-directory
+ (locate-dominating-file dir 'file-directory-p)))
+ (eq (process-file directory-free-space-program
nil t nil
directory-free-space-args
- dir)
+ (file-relative-name dir))
0)))
;; Assume that the "available" column is before the
;; "capacity" column. Find the "%" and scan backward.
@@ -6143,7 +6313,11 @@ be a predicate function such as `yes-or-no-p'."
(defun save-buffers-kill-emacs (&optional arg)
"Offer to save each buffer, then kill this Emacs process.
-With prefix ARG, silently save all file-visiting buffers, then kill."
+With prefix ARG, silently save all file-visiting buffers without asking.
+If there are active processes where `process-query-on-exit-flag'
+returns non-nil, asks whether processes should be killed.
+Runs the members of `kill-emacs-query-functions' in turn and stops
+if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
(interactive "P")
(save-some-buffers arg t)
(and (or (not (memq t (mapcar (function
@@ -6161,8 +6335,15 @@ With prefix ARG, silently save all file-visiting buffers, then kill."
(setq active t))
(setq processes (cdr processes)))
(or (not active)
- (progn (list-processes t)
- (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))))
+ (with-temp-buffer-window
+ (get-buffer-create "*Process List*") nil
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (yes-or-no-p "Active processes exist; kill them and exit anyway? ")
+ (when (window-live-p window)
+ (quit-restore-window window 'kill)))))
+ (list-processes t)))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
(or (null confirm-kill-emacs)
@@ -6251,20 +6432,20 @@ only these files will be asked to be saved."
"/"
(substring (car pair) 2)))))
(setq file-arg-indices (cdr file-arg-indices))))
- (case method
- (identity (car arguments))
- (add (concat "/:" (apply operation arguments)))
- (insert-file-contents
+ (pcase method
+ (`identity (car arguments))
+ (`add (concat "/:" (apply operation arguments)))
+ (`insert-file-contents
(let ((visit (nth 1 arguments)))
(prog1
- (apply operation arguments)
+ (apply operation arguments)
(when (and visit buffer-file-name)
(setq buffer-file-name (concat "/:" buffer-file-name))))))
- (unquote-then-quote
+ (`unquote-then-quote
(let ((buffer-file-name (substring buffer-file-name 2)))
(apply operation arguments)))
- (t
- (apply operation arguments)))))
+ (_
+ (apply operation arguments)))))
;; Symbolic modes and read-file-modes.
@@ -6416,7 +6597,7 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
(new-fn (expand-file-name (file-name-nondirectory fn)
trash-dir)))
;; We can't trash a parent directory of trash-directory.
- (if (string-match fn trash-dir)
+ (if (string-prefix-p fn trash-dir)
(error "Trash directory `%s' is a subdirectory of `%s'"
trash-dir filename))
(unless (file-directory-p trash-dir)
@@ -6448,21 +6629,23 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
(file-name-directory fn)))
(error "Cannot move %s to trash: Permission denied" filename))
;; The trashed file cannot be the trash dir or its parent.
- (if (string-match fn trash-files-dir)
+ (if (string-prefix-p fn trash-files-dir)
(error "The trash directory %s is a subdirectory of %s"
trash-files-dir filename))
- (if (string-match fn trash-info-dir)
+ (if (string-prefix-p fn trash-info-dir)
(error "The trash directory %s is a subdirectory of %s"
trash-info-dir filename))
;; Ensure that the trash directory exists; otherwise, create it.
(let ((saved-default-file-modes (default-file-modes)))
- (set-default-file-modes ?\700)
- (unless (file-exists-p trash-files-dir)
- (make-directory trash-files-dir t))
- (unless (file-exists-p trash-info-dir)
- (make-directory trash-info-dir t))
- (set-default-file-modes saved-default-file-modes))
+ (unwind-protect
+ (progn
+ (set-default-file-modes #o700)
+ (unless (file-exists-p trash-files-dir)
+ (make-directory trash-files-dir t))
+ (unless (file-exists-p trash-info-dir)
+ (make-directory trash-info-dir t)))
+ (set-default-file-modes saved-default-file-modes)))
;; Try to move to trash with .trashinfo undo information
(save-excursion
@@ -6539,7 +6722,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/filesets.el b/lisp/filesets.el
index 0f6c6e8dd78..7f695cf33dd 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -1,6 +1,6 @@
;;; filesets.el --- handle group of files
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Thomas Link <sanobast-emacs@yahoo.de>
;; Maintainer: FSF
@@ -35,7 +35,7 @@
;; inclusion group (i.e. a base file including other files).
;; Usage:
-;; 1. Put (require 'filesets) and (filesets-init) in your .emacs file.
+;; 1. Put (require 'filesets) and (filesets-init) in your init file.
;; 2. Type ;; M-x filesets-edit or choose "Edit Filesets" from the menu.
;; 3. Save your customizations.
@@ -88,9 +88,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
-
+(eval-when-compile (require 'cl-lib))
;;; Some variables
@@ -405,8 +403,10 @@ Don't forget to check out `filesets-menu-ensure-use-cached'."
(sexp :tag "Other" :value nil)))
:group 'filesets)
-(defcustom filesets-cache-fill-content-hooks nil
- "Hooks to run when writing the contents of filesets' cache file.
+(define-obsolete-variable-alias 'filesets-cache-fill-content-hooks
+ 'filesets-cache-fill-content-hook "24.3")
+(defcustom filesets-cache-fill-content-hook nil
+ "Hook run when writing the contents of filesets' cache file.
The hook is called with the cache file as current buffer and the cursor
at the last position. I.e. each hook has to make sure that the cursor is
@@ -518,7 +518,7 @@ Caveat: Changes will take effect after rebuilding the menu."
This is for calls via `filesets-find-or-display-file'
or `filesets-find-file'.
-Set this to 0, if you don't use XEmacs' buffer tabs."
+Set this to 0, if you don't use XEmacs's buffer tabs."
:set (function filesets-set-default)
:type 'number
:group 'filesets)
@@ -1286,11 +1286,11 @@ on-close-all ... Not used"
(or entry
(filesets-get-external-viewer filename)))))
(filesets-alist-get def
- (case event
- ((on-open-all) ':ignore-on-open-all)
- ((on-grep) ':ignore-on-read-text)
- ((on-cmd) nil)
- ((on-close-all) nil))
+ (pcase event
+ (`on-open-all ':ignore-on-open-all)
+ (`on-grep ':ignore-on-read-text)
+ (`on-cmd nil)
+ (`on-close-all nil))
nil t)))
(defun filesets-filetype-get-prop (property filename &optional entry)
@@ -1559,11 +1559,9 @@ SAVE-FUNCTION takes no argument, but works on the current buffer."
(defun filesets-get-fileset-from-name (name &optional mode)
"Get fileset definition for NAME."
- (case mode
- ((:ingroup :tree)
- name)
- (t
- (assoc name filesets-data))))
+ (pcase mode
+ ((or `:ingroup `:tree) name)
+ (_ (assoc name filesets-data))))
;;; commands
@@ -1720,22 +1718,22 @@ Replace <file-name> or <<file-name>> with filename."
Assume MODE (see `filesets-entry-mode'), if provided."
(let* ((mode (or mode
(filesets-entry-mode entry)))
- (fl (case mode
- ((:files)
+ (fl (pcase mode
+ (:files
(filesets-entry-get-files entry))
- ((:file)
+ (:file
(list (filesets-entry-get-file entry)))
- ((:ingroup)
+ (:ingroup
(let ((entry (expand-file-name
(if (stringp entry)
entry
(filesets-entry-get-master entry)))))
(cons entry (filesets-ingroup-cache-get entry))))
- ((:tree)
+ (:tree
(let ((dir (nth 0 entry))
(patt (nth 1 entry)))
(filesets-directory-files dir patt ':files t)))
- ((:pattern)
+ (:pattern
(let ((dirpatt (filesets-entry-get-pattern entry)))
(if dirpatt
(let ((dir (filesets-entry-get-pattern--dir dirpatt))
@@ -1904,12 +1902,12 @@ User will be queried, if no fileset name is provided."
(let* ((result nil)
(factor (ceiling (/ (float bl)
filesets-max-submenu-length))))
- (do ((data submenu-body (cdr data))
- (n 1 (+ n 1))
- (count 0 (+ count factor)))
+ (cl-do ((data submenu-body (cdr data))
+ (n 1 (+ n 1))
+ (count 0 (+ count factor)))
((or (> count bl)
(null data)))
-; (let ((sl (subseq submenu-body count
+ ;; (let ((sl (subseq submenu-body count
(let ((sl (filesets-sublist submenu-body count
(let ((x (+ count factor)))
(if (>= bl x)
@@ -1926,7 +1924,7 @@ User will be queried, if no fileset name is provided."
`((,(concat
(filesets-get-shortcut n)
(let ((rv ""))
- (do ((x sl (cdr x)))
+ (cl-do ((x sl (cdr x)))
((null x))
(let ((y (concat (elt (car x) 0)
(if (null (cdr x))
@@ -1952,8 +1950,8 @@ User will be queried, if no fileset name is provided."
"Get submenu epilog for SOMETHING (usually a fileset).
If mode is :tree or :ingroup, SOMETHING is some weird construct and
LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
- (case mode
- ((:tree)
+ (pcase mode
+ (:tree
`("---"
["Close all files" (filesets-close ',mode ',something ',lookup-name)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
@@ -1962,14 +1960,14 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- ((:ingroup)
+ (:ingroup
`("---"
["Close all files" (filesets-close ',mode ',something ',lookup-name)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- ((:pattern)
+ (:pattern
`("---"
["Close all files" (filesets-close ',mode ',something)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
@@ -1986,7 +1984,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- ((:files)
+ (:files
`("---"
[,(concat "Close all files") (filesets-close ',mode ',something)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
@@ -1997,7 +1995,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- (t
+ (_
(filesets-error 'error "Filesets: malformed definition of " something))))
(defun filesets-ingroup-get-data (master pos &optional fun)
@@ -2249,15 +2247,15 @@ Construct a shortcut from COUNT."
(filesets-verbosity (filesets-entry-get-verbosity entry))
(this-lookup-name (concat (filesets-get-shortcut count)
lookup-name)))
- (case mode
- ((:file)
+ (pcase mode
+ (:file
(let* ((file (filesets-entry-get-file entry)))
`[,this-lookup-name
(filesets-file-open nil ',file ',lookup-name)]))
- (t
+ (_
`(,this-lookup-name
- ,@(case mode
- ((:pattern)
+ ,@(pcase mode
+ (:pattern
(let* ((files (filesets-get-filelist entry mode 'on-ls))
(dirpatt (filesets-entry-get-pattern entry))
(pattname (apply 'concat (cons "Pattern: " dirpatt)))
@@ -2276,7 +2274,7 @@ Construct a shortcut from COUNT."
files))
,@(filesets-get-menu-epilog lookup-name mode
lookup-name t))))
- ((:ingroup)
+ (:ingroup
(let* ((master (filesets-entry-get-master entry)))
;;(filesets-message 3 "Filesets: parsing %S" master)
`([,(concat "Inclusion Group: "
@@ -2288,12 +2286,12 @@ Construct a shortcut from COUNT."
,@(filesets-wrap-submenu
(filesets-build-ingroup-submenu lookup-name master))
,@(filesets-get-menu-epilog master mode lookup-name t))))
- ((:tree)
+ (:tree
(let* ((dirpatt (filesets-entry-get-tree entry))
(dir (car dirpatt))
(patt (cadr dirpatt)))
(filesets-build-dir-submenu entry lookup-name dir patt)))
- ((:files)
+ (:files
(let ((files (filesets-get-filelist entry mode 'on-open-all))
(count 0))
`([,(concat "Files: " lookup-name)
@@ -2331,9 +2329,9 @@ bottom up, set `filesets-submenus' to nil, first.)"
(setq filesets-has-changed-flag nil)
(setq filesets-updated-buffers nil)
(setq filesets-update-cache-file-flag t)
- (do ((data (filesets-conditional-sort filesets-data (function car))
- (cdr data))
- (count 1 (+ count 1)))
+ (cl-do ((data (filesets-conditional-sort filesets-data (function car))
+ (cdr data))
+ (count 1 (+ count 1)))
((null data))
(let* ((this (car data))
(name (filesets-data-get-name this))
@@ -2418,7 +2416,7 @@ fileset thinks this is necessary or not."
(when filesets-cache-hostname-flag
(insert (format "(setq filesets-cache-hostname %S)" (system-name)))
(newline 2))
- (run-hooks 'filesets-cache-fill-content-hooks)
+ (run-hooks 'filesets-cache-fill-content-hook)
(write-file filesets-menu-cache-file))
(setq filesets-has-changed-flag nil)
(setq filesets-update-cache-file-flag nil)))
diff --git a/lisp/find-cmd.el b/lisp/find-cmd.el
index 8b0c1eb522a..4cf5b85c81a 100644
--- a/lisp/find-cmd.el
+++ b/lisp/find-cmd.el
@@ -1,6 +1,6 @@
;;; find-cmd.el --- Build a valid find(1) command with sexps
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Philip Jackson <phil@shellarchive.co.uk>
;; Version: 0.6
@@ -63,6 +63,7 @@
(cnewer . (1))
(ctime . (1))
(empty . (0))
+ (executable . (0))
(false . (0))
(fstype . (1))
(gid . (1))
@@ -70,37 +71,43 @@
(ilname . (1))
(iname . (1))
(inum . (1))
- (iwholename . (1))
+ (ipath . (1))
(iregex . (1))
+ (iwholename . (1))
(links . (1))
(lname . (1))
(mmin . (1))
(mtime . (1))
(name . (1))
(newer . (1))
- (nouser . (0))
(nogroup . (0))
+ (nouser . (0))
(path . (1))
(perm . (0))
+ (readable . (0))
(regex . (1))
- (wholename . (1))
+ (samefile . (1))
(size . (1))
(true . (0))
(type . (1))
(uid . (1))
(used . (1))
(user . (1))
+ (wholename . (1))
+ (writable . (0))
(xtype . (nil))
;; normal options (always true)
+ (daystart . (0))
(depth . (0))
(maxdepth . (1))
(mindepth . (1))
(mount . (0))
(noleaf . (0))
- (xdev . (0))
(ignore_readdir_race . (0))
(noignore_readdir_race . (0))
+ (regextype . (1))
+ (xdev . (0))
;; actions
(delete . (0))
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index 491110bc898..9c1c8eedffd 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -1,6 +1,6 @@
;;; find-dired.el --- run a `find' command and dired the output
-;; Copyright (C) 1992, 1994-1995, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994-1995, 2000-2012 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>,
;; Sebastian Kremer <sk@thp.uni-koeln.de>
@@ -63,10 +63,20 @@ than the latter."
(cons
(format "-exec ls -ld {} %s" find-exec-terminator)
"-ld"))
- "Description of the option to `find' to produce an `ls -l'-type listing.
-This is a cons of two strings (FIND-OPTION . LS-SWITCHES). FIND-OPTION
-gives the option (or options) to `find' that produce the desired output.
-LS-SWITCHES is a list of `ls' switches to tell dired how to parse the output."
+ "A pair of options to produce and parse an `ls -l'-type list from `find'.
+This is a cons of two strings (FIND-OPTION . LS-SWITCHES).
+FIND-OPTION is the option (or options) passed to `find' to produce
+a file listing in the desired format. LS-SWITCHES is a set of
+`ls' switches that tell dired how to parse the output of `find'.
+
+The two options must be set to compatible values.
+For example, to use human-readable file sizes with GNU ls:
+ \(\"-exec ls -ldh {} +\" . \"-ldh\")
+
+To use GNU find's inbuilt \"-ls\" option to list files:
+ \(\"-ls\" . \"-dilsb\")
+since GNU find's output has the same format as using GNU ls with
+the options \"-dilsb\"."
:version "24.1" ; add tests for -ls and -exec + support
:type '(cons (string :tag "Find Option")
(string :tag "Ls Switches"))
diff --git a/lisp/find-file.el b/lisp/find-file.el
index e4285523184..1deafc9734c 100644
--- a/lisp/find-file.el
+++ b/lisp/find-file.el
@@ -4,7 +4,7 @@
;; Maintainer: FSF
;; Keywords: c, matching, tools
-;; Copyright (C) 1994-1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -181,21 +181,21 @@ To override this, give an argument to `ff-find-other-file'."
:group 'ff)
;;;###autoload
-(defvar ff-special-constructs
- `(
- ;; C/C++ include, for NeXTstep too
- (,(purecopy "^\#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") .
+(defcustom ff-special-constructs
+ ;; C/C++ include, for NeXTstep too
+ `((,(purecopy "^\#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") .
(lambda ()
- (buffer-substring (match-beginning 2) (match-end 2))))
- )
+ (buffer-substring (match-beginning 2) (match-end 2)))))
;; We include `ff-treat-as-special' documentation here so that autoload
;; can make it available to be read prior to loading this file.
- "*List of special constructs for `ff-treat-as-special' to recognize.
+ "List of special constructs recognized by `ff-treat-as-special'.
Each element, tried in order, has the form (REGEXP . EXTRACT).
If REGEXP matches the current line (from the beginning of the line),
`ff-treat-as-special' calls function EXTRACT with no args.
If EXTRACT returns nil, keep trying. Otherwise, return the
-filename that EXTRACT returned.")
+filename that EXTRACT returned."
+ :type '(repeat (cons regexp function))
+ :group 'ff)
(defvaralias 'ff-related-file-alist 'ff-other-file-alist)
(defcustom ff-other-file-alist 'cc-other-file-alist
diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el
index b89762dc1a8..bfe35c0109c 100644
--- a/lisp/find-lisp.el
+++ b/lisp/find-lisp.el
@@ -4,7 +4,7 @@
;; Created: Fri Mar 26 1999
;; Keywords: unix
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/lisp/finder.el b/lisp/finder.el
index ae2afba5bbb..6ccb4bf9ecd 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -1,6 +1,6 @@
;;; finder.el --- topic & keyword-based code finder
-;; Copyright (C) 1992, 1997-1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1997-1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Created: 16 Jun 1992
diff --git a/lisp/flow-ctrl.el b/lisp/flow-ctrl.el
index a025f0a184c..b301886de5b 100644
--- a/lisp/flow-ctrl.el
+++ b/lisp/flow-ctrl.el
@@ -1,6 +1,6 @@
;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control
-;; Copyright (C) 1990-1991, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1991, 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Kevin Gallagher
;; Maintainer: FSF
@@ -31,7 +31,7 @@
;;
;; To invoke these adjustments, a user need only invoke the function
;; enable-flow-control-on with a list of terminal types in his/her own
-;; .emacs file. As arguments, give it the names of one or more terminal
+;; init file. As arguments, give it the names of one or more terminal
;; types in use by that user which require flow control adjustments.
;; Here's an example:
;;
diff --git a/lisp/foldout.el b/lisp/foldout.el
index 4f93b4205b2..8d15416d557 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -1,6 +1,6 @@
;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode
-;; Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Kevin Broadey <KevinB@bartley.demon.co.uk>
;; Maintainer: FSF
@@ -39,7 +39,7 @@
;; look under one of the level-2 headings, position the cursor on it and do C-c
;; C-z again. This exposes the level-2 body and its level-3 child subheadings
;; and narrows the buffer again. You can keep on zooming in on successive
-;; subheadings as much as you like. A string in the modeline tells you how
+;; subheadings as much as you like. A string in the mode line tells you how
;; deep you've gone.
;;
;; When zooming in on a heading you might only want to see the child
@@ -194,7 +194,7 @@
;; shows only the subheadings.
;; 1.2 28-Jan-94
-;; Fixed a dumb bug - didn't make `foldout-modeline-string' buffer-local :-(
+;; Fixed a dumb bug - didn't make `foldout-mode-line-string' buffer-local :-(
;;
;; Changed `foldout-exit-fold' to use prefix arg to say how many folds to exit.
;; Negative arg means exit but don't hide text. Zero arg means exit all folds.
@@ -218,15 +218,15 @@
An end marker of nil means the fold ends after (point-max).")
(make-variable-buffer-local 'foldout-fold-list)
-(defvar foldout-modeline-string nil
- "Modeline string announcing that we are in an outline fold.")
-(make-variable-buffer-local 'foldout-modeline-string)
+(defvar foldout-mode-line-string nil
+ "Mode line string announcing that we are in an outline fold.")
+(make-variable-buffer-local 'foldout-mode-line-string)
;; put our minor mode string immediately following outline-minor-mode's
-(or (assq 'foldout-modeline-string minor-mode-alist)
+(or (assq 'foldout-mode-line-string minor-mode-alist)
(let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist)
minor-mode-alist))
- (foldout-entry '((foldout-modeline-string foldout-modeline-string))))
+ (foldout-entry '((foldout-mode-line-string foldout-mode-line-string))))
;; something's wrong with outline if we can't find it
(if (null outl-entry)
@@ -296,8 +296,8 @@ optional arg EXPOSURE \(interactively with prefix arg\) changes this:-
(setq foldout-fold-list (cons (cons start-marker end-marker)
foldout-fold-list))
- ;; update the modeline
- (foldout-update-modeline)
+ ;; update the mode line
+ (foldout-update-mode-line)
)))
@@ -375,8 +375,7 @@ exited and text is left visible."
;; zap the markers so they don't slow down editing
(set-marker start-marker nil)
- (if end-marker (set-marker end-marker nil))
- )
+ (if end-marker (set-marker end-marker nil)))
;; narrow to the enclosing fold if there is one
(if foldout-fold-list
@@ -386,32 +385,29 @@ exited and text is left visible."
(narrow-to-region start-marker
(if end-marker
(1- (marker-position end-marker))
- (point-max)))
- ))
+ (point-max)))))
(recenter)
- ;; update the modeline
- (foldout-update-modeline)
- ))
+ ;; update the mode line
+ (foldout-update-mode-line)))
-(defun foldout-update-modeline ()
- "Set the modeline string to indicate our fold depth."
+(defun foldout-update-mode-line ()
+ "Set the mode line to indicate our fold depth."
(let ((depth (length foldout-fold-list)))
- (setq foldout-modeline-string
+ (setq foldout-mode-line-string
(cond
;; if we're not in a fold, keep quiet
((zerop depth)
nil)
- ;; in outline-minor-mode we're after "Outl:xx" in the modeline
+ ;; in outline-minor-mode we're after "Outl:xx" in the mode line
(outline-minor-mode
(format ":%d" depth))
;; otherwise just announce the depth (I guess we're in outline-mode)
((= depth 1)
" Inside 1 fold")
(t
- (format " Inside %d folds" depth))
- ))))
+ (format " Inside %d folds" depth))))))
(defun foldout-mouse-zoom (event)
diff --git a/lisp/follow.el b/lisp/follow.el
index ee8be14c6dc..a74862cb5d0 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -1,6 +1,5 @@
;;; follow.el --- synchronize windows showing the same buffer
-
-;; Copyright (C) 1995-1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Anders Lindgren <andersl@andersl.com>
;; Maintainer: FSF (Anders' email bounces, Sep 2005)
@@ -24,8 +23,6 @@
;;; Commentary:
-;;{{{ Documentation
-
;; `Follow mode' is a minor mode for Emacs and XEmacs that
;; combines windows into one tall virtual window.
;;
@@ -109,24 +106,11 @@
;; (setq truncate-partial-width-windows nil)
-;; Since the display of XEmacs is pixel-oriented, a line could be
-;; clipped in half at the bottom of the window.
-;;
-;; To make XEmacs avoid clipping (normal) lines, please place the
-;; following line in your init-file:
-;;
-;; (setq pixel-vertical-clip-threshold 30)
-
-
;; The correct way to configure Follow mode, or any other mode for
;; that matter, is to create one or more functions that do
;; whatever you would like to do. These functions are then added to
;; a hook.
;;
-;; When `Follow' mode is activated, functions stored in the hook
-;; `follow-mode-hook' are called. When it is deactivated
-;; `follow-mode-off-hook' is run.
-;;
;; The keymap `follow-key-map' contains key bindings activated by
;; `follow-mode'.
;;
@@ -198,80 +182,29 @@
;; Example from my ~/.emacs:
;; (global-set-key [f8] 'follow-mode)
-
;; Implementation:
;;
-;; In an ideal world, follow mode would have been implemented in the
-;; kernel of the display routines, making sure that the windows (using
-;; follow mode) ALWAYS are aligned. On planet Earth, however, we must
-;; accept a solution where we ALMOST ALWAYS can make sure that the
-;; windows are aligned.
-;;
-;; Follow mode does this in three places:
-;; 1) After each user command.
-;; 2) After a process output has been performed.
-;; 3) When a scrollbar has been moved.
+;; The main method by which Follow mode aligns windows is via the
+;; function `follow-post-command-hook', which is run after each
+;; command. This "fixes up" the alignment of other windows which are
+;; showing the same Follow mode buffer, on the same frame as the
+;; selected window. It does not try to deal with buffers other than
+;; the buffer of the selected frame, or windows on other frames.
;;
-;; This will cover most situations. (Let me know if there are other
-;; situations that should be covered.)
-;;
-;; Note that only the selected window is checked, for the reason of
-;; efficiency and code complexity. (I.e. it is possible to make a
-;; non-selected window unaligned. It will, however, pop right back
-;; when it is selected.)
-
-;;}}}
+;; Comint mode specially calls `follow-comint-scroll-to-bottom' on
+;; Follow mode buffers. This function scrolls the bottom-most window
+;; in a window chain and aligns the other windows accordingly. Follow
+;; mode adds a function to `compilation-filter-hook' to align
+;; compilation buffers.
;;; Code:
-;;{{{ Preliminaries
-
-;; Make the compiler shut up!
-;; There are two strategies:
-;; 1) Shut warnings off completely.
-;; 2) Handle each warning separately.
-;;
-;; Since I would like to see real errors, I've selected the latter
-;; method.
-;;
-;; The problem with undefined variables and functions has been solved
-;; by using `set', `symbol-value' and `symbol-function' rather than
-;; `setq' and direct references to variables and functions.
-;;
-;; For example:
-;; (if (boundp 'foo) ... (symbol-value 'foo) )
-;; (set 'foo ...) <-- XEmacs doesn't fall for this one.
-;; (funcall (symbol-function 'set) 'bar ...)
-;;
-;; Note: When this file is interpreted, `eval-when-compile' is
-;; evaluated. Since it doesn't hurt to evaluate it, but it is a bit
-;; annoying, we test if the byte-compiler has been loaded. This can,
-;; of course, lead to some occasional unintended evaluation...
-;;
-;; Should someone come up with a better solution, please let me
-;; know.
-
(require 'easymenu)
-(eval-when-compile
- (if (or (featurep 'bytecomp)
- (featurep 'byte-compile))
- (cond ((featurep 'xemacs)
- ;; Make XEmacs shut up! I'm using standard Emacs
- ;; functions, they are NOT obsolete!
- (if (eq (get 'force-mode-line-update 'byte-compile)
- 'byte-compile-obsolete)
- (put 'force-mode-line-update 'byte-compile 'nil))
- (if (eq (get 'frame-first-window 'byte-compile)
- 'byte-compile-obsolete)
- (put 'frame-first-window 'byte-compile 'nil))))))
-
-;;}}}
-;;{{{ Variables
+;;; Variables
(defgroup follow nil
"Synchronize windows showing the same buffer."
- :prefix "follow-"
:group 'windows
:group 'convenience)
@@ -280,28 +213,15 @@
:type 'hook
:group 'follow)
-(defcustom follow-mode-off-hook nil
- "Hooks to run when Follow mode is turned off."
- :type 'hook
- :group 'follow)
-(make-obsolete-variable 'follow-mode-off-hook 'follow-mode-hook "22.2")
-
-;;{{{ Keymap/Menu
+;;; Keymap/Menu
;; Define keys for the follow-mode minor mode map and replace some
-;; functions in the global map. All `follow' mode special functions
-;; can be found on (the somewhat cumbersome) "C-c . <key>"
-;; (Control-C dot <key>). (As of Emacs 19.29 the keys
-;; C-c <punctuation character> are reserved for minor modes.)
+;; functions in the global map. All Follow mode special functions can
+;; be found on the `C-c .' prefix key.
;;
-;; To change the prefix, redefine `follow-mode-prefix' before
-;; `follow' is loaded, or see the section on `follow-mode-hook'
-;; above for an example of how to bind the keys the way you like.
-;;
-;; Please note that the keymap is defined the first time this file is
-;; loaded. Also note that the only valid way to manipulate the
-;; keymap is to use `define-key'. Don't change it using `setq' or
-;; similar!
+;; To change the prefix, redefine `follow-mode-prefix' before `follow'
+;; is loaded, or see the section on `follow-mode-hook' above for an
+;; example of how to bind the keys the way you like.
(defcustom follow-mode-prefix "\C-c."
"Prefix key to use for follow commands in Follow mode.
@@ -334,6 +254,12 @@ After that, changing the prefix key requires manipulating keymaps."
;; the look and feel of Follow mode.)
(define-key mainmap [remap end-of-buffer] 'follow-end-of-buffer)
+ (define-key mainmap [remap scroll-bar-toolkit-scroll] 'follow-scroll-bar-toolkit-scroll)
+ (define-key mainmap [remap scroll-bar-drag] 'follow-scroll-bar-drag)
+ (define-key mainmap [remap scroll-bar-scroll-up] 'follow-scroll-bar-scroll-up)
+ (define-key mainmap [remap scroll-bar-scroll-down] 'follow-scroll-bar-scroll-down)
+ (define-key mainmap [remap mwheel-scroll] 'follow-mwheel-scroll)
+
mainmap)
"Minor mode keymap for Follow mode.")
@@ -345,16 +271,8 @@ After that, changing the prefix key requires manipulating keymaps."
'(["Follow mode" follow-mode
:style toggle :selected follow-mode])))
-;; If there is a `tools' menu, we use it. However, we can't add a
-;; minor-mode specific item to it (it's broken), so we make the
-;; contents ghosted when not in use, and add ourselves to the
-;; global map.
(easy-menu-add-item nil '("Tools")
'("Follow"
- ;; The Emacs code used to just gray out operations when follow-mode was
- ;; not enabled, whereas the XEmacs code used to remove it altogether.
- ;; Not sure which is preferable, but clearly the preference should not
- ;; depend on the flavor.
:filter follow-menu-filter
["Scroll Up" follow-scroll-up follow-mode]
["Scroll Down" follow-scroll-down follow-mode]
@@ -373,8 +291,6 @@ After that, changing the prefix key requires manipulating keymaps."
"--"
["Follow mode" follow-mode :style toggle :selected follow-mode]))
-;;}}}
-
(defcustom follow-mode-line-text " Follow"
"Text shown in the mode line when Follow mode is active.
Defaults to \" Follow\". Examples of other values
@@ -385,30 +301,12 @@ are \" Fw\", or simply \"\"."
(defcustom follow-auto nil
"Non-nil activates Follow mode whenever a file is loaded."
:type 'boolean
- :group 'follow)
-
-(defcustom follow-intercept-processes (fboundp 'start-process)
- "When non-nil, Follow mode will monitor process output."
- :type 'boolean
- :group 'follow)
-
-(defvar follow-avoid-tail-recenter-p (not (featurep 'xemacs))
- "*When non-nil, patch Emacs so that tail windows won't be recentered.
-
-A \"tail window\" is a window that displays only the end of
-the buffer. Normally it is practical for the user that empty
-windows are recentered automatically. However, when using
-Follow mode it breaks the display when the end is displayed
-in a window \"above\" the last window. This is for
-example the case when displaying a short page in info.
-
-Must be set before Follow mode is loaded.
-
-Please note that it is not possible to fully prevent Emacs from
-recentering empty windows. Please report if you find a repeatable
-situation in which Emacs recenters empty windows.
-
-XEmacs, as of 19.12, does not recenter windows, good!")
+ :group 'follow
+ :set (lambda (symbol value)
+ (if value
+ (add-hook 'find-file-hook 'follow-find-file-hook t)
+ (remove-hook 'find-file-hook 'follow-find-file-hook))
+ (set-default symbol value)))
(defvar follow-cache-command-list
'(next-line previous-line forward-char backward-char)
@@ -423,23 +321,21 @@ The commands in this list are checked at load time.
To mark other commands as suitable for caching, set the symbol
property `follow-mode-use-cache' to non-nil.")
-(defvar follow-debug nil
- "*Non-nil when debugging Follow mode.")
-
+(defcustom follow-debug nil
+ "If non-nil, emit Follow mode debugging messages."
+ :type 'boolean
+ :group 'follow)
;; Internal variables:
(defvar follow-internal-force-redisplay nil
"True when Follow mode should redisplay the windows.")
-(defvar follow-process-filter-alist '()
- "The original filters for processes intercepted by Follow mode.")
-
(defvar follow-active-menu nil
"The menu visible when Follow mode is active.")
-(defvar follow-deactive-menu nil
- "The menu visible when Follow mode is deactivated.")
+(defvar follow-inactive-menu nil
+ "The menu visible when Follow mode is inactive.")
(defvar follow-inside-post-command-hook nil
"Non-nil when inside Follow modes `post-command-hook'.
@@ -448,8 +344,7 @@ Used by `follow-window-size-change'.")
(defvar follow-windows-start-end-cache nil
"Cache used by `follow-window-start-end'.")
-;;}}}
-;;{{{ Debug messages
+;;; Debug messages
;; This inline function must be as small as possible!
;; Maybe we should define a macro that expands to nil if
@@ -460,15 +355,12 @@ Used by `follow-window-size-change'.")
(if (and (boundp 'follow-debug) follow-debug)
(apply 'message args)))
-;;}}}
-;;{{{ Cache
+;;; Cache
(dolist (cmd follow-cache-command-list)
(put cmd 'follow-mode-use-cache t))
-;;}}}
-
-;;{{{ The mode
+;;; The mode
;;;###autoload
(defun turn-on-follow-mode ()
@@ -514,49 +406,35 @@ To split one large window into two side-by-side windows, the commands
Only windows displayed in the same frame follow each other.
-If the variable `follow-intercept-processes' is non-nil, Follow mode
-will listen to the output of processes and redisplay accordingly.
-\(This is the default.)
-
This command runs the normal hook `follow-mode-hook'.
Keys specific to Follow mode:
\\{follow-mode-map}"
:keymap follow-mode-map
- (when (and follow-mode follow-intercept-processes)
- (follow-intercept-process-output))
- (cond (follow-mode ; On
- ;; XEmacs: If this is non-nil, the window will scroll before
- ;; the point will have a chance to get into the next window.
- (when (boundp 'scroll-on-clipped-lines)
- (setq scroll-on-clipped-lines nil))
- (force-mode-line-update)
- (add-hook 'post-command-hook 'follow-post-command-hook t))
-
- ((not follow-mode) ; Off
- (force-mode-line-update))))
-
-;;}}}
-;;{{{ Find file hook
-
-;; This will start follow-mode whenever a new file is loaded, if
-;; the variable `follow-auto' is non-nil.
-
-(add-hook 'find-file-hook 'follow-find-file-hook t)
+ (if follow-mode
+ (progn
+ (add-hook 'compilation-filter-hook 'follow-align-compilation-windows t t)
+ (add-hook 'post-command-hook 'follow-post-command-hook t)
+ (add-hook 'window-size-change-functions 'follow-window-size-change t))
+ ;; Remove globally-installed hook functions only if there is no
+ ;; other Follow mode buffer.
+ (let ((buffers (buffer-list))
+ following)
+ (while (and (not following) buffers)
+ (setq following (buffer-local-value 'follow-mode (car buffers))
+ buffers (cdr buffers)))
+ (unless following
+ (remove-hook 'post-command-hook 'follow-post-command-hook)
+ (remove-hook 'window-size-change-functions 'follow-window-size-change)))
+ (remove-hook 'compilation-filter-hook 'follow-align-compilation-windows t)))
(defun follow-find-file-hook ()
"Find-file hook for Follow mode. See the variable `follow-auto'."
- (if follow-auto (follow-mode t)))
-
-;;}}}
+ (if follow-auto (follow-mode 1)))
-;;{{{ User functions
+;;; User functions
-;;;
-;;; User functions usable when in Follow mode.
-;;;
-
-;;{{{ Scroll
+;;; Scroll
;; `scroll-up' and `-down', but for windows in Follow mode.
;;
@@ -584,7 +462,7 @@ Negative ARG means scroll downward.
Works like `scroll-up' when not in Follow mode."
(interactive "P")
- (cond ((not (and (boundp 'follow-mode) follow-mode))
+ (cond ((not follow-mode)
(scroll-up arg))
(arg
(save-excursion (scroll-up arg))
@@ -613,7 +491,7 @@ Negative ARG means scroll upward.
Works like `scroll-up' when not in Follow mode."
(interactive "P")
- (cond ((not (and (boundp 'follow-mode) follow-mode))
+ (cond ((not follow-mode)
(scroll-up arg))
(arg
(save-excursion (scroll-down arg)))
@@ -633,8 +511,48 @@ Works like `scroll-up' when not in Follow mode."
(vertical-motion (- next-screen-context-lines 1))
(setq follow-internal-force-redisplay t))))))
-;;}}}
-;;{{{ Buffer
+(declare-function comint-adjust-point "comint" (window))
+(defvar comint-scroll-show-maximum-output)
+
+(defun follow-comint-scroll-to-bottom (&optional window)
+ "Scroll the bottom-most window in the current Follow chain.
+This is to be called by `comint-postoutput-scroll-to-bottom'."
+ (let* ((buffer (current-buffer))
+ (selected (selected-window))
+ (is-selected (eq (window-buffer) buffer))
+ some-window)
+ (when (or is-selected
+ (setq some-window (get-buffer-window)))
+ (let* ((pos (progn (comint-adjust-point nil) (point)))
+ (win (if is-selected
+ selected
+ (car (last (follow-all-followers some-window))))))
+ (select-window win)
+ (goto-char pos)
+ (setq follow-windows-start-end-cache nil)
+ (follow-adjust-window win pos)
+ (unless is-selected
+ (select-window selected)
+ (set-buffer buffer))))))
+
+(defun follow-align-compilation-windows ()
+ "Align the windows of the current Follow mode buffer.
+This is to be called from `compilation-filter-hook'."
+ (let ((buffer (current-buffer))
+ (win (get-buffer-window))
+ (selected (selected-window)))
+ (when (and follow-mode (waiting-for-user-input-p) win)
+ (let ((windows (follow-all-followers win)))
+ (unless (eq (window-buffer selected) buffer)
+ (setq win (car windows))
+ (select-window win))
+ (follow-redisplay windows win t)
+ (setq follow-windows-start-end-cache nil)
+ (unless (eq selected win)
+ (select-window selected)
+ (set-buffer buffer))))))
+
+;;; Buffer
;;;###autoload
(defun follow-delete-other-windows-and-split (&optional arg)
@@ -649,11 +567,7 @@ two windows always will display two successive pages.
If ARG is positive, the leftmost window is selected. If negative,
the rightmost is selected. If ARG is nil, the leftmost window is
-selected if the original window is the first one in the frame.
-
-To bind this command to a hotkey, place the following line
-in your `~/.emacs' file, replacing [f7] by your favorite key:
- (global-set-key [f7] 'follow-delete-other-windows-and-split)"
+selected if the original window is the first one in the frame."
(interactive "P")
(let ((other (or (and (null arg)
(not (eq (selected-window)
@@ -689,28 +603,22 @@ Defaults to current buffer."
(current-buffer))))
(or buffer (setq buffer (current-buffer)))
(let ((orig-window (selected-window)))
- (walk-windows
- (function
- (lambda (win)
- (select-window win)
- (switch-to-buffer buffer))))
+ (walk-windows (lambda (win)
+ (select-window win)
+ (switch-to-buffer buffer))
+ 'no-minibuf)
(select-window orig-window)
(follow-redisplay)))
(defun follow-switch-to-current-buffer-all ()
- "Show current buffer in all windows on this frame, and enter Follow mode.
-
-To bind this command to a hotkey place the following line
-in your `~/.emacs' file:
- (global-set-key [f7] 'follow-switch-to-current-buffer-all)"
+ "Show current buffer in all windows on this frame, and enter Follow mode."
(interactive)
- (or (and (boundp 'follow-mode) follow-mode)
- (follow-mode 1))
+ (unless follow-mode
+ (follow-mode 1))
(follow-switch-to-buffer-all))
-;;}}}
-;;{{{ Movement
+;;; Movement
;; Note, these functions are not very useful, at least not unless you
;; rebind the rather cumbersome key sequence `C-c . p'.
@@ -744,8 +652,7 @@ in your `~/.emacs' file:
(interactive)
(select-window (car (reverse (follow-all-followers)))))
-;;}}}
-;;{{{ Redraw
+;;; Redraw
(defun follow-recenter (&optional arg)
"Recenter the middle window around point.
@@ -777,9 +684,7 @@ from the bottom."
(win (nth (/ (- (length windows) 1) 2) windows)))
(select-window win)
(goto-char dest)
- (recenter)
- ;;(setq follow-internal-force-redisplay t)
- )))
+ (recenter))))
(defun follow-redraw ()
@@ -792,8 +697,7 @@ Follow mode since the windows should always be aligned."
(sit-for 0)
(follow-redisplay))
-;;}}}
-;;{{{ End of buffer
+;;; End of buffer
(defun follow-end-of-buffer (&optional arg)
"Move point to the end of the buffer, Follow mode style.
@@ -816,38 +720,37 @@ of the way from the true end."
(with-no-warnings
(end-of-buffer arg))))
-;;}}}
-
-;;}}}
-
-;;{{{ Display
-
-;;;; The display routines
-
-;;{{{ Information gathering functions
-
-(defun follow-all-followers (&optional testwin)
- "Return all windows displaying the same buffer as the TESTWIN.
-The list contains only windows displayed in the same frame as TESTWIN.
-If TESTWIN is nil the selected window is used."
- (or (window-live-p testwin)
- (setq testwin (selected-window)))
- (let* ((top (frame-first-window (window-frame testwin)))
- (win top)
- (done nil)
- (windows '())
- (buffer (window-buffer testwin)))
- (while (and (not done) win)
- (if (eq (window-buffer win) buffer)
- (setq windows (cons win windows)))
- (setq win (next-window win 'not))
- (if (eq win top)
- (setq done t)))
- (nreverse windows)))
-
+;;; Display
+
+(defun follow--window-sorter (w1 w2)
+ "Sorting function for W1 and W2 based on their positions.
+Return non-nil if W1 is above W2; if their top-lines
+are at the same position, return non-nil if W1 is to the
+left of W2."
+ (let* ((edge-1 (window-pixel-edges w1))
+ (edge-2 (window-pixel-edges w2))
+ (y1 (nth 1 edge-1))
+ (y2 (nth 1 edge-2)))
+ (if (= y1 y2)
+ (< (car edge-1) (car edge-2))
+ (< y1 y2))))
+
+(defun follow-all-followers (&optional win)
+ "Return all windows displaying the same buffer as the WIN.
+The list is sorted with topmost and leftmost windows first, and
+contains only windows in the same frame as WIN. If WIN is nil,
+it defaults to the selected window."
+ (unless (window-live-p win)
+ (setq win (selected-window)))
+ (let ((buffer (window-buffer win))
+ windows)
+ (dolist (w (window-list (window-frame win) 'no-minibuf win))
+ (if (eq (window-buffer w) buffer)
+ (push w windows)))
+ (sort windows 'follow--window-sorter)))
(defun follow-split-followers (windows &optional win)
- "Split the WINDOWS into the sets: predecessors and successors.
+ "Split WINDOWS into two sets: predecessors and successors.
Return `(PRED . SUCC)' where `PRED' and `SUCC' are ordered starting
from the selected window."
(or win
@@ -858,62 +761,35 @@ from the selected window."
(setq windows (cdr windows)))
(cons pred (cdr windows))))
-
-;; This function is optimized function for speed!
-
(defun follow-calc-win-end (&optional win)
- "Calculate the presumed window end for WIN.
-
-Actually, the position returned is the start of the next
-window, normally is the end plus one.
-
-If WIN is nil, the selected window is used.
-
-Returns (end-pos end-of-buffer-p)"
- (if (featurep 'xemacs)
- ;; XEmacs can calculate the end of the window by using
- ;; the 'guarantee options. GOOD!
- (let ((end (window-end win t)))
- (if (= end (point-max (window-buffer win)))
- (list end t)
- (list (+ end 1) nil)))
- ;; Emacs: We have to calculate the end by ourselves.
- ;; This code works on both XEmacs and Emacs, but now
- ;; that XEmacs has got custom-written code, this could
- ;; be optimized for Emacs.
- (let (height buffer-end-p)
- (with-selected-window (or win (selected-window))
- (save-excursion
- (goto-char (window-start))
- (setq height
- (- (window-height)
- (if header-line-format 2 1)))
- (setq buffer-end-p
- (if (bolp)
- (not (= height (vertical-motion height)))
- (save-restriction
- ;; Fix a mis-feature in `vertical-motion':
- ;; The start of the window is assumed to
- ;; coincide with the start of a line.
- (narrow-to-region (point) (point-max))
- (not (= height (vertical-motion height))))))
- (list (point) buffer-end-p))))))
-
-
-;; Can't use `save-window-excursion' since it triggers a redraw.
-(defun follow-calc-win-start (windows pos win)
- "Calculate where WIN will start if the first in WINDOWS start at POS.
+ "Calculate the end position for window WIN.
+Return (END-POS END-OF-BUFFER).
+
+Actually, the position returned is the start of the line after
+the last fully-visible line in WIN. If WIN is nil, the selected
+window is used."
+ (let* ((win (or win (selected-window)))
+ (edges (window-inside-pixel-edges win))
+ (ht (- (nth 3 edges) (nth 1 edges)))
+ (last-line-pos (posn-point (posn-at-x-y 0 (1- ht) win))))
+ (if (pos-visible-in-window-p last-line-pos win)
+ (let ((end (window-end win t)))
+ (list end (= end (point-max))))
+ (list last-line-pos nil))))
-If WIN is nil the point below all windows is returned."
- (let (start)
- (while (and windows (not (eq (car windows) win)))
- (setq start (window-start (car windows)))
+(defun follow-calc-win-start (windows pos win)
+ "Determine the start of window WIN in a Follow mode window chain.
+WINDOWS is a list of chained windows, and POS is the starting
+position for the first window in the list. If WIN is nil, return
+the point below all windows."
+ (while (and windows (not (eq (car windows) win)))
+ (let ((old-start (window-start (car windows))))
+ ;; Can't use `save-window-excursion' since it triggers a redraw.
(set-window-start (car windows) pos 'noforce)
(setq pos (car (follow-calc-win-end (car windows))))
- (set-window-start (car windows) start 'noforce)
- (setq windows (cdr windows)))
- pos))
-
+ (set-window-start (car windows) old-start 'noforce)
+ (setq windows (cdr windows))))
+ pos)
;; The result from `follow-windows-start-end' is cached when using
;; a handful simple commands, like cursor movement commands.
@@ -932,23 +808,8 @@ Note that this handles the case when the cache has been set to nil."
(setq cache (cdr cache)))
(and res (null windows) (null cache))))
-
-(defsubst follow-invalidate-cache ()
- "Force `follow-windows-start-end' to recalculate the end of the window."
- (setq follow-windows-start-end-cache nil))
-
-
-;; Build a list of windows and their start and end positions.
-;; Useful to avoid calculating start/end position whenever they are needed.
-;; The list has the format:
-;; ((Win Start End End-of-buffer-visible-p) ...)
-
-;; Used to have a `save-window-excursion', but it obviously triggered
-;; redraws of the display. Check if I used it for anything.
-
-
(defun follow-windows-start-end (windows)
- "Builds a list of (WIN START END BUFFER-END-P) for every window in WINDOWS."
+ "Return a list of (WIN START END BUFFER-END-P) for window list WINDOWS."
(if (follow-cache-valid-p windows)
follow-windows-start-end-cache
(let ((orig-win (selected-window))
@@ -960,7 +821,6 @@ Note that this handles the case when the cache has been set to nil."
(select-window orig-win)
(setq follow-windows-start-end-cache (nreverse win-start-end)))))
-
(defsubst follow-pos-visible (pos win win-start-end)
"Non-nil when POS is visible in WIN."
(let ((wstart-wend-bend (cdr (assq win win-start-end))))
@@ -974,20 +834,16 @@ Note that this handles the case when the cache has been set to nil."
;; should start at a full screen line.
(defsubst follow-windows-aligned-p (win-start-end)
- "Non-nil if the follower windows are aligned."
- (let ((res t))
- (save-excursion
- (goto-char (window-start (caar win-start-end)))
- (unless (bolp)
- (vertical-motion 0 (caar win-start-end))
- (setq res (eq (point) (window-start (caar win-start-end))))))
- (while (and res (cdr win-start-end))
- ;; At least two followers left
- (setq res (eq (car (cdr (cdr (car win-start-end))))
- (car (cdr (car (cdr win-start-end))))))
+ "Non-nil if the follower windows are aligned.
+The argument, WIN-START-END, should be a list of the form
+returned by `follow-windows-start-end'."
+ (let ((result t))
+ (while (and win-start-end result)
+ (if (cdr win-start-end)
+ (setq result (eq (nth 2 (car win-start-end))
+ (nth 1 (cadr win-start-end)))))
(setq win-start-end (cdr win-start-end)))
- res))
-
+ result))
;; Check if the point is visible in all windows. (So that
;; no one will be recentered.)
@@ -1023,43 +879,22 @@ Note that this handles the case when the cache has been set to nil."
(vertical-motion 1 win)
(set-window-start win (point) 'noforce)))))
-;;}}}
-;;{{{ Selection functions
-
-;; Make a window in WINDOWS selected if it currently
-;; is displaying the position DEST.
-;;
-;; We don't select a window if it just has been moved.
-
(defun follow-select-if-visible (dest win-start-end)
"Select and return a window, if DEST is visible in it.
Return the selected window."
- (let (win win-end)
+ (let (win win-end wse)
(while (and (not win) win-start-end)
;; Don't select a window that was just moved. This makes it
- ;; possible to later select the last window after a `end-of-buffer'
- ;; command.
- (when (follow-pos-visible dest (caar win-start-end) win-start-end)
- (setq win (caar win-start-end)
- win-end (car (cddr (car win-start-end))))
+ ;; possible to later select the last window after a
+ ;; `end-of-buffer' command.
+ (setq wse (car win-start-end))
+ (when (follow-pos-visible dest (car wse) win-start-end)
+ (setq win (car wse)
+ win-end (nth 2 wse))
(select-window win))
(setq win-start-end (cdr win-start-end)))
- ;; The last line of the window may be partially visible; if so,
- ;; and if point is visible in the next window, select the next
- ;; window instead.
- (and win
- (/= dest (point-max))
- win-start-end
- (follow-pos-visible dest (caar win-start-end) win-start-end)
- (save-excursion
- (goto-char dest)
- (vertical-motion 1 win)
- (>= (point) win-end))
- (setq win (caar win-start-end))
- (select-window win))
win))
-
;; Lets select a window showing the end. Make sure we only select it if
;; it wasn't just moved here. (I.e. M-> shall not unconditionally place
;; the point in the selected window.)
@@ -1112,8 +947,8 @@ Otherwise, return nil."
(set-window-start (car windows) (point) 'noforce)
(setq end-pos-end-p (follow-calc-win-end (car windows)))
(goto-char (car end-pos-end-p))
- ;; Visible, if dest above end, or if eob is visible inside
- ;; the window.
+ ;; Visible, if dest above end, or if eob is visible
+ ;; inside the window.
(if (or (car (cdr end-pos-end-p))
(< dest (point)))
(setq win (car windows))
@@ -1124,9 +959,7 @@ Otherwise, return nil."
(goto-char dest))
win))
-
-;;}}}
-;;{{{ Redisplay
+;;; Redisplay
;; Redraw all the windows on the screen, starting with the top window.
;; The window used as as marker is WIN, or the selected window if WIN
@@ -1167,7 +1000,6 @@ repositioning the other windows."
(set-window-start w start))
(setq start (car (follow-calc-win-end w))))))
-
(defun follow-estimate-first-window-start (windows win start)
"Estimate the position of the first window.
The estimate is computed by assuming that the window WIN, which
@@ -1206,9 +1038,6 @@ should be a member of WINDOWS, starts at position START."
;; Find the starting point, start at GUESS and search upward. Return
;; a point on the same line as GUESS, or above.
-;;
-;; (Is this ever used? I must make sure it works just in case it is
-;; ever called.)
(defun follow-calculate-first-window-start-from-below
(windows guess &optional win start)
@@ -1240,65 +1069,40 @@ should be a member of WINDOWS, starts at position START."
(setq res (point))))))
res)))
-;;}}}
-;;{{{ Avoid tail recenter
+;;; Avoid tail recenter
-;; This sets the window internal flag `force_start'. The effect is that
-;; windows only displaying the tail aren't recentered.
-;; Has to be called before every redisplay... (Great isn't it?)
-;;
-;; XEmacs doesn't recenter the tail, GOOD!
-;;
-;; A window displaying only the tail, is a window whose
-;; window-start position is equal to (point-max) of the buffer it
-;; displays.
-;;
-;; This function is also added to `post-command-idle-hook', introduced
-;; in Emacs 19.30. This is needed since the vaccine injected by the
-;; call from `post-command-hook' only works until the next redisplay.
-;; It is possible that the functions in the `post-command-idle-hook'
-;; can cause a redisplay, and hence a new vaccine is needed.
+;; This sets the window internal flag `force_start'. The effect is
+;; that windows only displaying the tail aren't recentered.
;;
-;; Sometimes, calling this function could actually cause a redisplay,
-;; especially if it is placed in the debug filter section. I must
-;; investigate this further...
+;; A window displaying only the tail, is a window whose window-start
+;; position is equal to (point-max) of the buffer it displays.
(defun follow-avoid-tail-recenter (&rest _rest)
"Make sure windows displaying the end of a buffer aren't recentered.
-
This is done by reading and rewriting the start position of
non-first windows in Follow mode."
- (if follow-avoid-tail-recenter-p
- (let* ((orig-buffer (current-buffer))
- (top (frame-first-window (selected-frame)))
- (win top)
- (who '()) ; list of (buffer . frame)
- start
- pair) ; (buffer . frame)
- ;; If the only window in the frame is a minibuffer
- ;; window, `next-window' will never find it again...
- (if (window-minibuffer-p top)
- nil
- (while ;; look, no body!
- (progn
- (setq start (window-start win))
- (set-buffer (window-buffer win))
- (setq pair (cons (window-buffer win) (window-frame win)))
- (if (member pair who)
- (if (and (boundp 'follow-mode) follow-mode
- (eq (point-max) start))
- ;; Write the same window start back, but don't
- ;; set the NOFORCE flag.
- (set-window-start win start))
- (setq who (cons pair who)))
- (setq win (next-window win 'not t))
- (not (eq win top)))) ;; Loop while this is true.
- (set-buffer orig-buffer)))))
-
-;;}}}
-
-;;}}}
-;;{{{ Post Command Hook
+ (let* ((orig-buffer (current-buffer))
+ (top (frame-first-window (selected-frame)))
+ (win top)
+ who) ; list of (buffer . frame)
+ ;; If the only window in the frame is a minibuffer
+ ;; window, `next-window' will never find it again...
+ (unless (window-minibuffer-p top)
+ (while ;; look, no body!
+ (let ((start (window-start win))
+ (pair (cons (window-buffer win) (window-frame win))))
+ (set-buffer (window-buffer win))
+ (cond ((null (member pair who))
+ (setq who (cons pair who)))
+ ((and follow-mode (eq (point-max) start))
+ ;; Write the same window start back, but don't
+ ;; set the NOFORCE flag.
+ (set-window-start win start)))
+ (setq win (next-window win 'not t))
+ (not (eq win top)))) ;; Loop while this is true.
+ (set-buffer orig-buffer))))
+
+;;; Post Command Hook
;; The magic little box. This function is called after every command.
@@ -1319,149 +1123,151 @@ non-first windows in Follow mode."
(with-current-buffer (window-buffer win)
(unless (and (symbolp this-command)
(get this-command 'follow-mode-use-cache))
- (follow-invalidate-cache))
- (when (and follow-mode
- (not (window-minibuffer-p win)))
- ;; The buffer shown in the selected window is in follow
- ;; mode. Find the current state of the display.
- (let* ((windows (follow-all-followers win))
- (dest (point))
- (win-start-end (progn
- (follow-update-window-start (car windows))
- (follow-windows-start-end windows)))
- (aligned (follow-windows-aligned-p win-start-end))
- (visible (follow-pos-visible dest win win-start-end))
- selected-window-up-to-date)
- (unless (and aligned visible)
- (follow-invalidate-cache))
- (follow-avoid-tail-recenter)
- ;; Select a window to display point.
- (unless follow-internal-force-redisplay
- (if (eq dest (point-max))
- ;; At point-max, we have to be careful since the
- ;; display can be aligned while `dest' can be
- ;; visible in several windows.
- (cond
- ;; Select the current window, but only when the
- ;; display is correct. (When inserting characters
- ;; in a tail window, the display is not correct, as
- ;; they are shown twice.)
- ;;
- ;; Never stick to the current window after a
- ;; deletion. The reason is cosmetic: when typing
- ;; `DEL' in a window showing only the end of the
- ;; file, a character would be removed from the
- ;; window above, which is very unintuitive.
- ((and visible
- aligned
- (not (memq this-command
- '(backward-delete-char
- delete-backward-char
- backward-delete-char-untabify
- kill-region))))
- (follow-debug-message "Max: same"))
- ;; If the end is visible, and the window doesn't
- ;; seems like it just has been moved, select it.
- ((follow-select-if-end-visible win-start-end)
- (follow-debug-message "Max: end visible")
- (setq visible t aligned nil)
- (goto-char dest))
- ;; Just show the end...
- (t
- (follow-debug-message "Max: default")
- (select-window (car (reverse windows)))
- (goto-char dest)
- (setq visible nil aligned nil)))
-
- ;; We're not at the end, here life is much simpler.
- (cond
- ;; This is the normal case!
- ;; It should be optimized for speed.
- ((and visible aligned)
- (follow-debug-message "same"))
- ;; Pick a position in any window. If the display is
- ;; ok, this will pick the `correct' window.
- ((follow-select-if-visible dest win-start-end)
- (follow-debug-message "visible")
- (goto-char dest)
- ;; We have to perform redisplay, since scrolling is
- ;; needed in case the line is partially visible.
- (setq visible nil))
- ;; Not visible anywhere else, lets pick this one.
- ;; (Is this case used?)
- (visible
- (follow-debug-message "visible in selected."))
- ;; Far out!
- ((eq dest (point-min))
- (follow-debug-message "min")
- (select-window (car windows))
- (goto-char dest)
- (set-window-start (selected-window) (point-min))
- (setq win-start-end (follow-windows-start-end windows))
- (follow-invalidate-cache)
- (setq visible t aligned nil))
- ;; If we can position the cursor without moving the first
- ;; window, do it. This is the case that catches `RET'
- ;; at the bottom of a window.
- ((follow-select-if-visible-from-first dest windows)
- (follow-debug-message "Below first")
- (setq visible t aligned t))
- ;; None of the above. For simplicity, we stick to the
- ;; selected window.
- (t
- (follow-debug-message "None")
- (setq visible nil aligned nil))))
- ;; If a new window has been selected, make sure that the
- ;; old is not scrolled when the point is outside the
- ;; window.
- (unless (eq win (selected-window))
- (let ((p (window-point win)))
- (set-window-start win (window-start win) nil)
- (set-window-point win p))))
- (unless visible
- ;; If point may not be visible in the selected window,
- ;; perform a redisplay; this ensures scrolling.
- (redisplay)
- (setq selected-window-up-to-date t)
- (follow-avoid-tail-recenter)
- (setq win-start-end (follow-windows-start-end windows))
- (follow-invalidate-cache)
- (setq aligned nil))
- ;; Now redraw the windows around the selected window.
- (unless (and (not follow-internal-force-redisplay)
- (or aligned
- (follow-windows-aligned-p win-start-end))
- (follow-point-visible-all-windows-p
- win-start-end))
- (setq follow-internal-force-redisplay nil)
- (follow-redisplay windows (selected-window)
- selected-window-up-to-date)
- (setq win-start-end (follow-windows-start-end windows))
- (follow-invalidate-cache)
- ;; When the point ends up in another window. This
- ;; happens when dest is in the beginning of the file and
- ;; the selected window is not the first. It can also,
- ;; in rare situations happen when long lines are used
- ;; and there is a big difference between the width of
- ;; the windows. (When scrolling one line in a wide
- ;; window which will cause a move larger that an entire
- ;; small window.)
- (unless (follow-pos-visible dest win win-start-end)
- (follow-select-if-visible dest win-start-end)
- (goto-char dest)))
-
- ;; If the region is visible, make it look good when spanning
- ;; multiple windows.
- (when (region-active-p)
- (follow-maximize-region
- (selected-window) windows win-start-end))))
- ;; Whether or not the buffer was in follow mode, we must
- ;; update the windows displaying the tail so that Emacs won't
- ;; recenter them.
- (follow-avoid-tail-recenter)))))
-
-;;}}}
-;;{{{ The region
+ (setq follow-windows-start-end-cache nil)))
+ (follow-adjust-window win (point)))))
+
+(defun follow-adjust-window (win dest)
+ ;; Adjust the window WIN and its followers.
+ (with-current-buffer (window-buffer win)
+ (when (and follow-mode
+ (not (window-minibuffer-p win)))
+ (let* ((windows (follow-all-followers win))
+ (win-start-end (progn
+ (follow-update-window-start (car windows))
+ (follow-windows-start-end windows)))
+ (aligned (follow-windows-aligned-p win-start-end))
+ (visible (follow-pos-visible dest win win-start-end))
+ selected-window-up-to-date)
+ (unless (and aligned visible)
+ (setq follow-windows-start-end-cache nil))
+
+ ;; Select a window to display point.
+ (unless follow-internal-force-redisplay
+ (if (eq dest (point-max))
+ ;; Be careful at point-max: the display can be aligned
+ ;; while DEST can be visible in several windows.
+ (cond
+ ;; Select the current window, but only when the display
+ ;; is correct. (When inserting characters in a tail
+ ;; window, the display is not correct, as they are
+ ;; shown twice.)
+ ;;
+ ;; Never stick to the current window after a deletion.
+ ;; Otherwise, when typing `DEL' in a window showing
+ ;; only the end of the file, a character would be
+ ;; removed from the window above, which is very
+ ;; unintuitive.
+ ((and visible
+ aligned
+ (not (memq this-command
+ '(backward-delete-char
+ delete-backward-char
+ backward-delete-char-untabify
+ kill-region))))
+ (follow-debug-message "Max: same"))
+ ;; If the end is visible, and the window doesn't
+ ;; seems like it just has been moved, select it.
+ ((follow-select-if-end-visible win-start-end)
+ (follow-debug-message "Max: end visible")
+ (setq visible t aligned nil)
+ (goto-char dest))
+ ;; Just show the end...
+ (t
+ (follow-debug-message "Max: default")
+ (select-window (car (last windows)))
+ (goto-char dest)
+ (setq visible nil aligned nil)))
+
+ ;; We're not at the end, here life is much simpler.
+ (cond
+ ;; This is the normal case!
+ ;; It should be optimized for speed.
+ ((and visible aligned)
+ (follow-debug-message "same"))
+ ;; Pick a position in any window. If the display is ok,
+ ;; this picks the `correct' window.
+ ((follow-select-if-visible dest win-start-end)
+ (follow-debug-message "visible")
+ (goto-char dest)
+ ;; Perform redisplay, in case line is partially visible.
+ (setq visible nil))
+ ;; Not visible anywhere else, lets pick this one.
+ (visible
+ (follow-debug-message "visible in selected."))
+ ;; If DEST is before the first window start, select the
+ ;; first window.
+ ((< dest (nth 1 (car win-start-end)))
+ (follow-debug-message "before first")
+ (select-window (car windows))
+ (goto-char dest)
+ (setq visible nil aligned nil))
+ ;; If we can position the cursor without moving the first
+ ;; window, do it. This is the case that catches `RET' at
+ ;; the bottom of a window.
+ ((follow-select-if-visible-from-first dest windows)
+ (follow-debug-message "Below first")
+ (setq visible t aligned t))
+ ;; None of the above. Stick to the selected window.
+ (t
+ (follow-debug-message "None")
+ (setq visible nil aligned nil))))
+
+ ;; If a new window was selected, make sure that the old is
+ ;; not scrolled when the point is outside the window.
+ (unless (eq win (selected-window))
+ (let ((p (window-point win)))
+ (set-window-start win (window-start win) nil)
+ (set-window-point win p))))
+
+ (unless visible
+ ;; If point may not be visible in the selected window,
+ ;; perform a redisplay; this ensures scrolling.
+ (let ((opoint (point)))
+ (redisplay)
+ ;; If this `redisplay' moved point, we got clobbered by a
+ ;; previous call to `set-window-start'. Try again.
+ (when (/= (point) opoint)
+ (goto-char opoint)
+ (redisplay)))
+
+ (setq selected-window-up-to-date t)
+ (follow-avoid-tail-recenter)
+ (setq win-start-end (follow-windows-start-end windows)
+ follow-windows-start-end-cache nil
+ aligned nil))
+
+ ;; Now redraw the windows around the selected window.
+ (unless (and (not follow-internal-force-redisplay)
+ (or aligned
+ (follow-windows-aligned-p win-start-end))
+ (follow-point-visible-all-windows-p win-start-end))
+ (setq follow-internal-force-redisplay nil)
+ (follow-redisplay windows (selected-window)
+ selected-window-up-to-date)
+ (setq win-start-end (follow-windows-start-end windows)
+ follow-windows-start-end-cache nil)
+ ;; The point can ends up in another window when DEST is at
+ ;; the beginning of the buffer and the selected window is
+ ;; not the first. It can also happen when long lines are
+ ;; used and there is a big difference between the width of
+ ;; the windows. (When scrolling one line in a wide window
+ ;; which will cause a move larger that an entire small
+ ;; window.)
+ (unless (follow-pos-visible dest win win-start-end)
+ (follow-select-if-visible dest win-start-end)
+ (goto-char dest)))
+
+ ;; If the region is visible, make it look good when spanning
+ ;; multiple windows.
+ (when (region-active-p)
+ (follow-maximize-region
+ (selected-window) windows win-start-end)))
+
+ ;; Whether or not the buffer was in follow mode, update windows
+ ;; displaying the tail so that Emacs won't recenter them.
+ (follow-avoid-tail-recenter))))
+
+;;; The region
;; Tries to make the highlighted area representing the region look
;; good when spanning several windows.
@@ -1484,440 +1290,70 @@ non-first windows in Follow mode."
(set-window-point (car succ) (nth 1 (assq (car succ) win-start-end)))
(setq succ (cdr succ)))))
-;;}}}
-;;{{{ Scroll bar
+;;; Scroll bar
;;;; Scroll-bar support code.
-;; Why is it needed? Well, if the selected window is in follow mode,
-;; all its followers stick to it blindly. If one of them is scrolled,
-;; it immediately returns to the original position when the mouse is
-;; released. If the selected window is not a follower of the dragged
-;; window the windows will be unaligned.
-
-;; The advices don't get compiled. Aesthetically, this might be a
-;; problem but in practical life it isn't.
-
-;; Discussion: Now when the other windows in the chain follow the
-;; dragged, should we really select it?
-
-(cond ((fboundp 'scroll-bar-drag)
- ;;;
- ;;; Emacs style scrollbars.
- ;;;
-
- ;; Select the dragged window if it is a follower of the
- ;; selected window.
- ;;
- ;; Generate advices of the form:
- ;; (defadvice scroll-bar-drag (after follow-scroll-bar-drag activate)
- ;; "Adviced by `follow-mode'."
- ;; (follow-redraw-after-event (ad-get-arg 0)))
- (let ((cmds '(scroll-bar-drag
- scroll-bar-drag-1 ; Executed at every move.
- scroll-bar-scroll-down
- scroll-bar-scroll-up
- scroll-bar-set-window-start)))
- (while cmds
- (eval
- `(defadvice ,(intern (symbol-name (car cmds)))
- (after
- ,(intern (concat "follow-" (symbol-name (car cmds))))
- activate)
- "Adviced by Follow mode."
- (follow-redraw-after-event (ad-get-arg 0))))
- (setq cmds (cdr cmds))))
-
-
- (defun follow-redraw-after-event (event)
- "Adviced by Follow mode."
- (condition-case nil
- (let* ((orig-win (selected-window))
- (win (nth 0 (funcall
- (symbol-function 'event-start) event)))
- (fmode (assq 'follow-mode
- (buffer-local-variables
- (window-buffer win)))))
- (if (and fmode (cdr fmode))
- ;; The selected window is in follow-mode
- (progn
- ;; Recenter around the dragged window.
- (select-window win)
- (follow-redisplay)
- (select-window orig-win))))
- (error nil))))
-
-
- ((fboundp 'scrollbar-vertical-drag)
- ;;;
- ;;; XEmacs style scrollbars.
- ;;;
-
- ;; Advice all scrollbar functions on the form:
- ;;
- ;; (defadvice scrollbar-line-down
- ;; (after follow-scrollbar-line-down activate)
- ;; (follow-xemacs-scrollbar-support (ad-get-arg 0)))
-
- (let ((cmds '(scrollbar-line-down ; Window
- scrollbar-line-up
- scrollbar-page-down ; Object
- scrollbar-page-up
- scrollbar-to-bottom ; Window
- scrollbar-to-top
- scrollbar-vertical-drag ; Object
- )))
-
- (while cmds
- (eval
- `(defadvice ,(intern (symbol-name (car cmds)))
- (after
- ,(intern (concat "follow-" (symbol-name (car cmds))))
- activate)
- "Adviced by `follow-mode'."
- (follow-xemacs-scrollbar-support (ad-get-arg 0))))
- (setq cmds (cdr cmds))))
-
-
- (defun follow-xemacs-scrollbar-support (window)
- "Redraw windows showing the same buffer as shown in WINDOW.
-WINDOW is either the dragged window, or a cons containing the
-window as its first element. This is called while the user drags
-the scrollbar.
-
-WINDOW can be an object or a window."
- (condition-case nil
- (progn
- (if (consp window)
- (setq window (car window)))
- (let ((fmode (assq 'follow-mode
- (buffer-local-variables
- (window-buffer window))))
- (orig-win (selected-window)))
- (if (and fmode (cdr fmode))
- (progn
- ;; Recenter around the dragged window.
- (select-window window)
- (follow-redisplay)
- (select-window orig-win)))))
- (error nil)))))
-
-;;}}}
-;;{{{ Process output
-
-;; The following sections installs a spy that listens to process
-;; output and tries to reposition the windows whose buffers are in
-;; Follow mode. We play safe as much as possible...
-;;
-;; When follow-mode is activated all active processes are
-;; intercepted. All new processes that change their filter function
-;; using `set-process-filter' are also intercepted. The reason is
-;; that a process can cause a redisplay recentering "tail" windows.
-;; Note that it doesn't hurt to spy on more processes than needed.
-;;
-;; Technically, we set the process filter to `follow-generic-filter'.
-;; The original filter is stored in `follow-process-filter-alist'.
-;; Our generic filter calls the original filter, or inserts the
-;; output into the buffer, if the buffer originally didn't have an
-;; output filter. It also makes sure that the windows connected to
-;; the buffer are aligned.
-;;
-;; Discussion: How do we find processes that don't call
-;; `set-process-filter'? (How often are processes created in a
-;; buffer after Follow mode are activated?)
-;;
-;; Discussion: Should we also advice `process-filter' to make our
-;; filter invisible to others?
-
-;;{{{ Advice for `set-process-filter'
-
-;; Do not call this with 'follow-generic-filter as the name of the
-;; filter...
-
-(defadvice set-process-filter (before follow-set-process-filter activate)
- "Ensure process output will be displayed correctly in Follow mode buffers.
-
-Follow mode inserts its own process filter to do its
-magic stuff before the real process filter is called."
- (if follow-intercept-processes
- (progn
- (setq follow-process-filter-alist
- (delq (assq (ad-get-arg 0) follow-process-filter-alist)
- follow-process-filter-alist))
- (follow-tidy-process-filter-alist)
- (cond ((eq (ad-get-arg 1) t))
- ((eq (ad-get-arg 1) nil)
- (ad-set-arg 1 'follow-generic-filter))
- (t
- (setq follow-process-filter-alist
- (cons (cons (ad-get-arg 0) (ad-get-arg 1))
- follow-process-filter-alist))
- (ad-set-arg 1 'follow-generic-filter))))))
-
-
-(defun follow-call-set-process-filter (proc filter)
- "Call original `set-process-filter' without the Follow mode advice."
- (ad-disable-advice 'set-process-filter 'before
- 'follow-set-process-filter)
- (ad-activate 'set-process-filter)
- (prog1
- (set-process-filter proc filter)
- (ad-enable-advice 'set-process-filter 'before
- 'follow-set-process-filter)
- (ad-activate 'set-process-filter)))
-
-
-(defadvice process-filter (after follow-process-filter activate)
- "Return the original process filter, not `follow-generic-filter'."
- (cond ((eq ad-return-value 'follow-generic-filter)
- (setq ad-return-value
- (cdr-safe (assq (ad-get-arg 0)
- follow-process-filter-alist))))))
-
-
-(defun follow-call-process-filter (proc)
- "Call original `process-filter' without the Follow mode advice."
- (ad-disable-advice 'process-filter 'after
- 'follow-process-filter)
- (ad-activate 'process-filter)
- (prog1
- (process-filter proc)
- (ad-enable-advice 'process-filter 'after
- 'follow-process-filter)
- (ad-activate 'process-filter)))
-
-
-(defun follow-tidy-process-filter-alist ()
- "Remove old processes from `follow-process-filter-alist'."
- (let ((alist follow-process-filter-alist)
- (ps (process-list))
- (new ()))
- (while alist
- (if (and (not (memq (process-status (car (car alist)))
- '(exit signal closed nil)))
- (memq (car (car alist)) ps))
- (setq new (cons (car alist) new)))
- (setq alist (cdr alist)))
- (setq follow-process-filter-alist new)))
-
-;;}}}
-;;{{{ Start/stop interception of processes.
-
-;; Normally, all new processes are intercepted by our `set-process-filter'.
-;; This is needed to intercept old processes that were started before we were
-;; loaded, and processes we have forgotten by calling
-;; `follow-stop-intercept-process-output'.
-
-(defun follow-intercept-process-output ()
- "Intercept all active processes.
-
-This is needed so that Follow mode can track all display events in the
-system. (See `follow-mode'.)"
- (interactive)
- (let ((list (process-list)))
- (while list
- (if (eq (process-filter (car list)) 'follow-generic-filter)
- nil
- ;; The custom `set-process-filter' defined above.
- (set-process-filter (car list) (process-filter (car list))))
- (setq list (cdr list))))
- (setq follow-intercept-processes t))
-
-
-(defun follow-stop-intercept-process-output ()
- "Stop Follow mode from spying on processes.
-
-All current spypoints are removed and no new will be added.
-
-The effect is that Follow mode won't be able to handle buffers
-connected to processes.
-
-The only reason to call this function is if the Follow mode spy filter
-would interfere with some other package. If this happens, please
-report this using the `report-emacs-bug' function."
- (interactive)
- (follow-tidy-process-filter-alist)
- (dolist (process (process-list))
- (when (eq (follow-call-process-filter process) 'follow-generic-filter)
- (follow-call-set-process-filter
- process
- (cdr-safe (assq process follow-process-filter-alist)))
- (setq follow-process-filter-alist
- (delq (assq process follow-process-filter-alist)
- follow-process-filter-alist))))
- (setq follow-intercept-processes nil))
-
-;;}}}
-;;{{{ The filter
-
-;; The following section is a naive method to make buffers with
-;; process output to work with Follow mode. Whenever the start of the
-;; window displaying the buffer is moved, we move it back to its
-;; original position and try to select a new window. (If we fail,
-;; the normal redisplay functions of Emacs will scroll it right
-;; back!)
-
-(defun follow-generic-filter (proc output)
- "Process output filter for process connected to buffers in Follow mode."
- (let* ((old-buffer (current-buffer))
- (orig-win (selected-window))
- (buf (process-buffer proc))
- (win (and buf (if (eq buf (window-buffer orig-win))
- orig-win
- (get-buffer-window buf t))))
- (return-to-orig-win (and win (not (eq win orig-win))))
- (orig-window-start (and win (window-start win))))
-
- ;; If input is pending, the `sit-for' below won't redraw the
- ;; display. In that case, calling `follow-avoid-tail-recenter' may
- ;; provoke the process handling code to schedule a redisplay.
- ;(or (input-pending-p)
- ; (follow-avoid-tail-recenter))
-
- ;; Output the `output'.
- (let ((filter (cdr-safe (assq proc follow-process-filter-alist))))
- (cond
- ;; Call the original filter function
- (filter
- (funcall filter proc output))
-
- ;; No filter, but we've got a buffer. Just output into it.
- (buf
- (set-buffer buf)
- (if (not (marker-buffer (process-mark proc)))
- (set-marker (process-mark proc) (point-max)))
- (let ((moving (= (point) (process-mark proc)))
- deactivate-mark
- (inhibit-read-only t))
- (save-excursion
- (goto-char (process-mark proc))
- ;; `insert-before-markers' just in case the user's next
- ;; command is M-y.
- (insert-before-markers output)
- (set-marker (process-mark proc) (point)))
- (if moving (goto-char (process-mark proc)))))))
-
- ;; If we're in follow mode, do our stuff. Select a new window and
- ;; redisplay. (Actually, it is redundant to check `buf', but I
- ;; feel it's more correct.)
- (if (and buf (window-live-p win))
- (progn
- (set-buffer buf)
- (if (and (boundp 'follow-mode) follow-mode)
- (progn
- (select-window win)
- (let* ((windows (follow-all-followers win))
- (win-start-end (follow-windows-start-end windows))
- (new-window-start (window-start win))
- (new-window-point (window-point win)))
- (cond
- ;; The start of the selected window was repositioned.
- ;; Try to use the original start position and continue
- ;; working with a window to the "right" in the window
- ;; chain. This will create the effect that the output
- ;; starts in one window and continues into the next.
-
- ;; If the display has changed so much that it is not
- ;; possible to keep the original window fixed and still
- ;; display the point then we give up and use the new
- ;; window start.
-
- ;; This case is typically used when the process filter
- ;; tries to reposition the start of the window in order
- ;; to view the tail of the output.
- ((not (eq orig-window-start new-window-start))
- (follow-debug-message "filter: Moved")
- (set-window-start win orig-window-start)
- (follow-redisplay windows win)
- (setq win-start-end (follow-windows-start-end windows))
- (follow-select-if-visible new-window-point
- win-start-end)
- (goto-char new-window-point)
- (if (eq win (selected-window))
- (set-window-start win new-window-start))
- (setq win-start-end (follow-windows-start-end windows)))
- ;; Stick to this window, if point is visible in it.
- ((pos-visible-in-window-p new-window-point)
- (follow-debug-message "filter: Visible in window"))
- ;; Avoid redisplaying the first window. If the
- ;; point is visible at a window below,
- ;; redisplay and select it.
- ((follow-select-if-visible-from-first
- new-window-point windows)
- (follow-debug-message "filter: Seen from first")
- (setq win-start-end
- (follow-windows-start-end windows)))
- ;; None of the above. We stick to the current window.
- (t
- (follow-debug-message "filter: nothing")))
-
- ;; Here we have selected a window. Make sure the
- ;; windows are aligned and the point is visible
- ;; in the selected window.
- (if (and (not (follow-pos-visible
- (point) (selected-window) win-start-end))
- (not return-to-orig-win))
- (progn
- (sit-for 0)
- (setq win-start-end
- (follow-windows-start-end windows))))
-
- (if (or follow-internal-force-redisplay
- (not (follow-windows-aligned-p win-start-end)))
- (follow-redisplay windows)))))))
-
- ;; return to the original window.
- (if return-to-orig-win
- (select-window orig-win))
- ;; Restore the original buffer, unless the filter explicitly
- ;; changed buffer or killed the old buffer.
- (if (and (eq buf (current-buffer))
- (buffer-name old-buffer))
- (set-buffer old-buffer)))
-
- (follow-invalidate-cache)
-
- ;; Normally, if the display has been changed, it is redrawn. All
- ;; windows showing only the end of a buffer are unconditionally
- ;; recentered; we can't prevent that by calling
- ;; `follow-avoid-tail-recenter'.
- ;;
- ;; We force a redisplay here on our own, so Emacs does need to.
- ;; (However, redisplaying when there's input available just seems
- ;; to make things worse, so we exclude that case.)
- (if (and follow-avoid-tail-recenter-p
- (not (input-pending-p)))
- (sit-for 0)))
-
-;;}}}
-
-;;}}}
-;;{{{ Window size change
-
-;; In Emacs 19.29, the functions in `window-size-change-functions' are
-;; called every time a window in a frame changes size. Most notably, it
-;; is called after the frame has been resized.
-;;
-;; We basically call our post-command-hook for every buffer that is
-;; visible in any window in the resized frame, which is in follow-mode.
-;;
-;; Since this function can be called indirectly from
-;; `follow-post-command-hook' we have a potential infinite loop. We
-;; handle this problem by simply not doing anything at all in this
-;; situation. The variable `follow-inside-post-command-hook' contains
-;; information about whether the execution actually is inside the
+;; This handles the case where the user drags the scroll bar of a
+;; non-selected window whose buffer is in Follow mode.
+
+(defun follow-scroll-bar-toolkit-scroll (event)
+ (interactive "e")
+ (scroll-bar-toolkit-scroll event)
+ (follow-redraw-after-event event))
+
+(defun follow-scroll-bar-drag (event)
+ (interactive "e")
+ (scroll-bar-drag event)
+ (follow-redraw-after-event event))
+
+(defun follow-scroll-bar-scroll-up (event)
+ (interactive "e")
+ (scroll-bar-scroll-up event)
+ (follow-redraw-after-event event))
+
+(defun follow-scroll-bar-scroll-down (event)
+ (interactive "e")
+ (scroll-bar-scroll-down event)
+ (follow-redraw-after-event event))
+
+(defun follow-mwheel-scroll (event)
+ (interactive "e")
+ (mwheel-scroll event)
+ (follow-redraw-after-event event))
+
+(defun follow-redraw-after-event (event)
+ "Re-align the Follow mode windows affected by EVENT."
+ (let* ((window (nth 0 (event-end event)))
+ (buffer (window-buffer window))
+ (orig-win (selected-window)))
+ (when (and (buffer-local-value 'follow-mode buffer)
+ ;; Ignore the case where we scroll the selected window;
+ ;; that is handled by the post-command hook function.
+ (not (eq window (selected-window))))
+ (select-window window)
+ (follow-redisplay)
+ (unless (eq (window-buffer orig-win) buffer)
+ (select-window orig-win)))))
+
+;;; Window size change
+
+;; The functions in `window-size-change-functions' are called every
+;; time a window in a frame changes size, most notably after the frame
+;; has been resized. We call `follow-post-command-hook' for every
+;; Follow mode buffer visible in any window in the resized frame.
+;;
+;; Since `follow-window-size-change' can be called indirectly from
+;; `follow-post-command-hook' we have a potential infinite loop. To
+;; avoid this, we simply do not do anything in this situation. The
+;; variable `follow-inside-post-command-hook' contains information
+;; about whether the execution actually is inside the
;; post-command-hook or not.
-(if (boundp 'window-size-change-functions)
- (add-hook 'window-size-change-functions 'follow-window-size-change))
-
-
(defun follow-window-size-change (frame)
"Redraw all windows in FRAME, when in Follow mode."
- ;; Below, we call `post-command-hook'. This makes sure that we
- ;; don't start a mutually recursive endless loop.
- (if follow-inside-post-command-hook
- nil
+ ;; Below, we call `post-command-hook'. Avoid an infloop.
+ (unless follow-inside-post-command-hook
(let ((buffers '())
(orig-window (selected-window))
(orig-buffer (current-buffer))
@@ -1927,193 +1363,59 @@ report this using the `report-emacs-bug' function."
(select-frame frame)
(unwind-protect
(walk-windows
- (function
- (lambda (win)
- (setq buf (window-buffer win))
- (if (memq buf buffers)
- nil
- (set-buffer buf)
- (if (and (boundp 'follow-mode)
- follow-mode)
- (progn
- (setq windows (follow-all-followers win))
- (if (memq orig-window windows)
- (progn
- ;; Make sure we're redrawing around the
- ;; selected window.
- ;;
- ;; We must be really careful not to do this
- ;; when we are (indirectly) called by
- ;; `post-command-hook'.
- (select-window orig-window)
- (follow-post-command-hook)
- (setq orig-window (selected-window)))
- (follow-redisplay windows win))
- (setq buffers (cons buf buffers))))))))
+ (lambda (win)
+ (setq buf (window-buffer win))
+ (unless (memq buf buffers)
+ (set-buffer buf)
+ (when follow-mode
+ (setq windows (follow-all-followers win))
+ (if (not (memq orig-window windows))
+ (follow-redisplay windows win)
+ ;; Make sure we're redrawing around the selected
+ ;; window.
+ (select-window orig-window)
+ (follow-post-command-hook)
+ (setq orig-window (selected-window)))
+ (setq buffers (cons buf buffers)))))
+ 'no-minibuf)
(select-frame orig-frame)
(set-buffer orig-buffer)
(select-window orig-window)))))
-;;}}}
-
-;;{{{ XEmacs isearch
-
-;; In XEmacs, isearch often finds matches in other windows than the
-;; currently selected. However, when exiting the old window
-;; configuration is restored, with the exception of the beginning of
-;; the start of the window for the selected window. This is not much
-;; help for us.
-;;
-;; We overwrite the stored window configuration with the current,
-;; unless we are in `slow-search-mode', i.e. only a few lines
-;; of text is visible.
-
-(if (featurep 'xemacs)
- (defadvice isearch-done (before follow-isearch-done activate)
- (if (and (boundp 'follow-mode)
- follow-mode
- (boundp 'isearch-window-configuration)
- isearch-window-configuration
- (boundp 'isearch-slow-terminal-mode)
- (not isearch-slow-terminal-mode))
- (let ((buf (current-buffer)))
- (setq isearch-window-configuration
- (current-window-configuration))
- (set-buffer buf)))))
-
-;;}}}
-;;{{{ Tail window handling
-
-;; In Emacs (not XEmacs) windows showing nothing are sometimes
-;; recentered. When in Follow mode, this is not desirable for
-;; non-first windows in the window chain. This section tries to
-;; make the windows stay where they should be.
-;;
-;; If the display is updated, all windows starting at (point-max) are
-;; going to be recentered at the next redisplay, unless we do a
-;; read-and-write cycle to update the `force' flag inside the windows.
-;;
-;; In 19.30, a new variable `window-scroll-functions' is called every
-;; time a window is recentered. It is not perfect for our situation,
-;; since when it is called for a tail window, it is to late. However,
-;; if it is called for another window, we can try to update our
-;; windows.
-;;
-;; By patching `sit-for' we can make sure that to catch all explicit
-;; updates initiated by lisp programs. Internal calls, on the other
-;; hand, are not handled.
-;;
-;; Please note that the function `follow-avoid-tail-recenter' is also
-;; called from other places, e.g. `post-command-hook' and
-;; `post-command-idle-hook'.
-
-;; If this function is called it is too late for this window, but
-;; we might save other windows from being recentered.
-
-(if (and follow-avoid-tail-recenter-p (boundp 'window-scroll-functions))
- (add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t))
-
-
-;; This prevents all packages that calls `sit-for' directly
-;; to recenter tail windows.
-
-(if follow-avoid-tail-recenter-p
- (defadvice sit-for (before follow-sit-for activate)
- "Adviced by Follow mode.
+(add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t)
-Avoid to recenter windows displaying only the end of a file as when
-displaying a short file in two windows, using Follow mode."
- (follow-avoid-tail-recenter)))
-
-
-;; Without this advice, `mouse-drag-region' would start to recenter
-;; tail windows.
-
-(if (and follow-avoid-tail-recenter-p
- (fboundp 'move-overlay))
- (defadvice move-overlay (before follow-move-overlay activate)
- "Adviced by Follow mode.
-Don't recenter windows showing only the end of a buffer.
-This prevents `mouse-drag-region' from messing things up."
- (follow-avoid-tail-recenter)))
-
-;;}}}
-;;{{{ profile support
+;;; Profile support
;; The following (non-evaluated) section can be used to
;; profile this package using `elp'.
;;
;; Invalid indentation on purpose!
-(cond (nil
-(setq elp-function-list
- '(window-end
- vertical-motion
- ; sit-for ;; elp can't handle advices...
- follow-mode
- follow-all-followers
- follow-split-followers
- follow-redisplay
- follow-estimate-first-window-start
- follow-calculate-first-window-start-from-above
- follow-calculate-first-window-start-from-below
- follow-calc-win-end
- follow-calc-win-start
- follow-pos-visible
- follow-windows-start-end
- follow-cache-valid-p
- follow-select-if-visible
- follow-select-if-visible-from-first
- follow-windows-aligned-p
- follow-point-visible-all-windows-p
- follow-avoid-tail-recenter
- follow-update-window-start
- follow-post-command-hook
- ))))
-
-;;}}}
-
-;;{{{ The end
-
-(defun follow-unload-function ()
- "Unload Follow mode library."
- (easy-menu-remove-item nil '("Tools") "Follow")
- (follow-stop-intercept-process-output)
- (dolist (group '((before
- ;; XEmacs
- isearch-done
- ;; both
- set-process-filter sit-for move-overlay)
- (after
- ;; Emacs
- scroll-bar-drag scroll-bar-drag-1 scroll-bar-scroll-down
- scroll-bar-scroll-up scroll-bar-set-window-start
- ;; XEmacs
- scrollbar-line-down scrollbar-line-up scrollbar-page-down
- scrollbar-page-up scrollbar-to-bottom scrollbar-to-top
- scrollbar-vertical-drag
- ;; both
- process-filter)))
- (let ((class (car group)))
- (dolist (fun (cdr group))
- (when (functionp fun)
- (condition-case nil
- (progn
- (ad-remove-advice fun class
- (intern (concat "follow-" (symbol-name fun))))
- (ad-update fun))
- (error nil))))))
- ;; continue standard processing
- nil)
-
-;;
-;; We're done!
-;;
+;; (setq elp-function-list
+;; '(window-end
+;; vertical-motion
+;; follow-mode
+;; follow-all-followers
+;; follow-split-followers
+;; follow-redisplay
+;; follow-estimate-first-window-start
+;; follow-calculate-first-window-start-from-above
+;; follow-calculate-first-window-start-from-below
+;; follow-calc-win-end
+;; follow-calc-win-start
+;; follow-pos-visible
+;; follow-windows-start-end
+;; follow-cache-valid-p
+;; follow-select-if-visible
+;; follow-select-if-visible-from-first
+;; follow-windows-aligned-p
+;; follow-point-visible-all-windows-p
+;; follow-avoid-tail-recenter
+;; follow-update-window-start
+;; follow-post-command-hook))
(provide 'follow)
-;;}}}
-
;; /------------------------------------------------------------------------\
;; | "I [..] am rarely happier then when spending an entire day programming |
;; | my computer to perform automatically a task that it would otherwise |
diff --git a/lisp/font-core.el b/lisp/font-core.el
index a5de29520f7..fc647a3727b 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -1,6 +1,6 @@
;;; font-core.el --- Core interface to font-lock
-;; Copyright (C) 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: languages, faces
@@ -138,6 +138,7 @@ The above is the default behavior of `font-lock-mode'; you may specify
your own function which is called when `font-lock-mode' is toggled via
`font-lock-function'. "
nil nil nil
+ :after-hook (font-lock-initial-fontify)
;; Don't turn on Font Lock mode if we don't have a display (we're running a
;; batch job) or if the buffer is invisible (the name starts with a space).
(when (or noninteractive (eq (aref (buffer-name) 0) ?\s))
@@ -191,13 +192,7 @@ this function onto `change-major-mode-hook'."
;; Only do hard work if the mode has specified stuff in
;; `font-lock-defaults'.
- (when (or font-lock-defaults
- (if (boundp 'font-lock-keywords) font-lock-keywords)
- (and mode
- (boundp 'font-lock-set-defaults)
- font-lock-set-defaults
- font-lock-major-mode
- (not (eq font-lock-major-mode major-mode))))
+ (when (font-lock-specified-p mode)
(font-lock-mode-internal mode)))
(defun turn-on-font-lock ()
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 2db0d809275..78760c015ff 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1,6 +1,6 @@
;;; font-lock.el --- Electric font lock mode
-;; Copyright (C) 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
;; Author: Jamie Zawinski
;; Richard Stallman
@@ -37,7 +37,7 @@
;; When this minor mode is on, the faces of the current line are updated with
;; every insertion or deletion.
;;
-;; To turn Font Lock mode on automatically, add this to your ~/.emacs file:
+;; To turn Font Lock mode on automatically, add this to your init file:
;;
;; (add-hook 'emacs-lisp-mode-hook 'turn-on-font-lock)
;;
@@ -67,7 +67,7 @@
;;
;; The syntactic keyword pass places `syntax-table' text properties in the
;; buffer according to the variable `font-lock-syntactic-keywords'. It is
-;; necessary because Emacs' syntax table is not powerful enough to describe all
+;; necessary because Emacs's syntax table is not powerful enough to describe all
;; the different syntactic constructs required by the sort of people who decide
;; that a single quote can be syntactic or not depending on the time of day.
;; (What sort of person could decide to overload the meaning of a quote?)
@@ -146,8 +146,8 @@
;; fontified automagically. In your ~/.emacs there could be:
;;
;; (defvar foo-font-lock-keywords
-;; '(("\\<\\(one\\|two\\|three\\)\\>" . font-lock-keyword-face)
-;; ("\\<\\(four\\|five\\|six\\)\\>" . font-lock-type-face))
+;; '(("\\<\\(one\\|two\\|three\\)\\>" . 'font-lock-keyword-face)
+;; ("\\<\\(four\\|five\\|six\\)\\>" . 'font-lock-type-face))
;; "Default expressions to highlight in Foo mode.")
;;
;; (add-hook 'foo-mode-hook
@@ -167,8 +167,8 @@
;; could be:
;;
;; (defvar bar-font-lock-keywords
-;; '(("\\<\\(uno\\|due\\|tre\\)\\>" . font-lock-keyword-face)
-;; ("\\<\\(quattro\\|cinque\\|sei\\)\\>" . font-lock-type-face))
+;; '(("\\<\\(uno\\|due\\|tre\\)\\>" . 'font-lock-keyword-face)
+;; ("\\<\\(quattro\\|cinque\\|sei\\)\\>" . 'font-lock-type-face))
;; "Default expressions to highlight in Bar mode.")
;;
;; and within `bar-mode' there could be:
@@ -207,7 +207,7 @@
;;; Code:
(require 'syntax)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;; Define core `font-lock' group.
(defgroup font-lock '((jit-lock custom-group))
@@ -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:
@@ -492,11 +492,11 @@ This is normally set via `font-lock-add-keywords' and
`font-lock-remove-keywords'.")
(defvar font-lock-keywords-only nil
- "*Non-nil means Font Lock should not fontify comments or strings.
+ "Non-nil means Font Lock should not fontify comments or strings.
This is normally set via `font-lock-defaults'.")
(defvar font-lock-keywords-case-fold-search nil
- "*Non-nil means the patterns in `font-lock-keywords' are case-insensitive.
+ "Non-nil means the patterns in `font-lock-keywords' are case-insensitive.
This is set via the function `font-lock-set-defaults', based on
the CASE-FOLD argument of `font-lock-defaults'.")
(make-variable-buffer-local 'font-lock-keywords-case-fold-search)
@@ -556,7 +556,7 @@ If this is nil, the major mode's syntax table is used.
This is normally set via `font-lock-defaults'.")
(defvar font-lock-beginning-of-syntax-function nil
- "*Non-nil means use this function to move back outside all constructs.
+ "Non-nil means use this function to move back outside all constructs.
When called with no args it should move point backward to a place which
is not in a string or comment and not within any bracket-pairs (or else,
a place such that any bracket-pairs outside it can be ignored for Emacs
@@ -571,7 +571,7 @@ This is normally set via `font-lock-defaults'.")
'syntax-begin-function "23.3" 'set)
(defvar font-lock-mark-block-function nil
- "*Non-nil means use this function to mark a block of text.
+ "Non-nil means use this function to mark a block of text.
When called with no args it should leave point at the beginning of any
enclosing textual block and mark at the end.
This is normally set via `font-lock-defaults'.")
@@ -614,9 +614,6 @@ Major/minor modes can set this variable if they know which option applies.")
(eval-when-compile
;;
- ;; We don't do this at the top-level as we only use non-autoloaded macros.
- (require 'cl)
- ;;
;; Borrowed from lazy-lock.el.
;; We use this to preserve or protect things when modifying text properties.
(defmacro save-buffer-state (&rest body)
@@ -629,13 +626,24 @@ Major/minor modes can set this variable if they know which option applies.")
;; Shut up the byte compiler.
(defvar font-lock-face-attributes)) ; Obsolete but respected if set.
-(defun font-lock-mode-internal (arg)
- ;; Turn on Font Lock mode.
- (when arg
- (add-hook 'after-change-functions 'font-lock-after-change-function t t)
- (font-lock-set-defaults)
- (font-lock-turn-on-thing-lock)
- ;; Fontify the buffer if we have to.
+(defun font-lock-specified-p (mode)
+ "Return non-nil if the current buffer is ready for fontification.
+The MODE argument, if non-nil, means Font Lock mode is about to
+be enabled."
+ (or font-lock-defaults
+ (and (boundp 'font-lock-keywords)
+ font-lock-keywords)
+ (and mode
+ (boundp 'font-lock-set-defaults)
+ font-lock-set-defaults
+ font-lock-major-mode
+ (not (eq font-lock-major-mode major-mode)))))
+
+(defun font-lock-initial-fontify ()
+ ;; The first fontification after turning the mode on. This must
+ ;; only be called after the mode hooks have been run.
+ (when (and font-lock-mode
+ (font-lock-specified-p t))
(let ((max-size (font-lock-value-in-major-mode font-lock-maximum-size)))
(cond (font-lock-fontified
nil)
@@ -643,7 +651,14 @@ Major/minor modes can set this variable if they know which option applies.")
(font-lock-fontify-buffer))
(font-lock-verbose
(message "Fontifying %s...buffer size greater than font-lock-maximum-size"
- (buffer-name))))))
+ (buffer-name)))))))
+
+(defun font-lock-mode-internal (arg)
+ ;; Turn on Font Lock mode.
+ (when arg
+ (add-hook 'after-change-functions 'font-lock-after-change-function t t)
+ (font-lock-set-defaults)
+ (font-lock-turn-on-thing-lock))
;; Turn off Font Lock mode.
(unless font-lock-mode
(remove-hook 'after-change-functions 'font-lock-after-change-function t)
@@ -664,8 +679,8 @@ end of the current highlighting list.
For example:
(font-lock-add-keywords 'c-mode
- '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
- (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . font-lock-keyword-face)))
+ '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 'font-lock-warning-face prepend)
+ (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . 'font-lock-keyword-face)))
adds two fontification patterns for C mode, to fontify `FIXME:' words, even in
comments, and to fontify `and', `or' and `not' words as keywords.
@@ -679,9 +694,9 @@ For example:
(add-hook 'c-mode-hook
(lambda ()
(font-lock-add-keywords nil
- '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
+ '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 'font-lock-warning-face prepend)
(\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" .
- font-lock-keyword-face)))))
+ 'font-lock-keyword-face)))))
The above procedure may fail to add keywords to derived modes if
some involved major mode does not follow the standard conventions.
@@ -899,10 +914,10 @@ The value of this variable is used when Font Lock mode is turned on."
(declare-function lazy-lock-mode "lazy-lock")
(defun font-lock-turn-on-thing-lock ()
- (case (font-lock-value-in-major-mode font-lock-support-mode)
- (fast-lock-mode (fast-lock-mode t))
- (lazy-lock-mode (lazy-lock-mode t))
- (jit-lock-mode
+ (pcase (font-lock-value-in-major-mode font-lock-support-mode)
+ (`fast-lock-mode (fast-lock-mode t))
+ (`lazy-lock-mode (lazy-lock-mode t))
+ (`jit-lock-mode
;; Prepare for jit-lock
(remove-hook 'after-change-functions
'font-lock-after-change-function t)
@@ -1636,7 +1651,7 @@ LOUDLY, if non-nil, allows progress-meter bar."
;; Fontify each item in `font-lock-keywords' from `start' to `end'.
(while keywords
(if loudly (message "Fontifying %s... (regexps..%s)" bufname
- (make-string (incf count) ?.)))
+ (make-string (cl-incf count) ?.)))
;;
;; Find an occurrence of `matcher' from `start' to `end'.
(setq keyword (car keywords) matcher (car keyword))
@@ -1859,22 +1874,22 @@ Sets various variables using `font-lock-defaults' and
;; `custom-declare-face'.
(defface font-lock-comment-face
'((((class grayscale) (background light))
- (:foreground "DimGray" :weight bold :slant italic))
+ :foreground "DimGray" :weight bold :slant italic)
(((class grayscale) (background dark))
- (:foreground "LightGray" :weight bold :slant italic))
+ :foreground "LightGray" :weight bold :slant italic)
(((class color) (min-colors 88) (background light))
- (:foreground "Firebrick"))
+ :foreground "Firebrick")
(((class color) (min-colors 88) (background dark))
- (:foreground "chocolate1"))
+ :foreground "chocolate1")
(((class color) (min-colors 16) (background light))
- (:foreground "red"))
+ :foreground "red")
(((class color) (min-colors 16) (background dark))
- (:foreground "red1"))
+ :foreground "red1")
(((class color) (min-colors 8) (background light))
- (:foreground "red"))
+ :foreground "red")
(((class color) (min-colors 8) (background dark))
- (:foreground "yellow"))
- (t (:weight bold :slant italic)))
+ :foreground "yellow")
+ (t :weight bold :slant italic))
"Font Lock mode face used to highlight comments."
:group 'font-lock-faces)
@@ -1884,14 +1899,14 @@ Sets various variables using `font-lock-defaults' and
:group 'font-lock-faces)
(defface font-lock-string-face
- '((((class grayscale) (background light)) (:foreground "DimGray" :slant italic))
- (((class grayscale) (background dark)) (:foreground "LightGray" :slant italic))
- (((class color) (min-colors 88) (background light)) (:foreground "VioletRed4"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSalmon"))
- (((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
- (((class color) (min-colors 8)) (:foreground "green"))
- (t (:slant italic)))
+ '((((class grayscale) (background light)) :foreground "DimGray" :slant italic)
+ (((class grayscale) (background dark)) :foreground "LightGray" :slant italic)
+ (((class color) (min-colors 88) (background light)) :foreground "VioletRed4")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightSalmon")
+ (((class color) (min-colors 16) (background light)) :foreground "RosyBrown")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightSalmon")
+ (((class color) (min-colors 8)) :foreground "green")
+ (t :slant italic))
"Font Lock mode face used to highlight strings."
:group 'font-lock-faces)
@@ -1901,76 +1916,76 @@ Sets various variables using `font-lock-defaults' and
:group 'font-lock-faces)
(defface font-lock-keyword-face
- '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
- (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
- (((class color) (min-colors 88) (background light)) (:foreground "Purple"))
- (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
- (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
- (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
- (((class color) (min-colors 8)) (:foreground "cyan" :weight bold))
- (t (:weight bold)))
+ '((((class grayscale) (background light)) :foreground "LightGray" :weight bold)
+ (((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "Purple")
+ (((class color) (min-colors 88) (background dark)) :foreground "Cyan1")
+ (((class color) (min-colors 16) (background light)) :foreground "Purple")
+ (((class color) (min-colors 16) (background dark)) :foreground "Cyan")
+ (((class color) (min-colors 8)) :foreground "cyan" :weight bold)
+ (t :weight bold))
"Font Lock mode face used to highlight keywords."
:group 'font-lock-faces)
(defface font-lock-builtin-face
- '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
- (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
- (((class color) (min-colors 88) (background light)) (:foreground "dark slate blue"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSteelBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Orchid"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue"))
- (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
- (t (:weight bold)))
+ '((((class grayscale) (background light)) :foreground "LightGray" :weight bold)
+ (((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "dark slate blue")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightSteelBlue")
+ (((class color) (min-colors 16) (background light)) :foreground "Orchid")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightSteelBlue")
+ (((class color) (min-colors 8)) :foreground "blue" :weight bold)
+ (t :weight bold))
"Font Lock mode face used to highlight builtins."
:group 'font-lock-faces)
(defface font-lock-function-name-face
- '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
- (t (:inverse-video t :weight bold)))
+ '((((class color) (min-colors 88) (background light)) :foreground "Blue1")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue")
+ (((class color) (min-colors 16) (background light)) :foreground "Blue")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightSkyBlue")
+ (((class color) (min-colors 8)) :foreground "blue" :weight bold)
+ (t :inverse-video t :weight bold))
"Font Lock mode face used to highlight function names."
:group 'font-lock-faces)
(defface font-lock-variable-name-face
'((((class grayscale) (background light))
- (:foreground "Gray90" :weight bold :slant italic))
+ :foreground "Gray90" :weight bold :slant italic)
(((class grayscale) (background dark))
- (:foreground "DimGray" :weight bold :slant italic))
- (((class color) (min-colors 88) (background light)) (:foreground "sienna"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod"))
- (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
- (((class color) (min-colors 8)) (:foreground "yellow" :weight light))
- (t (:weight bold :slant italic)))
+ :foreground "DimGray" :weight bold :slant italic)
+ (((class color) (min-colors 88) (background light)) :foreground "sienna")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightGoldenrod")
+ (((class color) (min-colors 16) (background light)) :foreground "DarkGoldenrod")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightGoldenrod")
+ (((class color) (min-colors 8)) :foreground "yellow" :weight light)
+ (t :weight bold :slant italic))
"Font Lock mode face used to highlight variable names."
:group 'font-lock-faces)
(defface font-lock-type-face
- '((((class grayscale) (background light)) (:foreground "Gray90" :weight bold))
- (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
- (((class color) (min-colors 88) (background light)) (:foreground "ForestGreen"))
- (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
- (((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
- (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
- (((class color) (min-colors 8)) (:foreground "green"))
- (t (:weight bold :underline t)))
+ '((((class grayscale) (background light)) :foreground "Gray90" :weight bold)
+ (((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "ForestGreen")
+ (((class color) (min-colors 88) (background dark)) :foreground "PaleGreen")
+ (((class color) (min-colors 16) (background light)) :foreground "ForestGreen")
+ (((class color) (min-colors 16) (background dark)) :foreground "PaleGreen")
+ (((class color) (min-colors 8)) :foreground "green")
+ (t :weight bold :underline t))
"Font Lock mode face used to highlight type and classes."
:group 'font-lock-faces)
(defface font-lock-constant-face
'((((class grayscale) (background light))
- (:foreground "LightGray" :weight bold :underline t))
+ :foreground "LightGray" :weight bold :underline t)
(((class grayscale) (background dark))
- (:foreground "Gray50" :weight bold :underline t))
- (((class color) (min-colors 88) (background light)) (:foreground "dark cyan"))
- (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine"))
- (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
- (((class color) (min-colors 8)) (:foreground "magenta"))
- (t (:weight bold :underline t)))
+ :foreground "Gray50" :weight bold :underline t)
+ (((class color) (min-colors 88) (background light)) :foreground "dark cyan")
+ (((class color) (min-colors 88) (background dark)) :foreground "Aquamarine")
+ (((class color) (min-colors 16) (background light)) :foreground "CadetBlue")
+ (((class color) (min-colors 16) (background dark)) :foreground "Aquamarine")
+ (((class color) (min-colors 8)) :foreground "magenta")
+ (t :weight bold :underline t))
"Font Lock mode face used to highlight constants and labels."
:group 'font-lock-faces)
@@ -2266,13 +2281,13 @@ in which C preprocessor directives are used. e.g. `asm-mode' and
`(;; Control structures. Emacs Lisp forms.
(,(concat
"(" (regexp-opt
- '("cond" "if" "while" "while-no-input" "let" "let*"
- "prog" "progn" "progv" "prog1" "prog2" "prog*"
- "inline" "lambda" "save-restriction" "save-excursion"
- "save-selected-window" "save-window-excursion"
- "save-match-data" "save-current-buffer"
+ '("cond" "if" "while" "while-no-input" "let" "let*" "letrec"
+ "pcase" "pcase-let" "pcase-let*" "prog" "progn" "progv"
+ "prog1" "prog2" "prog*" "inline" "lambda"
+ "save-restriction" "save-excursion" "save-selected-window"
+ "save-window-excursion" "save-match-data" "save-current-buffer"
"combine-after-change-calls" "unwind-protect"
- "condition-case" "condition-case-no-debug"
+ "condition-case" "condition-case-unless-debug"
"track-mouse" "eval-after-load" "eval-and-compile"
"eval-when-compile" "eval-when" "eval-next-after-load"
"with-case-table" "with-category-table"
@@ -2283,7 +2298,7 @@ in which C preprocessor directives are used. e.g. `asm-mode' and
"with-selected-window" "with-selected-frame"
"with-silent-modifications" "with-syntax-table"
"with-temp-buffer" "with-temp-file" "with-temp-message"
- "with-timeout" "with-timeout-handler") t)
+ "with-timeout" "with-timeout-handler" "with-wrapper-hook") t)
"\\>")
. 1)
;; Control structures. Common Lisp forms.
diff --git a/lisp/format-spec.el b/lisp/format-spec.el
index 68d57b73db1..1bf9a49fa48 100644
--- a/lisp/format-spec.el
+++ b/lisp/format-spec.el
@@ -1,6 +1,6 @@
;;; format-spec.el --- functions for formatting arbitrary formatting strings
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: tools
diff --git a/lisp/format.el b/lisp/format.el
index 61c68870e08..cfaad623042 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -1,6 +1,6 @@
;;; format.el --- read and save files in multiple formats
-;; Copyright (C) 1994-1995, 1997, 1999, 2001-2011
+;; Copyright (C) 1994-1995, 1997, 1999, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
diff --git a/lisp/forms.el b/lisp/forms.el
index 0d92dc3ffd9..4626b28f464 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -1,6 +1,6 @@
;;; forms.el --- Forms mode: edit a file as a form to fill in
-;; Copyright (C) 1991, 1994-1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994-1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Johan Vromans <jvromans@squirrel.nl>
@@ -21,7 +21,7 @@
;;; Commentary:
-;; Visit a file using a form. See forms-d2.el for examples.
+;; Visit a file using a form. See etc/forms for examples.
;;
;; === Naming conventions
;;
@@ -581,7 +581,7 @@ Commands: Equivalent keys in read-only mode:
(error (concat "Forms control file error: "
"`forms-modified-record-filter' is not a function")))
- ;; The filters acces the contents of the forms using `forms-fields'.
+ ;; The filters access the contents of the forms using `forms-fields'.
(make-local-variable 'forms-fields)
;; Dynamic text support.
@@ -669,7 +669,7 @@ Commands: Equivalent keys in read-only mode:
;;(message "forms: proceeding setup...")
- ;; Since we aren't really implementing a minor mode, we hack the modeline
+ ;; Since we aren't really implementing a minor mode, we hack the mode line
;; directly to get the text " View " into forms-read-only form buffers. For
;; that reason, this variable must be buffer only.
(make-local-variable 'minor-mode-alist)
@@ -2030,8 +2030,10 @@ Usage: (setq forms-number-of-fields
;;; Debugging
-(defvar forms--debug nil
- "*Enables forms-mode debugging if not nil.")
+(defcustom forms--debug nil
+ "If non-nil, enable Forms mode debugging."
+ :type 'boolean
+ :group 'forms)
(defun forms--debug (&rest args)
"Internal debugging routine."
diff --git a/lisp/frame.el b/lisp/frame.el
index af668f80961..7a54efc23e7 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1,6 +1,6 @@
;;; frame.el --- multi-frame management independent of window systems
-;; Copyright (C) 1993-1994, 1996-1997, 2000-2011
+;; Copyright (C) 1993-1994, 1996-1997, 2000-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -25,7 +25,7 @@
;;; Commentary:
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defvar frame-creation-function-alist
(list (cons nil
@@ -39,10 +39,20 @@ function to this list, which should take an alist of parameters
as its argument.")
(defvar window-system-default-frame-alist nil
- "Alist of window-system dependent default frame parameters.
-Parameters specified here supersede the values given in
+ "Window-system dependent default frame parameters.
+The value should be an alist of elements (WINDOW-SYSTEM . ALIST),
+where WINDOW-SYSTEM is a window system symbol (see `window-system')
+and ALIST is a frame parameter alist like `default-frame-alist'.
+Then, for frames on WINDOW-SYSTEM, any parameters specified in
+ALIST supersede the corresponding parameters specified in
`default-frame-alist'.")
+(defvar display-format-alist nil
+ "Alist of patterns to decode display names.
+The car of each entry is a regular expression matching a display
+name string. The cdr is a symbol giving the window-system that
+handles the corresponding kind of display.")
+
;; The initial value given here used to ask for a minibuffer.
;; But that's not necessary, because the default is to have one.
;; By not specifying it here, we let an X resource specify it.
@@ -299,7 +309,7 @@ there (in decreasing order of priority)."
;; existing frame. We need to explicitly include
;; default-frame-alist in the parameters of the screen we
;; create here, so that its new value, gleaned from the user's
- ;; .emacs file, will be applied to the existing screen.
+ ;; init file, will be applied to the existing screen.
(if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist)
(assq 'minibuffer window-system-frame-alist)
(assq 'minibuffer default-frame-alist)
@@ -396,7 +406,7 @@ there (in decreasing order of priority)."
;; Finally, get rid of the old frame.
(delete-frame frame-initial-frame t))
- ;; Otherwise, we don't need all that rigamarole; just apply
+ ;; Otherwise, we don't need all that rigmarole; just apply
;; the new parameters.
(let (newparms allparms tail)
(setq allparms (append initial-frame-alist
@@ -508,31 +518,19 @@ is not considered (see `next-frame')."
0))
(select-frame-set-input-focus (selected-frame)))
-(declare-function x-initialize-window-system "term/x-win" ())
-(declare-function ns-initialize-window-system "term/ns-win" ())
-(defvar x-display-name) ; term/x-win
+(defun window-system-for-display (display)
+ "Return the window system for DISPLAY.
+Return nil if we don't know how to interpret DISPLAY."
+ (cl-loop for descriptor in display-format-alist
+ for pattern = (car descriptor)
+ for system = (cdr descriptor)
+ when (string-match-p pattern display) return system))
(defun make-frame-on-display (display &optional parameters)
"Make a frame on display DISPLAY.
The optional argument PARAMETERS specifies additional frame parameters."
(interactive "sMake frame on display: ")
- (cond ((featurep 'ns)
- (when (and (boundp 'ns-initialized) (not ns-initialized))
- (setq x-display-name display)
- (ns-initialize-window-system))
- (make-frame `((window-system . ns)
- (display . ,display) . ,parameters)))
- ((eq system-type 'windows-nt)
- ;; On Windows, ignore DISPLAY.
- (make-frame parameters))
- (t
- (unless (string-match-p "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
- (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
- (when (and (boundp 'x-initialized) (not x-initialized))
- (setq x-display-name display)
- (x-initialize-window-system))
- (make-frame `((window-system . x)
- (display . ,display) . ,parameters)))))
+ (make-frame (cons (cons 'display display) parameters)))
(declare-function x-close-connection "xfns.c" (terminal))
@@ -614,6 +612,8 @@ neither or both.
(window-system . nil) The frame should be displayed on a terminal device.
(window-system . x) The frame should be displayed in an X window.
+ (display . \":0\") The frame should appear on display :0.
+
(terminal . TERMINAL) The frame should use the terminal object TERMINAL.
In addition, any parameter specified in `default-frame-alist',
@@ -624,11 +624,15 @@ this function runs the hook `before-make-frame-hook'. After
creating the frame, it runs the hook `after-make-frame-functions'
with one arg, the newly created frame.
+If a display parameter is supplied and a window-system is not,
+guess the window-system from the display.
+
On graphical displays, this function does not itself make the new
frame the selected frame. However, the window system may select
the new frame according to its own rules."
(interactive)
- (let* ((w (cond
+ (let* ((display (cdr (assq 'display parameters)))
+ (w (cond
((assq 'terminal parameters)
(let ((type (terminal-live-p (cdr (assq 'terminal parameters)))))
(cond
@@ -638,6 +642,10 @@ the new frame according to its own rules."
(t type))))
((assq 'window-system parameters)
(cdr (assq 'window-system parameters)))
+ (display
+ (or (window-system-for-display display)
+ (error "Don't know how to interpret display \"%S\""
+ display)))
(t window-system)))
(frame-creation-function (cdr (assq w frame-creation-function-alist)))
(oldframe (selected-frame))
@@ -645,6 +653,13 @@ the new frame according to its own rules."
frame)
(unless frame-creation-function
(error "Don't know how to create a frame on window system %s" w))
+
+ (unless (get w 'window-system-initialized)
+ (unless x-display-name
+ (setq x-display-name display))
+ (funcall (cdr (assq w window-system-initialization-alist)))
+ (put w 'window-system-initialized t))
+
;; Add parameters from `window-system-default-frame-alist'.
(dolist (p (cdr (assq w window-system-default-frame-alist)))
(unless (assq (car p) params)
@@ -1048,15 +1063,25 @@ If FRAME is omitted, describe the currently selected frame."
(pattern &optional face frame maximum width))
(define-obsolete-function-alias 'set-default-font 'set-frame-font "23.1")
-(defun set-frame-font (font-name &optional keep-size)
- "Set the font of the selected frame to FONT-NAME.
-When called interactively, prompt for the name of the font to use.
-To get the frame's current default font, use `frame-parameters'.
-
-The default behavior is to keep the numbers of lines and columns in
-the frame, thus may change its pixel size. If optional KEEP-SIZE is
-non-nil (interactively, prefix argument) the current frame size (in
-pixels) is kept by adjusting the numbers of the lines and columns."
+
+(defun set-frame-font (font &optional keep-size frames)
+ "Set the default font to FONT.
+When called interactively, prompt for the name of a font, and use
+that font on the selected frame. When called from Lisp, FONT
+should be a font name (a string), a font object, font entity, or
+font spec.
+
+If KEEP-SIZE is nil, keep the number of frame lines and columns
+fixed. If KEEP-SIZE is non-nil (or with a prefix argument), try
+to keep the current frame size fixed (in pixels) by adjusting the
+number of lines and columns.
+
+If FRAMES is nil, apply the font to the selected frame only.
+If FRAMES is non-nil, it should be a list of frames to act upon,
+or t meaning all graphical frames. Also, if FRAME is non-nil,
+alter the user's Customization settings as though the
+font-related attributes of the `default' face had been \"set in
+this session\", so that the font is applied to future frames."
(interactive
(let* ((completion-ignore-case t)
(font (completing-read "Font name: "
@@ -1065,19 +1090,57 @@ pixels) is kept by adjusting the numbers of the lines and columns."
(x-list-fonts "*" nil (selected-frame))
nil nil nil nil
(frame-parameter nil 'font))))
- (list font current-prefix-arg)))
- (let (fht fwd)
- (if keep-size
- (setq fht (* (frame-parameter nil 'height) (frame-char-height))
- fwd (* (frame-parameter nil 'width) (frame-char-width))))
- (modify-frame-parameters (selected-frame)
- (list (cons 'font font-name)))
- (if keep-size
- (modify-frame-parameters
- (selected-frame)
- (list (cons 'height (round fht (frame-char-height)))
- (cons 'width (round fwd (frame-char-width)))))))
- (run-hooks 'after-setting-font-hook 'after-setting-font-hooks))
+ (list font current-prefix-arg nil)))
+ (when (or (stringp font) (fontp font))
+ (let* ((this-frame (selected-frame))
+ ;; FRAMES nil means affect the selected frame.
+ (frame-list (cond ((null frames)
+ (list this-frame))
+ ((eq frames t)
+ (frame-list))
+ (t frames)))
+ height width)
+ (dolist (f frame-list)
+ (when (display-multi-font-p f)
+ (if keep-size
+ (setq height (* (frame-parameter f 'height)
+ (frame-char-height f))
+ width (* (frame-parameter f 'width)
+ (frame-char-width f))))
+ ;; When set-face-attribute is called for :font, Emacs
+ ;; guesses the best font according to other face attributes
+ ;; (:width, :weight, etc.) so reset them too (Bug#2476).
+ (set-face-attribute 'default f
+ :width 'normal :weight 'normal
+ :slant 'normal :font font)
+ (if keep-size
+ (modify-frame-parameters
+ f
+ (list (cons 'height (round height (frame-char-height f)))
+ (cons 'width (round width (frame-char-width f))))))))
+ (when frames
+ ;; Alter the user's Custom setting of the `default' face, but
+ ;; only for font-related attributes.
+ (let ((specs (cadr (assq 'user (get 'default 'theme-face))))
+ (attrs '(:family :foundry :slant :weight :height :width))
+ (new-specs nil))
+ (if (null specs) (setq specs '((t nil))))
+ (dolist (spec specs)
+ ;; Each SPEC has the form (DISPLAY ATTRIBUTE-PLIST)
+ (let ((display (nth 0 spec))
+ (plist (copy-tree (nth 1 spec))))
+ ;; Alter only DISPLAY conditions matching this frame.
+ (when (or (memq display '(t default))
+ (face-spec-set-match-display display this-frame))
+ (dolist (attr attrs)
+ (setq plist (plist-put plist attr
+ (face-attribute 'default attr)))))
+ (push (list display plist) new-specs)))
+ (setq new-specs (nreverse new-specs))
+ (put 'default 'customized-face new-specs)
+ (custom-push-theme 'theme-face 'default 'user 'set new-specs)
+ (put 'default 'face-modified nil))))
+ (run-hooks 'after-setting-font-hook 'after-setting-font-hooks)))
(defun set-frame-parameter (frame parameter value)
"Set frame parameter PARAMETER to VALUE on FRAME.
@@ -1108,7 +1171,11 @@ To get the frame's current foreground color, use `frame-parameters'."
(defun set-cursor-color (color-name)
"Set the text cursor color of the selected frame to COLOR-NAME.
When called interactively, prompt for the name of the color to use.
-To get the frame's current cursor color, use `frame-parameters'."
+This works by setting the `cursor-color' frame parameter on the
+selected frame.
+
+You can also set the text cursor color, for all frames, by
+customizing the `cursor' face."
(interactive (list (read-color "Cursor color: ")))
(modify-frame-parameters (selected-frame)
(list (cons 'cursor-color color-name))))
@@ -1173,8 +1240,8 @@ often have their own features for raising or lowering frames."
(defun set-frame-name (name)
"Set the name of the selected frame to NAME.
When called interactively, prompt for the name of the frame.
-The frame name is displayed on the modeline if the terminal displays only
-one frame, otherwise the name is displayed on the frame's caption bar."
+On text terminals, the frame name is displayed on the mode line.
+On graphical displays, it is displayed on the frame's title bar."
(interactive "sFrame name: ")
(modify-frame-parameters (selected-frame)
(list (cons 'name name))))
@@ -1206,7 +1273,7 @@ frame's display)."
(cond
((eq frame-type 'pc)
(msdos-mouse-p))
- ((eq system-type 'windows-nt)
+ ((eq frame-type 'w32)
(with-no-warnings
(> w32-num-mouse-buttons 0)))
((memq frame-type '(x ns))
@@ -1503,21 +1570,6 @@ left untouched. FRAME nil or omitted means use the selected frame."
'delete-frame-functions "22.1")
-;; Highlighting trailing whitespace.
-
-(make-variable-buffer-local 'show-trailing-whitespace)
-
-
-;; Scrolling
-
-(defgroup scrolling nil
- "Scrolling windows."
- :version "21.1"
- :group 'frames)
-
-(defvaralias 'automatic-hscrolling 'auto-hscroll-mode)
-
-
;; Blinking cursor
(defgroup cursor nil
@@ -1573,6 +1625,8 @@ itself as a pre-command hook."
(cancel-timer blink-cursor-timer)
(setq blink-cursor-timer nil)))
+(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
+
(define-minor-mode blink-cursor-mode
"Toggle cursor blinking (Blink Cursor mode).
With a prefix argument ARG, enable Blink Cursor mode if ARG is
@@ -1599,8 +1653,6 @@ terminals, cursor blinking is controlled by the terminal."
blink-cursor-delay
'blink-cursor-start))))
-(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
-
;;;; Key bindings
@@ -1609,6 +1661,19 @@ terminals, cursor blinking is controlled by the terminal."
(define-key ctl-x-5-map "0" 'delete-frame)
(define-key ctl-x-5-map "o" 'other-frame)
+
+;; Misc.
+
+;; Only marked as obsolete in 24.3.
+(define-obsolete-variable-alias 'automatic-hscrolling
+ 'auto-hscroll-mode "22.1")
+
+(make-variable-buffer-local 'show-trailing-whitespace)
+
+;; Defined in dispnew.c.
+(make-obsolete-variable
+ 'window-system-version "it does not give useful information." "24.3")
+
(provide 'frame)
;;; frame.el ends here
diff --git a/lisp/fringe.el b/lisp/fringe.el
index fa5ebb6f0c6..6ff27a71355 100644
--- a/lisp/fringe.el
+++ b/lisp/fringe.el
@@ -1,6 +1,6 @@
;;; fringe.el --- fringe setup and control -*- coding: utf-8 -*-
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Maintainer: FSF
@@ -30,7 +30,7 @@
;; The code is influenced by scroll-bar.el and avoid.el. The author
;; gratefully acknowledge comments and suggestions made by Miles
-;; Bader, Eli Zaretski, Richard Stallman, Pavel Janík and others which
+;; Bader, Eli Zaretskii, Richard Stallman, Pavel Janík and others which
;; improved this package.
;;; Code:
@@ -43,7 +43,7 @@
;; Define the built-in fringe bitmaps and setup default mappings
(when (boundp 'fringe-bitmaps)
- (let ((bitmaps '(question-mark
+ (let ((bitmaps '(question-mark exclamation-mark
left-arrow right-arrow up-arrow down-arrow
left-curly-arrow right-curly-arrow
left-triangle right-triangle
@@ -105,8 +105,8 @@ This is usually invoked when setting `fringe-mode' via customize."
(defun set-fringe-mode (value)
"Set `fringe-mode' to VALUE and put the new value into effect.
See `fringe-mode' for possible values and their effect."
+ (fringe--check-style value)
(setq fringe-mode value)
-
(when fringe-mode-explicit
(modify-all-frames-parameters
(list (cons 'left-fringe (if (consp fringe-mode)
@@ -116,6 +116,14 @@ See `fringe-mode' for possible values and their effect."
(cdr fringe-mode)
fringe-mode))))))
+(defun fringe--check-style (style)
+ (or (null style)
+ (integerp style)
+ (and (consp style)
+ (or (null (car style)) (integerp (car style)))
+ (or (null (cdr style)) (integerp (cdr style))))
+ (error "Invalid fringe style `%s'" style)))
+
;; For initialization of fringe-mode, take account of changes
;; made explicitly to default-frame-alist.
(defun fringe-mode-initialize (symbol value)
@@ -141,24 +149,40 @@ See `fringe-mode' for possible values and their effect."
("right-only" . (0 . nil))
("left-only" . (nil . 0))
("half-width" . (4 . 4))
- ("minimal" . (1 . 1))))
+ ("minimal" . (1 . 1)))
+ "Alist mapping fringe mode names to fringe widths.
+Each list element has the form (NAME . WIDTH), where NAME is a
+mnemonic fringe mode name (a symbol) and WIDTH is one of the
+following:
+- nil, which means the default width (8 pixels).
+- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
+ respectively the left and right fringe widths in pixels, or
+ nil (meaning to disable that fringe).
+- a single integer, which specifies the pixel widths of both
+ fringes.")
(defcustom fringe-mode nil
- "Specify appearance of fringes on all frames.
-This variable can be nil (the default) meaning the fringes should have
-the default width (8 pixels), it can be an integer value specifying
-the width of both left and right fringe (where 0 means no fringe), or
-a cons cell where car indicates width of left fringe and cdr indicates
-width of right fringe (where again 0 can be used to indicate no
-fringe).
-Note that the actual width may be rounded up to ensure that the sum of
-the width of the left and right fringes is a multiple of the frame's
-character width. However, a fringe width of 0 is never rounded.
-To set this variable in a Lisp program, use `set-fringe-mode' to make
-it take real effect.
-Setting the variable with a customization buffer also takes effect.
-If you only want to modify the appearance of the fringe in one frame,
-you can use the interactive function `set-fringe-style'."
+ "Default appearance of fringes on all frames.
+The Lisp value should be one of the following:
+- nil, which means the default width (8 pixels).
+- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
+ respectively the left and right fringe widths in pixels, or
+ nil (meaning to disable that fringe).
+- a single integer, which specifies the pixel widths of both
+ fringes.
+Note that the actual width may be rounded up to ensure that the
+sum of the width of the left and right fringes is a multiple of
+the frame's character width. However, a fringe width of 0 is
+never rounded.
+
+When setting this variable from Customize, the user can choose
+from the mnemonic fringe mode names defined in `fringe-styles'.
+
+When setting this variable in a Lisp program, call
+`set-fringe-mode' afterward to make it take real effect.
+
+To modify the appearance of the fringe in a specific frame, use
+the interactive function `set-fringe-style'."
:type `(choice
,@ (mapcar (lambda (style)
(let ((name
@@ -195,30 +219,31 @@ frame parameter is used."
": ")
fringe-styles nil t))
(style (assoc (downcase mode) fringe-styles)))
- (if style (cdr style)
- (if (eq 0 (cdr (assq 'left-fringe
- (if all-frames
- default-frame-alist
- (frame-parameters (selected-frame))))))
- nil
- 0))))
+ (cond
+ (style
+ (cdr style))
+ ((not (eq 0 (cdr (assq 'left-fringe
+ (if all-frames
+ default-frame-alist
+ (frame-parameters))))))
+ 0))))
(defun fringe-mode (&optional mode)
"Set the default appearance of fringes on all frames.
-
-When called interactively, query the user for MODE. Valid values
-for MODE include `none', `default', `left-only', `right-only',
-`minimal' and `half'.
-
-When used in a Lisp program, MODE can be a cons cell where the
-integer in car specifies the left fringe width and the integer in
-cdr specifies the right fringe width. MODE can also be a single
-integer that specifies both the left and the right fringe width.
-If a fringe width specification is nil, that means to use the
-default width (8 pixels). This command may round up the left and
-right width specifications to ensure that their sum is a multiple
-of the character width of a frame. It never rounds up a fringe
-width of 0.
+When called interactively, query the user for MODE; valid values
+are `no-fringes', `default', `left-only', `right-only', `minimal'
+and `half-width'. See `fringe-styles'.
+
+When used in a Lisp program, MODE should be one of these:
+- nil, which means the default width (8 pixels).
+- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
+ respectively the left and right fringe widths in pixels, or
+ nil (meaning to disable that fringe).
+- a single integer, which specifies the pixel widths of both
+ fringes.
+This command may round up the left and right width specifications
+to ensure that their sum is a multiple of the character width of
+a frame. It never rounds up a fringe width of 0.
Fringe widths set by `set-window-fringes' override the default
fringe widths set by this command. This command applies to all
@@ -230,26 +255,27 @@ frame only, see the command `set-fringe-style'."
(defun set-fringe-style (&optional mode)
"Set the default appearance of fringes on the selected frame.
-
-When called interactively, query the user for MODE. Valid values
-for MODE include `none', `default', `left-only', `right-only',
-`minimal' and `half'.
-
-When used in a Lisp program, MODE can be a cons cell where the
-integer in car specifies the left fringe width and the integer in
-cdr specifies the right fringe width. MODE can also be a single
-integer that specifies both the left and the right fringe width.
-If a fringe width specification is nil, that means to use the
-default width (8 pixels). This command may round up the left and
-right width specifications to ensure that their sum is a multiple
-of the character width of a frame. It never rounds up a fringe
-width of 0.
+When called interactively, query the user for MODE; valid values
+are `no-fringes', `default', `left-only', `right-only', `minimal'
+and `half-width'. See `fringe-styles'.
+
+When used in a Lisp program, MODE should be one of these:
+- nil, which means the default width (8 pixels).
+- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
+ respectively the left and right fringe widths in pixels, or
+ nil (meaning to disable that fringe).
+- a single integer, which specifies the pixel widths of both
+ fringes.
+This command may round up the left and right width specifications
+to ensure that their sum is a multiple of the character width of
+a frame. It never rounds up a fringe width of 0.
Fringe widths set by `set-window-fringes' override the default
fringe widths set by this command. If you want to set the
default appearance of fringes on all frames, see the command
`fringe-mode'."
(interactive (list (fringe-query-style)))
+ (fringe--check-style mode)
(modify-frame-parameters
(selected-frame)
(list (cons 'left-fringe (if (consp mode) (car mode) mode))
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index b0ef0439404..e2533c1f12b 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -1,6 +1,6 @@
;;; generic-x.el --- A collection of generic modes
-;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Tue Oct 08 1996
@@ -28,7 +28,7 @@
;;
;; INSTALLATION:
;;
-;; Add this line to your .emacs file:
+;; Add this line to your init file:
;;
;; (require 'generic-x)
;;
@@ -549,6 +549,9 @@ like an INI file. You can add this hook to `find-file-hook'."
(concat (w32-shell-name) " -c " (buffer-file-name)))))
(eval-when-compile (require 'comint))
+(declare-function comint-mode "comint" ())
+(declare-function comint-exec "comint" (buffer name command startfile switches))
+
(defun bat-generic-mode-run-as-comint ()
"Run the current BAT file in a comint buffer."
(interactive)
@@ -646,83 +649,10 @@ like an INI file. You can add this hook to `find-file-hook'."
"Generic mode for Sys V pkginfo files."))
;; Javascript mode
-;; Includes extra keywords from Armando Singer [asinger@MAIL.COLGATE.EDU]
+;; Obsolete; defer to js-mode from js.el.
(when (memq 'javascript-generic-mode generic-extras-enable-list)
-
-(define-generic-mode javascript-generic-mode
- '("//" ("/*" . "*/"))
- '("break"
- "case"
- "continue"
- "default"
- "delete"
- "do"
- "else"
- "export"
- "for"
- "function"
- "if"
- "import"
- "in"
- "new"
- "return"
- "switch"
- "this"
- "typeof"
- "var"
- "void"
- "while"
- "with"
- ;; words reserved for ECMA extensions below
- "catch"
- "class"
- "const"
- "debugger"
- "enum"
- "extends"
- "finally"
- "super"
- "throw"
- "try"
- ;; Java Keywords reserved by JavaScript
- "abstract"
- "boolean"
- "byte"
- "char"
- "double"
- "false"
- "final"
- "float"
- "goto"
- "implements"
- "instanceof"
- "int"
- "interface"
- "long"
- "native"
- "null"
- "package"
- "private"
- "protected"
- "public"
- "short"
- "static"
- "synchronized"
- "throws"
- "transient"
- "true")
- '(("^\\s-*function\\s-+\\([A-Za-z0-9_]+\\)"
- (1 font-lock-function-name-face))
- ("^\\s-*var\\s-+\\([A-Za-z0-9_]+\\)"
- (1 font-lock-variable-name-face)))
- '("\\.js\\'")
- (list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^function\\s-+\\([A-Za-z0-9_]+\\)" 1)
- ("*Variables*" "^var\\s-+\\([A-Za-z0-9_]+\\)" 1))))))
- "Generic mode for JavaScript files."))
+ (define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3")
+ (define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3"))
;; VRML files
(when (memq 'vrml-generic-mode generic-extras-enable-list)
@@ -1531,15 +1461,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 c26c0a0a5b1..d0dfd100f44 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,6 +1,1510 @@
+2012-11-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-get-reply-headers):
+ Make sure the reply goes to the author if it is a wide reply.
+
+2012-11-16 Jan Tatarik <jan.tatarik@gmail.com>
+
+ * gnus-score.el (gnus-score-body):
+ * gnus-logic.el (gnus-advanced-body): Don't score by headers when
+ scoring by body.
+
+2012-11-16 Glenn Morris <rgm@gnu.org>
+
+ * gnus-diary.el (nndiary-request-create-group-functions)
+ (nndiary-request-update-info-functions)
+ (gnus-subscribe-newsgroup-functions)
+ (nndiary-request-accept-article-functions):
+ Use new names for hooks rather than obsolete aliases.
+
+2012-11-08 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-browse-html-parts): Always replace charset
+ in meta tag with the one the part specifies in its header.
+
+2012-11-02 Stephen Eglen <S.J.Eglen@damtp.cam.ac.uk>
+
+ * gnus-dired.el (gnus-dired-attach): Attach to last used message buffer
+ by default.
+
+2012-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ New UIDL implementation.
+
+ * mail-source.el (mail-sources, mail-source-keyword-map):
+ Add :leave as a pop3 keyword.
+ (mail-source-fetch-pop): Bind pop3-leave-mail-on-server.
+
+ * pop3.el (pop3-leave-mail-on-server): Allow number.
+ (pop3-uidl-file, pop3-uidl-file-backup): New user options.
+ (pop3-movemail): Add UIDL support.
+ (pop3-send-streaming-command): Take a list of mail numbers instead of
+ the number of mails.
+ (pop3-write-to-file): Add X-UIDL header.
+ (pop3-uidl-stat, pop3-uidl-dele, pop3-uidl-load, pop3-uidl-save)
+ (pop3-uidl-add-xheader): New functions.
+
+ * message.el (message-ignored-resent-headers):
+ Add X-Content-Length and X-UIDL headers.
+
+2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * nndiary.el (nndiary-request-create-group-functions)
+ (nndiary-request-update-info-functions)
+ (nndiary-request-accept-article-functions):
+ * gnus-start.el (gnus-subscribe-newsgroup-functions): Don't use
+ "-hooks" suffix.
+
+2012-10-17 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny change)
+
+ * starttls.el (starttls-extra-arguments): Doc fix.
+
+2012-10-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-insert): \r is also not inserted, so don't try to delete
+ it.
+
+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.
+
+ * gnus-art.el (gnus-article-stop-animations): Use it.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix glitches caused by addition of psec to timers.
+ * gnus-art.el (gnus-article-stop-animations): Use timer--function
+ rather than raw access to timer vector.
+
+2012-09-11 Julien Danjou <julien@danjou.info>
+
+ * gnus-notifications.el (gnus-notifications): Check for nil values in
+ ignored addresses check.
+
+2012-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * qp.el (quoted-printable-decode-region): Inline+CSE+strength-reduction.
+
+2012-09-07 Chong Yidong <cyd@gnu.org>
+
+ * gnus-util.el
+ (gnus-put-text-property-excluding-characters-with-faces): Restore.
+
+ * gnus-salt.el (gnus-tree-highlight-node):
+ * gnus-sum.el (gnus-summary-highlight-line):
+ * gnus-group.el (gnus-group-highlight-line): Revert use of add-face.
+
+2012-09-06 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-util.el: Fix compilation error on XEmacs 21.4.
+
+2012-09-06 Juri Linkov <juri@jurta.org>
+
+ * gnus-group.el (gnus-read-ephemeral-gmane-group): Change the naming
+ scheme for buffer names to be more consistent with other group and
+ article buffer names in Gnus.
+
+2012-09-06 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-util.el
+ (gnus-put-text-property-excluding-characters-with-faces): Remove.
+
+ * gnus-compat.el: Define compat function `add-face' from Wolfgang
+ Jenkner.
+
+ * gnus-group.el (gnus-group-highlight-line): Use combining faces.
+
+ * gnus-sum.el (gnus-summary-highlight-line): Ditto.
+
+ * gnus-salt.el (gnus-tree-highlight-node): Ditto.
+
+2012-09-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-score.el (gnus-score-decode-text-parts): Use #' for
+ mm-text-parts used in labels macro to make it work with XEmacs 21.5.
+
+ * gnus-util.el (gnus-string-prefix-p): New function, an alias to
+ string-prefix-p in Emacs >=23.2.
+
+ * nnmaildir.el (nnmaildir--ensure-suffix, nnmaildir--add-flag)
+ (nnmaildir--remove-flag, nnmaildir--scan): Use gnus-string-match-p
+ instead of string-match-p.
+ (nnmaildir--scan): Use gnus-string-prefix-p instead of string-prefix-p.
+
+2012-09-06 Kenichi Handa <handa@gnu.org>
+
+ * qp.el (quoted-printable-decode-region): Fix previous change; handle
+ lowercase a..f.
+
+2012-09-05 Magnus Henoch <magnus.henoch@gmail.com>
+
+ * nnmaildir.el (nnmaildir--article-set-flags): Fix compilation error.
+
+2012-09-05 Martin Stjernholm <mast@lysator.liu.se>
+
+ * gnus-demon.el (gnus-demon-init): Fix regression when IDLE is t and
+ TIME is set.
+
+2012-09-05 Juri Linkov <juri@jurta.org>
+
+ * gnus-group.el (gnus-read-ephemeral-bug-group): Allow opening more
+ than one group at a time (bug#11961).
+
+2012-09-05 Julien Danjou <julien@danjou.info>
+
+ * gnus-srvr.el (gnus-server-open-server): Don't message on failure:
+ this hide the real reason with a message giving absolutely no hint.
+
+2012-09-05 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-mark-article-read): Propagate the read mark
+ to the backend (bug#11804).
+
+ * message.el (message-insert-newsgroups): Don't insert newsgroup
+ duplicates (bug#12275).
+
+2012-09-05 John Wiegley <johnw@newartisans.com>
+
+ * gnus.el (gnus-expand-group-parameters): Allow regexp substitutions in
+ sieve rules.
+
+2012-09-05 Jan Tatarik <jan.tatarik@gmail.com>
+
+ * gnus-score.el (gnus-score-decode-text-parts): Use #' for the local
+ function.
+
+ * gnus-logic.el (gnus-advanced-body): Allow scoring on decoded bodies.
+
+ * gnus-score.el (gnus-score-decode-text-parts): Ditto.
+
+2012-09-05 Magnus Henoch <magnus.henoch@gmail.com>
+
+ * nnmaildir.el: Make nnmaildir understand and write maildir flags.
+ That is, rename files from "unique:2," to "unique:2,S" for "seen", etc.
+ This should make nnmaildir more usable with offlineimap.
+
+2012-09-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-notifications.el (gnus-notifications-notify): Use it.
+
+ * gnus-fun.el (gnus-funcall-no-warning): New function to silence
+ warnings on XEmacs.
+
+2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better seeds for (random).
+ * gnus-sync.el (gnus-sync-lesync-setup):
+ * message.el (message-canlock-generate, message-unique-id):
+ Change (random t) to (random), now that the latter is more random.
+
+2012-08-31 Dave Abrahams <dave@boostpro.com>
+
+ * auth-source.el (auth-sources): Fix macos keychain access.
+
+ * gnus-int.el (gnus-request-head): When gnus-override-method is set,
+ allow the backend `request-head' function to determine the group
+ name on its own.
+ (gnus-request-expire-articles): Filter out negative article numbers
+ during expiry (Bug#11980).
+
+ * gnus-range.el (gnus-set-difference): Change gnus-set-difference from
+ O(N^2) to O(N). This makes warping into huge groups tolerable.
+
+ * gnus-registry.el (gnus-try-warping-via-registry): Don't act as though
+ you've found the article when you haven't.
+
+2012-08-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * gnus-notifications.el (gnus-notifications-action): Avoid CL-ism.
+
+2012-08-30 Julien Danjou <julien@danjou.info>
+
+ * gnus-notifications.el (gnus-notifications-notify): Use timeout from
+ `gnus-notifications-timeout'.
+ (gnus-notifications-timeout): Add.
+ (gnus-notifications-action): New function.
+ (gnus-notifications-notify): Add :action using
+ `gnus-notifications-action'.
+ (gnus-notifications-id-to-msg): New variable.
+ (gnus-notifications): Use `gnus-notifications-id-to-msg' to map
+ notifications id to messages.
+
+2012-08-30 Kenichi Handa <handa@gnu.org>
+
+ * qp.el (quoted-printable-decode-region): Decode multiple bytes at
+ once.
+
+2012-08-29 Julien Danjou <julien@danjou.info>
+
+ * gnus-notifications.el: New file.
+ (gnus-notifications-notify): New function.
+ (gnus-notifications): Use `gnus-notifications-notify'.
+
+2012-08-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-enter-digest-group): Decode content
+ transfer encoding first; bind gnus-newsgroup-charset to the charset
+ that the article specifies (Bug#12209).
+
+2012-08-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-cus.el (gnus-group-customize): Decode values posting-style holds.
+ (gnus-group-customize-done): Encode values posting-style holds.
+
+ * gnus-msg.el (gnus-summary-resend-message)
+ (gnus-configure-posting-styles): Decode values posting-style group
+ parameter holds.
+
+2012-08-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-summary-resend-message): Honor posting-style for
+ `name' and `address' in Resent-From header.
+
+2012-08-14 Chong Yidong <cyd@gnu.org>
+
+ * gnus-art.el (article-display-face): Handle failure in
+ gnus-create-image (Bug#11802).
+
+2012-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-groups):
+ Use defsetf.
+
+2012-08-10 Daiki Ueno <ueno@unixuser.org>
+
+ * auth-source.el: (auth-source-plstore-search)
+ (auth-source-secrets-search): Ignore :require and :type in search spec.
+
+2012-08-06 Julien Danjou <julien@danjou.info>
+
+ * gnus-demon.el (gnus-demon-add-handler, gnus-demon-remove-handler):
+ Remove autoload, already handled by gnus.el.
+
+2012-08-05 Julien Danjou <julien@danjou.info>
+
+ * gnus-demon.el (gnus-demon-add-handler, gnus-demon-remove-handler):
+ Add autoload.
+
+2012-07-31 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-valid-select-methods): Fix custom type.
+
+2012-07-29 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * auth-source.el (auth-sources, auth-source-backend-parse)
+ (auth-source-macos-keychain-search)
+ (auth-source-macos-keychain-search-items)
+ (auth-source-macos-keychain-result-append)
+ (auth-source-macos-keychain-create): Support Mac OS X Keychains in
+ auth-source.el through the /usr/bin/security utility.
+ (auth-sources): Fix syntax error.
+ (auth-source-macos-keychain-result-append): Fix variable name.
+ (auth-sources, auth-source-macos-keychain-result-append): More fixes.
+
+2012-07-27 Julien Danjou <julien@danjou.info>
+
+ * message.el (fboundp): Add a defalias on `mail-dont-reply-to' for
+ Emacs < 24.1
+
+2012-07-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-kill-address): Don't kill last newline.
+ (message-skip-to-next-address): Don't move to the next header.
+ (message-fill-field-address): Work properly.
+
+2012-07-25 Julien Danjou <julien@danjou.info>
+
+ * gnus-art.el (gnus-kill-sticky-article-buffers): Reintroduce.
+
+2012-07-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnimap.el (nnimap-get-responses): Don't remove, still used.
+
+2012-07-24 Julien Danjou <julien@danjou.info>
+
+ * mail-source.el (mail-source-movemail-and-remove): Remove, unused.
+
+ * nntp.el (nntp-send-nosy-authinfo, nntp-send-authinfo-from-file)
+ (nntp-async-timer-handler): Remove, unused.
+
+ * nnimap.el (nnimap-get-responses): Remove, unused.
+
+ * nnheader.el (mail-header-set-extra): Remove, unused.
+
+ * mm-view.el (mm-view-sound-file): Remove, unused.
+
+ * mm-url.el (mm-url-fetch-simple, mm-url-fetch-form)
+ (mm-url-encode-multipart-form-data): Remove, unused.
+
+ * message.el (message-remove-signature, message-make-host-name)
+ (message-fill-address): Remove, unused.
+
+ * gnus.el (gnus-writable-groups, gnus-group-guess-prefixed-name)
+ (gnus-group-guess-full-name, gnus-group-guess-prefixed-name): Remove,
+ unused.
+
+ * gnus-uu.el (gnus-uu-find-name-in-shar): Remove, unused.
+
+ * gnus-util.el (gnus-extract-address-component-name)
+ (gnus-extract-address-component-email, gnus-sortable-date)
+ (gnus-alist-to-hashtable, gnus-hashtable-to-alist)
+ (gnus-process-live-p): Remove, unused.
+
+ * gnus-topic.el (gnus-group-parent-topic): Remove, unused.
+
+ * gnus-sum.el (gnus-score-set-default, gnus-article-parent-p)
+ (gnus-article-read-p, gnus-uncompress-marks): Remove, unused.
+ (gnus-summary-set-current-mark): Remove obsolete, empty and unused
+ function.
+
+ * gnus-start.el (gnus-kill-newsgroup): Remove unused obsolete function.
+
+ * gnus-score.el (gnus-summary-score-crossposting)
+ (gnus-score-regexp-bad-p): Remove, unused.
+
+ * gnus-salt.el (gnus-tree-goto-article): Remove, unused.
+
+ * gnus-range.el (gnus-sublist-p): Remove, unused.
+
+ * gnus-msg.el (gnus-mail-parse-comma-list, gnus-put-message): Remove,
+ unused.
+
+ * gnus-kill.el (gnus-Newsgroup-kill-file): Remove, unused.
+
+ * gnus-int.el (gnus-list-active-group, gnus-request-group-articles)
+ (gnus-request-associate-buffer): Remove, unused.
+
+ * gnus-group.el (gnus-group-set-method-info)
+ (gnus-group-set-params-info): Remove, unused.
+
+ * gnus-fun.el (gnus-shell-command-to-string)
+ (gnus-shell-command-on-region): Remove, unused.
+
+ * gnus-cite.el (gnus-cited-line-p): Remove, unused.
+
+ * gnus-art.el (gnus-article-text-type-exists-p)
+ (article-translate-characters, gnus-article-hide-text-of-type)
+ (gnus-kill-sticky-article-buffers, gnus-article-maybe-highlight):
+ Remove, unused.
+
+2012-07-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnir.el ("nnir"): Revert last change, that's premature to merge from
+ Gnus master.
+
+2012-07-22 Andrew Cohen <cohen@bu.edu>
+
+ * nnir.el ("nnir"): Add 'virtual ability to nnir backend.
+
+2012-07-21 Julien Danjou <julien@danjou.info>
+
+ * message.el (message-dont-reply-to-names): Replace deprecated
+ `rmail-dont-reply-to-names' with `mail-dont-reply-to-names'.
+ (message-get-reply-headers): Ditto.
+
+2012-07-18 Julien Danjou <julien@danjou.info>
+
+ * sieve-mode.el (sieve-mode-map): Bind C-c C-c to
+ `sieve-upload-and-kill'.
+
+ * sieve.el (sieve-bury-buffer): Remove function.
+ (sieve-manage-mode-map): Map "q" to `kill-buffer'.
+ (sieve-upload-and-kill): New function, mapped to C-c C-c.
+
+2012-07-17 Andreas Schwab <schwab@linux-m68k.org>
+
+ * shr.el (shr-expand-url): Handle URL starting with `//'.
+
+2012-07-17 Toke Høiland-Jørgensen <toke@toke.dk> (tiny change)
+2012-07-13 Chong Yidong <cyd@gnu.org>
+
+ * smime.el (smime-certificate-info): Set buffer-read-only directly,
+ instead of calling toggle-read-only with a (bogus) argument.
+
+2012-07-09 Tassilo Horn <tassilo@member.fsf.org>
+
+ * gnus-sum.el (gnus-summary-limit-to-author): Use default value instead
+ of initial input when reading the author to restrict the summary to.
+
+2012-07-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-select-newsgroup): Don't assume that the group
+ buffer exists, which it doesn't if we haven't started Gnus.
+
+2012-07-09 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-shr):
+ Allow overriding charset by mm-charset-override-alist.
+
+2012-07-03 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-view-part):
+ Toggle subparts of multipart/alternative part.
+
+2012-07-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sync.el: Simply require json.
+
+ * registry.el: Simply require eieio and eieio-base.
+
+2012-06-29 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * tests/gnustest-nntp.el, tests/gnustest-registry.el, tests/: Remove.
+
+2012-06-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * shr.el (shr-render-buffer): New command.
+ (shr-visit-file): Use it.
+
+2012-06-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * tests/gnustest-nntp.el, tests/gnustest-registry.el:
+ Set no-byte-compile and no-update-autoloads.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el: Add coding cookie for a soft hyphen that mm-shr uses.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-read-summary-keys): Protect against the key
+ being bound to a lambda form.
+
+2012-06-26 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * gnus-picon.el (gnus-picon-properties): New defcustom.
+ (gnus-picon-create-glyph): Use it.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el: Add a iso-8859-1 cookie to make stuff work under other
+ locales.
+
+ * mm-decode.el (mm-display-part): Dissect archives when hitting `RET'
+ on a handle.
+
+ * gnus-sum.el (gnus-summary-limit-to-author): Use the current From
+ address as the default.
+
+ * nnfolder.el (nnfolder-save-buffer): Delete old versions silently.
+ It makes no sense to query the user about internal files.
+
+ * gnus-spec.el: Remove all the byte-compilation stuff, since
+ benchmarking shows that it doesn't help when entering large summary
+ buffers.
+
+ * gnus-util.el (gnus-byte-code): Remove.
+
+ * gnus-spec.el (gnus-update-format-specifications): Remove outdated
+ grouplens stuff.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-msg-mail): Warn the user about Gnus not running
+ (bug#11514).
+
+2012-06-26 Stephen Eglen <S.J.Eglen@damtp.cam.ac.uk>
+
+ * message.el (message-buffers): Return all buffers derived from Message
+ to make `gnus-dired-attach' work with mu4e.
+
+2012-06-26 Daiki Ueno <ueno@unixuser.org>
+
+ * mm-decode.el (mm-inhibit-auto-detect-attachment): New variable.
+ (mm-dissect-singlepart): Don't guess the MIME type of
+ application/octet-stream parts if mm-inhibit-auto-detect-attachment is
+ set.
+ (mm-dissect-multipart): Bind mm-inhibit-auto-detect-attachment if the
+ toplevel MIME type is multipart/encrypted.
+
+2012-06-26 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * gnus-agent.el (gnus-agent-save-active): Deal with the "groups" format.
+ In particular, add an optional argument and a docstring.
+
+ * gnus-start.el (gnus-groups-to-gnus-format): Use it.
+
+ * nntp.el (nntp-finish-retrieve-group-infos): Make `nntp-server-buffer'
+ current before calling `gnus-groups-to-gnus-format'.
+ Note that this was already the case for `gnus-active-to-gnus-format'.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * pop3.el (pop3-wait-for-messages): Fix retrieved data size calculation.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-dissect-buffer): Doc fix.
+
+ * gnus-sum.el (gnus-handle-ephemeral-exit):
+ Avoid creating the group buffer if it doesn't exist.
+
+ * gnus-group.el (gnus-group-read-ephemeral-group): If no quit-config
+ is given, mark the group as ephemeral with the current window conf.
+
+ * gnus-sum.el (gnus-set-global-variables): Don't assume that the group
+ buffer exists, which it doesn't if we haven't started Gnus.
+ (gnus-summary-exit): Allow quitting when we don't have a group buffer.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mml.el (mml-generate-mime):
+ Allow specifying what the top-level part type is.
+
+ * gnus-sum.el (gnus-auto-center-summary):
+ `scroll-margin' isn't defined on XEmacs.
+
+2012-06-26 Philipp Haselwarter <philipp.haselwarter@gmx.de> (tiny change)
+
+ * gnus-sum.el (gnus-auto-center-summary):
+ Set default to respect `scroll-margin'.
+
+2012-06-26 Elias Oltmanns <eo@nebensachen.de> (tiny change)
+
+ * gnus-cite.el (gnus-dissect-cited-text): A single line without
+ citation prefix within a block of cited text should be considered
+ part of that block *only* if it is a blank line.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * shr.el (shr-find-fill-point): Remove unused code; don't break a line
+ before kinsoku-bol characters nor within kinsoku-eol characters.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sync.el (gnus-topic-alist, gnus-group-topic)
+ (gnus-topic-create-topic, gnus-topic-enter-dribble):
+ Silence compiler.
+ (gnus-sync-read): Use mapc instead of mapcar.
+
+ * mm-archive.el: Require mm-decode for some macros.
+ (gnus-recursive-directory-files, mailcap-extension-to-mime):
+ Silence the byte compiler.
+ (mm-archive-decoders): New function that returns the value of
+ the mm-archive-decoders variable.
+
+ * mm-decode.el:
+ Don't require mm-archive; autoload mm-archive functions instead.
+ (mm-dissect-singlepart): Use the function mm-archive-decoders.
+
+ * nnmail.el (mail-send-and-exit): Silence the byte compiler.
+
+2012-06-26 Peter Munster <pmrb@free.fr>
+
+ * gnus-demon.el (gnus-demon-timers): Now a plist (function -> timer).
+ (gnus-demon-cancel): Ditto.
+ (gnus-demon-run-callback): When function cannot be called due to low
+ idleness, call it when idleness reaches the expected value, instead
+ of waiting another timer period.
+ (gnus-demon-init): Add `time' to arguments of call-back.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el: Register gnus-registry functions.
+
+ * gnus-registry.el (gnus-try-warping-via-registry):
+ Move here and indent.
+
+ * gnus-int.el (gnus-warp-to-article):
+ Check whether the registry is enabled before warping.
+
+2012-06-26 Dave Abrahams <dave@boostpro.com>
+
+ * gnus-sum.el (gnus-summary-insert-subject): Record information
+ in the registry about each article retrieved.
+
+ * gnus-int.el (gnus-select-group-with-message-id): New function.
+ (gnus-try-warping-via-registry): Ditto.
+ (gnus-warp-to-article): Fall back on the registry.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-fetch-partial-articles): Minor doc string fixup.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-summary-resend-message-insert-gcc): Assume that
+ gnus-gcc-self-resent-messages may be a group parameter.
+ (gnus-summary-resend-message):
+ Don't encode encoded words in header when Gcc'ing resent message.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-insert): Treat non-breaking space just like normal
+ space. This seems to produce more pleasing results.
+ (shr-insert):
+ Only insert a blank line if we're starting from an image.
+ (shr-tag-br):
+ Allow <br> to end lines or to make a single blank line.
+ (shr-ensure-paragraph): Consider lines with white space to be blank.
+
+2012-06-26 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * gnus-msg.el (gnus-inews-do-gcc): Add gnus-gcc-pre-body-encode-hook
+ and gnus-gcc-post-body-encode-hook.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-dissect-singlepart):
+ Guess what the type of application/octet-stream parts really is.
+
+ * gnus-sum.el (gnus-propagate-marks): Remove.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nntp.el (nntp-coding-system-for-read): Remove.
+ (nntp-coding-system-for-write): Ditto.
+ (nntp-open-connection): Just use `binary' directly.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * registry.el (registry-usage-test, registry-persistence-test):
+ Move to tests/gnustest-registry.el.
+ (registry-make-testable-db, registry-match-test)
+ (registry-instantiation-test): Move to tests/gnustest-registry.el.
+
+ * gnus-registry.el (gnus-registry-misc-test)
+ (gnus-registry-usage-test): Move to tests/gnustest-registry.el.
+
+ * tests/gnustest-registry.el:
+ New file with the registry and gnus-registry ERT tests.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-summary-resend-message):
+ Make gnus-summary-resend-message-insert-gcc be last item in
+ message-header-setup-hook.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnfolder.el (nnfolder-marks-directory, nnfolder-marks-is-evil)
+ (nnfolder-marks, nnfolder-marks-file-suffix)
+ (nnfolder-marks-modtime): Remove.
+ (nnfolder-open-server): Don't use marks.
+ (nnfolder-request-delete-group): Ditto.
+ (nnfolder-request-rename-group): Ditto.
+ (nnfolder-request-set-mark, nnfolder-request-marks)
+ (nnfolder-group-marks-pathname, nnfolder-marks-changed-p)
+ (nnfolder-save-marks, nnfolder-open-marks): Remove.
+
+ * nnml.el (nnml-marks-is-evil, nnml-marks-file-name, nnml-marks)
+ (nnml-marks-modtime): Remove.
+ (nnml-request-delete-group): Don't use marks.
+ (nnml-request-rename-group): Ditto.
+ (nnml-request-set-mark, nnml-request-marks, nnml-marks-changed-p)
+ (nnml-save-marks, nnml-open-marks): Remove.
+
+ * nntp.el (nntp-marks-is-evil, nntp-marks-file-name, nntp-marks)
+ (nntp-marks-modtime, nntp-marks-directory, nntp-request-set-mark)
+ (nntp-request-marks, nntp-marks-directory, nntp-marks-changed-p)
+ (nntp-save-marks, nntp-open-marks, nntp-possibly-create-directory)
+ (nntp-server-to-method-cache): Remove.
+
+ * shr.el (shr-rescale-image): Fix wrong merge.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-remove-trailing-whitespace):
+ Really delete the padding on too-wide lines.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-archive.el (mm-archive-dissect-and-inline): New function.
+ (mm-archive-dissect-and-inline): Fix up the undisplayer.
+
+ * mm-decode.el (mm-display-external): Output the text from
+ the command in the buffer after the command finished.
+ This makes text-based commands behave better.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (smtpmail-smtp-user): Silence compiler warning.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-multi-smtp-send-mail): Also allow specifying
+ the SMTP user name.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-article-map): Fix typo.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-multi-smtp-send-mail): New function.
+ (message-multi-smtp-send-mail): Respect the X-Message-SMTP-Method
+ header to implement multi-SMTP functionality.
+
+ * gnus-agent.el (gnus-agent-send-mail-function): Remove.
+ (gnus-agentize): Don't set it.
+ (gnus-agent-send-mail): Don't use it.
+
+ * gnus-sum.el (gnus-summary-widget-backward):
+ New function and keystroke.
+
+ * shr.el (shr-put-image): Remove underlines from sliced images.
+ (shr-zoom-image): Compute the region to be replaced more correctly.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-gcc-self-resent-messages): New user option.
+ (gnus-summary-resend-message-insert-gcc): New function.
+ (gnus-summary-resend-message): Modify message-header-setup-hook and
+ message-sent-hook to make it work for Gcc.
+ (gnus-inews-do-gcc): Update the number of unread articles of groups
+ that messages are Gcc'd to.
+
+ * message.el (message-resend): Run message-sent-hook to do Gcc.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-registry.el (gnus-registry-fixup-registry):
+ Move the message to a higher level to silence compilation.
+
+ * gnus-art.el (gnus-shr-put-image): Take and pass on a `flags'
+ parameter to allow controlling the scaling.
+
+ * shr.el (shr-zoom-image): New command and keystroke.
+ (shr-put-image): Take a `size' flag to say how to scale the image.
+
+ * mm-archive.el (mm-dissect-archive): Use it to get all file names.
+ Use recursive deletion.
+ (mm-dissect-archive): Add support for zip files.
+
+ * gnus-util.el (gnus-recursive-directory-files): New function.
+
+ * mm-archive.el (mm-archive-list-files): Inline text and image parts.
+ (mm-archive-decoders): Add tgz support.
+
+ * mm-decode.el (mm-shr): Make sure that the HTML ends with a newline.
+ Otherwise inserting text into the Gnus buffer can look odd.
+
+ * gnus-art.el (gnus-mime-inline-part): Slight clean-up.
+
+ * mm-archive.el (mm-archive-decoders): Add support for tar.
+
+ * gnus.el (gnus-logo-color-alist): Change the colours for Ma Gnus.
+
+ * nnmail.el (nnmail-extra-headers): Add Cc to the default.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-dissect-singlepart): Check that the decoder exists.
+
+ * mm-archive.el: New file.
+
+ * mm-decode.el (mm-dissect-singlepart):
+ Use it to decode ms-tnef files.
+
+ * mm-util.el (mm-find-buffer-file-coding-system): Comment fix.
+
+ * message.el (message-goto-*): Make all the `message-goto-*' commands
+ push the mark before moving point. This makes it easier to go back
+ to where you came from after editing whatever you jumped to.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el (gnus-sync-newsrc-groups): Quote normally.
+ (gnus-sync-lesync-pre-save-group-entry): Remove invalid invlists.
+ (gnus-sync-lesync-normalize-group-entry): Ignore a few more keys.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: Move BBDB autoloads.
+ (spam-exists-in-BBDB-p):
+ New function to do the BBDB search directly in BBDB 2 and 3.
+ (spam-check-BBDB): Use it.
+ (spam-enter-ham-BBDB): Use it.
+
+2012-06-26 Peter Munster <pmrb@free.fr> (tiny change)
+
+ * gnus-group.el (gnus-group-get-new-news):
+ New parameter `one-level' for scanning exactly one level.
+
+ * gnus-start.el (gnus-get-unread-articles): Ditto.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el: More commentary about setup.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el: More commentary about `gnus-sync-read' issues.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el: Improve docs about CouchDB admins.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el (gnus-sync-lesync-setup): Fix salt when user setup is
+ not needed. Provide xmlplistread list function to produce XML plist
+ output for non-Gnus LeSync clients.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el: Add LeSync synchronization backend and logic to read
+ and save against it. Group subscriptions, read marks, other marks,
+ subscription levels, topic names, and topic offsets (the group's
+ position within the topic) are saved. This is an experimental
+ backend and may change significantly. Load json.el from
+ the gnus-fallback-lib if it's not available otherwise.
+ (gnus-sync-save): Don't use `apply-partially' because of XEmacs.
+
+2012-06-26 David Engster <dengste@eml.cc>
+
+ * tests/gnustest-nntp.el: New file for simple NNTP testing.
+
+2012-06-18 Nelson Ferreira <nelson.ferreira@ieee.org> (tiny change)
+
+ * gnus-win.el (gnus-configure-frame): Pass an arg to window-dedicated-p.
+
+2012-06-17 Toke Høiland-Jørgensen <toke@toke.dk> (tiny change)
+
+ * nnmaildir.el (nnmaildir-request-expire-articles): Ensure that `time'
+ is an integer to avoid later problems.
+
+2012-06-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el: Add a iso-8859-1 cookie to make stuff work under other
+ locales.
+
+2012-04-14 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * gnus-agent.el (gnus-agent-retrieve-headers): Recalculate the range of
+ articles when fetch-old is non-nil (bug#11370).
+
+2012-06-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-get-new-news):
+ Respect `gnus-group-use-permanent-levels', as documented (bug#11638).
+
+2012-06-10 Dave Abrahams <dave@boostpro.com>
+
+ * gnus-int.el (gnus-warp-to-article): Limit registry warping to real
+ groups (bug#11641).
+
+2012-06-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-msg-mail): Warn the user about Gnus not running
+ (bug#11514).
+
+2012-06-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * nntp.el: Stop the `letf' madness.
+ (nntp--report-1): New var.
+ (nntp-report): Merge nntp-report-1 into it.
+ (nntp-with-open-group-function): Set nntp--report-1 instead of modifying
+ the nntp-report function.
+
+ * auth-source.el: Fix comment-style to follow the convention.
+
+2012-05-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-msg-mail): Ensure that gnus-newsgroup-name is
+ a string so that Gcc works (bug#11514).
+
+2012-05-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * legacy-gnus-agent.el (gnus-agent-unhook-expire-days):
+ * gnus-demon.el (gnus-demon-init): Don't bother with type-of.
+
+2012-05-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * gnus-win.el (gnus-configure-frame): Don't signal an error when
+ jumping to *Server* from a dedicated *Group* window.
+ (gnus-configure-frame): CSE.
+
+ * gnus-registry.el: Minor style cleanup.
+ (gnus-registry--set/remove-mark): New function, extracted from
+ gnus-registry-install-shortcuts.
+ (gnus-registry-install-shortcuts): Use it.
+
+2012-05-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnspool.el (news-path): Use eval-and-compile.
+
+2012-05-24 Glenn Morris <rgm@gnu.org>
+
+ * nnspool.el (news-directory, news-path, news-inews-program):
+ Move here from paths.el. Don't see a need for these to be autoloaded.
+
+ * gnus.el (gnus-default-nntp-server): Make it a defcustom.
+ Merge in doc from paths.el version. Don't see any need for this to be
+ autoloaded, or for the warning about users not setting it.
+
+2012-05-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor Y10k bug.
+ * nnweb.el (nnweb-google-parse-1): Don't assume years have 4 digits.
+
+2012-05-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * nnimap.el (nnimap-open-connection-1): Don't leave an "opening..."
+ message once it's actually open.
+
+2012-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * auth-source.el (auth-source--aput-1, auth-source--aput)
+ (auth-source--aget): New functions and macros.
+ Use them instead of aput/aget.
+
+2012-04-27 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gnus.el (debbugs-gnu): Don't override existing autoload definition.
+
+2012-04-26 Daiki Ueno <ueno@unixuser.org>
+
+ * plstore.el (plstore-called-interactively-p): New compat macro copied
+ from message.el.
+ (plstore-mode): Use it.
+
+2012-04-26 Daiki Ueno <ueno@unixuser.org>
+
+ * plstore.el: Revive the editing feature.
+ (plstore-mode): New mode to edit plstore file.
+ (plstore-mode-toggle-display, plstore-mode-original)
+ (plstore-mode-decoded): New command.
+ (plstore--encode, plstore--decode, plstore--write-contents-functions)
+ (plstore--insert-buffer, plstore--make): New function.
+ (plstore-open, plstore-save): Simplify by using them.
+
+2012-04-16 Glenn Morris <rgm@gnu.org>
+
+ * nndraft.el (nndraft-request-list): Fix declaration.
+
+2012-04-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-inews-insert-gcc): Don't do the alist stuff when we
+ don't have a current group.
+
+ * gnus-msg.el (gnus-inews-insert-gcc): Protect against when we don't
+ have a group name.
+
+ * gnus-art.el (article-wash-html): Ensure that we insert the HTML into
+ a multibyte buffer (bug#7410).
+ (article-wash-html): Parse the original article buffer to get the
+ unencoded data (bug#7410).
+
+ * gnus-start.el (gnus-read-newsrc-el-file): Protect against broken
+ .newsrc.el files.
+
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-summary-cancel-article): See what From header we
+ would have gotten if we posted to the group, and use that to compare
+ against the message we want to cancel (bug#10808).
+
+2012-03-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * auth-source.el (auth-source-netrc-create): Quote tokens that contain
+ "#" to avoid having them interpreted as comments.
+
+2012-03-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-insert): Update the text state properly to avoid
+ inserting spurious paragraph starts.
+
+2012-03-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-update-marks): Don't propagate marks unless
+ requested (bug#10961).
+
+ * shr.el (shr-table-widths): Divide the extra width more fairly over
+ the TDs (bug#10973).
+ (shr-render-td): Don't delete too much padding.
+ (shr-natural-width): Compute the natural width more correctly.
+ (shr-insert): Allow the natural width to be computed for tables again.
+ (shr-tag-table-1): Rework how the natural widths are computed by
+ rendering the table a third time.
+ (shr-natural-width): Remove.
+ (shr-buffer-width): New function.
+ (shr-expand-newlines): Use it.
+
+ * gnus-msg.el (gnus-bug): Don't delete the other windows. We may be
+ using a `gnus-use-full-window' setup (bug#11013).
+
+2012-03-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-int.el (gnus-backend-trace): Flip default to nil before Emacs
+ 24.1 release.
+
+2012-03-10 David Edmondson <dme@dme.org>
+
+ * mm-uu.el (mm-uu-forward-extract): Allow for blank lines between the
+ 'Forwarded Message' header and the start of the message.
+
+2012-03-04 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * gnus-msg.el (gnus-msg-mail): Call `message-mail' correctly when Gnus
+ isn't running (bug#10897).
+
+2012-02-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-column-specs): Protect against TDs with "width: 0%".
+
+2012-02-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nntp.el (nntp-send-authinfo): Work for secure nntp entry in authinfo.
+
+2012-02-20 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-shr): Remove "soft hyphens".
+
+ * nnimap.el (nnimap-request-list): Return the group names encoded as
+ utf8. Otherwise non-European group names don't work.
+ (nnimap-request-newgroups): Ditto.
+
+ * gnus-sum.el (gnus-summary-insert-old-articles): Fix the syntax for
+ the default in `read-string' (bug#10757).
+
+ * gnus-msg.el (gnus-group-post-news): Don't bug out on `C-u a' on
+ topics (bug#10843).
+
+ * nnimap.el (nnimap-log-command): Add the IMAP address to the log
+ buffer. Suggested by Herbert Valerio Riedel.
+ (nnimap-request-move-article): Delete the message from the correct IMAP
+ server.
+
+2012-02-19 Vida Gábor <vidagabor@gmail.com> (tiny change)
+
+ * gnus-demon.el (gnus-demon-init): Don't multiply time twice.
+ Reported by Peter Münster.
+
+2012-02-18 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-image-fetched): Make sure we really kill the right
+ buffer.
+
+2012-02-16 Leo Liu <sdl.web@gmail.com>
+
+ * gnus-start.el (gnus-1): Avoid duplicate entries.
+
+2012-02-15 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-remove-trailing-whitespace): Really delete the padding on
+ too-wide lines.
+
+2012-02-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ * shr.el (shr-rescale-image): Undo previous change; see
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00540.html>.
+
+2012-02-13 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-record-commands): New variable.
+ (nnimap-log-command): Use it.
+ (nnimap-make-process-buffer): Add a space to the process buffer.
+ (nnimap-transform-headers): Don't bug out on header lines containing
+ stuff that look like IMAP length encodings.
+
+ * shr.el (shr-rescale-image): Allow viewing large images.
+
+2012-02-12 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnml.el (nnml-request-compact-group): Delete the marks file after
+ compaction (bug#10800).
+
+ * gnus-art.el (gnus-stop-downloads): Stop `url-queue' downloads on
+ group exit.
+
+ * nnimap.el (nnimap-parse-flags): Parse correctly when we have mixed
+ QRESYNC/FETCH output.
+
+2012-02-11 Glenn Morris <rgm@gnu.org>
+
+ * sieve-manage.el (sieve-manage-default-stream):
+ * shr.el (shr):
+ * nnir.el (nnir-ignored-newsgroups, nnir-summary-line-format)
+ (nnir-retrieve-headers-override-function)
+ (nnir-imap-default-search-key, nnir-notmuch-program)
+ (nnir-notmuch-additional-switches, nnir-notmuch-remove-prefix)
+ (nnir-method-default-engines):
+ * message.el (message-cite-reply-position):
+ * gssapi.el (gssapi-program):
+ * gravatar.el (gravatar):
+ * gnus-sum.el (gnus-refer-thread-use-nnir):
+ * gnus-registry.el (gnus-registry-unfollowed-addresses)
+ (gnus-registry-max-pruned-entries):
+ * gnus-picon.el (gnus-picon-inhibit-top-level-domains):
+ * gnus-int.el (gnus-after-set-mark-hook)
+ (gnus-before-update-mark-hook):
+ * gnus-async.el (gnus-async-post-fetch-function):
+ * auth-source.el (auth-source-cache-expiry):
+ Add missing :version tags to new defcustoms and defgroups.
+
+2012-02-10 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-default-send-mail-function): Made into own
+ function for reuse by emacsbug.el.
+
+2012-02-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * gnus.el (gnus-method-ephemeral-p): Move after declaration of defsubst
+ `gnus-sloppily-equal-method-parameters' to avoid a warning.
+
+2012-02-09 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-msg-mail): Use `message-mail' if Gnus isn't
+ running.
+
+ * nnimap.el (nnimap-wait-for-response): Minor fixup of message string.
+
+ * gnus.el (gnus-server-extend-method): Don't add an -address component
+ if the method already has one (bug#9676).
+
+2012-02-08 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-insert-old-articles): Use a default instead
+ of an initial-input for consistency (bug#10757).
+
+ * shr.el: Inhibit getting and sending cookies when fetching pictures.
+
+ * gnus-html.el (gnus-html-schedule-image-fetching): Ditto.
+
+2012-02-07 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-remove-trailing-whitespace): Don't strip whitespace from
+ lines that are narrower than the window width. Otherwise background
+ "blocks" will look less readable.
+
+2012-02-07 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-show-thread): Revert last two changes.
+
+2012-02-07 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-transform-headers): Remove unused variable.
+ (nnimap-transform-headers): Fix parsing BODYSTRUCTURE elements that
+ have newlines within the strings, and where the UID comes after the
+ BODYSTRUCTURE element (bug#10537).
+
+ * shr-color.el (shr-color-set-minimum-interval): Rename to add prefix
+ (bug#10732).
+
+ * shr.el (shr-insert-document): Add doc string.
+ (shr-visit-file): Ditto.
+ (shr-remove-trailing-whitespace): New function.
+ (shr-insert-document): Use it to clean up trailing whitespace as the
+ final step (bug#10714).
+
+2012-02-06 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-exit-no-update): Really deaden the summary
+ buffer if `gnus-kill-summary-on-exit' is nil.
+
+2012-02-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-show-thread):
+ next-single-char-property-change may return nil in XEmacs.
+
+2012-02-06 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-handle-ephemeral-exit): Allow exiting from Gnus
+ when just reading a single group from "without" Gnus.
+
+2012-02-06 Chong Yidong <cyd@gnu.org>
+
+ * gnus-sum.el (gnus-summary-show-thread):
+ next-single-char-property-change never returns nil (Bug#8657).
+
+2012-02-05 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-open-server): Allow switching the nnoo server
+ without reconnecting.
+ (nnimap-possibly-change-group): Ditto.
+ (nnimap-finish-retrieve-group-infos): Don't reconnect if the server
+ connection has died before being called.
+
+2012-02-02 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-retrieve-group-data-early): Don't say we're doing
+ an initial sync unless we're really doing one.
+
+ * gnus-group.el (gnus-group-read-ephemeral-group): Don't add a new
+ address parameter if one already exists (bug#9676).
+
+ * gnus-msg.el (gnus-summary-mail-forward): Respect the process marks,
+ not the prefix, as documented (bug#10689).
+
+2012-02-01 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-valid-select-methods): nnmaildir also saves marks in
+ the "server".
+
+ * gnus-group.el (gnus-group-get-new-news-this-group): Don't overwrite
+ the real error message with the useless "previously known to be down".
+ Which isn't even correct.
+
+ * nntp.el (nntp-open-connection): Report the error message if the nntp
+ server can't be reached.
+
+ * nnimap.el (nnimap-retrieve-group-data-early): Keep track of how many
+ groups we do a total scan for.
+ (nnimap-wait-for-response): Say that we're doing a total scan, if we're
+ doing that.
+
+2012-01-31 Jim Meyering <jim@meyering.net>
+
+ * gnus-agent.el (gnus-agent-expire-unagentized-dirs):
+ Correct a comment (insert "not") and hide nominally-doubled "to".
+
+2012-01-30 Philipp Haselwarter <philipp.haselwarter@gmx.de> (tiny change)
+
+ * gnus-agent.el (gnus-agent-auto-agentize-methods): Point to the Agent
+ section in the manual.
+
+2012-01-30 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * rfc2047.el (rfc2047-encode-region): Allow not folding the encoded
+ words.
+ (rfc2047-encode-string): Ditto.
+ (rfc2047-encode-parameter): Don't fold parameters. Some MUAs do not
+ understand folded filename="..." parameters, for instance.
+
+ * nnimap.el (nnimap-wait-for-response): Include the imap server name in
+ the message for greater debuggability.
+
+2012-01-28 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-view.el (mm-display-inline-fontify): Bind `font-lock-support-mode'
+ instead of setting it locally, since the latter doesn't seem to have
+ any effect (most of the time).
+
+2012-01-27 Elias Pipping <pipping@lavabit.com> (tiny change)
+
+ * shr.el (shr-browse-url): Fix the name of the `browse-url-mail'
+ function call.
+
+2012-01-27 Vida Gábor <vidagabor@gmail.com> (tiny change)
+
+ * gnus-demon.el (gnus-demon-run-callback, gnus-demon-init): Convert to
+ seconds, and make the repeat clause with HH:MM specs work as
+ documented.
+
+2012-01-27 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-get-unread-articles): Clear out "early" methods
+ so that previous errors don't prohibit getting new news.
+
+ * nnimap.el (nnimap-retrieve-group-data-early): Ditto.
+
+ * nntp.el (nntp-retrieve-group-data-early): Ditto.
+
+2012-01-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-mode): Don't make bidi-paragraph-direction
+ bound globally in old Emacsen and XEmacsen.
+
+2012-01-26 Nick Alcock <nick.alcock@oracle.com> (tiny change)
+
+ * gnus.el (gnus-group-find-parameter): Check for liveness of the
+ buffer, not of the string which is its name.
+
+2012-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-move-article): Don't propagate marks to
+ non-server-marks groups.
+ (gnus-group-make-articles-read): Ditto.
+
+ * gnus-srvr.el (gnus-server-prepare): Use it to avoid showing ephemeral
+ methods (bug#9676).
+
+ * gnus.el (gnus-method-ephemeral-p): New function.
+
+2012-01-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-mode): Force paragraph direction to be
+ left-to-right.
+
+2012-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnir-search-thread): Autoload to avoid a compilation
+ warning.
+
+2012-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-line-format-alist): Don't try to
+ macroexpand the nnir things, since they haven't been defined yet, and
+ nnir requires gnus-sum.
+
+2012-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-interactively-view-part): Fix prompt.
+
+2012-01-10 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * nntp.el (nntp-send-authinfo): Query `auth-source-search' with the
+ logical server name in addition to the actual machine address.
+
+ * auth-source.el (auth-source-user-and-password): Add convenience
+ wrapper to search by just host and optionally user.
+
+2012-01-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-visit-file): Move point to the beginning of the buffer
+ after rendering.
+
+2012-01-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-read-group): Document more parameters
+ (bug#9693).
+ (gnus-summary-setup-buffer): Document return value (bug#9697).
+
+ * mm-decode.el (mm-interactively-view-part): Use `completing-read',
+ since ido doesn't work on symbols (bug#9632).
+
+ * gnus.el (gnus-group-fast-parameter): Use the same precedence rules
+ when getting a single value as when getting all the values. This means
+ that atoms like `gcc-self' work cumulatively, like variable settings,
+ instead of getting the value from the last matching clause.
+ (gnus-group-find-parameter): Protect against the group buffer not
+ existing (bug#9585).
+
+2012-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-activate-group): Document more parameters
+ (bug#9694).
+
+ * gnus-group.el (gnus-group-read-ephemeral-group): Doc clarification
+ (bug#9692).
+
+ * gnus-agent.el (gnus-agent-store-article): Tell the Agent when the
+ article was fetched, so that it can be expired later (bug#9958).
+ (gnus-agent-summary-fetch-series): Add doc string.
+ (gnus-agent-summary-fetch-group): Don't remove tick and dormant marks
+ (bug#9517).
+
+ * nntp.el (nntp-retrieve-groups): Refuse to do retrieval when an async
+ retrieval is happening.
+
+ * gnus.el (gnus-parameters): Doc fix.
+
+2012-01-06 Dave Abrahams <dave@boostpro.com>
+
+ * gnus-sum.el (gnus-summary-refer-thread): If the subtree is hidden,
+ show the thread after expansion.
+
+2012-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (article-narrow-to-head): If the head is completely
+ empty, narrow to the empty region (bug#9764).
+
+ * gnus-sum.el (gnus-summary-mark-article-as-unread): Mark articles as
+ read, and then mark them as unread only when the unread mark is used.
+ This makes `C-- T k' actually work, even though it's confusing.
+
+ * gnus-win.el (gnus-all-windows-visible-p): Ensure that the buffer is
+ alive before we try to find its window.
+
+2012-01-06 Brian Sniffen <bsniffen@akamai.com> (tiny change)
+
+ * mm-decode.el (mm-display-external): Use a longer timeout for the
+ deletion to allow slow programs to display the file.
+
+2012-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-browse-delete-temp-files): Fix up the
+ prompt to be less confusing.
+
+ * gnus-msg.el (gnus-summary-reply): Do not give a `switch-to-buffer'
+ argument to `message-reply'. This broke `special-display-*' frame
+ pop-uping (bug#10238).
+
+2012-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * starttls.el (starttls-available-p): Return nil on Windows/MS-DOS
+ systems, since these allegedly don't work there.
+
+2012-01-04 Chris Gray <chrismgray@gmail.com> (tiny change)
+
+ * mm-decode.el (mm-shr): Check that `gnus-summary-buffer' really is a
+ live buffer.
+
+2012-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnir.el (nnir-retrieve-headers): Protect against the article not
+ existing on the server (bug#10335).
+
+2012-01-04 Wolfgang Jenkner <wjenkner@inode.at> (tiny change)
+
+ * gnus-agent.el (gnus-agent-load-local):
+ Recompute gnus-agent-article-local on changing method.
+
+2012-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-parameters): Note precedence.
+
+2012-01-04 Leo Liu <sdl.web@gmail.com>
+
+ * nndraft.el (nndraft-update-unread-articles): Don't move point around
+ in the group buffer.
+
+2012-01-04 Julien Danjou <julien@danjou.info>
+
+ * nnimap.el (nnimap-update-info): Fix an error when all articles UIDs
+ change.
+
+2012-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-rescale-image): Add :ascent 100 to the rescaled picture,
+ too.
+
+ * nntp.el (nntp-retrieve-group-data-early): Use it.
+
+2012-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nntp.el (nntp-retrieval-in-progress): New variable.
+ (nntp-make-process-buffer): Make it buffer-local.
+
+ * gnus-demon.el (gnus-demon-time-to-step): Resurrect function lost in
+ 2010.
+ (gnus-demon-init): Use it to compute the time if time is on the form
+ "04:23".
+
+ * gnus-topic.el (gnus-topic-history): Define `gnus-topic-history'.
+
+ * nnimap.el (nnimap-finish-retrieve-group-infos): Check the connection
+ status in the correct buffer.
+
+2012-01-03 Leo Liu <sdl.web@gmail.com>
+
+ * gnus-topic.el (gnus-topic-goto-next-group): Don't move point around
+ when opening topics (bug#10407).
+
+2011-12-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-view.el (mm-display-inline-fontify): Add comment.
+
2011-12-15 Juri Linkov <juri@jurta.org>
- * mm-decode.el (mm-inline-media-tests): Add missing `mm-handle-media-subtype'.
+ * mm-decode.el (mm-inline-media-tests): Add missing
+ `mm-handle-media-subtype'.
2011-12-09 Tassilo Horn <tassilo@member.fsf.org>
@@ -167,7 +1671,7 @@
* nnir.el (gnus-registry-enabled): Defvar to keep the compiler happy.
* nnmairix.el (gnus-registry-enabled): Ditto.
-2011-10-17 Dave Abrahams <dave@boostpro.com> (tiny change)
+2011-10-17 Dave Abrahams <dave@boostpro.com>
* gnus-registry.el (gnus-registry-enabled): Add new variable (bug#9691).
(gnus-registry-install-shortcuts): Set `gnus-registry-install' to 'ask
@@ -242,8 +1746,8 @@
2011-09-27 Daiki Ueno <ueno@unixuser.org>
- * plstore.el (plstore-select-keys, plstore-encrypt-to): Clarify
- documentation.
+ * plstore.el (plstore-select-keys, plstore-encrypt-to):
+ Clarify documentation.
2011-09-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -421,7 +1925,7 @@
* gnus.el (gnus-variable-list): Don't save `gnus-format-specs' in the
newsrc file. It doesn't seem like an important optimization any more.
-2011-09-10 Dave Abrahams <dave@boostpro.com> (tiny change)
+2011-09-10 Dave Abrahams <dave@boostpro.com>
* nnimap.el (nnimap-transform-headers): Fix regexp to be less prone to
overflows.
@@ -698,7 +2202,7 @@
* spam.el (spam-fetch-field-fast): Rewrite slightly for clarity.
-2011-07-31 Dave Abrahams <dave@boostpro.com> (tiny change)
+2011-07-31 Dave Abrahams <dave@boostpro.com>
* gnus-sum.el (gnus-summary-refer-thread): Since lambdas aren't
closures, quote the form properly (bug#9194).
@@ -1004,8 +2508,6 @@
2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * dgnushack.el: Autoload sha1 on XEmacs.
-
* gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Take an optional
quit window configuration.
@@ -1155,7 +2657,7 @@
2011-06-21 Andrew Cohen <cohen@andy.bu.edu>
- * nnimap.el (nnimap-find-article-by-message-id): return nil when no
+ * nnimap.el (nnimap-find-article-by-message-id): Return nil when no
article found.
2011-06-18 Teodor Zlatanov <tzz@lifelogs.com>
@@ -1664,11 +3166,6 @@
(gnus-registry--split-fancy-with-parent-internal): Fix splitting bugs
and provide better messaging.
-2011-04-06 David Engster <dengste@eml.cc>
-
- * Makefile.in (fail-on-warning): New rule to compile with warnings as
- errors.
-
2011-04-06 Teodor Zlatanov <tzz@lifelogs.com>
* gnus-registry.el: Don't use ERT if it's not available. Load it
@@ -3675,7 +5172,7 @@
2010-11-29 Binjo <binjo.cn@gmail.com> (tiny change)
* nnimap.el (nnimap-open-connection-1): w32 open-network-stream doesn't
- seem to accept strings-with-numbers as port numbers,
+ seem to accept strings-with-numbers as port numbers.
2010-11-29 Andrew Cohen <cohen@andy.bu.edu>
@@ -3874,7 +5371,7 @@
2010-11-25 Julien Danjou <julien@danjou.info>
- * shr-color.el (shr-color->hexadecimal): Use color-rgb->hex
+ * shr-color.el (shr-color->hexadecimal): Use color-rgb->hex.
* color.el: Rename from color-lab.el
(color-rgb->hex): Add.
@@ -4708,7 +6205,7 @@
2010-10-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-request-head): New function.
- (nnimap-request-move-article): Try to be slighly faster by not
+ (nnimap-request-move-article): Try to be slightly faster by not
requesting the entire message when moving.
(nnimap-transform-headers): Don't bug out on bodiless articles.
(nnimap-send-command): Have no outstanding messages if the IMAP server
@@ -6925,7 +8422,7 @@
"failed" all the time.
* gnus.el: Throughout all files, replace (save-excursion (set-buffer
- ...)) with (with-current-buffer ... ).
+ ...)) with (with-current-buffer ...).
* nntp.el (nntp-open-server): Return whether the open was successful or
not.
@@ -11097,7 +12594,7 @@
* gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): Add "alpine".
(gnus-treat-body-boundary): Don't test window-system.
-2007-10-28 Leo <sdl.web@gmail.com> (tiny change)
+2007-10-28 Leo Liu <sdl.web@gmail.com> (tiny change)
* gnus-art.el (gnus-treat-emphasize): Don't test window-system.
@@ -19936,8 +21433,8 @@
2004-05-20 Danny Siu <dsiu@adobe.com>
- * gnus-sum.el (gnus-summary-recenter): Summery buffer was not auto
- centered even when gnus-auto-center-summary is t
+ * gnus-sum.el (gnus-summary-recenter): Summary buffer was not auto
+ centered even when gnus-auto-center-summary is t.
2004-05-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -21159,7 +22656,7 @@
* gnus.el (gnus-method-to-server): Move defsubst before first use.
- * gnus-diary.el (gnus-diary-header-schedule): caddr -> car (cddr
+ * gnus-diary.el (gnus-diary-header-schedule): caddr -> car (cddr.
* gnus-art.el (gnus-article-edit-mode): Define before first
reference.
@@ -21391,7 +22888,7 @@
* gnus-sum.el (gnus-select-newgroup): Replace inline code with
gnus-agent-possibly-alter-active.
- (gnus-adjust-marked-articles): Faster handling of simple lists
+ (gnus-adjust-marked-articles): Faster handling of simple lists.
2004-01-21 Jesper Harder <harder@ifa.au.dk>
@@ -22122,7 +23619,7 @@
See ChangeLog.2 for earlier changes.
- Copyright (C) 2004-2011 Free Software Foundation, Inc.
+ Copyright (C) 2004-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1
index a2d6d61efd4..f223bd77085 100644
--- a/lisp/gnus/ChangeLog.1
+++ b/lisp/gnus/ChangeLog.1
@@ -2966,7 +2966,7 @@
1997-11-25 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
- * gnus-move.el (gnus-move-group-to-server): Protect agains
+ * gnus-move.el (gnus-move-group-to-server): Protect against
nil-ness.
1997-11-25 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
@@ -3708,7 +3708,7 @@
* gnus.el: Quassia Gnus v0.1 is released.
- Copyright (C) 1997-2011 Free Software Foundation, Inc.
+ Copyright (C) 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2
index 64b15ce31b3..e75506956bb 100644
--- a/lisp/gnus/ChangeLog.2
+++ b/lisp/gnus/ChangeLog.2
@@ -970,9 +970,9 @@
* pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): New optional
parameter key, overrides the key id used to store passphrase
under (uses true key id from gpg output if nil).
- (pgg-gpg-encrypt-region): Search for passphrase using user suplied
+ (pgg-gpg-encrypt-region): Search for passphrase using user supplied
string STR, instead of (pgg-lookup-key STR t).
- (pgg-gpg-encrypt-region): Store passphrase under user suplied
+ (pgg-gpg-encrypt-region): Store passphrase under user supplied
string, instead of real key id taken from gpg output.
(pgg-gpg-decrypt-region): Likewise.
(pgg-gpg-sign-region): Likewise.
@@ -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'.
@@ -18553,7 +18553,7 @@
See ChangeLog.1 for earlier changes.
- Copyright (C) 2000-2002, 2004-2011 Free Software Foundation, Inc.
+ Copyright (C) 2000-2002, 2004-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index 4269b79a6a7..4c5e5ffadce 100644
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -1,6 +1,6 @@
;;; auth-source.el --- authentication sources for Gnus and Emacs
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news
@@ -42,7 +42,6 @@
(require 'password-cache)
(require 'mm-util)
(require 'gnus-util)
-(require 'assoc)
(eval-when-compile (require 'cl))
(require 'eieio)
@@ -84,6 +83,7 @@
"How many seconds passwords are cached, or nil to disable
expiring. Overrides `password-cache-expiry' through a
let-binding."
+ :version "24.1"
:group 'auth-source
:type '(choice (const :tag "Never" nil)
(const :tag "All Day" 86400)
@@ -91,9 +91,9 @@ let-binding."
(const :tag "30 Minutes" 1800)
(integer :tag "Seconds")))
-;;; The slots below correspond with the `auth-source-search' spec,
-;;; so a backend with :host set, for instance, would match only
-;;; searches for that host. Normally they are nil.
+;; The slots below correspond with the `auth-source-search' spec,
+;; so a backend with :host set, for instance, would match only
+;; searches for that host. Normally they are nil.
(defclass auth-source-backend ()
((type :initarg :type
:initform 'netrc
@@ -148,8 +148,8 @@ let-binding."
(repeat :tag "Names"
(string :tag "Name")))))
-;;; generate all the protocols in a format Customize can use
-;;; TODO: generate on the fly from auth-source-protocols
+;; Generate all the protocols in a format Customize can use.
+;; TODO: generate on the fly from auth-source-protocols
(defconst auth-source-protocols-customize
(mapcar (lambda (a)
(let ((p (car-safe a)))
@@ -254,6 +254,13 @@ can get pretty complex."
(const :tag "Default Secrets API Collection" 'default)
(const :tag "Login Secrets API Collection" "secrets:Login")
(const :tag "Temp Secrets API Collection" "secrets:session")
+
+ (const :tag "Default internet Mac OS Keychain"
+ macos-keychain-internet)
+
+ (const :tag "Default generic Mac OS Keychain"
+ macos-keychain-generic)
+
(list :tag "Source definition"
(const :format "" :value :source)
(choice :tag "Authentication backend choice"
@@ -266,7 +273,21 @@ can get pretty complex."
(const :tag "Default" 'default)
(const :tag "Login" "Login")
(const
- :tag "Temporary" "session"))))
+ :tag "Temporary" "session")))
+ (list
+ :tag "Mac OS internet Keychain"
+ (const :format ""
+ :value :macos-keychain-internet)
+ (choice :tag "Collection to use"
+ (string :tag "internet Keychain path")
+ (const :tag "default" 'default)))
+ (list
+ :tag "Mac OS generic Keychain"
+ (const :format ""
+ :value :macos-keychain-generic)
+ (choice :tag "Collection to use"
+ (string :tag "generic Keychain path")
+ (const :tag "default" 'default))))
(repeat :tag "Extra Parameters" :inline t
(choice :tag "Extra parameter"
(list
@@ -338,7 +359,7 @@ If the value is not a list, symmetric encryption will be used."
msg))
-;;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
+;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
(defun auth-source-read-char-choice (prompt choices)
"Read one of CHOICES by `read-char-choice', or `read-char'.
`dropdown-list' support is disabled because it doesn't work reliably.
@@ -377,6 +398,10 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
;; (auth-source-backend-parse "myfile.gpg")
;; (auth-source-backend-parse 'default)
;; (auth-source-backend-parse "secrets:Login")
+;; (auth-source-backend-parse 'macos-keychain-internet)
+;; (auth-source-backend-parse 'macos-keychain-generic)
+;; (auth-source-backend-parse "macos-keychain-internet:/path/here.keychain")
+;; (auth-source-backend-parse "macos-keychain-generic:/path/here.keychain")
(defun auth-source-backend-parse (entry)
"Creates an auth-source-backend from an ENTRY in `auth-sources'."
@@ -391,6 +416,28 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
;; matching any user, host, and protocol
((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
(auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
+
+ ;; take 'macos-keychain-internet and recurse to get it as a Mac OS
+ ;; Keychain collection matching any user, host, and protocol
+ ((eq entry 'macos-keychain-internet)
+ (auth-source-backend-parse '(:source (:macos-keychain-internet default))))
+ ;; take 'macos-keychain-generic and recurse to get it as a Mac OS
+ ;; Keychain collection matching any user, host, and protocol
+ ((eq entry 'macos-keychain-generic)
+ (auth-source-backend-parse '(:source (:macos-keychain-generic default))))
+ ;; take macos-keychain-internet:XYZ and recurse to get it as MacOS
+ ;; Keychain "XYZ" matching any user, host, and protocol
+ ((and (stringp entry) (string-match "^macos-keychain-internet:\\(.+\\)"
+ entry))
+ (auth-source-backend-parse `(:source (:macos-keychain-internet
+ ,(match-string 1 entry)))))
+ ;; take macos-keychain-generic:XYZ and recurse to get it as MacOS
+ ;; Keychain "XYZ" matching any user, host, and protocol
+ ((and (stringp entry) (string-match "^macos-keychain-generic:\\(.+\\)"
+ entry))
+ (auth-source-backend-parse `(:source (:macos-keychain-generic
+ ,(match-string 1 entry)))))
+
;; take just a file name and recurse to get it as a netrc file
;; matching any user, host, and protocol
((stringp entry)
@@ -413,6 +460,33 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
:search-function 'auth-source-netrc-search
:create-function 'auth-source-netrc-create)))
+ ;; the MacOS Keychain
+ ((and
+ (not (null (plist-get entry :source))) ; the source must not be nil
+ (listp (plist-get entry :source)) ; and it must be a list
+ (or
+ (plist-get (plist-get entry :source) :macos-keychain-generic)
+ (plist-get (plist-get entry :source) :macos-keychain-internet)))
+
+ (let* ((source-spec (plist-get entry :source))
+ (keychain-generic (plist-get source-spec :macos-keychain-generic))
+ (keychain-type (if keychain-generic
+ 'macos-keychain-generic
+ 'macos-keychain-internet))
+ (source (plist-get source-spec (if keychain-generic
+ :macos-keychain-generic
+ :macos-keychain-internet))))
+
+ (when (symbolp source)
+ (setq source (symbol-name source)))
+
+ (auth-source-backend
+ (format "Mac OS Keychain (%s)" source)
+ :source source
+ :type keychain-type
+ :search-function 'auth-source-macos-keychain-search
+ :create-function 'auth-source-macos-keychain-create)))
+
;; the Secrets API. We require the package, in order to have a
;; defined value for `secrets-enabled'.
((and
@@ -694,6 +768,7 @@ must call it to obtain the actual value."
(let* ((bmatches (apply
(slot-value backend 'search-function)
:backend backend
+ :type (slot-value backend :type)
;; note we're overriding whatever the spec
;; has for :require, :create, and :delete
:require require
@@ -710,10 +785,10 @@ must call it to obtain the actual value."
(setq matches (append matches bmatches))))))
matches))
-;;; (auth-source-search :max 1)
-;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
-;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
-;;; (auth-source-search :host "nonesuch" :type 'secrets)
+;; (auth-source-search :max 1)
+;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
+;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
+;; (auth-source-search :host "nonesuch" :type 'secrets)
(defun* auth-source-delete (&rest spec
&key delete
@@ -775,16 +850,16 @@ This is the same SPEC you passed to `auth-source-search'.
Returns t or nil for forgotten or not found."
(password-cache-remove (auth-source-format-cache-entry spec)))
-;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
+;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
-;;; (auth-source-remember '(:host "wedd") '(4 5 6))
-;;; (auth-source-remembered-p '(:host "wedd"))
-;;; (auth-source-remember '(:host "xedd") '(1 2 3))
-;;; (auth-source-remembered-p '(:host "xedd"))
-;;; (auth-source-remembered-p '(:host "zedd"))
-;;; (auth-source-recall '(:host "xedd"))
-;;; (auth-source-recall '(:host t))
-;;; (auth-source-forget+ :host t)
+;; (auth-source-remember '(:host "wedd") '(4 5 6))
+;; (auth-source-remembered-p '(:host "wedd"))
+;; (auth-source-remember '(:host "xedd") '(1 2 3))
+;; (auth-source-remembered-p '(:host "xedd"))
+;; (auth-source-remembered-p '(:host "zedd"))
+;; (auth-source-recall '(:host "xedd"))
+;; (auth-source-recall '(:host t))
+;; (auth-source-forget+ :host t)
(defun* auth-source-forget+ (&rest spec &allow-other-keys)
"Forget any cached data matching SPEC. Returns forgotten count.
@@ -818,8 +893,8 @@ while \(:host t) would find all host entries."
(return 'no)))
'no))))
-;;; (auth-source-pick-first-password :host "z.lifelogs.com")
-;;; (auth-source-pick-first-password :port "imap")
+;; (auth-source-pick-first-password :host "z.lifelogs.com")
+;; (auth-source-pick-first-password :port "imap")
(defun auth-source-pick-first-password (&rest spec)
"Pick the first secret found from applying SPEC to `auth-source-search'."
(let* ((result (nth 0 (apply 'auth-source-search (plist-put spec :max 1))))
@@ -852,7 +927,22 @@ while \(:host t) would find all host entries."
;;; Backend specific parsing: netrc/authinfo backend
-;;; (auth-source-netrc-parse "~/.authinfo.gpg")
+(defun auth-source--aput-1 (alist key val)
+ (let ((seen ())
+ (rest alist))
+ (while (and (consp rest) (not (equal key (caar rest))))
+ (push (pop rest) seen))
+ (cons (cons key val)
+ (if (null rest) alist
+ (nconc (nreverse seen)
+ (if (equal key (caar rest)) (cdr rest) rest))))))
+(defmacro auth-source--aput (var key val)
+ `(setq ,var (auth-source--aput-1 ,var ,key ,val)))
+
+(defun auth-source--aget (alist key)
+ (cdr (assoc key alist)))
+
+;; (auth-source-netrc-parse "~/.authinfo.gpg")
(defun* auth-source-netrc-parse (&rest
spec
&key file max host user port delete require
@@ -887,10 +977,11 @@ Note that the MAX parameter is used so we can exit the parse early."
;; cache all netrc files (used to be just .gpg files)
;; Store the contents of the file heavily encrypted in memory.
;; (note for the irony-impaired: they are just obfuscated)
- (aput 'auth-source-netrc-cache file
- (list :mtime (nth 5 (file-attributes file))
- :secret (lexical-let ((v (mapcar '1+ (buffer-string))))
- (lambda () (apply 'string (mapcar '1- v)))))))
+ (auth-source--aput
+ auth-source-netrc-cache file
+ (list :mtime (nth 5 (file-attributes file))
+ :secret (lexical-let ((v (mapcar '1+ (buffer-string))))
+ (lambda () (apply 'string (mapcar '1- v)))))))
(goto-char (point-min))
;; Go through the file, line by line.
(while (and (not (eobp))
@@ -936,21 +1027,21 @@ Note that the MAX parameter is used so we can exit the parse early."
(auth-source-search-collection
host
(or
- (aget alist "machine")
- (aget alist "host")
+ (auth-source--aget alist "machine")
+ (auth-source--aget alist "host")
t))
(auth-source-search-collection
user
(or
- (aget alist "login")
- (aget alist "account")
- (aget alist "user")
+ (auth-source--aget alist "login")
+ (auth-source--aget alist "account")
+ (auth-source--aget alist "user")
t))
(auth-source-search-collection
port
(or
- (aget alist "port")
- (aget alist "protocol")
+ (auth-source--aget alist "port")
+ (auth-source--aget alist "protocol")
t))
(or
;; the required list of keys is nil, or
@@ -1085,8 +1176,8 @@ FILE is the file from which we obtained this token."
ret))
alist))
-;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
-;;; (funcall secret)
+;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
+;; (funcall secret)
(defun* auth-source-netrc-search (&rest
spec
@@ -1132,8 +1223,8 @@ See `auth-source-search' for details on SPEC."
(nth 0 v)
v))
-;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
-;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
+;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
+;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
(defun* auth-source-netrc-create (&rest spec
&key backend
@@ -1165,7 +1256,7 @@ See `auth-source-search' for details on SPEC."
;; just the value otherwise
(t (symbol-value br)))))
(when br-choice
- (aput 'valist br br-choice)))))
+ (auth-source--aput valist br br-choice)))))
;; for extra required elements, see if the spec includes a value for them
(dolist (er create-extra)
@@ -1174,17 +1265,18 @@ See `auth-source-search' for details on SPEC."
collect (nth i spec))))
(dolist (k keys)
(when (equal (symbol-name k) name)
- (aput 'valist er (plist-get spec k))))))
+ (auth-source--aput valist er (plist-get spec k))))))
;; for each required element
(dolist (r required)
- (let* ((data (aget valist r))
+ (let* ((data (auth-source--aget valist r))
;; take the first element if the data is a list
(data (or (auth-source-netrc-element-or-first data)
(plist-get current-data
(intern (format ":%s" r) obarray))))
;; this is the default to be offered
- (given-default (aget auth-source-creation-defaults r))
+ (given-default (auth-source--aget
+ auth-source-creation-defaults r))
;; the default supplementals are simple:
;; for the user, try `given-default' and then (user-login-name);
;; otherwise take `given-default'
@@ -1196,22 +1288,22 @@ See `auth-source-search' for details on SPEC."
(cons 'user
(or
(auth-source-netrc-element-or-first
- (aget valist 'user))
+ (auth-source--aget valist 'user))
(plist-get artificial :user)
"[any user]"))
(cons 'host
(or
(auth-source-netrc-element-or-first
- (aget valist 'host))
+ (auth-source--aget valist 'host))
(plist-get artificial :host)
"[any host]"))
(cons 'port
(or
(auth-source-netrc-element-or-first
- (aget valist 'port))
+ (auth-source--aget valist 'port))
(plist-get artificial :port)
"[any port]"))))
- (prompt (or (aget auth-source-creation-prompts r)
+ (prompt (or (auth-source--aget auth-source-creation-prompts r)
(case r
(secret "%p password for %u@%h: ")
(user "%p user name for %h: ")
@@ -1220,9 +1312,9 @@ See `auth-source-search' for details on SPEC."
(format "Enter %s (%%u@%%h:%%p): " r)))
(prompt (auth-source-format-prompt
prompt
- `((?u ,(aget printable-defaults 'user))
- (?h ,(aget printable-defaults 'host))
- (?p ,(aget printable-defaults 'port))))))
+ `((?u ,(auth-source--aget printable-defaults 'user))
+ (?h ,(auth-source--aget printable-defaults 'host))
+ (?p ,(auth-source--aget printable-defaults 'port))))))
;; Store the data, prompting for the password if needed.
(setq data (or data
@@ -1292,7 +1384,7 @@ See `auth-source-search' for details on SPEC."
(secret "password")
(port "port") ; redundant but clearer
(t (symbol-name r)))
- (if (string-match "[\" ]" data)
+ (if (string-match "[\"# ]" data)
(format "%S" data)
data)))))
(setq add (concat add (funcall printer)))))))
@@ -1383,16 +1475,16 @@ Respects `auth-source-save-behavior'. Uses
file)
(message "Saved new authentication information to %s" file)
nil))))
- (aput 'auth-source-netrc-cache key "ran"))))
+ (auth-source--aput auth-source-netrc-cache key "ran"))))
;;; Backend specific parsing: Secrets API backend
-;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
-;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
-;;; (let ((auth-sources '(default))) (auth-source-search :max 1))
-;;; (let ((auth-sources '(default))) (auth-source-search))
-;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1))
-;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
+;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
+;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
+;; (let ((auth-sources '(default))) (auth-source-search :max 1))
+;; (let ((auth-sources '(default))) (auth-source-search))
+;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1))
+;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
(defun* auth-source-secrets-search (&rest
spec
@@ -1440,7 +1532,7 @@ authentication tokens:
(let* ((coll (oref backend source))
(max (or max 5000)) ; sanity check: default to stop at 5K
- (ignored-keys '(:create :delete :max :backend :label))
+ (ignored-keys '(:create :delete :max :backend :label :require :type))
(search-keys (loop for i below (length spec) by 2
unless (memq (nth i spec) ignored-keys)
collect (nth i spec)))
@@ -1498,6 +1590,193 @@ authentication tokens:
;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
(debug spec))
+;;; Backend specific parsing: Mac OS Keychain (using /usr/bin/security) backend
+
+;; (let ((auth-sources '(macos-keychain-internet))) (auth-source-search :max 1 :create t))
+;; (let ((auth-sources '(macos-keychain-internet))) (auth-source-search :max 1 :delete t))
+;; (let ((auth-sources '(macos-keychain-internet))) (auth-source-search :max 1))
+;; (let ((auth-sources '(macos-keychain-internet))) (auth-source-search))
+
+;; (let ((auth-sources '(macos-keychain-generic))) (auth-source-search :max 1 :create t))
+;; (let ((auth-sources '(macos-keychain-generic))) (auth-source-search :max 1 :delete t))
+;; (let ((auth-sources '(macos-keychain-generic))) (auth-source-search :max 1))
+;; (let ((auth-sources '(macos-keychain-generic))) (auth-source-search))
+
+;; (let ((auth-sources '("macos-keychain-internet:/Users/tzz/Library/Keychains/login.keychain"))) (auth-source-search :max 1))
+;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1 :host "git.gnus.org"))
+
+(defun* auth-source-macos-keychain-search (&rest
+ spec
+ &key backend create delete label
+ type max host user port
+ &allow-other-keys)
+ "Search the MacOS Keychain; spec is like `auth-source'.
+
+All search keys must match exactly. If you need substring
+matching, do a wider search and narrow it down yourself.
+
+You'll get back all the properties of the token as a plist.
+
+The :type key is either 'macos-keychain-internet or
+'macos-keychain-generic.
+
+For the internet keychain type, the :label key searches the
+item's labels (\"-l LABEL\" passed to \"/usr/bin/security\").
+Similarly, :host maps to \"-s HOST\", :user maps to \"-a USER\",
+and :port maps to \"-P PORT\" or \"-r PROT\"
+(note PROT has to be a 4-character string).
+
+For the generic keychain type, the :label key searches the item's
+labels (\"-l LABEL\" passed to \"/usr/bin/security\").
+Similarly, :host maps to \"-c HOST\" (the \"creator\" keychain
+field), :user maps to \"-a USER\", and :port maps to \"-s PORT\".
+
+Here's an example that looks for the first item in the default
+generic MacOS Keychain:
+
+ \(let ((auth-sources '(macos-keychain-generic)))
+ (auth-source-search :max 1)
+
+Here's another that looks for the first item in the internet
+MacOS Keychain collection whose label is 'gnus':
+
+ \(let ((auth-sources '(macos-keychain-internet)))
+ (auth-source-search :max 1 :label \"gnus\")
+
+And this one looks for the first item in the internet keychain
+entries for git.gnus.org:
+
+ \(let ((auth-sources '(macos-keychain-internet\")))
+ (auth-source-search :max 1 :host \"git.gnus.org\"))
+"
+ ;; TODO
+ (assert (not create) nil
+ "The MacOS Keychain auth-source backend doesn't support creation yet")
+ ;; TODO
+ ;; (macos-keychain-delete-item coll elt)
+ (assert (not delete) nil
+ "The MacOS Keychain auth-source backend doesn't support deletion yet")
+
+ (let* ((coll (oref backend source))
+ (max (or max 5000)) ; sanity check: default to stop at 5K
+ (ignored-keys '(:create :delete :max :backend :label))
+ (search-keys (loop for i below (length spec) by 2
+ unless (memq (nth i spec) ignored-keys)
+ collect (nth i spec)))
+ ;; build a search spec without the ignored keys
+ ;; if a search key is nil or t (match anything), we skip it
+ (search-spec (apply 'append (mapcar
+ (lambda (k)
+ (if (or (null (plist-get spec k))
+ (eq t (plist-get spec k)))
+ nil
+ (list k (plist-get spec k))))
+ search-keys)))
+ ;; needed keys (always including host, login, port, and secret)
+ (returned-keys (mm-delete-duplicates (append
+ '(:host :login :port :secret)
+ search-keys)))
+ (items (apply 'auth-source-macos-keychain-search-items
+ coll
+ type
+ max
+ search-spec))
+
+ ;; ensure each item has each key in `returned-keys'
+ (items (mapcar (lambda (plist)
+ (append
+ (apply 'append
+ (mapcar (lambda (req)
+ (if (plist-get plist req)
+ nil
+ (list req nil)))
+ returned-keys))
+ plist))
+ items)))
+ items))
+
+(defun* auth-source-macos-keychain-search-items (coll type max
+ &rest spec
+ &key label type
+ host user port
+ &allow-other-keys)
+
+ (let* ((keychain-generic (eq type 'macos-keychain-generic))
+ (args `(,(if keychain-generic
+ "find-generic-password"
+ "find-internet-password")
+ "-g"))
+ (ret (list :type type)))
+ (when label
+ (setq args (append args (list "-l" label))))
+ (when host
+ (setq args (append args (list (if keychain-generic "-c" "-s") host))))
+ (when user
+ (setq args (append args (list "-a" user))))
+
+ (when port
+ (if keychain-generic
+ (setq args (append args (list "-s" port)))
+ (setq args (append args (list
+ (if (string-match "[0-9]+" port) "-P" "-r")
+ port)))))
+
+ (unless (equal coll "default")
+ (setq args (append args (list coll))))
+
+ (with-temp-buffer
+ (apply 'call-process "/usr/bin/security" nil t nil args)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (cond
+ ((looking-at "^password: \"\\(.+\\)\"$")
+ (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ "secret"
+ (lexical-let ((v (match-string 1)))
+ (lambda () v))))
+ ;; TODO: check if this is really the label
+ ;; match 0x00000007 <blob>="AppleID"
+ ((looking-at "^[ ]+0x00000007 <blob>=\"\\(.+\\)\"")
+ (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ "label"
+ (match-string 1)))
+ ;; match "crtr"<uint32>="aapl"
+ ;; match "svce"<blob>="AppleID"
+ ((looking-at "^[ ]+\"\\([a-z]+\\)\"[^=]+=\"\\(.+\\)\"")
+ (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ (match-string 1)
+ (match-string 2))))
+ (forward-line)))
+ ;; return `ret' iff it has the :secret key
+ (and (plist-get ret :secret) (list ret))))
+
+(defun auth-source-macos-keychain-result-append (result generic k v)
+ (push v result)
+ (setq k (cond
+ ((equal k "acct") "user")
+ ;; for generic keychains, creator is host, service is port
+ ((and generic (equal k "crtr")) "host")
+ ((and generic (equal k "svce")) "port")
+ ;; for internet keychains, protocol is port, server is host
+ ((and (not generic) (equal k "ptcl")) "port")
+ ((and (not generic) (equal k "srvr")) "host")
+ (t k)))
+
+ (push (intern (format ":%s" k)) result))
+
+(defun* auth-source-macos-keychain-create (&rest
+ spec
+ &key backend type max host user port
+ &allow-other-keys)
+ ;; TODO
+ (debug spec))
+
;;; Backend specific parsing: PLSTORE backend
(defun* auth-source-plstore-search (&rest
@@ -1508,7 +1787,7 @@ authentication tokens:
"Search the PLSTORE; spec is like `auth-source'."
(let* ((store (oref backend data))
(max (or max 5000)) ; sanity check: default to stop at 5K
- (ignored-keys '(:create :delete :max :backend :require))
+ (ignored-keys '(:create :delete :max :backend :label :require :type))
(search-keys (loop for i below (length spec) by 2
unless (memq (nth i spec) ignored-keys)
collect (nth i spec)))
@@ -1608,7 +1887,7 @@ authentication tokens:
;; just the value otherwise
(t (symbol-value br)))))
(when br-choice
- (aput 'valist br br-choice)))))
+ (auth-source--aput valist br br-choice)))))
;; for extra required elements, see if the spec includes a value for them
(dolist (er create-extra)
@@ -1617,17 +1896,18 @@ authentication tokens:
collect (nth i spec))))
(dolist (k keys)
(when (equal (symbol-name k) name)
- (aput 'valist er (plist-get spec k))))))
+ (auth-source--aput valist er (plist-get spec k))))))
;; for each required element
(dolist (r required)
- (let* ((data (aget valist r))
+ (let* ((data (auth-source--aget valist r))
;; take the first element if the data is a list
(data (or (auth-source-netrc-element-or-first data)
(plist-get current-data
(intern (format ":%s" r) obarray))))
;; this is the default to be offered
- (given-default (aget auth-source-creation-defaults r))
+ (given-default (auth-source--aget
+ auth-source-creation-defaults r))
;; the default supplementals are simple:
;; for the user, try `given-default' and then (user-login-name);
;; otherwise take `given-default'
@@ -1639,22 +1919,22 @@ authentication tokens:
(cons 'user
(or
(auth-source-netrc-element-or-first
- (aget valist 'user))
+ (auth-source--aget valist 'user))
(plist-get artificial :user)
"[any user]"))
(cons 'host
(or
(auth-source-netrc-element-or-first
- (aget valist 'host))
+ (auth-source--aget valist 'host))
(plist-get artificial :host)
"[any host]"))
(cons 'port
(or
(auth-source-netrc-element-or-first
- (aget valist 'port))
+ (auth-source--aget valist 'port))
(plist-get artificial :port)
"[any port]"))))
- (prompt (or (aget auth-source-creation-prompts r)
+ (prompt (or (auth-source--aget auth-source-creation-prompts r)
(case r
(secret "%p password for %u@%h: ")
(user "%p user name for %h: ")
@@ -1663,20 +1943,21 @@ authentication tokens:
(format "Enter %s (%%u@%%h:%%p): " r)))
(prompt (auth-source-format-prompt
prompt
- `((?u ,(aget printable-defaults 'user))
- (?h ,(aget printable-defaults 'host))
- (?p ,(aget printable-defaults 'port))))))
+ `((?u ,(auth-source--aget printable-defaults 'user))
+ (?h ,(auth-source--aget printable-defaults 'host))
+ (?p ,(auth-source--aget printable-defaults 'port))))))
;; Store the data, prompting for the password if needed.
(setq data (or data
(if (eq r 'secret)
(or (eval default) (read-passwd prompt))
(if (stringp default)
- (read-string (if (string-match ": *\\'" prompt)
- (concat (substring prompt 0 (match-beginning 0))
- " (default " default "): ")
- (concat prompt "(default " default ") "))
- nil nil default)
+ (read-string
+ (if (string-match ": *\\'" prompt)
+ (concat (substring prompt 0 (match-beginning 0))
+ " (default " default "): ")
+ (concat prompt "(default " default ") "))
+ nil nil default)
(eval default)))))
(when data
@@ -1700,7 +1981,7 @@ authentication tokens:
;;; older API
-;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
+;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
;; deprecate the old interface
(make-obsolete 'auth-source-user-or-password
@@ -1781,6 +2062,26 @@ MODE can be \"login\" or \"password\"."
found))
+(defun auth-source-user-and-password (host &optional user)
+ (let* ((auth-info (car
+ (if user
+ (auth-source-search
+ :host host
+ :user "yourusername"
+ :max 1
+ :require '(:user :secret)
+ :create nil)
+ (auth-source-search
+ :host host
+ :max 1
+ :require '(:user :secret)
+ :create nil))))
+ (user (plist-get auth-info :user))
+ (password (plist-get auth-info :secret)))
+ (when (functionp password)
+ (setq password (funcall password)))
+ (list user password auth-info)))
+
(provide 'auth-source)
;;; auth-source.el ends here
diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el
index 5727bef37ef..e3ad1ae005f 100644
--- a/lisp/gnus/canlock.el
+++ b/lisp/gnus/canlock.el
@@ -1,6 +1,6 @@
;;; canlock.el --- functions for Cancel-Lock feature
-;; Copyright (C) 1998-1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: news, cancel-lock, hmac, sha1, rfc2104
diff --git a/lisp/gnus/compface.el b/lisp/gnus/compface.el
index e132f736269..eb125e20995 100644
--- a/lisp/gnus/compface.el
+++ b/lisp/gnus/compface.el
@@ -1,6 +1,6 @@
;;; compface.el --- functions for converting X-Face headers
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
index 1e2a566f72d..e99644a7c20 100644
--- a/lisp/gnus/deuglify.el
+++ b/lisp/gnus/deuglify.el
@@ -1,6 +1,6 @@
;;; deuglify.el --- deuglify broken Outlook (Express) articles
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Raymond Scholz <rscholz@zonix.de>
;; Thomas Steffen
diff --git a/lisp/gnus/ecomplete.el b/lisp/gnus/ecomplete.el
index 5d1c46bc2f6..eab8e6cdfb4 100644
--- a/lisp/gnus/ecomplete.el
+++ b/lisp/gnus/ecomplete.el
@@ -1,6 +1,6 @@
;;; ecomplete.el --- electric completion of addresses and the like
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail
diff --git a/lisp/gnus/flow-fill.el b/lisp/gnus/flow-fill.el
index cdaebbd6837..62e49f8f9ad 100644
--- a/lisp/gnus/flow-fill.el
+++ b/lisp/gnus/flow-fill.el
@@ -1,6 +1,6 @@
;;; flow-fill.el --- interpret RFC2646 "flowed" text
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Keywords: mail
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index 3ee72bc5fc6..975b83370ba 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -1,6 +1,6 @@
;;; gmm-utils.el --- Utility functions for Gnus, Message and MML
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Reiner Steib <reiner.steib@gmx.de>
;; Keywords: news
@@ -352,7 +352,7 @@ compatibility with versions of Emacs that lack the variable
dir (expand-file-name "../" dir))))
(setq image-directory-load-path dir))
- ;; If `image-directory-load-path' isn't Emacs' image directory,
+ ;; If `image-directory-load-path' isn't Emacs's image directory,
;; it's probably a user preference, so use it. Then use a
;; relative setting if possible; otherwise, use
;; `image-directory-load-path'.
@@ -383,7 +383,7 @@ compatibility with versions of Emacs that lack the variable
;; Set it to nil if image is not found.
(cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
((file-exists-p (expand-file-name image d1ei)) d1ei)))))
- ;; Use Emacs' image directory.
+ ;; Use Emacs's image directory.
(image-directory-load-path
(setq image-directory image-directory-load-path))
(no-error
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index bf7f31e6392..60d6102f7c0 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -1,6 +1,6 @@
;;; gnus-agent.el --- unplugged support for Gnus
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -186,7 +186,7 @@ When found, offer to remove them."
(defcustom gnus-agent-auto-agentize-methods nil
"Initially, all servers from these methods are agentized.
The user may remove or add servers using the Server buffer.
-See Info node `(gnus)Server Buffer'."
+See Info nodes `(gnus)Server Buffer', `(gnus)Agent Variables'."
:version "22.1"
:type '(repeat symbol)
:group 'gnus-agent)
@@ -242,7 +242,6 @@ NOTES:
(defvar gnus-category-group-cache nil)
(defvar gnus-agent-spam-hashtb nil)
(defvar gnus-agent-file-name nil)
-(defvar gnus-agent-send-mail-function nil)
(defvar gnus-agent-file-coding-system 'raw-text)
(defvar gnus-agent-file-loading-cache nil)
(defvar gnus-agent-total-fetched-hashtb nil)
@@ -355,23 +354,11 @@ manipulated as follows:
(func LIST): Returns VALUE1
(setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1."
`(progn (defmacro ,name (category)
- (list (quote cdr) (list (quote assq)
- (quote (quote ,prop-name)) category)))
-
- (define-setf-method ,name (category)
- (let* ((--category--temp-- (make-symbol "--category--"))
- (--value--temp-- (make-symbol "--value--")))
- (list (list --category--temp--) ; temporary-variables
- (list category) ; value-forms
- (list --value--temp--) ; store-variables
- (let* ((category --category--temp--) ; store-form
- (value --value--temp--))
- (list (quote gnus-agent-cat-set-property)
- category
- (quote (quote ,prop-name))
- value))
- (list (quote ,name) --category--temp--) ; access-form
- )))))
+ (list 'cdr (list 'assq '',prop-name category)))
+
+ (defsetf ,name (category) (value)
+ (list 'gnus-agent-cat-set-property
+ category '',prop-name value))))
)
(defmacro gnus-agent-cat-name (category)
@@ -399,22 +386,10 @@ manipulated as follows:
gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
-;; This form is equivalent to defsetf except that it calls make-symbol
-;; whereas defsetf calls gensym (Using gensym creates a run-time
-;; dependency on the CL library).
-
-(eval-and-compile
- (define-setf-method gnus-agent-cat-groups (category)
- (let* ((--category--temp-- (make-symbol "--category--"))
- (--groups--temp-- (make-symbol "--groups--")))
- (list (list --category--temp--)
- (list category)
- (list --groups--temp--)
- (let* ((category --category--temp--)
- (groups --groups--temp--))
- (list (quote gnus-agent-set-cat-groups) category groups))
- (list (quote gnus-agent-cat-groups) --category--temp--))))
- )
+;; This form may expand to code that uses CL functions at run-time,
+;; but that's OK since those functions will only ever be called from
+;; something like `setf', so only when CL is loaded anyway.
+(defsetf gnus-agent-cat-groups gnus-agent-set-cat-groups)
(defun gnus-agent-set-cat-groups (category groups)
(unless (eq groups 'ignore)
@@ -602,7 +577,7 @@ manipulated as follows:
(make-mode-line-mouse-map mouse-button mouse-func)
'mouse-face
(if (and (featurep 'xemacs)
- ;; XEmacs' `facep' only checks for a face
+ ;; XEmacs's `facep' only checks for a face
;; object, not for a face name, so it's useless
;; to check with `facep'.
(find-face 'modeline))
@@ -683,11 +658,7 @@ This will modify the `gnus-setup-news-hook', and
minor mode in all Gnus buffers."
(interactive)
(gnus-open-agent)
- (unless gnus-agent-send-mail-function
- (setq gnus-agent-send-mail-function
- (or message-send-mail-real-function
- (function (lambda () (funcall message-send-mail-function))))
- message-send-mail-real-function 'gnus-agent-send-mail))
+ (setq message-send-mail-real-function 'gnus-agent-send-mail)
;; If the servers file doesn't exist, auto-agentize some servers and
;; save the servers file so this auto-agentizing isn't invoked
@@ -723,7 +694,7 @@ Optional arg GROUP-NAME allows to specify another group."
(defun gnus-agent-send-mail ()
(if (or (not gnus-agent-queue-mail)
(and gnus-plugged (not (eq gnus-agent-queue-mail 'always))))
- (funcall gnus-agent-send-mail-function)
+ (message-multi-smtp-send-mail)
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "\n"))
@@ -1181,6 +1152,7 @@ downloadable."
(gnus-summary-position-point)))
(defun gnus-agent-summary-fetch-series ()
+ "Fetch the process-marked articles into the Agent."
(interactive)
(when gnus-newsgroup-processable
(setq gnus-newsgroup-downloadable
@@ -1228,8 +1200,9 @@ Optional arg ALL, if non-nil, means to fetch all articles."
(cond (gnus-agent-mark-unread-after-downloaded
(setq gnus-newsgroup-downloadable
(delq article gnus-newsgroup-downloadable))
-
- (gnus-summary-mark-article article gnus-unread-mark))
+ (when (and (not (member article gnus-newsgroup-dormant))
+ (not (member article gnus-newsgroup-marked)))
+ (gnus-summary-mark-article article gnus-unread-mark)))
(was-marked-downloadable
(gnus-summary-set-agent-mark article t)))
(when (gnus-summary-goto-subject article nil t)
@@ -1302,12 +1275,18 @@ This can be added to `gnus-select-article-hook' or
(gnus-group-update-group group t)))
nil))
-(defun gnus-agent-save-active (method)
+(defun gnus-agent-save-active (method &optional groups-p)
+ "Sync the agent's active file with the current buffer.
+Pass non-nil for GROUPS-P if the buffer starts out in groups format.
+Regardless, both the file and the buffer end up in active format
+if METHOD is agentized; otherwise the function is a no-op."
(when (gnus-agent-method-p method)
(let* ((gnus-command-method method)
(new (gnus-make-hashtable (count-lines (point-min) (point-max))))
(file (gnus-agent-lib-file "active")))
- (gnus-active-to-gnus-format nil new)
+ (if groups-p
+ (gnus-groups-to-gnus-format nil new)
+ (gnus-active-to-gnus-format nil new))
(gnus-agent-write-active file new)
(erase-buffer)
(let ((nnheader-file-coding-system gnus-agent-file-coding-system))
@@ -2229,7 +2208,10 @@ doesn't exist, to valid the overview buffer."
article counts for each of the method's subscribed groups."
(let ((gnus-command-method (or method gnus-command-method)))
(when (or (null gnus-agent-article-local-times)
- (zerop gnus-agent-article-local-times))
+ (zerop gnus-agent-article-local-times)
+ (not (gnus-methods-equal-p
+ gnus-command-method
+ (symbol-value (intern "+method" gnus-agent-article-local)))))
(setq gnus-agent-article-local
(gnus-cache-file-contents
(gnus-agent-lib-file "local")
@@ -3613,7 +3595,7 @@ articles in every agentized group? "))
(setq r d
d (directory-file-name d)))
;; if ANY ancestor was NOT in keep hash and
- ;; it's already in to-remove, add it to
+ ;; it's not already in to-remove, add it to
;; to-remove.
(if (and r
(not (member r to-remove)))
@@ -3737,6 +3719,13 @@ has been fetched."
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file) t))
+ (when fetch-old
+ (setq articles (gnus-uncompress-range
+ (cons (if (numberp fetch-old)
+ (max 1 (- (car articles) fetch-old))
+ 1)
+ (car (last articles))))))
+
;; Populate temp buffer with known headers
(when (file-exists-p file)
(with-current-buffer gnus-agent-overview-buffer
@@ -3773,12 +3762,7 @@ has been fetched."
(set-buffer nntp-server-buffer)
(let* ((fetched-articles (list nil))
(tail-fetched-articles fetched-articles)
- (min (cond ((numberp fetch-old)
- (max 1 (- (car articles) fetch-old)))
- (fetch-old
- 1)
- (t
- (car articles))))
+ (min (car articles))
(max (car (last articles))))
;; Get the list of articles that were fetched
@@ -3853,8 +3837,7 @@ has been fetched."
(not (numberp fetch-old)))
t ; Don't remove anything.
(nnheader-nov-delete-outside-range
- (if fetch-old (max 1 (- (car articles) fetch-old))
- (car articles))
+ (car articles)
(car (last articles)))
t)
@@ -3885,7 +3868,12 @@ has been fetched."
(coding-system-for-write gnus-cache-coding-system))
(when (not (file-exists-p file))
(gnus-make-directory (file-name-directory file))
- (write-region (point-min) (point-max) file nil 'silent))))
+ (write-region (point-min) (point-max) file nil 'silent)
+ ;; Tell the Agent when the article was fetched, so that it can
+ ;; be expired later.
+ (gnus-agent-load-alist group)
+ (gnus-agent-save-alist group (list article)
+ (time-to-days (current-time))))))
(defun gnus-agent-regenerate-group (group &optional reread)
"Regenerate GROUP.
@@ -4031,7 +4019,7 @@ If REREAD is not nil, downloaded articles are marked as unread."
;; gnus-agent-regenerate-group can remove the article ID of every
;; article (with the exception of the last ID in the list - it's
;; special) that no longer appears in the overview. In this
- ;; situtation, the last article ID in the list implies that it,
+ ;; situation, the last article ID in the list implies that it,
;; and every article ID preceding it, have been fetched from the
;; server.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index ea0710bf026..edcd7da2ddd 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1,6 +1,6 @@
;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -1794,14 +1794,6 @@ Initialized from `text-mode-syntax-table.")
(put-text-property (max (1- b) (point-min))
b 'intangible nil)))
-(defun gnus-article-hide-text-of-type (type)
- "Hide text of TYPE in the current buffer."
- (save-excursion
- (let ((b (point-min))
- (e (point-max)))
- (while (setq b (text-property-any b e 'article-type type))
- (add-text-properties b (incf b) gnus-hidden-properties)))))
-
(defun gnus-article-delete-text-of-type (type)
"Delete text of TYPE in the current buffer."
(save-excursion
@@ -1834,10 +1826,6 @@ Initialized from `text-mode-syntax-table.")
b (or (text-property-not-all b (point-max) 'invisible t)
(point-max)))))))
-(defun gnus-article-text-type-exists-p (type)
- "Say whether any text of type TYPE exists in the buffer."
- (text-property-any (point-min) (point-max) 'article-type type))
-
(defsubst gnus-article-header-rank ()
"Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
(let ((list gnus-sorted-header-list)
@@ -2146,23 +2134,6 @@ try this wash."
props)
(insert replace)))))))))
-(defun article-translate-characters (from to)
- "Translate all characters in the body of the article according to FROM and TO.
-FROM is a string of characters to translate from; to is a string of
-characters to translate to."
- (save-excursion
- (when (article-goto-body)
- (let ((inhibit-read-only t)
- (x (make-string 225 ?x))
- (i -1))
- (while (< (incf i) (length x))
- (aset x i i))
- (setq i 0)
- (while (< i (length from))
- (aset x (aref from i) (aref to i))
- (incf i))
- (translate-region (point) (point-max) x)))))
-
(defun article-translate-strings (map)
"Translate all string in the body of the article according to MAP.
MAP is an alist where the elements are on the form (\"from\" \"to\")."
@@ -2231,7 +2202,8 @@ unfolded."
(unfoldable
(or (equal gnus-article-unfold-long-headers t)
(and (stringp gnus-article-unfold-long-headers)
- (string-match gnus-article-unfold-long-headers header)))))
+ (string-match gnus-article-unfold-long-headers
+ header)))))
(with-temp-buffer
(insert header)
(goto-char (point-min))
@@ -2465,9 +2437,10 @@ long lines if and only if arg is positive."
(apply 'gnus-create-image png 'png t
(cdr (assq 'png gnus-face-properties-alist))))
(goto-char from)
- (gnus-add-wash-type 'face)
- (gnus-add-image 'face image)
- (gnus-put-image image nil 'face))))))))))
+ (when image
+ (gnus-add-wash-type 'face)
+ (gnus-add-image 'face image)
+ (gnus-put-image image nil 'face)))))))))))
(defun article-display-x-face (&optional force)
"Look for an X-Face header and display it if present."
@@ -2754,9 +2727,11 @@ If READ-CHARSET, ask for a coding system."
(let ((handles nil)
(buffer-read-only nil))
(when (gnus-buffer-live-p gnus-original-article-buffer)
- (setq handles (mm-dissect-buffer t t)))
+ (with-current-buffer gnus-original-article-buffer
+ (setq handles (mm-dissect-buffer t t))))
(article-goto-body)
(delete-region (point) (point-max))
+ (mm-enable-multibyte)
(mm-inline-text-html handles)))
(defvar gnus-article-browse-html-temp-list nil
@@ -2785,10 +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 (format
- "Delete all %s temporary HTML file%s? "
- files
- (if (> files 1) "s" ""))))
+ (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)
@@ -2900,7 +2877,7 @@ message header will be added to the bodies of the \"text/html\" parts."
;; Add a meta html tag to specify charset and a header.
(cond
(header
- (let (title eheader body hcharset coding force-charset)
+ (let (title eheader body hcharset coding)
(with-temp-buffer
(mm-enable-multibyte)
(setq case-fold-search t)
@@ -2923,8 +2900,7 @@ message header will be added to the bodies of the \"text/html\" parts."
charset)
title (when title
(mm-encode-coding-string title charset))
- body (mm-encode-coding-string content charset)
- force-charset t)
+ body (mm-encode-coding-string content charset))
(setq hcharset (mm-find-mime-charset-region (point-min)
(point-max)))
(cond ((= (length hcharset) 1)
@@ -2955,8 +2931,7 @@ message header will be added to the bodies of the \"text/html\" parts."
body (mm-encode-coding-string
(mm-decode-coding-string
content body)
- charset)
- force-charset t)))
+ charset))))
(setq charset hcharset
eheader (mm-encode-coding-string
(buffer-string) coding)
@@ -2970,7 +2945,7 @@ message header will be added to the bodies of the \"text/html\" parts."
(mm-disable-multibyte)
(insert body)
(when charset
- (mm-add-meta-html-tag handle charset force-charset))
+ (mm-add-meta-html-tag handle charset t))
(when title
(goto-char (point-min))
(unless (search-forward "<title>" nil t)
@@ -3239,9 +3214,16 @@ always hide."
Point is left at the beginning of the narrowed-to region."
(narrow-to-region
(goto-char (point-min))
- (if (search-forward "\n\n" nil 1)
- (1- (point))
- (point-max)))
+ (cond
+ ;; Absolutely no headers displayed.
+ ((looking-at "\n")
+ (point))
+ ;; Normal headers.
+ ((search-forward "\n\n" nil 1)
+ (1- (point)))
+ ;; Nothing but headers.
+ (t
+ (point-max))))
(goto-char (point-min)))
(defun article-goto-body ()
@@ -4571,9 +4553,13 @@ commands:
(defun gnus-article-stop-animations ()
(dolist (timer (and (boundp 'timer-list)
timer-list))
- (when (eq (elt timer 5) 'image-animate-timeout)
+ (when (eq (gnus-timer--function timer) 'image-animate-timeout)
(cancel-timer timer))))
+(defun gnus-stop-downloads ()
+ (when (boundp 'url-queue)
+ (set (intern "url-queue" obarray) nil)))
+
;; Set article window start at LINE, where LINE is the number of lines
;; from the head of the article.
(defun gnus-article-set-window-start (&optional line)
@@ -4796,10 +4782,10 @@ If a prefix ARG is given, ask for confirmation."
(dolist (buf (gnus-buffers))
(with-current-buffer buf
(when (eq major-mode 'gnus-sticky-article-mode)
- (if (not arg)
- (gnus-kill-buffer buf)
- (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
- (gnus-kill-buffer buf)))))))
+ (if (not arg)
+ (gnus-kill-buffer buf)
+ (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
+ (gnus-kill-buffer buf)))))))
;;;
;;; Gnus MIME viewing functions
@@ -5315,9 +5301,8 @@ Compressed files like .gz and .bz2 are decompressed."
(or (cdr (assq arg
gnus-summary-show-article-charset-alist))
(mm-read-coding-system "Charset: "))))
- (t
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle))))
+ ((mm-handle-undisplayer handle)
+ (mm-remove-part handle)))
(forward-line 2)
(mm-display-inline handle)
(goto-char b)))))
@@ -5607,7 +5592,9 @@ all parts."
(let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
(when (gnus-article-goto-part n)
(if (equal (car handle) "multipart/alternative")
- (gnus-article-press-button)
+ (progn
+ (beginning-of-line) ;; Make it toggle subparts
+ (gnus-article-press-button))
(when (eq (gnus-mm-display-part handle) 'internal)
(gnus-set-window-start)))))))
@@ -6186,12 +6173,13 @@ Provided for backwards compatibility."
(not gnus-inhibit-hiding))
(gnus-article-hide-headers)))
-(declare-function shr-put-image "shr" (data alt))
+(declare-function shr-put-image "shr" (data alt &optional flags))
-(defun gnus-shr-put-image (data alt)
+(defun gnus-shr-put-image (data alt &optional flags)
"Put image DATA with a string ALT. Enable image to be deleted."
(let ((image (shr-put-image data (propertize (or alt "*")
- 'gnus-image-category 'shr))))
+ 'gnus-image-category 'shr)
+ flags)))
(when image
(gnus-add-image 'shr image))))
@@ -6510,7 +6498,8 @@ not have a face in `gnus-article-boring-faces'."
(ding)
(unless (member keys nosave-in-article)
(set-buffer gnus-article-current-summary))
- (when (get func 'disabled)
+ (when (and (symbolp func)
+ (get func 'disabled))
(error "Function %s disabled" func))
(call-interactively func)
(setq new-sum-point (point)))
@@ -6752,11 +6741,6 @@ If given a prefix, show the hidden text instead."
(gnus-article-hide-citation-maybe arg force)
(gnus-article-hide-signature arg))
-(defun gnus-article-maybe-highlight ()
- "Do some article highlighting if article highlighting is requested."
- (when (gnus-visual-p 'article-highlight 'highlight)
- (gnus-article-highlight-some)))
-
(defun gnus-check-group-server ()
;; Make sure the connection to the server is alive.
(unless (gnus-server-opened
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index ad85bc5cf76..603952dd17b 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -1,6 +1,6 @@
;;; gnus-async.el --- asynchronous support for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -74,6 +74,7 @@ It should return non-nil if the article is to be prefetched."
"Function called after an article has been prefetched.
The function will be called narrowed to the region of the article
that was fetched."
+ :version "24.1"
:group 'gnus-asynchronous
:type 'function)
diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el
index d3fee3538b8..fdf868d8e21 100644
--- a/lisp/gnus/gnus-bcklg.el
+++ b/lisp/gnus/gnus-bcklg.el
@@ -1,6 +1,6 @@
;;; gnus-bcklg.el --- backlog functions for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index f86c94571a7..9f6654dd12d 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -1,6 +1,6 @@
;;; gnus-bookmark.el --- Bookmarks in Gnus
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Bastien Guerry <bzg AT altern DOT org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 203368f76e2..3dd236545a1 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -1,6 +1,6 @@
;;; gnus-cache.el --- cache interface for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 7c36311356f..d107dfad32e 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -1,6 +1,6 @@
;;; gnus-cite.el --- parse citations in articles for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Per Abhiddenware
@@ -509,6 +509,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
(if (and (equal (cdadr m) "")
(equal (cdar m) (cdaddr m))
(goto-char (caadr m))
+ (looking-at "[ \t]*$")
(forward-line 1)
(= (point) (caaddr m)))
(setcdr m (cdddr m))
@@ -1163,18 +1164,6 @@ See also the documentation for `gnus-article-highlight-citation'."
(while vars
(make-local-variable (pop vars)))))
-(defun gnus-cited-line-p ()
- "Say whether the current line is a cited line."
- (save-excursion
- (beginning-of-line)
- (let ((found nil))
- (dolist (prefix (mapcar 'car gnus-cite-prefix-alist))
- (when (string= (buffer-substring (point) (+ (length prefix) (point)))
- prefix)
- (setq found t)))
- found)))
-
-
;; Highlighting of different citation levels in message-mode.
;; - message-cite-prefix will be overridden if this is enabled.
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index 98f04263571..3440e6310af 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -1,6 +1,6 @@
;;; gnus-cus.el --- customization commands for Gnus
-;; Copyright (C) 1996, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1999-2012 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: news
@@ -417,6 +417,11 @@ category."))
(delq elem tmp))
(setq tmp (cdr tmp))))
+ ;; Decode values posting-style holds.
+ (dolist (style (cdr (assq 'posting-style values)))
+ (when (stringp (cadr style))
+ (setcdr style (list (mm-decode-coding-string (cadr style) 'utf-8)))))
+
(setq gnus-custom-params
(apply 'widget-create 'group
:value values
@@ -487,14 +492,17 @@ form, but who cares?"
(defun gnus-group-customize-done (&rest ignore)
"Apply changes and bury the buffer."
(interactive)
- (if gnus-custom-topic
- (gnus-topic-set-parameters gnus-custom-topic
- (widget-value gnus-custom-params))
- (gnus-group-edit-group-done 'params gnus-custom-group
- (widget-value gnus-custom-params))
- (gnus-group-edit-group-done 'method gnus-custom-group
- (widget-value gnus-custom-method)))
- (bury-buffer))
+ (let ((params (widget-value gnus-custom-params)))
+ ;; Encode values posting-style holds.
+ (dolist (style (cdr (assq 'posting-style params)))
+ (when (stringp (cadr style))
+ (setcdr style (list (mm-encode-coding-string (cadr style) 'utf-8)))))
+ (if gnus-custom-topic
+ (gnus-topic-set-parameters gnus-custom-topic params)
+ (gnus-group-edit-group-done 'params gnus-custom-group params)
+ (gnus-group-edit-group-done 'method gnus-custom-group
+ (widget-value gnus-custom-method)))
+ (bury-buffer)))
;;; Score Customization:
@@ -922,7 +930,7 @@ will add a new `thread' match for each article that has X in its
`Message-ID's of these matching articles.) This will ensure that you
can raise/lower the score of an entire thread, even though some
articles in the thread may not have complete `References' headers.
-Note that using this may lead to undeterministic scores of the
+Note that using this may lead to nondeterministic scores of the
articles in the thread.
")
,@types)
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index c632cab422f..9c27b2c74a9 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -1,6 +1,6 @@
;;; gnus-delay.el --- Delayed posting of articles
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Kai Grojohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
;; Keywords: mail, news, extensions
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 419346b7191..671c566d09f 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -1,6 +1,6 @@
;;; gnus-demon.el --- daemonic Gnus behavior
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -71,7 +71,7 @@ Emacs has been idle for IDLE `gnus-demon-timestep's."
;;; Internal variables.
(defvar gnus-demon-timers nil
- "List of idle timers which are running.")
+ "Plist of idle timers which are running.")
(defvar gnus-inhibit-demon nil
"If non-nil, no daemonic function will be run.")
@@ -98,14 +98,32 @@ Emacs has been idle for IDLE `gnus-demon-timestep's."
(float-time (or (current-idle-time)
'(0 0 0)))))
-(defun gnus-demon-run-callback (func &optional idle)
- "Run FUNC if Emacs has been idle for longer than IDLE seconds."
+(defun gnus-demon-run-callback (func &optional idle time special)
+ "Run FUNC if Emacs has been idle for longer than IDLE seconds.
+If not, and a TIME is given, restart a new idle timer, so FUNC
+can be called at the next opportunity. Such a special idle run is
+marked with SPECIAL."
(unless gnus-inhibit-demon
- (when (or (not idle)
- (<= idle (gnus-demon-idle-since)))
+ (block run-callback
+ (when (eq idle t)
+ (setq idle 0.001))
+ (cond (special
+ (setq gnus-demon-timers
+ (plist-put gnus-demon-timers func
+ (run-with-timer time time 'gnus-demon-run-callback
+ func idle time))))
+ ((and idle (> idle (gnus-demon-idle-since)))
+ (when time
+ (nnheader-cancel-timer (plist-get gnus-demon-timers func))
+ (setq gnus-demon-timers
+ (plist-put gnus-demon-timers func
+ (run-with-idle-timer idle nil
+ 'gnus-demon-run-callback
+ func idle time t))))
+ (return-from run-callback)))
(with-local-quit
- (ignore-errors
- (funcall func))))))
+ (ignore-errors
+ (funcall func))))))
(defun gnus-demon-init ()
"Initialize the Gnus daemon."
@@ -120,37 +138,76 @@ Emacs has been idle for IDLE `gnus-demon-timestep's."
;; If t, replace by 1
(time (cond ((eq time t)
gnus-demon-timestep)
- ((null time) nil)
- (t (* time gnus-demon-timestep))))
+ ((null time)
+ nil)
+ ((stringp time)
+ (* (gnus-demon-time-to-step time) gnus-demon-timestep))
+ (t
+ (* time gnus-demon-timestep))))
+ (idle (cond ((numberp idle)
+ (* idle gnus-demon-timestep))
+ ((and (eq idle t) (numberp time))
+ time)
+ (t
+ idle)))
+
(timer
(cond
- ;; (func number t)
- ;; Call when Emacs has been idle for `time'
- ((and (numberp time) (eq idle t))
- (run-with-timer time time 'gnus-demon-run-callback func time))
- ;; (func number number)
- ;; Call every `time' when Emacs has been idle for `idle'
- ((and (numberp time) (numberp idle))
- (run-with-timer time time 'gnus-demon-run-callback func idle))
;; (func nil number)
;; Only call when Emacs has been idle for `idle'
((and (null time) (numberp idle))
- (run-with-idle-timer (* idle gnus-demon-timestep) t
- 'gnus-demon-run-callback func))
- ;; (func number nil)
+ (run-with-idle-timer idle t 'gnus-demon-run-callback func))
+ ;; (func number any)
;; Call every `time'
- ((and (numberp time) (null idle))
- (run-with-timer time time 'gnus-demon-run-callback func)))))
+ ((integerp time)
+ (run-with-timer time time 'gnus-demon-run-callback
+ func idle time))
+ ;; (func string any)
+ ((stringp time)
+ (run-with-timer time (* 24 60 60) 'gnus-demon-run-callback
+ func idle)))))
(when timer
- (add-to-list 'gnus-demon-timers timer)))))
+ (setq gnus-demon-timers (plist-put gnus-demon-timers func timer))))))
+
+(defun gnus-demon-time-to-step (time)
+ "Find out how many steps to TIME, which is on the form \"17:43\"."
+ (let* ((now (current-time))
+ ;; obtain NOW as discrete components -- make a vector for speed
+ (nowParts (decode-time now))
+ ;; obtain THEN as discrete components
+ (thenParts (parse-time-string time))
+ (thenHour (elt thenParts 2))
+ (thenMin (elt thenParts 1))
+ ;; convert time as elements into number of seconds since EPOCH.
+ (then (encode-time 0
+ thenMin
+ thenHour
+ ;; If THEN is earlier than NOW, make it
+ ;; same time tomorrow. Doc for encode-time
+ ;; says that this is OK.
+ (+ (elt nowParts 3)
+ (if (or (< thenHour (elt nowParts 2))
+ (and (= thenHour (elt nowParts 2))
+ (<= thenMin (elt nowParts 1))))
+ 1 0))
+ (elt nowParts 4)
+ (elt nowParts 5)
+ (elt nowParts 6)
+ (elt nowParts 7)
+ (elt nowParts 8)))
+ ;; calculate number of seconds between NOW and THEN
+ (diff (+ (* 65536 (- (car then) (car now)))
+ (- (cadr then) (cadr now)))))
+ ;; return number of timesteps in the number of seconds
+ (round (/ diff gnus-demon-timestep))))
(gnus-add-shutdown 'gnus-demon-cancel 'gnus)
(defun gnus-demon-cancel ()
"Cancel any Gnus daemons."
(interactive)
- (dolist (timer gnus-demon-timers)
- (nnheader-cancel-timer timer))
+ (dotimes (i (/ (length gnus-demon-timers) 2))
+ (nnheader-cancel-timer (nth (1+ (* i 2)) gnus-demon-timers)))
(setq gnus-demon-timers nil))
(defun gnus-demon-add-disconnection ()
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
index 9f86e74bd99..bca307b19b6 100644
--- a/lisp/gnus/gnus-diary.el
+++ b/lisp/gnus/gnus-diary.el
@@ -1,6 +1,6 @@
;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Didier Verna <didier@xemacs.org>
;; Maintainer: Didier Verna <didier@xemacs.org>
@@ -277,18 +277,18 @@ Optional prefix (or REVERSE argument) means sort in reverse order."
;; Called when a group is subscribed. This is needed because groups created
;; because of mail splitting are *not* created with the back end function.
-;; Thus, `nndiary-request-create-group-hooks' is inoperative.
+;; Thus, `nndiary-request-create-group-functions' is inoperative.
(defun gnus-diary-maybe-update-group-parameters (group)
(when (eq (car (gnus-find-method-for-group group)) 'nndiary)
(gnus-diary-update-group-parameters group)))
-(add-hook 'nndiary-request-create-group-hooks
+(add-hook 'nndiary-request-create-group-functions
'gnus-diary-update-group-parameters)
-;; Now that we have `gnus-subscribe-newsgroup-hooks', this is not needed
+;; Now that we have `gnus-subscribe-newsgroup-functions', this is not needed
;; anymore. Maybe I should remove this completely.
-(add-hook 'nndiary-request-update-info-hooks
+(add-hook 'nndiary-request-update-info-functions
'gnus-diary-update-group-parameters)
-(add-hook 'gnus-subscribe-newsgroup-hooks
+(add-hook 'gnus-subscribe-newsgroup-functions
'gnus-diary-maybe-update-group-parameters)
@@ -384,7 +384,7 @@ If ARG (or prefix) is non-nil, force prompting for all fields."
nndiary-headers)
))
-(add-hook 'nndiary-request-accept-article-hooks
+(add-hook 'nndiary-request-accept-article-functions
(lambda () (gnus-diary-check-message nil)))
(define-key message-mode-map "\C-c\C-fd" 'gnus-diary-check-message)
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index b4d23ff579c..e15a6c732b5 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -1,6 +1,6 @@
;;; gnus-dired.el --- utility functions where gnus and dired meet
-;; Copyright (C) 1996-1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2001-2012 Free Software Foundation, Inc.
;; Authors: Benjamin Rutt <brutt@bloomington.in.us>,
;; Shenghuo Zhu <zsh@cs.rochester.edu>
@@ -155,8 +155,8 @@ filenames."
(setq destination
(if (= (length bufs) 1)
(get-buffer (car bufs))
- (gnus-completing-read "Attach to which mail composition buffer"
- bufs t)))
+ (gnus-completing-read "Attach to buffer"
+ bufs t nil nil (car bufs))))
;; setup a new mail composition buffer
(let ((mail-user-agent gnus-dired-mail-mode)
;; A workaround to prevent Gnus from displaying the Gnus
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index 40f5abda4f8..13b3cbb862f 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -1,6 +1,6 @@
;;; gnus-draft.el --- draft message support for Gnus
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el
index 8db1905ef8b..313a230e836 100644
--- a/lisp/gnus/gnus-dup.el
+++ b/lisp/gnus/gnus-dup.el
@@ -1,6 +1,6 @@
;;; gnus-dup.el --- suppression of duplicate articles in Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index 4075e7a7625..f1a19e2e2d9 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -1,6 +1,6 @@
;;; gnus-eform.el --- a mode for editing forms for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el
index 5acc9d117e4..8b70a7a0989 100644
--- a/lisp/gnus/gnus-ems.el
+++ b/lisp/gnus/gnus-ems.el
@@ -1,6 +1,6 @@
;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index 44cb1583ec9..f5e1c5ad691 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -1,6 +1,6 @@
;;; gnus-fun.el --- various frivolous extension functions to Gnus
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -85,13 +85,6 @@ PNG format."
(call-process shell-file-name nil (list standard-output nil)
nil shell-command-switch command)))
-(defun gnus-shell-command-on-region (start end command)
- "A simplified `shell-command-on-region'.
-Output to the current buffer, replace text, and don't mingle error."
- (call-process-region start end shell-file-name t
- (list (current-buffer) nil)
- nil shell-command-switch command))
-
;;;###autoload
(defun gnus-random-x-face ()
"Return X-Face header data chosen randomly from `gnus-x-face-directory'."
@@ -285,6 +278,10 @@ colors of the displayed X-Faces."
values))
(mapconcat 'identity values " ")))
+(defun gnus-funcall-no-warning (function &rest args)
+ (when (fboundp function)
+ (apply function args)))
+
(provide 'gnus-fun)
;;; gnus-fun.el ends here
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index 98b1f3bd18c..b6e760b1d0b 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -1,6 +1,6 @@
;;; gnus-gravatar.el --- Gnus Gravatar support
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: news
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 9730b69164e..8c7d0165976 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1,6 +1,6 @@
;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -56,7 +56,7 @@
(autoload 'gnus-group-make-nnir-group "nnir")
-(defcustom gnus-no-groups-message "No Gnus is good news"
+(defcustom gnus-no-groups-message "No news is good news"
"*Message displayed by Gnus when no groups are available."
:group 'gnus-start
:type 'string)
@@ -2277,8 +2277,8 @@ confirmation is required."
number)
"Read GROUP from METHOD as an ephemeral group.
If ACTIVATE, request the group first.
-If QUIT-CONFIG, use that window configuration when exiting from the
-ephemeral group.
+If QUIT-CONFIG, use that Gnus window configuration name when
+exiting from the ephemeral group.
If REQUEST-ONLY, don't actually read the group; just request it.
If SELECT-ARTICLES, only select those articles.
If PARAMETERS, use those as the group parameters.
@@ -2290,15 +2290,23 @@ Return the name of the group if selection was successful."
;; (gnus-read-group "Group name: ")
(gnus-group-completing-read)
(gnus-read-method "From method")))
- ;; Transform the select method into a unique server.
(unless (gnus-alive-p)
- (gnus-no-server))
+ (nnheader-init-server-buffer)
+ ;; Necessary because of funky inlining.
+ (require 'gnus-cache)
+ (setq gnus-newsrc-hashtb (gnus-make-hashtable)))
+ ;; Transform the select method into a unique server.
(when (stringp method)
(setq method (gnus-server-to-method method)))
- (setq method
- `(,(car method) ,(concat (cadr method) "-ephemeral")
- (,(intern (format "%s-address" (car method))) ,(cadr method))
- ,@(cddr method)))
+ (let ((address-slot
+ (intern (format "%s-address" (car method)))))
+ (setq method
+ (if (assq address-slot (cddr method))
+ `(,(car method) ,(concat (cadr method) "-ephemeral")
+ ,@(cddr method))
+ `(,(car method) ,(concat (cadr method) "-ephemeral")
+ (,address-slot ,(cadr method))
+ ,@(cddr method)))))
(let ((group (if (gnus-group-foreign-p group) group
(gnus-group-prefixed-name (gnus-group-real-name group)
method))))
@@ -2307,18 +2315,22 @@ Return the name of the group if selection was successful."
`(-1 nil (,group
,gnus-level-default-subscribed nil nil ,method
,(cons
- (cond
- (quit-config
- (cons 'quit-config quit-config))
- ((assq gnus-current-window-configuration
- gnus-buffer-configuration)
- (cons 'quit-config
+ (cons 'quit-config
+ (cond
+ (quit-config
+ quit-config)
+ ((assq gnus-current-window-configuration
+ gnus-buffer-configuration)
(cons gnus-summary-buffer
- gnus-current-window-configuration))))
+ gnus-current-window-configuration))
+ (t
+ (cons (current-buffer)
+ (current-window-configuration)))))
parameters)))
gnus-newsrc-hashtb)
(push method gnus-ephemeral-servers)
- (set-buffer gnus-group-buffer)
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (set-buffer gnus-group-buffer))
(unless (gnus-check-server method)
(error "Unable to contact server: %s" (gnus-status-message method)))
(when activate
@@ -2376,7 +2388,7 @@ specified by `gnus-gmane-group-download-format'."
group start (+ start range)))
(write-region (point-min) (point-max) tmpfile)
(gnus-group-read-ephemeral-group
- (format "%s.start-%s.range-%s" group start range)
+ (format "nndoc+ephemeral:%s.start-%s.range-%s" group start range)
`(nndoc ,tmpfile
(nndoc-article-type mbox))))
(delete-file tmpfile)))
@@ -2469,7 +2481,8 @@ the bug number, and browsing the URL must return mbox output."
"/.*$" ""))))
(write-region (point-min) (point-max) tmpfile)
(gnus-group-read-ephemeral-group
- "gnus-read-ephemeral-bug"
+ (format "nndoc+ephemeral:bug#%s"
+ (mapconcat 'number-to-string ids ","))
`(nndoc ,tmpfile
(nndoc-article-type mbox))
nil window-conf))
@@ -4009,11 +4022,13 @@ entail asking the server for the groups."
(gnus-activate-foreign-newsgroups level))
(gnus-group-get-new-news)))
-(defun gnus-group-get-new-news (&optional arg)
+(defun gnus-group-get-new-news (&optional arg one-level)
"Get newly arrived articles.
If ARG is a number, it specifies which levels you are interested in
re-scanning. If ARG is non-nil and not a number, this will force
-\"hard\" re-reading of the active files from all servers."
+\"hard\" re-reading of the active files from all servers.
+If ONE-LEVEL is not nil, then re-scan only the specified level,
+otherwise all levels below ARG will be scanned too."
(interactive "P")
(require 'nnmail)
(let ((gnus-inhibit-demon t)
@@ -4027,7 +4042,8 @@ re-scanning. If ARG is non-nil and not a number, this will force
(unless gnus-slave
(gnus-master-read-slave-newsrc))
- (gnus-get-unread-articles arg)
+ (gnus-get-unread-articles (gnus-group-default-level arg t)
+ nil one-level)
;; If the user wants it, we scan for new groups.
(when (eq gnus-check-new-newsgroups 'always)
@@ -4070,10 +4086,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
(gnus-agent-save-group-info
method (gnus-group-real-name group) active))
(gnus-group-update-group group nil t))
- (if (eq (gnus-server-status (gnus-find-method-for-group group))
- 'denied)
- (gnus-error 3 "Server previously determined to be down; not retrying")
- (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
+ (gnus-error 3 "%s error: %s" group (gnus-status-message group))))
(when beg
(goto-char beg))
(when gnus-goto-next-group-when-activating
@@ -4438,12 +4451,6 @@ and the second element is the address."
(gnus-list-of-unread-articles (car info))))))
(error "No such group: %s" (gnus-info-group info))))))
-(defun gnus-group-set-method-info (group select-method)
- (gnus-group-set-info select-method group 'method))
-
-(defun gnus-group-set-params-info (group params)
- (gnus-group-set-info params group 'params))
-
;; Ad-hoc function for inserting data from a different newsrc.eld
;; file. Use with caution, if at all.
(defun gnus-import-other-newsrc-file (file)
@@ -4664,6 +4671,8 @@ you the groups that have both dormant articles and cached articles."
(setq mark gnus-expirable-mark))
(setq mark (gnus-request-update-mark
group article mark))
+ (gnus-request-set-mark
+ group (list (list (list article) 'add '(read))))
(gnus-mark-article-as-read article mark)
(setq gnus-newsgroup-active (gnus-active group))
(when active
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index f443c4021e2..770904fa1c4 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -1,6 +1,6 @@
;;; gnus-html.el --- Render HTML in a buffer.
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: html, web
@@ -390,7 +390,7 @@ Use ALT-TEXT for the image string."
(if (fboundp 'url-queue-retrieve)
(url-queue-retrieve (car image)
'gnus-html-image-fetched
- (list buffer image) t)
+ (list buffer image) t t)
(ignore-errors
(url-retrieve (car image)
'gnus-html-image-fetched
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 2e102634727..bc3ba187dd4 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -1,6 +1,6 @@
;;; gnus-int.el --- backend interface functions for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -43,11 +43,13 @@
(defcustom gnus-after-set-mark-hook nil
"Hook called just after marks are set in a group."
+ :version "24.1"
:group 'gnus-start
:type 'hook)
(defcustom gnus-before-update-mark-hook nil
"Hook called just before marks are updated in a group."
+ :version "24.1"
:group 'gnus-start
:type 'hook)
@@ -245,7 +247,7 @@ If it is down, start it up (again)."
(eq (nth 1 (assoc method gnus-opened-servers))
'denied))
-(defvar gnus-backend-trace t)
+(defvar gnus-backend-trace nil)
(defun gnus-open-server (gnus-command-method)
"Open a connection to GNUS-COMMAND-METHOD."
@@ -356,7 +358,7 @@ If it is down, start it up (again)."
infos data))
(defun gnus-retrieve-group-data-early (gnus-command-method infos)
- "Start early async retrival of data from GNUS-COMMAND-METHOD."
+ "Start early async retrieval of data from GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(funcall (gnus-get-function gnus-command-method 'retrieve-group-data-early)
@@ -396,7 +398,7 @@ If it is down, start it up (again)."
result))
(defun gnus-request-compact (gnus-command-method)
- "Request groups compaction from GNUS-COMMAND-METHOD."
+ "Request groups compaction from GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(funcall (gnus-get-function gnus-command-method 'request-compact)
@@ -414,14 +416,6 @@ If it is down, start it up (again)."
dont-check
info)))
-(defun gnus-list-active-group (group)
- "Request active information on GROUP."
- (let ((gnus-command-method (gnus-find-method-for-group group))
- (func 'list-active-group))
- (when (gnus-check-backend-function func group)
- (funcall (gnus-get-function gnus-command-method func)
- (gnus-group-real-name group) (nth 1 gnus-command-method)))))
-
(defun gnus-request-group-description (group)
"Request a description of GROUP."
(let ((gnus-command-method (gnus-find-method-for-group group))
@@ -430,14 +424,6 @@ If it is down, start it up (again)."
(funcall (gnus-get-function gnus-command-method func)
(gnus-group-real-name group) (nth 1 gnus-command-method)))))
-(defun gnus-request-group-articles (group)
- "Request a list of existing articles in GROUP."
- (let ((gnus-command-method (gnus-find-method-for-group group))
- (func 'request-group-articles))
- (when (gnus-check-backend-function func group)
- (funcall (gnus-get-function gnus-command-method func)
- (gnus-group-real-name group) (nth 1 gnus-command-method)))))
-
(defun gnus-close-group (group)
"Request the GROUP be closed."
(let ((gnus-command-method (inline (gnus-find-method-for-group group))))
@@ -531,15 +517,69 @@ If BUFFER, insert the article in that group."
header
(gnus-group-real-name group))))
+(defun gnus-select-group-with-message-id (group message-id)
+ "Activate and select GROUP with the given MESSAGE-ID selected.
+Returns the article number of the message.
+
+If GROUP is not already selected, the message will be the only one in
+the group's summary.
+"
+ ;; TODO: is there a way to know at this point whether the group will
+ ;; be newly-selected? If so we could clean up the logic at the end
+ ;;
+ ;; save the new group's display parameter, if any, so we
+ ;; can replace it temporarily with zero.
+ (let ((saved-display
+ (gnus-group-get-parameter group 'display :allow-list)))
+
+ ;; Tell gnus we really don't want any articles
+ (gnus-group-set-parameter group 'display 0)
+
+ (unwind-protect
+ (gnus-summary-read-group-1
+ group (not :show-all) :no-article (not :kill-buffer)
+ ;; The combination of no-display and this dummy list of
+ ;; articles to select somehow makes it possible to open a
+ ;; group with no articles in it. Black magic.
+ :no-display '(-1); select-articles
+ )
+ ;; Restore the new group's display parameter
+ (gnus-group-set-parameter group 'display saved-display)))
+
+ ;; The summary buffer was suppressed by :no-display above.
+ ;; Create it now and insert the message
+ (let ((group-is-new (gnus-summary-setup-buffer group)))
+ (condition-case err
+ (let ((article-number
+ (gnus-summary-insert-subject message-id)))
+ (unless article-number
+ (signal 'error "message-id not in group"))
+ (gnus-summary-select-article nil nil nil article-number)
+ article-number)
+ ;; Clean up the new summary and propagate the error
+ (error (when group-is-new (gnus-summary-exit))
+ (apply 'signal err)))))
+
+(defun gnus-simplify-group-name (group)
+ "Return the simplest representation of the name of GROUP.
+This is the string that Gnus uses to identify the group."
+ (gnus-group-prefixed-name
+ (gnus-group-real-name group)
+ (gnus-group-method group)))
+
(defun gnus-warp-to-article ()
"Warps from an article in a virtual group to the article in its
real group. Does nothing on a real group."
(interactive)
- (let ((gnus-command-method
- (gnus-find-method-for-group gnus-newsgroup-name)))
- (when (gnus-check-backend-function
- 'warp-to-article (car gnus-command-method))
- (funcall (gnus-get-function gnus-command-method 'warp-to-article)))))
+ (when (gnus-virtual-group-p gnus-newsgroup-name)
+ (let ((gnus-command-method
+ (gnus-find-method-for-group gnus-newsgroup-name)))
+ (or
+ (when (gnus-check-backend-function
+ 'warp-to-article (car gnus-command-method))
+ (funcall (gnus-get-function gnus-command-method 'warp-to-article)))
+ (and (bound-and-true-p gnus-registry-enabled)
+ (gnus-try-warping-via-registry))))))
(defun gnus-request-head (article group)
"Request the head of ARTICLE in GROUP."
@@ -559,7 +599,8 @@ real group. Does nothing on a real group."
clean-up t))
;; Use `head' function.
((fboundp head)
- (setq res (funcall head article (gnus-group-real-name group)
+ (setq res (funcall head article
+ (and (not gnus-override-method) (gnus-group-real-name group))
(nth 1 gnus-command-method))))
;; Use `article' function.
(t
@@ -666,6 +707,10 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(defun gnus-request-expire-articles (articles group &optional force)
(let* ((gnus-command-method (gnus-find-method-for-group group))
+ ;; Filter out any negative article numbers; they can't be
+ ;; expired here.
+ (articles
+ (delq nil (mapcar (lambda (n) (and (>= n 0) n)) articles)))
(gnus-inhibit-demon t)
(not-deleted
(funcall
@@ -742,11 +787,6 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(gnus-agent-regenerate-group group (list article)))
result))
-(defun gnus-request-associate-buffer (group)
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function gnus-command-method 'request-associate-buffer)
- (gnus-group-real-name group))))
-
(defun gnus-request-restore-buffer (article group)
"Request a new buffer restored to the state of ARTICLE."
(let ((gnus-command-method (gnus-find-method-for-group group)))
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index fdbe125ff10..c1e5bcb7d01 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -1,6 +1,6 @@
;;; gnus-kill.el --- kill commands for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -328,24 +328,6 @@ If NEWSGROUP is nil, the global kill file is selected."
;; For kill files
-(defun gnus-Newsgroup-kill-file (newsgroup)
- "Return the name of a kill file for NEWSGROUP.
-If NEWSGROUP is nil, return the global kill file instead."
- (cond ((or (null newsgroup)
- (string-equal newsgroup ""))
- ;; The global kill file is placed at top of the directory.
- (expand-file-name gnus-kill-file-name gnus-kill-files-directory))
- (gnus-use-long-file-name
- ;; Append ".KILL" to capitalized newsgroup name.
- (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
- "." gnus-kill-file-name)
- gnus-kill-files-directory))
- (t
- ;; Place "KILL" under the hierarchical directory.
- (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
- "/" gnus-kill-file-name)
- gnus-kill-files-directory))))
-
(defun gnus-expunge (marks)
"Remove lines marked with MARKS."
(with-current-buffer gnus-summary-buffer
diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el
index 51b44e6052d..60d7b31713b 100644
--- a/lisp/gnus/gnus-logic.el
+++ b/lisp/gnus/gnus-logic.el
@@ -1,6 +1,6 @@
;;; gnus-logic.el --- advanced scoring code for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -180,46 +180,52 @@
(setq header "article"))
(with-current-buffer nntp-server-buffer
(let* ((request-func (cond ((string= "head" header)
- 'gnus-request-head)
- ((string= "body" header)
- 'gnus-request-body)
- (t 'gnus-request-article)))
- ofunc article)
+ 'gnus-request-head)
+ ((string= "body" header)
+ 'gnus-request-body)
+ (t 'gnus-request-article)))
+ ofunc article handles)
;; Not all backends support partial fetching. In that case, we
;; just fetch the entire article.
- (unless (gnus-check-backend-function
- (intern (concat "request-" header))
- gnus-newsgroup-name)
- (setq ofunc request-func)
- (setq request-func 'gnus-request-article))
+ ;; When scoring by body, we need to peek at the headers to detect the
+ ;; content encoding
+ (unless (or (gnus-check-backend-function
+ (intern (concat "request-" header))
+ gnus-newsgroup-name)
+ (string= "body" header))
+ (setq ofunc request-func)
+ (setq request-func 'gnus-request-article))
(setq article (mail-header-number gnus-advanced-headers))
(gnus-message 7 "Scoring article %s..." article)
(when (funcall request-func article gnus-newsgroup-name)
- (goto-char (point-min))
- ;; If just parts of the article is to be searched and the
- ;; backend didn't support partial fetching, we just narrow to
- ;; the relevant parts.
- (when ofunc
- (if (eq ofunc 'gnus-request-head)
- (narrow-to-region
- (point)
- (or (search-forward "\n\n" nil t) (point-max)))
- (narrow-to-region
- (or (search-forward "\n\n" nil t) (point))
- (point-max))))
- (let* ((case-fold-search (not (eq (downcase (symbol-name type))
- (symbol-name type))))
- (search-func
- (cond ((memq type '(r R regexp Regexp))
- 're-search-forward)
- ((memq type '(s S string String))
- 'search-forward)
- (t
- (error "Invalid match type: %s" type)))))
- (goto-char (point-min))
- (prog1
- (funcall search-func match nil t)
- (widen)))))))
+ (when (string= "body" header)
+ (setq handles (gnus-score-decode-text-parts)))
+ (goto-char (point-min))
+ ;; If just parts of the article is to be searched and the
+ ;; backend didn't support partial fetching, we just narrow to
+ ;; the relevant parts.
+ (when ofunc
+ (if (eq ofunc 'gnus-request-head)
+ (narrow-to-region
+ (point)
+ (or (search-forward "\n\n" nil t) (point-max)))
+ (narrow-to-region
+ (or (search-forward "\n\n" nil t) (point))
+ (point-max))))
+ (let* ((case-fold-search (not (eq (downcase (symbol-name type))
+ (symbol-name type))))
+ (search-func
+ (cond ((memq type '(r R regexp Regexp))
+ 're-search-forward)
+ ((memq type '(s S string String))
+ 'search-forward)
+ (t
+ (error "Invalid match type: %s" type)))))
+ (goto-char (point-min))
+ (prog1
+ (funcall search-func match nil t)
+ (widen)))
+ (when handles (mm-destroy-parts handles))))))
(provide 'gnus-logic)
diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el
index 1c9d31ab6c4..874a1dc3bb4 100644
--- a/lisp/gnus/gnus-mh.el
+++ b/lisp/gnus/gnus-mh.el
@@ -1,6 +1,6 @@
;;; gnus-mh.el --- mh-e interface for Gnus
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el
index d99680f5924..d78d6b7a92f 100644
--- a/lisp/gnus/gnus-ml.el
+++ b/lisp/gnus/gnus-ml.el
@@ -1,6 +1,6 @@
;;; gnus-ml.el --- Mailing list minor mode for Gnus
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Julien Gilles <jgilles@free.fr>
;; Keywords: news, mail
diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el
index ccc145b7e29..3086e2b8dfa 100644
--- a/lisp/gnus/gnus-mlspl.el
+++ b/lisp/gnus/gnus-mlspl.el
@@ -1,6 +1,6 @@
;;; gnus-mlspl.el --- a group params-based mail splitting mechanism
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Alexandre Oliva <oliva@lsd.ic.unicamp.br>
;; Keywords: news, mail
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 6ff1023383b..77bb6281bc4 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1,6 +1,6 @@
;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -163,6 +163,22 @@ if nil, attach files as normal parts."
(const all :tag "Any")
(string :tag "Regexp")))
+(defcustom gnus-gcc-self-resent-messages 'no-gcc-self
+ "Like `gcc-self' group parameter, only for unmodified resent messages.
+Applied to messages sent by `gnus-summary-resend-message'. Non-nil
+value of this variable takes precedence over any existing Gcc header.
+
+If this is `none', no Gcc copy will be made. If this is t, messages
+resent will be Gcc'd to the current group. If this is a string, it
+specifies a group to which resent messages will be Gcc'd. If this is
+nil, Gcc will be done according to existing Gcc header(s), if any.
+If this is `no-gcc-self', resent messages will be Gcc'd to groups that
+existing Gcc header specifies, except for the current group."
+ :version "24.3"
+ :group 'gnus-message
+ :type '(choice (const none) (const t) string (const nil)
+ (const no-gcc-self)))
+
(gnus-define-group-parameter
posting-charset-alist
:type list
@@ -297,6 +313,24 @@ If nil, the address field will always be empty after invoking
:group 'gnus-message
:type 'boolean)
+(defcustom gnus-gcc-pre-body-encode-hook nil
+ "A hook called before encoding the body of the Gcc copy of a message.
+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
+ "A hook called after encoding the body of the Gcc copy of a message.
+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)
;;; Internal variables.
@@ -478,22 +512,31 @@ Thank you for your help in stamping out bugs.
;;;###autoload
(defun gnus-msg-mail (&optional to subject other-headers continue
- switch-action yank-action send-actions return-action)
+ switch-action yank-action send-actions
+ return-action)
"Start editing a mail message to be sent.
Like `message-mail', but with Gnus paraphernalia, particularly the
-Gcc: header for archiving purposes."
+Gcc: header for archiving purposes.
+If Gnus isn't running, a plain `message-mail' setup is used
+instead."
(interactive)
- (let ((buf (current-buffer))
- mail-buf)
- (gnus-setup-message 'message
- (message-mail to subject other-headers continue
- nil yank-action send-actions return-action))
- (when switch-action
- (setq mail-buf (current-buffer))
- (switch-to-buffer buf)
- (apply switch-action mail-buf nil)))
- ;; COMPOSEFUNC should return t if succeed. Undocumented ???
- t)
+ (if (not (gnus-alive-p))
+ (progn
+ (message "Gnus not running; using plain Message mode")
+ (message-mail to subject other-headers continue
+ nil yank-action send-actions return-action))
+ (let ((buf (current-buffer))
+ (gnus-newsgroup-name (or gnus-newsgroup-name ""))
+ mail-buf)
+ (gnus-setup-message 'message
+ (message-mail to subject other-headers continue
+ nil yank-action send-actions return-action))
+ (when switch-action
+ (setq mail-buf (current-buffer))
+ (switch-to-buffer buf)
+ (apply switch-action mail-buf nil))
+ ;; COMPOSEFUNC should return t if succeed. Undocumented ???
+ t)))
;;;###autoload
(defun gnus-button-mailto (address)
@@ -636,7 +679,7 @@ a news."
(if (= 1 (prefix-numeric-value arg))
(gnus-group-completing-read "Newsgroup" nil
(gnus-read-active-file-p))
- (gnus-group-group-name))
+ (or (gnus-group-group-name) ""))
""))
;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy))
@@ -803,9 +846,21 @@ post using the current select method."
(interactive (gnus-interactive "P\ny"))
(let ((message-post-method
`(lambda (arg)
- (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))))
+ (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
+ (user-mail-address user-mail-address))
(dolist (article (gnus-summary-work-articles n))
(when (gnus-summary-select-article t nil nil article)
+ ;; Pretend that we're doing a followup so that we can see what
+ ;; the From header would have ended up being.
+ (save-window-excursion
+ (save-excursion
+ (gnus-summary-followup nil)
+ (let ((from (message-fetch-field "from")))
+ (when from
+ (setq user-mail-address
+ (car (mail-header-parse-address from)))))
+ (kill-buffer (current-buffer))))
+ ;; Now cancel the article using the From header we got.
(when (gnus-eval-in-buffer-window gnus-original-article-buffer
(message-cancel-news))
(gnus-summary-mark-as-read article gnus-canceled-mark)
@@ -1129,7 +1184,7 @@ If VERY-WIDE, make a very wide reply."
(insert headers))
(goto-char (point-max)))
(mml-quote-region (point) (point-max))
- (message-reply nil wide 'switch-to-buffer)
+ (message-reply nil wide)
(when yank
(gnus-inews-yank-articles yank))
(gnus-summary-handle-replysign)))))
@@ -1230,7 +1285,7 @@ For the \"inline\" alternatives, also see the variable
(interactive "P")
(if (cdr (gnus-summary-work-articles nil))
;; Process marks are given.
- (gnus-uu-digest-mail-forward arg post)
+ (gnus-uu-digest-mail-forward nil post)
;; No process marks.
(let ((message-forward-as-mime message-forward-as-mime)
(message-forward-show-mml message-forward-show-mml))
@@ -1264,6 +1319,44 @@ For the \"inline\" alternatives, also see the variable
(set-buffer gnus-original-article-buffer)
(message-forward post)))))))
+(defun gnus-summary-resend-message-insert-gcc ()
+ "Insert Gcc header according to `gnus-gcc-self-resent-messages'."
+ (gnus-inews-insert-gcc)
+ (let ((gcc (mapcar
+ (lambda (group)
+ (mm-encode-coding-string
+ group
+ (gnus-group-name-charset (gnus-inews-group-method group)
+ group)))
+ (message-unquote-tokens
+ (message-tokenize-header (mail-fetch-field "gcc" nil t)
+ " ,"))))
+ (self (with-current-buffer gnus-summary-buffer
+ gnus-gcc-self-resent-messages)))
+ (message-remove-header "gcc")
+ (when gcc
+ (goto-char (point-max))
+ (cond ((eq self 'none))
+ ((eq self t)
+ (insert "Gcc: \"" gnus-newsgroup-name "\"\n"))
+ ((stringp self)
+ (insert "Gcc: "
+ (mm-encode-coding-string
+ (if (string-match " " self)
+ (concat "\"" self "\"")
+ self)
+ (gnus-group-name-charset (gnus-inews-group-method self)
+ self))
+ "\n"))
+ ((null self)
+ (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))
+ ((eq self 'no-gcc-self)
+ (when (setq gcc (delete
+ gnus-newsgroup-name
+ (delete (concat "\"" gnus-newsgroup-name "\"")
+ gcc)))
+ (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n")))))))
+
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
(interactive
@@ -1277,12 +1370,41 @@ For the \"inline\" alternatives, also see the variable
(with-current-buffer gnus-original-article-buffer
(nnmail-fetch-field "to"))))
current-prefix-arg))
- (dolist (article (gnus-summary-work-articles n))
- (gnus-summary-select-article nil nil nil article)
- (with-current-buffer gnus-original-article-buffer
- (let ((gnus-gcc-externalize-attachments nil))
- (message-resend address)))
- (gnus-summary-mark-article-as-forwarded article)))
+ (let ((message-header-setup-hook (copy-sequence message-header-setup-hook))
+ (message-sent-hook (copy-sequence message-sent-hook))
+ ;; Honor posting-style for `name' and `address' in Resent-From header.
+ (styles (gnus-group-find-parameter gnus-newsgroup-name
+ 'posting-style t))
+ (user-full-name user-full-name)
+ (user-mail-address user-mail-address)
+ tem)
+ (dolist (style styles)
+ (when (stringp (cadr style))
+ (setcdr style (list (mm-decode-coding-string (cadr style) 'utf-8)))))
+ (dolist (style (if styles
+ (append gnus-posting-styles (list (cons ".*" styles)))
+ gnus-posting-styles))
+ (when (string-match (pop style) gnus-newsgroup-name)
+ (when (setq tem (cadr (assq 'name style)))
+ (setq user-full-name tem))
+ (when (setq tem (cadr (assq 'address style)))
+ (setq user-mail-address tem))))
+ ;; `gnus-summary-resend-message-insert-gcc' must run last.
+ (add-hook 'message-header-setup-hook
+ 'gnus-summary-resend-message-insert-gcc t)
+ (add-hook 'message-sent-hook
+ `(lambda ()
+ (let ((rfc2047-encode-encoded-words nil))
+ ,(if gnus-agent
+ '(gnus-agent-possibly-do-gcc)
+ '(gnus-inews-do-gcc)))))
+ (dolist (article (gnus-summary-work-articles n))
+ (gnus-summary-select-article nil nil nil article)
+ (with-current-buffer gnus-original-article-buffer
+ (let ((gnus-gcc-externalize-attachments nil)
+ (message-inhibit-body-encoding t))
+ (message-resend address)))
+ (gnus-summary-mark-article-as-forwarded article))))
;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
(defun gnus-summary-resend-message-edit ()
@@ -1354,33 +1476,6 @@ See `gnus-summary-mail-forward' for ARG."
(when (gnus-y-or-n-p "Send this complaint? ")
(message-send-and-exit))))))
-(defun gnus-mail-parse-comma-list ()
- (let (accumulated
- beg)
- (skip-chars-forward " ")
- (while (not (eobp))
- (setq beg (point))
- (skip-chars-forward "^,")
- (while (zerop
- (save-excursion
- (save-restriction
- (let ((i 0))
- (narrow-to-region beg (point))
- (goto-char beg)
- (logand (progn
- (while (search-forward "\"" nil t)
- (incf i))
- (if (zerop i) 2 i))
- 2)))))
- (skip-chars-forward ",")
- (skip-chars-forward "^,"))
- (skip-chars-backward " ")
- (push (buffer-substring beg (point))
- accumulated)
- (skip-chars-forward "^,")
- (skip-chars-forward ", "))
- accumulated))
-
(defun gnus-inews-add-to-address (group)
(let ((to-address (mail-fetch-field "to")))
(when (and to-address
@@ -1391,41 +1486,6 @@ See `gnus-summary-mail-forward' for ARG."
(format "Do you want to add this as `to-list': %s? " to-address))
(gnus-group-add-parameter group (cons 'to-list to-address))))))
-(defun gnus-put-message ()
- "Put the current message in some group and return to Gnus."
- (interactive)
- (let ((reply gnus-article-reply)
- (winconf gnus-prev-winconf)
- (group gnus-newsgroup-name))
- (unless (and group
- (not (gnus-group-read-only-p group)))
- (setq group (read-string "Put in group: " nil (gnus-writable-groups))))
-
- (when (gnus-group-entry group)
- (error "No such group: %s" group))
- (save-excursion
- (save-restriction
- (widen)
- (message-narrow-to-headers)
- (let ((gnus-deletable-headers nil))
- (message-generate-headers
- (if (message-news-p)
- message-required-news-headers
- message-required-mail-headers)))
- (goto-char (point-max))
- (if (string-match " " group)
- (insert "Gcc: \"" group "\"\n")
- (insert "Gcc: " group "\n"))
- (widen)))
- (gnus-inews-do-gcc)
- (when (and (get-buffer gnus-group-buffer)
- (gnus-buffer-exists-p (car-safe reply))
- (cdr reply))
- (set-buffer (car reply))
- (gnus-summary-mark-article-as-replied (cdr reply)))
- (when winconf
- (set-window-configuration winconf))))
-
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
If YANK is non-nil, include the original article."
@@ -1447,7 +1507,6 @@ If YANK is non-nil, include the original article."
(error "Gnus has been shut down"))
(gnus-setup-message (if (message-mail-user-agent) 'message 'bug)
(unless (message-mail-user-agent)
- (delete-other-windows)
(when gnus-bug-create-help-buffer
(switch-to-buffer "*Gnus Help Bug*")
(erase-buffer)
@@ -1575,7 +1634,9 @@ this is a reply."
(nnheader-set-temp-buffer " *acc*")
(setq message-options (with-current-buffer cur message-options))
(insert-buffer-substring cur)
+ (run-hooks 'gnus-gcc-pre-body-encode-hook)
(message-encode-message-body)
+ (run-hooks 'gnus-gcc-post-body-encode-hook)
(save-restriction
(message-narrow-to-headers)
(let* ((mail-parse-charset message-default-charset)
@@ -1624,12 +1685,16 @@ this is a reply."
(when (and group-art
;; FIXME: Should gcc-mark-as-read work when
;; Gnus is not running?
- (gnus-alive-p)
- (or gnus-gcc-mark-as-read
- (and
- (boundp 'gnus-inews-mark-gcc-as-read)
- (symbol-value 'gnus-inews-mark-gcc-as-read))))
- (gnus-group-mark-article-read group (cdr group-art)))
+ (gnus-alive-p))
+ (if (or gnus-gcc-mark-as-read
+ (and (boundp 'gnus-inews-mark-gcc-as-read)
+ (symbol-value 'gnus-inews-mark-gcc-as-read)))
+ (gnus-group-mark-article-read group (cdr group-art))
+ (with-current-buffer gnus-group-buffer
+ (let ((gnus-group-marked (list group))
+ (gnus-get-new-news-hook nil)
+ (inhibit-read-only t))
+ (gnus-group-get-new-news-this-group nil t)))))
(setq options message-options)
(with-current-buffer cur (setq message-options options))
(kill-buffer (current-buffer)))))))))
@@ -1659,17 +1724,19 @@ this is a reply."
((functionp var)
;; A function.
(funcall var group))
- (t
+ (group
;; An alist of regexps/functions/forms.
(while (and var
(not
(setq result
(cond
- ((stringp (caar var))
+ ((and group
+ (stringp (caar var)))
;; Regexp.
(when (string-match (caar var) group)
(cdar var)))
- ((functionp (car var))
+ ((and group
+ (functionp (car var)))
;; Function.
(funcall (car var) group))
(t
@@ -1745,6 +1812,10 @@ this is a reply."
(when gnus-newsgroup-name
(let ((tmp-style (gnus-group-find-parameter group 'posting-style t)))
(when tmp-style
+ (dolist (style tmp-style)
+ (when (stringp (cadr style))
+ (setcdr style (list (mm-decode-coding-string (cadr style)
+ 'utf-8)))))
(setq styles (append styles (list (cons ".*" tmp-style)))))))
;; Go through all styles and look for matches.
(dolist (style styles)
diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
new file mode 100644
index 00000000000..3848dee8d4f
--- /dev/null
+++ b/lisp/gnus/gnus-notifications.el
@@ -0,0 +1,190 @@
+;; gnus-notifications.el -- Send notification on new message in Gnus
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Julien Danjou <julien@danjou.info>
+;; Keywords: news
+
+;; 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 implements notifications using `notifications-notify' on new
+;; messages received.
+;; Use (add-hook 'gnus-after-getting-new-news-hook 'gnus-notifications)
+;; to get notifications just after getting the new news.
+
+;;; Code:
+
+(ignore-errors
+ (require 'notifications))
+(require 'gnus-sum)
+(require 'gnus-group)
+(require 'gnus-int)
+(require 'gnus-art)
+(require 'gnus-util)
+(ignore-errors
+ (require 'google-contacts)) ; Optional
+(require 'gnus-fun)
+
+(defgroup gnus-notifications nil
+ "Send notifications on new message in Gnus."
+ :version "24.3"
+ :group 'gnus)
+
+(defcustom gnus-notifications-use-google-contacts t
+ "Use Google Contacts to retrieve photo."
+ :type 'boolean
+ :group 'gnus-notifications)
+
+(defcustom gnus-notifications-use-gravatar t
+ "Use Gravatar to retrieve photo."
+ :type 'boolean
+ :group 'gnus-notifications)
+
+(defcustom gnus-notifications-minimum-level 1
+ "Minimum group level the message should have to be notified.
+Any message in a group that has a greater value than this will
+not get notifications."
+ :type 'integer
+ :group 'gnus-notifications)
+
+(defcustom gnus-notifications-timeout nil
+ "Timeout used for notifications sent via `notifications-notify'."
+ :type 'integer
+ :group 'gnus-notifications)
+
+(defvar gnus-notifications-sent nil
+ "Notifications already sent.")
+
+(defvar gnus-notifications-id-to-msg nil
+ "Map notifications ids to messages.")
+
+(defun gnus-notifications-action (id key)
+ (when (string= key "read")
+ (let ((group-article (assoc id gnus-notifications-id-to-msg)))
+ (when group-article
+ (let ((group (cadr group-article))
+ (article (nth 2 group-article)))
+ (gnus-fetch-group group (list article)))))))
+
+(defun gnus-notifications-notify (from subject photo-file)
+ "Send a notification about a new mail.
+Return a notification id if any, or t on success."
+ (if (fboundp 'notifications-notify)
+ (gnus-funcall-no-warning
+ 'notifications-notify
+ :title from
+ :body subject
+ :actions '("read" "Read")
+ :on-action 'gnus-notifications-action
+ :app-icon (gnus-funcall-no-warning
+ 'image-search-load-path "gnus/gnus.png")
+ :app-name "Gnus"
+ :category "email.arrived"
+ :timeout gnus-notifications-timeout
+ :image-path photo-file)
+ (message "New message from %s: %s" from subject)
+ ;; Don't return an id
+ t))
+
+(defun gnus-notifications-get-photo (mail-address)
+ "Get photo for mail address."
+ (let ((google-photo (when (and gnus-notifications-use-google-contacts
+ (fboundp 'google-contacts-get-photo))
+ (ignore-errors
+ (gnus-funcall-no-warning
+ 'google-contacts-get-photo mail-address)))))
+ (if google-photo
+ google-photo
+ (when gnus-notifications-use-gravatar
+ (let ((gravatar (ignore-errors
+ (gravatar-retrieve-synchronously mail-address))))
+ (if (eq gravatar 'error)
+ nil
+ (plist-get (cdr gravatar) :data)))))))
+
+(defun gnus-notifications-get-photo-file (mail-address)
+ "Get a temporary file with an image for MAIL-ADDRESS.
+You have to delete the temporary image yourself using
+`delete-image'.
+
+Returns nil if no image found."
+ (let ((photo (gnus-notifications-get-photo mail-address)))
+ (when photo
+ (let ((photo-file (make-temp-file "gnus-notifications-photo-"))
+ (coding-system-for-write 'binary))
+ (with-temp-file photo-file
+ (insert photo))
+ photo-file))))
+
+;;;###autoload
+(defun gnus-notifications ()
+ "Send a notification on new message.
+This check for new messages that are in group with a level lower
+or equal to `gnus-notifications-minimum-level' and send a
+notification using `notifications-notify' for it.
+
+This is typically a function to add in
+`gnus-after-getting-new-news-hook'"
+ (dolist (entry gnus-newsrc-alist)
+ (let ((group (car entry)))
+ ;; Check that the group level is less than
+ ;; `gnus-notifications-minimum-level' and the the group has unread
+ ;; messages.
+ (when (and (<= (gnus-group-level group) gnus-notifications-minimum-level)
+ (let ((unread (gnus-group-unread group)))
+ (and (numberp unread)
+ (> unread 0))))
+ ;; Each group should have an entry in the `gnus-notifications-sent'
+ ;; alist. If not, we add one at this time.
+ (let ((group-notifications (or (assoc group gnus-notifications-sent)
+ ;; Nothing, add one and return it.
+ (assoc group
+ (add-to-list
+ 'gnus-notifications-sent
+ (cons group nil))))))
+ (dolist (article (gnus-list-of-unread-articles group))
+ ;; Check if the article already has been notified
+ (unless (memq article (cdr group-notifications))
+ (with-current-buffer nntp-server-buffer
+ (gnus-request-head article group)
+ (article-decode-encoded-words) ; to decode mail addresses, subjects, etc
+ (let* ((address-components (mail-extract-address-components
+ (or (mail-fetch-field "From") "")))
+ (address (cadr address-components)))
+ ;; Ignore mails from ourselves
+ (unless (and gnus-ignored-from-addresses
+ address
+ (gnus-string-match-p gnus-ignored-from-addresses
+ address))
+ (let* ((photo-file (gnus-notifications-get-photo-file address))
+ (notification-id (gnus-notifications-notify
+ (or (car address-components) address)
+ (mail-fetch-field "Subject")
+ photo-file)))
+ (when notification-id
+ ;; Register that we did notify this message
+ (setcdr group-notifications (cons article (cdr group-notifications)))
+ (unless (eq notification-id t)
+ ;; Register the notification id for later actions
+ (add-to-list 'gnus-notifications-id-to-msg (list notification-id group article))))
+ (when photo-file
+ (delete-file photo-file)))))))))))))
+
+(provide 'gnus-notifications)
+
+;;; gnus-notifications.el ends here
diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el
index dc6feeec0ab..44f56b5acf3 100644
--- a/lisp/gnus/gnus-picon.el
+++ b/lisp/gnus/gnus-picon.el
@@ -1,6 +1,6 @@
;;; gnus-picon.el --- displaying pretty icons in Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news xpm annotation glyph faces
@@ -75,6 +75,12 @@ Some people may want to add \"unknown\" to this list."
:type '(repeat string)
:group 'gnus-picon)
+(defcustom gnus-picon-properties '(:color-symbols (("None" . "white")))
+ "List of image properties applied to picons."
+ :type 'list
+ :version "24.3"
+ :group 'gnus-picon)
+
(defcustom gnus-picon-style 'inline
"How should picons be displayed.
If `inline', the textual representation is replaced. If `right', picons are
@@ -87,6 +93,7 @@ added right to the textual representation."
(defcustom gnus-picon-inhibit-top-level-domains t
"If non-nil, don't piconify top-level domains.
These are often not very interesting."
+ :version "24.1"
:type 'boolean
:group 'gnus-picon)
@@ -156,9 +163,9 @@ replacement is added."
(defun gnus-picon-create-glyph (file)
(or (cdr (assoc file gnus-picon-glyph-alist))
- (cdar (push (cons file (gnus-create-image
- file nil nil
- :color-symbols '(("None" . "white"))))
+ (cdar (push (cons file (apply 'gnus-create-image
+ file nil nil
+ gnus-picon-properties))
gnus-picon-glyph-alist))))
;;; Functions that does picon transformations:
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index ce5a837eaef..091276ee4f8 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -1,6 +1,6 @@
;;; gnus-range.el --- range and sequence functions for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -52,11 +52,13 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
(defun gnus-set-difference (list1 list2)
"Return a list of elements of LIST1 that do not appear in LIST2."
- (let ((list1 (copy-sequence list1)))
- (while list2
- (setq list1 (delq (car list2) list1))
- (setq list2 (cdr list2)))
- list1))
+ (let ((hash2 (make-hash-table :test 'eq))
+ (result nil))
+ (dolist (elt list2) (puthash elt t hash2))
+ (dolist (elt list1)
+ (unless (gethash elt hash2)
+ (setq result (cons elt result))))
+ (nreverse result)))
(defun gnus-range-nconcat (&rest ranges)
"Return a range comprising all the RANGES, which are pre-sorted.
@@ -592,15 +594,6 @@ LIST is a sorted list."
(setq sum
(+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
-(defun gnus-sublist-p (list sublist)
- "Test whether all elements in SUBLIST are members of LIST."
- (let ((sublistp t))
- (while sublist
- (unless (memq (pop sublist) list)
- (setq sublistp nil
- sublist nil)))
- sublistp))
-
(defun gnus-range-add (range1 range2)
"Add RANGE2 to RANGE1 (nondestructively)."
(unless (listp (cdr range1))
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index d25b8b1d24b..71e00967548 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -1,6 +1,6 @@
;;; gnus-registry.el --- article registry for Gnus
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news registry
@@ -78,12 +78,6 @@
(eval-when-compile (require 'cl))
-(eval-when-compile
- (when (null (ignore-errors (require 'ert)))
- (defmacro* ert-deftest (name () &body docstring-keys-and-body))))
-
-(ignore-errors
- (require 'ert))
(require 'gnus)
(require 'gnus-int)
(require 'gnus-sum)
@@ -96,7 +90,7 @@
(defvar gnus-adaptive-word-syntax-table)
(defvar gnus-registry-dirty t
- "Boolean set to t when the registry is modified")
+ "Boolean set to t when the registry is modified.")
(defgroup gnus-registry nil
"The Gnus registry."
@@ -142,6 +136,7 @@ display.")
The addresses are matched, they don't have to be fully qualified.
In the messages, these addresses can be the sender or the
recipients."
+ :version "24.1"
:group 'gnus-registry
:type '(repeat regexp))
@@ -243,6 +238,7 @@ the Bit Bucket."
(defcustom gnus-registry-max-pruned-entries nil
"Maximum number of pruned entries in the registry, nil for unlimited."
+ :version "24.1"
:group 'gnus-registry
:type '(radio (const :format "Unlimited " nil)
(integer :format "Maximum number: %v")))
@@ -265,7 +261,7 @@ the Bit Bucket."
(append gnus-registry-track-extra
'(mark group keyword)))
(when (not (equal old (oref db :tracked)))
- (gnus-message 4 "Reindexing the Gnus registry (tracked change)")
+ (gnus-message 9 "Reindexing the Gnus registry (tracked change)")
(registry-reindex db))))
db)
@@ -282,7 +278,7 @@ the Bit Bucket."
:tracked nil)))
(defvar gnus-registry-db (gnus-registry-make-db)
- "*The article registry by Message ID. See `registry-db'")
+ "The article registry by Message ID. See `registry-db'.")
;; top-level registry data management
(defun gnus-registry-remake-db (&optional forsure)
@@ -416,9 +412,9 @@ This is not required after changing `gnus-registry-cache-file'."
;; Function for nn{mail|imap}-split-fancy: look up all references in
;; the cache and if a match is found, return that group.
(defun gnus-registry-split-fancy-with-parent ()
- "Split this message into the same group as its parent. The parent
-is obtained from the registry. This function can be used as an entry
-in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
+ "Split this message into the same group as its parent.
+The parent is obtained from the registry. This function can be used as an
+entry in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
this: (: gnus-registry-split-fancy-with-parent)
This function tracks ALL backends, unlike
@@ -744,7 +740,7 @@ Overrides existing keywords with FORCE set non-nil."
(registry-lookup-secondary-value gnus-registry-db 'keyword keyword))
(defun gnus-registry-register-message-ids ()
- "Register the Message-ID of every article in the group"
+ "Register the Message-ID of every article in the group."
(unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
(dolist (article gnus-newsgroup-articles)
(let* ((id (gnus-registry-fetch-message-id-fast article))
@@ -759,7 +755,7 @@ Overrides existing keywords with FORCE set non-nil."
;; message field fetchers
(defun gnus-registry-fetch-message-id-fast (article)
- "Fetch the Message-ID quickly, using the internal gnus-data-list function"
+ "Fetch the Message-ID quickly, using the internal gnus-data-list function."
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
(mail-header-id (gnus-data-header (assoc article (gnus-data-list nil))))
@@ -791,7 +787,7 @@ Addresses without a name will say \"noname\"."
nil))
(defun gnus-registry-fetch-simplified-message-subject-fast (article)
- "Fetch the Subject quickly, using the internal gnus-data-list function"
+ "Fetch the Subject quickly, using the internal gnus-data-list function."
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
(gnus-string-remove-all-properties
@@ -809,7 +805,7 @@ Addresses without a name will say \"noname\"."
(or (ignore-errors (gnus-registry-fetch-header-fast "To" article)) "")))
(defun gnus-registry-fetch-header-fast (article header)
- "Fetch the HEADER quickly, using the internal gnus-data-list function"
+ "Fetch the HEADER quickly, using the internal gnus-data-list function."
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
(gnus-string-remove-all-properties
@@ -829,7 +825,34 @@ FUNCTION should take two parameters, a mark symbol and the cell value."
(when cell-data
(funcall function mark cell-data)))))
-;;; this is ugly code, but I don't know how to do it better
+;; FIXME: Why not merge gnus-registry--set/remove-mark and
+;; gnus-registry-set-article-mark-internal?
+(defun gnus-registry--set/remove-mark (remove mark articles)
+ "Set/remove the MARK over process-marked ARTICLES."
+ ;; If this is called and the user doesn't want the
+ ;; registry enabled, we'll ask anyhow.
+ (unless gnus-registry-install
+ (let ((gnus-registry-install 'ask))
+ (gnus-registry-install-p)))
+
+ ;; Now the user is asked if gnus-registry-install is `ask'.
+ (when (gnus-registry-install-p)
+ (gnus-registry-set-article-mark-internal
+ ;; All this just to get the mark, I must be doing it wrong.
+ mark articles remove t)
+ ;; FIXME: Why do we do the above only here and not directly inside
+ ;; gnus-registry-set-article-mark-internal? I.e. we wouldn't we want to do
+ ;; the things below when gnus-registry-set-article-mark-internal is called
+ ;; from gnus-registry-set-article-mark or
+ ;; gnus-registry-remove-article-mark?
+ (gnus-message 9 "Applying mark %s to %d articles"
+ mark (length articles))
+ (dolist (article articles)
+ (gnus-summary-update-article
+ article
+ (assoc article (gnus-data-list nil))))))
+
+;; This is ugly code, but I don't know how to do it better.
(defun gnus-registry-install-shortcuts ()
"Install the keyboard shortcuts and menus for the registry.
Uses `gnus-registry-marks' to find what shortcuts to install."
@@ -841,69 +864,41 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
(let ((function-format
(format "gnus-registry-%%s-article-%s-mark" mark)))
-;;; The following generates these functions:
-;;; (defun gnus-registry-set-article-Important-mark (&rest articles)
-;;; "Apply the Important mark to process-marked ARTICLES."
-;;; (interactive (gnus-summary-work-articles current-prefix-arg))
-;;; (gnus-registry-set-article-mark-internal 'Important articles nil t))
-;;; (defun gnus-registry-remove-article-Important-mark (&rest articles)
-;;; "Apply the Important mark to process-marked ARTICLES."
-;;; (interactive (gnus-summary-work-articles current-prefix-arg))
-;;; (gnus-registry-set-article-mark-internal 'Important articles t t))
+;;; The following generates these functions:
+;;; (defun gnus-registry-set-article-Important-mark (&rest articles)
+;;; "Apply the Important mark to process-marked ARTICLES."
+;;; (interactive (gnus-summary-work-articles current-prefix-arg))
+;;; (gnus-registry-set-article-mark-internal 'Important articles nil t))
+;;; (defun gnus-registry-remove-article-Important-mark (&rest articles)
+;;; "Apply the Important mark to process-marked ARTICLES."
+;;; (interactive (gnus-summary-work-articles current-prefix-arg))
+;;; (gnus-registry-set-article-mark-internal 'Important articles t t))
(dolist (remove '(t nil))
(let* ((variant-name (if remove "remove" "set"))
- (function-name (format function-format variant-name))
- (shortcut (format "%c" data))
- (shortcut (if remove (upcase shortcut) shortcut)))
- (unintern function-name obarray)
- (eval
- `(defun
- ;; function name
- ,(intern function-name)
- ;; parameter definition
- (&rest articles)
- ;; documentation
- ,(format
- "%s the %s mark over process-marked ARTICLES."
- (upcase-initials variant-name)
- mark)
- ;; interactive definition
- (interactive
- (gnus-summary-work-articles current-prefix-arg))
- ;; actual code
-
- ;; if this is called and the user doesn't want the
- ;; registry enabled, we'll ask anyhow
- (unless gnus-registry-install
- (let ((gnus-registry-install 'ask))
- (gnus-registry-install-p)))
-
- ;; now the user is asked if gnus-registry-install is 'ask
- (when (gnus-registry-install-p)
- (gnus-registry-set-article-mark-internal
- ;; all this just to get the mark, I must be doing it wrong
- (intern ,(symbol-name mark))
- articles ,remove t)
- (gnus-message
- 9
- "Applying mark %s to %d articles"
- ,(symbol-name mark) (length articles))
- (dolist (article articles)
- (gnus-summary-update-article
- article
- (assoc article (gnus-data-list nil)))))))
- (push (intern function-name) keys-plist)
+ (function-name
+ (intern (format function-format variant-name)))
+ (shortcut (format "%c" (if remove (upcase data) data))))
+ (defalias function-name
+ ;; If it weren't for the function's docstring, we could
+ ;; use a closure, with lexical-let :-(
+ `(lambda (&rest articles)
+ ,(format
+ "%s the %s mark over process-marked ARTICLES."
+ (upcase-initials variant-name)
+ mark)
+ (interactive
+ (gnus-summary-work-articles current-prefix-arg))
+ (gnus-registry--set/remove-mark ',mark ',remove articles)))
+ (push function-name keys-plist)
(push shortcut keys-plist)
(push (vector (format "%s %s"
(upcase-initials variant-name)
(symbol-name mark))
- (intern function-name) t)
+ function-name t)
gnus-registry-misc-menus)
- (gnus-message
- 9
- "Defined mark handling function %s"
- function-name))))))
+ (gnus-message 9 "Defined mark handling function %s"
+ function-name))))))
(gnus-define-keys-1
'(gnus-registry-mark-map "M" gnus-summary-mark-map)
keys-plist)
@@ -923,7 +918,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
;; use like this:
;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
(defun gnus-registry-article-marks-to-chars (headers)
- "Show the marks for an article by the :char property"
+ "Show the marks for an article by the :char property."
(let* ((id (mail-header-message-id headers))
(marks (when id (gnus-registry-get-id-key id 'mark))))
(mapconcat (lambda (mark)
@@ -936,7 +931,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
;; use like this:
;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
(defun gnus-registry-article-marks-to-names (headers)
- "Show the marks for an article by name"
+ "Show the marks for an article by name."
(let* ((id (mail-header-message-id headers))
(marks (when id (gnus-registry-get-id-key id 'mark))))
(mapconcat (lambda (mark) (symbol-name mark)) marks ",")))
@@ -1076,88 +1071,16 @@ only the last one's marks are returned."
(gnus-registry-set-id-key id key val))))
(message "Import done, collected %d entries" count))))
-(ert-deftest gnus-registry-misc-test ()
- (should-error (gnus-registry-extract-addresses '("" "")))
-
- (should (equal '("Ted Zlatanov <tzz@lifelogs.com>"
- "noname <ed@you.me>"
- "noname <cyd@stupidchicken.com>"
- "noname <tzz@lifelogs.com>")
- (gnus-registry-extract-addresses
- (concat "Ted Zlatanov <tzz@lifelogs.com>, "
- "ed <ed@you.me>, " ; "ed" is not a valid name here
- "cyd@stupidchicken.com, "
- "tzz@lifelogs.com")))))
-
-(ert-deftest gnus-registry-usage-test ()
- (let* ((n 100)
- (tempfile (make-temp-file "gnus-registry-persist"))
- (db (gnus-registry-make-db tempfile))
- (gnus-registry-db db)
- back size)
- (message "Adding %d keys to the test Gnus registry" n)
- (dotimes (i n)
- (let ((id (number-to-string i)))
- (gnus-registry-handle-action id
- (if (>= 50 i) "fromgroup" nil)
- "togroup"
- (when (>= 70 i)
- (format "subject %d" (mod i 10)))
- (when (>= 80 i)
- (format "sender %d" (mod i 10))))))
- (message "Testing Gnus registry size is %d" n)
- (should (= n (registry-size db)))
- (message "Looking up individual keys (registry-lookup)")
- (should (equal (loop for e
- in (mapcar 'cadr
- (registry-lookup db '("20" "83" "72")))
- collect (assq 'subject e)
- collect (assq 'sender e)
- collect (assq 'group e))
- '((subject "subject 0") (sender "sender 0") (group "togroup")
- (subject) (sender) (group "togroup")
- (subject) (sender "sender 2") (group "togroup"))))
-
- (message "Looking up individual keys (gnus-registry-id-key)")
- (should (equal (gnus-registry-get-id-key "34" 'group) '("togroup")))
- (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4")))
- (message "Trying to insert a duplicate key")
- (should-error (gnus-registry-insert db "55" '()))
- (message "Looking up individual keys (gnus-registry-get-or-make-entry)")
- (should (gnus-registry-get-or-make-entry "22"))
- (message "Saving the Gnus registry to %s" tempfile)
- (should (gnus-registry-save tempfile db))
- (setq size (nth 7 (file-attributes tempfile)))
- (message "Saving the Gnus registry to %s: size %d" tempfile size)
- (should (< 0 size))
- (with-temp-buffer
- (insert-file-contents-literally tempfile)
- (should (looking-at (concat ";; Object "
- "Gnus Registry"
- "\n;; EIEIO PERSISTENT OBJECT"))))
- (message "Reading Gnus registry back")
- (setq back (eieio-persistent-read tempfile))
- (should back)
- (message "Read Gnus registry back: %d keys, expected %d==%d"
- (registry-size back) n (registry-size db))
- (should (= (registry-size back) n))
- (should (= (registry-size back) (registry-size db)))
- (delete-file tempfile)
- (message "Pruning Gnus registry to 0 by setting :max-soft")
- (oset db :max-soft 0)
- (registry-prune db)
- (should (= (registry-size db) 0)))
- (message "Done with Gnus registry usage testing."))
-
;;;###autoload
(defun gnus-registry-initialize ()
-"Initialize the Gnus registry."
+ "Initialize the Gnus registry."
(interactive)
(gnus-message 5 "Initializing the registry")
(gnus-registry-install-hooks)
(gnus-registry-install-shortcuts)
(gnus-registry-read))
+;; FIXME: Why autoload this function?
;;;###autoload
(defun gnus-registry-install-hooks ()
"Install the registry hooks."
@@ -1204,6 +1127,53 @@ the user is asked first. Returns non-nil iff the registry is enabled."
(gnus-registry-initialize)))
gnus-registry-enabled)
+;; largely based on nnir-warp-to-article
+(defun gnus-try-warping-via-registry ()
+ "Try to warp via the registry.
+This will be done via the current article's source group based on
+data stored in the registry."
+ (interactive)
+ (when (gnus-summary-article-header)
+ (let* ((message-id (mail-header-id (gnus-summary-article-header)))
+ ;; Retrieve the message's group(s) from the registry
+ (groups (gnus-registry-get-id-key message-id 'group))
+ ;; If starting from an ephemeral group, this describes
+ ;; how to restore the window configuration
+ (quit-config
+ (gnus-ephemeral-group-p gnus-newsgroup-name))
+ (seen-groups (list (gnus-group-group-name))))
+
+ (catch 'found
+ (dolist (group (mapcar 'gnus-simplify-group-name groups))
+
+ ;; skip over any groups we really don't want to warp to.
+ (unless (or (member group seen-groups)
+ (gnus-ephemeral-group-p group) ;; any ephemeral group
+ (memq (car (gnus-find-method-for-group group))
+ ;; Specific methods; this list may need to expand.
+ '(nnir)))
+
+ ;; remember that we've seen this group already
+ (push group seen-groups)
+
+ ;; first exit from any ephemeral summary buffer.
+ (when quit-config
+ (gnus-summary-exit)
+ ;; and if the ephemeral summary buffer in turn came from
+ ;; another summary buffer we have to clean that summary
+ ;; up too.
+ (when (eq (cdr quit-config) 'summary)
+ (gnus-summary-exit))
+ ;; remember that we've already done this part
+ (setq quit-config nil))
+
+ ;; Try to activate the group. If that fails, just move
+ ;; along. We may have more groups to work with
+ (when
+ (ignore-errors
+ (gnus-select-group-with-message-id group message-id) t)
+ (throw 'found t))))))))
+
;; TODO: a few things
(provide 'gnus-registry)
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index 43a8eba4bed..760a7a0942e 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -1,6 +1,6 @@
;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
-;; Copyright (C) 1996-1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -536,12 +536,6 @@ Two predefined functions are available:
(when pos
(cons pos (next-single-property-change pos 'gnus-number)))))
-(defun gnus-tree-goto-article (article)
- (let ((pos (text-property-any
- (point-min) (point-max) 'gnus-number article)))
- (when pos
- (goto-char pos))))
-
(defun gnus-tree-recenter ()
"Center point in the tree window."
(let ((selected (selected-window))
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index d8e424eacc8..b7061960839 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -1,6 +1,6 @@
;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -947,25 +947,6 @@ EXTRA is the possible non-standard header."
(gnus-summary-raise-score score))))
(beginning-of-line 2))))
(gnus-set-mode-line 'summary))
-
-(defun gnus-summary-score-crossposting (score date)
- ;; Enter score file entry for current crossposting.
- ;; SCORE is the score to add.
- ;; DATE is the expire date.
- (let ((xref (gnus-summary-header "xref"))
- (start 0)
- group)
- (unless xref
- (error "This article is not crossposted"))
- (while (string-match " \\([^ \t]+\\):" xref start)
- (setq start (match-end 0))
- (when (not (string=
- (setq group
- (substring xref (match-beginning 1) (match-end 1)))
- gnus-newsgroup-name))
- (gnus-summary-score-entry
- "xref" (concat " " group ":") nil score date t)))))
-
;;;
;;; Gnus Score Files
@@ -1736,105 +1717,141 @@ score in `gnus-newsgroup-scored' by SCORE."
(setq entries rest)))))
nil)
+(defun gnus-score-decode-text-parts ()
+ (labels ((mm-text-parts (handle)
+ (cond ((stringp (car handle))
+ (let ((parts (mapcan #'mm-text-parts (cdr handle))))
+ (if (equal "multipart/alternative" (car handle))
+ ;; pick the first supported alternative
+ (list (car parts))
+ parts)))
+
+ ((bufferp (car handle))
+ (when (string-match "^text/" (mm-handle-media-type handle))
+ (list handle)))
+
+ (t (mapcan #'mm-text-parts handle))))
+ (my-mm-display-part (handle)
+ (when handle
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mm-display-inline handle)
+ (goto-char (point-max))))))
+
+ (let (;(mm-text-html-renderer 'w3m-standalone)
+ (handles (mm-dissect-buffer t)))
+ (save-excursion
+ (article-goto-body)
+ (delete-region (point) (point-max))
+ (mapc #'my-mm-display-part (mm-text-parts handles))
+ handles))))
+
(defun gnus-score-body (scores header now expire &optional trace)
- (if gnus-agent-fetching
- nil
- (save-excursion
- (setq gnus-scores-articles
- (sort gnus-scores-articles
- (lambda (a1 a2)
- (< (mail-header-number (car a1))
- (mail-header-number (car a2))))))
- (set-buffer nntp-server-buffer)
- (save-restriction
- (let* ((buffer-read-only nil)
- (articles gnus-scores-articles)
- (all-scores scores)
- (request-func (cond ((string= "head" header)
- 'gnus-request-head)
- ((string= "body" header)
- 'gnus-request-body)
- (t 'gnus-request-article)))
- entries alist ofunc article last)
- (when articles
- (setq last (mail-header-number (caar (last articles))))
- ;; Not all backends support partial fetching. In that case,
- ;; we just fetch the entire article.
- (unless (gnus-check-backend-function
- (and (string-match "^gnus-" (symbol-name request-func))
- (intern (substring (symbol-name request-func)
- (match-end 0))))
- gnus-newsgroup-name)
- (setq ofunc request-func)
- (setq request-func 'gnus-request-article))
- (while articles
- (setq article (mail-header-number (caar articles)))
- (gnus-message 7 "Scoring article %s of %s..." article last)
- (widen)
- (when (funcall request-func article gnus-newsgroup-name)
- (goto-char (point-min))
- ;; If just parts of the article is to be searched, but the
- ;; backend didn't support partial fetching, we just narrow
- ;; to the relevant parts.
- (when ofunc
- (if (eq ofunc 'gnus-request-head)
- (narrow-to-region
- (point)
- (or (search-forward "\n\n" nil t) (point-max)))
- (narrow-to-region
- (or (search-forward "\n\n" nil t) (point))
- (point-max))))
- (setq scores all-scores)
- ;; Find matches.
- (while scores
- (setq alist (pop scores)
- entries (assoc header alist))
- (while (cdr entries) ;First entry is the header index.
- (let* ((rest (cdr entries))
- (kill (car rest))
- (match (nth 0 kill))
- (type (or (nth 3 kill) 's))
- (score (or (nth 1 kill)
- gnus-score-interactive-default-score))
- (date (nth 2 kill))
- (found nil)
- (case-fold-search
- (not (or (eq type 'R) (eq type 'S)
- (eq type 'Regexp) (eq type 'String))))
- (search-func
- (cond ((or (eq type 'r) (eq type 'R)
- (eq type 'regexp) (eq type 'Regexp))
- 're-search-forward)
- ((or (eq type 's) (eq type 'S)
- (eq type 'string) (eq type 'String))
- 'search-forward)
- (t
- (error "Invalid match type: %s" type)))))
- (goto-char (point-min))
- (when (funcall search-func match nil t)
- ;; Found a match, update scores.
- (setcdr (car articles) (+ score (cdar articles)))
- (setq found t)
- (when trace
- (push
- (cons (car-safe (rassq alist gnus-score-cache))
- kill)
- gnus-score-trace)))
- ;; Update expire date
- (unless trace
- (cond
- ((null date)) ;Permanent entry.
- ((and found gnus-update-score-entry-dates)
- ;; Match, update date.
- (gnus-score-set 'touched '(t) alist)
- (setcar (nthcdr 2 kill) now))
- ((and expire (< date expire)) ;Old entry, remove.
- (gnus-score-set 'touched '(t) alist)
- (setcdr entries (cdr rest))
- (setq rest entries))))
- (setq entries rest)))))
- (setq articles (cdr articles)))))))
- nil))
+ (if gnus-agent-fetching
+ nil
+ (save-excursion
+ (setq gnus-scores-articles
+ (sort gnus-scores-articles
+ (lambda (a1 a2)
+ (< (mail-header-number (car a1))
+ (mail-header-number (car a2))))))
+ (set-buffer nntp-server-buffer)
+ (save-restriction
+ (let* ((buffer-read-only nil)
+ (articles gnus-scores-articles)
+ (all-scores scores)
+ (request-func (cond ((string= "head" header)
+ 'gnus-request-head)
+ ((string= "body" header)
+ 'gnus-request-body)
+ (t 'gnus-request-article)))
+ entries alist ofunc article last)
+ (when articles
+ (setq last (mail-header-number (caar (last articles))))
+ ;; Not all backends support partial fetching. In that case,
+ ;; we just fetch the entire article.
+ ;; When scoring by body, we need to peek at the headers to detect
+ ;; the content encoding
+ (unless (or (gnus-check-backend-function
+ (and (string-match "^gnus-" (symbol-name request-func))
+ (intern (substring (symbol-name request-func)
+ (match-end 0))))
+ gnus-newsgroup-name)
+ (string= "body" header))
+ (setq ofunc request-func)
+ (setq request-func 'gnus-request-article))
+ (while articles
+ (setq article (mail-header-number (caar articles)))
+ (gnus-message 7 "Scoring article %s of %s..." article last)
+ (widen)
+ (let (handles)
+ (when (funcall request-func article gnus-newsgroup-name)
+ (when (string= "body" header)
+ (setq handles (gnus-score-decode-text-parts)))
+ (goto-char (point-min))
+ ;; If just parts of the article is to be searched, but the
+ ;; backend didn't support partial fetching, we just narrow
+ ;; to the relevant parts.
+ (when ofunc
+ (if (eq ofunc 'gnus-request-head)
+ (narrow-to-region
+ (point)
+ (or (search-forward "\n\n" nil t) (point-max)))
+ (narrow-to-region
+ (or (search-forward "\n\n" nil t) (point))
+ (point-max))))
+ (setq scores all-scores)
+ ;; Find matches.
+ (while scores
+ (setq alist (pop scores)
+ entries (assoc header alist))
+ (while (cdr entries) ;First entry is the header index.
+ (let* ((rest (cdr entries))
+ (kill (car rest))
+ (match (nth 0 kill))
+ (type (or (nth 3 kill) 's))
+ (score (or (nth 1 kill)
+ gnus-score-interactive-default-score))
+ (date (nth 2 kill))
+ (found nil)
+ (case-fold-search
+ (not (or (eq type 'R) (eq type 'S)
+ (eq type 'Regexp) (eq type 'String))))
+ (search-func
+ (cond ((or (eq type 'r) (eq type 'R)
+ (eq type 'regexp) (eq type 'Regexp))
+ 're-search-forward)
+ ((or (eq type 's) (eq type 'S)
+ (eq type 'string) (eq type 'String))
+ 'search-forward)
+ (t
+ (error "Invalid match type: %s" type)))))
+ (goto-char (point-min))
+ (when (funcall search-func match nil t)
+ ;; Found a match, update scores.
+ (setcdr (car articles) (+ score (cdar articles)))
+ (setq found t)
+ (when trace
+ (push
+ (cons (car-safe (rassq alist gnus-score-cache))
+ kill)
+ gnus-score-trace)))
+ ;; Update expire date
+ (unless trace
+ (cond
+ ((null date)) ;Permanent entry.
+ ((and found gnus-update-score-entry-dates)
+ ;; Match, update date.
+ (gnus-score-set 'touched '(t) alist)
+ (setcar (nthcdr 2 kill) now))
+ ((and expire (< date expire)) ;Old entry, remove.
+ (gnus-score-set 'touched '(t) alist)
+ (setcdr entries (cdr rest))
+ (setq rest entries))))
+ (setq entries rest))))
+ (when handles (mm-destroy-parts handles))))
+ (setq articles (cdr articles)))))))
+ nil))
(defun gnus-score-thread (scores header now expire &optional trace)
(gnus-score-followup scores header now expire trace t))
@@ -3028,7 +3045,7 @@ If ADAPT, return the home adaptive file instead."
(* (abs score)
gnus-score-decay-scale)))))))
(if (and (featurep 'xemacs)
- ;; XEmacs' floor can handle only the floating point
+ ;; XEmacs's floor can handle only the floating point
;; number below the half of the maximum integer.
(> (abs n) (lsh -1 -2)))
(string-to-number
@@ -3056,62 +3073,6 @@ If ADAPT, return the home adaptive file instead."
;; Return whether this score file needs to be saved. By Je-haysuss!
updated))
-(defun gnus-score-regexp-bad-p (regexp)
- "Test whether REGEXP is safe for Gnus scoring.
-A regexp is unsafe if it matches newline or a buffer boundary.
-
-If the regexp is good, return nil. If the regexp is bad, return a
-cons cell (SYM . STRING), where the symbol SYM is `new' or `bad'.
-In the `new' case, the string is a safe replacement for REGEXP.
-In the `bad' case, the string is a unsafe subexpression of REGEXP,
-and we do not have a simple replacement to suggest.
-
-See Info node `(gnus)Scoring Tips' for examples of good regular expressions."
- (let (case-fold-search)
- (and
- ;; First, try a relatively fast necessary condition.
- ;; Notice ranges (like [^:] or [\t-\r]), \s>, \Sw, \W, \', \`:
- (string-match "\n\\|\\\\[SsW`']\\|\\[\\^\\|[\0-\n]-" regexp)
- ;; Now break the regexp into tokens, and check each:
- (let ((tail regexp) ; remaining regexp to check
- tok ; current token
- bad ; nil, or bad subexpression
- new ; nil, or replacement regexp so far
- end) ; length of current token
- (while (and (not bad)
- (string-match
- "\\`\\(\\\\[sS]?.\\|\\[\\^?]?[^]]*]\\|[^\\]\\)"
- tail))
- (setq end (match-end 0)
- tok (substring tail 0 end)
- tail (substring tail end))
- (if;; Is token `bad' (matching newline or buffer ends)?
- (or (member tok '("\n" "\\W" "\\`" "\\'"))
- ;; This next handles "[...]", "\\s.", and "\\S.":
- (and (> end 2) (string-match tok "\n")))
- (let ((newtok
- ;; Try to suggest a replacement for tok ...
- (cond ((string-equal tok "\\`") "^") ; or "\\(^\\)"
- ((string-equal tok "\\'") "$") ; or "\\($\\)"
- ((string-match "\\[\\^" tok) ; very common
- (concat (substring tok 0 -1) "\n]")))))
- (if newtok
- (setq new
- (concat
- (or new
- ;; good prefix so far:
- (substring regexp 0 (- (+ (length tail) end))))
- newtok))
- ;; No replacement idea, so give up:
- (setq bad tok)))
- ;; tok is good, may need to extend new
- (and new (setq new (concat new tok)))))
- ;; Now return a value:
- (cond
- (bad (cons 'bad bad))
- (new (cons 'new new))
- (t nil))))))
-
(provide 'gnus-score)
;;; gnus-score.el ends here
diff --git a/lisp/gnus/gnus-setup.el b/lisp/gnus/gnus-setup.el
index bd7c3a77c36..67c8df6e41f 100644
--- a/lisp/gnus/gnus-setup.el
+++ b/lisp/gnus/gnus-setup.el
@@ -1,6 +1,6 @@
;;; gnus-setup.el --- Initialization & Setup for Gnus 5
-;; Copyright (C) 1995-1996, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 2000-2012 Free Software Foundation, Inc.
;; Author: Steven L. Baur <steve@miranova.com>
;; Keywords: news
diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el
index 376dd4277a0..3f600146cbf 100644
--- a/lisp/gnus/gnus-sieve.el
+++ b/lisp/gnus/gnus-sieve.el
@@ -1,6 +1,6 @@
;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: NAGY Andras <nagya@inf.elte.hu>,
;; Simon Josefsson <simon@josefsson.org>
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index 4c5715c67f9..f40177d5c60 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -1,6 +1,6 @@
;;; gnus-spec.el --- format spec functions for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -101,66 +101,13 @@ text properties. This is only needed on XEmacs, as Emacs does this anyway."
(propertize (string 8206) 'invisible t)
""))
-(defun gnus-summary-line-format-spec ()
- (insert gnus-tmp-unread gnus-tmp-replied
- gnus-tmp-score-char gnus-tmp-indentation)
- (gnus-put-text-property
- (point)
- (progn
- (insert
- (format "%c%4s: %-23s%c" gnus-tmp-opening-bracket gnus-tmp-lines
- (let ((val
- (inline
- (gnus-summary-from-or-to-or-newsgroups
- gnus-tmp-header gnus-tmp-from))))
- (if (> (length val) 23)
- (if (gnus-lrm-string-p val)
- (concat (substring val 0 23) gnus-lrm-string)
- (substring val 0 23))
- val))
- gnus-tmp-closing-bracket))
- (point))
- gnus-mouse-face-prop gnus-mouse-face)
- (insert " " gnus-tmp-subject-or-nil "\n"))
-
-(defvar gnus-summary-line-format-spec
- (gnus-byte-code 'gnus-summary-line-format-spec))
-
-(defun gnus-summary-dummy-line-format-spec ()
- (insert "* ")
- (gnus-put-text-property
- (point)
- (progn
- (insert ": :")
- (point))
- gnus-mouse-face-prop gnus-mouse-face)
- (insert " " gnus-tmp-subject "\n"))
-
-(defvar gnus-summary-dummy-line-format-spec
- (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
-
-(defun gnus-group-line-format-spec ()
- (insert gnus-tmp-marked-mark gnus-tmp-subscribed
- gnus-tmp-process-marked
- gnus-group-indentation
- (format "%5s: " gnus-tmp-number-of-unread))
- (gnus-put-text-property
- (point)
- (progn
- (insert gnus-tmp-group "\n")
- (1- (point)))
- gnus-mouse-face-prop gnus-mouse-face))
-(defvar gnus-group-line-format-spec
- (gnus-byte-code 'gnus-group-line-format-spec))
+(defvar gnus-summary-line-format-spec nil)
+(defvar gnus-summary-dummy-line-format-spec nil)
+(defvar gnus-group-line-format-spec nil)
(defvar gnus-format-specs
`((version . ,emacs-version)
- (gnus-version . ,(gnus-continuum-version))
- (group "%M\%S\%p\%P\%5y: %(%g%)\n" ,gnus-group-line-format-spec)
- (summary-dummy "* %(: :%) %S\n"
- ,gnus-summary-dummy-line-format-spec)
- (summary "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n"
- ,gnus-summary-line-format-spec))
+ (gnus-version . ,(gnus-continuum-version)))
"Alist of format specs.")
(defvar gnus-default-format-specs gnus-format-specs)
@@ -214,15 +161,6 @@ Return a list of updated types."
(not (equal emacs-version
(cdr (assq 'version gnus-format-specs)))))
(setq gnus-format-specs nil))
- ;; Flush the group format spec cache if there's the grouplens stuff
- ;; or it doesn't support decoded group names.
- (when (memq 'group types)
- (let* ((spec (assq 'group gnus-format-specs))
- (sspec (gnus-prin1-to-string (nth 2 spec))))
- (when (or (string-match " gnus-tmp-grouplens[ )]" sspec)
- (not (string-match " gnus-tmp-decoded-group[ )]" sspec)))
- (setq gnus-format-specs (delq spec gnus-format-specs)))))
-
;; Go through all the formats and see whether they need updating.
(let (new-format entry type val updated)
(while (setq type (pop types))
@@ -778,36 +716,6 @@ If PROPS, insert the result."
(gnus-add-text-properties (point) (progn (eval form) (point)) props)
(eval form))))
-(defun gnus-compile ()
- "Byte-compile the user-defined format specs."
- (interactive)
- (require 'bytecomp)
- (let ((entries gnus-format-specs)
- (byte-compile-warnings '(unresolved callargs redefine))
- entry gnus-tmp-func)
- (save-excursion
- (gnus-message 7 "Compiling format specs...")
-
- (while entries
- (setq entry (pop entries))
- (if (memq (car entry) '(gnus-version version))
- (setq gnus-format-specs (delq entry gnus-format-specs))
- (let ((form (caddr entry)))
- (when (and (listp form)
- ;; Under GNU Emacs, it's (byte-code ...)
- (not (eq 'byte-code (car form)))
- ;; Under XEmacs, it's (funcall #<compiled-function ...>)
- (not (and (eq 'funcall (car form))
- (byte-code-function-p (cadr form)))))
- (defalias 'gnus-tmp-func `(lambda () ,form))
- (byte-compile 'gnus-tmp-func)
- (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))))
-
- (push (cons 'version emacs-version) gnus-format-specs)
- ;; Mark the .newsrc.eld file as "dirty".
- (gnus-dribble-touch)
- (gnus-message 7 "Compiling user specs...done"))))
-
(defun gnus-set-format (type &optional insertable)
(set (intern (format "gnus-%s-line-format-spec" type))
(gnus-parse-format
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 2d8587ace3f..f58cb80311a 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -1,6 +1,6 @@
;;; gnus-srvr.el --- virtual server support for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -330,7 +330,7 @@ The following commands are available:
(dolist (open gnus-opened-servers)
(when (and (not (member (car open) done))
;; Just ignore ephemeral servers.
- (not (member (car open) gnus-ephemeral-servers)))
+ (not (gnus-method-ephemeral-p (car open))))
(push (car open) done)
(gnus-server-insert-server-line
(setq op-ser (format "%s:%s" (caar open) (nth 1 (car open))))
@@ -490,8 +490,7 @@ The following commands are available:
(error "No such server: %s" server))
(gnus-server-set-status method 'ok)
(prog1
- (or (gnus-open-server method)
- (progn (message "Couldn't open %s" server) nil))
+ (gnus-open-server method)
(gnus-server-update-server server)
(gnus-server-position-point))))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 3a9294d58d6..eaf17d9e579 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1,6 +1,6 @@
;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -291,7 +291,9 @@ claim them."
function
(repeat function)))
-(defcustom gnus-subscribe-newsgroup-hooks nil
+(define-obsolete-variable-alias 'gnus-subscribe-newsgroup-hooks
+ 'gnus-subscribe-newsgroup-functions "24.3")
+(defcustom gnus-subscribe-newsgroup-functions nil
"*Hooks run after you subscribe to a new group.
The hooks will be called with new group's name as argument."
:version "22.1"
@@ -639,7 +641,7 @@ the first newsgroup."
gnus-level-killed (gnus-group-entry (or next "dummy.group")))
(gnus-request-update-group-status newsgroup 'subscribe)
(gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
- (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
+ (run-hook-with-args 'gnus-subscribe-newsgroup-functions newsgroup)
t))
(defun gnus-read-active-file-p ()
@@ -763,8 +765,8 @@ prompt the user for the name of an NNTP server to use."
;; Add "native" to gnus-predefined-server-alist just to have a
;; name for the native select method.
(when gnus-select-method
- (push (cons "native" gnus-select-method)
- gnus-predefined-server-alist))
+ (add-to-list 'gnus-predefined-server-alist
+ (cons "native" gnus-select-method)))
(if gnus-agent
(gnus-agentize))
@@ -1369,11 +1371,6 @@ for new groups, and subscribe the new groups as zombies."
(funcall gnus-group-change-level-function
group level oldlevel previous)))))
-(defun gnus-kill-newsgroup (newsgroup)
- "Obsolete function. Kills a newsgroup."
- (gnus-group-change-level
- (gnus-group-entry newsgroup) gnus-level-killed))
-
(defun gnus-check-bogus-newsgroups (&optional confirm)
"Remove bogus newsgroups.
If CONFIRM is non-nil, the user has to confirm the deletion of every
@@ -1451,7 +1448,11 @@ newsgroup."
(defun gnus-activate-group (group &optional scan dont-check method
dont-sub-check)
"Check whether a group has been activated or not.
-If SCAN, request a scan of that group as well."
+If SCAN, request a scan of that group as well. If METHOD, use
+that select method instead of determining the method based on the
+group name. If DONT-CHECK, don't check check whether the group
+actually exists. If DONT-SUB-CHECK or DONT-CHECK, don't let the
+backend check whether the group actually exists."
(let ((method (or method (inline (gnus-find-method-for-group group))))
active)
(and (inline (gnus-check-server method))
@@ -1500,8 +1501,6 @@ If SCAN, request a scan of that group as well."
;; Return the new active info.
active)))))
-(defvar gnus-propagate-marks) ; gnus-sum
-
(defun gnus-get-unread-articles-in-group (info active &optional update)
(when (and info active)
;; Allow the backend to update the info in the group.
@@ -1511,13 +1510,6 @@ If SCAN, request a scan of that group as well."
(gnus-info-group info)))))
(gnus-activate-group (gnus-info-group info) nil t))
- ;; Allow backends to update marks,
- (when gnus-propagate-marks
- (let ((method (inline (gnus-find-method-for-group
- (gnus-info-group info)))))
- (when (gnus-check-backend-function 'request-marks (car method))
- (gnus-request-marks info method))))
-
(let* ((range (gnus-info-read info))
(num 0))
@@ -1606,7 +1598,7 @@ If SCAN, request a scan of that group as well."
;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
;; and compute how many unread articles there are in each group.
-(defun gnus-get-unread-articles (&optional level dont-connect)
+(defun gnus-get-unread-articles (&optional level dont-connect one-level)
(setq gnus-server-method-cache nil)
(require 'gnus-agent)
(let* ((newsrc (cdr gnus-newsrc-alist))
@@ -1663,7 +1655,7 @@ If SCAN, request a scan of that group as well."
(push (setq method-group-list (list method method-type nil nil))
type-cache))
;; Only add groups that need updating.
- (if (<= (gnus-info-level info)
+ (if (funcall (if one-level #'= #'<=) (gnus-info-level info)
(if (eq (cadr method-group-list) 'foreign)
foreign-level
alevel))
@@ -1710,6 +1702,21 @@ If SCAN, request a scan of that group as well."
(with-current-buffer nntp-server-buffer
(gnus-read-active-file-1 method nil)))))
+ ;; Clear out all the early methods.
+ (dolist (elem type-cache)
+ (destructuring-bind (method method-type infos dummy) elem
+ (when (and method
+ infos
+ (gnus-check-backend-function
+ 'retrieve-group-data-early (car method))
+ (not (gnus-method-denied-p method)))
+ (when (ignore-errors (gnus-get-function method 'open-server))
+ (unless (gnus-server-opened method)
+ (gnus-open-server method))
+ (when (gnus-server-opened method)
+ ;; Just mark this server as "cleared".
+ (gnus-retrieve-group-data-early method nil))))))
+
;; Start early async retrieval of data.
(let ((done-methods nil)
sanity-spec)
@@ -2211,7 +2218,7 @@ If SCAN, request a scan of that group as well."
(gnus-online method)
(gnus-agent-method-p method))
(progn
- (gnus-agent-save-active method)
+ (gnus-agent-save-active method t)
(gnus-active-to-gnus-format method hashtb nil real-active))
(goto-char (point-min))
@@ -2423,7 +2430,9 @@ If FORCE is non-nil, the .newsrc file is read."
(when gnus-newsrc-assoc
(setq gnus-newsrc-alist gnus-newsrc-assoc))))
(dolist (elem gnus-newsrc-alist)
- (setcar elem (mm-string-as-unibyte (car elem))))
+ ;; Protect against broken .newsrc.el files.
+ (when (car elem)
+ (setcar elem (mm-string-as-unibyte (car elem)))))
(gnus-make-hashtable-from-newsrc-alist)
(when (file-newer-than-file-p file ding-file)
;; Old format quick file
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index d8db300efbd..b44b953bec6 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1,6 +1,6 @@
;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -122,6 +122,7 @@ If t, fetch all the available old headers."
"*Use nnir to search an entire server when referring threads. A
nil value will only search for thread-related articles in the
current group."
+ :version "24.1"
:group 'gnus-thread
:type 'boolean)
@@ -450,7 +451,8 @@ current article is unread."
:group 'gnus-summary-maneuvering
:type 'boolean)
-(defcustom gnus-auto-center-summary 2
+(defcustom gnus-auto-center-summary
+ (max (or (bound-and-true-p scroll-margin) 0) 2)
"*If non-nil, always center the current summary buffer.
In particular, if `vertical' do only vertical recentering. If non-nil
and non-`vertical', do both horizontal and vertical recentering."
@@ -1242,13 +1244,6 @@ For example: ((1 . cn-gb-2312) (2 . big5))."
:type 'boolean
:group 'gnus-summary-marks)
-(defcustom gnus-propagate-marks nil
- "If non-nil, Gnus will store and retrieve marks from the backends.
-This means that marks will be stored both in .newsrc.eld and in
-the backend, and will slow operation down somewhat."
- :type 'boolean
- :group 'gnus-summary-marks)
-
(defcustom gnus-alter-articles-to-read-function nil
"Function to be called to alter the list of articles to be selected."
:type '(choice (const nil) function)
@@ -1371,15 +1366,12 @@ the normal Gnus MIME machinery."
(?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
(?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
(?L gnus-tmp-lines ?s)
- (?Z (or ,(gnus-macroexpand-all
- '(nnir-article-rsv (mail-header-number gnus-tmp-header)))
+ (?Z (or (nnir-article-rsv (mail-header-number gnus-tmp-header))
0) ?d)
- (?G (or ,(gnus-macroexpand-all
- '(nnir-article-group (mail-header-number gnus-tmp-header)))
+ (?G (or (nnir-article-group (mail-header-number gnus-tmp-header))
"") ?s)
- (?g (or ,(gnus-macroexpand-all
- '(gnus-group-short-name
- (nnir-article-group (mail-header-number gnus-tmp-header))))
+ (?g (or (gnus-group-short-name
+ (nnir-article-group (mail-header-number gnus-tmp-header)))
"") ?s)
(?O gnus-tmp-downloaded ?c)
(?I gnus-tmp-indentation ?s)
@@ -1920,6 +1912,7 @@ increase the score of each group you read."
"x" gnus-summary-limit-to-unread
"s" gnus-summary-isearch-article
[tab] gnus-summary-widget-forward
+ [backtab] gnus-summary-widget-backward
"t" gnus-summary-toggle-header
"g" gnus-summary-show-article
"l" gnus-summary-goto-last-article
@@ -2084,6 +2077,7 @@ increase the score of each group you read."
"g" gnus-summary-show-article
"s" gnus-summary-isearch-article
[tab] gnus-summary-widget-forward
+ [backtab] gnus-summary-widget-backward
"P" gnus-summary-print-article
"S" gnus-sticky-article
"M" gnus-mailing-list-insinuate
@@ -2973,12 +2967,6 @@ When FORCE, rebuild the tool bar."
(setq gnus-summary-tool-bar-map map))))
(set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))
-(defun gnus-score-set-default (var value)
- "A version of set that updates the GNU Emacs menu-bar."
- (set var value)
- ;; It is the message that forces the active status to be updated.
- (message ""))
-
(defun gnus-make-score-map (type)
"Make a summary score map of type TYPE."
(if t
@@ -3062,6 +3050,7 @@ When FORCE, rebuild the tool bar."
(declare-function turn-on-gnus-mailing-list-mode "gnus-ml" ())
(defvar bookmark-make-record-function)
+(defvar bidi-paragraph-direction)
(defun gnus-summary-mode (&optional group)
"Major mode for reading articles.
@@ -3101,6 +3090,9 @@ The following commands are available:
(setq buffer-read-only t ;Disable modification
show-trailing-whitespace nil)
(setq truncate-lines t)
+ ;; Force paragraph direction to be left-to-right. Don't make it
+ ;; bound globally in old Emacsen and XEmacsen.
+ (set (make-local-variable 'bidi-paragraph-direction) 'left-to-right)
(add-to-invisibility-spec '(gnus-sum . t))
(gnus-summary-set-display-table)
(gnus-set-default-directory)
@@ -3260,13 +3252,6 @@ The following commands are available:
"Say whether this article is a sparse article or not."
`(memq ,article gnus-newsgroup-ancient))
-(defun gnus-article-parent-p (number)
- "Say whether this article is a parent or not."
- (let ((data (gnus-data-find-list number)))
- (and (cdr data) ; There has to be an article after...
- (< (gnus-data-level (car data)) ; And it has to have a higher level.
- (gnus-data-level (nth 1 data))))))
-
(defun gnus-article-children (number)
"Return a list of all children to NUMBER."
(let* ((data (gnus-data-find-list number))
@@ -3288,14 +3273,6 @@ The following commands are available:
"Say whether this article is intangible or not."
'(get-text-property (point) 'gnus-intangible))
-(defun gnus-article-read-p (article)
- "Say whether ARTICLE is read or not."
- (not (or (memq article gnus-newsgroup-marked)
- (memq article gnus-newsgroup-spam-marked)
- (memq article gnus-newsgroup-unreads)
- (memq article gnus-newsgroup-unselected)
- (memq article gnus-newsgroup-dormant))))
-
;; Some summary mode macros.
(defmacro gnus-summary-article-number ()
@@ -3503,7 +3480,8 @@ display only a single character."
(current-buffer))))))
(defun gnus-summary-setup-buffer (group)
- "Initialize summary buffer."
+ "Initialize summary buffer.
+If the setup was successful, non-nil is returned."
(let ((buffer (gnus-summary-buffer-name group))
(dead-name (concat "*Dead Summary "
(gnus-group-decoded-name group) "*")))
@@ -3555,7 +3533,7 @@ buffer that was in action when the last article was fetched."
(push (eval (car locals)) vlist))
(setq locals (cdr locals)))
(setq vlist (nreverse vlist)))
- (with-current-buffer gnus-group-buffer
+ (with-temp-buffer
(setq gnus-newsgroup-name name
gnus-newsgroup-marked marked
gnus-newsgroup-spam-marked spam
@@ -3931,7 +3909,11 @@ Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
"Start reading news in newsgroup GROUP.
If SHOW-ALL is non-nil, already read articles are also listed.
If NO-ARTICLE is non-nil, no article is selected initially.
-If NO-DISPLAY, don't generate a summary buffer."
+If NO-DISPLAY, don't generate the summary buffer contents.
+If KILL-BUFFER, it should be a buffer that's killed once the new
+summary buffer has been generated.
+If BACKWARD, move point to the previous group in the group buffer
+If SELECT-ARTICLES, only select those articles from GROUP."
(let (result)
(while (and group
(null (setq result
@@ -4257,7 +4239,7 @@ If NO-DISPLAY, don't generate a summary buffer."
result))
(defun gnus-sort-gathered-threads (threads)
- "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'."
+ "Sort subthreads inside each gathered thread by `gnus-sort-gathered-threads-function'."
(let ((result threads))
(while threads
(when (stringp (caar threads))
@@ -5676,7 +5658,9 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; Init the dependencies hash table.
(setq gnus-newsgroup-dependencies
(gnus-make-hashtable (length articles)))
- (gnus-set-global-variables)
+ (if (gnus-buffer-live-p gnus-group-buffer)
+ (gnus-set-global-variables)
+ (set-default 'gnus-newsgroup-name gnus-newsgroup-name))
;; Retrieve the headers and read them in.
(setq gnus-newsgroup-headers (gnus-fetch-headers articles))
@@ -5920,17 +5904,6 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(setq articles (cdr articles)))
out))
-(defun gnus-uncompress-marks (marks)
- "Uncompress the mark ranges in MARKS."
- (let ((uncompressed '(score bookmark))
- out)
- (while marks
- (if (memq (caar marks) uncompressed)
- (push (car marks) out)
- (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
- (setq marks (cdr marks)))
- out))
-
(defun gnus-article-mark-to-type (mark)
"Return the type of MARK."
(or (cadr (assq mark gnus-article-special-mark-lists))
@@ -5958,7 +5931,6 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(setq mark (car marks)
mark-type (gnus-article-mark-to-type mark)
var (intern (format "gnus-newsgroup-%s" (car (rassq mark types)))))
-
;; We set the variable according to the type of the marks list,
;; and then adjust the marks to a subset of the active articles.
(cond
@@ -6277,13 +6249,18 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(entry (gnus-group-entry group))
(info (nth 2 entry))
(active (gnus-active group))
+ (set-marks
+ (gnus-method-option-p
+ (gnus-find-method-for-group group)
+ 'server-marks))
range)
(if (not entry)
;; Group that Gnus doesn't know exists, but still allow the
;; backend to set marks.
- (gnus-request-set-mark
- group (list (list (gnus-compress-sequence (sort articles #'<))
- 'add '(read))))
+ (when set-marks
+ (gnus-request-set-mark
+ group (list (list (gnus-compress-sequence (sort articles #'<))
+ 'add '(read)))))
;; Normal, subscribed groups.
(setq range (gnus-compute-read-articles group articles))
(with-current-buffer gnus-group-buffer
@@ -6292,11 +6269,14 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(gnus-info-set-marks ',info ',(gnus-info-marks info) t)
(gnus-info-set-read ',info ',(gnus-info-read info))
(gnus-get-unread-articles-in-group ',info (gnus-active ,group))
- (gnus-request-set-mark ,group (list (list ',range 'del '(read))))
+ (when ,set-marks
+ (gnus-request-set-mark
+ ,group (list (list ',range 'del '(read)))))
(gnus-group-update-group ,group t))))
;; Add the read articles to the range.
(gnus-info-set-read info range)
- (gnus-request-set-mark group (list (list range 'add '(read))))
+ (when set-marks
+ (gnus-request-set-mark group (list (list range 'add '(read)))))
;; Then we have to re-compute how many unread
;; articles there are in this group.
(when active
@@ -6609,9 +6589,9 @@ too, instead of trying to fetch new headers."
;; article if ID is a number -- so that the next `P' or `N'
;; command will fetch the previous (or next) article even
;; if the one we tried to fetch this time has been canceled.
- (when (> number gnus-newsgroup-end)
+ (unless (and gnus-newsgroup-end (< number gnus-newsgroup-end))
(setq gnus-newsgroup-end number))
- (when (< number gnus-newsgroup-begin)
+ (unless (and gnus-newsgroup-begin (> number gnus-newsgroup-begin))
(setq gnus-newsgroup-begin number))
(setq gnus-newsgroup-unselected
(delq number gnus-newsgroup-unselected)))
@@ -7237,7 +7217,8 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-summary-update-info))
(gnus-close-group group)
;; Make sure where we were, and go to next newsgroup.
- (set-buffer gnus-group-buffer)
+ (when (buffer-live-p (get-buffer gnus-group-buffer))
+ (set-buffer gnus-group-buffer))
(unless quit-config
(gnus-group-jump-to-group group))
(gnus-run-hooks 'gnus-summary-exit-hook)
@@ -7262,7 +7243,8 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-kill-buffer buf)))
(setq gnus-current-select-method gnus-select-method)
- (set-buffer gnus-group-buffer)
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (set-buffer gnus-group-buffer))
(if quit-config
(gnus-handle-ephemeral-exit quit-config)
(goto-char group-point)
@@ -7303,6 +7285,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(when (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
(gnus-article-stop-animations)
+ (gnus-stop-downloads)
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
(setq gnus-article-mime-handle-alist nil)
@@ -7313,9 +7296,11 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-kill-buffer gnus-original-article-buffer)
(setq gnus-article-current nil))
;; Return to the group buffer.
- (gnus-configure-windows 'group 'force)
(if (not gnus-kill-summary-on-exit)
- (gnus-deaden-summary)
+ (progn
+ (gnus-deaden-summary)
+ (gnus-configure-windows 'group 'force))
+ (gnus-configure-windows 'group 'force)
(gnus-close-group group)
(gnus-kill-buffer gnus-summary-buffer))
(unless gnus-single-article-buffer
@@ -7337,8 +7322,9 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(defun gnus-handle-ephemeral-exit (quit-config)
"Handle movement when leaving an ephemeral group.
The state which existed when entering the ephemeral is reset."
- (if (not (buffer-name (car quit-config)))
- (gnus-configure-windows 'group 'force)
+ (if (not (buffer-live-p (car quit-config)))
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (gnus-configure-windows 'group 'force))
(set-buffer (car quit-config))
(unless (eq (cdr quit-config) 'group)
(setq gnus-current-select-method
@@ -7736,10 +7722,6 @@ be displayed."
gnus-buttonized-mime-types)))
(gnus-summary-select-article nil 'force)))
-(defun gnus-summary-set-current-mark (&optional current-mark)
- "Obsolete function."
- nil)
-
(defun gnus-summary-next-article (&optional unread subject backward push)
"Select the next article.
If UNREAD, only unread articles are selected.
@@ -8213,9 +8195,17 @@ If NOT-MATCHING, excluding articles that have subjects that match a regexp."
"Limit the summary buffer to articles that have authors that match a regexp.
If NOT-MATCHING, excluding articles that have authors that match a regexp."
(interactive
- (list (read-string (if current-prefix-arg
- "Exclude author (regexp): "
- "Limit to author (regexp): "))
+ (list (let* ((header (gnus-summary-article-header))
+ (default (and header (car (mail-header-parse-address
+ (mail-header-from header))))))
+ (read-string (concat (if current-prefix-arg
+ "Exclude author (regexp"
+ "Limit to author (regexp")
+ (if default
+ (concat ", default \"" default "\"): ")
+ "): "))
+ nil nil
+ default))
current-prefix-arg))
(gnus-summary-limit-to-subject from "from" not-matching))
@@ -9032,7 +9022,8 @@ non-numeric or nil fetch the number specified by the
'gnus-article-sort-by-number)))
(setq gnus-newsgroup-articles
(gnus-sorted-nunion gnus-newsgroup-articles (nreverse article-ids)))
- (gnus-summary-limit-include-thread id))))
+ (gnus-summary-limit-include-thread id)))
+ (gnus-summary-show-thread))
(defun gnus-summary-refer-article (message-id)
"Fetch an article specified by MESSAGE-ID."
@@ -9146,7 +9137,7 @@ To control what happens when you exit the group, see the
(list (cons 'save-article-group ogroup))))
(case-fold-search t)
(buf (current-buffer))
- dig to-address)
+ dig to-address charset)
(with-current-buffer gnus-original-article-buffer
;; Have the digest group inherit the main mail address of
;; the parent article.
@@ -9159,16 +9150,32 @@ To control what happens when you exit the group, see the
to-address))))))
(setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
(insert-buffer-substring gnus-original-article-buffer)
- ;; Remove lines that may lead nndoc to misinterpret the
- ;; document type.
(narrow-to-region
(goto-char (point-min))
(or (search-forward "\n\n" nil t) (point)))
+ ;; Remove lines that may lead nndoc to misinterpret the
+ ;; document type.
(goto-char (point-min))
(delete-matching-lines "^Path:\\|^From ")
+ ;; Parse charset, and decode content transfer encoding.
+ (setq charset (mail-content-type-get
+ (mail-header-parse-content-type
+ (or (gnus-fetch-field "content-type") ""))
+ 'charset))
+ (let ((encoding (gnus-fetch-field "content-transfer-encoding")))
+ (when encoding
+ (message-remove-header "content-transfer-encoding")
+ (goto-char (point-max))
+ (widen)
+ (narrow-to-region (point) (point-max))
+ (mm-decode-content-transfer-encoding
+ (intern (downcase (mail-header-strip encoding))))))
(widen))
(unwind-protect
- (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset)
+ (if (let ((gnus-newsgroup-ephemeral-charset
+ (if charset
+ (intern (downcase (gnus-strip-whitespace charset)))
+ gnus-newsgroup-charset))
(gnus-newsgroup-ephemeral-ignored-charsets
gnus-newsgroup-ignored-charsets))
(gnus-group-read-ephemeral-group
@@ -9246,6 +9253,17 @@ With optional ARG, move across that many fields."
(select-window (gnus-get-buffer-window gnus-article-buffer))
(widget-forward arg))
+(defun gnus-summary-widget-backward (arg)
+ "Move point to the previous field or button in the article.
+With optional ARG, move across that many fields."
+ (interactive "p")
+ (gnus-summary-select-article)
+ (gnus-configure-windows 'article)
+ (select-window (gnus-get-buffer-window gnus-article-buffer))
+ (unless (widget-at (point))
+ (goto-char (point-max)))
+ (widget-backward arg))
+
(defun gnus-summary-isearch-article (&optional regexp-p)
"Do incremental search forward on the current article.
If REGEXP-P (the prefix) is non-nil, do regexp isearch."
@@ -9637,6 +9655,7 @@ C-u g', show the raw article."
(when (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
(gnus-article-stop-animations)
+ (gnus-stop-downloads)
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
(setq gnus-article-mime-handle-alist nil)
@@ -10054,7 +10073,10 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(gnus-add-marked-articles
to-group 'expire (list to-article) info))
- (when to-marks
+ (when (and to-marks
+ (gnus-method-option-p
+ (gnus-find-method-for-group to-group)
+ 'server-marks))
(gnus-request-set-mark
to-group (list (list (list to-article) 'add to-marks)))))
@@ -10886,6 +10908,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
(setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
(setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
(setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
+ (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
(cond ((= mark gnus-ticked-mark)
(setq gnus-newsgroup-marked
(gnus-add-to-sorted-list gnus-newsgroup-marked
@@ -11558,6 +11581,7 @@ Returns nil if no thread was there to be shown."
(beg (progn (beginning-of-line) (if (bobp) (point) (1- (point)))))
(eoi (when end
(if (fboundp 'next-single-char-property-change)
+ ;; Note: XEmacs version of n-s-c-p-c may return nil
(or (next-single-char-property-change end 'invisible)
(point-max))
(while (progn
@@ -12387,6 +12411,13 @@ If REVERSE, save parts that do not match TYPE."
(not (setq header (car (gnus-get-newsgroup-headers nil t)))))
() ; Malformed head.
(unless (gnus-summary-article-sparse-p (mail-header-number header))
+ (when (and (bound-and-true-p gnus-registry-enabled)
+ (not (gnus-ephemeral-group-p (car where))))
+ (gnus-registry-handle-action
+ (mail-header-id header) nil
+ (gnus-group-prefixed-name (car where) gnus-override-method)
+ (mail-header-subject header)
+ (mail-header-from header)))
(when (and (stringp id)
(or
(not (string= (gnus-group-real-name group)
@@ -12534,10 +12565,9 @@ UNREAD is a sorted list."
(save-excursion
(let (setmarkundo)
;; Propagate the read marks to the backend.
- (when (and (or gnus-propagate-marks
- (gnus-method-option-p
- (gnus-find-method-for-group group)
- 'server-marks))
+ (when (and (gnus-method-option-p
+ (gnus-find-method-for-group group)
+ 'server-marks)
(gnus-check-backend-function 'request-set-mark group))
(let ((del (gnus-remove-from-range (gnus-info-read info) read))
(add (gnus-remove-from-range read (gnus-info-read info))))
@@ -12832,9 +12862,9 @@ If ALL is a number, fetch this number of articles."
(gnus-group-decoded-name gnus-newsgroup-name)
(if initial "max" "default")
len)
- (if initial
- (cons (number-to-string initial)
- 0)))))
+ nil nil
+ (and initial
+ (number-to-string initial)))))
(unless (string-match "^[ \t]*$" input)
(setq all (string-to-number input))
(if (< all len)
diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el
index fbdacdd2fbe..b5f8379e367 100644
--- a/lisp/gnus/gnus-sync.el
+++ b/lisp/gnus/gnus-sync.el
@@ -1,6 +1,6 @@
;;; gnus-sync.el --- synchronization facility for Gnus
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news synchronization nntp nnrss
@@ -24,44 +24,83 @@
;; This is the gnus-sync.el package.
-;; It's due for a rewrite using gnus-after-set-mark-hook and
-;; gnus-before-update-mark-hook, and my plan is to do this once No
-;; Gnus development is done. Until then please consider it
-;; experimental.
-
;; Put this in your startup file (~/.gnus.el for instance)
;; possibilities for gnus-sync-backend:
;; Tramp over SSH: /ssh:user@host:/path/to/filename
-;; Tramp over IMAP: /imaps:user@yourhosthere.com:/INBOX.test/filename
;; ...or any other file Tramp and Emacs can handle...
;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded
-;; gnus-sync-global-vars `(gnus-newsrc-last-checked-date)
-;; gnus-sync-newsrc-groups `("nntp" "nnrss")
-;; gnus-sync-newsrc-offsets `(2 3))
+;; gnus-sync-global-vars '(gnus-newsrc-last-checked-date)
+;; gnus-sync-newsrc-groups '("nntp" "nnrss"))
+;; gnus-sync-newsrc-offsets '(2 3))
+;; against a LeSync server (beware the vampire LeSync, who knows your newsrc)
+
+;; (setq gnus-sync-backend '(lesync "http://lesync.info:5984/tzz")
+;; gnus-sync-newsrc-groups '("nntp" "nnrss"))
+
+;; What's a LeSync server?
+
+;; 1. install CouchDB, set up a real server admin user, and create a
+;; database, e.g. "tzz" and save the URL,
+;; e.g. http://lesync.info:5984/tzz
+
+;; 2. run `M-: (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)'
+
+;; (If you run it more than once, you have to remove the entry from
+;; _users yourself. This is intentional. This sets up a database
+;; admin for the "tzz" database, distinct from the server admin
+;; user in (1) above.)
+
+;; That's it, you can start using http://lesync.info:5984/tzz in your
+;; gnus-sync-backend as a LeSync backend. Fan fiction about the
+;; vampire LeSync is welcome.
+
+;; You may not want to expose a CouchDB install to the Big Bad
+;; Internet, especially if your love of all things furry would be thus
+;; revealed. Make sure it's not accessible by unauthorized users and
+;; guests, at least.
+
+;; If you want to try it out, I will create a test DB for you under
+;; http://lesync.info:5984/yourfavoritedbname
;; TODO:
-;; - after gnus-sync-read, the message counts are wrong. So it's not
-;; run automatically, you have to call it with M-x gnus-sync-read
+;; - after gnus-sync-read, the message counts look wrong until you do
+;; `g'. So it's not run automatically, you have to call it with M-x
+;; gnus-sync-read
;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to
;; catch the mark updates
+;; - repositioning of groups within topic after a LeSync sync is a
+;; weird sort of bubble sort ("buttle" sort: the old entry ends up
+;; at the rear of the list); you will eventually end up with the
+;; right order after calling `gnus-sync-read' a bunch of times.
+
+;; - installing topics and groups is inefficient and annoying, lots of
+;; prompts could be avoided
+
;;; Code:
(eval-when-compile (require 'cl))
+(require 'json)
(require 'gnus)
(require 'gnus-start)
(require 'gnus-util)
+(defvar gnus-topic-alist) ;; gnus-group.el
+(eval-when-compile
+ (autoload 'gnus-group-topic "gnus-topic")
+ (autoload 'gnus-topic-create-topic "gnus-topic" nil t)
+ (autoload 'gnus-topic-enter-dribble "gnus-topic"))
+
(defgroup gnus-sync nil
"The Gnus synchronization facility."
:version "24.1"
:group 'gnus)
-(defcustom gnus-sync-newsrc-groups `("nntp" "nnrss")
+(defcustom gnus-sync-newsrc-groups '("nntp" "nnrss")
"List of groups to be synchronized in the gnus-newsrc-alist.
The group names are matched, they don't have to be fully
qualified. Typically you would choose all of these. That's the
@@ -70,20 +109,12 @@ this setting is harmless until the user chooses a sync backend."
:group 'gnus-sync
:type '(repeat regexp))
-(defcustom gnus-sync-newsrc-offsets '(2 3)
- "List of per-group data to be synchronized."
- :group 'gnus-sync
- :type '(set (const :tag "Read ranges" 2)
- (const :tag "Marks" 3)))
-
(defcustom gnus-sync-global-vars nil
"List of global variables to be synchronized.
You may want to sync `gnus-newsrc-last-checked-date' but pretty
much any symbol is fair game. You could additionally sync
`gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology',
-and `gnus-topic-alist' to cover all the variables in
-newsrc.eld (except for `gnus-format-specs' which should not be
-synchronized, I believe). Also see `gnus-variable-list'."
+and `gnus-topic-alist'. Also see `gnus-variable-list'."
:group 'gnus-sync
:type '(repeat (choice (variable :tag "A known variable")
(symbol :tag "Any symbol"))))
@@ -92,30 +123,627 @@ synchronized, I believe). Also see `gnus-variable-list'."
"The synchronization backend."
:group 'gnus-sync
:type '(radio (const :format "None" nil)
+ (list :tag "Sync server"
+ (const :format "LeSync Server API" lesync)
+ (string :tag "URL of a CouchDB database for API access"))
(string :tag "Sync to a file")))
(defvar gnus-sync-newsrc-loader nil
"Carrier for newsrc data")
-(defun gnus-sync-save ()
-"Save the Gnus sync data to the backend."
- (interactive)
+(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
+ "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)))
+
+(defvar gnus-sync-lesync-props-hash (make-hash-table :test 'equal)
+ "LeSync props, keyed by group name")
+
+(defvar gnus-sync-lesync-design-prefix "/_design/lesync"
+ "The LeSync design prefix for CouchDB")
+
+(defvar gnus-sync-lesync-security-object "/_security"
+ "The LeSync security object for CouchDB")
+
+(defun gnus-sync-lesync-parse ()
+ "Parse the result of a LeSync request."
+ (goto-char (point-min))
+ (condition-case nil
+ (when (search-forward-regexp "^$" nil t)
+ (json-read))
+ (error
+ (gnus-message
+ 1
+ "gnus-sync-lesync-parse: Could not read the LeSync response!")
+ nil)))
+
+(defun gnus-sync-lesync-call (url method headers &optional kvdata)
+ "Make an access request to URL using KVDATA and METHOD.
+KVDATA must be an alist."
+ (flet ((json-alist-p (list) (gnus-sync-json-alist-p list))) ; temp patch
+ (let ((url-request-method method)
+ (url-request-extra-headers headers)
+ (url-request-data (if kvdata (json-encode kvdata) nil)))
+ (with-current-buffer (url-retrieve-synchronously url)
+ (let ((data (gnus-sync-lesync-parse)))
+ (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S"
+ method url `((headers . ,headers) (data ,kvdata)) data)
+ (kill-buffer (current-buffer))
+ data)))))
+
+(defun gnus-sync-lesync-PUT (url headers &optional data)
+ (gnus-sync-lesync-call url "PUT" headers data))
+
+(defun gnus-sync-lesync-POST (url headers &optional data)
+ (gnus-sync-lesync-call url "POST" headers data))
+
+(defun gnus-sync-lesync-GET (url headers &optional data)
+ (gnus-sync-lesync-call url "GET" headers data))
+
+(defun gnus-sync-lesync-DELETE (url headers &optional data)
+ (gnus-sync-lesync-call url "DELETE" headers data))
+
+;; this is not necessary with newer versions of json.el but 1.2 or older
+;; (which are in Emacs 24.1 and earlier) need it
+(defun gnus-sync-json-alist-p (list)
+ "Non-null if and only if LIST is an alist."
+ (while (consp list)
+ (setq list (if (consp (car list))
+ (cdr list)
+ 'not-alist)))
+ (null list))
+
+;; this is not necessary with newer versions of json.el but 1.2 or older
+;; (which are in Emacs 24.1 and earlier) need it
+(defun gnus-sync-json-plist-p (list)
+ "Non-null if and only if LIST is a plist."
+ (while (consp list)
+ (setq list (if (and (keywordp (car list))
+ (consp (cdr list)))
+ (cddr list)
+ 'not-plist)))
+ (null list))
+
+; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)
+; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz")
+
+(defun gnus-sync-lesync-setup (url &optional user password salt reader admin)
+ (interactive "sEnter URL to set up: ")
+ "Set up the LeSync database at URL.
+Install USER as a READER and/or an ADMIN in the security object
+under \"_security\", and in the CouchDB \"_users\" table using
+PASSWORD and SALT. Only one USER is thus supported for now.
+When SALT is nil, a random one will be generated using `random'."
+ (let* ((design-url (concat url gnus-sync-lesync-design-prefix))
+ (security-object (concat url "/_security"))
+ (user-record `((names . [,user]) (roles . [])))
+ (couch-user-name (format "org.couchdb.user:%s" user))
+ (salt (or salt (sha1 (format "%s" (random)))))
+ (couch-user-record
+ `((_id . ,couch-user-name)
+ (type . user)
+ (name . ,(format "%s" user))
+ (roles . [])
+ (salt . ,salt)
+ (password_sha . ,(when password
+ (sha1
+ (format "%s%s" password salt))))))
+ (rev (progn
+ (gnus-sync-lesync-find-prop 'rev design-url design-url)
+ (gnus-sync-lesync-get-prop 'rev design-url)))
+ (latest-func "function(head,req)
+{
+ var tosend = [];
+ var row;
+ var ftime = (req.query['ftime'] || 0);
+ while (row = getRow())
+ {
+ if (row.value['float-time'] > ftime)
+ {
+ var s = row.value['_id'];
+ if (s) tosend.push('\"'+s.replace('\"', '\\\"')+'\"');
+ }
+ }
+ send('['+tosend.join(',') + ']');
+}")
+;; <key>read</key>
+;; <dict>
+;; <key>de.alt.fan.ipod</key>
+;; <array>
+;; <integer>1</integer>
+;; <integer>2</integer>
+;; <dict>
+;; <key>start</key>
+;; <integer>100</integer>
+;; <key>length</key>
+;; <integer>100</integer>
+;; </dict>
+;; </array>
+;; </dict>
+ (xmlplistread-func "function(head, req) {
+ var row;
+ start({ 'headers': { 'Content-Type': 'text/xml' } });
+
+ send('<dict>');
+ send('<key>read</key>');
+ send('<dict>');
+ while(row = getRow())
+ {
+ var read = row.value.read;
+ if (read && read[0] && read[0] == 'invlist')
+ {
+ send('<key>'+row.key+'</key>');
+ //send('<invlist>'+read+'</invlist>');
+ send('<array>');
+
+ var from = 0;
+ var flip = false;
+
+ for (var i = 1; i < read.length && read[i]; i++)
+ {
+ var cur = read[i];
+ if (flip)
+ {
+ if (from == cur-1)
+ {
+ send('<integer>'+read[i]+'</integer>');
+ }
+ else
+ {
+ send('<dict>');
+ send('<key>start</key>');
+ send('<integer>'+from+'</integer>');
+ send('<key>end</key>');
+ send('<integer>'+(cur-1)+'</integer>');
+ send('</dict>');
+ }
+
+ }
+ flip = ! flip;
+ from = cur;
+ }
+ send('</array>');
+ }
+ }
+
+ send('</dict>');
+ send('</dict>');
+}
+")
+ (subs-func "function(doc){emit([doc._id, doc.source], doc._rev);}")
+ (revs-func "function(doc){emit(doc._id, doc._rev);}")
+ (bytimesubs-func "function(doc)
+{emit([(doc['float-time']||0), doc._id], doc._rev);}")
+ (bytime-func "function(doc)
+{emit([(doc['float-time']||0), doc._id], doc);}")
+ (groups-func "function(doc){emit(doc._id, doc);}"))
+ (and (if user
+ (and (assq 'ok (gnus-sync-lesync-PUT
+ security-object
+ nil
+ (append (and reader
+ (list `(readers . ,user-record)))
+ (and admin
+ (list `(admins . ,user-record))))))
+ (assq 'ok (gnus-sync-lesync-PUT
+ (concat (file-name-directory url)
+ "_users/"
+ couch-user-name)
+ nil
+ couch-user-record)))
+ t)
+ (assq 'ok (gnus-sync-lesync-PUT
+ design-url
+ nil
+ `(,@(when rev (list (cons '_rev rev)))
+ (lists . ((latest . ,latest-func)
+ (xmlplistread . ,xmlplistread-func)))
+ (views . ((subs . ((map . ,subs-func)))
+ (revs . ((map . ,revs-func)))
+ (bytimesubs . ((map . ,bytimesubs-func)))
+ (bytime . ((map . ,bytime-func)))
+ (groups . ((map . ,groups-func)))))))))))
+
+(defun gnus-sync-lesync-find-prop (prop url key)
+ "Retrieve a PROPerty of a document KEY at URL.
+Calls `gnus-sync-lesync-set-prop'.
+For the 'rev PROP, uses '_rev against the document."
+ (gnus-sync-lesync-set-prop
+ prop key (cdr (assq (if (eq prop 'rev) '_rev prop)
+ (gnus-sync-lesync-GET url nil)))))
+
+(defun gnus-sync-lesync-set-prop (prop key val)
+ "Update the PROPerty of document KEY at URL to VAL.
+Updates `gnus-sync-lesync-props-hash'."
+ (puthash (format "%s.%s" key prop) val gnus-sync-lesync-props-hash))
+
+(defun gnus-sync-lesync-get-prop (prop key)
+ "Get the PROPerty of KEY from `gnus-sync-lesync-props-hash'."
+ (gethash (format "%s.%s" key prop) gnus-sync-lesync-props-hash))
+
+(defun gnus-sync-deep-print (data)
+ (let* ((print-quoted t)
+ (print-readably t)
+ (print-escape-multibyte nil)
+ (print-escape-nonascii t)
+ (print-length nil)
+ (print-level nil)
+ (print-circle nil)
+ (print-escape-newlines t))
+ (format "%S" data)))
+
+(defun gnus-sync-newsrc-loader-builder (&optional only-modified)
+ (let* ((entries (cdr gnus-newsrc-alist))
+ entry name ret)
+ (while entries
+ (setq entry (pop entries)
+ name (car entry))
+ (when (gnus-grep-in-list name gnus-sync-newsrc-groups)
+ (if only-modified
+ (when (not (equal (gnus-sync-deep-print entry)
+ (gnus-sync-lesync-get-prop 'checksum name)))
+ (gnus-message 9 "%s: add %s, it's modified"
+ "gnus-sync-newsrc-loader-builder" name)
+ (push entry ret))
+ (push entry ret))))
+ ret))
+
+; (json-encode (gnus-sync-range2invlist '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)))
+(defun gnus-sync-range2invlist (ranges)
+ (append '(invlist)
+ (let ((ranges (delq nil ranges))
+ ret range from to)
+ (while ranges
+ (setq range (pop ranges))
+ (if (atom range)
+ (setq from range
+ to range)
+ (setq from (car range)
+ to (cdr range)))
+ (push from ret)
+ (push (1+ to) ret))
+ (reverse ret))))
+
+; (let* ((d '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)) (j (format "%S" (gnus-sync-invlist2range (gnus-sync-range2invlist d))))) (or (equal (format "%S" d) j) j))
+(defun gnus-sync-invlist2range (inv)
+ (setq inv (append inv nil))
+ (if (equal (format "%s" (car inv)) "invlist")
+ (let ((i (cdr inv))
+ (start 0)
+ ret cur top flip)
+ (while i
+ (setq cur (pop i))
+ (when flip
+ (setq top (1- cur))
+ (if (= start top)
+ (push start ret)
+ (push (cons start top) ret)))
+ (setq flip (not flip))
+ (setq start cur))
+ (reverse ret))
+ inv))
+
+(defun gnus-sync-position (search list &optional test)
+ "Find the position of SEARCH in LIST using TEST, defaulting to `eq'."
+ (let ((pos 0)
+ (test (or test 'eq)))
+ (while (and list (not (funcall test (car list) search)))
+ (pop list)
+ (incf pos))
+ (if (funcall test (car list) search) pos nil)))
+
+(defun gnus-sync-topic-group-position (group topic-name)
+ (gnus-sync-position
+ group (cdr (assoc topic-name gnus-topic-alist)) 'equal))
+
+(defun gnus-sync-fix-topic-group-position (group topic-name position)
+ (unless (equal position (gnus-sync-topic-group-position group topic-name))
+ (let* ((loc "gnus-sync-fix-topic-group-position")
+ (groups (delete group (cdr (assoc topic-name gnus-topic-alist))))
+ (position (min position (1- (length groups))))
+ (old (nth position groups)))
+ (when (and old (not (equal old group)))
+ (setf (nth position groups) group)
+ (setcdr (assoc topic-name gnus-topic-alist)
+ (append groups (list old)))
+ (gnus-message 9 "%s: %s moved to %d, swap with %s"
+ loc group position old)))))
+
+(defun gnus-sync-lesync-pre-save-group-entry (url nentry &rest passed-props)
+ (let* ((loc "gnus-sync-lesync-save-group-entry")
+ (k (car nentry))
+ (revision (gnus-sync-lesync-get-prop 'rev k))
+ (sname gnus-sync-lesync-name)
+ (topic (gnus-group-topic k))
+ (topic-offset (gnus-sync-topic-group-position k topic))
+ (sources (gnus-sync-lesync-get-prop 'source k)))
+ ;; set the revision so we don't have a conflict
+ `(,@(when revision
+ (list (cons '_rev revision)))
+ (_id . ,k)
+ ;; the time we saved
+ ,@passed-props
+ ;; add our name to the sources list for this key
+ (source ,@(if (member gnus-sync-lesync-name sources)
+ sources
+ (cons gnus-sync-lesync-name sources)))
+ ,(cons 'level (nth 1 nentry))
+ ,@(if topic (list (cons 'topic topic)) nil)
+ ,@(if topic-offset (list (cons 'topic-offset topic-offset)) nil)
+ ;; the read marks
+ ,(cons 'read (gnus-sync-range2invlist (nth 2 nentry)))
+ ;; the other marks
+ ,@(delq nil (mapcar (lambda (mark-entry)
+ (gnus-message 12 "%s: prep param %s in %s"
+ loc
+ (car mark-entry)
+ (nth 3 nentry))
+ (if (listp (cdr mark-entry))
+ (cons (car mark-entry)
+ (gnus-sync-range2invlist
+ (cdr mark-entry)))
+ (progn ; else this is not a list
+ (gnus-message 9 "%s: non-list param %s in %s"
+ loc
+ (car mark-entry)
+ (nth 3 nentry))
+ nil)))
+ (nth 3 nentry))))))
+
+(defun gnus-sync-lesync-post-save-group-entry (url entry)
+ (let* ((loc "gnus-sync-lesync-post-save-group-entry")
+ (k (cdr (assq 'id entry))))
+ (cond
+ ;; success!
+ ((and (assq 'rev entry) (assq 'id entry))
+ (progn
+ (gnus-sync-lesync-set-prop 'rev k (cdr (assq 'rev entry)))
+ (gnus-sync-lesync-set-prop 'checksum
+ k
+ (gnus-sync-deep-print
+ (assoc k gnus-newsrc-alist)))
+ (gnus-message 9 "%s: successfully synced %s to %s"
+ loc k url)))
+ ;; specifically check for document conflicts
+ ((equal "conflict" (format "%s" (cdr-safe (assq 'error entry))))
+ (gnus-error
+ 1
+ "%s: use `%s' to resolve the conflict synchronizing %s to %s: %s"
+ loc "gnus-sync-read" k url (cdr (assq 'reason entry))))
+ ;; generic errors
+ ((assq 'error entry)
+ (gnus-error 1 "%s: got error while synchronizing %s to %s: %s"
+ loc k url (cdr (assq 'reason entry))))
+
+ (t
+ (gnus-message 2 "%s: unknown sync status after %s to %s: %S"
+ loc k url entry)))
+ (assoc 'error entry)))
+
+(defun gnus-sync-lesync-groups-builder (url)
+ (let ((u (concat url gnus-sync-lesync-design-prefix "/_view/groups")))
+ (cdr (assq 'rows (gnus-sync-lesync-GET u nil)))))
+
+(defun gnus-sync-subscribe-group (name)
+ "Subscribe to group NAME. Returns NAME on success, nil otherwise."
+ (gnus-subscribe-newsgroup name))
+
+(defun gnus-sync-lesync-read-group-entry (url name entry &rest passed-props)
+ "Read ENTRY information for NAME. Returns NAME if successful.
+Skips entries whose sources don't contain
+`gnus-sync-lesync-name'. When the alist PASSED-PROPS has a
+`subscribe-all' element that evaluates to true, we attempt to
+subscribe to unknown groups. The user is also allowed to delete
+unwanted groups via the LeSync URL."
+ (let* ((loc "gnus-sync-lesync-read-group-entry")
+ (entry (gnus-sync-lesync-normalize-group-entry entry passed-props))
+ (subscribe-all (cdr (assq 'subscribe-all passed-props)))
+ (sources (cdr (assq 'source entry)))
+ (rev (cdr (assq 'rev entry)))
+ (in-sources (member gnus-sync-lesync-name sources))
+ (known (assoc name gnus-newsrc-alist))
+ cell)
+ (unless known
+ (if (and subscribe-all
+ (y-or-n-p (format "Subscribe to group %s?" name)))
+ (setq known (gnus-sync-subscribe-group name)
+ in-sources t)
+ ;; else...
+ (when (y-or-n-p (format "Delete group %s from server?" name))
+ (if (equal name (gnus-sync-lesync-delete-group url name))
+ (gnus-message 1 "%s: removed group %s from server %s"
+ loc name url)
+ (gnus-error 1 "%s: could not remove group %s from server %s"
+ loc name url)))))
+ (when known
+ (unless in-sources
+ (setq in-sources
+ (y-or-n-p
+ (format "Read group %s even though %s is not in sources %S?"
+ name gnus-sync-lesync-name (or sources ""))))))
+ (when rev
+ (gnus-sync-lesync-set-prop 'rev name rev))
+
+ ;; if the source matches AND we have this group
+ (if (and known in-sources)
+ (progn
+ (gnus-message 10 "%s: reading LeSync entry %s, sources %S"
+ loc name sources)
+ (while entry
+ (setq cell (pop entry))
+ (let ((k (car cell))
+ (val (cdr cell)))
+ (gnus-sync-lesync-set-prop k name val)))
+ name)
+ ;; else...
+ (unless known
+ (gnus-message 5 "%s: ignoring entry %s, it wasn't subscribed. %s"
+ loc name "Call `gnus-sync-read' with C-u to force it."))
+ (unless in-sources
+ (gnus-message 5 "%s: ignoring entry %s, %s not in sources %S"
+ loc name gnus-sync-lesync-name (or sources "")))
+ nil)))
+
+(defun gnus-sync-lesync-install-group-entry (name)
+ (let* ((master (assoc name gnus-newsrc-alist))
+ (old-topic-name (gnus-group-topic name))
+ (old-topic (assoc old-topic-name gnus-topic-alist))
+ (target-topic-name (gnus-sync-lesync-get-prop 'topic name))
+ (target-topic-offset (gnus-sync-lesync-get-prop 'topic-offset name))
+ (target-topic (assoc target-topic-name gnus-topic-alist))
+ (loc "gnus-sync-lesync-install-group-entry"))
+ (if master
+ (progn
+ (when (eq 'ask gnus-sync-lesync-install-topics)
+ (setq gnus-sync-lesync-install-topics
+ (y-or-n-p "Install topics from LeSync?")))
+ (when (and (eq t gnus-sync-lesync-install-topics)
+ target-topic-name)
+ (if (equal old-topic-name target-topic-name)
+ (gnus-message 12 "%s: %s is already in topic %s"
+ loc name target-topic-name)
+ ;; see `gnus-topic-move-group'
+ (when (and old-topic target-topic)
+ (setcdr old-topic (gnus-delete-first name (cdr old-topic)))
+ (gnus-message 5 "%s: removing %s from topic %s"
+ loc name old-topic-name))
+ (unless target-topic
+ (when (y-or-n-p (format "Create missing topic %s?"
+ target-topic-name))
+ (gnus-topic-create-topic target-topic-name nil)
+ (setq target-topic (assoc target-topic-name
+ gnus-topic-alist))))
+ (if target-topic
+ (prog1
+ (nconc target-topic (list name))
+ (gnus-message 5 "%s: adding %s to topic %s"
+ loc name (car target-topic))
+ (gnus-topic-enter-dribble))
+ (gnus-error 2 "%s: LeSync group %s can't go in missing topic %s"
+ loc name target-topic-name)))
+ (when (and target-topic-offset target-topic)
+ (gnus-sync-fix-topic-group-position
+ name target-topic-name target-topic-offset)))
+ ;; install the subscription level
+ (when (gnus-sync-lesync-get-prop 'level name)
+ (setf (nth 1 master) (gnus-sync-lesync-get-prop 'level name)))
+ ;; install the read and other marks
+ (setf (nth 2 master) (gnus-sync-lesync-get-prop 'read name))
+ (setf (nth 3 master) (gnus-sync-lesync-get-prop 'marks name))
+ (gnus-sync-lesync-set-prop 'checksum
+ name
+ (gnus-sync-deep-print master))
+ nil)
+ (gnus-error 1 "%s: invalid LeSync group %s" loc name)
+ 'invalid-name)))
+
+; (gnus-sync-lesync-delete-group (cdr gnus-sync-backend) "nntp+Gmane:gwene.org.slashdot")
+
+(defun gnus-sync-lesync-delete-group (url name)
+ "Returns NAME if successful deleting it from URL, an error otherwise."
+ (interactive "sEnter URL to set up: \rsEnter group name: ")
+ (let* ((u (concat (cadr gnus-sync-backend) "/" (url-hexify-string name)))
+ (del (gnus-sync-lesync-DELETE
+ u
+ `(,@(when (gnus-sync-lesync-get-prop 'rev name)
+ (list (cons "If-Match"
+ (gnus-sync-lesync-get-prop 'rev name))))))))
+ (or (cdr (assq 'id del)) del)))
+
+;;; (gnus-sync-lesync-normalize-group-entry '((subscribe . ["invlist"]) (read . ["invlist"]) (topic-offset . 20) (topic . "news") (level . 6) (source . ["a" "b"]) (float-time . 1319671237.099285) (_rev . "10-edf5107f41e5e6f7f6629d1c0ee172f7") (_id . "nntp+news.net:alt.movies")) '((read-time 1319672156.486414) (subscribe-all nil)))
+
+(defun gnus-sync-lesync-normalize-group-entry (entry &optional passed-props)
+ (let (ret
+ marks
+ cell)
+ (setq entry (append passed-props entry))
+ (while (setq cell (pop entry))
+ (let ((k (car cell))
+ (val (cdr cell)))
+ (cond
+ ((eq k 'read)
+ (push (cons k (gnus-sync-invlist2range val)) ret))
+ ;; we ignore these parameters
+ ((member k '(_id subscribe-all _deleted_conflicts))
+ nil)
+ ((eq k '_rev)
+ (push (cons 'rev val) ret))
+ ((eq k 'source)
+ (push (cons 'source (append val nil)) ret))
+ ((or (eq k 'float-time)
+ (eq k 'level)
+ (eq k 'topic)
+ (eq k 'topic-offset)
+ (eq k 'read-time))
+ (push (cons k val) ret))
+;;; "How often have I said to you that when you have eliminated the
+;;; impossible, whatever remains, however improbable, must be the
+;;; truth?" --Sherlock Holmes
+ ;; everything remaining must be a mark
+ (t (push (cons k (gnus-sync-invlist2range val)) marks)))))
+ (cons (cons 'marks marks) ret)))
+
+(defun gnus-sync-save (&optional force)
+"Save the Gnus sync data to the backend.
+With a prefix, FORCE is set and all groups will be saved."
+ (interactive "P")
(cond
+ ((and (listp gnus-sync-backend)
+ (eq (nth 0 gnus-sync-backend) 'lesync)
+ (stringp (nth 1 gnus-sync-backend)))
+
+ ;; refresh the revisions if we're forcing the save
+ (when force
+ (mapc (lambda (entry)
+ (when (and (assq 'key entry)
+ (assq 'value entry))
+ (gnus-sync-lesync-set-prop
+ 'rev
+ (cdr (assq 'key entry))
+ (cdr (assq 'value entry)))))
+ ;; the revs view is key = name, value = rev
+ (cdr (assq 'rows (gnus-sync-lesync-GET
+ (concat (nth 1 gnus-sync-backend)
+ gnus-sync-lesync-design-prefix
+ "/_view/revs")
+ nil)))))
+
+ (let* ((ftime (float-time))
+ (url (nth 1 gnus-sync-backend))
+ (entries
+ (mapcar (lambda (entry)
+ (gnus-sync-lesync-pre-save-group-entry
+ (cadr gnus-sync-backend)
+ entry
+ (cons 'float-time ftime)))
+ (gnus-sync-newsrc-loader-builder (not force))))
+ ;; when there are no entries, there's nothing to save
+ (sync (if entries
+ (gnus-sync-lesync-POST
+ (concat url "/_bulk_docs")
+ '(("Content-Type" . "application/json"))
+ `((docs . ,(vconcat entries nil))))
+ (gnus-message
+ 2 "gnus-sync-save: nothing to save to the LeSync backend")
+ nil)))
+ (mapcar (lambda (e) (gnus-sync-lesync-post-save-group-entry url e))
+ sync)))
((stringp gnus-sync-backend)
- (gnus-message 7 "gnus-sync: saving to backend %s" gnus-sync-backend)
+ (gnus-message 7 "gnus-sync-save: saving to backend %s" gnus-sync-backend)
;; populate gnus-sync-newsrc-loader from all but the first dummy
;; entry in gnus-newsrc-alist whose group matches any of the
;; gnus-sync-newsrc-groups
;; TODO: keep the old contents for groups we don't have!
- (let ((gnus-sync-newsrc-loader
- (loop for entry in (cdr gnus-newsrc-alist)
- when (gnus-grep-in-list
- (car entry) ;the group name
- gnus-sync-newsrc-groups)
- collect (cons (car entry)
- (mapcar (lambda (offset)
- (cons offset (nth offset entry)))
- gnus-sync-newsrc-offsets)))))
+ (let ((gnus-sync-newsrc-loader (gnus-sync-newsrc-loader-builder)))
(with-temp-file gnus-sync-backend
(progn
(let ((coding-system-for-write gnus-ding-file-coding-system)
@@ -123,6 +751,7 @@ synchronized, I believe). Also see `gnus-variable-list'."
(princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n"
gnus-ding-file-coding-system))
(princ ";; Gnus sync data v. 0.0.1\n")
+ ;; TODO: replace with `gnus-sync-deep-print'
(let* ((print-quoted t)
(print-readably t)
(print-escape-multibyte nil)
@@ -147,14 +776,14 @@ synchronized, I believe). Also see `gnus-variable-list'."
(princ (symbol-name variable)))))
(gnus-message
7
- "gnus-sync: stored variables %s and %d groups in %s"
+ "gnus-sync-save: stored variables %s and %d groups in %s"
gnus-sync-global-vars
(length gnus-sync-newsrc-loader)
gnus-sync-backend)
;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
;; Save the .eld file with extra line breaks.
- (gnus-message 8 "gnus-sync: adding whitespace to %s"
+ (gnus-message 8 "gnus-sync-save: adding whitespace to %s"
gnus-sync-backend)
(save-excursion
(goto-char (point-min))
@@ -166,49 +795,74 @@ synchronized, I believe). Also see `gnus-variable-list'."
;; the pass-through case: gnus-sync-backend is not a known choice
(nil)))
-(defun gnus-sync-read ()
-"Load the Gnus sync data from the backend."
- (interactive)
+(defun gnus-sync-read (&optional subscribe-all)
+ "Load the Gnus sync data from the backend.
+With a prefix, SUBSCRIBE-ALL is set and unknown groups will be subscribed."
+ (interactive "P")
(when gnus-sync-backend
- (gnus-message 7 "gnus-sync: loading from backend %s" gnus-sync-backend)
- (cond ((stringp gnus-sync-backend)
- ;; read data here...
- (if (or debug-on-error debug-on-quit)
- (load gnus-sync-backend nil t)
- (condition-case var
- (load gnus-sync-backend nil t)
- (error
- (error "Error in %s: %s" gnus-sync-backend (cadr var)))))
- (let ((valid-count 0)
- invalid-groups)
- (dolist (node gnus-sync-newsrc-loader)
- (if (gnus-gethash (car node) gnus-newsrc-hashtb)
- (progn
- (incf valid-count)
- (loop for store in (cdr node)
- do (setf (nth (car store)
- (assoc (car node) gnus-newsrc-alist))
- (cdr store))))
- (push (car node) invalid-groups)))
- (gnus-message
- 7
- "gnus-sync: loaded %d groups (out of %d) from %s"
- valid-count (length gnus-sync-newsrc-loader)
- gnus-sync-backend)
- (when invalid-groups
- (gnus-message
- 7
- "gnus-sync: skipped %d groups (out of %d) from %s"
- (length invalid-groups)
- (length gnus-sync-newsrc-loader)
- gnus-sync-backend)
- (gnus-message 9 "gnus-sync: skipped groups: %s"
- (mapconcat 'identity invalid-groups ", ")))))
- (nil))
- ;; make the hashtable again because the newsrc-alist may have been modified
- (when gnus-sync-newsrc-offsets
- (gnus-message 9 "gnus-sync: remaking the newsrc hashtable")
- (gnus-make-hashtable-from-newsrc-alist))))
+ (gnus-message 7 "gnus-sync-read: loading from backend %s" gnus-sync-backend)
+ (cond
+ ((and (listp gnus-sync-backend)
+ (eq (nth 0 gnus-sync-backend) 'lesync)
+ (stringp (nth 1 gnus-sync-backend)))
+ (let ((errored nil)
+ name ftime)
+ (mapc (lambda (entry)
+ (setq name (cdr (assq 'id entry)))
+ ;; set ftime the FIRST time through this loop, that
+ ;; way it reflects the time we FINISHED reading
+ (unless ftime (setq ftime (float-time)))
+
+ (unless errored
+ (setq errored
+ (when (equal name
+ (gnus-sync-lesync-read-group-entry
+ (nth 1 gnus-sync-backend)
+ name
+ (cdr (assq 'value entry))
+ `(read-time ,ftime)
+ `(subscribe-all ,subscribe-all)))
+ (gnus-sync-lesync-install-group-entry
+ (cdr (assq 'id entry)))))))
+ (gnus-sync-lesync-groups-builder (nth 1 gnus-sync-backend)))))
+
+ ((stringp gnus-sync-backend)
+ ;; read data here...
+ (if (or debug-on-error debug-on-quit)
+ (load gnus-sync-backend nil t)
+ (condition-case var
+ (load gnus-sync-backend nil t)
+ (error
+ (error "Error in %s: %s" gnus-sync-backend (cadr var)))))
+ (let ((valid-count 0)
+ invalid-groups)
+ (dolist (node gnus-sync-newsrc-loader)
+ (if (gnus-gethash (car node) gnus-newsrc-hashtb)
+ (progn
+ (incf valid-count)
+ (loop for store in (cdr node)
+ do (setf (nth (car store)
+ (assoc (car node) gnus-newsrc-alist))
+ (cdr store))))
+ (push (car node) invalid-groups)))
+ (gnus-message
+ 7
+ "gnus-sync-read: loaded %d groups (out of %d) from %s"
+ valid-count (length gnus-sync-newsrc-loader)
+ gnus-sync-backend)
+ (when invalid-groups
+ (gnus-message
+ 7
+ "gnus-sync-read: skipped %d groups (out of %d) from %s"
+ (length invalid-groups)
+ (length gnus-sync-newsrc-loader)
+ gnus-sync-backend)
+ (gnus-message 9 "gnus-sync-read: skipped groups: %s"
+ (mapconcat 'identity invalid-groups ", ")))))
+ (nil))
+
+ (gnus-message 9 "gnus-sync-read: remaking the newsrc hashtable")
+ (gnus-make-hashtable-from-newsrc-alist)))
;;;###autoload
(defun gnus-sync-initialize ()
@@ -228,14 +882,11 @@ synchronized, I believe). Also see `gnus-variable-list'."
(defun gnus-sync-unload-hook ()
"Uninstall the sync hooks."
(interactive)
- (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read)
- (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
- (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
+ (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save))
(add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook)
-;; this is harmless by default, until the gnus-sync-backend is set
-(gnus-sync-initialize)
+(when gnus-sync-backend (gnus-sync-initialize))
(provide 'gnus-sync)
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index 87ca27adcf4..3567f37aeb3 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -1,6 +1,6 @@
;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Ilja Weis <kult@uni-paderborn.de>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -145,13 +145,6 @@ See Info node `(gnus)Formatting Variables'."
(setq alist (cdr alist)))
out))
-(defun gnus-group-parent-topic (group)
- "Return the topic GROUP is member of by looking at the group buffer."
- (with-current-buffer gnus-group-buffer
- (if (gnus-group-goto-group group)
- (gnus-current-topic)
- (gnus-group-topic group))))
-
(defun gnus-topic-goto-topic (topic)
(when topic
(gnus-goto-char (text-property-any (point-min) (point-max)
@@ -969,12 +962,15 @@ articles in the topic and its subtopics."
(if (not group)
(if (not (memq 'gnus-topic props))
(goto-char (point-max))
- (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props)))))
+ (let ((topic (symbol-name (cadr (memq 'gnus-topic props)))))
+ (or (gnus-topic-goto-topic topic)
+ (gnus-topic-goto-topic (gnus-topic-next-topic topic)))))
(if (gnus-group-goto-group group)
t
;; The group is no longer visible.
(let* ((list (assoc (gnus-group-topic group) gnus-topic-alist))
- (after (cdr (member group (cdr list)))))
+ (topic-visible (save-excursion (gnus-topic-goto-topic (car list))))
+ (after (and topic-visible (cdr (member group (cdr list))))))
;; First try to put point on a group after the current one.
(while (and after
(not (gnus-group-goto-group (car after))))
@@ -989,7 +985,9 @@ articles in the topic and its subtopics."
(if (not (car list))
(goto-char (point-min))
(unless after
- (gnus-topic-goto-topic (car list))
+ (if topic-visible
+ (gnus-goto-char topic-visible)
+ (gnus-topic-goto-topic (gnus-topic-next-topic (car list))))
(setq after nil)))
t))))
@@ -1297,6 +1295,8 @@ When used interactively, PARENT will be the topic under point."
;; 2. Can't process on several marked groups with a same name,
;; because gnus-group-marked only keeps one copy.
+(defvar gnus-topic-history nil)
+
(defun gnus-topic-move-group (n topic &optional copyp)
"Move the next N groups to TOPIC.
If COPYP, copy the groups instead."
diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el
index 5530c3d9a34..b94df4df508 100644
--- a/lisp/gnus/gnus-undo.el
+++ b/lisp/gnus/gnus-undo.el
@@ -1,6 +1,6 @@
;;; gnus-undo.el --- minor mode for undoing in Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 14551737837..f5e1077f8c4 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1,6 +1,6 @@
;;; gnus-util.el --- utility functions for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -169,15 +169,6 @@ This is a compatibility function for different Emacsen."
`(delete-region (point-at-bol)
(progn (forward-line ,(or n 1)) (point))))
-(defun gnus-byte-code (func)
- "Return a form that can be `eval'ed based on FUNC."
- (let ((fval (indirect-function func)))
- (if (byte-code-function-p fval)
- (let ((flist (append fval nil)))
- (setcar flist 'byte-code)
- flist)
- (cons 'progn (cddr fval)))))
-
(defun gnus-extract-address-components (from)
"Extract address components from a From header.
Given an RFC-822 address FROM, extract full name and canonical address.
@@ -216,16 +207,6 @@ is slower."
(match-end 0)))))
(list (if (string= name "") nil name) (or address from))))
-(defun gnus-extract-address-component-name (from)
- "Extract name from a From header.
-Uses `gnus-extract-address-components'."
- (nth 0 (gnus-extract-address-components from)))
-
-(defun gnus-extract-address-component-email (from)
- "Extract e-mail address from a From header.
-Uses `gnus-extract-address-components'."
- (nth 1 (gnus-extract-address-components from)))
-
(declare-function message-fetch-field "message" (header &optional not-all))
(defun gnus-fetch-field (field)
@@ -664,10 +645,6 @@ If N, return the Nth ancestor instead."
;; should be gnus-characterp, but this can't be called in XEmacs anyway
(cons (and (numberp event) event) event)))
-(defun gnus-sortable-date (date)
- "Make string suitable for sorting from DATE."
- (gnus-time-iso8601 (date-to-time date)))
-
(defun gnus-copy-file (file &optional to)
"Copy FILE to TO."
(interactive
@@ -852,28 +829,6 @@ If there's no subdirectory, delete DIRECTORY as well."
(unless dir
(delete-directory directory)))))
-;; The following two functions are used in gnus-registry.
-;; They were contributed by Andreas Fuchs <asf@void.at>.
-(defun gnus-alist-to-hashtable (alist)
- "Build a hashtable from the values in ALIST."
- (let ((ht (make-hash-table
- :size 4096
- :test 'equal)))
- (mapc
- (lambda (kv-pair)
- (puthash (car kv-pair) (cdr kv-pair) ht))
- alist)
- ht))
-
-(defun gnus-hashtable-to-alist (hash)
- "Build an alist from the values in HASH."
- (let ((list nil))
- (maphash
- (lambda (key value)
- (setq list (cons (cons key value) list)))
- hash)
- list))
-
(defun gnus-strip-whitespace (string)
"Return STRING stripped of all whitespace."
(while (string-match "[\r\n\t ]+" string)
@@ -1250,13 +1205,6 @@ This function saves the current buffer."
(with-current-buffer gnus-group-buffer
(eq major-mode 'gnus-group-mode))))
-(defun gnus-process-live-p (process)
- "Returns non-nil if PROCESS is alive.
-A process is considered alive if its status is `run', `open',
-`listen', `connect' or `stop'."
- (memq (process-status process)
- '(run open listen connect stop)))
-
(defun gnus-remove-if (predicate sequence &optional hash-table-p)
"Return a copy of SEQUENCE with all items satisfying PREDICATE removed.
SEQUENCE should be a list, a vector, or a string. Returns always a list.
@@ -1927,6 +1875,19 @@ Sizes are in pixels."
image)))
image)))
+(defun gnus-recursive-directory-files (dir)
+ "Return all regular files below DIR."
+ (let (files)
+ (dolist (file (directory-files dir t))
+ (when (and (not (member (file-name-nondirectory file) '("." "..")))
+ (file-readable-p file))
+ (cond
+ ((file-regular-p file)
+ (push file files))
+ ((file-directory-p file)
+ (setq files (append (gnus-recursive-directory-files file) files))))))
+ files))
+
(defun gnus-list-memq-of-list (elements list)
"Return non-nil if any of the members of ELEMENTS are in LIST."
(let ((found nil))
@@ -1965,6 +1926,18 @@ Same as `string-match' except this function does not change the match data."
(save-match-data
(string-match regexp string start))))
+(if (fboundp 'string-prefix-p)
+ (defalias 'gnus-string-prefix-p 'string-prefix-p)
+ (defun gnus-string-prefix-p (str1 str2 &optional ignore-case)
+ "Return non-nil if STR1 is a prefix of STR2.
+If IGNORE-CASE is non-nil, the comparison is done without paying attention
+to case differences."
+ (and (<= (length str1) (length str2))
+ (let ((prefix (substring str2 0 (length str1))))
+ (if ignore-case
+ (string-equal (downcase str1) (downcase prefix))
+ (string-equal str1 prefix))))))
+
(eval-and-compile
(if (fboundp 'macroexpand-all)
(defalias 'gnus-macroexpand-all 'macroexpand-all)
@@ -1991,6 +1964,11 @@ definitions to shadow the loaded ones for use in file byte-compilation."
(defun gnus-bound-and-true-p (sym)
(and (boundp sym) (symbol-value sym)))
+(if (fboundp 'timer--function)
+ (defalias 'gnus-timer--function 'timer--function)
+ (defun gnus-timer--function (timer)
+ (elt timer 5)))
+
(provide 'gnus-util)
;;; gnus-util.el ends here
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index 50a33809946..1ca6d0e10ed 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -1,6 +1,6 @@
;;; gnus-uu.el --- extract (uu)encoded files in Gnus
-;; Copyright (C) 1985-1987, 1993-1998, 2000-2011
+;; Copyright (C) 1985-1987, 1993-1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -1615,16 +1615,6 @@ Gnus might fail to display all of it.")
gnus-shell-command-separator " sh")))))
state))
-;; Returns the name of what the shar file is going to unpack.
-(defun gnus-uu-find-name-in-shar ()
- (let ((oldpoint (point))
- res)
- (goto-char (point-min))
- (when (re-search-forward gnus-uu-shar-name-marker nil t)
- (setq res (buffer-substring (match-beginning 1) (match-end 1))))
- (goto-char oldpoint)
- res))
-
;; `gnus-uu-choose-action' chooses what action to perform given the name
;; and `gnus-uu-file-action-list'. Returns either nil if no action is
;; found, or the name of the command to run if such a rule is found.
diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el
index 522f03c43c1..d5028fe6e5b 100644
--- a/lisp/gnus/gnus-vm.el
+++ b/lisp/gnus/gnus-vm.el
@@ -1,6 +1,6 @@
;;; gnus-vm.el --- vm interface for Gnus
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Author: Per Persson <pp@gnu.ai.mit.edu>
;; Keywords: news, mail
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index f0009830b44..bd9ea10fdc4 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -1,6 +1,6 @@
;;; gnus-win.el --- window configuration functions for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -239,7 +239,8 @@ See the Gnus manual for an explanation of the syntax used.")
(defun gnus-configure-frame (split &optional window)
"Split WINDOW according to SPLIT."
- (let* ((current-window (or (get-buffer-window (current-buffer)) (selected-window)))
+ (let* ((current-window (or (get-buffer-window (current-buffer))
+ (selected-window)))
(window (or window current-window)))
(select-window window)
;; The SPLIT might be something that is to be evalled to
@@ -269,9 +270,23 @@ See the Gnus manual for an explanation of the syntax used.")
(let ((buf (gnus-get-buffer-create
(gnus-window-to-buffer-helper buffer))))
(when (buffer-name buf)
- (if (eq buf (window-buffer (selected-window)))
- (set-buffer buf)
- (switch-to-buffer buf))))
+ (cond
+ ((eq buf (window-buffer (selected-window)))
+ (set-buffer buf))
+ ((eq t (window-dedicated-p
+ ;; XEmacs version of `window-dedicated-p' requires it.
+ (selected-window)))
+ ;; If the window is hard-dedicated, we have a problem because
+ ;; we just can't do what we're asked. But signaling an error,
+ ;; like `switch-to-buffer' would do, is not an option because
+ ;; it would prevent things like "^" (to jump to the *Servers*)
+ ;; in a dedicated *Group*.
+ ;; FIXME: Maybe a better/additional fix would be to change
+ ;; gnus-configure-windows so that when called
+ ;; from a hard-dedicated frame, it creates (and
+ ;; configures) a new frame, leaving the dedicated frame alone.
+ (pop-to-buffer buf))
+ (t (switch-to-buffer buf)))))
(when (memq 'frame-focus split)
(setq gnus-window-frame-focus window))
;; We return the window if it has the `point' spec.
@@ -340,9 +355,9 @@ See the Gnus manual for an explanation of the syntax used.")
;; fashion.
(setq comp-subs (nreverse comp-subs))
(while comp-subs
- (if (null (cdr comp-subs))
- (setq new-win window)
- (setq new-win
+ (setq new-win
+ (if (null (cdr comp-subs))
+ window
(split-window window (cadar comp-subs)
(eq type 'horizontal))))
(setq result (or (gnus-configure-frame
@@ -464,6 +479,7 @@ should have point."
(unless buffer
(error "Invalid buffer type: %s" type))
(if (and (setq buf (get-buffer (gnus-window-to-buffer-helper buffer)))
+ (buffer-live-p buf)
(setq win (gnus-get-buffer-window buf t)))
(if (memq 'point split)
(setq all-visible win))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index b1f0f60668e..8fbde5c8ecc 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1,6 +1,6 @@
;;; gnus.el --- a newsreader for GNU Emacs
-;; Copyright (C) 1987-1990, 1993-1998, 2000-2011
+;; Copyright (C) 1987-1990, 1993-1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -1009,10 +1009,11 @@ be set in `.emacs' instead."
(purp "#9999cc" "#666699")
(no "#ff0000" "#ffff00")
(neutral "#b4b4b4" "#878787")
+ (ma "#2020e0" "#8080ff")
(september "#bf9900" "#ffcc00"))
"Color alist used for the Gnus logo.")
-(defcustom gnus-logo-color-style 'no
+(defcustom gnus-logo-color-style 'ma
"*Color styles used for the Gnus logo."
:type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
gnus-logo-color-alist))
@@ -1271,15 +1272,18 @@ Set this variable in `.emacs' instead."
:type '(choice (const :tag "current" nil)
directory))
-;; Site dependent variables. These variables should be defined in
-;; paths.el.
+;; Site dependent variables.
-(defvar gnus-default-nntp-server nil
- "Specify a default NNTP server.
-This variable should be defined in paths.el, and should never be set
-by the user.
-If you want to change servers, you should use `gnus-select-method'.
-See the documentation to that variable.")
+;; Should this be obsolete?
+(defcustom gnus-default-nntp-server nil
+ "The hostname of the default NNTP server.
+The empty string, or nil, means to use the local host.
+You may wish to set this on a site-wide basis.
+
+If you want to change servers, you should use `gnus-select-method'."
+ :group 'gnus-server
+ :type '(choice (const :tag "local host" nil)
+ (string :tag "host name")))
(defcustom gnus-nntpserver-file "/etc/nntpserver"
"A file with only the name of the nntp server in it."
@@ -1326,6 +1330,8 @@ If you use this variable, you must set `gnus-nntp-server' to nil.
There is a lot more to know about select methods and virtual servers -
see the manual for details."
+ ;; Emacs has set-after since 22.1.
+ ;set-after '(gnus-default-nntp-server)
:group 'gnus-server
:group 'gnus-start
:initialize 'custom-initialize-default
@@ -1626,7 +1632,7 @@ slower."
("nnagent" post-mail)
("nnimap" post-mail address prompt-address physical-address respool
server-marks)
- ("nnmaildir" mail respool address)
+ ("nnmaildir" mail respool address server-marks)
("nnnil" none))
"*An alist of valid select methods.
The first element of each list lists should be a string with the name
@@ -1641,12 +1647,13 @@ this variable. I think."
(const :format "%v " mail)
(const :format "%v " none)
(const post-mail))
- (checklist :inline t
+ (checklist :inline t :greedy t
(const :format "%v " address)
(const :format "%v " prompt-address)
(const :format "%v " physical-address)
- (const :format "%v " virtual)
- (const respool))))
+ (const virtual)
+ (const :format "%v " respool)
+ (const server-marks))))
:version "24.1")
(defun gnus-redefine-select-method-widget ()
@@ -2798,6 +2805,8 @@ gnus-registry.el will populate this if it's loaded.")
("gnus-kill" gnus-kill gnus-apply-kill-file-internal
gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score)
+ ("gnus-registry" gnus-try-warping-via-registry
+ gnus-registry-handle-action)
("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
gnus-cache-possibly-remove-articles gnus-cache-request-article
gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
@@ -3404,15 +3413,6 @@ that that variable is buffer-local to the summary buffers."
(t ;Has positive number
(eq (gnus-request-type group article) 'news)))) ;use it.
-;; Returns a list of writable groups.
-(defun gnus-writable-groups ()
- (let ((alist gnus-newsrc-alist)
- groups group)
- (while (setq group (car (pop alist)))
- (unless (gnus-group-read-only-p group)
- (push group groups)))
- (nreverse groups)))
-
;; Check whether to use long file names.
(defun gnus-use-long-file-name (symbol)
;; The variable has to be set...
@@ -3609,6 +3609,13 @@ that that variable is buffer-local to the summary buffers."
;; If p2 now is empty, they were equal.
(null p2))))
+(defun gnus-method-ephemeral-p (method)
+ (let ((equal nil))
+ (dolist (ephemeral gnus-ephemeral-servers)
+ (when (gnus-sloppily-equal-method-parameters method ephemeral)
+ (setq equal t)))
+ equal))
+
(defun gnus-methods-sloppily-equal (m1 m2)
;; Same method.
(or
@@ -3681,21 +3688,10 @@ server is native)."
group
(concat (gnus-method-to-server-name method) ":" group)))
-(defun gnus-group-guess-prefixed-name (group)
- "Guess the whole name from GROUP and METHOD."
- (gnus-group-prefixed-name group (gnus-find-method-for-group
- group)))
-
(defun gnus-group-full-name (group method)
"Return the full name from GROUP and METHOD, even if the method is native."
(gnus-group-prefixed-name group method t))
-(defun gnus-group-guess-full-name (group)
- "Guess the full name from GROUP, even if the method is native."
- (if (gnus-group-prefixed-p group)
- group
- (gnus-group-full-name group (gnus-find-method-for-group group))))
-
(defun gnus-group-guess-full-name-from-command-method (group)
"Guess the full name from GROUP, even if the method is native."
(if (gnus-group-prefixed-p group)
@@ -3828,12 +3824,28 @@ You should probably use `gnus-find-method-for-group' instead."
"Go through PARAMETERS and expand them according to the match data."
(let (new)
(dolist (elem parameters)
- (if (and (stringp (cdr elem))
- (string-match "\\\\[0-9&]" (cdr elem)))
- (push (cons (car elem)
- (gnus-expand-group-parameter match (cdr elem) group))
- new)
- (push elem new)))
+ (cond
+ ((and (stringp (cdr elem))
+ (string-match "\\\\[0-9&]" (cdr elem)))
+ (push (cons (car elem)
+ (gnus-expand-group-parameter match (cdr elem) group))
+ new))
+ ;; For `sieve' group parameters, perform substitutions for every
+ ;; string within the match rule. This allows for parameters such
+ ;; as:
+ ;; ("list\\.\\(.*\\)"
+ ;; (sieve header :is "list-id" "<\\1.domain.org>"))
+ ((eq 'sieve (car elem))
+ (push (mapcar (lambda (sieve-elem)
+ (if (and (stringp sieve-elem)
+ (string-match "\\\\[0-9&]" sieve-elem))
+ (gnus-expand-group-parameter match sieve-elem
+ group)
+ sieve-elem))
+ (cdr elem))
+ new))
+ (t
+ (push elem new))))
new))
(defun gnus-group-fast-parameter (group symbol &optional allow-list)
@@ -3860,13 +3872,25 @@ The function `gnus-group-find-parameter' will do that for you."
;; The car is regexp matching for matching the group name.
(when (string-match (car head) group)
;; The cdr is the parameters.
- (setq result (gnus-group-parameter-value (cdr head)
- symbol allow-list))
- (when result
- ;; Expand if necessary.
- (if (and (stringp result) (string-match "\\\\[0-9&]" result))
- (setq result (gnus-expand-group-parameter (car head)
- result group))))))
+ (let ((this-result
+ (gnus-group-parameter-value (cdr head) symbol allow-list t)))
+ (when this-result
+ (setq result (car this-result))
+ ;; Expand if necessary.
+ (cond
+ ((and (stringp result) (string-match "\\\\[0-9&]" result))
+ (setq result (gnus-expand-group-parameter
+ (car head) result group)))
+ ;; For `sieve' group parameters, perform substitutions
+ ;; for every string within the match rule (see above).
+ ((eq symbol 'sieve)
+ (setq result
+ (mapcar (lambda (elem)
+ (if (stringp elem)
+ (gnus-expand-group-parameter (car head)
+ elem group)
+ elem))
+ result))))))))
;; Done.
result))))
@@ -3876,7 +3900,9 @@ If SYMBOL, return the value of that symbol in the group parameters.
If you call this function inside a loop, consider using the faster
`gnus-group-fast-parameter' instead."
- (with-current-buffer gnus-group-buffer
+ (with-current-buffer (if (buffer-live-p (get-buffer gnus-group-buffer))
+ gnus-group-buffer
+ (current-buffer))
(if symbol
(gnus-group-fast-parameter group symbol allow-list)
(nconc
@@ -4113,12 +4139,17 @@ parameters."
(if (or (not (inline (gnus-similar-server-opened method)))
(not (cddr method)))
method
- (setq method
- `(,(car method) ,(concat (cadr method) "+" group)
- (,(intern (format "%s-address" (car method))) ,(cadr method))
- ,@(cddr method)))
- (push method gnus-extended-servers)
- method))
+ (let ((address-slot
+ (intern (format "%s-address" (car method)))))
+ (setq method
+ (if (assq address-slot (cddr method))
+ `(,(car method) ,(concat (cadr method) "+" group)
+ ,@(cddr method))
+ `(,(car method) ,(concat (cadr method) "+" group)
+ (,address-slot ,(cadr method))
+ ,@(cddr method))))
+ (push method gnus-extended-servers)
+ method)))
(defun gnus-server-status (method)
"Return the status of METHOD."
@@ -4382,7 +4413,9 @@ prompt the user for the name of an NNTP server to use."
(gnus-1 arg dont-connect slave)
(gnus-final-warning)))
-(autoload 'debbugs-gnu "debbugs-gnu")
+(eval-and-compile
+ (unless (fboundp 'debbugs-gnu)
+ (autoload 'debbugs-gnu "debbugs-gnu" "List all outstanding Emacs bugs." t)))
(defun gnus-list-debbugs ()
"List all open Gnus bug reports."
(interactive)
diff --git a/lisp/gnus/gravatar.el b/lisp/gnus/gravatar.el
index 4b0c9a16283..a10ea21b96b 100644
--- a/lisp/gnus/gravatar.el
+++ b/lisp/gnus/gravatar.el
@@ -1,6 +1,6 @@
;;; gravatar.el --- Get Gravatars
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: news
@@ -29,6 +29,7 @@
(defgroup gravatar nil
"Gravatar."
+ :version "24.1"
:group 'comm)
(defcustom gravatar-automatic-caching t
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el
index e96c23b14ac..ab8831dc49e 100644
--- a/lisp/gnus/gssapi.el
+++ b/lisp/gnus/gssapi.el
@@ -1,6 +1,6 @@
;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -37,6 +37,7 @@
and %l with the user name. The program should accept commands on
stdin and return responses to stdout. Each entry in the list is
tried until a successful connection is made."
+ :version "24.1"
:group 'network
:type '(repeat string))
diff --git a/lisp/gnus/html2text.el b/lisp/gnus/html2text.el
index dade86ab174..8c20547806e 100644
--- a/lisp/gnus/html2text.el
+++ b/lisp/gnus/html2text.el
@@ -1,6 +1,6 @@
;;; html2text.el --- a simple html to plain text converter
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Joakim Hove <hove@phys.ntnu.no>
diff --git a/lisp/gnus/ietf-drums.el b/lisp/gnus/ietf-drums.el
index 4d99cea7608..6f5446e1f7e 100644
--- a/lisp/gnus/ietf-drums.el
+++ b/lisp/gnus/ietf-drums.el
@@ -1,6 +1,6 @@
;;; ietf-drums.el --- Functions for parsing RFC822bis headers
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el
index 6c6d119c0c5..ecde35dca8f 100644
--- a/lisp/gnus/legacy-gnus-agent.el
+++ b/lisp/gnus/legacy-gnus-agent.el
@@ -1,6 +1,6 @@
;;; gnus-agent.el --- Legacy unplugged support for Gnus
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Kevin Greiner <kgreiner@xpediantsolutions.com>
;; Keywords: news
@@ -206,29 +206,31 @@ converted to the compressed format."
(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t)
(defun gnus-agent-unhook-expire-days (converting-to)
- "Remove every lambda from gnus-group-prepare-hook that mention the
-symbol gnus-agent-do-once in their definition. This should NOT be
+ "Remove every lambda from `gnus-group-prepare-hook' that mention the
+symbol `gnus-agent-do-once' in their definition. This should NOT be
necessary as gnus-agent.el no longer adds them. However, it is
possible that the hook was persistently saved."
- (let ((h t)) ; iterate from bgn of hook
+ (let ((h t)) ; Iterate from bgn of hook.
(while h
(let ((func (progn (when (eq h t)
- ;; init h to list of functions
+ ;; Init h to list of functions.
(setq h (cond ((listp gnus-group-prepare-hook)
gnus-group-prepare-hook)
((boundp 'gnus-group-prepare-hook)
(list gnus-group-prepare-hook)))))
(pop h))))
- (when (cond ((eq (type-of func) 'compiled-function)
- ;; Search def. of compiled function for gnus-agent-do-once string
+ (when (cond ((byte-code-function-p func)
+ ;; Search def. of compiled function for
+ ;; gnus-agent-do-once string.
(let* (definition
print-level
print-length
(standard-output
(lambda (char)
(setq definition (cons char definition)))))
- (princ func) ; populates definition with reversed list of characters
+ (princ func) ; Populates definition with reversed list
+ ; of characters.
(let* ((i (length definition))
(s (make-string i 0)))
(while definition
@@ -236,7 +238,7 @@ possible that the hook was persistently saved."
(string-match "\\bgnus-agent-do-once\\b" s))))
((listp func)
- (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; handles eval'd lambda
+ (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; Handles eval'd lambda.
))
(remove-hook 'gnus-group-prepare-hook func)
diff --git a/lisp/gnus/mail-parse.el b/lisp/gnus/mail-parse.el
index 0fcc206cf71..646f9ad27b3 100644
--- a/lisp/gnus/mail-parse.el
+++ b/lisp/gnus/mail-parse.el
@@ -1,6 +1,6 @@
;;; mail-parse.el --- Interface functions for parsing mail
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/mail-prsvr.el b/lisp/gnus/mail-prsvr.el
index b87656dab4d..ebb6cf3245a 100644
--- a/lisp/gnus/mail-prsvr.el
+++ b/lisp/gnus/mail-prsvr.el
@@ -1,6 +1,6 @@
;;; mail-prsvr.el --- Interface variables for parsing mail
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 2315cff6261..fc66414a9f0 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -1,6 +1,6 @@
;;; mail-source.el --- functions for fetching mail
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
@@ -63,7 +63,7 @@
This variable is a list of mail source specifiers.
See Info node `(gnus)Mail Source Specifiers'."
:group 'mail-source
- :version "23.1" ;; No Gnus
+ :version "24.4"
:link '(custom-manual "(gnus)Mail Source Specifiers")
:type `(choice
(const :tag "None" nil)
@@ -159,7 +159,18 @@ See Info node `(gnus)Mail Source Specifiers'."
:value nil
(const :tag "Clear" nil)
(const starttls)
- (const :tag "SSL/TLS" ssl)))))
+ (const :tag "SSL/TLS" ssl)))
+ (group :inline t
+ (const :format "" :value :leave)
+ (choice :format "\
+%{Leave mail on server%}:\n\t\t%[Value Menu%] %v"
+ :value nil
+ (const :tag "\
+Don't leave mails" nil)
+ (const :tag "\
+Leave all mails" t)
+ (number :tag "\
+Leave mails for this many days" :value 14)))))
(cons :tag "Maildir (qmail, postfix...)"
(const :format "" maildir)
(checklist :tag "Options" :greedy t
@@ -340,7 +351,8 @@ Common keywords should be listed here.")
(:function)
(:password)
(:authentication password)
- (:stream nil))
+ (:stream nil)
+ (:leave))
(maildir
(:path (or (getenv "MAILDIR") "~/Maildir/"))
(:subdirs ("cur" "new"))
@@ -721,12 +733,6 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
;; Return whether we moved successfully or not.
to)))
-(defun mail-source-movemail-and-remove (from to)
- "Move FROM to TO using movemail, then remove FROM if empty."
- (or (not (mail-source-movemail from to))
- (not (zerop (nth 7 (file-attributes from))))
- (delete-file from)))
-
(defun mail-source-fetch-with-program (program)
(eq 0 (call-process shell-file-name nil nil nil
shell-command-switch program)))
@@ -831,7 +837,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(pop3-port port)
(pop3-authentication-scheme
(if (eq authentication 'apop) 'apop 'pass))
- (pop3-stream-type stream))
+ (pop3-stream-type stream)
+ (pop3-leave-mail-on-server leave))
(if (or debug-on-quit debug-on-error)
(save-excursion (pop3-movemail mail-source-crash-box))
(condition-case err
diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el
index cbfa05bb87d..d3e80e6daa2 100644
--- a/lisp/gnus/mailcap.el
+++ b/lisp/gnus/mailcap.el
@@ -1,6 +1,6 @@
;;; mailcap.el --- MIME media types configuration
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: William M. Perry <wmperry@aventail.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 5198618c2c3..5a2b4334582 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1,6 +1,6 @@
;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
@@ -592,8 +592,10 @@ Done before generating the new subject of a forward."
;; comes back to you (e.g. a mailing-list to which you subscribe, in which
;; case you may be removed from the list on the grounds that mail to you
;; bounced with a "mailing loop" error).
- "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:"
+ "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:\
+\\|^X-Content-Length:\\|^X-UIDL:"
"*All headers that match this regexp will be deleted when resending a message."
+ :version "24.4"
:group 'message-interface
:link '(custom-manual "(message)Resending")
:type '(repeat :value-to-internal (lambda (widget value)
@@ -655,14 +657,16 @@ Done before generating the new subject of a forward."
(t
(error "Don't know how to send mail. Please customize `message-send-mail-function'"))))
-;; Useful to set in site-init.el
-(defcustom message-send-mail-function
+(defun message-default-send-mail-function ()
(cond ((eq send-mail-function 'smtpmail-send-it) 'message-smtpmail-send-it)
((eq send-mail-function 'feedmail-send-it) 'feedmail-send-it)
((eq send-mail-function 'sendmail-query-once) 'sendmail-query-once)
((eq send-mail-function 'mailclient-send-it)
'message-send-mail-with-mailclient)
- (t (message-send-mail-function)))
+ (t (message-send-mail-function))))
+
+;; Useful to set in site-init.el
+(defcustom message-send-mail-function (message-default-send-mail-function)
"Function to call to send the current buffer as mail.
The headers should be delimited by a line whose contents match the
variable `mail-header-separator'.
@@ -1093,6 +1097,7 @@ probably want to set this variable only for specific groups,
e.g. using `gnus-posting-styles':
(eval (set (make-local-variable 'message-cite-reply-position) 'above))"
+ :version "24.1"
:type '(choice (const :tag "Reply inline" 'traditional)
(const :tag "Reply above" 'above)
(const :tag "Reply below" 'below))
@@ -1329,11 +1334,11 @@ If nil, you might be asked to input the charset."
:type 'symbol)
(defcustom message-dont-reply-to-names
- (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
+ (and (boundp 'mail-dont-reply-to-names) mail-dont-reply-to-names)
"*Addresses to prune when doing wide replies.
This can be a regexp or a list of regexps. Also, a value of nil means
exclude your own user name only."
- :version "21.1"
+ :version "24.3"
:group 'message
:link '(custom-manual "(message)Wide Reply")
:type '(choice (const :tag "Yourself" nil)
@@ -1930,10 +1935,13 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
(autoload 'nndraft-request-associate-buffer "nndraft")
(autoload 'nndraft-request-expire-articles "nndraft")
(autoload 'nnvirtual-find-group-art "nnvirtual")
-(autoload 'rmail-dont-reply-to "mail-utils")
(autoload 'rmail-msg-is-pruned "rmail")
(autoload 'rmail-output "rmailout")
+;; Emacs < 24.1 do not have mail-dont-reply-to
+(unless (fboundp 'mail-dont-reply-to)
+ (defalias 'mail-dont-reply-to 'rmail-dont-reply-to))
+
;;;
@@ -2600,7 +2608,7 @@ Point is left at the beginning of the narrowed-to region."
(interactive)
(let ((start (point)))
(message-skip-to-next-address)
- (kill-region start (point))))
+ (kill-region start (if (bolp) (1- (point)) (point)))))
(autoload 'Info-goto-node "info")
@@ -3054,66 +3062,79 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
(defun message-goto-to ()
"Move point to the To header."
(interactive)
+ (push-mark)
(message-position-on-field "To"))
(defun message-goto-from ()
"Move point to the From header."
(interactive)
+ (push-mark)
(message-position-on-field "From"))
(defun message-goto-subject ()
"Move point to the Subject header."
(interactive)
+ (push-mark)
(message-position-on-field "Subject"))
(defun message-goto-cc ()
"Move point to the Cc header."
(interactive)
+ (push-mark)
(message-position-on-field "Cc" "To"))
(defun message-goto-bcc ()
"Move point to the Bcc header."
(interactive)
+ (push-mark)
(message-position-on-field "Bcc" "Cc" "To"))
(defun message-goto-fcc ()
"Move point to the Fcc header."
(interactive)
+ (push-mark)
(message-position-on-field "Fcc" "To" "Newsgroups"))
(defun message-goto-reply-to ()
"Move point to the Reply-To header."
(interactive)
+ (push-mark)
(message-position-on-field "Reply-To" "Subject"))
(defun message-goto-newsgroups ()
"Move point to the Newsgroups header."
(interactive)
+ (push-mark)
(message-position-on-field "Newsgroups"))
(defun message-goto-distribution ()
"Move point to the Distribution header."
(interactive)
+ (push-mark)
(message-position-on-field "Distribution"))
(defun message-goto-followup-to ()
"Move point to the Followup-To header."
(interactive)
+ (push-mark)
(message-position-on-field "Followup-To" "Newsgroups"))
(defun message-goto-mail-followup-to ()
"Move point to the Mail-Followup-To header."
(interactive)
+ (push-mark)
(message-position-on-field "Mail-Followup-To" "To"))
(defun message-goto-keywords ()
"Move point to the Keywords header."
(interactive)
+ (push-mark)
(message-position-on-field "Keywords" "Subject"))
(defun message-goto-summary ()
"Move point to the Summary header."
(interactive)
+ (push-mark)
(message-position-on-field "Summary" "Subject"))
(eval-when-compile
@@ -3134,14 +3155,19 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
(when (and (message-called-interactively-p 'any)
(looking-at "[ \t]*\n"))
(expand-abbrev))
+ (push-mark)
(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)))
(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."
@@ -3154,6 +3180,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
If there is no signature in the article, go to the end and
return nil."
(interactive)
+ (push-mark)
(goto-char (point-min))
(if (re-search-forward message-signature-separator nil t)
(forward-line 1)
@@ -3271,11 +3298,33 @@ or in the synonym headers, defined by `message-header-synonyms'."
(defun message-insert-newsgroups ()
"Insert the Newsgroups header from the article being replied to."
(interactive)
- (when (and (message-position-on-field "Newsgroups")
- (mail-fetch-field "newsgroups")
- (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
- (insert ","))
- (insert (or (message-fetch-reply-field "newsgroups") "")))
+ (let ((old-newsgroups (mail-fetch-field "newsgroups"))
+ (new-newsgroups (message-fetch-reply-field "newsgroups"))
+ (first t)
+ insert-newsgroups)
+ (message-position-on-field "Newsgroups")
+ (cond
+ ((not new-newsgroups)
+ (error "No Newsgroups to insert"))
+ ((not old-newsgroups)
+ (insert new-newsgroups))
+ (t
+ (setq new-newsgroups (split-string new-newsgroups "[, ]+")
+ old-newsgroups (split-string old-newsgroups "[, ]+"))
+ (dolist (group new-newsgroups)
+ (unless (member group old-newsgroups)
+ (push group insert-newsgroups)))
+ (if (null insert-newsgroups)
+ (error "Newgroup%s already in the header"
+ (if (> (length new-newsgroups) 1)
+ "s" ""))
+ (when old-newsgroups
+ (setq first nil))
+ (dolist (group insert-newsgroups)
+ (unless first
+ (insert ","))
+ (setq first nil)
+ (insert group)))))))
@@ -3793,7 +3842,7 @@ prefix, and don't delete any headers."
(save-current-buffer
(dolist (buffer (buffer-list t))
(set-buffer buffer)
- (when (and (eq major-mode 'message-mode)
+ (when (and (derived-mode-p 'message-mode)
(null message-sent-message-via))
(push (buffer-name buffer) buffers))))
(nreverse buffers)))
@@ -3993,28 +4042,6 @@ This function strips off the signature from the original message."
(forward-char -1)
nil))))
-(defun message-remove-signature ()
- "Remove the signature from the text between point and mark.
-The text will also be indented the normal way."
- (save-excursion
- (let ((start (point))
- mark)
- (if (not (re-search-forward message-signature-separator (mark t) t))
- ;; No signature here, so we just indent the cited text.
- (message-indent-citation)
- ;; Find the last non-empty line.
- (forward-line -1)
- (while (looking-at "[ \t]*$")
- (forward-line -1))
- (forward-line 1)
- (setq mark (set-marker (make-marker) (point)))
- (goto-char start)
- (message-indent-citation)
- ;; Enable undoing the deletion.
- (undo-boundary)
- (delete-region mark (mark t))
- (set-marker mark nil)))))
-
;;;
@@ -4476,8 +4503,9 @@ This function could be useful in `message-setup-hook'."
(end-of-line)
(insert (format " (%d/%d)" n total))
(widen)
- (funcall (or message-send-mail-real-function
- message-send-mail-function)))
+ (if message-send-mail-real-function
+ (funcall message-send-mail-real-function)
+ (message-multi-smtp-send-mail)))
(setq n (+ n 1))
(setq p (pop plist))
(erase-buffer)))
@@ -4631,8 +4659,9 @@ If you always want Gnus to send messages in one piece, set
")))
(progn
(message "Sending via mail...")
- (funcall (or message-send-mail-real-function
- message-send-mail-function)))
+ (if message-send-mail-real-function
+ (funcall message-send-mail-real-function)
+ (message-multi-smtp-send-mail)))
(message-send-mail-partially))
(setq options message-options))
(kill-buffer tembuf))
@@ -4641,6 +4670,28 @@ If you always want Gnus to send messages in one piece, set
(push 'mail message-sent-message-via)))
(defvar sendmail-program)
+(defvar smtpmail-smtp-user)
+
+(defun message-multi-smtp-send-mail ()
+ "Send the current buffer to `message-send-mail-function'.
+Or, if there's a header that specifies a different method, use
+that instead."
+ (let ((method (message-field-value "X-Message-SMTP-Method")))
+ (if (not method)
+ (funcall message-send-mail-function)
+ (message-remove-header "X-Message-SMTP-Method")
+ (setq method (split-string method))
+ (cond
+ ((equal (car method) "sendmail")
+ (message-send-mail-with-sendmail))
+ ((equal (car method) "smtp")
+ (require 'smtpmail)
+ (let ((smtpmail-smtp-server (nth 1 method))
+ (smtpmail-smtp-service (nth 2 method))
+ (smtpmail-smtp-user (or (nth 3 method) smtpmail-smtp-user)))
+ (message-smtpmail-send-it)))
+ (t
+ (error "Unknown method %s" method))))))
(defun message-send-mail-with-sendmail ()
"Send off the prepared buffer with sendmail."
@@ -4797,9 +4848,7 @@ Do not use this for anything important, it is cryptographically weak."
(require 'sha1)
(let (sha1-maximum-internal-length)
(sha1 (concat (message-unique-id)
- (format "%x%x%x" (random)
- (progn (random t) (random))
- (random))
+ (format "%x%x%x" (random) (random) (random))
(prin1-to-string (recent-keys))
(prin1-to-string (garbage-collect))))))
@@ -5502,7 +5551,6 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
;; You might for example insert a "." somewhere (not next to another dot
;; or string boundary), or modify the "fsf" string.
(defun message-unique-id ()
- (random t)
;; Don't use microseconds from (current-time), they may be unsupported.
;; Instead we use this randomly inited counter.
(setq message-unique-id-char
@@ -5763,12 +5811,6 @@ give as trustworthy answer as possible."
(concat system-name
".i-did-not-set--mail-host-address--so-tickle-me")))))
-(defun message-make-host-name ()
- "Return the name of the host."
- (let ((fqdn (message-make-fqdn)))
- (string-match "^[^.]+\\." fqdn)
- (substring fqdn 0 (1- (match-end 0)))))
-
(defun message-make-domain ()
"Return the domain name."
(or mail-host-address
@@ -6085,20 +6127,13 @@ Headers already prepared in the buffer are not modified."
(while (and (not (= (point) end))
(or (not (eq char ?,))
quoted))
- (skip-chars-forward "^,\"" (point-max))
+ (skip-chars-forward "^,\"" end)
(when (eq (setq char (following-char)) ?\")
(setq quoted (not quoted)))
(unless (= (point) end)
(forward-char 1)))
(skip-chars-forward " \t\n")))
-(defun message-fill-address (header value)
- (insert (capitalize (symbol-name header))
- ": "
- (if (consp value) (car value) value)
- "\n")
- (message-fill-field-address))
-
(defun message-split-line ()
"Split current line, moving portion beyond point vertically down.
If the current line has `message-yank-prefix', insert it on the new line."
@@ -6129,17 +6164,22 @@ If the current line has `message-yank-prefix', insert it on the new line."
(point-max))))
(defun message-fill-field-address ()
- (while (not (eobp))
- (message-skip-to-next-address)
- (let (last)
- (if (and (> (current-column) 78)
- last)
- (progn
- (save-excursion
- (goto-char last)
- (insert "\n\t"))
- (setq last (1+ (point))))
- (setq last (1+ (point)))))))
+ (let (end last)
+ (while (not end)
+ (message-skip-to-next-address)
+ (cond ((bolp)
+ (end-of-line 0)
+ (setq end 1))
+ ((eobp)
+ (setq end 0)))
+ (when (and (> (current-column) 78)
+ last)
+ (save-excursion
+ (goto-char last)
+ (delete-char (- (skip-chars-backward " \t")))
+ (insert "\n\t")))
+ (setq last (point)))
+ (forward-line end)))
(defun message-fill-field-general ()
(let ((begin (point))
@@ -6169,7 +6209,7 @@ If the current line has `message-yank-prefix', insert it on the new line."
When sending via news, also check that the REFERENCES are less
than 988 characters long, and if they are not, trim them until
they are."
- ;; 21 is the number suggested by USEAGE.
+ ;; 21 is the number suggested by USAGE.
(let ((maxcount 21)
(count 0)
(cut 2)
@@ -6690,11 +6730,16 @@ The function is called with one parameter, a cons cell ..."
", "))
mct (message-fetch-field "mail-copies-to")
author (or (message-fetch-field "mail-reply-to")
- (message-fetch-field "reply-to")
- (message-fetch-field "from")
- "")
+ (message-fetch-field "reply-to"))
mft (and message-use-mail-followup-to
- (message-fetch-field "mail-followup-to"))))
+ (message-fetch-field "mail-followup-to")))
+ ;; Make sure this message goes to the author if this is a wide
+ ;; reply, since Reply-To address may be a list address a mailing
+ ;; list server added.
+ (when (and wide author)
+ (setq cc (concat author ", " cc)))
+ (when (or wide (not author))
+ (setq author (or (message-fetch-field "from") ""))))
;; Handle special values of Mail-Copies-To.
(when mct
@@ -6760,9 +6805,9 @@ want to get rid of this query permanently.")))
;; Squeeze whitespace.
(while (string-match "[ \t][ \t]+" recipients)
(setq recipients (replace-match " " t t recipients)))
- ;; Remove addresses that match `rmail-dont-reply-to-names'.
- (let ((rmail-dont-reply-to-names (message-dont-reply-to-names)))
- (setq recipients (rmail-dont-reply-to recipients)))
+ ;; Remove addresses that match `mail-dont-reply-to-names'.
+ (let ((mail-dont-reply-to-names (message-dont-reply-to-names)))
+ (setq recipients (mail-dont-reply-to recipients)))
;; Perhaps "Mail-Copies-To: never" removed the only address?
(if (string-equal recipients "")
(setq recipients author))
@@ -7527,7 +7572,7 @@ is for the internal use."
(message "Resending message to %s..." address)
(save-excursion
(let ((cur (current-buffer))
- beg)
+ gcc beg)
;; We first set up a normal mail buffer.
(unless (message-mail-user-agent)
(set-buffer (get-buffer-create " *message resend*"))
@@ -7540,6 +7585,8 @@ is for the internal use."
;; Insert our usual headers.
(message-generate-headers '(From Date To Message-ID))
(message-narrow-to-headers)
+ (when (setq gcc (mail-fetch-field "gcc" nil t))
+ (message-remove-header "gcc"))
;; Remove X-Draft-From header etc.
(message-remove-header message-ignored-mail-headers t)
;; Rename them all to "Resent-*".
@@ -7581,6 +7628,10 @@ is for the internal use."
message-generate-hashcash
rfc2047-encode-encoded-words)
(message-send-mail))
+ (when gcc
+ (message-goto-eoh)
+ (insert "Gcc: " gcc "\n"))
+ (run-hooks 'message-sent-hook)
(kill-buffer (current-buffer)))
(message "Resending message to %s...done" address)))
diff --git a/lisp/gnus/messcompat.el b/lisp/gnus/messcompat.el
index c0c5125aeea..ad81e286847 100644
--- a/lisp/gnus/messcompat.el
+++ b/lisp/gnus/messcompat.el
@@ -1,6 +1,6 @@
;;; messcompat.el --- making message mode compatible with mail mode
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el
new file mode 100644
index 00000000000..7cfa4659fd9
--- /dev/null
+++ b/lisp/gnus/mm-archive.el
@@ -0,0 +1,107 @@
+;;; mm-archive.el --- Functions for parsing archive files as MIME
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.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:
+
+;;; Code:
+
+(require 'mm-decode)
+(eval-when-compile
+ (autoload 'gnus-recursive-directory-files "gnus-util")
+ (autoload 'mailcap-extension-to-mime "mailcap"))
+
+(defvar mm-archive-decoders
+ '(("application/ms-tnef" t "tnef" "-f" "-" "-C")
+ ("application/zip" nil "unzip" "-j" "-x" "%f" "-d")
+ ("application/x-gtar-compressed" nil "tar" "xzf" "-" "-C")
+ ("application/x-tar" nil "tar" "xf" "-" "-C")))
+
+(defun mm-archive-decoders () mm-archive-decoders)
+
+(defun mm-dissect-archive (handle)
+ (let ((decoder (cddr (assoc (car (mm-handle-type handle))
+ mm-archive-decoders)))
+ (dir (mm-make-temp-file
+ (expand-file-name "emm." mm-tmp-directory) 'dir)))
+ (set-file-modes dir #o700)
+ (unwind-protect
+ (progn
+ (mm-with-unibyte-buffer
+ (mm-insert-part handle)
+ (if (member "%f" decoder)
+ (let ((file (expand-file-name "mail.zip" dir)))
+ (write-region (point-min) (point-max) file nil 'silent)
+ (setq decoder (copy-sequence decoder))
+ (setcar (member "%f" decoder) file)
+ (apply 'call-process (car decoder) nil nil nil
+ (append (cdr decoder) (list dir)))
+ (delete-file file))
+ (apply 'call-process-region (point-min) (point-max) (car decoder)
+ nil (get-buffer-create "*tnef*")
+ nil (append (cdr decoder) (list dir)))))
+ `("multipart/mixed"
+ ,handle
+ ,@(mm-archive-list-files (gnus-recursive-directory-files dir))))
+ (delete-directory dir t))))
+
+(defun mm-archive-list-files (files)
+ (let ((handles nil)
+ type disposition)
+ (dolist (file files)
+ (with-temp-buffer
+ (when (string-match "\\.\\([^.]+\\)$" file)
+ (setq type (mailcap-extension-to-mime (match-string 1 file))))
+ (unless type
+ (setq type "application/octet-stream"))
+ (setq disposition
+ (if (string-match "^image/\\|^text/" type)
+ "inline"
+ "attachment"))
+ (insert (format "Content-type: %s\n" type))
+ (insert "Content-Transfer-Encoding: 8bit\n\n")
+ (insert-file-contents file)
+ (push
+ (mm-make-handle (mm-copy-to-buffer)
+ (list type)
+ '8bit nil
+ `(,disposition (filename . ,file))
+ nil nil nil)
+ handles)))
+ handles))
+
+(defun mm-archive-dissect-and-inline (handle)
+ (let ((start (point-marker)))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (dolist (handle (cddr (mm-dissect-archive handle)))
+ (goto-char (point-max))
+ (mm-display-inline handle))
+ (goto-char (point-max))
+ (mm-handle-set-undisplayer
+ handle
+ `(lambda ()
+ (let ((inhibit-read-only t)
+ (end ,(point-marker)))
+ (remove-images ,start end)
+ (delete-region ,start end)))))))
+
+(provide 'mm-archive)
+
+;; mm-archive.el ends here
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index ee7ba1c193b..029218e98e7 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -1,6 +1,6 @@
;;; mm-bodies.el --- Functions for decoding MIME things
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 7ea0902bdb5..7982b745d66 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1,6 +1,6 @@
;;; mm-decode.el --- Functions for decoding MIME things
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -41,6 +41,10 @@
(autoload 'mm-extern-cache-contents "mm-extern")
(autoload 'mm-insert-inline "mm-view")
+(autoload 'mm-archive-decoders "mm-archive")
+(autoload 'mm-archive-dissect-and-inline "mm-archive")
+(autoload 'mm-dissect-archive "mm-archive")
+
(defvar gnus-current-window-configuration)
(add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
@@ -248,6 +252,8 @@ before the external MIME handler is invoked."
("message/partial" mm-inline-partial identity)
("message/external-body" mm-inline-external-body identity)
("text/.*" mm-inline-text identity)
+ ("application/x-.?tar\\(-.*\\)?" mm-archive-dissect-and-inline identity)
+ ("application/zip" mm-archive-dissect-and-inline identity)
("audio/wav" mm-inline-audio
(lambda (handle)
(and (or (featurep 'nas-sound) (featurep 'native-sound))
@@ -275,7 +281,8 @@ before the external MIME handler is invoked."
(ignore-errors
(if (fboundp 'create-image)
(create-image (buffer-string) 'imagemagick 'data-p)
- (mm-create-image-xemacs (mm-handle-media-subtype handle))))))
+ (mm-create-image-xemacs
+ (mm-handle-media-subtype handle))))))
(when image
(setcar (cdr handle) (list "image/imagemagick"))
(mm-image-fit-p handle)))))))
@@ -297,6 +304,9 @@ before the external MIME handler is invoked."
"application/pgp-signature" "application/x-pkcs7-signature"
"application/pkcs7-signature" "application/x-pkcs7-mime"
"application/pkcs7-mime"
+ "application/x-gtar-compressed"
+ "application/x-tar"
+ "application/zip"
;; Mutt still uses this even though it has already been withdrawn.
"application/pgp")
"List of media types that are to be displayed inline.
@@ -448,6 +458,7 @@ If not set, `default-directory' will be used."
(defvar mm-last-shell-command "")
(defvar mm-content-id-alist nil)
(defvar mm-postponed-undisplay-list nil)
+(defvar mm-inhibit-auto-detect-attachment nil)
;; According to RFC2046, in particular, in a digest, the default
;; Content-Type value for a body part is changed from "text/plain" to
@@ -567,7 +578,9 @@ Postpone undisplaying of viewers for types in
(autoload 'message-fetch-field "message")
(defun mm-dissect-buffer (&optional no-strict-mime loose-mime from)
- "Dissect the current buffer and return a list of MIME handles."
+ "Dissect the current buffer and return a list of MIME handles.
+If NO-STRICT-MIME, don't require the message to have a
+MIME-Version header before proceeding."
(save-excursion
(let (ct ctl type subtype cte cd description id result)
(save-restriction
@@ -653,8 +666,26 @@ Postpone undisplaying of viewers for types in
(if (equal "text/plain" (car ctl))
(assoc 'format ctl)
t))
- (mm-make-handle
- (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
+ ;; Guess what the type of application/octet-stream parts should
+ ;; really be.
+ (let ((filename (cdr (assq 'filename (cdr cdl)))))
+ (when (and (not mm-inhibit-auto-detect-attachment)
+ (equal (car ctl) "application/octet-stream")
+ filename
+ (string-match "\\.\\([^.]+\\)$" filename))
+ (let ((new-type (mailcap-extension-to-mime (match-string 1 filename))))
+ (when new-type
+ (setcar ctl new-type)))))
+ (let ((handle
+ (mm-make-handle
+ (mm-copy-to-buffer) ctl cte nil cdl description nil id))
+ (decoder (assoc (car ctl) (mm-archive-decoders))))
+ (if (and decoder
+ ;; Do automatic decoding
+ (cadr decoder)
+ (executable-find (caddr decoder)))
+ (mm-dissect-archive handle)
+ handle))))
(defun mm-dissect-multipart (ctl from)
(goto-char (point-min))
@@ -665,7 +696,9 @@ Postpone undisplaying of viewers for types in
(goto-char (point-max))
(if (re-search-backward close-delimiter nil t)
(match-beginning 0)
- (point-max)))))
+ (point-max))))
+ (mm-inhibit-auto-detect-attachment
+ (equal (car ctl) "multipart/encrypted")))
(setq boundary (concat (regexp-quote boundary) "[ \t]*$"))
(while (and (< (point) end) (re-search-forward boundary end t))
(goto-char (match-beginning 0))
@@ -736,23 +769,29 @@ external if displayed external."
(mail-content-type-get
(mm-handle-type handle) 'name)
"<file>"))
- (external mm-enable-external))
- (if (and (mm-inlinable-p ehandle)
- (mm-inlined-p ehandle))
- (progn
- (forward-line 1)
- (mm-display-inline handle)
- 'inline)
- (when (or method
- (not no-default))
- (if (and (not method)
- (equal "text" (car (split-string type "/"))))
- (progn
- (forward-line 1)
- (mm-insert-inline handle (mm-get-part handle))
- 'inline)
- (setq external
- (and method ;; If nil, we always use "save".
+ (external mm-enable-external)
+ (decoder (assoc (car (mm-handle-type handle))
+ (mm-archive-decoders))))
+ (cond
+ ((and decoder
+ (executable-find (caddr decoder)))
+ (mm-archive-dissect-and-inline handle)
+ 'inline)
+ ((and (mm-inlinable-p ehandle)
+ (mm-inlined-p ehandle))
+ (forward-line 1)
+ (mm-display-inline handle)
+ 'inline)
+ ((or method
+ (not no-default))
+ (if (and (not method)
+ (equal "text" (car (split-string type "/"))))
+ (progn
+ (forward-line 1)
+ (mm-insert-inline handle (mm-get-part handle))
+ 'inline)
+ (setq external
+ (and method ;; If nil, we always use "save".
(stringp method) ;; 'mailcap-save-binary-file
(or (eq mm-enable-external t)
(and (eq mm-enable-external 'ask)
@@ -765,12 +804,12 @@ external if displayed external."
(concat
" \"" (format method filename) "\"")
"")
- "? "))))))
- (if external
- (mm-display-external
- handle (or method 'mailcap-save-binary-file))
+ "? "))))))
+ (if external
(mm-display-external
- handle 'mailcap-save-binary-file)))))))))
+ handle (or method 'mailcap-save-binary-file))
+ (mm-display-external
+ handle 'mailcap-save-binary-file)))))))))
(declare-function gnus-configure-windows "gnus-win" (setting &optional force))
(defvar mailcap-mime-extensions) ; mailcap-mime-info autoloads
@@ -918,46 +957,38 @@ external if displayed external."
shell-command-switch command)
(set-process-sentinel
(get-buffer-process buffer)
- (lexical-let ;; Don't use `let'.
- ;; Function used to remove temp file and directory.
- ((fn `(lambda nil
- ;; Don't use `ignore-errors'.
- (condition-case nil
- (delete-file ,file)
- (error))
- (condition-case nil
- (delete-directory
- ,(file-name-directory file))
- (error))))
- ;; Form uses to kill the process buffer and
- ;; remove the undisplayer.
- (fm `(progn
- (kill-buffer ,buffer)
- ,(macroexpand
- (list 'mm-handle-set-undisplayer
- (list 'quote handle)
- nil))))
- ;; Message to be issued when the process exits.
- (done (format "Displaying %s...done" command))
- ;; In particular, the timer object (which is
- ;; a vector in Emacs but is a list in XEmacs)
- ;; requires that it is lexically scoped.
- (timer (run-at-time 2.0 nil 'ignore)))
- (if (featurep 'xemacs)
- (lambda (process state)
- (when (eq 'exit (process-status process))
- (if (memq timer itimer-list)
- (set-itimer-function timer fn)
- (funcall fn))
- (ignore-errors (eval fm))
- (message "%s" done)))
- (lambda (process state)
- (when (eq 'exit (process-status process))
- (if (memq timer timer-list)
- (timer-set-function timer fn)
- (funcall fn))
- (ignore-errors (eval fm))
- (message "%s" done)))))))
+ (lexical-let ((outbuf outbuf)
+ (file file)
+ (buffer buffer)
+ (command command)
+ (handle handle))
+ (run-at-time
+ 30.0 nil
+ (lambda ()
+ (ignore-errors
+ (delete-file file))
+ (ignore-errors
+ (delete-directory (file-name-directory file)))))
+ (lambda (process state)
+ (when (eq (process-status process) 'exit)
+ (condition-case nil
+ (delete-file file)
+ (error))
+ (condition-case nil
+ (delete-directory (file-name-directory file))
+ (error))
+ (when (buffer-live-p outbuf)
+ (with-current-buffer outbuf
+ (let ((buffer-read-only nil)
+ (point (point)))
+ (forward-line 2)
+ (mm-insert-inline
+ handle (with-current-buffer buffer
+ (buffer-string)))
+ (goto-char point))))
+ (when (buffer-live-p buffer)
+ (kill-buffer buffer)))
+ (message "Displaying %s...done" command)))))
(mm-handle-set-external-undisplayer
handle (cons file buffer)))
(message "Displaying %s..." command))
@@ -1353,7 +1384,7 @@ Use CMD as the process."
(mailcap-mime-info type 'all)))
(method (let ((minibuffer-local-completion-map
mm-viewer-completion-map))
- (gnus-completing-read "Viewer" methods))))
+ (completing-read "Viewer: " methods))))
(when (string= method "")
(error "No method given"))
(if (string-match "^[^% \t]+$" method)
@@ -1493,7 +1524,7 @@ be determined."
(let ((image (mm-get-image handle)))
(or (not image)
(if (featurep 'xemacs)
- ;; XEmacs' glyphs can actually tell us about their width, so
+ ;; XEmacs's glyphs can actually tell us about their width, so
;; let's be nice and smart about them.
(or mm-inline-large-images
(and (<= (glyph-width image) (window-pixel-width))
@@ -1724,6 +1755,7 @@ If RECURSIVE, search recursively."
(buffer-string))))))
shr-inhibit-images shr-blocked-images charset char)
(if (and (boundp 'gnus-summary-buffer)
+ (bufferp gnus-summary-buffer)
(buffer-name gnus-summary-buffer))
(with-current-buffer gnus-summary-buffer
(setq shr-inhibit-images gnus-inhibit-images
@@ -1740,7 +1772,8 @@ If RECURSIVE, search recursively."
(insert (prog1
(if (and charset
(setq charset
- (mm-charset-to-coding-system charset))
+ (mm-charset-to-coding-system charset
+ nil t))
(not (eq charset 'ascii)))
(mm-decode-coding-string (buffer-string) charset)
(mm-string-as-multibyte (buffer-string)))
@@ -1756,7 +1789,13 @@ If RECURSIVE, search recursively."
(string-to-number (match-string 2)))
mm-extra-numeric-entities)))
(replace-match (char-to-string char))))
+ ;; Remove "soft hyphens".
+ (goto-char (point-min))
+ (while (search-forward "" nil t)
+ (replace-match "" t t))
(libxml-parse-html-region (point-min) (point-max))))
+ (unless (bobp)
+ (insert "\n"))
(mm-handle-set-undisplayer
handle
`(lambda ()
@@ -1773,4 +1812,8 @@ If RECURSIVE, search recursively."
(provide 'mm-decode)
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
;;; mm-decode.el ends here
diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el
index 0fb0e7a0795..c3febb01a0f 100644
--- a/lisp/gnus/mm-encode.el
+++ b/lisp/gnus/mm-encode.el
@@ -1,6 +1,6 @@
;;; mm-encode.el --- Functions for encoding MIME things
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el
index 5f4a9a85fc6..277932bf307 100644
--- a/lisp/gnus/mm-extern.el
+++ b/lisp/gnus/mm-extern.el
@@ -1,6 +1,6 @@
;;; mm-extern.el --- showing message/external-body
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: message external-body
diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el
index 017b604e9bb..70722544728 100644
--- a/lisp/gnus/mm-partial.el
+++ b/lisp/gnus/mm-partial.el
@@ -1,6 +1,6 @@
;;; mm-partial.el --- showing message/partial
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: message partial
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
index 2ce3791ef3d..109bd265faa 100644
--- a/lisp/gnus/mm-url.el
+++ b/lisp/gnus/mm-url.el
@@ -1,6 +1,6 @@
;;; mm-url.el --- a wrapper of url functions/commands for Gnus
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
@@ -416,69 +416,6 @@ spaces. Die Die Die."
(autoload 'mml-compute-boundary "mml")
-(defun mm-url-encode-multipart-form-data (pairs &optional boundary)
- "Return PAIRS encoded in multipart/form-data."
- ;; RFC1867
-
- ;; Get a good boundary
- (unless boundary
- (setq boundary (mml-compute-boundary '())))
-
- (concat
-
- ;; Start with the boundary
- "--" boundary "\r\n"
-
- ;; Create name value pairs
- (mapconcat
- 'identity
- ;; Delete any returned items that are empty
- (delq nil
- (mapcar (lambda (data)
- (when (car data)
- ;; For each pair
- (concat
-
- ;; Encode the name
- "Content-Disposition: form-data; name=\""
- (car data) "\"\r\n"
- "Content-Type: text/plain; charset=utf-8\r\n"
- "Content-Transfer-Encoding: binary\r\n\r\n"
-
- (cond ((stringp (cdr data))
- (cdr data))
- ((integerp (cdr data))
- (int-to-string (cdr data))))
-
- "\r\n")))
- pairs))
- ;; use the boundary as a separator
- (concat "--" boundary "\r\n"))
-
- ;; put a boundary at the end.
- "--" boundary "--\r\n"))
-
-(defun mm-url-fetch-form (url pairs)
- "Fetch a form from URL with PAIRS as the data using the POST method."
- (mm-url-load-url)
- (let ((url-request-data (mm-url-encode-www-form-urlencoded pairs))
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (url-insert-file-contents url)
- (setq buffer-file-name nil))
- t)
-
-(defun mm-url-fetch-simple (url content)
- (mm-url-load-url)
- (let ((url-request-data content)
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (url-insert-file-contents url)
- (setq buffer-file-name nil))
- t)
-
(defun mm-url-remove-markup ()
"Remove all HTML markup, leaving just plain text."
(goto-char (point-min))
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 129609df10d..4fb5ea704bd 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -1,6 +1,6 @@
;;; mm-util.el --- Utility functions for Mule and low level things
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -424,7 +424,7 @@ corresponding number of an iso-8859 charset."
;; Cf. http://thread.gmane.org/v9lkng5nwy.fsf@marauder.physik.uni-ulm.de
"List of IBM codepage numbers.
-The codepage mappings slighly differ between IBM and other vendors.
+The codepage mappings slightly differ between IBM and other vendors.
See \"ftp://ftp.unicode.org/Public/MAPPINGS/VENDORS/IBM/README.TXT\".
If an element is a number corresponding to a supported windows
@@ -1592,7 +1592,7 @@ gzip, bzip2, etc. are allowed."
(unless filename
(setq filename buffer-file-name))
(save-excursion
- (let ((decomp (unless ;; No worth to examine charset of tar files.
+ (let ((decomp (unless ;; Not worth it to examine charset of tar files.
(and filename
(string-match
"\\.\\(?:tar\\.[^.]+\\|tbz\\|tgz\\)\\'"
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index 4f7b5ed26b3..0cf3730d095 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -1,6 +1,6 @@
;;; mm-uu.el --- Return uu stuff as mm handles
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp
@@ -187,7 +187,7 @@ This can be either \"inline\" or \"attachment\".")
nil)
(verbatim-marks
;; slrn-style verbatim marks, see
- ;; http://www.slrn.org/manual/slrn-manual-6.html#ss6.81
+ ;; http://slrn.sourceforge.net/docs/slrn-manual-6.html#process_verbatim_marks
"^#v\\+"
"^#v\\-$"
(lambda () (mm-uu-verbatim-marks-extract 0 0))
@@ -430,7 +430,11 @@ apply the face `mm-uu-extract'."
(defun mm-uu-forward-extract ()
(mm-make-handle (mm-uu-copy-to-buffer
- (progn (goto-char start-point) (forward-line) (point))
+ (progn
+ (goto-char start-point)
+ (forward-line)
+ (skip-chars-forward "\n")
+ (point))
(progn (goto-char end-point) (forward-line -1) (point)))
'("message/rfc822" (charset . gnus-decoded))))
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 854ca3497da..d3e1014fcd4 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -1,6 +1,6 @@
;;; mm-view.el --- functions for viewing MIME objects
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -496,9 +496,6 @@
(defun mm-inline-audio (handle)
(message "Not implemented"))
-(defun mm-view-sound-file ()
- (message "Not implemented"))
-
(defun mm-w3-prepare-buffer ()
(require 'w3)
(let ((url-standalone-mode t)
@@ -600,10 +597,11 @@ If MODE is not set, try to find mode automatically."
text)))
(require 'font-lock)
;; I find font-lock a bit too verbose.
- (let ((font-lock-verbose nil))
+ (let ((font-lock-verbose nil)
+ (font-lock-support-mode nil))
;; Disable support modes, e.g., jit-lock, lazy-lock, etc.
+ ;; Note: XEmacs people use `font-lock-mode-hook' to run those modes.
(set (make-local-variable 'font-lock-mode-hook) nil)
- (set (make-local-variable 'font-lock-support-mode) nil)
(setq buffer-file-name (mm-handle-filename handle))
(set (make-local-variable 'enable-local-variables) nil)
(with-demoted-errors
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 1c6405b2b38..ae811afb1a5 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -1,6 +1,6 @@
;;; mml-sec.el --- A package with security functions for MML documents
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index 7a7b3f6d82d..f8e20a0791b 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -1,6 +1,6 @@
;;; mml-smime.el --- S/MIME support for MML
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: Gnus, MIME, S/MIME, MML
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 867c3be4b60..a72962aae0d 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -1,6 +1,6 @@
;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -463,8 +463,10 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(defvar mml-multipart-number 0)
(defvar mml-inhibit-compute-boundary nil)
-(defun mml-generate-mime ()
- "Generate a MIME message based on the current MML document."
+(defun mml-generate-mime (&optional multipart-type)
+ "Generate a MIME message based on the current MML document.
+MULTIPART-TYPE defaults to \"mixed\", but can also
+be \"related\" or \"alternate\"."
(let ((cont (mml-parse))
(mml-multipart-number mml-multipart-number)
(options message-options))
@@ -476,8 +478,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(if (and (consp (car cont))
(= (length cont) 1))
(mml-generate-mime-1 (car cont))
- (mml-generate-mime-1 (nconc (list 'multipart '(type . "mixed"))
- cont)))
+ (mml-generate-mime-1
+ (nconc (list 'multipart (cons 'type (or multipart-type "mixed")))
+ cont)))
(setq options message-options)
(buffer-string))
(setq message-options options)))))
@@ -1302,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
@@ -1316,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
@@ -1328,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.
@@ -1369,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.
@@ -1394,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)
@@ -1419,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/gnus/mml1991.el b/lisp/gnus/mml1991.el
index 1777a660319..97de6f0959b 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -1,10 +1,10 @@
;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Sascha Ldecke <sascha@meta-x.de>,
;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
-;; Keywords PGP
+;; Keywords: PGP
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 028955a8c33..78293f61791 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -1,6 +1,6 @@
;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: PGP MIME MML
diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el
index f6f0d6c1434..7650d9e29f7 100644
--- a/lisp/gnus/nnagent.el
+++ b/lisp/gnus/nnagent.el
@@ -1,6 +1,6 @@
;;; nnagent.el --- offline backend for Gnus
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el
index e10620683c9..72450b1f478 100644
--- a/lisp/gnus/nnbabyl.el
+++ b/lisp/gnus/nnbabyl.el
@@ -1,6 +1,6 @@
;;; nnbabyl.el --- rmail mbox access for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index 29f0695c74e..73dd2921b68 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -1,6 +1,6 @@
;;; nndiary.el --- A diary back end for Gnus
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Didier Verna <didier@xemacs.org>
;; Maintainer: Didier Verna <didier@xemacs.org>
@@ -71,7 +71,7 @@
;; * nndiary-get-new-mail, nndiary-mail-source and nndiary-split-methods:
;; NNDiary has some experimental parts, in the sense Gnus normally uses only
-;; one mail back ends for mail retreival and splitting. This back end is
+;; one mail back ends for mail retrieval and splitting. This back end is
;; also an attempt to make it behave differently. For Gnus developers: as
;; you can see if you snarf into the code, that was not a very difficult
;; thing to do. Something should be done about the respooling breakage
@@ -179,22 +179,28 @@ In order to make this clear, here are some examples:
:group 'nndiary)
-(defcustom nndiary-request-create-group-hooks nil
- "*Hooks to run after `nndiary-request-create-group' is executed.
-The hooks will be called with the full group name as argument."
+(define-obsolete-variable-alias 'nndiary-request-create-group-hooks
+ 'nndiary-request-create-group-functions "24.3")
+(defcustom nndiary-request-create-group-functions nil
+ "*Hook run after `nndiary-request-create-group' is executed.
+The hook functions will be called with the full group name as argument."
:group 'nndiary
:type 'hook)
-(defcustom nndiary-request-update-info-hooks nil
- "*Hooks to run after `nndiary-request-update-info-group' is executed.
-The hooks will be called with the full group name as argument."
+(define-obsolete-variable-alias 'nndiary-request-update-info-hooks
+ 'nndiary-request-update-info-functions "24.3")
+(defcustom nndiary-request-update-info-functions nil
+ "*Hook run after `nndiary-request-update-info-group' is executed.
+The hook functions will be called with the full group name as argument."
:group 'nndiary
:type 'hook)
-(defcustom nndiary-request-accept-article-hooks nil
- "*Hooks to run before accepting an article.
+(define-obsolete-variable-alias 'nndiary-request-accept-article-hooks
+ 'nndiary-request-accept-article-functions "24.3")
+(defcustom nndiary-request-accept-article-functions nil
+ "*Hook run before accepting an article.
Executed near the beginning of `nndiary-request-accept-article'.
-The hooks will be called with the article in the current buffer."
+The hook functions will be called with the article in the current buffer."
:group 'nndiary
:type 'hook)
@@ -224,7 +230,7 @@ The hooks will be called with the article in the current buffer."
(defvoo nndiary-get-new-mail nil
"Whether nndiary gets new mail and split it.
Contrary to traditional mail back ends, this variable can be set to t
-even if your primary mail back end also retreives mail. In such a case,
+even if your primary mail back end also retrieves mail. In such a case,
NDiary uses its own mail-sources and split-methods.")
(defvoo nndiary-nov-is-evil nil
@@ -541,7 +547,7 @@ all. This may very well take some time.")
(setcar active (apply 'min articles))
(setcdr active (apply 'max articles))))
(nnmail-save-active nndiary-group-alist nndiary-active-file)
- (run-hook-with-args 'nndiary-request-create-group-hooks
+ (run-hook-with-args 'nndiary-request-create-group-functions
(gnus-group-prefixed-name group
(list "nndiary" server)))
t))
@@ -633,7 +639,7 @@ all. This may very well take some time.")
(deffoo nndiary-request-accept-article (group &optional server last)
(nndiary-possibly-change-directory group server)
(nnmail-check-syntax)
- (run-hooks 'nndiary-request-accept-article-hooks)
+ (run-hooks 'nndiary-request-accept-article-functions)
(when (nndiary-schedule)
(let (result)
(when nnmail-cache-accepted-message-ids
@@ -804,7 +810,7 @@ all. This may very well take some time.")
(gnus-info-set-read info (gnus-update-read-articles
(gnus-info-group info) unread t)))
))
- (run-hook-with-args 'nndiary-request-update-info-hooks
+ (run-hook-with-args 'nndiary-request-update-info-functions
(gnus-info-group info))
t))
diff --git a/lisp/gnus/nndir.el b/lisp/gnus/nndir.el
index 736f37c1fa5..1e36229fe80 100644
--- a/lisp/gnus/nndir.el
+++ b/lisp/gnus/nndir.el
@@ -1,6 +1,6 @@
;;; nndir.el --- single directory newsgroup access for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index f900e02eb08..38d274d1d93 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -1,6 +1,6 @@
;;; nndoc.el --- single file access for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el
index 0b47062a919..da50720ebbe 100644
--- a/lisp/gnus/nndraft.el
+++ b/lisp/gnus/nndraft.el
@@ -1,6 +1,6 @@
;;; nndraft.el --- draft article access for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -37,7 +37,8 @@
(require 'mm-util)
(eval-when-compile (require 'cl))
-(declare-function nndraft-request-list "nnmh" (&rest args))
+;; The nnoo-import at the end, I think.
+(declare-function nndraft-request-list "nndraft" (&rest args) t)
(nnoo-declare nndraft
nnmh)
@@ -181,13 +182,14 @@ are generated if and only if they are also in `message-draft-headers'.")
(gnus-get-new-news-hook nil)
(inhibit-read-only t))
(gnus-group-get-new-news-this-group nil t)
- (dolist (group groups)
- (unless (and gnus-permanently-visible-groups
- (string-match gnus-permanently-visible-groups
- group))
- (gnus-group-goto-group group)
- (when (zerop (gnus-group-group-unread))
- (gnus-delete-line)))))))
+ (save-excursion
+ (dolist (group groups)
+ (unless (and gnus-permanently-visible-groups
+ (string-match gnus-permanently-visible-groups
+ group))
+ (gnus-group-goto-group group)
+ (when (zerop (gnus-group-group-unread))
+ (gnus-delete-line))))))))
(deffoo nndraft-request-associate-buffer (group)
"Associate the current buffer with some article in the draft group."
diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el
index 7f4fab0a991..3b43920852d 100644
--- a/lisp/gnus/nneething.el
+++ b/lisp/gnus/nneething.el
@@ -1,6 +1,6 @@
;;; nneething.el --- arbitrary file access for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 3ec30410473..e93bd7f43e0 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -1,8 +1,8 @@
;;; nnfolder.el --- mail folder access for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
-;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
+;; Author: Simon Josefsson <simon@josefsson.org>
;; ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV)
;; Scott Byer <byer@mv.us.adobe.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -53,10 +53,6 @@
"The name of the nnfolder NOV directory.
If nil, `nnfolder-directory' is used.")
-(defvoo nnfolder-marks-directory nil
- "The name of the nnfolder MARKS directory.
-If nil, `nnfolder-directory' is used.")
-
(defvoo nnfolder-active-file
(nnheader-concat nnfolder-directory "active")
"The name of the active file.")
@@ -134,21 +130,6 @@ all. This may very well take some time.")
(defvar nnfolder-nov-buffer-file-name nil)
-(defvoo nnfolder-marks-is-evil nil
- "If non-nil, Gnus will never generate and use marks file for mail groups.
-Using marks files makes it possible to backup and restore mail groups
-separately from `.newsrc.eld'. If you have, for some reason, set
-this to t, and want to set it to nil again, you should always remove
-the corresponding marks file (usually base nnfolder file name
-concatenated with `.mrk', but see `nnfolder-marks-file-suffix') for
-the group. Then the marks file will be regenerated properly by Gnus.")
-
-(defvoo nnfolder-marks nil)
-
-(defvoo nnfolder-marks-file-suffix ".mrk")
-
-(defvar nnfolder-marks-modtime (gnus-make-hashtable))
-
;;; Interface functions
@@ -231,9 +212,6 @@ the group. Then the marks file will be regenerated properly by Gnus.")
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
(and nnfolder-nov-directory
(gnus-make-directory nnfolder-nov-directory)))
- (unless nnfolder-marks-is-evil
- (and nnfolder-marks-directory
- (gnus-make-directory nnfolder-marks-directory)))
(cond
((not (file-exists-p nnfolder-directory))
(nnfolder-close-server)
@@ -607,11 +585,9 @@ the group. Then the marks file will be regenerated properly by Gnus.")
() ; Don't delete the articles.
;; Delete the file that holds the group.
(let ((data (nnfolder-group-pathname group))
- (nov (nnfolder-group-nov-pathname group))
- (mrk (nnfolder-group-marks-pathname group)))
+ (nov (nnfolder-group-nov-pathname group)))
(ignore-errors (delete-file data))
- (ignore-errors (delete-file nov))
- (ignore-errors (delete-file mrk))))
+ (ignore-errors (delete-file nov))))
;; Remove the group from all structures.
(setq nnfolder-group-alist
(delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
@@ -632,11 +608,7 @@ the group. Then the marks file will be regenerated properly by Gnus.")
(when (file-exists-p (nnfolder-group-nov-pathname group))
(setq new-file (nnfolder-group-nov-pathname new-name))
(gnus-make-directory (file-name-directory new-file))
- (rename-file (nnfolder-group-nov-pathname group) new-file))
- (when (file-exists-p (nnfolder-group-marks-pathname group))
- (setq new-file (nnfolder-group-marks-pathname new-name))
- (gnus-make-directory (file-name-directory new-file))
- (rename-file (nnfolder-group-marks-pathname group) new-file)))
+ (rename-file (nnfolder-group-nov-pathname group) new-file)))
t)
;; That went ok, so we change the internal structures.
(let ((entry (assoc group nnfolder-group-alist)))
@@ -1087,16 +1059,17 @@ This command does not work if you use short group names."
(defun nnfolder-save-buffer ()
"Save the buffer."
- (when (buffer-modified-p)
- (run-hooks 'nnfolder-save-buffer-hook)
- (gnus-make-directory (file-name-directory (buffer-file-name)))
- (let ((coding-system-for-write
- (or nnfolder-file-coding-system-for-write
- nnfolder-file-coding-system)))
- (set (make-local-variable 'copyright-update) nil)
- (save-buffer)))
- (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
- (nnfolder-save-nov)))
+ (let ((delete-old-versions t))
+ (when (buffer-modified-p)
+ (run-hooks 'nnfolder-save-buffer-hook)
+ (gnus-make-directory (file-name-directory (buffer-file-name)))
+ (let ((coding-system-for-write
+ (or nnfolder-file-coding-system-for-write
+ nnfolder-file-coding-system)))
+ (set (make-local-variable 'copyright-update) nil)
+ (save-buffer)))
+ (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
+ (nnfolder-save-nov))))
(defun nnfolder-save-active (group-alist active-file)
(let ((nnmail-active-file-coding-system
@@ -1182,100 +1155,6 @@ This command does not work if you use short group names."
(mail-header-set-number headers article)
(nnheader-insert-nov headers)))
-(deffoo nnfolder-request-set-mark (group actions &optional server)
- (when (and server
- (not (nnfolder-server-opened server)))
- (nnfolder-open-server server))
- (unless nnfolder-marks-is-evil
- (nnfolder-open-marks group server)
- (setq nnfolder-marks (nnheader-update-marks-actions nnfolder-marks actions))
- (nnfolder-save-marks group server))
- nil)
-
-(deffoo nnfolder-request-marks (group info &optional server)
- ;; Change servers.
- (when (and server
- (not (nnfolder-server-opened server)))
- (nnfolder-open-server server))
- (when (and (not nnfolder-marks-is-evil) (nnfolder-marks-changed-p group))
- (nnheader-message 8 "Updating marks for %s..." group)
- (nnfolder-open-marks group server)
- ;; Update info using `nnfolder-marks'.
- (mapc (lambda (pred)
- (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nnfolder-marks))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
- (let ((seen (cdr (assq 'read nnfolder-marks))))
- (gnus-info-set-read info
- (if (and (integerp (car seen))
- (null (cdr seen)))
- (list (cons (car seen) (car seen)))
- seen)))
- (nnheader-message 8 "Updating marks for %s...done" group))
- info)
-
-(defun nnfolder-group-marks-pathname (group)
- "Make pathname for GROUP NOV."
- (let ((nnfolder-directory (or nnfolder-marks-directory nnfolder-directory)))
- (concat (nnfolder-group-pathname group) nnfolder-marks-file-suffix)))
-
-(defun nnfolder-marks-changed-p (group)
- (let ((file (nnfolder-group-marks-pathname group)))
- (if (null (gnus-gethash file nnfolder-marks-modtime))
- t ;; never looked at marks file, assume it has changed
- (not (equal (gnus-gethash file nnfolder-marks-modtime)
- (nth 5 (file-attributes file)))))))
-
-(defun nnfolder-save-marks (group server)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (file (nnfolder-group-marks-pathname group)))
- (condition-case err
- (progn
- (with-temp-file file
- (erase-buffer)
- (gnus-prin1 nnfolder-marks)
- (insert "\n"))
- (gnus-sethash file
- (nth 5 (file-attributes file))
- nnfolder-marks-modtime))
- (error (or (gnus-yes-or-no-p
- (format "Could not write to %s (%s). Continue? " file err))
- (error "Cannot write to %s (%s)" file err))))))
-
-(defun nnfolder-open-marks (group server)
- (let ((file (nnfolder-group-marks-pathname group)))
- (if (file-exists-p file)
- (condition-case err
- (with-temp-buffer
- (gnus-sethash file (nth 5 (file-attributes file))
- nnfolder-marks-modtime)
- (nnheader-insert-file-contents file)
- (setq nnfolder-marks (read (current-buffer)))
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnfolder-marks (gnus-remassoc el nnfolder-marks))))
- (error (or (gnus-yes-or-no-p
- (format "Error reading nnfolder marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
- (error "Cannot read nnfolder marks file %s (%s)" file err))))
- ;; User didn't have a .marks file. Probably first time
- ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
- (let ((info (gnus-get-info
- (gnus-group-prefixed-name
- group
- (gnus-server-to-method (format "nnfolder:%s" server))))))
- (nnheader-message 7 "Bootstrapping marks for %s..." group)
- (setq nnfolder-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nnfolder-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnfolder-marks (gnus-remassoc el nnfolder-marks)))
- (nnfolder-save-marks group server)
- (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
-
(provide 'nnfolder)
;;; nnfolder.el ends here
diff --git a/lisp/gnus/nngateway.el b/lisp/gnus/nngateway.el
index 994cefc9d08..f2e6b2e8509 100644
--- a/lisp/gnus/nngateway.el
+++ b/lisp/gnus/nngateway.el
@@ -1,6 +1,6 @@
;;; nngateway.el --- posting news via mail gateways
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index a8e8e7d08ef..f98b34c7714 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -1,6 +1,6 @@
;;; nnheader.el --- header access macros for Gnus and its backends
-;; Copyright (C) 1987-1990, 1993-1998, 2000-2011
+;; Copyright (C) 1987-1990, 1993-1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index b4e6e31fae4..5126c25f66b 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1,6 +1,6 @@
;;; nnimap.el --- IMAP interface for Gnus
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Simon Josefsson <simon@josefsson.org>
@@ -117,7 +117,7 @@ some servers.")
(defvoo nnimap-fetch-partial-articles nil
"If non-nil, Gnus will fetch partial articles.
-If t, nnimap will fetch only the first part. If a string, it
+If t, Gnus will fetch only the first part. If a string, it
will fetch all parts that have types that match that string. A
likely value would be \"text/\" to automatically fetch all
textual parts.")
@@ -134,7 +134,7 @@ textual parts.")
(defstruct nnimap
group process commands capabilities select-result newlinep server
- last-command-time greeting examined stream-type)
+ last-command-time greeting examined stream-type initial-resync)
(defvar nnimap-object nil)
@@ -189,25 +189,35 @@ textual parts.")
(defun nnimap-transform-headers ()
(goto-char (point-min))
- (let (article bytes lines size string)
+ (let (article lines size string)
(block nil
(while (not (eobp))
- (while (not (looking-at "\\* [0-9]+ FETCH.+?UID \\([0-9]+\\)"))
+ (while (not (looking-at "\\* [0-9]+ FETCH"))
(delete-region (point) (progn (forward-line 1) (point)))
(when (eobp)
(return)))
- (setq article (match-string 1))
+ (goto-char (match-end 0))
;; Unfold quoted {number} strings.
- (while (re-search-forward "[^]][ (]{\\([0-9]+\\)}\r?\n"
- (1+ (line-end-position)) t)
+ (while (re-search-forward
+ "[^]][ (]{\\([0-9]+\\)}\r?\n"
+ (save-excursion
+ ;; Start of the header section.
+ (or (re-search-forward "] {[0-9]+}\r?\n" nil t)
+ ;; Start of the next FETCH.
+ (re-search-forward "\\* [0-9]+ FETCH" nil t)
+ (point-max)))
+ t)
(setq size (string-to-number (match-string 1)))
(delete-region (+ (match-beginning 0) 2) (point))
(setq string (buffer-substring (point) (+ (point) size)))
(delete-region (point) (+ (point) size))
- (insert (format "%S" string)))
- (setq bytes (nnimap-get-length)
- lines nil)
+ (insert (format "%S" (mm-subst-char-in-string ?\n ?\s string))))
(beginning-of-line)
+ (setq article
+ (and (re-search-forward "UID \\([0-9]+\\)" (line-end-position)
+ t)
+ (match-string 1)))
+ (setq lines nil)
(setq size
(and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
(line-end-position)
@@ -269,18 +279,20 @@ textual parts.")
result))
(mapconcat #'identity (nreverse result) ",")))))
-(deffoo nnimap-open-server (server &optional defs)
+(deffoo nnimap-open-server (server &optional defs no-reconnect)
(if (nnimap-server-opened server)
t
(unless (assq 'nnimap-address defs)
(setq defs (append defs (list (list 'nnimap-address server)))))
(nnoo-change-server 'nnimap server defs)
- (or (nnimap-find-connection nntp-server-buffer)
- (nnimap-open-connection nntp-server-buffer))))
+ (if no-reconnect
+ (nnimap-find-connection nntp-server-buffer)
+ (or (nnimap-find-connection nntp-server-buffer)
+ (nnimap-open-connection nntp-server-buffer)))))
(defun nnimap-make-process-buffer (buffer)
(with-current-buffer
- (generate-new-buffer (format "*nnimap %s %s %s*"
+ (generate-new-buffer (format " *nnimap %s %s %s*"
nnimap-address nnimap-server-port
(gnus-buffer-exists-p buffer)))
(mm-disable-multibyte)
@@ -288,7 +300,8 @@ textual parts.")
(gnus-add-buffer)
(set (make-local-variable 'after-change-functions) nil)
(set (make-local-variable 'nnimap-object)
- (make-nnimap :server (nnoo-current-server 'nnimap)))
+ (make-nnimap :server (nnoo-current-server 'nnimap)
+ :initial-resync 0))
(push (list buffer (current-buffer)) nnimap-connection-alist)
(push (current-buffer) nnimap-process-buffers)
(current-buffer)))
@@ -462,6 +475,8 @@ textual parts.")
(when nnimap-object
(when (nnimap-capability "QRESYNC")
(nnimap-command "ENABLE QRESYNC"))
+ (nnheader-message 7 "Opening connection to %s...done"
+ nnimap-address)
(nnimap-process nnimap-object))))))))
(autoload 'rfc2104-hash "rfc2104")
@@ -855,6 +870,7 @@ textual parts.")
;; Move the article to a different method.
(let ((result (eval accept-form)))
(when result
+ (nnimap-possibly-change-group group server)
(nnimap-delete-article article)
result)))))))
@@ -1177,7 +1193,8 @@ textual parts.")
(dolist (response responses)
(let* ((sequence (car response))
(response (cadr response))
- (group (cadr (assoc sequence sequences))))
+ (group (cadr (assoc sequence sequences)))
+ (egroup (encode-coding-string group 'utf-8)))
(when (and group
(equal (caar response) "OK"))
(let ((uidnext (nnimap-find-parameter "UIDNEXT" response))
@@ -1189,15 +1206,14 @@ textual parts.")
(setq highest (1- (string-to-number (car uidnext)))))
(cond
((null highest)
- (insert (format "%S 0 1 y\n" (utf7-decode group t))))
+ (insert (format "%S 0 1 y\n" egroup)))
((zerop exists)
;; Empty group.
- (insert (format "%S %d %d y\n"
- (utf7-decode group t)
+ (insert (format "%S %d %d y\n" egroup
highest (1+ highest))))
(t
;; Return the widest possible range.
- (insert (format "%S %d 1 y\n" (utf7-decode group t)
+ (insert (format "%S %d 1 y\n" egroup
(or highest exists)))))))))
t)))))
@@ -1209,14 +1225,16 @@ textual parts.")
(nnimap-get-groups)))
(unless (assoc group nnimap-current-infos)
;; Insert dummy numbers here -- they don't matter.
- (insert (format "%S 0 1 y\n" (utf7-encode group)))))
+ (insert (format "%S 0 1 y\n" (encode-coding-string group 'utf-8)))))
t)))
(deffoo nnimap-retrieve-group-data-early (server infos)
- (when (nnimap-possibly-change-group nil server)
+ (when (and (nnimap-possibly-change-group nil server)
+ infos)
(with-current-buffer (nnimap-buffer)
(erase-buffer)
(setf (nnimap-group nnimap-object) nil)
+ (setf (nnimap-initial-resync nnimap-object) 0)
(let ((qresyncp (nnimap-capability "QRESYNC"))
params groups sequences active uidvalidity modseq group)
;; Go through the infos and gather the data needed to know
@@ -1241,12 +1259,7 @@ textual parts.")
'qresync
nil group 'qresync)
sequences)
- (let ((start
- (if (and active uidvalidity)
- ;; Fetch the last 100 flags.
- (max 1 (- (cdr active) 100))
- 1))
- (command
+ (let ((command
(if uidvalidity
"EXAMINE"
;; If we don't have a UIDVALIDITY, then this is
@@ -1254,7 +1267,14 @@ textual parts.")
;; have to do a SELECT (which is slower than an
;; examine), but will tell us whether the group
;; is read-only or not.
- "SELECT")))
+ "SELECT"))
+ start)
+ (if (and active uidvalidity)
+ ;; Fetch the last 100 flags.
+ (setq start (max 1 (- (cdr active) 100)))
+ (setf (nnimap-initial-resync nnimap-object)
+ (1+ (nnimap-initial-resync nnimap-object)))
+ (setq start 1))
(push (list (nnimap-send-command "%s %S" command
(utf7-encode group t))
(nnimap-send-command "UID FETCH %d:* FLAGS" start)
@@ -1273,11 +1293,11 @@ textual parts.")
(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
(when (and sequences
+ (nnimap-possibly-change-group nil server t)
;; Check that the process is still alive.
(get-buffer-process (nnimap-buffer))
(memq (process-status (get-buffer-process (nnimap-buffer)))
- '(open run))
- (nnimap-possibly-change-group nil server))
+ '(open run)))
(with-current-buffer (nnimap-buffer)
;; Wait for the final data to trickle in.
(when (nnimap-wait-for-response (if (eq (cadar sequences) 'qresync)
@@ -1332,7 +1352,8 @@ textual parts.")
(cdr (assq 'uidvalidity (gnus-info-params info)))))
(and old-uidvalidity
(not (equal old-uidvalidity uidvalidity))
- (> start-article 1)))
+ (or (not start-article)
+ (> start-article 1))))
(gnus-group-remove-parameter info 'uidvalidity)
(gnus-group-remove-parameter info 'modseq))
;; We have the data needed to update.
@@ -1524,7 +1545,8 @@ textual parts.")
(defun nnimap-parse-flags (sequences)
(goto-char (point-min))
- ;; Change \Delete etc to %Delete, so that the reader can read it.
+ ;; Change \Delete etc to %Delete, so that the Emacs Lisp reader can
+ ;; read it.
(subst-char-in-region (point-min) (point-max)
?\\ ?% t)
;; Remove any MODSEQ entries in the buffer, because they may contain
@@ -1595,7 +1617,9 @@ textual parts.")
vanished highestmodseq)
articles)
groups)
- (goto-char end)
+ (if (eq flag-sequence 'qresync)
+ (goto-char end)
+ (setq end (point)))
(setq articles nil))))
groups))
@@ -1609,6 +1633,8 @@ textual parts.")
(declare-function gnus-fetch-headers "gnus-sum"
(articles &optional limit force-new dependencies))
+(autoload 'nnir-search-thread "nnir")
+
(deffoo nnimap-request-thread (header &optional group server)
(when group
(setq group (nnimap-decode-gnus-group group)))
@@ -1620,15 +1646,16 @@ textual parts.")
(nnimap-command "UID SEARCH %s" cmd))))
(when result
(gnus-fetch-headers
- (and (car result) (delete 0 (mapcar #'string-to-number
- (cdr (assoc "SEARCH" (cdr result))))))
+ (and (car result)
+ (delete 0 (mapcar #'string-to-number
+ (cdr (assoc "SEARCH" (cdr result))))))
nil t))))))
-(defun nnimap-possibly-change-group (group server)
+(defun nnimap-possibly-change-group (group server &optional no-reconnect)
(let ((open-result t))
(when (and server
(not (nnimap-server-opened server)))
- (setq open-result (nnimap-open-server server)))
+ (setq open-result (nnimap-open-server server nil no-reconnect)))
(cond
((not open-result)
nil)
@@ -1675,13 +1702,18 @@ textual parts.")
(nnimap-wait-for-response nnimap-sequence))
nnimap-sequence)
+(defvar nnimap-record-commands nil
+ "If non-nil, log commands to the \"*imap log*\" buffer.")
+
(defun nnimap-log-command (command)
- (with-current-buffer (get-buffer-create "*imap log*")
- (goto-char (point-max))
- (insert (format-time-string "%H:%M:%S") " "
- (if nnimap-inhibit-logging
- "(inhibited)\n"
- command)))
+ (when nnimap-record-commands
+ (with-current-buffer (get-buffer-create "*imap log*")
+ (goto-char (point-max))
+ (insert (format-time-string "%H:%M:%S")
+ " [" nnimap-address "] "
+ (if nnimap-inhibit-logging
+ "(inhibited)\n"
+ command))))
command)
(defun nnimap-command (&rest args)
@@ -1733,9 +1765,18 @@ textual parts.")
(not (looking-at (format "%d .*\n" sequence)))))
(when messagep
(nnheader-message-maybe
- 7 "nnimap read %dk" (/ (buffer-size) 1000)))
+ 7 "nnimap read %dk from %s%s" (/ (buffer-size) 1000)
+ nnimap-address
+ (if (not (zerop (nnimap-initial-resync nnimap-object)))
+ (format " (initial sync of %d group%s; please wait)"
+ (nnimap-initial-resync nnimap-object)
+ (if (= (nnimap-initial-resync nnimap-object) 1)
+ ""
+ "s"))
+ "")))
(nnheader-accept-process-output process)
(goto-char (point-max)))
+ (setf (nnimap-initial-resync nnimap-object) 0)
openp)
(quit
(when debug-on-quit
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 3d0fc78dca7..d1ca0213ed9 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -1,6 +1,6 @@
;;; nnir.el --- search mail with various search engines -*- coding: iso-8859-1 -*-
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Kai Grojohann <grossjohann@ls6.cs.uni-dortmund.de>
;; Swish-e and Swish++ backends by:
@@ -304,12 +304,13 @@ is `(valuefunc member)'."
;;; User Customizable Variables:
(defgroup nnir nil
- "Search groups in Gnus with assorted seach engines."
+ "Search groups in Gnus with assorted search engines."
:group 'gnus)
(defcustom nnir-ignored-newsgroups ""
"*A regexp to match newsgroups in the active file that should
be skipped when searching."
+ :version "24.1"
:type '(regexp)
:group 'nnir)
@@ -324,6 +325,7 @@ with three items unique to nnir summary buffers:
%g Article original short group name (string)
If nil this will use `gnus-summary-line-format'."
+ :version "24.1"
:type '(string)
:group 'nnir)
@@ -335,6 +337,7 @@ retrieved header format.
If this variable is nil, or if the provided function returns nil for a search
result, `gnus-retrieve-headers' will be called instead."
+ :version "24.1"
:type '(function)
:group 'nnir)
@@ -342,6 +345,7 @@ result, `gnus-retrieve-headers' will be called instead."
"*The default IMAP search key for an nnir search. Must be one of
the keys in `nnir-imap-search-arguments'. To use raw imap queries
by default set this to \"Imap\"."
+ :version "24.1"
:type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
nnir-imap-search-arguments))
:group 'nnir)
@@ -503,6 +507,7 @@ arrive at the correct group name, \"mail.misc\"."
(defcustom nnir-notmuch-program "notmuch"
"*Name of notmuch search executable."
+ :version "24.1"
:type '(string)
:group 'nnir)
@@ -513,6 +518,7 @@ Note that this should be a list. Ie, do NOT use the following:
(setq nnir-notmuch-additional-switches \"-i -w\") ; wrong
Instead, use this:
(setq nnir-notmuch-additional-switches '(\"-i\" \"-w\"))"
+ :version "24.1"
:type '(repeat (string))
:group 'nnir)
@@ -523,6 +529,7 @@ regular expression.
This variable is very similar to `nnir-namazu-remove-prefix', except
that it is for notmuch, not Namazu."
+ :version "24.1"
:type '(regexp)
:group 'nnir)
@@ -573,6 +580,7 @@ Add an entry here when adding a new search engine.")
'((nnimap . imap)
(nntp . gmane))
"*Alist of default search engines keyed by server method."
+ :version "24.1"
:type `(repeat (cons (choice (const nnimap) (const nttp) (const nnspool)
(const nneething) (const nndir) (const nnmbox)
(const nnml) (const nnmh) (const nndraft)
@@ -670,7 +678,8 @@ Add an entry here when adding a new search engine.")
(goto-char (point-min))
(while (not (eobp))
(let* ((novitem (funcall parsefunc))
- (artno (mail-header-number novitem))
+ (artno (and novitem
+ (mail-header-number novitem)))
(art (car (rassq artno articleids))))
(when art
(mail-header-set-number novitem art)
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 93e8544b633..93f04cda929 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1,6 +1,6 @@
;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
@@ -40,6 +40,8 @@
(autoload 'gnus-add-buffer "gnus")
(autoload 'gnus-kill-buffer "gnus")
+(eval-when-compile
+ (autoload 'mail-send-and-exit "sendmail" nil t))
(defgroup nnmail nil
"Reading mail with Gnus."
@@ -553,11 +555,11 @@ parameter. It should return nil, `warn' or `delete'."
(const warn)
(const delete)))
-(defcustom nnmail-extra-headers '(To Newsgroups)
+(defcustom nnmail-extra-headers '(To Newsgroups Cc)
"Extra headers to parse.
In addition to the standard headers, these extra headers will be
included in NOV headers (and the like) when backends parse headers."
- :version "21.1"
+ :version "24.3"
:group 'nnmail
:type '(repeat symbol))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index bbace7c784a..74a693a9c61 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -77,6 +77,56 @@
(defconst nnmaildir-version "Gnus")
+(defconst nnmaildir-flag-mark-mapping
+ '((?F . tick)
+ (?R . reply)
+ (?S . read))
+ "Alist mapping Maildir filename flags to Gnus marks.
+Maildir filenames are of the form \"unique-id:2,FLAGS\",
+where FLAGS are a string of characters in ASCII order.
+Some of the FLAGS correspond to Gnus marks.")
+
+(defsubst nnmaildir--mark-to-flag (mark)
+ "Find the Maildir flag that corresponds to MARK (an atom).
+Return a character, or `nil' if not found.
+See `nnmaildir-flag-mark-mapping'."
+ (car (rassq mark nnmaildir-flag-mark-mapping)))
+
+(defsubst nnmaildir--flag-to-mark (flag)
+ "Find the Gnus mark that corresponds to FLAG (a character).
+Return an atom, or `nil' if not found.
+See `nnmaildir-flag-mark-mapping'."
+ (cdr (assq flag nnmaildir-flag-mark-mapping)))
+
+(defun nnmaildir--ensure-suffix (filename)
+ "Ensure that FILENAME contains the suffix \":2,\"."
+ (if (gnus-string-match-p ":2," filename)
+ filename
+ (concat filename ":2,")))
+
+(defun nnmaildir--add-flag (flag suffix)
+ "Return a copy of SUFFIX where FLAG is set.
+SUFFIX should start with \":2,\"."
+ (unless (gnus-string-match-p "^:2," suffix)
+ (error "Invalid suffix `%s'" suffix))
+ (let* ((flags (substring suffix 3))
+ (flags-as-list (append flags nil))
+ (new-flags
+ (concat (gnus-delete-duplicates
+ ;; maildir flags must be sorted
+ (sort (cons flag flags-as-list) '<)))))
+ (concat ":2," new-flags)))
+
+(defun nnmaildir--remove-flag (flag suffix)
+ "Return a copy of SUFFIX where FLAG is cleared.
+SUFFIX should start with \":2,\"."
+ (unless (gnus-string-match-p "^:2," suffix)
+ (error "Invalid suffix `%s'" suffix))
+ (let* ((flags (substring suffix 3))
+ (flags-as-list (append flags nil))
+ (new-flags (concat (delq flag flags-as-list))))
+ (concat ":2," new-flags)))
+
(defvar nnmaildir-article-file-name nil
"*The filename of the most recently requested article. This variable is set
by nnmaildir-request-article.")
@@ -152,6 +202,16 @@ by nnmaildir-request-article.")
(gnm nil) ;; flag: split from mail-sources?
(target-prefix nil :type string)) ;; symlink target prefix
+(defun nnmaildir--article-set-flags (article new-suffix curdir)
+ (let* ((prefix (nnmaildir--art-prefix article))
+ (suffix (nnmaildir--art-suffix article))
+ (article-file (concat curdir prefix suffix))
+ (new-name (concat curdir prefix new-suffix)))
+ (unless (file-exists-p article-file)
+ (error "Couldn't find article file %s" article-file))
+ (rename-file article-file new-name 'replace)
+ (setf (nnmaildir--art-suffix article) new-suffix)))
+
(defun nnmaildir--expired-article (group article)
(setf (nnmaildir--art-nov article) nil)
(let ((flist (nnmaildir--grp-flist group))
@@ -208,29 +268,33 @@ by nnmaildir-request-article.")
(eval param))
(defmacro nnmaildir--with-nntp-buffer (&rest body)
+ (declare (debug (body)))
`(with-current-buffer nntp-server-buffer
,@body))
(defmacro nnmaildir--with-work-buffer (&rest body)
+ (declare (debug (body)))
`(with-current-buffer (get-buffer-create " *nnmaildir work*")
,@body))
(defmacro nnmaildir--with-nov-buffer (&rest body)
+ (declare (debug (body)))
`(with-current-buffer (get-buffer-create " *nnmaildir nov*")
,@body))
(defmacro nnmaildir--with-move-buffer (&rest body)
+ (declare (debug (body)))
`(with-current-buffer (get-buffer-create " *nnmaildir move*")
,@body))
-(defmacro nnmaildir--subdir (dir subdir)
- `(file-name-as-directory (concat ,dir ,subdir)))
-(defmacro nnmaildir--srvgrp-dir (srv-dir gname)
- `(nnmaildir--subdir ,srv-dir ,gname))
-(defmacro nnmaildir--tmp (dir) `(nnmaildir--subdir ,dir "tmp"))
-(defmacro nnmaildir--new (dir) `(nnmaildir--subdir ,dir "new"))
-(defmacro nnmaildir--cur (dir) `(nnmaildir--subdir ,dir "cur"))
-(defmacro nnmaildir--nndir (dir) `(nnmaildir--subdir ,dir ".nnmaildir"))
-(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov"))
-(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks"))
-(defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num"))
+(defsubst nnmaildir--subdir (dir subdir)
+ (file-name-as-directory (concat dir subdir)))
+(defsubst nnmaildir--srvgrp-dir (srv-dir gname)
+ (nnmaildir--subdir srv-dir gname))
+(defsubst nnmaildir--tmp (dir) (nnmaildir--subdir dir "tmp"))
+(defsubst nnmaildir--new (dir) (nnmaildir--subdir dir "new"))
+(defsubst nnmaildir--cur (dir) (nnmaildir--subdir dir "cur"))
+(defsubst nnmaildir--nndir (dir) (nnmaildir--subdir dir ".nnmaildir"))
+(defsubst nnmaildir--nov-dir (dir) (nnmaildir--subdir dir "nov"))
+(defsubst nnmaildir--marks-dir (dir) (nnmaildir--subdir dir "marks"))
+(defsubst nnmaildir--num-dir (dir) (nnmaildir--subdir dir "num"))
(defmacro nnmaildir--unlink (file-arg)
`(let ((file ,file-arg))
@@ -305,6 +369,7 @@ by nnmaildir-request-article.")
string)
(defmacro nnmaildir--condcase (errsym body &rest handler)
+ (declare (debug (sexp form body)))
`(condition-case ,errsym
(let ((system-messages-locale "C")) ,body)
(error . ,handler)))
@@ -759,7 +824,7 @@ by nnmaildir-request-article.")
(dolist (file (funcall ls ndir nil "\\`[^.]" 'nosort))
(setq x (concat ndir file))
(and (time-less-p (nth 5 (file-attributes x)) (current-time))
- (rename-file x (concat cdir file ":2,"))))
+ (rename-file x (concat cdir (nnmaildir--ensure-suffix file)))))
(setf (nnmaildir--grp-new group) nattr))
(setq cattr (nth 5 (file-attributes cdir)))
(if (equal cattr (nnmaildir--grp-cur group))
@@ -784,11 +849,23 @@ by nnmaildir-request-article.")
cdir (nnmaildir--marks-dir nndir)
ndir (nnmaildir--subdir cdir "tick")
cdir (nnmaildir--subdir cdir "read"))
- (dolist (file files)
- (setq file (car file))
- (if (or (not (file-exists-p (concat cdir file)))
- (file-exists-p (concat ndir file)))
- (setq num (1+ num)))))
+ (dolist (prefix-suffix files)
+ (let ((prefix (car prefix-suffix))
+ (suffix (cdr prefix-suffix)))
+ ;; increase num for each unread or ticked article
+ (when (or
+ ;; first look for marks in suffix, if it's valid...
+ (when (and (stringp suffix)
+ (gnus-string-prefix-p ":2," suffix))
+ (or
+ (not (gnus-string-match-p
+ (string (nnmaildir--mark-to-flag 'read)) suffix))
+ (gnus-string-match-p
+ (string (nnmaildir--mark-to-flag 'tick)) suffix)))
+ ;; then look in marks directories
+ (not (file-exists-p (concat cdir prefix)))
+ (file-exists-p (concat ndir prefix)))
+ (incf num)))))
(setf (nnmaildir--grp-cache group) (make-vector num nil))
(let ((inhibit-quit t))
(set (intern gname groups) group))
@@ -916,12 +993,15 @@ by nnmaildir-request-article.")
"\n")))))
'group)
-(defun nnmaildir-request-marks (gname info &optional server)
- (let ((group (nnmaildir--prepare server gname))
- pgname flist always-marks never-marks old-marks dotfile num dir
- markdirs marks mark ranges markdir article read end new-marks ls
- old-mmth new-mmth mtime mark-sym existing missing deactivate-mark
- article-list)
+(defun nnmaildir-request-update-info (gname info &optional server)
+ (let* ((group (nnmaildir--prepare server gname))
+ (curdir (nnmaildir--cur
+ (nnmaildir--srvgrp-dir
+ (nnmaildir--srv-dir nnmaildir--cur-server) gname)))
+ (curdir-mtime (nth 5 (file-attributes curdir)))
+ pgname flist always-marks never-marks old-marks dotfile num dir
+ all-marks marks mark ranges markdir read end new-marks ls
+ old-mmth new-mmth mtime mark-sym existing missing deactivate-mark)
(catch 'return
(unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
@@ -950,34 +1030,71 @@ by nnmaildir-request-article.")
dir (nnmaildir--nndir dir)
dir (nnmaildir--marks-dir dir)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
- markdirs (funcall ls dir nil "\\`[^.]" 'nosort)
- new-mmth (nnmaildir--up2-1 (length markdirs))
+ all-marks (gnus-delete-duplicates
+ ;; get mark names from mark dirs and from flag
+ ;; mappings
+ (append
+ (mapcar 'cdr nnmaildir-flag-mark-mapping)
+ (mapcar 'intern (funcall ls dir nil "\\`[^.]" 'nosort))))
+ new-mmth (nnmaildir--up2-1 (length all-marks))
new-mmth (make-vector new-mmth 0)
old-mmth (nnmaildir--grp-mmth group))
- (dolist (mark markdirs)
- (setq markdir (nnmaildir--subdir dir mark)
- mark-sym (intern mark)
+ (dolist (mark all-marks)
+ (setq markdir (nnmaildir--subdir dir (symbol-name mark))
ranges nil)
(catch 'got-ranges
- (if (memq mark-sym never-marks) (throw 'got-ranges nil))
- (when (memq mark-sym always-marks)
+ (if (memq mark never-marks) (throw 'got-ranges nil))
+ (when (memq mark always-marks)
(setq ranges existing)
(throw 'got-ranges nil))
- (setq mtime (nth 5 (file-attributes markdir)))
- (set (intern mark new-mmth) mtime)
- (when (equal mtime (symbol-value (intern-soft mark old-mmth)))
- (setq ranges (assq mark-sym old-marks))
+ ;; Find the mtime for this mark. If this mark can be expressed as
+ ;; a filename flag, get the later of the mtimes for markdir and
+ ;; curdir, otherwise only the markdir counts.
+ (setq mtime
+ (let ((markdir-mtime (nth 5 (file-attributes markdir))))
+ (cond
+ ((null (nnmaildir--mark-to-flag mark))
+ markdir-mtime)
+ ((null markdir-mtime)
+ curdir-mtime)
+ ((null curdir-mtime)
+ ;; this should never happen...
+ markdir-mtime)
+ ((time-less-p markdir-mtime curdir-mtime)
+ curdir-mtime)
+ (t
+ markdir-mtime))))
+ (set (intern (symbol-name mark) new-mmth) mtime)
+ (when (equal mtime (symbol-value (intern-soft (symbol-name mark) old-mmth)))
+ (setq ranges (assq mark old-marks))
(if ranges (setq ranges (cdr ranges)))
(throw 'got-ranges nil))
- (setq article-list nil)
- (dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort))
- (setq article (nnmaildir--flist-art flist prefix))
- (if article
- (setq article-list
- (cons (nnmaildir--art-num article) article-list))))
- (setq ranges (gnus-add-to-range ranges (sort article-list '<))))
- (if (eq mark-sym 'read) (setq read ranges)
- (if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
+ (let ((article-list nil))
+ ;; Consider the article marked if it either has the flag in the
+ ;; filename, or is in the markdir. As you'd rarely remove a
+ ;; flag/mark, this should avoid losing information in the most
+ ;; common usage pattern.
+ (or
+ (let ((flag (nnmaildir--mark-to-flag mark)))
+ ;; If this mark has a corresponding maildir flag...
+ (when flag
+ (let ((regexp
+ (concat "\\`[^.].*:2,[A-Z]*" (string flag))))
+ ;; ...then find all files with that flag.
+ (dolist (filename (funcall ls curdir nil regexp 'nosort))
+ (let* ((prefix (car (split-string filename ":2,")))
+ (article (nnmaildir--flist-art flist prefix)))
+ (when article
+ (push (nnmaildir--art-num article) article-list)))))))
+ ;; Also check Gnus-specific mark directory, if it exists.
+ (when (file-directory-p markdir)
+ (dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort))
+ (let ((article (nnmaildir--flist-art flist prefix)))
+ (when article
+ (push (nnmaildir--art-num article) article-list))))))
+ (setq ranges (gnus-add-to-range ranges (sort article-list '<)))))
+ (if (eq mark 'read) (setq read ranges)
+ (if ranges (setq marks (cons (cons mark ranges) marks)))))
(gnus-info-set-read info (gnus-range-add read missing))
(gnus-info-set-marks info marks 'extend)
(setf (nnmaildir--grp-mmth group) new-mmth)
@@ -1461,7 +1578,7 @@ by nnmaildir-request-article.")
(if (eq time 'immediate)
(setq time 0)
(if (numberp time)
- (setq time (* time 86400)))))
+ (setq time (round (* time 86400))))))
(when no-force
(unless (integerp time) ;; handle 'never
(throw 'return (gnus-uncompress-range ranges)))
@@ -1525,39 +1642,63 @@ by nnmaildir-request-article.")
didnt)))
(defun nnmaildir-request-set-mark (gname actions &optional server)
- (let ((group (nnmaildir--prepare server gname))
- (coding-system-for-write nnheader-file-coding-system)
- (buffer-file-coding-system nil)
- (file-coding-system-alist nil)
- del-mark del-action add-action set-action marksdir nlist
- ranges begin end article all-marks todo-marks mdir mfile
- pgname ls permarkfile deactivate-mark)
+ (let* ((group (nnmaildir--prepare server gname))
+ (curdir (nnmaildir--cur
+ (nnmaildir--srvgrp-dir
+ (nnmaildir--srv-dir nnmaildir--cur-server)
+ gname)))
+ (coding-system-for-write nnheader-file-coding-system)
+ (buffer-file-coding-system nil)
+ (file-coding-system-alist nil)
+ del-mark del-action add-action set-action marksdir nlist
+ ranges begin end article all-marks todo-marks mdir mfile
+ pgname ls permarkfile deactivate-mark)
(setq del-mark
(lambda (mark)
- (setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
- mfile (concat mfile (nnmaildir--art-prefix article)))
- (nnmaildir--unlink mfile))
+ (let ((prefix (nnmaildir--art-prefix article))
+ (suffix (nnmaildir--art-suffix article))
+ (flag (nnmaildir--mark-to-flag mark)))
+ (when flag
+ ;; If this mark corresponds to a flag, remove the flag from
+ ;; the file name.
+ (nnmaildir--article-set-flags
+ article (nnmaildir--remove-flag flag suffix) curdir))
+ ;; We still want to delete the hardlink in the marks dir if
+ ;; present, regardless of whether this mark has a maildir flag or
+ ;; not, to avoid getting out of sync.
+ (setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
+ mfile (concat mfile prefix))
+ (nnmaildir--unlink mfile)))
del-action (lambda (article) (mapcar del-mark todo-marks))
add-action
(lambda (article)
(mapcar
(lambda (mark)
- (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
- permarkfile (concat mdir ":")
- mfile (concat mdir (nnmaildir--art-prefix article)))
- (nnmaildir--condcase err (add-name-to-file permarkfile mfile)
- (cond
- ((nnmaildir--eexist-p err))
- ((nnmaildir--enoent-p err)
- (nnmaildir--mkdir mdir)
- (nnmaildir--mkfile permarkfile)
- (add-name-to-file permarkfile mfile))
- ((nnmaildir--emlink-p err)
- (let ((permarkfilenew (concat permarkfile "{new}")))
- (nnmaildir--mkfile permarkfilenew)
- (rename-file permarkfilenew permarkfile 'replace)
- (add-name-to-file permarkfile mfile)))
- (t (signal (car err) (cdr err))))))
+ (let ((prefix (nnmaildir--art-prefix article))
+ (suffix (nnmaildir--art-suffix article))
+ (flag (nnmaildir--mark-to-flag mark)))
+ (if flag
+ ;; If there is a corresponding maildir flag, just rename
+ ;; the file.
+ (nnmaildir--article-set-flags
+ article (nnmaildir--add-flag flag suffix) curdir)
+ ;; Otherwise, use nnmaildir-specific marks dir.
+ (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
+ permarkfile (concat mdir ":")
+ mfile (concat mdir prefix))
+ (nnmaildir--condcase err (add-name-to-file permarkfile mfile)
+ (cond
+ ((nnmaildir--eexist-p err))
+ ((nnmaildir--enoent-p err)
+ (nnmaildir--mkdir mdir)
+ (nnmaildir--mkfile permarkfile)
+ (add-name-to-file permarkfile mfile))
+ ((nnmaildir--emlink-p err)
+ (let ((permarkfilenew (concat permarkfile "{new}")))
+ (nnmaildir--mkfile permarkfilenew)
+ (rename-file permarkfilenew permarkfile 'replace)
+ (add-name-to-file permarkfile mfile)))
+ (t (signal (car err) (cdr err))))))))
todo-marks))
set-action (lambda (article)
(funcall add-action article)
@@ -1581,7 +1722,12 @@ by nnmaildir-request-article.")
pgname (nnmaildir--pgname nnmaildir--cur-server gname)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
- all-marks (mapcar 'intern all-marks))
+ all-marks (gnus-delete-duplicates
+ ;; get mark names from mark dirs and from flag
+ ;; mappings
+ (append
+ (mapcar 'cdr nnmaildir-flag-mark-mapping)
+ (mapcar 'intern all-marks))))
(dolist (action actions)
(setq ranges (car action)
todo-marks (caddr action))
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index 4ad9d11f906..1174d148e45 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -1,6 +1,6 @@
;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: David Engster <dengste@eml.cc>
;; Keywords: mail searching
@@ -483,7 +483,7 @@ Other back ends might or might not work.")
mfolder query threads)))
;; Check return value
(cond
- ((zerop rval) ; call was succesful
+ ((zerop rval) ; call was successful
(nnmairix-call-backend
"open-server" nnmairix-backend-server)
;; If we're dealing with nnml, rename files
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index aac5a064a7f..cdb42eb5327 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -1,6 +1,6 @@
;;; nnmbox.el --- mail mbox access for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index ec270eba2ce..960b15fd1aa 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -1,6 +1,6 @@
;;; nnmh.el --- mhspool access for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 59e06364f42..600a0d21e3c 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -1,10 +1,10 @@
;;; nnml.el --- mail spool access for Gnus
-;; Copyright (C) 1995-2011 Free Software
+;; Copyright (C) 1995-2012 Free Software
;; Foundation, Inc.
;; Authors: Didier Verna <didier@xemacs.org> (adding compaction)
-;; Simon Josefsson <simon@josefsson.org> (adding MARKS)
+;; Simon Josefsson <simon@josefsson.org>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail
@@ -67,15 +67,6 @@ the `nnml-generate-nov-databases' command. The function will go
through all nnml directories and generate nov databases for them
all. This may very well take some time.")
-(defvoo nnml-marks-is-evil nil
- "If non-nil, Gnus will never generate and use marks file for mail spools.
-Using marks files makes it possible to backup and restore mail groups
-separately from `.newsrc.eld'. If you have, for some reason, set this
-to t, and want to set it to nil again, you should always remove the
-corresponding marks file (usually named `.marks' in the nnml group
-directory, but see `nnml-marks-file-name') for the group. Then the
-marks file will be regenerated properly by Gnus.")
-
(defvoo nnml-prepare-save-mail-hook nil
"Hook run narrowed to an article before saving.")
@@ -102,7 +93,6 @@ non-nil.")
"nnml version.")
(defvoo nnml-nov-file-name ".overview")
-(defvoo nnml-marks-file-name ".marks")
(defvoo nnml-current-directory nil)
(defvoo nnml-current-group nil)
@@ -118,10 +108,6 @@ non-nil.")
(defvoo nnml-file-coding-system nnmail-file-coding-system)
-(defvoo nnml-marks nil)
-
-(defvar nnml-marks-modtime (gnus-make-hashtable))
-
;;; Interface functions.
@@ -513,8 +499,7 @@ non-nil.")
nnml-current-directory t
(concat
nnheader-numerical-short-files
- "\\|" (regexp-quote nnml-nov-file-name) "$"
- "\\|" (regexp-quote nnml-marks-file-name) "$")))
+ "\\|" (regexp-quote nnml-nov-file-name) "$")))
(decoded (nnml-decoded-group-name group server)))
(dolist (article articles)
(when (file-writable-p article)
@@ -554,10 +539,6 @@ non-nil.")
(let ((overview (concat old-dir nnml-nov-file-name)))
(when (file-exists-p overview)
(rename-file overview (concat new-dir nnml-nov-file-name))))
- ;; Move .marks file.
- (let ((marks (concat old-dir nnml-marks-file-name)))
- (when (file-exists-p marks)
- (rename-file marks (concat new-dir nnml-marks-file-name))))
(when (<= (length (directory-files old-dir)) 2)
(ignore-errors (delete-directory old-dir)))
;; That went ok, so we change the internal structures.
@@ -1033,99 +1014,6 @@ Use the nov database for the current group if available."
(forward-line 1))
alist))))
-(deffoo nnml-request-set-mark (group actions &optional server)
- (nnml-possibly-change-directory group server)
- (unless nnml-marks-is-evil
- (nnml-open-marks group server)
- (setq nnml-marks (nnheader-update-marks-actions nnml-marks actions))
- (nnml-save-marks group server))
- nil)
-
-(deffoo nnml-request-marks (group info &optional server)
- (nnml-possibly-change-directory group server)
- (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group server))
- (nnheader-message 8 "Updating marks for %s..." group)
- (nnml-open-marks group server)
- ;; Update info using `nnml-marks'.
- (mapc (lambda (pred)
- (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nnml-marks))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
- (let ((seen (cdr (assq 'read nnml-marks))))
- (gnus-info-set-read info
- (if (and (integerp (car seen))
- (null (cdr seen)))
- (list (cons (car seen) (car seen)))
- seen)))
- (nnheader-message 8 "Updating marks for %s...done" group))
- info)
-
-(defun nnml-marks-changed-p (group server)
- (let ((file (nnml-group-pathname group nnml-marks-file-name server)))
- (if (null (gnus-gethash file nnml-marks-modtime))
- t ;; never looked at marks file, assume it has changed
- (not (equal (gnus-gethash file nnml-marks-modtime)
- (nth 5 (file-attributes file)))))))
-
-(defun nnml-save-marks (group server)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (file (nnml-group-pathname group nnml-marks-file-name server)))
- (condition-case err
- (progn
- (nnml-possibly-create-directory group server)
- (with-temp-file file
- (erase-buffer)
- (gnus-prin1 nnml-marks)
- (insert "\n"))
- (gnus-sethash file
- (nth 5 (file-attributes file))
- nnml-marks-modtime))
- (error (or (gnus-yes-or-no-p
- (format "Could not write to %s (%s). Continue? " file err))
- (error "Cannot write to %s (%s)" file err))))))
-
-(defun nnml-open-marks (group server)
- (let* ((decoded (nnml-decoded-group-name group server))
- (file (nnmail-group-pathname decoded nnml-directory
- nnml-marks-file-name))
- (file-name-coding-system nnmail-pathname-coding-system))
- (if (file-exists-p file)
- (condition-case err
- (with-temp-buffer
- (gnus-sethash file (nth 5 (file-attributes file))
- nnml-marks-modtime)
- (nnheader-insert-file-contents file)
- (setq nnml-marks (read (current-buffer)))
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnml-marks (gnus-remassoc el nnml-marks))))
- (error (or (gnus-yes-or-no-p
- (format "Error reading nnml marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
- (error "Cannot read nnml marks file %s (%s)" file err))))
- ;; User didn't have a .marks file. Probably first time
- ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
- (let ((info (gnus-get-info
- (gnus-group-prefixed-name
- group
- (gnus-server-to-method
- (format "nnml:%s" (or server "")))))))
- (setq decoded (if (member server '(nil ""))
- (concat "nnml:" decoded)
- (format "nnml+%s:%s" server decoded)))
- (nnheader-message 7 "Bootstrapping marks for %s..." decoded)
- (setq nnml-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nnml-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnml-marks (gnus-remassoc el nnml-marks)))
- (nnml-save-marks group server)
- (nnheader-message 7 "Bootstrapping marks for %s...done" decoded)))))
-
-
;;;
;;; Group and server compaction. -- dvl
;;;
@@ -1275,19 +1163,11 @@ Use the nov database for the current group if available."
(gnus-set-active group-full-name active))
;; 1 bis/
;; #### NOTE: normally, we should save the overview (NOV) file
- ;; #### here, just like we save the marks file. However, there is no
- ;; #### such function as nnml-save-nov for a single group. Only for
- ;; #### all groups. Gnus inconsistency is getting worse every day...
- ;; 2/ Rebuild marks file:
- (unless nnml-marks-is-evil
- ;; #### NOTE: this constant use of global variables everywhere is
- ;; #### truly disgusting. Gnus really needs a *major* cleanup.
- (setq nnml-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nnml-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnml-marks (gnus-remassoc el nnml-marks)))
- (nnml-save-marks group server))
- ;; 3/ Save everything if this was not part of a bigger operation:
+ ;; #### here. However, there is no such function as
+ ;; #### nnml-save-nov for a single group. Only for all
+ ;; #### groups. Gnus inconsistency is getting worse every
+ ;; #### day... ;; 3/ Save everything if this was not part of
+ ;; #### a bigger operation:
(if (not save)
;; Nothing to save (yet):
t
diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el
index bbe47fcf5c0..12df03c8b26 100644
--- a/lisp/gnus/nnoo.el
+++ b/lisp/gnus/nnoo.el
@@ -1,6 +1,6 @@
;;; nnoo.el --- OO Gnus Backends
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/nnregistry.el b/lisp/gnus/nnregistry.el
index 2001f8f2366..2a6e3f046c6 100644
--- a/lisp/gnus/nnregistry.el
+++ b/lisp/gnus/nnregistry.el
@@ -1,7 +1,7 @@
;;; nnregistry.el --- access to articles via Gnus' message-id registry
;;; -*- coding: utf-8 -*-
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Authors: Ludovic Courtès <ludo@gnu.org>
;; Keywords: news, mail
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 3e3b7326f29..d35d7c623a7 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -1,6 +1,6 @@
;;; nnrss.el --- interfacing with RSS
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: RSS
diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el
index 6c23f41132f..ad9e9c62d6d 100644
--- a/lisp/gnus/nnspool.el
+++ b/lisp/gnus/nnspool.el
@@ -1,6 +1,6 @@
;;; nnspool.el --- spool access for GNU Emacs
-;; Copyright (C) 1988-1990, 1993-1998, 2000-2011
+;; Copyright (C) 1988-1990, 1993-1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -31,6 +31,26 @@
(require 'nnoo)
(eval-when-compile (require 'cl))
+;; Probably this entire thing should be obsolete.
+;; It's only used to init nnspool-spool-directory, so why not just
+;; set that variable's default directly?
+(eval-and-compile
+ (defvar news-directory (if (file-exists-p "/usr/spool/news/")
+ "/usr/spool/news/"
+ "/var/spool/news/")
+ "The root directory below which all news files are stored.")
+ (defvaralias 'news-path 'news-directory))
+
+;; Ditto re obsolescence.
+(defvar news-inews-program
+ (cond ((file-exists-p "/usr/bin/inews") "/usr/bin/inews")
+ ((file-exists-p "/usr/local/inews") "/usr/local/inews")
+ ((file-exists-p "/usr/local/bin/inews") "/usr/local/bin/inews")
+ ((file-exists-p "/usr/contrib/lib/news/inews") "/usr/contrib/lib/news/inews")
+ ((file-exists-p "/usr/lib/news/inews") "/usr/lib/news/inews")
+ (t "inews"))
+ "Program to post news.")
+
(nnoo-declare nnspool)
(defvoo nnspool-inews-program news-inews-program
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index f4b8ce66d16..be5d1e6ff4c 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -1,6 +1,6 @@
;;; nntp.el --- nntp access for Gnus
-;; Copyright (C) 1987-1990, 1992-1998, 2000-2011
+;; Copyright (C) 1987-1990, 1992-1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -222,27 +222,6 @@ then use this hook to rsh to the remote machine and start a proxy NNTP
server there that you can connect to. See also
`nntp-open-connection-function'")
-(defvoo nntp-coding-system-for-read 'binary
- "*Coding system to read from NNTP.")
-
-(defvoo nntp-coding-system-for-write 'binary
- "*Coding system to write to NNTP.")
-
-;; Marks
-(defvoo nntp-marks-is-evil nil
- "*If non-nil, Gnus will never generate and use marks file for nntp groups.
-See `nnml-marks-is-evil' for more information.")
-
-(defvoo nntp-marks-file-name ".marks")
-(defvoo nntp-marks nil)
-(defvar nntp-marks-modtime (gnus-make-hashtable))
-
-(defcustom nntp-marks-directory
- (nnheader-concat gnus-directory "marks/")
- "*The directory where marks for nntp groups will be stored."
- :group 'nntp
- :type 'directory)
-
(defcustom nntp-authinfo-file "~/.authinfo"
".netrc-like file that holds nntp authinfo passwords."
:group 'nntp
@@ -281,6 +260,7 @@ update their active files often, this can help.")
;;; Internal variables.
+(defvoo nntp-retrieval-in-progress nil)
(defvar nntp-record-commands nil
"*If non-nil, nntp will record all commands in the \"*nntp-log*\" buffer.")
@@ -343,26 +323,26 @@ backend doesn't catch this error.")
(insert (format-time-string "%Y%m%dT%H%M%S.%3N")
" " nntp-address " " string "\n")))
+(defvar nntp--report-1 nil)
+
(defun nntp-report (&rest args)
"Report an error from the nntp backend. The first string in ARGS
can be a format string. For some commands, the failed command may be
retried once before actually displaying the error report."
+ (if nntp--report-1
+ (progn
+ ;; Throw out to nntp-with-open-group-error so that the connection may
+ ;; be restored and the command retried."
+ (when nntp-record-commands
+ (nntp-record-command "*** CONNECTION LOST ***"))
+ (throw 'nntp-with-open-group-error t))
- (when nntp-record-commands
- (nntp-record-command "*** CALLED nntp-report ***"))
-
- (nnheader-report 'nntp args)
-
- (apply 'error args))
+ (when nntp-record-commands
+ (nntp-record-command "*** CALLED nntp-report ***"))
-(defun nntp-report-1 (&rest args)
- "Throws out to nntp-with-open-group-error so that the connection may
-be restored and the command retried."
+ (nnheader-report 'nntp args)
- (when nntp-record-commands
- (nntp-record-command "*** CONNECTION LOST ***"))
-
- (throw 'nntp-with-open-group-error t))
+ (apply 'error args)))
(defmacro nntp-copy-to-buffer (buffer start end)
"Copy string from unibyte current buffer to multibyte buffer."
@@ -632,10 +612,6 @@ be restored and the command retried."
(t
nil)))
-(eval-when-compile
- (defvar nntp-with-open-group-internal nil)
- (defvar nntp-report-n nil))
-
(defun nntp-with-open-group-function (-group -server -connectionless -bodyfun)
"Protect against servers that don't like clients that keep idle connections opens.
The problem being that these servers may either close a connection or
@@ -646,9 +622,9 @@ connection timeouts (which may be several minutes) or
`nntp-connection-timeout' has expired. When these occur
`nntp-with-open-group', opens a new connection then re-issues the NNTP
command whose response triggered the error."
- (letf ((nntp-report-n (symbol-function 'nntp-report))
- ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1))
- (nntp-with-open-group-internal nil))
+ (let ((nntp-report-n nntp--report-1)
+ (nntp--report-1 t)
+ (nntp-with-open-group-internal nil))
(while (catch 'nntp-with-open-group-error
;; Open the connection to the server
;; NOTE: Existing connections are NOT tested.
@@ -684,7 +660,7 @@ command whose response triggered the error."
(when -timer
(nnheader-cancel-timer -timer)))
nil))
- (setf (symbol-function 'nntp-report) nntp-report-n))
+ (setq nntp--report-1 nntp-report-n))
nntp-with-open-group-internal))
(defmacro nntp-with-open-group (group server &optional connectionless &rest forms)
@@ -770,21 +746,32 @@ command whose response triggered the error."
(deffoo nntp-retrieve-group-data-early (server infos)
"Retrieve group info on INFOS."
(nntp-with-open-group nil server
- (when (nntp-find-connection-buffer nntp-server-buffer)
- ;; The first time this is run, this variable is `try'. So we
- ;; try.
- (when (eq nntp-server-list-active-group 'try)
- (nntp-try-list-active
- (gnus-group-real-name (gnus-info-group (car infos)))))
- (with-current-buffer (nntp-find-connection-buffer nntp-server-buffer)
- (erase-buffer)
- (let ((nntp-inhibit-erase t)
- (command (if nntp-server-list-active-group
- "LIST ACTIVE" "GROUP")))
- (dolist (info infos)
- (nntp-send-command
- nil command (gnus-group-real-name (gnus-info-group info)))))
- (length infos)))))
+ (let ((buffer (nntp-find-connection-buffer nntp-server-buffer)))
+ (unless infos
+ (with-current-buffer buffer
+ (setq nntp-retrieval-in-progress nil)))
+ (when (and buffer
+ infos
+ (with-current-buffer buffer
+ (not nntp-retrieval-in-progress)))
+ ;; The first time this is run, this variable is `try'. So we
+ ;; try.
+ (when (eq nntp-server-list-active-group 'try)
+ (nntp-try-list-active
+ (gnus-group-real-name (gnus-info-group (car infos)))))
+ (with-current-buffer buffer
+ (erase-buffer)
+ ;; Mark this buffer as "in use" in case we try to issue two
+ ;; retrievals from the same server. This shouldn't happen,
+ ;; so this is mostly a sanity check.
+ (setq nntp-retrieval-in-progress t)
+ (let ((nntp-inhibit-erase t)
+ (command (if nntp-server-list-active-group
+ "LIST ACTIVE" "GROUP")))
+ (dolist (info infos)
+ (nntp-send-command
+ nil command (gnus-group-real-name (gnus-info-group info)))))
+ (length infos))))))
(deffoo nntp-finish-retrieve-group-infos (server infos count)
(nntp-with-open-group nil server
@@ -794,6 +781,8 @@ command whose response triggered the error."
(car infos)))
(received 0)
(last-point 1))
+ (with-current-buffer buf
+ (setq nntp-retrieval-in-progress nil))
(when (and buf
count)
(with-current-buffer buf
@@ -816,7 +805,8 @@ command whose response triggered the error."
(progn
(nntp-copy-to-buffer nntp-server-buffer
(point-min) (point-max))
- (gnus-groups-to-gnus-format method gnus-active-hashtb t))
+ (with-current-buffer nntp-server-buffer
+ (gnus-groups-to-gnus-format method gnus-active-hashtb t)))
;; We have read active entries, so we just delete the
;; superfluous gunk.
(goto-char (point-min))
@@ -837,7 +827,14 @@ command whose response triggered the error."
"Retrieve group info on GROUPS."
(nntp-with-open-group
nil server
- (when (nntp-find-connection-buffer nntp-server-buffer)
+ (when (and (nntp-find-connection-buffer nntp-server-buffer)
+ (with-current-buffer
+ (nntp-find-connection-buffer nntp-server-buffer)
+ (if (not nntp-retrieval-in-progress)
+ t
+ (message "Warning: Refusing to do retrieval from %s because a retrieval is already happening"
+ server)
+ nil)))
(catch 'done
(save-excursion
;; Erase nntp-server-buffer before nntp-inhibit-erase.
@@ -1167,43 +1164,6 @@ command whose response triggered the error."
(deffoo nntp-asynchronous-p ()
t)
-(deffoo nntp-request-set-mark (group actions &optional server)
- (when (and (not nntp-marks-is-evil)
- nntp-marks-file-name)
- (nntp-possibly-create-directory group server)
- (nntp-open-marks group server)
- (setq nntp-marks (nnheader-update-marks-actions nntp-marks actions))
- (nntp-save-marks group server))
- nil)
-
-(deffoo nntp-request-marks (group info &optional server)
- (when (and (not nntp-marks-is-evil)
- nntp-marks-file-name)
- (nntp-possibly-create-directory group server)
- (when (nntp-marks-changed-p group server)
- (nnheader-message 8 "Updating marks for %s..." group)
- (nntp-open-marks group server)
- ;; Update info using `nntp-marks'.
- (mapc (lambda (pred)
- (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nntp-marks))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
- (let ((seen (cdr (assq 'read nntp-marks))))
- (gnus-info-set-read info
- (if (and (integerp (car seen))
- (null (cdr seen)))
- (list (cons (car seen) (car seen)))
- seen)))
- (nnheader-message 8 "Updating marks for %s...done" group)))
- nil)
-
-
;;; Hooky functions.
@@ -1231,10 +1191,11 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(let* ((list (netrc-parse nntp-authinfo-file))
(alist (netrc-machine list nntp-address "nntp"))
(auth-info
- (nth 0 (auth-source-search :max 1
- ;; TODO: allow the virtual server name too
- :host nntp-address
- :port '("119" "nntp"))))
+ (nth 0 (auth-source-search
+ :max 1
+ :host (list nntp-address (nnoo-current-server 'nntp))
+ :port `("119" "nntp" ,(format "%s" nntp-port-number)
+ "563" "nntps" "snews"))))
(auth-user (plist-get auth-info :user))
(auth-force (plist-get auth-info :force))
(auth-passwd (plist-get auth-info :secret))
@@ -1269,30 +1230,6 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(read-passwd (format "NNTP (%s@%s) password: "
user nntp-address))))))))))
-(defun nntp-send-nosy-authinfo ()
- "Send the AUTHINFO to the nntp server."
- (let ((user (read-string (format "NNTP (%s) user name: " nntp-address))))
- (unless (member user '(nil ""))
- (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
- (when t ;???Should check if AUTHINFO succeeded
- (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"
- (read-passwd (format "NNTP (%s@%s) password: "
- user nntp-address)))))))
-
-(defun nntp-send-authinfo-from-file ()
- "Send the AUTHINFO to the nntp server.
-
-The authinfo login name is taken from the user's login name and the
-password contained in '~/.nntp-authinfo'."
- (when (file-exists-p "~/.nntp-authinfo")
- (with-temp-buffer
- (insert-file-contents "~/.nntp-authinfo")
- (goto-char (point-min))
- (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
- (nntp-send-command
- "^2.*\r?\n" "AUTHINFO PASS"
- (buffer-substring (point) (point-at-eol))))))
-
;;; Internal functions.
(defun nntp-handle-authinfo (process)
@@ -1318,6 +1255,7 @@ password contained in '~/.nntp-authinfo'."
(set (make-local-variable 'nntp-process-to-buffer) nil)
(set (make-local-variable 'nntp-process-start-point) nil)
(set (make-local-variable 'nntp-process-decode) nil)
+ (set (make-local-variable 'nntp-retrieval-in-progress) nil)
(current-buffer)))
(defun nntp-open-connection (buffer)
@@ -1332,8 +1270,8 @@ password contained in '~/.nntp-authinfo'."
(nntp-kill-buffer ,pbuffer)))))
(process
(condition-case err
- (let ((coding-system-for-read nntp-coding-system-for-read)
- (coding-system-for-write nntp-coding-system-for-write)
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
(map '((nntp-open-network-stream network)
(network-only plain) ; compat
(nntp-open-plain-stream plain)
@@ -1363,6 +1301,10 @@ password contained in '~/.nntp-authinfo'."
(nnheader-cancel-timer timer))
(when (and process
(not (memq (process-status process) '(open run))))
+ (with-current-buffer pbuffer
+ (goto-char (point-min))
+ (nnheader-report 'nntp "Error when connecting: %s"
+ (buffer-substring (point) (line-end-position))))
(setq process nil))
(unless process
(nntp-kill-buffer pbuffer))
@@ -1414,14 +1356,6 @@ password contained in '~/.nntp-authinfo'."
nntp-process-start-point (point-max))
(setq after-change-functions '(nntp-after-change-function))))
-(defun nntp-async-timer-handler ()
- (mapcar
- (lambda (proc)
- (if (memq (process-status proc) '(open run))
- (nntp-async-trigger proc)
- (nntp-async-stop proc)))
- nntp-async-process-list))
-
(defun nntp-async-stop (proc)
(setq nntp-async-process-list (delq proc nntp-async-process-list))
(when (and nntp-async-timer (not nntp-async-process-list))
@@ -2138,95 +2072,6 @@ Please refer to the following variables to customize the connection:
(delete-region (point) (point-max)))
proc)))
-;; Marks handling
-
-(defun nntp-marks-directory (server)
- (expand-file-name server nntp-marks-directory))
-
-(defvar nntp-server-to-method-cache nil
- "Alist of servers and select methods.")
-
-(defun nntp-group-pathname (server group &optional file)
- "Return an absolute file name of FILE for GROUP on SERVER."
- (let ((method (cdr (assoc server nntp-server-to-method-cache))))
- (unless method
- (push (cons server (setq method (or (gnus-server-to-method server)
- (gnus-find-method-for-group group))))
- nntp-server-to-method-cache))
- (nnmail-group-pathname
- (mm-decode-coding-string group
- (inline (gnus-group-name-charset method group)))
- (nntp-marks-directory server)
- file)))
-
-(defun nntp-possibly-create-directory (group server)
- (let ((dir (nntp-group-pathname server group))
- (file-name-coding-system nnmail-pathname-coding-system))
- (unless (file-exists-p dir)
- (make-directory (directory-file-name dir) t)
- (nnheader-message 5 "Creating nntp marks directory %s" dir))))
-
-(autoload 'time-less-p "time-date")
-
-(defun nntp-marks-changed-p (group server)
- (let ((file (nntp-group-pathname server group nntp-marks-file-name))
- (file-name-coding-system nnmail-pathname-coding-system))
- (if (null (gnus-gethash file nntp-marks-modtime))
- t ;; never looked at marks file, assume it has changed
- (time-less-p (gnus-gethash file nntp-marks-modtime)
- (nth 5 (file-attributes file))))))
-
-(defun nntp-save-marks (group server)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (file (nntp-group-pathname server group nntp-marks-file-name)))
- (condition-case err
- (progn
- (nntp-possibly-create-directory group server)
- (with-temp-file file
- (erase-buffer)
- (gnus-prin1 nntp-marks)
- (insert "\n"))
- (gnus-sethash file
- (nth 5 (file-attributes file))
- nntp-marks-modtime))
- (error (or (gnus-yes-or-no-p
- (format "Could not write to %s (%s). Continue? " file err))
- (error "Cannot write to %s (%s)" file err))))))
-
-(defun nntp-open-marks (group server)
- (let ((file (nntp-group-pathname server group nntp-marks-file-name))
- (file-name-coding-system nnmail-pathname-coding-system))
- (if (file-exists-p file)
- (condition-case err
- (with-temp-buffer
- (gnus-sethash file (nth 5 (file-attributes file))
- nntp-marks-modtime)
- (nnheader-insert-file-contents file)
- (setq nntp-marks (read (current-buffer)))
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nntp-marks (gnus-remassoc el nntp-marks))))
- (error (or (gnus-yes-or-no-p
- (format "Error reading nntp marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
- (error "Cannot read nntp marks file %s (%s)" file err))))
- ;; User didn't have a .marks file. Probably first time
- ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
- (let ((info (gnus-get-info
- (gnus-group-prefixed-name
- group
- (gnus-server-to-method (format "nntp:%s" server)))))
- (decoded-name (mm-decode-coding-string
- group
- (gnus-group-name-charset
- (gnus-server-to-method server) group))))
- (nnheader-message 7 "Bootstrapping marks for %s..." decoded-name)
- (setq nntp-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nntp-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nntp-marks (gnus-remassoc el nntp-marks)))
- (nntp-save-marks group server)
- (nnheader-message 7 "Bootstrapping marks for %s...done"
- decoded-name)))))
-
(provide 'nntp)
;;; nntp.el ends here
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index ea64c247d99..edc9fb655a3 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -1,6 +1,6 @@
;;; nnvirtual.el --- virtual newsgroups access for Gnus
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Author: David Moore <dmoore@ucsd.edu>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el
index f190bb7cffa..8c9c984ba2e 100644
--- a/lisp/gnus/nnweb.el
+++ b/lisp/gnus/nnweb.el
@@ -1,6 +1,6 @@
;;; nnweb.el --- retrieving articles via web search engines
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -365,7 +365,7 @@ Valid types include `google', `dejanews', and `gmane'.")
(match-string 1)
(match-string 2)
(or (match-string 3)
- (substring (current-time-string) -4)))
+ (format-time-string "%Y")))
(current-time-string)))
(setq From (match-string 4)))
(widen)
diff --git a/lisp/gnus/plstore.el b/lisp/gnus/plstore.el
index 50208cc5b0b..6d5424e833d 100644
--- a/lisp/gnus/plstore.el
+++ b/lisp/gnus/plstore.el
@@ -1,5 +1,5 @@
;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
@@ -64,8 +64,18 @@
;;
;; Editing:
;;
-;; Currently not supported but in the future plstore will provide a
-;; major mode to edit PLSTORE files.
+;; This file also provides `plstore-mode', a major mode for editing
+;; the PLSTORE format file. Visit a non-existing file and put the
+;; following line:
+;;
+;; (("foo" :host "foo.example.org" :secret-user "user"))
+;;
+;; where the prefixing `:secret-' means the property (without
+;; `:secret-' prefix) is marked as secret. Thus, when you save the
+;; buffer, the `:secret-user' property is encrypted as `:user'.
+;;
+;; You can toggle the view between encrypted form and the decrypted
+;; form with C-c C-c.
;;; Code:
@@ -107,6 +117,10 @@ symmetric encryption will be used.")
(put 'plstore-encrypt-to 'permanent-local t)
+(defvar plstore-encoded nil)
+
+(put 'plstore-encoded 'permanent-local t)
+
(defvar plstore-cache-passphrase-for-symmetric-encryption nil)
(defvar plstore-passphrase-alist nil)
@@ -194,10 +208,6 @@ symmetric encryption will be used.")
(generate-new-buffer (format " plstore %s" filename))))
(store (plstore--make buffer)))
(with-current-buffer buffer
- ;; In the future plstore will provide a major mode called
- ;; `plstore-mode' to edit PLSTORE files.
- (if (eq major-mode 'plstore-mode)
- (error "%s is opened for editing; kill the buffer first" file))
(erase-buffer)
(condition-case nil
(insert-file-contents-literally file)
@@ -435,6 +445,131 @@ If no one is selected, symmetric encryption will be performed. "
(plstore--insert-buffer plstore)
(save-buffer)))
+(defun plstore--encode (plstore)
+ (plstore--decrypt plstore)
+ (let ((merged-alist (plstore--get-merged-alist plstore)))
+ (concat "("
+ (mapconcat
+ (lambda (entry)
+ (setq entry (copy-sequence entry))
+ (let ((merged-plist (cdr (assoc (car entry) merged-alist)))
+ (plist (cdr entry)))
+ (while plist
+ (if (string-match "\\`:secret-" (symbol-name (car plist)))
+ (setcar (cdr plist)
+ (plist-get
+ merged-plist
+ (intern (concat ":"
+ (substring (symbol-name
+ (car plist))
+ (match-end 0)))))))
+ (setq plist (nthcdr 2 plist)))
+ (prin1-to-string entry)))
+ (plstore--get-alist plstore)
+ "\n")
+ ")")))
+
+(defun plstore--decode (string)
+ (let* ((alist (car (read-from-string string)))
+ (pointer alist)
+ secret-alist
+ plist
+ entry)
+ (while pointer
+ (unless (stringp (car (car pointer)))
+ (error "Invalid PLSTORE format %s" string))
+ (setq plist (cdr (car pointer)))
+ (while plist
+ (when (string-match "\\`:secret-" (symbol-name (car plist)))
+ (setq entry (assoc (car (car pointer)) secret-alist))
+ (unless entry
+ (setq entry (list (car (car pointer)))
+ secret-alist (cons entry secret-alist)))
+ (setcdr entry (plist-put (cdr entry)
+ (intern (concat ":"
+ (substring (symbol-name
+ (car plist))
+ (match-end 0))))
+ (car (cdr plist))))
+ (setcar (cdr plist) t))
+ (setq plist (nthcdr 2 plist)))
+ (setq pointer (cdr pointer)))
+ (plstore--make nil alist nil secret-alist)))
+
+(defun plstore--write-contents-functions ()
+ (when plstore-encoded
+ (let ((store (plstore--decode (buffer-string)))
+ (file (buffer-file-name)))
+ (unwind-protect
+ (progn
+ (set-visited-file-name nil)
+ (with-temp-buffer
+ (plstore--insert-buffer store)
+ (write-region (buffer-string) nil file)))
+ (set-visited-file-name file)
+ (set-buffer-modified-p nil))
+ t)))
+
+(defun plstore-mode-original ()
+ "Show the original form of the this buffer."
+ (interactive)
+ (when plstore-encoded
+ (if (and (buffer-modified-p)
+ (y-or-n-p "Save buffer before reading the original form? "))
+ (save-buffer))
+ (erase-buffer)
+ (insert-file-contents-literally (buffer-file-name))
+ (set-buffer-modified-p nil)
+ (setq plstore-encoded nil)))
+
+(defun plstore-mode-decoded ()
+ "Show the decoded form of the this buffer."
+ (interactive)
+ (unless plstore-encoded
+ (if (and (buffer-modified-p)
+ (y-or-n-p "Save buffer before decoding? "))
+ (save-buffer))
+ (let ((store (plstore--make (current-buffer))))
+ (plstore--init-from-buffer store)
+ (erase-buffer)
+ (insert
+ (substitute-command-keys "\
+;;; You are looking at the decoded form of the PLSTORE file.\n\
+;;; To see the original form content, do \\[plstore-mode-toggle-display]\n\n"))
+ (insert (plstore--encode store))
+ (set-buffer-modified-p nil)
+ (setq plstore-encoded t))))
+
+(defun plstore-mode-toggle-display ()
+ "Toggle the display mode of PLSTORE between the original and decoded forms."
+ (interactive)
+ (if plstore-encoded
+ (plstore-mode-original)
+ (plstore-mode-decoded)))
+
+(eval-when-compile
+ (defmacro plstore-called-interactively-p (kind)
+ (condition-case nil
+ (progn
+ (eval '(called-interactively-p 'any))
+ ;; Emacs >=23.2
+ `(called-interactively-p ,kind))
+ ;; Emacs <23.2
+ (wrong-number-of-arguments '(called-interactively-p))
+ ;; XEmacs
+ (void-function '(interactive-p)))))
+
+;;;###autoload
+(define-derived-mode plstore-mode emacs-lisp-mode "PLSTORE"
+ "Major mode for editing PLSTORE files."
+ (make-local-variable 'plstore-encoded)
+ (add-hook 'write-contents-functions #'plstore--write-contents-functions)
+ (define-key plstore-mode-map "\C-c\C-c" #'plstore-mode-toggle-display)
+ ;; to create a new file with plstore-mode, mark it as already decoded
+ (if (plstore-called-interactively-p 'any)
+ (setq plstore-encoded t)
+ (plstore-mode-decoded)))
+
(provide 'plstore)
;;; plstore.el ends here
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index 0f7a450b30c..801ed66ec2b 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -1,6 +1,6 @@
;;; pop3.el --- Post Office Protocol (RFC 1460) interface
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
;; Maintainer: FSF
@@ -98,20 +98,53 @@ set this to 1."
:group 'pop3)
(defcustom pop3-leave-mail-on-server nil
- "*Non-nil if the mail is to be left on the POP server after fetching.
-
-If `pop3-leave-mail-on-server' is non-nil the mail is to be left
-on the POP server after fetching. Note that POP servers maintain
-no state information between sessions, so what the client
-believes is there and what is actually there may not match up.
-If they do not, then you may get duplicate mails or the whole
-thing can fall apart and leave you with a corrupt mailbox."
- ;; We can't use the UILD support from XEmacs mail-lib or cvs.m17n.org:
- ;; http://thread.gmane.org/v9lld8fml4.fsf@marauder.physik.uni-ulm.de
- ;; http://thread.gmane.org/b9yy8hzy9ej.fsf@jpl.org
- ;; Any volunteer to re-implement this?
- :version "22.1" ;; Oort Gnus
- :type 'boolean
+ "Non-nil if the mail is to be left on the POP server after fetching.
+Mails once fetched will never be fetched again by the UIDL control.
+
+If this is neither nil nor a number, all mails will be left on the
+server. If this is a number, leave mails on the server for this many
+days since you first checked new mails. If this is nil, mails will be
+deleted on the server right after fetching.
+
+Gnus users should use the `:leave' keyword in a mail source to direct
+the behaviour per server, rather than directly modifying this value.
+
+Note that POP servers maintain no state information between sessions,
+so what the client believes is there and what is actually there may
+not match up. If they do not, then you may get duplicate mails or
+the whole thing can fall apart and leave you with a corrupt mailbox."
+ :version "24.4"
+ :type '(choice (const :tag "Don't leave mails" nil)
+ (const :tag "Leave all mails" t)
+ (number :tag "Leave mails for this many days" :value 14))
+ :group 'pop3)
+
+(defcustom pop3-uidl-file "~/.pop3-uidl"
+ "File used to save UIDL."
+ :version "24.4"
+ :type 'file
+ :group 'pop3)
+
+(defcustom pop3-uidl-file-backup '(0 9)
+ "How to backup the UIDL file `pop3-uidl-file' when updating.
+If it is a list of numbers, the first one binds `kept-old-versions' and
+the other binds `kept-new-versions' to keep number of oldest and newest
+versions. Otherwise, the value binds `version-control' (which see).
+
+Note: Backup will take place whenever you check new mails on a server.
+So, you may lose the backup files having been saved before a trouble
+if you set it so as to make too few backups whereas you have access to
+many servers."
+ :version "24.4"
+ :type '(choice (group :tag "Keep versions" :format "\n%v" :indent 3
+ (number :tag "oldest")
+ (number :tag "newest"))
+ (sexp :format "%v"
+ :match (lambda (widget value)
+ (condition-case nil
+ (not (and (numberp (car value))
+ (numberp (car (cdr value)))))
+ (error t)))))
:group 'pop3)
(defvar pop3-timestamp nil
@@ -144,34 +177,66 @@ Shorter values mean quicker response, but are more CPU intensive.")
(truncate pop3-read-timeout))
1000))))))
+(defvar pop3-uidl)
+;; List of UIDLs of existing messages at present in the server:
+;; ("UIDL1" "UIDL2" "UIDL3"...)
+
+(defvar pop3-uidl-saved)
+;; Locally saved UIDL data; an alist of the server, the user, and the UIDL
+;; and timestamp pairs:
+;; (("SERVER_A" ("USER_A1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;; ("USER_A2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;; ...)
+;; ("SERVER_B" ("USER_B1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;; ("USER_B2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;; ...))
+;; Where TIMESTAMP is the most significant two digits of an Emacs time,
+;; i.e. the return value of `current-time'.
+
;;;###autoload
(defun pop3-movemail (file)
"Transfer contents of a maildrop to the specified FILE.
Use streaming commands."
- (let* ((process (pop3-open-server pop3-mailhost pop3-port))
- message-count message-total-size)
+ (let ((process (pop3-open-server pop3-mailhost pop3-port))
+ messages total-size
+ pop3-uidl
+ pop3-uidl-saved)
(pop3-logon process)
- (with-current-buffer (process-buffer process)
+ (if pop3-leave-mail-on-server
+ (setq messages (pop3-uidl-stat process)
+ total-size (cadr messages)
+ messages (car messages))
(let ((size (pop3-stat process)))
- (setq message-count (car size)
- message-total-size (cadr size)))
- (when (> message-count 0)
- (pop3-send-streaming-command
- process "RETR" message-count message-total-size)
- (pop3-write-to-file file)
+ (dotimes (i (car size)) (push (1+ i) messages))
+ (setq messages (nreverse messages)
+ total-size (cadr size))))
+ (when messages
+ (with-current-buffer (process-buffer process)
+ (pop3-send-streaming-command process "RETR" messages total-size)
+ (pop3-write-to-file file messages)
(unless pop3-leave-mail-on-server
- (pop3-send-streaming-command
- process "DELE" message-count nil))))
- (pop3-quit process)
+ (pop3-send-streaming-command process "DELE" messages nil))))
+ (if pop3-leave-mail-on-server
+ (when (prog1 (pop3-uidl-dele process) (pop3-quit process))
+ (pop3-uidl-save))
+ (pop3-quit process)
+ ;; Remove UIDL data for the account that got not to leave mails.
+ (setq pop3-uidl-saved (pop3-uidl-load))
+ (let ((elt (assoc pop3-maildrop
+ (cdr (assoc pop3-mailhost pop3-uidl-saved)))))
+ (when elt
+ (setcdr elt nil)
+ (pop3-uidl-save))))
t))
-(defun pop3-send-streaming-command (process command count total-size)
+(defun pop3-send-streaming-command (process command messages total-size)
(erase-buffer)
- (let ((i 1)
+ (let ((count (length messages))
+ (i 1)
(start-point (point-min))
(waited-for 0))
- (while (>= count i)
- (process-send-string process (format "%s %d\r\n" command i))
+ (while messages
+ (process-send-string process (format "%s %d\r\n" command (pop messages)))
;; Only do 100 messages at a time to avoid pipe stalls.
(when (zerop (% i pop3-stream-length))
(setq start-point
@@ -194,14 +259,20 @@ Use streaming commands."
(unless (memq (process-status process) '(open run))
(error "pop3 process died"))
(when total-size
- (message "pop3 retrieved %dKB (%d%%)"
- (truncate (/ (buffer-size) 1000))
- (truncate (* (/ (* (buffer-size) 1.0)
- total-size) 100))))
+ (let ((size 0))
+ (goto-char (point-min))
+ (while (re-search-forward "^\\+OK.*\n" nil t)
+ (setq size (+ size (- (point))
+ (if (re-search-forward "^\\.\r?\n" nil 'move)
+ (match-beginning 0)
+ (point)))))
+ (message "pop3 retrieved %dKB (%d%%)"
+ (truncate (/ size 1000))
+ (truncate (* (/ (* size 1.0) total-size) 100)))))
(pop3-accept-process-output process))
start-point)
-(defun pop3-write-to-file (file)
+(defun pop3-write-to-file (file messages)
(let ((pop-buffer (current-buffer))
(start (point-min))
beg end
@@ -224,6 +295,8 @@ Use streaming commands."
(pop3-clean-region hstart (point))
(goto-char (point-max))
(pop3-munge-message-separator hstart (point))
+ (when pop3-leave-mail-on-server
+ (pop3-uidl-add-xheader hstart (pop messages)))
(goto-char (point-max))))))
(let ((coding-system-for-write 'binary))
(goto-char (point-min))
@@ -269,6 +342,184 @@ Use streaming commands."
(pop3-quit process)
message-count))
+(defun pop3-uidl-stat (process)
+ "Return a list of unread message numbers and total size."
+ (pop3-send-command process "UIDL")
+ (let (err messages size)
+ (if (condition-case code
+ (progn
+ (pop3-read-response process)
+ t)
+ (error (setq err (error-message-string code))
+ nil))
+ (let ((start pop3-read-point)
+ saved list)
+ (with-current-buffer (process-buffer process)
+ (while (not (re-search-forward "^\\.\r\n" nil t))
+ (unless (memq (process-status process) '(open run))
+ (error "pop3 server closed the connection"))
+ (pop3-accept-process-output process)
+ (goto-char start))
+ (setq pop3-read-point (point-marker)
+ pop3-uidl nil)
+ (while (progn (forward-line -1) (>= (point) start))
+ (when (looking-at "[0-9]+ \\([^\n\r ]+\\)")
+ (push (match-string 1) pop3-uidl)))
+ (when pop3-uidl
+ (setq pop3-uidl-saved (pop3-uidl-load)
+ saved (cdr (assoc pop3-maildrop
+ (cdr (assoc pop3-mailhost
+ pop3-uidl-saved)))))
+ (let ((i (length pop3-uidl)))
+ (while (> i 0)
+ (unless (member (nth (1- i) pop3-uidl) saved)
+ (push i messages))
+ (decf i)))
+ (when messages
+ (setq list (pop3-list process)
+ size 0)
+ (dolist (msg messages)
+ (setq size (+ size (cdr (assq msg list)))))
+ (list messages size)))))
+ (message "%s doesn't support UIDL (%s), so we try a regressive way..."
+ pop3-mailhost err)
+ (sit-for 1)
+ (setq size (pop3-stat process))
+ (dotimes (i (car size)) (push (1+ i) messages))
+ (setcar size (nreverse messages))
+ size)))
+
+(defun pop3-uidl-dele (process)
+ "Delete messages according to `pop3-leave-mail-on-server'.
+Return non-nil if it is necessary to update the local UIDL file."
+ (let* ((ctime (current-time))
+ (srvr (assoc pop3-mailhost pop3-uidl-saved))
+ (saved (assoc pop3-maildrop (cdr srvr)))
+ i uidl mod new tstamp dele)
+ (setcdr (cdr ctime) nil)
+ ;; Add new messages to the data to be saved.
+ (cond ((and pop3-uidl saved)
+ (setq i (1- (length pop3-uidl)))
+ (while (>= i 0)
+ (unless (member (setq uidl (nth i pop3-uidl)) (cdr saved))
+ (push ctime new)
+ (push uidl new))
+ (decf i)))
+ (pop3-uidl
+ (setq new (apply 'nconc (mapcar (lambda (elt) (list elt ctime))
+ pop3-uidl)))))
+ (when new (setq mod t))
+ ;; List expirable messages and delete them from the data to be saved.
+ (setq ctime (when (numberp pop3-leave-mail-on-server)
+ (/ (+ (* (car ctime) 65536.0) (cadr ctime)) 86400))
+ i (1- (length saved)))
+ (while (> i 0)
+ (if (member (setq uidl (nth (1- i) saved)) pop3-uidl)
+ (progn
+ (setq tstamp (nth i saved))
+ (if (and ctime
+ (> (- ctime (/ (+ (* (car tstamp) 65536.0) (cadr tstamp))
+ 86400))
+ pop3-leave-mail-on-server))
+ ;; Mails to delete.
+ (progn
+ (setq mod t)
+ (push uidl dele))
+ ;; Mails to keep.
+ (push tstamp new)
+ (push uidl new)))
+ ;; Mails having been deleted in the server.
+ (setq mod t))
+ (decf i 2))
+ (cond (saved
+ (setcdr saved new))
+ (srvr
+ (setcdr (last srvr) (list (cons pop3-maildrop new))))
+ (t
+ (add-to-list 'pop3-uidl-saved
+ (list pop3-mailhost (cons pop3-maildrop new))
+ t)))
+ ;; Actually delete the messages in the server.
+ (when dele
+ (setq uidl nil
+ i (length pop3-uidl))
+ (while (> i 0)
+ (when (member (nth (1- i) pop3-uidl) dele)
+ (push i uidl))
+ (decf i))
+ (when uidl
+ (pop3-send-streaming-command process "DELE" uidl nil)))
+ mod))
+
+(defun pop3-uidl-load ()
+ "Load saved UIDL."
+ (when (file-exists-p pop3-uidl-file)
+ (with-temp-buffer
+ (condition-case code
+ (progn
+ (insert-file-contents pop3-uidl-file)
+ (goto-char (point-min))
+ (read (current-buffer)))
+ (error
+ (message "Error while loading %s (%s)"
+ pop3-uidl-file (error-message-string code))
+ (sit-for 1)
+ nil)))))
+
+(defun pop3-uidl-save ()
+ "Save UIDL."
+ (with-temp-buffer
+ (if pop3-uidl-saved
+ (progn
+ (insert "(")
+ (dolist (srvr pop3-uidl-saved)
+ (when (cdr srvr)
+ (insert "(\"" (pop srvr) "\"\n ")
+ (dolist (elt srvr)
+ (when (cdr elt)
+ (insert "(\"" (pop elt) "\"\n ")
+ (while elt
+ (insert (format "\"%s\" %s\n " (pop elt) (pop elt))))
+ (delete-char -4)
+ (insert ")\n ")))
+ (delete-char -3)
+ (if (eq (char-before) ?\))
+ (insert ")\n ")
+ (goto-char (1+ (point-at-bol)))
+ (delete-region (point) (point-max)))))
+ (when (eq (char-before) ? )
+ (delete-char -2))
+ (insert ")\n"))
+ (insert "()\n"))
+ (let ((buffer-file-name pop3-uidl-file)
+ (delete-old-versions t)
+ (kept-new-versions kept-new-versions)
+ (kept-old-versions kept-old-versions)
+ (version-control version-control))
+ (if (consp pop3-uidl-file-backup)
+ (setq kept-new-versions (cadr pop3-uidl-file-backup)
+ kept-old-versions (car pop3-uidl-file-backup)
+ version-control t)
+ (setq version-control pop3-uidl-file-backup))
+ (save-buffer))))
+
+(defun pop3-uidl-add-xheader (start msgno)
+ "Add X-UIDL header."
+ (let ((case-fold-search t))
+ (save-restriction
+ (narrow-to-region start (progn
+ (goto-char start)
+ (search-forward "\n\n" nil 'move)
+ (1- (point))))
+ (goto-char start)
+ (while (re-search-forward "^x-uidl:" nil t)
+ (while (progn
+ (forward-line 1)
+ (memq (char-after) '(?\t ? ))))
+ (delete-region (match-beginning 0) (point)))
+ (goto-char (point-max))
+ (insert "X-UIDL: " (nth (1- msgno) pop3-uidl) "\n"))))
+
(defcustom pop3-stream-type nil
"*Transport security type for POP3 connections.
This may be either nil (plain connection), `ssl' (use an
@@ -657,6 +908,13 @@ and close the connection."
;; Possible responses:
;; +OK [all delete marks removed]
+;; UIDL [msg]
+;; Arguments: a message-id (optional)
+;; Restrictions: transaction state; msg must not be deleted
+;; Possible responses:
+;; +OK [uidl listing follows]
+;; -ERR [no such message]
+
;;; UPDATE STATE
;; QUIT
diff --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el
index 584e24177af..c4487c68b5c 100644
--- a/lisp/gnus/qp.el
+++ b/lisp/gnus/qp.el
@@ -1,6 +1,6 @@
;;; qp.el --- Quoted-Printable functions
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, extensions
@@ -65,12 +65,24 @@ them into characters should be done separately."
(not (eobp)))
(cond ((eq (char-after (1+ (point))) ?\n)
(delete-char 2))
- ((looking-at "=[0-9A-F][0-9A-F]")
- (let ((byte (string-to-number (buffer-substring (1+ (point))
- (+ 3 (point)))
- 16)))
- (mm-insert-byte byte 1)
- (delete-char 3)))
+ ((looking-at "\\(=[0-9A-F][0-9A-F]\\)+")
+ ;; Decode this sequence at once; i.e. by a single
+ ;; deletion and insertion.
+ (let* ((n (/ (- (match-end 0) (point)) 3))
+ (str (make-string n 0)))
+ (dotimes (i n)
+ (let ((n1 (char-after (1+ (point))))
+ (n2 (char-after (+ 2 (point)))))
+ (aset str i
+ (+ (* 16 (- n1 (if (<= n1 ?9) ?0
+ (if (<= n1 ?F) (- ?A 10)
+ (- ?a 10)))))
+ (- n2 (if (<= n2 ?9) ?0
+ (if (<= n2 ?F) (- ?A 10)
+ (- ?a 10)))))))
+ (forward-char 3))
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert str)))
(t
(message "Malformed quoted-printable text")
(forward-char)))))
diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el
index 5fd309a5c7d..7b1029a2690 100644
--- a/lisp/gnus/registry.el
+++ b/lisp/gnus/registry.el
@@ -1,6 +1,6 @@
;;; registry.el --- Track and remember data items by various fields
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: data
@@ -79,26 +79,8 @@
(eval-when-compile (require 'cl))
-(eval-when-compile
- (when (null (ignore-errors (require 'ert)))
- (defmacro* ert-deftest (name () &body docstring-keys-and-body))))
-
-(ignore-errors
- (require 'ert))
-(eval-and-compile
- (or (ignore-errors (progn
- (require 'eieio)
- (require 'eieio-base)))
- ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
- (ignore-errors
- (let ((load-path (cons (expand-file-name
- "gnus-fallback-lib/eieio"
- (file-name-directory (locate-library "gnus")))
- load-path)))
- (require 'eieio)
- (require 'eieio-base)))
- (error
- "eieio not found in `load-path' or gnus-fallback-lib/ directory.")))
+(require 'eieio)
+(require 'eieio-base)
(defclass registry-db (eieio-persistent)
((version :initarg :version
@@ -373,111 +355,5 @@ Proposes any entries over the max-hard limit minus size * prune-factor."
collect k)))
(list limit candidates))))
-(ert-deftest registry-instantiation-test ()
- (should (registry-db "Testing")))
-
-(ert-deftest registry-match-test ()
- (let ((entry '((hello "goodbye" "bye") (blank))))
-
- (message "Testing :regex matching")
- (should (registry--match :regex entry '((hello "nye" "bye"))))
- (should (registry--match :regex entry '((hello "good"))))
- (should-not (registry--match :regex entry '((hello "nye"))))
- (should-not (registry--match :regex entry '((hello))))
-
- (message "Testing :member matching")
- (should (registry--match :member entry '((hello "bye"))))
- (should (registry--match :member entry '((hello "goodbye"))))
- (should-not (registry--match :member entry '((hello "good"))))
- (should-not (registry--match :member entry '((hello "nye"))))
- (should-not (registry--match :member entry '((hello)))))
- (message "Done with matching testing."))
-
-(defun registry-make-testable-db (n &optional name file)
- (let* ((db (registry-db
- (or name "Testing")
- :file (or file "unused")
- :max-hard n
- :max-soft 0 ; keep nothing not precious
- :precious '(extra more-extra)
- :tracked '(sender subject groups))))
- (dotimes (i n)
- (registry-insert db i `((sender "me")
- (subject "about you")
- (more-extra) ; empty data key should be pruned
- ;; first 5 entries will NOT have this extra data
- ,@(when (< 5 i) (list (list 'extra "more data")))
- (groups ,(number-to-string i)))))
- db))
-
-(ert-deftest registry-usage-test ()
- (let* ((n 100)
- (db (registry-make-testable-db n)))
- (message "size %d" n)
- (should (= n (registry-size db)))
- (message "max-hard test")
- (should-error (registry-insert db "new" '()))
- (message "Individual lookup")
- (should (= 58 (caadr (registry-lookup db '(1 58 99)))))
- (message "Grouped individual lookup")
- (should (= 3 (length (registry-lookup db '(1 58 99)))))
- (when (boundp 'lexical-binding)
- (message "Individual lookup (breaks before lexbind)")
- (should (= 58
- (caadr (registry-lookup-breaks-before-lexbind db '(1 58 99)))))
- (message "Grouped individual lookup (breaks before lexbind)")
- (should (= 3
- (length (registry-lookup-breaks-before-lexbind db
- '(1 58 99))))))
- (message "Search")
- (should (= n (length (registry-search db :all t))))
- (should (= n (length (registry-search db :member '((sender "me"))))))
- (message "Secondary index search")
- (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
- (should (equal '(74) (registry-lookup-secondary-value db 'groups "74")))
- (message "Delete")
- (should (registry-delete db '(1) t))
- (decf n)
- (message "Search after delete")
- (should (= n (length (registry-search db :all t))))
- (message "Secondary search after delete")
- (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
- ;; (message "Pruning")
- ;; (let* ((tokeep (registry-search db :member '((extra "more data"))))
- ;; (count (- n (length tokeep)))
- ;; (pruned (registry-prune db))
- ;; (prune-count (length pruned)))
- ;; (message "Expecting to prune %d entries and pruned %d"
- ;; count prune-count)
- ;; (should (and (= count 5)
- ;; (= count prune-count))))
- (message "Done with usage testing.")))
-
-(ert-deftest registry-persistence-test ()
- (let* ((n 100)
- (tempfile (make-temp-file "registry-persistence-"))
- (name "persistence tester")
- (db (registry-make-testable-db n name tempfile))
- size back)
- (message "Saving to %s" tempfile)
- (eieio-persistent-save db)
- (setq size (nth 7 (file-attributes tempfile)))
- (message "Saved to %s: size %d" tempfile size)
- (should (< 0 size))
- (with-temp-buffer
- (insert-file-contents-literally tempfile)
- (should (looking-at (concat ";; Object "
- name
- "\n;; EIEIO PERSISTENT OBJECT"))))
- (message "Reading object back")
- (setq back (eieio-persistent-read tempfile))
- (should back)
- (message "Read object back: %d keys, expected %d==%d"
- (registry-size back) n (registry-size db))
- (should (= (registry-size back) n))
- (should (= (registry-size back) (registry-size db)))
- (delete-file tempfile))
- (message "Done with persistence testing."))
-
(provide 'registry)
;;; registry.el ends here
diff --git a/lisp/gnus/rfc1843.el b/lisp/gnus/rfc1843.el
index 019dc6ed8a2..338a81949ea 100644
--- a/lisp/gnus/rfc1843.el
+++ b/lisp/gnus/rfc1843.el
@@ -1,6 +1,6 @@
;;; rfc1843.el --- HZ (rfc1843) decoding
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: news HZ HZ+ mail i18n
diff --git a/lisp/gnus/rfc2045.el b/lisp/gnus/rfc2045.el
index d9aaf88b046..783189c6503 100644
--- a/lisp/gnus/rfc2045.el
+++ b/lisp/gnus/rfc2045.el
@@ -1,6 +1,6 @@
;;; rfc2045.el --- Functions for decoding rfc2045 headers
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el
index f1cb1f69e56..e881256f386 100644
--- a/lisp/gnus/rfc2047.el
+++ b/lisp/gnus/rfc2047.el
@@ -1,6 +1,6 @@
;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -362,7 +362,7 @@ The buffer may be narrowed."
(modify-syntax-entry ?@ "." table)
table))
-(defun rfc2047-encode-region (b e)
+(defun rfc2047-encode-region (b e &optional dont-fold)
"Encode words in region B to E that need encoding.
By default, the region is treated as containing RFC2822 addresses.
Dynamically bind `rfc2047-encoding-type' to change that."
@@ -546,16 +546,17 @@ Dynamically bind `rfc2047-encoding-type' to change that."
(signal (car err) (cdr err))
(error "Invalid data for rfc2047 encoding: %s"
(mm-replace-in-string orig-text "[ \t\n]+" " "))))))))
- (rfc2047-fold-region b (point))
+ (unless dont-fold
+ (rfc2047-fold-region b (point)))
(goto-char (point-max))))
-(defun rfc2047-encode-string (string)
+(defun rfc2047-encode-string (string &optional dont-fold)
"Encode words in STRING.
By default, the string is treated as containing addresses (see
`rfc2047-encoding-type')."
(mm-with-multibyte-buffer
(insert string)
- (rfc2047-encode-region (point-min) (point-max))
+ (rfc2047-encode-region (point-min) (point-max) dont-fold)
(buffer-string)))
;; From RFC 2047:
@@ -850,7 +851,7 @@ This is a substitution for the `rfc2231-encode-string' function, that
is the standard but many mailers don't support it."
(let ((rfc2047-encoding-type 'mime)
(rfc2047-encode-max-chars nil))
- (rfc2045-encode-string param (rfc2047-encode-string value))))
+ (rfc2045-encode-string param (rfc2047-encode-string value t))))
;;;
;;; Functions for decoding RFC2047 messages
diff --git a/lisp/gnus/rfc2104.el b/lisp/gnus/rfc2104.el
index 158cf4bae22..b638da0eb84 100644
--- a/lisp/gnus/rfc2104.el
+++ b/lisp/gnus/rfc2104.el
@@ -1,6 +1,6 @@
;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Keywords: mail
diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el
index 9c30379ef6e..48aa89c9757 100644
--- a/lisp/gnus/rfc2231.el
+++ b/lisp/gnus/rfc2231.el
@@ -1,6 +1,6 @@
;;; rfc2231.el --- Functions for decoding rfc2231 headers
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/rtree.el b/lisp/gnus/rtree.el
index 869ca4f0069..4894e6da92c 100644
--- a/lisp/gnus/rtree.el
+++ b/lisp/gnus/rtree.el
@@ -1,6 +1,6 @@
;;; rtree.el --- functions for manipulating range trees
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el
index a7ed6bc0cb8..6035abb38e0 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -1,6 +1,6 @@
;;; score-mode.el --- mode for editing Gnus score files
-;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
diff --git a/lisp/gnus/shr-color.el b/lisp/gnus/shr-color.el
index 4fd35659e08..7011034d242 100644
--- a/lisp/gnus/shr-color.el
+++ b/lisp/gnus/shr-color.el
@@ -1,6 +1,6 @@
;;; shr-color.el --- Simple HTML Renderer color management
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: html
@@ -267,7 +267,8 @@ Like rgb() or hsl()."
(t
nil))))
-(defun set-minimum-interval (val1 val2 min max interval &optional fixed)
+(defun shr-color-set-minimum-interval (val1 val2 min max interval
+ &optional fixed)
"Set minimum interval between VAL1 and VAL2 to INTERVAL.
The values are bound by MIN and MAX.
If FIXED is t, then VAL1 will not be touched."
@@ -341,9 +342,9 @@ color will be adapted to be visible on BG."
(>= luminance-distance shr-color-visible-luminance-min))
(list bg fg)
;; Not visible, try to change luminance to make them visible
- (let ((Ls (set-minimum-interval (car bg-lab) (car fg-lab) 0 100
- shr-color-visible-luminance-min
- fixed-background)))
+ (let ((Ls (shr-color-set-minimum-interval
+ (car bg-lab) (car fg-lab) 0 100
+ shr-color-visible-luminance-min fixed-background)))
(unless fixed-background
(setcar bg-lab (car Ls)))
(setcar fg-lab (cadr Ls))
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index f2d8f843564..03704554459 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -1,6 +1,6 @@
;;; shr.el --- Simple HTML Renderer
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: html
@@ -35,6 +35,7 @@
(defgroup shr nil
"Simple HTML Renderer"
+ :version "24.1"
:group 'mail)
(defcustom shr-max-image-proportion 0.9
@@ -118,6 +119,7 @@ cid: URL as the argument.")
(let ((map (make-sparse-keymap)))
(define-key map "a" 'shr-show-alt-text)
(define-key map "i" 'shr-browse-image)
+ (define-key map "z" 'shr-zoom-image)
(define-key map "I" 'shr-insert-image)
(define-key map "u" 'shr-copy-url)
(define-key map "v" 'shr-browse-url)
@@ -127,23 +129,49 @@ cid: URL as the argument.")
;; Public functions and commands.
-(defun shr-visit-file (file)
- (interactive "fHTML file name: ")
+(defun shr-render-buffer (buffer)
+ "Display the HTML rendering of the current buffer."
+ (interactive (list (current-buffer)))
(pop-to-buffer "*html*")
(erase-buffer)
(shr-insert-document
- (with-temp-buffer
- (insert-file-contents file)
- (libxml-parse-html-region (point-min) (point-max)))))
+ (with-current-buffer buffer
+ (libxml-parse-html-region (point-min) (point-max))))
+ (goto-char (point-min)))
+
+(defun shr-visit-file (file)
+ "Parse FILE as an HTML document, and render it in a new buffer."
+ (interactive "fHTML file name: ")
+ (with-temp-buffer
+ (insert-file-contents file)
+ (shr-render-buffer (current-buffer))))
;;;###autoload
(defun shr-insert-document (dom)
+ "Render the parsed document DOM into the current buffer.
+DOM should be a parse tree as generated by
+`libxml-parse-html-region' or similar."
(setq shr-content-cache nil)
- (let ((shr-state nil)
+ (let ((start (point))
+ (shr-state nil)
(shr-start nil)
(shr-base nil)
(shr-width (or shr-width (window-width))))
- (shr-descend (shr-transform-dom dom))))
+ (shr-descend (shr-transform-dom dom))
+ (shr-remove-trailing-whitespace start (point))))
+
+(defun shr-remove-trailing-whitespace (start end)
+ (let ((width (window-width)))
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (while (not (eobp))
+ (end-of-line)
+ (when (> (shr-previous-newline-padding-width (current-column)) width)
+ (dolist (overlay (overlays-at (point)))
+ (when (overlay-get overlay 'before-string)
+ (overlay-put overlay 'before-string nil))))
+ (forward-line 1)))))
(defun shr-copy-url ()
"Copy the URL under point to the kill ring.
@@ -168,7 +196,8 @@ redirects somewhere else."
(when (re-search-forward ".utm_.*" nil t)
(replace-match "" t t))
(message "Copied %s" (buffer-string))
- (copy-region-as-kill (point-min) (point-max)))))))
+ (copy-region-as-kill (point-min) (point-max)))))
+ nil t))
;; Copy the URL to the kill ring.
(t
(with-temp-buffer
@@ -211,6 +240,40 @@ the URL of the image to the kill buffer instead."
(message "Inserting %s..." url)
(url-retrieve url 'shr-image-fetched
(list (current-buffer) (1- (point)) (point-marker))
+ t t))))
+
+(defun shr-zoom-image ()
+ "Toggle the image size.
+The size will be rotated between the default size, the original
+size, and full-buffer size."
+ (interactive)
+ (let ((url (get-text-property (point) 'image-url))
+ (size (get-text-property (point) 'image-size))
+ (buffer-read-only nil))
+ (if (not url)
+ (message "No image under point")
+ ;; Delete the old picture.
+ (while (get-text-property (point) 'image-url)
+ (forward-char -1))
+ (forward-char 1)
+ (let ((start (point)))
+ (while (get-text-property (point) 'image-url)
+ (forward-char 1))
+ (forward-char -1)
+ (put-text-property start (point) 'display nil)
+ (when (> (- (point) start) 2)
+ (delete-region start (1- (point)))))
+ (message "Inserting %s..." url)
+ (url-retrieve url 'shr-image-fetched
+ (list (current-buffer) (1- (point)) (point-marker)
+ (list (cons 'size
+ (cond ((or (eq size 'default)
+ (null size))
+ 'original)
+ ((eq size 'original)
+ 'full)
+ ((eq size 'full)
+ 'default)))))
t))))
;;; Utility functions.
@@ -276,6 +339,7 @@ the URL of the image to the kill buffer instead."
(defun shr-insert (text)
(when (and (eq shr-state 'image)
+ (not (bolp))
(not (string-match "\\`[ \t\n]+\\'" text)))
(insert "\n")
(setq shr-state nil))
@@ -283,11 +347,11 @@ the URL of the image to the kill buffer instead."
((eq shr-folding-mode 'none)
(insert text))
(t
- (when (and (string-match "\\`[ \t\n]" text)
+ (when (and (string-match "\\`[ \t\n]" text)
(not (bolp))
(not (eq (char-after (1- (point))) ? )))
(insert " "))
- (dolist (elem (split-string text))
+ (dolist (elem (split-string text "[ \f\t\n\r\v]+" t))
(when (and (bolp)
(> shr-indentation 0))
(shr-indent))
@@ -310,6 +374,7 @@ the URL of the image to the kill buffer instead."
(unless shr-start
(setq shr-start (point)))
(insert elem)
+ (setq shr-state nil)
(let (found)
(while (and (> (current-column) shr-width)
(progn
@@ -319,7 +384,6 @@ the URL of the image to the kill buffer instead."
(delete-char -1))
(insert "\n")
(unless found
- (put-text-property (1- (point)) (point) 'shr-break t)
;; No space is needed at the beginning of a line.
(when (eq (following-char) ? )
(delete-char 1)))
@@ -327,7 +391,7 @@ the URL of the image to the kill buffer instead."
(shr-indent))
(end-of-line))
(insert " ")))
- (unless (string-match "[ \t\n]\\'" text)
+ (unless (string-match "[ \t\r\n]\\'" text)
(delete-char -1)))))
(defun shr-find-fill-point ()
@@ -386,32 +450,29 @@ the URL of the image to the kill buffer instead."
(shr-char-kinsoku-eol-p (following-char)))))
(goto-char bp)))
((shr-char-kinsoku-eol-p (preceding-char))
- (if (shr-char-kinsoku-eol-p (following-char))
- ;; There are consecutive kinsoku-eol characters.
- (setq failed t)
- (let ((count 4))
- (while
- (progn
- (backward-char 1)
- (and (> (setq count (1- count)) 0)
- (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
- (or (shr-char-kinsoku-eol-p (preceding-char))
- (shr-char-kinsoku-bol-p (following-char)))))))
- (if (setq failed (= (current-column) shr-indentation))
- ;; There's no breakable point that doesn't violate kinsoku,
- ;; so we go to the second best position.
- (if (looking-at "\\(\\c<+\\)\\c<")
- (goto-char (match-end 1))
- (forward-char 1)))))
- (t
- (if (shr-char-kinsoku-bol-p (preceding-char))
- ;; There are consecutive kinsoku-bol characters.
- (setq failed t)
- (let ((count 4))
- (while (and (>= (setq count (1- count)) 0)
+ ;; Find backward the point where kinsoku-eol characters begin.
+ (let ((count 4))
+ (while
+ (progn
+ (backward-char 1)
+ (and (> (setq count (1- count)) 0)
+ (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
+ (or (shr-char-kinsoku-eol-p (preceding-char))
+ (shr-char-kinsoku-bol-p (following-char)))))))
+ (if (setq failed (= (current-column) shr-indentation))
+ ;; There's no breakable point that doesn't violate kinsoku,
+ ;; so we go to the second best position.
+ (if (looking-at "\\(\\c<+\\)\\c<")
+ (goto-char (match-end 1))
+ (forward-char 1))))
+ ((shr-char-kinsoku-bol-p (following-char))
+ ;; Find forward the point where kinsoku-bol characters end.
+ (let ((count 4))
+ (while (progn
+ (forward-char 1)
+ (and (>= (setq count (1- count)) 0)
(shr-char-kinsoku-bol-p (following-char))
- (shr-char-breakable-p (following-char)))
- (forward-char 1))))))
+ (shr-char-breakable-p (following-char))))))))
(when (eq (following-char) ? )
(forward-char 1))))
(not failed)))
@@ -423,6 +484,9 @@ the URL of the image to the kill buffer instead."
(string-match "\\`[a-z]*:" url)
(not shr-base))
url)
+ ((and (string-match "\\`//" url)
+ (string-match "\\`[a-z]*:" shr-base))
+ (concat (match-string 0 shr-base) url))
((and (not (string-match "/\\'" shr-base))
(not (string-match "\\`/" url)))
(concat shr-base "/" url))
@@ -443,7 +507,7 @@ the URL of the image to the kill buffer instead."
(if (save-excursion
(beginning-of-line)
(looking-at " *$"))
- (insert "\n")
+ (delete-region (match-beginning 0) (match-end 0))
(insert "\n\n")))))
(defun shr-indent ()
@@ -479,7 +543,7 @@ the URL of the image to the kill buffer instead."
((not url)
(message "No link under point"))
((string-match "^mailto:" url)
- (browse-url-mailto url))
+ (browse-url-mail url))
(t
(browse-url url)))))
@@ -490,7 +554,8 @@ the URL of the image to the kill buffer instead."
(if (not url)
(message "No link under point")
(url-retrieve (shr-encode-url url)
- 'shr-store-contents (list url directory)))))
+ 'shr-store-contents (list url directory)
+ nil t))))
(defun shr-store-contents (status url directory)
(unless (plist-get status :error)
@@ -500,72 +565,97 @@ the URL of the image to the kill buffer instead."
(expand-file-name (file-name-nondirectory url)
directory)))))
-(defun shr-image-fetched (status buffer start end)
- (when (and (buffer-name buffer)
- (not (plist-get status :error)))
- (url-store-in-cache (current-buffer))
- (when (or (search-forward "\n\n" nil t)
- (search-forward "\r\n\r\n" nil t))
- (let ((data (buffer-substring (point) (point-max))))
- (with-current-buffer buffer
- (save-excursion
- (let ((alt (buffer-substring start end))
- (inhibit-read-only t))
- (delete-region start end)
- (goto-char start)
- (funcall shr-put-image-function data alt)))))))
- (kill-buffer (current-buffer)))
-
-(defun shr-put-image (data alt)
+(defun shr-image-fetched (status buffer start end &optional flags)
+ (let ((image-buffer (current-buffer)))
+ (when (and (buffer-name buffer)
+ (not (plist-get status :error)))
+ (url-store-in-cache image-buffer)
+ (when (or (search-forward "\n\n" nil t)
+ (search-forward "\r\n\r\n" nil t))
+ (let ((data (buffer-substring (point) (point-max))))
+ (with-current-buffer buffer
+ (save-excursion
+ (let ((alt (buffer-substring start end))
+ (properties (text-properties-at start))
+ (inhibit-read-only t))
+ (delete-region start end)
+ (goto-char start)
+ (funcall shr-put-image-function data alt flags)
+ (while properties
+ (let ((type (pop properties))
+ (value (pop properties)))
+ (unless (memq type '(display image-size))
+ (put-text-property start (point) type value))))))))))
+ (kill-buffer image-buffer)))
+
+(defun shr-put-image (data alt &optional flags)
"Put image DATA with a string ALT. Return image."
(if (display-graphic-p)
- (let ((image (ignore-errors
- (shr-rescale-image data))))
+ (let* ((size (cdr (assq 'size flags)))
+ (start (point))
+ (image (cond
+ ((eq size 'original)
+ (create-image data nil t :ascent 100))
+ ((eq size 'full)
+ (ignore-errors
+ (shr-rescale-image data t)))
+ (t
+ (ignore-errors
+ (shr-rescale-image data))))))
(when image
;; When inserting big-ish pictures, put them at the
;; beginning of the line.
(when (and (> (current-column) 0)
(> (car (image-size image t)) 400))
(insert "\n"))
- (insert-image image (or alt "*"))
+ (if (eq size 'original)
+ (let ((overlays (overlays-at (point))))
+ (insert-sliced-image image (or alt "*") nil 20 1)
+ (dolist (overlay overlays)
+ (overlay-put overlay 'face 'default)))
+ (insert-image image (or alt "*")))
+ (put-text-property start (point) 'image-size size)
(when (image-animated-p image)
(image-animate image nil 60)))
image)
(insert alt)))
-(defun shr-rescale-image (data)
- (if (or (not (fboundp 'imagemagick-types))
- (not (get-buffer-window (current-buffer))))
- (create-image data nil t
- :ascent 100)
- (let* ((image (create-image data nil t :ascent 100))
- (size (image-size image t))
- (width (car size))
- (height (cdr size))
- (edges (window-inside-pixel-edges
- (get-buffer-window (current-buffer))))
- (window-width (truncate (* shr-max-image-proportion
- (- (nth 2 edges) (nth 0 edges)))))
- (window-height (truncate (* shr-max-image-proportion
- (- (nth 3 edges) (nth 1 edges)))))
- scaled-image)
- (when (> height window-height)
- (setq image (or (create-image data 'imagemagick t
- :height window-height)
- image))
- (setq size (image-size image t)))
- (when (> (car size) window-width)
- (setq image (or
- (create-image data 'imagemagick t
- :width window-width
- :ascent 100)
- image)))
- image)))
+(defun shr-rescale-image (data &optional force)
+ "Rescale DATA, if too big, to fit the current buffer.
+If FORCE, rescale the image anyway."
+ (let ((image (create-image data nil t :ascent 100)))
+ (if (or (not (fboundp 'imagemagick-types))
+ (not (get-buffer-window (current-buffer))))
+ image
+ (let* ((size (image-size image t))
+ (width (car size))
+ (height (cdr size))
+ (edges (window-inside-pixel-edges
+ (get-buffer-window (current-buffer))))
+ (window-width (truncate (* shr-max-image-proportion
+ (- (nth 2 edges) (nth 0 edges)))))
+ (window-height (truncate (* shr-max-image-proportion
+ (- (nth 3 edges) (nth 1 edges)))))
+ scaled-image)
+ (when (or force
+ (> height window-height))
+ (setq image (or (create-image data 'imagemagick t
+ :height window-height
+ :ascent 100)
+ image))
+ (setq size (image-size image t)))
+ (when (> (car size) window-width)
+ (setq image (or
+ (create-image data 'imagemagick t
+ :width window-width
+ :ascent 100)
+ image)))
+ image))))
;; url-cache-extract autoloads url-cache.
(declare-function url-cache-create-filename "url-cache" (url))
(autoload 'mm-disable-multibyte "mm-util")
-(autoload 'browse-url-mailto "browse-url")
+(autoload 'browse-url-mail "browse-url")
(defun shr-get-image-data (url)
"Get image data for URL.
@@ -597,7 +687,7 @@ START, and END. Note that START and END should be markers."
(delete-region (point) end))))
(url-retrieve url 'shr-image-fetched
(list (current-buffer) start end)
- t)))))
+ t t)))))
(defun shr-heading (cont &rest types)
(shr-ensure-paragraph)
@@ -687,7 +777,7 @@ ones, in case fg and bg are nil."
(forward-line 1)
(setq end (point))
(narrow-to-region start end)
- (let ((width (shr-natural-width))
+ (let ((width (shr-buffer-width))
column)
(goto-char (point-min))
(while (not (eobp))
@@ -907,13 +997,10 @@ ones, in case fg and bg are nil."
(let ((file (url-cache-create-filename (shr-encode-url url))))
(when (file-exists-p file)
(delete-file file))))
- (funcall
- (if (fboundp 'url-queue-retrieve)
- 'url-queue-retrieve
- 'url-retrieve)
+ (url-queue-retrieve
(shr-encode-url url) 'shr-image-fetched
(list (current-buffer) start (set-marker (make-marker) (1- (point))))
- t)))
+ t t)))
(when (zerop shr-table-depth) ;; We are not in a table.
(put-text-property start (point) 'keymap shr-map)
(put-text-property start (point) 'shr-alt alt)
@@ -963,7 +1050,12 @@ ones, in case fg and bg are nil."
(shr-generic cont)))
(defun shr-tag-br (cont)
- (unless (bobp)
+ (when (and (not (bobp))
+ ;; Only add a newline if we break the current line, or
+ ;; the previous line isn't a blank line.
+ (or (not (bolp))
+ (and (> (- (point) 2) (point-min))
+ (not (= (char-after (- (point) 2)) ?\n)))))
(insert "\n")
(shr-indent))
(shr-generic cont))
@@ -1027,7 +1119,10 @@ ones, in case fg and bg are nil."
;; be smaller (if there's little text) or bigger (if there's
;; unbreakable text).
(sketch (shr-make-table cont suggested-widths))
- (sketch-widths (shr-table-widths sketch suggested-widths)))
+ ;; Compute the "natural" width by setting each column to 500
+ ;; characters and see how wide they really render.
+ (natural (shr-make-table cont (make-vector (length columns) 500)))
+ (sketch-widths (shr-table-widths sketch natural suggested-widths)))
;; This probably won't work very well.
(when (> (+ (loop for width across sketch-widths
summing (1+ width))
@@ -1165,31 +1260,35 @@ ones, in case fg and bg are nil."
shr-table-corner))
(insert "\n"))
-(defun shr-table-widths (table suggested-widths)
+(defun shr-table-widths (table natural-table suggested-widths)
(let* ((length (length suggested-widths))
(widths (make-vector length 0))
(natural-widths (make-vector length 0)))
(dolist (row table)
(let ((i 0))
(dolist (column row)
- (aset widths i (max (aref widths i)
- (car column)))
- (aset natural-widths i (max (aref natural-widths i)
- (cadr column)))
+ (aset widths i (max (aref widths i) column))
+ (setq i (1+ i)))))
+ (dolist (row natural-table)
+ (let ((i 0))
+ (dolist (column row)
+ (aset natural-widths i (max (aref natural-widths i) column))
(setq i (1+ i)))))
(let ((extra (- (apply '+ (append suggested-widths nil))
(apply '+ (append widths nil))))
(expanded-columns 0))
+ ;; We have extra, unused space, so divide this space amongst the
+ ;; columns.
(when (> extra 0)
+ ;; If the natural width is wider than the rendered width, we
+ ;; want to allow the column to expand.
(dotimes (i length)
- ;; If the natural width is wider than the rendered width, we
- ;; want to allow the column to expand.
(when (> (aref natural-widths i) (aref widths i))
(setq expanded-columns (1+ expanded-columns))))
(dotimes (i length)
(when (> (aref natural-widths i) (aref widths i))
(aset widths i (min
- (1+ (aref natural-widths i))
+ (aref natural-widths i)
(+ (/ extra expanded-columns)
(aref widths i))))))))
widths))
@@ -1244,10 +1343,13 @@ ones, in case fg and bg are nil."
(let ((shr-width width)
(shr-indentation 0))
(shr-descend (cons 'td cont)))
+ ;; Delete padding at the bottom of the TDs.
(delete-region
(point)
- (+ (point)
- (skip-chars-backward " \t\n")))
+ (progn
+ (skip-chars-backward " \t\n")
+ (end-of-line)
+ (point)))
(push (list (cons width cont) (buffer-string)
(shr-overlays-in-region (point-min) (point-max)))
shr-content-cache)))
@@ -1281,19 +1383,14 @@ ones, in case fg and bg are nil."
(split-string (buffer-string) "\n")
(shr-collect-overlays)
(car actual-colors))
- (list max
- (shr-natural-width)))))))
+ max)))))
-(defun shr-natural-width ()
+(defun shr-buffer-width ()
(goto-char (point-min))
- (let ((current 0)
- (max 0))
+ (let ((max 0))
(while (not (eobp))
(end-of-line)
- (setq current (+ current (current-column)))
- (unless (get-text-property (point) 'shr-break)
- (setq max (max max current)
- current 0))
+ (setq max (max max (current-column)))
(forward-line 1))
max))
@@ -1343,10 +1440,10 @@ ones, in case fg and bg are nil."
(when (memq (car column) '(td th))
(let ((width (cdr (assq :width (cdr column)))))
(when (and width
- (string-match "\\([0-9]+\\)%" width))
- (aset columns i
- (/ (string-to-number (match-string 1 width))
- 100.0))))
+ (string-match "\\([0-9]+\\)%" width)
+ (not (zerop (setq width (string-to-number
+ (match-string 1 width))))))
+ (aset columns i (/ width 100.0))))
(setq i (1+ i)))))))
columns))
@@ -1367,4 +1464,8 @@ ones, in case fg and bg are nil."
(provide 'shr)
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
;;; shr.el ends here
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el
index a0c1d4f108b..74bcbcc7899 100644
--- a/lisp/gnus/sieve-manage.el
+++ b/lisp/gnus/sieve-manage.el
@@ -1,6 +1,6 @@
;;; sieve-manage.el --- Implementation of the managesieve protocol in elisp
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
@@ -157,6 +157,7 @@ for doing the actual authentication."
(defcustom sieve-manage-default-stream 'network
"Default stream type to use for `sieve-manage'.
Must be a name of a stream in `sieve-manage-stream-alist'."
+ :version "24.1"
:type 'symbol
:group 'sieve-manage)
diff --git a/lisp/gnus/sieve-mode.el b/lisp/gnus/sieve-mode.el
index efd28affacb..f49f767d791 100644
--- a/lisp/gnus/sieve-mode.el
+++ b/lisp/gnus/sieve-mode.el
@@ -1,6 +1,6 @@
;;; sieve-mode.el --- Sieve code editing commands for Emacs
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
@@ -173,7 +173,7 @@
(defvar sieve-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-l" 'sieve-upload)
- (define-key map "\C-c\C-c" 'sieve-upload-and-bury)
+ (define-key map "\C-c\C-c" 'sieve-upload-and-kill)
(define-key map "\C-c\C-m" 'sieve-manage)
map)
"Key map used in sieve mode.")
diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el
index a44a03b6913..39b74e5eae0 100644
--- a/lisp/gnus/sieve.el
+++ b/lisp/gnus/sieve.el
@@ -1,6 +1,6 @@
;;; sieve.el --- Utilities to manage sieve scripts
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
@@ -109,7 +109,7 @@ require \"fileinto\";
;; various
(define-key map "?" 'sieve-help)
(define-key map "h" 'sieve-help)
- (define-key map "q" 'sieve-bury-buffer)
+ (define-key map "q" 'kill-buffer)
;; activating
(define-key map "m" 'sieve-activate)
(define-key map "u" 'sieve-deactivate)
@@ -250,29 +250,6 @@ Used to bracket operations which move point in the sieve-buffer."
(message "%s" (substitute-command-keys
"`\\[sieve-edit-script]':edit `\\[sieve-activate]':activate `\\[sieve-deactivate]':deactivate `\\[sieve-remove]':remove"))))
-(defun sieve-bury-buffer (buf &optional mainbuf)
- "Hide the buffer BUF that was temporarily popped up.
-BUF is assumed to be a temporary buffer used from the buffer MAINBUF."
- (interactive (list (current-buffer)))
- (save-current-buffer
- (let ((win (if (eq buf (window-buffer (selected-window))) (selected-window)
- (get-buffer-window buf t))))
- (when win
- (if (window-dedicated-p win)
- (condition-case ()
- (delete-window win)
- (error (iconify-frame (window-frame win))))
- (if (and mainbuf (get-buffer-window mainbuf))
- (delete-window win)))))
- (with-current-buffer buf
- (bury-buffer (unless (and (eq buf (window-buffer (selected-window)))
- (not (window-dedicated-p (selected-window))))
- buf)))
- (when mainbuf
- (let ((mainwin (or (get-buffer-window mainbuf)
- (get-buffer-window mainbuf 'visible))))
- (when mainwin (select-window mainwin))))))
-
;; Create buffer:
(defun sieve-setup-buffer (server port)
@@ -389,6 +366,12 @@ Server : " server ":" (or port "2000") "
(sieve-upload name)
(bury-buffer))
+;;;###autoload
+(defun sieve-upload-and-kill (&optional name)
+ (interactive)
+ (sieve-upload name)
+ (kill-buffer))
+
(provide 'sieve)
;; sieve.el ends here
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index cf23deb174b..df4b624ea15 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -1,6 +1,6 @@
;;; smiley.el --- displaying smiley faces
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: news mail multimedia
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index 3c1f75f3dc9..7492142947e 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -1,6 +1,6 @@
;;; smime.el --- S/MIME support library
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: SMIME X.509 PEM OpenSSL
@@ -678,7 +678,7 @@ The following commands are available:
"x509" "-in" (expand-file-name certfile) "-text")
(fundamental-mode)
(set-buffer-modified-p nil)
- (toggle-read-only t)
+ (setq buffer-read-only t)
(goto-char (point-min))))
(defun smime-draw-buffer ()
diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
index 6c94dbdd2c4..bb2827c4ced 100644
--- a/lisp/gnus/spam-report.el
+++ b/lisp/gnus/spam-report.el
@@ -1,6 +1,6 @@
;;; spam-report.el --- Reporting spam
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: network, spam, mail, gmane, report
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index 8b56c7bd537..04f90ee038d 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -1,6 +1,6 @@
;;; spam-stat.el --- detecting spam based on statistics
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Keywords: network
diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el
index 88e2037f5e7..087bbb2575f 100644
--- a/lisp/gnus/spam-wash.el
+++ b/lisp/gnus/spam-wash.el
@@ -1,6 +1,6 @@
;;; spam-wash.el --- wash spam before analysis
-;; Copyright (C) 2004, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2007-2012 Free Software Foundation, Inc.
;; Author: Andrew Cohen <cohen@andy.bu.edu>
;; Keywords: mail
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 869dbc9bc0e..c3be15adc1a 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -1,6 +1,6 @@
;;; spam.el --- Identifying spam
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
@@ -2088,11 +2088,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
;; all this is done inside a condition-case to trap errors
-(eval-when-compile
- (autoload 'bbdb-buffer "bbdb")
- (autoload 'bbdb-create-internal "bbdb")
- (autoload 'bbdb-search-simple "bbdb"))
-
;; Autoloaded in message, which we require.
(declare-function gnus-extract-address-components "gnus-util" (from))
@@ -2104,9 +2099,13 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(file-error
;; `bbdb-records' should not be bound as an autoload function
;; before loading bbdb because of `bbdb-hashtable-size'.
+ (defalias 'bbdb-buffer 'ignore)
+ (defalias 'bbdb-create-internal 'ignore)
(defalias 'bbdb-records 'ignore)
(defalias 'spam-BBDB-register-routine 'ignore)
(defalias 'spam-enter-ham-BBDB 'ignore)
+ (defalias 'spam-exists-in-BBDB-p 'ignore)
+ (defalias 'bbdb-gethash 'ignore)
nil))
;; when the BBDB changes, we want to clear out our cache
@@ -2126,7 +2125,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
'ignore))
(net-address (nth 1 parsed-address))
(record (and net-address
- (bbdb-search-simple nil net-address))))
+ (spam-exists-in-BBDB-p net-address))))
(when net-address
(gnus-message 6 "%s address %s %s BBDB"
(if remove "Deleting" "Adding")
@@ -2148,15 +2147,17 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(defun spam-BBDB-unregister-routine (articles)
(spam-BBDB-register-routine articles t))
+ (defsubst spam-exists-in-BBDB-p (net)
+ (when (and (stringp net) (not (zerop (length net))))
+ (bbdb-records)
+ (bbdb-gethash (downcase net))))
+
(defun spam-check-BBDB ()
"Mail from people in the BBDB is classified as ham or non-spam"
- (let ((who (message-fetch-field "from")))
- (when who
- (setq who (nth 1 (gnus-extract-address-components who)))
- (if
- (if (fboundp 'bbdb-search)
- (bbdb-search (bbdb-records) who) ;; v3
- (bbdb-search-simple nil who)) ;; v2
+ (let ((net (message-fetch-field "from")))
+ (when net
+ (setq net (nth 1 (gnus-extract-address-components net)))
+ (if (spam-exists-in-BBDB-p net)
t
(if spam-use-BBDB-exclusive
spam-split-group
diff --git a/lisp/gnus/starttls.el b/lisp/gnus/starttls.el
index af9fd42c127..346e76b2ccc 100644
--- a/lisp/gnus/starttls.el
+++ b/lisp/gnus/starttls.el
@@ -1,6 +1,6 @@
;;; starttls.el --- STARTTLS functions
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Author: Simon Josefsson <simon@josefsson.org>
@@ -149,7 +149,7 @@ These apply when the `starttls' command is used, i.e. when
:group 'starttls)
(defcustom starttls-extra-arguments nil
- "Extra arguments to `starttls-program'.
+ "Extra arguments to `starttls-gnutls-program'.
These apply when GnuTLS is used, i.e. when `starttls-use-gnutls' is non-nil.
For example, non-TLS compliant servers may require
@@ -297,9 +297,10 @@ GnuTLS requires a port number."
(defun starttls-available-p ()
"Say whether the STARTTLS programs are available."
- (executable-find (if starttls-use-gnutls
- starttls-gnutls-program
- starttls-program)))
+ (and (not (memq system-type '(windows-nt ms-dos)))
+ (executable-find (if starttls-use-gnutls
+ starttls-gnutls-program
+ starttls-program))))
(defalias 'starttls-any-program-available 'starttls-available-p)
(make-obsolete 'starttls-any-program-available 'starttls-available-p
diff --git a/lisp/gnus/utf7.el b/lisp/gnus/utf7.el
index f362931dcd0..aeabe7f9ebe 100644
--- a/lisp/gnus/utf7.el
+++ b/lisp/gnus/utf7.el
@@ -1,6 +1,6 @@
;;; utf7.el --- UTF-7 encoding/decoding for Emacs -*-coding: iso-8859-1;-*-
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Jon K Hellan <hellan@acm.org>
;; Maintainer: bugs@gnus.org
diff --git a/lisp/gnus/yenc.el b/lisp/gnus/yenc.el
index c21dfbdb438..46f30399b66 100644
--- a/lisp/gnus/yenc.el
+++ b/lisp/gnus/yenc.el
@@ -1,6 +1,6 @@
;;; yenc.el --- elisp native yenc decoder
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Jesper Harder <harder@ifa.au.dk>
;; Keywords: yenc news
diff --git a/lisp/gs.el b/lisp/gs.el
index b86632f7637..c9e7955078f 100644
--- a/lisp/gs.el
+++ b/lisp/gs.el
@@ -1,6 +1,6 @@
;;; gs.el --- interface to Ghostscript
-;; Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el
index d9012bdcad3..394768f4734 100644
--- a/lisp/help-at-pt.el
+++ b/lisp/help-at-pt.el
@@ -1,6 +1,6 @@
;;; help-at-pt.el --- local help through the keyboard
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Luc Teirlinck <teirllm@auburn.edu>
;; Keywords: help
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index efdc237d11f..b552d8c1357 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1,6 +1,6 @@
;;; help-fns.el --- Complex help functions -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2011
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -150,7 +150,7 @@ the same names as used in the original source code, when possible."
arglist)))
(unless (zerop rest) (push '&rest arglist) (push 'rest arglist))
(nreverse arglist))))
- ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap)))
+ ((and (autoloadp def) (not (eq (nth 4 def) 'keymap)))
"[Arg list not available until function definition is loaded.]")
(t t)))
@@ -288,7 +288,7 @@ defined. If several such files exist, preference is given to a file
found via `load-path'. The return value can also be `C-source', which
means that OBJECT is a function or variable defined in C. If no
suitable file is found, return nil."
- (let* ((autoloaded (eq (car-safe type) 'autoload))
+ (let* ((autoloaded (autoloadp type))
(file-name (or (and autoloaded (nth 1 type))
(symbol-file
object (if (memq type (list 'defvar 'defface))
@@ -380,6 +380,146 @@ suitable file is found, return nil."
(declare-function ad-get-advice-info "advice" (function))
+(defun help-fns--key-bindings (function)
+ (when (commandp function)
+ (let ((pt2 (with-current-buffer standard-output (point)))
+ (remapped (command-remapping function)))
+ (unless (memq remapped '(ignore undefined))
+ (let ((keys (where-is-internal
+ (or remapped function) overriding-local-map nil nil))
+ non-modified-keys)
+ (if (and (eq function 'self-insert-command)
+ (vectorp (car-safe keys))
+ (consp (aref (car keys) 0)))
+ (princ "It is bound to many ordinary text characters.\n")
+ ;; Which non-control non-meta keys run this command?
+ (dolist (key keys)
+ (if (member (event-modifiers (aref key 0)) '(nil (shift)))
+ (push key non-modified-keys)))
+ (when remapped
+ (princ "Its keys are remapped to ")
+ (princ (if (symbolp remapped)
+ (concat "`" (symbol-name remapped) "'")
+ "an anonymous command"))
+ (princ ".\n"))
+
+ (when keys
+ (princ (if remapped
+ "Without this remapping, it would be bound to "
+ "It is bound to "))
+ ;; If lots of ordinary text characters run this command,
+ ;; don't mention them one by one.
+ (if (< (length non-modified-keys) 10)
+ (princ (mapconcat 'key-description keys ", "))
+ (dolist (key non-modified-keys)
+ (setq keys (delq key keys)))
+ (if keys
+ (progn
+ (princ (mapconcat 'key-description keys ", "))
+ (princ ", and many ordinary text characters"))
+ (princ "many ordinary text characters"))))
+ (when (or remapped keys non-modified-keys)
+ (princ ".")
+ (terpri)))))
+
+ (with-current-buffer standard-output
+ (fill-region-as-paragraph pt2 (point))
+ (unless (looking-back "\n\n")
+ (terpri))))))
+
+(defun help-fns--compiler-macro (function)
+ (let ((handler (function-get function 'compiler-macro)))
+ (when handler
+ (insert "\nThis function has a compiler macro")
+ (let ((lib (get function 'compiler-macro-file)))
+ ;; FIXME: rather than look at the compiler-macro-file property,
+ ;; just look at `handler' itself.
+ (when (stringp lib)
+ (insert (format " in `%s'" lib))
+ (save-excursion
+ (re-search-backward "`\\([^`']+\\)'" nil t)
+ (help-xref-button 1 'help-function-cmacro function lib))))
+ (insert ".\n"))))
+
+(defun help-fns--signature (function doc real-def real-function)
+ (unless (keymapp function) ; If definition is a keymap, skip arglist note.
+ (let* ((advertised (gethash real-def advertised-signature-table t))
+ (arglist (if (listp advertised)
+ advertised (help-function-arglist real-def)))
+ (usage (help-split-fundoc doc function)))
+ (if usage (setq doc (cdr usage)))
+ (let* ((use (cond
+ ((and usage (not (listp advertised))) (car usage))
+ ((listp arglist)
+ (format "%S" (help-make-usage function arglist)))
+ ((stringp arglist) arglist)
+ ;; Maybe the arglist is in the docstring of a symbol
+ ;; this one is aliased to.
+ ((let ((fun real-function))
+ (while (and (symbolp fun)
+ (setq fun (symbol-function fun))
+ (not (setq usage (help-split-fundoc
+ (documentation fun)
+ function)))))
+ usage)
+ (car usage))
+ ((or (stringp real-def)
+ (vectorp real-def))
+ (format "\nMacro: %s" (format-kbd-macro real-def)))
+ (t "[Missing arglist. Please make a bug report.]")))
+ (high (help-highlight-arguments use doc)))
+ (let ((fill-begin (point)))
+ (insert (car high) "\n")
+ (fill-region fill-begin (point)))
+ (cdr high)))))
+
+(defun help-fns--parent-mode (function)
+ ;; If this is a derived mode, link to the parent.
+ (let ((parent-mode (and (symbolp function)
+ (get function
+ 'derived-mode-parent))))
+ (when parent-mode
+ (insert "\nParent mode: `")
+ (let ((beg (point)))
+ (insert (format "%s" parent-mode))
+ (make-text-button beg (point)
+ 'type 'help-function
+ 'help-args (list parent-mode)))
+ (insert "'.\n"))))
+
+(defun help-fns--obsolete (function)
+ ;; Ignore lambda constructs, keyboard macros, etc.
+ (let* ((obsolete (and (symbolp function)
+ (get function 'byte-obsolete-info)))
+ (use (car obsolete)))
+ (when 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))
+ (use (format ";\nuse `%s' instead." use))
+ (t "."))
+ "\n"))))
+
+;; We could use `symbol-file' but this is a wee bit more efficient.
+(defun help-fns--autoloaded-p (function file)
+ "Return non-nil if FUNCTION has previously been autoloaded.
+FILE is the file where FUNCTION was probably defined."
+ (let* ((file (file-name-sans-extension (file-truename file)))
+ (load-hist load-history)
+ (target (cons t function))
+ found)
+ (while (and load-hist (not found))
+ (and (caar load-hist)
+ (equal (file-name-sans-extension (caar load-hist)) file)
+ (setq found (member target (cdar load-hist))))
+ (setq load-hist (cdr load-hist)))
+ found))
+
;;;###autoload
(defun describe-function-1 (function)
(let* ((advised (and (symbolp function) (featurep 'advice)
@@ -395,59 +535,67 @@ suitable file is found, return nil."
(def (if (symbolp real-function)
(symbol-function real-function)
function))
- file-name string
- (beg (if (commandp def) "an interactive " "a "))
+ (aliased (symbolp def))
+ (real-def (if aliased
+ (let ((f def))
+ (while (and (fboundp f)
+ (symbolp (symbol-function f)))
+ (setq f (symbol-function f)))
+ f)
+ def))
+ (file-name (find-lisp-object-file-name function def))
(pt1 (with-current-buffer (help-buffer) (point)))
- errtype)
- (setq string
- (cond ((or (stringp def) (vectorp def))
- "a keyboard macro")
- ((subrp def)
- (if (eq 'unevalled (cdr (subr-arity def)))
- (concat beg "special form")
- (concat beg "built-in function")))
- ((byte-code-function-p def)
- (concat beg "compiled Lisp function"))
- ((symbolp def)
- (while (and (fboundp def)
- (symbolp (symbol-function def)))
- (setq def (symbol-function def)))
- ;; Handle (defalias 'foo 'bar), where bar is undefined.
- (or (fboundp def) (setq errtype 'alias))
- (format "an alias for `%s'" def))
- ((eq (car-safe def) 'lambda)
- (concat beg "Lisp function"))
- ((eq (car-safe def) 'macro)
- "a Lisp macro")
- ((eq (car-safe def) 'closure)
- (concat beg "Lisp closure"))
- ((eq (car-safe def) 'autoload)
- (format "%s autoloaded %s"
- (if (commandp def) "an interactive" "an")
- (if (eq (nth 4 def) 'keymap) "keymap"
- (if (nth 4 def) "Lisp macro" "Lisp function"))))
- ((keymapp def)
- (let ((is-full nil)
- (elts (cdr-safe def)))
- (while elts
- (if (char-table-p (car-safe elts))
- (setq is-full t
- elts nil))
- (setq elts (cdr-safe elts)))
- (if is-full
- "a full keymap"
- "a sparse keymap")))
- (t "")))
- (princ string)
- (if (eq errtype 'alias)
+ (beg (if (and (or (byte-code-function-p def)
+ (keymapp def)
+ (memq (car-safe def) '(macro lambda closure)))
+ file-name
+ (help-fns--autoloaded-p function file-name))
+ (if (commandp def)
+ "an interactive autoloaded "
+ "an autoloaded ")
+ (if (commandp def) "an interactive " "a "))))
+
+ ;; Print what kind of function-like object FUNCTION is.
+ (princ (cond ((or (stringp def) (vectorp def))
+ "a keyboard macro")
+ ((subrp def)
+ (if (eq 'unevalled (cdr (subr-arity def)))
+ (concat beg "special form")
+ (concat beg "built-in function")))
+ ((byte-code-function-p def)
+ (concat beg "compiled Lisp function"))
+ (aliased
+ (format "an alias for `%s'" real-def))
+ ((eq (car-safe def) 'lambda)
+ (concat beg "Lisp function"))
+ ((eq (car-safe def) 'macro)
+ (concat beg "Lisp macro"))
+ ((eq (car-safe def) 'closure)
+ (concat beg "Lisp closure"))
+ ((autoloadp def)
+ (format "%s autoloaded %s"
+ (if (commandp def) "an interactive" "an")
+ (if (eq (nth 4 def) 'keymap) "keymap"
+ (if (nth 4 def) "Lisp macro" "Lisp function"))))
+ ((keymapp def)
+ (let ((is-full nil)
+ (elts (cdr-safe def)))
+ (while elts
+ (if (char-table-p (car-safe elts))
+ (setq is-full t
+ elts nil))
+ (setq elts (cdr-safe elts)))
+ (concat beg (if is-full "keymap" "sparse keymap"))))
+ (t "")))
+
+ (if (and aliased (not (fboundp real-def)))
(princ ",\nwhich is not defined. Please make a bug report.")
(with-current-buffer standard-output
(save-excursion
(save-match-data
(when (re-search-backward "alias for `\\([^`']+\\)'" nil t)
- (help-xref-button 1 'help-function def)))))
+ (help-xref-button 1 'help-function real-def)))))
- (setq file-name (find-lisp-object-file-name function def))
(when file-name
(princ " in `")
;; We used to add .el to the file name,
@@ -466,125 +614,28 @@ suitable file is found, return nil."
(fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point))
(point)))
(terpri)(terpri)
- (when (commandp function)
- (let ((pt2 (with-current-buffer (help-buffer) (point)))
- (remapped (command-remapping function)))
- (unless (memq remapped '(ignore undefined))
- (let ((keys (where-is-internal
- (or remapped function) overriding-local-map nil nil))
- non-modified-keys)
- (if (and (eq function 'self-insert-command)
- (vectorp (car-safe keys))
- (consp (aref (car keys) 0)))
- (princ "It is bound to many ordinary text characters.\n")
- ;; Which non-control non-meta keys run this command?
- (dolist (key keys)
- (if (member (event-modifiers (aref key 0)) '(nil (shift)))
- (push key non-modified-keys)))
- (when remapped
- (princ "It is remapped to `")
- (princ (symbol-name remapped))
- (princ "'"))
-
- (when keys
- (princ (if remapped ", which is bound to " "It is bound to "))
- ;; If lots of ordinary text characters run this command,
- ;; don't mention them one by one.
- (if (< (length non-modified-keys) 10)
- (princ (mapconcat 'key-description keys ", "))
- (dolist (key non-modified-keys)
- (setq keys (delq key keys)))
- (if keys
- (progn
- (princ (mapconcat 'key-description keys ", "))
- (princ ", and many ordinary text characters"))
- (princ "many ordinary text characters"))))
- (when (or remapped keys non-modified-keys)
- (princ ".")
- (terpri)))))
-
- (with-current-buffer (help-buffer)
- (fill-region-as-paragraph pt2 (point))
- (unless (looking-back "\n\n")
- (terpri)))))
- ;; Note that list* etc do not get this property until
- ;; cl-hack-byte-compiler runs, after bytecomp is loaded.
- (when (and (symbolp function)
- (eq (get function 'byte-compile)
- 'cl-byte-compile-compiler-macro))
- (princ "This function has a compiler macro")
- (let ((lib (get function 'compiler-macro-file)))
- (when (stringp lib)
- (princ (format " in `%s'" lib))
- (with-current-buffer standard-output
- (save-excursion
- (re-search-backward "`\\([^`']+\\)'" nil t)
- (help-xref-button 1 'help-function-cmacro function lib)))))
- (princ ".\n\n"))
- (let* ((advertised (gethash def advertised-signature-table t))
- (arglist (if (listp advertised)
- advertised (help-function-arglist def)))
- (doc (condition-case err (documentation function)
- (error (format "No Doc! %S" err))))
- (usage (help-split-fundoc doc function)))
- (with-current-buffer standard-output
- ;; If definition is a keymap, skip arglist note.
- (unless (keymapp function)
- (if usage (setq doc (cdr usage)))
- (let* ((use (cond
- ((and usage (not (listp advertised))) (car usage))
- ((listp arglist)
- (format "%S" (help-make-usage function arglist)))
- ((stringp arglist) arglist)
- ;; Maybe the arglist is in the docstring of a symbol
- ;; this one is aliased to.
- ((let ((fun real-function))
- (while (and (symbolp fun)
- (setq fun (symbol-function fun))
- (not (setq usage (help-split-fundoc
- (documentation fun)
- function)))))
- usage)
- (car usage))
- ((or (stringp def)
- (vectorp def))
- (format "\nMacro: %s" (format-kbd-macro def)))
- (t "[Missing arglist. Please make a bug report.]")))
- (high (help-highlight-arguments use doc)))
- (let ((fill-begin (point)))
- (insert (car high) "\n")
- (fill-region fill-begin (point)))
- (setq doc (cdr high))))
-
- ;; If this is a derived mode, link to the parent.
- (let ((parent-mode (and (symbolp real-function)
- (get real-function
- 'derived-mode-parent))))
- (when parent-mode
- (with-current-buffer standard-output
- (insert "\nParent mode: `")
- (let ((beg (point)))
- (insert (format "%s" parent-mode))
- (make-text-button beg (point)
- 'type 'help-function
- 'help-args (list parent-mode))))
- (princ "'.\n")))
-
- (let* ((obsolete (and
- ;; function might be a lambda construct.
- (symbolp function)
- (get function 'byte-obsolete-info)))
- (use (car obsolete)))
- (when obsolete
- (princ "\nThis function is obsolete")
- (when (nth 2 obsolete)
- (insert (format " since %s" (nth 2 obsolete))))
- (insert (cond ((stringp use) (concat ";\n" use))
- (use (format ";\nuse `%s' instead." use))
- (t "."))
- "\n"))
- (insert "\n"
- (or doc "Not documented."))))))))
+
+ (let* ((doc-raw (documentation function t))
+ ;; If the function is autoloaded, and its docstring has
+ ;; key substitution constructs, load the library.
+ (doc (progn
+ (and (autoloadp real-def) doc-raw
+ help-enable-auto-load
+ (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]"
+ doc-raw)
+ (load (cadr real-def) t))
+ (substitute-command-keys doc-raw))))
+
+ (help-fns--key-bindings function)
+ (with-current-buffer standard-output
+ (setq doc (help-fns--signature function doc real-def real-function))
+
+ (help-fns--compiler-macro function)
+ (help-fns--parent-mode function)
+ (help-fns--obsolete function)
+
+ (insert "\n"
+ (or doc "Not documented.")))))))
;; Variables
@@ -670,6 +721,7 @@ it is displayed along with the global value."
(message "You did not specify a variable")
(save-excursion
(let ((valvoid (not (with-current-buffer buffer (boundp variable))))
+ (permanent-local (get variable 'permanent-local))
val val-start-pos locus)
;; Extract the value before setting up the output buffer,
;; in case `buffer' *is* the output buffer.
@@ -707,12 +759,18 @@ it is displayed along with the global value."
(with-current-buffer standard-output
(setq val-start-pos (point))
(princ "value is ")
- (let ((from (point)))
- (terpri)
- (pp val)
- (if (< (point) (+ 68 (line-beginning-position 0)))
- (delete-region from (1+ from))
- (delete-region (1- from) from))
+ (let ((from (point))
+ (line-beg (line-beginning-position))
+ (print-rep
+ (let ((print-quoted t))
+ (prin1-to-string val))))
+ (if (< (+ (length print-rep) (point) (- line-beg)) 68)
+ (insert print-rep)
+ (terpri)
+ (pp val)
+ (if (< (point) (+ 68 (line-beginning-position 0)))
+ (delete-region from (1+ from))
+ (delete-region (1- from) from)))
(let* ((sv (get variable 'standard-value))
(origval (and (consp sv)
(condition-case nil
@@ -730,9 +788,7 @@ it is displayed along with the global value."
(when locus
(cond
((bufferp locus)
- (princ (format "%socal in buffer %s; "
- (if (get variable 'permanent-local)
- "Permanently l" "L")
+ (princ (format "Local in buffer %s; "
(buffer-name))))
((framep locus)
(princ (format "It is a frame-local variable; ")))
@@ -742,20 +798,22 @@ it is displayed along with the global value."
(princ (format "It is local to %S" locus))))
(if (not (default-boundp variable))
(princ "globally void")
- (let ((val (default-value variable)))
+ (let ((global-val (default-value variable)))
(with-current-buffer standard-output
(princ "global value is ")
- (terpri)
- ;; Fixme: pp can take an age if you happen to
- ;; ask for a very large expression. We should
- ;; probably print it raw once and check it's a
- ;; sensible size before prettyprinting. -- fx
- (let ((from (point)))
- (pp val)
- ;; See previous comment for this function.
- ;; (help-xref-on-pp from (point))
- (if (< (point) (+ from 20))
- (delete-region (1- from) from))))))
+ (if (eq val global-val)
+ (princ "the same.")
+ (terpri)
+ ;; Fixme: pp can take an age if you happen to
+ ;; ask for a very large expression. We should
+ ;; probably print it raw once and check it's a
+ ;; sensible size before prettyprinting. -- fx
+ (let ((from (point)))
+ (pp global-val)
+ ;; See previous comment for this function.
+ ;; (help-xref-on-pp from (point))
+ (if (< (point) (+ from 20))
+ (delete-region (1- from) from)))))))
(terpri))
;; If the value is large, move it to the end.
@@ -789,18 +847,31 @@ it is displayed along with the global value."
(obsolete (get variable 'byte-obsolete-variable))
(use (car obsolete))
(safe-var (get variable 'safe-local-variable))
- (doc (or (documentation-property variable 'variable-documentation)
- (documentation-property alias 'variable-documentation)))
+ (doc (or (documentation-property
+ variable 'variable-documentation)
+ (documentation-property
+ alias 'variable-documentation)))
(extra-line nil))
- ;; Add a note for variables that have been make-var-buffer-local.
- (when (and (local-variable-if-set-p variable)
- (or (not (local-variable-p variable))
- (with-temp-buffer
- (local-variable-if-set-p variable))))
+
+ ;; Mention if it's a local variable.
+ (cond
+ ((and (local-variable-if-set-p variable)
+ (or (not (local-variable-p variable))
+ (with-temp-buffer
+ (local-variable-if-set-p variable))))
(setq extra-line t)
- (princ " Automatically becomes buffer-local when set in any fashion.\n"))
+ (princ " Automatically becomes ")
+ (if permanent-local
+ (princ "permanently "))
+ (princ "buffer-local when set.\n"))
+ ((not permanent-local))
+ ((bufferp locus)
+ (princ " This variable's buffer-local value is permanent.\n"))
+ (t
+ (princ " This variable's value is permanent \
+if it is given a local binding.\n")))
- ;; Mention if it's an alias
+ ;; Mention if it's an alias.
(unless (eq alias variable)
(setq extra-line t)
(princ (format " This variable is an alias for `%s'.\n" alias)))
@@ -822,9 +893,11 @@ it is displayed along with the global value."
(not (file-remote-p (buffer-file-name)))
(dir-locals-find-file
(buffer-file-name))))
- (type "file"))
- (princ " This variable is a directory local variable")
- (when file
+ (dir-file t))
+ (princ " This variable's value is directory-local")
+ (if (null file)
+ (princ ".\n")
+ (princ ", set ")
(if (consp file) ; result from cache
;; If the cache element has an mtime, we
;; assume it came from a file.
@@ -832,21 +905,27 @@ it is displayed along with the global value."
(setq file (expand-file-name
dir-locals-file (car file)))
;; Otherwise, assume it was set directly.
- (setq type "directory")))
- (princ (format "\n from the %s \"%s\"" type file)))
- (princ ".\n"))
- (princ " This variable is a file local variable.\n")))
+ (setq dir-file nil)))
+ (princ (if dir-file
+ "by the file\n `"
+ "for the directory\n `"))
+ (with-current-buffer standard-output
+ (insert-text-button
+ file 'type 'help-dir-local-var-def
+ 'help-args (list variable file)))
+ (princ "'.\n")))
+ (princ " This variable's value is file-local.\n")))
(when (memq variable ignored-local-variables)
(setq extra-line t)
- (princ " This variable is ignored when used as a file local \
+ (princ " This variable is ignored as a file-local \
variable.\n"))
;; Can be both risky and safe, eg auto-fill-function.
(when (risky-local-variable-p variable)
(setq extra-line t)
- (princ " This variable is potentially risky when used as a \
-file local variable.\n")
+ (princ " This variable may be risky if used as a \
+file-local variable.\n")
(when (assq variable safe-local-variable-values)
(princ " However, you have added it to \
`safe-local-variable-values'.\n")))
@@ -856,7 +935,7 @@ file local variable.\n")
(princ " This variable is safe as a file local variable ")
(princ "if its value\n satisfies the predicate ")
(princ (if (byte-code-function-p safe-var)
- "which is byte-compiled expression.\n"
+ "which is a byte-compiled expression.\n"
(format "`%s'.\n" safe-var))))
(if extra-line (terpri))
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 8efb99d42d8..63ae02eb90d 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -1,6 +1,6 @@
;;; help-macro.el --- makes command line help such as help-for-help
-;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Lynn Slater <lrs@indetech.com>
;; Maintainer: FSF
@@ -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.
@@ -184,9 +188,12 @@ and then returns."
(when config
(set-window-configuration config)
(setq config nil))
- ;; `defn' must make sure that its frame is
- ;; selected, so we won't iconify it below.
- (call-interactively defn)
+ ;; Temporarily rebind `minor-mode-map-alist'
+ ;; to `new-minor-mode-map-alist' (Bug#10454).
+ (let ((minor-mode-map-alist new-minor-mode-map-alist))
+ ;; `defn' must make sure that its frame is
+ ;; selected, so we won't iconify it below.
+ (call-interactively defn))
(when new-frame
;; Do not iconify the selected frame.
(unless (eq new-frame (selected-frame))
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 5906683071b..48c5849d301 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -1,6 +1,6 @@
;;; help-mode.el --- `help-mode' used by *Help* buffers
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2011
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -30,7 +30,6 @@
;;; Code:
(require 'button)
-(require 'view)
(eval-when-compile (require 'easymenu))
(defvar help-mode-map
@@ -40,6 +39,8 @@
(define-key map [mouse-2] 'help-follow-mouse)
(define-key map "\C-c\C-b" 'help-go-back)
(define-key map "\C-c\C-f" 'help-go-forward)
+ (define-key map [XF86Back] 'help-go-back)
+ (define-key map [XF86Forward] 'help-go-forward)
(define-key map "\C-c\C-c" 'help-follow-symbol)
(define-key map "\r" 'help-follow)
map)
@@ -264,7 +265,18 @@ The format is (FUNCTION ARGS...).")
:supertype 'help-xref
'help-function 'customize-create-theme
'help-echo (purecopy "mouse-2, RET: edit this theme file"))
+
+(define-button-type 'help-dir-local-var-def
+ :supertype 'help-xref
+ 'help-function (lambda (var &optional file)
+ ;; FIXME: this should go to the point where the
+ ;; local variable was defined.
+ (find-file file))
+ 'help-echo (purecopy "mouse-2, RET: open directory-local variables file"))
+
+(defvar bookmark-make-record-function)
+
;;;###autoload
(define-derived-mode help-mode special-mode "Help"
"Major mode for viewing help text and navigating references in it.
@@ -272,7 +284,9 @@ Entry to this mode runs the normal hook `help-mode-hook'.
Commands:
\\{help-mode-map}"
(set (make-local-variable 'revert-buffer-function)
- 'help-mode-revert-buffer))
+ 'help-mode-revert-buffer)
+ (set (make-local-variable 'bookmark-make-record-function)
+ 'help-bookmark-make-record))
;;;###autoload
(defun help-mode-setup ()
@@ -282,10 +296,7 @@ Commands:
;;;###autoload
(defun help-mode-finish ()
(when (eq major-mode 'help-mode)
- ;; View mode's read-only status of existing *Help* buffer is lost
- ;; by with-output-to-temp-buffer.
- (toggle-read-only 1)
-
+ (setq buffer-read-only t)
(save-excursion
(goto-char (point-min))
(let ((inhibit-read-only t))
@@ -497,11 +508,9 @@ that."
(or
(documentation-property
sym 'variable-documentation)
- (condition-case nil
- (documentation-property
- (indirect-variable sym)
- 'variable-documentation)
- (cyclic-variable-indirection nil))))
+ (documentation-property
+ (indirect-variable sym)
+ 'variable-documentation)))
(help-xref-button 8 'help-variable sym))
((fboundp sym)
(help-xref-button 8 'help-function sym)))))))
@@ -668,7 +677,8 @@ help buffer."
" is also a " "face." "\n\n" facedoc))
;; Don't record the `describe-function' item in the stack.
(setq help-xref-stack-item nil)
- (help-setup-xref (list #'help-xref-interned symbol) nil)))))))
+ (help-setup-xref (list #'help-xref-interned symbol) nil))))
+ (goto-char (point-min)))))
;; Navigation/hyperlinking with xrefs
@@ -789,6 +799,37 @@ help buffer by other means."
(with-output-to-temp-buffer (help-buffer)
(insert string)))
+
+;; Bookmark support
+
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-make-record-default "bookmark"
+ (&optional no-file no-context posn))
+
+(defun help-bookmark-make-record ()
+ "Create and return a help-mode bookmark record.
+Implements `bookmark-make-record-function' for help-mode buffers."
+ (unless (car help-xref-stack-item)
+ (error "Cannot create bookmark - help command not known"))
+ `(,@(bookmark-make-record-default 'NO-FILE 'NO-CONTEXT)
+ (help-fn . ,(car help-xref-stack-item))
+ (help-args . ,(cdr help-xref-stack-item))
+ (position . ,(point))
+ (handler . help-bookmark-jump)))
+
+;;;###autoload
+(defun help-bookmark-jump (bookmark)
+ "Jump to help-mode bookmark BOOKMARK.
+Handler function for record returned by `help-bookmark-make-record'.
+BOOKMARK is a bookmark name or a bookmark record."
+ (let ((help-fn (bookmark-prop-get bookmark 'help-fn))
+ (help-args (bookmark-prop-get bookmark 'help-args))
+ (position (bookmark-prop-get bookmark 'position)))
+ (apply help-fn help-args)
+ (pop-to-buffer "*Help*")
+ (goto-char position)))
+
+
(provide 'help-mode)
;;; help-mode.el ends here
diff --git a/lisp/help.el b/lisp/help.el
index 36d49aae9b3..de2a22714f9 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1,7 +1,6 @@
;;; help.el --- help commands for Emacs
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2011
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help, internal
@@ -24,7 +23,7 @@
;;; Commentary:
-;; This code implements GNU Emacs' on-line help system, the one invoked by
+;; This code implements GNU Emacs's on-line help system, the one invoked by
;; `M-x help-for-help'.
;;; Code:
@@ -40,9 +39,10 @@
;; `help-window-point-marker' is a marker you can move to a valid
;; position of the buffer shown in the help window in order to override
;; the standard positioning mechanism (`point-min') chosen by
-;; `with-output-to-temp-buffer'. `with-help-window' has this point
-;; nowhere before exiting. Currently used by `view-lossage' to assert
-;; that the last keystrokes are always visible.
+;; `with-output-to-temp-buffer' and `with-temp-buffer-window'.
+;; `with-help-window' has this point nowhere before exiting. Currently
+;; used by `view-lossage' to assert that the last keystrokes are always
+;; visible.
(defvar help-window-point-marker (make-marker)
"Marker to override default `window-point' in help windows.")
@@ -146,10 +146,6 @@ specifies what to do when the user exits the help buffer."
;; Secondly, the buffer has not been displayed yet,
;; so we don't know whether its frame will be selected.
nil)
- (display-buffer-reuse-frames
- (setq help-return-method (cons (selected-window)
- 'quit-window))
- nil)
((not (one-window-p t))
(setq help-return-method
(cons (selected-window) 'quit-window))
@@ -589,6 +585,8 @@ temporarily enables it to allow getting help on disabled items and buttons."
(setq saved-yank-menu (copy-sequence yank-menu))
(menu-bar-update-yank-menu "(any string)" nil))
(setq key (read-key-sequence "Describe key (or click or menu item): "))
+ ;; Clear the echo area message (Bug#7014).
+ (message nil)
;; If KEY is a down-event, read and discard the
;; corresponding up-event. Note that there are also
;; down-events on scroll bars and mode lines: the actual
@@ -784,7 +782,10 @@ descriptions of the minor modes, each on a separate page.
For this to work correctly for a minor mode, the mode's indicator
variable \(listed in `minor-mode-alist') must also be a function
-whose documentation describes the minor mode."
+whose documentation describes the minor mode.
+
+If called from Lisp with a non-nil BUFFER argument, display
+documentation for the major and minor modes of that buffer."
(interactive "@")
(unless buffer (setq buffer (current-buffer)))
(help-setup-xref (list #'describe-mode buffer)
@@ -940,7 +941,7 @@ is currently activated with completion."
(error "Cannot find minor mode for `%s'" indicator))))
(defun lookup-minor-mode-from-indicator (indicator)
- "Return a minor mode symbol from its indicator on the modeline."
+ "Return a minor mode symbol from its indicator on the mode line."
;; remove first space if existed
(if (and (< 0 (length indicator))
(eq (aref indicator 0) ?\s))
@@ -963,7 +964,11 @@ is currently activated with completion."
result))
;;; Automatic resizing of temporary buffers.
-(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2))
+(defcustom temp-buffer-max-height
+ (lambda (buffer)
+ (if (eq (selected-window) (frame-root-window))
+ (/ (x-display-pixel-height) (frame-char-height) 2)
+ (/ (- (frame-height) 2) 2)))
"Maximum height of a window displaying a temporary buffer.
This is effective only when Temp Buffer Resize mode is enabled.
The value is the maximum height (in lines) which
@@ -974,19 +979,24 @@ buffer, and should return a positive integer. At the time the
function is called, the window to be resized is selected."
:type '(choice integer function)
:group 'help
- :version "20.4")
+ :version "24.3")
(define-minor-mode temp-buffer-resize-mode
- "Toggle auto-shrinking temp buffer windows (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
is positive, and disable it otherwise. If called from Lisp,
enable the mode if ARG is omitted or nil.
When Temp Buffer Resize mode is enabled, the windows in which we
-show a temporary buffer are automatically reduced in height to
+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
@@ -996,19 +1006,36 @@ and some others."
(add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
(remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
-(defun resize-temp-buffer-window ()
- "Resize the selected window to fit its contents.
-Will not make it higher than `temp-buffer-max-height' nor smaller
-than `window-min-height'. Do nothing if the selected window is
-not vertically combined or some of its contents are scrolled out
-of view."
- (when (and (pos-visible-in-window-p (point-min))
- (window-combined-p))
- (fit-window-to-buffer
- nil
- (if (functionp temp-buffer-max-height)
- (funcall temp-buffer-max-height (window-buffer))
- temp-buffer-max-height))))
+(defun resize-temp-buffer-window (&optional window)
+ "Resize WINDOW to fit its contents.
+WINDOW can be any live window and defaults to the selected one.
+
+Do not make WINDOW higher than `temp-buffer-max-height' nor
+smaller than `window-min-height'. Do nothing if WINDOW is not
+vertically combined, some of its contents are scrolled out of
+view, or WINDOW was not created by `display-buffer'."
+ (setq window (window-normalize-window window t))
+ (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
+ ;; Resize WINDOW iff it was split off by `display-buffer'.
+ ((and (eq quit-cadr 'window)
+ (pos-visible-in-window-p (point-min) window)
+ (window-combined-p window))
+ (fit-window-to-buffer window height))
+ ;; Resize FRAME iff it was created by `display-buffer'.
+ ((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
@@ -1028,6 +1055,16 @@ by `with-help-window'"
:group 'help
:version "23.1")
+(defcustom help-enable-auto-load t
+ "Whether Help commands can perform autoloading.
+If non-nil, whenever \\[describe-function] is called for an
+autoloaded function whose docstring contains any key substitution
+construct (see `substitute-command-keys'), the library is loaded,
+so that the documentation can show the right key bindings."
+ :type 'boolean
+ :group 'help
+ :version "24.3")
+
(defun help-window-display-message (quit-part window &optional scroll)
"Display message telling how to quit and scroll help window.
QUIT-PART is a string telling how to quit the help window WINDOW.
diff --git a/lisp/hex-util.el b/lisp/hex-util.el
index c5ef6ac906a..caf5d740d32 100644
--- a/lisp/hex-util.el
+++ b/lisp/hex-util.el
@@ -1,6 +1,6 @@
;;; hex-util.el --- Functions to encode/decode hexadecimal string.
-;; Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Keywords: data
diff --git a/lisp/hexl.el b/lisp/hexl.el
index fdafd97cdab..7dd39807955 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -1,6 +1,6 @@
;;; hexl.el --- edit a file in a hex dump format using the hexl filter -*- lexical-binding: t -*-
-;; Copyright (C) 1989, 1994, 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1994, 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Keith Gabryelski <ag@wheaties.ai.mit.edu>
;; Maintainer: FSF
@@ -41,7 +41,7 @@
;;; Code:
(require 'eldoc)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;
;; vars here
@@ -51,6 +51,14 @@
"Edit a file in a hex dump format using the hexl filter."
:group 'data)
+(defcustom hexl-bits 16
+ "The bit grouping that hexl will use."
+ :type '(choice (const 8 )
+ (const 16)
+ (const 32)
+ (const 64))
+ :group 'hexl
+ :version "24.3")
(defcustom hexl-program "hexl"
"The program that will hexlify and dehexlify its stdin.
@@ -67,7 +75,9 @@ and \"-de\" when dehexlifying a buffer."
(defcustom hexl-options (format "-hex %s" hexl-iso)
"Space separated options to `hexl-program' that suit your needs.
-Quoting cannot be used, so the arguments cannot themselves contain spaces."
+Quoting cannot be used, so the arguments cannot themselves contain spaces.
+If you wish to set the `-group-by-X-bits' options, set `hexl-bits' instead,
+as that will override any bit grouping options set here."
:type 'string
:group 'hexl)
@@ -212,10 +222,34 @@ Quoting cannot be used, so the arguments cannot themselves contain spaces."
(2 'hexl-ascii-region t t)))
"Font lock keywords used in `hexl-mode'.")
+(defun hexl-rulerize (string bits)
+ (let ((size (/ bits 4)) (strlen (length string)) (pos 0) (ruler ""))
+ (while (< pos strlen)
+ (setq ruler (concat ruler " " (substring string pos (+ pos size))))
+ (setq pos (+ pos size)))
+ (substring ruler 1) ))
+
+(defvar hexl-rulers
+ (mapcar
+ (lambda (bits)
+ (cons bits
+ (concat " 87654321 "
+ (hexl-rulerize "00112233445566778899aabbccddeeff" bits)
+ " 0123456789abcdef")))
+ '(8 16 32 64)))
;; routines
(put 'hexl-mode 'mode-class 'special)
+;; 10 chars for the "address: "
+;; 32 chars for the hexlified bytes
+;; 1 char for the space
+;; 16 chars for the character display
+;; X chars for the spaces (128 bits divided by the hexl-bits)
+;; 1 char for the newline.
+(defun hexl-line-displen ()
+ "The length of a hexl display line (varies with `hexl-bits')."
+ (+ 60 (/ 128 (or hexl-bits 16))))
(defun hexl-mode--minor-mode-p (var)
(memq var '(ruler-mode hl-line-mode)))
@@ -248,7 +282,7 @@ using the function `hexlify-buffer'.
Each line in the buffer has an \"address\" (displayed in hexadecimal)
representing the offset into the file that the characters on this line
are at and 16 characters from the file (displayed as hexadecimal
-values grouped every 16 bits) and as their ASCII values.
+values grouped every `hexl-bits' bits) and as their ASCII values.
If any of the characters (displayed as ASCII characters) are
unprintable (control or meta characters) they will be replaced as
@@ -330,10 +364,7 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
(hexlify-buffer)
(restore-buffer-modified-p modified))
(set (make-local-variable 'hexl-max-address)
- (let* ((full-lines (/ (buffer-size) 68))
- (last-line (% (buffer-size) 68))
- (last-line-bytes (% last-line 52)))
- (+ last-line-bytes (* full-lines 16) -1)))
+ (+ (* (/ (1- (buffer-size)) (hexl-line-displen)) 16) 15))
(condition-case nil
(hexl-goto-address original-point)
(error nil)))
@@ -389,8 +420,7 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
" \\(?: .+\n[a-f0-9]+: \\)?"))
textre))
bound noerror count))
- (let ((isearch-search-fun-function nil))
- (isearch-search-fun))))
+ (isearch-search-fun-default)))
(defvar hexl-in-save-buffer nil)
@@ -432,7 +462,7 @@ and edit the file in `hexl-mode'."
(let ((completion-ignored-extensions nil))
(read-file-name "Filename: " nil nil 'ret-must-match))))
;; Ignore the user's setting of default major-mode.
- (letf (((default-value 'major-mode) 'fundamental-mode))
+ (cl-letf (((default-value 'major-mode) 'fundamental-mode))
(find-file-literally filename))
(if (not (eq major-mode 'hexl-mode))
(hexl-mode)))
@@ -510,17 +540,20 @@ Ask the user for confirmation."
(defun hexl-current-address (&optional validate)
"Return current hexl-address."
(interactive)
- (let ((current-column (- (% (- (point) (point-min) -1) 68) 11))
+ (let ((current-column
+ (- (% (- (point) (point-min) -1) (hexl-line-displen)) 11))
(hexl-address 0))
(if (< current-column 0)
(if validate
(error "Point is not on a character in the file")
(setq current-column 0)))
(setq hexl-address
- (+ (* (/ (- (point) (point-min) -1) 68) 16)
- (if (>= current-column 41)
- (- current-column 41)
- (/ (- current-column (/ current-column 5)) 2))))
+ (+ (* (/ (- (point) (point-min) -1)
+ (hexl-line-displen)) 16)
+ (if (>= current-column (- (hexl-ascii-start-column) 10))
+ (- current-column (- (hexl-ascii-start-column) 10))
+ (/ (- current-column
+ (/ current-column (1+ (/ hexl-bits 4)))) 2))))
(when (called-interactively-p 'interactive)
(message "Current address is %d/0x%08x" hexl-address hexl-address))
hexl-address))
@@ -531,10 +564,18 @@ This function is intended to be used as eldoc callback."
(let ((addr (hexl-current-address)))
(format "Current address is %d/0x%08x" addr addr)))
+(defun hexl-ascii-start-column ()
+ "Column at which the ascii portion of the hexl display starts."
+ (+ 43 (/ 128 hexl-bits)))
+
(defun hexl-address-to-marker (address)
"Return buffer position for ADDRESS."
(interactive "nAddress: ")
- (+ (* (/ address 16) 68) 10 (point-min) (/ (* (% address 16) 5) 2)))
+ (let ((N (* (% address 16) 2)))
+ (+ (* (/ address 16) (hexl-line-displen)) ; hexl line no * display length
+ 10 ; 10 chars for the "address: " prefix
+ (point-min) ; base offset (point usually starts at 1, not 0)
+ (+ N (/ N (/ hexl-bits 4))) )) ) ; char offset into hexl display line
(defun hexl-goto-address (address)
"Go to hexl-mode (decimal) address ADDRESS.
@@ -700,7 +741,7 @@ With prefix arg N, puts point N bytes of the way from the true beginning."
(defun hexl-beginning-of-line ()
"Goto beginning of line in hexl mode."
(interactive)
- (goto-char (+ (* (/ (point) 68) 68) 11)))
+ (goto-char (+ (* (/ (point) (hexl-line-displen)) (hexl-line-displen)) 11)))
(defun hexl-end-of-line ()
"Goto end of line in hexl mode."
@@ -776,6 +817,17 @@ You may also type octal digits, to insert a character with that code."
;00000000: 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789ABCDEF
+(defun hexl-options (&optional test)
+ "Combine `hexl-bits' with `hexl-options', altering `hexl-options' as needed
+to produce the command line options to pass to the hexl command."
+ (let ((opts (or test hexl-options)))
+ (when (memq hexl-bits '(8 16 32 64))
+ (when (string-match "\\(.*\\)-group-by-[0-9]+-bits\\(.*\\)" opts)
+ (setq opts (concat (match-string 1 opts)
+ (match-string 2 opts))))
+ (setq opts (format "%s -group-by-%d-bits " opts hexl-bits)) )
+ opts))
+
;;;###autoload
(defun hexlify-buffer ()
"Convert a binary buffer to hexl format.
@@ -798,7 +850,7 @@ This discards the buffer's undo information."
(mapcar (lambda (s)
(if (not (multibyte-string-p s)) s
(encode-coding-string s locale-coding-system)))
- (split-string hexl-options)))
+ (split-string (hexl-options))))
(if (> (point) (hexl-address-to-marker hexl-max-address))
(hexl-goto-address hexl-max-address))))
@@ -815,7 +867,7 @@ This discards the buffer's undo information."
(buffer-undo-list t))
(apply 'call-process-region (point-min) (point-max)
(expand-file-name hexl-program exec-directory)
- t t nil "-de" (split-string hexl-options))))
+ t t nil "-de" (split-string (hexl-options)))))
(defun hexl-char-after-point ()
"Return char for ASCII hex digits at point."
@@ -911,13 +963,12 @@ CH must be a unibyte character whose value is between 0 and 255."
(error "Invalid character 0x%x -- must be in the range [0..255]" ch))
(let ((address (hexl-current-address t)))
(while (> num 0)
- (let ((hex-position
- (+ (* (/ address 16) 68)
- 10 (point-min)
- (* 2 (% address 16))
- (/ (% address 16) 2)))
+ (let ((hex-position (hexl-address-to-marker address))
(ascii-position
- (+ (* (/ address 16) 68) 51 (point-min) (% address 16)))
+ (+ (* (/ address 16) (hexl-line-displen))
+ (hexl-ascii-start-column)
+ (point-min)
+ (% address 16)))
at-ascii-position)
(if (= (point) ascii-position)
(setq at-ascii-position t))
@@ -933,7 +984,7 @@ CH must be a unibyte character whose value is between 0 and 255."
(if at-ascii-position
(progn
(beginning-of-line)
- (forward-char 51)
+ (forward-char (hexl-ascii-start-column))
(forward-char (% address 16)))))
(setq num (1- num)))))
@@ -1041,7 +1092,7 @@ This function is assumed to be used as callback function for `hl-line-mode'."
(defun hexl-follow-ascii-find ()
"Find and highlight the ASCII element corresponding to current point."
- (let ((pos (+ 51
+ (let ((pos (+ (hexl-ascii-start-column)
(- (point) (current-column))
(mod (hexl-current-address) 16))))
(move-overlay hexl-ascii-overlay pos (1+ pos))
@@ -1050,7 +1101,7 @@ This function is assumed to be used as callback function for `hl-line-mode'."
(defun hexl-mode-ruler ()
"Return a string ruler for hexl mode."
(let* ((highlight (mod (hexl-current-address) 16))
- (s " 87654321 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789abcdef")
+ (s (cdr (assq hexl-bits hexl-rulers)))
(pos 0))
(set-text-properties 0 (length s) nil s)
;; Turn spaces in the header into stretch specs so they work
@@ -1062,12 +1113,12 @@ This function is assumed to be used as callback function for `hl-line-mode'."
`(space :align-to ,(1- pos))
s))
;; Highlight the current column.
- (put-text-property (+ 11 (/ (* 5 highlight) 2))
- (+ 13 (/ (* 5 highlight) 2))
- 'face 'highlight s)
+ (let ( (offset (+ (* 2 highlight) (/ (* 8 highlight) hexl-bits))) )
+ (put-text-property (+ 11 offset) (+ 13 offset) 'face 'highlight s))
;; Highlight the current ascii column
- (put-text-property (+ 13 39 highlight) (+ 13 40 highlight)
- 'face 'highlight s)
+ (put-text-property (+ (hexl-ascii-start-column) highlight 1)
+ (+ (hexl-ascii-start-column) highlight 2)
+ 'face 'highlight s)
s))
;; startup stuff.
diff --git a/lisp/hfy-cmap.el b/lisp/hfy-cmap.el
index 7bf1da2bdd9..05fefdaaed6 100644
--- a/lisp/hfy-cmap.el
+++ b/lisp/hfy-cmap.el
@@ -1,6 +1,6 @@
;;; hfy-cmap.el --- Fallback colour name -> rgb mapping for `htmlfontify'
-;; Copyright (C) 2002-2003, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2009-2012 Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
;; Package: htmlfontify
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index f659a7e8eef..59743124cc5 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -1,6 +1,6 @@
;;; hi-lock.el --- minor mode for interactive automatic highlighting
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: David M. Koppelman <koppel@ece.lsu.edu>
;; Keywords: faces, minor-mode, matching, display
@@ -52,14 +52,14 @@
;;
;; Setup:
;;
-;; Put the following code in your .emacs file. This turns on
+;; Put the following code in your init file. This turns on
;; hi-lock mode and adds a "Regexp Highlighting" entry
;; to the edit menu.
;;
;; (global-hi-lock-mode 1)
;;
;; To enable the use of patterns found in files (presumably placed
-;; there by hi-lock) include the following in your .emacs file:
+;; there by hi-lock) include the following in your init file:
;;
;; (setq hi-lock-file-patterns-policy 'ask)
;;
@@ -204,16 +204,15 @@ patterns."
(defvar hi-lock-interactive-patterns nil
"Patterns provided to hi-lock by user. Should not be changed.")
+(define-obsolete-variable-alias 'hi-lock-face-history
+ 'hi-lock-face-defaults "23.1")
(defvar hi-lock-face-defaults
'("hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-black-b"
"hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb")
"Default faces for hi-lock interactive functions.")
-;(dolist (f hi-lock-face-defaults) (unless (facep f) (error "%s not a face" f)))
-
-(define-obsolete-variable-alias 'hi-lock-face-history
- 'hi-lock-face-defaults
- "23.1")
+;;(dolist (f hi-lock-face-defaults)
+;; (unless (facep f) (error "%s not a face" f)))
(define-obsolete-variable-alias 'hi-lock-regexp-history
'regexp-history
@@ -288,12 +287,19 @@ With a prefix argument ARG, enable Hi Lock mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-Issuing one the highlighting commands listed below will
-automatically enable Hi Lock mode. To enable Hi Lock mode in all
-buffers, use `global-hi-lock-mode' or add (global-hi-lock-mode 1)
-to your init file. When Hi Lock mode is enabled, a \"Regexp
-Highlighting\" submenu is added to the \"Edit\" menu. The
-commands in the submenu, which can be called interactively, are:
+Hi Lock mode is automatically enabled when you invoke any of the
+highlighting commands listed below, such as \\[highlight-regexp].
+To enable Hi Lock mode in all buffers, use `global-hi-lock-mode'
+or add (global-hi-lock-mode 1) to your init file.
+
+In buffers where Font Lock mode is enabled, patterns are
+highlighted using font lock. In buffers where Font Lock mode is
+disabled, patterns are applied using overlays; in this case, the
+highlighting will not be updated as you type.
+
+When Hi Lock mode is enabled, a \"Regexp Highlighting\" submenu
+is added to the \"Edit\" menu. The commands in the submenu,
+which can be called interactively, are:
\\[highlight-regexp] REGEXP FACE
Highlight matches of pattern REGEXP in current buffer with FACE.
@@ -327,12 +333,12 @@ When hi-lock is started and if the mode is not excluded or patterns
rejected, the beginning of the buffer is searched for lines of the
form:
Hi-lock: FOO
-where FOO is a list of patterns. These are added to the font lock
-keywords already present. The patterns must start before position
-\(number of characters into buffer) `hi-lock-file-patterns-range'.
-Patterns will be read until
- Hi-lock: end
-is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'."
+
+where FOO is a list of patterns. The patterns must start before
+position \(number of characters into buffer)
+`hi-lock-file-patterns-range'. Patterns will be read until
+Hi-lock: end is found. A mode is excluded if it's in the list
+`hi-lock-exclude-modes'."
:group 'hi-lock
:lighter (:eval (if (or hi-lock-interactive-patterns
hi-lock-file-patterns)
@@ -350,7 +356,7 @@ is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'."
"Possible archaic use of (hi-lock-mode).
Use (global-hi-lock-mode 1) in .emacs to enable hi-lock for all buffers,
use (hi-lock-mode 1) for individual buffers. For compatibility with Emacs
-versions before 22 use the following in your .emacs file:
+versions before 22 use the following in your init file:
(if (functionp 'global-hi-lock-mode)
(global-hi-lock-mode 1)
@@ -359,7 +365,6 @@ versions before 22 use the following in your .emacs file:
(if hi-lock-mode
;; Turned on.
(progn
- (unless font-lock-mode (font-lock-mode 1))
(define-key-after menu-bar-edit-menu [hi-lock]
(cons "Regexp Highlighting" hi-lock-menu))
(hi-lock-find-patterns)
@@ -393,12 +398,13 @@ versions before 22 use the following in your .emacs file:
;;;###autoload
(defun hi-lock-line-face-buffer (regexp &optional face)
"Set face of all lines containing a match of REGEXP to FACE.
+Interactively, prompt for REGEXP then FACE, using a buffer-local
+history list for REGEXP and a global history list for FACE.
-Interactively, prompt for REGEXP then FACE. Buffer-local history
-list maintained for regexps, global history maintained for faces.
-\\<minibuffer-local-map>Use \\[previous-history-element] to retrieve previous history items,
-and \\[next-history-element] to retrieve default values.
-\(See info node `Minibuffer History'.)"
+If Font Lock mode is enabled in the buffer, it is used to
+highlight REGEXP. If Font Lock mode is disabled, overlays are
+used for highlighting; in this case, the highlighting will not be
+updated as you type."
(interactive
(list
(hi-lock-regexp-okay
@@ -417,12 +423,13 @@ and \\[next-history-element] to retrieve default values.
;;;###autoload
(defun hi-lock-face-buffer (regexp &optional face)
"Set face of each match of REGEXP to FACE.
+Interactively, prompt for REGEXP then FACE, using a buffer-local
+history list for REGEXP and a global history list for FACE.
-Interactively, prompt for REGEXP then FACE. Buffer-local history
-list maintained for regexps, global history maintained for faces.
-\\<minibuffer-local-map>Use \\[previous-history-element] to retrieve previous history items,
-and \\[next-history-element] to retrieve default values.
-\(See info node `Minibuffer History'.)"
+If Font Lock mode is enabled in the buffer, it is used to
+highlight REGEXP. If Font Lock mode is disabled, overlays are
+used for highlighting; in this case, the highlighting will not be
+updated as you type."
(interactive
(list
(hi-lock-regexp-okay
@@ -437,9 +444,13 @@ and \\[next-history-element] to retrieve default values.
;;;###autoload
(defun hi-lock-face-phrase-buffer (regexp &optional face)
"Set face of each match of phrase REGEXP to FACE.
+If called interactively, replaces whitespace in REGEXP with
+arbitrary whitespace and makes initial lower-case letters case-insensitive.
-Whitespace in REGEXP converted to arbitrary whitespace and initial
-lower-case letters made 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
+used for highlighting; in this case, the highlighting will not be
+updated as you type."
(interactive
(list
(hi-lock-regexp-okay
@@ -457,12 +468,8 @@ lower-case letters made case insensitive."
;;;###autoload
(defun hi-lock-unface-buffer (regexp)
"Remove highlighting of each match to REGEXP set by hi-lock.
-
-Interactively, prompt for REGEXP. Buffer-local history of inserted
-regexp's maintained. Will accept only regexps inserted by hi-lock
-interactive functions. \(See `hi-lock-interactive-patterns'.\)
-\\<minibuffer-local-must-match-map>Use \\[minibuffer-complete] to complete a partially typed regexp.
-\(See info node `Minibuffer History'.\)"
+Interactively, prompt for REGEXP, accepting only regexps
+previously inserted by hi-lock interactive functions."
(interactive
(if (and (display-popup-menus-p)
(listp last-nonmenu-event)
@@ -537,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))))
@@ -574,7 +587,7 @@ not suitable."
(let ((pattern (list regexp (list 0 (list 'quote face) t))))
(unless (member pattern hi-lock-interactive-patterns)
(push pattern hi-lock-interactive-patterns)
- (if font-lock-fontified
+ (if font-lock-mode
(progn
(font-lock-add-keywords nil (list pattern) t)
(font-lock-fontify-buffer))
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index 50e631a95c5..0970ece9446 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -1,6 +1,6 @@
;;; hilit-chg.el --- minor mode displaying buffer changes with special face
-;; Copyright (C) 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Richard Sharman <rsharman@pobox.com>
;; Keywords: faces
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
index 69da8fc6110..2f0a6e3af59 100644
--- a/lisp/hippie-exp.el
+++ b/lisp/hippie-exp.el
@@ -1,6 +1,6 @@
;;; hippie-exp.el --- expand text trying various ways to find its expansion
-;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;; Author: Anders Holst <aho@sans.kth.se>
;; Last change: 3 March 1998
@@ -156,7 +156,7 @@
;; opposite situation to occur, that `hippie-expand' misses some
;; suggestion because it thinks it has already tried it.
;;
-;; Acknowledgement
+;; Acknowledgment
;;
;; I want to thank Mikael Djurfeldt in discussions with whom the idea
;; of this function took form.
@@ -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/hl-line.el b/lisp/hl-line.el
index b535398f107..8164d8ad790 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -1,6 +1,6 @@
;;; hl-line.el --- highlight the current line
-;; Copyright (C) 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Maintainer: FSF
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index b0fd37abd36..a1853a6e04b 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1,6 +1,6 @@
;;; htmlfontify.el --- htmlize a buffer/source tree with optional hyperlinks
-;; Copyright (C) 2002-2003, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2009-2012 Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
;; Package: htmlfontify
@@ -249,7 +249,8 @@ when not running under a window system."
:tag "init-kludge-hooks"
:type '(hook))
-(defcustom hfy-post-html-hooks nil
+(define-obsolete-variable-alias 'hfy-post-html-hooks 'hfy-post-html-hook "24.3")
+(defcustom hfy-post-html-hook nil
"List of functions to call after creating and filling the HTML buffer.
These functions will be called with the HTML buffer as the current buffer."
:group 'htmlfontify
@@ -376,7 +377,7 @@ commands in `hfy-etags-cmd-alist'."
"The etags equivalent command to run in a source directory to generate a tags
file for the whole source tree from there on down. The command should emit
the etags output on stdout.\n
-Two canned commands are provided - they drive Emacs' etags and
+Two canned commands are provided - they drive Emacs's etags and
exuberant-ctags' etags respectively."
:group 'htmlfontify
:tag "etags-command"
@@ -450,6 +451,12 @@ and so on."
keep-overlays : More of a bell (or possibly whistle) than an
optimization - If on, preserve overlay highlighting
(cf ediff or goo-font-lock) as well as basic faces.\n
+ body-text-only : Emit only body-text. In concrete terms,
+ 1. Suppress calls to `hfy-page-header'and
+ `hfy-page-footer'
+ 2. Pretend that `div-wrapper' option above is
+ turned off
+ 3. Don't enclose output in <pre> </pre> tags
And the following are planned but not yet available:\n
kill-context-leak : Suppress hyperlinking between files highlighted by
different modes.\n
@@ -463,7 +470,8 @@ which can never slow you down, but may result in incomplete fontification."
(const :tag "skip-refontification" skip-refontification)
(const :tag "kill-context-leak" kill-context-leak )
(const :tag "div-wrapper" div-wrapper )
- (const :tag "keep-overlays" keep-overlays ))
+ (const :tag "keep-overlays" keep-overlays )
+ (const :tag "body-text-only" body-text-only ))
:group 'htmlfontify
:tag "optimizations")
@@ -859,13 +867,13 @@ If CLASS is set, it must be a `defface' alist key [see below],
in which case the first face specification returned by `hfy-combined-face-spec'
which *doesn't* clash with CLASS is returned.\n
\(A specification with a class of t is considered to match any class you
-specify - this matches Emacs' behavior when deciding on which face attributes
+specify - this matches Emacs's behavior when deciding on which face attributes
to use, to the best of my understanding).\n
-If CLASS is nil, then you just get get whatever `face-attr-construct' returns,
+If CLASS is nil, then you just get whatever `face-attr-construct' returns,
ie the current specification in effect for FACE.\n
*NOTE*: This function forces any face that is not 'default and which has
no :inherit property to inherit from 'default (this is because 'default
-is magical in that Emacs' fonts behave as if they inherit implicitly from
+is magical in that Emacs's fonts behave as if they inherit implicitly from
'default, but no such behavior exists in HTML/CSS).\n
See also `hfy-display-class' for details of valid values for CLASS."
(let ((face-spec
@@ -1044,9 +1052,7 @@ haven't encountered them yet. Returns a `hfy-style-assoc'."
((facep fn)
(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.
+ (facep (symbol-value fn)))
(hfy-face-attr-for-class (symbol-value fn) hfy-display-class))
(t nil)))
@@ -1108,10 +1114,9 @@ See also `hfy-face-to-style-i', `hfy-flatten-style'."
;; construct an assoc of (stripped-name . "{ css-stuff-here }") pairs
;; from a face:
-(defun hfy-face-to-css (fn)
- "Take FN, a font or `defface' specification (cf `face-attr-construct')
-and return a CSS style specification.\n
-See also `hfy-face-to-style'."
+(defun hfy-face-to-css-default (fn)
+ "Default handler for mapping faces to styles.
+See also `hfy-face-to-css'."
;;(message "hfy-face-to-css");;DBUG
(let* ((css-list (hfy-face-to-style fn))
(seen nil)
@@ -1125,6 +1130,17 @@ See also `hfy-face-to-style'."
css-list)))
(cons (hfy-css-name fn) (format "{%s}" (apply 'concat css-text)))) )
+(defvar hfy-face-to-css 'hfy-face-to-css-default
+ "Handler for mapping faces to styles.
+The signature of the handler is of the form \(lambda (FN) ...\).
+FN is a font or `defface' specification (cf
+`face-attr-construct'). The handler should return a cons cell of
+the form (STYLE-NAME . STYLE-SPEC).
+
+The default handler is `hfy-face-to-css-default'.
+
+See also `hfy-face-to-style'.")
+
(defalias 'hfy-prop-invisible-p
(if (fboundp 'invisible-p) #'invisible-p
(lambda (prop)
@@ -1311,20 +1327,27 @@ The plists are returned in descending priority order."
;; construct an assoc of (face-name . (css-name . "{ css-style }")) elements:
(defun hfy-compile-stylesheet ()
- "Trawl the current buffer, construct and return a `hfy-sheet-assoc'."
+ "Trawl the current buffer, construct and return a `hfy-sheet-assoc'.
+If `hfy-user-sheet-assoc' is currently bound then use it to
+collect new styles discovered during this run. Otherwise create
+a new assoc."
;;(message "hfy-compile-stylesheet");;DBUG
(let ((pt (point-min))
;; Make the font stack stay:
;;(hfy-tmpfont-stack nil)
(fn nil)
- (style nil))
+ (style (and (boundp 'hfy-user-sheet-assoc) hfy-user-sheet-assoc)))
(save-excursion
(goto-char pt)
(while (< pt (point-max))
(if (and (setq fn (hfy-face-at pt)) (not (assoc fn style)))
- (push (cons fn (hfy-face-to-css fn)) style))
- (setq pt (next-char-property-change pt))) )
- (push (cons 'default (hfy-face-to-css 'default)) style)))
+ (push (cons fn (funcall hfy-face-to-css fn)) style))
+ (setq pt (next-char-property-change pt))))
+ (unless (assoc 'default style)
+ (push (cons 'default (funcall hfy-face-to-css 'default)) style))
+ (when (boundp 'hfy-user-sheet-assoc)
+ (setq hfy-user-sheet-assoc style))
+ style))
(defun hfy-fontified-p ()
"`font-lock' doesn't like to say it's been fontified when in batch
@@ -1425,7 +1448,7 @@ Returns a modified copy of FACE-MAP."
(setq pt (next-char-property-change pt))
(setq pt-narrow (+ offset pt)))
(if (and map (not (eq 'end (cdar map))))
- (push (cons (- (point-max) (point-min)) 'end) map)))
+ (push (cons (1+ (- (point-max) (point-min))) 'end) map)))
(if (hfy-opt 'merge-adjacent-tags) (hfy-merge-adjacent-spans map) map)))
(defun hfy-buffer ()
@@ -1547,6 +1570,61 @@ Do not record undo information during evaluation of BODY."
(remove-text-properties (point-min) (point-max)
'(hfy-show-trailing-whitespace)))))
+(defun hfy-begin-span (style text-block text-id text-begins-block-p)
+ "Default handler to begin a span of text.
+Insert \"<span class=\"STYLE\" ...>\". See
+`hfy-begin-span-handler' for more information."
+ (when text-begins-block-p
+ (insert
+ (format "<span onclick=\"toggle_invis('%s');\">…</span>" text-block)))
+
+ (insert
+ (if text-block
+ (format "<span class=\"%s\" id=\"%s-%d\">" style text-block text-id)
+ (format "<span class=\"%s\">" style))))
+
+(defun hfy-end-span ()
+ "Default handler to end a span of text.
+Insert \"</span>\". See `hfy-end-span-handler' for more
+information."
+ (insert "</span>"))
+
+(defvar hfy-begin-span-handler 'hfy-begin-span
+ "Handler to begin a span of text.
+The signature of the handler is \(lambda (STYLE TEXT-BLOCK
+TEXT-ID TEXT-BEGINS-BLOCK-P) ...\). The handler must insert
+appropriate tags to begin a span of text.
+
+STYLE is the name of the style that begins at point. It is
+derived from the face attributes as part of `hfy-face-to-css'
+callback. The other arguments TEXT-BLOCK, TEXT-ID,
+TEXT-BEGINS-BLOCK-P are non-nil only if the buffer contains
+invisible text.
+
+TEXT-BLOCK is a string that identifies a single chunk of visible
+or invisible text of which the current position is a part. For
+visible portions, it's value is \"nil\". For invisible portions,
+it's value is computed as part of `hfy-invisible-name'.
+
+TEXT-ID marks a unique position within a block. It is set to
+value of `point' at the current buffer position.
+
+TEXT-BEGINS-BLOCK-P is a boolean and is non-nil if the current
+span also begins a invisible portion of text.
+
+An implementation can use TEXT-BLOCK, TEXT-ID,
+TEXT-BEGINS-BLOCK-P to implement fold/unfold-on-mouse-click like
+behaviour.
+
+The default handler is `hfy-begin-span'.")
+
+(defvar hfy-end-span-handler 'hfy-end-span
+ "Handler to end a span of text.
+The signature of the handler is \(lambda () ...\). The handler
+must insert appropriate tags to end a span of text.
+
+The default handler is `hfy-end-span'.")
+
(defun hfy-fontify-buffer (&optional srcdir file)
"Implement the guts of `htmlfontify-buffer'.
SRCDIR, if set, is the directory being htmlfontified.
@@ -1634,23 +1712,19 @@ FILE, if set, is the file name."
(or (get-text-property pt 'hfy-linkp)
(get-text-property pt 'hfy-endl )))
(if (eq 'end fn)
- (insert "</span>")
+ (funcall hfy-end-span-handler)
(if (not (and srcdir file))
nil
(when move-link
(remove-text-properties (point) (1+ (point)) '(hfy-endl nil))
(put-text-property pt (1+ pt) 'hfy-endl t) ))
;; if we have invisible blocks, we need to do some extra magic:
- (if invis-ranges
- (let ((iname (hfy-invisible-name pt invis-ranges))
- (fname (hfy-lookup fn css-sheet )))
- (when (assq pt invis-ranges)
- (insert
- (format "<span onclick=\"toggle_invis('%s');\">" iname))
- (insert "…</span>"))
- (insert
- (format "<span class=\"%s\" id=\"%s-%d\">" fname iname pt)))
- (insert (format "<span class=\"%s\">" (hfy-lookup fn css-sheet))))
+ (funcall hfy-begin-span-handler
+ (hfy-lookup fn css-sheet)
+ (and invis-ranges
+ (format "%s" (hfy-invisible-name pt invis-ranges)))
+ (and invis-ranges pt)
+ (and invis-ranges (assq pt invis-ranges)))
(if (not move-link) nil
;;(message "removing prop2 @ %d" (point))
(if (remove-text-properties (point) (1+ (point)) '(hfy-endl nil))
@@ -1698,23 +1772,39 @@ FILE, if set, is the file name."
;; so we have to do this after we use said properties:
;; (message "munging dangerous characters")
(hfy-html-dekludge-buffer)
- ;; insert the stylesheet at the top:
- (goto-char (point-min))
- ;;(message "inserting stylesheet")
- (insert (hfy-sprintf-stylesheet css-sheet file))
- (if (hfy-opt 'div-wrapper) (insert "<div class=\"default\">"))
- (insert "\n<pre>")
- (goto-char (point-max))
- (insert "</pre>\n")
- (if (hfy-opt 'div-wrapper) (insert "</div>"))
- ;;(message "inserting footer")
- (insert (funcall hfy-page-footer file))
+ (unless (hfy-opt 'body-text-only)
+ ;; insert the stylesheet at the top:
+ (goto-char (point-min))
+
+ ;;(message "inserting stylesheet")
+ (insert (hfy-sprintf-stylesheet css-sheet file))
+
+ (if (hfy-opt 'div-wrapper) (insert "<div class=\"default\">"))
+ (insert "\n<pre>")
+ (goto-char (point-max))
+ (insert "</pre>\n")
+ (if (hfy-opt 'div-wrapper) (insert "</div>"))
+ ;;(message "inserting footer")
+ (insert (funcall hfy-page-footer file)))
;; call any post html-generation hooks:
- (run-hooks 'hfy-post-html-hooks)
+ (run-hooks 'hfy-post-html-hook)
;; return the html buffer
(set-buffer-modified-p nil)
html-buffer))
+(defun htmlfontify-string (string)
+ "Take a STRING and return a fontified version of it.
+It is assumed that STRING has text properties that allow it to be
+fontified. This is a simple convenience wrapper around
+`htmlfontify-buffer'."
+ (let* ((hfy-optimisations-1 (copy-sequence hfy-optimisations))
+ (hfy-optimisations (add-to-list 'hfy-optimisations-1
+ 'skip-refontification)))
+ (with-temp-buffer
+ (insert string)
+ (htmlfontify-buffer)
+ (buffer-string))))
+
(defun hfy-force-fontification ()
"Try to force font-locking even when it is optimized away."
(run-hooks 'hfy-init-kludge-hook)
@@ -2316,7 +2406,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'."
;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file)
-;;;;;; "hfy-cmap" "hfy-cmap.el" "8dce008297f15826cc6ab82203c46fa6")
+;;;;;; "hfy-cmap" "hfy-cmap.el" "ef24066922f1e27b7580d572f12fabbe")
;;; Generated autoloads from hfy-cmap.el
(autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index a0fae8d8671..ee5bd0f357a 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -1,6 +1,6 @@
;;; ibuf-ext.el --- extensions for ibuffer
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Colin Walters <walters@verbum.org>
;; Maintainer: John Paul Wallington <jpw@gnu.org>
@@ -35,7 +35,7 @@
(eval-when-compile
(require 'ibuf-macs)
- (require 'cl))
+ (require 'cl-lib))
;;; Utility functions
(defun ibuffer-delete-alist (key alist)
@@ -497,12 +497,12 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
(defun ibuffer-included-in-filter-p-1 (buf filter)
(not
(not
- (case (car filter)
- (or
+ (pcase (car filter)
+ (`or
(memq t (mapcar #'(lambda (x)
(ibuffer-included-in-filter-p buf x))
(cdr filter))))
- (saved
+ (`saved
(let ((data
(assoc (cdr filter)
ibuffer-saved-filters)))
@@ -510,19 +510,13 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
(ibuffer-filter-disable t)
(error "Unknown saved filter %s" (cdr filter)))
(ibuffer-included-in-filters-p buf (cadr data))))
- (t
- (let ((filterdat (assq (car filter)
- ibuffer-filtering-alist)))
- ;; filterdat should be like (TYPE DESCRIPTION FUNC)
- ;; just a sanity check
- (unless filterdat
- (ibuffer-filter-disable t)
- (error "Undefined filter %s" (car filter)))
- (not
- (not
- (funcall (caddr filterdat)
- buf
- (cdr filter))))))))))
+ (_
+ (pcase-let ((`(,_type ,_desc ,func)
+ (assq (car filter) ibuffer-filtering-alist)))
+ (unless func
+ (ibuffer-filter-disable t)
+ (error "Undefined filter %s" (car filter)))
+ (funcall func buf (cdr filter))))))))
(defun ibuffer-generate-filter-groups (bmarklist &optional noempty nodefault)
(let ((filter-group-alist (if nodefault
@@ -536,14 +530,14 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
(i 0))
(dolist (filtergroup filter-group-alist)
(let ((filterset (cdr filtergroup)))
- (multiple-value-bind (hip-crowd lamers)
- (values-list
+ (cl-multiple-value-bind (hip-crowd lamers)
+ (cl-values-list
(ibuffer-split-list (lambda (bufmark)
(ibuffer-included-in-filters-p (car bufmark)
filterset))
bmarklist))
(aset vec i hip-crowd)
- (incf i)
+ (cl-incf i)
(setq bmarklist lamers))))
(let (ret)
(dotimes (j i ret)
@@ -689,7 +683,7 @@ See also `ibuffer-kill-filter-group'."
(if (equal (car groups) group)
(setq found t
groups nil)
- (incf res)
+ (cl-incf res)
(setq groups (cdr groups))))
res)))
(cond ((not found)
@@ -761,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))
@@ -810,12 +810,12 @@ turned into two separate filters [name: foo] and [mode: bar-mode]."
(when (null ibuffer-filtering-qualifiers)
(error "No filters in effect"))
(let ((lim (pop ibuffer-filtering-qualifiers)))
- (case (car lim)
- (or
+ (pcase (car lim)
+ (`or
(setq ibuffer-filtering-qualifiers (append
(cdr lim)
ibuffer-filtering-qualifiers)))
- (saved
+ (`saved
(let ((data
(assoc (cdr lim)
ibuffer-saved-filters)))
@@ -825,10 +825,10 @@ turned into two separate filters [name: foo] and [mode: bar-mode]."
(setq ibuffer-filtering-qualifiers (append
(cadr data)
ibuffer-filtering-qualifiers))))
- (not
+ (`not
(push (cdr lim)
ibuffer-filtering-qualifiers))
- (t
+ (_
(error "Filter type %s is not compound" (car lim)))))
(ibuffer-update nil t))
@@ -960,33 +960,30 @@ Interactively, prompt for NAME, and use the current filters."
(ibuffer-format-qualifier-1 qualifier)))
(defun ibuffer-format-qualifier-1 (qualifier)
- (case (car qualifier)
- (saved
+ (pcase (car qualifier)
+ (`saved
(concat " [filter: " (cdr qualifier) "]"))
- (or
+ (`or
(concat " [OR" (mapconcat #'ibuffer-format-qualifier
(cdr qualifier) "") "]"))
- (t
+ (_
(let ((type (assq (car qualifier) ibuffer-filtering-alist)))
(unless qualifier
(error "Ibuffer: bad qualifier %s" qualifier))
(concat " [" (cadr type) ": " (format "%s]" (cdr qualifier)))))))
-(defun ibuffer-list-buffer-modes ()
- "Create an alist of buffer modes currently in use.
-The list returned will be of the form (\"MODE-NAME\" . MODE-SYMBOL)."
- (let ((bufs (buffer-list))
- (modes)
- (this-mode))
- (while bufs
- (setq this-mode (buffer-local-value 'major-mode (car bufs))
- bufs (cdr bufs))
- (add-to-list
- 'modes
- `(,(symbol-name this-mode) .
- ,this-mode)))
- modes))
+(defun ibuffer-list-buffer-modes (&optional include-parents)
+ "Create a completion table of buffer modes currently in use.
+If INCLUDE-PARENTS is non-nil then include parent modes."
+ (let ((modes))
+ (dolist (buf (buffer-list))
+ (let ((this-mode (buffer-local-value 'major-mode buf)))
+ (while (and this-mode (not (memq this-mode modes)))
+ (push this-mode modes)
+ (setq this-mode (and include-parents
+ (get this-mode 'derived-mode-parent))))))
+ (mapcar #'symbol-name modes)))
;;; Extra operation definitions
@@ -996,16 +993,19 @@ The list returned will be of the form (\"MODE-NAME\" . MODE-SYMBOL)."
"Toggle current view to buffers with major mode QUALIFIER."
(:description "major mode"
:reader
- (intern
- (completing-read "Filter by major mode: " obarray
- #'(lambda (e)
- (string-match "-mode$"
- (symbol-name e)))
- t
- (let ((buf (ibuffer-current-buffer)))
- (if (and buf (buffer-live-p buf))
- (symbol-name (buffer-local-value 'major-mode buf))
- "")))))
+ (let* ((buf (ibuffer-current-buffer))
+ (default (if (and buf (buffer-live-p buf))
+ (symbol-name (buffer-local-value
+ 'major-mode buf)))))
+ (intern
+ (completing-read
+ (if default
+ (format "Filter by major mode (default %s): " default)
+ "Filter by major mode: ")
+ obarray
+ #'(lambda (e)
+ (string-match "-mode\\'" (symbol-name e)))
+ t nil nil default))))
(eq qualifier (buffer-local-value 'major-mode buf)))
;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext")
@@ -1014,18 +1014,29 @@ The list returned will be of the form (\"MODE-NAME\" . MODE-SYMBOL)."
Called interactively, this function allows selection of modes
currently used by buffers."
(:description "major mode in use"
+ :reader
+ (let* ((buf (ibuffer-current-buffer))
+ (default (if (and buf (buffer-live-p buf))
+ (symbol-name (buffer-local-value
+ 'major-mode buf)))))
+ (intern
+ (completing-read
+ (if default
+ (format "Filter by major mode (default %s): " default)
+ "Filter by major mode: ")
+ (ibuffer-list-buffer-modes) nil t nil nil default))))
+ (eq qualifier (buffer-local-value 'major-mode buf)))
+
+;;;###autoload (autoload 'ibuffer-filter-by-derived-mode "ibuf-ext")
+(define-ibuffer-filter derived-mode
+ "Toggle current view to buffers whose major mode inherits from QUALIFIER."
+ (:description "derived mode"
:reader
(intern
- (completing-read "Filter by major mode: "
- (ibuffer-list-buffer-modes)
- nil
- t
- (let ((buf (ibuffer-current-buffer)))
- (if (and buf (buffer-live-p buf))
- (symbol-name (buffer-local-value
- 'major-mode buf))
- "")))))
- (eq qualifier (buffer-local-value 'major-mode buf)))
+ (completing-read "Filter by derived mode: "
+ (ibuffer-list-buffer-modes t)
+ nil t)))
+ (with-current-buffer buf (derived-mode-p qualifier)))
;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext")
(define-ibuffer-filter name
@@ -1345,8 +1356,8 @@ a prefix argument reverses the meaning of that variable."
(diff-sentinel
(call-process shell-file-name nil
(current-buffer) nil
- shell-command-switch command)))
- (insert "\n"))))
+ shell-command-switch command))
+ (insert "\n")))))
(sit-for 0)
(when (file-exists-p tempfile)
(delete-file tempfile)))))
@@ -1403,14 +1414,14 @@ You can then feed the file name(s) to other commands with \\[yank]."
(concat ibuffer-copy-filename-as-kill-result
(let ((name (buffer-file-name buf)))
(if name
- (case type
- (full
+ (pcase type
+ (`full
name)
- (relative
+ (`relative
(file-relative-name
name (or ibuffer-default-directory
default-directory)))
- (t
+ (_
(file-name-nondirectory name)))
""))
" "))))
@@ -1466,19 +1477,16 @@ You can then feed the file name(s) to other commands with \\[yank]."
(defun ibuffer-mark-by-mode (mode)
"Mark all buffers whose major mode equals MODE."
(interactive
- (list (intern (completing-read "Mark by major mode: " obarray
- #'(lambda (e)
- ;; kind of a hack...
- (and (fboundp e)
- (string-match "-mode$"
- (symbol-name e))))
- t
- (let ((buf (ibuffer-current-buffer)))
- (if (and buf (buffer-live-p buf))
- (with-current-buffer buf
- (cons (symbol-name major-mode)
- 0))
- ""))))))
+ (let* ((buf (ibuffer-current-buffer))
+ (default (if (and buf (buffer-live-p buf))
+ (symbol-name (buffer-local-value
+ 'major-mode buf)))))
+ (list (intern
+ (completing-read
+ (if default
+ (format "Mark by major mode (default %s): " default)
+ "Mark by major mode: ")
+ (ibuffer-list-buffer-modes) nil t nil nil default)))))
(ibuffer-mark-on-buffer
#'(lambda (buf)
(eq (buffer-local-value 'major-mode buf) mode))))
@@ -1542,13 +1550,8 @@ You can then feed the file name(s) to other commands with \\[yank]."
(with-current-buffer buf
;; hacked from midnight.el
(when buffer-display-time
- (let* ((tm (current-time))
- (now (+ (* (float (ash 1 16)) (car tm))
- (float (cadr tm)) (* 0.0000001 (caddr tm))))
- (then (+ (* (float (ash 1 16))
- (car buffer-display-time))
- (float (cadr buffer-display-time))
- (* 0.0000001 (caddr buffer-display-time)))))
+ (let* ((now (float-time))
+ (then (float-time buffer-display-time)))
(> (- now then) (* 60 60 ibuffer-old-time))))))))
;;;###autoload
diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index 9965e0ccfb2..ebf34c120e5 100644
--- a/lisp/ibuf-macs.el
+++ b/lisp/ibuf-macs.el
@@ -1,6 +1,6 @@
;;; ibuf-macs.el --- macros for ibuffer
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Colin Walters <walters@verbum.org>
;; Maintainer: John Paul Wallington <jpw@gnu.org>
@@ -27,8 +27,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
;; From Paul Graham's "ANSI Common Lisp", adapted for Emacs Lisp here.
(defmacro ibuffer-aif (test true-body &rest false-body)
@@ -73,7 +72,7 @@ During evaluation of body, bind `it' to the value returned by TEST."
(ibuffer-redisplay t))))))
;;;###autoload
-(defmacro* define-ibuffer-column (symbol (&key name inline props summarizer
+(cl-defmacro define-ibuffer-column (symbol (&key name inline props summarizer
header-mouse-map) &rest body)
"Define a column SYMBOL for use with `ibuffer-formats'.
@@ -129,7 +128,7 @@ change its definition, you should explicitly call
:autoload-end)))
;;;###autoload
-(defmacro* define-ibuffer-sorter (name documentation
+(cl-defmacro define-ibuffer-sorter (name documentation
(&key
description)
&rest body)
@@ -143,7 +142,7 @@ buffer object, and `b' bound to another. BODY should return a non-nil
value if and only if `a' is \"less than\" `b'.
\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)"
- (declare (indent 1))
+ (declare (indent 1) (doc-string 2))
`(progn
(defun ,(intern (concat "ibuffer-do-sort-by-" (symbol-name name))) ()
,(or documentation "No :documentation specified for this sorting method.")
@@ -160,7 +159,7 @@ value if and only if `a' is \"less than\" `b'.
:autoload-end))
;;;###autoload
-(defmacro* define-ibuffer-op (op args
+(cl-defmacro define-ibuffer-op (op args
documentation
(&key
interactive
@@ -202,7 +201,7 @@ COMPLEX means this function is special; see the source code of this
macro for exactly what it does.
\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)"
- (declare (indent 2))
+ (declare (indent 2) (doc-string 3))
`(progn
(defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
"" "ibuffer-do-") (symbol-name op)))
@@ -213,19 +212,19 @@ macro for exactly what it does.
,(if (not (null interactive))
`(interactive ,interactive)
'(interactive))
- (assert (derived-mode-p 'ibuffer-mode))
+ (cl-assert (derived-mode-p 'ibuffer-mode))
(setq ibuffer-did-modification nil)
- (let ((marked-names (,(case mark
+ (let ((marked-names (,(pcase mark
(:deletion
'ibuffer-deletion-marked-buffer-names)
- (t
+ (_
'ibuffer-marked-buffer-names)))))
(when (null marked-names)
(setq marked-names (list (buffer-name (ibuffer-current-buffer))))
- (ibuffer-set-mark ,(case mark
+ (ibuffer-set-mark ,(pcase mark
(:deletion
'ibuffer-deletion-char)
- (t
+ (_
'ibuffer-marked-char))))
,(let* ((finish (append
'(progn)
@@ -242,10 +241,10 @@ macro for exactly what it does.
,@body))
t)))
(body `(let ((count
- (,(case mark
+ (,(pcase mark
(:deletion
'ibuffer-map-deletion-lines)
- (t
+ (_
'ibuffer-map-marked-lines))
#'(lambda (buf mark)
,(if (eq modifier-p :maybe)
@@ -264,7 +263,7 @@ macro for exactly what it does.
:autoload-end))
;;;###autoload
-(defmacro* define-ibuffer-filter (name documentation
+(cl-defmacro define-ibuffer-filter (name documentation
(&key
reader
description)
@@ -280,7 +279,7 @@ will be evaluated with BUF bound to the buffer object, and QUALIFIER
bound to the current value of the filter.
\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)"
- (declare (indent 2))
+ (declare (indent 2) (doc-string 2))
(let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))))
`(progn
(defun ,fn-name (qualifier)
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index cb511c4695e..4e0ac1a4856 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -1,6 +1,6 @@
;;; ibuffer.el --- operate on buffers like dired
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Colin Walters <walters@verbum.org>
;; Maintainer: John Paul Wallington <jpw@gnu.org>
@@ -31,7 +31,7 @@
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'ibuf-macs)
(require 'dired))
@@ -60,11 +60,10 @@
(declare-function ibuffer-format-filter-group-data "ibuf-ext" (filter))
(defgroup ibuffer nil
- "An advanced replacement for `buffer-menu'.
-
-Ibuffer allows you to operate on buffers in a manner much like Dired.
-Operations include sorting, marking by regular expression, and
-the ability to filter the displayed buffers by various criteria."
+ "Advanced replacement for `buffer-menu'.
+Ibuffer lets you operate on buffers in a Dired-like way,
+with the ability to sort, mark by regular expression,
+and filter displayed buffers by various criteria."
:version "22.1"
:group 'convenience)
@@ -124,13 +123,13 @@ own!):
no upper limit on its size. The size will also be aligned to the
right.
-Thus, if you wanted to use these two formats, add
-
- (setq ibuffer-formats '((mark \" \" name)
- (mark modified read-only
- (name 16 16 :left) (size 6 -1 :right))))
+Thus, if you wanted to use these two formats, the appropriate
+value for this variable would be
-to your ~/.emacs file.
+ '((mark \" \" name)
+ (mark modified read-only
+ (name 16 16 :left)
+ (size 6 -1 :right)))
Using \\[ibuffer-switch-format], you can rotate the display between
the specified formats in the list."
@@ -502,8 +501,8 @@ directory, like `default-directory'."
(define-key map (kbd "s f") 'ibuffer-do-sort-by-filename/process)
(define-key map (kbd "s m") 'ibuffer-do-sort-by-major-mode)
- (define-key map (kbd "/ m") 'ibuffer-filter-by-mode)
- (define-key map (kbd "/ M") 'ibuffer-filter-by-used-mode)
+ (define-key map (kbd "/ m") 'ibuffer-filter-by-used-mode)
+ (define-key map (kbd "/ M") 'ibuffer-filter-by-derived-mode)
(define-key map (kbd "/ n") 'ibuffer-filter-by-name)
(define-key map (kbd "/ c") 'ibuffer-filter-by-content)
(define-key map (kbd "/ e") 'ibuffer-filter-by-predicate)
@@ -633,10 +632,13 @@ directory, like `default-directory'."
'(menu-item "Disable all filtering" ibuffer-filter-disable
:enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)))
(define-key-after map [menu-bar view filter filter-by-mode]
- '(menu-item "Add filter by major mode..." ibuffer-filter-by-mode))
- (define-key-after map [menu-bar view filter filter-by-mode]
- '(menu-item "Add filter by major mode in use..."
+ '(menu-item "Add filter by any major mode..." ibuffer-filter-by-mode))
+ (define-key-after map [menu-bar view filter filter-by-used-mode]
+ '(menu-item "Add filter by a major mode in use..."
ibuffer-filter-by-used-mode))
+ (define-key-after map [menu-bar view filter filter-by-derived-mode]
+ '(menu-item "Add filter by derived mode..."
+ ibuffer-filter-by-derived-mode))
(define-key-after map [menu-bar view filter filter-by-name]
'(menu-item "Add filter by buffer name..." ibuffer-filter-by-name))
(define-key-after map [menu-bar view filter filter-by-filename]
@@ -1018,7 +1020,7 @@ width and the longest string in LIST."
(when (get-text-property (point) 'ibuffer-title)
(forward-line 1)
(setq arg 1))
- (decf arg)))
+ (cl-decf arg)))
(defun ibuffer-forward-line (&optional arg skip-group-names)
"Move forward ARG lines, wrapping around the list if necessary."
@@ -1033,7 +1035,7 @@ width and the longest string in LIST."
(and skip-group-names
(get-text-property (point) 'ibuffer-filter-group-name)))
(when (> arg 0)
- (decf arg))
+ (cl-decf arg))
(ibuffer-skip-properties (append '(ibuffer-title)
(when skip-group-names
'(ibuffer-filter-group-name)))
@@ -1046,7 +1048,7 @@ width and the longest string in LIST."
(or (eobp)
(get-text-property (point) 'ibuffer-summary)))
(goto-char (point-min)))
- (decf arg)
+ (cl-decf arg)
(ibuffer-skip-properties (append '(ibuffer-title)
(when skip-group-names
'(ibuffer-filter-group-name)))
@@ -1191,7 +1193,7 @@ a new window in the current frame, splitting vertically."
(setq trying nil))
(error
;; Handle a failure
- (if (or (> (incf attempts) 4)
+ (if (or (> (cl-incf attempts) 4)
(and (stringp (cadr err))
;; This definitely falls in the
;; ghetto hack category...
@@ -1244,7 +1246,7 @@ a new window in the current frame, splitting vertically."
(ibuffer-map-on-mark ibuffer-deletion-char func))
(defsubst ibuffer-assert-ibuffer-mode ()
- (assert (derived-mode-p 'ibuffer-mode)))
+ (cl-assert (derived-mode-p 'ibuffer-mode)))
(defun ibuffer-buffer-file-name ()
(or buffer-file-name
@@ -1280,11 +1282,11 @@ a new window in the current frame, splitting vertically."
(define-ibuffer-op ibuffer-do-toggle-read-only (&optional arg)
"Toggle read only status in marked buffers.
-With optional ARG, make read-only only if ARG is positive."
+With optional ARG, make read-only only if ARG is not negative."
(:opstring "toggled read only status in"
:interactive "P"
:modifier-p t)
- (toggle-read-only arg))
+ (read-only-mode 'toggle))
(define-ibuffer-op ibuffer-do-delete ()
"Kill marked buffers as with `kill-this-buffer'."
@@ -1360,24 +1362,27 @@ group."
(defun ibuffer-mark-forward (arg)
"Mark the buffer on this line, and move forward ARG lines.
If point is on a group name, this function operates on that group."
- (interactive "P")
- (ibuffer-mark-interactive arg ibuffer-marked-char 1))
+ (interactive "p")
+ (ibuffer-mark-interactive arg ibuffer-marked-char))
(defun ibuffer-unmark-forward (arg)
"Unmark the buffer on this line, and move forward ARG lines.
If point is on a group name, this function operates on that group."
- (interactive "P")
- (ibuffer-mark-interactive arg ?\s 1))
+ (interactive "p")
+ (ibuffer-mark-interactive arg ?\s))
(defun ibuffer-unmark-backward (arg)
"Unmark the buffer on this line, and move backward ARG lines.
If point is on a group name, this function operates on that group."
- (interactive "P")
- (ibuffer-mark-interactive arg ?\s -1))
+ (interactive "p")
+ (ibuffer-unmark-forward (- arg)))
-(defun ibuffer-mark-interactive (arg mark movement)
+(defun ibuffer-mark-interactive (arg mark &optional movement)
(ibuffer-assert-ibuffer-mode)
(or arg (setq arg 1))
+ ;; deprecated movement argument
+ (when (and movement (< movement 0))
+ (setq arg (- arg)))
(ibuffer-forward-line 0)
(ibuffer-aif (get-text-property (point) 'ibuffer-filter-group-name)
(progn
@@ -1387,8 +1392,12 @@ If point is on a group name, this function operates on that group."
(let ((inhibit-read-only t))
(while (> arg 0)
(ibuffer-set-mark mark)
- (ibuffer-forward-line movement t)
- (setq arg (1- arg))))))
+ (ibuffer-forward-line 1 t)
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (ibuffer-forward-line -1 t)
+ (ibuffer-set-mark mark)
+ (setq arg (1+ arg))))))
(defun ibuffer-set-mark (mark)
(ibuffer-assert-ibuffer-mode)
@@ -1505,11 +1514,11 @@ If point is on a group name, this function operates on that group."
`(progn
(setq tmp1 ,widthform
tmp2 (/ tmp1 2))
- ,(case alignment
+ ,(pcase alignment
(:right `(concat ,left ,right ,strvar))
(:center `(concat ,left ,strvar ,right))
(:left `(concat ,strvar ,left ,right))
- (t (error "Invalid alignment %s" alignment))))))
+ (_ (error "Invalid alignment %s" alignment))))))
(defun ibuffer-compile-format (format)
(let ((result nil)
@@ -1530,7 +1539,7 @@ If point is on a group name, this function operates on that group."
(max (nth 2 form))
(align (nth 3 form))
(elide (nth 4 form)))
- (let* ((from-end-p (when (minusp min)
+ (let* ((from-end-p (when (cl-minusp min)
(setq min (- min))
t))
(letbindings nil)
@@ -1813,10 +1822,10 @@ If point is on a group name, this function operates on that group."
(defun ibuffer-format-column (str width alignment)
(let ((left (make-string (/ width 2) ?\s))
(right (make-string (- width (/ width 2)) ?\s)))
- (case alignment
+ (pcase alignment
(:right (concat left right str))
(:center (concat left str right))
- (t (concat str left right)))))
+ (_ (concat str left right)))))
(defun ibuffer-buffer-name-face (buf mark)
(cond ((char-equal mark ibuffer-marked-char)
@@ -1914,18 +1923,18 @@ the buffer object itself and the current mark symbol."
;; `nil' if it chose not to affect the buffer
;; `kill' means the remove line from the buffer list
;; `t' otherwise
- (incf ibuffer-map-lines-total)
+ (cl-incf ibuffer-map-lines-total)
(cond ((null result)
(forward-line 1))
((eq result 'kill)
(delete-region (line-beginning-position)
(1+ (line-end-position)))
- (incf ibuffer-map-lines-count)
+ (cl-incf ibuffer-map-lines-count)
(when (< ibuffer-map-lines-total
orig-target-line)
- (decf target-line-offset)))
+ (cl-decf target-line-offset)))
(t
- (incf ibuffer-map-lines-count)
+ (cl-incf ibuffer-map-lines-count)
(forward-line 1)))))
ibuffer-map-lines-count)
(progn
@@ -2055,12 +2064,9 @@ the value of point at the beginning of the line for that buffer."
(insert
(if (stringp element)
element
- (let ((sym (car element))
- (min (cadr element))
- ;; (max (caddr element))
- (align (cadddr element)))
+ (pcase-let ((`(,sym ,min ,_max ,align) element))
;; Ignore a negative min when we're inserting the title
- (when (minusp min)
+ (when (cl-minusp min)
(setq min (- min)))
(let* ((name (or (get sym 'ibuffer-column-name)
(error "Unknown column %s in ibuffer-formats" sym)))
@@ -2108,24 +2114,23 @@ the value of point at the beginning of the line for that buffer."
(insert
(if (stringp element)
(make-string (length element) ?\s)
- (let ((sym (car element)))
- (let ((min (cadr element))
- ;; (max (caddr element))
- (align (cadddr element)))
- ;; Ignore a negative min when we're inserting the title
- (when (minusp min)
- (setq min (- min)))
- (let* ((summary (if (get sym 'ibuffer-column-summarizer)
- (funcall (get sym 'ibuffer-column-summarizer)
- (get sym 'ibuffer-column-summary))
- (make-string (length (get sym 'ibuffer-column-name))
- ?\s)))
- (len (length summary)))
- (if (< len min)
- (ibuffer-format-column summary
- (- min len)
- align)
- summary)))))))
+ (pcase-let ((`(,sym ,min ,_max ,align) element))
+ ;; Ignore a negative min when we're inserting the title.
+ (when (cl-minusp min)
+ (setq min (- min)))
+ (let* ((summary
+ (if (get sym 'ibuffer-column-summarizer)
+ (funcall (get sym 'ibuffer-column-summarizer)
+ (get sym 'ibuffer-column-summary))
+ (make-string
+ (length (get sym 'ibuffer-column-name))
+ ?\s)))
+ (len (length summary)))
+ (if (< len min)
+ (ibuffer-format-column summary
+ (- min len)
+ align)
+ summary))))))
(point))
`(ibuffer-summary t)))))
@@ -2140,11 +2145,10 @@ If optional arg SILENT is non-nil, do not display progress messages."
(unless silent
(message "Redisplaying current buffer list..."))
(let ((blist (ibuffer-current-state-list)))
- (when (null blist)
- (if (and (featurep 'ibuf-ext)
+ (when (and (null blist)
+ (featurep 'ibuf-ext)
(or ibuffer-filtering-qualifiers ibuffer-hidden-filter-groups))
- (message "No buffers! (note: filtering in effect)")
- (error "No buffers!")))
+ (message "No buffers! (note: filtering in effect)"))
(ibuffer-redisplay-engine blist t)
(unless silent
(message "Redisplaying current buffer list...done"))
@@ -2170,15 +2174,14 @@ If optional arg SILENT is non-nil, do not display progress messages."
(eq ibuffer-always-show-last-buffer
:nomini)
(minibufferp (cadr bufs)))
- (caddr bufs)
+ (cl-caddr bufs)
(cadr bufs))
(ibuffer-current-buffers-with-marks bufs)
ibuffer-display-maybe-show-predicates)))
- (when (null blist)
- (if (and (featurep 'ibuf-ext)
- ibuffer-filtering-qualifiers)
- (message "No buffers! (note: filtering in effect)")
- (error "No buffers!")))
+ (and (null blist)
+ (featurep 'ibuf-ext)
+ ibuffer-filtering-qualifiers
+ (message "No buffers! (note: filtering in effect)"))
(unless silent
(message "Updating buffer list..."))
(ibuffer-redisplay-engine blist arg)
@@ -2203,7 +2206,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
(require 'ibuf-ext))
(let* ((sortdat (assq ibuffer-sorting-mode
ibuffer-sorting-functions-alist))
- (func (caddr sortdat)))
+ (func (cl-caddr sortdat)))
(let ((result
;; actually sort the buffers
(if (and sortdat func)
@@ -2384,7 +2387,7 @@ currently open buffers, in addition to filtering your view to a
particular subset of them, and sorting by various criteria.
Operations on marked buffers:
-
+\\<ibuffer-mode-map>
'\\[ibuffer-do-save]' - Save the marked buffers
'\\[ibuffer-do-view]' - View the marked buffers in this frame.
'\\[ibuffer-do-view-other-frame]' - View the marked buffers in another frame.
@@ -2408,7 +2411,7 @@ Operations on marked buffers:
buffer's file as an argument.
'\\[ibuffer-do-eval]' - Evaluate a form in each of the marked buffers. This
is a very flexible command. For example, if you want to make all
- of the marked buffers read only, try using (toggle-read-only 1) as
+ of the marked buffers read only, try using (read-only-mode 1) as
the input form.
'\\[ibuffer-do-view-and-eval]' - As above, but view each buffer while the form
is evaluated.
@@ -2445,8 +2448,9 @@ Marking commands:
Filtering commands:
- '\\[ibuffer-filter-by-mode]' - Add a filter by major mode.
- '\\[ibuffer-filter-by-used-mode]' - Add a filter by major mode now in use.
+ '\\[ibuffer-filter-by-mode]' - Add a filter by any major mode.
+ '\\[ibuffer-filter-by-used-mode]' - Add a filter by a major mode now in use.
+ '\\[ibuffer-filter-by-derived-mode]' - Add a filter by derived mode.
'\\[ibuffer-filter-by-name]' - Add a filter by buffer name.
'\\[ibuffer-filter-by-content]' - Add a filter by buffer content.
'\\[ibuffer-filter-by-filename]' - Add a filter by filename.
@@ -2577,11 +2581,11 @@ will be inserted before the group at point."
;; `ibuffer-update' puts this on header-line-format when needed.
(setq ibuffer-header-line-format
;; Display the part that won't be in the mode-line.
- (list* "" mode-name
- (mapcar (lambda (elem)
- (if (eq (car-safe elem) 'header-line-format)
- (nth 2 elem) elem))
- mode-line-process)))
+ `("" ,mode-name
+ ,@(mapcar (lambda (elem)
+ (if (eq (car-safe elem) 'header-line-format)
+ (nth 2 elem) elem))
+ mode-line-process)))
(setq buffer-read-only t)
(buffer-disable-undo)
@@ -2648,7 +2652,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" "897e64e4465af94b89e21fa84ae61290")
+;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "f03bae226325c7320d41ddb78896665a")
;;; Generated autoloads from ibuf-ext.el
(autoload 'ibuffer-auto-mode "ibuf-ext" "\
@@ -2838,6 +2842,7 @@ Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'.
\(fn NAME)" t nil)
(autoload 'ibuffer-filter-by-mode "ibuf-ext")
(autoload 'ibuffer-filter-by-used-mode "ibuf-ext")
+ (autoload 'ibuffer-filter-by-derived-mode "ibuf-ext")
(autoload 'ibuffer-filter-by-name "ibuf-ext")
(autoload 'ibuffer-filter-by-filename "ibuf-ext")
(autoload 'ibuffer-filter-by-size-gt "ibuf-ext")
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 53876f48a06..a4e3e339470 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -1,6 +1,6 @@
;;; icomplete.el --- minibuffer completion incremental feedback
-;; Copyright (C) 1992-1994, 1997, 1999, 2001-2011
+;; Copyright (C) 1992-1994, 1997, 1999, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Ken Manheimer <klm@i.am>
@@ -209,10 +209,12 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(when (and icomplete-mode (icomplete-simple-completing-p))
(set (make-local-variable 'completion-show-inline-help) nil)
(add-hook 'pre-command-hook
- (lambda () (run-hooks 'icomplete-pre-command-hook))
+ (lambda () (let ((non-essential t))
+ (run-hooks 'icomplete-pre-command-hook)))
nil t)
(add-hook 'post-command-hook
- (lambda () (run-hooks 'icomplete-post-command-hook))
+ (lambda () (let ((non-essential t)) ;E.g. don't prompt for password!
+ (run-hooks 'icomplete-post-command-hook)))
nil t)
(run-hooks 'icomplete-minibuffer-setup-hook)))
;
@@ -285,8 +287,7 @@ The displays for unambiguous matches have ` [Matched]' appended
matches exist. \(Keybindings for uniquely matched commands
are exhibited within the square braces.)"
- (let* ((non-essential t)
- (md (completion--field-metadata (field-beginning)))
+ (let* ((md (completion--field-metadata (field-beginning)))
(comps (completion-all-sorted-completions))
(last (if (consp comps) (last comps)))
(base-size (cdr last))
@@ -333,21 +334,23 @@ are exhibited within the square braces.)"
(window-width)))
(prefix-len
;; Find the common prefix among `comps'.
- (if (eq t (compare-strings (car comps) nil (length most)
- most nil nil completion-ignore-case))
- ;; Common case.
- (length most)
- ;; Else, use try-completion.
- (let ((comps-prefix (try-completion "" comps)))
- (and (stringp comps-prefix)
- (length comps-prefix)))))
+ ;; We can't use the optimization below because its assumptions
+ ;; aren't always true, e.g. when completion-cycling (bug#10850):
+ ;; (if (eq t (compare-strings (car comps) nil (length most)
+ ;; most nil nil completion-ignore-case))
+ ;; ;; Common case.
+ ;; (length most)
+ ;; Else, use try-completion.
+ (let ((comps-prefix (try-completion "" comps)))
+ (and (stringp comps-prefix)
+ (length comps-prefix)))) ;;)
prospects most-is-exact comp limit)
(if (eq most-try t) ;; (or (null (cdr comps))
(setq prospects nil)
(while (and comps (not limit))
(setq comp
- (if prefix-len (substring (car comps) prefix-len) (car comps))
+ (if prefix-len (substring (car comps) prefix-len) (car comps))
comps (cdr comps))
(cond ((string-equal comp "") (setq most-is-exact t))
((member comp prospects))
diff --git a/lisp/ido.el b/lisp/ido.el
index 345438d3cc6..f4f9c27c847 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1,6 +1,6 @@
;;; ido.el --- interactively do things with buffers and files
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Based on: iswitchb by Stephen Eglen <stephen@cns.ed.ac.uk>
@@ -279,7 +279,7 @@
;; can be used by other packages to read a buffer name, a file name,
;; or a directory name in the `ido' way.
-;;; Acknowledgements
+;;; Acknowledgments
;; Infinite amounts of gratitude goes to Stephen Eglen <stephen@cns.ed.ac.uk>
;; who wrote iswitch-buffer mode - from which I ripped off 99% of the code
@@ -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."
@@ -791,44 +803,39 @@ subdirs in the alternatives."
:type 'boolean
:group 'ido)
-(defface ido-first-match '((t (:bold t)))
+(defface ido-first-match '((t :weight bold))
"Face used by ido for highlighting first match."
:group 'ido)
(defface ido-only-match '((((class color))
- (:foreground "ForestGreen"))
- (t (:italic t)))
+ :foreground "ForestGreen")
+ (t :slant italic))
"Face used by ido for highlighting only match."
:group 'ido)
(defface ido-subdir '((((min-colors 88) (class color))
- (:foreground "red1"))
- (((class color))
- (:foreground "red"))
- (t (:underline t)))
+ :foreground "red1")
+ (((class color))
+ :foreground "red")
+ (t :underline t))
"Face used by ido for highlighting subdirs in the alternatives."
:group 'ido)
-(defface ido-virtual '((t (:inherit font-lock-builtin-face)))
+(defface ido-virtual '((t :inherit font-lock-builtin-face))
"Face used by ido for matching virtual buffer names."
:version "24.1"
:group 'ido)
-(defface ido-indicator '((((min-colors 88) (class color))
- (:foreground "yellow1"
- :background "red1"
- :width condensed))
- (((class color))
- (:foreground "yellow"
- :background "red"
- :width condensed))
- (t (:inverse-video t)))
+(defface ido-indicator '((((min-colors 88) (class color))
+ :foreground "yellow1" :background "red1" :width condensed)
+ (((class color))
+ :foreground "yellow" :background "red" :width condensed)
+ (t :inverse-video t))
"Face used by ido for highlighting its indicators."
:group 'ido)
(defface ido-incomplete-regexp
- '((t
- (:inherit font-lock-warning-face)))
+ '((t :inherit font-lock-warning-face))
"Ido face for indicating incomplete regexps."
:group 'ido)
@@ -872,7 +879,7 @@ The following variables are available, but should not be changed:
:group 'ido)
(defvar ido-rewrite-file-prompt-rules nil
- "*Alist of rewriting rules for directory names in ido prompts.
+ "Alist of rewriting rules for directory names in ido prompts.
A list of elements of the form (FROM . TO) or (FROM . FUNC), each
meaning to rewrite the directory name if matched by FROM by either
substituting the matched string by TO or calling the function FUNC
@@ -893,9 +900,14 @@ Otherwise, only the current list of matches is shown."
:type 'boolean
:group 'ido)
-(defvar ido-all-frames 'visible
- "*Argument to pass to `walk-windows' when finding visible files.
-See documentation of `walk-windows' for useful values.")
+(defcustom ido-all-frames 'visible
+ "Argument to pass to `walk-windows' when Ido is finding buffers.
+See documentation of `walk-windows' for useful values."
+ :type '(choice (const :tag "Selected frame only" nil)
+ (const :tag "All existing frames" t)
+ (const :tag "All visible frames" visible)
+ (const :tag "All frames on this terminal" 0))
+ :group 'ido)
(defcustom ido-minibuffer-setup-hook nil
"Ido-specific customization of minibuffer setup.
@@ -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
@@ -1722,8 +1734,9 @@ This function also adds a hook to the minibuffer."
(unless (and ido-enable-tramp-completion
(string-match "\\`/[^/]*@\\'" dir))
(setq dir (ido-final-slash dir t))))
- (if (get-buffer ido-completion-buffer)
- (kill-buffer ido-completion-buffer))
+ (and ido-completion-buffer
+ (get-buffer ido-completion-buffer)
+ (kill-buffer ido-completion-buffer))
(cond
((equal dir ido-current-directory)
nil)
@@ -1736,8 +1749,9 @@ This function also adds a hook to the minibuffer."
(t
(ido-trace "cd" dir)
(setq ido-current-directory dir)
- (if (get-buffer ido-completion-buffer)
- (kill-buffer ido-completion-buffer))
+ (and ido-completion-buffer
+ (get-buffer ido-completion-buffer)
+ (kill-buffer ido-completion-buffer))
(setq ido-directory-nonreadable (ido-nonreadable-directory-p dir))
(setq ido-directory-too-big (and (not ido-directory-nonreadable)
(ido-directory-too-big-p dir)))
@@ -1982,8 +1996,9 @@ If INITIAL is non-nil, it specifies the initial input string."
(setq ido-text-init nil))
ido-completion-map nil hist))))
(ido-trace "read-from-minibuffer" ido-final-text)
- (if (get-buffer ido-completion-buffer)
- (kill-buffer ido-completion-buffer))
+ (and ido-completion-buffer
+ (get-buffer ido-completion-buffer)
+ (kill-buffer ido-completion-buffer))
(ido-trace "\n_EXIT_" ido-exit)
@@ -3266,7 +3281,7 @@ for first matching file."
(while filenames
(setq filename (car filenames)
filenames (cdr filenames))
- (if (and (string-match "^/" filename)
+ (if (and (file-name-absolute-p filename)
(file-exists-p filename))
(setq d (file-name-directory filename)
f (file-name-nondirectory filename)
@@ -3685,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)))
@@ -3742,7 +3764,11 @@ This is to make them appear as if they were \"virtual buffers\"."
ido-enable-flex-matching
(> (length ido-text) 1)
(not ido-enable-regexp))
- (setq re (mapconcat #'regexp-quote (split-string ido-text "") ".*"))
+ (setq re (concat (regexp-quote (string (aref ido-text 0)))
+ (mapconcat (lambda (c)
+ (concat "[^" (string c) "]*"
+ (regexp-quote (string c))))
+ (substring ido-text 1) "")))
(if ido-enable-prefix
(setq re (concat "\\`" re)))
(mapc
@@ -3837,8 +3863,9 @@ This is to make them appear as if they were \"virtual buffers\"."
(defun ido-choose-completion-string (choice &rest ignored)
(when (ido-active)
;; Insert the completion into the buffer where completion was requested.
- (if (get-buffer ido-completion-buffer)
- (kill-buffer ido-completion-buffer))
+ (and ido-completion-buffer
+ (get-buffer ido-completion-buffer)
+ (kill-buffer ido-completion-buffer))
(cond
((ido-active t) ;; ido-use-merged-list
(setq ido-current-directory ""
@@ -3857,7 +3884,8 @@ This is to make them appear as if they were \"virtual buffers\"."
"Show possible completions in a *File Completions* buffer."
(interactive)
(setq ido-rescan nil)
- (let ((temp-buf (get-buffer ido-completion-buffer))
+ (let ((temp-buf (and ido-completion-buffer
+ (get-buffer ido-completion-buffer)))
display-it full-list)
(if (and (eq last-command this-command) temp-buf)
;; scroll buffer
@@ -3876,7 +3904,7 @@ This is to make them appear as if they were \"virtual buffers\"."
(scroll-other-window))
(set-buffer buf))
(setq display-it t))
- (if display-it
+ (if (and ido-completion-buffer display-it)
(with-output-to-temp-buffer ido-completion-buffer
(let ((completion-list (sort
(cond
@@ -4041,8 +4069,7 @@ their normal keybindings, except for the following: \\<ido-buffer-completion-map
RET Select the buffer at the front of the list of matches. If the
list is empty, possibly prompt to create new buffer.
-\\[ido-select-text] Select the current prompt as the buffer.
-If no buffer is found, prompt for a new one.
+\\[ido-select-text] Use the current input string verbatim.
\\[ido-next-match] Put the first element at the end of the list.
\\[ido-prev-match] Put the last element at the start of the list.
@@ -4128,8 +4155,7 @@ except for the following: \\<ido-file-completion-map>
RET Select the file at the front of the list of matches. If the
list is empty, possibly prompt to create new file.
-\\[ido-select-text] Select the current prompt as the buffer or file.
-If no buffer or file is found, prompt for a new one.
+\\[ido-select-text] Use the current input string verbatim.
\\[ido-next-match] Put the first element at the end of the list.
\\[ido-prev-match] Put the last element at the start of the list.
@@ -4137,6 +4163,7 @@ If no buffer or file is found, prompt for a new one.
matches all files. If there is only one match, select that file.
If there is no common suffix, show a list of all matching files
in a separate window.
+\\[ido-magic-delete-char] Open the specified directory in Dired mode.
\\[ido-edit-input] Edit input string (including directory).
\\[ido-prev-work-directory] or \\[ido-next-work-directory] go to previous/next directory in work directory history.
\\[ido-merge-work-directories] search for file in the work directory history.
@@ -4148,7 +4175,6 @@ in a separate window.
\\[ido-toggle-regexp] Toggle regexp searching.
\\[ido-toggle-prefix] Toggle between substring and prefix matching.
\\[ido-toggle-case] Toggle case-sensitive searching of file names.
-\\[ido-toggle-vc] Toggle version control for this file.
\\[ido-toggle-literal] Toggle literal reading of this file.
\\[ido-completion-help] Show list of matching files in separate window.
\\[ido-toggle-ignore] Toggle ignoring files listed in `ido-ignore-files'."
diff --git a/lisp/ielm.el b/lisp/ielm.el
index 94bb299eaac..ba05bbcfc0f 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -1,6 +1,6 @@
;;; ielm.el --- interaction mode for Emacs Lisp
-;; Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: David Smith <maa036@lancaster.ac.uk>
;; Maintainer: FSF
@@ -59,7 +59,7 @@ override the read-only-ness of IELM prompts is to call
`comint-kill-whole-line' or `comint-kill-region' with no
narrowing in effect. This way you will be certain that none of
the remaining prompts will be accidentally messed up. You may
-wish to put something like the following in your `.emacs' file:
+wish to put something like the following in your init file:
\(add-hook 'ielm-mode-hook
(lambda ()
diff --git a/lisp/iimage.el b/lisp/iimage.el
index 61347c5024c..a6180b263c7 100644
--- a/lisp/iimage.el
+++ b/lisp/iimage.el
@@ -1,6 +1,6 @@
;;; iimage.el --- Inline image minor mode.
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: KOSEKI Yoshinori <kose@meadowy.org>
;; Maintainer: KOSEKI Yoshinori <kose@meadowy.org>
@@ -137,8 +137,7 @@ Examples of image filename patterns to match:
'(display modification-hooks))))))))))
;;;###autoload
-(define-minor-mode iimage-mode
- "Toggle inline image minor mode."
+(define-minor-mode iimage-mode nil
:group 'iimage :lighter " iImg" :keymap iimage-mode-map
(iimage-mode-buffer iimage-mode))
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 4a164dfaa42..77c968b21ae 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -1,6 +1,6 @@
;;; image-dired.el --- use dired to browse and manipulate your images
;;
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;;
;; Version: 0.4.11
;; Keywords: multimedia
@@ -157,7 +157,7 @@
(require 'widget)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'wid-edit))
(defgroup image-dired nil
@@ -602,14 +602,14 @@ according to the Thumbnail Managing Standard."
(md5 (file-name-as-directory (file-name-directory f)))))
(format "%s%s%s.thumb.%s"
(file-name-as-directory (expand-file-name (image-dired-dir)))
- (file-name-sans-extension (file-name-nondirectory f))
+ (file-name-base f)
(if md5-hash (concat "_" md5-hash) "")
(file-name-extension f))))
((eq 'per-directory image-dired-thumbnail-storage)
(let ((f (expand-file-name file)))
(format "%s.image-dired/%s.thumb.%s"
(file-name-directory f)
- (file-name-sans-extension (file-name-nondirectory f))
+ (file-name-base f)
(file-name-extension f))))))
(defun image-dired-create-thumb (original-file thumbnail-file)
@@ -653,21 +653,24 @@ previous -ARG, if ARG<0) files."
(image-file (dired-get-filename nil t))
thumb-file
overlay)
- (when (and image-file (string-match-p (image-file-name-regexp) image-file))
+ (when (and image-file
+ (string-match-p (image-file-name-regexp) image-file))
(setq thumb-file (image-dired-get-thumbnail-image image-file))
;; If image is not already added, then add it.
(let ((cur-ov (overlays-in (point) (1+ (point)))))
(if cur-ov
(delete-overlay (car cur-ov))
(put-image thumb-file image-pos)
- (setq overlay (loop for o in (overlays-in (point) (1+ (point)))
- when (overlay-get o 'put-image) collect o into ov
- finally return (car ov)))
+ (setq overlay
+ (cl-loop for o in (overlays-in (point) (1+ (point)))
+ when (overlay-get o 'put-image) collect o into ov
+ finally return (car ov)))
(overlay-put overlay 'image-file image-file)
(overlay-put overlay 'thumb-file thumb-file)))))
arg ; Show or hide image on ARG next files.
'show-progress) ; Update dired display after each image is updated.
- (add-hook 'dired-after-readin-hook 'image-dired-dired-after-readin-hook nil t))
+ (add-hook 'dired-after-readin-hook
+ 'image-dired-dired-after-readin-hook nil t))
(defun image-dired-dired-after-readin-hook ()
"Relocate existing thumbnail overlays in dired buffer after reverting.
@@ -2451,6 +2454,8 @@ when using per-directory thumbnail file storage"))
(defvar image-dired-widget-list nil
"List to keep track of meta data in edit buffer.")
+(declare-function widget-forward "wid-edit" (arg))
+
;;;###autoload
(defun image-dired-dired-edit-comment-and-tags ()
"Edit comment and tags of current or marked image files.
diff --git a/lisp/image-file.el b/lisp/image-file.el
index 52012b12a56..efbbfcb03b0 100644
--- a/lisp/image-file.el
+++ b/lisp/image-file.el
@@ -1,6 +1,6 @@
;;; image-file.el --- support for visiting image files
;;
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: multimedia
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index f3e7caab174..0e91567a29a 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -1,6 +1,6 @@
-;;; image-mode.el --- support for visiting image files
+;;; image-mode.el --- support for visiting image files -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;;
;; Author: Richard Stallman <rms@gnu.org>
;; Keywords: multimedia
@@ -31,15 +31,19 @@
;; 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)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; 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
@@ -70,12 +78,11 @@ A winprops object has the shape (WINDOW . ALIST)."
winprops))
(defun image-mode-window-get (prop &optional winprops)
+ (declare (gv-setter (lambda (val)
+ `(image-mode-window-put ,prop ,val ,winprops))))
(unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
(cdr (assq prop (cdr winprops))))
-(defsetf image-mode-window-get (prop &optional winprops) (val)
- `(image-mode-window-put ,prop ,val ,winprops))
-
(defun image-mode-window-put (prop val &optional winprops)
(unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
(setcdr winprops (cons (cons prop val)
@@ -482,7 +489,7 @@ Remove text properties that display the image."
"Show the image of the image file.
Turn the image data into a real image, but only if the whole file
was inserted."
- (unless (derived-mode-p 'image-mode major-mode)
+ (unless (derived-mode-p 'image-mode)
(error "The buffer is not in Image mode"))
(let* ((filename (buffer-file-name))
(data-p (not (and filename
@@ -532,6 +539,7 @@ was inserted."
(setq image-type type)
(if (eq major-mode 'image-mode)
(setq mode-name (format "Image[%s]" type)))
+ (image-transform-check-size)
(if (called-interactively-p 'any)
(message "Repeat this command to go back to displaying the file as text"))))
@@ -557,13 +565,15 @@ the image by calling `image-mode'."
;;; Animated images
(defcustom image-animate-loop nil
- "Whether to play animated images on a loop in Image mode."
+ "Non-nil means animated images loop forever, rather than playing once."
:type 'boolean
:version "24.1"
:group 'image)
(defun image-toggle-animation ()
- "Start or stop animating the current image."
+ "Start or stop animating the current image.
+If `image-animate-loop' is non-nil, animation loops forever.
+Otherwise it plays once, then stops."
(interactive)
(let ((image (image-get-display-property))
animation)
@@ -605,33 +615,157 @@ the image by calling `image-mode'."
(image-toggle-display))))
-(defvar image-transform-minor-mode-map
- (let ((map (make-sparse-keymap)))
- ;; (define-key map [(control ?+)] 'image-scale-in)
- ;; (define-key map [(control ?-)] 'image-scale-out)
- ;; (define-key map [(control ?=)] 'image-scale-none)
- ;; (define-key map "c f h" 'image-scale-fit-height)
- ;; (define-key map "c ]" 'image-rotate-right)
- map)
- "Minor mode keymap `image-transform-mode'.")
+;; Not yet implemented.
+;; (defvar image-transform-minor-mode-map
+;; (let ((map (make-sparse-keymap)))
+;; ;; (define-key map [(control ?+)] 'image-scale-in)
+;; ;; (define-key map [(control ?-)] 'image-scale-out)
+;; ;; (define-key map [(control ?=)] 'image-scale-none)
+;; ;; (define-key map "c f h" 'image-scale-fit-height)
+;; ;; (define-key map "c ]" 'image-rotate-right)
+;; map)
+;; "Minor mode keymap `image-transform-mode'.")
+;;
+;; (define-minor-mode image-transform-mode
+;; "Minor mode for scaling and rotating images.
+;; With a prefix argument ARG, enable the mode if ARG is positive,
+;; and disable it otherwise. If called from Lisp, enable the mode
+;; if ARG is omitted or nil. This minor mode requires Emacs to have
+;; been compiled with ImageMagick support."
+;; nil "image-transform" image-transform-minor-mode-map)
-(define-minor-mode image-transform-mode
- "Minor mode for scaling and rotating images.
-This minor mode has no effect unless Emacs is compiled with
-ImageMagick support."
- nil "image-transform" image-transform-minor-mode-map)
+;; FIXME this doesn't seem mature yet. Document in manual when it is.
(defvar image-transform-resize nil
"The image resize operation.
Its value should be one of the following:
- nil, meaning no resizing.
- `fit-height', meaning to fit the image to the window height.
- `fit-width', meaning to fit the image to the window width.
- - A number, which is a scale factor (the default size is 100).")
+ - A number, which is a scale factor (the default size is 1).")
+
+(defvar image-transform-scale 1.0
+ "The scale factor of the image being displayed.")
(defvar image-transform-rotation 0.0
"Rotation angle for the image in the current Image mode buffer.")
+(defvar image-transform-right-angle-fudge 0.0001
+ "Snap distance to a multiple of a right angle.
+There's no deep theory behind the default value, it should just
+be somewhat larger than ImageMagick's MagickEpsilon.")
+
+(defsubst image-transform-width (width height)
+ "Return the bounding box width of a rotated WIDTH x HEIGHT rectangle.
+The rotation angle is the value of `image-transform-rotation' in degrees."
+ (let ((angle (degrees-to-radians image-transform-rotation)))
+ ;; Assume, w.l.o.g., that the vertices of the rectangle have the
+ ;; coordinates (+-w/2, +-h/2) and that (0, 0) is the center of the
+ ;; rotation by the angle A. The projections onto the first axis
+ ;; of the vertices of the rotated rectangle are +- (w/2) cos A +-
+ ;; (h/2) sin A, and the difference between the largest and the
+ ;; smallest of the four values is the expression below.
+ (+ (* width (abs (cos angle))) (* height (abs (sin angle))))))
+
+;; The following comment and code snippet are from
+;; ImageMagick-6.7.4-4/magick/distort.c
+
+;; /* Set the output image geometry to calculated 'best fit'.
+;; Yes this tends to 'over do' the file image size, ON PURPOSE!
+;; Do not do this for DePolar which needs to be exact for virtual tiling.
+;; */
+;; if ( fix_bounds ) {
+;; geometry.x = (ssize_t) floor(min.x-0.5);
+;; geometry.y = (ssize_t) floor(min.y-0.5);
+;; geometry.width=(size_t) ceil(max.x-geometry.x+0.5);
+;; geometry.height=(size_t) ceil(max.y-geometry.y+0.5);
+;; }
+
+;; Other parts of the same file show that here the origin is in the
+;; left lower corner of the image rectangle, the center of the
+;; rotation is the center of the rectangle and min.x and max.x
+;; (resp. min.y and max.y) are the smallest and the largest of the
+;; projections of the vertices onto the first (resp. second) axis.
+
+(defun image-transform-fit-width (width height length)
+ "Return (w . h) so that a rotated w x h image has exactly width LENGTH.
+The rotation angle is the value of `image-transform-rotation'.
+Write W for WIDTH and H for HEIGHT. Then the w x h rectangle is
+an \"approximately uniformly\" scaled W x H rectangle, which
+currently means that w is one of floor(s W) + {0, 1, -1} and h is
+floor(s H), where s can be recovered as the value of `image-transform-scale'.
+The value of `image-transform-rotation' may be replaced by
+a slightly different angle. Currently this is done for values
+close to a multiple of 90, see `image-transform-right-angle-fudge'."
+ (cond ((< (abs (- (mod (+ image-transform-rotation 90) 180) 90))
+ image-transform-right-angle-fudge)
+ (cl-assert (not (zerop width)) t)
+ (setq image-transform-rotation
+ (float (round image-transform-rotation))
+ image-transform-scale (/ (float length) width))
+ (cons length nil))
+ ((< (abs (- (mod (+ image-transform-rotation 45) 90) 45))
+ image-transform-right-angle-fudge)
+ (cl-assert (not (zerop height)) t)
+ (setq image-transform-rotation
+ (float (round image-transform-rotation))
+ image-transform-scale (/ (float length) height))
+ (cons nil length))
+ (t
+ (cl-assert (not (and (zerop width) (zerop height))) t)
+ (setq image-transform-scale
+ (/ (float (1- length)) (image-transform-width width height)))
+ ;; Assume we have a w x h image and an angle A, and let l =
+ ;; l(w, h) = w |cos A| + h |sin A|, which is the actual width
+ ;; of the bounding box of the rotated image, as calculated by
+ ;; `image-transform-width'. The code snippet quoted above
+ ;; means that ImageMagick puts the rotated image in
+ ;; a bounding box of width L = 2 ceil((w+l+1)/2) - w.
+ ;; Elementary considerations show that this is equivalent to
+ ;; L - w being even and L-3 < l(w, h) <= L-1. In our case, L is
+ ;; the given `length' parameter and our job is to determine
+ ;; reasonable values for w and h which satisfy these
+ ;; conditions.
+ (let ((w (floor (* image-transform-scale width)))
+ (h (floor (* image-transform-scale height))))
+ ;; Let w and h as bound above. Then l(w, h) <= l(s W, s H)
+ ;; = L-1 < l(w+1, h+1) = l(w, h) + l(1, 1) <= l(w, h) + 2,
+ ;; hence l(w, h) > (L-1) - 2 = L-3.
+ (cons
+ (cond ((= (mod w 2) (mod length 2))
+ w)
+ ;; l(w+1, h) >= l(w, h) > L-3, but does l(w+1, h) <=
+ ;; L-1 hold?
+ ((<= (image-transform-width (1+ w) h) (1- length))
+ (1+ w))
+ ;; No, it doesn't, but this implies that l(w-1, h) =
+ ;; l(w+1, h) - l(2, 0) >= l(w+1, h) - 2 > (L-1) -
+ ;; 2 = L-3. Clearly, l(w-1, h) <= l(w, h) <= L-1.
+ (t
+ (1- w)))
+ h)))))
+
+(defun image-transform-check-size ()
+ "Check that the image exactly fits the width/height of the window.
+
+Do this for an image of type `imagemagick' to make sure that the
+elisp code matches the way ImageMagick computes the bounding box
+of a rotated image."
+ (when (and (not (numberp image-transform-resize))
+ (boundp 'image-type)
+ (eq image-type 'imagemagick))
+ (let ((size (image-display-size (image-get-display-property) t)))
+ (cond ((eq image-transform-resize 'fit-width)
+ (cl-assert (= (car size)
+ (- (nth 2 (window-inside-pixel-edges))
+ (nth 0 (window-inside-pixel-edges))))
+ t))
+ ((eq image-transform-resize 'fit-height)
+ (cl-assert (= (cdr size)
+ (- (nth 3 (window-inside-pixel-edges))
+ (nth 1 (window-inside-pixel-edges))))
+ t))))))
+
(defun image-transform-properties (spec)
"Return rescaling/rotation properties for image SPEC.
These properties are determined by the Image mode variables
@@ -640,27 +774,35 @@ return value is suitable for appending to an image spec.
Rescaling and rotation properties only take effect if Emacs is
compiled with ImageMagick support."
+ (setq image-transform-scale 1.0)
(when (or image-transform-resize
- (not (equal image-transform-rotation 0.0)))
+ (/= image-transform-rotation 0.0))
;; Note: `image-size' looks up and thus caches the untransformed
;; image. There's no easy way to prevent that.
(let* ((size (image-size spec t))
- (height
+ (resized
(cond
((numberp image-transform-resize)
- (unless (= image-transform-resize 100)
- (* image-transform-resize (cdr size))))
+ (unless (= image-transform-resize 1)
+ (setq image-transform-scale image-transform-resize)
+ (cons nil (floor (* image-transform-resize (cdr size))))))
+ ((eq image-transform-resize 'fit-width)
+ (image-transform-fit-width
+ (car size) (cdr size)
+ (- (nth 2 (window-inside-pixel-edges))
+ (nth 0 (window-inside-pixel-edges)))))
((eq image-transform-resize 'fit-height)
- (- (nth 3 (window-inside-pixel-edges))
- (nth 1 (window-inside-pixel-edges))))))
- (width (if (eq image-transform-resize 'fit-width)
- (- (nth 2 (window-inside-pixel-edges))
- (nth 0 (window-inside-pixel-edges))))))
- ;;TODO fit-to-* should consider the rotation angle
- `(,@(if height (list :height height))
- ,@(if width (list :width width))
- ,@(if (not (equal 0.0 image-transform-rotation))
- (list :rotation image-transform-rotation))))))
+ (let ((res (image-transform-fit-width
+ (cdr size) (car size)
+ (- (nth 3 (window-inside-pixel-edges))
+ (nth 1 (window-inside-pixel-edges))))))
+ (cons (cdr res) (car res)))))))
+ `(,@(when (car resized)
+ (list :width (car resized)))
+ ,@(when (cdr resized)
+ (list :height (cdr resized)))
+ ,@(unless (= 0.0 image-transform-rotation)
+ (list :rotation image-transform-rotation))))))
(defun image-transform-set-scale (scale)
"Prompt for a number, and resize the current image by that amount.
@@ -691,9 +833,7 @@ ImageMagick support."
ROTATION should be in degrees. This command has no effect unless
Emacs is compiled with ImageMagick support."
(interactive "nRotation angle (in degrees): ")
- ;;TODO 0 90 180 270 degrees are the only reasonable angles here
- ;;otherwise combining with rescaling will get very awkward
- (setq image-transform-rotation (float rotation))
+ (setq image-transform-rotation (float (mod rotation 360)))
(image-toggle-display-image))
(provide 'image-mode)
diff --git a/lisp/image.el b/lisp/image.el
index c150f4239dd..27bbc2c08d6 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1,6 +1,6 @@
;;; image.el --- image API
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: multimedia
@@ -163,7 +163,7 @@ compatibility with versions of Emacs that lack the variable
dir (expand-file-name "../" dir))))
(setq image-directory-load-path dir))
- ;; If `image-directory-load-path' isn't Emacs' image directory,
+ ;; If `image-directory-load-path' isn't Emacs's image directory,
;; it's probably a user preference, so use it. Then use a
;; relative setting if possible; otherwise, use
;; `image-directory-load-path'.
@@ -194,7 +194,7 @@ compatibility with versions of Emacs that lack the variable
;; Set it to nil if image is not found.
(cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
((file-exists-p (expand-file-name image d1ei)) d1ei)))))
- ;; Use Emacs' image directory.
+ ;; Use Emacs's image directory.
(image-directory-load-path
(setq image-directory image-directory-load-path))
(no-error
@@ -207,6 +207,8 @@ compatibility with versions of Emacs that lack the variable
(delete image-directory (copy-sequence (or path load-path))))))
+;; Used to be in image-type-header-regexps, but now not used anywhere
+;; (since 2009-08-28).
(defun image-jpeg-p (data)
"Value is non-nil if DATA, a string, consists of JFIF image data.
We accept the tag Exif because that is the same format."
@@ -280,7 +282,9 @@ be determined."
types nil)
(setq types (cdr types)))))
(goto-char opoint)
- type))
+ (and type
+ (memq type image-types)
+ type)))
;;;###autoload
@@ -304,8 +308,14 @@ be determined."
"Determine the type of image file FILE from its name.
Value is a symbol specifying the image type, or nil if type cannot
be determined."
- (assoc-default file image-type-file-name-regexps 'string-match-p))
-
+ (let (type first)
+ (catch 'found
+ (dolist (elem image-type-file-name-regexps first)
+ (when (string-match-p (car elem) file)
+ (if (image-type-available-p (setq type (cdr elem)))
+ (throw 'found type)
+ ;; If nothing seems to be supported, return first type that matched.
+ (or first (setq first type))))))))
;;;###autoload
(defun image-type (source &optional type data-p)
@@ -329,6 +339,10 @@ Optional DATA-P non-nil means SOURCE is a string containing image data."
type)
+(if (fboundp 'image-metadata) ; eg not --without-x
+ (define-obsolete-function-alias 'image-extension-data
+ 'image-metadata' "24.1"))
+
(define-obsolete-variable-alias
'image-library-alist
'dynamic-library-alist "24.1")
@@ -338,7 +352,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
@@ -406,7 +420,8 @@ means display it in the right marginal area."
(prop (if (null area) image (list (list 'margin area) image))))
(put-text-property 0 (length string) 'display prop string)
(overlay-put overlay 'put-image t)
- (overlay-put overlay 'before-string string))))
+ (overlay-put overlay 'before-string string)
+ overlay)))
;;;###autoload
@@ -414,7 +429,7 @@ means display it in the right marginal area."
"Insert IMAGE into current buffer at point.
IMAGE is displayed by inserting STRING into the current buffer
with a `display' property whose value is the image. STRING
-defaults to the empty string if you omit it.
+defaults to a single space if you omit it.
AREA is where to display the image. AREA nil or omitted means
display it in the text area, a value of `left-margin' means
display it in the left marginal area, a value of `right-margin'
@@ -452,8 +467,8 @@ height of the image; integer values are taken as pixel values."
(defun insert-sliced-image (image &optional string area rows cols)
"Insert IMAGE into current buffer at point.
IMAGE is displayed by inserting STRING into the current buffer
-with a `display' property whose value is the image. STRING is
-defaulted if you omit it.
+with a `display' property whose value is the image. The default
+STRING is a single space.
AREA is where to display the image. AREA nil or omitted means
display it in the text area, a value of `left-margin' means
display it in the left marginal area, a value of `right-margin'
@@ -595,13 +610,15 @@ Example:
"List of supported animated image types.")
(defun image-animated-p (image)
- "Return non-nil if image can be animated.
-Actually, the return value is a cons (NIMAGES . DELAY), where
-NIMAGES is the number of sub-images in the animated image and
-DELAY is the delay in second until the next sub-image shall be
-displayed."
+ "Return non-nil if IMAGE can be animated.
+To be capable of being animated, an image must be of a type
+listed in `image-animated-types', and contain more than one
+sub-image, with a specified animation delay. The actual return
+value is a cons (NIMAGES . DELAY), where NIMAGES is the number
+of sub-images in the animated image and DELAY is the delay in
+seconds until the next sub-image should be displayed."
(cond
- ((eq (plist-get (cdr image) :type) 'gif)
+ ((memq (plist-get (cdr image) :type) image-animated-types)
(let* ((metadata (image-metadata image))
(images (plist-get metadata 'count))
(delay (plist-get metadata 'delay)))
@@ -609,6 +626,7 @@ displayed."
(if (< delay 0) (setq delay 0.1))
(cons images delay))))))
+;; "Destructively"?
(defun image-animate (image &optional index limit)
"Start animating IMAGE.
Animation occurs by destructively altering the IMAGE spec list.
@@ -633,22 +651,26 @@ number, play until that number of seconds has elapsed."
(while tail
(setq timer (car tail)
tail (cdr tail))
- (if (and (eq (aref timer 5) 'image-animate-timeout)
- (eq (car-safe (aref timer 6)) image))
+ (if (and (eq (timer--function timer) 'image-animate-timeout)
+ (eq (car-safe (timer--args timer)) image))
(setq tail nil)
(setq timer nil)))
timer))
+;; FIXME? The delay may not be the same for different sub-images,
+;; hence we need to call image-animated-p to return it.
+;; But it also returns count, so why do we bother passing that as an
+;; argument?
(defun image-animate-timeout (image n count time-elapsed limit)
"Display animation frame N of IMAGE.
N=0 refers to the initial animation frame.
COUNT is the total number of frames in the animation.
-DELAY is the time between animation frames, in seconds.
TIME-ELAPSED is the total time that has elapsed since
`image-animate-start' was called.
LIMIT determines when to stop. If t, loop forever. If nil, stop
after displaying the last animation frame. Otherwise, stop
- after LIMIT seconds have elapsed."
+ after LIMIT seconds have elapsed.
+The minimum delay between successive frames is 0.01s."
(plist-put (cdr image) :index n)
(force-window-update)
(setq n (1+ n))
@@ -671,38 +693,135 @@ LIMIT determines when to stop. If t, loop forever. If nil, stop
image n count time-elapsed limit))))
-(defcustom imagemagick-types-inhibit
- '(C HTML HTM TXT PDF)
- "ImageMagick types that Emacs should not use ImageMagick to handle.
-This should be a list of symbols, each of which has the same
-names as one of the format tags used internally by ImageMagick;
-see `imagemagick-types'. Entries in this list are excluded from
-being registered by `imagemagick-register-types'.
-
-If Emacs is compiled without ImageMagick, this variable has no effect."
- :type '(choice (const :tag "Let ImageMagick handle all types it can" nil)
- (repeat symbol))
- :version "24.1"
- :group 'image)
+(defvar imagemagick-types-inhibit)
+(defvar imagemagick-enabled-types)
+
+(defun imagemagick-filter-types ()
+ "Return a list of the ImageMagick types to be treated as images, or nil.
+This is the result of `imagemagick-types', including only elements
+that match `imagemagick-enabled-types' and do not match
+`imagemagick-types-inhibit'."
+ (when (fboundp 'imagemagick-types)
+ (cond ((null imagemagick-enabled-types) nil)
+ ((eq imagemagick-types-inhibit t) nil)
+ (t
+ (delq nil
+ (mapcar
+ (lambda (type)
+ (unless (memq type imagemagick-types-inhibit)
+ (if (eq imagemagick-enabled-types t) type
+ (catch 'found
+ (dolist (enable imagemagick-enabled-types nil)
+ (if (cond ((symbolp enable) (eq enable type))
+ ((stringp enable)
+ (string-match enable
+ (symbol-name type))))
+ (throw 'found type)))))))
+ (imagemagick-types)))))))
+
+(defvar imagemagick--file-regexp nil
+ "File extension regexp for ImageMagick files, if any.
+This is the extension installed into `auto-mode-alist' and
+`image-type-file-name-regexps' by `imagemagick-register-types'.")
;;;###autoload
(defun imagemagick-register-types ()
"Register file types that can be handled by ImageMagick.
-This adds the file types returned by `imagemagick-types'
-\(excluding the ones in `imagemagick-types-inhibit') to
-`auto-mode-alist' and `image-type-file-name-regexps', so that
-Emacs visits them in Image mode.
+This function is called at startup, after loading the init file.
+It registers the ImageMagick types returned by `imagemagick-filter-types'.
-If Emacs is compiled without ImageMagick support, do nothing."
+Registered image types are added to `auto-mode-alist', so that
+Emacs visits them in Image mode. They are also added to
+`image-type-file-name-regexps', so that the `image-type' function
+recognizes these files as having image type `imagemagick'.
+
+If Emacs is compiled without ImageMagick support, this does nothing."
(when (fboundp 'imagemagick-types)
- (let ((im-types '()))
- (dolist (im-type (imagemagick-types))
- (unless (memq im-type imagemagick-types-inhibit)
- (push (downcase (symbol-name im-type)) im-types)))
- (let ((extension (concat "\\." (regexp-opt im-types) "\\'")))
- (push (cons extension 'image-mode) auto-mode-alist)
- (push (cons extension 'imagemagick)
- image-type-file-name-regexps)))))
+ (let* ((types (mapcar (lambda (type) (downcase (symbol-name type)))
+ (imagemagick-filter-types)))
+ (re (if types (concat "\\." (regexp-opt types) "\\'")))
+ (ama-elt (car (member (cons imagemagick--file-regexp 'image-mode)
+ auto-mode-alist)))
+ (itfnr-elt (car (member (cons imagemagick--file-regexp 'imagemagick)
+ image-type-file-name-regexps))))
+ (if (not re)
+ (setq auto-mode-alist (delete ama-elt auto-mode-alist)
+ image-type-file-name-regexps
+ (delete itfnr-elt image-type-file-name-regexps))
+ (if ama-elt
+ (setcar ama-elt re)
+ (push (cons re 'image-mode) auto-mode-alist))
+ (if itfnr-elt
+ (setcar itfnr-elt re)
+ ;; Append to `image-type-file-name-regexps', so that we
+ ;; preferentially use specialized image libraries.
+ (add-to-list 'image-type-file-name-regexps
+ (cons re 'imagemagick) t)))
+ (setq imagemagick--file-regexp re))))
+
+(defcustom imagemagick-types-inhibit
+ '(C HTML HTM INFO M TXT PDF)
+ "List of ImageMagick types that should never be treated as images.
+This should be a list of symbols, each of which should be one of
+the ImageMagick types listed by `imagemagick-types'. The listed
+image types are not registered by `imagemagick-register-types'.
+
+If the value is t, inhibit the use of ImageMagick for images.
+
+If you change this without using customize, you must call
+`imagemagick-register-types' afterwards.
+
+If Emacs is compiled without ImageMagick support, this variable
+has no effect."
+ :type '(choice (const :tag "Support all ImageMagick types" nil)
+ (const :tag "Disable all ImageMagick types" t)
+ (repeat symbol))
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (imagemagick-register-types))
+ :version "24.3"
+ :group 'image)
+
+(defcustom imagemagick-enabled-types
+ '(3FR ART ARW AVS BMP BMP2 BMP3 CAL CALS CMYK CMYKA CR2 CRW
+ CUR CUT DCM DCR DCX DDS DJVU DNG DPX EXR FAX FITS GBR GIF
+ GIF87 GRB HRZ ICB ICO ICON J2C JNG JP2 JPC JPEG JPG JPX K25
+ KDC MIFF MNG MRW MSL MSVG MTV NEF ORF OTB PBM PCD PCDS PCL
+ PCT PCX PDB PEF PGM PICT PIX PJPEG PNG PNG24 PNG32 PNG8 PNM
+ PPM PSD PTIF PWP RAF RAS RBG RGB RGBA RGBO RLA RLE SCR SCT
+ SFW SGI SR2 SRF SUN SVG SVGZ TGA TIFF TIFF64 TILE TIM TTF
+ UYVY VDA VICAR VID VIFF VST WBMP WPG X3F XBM XC XCF XPM XV
+ XWD YCbCr YCbCrA YUV)
+ "List of ImageMagick types to treat as images.
+Each list element should be a string or symbol, representing one
+of the image types returned by `imagemagick-types'. If the
+element is a string, it is handled as a regexp that enables all
+matching types.
+
+The value of `imagemagick-enabled-types' may also be t, meaning
+to enable all types that ImageMagick supports.
+
+The variable `imagemagick-types-inhibit' overrides this variable.
+
+If you change this without using customize, you must call
+`imagemagick-register-types' afterwards.
+
+If Emacs is compiled without ImageMagick support, this variable
+has no effect."
+ :type '(choice (const :tag "Support all ImageMagick types" t)
+ (const :tag "Disable all ImageMagick types" nil)
+ (repeat :tag "List of types"
+ (choice (symbol :tag "type")
+ (regexp :tag "regexp"))))
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (imagemagick-register-types))
+ :version "24.3"
+ :group 'image)
+
+(imagemagick-register-types)
(provide 'image)
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 6be6b85af8a..1d3da2db15b 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -1,6 +1,6 @@
-;;; imenu.el --- framework for mode-specific buffer indexes
+;;; imenu.el --- framework for mode-specific buffer indexes -*- lexical-binding: t -*-
-;; Copyright (C) 1994-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Ake Stenhoff <etxaksf@aom.ericsson.se>
;; Lars Lindberg <lli@sypro.cap.se>
@@ -59,7 +59,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -187,16 +187,39 @@ with name concatenation."
;;;###autoload
(defvar imenu-generic-expression nil
- "The regex pattern to use for creating a buffer index.
+ "List of definition matchers for creating an Imenu index.
+Each element of this list should have the form
+
+ (MENU-TITLE REGEXP INDEX [FUNCTION] [ARGUMENTS...])
+
+MENU-TITLE should be nil (in which case the matches for this
+element are put in the top level of the buffer index) or a
+string (which specifies the title of a submenu into which the
+matches are put).
+REGEXP is a regular expression matching a definition construct
+which is to be displayed in the menu. REGEXP may also be a
+function, called without arguments. It is expected to search
+backwards. It must return true and set `match-data' if it finds
+another element.
+INDEX is an integer specifying which subexpression of REGEXP
+matches the definition's name; this subexpression is displayed as
+the menu item.
+FUNCTION, if present, specifies a function to call when the index
+item is selected by the user. This function is called with
+arguments consisting of the item name, the buffer position, and
+the ARGUMENTS.
+
+The variable `imenu-case-fold-search' determines whether or not
+the regexp matches are case sensitive, and `imenu-syntax-alist'
+can be used to alter the syntax table for the search.
If non-nil this pattern is passed to `imenu--generic-function' to
-create a buffer index. Look there for the documentation of this
-pattern's structure.
+create a buffer index.
-For example, see the value of `fortran-imenu-generic-expression' used by
-`fortran-mode' with `imenu-syntax-alist' set locally to give the
-characters which normally have \"symbol\" syntax \"word\" syntax
-during matching.")
+For example, see the value of `fortran-imenu-generic-expression'
+used by `fortran-mode' with `imenu-syntax-alist' set locally to
+give the characters which normally have \"symbol\" syntax
+\"word\" syntax during matching.")
;;;###autoload(put 'imenu-generic-expression 'risky-local-variable t)
;;;###autoload
@@ -266,12 +289,12 @@ The function in this variable is called when selecting a normal index-item.")
(and (consp (cdr item)) (listp (cadr item))
(not (eq (car (cadr item)) 'lambda))))
-;; Macro to display a progress message.
-;; RELPOS is the relative position to display.
-;; If RELPOS is nil, then the relative position in the buffer
-;; is calculated.
-;; PREVPOS is the variable in which we store the last position displayed.
-(defmacro imenu-progress-message (prevpos &optional relpos reverse)
+(defmacro imenu-progress-message (_prevpos &optional _relpos _reverse)
+ "Macro to display a progress message.
+RELPOS is the relative position to display.
+If RELPOS is nil, then the relative position in the buffer
+is calculated.
+PREVPOS is the variable in which we store the last position displayed."
;; Made obsolete/empty, as computers are now faster than the eye, and
;; it had problems updating the messages correctly, and could shadow
@@ -280,13 +303,13 @@ The function in this variable is called when selecting a normal index-item.")
;; `(and
;; imenu-scanning-message
;; (let ((pos ,(if relpos
-;; relpos
-;; `(imenu--relative-position ,reverse))))
-;; (if ,(if relpos t
-;; `(> pos (+ 5 ,prevpos)))
-;; (progn
-;; (message imenu-scanning-message pos)
-;; (setq ,prevpos pos)))))
+;; relpos
+;; `(imenu--relative-position ,reverse))))
+;; (if ,(if relpos t
+;; `(> pos (+ 5 ,prevpos)))
+;; (progn
+;; (message imenu-scanning-message pos)
+;; (setq ,prevpos pos)))))
)
@@ -303,6 +326,7 @@ The function in this variable is called when selecting a normal index-item.")
(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
@@ -310,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
@@ -320,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
@@ -330,21 +353,18 @@ 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 '())
- (index-unknown-alist '())
- prev-pos)
+ (index-unknown-alist '()))
(goto-char (point-max))
- (imenu-progress-message prev-pos 0)
;; Search for the function
(while (beginning-of-defun)
- (imenu-progress-message prev-pos nil t)
(save-match-data
(and (looking-at "(def")
(save-excursion
@@ -371,7 +391,6 @@ Don't move point."
(forward-sexp 2)
(push (imenu-example--name-and-position)
index-unknown-alist)))))))
- (imenu-progress-message prev-pos 100)
(and index-var-alist
(push (cons "Variables" index-var-alist)
index-alist))
@@ -382,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
@@ -395,16 +413,15 @@ Don't move point."
))
(defun imenu-example--create-c-index (&optional regexp)
+ (declare (obsolete nil "23.2"))
(let ((index-alist '())
- prev-pos char)
+ char)
(goto-char (point-min))
- (imenu-progress-message prev-pos 0)
;; Search for the function
(save-match-data
(while (re-search-forward
(or regexp imenu-example--function-name-regexp-c)
nil t)
- (imenu-progress-message prev-pos)
(backward-up-list 1)
(save-excursion
(goto-char (scan-sexps (point) 1))
@@ -412,9 +429,7 @@ Don't move point."
;; Skip this function name if it is a prototype declaration.
(if (not (eq char ?\;))
(push (imenu-example--name-and-position) index-alist))))
- (imenu-progress-message prev-pos 100)
(nreverse index-alist)))
-(make-obsolete 'imenu-example--create-c-index "your own" "23.2")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -426,8 +441,7 @@ Don't move point."
(defconst imenu--rescan-item '("*Rescan*" . -99))
;; The latest buffer index.
-;; Buffer local.
-(defvar imenu--index-alist nil
+(defvar-local imenu--index-alist nil
"The buffer index alist computed for this buffer in Imenu.
Simple elements in the alist look like (INDEX-NAME . POSITION).
@@ -446,16 +460,12 @@ There is one simple element with negative POSITION; selecting that
element recalculates the buffer's index alist.")
;;;###autoload(put 'imenu--index-alist 'risky-local-variable t)
-(make-variable-buffer-local 'imenu--index-alist)
-
-(defvar imenu--last-menubar-index-alist nil
+(defvar-local imenu--last-menubar-index-alist nil
"The latest buffer index alist used to update the menu bar menu.")
-(make-variable-buffer-local 'imenu--last-menubar-index-alist)
-
-;; History list for 'jump-to-function-in-buffer'.
-;; Making this buffer local caused it not to work!
-(defvar imenu--history-list nil)
+(defvar imenu--history-list nil
+ ;; Making this buffer local caused it not to work!
+ "History list for 'jump-to-function-in-buffer'.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -463,21 +473,18 @@ element recalculates the buffer's index alist.")
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Sort function
-;;; Sorts the items depending on their index name.
-;;; An item looks like (NAME . POSITION).
-;;;
(defun imenu--sort-by-name (item1 item2)
+ "Comparison function to sort items depending on their index name.
+An item looks like (NAME . POSITION)."
(string-lessp (car item1) (car item2)))
(defun imenu--sort-by-position (item1 item2)
(< (cdr item1) (cdr item2)))
(defun imenu--relative-position (&optional reverse)
- ;; Support function to calculate relative position in buffer
- ;; Beginning of buffer is 0 and end of buffer is 100
- ;; If REVERSE is non-nil then the beginning is 100 and the end is 0.
+ "Support function to calculate relative position in buffer.
+Beginning of buffer is 0 and end of buffer is 100
+If REVERSE is non-nil then the beginning is 100 and the end is 0."
(let ((pos (point))
(total (buffer-size)))
(and reverse (setq pos (- total pos)))
@@ -486,18 +493,17 @@ element recalculates the buffer's index alist.")
(/ (1- pos) (max (/ total 100) 1))
(/ (* 100 (1- pos)) (max total 1)))))
-;; Split LIST into sublists of max length N.
-;; Example (imenu--split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8))
-;;
-;; The returned list DOES NOT share structure with LIST.
(defun imenu--split (list n)
+ "Split LIST into sublists of max length N.
+Example (imenu--split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8))
+The returned list DOES NOT share structure with LIST."
(let ((remain list)
(result '())
(sublist '())
(i 0))
(while remain
(push (pop remain) sublist)
- (incf i)
+ (cl-incf i)
(and (= i n)
;; We have finished a sublist
(progn (push (nreverse sublist) result)
@@ -509,20 +515,18 @@ element recalculates the buffer's index alist.")
(push (nreverse sublist) result))
(nreverse result)))
-;;; Split the alist MENULIST into a nested alist, if it is long enough.
-;;; In any case, add TITLE to the front of the alist.
-;;; If IMENU--RESCAN-ITEM is present in MENULIST, it is moved to the
-;;; beginning of the returned alist.
-;;;
-;;; The returned alist DOES NOT share structure with MENULIST.
(defun imenu--split-menu (menulist title)
+ "Split the alist MENULIST into a nested alist, if it is long enough.
+In any case, add TITLE to the front of the alist.
+If IMENU--RESCAN-ITEM is present in MENULIST, it is moved to the
+beginning of the returned alist.
+The returned alist DOES NOT share structure with MENULIST."
(let ((menulist (copy-sequence menulist))
- keep-at-top tail)
+ keep-at-top)
(if (memq imenu--rescan-item menulist)
(setq keep-at-top (list imenu--rescan-item)
menulist (delq imenu--rescan-item menulist)))
- (setq tail menulist)
- (dolist (item tail)
+ (dolist (item menulist)
(when (imenu--subalist-p item)
(push item keep-at-top)
(setq menulist (delq item menulist))))
@@ -537,32 +541,26 @@ element recalculates the buffer's index alist.")
(cons title
(nconc (nreverse keep-at-top) menulist))))
-;;; Split up each long alist that are nested within ALIST
-;;; into nested alists.
-;;;
-;;; Return a split and sorted copy of ALIST. The returned alist DOES
-;;; NOT share structure with ALIST.
(defun imenu--split-submenus (alist)
- (mapcar (function
- (lambda (elt)
- (if (and (consp elt)
- (stringp (car elt))
- (listp (cdr elt)))
- (imenu--split-menu (cdr elt) (car elt))
- elt)))
+ "Split up each long alist that are nested within ALIST into nested alists.
+Return a split and sorted copy of ALIST. The returned alist DOES
+NOT share structure with ALIST."
+ (mapcar (lambda (elt)
+ (if (imenu--subalist-p elt)
+ (imenu--split-menu (cdr elt) (car elt))
+ elt))
alist))
-;;; Truncate all strings in MENULIST to imenu-max-item-length
(defun imenu--truncate-items (menulist)
- (mapcar (function
- (lambda (item)
- (cond
- ((consp (cdr item))
- (imenu--truncate-items (cdr item)))
- ;; truncate if necessary
- ((and (numberp imenu-max-item-length)
- (> (length (car item)) imenu-max-item-length))
- (setcar item (substring (car item) 0 imenu-max-item-length))))))
+ "Truncate all strings in MENULIST to `imenu-max-item-length'."
+ (mapcar (lambda (item)
+ (cond
+ ((consp (cdr item))
+ (imenu--truncate-items (cdr item)))
+ ;; truncate if necessary
+ ((and (numberp imenu-max-item-length)
+ (> (length (car item)) imenu-max-item-length))
+ (setcar item (substring (car item) 0 imenu-max-item-length)))))
menulist))
@@ -586,19 +584,18 @@ See `imenu--index-alist' for the format of the index alist."
(funcall imenu-create-index-function))))
(imenu--truncate-items imenu--index-alist)))
(or imenu--index-alist noerror
- (error "No items suitable for an index found in this buffer"))
+ (user-error "No items suitable for an index found in this buffer"))
(or imenu--index-alist
(setq imenu--index-alist (list nil)))
;; Add a rescan option to the index.
(cons imenu--rescan-item imenu--index-alist))
-;;; Find all markers in alist and makes
-;;; them point nowhere.
-;;; The top-level call uses nil as the argument;
-;;; non-nil arguments are in recursive calls.
-(defvar imenu--cleanup-seen)
+(defvar imenu--cleanup-seen nil)
(defun imenu--cleanup (&optional alist)
+ "Find all markers in ALIST and make them point nowhere.
+If ALIST is nil (the normal case), use `imenu--index-alist'.
+Non-nil arguments are in recursive calls."
;; If alist is provided use that list.
;; If not, empty the table of lists already seen
;; and use imenu--index-alist.
@@ -606,31 +603,27 @@ See `imenu--index-alist' for the format of the index alist."
(setq imenu--cleanup-seen (cons alist imenu--cleanup-seen))
(setq alist imenu--index-alist imenu--cleanup-seen (list alist)))
- (and alist
- (mapc
- (lambda (item)
- (cond
- ((markerp (cdr item))
- (set-marker (cdr item) nil))
- ;; Don't process one alist twice.
- ((memq (cdr item) imenu--cleanup-seen))
- ((imenu--subalist-p item)
- (imenu--cleanup (cdr item)))))
- alist)
- t))
+ (when alist
+ (dolist (item alist)
+ (cond
+ ((markerp (cdr item)) (set-marker (cdr item) nil))
+ ;; Don't process one alist twice.
+ ((memq (cdr item) imenu--cleanup-seen))
+ ((imenu--subalist-p item) (imenu--cleanup (cdr item)))))
+ t))
(defun imenu--create-keymap (title alist &optional cmd)
- (list* 'keymap title
- (mapcar
- (lambda (item)
- (list* (car item) (car item)
- (cond
- ((imenu--subalist-p item)
- (imenu--create-keymap (car item) (cdr item) cmd))
- (t
- `(lambda () (interactive)
- ,(if cmd `(,cmd ',item) (list 'quote item)))))))
- alist)))
+ `(keymap ,title
+ ,@(mapcar
+ (lambda (item)
+ `(,(car item) ,(car item)
+ ,@(cond
+ ((imenu--subalist-p item)
+ (imenu--create-keymap (car item) (cdr item) cmd))
+ (t
+ `(lambda () (interactive)
+ ,(if cmd `(,cmd ',item) (list 'quote item)))))))
+ alist)))
(defun imenu--in-alist (str alist)
"Check whether the string STR is contained in multi-level ALIST."
@@ -684,28 +677,25 @@ The alternate method, which is the one most often used, is to call
(cond ((and imenu-prev-index-position-function
imenu-extract-index-name-function)
(let ((index-alist '()) (pos (point))
- prev-pos name)
+ name)
(goto-char (point-max))
- (imenu-progress-message prev-pos 0 t)
;; Search for the function
(while (funcall imenu-prev-index-position-function)
(when (= pos (point))
(error "Infinite loop at %s:%d: imenu-prev-index-position-function does not move point" (buffer-name) pos))
(setq pos (point))
- (imenu-progress-message prev-pos nil t)
(save-excursion
(setq name (funcall imenu-extract-index-name-function)))
(and (stringp name)
;; [ydi] updated for imenu-use-markers
(push (cons name (if imenu-use-markers (point-marker) (point)))
index-alist)))
- (imenu-progress-message prev-pos 100 t)
index-alist))
;; Use generic expression if possible.
((and imenu-generic-expression)
(imenu--generic-function imenu-generic-expression))
(t
- (error "This buffer cannot use `imenu-default-create-index-function'"))))
+ (user-error "This buffer cannot use `imenu-default-create-index-function'"))))
;;;
;;; Generic index gathering function.
@@ -724,48 +714,17 @@ for modes which use `imenu--generic-function'. If it is not set, but
;; so it needs to be careful never to loop!
(defun imenu--generic-function (patterns)
"Return an index alist of the current buffer based on PATTERNS.
+PATTERNS should be an alist which has the same form as
+`imenu-generic-expression'.
-PATTERNS is an alist with elements that look like this:
- (MENU-TITLE REGEXP INDEX)
-or like this:
- (MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...)
-with zero or more ARGUMENTS. The former format creates a simple
-element in the index alist when it matches; the latter creates a
-special element of the form (INDEX-NAME POSITION-MARKER FUNCTION
-ARGUMENTS...) with FUNCTION and ARGUMENTS copied from PATTERNS.
-
-MENU-TITLE is a string used as the title for the submenu or nil
-if the entries are not nested.
-
-REGEXP is a regexp that should match a construct in the buffer
-that is to be displayed in the menu; i.e., function or variable
-definitions, etc. It contains a substring which is the name to
-appear in the menu. See the info section on Regexps for more
-information. REGEXP may also be a function, called without
-arguments. It is expected to search backwards. It shall return
-true and set `match-data' if it finds another element.
-
-INDEX points to the substring in REGEXP that contains the
-name (of the function, variable or type) that is to appear in the
-menu.
-
-The variable `imenu-case-fold-search' determines whether or not the
-regexp matches are case sensitive, and `imenu-syntax-alist' can be
-used to alter the syntax table for the search.
-
-See `lisp-imenu-generic-expression' for an example of PATTERNS.
-
-Returns an index of the current buffer as an alist. The elements in
-the alist look like:
+The return value is an alist of the form
(INDEX-NAME . INDEX-POSITION)
-or like:
+or
(INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...)
-They may also be nested index alists like:
+The return value may also consist of nested index alists like:
(INDEX-NAME . INDEX-ALIST)
depending on PATTERNS."
-
(let ((index-alist (list 'dummy))
- prev-pos
(case-fold-search (if (or (local-variable-p 'imenu-case-fold-search)
(not (local-variable-p 'font-lock-defaults)))
imenu-case-fold-search
@@ -782,7 +741,6 @@ depending on PATTERNS."
(modify-syntax-entry c (cdr syn) table))
(car syn))))
(goto-char (point-max))
- (imenu-progress-message prev-pos 0 t)
(unwind-protect ; for syntax table
(save-match-data
(set-syntax-table table)
@@ -800,7 +758,17 @@ depending on PATTERNS."
(goto-char (point-max))
(while (and (if (functionp regexp)
(funcall regexp)
- (re-search-backward regexp nil t))
+ (and
+ (re-search-backward regexp nil t)
+ ;; Do not count invisible definitions.
+ (let ((invis (invisible-p (point))))
+ (or (not invis)
+ (progn
+ (while (and invis
+ (not (bobp)))
+ (setq invis (not (re-search-backward
+ regexp nil 'move))))
+ (not invis))))))
;; Exit the loop if we get an empty match,
;; because it means a bad regexp was specified.
(not (= (match-beginning 0) (match-end 0))))
@@ -810,7 +778,6 @@ depending on PATTERNS."
(goto-char (match-beginning index))
(beginning-of-line)
(setq beg (point))
- (imenu-progress-message prev-pos nil t)
;; Add this sort of submenu only when we've found an
;; item for it, avoiding empty, duff menus.
(unless (assoc menu-title index-alist)
@@ -835,7 +802,6 @@ depending on PATTERNS."
;; keep making progress backwards.
(goto-char start))))
(set-syntax-table old-table)))
- (imenu-progress-message prev-pos 100 t)
;; Sort each submenu by position.
;; This is in case one submenu gets items from two different regexps.
(dolist (item index-alist)
@@ -963,15 +929,17 @@ See the command `imenu' for more information."
imenu-generic-expression
(not (eq imenu-create-index-function
'imenu-default-create-index-function)))
- (let ((newmap (make-sparse-keymap)))
- (set-keymap-parent newmap (current-local-map))
- (setq imenu--last-menubar-index-alist nil)
- (define-key newmap [menu-bar index]
- `(menu-item ,name ,(make-sparse-keymap "Imenu")))
- (use-local-map newmap)
- (add-hook 'menu-bar-update-hook 'imenu-update-menubar))
- (error "The mode `%s' does not support Imenu"
- (format-mode-line mode-name))))
+ (unless (and (current-local-map)
+ (keymapp (lookup-key (current-local-map) [menu-bar index])))
+ (let ((newmap (make-sparse-keymap)))
+ (set-keymap-parent newmap (current-local-map))
+ (setq imenu--last-menubar-index-alist nil)
+ (define-key newmap [menu-bar index]
+ `(menu-item ,name ,(make-sparse-keymap "Imenu")))
+ (use-local-map newmap)
+ (add-hook 'menu-bar-update-hook 'imenu-update-menubar)))
+ (user-error "The mode `%s' does not support Imenu"
+ (format-mode-line mode-name))))
;;;###autoload
(defun imenu-add-menubar-index ()
@@ -983,10 +951,9 @@ A trivial interface to `imenu-add-to-menubar' suitable for use in a hook."
(defvar imenu-buffer-menubar nil)
-(defvar imenu-menubar-modified-tick 0
+(defvar-local imenu-menubar-modified-tick 0
"The value of (buffer-chars-modified-tick) as of the last call
to `imenu-update-menubar'.")
-(make-variable-buffer-local 'imenu-menubar-modified-tick)
(defun imenu-update-menubar ()
(when (and (current-local-map)
@@ -1008,6 +975,9 @@ to `imenu-update-menubar'.")
(car (cdr menu))))
'imenu--menubar-select))
(setq old (lookup-key (current-local-map) [menu-bar index]))
+ ;; This should never happen, but in some odd cases, potentially,
+ ;; lookup-key may return a dynamically composed keymap.
+ (if (keymapp (cadr old)) (setq old (cadr old)))
(setcdr old (cdr menu1)))))))
(defun imenu--menubar-select (item)
@@ -1024,7 +994,7 @@ to `imenu-update-menubar'.")
(imenu item)
nil))
-(defun imenu-default-goto-function (name position &optional rest)
+(defun imenu-default-goto-function (_name position &optional _rest)
"Move to the given position.
NAME is ignored. POSITION is where to move. REST is also ignored.
@@ -1046,7 +1016,7 @@ for more information."
(if (stringp index-item)
(setq index-item (assoc index-item (imenu--make-index-alist))))
(when index-item
- (push-mark)
+ (push-mark nil t)
(let* ((is-special-item (listp (cdr index-item)))
(function
(if is-special-item
@@ -1057,12 +1027,6 @@ for more information."
(apply function (car index-item) position rest))
(run-hooks 'imenu-after-jump-hook)))
-(dolist (mess
- '("^No items suitable for an index found in this buffer$"
- "^This buffer cannot use `imenu-default-create-index-function'$"
- "^The mode `.*' does not support Imenu$"))
- (add-to-list 'debug-ignored-errors mess))
-
(provide 'imenu)
;;; imenu.el ends here
diff --git a/lisp/indent.el b/lisp/indent.el
index f5850de8b8f..7032aabd496 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -1,6 +1,6 @@
;;; indent.el --- indentation commands for Emacs
-;; Copyright (C) 1985, 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1995, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Package: emacs
diff --git a/lisp/info-look.el b/lisp/info-look.el
index 13edc0269dd..eb780fe5620 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -1,7 +1,7 @@
;;; info-look.el --- major-mode-sensitive Info index lookup facility -*- lexical-binding: t -*-
;; An older version of this was known as libc.el.
-;; Copyright (C) 1995-1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Ralph Schleicher <rs@nunatak.allgaeu.org>
;; (did not show signs of life (Nov 2001) -stef)
@@ -732,7 +732,7 @@ Return nil if there is nothing appropriate in the buffer near point."
:parse-rule "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z0-9-]+\\|##\\|\\+="
:doc-spec '(
;; "(automake)Macro Index" is autoconf macros used in
- ;; configure.in, not Makefile.am, so don't have that here.
+ ;; configure.ac, not Makefile.am, so don't have that here.
("(automake)Variable Index" nil "^[ \t]*`" "'")
;; In automake 1.4 macros and variables were a combined node.
("(automake)Macro and Variable Index" nil "^[ \t]*`" "'")
diff --git a/lisp/info-xref.el b/lisp/info-xref.el
index 805bec064cf..ebe50551a69 100644
--- a/lisp/info-xref.el
+++ b/lisp/info-xref.el
@@ -1,6 +1,6 @@
;;; info-xref.el --- check external references in an Info document
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Kevin Ryde <user42@zip.com.au>
;; Keywords: docs
@@ -45,8 +45,7 @@
;;; Code:
(require 'info)
-(eval-when-compile
- (require 'cl)) ;; for `incf'
+(eval-when-compile (require 'cl-lib)) ;; for `incf'
;;-----------------------------------------------------------------------------
;; vaguely generic
@@ -239,11 +238,11 @@ buffer's line and column of point."
;; if the file exists, try the node
(cond ((not (cdr (assoc file info-xref-xfile-alist)))
- (incf info-xref-unavail))
+ (cl-incf info-xref-unavail))
((info-xref-goto-node-p node)
- (incf info-xref-good))
+ (cl-incf info-xref-good))
(t
- (incf info-xref-bad)
+ (cl-incf info-xref-bad)
(info-xref-output-error "no such node: %s" node)))))))
@@ -447,8 +446,8 @@ and can take a long time."
(if (eq :tag (cadr link))
(setq link (cddr link)))
(if (info-xref-goto-node-p (cadr link))
- (incf info-xref-good)
- (incf info-xref-bad)
+ (cl-incf info-xref-good)
+ (cl-incf info-xref-bad)
;; symbol-file gives nil for preloaded variables, would need
;; to copy what describe-variable does to show the right place
(info-xref-output "Symbol `%s' (file %s): cannot goto node: %s"
diff --git a/lisp/info.el b/lisp/info.el
index c1dae66bea2..b0ef5c6bc4d 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1,6 +1,6 @@
;; info.el --- info package for Emacs
-;; Copyright (C) 1985-1986, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1992-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help
@@ -32,8 +32,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(defgroup info nil
"Info subsystem."
:group 'help
@@ -169,6 +167,83 @@ A header-line does not scroll with the rest of the buffer."
"Face for Info nodes in a node header."
:group 'info)
+;; This is a defcustom largely so that we can get the benefit
+;; of custom-initialize-delay. Perhaps it would work to make it a
+;; defvar and explicitly give it a standard-value property, and
+;; call custom-initialize-delay on it.
+;; The progn forces the autoloader to include the whole thing, not
+;; just an abbreviated version.
+;;;###autoload
+(progn
+(defcustom Info-default-directory-list
+ (let* ((config-dir
+ (file-name-as-directory
+ ;; Self-contained NS build with info/ in the app-bundle.
+ (or (and (featurep 'ns)
+ (let ((dir (expand-file-name "../info" data-directory)))
+ (if (file-directory-p dir) dir)))
+ configure-info-directory)))
+ (prefixes
+ ;; Directory trees in which to look for info subdirectories
+ (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/")))
+ (suffixes
+ ;; Subdirectories in each directory tree that may contain info
+ ;; directories. Most of these are rather outdated.
+ ;; It ought to be fine to stop checking the "emacs" ones now,
+ ;; since this is Emacs and we have not installed info files
+ ;; into such directories for a looong time...
+ '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/"
+ "emacs/" "lib/" "lib/emacs/"))
+ (standard-info-dirs
+ (apply #'nconc
+ (mapcar (lambda (pfx)
+ (let ((dirs
+ (mapcar (lambda (sfx)
+ (concat pfx sfx "info/"))
+ suffixes)))
+ (prune-directory-list dirs)))
+ prefixes)))
+ ;; If $(prefix)/share/info is not one of the standard info
+ ;; directories, they are probably installing an experimental
+ ;; version of Emacs, so make sure that experimental version's Info
+ ;; files override the ones in standard directories.
+ (dirs
+ (if (member config-dir standard-info-dirs)
+ ;; FIXME? What is the point of adding it again at the end
+ ;; when it is already present earlier in the list?
+ (nconc standard-info-dirs (list config-dir))
+ (cons config-dir standard-info-dirs))))
+ (if (not (eq system-type 'windows-nt))
+ dirs
+ ;; Include the info directory near where Emacs executable was installed.
+ (let* ((instdir (file-name-directory invocation-directory))
+ (dir1 (expand-file-name "../info/" instdir))
+ (dir2 (expand-file-name "../../../info/" instdir)))
+ (cond ((file-exists-p dir1) (append dirs (list dir1)))
+ ((file-exists-p dir2) (append dirs (list dir2)))
+ (t dirs)))))
+
+ "Default list of directories to search for Info documentation files.
+They are searched in the order they are given in the list.
+Therefore, the directory of Info files that come with Emacs
+normally should come last (so that local files override standard ones),
+unless Emacs is installed into a non-standard directory. In the latter
+case, the directory of Info files that come with Emacs should be
+first in this list.
+
+Once Info is started, the list of directories to search
+comes from the variable `Info-directory-list'.
+This variable `Info-default-directory-list' is used as the default
+for initializing `Info-directory-list' when Info is started, unless
+the environment variable INFOPATH is set.
+
+Although this is a customizable variable, that is mainly for technical
+reasons. Normally, you should either set INFOPATH or customize
+`Info-additional-directory-list', rather than changing this variable."
+ :initialize 'custom-initialize-delay
+ :type '(repeat directory)
+ :group 'info))
+
(defvar Info-directory-list nil
"List of directories to search for Info documentation files.
If nil, meaning not yet initialized, Info uses the environment
@@ -267,12 +342,12 @@ a tab, a carriage return (control-M), a newline, and `]+'."
(defcustom Info-isearch-search t
"If non-nil, isearch in Info searches through multiple nodes.
Before leaving the initial Info node, where isearch was started,
-it fails once with the error message [initial node], and with
+it fails once with the error message [end of node], and with
subsequent C-s/C-r continues through other nodes without failing
with this error message in other nodes. When isearch fails for
-the rest of the manual, it wraps around the whole manual and
-restarts the search from the top/final node depending on
-search direction.
+the rest of the manual, it displays the error message [end of manual],
+wraps around the whole manual and restarts the search from the top/final
+node depending on search direction.
Setting this option to nil restores the default isearch behavior
with wrapping around the current Info node."
@@ -342,6 +417,21 @@ If number, the point is moved to the corresponding line.")
(defvar Info-standalone nil
"Non-nil if Emacs was started solely as an Info browser.")
+(defvar Info-file-attributes nil
+ "Alist of file attributes of visited Info files.
+Each element is a list (FILE-NAME FILE-ATTRIBUTES...).")
+
+(defvar Info-toc-nodes nil
+ "Alist of cached parent-children node information in visited Info files.
+Each element is (FILE (NODE-NAME PARENT SECTION CHILDREN) ...)
+where PARENT is the parent node extracted from the Up pointer,
+SECTION is the section name in the Top node where this node is placed,
+CHILDREN is a list of child nodes extracted from the node menu.")
+
+(defvar Info-index-nodes nil
+ "Alist of cached index node names of visited Info files.
+Each element has the form (INFO-FILE INDEX-NODE-NAMES-LIST).")
+
(defvar Info-virtual-files nil
"List of definitions of virtual Info files.
Each element of the list has the format (FILENAME (OPERATION . HANDLER) ...)
@@ -534,7 +624,26 @@ Do the right thing if the file has been compressed or zipped."
(apply 'call-process-region (point-min) (point-max)
(car decoder) t t nil (cdr decoder))))
(let ((inhibit-null-byte-detection t)) ; Index nodes include null bytes
- (insert-file-contents fullname visit)))))
+ (insert-file-contents fullname visit)))
+
+ ;; Clear the caches of modified Info files.
+ (let* ((attribs-old (cdr (assoc fullname Info-file-attributes)))
+ (modtime-old (and attribs-old (nth 5 attribs-old)))
+ (attribs-new (and (stringp fullname) (file-attributes fullname)))
+ (modtime-new (and attribs-new (nth 5 attribs-new))))
+ (when (and modtime-old modtime-new
+ (> (float-time modtime-new) (float-time modtime-old)))
+ (setq Info-index-nodes (remove (assoc (or Info-current-file filename)
+ Info-index-nodes)
+ Info-index-nodes))
+ (setq Info-toc-nodes (remove (assoc (or Info-current-file filename)
+ Info-toc-nodes)
+ Info-toc-nodes)))
+ ;; Add new modtime to `Info-file-attributes'.
+ (setq Info-file-attributes
+ (cons (cons fullname attribs-new)
+ (remove (assoc fullname Info-file-attributes)
+ Info-file-attributes))))))
(defun Info-file-supports-index-cookies (&optional file)
"Return non-nil value if FILE supports Info index cookies.
@@ -618,7 +727,19 @@ in `Info-file-supports-index-cookies-list'."
(append (split-string (substring path 0 -1) sep)
(Info-default-dirs))
(split-string path sep))
- (Info-default-dirs)))))))
+ (Info-default-dirs))))
+ ;; For a self-contained (ie relocatable) NS build, AFAICS we
+ ;; always want the included info directory to be at the head of
+ ;; the search path, unless it's already in INFOPATH somewhere.
+ ;; It's at the head of Info-default-directory-list,
+ ;; but there's no way to get it at the head of Info-directory-list
+ ;; except by doing it here.
+ (and path
+ (featurep 'ns)
+ (let ((dir (expand-file-name "../info" data-directory)))
+ (and (file-directory-p dir)
+ (not (member dir (split-string path ":" t)))
+ (push dir Info-directory-list)))))))
;;;###autoload
(defun info-other-window (&optional file-or-node)
@@ -683,6 +804,12 @@ See a list of available Info commands in `Info-mode'."
(info "emacs"))
;;;###autoload
+(defun info-emacs-bug ()
+ "Display the \"Reporting Bugs\" section of the Emacs manual in Info mode."
+ (interactive)
+ (info "(emacs)Bugs"))
+
+;;;###autoload
(defun info-standalone ()
"Run Emacs as a standalone Info reader.
Usage: emacs -f info-standalone [filename]
@@ -1071,7 +1198,7 @@ a case-insensitive match is tried."
(throw 'foo t))
;; No such anchor in tag table or node in tag table or file
- (error "No such node or anchor: %s" nodename))
+ (user-error "No such node or anchor: %s" nodename))
(Info-select-node)
(goto-char (point-min))
@@ -1165,6 +1292,12 @@ a case-insensitive match is tried."
(progn (setq file (expand-file-name "dir.info" truename))
(file-attributes file))
(progn (setq file (expand-file-name "DIR.INFO" truename))
+ (file-attributes file))
+ ;; Shouldn't really happen, but sometimes does,
+ ;; eg on Debian systems with buggy packages;
+ ;; so may as well try it.
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00005.html
+ (progn (setq file (expand-file-name "dir.gz" truename))
(file-attributes file)))))
(setq dirs-done
(cons truename
@@ -1749,9 +1882,7 @@ If DIRECTION is `backward', search in the reverse direction."
(while (and (not give-up)
(or (null found)
(not (funcall isearch-filter-predicate beg-found found))))
- (let ((search-spaces-regexp
- (if (or (not isearch-mode) isearch-regexp)
- Info-search-whitespace-regexp)))
+ (let ((search-spaces-regexp Info-search-whitespace-regexp))
(if (if backward
(re-search-backward regexp bound t)
(re-search-forward regexp bound t))
@@ -1764,16 +1895,14 @@ If DIRECTION is `backward', search in the reverse direction."
(not bound)
(or give-up (and found (not (and (> found opoint-min)
(< found opoint-max))))))
- (signal 'search-failed (list regexp "initial node")))
+ (signal 'search-failed (list regexp "end of node")))
;; If no subfiles, give error now.
(if give-up
(if (null Info-current-subfile)
(if isearch-mode
(signal 'search-failed (list regexp "end of manual"))
- (let ((search-spaces-regexp
- (if (or (not isearch-mode) isearch-regexp)
- Info-search-whitespace-regexp)))
+ (let ((search-spaces-regexp Info-search-whitespace-regexp))
(if backward
(re-search-backward regexp)
(re-search-forward regexp))))
@@ -1831,9 +1960,7 @@ If DIRECTION is `backward', search in the reverse direction."
(while (and (not give-up)
(or (null found)
(not (funcall isearch-filter-predicate beg-found found))))
- (let ((search-spaces-regexp
- (if (or (not isearch-mode) isearch-regexp)
- Info-search-whitespace-regexp)))
+ (let ((search-spaces-regexp Info-search-whitespace-regexp))
(if (if backward
(re-search-backward regexp nil t)
(re-search-forward regexp nil t))
@@ -1901,26 +2028,28 @@ If DIRECTION is `backward', search in the reverse direction."
(defun Info-isearch-search ()
(if Info-isearch-search
(lambda (string &optional bound noerror count)
- (if isearch-word
- (Info-search (concat "\\b" (replace-regexp-in-string
- "\\W+" "\\W+"
- (replace-regexp-in-string
- "^\\W+\\|\\W+$" "" string)
- nil t)
- ;; Lax version of word search
- (if (or isearch-nonincremental
- (eq (length string)
- (length (isearch-string-state
- (car isearch-cmds)))))
- "\\b"))
- bound noerror count
- (unless isearch-forward 'backward))
- (Info-search (if isearch-regexp string (regexp-quote string))
- bound noerror count
- (unless isearch-forward 'backward)))
+ (let ((Info-search-whitespace-regexp
+ (if (if isearch-regexp
+ isearch-regexp-lax-whitespace
+ isearch-lax-whitespace)
+ search-whitespace-regexp)))
+ (Info-search
+ (cond
+ (isearch-word
+ ;; Lax version of word search
+ (let ((lax (not (or isearch-nonincremental
+ (eq (length string)
+ (length (isearch--state-string
+ (car isearch-cmds))))))))
+ (if (functionp isearch-word)
+ (funcall isearch-word string lax)
+ (word-search-regexp string lax))))
+ (isearch-regexp string)
+ (t (regexp-quote string)))
+ bound noerror count
+ (unless isearch-forward 'backward)))
(point))
- (let ((isearch-search-fun-function nil))
- (isearch-search-fun))))
+ (isearch-search-fun-default)))
(defun Info-isearch-wrap ()
(if Info-isearch-search
@@ -2006,8 +2135,8 @@ if ERRORNAME is nil, just return nil."
(concat name ":" (Info-following-node-name-re)) bound t)
(match-string-no-properties 1))
((not (eq errorname t))
- (error "Node has no %s"
- (capitalize (or errorname name)))))))))
+ (user-error "Node has no %s"
+ (capitalize (or errorname name)))))))))
(defun Info-following-node-name-re (&optional allowedchars)
"Return a regexp matching a node name.
@@ -2076,7 +2205,7 @@ If SAME-FILE is non-nil, do not move to a different Info file."
"Go back in the history to the last node visited."
(interactive)
(or Info-history
- (error "This is the first Info node you looked at"))
+ (user-error "This is the first Info node you looked at"))
(let ((history-forward
(cons (list Info-current-file Info-current-node (point))
Info-history-forward))
@@ -2096,7 +2225,7 @@ If SAME-FILE is non-nil, do not move to a different Info file."
"Go forward in the history of visited nodes."
(interactive)
(or Info-history-forward
- (error "This is the last Info node you looked at"))
+ (user-error "This is the last Info node you looked at"))
(let ((history-forward (cdr Info-history-forward))
filename nodename opoint)
(setq filename (car (car Info-history-forward)))
@@ -2251,7 +2380,7 @@ Table of contents is created from the tree structure of menus."
(match-string-no-properties 1)))
(section "Top")
menu-items)
- (when (string-match "(" upnode) (setq upnode nil))
+ (when (and upnode (string-match "(" upnode)) (setq upnode nil))
(when (and (not (Info-index-node nodename file))
(re-search-forward "^\\* Menu:" bound t))
(forward-line 1)
@@ -2298,13 +2427,6 @@ Table of contents is created from the tree structure of menus."
(message "")
(nreverse nodes))))
-(defvar Info-toc-nodes nil
- "Alist of cached parent-children node information in visited Info files.
-Each element is (FILE (NODE-NAME PARENT SECTION CHILDREN) ...)
-where PARENT is the parent node extracted from the Up pointer,
-SECTION is the section name in the Top node where this node is placed,
-CHILDREN is a list of child nodes extracted from the node menu.")
-
(defun Info-toc-nodes (filename)
"Return a node list of Info FILENAME with parent-children information.
This information is cached in the variable `Info-toc-nodes' with the help
@@ -2382,7 +2504,7 @@ new buffer."
completions nil t)))
(list (if (equal input "")
default input) current-prefix-arg))
- (error "No cross-references in this node"))))
+ (user-error "No cross-references in this node"))))
(unless footnotename
(error "No reference was specified"))
@@ -2413,7 +2535,8 @@ new buffer."
(abs (- prev-ref (point))))
next-ref prev-ref))
((or next-ref prev-ref))
- ((error "No cross-reference named %s" footnotename))))
+ ((user-error "No cross-reference named %s"
+ footnotename))))
(setq target (Info-extract-menu-node-name t))))
(while (setq i (string-match "[ \t\n]+" target i))
(setq target (concat (substring target 0 i) " "
@@ -2523,6 +2646,7 @@ Because of ambiguities, this should be concatenated with something like
(while (re-search-forward pattern nil t)
(push (match-string-no-properties 1)
completions))
+ (setq completions (delete-dups completions))
;; Check subsequent nodes if applicable.
(or (and Info-complete-next-re
(setq nextnode (Info-extract-pointer "next" t))
@@ -2558,7 +2682,7 @@ new buffer."
(save-excursion
(goto-char (point-min))
(if (not (search-forward "\n* menu:" nil t))
- (error "No menu in this node"))
+ (user-error "No menu in this node"))
(setq beg (point))
(and (< (point) p)
(save-excursion
@@ -2588,7 +2712,9 @@ new buffer."
(list item current-prefix-arg))))
;; there is a problem here in that if several menu items have the same
;; name you can only go to the node of the first with this command.
- (Info-goto-node (Info-extract-menu-item menu-item) (if fork menu-item)))
+ (Info-goto-node (Info-extract-menu-item menu-item)
+ (and fork
+ (if (stringp fork) fork menu-item))))
(defun Info-extract-menu-item (menu-item)
(setq menu-item (regexp-quote menu-item))
@@ -2597,10 +2723,10 @@ new buffer."
(let ((case-fold-search t))
(goto-char (point-min))
(or (search-forward "\n* menu:" nil t)
- (error "No menu in this node"))
+ (user-error "No menu in this node"))
(or (re-search-forward (concat "\n\\* +" menu-item ":") nil t)
(re-search-forward (concat "\n\\* +" menu-item) nil t)
- (error "No such item in menu"))
+ (user-error "No such item in menu"))
(beginning-of-line)
(forward-char 2)
(Info-extract-menu-node-name nil (Info-index-node))))))
@@ -2616,7 +2742,7 @@ new buffer."
(match-beginning 0))))
(goto-char (point-min))
(or (search-forward "\n* menu:" bound t)
- (error "No menu in this node"))
+ (user-error "No menu in this node"))
(if count
(or (search-forward "\n* " bound t count)
(error "Too few items in menu"))
@@ -2688,7 +2814,7 @@ N is the digit argument used to invoke this command."
(if Info-history-skip-intermediate-nodes
(setq Info-history old-history)))))
(no-error nil)
- (t (error "No pointer forward from this node")))))
+ (t (user-error "No pointer forward from this node")))))
(defun Info-backward-node ()
"Go backward one node, considering all nodes as forming one sequence."
@@ -2697,7 +2823,7 @@ N is the digit argument used to invoke this command."
(upnode (Info-extract-pointer "up" t))
(case-fold-search t))
(cond ((and upnode (string-match "(" upnode))
- (error "First node in file"))
+ (user-error "First node in file"))
((and upnode (or (null prevnode)
;; Use string-equal, not equal,
;; to ignore text properties.
@@ -2715,7 +2841,7 @@ N is the digit argument used to invoke this command."
(if Info-history-skip-intermediate-nodes
(setq Info-history old-history))))
(t
- (error "No pointer backward from this node")))))
+ (user-error "No pointer backward from this node")))))
(defun Info-exit ()
"Exit Info by selecting some other buffer."
@@ -2736,7 +2862,7 @@ N is the digit argument used to invoke this command."
(and (search-forward "\n* " nil t)
(Info-extract-menu-node-name)))))
(if node (Info-goto-node node)
- (error "No more items in menu"))))
+ (user-error "No more items in menu"))))
(defun Info-last-menu-item ()
"Go to the node of the previous menu item."
@@ -2749,13 +2875,13 @@ N is the digit argument used to invoke this command."
(and (search-backward "\n* menu:" nil t)
(point)))))
(or (and beg (search-backward "\n* " beg t))
- (error "No previous items in menu")))
+ (user-error "No previous items in menu")))
(Info-goto-node (save-excursion
(goto-char (match-end 0))
(Info-extract-menu-node-name)))))
(defmacro Info-no-error (&rest body)
- (list 'condition-case nil (cons 'progn (append body '(t))) '(error nil)))
+ `(condition-case nil (progn ,@body t) (error nil)))
(defun Info-next-preorder ()
"Go to the next subnode or the next node, or go up a level."
@@ -2774,7 +2900,7 @@ N is the digit argument used to invoke this command."
(if Info-history-skip-intermediate-nodes
(setq Info-history old-history))))
(t
- (error "No more nodes"))))
+ (user-error "No more nodes"))))
(defun Info-last-preorder ()
"Go to the last node, popping up a level if there is none."
@@ -2814,7 +2940,7 @@ N is the digit argument used to invoke this command."
(let ((case-fold-search t))
(or (search-forward "\n* Menu:" nil t)
(goto-char (point-max)))))
- (t (error "No previous nodes"))))
+ (t (user-error "No previous nodes"))))
(defun Info-scroll-up ()
"Scroll one screenful forward in Info, considering all nodes as one sequence.
@@ -2903,11 +3029,11 @@ See `Info-scroll-down'."
(or (re-search-forward pat nil t)
(progn
(goto-char old-pt)
- (error "No cross references in this node")))))
+ (user-error "No cross references in this node")))))
(goto-char (or (match-beginning 1) (match-beginning 0)))
(if (looking-at "\\* Menu:")
(if recur
- (error "No cross references in this node")
+ (user-error "No cross references in this node")
(Info-next-reference t))
(if (looking-at "^\\* ")
(forward-char 2)))))
@@ -2924,19 +3050,15 @@ See `Info-scroll-down'."
(or (re-search-backward pat nil t)
(progn
(goto-char old-pt)
- (error "No cross references in this node")))))
+ (user-error "No cross references in this node")))))
(goto-char (or (match-beginning 1) (match-beginning 0)))
(if (looking-at "\\* Menu:")
(if recur
- (error "No cross references in this node")
+ (user-error "No cross references in this node")
(Info-prev-reference t))
(if (looking-at "^\\* ")
(forward-char 2)))))
-(defvar Info-index-nodes nil
- "Alist of cached index node names of visited Info files.
-Each element has the form (INFO-FILE INDEX-NODE-NAMES-LIST).")
-
(defun Info-index-nodes (&optional file)
"Return a list of names of all index nodes in Info FILE.
If FILE is omitted, it defaults to the current Info file.
@@ -3099,7 +3221,7 @@ Give an empty topic name to go to the Index node itself."
(or matches
(progn
(Info-goto-node orignode)
- (error "No `%s' in index" topic)))
+ (user-error "No `%s' in index" topic)))
;; Here it is a feature that assoc is case-sensitive.
(while (setq found (assoc topic matches))
(setq exact (cons found exact)
@@ -3112,7 +3234,7 @@ Give an empty topic name to go to the Index node itself."
"Go to the next matching index item from the last \\<Info-mode-map>\\[Info-index] command."
(interactive "p")
(or Info-index-alternatives
- (error "No previous `i' command"))
+ (user-error "No previous `i' command"))
(while (< num 0)
(setq num (+ num (length Info-index-alternatives))))
(while (> num 0)
@@ -3632,7 +3754,7 @@ If FORK is a string, it is the name to use for the new buffer."
;; Don't raise an error when mouse-1 is bound to this - it's
;; often used to simply select the window or frame.
(eq 'mouse-1 (event-basic-type last-input-event)))
- (error "Point neither on reference nor in menu item description")))
+ (user-error "Point neither on reference nor in menu item description")))
;; Common subroutine.
(defun Info-try-follow-nearest-node (&optional fork)
@@ -3668,15 +3790,22 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(defun Info-mouse-follow-link (click)
"Follow a link where you click."
- (interactive "e")
+ (interactive "@e")
(let* ((position (event-start click))
(posn-string (and position (posn-string position)))
- (string (car-safe posn-string))
- (string-pos (cdr-safe posn-string))
- (link-args (and string string-pos
- (get-text-property string-pos 'link-args string))))
- (when link-args
- (Info-goto-node link-args))))
+ (link-args (if posn-string
+ (get-text-property (cdr posn-string)
+ 'link-args
+ (car posn-string))
+ (get-char-property (posn-point position)
+ 'link-args))))
+ (cond ((stringp link-args)
+ (Info-goto-node link-args))
+ ;; These special values of the `link-args' property are used
+ ;; for navigation; see `Info-fontify-node'.
+ ((eq link-args 'prev) (Info-prev))
+ ((eq link-args 'next) (Info-next))
+ ((eq link-args 'up) (Info-up)))))
(defvar Info-mode-map
@@ -3706,7 +3835,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map "b" 'beginning-of-buffer)
(put 'beginning-of-buffer :advertised-binding "b")
(define-key map "d" 'Info-directory)
- (define-key map "e" 'Info-edit)
+ (define-key map "e" 'end-of-buffer)
(define-key map "f" 'Info-follow-reference)
(define-key map "g" 'Info-goto-node)
(define-key map "h" 'Info-help)
@@ -3734,6 +3863,8 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map "\177" 'Info-scroll-down)
(define-key map [mouse-2] 'Info-mouse-follow-nearest-node)
(define-key map [follow-link] 'mouse-face)
+ (define-key map [XF86Back] 'Info-history-back)
+ (define-key map [XF86Forward] 'Info-history-forward)
map)
"Keymap containing Info commands.")
@@ -3899,7 +4030,7 @@ The name of the Info file is prepended to the node name in parentheses.
With a zero prefix arg, put the name inside a function call to `info'."
(interactive "P")
(unless Info-current-node
- (error "No current Info node"))
+ (user-error "No current Info node"))
(let ((node (if (stringp Info-current-file)
(concat "(" (file-name-nondirectory Info-current-file) ") "
Info-current-node))))
@@ -4026,8 +4157,6 @@ Advanced commands:
'Info-isearch-push-state)
(set (make-local-variable 'isearch-filter-predicate)
'Info-isearch-filter)
- (set (make-local-variable 'search-whitespace-regexp)
- Info-search-whitespace-regexp)
(set (make-local-variable 'revert-buffer-function)
'Info-revert-buffer-function)
(Info-set-mode-line)
@@ -4249,45 +4378,17 @@ the variable `Info-file-list-for-emacs'."
(t
(Info-goto-emacs-command-node command)))))
-(defvar Info-next-link-keymap
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap [header-line mouse-1] 'Info-next)
- (define-key keymap [header-line mouse-2] 'Info-next)
- (define-key keymap [header-line down-mouse-1] 'ignore)
- (define-key keymap [mouse-2] 'Info-next)
- (define-key keymap [follow-link] 'mouse-face)
- keymap)
- "Keymap to put on the Next link in the text or the header line.")
-
-(defvar Info-prev-link-keymap
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap [header-line mouse-1] 'Info-prev)
- (define-key keymap [header-line mouse-2] 'Info-prev)
- (define-key keymap [header-line down-mouse-1] 'ignore)
- (define-key keymap [mouse-2] 'Info-prev)
- (define-key keymap [follow-link] 'mouse-face)
- keymap)
- "Keymap to put on the Prev link in the text or the header line.")
-
-(defvar Info-up-link-keymap
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap [header-line mouse-1] 'Info-up)
- (define-key keymap [header-line mouse-2] 'Info-up)
- (define-key keymap [header-line down-mouse-1] 'ignore)
- (define-key keymap [mouse-2] 'Info-up)
- (define-key keymap [follow-link] 'mouse-face)
- keymap)
- "Keymap to put on the Up link in the text or the header line.")
-
(defvar Info-link-keymap
(let ((keymap (make-sparse-keymap)))
- (define-key keymap [header-line mouse-1] 'Info-mouse-follow-link)
+ (define-key keymap [header-line down-mouse-1] 'mouse-drag-header-line)
+ (define-key keymap [header-line mouse-1] 'mouse-select-window)
(define-key keymap [header-line mouse-2] 'Info-mouse-follow-link)
- (define-key keymap [header-line down-mouse-1] 'ignore)
(define-key keymap [mouse-2] 'Info-mouse-follow-link)
(define-key keymap [follow-link] 'mouse-face)
keymap)
- "Keymap to put on the link in the text or the header line.")
+ "Keymap to put on Info links.
+This is used for the \"Next\", \"Prev\", and \"Up\" links in the
+first line or header line, and for breadcrumb links.")
(defun Info-breadcrumbs ()
(let ((nodes (Info-toc-nodes Info-current-file))
@@ -4376,15 +4477,14 @@ the variable `Info-file-list-for-emacs'."
'help-echo
(concat "mouse-2: Go to node "
(buffer-substring nbeg nend)))
- ;; Always set up the text property keymap.
- ;; It will either be used in the buffer
- ;; or copied in the header line.
- (put-text-property
- tbeg nend 'keymap
- (cond
- ((string-equal (downcase tag) "prev") Info-prev-link-keymap)
- ((string-equal (downcase tag) "next") Info-next-link-keymap)
- ((string-equal (downcase tag) "up" ) Info-up-link-keymap))))))
+ ;; Set up the text property keymap. Depending on
+ ;; `Info-use-header-line', it is either used in the
+ ;; buffer, or copied to the header line. A symbol value
+ ;; of the `link-args' property is handled specially by
+ ;; `Info-mouse-follow-link'.
+ (put-text-property tbeg nend 'keymap Info-link-keymap)
+ (put-text-property tbeg nend 'link-args
+ (intern (downcase tag))))))
;; (when (> Info-breadcrumbs-depth 0)
;; (insert (Info-breadcrumbs)))
@@ -4425,7 +4525,17 @@ the variable `Info-file-list-for-emacs'."
((not (bobp))
;; Hide the punctuation at the end, too.
(skip-chars-backward " \t,")
- (put-text-property (point) header-end 'invisible t))))))
+ (put-text-property (point) header-end 'invisible t)
+ ;; Hide the suffix of the Info file name.
+ (beginning-of-line)
+ (if (re-search-forward
+ (format "File: %s\\([^,\n\t]+\\),"
+ (if (stringp Info-current-file)
+ (file-name-nondirectory Info-current-file)
+ Info-current-file))
+ header-end t)
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'invisible t)))))))
;; Fontify titles
(goto-char (point-min))
@@ -4713,6 +4823,12 @@ the variable `Info-file-list-for-emacs'."
mouse-face highlight
help-echo "mouse-2: go to this URL"))))
+ ;; Hide empty lines at the end of the node.
+ (goto-char (point-max))
+ (skip-chars-backward "\n")
+ (when (< (1+ (point)) (point-max))
+ (put-text-property (1+ (point)) (point-max) 'invisible t))
+
(set-buffer-modified-p nil))))
;;; Speedbar support:
@@ -4720,6 +4836,17 @@ the variable `Info-file-list-for-emacs'."
;; current Info node.
(eval-when-compile (require 'speedbar))
+(declare-function speedbar-add-expansion-list "speedbar" (new-list))
+(declare-function speedbar-center-buffer-smartly "speedbar" ())
+(declare-function speedbar-change-expand-button-char "speedbar" (char))
+(declare-function speedbar-change-initial-expansion-list "speedbar" (new-default))
+(declare-function speedbar-delete-subblock "speedbar" (indent))
+(declare-function speedbar-make-specialized-keymap "speedbar" ())
+(declare-function speedbar-make-tag-line "speedbar"
+ (exp-button-type exp-button-char exp-button-function
+ exp-button-data tag-button tag-button-function
+ tag-button-data tag-button-face depth))
+
(defvar Info-speedbar-key-map nil
"Keymap used when in the Info display mode.")
@@ -4891,25 +5018,8 @@ BUFFER is the buffer speedbar is requesting buttons for."
(erase-buffer))
(Info-speedbar-hierarchy-buttons nil 0))
-(dolist (mess '("^First node in file$"
- "^No `.*' in index$"
- "^No cross-reference named"
- "^No cross.references in this node$"
- "^No current Info node$"
- "^No menu in this node$"
- "^No more items in menu$"
- "^No more nodes$"
- "^No pointer \\(?:forward\\|backward\\) from this node$"
- "^No previous `i' command$"
- "^No previous items in menu$"
- "^No previous nodes$"
- "^No such item in menu$"
- "^No such node or anchor"
- "^Node has no"
- "^Point neither on reference nor in menu item description$"
- "^This is the \\(?:first\\|last\\) Info node you looked at$"
- search-failed))
- (add-to-list 'debug-ignored-errors mess))
+;; FIXME: Really? Why here?
+(add-to-list 'debug-ignored-errors 'search-failed)
;;;; Desktop support
@@ -4958,11 +5068,18 @@ BUFFER is the buffer speedbar is requesting buttons for."
(defun Info-bookmark-make-record ()
"This implements the `bookmark-make-record-function' type (which see)
for Info nodes."
- `(,Info-current-node
- ,@(bookmark-make-record-default 'no-file)
- (filename . ,Info-current-file)
- (info-node . ,Info-current-node)
- (handler . Info-bookmark-jump)))
+ (let* ((file (and (stringp Info-current-file)
+ (file-name-nondirectory Info-current-file)))
+ (bookmark-name (if file
+ (concat "(" file ") " Info-current-node)
+ Info-current-node))
+ (defaults (delq nil (list bookmark-name file Info-current-node))))
+ `(,bookmark-name
+ ,@(bookmark-make-record-default 'no-file)
+ (filename . ,Info-current-file)
+ (info-node . ,Info-current-node)
+ (handler . Info-bookmark-jump)
+ (defaults . ,defaults))))
;;;###autoload
(defun Info-bookmark-jump (bmk)
diff --git a/lisp/informat.el b/lisp/informat.el
index be60b12bbac..f64cede4aea 100644
--- a/lisp/informat.el
+++ b/lisp/informat.el
@@ -1,6 +1,6 @@
;;; informat.el --- info support functions package for Emacs
-;; Copyright (C) 1986, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index d16a272c9dc..e8a0883ae92 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -1,6 +1,6 @@
;;; ccl.el --- CCL (Code Conversion Language) compiler
-;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 55aee4d53db..0a51c324d61 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -1,6 +1,6 @@
;;; characters.el --- set syntax and category for multibyte characters
-;; Copyright (C) 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -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)
@@ -560,6 +554,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(#x01AC . #x01AD)
(#x01AF . #x01B0)
(#x01B3 . #x01B6)
+ (#x01B8 . #x01B9)
(#x01BC . #x01BD)
(#x01CD . #x01DC)
(#x01DE . #x01EF)
@@ -575,8 +570,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(set-case-syntax-pair from (1+ from) tbl)
(setq from (+ from 2))))))
- (set-case-syntax-pair #x189 #x256 tbl)
- (set-case-syntax-pair #x18A #x257 tbl)
+ (set-case-syntax-pair ?Ÿ ?ÿ tbl)
;; In some languages, such as Turkish, U+0049 LATIN CAPITAL LETTER I
;; and U+0131 LATIN SMALL LETTER DOTLESS I make a case pair, and so
@@ -590,6 +584,26 @@ with L, LRE, or LRO Unicode bidi character type.")
;; (set-downcase-syntax ?İ ?i tbl)
;; (set-upcase-syntax ?I ?ı tbl)
+ (set-case-syntax-pair ?Ɓ ?ɓ tbl)
+ (set-case-syntax-pair ?Ɔ ?ɔ tbl)
+ (set-case-syntax-pair ?Ɖ ?ɖ tbl)
+ (set-case-syntax-pair ?Ɗ ?ɗ tbl)
+ (set-case-syntax-pair ?Ǝ ?ǝ tbl)
+ (set-case-syntax-pair ?Ə ?ə tbl)
+ (set-case-syntax-pair ?Ɛ ?ɛ tbl)
+ (set-case-syntax-pair ?Ɠ ?ɠ tbl)
+ (set-case-syntax-pair ?Ɣ ?ɣ tbl)
+ (set-case-syntax-pair ?Ɩ ?ɩ tbl)
+ (set-case-syntax-pair ?Ɨ ?ɨ tbl)
+ (set-case-syntax-pair ?Ɯ ?ɯ tbl)
+ (set-case-syntax-pair ?Ɲ ?ɲ tbl)
+ (set-case-syntax-pair ?Ɵ ?ɵ tbl)
+ (set-case-syntax-pair ?Ʀ ?ʀ tbl)
+ (set-case-syntax-pair ?Ʃ ?ʃ tbl)
+ (set-case-syntax-pair ?Ʈ ?ʈ tbl)
+ (set-case-syntax-pair ?Ʊ ?ʊ tbl)
+ (set-case-syntax-pair ?Ʋ ?ʋ tbl)
+ (set-case-syntax-pair ?Ʒ ?ʒ tbl)
(set-case-syntax-pair ?DŽ ?dž tbl)
(set-case-syntax-pair ?Dž ?dž tbl)
(set-case-syntax-pair ?LJ ?lj tbl)
@@ -602,6 +616,12 @@ with L, LRE, or LRO Unicode bidi character type.")
(set-case-syntax-pair ?Dz ?dz tbl)
(set-case-syntax-pair ?Ƕ ?ƕ tbl)
(set-case-syntax-pair ?Ƿ ?ƿ tbl)
+ (set-case-syntax-pair ?Ⱥ ?ⱥ tbl)
+ (set-case-syntax-pair ?Ƚ ?ƚ tbl)
+ (set-case-syntax-pair ?Ⱦ ?ⱦ tbl)
+ (set-case-syntax-pair ?Ƀ ?ƀ tbl)
+ (set-case-syntax-pair ?Ʉ ?ʉ tbl)
+ (set-case-syntax-pair ?Ʌ ?ʌ tbl)
;; Latin Extended Additional
(modify-category-entry '(#x1e00 . #x1ef9) ?l)
@@ -1114,6 +1134,12 @@ Setup char-width-table appropriate for non-CJK language environment."
;; Setting char-script-table.
+;; The data is compiled from Blocks.txt and Scripts.txt in the
+;; "Unicode Character Database", simplified to lump together all the
+;; blocks belonging to the same language. E.g., "Basic Latin",
+;; "Latin-1 Supplement", "Latin Extended-A", etc. are all lumped
+;; together under "latin".
+;;
;; The Unicode blocks actually extend past some of these ranges with
;; undefined codepoints.
(let ((script-list nil))
@@ -1126,13 +1152,17 @@ Setup char-width-table appropriate for non-CJK language environment."
(#x0370 #x03E1 greek)
(#x03E2 #x03EF coptic)
(#x03F0 #x03F3 greek)
- (#x0400 #x04FF cyrillic)
+ (#x0400 #x052F cyrillic)
(#x0530 #x058F armenian)
(#x0590 #x05FF hebrew)
(#x0600 #x06FF arabic)
(#x0700 #x074F syriac)
- (#x07C0 #x07FA nko)
+ (#x0750 #x077F arabic)
(#x0780 #x07BF thaana)
+ (#x07C0 #x07FF nko)
+ (#x0800 #x083F samaritan)
+ (#x0840 #x085F mandaic)
+ (#x08A0 #x08FF arabic)
(#x0900 #x097F devanagari)
(#x0980 #x09FF bengali)
(#x0A00 #x0A7F gurmukhi)
@@ -1143,10 +1173,10 @@ Setup char-width-table appropriate for non-CJK language environment."
(#x0C80 #x0CFF kannada)
(#x0D00 #x0D7F malayalam)
(#x0D80 #x0DFF sinhala)
- (#x0E00 #x0E5F thai)
- (#x0E80 #x0EDF lao)
+ (#x0E00 #x0E7F thai)
+ (#x0E80 #x0EFF lao)
(#x0F00 #x0FFF tibetan)
- (#x1000 #x109F burmese)
+ (#x1000 #x109F burmese) ; according to Unicode 6.1, should be "myanmar"
(#x10A0 #x10FF georgian)
(#x1100 #x11FF hangul)
(#x1200 #x139F ethiopic)
@@ -1154,14 +1184,40 @@ Setup char-width-table appropriate for non-CJK language environment."
(#x1400 #x167F canadian-aboriginal)
(#x1680 #x169F ogham)
(#x16A0 #x16FF runic)
+ (#x1700 #x171F tagalog)
+ (#x1720 #x173F hanunoo)
+ (#x1740 #x175F buhid)
+ (#x1760 #x177F tagbanwa)
(#x1780 #x17FF khmer)
(#x1800 #x18AF mongolian)
- (#x1D00 #x1DFF phonetic)
- (#x1E00 #x1EFF latin)
+ (#x18B0 #x18FF canadian-aboriginal)
+ (#x1900 #x194F limbu)
+ (#x1950 #x197F tai-le)
+ (#x1980 #x19DF tai-lue)
+ (#x19E0 #x19FF khmer)
+ (#x1A00 #x1A00 buginese)
+ (#x1A20 #x1AAF tai-tham)
+ (#x1B00 #x1B7F balinese)
+ (#x1B80 #x1BBF sundanese)
+ (#x1BC0 #x1BFF batak)
+ (#x1C00 #x1C4F lepcha)
+ (#x1C50 #x1C7F ol-chiki)
+ (#x1CC0 #x1CCF sundanese)
+ (#x1CD0 #x1CFF vedic)
+ (#x1D00 #x1DBF phonetic)
+ (#x1DC0 #x1EFF latin)
(#x1F00 #x1FFF greek)
(#x2000 #x27FF symbol)
(#x2800 #x28FF braille)
+ (#x2900 #x2BFF symbol)
+ (#x2C00 #x2C5F glagolitic)
+ (#x2C60 #x2C7F latin)
+ (#x2C80 #x2CFF coptic)
+ (#x2D00 #x2D2F georgian)
+ (#x2D30 #x2D7F tifinagh)
(#x2D80 #x2DDF ethiopic)
+ (#x2DE0 #x2DFF cyrillic)
+ (#x2E00 #x2E7F symbol)
(#x2E80 #x2FDF han)
(#x2FF0 #x2FFF ideographic-description)
(#x3000 #x303F cjk-misc)
@@ -1170,47 +1226,92 @@ Setup char-width-table appropriate for non-CJK language environment."
(#x3130 #x318F hangul)
(#x3190 #x319F kanbun)
(#x31A0 #x31BF bopomofo)
- (#x3400 #x9FAF han)
+ (#x31C0 #x31EF cjk-misc)
+ (#x31F0 #x31FF kana)
+ (#x3200 #x9FAF han)
(#xA000 #xA4CF yi)
+ (#xA4D0 #xA4FF lisu)
+ (#xA500 #xA63F vai)
+ (#xA640 #xA69F cyrillic)
+ (#xA6A0 #xA6FF bamum)
+ (#xA700 #xA7FF latin)
+ (#xA800 #xA82F syloti-nagri)
+ (#xA830 #xA83F north-indic-number)
+ (#xA840 #xA87F phags-pa)
+ (#xA880 #xA8DF saurashtra)
+ (#xA8E0 #xA8FF devanagari)
+ (#xA900 #xA92F kayah-li)
+ (#xA930 #xA95F rejang)
+ (#xA960 #xA97F hangul)
+ (#xA980 #xA9DF javanese)
(#xAA00 #xAA5F cham)
- (#xAA60 #xAA7B burmese)
+ (#xAA60 #xAA7B burmese) ; Unicode 6.1: "myanmar"
(#xAA80 #xAADF tai-viet)
- (#xAC00 #xD7AF hangul)
+ (#xAAE0 #xAAFF meetei-mayek)
+ (#xAB00 #xAB2F ethiopic)
+ (#xABC0 #xABFF meetei-mayek)
+ (#xAC00 #xD7FF hangul)
(#xF900 #xFAFF han)
(#xFB1D #xFB4F hebrew)
(#xFB50 #xFDFF arabic)
- (#xFE70 #xFEFC arabic)
+ (#xFE30 #xFE4F han)
+ (#xFE70 #xFEFF arabic)
(#xFF00 #xFF5F cjk-misc)
(#xFF61 #xFF9F kana)
(#xFFE0 #xFFE6 cjk-misc)
(#x10000 #x100FF linear-b)
(#x10100 #x1013F aegean-number)
- (#x10140 #x1018A ancient-greek-number)
- (#x10190 #x1019B ancient-symbol)
+ (#x10140 #x1018F ancient-greek-number)
+ (#x10190 #x101CF ancient-symbol)
(#x101D0 #x101FF phaistos-disc)
(#x10280 #x1029F lycian)
(#x102A0 #x102DF carian)
(#x10300 #x1032F olt-italic)
+ (#x10330 #x1034F gothic)
(#x10380 #x1039F ugaritic)
(#x103A0 #x103DF old-persian)
(#x10400 #x1044F deseret)
(#x10450 #x1047F shavian)
(#x10480 #x104AF osmanya)
(#x10800 #x1083F cypriot-syllabary)
+ (#x10840 #x1085F aramaic)
(#x10900 #x1091F phoenician)
(#x10920 #x1093F lydian)
+ (#x10980 #x109FF meroitic)
(#x10A00 #x10A5F kharoshthi)
+ (#x10A60 #x10A7F old-south-arabian)
+ (#x10B00 #x10B3F avestan)
+ (#x10B40 #x10B5F inscriptional-parthian)
+ (#x10B60 #x10B7F inscriptional-pahlavi)
+ (#x10C00 #x10C4F old-turkic)
+ (#x10E60 #x10E7F rumi-number)
+ (#x11000 #x1107F brahmi)
+ (#x11080 #x110CF kaithi)
+ (#x110D0 #x110FF sora-sompeng)
+ (#x11100 #x1114F chakma)
+ (#x11180 #x111DF sharada)
+ (#x11680 #x116CF takri)
(#x12000 #x123FF cuneiform)
(#x12400 #x1247F cuneiform-numbers-and-punctuation)
+ (#x13000 #x1342F egyptian)
+ (#x16800 #x16A3F bamum)
+ (#x16F00 #x16F9F miao)
+ (#x1B000 #x1B0FF kana)
(#x1D000 #x1D0FF byzantine-musical-symbol)
(#x1D100 #x1D1FF musical-symbol)
(#x1D200 #x1D24F ancient-greek-musical-notation)
(#x1D300 #x1D35F tai-xuan-jing-symbol)
(#x1D360 #x1D37F counting-rod-numeral)
(#x1D400 #x1D7FF mathematical)
+ (#x1EE00 #x1EEFF arabic)
(#x1F000 #x1F02F mahjong-tile)
(#x1F030 #x1F09F domino-tile)
- (#x20000 #x2AFFF han)
+ (#x1F0A0 #x1F0FF playing-cards)
+ (#x1F100 #x1F1FF symbol)
+ (#x1F200 #x1F2FF han)
+ (#x1F300 #x1F64F symbol)
+ (#x1F680 #x1F77F symbol)
+ (#x20000 #x2B81F han)
(#x2F800 #x2FFFF han)))
(set-char-table-range char-script-table
(cons (car elt) (nth 1 elt)) (nth 2 elt))
@@ -1372,7 +1473,7 @@ METHOD must be one of these symbols:
`acronym': display an acronym of the character in a box. The
acronym is taken from `char-acronym-table', which see.
`hex-code': display the hexadecimal character code in a box."
-
+ :version "24.1"
:type '(alist :key-type (symbol :tag "Character Group")
:value-type (symbol :tag "Display Method"))
:options '((c0-control
diff --git a/lisp/international/charprop.el b/lisp/international/charprop.el
index 2424e87ae44..50226b1b773 100644
--- a/lisp/international/charprop.el
+++ b/lisp/international/charprop.el
@@ -2,7 +2,8 @@
;; FILE: uni-name.el
(define-char-code-property 'name "uni-name.el"
"Unicode character name.
-Property value is a string.")
+Property value is a string or nil.
+The value nil stands for the default value \"null string\").")
;; FILE: uni-category.el
(define-char-code-property 'general-category "uni-category.el"
"Unicode general category.
@@ -48,7 +49,8 @@ Property value is a symbol `Y' or `N'. See also the property `mirroring'.")
;; FILE: uni-old-name.el
(define-char-code-property 'old-name "uni-old-name.el"
"Unicode old names as published in Unicode 1.0.
-Property value is a string.")
+Property value is a string or nil.
+The value nil stands for the default value \"null string\").")
;; FILE: uni-comment.el
(define-char-code-property 'iso-10646-comment "uni-comment.el"
"Unicode ISO 10646 comment.
diff --git a/lisp/international/eucjp-ms.el b/lisp/international/eucjp-ms.el
index a16848a0c7c..6e4e1e798b0 100644
--- a/lisp/international/eucjp-ms.el
+++ b/lisp/international/eucjp-ms.el
@@ -2085,4 +2085,3 @@
(setcar x (cdr x)) (setcdr x tmp)))
map)
(define-translation-table 'eucjp-ms-encode map))
-
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 2425ee46eea..7e893a3d751 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -1,6 +1,6 @@
;;; fontset.el --- commands for handling fontset
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -58,6 +58,7 @@
("jisx0208" . japanese-jisx0208)
("jisx0201" . jisx0201)
("jisx0212" . japanese-jisx0212)
+ ("ksx1001" . korean-ksc5601)
("ksc5601.1987" . korean-ksc5601)
("cns11643.1992.*1" . chinese-cns11643-1)
("cns11643.1992.*2" . chinese-cns11643-2)
diff --git a/lisp/international/isearch-x.el b/lisp/international/isearch-x.el
index cb6856964c0..61f7cc3f0de 100644
--- a/lisp/international/isearch-x.el
+++ b/lisp/international/isearch-x.el
@@ -1,6 +1,6 @@
;;; isearch-x.el --- extended isearch handling commands
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/international/iso-ascii.el b/lisp/international/iso-ascii.el
index 491a7c02ba4..536cd231753 100644
--- a/lisp/international/iso-ascii.el
+++ b/lisp/international/iso-ascii.el
@@ -1,6 +1,6 @@
;;; iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals
-;; Copyright (C) 1987, 1995, 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1995, 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: FSF
@@ -32,7 +32,6 @@
;;; Code:
(require 'disp-table)
-(eval-when-compile (require 'cl))
(defgroup iso-ascii nil
"Set up char tables for ISO 8859/1 on ASCII terminals."
@@ -163,10 +162,18 @@
(iso-ascii-display 255 "\"y") ; small y with diaeresis or umlaut mark
(define-minor-mode iso-ascii-mode
- "Toggle ISO-ASCII mode."
- :variable (eq standard-display-table iso-ascii-display-table)
- (unless standard-display-table
- (setq standard-display-table iso-ascii-standard-display-table)))
+ "Toggle ISO-ASCII mode.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
+ :variable ((eq standard-display-table iso-ascii-display-table)
+ . (lambda (v)
+ (setq standard-display-table
+ (cond
+ (v iso-ascii-display-table)
+ ((eq standard-display-table iso-ascii-display-table)
+ iso-ascii-standard-display-table)
+ (t standard-display-table))))))
(provide 'iso-ascii)
diff --git a/lisp/international/iso-cvt.el b/lisp/international/iso-cvt.el
index 6ccd1c21739..3f8b61af6e1 100644
--- a/lisp/international/iso-cvt.el
+++ b/lisp/international/iso-cvt.el
@@ -1,7 +1,7 @@
;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*- coding: iso-latin-1 -*-
;; This file was formerly called gm-lingo.el.
-;; Copyright (C) 1993-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Michael Gschwind <mike@vlsivie.tuwien.ac.at>
;; Keywords: tex, iso, latin, i18n
diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el
index 49b1f6ef231..5d2818888fe 100644
--- a/lisp/international/iso-transl.el
+++ b/lisp/international/iso-transl.el
@@ -1,6 +1,6 @@
;;; iso-transl.el --- keyboard input definitions for ISO 8859-1 -*- coding: iso-8859-1 -*-
-;; Copyright (C) 1987, 1993-1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1993-1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: FSF
@@ -38,7 +38,6 @@
;;; Code:
;;; Provide some binding for startup:
-;;;###autoload (or key-translation-map (setq key-translation-map (make-sparse-keymap)))
;;;###autoload (define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map)
;;;###autoload (autoload 'iso-transl-ctl-x-8-map "iso-transl" "Keymap for C-x 8 prefix." t 'keymap)
@@ -283,11 +282,6 @@ sequence VECTOR. (VECTOR is normally one character long.)")
;; with a language-specific mapping by using `M-x iso-transl-set-language'.
(iso-transl-define-keys iso-transl-char-map)
-(define-key isearch-mode-map "\C-x" nil)
-(define-key isearch-mode-map [?\C-x t] 'isearch-other-control-char)
-(define-key isearch-mode-map "\C-x8" nil)
-
-
(provide 'iso-transl)
;;; iso-transl.el ends here
diff --git a/lisp/international/kinsoku.el b/lisp/international/kinsoku.el
index b0ca522dee4..04ca9de690d 100644
--- a/lisp/international/kinsoku.el
+++ b/lisp/international/kinsoku.el
@@ -1,6 +1,6 @@
;;; kinsoku.el --- `Kinsoku' processing funcs -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/international/kkc.el b/lisp/international/kkc.el
index 03e5202438f..751d0dd4d9e 100644
--- a/lisp/international/kkc.el
+++ b/lisp/international/kkc.el
@@ -1,6 +1,6 @@
;;; kkc.el --- Kana Kanji converter -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/international/latexenc.el b/lisp/international/latexenc.el
index d5a7713dbec..10d0a5bbd32 100644
--- a/lisp/international/latexenc.el
+++ b/lisp/international/latexenc.el
@@ -1,6 +1,6 @@
;;; latexenc.el --- guess correct coding system in LaTeX files -*-coding: iso-2022-7bit -*-
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;; Author: Arne J,Ax(Brgensen <arne@arnested.dk>
;; Keywords: mule, coding system, latex
diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el
index 1c9b06beab8..5041f45ba97 100644
--- a/lisp/international/latin1-disp.el
+++ b/lisp/international/latin1-disp.el
@@ -1,6 +1,6 @@
;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
@@ -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 0d3f079866e..3431c81df88 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1,6 +1,6 @@
;;; mule-cmds.el --- commands for multilingual environment -*-coding: iso-2022-7bit -*-
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -30,8 +30,6 @@
;;; Code:
-(eval-when-compile (require 'cl)) ; letf
-
(defvar dos-codepage)
(autoload 'widget-value "wid-edit")
@@ -60,98 +58,98 @@
(defvar describe-language-environment-map
(let ((map (make-sparse-keymap "Describe Language Environment")))
- (define-key map
- [Default] `(menu-item ,(purecopy "Default") describe-specified-language-support))
+ (bindings--define-key map
+ [Default] '(menu-item "Default" describe-specified-language-support))
map))
(defvar setup-language-environment-map
(let ((map (make-sparse-keymap "Set Language Environment")))
- (define-key map
- [Default] `(menu-item ,(purecopy "Default") setup-specified-language-environment))
+ (bindings--define-key map
+ [Default] '(menu-item "Default" setup-specified-language-environment))
map))
(defvar set-coding-system-map
(let ((map (make-sparse-keymap "Set Coding System")))
- (define-key-after map [universal-coding-system-argument]
- `(menu-item ,(purecopy "For Next Command") universal-coding-system-argument
- :help ,(purecopy "Coding system to be used by next command")))
- (define-key-after map [separator-1] menu-bar-separator)
- (define-key-after map [set-buffer-file-coding-system]
- `(menu-item ,(purecopy "For Saving This Buffer") set-buffer-file-coding-system
- :help ,(purecopy "How to encode this buffer when saved")))
- (define-key-after map [revert-buffer-with-coding-system]
- `(menu-item ,(purecopy "For Reverting This File Now")
- revert-buffer-with-coding-system
- :enable buffer-file-name
- :help ,(purecopy "Revisit this file immediately using specified coding system")))
- (define-key-after map [set-file-name-coding-system]
- `(menu-item ,(purecopy "For File Name") set-file-name-coding-system
- :help ,(purecopy "How to decode/encode file names")))
- (define-key-after map [separator-2] menu-bar-separator)
-
- (define-key-after map [set-keyboard-coding-system]
- `(menu-item ,(purecopy "For Keyboard") set-keyboard-coding-system
- :help ,(purecopy "How to decode keyboard input")))
- (define-key-after map [set-terminal-coding-system]
- `(menu-item ,(purecopy "For Terminal") set-terminal-coding-system
- :enable (null (memq initial-window-system '(x w32 ns)))
- :help ,(purecopy "How to encode terminal output")))
- (define-key-after map [separator-3] menu-bar-separator)
-
- (define-key-after map [set-selection-coding-system]
- `(menu-item ,(purecopy "For X Selections/Clipboard") set-selection-coding-system
- :visible (display-selections-p)
- :help ,(purecopy "How to en/decode data to/from selection/clipboard")))
- (define-key-after map [set-next-selection-coding-system]
- `(menu-item ,(purecopy "For Next X Selection") set-next-selection-coding-system
- :visible (display-selections-p)
- :help ,(purecopy "How to en/decode next selection/clipboard operation")))
- (define-key-after map [set-buffer-process-coding-system]
- `(menu-item ,(purecopy "For I/O with Subprocess") set-buffer-process-coding-system
+ (bindings--define-key map [set-buffer-process-coding-system]
+ '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system
:visible (fboundp 'start-process)
:enable (get-buffer-process (current-buffer))
- :help ,(purecopy "How to en/decode I/O from/to subprocess connected to this buffer")))
+ :help "How to en/decode I/O from/to subprocess connected to this buffer"))
+ (bindings--define-key map [set-next-selection-coding-system]
+ '(menu-item "For Next X Selection" set-next-selection-coding-system
+ :visible (display-selections-p)
+ :help "How to en/decode next selection/clipboard operation"))
+ (bindings--define-key map [set-selection-coding-system]
+ '(menu-item "For X Selections/Clipboard" set-selection-coding-system
+ :visible (display-selections-p)
+ :help "How to en/decode data to/from selection/clipboard"))
+
+ (bindings--define-key map [separator-3] menu-bar-separator)
+ (bindings--define-key map [set-terminal-coding-system]
+ '(menu-item "For Terminal" set-terminal-coding-system
+ :enable (null (memq initial-window-system '(x w32 ns)))
+ :help "How to encode terminal output"))
+ (bindings--define-key map [set-keyboard-coding-system]
+ '(menu-item "For Keyboard" set-keyboard-coding-system
+ :help "How to decode keyboard input"))
+
+ (bindings--define-key map [separator-2] menu-bar-separator)
+ (bindings--define-key map [set-file-name-coding-system]
+ '(menu-item "For File Name" set-file-name-coding-system
+ :help "How to decode/encode file names"))
+ (bindings--define-key map [revert-buffer-with-coding-system]
+ '(menu-item "For Reverting This File Now"
+ revert-buffer-with-coding-system
+ :enable buffer-file-name
+ :help "Revisit this file immediately using specified coding system"))
+ (bindings--define-key map [set-buffer-file-coding-system]
+ '(menu-item "For Saving This Buffer" set-buffer-file-coding-system
+ :help "How to encode this buffer when saved"))
+ (bindings--define-key map [separator-1] menu-bar-separator)
+ (bindings--define-key map [universal-coding-system-argument]
+ '(menu-item "For Next Command" universal-coding-system-argument
+ :help "Coding system to be used by next command"))
map))
(defvar mule-menu-keymap
(let ((map (make-sparse-keymap "Mule (Multilingual Environment)")))
- (define-key-after map [set-language-environment]
- `(menu-item ,(purecopy "Set Language Environment") ,setup-language-environment-map))
- (define-key-after map [separator-mule] menu-bar-separator)
-
- (define-key-after map [toggle-input-method]
- `(menu-item ,(purecopy "Toggle Input Method") toggle-input-method))
- (define-key-after map [set-input-method]
- `(menu-item ,(purecopy "Select Input Method...") set-input-method))
- (define-key-after map [describe-input-method]
- `(menu-item ,(purecopy "Describe Input Method") describe-input-method))
- (define-key-after map [separator-input-method] menu-bar-separator)
-
- (define-key-after map [set-various-coding-system]
- `(menu-item ,(purecopy "Set Coding Systems") ,set-coding-system-map
- :enable (default-value 'enable-multibyte-characters)))
- (define-key-after map [view-hello-file]
- `(menu-item ,(purecopy "Show Multi-lingual Text") view-hello-file
+ (bindings--define-key map [mule-diag]
+ '(menu-item "Show All Multilingual Settings" mule-diag
+ :help "Display multilingual environment settings"))
+ (bindings--define-key map [list-character-sets]
+ '(menu-item "List Character Sets" list-character-sets
+ :help "Show table of available character sets"))
+ (bindings--define-key map [describe-coding-system]
+ '(menu-item "Describe Coding System..." describe-coding-system))
+ (bindings--define-key map [describe-input-method]
+ '(menu-item "Describe Input Method..." describe-input-method
+ :help "Keyboard layout for a specific input method"))
+ (bindings--define-key map [describe-language-environment]
+ `(menu-item "Describe Language Environment"
+ ,describe-language-environment-map
+ :help "Show multilingual settings for a specific language"))
+
+ (bindings--define-key map [separator-coding-system] menu-bar-separator)
+ (bindings--define-key map [view-hello-file]
+ '(menu-item "Show Multilingual Sample Text" view-hello-file
:enable (file-readable-p
(expand-file-name "HELLO" data-directory))
- :help ,(purecopy "Display file which says HELLO in many languages")))
- (define-key-after map [separator-coding-system] menu-bar-separator)
+ :help "Demonstrate various character sets"))
+ (bindings--define-key map [set-various-coding-system]
+ `(menu-item "Set Coding Systems" ,set-coding-system-map
+ :enable (default-value 'enable-multibyte-characters)))
- (define-key-after map [describe-language-environment]
- `(menu-item ,(purecopy "Describe Language Environment")
- ,describe-language-environment-map
- :help ,(purecopy "Show multilingual settings for a specific language")))
- (define-key-after map [describe-input-method]
- `(menu-item ,(purecopy "Describe Input Method...") describe-input-method
- :help ,(purecopy "Keyboard layout for a specific input method")))
- (define-key-after map [describe-coding-system]
- `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system))
- (define-key-after map [list-character-sets]
- `(menu-item ,(purecopy "List Character Sets") list-character-sets
- :help ,(purecopy "Show table of available character sets")))
- (define-key-after map [mule-diag]
- `(menu-item ,(purecopy "Show All of Mule Status") mule-diag
- :help ,(purecopy "Display multilingual environment settings")))
+ (bindings--define-key map [separator-input-method] menu-bar-separator)
+ (bindings--define-key map [describe-input-method]
+ '(menu-item "Describe Input Method" describe-input-method))
+ (bindings--define-key map [set-input-method]
+ '(menu-item "Select Input Method..." set-input-method))
+ (bindings--define-key map [toggle-input-method]
+ '(menu-item "Toggle Input Method" toggle-input-method))
+
+ (bindings--define-key map [separator-mule] menu-bar-separator)
+ (bindings--define-key map [set-language-environment]
+ `(menu-item "Set Language Environment" ,setup-language-environment-map))
map)
"Keymap for Mule (Multilingual environment) menu specific commands.")
@@ -285,7 +283,7 @@ wrong, use this command again to toggle back to the right mode."
"Display the HELLO file, which lists many languages and characters."
(interactive)
;; We have to decode the file in any environment.
- (letf ((coding-system-for-read 'iso-2022-7bit))
+ (let ((coding-system-for-read 'iso-2022-7bit))
(view-file (expand-file-name "HELLO" data-directory))))
(defun universal-coding-system-argument (coding-system)
@@ -353,10 +351,6 @@ This also sets the following values:
if CODING-SYSTEM is ASCII-compatible"
(check-coding-system coding-system)
(setq-default buffer-file-coding-system coding-system)
- (if (fboundp 'ucs-set-table-for-input)
- (dolist (buffer (buffer-list))
- (or (local-variable-p 'buffer-file-coding-system buffer)
- (ucs-set-table-for-input buffer))))
(if (eq system-type 'darwin)
;; The file-name coding system on Darwin systems is always utf-8.
@@ -418,7 +412,10 @@ To prefer, for instance, utf-8, say the following:
(if (memq eol-type '(0 1 2))
(setq base
(coding-system-change-eol-conversion base eol-type)))
- (set-default-coding-systems base)))
+ (set-default-coding-systems base)
+ (if (called-interactively-p 'interactive)
+ (or (eq base default-file-name-coding-system)
+ (message "The default value of `file-name-coding-system' was not changed because the specified coding system is not suitable for file names.")))))
(defvar sort-coding-systems-predicate nil
"If non-nil, a predicate function to sort coding systems.
@@ -1334,15 +1331,18 @@ of `history-length', which see.")
(make-variable-buffer-local 'input-method-history)
(put 'input-method-history 'permanent-local t)
-(defvar inactivate-current-input-method-function nil
- "Function to call for inactivating the current input method.
+(define-obsolete-variable-alias
+ 'inactivate-current-input-method-function
+ 'deactivate-current-input-method-function "24.3")
+(defvar deactivate-current-input-method-function nil
+ "Function to call for deactivating the current input method.
Every input method should set this to an appropriate value when activated.
This function is called with no argument.
This function should never change the value of `current-input-method'.
-It is set to nil by the function `inactivate-input-method'.")
-(make-variable-buffer-local 'inactivate-current-input-method-function)
-(put 'inactivate-current-input-method-function 'permanent-local t)
+It is set to nil by the function `deactivate-input-method'.")
+(make-variable-buffer-local 'deactivate-current-input-method-function)
+(put 'deactivate-current-input-method-function 'permanent-local t)
(defvar describe-current-input-method-function nil
"Function to call for describing the current input method.
@@ -1429,7 +1429,7 @@ If INPUT-METHOD is nil, deactivate any current input method."
(setq input-method (symbol-name input-method)))
(if (and current-input-method
(not (string= current-input-method input-method)))
- (inactivate-input-method))
+ (deactivate-input-method))
(unless (or current-input-method (null input-method))
(let ((slot (assoc input-method input-method-alist)))
(if (null slot)
@@ -1450,7 +1450,7 @@ If INPUT-METHOD is nil, deactivate any current input method."
(run-hooks 'input-method-activate-hook)
(force-mode-line-update)))))
-(defun inactivate-input-method ()
+(defun deactivate-input-method ()
"Turn off the current input method."
(when current-input-method
(if input-method-history
@@ -1463,12 +1463,18 @@ If INPUT-METHOD is nil, deactivate any current input method."
(progn
(setq input-method-function nil
current-input-method-title nil)
- (funcall inactivate-current-input-method-function))
+ (funcall deactivate-current-input-method-function))
(unwind-protect
- (run-hooks 'input-method-inactivate-hook)
+ (run-hooks
+ 'input-method-inactivate-hook ; for backward compatibility
+ 'input-method-deactivate-hook)
(setq current-input-method nil)
(force-mode-line-update)))))
+(define-obsolete-function-alias
+ 'inactivate-input-method
+ 'deactivate-input-method "24.3")
+
(defun set-input-method (input-method &optional interactive)
"Select and activate input method INPUT-METHOD for the current buffer.
This also sets the default input method to the one you specify.
@@ -1479,7 +1485,7 @@ When called interactively, the optional arg INTERACTIVE is non-nil,
which marks the variable `default-input-method' as set for Custom buffers.
To deactivate the input method interactively, use \\[toggle-input-method].
-To deactivate it programmatically, use `inactivate-input-method'."
+To deactivate it programmatically, use `deactivate-input-method'."
(interactive
(let* ((default (or (car input-method-history) default-input-method)))
(list (read-input-method-name
@@ -1516,7 +1522,7 @@ which marks the variable `default-input-method' as set for Custom buffers."
(if toggle-input-method-active
(error "Recursive use of `toggle-input-method'"))
(if (and current-input-method (not arg))
- (inactivate-input-method)
+ (deactivate-input-method)
(let ((toggle-input-method-active t)
(default (or (car input-method-history) default-input-method)))
(if (and arg default (equal current-input-method default)
@@ -1643,13 +1649,18 @@ just activated."
:type 'hook
:group 'mule)
-(defcustom input-method-inactivate-hook nil
- "Normal hook run just after an input method is inactivated.
+(define-obsolete-variable-alias
+ 'input-method-inactivate-hook
+ 'input-method-deactivate-hook "24.3")
+
+(defcustom input-method-deactivate-hook nil
+ "Normal hook run just after an input method is deactivated.
The variable `current-input-method' still keeps the input method name
-just inactivated."
+just deactivated."
:type 'hook
- :group 'mule)
+ :group 'mule
+ :version "24.3")
(defcustom input-method-after-insert-chunk-hook nil
"Normal hook run just after an input method insert some chunk of text."
@@ -1831,11 +1842,15 @@ The default status is as follows:
(set-terminal-coding-system (or coding-system coding) display)))
(defun set-language-environment (language-name)
- "Set up multi-lingual environment for using LANGUAGE-NAME.
+ "Set up multilingual environment for using LANGUAGE-NAME.
This sets the coding system priority and the default input method
and sometimes other things. LANGUAGE-NAME should be a string
which is the name of a language environment. For example, \"Latin-1\"
-specifies the character set for the major languages of Western Europe."
+specifies the character set for the major languages of Western Europe.
+
+If there is a prior value for `current-language-environment', this
+runs the hook `exit-language-environment-hook'. After setting up
+the new language environment, it runs `set-language-environment-hook'."
(interactive (list (read-language-name
nil
"Set language environment (default English): ")))
@@ -2043,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)
@@ -2499,7 +2514,7 @@ For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"."
locale))
(defun set-locale-environment (&optional locale-name frame)
- "Set up multi-lingual environment for using LOCALE-NAME.
+ "Set up multilingual environment for using LOCALE-NAME.
This sets the language environment, the coding system priority,
the default input method and sometimes other things.
@@ -2655,21 +2670,13 @@ See also `locale-charset-language-names', `locale-language-names',
;; On Windows, override locale-coding-system,
;; default-file-name-coding-system, keyboard-coding-system,
;; terminal-coding-system with system codepage.
- (when (boundp 'w32-ansi-code-page)
+ (when (and (eq system-type 'windows-nt)
+ (boundp 'w32-ansi-code-page))
(let ((code-page-coding (intern (format "cp%d" w32-ansi-code-page))))
(when (coding-system-p code-page-coding)
(unless frame (setq locale-coding-system code-page-coding))
(set-keyboard-coding-system code-page-coding frame)
(set-terminal-coding-system code-page-coding frame)
- ;; Set default-file-name-coding-system last, so that Emacs
- ;; doesn't try to use cpNNNN when it defines keyboard and
- ;; terminal encoding. That's because the above two lines
- ;; will want to load code-pages.el, where cpNNNN are
- ;; defined; if default-file-name-coding-system were set to
- ;; cpNNNN while these two lines run, Emacs will want to use
- ;; it for encoding the file name it wants to load. And that
- ;; will fail, since cpNNNN is not yet usable until
- ;; code-pages.el finishes loading.
(setq default-file-name-coding-system code-page-coding))))
(when (eq system-type 'darwin)
@@ -2860,13 +2867,18 @@ on encoding."
;; Backwards compatibility. These might be better with :init-value t,
;; but that breaks loadup.
(define-minor-mode unify-8859-on-encoding-mode
- "Obsolete."
+ "Exists only for backwards compatibility."
:group 'mule
:global t)
+;; Doc said "obsolete" in 23.1, this statement only added in 24.1.
+(make-obsolete 'unify-8859-on-encoding-mode "don't use it." "23.1")
+
(define-minor-mode unify-8859-on-decoding-mode
- "Obsolete."
+ "Exists only for backwards compatibility."
:group 'mule
:global t)
+;; Doc said "obsolete" in 23.1, this statement only added in 24.1.
+(make-obsolete 'unify-8859-on-decoding-mode "don't use it." "23.1")
(defvar nonascii-insert-offset 0)
(make-obsolete-variable 'nonascii-insert-offset "do not use it." "23.1")
@@ -2933,51 +2945,23 @@ at the beginning of the name.
This function also accepts a hexadecimal number of Unicode code
point or a number in hash notation, e.g. #o21430 for octal,
#x2318 for hex, or #10r8984 for decimal."
- (let* ((completion-ignore-case t)
- (input (completing-read
- prompt
- (lambda (string pred action)
- (if (eq action 'metadata)
- '(metadata (category . unicode-name))
- (complete-with-action action (ucs-names) string pred))))))
+ (let ((input
+ (completing-read
+ prompt
+ (lambda (string pred action)
+ (let ((completion-ignore-case t))
+ (if (eq action 'metadata)
+ '(metadata (category . unicode-name))
+ (complete-with-action action (ucs-names) string pred)))))))
(cond
- ((string-match-p "^[0-9a-fA-F]+$" input)
+ ((string-match-p "\\`[0-9a-fA-F]+\\'" input)
(string-to-number input 16))
- ((string-match-p "^#" input)
+ ((string-match-p "\\`#" input)
(read input))
(t
(cdr (assoc-string input (ucs-names) t))))))
-(defun ucs-insert (character &optional count inherit)
- "Insert COUNT copies of CHARACTER of the given Unicode code point.
-Interactively, prompts for a Unicode character name or a hex number
-using `read-char-by-name'.
-
-You can type a few of the first letters of the Unicode name and
-use completion. If you type a substring of the Unicode name
-preceded by an asterisk `*' and use completion, it will show all
-the characters whose names include that substring, not necessarily
-at the beginning of the name.
-
-The optional third arg INHERIT (non-nil when called interactively),
-says to inherit text properties from adjoining text, if those
-properties are sticky."
- (interactive
- (list (read-char-by-name "Unicode (name or hex): ")
- (prefix-numeric-value current-prefix-arg)
- t))
- (unless count (setq count 1))
- (if (stringp character)
- (setq character (string-to-number character 16)))
- (cond
- ((not (integerp character))
- (error "Not a Unicode character code: %S" character))
- ((or (< character 0) (> character #x10FFFF))
- (error "Not a Unicode character code: 0x%X" character)))
- (if inherit
- (dotimes (i count) (insert-and-inherit character))
- (dotimes (i count) (insert character))))
-
-(define-key ctl-x-map "8\r" 'ucs-insert)
+(define-obsolete-function-alias 'ucs-insert 'insert-char "24.3")
+(define-key ctl-x-map "8\r" 'insert-char)
;;; mule-cmds.el ends here
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index e27424b2328..11207b0b78d 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1,6 +1,6 @@
;;; mule-conf.el --- configure multilingual environment
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
@@ -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 efb910a3ef6..43af785cc2f 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -1,6 +1,6 @@
;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
-;; Copyright (C) 1997-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -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 f0a5ebbee40..3dc0b54421a 100644
--- a/lisp/international/mule-util.el
+++ b/lisp/international/mule-util.el
@@ -1,6 +1,6 @@
;;; mule-util.el --- utility functions for multilingual environment (mule)
-;; Copyright (C) 1997-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -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 1beffa5218b..922bec64c86 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1,6 +1,6 @@
;;; mule.el --- basic commands for multilingual environment
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -30,6 +30,7 @@
;;; Code:
+;; FIXME? Are these still relevant? Nothing uses them AFAICS.
(defconst mule-version "6.0 (HANACHIRUSATO)" "\
Version number and name of this version of MULE (multilingual environment).")
@@ -165,7 +166,7 @@ compatibility.
VALUE must be a nonnegative integer that can be used as an invalid
code point of the charset. If the minimum code is 0 and the maximum
-code is greater than Emacs' maximum integer value, `:invalid-code'
+code is greater than Emacs's maximum integer value, `:invalid-code'
should not be omitted.
`:code-offset'
@@ -408,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.
@@ -463,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
@@ -472,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)))
@@ -1011,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
@@ -1103,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."
@@ -1355,19 +1355,25 @@ graphical terminals."
(t
(error "Unsupported coding system for keyboard: %s"
coding-system)))
- (when accept-8-bit
- (or saved-meta-mode
- (set-terminal-parameter terminal
- 'keyboard-coding-saved-meta-mode
- (cons (nth 2 (current-input-mode))
- nil)))
- (set-input-meta-mode 8))
+ (if accept-8-bit
+ (progn
+ (or saved-meta-mode
+ (set-terminal-parameter terminal
+ 'keyboard-coding-saved-meta-mode
+ (cons (nth 2 (current-input-mode))
+ nil)))
+ (set-input-meta-mode 8 terminal))
+ (when saved-meta-mode
+ (set-input-meta-mode (car saved-meta-mode) terminal)
+ (set-terminal-parameter terminal
+ 'keyboard-coding-saved-meta-mode
+ nil)))
;; Avoid end-of-line conversion.
(setq coding-system
(coding-system-change-eol-conversion coding-system 'unix)))
(when saved-meta-mode
- (set-input-meta-mode (car saved-meta-mode))
+ (set-input-meta-mode (car saved-meta-mode) terminal)
(set-terminal-parameter terminal
'keyboard-coding-saved-meta-mode
nil))))
@@ -1448,9 +1454,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
@@ -1668,6 +1674,7 @@ in-place."
;;; FILE I/O
+;; TODO many elements of this list are also in inhibit-local-variables-regexps.
(defcustom auto-coding-alist
;; .exe and .EXE are added to support archive-mode looking at DOS
;; self-extracting exe archives.
@@ -1677,7 +1684,7 @@ arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|\
ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'"
. no-conversion-multibyte)
("\\.\\(exe\\|EXE\\)\\'" . no-conversion)
- ("\\.\\(sx[dmicw]\\|odt\\|tar\\|tgz\\)\\'" . no-conversion)
+ ("\\.\\(sx[dmicw]\\|odt\\|tar\\|t[bg]z\\)\\'" . no-conversion)
("\\.\\(gz\\|Z\\|bz\\|bz2\\|xz\\|gpg\\)\\'" . no-conversion)
("\\.\\(jpe?g\\|png\\|gif\\|tiff?\\|p[bpgn]m\\)\\'" . no-conversion)
("\\.pdf\\'" . no-conversion)
@@ -1753,8 +1760,9 @@ functions, so they won't be called at all."
:type '(repeat function))
(defvar set-auto-coding-for-load nil
- "Non-nil means look for `load-coding' property instead of `coding'.
-This is used for loading and byte-compiling Emacs Lisp files.")
+ "Non-nil means respect a \"unibyte: t\" entry in file local variables.
+Emacs binds this variable to t when loading or byte-compiling Emacs Lisp
+files.")
(defun auto-coding-alist-lookup (filename)
"Return the coding system specified by `auto-coding-alist' for FILENAME."
@@ -1833,6 +1841,8 @@ If nothing is specified, the return value is nil."
(re-search-forward
"\\(.*;\\)?[ \t]*unibyte:[ \t]*\\([^ ;]+\\)"
head-end t))
+ (display-warning 'mule "`unibyte: t' is obsolete; \
+use \"coding: 'raw-text\" instead." :warning)
(setq coding-system 'raw-text))
(when (and (not coding-system)
(re-search-forward
@@ -1885,6 +1895,8 @@ If nothing is specified, the return value is nil."
(goto-char pos)
(when (and set-auto-coding-for-load
(re-search-forward re-unibyte tail-end t))
+ (display-warning 'mule "`unibyte: t' is obsolete; \
+use \"coding: 'raw-text\" instead." :warning)
(setq coding-system 'raw-text))
(when (and (not coding-system)
(re-search-forward re-coding tail-end t))
@@ -2349,9 +2361,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/ogonek.el b/lisp/international/ogonek.el
index cc8d1e25c66..3c34e5d9a2a 100644
--- a/lisp/international/ogonek.el
+++ b/lisp/international/ogonek.el
@@ -1,6 +1,6 @@
;;; ogonek.el --- change the encoding of Polish diacritics
-;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: W{\l}odek Bzyl
;; Ryszard Kubiak
@@ -224,13 +224,14 @@ The functions come in the following groups.
ogonek-prefix-to-encoding iso8859-2
The above default values can be changed by placing appropriate settings
- in the '~/.emacs' file:
+ in your init file:
(setq ogonek-prefix-char ?/)
(setq ogonek-prefix-to-encoding \"iso8859-2\")
- Instead of loading the whole library `ogonek' it may be better to
- autoload the needed functions, for example by placing in `~/.emacs':
+ Instead of loading the whole library `ogonek' it may be better
+ to autoload the needed functions, for example by adding the
+ following lines to your init file:
(autoload 'ogonek-how \"ogonek\")
(autoload 'ogonek-recode-region \"ogonek\")
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 3e0f543492a..4669528c9a7 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1,6 +1,6 @@
;;; quail.el --- provides simple input method for multilingual text
-;; Copyright (C) 1997-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -53,7 +53,7 @@
;;; Code:
(require 'help-mode)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup quail nil
"Quail: multilingual input method."
@@ -486,19 +486,15 @@ non-Quail commands."
(setq translation-keymap (copy-keymap
(if simple quail-simple-translation-keymap
quail-translation-keymap)))
- (while translation-keys
- (define-key translation-keymap
- (car (car translation-keys)) (cdr (car translation-keys)))
- (setq translation-keys (cdr translation-keys))))
+ (dolist (trans translation-keys)
+ (define-key translation-keymap (car trans) (cdr trans))))
(setq translation-keymap
(if simple quail-simple-translation-keymap
quail-translation-keymap)))
(when conversion-keys
(setq conversion-keymap (copy-keymap quail-conversion-keymap))
- (while conversion-keys
- (define-key conversion-keymap
- (car (car conversion-keys)) (cdr (car conversion-keys)))
- (setq conversion-keys (cdr conversion-keys))))
+ (dolist (conv conversion-keys)
+ (define-key conversion-keymap (car conv) (cdr conv))))
(quail-add-package
(list name title (list nil) guidance (or docstring "")
translation-keymap
@@ -544,32 +540,36 @@ non-Quail commands."
(if (and (overlayp quail-conv-overlay) (overlay-start quail-conv-overlay))
(delete-overlay quail-conv-overlay)))
-(defun quail-inactivate ()
- "Inactivate Quail input method.
+(defun quail-deactivate ()
+ "Deactivate Quail input method.
-This function runs the normal hook `quail-inactivate-hook'."
+This function runs the normal hook `quail-deactivate-hook'."
(interactive)
(quail-activate -1))
+(define-obsolete-function-alias 'quail-inactivate 'quail-deactivate "24.3")
+
(defun quail-activate (&optional arg)
"Activate Quail input method.
With ARG, activate Quail input method if and only if arg is positive.
This function runs `quail-activate-hook' if it activates the input
-method, `quail-inactivate-hook' if it deactivates it.
+method, `quail-deactivate-hook' if it deactivates it.
While this input method is active, the variable
`input-method-function' is bound to the function `quail-input-method'."
(if (and arg
(< (prefix-numeric-value arg) 0))
- ;; Let's inactivate Quail input method.
+ ;; Let's deactivate Quail input method.
(unwind-protect
(progn
(quail-delete-overlays)
(setq describe-current-input-method-function nil)
(quail-hide-guidance)
(remove-hook 'post-command-hook 'quail-show-guidance t)
- (run-hooks 'quail-inactivate-hook))
+ (run-hooks
+ 'quail-inactivate-hook ; for backward compatibility
+ 'quail-deactivate-hook))
(kill-local-variable 'input-method-function))
;; Let's activate Quail input method.
(if (null quail-current-package)
@@ -579,7 +579,7 @@ While this input method is active, the variable
(setq name (car (car quail-package-alist)))
(error "No Quail package loaded"))
(quail-select-package name)))
- (setq inactivate-current-input-method-function 'quail-inactivate)
+ (setq deactivate-current-input-method-function 'quail-deactivate)
(setq describe-current-input-method-function 'quail-help)
(quail-delete-overlays)
(setq quail-guidance-str "")
@@ -593,8 +593,12 @@ While this input method is active, the variable
(make-local-variable 'input-method-function)
(setq input-method-function 'quail-input-method)))
+(define-obsolete-variable-alias
+ 'quail-inactivate-hook
+ 'quail-deactivate-hook "24.3")
+
(defun quail-exit-from-minibuffer ()
- (inactivate-input-method)
+ (deactivate-input-method)
(if (<= (minibuffer-depth) 1)
(remove-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer)))
@@ -720,12 +724,11 @@ The command `quail-set-keyboard-layout' usually sets this variable."
(setq quail-keyboard-layout-substitution subst-list)
;; If there are additional key locations, map them to missing
;; key locations.
- (while missing-list
+ (dolist (missing missing-list)
(while (and subst-list (cdr (car subst-list)))
(setq subst-list (cdr subst-list)))
(if subst-list
- (setcdr (car subst-list) (car missing-list)))
- (setq missing-list (cdr missing-list))))))
+ (setcdr (car subst-list) missing))))))
(defcustom quail-keyboard-layout-type "standard"
"Type of keyboard layout used in Quail base input method.
@@ -806,9 +809,10 @@ The format of KBD-LAYOUT is the same as `quail-keyboard-layout'."
(if translation
(progn
(if (consp translation)
- (if (> (length (cdr translation)) 0)
- (setq translation (aref (cdr translation) 0))
- (setq translation " ")))
+ (setq translation
+ (if (> (length (cdr translation)) 0)
+ (aref (cdr translation) 0)
+ " ")))
(setq done-list (cons translation done-list)))
(setq translation (aref kbd-layout i)))
(aset layout i translation))
@@ -831,10 +835,26 @@ The format of KBD-LAYOUT is the same as `quail-keyboard-layout'."
(setq lower (aref layout i)
upper (aref layout (1+ i)))
(insert bar)
- (if (= (if (stringp lower) (string-width lower) (char-width lower)) 1)
+ (if (< (if (stringp lower) (string-width lower) (char-width lower)) 2)
(insert " "))
- (insert lower upper)
- (if (= (if (stringp upper) (string-width upper) (char-width upper)) 1)
+ (if (characterp lower)
+ (setq lower
+ (if (eq (get-char-code-property lower 'general-category) 'Mn)
+ ;; Pad the left and right of non-spacing characters.
+ (compose-string (string lower) 0 1
+ (format "\t%c\t" lower))
+ (string lower))))
+ (if (characterp upper)
+ (setq upper
+ (if (eq (get-char-code-property upper 'general-category) 'Mn)
+ ;; Pad the left and right of non-spacing characters.
+ (compose-string (string upper) 0 1
+ (format "\t%c\t" upper))
+ (string upper))))
+ (insert (bidi-string-mark-left-to-right lower)
+ (propertize " " 'invisible t)
+ (bidi-string-mark-left-to-right upper))
+ (if (< (string-width upper) 2)
(insert " "))
(setq i (+ i 2))
(if (= (% i 30) 0)
@@ -849,20 +869,21 @@ The format of KBD-LAYOUT is the same as `quail-keyboard-layout'."
;;(delete-region pos (point)))
(let ((from1 100) (to1 0) from2 to2)
(while (not (eobp))
- (if (looking-at "[| ]*$")
+ (if (looking-at "[| \u202c\u202d]*$")
;; The entire row is blank.
(delete-region (point) (match-end 0))
;; Delete blank key columns at the head.
- (if (looking-at " *\\(| \\)+")
+ (if (looking-at "\u202d? *\\(| \\)+")
(subst-char-in-region (point) (match-end 0) ?| ? ))
;; Delete blank key columns at the tail.
- (if (re-search-forward "\\( |\\)+$" (line-end-position) t)
+ (if (re-search-forward "\\( |\\)+\u202c?$"
+ (line-end-position) t)
(delete-region (match-beginning 0) (point)))
(beginning-of-line))
;; Calculate the start and end columns of a horizontal line.
(if (eolp)
(setq from2 from1 to2 to1)
- (skip-chars-forward " ")
+ (skip-chars-forward " \u202d")
(setq from2 (current-column))
(end-of-line)
(setq to2 (current-column))
@@ -1017,8 +1038,8 @@ the following annotation types are supported.
(let ((map (list nil))
(decode-map (if (not no-decode-map) (list 'decode-map)))
key trans)
- (while l
- (setq key (car (car l)) trans (car (cdr (car l))) l (cdr l))
+ (dolist (el l)
+ (setq key (car el) trans (car (cdr el)))
(quail-defrule-internal key trans map t decode-map props))
`(if (prog1 (quail-decode-map)
(quail-install-map ',map))
@@ -1186,7 +1207,7 @@ function `quail-define-rules' for the detail."
(if (stringp trans)
(setq trans (string-to-vector trans))))
(let ((new (quail-vunion prevchars trans)))
- (setq trans
+ (setq trans
(if (equal new prevchars)
;; Nothing to change, get back to orig value.
prev
@@ -1200,10 +1221,8 @@ where VECTOR is a vector of candidates (character or string) for
the translation, and INDEX points into VECTOR to specify the currently
selected translation."
(if (and def (symbolp def))
- (if (functionp def)
- ;; DEF is a symbol of a function which returns valid translation.
- (setq def (funcall def key len))
- (setq def nil)))
+ ;; DEF is a symbol of a function which returns valid translation.
+ (setq def (if (functionp def) (funcall def key len))))
(if (and (consp def) (not (vectorp (cdr def))))
(setq def (car def)))
@@ -2384,10 +2403,10 @@ should be made by `quail-build-decode-map' (which see)."
(let ((last-col-elt (or (nth (1- (* (1+ col) newrows))
single-list)
(car (last single-list)))))
- (incf width (+ (max 3 (length (car last-col-elt)))
- 1 single-trans-width 1))))
+ (cl-incf width (+ (max 3 (length (car last-col-elt)))
+ 1 single-trans-width 1))))
(< width window-width))
- (incf cols))
+ (cl-incf cols))
(setq rows (/ (+ len cols -1) cols)) ;Round up.
(let ((key-width (max 3 (length (car (nth (1- rows) single-list))))))
(insert "key")
@@ -2485,6 +2504,11 @@ package to describe."
;; the width of the window in which the buffer displayed.
(with-current-buffer (help-buffer)
(setq buffer-read-only nil)
+ ;; Without this, a keyboard layout with R2L characters might be
+ ;; displayed reversed, right to left. See the thread starting at
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00062.html
+ ;; for a description of one such situation.
+ (setq bidi-paragraph-direction 'left-to-right)
(insert "Input method: " (quail-name)
" (mode line indicator:"
(quail-title)
diff --git a/lisp/international/robin.el b/lisp/international/robin.el
index c50277686ff..897075f0faf 100644
--- a/lisp/international/robin.el
+++ b/lisp/international/robin.el
@@ -127,7 +127,7 @@
;; Use the symbol `robin-use-package' as the third argument.
-;; The fourth argument is the prompt that appears in modeline when this
+;; The fourth argument is the prompt that appears in mode line when this
;; input method is active.
;; The fifth argument is a documentation string; it may or may not be
@@ -390,12 +390,14 @@ A nil value means no package is selected.")
(setq robin-current-package-name name)
(robin-activate)))
-(defun robin-inactivate ()
- "Inactivate robin input method."
+(defun robin-deactivate ()
+ "Deactivate robin input method."
(interactive)
(robin-activate -1))
+(define-obsolete-function-alias 'robin-inactivate 'robin-deactivate "24.3")
+
(defun robin-activate (&optional arg)
"Activate robin input method.
@@ -406,18 +408,20 @@ While this input method is active, the variable
(if (and arg
(< (prefix-numeric-value arg) 0))
- ;; inactivate robin input method.
+ ;; deactivate robin input method.
(unwind-protect
(progn
(setq robin-mode nil)
(setq describe-current-input-method-function nil)
- (run-hooks 'robin-inactivate-hook))
+ (run-hooks
+ 'robin-inactivate-hook ; for backward compatibility
+ 'robin-deactivate-hook))
(kill-local-variable 'input-method-function))
;; activate robin input method.
(setq robin-mode t
describe-current-input-method-function 'robin-help
- inactivate-current-input-method-function 'robin-inactivate)
+ deactivate-current-input-method-function 'robin-deactivate)
(if (eq (selected-window) (minibuffer-window))
(add-hook 'minibuffer-exit-hook 'robin-exit-from-minibuffer))
(run-hooks 'input-method-activate-hook
@@ -425,8 +429,12 @@ While this input method is active, the variable
(set (make-local-variable 'input-method-function)
'robin-input-method)))
+(define-obsolete-variable-alias
+ 'robin-inactivate-hook
+ 'robin-deactivate-hook "24.3")
+
(defun robin-exit-from-minibuffer ()
- (inactivate-input-method)
+ (deactivate-input-method)
(if (<= (minibuffer-depth) 1)
(remove-hook 'minibuffer-exit-hook 'robin-exit-from-minibuffer)))
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index 304dc01abe4..a8f23adcf6d 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -1,6 +1,6 @@
;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding:iso-2022-7bit; -*-
-;; Copyright (C) 1997-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -1204,8 +1204,4 @@ to store generated Quail packages."
(miscdic-convert filename dir))))
(kill-emacs 0))
-;; Local Variables:
-;; coding: iso-2022-7bit
-;; End:
-
;;; titdic-cnv.el ends here
diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el
index 8d13eb2039d..54566e1d004 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -1,6 +1,6 @@
;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Taichi Kawabata <kawabata.taichi@gmail.com>
;; Keywords: unicode, normalization
@@ -109,7 +109,7 @@
(defconst ucs-normalize-version "1.2")
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(declare-function nfd "ucs-normalize" (char))
@@ -179,7 +179,7 @@
(let ((char 0) ccc decomposition)
(mapc
(lambda (start-end)
- (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
+ (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
(setq ccc (ucs-normalize-ccc char))
(setq decomposition (get-char-code-property
char 'decomposition))
@@ -270,7 +270,7 @@ Note that Hangul are excluded.")
(let (decomposition alist)
(mapc
(lambda (start-end)
- (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
+ (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
(setq decomposition (funcall decomposition-function char))
(if decomposition
(setq alist (cons (cons char
@@ -391,7 +391,7 @@ decomposition."
(let (entries decomposition composition)
(mapc
(lambda (start-end)
- (do ((i (car start-end) (+ i 1))) ((> i (cdr start-end)))
+ (cl-do ((i (car start-end) (+ i 1))) ((> i (cdr start-end)))
(setq decomposition
(string-to-list
(with-temp-buffer
diff --git a/lisp/international/uni-bidi.el b/lisp/international/uni-bidi.el
index 4d86fc821fa..ba1bd436b23 100644
--- a/lisp/international/uni-bidi.el
+++ b/lisp/international/uni-bidi.el
@@ -4,9 +4,9 @@
;; See lisp/international/README for the copyright and permission notice.
(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 "ƒ·„ˆ„ƒ‡Šœ" "º„„ˆ”Ž‡„" "¹„„ƒƒžƒŠ" "¹„…„”Ž" "º„ˆˆ‹œ" "½Œ¥†…" "¾ƒ…ƒ„‡‹”‡" "¼”œ" "Á„ˆ”œ" "ʇƒ©" "±‡„‡ˆ±" "±†‹†²" "˜›„³Ž" "……‹¤‰¹"] #^^[2 4096 "­„†™„ƒ„‹" "†â" 1 1 1 1 "݃ " "Šæ" "ÿ" 1 1 1 1 "šã" "’ƒƒžŒ" "·‡ˆ‹‡’Š†" "‹ƒñ" "©Ö" " ƒ„‰†ƒ„ƒº" "Þ¢" "—½‡ˆ†Š" 1 "„°……¨‰Œ" " „¼ƒƒŽ" "¬ˆÈ" "Ѓ‡„’" 1 "À§•„" 1 1 1 "½ƒ‹ƒƒƒ"] #^^[2 8192 "‹ƒ˜
- …š……†ƒ† ƒ" "Š ƒ‘š–¡" "„Šƒ…†„‹„……„ " "‰†ð" "’ ì" 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 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 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 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 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
+#^^[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
#^^[3 178176 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 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 192512 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] 1 1 1 1 1 1 1 1 1 1 1 #^^[1 917504 #^^[2 917504 "žà" 1 16 "ð" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[1 983040 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[2 1044480 1 1 1 1 1 1 1 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 94b7c18b6e2..75ebc04c98f 100644
--- a/lisp/international/uni-category.el
+++ b/lisp/international/uni-category.el
@@ -4,21 +4,21 @@
;; See lisp/international/README for the copyright and permission notice.
(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] " „   ƒ—‡˜ˆ" "" "ƒ„ƒƒƒƒ„ƒ" "‡„±" "”›’„ŒŽ…‡‘" "ðƒ" "„ƒ‘‰£ƒƒ…ƒ" "°°" "…" "‰¦†Ÿ" "ˆ †­ ˆ›…ƒ‹" "„ƒ‹ Š• Š„" "Ô‡†„ Šƒ" "Žž›³" "¦‹Ž Š¡‰ƒ…" "–„‰ƒ…™ƒ¡" 30 "ƒ¶ƒˆ„‡Š Š†‡" "ˆ–‡ƒ„ƒ„ˆ„ƒ Š †„" "†„–‡ƒ„ƒƒ‡„‡ ŠƒŠ" "‰ƒ–‡…ƒ… ŠŽ" "ˆ–‡…„ˆ„ƒ Š †ˆ" "†ƒƒ„ƒƒƒƒƒŒ„ƒƒƒ†Ž Š ƒ†…" "ƒˆƒ—Š…ƒƒ„ƒ„‡† Šˆ ‡" "ˆƒ—Š……‡‡ Š" "ˆƒ©ƒ„ƒƒˆˆ Š †ƒ†" "’ƒ˜‰‡ƒ„ƒƒˆ’‹" "°‡„†ˆ Š¤" "†„‡ƒ„†…† Š¢" "ƒ…† Š Šˆ¤„Ž" "……‹¤ˆ†…„¥"] #^^[2 4096 "«„† Š††„ƒƒ‡ƒ„‹" "† Šƒ¦Š«ƒ" 5 5 "É„‡„ " "‰„¡„‡„¨" "‘„È ”ƒ" "Š†Õ‹" " ÿ" 5 5 5 "í‘" "šƒËƒ
-ƒ" "„ƒ‹’ƒ‰’ŒƒŒ" "´‡ˆ‹ƒƒ Š† Š†" "† „ƒ Š†£´ˆ" "©…ÆŠ" "ƒƒ„ƒ„†ƒ„ƒ Šž…‹" "¬„‘‡† Š ƒ¢" "—ƒµ‡ˆ†Š" " Š† Š†‡†Ò" "„¯……‡„ Š‡Š‰‰ƒ" "ž„ƒ Š†¦ƒƒˆ„" "¤ˆˆƒ… Šƒƒ Šž†" "Ѓ‡„„" "¬¶–‡" "›¥§•„" "" "‰" "ˆˆ††ˆˆˆˆ††ˆˆˆŽ" "ˆˆˆˆˆˆ…„ƒƒ„ƒ„„ƒˆ…ƒƒ„"] #^^[2 8192 "‹… †ˆ…‰„ ƒ‹ Š……†  †ƒ" " Šƒƒš–„ƒŒ" "„ƒƒ…†„„„…„ 
+#^^[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 "‹… †ˆ…‰„ ƒ‹ Š……†  †ƒ" " Šƒƒ›•„ƒŒ" "„ƒƒ…†„„„…„ 
 " "
ƒ
-„ †……„‡ŸŸŒ" 19 19 "ˆ„”‡Ñƒ" "›™¨†’Œ" "§™‹•  " " œÎ –" 22 "·‰¶ˆ" "ï" 22 "ç Š" " ”¬…„˜" 22 22 19 "ƒ¿ " 19 19 "°•†ƒŠ¦" 30 "¯¯ƒ„‡" "†ƒ‡„ " "¦Š¶‰Ž" "—‰‡‡‡‡‡‡‡‡ " "ƒ‰  …Î" "šÙŒ" 22 "ÖšŒ„"] #^^[2 12288 "ƒ
+„ †……„‡ŸŸŒ" 19 19 "ˆ„”‡Ñƒ" "›™¨†’Œ" "§™‹•  " " œÎ –" 22 "·‰¶ˆ" "ï" 22 "ç Š" " ”¬…Ÿ" 22 22 19 "ƒ¿ " 19 19 "°•†ƒŠ¦" 30 "¯¯ƒ„†" "†ƒ…„ " "¦…¸‡Ž" "—‰‡‡‡‡‡‡‡‡ " "ƒ‰  …Š Ä" "šÙŒ" 22 "ÖšŒ„"] #^^[2 12288 "ƒ
 
-‰† …
-ƒ¿" "— Úƒ" "…©ƒÏ" " „Š›…¤Œ" "Ÿ Š§  " " Š§ ¿" 22 22 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5] #^^[2 16384 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 "¶ŠÀ" 5 5 5 5] 5 5 5 5 #^^[2 36864 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5
-#^^[3 40832 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30]] #^^[2 40960 "•ê" 5 5 5 5 5 5 5 5 "ƒ·‰¨†" 5 5 "Œƒ Š”ƒˆ" "ˆÆ
-Š†ˆ" "—‰ƒˆ" "ŽÐ…" "ƒ„—„„ ††´„ˆ" "²‰ Š†’†ƒ„" " Šœˆ—‹‹ƒ" "ƒ¯„„ Š„ " "©†‰ƒˆ Š„†ƒ„" "°ƒ…˜ " "†††‰‡‡Ñ" "À£ Š†" 5 5 5 5 5 5 5 5] 5 5 #^^[2 53248 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 "¤Œ—„±„" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 29 #^^[2 61440 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 5 5 "®¾" "Ú¦" "‡Œ……Š…º" "²‘­" 5 5 "¾°" "¶¨Œ" "‡†‡‰ „ ƒƒ„ ƒ ƒ„…Š" "ý" "ƒƒ  Šƒš šŠ" "žŸƒ†††ƒƒ„Šƒ"]] #^^[1 65536 #^^[2 65536 "Œš“Ž¢" "û…" "„ ­ƒ‰
+‰„ …
+ƒ¿" "— Úƒ" "…©ƒÏ" " „Š›…¤Œ" "Ÿ Šž ˆ  " " Š§ ¿" 22 22 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5] #^^[2 16384 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 "¶ŠÀ" 5 5 5 5] 5 5 5 5 #^^[2 36864 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5
+#^^[3 40832 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30]] #^^[2 40960 "•ê" 5 5 5 5 5 5 5 5 "ƒ·‰¨†" 5 5 "Œƒ Š”ƒŠ" "‡Æ
+Š†ˆ" "—‰ƒˆ" "ŒÍ…" "ƒ„—„„ ††´„ˆ" "²‰ Š†’†ƒ„" " Šœˆ—‹‹ƒ" "ƒ¯„„ Š„ " "©†‰ƒˆ Š„†ƒ„" "°ƒ…˜‹‰" "†††‰‡‡Ñ" "À£ Š†" 5 5 5 5 5 5 5 5] 5 5 #^^[2 53248 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 "¤Œ—„±„" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 29 #^^[2 61440 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 5 5 "î" "Ú¦" "‡Œ……Š…º" "²‘­" 5 5 "¾°" "¶¨Œ" "‡†‡‰ „ ƒƒ„ ƒ ƒ„…Š" "ý" "ƒƒ  Šƒš šŠ" "žŸƒ†††ƒƒ„Šƒ"]] #^^[1 65536 #^^[2 65536 "Œš“Ž¢" "û…" "ƒ„ ­ƒ‰
µ „‡" "Š …Œ´­" 30 "ƒ±¯" "Ÿ „Œ‘
µ" "ž¤„ˆ
-…ª" "¨¨°" "ž ŠÖ" 30 30 30 30 30 30 "†¬ƒ— ˆ " 30 "– †ƒš…À" 30 "ƒ…„„ƒ›„ƒ„ ˆˆ‰‡ " 30 "¶ƒ‡– ˆ“… ˆ" 30 "É·" 30 30 30 "à Ÿ" 30 30 30] #^^[2 69632 "µ‡„ ” Š" "­ƒ„„¾" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[2 73728 5 5 5 5 5 5 "ï‘" 30 "
-㍄Œ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[2 77824 5 5 5 5 5 5 5 5 "¯Ñ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 #^^[2 90112 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 5 5 5 5 "¹Ç" 30 30 30 30 30 30 30 30 30 30 30] 30 30 30 30 #^^[2 110592 "þ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 #^^[2 118784 22 "öŠ" "§¼ƒƒ†ˆ…" "ƒ‡ž„°¢" "ƒº" 30 "׉ ’Ž" 30 "ššš‡’˜" "š„ˆ„‡‹š–" "„„ˆ‡š„…ƒ‡š”" "†šššš’" "ˆšššš" "Šœ™™†™„" "•†™™†™" "‰†™™† ²" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 #^^[2 126976 "¬„Ð" "”ŒŽ " " ‹…Ÿº†" "›Ëš" "ƒ«…‰‡®" 30 "¡†Æƒ" "”Œ¥…•‘" "¿¾" "ø„ƒ" "¾’˜˜" "û…" "ƒƒ†„„Œ„‹°" "ƺ" "ôŒ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30]] #^^[1 131072 5 5 5 5 5 5 5 5 5 5 #^^[2 172032 5 5 5 5 5 5 5 5 5 5 5 5 5
+…ª" "¨¨°" "ž ŠÖ" 30 30 30 30 30 30 "†¬ƒ— ˆ " 30 "– †ƒš…À" "¸†À" "ƒ…„„ƒ›„ƒ„ ˆˆ‰‡ " 30 "¶ƒ‡– ˆ“… ˆ" 30 "É·" 30 30 30 "à Ÿ" 30 30 30] #^^[2 69632 "µ‡„ ” Š" "­ƒ„„Ž™‡ Š†" "ƒ¤…ˆ Š„¼" "°ƒ‰„„‡ Š¦" 30 30 30 30 30 30 30 30 30 "«†ˆ Š¶" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[2 73728 5 5 5 5 5 5 "ï‘" 30 "
+㍄Œ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[2 77824 5 5 5 5 5 5 5 5 "¯Ñ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 #^^[2 90112 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 5 5 5 5 "¹Ç" 30 30 30 30 30 30 30 30 30 "Å‹®" "„à"] 30 30 30 30 #^^[2 110592 "þ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 #^^[2 118784 22 "öŠ" "§¼ƒƒ†ˆ…" "ƒ‡ž„°¢" "ƒº" 30 "׉ ’Ž" 30 "ššš‡’˜" "š„ˆ„‡‹š–" "„„ˆ‡š„…ƒ‡š”" "†šššš’" "ˆšššš" "Šœ™™†™„" "•†™™†™" "‰†™™† ²" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[2 122880 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 "„›Š„†„ƒ„‡„„" "Š‘…ƒ…‘´Ž" 30 30] #^^[2 126976 "¬„Ð" "”ŒŽ " " ‹…Ÿ¼„" "›Ëš" "ƒ«…‰‡®" 30 "¡†Æƒ" "”Œ¥…•‘" "¿¾" "ø„ƒ" "¾„Œ˜˜" "û…" "Á„‹°" "ƺ" "ôŒ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30]] #^^[1 131072 5 5 5 5 5 5 5 5 5 5 #^^[2 172032 5 5 5 5 5 5 5 5 5 5 5 5 5
#^^[3 173696 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5] #^^[2 176128 5 5 5 5 5 5 5 5 5 5 5 5 5 5
#^^[3 177920 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5] 5
#^^[3 178176 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 30 #^^[2 192512 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 5 5 5 5 "žâ" 30 30 30 30 30 30 30 30 30 30 30]] 30 30 30 30 30 30 30 30 30 30 30 #^^[1 917504 #^^[2 917504 "žà" 30 6 "ð" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[1 983040 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 #^^[2 1044480 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29
diff --git a/lisp/international/uni-combining.el b/lisp/international/uni-combining.el
index 1437ff9acbd..3863f95f881 100644
--- a/lisp/international/uni-combining.el
+++ b/lisp/international/uni-combining.el
@@ -6,9 +6,9 @@
- " 1 1 "ƒ…ø" 1 "‘„ƒ ††  ¸" "ˆ° !\"#$…%" "Ö‡„’" "‘&žƒƒµ" "뇌" "–„‰ƒ…«ƒ¤" 1 "¼'(ƒ«" "¼'(²" "¼'(²" "¼'(²" "¼'(²" "Í(²" "Í(‡)*©" "¼'(²" "Í(²" "Ê(µ" "¸++(,„´" "¸--Ž.„´" "˜›·/01…0„" "0(¾¹"] #^^[2 4096 "·'((Å" "ò" 1 1 1 1 "݃ " 1 1 1 1 1 1 1 "”(Ÿ(Ë" "Ò(Š¢" 1 "© Ö" "¹ Ä" 1 "—Ç(”ˆ" 1 "´'(¦‡Œ" "ª(»'‹((Œ" "·'È" "Ѓ…„‡„’" 1 "À‡
+ " 1 1 "ƒ…ø" 1 "‘„ƒ ††  ¸" "ˆ° !\"#$…%" "Ö‡„’" "‘&žƒƒµ" "뇌" "–„‰ƒ…«ƒ¤" "䃃 !\"ƒ„" "¼'(ƒ«" "¼'(²" "¼'(²" "¼'(²" "¼'(²" "Í(²" "Í(‡)*©" "¼'(²" "Í(²" "Ê(µ" "¸++(,„´" "¸--Ž.„´" "˜›·/01…0„" "0(¾¹"] #^^[2 4096 "·'((Å" "ò" 1 1 1 1 "݃ " 1 1 1 1 1 1 1 "”(Ÿ(Ë" "Ò(Š¢" 1 "© Ö" "¹ Ä" 1 "—Ç(”ˆ" 1 "´'(¦‡Œ" "ª((º'‹((Œ" "·'È" "Ѓ…„‡„†‹" 1 "À‡
2–• " 1 1 1 1] #^^[2 8192 1 "Єƒ„ƒ„" 1 1 1 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 12288 "ª3  44Ð" "™55å" 1 1 1 1 1 1 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 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 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 "ž6á" 1 1 1 1 1 " ‡Ù" 1 1 1]] #^^[1 65536 #^^[2 65536 1 1 1 "ý" 1 1 1 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 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 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 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 "僃7…ˆ…" "ƒ…ž„Ò" "ƒ»" 1 1 1 1 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 126976 1 1 1 1 1 1 1 1 1 1 1 1 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 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 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 "ž6á" 1 1 1 1 1 " ‡Ù" 1 1 1]] #^^[1 65536 #^^[2 65536 1 1 1 "ý" 1 1 1 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 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 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 "僃7…ˆ…" "ƒ…ž„Ò" "ƒ»" 1 1 1 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 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 126976 1 1 1 1 1 1 1 1 1 1 1 1 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
#^^[3 178176 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 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 192512 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] 1 1 1 1 1 1 1 1 1 1 1 #^^[1 917504 #^^[2 917504 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[1 983040 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[2 1044480 1 1 1 1 1 1 1 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-comment.el b/lisp/international/uni-comment.el
index 21ccfe3ffe7..c9743064bd4 100644
--- a/lisp/international/uni-comment.el
+++ b/lisp/international/uni-comment.el
Binary files differ
diff --git a/lisp/international/uni-decimal.el b/lisp/international/uni-decimal.el
index 096257add20..1866e7c4354 100644
--- a/lisp/international/uni-decimal.el
+++ b/lisp/international/uni-decimal.el
Binary files differ
diff --git a/lisp/international/uni-decomposition.el b/lisp/international/uni-decomposition.el
index b9660cdab0a..2bcca9e60fb 100644
--- a/lisp/international/uni-decomposition.el
+++ b/lisp/international/uni-decomposition.el
Binary files differ
diff --git a/lisp/international/uni-digit.el b/lisp/international/uni-digit.el
index efb78b0e43d..405d59784a7 100644
--- a/lisp/international/uni-digit.el
+++ b/lisp/international/uni-digit.el
Binary files differ
diff --git a/lisp/international/uni-lowercase.el b/lisp/international/uni-lowercase.el
index 7afd9503cb3..81196499150 100644
--- a/lisp/international/uni-lowercase.el
+++ b/lisp/international/uni-lowercase.el
Binary files differ
diff --git a/lisp/international/uni-mirrored.el b/lisp/international/uni-mirrored.el
index e650166c24c..c34184c0d6b 100644
--- a/lisp/international/uni-mirrored.el
+++ b/lisp/international/uni-mirrored.el
Binary files differ
diff --git a/lisp/international/uni-name.el b/lisp/international/uni-name.el
index 8b681631067..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 a1865f1fb23..7c0be5b438a 100644
--- a/lisp/international/uni-numeric.el
+++ b/lisp/international/uni-numeric.el
Binary files differ
diff --git a/lisp/international/uni-old-name.el b/lisp/international/uni-old-name.el
index de2d67b9450..6165eba61cc 100644
--- a/lisp/international/uni-old-name.el
+++ b/lisp/international/uni-old-name.el
Binary files differ
diff --git a/lisp/international/uni-titlecase.el b/lisp/international/uni-titlecase.el
index 517edb20445..e3454a4dd3d 100644
--- a/lisp/international/uni-titlecase.el
+++ b/lisp/international/uni-titlecase.el
Binary files differ
diff --git a/lisp/international/uni-uppercase.el b/lisp/international/uni-uppercase.el
index fcb22d72470..85112406d75 100644
--- a/lisp/international/uni-uppercase.el
+++ b/lisp/international/uni-uppercase.el
Binary files differ
diff --git a/lisp/international/utf-7.el b/lisp/international/utf-7.el
index e27bf26e17d..8e10c94900a 100644
--- a/lisp/international/utf-7.el
+++ b/lisp/international/utf-7.el
@@ -1,6 +1,6 @@
;;; utf-7.el --- utf-7 coding system
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n, mail
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 01dff91a1ff..54ec3f2b052 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1,6 +1,6 @@
;;; isearch.el --- incremental search minor mode
-;; Copyright (C) 1992-1997, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1997, 1999-2012 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
;; Maintainer: FSF
@@ -57,6 +57,7 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
;; Some additional options and constants.
@@ -102,7 +103,7 @@ in Isearch mode is always downcased."
:group 'isearch)
(defcustom search-nonincremental-instead t
- "If non-nil, do a nonincremental search instead if exiting immediately.
+ "If non-nil, do a nonincremental search instead of exiting immediately.
Actually, `isearch-edit-string' is called to let you enter the search
string, and RET terminates editing and does a nonincremental search."
:type 'boolean
@@ -110,17 +111,24 @@ string, and RET terminates editing and does a nonincremental search."
(defcustom search-whitespace-regexp (purecopy "\\s-+")
"If non-nil, regular expression to match a sequence of whitespace chars.
-This applies to regular expression incremental search.
-When you put a space or spaces in the incremental regexp, it stands for
-this, unless it is inside of a regexp construct such as [...] or *, + or ?.
+When you enter a space or spaces in the incremental search, it
+will match any sequence matched by this regexp. As an exception,
+spaces are treated normally in regexp incremental search if they
+occur in a regexp construct like [...] or *, + or ?.
+
+If the value is a string, it applies to both ordinary and
+regexp incremental search. If the value is nil, or
+`isearch-lax-whitespace' is nil for ordinary incremental search, or
+`isearch-regexp-lax-whitespace' is nil for regexp incremental search,
+then each space you type matches literally, against one space.
+
You might want to use something like \"[ \\t\\r\\n]+\" instead.
In the Customization buffer, that is `[' followed by a space,
-a tab, a carriage return (control-M), a newline, and `]+'.
-
-When this is nil, each space you type matches literally, against one space."
- :type '(choice (const :tag "Find Spaces Literally" nil)
+a tab, a carriage return (control-M), a newline, and `]+'."
+ :type '(choice (const :tag "Match Spaces Literally" nil)
regexp)
- :group 'isearch)
+ :group 'isearch
+ :version "24.3")
(defcustom search-invisible 'open
"If t incremental search can match hidden text.
@@ -366,10 +374,12 @@ but outside of this help window when you type them in Isearch mode,
they exit Isearch mode before displaying global help."
isearch-help-map)
+(defvar isearch--display-help-action '(nil (inhibit-same-window . t)))
+
(defun isearch-help-for-help ()
"Display Isearch help menu."
(interactive)
- (let (same-window-buffer-names same-window-regexps)
+ (let ((display-buffer-overriding-action isearch--display-help-action))
(isearch-help-for-help-internal))
(isearch-update))
@@ -377,7 +387,7 @@ they exit Isearch mode before displaying global help."
"Show a list of all keys defined in Isearch mode, and their definitions.
This is like `describe-bindings', but displays only Isearch keys."
(interactive)
- (let (same-window-buffer-names same-window-regexps)
+ (let ((display-buffer-overriding-action isearch--display-help-action))
(with-help-window "*Help*"
(with-current-buffer standard-output
(princ "Isearch Mode Bindings:\n")
@@ -386,14 +396,14 @@ This is like `describe-bindings', but displays only Isearch keys."
(defun isearch-describe-key ()
"Display documentation of the function invoked by isearch key."
(interactive)
- (let (same-window-buffer-names same-window-regexps)
+ (let ((display-buffer-overriding-action isearch--display-help-action))
(call-interactively 'describe-key))
(isearch-update))
(defun isearch-describe-mode ()
"Display documentation of Isearch mode."
(interactive)
- (let (same-window-buffer-names same-window-regexps)
+ (let ((display-buffer-overriding-action isearch--display-help-action))
(describe-function 'isearch-forward))
(isearch-update))
@@ -413,13 +423,6 @@ This is like `describe-bindings', but displays only Isearch keys."
;; Make function keys, etc, which aren't bound to a scrolling-function
;; exit the search.
(define-key map [t] 'isearch-other-control-char)
- ;; Control chars, by default, end isearch mode transparently.
- ;; We need these explicit definitions because, in a dense keymap,
- ;; the binding for t does not affect characters.
- ;; We use a dense keymap to save space.
- (while (< i ?\s)
- (define-key map (make-string 1 i) 'isearch-other-control-char)
- (setq i (1+ i)))
;; Single-byte printing chars extend the search string by default.
(setq i ?\s)
@@ -434,8 +437,8 @@ This is like `describe-bindings', but displays only Isearch keys."
;; default local key binding for any key not otherwise bound.
(let ((meta-map (make-sparse-keymap)))
(define-key map (char-to-string meta-prefix-char) meta-map)
- (define-key map [escape] meta-map))
- (define-key map (vector meta-prefix-char t) 'isearch-other-meta-char)
+ (define-key map [escape] meta-map)
+ (define-key meta-map [t] 'isearch-other-meta-char))
;; Several non-printing chars change the searching behavior.
(define-key map "\C-s" 'isearch-repeat-forward)
@@ -501,14 +504,24 @@ This is like `describe-bindings', but displays only Isearch keys."
(define-key map "\M-r" 'isearch-toggle-regexp)
(define-key map "\M-e" 'isearch-edit-string)
+ (define-key map "\M-sc" 'isearch-toggle-case-fold)
(define-key map "\M-sr" 'isearch-toggle-regexp)
(define-key map "\M-sw" 'isearch-toggle-word)
+ (define-key map "\M-s_" 'isearch-toggle-symbol)
+ (define-key map "\M-s " 'isearch-toggle-lax-whitespace)
(define-key map [?\M-%] 'isearch-query-replace)
(define-key map [?\C-\M-%] 'isearch-query-replace-regexp)
(define-key map "\M-so" 'isearch-occur)
(define-key map "\M-shr" 'isearch-highlight-regexp)
+ ;; The key translations defined in the C-x 8 prefix should insert
+ ;; characters into the search string. See iso-transl.el.
+ (define-key map "\C-x" nil)
+ (define-key map [?\C-x t] 'isearch-other-control-char)
+ (define-key map "\C-x8" nil)
+ (define-key map "\C-x8\r" 'isearch-other-control-char)
+
map)
"Keymap for `isearch-mode'.")
@@ -530,8 +543,29 @@ This is like `describe-bindings', but displays only Isearch keys."
(defvar isearch-forward nil) ; Searching in the forward direction.
(defvar isearch-regexp nil) ; Searching for a regexp.
-(defvar isearch-word nil) ; Searching for words.
-(defvar isearch-hidden nil) ; Non-nil if the string exists but is invisible.
+(defvar isearch-word nil
+ "Regexp-based search mode for words/symbols.
+If t, do incremental search for a sequence of words, ignoring punctuation.
+If the value is a function (e.g. `isearch-symbol-regexp'), it is called to
+convert the search string to a regexp used by regexp search functions.
+The property `isearch-message-prefix' put on this function specifies the
+prefix string displayed in the search message.")
+
+(defvar isearch-lax-whitespace t
+ "If non-nil, a space will match a sequence of whitespace chars.
+When you enter a space or spaces in ordinary incremental search, it
+will match any sequence matched by the regexp defined by the variable
+`search-whitespace-regexp'. If the value is nil, each space you type
+matches literally, against one space. You can toggle the value of this
+variable by the command `isearch-toggle-lax-whitespace'.")
+
+(defvar isearch-regexp-lax-whitespace nil
+ "If non-nil, a space will match a sequence of whitespace chars.
+When you enter a space or spaces in regexp incremental search, it
+will match any sequence matched by the regexp defined by the variable
+`search-whitespace-regexp'. If the value is nil, each space you type
+matches literally, against one space. You can toggle the value of this
+variable by the command `isearch-toggle-lax-whitespace'.")
(defvar isearch-cmds nil
"Stack of search status sets.
@@ -592,6 +626,9 @@ Each set is a vector of the form:
;; Accumulate here the overlays opened during searching.
(defvar isearch-opened-overlays nil)
+;; Non-nil if the string exists but is invisible.
+(defvar isearch-hidden nil)
+
;; The value of input-method-function when isearch is invoked.
(defvar isearch-input-method-function nil)
@@ -614,6 +651,7 @@ Each set is a vector of the form:
(define-key global-map "\C-r" 'isearch-backward)
(define-key esc-map "\C-r" 'isearch-backward-regexp)
(define-key search-map "w" 'isearch-forward-word)
+(define-key search-map "_" 'isearch-forward-symbol)
;; Entry points to isearch-mode.
@@ -653,6 +691,13 @@ If you try to exit with the search string still empty, it invokes
Type \\[isearch-toggle-case-fold] to toggle search case-sensitivity.
Type \\[isearch-toggle-regexp] to toggle regular-expression mode.
Type \\[isearch-toggle-word] to toggle word mode.
+Type \\[isearch-toggle-symbol] to toggle symbol mode.
+
+Type \\[isearch-toggle-lax-whitespace] to toggle whitespace matching.
+In incremental searches, a space or spaces normally matches any whitespace
+defined by the variable `search-whitespace-regexp'; see also the variables
+`isearch-lax-whitespace' and `isearch-regexp-lax-whitespace'.
+
Type \\[isearch-edit-string] to edit the search string in the minibuffer.
Also supported is a search ring of the previous 16 search strings.
@@ -697,22 +742,20 @@ the calling function until the search is done."
(isearch-mode t (not (null regexp-p)) nil (not no-recursive-edit)))
(defun isearch-forward-regexp (&optional not-regexp no-recursive-edit)
- "\
-Do incremental search forward for regular expression.
+ "Do incremental search forward for regular expression.
With a prefix argument, do a regular string search instead.
Like ordinary incremental search except that your input is treated
as a regexp. See the command `isearch-forward' for more information.
-In regexp incremental searches, a space or spaces normally matches
-any whitespace (the variable `search-whitespace-regexp' controls
-precisely what that means). If you want to search for a literal space
-and nothing else, enter C-q SPC."
+In incremental searches, a space or spaces normally matches any
+whitespace defined by the variable `search-whitespace-regexp'.
+To search for a literal space and nothing else, enter C-q SPC.
+To toggle whitespace matching, use `isearch-toggle-lax-whitespace'."
(interactive "P\np")
(isearch-mode t (null not-regexp) nil (not no-recursive-edit)))
(defun isearch-forward-word (&optional not-word no-recursive-edit)
- "\
-Do incremental search forward for a sequence of words.
+ "Do incremental search forward for a sequence of words.
With a prefix argument, do a regular string search instead.
Like ordinary incremental search except that your input is treated
as a sequence of words without regard to how the words are separated.
@@ -720,17 +763,24 @@ See the command `isearch-forward' for more information."
(interactive "P\np")
(isearch-mode t nil nil (not no-recursive-edit) (null not-word)))
+(defun isearch-forward-symbol (&optional not-symbol no-recursive-edit)
+ "Do incremental search forward for a symbol.
+The prefix argument is currently unused.
+Like ordinary incremental search except that your input is treated
+as a symbol surrounded by symbol boundary constructs \\_< and \\_>.
+See the command `isearch-forward' for more information."
+ (interactive "P\np")
+ (isearch-mode t nil nil (not no-recursive-edit) 'isearch-symbol-regexp))
+
(defun isearch-backward (&optional regexp-p no-recursive-edit)
- "\
-Do incremental search backward.
+ "Do incremental search backward.
With a prefix argument, do a regular expression search instead.
See the command `isearch-forward' for more information."
(interactive "P\np")
(isearch-mode nil (not (null regexp-p)) nil (not no-recursive-edit)))
(defun isearch-backward-regexp (&optional not-regexp no-recursive-edit)
- "\
-Do incremental search backward for regular expression.
+ "Do incremental search backward for regular expression.
With a prefix argument, do a regular string search instead.
Like ordinary incremental search except that your input is treated
as a regexp. See the command `isearch-forward' for more information."
@@ -747,14 +797,14 @@ as a regexp. See the command `isearch-forward' for more information."
;; "List of commands for which isearch-mode does not recursive-edit.")
-(defun isearch-mode (forward &optional regexp op-fun recursive-edit word-p)
+(defun isearch-mode (forward &optional regexp op-fun recursive-edit word)
"Start Isearch minor mode.
It is called by the function `isearch-forward' and other related functions."
;; Initialize global vars.
(setq isearch-forward forward
isearch-regexp regexp
- isearch-word word-p
+ isearch-word word
isearch-op-fun op-fun
isearch-last-case-fold-search isearch-case-fold-search
isearch-case-fold-search case-fold-search
@@ -835,7 +885,8 @@ It is called by the function `isearch-forward' and other related functions."
;; Some high level utilities. Others below.
(defun isearch-update ()
- ;; Called after each command to update the display.
+ "This is called after every isearch command to update the display.
+The last thing it does is to run `isearch-update-post-hook'."
(if (and (null unread-command-events)
(null executing-kbd-macro))
(progn
@@ -871,8 +922,7 @@ It is called by the function `isearch-forward' and other related functions."
(if (< isearch-other-end (point)) ; isearch-forward?
(isearch-highlight isearch-other-end (point))
(isearch-highlight (point) isearch-other-end))
- (isearch-dehighlight))
- ))
+ (isearch-dehighlight))))
(setq ;; quit-flag nil not for isearch-mode
isearch-adjusted nil
isearch-yank-flag nil)
@@ -935,9 +985,10 @@ NOPUSH is t and EDIT is t."
(before (if (bobp) nil
(get-text-property (1- (point)) 'intangible))))
(when (and before after (eq before after))
- (if isearch-forward
- (goto-char (next-single-property-change (point) 'intangible))
- (goto-char (previous-single-property-change (point) 'intangible)))))
+ (goto-char
+ (if isearch-forward
+ (next-single-property-change (point) 'intangible)
+ (previous-single-property-change (point) 'intangible)))))
(if (and (> (length isearch-string) 0) (not nopush))
;; Update the ring data.
@@ -977,73 +1028,58 @@ REGEXP if non-nil says use the regexp search ring."
;; The search status structure and stack.
-(defsubst isearch-string-state (frame)
- "Return the search string in FRAME."
- (aref frame 0))
-(defsubst isearch-message-state (frame)
- "Return the search string to display to the user in FRAME."
- (aref frame 1))
-(defsubst isearch-point-state (frame)
- "Return the point in FRAME."
- (aref frame 2))
-(defsubst isearch-success-state (frame)
- "Return the success flag in FRAME."
- (aref frame 3))
-(defsubst isearch-forward-state (frame)
- "Return the searching-forward flag in FRAME."
- (aref frame 4))
-(defsubst isearch-other-end-state (frame)
- "Return the other end of the match in FRAME."
- (aref frame 5))
-(defsubst isearch-word-state (frame)
- "Return the search-by-word flag in FRAME."
- (aref frame 6))
-(defsubst isearch-error-state (frame)
- "Return the regexp error message in FRAME, or nil if its regexp is valid."
- (aref frame 7))
-(defsubst isearch-wrapped-state (frame)
- "Return the search-wrapped flag in FRAME."
- (aref frame 8))
-(defsubst isearch-barrier-state (frame)
- "Return the barrier value in FRAME."
- (aref frame 9))
-(defsubst isearch-case-fold-search-state (frame)
- "Return the case-folding flag in FRAME."
- (aref frame 10))
-(defsubst isearch-pop-fun-state (frame)
- "Return the function restoring the mode-specific Isearch state in FRAME."
- (aref frame 11))
-
-(defun isearch-top-state ()
- (let ((cmd (car isearch-cmds)))
- (setq isearch-string (isearch-string-state cmd)
- isearch-message (isearch-message-state cmd)
- isearch-success (isearch-success-state cmd)
- isearch-forward (isearch-forward-state cmd)
- isearch-other-end (isearch-other-end-state cmd)
- isearch-word (isearch-word-state cmd)
- isearch-error (isearch-error-state cmd)
- isearch-wrapped (isearch-wrapped-state cmd)
- isearch-barrier (isearch-barrier-state cmd)
- isearch-case-fold-search (isearch-case-fold-search-state cmd))
- (if (functionp (isearch-pop-fun-state cmd))
- (funcall (isearch-pop-fun-state cmd) cmd))
- (goto-char (isearch-point-state cmd))))
+(cl-defstruct (isearch--state
+ (:constructor nil)
+ (:copier nil)
+ (:constructor isearch--get-state
+ (&aux
+ (string isearch-string)
+ (message isearch-message)
+ (point (point))
+ (success isearch-success)
+ (forward isearch-forward)
+ (other-end isearch-other-end)
+ (word isearch-word)
+ (error isearch-error)
+ (wrapped isearch-wrapped)
+ (barrier isearch-barrier)
+ (case-fold-search isearch-case-fold-search)
+ (pop-fun (if isearch-push-state-function
+ (funcall isearch-push-state-function))))))
+ (string :read-only t)
+ (message :read-only t)
+ (point :read-only t)
+ (success :read-only t)
+ (forward :read-only t)
+ (other-end :read-only t)
+ (word :read-only t)
+ (error :read-only t)
+ (wrapped :read-only t)
+ (barrier :read-only t)
+ (case-fold-search :read-only t)
+ (pop-fun :read-only t))
+
+(defun isearch--set-state (cmd)
+ (setq isearch-string (isearch--state-string cmd)
+ isearch-message (isearch--state-message cmd)
+ isearch-success (isearch--state-success cmd)
+ isearch-forward (isearch--state-forward cmd)
+ isearch-other-end (isearch--state-other-end cmd)
+ isearch-word (isearch--state-word cmd)
+ isearch-error (isearch--state-error cmd)
+ isearch-wrapped (isearch--state-wrapped cmd)
+ isearch-barrier (isearch--state-barrier cmd)
+ isearch-case-fold-search (isearch--state-case-fold-search cmd))
+ (if (functionp (isearch--state-pop-fun cmd))
+ (funcall (isearch--state-pop-fun cmd) cmd))
+ (goto-char (isearch--state-point cmd)))
(defun isearch-pop-state ()
(setq isearch-cmds (cdr isearch-cmds))
- (isearch-top-state))
+ (isearch--set-state (car isearch-cmds)))
(defun isearch-push-state ()
- (setq isearch-cmds
- (cons (vector isearch-string isearch-message (point)
- isearch-success isearch-forward isearch-other-end
- isearch-word
- isearch-error isearch-wrapped isearch-barrier
- isearch-case-fold-search
- (if isearch-push-state-function
- (funcall isearch-push-state-function)))
- isearch-cmds)))
+ (push (isearch--get-state) isearch-cmds))
;; Commands active while inside of the isearch minor mode.
@@ -1070,11 +1106,11 @@ If MSG is non-nil, use `isearch-message', otherwise `isearch-string'."
(curr-msg (if msg isearch-message isearch-string))
succ-msg)
(when (or (not isearch-success) isearch-error)
- (while (or (not (isearch-success-state (car cmds)))
- (isearch-error-state (car cmds)))
+ (while (or (not (isearch--state-success (car cmds)))
+ (isearch--state-error (car cmds)))
(pop cmds))
- (setq succ-msg (and cmds (if msg (isearch-message-state (car cmds))
- (isearch-string-state (car cmds)))))
+ (setq succ-msg (and cmds (if msg (isearch--state-message (car cmds))
+ (isearch--state-string (car cmds)))))
(if (and (stringp succ-msg)
(< (length succ-msg) (length curr-msg))
(equal succ-msg
@@ -1171,7 +1207,7 @@ The following additional command keys are active while editing.
(minibuffer-history-symbol))
(setq isearch-new-string
(read-from-minibuffer
- (isearch-message-prefix nil nil isearch-nonincremental)
+ (isearch-message-prefix nil isearch-nonincremental)
(cons isearch-string (1+ (or (isearch-fail-pos)
(length isearch-string))))
minibuffer-local-isearch-map nil
@@ -1264,18 +1300,18 @@ The following additional command keys are active while editing.
;; For defined push-state function, restore the first state.
;; This calls pop-state function and restores original point.
(let ((isearch-cmds (last isearch-cmds)))
- (isearch-top-state))
+ (isearch--set-state (car isearch-cmds)))
(goto-char isearch-opoint))
- (isearch-done t) ; exit isearch
+ (isearch-done t) ; Exit isearch..
(isearch-clean-overlays)
- (signal 'quit nil)) ; and pass on quit signal
+ (signal 'quit nil)) ; ..and pass on quit signal.
(defun isearch-abort ()
"Abort incremental search mode if searching is successful, signaling quit.
Otherwise, revert to previous successful search and continue searching.
Use `isearch-exit' to quit without signaling."
(interactive)
-;; (ding) signal instead below, if quitting
+ ;; (ding) signal instead below, if quitting
(discard-input)
(if (and isearch-success (not isearch-error))
;; If search is successful and has no incomplete regexp,
@@ -1298,9 +1334,7 @@ Use `isearch-exit' to quit without signaling."
(if (null (if isearch-regexp regexp-search-ring search-ring))
(setq isearch-error "No previous search string")
(setq isearch-string
- (if isearch-regexp
- (car regexp-search-ring)
- (car search-ring))
+ (car (if isearch-regexp regexp-search-ring search-ring))
isearch-message
(mapconcat 'isearch-text-char-description
isearch-string "")
@@ -1361,11 +1395,44 @@ Use `isearch-exit' to quit without signaling."
(defun isearch-toggle-word ()
"Toggle word searching on or off."
+ ;; The status stack is left unchanged.
(interactive)
(setq isearch-word (not isearch-word))
+ (if isearch-word (setq isearch-regexp nil))
(setq isearch-success t isearch-adjusted t)
(isearch-update))
+(defun isearch-toggle-symbol ()
+ "Toggle symbol searching on or off."
+ (interactive)
+ (setq isearch-word (unless (eq isearch-word 'isearch-symbol-regexp)
+ 'isearch-symbol-regexp))
+ (if isearch-word (setq isearch-regexp nil))
+ (setq isearch-success t isearch-adjusted t)
+ (isearch-update))
+
+(defun isearch-toggle-lax-whitespace ()
+ "Toggle whitespace matching in searching on or off.
+In ordinary search, toggles the value of the variable
+`isearch-lax-whitespace'. In regexp search, toggles the
+value of the variable `isearch-regexp-lax-whitespace'."
+ (interactive)
+ (if isearch-regexp
+ (setq isearch-regexp-lax-whitespace (not isearch-regexp-lax-whitespace))
+ (setq isearch-lax-whitespace (not isearch-lax-whitespace)))
+ (let ((message-log-max nil))
+ (message "%s%s [%s]"
+ (isearch-message-prefix nil isearch-nonincremental)
+ isearch-message
+ (if (if isearch-regexp
+ isearch-regexp-lax-whitespace
+ isearch-lax-whitespace)
+ "match spaces loosely"
+ "match spaces literally")))
+ (setq isearch-success t isearch-adjusted t)
+ (sit-for 1)
+ (isearch-update))
+
(defun isearch-toggle-case-fold ()
"Toggle case folding in searching on or off."
(interactive)
@@ -1373,13 +1440,133 @@ Use `isearch-exit' to quit without signaling."
(if isearch-case-fold-search nil 'yes))
(let ((message-log-max nil))
(message "%s%s [case %ssensitive]"
- (isearch-message-prefix nil nil isearch-nonincremental)
+ (isearch-message-prefix nil isearch-nonincremental)
isearch-message
(if isearch-case-fold-search "in" "")))
(setq isearch-success t isearch-adjusted t)
(sit-for 1)
(isearch-update))
+
+;; Word search
+
+(defun word-search-regexp (string &optional lax)
+ "Return a regexp which matches words, ignoring punctuation.
+Given STRING, a string of words separated by word delimiters,
+compute a regexp that matches those exact words separated by
+arbitrary punctuation. If LAX is non-nil, the end of the string
+need not match a word boundary unless it ends in whitespace.
+
+Used in `word-search-forward', `word-search-backward',
+`word-search-forward-lax', `word-search-backward-lax'."
+ (if (string-match-p "^\\W*$" string)
+ ""
+ (concat
+ "\\b"
+ (mapconcat 'identity (split-string string "\\W+" t) "\\W+")
+ (if (or (not lax) (string-match-p "\\W$" string)) "\\b"))))
+
+(defun word-search-backward (string &optional bound noerror count)
+ "Search backward from point for STRING, ignoring differences in punctuation.
+Set point to the beginning of the occurrence found, and return point.
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend before that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+
+Relies on the function `word-search-regexp' to convert a sequence
+of words in STRING to a regexp used to search words without regard
+to punctuation."
+ (interactive "sWord search backward: ")
+ (re-search-backward (word-search-regexp string nil) bound noerror count))
+
+(defun word-search-forward (string &optional bound noerror count)
+ "Search forward from point for STRING, ignoring differences in punctuation.
+Set point to the end of the occurrence found, and return point.
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend after that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+
+Relies on the function `word-search-regexp' to convert a sequence
+of words in STRING to a regexp used to search words without regard
+to punctuation."
+ (interactive "sWord search: ")
+ (re-search-forward (word-search-regexp string nil) bound noerror count))
+
+(defun word-search-backward-lax (string &optional bound noerror count)
+ "Search backward from point for STRING, ignoring differences in punctuation.
+Set point to the beginning of the occurrence found, and return point.
+
+Unlike `word-search-backward', the end of STRING need not match a word
+boundary, unless STRING ends in whitespace.
+
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend before that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+
+Relies on the function `word-search-regexp' to convert a sequence
+of words in STRING to a regexp used to search words without regard
+to punctuation."
+ (interactive "sWord search backward: ")
+ (re-search-backward (word-search-regexp string t) bound noerror count))
+
+(defun word-search-forward-lax (string &optional bound noerror count)
+ "Search forward from point for STRING, ignoring differences in punctuation.
+Set point to the end of the occurrence found, and return point.
+
+Unlike `word-search-forward', the end of STRING need not match a word
+boundary, unless STRING ends in whitespace.
+
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend after that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+
+Relies on the function `word-search-regexp' to convert a sequence
+of words in STRING to a regexp used to search words without regard
+to punctuation."
+ (interactive "sWord search: ")
+ (re-search-forward (word-search-regexp string t) bound noerror count))
+
+;; Symbol search
+
+(defun isearch-symbol-regexp (string &optional lax)
+ "Return a regexp which matches STRING as a symbol.
+Creates a regexp where STRING is surrounded by symbol delimiters \\_< and \\_>.
+If LAX is non-nil, the end of the string need not match a symbol boundary."
+ (concat "\\_<" (regexp-quote string) (unless lax "\\_>")))
+
+(put 'isearch-symbol-regexp 'isearch-message-prefix "symbol ")
+
+;; Search with lax whitespace
+
+(defun search-forward-lax-whitespace (string &optional bound noerror count)
+ "Search forward for STRING, matching a sequence of whitespace chars."
+ (let ((search-spaces-regexp search-whitespace-regexp))
+ (re-search-forward (regexp-quote string) bound noerror count)))
+
+(defun search-backward-lax-whitespace (string &optional bound noerror count)
+ "Search backward for STRING, matching a sequence of whitespace chars."
+ (let ((search-spaces-regexp search-whitespace-regexp))
+ (re-search-backward (regexp-quote string) bound noerror count)))
+
+(defun re-search-forward-lax-whitespace (regexp &optional bound noerror count)
+ "Search forward for REGEXP, matching a sequence of whitespace chars."
+ (let ((search-spaces-regexp search-whitespace-regexp))
+ (re-search-forward regexp bound noerror count)))
+
+(defun re-search-backward-lax-whitespace (regexp &optional bound noerror count)
+ "Search backward for REGEXP, matching a sequence of whitespace chars."
+ (let ((search-spaces-regexp search-whitespace-regexp))
+ (re-search-backward regexp bound noerror count)))
+
+
(defun isearch-query-replace (&optional delimited regexp-flag)
"Start `query-replace' with string to replace from last search string.
The arg DELIMITED (prefix arg if interactive), if non-nil, means replace
@@ -1395,6 +1582,10 @@ way to run word replacements from Isearch is `M-s w ... M-%'."
;; set `search-upper-case' to nil to not call
;; `isearch-no-upper-case-p' in `perform-replace'
(search-upper-case nil)
+ (replace-lax-whitespace
+ isearch-lax-whitespace)
+ (replace-regexp-lax-whitespace
+ isearch-regexp-lax-whitespace)
;; Set `isearch-recursive-edit' to nil to prevent calling
;; `exit-recursive-edit' in `isearch-done' that terminates
;; the execution of this command when it is non-nil.
@@ -1432,21 +1623,49 @@ See `isearch-query-replace' for more information."
(isearch-query-replace delimited t))
(defun isearch-occur (regexp &optional nlines)
- "Run `occur' with regexp to search from the current search string.
-Interactively, REGEXP is the current search regexp or a quoted search
-string. NLINES has the same meaning as in `occur'."
+ "Run `occur' using the last search string as the regexp.
+Interactively, REGEXP is constructed using the search string from the
+last search command. NLINES has the same meaning as in `occur'.
+
+If the last search command was a word search, REGEXP is computed from
+the search words, ignoring punctuation. If the last search
+command was a regular expression search, REGEXP is the regular
+expression used in that search. If the last search command searched
+for a literal string, REGEXP is constructed by quoting all the special
+characters in that string."
(interactive
- (list
- (cond
- (isearch-word (word-search-regexp isearch-string))
- (isearch-regexp isearch-string)
- (t (regexp-quote isearch-string)))
- (if current-prefix-arg (prefix-numeric-value current-prefix-arg))))
+ (let* ((perform-collect (consp current-prefix-arg))
+ (regexp (cond
+ ((functionp isearch-word)
+ (funcall isearch-word isearch-string))
+ (isearch-word (word-search-regexp isearch-string))
+ (isearch-regexp isearch-string)
+ (t (regexp-quote isearch-string)))))
+ (list regexp
+ (if perform-collect
+ ;; Perform collect operation
+ (if (zerop (regexp-opt-depth regexp))
+ ;; No subexpression so collect the entire match.
+ "\\&"
+ ;; Get the regexp for collection pattern.
+ (isearch-done nil t)
+ (isearch-clean-overlays)
+ (let ((default (car occur-collect-regexp-history)))
+ (read-regexp
+ (format "Regexp to collect (default %s): " default)
+ default 'occur-collect-regexp-history)))
+ ;; Otherwise normal occur takes numerical prefix argument.
+ (when current-prefix-arg
+ (prefix-numeric-value current-prefix-arg))))))
(let ((case-fold-search isearch-case-fold-search)
;; Set `search-upper-case' to nil to not call
;; `isearch-no-upper-case-p' in `occur-1'.
(search-upper-case nil)
- (search-spaces-regexp (if isearch-regexp search-whitespace-regexp)))
+ (search-spaces-regexp
+ (if (if isearch-regexp
+ isearch-regexp-lax-whitespace
+ isearch-lax-whitespace)
+ search-whitespace-regexp)))
(occur regexp nlines)))
(declare-function hi-lock-read-face-name "hi-lock" ())
@@ -1638,6 +1857,8 @@ Subword is used when `subword-mode' is activated. "
(setq case-fold-search
(isearch-no-upper-case-p isearch-string isearch-regexp)))
(looking-at (cond
+ ((functionp isearch-word)
+ (funcall isearch-word isearch-string t))
(isearch-word (word-search-regexp isearch-string t))
(isearch-regexp isearch-string)
(t (regexp-quote isearch-string)))))
@@ -1695,7 +1916,7 @@ to the barrier."
;; We have to check 2 stack frames because the last might be
;; invalid just because of a backslash.
(or (not isearch-error)
- (not (isearch-error-state (cadr isearch-cmds)))
+ (not (isearch--state-error (cadr isearch-cmds)))
allow-invalid))
(if to-barrier
(progn (goto-char isearch-barrier)
@@ -1710,8 +1931,8 @@ to the barrier."
;; Also skip over postfix operators -- though horrid,
;; 'ab?\{5,6\}+\{1,2\}*' is perfectly valid.
(while (and previous
- (or (isearch-error-state frame)
- (let* ((string (isearch-string-state frame))
+ (or (isearch--state-error frame)
+ (let* ((string (isearch--state-string frame))
(lchar (aref string (1- (length string)))))
;; The operators aren't always operators; check
;; backslashes. This doesn't handle the case of
@@ -1719,7 +1940,7 @@ to the barrier."
;; being special, but then we should fall back to
;; the barrier anyway because it's all optional.
(if (isearch-backslash
- (isearch-string-state (car previous)))
+ (isearch--state-string (car previous)))
(eq lchar ?\})
(memq lchar '(?* ?? ?+))))))
(setq stack previous previous (cdr previous) frame (car stack)))
@@ -1729,7 +1950,7 @@ to the barrier."
;; what matched before that.
(let ((last-other-end
(or (and (car previous)
- (isearch-other-end-state (car previous)))
+ (isearch--state-other-end (car previous)))
isearch-barrier)))
(goto-char (if isearch-forward
(max last-other-end isearch-barrier)
@@ -1930,7 +2151,8 @@ Isearch mode."
(setq prefix-arg arg)
(apply 'isearch-unread keylist))
(setq keylist
- (listify-key-sequence (lookup-key local-function-key-map key)))
+ (listify-key-sequence
+ (lookup-key local-function-key-map key)))
(while keylist
(setq key (car keylist))
;; If KEY is a printing char, we handle it here
@@ -1939,6 +2161,9 @@ Isearch mode."
(if (and (integerp key)
(>= key ?\s) (/= key 127) (< key 256))
(progn
+ ;; Ensure that the processed char is recorded in
+ ;; the keyboard macro, if any (Bug#4894)
+ (store-kbd-macro-event key)
(isearch-process-search-char key)
(setq keylist (cdr keylist)))
;; As the remaining keys in KEYLIST can't be handled
@@ -2041,7 +2266,7 @@ Isearch mode."
;; Assume character codes 0200 - 0377 stand for characters in some
;; single-byte character set, and convert them to Emacs
;; characters.
- (if (and isearch-regexp (= char ?\s))
+ (if (and isearch-regexp isearch-regexp-lax-whitespace (= char ?\s))
(if (subregexp-context-p isearch-string (length isearch-string))
(isearch-process-search-string "[ ]" " ")
(isearch-process-search-char char))
@@ -2193,12 +2418,12 @@ If there is no completion possible, say so and continue searching."
(add-text-properties (match-beginning 0) (match-end 0)
'(face trailing-whitespace) m)))
(setq m (concat
- (isearch-message-prefix c-q-hack ellipsis isearch-nonincremental)
+ (isearch-message-prefix ellipsis isearch-nonincremental)
m
- (isearch-message-suffix c-q-hack ellipsis)))
+ (isearch-message-suffix c-q-hack)))
(if c-q-hack m (let ((message-log-max nil)) (message "%s" m)))))
-(defun isearch-message-prefix (&optional _c-q-hack ellipsis nonincremental)
+(defun isearch-message-prefix (&optional ellipsis nonincremental)
;; If about to search, and previous search regexp was invalid,
;; check that it still is. If it is valid now,
;; let the message we display while searching say that it is valid.
@@ -2218,7 +2443,11 @@ If there is no completion possible, say so and continue searching."
(< (point) isearch-opoint)))
"over")
(if isearch-wrapped "wrapped ")
- (if isearch-word "word " "")
+ (if isearch-word
+ (or (and (symbolp isearch-word)
+ (get isearch-word 'isearch-message-prefix))
+ "word ")
+ "")
(if isearch-regexp "regexp " "")
(if multi-isearch-next-buffer-current-function "multi " "")
(or isearch-message-prefix-add "")
@@ -2235,7 +2464,7 @@ If there is no completion possible, say so and continue searching."
(propertize (concat (upcase (substring m 0 1)) (substring m 1))
'face 'minibuffer-prompt)))
-(defun isearch-message-suffix (&optional c-q-hack _ellipsis)
+(defun isearch-message-suffix (&optional c-q-hack)
(concat (if c-q-hack "^Q" "")
(if isearch-error
(concat " [" isearch-error "]")
@@ -2245,8 +2474,8 @@ If there is no completion possible, say so and continue searching."
;; Searching
-(defvar isearch-search-fun-function nil
- "Overrides the default `isearch-search-fun' behavior.
+(defvar isearch-search-fun-function 'isearch-search-fun-default
+ "Non-default value overrides the behavior of `isearch-search-fun-default'.
This variable's value should be a function, which will be called
with no arguments, and should return a function that takes three
arguments: STRING, BOUND, and NOERROR.
@@ -2257,22 +2486,39 @@ search for the first occurrence of STRING or its translation.")
(defun isearch-search-fun ()
"Return the function to use for the search.
Can be changed via `isearch-search-fun-function' for special needs."
- (if isearch-search-fun-function
- (funcall isearch-search-fun-function)
- (cond
- (isearch-word
+ (funcall (or isearch-search-fun-function 'isearch-search-fun-default)))
+
+(defun isearch-search-fun-default ()
+ "Return default functions to use for the search."
+ (cond
+ (isearch-word
+ (lambda (string &optional bound noerror count)
;; Use lax versions to not fail at the end of the word while
;; the user adds and removes characters in the search string
;; (or when using nonincremental word isearch)
- (if (or isearch-nonincremental
- (eq (length isearch-string)
- (length (isearch-string-state (car isearch-cmds)))))
- (if isearch-forward 'word-search-forward 'word-search-backward)
- (if isearch-forward 'word-search-forward-lax 'word-search-backward-lax)))
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward)))))
+ (let ((lax (not (or isearch-nonincremental
+ (eq (length isearch-string)
+ (length (isearch--state-string
+ (car isearch-cmds))))))))
+ (funcall
+ (if isearch-forward #'re-search-forward #'re-search-backward)
+ (if (functionp isearch-word)
+ (funcall isearch-word string lax)
+ (word-search-regexp string lax))
+ bound noerror count))))
+ ((and isearch-regexp isearch-regexp-lax-whitespace
+ search-whitespace-regexp)
+ (if isearch-forward
+ 're-search-forward-lax-whitespace
+ 're-search-backward-lax-whitespace))
+ (isearch-regexp
+ (if isearch-forward 're-search-forward 're-search-backward))
+ ((and isearch-lax-whitespace search-whitespace-regexp)
+ (if isearch-forward
+ 'search-forward-lax-whitespace
+ 'search-backward-lax-whitespace))
+ (t
+ (if isearch-forward 'search-forward 'search-backward))))
(defun isearch-search-string (string bound noerror)
"Search for the first occurrence of STRING or its translation.
@@ -2328,11 +2574,11 @@ update the match data, and return point."
(isearch-no-upper-case-p isearch-string isearch-regexp)))
(condition-case lossage
(let ((inhibit-point-motion-hooks
+ ;; FIXME: equality comparisons on functions is asking for trouble.
(and (eq isearch-filter-predicate 'isearch-filter-visible)
search-invisible))
(inhibit-quit nil)
(case-fold-search isearch-case-fold-search)
- (search-spaces-regexp search-whitespace-regexp)
(retry t))
(setq isearch-error nil)
(while retry
@@ -2372,11 +2618,12 @@ update the match data, and return point."
(if isearch-success
nil
;; Ding if failed this time after succeeding last time.
- (and (isearch-success-state (car isearch-cmds))
+ (and (isearch--state-success (car isearch-cmds))
(ding))
- (if (functionp (isearch-pop-fun-state (car isearch-cmds)))
- (funcall (isearch-pop-fun-state (car isearch-cmds)) (car isearch-cmds)))
- (goto-char (isearch-point-state (car isearch-cmds)))))
+ (if (functionp (isearch--state-pop-fun (car isearch-cmds)))
+ (funcall (isearch--state-pop-fun (car isearch-cmds))
+ (car isearch-cmds)))
+ (goto-char (isearch--state-point (car isearch-cmds)))))
;; Called when opening an overlay, and we are still in isearch.
@@ -2623,7 +2870,8 @@ since they have special meaning in a regexp."
(defvar isearch-lazy-highlight-window-end nil)
(defvar isearch-lazy-highlight-case-fold-search nil)
(defvar isearch-lazy-highlight-regexp nil)
-(defvar isearch-lazy-highlight-space-regexp nil)
+(defvar isearch-lazy-highlight-lax-whitespace nil)
+(defvar isearch-lazy-highlight-regexp-lax-whitespace nil)
(defvar isearch-lazy-highlight-word nil)
(defvar isearch-lazy-highlight-forward nil)
(defvar isearch-lazy-highlight-error nil)
@@ -2665,6 +2913,10 @@ by other Emacs features."
isearch-regexp))
(not (eq isearch-lazy-highlight-word
isearch-word))
+ (not (eq isearch-lazy-highlight-lax-whitespace
+ isearch-lax-whitespace))
+ (not (eq isearch-lazy-highlight-regexp-lax-whitespace
+ isearch-regexp-lax-whitespace))
(not (= (window-start)
isearch-lazy-highlight-window-start))
(not (= (window-end) ; Window may have been split/joined.
@@ -2691,7 +2943,8 @@ by other Emacs features."
isearch-lazy-highlight-last-string isearch-string
isearch-lazy-highlight-case-fold-search isearch-case-fold-search
isearch-lazy-highlight-regexp isearch-regexp
- isearch-lazy-highlight-space-regexp search-whitespace-regexp
+ isearch-lazy-highlight-lax-whitespace isearch-lax-whitespace
+ isearch-lazy-highlight-regexp-lax-whitespace isearch-regexp-lax-whitespace
isearch-lazy-highlight-word isearch-word
isearch-lazy-highlight-forward isearch-forward)
(unless (equal isearch-string "")
@@ -2705,12 +2958,15 @@ Attempt to do the search exactly the way the pending Isearch would."
(condition-case nil
(let ((case-fold-search isearch-lazy-highlight-case-fold-search)
(isearch-regexp isearch-lazy-highlight-regexp)
- (search-spaces-regexp isearch-lazy-highlight-space-regexp)
(isearch-word isearch-lazy-highlight-word)
+ (isearch-lax-whitespace
+ isearch-lazy-highlight-lax-whitespace)
+ (isearch-regexp-lax-whitespace
+ isearch-lazy-highlight-regexp-lax-whitespace)
+ (isearch-forward isearch-lazy-highlight-forward)
(search-invisible nil) ; don't match invisible text
(retry t)
(success nil)
- (isearch-forward isearch-lazy-highlight-forward)
(bound (if isearch-lazy-highlight-forward
(min (or isearch-lazy-highlight-end-limit (point-max))
(if isearch-lazy-highlight-wrapped
diff --git a/lisp/isearchb.el b/lisp/isearchb.el
index 721fce8ef9a..030e4925619 100644
--- a/lisp/isearchb.el
+++ b/lisp/isearchb.el
@@ -1,6 +1,6 @@
;;; isearchb --- a marriage between iswitchb and isearch
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: FSF
diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el
index 21201c6cff5..13ab41cf83a 100644
--- a/lisp/iswitchb.el
+++ b/lisp/iswitchb.el
@@ -1,6 +1,6 @@
;;; iswitchb.el --- switch between buffers using substrings
-;; Copyright (C) 1996-1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Stephen Eglen <stephen@gnu.org>
;; Maintainer: Stephen Eglen <stephen@gnu.org>
@@ -233,7 +233,7 @@
;;; TODO
-;;; Acknowledgements
+;;; Acknowledgments
;; Thanks to Jari Aalto <jari.aalto@poboxes.com> for help with the
;; first version of this package, iswitch-buffer. Thanks also to many
@@ -372,9 +372,14 @@ See also `iswitchb-newbuffer'."
:type 'string
:group 'iswitchb)
-(defvar iswitchb-all-frames 'visible
- "*Argument to pass to `walk-windows' when finding visible buffers.
-See documentation of `walk-windows' for useful values.")
+(defcustom iswitchb-all-frames 'visible
+ "Argument to pass to `walk-windows' when iswitchb is finding buffers.
+See documentation of `walk-windows' for useful values."
+ :type '(choice (const :tag "Selected frame only" nil)
+ (const :tag "All existing frames" t)
+ (const :tag "All visible frames" visible)
+ (const :tag "All frames on this terminal" 0))
+ :group 'iswitchb)
(defcustom iswitchb-minibuffer-setup-hook nil
"Iswitchb-specific customization of minibuffer setup.
@@ -522,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.
@@ -614,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/jit-lock.el b/lisp/jit-lock.el
index b65b186b4e2..55e25e4c262 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -1,6 +1,6 @@
;;; jit-lock.el --- just-in-time fontification
-;; Copyright (C) 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Keywords: faces files
@@ -29,8 +29,6 @@
(eval-when-compile
- (require 'cl)
-
(defmacro with-buffer-prepared-for-jit-lock (&rest body)
"Execute BODY in current buffer, overriding several variables.
Preserves the `buffer-modified-p' state of the current buffer."
diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el
index bf312445f17..e4743ada045 100644
--- a/lisp/jka-cmpr-hook.el
+++ b/lisp/jka-cmpr-hook.el
@@ -1,6 +1,6 @@
;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el
-;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2011
+;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2012
;; Free Software Foundation, Inc.
;; Author: jka@ece.cmu.edu (Jay K. Adams)
@@ -119,7 +119,7 @@ based on the filename itself and `jka-compr-compression-info-list'."
(defun jka-compr-install ()
"Install jka-compr.
This adds entries to `file-name-handler-alist' and `auto-mode-alist'
-and `inhibit-first-line-modes-suffixes'."
+and `inhibit-local-variables-suffixes'."
(setq jka-compr-file-name-handler-entry
(cons (jka-compr-build-file-regexp) 'jka-compr-handler))
@@ -145,12 +145,12 @@ and `inhibit-first-line-modes-suffixes'."
;; are chosen right according to the file names
;; sans `.gz'.
(push (list (jka-compr-info-regexp x) nil 'jka-compr) auto-mode-alist)
- ;; Also add these regexps to
- ;; inhibit-first-line-modes-suffixes, so that a
- ;; -*- line in the first file of a compressed tar
- ;; file doesn't override tar-mode.
+ ;; Also add these regexps to inhibit-local-variables-suffixes,
+ ;; so that a -*- line in the first file of a compressed tar file,
+ ;; or a Local Variables section in a member file at the end of
+ ;; the tar file don't override tar-mode.
(push (jka-compr-info-regexp x)
- inhibit-first-line-modes-suffixes)))
+ inhibit-local-variables-suffixes)))
(setq auto-mode-alist
(append auto-mode-alist jka-compr-mode-alist-additions))
@@ -234,6 +234,14 @@ options through Custom does this automatically."
"compressing" "gzip" ("-c" "-q")
"uncompressing" "gzip" ("-c" "-q" "-d")
t t "\037\213"]
+ ["\\.lz\\'"
+ "Lzip compressing" "lzip" ("-c" "-q")
+ "Lzip uncompressing" "lzip" ("-c" "-q" "-d")
+ t t "LZIP"]
+ ["\\.lzma\\'"
+ "LZMA compressing" "lzma" ("-c" "-q" "-z")
+ "LZMA uncompressing" "lzma" ("-c" "-q" "-d")
+ t t ""]
["\\.xz\\'"
"XZ compressing" "xz" ("-c" "-q")
"XZ uncompressing" "xz" ("-c" "-q" "-d")
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index cd769885cc6..7e50ae57b19 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -1,6 +1,6 @@
;;; jka-compr.el --- reading/writing/loading compressed files
-;; Copyright (C) 1993-1995, 1997, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1997, 1999-2012 Free Software Foundation, Inc.
;; Author: jka@ece.cmu.edu (Jay K. Adams)
;; Maintainer: FSF
@@ -203,6 +203,7 @@ to keep: LEN chars starting BEG chars from the beginning."
;; call-process barfs if default-directory is inaccessible.
(let ((default-directory
(if (and default-directory
+ (not (file-remote-p default-directory))
(file-accessible-directory-p default-directory))
default-directory
(file-name-directory infile))))
@@ -657,16 +658,15 @@ It is not recommended to set this variable permanently to anything but nil.")
(defun jka-compr-uninstall ()
"Uninstall jka-compr.
This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
-and `inhibit-first-line-modes-suffixes' that were added
+and `inhibit-local-variables-suffixes' that were added
by `jka-compr-installed'."
- ;; Delete from inhibit-first-line-modes-suffixes
- ;; what jka-compr-install added.
+ ;; Delete from inhibit-local-variables-suffixes what jka-compr-install added.
(mapc
(function (lambda (x)
(and (jka-compr-info-strip-extension x)
- (setq inhibit-first-line-modes-suffixes
+ (setq inhibit-local-variables-suffixes
(delete (jka-compr-info-regexp x)
- inhibit-first-line-modes-suffixes)))))
+ inhibit-local-variables-suffixes)))))
jka-compr-compression-info-list--internal)
(let* ((fnha (cons nil file-name-handler-alist))
diff --git a/lisp/json.el b/lisp/json.el
index 2debd46c842..b1ea03120dc 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -1,6 +1,6 @@
;;; json.el --- JavaScript Object Notation parser / generator
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Edward O'Connor <ted@oconnor.cx>
;; Version: 1.3
@@ -51,7 +51,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
;; Compatibility code
@@ -174,6 +173,10 @@ this around your call to `json-read' instead of `setq'ing it.")
(put 'json-string-format 'error-conditions
'(json-string-format json-error error))
+(put 'json-key-format 'error-message "Bad JSON object key")
+(put 'json-key-format 'error-conditions
+ '(json-key-format json-error error))
+
(put 'json-object-format 'error-message "Bad JSON object")
(put 'json-object-format 'error-conditions
'(json-object-format json-error error))
@@ -307,13 +310,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)))))
@@ -321,6 +324,15 @@ representation will be parsed correctly."
"Return a JSON representation of STRING."
(format "\"%s\"" (mapconcat 'json-encode-char string "")))
+(defun json-encode-key (object)
+ "Return a JSON representation of OBJECT.
+If the resulting JSON object isn't a valid JSON object key,
+this signals `json-key-format'."
+ (let ((encoded (json-encode object)))
+ (unless (stringp (json-read-from-string encoded))
+ (signal 'json-key-format (list object)))
+ encoded))
+
;;; JSON Objects
(defun json-new-object ()
@@ -395,7 +407,7 @@ Please see the documentation of `json-object-type' and `json-key-type'."
(maphash
(lambda (k v)
(push (format "%s:%s"
- (json-encode k)
+ (json-encode-key k)
(json-encode v))
r))
hash-table)
@@ -409,7 +421,7 @@ Please see the documentation of `json-object-type' and `json-key-type'."
(format "{%s}"
(json-join (mapcar (lambda (cons)
(format "%s:%s"
- (json-encode (car cons))
+ (json-encode-key (car cons))
(json-encode (cdr cons))))
alist)
", ")))
@@ -418,7 +430,7 @@ Please see the documentation of `json-object-type' and `json-key-type'."
"Return a JSON representation of PLIST."
(let (result)
(while plist
- (push (concat (json-encode (car plist))
+ (push (concat (json-encode-key (car plist))
":"
(json-encode (cadr plist)))
result)
diff --git a/lisp/kermit.el b/lisp/kermit.el
index 3c8f52db0cd..dc76c41505e 100644
--- a/lisp/kermit.el
+++ b/lisp/kermit.el
@@ -1,6 +1,6 @@
;;; kermit.el --- additions to shell mode for use with kermit
-;; Copyright (C) 1988, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2012 Free Software Foundation, Inc.
;; Author: Jeff Norden <jeff@colgate.csnet>
;; Maintainer: FSF
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 6915640944a..6ecac2cdf28 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -1,6 +1,6 @@
;;; kmacro.el --- enhanced keyboard macros
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard convenience
@@ -231,12 +231,12 @@ macro to be executed before appending to it."
;;; Keyboard macro counter
(defvar kmacro-counter 0
- "*Current keyboard macro counter.")
+ "Current keyboard macro counter.")
(defvar kmacro-default-counter-format "%d")
(defvar kmacro-counter-format "%d"
- "*Current keyboard macro counter format.")
+ "Current keyboard macro counter format.")
(defvar kmacro-counter-format-start kmacro-counter-format
"Macro format at start of macro execution.")
@@ -625,10 +625,11 @@ for details on how to adjust or disable this behavior.
To make a macro permanent so you can call it even after defining
others, use \\[kmacro-name-last-macro]."
(interactive "p")
- (let ((repeat-key (and (null no-repeat)
- (> (length (this-single-command-keys)) 1)
- last-input-event))
- repeat-key-str)
+ (let ((repeat-key (and (or (and (null no-repeat)
+ (> (length (this-single-command-keys)) 1))
+ ;; Used when we're in the process of repeating.
+ (eq no-repeat 'repeating))
+ last-input-event)))
(if end-macro
(kmacro-end-macro arg)
(call-last-kbd-macro arg #'kmacro-loop-setup-function))
@@ -639,25 +640,23 @@ others, use \\[kmacro-name-last-macro]."
(if (eq kmacro-call-repeat-key t)
repeat-key
kmacro-call-repeat-key)))
- (setq repeat-key-str (format-kbd-macro (vector repeat-key) nil))
- (while repeat-key
- ;; Issue a hint to the user, if the echo area isn't in use.
- (unless (current-message)
- (message "(Type %s to repeat macro%s)"
- repeat-key-str
- (if (and kmacro-call-repeat-with-arg
- arg (> arg 1))
- (format " %d times" arg) "")))
- (if (equal repeat-key (read-event))
- (progn
- (clear-this-command-keys t)
- (call-last-kbd-macro (and kmacro-call-repeat-with-arg arg)
- #'kmacro-loop-setup-function)
- (setq last-input-event nil))
- (setq repeat-key nil)))
- (when last-input-event
- (clear-this-command-keys t)
- (setq unread-command-events (list last-input-event))))))
+ ;; Issue a hint to the user, if the echo area isn't in use.
+ (unless (current-message)
+ (message "(Type %s to repeat macro%s)"
+ (format-kbd-macro (vector repeat-key) nil)
+ (if (and kmacro-call-repeat-with-arg
+ arg (> arg 1))
+ (format " %d times" arg) "")))
+ ;; Can't use the `keep-pred' arg because this overlay keymap needs to be
+ ;; removed during the next run of the kmacro (i.e. we need to add&remove
+ ;; this overlay-map at each repetition).
+ (set-temporary-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (vector repeat-key)
+ `(lambda () (interactive)
+ (kmacro-call-macro ,(and kmacro-call-repeat-with-arg arg)
+ 'repeating)))
+ map)))))
;;; Combined function key bindings:
diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el
index 9fce0583161..420e8d74919 100644
--- a/lisp/language/burmese.el
+++ b/lisp/language/burmese.el
@@ -1,4 +1,4 @@
-;;; burmese.el --- support for Burmese -*- coding: utf-8; no-byte-compile: t -*-
+;;; burmese.el --- support for Burmese -*- coding: utf-8 -*-
;; Copyright (C) 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/cham.el b/lisp/language/cham.el
index d1ddfb512a9..a025ff0d209 100644
--- a/lisp/language/cham.el
+++ b/lisp/language/cham.el
@@ -1,6 +1,6 @@
-;;; cham.el --- support for Cham -*- coding: utf-8; no-byte-compile: t -*-
+;;; cham.el --- support for Cham -*- coding: utf-8 -*-
-;; Copyright (C) 2008, 2009, 2010, 2011
+;; Copyright (C) 2008, 2009, 2010, 2011, 2012
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H13PRO009
@@ -37,8 +37,3 @@
(coding-priority utf-8)))
(provide 'cham)
-
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
diff --git a/lisp/language/china-util.el b/lisp/language/china-util.el
index 9f79dd087bb..f68420b070c 100644
--- a/lisp/language/china-util.el
+++ b/lisp/language/china-util.el
@@ -1,6 +1,6 @@
;;; china-util.el --- utilities for Chinese -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/chinese.el b/lisp/language/chinese.el
index 0e87d4d8e8c..782b5a363ad 100644
--- a/lisp/language/chinese.el
+++ b/lisp/language/chinese.el
@@ -1,6 +1,6 @@
;;; chinese.el --- support for Chinese -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -110,7 +110,8 @@
(use-cjk-char-width-table 'zh_CN)))
(exit-function . use-default-char-width-table)
(coding-system chinese-iso-8bit iso-2022-cn chinese-hz)
- (coding-priority chinese-iso-8bit chinese-big5 iso-2022-cn)
+ (coding-priority chinese-iso-8bit chinese-gbk chinese-big5
+ iso-2022-cn)
(input-method . "chinese-py-punct")
(features china-util)
(sample-text . "Chinese ($AVPND(B,$AFUM(;0(B,$A::So(B) $ADc:C(B")
@@ -140,7 +141,8 @@
(use-cjk-char-width-table 'zh_HK)))
(exit-function . use-default-char-width-table)
(coding-system chinese-big5 chinese-iso-7bit)
- (coding-priority chinese-big5 iso-2022-cn chinese-iso-8bit)
+ (coding-priority chinese-big5 iso-2022-cn chinese-iso-8bit
+ chinese-gbk)
(input-method . "chinese-py-punct-b5")
(ctext-non-standard-encodings "big5-0")
(features china-util)
@@ -196,7 +198,7 @@
(exit-function . use-default-char-width-table)
(coding-system iso-2022-cn euc-tw)
(coding-priority iso-2022-cn euc-tw chinese-big5
- chinese-iso-8bit)
+ chinese-iso-8bit chinese-gbk)
(features china-util)
(input-method . "chinese-cns-quick")
;; Fixme: presumably it won't accept big5 now.
@@ -216,7 +218,7 @@ accepts Big5 for input also (which is then converted to CNS)."))
(exit-function . use-default-char-width-table)
(coding-system euc-tw iso-2022-cn)
(coding-priority euc-tw chinese-big5 iso-2022-cn
- chinese-iso-8bit)
+ chinese-iso-8bit chinese-gbk)
(features china-util)
(input-method . "chinese-cns-quick")
(documentation . "\
diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el
index e833bb7ab04..eb72a7b1c1d 100644
--- a/lisp/language/cyril-util.el
+++ b/lisp/language/cyril-util.el
@@ -1,6 +1,6 @@
;;; cyril-util.el --- utilities for Cyrillic scripts
-;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Keywords: mule, multilingual, Cyrillic
diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el
index c0f857cadee..33c5fbbf3f1 100644
--- a/lisp/language/cyrillic.el
+++ b/lisp/language/cyrillic.el
@@ -1,6 +1,6 @@
;;; cyrillic.el --- support for Cyrillic -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/czech.el b/lisp/language/czech.el
index 2325699e30e..5bda5d1faa1 100644
--- a/lisp/language/czech.el
+++ b/lisp/language/czech.el
@@ -1,6 +1,6 @@
-;;; czech.el --- support for Czech -*- coding: iso-2022-7bit; no-byte-compile: t -*-
+;;; czech.el --- support for Czech -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Milan Zamazal <pdm@zamazal.org>
;; Maintainer: Pavel Jan,Am(Bk <Pavel@Janik.cz>
diff --git a/lisp/language/english.el b/lisp/language/english.el
index dd96d38a197..4f4c6788cae 100644
--- a/lisp/language/english.el
+++ b/lisp/language/english.el
@@ -1,6 +1,6 @@
-;;; english.el --- support for English -*- no-byte-compile: t -*-
+;;; english.el --- support for English
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -30,7 +30,7 @@
;; We need nothing special to support English on Emacs. Selecting
;; English as a language environment is one of the ways to reset
-;; various multilingual environment to the original settting.
+;; various multilingual environment to the original setting.
;;; Code:
diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el
index 3c39b1eff9c..90e649c574c 100644
--- a/lisp/language/ethio-util.el
+++ b/lisp/language/ethio-util.el
@@ -1,6 +1,6 @@
;;; ethio-util.el --- utilities for Ethiopic -*- coding: utf-8-emacs; -*-
-;; Copyright (C) 1997-1998, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2002-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -99,34 +99,34 @@
;;
(defvar ethio-primary-language 'tigrigna
- "*Symbol that defines the primary language in SERA --> FIDEL conversion.
+ "Symbol that defines the primary language in SERA --> FIDEL conversion.
The value should be one of: `tigrigna', `amharic' or `english'.")
(defvar ethio-secondary-language 'english
- "*Symbol that defines the secondary language in SERA --> FIDEL conversion.
+ "Symbol that defines the secondary language in SERA --> FIDEL conversion.
The value should be one of: `tigrigna', `amharic' or `english'.")
(defvar ethio-use-colon-for-colon nil
- "*Non-nil means associate ASCII colon with Ethiopic colon.
+ "Non-nil means associate ASCII colon with Ethiopic colon.
If nil, associate ASCII colon with Ethiopic word separator, i.e., two
vertically stacked dots. All SERA <--> FIDEL converters refer this
variable.")
(defvar ethio-use-three-dot-question nil
- "*Non-nil means associate ASCII question mark with Ethiopic old style question mark (three vertically stacked dots).
+ "Non-nil means associate ASCII question mark with Ethiopic old style question mark (three vertically stacked dots).
If nil, associate ASCII question mark with Ethiopic stylized question
mark. All SERA <--> FIDEL converters refer this variable.")
(defvar ethio-quote-vowel-always nil
- "*Non-nil means always put an apostrophe before an isolated vowel (except at word initial) in FIDEL --> SERA conversion.
+ "Non-nil means always put an apostrophe before an isolated vowel (except at word initial) in FIDEL --> SERA conversion.
If nil, put an apostrophe only between a 6th-form consonant and an
isolated vowel.")
(defvar ethio-W-sixth-always nil
- "*Non-nil means convert the Wu-form of a 12-form consonant to \"W'\" instead of \"Wu\" in FIDEL --> SERA conversion.")
+ "Non-nil means convert the Wu-form of a 12-form consonant to \"W'\" instead of \"Wu\" in FIDEL --> SERA conversion.")
(defvar ethio-numeric-reduction 0
- "*Degree of reduction in converting Ethiopic digits into Arabic digits.
+ "Degree of reduction in converting Ethiopic digits into Arabic digits.
Should be 0, 1 or 2.
For example, ({10}{9}{100}{80}{7}) is converted into:
`10`9`100`80`7 if `ethio-numeric-reduction' is 0,
@@ -134,7 +134,7 @@ For example, ({10}{9}{100}{80}{7}) is converted into:
`10900807 if `ethio-numeric-reduction' is 2.")
(defvar ethio-java-save-lowercase nil
- "*Non-nil means save Ethiopic characters in lowercase hex numbers to Java files.
+ "Non-nil means save Ethiopic characters in lowercase hex numbers to Java files.
If nil, use uppercases.")
(defun ethio-prefer-amharic-p ()
diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el
index 13a645a9975..c25710e953a 100644
--- a/lisp/language/ethiopic.el
+++ b/lisp/language/ethiopic.el
@@ -1,6 +1,6 @@
;;; ethiopic.el --- support for Ethiopic -*- coding: utf-8-emacs; -*-
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/european.el b/lisp/language/european.el
index 3c2cb083ff6..259c06755a0 100644
--- a/lisp/language/european.el
+++ b/lisp/language/european.el
@@ -1,6 +1,6 @@
;;; european.el --- support for European languages -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 1997-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -324,6 +324,14 @@ Latin-9 is sometimes nicknamed `Latin-0'."))
:mime-charset 'windows-1257)
(define-coding-system-alias 'cp1257 'windows-1257)
+(define-coding-system 'cp775
+ "DOS codepage 775 (PC Baltic, MS-DOS Baltic Rim)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp775)
+ :mime-charset 'cp775)
+(define-coding-system-alias 'ibm775 'cp775)
+
(define-coding-system 'cp850
"DOS codepage 850 (Western European)"
:coding-type 'charset
diff --git a/lisp/language/georgian.el b/lisp/language/georgian.el
index be6da8cba17..a410a722db3 100644
--- a/lisp/language/georgian.el
+++ b/lisp/language/georgian.el
@@ -1,6 +1,6 @@
-;;; georgian.el --- language support for Georgian -*- no-byte-compile: t -*-
+;;; georgian.el --- language support for Georgian
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/lisp/language/greek.el b/lisp/language/greek.el
index e4d239cdf27..1c8330936c9 100644
--- a/lisp/language/greek.el
+++ b/lisp/language/greek.el
@@ -1,4 +1,4 @@
-;;; greek.el --- support for Greek -*- no-byte-compile: t -*-
+;;; greek.el --- support for Greek
;; Copyright (C) 2002 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el
index bd661083406..337bf4b4c0e 100644
--- a/lisp/language/hanja-util.el
+++ b/lisp/language/hanja-util.el
@@ -1,6 +1,6 @@
;;; hanja-util.el --- Korean Hanja util module -*- coding: utf-8 -*-
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Jihyun Cho <jihyun.jo@gmail.com>
;; Keywords: multilingual, input method, Korean, Hanja
@@ -6438,7 +6438,7 @@ character. This variable is initialized by `hanja-init-load'.")
;; List of current conversion status.
;; The first element is the strating position of shown list.
-;; It is a group number each splited by `hanja-list-width'.
+;; It is a group number each split by `hanja-list-width'.
;; The second element is the position of selected element.
;; The third element is a list of suitable Hanja candidate.
(defvar hanja-conversions
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index fd3e16b307a..c9896bb60a1 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -1,6 +1,6 @@
;;; hebrew.el --- support for Hebrew -*- coding: utf-8 -*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index 0e548420383..c7eb1492c07 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -1,6 +1,6 @@
;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
;; Keywords: multilingual, Indian, Devanagari
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index 8203213d8eb..e77f745168d 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -1,6 +1,6 @@
;;; indian.el --- Indian languages support -*- coding: utf-8; -*-
-;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
@@ -46,7 +46,7 @@
"Devanagari" '((charset unicode)
(coding-system utf-8)
(coding-priority utf-8)
- (input-method . "dev-aiba")
+ (input-method . "devanagari-aiba")
(documentation . "\
Such languages using Devanagari script as Hindi and Marathi
are supported in this language environment."))
diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el
index dcf3dc0f90e..9be3c44b4da 100644
--- a/lisp/language/japan-util.el
+++ b/lisp/language/japan-util.el
@@ -1,6 +1,6 @@
;;; japan-util.el --- utilities for Japanese -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el
index bf8a4d8d5c2..83c8fcf66c9 100644
--- a/lisp/language/japanese.el
+++ b/lisp/language/japanese.el
@@ -1,6 +1,6 @@
-;;; japanese.el --- support for Japanese -*- coding: iso-2022-7bit; no-byte-compile: t -*-
+;;; japanese.el --- support for Japanese -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/khmer.el b/lisp/language/khmer.el
index d01fa3b33bd..8663ff22ca0 100644
--- a/lisp/language/khmer.el
+++ b/lisp/language/khmer.el
@@ -1,4 +1,4 @@
-;;; khmer.el --- support for Khmer -*- coding: utf-8; no-byte-compile: t -*-
+;;; khmer.el --- support for Khmer -*- coding: utf-8 -*-
;; Copyright (C) 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index e2367cf0f7e..abd5b29ba6e 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -1,6 +1,6 @@
;;; korea-util.el --- utilities for Korean
-;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -32,7 +32,7 @@
(purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") ""))
"3"
""))
- "*The kind of Korean keyboard for Korean input method.
+ "The kind of Korean keyboard for Korean input method.
\"\" for 2, \"3\" for 3.")
;; functions useful for Korean text input
@@ -41,7 +41,7 @@
"Turn on or off a Korean text input method for the current buffer."
(interactive)
(if current-input-method
- (inactivate-input-method)
+ (deactivate-input-method)
(activate-input-method
(concat "korean-hangul" default-korean-keyboard))))
diff --git a/lisp/language/korean.el b/lisp/language/korean.el
index acb9fea268d..711d24a5b00 100644
--- a/lisp/language/korean.el
+++ b/lisp/language/korean.el
@@ -1,6 +1,6 @@
-;;; korean.el --- support for Korean -*- coding: iso-2022-7bit; no-byte-compile: t -*-
+;;; korean.el --- support for Korean -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el
index 2a339504409..863e3ba89a3 100644
--- a/lisp/language/lao-util.el
+++ b/lisp/language/lao-util.el
@@ -1,6 +1,6 @@
;;; lao-util.el --- utilities for Lao -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/lao.el b/lisp/language/lao.el
index c09c6f8a0ef..6a0d431f3ec 100644
--- a/lisp/language/lao.el
+++ b/lisp/language/lao.el
@@ -1,6 +1,6 @@
-;;; lao.el --- support for Lao -*- coding: utf-8; no-byte-compile: t -*-
+;;; lao.el --- support for Lao -*- coding: utf-8 -*-
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index 6fa54ff5c80..ee06e34eef4 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -1,4 +1,4 @@
-;;; misc-lang.el --- support for miscellaneous languages (characters) -*- no-byte-compile: t -*-
+;;; misc-lang.el --- support for miscellaneous languages (characters)
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
@@ -67,6 +67,14 @@ and Italian.")))
(sample-text . "Arabic السّلام عليكم")
(documentation . "Bidirectional editing is supported.")))
+(set-language-info-alist
+ "Persian" '((charset unicode)
+ (coding-system utf-8 iso-8859-6 windows-1256)
+ (coding-priority utf-8 iso-8859-6 windows-1256)
+ (input-method . "farsi-transliterate-banan")
+ (sample-text . "Persian فارسی")
+ (documentation . "Bidirectional editing is supported.")))
+
(set-char-table-range
composition-function-table
'(#x600 . #x6FF)
diff --git a/lisp/language/romanian.el b/lisp/language/romanian.el
index 25a10633a28..ff5db222bd2 100644
--- a/lisp/language/romanian.el
+++ b/lisp/language/romanian.el
@@ -1,6 +1,6 @@
-;;; romanian.el --- support for Romanian -*- coding: iso-latin-2; no-byte-compile: t -*-
+;;; romanian.el --- support for Romanian -*- coding: iso-latin-2 -*-
-;; Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Dan Nicolaescu <done@ece.arizona.edu>
;; Keywords: multilingual, Romanian, i18n
diff --git a/lisp/language/sinhala.el b/lisp/language/sinhala.el
index ea8a6a34cd8..037d753f52a 100644
--- a/lisp/language/sinhala.el
+++ b/lisp/language/sinhala.el
@@ -1,4 +1,4 @@
-;;; sinhala.el --- support for Sinhala -*- coding: utf-8; no-byte-compile: t -*-
+;;; sinhala.el --- support for Sinhala -*- coding: utf-8 -*-
;; Copyright (C) 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/slovak.el b/lisp/language/slovak.el
index 94aa5fdc94c..27e43fa22cf 100644
--- a/lisp/language/slovak.el
+++ b/lisp/language/slovak.el
@@ -1,6 +1,6 @@
-;;; slovak.el --- support for Slovak -*- coding: iso-2022-7bit; no-byte-compile: t -*-
+;;; slovak.el --- support for Slovak -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Authors: Tibor ,B)(Bimko <tibor.simko@fmph.uniba.sk>,
;; Milan Zamazal <pdm@zamazal.org>
diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el
index f6e525b0d25..496453f6502 100644
--- a/lisp/language/tai-viet.el
+++ b/lisp/language/tai-viet.el
@@ -1,6 +1,6 @@
-;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8; no-byte-compile: t -*-
+;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8 -*-
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Copyright (C) 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H13PRO009
@@ -57,7 +57,3 @@ is available at this web page:
")))
(provide 'tai-viet)
-
-;; Local Variables:
-;; coding: utf-8
-;; End:
diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el
index e9943df12a8..ff5eac86480 100644
--- a/lisp/language/thai-util.el
+++ b/lisp/language/thai-util.el
@@ -1,6 +1,6 @@
;;; thai-util.el --- utilities for Thai -*- coding: utf-8; -*-
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -257,7 +257,11 @@ positions (integers or markers) specifying the region."
(define-minor-mode thai-word-mode
"Minor mode to make word-oriented commands aware of Thai words.
-The commands affected are \\[forward-word], \\[backward-word], \\[kill-word], \\[backward-kill-word], \\[transpose-words], and \\[fill-paragraph]."
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil. The commands affected are
+\\[forward-word], \\[backward-word], \\[kill-word], \\[backward-kill-word],
+\\[transpose-words], and \\[fill-paragraph]."
:global t :group 'mule
(cond (thai-word-mode
;; This enables linebreak between Thai characters.
diff --git a/lisp/language/thai.el b/lisp/language/thai.el
index dd28ec77edb..c7522f94ec8 100644
--- a/lisp/language/thai.el
+++ b/lisp/language/thai.el
@@ -1,6 +1,6 @@
-;;; thai.el --- support for Thai -*- coding: iso-2022-7bit; no-byte-compile: t -*-
+;;; thai.el --- support for Thai -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 1997-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el
index fd23bbb6d54..f6dd15bf222 100644
--- a/lisp/language/tibet-util.el
+++ b/lisp/language/tibet-util.el
@@ -1,6 +1,6 @@
;;; tibet-util.el --- utilities for Tibetan -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -398,7 +398,7 @@ See also docstring of the function tibetan-compose-region."
))))
(defvar tibetan-strict-unicode t
- "*Flag to control Tibetan canonicalizing for Unicode.
+ "Flag to control Tibetan canonicalizing for Unicode.
If non-nil, the vowel a is removed and composite vowels are decomposed
before writing buffer in Unicode. See also
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index 1607868dea5..97bc3174d3e 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -1,6 +1,6 @@
;;; tibetan.el --- support for Tibetan language -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/utf-8-lang.el b/lisp/language/utf-8-lang.el
index dd840772218..e0313870323 100644
--- a/lisp/language/utf-8-lang.el
+++ b/lisp/language/utf-8-lang.el
@@ -1,6 +1,6 @@
-;;; utf-8-lang.el --- generic UTF-8 language environment -*- no-byte-compile: t -*-
+;;; utf-8-lang.el --- generic UTF-8 language environment
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/lisp/language/viet-util.el b/lisp/language/viet-util.el
index b71c65438be..a6b734c45a8 100644
--- a/lisp/language/viet-util.el
+++ b/lisp/language/viet-util.el
@@ -1,6 +1,6 @@
;;; viet-util.el --- utilities for Vietnamese -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/vietnamese.el b/lisp/language/vietnamese.el
index 4034566afca..7ec5a206990 100644
--- a/lisp/language/vietnamese.el
+++ b/lisp/language/vietnamese.el
@@ -1,6 +1,6 @@
;;; vietnamese.el --- support for Vietnamese -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index db511e1ce40..876402f6fff 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -5,7 +5,7 @@
;;;### (autoloads (5x5-crack 5x5-crack-xor-mutate 5x5-crack-mutating-best
;;;;;; 5x5-crack-mutating-current 5x5-crack-randomly 5x5) "5x5"
-;;;;;; "play/5x5.el" (20168 57844))
+;;;;;; "play/5x5.el" (20545 57511 257469 0))
;;; Generated autoloads from play/5x5.el
(autoload '5x5 "5x5" "\
@@ -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"
-;;;;;; (20178 7273))
+;;;;;; (20576 42138 697312 0))
;;; Generated autoloads from progmodes/ada-mode.el
(autoload 'ada-add-extensions "ada-mode" "\
@@ -88,7 +88,7 @@ Ada mode is the major mode for editing Ada code.
;;;***
;;;### (autoloads (ada-header) "ada-stmt" "progmodes/ada-stmt.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from progmodes/ada-stmt.el
(autoload 'ada-header "ada-stmt" "\
@@ -99,7 +99,7 @@ Insert a descriptive header at the top of the file.
;;;***
;;;### (autoloads (ada-find-file) "ada-xref" "progmodes/ada-xref.el"
-;;;;;; (20176 51947))
+;;;;;; (20458 56750 651721 0))
;;; Generated autoloads from progmodes/ada-xref.el
(autoload 'ada-find-file "ada-xref" "\
@@ -114,7 +114,7 @@ Completion is available.
;;;;;; add-change-log-entry-other-window add-change-log-entry find-change-log
;;;;;; prompt-for-change-log-name add-log-mailing-address add-log-full-name
;;;;;; add-log-current-defun-function) "add-log" "vc/add-log.el"
-;;;;;; (20033 22846))
+;;;;;; (20586 48936 135199 0))
;;; Generated autoloads from vc/add-log.el
(put 'change-log-default-name 'safe-local-variable 'string-or-null-p)
@@ -214,13 +214,13 @@ Runs `change-log-mode-hook'.
\(fn)" t nil)
(defvar add-log-lisp-like-modes '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode) "\
-*Modes that look like Lisp to `add-log-current-defun'.")
+Modes that look like Lisp to `add-log-current-defun'.")
(defvar add-log-c-like-modes '(c-mode c++-mode c++-c-mode objc-mode) "\
-*Modes that look like C to `add-log-current-defun'.")
+Modes that look like C to `add-log-current-defun'.")
(defvar add-log-tex-like-modes '(TeX-mode plain-TeX-mode LaTeX-mode tex-mode) "\
-*Modes that look like TeX to `add-log-current-defun'.")
+Modes that look like TeX to `add-log-current-defun'.")
(autoload 'add-log-current-defun "add-log" "\
Return name of function definition point is in, or nil.
@@ -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" (20179 28130))
+;;;;;; "advice" "emacs-lisp/advice.el" (20618 55210 422086 0))
;;; Generated autoloads from emacs-lisp/advice.el
(defvar ad-redefinition-action 'warn "\
@@ -390,7 +390,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
[DOCSTRING] [INTERACTIVE-FORM]
BODY...)
-\(fn FUNCTION ARGS &rest BODY)" nil (quote macro))
+\(fn FUNCTION ARGS &rest BODY)" nil t)
(put 'defadvice 'doc-string-elt '3)
@@ -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" (20182 4358))
+;;;;;; 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"
-;;;;;; (20178 7273))
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from allout.el
(autoload 'allout-auto-activation-helper "allout" "\
@@ -566,7 +566,7 @@ With value nil, inhibit any automatic allout-mode activation.")
(autoload 'allout-mode-p "allout" "\
Return t if `allout-mode' is active in current buffer.
-\(fn)" nil (quote macro))
+\(fn)" nil t)
(autoload 'allout-mode "allout" "\
Toggle Allout outline mode.
@@ -739,17 +739,17 @@ at the beginning of the current entry.
Extending Allout
-Allout exposure and authoring activites all have associated
+Allout exposure and authoring activities all have associated
hooks, by which independent code can cooperate with allout
without changes to the allout core. Here are key ones:
`allout-mode-hook'
`allout-mode-deactivate-hook' (deprecated)
`allout-mode-off-hook'
-`allout-exposure-change-hook'
-`allout-structure-added-hook'
-`allout-structure-deleted-hook'
-`allout-structure-shifted-hook'
+`allout-exposure-change-functions'
+`allout-structure-added-functions'
+`allout-structure-deleted-functions'
+`allout-structure-shifted-functions'
`allout-after-copy-or-kill-hook'
`allout-post-undo-hook'
@@ -850,13 +850,13 @@ for details on preparing Emacs for automatic allout activation.
;;;### (autoloads (allout-widgets-mode allout-widgets-auto-activation
;;;;;; allout-widgets-setup allout-widgets) "allout-widgets" "allout-widgets.el"
-;;;;;; (20167 36967))
+;;;;;; (20545 57511 257469 0))
;;; Generated autoloads from allout-widgets.el
(let ((loads (get 'allout-widgets 'custom-loads))) (if (member '"allout-widgets" loads) nil (put 'allout-widgets 'custom-loads (cons '"allout-widgets" loads))))
(autoload 'allout-widgets-setup "allout-widgets" "\
-Commission or decommision allout-widgets-mode along with allout-mode.
+Commission or decommission allout-widgets-mode along with allout-mode.
Meant to be used by customization of `allout-widgets-auto-activation'.
@@ -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" (20178 7273))
+;;;;;; "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)
@@ -932,7 +932,7 @@ directory, so that Emacs will know its current contents.
;;;***
;;;### (autoloads (animate-birthday-present animate-sequence animate-string)
-;;;;;; "animate" "play/animate.el" (20164 60780))
+;;;;;; "animate" "play/animate.el" (20545 57511 257469 0))
;;; Generated autoloads from play/animate.el
(autoload 'animate-string "animate" "\
@@ -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" (20164 60780))
+;;;;;; "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,8 @@ 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" (19890 42850))
+;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (20566 63671 243798
+;;;;;; 0))
;;; Generated autoloads from progmodes/antlr-mode.el
(autoload 'antlr-show-makefile-rules "antlr-mode" "\
@@ -1027,7 +1028,7 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'.
;;;***
;;;### (autoloads (appt-activate appt-add) "appt" "calendar/appt.el"
-;;;;;; (19956 37456))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from calendar/appt.el
(autoload 'appt-add "appt" "\
@@ -1050,7 +1051,8 @@ ARG is positive, otherwise off.
;;;### (autoloads (apropos-documentation apropos-value apropos-library
;;;;;; apropos apropos-documentation-property apropos-command apropos-variable
-;;;;;; apropos-read-pattern) "apropos" "apropos.el" (20161 45793))
+;;;;;; apropos-read-pattern) "apropos" "apropos.el" (20523 62082
+;;;;;; 997685 0))
;;; Generated autoloads from apropos.el
(autoload 'apropos-read-pattern "apropos" "\
@@ -1158,8 +1160,8 @@ Returns list of symbols and documentation found.
;;;***
-;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (20165
-;;;;;; 31925))
+;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (20614
+;;;;;; 54428 654267 0))
;;; Generated autoloads from arc-mode.el
(autoload 'archive-mode "arc-mode" "\
@@ -1179,7 +1181,8 @@ archive.
;;;***
-;;;### (autoloads (array-mode) "array" "array.el" (19845 45374))
+;;;### (autoloads (array-mode) "array" "array.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from array.el
(autoload 'array-mode "array" "\
@@ -1250,13 +1253,13 @@ Entering array mode calls the function `array-mode-hook'.
;;;***
-;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (20172
-;;;;;; 54913))
+;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (20513
+;;;;;; 18948 537867 0))
;;; Generated autoloads from textmodes/artist.el
(autoload 'artist-mode "artist" "\
Toggle Artist mode.
-With argument STATE, turn Artist mode on if STATE is positive.
+With argument ARG, turn Artist mode on if ARG is positive.
Artist lets you draw lines, squares, rectangles and poly-lines,
ellipses and circles with your mouse and/or keyboard.
@@ -1445,20 +1448,19 @@ Variables
Hooks
- When entering artist-mode, the hook `artist-mode-init-hook' is called.
- When quitting artist-mode, the hook `artist-mode-exit-hook' is called.
+ Turning the mode on or off runs `artist-mode-hook'.
Keymap summary
\\{artist-mode-map}
-\(fn &optional STATE)" t nil)
+\(fn &optional ARG)" t nil)
;;;***
-;;;### (autoloads (asm-mode) "asm-mode" "progmodes/asm-mode.el" (19890
-;;;;;; 42850))
+;;;### (autoloads (asm-mode) "asm-mode" "progmodes/asm-mode.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/asm-mode.el
(autoload 'asm-mode "asm-mode" "\
@@ -1486,7 +1488,7 @@ Special commands:
;;;***
;;;### (autoloads (auth-source-cache-expiry) "auth-source" "gnus/auth-source.el"
-;;;;;; (20089 47591))
+;;;;;; (20544 36659 880486 0))
;;; Generated autoloads from gnus/auth-source.el
(defvar auth-source-cache-expiry 7200 "\
@@ -1499,7 +1501,7 @@ let-binding.")
;;;***
;;;### (autoloads (autoarg-kp-mode autoarg-mode) "autoarg" "autoarg.el"
-;;;;;; (20127 62865))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from autoarg.el
(defvar autoarg-mode nil "\
@@ -1560,18 +1562,18 @@ This is similar to `autoarg-mode' but rebinds the keypad keys
;;;***
;;;### (autoloads (autoconf-mode) "autoconf" "progmodes/autoconf.el"
-;;;;;; (20163 39903))
+;;;;;; (20513 18948 537867 0))
;;; Generated autoloads from progmodes/autoconf.el
(autoload 'autoconf-mode "autoconf" "\
-Major mode for editing Autoconf configure.in files.
+Major mode for editing Autoconf configure.ac files.
\(fn)" t nil)
;;;***
;;;### (autoloads (auto-insert-mode define-auto-insert auto-insert)
-;;;;;; "autoinsert" "autoinsert.el" (20127 62865))
+;;;;;; "autoinsert" "autoinsert.el" (20566 63671 243798 0))
;;; Generated autoloads from autoinsert.el
(autoload 'auto-insert "autoinsert" "\
@@ -1611,7 +1613,7 @@ insert a template for the file depending on the mode of the buffer.
;;;### (autoloads (batch-update-autoloads update-directory-autoloads
;;;;;; update-file-autoloads) "autoload" "emacs-lisp/autoload.el"
-;;;;;; (20173 35732))
+;;;;;; (20594 43050 277913 0))
;;; Generated autoloads from emacs-lisp/autoload.el
(put 'generated-autoload-file 'safe-local-variable 'stringp)
@@ -1662,7 +1664,7 @@ should be non-nil).
;;;### (autoloads (global-auto-revert-mode turn-on-auto-revert-tail-mode
;;;;;; auto-revert-tail-mode turn-on-auto-revert-mode auto-revert-mode)
-;;;;;; "autorevert" "autorevert.el" (20168 57844))
+;;;;;; "autorevert" "autorevert.el" (20476 31768 298871 0))
;;; Generated autoloads from autorevert.el
(autoload 'auto-revert-mode "autorevert" "\
@@ -1751,7 +1753,7 @@ specifies in the mode line.
;;;***
;;;### (autoloads (mouse-avoidance-mode mouse-avoidance-mode) "avoid"
-;;;;;; "avoid.el" (19845 45374))
+;;;;;; "avoid.el" (20593 22184 581574 0))
;;; Generated autoloads from avoid.el
(defvar mouse-avoidance-mode nil "\
@@ -1792,7 +1794,7 @@ definition of \"random distance\".)
;;;***
;;;### (autoloads (display-battery-mode battery) "battery" "battery.el"
-;;;;;; (20127 62865))
+;;;;;; (20594 43050 277913 0))
;;; Generated autoloads from battery.el
(put 'battery-mode-line-string 'risky-local-variable t)
@@ -1828,7 +1830,8 @@ seconds.
;;;***
;;;### (autoloads (benchmark benchmark-run-compiled benchmark-run)
-;;;;;; "benchmark" "emacs-lisp/benchmark.el" (19981 40664))
+;;;;;; "benchmark" "emacs-lisp/benchmark.el" (20557 48712 315579
+;;;;;; 0))
;;; Generated autoloads from emacs-lisp/benchmark.el
(autoload 'benchmark-run "benchmark" "\
@@ -1840,7 +1843,9 @@ Return a list of the total elapsed time for execution, the number of
garbage collections that ran, and the time taken by garbage collection.
See also `benchmark-run-compiled'.
-\(fn &optional REPETITIONS &rest FORMS)" nil (quote macro))
+\(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.
@@ -1848,7 +1853,9 @@ This is like `benchmark-run', but what is timed is a funcall of the
byte code obtained by wrapping FORMS in a `lambda' and compiling the
result. The overhead of the `lambda's is accounted for.
-\(fn &optional REPETITIONS &rest FORMS)" nil (quote macro))
+\(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.
@@ -1861,7 +1868,7 @@ For non-interactive use see also `benchmark-run' and
;;;***
;;;### (autoloads (bibtex-search-entry bibtex-mode bibtex-initialize)
-;;;;;; "bibtex" "textmodes/bibtex.el" (20174 10230))
+;;;;;; "bibtex" "textmodes/bibtex.el" (20576 13095 881042 0))
;;; Generated autoloads from textmodes/bibtex.el
(autoload 'bibtex-initialize "bibtex" "\
@@ -1950,7 +1957,7 @@ A prefix arg negates the value of `bibtex-search-entry-globally'.
;;;***
;;;### (autoloads (bibtex-style-mode) "bibtex-style" "textmodes/bibtex-style.el"
-;;;;;; (19863 8742))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from textmodes/bibtex-style.el
(autoload 'bibtex-style-mode "bibtex-style" "\
@@ -1962,7 +1969,7 @@ Major mode for editing BibTeX style files.
;;;### (autoloads (binhex-decode-region binhex-decode-region-external
;;;;;; binhex-decode-region-internal) "binhex" "mail/binhex.el"
-;;;;;; (20174 10230))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mail/binhex.el
(defconst binhex-begin-line "^:...............................................................$" "\
@@ -1986,8 +1993,8 @@ Binhex decode region between START and END.
;;;***
-;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (20551
+;;;;;; 9899 283417 0))
;;; Generated autoloads from play/blackbox.el
(autoload 'blackbox "blackbox" "\
@@ -2110,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" (20178 7273))
+;;;;;; "bookmark.el" (20618 55210 422086 0))
;;; Generated autoloads from bookmark.el
(define-key ctl-x-r-map "b" 'bookmark-jump)
(define-key ctl-x-r-map "m" 'bookmark-set)
@@ -2297,7 +2304,7 @@ Incremental search of bookmarks, hiding the non-matches as we go.
\(fn)" t nil)
-(defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) (define-key map [load] `(menu-item ,(purecopy "Load a Bookmark File...") bookmark-load :help ,(purecopy "Load bookmarks from a bookmark file)"))) (define-key map [write] `(menu-item ,(purecopy "Save Bookmarks As...") bookmark-write :help ,(purecopy "Write bookmarks to a file (reading the file name with the minibuffer)"))) (define-key map [save] `(menu-item ,(purecopy "Save Bookmarks") bookmark-save :help ,(purecopy "Save currently defined bookmarks"))) (define-key map [edit] `(menu-item ,(purecopy "Edit Bookmark List") bookmark-bmenu-list :help ,(purecopy "Display a list of existing bookmarks"))) (define-key map [delete] `(menu-item ,(purecopy "Delete Bookmark...") bookmark-delete :help ,(purecopy "Delete a bookmark from the bookmark list"))) (define-key map [rename] `(menu-item ,(purecopy "Rename Bookmark...") bookmark-rename :help ,(purecopy "Change the name of a bookmark"))) (define-key map [locate] `(menu-item ,(purecopy "Insert Location...") bookmark-locate :help ,(purecopy "Insert the name of the file associated with a bookmark"))) (define-key map [insert] `(menu-item ,(purecopy "Insert Contents...") bookmark-insert :help ,(purecopy "Insert the text of the file pointed to by a bookmark"))) (define-key map [set] `(menu-item ,(purecopy "Set Bookmark...") bookmark-set :help ,(purecopy "Set a bookmark named inside a file."))) (define-key map [jump] `(menu-item ,(purecopy "Jump to Bookmark...") bookmark-jump :help ,(purecopy "Jump to a bookmark (a point in some file)"))) map))
+(defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) (bindings--define-key map [load] '(menu-item "Load a Bookmark File..." bookmark-load :help "Load bookmarks from a bookmark file)")) (bindings--define-key map [write] '(menu-item "Save Bookmarks As..." bookmark-write :help "Write bookmarks to a file (reading the file name with the minibuffer)")) (bindings--define-key map [save] '(menu-item "Save Bookmarks" bookmark-save :help "Save currently defined bookmarks")) (bindings--define-key map [edit] '(menu-item "Edit Bookmark List" bookmark-bmenu-list :help "Display a list of existing bookmarks")) (bindings--define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) (bindings--define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) (bindings--define-key map [locate] '(menu-item "Insert Location..." bookmark-locate :help "Insert the name of the file associated with a bookmark")) (bindings--define-key map [insert] '(menu-item "Insert Contents..." bookmark-insert :help "Insert the text of the file pointed to by a bookmark")) (bindings--define-key map [set] '(menu-item "Set Bookmark..." bookmark-set :help "Set a bookmark named inside a file.")) (bindings--define-key map [jump] '(menu-item "Jump to Bookmark..." bookmark-jump :help "Jump to a bookmark (a point in some file)")) map))
(defalias 'menu-bar-bookmark-map menu-bar-bookmark-map)
@@ -2311,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" (20168 57844))
+;;;;;; "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 "\
@@ -2380,9 +2387,11 @@ to use.
\(fn EVENT)" t nil)
(autoload 'browse-url-xdg-open "browse-url" "\
+Pass the specified URL to the \"xdg-open\" command.
+xdg-open is a desktop utility that calls your preferred web browser.
+The optional argument IGNORED is not used.
-
-\(fn URL &optional NEW-WINDOW)" t nil)
+\(fn URL &optional IGNORED)" t nil)
(autoload 'browse-url-netscape "browse-url" "\
Ask the Netscape WWW browser to load URL.
@@ -2624,24 +2633,8 @@ from `browse-url-elinks-wrapper'.
;;;***
-;;;### (autoloads (snarf-bruces bruce) "bruce" "play/bruce.el" (20165
-;;;;;; 31925))
-;;; Generated autoloads from play/bruce.el
-
-(autoload 'bruce "bruce" "\
-Adds that special touch of class to your outgoing mail.
-
-\(fn)" t nil)
-
-(autoload 'snarf-bruces "bruce" "\
-Return a vector containing the lines from `bruce-phrases-file'.
-
-\(fn)" nil nil)
-
-;;;***
-
;;;### (autoloads (bs-show bs-customize bs-cycle-previous bs-cycle-next)
-;;;;;; "bs" "bs.el" (20161 45793))
+;;;;;; "bs" "bs.el" (20576 13095 881042 0))
;;; Generated autoloads from bs.el
(autoload 'bs-cycle-next "bs" "\
@@ -2681,7 +2674,8 @@ name of buffer configuration.
;;;***
-;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20166 16092))
+;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20566 63671
+;;;;;; 243798 0))
;;; Generated autoloads from play/bubbles.el
(autoload 'bubbles "bubbles" "\
@@ -2703,7 +2697,7 @@ columns on its right towards the left.
;;;***
;;;### (autoloads (bug-reference-prog-mode bug-reference-mode) "bug-reference"
-;;;;;; "progmodes/bug-reference.el" (20127 62865))
+;;;;;; "progmodes/bug-reference.el" (20593 22184 581574 0))
;;; Generated autoloads from progmodes/bug-reference.el
(put 'bug-reference-url-format 'safe-local-variable (lambda (s) (or (stringp s) (and (symbolp s) (get s 'bug-reference-url-format)))))
@@ -2727,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" (20178 7273))
+;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (20599 27513 576550 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)
@@ -2847,8 +2841,8 @@ and corresponding effects.
;;;***
-;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (19885
-;;;;;; 24894))
+;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from calendar/cal-china.el
(put 'calendar-chinese-time-zone 'risky-local-variable t)
@@ -2857,7 +2851,8 @@ and corresponding effects.
;;;***
-;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (19885 24894))
+;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (20461 32935
+;;;;;; 300400 0))
;;; Generated autoloads from calendar/cal-dst.el
(put 'calendar-daylight-savings-starts 'risky-local-variable t)
@@ -2869,7 +2864,7 @@ and corresponding effects.
;;;***
;;;### (autoloads (calendar-hebrew-list-yahrzeits) "cal-hebrew" "calendar/cal-hebrew.el"
-;;;;;; (19885 24894))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from calendar/cal-hebrew.el
(autoload 'calendar-hebrew-list-yahrzeits "cal-hebrew" "\
@@ -2885,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" (20172
-;;;;;; 54913))
+;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (20593
+;;;;;; 22184 581574 0))
;;; Generated autoloads from calc/calc.el
(define-key ctl-x-map "*" 'calc-dispatch)
@@ -2964,14 +2959,14 @@ actual Lisp function name.
See Info node `(calc)Defining Functions'.
-\(fn FUNC ARGS &rest BODY)" nil (quote macro))
+\(fn FUNC ARGS &rest BODY)" nil t)
(put 'defmath 'doc-string-elt '3)
;;;***
-;;;### (autoloads (calc-undo) "calc-undo" "calc/calc-undo.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (calc-undo) "calc-undo" "calc/calc-undo.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from calc/calc-undo.el
(autoload 'calc-undo "calc-undo" "\
@@ -2981,8 +2976,8 @@ See Info node `(calc)Defining Functions'.
;;;***
-;;;### (autoloads (calculator) "calculator" "calculator.el" (20141
-;;;;;; 9296))
+;;;### (autoloads (calculator) "calculator" "calculator.el" (20476
+;;;;;; 31768 298871 0))
;;; Generated autoloads from calculator.el
(autoload 'calculator "calculator" "\
@@ -2993,8 +2988,8 @@ See the documentation for `calculator-mode' for more information.
;;;***
-;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (20141
-;;;;;; 9296))
+;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (20594
+;;;;;; 43050 277913 0))
;;; Generated autoloads from calendar/calendar.el
(autoload 'calendar "calendar" "\
@@ -3031,14 +3026,14 @@ 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)
;;;***
;;;### (autoloads (canlock-verify canlock-insert-header) "canlock"
-;;;;;; "gnus/canlock.el" (19845 45374))
+;;;;;; "gnus/canlock.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/canlock.el
(autoload 'canlock-insert-header "canlock" "\
@@ -3056,7 +3051,7 @@ it fails.
;;;***
;;;### (autoloads (capitalized-words-mode) "cap-words" "progmodes/cap-words.el"
-;;;;;; (20127 62865))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from progmodes/cap-words.el
(autoload 'capitalized-words-mode "cap-words" "\
@@ -3095,15 +3090,15 @@ Obsoletes `c-forward-into-nomenclature'.
;;;***
-;;;### (autoloads nil "cc-compat" "progmodes/cc-compat.el" (19845
-;;;;;; 45374))
+;;;### (autoloads nil "cc-compat" "progmodes/cc-compat.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/cc-compat.el
(put 'c-indent-level 'safe-local-variable 'integerp)
;;;***
;;;### (autoloads (c-guess-basic-syntax) "cc-engine" "progmodes/cc-engine.el"
-;;;;;; (20172 54913))
+;;;;;; (20557 48712 315579 0))
;;; Generated autoloads from progmodes/cc-engine.el
(autoload 'c-guess-basic-syntax "cc-engine" "\
@@ -3115,7 +3110,8 @@ Return the syntactic context of the current line.
;;;### (autoloads (c-guess-install c-guess-region-no-install c-guess-region
;;;;;; c-guess-buffer-no-install c-guess-buffer c-guess-no-install
-;;;;;; c-guess) "cc-guess" "progmodes/cc-guess.el" (19981 40664))
+;;;;;; c-guess) "cc-guess" "progmodes/cc-guess.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from progmodes/cc-guess.el
(defvar c-guess-guessed-offsets-alist nil "\
@@ -3215,7 +3211,7 @@ the absolute file name of the file if STYLE-NAME is nil.
;;;### (autoloads (awk-mode pike-mode idl-mode java-mode objc-mode
;;;;;; c++-mode c-mode c-initialize-cc-mode) "cc-mode" "progmodes/cc-mode.el"
-;;;;;; (20168 57844))
+;;;;;; (20614 54428 654267 0))
;;; Generated autoloads from progmodes/cc-mode.el
(autoload 'c-initialize-cc-mode "cc-mode" "\
@@ -3345,7 +3341,7 @@ Key bindings:
(defvar pike-mode-syntax-table nil "\
Syntax table used in pike-mode buffers.")
- (add-to-list 'auto-mode-alist '("\\.\\(u?lpc\\|pike\\|pmod\\(.in\\)?\\)\\'" . pike-mode))
+ (add-to-list 'auto-mode-alist '("\\.\\(u?lpc\\|pike\\|pmod\\(\\.in\\)?\\)\\'" . pike-mode))
(add-to-list 'interpreter-mode-alist '("pike" . pike-mode))
(autoload 'pike-mode "cc-mode" "\
@@ -3392,7 +3388,7 @@ Key bindings:
;;;***
;;;### (autoloads (c-set-offset c-add-style c-set-style) "cc-styles"
-;;;;;; "progmodes/cc-styles.el" (19981 40664))
+;;;;;; "progmodes/cc-styles.el" (20566 63671 243798 0))
;;; Generated autoloads from progmodes/cc-styles.el
(autoload 'c-set-style "cc-styles" "\
@@ -3409,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
@@ -3443,7 +3439,8 @@ and exists only for compatibility reasons.
;;;***
-;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (20167 36967))
+;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (20595 63909
+;;;;;; 923329 0))
;;; Generated autoloads from progmodes/cc-vars.el
(put 'c-basic-offset 'safe-local-variable 'integerp)
(put 'c-backslash-column 'safe-local-variable 'integerp)
@@ -3453,7 +3450,7 @@ and exists only for compatibility reasons.
;;;### (autoloads (ccl-execute-with-args check-ccl-program define-ccl-program
;;;;;; declare-ccl-program ccl-dump ccl-compile) "ccl" "international/ccl.el"
-;;;;;; (19943 25429))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from international/ccl.el
(autoload 'ccl-compile "ccl" "\
@@ -3477,7 +3474,7 @@ execution.
Optional arg VECTOR is a compiled CCL code of the CCL program.
-\(fn NAME &optional VECTOR)" nil (quote macro))
+\(fn NAME &optional VECTOR)" nil t)
(autoload 'define-ccl-program "ccl" "\
Set NAME the compiled code of CCL-PROGRAM.
@@ -3644,7 +3641,7 @@ OPERATOR :=
| de-sjis
;; If ARG_0 and ARG_1 are the first and second code point of
- ;; JISX0208 character CHAR, and SJIS is the correponding
+ ;; JISX0208 character CHAR, and SJIS is the corresponding
;; Shift-JIS code,
;; (REG = ARG_0 en-sjis ARG_1) means:
;; ((REG = HIGH)
@@ -3690,7 +3687,7 @@ MAP-IDs := MAP-ID ...
MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET
MAP-ID := integer
-\(fn NAME CCL-PROGRAM &optional DOC)" nil (quote macro))
+\(fn NAME CCL-PROGRAM &optional DOC)" nil t)
(put 'define-ccl-program 'doc-string-elt '3)
@@ -3701,7 +3698,7 @@ CCL-PROGRAM, else return nil.
If CCL-PROGRAM is a vector and optional arg NAME (symbol) is supplied,
register CCL-PROGRAM by name NAME, and return NAME.
-\(fn CCL-PROGRAM &optional NAME)" nil (quote macro))
+\(fn CCL-PROGRAM &optional NAME)" nil t)
(autoload 'ccl-execute-with-args "ccl" "\
Execute CCL-PROGRAM with registers initialized by the remaining args.
@@ -3714,7 +3711,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program.
;;;***
;;;### (autoloads (cconv-closure-convert) "cconv" "emacs-lisp/cconv.el"
-;;;;;; (20178 7273))
+;;;;;; (20453 5437 764254 0))
;;; Generated autoloads from emacs-lisp/cconv.el
(autoload 'cconv-closure-convert "cconv" "\
@@ -3728,12 +3725,12 @@ Returns a form where all lambdas don't have any free variables.
;;;***
-;;;### (autoloads (cfengine-auto-mode cfengine-mode cfengine3-mode)
-;;;;;; "cfengine" "progmodes/cfengine.el" (20168 57844))
+;;;### (autoloads (cfengine-auto-mode cfengine2-mode cfengine3-mode)
+;;;;;; "cfengine" "progmodes/cfengine.el" (20355 10021 546955 0))
;;; Generated autoloads from progmodes/cfengine.el
(autoload 'cfengine3-mode "cfengine" "\
-Major mode for editing cfengine input.
+Major mode for editing CFEngine3 input.
There are no special keybindings by default.
Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
@@ -3741,8 +3738,8 @@ to the action header.
\(fn)" t nil)
-(autoload 'cfengine-mode "cfengine" "\
-Major mode for editing cfengine input.
+(autoload 'cfengine2-mode "cfengine" "\
+Major mode for editing CFEngine2 input.
There are no special keybindings by default.
Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
@@ -3751,7 +3748,7 @@ to the action header.
\(fn)" t nil)
(autoload 'cfengine-auto-mode "cfengine" "\
-Choose between `cfengine-mode' and `cfengine3-mode' depending
+Choose between `cfengine2-mode' and `cfengine3-mode' depending
on the buffer contents
\(fn)" nil nil)
@@ -3759,7 +3756,7 @@ on the buffer contents
;;;***
;;;### (autoloads (check-declare-directory check-declare-file) "check-declare"
-;;;;;; "emacs-lisp/check-declare.el" (19906 31087))
+;;;;;; "emacs-lisp/check-declare.el" (20378 29222 722320 0))
;;; Generated autoloads from emacs-lisp/check-declare.el
(autoload 'check-declare-file "check-declare" "\
@@ -3784,7 +3781,7 @@ Returns non-nil if any false statements are found.
;;;;;; checkdoc-comments checkdoc-continue checkdoc-start checkdoc-current-buffer
;;;;;; checkdoc-eval-current-buffer checkdoc-message-interactive
;;;;;; checkdoc-interactive checkdoc checkdoc-list-of-strings-p)
-;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (20168 57844))
+;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (20614 54428 654267 0))
;;; Generated autoloads from emacs-lisp/checkdoc.el
(put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp)
(put 'checkdoc-force-history-flag 'safe-local-variable 'booleanp)
@@ -3980,7 +3977,7 @@ checking of documentation strings.
;;;### (autoloads (pre-write-encode-hz post-read-decode-hz encode-hz-buffer
;;;;;; encode-hz-region decode-hz-buffer decode-hz-region) "china-util"
-;;;;;; "language/china-util.el" (19845 45374))
+;;;;;; "language/china-util.el" (20355 10021 546955 0))
;;; Generated autoloads from language/china-util.el
(autoload 'decode-hz-region "china-util" "\
@@ -4018,7 +4015,7 @@ Encode the text in the current buffer to HZ.
;;;***
;;;### (autoloads (command-history list-command-history repeat-matching-complex-command)
-;;;;;; "chistory" "chistory.el" (19845 45374))
+;;;;;; "chistory" "chistory.el" (20355 10021 546955 0))
;;; Generated autoloads from chistory.el
(autoload 'repeat-matching-complex-command "chistory" "\
@@ -4057,23 +4054,8 @@ and runs the normal hook `command-history-hook'.
;;;***
-;;;### (autoloads nil "cl" "emacs-lisp/cl.el" (20137 45833))
-;;; Generated autoloads from emacs-lisp/cl.el
-
-(defvar custom-print-functions nil "\
-This is a list of functions that format user objects for printing.
-Each function is called in turn with three arguments: the object, the
-stream, and the print level (currently ignored). If it is able to
-print the object it returns true; otherwise it returns nil and the
-printer proceeds to the next function on the list.
-
-This variable is not used at present, but it is defined in hopes that
-a future Emacs interpreter will be able to use it.")
-
-;;;***
-
;;;### (autoloads (common-lisp-indent-function) "cl-indent" "emacs-lisp/cl-indent.el"
-;;;;;; (20170 64186))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/cl-indent.el
(autoload 'common-lisp-indent-function "cl-indent" "\
@@ -4151,8 +4133,36 @@ For example, the function `case' has an indent property
;;;***
+;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (20599 27513
+;;;;;; 576550 0))
+;;; Generated autoloads from emacs-lisp/cl-lib.el
+
+(define-obsolete-variable-alias 'custom-print-functions 'cl-custom-print-functions "24.3")
+
+(defvar cl-custom-print-functions nil "\
+This is a list of functions that format user objects for printing.
+Each function is called in turn with three arguments: the object, the
+stream, and the print level (currently ignored). If it is able to
+print the object it returns true; otherwise it returns nil and the
+printer proceeds to the next function on the list.
+
+This variable is not used at present, but it is defined in hopes that
+a future Emacs interpreter will be able to use it.")
+
+(autoload 'cl--defsubst-expand "cl-macs")
+
+(put 'cl-defun 'doc-string-elt 3)
+
+(put 'cl-defmacro 'doc-string-elt 3)
+
+(put 'cl-defsubst 'doc-string-elt 3)
+
+(put 'cl-defstruct 'doc-string-elt 2)
+
+;;;***
+
;;;### (autoloads (c-macro-expand) "cmacexp" "progmodes/cmacexp.el"
-;;;;;; (19845 45374))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from progmodes/cmacexp.el
(autoload 'c-macro-expand "cmacexp" "\
@@ -4172,8 +4182,8 @@ For use inside Lisp programs, see also `c-macro-expansion'.
;;;***
-;;;### (autoloads (run-scheme) "cmuscheme" "cmuscheme.el" (20092
-;;;;;; 23754))
+;;;### (autoloads (run-scheme) "cmuscheme" "cmuscheme.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from cmuscheme.el
(autoload 'run-scheme "cmuscheme" "\
@@ -4193,7 +4203,8 @@ is run).
;;;***
-;;;### (autoloads (color-name-to-rgb) "color" "color.el" (20175 31160))
+;;;### (autoloads (color-name-to-rgb) "color" "color.el" (20592 1317
+;;;;;; 691761 0))
;;; Generated autoloads from color.el
(autoload 'color-name-to-rgb "color" "\
@@ -4204,7 +4215,7 @@ 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.
@@ -4215,10 +4226,10 @@ 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"
-;;;;;; (20168 57844))
+;;;;;; (20594 43050 277913 0))
;;; Generated autoloads from comint.el
-(defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\
+(defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\
Functions to call after output is inserted into the buffer.
One possible function is `comint-postoutput-scroll-to-bottom'.
These functions get one argument, a string containing the text as originally
@@ -4234,16 +4245,21 @@ either globally or locally.")
(autoload 'make-comint-in-buffer "comint" "\
Make a Comint process NAME in BUFFER, running PROGRAM.
If BUFFER is nil, it defaults to NAME surrounded by `*'s.
-PROGRAM should be either a string denoting an executable program to create
-via `start-file-process', or a cons pair of the form (HOST . SERVICE) denoting
-a TCP connection to be opened via `open-network-stream'. If there is already
-a running process in that buffer, it is not restarted. Optional fourth arg
-STARTFILE is the name of a file, whose contents are sent to the
-process as its initial input.
+If there is a running process in BUFFER, it is not restarted.
+
+PROGRAM should be one of the following:
+- a string, denoting an executable program to create via
+ `start-file-process'
+- a cons pair of the form (HOST . SERVICE), denoting a TCP
+ connection to be opened via `open-network-stream'
+- nil, denoting a newly-allocated pty.
+
+Optional fourth arg STARTFILE is the name of a file, whose
+contents are sent to the process as its initial input.
If PROGRAM is a string, any more args are arguments to PROGRAM.
-Returns the (possibly newly created) process buffer.
+Return the (possibly newly created) process buffer.
\(fn NAME BUFFER PROGRAM &optional STARTFILE &rest SWITCHES)" nil nil)
@@ -4310,7 +4326,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use.
;;;***
;;;### (autoloads (compare-windows) "compare-w" "vc/compare-w.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from vc/compare-w.el
(autoload 'compare-windows "compare-w" "\
@@ -4347,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" (20167
-;;;;;; 36967))
+;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (20615
+;;;;;; 49194 141673 0))
;;; Generated autoloads from progmodes/compile.el
(defvar compilation-mode-hook nil "\
@@ -4372,7 +4388,7 @@ Number of lines in a compilation window. If nil, use Emacs default.")
(custom-autoload 'compilation-window-height "compile" t)
(defvar compilation-process-setup-function nil "\
-*Function to call to customize the compilation process.
+Function to call to customize the compilation process.
This function is called immediately before the compilation process is
started. It can be used to set any variables or functions that are used
while processing the output of the compilation process.")
@@ -4494,6 +4510,8 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
\(fn &optional NAME-OF-MODE)" t nil)
+(put 'define-compilation-mode 'doc-string-elt 3)
+
(autoload 'compilation-shell-minor-mode "compile" "\
Toggle Compilation Shell minor mode.
With a prefix argument ARG, enable Compilation Shell minor mode
@@ -4528,7 +4546,7 @@ This is the value of `next-error-function' in Compilation buffers.
;;;***
;;;### (autoloads (dynamic-completion-mode) "completion" "completion.el"
-;;;;;; (19886 45771))
+;;;;;; (20495 51111 757560 0))
;;; Generated autoloads from completion.el
(defvar dynamic-completion-mode nil "\
@@ -4541,7 +4559,10 @@ or call the function `dynamic-completion-mode'.")
(custom-autoload 'dynamic-completion-mode "completion" nil)
(autoload 'dynamic-completion-mode "completion" "\
-Enable dynamic word-completion.
+Toggle dynamic word-completion on or off.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
\(fn &optional ARG)" t nil)
@@ -4550,7 +4571,7 @@ Enable dynamic word-completion.
;;;### (autoloads (conf-xdefaults-mode conf-ppd-mode conf-colon-mode
;;;;;; conf-space-keywords conf-space-mode conf-javaprop-mode conf-windows-mode
;;;;;; conf-unix-mode conf-mode) "conf-mode" "textmodes/conf-mode.el"
-;;;;;; (20178 7273))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from textmodes/conf-mode.el
(autoload 'conf-mode "conf-mode" "\
@@ -4706,7 +4727,7 @@ For details see `conf-mode'. Example:
;;;***
;;;### (autoloads (shuffle-vector cookie-snarf cookie-insert cookie)
-;;;;;; "cookie1" "play/cookie1.el" (19845 45374))
+;;;;;; "cookie1" "play/cookie1.el" (20545 57511 257469 0))
;;; Generated autoloads from play/cookie1.el
(autoload 'cookie "cookie1" "\
@@ -4738,8 +4759,8 @@ Randomly permute the elements of VECTOR (all permutations equally likely).
;;;***
;;;### (autoloads (copyright-update-directory copyright copyright-fix-years
-;;;;;; copyright-update) "copyright" "emacs-lisp/copyright.el" (19845
-;;;;;; 45374))
+;;;;;; copyright-update) "copyright" "emacs-lisp/copyright.el" (20518
+;;;;;; 12580 46478 0))
;;; Generated autoloads from emacs-lisp/copyright.el
(put 'copyright-at-end-flag 'safe-local-variable 'booleanp)
(put 'copyright-names-regexp 'safe-local-variable 'stringp)
@@ -4778,7 +4799,8 @@ If FIX is non-nil, run `copyright-fix-years' instead.
;;;***
;;;### (autoloads (cperl-perldoc-at-point cperl-perldoc cperl-mode)
-;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (20178 7273))
+;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (20512 60198 306109
+;;;;;; 0))
;;; Generated autoloads from progmodes/cperl-mode.el
(put 'cperl-indent-level 'safe-local-variable 'integerp)
(put 'cperl-brace-offset 'safe-local-variable 'integerp)
@@ -4803,8 +4825,8 @@ default.) You can always quote (with \\[quoted-insert]) the left
since most the time you mean \"less\". CPerl mode tries to guess
whether you want to type pair <>, and inserts is if it
appropriate. You can set `cperl-electric-parens-string' to the string that
-contains the parenths from the above list you want to be electrical.
-Electricity of parenths is controlled by `cperl-electric-parens'.
+contains the parens from the above list you want to be electrical.
+Electricity of parens is controlled by `cperl-electric-parens'.
You may also set `cperl-electric-parens-mark' to have electric parens
look for active mark and \"embrace\" a region if possible.'
@@ -4977,7 +4999,7 @@ Run a `perldoc' on the word around point.
;;;***
;;;### (autoloads (cpp-parse-edit cpp-highlight-buffer) "cpp" "progmodes/cpp.el"
-;;;;;; (20104 14925))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from progmodes/cpp.el
(autoload 'cpp-highlight-buffer "cpp" "\
@@ -4996,7 +5018,7 @@ Edit display information for cpp conditionals.
;;;***
;;;### (autoloads (crisp-mode crisp-mode) "crisp" "emulation/crisp.el"
-;;;;;; (20161 45793))
+;;;;;; (20593 22184 581574 0))
;;; Generated autoloads from emulation/crisp.el
(defvar crisp-mode nil "\
@@ -5022,7 +5044,7 @@ if ARG is omitted or nil.
;;;***
;;;### (autoloads (completing-read-multiple) "crm" "emacs-lisp/crm.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/crm.el
(autoload 'completing-read-multiple "crm" "\
@@ -5057,8 +5079,8 @@ INHERIT-INPUT-METHOD.
;;;***
-;;;### (autoloads (css-mode) "css-mode" "textmodes/css-mode.el" (19978
-;;;;;; 37530))
+;;;### (autoloads (css-mode) "css-mode" "textmodes/css-mode.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from textmodes/css-mode.el
(autoload 'css-mode "css-mode" "\
@@ -5069,7 +5091,7 @@ Major mode to edit Cascading Style Sheets.
;;;***
;;;### (autoloads (cua-selection-mode cua-mode) "cua-base" "emulation/cua-base.el"
-;;;;;; (20127 62865))
+;;;;;; (20434 17809 692608 0))
;;; Generated autoloads from emulation/cua-base.el
(defvar cua-mode nil "\
@@ -5129,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" (20179 28130))
+;;;;;; "cus-edit" "cus-edit.el" (20577 33959 40183 0))
;;; Generated autoloads from cus-edit.el
(defvar custom-browse-sort-alphabetically nil "\
@@ -5234,14 +5256,14 @@ Customize GROUP, which must be a customization group, in another window.
(defalias 'customize-variable 'customize-option)
(autoload 'customize-option "cus-edit" "\
-Customize SYMBOL, which must be a user option variable.
+Customize SYMBOL, which must be a user option.
\(fn SYMBOL)" t nil)
(defalias 'customize-variable-other-window 'customize-option-other-window)
(autoload 'customize-option-other-window "cus-edit" "\
-Customize SYMBOL, which must be a user option variable.
+Customize SYMBOL, which must be a user option.
Show the buffer in another window, but don't select it.
\(fn SYMBOL)" t nil)
@@ -5281,9 +5303,10 @@ the official name of the package, such as MH-E or Gnus.")
(autoload 'customize-changed-options "cus-edit" "\
Customize all settings whose meanings have changed in Emacs itself.
-This includes new user option variables and faces, and new
-customization groups, as well as older options and faces whose meanings
-or default values have changed since the previous major Emacs release.
+This includes new user options and faces, and new customization
+groups, as well as older options and faces whose meanings or
+default values have changed since the previous major Emacs
+release.
With argument SINCE-VERSION (a string), customize all settings
that were added or redefined since that version.
@@ -5312,7 +5335,7 @@ suggest to customize that face, if it's customizable.
\(fn &optional FACE)" t nil)
(autoload 'customize-unsaved "cus-edit" "\
-Customize all user options set in this session but not saved.
+Customize all options and faces set in this session but not saved.
\(fn)" t nil)
@@ -5322,12 +5345,12 @@ Customize all user variables modified outside customize.
\(fn)" t nil)
(autoload 'customize-saved "cus-edit" "\
-Customize all already saved user options.
+Customize all saved options and faces.
\(fn)" t nil)
(autoload 'customize-apropos "cus-edit" "\
-Customize all loaded options, faces and groups matching PATTERN.
+Customize loaded options, faces and groups matching PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
or a regexp (using some regexp special characters). If it is a word,
search for matches for that word as a substring. If it is a list of words,
@@ -5336,18 +5359,13 @@ search for matches for any two (or more) of those words.
If TYPE is `options', include only options.
If TYPE is `faces', include only faces.
If TYPE is `groups', include only groups.
-If TYPE is t (interactively, with prefix arg), include variables
-that are not customizable options, as well as faces and groups
-\(but we recommend using `apropos-variable' instead).
\(fn PATTERN &optional TYPE)" t nil)
(autoload 'customize-apropos-options "cus-edit" "\
Customize all loaded customizable options matching REGEXP.
-With prefix ARG, include variables that are not customizable options
-\(but it is better to use `apropos-variable' if you want to find those).
-\(fn REGEXP &optional ARG)" t nil)
+\(fn REGEXP &optional IGNORED)" t nil)
(autoload 'customize-apropos-faces "cus-edit" "\
Customize all loaded faces matching REGEXP.
@@ -5445,14 +5463,16 @@ The format is suitable for use with `easy-menu-define'.
;;;***
;;;### (autoloads (customize-themes describe-theme custom-theme-visit-theme
-;;;;;; customize-create-theme) "cus-theme" "cus-theme.el" (20059
-;;;;;; 26455))
+;;;;;; customize-create-theme) "cus-theme" "cus-theme.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from cus-theme.el
(autoload 'customize-create-theme "cus-theme" "\
Create or edit a custom theme.
THEME, if non-nil, should be an existing theme to edit. If THEME
-is `user', provide an option to remove these as custom settings.
+is `user', the resulting *Custom Theme* buffer also contains a
+checkbox for removing the theme settings specified in the buffer
+from the Custom save file.
BUFFER, if non-nil, should be a buffer to use; the default is
named *Custom Theme*.
@@ -5478,7 +5498,7 @@ omitted, a buffer named *Custom Themes* is used.
;;;***
;;;### (autoloads (cvs-status-mode) "cvs-status" "vc/cvs-status.el"
-;;;;;; (20174 10230))
+;;;;;; (20476 31768 298871 0))
;;; Generated autoloads from vc/cvs-status.el
(autoload 'cvs-status-mode "cvs-status" "\
@@ -5488,8 +5508,8 @@ Mode used for cvs status output.
;;;***
-;;;### (autoloads (global-cwarn-mode turn-on-cwarn-mode cwarn-mode)
-;;;;;; "cwarn" "progmodes/cwarn.el" (20168 57844))
+;;;### (autoloads (global-cwarn-mode cwarn-mode) "cwarn" "progmodes/cwarn.el"
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from progmodes/cwarn.el
(autoload 'cwarn-mode "cwarn" "\
@@ -5501,17 +5521,13 @@ Note, in addition to enabling this minor mode, the major mode must
be included in the variable `cwarn-configuration'. By default C and
C++ modes are included.
-With ARG, turn CWarn mode on if and only if arg is positive.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+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.
@@ -5538,7 +5554,7 @@ See `cwarn-mode' for more information on Cwarn mode.
;;;### (autoloads (standard-display-cyrillic-translit cyrillic-encode-alternativnyj-char
;;;;;; cyrillic-encode-koi8-r-char) "cyril-util" "language/cyril-util.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from language/cyril-util.el
(autoload 'cyrillic-encode-koi8-r-char "cyril-util" "\
@@ -5567,7 +5583,7 @@ If the argument is nil, we return the display table to its standard state.
;;;***
;;;### (autoloads (dabbrev-expand dabbrev-completion) "dabbrev" "dabbrev.el"
-;;;;;; (19989 34789))
+;;;;;; (20397 45851 446679 0))
;;; Generated autoloads from dabbrev.el
(put 'dabbrev-case-fold-search 'risky-local-variable t)
(put 'dabbrev-case-replace 'risky-local-variable t)
@@ -5614,7 +5630,7 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion].
;;;***
;;;### (autoloads (data-debug-new-buffer) "data-debug" "cedet/data-debug.el"
-;;;;;; (20168 57844))
+;;;;;; (20586 48936 135199 0))
;;; Generated autoloads from cedet/data-debug.el
(autoload 'data-debug-new-buffer "data-debug" "\
@@ -5624,8 +5640,8 @@ Create a new data-debug buffer with NAME.
;;;***
-;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (20176
-;;;;;; 51947))
+;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (20614
+;;;;;; 54428 654267 0))
;;; Generated autoloads from net/dbus.el
(autoload 'dbus-handle-event "dbus" "\
@@ -5638,8 +5654,8 @@ If the HANDLER returns a `dbus-error', it is propagated as return message.
;;;***
-;;;### (autoloads (dcl-mode) "dcl-mode" "progmodes/dcl-mode.el" (20162
-;;;;;; 63140))
+;;;### (autoloads (dcl-mode) "dcl-mode" "progmodes/dcl-mode.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/dcl-mode.el
(autoload 'dcl-mode "dcl-mode" "\
@@ -5766,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" (20098 62550))
+;;;;;; "emacs-lisp/debug.el" (20609 10405 476026 0))
;;; Generated autoloads from emacs-lisp/debug.el
(setq debugger 'debug)
@@ -5810,7 +5826,7 @@ To specify a nil argument interactively, exit with an empty minibuffer.
;;;***
;;;### (autoloads (decipher-mode decipher) "decipher" "play/decipher.el"
-;;;;;; (20164 60780))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from play/decipher.el
(autoload 'decipher "decipher" "\
@@ -5839,8 +5855,8 @@ The most useful commands are:
;;;***
;;;### (autoloads (delimit-columns-rectangle delimit-columns-region
-;;;;;; delimit-columns-customize) "delim-col" "delim-col.el" (20154
-;;;;;; 24929))
+;;;;;; delimit-columns-customize) "delim-col" "delim-col.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from delim-col.el
(autoload 'delimit-columns-customize "delim-col" "\
@@ -5864,8 +5880,8 @@ START and END delimits the corners of text rectangle.
;;;***
-;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (20153
-;;;;;; 32900))
+;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/delphi.el
(autoload 'delphi-mode "delphi" "\
@@ -5916,8 +5932,8 @@ with no args, if that value is non-nil.
;;;***
-;;;### (autoloads (delete-selection-mode) "delsel" "delsel.el" (20127
-;;;;;; 62865))
+;;;### (autoloads (delete-selection-mode) "delsel" "delsel.el" (20613
+;;;;;; 49078 764749 0))
;;; Generated autoloads from delsel.el
(defalias 'pending-delete-mode 'delete-selection-mode)
@@ -5947,7 +5963,7 @@ any selection.
;;;***
;;;### (autoloads (derived-mode-init-mode-variables define-derived-mode)
-;;;;;; "derived" "emacs-lisp/derived.el" (20137 12290))
+;;;;;; "derived" "emacs-lisp/derived.el" (20577 33959 40183 0))
;;; Generated autoloads from emacs-lisp/derived.el
(autoload 'define-derived-mode "derived" "\
@@ -5999,7 +6015,7 @@ The new mode runs the hook constructed by the function
See Info node `(elisp)Derived Modes' for more details.
-\(fn CHILD PARENT NAME &optional DOCSTRING &rest BODY)" nil (quote macro))
+\(fn CHILD PARENT NAME &optional DOCSTRING &rest BODY)" nil t)
(put 'define-derived-mode 'doc-string-elt '4)
@@ -6014,7 +6030,7 @@ the first time the mode is used.
;;;***
;;;### (autoloads (describe-char describe-text-properties) "descr-text"
-;;;;;; "descr-text.el" (20170 13157))
+;;;;;; "descr-text.el" (20530 32114 546307 0))
;;; Generated autoloads from descr-text.el
(autoload 'describe-text-properties "descr-text" "\
@@ -6028,12 +6044,21 @@ otherwise.
\(fn POS &optional OUTPUT-BUFFER BUFFER)" t nil)
(autoload 'describe-char "descr-text" "\
-Describe the character after POS (interactively, the character after point).
-Is POS is taken to be in buffer BUFFER or current buffer if nil.
-The information includes character code, charset and code points in it,
-syntax, category, how the character is encoded in a file,
-character composition information (if relevant),
-as well as widgets, buttons, overlays, and text properties.
+Describe position POS (interactively, point) and the char after POS.
+POS is taken to be in BUFFER, or the current buffer if BUFFER is nil.
+The information is displayed in buffer `*Help*'.
+
+The position information includes POS; the total size of BUFFER; the
+region limits, if narrowed; the column number; and the horizontal
+scroll amount, if the buffer is horizontally scrolled.
+
+The character information includes the character code; charset and
+code points in it; syntax; category; how the character is encoded in
+BUFFER and in BUFFER's file; character composition information (if
+relevant); the font and font glyphs used to display the character;
+the character's canonical name and other properties defined by the
+Unicode Data Base; and widgets, buttons, overlays, and text properties
+relevant to POS.
\(fn POS &optional BUFFER)" t nil)
@@ -6042,7 +6067,7 @@ as well as widgets, buttons, overlays, and text properties.
;;;### (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" (20165 31925))
+;;;;;; "desktop.el" (20577 33959 40183 0))
;;; Generated autoloads from desktop.el
(defvar desktop-save-mode nil "\
@@ -6207,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
@@ -6229,7 +6256,7 @@ Revert to the last loaded desktop.
;;;### (autoloads (gnus-article-outlook-deuglify-article gnus-outlook-deuglify-article
;;;;;; gnus-article-outlook-repair-attribution gnus-article-outlook-unwrap-lines)
-;;;;;; "deuglify" "gnus/deuglify.el" (19845 45374))
+;;;;;; "deuglify" "gnus/deuglify.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/deuglify.el
(autoload 'gnus-article-outlook-unwrap-lines "deuglify" "\
@@ -6262,14 +6289,14 @@ Deuglify broken Outlook (Express) articles and redisplay.
;;;***
;;;### (autoloads (diary-mode diary-mail-entries diary) "diary-lib"
-;;;;;; "calendar/diary-lib.el" (20168 57844))
+;;;;;; "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)
@@ -6280,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
@@ -6304,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" (19999 41597))
+;;;### (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") "\
@@ -6340,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'.
@@ -6349,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"
-;;;;;; (20181 13366))
+;;;;;; (20623 43301 870757 0))
;;; Generated autoloads from vc/diff-mode.el
(autoload 'diff-mode "diff-mode" "\
@@ -6381,7 +6414,7 @@ the mode if ARG is omitted or nil.
;;;***
-;;;### (autoloads (dig) "dig" "net/dig.el" (19845 45374))
+;;;### (autoloads (dig) "dig" "net/dig.el" (20355 10021 546955 0))
;;; Generated autoloads from net/dig.el
(autoload 'dig "dig" "\
@@ -6393,7 +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" (20167 36967))
+;;;;;; dired dired-listing-switches) "dired" "dired.el" (20619 46245
+;;;;;; 806932 0))
;;; Generated autoloads from dired.el
(defvar dired-listing-switches (purecopy "-al") "\
@@ -6491,7 +6525,6 @@ for more info):
`dired-listing-switches'
`dired-trivial-filenames'
- `dired-shrink-to-fit'
`dired-marker-char'
`dired-del-marker'
`dired-keep-marker-rename'
@@ -6515,7 +6548,7 @@ Keybindings:
;;;***
;;;### (autoloads (dirtrack dirtrack-mode) "dirtrack" "dirtrack.el"
-;;;;;; (20127 62865))
+;;;;;; (20399 35365 4050 0))
;;; Generated autoloads from dirtrack.el
(autoload 'dirtrack-mode "dirtrack" "\
@@ -6524,29 +6557,29 @@ With a prefix argument ARG, enable Dirtrack mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-This method requires that your shell prompt contain the full
-current working directory at all times, and that `dirtrack-list'
-is set to match the prompt. This is an alternative to
-`shell-dirtrack-mode', which works differently, by tracking `cd'
-and similar commands which change the shell working directory.
+This method requires that your shell prompt contain the current
+working directory at all times, and that you set the variable
+`dirtrack-list' to match the prompt.
+
+This is an alternative to `shell-dirtrack-mode', which works by
+tracking `cd' and similar commands which change the shell working
+directory.
\(fn &optional ARG)" t nil)
(autoload 'dirtrack "dirtrack" "\
-Determine the current directory by scanning the process output for a prompt.
-The prompt to look for is the first item in `dirtrack-list'.
-
-You can toggle directory tracking by using the function `dirtrack-mode'.
-
-If directory tracking does not seem to be working, you can use the
-function `dirtrack-debug-mode' to turn on debugging output.
+Determine the current directory from the process output for a prompt.
+This filter function is used by `dirtrack-mode'. It looks for
+the prompt specified by `dirtrack-list', and calls
+`shell-process-cd' if the directory seems to have changed away
+from `default-directory'.
\(fn INPUT)" nil nil)
;;;***
-;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (19931
-;;;;;; 11784))
+;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (20497
+;;;;;; 6436 957082 0))
;;; Generated autoloads from emacs-lisp/disass.el
(autoload 'disassemble "disass" "\
@@ -6565,7 +6598,7 @@ redefine OBJECT if it is a symbol.
;;;;;; standard-display-g1 standard-display-ascii standard-display-default
;;;;;; standard-display-8bit describe-current-display-table describe-display-table
;;;;;; set-display-table-slot display-table-slot make-display-table)
-;;;;;; "disp-table" "disp-table.el" (19984 16846))
+;;;;;; "disp-table" "disp-table.el" (20355 10021 546955 0))
;;; Generated autoloads from disp-table.el
(autoload 'make-display-table "disp-table" "\
@@ -6687,7 +6720,7 @@ in `.emacs'.
;;;***
;;;### (autoloads (dissociated-press) "dissociate" "play/dissociate.el"
-;;;;;; (19845 45374))
+;;;;;; (20545 57511 257469 0))
;;; Generated autoloads from play/dissociate.el
(autoload 'dissociated-press "dissociate" "\
@@ -6703,7 +6736,8 @@ Default is 2.
;;;***
-;;;### (autoloads (dnd-protocol-alist) "dnd" "dnd.el" (19886 45771))
+;;;### (autoloads (dnd-protocol-alist) "dnd" "dnd.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from dnd.el
(defvar dnd-protocol-alist `((,(purecopy "^file:///") . dnd-open-local-file) (,(purecopy "^file://") . dnd-open-file) (,(purecopy "^file:") . dnd-open-local-file) (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)) "\
@@ -6724,7 +6758,7 @@ if some action was made, or nil if the URL is ignored.")
;;;***
;;;### (autoloads (dns-mode-soa-increment-serial dns-mode) "dns-mode"
-;;;;;; "textmodes/dns-mode.el" (19845 45374))
+;;;;;; "textmodes/dns-mode.el" (20355 10021 546955 0))
;;; Generated autoloads from textmodes/dns-mode.el
(autoload 'dns-mode "dns-mode" "\
@@ -6748,8 +6782,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" (20172
-;;;;;; 54913))
+;;;;;; 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" "\
@@ -6795,7 +6829,8 @@ See the command `doc-view-mode' for more information on this mode.
;;;***
-;;;### (autoloads (doctor) "doctor" "play/doctor.el" (20077 56412))
+;;;### (autoloads (doctor) "doctor" "play/doctor.el" (20545 57511
+;;;;;; 257469 0))
;;; Generated autoloads from play/doctor.el
(autoload 'doctor "doctor" "\
@@ -6805,7 +6840,8 @@ Switch to *doctor* buffer and start giving psychotherapy.
;;;***
-;;;### (autoloads (double-mode) "double" "double.el" (20127 62865))
+;;;### (autoloads (double-mode) "double" "double.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from double.el
(autoload 'double-mode "double" "\
@@ -6821,7 +6857,8 @@ strings when pressed twice. See `double-map' for details.
;;;***
-;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (19845 45374))
+;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (20545 57511
+;;;;;; 257469 0))
;;; Generated autoloads from play/dunnet.el
(autoload 'dunnet "dunnet" "\
@@ -6833,18 +6870,32 @@ 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" (20179 28130))
+;;;;;; "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)
(autoload 'define-minor-mode "easy-mmode" "\
Define a new minor mode MODE.
-This defines the control variable MODE and the toggle command MODE.
+This defines the toggle command MODE and (by default) a control variable
+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.
+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 modeline when the mode is on.
+Optional LIGHTER is displayed in the mode line when the mode is on.
Optional KEYMAP is the default keymap bound to the mode keymap.
If non-nil, it should be a variable name (whose value is a keymap),
or an expression that returns either a keymap or a list of
@@ -6867,22 +6918,30 @@ BODY contains code to execute each time the mode is enabled or disabled.
buffer-local, so don't make the variable MODE buffer-local.
By default, the mode is buffer-local.
:init-value VAL Same as the INIT-VALUE argument.
+ Not used if you also specify :variable.
:lighter SPEC Same as the LIGHTER argument.
:keymap MAP Same as the KEYMAP argument.
:require SYM Same as in `defcustom'.
-:variable PLACE The location (as can be used with `setf') to use instead
- of the variable MODE to store the state of the mode. PLACE
- can also be of the form (GET . SET) where GET is an expression
- that returns the current state and SET is a function that takes
- a new state and sets it. If you specify a :variable, this
- function assumes it is defined elsewhere.
+:variable PLACE The location to use instead of the variable MODE to store
+ the state of the mode. This can be simply a different
+ named variable, or more generally anything that can be used
+ with the CL macro `setf'. PLACE can also be of the form
+ (GET . SET), where GET is an expression that returns the
+ current state, and SET is a function that takes one argument,
+ the new state, and sets it. If you specify a :variable,
+ this function does not define a MODE variable (nor any of
+ the terms used in :variable).
+:after-hook A single lisp form which is evaluated after the mode hooks
+ have been run. It should not be quoted.
For example, you could write
(define-minor-mode foo-mode \"If enabled, foo on you!\"
:lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
...BODY CODE...)
-\(fn MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)" nil (quote macro))
+\(fn MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)" nil t)
+
+(put 'define-minor-mode 'doc-string-elt '2)
(defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode)
@@ -6907,7 +6966,9 @@ correctly with the current major mode. This is important to
prevent problems with derived modes, that is, major modes that
call another major mode in their body.
-\(fn GLOBAL-MODE MODE TURN-ON &rest KEYS)" nil (quote macro))
+\(fn GLOBAL-MODE MODE TURN-ON &rest KEYS)" nil t)
+
+(put 'define-globalized-minor-mode 'doc-string-elt '2)
(autoload 'easy-mmode-define-keymap "easy-mmode" "\
Return a keymap built from bindings BS.
@@ -6933,128 +6994,119 @@ Define a constant M whose value is the result of `easy-mmode-define-keymap'.
The M, BS, and ARGS arguments are as per that function. DOC is
the constant's documentation.
-\(fn M BS DOC &rest ARGS)" nil (quote macro))
+\(fn M BS DOC &rest ARGS)" nil t)
(autoload 'easy-mmode-defsyntax "easy-mmode" "\
Define variable ST as a syntax-table.
CSS contains a list of syntax specifications of the form (CHAR . SYNTAX).
-\(fn ST CSS DOC &rest ARGS)" nil (quote macro))
+\(fn ST CSS DOC &rest ARGS)" nil t)
;;;***
;;;### (autoloads (easy-menu-change easy-menu-create-menu easy-menu-do-define
-;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (19845
-;;;;;; 45374))
+;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (20615
+;;;;;; 49194 141673 0))
;;; Generated autoloads from emacs-lisp/easymenu.el
(autoload 'easy-menu-define "easymenu" "\
-Define a menu bar submenu in maps MAPS, according to MENU.
-
-If SYMBOL is non-nil, store the menu keymap in the value of SYMBOL,
-and define SYMBOL as a function to pop up the menu, with DOC as its doc string.
-If SYMBOL is nil, just store the menu keymap into MAPS.
-
-The first element of MENU must be a string. It is the menu bar item name.
-It may be followed by the following keyword argument pairs
+Define a pop-up menu and/or menu bar menu specified by MENU.
+If SYMBOL is non-nil, define SYMBOL as a function to pop up the
+submenu defined by MENU, with DOC as its doc string.
- :filter FUNCTION
+MAPS, if non-nil, should be a keymap or a list of keymaps; add
+the submenu defined by MENU to the keymap or each of the keymaps,
+as a top-level menu bar item.
-FUNCTION is a function with one argument, the rest of menu items.
-It returns the remaining items of the displayed menu.
+The first element of MENU must be a string. It is the menu bar
+item name. It may be followed by the following keyword argument
+pairs:
- :visible INCLUDE
+ :filter FUNCTION
+ FUNCTION must be a function which, if called with one
+ argument---the list of the other menu items---returns the
+ items to actually display.
-INCLUDE is an expression; this menu is only visible if this
-expression has a non-nil value. `:included' is an alias for `:visible'.
+ :visible INCLUDE
+ INCLUDE is an expression. The menu is visible if the
+ expression evaluates to a non-nil value. `:included' is an
+ alias for `:visible'.
- :active ENABLE
+ :active ENABLE
+ ENABLE is an expression. The menu is enabled for selection
+ if the expression evaluates to a non-nil value. `:enable' is
+ an alias for `:active'.
-ENABLE is an expression; the menu is enabled for selection whenever
-this expression's value is non-nil. `:enable' is an alias for `:active'.
+The rest of the elements in MENU are menu items.
+A menu item can be a vector of three elements:
-The rest of the elements in MENU, are menu items.
-
-A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE]
+ [NAME CALLBACK ENABLE]
NAME is a string--the menu item name.
-CALLBACK is a command to run when the item is chosen,
-or a list to evaluate when the item is chosen.
+CALLBACK is a command to run when the item is chosen, or an
+expression to evaluate when the item is chosen.
-ENABLE is an expression; the item is enabled for selection
-whenever this expression's value is non-nil.
+ENABLE is an expression; the item is enabled for selection if the
+expression evaluates to a non-nil value.
Alternatively, a menu item may have the form:
- [ NAME CALLBACK [ KEYWORD ARG ] ... ]
-
-Where KEYWORD is one of the symbols defined below.
-
- :keys KEYS
-
-KEYS is a string; a complex keyboard equivalent to this menu item.
-This is normally not needed because keyboard equivalents are usually
-computed automatically.
-KEYS is expanded with `substitute-command-keys' before it is used.
-
- :key-sequence KEYS
-
-KEYS is nil, a string or a vector; nil or a keyboard equivalent to this
-menu item.
-This is a hint that will considerably speed up Emacs' first display of
-a menu. Use `:key-sequence nil' when you know that this menu item has no
-keyboard equivalent.
-
- :active ENABLE
-
-ENABLE is an expression; the item is enabled for selection whenever
-this expression's value is non-nil. `:enable' is an alias for `:active'.
+ [ NAME CALLBACK [ KEYWORD ARG ]... ]
- :visible INCLUDE
+where NAME and CALLBACK have the same meanings as above, and each
+optional KEYWORD and ARG pair should be one of the following:
-INCLUDE is an expression; this item is only visible if this
-expression has a non-nil value. `:included' is an alias for `:visible'.
+ :keys KEYS
+ KEYS is a string; a keyboard equivalent to the menu item.
+ This is normally not needed because keyboard equivalents are
+ usually computed automatically. KEYS is expanded with
+ `substitute-command-keys' before it is used.
- :label FORM
+ :key-sequence KEYS
+ KEYS is a hint for speeding up Emacs's first display of the
+ menu. It should be nil if you know that the menu item has no
+ keyboard equivalent; otherwise it should be a string or
+ vector specifying a keyboard equivalent for the menu item.
-FORM is an expression that will be dynamically evaluated and whose
-value will be used for the menu entry's text label (the default is NAME).
+ :active ENABLE
+ ENABLE is an expression; the item is enabled for selection
+ whenever this expression's value is non-nil. `:enable' is an
+ alias for `:active'.
- :suffix FORM
+ :visible INCLUDE
+ INCLUDE is an expression; this item is only visible if this
+ expression has a non-nil value. `:included' is an alias for
+ `:visible'.
-FORM is an expression that will be dynamically evaluated and whose
-value will be concatenated to the menu entry's label.
+ :label FORM
+ FORM is an expression that is dynamically evaluated and whose
+ value serves as the menu item's label (the default is NAME).
- :style STYLE
+ :suffix FORM
+ FORM is an expression that is dynamically evaluated and whose
+ value is concatenated with the menu entry's label.
-STYLE is a symbol describing the type of menu item. The following are
-defined:
+ :style STYLE
+ STYLE is a symbol describing the type of menu item; it should
+ be `toggle' (a checkbox), or `radio' (a radio button), or any
+ other value (meaning an ordinary menu item).
-toggle: A checkbox.
- Prepend the name with `(*) ' or `( ) ' depending on if selected or not.
-radio: A radio button.
- Prepend the name with `[X] ' or `[ ] ' depending on if selected or not.
-button: Surround the name with `[' and `]'. Use this for an item in the
- menu bar itself.
-anything else means an ordinary menu item.
+ :selected SELECTED
+ SELECTED is an expression; the checkbox or radio button is
+ selected whenever the expression's value is non-nil.
- :selected SELECTED
+ :help HELP
+ HELP is a string, the help to display for the menu item.
-SELECTED is an expression; the checkbox or radio button is selected
-whenever this expression's value is non-nil.
+Alternatively, a menu item can be a string. Then that string
+appears in the menu as unselectable text. A string consisting
+solely of dashes is displayed as a menu separator.
- :help HELP
+Alternatively, a menu item can be a list with the same format as
+MENU. This is a submenu.
-HELP is a string, the help to display for the menu item.
-
-A menu item can be a string. Then that string appears in the menu as
-unselectable text. A string consisting solely of hyphens is displayed
-as a solid horizontal line.
-
-A menu item can be a list with the same format as MENU. This is a submenu.
-
-\(fn SYMBOL MAPS DOC MENU)" nil (quote macro))
+\(fn SYMBOL MAPS DOC MENU)" nil t)
(put 'easy-menu-define 'lisp-indent-function 'defun)
@@ -7099,7 +7151,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" (20166 16092))
+;;;;;; "progmodes/ebnf2ps.el" (20566 63671 243798 0))
;;; Generated autoloads from progmodes/ebnf2ps.el
(autoload 'ebnf-customize "ebnf2ps" "\
@@ -7373,8 +7425,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" (20104
-;;;;;; 14925))
+;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (20561
+;;;;;; 18280 338092 0))
;;; Generated autoloads from progmodes/ebrowse.el
(autoload 'ebrowse-tree-mode "ebrowse" "\
@@ -7523,32 +7575,40 @@ Display statistics for a class tree.
;;;***
;;;### (autoloads (electric-buffer-list) "ebuff-menu" "ebuff-menu.el"
-;;;;;; (20104 14925))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from ebuff-menu.el
(autoload 'electric-buffer-list "ebuff-menu" "\
-Pop up a buffer describing the set of Emacs buffers.
-Vaguely like ITS lunar select buffer; combining typeoutoid buffer
-listing with menuoid buffer selection.
-
-If the very next character typed is a space then the buffer list
-window disappears. Otherwise, one may move around in the buffer list
-window, marking buffers to be selected, saved or deleted.
-
-To exit and select a new buffer, type a space when the cursor is on
-the appropriate line of the buffer-list window. Other commands are
-much like those of `Buffer-menu-mode'.
+Pop up the Buffer Menu in an \"electric\" window.
+If you type SPC or RET (`Electric-buffer-menu-select'), that
+selects the buffer at point and quits the \"electric\" window.
+Otherwise, you can move around in the Buffer Menu, marking
+buffers to be selected, saved or deleted; these other commands
+are much like those of `Buffer-menu-mode'.
Run hooks in `electric-buffer-menu-mode-hook' on entry.
-\\{electric-buffer-menu-mode-map}
+\\<electric-buffer-menu-mode-map>
+\\[keyboard-quit] or \\[Electric-buffer-menu-quit] -- exit buffer menu, returning to previous window and buffer
+ configuration. If the very first character typed is a space, it
+ also has this effect.
+\\[Electric-buffer-menu-select] -- select buffer of line point is on.
+ Also show buffers marked with m in other windows,
+ deletes buffers marked with \"D\", and saves those marked with \"S\".
+\\[Buffer-menu-mark] -- mark buffer to be displayed.
+\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
+\\[Buffer-menu-save] -- mark that buffer to be saved.
+\\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted.
+\\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
+\\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done.
+\\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
\(fn ARG)" t nil)
;;;***
;;;### (autoloads (Electric-command-history-redo-expression) "echistory"
-;;;;;; "echistory.el" (19886 45771))
+;;;;;; "echistory.el" (20355 10021 546955 0))
;;; Generated autoloads from echistory.el
(autoload 'Electric-command-history-redo-expression "echistory" "\
@@ -7560,7 +7620,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing.
;;;***
;;;### (autoloads (ecomplete-setup) "ecomplete" "gnus/ecomplete.el"
-;;;;;; (20110 24804))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/ecomplete.el
(autoload 'ecomplete-setup "ecomplete" "\
@@ -7570,7 +7630,8 @@ With prefix arg NOCONFIRM, execute current line as-is without editing.
;;;***
-;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (20168 57844))
+;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (20590 45996
+;;;;;; 129575 0))
;;; Generated autoloads from cedet/ede.el
(defvar global-ede-mode nil "\
@@ -7597,7 +7658,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" (20166 16092))
+;;;;;; "emacs-lisp/edebug.el" (20594 43050 277913 0))
;;; Generated autoloads from emacs-lisp/edebug.el
(defvar edebug-all-defs nil "\
@@ -7670,7 +7731,8 @@ Toggle edebugging of all forms.
;;;;;; ediff-merge-directories-with-ancestor ediff-merge-directories
;;;;;; ediff-directories3 ediff-directory-revisions ediff-directories
;;;;;; ediff-buffers3 ediff-buffers ediff-backup ediff-current-file
-;;;;;; ediff-files3 ediff-files) "ediff" "vc/ediff.el" (19996 8027))
+;;;;;; ediff-files3 ediff-files) "ediff" "vc/ediff.el" (20495 51111
+;;;;;; 757560 0))
;;; Generated autoloads from vc/ediff.el
(autoload 'ediff-files "ediff" "\
@@ -7902,7 +7964,7 @@ With optional NODE, goes to that node.
;;;***
;;;### (autoloads (ediff-customize) "ediff-help" "vc/ediff-help.el"
-;;;;;; (20178 7273))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from vc/ediff-help.el
(autoload 'ediff-customize "ediff-help" "\
@@ -7913,7 +7975,7 @@ With optional NODE, goes to that node.
;;;***
;;;### (autoloads (ediff-show-registry) "ediff-mult" "vc/ediff-mult.el"
-;;;;;; (20168 57844))
+;;;;;; (20614 54428 654267 0))
;;; Generated autoloads from vc/ediff-mult.el
(autoload 'ediff-show-registry "ediff-mult" "\
@@ -7926,7 +7988,7 @@ Display Ediff's registry.
;;;***
;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe)
-;;;;;; "ediff-util" "vc/ediff-util.el" (20175 31160))
+;;;;;; "ediff-util" "vc/ediff-util.el" (20584 7212 455152 0))
;;; Generated autoloads from vc/ediff-util.el
(autoload 'ediff-toggle-multiframe "ediff-util" "\
@@ -7947,7 +8009,7 @@ To change the default, set the variable `ediff-use-toolbar-p', which see.
;;;### (autoloads (format-kbd-macro read-kbd-macro edit-named-kbd-macro
;;;;;; edit-last-kbd-macro edit-kbd-macro) "edmacro" "edmacro.el"
-;;;;;; (19886 45771))
+;;;;;; (20476 31768 298871 0))
;;; Generated autoloads from edmacro.el
(autoload 'edit-kbd-macro "edmacro" "\
@@ -7996,7 +8058,7 @@ or nil, use a compact 80-column format.
;;;***
;;;### (autoloads (edt-emulation-on edt-set-scroll-margins) "edt"
-;;;;;; "emulation/edt.el" (20154 24929))
+;;;;;; "emulation/edt.el" (20566 63671 243798 0))
;;; Generated autoloads from emulation/edt.el
(autoload 'edt-set-scroll-margins "edt" "\
@@ -8014,7 +8076,7 @@ Turn on EDT Emulation.
;;;***
;;;### (autoloads (electric-helpify with-electric-help) "ehelp" "ehelp.el"
-;;;;;; (19865 50420))
+;;;;;; (20593 22184 581574 0))
;;; Generated autoloads from ehelp.el
(autoload 'with-electric-help "ehelp" "\
@@ -8050,8 +8112,55 @@ BUFFER is put back into its original major mode.
;;;***
+;;;### (autoloads (customize-object) "eieio-custom" "emacs-lisp/eieio-custom.el"
+;;;;;; (20586 48936 135199 0))
+;;; Generated autoloads from emacs-lisp/eieio-custom.el
+
+(autoload 'customize-object "eieio-custom" "\
+Customize OBJ in a custom buffer.
+Optional argument GROUP is the sub-group of slots to display.
+
+\(fn OBJ &optional GROUP)" nil nil)
+
+;;;***
+
+;;;### (autoloads (eieio-describe-generic eieio-describe-constructor
+;;;;;; eieio-describe-class eieio-browse) "eieio-opt" "emacs-lisp/eieio-opt.el"
+;;;;;; (20617 41641 89638 0))
+;;; Generated autoloads from emacs-lisp/eieio-opt.el
+
+(autoload 'eieio-browse "eieio-opt" "\
+Create an object browser window to show all objects.
+If optional ROOT-CLASS, then start with that, otherwise start with
+variable `eieio-default-superclass'.
+
+\(fn &optional ROOT-CLASS)" t nil)
+(defalias 'describe-class 'eieio-describe-class)
+
+(autoload 'eieio-describe-class "eieio-opt" "\
+Describe a CLASS defined by a string or symbol.
+If CLASS is actually an object, then also display current values of that object.
+Optional HEADERFCN should be called to insert a few bits of info first.
+
+\(fn CLASS &optional HEADERFCN)" t nil)
+
+(autoload 'eieio-describe-constructor "eieio-opt" "\
+Describe the constructor function FCN.
+Uses `eieio-describe-class' to describe the class being constructed.
+
+\(fn FCN)" t nil)
+(defalias 'describe-generic 'eieio-describe-generic)
+
+(autoload 'eieio-describe-generic "eieio-opt" "\
+Describe the generic function GENERIC.
+Also extracts information about all methods specific to this generic.
+
+\(fn GENERIC)" t nil)
+
+;;;***
+
;;;### (autoloads (turn-on-eldoc-mode eldoc-mode eldoc-minor-mode-string)
-;;;;;; "eldoc" "emacs-lisp/eldoc.el" (20161 45793))
+;;;;;; "eldoc" "emacs-lisp/eldoc.el" (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/eldoc.el
(defvar eldoc-minor-mode-string (purecopy " ElDoc") "\
@@ -8098,15 +8207,11 @@ Emacs Lisp mode) that support ElDoc.")
;;;***
;;;### (autoloads (electric-layout-mode electric-pair-mode electric-indent-mode)
-;;;;;; "electric" "electric.el" (20168 57844))
+;;;;;; "electric" "electric.el" (20613 49078 764749 0))
;;; Generated autoloads from electric.el
(defvar electric-indent-chars '(10) "\
-Characters that should cause automatic reindentation.
-Each entry of the list can be either a character or a cons of the
-form (CHAR . PREDICATE) which means that CHAR should cause reindentation
-only if PREDICATE returns non-nil. PREDICATE is called with no arguments
-and with point before the inserted char.")
+Characters that should cause automatic reindentation.")
(defvar electric-indent-mode nil "\
Non-nil if Electric-Indent mode is enabled.
@@ -8123,9 +8228,9 @@ With a prefix argument ARG, enable Electric Indent mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-Electric Indent mode is a global minor mode. When enabled,
-reindentation is triggered whenever you insert a character listed
-in `electric-indent-chars'.
+This is a global minor mode. When enabled, it reindents whenever
+the hook `electric-indent-functions' returns non-nil, or you
+insert a character from `electric-indent-chars'.
\(fn &optional ARG)" t nil)
@@ -8148,6 +8253,8 @@ Electric Pair mode is a global minor mode. When enabled, typing
an open parenthesis automatically inserts the corresponding
closing parenthesis. (Likewise for brackets, etc.)
+See options `electric-pair-pairs' and `electric-pair-skip-self'.
+
\(fn &optional ARG)" t nil)
(defvar electric-layout-mode nil "\
@@ -8161,13 +8268,17 @@ or call the function `electric-layout-mode'.")
(autoload 'electric-layout-mode "electric" "\
Automatically insert newlines around some chars.
+With a prefix argument ARG, enable Electric Layout mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+The variable `electric-layout-rules' says when and how to insert newlines.
\(fn &optional ARG)" t nil)
;;;***
-;;;### (autoloads (elide-head) "elide-head" "elide-head.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (elide-head) "elide-head" "elide-head.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from elide-head.el
(autoload 'elide-head "elide-head" "\
@@ -8184,7 +8295,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks.
;;;### (autoloads (elint-initialize elint-defun elint-current-buffer
;;;;;; elint-directory elint-file) "elint" "emacs-lisp/elint.el"
-;;;;;; (20172 54913))
+;;;;;; (20486 36135 22104 0))
;;; Generated autoloads from emacs-lisp/elint.el
(autoload 'elint-file "elint" "\
@@ -8220,8 +8331,8 @@ optional prefix argument REINIT is non-nil.
;;;***
;;;### (autoloads (elp-results elp-instrument-package elp-instrument-list
-;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (19981
-;;;;;; 40664))
+;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (20497
+;;;;;; 6436 957082 0))
;;; Generated autoloads from emacs-lisp/elp.el
(autoload 'elp-instrument-function "elp" "\
@@ -8256,7 +8367,7 @@ displayed.
;;;***
;;;### (autoloads (emacs-lock-mode) "emacs-lock" "emacs-lock.el"
-;;;;;; (20127 62865))
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from emacs-lock.el
(autoload 'emacs-lock-mode "emacs-lock" "\
@@ -8284,7 +8395,7 @@ Other values are interpreted as usual.
;;;***
;;;### (autoloads (report-emacs-bug-query-existing-bugs report-emacs-bug)
-;;;;;; "emacsbug" "mail/emacsbug.el" (20093 44623))
+;;;;;; "emacsbug" "mail/emacsbug.el" (20576 13095 881042 0))
;;; Generated autoloads from mail/emacsbug.el
(autoload 'report-emacs-bug "emacsbug" "\
@@ -8305,7 +8416,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" (20141 9296))
+;;;;;; "vc/emerge.el" (20576 42138 697312 0))
;;; Generated autoloads from vc/emerge.el
(autoload 'emerge-files "emerge" "\
@@ -8366,13 +8477,18 @@ Emerge two RCS revisions of a file, with another revision as ancestor.
;;;***
;;;### (autoloads (enriched-decode enriched-encode enriched-mode)
-;;;;;; "enriched" "textmodes/enriched.el" (19845 45374))
+;;;;;; "enriched" "textmodes/enriched.el" (20461 32935 300400 0))
;;; Generated autoloads from textmodes/enriched.el
(autoload 'enriched-mode "enriched" "\
Minor mode for editing text/enriched files.
These are files with embedded formatting information in the MIME standard
text/enriched format.
+
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
+
Turning the mode on or off runs `enriched-mode-hook'.
More information about Enriched mode is available in the file
@@ -8401,8 +8517,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" (20104
-;;;;;; 14925))
+;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (20577
+;;;;;; 33959 40183 0))
;;; Generated autoloads from epa.el
(autoload 'epa-list-keys "epa" "\
@@ -8580,7 +8696,8 @@ Insert selected KEYS after the point.
;;;***
;;;### (autoloads (epa-dired-do-encrypt epa-dired-do-sign epa-dired-do-verify
-;;;;;; epa-dired-do-decrypt) "epa-dired" "epa-dired.el" (19865 50420))
+;;;;;; epa-dired-do-decrypt) "epa-dired" "epa-dired.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from epa-dired.el
(autoload 'epa-dired-do-decrypt "epa-dired" "\
@@ -8606,7 +8723,7 @@ Encrypt marked files.
;;;***
;;;### (autoloads (epa-file-disable epa-file-enable epa-file-handler)
-;;;;;; "epa-file" "epa-file.el" (20038 20303))
+;;;;;; "epa-file" "epa-file.el" (20355 10021 546955 0))
;;; Generated autoloads from epa-file.el
(autoload 'epa-file-handler "epa-file" "\
@@ -8628,11 +8745,14 @@ 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" (20043 38232))
+;;;;;; "epa-mail" "epa-mail.el" (20566 63671 243798 0))
;;; Generated autoloads from epa-mail.el
(autoload 'epa-mail-mode "epa-mail" "\
A minor-mode for composing encrypted/clearsigned mails.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
\(fn &optional ARG)" t nil)
@@ -8687,12 +8807,16 @@ or call the function `epa-global-mail-mode'.")
(autoload 'epa-global-mail-mode "epa-mail" "\
Minor mode to hook EasyPG into Mail mode.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
\(fn &optional ARG)" t nil)
;;;***
-;;;### (autoloads (epg-make-context) "epg" "epg.el" (20172 54913))
+;;;### (autoloads (epg-make-context) "epg" "epg.el" (20577 33959
+;;;;;; 40183 0))
;;; Generated autoloads from epg.el
(autoload 'epg-make-context "epg" "\
@@ -8703,7 +8827,7 @@ Return a context object.
;;;***
;;;### (autoloads (epg-expand-group epg-check-configuration epg-configuration)
-;;;;;; "epg-config" "epg-config.el" (19845 45374))
+;;;;;; "epg-config" "epg-config.el" (20373 11301 906925 0))
;;; Generated autoloads from epg-config.el
(autoload 'epg-configuration "epg-config" "\
@@ -8723,8 +8847,8 @@ Look at CONFIG and try to expand GROUP.
;;;***
-;;;### (autoloads (erc-handle-irc-url erc erc-select-read-args) "erc"
-;;;;;; "erc/erc.el" (20172 54913))
+;;;### (autoloads (erc-handle-irc-url erc-tls erc erc-select-read-args)
+;;;;;; "erc" "erc/erc.el" (20604 29767 397763 0))
;;; Generated autoloads from erc/erc.el
(autoload 'erc-select-read-args "erc" "\
@@ -8757,6 +8881,12 @@ be invoked for the values of the other parameters.
(defalias 'erc-select 'erc)
+(autoload 'erc-tls "erc" "\
+Interactively select TLS connection parameters and run ERC.
+Arguments are the same as for `erc'.
+
+\(fn &rest R)" t nil)
+
(autoload 'erc-handle-irc-url "erc" "\
Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD.
If ERC is already connected to HOST:PORT, simply /join CHANNEL.
@@ -8766,33 +8896,36 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;***
-;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (20161
-;;;;;; 45793))
+;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (20591
+;;;;;; 33616 626144 310000))
;;; Generated autoloads from erc/erc-autoaway.el
(autoload 'erc-autoaway-mode "erc-autoaway")
;;;***
-;;;### (autoloads nil "erc-button" "erc/erc-button.el" (20093 44623))
+;;;### (autoloads nil "erc-button" "erc/erc-button.el" (20593 22184
+;;;;;; 581574 0))
;;; Generated autoloads from erc/erc-button.el
(autoload 'erc-button-mode "erc-button" nil t)
;;;***
-;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (19845 45374))
+;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (20591 33616
+;;;;;; 706147 283000))
;;; Generated autoloads from erc/erc-capab.el
(autoload 'erc-capab-identify-mode "erc-capab" nil t)
;;;***
-;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (19845 45374))
+;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (20591 33616
+;;;;;; 736174 412000))
;;; Generated autoloads from erc/erc-compat.el
(autoload 'erc-define-minor-mode "erc-compat")
;;;***
;;;### (autoloads (erc-ctcp-query-DCC pcomplete/erc-mode/DCC erc-cmd-DCC)
-;;;;;; "erc-dcc" "erc/erc-dcc.el" (20179 28130))
+;;;;;; "erc-dcc" "erc/erc-dcc.el" (20591 33616 756180 926000))
;;; Generated autoloads from erc/erc-dcc.el
(autoload 'erc-dcc-mode "erc-dcc")
@@ -8810,7 +8943,7 @@ Provides completion for the /DCC command.
\(fn)" nil nil)
(defvar erc-ctcp-query-DCC-hook '(erc-ctcp-query-DCC) "\
-Hook variable for CTCP DCC queries")
+Hook variable for CTCP DCC queries.")
(autoload 'erc-ctcp-query-DCC "erc-dcc" "\
The function called when a CTCP DCC request is detected by the client.
@@ -8821,11 +8954,18 @@ that subcommand.
;;;***
+;;;### (autoloads nil "erc-desktop-notifications" "erc/erc-desktop-notifications.el"
+;;;;;; (20593 22184 581574 0))
+;;; Generated autoloads from erc/erc-desktop-notifications.el
+(autoload 'erc-notifications-mode "erc-desktop-notifications" "" t)
+
+;;;***
+
;;;### (autoloads (erc-ezb-initialize erc-ezb-select-session erc-ezb-select
;;;;;; erc-ezb-add-session erc-ezb-end-of-session-list erc-ezb-init-session-list
;;;;;; erc-ezb-identify erc-ezb-notice-autodetect erc-ezb-lookup-action
;;;;;; erc-ezb-get-login erc-cmd-ezb) "erc-ezbounce" "erc/erc-ezbounce.el"
-;;;;;; (19845 45374))
+;;;;;; (20591 33616 766161 665000))
;;; Generated autoloads from erc/erc-ezbounce.el
(autoload 'erc-cmd-ezb "erc-ezbounce" "\
@@ -8887,8 +9027,8 @@ Add EZBouncer convenience functions to ERC.
;;;***
-;;;### (autoloads (erc-fill) "erc-fill" "erc/erc-fill.el" (20127
-;;;;;; 62865))
+;;;### (autoloads (erc-fill) "erc-fill" "erc/erc-fill.el" (20591
+;;;;;; 33616 776163 920000))
;;; Generated autoloads from erc/erc-fill.el
(autoload 'erc-fill-mode "erc-fill" nil t)
@@ -8901,7 +9041,7 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'.
;;;***
;;;### (autoloads (erc-identd-stop erc-identd-start) "erc-identd"
-;;;;;; "erc/erc-identd.el" (19845 45374))
+;;;;;; "erc/erc-identd.el" (20591 33616 794740 81000))
;;; Generated autoloads from erc/erc-identd.el
(autoload 'erc-identd-mode "erc-identd")
@@ -8923,7 +9063,7 @@ system.
;;;***
;;;### (autoloads (erc-create-imenu-index) "erc-imenu" "erc/erc-imenu.el"
-;;;;;; (19845 45374))
+;;;;;; (20591 33616 794740 81000))
;;; Generated autoloads from erc/erc-imenu.el
(autoload 'erc-create-imenu-index "erc-imenu" "\
@@ -8933,20 +9073,22 @@ system.
;;;***
-;;;### (autoloads nil "erc-join" "erc/erc-join.el" (19845 45374))
+;;;### (autoloads nil "erc-join" "erc/erc-join.el" (20591 33616 804732
+;;;;;; 878000))
;;; Generated autoloads from erc/erc-join.el
(autoload 'erc-autojoin-mode "erc-join" nil t)
;;;***
-;;;### (autoloads nil "erc-list" "erc/erc-list.el" (19845 45374))
+;;;### (autoloads nil "erc-list" "erc/erc-list.el" (20591 33616 824757
+;;;;;; 867000))
;;; Generated autoloads from erc/erc-list.el
(autoload 'erc-list-mode "erc-list")
;;;***
;;;### (autoloads (erc-save-buffer-in-logs erc-logging-enabled) "erc-log"
-;;;;;; "erc/erc-log.el" (20168 57844))
+;;;;;; "erc/erc-log.el" (20593 22184 581574 0))
;;; Generated autoloads from erc/erc-log.el
(autoload 'erc-log-mode "erc-log" nil t)
@@ -8978,7 +9120,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"
-;;;;;; (20168 57844))
+;;;;;; (20591 33616 834740 676000))
;;; Generated autoloads from erc/erc-match.el
(autoload 'erc-match-mode "erc-match")
@@ -9024,14 +9166,15 @@ Delete dangerous-host interactively to `erc-dangerous-hosts'.
;;;***
-;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (19845 45374))
+;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (20591 33616 844710
+;;;;;; 904000))
;;; Generated autoloads from erc/erc-menu.el
(autoload 'erc-menu-mode "erc-menu" nil t)
;;;***
;;;### (autoloads (erc-cmd-WHOLEFT) "erc-netsplit" "erc/erc-netsplit.el"
-;;;;;; (19845 45374))
+;;;;;; (20591 33616 854733 799000))
;;; Generated autoloads from erc/erc-netsplit.el
(autoload 'erc-netsplit-mode "erc-netsplit")
@@ -9043,7 +9186,7 @@ Show who's gone.
;;;***
;;;### (autoloads (erc-server-select erc-determine-network) "erc-networks"
-;;;;;; "erc/erc-networks.el" (19845 45374))
+;;;;;; "erc/erc-networks.el" (20591 33616 854733 799000))
;;; Generated autoloads from erc/erc-networks.el
(autoload 'erc-determine-network "erc-networks" "\
@@ -9061,7 +9204,7 @@ Interactively select a server to connect to using `erc-server-alist'.
;;;***
;;;### (autoloads (pcomplete/erc-mode/NOTIFY erc-cmd-NOTIFY) "erc-notify"
-;;;;;; "erc/erc-notify.el" (20161 45793))
+;;;;;; "erc/erc-notify.el" (20591 33616 864734 46000))
;;; Generated autoloads from erc/erc-notify.el
(autoload 'erc-notify-mode "erc-notify" nil t)
@@ -9079,33 +9222,37 @@ with args, toggle notify status of people.
;;;***
-;;;### (autoloads nil "erc-page" "erc/erc-page.el" (19845 45374))
+;;;### (autoloads nil "erc-page" "erc/erc-page.el" (20591 33616 864734
+;;;;;; 46000))
;;; Generated autoloads from erc/erc-page.el
(autoload 'erc-page-mode "erc-page")
;;;***
-;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (19936
-;;;;;; 52203))
+;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (20591
+;;;;;; 33616 874723 983000))
;;; Generated autoloads from erc/erc-pcomplete.el
(autoload 'erc-completion-mode "erc-pcomplete" nil t)
;;;***
-;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (19845 45374))
+;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (20591 33616
+;;;;;; 874723 983000))
;;; Generated autoloads from erc/erc-replace.el
(autoload 'erc-replace-mode "erc-replace")
;;;***
-;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (19845 45374))
+;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (20591 33616 884730
+;;;;;; 605000))
;;; Generated autoloads from erc/erc-ring.el
(autoload 'erc-ring-mode "erc-ring" nil t)
;;;***
;;;### (autoloads (erc-nickserv-identify erc-nickserv-identify-mode)
-;;;;;; "erc-services" "erc/erc-services.el" (19845 45374))
+;;;;;; "erc-services" "erc/erc-services.el" (20591 33616 894723
+;;;;;; 303000))
;;; Generated autoloads from erc/erc-services.el
(autoload 'erc-services-mode "erc-services" nil t)
@@ -9122,14 +9269,15 @@ When called interactively, read the password using `read-passwd'.
;;;***
-;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (19845 45374))
+;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (20591 33616
+;;;;;; 894723 303000))
;;; Generated autoloads from erc/erc-sound.el
(autoload 'erc-sound-mode "erc-sound")
;;;***
;;;### (autoloads (erc-speedbar-browser) "erc-speedbar" "erc/erc-speedbar.el"
-;;;;;; (19845 45374))
+;;;;;; (20591 33616 894723 303000))
;;; Generated autoloads from erc/erc-speedbar.el
(autoload 'erc-speedbar-browser "erc-speedbar" "\
@@ -9140,21 +9288,22 @@ This will add a speedbar major display mode.
;;;***
-;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (19845
-;;;;;; 45374))
+;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (20591
+;;;;;; 33616 904733 437000))
;;; Generated autoloads from erc/erc-spelling.el
(autoload 'erc-spelling-mode "erc-spelling" nil t)
;;;***
-;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (19845 45374))
+;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (20593 22184
+;;;;;; 581574 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"
-;;;;;; (20168 57844))
+;;;;;; (20591 33616 924730 373000))
;;; Generated autoloads from erc/erc-track.el
(defvar erc-track-minor-mode nil "\
@@ -9180,7 +9329,8 @@ keybindings will not do anything useful.
;;;***
;;;### (autoloads (erc-truncate-buffer erc-truncate-buffer-to-size)
-;;;;;; "erc-truncate" "erc/erc-truncate.el" (19845 45374))
+;;;;;; "erc-truncate" "erc/erc-truncate.el" (20591 33616 934716
+;;;;;; 526000))
;;; Generated autoloads from erc/erc-truncate.el
(autoload 'erc-truncate-mode "erc-truncate" nil t)
@@ -9200,7 +9350,7 @@ Meant to be used in hooks, like `erc-insert-post-hook'.
;;;***
;;;### (autoloads (erc-xdcc-add-file) "erc-xdcc" "erc/erc-xdcc.el"
-;;;;;; (19845 45374))
+;;;;;; (20591 33616 934716 526000))
;;; Generated autoloads from erc/erc-xdcc.el
(autoload 'erc-xdcc-mode "erc-xdcc")
@@ -9213,7 +9363,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" (20168 57844))
+;;;;;; "ert" "emacs-lisp/ert.el" (20576 42138 697312 0))
;;; Generated autoloads from emacs-lisp/ert.el
(autoload 'ert-deftest "ert" "\
@@ -9233,10 +9383,6 @@ description of valid values for RESULT-TYPE.
\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags '(TAG...)] BODY...)" nil (quote macro))
-(put 'ert-deftest 'lisp-indent-function '2)
-
-(put 'ert-deftest 'doc-string-elt '3)
-
(put 'ert-deftest 'lisp-indent-function 2)
(put 'ert-info 'lisp-indent-function 1)
@@ -9283,7 +9429,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"
-;;;;;; (19845 45374))
+;;;;;; (20576 42138 697312 0))
;;; Generated autoloads from emacs-lisp/ert-x.el
(put 'ert-with-test-buffer 'lisp-indent-function 1)
@@ -9295,8 +9441,8 @@ Kill all test buffers that are still live.
;;;***
-;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (20164
-;;;;;; 60780))
+;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (20593
+;;;;;; 22184 581574 0))
;;; Generated autoloads from eshell/esh-mode.el
(autoload 'eshell-mode "esh-mode" "\
@@ -9309,7 +9455,7 @@ Emacs shell interactive mode.
;;;***
;;;### (autoloads (eshell-command-result eshell-command eshell) "eshell"
-;;;;;; "eshell/eshell.el" (20116 6099))
+;;;;;; "eshell/eshell.el" (20577 33959 40183 0))
;;; Generated autoloads from eshell/eshell.el
(autoload 'eshell "eshell" "\
@@ -9350,11 +9496,11 @@ corresponding to a successful execution.
;;;;;; visit-tags-table tags-table-mode find-tag-default-function
;;;;;; find-tag-hook tags-add-tables tags-compression-info-list
;;;;;; tags-table-list tags-case-fold-search) "etags" "progmodes/etags.el"
-;;;;;; (20168 57844))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from progmodes/etags.el
(defvar tags-file-name nil "\
-*File name of tags table.
+File name of tags table.
To switch to a new tags table, setting this variable is sufficient.
If you set this variable, do not also set `tags-table-list'.
Use the `etags' program to make a tags table file.")
@@ -9362,14 +9508,14 @@ Use the `etags' program to make a tags table file.")
(put 'tags-file-name 'safe-local-variable 'stringp)
(defvar tags-case-fold-search 'default "\
-*Whether tags operations should be case-sensitive.
+Whether tags operations should be case-sensitive.
A value of t means case-insensitive, a value of nil means case-sensitive.
Any other value means use the setting of `case-fold-search'.")
(custom-autoload 'tags-case-fold-search "etags" t)
(defvar tags-table-list nil "\
-*List of file names of tags tables to search.
+List of file names of tags tables to search.
An element that is a directory means the file \"TAGS\" in that directory.
To switch to a new list of tags tables, setting this variable is sufficient.
If you set this variable, do not also set `tags-file-name'.
@@ -9378,7 +9524,7 @@ Use the `etags' program to make a tags table file.")
(custom-autoload 'tags-table-list "etags" t)
(defvar tags-compression-info-list (purecopy '("" ".Z" ".bz2" ".gz" ".xz" ".tgz")) "\
-*List of extensions tried by etags when jka-compr is used.
+List of extensions tried by etags when jka-compr is used.
An empty string means search the non-compressed file.
These extensions will be tried only if jka-compr was activated
\(i.e. via customize of `auto-compression-mode' or by calling the function
@@ -9387,7 +9533,7 @@ These extensions will be tried only if jka-compr was activated
(custom-autoload 'tags-compression-info-list "etags" t)
(defvar tags-add-tables 'ask-user "\
-*Control whether to add a new tags table to the current list.
+Control whether to add a new tags table to the current list.
t means do; nil means don't (always start a new list).
Any other value means ask the user whether to add a new tags table
to the current list (as opposed to starting a new list).")
@@ -9395,14 +9541,14 @@ to the current list (as opposed to starting a new list).")
(custom-autoload 'tags-add-tables "etags" t)
(defvar find-tag-hook nil "\
-*Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
+Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
The value in the buffer in which \\[find-tag] is done is used,
not the value in the buffer \\[find-tag] goes to.")
(custom-autoload 'find-tag-hook "etags" t)
(defvar find-tag-default-function nil "\
-*A function of no arguments used by \\[find-tag] to pick a default tag.
+A function of no arguments used by \\[find-tag] to pick a default tag.
If nil, and the symbol that is the value of `major-mode'
has a `find-tag-default-function' property (see `put'), that is used.
Otherwise, `find-tag-default' is used.")
@@ -9668,7 +9814,7 @@ for \\[find-tag] (which see).
;;;;;; ethio-fidel-to-sera-marker ethio-fidel-to-sera-region ethio-fidel-to-sera-buffer
;;;;;; ethio-sera-to-fidel-marker ethio-sera-to-fidel-region ethio-sera-to-fidel-buffer
;;;;;; setup-ethiopic-environment-internal) "ethio-util" "language/ethio-util.el"
-;;;;;; (20175 31160))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from language/ethio-util.el
(autoload 'setup-ethiopic-environment-internal "ethio-util" "\
@@ -9814,7 +9960,7 @@ Convert the Java escape sequences into corresponding Ethiopic characters.
\(fn)" nil nil)
(autoload 'ethio-find-file "ethio-util" "\
-Transliterate file content into Ethiopic dependig on filename suffix.
+Transliterate file content into Ethiopic depending on filename suffix.
\(fn)" nil nil)
@@ -9838,7 +9984,7 @@ With ARG, insert that many delimiters.
;;;### (autoloads (eudc-load-eudc eudc-query-form eudc-expand-inline
;;;;;; eudc-get-phone eudc-get-email eudc-set-server) "eudc" "net/eudc.el"
-;;;;;; (19931 11784))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from net/eudc.el
(autoload 'eudc-set-server "eudc" "\
@@ -9894,7 +10040,7 @@ This does nothing except loading eudc by autoload side-effect.
;;;### (autoloads (eudc-display-jpeg-as-button eudc-display-jpeg-inline
;;;;;; eudc-display-sound eudc-display-mail eudc-display-url eudc-display-generic-binary)
-;;;;;; "eudc-bob" "net/eudc-bob.el" (19845 45374))
+;;;;;; "eudc-bob" "net/eudc-bob.el" (20355 10021 546955 0))
;;; Generated autoloads from net/eudc-bob.el
(autoload 'eudc-display-generic-binary "eudc-bob" "\
@@ -9930,7 +10076,7 @@ Display a button for the JPEG DATA.
;;;***
;;;### (autoloads (eudc-try-bbdb-insert eudc-insert-record-at-point-into-bbdb)
-;;;;;; "eudc-export" "net/eudc-export.el" (20175 31160))
+;;;;;; "eudc-export" "net/eudc-export.el" (20355 10021 546955 0))
;;; Generated autoloads from net/eudc-export.el
(autoload 'eudc-insert-record-at-point-into-bbdb "eudc-export" "\
@@ -9947,7 +10093,7 @@ Call `eudc-insert-record-at-point-into-bbdb' if on a record.
;;;***
;;;### (autoloads (eudc-edit-hotlist) "eudc-hotlist" "net/eudc-hotlist.el"
-;;;;;; (20162 19074))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from net/eudc-hotlist.el
(autoload 'eudc-edit-hotlist "eudc-hotlist" "\
@@ -9957,8 +10103,8 @@ Edit the hotlist of directory servers in a specialized buffer.
;;;***
-;;;### (autoloads (ewoc-create) "ewoc" "emacs-lisp/ewoc.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (ewoc-create) "ewoc" "emacs-lisp/ewoc.el" (20453
+;;;;;; 5437 764254 0))
;;; Generated autoloads from emacs-lisp/ewoc.el
(autoload 'ewoc-create "ewoc" "\
@@ -9987,7 +10133,7 @@ fourth arg NOSEP non-nil inhibits this.
;;;### (autoloads (executable-make-buffer-file-executable-if-script-p
;;;;;; executable-self-display executable-set-magic executable-interpret
;;;;;; executable-command-find-posix-p) "executable" "progmodes/executable.el"
-;;;;;; (20160 63745))
+;;;;;; (20533 6181 437016 717000))
;;; Generated autoloads from progmodes/executable.el
(autoload 'executable-command-find-posix-p "executable" "\
@@ -10030,7 +10176,7 @@ file modes.
;;;### (autoloads (expand-jump-to-next-slot expand-jump-to-previous-slot
;;;;;; expand-abbrev-hook expand-add-abbrevs) "expand" "expand.el"
-;;;;;; (20164 29468))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from expand.el
(autoload 'expand-add-abbrevs "expand" "\
@@ -10079,7 +10225,8 @@ This is used only in conjunction with `expand-add-abbrevs'.
;;;***
-;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20178 7273))
+;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20566 63671
+;;;;;; 243798 0))
;;; Generated autoloads from progmodes/f90.el
(autoload 'f90-mode "f90" "\
@@ -10149,41 +10296,54 @@ with no args, if that value is non-nil.
;;;### (autoloads (variable-pitch-mode buffer-face-toggle buffer-face-set
;;;;;; buffer-face-mode text-scale-adjust text-scale-decrease text-scale-increase
;;;;;; text-scale-set face-remap-set-base face-remap-reset-base
-;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (20127
-;;;;;; 62865))
+;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (20622
+;;;;;; 22438 32851 0))
;;; Generated autoloads from face-remap.el
(autoload 'face-remap-add-relative "face-remap" "\
Add a face remapping entry of FACE to SPECS in the current buffer.
-
-Return a cookie which can be used to delete the remapping with
+Return a cookie which can be used to delete this remapping with
`face-remap-remove-relative'.
-SPECS can be any value suitable for the `face' text property,
-including a face name, a list of face names, or a face-attribute
-property list. The attributes given by SPECS will be merged with
-any other currently active face remappings of FACE, and with the
-global definition of FACE. An attempt is made to sort multiple
-entries so that entries with relative face-attributes are applied
-after entries with absolute face-attributes.
+The remaining arguments, SPECS, should form a list of faces.
+Each list element should be either a face name or a property list
+of face attribute/value pairs. If more than one face is listed,
+that specifies an aggregate face, in the same way as in a `face'
+text property, except for possible priority changes noted below.
+
+The face remapping specified by SPECS takes effect alongside the
+remappings from other calls to `face-remap-add-relative' for the
+same FACE, as well as the normal definition of FACE (at lowest
+priority). This function tries to sort multiple remappings for
+the same face, so that remappings specifying relative face
+attributes are applied after remappings specifying absolute face
+attributes.
-The base (lowest priority) remapping may be set to a specific
-value, instead of the default of the global face definition,
-using `face-remap-set-base'.
+The base (lowest priority) remapping may be set to something
+other than the normal definition of FACE via `face-remap-set-base'.
\(fn FACE &rest SPECS)" nil nil)
(autoload 'face-remap-reset-base "face-remap" "\
-Set the base remapping of FACE to inherit from FACE's global definition.
+Set the base remapping of FACE to the normal definition of FACE.
+This causes the remappings specified by `face-remap-add-relative'
+to apply on top of the normal definition of FACE.
\(fn FACE)" nil nil)
(autoload 'face-remap-set-base "face-remap" "\
Set the base remapping of FACE in the current buffer to SPECS.
-If SPECS is empty, the default base remapping is restored, which
-inherits from the global definition of FACE; note that this is
-different from SPECS containing a single value `nil', which does
-not inherit from the global definition of FACE.
+This causes the remappings specified by `face-remap-add-relative'
+to apply on top of the face specification given by SPECS.
+
+The remaining arguments, SPECS, should form a list of faces.
+Each list element should be either a face name or a property list
+of face attribute/value pairs, like in a `face' text property.
+
+If SPECS is empty, call `face-remap-reset-base' to use the normal
+definition of FACE as the base remapping; note that this is
+different from SPECS containing a single value `nil', which means
+not to inherit from the global definition of FACE at all.
\(fn FACE &rest SPECS)" nil nil)
@@ -10220,7 +10380,9 @@ See `text-scale-increase' for more details.
(define-key ctl-x-map [(control ?0)] 'text-scale-adjust)
(autoload 'text-scale-adjust "face-remap" "\
-Increase or decrease the height of the default face in the current buffer.
+Adjust the height of the default face by INC.
+
+INC may be passed as a numeric prefix argument.
The actual adjustment made depends on the final component of the
key-binding used to invoke the command, with all modifiers removed:
@@ -10229,9 +10391,11 @@ key-binding used to invoke the command, with all modifiers removed:
- Decrease the default face height by one step
0 Reset the default face height to the global default
-Then, continue to read input events and further adjust the face
-height as long as the input event read (with all modifiers removed)
-is one of the above.
+When adjusting with `+' or `-', continue to read input events and
+further adjust the face height as long as the input event read
+\(with all modifiers removed) is `+' or `-'.
+
+When adjusting with `0', immediately finish.
Each step scales the height of the default face by the variable
`text-scale-mode-step' (a negative number of steps decreases the
@@ -10248,26 +10412,32 @@ a top-level keymap, `text-scale-increase' or
(autoload 'buffer-face-mode "face-remap" "\
Minor mode for a buffer-specific default face.
-When enabled, the face specified by the variable
-`buffer-face-mode-face' is used to display the buffer text.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil. When enabled, the face specified by the
+variable `buffer-face-mode-face' is used to display the buffer text.
\(fn &optional ARG)" t nil)
(autoload 'buffer-face-set "face-remap" "\
Enable `buffer-face-mode', using face specs SPECS.
-SPECS can be any value suitable for the `face' text property,
-including a face name, a list of face names, or a face-attribute
-If SPECS is nil, then `buffer-face-mode' is disabled.
+Each argument in SPECS should be a face, i.e. either a face name
+or a property list of face attributes and values. If more than
+one face is listed, that specifies an aggregate face, like in a
+`face' text property. If SPECS is nil or omitted, disable
+`buffer-face-mode'.
-This function will make the variable `buffer-face-mode-face'
-buffer local, and set it to FACE.
+This function makes the variable `buffer-face-mode-face' buffer
+local, and sets it to FACE.
\(fn &rest SPECS)" t nil)
(autoload 'buffer-face-toggle "face-remap" "\
Toggle `buffer-face-mode', using face specs SPECS.
-SPECS can be any value suitable for the `face' text property,
-including a face name, a list of face names, or a face-attribute
+Each argument in SPECS should be a face, i.e. either a face name
+or a property list of face attributes and values. If more than
+one face is listed, that specifies an aggregate face, like in a
+`face' text property.
If `buffer-face-mode' is already enabled, and is currently using
the face specs SPECS, then it is disabled; if buffer-face-mode is
@@ -10290,7 +10460,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" (20172 54913))
+;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (20566 63671
+;;;;;; 243798 0))
;;; Generated autoloads from mail/feedmail.el
(autoload 'feedmail-send-it "feedmail" "\
@@ -10343,8 +10514,9 @@ you can set `feedmail-queue-reminder-alist' to nil.
;;;***
-;;;### (autoloads (ffap-bindings dired-at-point ffap-at-mouse ffap-menu
-;;;;;; find-file-at-point ffap-next) "ffap" "ffap.el" (20164 60780))
+;;;### (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" (20595 63909 923329 0))
;;; Generated autoloads from ffap.el
(autoload 'ffap-next "ffap" "\
@@ -10394,9 +10566,11 @@ If `dired-at-point-require-prefix' is set, the prefix meaning is reversed.
\(fn &optional FILENAME)" t nil)
-(defun ffap-guess-file-name-at-point nil "\
+(autoload 'ffap-guess-file-name-at-point "ffap" "\
Try to get a file name at point.
-This hook is intended to be put in `file-name-at-point-functions'." (when (fboundp (quote ffap-guesser)) (let ((guess (ffap-guesser))) (setq guess (if (or (not guess) (and (fboundp (quote ffap-url-p)) (ffap-url-p guess)) (and (fboundp (quote ffap-file-remote-p)) (ffap-file-remote-p guess))) guess (abbreviate-file-name (expand-file-name guess)))) (when guess (if (file-directory-p guess) (file-name-as-directory guess) guess)))))
+This hook is intended to be put in `file-name-at-point-functions'.
+
+\(fn)" nil nil)
(autoload 'ffap-bindings "ffap" "\
Evaluate the forms in variable `ffap-bindings'.
@@ -10408,7 +10582,7 @@ Evaluate the forms in variable `ffap-bindings'.
;;;### (autoloads (file-cache-minibuffer-complete file-cache-add-directory-recursively
;;;;;; file-cache-add-directory-using-locate file-cache-add-directory-using-find
;;;;;; file-cache-add-file file-cache-add-directory-list file-cache-add-directory)
-;;;;;; "filecache" "filecache.el" (19845 45374))
+;;;;;; "filecache" "filecache.el" (20355 10021 546955 0))
;;; Generated autoloads from filecache.el
(autoload 'file-cache-add-directory "filecache" "\
@@ -10468,7 +10642,8 @@ the name is considered already unique; only the second substitution
;;;;;; copy-file-locals-to-dir-locals delete-dir-local-variable
;;;;;; add-dir-local-variable delete-file-local-variable-prop-line
;;;;;; add-file-local-variable-prop-line delete-file-local-variable
-;;;;;; add-file-local-variable) "files-x" "files-x.el" (20167 36967))
+;;;;;; add-file-local-variable) "files-x" "files-x.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from files-x.el
(autoload 'add-file-local-variable "files-x" "\
@@ -10533,8 +10708,8 @@ Copy directory-local variables to the -*- line.
;;;***
-;;;### (autoloads (filesets-init) "filesets" "filesets.el" (20178
-;;;;;; 7273))
+;;;### (autoloads (filesets-init) "filesets" "filesets.el" (20614
+;;;;;; 54428 654267 0))
;;; Generated autoloads from filesets.el
(autoload 'filesets-init "filesets" "\
@@ -10545,7 +10720,8 @@ Set up hooks, load the cache file -- if existing -- and build the menu.
;;;***
-;;;### (autoloads (find-cmd) "find-cmd" "find-cmd.el" (19845 45374))
+;;;### (autoloads (find-cmd) "find-cmd" "find-cmd.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from find-cmd.el
(autoload 'find-cmd "find-cmd" "\
@@ -10565,7 +10741,7 @@ result is a string that should be ready for the command line.
;;;***
;;;### (autoloads (find-grep-dired find-name-dired find-dired) "find-dired"
-;;;;;; "find-dired.el" (19980 19797))
+;;;;;; "find-dired.el" (20355 10021 546955 0))
;;; Generated autoloads from find-dired.el
(autoload 'find-dired "find-dired" "\
@@ -10604,18 +10780,20 @@ use in place of \"-ls\" as the final argument.
;;;***
;;;### (autoloads (ff-mouse-find-other-file-other-window ff-mouse-find-other-file
-;;;;;; ff-find-other-file ff-get-other-file) "find-file" "find-file.el"
-;;;;;; (19845 45374))
+;;;;;; ff-find-other-file ff-get-other-file ff-special-constructs)
+;;;;;; "find-file" "find-file.el" (20387 44199 24128 0))
;;; Generated autoloads from find-file.el
(defvar ff-special-constructs `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") lambda nil (buffer-substring (match-beginning 2) (match-end 2)))) "\
-*List of special constructs for `ff-treat-as-special' to recognize.
+List of special constructs recognized by `ff-treat-as-special'.
Each element, tried in order, has the form (REGEXP . EXTRACT).
If REGEXP matches the current line (from the beginning of the line),
`ff-treat-as-special' calls function EXTRACT with no args.
If EXTRACT returns nil, keep trying. Otherwise, return the
filename that EXTRACT returned.")
+(custom-autoload 'ff-special-constructs "find-file" t)
+
(autoload 'ff-get-other-file "find-file" "\
Find the header or source file corresponding to this file.
See also the documentation for `ff-find-other-file'.
@@ -10699,7 +10877,7 @@ Visit the file you click on in another window.
;;;;;; find-variable find-variable-noselect find-function-other-frame
;;;;;; find-function-other-window find-function find-function-noselect
;;;;;; find-function-search-for-symbol find-library) "find-func"
-;;;;;; "emacs-lisp/find-func.el" (20153 32815))
+;;;;;; "emacs-lisp/find-func.el" (20497 6436 957082 0))
;;; Generated autoloads from emacs-lisp/find-func.el
(autoload 'find-library "find-func" "\
@@ -10858,7 +11036,8 @@ Define some key bindings for the find-function family of functions.
;;;***
;;;### (autoloads (find-lisp-find-dired-filter find-lisp-find-dired-subdirectories
-;;;;;; find-lisp-find-dired) "find-lisp" "find-lisp.el" (19886 45771))
+;;;;;; find-lisp-find-dired) "find-lisp" "find-lisp.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from find-lisp.el
(autoload 'find-lisp-find-dired "find-lisp" "\
@@ -10879,7 +11058,7 @@ Change the filter on a find-lisp-find-dired buffer to REGEXP.
;;;***
;;;### (autoloads (finder-by-keyword finder-commentary finder-list-keywords)
-;;;;;; "finder" "finder.el" (19893 19022))
+;;;;;; "finder" "finder.el" (20355 10021 546955 0))
;;; Generated autoloads from finder.el
(autoload 'finder-list-keywords "finder" "\
@@ -10901,7 +11080,7 @@ Find packages matching a given keyword.
;;;***
;;;### (autoloads (enable-flow-control-on enable-flow-control) "flow-ctrl"
-;;;;;; "flow-ctrl.el" (19845 45374))
+;;;;;; "flow-ctrl.el" (20566 63671 243798 0))
;;; Generated autoloads from flow-ctrl.el
(autoload 'enable-flow-control "flow-ctrl" "\
@@ -10923,7 +11102,7 @@ to get the effect of a C-q.
;;;***
;;;### (autoloads (fill-flowed fill-flowed-encode) "flow-fill" "gnus/flow-fill.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/flow-fill.el
(autoload 'fill-flowed-encode "flow-fill" "\
@@ -10939,13 +11118,15 @@ 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" (19984 16846))
+;;;;;; flymake-mode) "flymake" "progmodes/flymake.el" (20611 52135
+;;;;;; 109136 0))
;;; Generated autoloads from progmodes/flymake.el
(autoload 'flymake-mode "flymake" "\
-Minor mode to do on-the-fly syntax checking.
-When called interactively, toggles the minor mode.
-With arg, turn Flymake mode on if and only if arg is positive.
+Toggle on-the-fly syntax checking.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
\(fn &optional ARG)" t nil)
@@ -10968,7 +11149,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" (20174 10230))
+;;;;;; "flyspell" "textmodes/flyspell.el" (20566 63671 243798 0))
;;; Generated autoloads from textmodes/flyspell.el
(autoload 'flyspell-prog-mode "flyspell" "\
@@ -11004,7 +11185,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.
@@ -11040,7 +11221,7 @@ Flyspell whole buffer.
;;;### (autoloads (follow-delete-other-windows-and-split follow-mode
;;;;;; turn-off-follow-mode turn-on-follow-mode) "follow" "follow.el"
-;;;;;; (20178 7273))
+;;;;;; (20501 3499 284800 0))
;;; Generated autoloads from follow.el
(autoload 'turn-on-follow-mode "follow" "\
@@ -11083,10 +11264,6 @@ To split one large window into two side-by-side windows, the commands
Only windows displayed in the same frame follow each other.
-If the variable `follow-intercept-processes' is non-nil, Follow mode
-will listen to the output of processes and redisplay accordingly.
-\(This is the default.)
-
This command runs the normal hook `follow-mode-hook'.
Keys specific to Follow mode:
@@ -11108,16 +11285,12 @@ If ARG is positive, the leftmost window is selected. If negative,
the rightmost is selected. If ARG is nil, the leftmost window is
selected if the original window is the first one in the frame.
-To bind this command to a hotkey, place the following line
-in your `~/.emacs' file, replacing [f7] by your favorite key:
- (global-set-key [f7] 'follow-delete-other-windows-and-split)
-
\(fn &optional ARG)" t nil)
;;;***
-;;;### (autoloads (footnote-mode) "footnote" "mail/footnote.el" (20170
-;;;;;; 13157))
+;;;### (autoloads (footnote-mode) "footnote" "mail/footnote.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from mail/footnote.el
(autoload 'footnote-mode "footnote" "\
@@ -11136,7 +11309,7 @@ play around with the following keys:
;;;***
;;;### (autoloads (forms-find-file-other-window forms-find-file forms-mode)
-;;;;;; "forms" "forms.el" (20168 57844))
+;;;;;; "forms" "forms.el" (20427 14766 970343 0))
;;; Generated autoloads from forms.el
(autoload 'forms-mode "forms" "\
@@ -11173,7 +11346,7 @@ Visit a file in Forms mode in other window.
;;;***
;;;### (autoloads (fortran-mode) "fortran" "progmodes/fortran.el"
-;;;;;; (20178 7273))
+;;;;;; (20438 24024 724594 589000))
;;; Generated autoloads from progmodes/fortran.el
(autoload 'fortran-mode "fortran" "\
@@ -11251,7 +11424,8 @@ with no args, if that value is non-nil.
;;;***
;;;### (autoloads (fortune fortune-to-signature fortune-compile fortune-from-region
-;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (20165 31925))
+;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from play/fortune.el
(autoload 'fortune-add-fortune "fortune" "\
@@ -11300,13 +11474,24 @@ and choose the directory as the fortune-file.
;;;***
;;;### (autoloads (gdb gdb-enable-debug) "gdb-mi" "progmodes/gdb-mi.el"
-;;;;;; (20182 4358))
+;;;;;; (20609 10405 476026 0))
;;; Generated autoloads from progmodes/gdb-mi.el
(defvar gdb-enable-debug nil "\
-Non-nil means record the process input and output in `gdb-debug-log'.")
+Non-nil if Gdb-Enable-Debug mode is enabled.
+See the command `gdb-enable-debug' for a description of this minor mode.")
+
+(custom-autoload 'gdb-enable-debug "gdb-mi" nil)
-(custom-autoload 'gdb-enable-debug "gdb-mi" t)
+(autoload 'gdb-enable-debug "gdb-mi" "\
+Toggle logging of transaction between Emacs and Gdb.
+The log is stored in `gdb-debug-log' as an alist with elements
+whose cons is send, send-item or recv and whose cdr is the string
+being transferred. This list may grow up to a size of
+`gdb-debug-log-max' after which the oldest element (at the end of
+the list) is deleted every time a new one is added (at the front).
+
+\(fn &optional ARG)" t nil)
(autoload 'gdb "gdb-mi" "\
Run gdb on program FILE in buffer *gud-FILE*.
@@ -11367,8 +11552,8 @@ detailed description of this mode.
;;;***
;;;### (autoloads (generic-make-keywords-list generic-mode generic-mode-internal
-;;;;;; define-generic-mode) "generic" "emacs-lisp/generic.el" (19845
-;;;;;; 45374))
+;;;;;; define-generic-mode) "generic" "emacs-lisp/generic.el" (20406
+;;;;;; 8611 875037 0))
;;; Generated autoloads from emacs-lisp/generic.el
(defvar generic-mode-list nil "\
@@ -11410,10 +11595,12 @@ mode hook `MODE-hook'.
See the file generic-x.el for some examples of `define-generic-mode'.
-\(fn MODE COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST &optional DOCSTRING)" nil (quote macro))
+\(fn MODE COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST &optional DOCSTRING)" nil t)
(put 'define-generic-mode 'lisp-indent-function '1)
+(put 'define-generic-mode 'doc-string-elt '7)
+
(autoload 'generic-mode-internal "generic" "\
Go into the generic mode MODE.
@@ -11445,13 +11632,15 @@ regular expression that can be used as an element of
;;;***
;;;### (autoloads (glasses-mode) "glasses" "progmodes/glasses.el"
-;;;;;; (19906 31087))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from progmodes/glasses.el
(autoload 'glasses-mode "glasses" "\
Minor mode for making identifiers likeThis readable.
-When this mode is active, it tries to add virtual separators (like underscores)
-at places they belong to.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil. When this mode is active, it tries to
+add virtual separators (like underscores) at places they belong to.
\(fn &optional ARG)" t nil)
@@ -11459,7 +11648,7 @@ at places they belong to.
;;;### (autoloads (gmm-tool-bar-from-list gmm-widget-p gmm-error
;;;;;; gmm-message gmm-regexp-concat) "gmm-utils" "gnus/gmm-utils.el"
-;;;;;; (20175 31160))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/gmm-utils.el
(autoload 'gmm-regexp-concat "gmm-utils" "\
@@ -11514,7 +11703,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" (20164 60780))
+;;;;;; 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"))
@@ -11567,7 +11757,7 @@ prompt the user for the name of an NNTP server to use.
;;;;;; gnus-agent-get-undownloaded-list gnus-agent-delete-group
;;;;;; gnus-agent-rename-group gnus-agent-possibly-save-gcc gnus-agentize
;;;;;; gnus-slave-unplugged gnus-plugged gnus-unplugged) "gnus-agent"
-;;;;;; "gnus/gnus-agent.el" (20168 57844))
+;;;;;; "gnus/gnus-agent.el" (20518 12580 46478 0))
;;; Generated autoloads from gnus/gnus-agent.el
(autoload 'gnus-unplugged "gnus-agent" "\
@@ -11658,7 +11848,7 @@ If CLEAN, obsolete (ignore).
;;;***
;;;### (autoloads (gnus-article-prepare-display) "gnus-art" "gnus/gnus-art.el"
-;;;;;; (20182 4358))
+;;;;;; (20578 54821 719276 0))
;;; Generated autoloads from gnus/gnus-art.el
(autoload 'gnus-article-prepare-display "gnus-art" "\
@@ -11669,7 +11859,8 @@ Make the current buffer look like a nice article.
;;;***
;;;### (autoloads (gnus-bookmark-bmenu-list gnus-bookmark-jump gnus-bookmark-set)
-;;;;;; "gnus-bookmark" "gnus/gnus-bookmark.el" (19845 45374))
+;;;;;; "gnus-bookmark" "gnus/gnus-bookmark.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from gnus/gnus-bookmark.el
(autoload 'gnus-bookmark-set "gnus-bookmark" "\
@@ -11694,8 +11885,8 @@ deletion, or > if it is flagged for displaying.
;;;### (autoloads (gnus-cache-delete-group gnus-cache-rename-group
;;;;;; gnus-cache-generate-nov-databases gnus-cache-generate-active
-;;;;;; gnus-jog-cache) "gnus-cache" "gnus/gnus-cache.el" (19845
-;;;;;; 45374))
+;;;;;; gnus-jog-cache) "gnus-cache" "gnus/gnus-cache.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from gnus/gnus-cache.el
(autoload 'gnus-jog-cache "gnus-cache" "\
@@ -11737,7 +11928,7 @@ supported.
;;;***
;;;### (autoloads (gnus-delay-initialize gnus-delay-send-queue gnus-delay-article)
-;;;;;; "gnus-delay" "gnus/gnus-delay.el" (19931 11784))
+;;;;;; "gnus-delay" "gnus/gnus-delay.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-delay.el
(autoload 'gnus-delay-article "gnus-delay" "\
@@ -11773,7 +11964,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil.
;;;***
;;;### (autoloads (gnus-user-format-function-D gnus-user-format-function-d)
-;;;;;; "gnus-diary" "gnus/gnus-diary.el" (20161 45793))
+;;;;;; "gnus-diary" "gnus/gnus-diary.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-diary.el
(autoload 'gnus-user-format-function-d "gnus-diary" "\
@@ -11789,7 +11980,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil.
;;;***
;;;### (autoloads (turn-on-gnus-dired-mode) "gnus-dired" "gnus/gnus-dired.el"
-;;;;;; (20167 36967))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-dired.el
(autoload 'turn-on-gnus-dired-mode "gnus-dired" "\
@@ -11800,7 +11991,7 @@ Convenience method to turn on gnus-dired-mode.
;;;***
;;;### (autoloads (gnus-draft-reminder) "gnus-draft" "gnus/gnus-draft.el"
-;;;;;; (19981 40664))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-draft.el
(autoload 'gnus-draft-reminder "gnus-draft" "\
@@ -11812,8 +12003,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" (20088
-;;;;;; 26718))
+;;;;;; 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" "\
@@ -11858,7 +12049,8 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to
;;;***
;;;### (autoloads (gnus-treat-mail-gravatar gnus-treat-from-gravatar)
-;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (19845 45374))
+;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from gnus/gnus-gravatar.el
(autoload 'gnus-treat-from-gravatar "gnus-gravatar" "\
@@ -11876,7 +12068,7 @@ If gravatars are already displayed, remove them.
;;;***
;;;### (autoloads (gnus-fetch-group-other-frame gnus-fetch-group)
-;;;;;; "gnus-group" "gnus/gnus-group.el" (20179 28130))
+;;;;;; "gnus-group" "gnus/gnus-group.el" (20553 51627 169867 0))
;;; Generated autoloads from gnus/gnus-group.el
(autoload 'gnus-fetch-group "gnus-group" "\
@@ -11894,7 +12086,7 @@ Pop up a frame and enter GROUP.
;;;***
;;;### (autoloads (gnus-html-prefetch-images gnus-article-html) "gnus-html"
-;;;;;; "gnus/gnus-html.el" (20050 11479))
+;;;;;; "gnus/gnus-html.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-html.el
(autoload 'gnus-article-html "gnus-html" "\
@@ -11910,7 +12102,7 @@ Pop up a frame and enter GROUP.
;;;***
;;;### (autoloads (gnus-batch-score) "gnus-kill" "gnus/gnus-kill.el"
-;;;;;; (19845 45374))
+;;;;;; (20495 51111 757560 0))
;;; Generated autoloads from gnus/gnus-kill.el
(defalias 'gnus-batch-kill 'gnus-batch-score)
@@ -11925,7 +12117,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score
;;;### (autoloads (gnus-mailing-list-mode gnus-mailing-list-insinuate
;;;;;; turn-on-gnus-mailing-list-mode) "gnus-ml" "gnus/gnus-ml.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-ml.el
(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" "\
@@ -11950,7 +12142,7 @@ Minor mode for providing mailing-list commands.
;;;### (autoloads (gnus-group-split-fancy gnus-group-split gnus-group-split-update
;;;;;; gnus-group-split-setup) "gnus-mlspl" "gnus/gnus-mlspl.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-mlspl.el
(autoload 'gnus-group-split-setup "gnus-mlspl" "\
@@ -12051,13 +12243,15 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
;;;***
;;;### (autoloads (gnus-button-reply gnus-button-mailto gnus-msg-mail)
-;;;;;; "gnus-msg" "gnus/gnus-msg.el" (20183 25152))
+;;;;;; "gnus-msg" "gnus/gnus-msg.el" (20593 22184 581574 0))
;;; Generated autoloads from gnus/gnus-msg.el
(autoload 'gnus-msg-mail "gnus-msg" "\
Start editing a mail message to be sent.
Like `message-mail', but with Gnus paraphernalia, particularly the
Gcc: header for archiving purposes.
+If Gnus isn't running, a plain `message-mail' setup is used
+instead.
\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-ACTION YANK-ACTION SEND-ACTIONS RETURN-ACTION)" t nil)
@@ -12075,9 +12269,26 @@ Like `message-reply'.
;;;***
+;;;### (autoloads (gnus-notifications) "gnus-notifications" "gnus/gnus-notifications.el"
+;;;;;; (20593 22184 581574 0))
+;;; Generated autoloads from gnus/gnus-notifications.el
+
+(autoload 'gnus-notifications "gnus-notifications" "\
+Send a notification on new message.
+This check for new messages that are in group with a level lower
+or equal to `gnus-notifications-minimum-level' and send a
+notification using `notifications-notify' for it.
+
+This is typically a function to add in
+`gnus-after-getting-new-news-hook'
+
+\(fn)" nil nil)
+
+;;;***
+
;;;### (autoloads (gnus-treat-newsgroups-picon gnus-treat-mail-picon
;;;;;; gnus-treat-from-picon) "gnus-picon" "gnus/gnus-picon.el"
-;;;;;; (19845 45374))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from gnus/gnus-picon.el
(autoload 'gnus-treat-from-picon "gnus-picon" "\
@@ -12104,7 +12315,7 @@ If picons are already displayed, remove them.
;;;;;; gnus-sorted-nintersection gnus-sorted-range-intersection
;;;;;; gnus-sorted-intersection gnus-intersection gnus-sorted-complement
;;;;;; gnus-sorted-ndifference gnus-sorted-difference) "gnus-range"
-;;;;;; "gnus/gnus-range.el" (19845 45374))
+;;;;;; "gnus/gnus-range.el" (20544 36659 880486 0))
;;; Generated autoloads from gnus/gnus-range.el
(autoload 'gnus-sorted-difference "gnus-range" "\
@@ -12172,7 +12383,8 @@ Add NUM into sorted LIST by side effect.
;;;***
;;;### (autoloads (gnus-registry-install-hooks gnus-registry-initialize)
-;;;;;; "gnus-registry" "gnus/gnus-registry.el" (20143 51029))
+;;;;;; "gnus-registry" "gnus/gnus-registry.el" (20544 36659 880486
+;;;;;; 0))
;;; Generated autoloads from gnus/gnus-registry.el
(autoload 'gnus-registry-initialize "gnus-registry" "\
@@ -12188,8 +12400,8 @@ Install the registry hooks.
;;;***
;;;### (autoloads (gnus-sieve-article-add-rule gnus-sieve-generate
-;;;;;; gnus-sieve-update) "gnus-sieve" "gnus/gnus-sieve.el" (19845
-;;;;;; 45374))
+;;;;;; gnus-sieve-update) "gnus-sieve" "gnus/gnus-sieve.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from gnus/gnus-sieve.el
(autoload 'gnus-sieve-update "gnus-sieve" "\
@@ -12217,7 +12429,7 @@ See the documentation for these variables and functions for details.
;;;***
;;;### (autoloads (gnus-update-format) "gnus-spec" "gnus/gnus-spec.el"
-;;;;;; (20076 35541))
+;;;;;; (20458 56750 651721 0))
;;; Generated autoloads from gnus/gnus-spec.el
(autoload 'gnus-update-format "gnus-spec" "\
@@ -12228,7 +12440,7 @@ Update the format specification near point.
;;;***
;;;### (autoloads (gnus-declare-backend) "gnus-start" "gnus/gnus-start.el"
-;;;;;; (20176 51947))
+;;;;;; (20614 54428 654267 0))
;;; Generated autoloads from gnus/gnus-start.el
(autoload 'gnus-declare-backend "gnus-start" "\
@@ -12239,7 +12451,7 @@ Declare back end NAME with ABILITIES as a Gnus back end.
;;;***
;;;### (autoloads (gnus-summary-bookmark-jump) "gnus-sum" "gnus/gnus-sum.el"
-;;;;;; (20172 54913))
+;;;;;; (20540 39589 424586 0))
;;; Generated autoloads from gnus/gnus-sum.el
(autoload 'gnus-summary-bookmark-jump "gnus-sum" "\
@@ -12251,7 +12463,7 @@ BOOKMARK is a bookmark name or a bookmark record.
;;;***
;;;### (autoloads (gnus-sync-install-hooks gnus-sync-initialize)
-;;;;;; "gnus-sync" "gnus/gnus-sync.el" (19845 45374))
+;;;;;; "gnus-sync" "gnus/gnus-sync.el" (20593 22184 581574 0))
;;; Generated autoloads from gnus/gnus-sync.el
(autoload 'gnus-sync-initialize "gnus-sync" "\
@@ -12267,7 +12479,7 @@ Install the sync hooks.
;;;***
;;;### (autoloads (gnus-add-configuration) "gnus-win" "gnus/gnus-win.el"
-;;;;;; (20161 45793))
+;;;;;; (20447 49522 409090 0))
;;; Generated autoloads from gnus/gnus-win.el
(autoload 'gnus-add-configuration "gnus-win" "\
@@ -12278,23 +12490,24 @@ Add the window configuration CONF to `gnus-buffer-configuration'.
;;;***
;;;### (autoloads (gnutls-min-prime-bits) "gnutls" "net/gnutls.el"
-;;;;;; (20176 51947))
+;;;;;; (20476 31768 298871 0))
;;; Generated autoloads from net/gnutls.el
-(defvar gnutls-min-prime-bits nil "\
-The minimum number of bits to be used in Diffie-Hellman key exchange.
-
-This sets the minimum accepted size of the key to be used in a
-client-server handshake. If the server sends a prime with fewer than
-the specified number of bits the handshake will fail.
+(defvar gnutls-min-prime-bits 256 "\
+Minimum number of prime bits accepted by GnuTLS for key exchange.
+During a Diffie-Hellman handshake, if the server sends a prime
+number with fewer than this number of bits, the handshake is
+rejected. (The smaller the prime number, the less secure the
+key exchange is against man-in-the-middle attacks.)
-A value of nil says to use the default gnutls value.")
+A value of nil says to use the default GnuTLS value.")
(custom-autoload 'gnutls-min-prime-bits "gnutls" t)
;;;***
-;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (20178 7273))
+;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (20626 19492
+;;;;;; 855904 0))
;;; Generated autoloads from play/gomoku.el
(autoload 'gomoku "gomoku" "\
@@ -12321,8 +12534,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" (20127
-;;;;;; 62865))
+;;;;;; 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")
@@ -12350,6 +12563,9 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
(autoload 'goto-address-mode "goto-addr" "\
Minor mode to buttonize URLs and e-mail addresses in the current buffer.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
\(fn &optional ARG)" t nil)
@@ -12361,7 +12577,7 @@ Like `goto-address-mode', but only for comments and strings.
;;;***
;;;### (autoloads (gravatar-retrieve-synchronously gravatar-retrieve)
-;;;;;; "gravatar" "gnus/gravatar.el" (19845 45374))
+;;;;;; "gravatar" "gnus/gravatar.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/gravatar.el
(autoload 'gravatar-retrieve "gravatar" "\
@@ -12379,11 +12595,12 @@ 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" (20174 10230))
+;;;;;; grep-window-height) "grep" "progmodes/grep.el" (20572 16038
+;;;;;; 402143 0))
;;; Generated autoloads from progmodes/grep.el
(defvar grep-window-height nil "\
-*Number of lines in a grep window. If nil, use `compilation-window-height'.")
+Number of lines in a grep window. If nil, use `compilation-window-height'.")
(custom-autoload 'grep-window-height "grep" t)
@@ -12462,8 +12679,8 @@ Sets `grep-last-buffer' and `compilation-window-height'.
(autoload 'grep "grep" "\
Run grep, with user-specified args, and collect output in a buffer.
While grep runs asynchronously, you can use \\[next-error] (M-x next-error),
-or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer, to go to the lines where grep
-found matches.
+or \\<grep-mode-map>\\[compile-goto-error] in the *grep* buffer, to go to the lines where grep found
+matches. To kill the grep job before it finishes, type \\[kill-compilation].
For doing a recursive `grep', see the `rgrep' command. For running
`grep' in a specific directory, see `lgrep'.
@@ -12519,12 +12736,16 @@ With \\[universal-argument] prefix, you can edit the constructed shell command l
before it is executed.
With two \\[universal-argument] prefixes, directly edit and run `grep-find-command'.
-Collect output in a buffer. While find runs asynchronously, you
-can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer,
-to go to the lines where grep found matches.
+Collect output in a buffer. While the recursive grep is running,
+you can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer,
+to visit the lines where matches were found. To kill the job
+before it finishes, type \\[kill-compilation].
This command shares argument histories with \\[lgrep] and \\[grep-find].
+When called programmatically and FILES is nil, REGEXP is expected
+to specify a command to run.
+
\(fn REGEXP &optional FILES DIR CONFIRM)" t nil)
(autoload 'zrgrep "grep" "\
@@ -12538,7 +12759,8 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'.
;;;***
-;;;### (autoloads (gs-load-image) "gs" "gs.el" (19845 45374))
+;;;### (autoloads (gs-load-image) "gs" "gs.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from gs.el
(autoload 'gs-load-image "gs" "\
@@ -12552,7 +12774,8 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful.
;;;***
;;;### (autoloads (gud-tooltip-mode gdb-script-mode jdb pdb perldb
-;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (20178 7273))
+;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (20614 55343
+;;;;;; 384716 548000))
;;; Generated autoloads from progmodes/gud.el
(autoload 'gud-gdb "gud" "\
@@ -12640,8 +12863,99 @@ it if ARG is omitted or nil.
;;;***
-;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (19889
-;;;;;; 21967))
+;;;### (autoloads (setf gv-define-simple-setter gv-define-setter
+;;;;;; gv--defun-declaration gv-define-expander gv-letplace gv-get)
+;;;;;; "gv" "emacs-lisp/gv.el" (20608 20265 413008 0))
+;;; Generated autoloads from emacs-lisp/gv.el
+
+(autoload 'gv-get "gv" "\
+Build the code that applies DO to PLACE.
+PLACE must be a valid generalized variable.
+DO must be a function; it will be called with 2 arguments: GETTER and SETTER,
+where GETTER is a (copyable) Elisp expression that returns the value of PLACE,
+and SETTER is a function which returns the code to set PLACE when called
+with a (not necessarily copyable) Elisp expression that returns the value to
+set it to.
+DO must return an Elisp expression.
+
+\(fn PLACE DO)" nil nil)
+
+(autoload 'gv-letplace "gv" "\
+Build the code manipulating the generalized variable PLACE.
+GETTER will be bound to a copyable expression that returns the value
+of PLACE.
+SETTER will be bound to a function that takes an expression V and returns
+and new expression that sets PLACE to V.
+BODY should return some Elisp expression E manipulating PLACE via GETTER
+and SETTER.
+The returned value will then be an Elisp expression that first evaluates
+all the parts of PLACE that can be evaluated and then runs E.
+
+\(fn (GETTER SETTER) PLACE &rest BODY)" nil t)
+
+(put 'gv-letplace 'lisp-indent-function '2)
+
+(autoload 'gv-define-expander "gv" "\
+Use HANDLER to handle NAME as a generalized var.
+NAME is a symbol: the name of a function, macro, or special form.
+HANDLER is a function which takes an argument DO followed by the same
+arguments as NAME. DO is a function as defined in `gv-get'.
+
+\(fn NAME HANDLER)" nil t)
+
+(put 'gv-define-expander 'lisp-indent-function '1)
+
+(autoload 'gv--defun-declaration "gv" "\
+
+
+\(fn SYMBOL NAME ARGS HANDLER &optional FIX)" nil nil)
+
+(push `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander)) defun-declarations-alist)
+
+(push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter)) defun-declarations-alist)
+
+(autoload 'gv-define-setter "gv" "\
+Define a setter method for generalized variable NAME.
+This macro is an easy-to-use substitute for `gv-define-expander' that works
+well for simple place forms.
+Assignments of VAL to (NAME ARGS...) are expanded by binding the argument
+forms (VAL ARGS...) according to ARGLIST, then executing BODY, which must
+return a Lisp form that does the assignment.
+The first arg in ARLIST (the one that receives VAL) receives an expression
+which can do arbitrary things, whereas the other arguments are all guaranteed
+to be pure and copyable. Example use:
+ (gv-define-setter aref (v a i) `(aset ,a ,i ,v))
+
+\(fn NAME ARGLIST &rest BODY)" nil t)
+
+(put 'gv-define-setter 'lisp-indent-function '2)
+
+(autoload 'gv-define-simple-setter "gv" "\
+Define a simple setter method for generalized variable NAME.
+This macro is an easy-to-use substitute for `gv-define-expander' that works
+well for simple place forms. Assignments of VAL to (NAME ARGS...) are
+turned into calls of the form (SETTER ARGS... VAL).
+If FIX-RETURN is non-nil, then SETTER is not assumed to return VAL and
+instead the assignment is turned into (prog1 VAL (SETTER ARGS... VAL))
+so as to preserve the semantics of `setf'.
+
+\(fn NAME SETTER &optional FIX-RETURN)" nil t)
+
+(autoload 'setf "gv" "\
+Set each PLACE to the value of its VAL.
+This is a generalized version of `setq'; the PLACEs may be symbolic
+references such as (car x) or (aref x i), as well as plain symbols.
+For example, (setf (cadr x) y) is equivalent to (setcar (cdr x) y).
+The return value is the last VAL in the list.
+
+\(fn PLACE VAL PLACE VAL ...)" nil t)
+
+(put 'gv-place 'edebug-form-spec 'edebug-match-form)
+
+;;;***
+
+;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from play/handwrite.el
(autoload 'handwrite "handwrite" "\
@@ -12659,7 +12973,7 @@ Variables: `handwrite-linespace' (default 12)
;;;***
;;;### (autoloads (hanoi-unix-64 hanoi-unix hanoi) "hanoi" "play/hanoi.el"
-;;;;;; (19981 40664))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from play/hanoi.el
(autoload 'hanoi "hanoi" "\
@@ -12688,7 +13002,7 @@ to be updated.
;;;### (autoloads (mail-check-payment mail-add-payment-async mail-add-payment
;;;;;; hashcash-verify-payment hashcash-insert-payment-async hashcash-insert-payment)
-;;;;;; "hashcash" "mail/hashcash.el" (19845 45374))
+;;;;;; "hashcash" "mail/hashcash.el" (20355 10021 546955 0))
;;; Generated autoloads from mail/hashcash.el
(autoload 'hashcash-insert-payment "hashcash" "\
@@ -12733,7 +13047,8 @@ Prefix arg sets default accept amount temporarily.
;;;### (autoloads (scan-buf-previous-region scan-buf-next-region
;;;;;; scan-buf-move-to-region help-at-pt-display-when-idle help-at-pt-set-timer
;;;;;; help-at-pt-cancel-timer display-local-help help-at-pt-kbd-string
-;;;;;; help-at-pt-string) "help-at-pt" "help-at-pt.el" (19845 45374))
+;;;;;; help-at-pt-string) "help-at-pt" "help-at-pt.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from help-at-pt.el
(autoload 'help-at-pt-string "help-at-pt" "\
@@ -12863,7 +13178,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" (20161 45793))
+;;;;;; "help-fns" "help-fns.el" (20601 16294 451653 0))
;;; Generated autoloads from help-fns.el
(autoload 'describe-function "help-fns" "\
@@ -12943,7 +13258,7 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file.
;;;***
;;;### (autoloads (three-step-help) "help-macro" "help-macro.el"
-;;;;;; (19845 45374))
+;;;;;; (20589 25124 41923 0))
;;; Generated autoloads from help-macro.el
(defvar three-step-help nil "\
@@ -12957,10 +13272,10 @@ gives the window that lists the options.")
;;;***
-;;;### (autoloads (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" (20167
-;;;;;; 36967))
+;;;### (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"
+;;;;;; (20601 16294 451653 0))
;;; Generated autoloads from help-mode.el
(autoload 'help-mode "help-mode" "\
@@ -13050,10 +13365,17 @@ Add xrefs for symbols in `pp's output between FROM and TO.
\(fn FROM TO)" nil nil)
+(autoload 'help-bookmark-jump "help-mode" "\
+Jump to help-mode bookmark BOOKMARK.
+Handler function for record returned by `help-bookmark-make-record'.
+BOOKMARK is a bookmark name or a bookmark record.
+
+\(fn BOOKMARK)" nil nil)
+
;;;***
;;;### (autoloads (Helper-help Helper-describe-bindings) "helper"
-;;;;;; "emacs-lisp/helper.el" (19845 45374))
+;;;;;; "emacs-lisp/helper.el" (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/helper.el
(autoload 'Helper-describe-bindings "helper" "\
@@ -13069,7 +13391,7 @@ Provide help for current mode.
;;;***
;;;### (autoloads (hexlify-buffer hexl-find-file hexl-mode) "hexl"
-;;;;;; "hexl.el" (19865 50420))
+;;;;;; "hexl.el" (20523 62082 997685 0))
;;; Generated autoloads from hexl.el
(autoload 'hexl-mode "hexl" "\
@@ -13084,7 +13406,7 @@ using the function `hexlify-buffer'.
Each line in the buffer has an \"address\" (displayed in hexadecimal)
representing the offset into the file that the characters on this line
are at and 16 characters from the file (displayed as hexadecimal
-values grouped every 16 bits) and as their ASCII values.
+values grouped every `hexl-bits' bits) and as their ASCII values.
If any of the characters (displayed as ASCII characters) are
unprintable (control or meta characters) they will be replaced as
@@ -13166,7 +13488,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"
-;;;;;; (20127 62865))
+;;;;;; (20593 22184 581574 0))
;;; Generated autoloads from hi-lock.el
(autoload 'hi-lock-mode "hi-lock" "\
@@ -13175,12 +13497,19 @@ With a prefix argument ARG, enable Hi Lock mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-Issuing one the highlighting commands listed below will
-automatically enable Hi Lock mode. To enable Hi Lock mode in all
-buffers, use `global-hi-lock-mode' or add (global-hi-lock-mode 1)
-to your init file. When Hi Lock mode is enabled, a \"Regexp
-Highlighting\" submenu is added to the \"Edit\" menu. The
-commands in the submenu, which can be called interactively, are:
+Hi Lock mode is automatically enabled when you invoke any of the
+highlighting commands listed below, such as \\[highlight-regexp].
+To enable Hi Lock mode in all buffers, use `global-hi-lock-mode'
+or add (global-hi-lock-mode 1) to your init file.
+
+In buffers where Font Lock mode is enabled, patterns are
+highlighted using font lock. In buffers where Font Lock mode is
+disabled, patterns are applied using overlays; in this case, the
+highlighting will not be updated as you type.
+
+When Hi Lock mode is enabled, a \"Regexp Highlighting\" submenu
+is added to the \"Edit\" menu. The commands in the submenu,
+which can be called interactively, are:
\\[highlight-regexp] REGEXP FACE
Highlight matches of pattern REGEXP in current buffer with FACE.
@@ -13214,12 +13543,12 @@ When hi-lock is started and if the mode is not excluded or patterns
rejected, the beginning of the buffer is searched for lines of the
form:
Hi-lock: FOO
-where FOO is a list of patterns. These are added to the font lock
-keywords already present. The patterns must start before position
-\(number of characters into buffer) `hi-lock-file-patterns-range'.
-Patterns will be read until
- Hi-lock: end
-is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'.
+
+where FOO is a list of patterns. The patterns must start before
+position (number of characters into buffer)
+`hi-lock-file-patterns-range'. Patterns will be read until
+Hi-lock: end is found. A mode is excluded if it's in the list
+`hi-lock-exclude-modes'.
\(fn &optional ARG)" t nil)
@@ -13248,12 +13577,13 @@ See `hi-lock-mode' for more information on Hi-Lock mode.
(autoload 'hi-lock-line-face-buffer "hi-lock" "\
Set face of all lines containing a match of REGEXP to FACE.
+Interactively, prompt for REGEXP then FACE, using a buffer-local
+history list for REGEXP and a global history list for FACE.
-Interactively, prompt for REGEXP then FACE. Buffer-local history
-list maintained for regexps, global history maintained for faces.
-\\<minibuffer-local-map>Use \\[previous-history-element] to retrieve previous history items,
-and \\[next-history-element] to retrieve default values.
-\(See info node `Minibuffer History'.)
+If Font Lock mode is enabled in the buffer, it is used to
+highlight REGEXP. If Font Lock mode is disabled, overlays are
+used for highlighting; in this case, the highlighting will not be
+updated as you type.
\(fn REGEXP &optional FACE)" t nil)
@@ -13261,12 +13591,13 @@ and \\[next-history-element] to retrieve default values.
(autoload 'hi-lock-face-buffer "hi-lock" "\
Set face of each match of REGEXP to FACE.
+Interactively, prompt for REGEXP then FACE, using a buffer-local
+history list for REGEXP and a global history list for FACE.
-Interactively, prompt for REGEXP then FACE. Buffer-local history
-list maintained for regexps, global history maintained for faces.
-\\<minibuffer-local-map>Use \\[previous-history-element] to retrieve previous history items,
-and \\[next-history-element] to retrieve default values.
-\(See info node `Minibuffer History'.)
+If Font Lock mode is enabled in the buffer, it is used to
+highlight REGEXP. If Font Lock mode is disabled, overlays are
+used for highlighting; in this case, the highlighting will not be
+updated as you type.
\(fn REGEXP &optional FACE)" t nil)
@@ -13274,9 +13605,13 @@ and \\[next-history-element] to retrieve default values.
(autoload 'hi-lock-face-phrase-buffer "hi-lock" "\
Set face of each match of phrase REGEXP to FACE.
+If called interactively, replaces whitespace in REGEXP with
+arbitrary whitespace and makes initial lower-case letters case-insensitive.
-Whitespace in REGEXP converted to arbitrary whitespace and initial
-lower-case letters made 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
+used for highlighting; in this case, the highlighting will not be
+updated as you type.
\(fn REGEXP &optional FACE)" t nil)
@@ -13284,12 +13619,8 @@ lower-case letters made case insensitive.
(autoload 'hi-lock-unface-buffer "hi-lock" "\
Remove highlighting of each match to REGEXP set by hi-lock.
-
-Interactively, prompt for REGEXP. Buffer-local history of inserted
-regexp's maintained. Will accept only regexps inserted by hi-lock
-interactive functions. (See `hi-lock-interactive-patterns'.)
-\\<minibuffer-local-must-match-map>Use \\[minibuffer-complete] to complete a partially typed regexp.
-\(See info node `Minibuffer History'.)
+Interactively, prompt for REGEXP, accepting only regexps
+previously inserted by hi-lock interactive functions.
\(fn REGEXP)" t nil)
@@ -13305,7 +13636,7 @@ be found in variable `hi-lock-interactive-patterns'.
;;;***
;;;### (autoloads (hide-ifdef-mode) "hideif" "progmodes/hideif.el"
-;;;;;; (20127 62865))
+;;;;;; (20588 4262 531841 0))
;;; Generated autoloads from progmodes/hideif.el
(autoload 'hide-ifdef-mode "hideif" "\
@@ -13349,11 +13680,11 @@ Several variables affect how the hiding is done:
;;;***
;;;### (autoloads (turn-off-hideshow hs-minor-mode) "hideshow" "progmodes/hideshow.el"
-;;;;;; (20172 54913))
+;;;;;; (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))) "\
-*Alist for initializing the hideshow variables for different modes.
+Alist for initializing the hideshow variables for different modes.
Each element has the form
(MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
@@ -13382,6 +13713,10 @@ whitespace. Case does not matter.")
(autoload 'hs-minor-mode "hideshow" "\
Minor mode to selectively hide/show code and comment blocks.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
+
When hideshow minor mode is on, the menu bar is augmented with hideshow
commands and the hideshow commands are enabled.
The value '(hs . t) is added to `buffer-invisibility-spec'.
@@ -13411,8 +13746,8 @@ Unconditionally turn off `hs-minor-mode'.
;;;;;; highlight-compare-buffers highlight-changes-rotate-faces
;;;;;; highlight-changes-previous-change highlight-changes-next-change
;;;;;; highlight-changes-remove-highlight highlight-changes-visible-mode
-;;;;;; highlight-changes-mode) "hilit-chg" "hilit-chg.el" (20164
-;;;;;; 60780))
+;;;;;; highlight-changes-mode) "hilit-chg" "hilit-chg.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from hilit-chg.el
(autoload 'highlight-changes-mode "hilit-chg" "\
@@ -13439,7 +13774,7 @@ buffer with the contents of a file
\(fn &optional ARG)" t nil)
(autoload 'highlight-changes-visible-mode "hilit-chg" "\
-Toggle visiblility of highlighting due to Highlight Changes mode.
+Toggle visibility of highlighting due to Highlight Changes mode.
With a prefix argument ARG, enable Highlight Changes Visible mode
if ARG is positive, and disable it otherwise. If called from
Lisp, enable the mode if ARG is omitted or nil.
@@ -13543,61 +13878,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" (20167 36967))
+;;;### (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
@@ -13615,12 +13899,12 @@ Construct a function similar to `hippie-expand'.
Make it use the expansion functions in TRY-LIST. An optional second
argument VERBOSE non-nil makes the function verbose.
-\(fn TRY-LIST &optional VERBOSE)" nil (quote macro))
+\(fn TRY-LIST &optional VERBOSE)" nil t)
;;;***
;;;### (autoloads (global-hl-line-mode hl-line-mode) "hl-line" "hl-line.el"
-;;;;;; (20127 62865))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from hl-line.el
(autoload 'hl-line-mode "hl-line" "\
@@ -13673,7 +13957,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" (20107 16822))
+;;;;;; "calendar/holidays.el" (20566 63671 243798 0))
;;; Generated autoloads from calendar/holidays.el
(define-obsolete-variable-alias 'general-holidays 'holiday-general-holidays "23.1")
@@ -13748,7 +14032,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.")
@@ -13768,8 +14052,8 @@ See the documentation for `calendar-holidays' for details.")
(define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1")
-(defvar holiday-bahai-holidays (mapcar 'purecopy '((holiday-bahai-new-year) (holiday-bahai-ridvan) (holiday-fixed 5 23 "Declaration of the Bab") (holiday-fixed 5 29 "Ascension of Baha'u'llah") (holiday-fixed 7 9 "Martyrdom of the Bab") (holiday-fixed 10 20 "Birth of the Bab") (holiday-fixed 11 12 "Birth of Baha'u'llah") (if calendar-bahai-all-holidays-flag (append (holiday-fixed 11 26 "Day of the Covenant") (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha"))))) "\
-Baha'i holidays.
+(defvar holiday-bahai-holidays (mapcar 'purecopy '((holiday-bahai-new-year) (holiday-bahai-ridvan) (holiday-fixed 5 23 "Declaration of the Báb") (holiday-fixed 5 29 "Ascension of Bahá'u'lláh") (holiday-fixed 7 9 "Martyrdom of the Báb") (holiday-fixed 10 20 "Birth of the Báb") (holiday-fixed 11 12 "Birth of Bahá'u'lláh") (if calendar-bahai-all-holidays-flag (append (holiday-fixed 11 26 "Day of the Covenant") (holiday-fixed 11 28 "Ascension of `Abdu'l-Bahá"))))) "\
+Bahá'í holidays.
See the documentation for `calendar-holidays' for details.")
(custom-autoload 'holiday-bahai-holidays "holidays" t)
@@ -13791,7 +14075,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)
@@ -13821,8 +14105,8 @@ The optional LABEL is used to label the buffer created.
;;;***
-;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (20164
-;;;;;; 60780))
+;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from gnus/html2text.el
(autoload 'html2text "html2text" "\
@@ -13833,7 +14117,7 @@ Convert HTML to plain text in the current buffer.
;;;***
;;;### (autoloads (htmlfontify-copy-and-link-dir htmlfontify-buffer)
-;;;;;; "htmlfontify" "htmlfontify.el" (20183 25152))
+;;;;;; "htmlfontify" "htmlfontify.el" (20614 54428 654267 0))
;;; Generated autoloads from htmlfontify.el
(autoload 'htmlfontify-buffer "htmlfontify" "\
@@ -13866,8 +14150,8 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'.
;;;***
;;;### (autoloads (define-ibuffer-filter define-ibuffer-op define-ibuffer-sorter
-;;;;;; define-ibuffer-column) "ibuf-macs" "ibuf-macs.el" (19845
-;;;;;; 45374))
+;;;;;; define-ibuffer-column) "ibuf-macs" "ibuf-macs.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from ibuf-macs.el
(autoload 'define-ibuffer-column "ibuf-macs" "\
@@ -13895,8 +14179,6 @@ change its definition, you should explicitly call
\(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil (quote macro))
-(put 'define-ibuffer-column 'lisp-indent-function 'defun)
-
(autoload 'define-ibuffer-sorter "ibuf-macs" "\
Define a method of sorting named NAME.
DOCUMENTATION is the documentation of the function, which will be called
@@ -13909,8 +14191,6 @@ value if and only if `a' is \"less than\" `b'.
\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil (quote macro))
-(put 'define-ibuffer-sorter 'lisp-indent-function '1)
-
(autoload 'define-ibuffer-op "ibuf-macs" "\
Generate a function which operates on a buffer.
OP becomes the name of the function; if it doesn't begin with
@@ -13944,8 +14224,6 @@ macro for exactly what it does.
\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)" nil (quote macro))
-(put 'define-ibuffer-op 'lisp-indent-function '2)
-
(autoload 'define-ibuffer-filter "ibuf-macs" "\
Define a filter named NAME.
DOCUMENTATION is the documentation of the function.
@@ -13959,12 +14237,10 @@ bound to the current value of the filter.
\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil (quote macro))
-(put 'define-ibuffer-filter 'lisp-indent-function '2)
-
;;;***
;;;### (autoloads (ibuffer ibuffer-other-window ibuffer-list-buffers)
-;;;;;; "ibuffer" "ibuffer.el" (20162 19074))
+;;;;;; "ibuffer" "ibuffer.el" (20576 13312 649004 817000))
;;; Generated autoloads from ibuffer.el
(autoload 'ibuffer-list-buffers "ibuffer" "\
@@ -14005,7 +14281,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" (20164 29468))
+;;;;;; "calendar/icalendar.el" (20593 22184 581574 0))
;;; Generated autoloads from calendar/icalendar.el
(autoload 'icalendar-export-file "icalendar" "\
@@ -14057,8 +14333,8 @@ buffer `*icalendar-errors*'.
;;;***
-;;;### (autoloads (icomplete-mode) "icomplete" "icomplete.el" (20127
-;;;;;; 62865))
+;;;### (autoloads (icomplete-mode) "icomplete" "icomplete.el" (20453
+;;;;;; 5437 764254 0))
;;; Generated autoloads from icomplete.el
(defvar icomplete-mode nil "\
@@ -14080,7 +14356,8 @@ the mode if ARG is omitted or nil.
;;;***
-;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (19890 42850))
+;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from progmodes/icon.el
(autoload 'icon-mode "icon" "\
@@ -14121,7 +14398,7 @@ with no args, if that value is non-nil.
;;;***
;;;### (autoloads (idlwave-shell) "idlw-shell" "progmodes/idlw-shell.el"
-;;;;;; (20178 7273))
+;;;;;; (20572 16038 402143 0))
;;; Generated autoloads from progmodes/idlw-shell.el
(autoload 'idlwave-shell "idlw-shell" "\
@@ -14147,7 +14424,7 @@ See also the variable `idlwave-shell-prompt-pattern'.
;;;***
;;;### (autoloads (idlwave-mode) "idlwave" "progmodes/idlwave.el"
-;;;;;; (20168 57844))
+;;;;;; (20576 42138 697312 0))
;;; Generated autoloads from progmodes/idlwave.el
(autoload 'idlwave-mode "idlwave" "\
@@ -14281,8 +14558,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" (20178
-;;;;;; 7273))
+;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (20590
+;;;;;; 45996 129575 0))
;;; Generated autoloads from ido.el
(defvar ido-mode nil "\
@@ -14326,8 +14603,7 @@ their normal keybindings, except for the following: \\<ido-buffer-completion-map
RET Select the buffer at the front of the list of matches. If the
list is empty, possibly prompt to create new buffer.
-\\[ido-select-text] Select the current prompt as the buffer.
-If no buffer is found, prompt for a new one.
+\\[ido-select-text] Use the current input string verbatim.
\\[ido-next-match] Put the first element at the end of the list.
\\[ido-prev-match] Put the last element at the start of the list.
@@ -14403,8 +14679,7 @@ except for the following: \\<ido-file-completion-map>
RET Select the file at the front of the list of matches. If the
list is empty, possibly prompt to create new file.
-\\[ido-select-text] Select the current prompt as the buffer or file.
-If no buffer or file is found, prompt for a new one.
+\\[ido-select-text] Use the current input string verbatim.
\\[ido-next-match] Put the first element at the end of the list.
\\[ido-prev-match] Put the last element at the start of the list.
@@ -14412,6 +14687,7 @@ If no buffer or file is found, prompt for a new one.
matches all files. If there is only one match, select that file.
If there is no common suffix, show a list of all matching files
in a separate window.
+\\[ido-magic-delete-char] Open the specified directory in Dired mode.
\\[ido-edit-input] Edit input string (including directory).
\\[ido-prev-work-directory] or \\[ido-next-work-directory] go to previous/next directory in work directory history.
\\[ido-merge-work-directories] search for file in the work directory history.
@@ -14423,7 +14699,6 @@ in a separate window.
\\[ido-toggle-regexp] Toggle regexp searching.
\\[ido-toggle-prefix] Toggle between substring and prefix matching.
\\[ido-toggle-case] Toggle case-sensitive searching of file names.
-\\[ido-toggle-vc] Toggle version control for this file.
\\[ido-toggle-literal] Toggle literal reading of this file.
\\[ido-completion-help] Show list of matching files in separate window.
\\[ido-toggle-ignore] Toggle ignoring files listed in `ido-ignore-files'.
@@ -14543,7 +14818,7 @@ DEF, if non-nil, is the default value.
;;;***
-;;;### (autoloads (ielm) "ielm" "ielm.el" (20077 56412))
+;;;### (autoloads (ielm) "ielm" "ielm.el" (20566 63671 243798 0))
;;; Generated autoloads from ielm.el
(autoload 'ielm "ielm" "\
@@ -14554,13 +14829,18 @@ Switches to the buffer `*ielm*', or creates it if it does not exist.
;;;***
-;;;### (autoloads (iimage-mode) "iimage" "iimage.el" (19845 45374))
+;;;### (autoloads (iimage-mode) "iimage" "iimage.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from iimage.el
(define-obsolete-function-alias 'turn-on-iimage-mode 'iimage-mode "24.1")
(autoload 'iimage-mode "iimage" "\
-Toggle inline image minor mode.
+Toggle Iimage mode on or off.
+With a prefix argument ARG, enable Iimage 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'.
+\\{iimage-mode-map}
\(fn &optional ARG)" t nil)
@@ -14571,7 +14851,7 @@ Toggle inline image minor mode.
;;;;;; 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"
-;;;;;; (20084 29660))
+;;;;;; (20613 59417 195100 163000))
;;; Generated autoloads from image.el
(autoload 'image-type-from-data "image" "\
@@ -14744,18 +15024,21 @@ Example:
(defimage test-image ((:type xpm :file \"~/test1.xpm\")
(:type xbm :file \"~/test1.xbm\")))
-\(fn SYMBOL SPECS &optional DOC)" nil (quote macro))
+\(fn SYMBOL SPECS &optional DOC)" nil t)
(put 'defimage 'doc-string-elt '3)
(autoload 'imagemagick-register-types "image" "\
Register file types that can be handled by ImageMagick.
-This adds the file types returned by `imagemagick-types'
-\(excluding the ones in `imagemagick-types-inhibit') to
-`auto-mode-alist' and `image-type-file-name-regexps', so that
-Emacs visits them in Image mode.
+This function is called at startup, after loading the init file.
+It registers the ImageMagick types returned by `imagemagick-filter-types'.
-If Emacs is compiled without ImageMagick support, do nothing.
+Registered image types are added to `auto-mode-alist', so that
+Emacs visits them in Image mode. They are also added to
+`image-type-file-name-regexps', so that the `image-type' function
+recognizes these files as having image type `imagemagick'.
+
+If Emacs is compiled without ImageMagick support, this does nothing.
\(fn)" nil nil)
@@ -14768,7 +15051,7 @@ If Emacs is compiled without ImageMagick support, do nothing.
;;;;;; image-dired-jump-thumbnail-buffer image-dired-delete-tag
;;;;;; image-dired-tag-files image-dired-show-all-from-dir image-dired-display-thumbs
;;;;;; image-dired-dired-with-window-configuration image-dired-dired-toggle-marked-thumbs)
-;;;;;; "image-dired" "image-dired.el" (20168 57844))
+;;;;;; "image-dired" "image-dired.el" (20478 3673 653810 0))
;;; Generated autoloads from image-dired.el
(autoload 'image-dired-dired-toggle-marked-thumbs "image-dired" "\
@@ -14906,7 +15189,7 @@ easy-to-use form.
;;;### (autoloads (auto-image-file-mode insert-image-file image-file-name-regexp
;;;;;; image-file-name-regexps image-file-name-extensions) "image-file"
-;;;;;; "image-file.el" (20127 62865))
+;;;;;; "image-file.el" (20355 10021 546955 0))
;;; Generated autoloads from image-file.el
(defvar image-file-name-extensions (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg")) "\
@@ -14969,7 +15252,8 @@ 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" (20160 63745))
+;;;;;; image-mode) "image-mode" "image-mode.el" (20580 10161 446444
+;;;;;; 0))
;;; Generated autoloads from image-mode.el
(autoload 'image-mode "image-mode" "\
@@ -15014,7 +15298,8 @@ on these modes.
;;;***
;;;### (autoloads (imenu imenu-add-menubar-index imenu-add-to-menubar
-;;;;;; imenu-sort-function) "imenu" "imenu.el" (19845 45374))
+;;;;;; imenu-sort-function) "imenu" "imenu.el" (20622 22438 32851
+;;;;;; 0))
;;; Generated autoloads from imenu.el
(defvar imenu-sort-function nil "\
@@ -15035,16 +15320,39 @@ element should come before the second. The arguments are cons cells;
(custom-autoload 'imenu-sort-function "imenu" t)
(defvar imenu-generic-expression nil "\
-The regex pattern to use for creating a buffer index.
+List of definition matchers for creating an Imenu index.
+Each element of this list should have the form
+
+ (MENU-TITLE REGEXP INDEX [FUNCTION] [ARGUMENTS...])
+
+MENU-TITLE should be nil (in which case the matches for this
+element are put in the top level of the buffer index) or a
+string (which specifies the title of a submenu into which the
+matches are put).
+REGEXP is a regular expression matching a definition construct
+which is to be displayed in the menu. REGEXP may also be a
+function, called without arguments. It is expected to search
+backwards. It must return true and set `match-data' if it finds
+another element.
+INDEX is an integer specifying which subexpression of REGEXP
+matches the definition's name; this subexpression is displayed as
+the menu item.
+FUNCTION, if present, specifies a function to call when the index
+item is selected by the user. This function is called with
+arguments consisting of the item name, the buffer position, and
+the ARGUMENTS.
+
+The variable `imenu-case-fold-search' determines whether or not
+the regexp matches are case sensitive, and `imenu-syntax-alist'
+can be used to alter the syntax table for the search.
If non-nil this pattern is passed to `imenu--generic-function' to
-create a buffer index. Look there for the documentation of this
-pattern's structure.
+create a buffer index.
-For example, see the value of `fortran-imenu-generic-expression' used by
-`fortran-mode' with `imenu-syntax-alist' set locally to give the
-characters which normally have \"symbol\" syntax \"word\" syntax
-during matching.")
+For example, see the value of `fortran-imenu-generic-expression'
+used by `fortran-mode' with `imenu-syntax-alist' set locally to
+give the characters which normally have \"symbol\" syntax
+\"word\" syntax during matching.")
(put 'imenu-generic-expression 'risky-local-variable t)
(make-variable-buffer-local 'imenu-generic-expression)
@@ -15131,7 +15439,7 @@ for more information.
;;;### (autoloads (indian-2-column-to-ucs-region in-is13194-pre-write-conversion
;;;;;; in-is13194-post-read-conversion indian-compose-string indian-compose-region)
-;;;;;; "ind-util" "language/ind-util.el" (20097 41737))
+;;;;;; "ind-util" "language/ind-util.el" (20355 10021 546955 0))
;;; Generated autoloads from language/ind-util.el
(autoload 'indian-compose-region "ind-util" "\
@@ -15161,56 +15469,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" (20168 57844))
+;;;### (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
@@ -15229,10 +15491,30 @@ of `inferior-lisp-program'). Runs the hooks from
;;;### (autoloads (info-display-manual Info-bookmark-jump Info-speedbar-browser
;;;;;; 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-manual
-;;;;;; info info-other-window) "info" "info.el" (20172 54913))
+;;;;;; Info-on-current-buffer info-standalone info-emacs-bug info-emacs-manual
+;;;;;; info info-other-window) "info" "info.el" (20623 43301 870757
+;;;;;; 0))
;;; Generated autoloads from info.el
+(defcustom Info-default-directory-list (let* ((config-dir (file-name-as-directory (or (and (featurep 'ns) (let ((dir (expand-file-name "../info" data-directory))) (if (file-directory-p dir) dir))) configure-info-directory))) (prefixes (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/"))) (suffixes '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/" "emacs/" "lib/" "lib/emacs/")) (standard-info-dirs (apply #'nconc (mapcar (lambda (pfx) (let ((dirs (mapcar (lambda (sfx) (concat pfx sfx "info/")) suffixes))) (prune-directory-list dirs))) prefixes))) (dirs (if (member config-dir standard-info-dirs) (nconc standard-info-dirs (list config-dir)) (cons config-dir standard-info-dirs)))) (if (not (eq system-type 'windows-nt)) dirs (let* ((instdir (file-name-directory invocation-directory)) (dir1 (expand-file-name "../info/" instdir)) (dir2 (expand-file-name "../../../info/" instdir))) (cond ((file-exists-p dir1) (append dirs (list dir1))) ((file-exists-p dir2) (append dirs (list dir2))) (t dirs))))) "\
+Default list of directories to search for Info documentation files.
+They are searched in the order they are given in the list.
+Therefore, the directory of Info files that come with Emacs
+normally should come last (so that local files override standard ones),
+unless Emacs is installed into a non-standard directory. In the latter
+case, the directory of Info files that come with Emacs should be
+first in this list.
+
+Once Info is started, the list of directories to search
+comes from the variable `Info-directory-list'.
+This variable `Info-default-directory-list' is used as the default
+for initializing `Info-directory-list' when Info is started, unless
+the environment variable INFOPATH is set.
+
+Although this is a customizable variable, that is mainly for technical
+reasons. Normally, you should either set INFOPATH or customize
+`Info-additional-directory-list', rather than changing this variable." :initialize (quote custom-initialize-delay) :type (quote (repeat directory)) :group (quote info))
+
(autoload 'info-other-window "info" "\
Like `info' but show the Info buffer in another window.
@@ -15268,6 +15550,11 @@ Display the Emacs manual in Info mode.
\(fn)" t nil)
+(autoload 'info-emacs-bug "info" "\
+Display the \"Reporting Bugs\" section of the Emacs manual in Info mode.
+
+\(fn)" t nil)
+
(autoload 'info-standalone "info" "\
Run Emacs as a standalone Info reader.
Usage: emacs -f info-standalone [filename]
@@ -15416,7 +15703,7 @@ Go to Info buffer that displays MANUAL, creating it if none already exists.
;;;### (autoloads (info-complete-file info-complete-symbol info-lookup-file
;;;;;; info-lookup-symbol info-lookup-reset) "info-look" "info-look.el"
-;;;;;; (19984 16846))
+;;;;;; (20474 44971 970015 0))
;;; Generated autoloads from info-look.el
(autoload 'info-lookup-reset "info-look" "\
@@ -15465,7 +15752,7 @@ Perform completion on file preceding point.
;;;### (autoloads (info-xref-docstrings info-xref-check-all-custom
;;;;;; info-xref-check-all info-xref-check) "info-xref" "info-xref.el"
-;;;;;; (20168 57844))
+;;;;;; (20476 31768 298871 0))
;;; Generated autoloads from info-xref.el
(autoload 'info-xref-check "info-xref" "\
@@ -15548,7 +15835,8 @@ the sources handy.
;;;***
;;;### (autoloads (batch-info-validate Info-validate Info-split Info-split-threshold
-;;;;;; Info-tagify) "informat" "informat.el" (19886 45771))
+;;;;;; Info-tagify) "informat" "informat.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from informat.el
(autoload 'Info-tagify "informat" "\
@@ -15593,9 +15881,21 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"
;;;***
+;;;### (autoloads (inversion-require-emacs) "inversion" "cedet/inversion.el"
+;;;;;; (20590 45996 129575 0))
+;;; Generated autoloads from cedet/inversion.el
+
+(autoload 'inversion-require-emacs "inversion" "\
+Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver.
+Only checks one based on which kind of Emacs is being run.
+
+\(fn EMACS-VER XEMACS-VER SXEMACS-VER)" nil nil)
+
+;;;***
+
;;;### (autoloads (isearch-process-search-multibyte-characters isearch-toggle-input-method
;;;;;; isearch-toggle-specified-input-method) "isearch-x" "international/isearch-x.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from international/isearch-x.el
(autoload 'isearch-toggle-specified-input-method "isearch-x" "\
@@ -15615,8 +15915,8 @@ Toggle input method in interactive search.
;;;***
-;;;### (autoloads (isearchb-activate) "isearchb" "isearchb.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (isearchb-activate) "isearchb" "isearchb.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from isearchb.el
(autoload 'isearchb-activate "isearchb" "\
@@ -15632,7 +15932,7 @@ accessed via isearchb.
;;;### (autoloads (iso-cvt-define-menu iso-cvt-write-only iso-cvt-read-only
;;;;;; iso-sgml2iso iso-iso2sgml iso-iso2duden iso-iso2gtex iso-gtex2iso
;;;;;; iso-tex2iso iso-iso2tex iso-german iso-spanish) "iso-cvt"
-;;;;;; "international/iso-cvt.el" (19845 45374))
+;;;;;; "international/iso-cvt.el" (20355 10021 546955 0))
;;; Generated autoloads from international/iso-cvt.el
(autoload 'iso-spanish "iso-cvt" "\
@@ -15723,9 +16023,8 @@ Add submenus to the File menu, to convert to and from various formats.
;;;***
;;;### (autoloads nil "iso-transl" "international/iso-transl.el"
-;;;;;; (19845 45374))
+;;;;;; (20486 36135 22104 0))
;;; Generated autoloads from international/iso-transl.el
- (or key-translation-map (setq key-translation-map (make-sparse-keymap)))
(define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map)
(autoload 'iso-transl-ctl-x-8-map "iso-transl" "Keymap for C-x 8 prefix." t 'keymap)
@@ -15735,13 +16034,13 @@ 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" (20178 7273))
+;;;;;; "ispell" "textmodes/ispell.el" (20601 16294 451653 0))
;;; Generated autoloads from textmodes/ispell.el
(put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive))))
(defvar ispell-personal-dictionary nil "\
-*File name of your personal spelling dictionary, or nil.
+File name of your personal spelling dictionary, or nil.
If nil, the default personal dictionary, (\"~/.ispell_DICTNAME\" for ispell or
\"~/.aspell.LANG.pws\" for aspell) is used, where DICTNAME is the name of your
default dictionary and LANG the two letter language code.")
@@ -15760,7 +16059,7 @@ and added as a submenu of the \"Edit\" menu.")
(defvar ispell-menu-map-needed (and (not ispell-menu-map) (not (featurep 'xemacs)) 'reload))
-(if ispell-menu-map-needed (progn (setq ispell-menu-map (make-sparse-keymap "Spell")) (define-key ispell-menu-map [ispell-change-dictionary] `(menu-item ,(purecopy "Change Dictionary...") ispell-change-dictionary :help ,(purecopy "Supply explicit dictionary file name"))) (define-key ispell-menu-map [ispell-kill-ispell] `(menu-item ,(purecopy "Kill Process") ispell-kill-ispell :enable (and (boundp 'ispell-process) ispell-process (eq (ispell-process-status) 'run)) :help ,(purecopy "Terminate Ispell subprocess"))) (define-key ispell-menu-map [ispell-pdict-save] `(menu-item ,(purecopy "Save Dictionary") (lambda nil (interactive) (ispell-pdict-save t t)) :help ,(purecopy "Save personal dictionary"))) (define-key ispell-menu-map [ispell-customize] `(menu-item ,(purecopy "Customize...") (lambda nil (interactive) (customize-group 'ispell)) :help ,(purecopy "Customize spell checking options"))) (define-key ispell-menu-map [ispell-help] `(menu-item ,(purecopy "Help") (lambda nil (interactive) (describe-function 'ispell-help)) :help ,(purecopy "Show standard Ispell keybindings and commands"))) (define-key ispell-menu-map [flyspell-mode] `(menu-item ,(purecopy "Automatic spell checking (Flyspell)") flyspell-mode :help ,(purecopy "Check spelling while you edit the text") :button (:toggle bound-and-true-p flyspell-mode))) (define-key ispell-menu-map [ispell-complete-word] `(menu-item ,(purecopy "Complete Word") ispell-complete-word :help ,(purecopy "Complete word at cursor using dictionary"))) (define-key ispell-menu-map [ispell-complete-word-interior-frag] `(menu-item ,(purecopy "Complete Word Fragment") ispell-complete-word-interior-frag :help ,(purecopy "Complete word fragment at cursor")))))
+(if ispell-menu-map-needed (progn (setq ispell-menu-map (make-sparse-keymap "Spell")) (define-key ispell-menu-map [ispell-change-dictionary] `(menu-item ,(purecopy "Change Dictionary...") ispell-change-dictionary :help ,(purecopy "Supply explicit dictionary file name"))) (define-key ispell-menu-map [ispell-kill-ispell] `(menu-item ,(purecopy "Kill Process") (lambda nil (interactive) (ispell-kill-ispell nil 'clear)) :enable (and (boundp 'ispell-process) ispell-process (eq (ispell-process-status) 'run)) :help ,(purecopy "Terminate Ispell subprocess"))) (define-key ispell-menu-map [ispell-pdict-save] `(menu-item ,(purecopy "Save Dictionary") (lambda nil (interactive) (ispell-pdict-save t t)) :help ,(purecopy "Save personal dictionary"))) (define-key ispell-menu-map [ispell-customize] `(menu-item ,(purecopy "Customize...") (lambda nil (interactive) (customize-group 'ispell)) :help ,(purecopy "Customize spell checking options"))) (define-key ispell-menu-map [ispell-help] `(menu-item ,(purecopy "Help") (lambda nil (interactive) (describe-function 'ispell-help)) :help ,(purecopy "Show standard Ispell keybindings and commands"))) (define-key ispell-menu-map [flyspell-mode] `(menu-item ,(purecopy "Automatic spell checking (Flyspell)") flyspell-mode :help ,(purecopy "Check spelling while you edit the text") :button (:toggle bound-and-true-p flyspell-mode))) (define-key ispell-menu-map [ispell-complete-word] `(menu-item ,(purecopy "Complete Word") ispell-complete-word :help ,(purecopy "Complete word at cursor using dictionary"))) (define-key ispell-menu-map [ispell-complete-word-interior-frag] `(menu-item ,(purecopy "Complete Word Fragment") ispell-complete-word-interior-frag :help ,(purecopy "Complete word fragment at cursor")))))
(if ispell-menu-map-needed (progn (define-key ispell-menu-map [ispell-continue] `(menu-item ,(purecopy "Continue Spell-Checking") ispell-continue :enable (and (boundp 'ispell-region-end) (marker-position ispell-region-end) (equal (marker-buffer ispell-region-end) (current-buffer))) :help ,(purecopy "Continue spell checking last region"))) (define-key ispell-menu-map [ispell-word] `(menu-item ,(purecopy "Spell-Check Word") ispell-word :help ,(purecopy "Spell-check word at cursor"))) (define-key ispell-menu-map [ispell-comments-and-strings] `(menu-item ,(purecopy "Spell-Check Comments") ispell-comments-and-strings :help ,(purecopy "Spell-check only comments and strings")))))
@@ -15776,7 +16075,7 @@ Valid forms include:
(KEY FUNCTION ARGS) - FUNCTION called with ARGS returns end of region.")
(defvar ispell-tex-skip-alists (purecopy '((("\\\\addcontentsline" ispell-tex-arg-end 2) ("\\\\add\\(tocontents\\|vspace\\)" ispell-tex-arg-end) ("\\\\\\([aA]lph\\|arabic\\)" ispell-tex-arg-end) ("\\\\bibliographystyle" ispell-tex-arg-end) ("\\\\makebox" ispell-tex-arg-end 0) ("\\\\e?psfig" ispell-tex-arg-end) ("\\\\document\\(class\\|style\\)" . "\\\\begin[ \n]*{[ \n]*document[ \n]*}")) (("\\(figure\\|table\\)\\*?" ispell-tex-arg-end 0) ("list" ispell-tex-arg-end 2) ("program" . "\\\\end[ \n]*{[ \n]*program[ \n]*}") ("verbatim\\*?" . "\\\\end[ \n]*{[ \n]*verbatim\\*?[ \n]*}")))) "\
-*Lists of regions to be skipped in TeX mode.
+Lists of regions to be skipped in TeX mode.
First list is used raw.
Second list has key placed inside \\begin{}.
@@ -15784,7 +16083,7 @@ Delete or add any regions you want to be automatically selected
for skipping in latex mode.")
(defconst ispell-html-skip-alists '(("<[cC][oO][dD][eE]\\>[^>]*>" "</[cC][oO][dD][eE]*>") ("<[sS][cC][rR][iI][pP][tT]\\>[^>]*>" "</[sS][cC][rR][iI][pP][tT]>") ("<[aA][pP][pP][lL][eE][tT]\\>[^>]*>" "</[aA][pP][pP][lL][eE][tT]>") ("<[vV][eE][rR][bB]\\>[^>]*>" "<[vV][eE][rR][bB]\\>[^>]*>") ("<[tT][tT]/" "/") ("<[^ \n>]" ">") ("&[^ \n;]" "[; \n]")) "\
-*Lists of start and end keys to skip in HTML buffers.
+Lists of start and end keys to skip in HTML buffers.
Same format as `ispell-skip-region-alist'.
Note - substrings of other matches must come last
(e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").")
@@ -15858,8 +16157,9 @@ SPC: Accept word this time.
(autoload 'ispell-kill-ispell "ispell" "\
Kill current Ispell process (so that you may start a fresh one).
With NO-ERROR, just return non-nil if there was no Ispell running.
+With CLEAR, buffer session localwords are cleaned.
-\(fn &optional NO-ERROR)" t nil)
+\(fn &optional NO-ERROR CLEAR)" t nil)
(autoload 'ispell-change-dictionary "ispell" "\
Change to dictionary DICT for Ispell.
@@ -15872,8 +16172,8 @@ By just answering RET you can find out what the current dictionary is.
(autoload 'ispell-region "ispell" "\
Interactively check a region for spelling errors.
-Return nil if spell session is quit,
- otherwise returns shift offset amount for last line processed.
+Return nil if spell session was terminated, otherwise returns shift offset
+amount for last line processed.
\(fn REG-START REG-END &optional RECHECKP SHIFT)" t nil)
@@ -15924,7 +16224,7 @@ With a prefix argument ARG, enable Ispell minor mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-Ispell minor mode is a buffer-local mior mode. When enabled,
+Ispell minor mode is a buffer-local minor mode. When enabled,
typing SPC or RET warns you if the previous word is incorrectly
spelled.
@@ -15944,10 +16244,10 @@ Don't check included messages.
To abort spell checking of a message region and send the message anyway,
use the `x' command. (Any subsequent regions will be checked.)
-The `X' command aborts the message send so that you can edit the buffer.
+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)
@@ -15961,8 +16261,8 @@ You can bind this to the key C-c i in GNUS or mail by adding to
;;;***
-;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (20168
-;;;;;; 57844))
+;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (20577
+;;;;;; 33959 40183 0))
;;; Generated autoloads from iswitchb.el
(defvar iswitchb-mode nil "\
@@ -15990,7 +16290,8 @@ between buffers using substrings. See `iswitchb' for details.
;;;### (autoloads (read-hiragana-string japanese-zenkaku-region japanese-hankaku-region
;;;;;; japanese-hiragana-region japanese-katakana-region japanese-zenkaku
;;;;;; japanese-hankaku japanese-hiragana japanese-katakana setup-japanese-environment-internal)
-;;;;;; "japan-util" "language/japan-util.el" (19845 45374))
+;;;;;; "japan-util" "language/japan-util.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from language/japan-util.el
(autoload 'setup-japanese-environment-internal "japan-util" "\
@@ -16068,7 +16369,7 @@ If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
;;;***
;;;### (autoloads (jka-compr-uninstall jka-compr-handler) "jka-compr"
-;;;;;; "jka-compr.el" (20000 30139))
+;;;;;; "jka-compr.el" (20355 10021 546955 0))
;;; Generated autoloads from jka-compr.el
(defvar jka-compr-inhibit nil "\
@@ -16084,14 +16385,15 @@ It is not recommended to set this variable permanently to anything but nil.")
(autoload 'jka-compr-uninstall "jka-compr" "\
Uninstall jka-compr.
This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
-and `inhibit-first-line-modes-suffixes' that were added
+and `inhibit-local-variables-suffixes' that were added
by `jka-compr-installed'.
\(fn)" nil nil)
;;;***
-;;;### (autoloads (js-mode) "js" "progmodes/js.el" (20167 36967))
+;;;### (autoloads (js-mode) "js" "progmodes/js.el" (20532 45476 981297
+;;;;;; 0))
;;; Generated autoloads from progmodes/js.el
(autoload 'js-mode "js" "\
@@ -16105,7 +16407,7 @@ Major mode for editing JavaScript.
;;;### (autoloads (keypad-setup keypad-numlock-shifted-setup keypad-shifted-setup
;;;;;; keypad-numlock-setup keypad-setup) "keypad" "emulation/keypad.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emulation/keypad.el
(defvar keypad-setup nil "\
@@ -16161,7 +16463,7 @@ the decimal key on the keypad is mapped to DECIMAL instead of `.'
;;;***
;;;### (autoloads (kinsoku) "kinsoku" "international/kinsoku.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from international/kinsoku.el
(autoload 'kinsoku "kinsoku" "\
@@ -16182,8 +16484,8 @@ the context of text formatting.
;;;***
-;;;### (autoloads (kkc-region) "kkc" "international/kkc.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (kkc-region) "kkc" "international/kkc.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from international/kkc.el
(defvar kkc-after-update-conversion-functions nil "\
@@ -16208,7 +16510,7 @@ and the return value is the length of the conversion.
;;;### (autoloads (kmacro-end-call-mouse kmacro-end-and-call-macro
;;;;;; kmacro-end-or-call-macro kmacro-start-macro-or-insert-counter
;;;;;; kmacro-call-macro kmacro-end-macro kmacro-start-macro kmacro-exec-ring-item)
-;;;;;; "kmacro" "kmacro.el" (20164 60780))
+;;;;;; "kmacro" "kmacro.el" (20471 22929 875294 592000))
;;; Generated autoloads from kmacro.el
(global-set-key "\C-x(" 'kmacro-start-macro)
(global-set-key "\C-x)" 'kmacro-end-macro)
@@ -16319,11 +16621,11 @@ If kbd macro currently being defined end it before activating it.
;;;***
;;;### (autoloads (setup-korean-environment-internal) "korea-util"
-;;;;;; "language/korea-util.el" (19845 45374))
+;;;;;; "language/korea-util.el" (20501 3499 284800 0))
;;; Generated autoloads from language/korea-util.el
(defvar default-korean-keyboard (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\
-*The kind of Korean keyboard for Korean input method.
+The kind of Korean keyboard for Korean input method.
\"\" for 2, \"3\" for 3.")
(autoload 'setup-korean-environment-internal "korea-util" "\
@@ -16334,7 +16636,7 @@ If kbd macro currently being defined end it before activating it.
;;;***
;;;### (autoloads (landmark landmark-test-run) "landmark" "play/landmark.el"
-;;;;;; (20178 7273))
+;;;;;; (20545 57511 257469 0))
;;; Generated autoloads from play/landmark.el
(defalias 'landmark-repeat 'landmark-test-run)
@@ -16366,7 +16668,7 @@ Use \\[describe-mode] for more info.
;;;### (autoloads (lao-compose-region lao-composition-function lao-transcribe-roman-to-lao-string
;;;;;; lao-transcribe-single-roman-syllable-to-lao lao-compose-string)
-;;;;;; "lao-util" "language/lao-util.el" (20165 31925))
+;;;;;; "lao-util" "language/lao-util.el" (20355 10021 546955 0))
;;; Generated autoloads from language/lao-util.el
(autoload 'lao-compose-string "lao-util" "\
@@ -16378,7 +16680,7 @@ Use \\[describe-mode] for more info.
Transcribe a Romanized Lao syllable in the region FROM and TO to Lao string.
Only the first syllable is transcribed.
The value has the form: (START END LAO-STRING), where
-START and END are the beggining and end positions of the Roman Lao syllable,
+START and END are the beginning and end positions of the Roman Lao syllable,
LAO-STRING is the Lao character transcription of it.
Optional 3rd arg STR, if non-nil, is a string to search for Roman Lao
@@ -16405,7 +16707,8 @@ Transcribe Romanized Lao string STR to Lao character string.
;;;### (autoloads (latexenc-find-file-coding-system latexenc-coding-system-to-inputenc
;;;;;; latexenc-inputenc-to-coding-system latex-inputenc-coding-alist)
-;;;;;; "latexenc" "international/latexenc.el" (19845 45374))
+;;;;;; "latexenc" "international/latexenc.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from international/latexenc.el
(defvar latex-inputenc-coding-alist (purecopy '(("ansinew" . windows-1252) ("applemac" . mac-roman) ("ascii" . us-ascii) ("cp1250" . windows-1250) ("cp1252" . windows-1252) ("cp1257" . cp1257) ("cp437de" . cp437) ("cp437" . cp437) ("cp850" . cp850) ("cp852" . cp852) ("cp858" . cp858) ("cp865" . cp865) ("latin1" . iso-8859-1) ("latin2" . iso-8859-2) ("latin3" . iso-8859-3) ("latin4" . iso-8859-4) ("latin5" . iso-8859-5) ("latin9" . iso-8859-15) ("next" . next) ("utf8" . utf-8) ("utf8x" . utf-8))) "\
@@ -16437,7 +16740,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" (19845 45374))
+;;;;;; "latin1-disp" "international/latin1-disp.el" (20577 33959
+;;;;;; 40183 0))
;;; Generated autoloads from international/latin1-disp.el
(defvar latin1-display nil "\
@@ -16479,7 +16783,7 @@ use either \\[customize] or the function `latin1-display'.")
;;;***
;;;### (autoloads (ld-script-mode) "ld-script" "progmodes/ld-script.el"
-;;;;;; (19961 55377))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from progmodes/ld-script.el
(autoload 'ld-script-mode "ld-script" "\
@@ -16489,43 +16793,8 @@ A major mode to edit GNU ld script files
;;;***
-;;;### (autoloads (ledit-from-lisp-mode ledit-mode) "ledit" "ledit.el"
-;;;;;; (19845 45374))
-;;; Generated autoloads from ledit.el
-
-(defconst ledit-save-files t "\
-*Non-nil means Ledit should save files before transferring to Lisp.")
-
-(defconst ledit-go-to-lisp-string "%?lisp" "\
-*Shell commands to execute to resume Lisp job.")
-
-(defconst ledit-go-to-liszt-string "%?liszt" "\
-*Shell commands to execute to resume Lisp compiler job.")
-
-(autoload 'ledit-mode "ledit" "\
-\\<ledit-mode-map>Major mode for editing text and stuffing it to a Lisp job.
-Like Lisp mode, plus these special commands:
- \\[ledit-save-defun] -- record defun at or after point
- for later transmission to Lisp job.
- \\[ledit-save-region] -- record region for later transmission to Lisp job.
- \\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text.
- \\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job
- and transmit saved text.
-
-\\{ledit-mode-map}
-To make Lisp mode automatically change to Ledit mode,
-do (setq lisp-mode-hook 'ledit-from-lisp-mode)
-
-\(fn)" t nil)
-
-(autoload 'ledit-from-lisp-mode "ledit" "\
-
-
-\(fn)" nil nil)
-
-;;;***
-
-;;;### (autoloads (life) "life" "play/life.el" (19845 45374))
+;;;### (autoloads (life) "life" "play/life.el" (20545 57511 257469
+;;;;;; 0))
;;; Generated autoloads from play/life.el
(autoload 'life "life" "\
@@ -16538,19 +16807,10 @@ generations (this defaults to 1).
;;;***
-;;;### (autoloads (global-linum-mode linum-mode linum-format) "linum"
-;;;;;; "linum.el" (20127 62865))
+;;;### (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,
@@ -16584,8 +16844,8 @@ See `linum-mode' for more information on Linum mode.
;;;***
-;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (20168
-;;;;;; 57844))
+;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (20476
+;;;;;; 31768 298871 0))
;;; Generated autoloads from loadhist.el
(autoload 'unload-feature "loadhist" "\
@@ -16617,7 +16877,7 @@ something strange, such as redefining an Emacs function.
;;;***
;;;### (autoloads (locate-with-filter locate locate-ls-subdir-switches)
-;;;;;; "locate" "locate.el" (19886 45771))
+;;;;;; "locate" "locate.el" (20566 63671 243798 0))
;;; Generated autoloads from locate.el
(defvar locate-ls-subdir-switches (purecopy "-al") "\
@@ -16669,35 +16929,40 @@ except that FILTER is not optional.
;;;***
-;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (20138 33157))
+;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (20586 48936
+;;;;;; 135199 0))
;;; Generated autoloads from vc/log-edit.el
(autoload 'log-edit "log-edit" "\
Setup a buffer to enter a log message.
-\\<log-edit-mode-map>The buffer will be put in mode MODE or `log-edit-mode'
-if MODE is nil.
-If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run.
-Mark and point will be set around the entire contents of the buffer so
-that it is easy to kill the contents of the buffer with \\[kill-region].
-Once you're done editing the message, pressing \\[log-edit-done] will call
-`log-edit-done' which will end up calling CALLBACK to do the actual commit.
-
-PARAMS if non-nil is an alist. Possible keys and associated values:
+The buffer is put in mode MODE or `log-edit-mode' if MODE is nil.
+\\<log-edit-mode-map>
+If SETUP is non-nil, erase the buffer and run `log-edit-hook'.
+Set mark and point around the entire contents of the buffer, so
+that it is easy to kill the contents of the buffer with
+\\[kill-region]. Once the user is done editing the message,
+invoking the command \\[log-edit-done] (`log-edit-done') will
+call CALLBACK to do the actual commit.
+
+PARAMS if non-nil is an alist of variables and buffer-local
+values to give them in the Log Edit buffer. Possible keys and
+associated values:
`log-edit-listfun' -- function taking no arguments that returns the list of
files that are concerned by the current operation (using relative names);
`log-edit-diff-function' -- function taking no arguments that
displays a diff of the files concerned by the current operation.
+ `vc-log-fileset' -- the VC fileset to be committed (if any).
-If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the
-log message and go back to the current buffer when done. Otherwise, it
-uses the current buffer.
+If BUFFER is non-nil `log-edit' will jump to that buffer, use it
+to edit the log message and go back to the current buffer when
+done. Otherwise, it uses the current buffer.
\(fn CALLBACK &optional SETUP PARAMS BUFFER MODE &rest IGNORE)" nil nil)
;;;***
-;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (19946
-;;;;;; 1612))
+;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (20515
+;;;;;; 36389 544939 0))
;;; Generated autoloads from vc/log-view.el
(autoload 'log-view-mode "log-view" "\
@@ -16707,8 +16972,8 @@ Major mode for browsing CVS log output.
;;;***
-;;;### (autoloads (longlines-mode) "longlines" "longlines.el" (20127
-;;;;;; 62865))
+;;;### (autoloads (longlines-mode) "longlines" "longlines.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from longlines.el
(autoload 'longlines-mode "longlines" "\
@@ -16734,8 +16999,8 @@ newlines are indicated with a symbol.
;;;***
;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer
-;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (20174
-;;;;;; 10230))
+;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (20476
+;;;;;; 31768 298871 0))
;;; Generated autoloads from lpr.el
(defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)) "\
@@ -16831,7 +17096,7 @@ for further customization of the printer command.
;;;***
;;;### (autoloads (ls-lisp-support-shell-wildcards) "ls-lisp" "ls-lisp.el"
-;;;;;; (19886 45771))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from ls-lisp.el
(defvar ls-lisp-support-shell-wildcards t "\
@@ -16842,14 +17107,14 @@ Otherwise they are treated as Emacs regexps (for backward compatibility).")
;;;***
-;;;### (autoloads (lunar-phases) "lunar" "calendar/lunar.el" (19845
-;;;;;; 45374))
+;;;### (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)
@@ -16857,8 +17122,8 @@ This function is suitable for execution in a .emacs file.
;;;***
-;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/m4-mode.el
(autoload 'm4-mode "m4-mode" "\
@@ -16868,22 +17133,9 @@ A major mode to edit m4 macro files.
;;;***
-;;;### (autoloads (macroexpand-all) "macroexp" "emacs-lisp/macroexp.el"
-;;;;;; (19930 13389))
-;;; 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" (19886 45771))
+;;;;;; name-last-kbd-macro) "macros" "macros.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from macros.el
(autoload 'name-last-kbd-macro "macros" "\
@@ -16972,7 +17224,7 @@ and then select the region of un-tablified names and use
;;;***
;;;### (autoloads (what-domain mail-extract-address-components) "mail-extr"
-;;;;;; "mail/mail-extr.el" (20160 63745))
+;;;;;; "mail/mail-extr.el" (20355 10021 546955 0))
;;; Generated autoloads from mail/mail-extr.el
(autoload 'mail-extract-address-components "mail-extr" "\
@@ -17004,7 +17256,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"
-;;;;;; (19845 45374))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from mail/mail-hist.el
(autoload 'mail-hist-define-keys "mail-hist" "\
@@ -17018,7 +17270,7 @@ Define keys for accessing mail header history. For use in hooks.
\(fn)" nil nil)
(defvar mail-hist-keep-history t "\
-*Non-nil means keep a history for headers and text of outgoing mail.")
+Non-nil means keep a history for headers and text of outgoing mail.")
(custom-autoload 'mail-hist-keep-history "mail-hist" t)
@@ -17036,7 +17288,7 @@ This function normally would be called when the message is sent.
;;;### (autoloads (mail-fetch-field mail-unquote-printable-region
;;;;;; mail-unquote-printable mail-quote-printable-region mail-quote-printable
;;;;;; mail-file-babyl-p mail-dont-reply-to-names mail-use-rfc822)
-;;;;;; "mail-utils" "mail/mail-utils.el" (19922 19303))
+;;;;;; "mail-utils" "mail/mail-utils.el" (20355 10021 546955 0))
;;; Generated autoloads from mail/mail-utils.el
(defvar mail-use-rfc822 nil "\
@@ -17062,7 +17314,10 @@ Return non-nil if FILE is a Babyl file.
\(fn FILE)" nil nil)
(autoload 'mail-quote-printable "mail-utils" "\
-Convert a string to the \"quoted printable\" Q encoding.
+Convert a string to the \"quoted printable\" Q encoding if necessary.
+If the string contains only ASCII characters and no troublesome ones,
+we return it unconverted.
+
If the optional argument WRAPPER is non-nil,
we add the wrapper characters =?ISO-8859-1?Q?....?=.
@@ -17108,8 +17363,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" (20127
-;;;;;; 62865))
+;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from mail/mailabbrev.el
(defvar mail-abbrevs-mode nil "\
@@ -17160,7 +17415,7 @@ double-quotes.
;;;### (autoloads (mail-complete mail-completion-at-point-function
;;;;;; define-mail-alias expand-mail-aliases mail-complete-style)
-;;;;;; "mailalias" "mail/mailalias.el" (19881 27850))
+;;;;;; "mailalias" "mail/mailalias.el" (20577 33959 40183 0))
;;; Generated autoloads from mail/mailalias.el
(defvar mail-complete-style 'angles "\
@@ -17209,10 +17464,12 @@ 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"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mail/mailclient.el
(autoload 'mailclient-send-it "mailclient" "\
@@ -17226,7 +17483,8 @@ The mail client is taken to be the handler of mailto URLs.
;;;### (autoloads (makefile-imake-mode makefile-bsdmake-mode makefile-makepp-mode
;;;;;; makefile-gmake-mode makefile-automake-mode makefile-mode)
-;;;;;; "make-mode" "progmodes/make-mode.el" (20176 51947))
+;;;;;; "make-mode" "progmodes/make-mode.el" (20392 30149 675975
+;;;;;; 59000))
;;; Generated autoloads from progmodes/make-mode.el
(autoload 'makefile-mode "make-mode" "\
@@ -17343,8 +17601,8 @@ An adapted `makefile-mode' that knows about imake.
;;;***
-;;;### (autoloads (make-command-summary) "makesum" "makesum.el" (19886
-;;;;;; 45771))
+;;;### (autoloads (make-command-summary) "makesum" "makesum.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from makesum.el
(autoload 'make-command-summary "makesum" "\
@@ -17356,7 +17614,7 @@ Previous contents of that buffer are killed first.
;;;***
;;;### (autoloads (Man-bookmark-jump man-follow man) "man" "man.el"
-;;;;;; (20178 7273))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from man.el
(defalias 'manual-entry 'man)
@@ -17410,7 +17668,8 @@ Default bookmark handler for Man buffers.
;;;***
-;;;### (autoloads (master-mode) "master" "master.el" (20127 62865))
+;;;### (autoloads (master-mode) "master" "master.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from master.el
(autoload 'master-mode "master" "\
@@ -17433,7 +17692,7 @@ yourself the value of `master-of' by calling `master-show-slave'.
;;;***
;;;### (autoloads (minibuffer-depth-indicate-mode) "mb-depth" "mb-depth.el"
-;;;;;; (20127 62865))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mb-depth.el
(defvar minibuffer-depth-indicate-mode nil "\
@@ -17466,7 +17725,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" (20183 25152))
+;;;;;; "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)
@@ -17632,7 +17891,7 @@ which specify the range to operate on.
;;;***
;;;### (autoloads (metapost-mode metafont-mode) "meta-mode" "progmodes/meta-mode.el"
-;;;;;; (20164 60780))
+;;;;;; (20399 35365 4050 0))
;;; Generated autoloads from progmodes/meta-mode.el
(autoload 'metafont-mode "meta-mode" "\
@@ -17649,7 +17908,7 @@ Major mode for editing MetaPost sources.
;;;### (autoloads (metamail-region metamail-buffer metamail-interpret-body
;;;;;; metamail-interpret-header) "metamail" "mail/metamail.el"
-;;;;;; (20168 57844))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mail/metamail.el
(autoload 'metamail-interpret-header "metamail" "\
@@ -17694,7 +17953,7 @@ redisplayed as output is inserted.
;;;### (autoloads (mh-fully-kill-draft mh-send-letter mh-user-agent-compose
;;;;;; mh-smail-batch mh-smail-other-window mh-smail) "mh-comp"
-;;;;;; "mh-e/mh-comp.el" (20160 63745))
+;;;;;; "mh-e/mh-comp.el" (20355 10021 546955 0))
;;; Generated autoloads from mh-e/mh-comp.el
(autoload 'mh-smail "mh-comp" "\
@@ -17784,7 +18043,8 @@ delete the draft message.
;;;***
-;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (20170 13157))
+;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (20614 54428
+;;;;;; 654267 0))
;;; Generated autoloads from mh-e/mh-e.el
(put 'mh-progs 'risky-local-variable t)
@@ -17801,7 +18061,7 @@ Display version information about MH-E and the MH mail handling system.
;;;***
;;;### (autoloads (mh-folder-mode mh-nmail mh-rmail) "mh-folder"
-;;;;;; "mh-e/mh-folder.el" (20004 2139))
+;;;;;; "mh-e/mh-folder.el" (20371 55972 331861 0))
;;; Generated autoloads from mh-e/mh-folder.el
(autoload 'mh-rmail "mh-folder" "\
@@ -17883,7 +18143,7 @@ perform the operation on all messages in that region.
;;;***
;;;### (autoloads (midnight-delay-set clean-buffer-list) "midnight"
-;;;;;; "midnight.el" (19853 59245))
+;;;;;; "midnight.el" (20478 3673 653810 0))
;;; Generated autoloads from midnight.el
(autoload 'clean-buffer-list "midnight" "\
@@ -17910,7 +18170,7 @@ to its second argument TM.
;;;***
;;;### (autoloads (minibuffer-electric-default-mode) "minibuf-eldef"
-;;;;;; "minibuf-eldef.el" (20127 62865))
+;;;;;; "minibuf-eldef.el" (20580 10161 446444 0))
;;; Generated autoloads from minibuf-eldef.el
(defvar minibuffer-electric-default-mode nil "\
@@ -17940,7 +18200,7 @@ is modified to remove the default indication.
;;;***
;;;### (autoloads (list-dynamic-libraries butterfly) "misc" "misc.el"
-;;;;;; (19968 28627))
+;;;;;; (20533 5993 500881 0))
;;; Generated autoloads from misc.el
(autoload 'butterfly "misc" "\
@@ -17970,7 +18230,7 @@ The return value is always nil.
;;;### (autoloads (multi-isearch-files-regexp multi-isearch-files
;;;;;; multi-isearch-buffers-regexp multi-isearch-buffers multi-isearch-setup)
-;;;;;; "misearch" "misearch.el" (20168 57844))
+;;;;;; "misearch" "misearch.el" (20490 33188 850375 0))
;;; Generated autoloads from misearch.el
(add-hook 'isearch-mode-hook 'multi-isearch-setup)
@@ -18052,7 +18312,7 @@ whose file names match the specified wildcard.
;;;***
;;;### (autoloads (mixal-mode) "mixal-mode" "progmodes/mixal-mode.el"
-;;;;;; (20162 19074))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from progmodes/mixal-mode.el
(autoload 'mixal-mode "mixal-mode" "\
@@ -18063,7 +18323,7 @@ Major mode for the mixal asm language.
;;;***
;;;### (autoloads (mm-default-file-encoding) "mm-encode" "gnus/mm-encode.el"
-;;;;;; (20075 14682))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/mm-encode.el
(autoload 'mm-default-file-encoding "mm-encode" "\
@@ -18074,7 +18334,7 @@ Return a default encoding for FILE.
;;;***
;;;### (autoloads (mm-inline-external-body mm-extern-cache-contents)
-;;;;;; "mm-extern" "gnus/mm-extern.el" (19845 45374))
+;;;;;; "mm-extern" "gnus/mm-extern.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/mm-extern.el
(autoload 'mm-extern-cache-contents "mm-extern" "\
@@ -18093,7 +18353,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing.
;;;***
;;;### (autoloads (mm-inline-partial) "mm-partial" "gnus/mm-partial.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/mm-partial.el
(autoload 'mm-inline-partial "mm-partial" "\
@@ -18107,7 +18367,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing.
;;;***
;;;### (autoloads (mm-url-insert-file-contents-external mm-url-insert-file-contents)
-;;;;;; "mm-url" "gnus/mm-url.el" (19877 30798))
+;;;;;; "mm-url" "gnus/mm-url.el" (20495 51111 757560 0))
;;; Generated autoloads from gnus/mm-url.el
(autoload 'mm-url-insert-file-contents "mm-url" "\
@@ -18124,7 +18384,7 @@ Insert file contents of URL using `mm-url-program'.
;;;***
;;;### (autoloads (mm-uu-dissect-text-parts mm-uu-dissect) "mm-uu"
-;;;;;; "gnus/mm-uu.el" (19845 45374))
+;;;;;; "gnus/mm-uu.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/mm-uu.el
(autoload 'mm-uu-dissect "mm-uu" "\
@@ -18144,7 +18404,7 @@ Assume text has been decoded if DECODED is non-nil.
;;;***
;;;### (autoloads (mml-attach-file mml-to-mime) "mml" "gnus/mml.el"
-;;;;;; (20183 25152))
+;;;;;; (20567 23165 75548 0))
;;; Generated autoloads from gnus/mml.el
(autoload 'mml-to-mime "mml" "\
@@ -18155,7 +18415,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
@@ -18169,7 +18430,7 @@ body) or \"attachment\" (separate from the body).
;;;***
;;;### (autoloads (mml1991-sign mml1991-encrypt) "mml1991" "gnus/mml1991.el"
-;;;;;; (20124 236))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/mml1991.el
(autoload 'mml1991-encrypt "mml1991" "\
@@ -18186,7 +18447,7 @@ body) or \"attachment\" (separate from the body).
;;;### (autoloads (mml2015-self-encrypt mml2015-sign mml2015-encrypt
;;;;;; mml2015-verify-test mml2015-verify mml2015-decrypt-test mml2015-decrypt)
-;;;;;; "mml2015" "gnus/mml2015.el" (20124 236))
+;;;;;; "mml2015" "gnus/mml2015.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/mml2015.el
(autoload 'mml2015-decrypt "mml2015" "\
@@ -18226,8 +18487,16 @@ body) or \"attachment\" (separate from the body).
;;;***
-;;;### (autoloads (m2-mode) "modula2" "progmodes/modula2.el" (20159
-;;;;;; 42847))
+;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (20406 8611
+;;;;;; 875037 0))
+;;; Generated autoloads from cedet/mode-local.el
+
+(put 'define-overloadable-function 'doc-string-elt 3)
+
+;;;***
+
+;;;### (autoloads (m2-mode) "modula2" "progmodes/modula2.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/modula2.el
(defalias 'modula-2-mode 'm2-mode)
@@ -18261,7 +18530,7 @@ followed by the first character of the construct.
;;;***
;;;### (autoloads (denato-region nato-region unmorse-region morse-region)
-;;;;;; "morse" "play/morse.el" (19869 36706))
+;;;;;; "morse" "play/morse.el" (20355 10021 546955 0))
;;; Generated autoloads from play/morse.el
(autoload 'morse-region "morse" "\
@@ -18287,7 +18556,7 @@ Convert NATO phonetic alphabet in region to ordinary ASCII text.
;;;***
;;;### (autoloads (mouse-drag-drag mouse-drag-throw) "mouse-drag"
-;;;;;; "mouse-drag.el" (19890 42850))
+;;;;;; "mouse-drag.el" (20566 63671 243798 0))
;;; Generated autoloads from mouse-drag.el
(autoload 'mouse-drag-throw "mouse-drag" "\
@@ -18334,51 +18603,7 @@ To test this function, evaluate:
;;;***
-;;;### (autoloads (mouse-sel-mode) "mouse-sel" "mouse-sel.el" (20168
-;;;;;; 57844))
-;;; Generated autoloads from mouse-sel.el
-
-(defvar mouse-sel-mode nil "\
-Non-nil if Mouse-Sel mode is enabled.
-See the command `mouse-sel-mode' for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `mouse-sel-mode'.")
-
-(custom-autoload 'mouse-sel-mode "mouse-sel" nil)
-
-(autoload 'mouse-sel-mode "mouse-sel" "\
-Toggle Mouse Sel mode.
-With a prefix argument ARG, enable Mouse Sel mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
-Mouse Sel mode is a global minor mode. When enabled, mouse
-selection is enhanced in various ways:
-
-- Double-clicking on symbol constituents selects symbols.
-Double-clicking on quotes or parentheses selects sexps.
-Double-clicking on whitespace selects whitespace.
-Triple-clicking selects lines.
-Quad-clicking selects paragraphs.
-
-- Selecting sets the region & X primary selection, but does NOT affect
-the `kill-ring', nor do the kill-ring functions change the X selection.
-Because the mouse handlers set the primary selection directly,
-mouse-sel sets the variables `interprogram-cut-function' and
-`interprogram-paste-function' to nil.
-
-- Clicking mouse-2 inserts the contents of the primary selection at
-the mouse position (or point, if `mouse-yank-at-point' is non-nil).
-
-- mouse-2 while selecting or extending copies selection to the
-kill ring; mouse-1 or mouse-3 kills it.
-
-\(fn &optional ARG)" t nil)
-
-;;;***
-
-;;;### (autoloads (mpc) "mpc" "mpc.el" (20178 7273))
+;;;### (autoloads (mpc) "mpc" "mpc.el" (20523 62082 997685 0))
;;; Generated autoloads from mpc.el
(autoload 'mpc "mpc" "\
@@ -18388,7 +18613,8 @@ Main entry point for MPC.
;;;***
-;;;### (autoloads (mpuz) "mpuz" "play/mpuz.el" (19890 42850))
+;;;### (autoloads (mpuz) "mpuz" "play/mpuz.el" (20545 57511 257469
+;;;;;; 0))
;;; Generated autoloads from play/mpuz.el
(autoload 'mpuz "mpuz" "\
@@ -18398,7 +18624,7 @@ Multiplication puzzle with GNU Emacs.
;;;***
-;;;### (autoloads (msb-mode) "msb" "msb.el" (20127 62865))
+;;;### (autoloads (msb-mode) "msb" "msb.el" (20476 31768 298871 0))
;;; Generated autoloads from msb.el
(defvar msb-mode nil "\
@@ -18428,7 +18654,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"
-;;;;;; (20160 63745))
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from international/mule-diag.el
(autoload 'list-character-sets "mule-diag" "\
@@ -18564,18 +18790,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" (19845 45374))
+;;;;;; 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))
@@ -18671,10 +18889,10 @@ Return the value of CODING-SYSTEM's `encode-translation-table' property.
(autoload 'with-coding-priority "mule-util" "\
Execute BODY like `progn' with CODING-SYSTEMS at the front of priority list.
CODING-SYSTEMS is a list of coding systems. See `set-coding-system-priority'.
-This affects the implicit sorting of lists of coding sysems returned by
+This affects the implicit sorting of lists of coding systems returned by
operations such as `find-coding-systems-region'.
-\(fn CODING-SYSTEMS &rest BODY)" nil (quote macro))
+\(fn CODING-SYSTEMS &rest BODY)" nil t)
(put 'with-coding-priority 'lisp-indent-function 1)
(autoload 'detect-coding-with-priority "mule-util" "\
@@ -18682,7 +18900,9 @@ 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.
-\(fn FROM TO PRIORITY-LIST)" nil (quote macro))
+\(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.
@@ -18705,8 +18925,8 @@ per-character basis, this may not be accurate.
;;;### (autoloads (network-connection network-connection-to-service
;;;;;; whois-reverse-lookup whois finger ftp run-dig dns-lookup-host
;;;;;; nslookup nslookup-host ping traceroute route arp netstat
-;;;;;; iwconfig ifconfig) "net-utils" "net/net-utils.el" (19845
-;;;;;; 45374))
+;;;;;; iwconfig ifconfig) "net-utils" "net/net-utils.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from net/net-utils.el
(autoload 'ifconfig "net-utils" "\
@@ -18800,13 +19020,13 @@ Open a network connection to HOST on PORT.
;;;***
-;;;### (autoloads (netrc-credentials) "netrc" "net/netrc.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (netrc-credentials) "netrc" "net/netrc.el" (20495
+;;;;;; 51111 757560 0))
;;; Generated autoloads from net/netrc.el
(autoload 'netrc-credentials "netrc" "\
Return a user name/password pair.
-Port specifications will be prioritised in the order they are
+Port specifications will be prioritized in the order they are
listed in the PORTS list.
\(fn MACHINE &rest PORTS)" nil nil)
@@ -18814,7 +19034,7 @@ listed in the PORTS list.
;;;***
;;;### (autoloads (open-network-stream) "network-stream" "net/network-stream.el"
-;;;;;; (20122 44898))
+;;;;;; (20369 14251 85829 0))
;;; Generated autoloads from net/network-stream.el
(autoload 'open-network-stream "network-stream" "\
@@ -18882,7 +19102,7 @@ values:
capability command, and should return the command to switch on
STARTTLS if the server supports STARTTLS, and nil otherwise.
-:always-query-capabilies says whether to query the server for
+:always-query-capabilities says whether to query the server for
capabilities, even if we're doing a `plain' network connection.
:client-certificate should either be a list where the first
@@ -18892,9 +19112,8 @@ values:
certificate. This parameter will only be used when doing TLS
or STARTTLS connections.
-If :use-starttls-if-possible is non-nil, do opportunistic
-STARTTLS upgrades even if Emacs doesn't have built-in TLS
-functionality.
+:use-starttls-if-possible is a boolean that says to do opportunistic
+STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality.
:nowait is a boolean that says the connection should be made
asynchronously, if possible.
@@ -18905,212 +19124,8 @@ functionality.
;;;***
-;;;### (autoloads (comment-indent-new-line comment-auto-fill-only-comments
-;;;;;; comment-dwim comment-or-uncomment-region comment-box comment-region
-;;;;;; uncomment-region comment-kill comment-set-column comment-indent
-;;;;;; comment-indent-default comment-normalize-vars comment-multi-line
-;;;;;; comment-padding comment-style comment-column) "newcomment"
-;;;;;; "newcomment.el" (20087 5852))
-;;; Generated autoloads from newcomment.el
-
-(defalias 'indent-for-comment 'comment-indent)
-
-(defalias 'set-comment-column 'comment-set-column)
-
-(defalias 'kill-comment 'comment-kill)
-
-(defalias 'indent-new-comment-line 'comment-indent-new-line)
-
-(defvar comment-use-syntax 'undecided "\
-Non-nil if syntax-tables can be used instead of regexps.
-Can also be `undecided' which means that a somewhat expensive test will
-be used to try to determine whether syntax-tables should be trusted
-to understand comments or not in the given buffer.
-Major modes should set this variable.")
-
-(defvar comment-column 32 "\
-Column to indent right-margin comments to.
-Each mode may establish a different default value for this variable; you
-can set the value for a particular mode using that mode's hook.
-Comments might be indented to a different value in order not to go beyond
-`comment-fill-column' or in order to align them with surrounding comments.")
-
-(custom-autoload 'comment-column "newcomment" t)
-(put 'comment-column 'safe-local-variable 'integerp)
-
-(defvar comment-start nil "\
-*String to insert to start a new comment, or nil if no comment syntax.")
-(put 'comment-start 'safe-local-variable 'string-or-null-p)
-
-(defvar comment-start-skip nil "\
-*Regexp to match the start of a comment plus everything up to its body.
-If there are any \\(...\\) pairs, the comment delimiter text is held to begin
-at the place matched by the close of the first pair.")
-(put 'comment-start-skip 'safe-local-variable 'string-or-null-p)
-
-(defvar comment-end-skip nil "\
-Regexp to match the end of a comment plus everything back to its body.")
-(put 'comment-end-skip 'safe-local-variable 'string-or-null-p)
-
-(defvar comment-end (purecopy "") "\
-*String to insert to end a new comment.
-Should be an empty string if comments are terminated by end-of-line.")
-(put 'comment-end 'safe-local-variable 'string-or-null-p)
-
-(defvar comment-indent-function 'comment-indent-default "\
-Function to compute desired indentation for a comment.
-This function is called with no args with point at the beginning of
-the comment's starting delimiter and should return either the desired
-column indentation or nil.
-If nil is returned, indentation is delegated to `indent-according-to-mode'.")
-
-(defvar comment-insert-comment-function nil "\
-Function to insert a comment when a line doesn't contain one.
-The function has no args.
-
-Applicable at least in modes for languages like fixed-format Fortran where
-comments always start in column zero.")
-
-(defvar comment-style 'indent "\
-Style to be used for `comment-region'.
-See `comment-styles' for a list of available styles.")
-
-(custom-autoload 'comment-style "newcomment" t)
-
-(defvar comment-padding (purecopy " ") "\
-Padding string that `comment-region' puts between comment chars and text.
-Can also be an integer which will be automatically turned into a string
-of the corresponding number of spaces.
-
-Extra spacing between the comment characters and the comment text
-makes the comment easier to read. Default is 1. nil means 0.")
-
-(custom-autoload 'comment-padding "newcomment" t)
-
-(defvar comment-multi-line nil "\
-Non-nil means `comment-indent-new-line' continues comments.
-That is, it inserts no new terminator or starter.
-This affects `auto-fill-mode', which is the main reason to
-customize this variable.
-
-It also affects \\[indent-new-comment-line]. However, if you want this
-behavior for explicit filling, you might as well use \\[newline-and-indent].")
-
-(custom-autoload 'comment-multi-line "newcomment" t)
-
-(autoload 'comment-normalize-vars "newcomment" "\
-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
-the variables are properly set.
-
-\(fn &optional NOERROR)" nil nil)
-
-(autoload 'comment-indent-default "newcomment" "\
-Default for `comment-indent-function'.
-
-\(fn)" nil nil)
-
-(autoload 'comment-indent "newcomment" "\
-Indent this line's comment to `comment-column', or insert an empty comment.
-If CONTINUE is non-nil, use the `comment-continue' markers if any.
-
-\(fn &optional CONTINUE)" t nil)
-
-(autoload 'comment-set-column "newcomment" "\
-Set the comment column based on point.
-With no ARG, set the comment column to the current column.
-With just minus as arg, kill any comment on this line.
-With any other arg, set comment column to indentation of the previous comment
- and then align or create a comment on this line at that column.
-
-\(fn ARG)" t nil)
-
-(autoload 'comment-kill "newcomment" "\
-Kill the first comment on this line, if any.
-With prefix ARG, kill comments on that many lines starting with this one.
-
-\(fn ARG)" t nil)
-
-(autoload 'uncomment-region "newcomment" "\
-Uncomment each line in the BEG .. END region.
-The numeric prefix ARG can specify a number of chars to remove from the
-comment markers.
-
-\(fn BEG END &optional ARG)" t nil)
-
-(autoload 'comment-region "newcomment" "\
-Comment or uncomment each line in the region.
-With just \\[universal-argument] prefix arg, uncomment each line in region BEG .. END.
-Numeric prefix ARG means use ARG comment characters.
-If ARG is negative, delete that many comment characters instead.
-
-The strings used as comment starts are built from `comment-start'
-and `comment-padding'; the strings used as comment ends are built
-from `comment-end' and `comment-padding'.
-
-By default, the `comment-start' markers are inserted at the
-current indentation of the region, and comments are terminated on
-each line (even for syntaxes in which newline does not end the
-comment and blank lines do not get comments). This can be
-changed with `comment-style'.
-
-\(fn BEG END &optional ARG)" t nil)
-
-(autoload 'comment-box "newcomment" "\
-Comment out the BEG .. END region, putting it inside a box.
-The numeric prefix ARG specifies how many characters to add to begin- and
-end- comment markers additionally to what `comment-add' already specifies.
-
-\(fn BEG END &optional ARG)" t nil)
-
-(autoload 'comment-or-uncomment-region "newcomment" "\
-Call `comment-region', unless the region only consists of comments,
-in which case call `uncomment-region'. If a prefix arg is given, it
-is passed on to the respective function.
-
-\(fn BEG END &optional ARG)" t nil)
-
-(autoload 'comment-dwim "newcomment" "\
-Call the comment command you want (Do What I Mean).
-If the region is active and `transient-mark-mode' is on, call
-`comment-region' (unless it only consists of comments, in which
-case it calls `uncomment-region').
-Else, if the current line is empty, call `comment-insert-comment-function'
-if it is defined, otherwise insert a comment and indent it.
-Else if a prefix ARG is specified, call `comment-kill'.
-Else, call `comment-indent'.
-You can configure `comment-style' to change the way regions are commented.
-
-\(fn ARG)" t nil)
-
-(defvar comment-auto-fill-only-comments nil "\
-Non-nil means to only auto-fill inside comments.
-This has no effect in modes that do not define a comment syntax.")
-
-(custom-autoload 'comment-auto-fill-only-comments "newcomment" t)
-
-(autoload 'comment-indent-new-line "newcomment" "\
-Break line at point and indent, continuing comment if within one.
-This indents the body of the continued comment
-under the previous comment line.
-
-This command is intended for styles where you write a comment per line,
-starting a new comment (and terminating it if necessary) on each line.
-If you want to continue one comment across several lines, use \\[newline-and-indent].
-
-If a fill column is specified, it overrides the use of the comment column
-or comment indentation.
-
-The inserted newline is marked hard if variable `use-hard-newlines' is true,
-unless optional argument SOFT is non-nil.
-
-\(fn &optional SOFT)" t nil)
-
-;;;***
-
;;;### (autoloads (newsticker-start newsticker-running-p) "newst-backend"
-;;;;;; "net/newst-backend.el" (19918 22236))
+;;;;;; "net/newst-backend.el" (20577 33959 40183 0))
;;; Generated autoloads from net/newst-backend.el
(autoload 'newsticker-running-p "newst-backend" "\
@@ -19132,7 +19147,7 @@ Run `newsticker-start-hook' if newsticker was not running already.
;;;***
;;;### (autoloads (newsticker-plainview) "newst-plainview" "net/newst-plainview.el"
-;;;;;; (20167 36967))
+;;;;;; (20434 17809 692608 0))
;;; Generated autoloads from net/newst-plainview.el
(autoload 'newsticker-plainview "newst-plainview" "\
@@ -19143,7 +19158,7 @@ Start newsticker plainview.
;;;***
;;;### (autoloads (newsticker-show-news) "newst-reader" "net/newst-reader.el"
-;;;;;; (20094 65493))
+;;;;;; (20434 17809 692608 0))
;;; Generated autoloads from net/newst-reader.el
(autoload 'newsticker-show-news "newst-reader" "\
@@ -19154,7 +19169,8 @@ Start reading news. You may want to bind this to a key.
;;;***
;;;### (autoloads (newsticker-start-ticker newsticker-ticker-running-p)
-;;;;;; "newst-ticker" "net/newst-ticker.el" (19845 45374))
+;;;;;; "newst-ticker" "net/newst-ticker.el" (20427 14766 970343
+;;;;;; 0))
;;; Generated autoloads from net/newst-ticker.el
(autoload 'newsticker-ticker-running-p "newst-ticker" "\
@@ -19175,7 +19191,7 @@ running already.
;;;***
;;;### (autoloads (newsticker-treeview) "newst-treeview" "net/newst-treeview.el"
-;;;;;; (20168 57844))
+;;;;;; (20590 45996 129575 0))
;;; Generated autoloads from net/newst-treeview.el
(autoload 'newsticker-treeview "newst-treeview" "\
@@ -19186,7 +19202,7 @@ Start newsticker treeview.
;;;***
;;;### (autoloads (nndiary-generate-nov-databases) "nndiary" "gnus/nndiary.el"
-;;;;;; (20168 57844))
+;;;;;; (20614 54428 654267 0))
;;; Generated autoloads from gnus/nndiary.el
(autoload 'nndiary-generate-nov-databases "nndiary" "\
@@ -19196,8 +19212,8 @@ Generate NOV databases in all nndiary directories.
;;;***
-;;;### (autoloads (nndoc-add-type) "nndoc" "gnus/nndoc.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (nndoc-add-type) "nndoc" "gnus/nndoc.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from gnus/nndoc.el
(autoload 'nndoc-add-type "nndoc" "\
@@ -19212,7 +19228,7 @@ symbol in the alist.
;;;***
;;;### (autoloads (nnfolder-generate-active-file) "nnfolder" "gnus/nnfolder.el"
-;;;;;; (19845 45374))
+;;;;;; (20458 56750 651721 0))
;;; Generated autoloads from gnus/nnfolder.el
(autoload 'nnfolder-generate-active-file "nnfolder" "\
@@ -19224,7 +19240,7 @@ This command does not work if you use short group names.
;;;***
;;;### (autoloads (nnml-generate-nov-databases) "nnml" "gnus/nnml.el"
-;;;;;; (20178 7273))
+;;;;;; (20458 56750 651721 0))
;;; Generated autoloads from gnus/nnml.el
(autoload 'nnml-generate-nov-databases "nnml" "\
@@ -19235,15 +19251,15 @@ Generate NOV databases in all nnml directories.
;;;***
;;;### (autoloads (disable-command enable-command disabled-command-function)
-;;;;;; "novice" "novice.el" (19845 45374))
+;;;;;; "novice" "novice.el" (20566 63671 243798 0))
;;; Generated autoloads from novice.el
+(define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1")
+
(defvar disabled-command-function 'disabled-command-function "\
Function to call to handle disabled commands.
If nil, the feature is disabled, i.e., all commands work normally.")
-(define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1")
-
(autoload 'disabled-command-function "novice" "\
@@ -19260,15 +19276,15 @@ 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)
;;;***
;;;### (autoloads (nroff-mode) "nroff-mode" "textmodes/nroff-mode.el"
-;;;;;; (20127 62865))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from textmodes/nroff-mode.el
(autoload 'nroff-mode "nroff-mode" "\
@@ -19283,7 +19299,7 @@ closing requests for requests that are used in matched pairs.
;;;***
;;;### (autoloads (nxml-glyph-display-string) "nxml-glyph" "nxml/nxml-glyph.el"
-;;;;;; (19845 45374))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from nxml/nxml-glyph.el
(autoload 'nxml-glyph-display-string "nxml-glyph" "\
@@ -19295,8 +19311,8 @@ Return nil if the face cannot display a glyph for N.
;;;***
-;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (19927
-;;;;;; 37225))
+;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from nxml/nxml-mode.el
(autoload 'nxml-mode "nxml-mode" "\
@@ -19310,7 +19326,7 @@ the start-tag, point, and end-tag are all left on separate lines.
If `nxml-slash-auto-complete-flag' is non-nil, then inserting a `</'
automatically inserts the rest of the end-tag.
-\\[nxml-complete] performs completion on the symbol preceding point.
+\\[completion-at-point] performs completion on the symbol preceding point.
\\[nxml-dynamic-markup-word] uses the contents of the current buffer
to choose a tag to put around the word preceding point.
@@ -19358,7 +19374,7 @@ Many aspects this mode can be customized using
;;;***
;;;### (autoloads (nxml-enable-unicode-char-name-sets) "nxml-uchnm"
-;;;;;; "nxml/nxml-uchnm.el" (19845 45374))
+;;;;;; "nxml/nxml-uchnm.el" (20355 10021 546955 0))
;;; Generated autoloads from nxml/nxml-uchnm.el
(autoload 'nxml-enable-unicode-char-name-sets "nxml-uchnm" "\
@@ -19370,299 +19386,8 @@ the variable `nxml-enabled-unicode-blocks'.
;;;***
-;;;### (autoloads (org-babel-mark-block org-babel-previous-src-block
-;;;;;; org-babel-next-src-block org-babel-goto-named-result org-babel-goto-named-src-block
-;;;;;; org-babel-goto-src-block-head org-babel-hide-result-toggle-maybe
-;;;;;; org-babel-sha1-hash org-babel-execute-subtree org-babel-execute-buffer
-;;;;;; org-babel-map-inline-src-blocks org-babel-map-src-blocks
-;;;;;; org-babel-open-src-block-result org-babel-switch-to-session-with-code
-;;;;;; org-babel-switch-to-session org-babel-initiate-session org-babel-load-in-session
-;;;;;; org-babel-check-src-block org-babel-expand-src-block org-babel-execute-src-block
-;;;;;; 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" (20174 10230))
-;;; Generated autoloads from org/ob.el
-
-(autoload 'org-babel-execute-safely-maybe "ob" "\
-
-
-\(fn)" nil nil)
-
-(autoload 'org-babel-execute-maybe "ob" "\
-
-
-\(fn)" t nil)
-
-(autoload 'org-babel-view-src-block-info "ob" "\
-Display information on the current source block.
-This includes header arguments, language and name, and is largely
-a window into the `org-babel-get-src-block-info' function.
-
-\(fn)" t nil)
-
-(autoload 'org-babel-expand-src-block-maybe "ob" "\
-Conditionally expand a source block.
-Detect if this is context for a org-babel src-block and if so
-then run `org-babel-expand-src-block'.
-
-\(fn)" t nil)
-
-(autoload 'org-babel-load-in-session-maybe "ob" "\
-Conditionally load a source block in a session.
-Detect if this is context for a org-babel src-block and if so
-then run `org-babel-load-in-session'.
-
-\(fn)" t nil)
-
-(autoload 'org-babel-pop-to-session-maybe "ob" "\
-Conditionally pop to a session.
-Detect if this is context for a org-babel src-block and if so
-then run `org-babel-pop-to-session'.
-
-\(fn)" t nil)
-
-(autoload 'org-babel-execute-src-block "ob" "\
-Execute the current source code block.
-Insert the results of execution into the buffer. Source code
-execution and the collection and formatting of results can be
-controlled through a variety of header arguments.
-
-With prefix argument ARG, force re-execution even if an
-existing result cached in the buffer would otherwise have been
-returned.
-
-Optionally supply a value for INFO in the form returned by
-`org-babel-get-src-block-info'.
-
-Optionally supply a value for PARAMS which will be merged with
-the header arguments specified at the front of the source code
-block.
-
-\(fn &optional ARG INFO PARAMS)" t nil)
-
-(autoload 'org-babel-expand-src-block "ob" "\
-Expand the current source code block.
-Expand according to the source code block's header
-arguments and pop open the results in a preview buffer.
-
-\(fn &optional ARG INFO PARAMS)" t nil)
-
-(autoload 'org-babel-check-src-block "ob" "\
-Check for misspelled header arguments in the current code block.
-
-\(fn)" t nil)
-
-(autoload 'org-babel-load-in-session "ob" "\
-Load the body of the current source-code block.
-Evaluate the header arguments for the source block before
-entering the session. After loading the body this pops open the
-session.
-
-\(fn &optional ARG INFO)" t nil)
-
-(autoload 'org-babel-initiate-session "ob" "\
-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.
-
-\(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
-with a prefix argument then this is passed on to
-`org-babel-initiate-session'.
-
-\(fn &optional ARG INFO)" t nil)
-
-(autoload 'org-babel-switch-to-session-with-code "ob" "\
-Switch to code buffer and display session.
-
-\(fn &optional ARG INFO)" t nil)
-
-(autoload 'org-babel-open-src-block-result "ob" "\
-If `point' is on a src block then open the results of the
-source code block, otherwise return nil. With optional prefix
-argument RE-RUN the source-code block is evaluated even if
-results already exist.
-
-\(fn &optional RE-RUN)" t nil)
-
-(autoload 'org-babel-map-src-blocks "ob" "\
-Evaluate BODY forms on each source-block in FILE.
-If FILE is nil evaluate BODY forms on source blocks in current
-buffer. During evaluation of BODY the following local variables
-are set relative to the currently matched code block.
-
-full-block ------- string holding the entirety of the code block
-beg-block -------- point at the beginning of the code block
-end-block -------- point at the end of the matched code block
-lang ------------- string holding the language of the code block
-beg-lang --------- point at the beginning of the lang
-end-lang --------- point at the end of the lang
-switches --------- string holding the switches
-beg-switches ----- point at the beginning of the switches
-end-switches ----- point at the end of the switches
-header-args ------ string holding the header-args
-beg-header-args -- point at the beginning of the header-args
-end-header-args -- point at the end of the header-args
-body ------------- string holding the body of the code block
-beg-body --------- point at the beginning of the body
-end-body --------- point at the end of the body
-
-\(fn FILE &rest BODY)" nil (quote macro))
-
-(put 'org-babel-map-src-blocks 'lisp-indent-function '1)
-
-(autoload 'org-babel-map-inline-src-blocks "ob" "\
-Evaluate BODY forms on each inline source-block in FILE.
-If FILE is nil evaluate BODY forms on source blocks in current
-buffer.
-
-\(fn FILE &rest BODY)" nil (quote macro))
-
-(put 'org-babel-map-inline-src-blocks 'lisp-indent-function '1)
-
-(autoload 'org-babel-execute-buffer "ob" "\
-Execute source code blocks in a buffer.
-Call `org-babel-execute-src-block' on every source block in
-the current buffer.
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'org-babel-execute-subtree "ob" "\
-Execute source code blocks in a subtree.
-Call `org-babel-execute-src-block' on every source block in
-the current subtree.
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'org-babel-sha1-hash "ob" "\
-Generate an sha1 hash based on the value of info.
-
-\(fn &optional INFO)" t nil)
-
-(autoload 'org-babel-hide-result-toggle-maybe "ob" "\
-Toggle visibility of result at point.
-
-\(fn)" t nil)
-
-(autoload 'org-babel-goto-src-block-head "ob" "\
-Go to the beginning of the current code block.
-
-\(fn)" t nil)
-
-(autoload 'org-babel-goto-named-src-block "ob" "\
-Go to a named source-code block.
-
-\(fn NAME)" t nil)
-
-(autoload 'org-babel-goto-named-result "ob" "\
-Go to a named result.
-
-\(fn NAME)" t nil)
-
-(autoload 'org-babel-next-src-block "ob" "\
-Jump to the next source block.
-With optional prefix argument ARG, jump forward ARG many source blocks.
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'org-babel-previous-src-block "ob" "\
-Jump to the previous source block.
-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
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (autoloads (org-babel-describe-bindings) "ob-keys" "org/ob-keys.el"
-;;;;;; (20045 30710))
-;;; Generated autoloads from org/ob-keys.el
-
-(autoload 'org-babel-describe-bindings "ob-keys" "\
-Describe all keybindings behind `org-babel-key-prefix'.
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe
-;;;;;; org-babel-lob-ingest) "ob-lob" "org/ob-lob.el" (20045 31431))
-;;; Generated autoloads from org/ob-lob.el
-
-(autoload 'org-babel-lob-ingest "ob-lob" "\
-Add all named source-blocks defined in FILE to
-`org-babel-library-of-babel'.
-
-\(fn &optional FILE)" t nil)
-
-(autoload 'org-babel-lob-execute-maybe "ob-lob" "\
-Execute a Library of Babel source block, if appropriate.
-Detect if this is context for a Library Of Babel source block and
-if so then run the appropriate source block from the Library.
-
-\(fn)" t nil)
-
-(autoload 'org-babel-lob-get-info "ob-lob" "\
-Return a Library of Babel function call as a string.
-
-\(fn)" nil nil)
-
-;;;***
-
-;;;### (autoloads (org-babel-tangle org-babel-tangle-file org-babel-load-file
-;;;;;; org-babel-tangle-lang-exts) "ob-tangle" "org/ob-tangle.el"
-;;;;;; (20045 30712))
-;;; Generated autoloads from org/ob-tangle.el
-
-(defvar org-babel-tangle-lang-exts '(("emacs-lisp" . "el")) "\
-Alist mapping languages to their file extensions.
-The key is the language name, the value is the string that should
-be inserted as the extension commonly used to identify files
-written in this language. If no entry is found in this list,
-then the name of the language is used.")
-
-(custom-autoload 'org-babel-tangle-lang-exts "ob-tangle" t)
-
-(autoload 'org-babel-load-file "ob-tangle" "\
-Load Emacs Lisp source code blocks in the Org-mode FILE.
-This function exports the source code using
-`org-babel-tangle' and then loads the resulting file using
-`load-file'.
-
-\(fn FILE)" t nil)
-
-(autoload 'org-babel-tangle-file "ob-tangle" "\
-Extract the bodies of source code blocks in FILE.
-Source code blocks are extracted with `org-babel-tangle'.
-Optional argument TARGET-FILE can be used to specify a default
-export file for all source blocks. Optional argument LANG can be
-used to limit the exported source code blocks by language.
-
-\(fn FILE &optional TARGET-FILE LANG)" t nil)
-
-(autoload 'org-babel-tangle "ob-tangle" "\
-Write code blocks to source-specific files.
-Extract the bodies of all source code blocks from the current
-file into their own source-specific files. Optional argument
-TARGET-FILE can be used to specify a default export file for all
-source blocks. Optional argument LANG can be used to limit the
-exported source code blocks by language.
-
-\(fn &optional ONLY-THIS-BLOCK TARGET-FILE LANG)" t nil)
-
-;;;***
-
;;;### (autoloads (inferior-octave) "octave-inf" "progmodes/octave-inf.el"
-;;;;;; (20135 56947))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from progmodes/octave-inf.el
(autoload 'inferior-octave "octave-inf" "\
@@ -19685,7 +19410,7 @@ startup file, `~/.emacs-octave'.
;;;***
;;;### (autoloads (octave-mode) "octave-mod" "progmodes/octave-mod.el"
-;;;;;; (20135 56947))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from progmodes/octave-mod.el
(autoload 'octave-mode "octave-mod" "\
@@ -19746,12 +19471,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 ()
@@ -19767,13 +19492,13 @@ 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-babel-do-load-languages) "org" "org/org.el"
-;;;;;; (20170 13157))
+;;;### (autoloads (org-customize org-reload org-submit-bug-report
+;;;;;; org-cycle-agenda-files org-switchb 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-cycle org-mode org-clock-persistence-insinuate
+;;;;;; turn-on-orgtbl org-version org-babel-do-load-languages) "org"
+;;;;;; "org/org.el" (20618 55210 422086 0))
;;; Generated autoloads from org/org.el
(autoload 'org-babel-do-load-languages "org" "\
@@ -19781,6 +19506,24 @@ Load the languages defined in `org-babel-load-languages'.
\(fn SYM VALUE)" nil nil)
+(autoload 'org-version "org" "\
+Show the org-mode version in the echo area.
+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 FULL MESSAGE)" t nil)
+
+(autoload 'turn-on-orgtbl "org" "\
+Unconditionally turn on `orgtbl-mode'.
+
+\(fn)" nil nil)
+
+(autoload 'org-clock-persistence-insinuate "org" "\
+Set up hooks for clock persistence.
+
+\(fn)" nil nil)
+
(autoload 'org-mode "org" "\
Outline-based notes management and organizer, alias
\"Carsten's outline-mode for keeping track of everything.\"
@@ -19802,7 +19545,55 @@ The following commands are available:
\(fn)" t nil)
-(defvar org-inlinetask-min-level)
+(autoload 'org-cycle "org" "\
+TAB-action and visibility cycling for Org-mode.
+
+This is the command invoked in Org-mode by the TAB key. Its main purpose
+is outline visibility cycling, but it also invokes other actions
+in special contexts.
+
+- When this function is called with a prefix argument, rotate the entire
+ buffer through 3 states (global cycling)
+ 1. OVERVIEW: Show only top-level headlines.
+ 2. CONTENTS: Show all headlines of all levels, but no body text.
+ 3. SHOW ALL: Show everything.
+ When called with two `C-u C-u' prefixes, switch to the startup visibility,
+ determined by the variable `org-startup-folded', and by any VISIBILITY
+ properties in the buffer.
+ When called with three `C-u C-u C-u' prefixed, show the entire buffer,
+ including any drawers.
+
+- When inside a table, re-align the table and move to the next field.
+
+- When point is at the beginning of a headline, rotate the subtree started
+ by this line through 3 different states (local cycling)
+ 1. FOLDED: Only the main headline is shown.
+ 2. CHILDREN: The main headline and the direct children are shown.
+ From this state, you can move to one of the children
+ and zoom in further.
+ 3. SUBTREE: Show the entire subtree, including body text.
+ If there is no subtree, switch directly from CHILDREN to FOLDED.
+
+- When point is at the beginning of an empty headline and the variable
+ `org-cycle-level-after-item/entry-creation' is set, cycle the level
+ of the headline by demoting and promoting it to likely levels. This
+ speeds up creation document structure by pressing TAB once or several
+ times right after creating a new headline.
+
+- When there is a numeric prefix, go up to a heading with level ARG, do
+ a `show-subtree' and return to the previous cursor position. If ARG
+ is negative, go up that many levels.
+
+- When point is not at the beginning of a headline, execute the global
+ binding for TAB, which is re-indenting the line. See the option
+ `org-cycle-emulate-tab' for details.
+
+- Special case: if point is at the beginning of the buffer and there is
+ no headline in line 1, this function will act as if called with prefix arg
+ (C-u TAB, same as S-TAB) also when called without prefix arg.
+ But only if also the variable `org-cycle-global-at-bob' is t.
+
+\(fn &optional ARG)" t nil)
(autoload 'org-global-cycle "org" "\
Cycle the global visibility. For details see `org-cycle'.
@@ -19883,69 +19674,9 @@ Open a link in the string S, as if it was in Org-mode.
\(fn S &optional ARG REFERENCE-BUFFER)" t nil)
-(autoload 'org-map-entries "org" "\
-Call FUNC at each headline selected by MATCH in SCOPE.
-
-FUNC is a function or a lisp form. The function will be called without
-arguments, with the cursor positioned at the beginning of the headline.
-The return values of all calls to the function will be collected and
-returned as a list.
-
-The call to FUNC will be wrapped into a save-excursion form, so FUNC
-does not need to preserve point. After evaluation, the cursor will be
-moved to the end of the line (presumably of the headline of the
-processed entry) and search continues from there. Under some
-circumstances, this may not produce the wanted results. For example,
-if you have removed (e.g. archived) the current (sub)tree it could
-mean that the next entry will be skipped entirely. In such cases, you
-can specify the position from where search should continue by making
-FUNC set the variable `org-map-continue-from' to the desired buffer
-position.
-
-MATCH is a tags/property/todo match as it is used in the agenda tags view.
-Only headlines that are matched by this query will be considered during
-the iteration. When MATCH is nil or t, all headlines will be
-visited by the iteration.
-
-SCOPE determines the scope of this command. It can be any of:
-
-nil The current buffer, respecting the restriction if any
-tree The subtree started with the entry at point
-region The entries within the active region, if any
-file The current buffer, without restriction
-file-with-archives
- The current buffer, and any archives associated with it
-agenda All agenda files
-agenda-with-archives
- All agenda files with any archive files associated with them
-\(file1 file2 ...)
- If this is a list, all files in the list will be scanned
-
-The remaining args are treated as settings for the skipping facilities of
-the scanner. The following items can be given here:
-
- archive skip trees with the archive tag.
- comment skip trees with the COMMENT keyword
- function or Emacs Lisp form:
- will be used as value for `org-agenda-skip-function', so whenever
- the function returns t, FUNC will not be called for that
- entry and search will continue from the point where the
- function leaves it.
-
-If your function needs to retrieve the tags including inherited tags
-at the *current* entry, you can use the value of the variable
-`org-scanner-tags' which will be much faster than getting the value
-with `org-get-tags-at'. If your function gets properties with
-`org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags'
-to t around the call to `org-entry-properties' to get the same speedup.
-Note that if your function moves around to retrieve tags and properties at
-a *different* entry, you cannot use these techniques.
-
-\(fn FUNC &optional MATCH SCOPE &rest SKIP)" nil nil)
-
(autoload 'org-switchb "org" "\
Switch between Org buffers.
-With a prefix argument, restrict available to files.
+With one prefix argument, restrict available buffers to files.
With two prefix arguments, restrict available buffers to agenda files.
Defaults to `iswitchb' for buffer name completion.
@@ -19975,11 +19706,6 @@ information about your Org-mode version and configuration.
\(fn)" t nil)
-(autoload 'org-require-autoloaded-modules "org" "\
-
-
-\(fn)" t nil)
-
(autoload 'org-reload "org" "\
Reload all org lisp files.
With prefix arg UNCOMPILED, load the uncompiled versions.
@@ -19993,13 +19719,19 @@ Call the customize function with org as argument.
;;;***
-;;;### (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
+;;;### (autoloads (org-agenda-to-appt org-calendar-goto-agenda 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" (20178 7273))
+;;;;;; org-agenda org-toggle-sticky-agenda) "org-agenda" "org/org-agenda.el"
+;;;;;; (20618 55210 422086 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
@@ -20015,6 +19747,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.
@@ -20034,7 +19767,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.
@@ -20044,7 +19777,7 @@ longer string it is used as a tags/todo match string.
Parameters are alternating variable names and values that will be bound
before running the agenda command.
-\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro))
+\(fn CMD-KEY &rest PARAMETERS)" nil t)
(autoload 'org-batch-agenda-csv "org-agenda" "\
Run an agenda command in batch mode and send the result to STDOUT.
@@ -20081,7 +19814,7 @@ priority-l The priority letter if any was given
priority-n The computed numerical priority
agenda-day The day in the agenda where this is listed
-\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro))
+\(fn CMD-KEY &rest PARAMETERS)" nil t)
(autoload 'org-store-agenda-views "org-agenda" "\
@@ -20091,7 +19824,7 @@ agenda-day The day in the agenda where this is listed
(autoload 'org-batch-store-agenda-views "org-agenda" "\
Run all custom agenda commands that have a file argument.
-\(fn &rest PARAMETERS)" nil (quote macro))
+\(fn &rest PARAMETERS)" nil t)
(autoload 'org-agenda-list "org-agenda" "\
Produce a daily/weekly view from all files in variable `org-agenda-files'.
@@ -20099,13 +19832,13 @@ The view will be for the current day or week, but from the overview buffer
you will be able to go to other days/weeks.
With a numeric prefix argument in an interactive call, the agenda will
-span INCLUDE-ALL days. Lisp programs should instead specify SPAN to change
+span ARG days. Lisp programs should instead specify SPAN to change
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'.
-\(fn &optional INCLUDE-ALL START-DAY SPAN)" t nil)
+\(fn &optional ARG START-DAY SPAN)" t nil)
(autoload 'org-search-view "org-agenda" "\
Show all entries that contain a phrase or words or regular expressions.
@@ -20160,7 +19893,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.
@@ -20177,7 +19910,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
@@ -20205,11 +19938,6 @@ function from a program - use `org-agenda-get-day-entries' instead.
\(fn &rest ARGS)" nil nil)
-(autoload 'org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item "org-agenda" "\
-Do we have a reason to ignore this TODO entry because it has a time stamp?
-
-\(fn &optional END)" nil nil)
-
(autoload 'org-calendar-goto-agenda "org-agenda" "\
Compute the Org-mode agenda for the calendar date displayed at the cursor.
This is a command that has to be installed in `calendar-mode-map'.
@@ -20227,6 +19955,10 @@ expression, and filter out entries that don't match it.
If FILTER is a string, use this string as a regular expression
for filtering entries out.
+If FILTER is a function, filter out entries against which
+calling the function returns nil. This function takes one
+argument: an entry from `org-agenda-get-day-entries'.
+
FILTER can also be an alist with the car of each cell being
either 'headline or 'category. For example:
@@ -20236,132 +19968,49 @@ either 'headline or 'category. For example:
will only add headlines containing IMPORTANT or headlines
belonging to the \"Work\" category.
-\(fn &optional REFRESH FILTER)" t nil)
-
-;;;***
-
-;;;### (autoloads (org-archive-subtree-default-with-confirmation
-;;;;;; org-archive-subtree-default) "org-archive" "org/org-archive.el"
-;;;;;; (20045 30713))
-;;; Generated autoloads from org/org-archive.el
+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.
-(autoload 'org-archive-subtree-default "org-archive" "\
-Archive the current subtree with the default command.
-This command is set with the variable `org-archive-default-command'.
-
-\(fn)" t nil)
+If an entry as a APPT_WARNTIME property, its value will be used
+to override `appt-message-warning-time'.
-(autoload 'org-archive-subtree-default-with-confirmation "org-archive" "\
-Archive the current subtree with the default command.
-This command is set with the variable `org-archive-default-command'.
-
-\(fn)" t nil)
+\(fn &optional REFRESH FILTER &rest ARGS)" t nil)
;;;***
-;;;### (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" (20045
-;;;;;; 30713))
-;;; Generated autoloads from org/org-ascii.el
-
-(autoload 'org-export-as-latin1 "org-ascii" "\
-Like `org-export-as-ascii', use latin1 encoding for special symbols.
-
-\(fn &rest ARGS)" t nil)
-
-(autoload 'org-export-as-latin1-to-buffer "org-ascii" "\
-Like `org-export-as-ascii-to-buffer', use latin1 encoding for symbols.
-
-\(fn &rest ARGS)" t nil)
+;;;### (autoloads (org-beamer-mode org-beamer-sectioning) "org-beamer"
+;;;;;; "org/org-beamer.el" (20618 55210 422086 0))
+;;; Generated autoloads from org/org-beamer.el
-(autoload 'org-export-as-utf8 "org-ascii" "\
-Like `org-export-as-ascii', use encoding for special symbols.
+(autoload 'org-beamer-sectioning "org-beamer" "\
+Return the sectioning entry for the current headline.
+LEVEL is the reduced level of the headline.
+TEXT is the text of the headline, everything except the leading stars.
+The return value is a cons cell. The car is the headline text, usually
+just TEXT, but possibly modified if options have been extracted from the
+text. The cdr is the sectioning entry, similar to what is given
+in org-export-latex-classes.
-\(fn &rest ARGS)" t nil)
-
-(autoload 'org-export-as-utf8-to-buffer "org-ascii" "\
-Like `org-export-as-ascii-to-buffer', use utf8 encoding for symbols.
-
-\(fn &rest ARGS)" t nil)
-
-(autoload 'org-export-as-ascii-to-buffer "org-ascii" "\
-Call `org-export-as-ascii` with output to a temporary buffer.
-No file is created. The prefix ARG is passed through to `org-export-as-ascii'.
-
-\(fn ARG)" t nil)
+\(fn LEVEL TEXT)" nil nil)
-(autoload 'org-replace-region-by-ascii "org-ascii" "\
-Assume the current region has org-mode syntax, and convert it to plain ASCII.
-This can be used in any buffer. For example, you could write an
-itemized list in org-mode syntax in a Mail buffer and then use this
-command to convert it.
+(autoload 'org-beamer-mode "org-beamer" "\
+Special support for editing Org-mode files made to export to beamer.
-\(fn BEG END)" t nil)
-
-(autoload 'org-export-region-as-ascii "org-ascii" "\
-Convert region from BEG to END in org-mode buffer to plain ASCII.
-If prefix arg BODY-ONLY is set, omit file header, footer, and table of
-contents, and only produce the region of converted text, useful for
-cut-and-paste operations.
-If BUFFER is a buffer or a string, use/create that buffer as a target
-of the converted ASCII. If BUFFER is the symbol `string', return the
-produced ASCII as a string and leave not buffer behind. For example,
-a Lisp program could call this function in the following way:
-
- (setq ascii (org-export-region-as-ascii beg end t 'string))
-
-When called interactively, the output buffer is selected, and shown
-in a window. A non-interactive call will only return the buffer.
-
-\(fn BEG END &optional BODY-ONLY BUFFER)" t nil)
-
-(autoload 'org-export-as-ascii "org-ascii" "\
-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
-underlined headlines, default is 3. Lower levels will become bulleted
-lists. When HIDDEN is non-nil, don't display the ASCII buffer.
-EXT-PLIST is a property list with external parameters overriding
-org-mode's default settings, but still inferior to file-local
-settings. When TO-BUFFER is non-nil, create a buffer with that
-name and export to that buffer. If TO-BUFFER is the symbol
-`string', don't leave any buffer behind but just return the
-resulting ASCII as a string. When BODY-ONLY is set, don't produce
-the file header and footer. When PUB-DIR is set, use this as the
-publishing directory.
-
-\(fn ARG &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
-
-;;;***
-
-;;;### (autoloads (org-attach) "org-attach" "org/org-attach.el" (20045
-;;;;;; 30713))
-;;; Generated autoloads from org/org-attach.el
-
-(autoload 'org-attach "org-attach" "\
-The dispatcher for attachment commands.
-Shows a list of commands and prompts for another key to execute a command.
-
-\(fn)" t nil)
+\(fn &optional ARG)" t nil)
;;;***
-;;;### (autoloads (org-bbdb-anniversaries) "org-bbdb" "org/org-bbdb.el"
-;;;;;; (20164 29468))
-;;; Generated autoloads from org/org-bbdb.el
+;;;### (autoloads (org-capture-import-remember-templates org-capture
+;;;;;; org-capture-string) "org-capture" "org/org-capture.el" (20618
+;;;;;; 55210 422086 0))
+;;; Generated autoloads from org/org-capture.el
-(autoload 'org-bbdb-anniversaries "org-bbdb" "\
-Extract anniversaries from BBDB for display in the agenda.
+(autoload 'org-capture-string "org-capture" "\
-\(fn)" nil nil)
-;;;***
-
-;;;### (autoloads (org-capture-import-remember-templates org-capture-insert-template-here
-;;;;;; org-capture) "org-capture" "org/org-capture.el" (20168 57844))
-;;; Generated autoloads from org/org-capture.el
+\(fn STRING &optional KEYS)" t nil)
(autoload 'org-capture "org-capture" "\
Capture something.
@@ -20379,16 +20028,14 @@ 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.
-\(fn &optional GOTO KEYS)" t nil)
-
-(autoload 'org-capture-insert-template-here "org-capture" "\
+If `org-capture-use-agenda-date' is non-nil, capturing from the
+agenda will use the date at point as the default date.
-
-\(fn)" nil nil)
+\(fn &optional GOTO KEYS)" t nil)
(autoload 'org-capture-import-remember-templates "org-capture" "\
Set org-capture-templates to be similar to `org-remember-templates'.
@@ -20397,895 +20044,85 @@ 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" (20172 54913))
-;;; Generated autoloads from org/org-clock.el
-
-(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
-fontified, and then returned.
-
-\(fn &rest PROPS)" nil nil)
-
-(autoload 'org-clock-persistence-insinuate "org-clock" "\
-Set up hooks for clock persistence.
-
-\(fn)" nil nil)
-
-;;;***
-
-;;;### (autoloads (org-datetree-find-date-create) "org-datetree"
-;;;;;; "org/org-datetree.el" (20045 30713))
-;;; Generated autoloads from org/org-datetree.el
-
-(autoload 'org-datetree-find-date-create "org-datetree" "\
-Find or create an entry for DATE.
-If KEEP-RESTRICTION is non-nil, do not widen the buffer.
-When it is nil, the buffer will be widened to make sure an existing date
-tree can be found.
-
-\(fn DATE &optional KEEP-RESTRICTION)" nil nil)
-
-;;;***
-
-;;;### (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" (20045 30713))
-;;; Generated autoloads from org/org-docbook.el
-
-(autoload 'org-export-as-docbook-batch "org-docbook" "\
-Call `org-export-as-docbook' in batch style.
-This function can be used in batch processing.
-
-For example:
-
-$ emacs --batch
- --load=$HOME/lib/emacs/org.el
- --visit=MyOrgFile.org --funcall org-export-as-docbook-batch
-
-\(fn)" nil nil)
-
-(autoload 'org-export-as-docbook-to-buffer "org-docbook" "\
-Call `org-export-as-docbook' with output to a temporary buffer.
-No file is created.
-
-\(fn)" t nil)
-
-(autoload 'org-replace-region-by-docbook "org-docbook" "\
-Replace the region from BEG to END with its DocBook export.
-It assumes the region has `org-mode' syntax, and then convert it to
-DocBook. This can be used in any buffer. For example, you could
-write an itemized list in `org-mode' syntax in an DocBook buffer and
-then use this command to convert it.
-
-\(fn BEG END)" t nil)
-
-(autoload 'org-export-region-as-docbook "org-docbook" "\
-Convert region from BEG to END in `org-mode' buffer to DocBook.
-If prefix arg BODY-ONLY is set, omit file header and footer and
-only produce the region of converted text, useful for
-cut-and-paste operations. If BUFFER is a buffer or a string,
-use/create that buffer as a target of the converted DocBook. If
-BUFFER is the symbol `string', return the produced DocBook as a
-string and leave not buffer behind. For example, a Lisp program
-could call this function in the following way:
-
- (setq docbook (org-export-region-as-docbook beg end t 'string))
-
-When called interactively, the output buffer is selected, and shown
-in a window. A non-interactive call will only return the buffer.
-
-\(fn BEG END &optional BODY-ONLY BUFFER)" t nil)
-
-(autoload 'org-export-as-docbook-pdf "org-docbook" "\
-Export as DocBook XML file, and generate PDF file.
-
-\(fn &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
-
-(autoload 'org-export-as-docbook-pdf-and-open "org-docbook" "\
-Export as DocBook XML file, generate PDF file, and open it.
-
-\(fn)" t nil)
-
-(autoload 'org-export-as-docbook "org-docbook" "\
-Export the current buffer as a DocBook file.
-If there is an active region, export only the region. When
-HIDDEN is obsolete and does nothing. EXT-PLIST is a
-property list with external parameters overriding org-mode's
-default settings, but still inferior to file-local settings.
-When TO-BUFFER is non-nil, create a buffer with that name and
-export to that buffer. If TO-BUFFER is the symbol `string',
-don't leave any buffer behind but just return the resulting HTML
-as a string. When BODY-ONLY is set, don't produce the file
-header and footer, simply return the content of the document (all
-top-level sections). When PUB-DIR is set, use this as the
-publishing directory.
-
-\(fn &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
-
-;;;***
-
-;;;### (autoloads (org-insert-export-options-template org-export-as-org
-;;;;;; org-export-visible org-export) "org-exp" "org/org-exp.el"
-;;;;;; (20167 36967))
-;;; Generated autoloads from org/org-exp.el
-
-(autoload 'org-export "org-exp" "\
-Export dispatcher for Org-mode.
-When `org-export-run-in-background' is non-nil, try to run the command
-in the background. This will be done only for commands that write
-to a file. For details see the docstring of `org-export-run-in-background'.
-
-The prefix argument ARG will be passed to the exporter. However, if
-ARG is a double universal prefix \\[universal-argument] \\[universal-argument], that means to inverse the
-value of `org-export-run-in-background'.
-
-If `org-export-initial-scope' is set to 'subtree, try to export
-the current subtree, otherwise try to export the whole buffer.
-Pressing `1' will switch between these two options.
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'org-export-visible "org-exp" "\
-Create a copy of the visible part of the current buffer, and export it.
-The copy is created in a temporary buffer and removed after use.
-TYPE is the final key (as a string) that also selects the export command in
-the \\<org-mode-map>\\[org-export] export dispatcher.
-As a special case, if the you type SPC at the prompt, the temporary
-org-mode file will not be removed but presented to you so that you can
-continue to use it. The prefix arg ARG is passed through to the exporting
-command.
-
-\(fn TYPE ARG)" t nil)
-
-(autoload 'org-export-as-org "org-exp" "\
-Make a copy with not-exporting stuff removed.
-The purpose of this function is to provide a way to export the source
-Org file of a webpage in Org format, but with sensitive and/or irrelevant
-stuff removed. This command will remove the following:
-
-- archived trees (if the variable `org-export-with-archived-trees' is nil)
-- comment blocks and trees starting with the COMMENT keyword
-- only trees that are consistent with `org-export-select-tags'
- and `org-export-exclude-tags'.
-
-The only arguments that will be used are EXT-PLIST and PUB-DIR,
-all the others will be ignored (but are present so that the general
-mechanism to call publishing functions will work).
-
-EXT-PLIST is a property list with external parameters overriding
-org-mode's default settings, but still inferior to file-local
-settings. When PUB-DIR is set, use this as the publishing
-directory.
-
-\(fn ARG &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
-
-(autoload 'org-insert-export-options-template "org-exp" "\
-Insert into the buffer a template with information for exporting.
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update
-;;;;;; org-feed-update-all) "org-feed" "org/org-feed.el" (20065
-;;;;;; 65310))
-;;; Generated autoloads from org/org-feed.el
-
-(autoload 'org-feed-update-all "org-feed" "\
-Get inbox items from all feeds in `org-feed-alist'.
-
-\(fn)" t nil)
-
-(autoload 'org-feed-update "org-feed" "\
-Get inbox items from FEED.
-FEED can be a string with an association in `org-feed-alist', or
-it can be a list structured like an entry in `org-feed-alist'.
-
-\(fn FEED &optional RETRIEVE-ONLY)" t nil)
-
-(autoload 'org-feed-goto-inbox "org-feed" "\
-Go to the inbox that captures the feed named FEED.
-
-\(fn FEED)" t nil)
-
-(autoload 'org-feed-show-raw-feed "org-feed" "\
-Show the raw feed buffer of a feed.
-
-\(fn FEED)" t nil)
-
-;;;***
-
-;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote"
-;;;;;; "org/org-footnote.el" (20161 45793))
-;;; Generated autoloads from org/org-footnote.el
-
-(autoload 'org-footnote-action "org-footnote" "\
-Do the right thing for footnotes.
-
-When at a footnote reference, jump to the definition.
-
-When at a definition, jump to the references if they exist, offer
-to create them otherwise.
-
-When neither at definition or reference, create a new footnote,
-interactively.
-
-With prefix arg SPECIAL, offer additional commands in a menu.
-
-\(fn &optional SPECIAL)" t nil)
-
-(autoload 'org-footnote-normalize "org-footnote" "\
-Collect the footnotes in various formats and normalize them.
-
-This finds the different sorts of footnotes allowed in Org, and
-normalizes them to the usual [N] format that is understood by the
-Org-mode exporters.
-
-When SORT-ONLY is set, only sort the footnote definitions into the
-referenced sequence.
-
-If Org is amidst an export process, EXPORT-PROPS will hold the
-export properties of the buffer.
-
-When EXPORT-PROPS is non-nil, the default action is to insert
-normalized footnotes towards the end of the pre-processing buffer.
-Some exporters like docbook, odt, etc. expect that footnote
-definitions be available before any references to them. Such
-exporters can let bind `org-footnote-insert-pos-for-preprocessor' to
-symbol 'point-min to achieve the desired behavior.
-
-Additional note on `org-footnote-insert-pos-for-preprocessor':
-1. This variable has not effect when FOR-PREPROCESSOR is nil.
-2. This variable (potentially) obviates the need for extra scan
- of pre-processor buffer as witnessed in
- `org-export-docbook-get-footnotes'.
-
-\(fn &optional SORT-ONLY EXPORT-PROPS)" nil nil)
-
-;;;***
-
-;;;### (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" (20172 54913))
-;;; Generated autoloads from org/org-freemind.el
-
-(autoload 'org-export-as-freemind "org-freemind" "\
-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
-external parameters overriding org-mode's default settings, but
-still inferior to file-local settings. When TO-BUFFER is
-non-nil, create a buffer with that name and export to that
-buffer. If TO-BUFFER is the symbol `string', don't leave any
-buffer behind but just return the resulting HTML as a string.
-When BODY-ONLY is set, don't produce the file header and footer,
-simply return the content of the document (all top level
-sections). When PUB-DIR is set, use this as the publishing
-directory.
-
-See `org-freemind-from-org-mode' for more information.
-
-\(fn &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
-
-(autoload 'org-freemind-show "org-freemind" "\
-Show file MM-FILE in Freemind.
-
-\(fn MM-FILE)" t nil)
-
-(autoload 'org-freemind-from-org-mode-node "org-freemind" "\
-Convert node at line NODE-LINE to the FreeMind file MM-FILE.
-See `org-freemind-from-org-mode' for more information.
-
-\(fn NODE-LINE MM-FILE)" t nil)
-
-(autoload 'org-freemind-from-org-mode "org-freemind" "\
-Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE.
-All the nodes will be opened or closed in Freemind just as you
-have them in `org-mode'.
-
-Note that exporting to Freemind also gives you an alternative way
-to export from `org-mode' to html. You can create a dynamic html
-version of the your org file, by first exporting to Freemind and
-then exporting from Freemind to html. The 'As
-XHTML (JavaScript)' version in Freemind works very well (and you
-can use a CSS stylesheet to style it).
-
-\(fn ORG-FILE MM-FILE)" t nil)
-
-(autoload 'org-freemind-from-org-sparse-tree "org-freemind" "\
-Convert visible part of buffer ORG-BUFFER to FreeMind file MM-FILE.
-
-\(fn ORG-BUFFER MM-FILE)" t nil)
-
-(autoload 'org-freemind-to-org-mode "org-freemind" "\
-Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE.
-
-\(fn MM-FILE ORG-FILE)" t nil)
-
-;;;***
-
-;;;### (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" (20065 65310))
-;;; Generated autoloads from org/org-html.el
-
-(put 'org-export-html-style-include-default 'safe-local-variable 'booleanp)
-
-(put 'org-export-html-style 'safe-local-variable 'stringp)
-
-(put 'org-export-html-style-extra 'safe-local-variable 'stringp)
-
-(autoload 'org-export-as-html-and-open "org-html" "\
-Export the outline as HTML and immediately open it with a browser.
-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.
-
-\(fn ARG)" t nil)
-
-(autoload 'org-export-as-html-batch "org-html" "\
-Call the function `org-export-as-html'.
-This function can be used in batch processing as:
-emacs --batch
- --load=$HOME/lib/emacs/org.el
- --eval \"(setq org-export-headline-levels 2)\"
- --visit=MyFile --funcall org-export-as-html-batch
-
-\(fn)" nil nil)
-
-(autoload 'org-export-as-html-to-buffer "org-html" "\
-Call `org-export-as-html` with output to a temporary buffer.
-No file is created. The prefix ARG is passed through to `org-export-as-html'.
-
-\(fn ARG)" t nil)
-
-(autoload 'org-replace-region-by-html "org-html" "\
-Assume the current region has org-mode syntax, and convert it to HTML.
-This can be used in any buffer. For example, you could write an
-itemized list in org-mode syntax in an HTML buffer and then use this
-command to convert it.
-
-\(fn BEG END)" t nil)
-
-(autoload 'org-export-region-as-html "org-html" "\
-Convert region from BEG to END in org-mode buffer to HTML.
-If prefix arg BODY-ONLY is set, omit file header, footer, and table of
-contents, and only produce the region of converted text, useful for
-cut-and-paste operations.
-If BUFFER is a buffer or a string, use/create that buffer as a target
-of the converted HTML. If BUFFER is the symbol `string', return the
-produced HTML as a string and leave not buffer behind. For example,
-a Lisp program could call this function in the following way:
-
- (setq html (org-export-region-as-html beg end t 'string))
-
-When called interactively, the output buffer is selected, and shown
-in a window. A non-interactive call will only return the buffer.
-
-\(fn BEG END &optional BODY-ONLY BUFFER)" t nil)
-
-(autoload 'org-export-as-html "org-html" "\
-Export the outline as a pretty HTML file.
-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. HIDDEN is obsolete and does nothing.
-EXT-PLIST is a property list with external parameters overriding
-org-mode's default settings, but still inferior to file-local
-settings. When TO-BUFFER is non-nil, create a buffer with that
-name and export to that buffer. If TO-BUFFER is the symbol
-`string', don't leave any buffer behind but just return the
-resulting HTML as a string. When BODY-ONLY is set, don't produce
-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.
-
-\(fn ARG &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
-
-(autoload 'org-export-htmlize-generate-css "org-html" "\
-Create the CSS for all font definitions in the current Emacs session.
-Use this to create face definitions in your CSS style file that can then
-be used by code snippets transformed by htmlize.
-This command just produces a buffer that contains class definitions for all
-faces used in the current Emacs session. You can copy and paste the ones you
-need into your CSS file.
-
-If you then set `org-export-htmlize-output-type' to `css', calls to
-the function `org-export-htmlize-region-for-paste' will produce code
-that uses these same face definitions.
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (autoloads (org-export-icalendar-combine-agenda-files org-export-icalendar-all-agenda-files
-;;;;;; org-export-icalendar-this-file) "org-icalendar" "org/org-icalendar.el"
-;;;;;; (20164 29468))
-;;; Generated autoloads from org/org-icalendar.el
-
-(autoload 'org-export-icalendar-this-file "org-icalendar" "\
-Export current file as an iCalendar file.
-The iCalendar file will be located in the same directory as the Org-mode
-file, but with extension `.ics'.
-
-\(fn)" t nil)
-
-(autoload 'org-export-icalendar-all-agenda-files "org-icalendar" "\
-Export all files in the variable `org-agenda-files' to iCalendar .ics files.
-Each iCalendar file will be located in the same directory as the Org-mode
-file, but with extension `.ics'.
-
-\(fn)" t nil)
-
-(autoload 'org-export-icalendar-combine-agenda-files "org-icalendar" "\
-Export all files in `org-agenda-files' to a single combined iCalendar file.
-The file is stored under the name `org-combined-agenda-icalendar-file'.
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (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"
-;;;;;; (20065 65310))
-;;; Generated autoloads from org/org-id.el
-
-(autoload 'org-id-get-create "org-id" "\
-Create an ID for the current entry and return it.
-If the entry already has an ID, just return it.
-With optional argument FORCE, force the creation of a new ID.
-
-\(fn &optional FORCE)" t nil)
-
-(autoload 'org-id-copy "org-id" "\
-Copy the ID of the entry at point to the kill ring.
-Create an ID if necessary.
-
-\(fn)" t nil)
-
-(autoload 'org-id-get "org-id" "\
-Get the ID property of the entry at point-or-marker POM.
-If POM is nil, refer to the entry at point.
-If the entry does not have an ID, the function returns nil.
-However, when CREATE is non nil, create an ID if none is present already.
-PREFIX will be passed through to `org-id-new'.
-In any case, the ID of the entry is returned.
-
-\(fn &optional POM CREATE PREFIX)" nil nil)
-
-(autoload 'org-id-get-with-outline-path-completion "org-id" "\
-Use outline-path-completion to retrieve the ID of an entry.
-TARGETS may be a setting for `org-refile-targets' to define the eligible
-headlines. When omitted, all headlines in all agenda files are
-eligible.
-It returns the ID of the entry. If necessary, the ID is created.
-
-\(fn &optional TARGETS)" nil nil)
-
-(autoload 'org-id-get-with-outline-drilling "org-id" "\
-Use an outline-cycling interface to retrieve the ID of an entry.
-This only finds entries in the current buffer, using `org-get-location'.
-It returns the ID of the entry. If necessary, the ID is created.
-
-\(fn &optional TARGETS)" nil nil)
-
-(autoload 'org-id-goto "org-id" "\
-Switch to the buffer containing the entry with id ID.
-Move the cursor to that entry in that buffer.
-
-\(fn ID)" t nil)
-
-(autoload 'org-id-find "org-id" "\
-Return the location of the entry with the id ID.
-The return value is a cons cell (file-name . position), or nil
-if there is no entry with that ID.
-With optional argument MARKERP, return the position as a new marker.
-
-\(fn ID &optional MARKERP)" nil nil)
-
-(autoload 'org-id-find-id-file "org-id" "\
-Query the id database for the file in which this ID is located.
-
-\(fn ID)" nil nil)
-
-(autoload 'org-id-store-link "org-id" "\
-Store a link to the current entry, using its ID.
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (autoloads (org-indent-mode) "org-indent" "org/org-indent.el"
-;;;;;; (20045 30716))
-;;; Generated autoloads from org/org-indent.el
-
-(autoload 'org-indent-mode "org-indent" "\
-When active, indent text according to outline structure.
-
-Internally this works by adding `line-prefix' properties to all non-headlines.
-These properties are updated locally in idle time.
-FIXME: How to update when broken?
-
-\(fn &optional ARG)" t nil)
-
-;;;***
-
-;;;### (autoloads (org-irc-store-link) "org-irc" "org/org-irc.el"
-;;;;;; (20065 65310))
-;;; Generated autoloads from org/org-irc.el
-
-(autoload 'org-irc-store-link "org-irc" "\
-Dispatch to the appropriate function to store a link to an IRC session.
-
-\(fn)" nil nil)
-
-;;;***
-
-;;;### (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"
-;;;;;; (20164 29468))
-;;; Generated autoloads from org/org-latex.el
-
-(autoload 'org-export-as-latex-batch "org-latex" "\
-Call `org-export-as-latex', may be used in batch processing.
-For example:
-
-emacs --batch
- --load=$HOME/lib/emacs/org.el
- --eval \"(setq org-export-headline-levels 2)\"
- --visit=MyFile --funcall org-export-as-latex-batch
-
-\(fn)" nil nil)
-
-(autoload 'org-export-as-latex-to-buffer "org-latex" "\
-Call `org-export-as-latex` with output to a temporary buffer.
-No file is created. The prefix ARG is passed through to `org-export-as-latex'.
-
-\(fn ARG)" t nil)
-
-(autoload 'org-replace-region-by-latex "org-latex" "\
-Replace the region from BEG to END with its LaTeX export.
-It assumes the region has `org-mode' syntax, and then convert it to
-LaTeX. This can be used in any buffer. For example, you could
-write an itemized list in `org-mode' syntax in an LaTeX buffer and
-then use this command to convert it.
+;;;### (autoloads (org-agenda-columns org-insert-columns-dblock org-dblock-write:columnview
+;;;;;; org-columns) "org-colview" "org/org-colview.el" (20618 55210
+;;;;;; 422086 0))
+;;; Generated autoloads from org/org-colview.el
-\(fn BEG END)" t nil)
-
-(autoload 'org-export-region-as-latex "org-latex" "\
-Convert region from BEG to END in `org-mode' buffer to LaTeX.
-If prefix arg BODY-ONLY is set, omit file header, footer, and table of
-contents, and only produce the region of converted text, useful for
-cut-and-paste operations.
-If BUFFER is a buffer or a string, use/create that buffer as a target
-of the converted LaTeX. If BUFFER is the symbol `string', return the
-produced LaTeX as a string and leave no buffer behind. For example,
-a Lisp program could call this function in the following way:
-
- (setq latex (org-export-region-as-latex beg end t 'string))
-
-When called interactively, the output buffer is selected, and shown
-in a window. A non-interactive call will only return the buffer.
-
-\(fn BEG END &optional BODY-ONLY BUFFER)" t nil)
-
-(autoload 'org-export-as-latex "org-latex" "\
-Export current buffer to a LaTeX file.
-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 be exported
-depending on `org-export-latex-low-levels'. The default is to
-convert them as description lists.
-HIDDEN is obsolete and does nothing.
-EXT-PLIST is a property list with
-external parameters overriding org-mode's default settings, but
-still inferior to file-local settings. When TO-BUFFER is
-non-nil, create a buffer with that name and export to that
-buffer. If TO-BUFFER is the symbol `string', don't leave any
-buffer behind but just return the resulting LaTeX as a string.
-When BODY-ONLY is set, don't produce the file header and footer,
-simply return the content of \\begin{document}...\\end{document},
-without even the \\begin{document} and \\end{document} commands.
-when PUB-DIR is set, use this as the publishing directory.
-
-\(fn ARG &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
-
-(autoload 'org-export-as-pdf "org-latex" "\
-Export as LaTeX, then process through to PDF.
-
-\(fn ARG &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
-
-(autoload 'org-export-as-pdf-and-open "org-latex" "\
-Export as LaTeX, then process through to PDF, and open.
+(autoload 'org-columns "org-colview" "\
+Turn on column view on an org-mode file.
+When COLUMNS-FMT-STRING is non-nil, use it as the column format.
-\(fn ARG)" t nil)
+\(fn &optional COLUMNS-FMT-STRING)" t nil)
-;;;***
-
-;;;### (autoloads (org-mobile-create-sumo-agenda org-mobile-pull
-;;;;;; org-mobile-push) "org-mobile" "org/org-mobile.el" (20065
-;;;;;; 65310))
-;;; Generated autoloads from org/org-mobile.el
+(autoload 'org-dblock-write:columnview "org-colview" "\
+Write the column view table.
+PARAMS is a property list of parameters:
-(autoload 'org-mobile-push "org-mobile" "\
-Push the current state of Org affairs to the WebDAV directory.
-This will create the index file, copy all agenda files there, and also
-create all custom agenda views, for upload to the mobile phone.
+:width enforce same column widths with <N> specifiers.
+:id the :ID: property of the entry where the columns view
+ should be built. When the symbol `local', call locally.
+ When `global' call column view with the cursor at the beginning
+ of the buffer (usually this means that the whole buffer switches
+ to column view). When \"file:path/to/file.org\", invoke column
+ view at the start of that file. Otherwise, the ID is located
+ using `org-id-find'.
+:hlines When t, insert a hline before each item. When a number, insert
+ a hline before each level <= that number.
+: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.
+:format When non-nil, specify the column view format to use.
-\(fn)" t nil)
+\(fn PARAMS)" nil nil)
-(autoload 'org-mobile-pull "org-mobile" "\
-Pull the contents of `org-mobile-capture-file' and integrate them.
-Apply all flagged actions, flag entries to be flagged and then call an
-agenda view showing the flagged items.
+(autoload 'org-insert-columns-dblock "org-colview" "\
+Create a dynamic block capturing a column view table.
\(fn)" t nil)
-(autoload 'org-mobile-create-sumo-agenda "org-mobile" "\
-Create a file that contains all custom agenda views.
+(autoload 'org-agenda-columns "org-colview" "\
+Turn on or update column view in the agenda.
\(fn)" t nil)
;;;***
-;;;### (autoloads (org-plot/gnuplot) "org-plot" "org/org-plot.el"
-;;;;;; (20157 54694))
-;;; Generated autoloads from org/org-plot.el
+;;;### (autoloads (org-check-version) "org-compat" "org/org-compat.el"
+;;;;;; (20618 55210 422086 0))
+;;; Generated autoloads from org/org-compat.el
-(autoload 'org-plot/gnuplot "org-plot" "\
-Plot table using gnuplot. Gnuplot options can be specified with PARAMS.
-If not given options will be taken from the +PLOT
-line directly before or after the table.
+(autoload 'org-check-version "org-compat" "\
+Try very hard to provide sensible version strings.
-\(fn &optional PARAMS)" t nil)
+\(fn)" nil t)
;;;***
-;;;### (autoloads (org-publish-current-project org-publish-current-file
-;;;;;; org-publish-all org-publish) "org-publish" "org/org-publish.el"
-;;;;;; (20161 45793))
-;;; Generated autoloads from org/org-publish.el
-
-(defalias 'org-publish-project 'org-publish)
-
-(autoload 'org-publish "org-publish" "\
-Publish PROJECT.
+;;;### (autoloads (org-git-version org-release) "org-version" "org/org-version.el"
+;;;;;; (20618 55210 422086 0))
+;;; Generated autoloads from org/org-version.el
-\(fn PROJECT &optional FORCE)" t nil)
-
-(autoload 'org-publish-all "org-publish" "\
-Publish all projects.
-With prefix argument, remove all files in the timestamp
-directory and force publishing all files.
-
-\(fn &optional FORCE)" t nil)
-
-(autoload 'org-publish-current-file "org-publish" "\
-Publish the current file.
-With prefix argument, force publish the file.
-
-\(fn &optional FORCE)" t nil)
-
-(autoload 'org-publish-current-project "org-publish" "\
-Publish the project associated with the current file.
-With a prefix argument, force publishing of all files in
-the project.
-
-\(fn &optional FORCE)" t nil)
-
-;;;***
-
-;;;### (autoloads (org-remember-handler org-remember org-remember-apply-template
-;;;;;; org-remember-annotation org-remember-insinuate) "org-remember"
-;;;;;; "org/org-remember.el" (20165 31925))
-;;; Generated autoloads from org/org-remember.el
-
-(autoload 'org-remember-insinuate "org-remember" "\
-Setup remember.el for use with Org-mode.
+(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-remember-annotation "org-remember" "\
-Return a link to the current location as an annotation for remember.el.
-If you are using Org-mode files as target for data storage with
-remember.el, then the annotations should include a link compatible with the
-conventions in Org-mode. This function returns such a link.
+(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)
-(autoload 'org-remember-apply-template "org-remember" "\
-Initialize *remember* buffer with template, invoke `org-mode'.
-This function should be placed into `remember-mode-hook' and in fact requires
-to be run from that hook to function properly.
-
-\(fn &optional USE-CHAR SKIP-INTERACTIVE)" nil nil)
-
-(autoload 'org-remember "org-remember" "\
-Call `remember'. If this is already a remember buffer, re-apply template.
-If there is an active region, make sure remember uses it as initial content
-of the remember buffer.
-
-When called interactively with a \\[universal-argument] prefix argument GOTO, don't remember
-anything, just go to the file/headline where the selected template usually
-stores its notes. With a double prefix argument \\[universal-argument] \\[universal-argument], go to the last
-note stored by remember.
-
-Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character
-associated with a template in `org-remember-templates'.
-
-\(fn &optional GOTO ORG-FORCE-REMEMBER-TEMPLATE-CHAR)" t nil)
-
-(autoload 'org-remember-handler "org-remember" "\
-Store stuff from remember.el into an org file.
-When the template has specified a file and a headline, the entry is filed
-there, or in the location defined by `org-default-notes-file' and
-`org-remember-default-headline'.
-\\<org-remember-mode-map>
-If no defaults have been defined, or if the current prefix argument
-is 1 (using C-1 \\[org-remember-finalize] to exit remember), an interactive
-process is used to select the target location.
-
-When the prefix is 0 (i.e. when remember is exited with C-0 \\[org-remember-finalize]),
-the entry is filed to the same location as the previous note.
-
-When the prefix is 2 (i.e. when remember is exited with C-2 \\[org-remember-finalize]),
-the entry is filed as a subentry of the entry where the clock is
-currently running.
-
-When \\[universal-argument] has been used as prefix argument, the
-note is stored and Emacs moves point to the new location of the
-note, so that editing can be continued there (similar to
-inserting \"%&\" into the template).
-
-Before storing the note, the function ensures that the text has an
-org-mode-style headline, i.e. a first line that starts with
-a \"*\". If not, a headline is constructed from the current date and
-some additional data.
-
-If the variable `org-adapt-indentation' is non-nil, the entire text is
-also indented so that it starts in the same column as the headline
-\(i.e. after the stars).
-
-See also the variable `org-reverse-note-order'.
-
-\(fn)" nil nil)
-
-;;;***
-
-;;;### (autoloads (org-table-to-lisp orgtbl-mode turn-on-orgtbl)
-;;;;;; "org-table" "org/org-table.el" (20168 57844))
-;;; Generated autoloads from org/org-table.el
-
-(autoload 'turn-on-orgtbl "org-table" "\
-Unconditionally turn on `orgtbl-mode'.
-
-\(fn)" nil nil)
-
-(autoload 'orgtbl-mode "org-table" "\
-The `org-mode' table editor as a minor mode for use in other modes.
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'org-table-to-lisp "org-table" "\
-Convert the table at point to a Lisp structure.
-The structure will be a list. Each item is either the symbol `hline'
-for a horizontal separator line, or a list of field values as strings.
-The table is taken from the parameter TXT, or from the buffer at point.
-
-\(fn &optional TXT)" nil nil)
-
-;;;***
-
-;;;### (autoloads (org-export-as-taskjuggler-and-open org-export-as-taskjuggler)
-;;;;;; "org-taskjuggler" "org/org-taskjuggler.el" (20166 16092))
-;;; Generated autoloads from org/org-taskjuggler.el
-
-(autoload 'org-export-as-taskjuggler "org-taskjuggler" "\
-Export parts of the current buffer as a TaskJuggler file.
-The exporter looks for a tree with tag, property or todo that
-matches `org-export-taskjuggler-project-tag' and takes this as
-the tasks for this project. The first node of this tree defines
-the project properties such as project name and project period.
-If there is a tree with tag, property or todo that matches
-`org-export-taskjuggler-resource-tag' this three is taken as
-resources for the project. If no resources are specified, a
-default resource is created and allocated to the project. Also
-the taskjuggler project will be created with default reports as
-defined in `org-export-taskjuggler-default-reports'.
-
-\(fn)" t nil)
-
-(autoload 'org-export-as-taskjuggler-and-open "org-taskjuggler" "\
-Export the current buffer as a TaskJuggler file and open it
-with the TaskJuggler GUI.
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (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"
-;;;;;; (20045 30718))
-;;; Generated autoloads from org/org-timer.el
-
-(autoload 'org-timer-start "org-timer" "\
-Set the starting time for the relative timer to now.
-When called with prefix argument OFFSET, prompt the user for an offset time,
-with the default taken from a timer stamp at point, if any.
-If OFFSET is a string or an integer, it is directly taken to be the offset
-without user interaction.
-When called with a double prefix arg, all timer strings in the active
-region will be shifted by a specific amount. You will be prompted for
-the amount, with the default to make the first timer string in
-the region 0:00:00.
-
-\(fn &optional OFFSET)" 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
-a \\[universal-argument] prefix, force restarting the timer.
-When used with a double prefix argument \\[universal-argument], change all the timer string
-in the region by a fixed amount. This can be used to recalibrate a timer
-that was not started at the correct moment.
-
-If NO-INSERT-P is non-nil, return the string instead of inserting
-it in the buffer.
-
-\(fn &optional RESTART NO-INSERT-P)" t nil)
-
-(autoload 'org-timer-change-times-in-region "org-timer" "\
-Change all h:mm:ss time in region by a DELTA.
-
-\(fn BEG END DELTA)" t nil)
-
-(autoload 'org-timer-item "org-timer" "\
-Insert a description-type item with the current timer value.
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'org-timer-set-timer "org-timer" "\
-Prompt for a duration and set a timer.
-
-If `org-timer-default-timer' is not zero, suggest this value as
-the default duration for the timer. If a timer is already set,
-prompt the user if she wants to replace it.
-
-Called with a numeric prefix argument, use this numeric value as
-the duration of the timer.
-
-Called with a `C-u' prefix arguments, use `org-timer-default-timer'
-without prompting the user for a duration.
-
-With two `C-u' prefix arguments, use `org-timer-default-timer'
-without prompting the user for a duration and automatically
-replace any running timer.
-
-\(fn &optional OPT)" t nil)
-
-;;;***
-
-;;;### (autoloads (org-export-as-xoxo) "org-xoxo" "org/org-xoxo.el"
-;;;;;; (20045 30719))
-;;; Generated autoloads from org/org-xoxo.el
-
-(autoload 'org-export-as-xoxo "org-xoxo" "\
-Export the org buffer as XOXO.
-The XOXO buffer is named *xoxo-<source buffer name>*
-
-\(fn &optional BUFFER)" t nil)
+(defvar org-odt-data-dir "/usr/share/emacs/etc/org" "\
+The location of ODT styles.")
;;;***
;;;### (autoloads (outline-minor-mode outline-mode) "outline" "outline.el"
-;;;;;; (20162 63140))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from outline.el
(put 'outline-regexp 'safe-local-variable 'stringp)
(put 'outline-heading-end-regexp 'safe-local-variable 'stringp)
@@ -21349,7 +20186,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"
-;;;;;; (20168 57844))
+;;;;;; (20622 22438 32851 0))
;;; Generated autoloads from emacs-lisp/package.el
(defvar package-enable-at-startup t "\
@@ -21419,7 +20256,8 @@ The list is displayed in a buffer named `*Packages*'.
;;;***
-;;;### (autoloads (show-paren-mode) "paren" "paren.el" (20127 62865))
+;;;### (autoloads (show-paren-mode) "paren" "paren.el" (20542 50478
+;;;;;; 439878 507000))
;;; Generated autoloads from paren.el
(defvar show-paren-mode nil "\
@@ -21446,7 +20284,7 @@ matching parenthesis is highlighted in `show-paren-style' after
;;;***
;;;### (autoloads (parse-time-string) "parse-time" "calendar/parse-time.el"
-;;;;;; (19845 45374))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from calendar/parse-time.el
(put 'parse-time-rules 'risky-local-variable t)
@@ -21459,8 +20297,8 @@ unknown are returned as nil.
;;;***
-;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (20168
-;;;;;; 57844))
+;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from progmodes/pascal.el
(autoload 'pascal-mode "pascal" "\
@@ -21513,7 +20351,7 @@ no args, if that value is non-nil.
;;;***
;;;### (autoloads (password-in-cache-p password-cache-expiry password-cache)
-;;;;;; "password-cache" "password-cache.el" (20089 47591))
+;;;;;; "password-cache" "password-cache.el" (20577 33959 40183 0))
;;; Generated autoloads from password-cache.el
(defvar password-cache t "\
@@ -21535,7 +20373,7 @@ Check if KEY is in the cache.
;;;***
;;;### (autoloads (pcase-let pcase-let* pcase) "pcase" "emacs-lisp/pcase.el"
-;;;;;; (19863 8742))
+;;;;;; (20582 12914 894781 0))
;;; Generated autoloads from emacs-lisp/pcase.el
(autoload 'pcase "pcase" "\
@@ -21544,6 +20382,7 @@ CASES is a list of elements of the form (UPATTERN CODE...).
UPatterns can take the following forms:
_ matches anything.
+ SELFQUOTING matches itself. This includes keywords, numbers, and strings.
SYMBOL matches anything and binds it to SYMBOL.
(or UPAT...) matches if any of the patterns matches.
(and UPAT...) matches if all the patterns match.
@@ -21563,14 +20402,15 @@ QPatterns for vectors are not implemented yet.
PRED can take the form
FUNCTION in which case it gets called with one argument.
- (FUN ARG1 .. ARGN) in which case it gets called with N+1 arguments.
+ (FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument
+ which is the value being matched.
A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION).
PRED patterns can refer to variables bound earlier in the pattern.
E.g. you can match pairs where the cdr is larger than the car with a pattern
like `(,a . ,(pred (< a))) or, with more checks:
`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))
-\(fn EXP &rest CASES)" nil (quote macro))
+\(fn EXP &rest CASES)" nil t)
(put 'pcase 'lisp-indent-function '1)
@@ -21579,7 +20419,7 @@ Like `let*' but where you can use `pcase' patterns for bindings.
BODY should be an expression, and BINDINGS should be a list of bindings
of the form (UPAT EXP).
-\(fn BINDINGS &rest BODY)" nil (quote macro))
+\(fn BINDINGS &rest BODY)" nil t)
(put 'pcase-let* 'lisp-indent-function '1)
@@ -21588,14 +20428,14 @@ Like `let' but where you can use `pcase' patterns for bindings.
BODY should be a list of expressions, and BINDINGS should be a list of bindings
of the form (UPAT EXP).
-\(fn BINDINGS &rest BODY)" nil (quote macro))
+\(fn BINDINGS &rest BODY)" nil t)
(put 'pcase-let 'lisp-indent-function '1)
;;;***
-;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (20100
-;;;;;; 17869))
+;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from pcmpl-cvs.el
(autoload 'pcomplete/cvs "pcmpl-cvs" "\
@@ -21606,7 +20446,7 @@ Completion rules for the `cvs' command.
;;;***
;;;### (autoloads (pcomplete/tar pcomplete/make pcomplete/bzip2 pcomplete/gzip)
-;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (20104 14925))
+;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (20572 16038 402143 0))
;;; Generated autoloads from pcmpl-gnu.el
(autoload 'pcomplete/gzip "pcmpl-gnu" "\
@@ -21634,7 +20474,7 @@ Completion for the GNU tar utility.
;;;***
;;;### (autoloads (pcomplete/mount pcomplete/umount pcomplete/kill)
-;;;;;; "pcmpl-linux" "pcmpl-linux.el" (19986 58615))
+;;;;;; "pcmpl-linux" "pcmpl-linux.el" (20355 10021 546955 0))
;;; Generated autoloads from pcmpl-linux.el
(autoload 'pcomplete/kill "pcmpl-linux" "\
@@ -21654,8 +20494,8 @@ Completion for GNU/Linux `mount'.
;;;***
-;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (19961
-;;;;;; 55377))
+;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (20523
+;;;;;; 62082 997685 0))
;;; Generated autoloads from pcmpl-rpm.el
(autoload 'pcomplete/rpm "pcmpl-rpm" "\
@@ -21667,7 +20507,8 @@ Completion for the `rpm' command.
;;;### (autoloads (pcomplete/scp pcomplete/ssh pcomplete/chgrp pcomplete/chown
;;;;;; pcomplete/which pcomplete/xargs pcomplete/rm pcomplete/rmdir
-;;;;;; pcomplete/cd) "pcmpl-unix" "pcmpl-unix.el" (20121 24048))
+;;;;;; pcomplete/cd) "pcmpl-unix" "pcmpl-unix.el" (20376 40834 914217
+;;;;;; 0))
;;; Generated autoloads from pcmpl-unix.el
(autoload 'pcomplete/cd "pcmpl-unix" "\
@@ -21724,8 +20565,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" (20106
-;;;;;; 17429))
+;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (20582
+;;;;;; 12914 894781 0))
;;; Generated autoloads from pcomplete.el
(autoload 'pcomplete "pcomplete" "\
@@ -21784,7 +20625,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" (20164 60780))
+;;;;;; "vc/pcvs.el" (20584 7212 455152 0))
;;; Generated autoloads from vc/pcvs.el
(autoload 'cvs-checkout "pcvs" "\
@@ -21859,7 +20700,8 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d
;;;***
-;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (20174 10230))
+;;;### (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)) "\
@@ -21868,7 +20710,7 @@ Global menu used by PCL-CVS.")
;;;***
;;;### (autoloads (perl-mode) "perl-mode" "progmodes/perl-mode.el"
-;;;;;; (20108 12033))
+;;;;;; (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)
@@ -21930,7 +20772,7 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'.
;;;***
;;;### (autoloads (picture-mode) "picture" "textmodes/picture.el"
-;;;;;; (20093 44623))
+;;;;;; (20551 9899 283417 0))
;;; Generated autoloads from textmodes/picture.el
(autoload 'picture-mode "picture" "\
@@ -21980,7 +20822,7 @@ You can edit tabular text with these commands:
You can manipulate text with these commands:
Clear ARG columns after point without moving: \\[picture-clear-column]
- Delete char at point: \\[delete-char]
+ Delete char at point: \\[picture-delete-char]
Clear ARG columns backward: \\[picture-backward-clear-column]
Clear ARG lines, advancing over them: \\[picture-clear-line]
(the cleared text is saved in the kill ring)
@@ -22002,7 +20844,7 @@ by supplying an argument.
Entry to this mode calls the value of `picture-mode-hook' if non-nil.
Note that Picture mode commands will work outside of Picture mode, but
-they are not defaultly assigned to keys.
+they are not by default assigned to keys.
\(fn)" t nil)
@@ -22010,8 +20852,8 @@ they are not defaultly assigned to keys.
;;;***
-;;;### (autoloads (plstore-open) "plstore" "gnus/plstore.el" (20097
-;;;;;; 41737))
+;;;### (autoloads (plstore-mode plstore-open) "plstore" "gnus/plstore.el"
+;;;;;; (20378 29222 722320 0))
;;; Generated autoloads from gnus/plstore.el
(autoload 'plstore-open "plstore" "\
@@ -22019,10 +20861,15 @@ Create a plstore instance associated with FILE.
\(fn FILE)" nil nil)
+(autoload 'plstore-mode "plstore" "\
+Major mode for editing PLSTORE files.
+
+\(fn)" t nil)
+
;;;***
;;;### (autoloads (po-find-file-coding-system) "po" "textmodes/po.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from textmodes/po.el
(autoload 'po-find-file-coding-system "po" "\
@@ -22033,7 +20880,8 @@ Called through `file-coding-system-alist', before the file is visited for real.
;;;***
-;;;### (autoloads (pong) "pong" "play/pong.el" (19845 45374))
+;;;### (autoloads (pong) "pong" "play/pong.el" (20478 3673 653810
+;;;;;; 0))
;;; Generated autoloads from play/pong.el
(autoload 'pong "pong" "\
@@ -22049,7 +20897,8 @@ pong-mode keybindings:\\<pong-mode-map>
;;;***
-;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (20178 7273))
+;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (20458 56750
+;;;;;; 651721 0))
;;; Generated autoloads from gnus/pop3.el
(autoload 'pop3-movemail "pop3" "\
@@ -22062,7 +20911,7 @@ Use streaming commands.
;;;### (autoloads (pp-macroexpand-last-sexp pp-eval-last-sexp pp-macroexpand-expression
;;;;;; pp-eval-expression pp pp-buffer pp-to-string) "pp" "emacs-lisp/pp.el"
-;;;;;; (19845 45374))
+;;;;;; (20495 51111 757560 0))
;;; Generated autoloads from emacs-lisp/pp.el
(autoload 'pp-to-string "pp" "\
@@ -22130,7 +20979,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"
-;;;;;; (20175 31160))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from printing.el
(autoload 'pr-interface "printing" "\
@@ -22639,12 +21488,12 @@ Interactively, you have the following situations:
M-x pr-ps-fast-fire RET
The command prompts the user for a N-UP value and printing will
- immediatelly be done using the current active printer.
+ immediately be done using the current active printer.
C-u M-x pr-ps-fast-fire RET
C-u 0 M-x pr-ps-fast-fire RET
The command prompts the user for a N-UP value and also for a current
- PostScript printer, then printing will immediatelly be done using the new
+ PostScript printer, then printing will immediately be done using the new
current active printer.
C-u 1 M-x pr-ps-fast-fire RET
@@ -22665,7 +21514,7 @@ zero and the argument SELECT is treated as follows:
If it's nil, send the image to the printer.
If it's a list or an integer lesser or equal to zero, the command prompts
- the user for a current PostScript printer, then printing will immediatelly
+ the user for a current PostScript printer, then printing will immediately
be done using the new current active printer.
If it's an integer equal to 1, the command prompts the user for a file name
@@ -22678,7 +21527,7 @@ zero and the argument SELECT is treated as follows:
instead of sending it to the printer.
If it's a symbol which it's defined in `pr-ps-printer-alist', it's the new
- active printer and printing will immediatelly be done using the new active
+ active printer and printing will immediately be done using the new active
printer.
Otherwise, send the image to the printer.
@@ -22705,7 +21554,7 @@ Noninteractively, the argument SELECT-PRINTER is treated as follows:
If it's nil, the printing is sent to the current active text printer.
If it's a symbol which it's defined in `pr-txt-printer-alist', it's the new
- active printer and printing will immediatelly be done using the new active
+ active printer and printing will immediately be done using the new active
printer.
If it's non-nil, the command prompts the user for a new active text printer.
@@ -22717,23 +21566,57 @@ are both set to t.
;;;***
-;;;### (autoloads (proced) "proced" "proced.el" (20053 39261))
+;;;### (autoloads (proced) "proced" "proced.el" (20593 22184 581574
+;;;;;; 0))
;;; Generated autoloads from proced.el
(autoload 'proced "proced" "\
Generate a listing of UNIX system processes.
-If invoked with optional ARG the window displaying the process
-information will be displayed but not selected.
-Runs the normal hook `proced-post-display-hook'.
+\\<proced-mode-map>
+If invoked with optional ARG, do not select the window displaying
+the process information.
-See `proced-mode' for a description of features available in Proced buffers.
+This function runs the normal hook `proced-post-display-hook'.
+
+See `proced-mode' for a description of features available in
+Proced buffers.
\(fn &optional ARG)" t nil)
;;;***
+;;;### (autoloads (profiler-find-profile-other-frame profiler-find-profile-other-window
+;;;;;; profiler-find-profile profiler-start) "profiler" "profiler.el"
+;;;;;; (20619 46245 806932 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" (20176 51947))
+;;;;;; "progmodes/prolog.el" (20576 42138 697312 0))
;;; Generated autoloads from progmodes/prolog.el
(autoload 'prolog-mode "prolog" "\
@@ -22768,8 +21651,8 @@ With prefix argument ARG, restart the Prolog process if running before.
;;;***
-;;;### (autoloads (bdf-directory-list) "ps-bdf" "ps-bdf.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (bdf-directory-list) "ps-bdf" "ps-bdf.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from ps-bdf.el
(defvar bdf-directory-list (if (memq system-type '(ms-dos windows-nt)) (list (expand-file-name "fonts/bdf" installation-directory)) '("/usr/local/share/emacs/fonts/bdf")) "\
@@ -22780,8 +21663,8 @@ The default value is '(\"/usr/local/share/emacs/fonts/bdf\").")
;;;***
-;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (20167
-;;;;;; 36967))
+;;;### (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" "\
@@ -22832,8 +21715,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" (20172
-;;;;;; 55048))
+;;;;;; 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"))) "\
@@ -23029,94 +21912,44 @@ If EXTENSION is any other symbol, it is ignored.
;;;***
-;;;### (autoloads (jython-mode python-mode python-after-info-look
-;;;;;; run-python) "python" "progmodes/python.el" (20170 13157))
+;;;### (autoloads (python-mode run-python) "python" "progmodes/python.el"
+;;;;;; (20599 27513 576550 0))
;;; Generated autoloads from progmodes/python.el
-(add-to-list 'interpreter-mode-alist (cons (purecopy "jython") 'jython-mode))
+(add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode))
(add-to-list 'interpreter-mode-alist (cons (purecopy "python") 'python-mode))
-(add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode))
-
(autoload 'run-python "python" "\
-Run an inferior Python process, input and output via buffer *Python*.
-CMD is the Python command to run. NOSHOW non-nil means don't
-show the buffer automatically.
-
-Interactively, a prefix arg means to prompt for the initial
-Python command line (default is `python-command').
-
-A new process is started if one isn't running attached to
-`python-buffer', or if called from Lisp with non-nil arg NEW.
-Otherwise, if a process is already running in `python-buffer',
-switch to that buffer.
-
-This command runs the hook `inferior-python-mode-hook' after
-running `comint-mode-hook'. Type \\[describe-mode] in the
-process buffer for a list of commands.
+Run an inferior Python process.
+Input and output via buffer named after
+`python-shell-buffer-name'. If there is a process already
+running in that buffer, just switch to it.
-By default, Emacs inhibits the loading of Python modules from the
-current working directory, for security reasons. To disable this
-behavior, change `python-remove-cwd-from-path' to nil.
+With argument, allows you to define CMD so you can edit the
+command used to call the interpreter and define DEDICATED, so a
+dedicated process for the current buffer is open. When numeric
+prefix arg is other than 0 or 4 do not SHOW.
-\(fn &optional CMD NOSHOW NEW)" t nil)
+Runs the hook `inferior-python-mode-hook' (after the
+`comint-mode-hook' is run). (Type \\[describe-mode] in the
+process buffer for a list of commands.)
-(autoload 'python-after-info-look "python" "\
-Set up info-look for Python.
-Used with `eval-after-load'.
-
-\(fn)" nil nil)
+\(fn CMD &optional DEDICATED SHOW)" t nil)
(autoload 'python-mode "python" "\
Major mode for editing Python files.
-Turns on Font Lock mode unconditionally since it is currently required
-for correct parsing of the source.
-See also `jython-mode', which is actually invoked if the buffer appears to
-contain Jython code. See also `run-python' and associated Python mode
-commands for running Python under Emacs.
-
-The Emacs commands which work with `defun's, e.g. \\[beginning-of-defun], deal
-with nested `def' and `class' blocks. They take the innermost one as
-current without distinguishing method and class definitions. Used multiple
-times, they move over others at the same indentation level until they reach
-the end of definitions at that level, when they move up a level.
-\\<python-mode-map>
-Colon is electric: it outdents the line if appropriate, e.g. for
-an else statement. \\[python-backspace] at the beginning of an indented statement
-deletes a level of indentation to close the current block; otherwise it
-deletes a character backward. TAB indents the current line relative to
-the preceding code. Successive TABs, with no intervening command, cycle
-through the possibilities for indentation on the basis of enclosing blocks.
-
-\\[fill-paragraph] fills comments and multi-line strings appropriately, but has no
-effect outside them.
-
-Supports Eldoc mode (only for functions, using a Python process),
-Info-Look and Imenu. In Outline minor mode, `class' and `def'
-lines count as headers. Symbol completion is available in the
-same way as in the Python shell using the `rlcompleter' module
-and this is added to the Hippie Expand functions locally if
-Hippie Expand mode is turned on. Completion of symbols of the
-form x.y only works if the components are literal
-module/attribute names, not variables. An abbrev table is set up
-with skeleton expansions for compound statement templates.
\\{python-mode-map}
-
-\(fn)" t nil)
-
-(autoload 'jython-mode "python" "\
-Major mode for editing Jython files.
-Like `python-mode', but sets up parameters for Jython subprocesses.
-Runs `jython-mode-hook' after `python-mode-hook'.
+Entry to this mode calls the value of `python-mode-hook'
+if that value is non-nil.
\(fn)" t nil)
;;;***
;;;### (autoloads (quoted-printable-decode-region) "qp" "gnus/qp.el"
-;;;;;; (19845 45374))
+;;;;;; (20557 48712 315579 0))
;;; Generated autoloads from gnus/qp.el
(autoload 'quoted-printable-decode-region "qp" "\
@@ -23139,7 +21972,7 @@ them into characters should be done separately.
;;;;;; quail-defrule quail-install-decode-map quail-install-map
;;;;;; quail-define-rules quail-show-keyboard-layout quail-set-keyboard-layout
;;;;;; quail-define-package quail-use-package quail-title) "quail"
-;;;;;; "international/quail.el" (20166 16092))
+;;;;;; "international/quail.el" (20523 62082 997685 0))
;;; Generated autoloads from international/quail.el
(autoload 'quail-title "quail" "\
@@ -23289,7 +22122,7 @@ the following annotation types are supported.
no-decode-map --- the value non-nil means that decoding map is not
generated for the following translations.
-\(fn &rest RULES)" nil (quote macro))
+\(fn &rest RULES)" nil t)
(autoload 'quail-install-map "quail" "\
Install the Quail map MAP in the current Quail package.
@@ -23370,8 +22203,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" (20168
-;;;;;; 57844))
+;;;;;; 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" "\
@@ -23383,7 +22216,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.
@@ -23443,7 +22276,7 @@ Display `quickurl-list' as a formatted list using `quickurl-list-mode'.
;;;***
;;;### (autoloads (rcirc-track-minor-mode rcirc-connect rcirc) "rcirc"
-;;;;;; "net/rcirc.el" (20170 13157))
+;;;;;; "net/rcirc.el" (20614 54428 654267 0))
;;; Generated autoloads from net/rcirc.el
(autoload 'rcirc "rcirc" "\
@@ -23473,13 +22306,16 @@ or call the function `rcirc-track-minor-mode'.")
(autoload 'rcirc-track-minor-mode "rcirc" "\
Global minor mode for tracking activity in rcirc buffers.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
\(fn &optional ARG)" t nil)
;;;***
-;;;### (autoloads (remote-compile) "rcompile" "net/rcompile.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (remote-compile) "rcompile" "net/rcompile.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from net/rcompile.el
(autoload 'remote-compile "rcompile" "\
@@ -23491,7 +22327,7 @@ See \\[compile].
;;;***
;;;### (autoloads (re-builder) "re-builder" "emacs-lisp/re-builder.el"
-;;;;;; (19975 1875))
+;;;;;; (20427 14766 970343 0))
;;; Generated autoloads from emacs-lisp/re-builder.el
(defalias 'regexp-builder 're-builder)
@@ -23509,7 +22345,8 @@ matching parts of the target buffer will be highlighted.
;;;***
-;;;### (autoloads (recentf-mode) "recentf" "recentf.el" (20167 36967))
+;;;### (autoloads (recentf-mode) "recentf" "recentf.el" (20356 2211
+;;;;;; 532900 0))
;;; Generated autoloads from recentf.el
(defvar recentf-mode nil "\
@@ -23537,17 +22374,10 @@ were operated on recently.
;;;### (autoloads (rectangle-number-lines clear-rectangle string-insert-rectangle
;;;;;; string-rectangle delete-whitespace-rectangle open-rectangle
-;;;;;; insert-rectangle yank-rectangle kill-rectangle extract-rectangle
-;;;;;; delete-extract-rectangle delete-rectangle) "rect" "rect.el"
-;;;;;; (19999 41597))
+;;;;;; insert-rectangle yank-rectangle copy-rectangle-as-kill kill-rectangle
+;;;;;; extract-rectangle delete-extract-rectangle delete-rectangle)
+;;;;;; "rect" "rect.el" (20501 3499 284800 0))
;;; Generated autoloads from rect.el
- (define-key ctl-x-r-map "c" 'clear-rectangle)
- (define-key ctl-x-r-map "k" 'kill-rectangle)
- (define-key ctl-x-r-map "d" 'delete-rectangle)
- (define-key ctl-x-r-map "y" 'yank-rectangle)
- (define-key ctl-x-r-map "o" 'open-rectangle)
- (define-key ctl-x-r-map "t" 'string-rectangle)
- (define-key ctl-x-r-map "N" 'rectangle-number-lines)
(autoload 'delete-rectangle "rect" "\
Delete (don't save) text in the region-rectangle.
@@ -23594,6 +22424,11 @@ even beep.)
\(fn START END &optional FILL)" t nil)
+(autoload 'copy-rectangle-as-kill "rect" "\
+Copy the region-rectangle and save it as the last killed one.
+
+\(fn START END)" t nil)
+
(autoload 'yank-rectangle "rect" "\
Yank the last killed rectangle with upper left corner at point.
@@ -23675,8 +22510,8 @@ with a prefix argument, prompt for START-AT and FORMAT.
;;;***
-;;;### (autoloads (refill-mode) "refill" "textmodes/refill.el" (20127
-;;;;;; 62865))
+;;;### (autoloads (refill-mode) "refill" "textmodes/refill.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from textmodes/refill.el
(autoload 'refill-mode "refill" "\
@@ -23697,7 +22532,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" (20164 60780))
+;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (20590 45996
+;;;;;; 129575 0))
;;; Generated autoloads from textmodes/reftex.el
(autoload 'turn-on-reftex "reftex" "\
@@ -23706,13 +22542,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]'.
@@ -23753,7 +22583,7 @@ This enforces rescanning the buffer on next use.
;;;***
;;;### (autoloads (reftex-citation) "reftex-cite" "textmodes/reftex-cite.el"
-;;;;;; (20168 57844))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from textmodes/reftex-cite.el
(autoload 'reftex-citation "reftex-cite" "\
@@ -23783,7 +22613,7 @@ While entering the regexp, completion on knows citation keys is possible.
;;;***
;;;### (autoloads (reftex-isearch-minor-mode) "reftex-global" "textmodes/reftex-global.el"
-;;;;;; (20164 60780))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from textmodes/reftex-global.el
(autoload 'reftex-isearch-minor-mode "reftex-global" "\
@@ -23800,7 +22630,7 @@ With no argument, this command toggles
;;;***
;;;### (autoloads (reftex-index-phrases-mode) "reftex-index" "textmodes/reftex-index.el"
-;;;;;; (20162 63140))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from textmodes/reftex-index.el
(autoload 'reftex-index-phrases-mode "reftex-index" "\
@@ -23833,7 +22663,7 @@ Here are all local bindings.
;;;***
;;;### (autoloads (reftex-all-document-files) "reftex-parse" "textmodes/reftex-parse.el"
-;;;;;; (20161 45793))
+;;;;;; (20585 28088 480237 0))
;;; Generated autoloads from textmodes/reftex-parse.el
(autoload 'reftex-all-document-files "reftex-parse" "\
@@ -23845,8 +22675,8 @@ of master file.
;;;***
-;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (19845
-;;;;;; 45374))
+;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (20593
+;;;;;; 22184 581574 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))))
@@ -23856,7 +22686,7 @@ of master file.
;;;***
;;;### (autoloads (regexp-opt-depth regexp-opt) "regexp-opt" "emacs-lisp/regexp-opt.el"
-;;;;;; (19845 45374))
+;;;;;; (20522 38650 757441 0))
;;; Generated autoloads from emacs-lisp/regexp-opt.el
(autoload 'regexp-opt "regexp-opt" "\
@@ -23887,7 +22717,7 @@ This means the number of non-shy regexp grouping constructs
;;;### (autoloads (remember-diary-extract-entries remember-clipboard
;;;;;; remember-other-frame remember) "remember" "textmodes/remember.el"
-;;;;;; (20161 45793))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from textmodes/remember.el
(autoload 'remember "remember" "\
@@ -23918,14 +22748,15 @@ Extract diary entries from the region.
;;;***
-;;;### (autoloads (repeat) "repeat" "repeat.el" (20172 54913))
+;;;### (autoloads (repeat) "repeat" "repeat.el" (20614 54428 654267
+;;;;;; 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
@@ -23941,7 +22772,7 @@ recently executed command not bound to an input event\".
;;;***
;;;### (autoloads (reporter-submit-bug-report) "reporter" "mail/reporter.el"
-;;;;;; (20076 35541))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mail/reporter.el
(autoload 'reporter-submit-bug-report "reporter" "\
@@ -23973,7 +22804,7 @@ mail-sending package is used for editing and sending the message.
;;;***
;;;### (autoloads (reposition-window) "reposition" "reposition.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from reposition.el
(autoload 'reposition-window "reposition" "\
@@ -24000,16 +22831,16 @@ first comment line visible (if point is in a comment).
;;;***
;;;### (autoloads (global-reveal-mode reveal-mode) "reveal" "reveal.el"
-;;;;;; (20127 62865))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from reveal.el
(autoload 'reveal-mode "reveal" "\
-Toggle decloaking of invisible text near point (Reveal mode).
+Toggle uncloaking of invisible text near point (Reveal mode).
With a prefix argument ARG, enable Reveal mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
Reveal mode if ARG is omitted or nil.
-Reveral mode is a buffer-local minor mode. When enabled, it
+Reveal mode is a buffer-local minor mode. When enabled, it
reveals invisible text around point.
\(fn &optional ARG)" t nil)
@@ -24036,7 +22867,7 @@ the mode if ARG is omitted or nil.
;;;***
;;;### (autoloads (make-ring ring-p) "ring" "emacs-lisp/ring.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/ring.el
(autoload 'ring-p "ring" "\
@@ -24051,7 +22882,8 @@ Make a ring that can contain SIZE elements.
;;;***
-;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (20077 56412))
+;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (20402 11562
+;;;;;; 85788 0))
;;; Generated autoloads from net/rlogin.el
(autoload 'rlogin "rlogin" "\
@@ -24099,10 +22931,25 @@ variable.
;;;;;; rmail rmail-show-message-hook rmail-secondary-file-regexp
;;;;;; 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" "mail/rmail.el" (20174 10633))
+;;;;;; rmail-user-mail-address-regexp rmail-movemail-variant-p rmail-spool-directory
+;;;;;; rmail-file-name) "rmail" "mail/rmail.el" (20599 61088 34742
+;;;;;; 635000))
;;; Generated autoloads from mail/rmail.el
+(defvar rmail-file-name (purecopy "~/RMAIL") "\
+Name of user's primary mail file.")
+
+(custom-autoload 'rmail-file-name "rmail" t)
+
+(put 'rmail-spool-directory 'standard-value '((cond ((file-exists-p "/var/mail") "/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/") (t "/usr/spool/mail/"))))
+
+(defvar rmail-spool-directory (purecopy (cond ((file-exists-p "/var/mail") "/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/") (t "/usr/spool/mail/"))) "\
+Name of directory used by system mailer for delivering new mail.
+Its name should end with a slash.")
+
+(custom-autoload 'rmail-spool-directory "rmail" t)
+(custom-initialize-delay 'rmail-spool-directory nil)
+
(autoload 'rmail-movemail-variant-p "rmail" "\
Return t if the current movemail variant is any of VARIANTS.
Currently known variants are 'emacs and 'mailutils.
@@ -24125,7 +22972,7 @@ Setting this variable has an effect only before reading a mail.")
(custom-autoload 'rmail-user-mail-address-regexp "rmail" t)
-(defvaralias 'rmail-dont-reply-to-names 'mail-dont-reply-to-names)
+(define-obsolete-variable-alias 'rmail-dont-reply-to-names 'mail-dont-reply-to-names "24.1")
(defvar rmail-default-dont-reply-to-names nil "\
Regexp specifying part of the default value of `mail-dont-reply-to-names'.
@@ -24284,7 +23131,8 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server.
;;;***
;;;### (autoloads (rmail-output-body-to-file rmail-output-as-seen
-;;;;;; rmail-output) "rmailout" "mail/rmailout.el" (20172 54913))
+;;;;;; rmail-output) "rmailout" "mail/rmailout.el" (20530 3765 184907
+;;;;;; 0))
;;; Generated autoloads from mail/rmailout.el
(put 'rmail-output-file-alist 'risky-local-variable t)
@@ -24349,7 +23197,7 @@ than appending to it. Deletes the message after writing if
;;;***
;;;### (autoloads (rng-c-load-schema) "rng-cmpct" "nxml/rng-cmpct.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from nxml/rng-cmpct.el
(autoload 'rng-c-load-schema "rng-cmpct" "\
@@ -24361,7 +23209,7 @@ Return a pattern.
;;;***
;;;### (autoloads (rng-nxml-mode-init) "rng-nxml" "nxml/rng-nxml.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from nxml/rng-nxml.el
(autoload 'rng-nxml-mode-init "rng-nxml" "\
@@ -24374,7 +23222,7 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil.
;;;***
;;;### (autoloads (rng-validate-mode) "rng-valid" "nxml/rng-valid.el"
-;;;;;; (20178 7273))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from nxml/rng-valid.el
(autoload 'rng-validate-mode "rng-valid" "\
@@ -24404,8 +23252,8 @@ to use for finding the schema.
;;;***
-;;;### (autoloads (rng-xsd-compile) "rng-xsd" "nxml/rng-xsd.el" (19930
-;;;;;; 13389))
+;;;### (autoloads (rng-xsd-compile) "rng-xsd" "nxml/rng-xsd.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from nxml/rng-xsd.el
(put 'http://www\.w3\.org/2001/XMLSchema-datatypes 'rng-dt-compile 'rng-xsd-compile)
@@ -24433,7 +23281,7 @@ must be equal.
;;;***
;;;### (autoloads (robin-use-package robin-modify-package robin-define-package)
-;;;;;; "robin" "international/robin.el" (20159 42847))
+;;;;;; "robin" "international/robin.el" (20523 62082 997685 0))
;;; Generated autoloads from international/robin.el
(autoload 'robin-define-package "robin" "\
@@ -24447,7 +23295,7 @@ OUTPUT is either a character or a string. RULES are not evaluated.
If there already exists a robin package whose name is NAME, the new
one replaces the old one.
-\(fn NAME DOCSTRING &rest RULES)" nil (quote macro))
+\(fn NAME DOCSTRING &rest RULES)" nil t)
(autoload 'robin-modify-package "robin" "\
Change a rule in an already defined robin package.
@@ -24466,7 +23314,8 @@ Start using robin package NAME, which is a string.
;;;***
;;;### (autoloads (toggle-rot13-mode rot13-other-window rot13-region
-;;;;;; rot13-string rot13) "rot13" "rot13.el" (20154 24929))
+;;;;;; rot13-string rot13) "rot13" "rot13.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from rot13.el
(autoload 'rot13 "rot13" "\
@@ -24504,23 +23353,17 @@ Toggle the use of ROT13 encoding for the current window.
;;;***
;;;### (autoloads (rst-minor-mode rst-mode) "rst" "textmodes/rst.el"
-;;;;;; (20178 7273))
+;;;;;; (20594 43050 277913 0))
;;; Generated autoloads from textmodes/rst.el
(add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode)))
(autoload 'rst-mode "rst" "\
Major mode for editing reStructuredText documents.
\\<rst-mode-map>
-There are a number of convenient keybindings provided by
-Rst mode. The main one is \\[rst-adjust], it updates or rotates
-the section title around point or promotes/demotes the
-decorations within the region (see full details below).
-Use negative prefix arg to rotate in the other direction.
Turning on `rst-mode' calls the normal hooks `text-mode-hook'
and `rst-mode-hook'. This mode also supports font-lock
-highlighting. You may customize `rst-mode-lazy' to toggle
-font-locking of blocks.
+highlighting.
\\{rst-mode-map}
@@ -24541,7 +23384,7 @@ for modes derived from Text mode, like Mail mode.
;;;***
;;;### (autoloads (ruby-mode) "ruby-mode" "progmodes/ruby-mode.el"
-;;;;;; (19845 45374))
+;;;;;; (20576 42138 697312 0))
;;; Generated autoloads from progmodes/ruby-mode.el
(autoload 'ruby-mode "ruby-mode" "\
@@ -24562,8 +23405,8 @@ The variable `ruby-indent-level' controls the amount of indentation.
;;;***
-;;;### (autoloads (ruler-mode) "ruler-mode" "ruler-mode.el" (20127
-;;;;;; 62865))
+;;;### (autoloads (ruler-mode) "ruler-mode" "ruler-mode.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from ruler-mode.el
(defvar ruler-mode nil "\
@@ -24580,8 +23423,8 @@ if ARG is omitted or nil.
;;;***
-;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (20161
-;;;;;; 45793))
+;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (20518
+;;;;;; 12580 46478 0))
;;; Generated autoloads from emacs-lisp/rx.el
(autoload 'rx-to-string "rx" "\
@@ -24888,12 +23731,12 @@ enclosed in `(and ...)'.
`(regexp REGEXP)'
include REGEXP in string notation in the result.
-\(fn &rest REGEXPS)" nil (quote macro))
+\(fn &rest REGEXPS)" nil t)
;;;***
-;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (20127
-;;;;;; 62865))
+;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (20577
+;;;;;; 33959 40183 0))
;;; Generated autoloads from savehist.el
(defvar savehist-mode nil "\
@@ -24925,7 +23768,7 @@ histories, which is probably undesirable.
;;;***
;;;### (autoloads (dsssl-mode scheme-mode) "scheme" "progmodes/scheme.el"
-;;;;;; (20079 39251))
+;;;;;; (20427 14766 970343 0))
;;; Generated autoloads from progmodes/scheme.el
(autoload 'scheme-mode "scheme" "\
@@ -24935,7 +23778,7 @@ Editing commands are similar to those of `lisp-mode'.
In addition, if an inferior Scheme process is running, some additional
commands will be defined, for evaluating expressions and controlling
the interpreter, and the state of the process will be displayed in the
-modeline of all Scheme buffers. The names of commands that interact
+mode line of all Scheme buffers. The names of commands that interact
with the Scheme process start with \"xscheme-\" if you use the MIT
Scheme-specific `xscheme' package; for more information see the
documentation for `xscheme-interaction-mode'. Use \\[run-scheme] to
@@ -24967,7 +23810,7 @@ that variable's value is a string.
;;;***
;;;### (autoloads (gnus-score-mode) "score-mode" "gnus/score-mode.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/score-mode.el
(autoload 'gnus-score-mode "score-mode" "\
@@ -24981,7 +23824,7 @@ This mode is an extended emacs-lisp mode.
;;;***
;;;### (autoloads (scroll-all-mode) "scroll-all" "scroll-all.el"
-;;;;;; (20127 62865))
+;;;;;; (20363 61861 222722 0))
;;; Generated autoloads from scroll-all.el
(defvar scroll-all-mode nil "\
@@ -25007,21 +23850,24 @@ one window apply to all visible windows in the same frame.
;;;***
;;;### (autoloads (scroll-lock-mode) "scroll-lock" "scroll-lock.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from scroll-lock.el
(autoload 'scroll-lock-mode "scroll-lock" "\
Buffer-local minor mode for pager-like scrolling.
-Keys which normally move point by line or paragraph will scroll
-the buffer by the respective amount of lines instead and point
-will be kept vertically fixed relative to window boundaries
-during scrolling.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil. When enabled, keys that normally move
+point by line or paragraph will scroll the buffer by the
+respective amount of lines instead and point will be kept
+vertically fixed relative to window boundaries during scrolling.
\(fn &optional ARG)" t nil)
;;;***
-;;;### (autoloads nil "secrets" "net/secrets.el" (20175 31160))
+;;;### (autoloads nil "secrets" "net/secrets.el" (20478 3673 653810
+;;;;;; 0))
;;; Generated autoloads from net/secrets.el
(when (featurep 'dbusbind)
(autoload 'secrets-show-secrets "secrets" nil t))
@@ -25029,7 +23875,7 @@ during scrolling.
;;;***
;;;### (autoloads (semantic-mode semantic-default-submodes) "semantic"
-;;;;;; "cedet/semantic.el" (20172 54913))
+;;;;;; "cedet/semantic.el" (20617 41641 89638 0))
;;; Generated autoloads from cedet/semantic.el
(defvar semantic-default-submodes '(global-semantic-idle-scheduler-mode global-semanticdb-minor-mode) "\
@@ -25044,7 +23890,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.")
(custom-autoload 'semantic-default-submodes "semantic" t)
@@ -25075,6 +23931,28 @@ Semantic mode.
;;;***
+;;;### (autoloads (bovine-grammar-mode) "semantic/bovine/grammar"
+;;;;;; "cedet/semantic/bovine/grammar.el" (20593 22184 581574 0))
+;;; Generated autoloads from cedet/semantic/bovine/grammar.el
+
+(autoload 'bovine-grammar-mode "semantic/bovine/grammar" "\
+Major mode for editing Bovine grammars.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads (wisent-grammar-mode) "semantic/wisent/grammar"
+;;;;;; "cedet/semantic/wisent/grammar.el" (20593 22184 581574 0))
+;;; Generated autoloads from cedet/semantic/wisent/grammar.el
+
+(autoload 'wisent-grammar-mode "semantic/wisent/grammar" "\
+Major mode for editing Wisent grammars.
+
+\(fn)" t nil)
+
+;;;***
+
;;;### (autoloads (mail-other-frame mail-other-window mail mail-mailing-lists
;;;;;; mail-mode sendmail-user-agent-compose sendmail-query-once
;;;;;; mail-default-headers mail-default-directory mail-signature-file
@@ -25083,7 +23961,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" (20122 44898))
+;;;;;; "sendmail" "mail/sendmail.el" (20614 54428 654267 0))
;;; Generated autoloads from mail/sendmail.el
(defvar mail-from-style 'default "\
@@ -25286,7 +24164,7 @@ header when sending a message to a mailing list.")
(custom-autoload 'mail-mailing-lists "sendmail" t)
(defvar sendmail-coding-system nil "\
-*Coding system for encoding the outgoing mail.
+Coding system for encoding the outgoing mail.
This has higher priority than the default `buffer-file-coding-system'
and `default-sendmail-coding-system',
but lower priority than the local value of `buffer-file-coding-system'.
@@ -25365,8 +24243,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" (20172
-;;;;;; 54913))
+;;;;;; server-force-delete server-start) "server" "server.el" (20594
+;;;;;; 43050 277913 0))
;;; Generated autoloads from server.el
(put 'server-host 'risky-local-variable t)
@@ -25377,10 +24255,10 @@ Like `mail' command, but display mail buffer in another frame.
(autoload 'server-start "server" "\
Allow this Emacs process to be a server for client processes.
-This starts a server communications subprocess through which
-client \"editors\" can send your editing commands to this Emacs
-job. To use the server, set up the program `emacsclient' in the
-Emacs distribution as your standard \"editor\".
+This starts a server communications subprocess through which client
+\"editors\" can send your editing commands to this Emacs job.
+To use the server, set up the program `emacsclient' in the Emacs
+distribution as your standard \"editor\".
Optional argument LEAVE-DEAD (interactively, a prefix arg) means just
kill any existing server communications subprocess.
@@ -25433,7 +24311,7 @@ only these files will be asked to be saved.
;;;***
-;;;### (autoloads (ses-mode) "ses" "ses.el" (20172 54913))
+;;;### (autoloads (ses-mode) "ses" "ses.el" (20553 51627 169867 0))
;;; Generated autoloads from ses.el
(autoload 'ses-mode "ses" "\
@@ -25452,7 +24330,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"
-;;;;;; (20167 36967))
+;;;;;; (20580 10161 446444 0))
;;; Generated autoloads from textmodes/sgml-mode.el
(autoload 'sgml-mode "sgml-mode" "\
@@ -25466,7 +24344,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.
@@ -25518,7 +24396,7 @@ To work around that, do:
;;;***
;;;### (autoloads (sh-mode) "sh-script" "progmodes/sh-script.el"
-;;;;;; (20168 57844))
+;;;;;; (20624 64165 102958 0))
;;; Generated autoloads from progmodes/sh-script.el
(put 'sh-shell 'safe-local-variable 'symbolp)
@@ -25565,9 +24443,8 @@ buffer indents as it currently is indented.
\\[sh-set-shell] Set this buffer's shell, and maybe its magic number.
\\[sh-execute-region] Have optional header and region be executed in a subshell.
-\\[sh-maybe-here-document] Without prefix, following an unquoted < inserts here document.
-{, (, [, ', \", `
- Unless quoted with \\, insert the pairs {}, (), [], or '', \"\", ``.
+`sh-electric-here-document-mode' controls whether insertion of two
+unquoted < insert a here document.
If you generally program a shell different from your login shell you can
set `sh-shell-file' accordingly. If your shell's file name doesn't correctly
@@ -25583,7 +24460,7 @@ with your script for an edit-interpret-debug cycle.
;;;***
;;;### (autoloads (list-load-path-shadows) "shadow" "emacs-lisp/shadow.el"
-;;;;;; (19845 45374))
+;;;;;; (20572 16038 402143 0))
;;; Generated autoloads from emacs-lisp/shadow.el
(autoload 'list-load-path-shadows "shadow" "\
@@ -25633,8 +24510,8 @@ function, `load-path-shadows-find'.
;;;***
;;;### (autoloads (shadow-initialize shadow-define-regexp-group shadow-define-literal-group
-;;;;;; shadow-define-cluster) "shadowfile" "shadowfile.el" (19886
-;;;;;; 45771))
+;;;;;; shadow-define-cluster) "shadowfile" "shadowfile.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from shadowfile.el
(autoload 'shadow-define-cluster "shadowfile" "\
@@ -25673,7 +24550,7 @@ Set up file shadowing.
;;;***
;;;### (autoloads (shell shell-dumb-shell-regexp) "shell" "shell.el"
-;;;;;; (20168 57844))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from shell.el
(defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\
@@ -25721,19 +24598,22 @@ Otherwise, one argument `-i' is passed to the shell.
;;;***
-;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (20172
-;;;;;; 54913))
+;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (20595
+;;;;;; 63909 923329 0))
;;; Generated autoloads from gnus/shr.el
(autoload 'shr-insert-document "shr" "\
-
+Render the parsed document DOM into the current buffer.
+DOM should be a parse tree as generated by
+`libxml-parse-html-region' or similar.
\(fn DOM)" nil nil)
;;;***
-;;;### (autoloads (sieve-upload-and-bury sieve-upload sieve-manage)
-;;;;;; "sieve" "gnus/sieve.el" (20165 31925))
+;;;### (autoloads (sieve-upload-and-kill sieve-upload-and-bury sieve-upload
+;;;;;; sieve-manage) "sieve" "gnus/sieve.el" (20487 57003 603251
+;;;;;; 0))
;;; Generated autoloads from gnus/sieve.el
(autoload 'sieve-manage "sieve" "\
@@ -25751,10 +24631,15 @@ Otherwise, one argument `-i' is passed to the shell.
\(fn &optional NAME)" t nil)
+(autoload 'sieve-upload-and-kill "sieve" "\
+
+
+\(fn &optional NAME)" t nil)
+
;;;***
;;;### (autoloads (sieve-mode) "sieve-mode" "gnus/sieve-mode.el"
-;;;;;; (19845 45374))
+;;;;;; (20487 57003 603251 0))
;;; Generated autoloads from gnus/sieve-mode.el
(autoload 'sieve-mode "sieve-mode" "\
@@ -25769,8 +24654,8 @@ Turning on Sieve mode runs `sieve-mode-hook'.
;;;***
-;;;### (autoloads (simula-mode) "simula" "progmodes/simula.el" (19890
-;;;;;; 42850))
+;;;### (autoloads (simula-mode) "simula" "progmodes/simula.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/simula.el
(autoload 'simula-mode "simula" "\
@@ -25819,7 +24704,8 @@ with no arguments, if that value is non-nil.
;;;***
;;;### (autoloads (skeleton-pair-insert-maybe skeleton-insert skeleton-proxy-new
-;;;;;; define-skeleton) "skeleton" "skeleton.el" (19845 45374))
+;;;;;; define-skeleton) "skeleton" "skeleton.el" (20541 6907 775259
+;;;;;; 0))
;;; Generated autoloads from skeleton.el
(defvar skeleton-filter-function 'identity "\
@@ -25830,7 +24716,9 @@ Define a user-configurable COMMAND that enters a statement skeleton.
DOCUMENTATION is that of the command.
SKELETON is as defined under `skeleton-insert'.
-\(fn COMMAND DOCUMENTATION &rest SKELETON)" nil (quote macro))
+\(fn COMMAND DOCUMENTATION &rest SKELETON)" nil t)
+
+(put 'define-skeleton 'doc-string-elt '2)
(autoload 'skeleton-proxy-new "skeleton" "\
Insert SKELETON.
@@ -25929,7 +24817,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" (19946 1612))
+;;;;;; "smerge-mode" "vc/smerge-mode.el" (20585 28088 480237 0))
;;; Generated autoloads from vc/smerge-mode.el
(autoload 'smerge-ediff "smerge-mode" "\
@@ -25941,6 +24829,9 @@ buffer names.
(autoload 'smerge-mode "smerge-mode" "\
Minor mode to simplify editing output from the diff3 program.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
\\{smerge-mode-map}
\(fn &optional ARG)" t nil)
@@ -25954,7 +24845,7 @@ If no conflict maker is found, turn off `smerge-mode'.
;;;***
;;;### (autoloads (smiley-buffer smiley-region) "smiley" "gnus/smiley.el"
-;;;;;; (19939 28373))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/smiley.el
(autoload 'smiley-region "smiley" "\
@@ -25972,7 +24863,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" (20168 57844))
+;;;;;; "mail/smtpmail.el" (20551 9899 283417 0))
;;; Generated autoloads from mail/smtpmail.el
(autoload 'smtpmail-send-it "smtpmail" "\
@@ -25987,7 +24878,8 @@ Send mail that was queued as a result of setting `smtpmail-queue-mail'.
;;;***
-;;;### (autoloads (snake) "snake" "play/snake.el" (19845 45374))
+;;;### (autoloads (snake) "snake" "play/snake.el" (20478 3673 653810
+;;;;;; 0))
;;; Generated autoloads from play/snake.el
(autoload 'snake "snake" "\
@@ -26011,7 +24903,7 @@ Snake mode keybindings:
;;;***
;;;### (autoloads (snmpv2-mode snmp-mode) "snmp-mode" "net/snmp-mode.el"
-;;;;;; (20161 45793))
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from net/snmp-mode.el
(autoload 'snmp-mode "snmp-mode" "\
@@ -26040,8 +24932,8 @@ then `snmpv2-mode-hook'.
;;;***
-;;;### (autoloads (sunrise-sunset) "solar" "calendar/solar.el" (19886
-;;;;;; 45771))
+;;;### (autoloads (sunrise-sunset) "solar" "calendar/solar.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from calendar/solar.el
(autoload 'sunrise-sunset "solar" "\
@@ -26050,14 +24942,14 @@ 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)
;;;***
-;;;### (autoloads (solitaire) "solitaire" "play/solitaire.el" (20165
-;;;;;; 31925))
+;;;### (autoloads (solitaire) "solitaire" "play/solitaire.el" (20427
+;;;;;; 14766 970343 0))
;;; Generated autoloads from play/solitaire.el
(autoload 'solitaire "solitaire" "\
@@ -26134,7 +25026,8 @@ Pick your favorite shortcuts:
;;;### (autoloads (reverse-region sort-columns sort-regexp-fields
;;;;;; sort-fields sort-numeric-fields sort-pages sort-paragraphs
-;;;;;; sort-lines sort-subr) "sort" "sort.el" (19845 45374))
+;;;;;; sort-lines sort-subr) "sort" "sort.el" (20507 42276 222255
+;;;;;; 0))
;;; Generated autoloads from sort.el
(put 'sort-fold-case 'safe-local-variable 'booleanp)
@@ -26231,18 +25124,23 @@ the sort order.
\(fn FIELD BEG END)" t nil)
(autoload 'sort-regexp-fields "sort" "\
-Sort the region lexicographically as specified by RECORD-REGEXP and KEY.
-RECORD-REGEXP specifies the textual units which should be sorted.
- For example, to sort lines RECORD-REGEXP would be \"^.*$\"
-KEY specifies the part of each record (ie each match for RECORD-REGEXP)
- is to be used for sorting.
- If it is \"\\\\digit\" then the digit'th \"\\\\(...\\\\)\" match field from
- RECORD-REGEXP is used.
- If it is \"\\\\&\" then the whole record is used.
- Otherwise, it is a regular-expression for which to search within the record.
-If a match for KEY is not found within a record then that record is ignored.
-
-With a negative prefix arg sorts in reverse order.
+Sort the text in the region region lexicographically.
+If called interactively, prompt for two regular expressions,
+RECORD-REGEXP and KEY-REGEXP.
+
+RECORD-REGEXP specifies the textual units to be sorted.
+ For example, to sort lines, RECORD-REGEXP would be \"^.*$\".
+
+KEY-REGEXP specifies the part of each record (i.e. each match for
+ RECORD-REGEXP) to be used for sorting.
+ If it is \"\\\\digit\", use the digit'th \"\\\\(...\\\\)\"
+ match field specified by RECORD-REGEXP.
+ If it is \"\\\\&\", use the whole record.
+ Otherwise, KEY-REGEXP should be a regular expression with which
+ to search within the record. If a match for KEY-REGEXP is not
+ found within a record, that record is ignored.
+
+With a negative prefix arg, sort in reverse order.
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order.
@@ -26278,8 +25176,8 @@ From a program takes two point or marker arguments, BEG and END.
;;;***
-;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (20167
-;;;;;; 36967))
+;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (20458
+;;;;;; 56750 651721 0))
;;; Generated autoloads from gnus/spam.el
(autoload 'spam-initialize "spam" "\
@@ -26295,7 +25193,7 @@ installed through `spam-necessary-extra-headers'.
;;;### (autoloads (spam-report-deagentize spam-report-agentize spam-report-url-to-file
;;;;;; spam-report-url-ping-mm-url spam-report-process-queue) "spam-report"
-;;;;;; "gnus/spam-report.el" (20166 16092))
+;;;;;; "gnus/spam-report.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/spam-report.el
(autoload 'spam-report-process-queue "spam-report" "\
@@ -26338,7 +25236,7 @@ Spam reports will be queued with the method used when
;;;***
;;;### (autoloads (speedbar-get-focus speedbar-frame-mode) "speedbar"
-;;;;;; "speedbar.el" (20178 7273))
+;;;;;; "speedbar.el" (20566 63671 243798 0))
;;; Generated autoloads from speedbar.el
(defalias 'speedbar 'speedbar-frame-mode)
@@ -26362,8 +25260,8 @@ selected. If the speedbar frame is active, then select the attached frame.
;;;***
-;;;### (autoloads (snarf-spooks spook) "spook" "play/spook.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (snarf-spooks spook) "spook" "play/spook.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from play/spook.el
(autoload 'spook "spook" "\
@@ -26382,7 +25280,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"
-;;;;;; (20178 7273))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from progmodes/sql.el
(autoload 'sql-add-product-keywords "sql" "\
@@ -26462,8 +25360,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 ()
@@ -26878,7 +25776,7 @@ buffer.
;;;***
;;;### (autoloads (srecode-template-mode) "srecode/srt-mode" "cedet/srecode/srt-mode.el"
-;;;;;; (20160 63745))
+;;;;;; (20586 48936 135199 0))
;;; Generated autoloads from cedet/srecode/srt-mode.el
(autoload 'srecode-template-mode "srecode/srt-mode" "\
@@ -26891,7 +25789,7 @@ Major-mode for writing SRecode macros.
;;;***
;;;### (autoloads (starttls-open-stream) "starttls" "gnus/starttls.el"
-;;;;;; (20175 31160))
+;;;;;; (20606 34222 123795 0))
;;; Generated autoloads from gnus/starttls.el
(autoload 'starttls-open-stream "starttls" "\
@@ -26918,8 +25816,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" (20127
-;;;;;; 62865))
+;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (20593
+;;;;;; 22184 581574 0))
;;; Generated autoloads from strokes.el
(autoload 'strokes-global-set-stroke "strokes" "\
@@ -27033,7 +25931,7 @@ Read a complex stroke and insert its glyph into the current buffer.
;;;***
;;;### (autoloads (studlify-buffer studlify-word studlify-region)
-;;;;;; "studly" "play/studly.el" (19845 45374))
+;;;;;; "studly" "play/studly.el" (20355 10021 546955 0))
;;; Generated autoloads from play/studly.el
(autoload 'studlify-region "studly" "\
@@ -27054,7 +25952,7 @@ Studlify-case the current buffer.
;;;***
;;;### (autoloads (global-subword-mode subword-mode) "subword" "progmodes/subword.el"
-;;;;;; (20127 62865))
+;;;;;; (20524 51365 2559 0))
;;; Generated autoloads from progmodes/subword.el
(autoload 'subword-mode "subword" "\
@@ -27110,7 +26008,7 @@ See `subword-mode' for more information on Subword mode.
;;;***
;;;### (autoloads (sc-cite-original) "supercite" "mail/supercite.el"
-;;;;;; (19931 11784))
+;;;;;; (20576 42138 697312 0))
;;; Generated autoloads from mail/supercite.el
(autoload 'sc-cite-original "supercite" "\
@@ -27142,8 +26040,8 @@ and `sc-post-hook' is run after the guts of this function.
;;;***
-;;;### (autoloads (gpm-mouse-mode) "t-mouse" "t-mouse.el" (20127
-;;;;;; 62865))
+;;;### (autoloads (gpm-mouse-mode) "t-mouse" "t-mouse.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from t-mouse.el
(define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1")
@@ -27171,7 +26069,8 @@ It relies on the `gpm' daemon being activated.
;;;***
-;;;### (autoloads (tabify untabify) "tabify" "tabify.el" (19998 49767))
+;;;### (autoloads (tabify untabify) "tabify" "tabify.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from tabify.el
(autoload 'untabify "tabify" "\
@@ -27206,7 +26105,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" (20179 28130))
+;;;;;; "table" "textmodes/table.el" (20586 48936 135199 0))
;;; Generated autoloads from textmodes/table.el
(defvar table-cell-map-hook nil "\
@@ -27446,7 +26345,7 @@ specified.
(autoload 'table-shorten-cell "table" "\
Shorten the current cell by N lines by shrinking the cell vertically.
Shortening is done by removing blank lines from the bottom of the cell
-and possibly from the top of the cell as well. Therefor, the cell
+and possibly from the top of the cell as well. Therefore, the cell
must have some bottom/top blank lines to be shorten effectively. This
is applicable to all the cells aligned horizontally with the current
one because they are also shortened in order to keep the rectangular
@@ -27569,10 +26468,14 @@ JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or top,
\(fn JUSTIFY)" t nil)
(autoload 'table-fixed-width-mode "table" "\
-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.
+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.
\(fn &optional ARG)" t nil)
@@ -27794,50 +26697,8 @@ converts a table into plain text without frames. It is a companion to
;;;***
-;;;### (autoloads (tabulated-list-mode) "tabulated-list" "emacs-lisp/tabulated-list.el"
-;;;;;; (20170 13157))
-;;; Generated autoloads from emacs-lisp/tabulated-list.el
-
-(autoload 'tabulated-list-mode "tabulated-list" "\
-Generic major mode for browsing a list of items.
-This mode is usually not used directly; instead, other major
-modes are derived from it, using `define-derived-mode'.
-
-In this major mode, the buffer is divided into multiple columns,
-which are labeled using the header line. Each non-empty line
-belongs to one \"entry\", and the entries can be sorted according
-to their column values.
-
-An inheriting mode should usually do the following in their body:
-
- - Set `tabulated-list-format', specifying the column format.
- - Set `tabulated-list-revert-hook', if the buffer contents need
- to be specially recomputed prior to `revert-buffer'.
- - Maybe set a `tabulated-list-entries' function (see below).
- - Maybe set `tabulated-list-printer' (see below).
- - Maybe set `tabulated-list-padding'.
- - Call `tabulated-list-init-header' to initialize `header-line-format'
- according to `tabulated-list-format'.
-
-An inheriting mode is usually accompanied by a \"list-FOO\"
-command (e.g. `list-packages', `list-processes'). This command
-creates or switches to a buffer and enables the major mode in
-that buffer. If `tabulated-list-entries' is not a function, the
-command should initialize it to a list of entries for displaying.
-Finally, it should call `tabulated-list-print'.
-
-`tabulated-list-print' calls the printer function specified by
-`tabulated-list-printer', once for each entry. The default
-printer is `tabulated-list-print-entry', but a mode that keeps
-data in an ewoc may instead specify a printer function (e.g., one
-that calls `ewoc-enter-last'), with `tabulated-list-print-entry'
-as the ewoc pretty-printer.
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (autoloads (talk talk-connect) "talk" "talk.el" (20141 9296))
+;;;### (autoloads (talk talk-connect) "talk" "talk.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from talk.el
(autoload 'talk-connect "talk" "\
@@ -27852,7 +26713,8 @@ Connect to the Emacs talk group from the current X display or tty frame.
;;;***
-;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20161 45793))
+;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20585 28088
+;;;;;; 480237 0))
;;; Generated autoloads from tar-mode.el
(autoload 'tar-mode "tar-mode" "\
@@ -27876,7 +26738,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
;;;***
;;;### (autoloads (tcl-help-on-word inferior-tcl tcl-mode) "tcl"
-;;;;;; "progmodes/tcl.el" (20164 29468))
+;;;;;; "progmodes/tcl.el" (20580 10161 446444 0))
;;; Generated autoloads from progmodes/tcl.el
(autoload 'tcl-mode "tcl" "\
@@ -27924,7 +26786,8 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'.
;;;***
-;;;### (autoloads (rsh telnet) "telnet" "net/telnet.el" (20077 56412))
+;;;### (autoloads (rsh telnet) "telnet" "net/telnet.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from net/telnet.el
(autoload 'telnet "telnet" "\
@@ -27950,7 +26813,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"
-;;;;;; (20178 7273))
+;;;;;; (20580 10161 446444 0))
;;; Generated autoloads from term.el
(autoload 'make-term "term" "\
@@ -27992,8 +26855,8 @@ use in that buffer.
;;;***
-;;;### (autoloads (terminal-emulator) "terminal" "terminal.el" (20167
-;;;;;; 36967))
+;;;### (autoloads (terminal-emulator) "terminal" "terminal.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from terminal.el
(autoload 'terminal-emulator "terminal" "\
@@ -28030,7 +26893,7 @@ subprocess started.
;;;***
;;;### (autoloads (testcover-this-defun) "testcover" "emacs-lisp/testcover.el"
-;;;;;; (20172 54913))
+;;;;;; (20580 10161 446444 0))
;;; Generated autoloads from emacs-lisp/testcover.el
(autoload 'testcover-this-defun "testcover" "\
@@ -28040,7 +26903,8 @@ Start coverage on function under point.
;;;***
-;;;### (autoloads (tetris) "tetris" "play/tetris.el" (19889 21967))
+;;;### (autoloads (tetris) "tetris" "play/tetris.el" (20545 57511
+;;;;;; 257469 0))
;;; Generated autoloads from play/tetris.el
(autoload 'tetris "tetris" "\
@@ -28071,7 +26935,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"
-;;;;;; (20178 7273))
+;;;;;; (20594 43050 277913 0))
;;; Generated autoloads from textmodes/tex-mode.el
(defvar tex-shell-file-name nil "\
@@ -28373,7 +27237,7 @@ Major mode to edit DocTeX files.
;;;***
;;;### (autoloads (texi2info texinfo-format-region texinfo-format-buffer)
-;;;;;; "texinfmt" "textmodes/texinfmt.el" (20183 25152))
+;;;;;; "texinfmt" "textmodes/texinfmt.el" (20434 17809 692608 0))
;;; Generated autoloads from textmodes/texinfmt.el
(autoload 'texinfo-format-buffer "texinfmt" "\
@@ -28413,7 +27277,7 @@ if large. You can use `Info-split' to do this manually.
;;;***
;;;### (autoloads (texinfo-mode texinfo-close-quote texinfo-open-quote)
-;;;;;; "texinfo" "textmodes/texinfo.el" (19845 45374))
+;;;;;; "texinfo" "textmodes/texinfo.el" (20478 3673 653810 0))
;;; Generated autoloads from textmodes/texinfo.el
(defvar texinfo-open-quote (purecopy "``") "\
@@ -28499,7 +27363,7 @@ value of `texinfo-mode-hook'.
;;;### (autoloads (thai-composition-function thai-compose-buffer
;;;;;; thai-compose-string thai-compose-region) "thai-util" "language/thai-util.el"
-;;;;;; (20168 57844))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from language/thai-util.el
(autoload 'thai-compose-region "thai-util" "\
@@ -28528,7 +27392,7 @@ Compose Thai characters in the current buffer.
;;;### (autoloads (list-at-point number-at-point symbol-at-point
;;;;;; sexp-at-point thing-at-point bounds-of-thing-at-point forward-thing)
-;;;;;; "thingatpt" "thingatpt.el" (19990 55648))
+;;;;;; "thingatpt" "thingatpt.el" (20623 43301 870757 0))
;;; Generated autoloads from thingatpt.el
(autoload 'forward-thing "thingatpt" "\
@@ -28560,7 +27424,7 @@ Return the THING at point.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
`filename', `url', `email', `word', `sentence', `whitespace',
-`line', and `page'.
+`line', `number', and `page'.
See the file `thingatpt.el' for documentation on how to define
a symbol as a valid THING.
@@ -28591,7 +27455,7 @@ Return the Lisp list at point, or nil if none is found.
;;;### (autoloads (thumbs-dired-setroot thumbs-dired-show thumbs-dired-show-marked
;;;;;; thumbs-show-from-dir thumbs-find-thumb) "thumbs" "thumbs.el"
-;;;;;; (20168 57844))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from thumbs.el
(autoload 'thumbs-find-thumb "thumbs" "\
@@ -28629,8 +27493,8 @@ In dired, call the setroot program on the image at point.
;;;;;; tibetan-post-read-conversion tibetan-compose-buffer tibetan-decompose-buffer
;;;;;; tibetan-decompose-string tibetan-decompose-region tibetan-compose-region
;;;;;; tibetan-compose-string tibetan-transcription-to-tibetan tibetan-tibetan-to-transcription
-;;;;;; tibetan-char-p) "tibet-util" "language/tibet-util.el" (20175
-;;;;;; 31160))
+;;;;;; tibetan-char-p) "tibet-util" "language/tibet-util.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from language/tibet-util.el
(autoload 'tibetan-char-p "tibet-util" "\
@@ -28704,7 +27568,7 @@ See also docstring of the function tibetan-compose-region.
;;;***
;;;### (autoloads (tildify-buffer tildify-region) "tildify" "textmodes/tildify.el"
-;;;;;; (19845 45374))
+;;;;;; (20373 11301 906925 0))
;;; Generated autoloads from textmodes/tildify.el
(autoload 'tildify-region "tildify" "\
@@ -28729,7 +27593,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" (20127 62865))
+;;;;;; "time" "time.el" (20619 46245 806932 0))
;;; Generated autoloads from time.el
(defvar display-time-day-and-date nil "\
@@ -28795,7 +27659,7 @@ Return a string giving the duration of the Emacs initialization.
;;;;;; time-to-day-in-year date-leap-year-p days-between date-to-day
;;;;;; time-add time-subtract time-since days-to-time time-less-p
;;;;;; seconds-to-time date-to-time) "time-date" "calendar/time-date.el"
-;;;;;; (19885 24894))
+;;;;;; (20453 5437 764254 0))
;;; Generated autoloads from calendar/time-date.el
(autoload 'date-to-time "time-date" "\
@@ -28909,7 +27773,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" (20033 22846))
+;;;;;; "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)
@@ -28923,7 +27787,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
@@ -28952,18 +27816,18 @@ With ARG, turn time stamping on if and only if arg is positive.
;;;### (autoloads (timeclock-when-to-leave-string timeclock-workday-elapsed-string
;;;;;; timeclock-workday-remaining-string timeclock-reread-log timeclock-query-out
;;;;;; timeclock-change timeclock-status-string timeclock-out timeclock-in
-;;;;;; timeclock-modeline-display) "timeclock" "calendar/timeclock.el"
-;;;;;; (20165 31925))
+;;;;;; timeclock-mode-line-display) "timeclock" "calendar/timeclock.el"
+;;;;;; (20593 22184 581574 0))
;;; Generated autoloads from calendar/timeclock.el
-(autoload 'timeclock-modeline-display "timeclock" "\
-Toggle display of the amount of time left today in the modeline.
+(autoload 'timeclock-mode-line-display "timeclock" "\
+Toggle display of the amount of time left today in the mode line.
If `timeclock-use-display-time' is non-nil (the default), then
-the function `display-time-mode' must be active, and the modeline
+the function `display-time-mode' must be active, and the mode line
will be updated whenever the time display is updated. Otherwise,
the timeclock will use its own sixty second timer to do its
-updating. With prefix ARG, turn modeline display on if and only
-if ARG is positive. Returns the new status of timeclock modeline
+updating. With prefix ARG, turn mode line display on if and only
+if ARG is positive. Returns the new status of timeclock mode line
display (non-nil means on).
\(fn &optional ARG)" t nil)
@@ -29053,7 +27917,7 @@ relative only to the time worked today, and not to past time.
;;;***
;;;### (autoloads (batch-titdic-convert titdic-convert) "titdic-cnv"
-;;;;;; "international/titdic-cnv.el" (20175 31160))
+;;;;;; "international/titdic-cnv.el" (20355 10021 546955 0))
;;; Generated autoloads from international/titdic-cnv.el
(autoload 'titdic-convert "titdic-cnv" "\
@@ -29076,7 +27940,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\".
;;;***
;;;### (autoloads (tmm-prompt tmm-menubar-mouse tmm-menubar) "tmm"
-;;;;;; "tmm.el" (20163 39903))
+;;;;;; "tmm.el" (20622 22438 32851 0))
;;; Generated autoloads from tmm.el
(define-key global-map "\M-`" 'tmm-menubar)
(define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse)
@@ -29116,7 +27980,7 @@ Its value should be an event that has a binding in MENU.
;;;### (autoloads (todo-show todo-cp todo-mode todo-print todo-top-priorities
;;;;;; todo-insert-item todo-add-item-non-interactively todo-add-category)
-;;;;;; "todo-mode" "calendar/todo-mode.el" (20168 57844))
+;;;;;; "todo-mode" "calendar/todo-mode.el" (20355 10021 546955 0))
;;; Generated autoloads from calendar/todo-mode.el
(autoload 'todo-add-category "todo-mode" "\
@@ -29176,7 +28040,7 @@ Show TODO list.
;;;### (autoloads (tool-bar-local-item-from-menu tool-bar-add-item-from-menu
;;;;;; tool-bar-local-item tool-bar-add-item toggle-tool-bar-mode-from-frame)
-;;;;;; "tool-bar" "tool-bar.el" (20127 62865))
+;;;;;; "tool-bar" "tool-bar.el" (20355 10021 546955 0))
;;; Generated autoloads from tool-bar.el
(autoload 'toggle-tool-bar-mode-from-frame "tool-bar" "\
@@ -29247,7 +28111,7 @@ holds a keymap.
;;;***
;;;### (autoloads (tpu-edt-on tpu-edt-mode) "tpu-edt" "emulation/tpu-edt.el"
-;;;;;; (20141 9296))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from emulation/tpu-edt.el
(defvar tpu-edt-mode nil "\
@@ -29260,7 +28124,10 @@ or call the function `tpu-edt-mode'.")
(custom-autoload 'tpu-edt-mode "tpu-edt" nil)
(autoload 'tpu-edt-mode "tpu-edt" "\
-TPU/edt emulation.
+Toggle TPU/edt emulation on or off.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
\(fn &optional ARG)" t nil)
@@ -29274,7 +28141,7 @@ Turn on TPU/edt emulation.
;;;***
;;;### (autoloads (tpu-mapper) "tpu-mapper" "emulation/tpu-mapper.el"
-;;;;;; (19845 45374))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from emulation/tpu-mapper.el
(autoload 'tpu-mapper "tpu-mapper" "\
@@ -29290,7 +28157,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)
@@ -29308,7 +28175,8 @@ your local X guru can try to figure out why the key is being ignored.
;;;***
-;;;### (autoloads (tq-create) "tq" "emacs-lisp/tq.el" (19845 45374))
+;;;### (autoloads (tq-create) "tq" "emacs-lisp/tq.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from emacs-lisp/tq.el
(autoload 'tq-create "tq" "\
@@ -29322,7 +28190,7 @@ to a tcp server on another machine.
;;;***
;;;### (autoloads (trace-function-background trace-function trace-buffer)
-;;;;;; "trace" "emacs-lisp/trace.el" (19845 45374))
+;;;;;; "trace" "emacs-lisp/trace.el" (20485 15269 390836 0))
;;; Generated autoloads from emacs-lisp/trace.el
(defvar trace-buffer (purecopy "*trace-output*") "\
@@ -29359,11 +28227,11 @@ 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" (20179 28130))
+;;;;;; "net/tramp.el" (20597 19239 817699 0))
;;; Generated autoloads from net/tramp.el
(defvar tramp-mode t "\
-*Whether Tramp is enabled.
+Whether Tramp is enabled.
If it is set to nil, all remote file names are used literally.")
(custom-autoload 'tramp-mode "tramp" t)
@@ -29379,7 +28247,7 @@ It can have the following values:
(custom-autoload 'tramp-syntax "tramp" t)
-(defconst tramp-file-name-regexp-unified (if (memq system-type '(cygwin windows-nt)) "\\`/\\([^[/:]\\{2,\\}\\|[^/]\\{2,\\}]\\):" "\\`/\\([^[/:]+\\|[^/]+]\\):") "\
+(defconst tramp-file-name-regexp-unified (if (memq system-type '(cygwin windows-nt)) "\\`/\\([^[/|:]\\{2,\\}\\|[^/|]\\{2,\\}]\\):" "\\`/\\([^[/|:]+\\|[^/|]+]\\):") "\
Value for `tramp-file-name-regexp' for unified remoting.
Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
Tramp. See `tramp-file-name-structure' for more explanations.
@@ -29391,12 +28259,12 @@ Value for `tramp-file-name-regexp' for separate remoting.
XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")
-(defconst tramp-file-name-regexp-url "\\`/[^/:]+://" "\
+(defconst tramp-file-name-regexp-url "\\`/[^/|:]+://" "\
Value for `tramp-file-name-regexp' for URL-like remoting.
See `tramp-file-name-structure' for more explanations.")
(defconst tramp-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate) ((equal tramp-syntax 'url) tramp-file-name-regexp-url) (t (error "Wrong `tramp-syntax' defined"))) "\
-*Regular expression matching file names handled by Tramp.
+Regular expression matching file names handled by Tramp.
This regexp should match Tramp file names but no other file names.
When tramp.el is loaded, this regular expression is prepended to
`file-name-handler-alist', and that is searched sequentially. Thus,
@@ -29428,7 +28296,7 @@ Value for `tramp-completion-file-name-regexp' for URL-like remoting.
See `tramp-file-name-structure' for more explanations.")
(defconst tramp-completion-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate) ((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url) (t (error "Wrong `tramp-syntax' defined"))) "\
-*Regular expression matching file names handled by Tramp completion.
+Regular expression matching file names handled by Tramp completion.
This regexp should match partial Tramp file names only.
Please note that the entry in `file-name-handler-alist' is made when
@@ -29492,7 +28360,7 @@ Discard Tramp from loading remote files.
;;;***
;;;### (autoloads (tramp-ftp-enable-ange-ftp) "tramp-ftp" "net/tramp-ftp.el"
-;;;;;; (19946 29209))
+;;;;;; (20438 24016 194668 0))
;;; Generated autoloads from net/tramp-ftp.el
(autoload 'tramp-ftp-enable-ange-ftp "tramp-ftp" "\
@@ -29502,8 +28370,8 @@ Discard Tramp from loading remote files.
;;;***
-;;;### (autoloads (help-with-tutorial) "tutorial" "tutorial.el" (20176
-;;;;;; 51947))
+;;;### (autoloads (help-with-tutorial) "tutorial" "tutorial.el" (20584
+;;;;;; 7212 455152 0))
;;; Generated autoloads from tutorial.el
(autoload 'help-with-tutorial "tutorial" "\
@@ -29528,7 +28396,7 @@ resumed later.
;;;***
;;;### (autoloads (tai-viet-composition-function) "tv-util" "language/tv-util.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from language/tv-util.el
(autoload 'tai-viet-composition-function "tv-util" "\
@@ -29539,7 +28407,7 @@ resumed later.
;;;***
;;;### (autoloads (2C-split 2C-associate-buffer 2C-two-columns) "two-column"
-;;;;;; "textmodes/two-column.el" (20141 9296))
+;;;;;; "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)
@@ -29587,71 +28455,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"
-;;;;;; (20127 62865))
+;;;;;; 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.
@@ -29726,7 +28542,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.
@@ -29772,7 +28588,8 @@ FRAC should be the inverse of the fractional value; for example, a value of
;;;***
-;;;### (autoloads (uce-reply-to-uce) "uce" "mail/uce.el" (19845 45374))
+;;;### (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" "\
@@ -29790,7 +28607,7 @@ You might need to set `uce-mail-reader' before using this.
;;;;;; ucs-normalize-NFKC-string ucs-normalize-NFKC-region ucs-normalize-NFKD-string
;;;;;; ucs-normalize-NFKD-region ucs-normalize-NFC-string ucs-normalize-NFC-region
;;;;;; ucs-normalize-NFD-string ucs-normalize-NFD-region) "ucs-normalize"
-;;;;;; "international/ucs-normalize.el" (20052 53218))
+;;;;;; "international/ucs-normalize.el" (20476 31768 298871 0))
;;; Generated autoloads from international/ucs-normalize.el
(autoload 'ucs-normalize-NFD-region "ucs-normalize" "\
@@ -29856,7 +28673,7 @@ Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus.
;;;***
;;;### (autoloads (ununderline-region underline-region) "underline"
-;;;;;; "textmodes/underline.el" (19845 45374))
+;;;;;; "textmodes/underline.el" (20355 10021 546955 0))
;;; Generated autoloads from textmodes/underline.el
(autoload 'underline-region "underline" "\
@@ -29877,7 +28694,7 @@ which specify the range to operate on.
;;;***
;;;### (autoloads (unrmail batch-unrmail) "unrmail" "mail/unrmail.el"
-;;;;;; (20172 54913))
+;;;;;; (20369 14251 85829 0))
;;; Generated autoloads from mail/unrmail.el
(autoload 'batch-unrmail "unrmail" "\
@@ -29896,8 +28713,8 @@ Convert old-style Rmail Babyl file FILE to system inbox format file TO-FILE.
;;;***
-;;;### (autoloads (unsafep) "unsafep" "emacs-lisp/unsafep.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (unsafep) "unsafep" "emacs-lisp/unsafep.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from emacs-lisp/unsafep.el
(autoload 'unsafep "unsafep" "\
@@ -29910,19 +28727,21 @@ UNSAFEP-VARS is a list of symbols with local bindings.
;;;***
;;;### (autoloads (url-retrieve-synchronously url-retrieve) "url"
-;;;;;; "url/url.el" (20162 19074))
+;;;;;; "url/url.el" (20601 16294 451653 0))
;;; Generated autoloads from url/url.el
(autoload 'url-retrieve "url" "\
Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
-URL is either a string or a parsed URL.
+URL is either a string or a parsed URL. If it is a string
+containing characters that are not valid in a URI, those
+characters are percent-encoded; see `url-encode-url'.
CALLBACK is called when the object has been completely retrieved, with
the current buffer containing the object, and any MIME headers associated
with it. It is called as (apply CALLBACK STATUS CBARGS).
-STATUS is a list with an even number of elements representing
-what happened during the request, with most recent events first,
-or an empty list if no events have occurred. Each pair is one of:
+STATUS is a plist representing what happened during the request,
+with most recent events first, or an empty list if no events have
+occurred. Each pair is one of:
\(:redirect REDIRECTED-TO) - the request was redirected to this URL
\(:error (ERROR-SYMBOL . DATA)) - an error occurred. The error can be
@@ -29938,8 +28757,12 @@ request; dynamic binding of other variables doesn't necessarily
take effect.
If SILENT, then don't message progress reports and the like.
+If INHIBIT-COOKIES, cookies will neither be stored nor sent to
+the server.
+If URL is a multibyte string, it will be encoded as utf-8 and
+URL-encoded before it's used.
-\(fn URL CALLBACK &optional CBARGS SILENT)" nil nil)
+\(fn URL CALLBACK &optional CBARGS SILENT INHIBIT-COOKIES)" nil nil)
(autoload 'url-retrieve-synchronously "url" "\
Retrieve URL synchronously.
@@ -29952,7 +28775,7 @@ no further processing). URL is either a string or a parsed URL.
;;;***
;;;### (autoloads (url-register-auth-scheme url-get-authentication)
-;;;;;; "url-auth" "url/url-auth.el" (19845 45374))
+;;;;;; "url-auth" "url/url-auth.el" (20355 10021 546955 0))
;;; Generated autoloads from url/url-auth.el
(autoload 'url-get-authentication "url-auth" "\
@@ -29994,7 +28817,7 @@ RATING a rating between 1 and 10 of the strength of the authentication.
;;;***
;;;### (autoloads (url-cache-extract url-is-cached url-store-in-cache)
-;;;;;; "url-cache" "url/url-cache.el" (19988 13913))
+;;;;;; "url-cache" "url/url-cache.el" (20355 10021 546955 0))
;;; Generated autoloads from url/url-cache.el
(autoload 'url-store-in-cache "url-cache" "\
@@ -30015,7 +28838,8 @@ Extract FNAM from the local disk cache.
;;;***
-;;;### (autoloads (url-cid) "url-cid" "url/url-cid.el" (19845 45374))
+;;;### (autoloads (url-cid) "url-cid" "url/url-cid.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from url/url-cid.el
(autoload 'url-cid "url-cid" "\
@@ -30025,15 +28849,34 @@ Extract FNAM from the local disk cache.
;;;***
-;;;### (autoloads (url-dav-vc-registered url-dav-supported-p) "url-dav"
-;;;;;; "url/url-dav.el" (20168 57844))
+;;;### (autoloads (url-dav-vc-registered url-dav-request url-dav-supported-p)
+;;;;;; "url-dav" "url/url-dav.el" (20501 3499 284800 0))
;;; Generated autoloads from url/url-dav.el
(autoload 'url-dav-supported-p "url-dav" "\
-
+Return WebDAV protocol version supported by URL.
+Returns nil if WebDAV is not supported.
\(fn URL)" nil nil)
+(autoload 'url-dav-request "url-dav" "\
+Perform WebDAV operation METHOD on URL. Return the parsed responses.
+Automatically creates an XML request body if TAG is non-nil.
+BODY is the XML document fragment to be enclosed by <TAG></TAG>.
+
+DEPTH is how deep the request should propagate. Default is 0, meaning
+it should apply only to URL. A negative number means to use
+`Infinity' for the depth. Not all WebDAV servers support this depth
+though.
+
+HEADERS is an assoc list of extra headers to send in the request.
+
+NAMESPACES is an assoc list of (NAMESPACE . EXPANSION), and these are
+added to the <TAG> element. The DAV=DAV: namespace is automatically
+added to this list, so most requests can just pass in nil.
+
+\(fn URL METHOD TAG BODY &optional DEPTH HEADERS NAMESPACES)" nil nil)
+
(autoload 'url-dav-vc-registered "url-dav" "\
@@ -30041,8 +28884,8 @@ Extract FNAM from the local disk cache.
;;;***
-;;;### (autoloads (url-file) "url-file" "url/url-file.el" (19845
-;;;;;; 45374))
+;;;### (autoloads (url-file) "url-file" "url/url-file.el" (20602
+;;;;;; 37158 321420 0))
;;; Generated autoloads from url/url-file.el
(autoload 'url-file "url-file" "\
@@ -30053,7 +28896,7 @@ Handle file: and ftp: URLs.
;;;***
;;;### (autoloads (url-open-stream url-gateway-nslookup-host) "url-gw"
-;;;;;; "url/url-gw.el" (19864 29553))
+;;;;;; "url/url-gw.el" (20478 3673 653810 0))
;;; Generated autoloads from url/url-gw.el
(autoload 'url-gateway-nslookup-host "url-gw" "\
@@ -30073,7 +28916,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"
-;;;;;; (20127 62865))
+;;;;;; (20584 7212 455152 0))
;;; Generated autoloads from url/url-handlers.el
(defvar url-handler-mode nil "\
@@ -30127,63 +28970,9 @@ accessible.
;;;***
-;;;### (autoloads (url-http-options url-http-file-attributes url-http-file-exists-p
-;;;;;; url-http) "url-http" "url/url-http.el" (20167 36967))
+;;;### (autoloads nil "url-http" "url/url-http.el" (20601 16294 451653
+;;;;;; 0))
;;; Generated autoloads from url/url-http.el
-
-(autoload 'url-http "url-http" "\
-Retrieve URL via HTTP asynchronously.
-URL must be a parsed URL. See `url-generic-parse-url' for details.
-When retrieval is completed, the function CALLBACK is executed with
-CBARGS as the arguments.
-
-\(fn URL CALLBACK CBARGS)" nil nil)
-
-(autoload 'url-http-file-exists-p "url-http" "\
-
-
-\(fn URL)" nil nil)
-
-(defalias 'url-http-file-readable-p 'url-http-file-exists-p)
-
-(autoload 'url-http-file-attributes "url-http" "\
-
-
-\(fn URL &optional ID-FORMAT)" nil nil)
-
-(autoload 'url-http-options "url-http" "\
-Return a property list describing options available for URL.
-This list is retrieved using the `OPTIONS' HTTP method.
-
-Property list members:
-
-methods
- A list of symbols specifying what HTTP methods the resource
- supports.
-
-dav
- A list of numbers specifying what DAV protocol/schema versions are
- supported.
-
-dasl
- A list of supported DASL search types supported (string form)
-
-ranges
- A list of the units available for use in partial document fetches.
-
-p3p
- The `Platform For Privacy Protection' description for the resource.
- Currently this is just the raw header contents. This is likely to
- change once P3P is formally supported by the URL package or
- Emacs/W3.
-
-\(fn URL)" nil nil)
-
-(defconst url-https-default-port 443 "\
-Default HTTPS port.")
-
-(defconst url-https-asynchronous-p t "\
-HTTPS retrievals are asynchronous.")
(autoload 'url-default-expander "url-expand")
(defalias 'url-https-expand-file-name 'url-default-expander)
@@ -30194,7 +28983,8 @@ HTTPS retrievals are asynchronous.")
;;;***
-;;;### (autoloads (url-irc) "url-irc" "url/url-irc.el" (19845 45374))
+;;;### (autoloads (url-irc) "url-irc" "url/url-irc.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from url/url-irc.el
(autoload 'url-irc "url-irc" "\
@@ -30204,8 +28994,8 @@ HTTPS retrievals are asynchronous.")
;;;***
-;;;### (autoloads (url-ldap) "url-ldap" "url/url-ldap.el" (20164
-;;;;;; 60780))
+;;;### (autoloads (url-ldap) "url-ldap" "url/url-ldap.el" (20355
+;;;;;; 10021 546955 0))
;;; Generated autoloads from url/url-ldap.el
(autoload 'url-ldap "url-ldap" "\
@@ -30219,7 +29009,7 @@ URL can be a URL string, or a URL vector of the type returned by
;;;***
;;;### (autoloads (url-mailto url-mail) "url-mailto" "url/url-mailto.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from url/url-mailto.el
(autoload 'url-mail "url-mailto" "\
@@ -30235,7 +29025,8 @@ Handle the mailto: URL syntax.
;;;***
;;;### (autoloads (url-data url-generic-emulator-loader url-info
-;;;;;; url-man) "url-misc" "url/url-misc.el" (19845 45374))
+;;;;;; url-man) "url-misc" "url/url-misc.el" (20478 3673 653810
+;;;;;; 0))
;;; Generated autoloads from url/url-misc.el
(autoload 'url-man "url-misc" "\
@@ -30267,7 +29058,7 @@ Fetch a data URL (RFC 2397).
;;;***
;;;### (autoloads (url-snews url-news) "url-news" "url/url-news.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from url/url-news.el
(autoload 'url-news "url-news" "\
@@ -30284,7 +29075,7 @@ Fetch a data URL (RFC 2397).
;;;### (autoloads (url-ns-user-pref url-ns-prefs isInNet isResolvable
;;;;;; dnsResolve dnsDomainIs isPlainHostName) "url-ns" "url/url-ns.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from url/url-ns.el
(autoload 'isPlainHostName "url-ns" "\
@@ -30325,7 +29116,7 @@ Fetch a data URL (RFC 2397).
;;;***
;;;### (autoloads (url-generic-parse-url url-recreate-url) "url-parse"
-;;;;;; "url/url-parse.el" (19845 45374))
+;;;;;; "url/url-parse.el" (20577 33959 40183 0))
;;; Generated autoloads from url/url-parse.el
(autoload 'url-recreate-url "url-parse" "\
@@ -30336,14 +29127,48 @@ Recreate a URL string from the parsed URLOBJ.
(autoload 'url-generic-parse-url "url-parse" "\
Return an URL-struct of the parts of URL.
The CL-style struct contains the following fields:
-TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS.
+
+TYPE is the URI scheme (string or nil).
+USER is the user name (string or nil).
+PASSWORD is the password (string [deprecated] or nil).
+HOST is the host (a registered name, IP literal in square
+ brackets, or IPv4 address in dotted-decimal form).
+PORTSPEC is the specified port (a number), or nil.
+FILENAME is the path AND the query component of the URI.
+TARGET is the fragment identifier component (used to refer to a
+ subordinate resource, e.g. a part of a webpage).
+ATTRIBUTES is nil; this slot originally stored the attribute and
+ value alists for IMAP URIs, but this feature was removed
+ since it conflicts with RFC 3986.
+FULLNESS is non-nil iff the hierarchical sequence component of
+ the URL starts with two slashes, \"//\".
+
+The parser follows RFC 3986, except that it also tries to handle
+URIs that are not fully specified (e.g. lacking TYPE), and it
+does not check for or perform %-encoding.
+
+Here is an example. The URL
+
+ foo://bob:pass@example.com:42/a/b/c.dtb?type=animal&name=narwhal#nose
+
+parses to
+
+ TYPE = \"foo\"
+ USER = \"bob\"
+ PASSWORD = \"pass\"
+ HOST = \"example.com\"
+ PORTSPEC = 42
+ FILENAME = \"/a/b/c.dtb?type=animal&name=narwhal\"
+ TARGET = \"nose\"
+ ATTRIBUTES = nil
+ FULLNESS = t
\(fn URL)" nil nil)
;;;***
;;;### (autoloads (url-setup-privacy-info) "url-privacy" "url/url-privacy.el"
-;;;;;; (19845 45374))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from url/url-privacy.el
(autoload 'url-setup-privacy-info "url-privacy" "\
@@ -30354,26 +29179,28 @@ Setup variables that expose info about you and your system.
;;;***
;;;### (autoloads (url-queue-retrieve) "url-queue" "url/url-queue.el"
-;;;;;; (19943 25429))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from url/url-queue.el
(autoload 'url-queue-retrieve "url-queue" "\
Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
-Like `url-retrieve' (which see for details of the arguments), but
-controls the level of parallelism via the
-`url-queue-parallel-processes' variable.
+This is like `url-retrieve' (which see for details of the arguments),
+but with limits on the degree of parallelism. The variable
+`url-queue-parallel-processes' sets the number of concurrent processes.
+The variable `url-queue-timeout' sets a timeout.
-\(fn URL CALLBACK &optional CBARGS SILENT)" nil nil)
+\(fn URL CALLBACK &optional CBARGS SILENT INHIBIT-COOKIES)" nil nil)
;;;***
;;;### (autoloads (url-view-url url-truncate-url-for-viewing url-file-extension
-;;;;;; url-hexify-string url-unhex-string url-parse-query-string
-;;;;;; url-file-nondirectory url-file-directory 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" (19867 59212))
+;;;;;; url-encode-url url-hexify-string url-unhex-string url-build-query-string
+;;;;;; url-parse-query-string url-file-nondirectory url-file-directory
+;;;;;; 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" (20584
+;;;;;; 7212 455152 0))
;;; Generated autoloads from url/url-util.el
(defvar url-debug nil "\
@@ -30399,8 +29226,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;
@@ -30467,6 +29294,30 @@ Return the nondirectory part of FILE, for a URL.
\(fn QUERY &optional DOWNCASE ALLOW-NEWLINES)" nil nil)
+(autoload 'url-build-query-string "url-util" "\
+Build a query-string.
+
+Given a QUERY in the form:
+'((key1 val1)
+ (key2 val2)
+ (key3 val1 val2)
+ (key4)
+ (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)
+
(autoload 'url-unhex-string "url-util" "\
Remove %XX embedded spaces, etc in a URL.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
@@ -30476,13 +29327,27 @@ forbidden in URL encoding.
\(fn STR &optional ALLOW-NEWLINES)" nil nil)
(autoload 'url-hexify-string "url-util" "\
-Return a new string that is STRING URI-encoded.
-First, STRING is converted to utf-8, if necessary. Then, for each
-character in the utf-8 string, those found in `url-unreserved-chars'
-are left as-is, all others are represented as a three-character
-string: \"%\" followed by two lowercase hex digits.
+URI-encode STRING and return the result.
+If STRING is multibyte, it is first converted to a utf-8 byte
+string. Each byte corresponding to an allowed character is left
+as-is, while all other bytes are converted to a three-character
+string: \"%\" followed by two upper-case hex digits.
+
+The allowed characters are specified by ALLOWED-CHARS. If this
+argument is nil, the list `url-unreserved-chars' determines the
+allowed characters. Otherwise, ALLOWED-CHARS should be a vector
+whose Nth element is non-nil if character N is allowed.
+
+\(fn STRING &optional ALLOWED-CHARS)" nil nil)
+
+(autoload 'url-encode-url "url-util" "\
+Return a properly URI-encoded version of URL.
+This function also performs URI normalization, e.g. converting
+the scheme to lowercase if it is uppercase. Apart from
+normalization, if URL is already URI-encoded, this function
+should return it unchanged.
-\(fn STRING)" nil nil)
+\(fn URL)" nil nil)
(autoload 'url-file-extension "url-util" "\
Return the filename extension of FNAME.
@@ -30509,7 +29374,7 @@ This uses `url-current-object', set locally to the buffer.
;;;***
;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock)
-;;;;;; "userlock" "userlock.el" (19845 45374))
+;;;;;; "userlock" "userlock.el" (20555 6946 859539 0))
;;; Generated autoloads from userlock.el
(autoload 'ask-user-about-lock "userlock" "\
@@ -30539,7 +29404,7 @@ The buffer in question is current when this function is called.
;;;### (autoloads (utf-7-imap-pre-write-conversion utf-7-pre-write-conversion
;;;;;; utf-7-imap-post-read-conversion utf-7-post-read-conversion)
-;;;;;; "utf-7" "international/utf-7.el" (19845 45374))
+;;;;;; "utf-7" "international/utf-7.el" (20355 10021 546955 0))
;;; Generated autoloads from international/utf-7.el
(autoload 'utf-7-post-read-conversion "utf-7" "\
@@ -30564,7 +29429,8 @@ The buffer in question is current when this function is called.
;;;***
-;;;### (autoloads (utf7-encode) "utf7" "gnus/utf7.el" (19845 45374))
+;;;### (autoloads (utf7-encode) "utf7" "gnus/utf7.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from gnus/utf7.el
(autoload 'utf7-encode "utf7" "\
@@ -30576,7 +29442,7 @@ Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil.
;;;### (autoloads (uudecode-decode-region uudecode-decode-region-internal
;;;;;; uudecode-decode-region-external) "uudecode" "mail/uudecode.el"
-;;;;;; (19845 45374))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mail/uudecode.el
(autoload 'uudecode-decode-region-external "uudecode" "\
@@ -30606,8 +29472,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" (20172
-;;;;;; 54913))
+;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (20611
+;;;;;; 52135 109136 0))
;;; Generated autoloads from vc/vc.el
(defvar vc-checkout-hook nil "\
@@ -30630,34 +29496,27 @@ See `run-hooks'.")
(autoload 'vc-next-action "vc" "\
Do the next logical version control operation on the current fileset.
-This requires that all files in the fileset be in the same state.
-
-For locking systems:
- If every file is not already registered, this registers each for version
-control.
- If every file is registered and not locked by anyone, this checks out
-a writable and locked file of each ready for editing.
- If every file is checked out and locked by the calling user, this
-first checks to see if each file has changed since checkout. If not,
-it performs a revert on that file.
- If every file has been changed, this pops up a buffer for entry
-of a log message; when the message has been entered, it checks in the
-resulting changes along with the log message as change commentary. If
-the variable `vc-keep-workfiles' is non-nil (which is its default), a
-read-only copy of each changed file is left in place afterwards.
- If the affected file is registered and locked by someone else, you are
-given the option to steal the lock(s).
-
-For merging systems:
- If every file is not already registered, this registers each one for version
-control. This does an add, but not a commit.
- If every file is added but not committed, each one is committed.
- If every working file is changed, but the corresponding repository file is
-unchanged, this pops up a buffer for entry of a log message; when the
-message has been entered, it checks in the resulting changes along
-with the logmessage as change commentary. A writable file is retained.
- If the repository file is changed, you are asked if you want to
-merge in the changes into your working copy.
+This requires that all files in the current VC fileset be in the
+same state. If not, signal an error.
+
+For merging-based version control systems:
+ If every file in the VC fileset is not registered for version
+ control, register the fileset (but don't commit).
+ If every work file in the VC fileset is added or changed, pop
+ up a *vc-log* buffer to commit the fileset.
+ For a centralized version control system, if any work file in
+ the VC fileset is out of date, offer to update the fileset.
+
+For old-style locking-based version control systems, like RCS:
+ If every file is not registered, register the file(s).
+ If every file is registered and unlocked, check out (lock)
+ the file(s) for editing.
+ If every file is locked by you and has changes, pop up a
+ *vc-log* buffer to check in the changes. If the variable
+ `vc-keep-workfiles' is non-nil (the default), leave a
+ read-only copy of each changed file after checking in.
+ If every file is locked by you and unchanged, unlock them.
+ If every file is locked by someone else, offer to steal the lock.
\(fn VERBOSE)" t nil)
@@ -30691,7 +29550,7 @@ designators specifying which revisions to compare.
The optional argument NOT-URGENT non-nil means it is ok to say no to
saving the buffer.
-\(fn HISTORIC &optional NOT-URGENT)" t nil)
+\(fn &optional HISTORIC NOT-URGENT)" t nil)
(autoload 'vc-version-ediff "vc" "\
Show differences between revisions of the fileset in the
@@ -30738,6 +29597,7 @@ the variable `vc-BACKEND-header'.
(autoload 'vc-merge "vc" "\
Perform a version control merge operation.
+You must be visiting a version controlled file, or in a `vc-dir' buffer.
On a distributed version control system, this runs a \"merge\"
operation to incorporate changes from another branch onto the
current branch, prompting for an argument list.
@@ -30820,6 +29680,7 @@ depending on the underlying version-control system.
(autoload 'vc-pull "vc" "\
Update the current fileset or branch.
+You must be visiting a version controlled file, or in a `vc-dir' buffer.
On a distributed version control system, this runs a \"pull\"
operation to update the current branch, prompting for an argument
list if required. Optional prefix ARG forces a prompt.
@@ -30890,7 +29751,7 @@ Return the branch part of a revision number REV.
;;;***
;;;### (autoloads (vc-annotate) "vc-annotate" "vc/vc-annotate.el"
-;;;;;; (19920 63959))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from vc/vc-annotate.el
(autoload 'vc-annotate "vc-annotate" "\
@@ -30927,7 +29788,8 @@ mode-specific menu. `vc-annotate-color-map' and
;;;***
-;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (20168 57844))
+;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (20478 3673 653810
+;;;;;; 0))
;;; Generated autoloads from vc/vc-arch.el
(defun vc-arch-registered (file)
(if (vc-find-root file "{arch}/=tagging-method")
@@ -30937,7 +29799,8 @@ mode-specific menu. `vc-annotate-color-map' and
;;;***
-;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20174 10230))
+;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20584 7212 455152
+;;;;;; 0))
;;; Generated autoloads from vc/vc-bzr.el
(defconst vc-bzr-admin-dirname ".bzr" "\
@@ -30953,7 +29816,8 @@ Name of the format file in a .bzr directory.")
;;;***
-;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (20174 10230))
+;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (20542 46798 773957
+;;;;;; 0))
;;; Generated autoloads from vc/vc-cvs.el
(defun vc-cvs-registered (f)
"Return non-nil if file F is registered with CVS."
@@ -30964,7 +29828,8 @@ Name of the format file in a .bzr directory.")
;;;***
-;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (20168 57844))
+;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (20522 9637 465791
+;;;;;; 0))
;;; Generated autoloads from vc/vc-dir.el
(autoload 'vc-dir "vc-dir" "\
@@ -30989,7 +29854,7 @@ These are the commands available for use in the file status buffer:
;;;***
;;;### (autoloads (vc-do-command) "vc-dispatcher" "vc/vc-dispatcher.el"
-;;;;;; (20168 57844))
+;;;;;; (20489 12324 656827 0))
;;; Generated autoloads from vc/vc-dispatcher.el
(autoload 'vc-do-command "vc-dispatcher" "\
@@ -31012,7 +29877,8 @@ case, and the process object in the asynchronous case.
;;;***
-;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20087 5852))
+;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20586 48936 135199
+;;;;;; 0))
;;; Generated autoloads from vc/vc-git.el
(defun vc-git-registered (file)
"Return non-nil if FILE is registered with git."
@@ -31023,7 +29889,7 @@ case, and the process object in the asynchronous case.
;;;***
-;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (19845 45374))
+;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (20489 12324 656827 0))
;;; Generated autoloads from vc/vc-hg.el
(defun vc-hg-registered (file)
"Return non-nil if FILE is registered with hg."
@@ -31034,7 +29900,7 @@ case, and the process object in the asynchronous case.
;;;***
-;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (20174 10230))
+;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (20524 51365 2559 0))
;;; Generated autoloads from vc/vc-mtn.el
(defconst vc-mtn-admin-dir "_MTN" "\
@@ -31051,7 +29917,7 @@ Name of the monotone directory's format file.")
;;;***
;;;### (autoloads (vc-rcs-master-templates) "vc-rcs" "vc/vc-rcs.el"
-;;;;;; (20161 45793))
+;;;;;; (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")) "\
@@ -31065,7 +29931,7 @@ For a description of possible values, see `vc-check-master-templates'.")
;;;***
;;;### (autoloads (vc-sccs-master-templates) "vc-sccs" "vc/vc-sccs.el"
-;;;;;; (19845 45374))
+;;;;;; (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)) "\
@@ -31073,7 +29939,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.
@@ -31082,7 +29949,8 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir)
;;;***
-;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (20162 19074))
+;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from vc/vc-svn.el
(defun vc-svn-registered (f)
(let ((admin-dir (cond ((and (eq system-type 'windows-nt)
@@ -31096,7 +29964,7 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir)
;;;***
;;;### (autoloads (vera-mode) "vera-mode" "progmodes/vera-mode.el"
-;;;;;; (20131 59880))
+;;;;;; (20577 33959 40183 0))
;;; Generated autoloads from progmodes/vera-mode.el
(add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode))
@@ -31154,7 +30022,7 @@ Key bindings:
;;;***
;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el"
-;;;;;; (20183 25152))
+;;;;;; (20593 22184 581574 0))
;;; Generated autoloads from progmodes/verilog-mode.el
(autoload 'verilog-mode "verilog-mode" "\
@@ -31293,7 +30161,7 @@ Key bindings specific to `verilog-mode-map' are:
;;;***
;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el"
-;;;;;; (20168 57844))
+;;;;;; (20593 22184 581574 0))
;;; Generated autoloads from progmodes/vhdl-mode.el
(autoload 'vhdl-mode "vhdl-mode" "\
@@ -31310,7 +30178,7 @@ Usage:
brackets and removed if the queried string is left empty. Prompts for
mandatory arguments remain in the code if the queried string is left
empty. They can be queried again by `C-c C-t C-q'. Enabled
- electrification is indicated by `/e' in the modeline.
+ electrification is indicated by `/e' in the mode line.
Typing `M-SPC' after a keyword inserts a space without calling the
template generator. Automatic template generation (i.e.
@@ -31337,7 +30205,7 @@ Usage:
Double striking of some keys inserts cumbersome VHDL syntax elements.
Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by
option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in
- the modeline. The stuttering keys and their effects are:
+ the mode line. The stuttering keys and their effects are:
;; --> \" : \" [ --> ( -- --> comment
;;; --> \" := \" [[ --> [ --CR --> comment-out code
@@ -31371,8 +30239,10 @@ Usage:
with a comment in between.
`--CR' comments out code on that line. Re-hitting CR comments
out following lines.
- `C-c c' comments out a region if not commented out,
- uncomments a region if already commented out.
+ `C-c C-c' comments out a region if not commented out,
+ uncomments a region if already commented out. Option
+ `comment-style' defines where the comment characters
+ should be placed (beginning of line, indent, etc.).
You are prompted for comments after object definitions (i.e. signals,
variables, constants, ports) and after subprogram and process
@@ -31393,7 +30263,8 @@ Usage:
`TAB' indents a line if at the beginning of the line. The amount of
indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l'
always indents the current line (is bound to `TAB' if option
- `vhdl-intelligent-tab' is nil).
+ `vhdl-intelligent-tab' is nil). If a region is active, `TAB' indents
+ the entire region.
Indentation can be done for a group of lines (`C-c C-i C-g'), a region
(`M-C-\\') or the entire buffer (menu). Argument and port lists are
@@ -31407,6 +30278,10 @@ Usage:
Syntax-based indentation can be very slow in large files. Option
`vhdl-indent-syntax-based' allows to use faster but simpler indentation.
+ Option `vhdl-indent-comment-like-next-code-line' controls whether
+ comment lines are indented like the preceding or like the following code
+ line.
+
ALIGNMENT:
The alignment functions align operators, keywords, and inline comments
@@ -31444,7 +30319,7 @@ Usage:
CODE BEAUTIFICATION:
`C-c M-b' and `C-c C-b' beautify the code of a region or of the entire
- buffer respectively. This inludes indentation, alignment, and case
+ buffer respectively. This includes indentation, alignment, and case
fixing. Code beautification can also be run non-interactively using the
command:
@@ -31535,12 +30410,12 @@ Usage:
STRUCTURAL COMPOSITION:
- Enables simple structural composition. `C-c C-c C-n' creates a skeleton
+ Enables simple structural composition. `C-c C-m C-n' creates a skeleton
for a new component. Subcomponents (i.e. component declaration and
instantiation) can be automatically placed from a previously read port
- (`C-c C-c C-p') or directly from the hierarchy browser (`P'). Finally,
+ (`C-c C-m C-p') or directly from the hierarchy browser (`P'). Finally,
all subcomponents can be automatically connected using internal signals
- and ports (`C-c C-c C-w') following these rules:
+ and ports (`C-c C-m C-w') following these rules:
- subcomponent actual ports with same name are considered to be
connected by a signal (internal signal or port)
- signals that are only inputs to subcomponents are considered as
@@ -31561,25 +30436,25 @@ Usage:
Component declarations can be placed in a components package (option
`vhdl-use-components-package') which can be automatically generated for
- an entire directory or project (`C-c C-c M-p'). The VHDL'93 direct
+ an entire directory or project (`C-c C-m M-p'). The VHDL'93 direct
component instantiation is also supported (option
`vhdl-use-direct-instantiation').
-| Configuration declarations can automatically be generated either from
-| the menu (`C-c C-c C-f') (for the architecture the cursor is in) or from
-| the speedbar menu (for the architecture under the cursor). The
-| configurations can optionally be hierarchical (i.e. include all
-| component levels of a hierarchical design, option
-| `vhdl-compose-configuration-hierarchical') or include subconfigurations
-| (option `vhdl-compose-configuration-use-subconfiguration'). For
-| subcomponents in hierarchical configurations, the most-recently-analyzed
-| (mra) architecture is selected. If another architecture is desired, it
-| can be marked as most-recently-analyzed (speedbar menu) before
-| generating the configuration.
-|
-| Note: Configurations of subcomponents (i.e. hierarchical configuration
-| declarations) are currently not considered when displaying
-| configurations in speedbar.
+ Configuration declarations can automatically be generated either from
+ the menu (`C-c C-m C-f') (for the architecture the cursor is in) or from
+ the speedbar menu (for the architecture under the cursor). The
+ configurations can optionally be hierarchical (i.e. include all
+ component levels of a hierarchical design, option
+ `vhdl-compose-configuration-hierarchical') or include subconfigurations
+ (option `vhdl-compose-configuration-use-subconfiguration'). For
+ subcomponents in hierarchical configurations, the most-recently-analyzed
+ (mra) architecture is selected. If another architecture is desired, it
+ can be marked as most-recently-analyzed (speedbar menu) before
+ generating the configuration.
+
+ Note: Configurations of subcomponents (i.e. hierarchical configuration
+ declarations) are currently not considered when displaying
+ configurations in speedbar.
See the options group `vhdl-compose' for all relevant user options.
@@ -31611,11 +30486,13 @@ Usage:
The Makefile's default target \"all\" compiles the entire design, the
target \"clean\" removes it and the target \"library\" creates the
- library directory if not existent. The Makefile also includes a target
- for each primary library unit which allows selective compilation of this
- unit, its secondary units and its subhierarchy (example: compilation of
- a design specified by a configuration). User specific parts can be
- inserted into a Makefile with option `vhdl-makefile-generation-hook'.
+ library directory if not existent. These target names can be customized
+ by option `vhdl-makefile-default-targets'. The Makefile also includes a
+ target for each primary library unit which allows selective compilation
+ of this unit, its secondary units and its subhierarchy (example:
+ compilation of a design specified by a configuration). User specific
+ parts can be inserted into a Makefile with option
+ `vhdl-makefile-generation-hook'.
Limitations:
- Only library units and dependencies within the current library are
@@ -31661,7 +30538,7 @@ Usage:
VHDL STANDARDS:
The VHDL standards to be used are specified in option `vhdl-standard'.
- Available standards are: VHDL'87/'93, VHDL-AMS, and Math Packages.
+ Available standards are: VHDL'87/'93(02), VHDL-AMS, and Math Packages.
KEYWORD CASE:
@@ -31737,6 +30614,9 @@ Usage:
- Out parameters of procedures are considered to be read.
Use option `vhdl-entity-file-name' to specify the entity file name
(used to obtain the port names).
+ Use option `vhdl-array-index-record-field-in-sensitivity-list' to
+ specify whether to include array indices and record fields in
+ sensitivity lists.
CODE FIXING:
@@ -31810,16 +30690,17 @@ releases. You are kindly invited to participate in beta testing. Subscribe
to above mailing lists by sending an email to <reto@gnu.org>.
VHDL Mode is officially distributed at
-URL `http://opensource.ethz.ch/emacs/vhdl-mode.html'
+http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
where the latest version can be found.
Known problems:
---------------
-- Indentation bug in simultaneous if- and case-statements (VHDL-AMS).
- XEmacs: Incorrect start-up when automatically opening speedbar.
- XEmacs: Indentation in XEmacs 21.4 (and higher).
+- Indentation incorrect for new 'postponed' VHDL keyword.
+- Indentation incorrect for 'protected body' construct.
The VHDL Mode Authors
@@ -31834,7 +30715,8 @@ Key bindings:
;;;***
-;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (20104 14925))
+;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (20566 63671 243798
+;;;;;; 0))
;;; Generated autoloads from emulation/vi.el
(autoload 'vi-mode "vi" "\
@@ -31889,7 +30771,7 @@ Syntax table and abbrevs while in vi mode remain as they were in Emacs.
;;;### (autoloads (viqr-pre-write-conversion viqr-post-read-conversion
;;;;;; viet-encode-viqr-buffer viet-encode-viqr-region viet-decode-viqr-buffer
;;;;;; viet-decode-viqr-region viet-encode-viscii-char) "viet-util"
-;;;;;; "language/viet-util.el" (19845 45374))
+;;;;;; "language/viet-util.el" (20355 10021 546955 0))
;;; Generated autoloads from language/viet-util.el
(autoload 'viet-encode-viscii-char "viet-util" "\
@@ -31937,7 +30819,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" (20174 10230))
+;;;;;; "view" "view.el" (20577 33959 40183 0))
;;; Generated autoloads from view.el
(defvar view-remove-frame-by-deleting t "\
@@ -32020,6 +30902,10 @@ file: Users may suspend viewing in order to modify the buffer.
Exiting View mode will then discard the user's edits. Setting
EXIT-ACTION to `kill-buffer-if-not-modified' avoids this.
+This function does not enable View mode if the buffer's major-mode
+has a `special' mode-class, because such modes usually have their
+own View-like bindings.
+
\(fn BUFFER &optional EXIT-ACTION)" t nil)
(autoload 'view-buffer-other-window "view" "\
@@ -32038,6 +30924,10 @@ Optional argument EXIT-ACTION is either nil or a function with buffer as
argument. This function is called when finished viewing buffer. Use
this argument instead of explicitly setting `view-exit-action'.
+This function does not enable View mode if the buffer's major-mode
+has a `special' mode-class, because such modes usually have their
+own View-like bindings.
+
\(fn BUFFER &optional NOT-RETURN EXIT-ACTION)" t nil)
(autoload 'view-buffer-other-frame "view" "\
@@ -32056,6 +30946,10 @@ Optional argument EXIT-ACTION is either nil or a function with buffer as
argument. This function is called when finished viewing buffer. Use
this argument instead of explicitly setting `view-exit-action'.
+This function does not enable View mode if the buffer's major-mode
+has a `special' mode-class, because such modes usually have their
+own View-like bindings.
+
\(fn BUFFER &optional NOT-RETURN EXIT-ACTION)" t nil)
(autoload 'view-mode "view" "\
@@ -32147,7 +31041,7 @@ Entry to view-mode runs the normal hook `view-mode-hook'.
Update `view-return-to-alist' of buffer BUFFER.
Remove from `view-return-to-alist' all entries referencing dead
windows. Optional argument ITEM non-nil means add ITEM to
-`view-return-to-alist' after purging. For a decsription of items
+`view-return-to-alist' after purging. For a description of items
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
@@ -32155,6 +31049,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
@@ -32179,8 +31075,8 @@ Exit View mode and make the current buffer editable.
;;;***
-;;;### (autoloads (vip-mode vip-setup) "vip" "emulation/vip.el" (20141
-;;;;;; 9296))
+;;;### (autoloads (vip-mode vip-setup) "vip" "emulation/vip.el" (20513
+;;;;;; 18948 537867 0))
;;; Generated autoloads from emulation/vip.el
(autoload 'vip-setup "vip" "\
@@ -32196,7 +31092,7 @@ Turn on VIP emulation of VI.
;;;***
;;;### (autoloads (viper-mode toggle-viper-mode) "viper" "emulation/viper.el"
-;;;;;; (20167 36967))
+;;;;;; (20566 63671 243798 0))
;;; Generated autoloads from emulation/viper.el
(autoload 'toggle-viper-mode "viper" "\
@@ -32213,7 +31109,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'.
;;;***
;;;### (autoloads (warn lwarn display-warning) "warnings" "emacs-lisp/warnings.el"
-;;;;;; (19906 31087))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/warnings.el
(defvar warning-prefix-function nil "\
@@ -32303,15 +31199,16 @@ this is equivalent to `display-warning', using
;;;***
;;;### (autoloads (wdired-change-to-wdired-mode) "wdired" "wdired.el"
-;;;;;; (20174 10230))
+;;;;;; (20619 46245 806932 0))
;;; Generated autoloads from wdired.el
(autoload 'wdired-change-to-wdired-mode "wdired" "\
-Put a dired buffer in a mode in which filenames are editable.
+Put a Dired buffer in Writable Dired (WDired) mode.
\\<wdired-mode-map>
-This mode allows the user to change the names of the files, and after
-typing \\[wdired-finish-edit] Emacs renames the files and directories
-in disk.
+In WDired mode, you can edit the names of the files in the
+buffer, the target of the links, and the permission bits of the
+files. After typing \\[wdired-finish-edit], Emacs modifies the files and
+directories to reflect your edits.
See `wdired-mode'.
@@ -32319,7 +31216,8 @@ See `wdired-mode'.
;;;***
-;;;### (autoloads (webjump) "webjump" "net/webjump.el" (20159 42847))
+;;;### (autoloads (webjump) "webjump" "net/webjump.el" (20566 63671
+;;;;;; 243798 0))
;;; Generated autoloads from net/webjump.el
(autoload 'webjump "webjump" "\
@@ -32336,12 +31234,12 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke
;;;***
;;;### (autoloads (which-function-mode) "which-func" "progmodes/which-func.el"
-;;;;;; (20127 62865))
+;;;;;; (20613 49078 764749 0))
;;; Generated autoloads from progmodes/which-func.el
(put 'which-func-format 'risky-local-variable t)
(put 'which-func-current 'risky-local-variable t)
-(defalias 'which-func-mode 'which-function-mode)
+(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.
@@ -32369,7 +31267,8 @@ in certain major modes.
;;;### (autoloads (whitespace-report-region whitespace-report whitespace-cleanup-region
;;;;;; whitespace-cleanup global-whitespace-toggle-options whitespace-toggle-options
;;;;;; global-whitespace-newline-mode global-whitespace-mode whitespace-newline-mode
-;;;;;; whitespace-mode) "whitespace" "whitespace.el" (20176 51947))
+;;;;;; whitespace-mode) "whitespace" "whitespace.el" (20508 13724
+;;;;;; 260761 0))
;;; Generated autoloads from whitespace.el
(autoload 'whitespace-mode "whitespace" "\
@@ -32768,7 +31667,8 @@ cleaning up these problems.
;;;***
;;;### (autoloads (widget-minor-mode widget-browse-other-window widget-browse
-;;;;;; widget-browse-at) "wid-browse" "wid-browse.el" (20127 62865))
+;;;;;; widget-browse-at) "wid-browse" "wid-browse.el" (20478 3673
+;;;;;; 653810 0))
;;; Generated autoloads from wid-browse.el
(autoload 'widget-browse-at "wid-browse" "\
@@ -32788,14 +31688,17 @@ Show widget browser for WIDGET in other window.
(autoload 'widget-minor-mode "wid-browse" "\
Minor mode for traversing widgets.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads (widget-setup widget-insert widget-delete widget-create
-;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (20162
-;;;;;; 19074))
+;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (20373
+;;;;;; 11301 906925 0))
;;; Generated autoloads from wid-edit.el
(autoload 'widgetp "wid-edit" "\
@@ -32838,8 +31741,8 @@ Setup current buffer so editing string widgets works.
;;;***
;;;### (autoloads (windmove-default-keybindings windmove-down windmove-right
-;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (20161
-;;;;;; 45793))
+;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (20566
+;;;;;; 63671 243798 0))
;;; Generated autoloads from windmove.el
(autoload 'windmove-left "windmove" "\
@@ -32891,27 +31794,33 @@ Default MODIFIER is 'shift.
;;;***
-;;;### (autoloads (winner-mode winner-mode) "winner" "winner.el"
-;;;;;; (19998 49767))
+;;;### (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)
;;;***
;;;### (autoloads (woman-bookmark-jump woman-find-file woman-dired-find-file
-;;;;;; woman woman-locale) "woman" "woman.el" (20168 57844))
+;;;;;; woman woman-locale) "woman" "woman.el" (20623 43301 870757
+;;;;;; 0))
;;; Generated autoloads from woman.el
(defvar woman-locale nil "\
@@ -32960,7 +31869,7 @@ Default bookmark handler for Woman buffers.
;;;***
;;;### (autoloads (wordstar-mode) "ws-mode" "emulation/ws-mode.el"
-;;;;;; (20141 9296))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emulation/ws-mode.el
(autoload 'wordstar-mode "ws-mode" "\
@@ -33072,7 +31981,8 @@ The key bindings are:
;;;***
-;;;### (autoloads (xesam-search) "xesam" "net/xesam.el" (20175 31160))
+;;;### (autoloads (xesam-search) "xesam" "net/xesam.el" (20478 3673
+;;;;;; 653810 0))
;;; Generated autoloads from net/xesam.el
(autoload 'xesam-search "xesam" "\
@@ -33092,33 +32002,64 @@ Example:
;;;***
;;;### (autoloads (xml-parse-region xml-parse-file) "xml" "xml.el"
-;;;;;; (20168 57844))
+;;;;;; (20528 48420 241677 0))
;;; Generated autoloads from xml.el
(autoload 'xml-parse-file "xml" "\
Parse the well-formed XML file FILE.
-If FILE is already visited, use its buffer and don't kill it.
-Returns the top node with all its children.
+Return the top node with all its children.
If PARSE-DTD is non-nil, the DTD is parsed rather than skipped.
-If PARSE-NS is non-nil, then QNAMES are expanded.
+
+If PARSE-NS is non-nil, then QNAMES are expanded. By default,
+the variable `xml-default-ns' is the mapping from namespaces to
+URIs, and expanded names will be returned as a cons
+
+ (\"namespace:\" . \"foo\").
+
+If PARSE-NS is an alist, it will be used as the mapping from
+namespace to URIs instead.
+
+If it is the symbol 'symbol-qnames, expanded names will be
+returned as a plain symbol 'namespace:foo instead of a cons.
+
+Both features can be combined by providing a cons cell
+
+ (symbol-qnames . ALIST).
\(fn FILE &optional PARSE-DTD PARSE-NS)" nil nil)
(autoload 'xml-parse-region "xml" "\
Parse the region from BEG to END in BUFFER.
+Return the XML parse tree, or raise an error if the region does
+not contain well-formed XML.
+
+If BEG is nil, it defaults to `point-min'.
+If END is nil, it defaults to `point-max'.
If BUFFER is nil, it defaults to the current buffer.
-Returns the XML list for the region, or raises an error if the region
-is not well-formed XML.
-If PARSE-DTD is non-nil, the DTD is parsed rather than skipped,
-and returned as the first element of the list.
-If PARSE-NS is non-nil, then QNAMES are expanded.
+If PARSE-DTD is non-nil, parse the DTD and return it as the first
+element of the list.
+If PARSE-NS is non-nil, then QNAMES are expanded. By default,
+the variable `xml-default-ns' is the mapping from namespaces to
+URIs, and expanded names will be returned as a cons
+
+ (\"namespace:\" . \"foo\").
+
+If PARSE-NS is an alist, it will be used as the mapping from
+namespace to URIs instead.
+
+If it is the symbol 'symbol-qnames, expanded names will be
+returned as a plain symbol 'namespace:foo instead of a cons.
+
+Both features can be combined by providing a cons cell
+
+ (symbol-qnames . ALIST).
-\(fn BEG END &optional BUFFER PARSE-DTD PARSE-NS)" nil nil)
+\(fn &optional BEG END BUFFER PARSE-DTD PARSE-NS)" nil nil)
;;;***
;;;### (autoloads (xmltok-get-declared-encoding-position) "xmltok"
-;;;;;; "nxml/xmltok.el" (19845 45374))
+;;;;;; "nxml/xmltok.el" (20355 10021 546955 0))
;;; Generated autoloads from nxml/xmltok.el
(autoload 'xmltok-get-declared-encoding-position "xmltok" "\
@@ -33136,8 +32077,8 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT.
;;;***
-;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (20127
-;;;;;; 62865))
+;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (20485
+;;;;;; 15269 390836 0))
;;; Generated autoloads from xt-mouse.el
(defvar xterm-mouse-mode nil "\
@@ -33167,7 +32108,7 @@ down the SHIFT key while pressing the mouse button.
;;;***
;;;### (autoloads (yenc-extract-filename yenc-decode-region) "yenc"
-;;;;;; "gnus/yenc.el" (19845 45374))
+;;;;;; "gnus/yenc.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/yenc.el
(autoload 'yenc-decode-region "yenc" "\
@@ -33183,7 +32124,7 @@ Extract file name from an yenc header.
;;;***
;;;### (autoloads (psychoanalyze-pinhead apropos-zippy insert-zippyism
-;;;;;; yow) "yow" "play/yow.el" (19845 45374))
+;;;;;; yow) "yow" "play/yow.el" (20364 42504 244840 586000))
;;; Generated autoloads from play/yow.el
(autoload 'yow "yow" "\
@@ -33209,7 +32150,8 @@ Zippy goes to the analyst.
;;;***
-;;;### (autoloads (zone) "zone" "play/zone.el" (19889 21967))
+;;;### (autoloads (zone) "zone" "play/zone.el" (20545 57511 257469
+;;;;;; 0))
;;; Generated autoloads from play/zone.el
(autoload 'zone "zone" "\
@@ -33252,20 +32194,19 @@ Zone out, completely.
;;;;;; "cedet/ede/proj-shared.el" "cedet/ede/proj.el" "cedet/ede/project-am.el"
;;;;;; "cedet/ede/shell.el" "cedet/ede/simple.el" "cedet/ede/source.el"
;;;;;; "cedet/ede/speedbar.el" "cedet/ede/srecode.el" "cedet/ede/system.el"
-;;;;;; "cedet/ede/util.el" "cedet/inversion.el" "cedet/mode-local.el"
-;;;;;; "cedet/pulse.el" "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el"
-;;;;;; "cedet/semantic/analyze/debug.el" "cedet/semantic/analyze/fcn.el"
-;;;;;; "cedet/semantic/analyze/refs.el" "cedet/semantic/bovine.el"
-;;;;;; "cedet/semantic/bovine/c-by.el" "cedet/semantic/bovine/c.el"
-;;;;;; "cedet/semantic/bovine/debug.el" "cedet/semantic/bovine/el.el"
-;;;;;; "cedet/semantic/bovine/gcc.el" "cedet/semantic/bovine/make-by.el"
-;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm-by.el"
-;;;;;; "cedet/semantic/bovine/scm.el" "cedet/semantic/chart.el"
-;;;;;; "cedet/semantic/complete.el" "cedet/semantic/ctxt.el" "cedet/semantic/db-debug.el"
-;;;;;; "cedet/semantic/db-ebrowse.el" "cedet/semantic/db-el.el"
-;;;;;; "cedet/semantic/db-file.el" "cedet/semantic/db-find.el" "cedet/semantic/db-global.el"
-;;;;;; "cedet/semantic/db-javascript.el" "cedet/semantic/db-mode.el"
-;;;;;; "cedet/semantic/db-ref.el" "cedet/semantic/db-typecache.el"
+;;;;;; "cedet/ede/util.el" "cedet/pulse.el" "cedet/semantic/analyze.el"
+;;;;;; "cedet/semantic/analyze/complete.el" "cedet/semantic/analyze/debug.el"
+;;;;;; "cedet/semantic/analyze/fcn.el" "cedet/semantic/analyze/refs.el"
+;;;;;; "cedet/semantic/bovine.el" "cedet/semantic/bovine/c-by.el"
+;;;;;; "cedet/semantic/bovine/c.el" "cedet/semantic/bovine/debug.el"
+;;;;;; "cedet/semantic/bovine/el.el" "cedet/semantic/bovine/gcc.el"
+;;;;;; "cedet/semantic/bovine/make-by.el" "cedet/semantic/bovine/make.el"
+;;;;;; "cedet/semantic/bovine/scm-by.el" "cedet/semantic/bovine/scm.el"
+;;;;;; "cedet/semantic/chart.el" "cedet/semantic/complete.el" "cedet/semantic/ctxt.el"
+;;;;;; "cedet/semantic/db-debug.el" "cedet/semantic/db-ebrowse.el"
+;;;;;; "cedet/semantic/db-el.el" "cedet/semantic/db-file.el" "cedet/semantic/db-find.el"
+;;;;;; "cedet/semantic/db-global.el" "cedet/semantic/db-javascript.el"
+;;;;;; "cedet/semantic/db-mode.el" "cedet/semantic/db-ref.el" "cedet/semantic/db-typecache.el"
;;;;;; "cedet/semantic/db.el" "cedet/semantic/debug.el" "cedet/semantic/decorate.el"
;;;;;; "cedet/semantic/decorate/include.el" "cedet/semantic/decorate/mode.el"
;;;;;; "cedet/semantic/dep.el" "cedet/semantic/doc.el" "cedet/semantic/ede-grammar.el"
@@ -33295,33 +32236,31 @@ Zone out, completely.
;;;;;; "cedet/srecode/semantic.el" "cedet/srecode/srt-wy.el" "cedet/srecode/srt.el"
;;;;;; "cedet/srecode/table.el" "cedet/srecode/template.el" "cedet/srecode/texi.el"
;;;;;; "cus-dep.el" "dframe.el" "dired-aux.el" "dired-x.el" "dos-fns.el"
-;;;;;; "dos-vars.el" "dos-w32.el" "dynamic-setting.el" "emacs-lisp/assoc.el"
-;;;;;; "emacs-lisp/authors.el" "emacs-lisp/avl-tree.el" "emacs-lisp/bindat.el"
-;;;;;; "emacs-lisp/byte-opt.el" "emacs-lisp/chart.el" "emacs-lisp/cl-extra.el"
-;;;;;; "emacs-lisp/cl-loaddefs.el" "emacs-lisp/cl-macs.el" "emacs-lisp/cl-seq.el"
-;;;;;; "emacs-lisp/cl-specs.el" "emacs-lisp/cust-print.el" "emacs-lisp/eieio-base.el"
-;;;;;; "emacs-lisp/eieio-custom.el" "emacs-lisp/eieio-datadebug.el"
-;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/eieio-speedbar.el"
-;;;;;; "emacs-lisp/eieio.el" "emacs-lisp/find-gc.el" "emacs-lisp/gulp.el"
-;;;;;; "emacs-lisp/lisp-mnt.el" "emacs-lisp/package-x.el" "emacs-lisp/regi.el"
-;;;;;; "emacs-lisp/smie.el" "emacs-lisp/tcover-ses.el" "emacs-lisp/tcover-unsafep.el"
-;;;;;; "emulation/cua-gmrk.el" "emulation/cua-rect.el" "emulation/edt-lk201.el"
-;;;;;; "emulation/edt-mapper.el" "emulation/edt-pc.el" "emulation/edt-vt100.el"
-;;;;;; "emulation/tpu-extras.el" "emulation/viper-cmd.el" "emulation/viper-ex.el"
-;;;;;; "emulation/viper-init.el" "emulation/viper-keym.el" "emulation/viper-macs.el"
-;;;;;; "emulation/viper-mous.el" "emulation/viper-util.el" "erc/erc-backend.el"
-;;;;;; "erc/erc-goodies.el" "erc/erc-ibuffer.el" "erc/erc-lang.el"
-;;;;;; "eshell/em-alias.el" "eshell/em-banner.el" "eshell/em-basic.el"
-;;;;;; "eshell/em-cmpl.el" "eshell/em-dirs.el" "eshell/em-glob.el"
-;;;;;; "eshell/em-hist.el" "eshell/em-ls.el" "eshell/em-pred.el"
-;;;;;; "eshell/em-prompt.el" "eshell/em-rebind.el" "eshell/em-script.el"
-;;;;;; "eshell/em-smart.el" "eshell/em-term.el" "eshell/em-unix.el"
-;;;;;; "eshell/em-xtra.el" "eshell/esh-arg.el" "eshell/esh-cmd.el"
-;;;;;; "eshell/esh-ext.el" "eshell/esh-groups.el" "eshell/esh-io.el"
-;;;;;; "eshell/esh-module.el" "eshell/esh-opt.el" "eshell/esh-proc.el"
-;;;;;; "eshell/esh-util.el" "eshell/esh-var.el" "ezimage.el" "foldout.el"
-;;;;;; "format-spec.el" "forms-d2.el" "forms-pass.el" "fringe.el"
-;;;;;; "generic-x.el" "gnus/compface.el" "gnus/gnus-async.el" "gnus/gnus-bcklg.el"
+;;;;;; "dos-vars.el" "dos-w32.el" "dynamic-setting.el" "emacs-lisp/authors.el"
+;;;;;; "emacs-lisp/avl-tree.el" "emacs-lisp/bindat.el" "emacs-lisp/byte-opt.el"
+;;;;;; "emacs-lisp/chart.el" "emacs-lisp/cl-extra.el" "emacs-lisp/cl-loaddefs.el"
+;;;;;; "emacs-lisp/cl-macs.el" "emacs-lisp/cl-seq.el" "emacs-lisp/cl.el"
+;;;;;; "emacs-lisp/eieio-base.el" "emacs-lisp/eieio-datadebug.el"
+;;;;;; "emacs-lisp/eieio-speedbar.el" "emacs-lisp/eieio.el" "emacs-lisp/find-gc.el"
+;;;;;; "emacs-lisp/gulp.el" "emacs-lisp/lisp-mnt.el" "emacs-lisp/package-x.el"
+;;;;;; "emacs-lisp/regi.el" "emacs-lisp/smie.el" "emacs-lisp/tcover-ses.el"
+;;;;;; "emacs-lisp/tcover-unsafep.el" "emulation/cua-gmrk.el" "emulation/cua-rect.el"
+;;;;;; "emulation/edt-lk201.el" "emulation/edt-mapper.el" "emulation/edt-pc.el"
+;;;;;; "emulation/edt-vt100.el" "emulation/tpu-extras.el" "emulation/viper-cmd.el"
+;;;;;; "emulation/viper-ex.el" "emulation/viper-init.el" "emulation/viper-keym.el"
+;;;;;; "emulation/viper-macs.el" "emulation/viper-mous.el" "emulation/viper-util.el"
+;;;;;; "erc/erc-backend.el" "erc/erc-goodies.el" "erc/erc-ibuffer.el"
+;;;;;; "erc/erc-lang.el" "eshell/em-alias.el" "eshell/em-banner.el"
+;;;;;; "eshell/em-basic.el" "eshell/em-cmpl.el" "eshell/em-dirs.el"
+;;;;;; "eshell/em-glob.el" "eshell/em-hist.el" "eshell/em-ls.el"
+;;;;;; "eshell/em-pred.el" "eshell/em-prompt.el" "eshell/em-rebind.el"
+;;;;;; "eshell/em-script.el" "eshell/em-smart.el" "eshell/em-term.el"
+;;;;;; "eshell/em-unix.el" "eshell/em-xtra.el" "eshell/esh-arg.el"
+;;;;;; "eshell/esh-cmd.el" "eshell/esh-ext.el" "eshell/esh-groups.el"
+;;;;;; "eshell/esh-io.el" "eshell/esh-module.el" "eshell/esh-opt.el"
+;;;;;; "eshell/esh-proc.el" "eshell/esh-util.el" "eshell/esh-var.el"
+;;;;;; "ezimage.el" "foldout.el" "format-spec.el" "fringe.el" "generic-x.el"
+;;;;;; "gnus/compface.el" "gnus/gnus-async.el" "gnus/gnus-bcklg.el"
;;;;;; "gnus/gnus-cite.el" "gnus/gnus-cus.el" "gnus/gnus-demon.el"
;;;;;; "gnus/gnus-dup.el" "gnus/gnus-eform.el" "gnus/gnus-ems.el"
;;;;;; "gnus/gnus-int.el" "gnus/gnus-logic.el" "gnus/gnus-mh.el"
@@ -33330,19 +32269,20 @@ Zone out, completely.
;;;;;; "gnus/gnus-util.el" "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/gssapi.el"
;;;;;; "gnus/ietf-drums.el" "gnus/legacy-gnus-agent.el" "gnus/mail-parse.el"
;;;;;; "gnus/mail-prsvr.el" "gnus/mail-source.el" "gnus/mailcap.el"
-;;;;;; "gnus/messcompat.el" "gnus/mm-bodies.el" "gnus/mm-decode.el"
-;;;;;; "gnus/mm-util.el" "gnus/mm-view.el" "gnus/mml-sec.el" "gnus/mml-smime.el"
-;;;;;; "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndir.el" "gnus/nndraft.el"
-;;;;;; "gnus/nneething.el" "gnus/nngateway.el" "gnus/nnheader.el"
-;;;;;; "gnus/nnimap.el" "gnus/nnir.el" "gnus/nnmail.el" "gnus/nnmaildir.el"
-;;;;;; "gnus/nnmairix.el" "gnus/nnmbox.el" "gnus/nnmh.el" "gnus/nnnil.el"
-;;;;;; "gnus/nnoo.el" "gnus/nnregistry.el" "gnus/nnrss.el" "gnus/nnspool.el"
-;;;;;; "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"
+;;;;;; "gnus/messcompat.el" "gnus/mm-archive.el" "gnus/mm-bodies.el"
+;;;;;; "gnus/mm-decode.el" "gnus/mm-util.el" "gnus/mm-view.el" "gnus/mml-sec.el"
+;;;;;; "gnus/mml-smime.el" "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndir.el"
+;;;;;; "gnus/nndraft.el" "gnus/nneething.el" "gnus/nngateway.el"
+;;;;;; "gnus/nnheader.el" "gnus/nnimap.el" "gnus/nnir.el" "gnus/nnmail.el"
+;;;;;; "gnus/nnmaildir.el" "gnus/nnmairix.el" "gnus/nnmbox.el" "gnus/nnmh.el"
+;;;;;; "gnus/nnnil.el" "gnus/nnoo.el" "gnus/nnregistry.el" "gnus/nnrss.el"
+;;;;;; "gnus/nnspool.el" "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"
@@ -33352,14 +32292,13 @@ Zone out, completely.
;;;;;; "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/mailpost.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"
+;;;;;; "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"
@@ -33381,24 +32320,34 @@ Zone out, completely.
;;;;;; "nxml/xsd-regexp.el" "org/ob-C.el" "org/ob-R.el" "org/ob-asymptote.el"
;;;;;; "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-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-ocaml.el" "org/ob-octave.el"
-;;;;;; "org/ob-org.el" "org/ob-perl.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-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-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"
-;;;;;; "patcomp.el" "play/gamegrid.el" "play/gametree.el" "play/meese.el"
+;;;;;; "org/ob-eval.el" "org/ob-exp.el" "org/ob-fortran.el" "org/ob-gnuplot.el"
+;;;;;; "org/ob-haskell.el" "org/ob-io.el" "org/ob-java.el" "org/ob-js.el"
+;;;;;; "org/ob-keys.el" "org/ob-latex.el" "org/ob-ledger.el" "org/ob-lilypond.el"
+;;;;;; "org/ob-lisp.el" "org/ob-lob.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-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/ob-tangle.el" "org/ob.el" "org/org-archive.el" "org/org-ascii.el"
+;;;;;; "org/org-attach.el" "org/org-bbdb.el" "org/org-bibtex.el"
+;;;;;; "org/org-clock.el" "org/org-crypt.el" "org/org-ctags.el"
+;;;;;; "org/org-datetree.el" "org/org-docbook.el" "org/org-docview.el"
+;;;;;; "org/org-element.el" "org/org-entities.el" "org/org-eshell.el"
+;;;;;; "org/org-exp-blocks.el" "org/org-exp.el" "org/org-faces.el"
+;;;;;; "org/org-feed.el" "org/org-footnote.el" "org/org-freemind.el"
+;;;;;; "org/org-gnus.el" "org/org-habit.el" "org/org-html.el" "org/org-icalendar.el"
+;;;;;; "org/org-id.el" "org/org-indent.el" "org/org-info.el" "org/org-inlinetask.el"
+;;;;;; "org/org-install.el" "org/org-irc.el" "org/org-jsinfo.el"
+;;;;;; "org/org-latex.el" "org/org-list.el" "org/org-loaddefs.el"
+;;;;;; "org/org-lparse.el" "org/org-mac-message.el" "org/org-macs.el"
+;;;;;; "org/org-mew.el" "org/org-mhe.el" "org/org-mks.el" "org/org-mobile.el"
+;;;;;; "org/org-mouse.el" "org/org-odt.el" "org/org-pcomplete.el"
+;;;;;; "org/org-plot.el" "org/org-protocol.el" "org/org-publish.el"
+;;;;;; "org/org-remember.el" "org/org-rmail.el" "org/org-special-blocks.el"
+;;;;;; "org/org-src.el" "org/org-table.el" "org/org-taskjuggler.el"
+;;;;;; "org/org-timer.el" "org/org-vm.el" "org/org-w3m.el" "org/org-wl.el"
+;;;;;; "org/org-xoxo.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"
@@ -33414,14 +32363,15 @@ Zone out, completely.
;;;;;; "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-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") (20183
-;;;;;; 25444 347950))
+;;;;;; "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-common-fns.el"
+;;;;;; "w32-fns.el" "w32-vars.el" "x-dnd.el") (20626 19627 425848
+;;;;;; 6000))
;;;***
diff --git a/lisp/linum.el b/lisp/linum.el
index 4e58a1b7118..3c278dbbf3b 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -1,6 +1,6 @@
;;; linum.el --- display line numbers in the left margin -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Markus Triska <markus.triska@gmx.at>
;; Maintainer: FSF
@@ -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/loadhist.el b/lisp/loadhist.el
index 8edda03044a..88aa9f53b75 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -1,6 +1,6 @@
;;; loadhist.el --- lisp functions for working with feature groups
-;; Copyright (C) 1995, 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: FSF
@@ -29,8 +29,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(defun feature-symbols (feature)
"Return the file and list of definitions associated with FEATURE.
The value is actually the element of `load-history'
@@ -143,13 +141,13 @@ These are symbols with hooklike values whose names don't end in
`-hook' or `-hooks', from which `unload-feature' should try to remove
pertinent symbols.")
+(define-obsolete-variable-alias 'unload-hook-features-list
+ 'unload-function-defs-list "22.2")
(defvar unload-function-defs-list nil
"List of definitions in the Lisp library being unloaded.
This is meant to be used by `FEATURE-unload-function'; see the
documentation of `unload-feature' for details.")
-(define-obsolete-variable-alias 'unload-hook-features-list
- 'unload-function-defs-list "22.2")
(defun unload--set-major-mode ()
(save-current-buffer
@@ -254,11 +252,11 @@ something strange, such as redefining an Emacs function."
(dolist (x unload-function-defs-list)
(if (consp x)
- (case (car x)
+ (pcase (car x)
;; Remove any feature names that this file provided.
- (provide
+ (`provide
(setq features (delq (cdr x) features)))
- ((defun autoload)
+ ((or `defun `autoload)
(let ((fun (cdr x)))
(when (fboundp fun)
(when (fboundp 'ad-unadvise)
@@ -270,9 +268,9 @@ something strange, such as redefining an Emacs function."
;; (t . SYMBOL) comes before (defun . SYMBOL)
;; and says we should restore SYMBOL's autoload
;; when we undefine it.
- ((t) (setq restore-autoload (cdr x)))
- ((require defface) nil)
- (t (message "Unexpected element %s in load-history" x)))
+ (`t (setq restore-autoload (cdr x)))
+ ((or `require `defface) nil)
+ (_ (message "Unexpected element %s in load-history" x)))
;; Kill local values as much as possible.
(dolist (buf (buffer-list))
(with-current-buffer buf
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 792827dd913..f017295c33b 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -1,6 +1,6 @@
;;; loadup.el --- load up standardly loaded Lisp files for Emacs
-;; Copyright (C) 1985-1986, 1992, 1994, 2001-2011
+;; Copyright (C) 1985-1986, 1992, 1994, 2001-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -38,12 +38,17 @@
;; doc strings in the dumped Emacs.) Because of this:
;; ii) If the file is loaded uncompiled, it should (where possible)
-;; obey the doc-string conventions expected by make-docfile.
+;; obey the doc-string conventions expected by make-docfile. It
+;; should also be added to the uncompiled[] list in make-docfile.c.
;;; Code:
;; Add subdirectories to the load-path for files that might get
;; autoloaded when bootstrapping.
+;; This is because PATH_DUMPLOADSEARCH is just "../lisp".
+;; Note that we reset load-path below just before dumping,
+;; since lread.c:init_lread checks for changes to load-path
+;; in deciding whether to modify it.
(if (or (equal (nth 3 command-line-args) "bootstrap")
(equal (nth 4 command-line-args) "bootstrap")
(equal (nth 3 command-line-args) "unidata-gen.el")
@@ -61,7 +66,7 @@
(if (eq t purify-flag)
;; Hash consing saved around 11% of pure space in my tests.
- (setq purify-flag (make-hash-table :test 'equal)))
+ (setq purify-flag (make-hash-table :test 'equal :size 70000)))
(message "Using load-path %s" load-path)
@@ -83,28 +88,51 @@
;; implemented in subr.el.
(add-hook 'after-load-functions (lambda (f) (garbage-collect)))
-;; We specify .el in case someone compiled version.el by mistake.
-(load "version.el")
+(load "version")
(load "widget")
(load "custom")
(load "emacs-lisp/map-ynp")
-(load "cus-start")
(load "international/mule")
(load "international/mule-conf")
(load "env")
(load "format")
(load "bindings")
+(load "cus-start")
(load "window") ; Needed here for `replace-buffer-in-windows'.
(setq load-source-file-function 'load-with-code-conversion)
(load "files")
+;; Load-time macro-expansion can only take effect after setting
+;; load-source-file-function because of where it is called in lread.c.
+(load "emacs-lisp/macroexp")
+(if (byte-code-function-p (symbol-function 'macroexpand-all))
+ nil
+ ;; Since loaddefs is not yet loaded, macroexp's uses of pcase will simply
+ ;; fail until pcase is explicitly loaded. This also means that we have to
+ ;; disable eager macro-expansion while loading pcase.
+ (let ((macroexp--pending-eager-loads '(skip)))
+ (load "emacs-lisp/pcase"))
+ ;; Re-load macroexp so as to eagerly macro-expand its uses of pcase.
+ (load "emacs-lisp/macroexp"))
+
(load "cus-face")
(load "faces") ; after here, `defface' may be used.
(load "button")
(load "startup")
+;; We don't want to store loaddefs.el in the repository because it is
+;; a generated file; but it is required in order to compile the lisp files.
+;; When bootstrapping, we cannot generate loaddefs.el until an
+;; emacs binary has been built. We therefore compromise and keep
+;; ldefs-boot.el in the repository. This does not need to be updated
+;; as often as the real loaddefs.el would. Bootstrap should always
+;; work with ldefs-boot.el. Therefore, Whenever a new autoload cookie
+;; gets added that is necessary during bootstrapping, ldefs-boot.el
+;; should be updated by overwriting it with an up-to-date copy of
+;; loaddefs.el that is uncorrupted by local changes.
+;; autogen/update_autogen can be used to periodically update ldefs-boot.
(condition-case nil
;; Don't get confused if someone compiled this by mistake.
(load "loaddefs.el")
@@ -178,7 +206,6 @@
(load "rfn-eshadow")
(load "menu-bar")
-(load "paths.el") ;Don't get confused if someone compiled paths by mistake.
(load "emacs-lisp/lisp")
(load "textmodes/page")
(load "register")
@@ -186,13 +213,17 @@
(load "emacs-lisp/lisp-mode")
(load "textmodes/text-mode")
(load "textmodes/fill")
+(load "newcomment")
(load "replace")
+(load "emacs-lisp/tabulated-list")
(load "buff-menu")
(if (fboundp 'x-create-frame)
(progn
(load "fringe")
+ ;; Needed by `imagemagick-register-types'
+ (load "emacs-lisp/regexp-opt")
(load "image")
(load "international/fontset")
(load "dnd")
@@ -207,15 +238,18 @@
(load "term/common-win")
(load "term/x-win")))
-(if (eq system-type 'windows-nt)
+(if (or (eq system-type 'windows-nt)
+ (featurep 'w32))
(progn
- (load "w32-vars")
(load "term/common-win")
+ (load "w32-vars")
(load "term/w32-win")
- (load "ls-lisp")
(load "disp-table")
- (load "dos-w32")
- (load "w32-fns")))
+ (load "w32-common-fns")
+ (when (eq system-type 'windows-nt)
+ (load "w32-fns")
+ (load "ls-lisp")
+ (load "dos-w32"))))
(if (eq system-type 'ms-dos)
(progn
(load "dos-w32")
@@ -223,6 +257,7 @@
(load "dos-vars")
;; Don't load term/common-win: it isn't appropriate for the `pc'
;; ``window system'', which generally behaves like a terminal.
+ (load "term/internal")
(load "term/pc-win")
(load "ls-lisp")
(load "disp-table"))) ; needed to setup ibm-pc char set, see internal.el
@@ -259,6 +294,8 @@
(versions (mapcar (function (lambda (name)
(string-to-number (substring name (length base)))))
files)))
+ (setq emacs-bzr-version (condition-case nil (emacs-bzr-get-version)
+ (error nil)))
;; `emacs-version' is a constant, so we shouldn't change it with `setq'.
(defconst emacs-version
(format "%s.%d"
@@ -313,6 +350,23 @@
;; At this point, we're ready to resume undo recording for scratch.
(buffer-enable-undo "*scratch*")
+(when (hash-table-p purify-flag)
+ (let ((strings 0)
+ (vectors 0)
+ (bytecodes 0)
+ (conses 0)
+ (others 0))
+ (maphash (lambda (k v)
+ (cond
+ ((stringp k) (setq strings (1+ strings)))
+ ((vectorp k) (setq vectors (1+ vectors)))
+ ((consp k) (setq conses (1+ conses)))
+ ((byte-code-function-p v) (setq bytecodes (1+ bytecodes)))
+ (t (setq others (1+ others)))))
+ purify-flag)
+ (message "Pure-hashed: %d strings, %d vectors, %d conses, %d bytecodes, %d others"
+ strings vectors conses bytecodes others)))
+
;; Avoid error if user loads some more libraries now and make sure the
;; hash-consing hash table is GC'd.
(setq purify-flag nil)
@@ -323,9 +377,7 @@
(if (or (member (nth 3 command-line-args) '("dump" "bootstrap"))
(member (nth 4 command-line-args) '("dump" "bootstrap")))
(progn
- (if (memq system-type '(ms-dos windows-nt cygwin))
- (message "Dumping under the name emacs")
- (message "Dumping under the name emacs"))
+ (message "Dumping under the name emacs")
(condition-case ()
(delete-file "emacs")
(file-error nil))
diff --git a/lisp/locate.el b/lisp/locate.el
index 2ac2d30f41d..d172ce3d6c4 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -1,6 +1,6 @@
;;; locate.el --- interface to the locate command
-;; Copyright (C) 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Keywords: unix files
@@ -34,7 +34,7 @@
;;
;; SHELLPROGRAM Name-to-find
;;
-;; set the variable `locate-command' in your .emacs file.
+;; set the variable `locate-command' in your init file.
;;
;; To use a more complicated expression, create a function which
;; takes a string (the name to find) as input and returns a list.
diff --git a/lisp/longlines.el b/lisp/longlines.el
index b4d15da78a7..68722a8f920 100644
--- a/lisp/longlines.el
+++ b/lisp/longlines.el
@@ -1,6 +1,6 @@
;;; longlines.el --- automatically wrap long lines -*- coding:utf-8 -*-
-;; Copyright (C) 2000-2001, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2001, 2004-2012 Free Software Foundation, Inc.
;; Authors: Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
;; Alex Schroeder <alex@gnu.org>
diff --git a/lisp/lpr.el b/lisp/lpr.el
index 296063549fc..b31d19b624f 100644
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -1,6 +1,6 @@
;;; lpr.el --- print Emacs buffer on line printer
-;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2011
+;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -29,8 +29,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
;;;###autoload
(defvar lpr-windows-system
(memq system-type '(ms-dos windows-nt))
@@ -281,10 +279,10 @@ for further customization of the printer command."
(if (markerp end)
(set-marker end nil))
(message "Spooling%s...done%s%s" switch-string
- (case (count-lines (point-min) (point-max))
+ (pcase (count-lines (point-min) (point-max))
(0 "")
(1 ": ")
- (t ":\n"))
+ (_ ":\n"))
(buffer-string)))))))
;; This function copies the text between start and end
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 14a8cabf1a7..de489871887 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -1,6 +1,6 @@
;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp
-;; Copyright (C) 1992, 1994, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 2000-2012 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>
@@ -331,6 +331,7 @@ not contain `d', so that a full listing is expected."
;; do all bindings here for speed
total-line files elt short file-size attr
fuid fgid uid-len gid-len)
+ (setq file-alist (ls-lisp-sanitize file-alist))
(cond ((memq ?A switches)
(setq file-alist
(ls-lisp-delete-matching "^\\.\\.?$" file-alist)))
@@ -437,6 +438,22 @@ not contain `d', so that a full listing is expected."
(message "%s: doesn't exist or is inaccessible" file)
(ding) (sit-for 2))))) ; to show user the message!
+(defun ls-lisp-sanitize (file-alist)
+ "Sanitize the elements in FILE-ALIST.
+Fixes any elements in the alist for directory entries whose file
+attributes are nil (meaning that `file-attributes' failed for
+them). This is known to happen for some network shares, in
+particular for the \"..\" directory entry.
+
+If the \"..\" directory entry has nil attributes, the attributes
+are copied from the \".\" entry, if they are non-nil. Otherwise,
+the offending element is removed from the list, as are any
+elements for other directory entries with nil attributes."
+ (if (and (null (cdr (assoc ".." file-alist)))
+ (cdr (assoc "." file-alist)))
+ (setcdr (assoc ".." file-alist) (cdr (assoc "." file-alist))))
+ (rassq-delete-all nil file-alist))
+
(defun ls-lisp-column-format (file-alist)
"Insert the file names (only) in FILE-ALIST into the current buffer.
Format in columns, sorted vertically, following GNU ls -C.
diff --git a/lisp/macros.el b/lisp/macros.el
index 554f89a8a60..2f48aaa982a 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -1,6 +1,6 @@
;;; macros.el --- non-primitive commands for keyboard macros
-;; Copyright (C) 1985-1987, 1992, 1994-1995, 2001-2011
+;; Copyright (C) 1985-1987, 1992, 1994-1995, 2001-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el
index 32593462062..40ea8fa4a82 100644
--- a/lisp/mail/binhex.el
+++ b/lisp/mail/binhex.el
@@ -1,6 +1,6 @@
;;; binhex.el --- decode BinHex-encoded text
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: binhex news
@@ -43,20 +43,20 @@
:group 'news)
(defcustom binhex-decoder-program "hexbin"
- "*Non-nil value should be a string that names a binhex decoder.
+ "Non-nil value should be a string that names a binhex decoder.
The program should expect to read binhex data on its standard
input and write the converted data to its standard output."
:type 'string
:group 'binhex)
(defcustom binhex-decoder-switches '("-d")
- "*List of command line flags passed to the command `binhex-decoder-program'."
+ "List of command line flags passed to the command `binhex-decoder-program'."
:group 'binhex
:type '(repeat string))
(defcustom binhex-use-external
(executable-find binhex-decoder-program)
- "*Use external binhex program."
+ "Use external binhex program."
:version "22.1"
:group 'binhex
:type 'boolean)
diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el
index b614fffb69d..44b2996dea9 100644
--- a/lisp/mail/blessmail.el
+++ b/lisp/mail/blessmail.el
@@ -1,6 +1,6 @@
;;; blessmail.el --- decide whether movemail needs special privileges -*- no-byte-compile: t -*-
-;; Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 5b7601c6335..1d9d098e71c 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -1,6 +1,6 @@
;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list
-;; Copyright (C) 1985, 1994, 1997-1998, 2000-2011
+;; Copyright (C) 1985, 1994, 1997-1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: K. Shane Hartman
@@ -32,6 +32,9 @@
;;; Code:
+(require 'sendmail)
+(require 'message)
+
(defgroup emacsbug nil
"Sending Emacs bug reports."
:group 'maint
@@ -57,10 +60,6 @@
;; User options end here.
-(defvar report-emacs-bug-tracker-url "http://debbugs.gnu.org/cgi/"
- "Base URL of the GNU bugtracker.
-Used for querying duplicates and linking to existing bugs.")
-
(defvar report-emacs-bug-orig-text nil
"The automatically-created initial text of the bug report.")
@@ -78,13 +77,16 @@ Used for querying duplicates and linking to existing bugs.")
(defvar message-strip-special-text-properties)
(defun report-emacs-bug-can-use-osx-open ()
- "Check if OSX open can be used to insert bug report into mailer"
+ "Return non-nil if the OS X \"open\" command is available for mailing."
(and (featurep 'ns)
(equal (executable-find "open") "/usr/bin/open")
(memq system-type '(darwin))))
+;; FIXME this duplicates much of the logic from browse-url-can-use-xdg-open.
(defun report-emacs-bug-can-use-xdg-email ()
- "Check if xdg-email can be used, i.e. we are on Gnome, KDE or xfce4."
+ "Return non-nil if the \"xdg-email\" command can be used.
+xdg-email is a desktop utility that calls your preferred mail client.
+This requires you to be running either Gnome, KDE, or Xfce4."
(and (getenv "DISPLAY")
(executable-find "xdg-email")
(or (getenv "GNOME_DESKTOP_SESSION_ID")
@@ -98,16 +100,23 @@ Used for querying duplicates and linking to existing bugs.")
"org.gnome.SessionManager.CanShutdown"))
(error nil))
(equal (getenv "KDE_FULL_SESSION") "true")
+ ;; FIXME? browse-url-can-use-xdg-open also accepts LXDE.
+ ;; Is that no good here, or just overlooked?
(condition-case nil
(eq 0 (call-process
"/bin/sh" nil nil nil
"-c"
+ ;; FIXME use string-match rather than grep.
"xprop -root _DT_SAVE_MODE|grep xfce4"))
(error nil)))))
(defun report-emacs-bug-insert-to-mailer ()
+ "Send the message to your preferred mail client.
+This requires either the OS X \"open\" command, or the freedesktop
+\"xdg-email\" command to be available."
(interactive)
(save-excursion
+ ;; FIXME? use mail-fetch-field?
(let* ((to (progn
(goto-char (point-min))
(forward-line)
@@ -169,7 +178,9 @@ Prompts for bug subject. Leaves you in a mail buffer."
(set (make-local-variable 'message-strip-special-text-properties) nil))
(rfc822-goto-eoh)
(forward-line 1)
- (let ((signature (buffer-substring (point) (point-max))))
+ ;; Move the mail signature to the proper place.
+ (let ((signature (buffer-substring (point) (point-max)))
+ (inhibit-read-only t))
(delete-region (point) (point-max))
(insert signature)
(backward-char (length signature)))
@@ -197,7 +208,7 @@ Prompts for bug subject. Leaves you in a mail buffer."
(insert ". Please check that
the From: line contains a valid email address. After a delay of up
-to one day, you should receive an acknowledgement at that address.
+to one day, you should receive an acknowledgment at that address.
Please write in English if possible, as the Emacs maintainers
usually do not have translators for other languages.\n\n")))
@@ -224,6 +235,8 @@ usually do not have translators for other languages.\n\n")))
(add-text-properties (1+ user-point) (point) prompt-properties)
(insert "\n\nIn " (emacs-version) "\n")
+ (if (stringp emacs-bzr-version)
+ (insert "Bzr revision: " emacs-bzr-version "\n"))
(if (fboundp 'x-server-vendor)
(condition-case nil
;; This is used not only for X11 but also W32 and others.
@@ -231,15 +244,25 @@ usually do not have translators for other languages.\n\n")))
"', version "
(mapconcat 'number-to-string (x-server-version) ".") "\n")
(error t)))
- (if (and system-configuration-options
- (not (equal system-configuration-options "")))
- (insert "configured using `configure "
- system-configuration-options "'\n\n"))
+ (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 "
+ system-configuration-options "'\n\n")
+ (fill-region (line-beginning-position -1) (point)))
(insert "Important settings:\n")
(mapc
(lambda (var)
- (insert (format " value of $%s: %s\n" var (getenv var))))
- '("LC_ALL" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES"
+ (let ((val (getenv var)))
+ (if val (insert (format " value of $%s: %s\n" var val)))))
+ '("EMACSDATA" "EMACSDOC" "EMACSLOADPATH" "EMACSPATH"
+ "LC_ALL" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES"
"LC_MONETARY" "LC_NUMERIC" "LC_TIME" "LANG" "XMODIFIERS"))
(insert (format " locale-coding-system: %s\n" locale-coding-system))
(insert (format " default enable-multibyte-characters: %s\n"
@@ -288,9 +311,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)))
@@ -298,7 +326,7 @@ usually do not have translators for other languages.\n\n")))
(fill-region (line-beginning-position 0) (point))
;; This is so the user has to type something in order to send easily.
(use-local-map (nconc (make-sparse-keymap) (current-local-map)))
- (define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info)
+ (define-key (current-local-map) "\C-c\C-i" 'info-emacs-bug)
(if can-insert-mail
(define-key (current-local-map) "\C-cm"
'report-emacs-bug-insert-to-mailer))
@@ -318,10 +346,10 @@ usually do not have translators for other languages.\n\n")))
" Type \\[kill-buffer] RET to cancel (don't send it).\n"))
(if can-insert-mail
(princ (substitute-command-keys
- " Type \\[report-emacs-bug-insert-to-mailer] to insert text to you preferred mail program.\n")))
+ " Type \\[report-emacs-bug-insert-to-mailer] to copy text to your preferred mail program.\n")))
(terpri)
(princ (substitute-command-keys
- " Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section
+ " Type \\[info-emacs-bug] to visit in Info the Emacs Manual section
about when and how to write a bug report, and what
information you should include to help fix the bug.")))
(shrink-window-if-larger-than-buffer (get-buffer-window "*Bug Help*")))
@@ -335,10 +363,7 @@ usually do not have translators for other languages.\n\n")))
(buffer-substring-no-properties (point-min) (point)))
(goto-char user-point)))
-(defun report-emacs-bug-info ()
- "Go to the Info node on reporting Emacs bugs."
- (interactive)
- (info "(emacs)Bugs"))
+(define-obsolete-function-alias 'report-emacs-bug-info 'info-emacs-bug "24.3")
;; It's the default mail mode, so it seems OK to use its features.
(autoload 'message-bogus-recipient-p "message")
@@ -354,26 +379,7 @@ usually do not have translators for other languages.\n\n")))
(string-equal (buffer-substring-no-properties (point-min) (point))
report-emacs-bug-orig-text)
(error "No text entered in bug report"))
- (or report-emacs-bug-no-confirmation
- ;; mailclient.el does not handle From (at present).
- (if (derived-mode-p 'message-mode)
- (eq message-send-mail-function 'message-send-mail-with-mailclient)
- (eq send-mail-function 'mailclient-send-it))
- ;; Not narrowing to the headers, but that's OK.
- (let ((from (mail-fetch-field "From")))
- (and (or (not from)
- (message-bogus-recipient-p from)
- ;; This is the default user-mail-address. On today's
- ;; systems, it seems more likely to be wrong than right,
- ;; since most people don't run their own mail server.
- (string-match (format "\\<%s@%s\\>"
- (regexp-quote (user-login-name))
- (regexp-quote (system-name)))
- from))
- (not (yes-or-no-p
- (format "Is `%s' really your email address? " from)))
- (error "Please edit the From address and try again"))))
- ;; The last warning for novice users.
+ ;; Warning for novice users.
(unless (or report-emacs-bug-no-confirmation
(yes-or-no-p
"Send this bug report to the Emacs maintainers? "))
@@ -396,7 +402,35 @@ and send the mail again%s."
report-emacs-bug-send-command)
"")))))
(error "M-x report-emacs-bug was cancelled, please read *Bug Help* buffer"))
-
+ ;; Query the user for the SMTP method, so that we can skip
+ ;; questions about From header validity if the user is going to
+ ;; use mailclient, anyway.
+ (when (or (and (derived-mode-p 'message-mode)
+ (eq message-send-mail-function 'sendmail-query-once))
+ (and (not (derived-mode-p 'message-mode))
+ (eq send-mail-function 'sendmail-query-once)))
+ (sendmail-query-user-about-smtp)
+ (when (derived-mode-p 'message-mode)
+ (setq message-send-mail-function (message-default-send-mail-function))))
+ (or report-emacs-bug-no-confirmation
+ ;; mailclient.el does not need a valid From
+ (if (derived-mode-p 'message-mode)
+ (eq message-send-mail-function 'message-send-mail-with-mailclient)
+ (eq send-mail-function 'mailclient-send-it))
+ ;; Not narrowing to the headers, but that's OK.
+ (let ((from (mail-fetch-field "From")))
+ (and (or (not from)
+ (message-bogus-recipient-p from)
+ ;; This is the default user-mail-address. On today's
+ ;; systems, it seems more likely to be wrong than right,
+ ;; since most people don't run their own mail server.
+ (string-match (format "\\<%s@%s\\>"
+ (regexp-quote (user-login-name))
+ (regexp-quote (system-name)))
+ from))
+ (not (yes-or-no-p
+ (format "Is `%s' really your email address? " from)))
+ (error "Please edit the From address and try again"))))
;; Delete the uninteresting text that was just to help fill out the report.
(rfc822-goto-eoh)
(forward-line 1)
@@ -406,90 +440,6 @@ and send the mail again%s."
(delete-region pos (field-end (1+ pos)))))))
-;; Querying the bug database
-
-(defvar report-emacs-bug-bug-alist nil)
-(make-variable-buffer-local 'report-emacs-bug-bug-alist)
-(defvar report-emacs-bug-choice-widget nil)
-(make-variable-buffer-local 'report-emacs-bug-choice-widget)
-
-(defun report-emacs-bug-create-existing-bugs-buffer (bugs keywords)
- (switch-to-buffer (get-buffer-create "*Existing Emacs Bugs*"))
- (setq buffer-read-only t)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (setq report-emacs-bug-bug-alist bugs)
- (widget-insert (propertize (concat "Already known bugs ("
- keywords "):\n\n")
- 'face 'bold))
- (if bugs
- (setq report-emacs-bug-choice-widget
- (apply 'widget-create 'radio-button-choice
- :value (caar bugs)
- (let (items)
- (dolist (bug bugs)
- (push (list
- 'url-link
- :format (concat "Bug#" (number-to-string (nth 2 bug))
- ": " (cadr bug) "\n %[%v%]\n")
- ;; FIXME: Why is only the link of the
- ;; active item clickable?
- (car bug))
- items))
- (nreverse items))))
- (widget-insert "No bugs matching your keywords found.\n"))
- (widget-insert "\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- ;; TODO: Do something!
- (message "Reporting new bug!"))
- "Report new bug")
- (when bugs
- (widget-insert " ")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (let ((val (widget-value report-emacs-bug-choice-widget)))
- ;; TODO: Do something!
- (message "Appending to bug %s!"
- (nth 2 (assoc val report-emacs-bug-bug-alist)))))
- "Append to chosen bug"))
- (widget-insert " ")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (kill-buffer))
- "Quit reporting bug")
- (widget-insert "\n"))
- (use-local-map widget-keymap)
- (widget-setup)
- (goto-char (point-min)))
-
-(defun report-emacs-bug-parse-query-results (status keywords)
- (goto-char (point-min))
- (let (buglist)
- (while (re-search-forward "<a href=\"bugreport\\.cgi\\?bug=\\([[:digit:]]+\\)\">\\([^<]+\\)</a>" nil t)
- (let ((number (match-string 1))
- (subject (match-string 2)))
- (when (not (string-match "^#" subject))
- (push (list
- ;; first the bug URL
- (concat report-emacs-bug-tracker-url
- "bugreport.cgi?bug=" number)
- ;; then the subject and number
- subject (string-to-number number))
- buglist))))
- (report-emacs-bug-create-existing-bugs-buffer (nreverse buglist) keywords)))
-
-;;;###autoload
-(defun report-emacs-bug-query-existing-bugs (keywords)
- "Query for KEYWORDS at `report-emacs-bug-tracker-url', and return the result.
-The result is an alist with items of the form (URL SUBJECT NO)."
- (interactive "sBug keywords (comma separated): ")
- (url-retrieve (concat report-emacs-bug-tracker-url
- "pkgreport.cgi?include=subject%3A"
- (replace-regexp-in-string "[[:space:]]+" "+" keywords)
- ";package=emacs")
- 'report-emacs-bug-parse-query-results (list keywords)))
-
(provide 'emacsbug)
;;; emacsbug.el ends here
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index 7e3d983a76c..4305094611a 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -10,7 +10,7 @@
;;; Commentary:
-;; A replacement for parts of Emacs' sendmail.el (specifically,
+;; A replacement for parts of sendmail.el (specifically,
;; it's what handles your outgoing mail after you hit C-c C-c in mail
;; mode). See below for a list of additional features, including the
;; ability to queue messages for later sending. This replaces
@@ -139,9 +139,8 @@
;; feedmail-send-it. Hers's the best way to use the stuff in this
;; file:
;;
-;; Save this file as feedmail.el somewhere on your elisp
-;; loadpath; byte-compile it. Put the following lines somewhere in
-;; your ~/.emacs stuff:
+;; Save this file as feedmail.el somewhere on your elisp loadpath;
+;; byte-compile it. Put the following lines in your init file:
;;
;; (setq send-mail-function 'feedmail-send-it)
;; (autoload 'feedmail-send-it "feedmail")
@@ -372,8 +371,7 @@
(require 'mail-utils) ; pick up mail-strip-quoted-names
(eval-when-compile
- (require 'smtpmail)
- (require 'cl))
+ (require 'smtpmail))
(autoload 'mail-do-fcc "sendmail")
@@ -428,6 +426,7 @@ any other non-nil value, take the action in both cases. Even if
you're not confirming the sending of immediate or queued messages,
it can still be interesting to see a lot about them as they are
shuttled robotically onward."
+ :version "24.1"
:group 'feedmail-misc
:type 'boolean
)
@@ -1339,7 +1338,7 @@ Example 'defadvice' for mail-send:
(defvar feedmail-queue-runner-is-active nil
- "*Non-nil means we're inside the logic of the queue-running loop.
+ "Non-nil means we're inside the logic of the queue-running loop.
That is, iterating over all messages in the queue to send them. In
that case, the value is the name of the queued message file currently
being processed. This can be used for differentiating customized code
@@ -1365,17 +1364,19 @@ call to `feedmail-run-the-queue'."
(feedmail-say-debug ">in-> feedmail-mail-send-hook-splitter %s" feedmail-queue-runner-is-active)
(if feedmail-queue-runner-is-active
(run-hooks 'feedmail-mail-send-hook-queued)
- (run-hooks 'feedmail-mail-send-hook))
- )
-
+ (run-hooks 'feedmail-mail-send-hook)))
-(defvar feedmail-mail-send-hook nil
- "*See documentation for `feedmail-mail-send-hook-splitter'.")
-
-
-(defvar feedmail-mail-send-hook-queued nil
- "*See documentation for `feedmail-mail-send-hook-splitter'.")
+(defcustom feedmail-mail-send-hook nil
+ "Hook run by `feedmail-mail-send-hook-splitter' for immediate mail.
+See documentation of `feedmail-mail-send-hook-splitter' for details."
+ :type 'hook
+ :group 'feedmail)
+(defcustom feedmail-mail-send-hook-queued nil
+ "Hook run by `feedmail-mail-send-hook-splitter' for queued mail.
+See documentation of `feedmail-mail-send-hook-splitter' for details."
+ :type 'hook
+ :group 'feedmail)
(defun feedmail-confirm-addresses-hook-example ()
"An example of a `feedmail-last-chance-hook'.
@@ -1386,9 +1387,7 @@ It shows the simple addresses and gets a confirmation. Use as:
(erase-buffer)
(insert (mapconcat 'identity feedmail-address-list " "))
(if (not (y-or-n-p "How do you like them apples? "))
- (error "FQM: Sending...gave up in last chance hook")
- )))
-
+ (error "FQM: Sending...gave up in last chance hook"))))
(defcustom feedmail-last-chance-hook nil
"User's last opportunity to modify the message on its way out.
@@ -1513,7 +1512,7 @@ function, for example, to archive all of your sent messages someplace
(defvar feedmail-is-a-resend nil
- "*Non-nil means the message is a Resend (in the RFC-822 sense).
+ "Non-nil means the message is a Resend (in the RFC-822 sense).
This affects the composition of certain headers. feedmail sets this
variable as soon as it starts prepping the message text buffer, so any
user-supplied functions can rely on it. Users shouldn't set or change this
@@ -1585,7 +1584,7 @@ messages to make sure it works as expected."
;; feedmail-buffer-to-binmail, feedmail-buffer-to-sendmail, and
-;; feedmail-buffer-to-smptmail are the only things provided for values
+;; feedmail-buffer-to-smtpmail are the only things provided for values
;; for the variable feedmail-buffer-eating-function. It's pretty easy
;; to write your own, though.
(defun feedmail-buffer-to-binmail (prepped errors-to addr-listoid)
@@ -1950,9 +1949,6 @@ bail out with an appropriate answer to the global confirmation prompt."
(feedmail-say-debug ">in-> feedmail-run-the-queue-global-prompts")
(let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg)))
-;; letf fools the byte-compiler.
-(defvar file-name-buffer-file-type-alist)
-
;;;###autoload
(defun feedmail-run-the-queue (&optional arg)
"Visit each message in the feedmail queue directory and send it out.
@@ -2026,12 +2022,6 @@ backup file names and the like)."
(if (looking-at ".*\r\n.*\r\n")
(while (search-forward "\r\n" nil t)
(replace-match "\n" nil t)))
-;; ;; work around text-vs-binary weirdness
-;; ;; if we don't find the normal M-H-S, try reading the file a different way
-;; (if (not (feedmail-find-eoh t))
-;; (let ((file-name-buffer-file-type-alist nil) (default-buffer-file-type nil))
-;; (erase-buffer)
-;; (insert-file-contents maybe-file)))
(funcall feedmail-queue-runner-mode-setter arg)
(condition-case signal-stuff ; don't give up the loop if user skips some
(let ((feedmail-enable-queue nil)
@@ -2343,7 +2333,7 @@ mapped to mostly alphanumerics for safety."
(if (and is-fqm is-in-this-dir)
(setq filename buffer-file-name)
(setq filename (feedmail-create-queue-filename queue-directory)))
- ;; make binary file on DOS/Win95/WinNT, etc
+ ;; make binary file on DOS/Windows 95/Windows NT, etc
(let ((buffer-file-type feedmail-force-binary-write))
(write-file filename))
;; convenient for moving from draft to q, for example
@@ -2397,8 +2387,10 @@ mapped to mostly alphanumerics for safety."
(defun feedmail-send-it-immediately ()
"Handle immediate sending, including during a queue run."
(feedmail-say-debug ">in-> feedmail-send-it-immediately")
- (let ((feedmail-error-buffer (get-buffer-create " *FQM Outgoing Email Errors*"))
- (feedmail-prepped-text-buffer (get-buffer-create " *FQM Outgoing Email Text*"))
+ (let ((feedmail-error-buffer
+ (get-buffer-create " *FQM Outgoing Email Errors*"))
+ (feedmail-prepped-text-buffer
+ (get-buffer-create " *FQM Outgoing Email Text*"))
(feedmail-raw-text-buffer (current-buffer))
(feedmail-address-list)
(eoh-marker)
@@ -2410,7 +2402,7 @@ mapped to mostly alphanumerics for safety."
(a-re-dtcb "^\\(To\\|Cc\\|Bcc\\):")
(a-re-dtc "^\\(To\\|Cc\\):")
(a-re-db "^Bcc:")
- ;; to get a temporary changeable copy
+ ;; To get a temporary changeable copy.
(mail-header-separator mail-header-separator)
)
(unwind-protect
@@ -2418,10 +2410,10 @@ mapped to mostly alphanumerics for safety."
(set-buffer feedmail-error-buffer) (erase-buffer)
(set-buffer feedmail-prepped-text-buffer) (erase-buffer)
- ;; jam contents of user-supplied mail buffer into our scratch buffer
+ ;; Jam contents of user-supplied mail buffer into our scratch buffer.
(insert-buffer-substring feedmail-raw-text-buffer)
- ;; require one newline at the end.
+ ;; Require one newline at the end.
(goto-char (point-max))
(or (= (preceding-char) ?\n) (insert ?\n))
@@ -2442,54 +2434,69 @@ mapped to mostly alphanumerics for safety."
(and (fboundp 'expand-mail-aliases) mail-aliases))
(expand-mail-aliases (point-min) eoh-marker))
- ;; make it pretty
+ ;; Make it pretty.
(if feedmail-fill-to-cc (feedmail-fill-to-cc-function eoh-marker))
- ;; ignore any blank lines in the header
+ ;; Ignore any blank lines in the header.
(goto-char (point-min))
- (while (and (re-search-forward "\n\n\n*" eoh-marker t) (< (point) eoh-marker))
+ (while (and (re-search-forward "\n\n\n*" eoh-marker t)
+ (< (point) eoh-marker))
(replace-match "\n"))
(let ((case-fold-search t) (addr-regexp))
(goto-char (point-min))
- ;; there are some RFC-822 combinations/cases missed here,
- ;; but probably good enough and what users expect
+ ;; There are some RFC-822 combinations/cases missed here,
+ ;; but probably good enough and what users expect.
;;
- ;; use resent-* stuff only if there is at least one non-empty one
+ ;; Use resent-* stuff only if there is at least one non-empty one.
(setq feedmail-is-a-resend
(re-search-forward
- ;; header name, followed by optional whitespace, followed by
- ;; non-whitespace, followed by anything, followed by newline;
- ;; the idea is empty Resent-* headers are ignored
+ ;; Header name, followed by optional whitespace, followed by
+ ;; non-whitespace, followed by anything, followed by
+ ;; newline; the idea is empty Resent-* headers are ignored.
"^\\(Resent-To:\\|Resent-Cc:\\|Resent-Bcc:\\)\\s-*\\S-+.*$"
eoh-marker t))
- ;; if we say so, gather the Bcc stuff before the main course
- (if (eq feedmail-deduce-bcc-where 'first)
- (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
- (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
- ;; the main course
- (if (or (eq feedmail-deduce-bcc-where 'first) (eq feedmail-deduce-bcc-where 'last))
- ;; handled by first or last cases, so don't get Bcc stuff
- (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtc) (setq addr-regexp a-re-dtc))
- (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list)))
- ;; not handled by first or last cases, so also get Bcc stuff
- (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtcb) (setq addr-regexp a-re-dtcb))
- (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
- ;; if we say so, gather the Bcc stuff after the main course
- (if (eq feedmail-deduce-bcc-where 'last)
- (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
- (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
- (if (not feedmail-address-list) (error "FQM: Sending...abandoned, no addressees"))
- ;; not needed, but meets user expectations
+ ;; If we say so, gather the Bcc stuff before the main course.
+ (when (eq feedmail-deduce-bcc-where 'first)
+ (setq addr-regexp (if feedmail-is-a-resend a-re-rb a-re-db))
+ (setq feedmail-address-list
+ (feedmail-deduce-address-list
+ feedmail-prepped-text-buffer (point-min) eoh-marker
+ addr-regexp feedmail-address-list)))
+ ;; The main course.
+ (setq addr-regexp
+ (if (memq feedmail-deduce-bcc-where '(first last))
+ ;; Handled by first or last cases, so don't get
+ ;; Bcc stuff.
+ (if feedmail-is-a-resend a-re-rtc a-re-dtc)
+ ;; Not handled by first or last cases, so also get
+ ;; Bcc stuff.
+ (if feedmail-is-a-resend a-re-rtcb a-re-dtcb)))
+ (setq feedmail-address-list
+ (feedmail-deduce-address-list
+ feedmail-prepped-text-buffer (point-min) eoh-marker
+ addr-regexp feedmail-address-list))
+ ;; If we say so, gather the Bcc stuff after the main course.
+ (when (eq feedmail-deduce-bcc-where 'last)
+ (setq addr-regexp (if feedmail-is-a-resend a-re-rb a-re-db))
+ (setq feedmail-address-list
+ (feedmail-deduce-address-list
+ feedmail-prepped-text-buffer (point-min) eoh-marker
+ addr-regexp feedmail-address-list)))
+ (if (not feedmail-address-list)
+ (error "FQM: Sending...abandoned, no addressees"))
+ ;; Not needed, but meets user expectations.
(setq feedmail-address-list (nreverse feedmail-address-list))
;; Find and handle any Bcc fields.
- (setq bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Bcc:"))
- (setq resent-bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:"))
- (if (and bcc-holder (not feedmail-nuke-bcc))
- (progn (goto-char (point-min))
- (insert bcc-holder)))
- (if (and resent-bcc-holder (not feedmail-nuke-resent-bcc))
- (progn (goto-char (point-min))
- (insert resent-bcc-holder)))
+ (setq bcc-holder
+ (feedmail-accume-n-nuke-header eoh-marker "^Bcc:"))
+ (setq resent-bcc-holder
+ (feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:"))
+ (when (and bcc-holder (not feedmail-nuke-bcc))
+ (goto-char (point-min))
+ (insert bcc-holder))
+ (when (and resent-bcc-holder (not feedmail-nuke-resent-bcc))
+ (goto-char (point-min))
+ (insert resent-bcc-holder))
(goto-char (point-min))
;; fiddle about, fiddle about, fiddle about....
@@ -2497,16 +2504,20 @@ mapped to mostly alphanumerics for safety."
(feedmail-fiddle-sender)
(feedmail-fiddle-x-mailer)
(feedmail-fiddle-message-id
- (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
+ (or feedmail-queue-runner-is-active
+ (buffer-file-name feedmail-raw-text-buffer)))
(feedmail-fiddle-date
- (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
- (feedmail-fiddle-list-of-fiddle-plexes feedmail-fiddle-plex-user-list)
+ (or feedmail-queue-runner-is-active
+ (buffer-file-name feedmail-raw-text-buffer)))
+ (feedmail-fiddle-list-of-fiddle-plexes
+ feedmail-fiddle-plex-user-list)
;; don't send out a blank headers of various sorts
;; (this loses on continued line with a blank first line)
(goto-char (point-min))
(and feedmail-nuke-empty-headers ; hey, who's an empty-header?
- (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" eoh-marker t)
+ (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n"
+ eoh-marker t)
(replace-match ""))))
(feedmail-say-debug "last chance hook: %s" feedmail-last-chance-hook)
@@ -2518,79 +2529,90 @@ mapped to mostly alphanumerics for safety."
(confirm (cond
((eq feedmail-confirm-outgoing 'immediate)
(not feedmail-queue-runner-is-active))
- ((eq feedmail-confirm-outgoing 'queued) feedmail-queue-runner-is-active)
+ ((eq feedmail-confirm-outgoing 'queued)
+ feedmail-queue-runner-is-active)
(t feedmail-confirm-outgoing)))
(fullframe (cond
((eq feedmail-display-full-frame 'immediate)
(not feedmail-queue-runner-is-active))
- ((eq feedmail-display-full-frame 'queued) feedmail-queue-runner-is-active)
+ ((eq feedmail-display-full-frame 'queued)
+ feedmail-queue-runner-is-active)
(t feedmail-display-full-frame))))
(if fullframe
(progn
(switch-to-buffer feedmail-prepped-text-buffer t)
(delete-other-windows)))
- (if (or (not confirm) (feedmail-one-last-look feedmail-prepped-text-buffer))
- (let ((user-mail-address (feedmail-envelope-deducer eoh-marker)))
+ (if (or (not confirm)
+ (feedmail-one-last-look feedmail-prepped-text-buffer))
+ (let ((user-mail-address
+ (feedmail-envelope-deducer eoh-marker)))
(feedmail-say-debug "give it to buffer-eater")
(feedmail-give-it-to-buffer-eater)
(feedmail-say-debug "gave it to buffer-eater")
- (if (and (not feedmail-queue-runner-is-active) (setq also-file (buffer-file-name feedmail-raw-text-buffer)))
- (progn ; if a file but not running the queue, offer to delete it
+ (if (and (not feedmail-queue-runner-is-active)
+ (setq also-file
+ (buffer-file-name feedmail-raw-text-buffer)))
+ (progn
+ ;; If a file but not running the queue,
+ ;; offer to delete it
(setq also-file (expand-file-name also-file))
(when (or feedmail-queue-auto-file-nuke
(y-or-n-p
(format "FQM: Delete message file %s? "
also-file)))
- ;; if we delete the affiliated file, get rid
+ ;; If we delete the affiliated file, get rid
;; of the file name association and make sure we
- ;; don't annoy people with a prompt on exit
+ ;; don't annoy people with a prompt on exit.
(delete-file also-file)
(with-current-buffer feedmail-raw-text-buffer
(setq buffer-offer-save nil)
(setq buffer-file-name nil)))))
(goto-char (point-min))
- ;; re-insert and handle any Fcc fields (and, optionally, any Bcc).
- (if fcc (letf (((default-value 'buffer-file-type)
- feedmail-force-binary-write))
- (insert fcc)
- (if (not feedmail-nuke-bcc-in-fcc)
- (progn (if bcc-holder (insert bcc-holder))
- (if resent-bcc-holder (insert resent-bcc-holder))))
-
- (run-hooks 'feedmail-before-fcc-hook)
-
- (if feedmail-nuke-body-in-fcc
- (progn (goto-char eoh-marker)
- (if (natnump feedmail-nuke-body-in-fcc)
- (forward-line feedmail-nuke-body-in-fcc))
- (delete-region (point) (point-max))
- ))
- (mail-do-fcc eoh-marker)
- )))
- ;; user bailed out of one-last-look
+ ;; Re-insert and handle any Fcc fields (and, optionally,
+ ;; any Bcc).
+ (when fcc
+ (let ((old (default-value 'buffer-file-type)))
+ (unwind-protect
+ (progn
+ (setq-default buffer-file-type
+ feedmail-force-binary-write)
+ (insert fcc)
+ (unless feedmail-nuke-bcc-in-fcc
+ (if bcc-holder (insert bcc-holder))
+ (if resent-bcc-holder
+ (insert resent-bcc-holder)))
+
+ (run-hooks 'feedmail-before-fcc-hook)
+
+ (when feedmail-nuke-body-in-fcc
+ (goto-char eoh-marker)
+ (if (natnump feedmail-nuke-body-in-fcc)
+ (forward-line feedmail-nuke-body-in-fcc))
+ (delete-region (point) (point-max)))
+ (mail-do-fcc eoh-marker))
+ (setq-default buffer-file-type old)))))
+ ;; User bailed out of one-last-look.
(if feedmail-queue-runner-is-active
(throw 'skip-me-q 'skip-me-q)
(throw 'skip-me-i 'skip-me-i))
)))) ; unwind-protect body (save-excursion)
- ;; unwind-protect cleanup forms
+ ;; unwind-protect cleanup forms.
(kill-buffer feedmail-prepped-text-buffer)
(set-buffer feedmail-error-buffer)
(if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer)
- (progn (display-buffer feedmail-error-buffer)
- ;; read fast ... the meter is running
- (if feedmail-queue-runner-is-active
- (progn
- (ding t)
- (feedmail-say-chatter "Sending...failed")))
- (error "FQM: Sending...failed")))
+ (display-buffer feedmail-error-buffer)
+ ;; Read fast ... the meter is running.
+ (if feedmail-queue-runner-is-active
+ (progn
+ (ding t)
+ (feedmail-say-chatter "Sending...failed")))
+ (error "FQM: Sending...failed"))
(set-buffer feedmail-raw-text-buffer))
) ; let
- (if (and feedmail-queue-chatty (not feedmail-queue-runner-is-active))
- (progn
- (feedmail-queue-reminder 'after-immediate)
- (sit-for feedmail-queue-chatty-sit-for)))
- )
+ (when (and feedmail-queue-chatty (not feedmail-queue-runner-is-active))
+ (feedmail-queue-reminder 'after-immediate)
+ (sit-for feedmail-queue-chatty-sit-for)))
(defun feedmail-fiddle-header (name value &optional action folding)
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 342d6c16b6e..e342e0ae977 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -1,6 +1,6 @@
;;; footnote.el --- footnote support for message mode -*- coding: utf-8;-*-
-;; Copyright (C) 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Steven L Baur <steve@xemacs.org>
;; Keywords: mail, news
@@ -35,9 +35,8 @@
;;; Code:
-(eval-when-compile
- (require 'cl)
- (defvar filladapt-token-table))
+(eval-when-compile (require 'cl-lib))
+(defvar filladapt-token-table)
(defgroup footnote nil
"Support for footnotes in mail and news messages."
@@ -126,10 +125,12 @@ has no effect on buffers already displaying footnotes."
:type 'string
:group 'footnote)
-(defvar footnote-signature-separator (if (boundp 'message-signature-separator)
- message-signature-separator
- "^-- $")
- "*String used to recognize .signatures.")
+(defcustom footnote-signature-separator (if (boundp 'message-signature-separator)
+ message-signature-separator
+ "^-- $")
+ "Regexp used by Footnote mode to recognize signatures."
+ :type 'regexp
+ :group 'footnote)
;;; Private variables
@@ -642,12 +643,12 @@ If the variable `footnote-narrow-to-footnotes-when-editing' is set,
the buffer is narrowed to the footnote body. The restriction is removed
by using `Footnote-back-to-message'."
(interactive "*P")
- (let (num)
- (if footnote-text-marker-alist
- (if (< (point) (cadar (last footnote-pointer-marker-alist)))
- (setq num (Footnote-make-hole))
- (setq num (1+ (caar (last footnote-text-marker-alist)))))
- (setq num 1))
+ (let ((num
+ (if footnote-text-marker-alist
+ (if (< (point) (cl-cadar (last footnote-pointer-marker-alist)))
+ (Footnote-make-hole)
+ (1+ (caar (last footnote-text-marker-alist))))
+ 1)))
(message "Adding footnote %d" num)
(Footnote-insert-footnote num)
(insert-before-markers (make-string footnote-body-tag-spacing ? ))
diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el
index 8343cd086b1..fd8d2633818 100644
--- a/lisp/mail/hashcash.el
+++ b/lisp/mail/hashcash.el
@@ -1,6 +1,6 @@
;;; hashcash.el --- Add hashcash payments to email
-;; Copyright (C) 2003-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005, 2007-2012 Free Software Foundation, Inc.
;; Written by: Paul Foley <mycroft@actrix.gen.nz> (1997-2002)
;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
@@ -58,14 +58,14 @@
:group 'mail)
(defcustom hashcash-default-payment 20
- "*The default number of bits to pay to unknown users.
+ "The default number of bits to pay to unknown users.
If this is zero, no payment header will be generated.
See `hashcash-payment-alist'."
:type 'integer
:group 'hashcash)
(defcustom hashcash-payment-alist '()
- "*An association list mapping email addresses to payment amounts.
+ "An association list mapping email addresses to payment amounts.
Elements may consist of (ADDR AMOUNT) or (ADDR STRING AMOUNT), where
ADDR is the email address of the intended recipient and AMOUNT is
the value of hashcash payment to be made to that user. STRING, if
@@ -80,33 +80,33 @@ present, is the string to be hashed; if not present ADDR will be used."
:group 'hashcash)
(defcustom hashcash-default-accept-payment 20
- "*The default minimum number of bits to accept on incoming payments."
+ "The default minimum number of bits to accept on incoming payments."
:type 'integer
:group 'hashcash)
(defcustom hashcash-accept-resources `((,user-mail-address nil))
- "*An association list mapping hashcash resources to payment amounts.
+ "An association list mapping hashcash resources to payment amounts.
Resources named here are to be accepted in incoming payments. If the
corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment'
is used instead."
:group 'hashcash)
(defcustom hashcash-path (executable-find "hashcash")
- "*The path to the hashcash binary."
+ "The path to the hashcash binary."
:group 'hashcash)
(defcustom hashcash-extra-generate-parameters nil
- "*A list of parameter strings passed to `hashcash-path' when minting.
+ "A list of parameter strings passed to `hashcash-path' when minting.
For example, you may want to set this to '(\"-Z2\") to reduce header length."
:type '(repeat string)
:group 'hashcash)
(defcustom hashcash-double-spend-database "hashcash.db"
- "*The path to the double-spending database."
+ "The path to the double-spending database."
:group 'hashcash)
(defcustom hashcash-in-news nil
- "*Specifies whether or not hashcash payments should be made to newsgroups."
+ "Specifies whether or not hashcash payments should be made to newsgroups."
:type 'boolean
:group 'hashcash)
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 12826001d86..32f99ac1465 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -1,6 +1,6 @@
;;; mail-extr.el --- extract full name and address from RFC 822 mail header -*- coding: utf-8 -*-
-;; Copyright (C) 1991-1994, 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1994, 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Joe Wells <jbw@cs.bu.edu>
;; Maintainer: FSF
@@ -218,14 +218,14 @@
;;
(defcustom mail-extr-guess-middle-initial nil
- "*Whether to try to guess middle initial from mail address.
+ "Whether to try to guess middle initial from mail address.
If true, then when we see an address like \"John Smith <jqs@host.com>\"
we will assume that \"John Q. Smith\" is the fellow's name."
:type 'boolean
:group 'mail-extr)
(defcustom mail-extr-ignore-single-names nil
- "*Whether to ignore a name that is just a single word.
+ "Whether to ignore a name that is just a single word.
If true, then when we see an address like \"Idiot <dumb@stupid.com>\"
we will act as though we couldn't find a full name in the address."
:type 'boolean
@@ -244,19 +244,19 @@ we will act as though we couldn't find a full name in the address."
(defcustom mail-extr-full-name-prefixes
(purecopy
"\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]")
- "*Matches prefixes to the full name that identify a person's position.
+ "Matches prefixes to the full name that identify a person's position.
These are stripped from the full name because they do not contribute to
uniquely identifying the person."
:type 'regexp
:group 'mail-extr)
(defcustom mail-extr-@-binds-tighter-than-! nil
- "*Whether the local mail transport agent looks at ! before @."
+ "Whether the local mail transport agent looks at ! before @."
:type 'boolean
:group 'mail-extr)
(defcustom mail-extr-mangle-uucp nil
- "*Whether to throw away information in UUCP addresses
+ "Whether to throw away information in UUCP addresses
by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
:type 'boolean
:group 'mail-extr)
@@ -394,7 +394,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; Matches ham radio call signs.
;; Help from: Mat Maessen N2NJZ <maessm@rpi.edu>, Mark Feit
;; <mark@era.com>, Michael Covington <mcovingt@ai.uga.edu>.
-;; Examples: DX504 DX515 K5MRU K8DHK KA9WGN KA9WGN KD3FU KD6EUI KD6HBW
+;; Examples: DX504 DX515 K5MRU K8DHK KA9WGN KD3FU KD6EUI KD6HBW
;; KE9TV KF0NV N1API N3FU N3GZE N3IGS N4KCC N7IKQ N9HHU W4YHF W6ANK WA2SUH
;; WB7VZI N2NJZ NR3G KJ4KK AB4UM AL7NI KH6OH WN3KBT N4TMI W1A N0NZO
(defconst mail-extr-ham-call-sign-pattern
@@ -1454,7 +1454,7 @@ consing a string.)"
))
(defcustom mail-extr-disable-voodoo "\\cj"
- "*If it is a regexp, names matching it will never be modified.
+ "If it is a regexp, names matching it will never be modified.
If it is neither nil nor a string, modifying of names will never take
place. It affects how `mail-extract-address-components' works."
:type '(choice (regexp :size 0)
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index d824c282805..40d67b4e904 100644
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -1,6 +1,6 @@
;;; mail-hist.el --- headers and message body history for outgoing mail
-;; Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Created: March, 1994
@@ -28,7 +28,7 @@
;; time.
;;
;; To use this package, put it in a directory in your load-path, and
-;; put this in your .emacs file:
+;; put this in your init file:
;;
;; (load "mail-hist" nil t)
;;
@@ -78,14 +78,14 @@ Used for knowing which history list to look in when the user asks for
previous/next input.")
(defcustom mail-hist-history-size (or kill-ring-max 1729)
- "*The maximum number of elements in a mail field's history.
+ "The maximum number of elements in a mail field's history.
Oldest elements are dumped first."
:type 'integer
:group 'mail-hist)
;;;###autoload
(defcustom mail-hist-keep-history t
- "*Non-nil means keep a history for headers and text of outgoing mail."
+ "Non-nil means keep a history for headers and text of outgoing mail."
:type 'boolean
:group 'mail-hist)
@@ -182,7 +182,7 @@ HEADER is a string without the colon."
(cdr (assoc header mail-hist-header-ring-alist)))
(defcustom mail-hist-text-size-limit nil
- "*Don't store any header or body with more than this many characters.
+ "Don't store any header or body with more than this many characters.
If the value is nil, that means no limit on text size."
:type '(choice (const nil) integer)
:group 'mail-hist)
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index 2e6f06a6758..9059da817b6 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -1,6 +1,6 @@
;;; mail-utils.el --- utility functions used both by rmail and rnews
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail, news
@@ -63,12 +63,16 @@ from START (inclusive) to END (exclusive)."
;;;###autoload
(defun mail-quote-printable (string &optional wrapper)
- "Convert a string to the \"quoted printable\" Q encoding.
+ "Convert a string to the \"quoted printable\" Q encoding if necessary.
+If the string contains only ASCII characters and no troublesome ones,
+we return it unconverted.
+
If the optional argument WRAPPER is non-nil,
we add the wrapper characters =?ISO-8859-1?Q?....?=."
(let ((i 0) (result ""))
(save-match-data
- (while (string-match "[?=\"\200-\377]" string i)
+ (while (or (string-match "[?=\"]" string i)
+ (string-match "[^\000-\177]" string i))
(setq result
(concat result (substring string i (match-beginning 0))
(upcase (format "=%02x"
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index 2472b8a1870..2e4ffec1383 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -1,6 +1,6 @@
;;; mailabbrev.el --- abbrev-expansion of mail aliases
-;; Copyright (C) 1985-1987, 1992-1993, 1996-1997, 2000-2011
+;; Copyright (C) 1985-1987, 1992-1993, 1996-1997, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com; now jwz@jwz.org>
@@ -254,10 +254,12 @@ By default this is the file specified by `mail-personal-alias-file'."
mail-abbrevs)
(message "Parsing %s... done" file))
-(defvar mail-alias-separator-string ", "
- "*A string inserted between addresses in multi-address mail aliases.
+(defcustom mail-alias-separator-string ", "
+ "String inserted between addresses in multi-address mail aliases.
This has to contain a comma, so \", \" is a reasonable value. You might
-also want something like \",\\n \" to get each address on its own line.")
+also want something like \",\\n \" to get each address on its own line."
+ :type 'string
+ :group 'mail-abbrev)
;; define-mail-abbrev sets this flag, which causes mail-resolve-all-aliases
;; to be called before expanding abbrevs if it's necessary.
@@ -389,46 +391,37 @@ double-quotes."
(defun mail-abbrev-expand-hook ()
"For use as the fourth arg to `define-abbrev'.
After expanding a mail-abbrev, if Auto Fill mode is on and we're past the
-fill-column, break the line at the previous comma, and indent the next line."
- ;; Disable abbrev mode to avoid recursion in indent-relative expanding
- ;; part of the abbrev expansion as an abbrev itself.
- (let ((abbrev-mode nil))
- (save-excursion
- (let ((p (point))
- bol comma fp)
- (beginning-of-line)
- (setq bol (point))
- (goto-char p)
- (while (and auto-fill-function
- (>= (current-column) fill-column)
- (search-backward "," bol t))
- (setq comma (point))
- (forward-char 1) ; Now we are just past the comma.
- (insert "\n")
- (delete-horizontal-space)
- (setq p (point))
- (indent-relative)
- (setq fp (buffer-substring p (point)))
- ;; Go to the end of the new line.
- (end-of-line)
- (if (> (current-column) fill-column)
- ;; It's still too long; do normal auto-fill.
- (let ((fill-prefix (or fp "\t")))
- (do-auto-fill)))
- ;; Resume the search.
- (goto-char comma)
- )))))
+fill-column, break the line at the previous comma, and indent the next line
+with a space."
+ (when auto-fill-function
+ (let (p)
+ (save-excursion
+ (while (>= (current-column) fill-column)
+ (while (and (search-backward "," (point-at-bol) 'move)
+ (>= (current-column) (1- fill-column))
+ (setq p (point))))
+ (when (or (not (bolp))
+ (and p (goto-char p)))
+ (setq p nil)
+ (forward-char 1)
+ (insert "\n")
+ (when (looking-at "[\t ]+")
+ (delete-region (point) (match-end 0)))
+ (insert " ")
+ (end-of-line)))))))
;;; Syntax tables and abbrev-expansion
-(defvar mail-abbrev-mode-regexp
+(defcustom mail-abbrev-mode-regexp
"^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):"
- "*Regexp to select mail-headers in which mail abbrevs should be expanded.
+ "Regexp matching mail headers in which mail abbrevs should be expanded.
This string will be handed to `looking-at' with point at the beginning
of the current line; if it matches, abbrev mode will be turned on, otherwise
it will be turned off. (You don't need to worry about continuation lines.)
This should be set to match those mail fields in which you want abbreviations
-turned on.")
+turned on."
+ :type 'regexp
+ :group 'mail-abbrev)
(defvar mail-abbrev-syntax-table nil
"The syntax-table used for abbrev-expansion purposes.
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
index fc8a07acd47..c7943fe40c8 100644
--- a/lisp/mail/mailalias.el
+++ b/lisp/mail/mailalias.el
@@ -1,6 +1,6 @@
;;; mailalias.el --- expand and complete mailing address aliases -*- lexical-binding: t -*-
-;; Copyright (C) 1985, 1987, 1995-1997, 2001-2011
+;; Copyright (C) 1985, 1987, 1995-1997, 2001-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -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/mailclient.el b/lisp/mail/mailclient.el
index b957d9f36c6..056bfebb1e5 100644
--- a/lisp/mail/mailclient.el
+++ b/lisp/mail/mailclient.el
@@ -1,6 +1,6 @@
;;; mailclient.el --- mail sending via system's mail client.
-;; Copyright (C) 2005-2011 Free Software Foundation
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;; Author: David Reitter <david.reitter@gmail.com>
;; Keywords: mail
diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el
index 1277d1d4109..6adcb25904b 100644
--- a/lisp/mail/mailheader.el
+++ b/lisp/mail/mailheader.el
@@ -1,6 +1,6 @@
;;; mailheader.el --- mail header parsing, merging, formatting
-;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Erik Naggum <erik@naggum.no>
;; Keywords: tools, mail, news
@@ -45,9 +45,6 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
-
(defun mail-header-extract ()
"Extract headers from current buffer after point.
Returns a header alist, where each element is a cons cell (name . value),
@@ -110,6 +107,8 @@ If the value is a string, it is the original value of the header. If the
value is a list, its first element is the original value of the header,
with any subsequent elements being the result of parsing the value.
If HEADER-ALIST is nil, the dynamically bound variable `headers' is used."
+ (declare (gv-setter (lambda (value)
+ `(mail-header-set ,header ,value ,header-alist))))
(cdr (assq header (or header-alist headers))))
(defun mail-header-set (header value &optional header-alist)
@@ -123,9 +122,6 @@ See `mail-header' for the semantics of VALUE."
(nconc alist (list (cons header value)))))
value)
-(defsetf mail-header (header &optional header-alist) (value)
- `(mail-header-set ,header ,value ,header-alist))
-
(defun mail-header-merge (merge-rules headers)
"Return a new header alist with MERGE-RULES applied to HEADERS.
MERGE-RULES is an alist whose keys are header names (symbols) and whose
diff --git a/lisp/mail/metamail.el b/lisp/mail/metamail.el
index fcc334ea30b..60dcd5210e1 100644
--- a/lisp/mail/metamail.el
+++ b/lisp/mail/metamail.el
@@ -1,6 +1,6 @@
;;; metamail.el --- Metamail interface for GNU Emacs
-;; Copyright (C) 1993, 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
;; Keywords: mail, news, mime, multimedia
@@ -42,23 +42,23 @@
:group 'processes)
(defcustom metamail-program-name "metamail"
- "*Metamail program name."
+ "Metamail program name."
:type 'string
:group 'metamail)
(defcustom metamail-mailer-name "emacs"
- "*Mailer name set to MM_MAILER environment variable."
+ "Mailer name set to MM_MAILER environment variable."
:type 'string
:group 'metamail)
(defvar metamail-environment '("KEYHEADS=*" "MM_QUIET=1")
- "*Environment variables passed to `metamail'.
+ "Environment variables passed to `metamail'.
It must be a list of strings that have the format ENVVARNAME=VALUE.
It is not expected to be altered globally by `set' or `setq'.
Instead, change its value temporary using `let' or `let*' form.")
(defcustom metamail-switches '("-x" "-d" "-z")
- "*Switches for `metamail' program.
+ "Switches for `metamail' program.
`-z' is required to remove zap file.
It is not expected to be altered globally by `set' or `setq'.
Instead, change its value temporary using `let' or `let*' form.
diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el
index 9af59672689..6f8c444651c 100644
--- a/lisp/mail/mspools.el
+++ b/lisp/mail/mspools.el
@@ -1,6 +1,6 @@
;;; mspools.el --- show mail spools waiting to be read
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Stephen Eglen <stephen@gnu.org>
;; Maintainer: Stephen Eglen <stephen@gnu.org>
@@ -83,7 +83,7 @@
;; Useful settings for VM
;; vm-auto-get-new-mail should be t (the default).
-;; Acknowledgements
+;; Acknowledgments
;; Thanks to jond@mitre.org (Jonathan Doughty) for help with code for
;; setting up vm-spool-files.
@@ -125,17 +125,17 @@
)
(defcustom mspools-update nil
- "*Non-nil means update *spools* buffer after visiting any folder."
+ "Non-nil means update *spools* buffer after visiting any folder."
:type 'boolean
:group 'mspools)
(defcustom mspools-suffix "spool"
- "*Extension used for spool files (not including full stop)."
+ "Extension used for spool files (not including full stop)."
:type 'string
:group 'mspools)
(defcustom mspools-using-vm (fboundp 'vm)
- "*Non-nil if VM is used as mail reader, otherwise RMAIL is used."
+ "Non-nil if VM is used as mail reader, otherwise RMAIL is used."
:type 'boolean
:group 'mspools)
@@ -143,7 +143,7 @@
(if (boundp 'vm-folder-directory)
vm-folder-directory
"~/MAIL/")
- "*Directory where mail folders are kept. Ensure it has a trailing /.
+ "Directory where mail folders are kept. Ensure it has a trailing /.
Defaults to `vm-folder-directory' if bound else to ~/MAIL/."
:type 'directory
:group 'mspools)
@@ -151,7 +151,7 @@ Defaults to `vm-folder-directory' if bound else to ~/MAIL/."
(defcustom mspools-vm-system-mail (or (getenv "MAIL")
(concat rmail-spool-directory
(user-login-name)))
- "*Spool file for main mailbox. Only used by VM.
+ "Spool file for main mailbox. Only used by VM.
This needs to be set to your primary mail spool - mspools will not run
without it. By default this will be set to the environment variable
$MAIL. Otherwise it will use `rmail-spool-directory' to guess where
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index 6c5448aca83..b4ee19b5186 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -1,6 +1,6 @@
;;; reporter.el --- customizable bug reporting of lisp programs
-;; Copyright (C) 1993-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: 1993-1998 Barry A. Warsaw
;; Maintainer: FSF
diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el
index d3f824fe50f..8b30e82804e 100644
--- a/lisp/mail/rfc2368.el
+++ b/lisp/mail/rfc2368.el
@@ -1,6 +1,6 @@
;;; rfc2368.el --- support for rfc2368
-;; Copyright (C) 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Sen Nagata <sen@eccosys.com>
;; Keywords: mail
@@ -33,7 +33,7 @@
;;
;; this is intended as a replacement for mailto.el
;;
-;; acknowledgements:
+;; acknowledgments:
;;
;; the functions that deal w/ unhexifying in this file were basically
;; taken from w3 -- i hope to replace them w/ something else soon OR
diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el
index 9e4e60e6806..4a1779d44f7 100644
--- a/lisp/mail/rfc822.el
+++ b/lisp/mail/rfc822.el
@@ -1,6 +1,6 @@
;;; rfc822.el --- hairy rfc822 parser for mail and news and suchlike
-;; Copyright (C) 1986-1987, 1990, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1986-1987, 1990, 2001-2012 Free Software Foundation, Inc.
;; Author: Richard Mlynarik <mly@eddie.mit.edu>
;; Maintainer: FSF
diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el
index 14a76746797..d7e31bfade7 100644
--- a/lisp/mail/rmail-spam-filter.el
+++ b/lisp/mail/rmail-spam-filter.el
@@ -1,6 +1,6 @@
;;; rmail-spam-filter.el --- spam filter for Rmail, the Emacs mail reader
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Keywords: email, spam, filter, rmail
;; Author: Eli Tziperman <eli AT deas.harvard.edu>
;; Package: rmail
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 1ea01bdadb8..a2cb7cb9ee8 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -1,6 +1,6 @@
;;; rmail.el --- main code of "RMAIL" mail reader for Emacs
-;; Copyright (C) 1985-1988, 1993-1998, 2000-2011
+;; Copyright (C) 1985-1988, 1993-1998, 2000-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -40,6 +40,9 @@
(require 'mail-utils)
(require 'rfc2047)
+(declare-function compilation--message->loc "compile" (cl-x) t)
+(declare-function epa--find-coding-system-for-mime-charset "epa" (mime-charset))
+
(defconst rmail-attribute-header "X-RMAIL-ATTRIBUTES"
"The header that stores the Rmail attribute data.")
@@ -97,8 +100,6 @@ its character representation and its display representation.")
"The current header display style choice, one of
'normal (selected headers) or 'full (all headers).")
-;; rmail-spool-directory and rmail-file-name are defined in paths.el.
-
(defgroup rmail nil
"Mail reader for Emacs."
:group 'mail)
@@ -140,6 +141,40 @@ its character representation and its display representation.")
:prefix "rmail-edit-"
:group 'rmail)
+;;;###autoload
+(defcustom rmail-file-name (purecopy "~/RMAIL")
+ "Name of user's primary mail file."
+ :type 'string
+ :group 'rmail
+ :version "21.1")
+
+;;;###autoload
+(put 'rmail-spool-directory 'standard-value
+ '((cond ((file-exists-p "/var/mail") "/var/mail/")
+ ((file-exists-p "/var/spool/mail") "/var/spool/mail/")
+ ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/")
+ (t "/usr/spool/mail/"))))
+
+;;;###autoload
+(defcustom rmail-spool-directory
+ (purecopy
+ (cond ((file-exists-p "/var/mail")
+ ;; SVR4 and recent BSD are said to use this.
+ ;; Rather than trying to know precisely which systems use it,
+ ;; let's assume this dir is never used for anything else.
+ "/var/mail/")
+ ;; Many GNU/Linux systems use this name.
+ ((file-exists-p "/var/spool/mail") "/var/spool/mail/")
+ ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/")
+ (t "/usr/spool/mail/")))
+ "Name of directory used by system mailer for delivering new mail.
+Its name should end with a slash."
+ :initialize 'custom-initialize-delay
+ :type 'directory
+ :group 'rmail)
+
+;;;###autoload(custom-initialize-delay 'rmail-spool-directory nil)
+
(defcustom rmail-movemail-program nil
"If non-nil, the file name of the `movemail' program."
:group 'rmail-retrieve
@@ -285,8 +320,10 @@ Setting this variable has an effect only before reading a mail."
:version "21.1")
;;;###autoload
-(defvaralias 'rmail-dont-reply-to-names 'mail-dont-reply-to-names)
+(define-obsolete-variable-alias 'rmail-dont-reply-to-names
+ 'mail-dont-reply-to-names "24.1")
+;; Prior to 24.1, this used to contain "\\`info-".
;;;###autoload
(defvar rmail-default-dont-reply-to-names nil
"Regexp specifying part of the default value of `mail-dont-reply-to-names'.
@@ -626,6 +663,7 @@ Element N specifies the summary line for message N+1.")
(defvar rmail-last-regexp nil)
(put 'rmail-last-regexp 'permanent-local t)
+;; Note that rmail-output-read-file-name modifies this.
(defcustom rmail-default-file "~/xmail"
"Default file name for \\[rmail-output]."
:type 'file
@@ -708,19 +746,6 @@ to an appropriate value, and optionally also set
`rmail-insert-mime-forwarded-message-function', and
`rmail-insert-mime-resent-message-function'.")
-;; FIXME this is unused since 23.1.
-(defvar rmail-decode-mime-charset t
- "*Non-nil means a message is decoded by MIME's charset specification.
-If this variable is nil, or the message has not MIME specification,
-the message is decoded as normal way.
-
-If the variable `rmail-enable-mime' is non-nil, this variable is
-ignored, and all the decoding work is done by a feature specified by
-the variable `rmail-mime-feature'.")
-
-(make-obsolete-variable 'rmail-decode-mime-charset
- "it does nothing." "23.1")
-
(defvar rmail-mime-charset-pattern
(concat "^content-type:[ \t]*text/plain;"
"\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*"
@@ -791,7 +816,7 @@ that knows the exact ordering of the \\( \\) subexpressions.")
;; These are all matched case-insensitively.
(eval-when-compile
(let* ((cite-chars "[>|}]")
- (cite-prefix "a-z")
+ (cite-prefix "[:alpha:]")
(cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
(list '("^\\(From\\|Sender\\|Resent-From\\):"
. 'rmail-header-name)
@@ -1361,8 +1386,7 @@ sets the current buffer's `buffer-file-coding-system' to that of
(defun rmail-buffers-swapped-p ()
"Return non-nil if the message collection is in `rmail-view-buffer'."
;; This is analogous to tar-data-swapped-p in tar-mode.el.
- (and (buffer-live-p rmail-view-buffer)
- rmail-buffer-swapped))
+ rmail-buffer-swapped)
(defun rmail-change-major-mode-hook ()
;; Bring the actual Rmail messages back into the main buffer.
@@ -1404,7 +1428,8 @@ If so restore the actual mbox message collection."
(kill-buffer rmail-view-buffer))))
(defun rmail-view-buffer-kill-buffer-hook ()
- (error "Can't kill message view buffer by itself"))
+ (error "Can't kill Rmail view buffer `%s' by itself"
+ (buffer-name (current-buffer))))
;; Set up the permanent locals associated with an Rmail file.
(defun rmail-perm-variables ()
@@ -2773,7 +2798,15 @@ The current mail message becomes the message displayed."
(forward-line))
(goto-char (point-min)))
;; Copy the headers to the front of the message view buffer.
- (rmail-copy-headers beg end))
+ (rmail-copy-headers beg end)
+ ;; Decode any RFC2047 encoded message headers.
+ (if rmail-enable-mime
+ (with-current-buffer rmail-view-buffer
+ (rfc2047-decode-region
+ (point-min)
+ (progn
+ (search-forward "\n\n" nil 'move)
+ (point))))))
;; highlight the message, activate any URL like text and add
;; special highlighting for and quoted material.
(with-current-buffer rmail-view-buffer
@@ -3550,6 +3583,25 @@ does not pop any summary buffer."
;;;; *** Rmail Mailing Commands ***
+(defun rmail-yank-current-message (buffer)
+ "Yank into the current buffer the current message of Rmail buffer BUFFER.
+If BUFFER is swapped with its message viewer buffer, yank out of BUFFER.
+If BUFFER is not swapped, yank out of its message viewer buffer."
+ (with-current-buffer buffer
+ (unless (rmail-buffers-swapped-p)
+ (setq buffer rmail-view-buffer)))
+ (insert-buffer-substring buffer)
+ ;; If they yank the text of BUFFER, the encoding of BUFFER is a
+ ;; better default for the reply message than the default value of
+ ;; buffer-file-coding-system.
+ (and (coding-system-equal (default-value 'buffer-file-coding-system)
+ buffer-file-coding-system)
+ (setq buffer-file-coding-system
+ (coding-system-change-text-conversion
+ buffer-file-coding-system (coding-system-base
+ (with-current-buffer buffer
+ buffer-file-coding-system))))))
+
(defun rmail-start-mail (&optional noerase to subject in-reply-to cc
replybuffer sendactions same-window
other-headers)
@@ -3561,7 +3613,8 @@ does not pop any summary buffer."
(if replybuffer
;; The function used here must behave like insert-buffer wrt
;; point and mark (see doc of sc-cite-original).
- (setq yank-action (list 'insert-buffer replybuffer)))
+ (setq yank-action
+ `(rmail-yank-current-message ,replybuffer)))
(push (cons "cc" cc) other-headers)
(push (cons "in-reply-to" in-reply-to) other-headers)
(setq other-headers
@@ -3576,15 +3629,18 @@ does not pop any summary buffer."
(if (stringp subject) (setq subject (rfc2047-decode-string subject)))
(prog1
(compose-mail to subject other-headers noerase
- switch-function yank-action sendactions)
+ switch-function yank-action sendactions
+ (if replybuffer `(rmail-mail-return ,replybuffer)))
(if (eq switch-function 'switch-to-buffer-other-frame)
;; This is not a standard frame parameter; nothing except
;; sendmail.el looks at it.
- (modify-frame-parameters (selected-frame)
+ (modify-frame-parameters (selected-frame)
'((mail-dedicated-frame . t)))))))
(defun rmail-mail-return (&optional newbuf)
- "NEWBUF is a buffer to switch to."
+ "Try to return to Rmail from the mail window.
+If optional argument NEWBUF is specified, it is the Rmail buffer
+to switch to."
(cond
;; If there is only one visible frame with no special handling,
;; consider deleting the mail window to return to Rmail.
@@ -3594,23 +3650,30 @@ does not pop any summary buffer."
(cdr (assq 'mail-dedicated-frame
(frame-parameters))))))
(let (rmail-flag summary-buffer)
- (and (not (one-window-p))
- (with-current-buffer
- (window-buffer (next-window (selected-window) 'not))
- (setq rmail-flag (eq major-mode 'rmail-mode))
- (setq summary-buffer
- (and (boundp 'mail-bury-selects-summary)
- mail-bury-selects-summary
- (boundp 'rmail-summary-buffer)
- rmail-summary-buffer
- (buffer-name rmail-summary-buffer)
- (not (get-buffer-window rmail-summary-buffer))
- rmail-summary-buffer))))
- (if rmail-flag
- ;; If the Rmail buffer has a summary, show that.
- (if summary-buffer (switch-to-buffer summary-buffer)
- (delete-window))
- (switch-to-buffer newbuf))))
+ (unless (one-window-p)
+ (with-current-buffer
+ (window-buffer (next-window (selected-window) 'not))
+ (setq rmail-flag (eq major-mode 'rmail-mode))
+ (setq summary-buffer
+ (and (boundp 'mail-bury-selects-summary)
+ mail-bury-selects-summary
+ (boundp 'rmail-summary-buffer)
+ rmail-summary-buffer
+ (buffer-name rmail-summary-buffer)
+ (not (get-buffer-window rmail-summary-buffer))
+ rmail-summary-buffer))))
+ (cond ((null rmail-flag)
+ ;; If the Rmail buffer is not in the next window, switch
+ ;; directly to the Rmail buffer specified by NEWBUF.
+ (if (buffer-live-p newbuf)
+ (switch-to-buffer newbuf)))
+ ;; If the Rmail buffer is in the next window, switch to
+ ;; the summary buffer if `mail-bury-selects-summary' is
+ ;; non-nil. Otherwise just delete this window.
+ (summary-buffer
+ (switch-to-buffer summary-buffer))
+ (t
+ (delete-window)))))
;; If the frame was probably made for this buffer, the user
;; probably wants to delete it now.
((display-multi-frame-p)
@@ -3624,7 +3687,7 @@ does not pop any summary buffer."
While composing the message, use \\[mail-yank-original] to yank the
original message into it."
(interactive)
- (rmail-start-mail nil nil nil nil nil rmail-view-buffer))
+ (rmail-start-mail nil nil nil nil nil rmail-buffer))
;; FIXME should complain if there is nothing to continue.
(defun rmail-continue ()
@@ -3711,9 +3774,7 @@ use \\[mail-yank-original] to yank the original message into it."
(mail-strip-quoted-names
(if (null cc) to (concat to ", " cc))))))
(if (string= cc-list "") nil cc-list)))
- (if (rmail-buffers-swapped-p)
- rmail-buffer
- rmail-view-buffer)
+ rmail-buffer
(list (list 'rmail-mark-message
rmail-buffer
(with-current-buffer rmail-buffer
@@ -3815,7 +3876,7 @@ see the documentation of `rmail-resend'."
(or (mail-fetch-field "Subject") "")
"]")))
(if (rmail-start-mail
- nil nil subject nil nil nil
+ nil nil subject nil nil rmail-buffer
(list (list 'rmail-mark-message
forward-buffer
(with-current-buffer rmail-buffer
@@ -4007,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
@@ -4190,10 +4258,13 @@ This has an effect only if a summary buffer exists."
;;; Speedbar support for RMAIL files.
(eval-when-compile (require 'speedbar))
-(defvar rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$"
- "*This regex is used to match folder names to be displayed in speedbar.
-Enabling this will permit speedbar to display your folders for easy
-browsing, and moving of messages.")
+(defcustom rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$"
+ "Regexp matching Rmail folder names to be displayed in Speedbar.
+Enabling this permits Speedbar to display your folders for easy
+browsing, and moving of messages."
+ :type 'regexp
+ :group 'rmail
+ :group 'speedbar)
(defvar rmail-speedbar-last-user nil
"The last user to be displayed in the speedbar.")
@@ -4345,6 +4416,9 @@ encoded string (and the same mask) will decode the string."
(setq i (1+ i)))
(concat string-vector)))
+;; Should this have a key-binding, or be in a menu?
+;; There doesn't really seem to be an appropriate menu.
+;; Eg the edit command is not in a menu either.
(defun rmail-epa-decrypt ()
"Decrypt OpenPGP armors in current message."
(interactive)
@@ -4449,7 +4523,11 @@ encoded string (and the same mask) will decode the string."
;; Used in `write-region-annotate-functions' to write rmail files.
(defun rmail-write-region-annotate (start end)
- (when (and (null start) (rmail-buffers-swapped-p))
+ (when (and (null start) rmail-buffer-swapped)
+ (unless (buffer-live-p rmail-view-buffer)
+ (error "Buffer `%s' with real text of `%s' has disappeared"
+ (buffer-name rmail-view-buffer)
+ (buffer-name (current-buffer))))
(setq rmail-message-encoding buffer-file-coding-system)
(set-buffer rmail-view-buffer)
(widen)
@@ -4472,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"
-;;;;;; "7f9bff22ed0bbac561c97fd1e3ab503d")
+;;;;;; "78b8b7d5c679935c118d595d473d7c5e")
;;; Generated autoloads from rmailedit.el
(autoload 'rmail-edit-current-message "rmailedit" "\
@@ -4484,7 +4562,7 @@ Edit the contents of this message.
;;;### (autoloads (rmail-next-labeled-message rmail-previous-labeled-message
;;;;;; rmail-read-label rmail-kill-label rmail-add-label) "rmailkwd"
-;;;;;; "rmailkwd.el" "ec13237a2b0a9e9c1893e38d36b11134")
+;;;;;; "rmailkwd.el" "4ae5660d86d49e524f4a6bcbc6d9a984")
;;; Generated autoloads from rmailkwd.el
(autoload 'rmail-add-label "rmailkwd" "\
@@ -4527,7 +4605,7 @@ With prefix argument N moves forward N messages with these labels.
;;;***
-;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "91f72e39e6ea7c2be098fe3f05174b9e")
+;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "f1937f85a1258de8880a089fa5ae5621")
;;; Generated autoloads from rmailmm.el
(autoload 'rmail-mime "rmailmm" "\
@@ -4554,7 +4632,7 @@ The arguments ARG and STATE have no effect in this case.
;;;***
;;;### (autoloads (set-rmail-inbox-list) "rmailmsc" "rmailmsc.el"
-;;;;;; "ca19b2f8a3e8aa01aa75ca7413f8a5ef")
+;;;;;; "e2212ea15561d60365ffa1f7a5902939")
;;; Generated autoloads from rmailmsc.el
(autoload 'set-rmail-inbox-list "rmailmsc" "\
@@ -4570,7 +4648,7 @@ This applies only to the current session.
;;;### (autoloads (rmail-sort-by-labels rmail-sort-by-lines rmail-sort-by-correspondent
;;;;;; rmail-sort-by-recipient rmail-sort-by-author rmail-sort-by-subject
-;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "ad1c98fe868c0e5804cf945d6c980d0b")
+;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "38da5f17d4ed0dcd2b09c158642cef63")
;;; Generated autoloads from rmailsort.el
(autoload 'rmail-sort-by-date "rmailsort" "\
@@ -4629,7 +4707,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order.
;;;### (autoloads (rmail-summary-by-senders rmail-summary-by-topic
;;;;;; rmail-summary-by-regexp rmail-summary-by-recipients rmail-summary-by-labels
-;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "d5971848a5fb43dc0092008376298a80")
+;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "6cafe6b03e187b5836e3c359322b5cbf")
;;; Generated autoloads from rmailsum.el
(autoload 'rmail-summary "rmailsum" "\
@@ -4677,7 +4755,7 @@ SENDERS is a string of regexps separated by commas.
;;;***
;;;### (autoloads (unforward-rmail-message undigestify-rmail-message)
-;;;;;; "undigest" "undigest.el" "41e6a48ea63224385c447a944528feb6")
+;;;;;; "undigest" "undigest.el" "9f270a2571bbbbfabc27498a8d4089c7")
;;; Generated autoloads from undigest.el
(autoload 'undigestify-rmail-message "undigest" "\
@@ -4688,8 +4766,9 @@ Leaves original message, deleted, before the undigestified messages.
(autoload 'unforward-rmail-message "undigest" "\
Extract a forwarded message from the containing message.
-This puts the forwarded message into a separate rmail message
-following the containing message.
+This puts the forwarded message into a separate rmail message following
+the containing message. This command is only useful when messages are
+forwarded with `rmail-enable-mime-composing' set to nil.
\(fn)" t nil)
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index 7e70f66ef11..e4e066bd642 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -1,6 +1,6 @@
;;; rmailedit.el --- "RMAIL edit mode" Edit the current message
-;; Copyright (C) 1985, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail
@@ -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/rmailkwd.el b/lisp/mail/rmailkwd.el
index 472740aefd8..a3a56fa47a2 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -1,6 +1,6 @@
;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs
-;; Copyright (C) 1985, 1988, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1988, 1994, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 03023b07527..11bccd59765 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -1,6 +1,6 @@
;;; rmailmm.el --- MIME decoding and display stuff for RMAIL
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Alexander Pohoyda
;; Alex Schroeder
@@ -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))
@@ -1300,26 +1310,40 @@ The arguments ARG and STATE have no effect in this case."
(rmail-mime-mbox-buffer rmail-buffer)
(rmail-mime-view-buffer rmail-view-buffer)
(rmail-mime-coding-system nil))
+ ;; If ENTITY is not a vector, it is a string describing an error.
(if (vectorp entity)
(with-current-buffer rmail-mime-view-buffer
(erase-buffer)
- (rmail-mime-insert entity)
- (if (consp rmail-mime-coding-system)
- ;; Decoding is done by rfc2047-decode-region only for a
- ;; header. But, as the used coding system may have been
- ;; overridden by mm-charset-override-alist, we can't
- ;; trust (car rmail-mime-coding-system). So, here we
- ;; try the decoding again with mm-charset-override-alist
- ;; bound to nil.
- (let ((mm-charset-override-alist nil))
- (setq rmail-mime-coding-system
- (rmail-mime-find-header-encoding
- (rmail-mime-entity-header entity)))))
- (set-buffer-file-coding-system
- (if rmail-mime-coding-system
- (coding-system-base rmail-mime-coding-system)
- 'undecided)
- t t))
+ ;; This condition-case is for catching an error in the
+ ;; internal MIME decoding (e.g. incorrect BASE64 form) that
+ ;; may be signaled by rmail-mime-insert.
+ ;; FIXME: The current code doesn't set a proper error symbol
+ ;; in ERR. We must find a way to propagate a correct error
+ ;; symbol that is caused in the very deep code of text
+ ;; decoding (e.g. an error by base64-decode-region called by
+ ;; post-read-conversion function of utf-7).
+ (condition-case err
+ (progn
+ (rmail-mime-insert entity)
+ (if (consp rmail-mime-coding-system)
+ ;; Decoding is done by rfc2047-decode-region only for a
+ ;; header. But, as the used coding system may have been
+ ;; overridden by mm-charset-override-alist, we can't
+ ;; trust (car rmail-mime-coding-system). So, here we
+ ;; try the decoding again with mm-charset-override-alist
+ ;; bound to nil.
+ (let ((mm-charset-override-alist nil))
+ (setq rmail-mime-coding-system
+ (rmail-mime-find-header-encoding
+ (rmail-mime-entity-header entity)))))
+ (set-buffer-file-coding-system
+ (if rmail-mime-coding-system
+ (coding-system-base rmail-mime-coding-system)
+ 'undecided)
+ t t))
+ (error (setq entity (format "%s" err))))))
+ ;; Re-check ENTITY. It may be set to an error string.
+ (when (stringp entity)
;; Decoding failed. ENTITY is an error message. Insert the
;; original message body as is, and show warning.
(let ((region (with-current-buffer rmail-mime-mbox-buffer
diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el
index 4519ab1505f..bfe2b6bbd79 100644
--- a/lisp/mail/rmailmsc.el
+++ b/lisp/mail/rmailmsc.el
@@ -1,6 +1,6 @@
;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index ad76a493483..63cc26360b7 100644
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -1,6 +1,6 @@
;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
-;; Copyright (C) 1985, 1987, 1993-1994, 2001-2011
+;; Copyright (C) 1985, 1987, 1993-1994, 2001-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -34,7 +34,6 @@
:type 'boolean
:group 'rmail-output)
-;; FIXME risky?
(defcustom rmail-output-file-alist nil
"Alist matching regexps to suggested output Rmail files.
This is a list of elements of the form (REGEXP . NAME-EXP).
@@ -47,6 +46,7 @@ a file name as a string."
(string :tag "File Name")
sexp)))
:group 'rmail-output)
+;; This is risky because NAME-EXP gets evalled.
;;;###autoload(put 'rmail-output-file-alist 'risky-local-variable t)
(defcustom rmail-fields-not-to-output nil
@@ -58,35 +58,57 @@ The function `rmail-delete-unwanted-fields' uses this, ignoring case."
(defun rmail-output-read-file-name ()
"Read the file name to use for `rmail-output'.
-Set `rmail-default-file' to this name as well as returning it."
- (let ((default-file
- (let (answer tail)
- (setq tail rmail-output-file-alist)
- ;; Suggest a file based on a pattern match.
- (while (and tail (not answer))
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward (car (car tail)) nil t)
- (setq answer (eval (cdr (car tail)))))
- (setq tail (cdr tail))))
+Set `rmail-default-file' to this name as well as returning it.
+This uses `rmail-output-file-alist'."
+ (let* ((default-file
+ (or
+ (when rmail-output-file-alist
+ (or rmail-buffer (error "There is no Rmail buffer"))
+ (save-current-buffer
+ (set-buffer rmail-buffer)
+ (let ((beg (rmail-msgbeg rmail-current-message))
+ (end (rmail-msgend rmail-current-message)))
+ (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (narrow-to-region beg end)
+ (let ((tail rmail-output-file-alist)
+ answer err)
+ ;; Suggest a file based on a pattern match.
+ (while (and tail (not answer))
+ (goto-char (point-min))
+ (if (re-search-forward (caar tail) nil t)
+ (setq answer
+ (condition-case err
+ (eval (cdar tail))
+ (error
+ (display-warning
+ :error
+ (format "Error evaluating \
+`rmail-output-file-alist' element:\nregexp: %s\naction: %s\nerror: %S\n"
+ (caar tail) (cdar tail) err))
+ nil))))
+ (setq tail (cdr tail)))
+ answer))))))
;; If no suggestion, use same file as last time.
- (or answer rmail-default-file))))
- (let ((read-file
- (expand-file-name
- (read-file-name
- (concat "Output message to mail file (default "
- (file-name-nondirectory default-file)
- "): ")
- (file-name-directory default-file)
- (abbreviate-file-name default-file))
- (file-name-directory default-file))))
- (setq rmail-default-file
- (if (file-directory-p read-file)
- (expand-file-name (file-name-nondirectory default-file)
- read-file)
- (expand-file-name
- (or read-file (file-name-nondirectory default-file))
- (file-name-directory default-file)))))))
+ rmail-default-file))
+ (read-file
+ (expand-file-name
+ (read-file-name
+ (concat "Output message to mail file (default "
+ (file-name-nondirectory default-file)
+ "): ")
+ (file-name-directory default-file)
+ (abbreviate-file-name default-file))
+ (file-name-directory default-file))))
+ (setq rmail-default-file
+ (if (file-directory-p read-file)
+ (expand-file-name (file-name-nondirectory default-file)
+ read-file)
+ (expand-file-name
+ (or read-file (file-name-nondirectory default-file))
+ (file-name-directory default-file))))))
(defun rmail-delete-unwanted-fields (preserve)
"Delete all headers matching `rmail-fields-not-to-output'.
diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el
index d8b85ad688a..41e24c0c16a 100644
--- a/lisp/mail/rmailsort.el
+++ b/lisp/mail/rmailsort.el
@@ -1,6 +1,6 @@
;;; rmailsort.el --- Rmail: sort messages
-;; Copyright (C) 1990, 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
;; Maintainer: FSF
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 5c147be3104..612ccbdfd9e 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -1,6 +1,6 @@
;;; rmailsum.el --- make summary buffers for the mail reader
-;; Copyright (C) 1985, 1993-1996, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1993-1996, 2000-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail
@@ -785,7 +785,7 @@ the message being processed."
(setq pos (point))
(forward-line 1)
(setq str (buffer-substring pos (1- (point))))
- (while (looking-at "\\s ")
+ (while (looking-at "[ \t]")
(setq str (concat str " "
(buffer-substring (match-end 0)
(line-end-position))))
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 6044392d4e0..afa13fe4e04 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -1,6 +1,6 @@
-;;; sendmail.el --- mail sending commands for Emacs. -*- byte-compile-dynamic: t -*-
+;;; sendmail.el --- mail sending commands for Emacs
-;; Copyright (C) 1985-1986, 1992-1996, 1998, 2000-2011
+;; Copyright (C) 1985-1986, 1992-1996, 1998, 2000-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -243,15 +243,14 @@ Used by `mail-yank-original' via `mail-indent-citation'."
:type 'integer
:group 'sendmail)
-;; FIXME make it really obsolete.
(defvar mail-yank-hooks nil
"Obsolete hook for modifying a citation just inserted in the mail buffer.
Each hook function can find the citation between (point) and (mark t).
And each hook function should leave point and mark around the citation
text as modified.
-
This is a normal hook, misnamed for historical reasons.
-It is semi-obsolete and mail agents should no longer use it.")
+It is obsolete and mail agents should no longer use it.")
+(make-obsolete-variable 'mail-yank-hooks 'mail-citation-hook "19.34")
;;;###autoload
(defcustom mail-citation-hook nil
@@ -304,7 +303,7 @@ The default value matches citations like `foo-bar>' plus whitespace."
(define-key map "\C-c\C-w" 'mail-signature)
(define-key map "\C-c\C-c" 'mail-send-and-exit)
(define-key map "\C-c\C-s" 'mail-send)
- (define-key map "\C-c\C-i" 'mail-attach-file)
+ (define-key map "\C-c\C-i" 'mail-insert-file)
;; FIXME add this? "b" = bury buffer. It's in the menu-bar.
;;; (define-key map "\C-c\C-b" 'mail-dont-send)
@@ -513,48 +512,51 @@ This also saves the value of `send-mail-function' via Customize."
;; a second time, probably because someone's using an old value
;; of send-mail-function.
(when (eq send-mail-function 'sendmail-query-once)
- (let* ((options `(("mail client" . mailclient-send-it)
- ,@(when (and sendmail-program
- (executable-find sendmail-program))
- '(("transport" . sendmail-send-it)))
- ("smtp" . smtpmail-send-it)))
- (choice
- ;; Query the user.
- (with-temp-buffer
- (rename-buffer "*Emacs Mail Setup Help*" t)
- (insert "\
+ (sendmail-query-user-about-smtp))
+ (funcall send-mail-function))
+
+(defun sendmail-query-user-about-smtp ()
+ (let* ((options `(("mail client" . mailclient-send-it)
+ ,@(when (and sendmail-program
+ (executable-find sendmail-program))
+ '(("transport" . sendmail-send-it)))
+ ("smtp" . smtpmail-send-it)))
+ (choice
+ ;; Query the user.
+ (with-temp-buffer
+ (rename-buffer "*Emacs Mail Setup Help*" t)
+ (insert "\
Emacs is about to send an email message, but it has not been
configured for sending email. To tell Emacs how to send email:
- Type `"
- (propertize "mail client" 'face 'bold)
- "' to start your default email client and
+ (propertize "mail client" 'face 'bold)
+ "' to start your default email client and
pass it the message text.\n\n")
- (and sendmail-program
- (executable-find sendmail-program)
- (insert "\
+ (and sendmail-program
+ (executable-find sendmail-program)
+ (insert "\
- Type `"
- (propertize "transport" 'face 'bold)
- "' to invoke the system's mail transport agent
+ (propertize "transport" 'face 'bold)
+ "' to invoke the system's mail transport agent
(the `"
- sendmail-program
- "' program).\n\n"))
- (insert "\
+ sendmail-program
+ "' program).\n\n"))
+ (insert "\
- Type `"
- (propertize "smtp" 'face 'bold)
- "' to send mail directly to an \"outgoing mail\" server.
+ (propertize "smtp" 'face 'bold)
+ "' to send mail directly to an \"outgoing mail\" server.
(Emacs may prompt you for SMTP settings).
Emacs will record your selection and will use it thereafter.
To change it later, customize the option `send-mail-function'.\n")
- (goto-char (point-min))
- (display-buffer (current-buffer))
- (let ((completion-ignore-case t))
- (completing-read "Send mail via: "
- options nil 'require-match)))))
- (customize-save-variable 'send-mail-function
- (cdr (assoc-string choice options t)))))
- (funcall send-mail-function))
+ (goto-char (point-min))
+ (display-buffer (current-buffer))
+ (let ((completion-ignore-case t))
+ (completing-read "Send mail via: "
+ options nil 'require-match)))))
+ (customize-save-variable 'send-mail-function
+ (cdr (assoc-string choice options t)))))
(defun sendmail-sync-aliases ()
(when mail-personal-alias-file
@@ -613,7 +615,7 @@ This also saves the value of `send-mail-function' via Customize."
;; (kill-local-variable 'enable-multibyte-characters)
(set-buffer-multibyte (default-value 'enable-multibyte-characters))
(if current-input-method
- (inactivate-input-method))
+ (deactivate-input-method))
;; Local variables for Mail mode.
(setq mail-send-actions actions)
@@ -730,6 +732,7 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and
(set (make-local-variable 'comment-start-skip)
(concat "^" (regexp-quote mail-yank-prefix) "[ \t]*")))
(make-local-variable 'adaptive-fill-regexp)
+ ;; Also update the paragraph-separate entry if you change this.
(setq adaptive-fill-regexp
(concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|"
adaptive-fill-regexp))
@@ -743,11 +746,14 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and
;; lines that delimit forwarded messages.
;; Lines containing just >= 3 dashes, perhaps after whitespace,
;; are also sometimes used and should be separators.
- (setq paragraph-separate (concat (regexp-quote mail-header-separator)
- "$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
- "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
- "--\\( \\|-+\\)$\\|"
- page-delimiter)))
+ (setq paragraph-separate
+ (concat (regexp-quote mail-header-separator)
+ ;; This is based on adaptive-fill-regexp (presumably
+ ;; the idea is to allow navigation etc of cited paragraphs).
+ "$\\|\t*[-–!|#%;>*·•‣⁃◦ ]+$"
+ "\\|[ \t]*[-[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
+ "--\\( \\|-+\\)$\\|"
+ page-delimiter)))
(defun mail-header-end ()
@@ -849,15 +855,17 @@ Prefix arg means don't delete this window."
(defun mail-bury (&optional arg)
"Bury this mail buffer."
(let ((newbuf (other-buffer (current-buffer)))
- (return-action mail-return-action)
- some-rmail)
+ (return-action mail-return-action))
(bury-buffer (current-buffer))
;; If there is an Rmail buffer, return to it nicely
;; even if this message was not started by an Rmail command.
(unless return-action
(dolist (buffer (buffer-list))
- (if (eq (buffer-local-value 'major-mode buffer) 'rmail-mode)
- (setq return-action `(rmail-mail-return ,newbuf)))))
+ (if (and (eq (buffer-local-value 'major-mode buffer) 'rmail-mode)
+ (null return-action)
+ ;; Don't match message-viewer buffer.
+ (not (string-match "\\` " (buffer-name buffer))))
+ (setq return-action `(rmail-mail-return ,buffer)))))
(if (and (null arg) return-action)
(apply (car return-action) (cdr return-action))
(switch-to-buffer newbuf))))
@@ -982,7 +990,7 @@ This function uses `mail-envelope-from'."
;;;###autoload
(defvar sendmail-coding-system nil
- "*Coding system for encoding the outgoing mail.
+ "Coding system for encoding the outgoing mail.
This has higher priority than the default `buffer-file-coding-system'
and `default-sendmail-coding-system',
but lower priority than the local value of `buffer-file-coding-system'.
@@ -1078,6 +1086,9 @@ Return non-nil if and only if some part of the header is encoded."
(cons selected mm-coding-system-priorities)
mm-coding-system-priorities))
(tick (buffer-chars-modified-tick))
+ ;; Many mailers, including Gnus, passes a message of which
+ ;; the header is already encoded, so this is necessary to
+ ;; prevent it from being encoded again.
(rfc2047-encode-encoded-words nil))
(rfc2047-encode-message-header)
(= tick (buffer-chars-modified-tick)))))
@@ -1402,6 +1413,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
@@ -1421,9 +1433,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."
@@ -1666,7 +1675,8 @@ Just \\[universal-argument] as argument means don't indent, insert no prefix,
and don't delete any header fields."
(interactive "P")
(and (consp mail-reply-action)
- (eq (car mail-reply-action) 'insert-buffer)
+ (memq (car mail-reply-action)
+ '(rmail-yank-current-message insert-buffer))
(with-current-buffer (nth 1 mail-reply-action)
(or (mark t)
(error "No mark set: %S" (current-buffer))))
@@ -1986,4 +1996,9 @@ you can move to one of them and type C-c C-c to recover that one."
(provide 'sendmail)
+;; Local Variables:
+;; byte-compile-dynamic: t
+;; coding: utf-8
+;; End:
+
;;; sendmail.el ends here
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index bc38b10124e..69a405436a7 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -1,6 +1,6 @@
;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
-;; Copyright (C) 1995-1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
;; Maintainer: Simon Josefsson <simon@josefsson.org>
@@ -60,7 +60,6 @@
(autoload 'message-make-date "message")
(autoload 'message-make-message-id "message")
(autoload 'rfc2104-hash "rfc2104")
-(autoload 'password-read "password-cache")
;;;
(defgroup smtpmail nil
@@ -87,7 +86,8 @@ The default value would be \"smtp\" or 25."
:group 'smtpmail)
(defcustom smtpmail-smtp-user nil
- "User name to use when looking up credentials."
+ "User name to use when looking up credentials in the authinfo file.
+If non-nil, only consider credentials for the specified user."
:version "24.1"
:type '(choice (const nil) string)
:group 'smtpmail)
@@ -100,15 +100,16 @@ don't define this value."
:group 'smtpmail)
(defcustom smtpmail-stream-type nil
- "Connection type SMTP connections.
-This may be either nil (possibly upgraded to STARTTLS if
-possible), or `starttls' (refuse to send if STARTTLS isn't
-available), or `plain' (never use STARTTLS).."
+ "Type of SMTP connections to use.
+This may be either nil (possibly upgraded to STARTTLS if possible),
+or `starttls' (refuse to send if STARTTLS isn't available), or `plain'
+\(never use STARTTLS), or `ssl' (to use TLS/SSL)."
:version "24.1"
:group 'smtpmail
:type '(choice (const :tag "Possibly upgrade to STARTTLS" nil)
(const :tag "Always use STARTTLS" starttls)
- (const :tag "Never use STARTTLS" plain)))
+ (const :tag "Never use STARTTLS" plain)
+ (const :tag "Use TLS/SSL" ssl)))
(defcustom smtpmail-sendto-domain nil
"Local domain name without a host name.
@@ -199,7 +200,10 @@ The list is in preference order.")
;; local binding in the mail buffer will take effect.
(smtpmail-mail-address
(or (and mail-specify-envelope-from (mail-envelope-from))
- user-mail-address))
+ (let ((from (mail-fetch-field "from")))
+ (and from
+ (cadr (mail-extract-address-components from))))
+ (smtpmail-user-mail-address)))
(smtpmail-code-conv-from
(if enable-multibyte-characters
(let ((sendmail-coding-system smtpmail-code-conv-from))
@@ -320,7 +324,10 @@ The list is in preference order.")
(if (re-search-forward "^FCC:" delimline t)
;; Force `mail-do-fcc' to use the encoding of the mail
;; buffer to encode outgoing messages on FCC files.
- (let ((coding-system-for-write smtpmail-code-conv-from))
+ (let ((coding-system-for-write
+ ;; mbox files must have Unix EOLs.
+ (coding-system-change-eol-conversion
+ smtpmail-code-conv-from 'unix)))
(mail-do-fcc delimline)))
(if mail-interactive
(with-current-buffer errbuf
@@ -468,9 +475,6 @@ The list is in preference order.")
(push el2 result)))
(nreverse result)))
-;; `password-read' autoloads password-cache.
-(declare-function password-cache-add "password-cache" (key password))
-
(defun smtpmail-command-or-throw (process string &optional code)
(let (ret)
(smtpmail-send-command process string)
@@ -595,24 +599,46 @@ The list is in preference order.")
(mapconcat 'identity (cdr response) "\n"))
(defun smtpmail-query-smtp-server ()
+ "Query for an SMTP server and try to contact it.
+If the contact succeeds, customizes and saves `smtpmail-smtp-server'
+and `smtpmail-smtp-service'. This tries standard SMTP ports, and if
+none works asks you to supply one. If you know that you need to use
+a non-standard port, you can set `smtpmail-smtp-service' in advance.
+Returns an error if the server cannot be contacted."
(let ((server (read-string "Outgoing SMTP mail server: "))
- (ports '("smtp" 587))
- stream port)
- (when (and smtpmail-smtp-server
- (not (member smtpmail-smtp-server ports)))
- (push smtpmail-smtp-server ports))
+ (ports '(25 587))
+ stream port prompted)
+ (when (and smtpmail-smtp-service
+ (not (member smtpmail-smtp-service ports)))
+ (push smtpmail-smtp-service ports))
(while (and (not smtpmail-smtp-server)
(setq port (pop ports)))
- (when (setq stream (condition-case ()
- (open-network-stream "smtp" nil server port)
- (quit nil)
- (error nil)))
+ (if (not (setq stream (condition-case ()
+ (open-network-stream "smtp" nil server port)
+ (quit nil)
+ (error nil))))
+ ;; We've used up the list of default ports, so query the user.
+ (when (and (not ports)
+ (not prompted))
+ (push (read-number (format "Port number to use when contacting %s? "
+ server))
+ ports)
+ (setq prompted t))
(customize-save-variable 'smtpmail-smtp-server server)
(customize-save-variable 'smtpmail-smtp-service port)
(delete-process stream)))
(unless smtpmail-smtp-server
(error "Couldn't contact an SMTP server"))))
+(defun smtpmail-user-mail-address ()
+ "Return `user-mail-address' if it's a valid email address."
+ (and user-mail-address
+ (let ((parts (split-string user-mail-address "@")))
+ (and (= (length parts) 2)
+ ;; There's a dot in the domain name.
+ (string-match "\\." (cadr parts))
+ user-mail-address))))
+
(defun smtpmail-via-smtp (recipient smtpmail-text-buffer
&optional ask-for-password)
(unless smtpmail-smtp-server
@@ -623,10 +649,14 @@ The list is in preference order.")
(port smtpmail-smtp-service)
;; `smtpmail-mail-address' should be set to the appropriate
;; buffer-local value by the caller, but in case not:
- (envelope-from (or smtpmail-mail-address
- (and mail-specify-envelope-from
- (mail-envelope-from))
- user-mail-address))
+ (envelope-from
+ (or smtpmail-mail-address
+ (and mail-specify-envelope-from
+ (mail-envelope-from))
+ (let ((from (mail-fetch-field "from")))
+ (and from
+ (cadr (mail-extract-address-components from))))
+ (smtpmail-user-mail-address)))
response-code
process-buffer
result
@@ -900,8 +930,7 @@ The list is in preference order.")
(insert (match-string 0 command) "<omitted>\r\n")
(insert command "\r\n"))
(setq smtpmail-read-point (point))
- (process-send-string process command)
- (process-send-string process "\r\n"))
+ (process-send-string process (concat command "\r\n")))
(defun smtpmail-send-data-1 (process data)
(goto-char (point-max))
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index 3d754c08f83..99e5df82bef 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -1,6 +1,6 @@
;;; supercite.el --- minor mode for citing mail and news replies
-;; Copyright (C) 1993, 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: 1993 Barry A. Warsaw <bwarsaw@python.org>
;; Maintainer: Glenn Morris <rgm@gnu.org>
@@ -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.")
@@ -1847,8 +1843,7 @@ Note on function names in this list: all functions of the form
;; ======================================================================
;; published interface to mail and news readers
-(define-minor-mode sc-minor-mode
- "Supercite minor mode."
+(define-minor-mode sc-minor-mode nil
:group 'supercite
:lighter (" SC" (sc-auto-fill-region-p
(":f" (sc-fixup-whitespace-p "w"))
@@ -1970,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/mail/uce.el b/lisp/mail/uce.el
index f1bd98af297..3d7495ffd1a 100644
--- a/lisp/mail/uce.el
+++ b/lisp/mail/uce.el
@@ -1,6 +1,6 @@
;;; uce.el --- facilitate reply to unsolicited commercial email
-;; Copyright (C) 1996, 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: stanislav shalunov <shalunov@mccme.ru>
;; Created: 10 Dec 1996
@@ -63,7 +63,7 @@
;; Usage:
;; Place uce.el in your load-path (and optionally byte-compile it).
-;; Add the following line to your ~/.emacs:
+;; Add the following line to your init file:
;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil)
;; If you want to use it with Gnus rather than Rmail:
;; (setq uce-mail-reader 'gnus)
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index 04bb320a2ab..916a977c546 100644
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -1,6 +1,6 @@
;;; undigest.el --- digest-cracking support for the RMAIL mail reader
-;; Copyright (C) 1985-1986, 1994, 1996, 2001-2011
+;; Copyright (C) 1985-1986, 1994, 1996, 2001-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -32,7 +32,7 @@
(defcustom rmail-forward-separator-regex
"^----.*\\([Ff]orwarded\\|[Oo]riginal\\).*[Mm]essage"
- "*Regexp to match the string that introduces forwarded messages.
+ "Regexp to match the string that introduces forwarded messages.
This is not a header, but a string contained in the body of the message.
You may need to customize it for local needs."
:type 'regexp
@@ -228,8 +228,9 @@ Leaves original message, deleted, before the undigestified messages."
;;;###autoload
(defun unforward-rmail-message ()
"Extract a forwarded message from the containing message.
-This puts the forwarded message into a separate rmail message
-following the containing message."
+This puts the forwarded message into a separate rmail message following
+the containing message. This command is only useful when messages are
+forwarded with `rmail-enable-mime-composing' set to nil."
(interactive)
(set-buffer rmail-buffer)
(let ((buff (current-buffer))
diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el
index 652693209e8..bf7b9abe2c1 100644
--- a/lisp/mail/unrmail.el
+++ b/lisp/mail/unrmail.el
@@ -1,6 +1,6 @@
;;; unrmail.el --- convert Rmail Babyl files to mailbox files
-;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail
@@ -61,15 +61,15 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
(error "This file is not in Babyl format"))
;; Decode the file contents just as Rmail did.
- (let ((modifiedp (buffer-modified-p))
- (coding-system rmail-file-coding-system)
+ (let ((coding-system rmail-file-coding-system)
from to)
(goto-char (point-min))
(search-forward "\n\^_" nil t) ; Skip BABYL header.
(setq from (point))
(goto-char (point-max))
(search-backward "\n\^_" from 'mv)
- (setq to (point))
+ (if (= from (setq to (point)))
+ (error "The input file contains no messages"))
(unless (and coding-system
(coding-system-p coding-system))
(setq coding-system
diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el
index 8652e67d3e1..f415c143473 100644
--- a/lisp/mail/uudecode.el
+++ b/lisp/mail/uudecode.el
@@ -1,6 +1,6 @@
;;; uudecode.el -- elisp native uudecode
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: uudecode news
@@ -38,20 +38,20 @@
:group 'news)
(defcustom uudecode-decoder-program "uudecode"
- "*Non-nil value should be a string that names a uu decoder.
+ "Non-nil value should be a string that names a uu decoder.
The program should expect to read uu data on its standard
input and write the converted data to its standard output."
:type 'string
:group 'uudecode)
(defcustom uudecode-decoder-switches nil
- "*List of command line flags passed to `uudecode-decoder-program'."
+ "List of command line flags passed to `uudecode-decoder-program'."
:group 'uudecode
:type '(repeat string))
(defcustom uudecode-use-external
(executable-find uudecode-decoder-program)
- "*Use external uudecode program."
+ "Use external uudecode program."
:version "22.1"
:group 'uudecode
:type 'boolean)
@@ -197,10 +197,10 @@ If FILE-NAME is non-nil, save the result to FILE-NAME."
(cond
(done)
((> 0 remain)
- (error "uucode line ends unexpectly")
+ (error "uucode line ends unexpectedly")
(setq done t))
((and (= (point) end) (not done))
- ;;(error "uucode ends unexpectly")
+ ;;(error "uucode ends unexpectedly")
(setq done t))
((= counter 3)
(setq result (cons
diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in
index c8e535d4ac0..756d2b949fa 100644
--- a/lisp/makefile.w32-in
+++ b/lisp/makefile.w32-in
@@ -1,5 +1,5 @@
-# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
-# Copyright (C) 2000-2011 Free Software Foundation, Inc.
+# -*- Makefile -*- for GNU Emacs on the Microsoft Windows API.
+# Copyright (C) 2000-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -70,25 +70,20 @@ AUTOGENEL = $(lisp)/loaddefs.el $(LOADDEFS) $(lisp)/cus-load.el \
# During bootstrapping the byte-compiler is run interpreted when compiling
# itself, and uses more stack than usual.
#
-BIG_STACK_DEPTH = 1200
+BIG_STACK_DEPTH = 2200
BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS)
# Files to compile before others during a bootstrap. This is done to
-# speed up the bootstrap process. The CC files are compiled first
-# because CC mode tweaks the compilation process, and requiring
-# cc-mode when it is not compiled doesn't work during the
-# bootstrapping.
+# speed up the bootstrap process.
COMPILE_FIRST = \
- $(lisp)/emacs-lisp/byte-opt.el \
- $(lisp)/emacs-lisp/bytecomp.el \
$(lisp)/emacs-lisp/macroexp.el \
$(lisp)/emacs-lisp/cconv.el \
- $(lisp)/subr.el \
- $(lisp)/progmodes/cc-mode.el \
- $(lisp)/progmodes/cc-vars.el
+ $(lisp)/emacs-lisp/byte-opt.el \
+ $(lisp)/emacs-lisp/bytecomp.el \
+ $(lisp)/emacs-lisp/autoload.el
# The actual Emacs command run in the targets below.
# The quotes around $(EMACS) are here because the user could type
@@ -173,12 +168,12 @@ $(lisp)/cus-load.el:
# WARNING: Do NOT split the part inside $(ARGQUOTE)s into multiple lines as
# this can break with GNU Make 3.81 and later if sh.exe is used.
-custom-deps: $(lisp)/cus-load.el $(lisp)/loaddefs.el doit
+custom-deps: $(lisp)/cus-load.el $(lisp)/loaddefs.el $(lisp)/subdirs.el doit
@echo Directories: $(WINS_UPDATES)
-$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hook nil)$(ARGQUOTE) \
-f custom-make-dependencies $(lisp) $(WINS_UPDATES)
-finder-data: $(lisp)/loaddefs.el doit
+finder-data: $(lisp)/loaddefs.el $(lisp)/subdirs.el doit
@echo Directories: $(WINS_UPDATES)
$(emacs) -l finder -f finder-compile-keywords-make-dist $(lisp) $(WINS_UPDATES)
@@ -243,12 +238,12 @@ update-subdirs-CMD: doit
echo ;; End:>> $(lisp)/subdirs.el
update-subdirs-SH: doit
- $(srcdir)/update-subdirs $(lisp); \
+ $(srcdir)/build-aux/update-subdirs $(lisp); \
for file in $(WINS_SUBDIR); do \
- $(srcdir)/update-subdirs $$file; \
+ $(srcdir)/build-aux/update-subdirs $$file; \
done;
-updates: update-subdirs autoloads mh-autoloads finder-data custom-deps
+updates: $(lisp)/subdirs.el autoloads mh-autoloads finder-data custom-deps
# This is useful after "bzr up".
bzr-update: recompile autoloads finder-data custom-deps
@@ -316,16 +311,16 @@ TAGS-LISP-CMD: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsf
# compiled find the right files.
# Need separate version for sh and native cmd.exe
-compile: $(lisp)/subdirs.el mh-autoloads compile-$(SHELLTYPE) doit
+compile: $(lisp)/subdirs.el compile-$(SHELLTYPE) doit
-compile-CMD:
+compile-CMD: autoloads
# -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g
for %%f in ($(COMPILE_FIRST)) do \
$(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f
for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do \
$(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g
-compile-SH:
+compile-SH: autoloads
# for elc in $(lisp)/*.elc $(lisp)/*/*.elc; do attrib -r $$elc; done
for el in $(COMPILE_FIRST); do \
echo Compiling $$el; \
@@ -388,7 +383,7 @@ backup-compiled-files:
compile-after-backup: backup-compiled-files compile-always
compile-first: $(lisp)/emacs-lisp/bytecomp.elc $(lisp)/emacs-lisp/byte-opt.elc \
- $(lisp)/emacs-lisp/autoload.elc
+ $(lisp)/emacs-lisp/autoload.elc $(lisp)/subdirs.el
# Recompile all Lisp files which are newer than their .elc files.
# Note that this doesn't create .elc files. It only recompiles if an
@@ -398,7 +393,7 @@ compile-first: $(lisp)/emacs-lisp/bytecomp.elc $(lisp)/emacs-lisp/byte-opt.elc
recompile: compile-first autoloads doit $(lisp)/progmodes/cc-mode.elc
$(emacs) --eval $(ARGQUOTE)(batch-byte-recompile-directory 0)$(ARGQUOTE) $(lisp)
-$(lisp)/calendar/cal-loaddefs.el:
+$(lisp)/calendar/cal-loaddefs.el: $(lisp)/subdirs.el
"$(EMACS)" $(EMACSOPT) -l autoload \
--eval "(setq generate-autoload-cookie \";;;###cal-autoload\")" \
--eval "(setq find-file-suppress-same-file-warnings t)" \
@@ -406,7 +401,7 @@ $(lisp)/calendar/cal-loaddefs.el:
-f w32-batch-update-autoloads "$(lisp)/calendar/cal-loaddefs.el" \
$(MAKE) ./calendar
-$(lisp)/calendar/diary-loaddefs.el:
+$(lisp)/calendar/diary-loaddefs.el: $(lisp)/subdirs.el
"$(EMACS)" $(EMACSOPT) -l autoload \
--eval "(setq generate-autoload-cookie \";;;###diary-autoload\")" \
--eval "(setq find-file-suppress-same-file-warnings t)" \
@@ -414,7 +409,7 @@ $(lisp)/calendar/diary-loaddefs.el:
-f w32-batch-update-autoloads $(lisp)/calendar/diary-loaddefs.el \
$(MAKE) ./calendar
-$(lisp)/calendar/hol-loaddefs.el:
+$(lisp)/calendar/hol-loaddefs.el: $(lisp)/subdirs.el
"$(EMACS)" $(EMACSOPT) -l autoload \
--eval "(setq generate-autoload-cookie \";;;###holiday-autoload\")" \
--eval "(setq find-file-suppress-same-file-warnings t)" \
@@ -442,7 +437,7 @@ MH_E_SRC = $(lisp)/mh-e/mh-acros.el $(lisp)/mh-e/mh-alias.el \
# See the commentary for autoloads above for why we use ./mh-e below
# instead of $(lisp)/mh-e.
mh-autoloads: $(lisp)/mh-e/mh-loaddefs.el
-$(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC)
+$(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC) $(lisp)/subdirs.el
"$(EMACS)" $(EMACSOPT) \
-l autoload \
--eval $(ARGQUOTE)(setq generate-autoload-cookie $(DQUOTE);;;###mh-autoload$(DQUOTE))$(ARGQUOTE) \
@@ -461,7 +456,7 @@ TRAMP_SRC = $(lisp)/net/tramp.el $(lisp)/net/tramp-cache.el \
$(lisp)/net/tramp-smb.el $(lisp)/net/tramp-uu.el \
$(lisp)/net/trampver.el
-$(lisp)/net/tramp-loaddefs.el: $(TRAMP_SRC)
+$(lisp)/net/tramp-loaddefs.el: $(TRAMP_SRC) $(lisp)/subdirs.el
"$(EMACS)" $(EMACSOPT) \
-l autoload \
--eval $(ARGQUOTE)(setq generate-autoload-cookie $(DQUOTE);;;###tramp-autoload$(DQUOTE))$(ARGQUOTE) \
@@ -486,6 +481,7 @@ $(lisp)/net/tramp-loaddefs.el: $(TRAMP_SRC)
# Need separate version for sh and native cmd.exe
bootstrap-clean:
- $(DEL) $(lisp)/loaddefs.el
+ - $(DEL) $(lisp)/subdirs.el
$(MAKE) $(MFLAGS) bootstrap-clean-$(SHELLTYPE)
bootstrap-clean-CMD:
@@ -501,7 +497,7 @@ bootstrap-clean-SH:
# When done, remove bootstrap-emacs from ../bin, so that
# it will not be mistaken for an installed binary.
-bootstrap: update-subdirs autoloads mh-autoloads compile finder-data custom-deps
+bootstrap: $(lisp)/subdirs.el compile finder-data custom-deps
- $(DEL) "$(EMACS)"
#
@@ -510,9 +506,9 @@ bootstrap: update-subdirs autoloads mh-autoloads compile finder-data custom-deps
#
install:
- mkdir "$(INSTALL_DIR)/lisp"
- - $(DEL) ../same-dir.tst
- - $(DEL) "$(INSTALL_DIR)/same-dir.tst"
- echo SameDirTest > "$(INSTALL_DIR)/same-dir.tst"
+ - $(DEL) ../$(DIRNAME)_same-dir.tst
+ - $(DEL) "$(INSTALL_DIR)/$(DIRNAME)_same-dir.tst"
+ echo SameDirTest > "$(INSTALL_DIR)/$(DIRNAME)_same-dir.tst"
#ifdef COPY_LISP_SOURCE
$(IFNOTSAMEDIR) $(MAKE) $(MFLAGS) install-lisp-$(SHELLTYPE) $(ENDIF)
#else
@@ -528,8 +524,8 @@ install:
# $(IFNOTSAMEDIR) $(CP) international/latin-*.el "$(INSTALL_DIR)/lisp/international" $(ENDIF)
# $(IFNOTSAMEDIR) $(CP) international/mule-conf.el "$(INSTALL_DIR)/lisp/international" $(ENDIF)
#endif
- - $(DEL) ../same-dir.tst
- - $(DEL) "$(INSTALL_DIR)/same-dir.tst"
+ - $(DEL) ../$(DIRNAME)_same-dir.tst
+ - $(DEL) "$(INSTALL_DIR)/$(DIRNAME)_same-dir.tst"
# Need to copy *.el files first, to avoid "source file is newer" annoyance
# since cp does not preserve time stamps
@@ -605,7 +601,8 @@ $(lisp)/progmodes/cc-langs.elc: $(lisp)/progmodes/cc-vars.elc \
$(lisp)/progmodes/cc-mode.elc: $(lisp)/progmodes/cc-langs.elc \
$(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc \
$(lisp)/progmodes/cc-styles.elc $(lisp)/progmodes/cc-cmds.elc \
- $(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-menus.elc
+ $(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-menus.elc \
+ $(lisp)/subdirs.el
$(lisp)/progmodes/cc-styles.elc: $(lisp)/progmodes/cc-vars.elc \
$(lisp)/progmodes/cc-align.elc
diff --git a/lisp/makesum.el b/lisp/makesum.el
index 21fc693cfd6..f19cb4f5a31 100644
--- a/lisp/makesum.el
+++ b/lisp/makesum.el
@@ -1,6 +1,6 @@
;;; makesum.el --- generate key binding summary for Emacs
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help
diff --git a/lisp/man.el b/lisp/man.el
index 3cdbdddb044..198cdbafab5 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -1,6 +1,6 @@
;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*-
-;; Copyright (C) 1993-1994, 1996-1997, 2001-2011
+;; Copyright (C) 1993-1994, 1996-1997, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Barry A. Warsaw <bwarsaw@cen.com>
@@ -88,13 +88,9 @@
;;; Code:
-(eval-when-compile (require 'cl))
-(require 'assoc)
+(require 'ansi-color)
(require 'button)
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; empty defvars (keep the compiler quiet)
-
(defgroup man nil
"Browse UNIX manual pages."
:prefix "Man-"
@@ -102,6 +98,7 @@
:group 'help)
(defvar Man-notify)
+
(defcustom Man-filter-list nil
"Manpage cleaning filter command phrases.
This variable contains a list of the following form:
@@ -123,28 +120,34 @@ the manpage buffer."
(defvar Man-sed-script nil
"Script for sed to nuke backspaces and ANSI codes from manpages.")
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; user variables
-
(defcustom Man-fontify-manpage-flag t
"Non-nil means make up the manpage with fonts."
:type 'boolean
:group 'man)
-(defcustom Man-overstrike-face 'bold
+(defface Man-overstrike
+ '((t (:inherit bold)))
"Face to use when fontifying overstrike."
- :type 'face
- :group 'man)
+ :group 'man
+ :version "24.3")
-(defcustom Man-underline-face 'underline
+(defface Man-underline
+ '((t (:inherit underline)))
"Face to use when fontifying underlining."
- :type 'face
- :group 'man)
+ :group 'man
+ :version "24.3")
-(defcustom Man-reverse-face 'highlight
+(defface Man-reverse
+ '((t (:inherit highlight)))
"Face to use when fontifying reverse video."
- :type 'face
- :group 'man)
+ :group 'man
+ :version "24.3")
+
+(defvar Man-ansi-color-map (let ((ansi-color-faces-vector
+ [ default Man-overstrike default Man-underline
+ Man-underline default default Man-reverse ]))
+ (ansi-color-make-color-map))
+ "The value used here for `ansi-color-map'.")
;; Use the value of the obsolete user option Man-notify, if set.
(defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
@@ -215,37 +218,63 @@ the associated section number."
(string :tag "Real Section")))
:group 'man)
+;; FIXME see comments at ffap-c-path.
(defcustom Man-header-file-path
- '("/usr/include" "/usr/local/include")
+ (let ((arch (with-temp-buffer
+ (when (eq 0 (ignore-errors
+ (call-process "gcc" nil '(t nil) nil
+ "-print-multiarch")))
+ (goto-char (point-min))
+ (buffer-substring (point) (line-end-position)))))
+ (base '("/usr/include" "/usr/local/include")))
+ (if (zerop (length arch))
+ base
+ (append base (list (expand-file-name arch "/usr/include")))))
"C Header file search path used in Man."
+ :version "24.1" ; add multiarch
:type '(repeat string)
:group 'man)
(defcustom Man-name-local-regexp (concat "^" (regexp-opt '("NOM" "NAME")) "$")
"Regexp that matches the text that precedes the command's name.
Used in `bookmark-set' to get the default bookmark name."
+ :version "24.1"
:type 'string :group 'bookmark)
-(defvar manual-program "man"
- "The name of the program that produces man pages.")
+(defcustom manual-program "man"
+ "Program used by `man' to produce man pages."
+ :type 'string
+ :group 'man)
-(defvar Man-untabify-command "pr"
- "Command used for untabifying.")
+(defcustom Man-untabify-command "pr"
+ "Program used by `man' for untabifying."
+ :type 'string
+ :group 'man)
-(defvar Man-untabify-command-args (list "-t" "-e")
- "List of arguments to be passed to `Man-untabify-command' (which see).")
+(defcustom Man-untabify-command-args (list "-t" "-e")
+ "List of arguments to be passed to `Man-untabify-command' (which see)."
+ :type '(repeat string)
+ :group 'man)
-(defvar Man-sed-command "sed"
- "Command used for processing sed scripts.")
+(defcustom Man-sed-command "sed"
+ "Program used by `man' to process sed scripts."
+ :type 'string
+ :group 'man)
-(defvar Man-awk-command "awk"
- "Command used for processing awk scripts.")
+(defcustom Man-awk-command "awk"
+ "Program used by `man' to process awk scripts."
+ :type 'string
+ :group 'man)
-(defvar Man-mode-hook nil
- "Hook run when Man mode is enabled.")
+(defcustom Man-mode-hook nil
+ "Hook run when Man mode is enabled."
+ :type 'hook
+ :group 'man)
-(defvar Man-cooked-hook nil
- "Hook run after removing backspaces but before `Man-mode' processing.")
+(defcustom Man-cooked-hook nil
+ "Hook run after removing backspaces but before `Man-mode' processing."
+ :type 'hook
+ :group 'man)
(defvar Man-name-regexp "[-a-zA-Z0-9_+][-a-zA-Z0-9_.:+]*"
"Regular expression describing the name of a manpage (without section).")
@@ -320,11 +349,12 @@ This regexp should not start with a `^' character.")
(concat "\\(" Man-name-regexp "\\)\\((\\(" Man-section-regexp "\\))\\)?")
"Regular expression describing a reference in the SEE ALSO section.")
-(defvar Man-switches ""
+(defcustom Man-switches ""
"Switches passed to the man command, as a single string.
-
-If you want to be able to see all the manpages for a subject you type,
-make -a one of the switches, if your `man' program supports it.")
+For example, the -a switch lets you see all the manpages for a
+specified subject, if your `man' program supports it."
+ :type 'string
+ :group 'man)
(defvar Man-specified-section-option
(if (string-match "-solaris[0-9.]*$" system-configuration)
@@ -338,8 +368,6 @@ make -a one of the switches, if your `man' program supports it.")
Otherwise, the value is whatever the function
`Man-support-local-filenames' should return.")
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; end user variables
;; other variables and keymap initializations
(defvar Man-original-frame)
@@ -348,10 +376,10 @@ Otherwise, the value is whatever the function
(make-variable-buffer-local 'Man-arguments)
(put 'Man-arguments 'permanent-local t)
-(defvar Man-sections-alist nil)
-(make-variable-buffer-local 'Man-sections-alist)
-(defvar Man-refpages-alist nil)
-(make-variable-buffer-local 'Man-refpages-alist)
+(defvar Man--sections nil)
+(make-variable-buffer-local 'Man--sections)
+(defvar Man--refpages nil)
+(make-variable-buffer-local 'Man--refpages)
(defvar Man-page-list nil)
(make-variable-buffer-local 'Man-page-list)
(defvar Man-current-page 0)
@@ -858,7 +886,7 @@ names or descriptions. The pattern argument is usually an
(list (let* ((default-entry (Man-default-man-entry))
;; ignore case because that's friendly for bizarre
;; caps things like the X11 function names and because
- ;; "man" itself is case-sensitive on the command line
+ ;; "man" itself is case-insensitive on the command line
;; so you're accustomed not to bother about the case
;; ("man -k" is case-insensitive similarly, so the
;; table has everything available to complete)
@@ -944,7 +972,6 @@ Return the buffer in which the manpage will appear."
Man-width)
(Man-width (frame-width))
((window-width))))))
- (setenv "GROFF_NO_SGR" "1")
;; Since man-db 2.4.3-1, man writes plain text with no escape
;; sequences when stdout is not a tty. In 2.5.0, the following
;; env-var was added to allow control of this (see Debian Bug#340673).
@@ -978,41 +1005,41 @@ Return the buffer in which the manpage will appear."
See the variable `Man-notify-method' for the different notification behaviors."
(let ((saved-frame (with-current-buffer man-buffer
Man-original-frame)))
- (case Man-notify-method
- (newframe
- ;; Since we run asynchronously, perhaps while Emacs is waiting
- ;; for input, we must not leave a different buffer current. We
- ;; can't rely on the editor command loop to reselect the
- ;; selected window's buffer.
- (save-excursion
- (let ((frame (make-frame Man-frame-parameters)))
- (set-window-buffer (frame-selected-window frame) man-buffer)
- (set-window-dedicated-p (frame-selected-window frame) t)
- (or (display-multi-frame-p frame)
- (select-frame frame)))))
- (pushy
- (switch-to-buffer man-buffer))
- (bully
- (and (frame-live-p saved-frame)
- (select-frame saved-frame))
- (pop-to-buffer man-buffer)
- (delete-other-windows))
- (aggressive
- (and (frame-live-p saved-frame)
- (select-frame saved-frame))
- (pop-to-buffer man-buffer))
- (friendly
- (and (frame-live-p saved-frame)
- (select-frame saved-frame))
- (display-buffer man-buffer 'not-this-window))
- (polite
- (beep)
- (message "Manual buffer %s is ready" (buffer-name man-buffer)))
- (quiet
- (message "Manual buffer %s is ready" (buffer-name man-buffer)))
- (t ;; meek
- (message ""))
- )))
+ (pcase Man-notify-method
+ (`newframe
+ ;; Since we run asynchronously, perhaps while Emacs is waiting
+ ;; for input, we must not leave a different buffer current. We
+ ;; can't rely on the editor command loop to reselect the
+ ;; selected window's buffer.
+ (save-excursion
+ (let ((frame (make-frame Man-frame-parameters)))
+ (set-window-buffer (frame-selected-window frame) man-buffer)
+ (set-window-dedicated-p (frame-selected-window frame) t)
+ (or (display-multi-frame-p frame)
+ (select-frame frame)))))
+ (`pushy
+ (switch-to-buffer man-buffer))
+ (`bully
+ (and (frame-live-p saved-frame)
+ (select-frame saved-frame))
+ (pop-to-buffer man-buffer)
+ (delete-other-windows))
+ (`aggressive
+ (and (frame-live-p saved-frame)
+ (select-frame saved-frame))
+ (pop-to-buffer man-buffer))
+ (`friendly
+ (and (frame-live-p saved-frame)
+ (select-frame saved-frame))
+ (display-buffer man-buffer 'not-this-window))
+ (`polite
+ (beep)
+ (message "Manual buffer %s is ready" (buffer-name man-buffer)))
+ (`quiet
+ (message "Manual buffer %s is ready" (buffer-name man-buffer)))
+ (_ ;; meek
+ (message ""))
+ )))
(defun Man-softhyphen-to-minus ()
;; \255 is SOFT HYPHEN in Latin-N. Versions of Debian man, at
@@ -1032,38 +1059,12 @@ Same for the ANSI bold and normal escape sequences."
(message "Please wait: formatting the %s man page..." Man-arguments)
(goto-char (point-min))
;; Fontify ANSI escapes.
- (let ((faces nil)
- (buffer-undo-list t)
- (start (point)))
- ;; http://www.isthe.com/chongo/tech/comp/ansi_escapes.html
- ;; suggests many codes, but we only handle:
- ;; ESC [ 00 m reset to normal display
- ;; ESC [ 01 m bold
- ;; ESC [ 04 m underline
- ;; ESC [ 07 m reverse-video
- ;; ESC [ 22 m no-bold
- ;; ESC [ 24 m no-underline
- ;; ESC [ 27 m no-reverse-video
- (while (re-search-forward "\e\\[0?\\([1470]\\|2\\([247]\\)\\)m" nil t)
- (if faces (put-text-property start (match-beginning 0) 'face
- (if (cdr faces) faces (car faces))))
- (setq faces
- (cond
- ((match-beginning 2)
- (delq (case (char-after (match-beginning 2))
- (?2 Man-overstrike-face)
- (?4 Man-underline-face)
- (?7 Man-reverse-face))
- faces))
- ((eq (char-after (match-beginning 1)) ?0) nil)
- (t
- (cons (case (char-after (match-beginning 1))
- (?1 Man-overstrike-face)
- (?4 Man-underline-face)
- (?7 Man-reverse-face))
- faces))))
- (delete-region (match-beginning 0) (match-end 0))
- (setq start (point))))
+ (let ((ansi-color-apply-face-function
+ (lambda (beg end face)
+ (when face
+ (put-text-property beg end 'face face))))
+ (ansi-color-map Man-ansi-color-map))
+ (ansi-color-apply-on-region (point-min) (point-max)))
;; Other highlighting.
(let ((buffer-undo-list t))
(if (< (buffer-size) (position-bytes (point-max)))
@@ -1072,23 +1073,23 @@ Same for the ANSI bold and normal escape sequences."
(goto-char (point-min))
(while (search-forward "__\b\b" nil t)
(backward-delete-char 4)
- (put-text-property (point) (1+ (point)) 'face Man-underline-face))
+ (put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min))
(while (search-forward "\b\b__" nil t)
(backward-delete-char 4)
- (put-text-property (1- (point)) (point) 'face Man-underline-face))))
+ (put-text-property (1- (point)) (point) 'face 'Man-underline))))
(goto-char (point-min))
(while (search-forward "_\b" nil t)
(backward-delete-char 2)
- (put-text-property (point) (1+ (point)) 'face Man-underline-face))
+ (put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min))
(while (search-forward "\b_" nil t)
(backward-delete-char 2)
- (put-text-property (1- (point)) (point) 'face Man-underline-face))
+ (put-text-property (1- (point)) (point) 'face 'Man-underline))
(goto-char (point-min))
(while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t)
(replace-match "\\1")
- (put-text-property (1- (point)) (point) 'face Man-overstrike-face))
+ (put-text-property (1- (point)) (point) 'face 'Man-overstrike))
(goto-char (point-min))
(while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
(replace-match "o")
@@ -1099,7 +1100,7 @@ Same for the ANSI bold and normal escape sequences."
(put-text-property (1- (point)) (point) 'face 'bold))
;; When the header is longer than the manpage name, groff tries to
;; condense it to a shorter line interspersed with ^H. Remove ^H with
- ;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566)
+ ;; their preceding chars (but don't put Man-overstrike). (Bug#5566)
(goto-char (point-min))
(while (re-search-forward ".\b" nil t) (backward-delete-char 2))
(goto-char (point-min))
@@ -1110,7 +1111,7 @@ Same for the ANSI bold and normal escape sequences."
(while (re-search-forward Man-heading-regexp nil t)
(put-text-property (match-beginning 0)
(match-end 0)
- 'face Man-overstrike-face)))
+ 'face 'Man-overstrike)))
(message "%s man page formatted" (Man-page-from-arguments Man-arguments)))
(defun Man-highlight-references (&optional xref-man-type)
@@ -1193,7 +1194,7 @@ script would have done them."
(while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
;; When the header is longer than the manpage name, groff tries to
;; condense it to a shorter line interspersed with ^H. Remove ^H with
- ;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566)
+ ;; their preceding chars (but don't put Man-overstrike). (Bug#5566)
(goto-char (point-min))
(while (re-search-forward ".\b" nil t) (backward-delete-char 2))
(Man-softhyphen-to-minus)
@@ -1262,8 +1263,8 @@ manpage command."
(if (not Man-page-list)
(let ((args Man-arguments))
(kill-buffer (current-buffer))
- (error "Can't find the %s manpage"
- (Man-page-from-arguments args)))
+ (user-error "Can't find the %s manpage"
+ (Man-page-from-arguments args)))
(set-buffer-modified-p nil))))
;; Restore case-fold-search before calling
;; Man-notify-when-ready because it may switch buffers.
@@ -1358,17 +1359,19 @@ The following key bindings are currently in effect in the buffer:
(run-mode-hooks 'Man-mode-hook))
(defsubst Man-build-section-alist ()
- "Build the association list of manpage sections."
- (setq Man-sections-alist nil)
+ "Build the list of manpage sections."
+ (setq Man--sections nil)
(goto-char (point-min))
(let ((case-fold-search nil))
(while (re-search-forward Man-heading-regexp (point-max) t)
- (aput 'Man-sections-alist (match-string 1))
+ (let ((section (match-string 1)))
+ (unless (member section Man--sections)
+ (push section Man--sections)))
(forward-line 1))))
(defsubst Man-build-references-alist ()
- "Build the association list of references (in the SEE ALSO section)."
- (setq Man-refpages-alist nil)
+ "Build the list of references (in the SEE ALSO section)."
+ (setq Man--refpages nil)
(save-excursion
(if (Man-find-section Man-see-also-regexp)
(let ((start (progn (forward-line 1) (point)))
@@ -1394,10 +1397,11 @@ The following key bindings are currently in effect in the buffer:
len (1- (length word))))
(if (memq (aref word len) '(?- ?))
(setq hyphenated (substring word 0 len)))
- (if (string-match Man-reference-regexp word)
- (aput 'Man-refpages-alist word))))
+ (and (string-match Man-reference-regexp word)
+ (not (member word Man--refpages))
+ (push word Man--refpages))))
(skip-chars-forward " \t\n,"))))))
- (setq Man-refpages-alist (nreverse Man-refpages-alist)))
+ (setq Man--refpages (nreverse Man--refpages)))
(defun Man-build-page-list ()
"Build the list of separate manpages in the buffer."
@@ -1461,7 +1465,12 @@ The following key bindings are currently in effect in the buffer:
(nindent 0))
(narrow-to-region (car page) (car (cdr page)))
(if Man-uses-untabify-flag
- (untabify (point-min) (point-max)))
+ ;; The space characters inserted by `untabify' inherit
+ ;; sticky text properties, which is unnecessary and looks
+ ;; ugly with underlining (Bug#11408).
+ (let ((text-property-default-nonsticky
+ (cons '(face . t) text-property-default-nonsticky)))
+ (untabify (point-min) (point-max))))
(if (catch 'unindent
(goto-char (point-min))
(if (not (re-search-forward Man-first-heading-regexp nil t))
@@ -1529,21 +1538,22 @@ Returns t if section is found, nil otherwise."
nil)
))
-(defun Man-goto-section ()
- "Query for section to move point to."
- (interactive)
- (aput 'Man-sections-alist
- (let* ((default (aheadsym Man-sections-alist))
- (completion-ignore-case t)
- chosen
- (prompt (concat "Go to section (default " default "): ")))
- (setq chosen (completing-read prompt Man-sections-alist))
- (if (or (not chosen)
- (string= chosen ""))
- default
- chosen)))
- (unless (Man-find-section (aheadsym Man-sections-alist))
- (error "Section not found")))
+(defvar Man--last-section nil)
+
+(defun Man-goto-section (section)
+ "Move point to SECTION."
+ (interactive
+ (let* ((default (if (member Man--last-section Man--sections)
+ Man--last-section
+ (car Man--sections)))
+ (completion-ignore-case t)
+ (prompt (concat "Go to section (default " default "): "))
+ (chosen (completing-read prompt Man--sections
+ nil nil nil nil default)))
+ (list chosen)))
+ (setq Man--last-section section)
+ (unless (Man-find-section section)
+ (error "Section %s not found" section)))
(defun Man-goto-see-also-section ()
@@ -1574,11 +1584,13 @@ as \"tcgetp-grp(3V)\", and point is at \"grp(3V)\", we return
(setq word (current-word))))
word)))
+(defvar Man--last-refpage nil)
+
(defun Man-follow-manual-reference (reference)
"Get one of the manpages referred to in the \"SEE ALSO\" section.
Specify which REFERENCE to use; default is based on word at point."
(interactive
- (if (not Man-refpages-alist)
+ (if (not Man--refpages)
(error "There are no references in the current man page")
(list
(let* ((default (or
@@ -1591,26 +1603,22 @@ Specify which REFERENCE to use; default is based on word at point."
(substring word 0
(match-beginning 0))
word))
- Man-refpages-alist))
- (aheadsym Man-refpages-alist)))
+ Man--refpages))
+ (if (member Man--last-refpage Man--refpages)
+ Man--last-refpage
+ (car Man--refpages))))
(defaults
(mapcar 'substring-no-properties
- (delete-dups
- (delq nil (cons default
- (mapcar 'car Man-refpages-alist))))))
- chosen
- (prompt (concat "Refer to (default " default "): ")))
- (setq chosen (completing-read prompt Man-refpages-alist
- nil nil nil nil defaults))
- (if (or (not chosen)
- (string= chosen ""))
- default
- chosen)))))
- (if (not Man-refpages-alist)
+ (cons default Man--refpages)))
+ (prompt (concat "Refer to (default " default "): "))
+ (chosen (completing-read prompt Man--refpages
+ nil nil nil nil defaults)))
+ chosen))))
+ (if (not Man--refpages)
(error "Can't find any references in the current manpage")
- (aput 'Man-refpages-alist reference)
+ (setq Man--last-refpage reference)
(Man-getpage-in-background
- (Man-translate-references (aheadsym Man-refpages-alist)))))
+ (Man-translate-references reference))))
(defun Man-kill ()
"Kill the buffer containing the manpage."
@@ -1636,7 +1644,7 @@ Specify which REFERENCE to use; default is based on word at point."
(when Man-page-list
(if (or (< page 1)
(> page (length Man-page-list)))
- (error "No manpage %d found" page))
+ (user-error "No manpage %d found" page))
(let* ((page-range (nth (1- page) Man-page-list))
(page-start (car page-range))
(page-end (car (cdr page-range))))
@@ -1729,9 +1737,6 @@ Uses `Man-name-local-regexp'."
;; Init the man package variables, if not already done.
(Man-init-defvars)
-(add-to-list 'debug-ignored-errors "^No manpage [0-9]* found$")
-(add-to-list 'debug-ignored-errors "^Can't find the .* manpage$")
-
(provide 'man)
;;; man.el ends here
diff --git a/lisp/master.el b/lisp/master.el
index c3e9004ca0b..b23c4493646 100644
--- a/lisp/master.el
+++ b/lisp/master.el
@@ -1,6 +1,6 @@
;;; master.el --- make a buffer the master over another buffer
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Alex Schroeder <alex@gnu.org>
diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el
index 22fd84a67aa..6cc5653d1ed 100644
--- a/lisp/mb-depth.el
+++ b/lisp/mb-depth.el
@@ -1,6 +1,6 @@
;;; mb-depth.el --- Indicate minibuffer-depth in prompt
;;
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: convenience
diff --git a/lisp/md4.el b/lisp/md4.el
index 8d89004de23..9ab44d5e3b2 100644
--- a/lisp/md4.el
+++ b/lisp/md4.el
@@ -1,6 +1,6 @@
;;; md4.el --- MD4 Message Digest Algorithm.
-;; Copyright (C) 2001, 2004, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2004, 2007-2012 Free Software Foundation, Inc.
;; Author: Taro Kawagishi <tarok@transpulse.org>
;; Keywords: MD4
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 9c020ffadab..88e59eff86b 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1,6 +1,6 @@
;;; menu-bar.el --- define a default menu bar
-;; Copyright (C) 1993-1995, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2012 Free Software Foundation, Inc.
;; Author: RMS
;; Maintainer: FSF
@@ -49,14 +49,14 @@
(setq menu-bar-final-items '(buffer services help-menu))
(setq menu-bar-final-items '(buffer services hide-app quit))
;; Add standard top-level items to GNUstep menu.
- (define-key global-map [menu-bar quit]
- `(menu-item ,(purecopy "Quit") save-buffers-kill-emacs
- :help ,(purecopy "Save unsaved buffers, then exit")))
- (define-key global-map [menu-bar hide-app]
- `(menu-item ,(purecopy "Hide") ns-do-hide-emacs
- :help ,(purecopy "Hide Emacs"))))
- (define-key global-map [menu-bar services] ; set-up in ns-win
- (cons (purecopy "Services") (make-sparse-keymap "Services"))))
+ (bindings--define-key global-map [menu-bar quit]
+ '(menu-item "Quit" save-buffers-kill-emacs
+ :help "Save unsaved buffers, then exit"))
+ (bindings--define-key global-map [menu-bar hide-app]
+ '(menu-item "Hide" ns-do-hide-emacs
+ :help "Hide Emacs")))
+ (bindings--define-key global-map [menu-bar services] ; Set-up in ns-win.
+ (cons "Services" (make-sparse-keymap "Services"))))
;; This definition is just to show what this looks like.
;; It gets modified in place when menu-bar-update-buffers is called.
@@ -69,85 +69,84 @@
(let ((menu (make-sparse-keymap "File")))
;; The "File" menu items
- (define-key menu [exit-emacs]
- `(menu-item ,(purecopy "Quit") save-buffers-kill-terminal
- :help ,(purecopy "Save unsaved buffers, then exit")))
+ (bindings--define-key menu [exit-emacs]
+ '(menu-item "Quit" save-buffers-kill-terminal
+ :help "Save unsaved buffers, then exit"))
- (define-key menu [separator-exit]
+ (bindings--define-key menu [separator-exit]
menu-bar-separator)
;; Don't use delete-frame as event name because that is a special
;; event.
- (define-key menu [delete-this-frame]
- `(menu-item ,(purecopy "Delete Frame") delete-frame
+ (bindings--define-key menu [delete-this-frame]
+ '(menu-item "Delete Frame" delete-frame
:visible (fboundp 'delete-frame)
:enable (delete-frame-enabled-p)
- :help ,(purecopy "Delete currently selected frame")))
- (define-key menu [make-frame-on-display]
- `(menu-item ,(purecopy "New Frame on Display...") make-frame-on-display
+ :help "Delete currently selected frame"))
+ (bindings--define-key menu [make-frame-on-display]
+ '(menu-item "New Frame on Display..." make-frame-on-display
:visible (fboundp 'make-frame-on-display)
- :help ,(purecopy "Open a new frame on another display")))
- (define-key menu [make-frame]
- `(menu-item ,(purecopy "New Frame") make-frame-command
+ :help "Open a new frame on another display"))
+ (bindings--define-key menu [make-frame]
+ '(menu-item "New Frame" make-frame-command
:visible (fboundp 'make-frame-command)
- :help ,(purecopy "Open a new frame")))
+ :help "Open a new frame"))
- (define-key menu [separator-frame]
+ (bindings--define-key menu [separator-frame]
menu-bar-separator)
- (define-key menu [one-window]
- `(menu-item ,(purecopy "Remove Other Windows") delete-other-windows
+ (bindings--define-key menu [one-window]
+ '(menu-item "Remove Other Windows" delete-other-windows
:enable (not (one-window-p t nil))
- :help ,(purecopy "Make selected window fill whole frame")))
+ :help "Make selected window fill whole frame"))
- (define-key menu [new-window-on-right]
- `(menu-item ,(purecopy "New Window on Right") split-window-right
+ (bindings--define-key menu [new-window-on-right]
+ '(menu-item "New Window on Right" split-window-right
:enable (and (menu-bar-menu-frame-live-and-visible-p)
(menu-bar-non-minibuffer-window-p))
- :help ,(purecopy "Make new window on right of selected one")))
+ :help "Make new window on right of selected one"))
- (define-key menu [new-window-below]
- `(menu-item ,(purecopy "New Window Below") split-window-below
+ (bindings--define-key menu [new-window-below]
+ '(menu-item "New Window Below" split-window-below
:enable (and (menu-bar-menu-frame-live-and-visible-p)
(menu-bar-non-minibuffer-window-p))
- :help ,(purecopy "Make new window below selected one")))
+ :help "Make new window below selected one"))
- (define-key menu [separator-window]
+ (bindings--define-key menu [separator-window]
menu-bar-separator)
- (define-key menu [ps-print-region]
- `(menu-item ,(purecopy "PostScript Print Region (B+W)") ps-print-region
+ (bindings--define-key menu [ps-print-region]
+ '(menu-item "PostScript Print Region (B+W)" ps-print-region
:enable mark-active
- :help ,(purecopy "Pretty-print marked region in black and white to PostScript printer")))
- (define-key menu [ps-print-buffer]
- `(menu-item ,(purecopy "PostScript Print Buffer (B+W)") ps-print-buffer
+ :help "Pretty-print marked region in black and white to PostScript printer"))
+ (bindings--define-key menu [ps-print-buffer]
+ '(menu-item "PostScript Print Buffer (B+W)" ps-print-buffer
:enable (menu-bar-menu-frame-live-and-visible-p)
- :help ,(purecopy "Pretty-print current buffer in black and white to PostScript printer")))
- (define-key menu [ps-print-region-faces]
- `(menu-item ,(purecopy "PostScript Print Region")
+ :help "Pretty-print current buffer in black and white to PostScript printer"))
+ (bindings--define-key menu [ps-print-region-faces]
+ '(menu-item "PostScript Print Region"
ps-print-region-with-faces
:enable mark-active
- :help ,(purecopy
- "Pretty-print marked region to PostScript printer")))
- (define-key menu [ps-print-buffer-faces]
- `(menu-item ,(purecopy "PostScript Print Buffer")
+ :help "Pretty-print marked region to PostScript printer"))
+ (bindings--define-key menu [ps-print-buffer-faces]
+ '(menu-item "PostScript Print Buffer"
ps-print-buffer-with-faces
:enable (menu-bar-menu-frame-live-and-visible-p)
- :help ,(purecopy "Pretty-print current buffer to PostScript printer")))
- (define-key menu [print-region]
- `(menu-item ,(purecopy "Print Region") print-region
+ :help "Pretty-print current buffer to PostScript printer"))
+ (bindings--define-key menu [print-region]
+ '(menu-item "Print Region" print-region
:enable mark-active
- :help ,(purecopy "Print region between mark and current position")))
- (define-key menu [print-buffer]
- `(menu-item ,(purecopy "Print Buffer") print-buffer
+ :help "Print region between mark and current position"))
+ (bindings--define-key menu [print-buffer]
+ '(menu-item "Print Buffer" print-buffer
:enable (menu-bar-menu-frame-live-and-visible-p)
- :help ,(purecopy "Print current buffer with page headings")))
+ :help "Print current buffer with page headings"))
- (define-key menu [separator-print]
+ (bindings--define-key menu [separator-print]
menu-bar-separator)
- (define-key menu [recover-session]
- `(menu-item ,(purecopy "Recover Crashed Session") recover-session
+ (bindings--define-key menu [recover-session]
+ '(menu-item "Recover Crashed Session" recover-session
:enable
(and auto-save-list-file-prefix
(file-directory-p
@@ -160,55 +159,52 @@
(file-name-nondirectory
auto-save-list-file-prefix)))
t))
- :help ,(purecopy "Recover edits from a crashed session")))
- (define-key menu [revert-buffer]
- `(menu-item ,(purecopy "Revert Buffer") revert-buffer
+ :help "Recover edits from a crashed session"))
+ (bindings--define-key menu [revert-buffer]
+ '(menu-item "Revert Buffer" revert-buffer
:enable (or revert-buffer-function
revert-buffer-insert-file-contents-function
(and buffer-file-number
(or (buffer-modified-p)
(not (verify-visited-file-modtime
(current-buffer))))))
- :help ,(purecopy "Re-read current buffer from its file")))
- (define-key menu [write-file]
- `(menu-item ,(purecopy "Save As...") write-file
+ :help "Re-read current buffer from its file"))
+ (bindings--define-key menu [write-file]
+ '(menu-item "Save As..." write-file
:enable (and (menu-bar-menu-frame-live-and-visible-p)
(menu-bar-non-minibuffer-window-p))
- :help ,(purecopy "Write current buffer to another file")))
- (define-key menu [save-buffer]
- `(menu-item ,(purecopy "Save") save-buffer
+ :help "Write current buffer to another file"))
+ (bindings--define-key menu [save-buffer]
+ '(menu-item "Save" save-buffer
:enable (and (buffer-modified-p)
(buffer-file-name)
(menu-bar-non-minibuffer-window-p))
- :help ,(purecopy "Save current buffer to its file")))
+ :help "Save current buffer to its file"))
- (define-key menu [separator-save]
+ (bindings--define-key menu [separator-save]
menu-bar-separator)
- (define-key menu [kill-buffer]
- `(menu-item ,(purecopy "Close") kill-this-buffer
+ (bindings--define-key menu [kill-buffer]
+ '(menu-item "Close" kill-this-buffer
:enable (kill-this-buffer-enabled-p)
- :help ,(purecopy "Discard (kill) current buffer")))
- (define-key menu [insert-file]
- `(menu-item ,(purecopy "Insert File...") insert-file
+ :help "Discard (kill) current buffer"))
+ (bindings--define-key menu [insert-file]
+ '(menu-item "Insert File..." insert-file
:enable (menu-bar-non-minibuffer-window-p)
- :help ,(purecopy "Insert another file into current buffer")))
- (define-key menu [dired]
- `(menu-item ,(purecopy "Open Directory...") dired
+ :help "Insert another file into current buffer"))
+ (bindings--define-key menu [dired]
+ '(menu-item "Open Directory..." dired
:enable (menu-bar-non-minibuffer-window-p)
- :help ,(purecopy
- "Read a directory, to operate on its files")))
- (define-key menu [open-file]
- `(menu-item ,(purecopy "Open File...") menu-find-file-existing
+ :help "Read a directory, to operate on its files"))
+ (bindings--define-key menu [open-file]
+ '(menu-item "Open File..." menu-find-file-existing
:enable (menu-bar-non-minibuffer-window-p)
- :help ,(purecopy
- "Read an existing file into an Emacs buffer")))
- (define-key menu [new-file]
- `(menu-item ,(purecopy "Visit New File...") find-file
+ :help "Read an existing file into an Emacs buffer"))
+ (bindings--define-key menu [new-file]
+ '(menu-item "Visit New File..." find-file
:enable (menu-bar-non-minibuffer-window-p)
- :help ,(purecopy
- "Specify a new file's name, to edit the file")))
+ :help "Specify a new file's name, to edit the file"))
menu))
@@ -291,148 +287,143 @@
;; The Edit->Search->Incremental Search menu
(defvar menu-bar-i-search-menu
(let ((menu (make-sparse-keymap "Incremental Search")))
- (define-key menu [isearch-backward-regexp]
- `(menu-item ,(purecopy "Backward Regexp...") isearch-backward-regexp
- :help ,(purecopy
- "Search backwards for a regular expression as you type it")))
- (define-key menu [isearch-forward-regexp]
- `(menu-item ,(purecopy "Forward Regexp...") isearch-forward-regexp
- :help ,(purecopy
- "Search forward for a regular expression as you type it")))
- (define-key menu [isearch-backward]
- `(menu-item ,(purecopy "Backward String...") isearch-backward
- :help ,(purecopy "Search backwards for a string as you type it")))
- (define-key menu [isearch-forward]
- `(menu-item ,(purecopy "Forward String...") isearch-forward
- :help ,(purecopy "Search forward for a string as you type it")))
+ (bindings--define-key menu [isearch-backward-regexp]
+ '(menu-item "Backward Regexp..." isearch-backward-regexp
+ :help "Search backwards for a regular expression as you type it"))
+ (bindings--define-key menu [isearch-forward-regexp]
+ '(menu-item "Forward Regexp..." isearch-forward-regexp
+ :help "Search forward for a regular expression as you type it"))
+ (bindings--define-key menu [isearch-backward]
+ '(menu-item "Backward String..." isearch-backward
+ :help "Search backwards for a string as you type it"))
+ (bindings--define-key menu [isearch-forward]
+ '(menu-item "Forward String..." isearch-forward
+ :help "Search forward for a string as you type it"))
menu))
(defvar menu-bar-search-menu
(let ((menu (make-sparse-keymap "Search")))
- (define-key menu [i-search]
- `(menu-item ,(purecopy "Incremental Search") ,menu-bar-i-search-menu))
- (define-key menu [separator-tag-isearch]
+ (bindings--define-key menu [i-search]
+ `(menu-item "Incremental Search" ,menu-bar-i-search-menu))
+ (bindings--define-key menu [separator-tag-isearch]
menu-bar-separator)
- (define-key menu [tags-continue]
- `(menu-item ,(purecopy "Continue Tags Search") tags-loop-continue
- :help ,(purecopy "Continue last tags search operation")))
- (define-key menu [tags-srch]
- `(menu-item ,(purecopy "Search Tagged Files...") tags-search
- :help ,(purecopy "Search for a regexp in all tagged files")))
- (define-key menu [separator-tag-search] menu-bar-separator)
+ (bindings--define-key menu [tags-continue]
+ '(menu-item "Continue Tags Search" tags-loop-continue
+ :help "Continue last tags search operation"))
+ (bindings--define-key menu [tags-srch]
+ '(menu-item "Search Tagged Files..." tags-search
+ :help "Search for a regexp in all tagged files"))
+ (bindings--define-key menu [separator-tag-search] menu-bar-separator)
- (define-key menu [repeat-search-back]
- `(menu-item ,(purecopy "Repeat Backwards")
+ (bindings--define-key menu [repeat-search-back]
+ '(menu-item "Repeat Backwards"
nonincremental-repeat-search-backward
:enable (or (and (eq menu-bar-last-search-type 'string)
search-ring)
(and (eq menu-bar-last-search-type 'regexp)
regexp-search-ring))
- :help ,(purecopy "Repeat last search backwards")))
- (define-key menu [repeat-search-fwd]
- `(menu-item ,(purecopy "Repeat Forward")
+ :help "Repeat last search backwards"))
+ (bindings--define-key menu [repeat-search-fwd]
+ '(menu-item "Repeat Forward"
nonincremental-repeat-search-forward
:enable (or (and (eq menu-bar-last-search-type 'string)
search-ring)
(and (eq menu-bar-last-search-type 'regexp)
regexp-search-ring))
- :help ,(purecopy "Repeat last search forward")))
- (define-key menu [separator-repeat-search]
+ :help "Repeat last search forward"))
+ (bindings--define-key menu [separator-repeat-search]
menu-bar-separator)
- (define-key menu [re-search-backward]
- `(menu-item ,(purecopy "Regexp Backwards...")
+ (bindings--define-key menu [re-search-backward]
+ '(menu-item "Regexp Backwards..."
nonincremental-re-search-backward
- :help ,(purecopy
- "Search backwards for a regular expression")))
- (define-key menu [re-search-forward]
- `(menu-item ,(purecopy "Regexp Forward...")
+ :help "Search backwards for a regular expression"))
+ (bindings--define-key menu [re-search-forward]
+ '(menu-item "Regexp Forward..."
nonincremental-re-search-forward
- :help ,(purecopy "Search forward for a regular expression")))
+ :help "Search forward for a regular expression"))
- (define-key menu [search-backward]
- `(menu-item ,(purecopy "String Backwards...")
+ (bindings--define-key menu [search-backward]
+ '(menu-item "String Backwards..."
nonincremental-search-backward
- :help ,(purecopy "Search backwards for a string")))
- (define-key menu [search-forward]
- `(menu-item ,(purecopy "String Forward...") nonincremental-search-forward
- :help ,(purecopy "Search forward for a string")))
+ :help "Search backwards for a string"))
+ (bindings--define-key menu [search-forward]
+ '(menu-item "String Forward..." nonincremental-search-forward
+ :help "Search forward for a string"))
menu))
;; The Edit->Replace submenu
(defvar menu-bar-replace-menu
(let ((menu (make-sparse-keymap "Replace")))
- (define-key menu [tags-repl-continue]
- `(menu-item ,(purecopy "Continue Replace") tags-loop-continue
- :help ,(purecopy "Continue last tags replace operation")))
- (define-key menu [tags-repl]
- `(menu-item ,(purecopy "Replace in Tagged Files...") tags-query-replace
- :help ,(purecopy
- "Interactively replace a regexp in all tagged files")))
- (define-key menu [separator-replace-tags]
+ (bindings--define-key menu [tags-repl-continue]
+ '(menu-item "Continue Replace" tags-loop-continue
+ :help "Continue last tags replace operation"))
+ (bindings--define-key menu [tags-repl]
+ '(menu-item "Replace in Tagged Files..." tags-query-replace
+ :help "Interactively replace a regexp in all tagged files"))
+ (bindings--define-key menu [separator-replace-tags]
menu-bar-separator)
- (define-key menu [query-replace-regexp]
- `(menu-item ,(purecopy "Replace Regexp...") query-replace-regexp
+ (bindings--define-key menu [query-replace-regexp]
+ '(menu-item "Replace Regexp..." query-replace-regexp
:enable (not buffer-read-only)
- :help ,(purecopy "Replace regular expression interactively, ask about each occurrence")))
- (define-key menu [query-replace]
- `(menu-item ,(purecopy "Replace String...") query-replace
+ :help "Replace regular expression interactively, ask about each occurrence"))
+ (bindings--define-key menu [query-replace]
+ '(menu-item "Replace String..." query-replace
:enable (not buffer-read-only)
- :help ,(purecopy
- "Replace string interactively, ask about each occurrence")))
+ :help "Replace string interactively, ask about each occurrence"))
menu))
;;; Assemble the top-level Edit menu items.
(defvar menu-bar-goto-menu
(let ((menu (make-sparse-keymap "Go To")))
- (define-key menu [set-tags-name]
- `(menu-item ,(purecopy "Set Tags File Name...") visit-tags-table
- :help ,(purecopy "Tell Tags commands which tag table file to use")))
+ (bindings--define-key menu [set-tags-name]
+ '(menu-item "Set Tags File Name..." visit-tags-table
+ :help "Tell Tags commands which tag table file to use"))
- (define-key menu [separator-tag-file]
+ (bindings--define-key menu [separator-tag-file]
menu-bar-separator)
- (define-key menu [apropos-tags]
- `(menu-item ,(purecopy "Tags Apropos...") tags-apropos
- :help ,(purecopy "Find function/variables whose names match regexp")))
- (define-key menu [next-tag-otherw]
- `(menu-item ,(purecopy "Next Tag in Other Window")
+ (bindings--define-key menu [apropos-tags]
+ '(menu-item "Tags Apropos..." tags-apropos
+ :help "Find function/variables whose names match regexp"))
+ (bindings--define-key menu [next-tag-otherw]
+ '(menu-item "Next Tag in Other Window"
menu-bar-next-tag-other-window
:enable (and (boundp 'tags-location-ring)
(not (ring-empty-p tags-location-ring)))
- :help ,(purecopy "Find next function/variable matching last tag name in another window")))
+ :help "Find next function/variable matching last tag name in another window"))
- (define-key menu [next-tag]
- `(menu-item ,(purecopy "Find Next Tag")
+ (bindings--define-key menu [next-tag]
+ '(menu-item "Find Next Tag"
menu-bar-next-tag
:enable (and (boundp 'tags-location-ring)
(not (ring-empty-p tags-location-ring)))
- :help ,(purecopy "Find next function/variable matching last tag name")))
- (define-key menu [find-tag-otherw]
- `(menu-item ,(purecopy "Find Tag in Other Window...") find-tag-other-window
- :help ,(purecopy "Find function/variable definition in another window")))
- (define-key menu [find-tag]
- `(menu-item ,(purecopy "Find Tag...") find-tag
- :help ,(purecopy "Find definition of function or variable")))
-
- (define-key menu [separator-tags]
+ :help "Find next function/variable matching last tag name"))
+ (bindings--define-key menu [find-tag-otherw]
+ '(menu-item "Find Tag in Other Window..." find-tag-other-window
+ :help "Find function/variable definition in another window"))
+ (bindings--define-key menu [find-tag]
+ '(menu-item "Find Tag..." find-tag
+ :help "Find definition of function or variable"))
+
+ (bindings--define-key menu [separator-tags]
menu-bar-separator)
- (define-key menu [end-of-buf]
- `(menu-item ,(purecopy "Goto End of Buffer") end-of-buffer))
- (define-key menu [beg-of-buf]
- `(menu-item ,(purecopy "Goto Beginning of Buffer") beginning-of-buffer))
- (define-key menu [go-to-pos]
- `(menu-item ,(purecopy "Goto Buffer Position...") goto-char
- :help ,(purecopy "Read a number N and go to buffer position N")))
- (define-key menu [go-to-line]
- `(menu-item ,(purecopy "Goto Line...") goto-line
- :help ,(purecopy "Read a line number and go to that line")))
+ (bindings--define-key menu [end-of-buf]
+ '(menu-item "Goto End of Buffer" end-of-buffer))
+ (bindings--define-key menu [beg-of-buf]
+ '(menu-item "Goto Beginning of Buffer" beginning-of-buffer))
+ (bindings--define-key menu [go-to-pos]
+ '(menu-item "Goto Buffer Position..." goto-char
+ :help "Read a number N and go to buffer position N"))
+ (bindings--define-key menu [go-to-line]
+ '(menu-item "Goto Line..." goto-line
+ :help "Read a line number and go to that line"))
menu))
@@ -442,59 +433,59 @@
(defvar menu-bar-edit-menu
(let ((menu (make-sparse-keymap "Edit")))
- (define-key menu [props]
- `(menu-item ,(purecopy "Text Properties") facemenu-menu))
+ (bindings--define-key menu [props]
+ `(menu-item "Text Properties" facemenu-menu))
;; ns-win.el said: Add spell for platform consistency.
(if (featurep 'ns)
- (define-key menu [spell]
- `(menu-item ,(purecopy "Spell") ispell-menu-map)))
+ (bindings--define-key menu [spell]
+ `(menu-item "Spell" ispell-menu-map)))
- (define-key menu [fill]
- `(menu-item ,(purecopy "Fill") fill-region
+ (bindings--define-key menu [fill]
+ `(menu-item "Fill" fill-region
:enable (and mark-active (not buffer-read-only))
:help
- ,(purecopy "Fill text in region to fit between left and right margin")))
+ "Fill text in region to fit between left and right margin"))
- (define-key menu [separator-bookmark]
+ (bindings--define-key menu [separator-bookmark]
menu-bar-separator)
- (define-key menu [bookmark]
- `(menu-item ,(purecopy "Bookmarks") menu-bar-bookmark-map))
+ (bindings--define-key menu [bookmark]
+ `(menu-item "Bookmarks" menu-bar-bookmark-map))
- (define-key menu [goto]
- `(menu-item ,(purecopy "Go To") ,menu-bar-goto-menu))
+ (bindings--define-key menu [goto]
+ `(menu-item "Go To" ,menu-bar-goto-menu))
- (define-key menu [replace]
- `(menu-item ,(purecopy "Replace") ,menu-bar-replace-menu))
+ (bindings--define-key menu [replace]
+ `(menu-item "Replace" ,menu-bar-replace-menu))
- (define-key menu [search]
- `(menu-item ,(purecopy "Search") ,menu-bar-search-menu))
+ (bindings--define-key menu [search]
+ `(menu-item "Search" ,menu-bar-search-menu))
- (define-key menu [separator-search]
+ (bindings--define-key menu [separator-search]
menu-bar-separator)
- (define-key menu [mark-whole-buffer]
- `(menu-item ,(purecopy "Select All") mark-whole-buffer
- :help ,(purecopy "Mark the whole buffer for a subsequent cut/copy")))
- (define-key menu [clear]
- `(menu-item ,(purecopy "Clear") delete-region
+ (bindings--define-key menu [mark-whole-buffer]
+ '(menu-item "Select All" mark-whole-buffer
+ :help "Mark the whole buffer for a subsequent cut/copy"))
+ (bindings--define-key menu [clear]
+ '(menu-item "Clear" delete-region
:enable (and mark-active
(not buffer-read-only))
:help
- ,(purecopy "Delete the text in region between mark and current position")))
+ "Delete the text in region between mark and current position"))
- (define-key menu (if (featurep 'ns) [select-paste]
+ (bindings--define-key menu (if (featurep 'ns) [select-paste]
[paste-from-menu])
;; ns-win.el said: Change text to be more consistent with
;; surrounding menu items `paste', etc."
- `(menu-item ,(purecopy (if (featurep 'ns) "Select and Paste"
- "Paste from Kill Menu")) yank-menu
- :enable (and (cdr yank-menu) (not buffer-read-only))
- :help ,(purecopy "Choose a string from the kill ring and paste it")))
- (define-key menu [paste]
- `(menu-item ,(purecopy "Paste") yank
+ `(menu-item ,(if (featurep 'ns) "Select and Paste"
+ "Paste from Kill Menu") yank-menu
+ :enable (and (cdr yank-menu) (not buffer-read-only))
+ :help "Choose a string from the kill ring and paste it"))
+ (bindings--define-key menu [paste]
+ '(menu-item "Paste" yank
:enable (and (or
;; Emacs compiled --without-x (or --with-ns)
;; doesn't have x-selection-exists-p.
@@ -504,35 +495,35 @@
(cdr yank-menu)
kill-ring))
(not buffer-read-only))
- :help ,(purecopy "Paste (yank) text most recently cut/copied")))
- (define-key menu [copy]
+ :help "Paste (yank) text most recently cut/copied"))
+ (bindings--define-key menu [copy]
;; ns-win.el said: Substitute a Copy function that works better
;; under X (for GNUstep).
- `(menu-item ,(purecopy "Copy") ,(if (featurep 'ns)
- 'ns-copy-including-secondary
- 'kill-ring-save)
+ `(menu-item "Copy" ,(if (featurep 'ns)
+ 'ns-copy-including-secondary
+ 'kill-ring-save)
:enable mark-active
- :help ,(purecopy "Copy text in region between mark and current position")
- :keys ,(purecopy (if (featurep 'ns)
- "\\[ns-copy-including-secondary]"
- "\\[kill-ring-save]"))))
- (define-key menu [cut]
- `(menu-item ,(purecopy "Cut") kill-region
+ :help "Copy text in region between mark and current position"
+ :keys ,(if (featurep 'ns)
+ "\\[ns-copy-including-secondary]"
+ "\\[kill-ring-save]")))
+ (bindings--define-key menu [cut]
+ '(menu-item "Cut" kill-region
:enable (and mark-active (not buffer-read-only))
:help
- ,(purecopy "Cut (kill) text in region between mark and current position")))
+ "Cut (kill) text in region between mark and current position"))
;; ns-win.el said: Separate undo from cut/paste section.
(if (featurep 'ns)
- (define-key menu [separator-undo] menu-bar-separator))
+ (bindings--define-key menu [separator-undo] menu-bar-separator))
- (define-key menu [undo]
- `(menu-item ,(purecopy "Undo") undo
+ (bindings--define-key menu [undo]
+ '(menu-item "Undo" undo
:enable (and (not buffer-read-only)
(not (eq t buffer-undo-list))
(if (eq last-command 'undo)
(listp pending-undo-list)
(consp buffer-undo-list)))
- :help ,(purecopy "Undo last operation")))
+ :help "Undo last operation"))
menu))
@@ -598,45 +589,45 @@ Do the same for the keys of the same name."
(defvar menu-bar-custom-menu
(let ((menu (make-sparse-keymap "Customize")))
- (define-key menu [customize-apropos-faces]
- `(menu-item ,(purecopy "Faces Matching...") customize-apropos-faces
- :help ,(purecopy "Browse faces matching a regexp or word list")))
- (define-key menu [customize-apropos-options]
- `(menu-item ,(purecopy "Options Matching...") customize-apropos-options
- :help ,(purecopy "Browse options matching a regexp or word list")))
- (define-key menu [customize-apropos]
- `(menu-item ,(purecopy "All Settings Matching...") customize-apropos
- :help ,(purecopy "Browse customizable settings matching a regexp or word list")))
- (define-key menu [separator-1]
+ (bindings--define-key menu [customize-apropos-faces]
+ '(menu-item "Faces Matching..." customize-apropos-faces
+ :help "Browse faces matching a regexp or word list"))
+ (bindings--define-key menu [customize-apropos-options]
+ '(menu-item "Options Matching..." customize-apropos-options
+ :help "Browse options matching a regexp or word list"))
+ (bindings--define-key menu [customize-apropos]
+ '(menu-item "All Settings Matching..." customize-apropos
+ :help "Browse customizable settings matching a regexp or word list"))
+ (bindings--define-key menu [separator-1]
menu-bar-separator)
- (define-key menu [customize-group]
- `(menu-item ,(purecopy "Specific Group...") customize-group
- :help ,(purecopy "Customize settings of specific group")))
- (define-key menu [customize-face]
- `(menu-item ,(purecopy "Specific Face...") customize-face
- :help ,(purecopy "Customize attributes of specific face")))
- (define-key menu [customize-option]
- `(menu-item ,(purecopy "Specific Option...") customize-option
- :help ,(purecopy "Customize value of specific option")))
- (define-key menu [separator-2]
+ (bindings--define-key menu [customize-group]
+ '(menu-item "Specific Group..." customize-group
+ :help "Customize settings of specific group"))
+ (bindings--define-key menu [customize-face]
+ '(menu-item "Specific Face..." customize-face
+ :help "Customize attributes of specific face"))
+ (bindings--define-key menu [customize-option]
+ '(menu-item "Specific Option..." customize-option
+ :help "Customize value of specific option"))
+ (bindings--define-key menu [separator-2]
menu-bar-separator)
- (define-key menu [customize-changed-options]
- `(menu-item ,(purecopy "New Options...") customize-changed-options
- :help ,(purecopy "Options added or changed in recent Emacs versions")))
- (define-key menu [customize-saved]
- `(menu-item ,(purecopy "Saved Options") customize-saved
- :help ,(purecopy "Customize previously saved options")))
- (define-key menu [separator-3]
+ (bindings--define-key menu [customize-changed-options]
+ '(menu-item "New Options..." customize-changed-options
+ :help "Options added or changed in recent Emacs versions"))
+ (bindings--define-key menu [customize-saved]
+ '(menu-item "Saved Options" customize-saved
+ :help "Customize previously saved options"))
+ (bindings--define-key menu [separator-3]
menu-bar-separator)
- (define-key menu [customize-browse]
- `(menu-item ,(purecopy "Browse Customization Groups") customize-browse
- :help ,(purecopy "Browse all customization groups")))
- (define-key menu [customize]
- `(menu-item ,(purecopy "Top-level Customization Group") customize
- :help ,(purecopy "The master group called `Emacs'")))
- (define-key menu [customize-themes]
- `(menu-item ,(purecopy "Custom Themes") customize-themes
- :help ,(purecopy "Choose a pre-defined customization theme")))
+ (bindings--define-key menu [customize-browse]
+ '(menu-item "Browse Customization Groups" customize-browse
+ :help "Browse all customization groups"))
+ (bindings--define-key menu [customize]
+ '(menu-item "Top-level Customization Group" customize
+ :help "The master group called `Emacs'"))
+ (bindings--define-key menu [customize-themes]
+ '(menu-item "Custom Themes" customize-themes
+ :help "Choose a pre-defined customization theme"))
menu))
;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
@@ -646,11 +637,11 @@ FNAME is the minor mode's name (variable and function).
DOC is the text to use for the menu entry.
HELP is the text to use for the tooltip.
PROPS are additional properties."
- `(list 'menu-item (purecopy ,doc) ',fname
- ,@(mapcar (lambda (p) (list 'quote p)) props)
- :help (purecopy ,help)
- :button '(:toggle . (and (default-boundp ',fname)
- (default-value ',fname)))))
+ `'(menu-item ,doc ,fname
+ ,@props
+ :help ,help
+ :button (:toggle . (and (default-boundp ',fname)
+ (default-value ',fname)))))
(defmacro menu-bar-make-toggle (name variable doc message help &rest body)
`(progn
@@ -673,39 +664,20 @@ by \"Save Options\" in Custom buffers.")
;; a candidate for "Save Options", and we do not want to save options
;; the user have already set explicitly in his init file.
(if interactively (customize-mark-as-set ',variable)))
- (list 'menu-item (purecopy ,doc) ',name
- :help (purecopy ,help)
- :button '(:toggle . (and (default-boundp ',variable)
- (default-value ',variable))))))
+ '(menu-item ,doc ,name
+ :help ,help
+ :button (:toggle . (and (default-boundp ',variable)
+ (default-value ',variable))))))
;; Function for setting/saving default font.
(defun menu-set-font ()
"Interactively select a font and make it the default."
(interactive)
- (let ((font (if (fboundp 'x-select-font)
- (x-select-font)
- (mouse-select-font)))
- spec)
- (when font
- ;; Be careful here: when set-face-attribute is called for the
- ;; :font attribute, Emacs tries to guess the best matching font
- ;; by examining the other face attributes (Bug#2476).
- (set-face-attribute 'default (selected-frame)
- :width 'normal
- :weight 'normal
- :slant 'normal
- :font font)
- (let ((font-object (face-attribute 'default :font)))
- (dolist (f (frame-list))
- (and (not (eq f (selected-frame)))
- (display-graphic-p f)
- (set-face-attribute 'default f :font font-object)))
- (set-face-attribute 'default t :font font-object))
- (setq spec (list (list t (face-attr-construct 'default))))
- (put 'default 'customized-face spec)
- (custom-push-theme 'theme-face 'default 'user 'set spec)
- (put 'default 'face-modified nil))))
+ (set-frame-font (if (fboundp 'x-select-font)
+ (x-select-font)
+ (mouse-select-font))
+ nil t))
(defun menu-bar-options-save ()
"Save current values of Options menu items using Custom."
@@ -794,46 +766,46 @@ by \"Save Options\" in Custom buffers.")
(defvar menu-bar-showhide-fringe-ind-menu
(let ((menu (make-sparse-keymap "Buffer boundaries")))
- (define-key menu [customize]
- `(menu-item ,(purecopy "Other (Customize)")
+ (bindings--define-key menu [customize]
+ '(menu-item "Other (Customize)"
menu-bar-showhide-fringe-ind-customize
- :help ,(purecopy "Additional choices available through Custom buffer")
+ :help "Additional choices available through Custom buffer"
:visible (display-graphic-p)
:button (:radio . (not (member indicate-buffer-boundaries
'(nil left right
((top . left) (bottom . right))
((t . right) (top . left))))))))
- (define-key menu [mixed]
- `(menu-item ,(purecopy "Opposite, Arrows Right") menu-bar-showhide-fringe-ind-mixed
+ (bindings--define-key menu [mixed]
+ '(menu-item "Opposite, Arrows Right" menu-bar-showhide-fringe-ind-mixed
:help
- ,(purecopy "Show top/bottom indicators in opposite fringes, arrows in right")
+ "Show top/bottom indicators in opposite fringes, arrows in right"
:visible (display-graphic-p)
:button (:radio . (equal indicate-buffer-boundaries
'((t . right) (top . left))))))
- (define-key menu [box]
- `(menu-item ,(purecopy "Opposite, No Arrows") menu-bar-showhide-fringe-ind-box
- :help ,(purecopy "Show top/bottom indicators in opposite fringes, no arrows")
+ (bindings--define-key menu [box]
+ '(menu-item "Opposite, No Arrows" menu-bar-showhide-fringe-ind-box
+ :help "Show top/bottom indicators in opposite fringes, no arrows"
:visible (display-graphic-p)
:button (:radio . (equal indicate-buffer-boundaries
'((top . left) (bottom . right))))))
- (define-key menu [right]
- `(menu-item ,(purecopy "In Right Fringe") menu-bar-showhide-fringe-ind-right
- :help ,(purecopy "Show buffer boundaries and arrows in right fringe")
+ (bindings--define-key menu [right]
+ '(menu-item "In Right Fringe" menu-bar-showhide-fringe-ind-right
+ :help "Show buffer boundaries and arrows in right fringe"
:visible (display-graphic-p)
:button (:radio . (eq indicate-buffer-boundaries 'right))))
- (define-key menu [left]
- `(menu-item ,(purecopy "In Left Fringe") menu-bar-showhide-fringe-ind-left
- :help ,(purecopy "Show buffer boundaries and arrows in left fringe")
+ (bindings--define-key menu [left]
+ '(menu-item "In Left Fringe" menu-bar-showhide-fringe-ind-left
+ :help "Show buffer boundaries and arrows in left fringe"
:visible (display-graphic-p)
:button (:radio . (eq indicate-buffer-boundaries 'left))))
- (define-key menu [none]
- `(menu-item ,(purecopy "No Indicators") menu-bar-showhide-fringe-ind-none
- :help ,(purecopy "Hide all buffer boundary indicators and arrows")
+ (bindings--define-key menu [none]
+ '(menu-item "No Indicators" menu-bar-showhide-fringe-ind-none
+ :help "Hide all buffer boundary indicators and arrows"
:visible (display-graphic-p)
:button (:radio . (eq indicate-buffer-boundaries nil))))
menu))
@@ -869,43 +841,43 @@ by \"Save Options\" in Custom buffers.")
(defvar menu-bar-showhide-fringe-menu
(let ((menu (make-sparse-keymap "Fringe")))
- (define-key menu [showhide-fringe-ind]
- `(menu-item ,(purecopy "Buffer Boundaries") ,menu-bar-showhide-fringe-ind-menu
+ (bindings--define-key menu [showhide-fringe-ind]
+ `(menu-item "Buffer Boundaries" ,menu-bar-showhide-fringe-ind-menu
:visible (display-graphic-p)
- :help ,(purecopy "Indicate buffer boundaries in fringe")))
+ :help "Indicate buffer boundaries in fringe"))
- (define-key menu [indicate-empty-lines]
+ (bindings--define-key menu [indicate-empty-lines]
(menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines
"Empty Line Indicators"
"Indicating of empty lines %s"
"Indicate trailing empty lines in fringe, globally"))
- (define-key menu [customize]
- `(menu-item ,(purecopy "Customize Fringe") menu-bar-showhide-fringe-menu-customize
- :help ,(purecopy "Detailed customization of fringe")
+ (bindings--define-key menu [customize]
+ '(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize
+ :help "Detailed customization of fringe"
:visible (display-graphic-p)))
- (define-key menu [default]
- `(menu-item ,(purecopy "Default") menu-bar-showhide-fringe-menu-customize-reset
- :help ,(purecopy "Default width fringe on both left and right side")
+ (bindings--define-key menu [default]
+ '(menu-item "Default" menu-bar-showhide-fringe-menu-customize-reset
+ :help "Default width fringe on both left and right side"
:visible (display-graphic-p)
:button (:radio . (eq fringe-mode nil))))
- (define-key menu [right]
- `(menu-item ,(purecopy "On the Right") menu-bar-showhide-fringe-menu-customize-right
- :help ,(purecopy "Fringe only on the right side")
+ (bindings--define-key menu [right]
+ '(menu-item "On the Right" menu-bar-showhide-fringe-menu-customize-right
+ :help "Fringe only on the right side"
:visible (display-graphic-p)
:button (:radio . (equal fringe-mode '(0 . nil)))))
- (define-key menu [left]
- `(menu-item ,(purecopy "On the Left") menu-bar-showhide-fringe-menu-customize-left
- :help ,(purecopy "Fringe only on the left side")
+ (bindings--define-key menu [left]
+ '(menu-item "On the Left" menu-bar-showhide-fringe-menu-customize-left
+ :help "Fringe only on the left side"
:visible (display-graphic-p)
:button (:radio . (equal fringe-mode '(nil . 0)))))
- (define-key menu [none]
- `(menu-item ,(purecopy "None") menu-bar-showhide-fringe-menu-customize-disable
- :help ,(purecopy "Turn off fringe")
+ (bindings--define-key menu [none]
+ '(menu-item "None" menu-bar-showhide-fringe-menu-customize-disable
+ :help "Turn off fringe"
:visible (display-graphic-p)
:button (:radio . (eq fringe-mode 0))))
menu))
@@ -928,26 +900,26 @@ by \"Save Options\" in Custom buffers.")
(defvar menu-bar-showhide-scroll-bar-menu
(let ((menu (make-sparse-keymap "Scroll-bar")))
- (define-key menu [right]
- `(menu-item ,(purecopy "On the Right")
+ (bindings--define-key menu [right]
+ '(menu-item "On the Right"
menu-bar-right-scroll-bar
- :help ,(purecopy "Scroll-bar on the right side")
+ :help "Scroll-bar on the right side"
:visible (display-graphic-p)
:button (:radio . (eq (cdr (assq 'vertical-scroll-bars
(frame-parameters))) 'right))))
- (define-key menu [left]
- `(menu-item ,(purecopy "On the Left")
+ (bindings--define-key menu [left]
+ '(menu-item "On the Left"
menu-bar-left-scroll-bar
- :help ,(purecopy "Scroll-bar on the left side")
+ :help "Scroll-bar on the left side"
:visible (display-graphic-p)
:button (:radio . (eq (cdr (assq 'vertical-scroll-bars
(frame-parameters))) 'left))))
- (define-key menu [none]
- `(menu-item ,(purecopy "None")
+ (bindings--define-key menu [none]
+ '(menu-item "None"
menu-bar-no-scroll-bar
- :help ,(purecopy "Turn off scroll-bar")
+ :help "Turn off scroll-bar"
:visible (display-graphic-p)
:button (:radio . (eq (cdr (assq 'vertical-scroll-bars
(frame-parameters))) nil))))
@@ -992,10 +964,10 @@ by \"Save Options\" in Custom buffers.")
(defvar menu-bar-showhide-tool-bar-menu
(let ((menu (make-sparse-keymap "Tool-bar")))
- (define-key menu [showhide-tool-bar-left]
- `(menu-item ,(purecopy "On the Left")
+ (bindings--define-key menu [showhide-tool-bar-left]
+ '(menu-item "On the Left"
menu-bar-showhide-tool-bar-menu-customize-enable-left
- :help ,(purecopy "Tool-bar at the left side")
+ :help "Tool-bar at the left side"
:visible (display-graphic-p)
:button
(:radio . (and tool-bar-mode
@@ -1004,10 +976,10 @@ by \"Save Options\" in Custom buffers.")
'tool-bar-position)
'left)))))
- (define-key menu [showhide-tool-bar-right]
- `(menu-item ,(purecopy "On the Right")
+ (bindings--define-key menu [showhide-tool-bar-right]
+ '(menu-item "On the Right"
menu-bar-showhide-tool-bar-menu-customize-enable-right
- :help ,(purecopy "Tool-bar at the right side")
+ :help "Tool-bar at the right side"
:visible (display-graphic-p)
:button
(:radio . (and tool-bar-mode
@@ -1016,10 +988,10 @@ by \"Save Options\" in Custom buffers.")
'tool-bar-position)
'right)))))
- (define-key menu [showhide-tool-bar-bottom]
- `(menu-item ,(purecopy "On the Bottom")
+ (bindings--define-key menu [showhide-tool-bar-bottom]
+ '(menu-item "On the Bottom"
menu-bar-showhide-tool-bar-menu-customize-enable-bottom
- :help ,(purecopy "Tool-bar at the bottom")
+ :help "Tool-bar at the bottom"
:visible (display-graphic-p)
:button
(:radio . (and tool-bar-mode
@@ -1028,10 +1000,10 @@ by \"Save Options\" in Custom buffers.")
'tool-bar-position)
'bottom)))))
- (define-key menu [showhide-tool-bar-top]
- `(menu-item ,(purecopy "On the Top")
+ (bindings--define-key menu [showhide-tool-bar-top]
+ '(menu-item "On the Top"
menu-bar-showhide-tool-bar-menu-customize-enable-top
- :help ,(purecopy "Tool-bar at the top")
+ :help "Tool-bar at the top"
:visible (display-graphic-p)
:button
(:radio . (and tool-bar-mode
@@ -1040,10 +1012,10 @@ by \"Save Options\" in Custom buffers.")
'tool-bar-position)
'top)))))
- (define-key menu [showhide-tool-bar-none]
- `(menu-item ,(purecopy "None")
+ (bindings--define-key menu [showhide-tool-bar-none]
+ '(menu-item "None"
menu-bar-showhide-tool-bar-menu-customize-disable
- :help ,(purecopy "Turn tool-bar off")
+ :help "Turn tool-bar off"
:visible (display-graphic-p)
:button (:radio . (eq tool-bar-mode nil))))
menu)))
@@ -1051,64 +1023,64 @@ by \"Save Options\" in Custom buffers.")
(defvar menu-bar-showhide-menu
(let ((menu (make-sparse-keymap "Show/Hide")))
- (define-key menu [column-number-mode]
+ (bindings--define-key menu [column-number-mode]
(menu-bar-make-mm-toggle column-number-mode
"Column Numbers"
"Show the current column number in the mode line"))
- (define-key menu [line-number-mode]
+ (bindings--define-key menu [line-number-mode]
(menu-bar-make-mm-toggle line-number-mode
"Line Numbers"
"Show the current line number in the mode line"))
- (define-key menu [size-indication-mode]
+ (bindings--define-key menu [size-indication-mode]
(menu-bar-make-mm-toggle size-indication-mode
"Size Indication"
"Show the size of the buffer in the mode line"))
- (define-key menu [linecolumn-separator]
+ (bindings--define-key menu [linecolumn-separator]
menu-bar-separator)
- (define-key menu [showhide-battery]
+ (bindings--define-key menu [showhide-battery]
(menu-bar-make-mm-toggle display-battery-mode
"Battery Status"
"Display battery status information in mode line"))
- (define-key menu [showhide-date-time]
+ (bindings--define-key menu [showhide-date-time]
(menu-bar-make-mm-toggle display-time-mode
"Time, Load and Mail"
"Display time, system load averages and \
mail status in mode line"))
- (define-key menu [datetime-separator]
+ (bindings--define-key menu [datetime-separator]
menu-bar-separator)
- (define-key menu [showhide-speedbar]
- `(menu-item ,(purecopy "Speedbar") speedbar-frame-mode
- :help ,(purecopy "Display a Speedbar quick-navigation frame")
+ (bindings--define-key menu [showhide-speedbar]
+ '(menu-item "Speedbar" speedbar-frame-mode
+ :help "Display a Speedbar quick-navigation frame"
:button (:toggle
. (and (boundp 'speedbar-frame)
(frame-live-p (symbol-value 'speedbar-frame))
(frame-visible-p
(symbol-value 'speedbar-frame))))))
- (define-key menu [showhide-fringe]
- `(menu-item ,(purecopy "Fringe") ,menu-bar-showhide-fringe-menu
+ (bindings--define-key menu [showhide-fringe]
+ `(menu-item "Fringe" ,menu-bar-showhide-fringe-menu
:visible (display-graphic-p)))
- (define-key menu [showhide-scroll-bar]
- `(menu-item ,(purecopy "Scroll-bar") ,menu-bar-showhide-scroll-bar-menu
+ (bindings--define-key menu [showhide-scroll-bar]
+ `(menu-item "Scroll-bar" ,menu-bar-showhide-scroll-bar-menu
:visible (display-graphic-p)))
- (define-key menu [showhide-tooltip-mode]
- `(menu-item ,(purecopy "Tooltips") tooltip-mode
- :help ,(purecopy "Turn tooltips on/off")
+ (bindings--define-key menu [showhide-tooltip-mode]
+ '(menu-item "Tooltips" tooltip-mode
+ :help "Turn tooltips on/off"
:visible (and (display-graphic-p) (fboundp 'x-show-tip))
:button (:toggle . tooltip-mode)))
- (define-key menu [menu-bar-mode]
- `(menu-item ,(purecopy "Menu-bar") toggle-menu-bar-mode-from-frame
- :help ,(purecopy "Turn menu-bar on/off")
+ (bindings--define-key menu [menu-bar-mode]
+ '(menu-item "Menu-bar" toggle-menu-bar-mode-from-frame
+ :help "Turn menu-bar on/off"
:button
(:toggle . (menu-bar-positive-p
(frame-parameter (menu-bar-frame-for-menubar)
@@ -1116,13 +1088,13 @@ mail status in mode line"))
(if (and (boundp 'menu-bar-showhide-tool-bar-menu)
(keymapp menu-bar-showhide-tool-bar-menu))
- (define-key menu [showhide-tool-bar]
- `(menu-item ,(purecopy "Tool-bar") ,menu-bar-showhide-tool-bar-menu
+ (bindings--define-key menu [showhide-tool-bar]
+ `(menu-item "Tool-bar" ,menu-bar-showhide-tool-bar-menu
:visible (display-graphic-p)))
;; else not tool bar that can move.
- (define-key menu [showhide-tool-bar]
- `(menu-item ,(purecopy "Tool-bar") toggle-tool-bar-mode-from-frame
- :help ,(purecopy "Turn tool-bar on/off")
+ (bindings--define-key menu [showhide-tool-bar]
+ '(menu-item "Tool-bar" toggle-tool-bar-mode-from-frame
+ :help "Turn tool-bar on/off"
:visible (display-graphic-p)
:button
(:toggle . (menu-bar-positive-p
@@ -1142,119 +1114,120 @@ mail status in mode line"))
(defvar menu-bar-line-wrapping-menu
(let ((menu (make-sparse-keymap "Line Wrapping")))
- (define-key menu [word-wrap]
- `(menu-item
- ,(purecopy "Word Wrap (Visual Line mode)")
- (lambda ()
- (interactive)
- (unless visual-line-mode
- (visual-line-mode 1))
- (message ,(purecopy "Visual-Line mode enabled")))
- :help ,(purecopy "Wrap long lines at word boundaries")
- :button (:radio . (and (null truncate-lines)
- (not (truncated-partial-width-window-p))
- word-wrap))
- :visible (menu-bar-menu-frame-live-and-visible-p)))
-
- (define-key menu [truncate]
- `(menu-item ,(purecopy "Truncate Long Lines")
- (lambda ()
- (interactive)
- (if visual-line-mode (visual-line-mode 0))
- (setq word-wrap nil)
- (toggle-truncate-lines 1))
- :help ,(purecopy "Truncate long lines at window edge")
+ (bindings--define-key menu [word-wrap]
+ `(menu-item "Word Wrap (Visual Line mode)"
+ ,(lambda ()
+ (interactive)
+ (unless visual-line-mode
+ (visual-line-mode 1))
+ (message "Visual-Line mode enabled"))
+ :help "Wrap long lines at word boundaries"
+ :button (:radio
+ . (and (null truncate-lines)
+ (not (truncated-partial-width-window-p))
+ word-wrap))
+ :visible (menu-bar-menu-frame-live-and-visible-p)))
+
+ (bindings--define-key menu [truncate]
+ `(menu-item "Truncate Long Lines"
+ ,(lambda ()
+ (interactive)
+ (if visual-line-mode (visual-line-mode 0))
+ (setq word-wrap nil)
+ (toggle-truncate-lines 1))
+ :help "Truncate long lines at window edge"
:button (:radio . (or truncate-lines
(truncated-partial-width-window-p)))
:visible (menu-bar-menu-frame-live-and-visible-p)
:enable (not (truncated-partial-width-window-p))))
- (define-key menu [window-wrap]
- `(menu-item ,(purecopy "Wrap at Window Edge")
- (lambda () (interactive)
- (if visual-line-mode (visual-line-mode 0))
- (setq word-wrap nil)
- (if truncate-lines (toggle-truncate-lines -1)))
- :help ,(purecopy "Wrap long lines at window edge")
- :button (:radio . (and (null truncate-lines)
- (not (truncated-partial-width-window-p))
- (not word-wrap)))
+ (bindings--define-key menu [window-wrap]
+ `(menu-item "Wrap at Window Edge"
+ ,(lambda () (interactive)
+ (if visual-line-mode (visual-line-mode 0))
+ (setq word-wrap nil)
+ (if truncate-lines (toggle-truncate-lines -1)))
+ :help "Wrap long lines at window edge"
+ :button (:radio
+ . (and (null truncate-lines)
+ (not (truncated-partial-width-window-p))
+ (not word-wrap)))
:visible (menu-bar-menu-frame-live-and-visible-p)
:enable (not (truncated-partial-width-window-p))))
menu))
(defvar menu-bar-options-menu
(let ((menu (make-sparse-keymap "Options")))
- (define-key menu [customize]
- `(menu-item ,(purecopy "Customize Emacs") ,menu-bar-custom-menu))
+ (bindings--define-key menu [customize]
+ `(menu-item "Customize Emacs" ,menu-bar-custom-menu))
- (define-key menu [package]
+ (bindings--define-key menu [package]
'(menu-item "Manage Emacs Packages" package-list-packages
:help "Install or uninstall additional Emacs packages"))
- (define-key menu [save]
- `(menu-item ,(purecopy "Save Options") menu-bar-options-save
- :help ,(purecopy "Save options set from the menu above")))
+ (bindings--define-key menu [save]
+ '(menu-item "Save Options" menu-bar-options-save
+ :help "Save options set from the menu above"))
- (define-key menu [custom-separator]
+ (bindings--define-key menu [custom-separator]
menu-bar-separator)
- (define-key menu [menu-set-font]
- `(menu-item ,(purecopy "Set Default Font...") menu-set-font
+ (bindings--define-key menu [menu-set-font]
+ '(menu-item "Set Default Font..." menu-set-font
:visible (display-multi-font-p)
- :help ,(purecopy "Select a default font")))
+ :help "Select a default font"))
(if (featurep 'system-font-setting)
- (define-key menu [menu-system-font]
+ (bindings--define-key menu [menu-system-font]
(menu-bar-make-toggle
toggle-use-system-font font-use-system-font
"Use System Font"
"Use system font: %s"
"Use the monospaced font defined by the system")))
- (define-key menu [showhide]
- `(menu-item ,(purecopy "Show/Hide") ,menu-bar-showhide-menu))
+ (bindings--define-key menu [showhide]
+ `(menu-item "Show/Hide" ,menu-bar-showhide-menu))
- (define-key menu [showhide-separator]
+ (bindings--define-key menu [showhide-separator]
menu-bar-separator)
- (define-key menu [mule]
+ (bindings--define-key menu [mule]
;; It is better not to use backquote here,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
- `(menu-item ,(purecopy "Multilingual Environment") ,mule-menu-keymap
+ `(menu-item "Multilingual Environment" ,mule-menu-keymap
;; Most of the MULE menu actually does make sense in
;; unibyte mode, e.g. language selection.
;; :visible '(default-value 'enable-multibyte-characters)
))
;;(setq menu-bar-final-items (cons 'mule menu-bar-final-items))
- ;;(define-key menu [preferences]
- ;; `(menu-item ,(purecopy "Preferences") ,menu-bar-preferences-menu
- ;; :help ,(purecopy "Toggle important global options")))
+ ;;(bindings--define-key menu [preferences]
+ ;; `(menu-item "Preferences" ,menu-bar-preferences-menu
+ ;; :help "Toggle important global options"))
- (define-key menu [mule-separator]
+ (bindings--define-key menu [mule-separator]
menu-bar-separator)
- (define-key menu [debug-on-quit]
+ (bindings--define-key menu [debug-on-quit]
(menu-bar-make-toggle toggle-debug-on-quit debug-on-quit
"Enter Debugger on Quit/C-g" "Debug on Quit %s"
"Enter Lisp debugger when C-g is pressed"))
- (define-key menu [debug-on-error]
+ (bindings--define-key menu [debug-on-error]
(menu-bar-make-toggle toggle-debug-on-error debug-on-error
"Enter Debugger on Error" "Debug on Error %s"
"Enter Lisp debugger when an error is signaled"))
- (define-key menu [debugger-separator]
+ (bindings--define-key menu [debugger-separator]
menu-bar-separator)
- (define-key menu [blink-cursor-mode]
+ (bindings--define-key menu [blink-cursor-mode]
(menu-bar-make-mm-toggle
blink-cursor-mode
"Blink Cursor"
"Whether the cursor blinks (Blink Cursor mode)"))
- (define-key menu [cursor-separator]
+ (bindings--define-key menu [cursor-separator]
menu-bar-separator)
- (define-key menu [save-place]
+ (bindings--define-key menu [save-place]
(menu-bar-make-toggle
toggle-save-place-globally save-place
"Save Place in Files between Sessions"
@@ -1266,7 +1239,7 @@ mail status in mode line"))
(set-default
'save-place (not (symbol-value 'save-place)))))
- (define-key menu [uniquify]
+ (bindings--define-key menu [uniquify]
(menu-bar-make-toggle
toggle-uniquify-buffer-names uniquify-buffer-name-style
"Use Directory Names in Buffer Names"
@@ -1277,9 +1250,9 @@ mail status in mode line"))
(if (not uniquify-buffer-name-style)
'forward))))
- (define-key menu [edit-options-separator]
+ (bindings--define-key menu [edit-options-separator]
menu-bar-separator)
- (define-key menu [cua-mode]
+ (bindings--define-key menu [cua-mode]
(menu-bar-make-mm-toggle
cua-mode
"Use CUA Keys (Cut/Paste with C-x/C-c/C-v)"
@@ -1287,7 +1260,7 @@ mail status in mode line"))
(:visible (or (not (boundp 'cua-enable-cua-keys))
cua-enable-cua-keys))))
- (define-key menu [cua-emulation-mode]
+ (bindings--define-key menu [cua-emulation-mode]
(menu-bar-make-mm-toggle
cua-mode
"Shift movement mark region (CUA)"
@@ -1295,35 +1268,35 @@ mail status in mode line"))
(:visible (and (boundp 'cua-enable-cua-keys)
(not cua-enable-cua-keys)))))
- (define-key menu [case-fold-search]
+ (bindings--define-key menu [case-fold-search]
(menu-bar-make-toggle
toggle-case-fold-search case-fold-search
"Ignore Case for Search"
"Case-Insensitive Search %s"
"Ignore letter-case in search commands"))
- (define-key menu [auto-fill-mode]
- `(menu-item
- ,(purecopy "Auto Fill in Text Modes")
+ (bindings--define-key menu [auto-fill-mode]
+ '(menu-item
+ "Auto Fill in Text Modes"
menu-bar-text-mode-auto-fill
- :help ,(purecopy "Automatically fill text while typing (Auto Fill mode)")
+ :help "Automatically fill text while typing (Auto Fill mode)"
:button (:toggle . (if (listp text-mode-hook)
(member 'turn-on-auto-fill text-mode-hook)
(eq 'turn-on-auto-fill text-mode-hook)))))
- (define-key menu [line-wrapping]
- `(menu-item ,(purecopy "Line Wrapping in This Buffer")
+ (bindings--define-key menu [line-wrapping]
+ `(menu-item "Line Wrapping in This Buffer"
,menu-bar-line-wrapping-menu))
- (define-key menu [highlight-separator]
+ (bindings--define-key menu [highlight-separator]
menu-bar-separator)
- (define-key menu [highlight-paren-mode]
+ (bindings--define-key menu [highlight-paren-mode]
(menu-bar-make-mm-toggle
show-paren-mode
"Highlight Matching Parentheses"
"Highlight matching/mismatched parentheses at cursor (Show Paren mode)"))
- (define-key menu [transient-mark-mode]
+ (bindings--define-key menu [transient-mark-mode]
(menu-bar-make-mm-toggle
transient-mark-mode
"Highlight Active Region"
@@ -1357,109 +1330,109 @@ mail status in mode line"))
(defvar menu-bar-games-menu
(let ((menu (make-sparse-keymap "Games")))
- (define-key menu [zone]
- `(menu-item ,(purecopy "Zone Out") zone
- :help ,(purecopy "Play tricks with Emacs display when Emacs is idle")))
- (define-key menu [tetris]
- `(menu-item ,(purecopy "Tetris") tetris
- :help ,(purecopy "Falling blocks game")))
- (define-key menu [solitaire]
- `(menu-item ,(purecopy "Solitaire") solitaire
- :help ,(purecopy "Get rid of all the stones")))
- (define-key menu [snake]
- `(menu-item ,(purecopy "Snake") snake
- :help ,(purecopy "Move snake around avoiding collisions")))
- (define-key menu [pong]
- `(menu-item ,(purecopy "Pong") pong
- :help ,(purecopy "Bounce the ball to your opponent")))
- (define-key menu [mult]
- `(menu-item ,(purecopy "Multiplication Puzzle") mpuz
- :help ,(purecopy "Exercise brain with multiplication")))
- (define-key menu [life]
- `(menu-item ,(purecopy "Life") life
- :help ,(purecopy "Watch how John Conway's cellular automaton evolves")))
- (define-key menu [land]
- `(menu-item ,(purecopy "Landmark") landmark
- :help ,(purecopy "Watch a neural-network robot learn landmarks")))
- (define-key menu [hanoi]
- `(menu-item ,(purecopy "Towers of Hanoi") hanoi
- :help ,(purecopy "Watch Towers-of-Hanoi puzzle solved by Emacs")))
- (define-key menu [gomoku]
- `(menu-item ,(purecopy "Gomoku") gomoku
- :help ,(purecopy "Mark 5 contiguous squares (like tic-tac-toe)")))
- (define-key menu [bubbles]
- `(menu-item ,(purecopy "Bubbles") bubbles
- :help ,(purecopy "Remove all bubbles using the fewest moves")))
- (define-key menu [black-box]
- `(menu-item ,(purecopy "Blackbox") blackbox
- :help ,(purecopy "Find balls in a black box by shooting rays")))
- (define-key menu [adventure]
- `(menu-item ,(purecopy "Adventure") dunnet
- :help ,(purecopy "Dunnet, a text Adventure game for Emacs")))
- (define-key menu [5x5]
- `(menu-item ,(purecopy "5x5") 5x5
- :help ,(purecopy "Fill in all the squares on a 5x5 board")))
+ (bindings--define-key menu [zone]
+ '(menu-item "Zone Out" zone
+ :help "Play tricks with Emacs display when Emacs is idle"))
+ (bindings--define-key menu [tetris]
+ '(menu-item "Tetris" tetris
+ :help "Falling blocks game"))
+ (bindings--define-key menu [solitaire]
+ '(menu-item "Solitaire" solitaire
+ :help "Get rid of all the stones"))
+ (bindings--define-key menu [snake]
+ '(menu-item "Snake" snake
+ :help "Move snake around avoiding collisions"))
+ (bindings--define-key menu [pong]
+ '(menu-item "Pong" pong
+ :help "Bounce the ball to your opponent"))
+ (bindings--define-key menu [mult]
+ '(menu-item "Multiplication Puzzle" mpuz
+ :help "Exercise brain with multiplication"))
+ (bindings--define-key menu [life]
+ '(menu-item "Life" life
+ :help "Watch how John Conway's cellular automaton evolves"))
+ (bindings--define-key menu [land]
+ '(menu-item "Landmark" landmark
+ :help "Watch a neural-network robot learn landmarks"))
+ (bindings--define-key menu [hanoi]
+ '(menu-item "Towers of Hanoi" hanoi
+ :help "Watch Towers-of-Hanoi puzzle solved by Emacs"))
+ (bindings--define-key menu [gomoku]
+ '(menu-item "Gomoku" gomoku
+ :help "Mark 5 contiguous squares (like tic-tac-toe)"))
+ (bindings--define-key menu [bubbles]
+ '(menu-item "Bubbles" bubbles
+ :help "Remove all bubbles using the fewest moves"))
+ (bindings--define-key menu [black-box]
+ '(menu-item "Blackbox" blackbox
+ :help "Find balls in a black box by shooting rays"))
+ (bindings--define-key menu [adventure]
+ '(menu-item "Adventure" dunnet
+ :help "Dunnet, a text Adventure game for Emacs"))
+ (bindings--define-key menu [5x5]
+ '(menu-item "5x5" 5x5
+ :help "Fill in all the squares on a 5x5 board"))
menu))
(defvar menu-bar-encryption-decryption-menu
(let ((menu (make-sparse-keymap "Encryption/Decryption")))
- (define-key menu [insert-keys]
- `(menu-item ,(purecopy "Insert Keys") epa-insert-keys
- :help ,(purecopy "Insert public keys after the current point")))
+ (bindings--define-key menu [insert-keys]
+ '(menu-item "Insert Keys" epa-insert-keys
+ :help "Insert public keys after the current point"))
- (define-key menu [export-keys]
- `(menu-item ,(purecopy "Export Keys") epa-export-keys
- :help ,(purecopy "Export public keys to a file")))
+ (bindings--define-key menu [export-keys]
+ '(menu-item "Export Keys" epa-export-keys
+ :help "Export public keys to a file"))
- (define-key menu [import-keys-region]
- `(menu-item ,(purecopy "Import Keys from Region") epa-import-keys-region
- :help ,(purecopy "Import public keys from the current region")))
+ (bindings--define-key menu [import-keys-region]
+ '(menu-item "Import Keys from Region" epa-import-keys-region
+ :help "Import public keys from the current region"))
- (define-key menu [import-keys]
- `(menu-item ,(purecopy "Import Keys from File...") epa-import-keys
- :help ,(purecopy "Import public keys from a file")))
+ (bindings--define-key menu [import-keys]
+ '(menu-item "Import Keys from File..." epa-import-keys
+ :help "Import public keys from a file"))
- (define-key menu [list-keys]
- `(menu-item ,(purecopy "List Keys") epa-list-keys
- :help ,(purecopy "Browse your public keyring")))
+ (bindings--define-key menu [list-keys]
+ '(menu-item "List Keys" epa-list-keys
+ :help "Browse your public keyring"))
- (define-key menu [separator-keys]
+ (bindings--define-key menu [separator-keys]
menu-bar-separator)
- (define-key menu [sign-region]
- `(menu-item ,(purecopy "Sign Region") epa-sign-region
- :help ,(purecopy "Create digital signature of the current region")))
+ (bindings--define-key menu [sign-region]
+ '(menu-item "Sign Region" epa-sign-region
+ :help "Create digital signature of the current region"))
- (define-key menu [verify-region]
- `(menu-item ,(purecopy "Verify Region") epa-verify-region
- :help ,(purecopy "Verify digital signature of the current region")))
+ (bindings--define-key menu [verify-region]
+ '(menu-item "Verify Region" epa-verify-region
+ :help "Verify digital signature of the current region"))
- (define-key menu [encrypt-region]
- `(menu-item ,(purecopy "Encrypt Region") epa-encrypt-region
- :help ,(purecopy "Encrypt the current region")))
+ (bindings--define-key menu [encrypt-region]
+ '(menu-item "Encrypt Region" epa-encrypt-region
+ :help "Encrypt the current region"))
- (define-key menu [decrypt-region]
- `(menu-item ,(purecopy "Decrypt Region") epa-decrypt-region
- :help ,(purecopy "Decrypt the current region")))
+ (bindings--define-key menu [decrypt-region]
+ '(menu-item "Decrypt Region" epa-decrypt-region
+ :help "Decrypt the current region"))
- (define-key menu [separator-file]
+ (bindings--define-key menu [separator-file]
menu-bar-separator)
- (define-key menu [sign-file]
- `(menu-item ,(purecopy "Sign File...") epa-sign-file
- :help ,(purecopy "Create digital signature of a file")))
+ (bindings--define-key menu [sign-file]
+ '(menu-item "Sign File..." epa-sign-file
+ :help "Create digital signature of a file"))
- (define-key menu [verify-file]
- `(menu-item ,(purecopy "Verify File...") epa-verify-file
- :help ,(purecopy "Verify digital signature of a file")))
+ (bindings--define-key menu [verify-file]
+ '(menu-item "Verify File..." epa-verify-file
+ :help "Verify digital signature of a file"))
- (define-key menu [encrypt-file]
- `(menu-item ,(purecopy "Encrypt File...") epa-encrypt-file
- :help ,(purecopy "Encrypt a file")))
+ (bindings--define-key menu [encrypt-file]
+ '(menu-item "Encrypt File..." epa-encrypt-file
+ :help "Encrypt a file"))
- (define-key menu [decrypt-file]
- `(menu-item ,(purecopy "Decrypt File...") epa-decrypt-file
- :help ,(purecopy "Decrypt a file")))
+ (bindings--define-key menu [decrypt-file]
+ '(menu-item "Decrypt File..." epa-decrypt-file
+ :help "Decrypt a file"))
menu))
@@ -1471,102 +1444,101 @@ mail status in mode line"))
(defvar menu-bar-tools-menu
(let ((menu (make-sparse-keymap "Tools")))
- (define-key menu [games]
- `(menu-item ,(purecopy "Games") ,menu-bar-games-menu))
+ (bindings--define-key menu [games]
+ `(menu-item "Games" ,menu-bar-games-menu))
- (define-key menu [separator-games]
+ (bindings--define-key menu [separator-games]
menu-bar-separator)
- (define-key menu [encryption-decryption]
- `(menu-item ,(purecopy "Encryption/Decryption") ,menu-bar-encryption-decryption-menu))
+ (bindings--define-key menu [encryption-decryption]
+ `(menu-item "Encryption/Decryption"
+ ,menu-bar-encryption-decryption-menu))
- (define-key menu [separator-encryption-decryption]
+ (bindings--define-key menu [separator-encryption-decryption]
menu-bar-separator)
- (define-key menu [simple-calculator]
- `(menu-item ,(purecopy "Simple Calculator") calculator
- :help ,(purecopy "Invoke the Emacs built-in quick calculator")))
- (define-key menu [calc]
- `(menu-item ,(purecopy "Programmable Calculator") calc
- :help ,(purecopy "Invoke the Emacs built-in full scientific calculator")))
- (define-key menu [calendar]
- `(menu-item ,(purecopy "Calendar") calendar
- :help ,(purecopy "Invoke the Emacs built-in calendar")))
-
- (define-key menu [separator-net]
+ (bindings--define-key menu [simple-calculator]
+ '(menu-item "Simple Calculator" calculator
+ :help "Invoke the Emacs built-in quick calculator"))
+ (bindings--define-key menu [calc]
+ '(menu-item "Programmable Calculator" calc
+ :help "Invoke the Emacs built-in full scientific calculator"))
+ (bindings--define-key menu [calendar]
+ '(menu-item "Calendar" calendar
+ :help "Invoke the Emacs built-in calendar"))
+
+ (bindings--define-key menu [separator-net]
menu-bar-separator)
- (define-key menu [directory-search]
- `(menu-item ,(purecopy "Directory Search") eudc-tools-menu))
- (define-key menu [compose-mail]
- `(menu-item (format "Send Mail (with %s)" (send-mail-item-name)) compose-mail
+ (bindings--define-key menu [directory-search]
+ '(menu-item "Directory Search" eudc-tools-menu))
+ (bindings--define-key menu [compose-mail]
+ '(menu-item (format "Send Mail (with %s)" (send-mail-item-name)) compose-mail
:visible (and mail-user-agent (not (eq mail-user-agent 'ignore)))
- :help ,(purecopy "Send a mail message")))
- (define-key menu [rmail]
- `(menu-item (format "Read Mail (with %s)" (read-mail-item-name))
+ :help "Send a mail message"))
+ (bindings--define-key menu [rmail]
+ '(menu-item (format "Read Mail (with %s)" (read-mail-item-name))
menu-bar-read-mail
:visible (and read-mail-command
(not (eq read-mail-command 'ignore)))
- :help ,(purecopy "Read your mail and reply to it")))
+ :help "Read your mail and reply to it"))
- (define-key menu [gnus]
- `(menu-item ,(purecopy "Read Net News (Gnus)") gnus
- :help ,(purecopy "Read network news groups")))
+ (bindings--define-key menu [gnus]
+ '(menu-item "Read Net News (Gnus)" gnus
+ :help "Read network news groups"))
- (define-key menu [separator-vc]
+ (bindings--define-key menu [separator-vc]
menu-bar-separator)
- (define-key menu [pcl-cvs]
- `(menu-item ,(purecopy "PCL-CVS") cvs-global-menu))
- (define-key menu [vc] nil) ;Create the place for the VC menu.
+ (bindings--define-key menu [vc] nil) ;Create the place for the VC menu.
- (define-key menu [separator-compare]
+ (bindings--define-key menu [separator-compare]
menu-bar-separator)
- (define-key menu [epatch]
- `(menu-item ,(purecopy "Apply Patch") menu-bar-epatch-menu))
- (define-key menu [ediff-merge]
- `(menu-item ,(purecopy "Merge") menu-bar-ediff-merge-menu))
- (define-key menu [compare]
- `(menu-item ,(purecopy "Compare (Ediff)") menu-bar-ediff-menu))
+ (bindings--define-key menu [epatch]
+ '(menu-item "Apply Patch" menu-bar-epatch-menu))
+ (bindings--define-key menu [ediff-merge]
+ '(menu-item "Merge" menu-bar-ediff-merge-menu))
+ (bindings--define-key menu [compare]
+ '(menu-item "Compare (Ediff)" menu-bar-ediff-menu))
- (define-key menu [separator-spell]
+ (bindings--define-key menu [separator-spell]
menu-bar-separator)
- (define-key menu [spell]
- `(menu-item ,(purecopy "Spell Checking") ispell-menu-map))
+ (bindings--define-key menu [spell]
+ '(menu-item "Spell Checking" ispell-menu-map))
- (define-key menu [separator-prog]
+ (bindings--define-key menu [separator-prog]
menu-bar-separator)
- (define-key menu [semantic]
- `(menu-item ,(purecopy "Source Code Parsers (Semantic)")
+ (bindings--define-key menu [semantic]
+ '(menu-item "Source Code Parsers (Semantic)"
semantic-mode
- :help ,(purecopy "Toggle automatic parsing in source code buffers (Semantic mode)")
+ :help "Toggle automatic parsing in source code buffers (Semantic mode)"
:button (:toggle . (bound-and-true-p semantic-mode))))
- (define-key menu [ede]
- `(menu-item ,(purecopy "Project support (EDE)")
+ (bindings--define-key menu [ede]
+ '(menu-item "Project support (EDE)"
global-ede-mode
- :help ,(purecopy "Toggle the Emacs Development Environment (Global EDE mode)")
+ :help "Toggle the Emacs Development Environment (Global EDE mode)"
:button (:toggle . (bound-and-true-p global-ede-mode))))
- (define-key menu [gdb]
- `(menu-item ,(purecopy "Debugger (GDB)...") gdb
- :help ,(purecopy "Debug a program from within Emacs with GDB")))
- (define-key menu [shell-on-region]
- `(menu-item ,(purecopy "Shell Command on Region...") shell-command-on-region
+ (bindings--define-key menu [gdb]
+ '(menu-item "Debugger (GDB)..." gdb
+ :help "Debug a program from within Emacs with GDB"))
+ (bindings--define-key menu [shell-on-region]
+ '(menu-item "Shell Command on Region..." shell-command-on-region
:enable mark-active
- :help ,(purecopy "Pass marked region to a shell command")))
- (define-key menu [shell]
- `(menu-item ,(purecopy "Shell Command...") shell-command
- :help ,(purecopy "Invoke a shell command and catch its output")))
- (define-key menu [compile]
- `(menu-item ,(purecopy "Compile...") compile
- :help ,(purecopy "Invoke compiler or Make, view compilation errors")))
- (define-key menu [grep]
- `(menu-item ,(purecopy "Search Files (Grep)...") grep
- :help ,(purecopy "Search files for strings or regexps (with Grep)")))
+ :help "Pass marked region to a shell command"))
+ (bindings--define-key menu [shell]
+ '(menu-item "Shell Command..." shell-command
+ :help "Invoke a shell command and catch its output"))
+ (bindings--define-key menu [compile]
+ '(menu-item "Compile..." compile
+ :help "Invoke compiler or Make, view compilation errors"))
+ (bindings--define-key menu [grep]
+ '(menu-item "Search Files (Grep)..." grep
+ :help "Search files for strings or regexps (with Grep)"))
menu))
;; The "Help" menu items
@@ -1574,54 +1546,54 @@ mail status in mode line"))
(defvar menu-bar-describe-menu
(let ((menu (make-sparse-keymap "Describe")))
- (define-key menu [mule-diag]
- `(menu-item ,(purecopy "Show All of Mule Status") mule-diag
+ (bindings--define-key menu [mule-diag]
+ '(menu-item "Show All of Mule Status" mule-diag
:visible (default-value 'enable-multibyte-characters)
- :help ,(purecopy "Display multilingual environment settings")))
- (define-key menu [describe-coding-system-briefly]
- `(menu-item ,(purecopy "Describe Coding System (Briefly)")
+ :help "Display multilingual environment settings"))
+ (bindings--define-key menu [describe-coding-system-briefly]
+ '(menu-item "Describe Coding System (Briefly)"
describe-current-coding-system-briefly
:visible (default-value 'enable-multibyte-characters)))
- (define-key menu [describe-coding-system]
- `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system
+ (bindings--define-key menu [describe-coding-system]
+ '(menu-item "Describe Coding System..." describe-coding-system
:visible (default-value 'enable-multibyte-characters)))
- (define-key menu [describe-input-method]
- `(menu-item ,(purecopy "Describe Input Method...") describe-input-method
+ (bindings--define-key menu [describe-input-method]
+ '(menu-item "Describe Input Method..." describe-input-method
:visible (default-value 'enable-multibyte-characters)
- :help ,(purecopy "Keyboard layout for specific input method")))
- (define-key menu [describe-language-environment]
- `(menu-item ,(purecopy "Describe Language Environment")
+ :help "Keyboard layout for specific input method"))
+ (bindings--define-key menu [describe-language-environment]
+ `(menu-item "Describe Language Environment"
,describe-language-environment-map))
- (define-key menu [separator-desc-mule]
+ (bindings--define-key menu [separator-desc-mule]
menu-bar-separator)
- (define-key menu [list-keybindings]
- `(menu-item ,(purecopy "List Key Bindings") describe-bindings
- :help ,(purecopy "Display all current key bindings (keyboard shortcuts)")))
- (define-key menu [describe-current-display-table]
- `(menu-item ,(purecopy "Describe Display Table") describe-current-display-table
- :help ,(purecopy "Describe the current display table")))
- (define-key menu [describe-package]
- `(menu-item ,(purecopy "Describe Package...") describe-package
- :help ,(purecopy "Display documentation of a Lisp package")))
- (define-key menu [describe-face]
- `(menu-item ,(purecopy "Describe Face...") describe-face
- :help ,(purecopy "Display the properties of a face")))
- (define-key menu [describe-variable]
- `(menu-item ,(purecopy "Describe Variable...") describe-variable
- :help ,(purecopy "Display documentation of variable/option")))
- (define-key menu [describe-function]
- `(menu-item ,(purecopy "Describe Function...") describe-function
- :help ,(purecopy "Display documentation of function/command")))
- (define-key menu [describe-key-1]
- `(menu-item ,(purecopy "Describe Key or Mouse Operation...") describe-key
+ (bindings--define-key menu [list-keybindings]
+ '(menu-item "List Key Bindings" describe-bindings
+ :help "Display all current key bindings (keyboard shortcuts)"))
+ (bindings--define-key menu [describe-current-display-table]
+ '(menu-item "Describe Display Table" describe-current-display-table
+ :help "Describe the current display table"))
+ (bindings--define-key menu [describe-package]
+ '(menu-item "Describe Package..." describe-package
+ :help "Display documentation of a Lisp package"))
+ (bindings--define-key menu [describe-face]
+ '(menu-item "Describe Face..." describe-face
+ :help "Display the properties of a face"))
+ (bindings--define-key menu [describe-variable]
+ '(menu-item "Describe Variable..." describe-variable
+ :help "Display documentation of variable/option"))
+ (bindings--define-key menu [describe-function]
+ '(menu-item "Describe Function..." describe-function
+ :help "Display documentation of function/command"))
+ (bindings--define-key menu [describe-key-1]
+ '(menu-item "Describe Key or Mouse Operation..." describe-key
;; Users typically don't identify keys and menu items...
- :help ,(purecopy "Display documentation of command bound to a \
-key, a click, or a menu-item")))
- (define-key menu [describe-mode]
- `(menu-item ,(purecopy "Describe Buffer Modes") describe-mode
- :help ,(purecopy "Describe this buffer's major and minor mode")))
+ :help "Display documentation of command bound to a \
+key, a click, or a menu-item"))
+ (bindings--define-key menu [describe-mode]
+ '(menu-item "Describe Buffer Modes" describe-mode
+ :help "Describe this buffer's major and minor mode"))
menu))
(defun menu-bar-read-lispref ()
@@ -1654,64 +1626,64 @@ key, a click, or a menu-item")))
(defvar menu-bar-search-documentation-menu
(let ((menu (make-sparse-keymap "Search Documentation")))
- (define-key menu [search-documentation-strings]
- `(menu-item ,(purecopy "Search Documentation Strings...") apropos-documentation
+ (bindings--define-key menu [search-documentation-strings]
+ '(menu-item "Search Documentation Strings..." apropos-documentation
:help
- ,(purecopy "Find functions and variables whose doc strings match a regexp")))
- (define-key menu [find-any-object-by-name]
- `(menu-item ,(purecopy "Find Any Object by Name...") apropos
- :help ,(purecopy "Find symbols of any kind whose names match a regexp")))
- (define-key menu [find-option-by-value]
- `(menu-item ,(purecopy "Find Options by Value...") apropos-value
- :help ,(purecopy "Find variables whose values match a regexp")))
- (define-key menu [find-options-by-name]
- `(menu-item ,(purecopy "Find Options by Name...") apropos-variable
- :help ,(purecopy "Find variables whose names match a regexp")))
- (define-key menu [find-commands-by-name]
- `(menu-item ,(purecopy "Find Commands by Name...") apropos-command
- :help ,(purecopy "Find commands whose names match a regexp")))
- (define-key menu [sep1]
+ "Find functions and variables whose doc strings match a regexp"))
+ (bindings--define-key menu [find-any-object-by-name]
+ '(menu-item "Find Any Object by Name..." apropos
+ :help "Find symbols of any kind whose names match a regexp"))
+ (bindings--define-key menu [find-option-by-value]
+ '(menu-item "Find Options by Value..." apropos-value
+ :help "Find variables whose values match a regexp"))
+ (bindings--define-key menu [find-options-by-name]
+ '(menu-item "Find Options by Name..." apropos-variable
+ :help "Find variables whose names match a regexp"))
+ (bindings--define-key menu [find-commands-by-name]
+ '(menu-item "Find Commands by Name..." apropos-command
+ :help "Find commands whose names match a regexp"))
+ (bindings--define-key menu [sep1]
menu-bar-separator)
- (define-key menu [lookup-command-in-manual]
- `(menu-item ,(purecopy "Look Up Command in User Manual...") Info-goto-emacs-command-node
- :help ,(purecopy "Display manual section that describes a command")))
- (define-key menu [lookup-key-in-manual]
- `(menu-item ,(purecopy "Look Up Key in User Manual...") Info-goto-emacs-key-command-node
- :help ,(purecopy "Display manual section that describes a key")))
- (define-key menu [lookup-subject-in-elisp-manual]
- `(menu-item ,(purecopy "Look Up Subject in ELisp Manual...") elisp-index-search
- :help ,(purecopy "Find description of a subject in Emacs Lisp manual")))
- (define-key menu [lookup-subject-in-emacs-manual]
- `(menu-item ,(purecopy "Look Up Subject in User Manual...") emacs-index-search
- :help ,(purecopy "Find description of a subject in Emacs User manual")))
- (define-key menu [emacs-terminology]
- `(menu-item ,(purecopy "Emacs Terminology") search-emacs-glossary
- :help ,(purecopy "Display the Glossary section of the Emacs manual")))
+ (bindings--define-key menu [lookup-command-in-manual]
+ '(menu-item "Look Up Command in User Manual..." Info-goto-emacs-command-node
+ :help "Display manual section that describes a command"))
+ (bindings--define-key menu [lookup-key-in-manual]
+ '(menu-item "Look Up Key in User Manual..." Info-goto-emacs-key-command-node
+ :help "Display manual section that describes a key"))
+ (bindings--define-key menu [lookup-subject-in-elisp-manual]
+ '(menu-item "Look Up Subject in ELisp Manual..." elisp-index-search
+ :help "Find description of a subject in Emacs Lisp manual"))
+ (bindings--define-key menu [lookup-subject-in-emacs-manual]
+ '(menu-item "Look Up Subject in User Manual..." emacs-index-search
+ :help "Find description of a subject in Emacs User manual"))
+ (bindings--define-key menu [emacs-terminology]
+ '(menu-item "Emacs Terminology" search-emacs-glossary
+ :help "Display the Glossary section of the Emacs manual"))
menu))
(defvar menu-bar-manuals-menu
(let ((menu (make-sparse-keymap "More Manuals")))
- (define-key menu [man]
- `(menu-item ,(purecopy "Read Man Page...") manual-entry
- :help ,(purecopy "Man-page docs for external commands and libraries")))
- (define-key menu [sep2]
+ (bindings--define-key menu [man]
+ '(menu-item "Read Man Page..." manual-entry
+ :help "Man-page docs for external commands and libraries"))
+ (bindings--define-key menu [sep2]
menu-bar-separator)
- (define-key menu [order-emacs-manuals]
- `(menu-item ,(purecopy "Ordering Manuals") view-order-manuals
- :help ,(purecopy "How to order manuals from the Free Software Foundation")))
- (define-key menu [lookup-subject-in-all-manuals]
- `(menu-item ,(purecopy "Lookup Subject in all Manuals...") info-apropos
- :help ,(purecopy "Find description of a subject in all installed manuals")))
- (define-key menu [other-manuals]
- `(menu-item ,(purecopy "All Other Manuals (Info)") Info-directory
- :help ,(purecopy "Read any of the installed manuals")))
- (define-key menu [emacs-lisp-reference]
- `(menu-item ,(purecopy "Emacs Lisp Reference") menu-bar-read-lispref
- :help ,(purecopy "Read the Emacs Lisp Reference manual")))
- (define-key menu [emacs-lisp-intro]
- `(menu-item ,(purecopy "Introduction to Emacs Lisp") menu-bar-read-lispintro
- :help ,(purecopy "Read the Introduction to Emacs Lisp Programming")))
+ (bindings--define-key menu [order-emacs-manuals]
+ '(menu-item "Ordering Manuals" view-order-manuals
+ :help "How to order manuals from the Free Software Foundation"))
+ (bindings--define-key menu [lookup-subject-in-all-manuals]
+ '(menu-item "Lookup Subject in all Manuals..." info-apropos
+ :help "Find description of a subject in all installed manuals"))
+ (bindings--define-key menu [other-manuals]
+ '(menu-item "All Other Manuals (Info)" Info-directory
+ :help "Read any of the installed manuals"))
+ (bindings--define-key menu [emacs-lisp-reference]
+ '(menu-item "Emacs Lisp Reference" menu-bar-read-lispref
+ :help "Read the Emacs Lisp Reference manual"))
+ (bindings--define-key menu [emacs-lisp-intro]
+ '(menu-item "Introduction to Emacs Lisp" menu-bar-read-lispintro
+ :help "Read the Introduction to Emacs Lisp Programming"))
menu))
(defun menu-bar-help-extra-packages ()
@@ -1729,91 +1701,94 @@ key, a click, or a menu-item")))
(defvar menu-bar-help-menu
(let ((menu (make-sparse-keymap "Help")))
- (define-key menu [about-gnu-project]
- `(menu-item ,(purecopy "About GNU") describe-gnu-project
- :help ,(purecopy "About the GNU System, GNU Project, and GNU/Linux")))
- (define-key menu [about-emacs]
- `(menu-item ,(purecopy "About Emacs") about-emacs
- :help ,(purecopy "Display version number, copyright info, and basic help")))
- (define-key menu [sep4]
+ (bindings--define-key menu [about-gnu-project]
+ '(menu-item "About GNU" describe-gnu-project
+ :help "About the GNU System, GNU Project, and GNU/Linux"))
+ (bindings--define-key menu [about-emacs]
+ '(menu-item "About Emacs" about-emacs
+ :help "Display version number, copyright info, and basic help"))
+ (bindings--define-key menu [sep4]
menu-bar-separator)
- (define-key menu [describe-no-warranty]
- `(menu-item ,(purecopy "(Non)Warranty") describe-no-warranty
- :help ,(purecopy "Explain that Emacs has NO WARRANTY")))
- (define-key menu [describe-copying]
- `(menu-item ,(purecopy "Copying Conditions") describe-copying
- :help ,(purecopy "Show the Emacs license (GPL)")))
- (define-key menu [getting-new-versions]
- `(menu-item ,(purecopy "Getting New Versions") describe-distribution
- :help ,(purecopy "How to get the latest version of Emacs")))
- (define-key menu [sep2]
+ (bindings--define-key menu [describe-no-warranty]
+ '(menu-item "(Non)Warranty" describe-no-warranty
+ :help "Explain that Emacs has NO WARRANTY"))
+ (bindings--define-key menu [describe-copying]
+ '(menu-item "Copying Conditions" describe-copying
+ :help "Show the Emacs license (GPL)"))
+ (bindings--define-key menu [getting-new-versions]
+ '(menu-item "Getting New Versions" describe-distribution
+ :help "How to get the latest version of Emacs"))
+ (bindings--define-key menu [sep2]
menu-bar-separator)
- (define-key menu [external-packages]
- `(menu-item ,(purecopy "Finding Extra Packages") menu-bar-help-extra-packages
- :help ,(purecopy "Lisp packages distributed separately for use in Emacs")))
- (define-key menu [find-emacs-packages]
- `(menu-item ,(purecopy "Search Built-in Packages") finder-by-keyword
- :help ,(purecopy "Find built-in packages and features by keyword")))
- (define-key menu [more-manuals]
- `(menu-item ,(purecopy "More Manuals") ,menu-bar-manuals-menu))
- (define-key menu [emacs-manual]
- `(menu-item ,(purecopy "Read the Emacs Manual") info-emacs-manual
- :help ,(purecopy "Full documentation of Emacs features")))
- (define-key menu [describe]
- `(menu-item ,(purecopy "Describe") ,menu-bar-describe-menu))
- (define-key menu [search-documentation]
- `(menu-item ,(purecopy "Search Documentation") ,menu-bar-search-documentation-menu))
- (define-key menu [sep1]
+ (bindings--define-key menu [external-packages]
+ '(menu-item "Finding Extra Packages" menu-bar-help-extra-packages
+ :help "Lisp packages distributed separately for use in Emacs"))
+ (bindings--define-key menu [find-emacs-packages]
+ '(menu-item "Search Built-in Packages" finder-by-keyword
+ :help "Find built-in packages and features by keyword"))
+ (bindings--define-key menu [more-manuals]
+ `(menu-item "More Manuals" ,menu-bar-manuals-menu))
+ (bindings--define-key menu [emacs-manual]
+ '(menu-item "Read the Emacs Manual" info-emacs-manual
+ :help "Full documentation of Emacs features"))
+ (bindings--define-key menu [describe]
+ `(menu-item "Describe" ,menu-bar-describe-menu))
+ (bindings--define-key menu [search-documentation]
+ `(menu-item "Search Documentation" ,menu-bar-search-documentation-menu))
+ (bindings--define-key menu [sep1]
menu-bar-separator)
- (define-key menu [emacs-psychotherapist]
- `(menu-item ,(purecopy "Emacs Psychotherapist") doctor
- :help ,(purecopy "Our doctor will help you feel better")))
- (define-key menu [send-emacs-bug-report]
- `(menu-item ,(purecopy "Send Bug Report...") report-emacs-bug
- :help ,(purecopy "Send e-mail to Emacs maintainers")))
- (define-key menu [emacs-known-problems]
- `(menu-item ,(purecopy "Emacs Known Problems") view-emacs-problems
- :help ,(purecopy "Read about known problems with Emacs")))
- (define-key menu [emacs-news]
- `(menu-item ,(purecopy "Emacs News") view-emacs-news
- :help ,(purecopy "New features of this version")))
- (define-key menu [emacs-faq]
- `(menu-item ,(purecopy "Emacs FAQ") view-emacs-FAQ
- :help ,(purecopy "Frequently asked (and answered) questions about Emacs")))
-
- (define-key menu [emacs-tutorial-language-specific]
- `(menu-item ,(purecopy "Emacs Tutorial (choose language)...")
+ (bindings--define-key menu [emacs-psychotherapist]
+ '(menu-item "Emacs Psychotherapist" doctor
+ :help "Our doctor will help you feel better"))
+ (bindings--define-key menu [send-emacs-bug-report]
+ '(menu-item "Send Bug Report..." report-emacs-bug
+ :help "Send e-mail to Emacs maintainers"))
+ (bindings--define-key menu [emacs-manual-bug]
+ '(menu-item "How to Report a Bug" info-emacs-bug
+ :help "Read about how to report an Emacs bug"))
+ (bindings--define-key menu [emacs-known-problems]
+ '(menu-item "Emacs Known Problems" view-emacs-problems
+ :help "Read about known problems with Emacs"))
+ (bindings--define-key menu [emacs-news]
+ '(menu-item "Emacs News" view-emacs-news
+ :help "New features of this version"))
+ (bindings--define-key menu [emacs-faq]
+ '(menu-item "Emacs FAQ" view-emacs-FAQ
+ :help "Frequently asked (and answered) questions about Emacs"))
+
+ (bindings--define-key menu [emacs-tutorial-language-specific]
+ '(menu-item "Emacs Tutorial (choose language)..."
help-with-tutorial-spec-language
- :help ,(purecopy "Learn how to use Emacs (choose a language)")))
- (define-key menu [emacs-tutorial]
- `(menu-item ,(purecopy "Emacs Tutorial") help-with-tutorial
- :help ,(purecopy "Learn how to use Emacs")))
+ :help "Learn how to use Emacs (choose a language)"))
+ (bindings--define-key menu [emacs-tutorial]
+ '(menu-item "Emacs Tutorial" help-with-tutorial
+ :help "Learn how to use Emacs"))
;; In OS X it's in the app menu already.
;; FIXME? There already is an "About Emacs" (sans ...) entry in the Help menu.
(and (featurep 'ns)
(not (eq system-type 'darwin))
- (define-key menu [info-panel]
- `(menu-item ,(purecopy "About Emacs...") ns-do-emacs-info-panel)))
+ (bindings--define-key menu [info-panel]
+ '(menu-item "About Emacs..." ns-do-emacs-info-panel)))
menu))
-(define-key global-map [menu-bar tools]
- (cons (purecopy "Tools") menu-bar-tools-menu))
-(define-key global-map [menu-bar buffer]
- (cons (purecopy "Buffers") global-buffers-menu-map))
-(define-key global-map [menu-bar options]
- (cons (purecopy "Options") menu-bar-options-menu))
-(define-key global-map [menu-bar edit]
- (cons (purecopy "Edit") menu-bar-edit-menu))
-(define-key global-map [menu-bar file]
- (cons (purecopy "File") menu-bar-file-menu))
+(bindings--define-key global-map [menu-bar tools]
+ (cons "Tools" menu-bar-tools-menu))
+(bindings--define-key global-map [menu-bar buffer]
+ (cons "Buffers" global-buffers-menu-map))
+(bindings--define-key global-map [menu-bar options]
+ (cons "Options" menu-bar-options-menu))
+(bindings--define-key global-map [menu-bar edit]
+ (cons "Edit" menu-bar-edit-menu))
+(bindings--define-key global-map [menu-bar file]
+ (cons "File" menu-bar-file-menu))
;; Put "Help" menu at the end, or Info at the front.
;; If running under GNUstep, "Help" is moved and renamed "Info" (see below).
(if (and (featurep 'ns)
(not (eq system-type 'darwin)))
- (define-key global-map [menu-bar help-menu]
- (cons (purecopy "Info") menu-bar-help-menu))
+ (bindings--define-key global-map [menu-bar help-menu]
+ (cons "Info" menu-bar-help-menu))
(define-key-after global-map [menu-bar help-menu]
(cons (purecopy "Help") menu-bar-help-menu)))
@@ -1837,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."
@@ -2133,40 +2113,40 @@ It must accept a buffer as its only required argument.")
;; This shouldn't be necessary, but there's a funny
;; bug in keymap.c that I don't understand yet. -stef
minibuffer-local-completion-map))
- (define-key map [menu-bar minibuf]
- (cons (purecopy "Minibuf") (make-sparse-keymap "Minibuf"))))
+ (bindings--define-key map [menu-bar minibuf]
+ (cons "Minibuf" (make-sparse-keymap "Minibuf"))))
(let ((map minibuffer-local-completion-map))
- (define-key map [menu-bar minibuf ?\?]
- `(menu-item ,(purecopy "List Completions") minibuffer-completion-help
- :help ,(purecopy "Display all possible completions")))
- (define-key map [menu-bar minibuf space]
- `(menu-item ,(purecopy "Complete Word") minibuffer-complete-word
- :help ,(purecopy "Complete at most one word")))
- (define-key map [menu-bar minibuf tab]
- `(menu-item ,(purecopy "Complete") minibuffer-complete
- :help ,(purecopy "Complete as far as possible"))))
+ (bindings--define-key map [menu-bar minibuf ?\?]
+ '(menu-item "List Completions" minibuffer-completion-help
+ :help "Display all possible completions"))
+ (bindings--define-key map [menu-bar minibuf space]
+ '(menu-item "Complete Word" minibuffer-complete-word
+ :help "Complete at most one word"))
+ (bindings--define-key map [menu-bar minibuf tab]
+ '(menu-item "Complete" minibuffer-complete
+ :help "Complete as far as possible")))
(let ((map minibuffer-local-map))
- (define-key map [menu-bar minibuf quit]
- `(menu-item ,(purecopy "Quit") abort-recursive-edit
- :help ,(purecopy "Abort input and exit minibuffer")))
- (define-key map [menu-bar minibuf return]
- `(menu-item ,(purecopy "Enter") exit-minibuffer
- :key-sequence ,(purecopy "\r")
- :help ,(purecopy "Terminate input and exit minibuffer")))
- (define-key map [menu-bar minibuf isearch-forward]
- `(menu-item ,(purecopy "Isearch History Forward") isearch-forward
- :help ,(purecopy "Incrementally search minibuffer history forward")))
- (define-key map [menu-bar minibuf isearch-backward]
- `(menu-item ,(purecopy "Isearch History Backward") isearch-backward
- :help ,(purecopy "Incrementally search minibuffer history backward")))
- (define-key map [menu-bar minibuf next]
- `(menu-item ,(purecopy "Next History Item") next-history-element
- :help ,(purecopy "Put next minibuffer history element in the minibuffer")))
- (define-key map [menu-bar minibuf previous]
- `(menu-item ,(purecopy "Previous History Item") previous-history-element
- :help ,(purecopy "Put previous minibuffer history element in the minibuffer"))))
+ (bindings--define-key map [menu-bar minibuf quit]
+ '(menu-item "Quit" abort-recursive-edit
+ :help "Abort input and exit minibuffer"))
+ (bindings--define-key map [menu-bar minibuf return]
+ '(menu-item "Enter" exit-minibuffer
+ :key-sequence "\r"
+ :help "Terminate input and exit minibuffer"))
+ (bindings--define-key map [menu-bar minibuf isearch-forward]
+ '(menu-item "Isearch History Forward" isearch-forward
+ :help "Incrementally search minibuffer history forward"))
+ (bindings--define-key map [menu-bar minibuf isearch-backward]
+ '(menu-item "Isearch History Backward" isearch-backward
+ :help "Incrementally search minibuffer history backward"))
+ (bindings--define-key map [menu-bar minibuf next]
+ '(menu-item "Next History Item" next-history-element
+ :help "Put next minibuffer history element in the minibuffer"))
+ (bindings--define-key map [menu-bar minibuf previous]
+ '(menu-item "Previous History Item" previous-history-element
+ :help "Put previous minibuffer history element in the minibuffer")))
(define-minor-mode menu-bar-mode
"Toggle display of a menu bar on each frame (Menu Bar mode).
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index 8bb1659a1c0..94ecfa138fe 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -13,6 +13,19 @@
calling mh-regexp-in-field-p.
(closes SF #1708292)
+2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mh-letter.el (mh-yank-hooks): Use make-obsolete-variable.
+
+2012-04-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mh-utils.el (minibuffer-completing-file-name): Don't declare, unused.
+
+2012-04-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * mh-folder.el (top): Check whether which-func-modes is t before
+ adding mh-folder-mode.
+
2012-01-07 Jeffrey C Honig <jch@honig.net>
* mh-e.el (mh-invisible-header-fields-internal): Added: X-xsi.
@@ -151,7 +164,7 @@
pop-to-buffer-same-window.
* mh-folder.el (mh-inc-folder, mh-modify, mh-scan-folder)
(mh-make-folder): Call mh-pop-to-buffer-same-window instead of
- switch-to-buffer. The previous change which used pop-to-buffer
+ switch-to-buffer. The previous change which used pop-to-buffer
produced the wrong behavior.
2011-07-12 Henrique Martins <henrique@martins.cc> (tiny change)
@@ -172,8 +185,8 @@
* mh-folder.el (mh-inc-folder, mh-modify, mh-scan-folder)
(mh-make-folder): Replace calls to switch-to-buffer with of
- pop-to-buffer. The former is intended for interactive use only and
- generates warnings in Emacs 24.
+ pop-to-buffer. The former is intended for interactive use only
+ and generates warnings in Emacs 24.
2011-07-09 Bill Wohler <wohler@newt.com>
@@ -195,7 +208,7 @@
* mh-e.el: Just require mh-loaddefs since loading it in an
eval-and-compile block causes compilation errors in XEmacs.
- * mh-acros.el, mh-comp.el, mh-e.el, mh-folder.el, mh-letter.el:
+ * mh-acros.el, mh-comp.el, mh-e.el, mh-folder.el, mh-letter.el:
* mh-mime.el, mh-search.el, mh-seq.el: Shush XEmacs compiler in
mh-do-in-xemacs block.
@@ -206,7 +219,7 @@
* mh-letter.el (mh-letter-mode-map, mh-letter-complete)
(mh-complete-word): Remove FIXME comments since these functions
- are still needed in other Emacsen. However, they can probably
+ are still needed in other Emacsen. However, they can probably
stand to be generalized like completion-at-point.
(mh-letter-complete-or-space): Remove unused variable.
@@ -272,9 +285,9 @@
2010-05-14 Peter S Galbraith <psg@debian.org>
* mh-mime.el (mh-decode-message-subject): New function to decode
- RFC2047 encoded Subject lines. Used for reply drafts.
- * mh-comp.el (mh-compose-and-send-mail): Call
- `mh-decode-message-subject' on (reply or forward) message drafts.
+ RFC2047 encoded Subject lines. Used for reply drafts.
+ * mh-comp.el (mh-compose-and-send-mail):
+ Call `mh-decode-message-subject' on (reply or forward) message drafts.
2010-05-07 Chong Yidong <cyd@stupidchicken.com>
@@ -447,8 +460,8 @@
* mh-show.el (mh-show-preferred-alternative)
* mh-e.el (mh-annotate-msg-hook): Sync docstring with manual.
- * mh-comp.el (mh-send-letter, mh-redistribute): Mention
- mh-annotate-msg-hook in docstring.
+ * mh-comp.el (mh-send-letter, mh-redistribute):
+ Mention mh-annotate-msg-hook in docstring.
2008-06-29 Jeffrey C Honig <jch@honig.net>
@@ -498,8 +511,8 @@
2008-05-23 Bill Wohler <wohler@newt.com>
- * mh-e.el (mh-invisible-header-fields-internal): Remove
- DKIM-Signature as it is covered by DKIM-. Fully qualify X-EID.
+ * mh-e.el (mh-invisible-header-fields-internal):
+ Remove DKIM-Signature as it is covered by DKIM-. Fully qualify X-EID.
2008-05-19 Sergey Poznyakoff <gray@gnu.org.ua>
@@ -582,8 +595,8 @@
2007-08-21 Jeffrey C Honig <jch@honig.net>
- * mh-folder.el (mh-folder-message-menu, mh-folder-mode-map): Add
- folder mode support for mh-show-preferred-alternative (closes SF
+ * mh-folder.el (mh-folder-message-menu, mh-folder-mode-map):
+ Add folder mode support for mh-show-preferred-alternative (closes SF
#1777321).
* mh-show.el (mh-show-preferred-alternative)
@@ -594,8 +607,8 @@
HTML when text content is lacking (closes SF #1777321).
* mh-e.el:
- (mh-invisible-header-fields-internal): Exclude Fax and Phone. Put
- known exclusions as comments before the list and move parens to
+ (mh-invisible-header-fields-internal): Exclude Fax and Phone.
+ Put known exclusions as comments before the list and move parens to
separate lines to aid in sorting (closes SF #1701231).
* mh-mime.el (mm-decode-body): Remove explicit autoload of
@@ -844,16 +857,16 @@
(mh-tool-bar-folder-buttons-set, mh-tool-bar-letter-buttons-set):
Call it (closes SF #1452718).
- * mh-folder.el (mh-folder-buttons-init-flag): Delete. Use
- mh-folder-tool-bar-map instead.
+ * mh-folder.el (mh-folder-buttons-init-flag): Delete.
+ Use mh-folder-tool-bar-map instead.
(image-load-path): Delete. No longer used.
- (mh-folder-mode): Moved setting of image-load-path into
+ (mh-folder-mode): Move setting of image-load-path into
mh-tool-bar-folder-buttons-init.
- * mh-letter.el (mh-letter-buttons-init-flag): Delete. Use
- mh-letter-tool-bar-map instead.
+ * mh-letter.el (mh-letter-buttons-init-flag): Delete.
+ Use mh-letter-tool-bar-map instead.
(image-load-path): Delete. No longer used.
- (mh-letter-mode): Moved setting of image-load-path into
+ (mh-letter-mode): Move setting of image-load-path into
mh-tool-bar-letter-buttons-init.
* mh-seq.el (mh-narrow-to-seq, mh-widen): Use with-current-buffer
@@ -1101,8 +1114,8 @@
(mh-print-background-flag, mh-show-maximum-size)
(mh-show-use-xface-flag, mh-store-default-directory)
(mh-summary-height, mh-speed-update-interval)
- (mh-show-threads-flag, mh-tool-bar-search-function): Add
- :package-version keyword to these options (closes SF #1452724).
+ (mh-show-threads-flag, mh-tool-bar-search-function):
+ Add :package-version keyword to these options (closes SF #1452724).
(mh-after-commands-processed-hook)
(mh-alias-reloaded-hook, mh-before-commands-processed-hook)
(mh-before-quit-hook, mh-before-send-letter-hook)
@@ -1129,15 +1142,15 @@
(mh-speedbar-selected-folder-with-unseen-messages): : Add
:package-version keyword to these faces (closes SF #1452724).
- * mh-tool-bar.el (mh-tool-bar-define): Added commented-out
+ * mh-tool-bar.el (mh-tool-bar-define): Add commented-out
:package-version keywords (closes SF #1452724).
2006-03-28 Bill Wohler <wohler@newt.com>
* mh-tool-bar.el: Use clipboard-kill-region,
clipboard-kill-ring-save, and clipboard-yank instead of undo,
- kill-region, and menu-bar-kill-ring-save respectively. In
- MH-Letter mode, move save-buffer and mh-fully-kill-draft icons in
+ kill-region, and menu-bar-kill-ring-save respectively.
+ In MH-Letter mode, move save-buffer and mh-fully-kill-draft icons in
front of mh-compose-insertion to be consistent with other mailers,
such as Evolution. In MH-Folder mode, move vanilla reply icon to
the left of the other reply icons. Use mail/inbox icon instead of
@@ -1193,8 +1206,8 @@
2006-03-14 Bill Wohler <wohler@newt.com>
- * mh-compat.el (mh-image-load-path-for-library): Incorporate
- changes from image-load-path-for-library, which are:
+ * mh-compat.el (mh-image-load-path-for-library):
+ Incorporate changes from image-load-path-for-library, which are:
(image-load-path-for-library): Pass value of path rather than
symbol. Always return list of directories. Guarantee that image
directory comes first.
@@ -1220,8 +1233,8 @@
flag to replace-in-string. This was badly needed by
mh-quote-pick-expr in order to properly quote subjects when using
/ s on XEmacs (closes SF #1447598).
- (mh-image-load-path-for-library): Merged changes from Reiner. Add
- no-error argument. If path t, just return directory.
+ (mh-image-load-path-for-library): Merged changes from Reiner.
+ Add no-error argument. If path t, just return directory.
* mh-e.el (mh-profile-component): Drop `s' from mhparam
-components for Mailutils compatibility (closes SF #1446985).
@@ -1279,8 +1292,8 @@
local variable mh-image-directory to image-directory. Move error
checks to default case in cond and simplify.
- * mh-comp.el (mh-send-letter, mh-insert-auto-fields): Sync
- docstrings with manual.
+ * mh-comp.el (mh-send-letter, mh-insert-auto-fields):
+ Sync docstrings with manual.
2006-03-02 Bill Wohler <wohler@newt.com>
@@ -1306,8 +1319,8 @@
* mh-utils.el (mh-image-directory)
(mh-image-load-path-called-flag): Delete.
- (mh-image-load-path): Incorporate changes from Gnus team. Biggest
- changes are that it no longer uses/sets mh-image-directory or
+ (mh-image-load-path): Incorporate changes from Gnus team.
+ Biggest changes are that it no longer uses/sets mh-image-directory or
mh-image-load-path-called-flag, and returns the updated path
rather than change it.
(mh-logo-display): Change usage of mh-image-load-path.
@@ -1372,8 +1385,8 @@
goto-addr.el.
(mh-alias-suggest-alias): Use goto-address-mail-regexp instead of
mh-address-mail-regexp.
- (mh-alias-add-address-under-point): Use
- goto-address-find-address-at-point instead of
+ (mh-alias-add-address-under-point):
+ Use goto-address-find-address-at-point instead of
mh-goto-address-find-address-at-point.
* mh-e.el (mh-show-use-goto-addr-flag): Delete.
@@ -1454,7 +1467,7 @@
2006-02-08 Peter S Galbraith <psg@debian.org>
- * mh-e.el (mh-invisible-header-fields-internal): Added entries
+ * mh-e.el (mh-invisible-header-fields-internal): Add entries
"X-BrightmailFiltered:", "X-Brightmail-Tracker:" and "X-Hashcash".
2006-02-04 Bill Wohler <wohler@newt.com>
@@ -1523,17 +1536,17 @@
* mh-search.el (which-func-mode): Shush compiler on Emacs 21 too.
- * mh-alias.el (mh-alias-gecos-name): Use
- mh-replace-regexp-in-string instead of replace-regexp-in-string.
+ * mh-alias.el (mh-alias-gecos-name):
+ Use mh-replace-regexp-in-string instead of replace-regexp-in-string.
(crm, multi-prompt): Use mh-require instead of require.
- (mh-goto-address-find-address-at-point): Use
- mh-line-beginning-position and mh-line-end-position instead of
- line-beginning-position and line-end-position. Use
- mh-match-string-no-properties instead of
+ (mh-goto-address-find-address-at-point):
+ Use mh-line-beginning-position and mh-line-end-position instead of
+ line-beginning-position and line-end-position.
+ Use mh-match-string-no-properties instead of
match-string-no-properties.
- * mh-comp.el (mh-modify-header-field): Use
- mh-line-beginning-position and mh-line-end-position instead of
+ * mh-comp.el (mh-modify-header-field):
+ Use mh-line-beginning-position and mh-line-end-position instead of
line-beginning-position and line-end-position.
* mh-compat.el (mailabbrev): Use mh-require instead of require.
@@ -1568,16 +1581,16 @@
mh-line-end-position instead of line-beginning-position and
line-end-position.
- * mh-limit.el (mh-subject-to-sequence-unthreaded): Use
- mh-match-string-no-properties instead of
+ * mh-limit.el (mh-subject-to-sequence-unthreaded):
+ Use mh-match-string-no-properties instead of
match-string-no-properties.
(mh-narrow-to-header-field): Use mh-line-beginning-position and
mh-line-end-position instead of line-beginning-position and
line-end-position.
* mh-mime.el (mh-mime-inline-part, mh-mm-display-part)
- (mh-mh-quote-unescaped-sharp, mh-mh-directive-present-p): Use
- mh-line-beginning-position and mh-line-end-position instead of
+ (mh-mh-quote-unescaped-sharp, mh-mh-directive-present-p):
+ Use mh-line-beginning-position and mh-line-end-position instead of
line-beginning-position and line-end-position.
* mh-search.el (which-func): Use mh-require instead of require.
@@ -1586,8 +1599,8 @@
(mh-mairix-next-result, mh-namazu-next-result)
(mh-pick-next-result, mh-grep-next-result)
(mh-index-create-imenu-index, mh-index-match-checksum)
- (mh-md5sum-parser, mh-openssl-parser, mh-index-update-maps): Use
- mh-line-beginning-position and mh-line-end-position instead of
+ (mh-md5sum-parser, mh-openssl-parser, mh-index-update-maps):
+ Use mh-line-beginning-position and mh-line-end-position instead of
line-beginning-position and line-end-position.
* mh-seq.el (mh-list-sequences): Use mh-view-mode-enter instead of
@@ -1610,8 +1623,8 @@
(mh-speed-flists): Use mh-cancel-timer instead of cancel-timer.
* mh-thread.el (mh-thread-find-children)
- (mh-thread-parse-scan-line, mh-thread-generate): Use
- mh-line-beginning-position and mh-line-end-position instead of
+ (mh-thread-parse-scan-line, mh-thread-generate):
+ Use mh-line-beginning-position and mh-line-end-position instead of
line-beginning-position and line-end-position.
* mh-utils.el (mh-colors-available-p): Use mh-display-color-cells
@@ -1832,8 +1845,8 @@
(mh-letter-header-field-regexp, mh-pgp-support-flag)
(mh-x-mailer-string): Move here from mh-comp.el.
(mh-folder-line-matches-show-buffer-p): Move to mh-alias.el.
- (mh-thread-scan-line-map, mh-thread-scan-line-map-stack): Move
- here from mh-seq.el.
+ (mh-thread-scan-line-map, mh-thread-scan-line-map-stack):
+ Move here from mh-seq.el.
(mh-draft-folder, mh-inbox, mh-user-path, mh-current-folder)
(mh-previous-window-config, mh-seen-list, mh-seq-list)
(mh-show-buffer, mh-showing-mode, mh-globals-hash)
@@ -2136,10 +2149,10 @@
(mh-show-mouse, mh-modify, mh-goto-msg, mh-set-folder-modified-p):
Move to new file mh-folder.el.
(with-mh-folder-updating, mh-in-show-buffer)
- (mh-do-at-event-location, mh-seq-msgs): Moved to mh-acros.el.
+ (mh-do-at-event-location, mh-seq-msgs): Move to mh-acros.el.
(mh-make-seq, mh-seq-name, mh-notate, mh-find-seq)
(mh-seq-to-msgs, mh-add-msgs-to-seq, mh-canonicalize-sequence):
- Moved to mh-seq.el.
+ Move to mh-seq.el.
(mh-show-xface-function, mh-uncompface-executable, mh-face-to-png)
(mh-uncompface, mh-icontopbm, mh-face-foreground-compat)
(mh-face-background-compat, mh-face-display-function)
@@ -2164,8 +2177,8 @@
mh-init.el.
(mh-help-messages): Now an alist of modes to an alist of messages.
(mh-set-help): New function used to set mh-help-messages.
- (mh-help): Adjust for new format of mh-help-messages. Add
- help-messages argument.
+ (mh-help): Adjust for new format of mh-help-messages.
+ Add help-messages argument.
(mh-prefix-help): Refactor to use mh-help.
(mh-coalesce-msg-list, mh-greaterp, mh-lessp): Move here from
mh-e.el.
@@ -2296,8 +2309,8 @@
(mh-search-mode-map): Autoload so that keys are shown in help even
before mh-search is loaded.
(mh-search-mode): Sync docstring with manual.
- (mh-index-do-search): Rename argument indexer to searcher. Sync
- docstring with manual.
+ (mh-index-do-search): Rename argument indexer to searcher.
+ Sync docstring with manual.
(mh-pick-do-search): Sync docstring with manual.
(mh-index-p): Rename to mh-search-p.
(mh-indexer-choices): Rename to mh-search-choices.
@@ -2314,7 +2327,7 @@
2006-01-13 Bill Wohler <wohler@newt.com>
- * mh-acros.el (require): Added Satyaki's comment regarding what
+ * mh-acros.el (require): Add Satyaki's comment regarding what
needs to happen to remove this defadvice which caused a little
discussion on emacs-devel today (see Subject: mh-e/mh-acros.el
advices `require' incorrectly).
@@ -2386,8 +2399,8 @@
* mh-gnus.el: Require mh-acros.
(mh-defmacro-compat, mh-defun-compat): Move to mh-acros.el.
- * mh-utils.el (mh-x-image-url-cache-canonicalize): Use
- url-hexify-string to remove special characters from filenames
+ * mh-utils.el (mh-x-image-url-cache-canonicalize):
+ Use url-hexify-string to remove special characters from filenames
(closes SF #1396499). Note that this invalidates the existing
names in your cache so you might as well remove
~/Mail/.mhe-x-image-cache/* now.
@@ -2446,16 +2459,16 @@
than file-executable-p which returns t for directories.
(mh-file-command-p): Move here from mh-utils, since
mh-variant-*-info are the only functions to use it.
- (mh-variant-set, mh-variant-set-variant, mh-variant-p): Use
- function mh-variants instead of variable. More robust.
+ (mh-variant-set, mh-variant-set-variant, mh-variant-p):
+ Use function mh-variants instead of variable. More robust.
(mh-find-path-run): Move here from mh-utils.el. Mention that
checking this variable is unnecessary.
(mh-find-path): Move here from mh-utils.el. With the advent of MH
variants and an mhparam command that doesn't work if there isn't
- an MH profile, we can't get libdir for running install-mh. So
- don't bother. If there's an issue with the environment, direct the
- user to install MH and run install-mh (closes SF #835192). Don't
- read ~/.mh_profile directly. Use mh-profile-component which uses
+ an MH profile, we can't get libdir for running install-mh.
+ So don't bother. If there's an issue with the environment, direct the
+ user to install MH and run install-mh (closes SF #835192).
+ Don't read ~/.mh_profile directly. Use mh-profile-component which uses
mhparam (closes SF #1016027).
* mh-utils.el (mh-get-profile-field): Rename to
@@ -2470,12 +2483,12 @@
(mh-no-install, mh-install): Delete.
* mh-customize.el (mh-folder-msg-number):
- * mh-mime.el (mh-file-mime-type): Removed trailing whitespace.
+ * mh-mime.el (mh-file-mime-type): Remove trailing whitespace.
2006-01-09 Bill Wohler <wohler@newt.com>
- * mh-init.el (mh-variant-mu-mh-info, mh-variant-nmh-info): Applied
- patch from Satyaki from SF #1016027.
+ * mh-init.el (mh-variant-mu-mh-info, mh-variant-nmh-info):
+ Applied patch from Satyaki from SF #1016027.
* mh-e.el (mh-rescan-folder): Try to keep cursor at current
message, even if cur sequence is no longer present (closes SF
@@ -2523,7 +2536,7 @@
* mh-comp.el: Require cleanup, wrap compiler-shushing defvars with
eval-when-compile.
- (mh-file-is-vcard-p): Removed redundant test.
+ (mh-file-is-vcard-p): Remove redundant test.
* mh-customize.el: Require cleanup, wrap compiler-shushing defvars
with eval-when-compile.
@@ -2549,8 +2562,8 @@
* mh-mime.el: Wrap compiler-shushing defvars with
eval-when-compile.
- (mh-have-file-command): Initialize variable to 'undefined. Add
- docstring. Update function of same name accordingly. Also don't
+ (mh-have-file-command): Initialize variable to 'undefined.
+ Add docstring. Update function of same name accordingly. Also don't
need to load executable any more.
(mh-mime-content-types): Delete.
(mh-minibuffer-read-type): Prompt user for type if
@@ -2789,11 +2802,11 @@
with manual.
(mh-yank-cur-msg): Mention that mh-ins-buf-prefix isn't used if
you have added a mail-citation-hook and neither are used if you
- use one of the supercite flavors of mh-yank-behavior. Sync
- docstrings with manual.
+ use one of the supercite flavors of mh-yank-behavior.
+ Sync docstrings with manual.
- * mh-customize.el (mh-kill-folder-suppress-prompt-hooks): Rename
- from mh-kill-folder-suppress-prompt-hook since it is an abnormal
+ * mh-customize.el (mh-kill-folder-suppress-prompt-hooks):
+ Rename from mh-kill-folder-suppress-prompt-hook since it is an abnormal
hook. Use "Hook run by `function'..." instead of "Invoked...".
Sync docstrings with manual.
(mh-ins-buf-prefix, mh-yank-behavior): Mention that
@@ -2918,13 +2931,13 @@
* mh-customize.el (mh-speed-flists-interval): Rename to
mh-speed-update-interval.
- (mh-speed-run-flists-flag): Delete. Setting
- mh-speed-flists-interval to 0 accomplishes the same thing.
+ (mh-speed-run-flists-flag): Delete.
+ Setting mh-speed-flists-interval to 0 accomplishes the same thing.
- * mh-speed.el (mh-folder-speedbar-buttons, mh-speed-flists): Use
- mh-speed-update-interval instead of mh-speed-run-flists-flag.
- (mh-speed-toggle, mh-speed-view, mh-speed-refresh): Sync
- docstrings with manual.
+ * mh-speed.el (mh-folder-speedbar-buttons, mh-speed-flists):
+ Use mh-speed-update-interval instead of mh-speed-run-flists-flag.
+ (mh-speed-toggle, mh-speed-view, mh-speed-refresh):
+ Sync docstrings with manual.
2005-12-09 Bill Wohler <wohler@newt.com>
@@ -2941,8 +2954,8 @@
(mh-invisible-header-fields-internal): Add X-Bugzilla-* and
X-Virus-Scanned.
- * mh-customize.el (mh-insert-signature-hook): Rename
- mh-letter-insert-signature-hook to mh-insert-signature-hook.
+ * mh-customize.el (mh-insert-signature-hook):
+ Rename mh-letter-insert-signature-hook to mh-insert-signature-hook.
* mh-comp.el (mh-insert-signature): Ditto.
@@ -3044,10 +3057,10 @@
(mh-next-undeleted-msg, mh-previous-undeleted-msg): Rename arg to
count. Sync docstrings with manual.
(mh-refile-or-write-again): Use output from mh-write-msg-to-file
- so that message doesn't change when using this command. Sync
- docstrings with manual.
- (mh-page-msg, mh-previous-page): Rename arg to lines. Sync
- docstrings with manual.
+ so that message doesn't change when using this command.
+ Sync docstrings with manual.
+ (mh-page-msg, mh-previous-page): Rename arg to lines.
+ Sync docstrings with manual.
(mh-write-msg-to-file): Rename msg to message. Rename no-headers
to no-header. Sync docstrings with manual.
(mh-ps-print-map): Delete keybindings for deleted commands
@@ -3071,8 +3084,8 @@
Sync docstrings with manual.
(mh-toggle-mh-decode-mime-flag): Use English in message, not Lisp.
Sync docstrings with manual.
- (mh-mm-display-part, mh-mm-inline-message): Use
- mh-highlight-citation-style instead of mh-highlight-citation-p.
+ (mh-mm-display-part, mh-mm-inline-message):
+ Use mh-highlight-citation-style instead of mh-highlight-citation-p.
(mh-press-button): Sync docstrings with manual.
(mh-display-with-external-viewer): Fix default output in
minibuffer. Sync docstrings with manual.
@@ -3163,8 +3176,8 @@
(mh-smail, mh-extract-rejected-mail, mh-forward, mh-redistribute)
(mh-reply, mh-send, mh-send-other-window)
(mh-fill-paragraph-function): Sync docstrings with manual.
- (mh-edit-again, mh-extract-rejected-mail, mh-redistribute): Rename
- msg argument to message (to make for a better docstring).
+ (mh-edit-again, mh-extract-rejected-mail, mh-redistribute):
+ Rename msg argument to message (to make for a better docstring).
* mh-customize.el (mh-redist-full-contents-flag): Convert defvar
to defcustom. Rename by adding -flag.
@@ -3189,8 +3202,8 @@
* mh-customize.el (mh-compose-space-does-completion-flag)
(mh-signature-separator-flag, mh-interpret-number-as-range-flag)
(mh-adaptive-cmd-note-flag): Use "Non-nil means" instead of "On
- means" to remain checkdoc clean and consistent with Emacs. I
- raised this issue with the Emacs developers and Stallman agrees
+ means" to remain checkdoc clean and consistent with Emacs.
+ I raised this issue with the Emacs developers and Stallman agrees
that "On means" should be allowed in custom docstrings but that
this change requires thought and should wait until after the Emacs
22 release.
@@ -3202,14 +3215,14 @@
* mh-customize.el (mh-interpret-number-as-range-flag): Add * to
docstring.
- (mh-adaptive-cmd-note-flag-check, mh-scan-format-file-check): New
- functions to check input for mh-adaptive-cmd-note-flag and
+ (mh-adaptive-cmd-note-flag-check, mh-scan-format-file-check):
+ New functions to check input for mh-adaptive-cmd-note-flag and
mh-scan-format-file respectively.
(mh-adaptive-cmd-note-flag, mh-scan-format-file): Docstring fixes,
add :set.
- * mh-e.el (mh-scan-field-destination-offset): New variable. The
- destination is the -, t, b, c, or n character for Replied, To, cc,
+ * mh-e.el (mh-scan-field-destination-offset): New variable.
+ The destination is the -, t, b, c, or n character for Replied, To, cc,
Bcc, or Newsgroups respectively.
(mh-make-folder, mh-regenerate-headers, mh-generate-new-cmd-note):
Call new function mh-msg-num-width-to-column to make leap between
@@ -3329,10 +3342,10 @@
2005-10-23 Bill Wohler <wohler@newt.com>
- * mh-comp.el (mh-letter-menu): Rename
- mh-mhn-compose-external-compressed-tar to
- mh-mh-compose-external-compressed-tar. Rename
- mh-mhn-compose-anon-ftp to mh-mh-compose-anon-ftp. Rename
+ * mh-comp.el (mh-letter-menu):
+ Rename mh-mhn-compose-external-compressed-tar to
+ mh-mh-compose-external-compressed-tar.
+ Rename mh-mhn-compose-anon-ftp to mh-mh-compose-anon-ftp. Rename
mh-edit-mhn to mh-mh-to-mime. Rename mh-mhn-directive-present-p to
mh-mh-directive-present-p. Rename mh-revert-mhn-edit to
mh-mh-to-mime-undo. Rename mh-gnus-pgp-support-flag to
@@ -3342,21 +3355,21 @@
mh-mh-directive-present-p.
(mh-send-letter): Rename mh-mhn-directive-present-p to
mh-mh-directive-present-p. Rename mh-edit-mhn to mh-mh-to-mime.
- (mh-letter-mode-map): Rename mh-edit-mhn to mh-mh-to-mime. Rename
- mh-mhn-compose-anon-ftp to mh-mh-compose-anon-ftp. Rename
- mh-mhn-compose-external-compressed-tar to
+ (mh-letter-mode-map): Rename mh-edit-mhn to mh-mh-to-mime.
+ Rename mh-mhn-compose-anon-ftp to mh-mh-compose-anon-ftp.
+ Rename mh-mhn-compose-external-compressed-tar to
mh-mh-compose-external-compressed-tar. Rename mh-revert-mhn-edit
to mh-mh-to-mime-undo. Rename mh-mhn-compose-external-type to
mh-mh-compose-external-type. Rename mh-mhn-compose-anon-ftp to
- mh-mh-compose-anon-ftp. Rename
- mh-mhn-compose-external-compressed-tar to
+ mh-mh-compose-anon-ftp.
+ Rename mh-mhn-compose-external-compressed-tar to
mh-mh-compose-external-compressed-tar. Rename mh-revert-mhn-edit
to mh-mh-to-mime-undo. Rename mh-mhn-compose-external-type to
mh-mh-compose-external-type.
(mh-send-letter, mh-letter-mode-map): Rename mh-edit-mhn to
mh-mh-to-mime, mh-revert-mhn-edit to mh-mh-to-mime-undo.
- (mh-reply, mh-yank-cur-msg, mh-insert-prefix-string): Rename
- mh-yank-from-start-of-msg to mh-yank-behavior.
+ (mh-reply, mh-yank-cur-msg, mh-insert-prefix-string):
+ Rename mh-yank-from-start-of-msg to mh-yank-behavior.
(mh-letter-mode, mh-to-field, mh-to-fcc, mh-insert-signature)
(mh-check-whom, mh-insert-auto-fields, mh-send-letter)
(mh-insert-letter, mh-yank-cur-msg, mh-insert-prefix-string)
@@ -3399,8 +3412,8 @@
(mh-mhn-compose-anon-ftp): Rename to mh-mh-compose-anon-ftp.
Rename mh-mhn-compose-external-type to mh-mh-compose-external-type.
(mh-mhn-compose-external-compressed-tar): Rename to
- mh-mh-compose-external-compressed-tar. Rename
- mh-mhn-compose-external-type to mh-mh-compose-external-type.
+ mh-mh-compose-external-compressed-tar.
+ Rename mh-mhn-compose-external-type to mh-mh-compose-external-type.
(mh-mhn-compose-external-type): Rename to mh-mh-compose-external-type.
(mh-edit-mhn): Rename to mh-mh-to-mime. Rename mh-mhn-args to
mh-mh-to-mime-args. Rename mh-edit-mhn-hook to mh-mh-to-mime-hook.
@@ -3417,8 +3430,8 @@
(mh-mh-compose-external-type): Rename extra-param argument to
parameters.
(mh-mml-to-mime, mh-secure-message, mh-mml-unsecure-message)
- (mh-mime-display-part, mh-mime-display-single): Rename
- mh-gnus-pgp-support-flag to mh-pgp-support-flag.
+ (mh-mime-display-part, mh-mime-display-single):
+ Rename mh-gnus-pgp-support-flag to mh-pgp-support-flag.
(mh-compose-insertion): Rename mh-mhn-compose-insertion to
mh-mh-attach-file.
(mh-compose-forward): Rename mh-mhn-compose-forw to
@@ -3483,8 +3496,8 @@
* mh-init.el (mh-image-load-path-called-flag): New variable which
is used by mh-image-load-path so that it runs only once.
- (mh-image-load-path): Modify so that it gets run only once. Also
- flatten out heavily nested if statements to make it clearer.
+ (mh-image-load-path): Modify so that it gets run only once.
+ Also flatten out heavily nested if statements to make it clearer.
* mh-e.el (mh-folder-mode): Call mh-image-load-path to allow Emacs
to find images used in the toolbar.
@@ -3508,11 +3521,11 @@
need to be indented.
* mh-e.el: mh-folder-tick-face had been renamed to mh-folder-tick
- but the code that invoked the face had not been updated. Tick
- highlighting working again.
+ but the code that invoked the face had not been updated.
+ Tick highlighting working again.
- * mh-seq.el (mh-non-seq-mode-line-annotation): Move
- make-variable-buffer-local call to top level to avoid warnings in
+ * mh-seq.el (mh-non-seq-mode-line-annotation):
+ Move make-variable-buffer-local call to top level to avoid warnings in
CVS Emacs.
* mh-comp.el (mh-insert-letter): Replace deprecated read-input
@@ -3534,7 +3547,7 @@
* ChangeLog.1: New file. Contains old ChangeLog.
- Copyright (C) 2005-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1
index 506390896a1..eb60392c32c 100644
--- a/lisp/mh-e/ChangeLog.1
+++ b/lisp/mh-e/ChangeLog.1
@@ -2898,7 +2898,7 @@
2003-06-01 Peter S Galbraith <psg@debian.org>
- * mh-comp.el (mh-modify-header-field): Bug fix. Calling with with
+ * mh-comp.el (mh-modify-header-field): Bug fix. Calling with
a value that was already inserted causes it to get inserted a
second time. I have wrapped the value around \b word delimiters.
Hope there are no side effects for other code.
@@ -9493,9 +9493,9 @@
* mh-utils.el (mh-find-progs): Run PATH search only when mh-progs,
mh-lib and mh-lib-progs are not all already set. This allows the
user to set them using a simple setq prior to loading mh-e. This
- is useful for implementation of mh-e on win32. Note that many
+ is useful for implementation of mh-e on w32. Note that many
commands still call mh-find-path which also parses the mh_profile
- file (that may still fail on win32), so this is still done often.
+ file (that may still fail on w32), so this is still done often.
But it lets us change the mh_profile file and have mh-e see the
changed file without exiting emacs and starting over so I left
that in.
@@ -9952,7 +9952,7 @@
* mh-mime.el (compilation): Code rearrangement to remove compiler
warnings.
(mh-defun-compat): New macro to define to useful functions that
- aren't present present in old Gnus.
+ aren't present in old Gnus.
(mh-destroy-postponed-handles): New function to cleanup handles
that are associated with external viewers.
(mh-handle-set-external-undisplayer): New function to replace
@@ -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
@@ -11400,7 +11400,7 @@
(dist): Leave release in current directory.
- Copyright (C) 2003-2011 Free Software Foundation, Inc.
+ Copyright (C) 2003-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index 2144eef7308..ee481868c47 100644
--- a/lisp/mh-e/mh-acros.el
+++ b/lisp/mh-e/mh-acros.el
@@ -1,6 +1,6 @@
;;; mh-acros.el --- macros used in MH-E
-;; Copyright (C) 2004, 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index c6d60b3b2e2..f5a7719d1ee 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -1,6 +1,6 @@
;;; mh-alias.el --- MH-E mail alias completion and expansion
-;; Copyright (C) 1994-1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-buffers.el b/lisp/mh-e/mh-buffers.el
index 48154cbf4e0..3410d859c49 100644
--- a/lisp/mh-e/mh-buffers.el
+++ b/lisp/mh-e/mh-buffers.el
@@ -1,6 +1,6 @@
;;; mh-buffers.el --- MH-E buffer constants and utilities
-;; Copyright (C) 1993, 1995, 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 6c8ac6c6e7e..d34de619268 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -1,6 +1,6 @@
;;; mh-comp.el --- MH-E functions for composing and sending messages
-;; Copyright (C) 1993, 1995, 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index 88a6ed84055..4a93109e7a4 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -1,6 +1,6 @@
;;; mh-compat.el --- make MH-E compatible with various versions of Emacs
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -174,7 +174,7 @@ compatibility with versions of Emacs that lack the variable
dir (expand-file-name "../" dir))))
(setq image-directory-load-path dir))
- ;; If `image-directory-load-path' isn't Emacs' image directory,
+ ;; If `image-directory-load-path' isn't Emacs's image directory,
;; it's probably a user preference, so use it. Then use a
;; relative setting if possible; otherwise, use
;; `image-directory-load-path'.
@@ -205,7 +205,7 @@ compatibility with versions of Emacs that lack the variable
;; Set it to nil if image is not found.
(cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
((file-exists-p (expand-file-name image d1ei)) d1ei)))))
- ;; Use Emacs' image directory.
+ ;; Use Emacs's image directory.
(image-directory-load-path
(setq image-directory image-directory-load-path))
(no-error
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 8ea7b661a18..94905e7984f 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -1,6 +1,6 @@
;;; mh-e.el --- GNU Emacs interface to the MH mail system
-;; Copyright (C) 1985-1988, 1990, 1992-1995, 1997, 1999-2011
+;; Copyright (C) 1985-1988, 1990, 1992-1995, 1997, 1999-2012
;; Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
@@ -352,7 +352,7 @@ Name of the Previous sequence.")
"Non-nil means that we have \"flists\".")
(defvar mh-index-data-file ".mhe_index"
- "MH-E specific file where index seach info is stored.")
+ "MH-E specific file where index search info is stored.")
(defvar mh-letter-header-field-regexp "^\\([A-Za-z][A-Za-z0-9-]*\\):")
@@ -2532,7 +2532,7 @@ of citations entirely, choose \"None\"."
"Seal-Send-Time:"
"See-Also:" ; H. Spencer: News Article Format and Transmission, June 1994
"Sensitivity:" ; RFC 2156, 2421
- "Speach-Act:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Speech-Act:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Status:" ; sendmail
"Supersedes:" ; H. Spencer: News Article Format and Transmission, June 1994
"Telefax:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
@@ -3276,7 +3276,9 @@ function used to insert the signature with
:group 'mh-letter
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-kill-folder-suppress-prompt-hooks '(mh-search-p)
+(define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks
+ 'mh-kill-folder-suppress-prompt-functions "24.3")
+(defcustom-mh mh-kill-folder-suppress-prompt-functions '(mh-search-p)
"Abnormal hook run at the beginning of \\<mh-folder-mode-map>\\[mh-kill-folder].
The hook functions are called with no arguments and should return
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index 1960a93ab99..6b5ff3b62e2 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -1,6 +1,6 @@
;;; mh-folder.el --- MH-Folder mode
-;; Copyright (C) 2002-2003, 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2005-2012 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -526,7 +526,7 @@ font-lock is done highlighting.")
;; Register mh-folder-mode as supporting which-function-mode...
(mh-require 'which-func nil t)
-(when (boundp 'which-func-modes)
+(when (and (boundp 'which-func-modes) (listp which-func-modes))
(add-to-list 'which-func-modes 'mh-folder-mode))
;; Shush compiler.
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 46a04c38845..545919ae74c 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -1,6 +1,6 @@
;;; mh-funcs.el --- MH-E functions not everyone will use right away
-;; Copyright (C) 1993, 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el
index f644282fc82..18b320e6078 100644
--- a/lisp/mh-e/mh-gnus.el
+++ b/lisp/mh-e/mh-gnus.el
@@ -1,6 +1,6 @@
;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus
-;; Copyright (C) 2003-2004, 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index 7e8b8576ff1..908f219e0fa 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -1,6 +1,6 @@
;;; mh-identity.el --- multiple identify support for MH-E
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el
index 5248d6ab75e..34903a0bca2 100644
--- a/lisp/mh-e/mh-inc.el
+++ b/lisp/mh-e/mh-inc.el
@@ -1,6 +1,6 @@
;;; mh-inc.el --- MH-E "inc" and separate mail spool handling
-;; Copyright (C) 2003-2004, 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index 9f265ddaef7..261dbfbf645 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -1,6 +1,6 @@
;;; mh-junk.el --- MH-E interface to anti-spam measures
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>,
;; Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el
index 4f3c6fc0d58..47554ce66a3 100644
--- a/lisp/mh-e/mh-letter.el
+++ b/lisp/mh-e/mh-letter.el
@@ -1,6 +1,6 @@
;;; mh-letter.el --- MH-Letter mode
-;; Copyright (C) 1993, 1995, 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -66,8 +66,9 @@ Each hook function can find the citation between point and mark.
And each hook function should leave point and mark around the
citation text as modified.
-This is a normal hook, misnamed for historical reasons. It is
-semi-obsolete and is only used if `mail-citation-hook' is nil.")
+This is a normal hook, misnamed for historical reasons.
+It is obsolete and is only used if `mail-citation-hook' is nil.")
+(make-obsolete-variable 'mh-yank-hooks 'mail-citation-hook "19.34")
@@ -911,7 +912,7 @@ Any match found replaces the text from BEGIN to END."
(with-output-to-temp-buffer completions-buffer
(mh-display-completion-list
(all-completions word choices)
- ;; The `common-subtring' arg only works if it's a prefix.
+ ;; The `common-substring' arg only works if it's a prefix.
(unless (and (functionp choices)
(let ((bounds
(funcall choices
diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el
index db17b05ef37..a7da41e0535 100644
--- a/lisp/mh-e/mh-limit.el
+++ b/lisp/mh-e/mh-limit.el
@@ -1,6 +1,6 @@
;;; mh-limit.el --- MH-E display limits
-;; Copyright (C) 2001-2003, 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2003, 2006-2012 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index a97185e1496..66e1ba5ec69 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -1,6 +1,6 @@
;;; mh-mime.el --- MH-E MIME support
-;; Copyright (C) 1993, 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el
index bd99245efe6..0a289ab6e45 100644
--- a/lisp/mh-e/mh-print.el
+++ b/lisp/mh-e/mh-print.el
@@ -1,6 +1,6 @@
;;; mh-print.el --- MH-E printing support
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Jeffrey C Honig <jch@honig.net>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el
index 9d6aec9c2ed..30bcf9f4647 100644
--- a/lisp/mh-e/mh-scan.el
+++ b/lisp/mh-e/mh-scan.el
@@ -1,6 +1,6 @@
;;; mh-scan.el --- MH-E scan line constants and utilities
-;; Copyright (C) 1993, 1995, 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index 911ba1240df..88e42986f7d 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -1,6 +1,6 @@
;;; mh-search --- MH-Search mode
-;; Copyright (C) 1993, 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Indexed search by Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index fc3e5c08143..19563dd9ba7 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -1,6 +1,6 @@
;;; mh-seq.el --- MH-E sequences support
-;; Copyright (C) 1993, 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index cb85a446ee5..ee516f8ede8 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -1,6 +1,6 @@
;;; mh-show.el --- MH-Show mode
-;; Copyright (C) 1993, 1995, 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 5c3679e8ce6..65fef66be91 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -1,6 +1,6 @@
;;; mh-speed.el --- MH-E speedbar support
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index c6f33a15fd2..48c06c3df87 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -1,6 +1,6 @@
;;; mh-thread.el --- MH-E threading support
-;; Copyright (C) 2002-2004, 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el
index 4469c043b15..384c0e7da47 100644
--- a/lisp/mh-e/mh-tool-bar.el
+++ b/lisp/mh-e/mh-tool-bar.el
@@ -1,6 +1,6 @@
;;; mh-tool-bar.el --- MH-E tool bar support
-;; Copyright (C) 2002-2003, 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2005-2012 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 327d8ad7040..2b5e51cfb34 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -1,6 +1,6 @@
;;; mh-utils.el --- MH-E general utilities
-;; Copyright (C) 1993, 1995, 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -732,8 +732,7 @@ See Info node `(elisp) Programmed Completion' for details."
;; Shush compiler.
(mh-do-in-xemacs
- (defvar completion-root-regexp)
- (defvar minibuffer-completing-file-name))
+ (defvar completion-root-regexp))
(defun mh-folder-completing-read (prompt default allow-root-folder-flag)
"Read folder name with PROMPT and default result DEFAULT.
diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el
index 179b552d536..5749a2c3461 100644
--- a/lisp/mh-e/mh-xface.el
+++ b/lisp/mh-e/mh-xface.el
@@ -1,6 +1,6 @@
;;; mh-xface.el --- MH-E X-Face and Face header field display
-;; Copyright (C) 2002-2003, 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2005-2012 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/midnight.el b/lisp/midnight.el
index 762bc5445ba..40e66b8ce9b 100644
--- a/lisp/midnight.el
+++ b/lisp/midnight.el
@@ -1,6 +1,6 @@
;;; midnight.el --- run something every midnight, e.g., kill old buffers
-;; Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Sam Steingold <sds@gnu.org>
;; Maintainer: Sam Steingold <sds@gnu.org>
@@ -36,8 +36,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup midnight nil
"Run something every day at midnight."
@@ -138,9 +137,9 @@ two lists will NOT be killed if it also matches anything in this list."
(defun midnight-find (el ls test &optional key)
"A stopgap solution to the absence of `find' in ELisp."
- (dolist (rr ls)
+ (cl-dolist (rr ls)
(when (funcall test (if key (funcall key rr) rr) el)
- (return rr))))
+ (cl-return rr))))
(defun clean-buffer-list-delay (name)
"Return the delay, in seconds, before killing a buffer named NAME.
@@ -196,8 +195,7 @@ The default value is `clean-buffer-list'."
(defun midnight-next ()
"Return the number of seconds till the next midnight."
- (multiple-value-bind (sec min hrs)
- (values-list (decode-time))
+ (pcase-let ((`(,sec ,min ,hrs) (decode-time)))
(- (* 24 60 60) (* 60 60 hrs) (* 60 min) sec)))
;;;###autoload
@@ -205,8 +203,8 @@ The default value is `clean-buffer-list'."
"Modify `midnight-timer' according to `midnight-delay'.
Sets the first argument SYMB (which must be symbol `midnight-delay')
to its second argument TM."
- (assert (eq symb 'midnight-delay) t
- "Invalid argument to `midnight-delay-set': `%s'")
+ (cl-assert (eq symb 'midnight-delay) t
+ "Invalid argument to `midnight-delay-set': `%s'")
(set symb tm)
(when (timerp midnight-timer) (cancel-timer midnight-timer))
(setq midnight-timer
diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el
index 405721f97ee..950c28b227f 100644
--- a/lisp/minibuf-eldef.el
+++ b/lisp/minibuf-eldef.el
@@ -1,6 +1,6 @@
-;;; 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-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: convenience
@@ -33,16 +33,34 @@
;;; Code:
+(defvar minibuffer-eldef-shorten-default)
+
+(defun minibuffer-default--in-prompt-regexps ()
+ `(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'"
+ 1 ,(if minibuffer-eldef-shorten-default " [\\2]"))
+ ("\\( \\[.*\\]\\):? *\\'" 1)))
+
+(defcustom minibuffer-eldef-shorten-default nil
+ "If non-nil, shorten \"(default ...)\" to \"[...]\" in minibuffer prompts."
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (setq-default minibuffer-default-in-prompt-regexps
+ (minibuffer-default--in-prompt-regexps)))
+ :type 'boolean
+ :group 'minibuffer
+ :version "24.3")
+
(defvar minibuffer-default-in-prompt-regexps
- '(("\\( (default\\>.*)\\):? \\'" . 1) ("\\( \\[.*\\]\\):? *\\'" . 1))
- "*A list of regexps matching the parts of minibuffer prompts showing defaults.
+ (minibuffer-default--in-prompt-regexps)
+ "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 +97,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 +163,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 11e195d4f7f..6e704fad807 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1,6 +1,6 @@
;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Package: emacs
@@ -45,33 +45,22 @@
;; corresponding to the displayed completions because we only
;; provide the start info but not the end info in
;; completion-base-position.
-;; - quoting is problematic. E.g. the double-dollar quoting used in
-;; substitute-in-file-name (and hence read-file-name-internal) bumps
-;; into various bugs:
-;; - choose-completion doesn't know how to quote the text it inserts.
-;; E.g. it fails to double the dollars in file-name completion, or
-;; to backslash-escape spaces and other chars in comint completion.
-;; - when completing ~/tmp/fo$$o, the highlighting in *Completions*
-;; is off by one position.
-;; - all code like PCM which relies on all-completions to match
-;; its argument gets confused because all-completions returns unquoted
-;; texts (as desired for *Completions* output).
;; - C-x C-f ~/*/sr ? should not list "~/./src".
;; - minibuffer-force-complete completes ~/src/emacs/t<!>/lisp/minibuffer.el
;; to ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
;;; Todo:
+;; - Make *Completions* readable even if some of the completion
+;; entries have LF chars or spaces in them (including at
+;; beginning/end) or are very long.
;; - for M-x, cycle-sort commands that have no key binding first.
;; - Make things like icomplete-mode or lightning-completion work with
;; completion-in-region-mode.
;; - extend `metadata':
-;; - quoting/unquoting (so we can complete files names with envvars
-;; and backslashes, and all-completion can list names without
-;; quoting backslashes and dollars).
;; - indicate how to turn all-completion's output into
;; try-completion's output: e.g. completion-ignored-extensions.
-;; maybe that could be merged with the "quote" operation above.
+;; maybe that could be merged with the "quote" operation.
;; - indicate that `all-completions' doesn't do prefix-completion
;; but just returns some list that relates in some other way to
;; the provided string (as is the case in filecache.el), in which
@@ -88,6 +77,9 @@
;; - whether the user wants completion to pay attention to case.
;; e.g. we may want to make it possible for the user to say "first try
;; completion case-sensitively, and if that fails, try to ignore case".
+;; Maybe the trick is that we should distinguish completion-ignore-case in
+;; try/all-completions (obey user's preference) from its use in
+;; test-completion (obey the underlying object's semantics).
;; - add support for ** to pcm.
;; - Add vc-file-name-completion-table to read-file-name-internal.
@@ -95,7 +87,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; Completion table manipulation
@@ -162,7 +154,7 @@ Like CL's `some'."
(defun complete-with-action (action table string pred)
"Perform completion ACTION.
STRING is the string to complete.
-TABLE is the completion table, which should not be a function.
+TABLE is the completion table.
PRED is a completion predicate.
ACTION can be one of nil, t or `lambda'."
(cond
@@ -213,7 +205,7 @@ You should give VAR a non-nil `risky-local-variable' property."
`(completion-table-dynamic
(lambda (,str)
(when (functionp ,var)
- (setq ,var (,fun)))
+ (setq ,var (funcall #',fun)))
,var))))
(defun completion-table-case-fold (table &optional dont-fold)
@@ -224,32 +216,69 @@ case sensitive instead."
(let ((completion-ignore-case (not dont-fold)))
(complete-with-action action table string pred))))
+(defun completion-table-subvert (table s1 s2)
+ "Return a completion table from TABLE with S1 replaced by S2.
+The result is a completion table which completes strings of the
+form (concat S1 S) in the same way as TABLE completes strings of
+the form (concat S2 S)."
+ (lambda (string pred action)
+ (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
+ completion-ignore-case))
+ (concat s2 (substring string (length s1)))))
+ (res (if str (complete-with-action action table str pred))))
+ (when res
+ (cond
+ ((eq (car-safe action) 'boundaries)
+ (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0)))
+ `(boundaries
+ ,(max (length s1)
+ (+ beg (- (length s1) (length s2))))
+ . ,(and (eq (car-safe res) 'boundaries) (cddr res)))))
+ ((stringp res)
+ (if (eq t (compare-strings res 0 (length s2) s2 nil nil
+ completion-ignore-case))
+ (concat s1 (substring res (length s2)))))
+ ((eq action t)
+ (let ((bounds (completion-boundaries str table pred "")))
+ (if (>= (car bounds) (length s2))
+ res
+ (let ((re (concat "\\`"
+ (regexp-quote (substring s2 (car bounds))))))
+ (delq nil
+ (mapcar (lambda (c)
+ (if (string-match re c)
+ (substring c (match-end 0))))
+ res))))))
+ ;; E.g. action=nil and it's the only completion.
+ (res))))))
+
(defun completion-table-with-context (prefix table string pred action)
;; TODO: add `suffix' maybe?
- ;; Notice that `pred' may not be a function in some abusive cases.
- (when (functionp pred)
- (setq pred
- ;; Predicates are called differently depending on the nature of
- ;; the completion table :-(
- (cond
- ((vectorp table) ;Obarray.
- (lambda (sym) (funcall pred (concat prefix (symbol-name sym)))))
- ((hash-table-p table)
- (lambda (s _v) (funcall pred (concat prefix s))))
- ((functionp table)
- (lambda (s) (funcall pred (concat prefix s))))
- (t ;Lists and alists.
- (lambda (s)
- (funcall pred (concat prefix (if (consp s) (car s) s))))))))
- (if (eq (car-safe action) 'boundaries)
- (let* ((len (length prefix))
- (bound (completion-boundaries string table pred (cdr action))))
- (list* 'boundaries (+ (car bound) len) (cdr bound)))
- (let ((comp (complete-with-action action table string pred)))
- (cond
- ;; In case of try-completion, add the prefix.
- ((stringp comp) (concat prefix comp))
- (t comp)))))
+ (let ((pred
+ (if (not (functionp pred))
+ ;; Notice that `pred' may not be a function in some abusive cases.
+ pred
+ ;; Predicates are called differently depending on the nature of
+ ;; the completion table :-(
+ (cond
+ ((vectorp table) ;Obarray.
+ (lambda (sym) (funcall pred (concat prefix (symbol-name sym)))))
+ ((hash-table-p table)
+ (lambda (s _v) (funcall pred (concat prefix s))))
+ ((functionp table)
+ (lambda (s) (funcall pred (concat prefix s))))
+ (t ;Lists and alists.
+ (lambda (s)
+ (funcall pred (concat prefix (if (consp s) (car s) s)))))))))
+ (if (eq (car-safe action) 'boundaries)
+ (let* ((len (length prefix))
+ (bound (completion-boundaries string table pred (cdr action))))
+ `(boundaries ,(+ (car bound) len) . ,(cdr bound)))
+ (let ((comp (complete-with-action action table string pred)))
+ (cond
+ ;; In case of try-completion, add the prefix.
+ ((stringp comp) (concat prefix comp))
+ (t comp))))))
(defun completion-table-with-terminator (terminator table string pred action)
"Construct a completion table like TABLE but with an extra TERMINATOR.
@@ -277,8 +306,8 @@ instead of a string, a function that takes the completion and returns the
(cdr terminator) (regexp-quote terminator)))
(max (and terminator-regexp
(string-match terminator-regexp suffix))))
- (list* 'boundaries (car bounds)
- (min (cdr bounds) (or max (length suffix))))))
+ `(boundaries ,(car bounds)
+ . ,(min (cdr bounds) (or max (length suffix))))))
((eq action nil)
(let ((comp (try-completion string table pred)))
(if (consp terminator) (setq terminator (car terminator)))
@@ -346,6 +375,214 @@ Note: TABLE needs to be a proper completion table which obeys predicates."
(complete-with-action action table string pred))
tables)))
+(defun completion-table-with-quoting (table unquote requote)
+ ;; A difficult part of completion-with-quoting is to map positions in the
+ ;; quoted string to equivalent positions in the unquoted string and
+ ;; vice-versa. There is no efficient and reliable algorithm that works for
+ ;; arbitrary quote and unquote functions.
+ ;; So to map from quoted positions to unquoted positions, we simply assume
+ ;; that `concat' and `unquote' commute (which tends to be the case).
+ ;; And we ask `requote' to do the work of mapping from unquoted positions
+ ;; back to quoted positions.
+ ;; FIXME: For some forms of "quoting" such as the truncation behavior of
+ ;; substitute-in-file-name, it would be desirable not to requote completely.
+ "Return a new completion table operating on quoted text.
+TABLE operates on the unquoted text.
+UNQUOTE is a function that takes a string and returns a new unquoted string.
+REQUOTE is a function of 2 args (UPOS QSTR) where
+ QSTR is a string entered by the user (and hence indicating
+ the user's preferred form of quoting); and
+ UPOS is a position within the unquoted form of QSTR.
+REQUOTE should return a pair (QPOS . QFUN) such that QPOS is the
+position corresponding to UPOS but in QSTR, and QFUN is a function
+of one argument (a string) which returns that argument appropriately quoted
+for use at QPOS."
+ ;; FIXME: One problem with the current setup is that `qfun' doesn't know if
+ ;; its argument is "the end of the completion", so if the quoting used double
+ ;; quotes (for example), we end up completing "fo" to "foobar and throwing
+ ;; away the closing double quote.
+ (lambda (string pred action)
+ (cond
+ ((eq action 'metadata)
+ (append (completion-metadata string table pred)
+ '((completion--unquote-requote . t))))
+
+ ((eq action 'lambda) ;;test-completion
+ (let ((ustring (funcall unquote string)))
+ (test-completion ustring table pred)))
+
+ ((eq (car-safe action) 'boundaries)
+ (let* ((ustring (funcall unquote string))
+ (qsuffix (cdr action))
+ (ufull (if (zerop (length qsuffix)) ustring
+ (funcall unquote (concat string qsuffix))))
+ (_ (cl-assert (string-prefix-p ustring ufull)))
+ (usuffix (substring ufull (length ustring)))
+ (boundaries (completion-boundaries ustring table pred usuffix))
+ (qlboundary (car (funcall requote (car boundaries) string)))
+ (qrboundary (if (zerop (cdr boundaries)) 0 ;Common case.
+ (let* ((urfullboundary
+ (+ (cdr boundaries) (length ustring))))
+ (- (car (funcall requote urfullboundary
+ (concat string qsuffix)))
+ (length string))))))
+ `(boundaries ,qlboundary . ,qrboundary)))
+
+ ;; In "normal" use a c-t-with-quoting completion table should never be
+ ;; called with action in (t nil) because `completion--unquote' should have
+ ;; been called before and would have returned a different completion table
+ ;; to apply to the unquoted text. But there's still a lot of code around
+ ;; that likes to use all/try-completions directly, so we do our best to
+ ;; handle those calls as well as we can.
+
+ ((eq action nil) ;;try-completion
+ (let* ((ustring (funcall unquote string))
+ (completion (try-completion ustring table pred)))
+ ;; Most forms of quoting allow several ways to quote the same string.
+ ;; So here we could simply requote `completion' in a kind of
+ ;; "canonical" quoted form without paying attention to the way
+ ;; `string' was quoted. But since we have to solve the more complex
+ ;; problems of "pay attention to the original quoting" for
+ ;; all-completions, we may as well use it here, since it provides
+ ;; a nicer behavior.
+ (if (not (stringp completion)) completion
+ (car (completion--twq-try
+ string ustring completion 0 unquote requote)))))
+
+ ((eq action t) ;;all-completions
+ ;; When all-completions is used for completion-try/all-completions
+ ;; (e.g. for `pcm' style), we can't do the job properly here because
+ ;; the caller will match our output against some pattern derived from
+ ;; the user's (quoted) input, and we don't have access to that
+ ;; pattern, so we can't know how to requote our output so that it
+ ;; matches the quoting used in the pattern. It is to fix this
+ ;; fundamental problem that we have to introduce the new
+ ;; unquote-requote method so that completion-try/all-completions can
+ ;; pass the unquoted string to the style functions.
+ (pcase-let*
+ ((ustring (funcall unquote string))
+ (completions (all-completions ustring table pred))
+ (boundary (car (completion-boundaries ustring table pred "")))
+ (completions
+ (completion--twq-all
+ string ustring completions boundary unquote requote))
+ (last (last completions)))
+ (when (consp last) (setcdr last nil))
+ completions))
+
+ ((eq action 'completion--unquote)
+ (let ((ustring (funcall unquote string))
+ (uprefix (funcall unquote (substring string 0 pred))))
+ ;; We presume (more or less) that `concat' and `unquote' commute.
+ (cl-assert (string-prefix-p uprefix ustring))
+ (list ustring table (length uprefix)
+ (lambda (unquoted-result op)
+ (pcase op
+ (1 ;;try
+ (if (not (stringp (car-safe unquoted-result)))
+ unquoted-result
+ (completion--twq-try
+ string ustring
+ (car unquoted-result) (cdr unquoted-result)
+ unquote requote)))
+ (2 ;;all
+ (let* ((last (last unquoted-result))
+ (base (or (cdr last) 0)))
+ (when last
+ (setcdr last nil)
+ (completion--twq-all string ustring
+ unquoted-result base
+ unquote requote))))))))))))
+
+(defun completion--twq-try (string ustring completion point
+ unquote requote)
+ ;; Basically two cases: either the new result is
+ ;; - commonprefix1 <point> morecommonprefix <qpos> suffix
+ ;; - commonprefix <qpos> newprefix <point> suffix
+ (pcase-let*
+ ((prefix (fill-common-string-prefix ustring completion))
+ (suffix (substring completion (max point (length prefix))))
+ (`(,qpos . ,qfun) (funcall requote (length prefix) string))
+ (qstr1 (if (> point (length prefix))
+ (funcall qfun (substring completion (length prefix) point))))
+ (qsuffix (funcall qfun suffix))
+ (qstring (concat (substring string 0 qpos) qstr1 qsuffix))
+ (qpoint
+ (cond
+ ((zerop point) 0)
+ ((> point (length prefix)) (+ qpos (length qstr1)))
+ (t (car (funcall requote point string))))))
+ ;; Make sure `requote' worked.
+ (if (equal (funcall unquote qstring) completion)
+ (cons qstring qpoint)
+ ;; If requote failed (e.g. because sifn-requote did not handle
+ ;; Tramp's "/foo:/bar//baz -> /foo:/baz" truncation), then at least
+ ;; try requote properly.
+ (let ((qstr (funcall qfun completion)))
+ (cons qstr (length qstr))))))
+
+(defun completion--string-equal-p (s1 s2)
+ (eq t (compare-strings s1 nil nil s2 nil nil 'ignore-case)))
+
+(defun completion--twq-all (string ustring completions boundary
+ unquote requote)
+ (when completions
+ (pcase-let*
+ ((prefix
+ (let ((completion-regexp-list nil))
+ (try-completion "" (cons (substring ustring boundary)
+ completions))))
+ (`(,qfullpos . ,qfun)
+ (funcall requote (+ boundary (length prefix)) string))
+ (qfullprefix (substring string 0 qfullpos))
+ ;; FIXME: This assertion can be wrong, e.g. in Cygwin, where
+ ;; (unquote "c:\bin") => "/usr/bin" but (unquote "c:\") => "/".
+ ;;(cl-assert (completion--string-equal-p
+ ;; (funcall unquote qfullprefix)
+ ;; (concat (substring ustring 0 boundary) prefix))
+ ;; t))
+ (qboundary (car (funcall requote boundary string)))
+ (_ (cl-assert (<= qboundary qfullpos)))
+ ;; FIXME: this split/quote/concat business messes up the carefully
+ ;; placed completions-common-part and completions-first-difference
+ ;; faces. We could try within the mapcar loop to search for the
+ ;; boundaries of those faces, pass them to `requote' to find their
+ ;; equivalent positions in the quoted output and re-add the faces:
+ ;; this might actually lead to correct results but would be
+ ;; pretty expensive.
+ ;; The better solution is to not quote the *Completions* display,
+ ;; which nicely circumvents the problem. The solution I used here
+ ;; instead is to hope that `qfun' preserves the text-properties and
+ ;; presume that the `first-difference' is not within the `prefix';
+ ;; this presumption is not always true, but at least in practice it is
+ ;; true in most cases.
+ (qprefix (propertize (substring qfullprefix qboundary)
+ 'face 'completions-common-part)))
+
+ ;; Here we choose to quote all elements returned, but a better option
+ ;; would be to return unquoted elements together with a function to
+ ;; requote them, so that *Completions* can show nicer unquoted values
+ ;; which only get quoted when needed by choose-completion.
+ (nconc
+ (mapcar (lambda (completion)
+ (cl-assert (string-prefix-p prefix completion 'ignore-case) t)
+ (let* ((new (substring completion (length prefix)))
+ (qnew (funcall qfun new))
+ (qcompletion (concat qprefix qnew)))
+ ;; FIXME: Similarly here, Cygwin's mapping trips this
+ ;; assertion.
+ ;;(cl-assert
+ ;; (completion--string-equal-p
+ ;; (funcall unquote
+ ;; (concat (substring string 0 qboundary)
+ ;; qcompletion))
+ ;; (concat (substring ustring 0 boundary)
+ ;; completion))
+ ;; t)
+ qcompletion))
+ completions)
+ qboundary))))
+
;; (defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b))
;; (defmacro dynamic-completion-table (fun) `(completion-table-dynamic ,fun))
(define-obsolete-function-alias
@@ -407,6 +644,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)))
@@ -509,11 +747,15 @@ styles for specific categories, such as files, buffers, etc."
Each override has the shape (CATEGORY . ALIST) where ALIST is
an association list that can specify properties such as:
- `styles': the list of `completion-styles' to use for that category.
-- `cycle': the `completion-cycle-threshold' to use for that category."
+- `cycle': the `completion-cycle-threshold' to use for that category.
+Categories are symbols such as `buffer' and `file', used when
+completing buffer and file names, respectively."
+ :version "24.1"
:type `(alist :key-type (choice :tag "Category"
(const buffer)
(const file)
(const unicode-name)
+ (const bookmark)
symbol)
:value-type
(set :tag "Properties to override"
@@ -531,21 +773,47 @@ an association list that can specify properties such as:
(delete-dups (append (cdr over) (copy-sequence completion-styles)))
completion-styles)))
+(defun completion--nth-completion (n string table pred point metadata)
+ "Call the Nth method of completion styles."
+ (unless metadata
+ (setq metadata
+ (completion-metadata (substring string 0 point) table pred)))
+ ;; We provide special support for quoting/unquoting here because it cannot
+ ;; reliably be done within the normal completion-table routines: Completion
+ ;; styles such as `substring' or `partial-completion' need to match the
+ ;; output of all-completions with the user's input, and since most/all
+ ;; quoting mechanisms allow several equivalent quoted forms, the
+ ;; completion-style can't do this matching (e.g. `substring' doesn't know
+ ;; that "\a\b\e" is a valid (quoted) substring of "label").
+ ;; The quote/unquote function needs to come from the completion table (rather
+ ;; than from completion-extra-properties) because it may apply only to some
+ ;; part of the string (e.g. substitute-in-file-name).
+ (let ((requote
+ (when (completion-metadata-get metadata 'completion--unquote-requote)
+ (let ((new (funcall table string point 'completion--unquote)))
+ (setq string (pop new))
+ (setq table (pop new))
+ (setq point (pop new))
+ (pop new))))
+ (result
+ (completion--some (lambda (style)
+ (funcall (nth n (assq style
+ completion-styles-alist))
+ string table pred point))
+ (completion--styles metadata))))
+ (if requote
+ (funcall requote result n)
+ result)))
+
(defun completion-try-completion (string table pred point &optional metadata)
"Try to complete STRING using completion table TABLE.
Only the elements of table that satisfy predicate PRED are considered.
POINT is the position of point within STRING.
The return value can be either nil to indicate that there is no completion,
t to indicate that STRING is the only possible completion,
-or a pair (STRING . NEWPOINT) of the completed result string together with
+or a pair (NEWSTRING . NEWPOINT) of the completed result string together with
a new position for point."
- (completion--some (lambda (style)
- (funcall (nth 1 (assq style completion-styles-alist))
- string table pred point))
- (completion--styles (or metadata
- (completion-metadata
- (substring string 0 point)
- table pred)))))
+ (completion--nth-completion 1 string table pred point metadata))
(defun completion-all-completions (string table pred point &optional metadata)
"List the possible completions of STRING in completion table TABLE.
@@ -555,13 +823,7 @@ The return value is a list of completions and may contain the base-size
in the last `cdr'."
;; FIXME: We need to additionally return the info needed for the
;; second part of completion-base-position.
- (completion--some (lambda (style)
- (funcall (nth 2 (assq style completion-styles-alist))
- string table pred point))
- (completion--styles (or metadata
- (completion-metadata
- (substring string 0 point)
- table pred)))))
+ (completion--nth-completion 2 string table pred point metadata))
(defun minibuffer--bitset (modified completions exact)
(logior (if modified 4 0)
@@ -571,6 +833,10 @@ in the last `cdr'."
(defun completion--replace (beg end newtext)
"Replace the buffer text between BEG and END with NEWTEXT.
Moves point to the end of the new text."
+ ;; The properties on `newtext' include things like
+ ;; completions-first-difference, which we don't want to include
+ ;; upon insertion.
+ (set-text-properties 0 (length newtext) nil newtext)
;; Maybe this should be in subr.el.
;; You'd think this is trivial to do, but details matter if you want
;; to keep markers "at the right place" and be robust in the face of
@@ -606,8 +872,9 @@ Depending on this setting `minibuffer-complete' may use cycling,
like `minibuffer-force-complete'.
If nil, cycling is never used.
If t, cycling is always used.
-If an integer, cycling is used as soon as there are fewer completion
-candidates than this number."
+If an integer, cycling is used so long as there are not more
+completion candidates than this number."
+ :version "24.1"
:type completion--cycling-threshold-type)
(defun completion--cycle-threshold (metadata)
@@ -617,6 +884,7 @@ candidates than this number."
(defvar completion-all-sorted-completions nil)
(make-variable-buffer-local 'completion-all-sorted-completions)
+(defvar-local completion--all-sorted-completions-location nil)
(defvar completion-cycling nil)
(defvar completion-fail-discreetly nil
@@ -696,23 +964,23 @@ when the buffer's text is already an exact match."
;; It did find a match. Do we match some possibility exactly now?
(let* ((exact (test-completion completion
- minibuffer-completion-table
- minibuffer-completion-predicate))
+ minibuffer-completion-table
+ minibuffer-completion-predicate))
(threshold (completion--cycle-threshold md))
- (comps
- ;; Check to see if we want to do cycling. We do it
- ;; here, after having performed the normal completion,
- ;; so as to take advantage of the difference between
- ;; try-completion and all-completions, for things
- ;; like completion-ignored-extensions.
+ (comps
+ ;; Check to see if we want to do cycling. We do it
+ ;; here, after having performed the normal completion,
+ ;; so as to take advantage of the difference between
+ ;; try-completion and all-completions, for things
+ ;; like completion-ignored-extensions.
(when (and threshold
- ;; Check that the completion didn't make
- ;; us jump to a different boundary.
- (or (not completed)
- (< (car (completion-boundaries
- (substring completion 0 comp-pos)
- minibuffer-completion-table
- minibuffer-completion-predicate
+ ;; Check that the completion didn't make
+ ;; us jump to a different boundary.
+ (or (not completed)
+ (< (car (completion-boundaries
+ (substring completion 0 comp-pos)
+ minibuffer-completion-table
+ minibuffer-completion-predicate
""))
comp-pos)))
(completion-all-sorted-completions))))
@@ -723,10 +991,10 @@ when the buffer's text is already an exact match."
;; This signal an (intended) error if comps is too
;; short or if completion-cycle-threshold is t.
(consp (nthcdr threshold comps)))))
- ;; Fewer than completion-cycle-threshold remaining
+ ;; Not more than completion-cycle-threshold remaining
;; completions: let's cycle.
(setq completed t exact t)
- (setq completion-all-sorted-completions comps)
+ (completion--cache-all-sorted-completions comps)
(minibuffer-force-complete))
(completed
;; We could also decide to refresh the completions,
@@ -741,9 +1009,9 @@ when the buffer's text is already an exact match."
'exact 'unknown))))
;; Show the completion table, if requested.
((not exact)
- (if (case completion-auto-help
- (lazy (eq this-command last-command))
- (t completion-auto-help))
+ (if (pcase completion-auto-help
+ (`lazy (eq this-command last-command))
+ (_ completion-auto-help))
(minibuffer-completion-help)
(completion--message "Next char not unique")))
;; If the last exact completion and this one were the same, it
@@ -767,7 +1035,8 @@ scroll the window of possible completions."
(interactive)
;; If the previous command was not this,
;; mark the completion buffer obsolete.
- (unless (eq this-command last-command)
+ (setq this-command 'completion-at-point)
+ (unless (eq 'completion-at-point last-command)
(completion--flush-all-sorted-completions)
(setq minibuffer-scroll-window nil))
@@ -787,15 +1056,25 @@ scroll the window of possible completions."
((and completion-cycling completion-all-sorted-completions)
(minibuffer-force-complete)
t)
- (t (case (completion--do-completion)
+ (t (pcase (completion--do-completion)
(#b000 nil)
- (t t)))))
-
-(defun completion--flush-all-sorted-completions (&rest _ignore)
- (remove-hook 'after-change-functions
- 'completion--flush-all-sorted-completions t)
- (setq completion-cycling nil)
- (setq completion-all-sorted-completions nil))
+ (_ t)))))
+
+(defun completion--cache-all-sorted-completions (comps)
+ (add-hook 'after-change-functions
+ 'completion--flush-all-sorted-completions nil t)
+ (setq completion--all-sorted-completions-location
+ (cons (copy-marker (field-beginning)) (copy-marker (field-end))))
+ (setq completion-all-sorted-completions comps))
+
+(defun completion--flush-all-sorted-completions (&optional start end _len)
+ (unless (and start end
+ (or (> start (cdr completion--all-sorted-completions-location))
+ (< end (car completion--all-sorted-completions-location))))
+ (remove-hook 'after-change-functions
+ 'completion--flush-all-sorted-completions t)
+ (setq completion-cycling nil)
+ (setq completion-all-sorted-completions nil)))
(defun completion--metadata (string base md-at-point table pred)
;; Like completion-metadata, but for the specific case of getting the
@@ -839,10 +1118,7 @@ scroll the window of possible completions."
;; Cache the result. This is not just for speed, but also so that
;; repeated calls to minibuffer-force-complete can cycle through
;; all possibilities.
- (add-hook 'after-change-functions
- 'completion--flush-all-sorted-completions nil t)
- (setq completion-all-sorted-completions
- (nconc all base-size))))))
+ (completion--cache-all-sorted-completions (nconc all base-size))))))
(defun minibuffer-force-complete ()
"Complete the minibuffer to an exact match.
@@ -851,7 +1127,7 @@ Repeated uses step through the possible completions."
;; FIXME: Need to deal with the extra-size issue here as well.
;; FIXME: ~/src/emacs/t<M-TAB>/lisp/minibuffer.el completes to
;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
- (let* ((start (field-beginning))
+ (let* ((start (copy-marker (field-beginning)))
(end (field-end))
;; (md (completion--field-metadata start))
(all (completion-all-sorted-completions))
@@ -861,14 +1137,15 @@ Repeated uses step through the possible completions."
(completion--message
(if all "No more completions" "No completions")))
((not (consp (cdr all)))
- (let ((mod (equal (car all) (buffer-substring-no-properties base end))))
- (if mod (completion--replace base end (car all)))
+ (let ((done (equal (car all) (buffer-substring-no-properties base end))))
+ (unless done (completion--replace base end (car all)))
(completion--done (buffer-substring-no-properties start (point))
- 'finished (unless mod "Sole completion"))))
+ 'finished (when done "Sole completion"))))
(t
- (setq completion-cycling t)
(completion--replace base end (car all))
(completion--done (buffer-substring-no-properties start (point)) 'sole)
+ ;; Set cycling after modifying the buffer since the flush hook resets it.
+ (setq completion-cycling t)
;; If completing file names, (car all) may be a directory, so we'd now
;; have a new set of possible completions and might want to reset
;; completion-all-sorted-completions to nil, but we prefer not to,
@@ -876,10 +1153,27 @@ Repeated uses step through the possible completions."
;; through the previous possible completions.
(let ((last (last all)))
(setcdr last (cons (car all) (cdr last)))
- (setq completion-all-sorted-completions (cdr all)))))))
+ (completion--cache-all-sorted-completions (cdr all)))
+ ;; Make sure repeated uses cycle, even though completion--done might
+ ;; have added a space or something that moved us outside of the field.
+ ;; (bug#12221).
+ (let* ((table minibuffer-completion-table)
+ (pred minibuffer-completion-predicate)
+ (extra-prop completion-extra-properties)
+ (cmd
+ (lambda () "Cycle through the possible completions."
+ (interactive)
+ (let ((completion-extra-properties extra-prop))
+ (completion-in-region start (point) table pred)))))
+ (set-temporary-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap completion-at-point] cmd)
+ (define-key map (vector last-command-event) cmd)
+ map)))))))
(defvar minibuffer-confirm-exit-commands
- '(minibuffer-complete minibuffer-complete-word PC-complete PC-complete-word)
+ '(completion-at-point minibuffer-complete
+ minibuffer-complete-word PC-complete PC-complete-word)
"A list of commands which cause an immediately following
`minibuffer-complete-and-exit' to ask for extra confirmation.")
@@ -945,15 +1239,15 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
(t
;; Call do-completion, but ignore errors.
- (case (condition-case nil
+ (pcase (condition-case nil
(completion--do-completion nil 'expect-exact)
(error 1))
- ((#b001 #b011) (exit-minibuffer))
+ ((or #b001 #b011) (exit-minibuffer))
(#b111 (if (not minibuffer-completion-confirm)
(exit-minibuffer)
(minibuffer-message "Confirm")
nil))
- (t nil))))))
+ (_ nil))))))
(defun completion--try-word-completion (string table predicate point md)
(let ((comp (completion-try-completion string table predicate point md)))
@@ -1048,9 +1342,9 @@ After one word is completed as much as possible, a space or hyphen
is added, provided that matches some possible completion.
Return nil if there is no valid completion, else t."
(interactive)
- (case (completion--do-completion 'completion--try-word-completion)
+ (pcase (completion--do-completion 'completion--try-word-completion)
(#b000 nil)
- (t t)))
+ (_ t)))
(defface completions-annotations '((t :inherit italic))
"Face to use for annotations in the *Completions* buffer.")
@@ -1256,17 +1550,24 @@ the completions buffer."
(defvar completion-extra-properties nil
"Property list of extra properties of the current completion job.
These include:
-`:annotation-function': Function to add annotations in the completions buffer.
- The function takes a completion and should either return nil, or a string
- that will be displayed next to the completion. The function can access the
- completion data via `minibuffer-completion-table' and related variables.
+
+`:annotation-function': Function to annotate the completions buffer.
+ The function must accept one argument, a completion string,
+ and return either nil or a string which is to be displayed
+ next to the completion (but which is not part of the
+ completion). The function can access the completion data via
+ `minibuffer-completion-table' and related variables.
+
`:exit-function': Function to run after completion is performed.
- The function takes at least 2 parameters (STRING and STATUS) where STRING
- is the text to which the field was completed and STATUS indicates what
- kind of operation happened: if text is now complete it's `finished', if text
- cannot be further completed but completion is not finished, it's `sole', if
- text is a valid completion but may be further completed, it's `exact', and
- other STATUSes may be added in the future.")
+
+ The function must accept two arguments, STRING and STATUS.
+ STRING is the text to which the field was completed, and
+ STATUS indicates what kind of operation happened:
+ `finished' - text is now complete
+ `sole' - text cannot be further completed but
+ completion is not finished
+ `exact' - text is a valid completion but may be further
+ completed.")
(defvar completion-annotate-function
nil
@@ -1290,8 +1591,7 @@ variables.")
(defun completion--done (string &optional finished message)
(let* ((exit-fun (plist-get completion-extra-properties :exit-function))
(pre-msg (and exit-fun (current-message))))
- (assert (memq finished '(exact sole finished unknown)))
- ;; FIXME: exit-fun should receive `finished' as a parameter.
+ (cl-assert (memq finished '(exact sole finished unknown)))
(when exit-fun
(when (eq finished 'unknown)
(setq finished
@@ -1462,7 +1762,7 @@ Return nil if there is no valid completion, else t.
Point needs to be somewhere between START and END.
PREDICATE (a function called with no arguments) says when to
exit."
- (assert (<= start (point)) (<= (point) end))
+ (cl-assert (<= start (point)) (<= (point) end))
(with-wrapper-hook
;; FIXME: Maybe we should use this hook to provide a "display
;; completions" operation as well.
@@ -1471,10 +1771,16 @@ exit."
(minibuffer-completion-predicate predicate)
(ol (make-overlay start end nil nil t)))
(overlay-put ol 'field 'completion)
+ ;; HACK: if the text we are completing is already in a field, we
+ ;; want the completion field to take priority (e.g. Bug#6830).
+ (overlay-put ol 'priority 100)
(when completion-in-region-mode-predicate
(completion-in-region-mode 1)
(setq completion-in-region--data
- (list (current-buffer) start end collection)))
+ (list (if (markerp start) start (copy-marker start))
+ (copy-marker end) collection)))
+ ;; FIXME: `minibuffer-complete' should call `completion-in-region' rather
+ ;; than the other way around!
(unwind-protect
(call-interactively 'minibuffer-complete)
(delete-overlay ol)))))
@@ -1483,7 +1789,7 @@ exit."
(let ((map (make-sparse-keymap)))
;; FIXME: Only works if completion-in-region-mode was activated via
;; completion-at-point called directly.
- (define-key map "?" 'completion-help-at-point)
+ (define-key map "\M-?" 'completion-help-at-point)
(define-key map "\t" 'completion-at-point)
map)
"Keymap activated during `completion-in-region'.")
@@ -1498,12 +1804,12 @@ exit."
(or unread-command-events ;Don't pop down the completions in the middle of
;mouse-drag-region/mouse-set-point.
(and completion-in-region--data
- (and (eq (car completion-in-region--data)
+ (and (eq (marker-buffer (nth 0 completion-in-region--data))
(current-buffer))
- (>= (point) (nth 1 completion-in-region--data))
+ (>= (point) (nth 0 completion-in-region--data))
(<= (point)
(save-excursion
- (goto-char (nth 2 completion-in-region--data))
+ (goto-char (nth 1 completion-in-region--data))
(line-end-position)))
(funcall completion-in-region-mode--predicate)))
(completion-in-region-mode -1)))
@@ -1511,7 +1817,10 @@ exit."
;; (defalias 'completion-in-region--prech 'completion-in-region--postch)
(define-minor-mode completion-in-region-mode
- "Transient minor mode used during `completion-in-region'."
+ "Transient minor mode used during `completion-in-region'.
+With a prefix argument ARG, enable the modemode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil."
:global t
(setq completion-in-region--data nil)
;; (remove-hook 'pre-command-hook #'completion-in-region--prech)
@@ -1523,7 +1832,7 @@ exit."
(unless (equal "*Completions*" (buffer-name (window-buffer)))
(minibuffer-hide-completions))
;; (add-hook 'pre-command-hook #'completion-in-region--prech)
- (assert completion-in-region-mode-predicate)
+ (cl-assert completion-in-region-mode-predicate)
(setq completion-in-region-mode--predicate
completion-in-region-mode-predicate)
(add-hook 'post-command-hook #'completion-in-region--postch)
@@ -1541,16 +1850,18 @@ exit."
Each function on this hook is called in turns without any argument and should
return either nil to mean that it is not applicable at point,
or a function of no argument to perform completion (discouraged),
-or a list of the form (START END COLLECTION &rest PROPS) where
+or a list of the form (START END COLLECTION . PROPS) where
START and END delimit the entity to complete and should include point,
COLLECTION is the completion table to use to complete it, and
PROPS is a property list for additional information.
Currently supported properties are all the properties that can appear in
`completion-extra-properties' plus:
`:predicate' a predicate that completion candidates need to satisfy.
- `:exclusive' If `no', means that if the completion data does not match the
- text at point failure, then instead of reporting a completion failure,
- the completion should try the next completion function.")
+ `:exclusive' If `no', means that if the completion table fails to
+ match the text at point, then instead of reporting a completion
+ failure, the completion should try the next completion function.
+As is the case with most hooks, the functions are responsible to preserve
+things like point and current buffer.")
(defvar completion--capf-misbehave-funs nil
"List of functions found on `completion-at-point-functions' that misbehave.
@@ -1566,10 +1877,10 @@ a completion function or god knows what else.")
;; always return the same kind of data, but this breaks down with functions
;; like comint-completion-at-point or mh-letter-completion-at-point, which
;; could be sometimes safe and sometimes misbehaving (and sometimes neither).
- (if (case which
- (all t)
- (safe (member fun completion--capf-safe-funs))
- (optimist (not (member fun completion--capf-misbehave-funs))))
+ (if (pcase which
+ (`all t)
+ (`safe (member fun completion--capf-safe-funs))
+ (`optimist (not (member fun completion--capf-misbehave-funs))))
(let ((res (funcall fun)))
(cond
((and (consp res) (not (functionp res)))
@@ -1603,17 +1914,19 @@ The completion method is determined by `completion-at-point-functions'."
(let ((res (run-hook-wrapped 'completion-at-point-functions
#'completion--capf-wrapper 'all)))
(pcase res
- (`(,_ . ,(and (pred functionp) f)) (funcall f))
- (`(,hookfun . (,start ,end ,collection . ,plist))
- (let* ((completion-extra-properties plist)
- (completion-in-region-mode-predicate
- (lambda ()
- ;; We're still in the same completion field.
- (eq (car-safe (funcall hookfun)) start))))
- (completion-in-region start end collection
- (plist-get plist :predicate))))
- ;; Maybe completion already happened and the function returned t.
- (_ (cdr res)))))
+ (`(,_ . ,(and (pred functionp) f)) (funcall f))
+ (`(,hookfun . (,start ,end ,collection . ,plist))
+ (unless (markerp start) (setq start (copy-marker start)))
+ (let* ((completion-extra-properties plist)
+ (completion-in-region-mode-predicate
+ (lambda ()
+ ;; We're still in the same completion field.
+ (let ((newstart (car-safe (funcall hookfun))))
+ (and newstart (= newstart start))))))
+ (completion-in-region start end collection
+ (plist-get plist :predicate))))
+ ;; Maybe completion already happened and the function returned t.
+ (_ (cdr res)))))
(defun completion-help-at-point ()
"Display the completions on the text around point.
@@ -1625,31 +1938,34 @@ The completion method is determined by `completion-at-point-functions'."
(pcase res
(`(,_ . ,(and (pred functionp) f))
(message "Don't know how to show completions for %S" f))
- (`(,hookfun . (,start ,end ,collection . ,plist))
- (let* ((minibuffer-completion-table collection)
- (minibuffer-completion-predicate (plist-get plist :predicate))
- (completion-extra-properties plist)
- (completion-in-region-mode-predicate
- (lambda ()
- ;; We're still in the same completion field.
- (eq (car-safe (funcall hookfun)) start)))
- (ol (make-overlay start end nil nil t)))
- ;; FIXME: We should somehow (ab)use completion-in-region-function or
- ;; introduce a corresponding hook (plus another for word-completion,
- ;; and another for force-completion, maybe?).
- (overlay-put ol 'field 'completion)
- (completion-in-region-mode 1)
- (setq completion-in-region--data
- (list (current-buffer) start end collection))
- (unwind-protect
- (call-interactively 'minibuffer-completion-help)
- (delete-overlay ol))))
- (`(,hookfun . ,_)
- ;; The hook function already performed completion :-(
- ;; Not much we can do at this point.
- (message "%s already performed completion!" hookfun)
- nil)
- (_ (message "Nothing to complete at point")))))
+ (`(,hookfun . (,start ,end ,collection . ,plist))
+ (unless (markerp start) (setq start (copy-marker start)))
+ (let* ((minibuffer-completion-table collection)
+ (minibuffer-completion-predicate (plist-get plist :predicate))
+ (completion-extra-properties plist)
+ (completion-in-region-mode-predicate
+ (lambda ()
+ ;; We're still in the same completion field.
+ (let ((newstart (car-safe (funcall hookfun))))
+ (and newstart (= newstart start)))))
+ (ol (make-overlay start end nil nil t)))
+ ;; FIXME: We should somehow (ab)use completion-in-region-function or
+ ;; introduce a corresponding hook (plus another for word-completion,
+ ;; and another for force-completion, maybe?).
+ (overlay-put ol 'field 'completion)
+ (overlay-put ol 'priority 100)
+ (completion-in-region-mode 1)
+ (setq completion-in-region--data
+ (list start (copy-marker end) collection))
+ (unwind-protect
+ (call-interactively 'minibuffer-completion-help)
+ (delete-overlay ol))))
+ (`(,hookfun . ,_)
+ ;; The hook function already performed completion :-(
+ ;; Not much we can do at this point.
+ (message "%s already performed completion!" hookfun)
+ nil)
+ (_ (message "Nothing to complete at point")))))
;;; Key bindings.
@@ -1686,10 +2002,10 @@ The completion method is determined by `completion-at-point-functions'."
Gets combined either with `minibuffer-local-completion-map' or
with `minibuffer-local-must-match-map'.")
-(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap))
-(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1")
(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map
'minibuffer-local-filename-must-match-map "23.1")
+(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap))
+(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1")
(let ((map minibuffer-local-ns-map))
(define-key map " " 'exit-minibuffer)
@@ -1727,7 +2043,10 @@ This is only used when the minibuffer area has no active minibuffer.")
;;; Completion tables.
(defun minibuffer--double-dollars (str)
- (replace-regexp-in-string "\\$" "$$" str))
+ ;; Reuse the actual "$" from the string to preserve any text-property it
+ ;; might have, such as `face'.
+ (replace-regexp-in-string "\\$" (lambda (dollar) (concat dollar dollar))
+ str))
(defun completion--make-envvar-table ()
(mapcar (lambda (enventry)
@@ -1735,6 +2054,8 @@ This is only used when the minibuffer area has no active minibuffer.")
process-environment))
(defconst completion--embedded-envvar-re
+ ;; We can't reuse env--substitute-vars-regexp because we need to match only
+ ;; potentially-unfinished envvars at end of string.
(concat "\\(?:^\\|[^$]\\(?:\\$\\$\\)*\\)"
"$\\([[:alnum:]_]*\\|{\\([^}]*\\)\\)\\'"))
@@ -1771,10 +2092,10 @@ same as `substitute-in-file-name'."
(if (eq action 'metadata)
'(metadata (category . environment-variable))
(let ((suffix (cdr action)))
- (list* 'boundaries
- (or (match-beginning 2) (match-beginning 1))
- (when (string-match "[^[:alnum:]_]" suffix)
- (match-beginning 0)))))))
+ `(boundaries
+ ,(or (match-beginning 2) (match-beginning 1))
+ . ,(when (string-match "[^[:alnum:]_]" suffix)
+ (match-beginning 0)))))))
(t
(if (eq (aref string (1- beg)) ?{)
(setq table (apply-partially 'completion-table-with-terminator
@@ -1790,17 +2111,23 @@ same as `substitute-in-file-name'."
(condition-case nil
(cond
((eq action 'metadata) '(metadata (category . file)))
+ ((string-match-p "\\`~[^/\\]*\\'" string)
+ (completion-table-with-context "~"
+ (mapcar (lambda (u) (concat u "/"))
+ (system-users))
+ (substring string 1)
+ pred action))
((eq (car-safe action) 'boundaries)
(let ((start (length (file-name-directory string)))
(end (string-match-p "/" (cdr action))))
- (list* 'boundaries
- ;; if `string' is "C:" in w32, (file-name-directory string)
- ;; returns "C:/", so `start' is 3 rather than 2.
- ;; Not quite sure what is The Right Fix, but clipping it
- ;; back to 2 will work for this particular case. We'll
- ;; see if we can come up with a better fix when we bump
- ;; into more such problematic cases.
- (min start (length string)) end)))
+ `(boundaries
+ ;; if `string' is "C:" in w32, (file-name-directory string)
+ ;; returns "C:/", so `start' is 3 rather than 2.
+ ;; Not quite sure what is The Right Fix, but clipping it
+ ;; back to 2 will work for this particular case. We'll
+ ;; see if we can come up with a better fix when we bump
+ ;; into more such problematic cases.
+ ,(min start (length string)) . ,end)))
((eq action 'lambda)
(if (zerop (length string))
@@ -1847,58 +2174,62 @@ same as `substitute-in-file-name'."
(make-obsolete-variable 'read-file-name-predicate
"use the regular PRED argument" "23.2")
-(defun completion--file-name-table (string pred action)
+(defun completion--sifn-requote (upos qstr)
+ ;; We're looking for `qpos' such that:
+ ;; (equal (substring (substitute-in-file-name qstr) 0 upos)
+ ;; (substitute-in-file-name (substring qstr 0 qpos)))
+ ;; Big problem here: we have to reverse engineer substitute-in-file-name to
+ ;; find the position corresponding to UPOS in QSTR, but
+ ;; substitute-in-file-name can do anything, depending on file-name-handlers.
+ ;; substitute-in-file-name does the following kind of things:
+ ;; - expand env-var references.
+ ;; - turn backslashes into slashes.
+ ;; - truncate some prefix of the input.
+ ;; - rewrite some prefix.
+ ;; Some of these operations are written in external libraries and we'd rather
+ ;; not hard code any assumptions here about what they actually do. IOW, we
+ ;; want to treat substitute-in-file-name as a black box, as much as possible.
+ ;; Kind of like in rfn-eshadow-update-overlay, only worse.
+ ;; Example of things we need to handle:
+ ;; - Tramp (substitute-in-file-name "/foo:~/bar//baz") => "/scpc:foo:/baz".
+ ;; - Cygwin (substitute-in-file-name "C:\bin") => "/usr/bin"
+ ;; (substitute-in-file-name "C:\") => "/"
+ ;; (substitute-in-file-name "C:\bi") => "/bi"
+ (let* ((ustr (substitute-in-file-name qstr))
+ (uprefix (substring ustr 0 upos))
+ qprefix)
+ ;; Main assumption: nothing after qpos should affect the text before upos,
+ ;; so we can work our way backward from the end of qstr, one character
+ ;; at a time.
+ ;; Second assumptions: If qpos is far from the end this can be a bit slow,
+ ;; so we speed it up by doing a first loop that skips a word at a time.
+ ;; This word-sized loop is careful not to cut in the middle of env-vars.
+ (while (let ((boundary (string-match "\\(\\$+{?\\)?\\w+\\W*\\'" qstr)))
+ (and boundary
+ (progn
+ (setq qprefix (substring qstr 0 boundary))
+ (string-prefix-p uprefix
+ (substitute-in-file-name qprefix)))))
+ (setq qstr qprefix))
+ (let ((qpos (length qstr)))
+ (while (and (> qpos 0)
+ (string-prefix-p uprefix
+ (substitute-in-file-name
+ (substring qstr 0 (1- qpos)))))
+ (setq qpos (1- qpos)))
+ (cons qpos #'minibuffer--double-dollars))))
+
+(defalias 'completion--file-name-table
+ (completion-table-with-quoting #'completion-file-name-table
+ #'substitute-in-file-name
+ #'completion--sifn-requote)
"Internal subroutine for `read-file-name'. Do not call this.
This is a completion table for file names, like `completion-file-name-table'
-except that it passes the file name through `substitute-in-file-name'."
- (cond
- ((eq (car-safe action) 'boundaries)
- ;; For the boundaries, we can't really delegate to
- ;; substitute-in-file-name+completion-file-name-table and then fix
- ;; them up (as we do for the other actions), because it would
- ;; require us to track the relationship between `str' and
- ;; `string', which is difficult. And in any case, if
- ;; substitute-in-file-name turns "fo-$TO-ba" into "fo-o/b-ba",
- ;; there's no way for us to return proper boundaries info, because
- ;; the boundary is not (yet) in `string'.
- ;;
- ;; FIXME: Actually there is a way to return correct boundaries
- ;; info, at the condition of modifying the all-completions
- ;; return accordingly. But for now, let's not bother.
- (completion-file-name-table string pred action))
-
- (t
- (let* ((default-directory
- (if (stringp pred)
- ;; It used to be that `pred' was abused to pass `dir'
- ;; as an argument.
- (prog1 (file-name-as-directory (expand-file-name pred))
- (setq pred nil))
- default-directory))
- (str (condition-case nil
- (substitute-in-file-name string)
- (error string)))
- (comp (completion-file-name-table
- str
- (with-no-warnings (or pred read-file-name-predicate))
- action)))
-
- (cond
- ((stringp comp)
- ;; Requote the $s before returning the completion.
- (minibuffer--double-dollars comp))
- ((and (null action) comp
- ;; Requote the $s before checking for changes.
- (setq str (minibuffer--double-dollars str))
- (not (string-equal string str)))
- ;; If there's no real completion, but substitute-in-file-name
- ;; changed the string, then return the new string.
- str)
- (t comp))))))
+except that it passes the file name through `substitute-in-file-name'.")
(defalias 'read-file-name-internal
- (completion-table-in-turn 'completion--embedded-envvar-table
- 'completion--file-name-table)
+ (completion-table-in-turn #'completion--embedded-envvar-table
+ #'completion--file-name-table)
"Internal subroutine for `read-file-name'. Do not call this.")
(defvar read-file-name-function 'read-file-name-default
@@ -1970,14 +2301,24 @@ such as making the current buffer visit no file in the case of
(defun read-file-name (prompt &optional dir default-filename mustmatch initial predicate)
"Read file name, prompting with PROMPT and completing in directory DIR.
Value is not expanded---you must call `expand-file-name' yourself.
-Default name to DEFAULT-FILENAME if user exits the minibuffer with
-the same non-empty string that was inserted by this function.
- (If DEFAULT-FILENAME is omitted, the visited file name is used,
- except that if INITIAL is specified, that combined with DIR is used.
- If DEFAULT-FILENAME is a list of file names, the first file name is used.)
-If the user exits with an empty minibuffer, this function returns
-an empty string. (This can only happen if the user erased the
-pre-inserted contents or if `insert-default-directory' is nil.)
+
+DIR is the directory to use for completing relative file names.
+It should be an absolute directory name, or nil (which means the
+current buffer's value of `default-directory').
+
+DEFAULT-FILENAME specifies the default file name to return if the
+user exits the minibuffer with the same non-empty string inserted
+by this function. If DEFAULT-FILENAME is a string, that serves
+as the default. If DEFAULT-FILENAME is a list of strings, the
+first string is the default. If DEFAULT-FILENAME is omitted or
+nil, then if INITIAL is non-nil, the default is DIR combined with
+INITIAL; otherwise, if the current buffer is visiting a file,
+that file serves as the default; otherwise, the default is simply
+the string inserted into the minibuffer.
+
+If the user exits with an empty minibuffer, return an empty
+string. (This happens only if the user erases the pre-inserted
+contents, or if `insert-default-directory' is nil.)
Fourth arg MUSTMATCH can take the following values:
- nil means that the user can exit with any input.
@@ -1994,23 +2335,45 @@ Fourth arg MUSTMATCH can take the following values:
Fifth arg INITIAL specifies text to start with.
-If optional sixth arg PREDICATE is non-nil, possible completions and
-the resulting file name must satisfy (funcall PREDICATE NAME).
-DIR should be an absolute directory name. It defaults to the value of
-`default-directory'.
+Sixth arg PREDICATE, if non-nil, should be a function of one
+argument; then a file name is considered an acceptable completion
+alternative only if PREDICATE returns non-nil with the file name
+as its argument.
If this command was invoked with the mouse, use a graphical file
dialog if `use-dialog-box' is non-nil, and the window system or X
toolkit in use provides a file dialog box, and DIR is not a
-remote file. For graphical file dialogs, any the special values
-of MUSTMATCH; `confirm' and `confirm-after-completion' are
-treated as equivalent to nil.
+remote file. For graphical file dialogs, any of the special values
+of MUSTMATCH `confirm' and `confirm-after-completion' are
+treated as equivalent to nil. Some graphical file dialogs respect
+a MUSTMATCH value of t, and some do not (or it only has a cosmetic
+effect, and does not actually prevent the user from entering a
+non-existent file).
See also `read-file-name-completion-ignore-case'
and `read-file-name-function'."
+ ;; If x-gtk-use-old-file-dialog = t (xg_get_file_with_selection),
+ ;; then MUSTMATCH is enforced. But with newer Gtk
+ ;; (xg_get_file_with_chooser), it only has a cosmetic effect.
+ ;; The user can still type a non-existent file name.
(funcall (or read-file-name-function #'read-file-name-default)
prompt dir default-filename mustmatch initial predicate))
+(defvar minibuffer-local-filename-syntax
+ (let ((table (make-syntax-table))
+ (punctuation (car (string-to-syntax "."))))
+ ;; Convert all punctuation entries to symbol.
+ (map-char-table (lambda (c syntax)
+ (when (eq (car syntax) punctuation)
+ (modify-syntax-entry c "_" table)))
+ table)
+ (mapc
+ (lambda (c)
+ (modify-syntax-entry c "." table))
+ '(?/ ?: ?\\))
+ table)
+ "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
;; minibuffer-local-completion-map. It shouldn't be exported to Elisp.
@@ -2018,7 +2381,7 @@ and `read-file-name-function'."
;; use (eq minibuffer-completion-table #'read-file-name-internal), which is
;; probably even worse. Maybe We should add some read-file-name-setup-hook
;; instead, but for now, let's keep this non-obsolete.
-;;(make-obsolete-variable 'minibuffer-completing-file-name nil "24.1" 'get)
+;;(make-obsolete-variable 'minibuffer-completing-file-name nil "future" 'get)
(defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate)
"Default method for reading file names.
@@ -2079,7 +2442,8 @@ See `read-file-name' for the meaning of the arguments."
(lambda ()
(with-current-buffer
(window-buffer (minibuffer-selected-window))
- (read-file-name--defaults dir initial)))))
+ (read-file-name--defaults dir initial))))
+ (set-syntax-table minibuffer-local-filename-syntax))
(completing-read prompt 'read-file-name-internal
pred mustmatch insdef
'file-name-history default-filename)))
@@ -2303,6 +2667,7 @@ Those chars are treated as delimiters iff this variable is non-nil.
I.e. if non-nil, M-x SPC will just insert a \"-\" in the minibuffer, whereas
if nil, it will list all possible commands in *Completions* because none of
the commands start with a \"-\" or a SPC."
+ :version "24.1"
:type 'boolean)
(defun completion-pcm--pattern-trivial-p (pattern)
@@ -2350,7 +2715,7 @@ or a symbol, see `completion-pcm--merge-completions'."
(setq p0 (1+ p)))
(push 'any pattern)
(setq p0 p))
- (incf p))
+ (cl-incf p))
;; An empty string might be erroneously added at the beginning.
;; It should be avoided properly, but it's so easy to remove it here.
@@ -2375,7 +2740,7 @@ or a symbol, see `completion-pcm--merge-completions'."
(defun completion-pcm--all-completions (prefix pattern table pred)
"Find all completions for PATTERN in TABLE obeying PRED.
PATTERN is as returned by `completion-pcm--string->pattern'."
- ;; (assert (= (car (completion-boundaries prefix table pred ""))
+ ;; (cl-assert (= (car (completion-boundaries prefix table pred ""))
;; (length prefix)))
;; Find an initial list of possible completions.
(if (completion-pcm--pattern-trivial-p pattern)
@@ -2449,9 +2814,9 @@ filter out additional entries (because TABLE might not obey PRED)."
;; The prefix has no completions at all, so we should try and fix
;; that first.
(let ((substring (substring prefix 0 -1)))
- (destructuring-bind (subpat suball subprefix _subsuffix)
- (completion-pcm--find-all-completions
- substring table pred (length substring) filter)
+ (pcase-let ((`(,subpat ,suball ,subprefix ,_subsuffix)
+ (completion-pcm--find-all-completions
+ substring table pred (length substring) filter)))
(let ((sep (aref prefix (1- (length prefix))))
;; Text that goes between the new submatches and the
;; completion substring.
@@ -2515,22 +2880,22 @@ filter out additional entries (because TABLE might not obey PRED)."
(list pattern all prefix suffix)))))
(defun completion-pcm-all-completions (string table pred point)
- (destructuring-bind (pattern all &optional prefix _suffix)
- (completion-pcm--find-all-completions string table pred point)
+ (pcase-let ((`(,pattern ,all ,prefix ,_suffix)
+ (completion-pcm--find-all-completions string table pred point)))
(when all
(nconc (completion-pcm--hilit-commonality pattern all)
(length prefix)))))
(defun completion--sreverse (str)
"Like `reverse' but for a string STR rather than a list."
- (apply 'string (nreverse (mapcar 'identity str))))
+ (apply #'string (nreverse (mapcar 'identity str))))
(defun completion--common-suffix (strs)
"Return the common suffix of the strings STRS."
(completion--sreverse
(try-completion
""
- (mapcar 'completion--sreverse strs))))
+ (mapcar #'completion--sreverse strs))))
(defun completion-pcm--merge-completions (strs pattern)
"Extract the commonality in STRS, with the help of PATTERN.
@@ -2615,7 +2980,7 @@ the same set of elements."
;; `any' it could lead to a merged completion that
;; doesn't itself match the candidates.
(let ((suffix (completion--common-suffix comps)))
- (assert (stringp suffix))
+ (cl-assert (stringp suffix))
(unless (equal suffix "")
(push suffix res)))))
(setq fixed "")))))
@@ -2672,18 +3037,18 @@ the same set of elements."
mergedpat))
;; New pos from the start.
(newpos (length (completion-pcm--pattern->string pointpat)))
- ;; Do it afterwards because it changes `pointpat' by sideeffect.
+ ;; Do it afterwards because it changes `pointpat' by side effect.
(merged (completion-pcm--pattern->string (nreverse mergedpat))))
(setq suffix (completion--merge-suffix merged newpos suffix))
(cons (concat prefix merged suffix) (+ newpos (length prefix)))))))
(defun completion-pcm-try-completion (string table pred point)
- (destructuring-bind (pattern all prefix suffix)
- (completion-pcm--find-all-completions
- string table pred point
- (if minibuffer-completing-file-name
- 'completion-pcm--filename-try-filter))
+ (pcase-let ((`(,pattern ,all ,prefix ,suffix)
+ (completion-pcm--find-all-completions
+ string table pred point
+ (if minibuffer-completing-file-name
+ 'completion-pcm--filename-try-filter))))
(completion-pcm--merge-try pattern all prefix suffix)))
;;; Substring completion
@@ -2704,15 +3069,17 @@ the same set of elements."
(list all pattern prefix suffix (car bounds))))
(defun completion-substring-try-completion (string table pred point)
- (destructuring-bind (all pattern prefix suffix _carbounds)
- (completion-substring--all-completions string table pred point)
+ (pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
+ (completion-substring--all-completions
+ string table pred point)))
(if minibuffer-completing-file-name
(setq all (completion-pcm--filename-try-filter all)))
(completion-pcm--merge-try pattern all prefix suffix)))
(defun completion-substring-all-completions (string table pred point)
- (destructuring-bind (all pattern prefix _suffix _carbounds)
- (completion-substring--all-completions string table pred point)
+ (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
+ (completion-substring--all-completions
+ string table pred point)))
(when all
(nconc (completion-pcm--hilit-commonality pattern all)
(length prefix)))))
diff --git a/lisp/misc.el b/lisp/misc.el
index 8087c7f5259..96b739dc2b7 100644
--- a/lisp/misc.el
+++ b/lisp/misc.el
@@ -1,6 +1,6 @@
;;; misc.el --- some nonstandard editing and utility commands for Emacs
-;; Copyright (C) 1989, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: convenience
@@ -99,14 +99,14 @@ Ignores CHAR at point."
(defun forward-to-word (arg)
"Move forward until encountering the beginning of a word.
With argument, do this that many times."
- (interactive "p")
+ (interactive "^p")
(or (re-search-forward (if (> arg 0) "\\W\\b" "\\b\\W") nil t arg)
(goto-char (if (> arg 0) (point-max) (point-min)))))
(defun backward-to-word (arg)
"Move backward until encountering the end of a word.
With argument, do this that many times."
- (interactive "p")
+ (interactive "^p")
(forward-to-word (- arg)))
;;;###autoload
@@ -138,6 +138,19 @@ variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'."
(defvar list-dynamic-libraries--loaded-only-p)
(make-variable-buffer-local 'list-dynamic-libraries--loaded-only-p)
+(defun list-dynamic-libraries--loaded (from)
+ "Compute the \"Loaded from\" column.
+Internal use only."
+ (if from
+ (let ((name (car from))
+ (path (or (cdr from) "<unknown>")))
+ ;; This is a roundabout way to change the tooltip without
+ ;; having to replace the default printer function
+ (propertize name
+ 'display (propertize name
+ 'help-echo (concat "Loaded from: " path))))
+ ""))
+
(defun list-dynamic-libraries--refresh ()
"Recompute the list of dynamic libraries.
Internal use only."
@@ -159,7 +172,7 @@ Internal use only."
(when (or from
(not list-dynamic-libraries--loaded-only-p))
(push (list id (vector (symbol-name id)
- (or from "")
+ (list-dynamic-libraries--loaded from)
(mapconcat 'identity (cdr lib) ", ")))
tabulated-list-entries)))))
diff --git a/lisp/misearch.el b/lisp/misearch.el
index de1a32ff7d5..502de52a05f 100644
--- a/lisp/misearch.el
+++ b/lisp/misearch.el
@@ -1,6 +1,6 @@
;;; misearch.el --- isearch extensions for multi-buffer search
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Juri Linkov <juri@jurta.org>
;; Keywords: matching
@@ -130,13 +130,7 @@ Intended to be added to `isearch-mode-hook'."
(lambda (string bound noerror)
(let ((search-fun
;; Use standard functions to search within one buffer
- (cond
- (isearch-word
- (if isearch-forward 'word-search-forward 'word-search-backward))
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward))))
+ (isearch-search-fun-default))
found buffer)
(or
;; 1. First try searching in the initial buffer
@@ -379,5 +373,5 @@ whose file names match the specified wildcard."
(provide 'multi-isearch)
-
+(provide 'misearch)
;;; misearch.el ends here
diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el
index 92fbdeb74e0..a8e32bec1ae 100644
--- a/lisp/mouse-copy.el
+++ b/lisp/mouse-copy.el
@@ -1,6 +1,6 @@
;;; mouse-copy.el --- one-click text copy and move
-;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: John Heidemann <johnh@ISI.EDU>
;; Keywords: mouse
@@ -35,7 +35,7 @@
;; If you like mouse-copy, you should also check out mouse-drag
;; for ``one-click scrolling''.
;;
-;; To use mouse-copy, place the following in your .emacs file:
+;; To use mouse-copy, place the following in your init file:
;; (require 'mouse-copy)
;; (global-set-key [M-down-mouse-1] 'mouse-drag-secondary-pasting)
;; (global-set-key [M-S-down-mouse-1] 'mouse-drag-secondary-moving)
diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
index fb6c8b7470f..acdad9a42cf 100644
--- a/lisp/mouse-drag.el
+++ b/lisp/mouse-drag.el
@@ -1,6 +1,6 @@
;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling
-;; Copyright (C) 1996-1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2012 Free Software Foundation, Inc.
;; Author: John Heidemann <johnh@ISI.EDU>
;; Keywords: mouse
@@ -46,7 +46,7 @@
;; If you like mouse-drag, you should also check out mouse-copy
;; for ``one-click text copy and move''.
;;
-;; To use mouse-drag, place the following in your .emacs file:
+;; To use mouse-drag, place the following in your init file:
;; -either-
;; (global-set-key [down-mouse-2] 'mouse-drag-throw)
;; -or-
@@ -169,7 +169,7 @@ Basically, we check for existing horizontal scrolling."
nil))))))
(defvar mouse-throw-with-scroll-bar nil
- "*Set direction of mouse-throwing.
+ "Set direction of mouse-throwing.
If nil, the text moves in the direction the mouse moves.
If t, the scroll bar moves in the direction the mouse moves.")
(defconst mouse-throw-magnifier-min -6)
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 615062dc031..61d70404bd6 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1,6 +1,6 @@
-;;; mouse.el --- window system-independent mouse support
+;;; mouse.el --- window system-independent mouse support -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1995, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1999-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: hardware, mouse
@@ -62,7 +62,7 @@ typically sets point where you click the mouse).
If value is an integer, the time elapsed between pressing and
releasing the mouse button determines whether to follow the link
or perform the normal Mouse-1 action (typically set point).
-The absolute numeric value specifices the maximum duration of a
+The absolute numeric value specifies the maximum duration of a
\"short click\" in milliseconds. A positive value means that a
short click follows the link, and a longer click performs the
normal action. A negative value gives the opposite behavior.
@@ -101,8 +101,8 @@ point at the click position."
"Popup the given menu and call the selected option.
MENU can be a keymap, an easymenu-style menu or a list of keymaps as for
`x-popup-menu'.
-POSITION can be a click event or ((XOFFSET YOFFSET) WINDOW) and defaults to
- the current mouse position.
+The menu is shown at the place where POSITION specifies. About
+the form of POSITION, see `popup-menu-normalize-position'.
PREFIX is the prefix argument (if any) to pass to the command."
(let* ((map (cond
((keymapp menu) menu)
@@ -111,10 +111,8 @@ PREFIX is the prefix argument (if any) to pass to the command."
(filter (when (symbolp map)
(plist-get (get map 'menu-prop) :filter))))
(if filter (funcall filter (symbol-function map)) map)))))
- event cmd)
- (unless position
- (let ((mp (mouse-pixel-position)))
- (setq position (list (list (cadr mp) (cddr mp)) (car mp)))))
+ event cmd
+ (position (popup-menu-normalize-position position)))
;; The looping behavior was taken from lmenu's popup-menu-popup
(while (and map (setq event
;; map could be a prefix key, in which case
@@ -132,7 +130,7 @@ PREFIX is the prefix argument (if any) to pass to the command."
binding)
(while (and map (null binding))
(setq binding (lookup-key (car map) mouse-click))
- (if (numberp binding) ; `too long'
+ (if (numberp binding) ; `too long'
(setq binding nil))
(setq map (cdr map)))
binding)
@@ -152,6 +150,26 @@ PREFIX is the prefix argument (if any) to pass to the command."
;; mouse-major-mode-menu was using `command-execute' instead.
(call-interactively cmd))))
+(defun popup-menu-normalize-position (position)
+ "Convert the POSITION to the form which `popup-menu' expects internally.
+POSITION can an event, a posn- value, a value having
+form ((XOFFSET YOFFSET) WINDOW), or nil.
+If nil, the current mouse position is used."
+ (pcase position
+ ;; nil -> mouse cursor position
+ (`nil
+ (let ((mp (mouse-pixel-position)))
+ (list (list (cadr mp) (cddr mp)) (car mp))))
+ ;; Value returned from `event-end' or `posn-at-point'.
+ ((pred posnp)
+ (let ((xy (posn-x-y position)))
+ (list (list (car xy) (cdr xy))
+ (posn-window position))))
+ ;; Event.
+ ((pred eventp)
+ (popup-menu-normalize-position (event-end position)))
+ (t position)))
+
(defun minor-mode-menu-from-indicator (indicator)
"Show menu for minor mode specified by INDICATOR.
Interactively, INDICATOR is read using completion.
@@ -194,8 +212,7 @@ items `Turn Off' and `Help'."
(newmap (if ancestor
(make-sparse-keymap (concat (format-mode-line mode-name)
" Mode"))
- menu-bar-edit-menu))
- uniq)
+ menu-bar-edit-menu)))
(if ancestor
(set-keymap-parent newmap ancestor))
newmap))
@@ -267,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
@@ -291,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.
@@ -299,7 +316,7 @@ Use the former if the menu bar is showing, otherwise the latter."
(let ((w (posn-window (event-start event))))
(and (window-minibuffer-p w)
(not (minibuffer-window-active-p w))
- (error "Minibuffer window is not active")))
+ (user-error "Minibuffer window is not active")))
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook))
@@ -389,10 +406,11 @@ This command must be bound to a mouse click."
;; Note that `window-in-direction' replaces `mouse-drag-window-above'
;; and `mouse-drag-vertical-line-rightward-window' with Emacs 24.1.
+
(defun mouse-drag-line (start-event line)
- "Drag some line with the mouse.
+ "Drag a mode line, header line, or vertical line with the mouse.
START-EVENT is the starting mouse-event of the drag action. LINE
-must be one of the symbols header, mode, or vertical."
+must be one of the symbols `header', `mode', or `vertical'."
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(let* ((echo-keystrokes 0)
@@ -401,63 +419,60 @@ must be one of the symbols header, mode, or vertical."
(frame (window-frame window))
(minibuffer-window (minibuffer-window frame))
(on-link (and mouse-1-click-follows-link
- (or mouse-1-click-in-non-selected-windows
- (eq window (selected-window)))
(mouse-on-link-p start)))
- (enlarge-minibuffer
- (and (eq line 'mode)
- (not resize-mini-windows)
- (eq (window-frame minibuffer-window) frame)
- (not (one-window-p t frame))
- (= (nth 1 (window-edges minibuffer-window))
- (nth 3 (window-edges window)))))
- (which-side
- (and (eq line 'vertical)
- (or (cdr (assq 'vertical-scroll-bars (frame-parameters frame)))
- 'right)))
- done event mouse growth dragged)
+ (side (and (eq line 'vertical)
+ (or (cdr (assq 'vertical-scroll-bars
+ (frame-parameters frame)))
+ 'right)))
+ (draggable t)
+ event position growth dragged)
(cond
((eq line 'header)
;; Check whether header-line can be dragged at all.
(if (window-at-side-p window 'top)
- (setq done t)
+ (setq draggable nil)
(setq window (window-in-direction 'above window t))))
((eq line 'mode)
;; Check whether mode-line can be dragged at all.
- (when (and (window-at-side-p window 'bottom)
- (not enlarge-minibuffer))
- (setq done t)))
+ (and (window-at-side-p window 'bottom)
+ ;; Allow resizing the minibuffer window if it's on the same
+ ;; frame as and immediately below the clicked window, and
+ ;; it's active or `resize-mini-windows' is nil.
+ (not (and (eq (window-frame minibuffer-window) frame)
+ (= (nth 1 (window-edges minibuffer-window))
+ (nth 3 (window-edges window)))
+ (or (not resize-mini-windows)
+ (eq minibuffer-window
+ (active-minibuffer-window)))))
+ (setq draggable nil)))
((eq line 'vertical)
- ;; Get the window to adjust for the vertical case.
- (setq window
- (if (eq which-side 'right)
- ;; If the scroll bar is on the window's right or there's
- ;; no scroll bar at all, adjust the window where the
- ;; start-event occurred.
- window
- ;; If the scroll bar is on the start-event window's left,
- ;; adjust the window on the left of it.
- (window-in-direction 'left window t)))))
+ ;; Get the window to adjust for the vertical case. If the
+ ;; scroll bar is on the window's right or there's no scroll bar
+ ;; at all, adjust the window where the start-event occurred. If
+ ;; the scroll bar is on the start-event window's left, adjust
+ ;; the window on the left of it.
+ (unless (eq side 'right)
+ (setq window (window-in-direction 'left window t)))))
;; Start tracking.
(track-mouse
;; Loop reading events and sampling the position of the mouse.
- (while (not done)
+ (while draggable
(setq event (read-event))
- (setq mouse (mouse-position))
+ (setq position (mouse-position))
;; Do nothing if
;; - there is a switch-frame event.
;; - the mouse isn't in the frame that we started in
;; - the mouse isn't in any Emacs frame
;; Drag if
;; - there is a mouse-movement event
- ;; - there is a scroll-bar-movement event (??)
+ ;; - there is a scroll-bar-movement event (Why? -- cyd)
;; (same as mouse movement for our purposes)
;; Quit if
;; - there is a keyboard event or some other unknown event.
(cond
((not (consp event))
- (setq done t))
+ (setq draggable nil))
((memq (car event) '(switch-frame select-window))
nil)
((not (memq (car event) '(mouse-movement scroll-bar-movement)))
@@ -471,53 +486,39 @@ must be one of the symbols header, mode, or vertical."
(memq (car event) '(drag-mouse-1 mouse-1))
(eq (car event) 'drag-mouse-1)))
(push event unread-command-events)))
- (setq done t))
- ((or (not (eq (car mouse) frame)) (null (car (cdr mouse))))
+ (setq draggable nil))
+ ((or (not (eq (car position) frame))
+ (null (car (cdr position))))
nil)
((eq line 'vertical)
- ;; Drag vertical divider (the calculations below are those
- ;; from Emacs 23).
- (setq growth
- (- (- (cadr mouse)
- (if (eq which-side 'right) 0 2))
- (nth 2 (window-edges window))
- -1))
+ ;; Drag vertical divider.
+ (setq growth (- (cadr position)
+ (if (eq side 'right) 0 2)
+ (nth 2 (window-edges window))
+ -1))
(unless (zerop growth)
- ;; Remember that we dragged.
(setq dragged t))
(adjust-window-trailing-edge window growth t))
- (t
- ;; Drag horizontal divider (the calculations below are those
- ;; from Emacs 23).
+ (draggable
+ ;; Drag horizontal divider.
(setq growth
(if (eq line 'mode)
- (- (cddr mouse) (nth 3 (window-edges window)) -1)
+ (- (cddr position) (nth 3 (window-edges window)) -1)
;; The window's top includes the header line!
- (- (nth 3 (window-edges window)) (cddr mouse))))
-
+ (- (nth 3 (window-edges window)) (cddr position))))
(unless (zerop growth)
- ;; Remember that we dragged.
(setq dragged t))
-
- (cond
- (enlarge-minibuffer
- (adjust-window-trailing-edge window growth))
- ((eq line 'mode)
- (adjust-window-trailing-edge window growth))
- (t
- (adjust-window-trailing-edge window (- growth)))))))
-
- ;; Presumably, if this was just a click, the last event should be
- ;; `mouse-1', whereas if this did move the mouse, it should be a
- ;; `drag-mouse-1'. `dragged' nil tells us that we never dragged
- ;; and `on-link' tells us that there is a link to follow.
- (when (and on-link (not dragged)
- (eq 'mouse-1 (car-safe (car unread-command-events))))
- ;; If mouse-2 has never been done by the user, it doesn't
- ;; have the necessary property to be interpreted correctly.
- (put 'mouse-2 'event-kind 'mouse-click)
- (setcar unread-command-events
- (cons 'mouse-2 (cdar unread-command-events)))))))
+ (adjust-window-trailing-edge window (if (eq line 'mode)
+ growth
+ (- growth)))))))
+ ;; Process the terminating event.
+ (when (and (mouse-event-p event) on-link (not dragged)
+ (mouse--remap-link-click-p start-event event))
+ ;; If mouse-2 has never been done by the user, it doesn't have
+ ;; the necessary property to be interpreted correctly.
+ (put 'mouse-2 'event-kind 'mouse-click)
+ (setcar event 'mouse-2)
+ (push event unread-command-events))))
(defun mouse-drag-mode-line (start-event)
"Change the height of a window by dragging on the mode line."
@@ -793,10 +794,8 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
;; Don't count the mode line.
(1- (nth 3 bounds))))
(on-link (and mouse-1-click-follows-link
- (or mouse-1-click-in-non-selected-windows
- (eq start-window original-window))
;; Use start-point before the intangibility
- ;; treatment, in case we click on a link inside an
+ ;; treatment, in case we click on a link inside
;; intangible text.
(mouse-on-link-p start-posn)))
(click-count (1- (event-click-count start-event)))
@@ -805,9 +804,9 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
(= click-count 1)))
;; Suppress automatic hscrolling, because that is a nuisance
;; when setting point near the right fringe (but see below).
- (automatic-hscrolling-saved automatic-hscrolling)
- (automatic-hscrolling nil)
- event end end-point)
+ (auto-hscroll-mode-saved auto-hscroll-mode)
+ (auto-hscroll-mode nil)
+ moved-off-start event end end-point)
(setq mouse-selection-click-count click-count)
;; In case the down click is in the middle of some intangible text,
@@ -838,10 +837,13 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
;; Automatic hscrolling did not occur during the call to
;; `read-event'; but if the user subsequently drags the
;; mouse, go ahead and hscroll.
- (let ((automatic-hscrolling automatic-hscrolling-saved))
+ (let ((auto-hscroll-mode auto-hscroll-mode-saved))
(redisplay))
(setq end (event-end event)
end-point (posn-point end))
+ ;; Note whether the mouse has left the starting position.
+ (unless (eq end-point start-point)
+ (setq moved-off-start t))
(if (and (eq (posn-window end) start-window)
(integer-or-marker-p end-point))
(mouse--drag-set-mark-and-point start-point
@@ -882,11 +884,13 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
(let (deactivate-mark)
(copy-region-as-kill (mark) (point)))))
- ;; If point hasn't moved, run the binding of the
- ;; terminating up-event.
+ ;; Otherwise, run binding of terminating up-event.
(if do-multi-click
(goto-char start-point)
- (deactivate-mark))
+ (deactivate-mark)
+ (unless moved-off-start
+ (pop-mark)))
+
(when (and (functionp fun)
(= start-hscroll (window-hscroll start-window))
;; Don't run the up-event handler if the window
@@ -1147,7 +1151,7 @@ regardless of where you click."
(or mouse-yank-at-point (mouse-set-point click))
(let ((primary
(cond
- ((eq system-type 'windows-nt)
+ ((eq (framep (selected-frame)) 'w32)
;; MS-Windows emulates PRIMARY in x-get-selection, but not
;; in x-get-selection-value (the latter only accesses the
;; clipboard). So try PRIMARY first, in case they selected
@@ -1947,12 +1951,14 @@ choose a font."
(choice
;; Either choice == 'x-select-font, or choice is a
;; symbol whose name is a font.
- (buffer-face-mode-invoke (font-face-attributes
- (if (eq choice 'x-select-font)
- (x-select-font)
- (symbol-name choice)))
- t
- (called-interactively-p 'interactive))))))))
+ (let ((font (if (eq choice 'x-select-font)
+ (x-select-font)
+ (symbol-name choice))))
+ (buffer-face-mode-invoke
+ (if (fontp font 'font-spec)
+ (list :font font)
+ (font-face-attributes font))
+ t (called-interactively-p 'interactive)))))))))
;;; Bindings for mouse commands.
diff --git a/lisp/mpc.el b/lisp/mpc.el
index 224131623f4..e8b5c50e561 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -1,6 +1,6 @@
;;; mpc.el --- A client for the Music Player Daemon -*- coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: multimedia
@@ -92,10 +92,10 @@
;; UI-commands : mpc-
;; internal : mpc--
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup mpc ()
- "A Client for the Music Player Daemon."
+ "Client for the Music Player Daemon (mpd)."
:prefix "mpc-"
:group 'multimedia
:group 'applications)
@@ -184,10 +184,7 @@ numerically rather than lexicographically."
(abs res))
res))))))))
-(defun mpc-string-prefix-p (str1 str2)
- ;; FIXME: copied from pcvs-util.el.
- "Tell whether STR1 is a prefix of STR2."
- (eq t (compare-strings str2 nil (length str1) str1 nil nil)))
+(define-obsolete-function-alias 'mpc-string-prefix-p 'string-prefix-p "24.3")
;; This can speed up mpc--song-search significantly. The table may grow
;; very large, tho. It's only bounded by the fact that it gets flushed
@@ -202,9 +199,10 @@ numerically rather than lexicographically."
(defcustom mpc-host
(concat (or (getenv "MPD_HOST") "localhost")
(if (getenv "MPD_PORT") (concat ":" (getenv "MPD_PORT"))))
- "Host (and port) where the Music Player Daemon is running.
-The format is \"HOST\" or \"HOST:PORT\" where PORT defaults to 6600
-and HOST defaults to localhost."
+ "Host (and port) where the Music Player Daemon is running. The
+format is \"HOST\", \"HOST:PORT\", \"PASSWORD@HOST\" or
+\"PASSWORD@HOST:PORT\" where PASSWORD defaults to no password, PORT
+defaults to 6600 and HOST defaults to localhost."
:type 'string)
(defvar mpc-proc nil)
@@ -255,20 +253,30 @@ and HOST defaults to localhost."
(funcall callback)))))))))
(defun mpc--proc-connect (host)
- (mpc--debug "Connecting to %s..." host)
- (with-current-buffer (get-buffer-create (format " *mpc-%s*" host))
- ;; (pop-to-buffer (current-buffer))
- (let (proc)
- (while (and (setq proc (get-buffer-process (current-buffer)))
- (progn ;; (debug)
- (delete-process proc)))))
- (erase-buffer)
- (let ((port 6600))
- (when (string-match ":[^.]+\\'" host)
- (setq port (substring host (1+ (match-beginning 0))))
- (setq host (substring host 0 (match-beginning 0)))
- (unless (string-match "[^[:digit:]]" port)
- (setq port (string-to-number port))))
+ (let ((port 6600)
+ pass)
+
+ (when (string-match "\\`\\(?:\\(.*\\)@\\)?\\(.*?\\)\\(?::\\(.*\\)\\)?\\'"
+ host)
+ (let ((v (match-string 1 host)))
+ (when (and (stringp v) (not (string= "" v)))
+ (setq pass v)))
+ (let ((v (match-string 3 host)))
+ (setq host (match-string 2 host))
+ (when (and (stringp v) (not (string= "" v)))
+ (setq port
+ (if (string-match "[^[:digit:]]" v)
+ (string-to-number v)
+ v)))))
+
+ (mpc--debug "Connecting to %s:%s..." host port)
+ (with-current-buffer (get-buffer-create (format " *mpc-%s:%s*" host port))
+ ;; (pop-to-buffer (current-buffer))
+ (let (proc)
+ (while (and (setq proc (get-buffer-process (current-buffer)))
+ (progn ;; (debug)
+ (delete-process proc)))))
+ (erase-buffer)
(let* ((coding-system-for-read 'utf-8-unix)
(coding-system-for-write 'utf-8-unix)
(proc (open-network-stream "MPC" (current-buffer) host port)))
@@ -285,7 +293,9 @@ and HOST defaults to localhost."
(set-process-query-on-exit-flag proc nil)
;; This may be called within a process filter ;-(
(with-local-quit (mpc-proc-sync proc))
- proc))))
+ (setq mpc-proc proc)
+ (when pass
+ (mpc-proc-cmd (list "password" pass) nil))))))
(defun mpc--proc-quote-string (s)
(if (numberp s) (number-to-string s)
@@ -295,7 +305,7 @@ and HOST defaults to localhost."
(defconst mpc--proc-alist-to-alists-starters '(file directory))
(defun mpc--proc-alist-to-alists (alist)
- (assert (or (null alist)
+ (cl-assert (or (null alist)
(memq (caar alist) mpc--proc-alist-to-alists-starters)))
(let ((starter (caar alist))
(alists ())
@@ -309,11 +319,11 @@ and HOST defaults to localhost."
(nreverse alists)))
(defun mpc-proc ()
- (or (and mpc-proc
- (buffer-live-p (process-buffer mpc-proc))
- (not (memq (process-status mpc-proc) '(closed)))
- mpc-proc)
- (setq mpc-proc (mpc--proc-connect mpc-host))))
+ (unless (and mpc-proc
+ (buffer-live-p (process-buffer mpc-proc))
+ (not (memq (process-status mpc-proc) '(closed))))
+ (mpc--proc-connect mpc-host))
+ mpc-proc)
(defun mpc-proc-check (proc)
(let ((error-text (process-get proc 'mpc-proc-error)))
@@ -409,7 +419,7 @@ which will be concatenated with proper quoting before passing them to MPD."
(funcall callback (prog1 (mpc-proc-buf-to-alist
(current-buffer))
(set-buffer buf))))))
- ;; (lexical-let ((res nil))
+ ;; (let ((res nil))
;; (mpc-proc-cmd-to-alist cmd (lambda (alist) (setq res alist)))
;; (mpc-proc-sync)
;; res)
@@ -460,7 +470,7 @@ to call FUN for any change whatsoever.")
(let ((old-status mpc-status))
;; Update the alist.
(setq mpc-status (mpc-proc-buf-to-alist))
- (assert mpc-status)
+ (cl-assert mpc-status)
(unless (equal old-status mpc-status)
;; Run the relevant refresher functions.
(dolist (pair mpc-status-callbacks)
@@ -547,7 +557,7 @@ Any call to `mpc-status-refresh' may cause it to be restarted."
;; (defun mpc--queue-pop ()
;; (when mpc-queue ;Can be nil if out of sync.
;; (let ((song (car mpc-queue)))
-;; (assert song)
+;; (cl-assert song)
;; (push (if (and (consp song) (cddr song))
;; ;; The queue's first element is itself a list of
;; ;; songs, where the first element isn't itself a song
@@ -556,7 +566,7 @@ Any call to `mpc-status-refresh' may cause it to be restarted."
;; (prog1 (if (consp song) (cadr song) song)
;; (setq mpc-queue (cdr mpc-queue))))
;; mpc-queue-back)
-;; (assert (stringp (car mpc-queue-back))))))
+;; (cl-assert (stringp (car mpc-queue-back))))))
;; (defun mpc--queue-refresh ()
;; ;; Maintain the queue.
@@ -614,7 +624,7 @@ The songs are returned as alists."
(i 0))
(mapcar (lambda (s)
(prog1 (cons (cons 'Pos (number-to-string i)) s)
- (incf i)))
+ (cl-incf i)))
l)))
((eq tag 'Search)
(mpc-proc-buf-to-alists
@@ -830,8 +840,8 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(list "move" song-pos dest-pos))
(if (< song-pos dest-pos)
;; This move has shifted dest-pos by 1.
- (decf dest-pos))
- (incf i)))
+ (cl-decf dest-pos))
+ (cl-incf i)))
;; Sort them from last to first, so the renumbering
;; caused by the earlier deletions affect
;; later ones a bit less.
@@ -975,8 +985,8 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(right-align (match-end 1))
(text
(if (eq info 'self) (symbol-name tag)
- (case tag
- ((Time Duration)
+ (pcase tag
+ ((or `Time `Duration)
(let ((time (cdr (or (assq 'time info) (assq 'Time info)))))
(setq pred (list nil)) ;Just assume it's never eq.
(when time
@@ -984,7 +994,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(string-match ":" time))
(substring time (match-end 0))
time)))))
- (Cover
+ (`Cover
(let* ((dir (file-name-directory (cdr (assq 'file info))))
(cover (concat dir "cover.jpg"))
(file (condition-case err
@@ -1007,7 +1017,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(mpc-tempfiles-add image tempfile)))
(setq size nil)
(propertize dir 'display image))))
- (t (let ((val (cdr (assq tag info))))
+ (_ (let ((val (cdr (assq tag info))))
;; For Streaming URLs, there's no other info
;; than the URL in `file'. Pretend it's in `Title'.
(when (and (null val) (eq tag 'Title))
@@ -1225,7 +1235,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(beginning-of-line))
(defun mpc-select-make-overlay ()
- (assert (not (get-char-property (point) 'mpc-select)))
+ (cl-assert (not (get-char-property (point) 'mpc-select)))
(let ((ol (make-overlay
(line-beginning-position) (line-beginning-position 2))))
(overlay-put ol 'mpc-select t)
@@ -1261,7 +1271,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(> (overlay-end ol) (point)))
(delete-overlay ol)
(push ol ols)))
- (assert (= (1+ (length ols)) (length mpc-select)))
+ (cl-assert (= (1+ (length ols)) (length mpc-select)))
(setq mpc-select ols)))
;; We're trying to select *ALL* additionally to others.
((mpc-tagbrowser-all-p) nil)
@@ -1289,12 +1299,12 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(while (and (zerop (forward-line 1))
(get-char-property (point) 'mpc-select))
(setq end (1+ (point)))
- (incf after))
+ (cl-incf after))
(goto-char mid)
(while (and (zerop (forward-line -1))
(get-char-property (point) 'mpc-select))
(setq start (point))
- (incf before))
+ (cl-incf before))
(if (and (= after 0) (= before 0))
;; Shortening an already minimum-size region: do nothing.
nil
@@ -1318,13 +1328,13 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(start (line-beginning-position)))
(while (and (zerop (forward-line 1))
(not (get-char-property (point) 'mpc-select)))
- (incf count))
+ (cl-incf count))
(unless (get-char-property (point) 'mpc-select)
(setq count nil))
(goto-char start)
(while (and (zerop (forward-line -1))
(not (get-char-property (point) 'mpc-select)))
- (incf before))
+ (cl-incf before))
(unless (get-char-property (point) 'mpc-select)
(setq before nil))
(when (and before (or (null count) (< before count)))
@@ -1433,7 +1443,7 @@ when constructing the set of constraints."
(mpc-select-save
(widen)
(goto-char (point-min))
- (assert (looking-at (regexp-quote mpc-tagbrowser-all-name)))
+ (cl-assert (looking-at (regexp-quote mpc-tagbrowser-all-name)))
(forward-line 1)
(let ((inhibit-read-only t))
(delete-region (point) (point-max))
@@ -1690,7 +1700,7 @@ Return non-nil if a selection was deactivated."
(process-put (mpc-proc) prop
(delq nil
(mapcar (lambda (x)
- (if (mpc-string-prefix-p name x)
+ (if (string-prefix-p name x)
nil x))
new)))))
(mpc-tagbrowser-refresh)))
@@ -1919,7 +1929,7 @@ This is used so that they can be compared with `eq', which is needed for
(cdr (assq 'file song1))
(cdr (assq 'file song2)))))
(and (integerp cmp) (< cmp 0)))))))
- (incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0")))
+ (cl-incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0")))
(mpc-format mpc-songs-format song)
(delete-char (- (skip-chars-backward " "))) ;Remove trailing space.
(insert "\n")
@@ -2043,7 +2053,7 @@ This is used so that they can be compared with `eq', which is needed for
(- (point) (car prev)))
next prev)
(or next prev)))))
- (assert sn)
+ (cl-assert sn)
(mpc-proc-cmd (concat "play " sn))))))))))
(define-derived-mode mpc-songs-mode mpc-mode "MPC-song"
@@ -2158,12 +2168,12 @@ This is used so that they can be compared with `eq', which is needed for
(dolist (song (car context))
(and (zerop (forward-line -1))
(eq (get-text-property (point) 'mpc-file) song)
- (incf count)))
+ (cl-incf count)))
(goto-char pos)
(dolist (song (cdr context))
(and (zerop (forward-line 1))
(eq (get-text-property (point) 'mpc-file) song)
- (incf count)))
+ (cl-incf count)))
count))
(defun mpc-songpointer-refresh-hairy ()
@@ -2204,13 +2214,13 @@ This is used so that they can be compared with `eq', which is needed for
((< score context-size) nil)
(t
;; Score is equal and increasing context might help: try it.
- (incf context-size)
+ (cl-incf context-size)
(let ((new-context
(mpc-songpointer-context context-size plbuf)))
(if (null new-context)
;; There isn't more context: choose one arbitrarily
;; and keep looking for a better match elsewhere.
- (decf context-size)
+ (cl-decf context-size)
(setq context new-context)
(setq score (mpc-songpointer-score context pos))
(save-excursion
@@ -2412,7 +2422,7 @@ This is used so that they can be compared with `eq', which is needed for
(let* (songid ;The ID of the currently ffwd/rewinding song.
songduration ;The duration of that song.
songtime ;The time of the song last time we ran.
- oldtime ;The timeoftheday last time we ran.
+ oldtime ;The time of day last time we ran.
prevsongid) ;The song we're in the process leaving.
(let ((fun
(lambda ()
diff --git a/lisp/msb.el b/lisp/msb.el
index 74ceff1a9cd..d9fb2c55d87 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -1,6 +1,6 @@
;;; msb.el --- customizable buffer-selection with multiple menus
-;; Copyright (C) 1993-1995, 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1997-2012 Free Software Foundation, Inc.
;; Author: Lars Lindberg <lars.lindberg@home.se>
;; Maintainer: FSF
@@ -77,13 +77,13 @@
;; hacked on by Dave Love.
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
-;;;
-;;; Some example constants to be used for `msb-menu-cond'. See that
-;;; variable for more information. Please note that if the condition
-;;; returns `multi', then the buffer can appear in several menus.
-;;;
+;;
+;; Some example constants to be used for `msb-menu-cond'. See that
+;; variable for more information. Please note that if the condition
+;; returns `multi', then the buffer can appear in several menus.
+;;
(defconst msb--few-menus
'(((and (boundp 'server-buffer-clients)
server-buffer-clients
@@ -271,7 +271,7 @@ that differs by this value or more."
:group 'msb)
(defvar msb-files-by-directory-sort-key 0
- "*The sort key for files sorted by directory.")
+ "The sort key for files sorted by directory.")
(defcustom msb-max-menu-items 15
"The maximum number of items in a menu.
@@ -316,7 +316,7 @@ No buffers at all if less than 1 or nil (or any non-number)."
:group 'msb)
(defvar msb-horizontal-shift-function (lambda () 0)
- "*Function that specifies how many pixels to shift the top menu leftwards.")
+ "Function that specifies how many pixels to shift the top menu leftwards.")
(defcustom msb-display-invisible-buffers-p nil
"Show invisible buffers or not.
@@ -327,7 +327,7 @@ names that starts with a space character."
:group 'msb)
(defvar msb-item-handling-function 'msb-item-handler
- "*The appearance of a buffer menu.
+ "The appearance of a buffer menu.
The default function to call for handling the appearance of a menu
item. It should take two arguments, BUFFER and MAX-BUFFER-NAME-LENGTH,
@@ -702,18 +702,18 @@ See `msb-menu-cond' for a description of its elements."
(multi-flag nil)
function-info-list)
(setq function-info-list
- (loop for fi
- across function-info-vector
- if (and (setq result
- (eval (aref fi 1))) ;Test CONDITION
- (not (and (eq result 'no-multi)
- multi-flag))
- (progn (when (eq result 'multi)
- (setq multi-flag t))
- t))
- collect fi
- until (and result
- (not (eq result 'multi)))))
+ (cl-loop for fi
+ across function-info-vector
+ if (and (setq result
+ (eval (aref fi 1))) ;Test CONDITION
+ (not (and (eq result 'no-multi)
+ multi-flag))
+ (progn (when (eq result 'multi)
+ (setq multi-flag t))
+ t))
+ collect fi
+ until (and result
+ (not (eq result 'multi)))))
(when (and (not function-info-list)
(not result))
(error "No catch-all in msb-menu-cond!"))
@@ -817,7 +817,7 @@ results in
(defun msb--mode-menu-cond ()
(let ((key msb-modes-key))
(mapcar (lambda (item)
- (incf key)
+ (cl-incf key)
(list `( eq major-mode (quote ,(car item)))
key
(concat (cdr item) " (%d)")))
@@ -841,18 +841,18 @@ It takes the form ((TITLE . BUFFER-LIST)...)."
(> msb-display-most-recently-used 0))
(let* ((buffers (cdr (buffer-list)))
(most-recently-used
- (loop with n = 0
- for buffer in buffers
- if (with-current-buffer buffer
- (and (not (msb-invisible-buffer-p))
- (not (eq major-mode 'dired-mode))))
- collect (with-current-buffer buffer
- (cons (funcall msb-item-handling-function
- buffer
- max-buffer-name-length)
- buffer))
- and do (incf n)
- until (>= n msb-display-most-recently-used))))
+ (cl-loop with n = 0
+ for buffer in buffers
+ if (with-current-buffer buffer
+ (and (not (msb-invisible-buffer-p))
+ (not (eq major-mode 'dired-mode))))
+ collect (with-current-buffer buffer
+ (cons (funcall msb-item-handling-function
+ buffer
+ max-buffer-name-length)
+ buffer))
+ and do (cl-incf n)
+ until (>= n msb-display-most-recently-used))))
(cons (if (stringp msb-most-recently-used-title)
(format msb-most-recently-used-title
(length most-recently-used))
@@ -899,29 +899,29 @@ It takes the form ((TITLE . BUFFER-LIST)...)."
(when file-buffers
(setq file-buffers
(mapcar (lambda (buffer-list)
- (list* msb-files-by-directory-sort-key
- (car buffer-list)
- (sort
- (mapcar (lambda (buffer)
- (cons (with-current-buffer buffer
- (funcall
- msb-item-handling-function
- buffer
- max-buffer-name-length))
- buffer))
- (cdr buffer-list))
- (lambda (item1 item2)
- (string< (car item1) (car item2))))))
+ `(,msb-files-by-directory-sort-key
+ ,(car buffer-list)
+ ,@(sort
+ (mapcar (lambda (buffer)
+ (cons (with-current-buffer buffer
+ (funcall
+ msb-item-handling-function
+ buffer
+ max-buffer-name-length))
+ buffer))
+ (cdr buffer-list))
+ (lambda (item1 item2)
+ (string< (car item1) (car item2))))))
(msb--choose-file-menu file-buffers))))
;; Now make the menu - a list of (TITLE . BUFFER-LIST)
(let* (menu
(most-recently-used
(msb--most-recently-used-menu max-buffer-name-length))
(others (nconc file-buffers
- (loop for elt
- across function-info-vector
- for value = (msb--create-sort-item elt)
- if value collect value))))
+ (cl-loop for elt
+ across function-info-vector
+ for value = (msb--create-sort-item elt)
+ if value collect value))))
(setq menu
(mapcar 'cdr ;Remove the SORT-KEY
;; Sort the menus - not the items.
@@ -1039,7 +1039,7 @@ variable `msb-menu-cond'."
(tmp-list nil))
(while (< count msb-max-menu-items)
(push (pop list) tmp-list)
- (incf count))
+ (cl-incf count))
(setq tmp-list (nreverse tmp-list))
(setq sub-name (concat (car (car tmp-list)) "..."))
(push (nconc (list mcount sub-name
@@ -1076,7 +1076,7 @@ variable `msb-menu-cond'."
(cons (buffer-name (cdr item))
(cons (car item) end)))
(cdr sub-menu))))
- (nconc (list (incf mcount) (car sub-menu)
+ (nconc (list (cl-incf mcount) (car sub-menu)
'keymap (car sub-menu))
(msb--split-menus buffers))))))
raw-menu)))
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 05aeb12acf4..1c2028ed02e 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -1,6 +1,6 @@
;;; mwheel.el --- Wheel mouse support
-;; Copyright (C) 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2012 Free Software Foundation, Inc.
;; Maintainer: William M. Perry <wmperry@gnu.org>
;; Keywords: mouse
;; Package: emacs
@@ -232,12 +232,17 @@ This should only be bound to mouse buttons 4 and 5."
(end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
(t (error "Bad binding in mwheel-scroll"))))
(if curwin (select-window curwin)))
- ;; If there is a temporarily active region, deactivate it iff
+ ;; If there is a temporarily active region, deactivate it if
;; scrolling moves point.
(when opoint
(with-current-buffer buffer
(when (/= opoint (point))
- (deactivate-mark)))))
+ ;; Call `deactivate-mark' at the original position, so that
+ ;; the original region is saved to the X selection.
+ (let ((newpoint (point)))
+ (goto-char opoint)
+ (deactivate-mark)
+ (goto-char newpoint))))))
(when (and mouse-wheel-click-event mouse-wheel-inhibit-click-time)
(if mwheel-inhibit-click-event-timer
(cancel-timer mwheel-inhibit-click-event-timer)
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index b7fdd9a9bd8..265a855b842 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -1,6 +1,6 @@
;;; ange-ftp.el --- transparent FTP support for GNU Emacs
-;; Copyright (C) 1989-1996, 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989-1996, 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Andy Norman (ange@hplb.hpl.hp.com)
;; Maintainer: FSF
@@ -79,7 +79,7 @@
;; that this change will take effect for the current GNU Emacs session only.
;; See below for a discussion of non-UNIX hosts. If a large number of
;; machines with similar hostnames have this problem then it is easier to set
-;; the value of ange-ftp-dumb-unix-host-regexp in your .emacs file. ange-ftp
+;; the value of ange-ftp-dumb-unix-host-regexp in your init file. ange-ftp
;; is unable to automatically recognize dumb unix hosts.
;; File name completion:
@@ -275,10 +275,10 @@
;; VMS support:
;;
-;; Ange-ftp has full support for VMS hosts. It
-;; should be able to automatically recognize any VMS machine. However, if it
-;; fails to do this, you can use the command ange-ftp-add-vms-host. As well,
-;; you can set the variable ange-ftp-vms-host-regexp in your .emacs file. We
+;; Ange-ftp has full support for VMS hosts. It should be able to
+;; automatically recognize any VMS machine. However, if it fails to do
+;; this, you can use the command ange-ftp-add-vms-host. Also, you can
+;; set the variable ange-ftp-vms-host-regexp in your init file. We
;; would be grateful if you would report any failures to automatically
;; recognize a VMS host as a bug.
;;
@@ -332,7 +332,7 @@
;; the Michigan terminal system. It should be able to automatically
;; recognize any MTS machine. However, if it fails to do this, you can use
;; the command ange-ftp-add-mts-host. As well, you can set the variable
-;; ange-ftp-mts-host-regexp in your .emacs file. We would be grateful if you
+;; ange-ftp-mts-host-regexp in your init file. We would be grateful if you
;; would report any failures to automatically recognize a MTS host as a bug.
;;
;; Filename syntax:
@@ -358,7 +358,7 @@
;; CMS. It should be able to automatically recognize any CMS machine.
;; However, if it fails to do this, you can use the command
;; ange-ftp-add-cms-host. As well, you can set the variable
-;; ange-ftp-cms-host-regexp in your .emacs file. We would be grateful if you
+;; ange-ftp-cms-host-regexp in your init file. We would be grateful if you
;; would report any failures to automatically recognize a CMS host as a bug.
;;
;; Filename syntax:
@@ -671,8 +671,7 @@
;;;; ------------------------------------------------------------
(defgroup ange-ftp nil
- "Accessing remote files and directories using FTP
- made as simple and transparent as possible."
+ "Accessing remote files and directories using FTP."
:group 'files
:group 'comm
:prefix "ange-ftp-")
@@ -697,11 +696,11 @@ parenthesized expressions in REGEXP for the components (in that order)."
(defvar ange-ftp-multi-msgs
"^150-\\|^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^331-\\|^4[25]1-\\|^530-"
- "*Regular expression matching the start of a multiline FTP reply.")
+ "Regular expression matching the start of a multiline FTP reply.")
(defvar ange-ftp-good-msgs
"^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark"
- "*Regular expression matching FTP \"success\" messages.")
+ "Regular expression matching FTP \"success\" messages.")
;; CMS and the odd VMS machine say 200 Port rather than 200 PORT.
;; Also CMS machines use a multiline 550- reply to say that you
@@ -908,7 +907,7 @@ matches the login banner."
(if (eq system-type 'hpux)
"stty -onlcr -echo\n"
"stty -echo nl\n")
- "*Set up terminal after logging in to the gateway machine.
+ "Set up terminal after logging in to the gateway machine.
This command should stop the terminal from echoing each command, and
arrange to strip out trailing ^M characters.")
@@ -1201,6 +1200,11 @@ only return the directory part of FILE."
(defun ange-ftp-get-passwd (host user)
"Return the password for specified HOST and USER, asking user if necessary."
+ ;; If `non-essential' is non-nil, don't ask for a password. It will
+ ;; be caught in Tramp.
+ (when non-essential
+ (throw 'non-essential 'non-essential))
+
(ange-ftp-parse-netrc)
;; look up password in the hash table first; user might have overridden the
@@ -1231,7 +1235,8 @@ only return the directory part of FILE."
;; see if same user has logged in to other hosts; if so then prompt
;; with the password that was used there.
(t
- (let* ((other (ange-ftp-get-host-with-passwd user))
+ (let* ((enable-recursive-minibuffers t)
+ (other (ange-ftp-get-host-with-passwd user))
(passwd (if other
;; found another machine with the same user.
@@ -1390,6 +1395,9 @@ only return the directory part of FILE."
(run-hooks 'find-file-hook)
(setq buffer-file-name nil)
(goto-char (point-min))
+ (while (search-forward-regexp "^[ \t]*#.*$" nil t)
+ (replace-match ""))
+ (goto-char (point-min))
(skip-chars-forward " \t\r\n")
(while (not (eobp))
(ange-ftp-parse-netrc-group))
@@ -1772,6 +1780,10 @@ good, skip, fatal, or unknown."
(defun ange-ftp-gwp-start (host user name args)
"Login to the gateway machine and fire up an FTP process."
+ ;; If `non-essential' is non-nil, don't reopen a new connection. It
+ ;; will be caught in Tramp.
+ (when non-essential
+ (throw 'non-essential 'non-essential))
(let (;; It would be nice to make process-connection-type nil,
;; but that doesn't work: ftp never responds.
;; Can anyone find a fix for that?
@@ -1903,6 +1915,10 @@ been queued with no result. CONT will still be called, however."
"Spawn a new FTP process ready to connect to machine HOST and give it NAME.
If HOST is only FTP-able through a gateway machine then spawn a shell
on the gateway machine to do the FTP instead."
+ ;; If `non-essential' is non-nil, don't reopen a new connection. It
+ ;; will be caught in Tramp.
+ (when non-essential
+ (throw 'non-essential 'non-essential))
(let* ((use-gateway (ange-ftp-use-gateway-p host))
(use-smart-ftp (and (not ange-ftp-gateway-host)
(ange-ftp-use-smart-gateway-p host)))
@@ -2095,7 +2111,7 @@ suffix of the form #PORT to specify a non-default port."
;; ange@hplb.hpl.hp.com says this should not be changed.
(defvar ange-ftp-hash-mark-msgs
"[hH]ash mark [^0-9]*\\([0-9]+\\)"
- "*Regexp matching the FTP client's output upon doing a HASH command.")
+ "Regexp matching the FTP client's output upon doing a HASH command.")
(defun ange-ftp-guess-hash-mark-size (proc)
(if ange-ftp-send-hash
@@ -2121,6 +2137,11 @@ Create a new process if needed."
(proc (get-process name)))
(if (and proc (memq (process-status proc) '(run open)))
proc
+ ;; If `non-essential' is non-nil, don't reopen a new connection. It
+ ;; will be caught in Tramp.
+ (when non-essential
+ (throw 'non-essential 'non-essential))
+
;; Must delete dead process so that new process can reuse the name.
(if proc (delete-process proc))
(let ((pass (ange-ftp-quote-string
@@ -2597,7 +2618,7 @@ away in the internal cache."
(format
"list data file %s not readable"
temp))))
- ;; remove ^M inserted by the win32 ftp client
+ ;; remove ^M inserted by the w32 ftp client
(while (re-search-forward "\r$" nil t)
(replace-match ""))
(goto-char 1)
@@ -3098,7 +3119,8 @@ logged in as user USER and cd'd to directory DIR."
(if (not (eq system-type 'windows-nt))
(setq name (ange-ftp-real-expand-file-name name))
;; Windows UNC default dirs do not make sense for ftp.
- (setq name (if (string-match "\\`//" default-directory)
+ (setq name (if (and default-directory
+ (string-match "\\`//" default-directory))
(ange-ftp-real-expand-file-name name "c:/")
(ange-ftp-real-expand-file-name name)))
;; Strip off possible drive specifier.
@@ -3121,21 +3143,15 @@ logged in as user USER and cd'd to directory DIR."
"Documented as `expand-file-name'."
(save-match-data
(setq default (or default default-directory))
- (cond ((eq (string-to-char name) ?~)
- (ange-ftp-real-expand-file-name name))
- ((eq (string-to-char name) ?/)
- (ange-ftp-canonize-filename name))
- ((and (eq system-type 'windows-nt)
- (eq (string-to-char name) ?\\))
- (ange-ftp-canonize-filename name))
- ((and (eq system-type 'windows-nt)
- (or (string-match "\\`[a-zA-Z]:" name)
- (string-match "\\`[a-zA-Z]:" default)))
- (ange-ftp-real-expand-file-name name default))
- ((zerop (length name))
- (ange-ftp-canonize-filename default))
- ((ange-ftp-canonize-filename
- (concat (file-name-as-directory default) name))))))
+ (cond
+ ((ange-ftp-ftp-name name)
+ ;; `default' is irrelevant.
+ (ange-ftp-canonize-filename name))
+ ((file-name-absolute-p name)
+ ;; `name' is absolute but is not an ange-ftp name => not ange-ftp.
+ (ange-ftp-real-expand-file-name name "/"))
+ ((ange-ftp-canonize-filename
+ (concat (file-name-as-directory default) name))))))
;;; These are problems--they are currently not enabled.
@@ -3368,7 +3384,7 @@ system TYPE.")
(if (ange-ftp-file-entry-p name)
(let ((file-ent (ange-ftp-get-file-entry name)))
(if (stringp file-ent)
- (file-exists-p
+ (ange-ftp-file-exists-p
(ange-ftp-expand-symlink file-ent
(file-name-directory
(directory-file-name name))))
@@ -3777,7 +3793,8 @@ so return the size on the remote host exactly. See RFC 3659."
(format "Copying %s to %s" f-abbr t-abbr)))
(list 'ange-ftp-cf2
newname t-host t-user binary temp1 temp2 cont)
- nowait))
+ nowait)
+ (ange-ftp-add-file-entry newname))
;; newname wasn't remote.
(ange-ftp-cf2 t nil newname t-host t-user binary temp1 temp2 cont))
@@ -3952,10 +3969,15 @@ E.g.,
(string-match "\\`[a-zA-Z]:[/\\]\\'" dir))
(string-equal "/" dir)))
+(defmacro ange-ftp-ignore-errors-if-non-essential (&rest body)
+ `(if non-essential
+ (ignore-errors ,@body)
+ (progn ,@body)))
+
(defun ange-ftp-file-name-all-completions (file dir)
(let ((ange-ftp-this-dir (expand-file-name dir)))
(if (ange-ftp-ftp-name ange-ftp-this-dir)
- (progn
+ (ange-ftp-ignore-errors-if-non-essential
(ange-ftp-barf-if-not-directory ange-ftp-this-dir)
(setq ange-ftp-this-dir
(ange-ftp-real-file-name-as-directory ange-ftp-this-dir))
@@ -6075,7 +6097,7 @@ Other orders of $ and _ seem to all work just fine.")
(defcustom ange-ftp-bs2000-additional-pubsets
nil
- "*List of additional pubsets available to all users."
+ "List of additional pubsets available to all users."
:group 'ange-ftp
:type '(repeat string))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 3ab1a345470..c1c83d2245e 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -1,6 +1,6 @@
;;; browse-url.el --- pass a URL to a WWW browser
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Denis Howe <dbh@doc.ic.ac.uk>
;; Maintainer: FSF
@@ -122,8 +122,7 @@
;; the buffer, use:
;; M-x browse-url
-;; To display a URL by shift-clicking on it, put this in your ~/.emacs
-;; file:
+;; To display a URL by shift-clicking on it, put this in your init file:
;; (global-set-key [S-mouse-2] 'browse-url-at-mouse)
;; (Note that using Shift-mouse-1 is not desirable because
;; that event has a standard meaning in Emacs.)
@@ -205,8 +204,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variables
-(eval-when-compile (require 'cl))
-
(defgroup browse-url nil
"Use a web browser to look at a URL."
:prefix "browse-url-"
@@ -297,7 +294,7 @@ Defaults to the value of `browse-url-netscape-arguments' at the time
:group 'browse-url)
(defcustom browse-url-browser-display nil
- "The X display for running the browser, if not same as Emacs'."
+ "The X display for running the browser, if not same as Emacs's."
:type '(choice string (const :tag "Default" nil))
:group 'browse-url)
@@ -467,7 +464,7 @@ commands reverses the effect of this variable. Requires Netscape version
;; it in anonymous cases. If it's not anonymous the next regexp
;; applies.
("^/\\([^:@]+@\\)?\\([^:]+\\):/*" . "ftp://\\1\\2/")
- ,@(if (memq system-type '(windows-nt ms-dos cygwin))
+ ,@(if (memq system-type '(windows-nt ms-dos))
'(("^\\([a-zA-Z]:\\)[\\/]" . "file:///\\1/")
("^[\\/][\\/]+" . "file://")))
("^/+" . "file:///"))
@@ -642,7 +639,7 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
(s 0))
(while (setq s (string-match chars encoded-text s))
(setq encoded-text
- (replace-match (format "%%%x"
+ (replace-match (format "%%%X"
(string-to-char (match-string 0 encoded-text)))
t t encoded-text)
s (1+ s)))
@@ -655,7 +652,7 @@ regarding its parameter treatment."
;; FIXME: Is there an actual example of a web browser getting
;; confused? (This used to encode commas, but at least Firefox
;; handles commas correctly and doesn't accept encoded commas.)
- (browse-url-url-encode-chars url "[)$]"))
+ (browse-url-url-encode-chars url "[\")$] "))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL input
@@ -724,12 +721,6 @@ interactively. Turn the filename into a URL with function
(defun browse-url-file-url (file)
"Return the URL corresponding to FILE.
Use variable `browse-url-filename-alist' to map filenames to URLs."
- ;; De-munge Cygwin filenames before passing them to Windows browser.
- (if (eq system-type 'cygwin)
- (let ((winfile (with-output-to-string
- (call-process "cygpath" nil standard-output
- nil "-m" file))))
- (setq file (substring winfile 0 -1))))
(let ((coding (and (default-value 'enable-multibyte-characters)
(or file-name-coding-system
default-file-name-coding-system))))
@@ -751,7 +742,7 @@ narrowed."
(and buffer (set-buffer buffer))
(let ((file-name
;; Ignore real name if restricted
- (and (= (- (point-max) (point-min)) (buffer-size))
+ (and (not (buffer-narrowed-p))
(or buffer-file-name
(and (boundp 'dired-directory) dired-directory)))))
(or file-name
@@ -944,7 +935,9 @@ used instead of `browse-url-new-window-flag'."
url args))
(defun browse-url-can-use-xdg-open ()
- "Check if xdg-open can be used, i.e. we are on Gnome, KDE, Xfce4 or LXDE."
+ "Return non-nil if the \"xdg-open\" program can be used.
+xdg-open is a desktop utility that calls your preferred web browser.
+This requires you to be running either Gnome, KDE, Xfce4 or LXDE."
(and (getenv "DISPLAY")
(executable-find "xdg-open")
;; xdg-open may call gnome-open and that does not wait for its child
@@ -967,6 +960,7 @@ used instead of `browse-url-new-window-flag'."
(eq 0 (call-process
"/bin/sh" nil nil nil
"-c"
+ ;; FIXME use string-match rather than grep.
"xprop -root _DT_SAVE_MODE|grep xfce4"))
(error nil))
(member (getenv "DESKTOP_SESSION") '("LXDE" "Lubuntu"))
@@ -974,7 +968,10 @@ used instead of `browse-url-new-window-flag'."
;;;###autoload
-(defun browse-url-xdg-open (url &optional new-window)
+(defun browse-url-xdg-open (url &optional ignored)
+ "Pass the specified URL to the \"xdg-open\" command.
+xdg-open is a desktop utility that calls your preferred web browser.
+The optional argument IGNORED is not used."
(interactive (browse-url-interactive-arg "URL: "))
(call-process "xdg-open" nil 0 nil url))
@@ -1621,22 +1618,21 @@ from `browse-url-elinks-wrapper'."
(defun browse-url-elinks-sentinel (process url)
"Determines if Elinks is running or a new one has to be started."
- (let ((exit-status (process-exit-status process)))
- ;; Try to determine if an instance is running or if we have to
- ;; create a new one.
- (case exit-status
- (5
- ;; No instance, start a new one.
- (browse-url-elinks-new-window url))
- (0
- ;; Found an instance, open URL in new tab.
- (let ((process-environment (browse-url-process-environment)))
- (start-process (concat "elinks:" url) nil
- "elinks" "-remote"
- (concat "openURL(\"" url "\",new-tab)"))))
- (otherwise
- (error "Unrecognized exit-code %d of process `elinks'"
- exit-status)))))
+ ;; Try to determine if an instance is running or if we have to
+ ;; create a new one.
+ (pcase (process-exit-status process)
+ (5
+ ;; No instance, start a new one.
+ (browse-url-elinks-new-window url))
+ (0
+ ;; Found an instance, open URL in new tab.
+ (let ((process-environment (browse-url-process-environment)))
+ (start-process (concat "elinks:" url) nil
+ "elinks" "-remote"
+ (concat "openURL(\"" url "\",new-tab)"))))
+ (exit-status
+ (error "Unrecognized exit-code %d of process `elinks'"
+ exit-status))))
(provide 'browse-url)
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 9254fef8a7f..c95e901c39d 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -1,6 +1,6 @@
;;; dbus.el --- Elisp bindings for D-Bus.
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, hardware
@@ -28,24 +28,24 @@
;; Low-level language bindings are implemented in src/dbusbind.c.
+;; D-Bus support in the Emacs core can be disabled with configuration
+;; option "--without-dbus".
+
;;; Code:
-;; D-Bus support in the Emacs core can be disabled with configuration
-;; option "--without-dbus". Declare used subroutines and variables.
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-call-method-asynchronously "dbusbind.c")
+;; Declare used subroutines and variables.
+(declare-function dbus-message-internal "dbusbind.c")
(declare-function dbus-init-bus "dbusbind.c")
-(declare-function dbus-method-return-internal "dbusbind.c")
-(declare-function dbus-method-error-internal "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
-(declare-function dbus-register-method "dbusbind.c")
-(declare-function dbus-send-signal "dbusbind.c")
+(defvar dbus-message-type-invalid)
+(defvar dbus-message-type-method-call)
+(defvar dbus-message-type-method-return)
+(defvar dbus-message-type-error)
+(defvar dbus-message-type-signal)
(defvar dbus-debug)
(defvar dbus-registered-objects-table)
;; Pacify byte compiler.
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'xml)
@@ -55,39 +55,93 @@
(defconst dbus-path-dbus "/org/freedesktop/DBus"
"The object path used to talk to the bus itself.")
+;; Default D-Bus interfaces.
+
(defconst dbus-interface-dbus "org.freedesktop.DBus"
- "The interface exported by the object with `dbus-service-dbus' and `dbus-path-dbus'.")
+ "The interface exported by the service `dbus-service-dbus'.")
(defconst dbus-interface-peer (concat dbus-interface-dbus ".Peer")
- "The interface for peer objects.")
+ "The interface for peer objects.
+See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-peer'.")
+
+;; <interface name="org.freedesktop.DBus.Peer">
+;; <method name="Ping">
+;; </method>
+;; <method name="GetMachineId">
+;; <arg name="machine_uuid" type="s" direction="out"/>
+;; </method>
+;; </interface>
(defconst dbus-interface-introspectable
(concat dbus-interface-dbus ".Introspectable")
- "The interface supported by introspectable objects.")
+ "The interface supported by introspectable objects.
+See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-introspectable'.")
-(defconst dbus-interface-properties (concat dbus-interface-dbus ".Properties")
- "The interface for property objects.")
+;; <interface name="org.freedesktop.DBus.Introspectable">
+;; <method name="Introspect">
+;; <arg name="data" type="s" direction="out"/>
+;; </method>
+;; </interface>
+(defconst dbus-interface-properties (concat dbus-interface-dbus ".Properties")
+ "The interface for property objects.
+See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-properties'.")
+
+;; <interface name="org.freedesktop.DBus.Properties">
+;; <method name="Get">
+;; <arg name="interface" type="s" direction="in"/>
+;; <arg name="propname" type="s" direction="in"/>
+;; <arg name="value" type="v" direction="out"/>
+;; </method>
+;; <method name="Set">
+;; <arg name="interface" type="s" direction="in"/>
+;; <arg name="propname" type="s" direction="in"/>
+;; <arg name="value" type="v" direction="in"/>
+;; </method>
+;; <method name="GetAll">
+;; <arg name="interface" type="s" direction="in"/>
+;; <arg name="props" type="a{sv}" direction="out"/>
+;; </method>
+;; <signal name="PropertiesChanged">
+;; <arg name="interface" type="s"/>
+;; <arg name="changed_properties" type="a{sv}"/>
+;; <arg name="invalidated_properties" type="as"/>
+;; </signal>
+;; </interface>
+
+(defconst dbus-interface-objectmanager
+ (concat dbus-interface-dbus ".ObjectManager")
+ "The object manager interface.
+See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-objectmanager'.")
+
+;; <interface name="org.freedesktop.DBus.ObjectManager">
+;; <method name="GetManagedObjects">
+;; <arg name="object_paths_interfaces_and_properties"
+;; type="a{oa{sa{sv}}}" direction="out"/>
+;; </method>
+;; <signal name="InterfacesAdded">
+;; <arg name="object_path" type="o"/>
+;; <arg name="interfaces_and_properties" type="a{sa{sv}}"/>
+;; </signal>
+;; <signal name="InterfacesRemoved">
+;; <arg name="object_path" type="o"/>
+;; <arg name="interfaces" type="as"/>
+;; </signal>
+;; </interface>
+
+;; Emacs defaults.
(defconst dbus-service-emacs "org.gnu.Emacs"
"The well known service name of Emacs.")
(defconst dbus-path-emacs "/org/gnu/Emacs"
- "The object path head used by Emacs.")
+ "The object path namespace used by Emacs.
+All object paths provided by the service `dbus-service-emacs'
+shall be subdirectories of this path.")
-(defconst dbus-message-type-invalid 0
- "This value is never a valid message type.")
+(defconst dbus-interface-emacs "org.gnu.Emacs"
+ "The interface namespace used by Emacs.")
-(defconst dbus-message-type-method-call 1
- "Message type of a method call message.")
-
-(defconst dbus-message-type-method-return 2
- "Message type of a method return message.")
-
-(defconst dbus-message-type-error 3
- "Message type of an error reply message.")
-
-(defconst dbus-message-type-signal 4
- "Message type of a signal message.")
+;; D-Bus constants.
(defmacro dbus-ignore-errors (&rest body)
"Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
@@ -98,21 +152,279 @@ Otherwise, return result of last form in BODY, or all other errors."
(dbus-error (when dbus-debug (signal (car err) (cdr err))))))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<dbus-ignore-errors\\>"))
-(defvar dbus-event-error-hooks nil
+(define-obsolete-variable-alias 'dbus-event-error-hooks
+ 'dbus-event-error-functions "24.3")
+(defvar dbus-event-error-functions nil
"Functions to be called when a D-Bus error happens in the event handler.
Every function must accept two arguments, the event and the error variable
caught in `condition-case' by `dbus-error'.")
-;;; Hash table of registered functions.
+;;; Basic D-Bus message functions.
(defvar dbus-return-values-table (make-hash-table :test 'equal)
"Hash table for temporary storing arguments of reply messages.
-A key in this hash table is a list (BUS SERIAL). BUS is either a
-Lisp symbol, `:system' or `:session', or a string denoting the
-bus address. SERIAL is the serial number of the reply message.
-See `dbus-call-method-non-blocking-handler' and
-`dbus-call-method-non-blocking'.")
+A key in this hash table is a list (:serial BUS SERIAL), like in
+`dbus-registered-objects-table'. BUS is either a Lisp symbol,
+`:system' or `:session', or a string denoting the bus address.
+SERIAL is the serial number of the reply message.")
+
+(defun dbus-call-method-handler (&rest args)
+ "Handler for reply messages of asynchronous D-Bus message calls.
+It calls the function stored in `dbus-registered-objects-table'.
+The result will be made available in `dbus-return-values-table'."
+ (puthash (list :serial
+ (dbus-event-bus-name last-input-event)
+ (dbus-event-serial-number last-input-event))
+ (if (= (length args) 1) (car args) args)
+ dbus-return-values-table))
+
+(defun dbus-call-method (bus service path interface method &rest args)
+ "Call METHOD on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name to be used. PATH is the D-Bus
+object path SERVICE is registered at. INTERFACE is an interface
+offered by SERVICE. It must provide METHOD.
+
+If the parameter `:timeout' is given, the following integer TIMEOUT
+specifies the maximum number of milliseconds the method call must
+return. The default value is 25,000. If the method call doesn't
+return in time, a D-Bus error is raised.
+
+All other arguments ARGS are passed to METHOD as arguments. They are
+converted into D-Bus types via the following rules:
+
+ t and nil => DBUS_TYPE_BOOLEAN
+ number => DBUS_TYPE_UINT32
+ integer => DBUS_TYPE_INT32
+ float => DBUS_TYPE_DOUBLE
+ string => DBUS_TYPE_STRING
+ list => DBUS_TYPE_ARRAY
+
+All arguments can be preceded by a type symbol. For details about
+type symbols, see Info node `(dbus)Type Conversion'.
+
+`dbus-call-method' returns the resulting values of METHOD as a list of
+Lisp objects. The type conversion happens the other direction as for
+input arguments. It follows the mapping rules:
+
+ DBUS_TYPE_BOOLEAN => t or nil
+ DBUS_TYPE_BYTE => number
+ DBUS_TYPE_UINT16 => number
+ DBUS_TYPE_INT16 => integer
+ DBUS_TYPE_UINT32 => number or float
+ DBUS_TYPE_UNIX_FD => number or float
+ DBUS_TYPE_INT32 => integer or float
+ DBUS_TYPE_UINT64 => number or float
+ DBUS_TYPE_INT64 => integer or float
+ DBUS_TYPE_DOUBLE => float
+ DBUS_TYPE_STRING => string
+ DBUS_TYPE_OBJECT_PATH => string
+ DBUS_TYPE_SIGNATURE => string
+ DBUS_TYPE_ARRAY => list
+ DBUS_TYPE_VARIANT => list
+ DBUS_TYPE_STRUCT => list
+ DBUS_TYPE_DICT_ENTRY => list
+
+Example:
+
+\(dbus-call-method
+ :session \"org.gnome.seahorse\" \"/org/gnome/seahorse/keys/openpgp\"
+ \"org.gnome.seahorse.Keys\" \"GetKeyField\"
+ \"openpgp:657984B8C7A966DD\" \"simple-name\")
+
+ => (t (\"Philip R. Zimmermann\"))
+
+If the result of the METHOD call is just one value, the converted Lisp
+object is returned instead of a list containing this single Lisp object.
+
+\(dbus-call-method
+ :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
+ \"org.freedesktop.Hal.Device\" \"GetPropertyString\"
+ \"system.kernel.machine\")
+
+ => \"i686\""
+
+ (or (memq bus '(:system :session)) (stringp bus)
+ (signal 'wrong-type-argument (list 'keywordp bus)))
+ (or (stringp service)
+ (signal 'wrong-type-argument (list 'stringp service)))
+ (or (stringp path)
+ (signal 'wrong-type-argument (list 'stringp path)))
+ (or (stringp interface)
+ (signal 'wrong-type-argument (list 'stringp interface)))
+ (or (stringp method)
+ (signal 'wrong-type-argument (list 'stringp method)))
+
+ (let ((timeout (plist-get args :timeout))
+ (key
+ (apply
+ 'dbus-message-internal dbus-message-type-method-call
+ bus service path interface method 'dbus-call-method-handler args)))
+
+ ;; Wait until `dbus-call-method-handler' has put the result into
+ ;; `dbus-return-values-table'. If no timeout is given, use the
+ ;; default 25". Events which are not from D-Bus must be restored.
+ (with-timeout ((if timeout (/ timeout 1000.0) 25))
+ (while (eq (gethash key dbus-return-values-table :ignore) :ignore)
+ (let ((event (let (unread-command-events) (read-event nil nil 0.1))))
+ (when (and event (not (ignore-errors (dbus-check-event event))))
+ (setq unread-command-events
+ (append unread-command-events (list event)))))))
+
+ ;; Cleanup `dbus-return-values-table'. Return the result.
+ (prog1
+ (gethash key dbus-return-values-table)
+ (remhash key dbus-return-values-table))))
+
+;; `dbus-call-method' works non-blocking now.
+(defalias 'dbus-call-method-non-blocking 'dbus-call-method)
+(make-obsolete 'dbus-call-method-non-blocking 'dbus-call-method "24.3")
+
+(defun dbus-call-method-asynchronously
+ (bus service path interface method handler &rest args)
+ "Call METHOD on the D-Bus BUS asynchronously.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name to be used. PATH is the D-Bus
+object path SERVICE is registered at. INTERFACE is an interface
+offered by SERVICE. It must provide METHOD.
+
+HANDLER is a Lisp function, which is called when the corresponding
+return message has arrived. If HANDLER is nil, no return message
+will be expected.
+
+If the parameter `:timeout' is given, the following integer TIMEOUT
+specifies the maximum number of milliseconds the method call must
+return. The default value is 25,000. If the method call doesn't
+return in time, a D-Bus error is raised.
+
+All other arguments ARGS are passed to METHOD as arguments. They are
+converted into D-Bus types via the following rules:
+
+ t and nil => DBUS_TYPE_BOOLEAN
+ number => DBUS_TYPE_UINT32
+ integer => DBUS_TYPE_INT32
+ float => DBUS_TYPE_DOUBLE
+ string => DBUS_TYPE_STRING
+ list => DBUS_TYPE_ARRAY
+
+All arguments can be preceded by a type symbol. For details about
+type symbols, see Info node `(dbus)Type Conversion'.
+
+If HANDLER is a Lisp function, the function returns a key into the
+hash table `dbus-registered-objects-table'. The corresponding entry
+in the hash table is removed, when the return message has been arrived,
+and HANDLER is called.
+
+Example:
+
+\(dbus-call-method-asynchronously
+ :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
+ \"org.freedesktop.Hal.Device\" \"GetPropertyString\" 'message
+ \"system.kernel.machine\")
+
+ => \(:serial :system 2)
+
+ -| i686"
+
+ (or (memq bus '(:system :session)) (stringp bus)
+ (signal 'wrong-type-argument (list 'keywordp bus)))
+ (or (stringp service)
+ (signal 'wrong-type-argument (list 'stringp service)))
+ (or (stringp path)
+ (signal 'wrong-type-argument (list 'stringp path)))
+ (or (stringp interface)
+ (signal 'wrong-type-argument (list 'stringp interface)))
+ (or (stringp method)
+ (signal 'wrong-type-argument (list 'stringp method)))
+ (or (null handler) (functionp handler)
+ (signal 'wrong-type-argument (list 'functionp handler)))
+
+ (apply 'dbus-message-internal dbus-message-type-method-call
+ bus service path interface method handler args))
+
+(defun dbus-send-signal (bus service path interface signal &rest args)
+ "Send signal SIGNAL on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address. The signal is sent from the D-Bus object
+Emacs is registered at BUS.
+
+SERVICE is the D-Bus name SIGNAL is sent to. It can be either a known
+name or a unique name. If SERVICE is nil, the signal is sent as
+broadcast message. PATH is the D-Bus object path SIGNAL is sent from.
+INTERFACE is an interface available at PATH. It must provide signal
+SIGNAL.
+
+All other arguments ARGS are passed to SIGNAL as arguments. They are
+converted into D-Bus types via the following rules:
+
+ t and nil => DBUS_TYPE_BOOLEAN
+ number => DBUS_TYPE_UINT32
+ integer => DBUS_TYPE_INT32
+ float => DBUS_TYPE_DOUBLE
+ string => DBUS_TYPE_STRING
+ list => DBUS_TYPE_ARRAY
+
+All arguments can be preceded by a type symbol. For details about
+type symbols, see Info node `(dbus)Type Conversion'.
+
+Example:
+
+\(dbus-send-signal
+ :session nil \"/org/gnu/Emacs\" \"org.gnu.Emacs.FileManager\"
+ \"FileModified\" \"/home/albinus/.emacs\")"
+
+ (or (memq bus '(:system :session)) (stringp bus)
+ (signal 'wrong-type-argument (list 'keywordp bus)))
+ (or (null service) (stringp service)
+ (signal 'wrong-type-argument (list 'stringp service)))
+ (or (stringp path)
+ (signal 'wrong-type-argument (list 'stringp path)))
+ (or (stringp interface)
+ (signal 'wrong-type-argument (list 'stringp interface)))
+ (or (stringp signal)
+ (signal 'wrong-type-argument (list 'stringp signal)))
+
+ (apply 'dbus-message-internal dbus-message-type-signal
+ bus service path interface signal args))
+
+(defun dbus-method-return-internal (bus service serial &rest args)
+ "Return for message SERIAL on the D-Bus BUS.
+This is an internal function, it shall not be used outside dbus.el."
+
+ (or (memq bus '(:system :session)) (stringp bus)
+ (signal 'wrong-type-argument (list 'keywordp bus)))
+ (or (stringp service)
+ (signal 'wrong-type-argument (list 'stringp service)))
+ (or (natnump serial)
+ (signal 'wrong-type-argument (list 'natnump serial)))
+
+ (apply 'dbus-message-internal dbus-message-type-method-return
+ bus service serial args))
+
+(defun dbus-method-error-internal (bus service serial &rest args)
+ "Return error message for message SERIAL on the D-Bus BUS.
+This is an internal function, it shall not be used outside dbus.el."
+
+ (or (memq bus '(:system :session)) (stringp bus)
+ (signal 'wrong-type-argument (list 'keywordp bus)))
+ (or (stringp service)
+ (signal 'wrong-type-argument (list 'stringp service)))
+ (or (natnump serial)
+ (signal 'wrong-type-argument (list 'natnump serial)))
+
+ (apply 'dbus-message-internal dbus-message-type-error
+ bus service serial args))
+
+
+;;; Hash table of registered functions.
(defun dbus-list-hash-table ()
"Returns all registered member registrations to D-Bus.
@@ -125,6 +437,313 @@ hash table."
dbus-registered-objects-table)
result))
+(defun dbus-setenv (bus variable value)
+ "Set the value of the BUS environment variable named VARIABLE to VALUE.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address. Both VARIABLE and VALUE should be strings.
+
+Normally, services inherit the environment of the BUS daemon. This
+function adds to or modifies that environment when activating services.
+
+Some bus instances, such as `:system', may disable setting the environment."
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus
+ dbus-interface-dbus "UpdateActivationEnvironment"
+ `(:array (:dict-entry ,variable ,value))))
+
+(defun dbus-register-service (bus service &rest flags)
+ "Register known name SERVICE on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name that should be registered. It must
+be a known name.
+
+FLAGS are keywords, which control how the service name is registered.
+The following keywords are recognized:
+
+`:allow-replacement': Allow another service to become the primary
+owner if requested.
+
+`:replace-existing': Request to replace the current primary owner.
+
+`:do-not-queue': If we can not become the primary owner do not place
+us in the queue.
+
+The function returns a keyword, indicating the result of the
+operation. One of the following keywords is returned:
+
+`:primary-owner': Service has become the primary owner of the
+requested name.
+
+`:in-queue': Service could not become the primary owner and has been
+placed in the queue.
+
+`:exists': Service is already in the queue.
+
+`:already-owner': Service is already the primary owner."
+
+ ;; Add ObjectManager handler.
+ (dbus-register-method
+ bus service nil dbus-interface-objectmanager "GetManagedObjects"
+ 'dbus-managed-objects-handler 'dont-register)
+
+ (let ((arg 0)
+ reply)
+ (dolist (flag flags)
+ (setq arg
+ (+ arg
+ (pcase flag
+ (:allow-replacement 1)
+ (:replace-existing 2)
+ (:do-not-queue 4)
+ (_ (signal 'wrong-type-argument (list flag)))))))
+ (setq reply (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+ "RequestName" service arg))
+ (pcase reply
+ (1 :primary-owner)
+ (2 :in-queue)
+ (3 :exists)
+ (4 :already-owner)
+ (_ (signal 'dbus-error (list "Could not register service" service))))))
+
+(defun dbus-unregister-service (bus service)
+ "Unregister all objects related to SERVICE from D-Bus BUS.
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address. SERVICE must be a known service name.
+
+The function returns a keyword, indicating the result of the
+operation. One of the following keywords is returned:
+
+`:released': Service has become the primary owner of the name.
+
+`:non-existent': Service name does not exist on this bus.
+
+`:not-owner': We are neither the primary owner nor waiting in the
+queue of this service."
+
+ (maphash
+ (lambda (key value)
+ (dolist (elt value)
+ (ignore-errors
+ (when (and (equal bus (cadr key)) (string-equal service (cadr elt)))
+ (unless
+ (puthash key (delete elt value) dbus-registered-objects-table)
+ (remhash key dbus-registered-objects-table))))))
+ dbus-registered-objects-table)
+ (let ((reply (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+ "ReleaseName" service)))
+ (pcase reply
+ (1 :released)
+ (2 :non-existent)
+ (3 :not-owner)
+ (_ (signal 'dbus-error (list "Could not unregister service" service))))))
+
+(defun dbus-register-signal
+ (bus service path interface signal handler &rest args)
+ "Register for a signal on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name used by the sending D-Bus object.
+It can be either a known name or the unique name of the D-Bus object
+sending the signal.
+
+PATH is the D-Bus object path SERVICE is registered. INTERFACE
+is an interface offered by SERVICE. It must provide SIGNAL.
+HANDLER is a Lisp function to be called when the signal is
+received. It must accept as arguments the values SIGNAL is
+sending.
+
+SERVICE, PATH, INTERFACE and SIGNAL can be nil. This is
+interpreted as a wildcard for the respective argument.
+
+The remaining arguments ARGS can be keywords or keyword string pairs.
+The meaning is as follows:
+
+`:argN' STRING:
+`:pathN' STRING: This stands for the Nth argument of the
+signal. `:pathN' arguments can be used for object path wildcard
+matches as specified by D-Bus, while an `:argN' argument
+requires an exact match.
+
+`:arg-namespace' STRING: Register for the signals, which first
+argument defines the service or interface namespace STRING.
+
+`:path-namespace' STRING: Register for the object path namespace
+STRING. All signals sent from an object path, which has STRING as
+the preceding string, are matched. This requires PATH to be nil.
+
+`:eavesdrop': Register for unicast signals which are not directed
+to the D-Bus object Emacs is registered at D-Bus BUS, if the
+security policy of BUS allows this.
+
+Example:
+
+\(defun my-signal-handler (device)
+ (message \"Device %s added\" device))
+
+\(dbus-register-signal
+ :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\"
+ \"org.freedesktop.Hal.Manager\" \"DeviceAdded\" 'my-signal-handler)
+
+ => \(\(:signal :system \"org.freedesktop.Hal.Manager\" \"DeviceAdded\")
+ \(\"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\" my-signal-handler))
+
+`dbus-register-signal' returns an object, which can be used in
+`dbus-unregister-object' for removing the registration."
+
+ (let ((counter 0)
+ (rule "type='signal'")
+ uname key key1 value)
+
+ ;; Retrieve unique name of service. If service is a known name,
+ ;; we will register for the corresponding unique name, if any.
+ ;; Signals are sent always with the unique name as sender. Note:
+ ;; the unique name of `dbus-service-dbus' is that string itself.
+ (if (and (stringp service)
+ (not (zerop (length service)))
+ (not (string-equal service dbus-service-dbus))
+ (not (string-match "^:" service)))
+ (setq uname (dbus-get-name-owner bus service))
+ (setq uname service))
+
+ (setq rule (concat rule
+ (when uname (format ",sender='%s'" uname))
+ (when interface (format ",interface='%s'" interface))
+ (when signal (format ",member='%s'" signal))
+ (when path (format ",path='%s'" path))))
+
+ ;; Add arguments to the rule.
+ (if (or (stringp (car args)) (null (car args)))
+ ;; As backward compatibility option, we allow just strings.
+ (dolist (arg args)
+ (if (stringp arg)
+ (setq rule (concat rule (format ",arg%d='%s'" counter arg)))
+ (if arg (signal 'wrong-type-argument (list "Wrong argument" arg))))
+ (setq counter (1+ counter)))
+
+ ;; Parse keywords.
+ (while args
+ (setq
+ key (car args)
+ rule (concat
+ rule
+ (cond
+ ;; `:arg0' .. `:arg63', `:path0' .. `:path63'.
+ ((and (keywordp key)
+ (string-match
+ "^:\\(arg\\|path\\)\\([[:digit:]]+\\)$"
+ (symbol-name key)))
+ (setq counter (match-string 2 (symbol-name key))
+ args (cdr args)
+ value (car args))
+ (unless (and (<= counter 63) (stringp value))
+ (signal 'wrong-type-argument
+ (list "Wrong argument" key value)))
+ (format
+ ",arg%s%s='%s'"
+ counter
+ (if (string-equal (match-string 1 (symbol-name key)) "path")
+ "path" "")
+ value))
+ ;; `:arg-namespace', `:path-namespace'.
+ ((and (keywordp key)
+ (string-match
+ "^:\\(arg\\|path\\)-namespace$" (symbol-name key)))
+ (setq args (cdr args)
+ value (car args))
+ (unless (stringp value)
+ (signal 'wrong-type-argument
+ (list "Wrong argument" key value)))
+ (format
+ ",%s='%s'"
+ (if (string-equal (match-string 1 (symbol-name key)) "path")
+ "path_namespace" "arg0namespace")
+ value))
+ ;; `:eavesdrop'.
+ ((eq key :eavesdrop)
+ ",eavesdrop='true'")
+ (t (signal 'wrong-type-argument (list "Wrong argument" key)))))
+ args (cdr args))))
+
+ ;; Add the rule to the bus.
+ (condition-case err
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+ "AddMatch" rule)
+ (dbus-error
+ (if (not (string-match "eavesdrop" rule))
+ (signal (car err) (cdr err))
+ ;; The D-Bus spec says we shall fall back to a rule without eavesdrop.
+ (when dbus-debug (message "Removing eavesdrop from rule %s" rule))
+ (setq rule (replace-regexp-in-string ",eavesdrop='true'" "" rule))
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+ "AddMatch" rule))))
+
+ (when dbus-debug (message "Matching rule \"%s\" created" rule))
+
+ ;; Create a hash table entry.
+ (setq key (list :signal bus interface signal)
+ key1 (list uname service path handler rule)
+ value (gethash key dbus-registered-objects-table))
+ (unless (member key1 value)
+ (puthash key (cons key1 value) dbus-registered-objects-table))
+
+ ;; Return the object.
+ (list key (list service path handler))))
+
+(defun dbus-register-method
+ (bus service path interface method handler &optional dont-register-service)
+ "Register for method METHOD on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name of the D-Bus object METHOD is
+registered for. It must be a known name (See discussion of
+DONT-REGISTER-SERVICE below).
+
+PATH is the D-Bus object path SERVICE is registered (See discussion of
+DONT-REGISTER-SERVICE below). INTERFACE is the interface offered by
+SERVICE. It must provide METHOD.
+
+HANDLER is a Lisp function to be called when a method call is
+received. It must accept the input arguments of METHOD. The return
+value of HANDLER is used for composing the returning D-Bus message.
+In case HANDLER shall return a reply message with an empty argument
+list, HANDLER must return the symbol `:ignore'.
+
+When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
+registered. This means that other D-Bus clients have no way of
+noticing the newly registered method. When interfaces are constructed
+incrementally by adding single methods or properties at a time,
+DONT-REGISTER-SERVICE can be used to prevent other clients from
+discovering the still incomplete interface."
+
+ ;; Register SERVICE.
+ (unless (or dont-register-service
+ (member service (dbus-list-names bus)))
+ (dbus-register-service bus service))
+
+ ;; Create a hash table entry. We use nil for the unique name,
+ ;; because the method might be called from anybody.
+ (let* ((key (list :method bus interface method))
+ (key1 (list nil service path handler))
+ (value (gethash key dbus-registered-objects-table)))
+
+ (unless (member key1 value)
+ (puthash key (cons key1 value) dbus-registered-objects-table))
+
+ ;; Return the object.
+ (list key (list service path handler))))
+
(defun dbus-unregister-object (object)
"Unregister OBJECT from D-Bus.
OBJECT must be the result of a preceding `dbus-register-method',
@@ -140,12 +759,13 @@ association to the service from D-Bus."
;; Find the corresponding entry in the hash table.
(let* ((key (car object))
+ (type (car key))
+ (bus (cadr key))
(value (cadr object))
- (bus (car key))
(service (car value))
(entry (gethash key dbus-registered-objects-table))
ret)
- ;; key has the structure (BUS INTERFACE MEMBER).
+ ;; key has the structure (TYPE BUS INTERFACE MEMBER).
;; value has the structure (SERVICE PATH [HANDLER]).
;; entry has the structure ((UNAME SERVICE PATH MEMBER [RULE]) ...).
;; MEMBER is either a string (the handler), or a cons cell (a
@@ -163,155 +783,35 @@ association to the service from D-Bus."
(unless (puthash key (delete elt entry) dbus-registered-objects-table)
(remhash key dbus-registered-objects-table))
;; Remove match rule of signals.
- (let ((rule (nth 4 elt)))
- (when (stringp rule)
- (setq service nil) ; We do not need to unregister the service.
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "RemoveMatch" rule)))))
+ (when (eq type :signal)
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+ "RemoveMatch" (nth 4 elt)))))
+
;; Check, whether there is still a registered function or property
;; for the given service. If not, unregister the service from the
;; bus.
- (when service
- (dolist (elt entry)
- (let (found)
- (maphash
- (lambda (k v)
- (dolist (e v)
- (ignore-errors
- (when (and (equal bus (car k)) (string-equal service (cadr e)))
- (setq found t)))))
- dbus-registered-objects-table)
- (unless found
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "ReleaseName" service)))))
+ (when (and service (memq type '(:method :property))
+ (not (catch :found
+ (progn
+ (maphash
+ (lambda (k v)
+ (dolist (e v)
+ (ignore-errors
+ (and
+ ;; Bus.
+ (equal bus (cadr k))
+ ;; Service.
+ (string-equal service (cadr e))
+ ;; Non-empty object path.
+ (cl-caddr e)
+ (throw :found t)))))
+ dbus-registered-objects-table)
+ nil))))
+ (dbus-unregister-service bus service))
;; Return.
ret))
-(defun dbus-unregister-service (bus service)
- "Unregister all objects related to SERVICE from D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. SERVICE must be a known service name.
-
-The function returns a keyword, indicating the result of the
-operation. One of the following keywords is returned:
-
-`:released': Service has become the primary owner of the name.
-
-`:non-existent': Service name does not exist on this bus.
-
-`:not-owner': We are neither the primary owner nor waiting in the
-queue of this service."
-
- (maphash
- (lambda (key value)
- (dolist (elt value)
- (ignore-errors
- (when (and (equal bus (car key)) (string-equal service (cadr elt)))
- (unless
- (puthash key (delete elt value) dbus-registered-objects-table)
- (remhash key dbus-registered-objects-table))))))
- dbus-registered-objects-table)
- (let ((reply (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "ReleaseName" service)))
- (case reply
- (1 :released)
- (2 :non-existent)
- (3 :not-owner)
- (t (signal 'dbus-error (list "Could not unregister service" service))))))
-
-(defun dbus-call-method-non-blocking-handler (&rest args)
- "Handler for reply messages of asynchronous D-Bus message calls.
-It calls the function stored in `dbus-registered-objects-table'.
-The result will be made available in `dbus-return-values-table'."
- (puthash (list (dbus-event-bus-name last-input-event)
- (dbus-event-serial-number last-input-event))
- (if (= (length args) 1) (car args) args)
- dbus-return-values-table))
-
-(defun dbus-call-method-non-blocking
- (bus service path interface method &rest args)
- "Call METHOD on the D-Bus BUS, but don't block the event queue.
-This is necessary for communicating to registered D-Bus methods,
-which are running in the same Emacs process.
-
-The arguments are the same as in `dbus-call-method'.
-
-usage: (dbus-call-method-non-blocking
- BUS SERVICE PATH INTERFACE METHOD
- &optional :timeout TIMEOUT &rest ARGS)"
-
- (let ((key
- (apply
- 'dbus-call-method-asynchronously
- bus service path interface method
- 'dbus-call-method-non-blocking-handler args)))
- ;; Wait until `dbus-call-method-non-blocking-handler' has put the
- ;; result into `dbus-return-values-table'.
- (while (eq (gethash key dbus-return-values-table :ignore) :ignore)
- (read-event nil nil 0.1))
-
- ;; Cleanup `dbus-return-values-table'. Return the result.
- (prog1
- (gethash key dbus-return-values-table nil)
- (remhash key dbus-return-values-table))))
-
-(defun dbus-name-owner-changed-handler (&rest args)
- "Reapplies all member registrations to D-Bus.
-This handler is applied when a \"NameOwnerChanged\" signal has
-arrived. SERVICE is the object name for which the name owner has
-been changed. OLD-OWNER is the previous owner of SERVICE, or the
-empty string if SERVICE was not owned yet. NEW-OWNER is the new
-owner of SERVICE, or the empty string if SERVICE loses any name owner.
-
-usage: (dbus-name-owner-changed-handler service old-owner new-owner)"
- (save-match-data
- ;; Check the arguments. We should silently ignore it when they
- ;; are wrong.
- (if (and (= (length args) 3)
- (stringp (car args))
- (stringp (cadr args))
- (stringp (caddr args)))
- (let ((service (car args))
- (old-owner (cadr args))
- (new-owner (caddr args)))
- ;; Check whether SERVICE is a known name.
- (when (not (string-match "^:" service))
- (maphash
- (lambda (key value)
- (dolist (elt value)
- ;; key has the structure (BUS INTERFACE MEMBER).
- ;; elt has the structure (UNAME SERVICE PATH HANDLER).
- (when (string-equal old-owner (car elt))
- ;; Remove old key, and add new entry with changed name.
- (dbus-unregister-object (list key (cdr elt)))
- ;; Maybe we could arrange the lists a little bit better
- ;; that we don't need to extract every single element?
- (dbus-register-signal
- ;; BUS SERVICE PATH
- (nth 0 key) (nth 1 elt) (nth 2 elt)
- ;; INTERFACE MEMBER HANDLER
- (nth 1 key) (nth 2 key) (nth 3 elt)))))
- (copy-hash-table dbus-registered-objects-table))))
- ;; The error is reported only in debug mode.
- (when dbus-debug
- (signal
- 'dbus-error
- (cons
- (format "Wrong arguments of %s.NameOwnerChanged" dbus-interface-dbus)
- args))))))
-
-;; Register the handler.
-(when nil ;ignore-errors
- (dbus-register-signal
- :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "NameOwnerChanged" 'dbus-name-owner-changed-handler)
- (dbus-register-signal
- :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "NameOwnerChanged" 'dbus-name-owner-changed-handler))
-
;;; D-Bus type conversion.
@@ -437,9 +937,9 @@ If the HANDLER returns a `dbus-error', it is propagated as return message."
(dbus-ignore-errors
(if (eq result :ignore)
(dbus-method-return-internal
- (nth 1 event) (nth 3 event) (nth 4 event))
+ (nth 1 event) (nth 4 event) (nth 3 event))
(apply 'dbus-method-return-internal
- (nth 1 event) (nth 3 event) (nth 4 event)
+ (nth 1 event) (nth 4 event) (nth 3 event)
(if (consp result) result (list result)))))))
;; Error handling.
(dbus-error
@@ -447,9 +947,9 @@ If the HANDLER returns a `dbus-error', it is propagated as return message."
(when (= dbus-message-type-method-call (nth 2 event))
(dbus-ignore-errors
(dbus-method-error-internal
- (nth 1 event) (nth 3 event) (nth 4 event) (cadr err))))
+ (nth 1 event) (nth 4 event) (nth 3 event) (cadr err))))
;; Propagate D-Bus error messages.
- (run-hook-with-args 'dbus-event-error-hooks event err)
+ (run-hook-with-args 'dbus-event-error-functions event err)
(when (or dbus-debug (= dbus-message-type-error (nth 2 event)))
(signal (car err) (cdr err))))))
@@ -594,13 +1094,11 @@ denoting the bus address. SERVICE must be a known service name,
and PATH must be a valid object path. The last two parameters
are strings. The result, the introspection data, is a string in
XML format."
- ;; We don't want to raise errors. `dbus-call-method-non-blocking'
- ;; is used, because the handler can be registered in our Emacs
- ;; instance; caller an callee would block each other.
+ ;; We don't want to raise errors.
(dbus-ignore-errors
- (funcall
- (if noninteractive 'dbus-call-method 'dbus-call-method-non-blocking)
- bus service path dbus-interface-introspectable "Introspect")))
+ (dbus-call-method
+ bus service path dbus-interface-introspectable "Introspect"
+ :timeout 1000)))
(defun dbus-introspect-xml (bus service path)
"Return the introspection data of SERVICE in D-Bus BUS at object path PATH.
@@ -854,12 +1352,11 @@ be \"out\"."
It will be checked at BUS, SERVICE, PATH. The result can be any
valid D-Bus value, or `nil' if there is no PROPERTY."
(dbus-ignore-errors
- ;; "Get" returns a variant, so we must use the `car'.
- (car
- (funcall
- (if noninteractive 'dbus-call-method 'dbus-call-method-non-blocking)
- bus service path dbus-interface-properties
- "Get" :timeout 500 interface property))))
+ ;; "Get" returns a variant, so we must use the `car'.
+ (car
+ (dbus-call-method
+ bus service path dbus-interface-properties
+ "Get" :timeout 500 interface property))))
(defun dbus-set-property (bus service path interface property value)
"Set value of PROPERTY of INTERFACE to VALUE.
@@ -867,13 +1364,12 @@ It will be checked at BUS, SERVICE, PATH. When the value has
been set successful, the result is VALUE. Otherwise, `nil' is
returned."
(dbus-ignore-errors
- ;; "Set" requires a variant.
- (funcall
- (if noninteractive 'dbus-call-method 'dbus-call-method-non-blocking)
- bus service path dbus-interface-properties
- "Set" :timeout 500 interface property (list :variant value))
- ;; Return VALUE.
- (dbus-get-property bus service path interface property)))
+ ;; "Set" requires a variant.
+ (dbus-call-method
+ bus service path dbus-interface-properties
+ "Set" :timeout 500 interface property (list :variant value))
+ ;; Return VALUE.
+ (dbus-get-property bus service path interface property)))
(defun dbus-get-all-properties (bus service path interface)
"Return all properties of INTERFACE at BUS, SERVICE, PATH.
@@ -884,14 +1380,11 @@ name of the property, and its value. If there are no properties,
;; "GetAll" returns "a{sv}".
(let (result)
(dolist (dict
- (funcall
- (if noninteractive
- 'dbus-call-method
- 'dbus-call-method-non-blocking)
+ (dbus-call-method
bus service path dbus-interface-properties
"GetAll" :timeout 500 interface)
result)
- (add-to-list 'result (cons (car dict) (caadr dict)) 'append)))))
+ (add-to-list 'result (cons (car dict) (cl-caadr dict)) 'append)))))
(defun dbus-register-property
(bus service path interface property access value
@@ -931,14 +1424,7 @@ constructed incrementally by adding single methods or properties
at a time, DONT-REGISTER-SERVICE can be used to prevent other
clients from discovering the still incomplete interface."
(unless (member access '(:read :readwrite))
- (signal 'dbus-error (list "Access type invalid" access)))
-
- ;; Register SERVICE.
- (unless (or dont-register-service
- (member service (dbus-list-names bus)))
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "RequestName" service 0))
+ (signal 'wrong-type-argument (list "Access type invalid" access)))
;; Add handlers for the three property-related methods.
(dbus-register-method
@@ -951,20 +1437,20 @@ clients from discovering the still incomplete interface."
bus service path dbus-interface-properties "Set"
'dbus-property-handler 'dont-register)
- ;; Register the name SERVICE with BUS.
- (unless dont-register-service
+ ;; Register SERVICE.
+ (unless (or dont-register-service (member service (dbus-list-names bus)))
(dbus-register-service bus service))
;; Send the PropertiesChanged signal.
(when emits-signal
(dbus-send-signal
bus service path dbus-interface-properties "PropertiesChanged"
- (list (list :dict-entry property (list :variant value)))
+ `((:dict-entry ,property (:variant ,value)))
'(:array)))
;; Create a hash table entry. We use nil for the unique name,
;; because the property might be accessed from anybody.
- (let ((key (list bus interface property))
+ (let ((key (list :property bus interface property))
(val
(list
(list
@@ -979,7 +1465,7 @@ clients from discovering the still incomplete interface."
(defun dbus-property-handler (&rest args)
"Default handler for the \"org.freedesktop.DBus.Properties\" interface.
-It will be registered for all objects created by `dbus-register-object'."
+It will be registered for all objects created by `dbus-register-property'."
(let ((bus (dbus-event-bus-name last-input-event))
(service (dbus-event-service-name last-input-event))
(path (dbus-event-path-name last-input-event))
@@ -989,15 +1475,15 @@ It will be registered for all objects created by `dbus-register-object'."
(cond
;; "Get" returns a variant.
((string-equal method "Get")
- (let ((entry (gethash (list bus interface property)
+ (let ((entry (gethash (list :property bus interface property)
dbus-registered-objects-table)))
(when (string-equal path (nth 2 (car entry)))
- (list (list :variant (cdar (last (car entry))))))))
+ `((:variant ,(cdar (last (car entry))))))))
;; "Set" expects a variant.
((string-equal method "Set")
(let* ((value (caar (cddr args)))
- (entry (gethash (list bus interface property)
+ (entry (gethash (list :property bus interface property)
dbus-registered-objects-table))
;; The value of the hash table is a list; in case of
;; properties it contains just one element (UNAME SERVICE
@@ -1012,7 +1498,7 @@ It will be registered for all objects created by `dbus-register-object'."
(unless (member :readwrite (car object))
(signal 'dbus-error
(list "Property not writable at path" property path)))
- (puthash (list bus interface property)
+ (puthash (list :property bus interface property)
(list (append (butlast (car entry))
(list (cons (car object) value))))
dbus-registered-objects-table)
@@ -1020,7 +1506,7 @@ It will be registered for all objects created by `dbus-register-object'."
(when (member :emits-signal (car object))
(dbus-send-signal
bus service path dbus-interface-properties "PropertiesChanged"
- (list (list :dict-entry property (list :variant value)))
+ `((:dict-entry ,property (:variant ,value)))
'(:array)))
;; Return empty reply.
:ignore))
@@ -1030,7 +1516,7 @@ It will be registered for all objects created by `dbus-register-object'."
(let (result)
(maphash
(lambda (key val)
- (when (and (equal (butlast key) (list bus interface))
+ (when (and (equal (butlast key) (list :property bus interface))
(string-equal path (nth 2 (car val)))
(not (functionp (car (last (car val))))))
(add-to-list
@@ -1039,17 +1525,154 @@ It will be registered for all objects created by `dbus-register-object'."
(car (last key))
(list :variant (cdar (last (car val))))))))
dbus-registered-objects-table)
- (list result))))))
+ ;; Return the result, or an empty array.
+ (list :array (or result '(:signature "{sv}"))))))))
+
+
+;;; D-Bus object manager.
+
+(defun dbus-get-all-managed-objects (bus service path)
+ "Return all objects at BUS, SERVICE, PATH, and the children of PATH.
+The result is a list of objects. Every object is a cons of an
+existing path name, and the list of available interface objects.
+An interface object is another cons, which car is the interface
+name, and the cdr is the list of properties as returned by
+`dbus-get-all-properties' for that path and interface. Example:
+
+\(dbus-get-all-managed-objects :session \"org.gnome.SettingsDaemon\" \"/\")
+
+ => \(\(\"/org/gnome/SettingsDaemon/MediaKeys\"
+ \(\"org.gnome.SettingsDaemon.MediaKeys\")
+ \(\"org.freedesktop.DBus.Peer\")
+ \(\"org.freedesktop.DBus.Introspectable\")
+ \(\"org.freedesktop.DBus.Properties\")
+ \(\"org.freedesktop.DBus.ObjectManager\"))
+ \(\"/org/gnome/SettingsDaemon/Power\"
+ \(\"org.gnome.SettingsDaemon.Power.Keyboard\")
+ \(\"org.gnome.SettingsDaemon.Power.Screen\")
+ \(\"org.gnome.SettingsDaemon.Power\"
+ \(\"Icon\" . \". GThemedIcon battery-full-charged-symbolic \")
+ \(\"Tooltip\" . \"Laptop battery is charged\"))
+ \(\"org.freedesktop.DBus.Peer\")
+ \(\"org.freedesktop.DBus.Introspectable\")
+ \(\"org.freedesktop.DBus.Properties\")
+ \(\"org.freedesktop.DBus.ObjectManager\"))
+ ...)
+
+If possible, \"org.freedesktop.DBus.ObjectManager.GetManagedObjects\"
+is used for retrieving the information. Otherwise, the information
+is collected via \"org.freedesktop.DBus.Introspectable.Introspect\"
+and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
+ (let ((result
+ ;; Direct call. Fails, if the target does not support the
+ ;; object manager interface.
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus service path dbus-interface-objectmanager
+ "GetManagedObjects" :timeout 1000))))
+
+ (if result
+ ;; Massage the returned structure.
+ (dolist (entry result result)
+ ;; "a{oa{sa{sv}}}".
+ (dolist (entry1 (cdr entry))
+ ;; "a{sa{sv}}".
+ (dolist (entry2 entry1)
+ ;; "a{sv}".
+ (if (cadr entry2)
+ ;; "sv".
+ (dolist (entry3 (cadr entry2))
+ (setcdr entry3 (cl-caadr entry3)))
+ (setcdr entry2 nil)))))
+
+ ;; Fallback: collect the information. Slooow!
+ (dolist (object
+ (dbus-introspect-get-all-nodes bus service path)
+ result)
+ (let (result1)
+ (dolist
+ (interface
+ (dbus-introspect-get-interface-names bus service object)
+ result1)
+ (add-to-list
+ 'result1
+ (cons interface
+ (dbus-get-all-properties bus service object interface))))
+ (when result1
+ (add-to-list 'result (cons object result1))))))))
+
+(defun dbus-managed-objects-handler ()
+ "Default handler for the \"org.freedesktop.DBus.ObjectManager\" interface.
+It will be registered for all objects created by `dbus-register-method'."
+ (let* ((last-input-event last-input-event)
+ (bus (dbus-event-bus-name last-input-event))
+ (service (dbus-event-service-name last-input-event))
+ (path (dbus-event-path-name last-input-event)))
+ ;; "GetManagedObjects" returns "a{oa{sa{sv}}}".
+ (let (interfaces result)
+
+ ;; Check for object path wildcard interfaces.
+ (maphash
+ (lambda (key val)
+ (when (and (equal (butlast key 2) (list :method bus))
+ (null (nth 2 (car-safe val))))
+ (add-to-list 'interfaces (nth 2 key))))
+ dbus-registered-objects-table)
+
+ ;; Check all registered object paths.
+ (maphash
+ (lambda (key val)
+ (let ((object (or (nth 2 (car-safe val)) ""))
+ (interface (nth 2 key)))
+ (when (and (equal (butlast key 2) (list :method bus))
+ (string-prefix-p path object))
+ (dolist (interface (cons (nth 2 key) interfaces))
+ (unless (assoc object result)
+ (add-to-list 'result (list object)))
+ (unless (assoc interface (cdr (assoc object result)))
+ (setcdr
+ (assoc object result)
+ (append
+ (list (cons
+ interface
+ ;; We simulate "org.freedesktop.DBus.Properties.GetAll"
+ ;; by using an appropriate D-Bus event.
+ (let ((last-input-event
+ (append
+ (butlast last-input-event 4)
+ (list object dbus-interface-properties
+ "GetAll" 'dbus-property-handler))))
+ (dbus-property-handler interface))))
+ (cdr (assoc object result)))))))))
+ dbus-registered-objects-table)
+
+ ;; Return the result, or an empty array.
+ (list
+ :array
+ (or
+ (mapcar
+ (lambda (x)
+ (list
+ :dict-entry :object-path (car x)
+ (cons :array (mapcar (lambda (y) (cons :dict-entry y)) (cdr x)))))
+ result)
+ '(:signature "{oa{sa{sv}}}"))))))
-;; Initialize :system and :session buses. This adds their file
+;; Initialize `:system' and `:session' buses. This adds their file
;; descriptors to input_wait_mask, in order to detect incoming
;; messages immediately.
(when (featurep 'dbusbind)
(dbus-ignore-errors
- (dbus-init-bus :system)
+ (dbus-init-bus :system))
+ (dbus-ignore-errors
(dbus-init-bus :session)))
(provide 'dbus)
+;;; TODO:
+
+;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and
+;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved.
+
;;; dbus.el ends here
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index af78ded4786..6fffce679d1 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -1,6 +1,6 @@
;;; dig.el --- Domain Name System dig interface
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: DNS BIND dig comm
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index 3c1bd54acfd..b94c161da31 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -1,6 +1,6 @@
;;; dns.el --- Domain Name Service lookups
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network comm
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 5847a2def64..17ea7f7fcd3 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -1,6 +1,6 @@
;;; eudc-bob.el --- Binary Objects Support for EUDC
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Maintainer: Pavel Jank <Pavel@Janik.cz>
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index af8bc084b57..beaceedd788 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -1,6 +1,6 @@
;;; eudc-export.el --- functions to export EUDC query results
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Maintainer: Pavel Jank <Pavel@Janik.cz>
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
index 1f6c4464808..a4b98f9864b 100644
--- a/lisp/net/eudc-hotlist.el
+++ b/lisp/net/eudc-hotlist.el
@@ -1,6 +1,6 @@
;;; eudc-hotlist.el --- hotlist management for EUDC
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Maintainer: Pavel Jank <Pavel@Janik.cz>
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index d9985312f99..c6b42b2ba72 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -1,6 +1,6 @@
;;; eudc-vars.el --- Emacs Unified Directory Client
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Maintainer: Pavel Jank <Pavel@Janik.cz>
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 6f4d5b2bbda..0e9707e57f3 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -1,6 +1,6 @@
;;; eudc.el --- Emacs Unified Directory Client
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Maintainer: Pavel Jank <Pavel@Janik.cz>
@@ -48,9 +48,7 @@
(eval-and-compile
(if (not (fboundp 'make-overlay))
- (require 'overlay))
- (if (not (fboundp 'unless))
- (require 'cl)))
+ (require 'overlay)))
(unless (fboundp 'custom-menu-create)
(autoload 'custom-menu-create "cus-edit"))
@@ -133,7 +131,7 @@
(setq plist (cdr (cdr plist))))
nil))
-;; Emacs' plist-get lacks third parameter
+;; Emacs's plist-get lacks third parameter
(defun eudc-plist-get (plist prop &optional default)
"Extract a value from a property list.
PLIST is a property list, which is a list of the form
@@ -1213,7 +1211,7 @@ queries the server for the existing fields and displays a corresponding form."
;;; Load the options file
(if (and (not noninteractive)
(and (locate-library eudc-options-file)
- (progn (message "") t)) ; Remove modeline message
+ (progn (message "") t)) ; Remove mode line message
(not (featurep 'eudc-options-file)))
(load eudc-options-file))
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index 5afd255f419..42b618815f5 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -1,6 +1,6 @@
;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Maintainer: Pavel Jank <Pavel@Janik.cz>
@@ -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/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index fc7519e5b30..ba664e41362 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -1,6 +1,6 @@
;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Maintainer: Pavel Jank <Pavel@Janik.cz>
diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el
index 485ca5a0c06..69058c7af5c 100644
--- a/lisp/net/eudcb-mab.el
+++ b/lisp/net/eudcb-mab.el
@@ -1,6 +1,6 @@
;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@newartisans.com>
;; Maintainer: FSF
diff --git a/lisp/net/eudcb-ph.el b/lisp/net/eudcb-ph.el
index 9e7490106ed..8da98e9d7ce 100644
--- a/lisp/net/eudcb-ph.el
+++ b/lisp/net/eudcb-ph.el
@@ -1,6 +1,6 @@
;;; eudcb-ph.el --- Emacs Unified Directory Client - CCSO PH/QI Backend
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Maintainer: Pavel Jank <Pavel@Janik.cz>
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 18471782f2c..d33480afb28 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -1,6 +1,6 @@
;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: comm, tls, ssl, encryption
@@ -35,10 +35,11 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup gnutls nil
"Emacs interface to the GnuTLS library."
+ :version "24.1"
:prefix "gnutls-"
:group 'net-utils)
@@ -46,18 +47,35 @@
"If non-nil, this should be a TLS priority string.
For instance, if you want to skip the \"dhe-rsa\" algorithm,
set this variable to \"normal:-dhe-rsa\"."
+ :group 'gnutls
:type '(choice (const nil)
- string))
+ string))
+
+(defcustom gnutls-trustfiles
+ '(
+ "/etc/ssl/certs/ca-certificates.crt" ; Debian, Ubuntu, Gentoo and Arch Linux
+ "/etc/pki/tls/certs/ca-bundle.crt" ; Fedora and RHEL
+ "/etc/ssl/ca-bundle.pem" ; Suse
+ "/usr/ssl/certs/ca-bundle.crt" ; Cygwin
+ )
+ "List of CA bundle location filenames or a function returning said list.
+The files may be in PEM or DER format, as per the GnuTLS documentation.
+The files may not exist, in which case they will be ignored."
+ :group 'gnutls
+ :type '(choice (function :tag "Function to produce list of bundle filenames")
+ (repeat (file :tag "Bundle filename"))))
;;;###autoload
-(defcustom gnutls-min-prime-bits nil
- "The minimum number of bits to be used in Diffie-Hellman key exchange.
-
-This sets the minimum accepted size of the key to be used in a
-client-server handshake. If the server sends a prime with fewer than
-the specified number of bits the handshake will fail.
-
-A value of nil says to use the default gnutls value."
+(defcustom gnutls-min-prime-bits 256
+ ;; Several mail servers send fewer bits than the GnuTLS default.
+ ;; Currently, 256 appears to be a reasonable choice (Bug#11267).
+ "Minimum number of prime bits accepted by GnuTLS for key exchange.
+During a Diffie-Hellman handshake, if the server sends a prime
+number with fewer than this number of bits, the handshake is
+rejected. \(The smaller the prime number, the less secure the
+key exchange is against man-in-the-middle attacks.)
+
+A value of nil says to use the default GnuTLS value."
:type '(choice (const :tag "Use default value" nil)
(integer :tag "Number of bits" 512))
:group 'gnutls)
@@ -102,7 +120,7 @@ trust and key files, and priority string."
(declare-function gnutls-boot "gnutls.c" (proc type proplist))
(declare-function gnutls-errorp "gnutls.c" (error))
-(defun* gnutls-negotiate
+(cl-defun gnutls-negotiate
(&rest spec
&key process type hostname priority-string
trustfiles crlfiles keylist min-prime-bits
@@ -116,7 +134,7 @@ TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default.
PROCESS is a process returned by `open-network-stream'.
HOSTNAME is the remote hostname. It must be a valid string.
PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
-TRUSTFILES is a list of CA bundles.
+TRUSTFILES is a list of CA bundles. It defaults to `gnutls-trustfiles'.
CRLFILES is a list of CRL files.
KEYLIST is an alist of (client key file, client cert file) pairs.
MIN-PRIME-BITS is the minimum acceptable size of Diffie-Hellman keys
@@ -154,18 +172,20 @@ here's a recent version of the list.
It must be omitted, a number, or nil; if omitted or nil it
defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
(let* ((type (or type 'gnutls-x509pki))
- (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
(trustfiles (or trustfiles
- (when (file-exists-p default-trustfile)
- (list default-trustfile))))
+ (delq nil
+ (mapcar (lambda (f) (and f (file-exists-p f) f))
+ (if (functionp gnutls-trustfiles)
+ (funcall gnutls-trustfiles)
+ gnutls-trustfiles)))))
(priority-string (or priority-string
(cond
((eq type 'gnutls-anon)
"NORMAL:+ANON-DH:!ARCFOUR-128")
((eq type 'gnutls-x509pki)
- (if gnutls-algorithm-priority
- (upcase gnutls-algorithm-priority)
- "NORMAL")))))
+ (if gnutls-algorithm-priority
+ (upcase gnutls-algorithm-priority)
+ "NORMAL")))))
(min-prime-bits (or min-prime-bits gnutls-min-prime-bits))
(params `(:priority ,priority-string
:hostname ,hostname
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 1432c1e516b..f9e31788527 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -1,6 +1,6 @@
;;; goto-addr.el --- click to browse URL or to send to e-mail address
-;; Copyright (C) 1995, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2000-2012 Free Software Foundation, Inc.
;; Author: Eric Ding <ericding@alum.mit.edu>
;; Maintainer: FSF
@@ -33,7 +33,7 @@
;; INSTALLATION
;;
;; To use goto-address in a particular mode (for example, while
-;; reading mail in mh-e), add something like this in your .emacs file:
+;; reading mail in mh-e), add this to your init file:
;;
;; (add-hook 'mh-show-mode-hook 'goto-address)
;;
@@ -80,18 +80,18 @@
;; I don't expect users to want fontify'ing without highlighting.
(defcustom goto-address-fontify-p t
- "*Non-nil means URLs and e-mail addresses in buffer are fontified.
+ "Non-nil means URLs and e-mail addresses in buffer are fontified.
But only if `goto-address-highlight-p' is also non-nil."
:type 'boolean
:group 'goto-address)
(defcustom goto-address-highlight-p t
- "*Non-nil means URLs and e-mail addresses in buffer are highlighted."
+ "Non-nil means URLs and e-mail addresses in buffer are highlighted."
:type 'boolean
:group 'goto-address)
(defcustom goto-address-fontify-maximum-size 30000
- "*Maximum size of file in which to fontify and/or highlight URLs.
+ "Maximum size of file in which to fontify and/or highlight URLs.
A value of t means there is no limit--fontify regardless of the size."
:type '(choice (integer :tag "Maximum size") (const :tag "No limit" t))
:group 'goto-address)
@@ -275,7 +275,10 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
;;;###autoload
(define-minor-mode goto-address-mode
- "Minor mode to buttonize URLs and e-mail addresses in the current buffer."
+ "Minor mode to buttonize URLs and e-mail addresses in the current buffer.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
nil
""
nil
diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el
index 5c8710afdbf..ae604767a79 100644
--- a/lisp/net/hmac-def.el
+++ b/lisp/net/hmac-def.el
@@ -1,6 +1,6 @@
;;; hmac-def.el --- A macro for defining HMAC functions.
-;; Copyright (C) 1999, 2001, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2007-2012 Free Software Foundation, Inc.
;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Keywords: HMAC, RFC2104
diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el
index a423cbeadd1..8d33750df25 100644
--- a/lisp/net/hmac-md5.el
+++ b/lisp/net/hmac-md5.el
@@ -1,6 +1,6 @@
;;; hmac-md5.el --- Compute HMAC-MD5.
-;; Copyright (C) 1999, 2001, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2007-2012 Free Software Foundation, Inc.
;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Keywords: HMAC, RFC2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index f4af03f100f..531f0730652 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -1,6 +1,6 @@
;;; imap.el --- imap library
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: mail
@@ -68,7 +68,7 @@
;; imap-body-lines
;;
;; It is my hope that these commands should be pretty self
-;; explanatory for someone that know IMAP. All functions have
+;; explanatory for someone who knows IMAP. All functions have
;; additional documentation on how to invoke them.
;;
;; imap.el supports RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1). The implemented
@@ -211,7 +211,7 @@ until a successful connection is made."
:type '(repeat string))
(defcustom imap-process-connection-type nil
- "*Value for `process-connection-type' to use for Kerberos4, GSSAPI, shell, and SSL.
+ "Value for `process-connection-type' to use for Kerberos4, GSSAPI, shell, and SSL.
The `process-connection-type' variable controls the type of device
used to communicate with subprocesses. Values are nil to use a
pipe, or t or `pty' to use a pty. The value has no effect if the
@@ -271,7 +271,7 @@ See also `imap-log'."
(symbol-name system-type))
1.0
0.1)
- "*How long to wait between checking for the end of output.
+ "How long to wait between checking for the end of output.
Shorter values mean quicker response, but is more CPU intensive."
:type 'number
:group 'imap)
@@ -838,9 +838,10 @@ sure of changing the value of `foo'."
(defun imap-interactive-login (buffer loginfunc)
"Login to server in BUFFER.
-LOGINFUNC is passed a username and a password, it should return t if
-it where successful authenticating itself to the server, nil otherwise.
-Returns t if login was successful, nil otherwise."
+Return t if login was successful, nil otherwise.
+
+LOGINFUNC is passed a username and a password. It should return
+t if it successfully authenticates, nil otherwise."
(with-current-buffer buffer
(make-local-variable 'imap-username)
(make-local-variable 'imap-password)
@@ -1187,11 +1188,12 @@ respond. If BUFFER is nil, the current buffer is used."
(defun imap-authenticate (&optional user passwd buffer)
"Authenticate to server in BUFFER, using current buffer if nil.
-It uses the authenticator specified when opening the server. If the
-authenticator requires username/passwords, they are queried from the
-user and optionally stored in the buffer. If USER and/or PASSWD is
-specified, the user will not be questioned and the username and/or
-password is remembered in the buffer."
+It uses the authenticator specified when opening the server.
+
+Optional arguments USER and PASSWD specify the username and
+password to use if the authenticator requires a username and/or
+password. If omitted or nil, the authenticator may query the
+user for a username and/or password."
(with-current-buffer (or buffer (current-buffer))
(if (not (eq imap-state 'nonauth))
(or (eq imap-state 'auth)
@@ -1475,7 +1477,7 @@ If BUFFER is nil the current buffer is assumed."
(defun imap-mailbox-lsub (&optional root reference add-delimiter buffer)
"Return a list of subscribed mailboxes on server in BUFFER.
If ROOT is non-nil, only list matching mailboxes. If ADD-DELIMITER is
-non-nil, a hierarchy delimiter is added to root. REFERENCE is a
+non-nil, a hierarchy delimiter is added to root. REFERENCE is an
implementation-specific string that has to be passed to lsub command."
(with-current-buffer (or buffer (current-buffer))
;; Make sure we know the hierarchy separator for root's hierarchy
@@ -1499,7 +1501,7 @@ implementation-specific string that has to be passed to lsub command."
(defun imap-mailbox-list (root &optional reference add-delimiter buffer)
"Return a list of mailboxes matching ROOT on server in BUFFER.
If ADD-DELIMITER is non-nil, a hierarchy delimiter is added to
-root. REFERENCE is a implementation-specific string that has to be
+root. REFERENCE is an implementation-specific string that has to be
passed to list command."
(with-current-buffer (or buffer (current-buffer))
;; Make sure we know the hierarchy separator for root's hierarchy
@@ -1559,7 +1561,7 @@ returned, if ITEMS is a symbol only its value is returned."
(imap-mailbox-get items mailbox)))))
(defun imap-mailbox-status-asynch (mailbox items &optional buffer)
- "Send status item request ITEM on MAILBOX to server in BUFFER.
+ "Send status item requests ITEMS on MAILBOX to server in BUFFER.
ITEMS can be a symbol or a list of symbols, valid symbols are one of
the STATUS data items -- i.e. 'messages, 'recent, 'uidnext, 'uidvalidity
or 'unseen. The IMAP command tag is returned."
@@ -1596,7 +1598,7 @@ or 'unseen. The IMAP command tag is returned."
rights))))))
(defun imap-mailbox-acl-delete (identifier &optional mailbox buffer)
- "Remove any <identifier,rights> pair for IDENTIFIER in MAILBOX from server in BUFFER."
+ "Remove <id,rights> pairs for IDENTIFIER from MAILBOX on server in BUFFER."
(let ((mailbox (imap-utf7-encode mailbox)))
(with-current-buffer (or buffer (current-buffer))
(imap-ok-p
@@ -1642,8 +1644,8 @@ or 'unseen. The IMAP command tag is returned."
(defun imap-fetch (uids props &optional receive nouidfetch buffer)
"Fetch properties PROPS from message set UIDS from server in BUFFER.
-UIDS can be a string, number or a list of numbers. If RECEIVE
-is non-nil return these properties."
+UIDS can be a string, number or a list of numbers. If RECEIVE is
+non-nil, return these properties."
(with-current-buffer (or buffer (current-buffer))
(when (imap-ok-p (imap-send-command-wait
(format "%sFETCH %s %s" (if nouidfetch "" "UID ")
@@ -1743,7 +1745,8 @@ is non-nil return these properties."
(imap-mailbox-get-1 'search imap-current-mailbox)))))
(defun imap-message-flag-permanent-p (flag &optional mailbox buffer)
- "Return t if FLAG can be permanently (between IMAP sessions) saved on articles, in MAILBOX on server in BUFFER."
+ "Return t if FLAG can be permanently saved on articles.
+MAILBOX specifies a mailbox on the server in BUFFER."
(with-current-buffer (or buffer (current-buffer))
(or (member "\\*" (imap-mailbox-get 'permanentflags mailbox))
(member flag (imap-mailbox-get 'permanentflags mailbox)))))
@@ -1918,7 +1921,7 @@ on failure."
0))
(defun imap-envelope-from (from)
- "Return a from string line."
+ "Return a FROM string line."
(and from
(concat (aref from 0)
(if (aref from 0) " <")
@@ -2285,7 +2288,7 @@ Return nil if no complete line has arrived."
;; ; capability.
(defun imap-parse-response ()
- "Parse a IMAP command response."
+ "Parse an IMAP command response."
(let (token)
(case (setq token (read (current-buffer)))
(+ (setq imap-continuation
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 1fa57dbfe3e..6ef713de93d 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -1,6 +1,6 @@
;;; ldap.el --- client interface to LDAP for Emacs
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Maintainer: FSF
@@ -34,7 +34,6 @@
;;; Code:
(require 'custom)
-(eval-when-compile (require 'cl))
(autoload 'auth-source-search "auth-source")
@@ -465,12 +464,12 @@ Additional search parameters can be specified through
(error "No LDAP host specified"))
(let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
result)
- (setq result (ldap-search-internal (list* 'host host
- 'filter filter
- 'attributes attributes
- 'attrsonly attrsonly
- 'withdn withdn
- host-plist)))
+ (setq result (ldap-search-internal `(host ,host
+ filter ,filter
+ attributes ,attributes
+ attrsonly ,attrsonly
+ withdn ,withdn
+ ,@host-plist)))
(if ldap-ignore-attribute-codings
result
(mapcar (lambda (record)
@@ -605,6 +604,7 @@ an alist of attribute/value pairs."
;; Skip error message when retrieving attribute list
(if (looking-at "Size limit exceeded")
(forward-line 1))
+ (if (looking-at "version:") (forward-line 1)) ;bug#12724.
(while (progn
(skip-chars-forward " \t\n")
(not (eobp)))
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index 68a0a6a85d4..f85983e6e9f 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -1,6 +1,6 @@
;;; mairix.el --- Mairix interface for Emacs
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: David Engster <dengste@eml.cc>
;; Keywords: mail searching
@@ -70,8 +70,6 @@
(require 'widget)
(require 'cus-edit)
-(eval-when-compile
- (require 'cl))
;;; Keymappings
@@ -570,10 +568,10 @@ whole threads. Function returns t if messages were found."
mairix-output-buffer)))
(zerop rval)))
-(defun mairix-replace-illegal-chars (header)
- "Replace illegal characters in HEADER for mairix query."
+(defun mairix-replace-invalid-chars (header)
+ "Replace invalid characters in HEADER for mairix query."
(when header
- (while (string-match "[^-.@/,& [:alnum:]]" header)
+ (while (string-match "[^-.@/,^=~& [:alnum:]]" header)
(setq header (replace-match "" t t header)))
(while (string-match "[& ]" header)
(setq header (replace-match "," t t header)))
@@ -620,7 +618,7 @@ See %s for details" mairix-output-buffer)))
(concat
(nth 1 cur)
":"
- (mairix-replace-illegal-chars
+ (mairix-replace-invalid-chars
(widget-value
(cadr (assoc (concat "e" (car (cddr cur))) widgets)))))
query)))
@@ -652,9 +650,17 @@ Fill in VALUES if based on an article."
(kill-all-local-variables)
(erase-buffer)
(widget-insert
- "Specify your query for Mairix (check boxes for activating fields):\n\n")
+ "Specify your query for Mairix using check boxes for activating fields.\n\n")
+ (widget-insert
+ (concat "Use ~word to match messages "
+ (propertize "not" 'face 'italic)
+ " containing the word)\n"
+ " substring= to match words containing the substring\n"
+ " substring=N to match words containing the substring, allowing\n"
+ " up to N errors(missing/extra/different letters)\n"
+ " ^substring= to match the substring at the beginning of a word.\n"))
(widget-insert
- "(Whitespaces will be converted to ',' (i.e. AND). Use '/' for OR.)\n\n")
+ "Whitespace will be converted to ',' (i.e. AND). Use '/' for OR.\n\n")
(setq mairix-widgets (mairix-widget-build-editable-fields values))
(when (member 'flags mairix-widget-other)
(widget-insert "\nFlags:\n Seen: ")
@@ -935,7 +941,7 @@ Use cursor keys or C-n,C-p to select next/previous search.\n\n")
(lambda (field)
(list (car (cddr field))
(if (car field)
- (mairix-replace-illegal-chars
+ (mairix-replace-invalid-chars
(funcall get-mail-header (car field)))
nil))))
mairix-widget-fields-list)))
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index d75b36051f0..7fa8bdfbf70 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -1,6 +1,6 @@
;;; net-utils.el --- network functions
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Sun Mar 16 1997
diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el
index 80836b03978..b01b8697825 100644
--- a/lisp/net/netrc.el
+++ b/lisp/net/netrc.el
@@ -1,5 +1,5 @@
;;; netrc.el --- .netrc parsing functionality
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -39,6 +39,7 @@
(defcustom netrc-file "~/.authinfo"
"File where user credentials are stored."
+ :version "24.1"
:type 'file
:group 'netrc)
@@ -214,26 +215,6 @@ MODE can be \"login\" or \"password\", suitable for passing to
(eq type (car (cddr service)))))))
(car service)))
-(defun netrc-find-service-number (name &optional type)
- (let ((services (netrc-parse-services))
- service)
- (setq type (or type 'tcp))
- (while (and (setq service (pop services))
- (not (and (string= name (car service))
- (eq type (car (cddr service)))))))
- (cadr service)))
-
-(defun netrc-store-data (file host port user password)
- (with-temp-buffer
- (when (file-exists-p file)
- (insert-file-contents file))
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (insert (format "machine %s login %s password %s port %s\n"
- host user password port))
- (write-region (point-min) (point-max) file nil 'silent)))
-
;;;###autoload
(defun netrc-credentials (machine &rest ports)
"Return a user name/password pair.
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 9c07953c9c9..81d05eabc5a 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -1,6 +1,6 @@
;;; network-stream.el --- open network processes, possibly with encryption
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network
@@ -125,9 +125,8 @@ values:
certificate. This parameter will only be used when doing TLS
or STARTTLS connections.
-If :use-starttls-if-possible is non-nil, do opportunistic
-STARTTLS upgrades even if Emacs doesn't have built-in TLS
-functionality.
+:use-starttls-if-possible is a boolean that says to do opportunistic
+STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality.
:nowait is a boolean that says the connection should be made
asynchronously, if possible."
@@ -299,13 +298,19 @@ functionality.
;; support, or no gnutls-cli installed.
(eq resulting-type 'plain))
(setq error
- (if starttls-available
+ (if (or (null starttls-command)
+ starttls-available)
"Server does not support TLS"
- (concat "Emacs does not support TLS, and no external `"
- (if starttls-use-gnutls
- starttls-gnutls-program
- starttls-program)
- "' program was found")))
+ ;; See `starttls-available-p'. If this predicate
+ ;; changes to allow running under Windows, the error
+ ;; message below should be amended.
+ (if (memq system-type '(windows-nt ms-dos))
+ (concat "Emacs does not support TLS")
+ (concat "Emacs does not support TLS, and no external `"
+ (if starttls-use-gnutls
+ starttls-gnutls-program
+ starttls-program)
+ "' program was found"))))
(delete-process stream)
(setq stream nil))
;; Return value:
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index fca36c70f2d..bc6fd38f713 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -1,6 +1,6 @@
;;; newst-backend.el --- Retrieval backend for newsticker.
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: 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-plainview.el b/lisp/net/newst-plainview.el
index f1b3ce7fd05..5597e0a6ddc 100644
--- a/lisp/net/newst-plainview.el
+++ b/lisp/net/newst-plainview.el
@@ -1,6 +1,6 @@
;;; newst-plainview.el --- Single buffer frontend for newsticker.
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-plainview.el
@@ -155,61 +155,39 @@ The following printf-like specifiers can be used:
;; ======================================================================
;; faces
-(defface newsticker-new-item-face
- '((((class color) (background dark))
- (:family "sans" :bold t))
- (((class color) (background light))
- (:family "sans" :bold t)))
+(defface newsticker-new-item-face '((t :weight bold))
"Face for new news items."
:group 'newsticker-faces)
(defface newsticker-old-item-face
- '((((class color) (background dark))
- (:family "sans" :bold t :foreground "orange3"))
- (((class color) (background light))
- (:family "sans" :bold t :foreground "red4")))
+ '((default :weight bold)
+ (((class color) (background dark)) :foreground "orange3")
+ (((class color) (background light)) :foreground "red4"))
"Face for old news items."
:group 'newsticker-faces)
(defface newsticker-immortal-item-face
- '((((class color) (background dark))
- (:family "sans" :bold t :italic t :foreground "orange"))
- (((class color) (background light))
- (:family "sans" :bold t :italic t :foreground "blue")))
+ '((default :weight bold :slant italic)
+ (((class color) (background dark)) :foreground "orange")
+ (((class color) (background light)) :foreground "blue"))
"Face for immortal news items."
:group 'newsticker-faces)
(defface newsticker-obsolete-item-face
- '((((class color) (background dark))
- (:family "sans" :bold t :strike-through t))
- (((class color) (background light))
- (:family "sans" :bold t :strike-through t)))
+ '((t :weight bold :strike-through t))
"Face for old news items."
:group 'newsticker-faces)
-(defface newsticker-date-face
- '((((class color) (background dark))
- (:family "sans" :italic t :height 0.8))
- (((class color) (background light))
- (:family "sans" :italic t :height 0.8)))
+(defface newsticker-date-face '((t :slant italic :height 0.8))
"Face for newsticker dates."
:group 'newsticker-faces)
-(defface newsticker-statistics-face
- '((((class color) (background dark))
- (:family "sans" :italic t :height 0.8))
- (((class color) (background light))
- (:family "sans" :italic t :height 0.8)))
+(defface newsticker-statistics-face '((t :slant italic :height 0.8))
"Face for newsticker dates."
:group 'newsticker-faces)
-(defface newsticker-default-face
- '((((class color) (background dark))
- (:inherit default))
- (((class color) (background light))
- (:inherit default)))
+(defface newsticker-default-face '((t))
"Face for the description of news items."
- ;;:set 'newsticker--set-customvar
:group 'newsticker-faces)
(defcustom newsticker-hide-old-items-in-newsticker-buffer
diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el
index f9975c45fb3..40da787cb19 100644
--- a/lisp/net/newst-reader.el
+++ b/lisp/net/newst-reader.el
@@ -1,6 +1,6 @@
;;; newst-reader.el --- Generic RSS reader functions.
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-reader.el
@@ -129,26 +129,23 @@ See `format-time-string' for a list of valid specifiers."
:group 'newsticker-reader)
(defface newsticker-feed-face
- '((((class color) (background dark))
- (:family "sans" :bold t :height 1.2 :foreground "white"))
- (((class color) (background light))
- (:family "sans" :bold t :height 1.2 :foreground "black")))
+ '((default :weight bold :height 1.2)
+ (((class color) (background dark)) :foreground "white")
+ (((class color) (background light)) :foreground "black"))
"Face for news feeds."
:group 'newsticker-faces)
(defface newsticker-extra-face
- '((((class color) (background dark))
- (:italic t :foreground "gray50" :height 0.8))
- (((class color) (background light))
- (:italic t :foreground "gray50" :height 0.8)))
+ '((default :slant italic :height 0.8)
+ (((class color) (background dark)) :foreground "gray50")
+ (((class color) (background light)) :foreground "gray50"))
"Face for newsticker dates."
:group 'newsticker-faces)
(defface newsticker-enclosure-face
- '((((class color) (background dark))
- (:bold t :background "orange"))
- (((class color) (background light))
- (:bold t :background "orange")))
+ '((default :weight bold)
+ (((class color) (background dark)) :background "orange")
+ (((class color) (background light)) :background "orange"))
"Face for enclosed elements."
:group 'newsticker-faces)
diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el
index cb82bb74048..4b5ac3143d3 100644
--- a/lisp/net/newst-ticker.el
+++ b/lisp/net/newst-ticker.el
@@ -1,6 +1,6 @@
-;; newst-ticker.el --- modeline ticker for newsticker.
+;; newst-ticker.el --- mode line ticker for newsticker.
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-ticker.el
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index 8ff74a94eb0..0bc7d6ad6ea 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -1,6 +1,6 @@
;;; newst-treeview.el --- Treeview frontend for newsticker.
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-treeview.el
@@ -50,50 +50,36 @@
:group 'newsticker-reader)
(defface newsticker-treeview-face
- '((((class color) (background dark))
- (:family "sans" :foreground "white" :bold nil))
- (((class color) (background light))
- (:family "sans" :foreground "black" :bold nil)))
+ '((((class color) (background dark)) :foreground "white")
+ (((class color) (background light)) :foreground "black"))
"Face for newsticker tree."
:group 'newsticker-treeview)
(defface newsticker-treeview-new-face
- '((((class color) (background dark))
- (:inherit newsticker-treeview-face :bold t))
- (((class color) (background light))
- (:inherit newsticker-treeview-face :bold t)))
+ '((t :inherit newsticker-treeview-face :weight bold))
"Face for newsticker tree."
:group 'newsticker-treeview)
(defface newsticker-treeview-old-face
- '((((class color) (background dark))
- (:inherit newsticker-treeview-face))
- (((class color) (background light))
- (:inherit newsticker-treeview-face)))
+ '((t :inherit newsticker-treeview-face))
"Face for newsticker tree."
:group 'newsticker-treeview)
(defface newsticker-treeview-immortal-face
- '((((class color) (background dark))
- (:inherit newsticker-treeview-face :foreground "orange" :italic t))
- (((class color) (background light))
- (:inherit newsticker-treeview-face :foreground "blue" :italic t)))
+ '((default :inherit newsticker-treeview-face :slant italic)
+ (((class color) (background dark)) :foreground "orange")
+ (((class color) (background light)) :foreground "blue"))
"Face for newsticker tree."
:group 'newsticker-treeview)
(defface newsticker-treeview-obsolete-face
- '((((class color) (background dark))
- (:inherit newsticker-treeview-face :strike-through t))
- (((class color) (background light))
- (:inherit newsticker-treeview-face :strike-through t)))
+ '((t :inherit newsticker-treeview-face :strike-through t))
"Face for newsticker tree."
:group 'newsticker-treeview)
(defface newsticker-treeview-selection-face
- '((((class color) (background dark))
- (:background "#bbbbff"))
- (((class color) (background light))
- (:background "#bbbbff")))
+ '((((class color) (background dark)) :background "#bbbbff")
+ (((class color) (background light)) :background "#bbbbff"))
"Face for newsticker selection."
:group 'newsticker-treeview)
@@ -142,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
@@ -1736,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/newsticker.el b/lisp/net/newsticker.el
index 0a1e07e63f1..91eca84ce53 100644
--- a/lisp/net/newsticker.el
+++ b/lisp/net/newsticker.el
@@ -1,6 +1,6 @@
;;; newsticker.el --- A Newsticker for Emacs.
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newsticker.el
@@ -87,7 +87,7 @@
;; If you are using Newsticker as part of GNU Emacs there is no need to
;; perform any installation steps in order to use Newsticker. Otherwise
;; place Newsticker in a directory where Emacs can find it. Add the
-;; following line to your Emacs startup file (`~/.emacs').
+;; following line to your init file:
;; (add-to-list 'load-path "/path/to/newsticker/")
;; (autoload 'newsticker-start "newsticker" "Emacs Newsticker" t)
;; (autoload 'newsticker-show-news "newsticker" "Emacs Newsticker" t)
@@ -103,7 +103,7 @@
;; -----
;; The command newsticker-show-news will display all available headlines in
;; a special buffer, called `*newsticker*'. It will also start the
-;; asynchronous download of headlines. The modeline in the `*newsticker*'
+;; asynchronous download of headlines. The mode line in the `*newsticker*'
;; buffer informs whenever new headlines have arrived. Clicking
;; mouse-button 2 or pressing RET in this buffer on a headline will call
;; browse-url to load the corresponding news story in your favorite web
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index 8bcb1ef2966..9626aef558d 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -1,6 +1,6 @@
;;; ntlm.el --- NTLM (NT LanManager) authentication support
-;; Copyright (C) 2001, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2007-2012 Free Software Foundation, Inc.
;; Author: Taro Kawagishi <tarok@transpulse.org>
;; Keywords: NTLM, SASL
diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el
index a31ec496c16..f7d41fcd97a 100644
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -1,6 +1,6 @@
;;; quickurl.el --- insert a URL based on text at point in buffer
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Dave Pearson <davep@davep.org>
;; Maintainer: Dave Pearson <davep@davep.org>
@@ -81,8 +81,7 @@
;; Things we need:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'thingatpt)
(require 'pp)
(require 'browse-url)
@@ -96,12 +95,12 @@
:prefix "quickurl-")
(defcustom quickurl-url-file (convert-standard-filename "~/.quickurls")
- "*File that contains the URL list."
+ "File that contains the URL list."
:type 'file
:group 'quickurl)
(defcustom quickurl-format-function (lambda (url) (format "<URL:%s>" (quickurl-url-url url)))
- "*Function to format the URL before insertion into the current buffer."
+ "Function to format the URL before insertion into the current buffer."
:type 'function
:group 'quickurl)
@@ -111,32 +110,32 @@
(string<
(downcase (quickurl-url-description x))
(downcase (quickurl-url-description y))))))
- "*Function to sort the URL list."
+ "Function to sort the URL list."
:type 'function
:group 'quickurl)
(defcustom quickurl-grab-lookup-function #'current-word
- "*Function to grab the thing to lookup."
+ "Function to grab the thing to lookup."
:type 'function
:group 'quickurl)
(defcustom quickurl-assoc-function #'assoc-ignore-case
- "*Function to use for alist lookup into `quickurl-urls'."
+ "Function to use for alist lookup into `quickurl-urls'."
:type 'function
:group 'quickurl)
(defcustom quickurl-completion-ignore-case t
- "*Should `quickurl-ask' ignore case when doing the input lookup?"
+ "Should `quickurl-ask' ignore case when doing the input lookup?"
:type 'boolean
:group 'quickurl)
(defcustom quickurl-prefix ";; -*- lisp -*-\n\n"
- "*Text to write to `quickurl-url-file' before writing the URL list."
+ "Text to write to `quickurl-url-file' before writing the URL list."
:type 'string
:group 'quickurl)
(defcustom quickurl-postfix ""
- "*Text to write to `quickurl-url-file' after writing the URL list.
+ "Text to write to `quickurl-url-file' after writing the URL list.
See the constant `quickurl-reread-hook-postfix' for some example text that
could be used here."
@@ -144,7 +143,7 @@ could be used here."
:group 'quickurl)
(defcustom quickurl-list-mode-hook nil
- "*Hooks for `quickurl-list-mode'."
+ "Hooks for `quickurl-list-mode'."
:type 'hook
:group 'quickurl)
@@ -165,7 +164,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).")
;; Non-customize variables.
@@ -206,47 +205,40 @@ in your ~/.emacs (after loading/requiring quickurl).")
(list keyword url comment)
(cons keyword url)))
-(defun quickurl-url-keyword (url)
+(defalias 'quickurl-url-keyword #'car
"Return the keyword for the URL.
-
-Note that this function is a setfable place."
- (car url))
-
-(defsetf quickurl-url-keyword (url) (store)
- `(setf (car ,url) ,store))
+\n\(fn URL)")
(defun quickurl-url-url (url)
"Return the actual URL of the URL.
Note that this function is a setfable place."
+ (declare (gv-setter (lambda (store)
+ `(setf (if (quickurl-url-commented-p ,url)
+ (cadr ,url)
+ (cdr ,url))
+ ,store))))
(if (quickurl-url-commented-p url)
(cadr url)
(cdr url)))
-(defsetf quickurl-url-url (url) (store)
- `
- (if (quickurl-url-commented-p ,url)
- (setf (cadr ,url) ,store)
- (setf (cdr ,url) ,store)))
-
(defun quickurl-url-comment (url)
"Get the comment from a URL.
If the URL has no comment an empty string is returned. Also note that this
function is a setfable place."
+ (declare
+ (gv-setter (lambda (store)
+ `(if (quickurl-url-commented-p ,url)
+ (if (zerop (length ,store))
+ (setf (cdr ,url) (cadr ,url))
+ (setf (nth 2 ,url) ,store))
+ (unless (zerop (length ,store))
+ (setf (cdr ,url) (list (cdr ,url) ,store)))))))
(if (quickurl-url-commented-p url)
(nth 2 url)
""))
-(defsetf quickurl-url-comment (url) (store)
- `
- (if (quickurl-url-commented-p ,url)
- (if (zerop (length ,store))
- (setf (cdr ,url) (cadr ,url))
- (setf (nth 2 ,url) ,store))
- (unless (zerop (length ,store))
- (setf (cdr ,url) (list (cdr ,url) ,store)))))
-
(defun quickurl-url-description (url)
"Return a description for the URL.
@@ -259,14 +251,14 @@ returned."
;; Main code:
-(defun* quickurl-read (&optional buffer)
+(cl-defun quickurl-read (&optional buffer)
"`read' the URL list from BUFFER into `quickurl-urls'.
BUFFER, if nil, defaults to current buffer.
Note that this function moves point to `point-min' before doing the `read'
It also restores point after the `read'."
(save-excursion
- (setf (point) (point-min))
+ (goto-char (point-min))
(setq quickurl-urls (funcall quickurl-sort-function
(read (or buffer (current-buffer)))))))
@@ -303,7 +295,7 @@ Also display a `message' saying what the URL was unless SILENT is non-nil."
(message "Found %s" (quickurl-url-url url))))
;;;###autoload
-(defun* quickurl (&optional lookup)
+(cl-defun quickurl (&optional lookup)
"Insert a URL based on LOOKUP.
If not supplied LOOKUP is taken to be the word at point in the current
@@ -464,20 +456,21 @@ The key bindings for `quickurl-list-mode' are:
(defun quickurl-list-populate-buffer ()
"Populate the `quickurl-list' buffer."
(with-current-buffer (get-buffer quickurl-list-buffer-name)
- (let ((buffer-read-only nil)
- (fmt (format "%%-%ds %%s\n"
- (apply #'max (or (loop for url in quickurl-urls
- collect (length (quickurl-url-description url)))
- (list 20))))))
- (setf (buffer-string) "")
- (loop for url in quickurl-urls
- do (let ((start (point)))
- (insert (format fmt (quickurl-url-description url)
- (quickurl-url-url url)))
- (add-text-properties start (1- (point))
- '(mouse-face highlight
- help-echo "mouse-2: insert this URL"))))
- (setf (point) (point-min)))))
+ (let* ((sizes (or (cl-loop for url in quickurl-urls
+ collect (length (quickurl-url-description url)))
+ (list 20)))
+ (fmt (format "%%-%ds %%s\n" (apply #'max sizes)))
+ (inhibit-read-only t))
+ (erase-buffer)
+ (cl-loop for url in quickurl-urls
+ do (let ((start (point)))
+ (insert (format fmt (quickurl-url-description url)
+ (quickurl-url-url url)))
+ (add-text-properties
+ start (1- (point))
+ '(mouse-face highlight
+ help-echo "mouse-2: insert this URL"))))
+ (goto-char (point-min)))))
(defun quickurl-list-add-url (word url comment)
"Wrapper for `quickurl-add-url' that doesn't guess the parameters."
@@ -494,7 +487,7 @@ The key bindings for `quickurl-list-mode' are:
(defun quickurl-list-mouse-select (event)
"Select the URL under the mouse click."
(interactive "e")
- (setf (point) (posn-point (event-end event)))
+ (goto-char (posn-point (event-end event)))
(quickurl-list-insert-url))
(defun quickurl-list-insert (type)
@@ -510,16 +503,16 @@ TYPE dictates what will be inserted, options are:
(if url
(with-current-buffer quickurl-list-last-buffer
(insert
- (case type
- (url (funcall quickurl-format-function url))
- (naked-url (quickurl-url-url url))
- (with-lookup (format "%s <URL:%s>"
+ (pcase type
+ (`url (funcall quickurl-format-function url))
+ (`naked-url (quickurl-url-url url))
+ (`with-lookup (format "%s <URL:%s>"
(quickurl-url-keyword url)
(quickurl-url-url url)))
- (with-desc (format "%S <URL:%s>"
+ (`with-desc (format "%S <URL:%s>"
(quickurl-url-description url)
(quickurl-url-url url)))
- (lookup (quickurl-url-keyword url)))))
+ (`lookup (quickurl-url-keyword url)))))
(error "No URL details on that line"))
url))
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 7d069a0f306..e9828c5f813 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1,6 +1,6 @@
;;; rcirc.el --- default, simple IRC client.
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;; Author: Ryan Yeske <rcyeske@gmail.com>
;; Maintainers: Ryan Yeske <rcyeske@gmail.com>,
@@ -30,7 +30,7 @@
;; one-to-one communication.
;; Rcirc has simple defaults and clear and consistent behavior.
-;; Message arrival timestamps, activity notification on the modeline,
+;; Message arrival timestamps, activity notification on the mode line,
;; message filling, nick completion, and keepalive pings are all
;; enabled by default, but can easily be adjusted or turned off. Each
;; discussion takes place in its own buffer and there is a single
@@ -139,12 +139,12 @@ for connections using SSL/TLS."
:group 'rcirc)
(defcustom rcirc-fill-flag t
- "*Non-nil means line-wrap messages printed in channel buffers."
+ "Non-nil means line-wrap messages printed in channel buffers."
:type 'boolean
:group 'rcirc)
(defcustom rcirc-fill-column nil
- "*Column beyond which automatic line-wrapping should happen.
+ "Column beyond which automatic line-wrapping should happen.
If nil, use value of `fill-column'. If 'frame-width, use the
maximum frame width."
:type '(choice (const :tag "Value of `fill-column'")
@@ -153,7 +153,7 @@ maximum frame width."
:group 'rcirc)
(defcustom rcirc-fill-prefix nil
- "*Text to insert before filled lines.
+ "Text to insert before filled lines.
If nil, calculate the prefix dynamically to line up text
underneath each nick."
:type '(choice (const :tag "Dynamic" nil)
@@ -174,23 +174,23 @@ Use the command `rcirc-omit-mode' to change this variable.")
(make-variable-buffer-local 'rcirc-omit-mode)
(defcustom rcirc-time-format "%H:%M "
- "*Describes how timestamps are printed.
+ "Describes how timestamps are printed.
Used as the first arg to `format-time-string'."
:type 'string
:group 'rcirc)
(defcustom rcirc-input-ring-size 1024
- "*Size of input history ring."
+ "Size of input history ring."
:type 'integer
:group 'rcirc)
(defcustom rcirc-read-only-flag t
- "*Non-nil means make text in IRC buffers read-only."
+ "Non-nil means make text in IRC buffers read-only."
:type 'boolean
:group 'rcirc)
(defcustom rcirc-buffer-maximum-lines nil
- "*The maximum size in lines for rcirc buffers.
+ "The maximum size in lines for rcirc buffers.
Channel buffers are truncated from the top to be no greater than this
number. If zero or nil, no truncating is done."
:type '(choice (const :tag "No truncation" nil)
@@ -198,7 +198,7 @@ number. If zero or nil, no truncating is done."
:group 'rcirc)
(defcustom rcirc-scroll-show-maximum-output t
- "*If non-nil, scroll buffer to keep the point at the bottom of
+ "If non-nil, scroll buffer to keep the point at the bottom of
the window."
:type 'boolean
:group 'rcirc)
@@ -244,13 +244,13 @@ Examples:
:group 'rcirc)
(defcustom rcirc-auto-authenticate-flag t
- "*Non-nil means automatically send authentication string to server.
+ "Non-nil means automatically send authentication string to server.
See also `rcirc-authinfo'."
:type 'boolean
:group 'rcirc)
(defcustom rcirc-authenticate-before-join t
- "*Non-nil means authenticate to services before joining channels.
+ "Non-nil means authenticate to services before joining channels.
Currently only works with NickServ on some networks."
:version "24.1"
:type 'boolean
@@ -300,7 +300,9 @@ See `rcirc-dim-nick' face."
:type '(repeat string)
:group 'rcirc)
-(defcustom rcirc-print-hooks nil
+(define-obsolete-variable-alias 'rcirc-print-hooks
+ 'rcirc-print-functions "24.3")
+(defcustom rcirc-print-functions nil
"Hook run after text is printed.
Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
:type 'hook
@@ -361,6 +363,14 @@ of a line. The string is passed as the first argument to
:type 'string
:group 'rcirc)
+(defcustom rcirc-kill-channel-buffers nil
+ "When non-nil, kill channel buffers when the server buffer is killed.
+Only the channel buffers associated with the server in question
+will be killed."
+ :version "24.3"
+ :type 'boolean
+ :group 'rcirc)
+
(defvar rcirc-nick nil)
(defvar rcirc-prompt-start-marker nil)
@@ -386,7 +396,7 @@ of a line. The string is passed as the first argument to
"List of buffers with unviewed activity.")
(defvar rcirc-activity-string ""
- "String displayed in modeline representing `rcirc-activity'.")
+ "String displayed in mode line representing `rcirc-activity'.")
(put 'rcirc-activity-string 'risky-local-variable t)
(defvar rcirc-server-buffer nil
@@ -471,7 +481,8 @@ If ARG is non-nil, instead prompt for connection parameters."
rcirc-default-full-name))
(channels (plist-get (cdr c) :channels))
(password (plist-get (cdr c) :password))
- (encryption (plist-get (cdr c) :encryption)))
+ (encryption (plist-get (cdr c) :encryption))
+ contact)
(when server
(let (connected)
(dolist (p (rcirc-process-list))
@@ -483,10 +494,11 @@ If ARG is non-nil, instead prompt for connection parameters."
full-name channels password encryption)
(quit (message "Quit connecting to %s" server)))
(with-current-buffer (process-buffer connected)
- (setq connected-servers
- (cons (process-contact (get-buffer-process
- (current-buffer)) :host)
- connected-servers))))))))
+ (setq contact (process-contact
+ (get-buffer-process (current-buffer)) :host))
+ (setq connected-servers
+ (cons (if (stringp contact) contact server)
+ connected-servers))))))))
(when connected-servers
(message "Already connected to %s"
(if (cdr connected-servers)
@@ -637,7 +649,9 @@ is non-nil."
"] "
text)))))
-(defvar rcirc-sentinel-hooks nil
+(define-obsolete-variable-alias 'rcirc-sentinel-hooks
+ 'rcirc-sentinel-functions "24.3")
+(defvar rcirc-sentinel-functions nil
"Hook functions called when the process sentinel is called.
Functions are called with PROCESS and SENTINEL arguments.")
@@ -654,7 +668,7 @@ Functions are called with PROCESS and SENTINEL arguments.")
sentinel
(process-status process)) (not rcirc-target))
(rcirc-disconnect-buffer)))
- (run-hook-with-args 'rcirc-sentinel-hooks process sentinel))))
+ (run-hook-with-args 'rcirc-sentinel-functions process sentinel))))
(defun rcirc-disconnect-buffer (&optional buffer)
(with-current-buffer (or buffer (current-buffer))
@@ -674,7 +688,9 @@ Functions are called with PROCESS and SENTINEL arguments.")
(process-list))
ps))
-(defvar rcirc-receive-message-hooks nil
+(define-obsolete-variable-alias 'rcirc-receive-message-hooks
+ 'rcirc-receive-message-functions "24.3")
+(defvar rcirc-receive-message-functions nil
"Hook functions run when a message is received from server.
Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(defun rcirc-filter (process output)
@@ -728,7 +744,7 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(if (not (fboundp handler))
(rcirc-handler-generic process cmd sender args text)
(funcall handler process sender args text))
- (run-hook-with-args 'rcirc-receive-message-hooks
+ (run-hook-with-args 'rcirc-receive-message-functions
process cmd sender args text)))
(message "UNHANDLED: %s" text)))
@@ -792,26 +808,36 @@ With no argument or nil as argument, use the current buffer."
(defvar rcirc-max-message-length 420
"Messages longer than this value will be split.")
+(defun rcirc-split-message (message)
+ "Split MESSAGE into chunks within `rcirc-max-message-length'."
+ ;; `rcirc-encode-coding-system' can have buffer-local value.
+ (let ((encoding rcirc-encode-coding-system))
+ (with-temp-buffer
+ (insert message)
+ (goto-char (point-min))
+ (let (result)
+ (while (not (eobp))
+ (goto-char (or (byte-to-position rcirc-max-message-length)
+ (point-max)))
+ ;; max message length is 512 including CRLF
+ (while (and (not (bobp))
+ (> (length (encode-coding-region
+ (point-min) (point) encoding t))
+ rcirc-max-message-length))
+ (forward-char -1))
+ (push (delete-and-extract-region (point-min) (point)) result))
+ (nreverse result)))))
+
(defun rcirc-send-message (process target message &optional noticep silent)
"Send TARGET associated with PROCESS a privmsg with text MESSAGE.
If NOTICEP is non-nil, send a notice instead of privmsg.
If SILENT is non-nil, do not print the message in any irc buffer."
- ;; max message length is 512 including CRLF
- (let* ((response (if noticep "NOTICE" "PRIVMSG"))
- (oversize (> (length message) rcirc-max-message-length))
- (text (if oversize
- (substring message 0 rcirc-max-message-length)
- message))
- (text (if (string= text "")
- " "
- text))
- (more (if oversize
- (substring message rcirc-max-message-length))))
+ (let ((response (if noticep "NOTICE" "PRIVMSG")))
(rcirc-get-buffer-create process target)
- (rcirc-send-string process (concat response " " target " :" text))
- (unless silent
- (rcirc-print process (rcirc-nick process) response target text))
- (when more (rcirc-send-message process target more noticep))))
+ (dolist (msg (rcirc-split-message message))
+ (rcirc-send-string process (concat response " " target " :" msg))
+ (unless silent
+ (rcirc-print process (rcirc-nick process) response target msg)))))
(defvar rcirc-input-ring nil)
(defvar rcirc-input-ring-index 0)
@@ -1088,12 +1114,20 @@ Logfiles are kept in `rcirc-log-directory'."
:group 'rcirc)
(defun rcirc-kill-buffer-hook ()
- "Part the channel when killing an rcirc buffer."
+ "Part the channel when killing an rcirc buffer.
+
+If `rcirc-kill-channel-buffers' is non-nil and the killed buffer
+is a server buffer, kills all of the channel buffers associated
+with it."
(when (eq major-mode 'rcirc-mode)
(when (and rcirc-log-flag
rcirc-log-directory)
(rcirc-log-write))
- (rcirc-clean-up-buffer "Killed buffer")))
+ (rcirc-clean-up-buffer "Killed buffer")
+ (when (and rcirc-buffer-alist ;; it's a server buffer
+ rcirc-kill-channel-buffers)
+ (dolist (channel rcirc-buffer-alist)
+ (kill-buffer (cdr channel))))))
(defun rcirc-change-major-mode-hook ()
"Part the channel when changing the major-mode."
@@ -1261,7 +1295,10 @@ Create the buffer if it doesn't exist."
"Keymap for multiline mode in rcirc.")
(define-minor-mode rcirc-multiline-minor-mode
- "Minor mode for editing multiple lines in rcirc."
+ "Minor mode for editing multiple lines in rcirc.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
:init-value nil
:lighter " rcirc-mline"
:keymap rcirc-multiline-minor-mode-map
@@ -1578,7 +1615,7 @@ record activity."
(buffer-disable-undo)
(buffer-enable-undo))
- ;; record modeline activity
+ ;; record mode line activity
(when (and activity
(not rcirc-ignore-buffer-activity-flag)
(not (and rcirc-dim-nicks sender
@@ -1594,7 +1631,7 @@ record activity."
(rcirc-log process sender response target text))
(sit-for 0) ; displayed text before hook
- (run-hook-with-args 'rcirc-print-hooks
+ (run-hook-with-args 'rcirc-print-functions
process sender response target text)))))
(defun rcirc-generate-log-filename (process target)
@@ -1779,7 +1816,10 @@ This function does not alter the INPUT string."
;;;###autoload
(define-minor-mode rcirc-track-minor-mode
- "Global minor mode for tracking activity in rcirc buffers."
+ "Global minor mode for tracking activity in rcirc buffers.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
:init-value nil
:lighter ""
:keymap rcirc-track-minor-mode-map
@@ -1893,7 +1933,9 @@ With prefix ARG, go to the next low priority buffer with activity."
(key-description (this-command-keys))
" for low priority activity."))))))))
-(defvar rcirc-activity-hooks nil
+(define-obsolete-variable-alias 'rcirc-activity-hooks
+ 'rcirc-activity-functions "24.3")
+(defvar rcirc-activity-functions nil
"Hook to be run when there is channel activity.
Functions are called with a single argument, the buffer with the
@@ -1916,7 +1958,7 @@ activity. Only run if the buffer is not visible and
(unless (and (equal rcirc-activity old-activity)
(member type old-types))
(rcirc-update-activity-string)))))
- (run-hook-with-args 'rcirc-activity-hooks buffer))
+ (run-hook-with-args 'rcirc-activity-functions buffer))
(defun rcirc-clear-activity (buffer)
"Clear the BUFFER activity."
@@ -1979,7 +2021,7 @@ activity. Only run if the buffer is not visible and
buffers ","))
(defun rcirc-short-buffer-name (buffer)
- "Return a short name for BUFFER to use in the modeline indicator."
+ "Return a short name for BUFFER to use in the mode line indicator."
(with-current-buffer buffer
(or rcirc-short-buffer-name (buffer-name))))
@@ -2378,6 +2420,7 @@ keywords when no KEYWORD is given."
(delete-region (match-beginning 1) (match-end 1))
(goto-char (match-beginning 1)))
;; remove the ^O characters now
+ (goto-char (point-min))
(while (re-search-forward "\C-o+" nil t)
(delete-region (match-beginning 0) (match-end 0))))
@@ -2861,67 +2904,65 @@ Passwords are stored in `rcirc-authinfo' (which see)."
:group 'faces)
(defface rcirc-my-nick ; font-lock-function-name-face
- '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
- (t (:inverse-video t :weight bold)))
- "The face used to highlight my messages."
+ '((((class color) (min-colors 88) (background light)) :foreground "Blue1")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue")
+ (((class color) (min-colors 16) (background light)) :foreground "Blue")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightSkyBlue")
+ (((class color) (min-colors 8)) :foreground "blue" :weight bold)
+ (t :inverse-video t :weight bold))
+ "Rcirc face for my messages."
:group 'rcirc-faces)
(defface rcirc-other-nick ; font-lock-variable-name-face
'((((class grayscale) (background light))
- (:foreground "Gray90" :weight bold :slant italic))
+ :foreground "Gray90" :weight bold :slant italic)
(((class grayscale) (background dark))
- (:foreground "DimGray" :weight bold :slant italic))
- (((class color) (min-colors 88) (background light)) (:foreground "DarkGoldenrod"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod"))
- (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
- (((class color) (min-colors 8)) (:foreground "yellow" :weight light))
- (t (:weight bold :slant italic)))
- "The face used to highlight other messages."
+ :foreground "DimGray" :weight bold :slant italic)
+ (((class color) (min-colors 88) (background light)) :foreground "DarkGoldenrod")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightGoldenrod")
+ (((class color) (min-colors 16) (background light)) :foreground "DarkGoldenrod")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightGoldenrod")
+ (((class color) (min-colors 8)) :foreground "yellow" :weight light)
+ (t :weight bold :slant italic))
+ "Rcirc face for other users' messages."
:group 'rcirc-faces)
(defface rcirc-bright-nick
'((((class grayscale) (background light))
- (:foreground "LightGray" :weight bold :underline t))
+ :foreground "LightGray" :weight bold :underline t)
(((class grayscale) (background dark))
- (:foreground "Gray50" :weight bold :underline t))
- (((class color) (min-colors 88) (background light)) (:foreground "CadetBlue"))
- (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine"))
- (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
- (((class color) (min-colors 8)) (:foreground "magenta"))
- (t (:weight bold :underline t)))
- "Face used for nicks matched by `rcirc-bright-nicks'."
+ :foreground "Gray50" :weight bold :underline t)
+ (((class color) (min-colors 88) (background light)) :foreground "CadetBlue")
+ (((class color) (min-colors 88) (background dark)) :foreground "Aquamarine")
+ (((class color) (min-colors 16) (background light)) :foreground "CadetBlue")
+ (((class color) (min-colors 16) (background dark)) :foreground "Aquamarine")
+ (((class color) (min-colors 8)) :foreground "magenta")
+ (t :weight bold :underline t))
+ "Rcirc face for nicks matched by `rcirc-bright-nicks'."
:group 'rcirc-faces)
(defface rcirc-dim-nick
'((t :inherit default))
- "Face used for nicks in `rcirc-dim-nicks'."
+ "Rcirc face for nicks in `rcirc-dim-nicks'."
:group 'rcirc-faces)
(defface rcirc-server ; font-lock-comment-face
'((((class grayscale) (background light))
- (:foreground "DimGray" :weight bold :slant italic))
+ :foreground "DimGray" :weight bold :slant italic)
(((class grayscale) (background dark))
- (:foreground "LightGray" :weight bold :slant italic))
+ :foreground "LightGray" :weight bold :slant italic)
(((class color) (min-colors 88) (background light))
- (:foreground "Firebrick"))
+ :foreground "Firebrick")
(((class color) (min-colors 88) (background dark))
- (:foreground "chocolate1"))
+ :foreground "chocolate1")
(((class color) (min-colors 16) (background light))
- (:foreground "red"))
+ :foreground "red")
(((class color) (min-colors 16) (background dark))
- (:foreground "red1"))
- (((class color) (min-colors 8) (background light))
- )
- (((class color) (min-colors 8) (background dark))
- )
- (t (:weight bold :slant italic)))
- "The face used to highlight server messages."
+ :foreground "red1")
+ (((class color) (min-colors 8) (background light)))
+ (((class color) (min-colors 8) (background dark)))
+ (t :weight bold :slant italic))
+ "Rcirc face for server messages."
:group 'rcirc-faces)
(defface rcirc-server-prefix ; font-lock-comment-delimiter-face
@@ -2932,57 +2973,53 @@ Passwords are stored in `rcirc-authinfo' (which see)."
:foreground "red")
(((class color) (min-colors 8) (background dark))
:foreground "red1"))
- "The face used to highlight server prefixes."
+ "Rcirc face for server prefixes."
:group 'rcirc-faces)
(defface rcirc-timestamp
- '((t (:inherit default)))
- "The face used to highlight timestamps."
+ '((t :inherit default))
+ "Rcirc face for timestamps."
:group 'rcirc-faces)
(defface rcirc-nick-in-message ; font-lock-keyword-face
- '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
- (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
- (((class color) (min-colors 88) (background light)) (:foreground "Purple"))
- (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
- (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
- (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
- (((class color) (min-colors 8)) (:foreground "cyan" :weight bold))
- (t (:weight bold)))
- "The face used to highlight instances of your nick within messages."
+ '((((class grayscale) (background light)) :foreground "LightGray" :weight bold)
+ (((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "Purple")
+ (((class color) (min-colors 88) (background dark)) :foreground "Cyan1")
+ (((class color) (min-colors 16) (background light)) :foreground "Purple")
+ (((class color) (min-colors 16) (background dark)) :foreground "Cyan")
+ (((class color) (min-colors 8)) :foreground "cyan" :weight bold)
+ (t :weight bold))
+ "Rcirc face for instances of your nick within messages."
:group 'rcirc-faces)
-(defface rcirc-nick-in-message-full-line
- '((t (:bold t)))
- "The face used emphasize the entire message when your nick is mentioned."
+(defface rcirc-nick-in-message-full-line '((t :weight bold))
+ "Rcirc face for emphasizing the entire message when your nick is mentioned."
:group 'rcirc-faces)
(defface rcirc-prompt ; comint-highlight-prompt
- '((((min-colors 88) (background dark)) (:foreground "cyan1"))
- (((background dark)) (:foreground "cyan"))
- (t (:foreground "dark blue")))
- "The face used to highlight prompts."
+ '((((min-colors 88) (background dark)) :foreground "cyan1")
+ (((background dark)) :foreground "cyan")
+ (t :foreground "dark blue"))
+ "Rcirc face for prompts."
:group 'rcirc-faces)
(defface rcirc-track-nick
- '((((type tty)) (:inherit default))
- (t (:inverse-video t)))
- "The face used in the mode-line when your nick is mentioned."
+ '((((type tty)) :inherit default)
+ (t :inverse-video t))
+ "Rcirc face used in the mode-line when your nick is mentioned."
:group 'rcirc-faces)
-(defface rcirc-track-keyword
- '((t (:bold t )))
- "The face used in the mode-line when keywords are mentioned."
+(defface rcirc-track-keyword '((t :weight bold))
+ "Rcirc face used in the mode-line when keywords are mentioned."
:group 'rcirc-faces)
-(defface rcirc-url
- '((t (:bold t)))
- "The face used to highlight urls."
+(defface rcirc-url '((t :weight bold))
+ "Rcirc face used to highlight urls."
:group 'rcirc-faces)
-(defface rcirc-keyword
- '((t (:inherit highlight)))
- "The face used to highlight keywords."
+(defface rcirc-keyword '((t :inherit highlight))
+ "Rcirc face used to highlight keywords."
:group 'rcirc-faces)
diff --git a/lisp/net/rcompile.el b/lisp/net/rcompile.el
index 82df5b39c95..09677a654c0 100644
--- a/lisp/net/rcompile.el
+++ b/lisp/net/rcompile.el
@@ -1,8 +1,8 @@
;;; rcompile.el --- run a compilation on a remote machine
-;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
-;; Author: Albert <alon@milcse.rtsg.mot.com>
+;; Author: Alon Albert <alon@milcse.rtsg.mot.com>
;; Maintainer: FSF
;; Created: 1993 Oct 6
;; Keywords: tools, processes
diff --git a/lisp/net/rlogin.el b/lisp/net/rlogin.el
index effdcabfb65..cef615dc320 100644
--- a/lisp/net/rlogin.el
+++ b/lisp/net/rlogin.el
@@ -1,6 +1,6 @@
;;; rlogin.el --- remote login interface
-;; Copyright (C) 1992-1995, 1997-1998, 2001-2011
+;; Copyright (C) 1992-1995, 1997-1998, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Noah Friedman
@@ -114,12 +114,12 @@ this variable is set from that."
(let ((map (if (consp shell-mode-map)
(cons 'keymap shell-mode-map)
(copy-keymap shell-mode-map))))
- (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C)
- (define-key rlogin-mode-map "\C-c\C-d" 'rlogin-send-Ctrl-D)
- (define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z)
- (define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash)
- (define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D)
- (define-key rlogin-mode-map "\C-i" 'rlogin-tab-or-complete)
+ (define-key map "\C-c\C-c" 'rlogin-send-Ctrl-C)
+ (define-key map "\C-c\C-d" 'rlogin-send-Ctrl-D)
+ (define-key map "\C-c\C-z" 'rlogin-send-Ctrl-Z)
+ (define-key map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash)
+ (define-key map "\C-d" 'rlogin-delchar-or-send-Ctrl-D)
+ (define-key map "\C-i" 'rlogin-tab-or-complete)
map)
"Keymap for `rlogin-mode'.")
diff --git a/lisp/net/sasl-cram.el b/lisp/net/sasl-cram.el
index 153d2cafe29..dd2a0c3c505 100644
--- a/lisp/net/sasl-cram.el
+++ b/lisp/net/sasl-cram.el
@@ -1,6 +1,6 @@
;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework
-;; Copyright (C) 2000, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2007-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Kenichi OKADA <okada@opaopa.org>
diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el
index 1c7d2f02d10..52a4a226008 100644
--- a/lisp/net/sasl-digest.el
+++ b/lisp/net/sasl-digest.el
@@ -1,6 +1,6 @@
;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework
-;; Copyright (C) 2000, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2007-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Kenichi OKADA <okada@opaopa.org>
diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el
index d8b367ac8ad..312941816c7 100644
--- a/lisp/net/sasl-ntlm.el
+++ b/lisp/net/sasl-ntlm.el
@@ -1,6 +1,6 @@
;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework
-;; Copyright (C) 2000, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2007-2012 Free Software Foundation, Inc.
;; Author: Taro Kawagishi <tarok@transpulse.org>
;; Keywords: SASL, NTLM
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index 2c4da7986e7..4e759a4e6b2 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -1,6 +1,6 @@
;;; sasl.el --- SASL client framework
-;; Copyright (C) 2000, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2007-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: SASL
@@ -183,7 +183,7 @@ It contain at least 64 bits of entropy."
;; Don't use microseconds from (current-time), they may be unsupported.
;; Instead we use this randomly inited counter.
(setq sasl-unique-id-char
- (% (1+ (or sasl-unique-id-char (logand (random t) (1- (lsh 1 20)))))
+ (% (1+ (or sasl-unique-id-char (logand (random) (1- (lsh 1 20)))))
;; (current-time) returns 16-bit ints,
;; and 2^16*25 just fits into 4 digits i base 36.
(* 25 25)))
diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el
index 1a48e8863f1..96b74b2f8e2 100644
--- a/lisp/net/secrets.el
+++ b/lisp/net/secrets.el
@@ -1,6 +1,6 @@
;;; secrets.el --- Client interface to gnome-keyring and kwallet.
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm password passphrase
@@ -78,7 +78,7 @@
;; (secrets-create-collection "my collection")
;; There exists a special collection called "session", which has the
-;; lifetime of the corresponding client session (aka Emacs'
+;; lifetime of the corresponding client session (aka Emacs's
;; lifetime). It is created automatically when Emacs uses the Secret
;; Service interface, and it is deleted when Emacs is killed.
;; Therefore, it can be used to store and retrieve secret items
@@ -99,7 +99,7 @@
;; Secret items can be added or deleted to a collection. In the
;; following examples, we use the special collection "session", which
-;; is bound to Emacs' lifetime.
+;; is bound to Emacs's lifetime.
;;
;; (secrets-delete-item "session" "my item")
;; (secrets-create-item "session" "my item" "geheim"
@@ -142,11 +142,8 @@
;; Pacify byte-compiler. D-Bus support in the Emacs core can be
;; disabled with configuration option "--without-dbus". Declare used
;; subroutines and variables of `dbus' therefore.
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
(defvar dbus-debug)
(require 'dbus)
@@ -650,7 +647,7 @@ If there is no such item, return nil."
(let ((item-path (secrets-item-path collection item)))
(unless (secrets-empty-path item-path)
(dbus-byte-array-to-string
- (caddr
+ (cl-caddr
(dbus-call-method
:session secrets-service item-path secrets-interface-item
"GetSecret" :object-path secrets-session-path))))))
diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el
index 8112ed5b177..217f9dc8b30 100644
--- a/lisp/net/snmp-mode.el
+++ b/lisp/net/snmp-mode.el
@@ -1,6 +1,6 @@
;;; snmp-mode.el --- SNMP & SNMPv2 MIB major mode
-;; Copyright (C) 1995, 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Paul D. Smith <psmith@BayNetworks.com>
;; Keywords: data
@@ -85,7 +85,6 @@
;;; Code:
(eval-when-compile
- (require 'cl)
(require 'imenu) ; Need this stuff when compiling for imenu macros, etc.
(require 'tempo))
@@ -141,10 +140,10 @@ This is used during Tempo template completion."
:group 'snmp)
(defvar snmp-tempo-tags nil
- "*Tempo tags for SNMP mode.")
+ "Tempo tags for SNMP mode.")
(defvar snmpv2-tempo-tags nil
- "*Tempo tags for SNMPv2 mode.")
+ "Tempo tags for SNMPv2 mode.")
;; Enable fontification for SNMP MIBs
@@ -176,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/soap-client.el b/lisp/net/soap-client.el
index 74f51d148ef..93ba0a7e167 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -1,6 +1,6 @@
;;;; soap-client.el -- Access SOAP web services from Emacs
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com>
;; Created: December, 2009
@@ -55,6 +55,7 @@
(defgroup soap-client nil
"Access SOAP web services from Emacs."
+ :version "24.1"
:group 'tools)
;;;; Support for parsing XML documents with namespaces
@@ -368,6 +369,9 @@ binding) but the same name."
kind ; a symbol of: string, dateTime, long, int
)
+(defstruct (soap-simple-type (:include soap-basic-type))
+ enumeration)
+
(defstruct soap-sequence-element
name type nillable? multiple?)
@@ -414,8 +418,9 @@ binding) but the same name."
(defun soap-default-xsd-types ()
"Return a namespace containing some of the XMLSchema types."
(let ((ns (make-soap-namespace :name "http://www.w3.org/2001/XMLSchema")))
- (dolist (type '("string" "dateTime" "boolean" "long" "int" "float"
- "base64Binary" "anyType" "Array" "byte[]"))
+ (dolist (type '("string" "dateTime" "boolean"
+ "long" "int" "integer" "unsignedInt" "byte" "float" "double"
+ "base64Binary" "anyType" "anyURI" "Array" "byte[]"))
(soap-namespace-put
(make-soap-basic-type :name type :kind (intern type))
ns))
@@ -424,9 +429,10 @@ binding) but the same name."
(defun soap-default-soapenc-types ()
"Return a namespace containing some of the SOAPEnc types."
(let ((ns (make-soap-namespace
- :name "http://schemas.xmlsoap.org/soap/encoding/")))
- (dolist (type '("string" "dateTime" "boolean" "long" "int" "float"
- "base64Binary" "anyType" "Array" "byte[]"))
+ :name "http://schemas.xmlsoap.org/soap/encoding/")))
+ (dolist (type '("string" "dateTime" "boolean"
+ "long" "int" "integer" "unsignedInt" "byte" "float" "double"
+ "base64Binary" "anyType" "anyURI" "Array" "byte[]"))
(soap-namespace-put
(make-soap-basic-type :name type :kind (intern type))
ns))
@@ -554,6 +560,15 @@ updated."
(when resolver
(funcall resolver element wsdl))))
+(defun soap-resolve-references-for-simple-type (type wsdl)
+ "Resolve the base type for the simple TYPE using the WSDL
+ document."
+ (let ((kind (soap-basic-type-kind type)))
+ (unless (symbolp kind)
+ (let ((basic-type (soap-wsdl-get kind wsdl 'soap-basic-type-p)))
+ (setf (soap-basic-type-kind type)
+ (soap-basic-type-kind basic-type))))))
+
(defun soap-resolve-references-for-sequence-type (type wsdl)
"Resolve references for a sequence TYPE using WSDL document.
See also `soap-resolve-references-for-element' and
@@ -561,12 +576,18 @@ See also `soap-resolve-references-for-element' and
(let ((parent (soap-sequence-type-parent type)))
(when (or (consp parent) (stringp parent))
(setf (soap-sequence-type-parent type)
- (soap-wsdl-get parent wsdl 'soap-type-p))))
+ (soap-wsdl-get
+ parent wsdl
+ ;; Prevent self references, see Bug#9
+ (lambda (e) (and (not (eq e type)) (soap-type-p e)))))))
(dolist (element (soap-sequence-type-elements type))
(let ((element-type (soap-sequence-element-type element)))
(cond ((or (consp element-type) (stringp element-type))
(setf (soap-sequence-element-type element)
- (soap-wsdl-get element-type wsdl 'soap-type-p)))
+ (soap-wsdl-get
+ element-type wsdl
+ ;; Prevent self references, see Bug#9
+ (lambda (e) (and (not (eq e type)) (soap-type-p e))))))
((soap-element-p element-type)
;; since the element already has a child element, it
;; could be an inline structure. we must resolve
@@ -581,7 +602,10 @@ See also `soap-resolve-references-for-element' and
(let ((element-type (soap-array-type-element-type type)))
(when (or (consp element-type) (stringp element-type))
(setf (soap-array-type-element-type type)
- (soap-wsdl-get element-type wsdl 'soap-type-p)))))
+ (soap-wsdl-get
+ element-type wsdl
+ ;; Prevent self references, see Bug#9
+ (lambda (e) (and (not (eq e type)) (soap-type-p e))))))))
(defun soap-resolve-references-for-message (message wsdl)
"Resolve references for a MESSAGE type using the WSDL document.
@@ -678,6 +702,8 @@ See also `soap-resolve-references-for-element' and
;; Install resolvers for our types
(progn
+ (put (aref (make-soap-simple-type) 0) 'soap-resolve-references
+ 'soap-resolve-references-for-simple-type)
(put (aref (make-soap-sequence-type) 0) 'soap-resolve-references
'soap-resolve-references-for-sequence-type)
(put (aref (make-soap-array-type) 0) 'soap-resolve-references
@@ -853,6 +879,9 @@ Return a SOAP-NAMESPACE containing the elements."
(let ((ns (make-soap-namespace :name (soap-get-target-namespace node))))
;; NOTE: we only extract the complexTypes from the schema, we wouldn't
;; know how to handle basic types beyond the built in ones anyway.
+ (dolist (node (soap-xml-get-children1 node 'xsd:simpleType))
+ (soap-namespace-put (soap-parse-simple-type node) ns))
+
(dolist (node (soap-xml-get-children1 node 'xsd:complexType))
(soap-namespace-put (soap-parse-complex-type node) ns))
@@ -861,6 +890,26 @@ Return a SOAP-NAMESPACE containing the elements."
ns)))
+(defun soap-parse-simple-type (node)
+ "Parse NODE and construct a simple type from it."
+ (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:simpleType)
+ nil
+ "soap-parse-complex-type: expecting xsd:simpleType node, got %s"
+ (soap-l2wk (xml-node-name node)))
+ (let ((name (xml-get-attribute-or-nil node 'name))
+ type
+ enumeration
+ (restriction (car-safe
+ (soap-xml-get-children1 node 'xsd:restriction))))
+ (unless restriction
+ (error "simpleType %s has no base type" name))
+
+ (setq type (xml-get-attribute-or-nil restriction 'base))
+ (dolist (e (soap-xml-get-children1 restriction 'xsd:enumeration))
+ (push (xml-get-attribute e 'value) enumeration))
+
+ (make-soap-simple-type :name name :kind type :enumeration enumeration)))
+
(defun soap-parse-schema-element (node)
"Parse NODE and construct a schema element from it."
(assert (eq (soap-l2wk (xml-node-name node)) 'xsd:element)
@@ -974,7 +1023,7 @@ contents."
extension 'xsd:sequence)))))
(restriction
(let ((base (xml-get-attribute-or-nil restriction 'base)))
- (assert (equal base "soapenc:Array")
+ (assert (equal base (soap-wk2l "soapenc:Array"))
nil
"restrictions supported only for soapenc:Array types, this is a %s"
base))
@@ -1244,9 +1293,9 @@ type-info stored in TYPE."
(if (null contents)
nil
(ecase type-kind
- (string (car contents))
+ ((string anyURI) (car contents))
(dateTime (car contents)) ; TODO: convert to a date time
- ((long int float) (string-to-number (car contents)))
+ ((long int integer unsignedInt byte float double) (string-to-number (car contents)))
(boolean (string= (downcase (car contents)) "true"))
(base64Binary (base64-decode-string (car contents)))
(anyType (soap-decode-any-type node))
@@ -1292,6 +1341,10 @@ This is because it is easier to work with list results in LISP."
(progn
(put (aref (make-soap-basic-type) 0)
'soap-decoder 'soap-decode-basic-type)
+ ;; just use the basic type decoder for the simple type -- we accept any
+ ;; value and don't do any validation on it.
+ (put (aref (make-soap-simple-type) 0)
+ 'soap-decoder 'soap-decode-basic-type)
(put (aref (make-soap-sequence-type) 0)
'soap-decoder 'soap-decode-sequence-type)
(put (aref (make-soap-array-type) 0)
@@ -1321,10 +1374,11 @@ WSDL is used to decode the NODE"
fault 'faultcode))))
(car-safe (xml-node-children n))))
(fault-string (let ((n (car (xml-get-children
- fault 'faultstring))))
- (car-safe (xml-node-children n)))))
+ fault 'faultstring))))
+ (car-safe (xml-node-children n))))
+ (detail (xml-get-children fault 'detail)))
(while t
- (signal 'soap-error (list fault-code fault-string))))))
+ (signal 'soap-error (list fault-code fault-string detail))))))
;; First (non string) element of the body is the root node of he
;; response
@@ -1456,7 +1510,7 @@ instead."
(progn
(insert ">")
(case basic-type
- (string
+ ((string anyURI)
(unless (stringp value)
(error "Soap-encode-basic-type(%s, %s, %s): not a string value"
xml-tag value xsi-type))
@@ -1483,10 +1537,19 @@ instead."
xml-tag value xsi-type))
(insert (if value "true" "false")))
- ((long int)
+ ((long int integer byte unsignedInt)
(unless (integerp value)
(error "Soap-encode-basic-type(%s, %s, %s): not an integer value"
xml-tag value xsi-type))
+ (when (and (eq basic-type 'unsignedInt) (< value 0))
+ (error "Soap-encode-basic-type(%s, %s, %s): not a positive integer"
+ xml-tag value xsi-type))
+ (insert (number-to-string value)))
+
+ ((float double)
+ (unless (numberp value)
+ (error "Soap-encode-basic-type(%s, %s, %s): not a number"
+ xml-tag value xsi-type))
(insert (number-to-string value)))
(base64Binary
@@ -1503,6 +1566,20 @@ instead."
(insert " xsi:nil=\"true\">"))
(insert "</" xml-tag ">\n")))
+(defun soap-encode-simple-type (xml-tag value type)
+ "Encode inside XML-TAG the LISP VALUE according to TYPE."
+
+ ;; Validate VALUE against the simple type's enumeration, than just encode it
+ ;; using `soap-encode-basic-type'
+
+ (let ((enumeration (soap-simple-type-enumeration type)))
+ (unless (and (> (length enumeration) 1)
+ (member value enumeration))
+ (error "soap-encode-simple-type(%s, %s, %s): bad value, should be one of %s"
+ xml-tag value (soap-element-fq-name type) enumeration)))
+
+ (soap-encode-basic-type xml-tag value type))
+
(defun soap-encode-sequence-type (xml-tag value type)
"Encode inside XML-TAG the LISP VALUE according to TYPE.
Do not call this function directly, use `soap-encode-value'
@@ -1563,6 +1640,8 @@ instead."
(progn
(put (aref (make-soap-basic-type) 0)
'soap-encoder 'soap-encode-basic-type)
+ (put (aref (make-soap-simple-type) 0)
+ 'soap-encoder 'soap-encode-simple-type)
(put (aref (make-soap-sequence-type) 0)
'soap-encoder 'soap-encode-sequence-type)
(put (aref (make-soap-array-type) 0)
diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el
index 8f67d02dc6f..877ac71f4c1 100644
--- a/lisp/net/soap-inspect.el
+++ b/lisp/net/soap-inspect.el
@@ -1,6 +1,6 @@
;;;; soap-inspect.el -- Interactive inspector for soap WSDL structures
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com>
;; Created: October 2010
@@ -66,6 +66,15 @@ use `soap-sample-value' instead."
;; TODO: we need better sample values for more types.
(t (format "%s" (soap-basic-type-kind type)))))
+(defun soap-sample-value-for-simple-type (type)
+ "Provide a sample value for TYPE which is a simple type.
+This is a specific function which should not be called directly,
+use `soap-sample-value' instead."
+ (let ((enumeration (soap-simple-type-enumeration type)))
+ (if (> (length enumeration) 1)
+ (elt enumeration (random (length enumeration)))
+ (soap-sample-value-for-basic-type type))))
+
(defun soap-sample-value-for-seqence-type (type)
"Provide a sample value for TYPE which is a sequence type.
Values for sequence types are ALISTS of (slot-name . VALUE) for
@@ -115,6 +124,9 @@ use `soap-sample-value' instead."
(put (aref (make-soap-basic-type) 0) 'soap-sample-value
'soap-sample-value-for-basic-type)
+ (put (aref (make-soap-simple-type) 0) 'soap-sample-value
+ 'soap-sample-value-for-simple-type)
+
(put (aref (make-soap-sequence-type) 0) 'soap-sample-value
'soap-sample-value-for-seqence-type)
@@ -204,6 +216,16 @@ entire WSDL can be inspected."
(insert "\nSample value\n")
(pp (soap-sample-value basic-type) (current-buffer)))
+(defun soap-inspect-simple-type (simple-type)
+ "Insert information about SIMPLE-TYPE into the current buffer"
+ (insert "Simple type: " (soap-element-fq-name simple-type) "\n")
+ (insert "Base: " (symbol-name (soap-basic-type-kind simple-type)) "\n")
+ (let ((enumeration (soap-simple-type-enumeration simple-type)))
+ (when (> (length enumeration) 1)
+ (insert "Valid values: ")
+ (dolist (e enumeration)
+ (insert "\"" e "\" ")))))
+
(defun soap-inspect-sequence-type (sequence)
"Insert information about SEQUENCE into the current buffer."
(insert "Sequence type: " (soap-element-fq-name sequence) "\n")
@@ -331,6 +353,9 @@ entire WSDL can be inspected."
(put (aref (make-soap-basic-type) 0) 'soap-inspect
'soap-inspect-basic-type)
+ (put (aref (make-soap-simple-type) 0) 'soap-inspect
+ 'soap-inspect-simple-type)
+
(put (aref (make-soap-sequence-type) 0) 'soap-inspect
'soap-inspect-sequence-type)
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index d792077d861..306376f8af2 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -1,6 +1,6 @@
;;; socks.el --- A Socks v5 Client for Emacs
-;; Copyright (C) 1996-2000, 2002, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2000, 2002, 2007-2012 Free Software Foundation, Inc.
;; Author: William M. Perry <wmperry@gnu.org>
;; Dave Love <fx@gnu.org>
@@ -35,6 +35,8 @@
(require 'wid-edit))
(require 'custom)
+;; FIXME this is bad practice, and who is it for anyway, since Emacs
+;; has split-string since at least 21.1.
(if (not (fboundp 'split-string))
(defun split-string (string &optional pattern)
"Return a list of substrings of STRING which are separated by PATTERN.
@@ -335,10 +337,17 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(declare-function socks-original-open-network-stream "socks") ; fset
+;; FIXME this is a terrible idea.
+;; It is not even compatible with the argument spec of open-network-stream
+;; in 24.1. If this is really necessary, open-network-stream
+;; could get a wrapper hook, or defer to open-network-stream-function.
+
(defvar socks-override-functions nil
- "*Whether to overwrite the open-network-stream function with the SOCKSified
+ "Whether to overwrite the open-network-stream function with the SOCKSified
version.")
+(require 'network-stream)
+
(if (fboundp 'socks-original-open-network-stream)
nil ; Do nothing, we've been here already
(defalias 'socks-original-open-network-stream
@@ -414,7 +423,7 @@ version.")
((= atype socks-address-type-name)
(format "%c%s" (length address) address))
(t
- (error "Unkown address type: %d" atype))))
+ (error "Unknown address type: %d" atype))))
(info (gethash proc socks-connections))
request version)
(or info (error "socks-send-command called on non-SOCKS connection %S"
@@ -471,7 +480,7 @@ version.")
;; Replacement functions for open-network-stream, etc.
(defvar socks-noproxy nil
- "*List of regexps matching hosts that we should not socksify connections to")
+ "List of regexps matching hosts that we should not socksify connections to")
(defun socks-find-route (host service)
(let ((route socks-server)
@@ -617,7 +626,7 @@ version.")
(defcustom socks-nslookup-program "nslookup"
- "*If non-NIL then a string naming the nslookup program."
+ "If non-NIL then a string naming the nslookup program."
:type '(choice (const :tag "None" :value nil) string)
:group 'socks)
diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el
index 59850f68d44..00a556813c1 100644
--- a/lisp/net/telnet.el
+++ b/lisp/net/telnet.el
@@ -1,6 +1,6 @@
;;; telnet.el --- run a telnet session from within an Emacs buffer
-;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2011
+;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2012
;; Free Software Foundation, Inc.
;; Author: William F. Schelter
diff --git a/lisp/net/tls.el b/lisp/net/tls.el
index 6f66156a7e2..75d178e3225 100644
--- a/lisp/net/tls.el
+++ b/lisp/net/tls.el
@@ -1,6 +1,6 @@
;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
-;; Copyright (C) 1996-1999, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2002-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: comm, tls, gnutls, ssl
@@ -231,16 +231,11 @@ Fourth arg PORT is an integer specifying a port to connect to."
?h host
?p (if (integerp port)
(int-to-string port)
- port))))
- response)
+ port)))))
(message "Opening TLS connection with `%s'..." formatted-cmd)
(setq process (start-process
name buffer shell-file-name shell-command-switch
formatted-cmd))
- (funcall (if (fboundp 'set-process-query-on-exit-flag)
- 'set-process-query-on-exit-flag
- 'process-kill-without-query)
- process nil)
(while (and process
(memq (process-status process) '(open run))
(progn
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 56087a3aef6..e4fca46ce2d 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -1,6 +1,6 @@
;;; tramp-cache.el --- file information caching for Tramp
-;; Copyright (C) 2000, 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2005-2012 Free Software Foundation, Inc.
;; Author: Daniel Pittman <daniel@inanna.danann.net>
;; Michael Albinus <michael.albinus@gmx.de>
@@ -139,27 +139,6 @@ Returns VALUE."
value))
;;;###tramp-autoload
-(defmacro with-file-property (vec file property &rest body)
- "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
-FILE must be a local file name on a connection identified via VEC."
- `(if (file-name-absolute-p ,file)
- (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
- (when (eq value 'undef)
- ;; We cannot pass @body as parameter to
- ;; `tramp-set-file-property' because it mangles our
- ;; debug messages.
- (setq value (progn ,@body))
- (tramp-set-file-property ,vec ,file ,property value))
- value)
- ,@body))
-
-;;;###tramp-autoload
-(put 'with-file-property 'lisp-indent-function 3)
-(put 'with-file-property 'edebug-form-spec t)
-(tramp-compat-font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-file-property\\>"))
-
-;;;###tramp-autoload
(defun tramp-flush-file-property (vec file)
"Remove all properties of FILE in the cache context of VEC."
;; Remove file property of symlinks.
@@ -243,31 +222,13 @@ PROPERTY is set persistent when KEY is a vector."
(aset key 3 nil))
(let ((hash (or (gethash key tramp-cache-data)
(puthash key (make-hash-table :test 'equal)
- tramp-cache-data))))
+ tramp-cache-data))))
(puthash property value hash)
(setq tramp-cache-data-changed t)
(tramp-message key 7 "%s %s" property value)
value))
;;;###tramp-autoload
-(defmacro with-connection-property (key property &rest body)
- "Check in Tramp for property PROPERTY, otherwise executes BODY and set."
- `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
- (when (eq value 'undef)
- ;; We cannot pass ,@body as parameter to
- ;; `tramp-set-connection-property' because it mangles our debug
- ;; messages.
- (setq value (progn ,@body))
- (tramp-set-connection-property ,key ,property value))
- value))
-
-;;;###tramp-autoload
-(put 'with-connection-property 'lisp-indent-function 2)
-(put 'with-connection-property 'edebug-form-spec t)
-(tramp-compat-font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-connection-property\\>"))
-
-;;;###tramp-autoload
(defun tramp-flush-connection-property (key)
"Remove all properties identified by KEY.
KEY identifies the connection, it is either a process or a vector."
@@ -328,11 +289,17 @@ KEY identifies the connection, it is either a process or a vector."
(not (zerop (hash-table-count tramp-cache-data)))
tramp-cache-data-changed
(stringp tramp-persistency-file-name))
- (let ((cache (copy-hash-table tramp-cache-data)))
- ;; Remove temporary data.
+ (let ((cache (copy-hash-table tramp-cache-data))
+ print-length print-level)
+ ;; Remove temporary data. If there is the key "login-as", we
+ ;; don't save either, because all other properties might
+ ;; depend on the login name, and we want to give the
+ ;; possibility to use another login name later on.
(maphash
(lambda (key value)
- (if (and (vectorp key) (not (tramp-file-name-localname key)))
+ (if (and (vectorp key)
+ (not (tramp-file-name-localname key))
+ (not (gethash "login-as" value)))
(progn
(remhash "process-name" value)
(remhash "process-buffer" value)
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 998f62920a1..abca6b3ea01 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -1,6 +1,6 @@
;;; tramp-cmds.el --- Interactive commands for Tramp
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -89,7 +89,9 @@ When called interactively, a Tramp connection has to be selected."
(tramp-flush-directory-property vec "")
;; Flush connection cache.
- (tramp-flush-connection-property (tramp-get-connection-process vec))
+ (when (processp (tramp-get-connection-process vec))
+ (delete-process (tramp-get-connection-process vec))
+ (tramp-flush-connection-property (tramp-get-connection-process vec)))
(tramp-flush-connection-property vec)
;; Remove buffers.
@@ -202,7 +204,7 @@ useful thing to do is to put
(setq tramp-verbose 9)
-in the ~/.emacs file and to repeat the bug. Then, include the
+in your init file and to repeat the bug. Then, include the
contents of the *tramp/foo* buffer and the *debug tramp/foo*
buffer in your bug report.
@@ -293,8 +295,9 @@ buffer in your bug report.
;; Dump load-path shadows.
(insert "\nload-path shadows:\n==================\n")
(ignore-errors
- (mapc (lambda (x) (when (string-match "tramp" x) (insert x "\n")))
- (split-string (list-load-path-shadows t) "\n")))
+ (mapc
+ (lambda (x) (when (string-match "tramp" x) (insert x "\n")))
+ (split-string (tramp-compat-funcall 'list-load-path-shadows t) "\n")))
;; Append buffers only when we are in message mode.
(when (and
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 89c7db241d8..c3552ae023b 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -1,6 +1,6 @@
;;; tramp-compat.el --- Tramp compatibility functions
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -29,8 +29,6 @@
;;; Code:
-(require 'tramp-loaddefs)
-
(eval-when-compile
;; Pacify byte-compiler.
@@ -38,11 +36,24 @@
(eval-and-compile
+ ;; Some packages must be required for XEmacs, because we compile
+ ;; with -no-autoloads.
+ (when (featurep 'xemacs)
+ (require 'cus-edit)
+ (require 'env)
+ (require 'executable)
+ (require 'outline)
+ (require 'passwd)
+ (require 'pp)
+ (require 'regexp-opt))
+
(require 'advice)
(require 'custom)
(require 'format-spec)
(require 'shell)
+ (require 'tramp-loaddefs)
+
;; As long as password.el is not part of (X)Emacs, it shouldn't be
;; mandatory.
(if (featurep 'xemacs)
@@ -61,7 +72,8 @@
(require 'timer))
;; We check whether `start-file-process' is bound.
- (unless (fboundp 'start-file-process)
+ ;; Note: we deactivate this. There are problems, at least in SXEmacs.
+ (unless t;(fboundp 'start-file-process)
;; tramp-util offers integration into other (X)Emacs packages like
;; compile.el, gud.el etc. Not necessary in Emacs 23.
@@ -127,7 +139,8 @@
(defalias 'file-remote-p
(lambda (file &optional identification connected)
(when (tramp-tramp-file-p file)
- (tramp-file-name-handler
+ (tramp-compat-funcall
+ 'tramp-file-name-handler
'file-remote-p file identification connected)))))
;; `process-file' does not exist in XEmacs.
@@ -153,8 +166,8 @@
(defalias 'set-file-times
(lambda (filename &optional time)
(when (tramp-tramp-file-p filename)
- (tramp-file-name-handler
- 'set-file-times filename time)))))
+ (tramp-compat-funcall
+ 'tramp-file-name-handler 'set-file-times filename time)))))
;; We currently use "[" and "]" in the filename format for IPv6
;; hosts of GNU Emacs. This means that Emacs wants to expand
@@ -194,6 +207,22 @@
"Display MESSAGE temporarily if non-nil while BODY is evaluated."
`(progn ,@body)))
+;; `condition-case-unless-debug' is introduced with Emacs 24.
+(if (fboundp 'condition-case-unless-debug)
+ (defalias 'tramp-compat-condition-case-unless-debug
+ 'condition-case-unless-debug)
+ (defmacro tramp-compat-condition-case-unless-debug
+ (var bodyform &rest handlers)
+ "Like `condition-case' except that it does not catch anything when debugging."
+ (declare (debug condition-case) (indent 2))
+ (let ((bodysym (make-symbol "body")))
+ `(let ((,bodysym (lambda () ,bodyform)))
+ (if debug-on-error
+ (funcall ,bodysym)
+ (condition-case ,var
+ (funcall ,bodysym)
+ ,@handlers))))))
+
;; `font-lock-add-keywords' does not exist in XEmacs.
(defun tramp-compat-font-lock-add-keywords (mode keywords &optional how)
"Add highlighting KEYWORDS for MODE."
@@ -204,19 +233,23 @@
"Return name of directory for temporary files (compat function).
For Emacs, this is the variable `temporary-file-directory', for XEmacs
this is the function `temp-directory'."
- (cond
- ((boundp 'temporary-file-directory) (symbol-value 'temporary-file-directory))
- ((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory))
- ((let ((d (getenv "TEMP"))) (and d (file-directory-p d)))
- (file-name-as-directory (getenv "TEMP")))
- ((let ((d (getenv "TMP"))) (and d (file-directory-p d)))
- (file-name-as-directory (getenv "TMP")))
- ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d)))
- (file-name-as-directory (getenv "TMPDIR")))
- ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
- (t (message (concat "Neither `temporary-file-directory' nor "
- "`temp-directory' is defined -- using /tmp."))
- (file-name-as-directory "/tmp"))))
+ (let (file-name-handler-alist)
+ ;; We must return a local directory. If it is remote, we could
+ ;; run into an infloop.
+ (cond
+ ((and (boundp 'temporary-file-directory)
+ (eval (car (get 'temporary-file-directory 'standard-value)))))
+ ((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory))
+ ((let ((d (getenv "TEMP"))) (and d (file-directory-p d)))
+ (file-name-as-directory (getenv "TEMP")))
+ ((let ((d (getenv "TMP"))) (and d (file-directory-p d)))
+ (file-name-as-directory (getenv "TMP")))
+ ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d)))
+ (file-name-as-directory (getenv "TMPDIR")))
+ ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
+ (t (message (concat "Neither `temporary-file-directory' nor "
+ "`temp-directory' is defined -- using /tmp."))
+ (file-name-as-directory "/tmp")))))
;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own
;; implementation with `make-temp-name', creating the temporary file
@@ -282,7 +315,8 @@ Not actually used. Use `(format \"%o\" i)' instead?"
((or (null id-format) (eq id-format 'integer))
(file-attributes filename))
((tramp-tramp-file-p filename)
- (tramp-file-name-handler 'file-attributes filename id-format))
+ (tramp-compat-funcall
+ 'tramp-file-name-handler 'file-attributes filename id-format))
(t (condition-case nil
(tramp-compat-funcall 'file-attributes filename id-format)
(wrong-number-of-arguments (file-attributes filename))))))
@@ -308,43 +342,49 @@ Not actually used. Use `(format \"%o\" i)' instead?"
;; `copy-directory' is a new function in Emacs 23.2. Implementation
;; is taken from there.
(defun tramp-compat-copy-directory
- (directory newname &optional keep-time parents)
+ (directory newname &optional keep-time parents copy-contents)
"Make a copy of DIRECTORY (compat function)."
- (if (fboundp 'copy-directory)
- (tramp-compat-funcall 'copy-directory directory newname keep-time parents)
-
- ;; If `default-directory' is a remote directory, make sure we find
- ;; its `copy-directory' handler.
- (let ((handler (or (find-file-name-handler directory 'copy-directory)
- (find-file-name-handler newname 'copy-directory))))
- (if handler
- (funcall handler 'copy-directory directory newname keep-time parents)
-
- ;; Compute target name.
- (setq directory (directory-file-name (expand-file-name directory))
- newname (directory-file-name (expand-file-name newname)))
- (if (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory directory)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory directory) newname)))
- (if (not (file-directory-p newname)) (make-directory newname parents))
-
- ;; Copy recursively.
- (mapc
- (lambda (file)
- (if (file-directory-p file)
- (tramp-compat-copy-directory file newname keep-time parents)
- (copy-file file newname t keep-time)))
- ;; We do not want to delete "." and "..".
- (directory-files
- directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
-
- ;; Set directory attributes.
- (set-file-modes newname (file-modes directory))
- (if keep-time
- (set-file-times newname (nth 5 (file-attributes directory))))))))
+ (condition-case nil
+ (tramp-compat-funcall
+ 'copy-directory directory newname keep-time parents copy-contents)
+
+ ;; `copy-directory' is either not implemented, or it does not
+ ;; support the the COPY-CONTENTS flag. For the time being, we
+ ;; ignore COPY-CONTENTS as well.
+
+ (error
+ ;; If `default-directory' is a remote directory, make sure we
+ ;; find its `copy-directory' handler.
+ (let ((handler (or (find-file-name-handler directory 'copy-directory)
+ (find-file-name-handler newname 'copy-directory))))
+ (if handler
+ (funcall handler 'copy-directory directory newname keep-time parents)
+
+ ;; Compute target name.
+ (setq directory (directory-file-name (expand-file-name directory))
+ newname (directory-file-name (expand-file-name newname)))
+ (if (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory directory)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory directory) newname)))
+ (if (not (file-directory-p newname)) (make-directory newname parents))
+
+ ;; Copy recursively.
+ (mapc
+ (lambda (file)
+ (if (file-directory-p file)
+ (tramp-compat-copy-directory file newname keep-time parents)
+ (copy-file file newname t keep-time)))
+ ;; We do not want to delete "." and "..".
+ (directory-files
+ directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
+
+ ;; Set directory attributes.
+ (set-file-modes newname (file-modes directory))
+ (if keep-time
+ (set-file-times newname (nth 5 (file-attributes directory)))))))))
;; TRASH has been introduced with Emacs 24.1.
(defun tramp-compat-delete-file (filename &optional trash)
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index 71b3eacccea..44ae176c6c9 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -1,6 +1,6 @@
;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -49,9 +49,8 @@
(defun tramp-disable-ange-ftp ()
"Turn Ange-FTP off.
This is useful for unified remoting. See
-`tramp-file-name-structure-unified' and
-`tramp-file-name-structure-separate' for details. Requests suitable
-for Ange-FTP will be forwarded to Ange-FTP. Also see the variables
+`tramp-file-name-structure' for details. Requests suitable for
+Ange-FTP will be forwarded to Ange-FTP. Also see the variables
`tramp-ftp-method', `tramp-default-method', and
`tramp-default-method-alist'.
@@ -99,7 +98,7 @@ present for backward compatibility."
;; Define FTP method ...
;;;###tramp-autoload
(defconst tramp-ftp-method "ftp"
- "*When this method name is used, forward all calls to Ange-FTP.")
+ "When this method name is used, forward all calls to Ange-FTP.")
;; ... and add it to the method list.
;;;###tramp-autoload
@@ -204,8 +203,8 @@ pass to the OPERATION."
;;;###tramp-autoload
(defsubst tramp-ftp-file-name-p (filename)
"Check if it's a filename that should be forwarded to Ange-FTP."
- (let ((v (tramp-dissect-file-name filename)))
- (string= (tramp-file-name-method v) tramp-ftp-method)))
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-ftp-method))
;;;###tramp-autoload
(unless (featurep 'xemacs)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 27dff3aa8d9..0aa1b8957ac 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1,6 +1,6 @@
;;; tramp-gvfs.el --- Tramp access functions for GVFS daemon
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -91,11 +91,7 @@
;; D-Bus support in the Emacs core can be disabled with configuration
;; option "--without-dbus". Declare used subroutines and variables.
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-call-method-asynchronously "dbusbind.c")
(declare-function dbus-get-unique-name "dbusbind.c")
-(declare-function dbus-register-method "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
;; Pacify byte-compiler
(eval-when-compile
@@ -111,7 +107,7 @@
;;;###tramp-autoload
(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce")
- "*List of methods for remote files, accessed with GVFS."
+ "List of methods for remote files, accessed with GVFS."
:group 'tramp
:version "23.2"
:type '(repeat (choice (const "dav")
@@ -128,7 +124,7 @@
(add-to-list 'tramp-default-user-alist '("\\`synce\\'" nil nil))
(defcustom tramp-gvfs-zeroconf-domain "local"
- "*Zeroconf domain to be used for discovering services, like host names."
+ "Zeroconf domain to be used for discovering services, like host names."
:group 'tramp
:version "23.2"
:type 'string)
@@ -525,12 +521,12 @@ It is needed when D-Bus signals or errors arrive, because there
is no information where to trace the message.")
(defun tramp-gvfs-dbus-event-error (event err)
- "Called when a D-Bus error message arrives, see `dbus-event-error-hooks'."
+ "Called when a D-Bus error message arrives, see `dbus-event-error-functions'."
(when tramp-gvfs-dbus-event-vector
(tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event)
(tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
-(add-hook 'dbus-event-error-hooks 'tramp-gvfs-dbus-event-error)
+(add-hook 'dbus-event-error-functions 'tramp-gvfs-dbus-event-error)
;; File name primitives.
@@ -541,7 +537,7 @@ is no information where to trace the message.")
"Like `copy-file' for Tramp files."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 0 (format "Copying %s to %s" filename newname)
(condition-case err
(let ((args
@@ -625,7 +621,7 @@ is no information where to trace the message.")
;; If there is a default location, expand tilde.
(when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
(save-match-data
- (tramp-gvfs-maybe-open-connection (vector method user host "/")))
+ (tramp-gvfs-maybe-open-connection (vector method user host "/" hop)))
(setq localname
(replace-match
(tramp-get-file-property v "/" "default-location" "~")
@@ -745,7 +741,7 @@ is no information where to trace the message.")
"Like `rename-file' for Tramp files."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 0 (format "Renaming %s to %s" filename newname)
(condition-case err
(rename-file
@@ -1060,7 +1056,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
(catch 'mounted
(dolist
(elt
- (with-file-property vec "/" "list-mounts"
+ (with-tramp-file-property vec "/" "list-mounts"
(with-tramp-dbus-call-method vec t
:session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
tramp-gvfs-interface-mounttracker "listMounts"))
@@ -1203,13 +1199,13 @@ connection if a previous connection has died for some reason."
(tramp-gvfs-object-path
(tramp-make-tramp-file-name method user host ""))))
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
vec 3
(if (zerop (length user))
(format "Opening connection for %s using %s" host method)
(format "Opening connection for %s@%s using %s" user host method))
- ;; Enable auth-sorce and password-cache.
+ ;; Enable auth-source and password-cache.
(tramp-set-connection-property vec "first-password-request" t)
;; There will be a callback of "askPassword" when a password is
@@ -1267,7 +1263,7 @@ COMMAND is usually a command from the gvfs-* utilities.
(with-current-buffer (tramp-get-buffer vec)
(erase-buffer)
(tramp-message vec 6 "%s %s" command (mapconcat 'identity args " "))
- (setq result (apply 'tramp-local-call-process command nil t nil args))
+ (setq result (apply 'tramp-compat-call-process command nil t nil args))
(tramp-message vec 6 "%s" (buffer-string))
result)))
diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el
index 4ddd63bc3b8..3aa25e2caa6 100644
--- a/lisp/net/tramp-gw.el
+++ b/lisp/net/tramp-gw.el
@@ -1,6 +1,6 @@
;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -50,20 +50,20 @@
;; Define HTTP tunnel method ...
;;;###tramp-autoload
(defconst tramp-gw-tunnel-method "tunnel"
- "*Method to connect HTTP gateways.")
+ "Method to connect HTTP gateways.")
;; ... and port.
(defconst tramp-gw-default-tunnel-port 8080
- "*Default port for HTTP gateways.")
+ "Default port for HTTP gateways.")
;; Define SOCKS method ...
;;;###tramp-autoload
(defconst tramp-gw-socks-method "socks"
- "*Method to connect SOCKS servers.")
+ "Method to connect SOCKS servers.")
;; ... and port.
(defconst tramp-gw-default-socks-port 1080
- "*Default port for SOCKS servers.")
+ "Default port for SOCKS servers.")
;; Autoload the socks library. It is used only when we access a SOCKS server.
(autoload 'socks-open-network-stream "socks")
@@ -154,7 +154,7 @@ instead of the host name declared in TARGET-VEC."
(memq (process-status tramp-gw-aux-proc) '(listen)))
(let ((aux-vec
(vector "aux" (tramp-file-name-user gw-vec)
- (tramp-file-name-host gw-vec) nil)))
+ (tramp-file-name-host gw-vec) nil nil)))
(setq tramp-gw-aux-proc
(make-network-process
:name (tramp-buffer-name aux-vec) :buffer nil :host 'local
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 446a27c65d3..07da0b3dc16 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1,6 +1,6 @@
;;; tramp-sh.el --- Tramp access functions for (s)sh-like connections
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; (copyright statements below in code to be updated with the above notice)
@@ -43,7 +43,7 @@
;; `dired-insert-set-properties'.
(defcustom tramp-inline-compress-start-size 4096
- "*The minimum size of compressing where inline transfer.
+ "The minimum size of compressing where inline transfer.
When inline transfer, compress transferred data of file
whose size is this value or above (up to `tramp-copy-size-limit').
If it is nil, no compression at all will be applied."
@@ -51,14 +51,15 @@ If it is nil, no compression at all will be applied."
:type '(choice (const nil) integer))
(defcustom tramp-copy-size-limit 10240
- "*The maximum file size where inline copying is preferred over an out-of-the-band copy.
-If it is nil, inline out-of-the-band copy will be used without a check."
+ "The maximum file size where inline copying is preferred over an \
+out-of-the-band copy.
+If it is nil, out-of-the-band copy will be used without a check."
:group 'tramp
:type '(choice (const nil) integer))
;;;###tramp-autoload
(defcustom tramp-terminal-type "dumb"
- "*Value of TERM environment variable for logging in to remote host.
+ "Value of TERM environment variable for logging in to remote host.
Because Tramp wants to parse the output of the remote shell, it is easily
confused by ANSI color escape sequences and suchlike. Often, shell init
files conditionalize this setup based on the TERM environment variable."
@@ -347,7 +348,6 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
- (tramp-password-end-of-line "xy") ;see docstring for "xy"
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
@@ -356,7 +356,6 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-login-args (("-l" "%u") ("-P" "%p") ("-1" "-ssh") ("%h")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
- (tramp-password-end-of-line "xy") ;see docstring for "xy"
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
@@ -380,11 +379,10 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "pscp")
- (tramp-copy-args (("-P" "%p") ("-scp") ("-p" "%k")
+ (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-scp") ("-p" "%k")
("-q") ("-r")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)
- (tramp-password-end-of-line "xy") ;see docstring for "xy"
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
@@ -394,11 +392,10 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "pscp")
- (tramp-copy-args (("-P" "%p") ("-sftp") ("-p" "%k")
+ (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") ("-p" "%k")
("-q") ("-r")))
(tramp-copy-keep-date t)
- (tramp-copy-recursive t)
- (tramp-password-end-of-line "xy"))) ;see docstring for "xy"
+ (tramp-copy-recursive t)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
'("fcp"
@@ -419,13 +416,12 @@ detected as prompt when being sent on echoing hosts, therefore.")
`(,(concat "\\`" (regexp-opt '("su" "sudo" "ksu")) "\\'")
nil "root"))
;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored.
+;; Do not add "plink" based methods, they ask interactively for the user.
;;;###tramp-autoload
(add-to-list 'tramp-default-user-alist
`(,(concat
"\\`"
- (regexp-opt
- '("rcp" "remcp" "rsh" "telnet" "krlogin"
- "plink" "plink1" "pscp" "psftp" "fcp"))
+ (regexp-opt '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
"\\'")
nil ,(user-login-name)))
@@ -463,9 +459,11 @@ detected as prompt when being sent on echoing hosts, therefore.")
;;;###tramp-autoload
(defconst tramp-completion-function-alist-putty
- '((tramp-parse-putty
- "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"))
- "Default list of (FUNCTION REGISTRY) pairs to be examined for putty methods.")
+ `((tramp-parse-putty
+ ,(if (memq system-type '(windows-nt))
+ "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"
+ "~/.putty/sessions")))
+ "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.")
;;;###tramp-autoload
(eval-after-load 'tramp
@@ -512,11 +510,13 @@ detected as prompt when being sent on echoing hosts, therefore.")
;; GNU/Linux (Debian, Suse): /bin:/usr/bin
;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
;; IRIX64: /usr/bin
+;;;###tramp-autoload
(defcustom tramp-remote-path
- '(tramp-default-remote-path "/bin" "/usr/bin" "/usr/sbin" "/usr/local/bin"
- "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
- "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin")
- "*List of directories to search for executables on remote host.
+ '(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin"
+ "/usr/local/bin" "/usr/local/sbin" "/local/bin" "/local/freeware/bin"
+ "/local/gnu/bin" "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin"
+ "/opt/bin" "/opt/sbin" "/opt/local/bin")
+ "List of directories to search for executables on remote host.
For every remote host, this variable will be set buffer local,
keeping the list of existing directories on that host.
@@ -543,10 +543,9 @@ as given in your `~/.profile'."
,(format "TERM=%s" tramp-terminal-type)
"EMACS=t" ;; Deprecated.
,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
- "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH="
+ "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=\"\""
"autocorrect=" "correct=")
-
- "*List of environment variables to be set on the remote host.
+ "List of environment variables to be set on the remote host.
Each element should be a string of the form ENVVARNAME=VALUE. An
entry ENVVARNAME= disables the corresponding environment variable,
@@ -558,7 +557,7 @@ not be set here. Instead, it should be set via `tramp-remote-path'."
:type '(repeat string))
(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
- "*Alist specifying extra arguments to pass to the remote shell.
+ "Alist specifying extra arguments to pass to the remote shell.
Entries are (REGEXP . ARGS) where REGEXP is a regular expression
matching the shell file name and ARGS is a string specifying the
arguments.
@@ -806,7 +805,7 @@ on the remote host.")
(defconst tramp-perl-encode
"%s -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
-# Copyright (C) 2002-2011 Free Software Foundation, Inc.
+# Copyright (C) 2002-2012 Free Software Foundation, Inc.
use strict;
my %%trans = do {
@@ -847,7 +846,7 @@ This string is passed to `format', so percent characters need to be doubled.")
(defconst tramp-perl-decode
"%s -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
-# Copyright (C) 2002-2011 Free Software Foundation, Inc.
+# Copyright (C) 2002-2012 Free Software Foundation, Inc.
use strict;
my %%trans = do {
@@ -1059,7 +1058,7 @@ target of the symlink differ."
"Like `file-truename' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-make-tramp-file-name method user host
- (with-file-property v localname "file-truename"
+ (with-tramp-file-property v localname "file-truename"
(let ((result nil)) ; result steps in reverse order
(tramp-message v 4 "Finding true name for `%s'" filename)
(cond
@@ -1168,7 +1167,7 @@ target of the symlink differ."
(defun tramp-sh-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (with-file-property v localname "file-exists-p"
+ (with-tramp-file-property v localname "file-exists-p"
(or (not (null (tramp-get-file-property
v localname "file-attributes-integer" nil)))
(not (null (tramp-get-file-property
@@ -1180,16 +1179,14 @@ target of the symlink differ."
(tramp-get-file-exists-command v)
(tramp-shell-quote-argument localname)))))))
-;; CCC: This should check for an error condition and signal failure
-;; when something goes wrong.
-;; Daniel Pittman <daniel@danann.net>
(defun tramp-sh-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used))
(with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-file-property v localname (format "file-attributes-%s" id-format)
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
(save-excursion
(tramp-convert-file-attributes
v
@@ -1273,9 +1270,10 @@ target of the symlink differ."
res-uid
;; 3. File gid.
res-gid
- ;; 4. Last access time, as a list of two integers. First
- ;; integer has high-order 16 bits of time, second has low 16
- ;; bits.
+ ;; 4. Last access time, as a list of integers. Normally this
+ ;; would be in the same format as `current-time', but the
+ ;; subseconds part is not currently implemented, and (0 0)
+ ;; denotes an unknown time.
;; 5. Last modification time, likewise.
;; 6. Last status change time, likewise.
'(0 0) '(0 0) '(0 0) ;CCC how to find out?
@@ -1318,8 +1316,8 @@ target of the symlink differ."
(tramp-get-test-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%u" "\"%U\"")
- (if (eq id-format 'integer) "%g" "\"%G\"")
+ (if (eq id-format 'integer) "%ue0" "\"%U\"")
+ (if (eq id-format 'integer) "%ge0" "\"%G\"")
(tramp-shell-quote-argument localname))))
(defun tramp-sh-handle-set-visited-file-modtime (&optional time-list)
@@ -1485,7 +1483,8 @@ and gid of the corresponding user is taken. Both parameters must be integers."
(defun tramp-remote-selinux-p (vec)
"Check, whether SELINUX is enabled on the remote host."
- (with-connection-property (tramp-get-connection-process vec) "selinux-p"
+ (with-tramp-connection-property
+ (tramp-get-connection-process vec) "selinux-p"
(let ((result (tramp-find-executable
vec "getenforce" (tramp-get-remote-path vec) t t)))
(and result
@@ -1497,7 +1496,7 @@ and gid of the corresponding user is taken. Both parameters must be integers."
(defun tramp-sh-handle-file-selinux-context (filename)
"Like `file-selinux-context' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (with-file-property v localname "file-selinux-context"
+ (with-tramp-file-property v localname "file-selinux-context"
(let ((context '(nil nil nil nil))
(regexp (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
"\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)")))
@@ -1541,7 +1540,7 @@ and gid of the corresponding user is taken. Both parameters must be integers."
(defun tramp-sh-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (with-file-property v localname "file-executable-p"
+ (with-tramp-file-property v localname "file-executable-p"
;; Examine `file-attributes' cache to see if request can be
;; satisfied without remote operation.
(or (tramp-check-cached-permissions v ?x)
@@ -1550,7 +1549,7 @@ and gid of the corresponding user is taken. Both parameters must be integers."
(defun tramp-sh-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (with-file-property v localname "file-readable-p"
+ (with-tramp-file-property v localname "file-readable-p"
;; Examine `file-attributes' cache to see if request can be
;; satisfied without remote operation.
(or (tramp-check-cached-permissions v ?r)
@@ -1604,13 +1603,13 @@ and gid of the corresponding user is taken. Both parameters must be integers."
;; desirable to return t immediately for "/method:foo:". It can
;; be expected that this is always a directory.
(or (zerop (length localname))
- (with-file-property v localname "file-directory-p"
+ (with-tramp-file-property v localname "file-directory-p"
(tramp-run-test "-d" filename)))))
(defun tramp-sh-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (with-file-property v localname "file-writable-p"
+ (with-tramp-file-property v localname "file-writable-p"
(if (file-exists-p filename)
;; Examine `file-attributes' cache to see if request can be
;; satisfied without remote operation.
@@ -1623,7 +1622,7 @@ and gid of the corresponding user is taken. Both parameters must be integers."
(defun tramp-sh-handle-file-ownership-preserved-p (filename)
"Like `file-ownership-preserved-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (with-file-property v localname "file-ownership-preserved-p"
+ (with-tramp-file-property v localname "file-ownership-preserved-p"
(let ((attributes (file-attributes filename)))
;; Return t if the file doesn't exist, since it's true that no
;; information would be lost by an (attempted) delete and create.
@@ -1641,7 +1640,7 @@ and gid of the corresponding user is taken. Both parameters must be integers."
(let* ((temp
(copy-tree
(with-parsed-tramp-file-name directory nil
- (with-file-property
+ (with-tramp-file-property
v localname
(format "directory-files-and-attributes-%s" id-format)
(save-excursion
@@ -1696,14 +1695,15 @@ and gid of the corresponding user is taken. Both parameters must be integers."
;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
;; but it does not work on all remote systems. Therefore, we
;; quote the filenames via sed.
- "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | xargs "
- "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)'); "
- "echo \")\"")
+ "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | "
+ "xargs %s -c "
+ "'(\"%%n\" (\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)'"
+ " 2>/dev/null); echo \")\"")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
(tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%u" "\"%U\"")
- (if (eq id-format 'integer) "%g" "\"%G\""))))
+ (if (eq id-format 'integer) "%ue0" "\"%U\"")
+ (if (eq id-format 'integer) "%ge0" "\"%G\""))))
;; This function should return "foo/" for directories and "bar" for
;; files.
@@ -1909,7 +1909,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
'copy-file (list filename newname ok-if-already-exists keep-date)))))
(defun tramp-sh-handle-copy-directory
- (dirname newname &optional keep-date parents)
+ (dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
(let ((t1 (tramp-tramp-file-p dirname))
(t2 (tramp-tramp-file-p newname)))
@@ -1981,6 +1981,7 @@ file names."
(error "Unknown operation `%s', must be `copy' or `rename'" op))
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
+ (length (nth 7 (file-attributes (file-truename filename))))
(context (and preserve-selinux-context
(apply 'file-selinux-context (list filename))))
pr tm)
@@ -1990,7 +1991,7 @@ file names."
(tramp-error
v 'file-already-exists "File %s already exists" newname))
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 0 (format "%s %s to %s"
(if (eq op 'copy) "Copying" "Renaming")
filename newname)
@@ -2010,8 +2011,9 @@ file names."
ok-if-already-exists keep-date preserve-uid-gid))
;; Try out-of-band operation.
- ((tramp-method-out-of-band-p
- v1 (nth 7 (file-attributes (file-truename filename))))
+ ((and
+ (tramp-method-out-of-band-p v1 length)
+ (tramp-method-out-of-band-p v2 length))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname keep-date))
@@ -2039,8 +2041,7 @@ file names."
;; If the Tramp file has an out-of-band method, the
;; corresponding copy-program can be invoked.
- ((tramp-method-out-of-band-p
- v (nth 7 (file-attributes (file-truename filename))))
+ ((tramp-method-out-of-band-p v length)
(tramp-do-copy-or-rename-file-out-of-band
op filename newname keep-date))
@@ -2280,8 +2281,10 @@ The method used must be an out-of-band method."
;; Set variables for computing the prompt for reading
;; password.
(setq tramp-current-method (tramp-file-name-method v)
- tramp-current-user (tramp-file-name-user v)
- tramp-current-host (tramp-file-name-real-host v))
+ tramp-current-user (or (tramp-file-name-user v)
+ (tramp-get-connection-property
+ v "login-as" nil))
+ tramp-current-host (tramp-file-name-real-host v))
;; Expand hops. Might be necessary for gateway methods.
(setq v (car (tramp-compute-multi-hops v)))
@@ -2308,8 +2311,15 @@ The method used must be an out-of-band method."
(setq port (string-to-number (match-string 2 host))
host (string-to-number (match-string 1 host))))
+ ;; Check for user. There might be an interactive setting.
+ (setq user (or (tramp-file-name-user v)
+ (tramp-get-connection-property v "login-as" nil)))
+
;; Compose copy command.
- (setq spec (format-spec-make
+ (setq host (or host "")
+ user (or user "")
+ port (or port "")
+ spec (format-spec-make
?h host ?u user ?p port
?t (tramp-get-connection-property
(tramp-get-connection-process v) "temp-file" "")
@@ -2385,7 +2395,7 @@ The method used must be an out-of-band method."
p v nil tramp-actions-copy-out-of-band)))
;; Reset the transfer process properties.
- (tramp-message orig-vec 6 "%s" (buffer-string))
+ (tramp-message orig-vec 6 "\n%s" (buffer-string))
(tramp-set-connection-property v "process-name" nil)
(tramp-set-connection-property v "process-buffer" nil)))
@@ -2448,11 +2458,11 @@ The method used must be an out-of-band method."
"Recursively delete the directory given.
This is like `dired-recursive-delete-directory' for Tramp files."
(with-parsed-tramp-file-name filename nil
- ;; Run a shell command 'rm -r <localname>'
+ ;; Run a shell command 'rm -r <localname>'.
;; Code shamelessly stolen from the dired implementation and, um, hacked :)
(unless (file-exists-p filename)
(tramp-error v 'file-error "No such directory: %s" filename))
- ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
+ ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>).
(tramp-send-command
v
(format "rm -rf %s" (tramp-shell-quote-argument localname))
@@ -2499,7 +2509,7 @@ This is like `dired-recursive-delete-directory' for Tramp files."
nil)
((and suffix (nth 2 suffix))
;; We found an uncompression rule.
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 0 (format "Uncompressing %s" file)
(when (tramp-send-command-and-check
v (concat (nth 2 suffix) " "
@@ -2511,7 +2521,7 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(t
;; We don't recognize the file as compressed, so compress it.
;; Try gzip.
- (tramp-with-progress-reporter v 0 (format "Compressing %s" file)
+ (with-tramp-progress-reporter v 0 (format "Compressing %s" file)
(when (tramp-send-command-and-check
v (concat "gzip -f "
(tramp-shell-quote-argument localname)))
@@ -2667,7 +2677,7 @@ the result will be a local, non-Tramp, filename."
(string-match "\\`su\\(do\\)?\\'" method))
(setq uname (concat uname user)))
(setq uname
- (with-connection-property v uname
+ (with-tramp-connection-property v uname
(tramp-send-command
v (format "cd %s; pwd" (tramp-shell-quote-argument uname)))
(with-current-buffer (tramp-get-buffer v)
@@ -2690,7 +2700,8 @@ the result will be a local, non-Tramp, filename."
method user host
(tramp-drop-volume-letter
(tramp-run-real-handler
- 'expand-file-name (list localname))))))))
+ 'expand-file-name (list localname)))
+ hop)))))
;;; Remote commands:
@@ -2731,51 +2742,64 @@ the result will be a local, non-Tramp, filename."
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0))
- (unwind-protect
- (save-excursion
- (save-restriction
- (unless buffer
- ;; BUFFER can be nil. We use a temporary buffer.
- (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- (setq name name1)
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
- ;; Activate narrowing in order to save BUFFER contents.
- ;; Clear also the modification time; otherwise we might
- ;; be interrupted by `verify-visited-file-modtime'.
- (with-current-buffer (tramp-get-connection-buffer v)
- (let ((buffer-undo-list t))
+
+ (unless buffer
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ (setq name name1)
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification time;
+ ;; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (buffer-read-only nil)
+ (mark (point)))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
+ ;; We call `tramp-maybe-open-connection', in order
+ ;; to cleanup the prompt afterwards.
+ (tramp-maybe-open-connection v)
+ (widen)
+ (delete-region mark (point))
+ (narrow-to-region (point-max) (point-max))
+ ;; Now do it.
(if command
;; Send the command.
(tramp-send-command v command nil t) ; nooutput
;; Check, whether a pty is associated.
- (tramp-maybe-open-connection v)
(unless (tramp-compat-process-get
(tramp-get-connection-process v) 'remote-tty)
(tramp-error
v 'file-error
- "pty association is not supported for `%s'" name)))))
- (let ((p (tramp-get-connection-process v)))
- ;; Set query flag for this process.
- (tramp-compat-set-process-query-on-exit-flag p t)
- ;; Return process.
- p)))
- ;; Save exit.
- (with-current-buffer (tramp-get-connection-buffer v)
+ "pty association is not supported for `%s'" name))))
+ (let ((p (tramp-get-connection-process v)))
+ ;; Set query flag for this process. We ignore errors,
+ ;; because the process could have finished already.
+ (ignore-errors
+ (tramp-compat-set-process-query-on-exit-flag p t))
+ ;; Return process.
+ p)))
+
+ ;; Save exit.
(if (string-match tramp-temp-buffer-name (buffer-name))
(progn
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp)))
- (tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil)))))
+ (set-buffer-modified-p bmp))
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil))))))
(defun tramp-sh-handle-process-file
(program &optional infile destination display &rest args)
@@ -2923,7 +2947,7 @@ the result will be a local, non-Tramp, filename."
;; Use inline encoding for file transfer.
(rem-enc
(save-excursion
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 3 (format "Encoding remote file %s" filename)
(tramp-barf-unless-okay
v (format rem-enc (tramp-shell-quote-argument localname))
@@ -2937,7 +2961,7 @@ the result will be a local, non-Tramp, filename."
(with-temp-buffer
(set-buffer-multibyte nil)
(insert-buffer-substring (tramp-get-buffer v))
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 3 (format "Decoding remote file %s with function %s"
filename loc-dec)
(funcall loc-dec (point-min) (point-max))
@@ -2955,7 +2979,7 @@ the result will be a local, non-Tramp, filename."
(let (file-name-handler-alist
(coding-system-for-write 'binary))
(write-region (point-min) (point-max) tmpfile2))
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 3 (format "Decoding remote file %s with command %s"
filename loc-dec)
(unwind-protect
@@ -3084,22 +3108,25 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
'write-region
(list start end localname append 'no-message lockname confirm))
- (let ((modes (save-excursion (tramp-default-file-modes filename)))
- ;; We use this to save the value of
- ;; `last-coding-system-used' after writing the tmp
- ;; file. At the end of the function, we set
- ;; `last-coding-system-used' to this saved value. This
- ;; way, any intermediary coding systems used while
- ;; talking to the remote shell or suchlike won't hose
- ;; this variable. This approach was snarfed from
- ;; ange-ftp.el.
- coding-system-used
- ;; Write region into a tmp file. This isn't really
- ;; needed if we use an encoding function, but currently
- ;; we use it always because this makes the logic
- ;; simpler.
- (tmpfile (or tramp-temp-buffer-file-name
- (tramp-compat-make-temp-file filename))))
+ (let* ((modes (save-excursion (tramp-default-file-modes filename)))
+ ;; We use this to save the value of
+ ;; `last-coding-system-used' after writing the tmp
+ ;; file. At the end of the function, we set
+ ;; `last-coding-system-used' to this saved value. This
+ ;; way, any intermediary coding systems used while
+ ;; talking to the remote shell or suchlike won't hose
+ ;; this variable. This approach was snarfed from
+ ;; ange-ftp.el.
+ coding-system-used
+ ;; Write region into a tmp file. This isn't really
+ ;; needed if we use an encoding function, but currently
+ ;; we use it always because this makes the logic
+ ;; simpler. We must also set `temporary-file-directory',
+ ;; because it could point to a remote directory.
+ (temporary-file-directory
+ (tramp-compat-temporary-file-directory))
+ (tmpfile (or tramp-temp-buffer-file-name
+ (tramp-compat-make-temp-file filename))))
;; If `append' is non-nil, we copy the file locally, and let
;; the native `write-region' implementation do the job.
@@ -3180,7 +3207,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(set-buffer-multibyte nil)
;; Use encoding function or command.
(if (functionp loc-enc)
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 3 (format "Encoding region using function `%s'"
loc-enc)
(let ((coding-system-for-read 'binary))
@@ -3198,7 +3225,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(tramp-compat-temporary-file-directory)))
(funcall loc-enc (point-min) (point-max))))
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 3 (format "Encoding region using command `%s'"
loc-enc)
(unless (zerop (tramp-call-local-coding-command
@@ -3212,7 +3239,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
;; Send buffer into remote decoding command which
;; writes to remote file. Because this happens on
;; the remote host, we cannot use the function.
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 3
(format "Decoding region into remote file %s" filename)
(goto-char (point-max))
@@ -3275,14 +3302,14 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(let (last-coding-system-used (need-chown t))
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
- (let ((file-attr (file-attributes filename)))
+ (let ((file-attr (tramp-compat-file-attributes filename 'integer)))
(set-visited-file-modtime
;; We must pass modtime explicitly, because filename can
;; be different from (buffer-file-name), f.e. if
;; `file-precious-flag' is set.
(nth 5 file-attr))
- (when (and (eq (nth 2 file-attr) uid)
- (eq (nth 3 file-attr) gid))
+ (when (and (= (nth 2 file-attr) uid)
+ (= (nth 3 file-attr) gid))
(setq need-chown nil))))
;; Set the ownership.
@@ -3312,7 +3339,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
"Like `vc-registered' for Tramp files."
(tramp-compat-with-temp-message ""
(with-parsed-tramp-file-name file nil
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 3 (format "Checking `vc-registered' for %s" file)
;; There could be new files, created by the vc backend. We
@@ -3323,7 +3350,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
`((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
;; Here we collect only file names, which need an operation.
- (tramp-run-real-handler 'vc-registered (list file))
+ (ignore-errors (tramp-run-real-handler 'vc-registered (list file)))
(tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
;; Send just one command, in order to fill the cache.
@@ -3391,10 +3418,12 @@ Fall back to normal file name handler if no Tramp handler exists."
((and fn (memq operation '(file-exists-p file-readable-p)))
(add-to-list 'tramp-vc-registered-file-names localname 'append)
nil)
+ ;; `process-file' and `start-file-process' shall be ignored.
+ ((and fn (eq operation 'process-file) 0))
+ ((and fn (eq operation 'start-file-process) nil))
;; Tramp file name handlers like `expand-file-name'. They
;; must still work.
- (fn
- (save-match-data (apply (cdr fn) args)))
+ (fn (save-match-data (apply (cdr fn) args)))
;; Default file name handlers, we don't care.
(t (tramp-run-real-handler operation args)))))))
@@ -3408,7 +3437,7 @@ Only send the definition if it has not already been done."
(let ((scripts (tramp-get-connection-property
(tramp-get-connection-process vec) "scripts" nil)))
(unless (member name scripts)
- (tramp-with-progress-reporter vec 5 (format "Sending script `%s'" name)
+ (with-tramp-progress-reporter vec 5 (format "Sending script `%s'" name)
;; The script could contain a call of Perl. This is masked with `%s'.
(tramp-barf-unless-okay
vec
@@ -3547,33 +3576,37 @@ file exists and nonzero exit status otherwise."
;; `/usr/bin/test'.
;; `/usr/bin/test -e' In case `/bin/test' does not exist.
(unless (or
- (and (setq result (format "%s -e" (tramp-get-test-command vec)))
- (tramp-send-command-and-check
- vec (format "%s %s" result existing))
- (not (tramp-send-command-and-check
- vec (format "%s %s" result nonexistent))))
- (and (setq result "/bin/test -e")
- (tramp-send-command-and-check
- vec (format "%s %s" result existing))
- (not (tramp-send-command-and-check
- vec (format "%s %s" result nonexistent))))
- (and (setq result "/usr/bin/test -e")
- (tramp-send-command-and-check
- vec (format "%s %s" result existing))
- (not (tramp-send-command-and-check
- vec (format "%s %s" result nonexistent))))
- (and (setq result (format "%s -d" (tramp-get-ls-command vec)))
- (tramp-send-command-and-check
- vec (format "%s %s" result existing))
- (not (tramp-send-command-and-check
- vec (format "%s %s" result nonexistent)))))
+ (ignore-errors
+ (and (setq result (format "%s -e" (tramp-get-test-command vec)))
+ (tramp-send-command-and-check
+ vec (format "%s %s" result existing))
+ (not (tramp-send-command-and-check
+ vec (format "%s %s" result nonexistent)))))
+ (ignore-errors
+ (and (setq result "/bin/test -e")
+ (tramp-send-command-and-check
+ vec (format "%s %s" result existing))
+ (not (tramp-send-command-and-check
+ vec (format "%s %s" result nonexistent)))))
+ (ignore-errors
+ (and (setq result "/usr/bin/test -e")
+ (tramp-send-command-and-check
+ vec (format "%s %s" result existing))
+ (not (tramp-send-command-and-check
+ vec (format "%s %s" result nonexistent)))))
+ (ignore-errors
+ (and (setq result (format "%s -d" (tramp-get-ls-command vec)))
+ (tramp-send-command-and-check
+ vec (format "%s %s" result existing))
+ (not (tramp-send-command-and-check
+ vec (format "%s %s" result nonexistent))))))
(tramp-error
vec 'file-error "Couldn't find command to check if file exists"))
result))
(defun tramp-open-shell (vec shell)
"Opens shell SHELL."
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
vec 5 (format "Opening remote shell `%s'" shell)
;; Find arguments for this shell.
(let ((tramp-end-of-output tramp-initial-end-of-output)
@@ -3583,11 +3616,14 @@ file exists and nonzero exit status otherwise."
(setq item (pop alist))
(when (string-match (car item) shell)
(setq extra-args (cdr item))))
- (when extra-args (setq shell (concat shell " " extra-args)))
(tramp-send-command
- vec (format "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s"
- (tramp-shell-quote-argument tramp-end-of-output) shell)
+ vec (format
+ "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"
+ (tramp-shell-quote-argument tramp-end-of-output)
+ shell (or extra-args ""))
t))
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "remote-shell" shell)
;; Setting prompts.
(tramp-send-command
vec (format "PS1=%s" (tramp-shell-quote-argument tramp-end-of-output)) t)
@@ -3597,36 +3633,54 @@ file exists and nonzero exit status otherwise."
(defun tramp-find-shell (vec)
"Opens a shell on the remote host which groks tilde expansion."
- (unless (tramp-get-connection-property vec "remote-shell" nil)
- (let (shell)
- (with-current-buffer (tramp-get-buffer vec)
- (tramp-send-command vec "echo ~root" t)
- (cond
- ((or (string-match "^~root$" (buffer-string))
- ;; The default shell (ksh93) of OpenSolaris and Solaris
- ;; is buggy. We've got reports for "SunOS 5.10" and
- ;; "SunOS 5.11" so far.
- (string-match (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
- (tramp-get-connection-property vec "uname" "")))
- (setq shell
- (or (tramp-find-executable
- vec "bash" (tramp-get-remote-path vec) t t)
- (tramp-find-executable
- vec "ksh" (tramp-get-remote-path vec) t t)))
- (unless shell
- (tramp-error
- vec 'file-error
- "Couldn't find a shell which groks tilde expansion"))
- (tramp-message
- vec 5 "Starting remote shell `%s' for tilde expansion" shell)
- (tramp-open-shell vec shell))
+ (with-current-buffer (tramp-get-buffer vec)
+ (let ((default-shell
+ (or
+ (tramp-get-connection-property
+ (tramp-get-connection-process vec) "remote-shell" nil)
+ (tramp-get-method-parameter
+ (tramp-file-name-method vec) 'tramp-remote-shell)))
+ shell)
+ (setq shell
+ (with-tramp-connection-property vec "remote-shell"
+ ;; CCC: "root" does not exist always, see QNAP 459.
+ ;; Which check could we apply instead?
+ (tramp-send-command vec "echo ~root" t)
+ (if (or (string-match "^~root$" (buffer-string))
+ ;; The default shell (ksh93) of OpenSolaris and
+ ;; Solaris is buggy. We've got reports for
+ ;; "SunOS 5.10" and "SunOS 5.11" so far.
+ (string-match (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
+ (tramp-get-connection-property
+ vec "uname" "")))
+
+ (or (tramp-find-executable
+ vec "bash" (tramp-get-remote-path vec) t t)
+ (tramp-find-executable
+ vec "ksh" (tramp-get-remote-path vec) t t)
+ ;; Maybe it works at least for some other commands.
+ (prog1
+ default-shell
+ (tramp-message
+ vec 2
+ (concat
+ "Couldn't find a remote shell which groks tilde "
+ "expansion, using `%s'")
+ default-shell)))
+
+ default-shell)))
+
+ ;; Open a new shell if needed.
+ (unless (string-equal shell default-shell)
+ (tramp-message
+ vec 5 "Starting remote shell `%s' for tilde expansion" shell)
+ (tramp-open-shell vec shell))
- (t (tramp-message
- vec 5 "Remote `%s' groks tilde expansion, good"
- (tramp-set-connection-property
- vec "remote-shell"
- (tramp-get-method-parameter
- (tramp-file-name-method vec) 'tramp-remote-shell)))))))))
+ ;; Busyboxes tend to behave strange. We check for the existence.
+ (with-tramp-connection-property vec "busybox"
+ (tramp-send-command vec (format "%s --version" shell) t)
+ (let ((case-fold-search t))
+ (and (string-match "busybox" (buffer-string)) t))))))
;; Utility functions.
@@ -3662,8 +3716,9 @@ process to set up. VEC specifies the connection."
;; discarded as well.
(tramp-open-shell
vec
- (tramp-get-method-parameter
- (tramp-file-name-method vec) 'tramp-remote-shell))
+ (or (tramp-get-connection-property vec "remote-shell" nil)
+ (tramp-get-method-parameter
+ (tramp-file-name-method vec) 'tramp-remote-shell)))
;; Disable echo.
(tramp-message vec 5 "Setting up remote shell environment")
@@ -3734,21 +3789,12 @@ process to set up. VEC specifies the connection."
vec "uname"
(tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
(when (and (stringp old-uname) (not (string-equal old-uname new-uname)))
- (with-current-buffer (tramp-get-debug-buffer vec)
- ;; Keep the debug buffer.
- (rename-buffer
- (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
- (tramp-cleanup-connection vec)
- (if (= (point-min) (point-max))
- (kill-buffer nil)
- (rename-buffer (tramp-debug-buffer-name vec) 'unique))
- ;; We call `tramp-get-buffer' in order to keep the debug buffer.
- (tramp-get-buffer vec)
- (tramp-message
- vec 3
- "Connection reset, because remote host changed from `%s' to `%s'"
- old-uname new-uname)
- (throw 'uname-changed (tramp-maybe-open-connection vec)))))
+ (tramp-cleanup vec)
+ (tramp-message
+ vec 3
+ "Connection reset, because remote host changed from `%s' to `%s'"
+ old-uname new-uname)
+ (throw 'uname-changed (tramp-maybe-open-connection vec))))
;; Check whether the remote host suffers from buggy
;; `send-process-string'. This is known for FreeBSD (see comment in
@@ -3756,7 +3802,7 @@ process to set up. VEC specifies the connection."
;; successfully, sending 625 bytes failed. Emacs makes a hack when
;; this host type is detected locally. It cannot handle remote
;; hosts, though.
- (with-connection-property proc "chunksize"
+ (with-tramp-connection-property proc "chunksize"
(cond
((and (integerp tramp-chunksize) (> tramp-chunksize 0))
tramp-chunksize)
@@ -3771,7 +3817,7 @@ process to set up. VEC specifies the connection."
(tramp-set-remote-path vec)
;; Search for a good shell before searching for a command which
- ;; checks if a file exists. This is done because Tramp wants to use
+ ;; checks if a file exists. This is done because Tramp wants to use
;; "test foo; echo $?" to check if various conditions hold, and
;; there are buggy /bin/sh implementations which don't execute the
;; "echo $?" part if the "test" part has an error. In particular,
@@ -3878,7 +3924,7 @@ with the encoded or decoded results, respectively.")
(b64 "recode data..base64" "recode base64..data")
(b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
(b64 tramp-perl-encode tramp-perl-decode)
- (uu "uuencode xxx" "uudecode -o /dev/stdout")
+ (uu "uuencode xxx" "uudecode -o /dev/stdout" "test -c /dev/stdout")
(uu "uuencode xxx" "uudecode -o -")
(uu "uuencode xxx" "uudecode -p")
(uu "uuencode xxx" tramp-uudecode)
@@ -3888,7 +3934,7 @@ with the encoded or decoded results, respectively.")
"List of remote coding commands for inline transfer.
Each item is a list that looks like this:
-\(FORMAT ENCODING DECODING\)
+\(FORMAT ENCODING DECODING [TEST]\)
FORMAT is symbol describing the encoding/decoding format. It can be
`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
@@ -3902,7 +3948,10 @@ input.
If they are variables, this variable is a string containing a Perl
implementation for this functionality. This Perl program will be transferred
-to the remote host, and it is available as shell function with the same name.")
+to the remote host, and it is available as shell function with the same name.
+
+The optional TEST command can be used for further tests, whether
+ENCODING and DECODING are applicable.")
(defun tramp-find-inline-encoding (vec)
"Find an inline transfer encoding that works.
@@ -3911,7 +3960,8 @@ Goes through the list `tramp-local-coding-commands' and
(save-excursion
(let ((local-commands tramp-local-coding-commands)
(magic "xyzzy")
- loc-enc loc-dec rem-enc rem-dec litem ritem found)
+ (p (tramp-get-connection-process vec))
+ loc-enc loc-dec rem-enc rem-dec rem-test litem ritem found)
(while (and local-commands (not found))
(setq litem (pop local-commands))
(catch 'wont-work-local
@@ -3944,6 +3994,13 @@ Goes through the list `tramp-local-coding-commands' and
(when (equal format (nth 0 ritem))
(setq rem-enc (nth 1 ritem))
(setq rem-dec (nth 2 ritem))
+ (setq rem-test (nth 3 ritem))
+ ;; Check the remote test command if exists.
+ (when (stringp rem-test)
+ (tramp-message
+ vec 5 "Checking remote test command `%s'" rem-test)
+ (unless (tramp-send-command-and-check vec rem-test t)
+ (throw 'wont-work-remote nil)))
;; Check if remote encoding and decoding commands can be
;; called remotely with null input and output. This makes
;; sure there are no syntax errors and the command is really
@@ -3995,15 +4052,16 @@ Goes through the list `tramp-local-coding-commands' and
(tramp-error
vec 'file-error "Couldn't find an inline transfer encoding"))
- ;; Set connection properties.
+ ;; Set connection properties. Since the commands are risky (due
+ ;; to output direction), we cache them in the process cache.
(tramp-message vec 5 "Using local encoding `%s'" loc-enc)
- (tramp-set-connection-property vec "local-encoding" loc-enc)
+ (tramp-set-connection-property p "local-encoding" loc-enc)
(tramp-message vec 5 "Using local decoding `%s'" loc-dec)
- (tramp-set-connection-property vec "local-decoding" loc-dec)
+ (tramp-set-connection-property p "local-decoding" loc-dec)
(tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
- (tramp-set-connection-property vec "remote-encoding" rem-enc)
+ (tramp-set-connection-property p "remote-encoding" rem-enc)
(tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
- (tramp-set-connection-property vec "remote-decoding" rem-dec))))
+ (tramp-set-connection-property p "remote-decoding" rem-dec))))
(defun tramp-call-local-coding-command (cmd input output)
"Call the local encoding or decoding command.
@@ -4041,8 +4099,8 @@ Goes through the list `tramp-inline-compress-commands'."
(save-excursion
(let ((commands tramp-inline-compress-commands)
(magic "xyzzy")
- item compress decompress
- found)
+ (p (tramp-get-connection-process vec))
+ item compress decompress found)
(while (and commands (not found))
(catch 'next
(setq item (pop commands)
@@ -4076,16 +4134,18 @@ Goes through the list `tramp-inline-compress-commands'."
;; Did we find something?
(if found
(progn
- ;; Set connection properties.
+ ;; Set connection properties. Since the commands are
+ ;; risky (due to output direction), we cache them in the
+ ;; process cache.
(tramp-message
vec 5 "Using inline transfer compress command `%s'" compress)
- (tramp-set-connection-property vec "inline-compress" compress)
+ (tramp-set-connection-property p "inline-compress" compress)
(tramp-message
vec 5 "Using inline transfer decompress command `%s'" decompress)
- (tramp-set-connection-property vec "inline-decompress" decompress))
+ (tramp-set-connection-property p "inline-decompress" decompress))
- (tramp-set-connection-property vec "inline-compress" nil)
- (tramp-set-connection-property vec "inline-decompress" nil)
+ (tramp-set-connection-property p "inline-compress" nil)
+ (tramp-set-connection-property p "inline-decompress" nil)
(tramp-message
vec 2 "Couldn't find an inline transfer compress command")))))
@@ -4093,18 +4153,43 @@ Goes through the list `tramp-inline-compress-commands'."
"Expands VEC according to `tramp-default-proxies-alist'.
Gateway hops are already opened."
(let ((target-alist `(,vec))
- (choices tramp-default-proxies-alist)
- item proxy)
+ (hops (or (tramp-file-name-hop vec) ""))
+ (item vec)
+ choices proxy)
+
+ ;; Ad-hoc proxy definitions.
+ (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
+ (let ((user (tramp-file-name-user item))
+ (host (tramp-file-name-host item))
+ (proxy (concat
+ tramp-prefix-format proxy tramp-postfix-host-format)))
+ (tramp-message
+ vec 5 "Add proxy (\"%s\" \"%s\" \"%s\")"
+ (and (stringp host) (regexp-quote host))
+ (and (stringp user) (regexp-quote user))
+ proxy)
+ ;; Add the hop.
+ (add-to-list
+ 'tramp-default-proxies-alist
+ (list (and (stringp host) (regexp-quote host))
+ (and (stringp user) (regexp-quote user))
+ proxy))
+ (setq item (tramp-dissect-file-name proxy))))
+ ;; Save the new value.
+ (when (and hops tramp-save-ad-hoc-proxies)
+ (customize-save-variable
+ 'tramp-default-proxies-alist tramp-default-proxies-alist))
;; Look for proxy hosts to be passed.
+ (setq choices tramp-default-proxies-alist)
(while choices
(setq item (pop choices)
proxy (eval (nth 2 item)))
(when (and
- ;; host
+ ;; Host.
(string-match (or (eval (nth 0 item)) "")
(or (tramp-file-name-host (car target-alist)) ""))
- ;; user
+ ;; User.
(string-match (or (eval (nth 1 item)) "")
(or (tramp-file-name-user (car target-alist)) "")))
(if (null proxy)
@@ -4140,7 +4225,7 @@ Gateway hops are already opened."
'target-alist
(vector
(tramp-file-name-method hop) (tramp-file-name-user hop)
- (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil))
+ (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil))
;; For the password prompt, we need the correct values.
;; Therefore, we must remember the gateway vector. But we
;; cannot do it as connection property, because it shouldn't
@@ -4188,6 +4273,9 @@ Gateway hops are already opened."
;; Result.
target-alist))
+(defvar tramp-current-connection nil
+ "Last connection timestamp.")
+
(defun tramp-maybe-open-connection (vec)
"Maybe open a connection VEC.
Does not do anything if a connection is already open, but re-opens the
@@ -4198,6 +4286,16 @@ connection if a previous connection has died for some reason."
(process-environment (copy-sequence process-environment))
(pos (with-current-buffer (tramp-get-connection-buffer vec) (point))))
+ ;; If Tramp opens the same connection within a short time frame,
+ ;; there is a problem. We shall signal this.
+ (unless (or (and p (processp p) (memq (process-status p) '(run open)))
+ (not (equal (butlast (append vec nil))
+ (car tramp-current-connection)))
+ (> (tramp-time-diff
+ (current-time) (cdr tramp-current-connection))
+ 5))
+ (throw 'suppress 'suppress))
+
;; If too much time has passed since last command was sent, look
;; whether process is still alive. If it isn't, kill it. When
;; using ssh, it can sometimes happen that the remote end has
@@ -4218,9 +4316,7 @@ connection if a previous connection has died for some reason."
;; The error will be caught locally.
(tramp-error vec 'file-error "Awake did fail")))
(file-error
- (tramp-flush-connection-property vec)
- (tramp-flush-connection-property p)
- (delete-process p)
+ (tramp-cleanup vec)
(setq p nil)))
;; New connection must be opened.
@@ -4230,7 +4326,12 @@ connection if a previous connection has died for some reason."
;; We call `tramp-get-buffer' in order to get a debug
;; buffer for messages from the beginning.
(tramp-get-buffer vec)
- (tramp-with-progress-reporter
+
+ ;; If `non-essential' is non-nil, don't reopen a new connection.
+ (when (and (boundp 'non-essential) (symbol-value 'non-essential))
+ (throw 'non-essential 'non-essential))
+
+ (with-tramp-progress-reporter
vec 3
(if (zerop (length (tramp-file-name-user vec)))
(format "Opening connection for %s using %s"
@@ -4269,6 +4370,9 @@ connection if a previous connection has died for some reason."
(tramp-set-connection-property p "vector" vec)
(set-process-sentinel p 'tramp-process-sentinel)
(tramp-compat-set-process-query-on-exit-flag p nil)
+ (setq tramp-current-connection
+ (cons (butlast (append vec nil)) (current-time))
+ tramp-current-host (system-name))
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
@@ -4315,7 +4419,7 @@ connection if a previous connection has died for some reason."
(expand-file-name
tramp-temp-name-prefix
(tramp-compat-temporary-file-directory)))))
- spec)
+ spec r-shell)
;; Add arguments for asynchronous processes.
(when (and process-name async-args)
@@ -4331,6 +4435,11 @@ connection if a previous connection has died for some reason."
(setq l-port (match-string 2 l-host)
l-host (match-string 1 l-host)))
+ ;; Check, whether there is a restricted shell.
+ (dolist (elt tramp-restricted-shell-hosts-alist)
+ (when (string-match elt tramp-current-host)
+ (setq r-shell t)))
+
;; Set variables for computing the prompt for
;; reading password. They can also be derived
;; from a gateway.
@@ -4349,7 +4458,7 @@ connection if a previous connection has died for some reason."
(concat
;; We do not want to see the trailing local
;; prompt in `start-file-process'.
- (unless (memq system-type '(windows-nt)) "exec ")
+ (unless r-shell "exec ")
command " "
(mapconcat
(lambda (x)
@@ -4358,9 +4467,10 @@ connection if a previous connection has died for some reason."
login-args " ")
;; Local shell could be a Windows COMSPEC. It
;; doesn't know the ";" syntax, but we must exit
- ;; always for `start-file-process'. "exec" does
- ;; not work either.
- (if (memq system-type '(windows-nt)) " && exit || exit")))
+ ;; always for `start-file-process'. It could
+ ;; also be a restricted shell, which does not
+ ;; allow "exec".
+ (when r-shell " && exit || exit")))
;; Send the command.
(tramp-message vec 3 "Sending command `%s'" command)
@@ -4377,11 +4487,7 @@ connection if a previous connection has died for some reason."
;; When the user did interrupt, we must cleanup.
(quit
- (let ((p (tramp-get-connection-process vec)))
- (when (and p (processp p))
- (tramp-flush-connection-property vec)
- (tramp-flush-connection-property p)
- (delete-process p)))
+ (tramp-cleanup vec)
;; Propagate the quit signal.
(signal (car err) (cdr err)))))))
@@ -4397,7 +4503,8 @@ function waits for output unless NOOUTPUT is set."
;; We mark the command string that it can be erased in the output buffer.
(tramp-set-connection-property p "check-remote-echo" t)
(setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark)))
- (when (string-match "<<'EOF'" command)
+ (when (and (string-match "<<'EOF'" command)
+ (not (tramp-get-connection-property vec "busybox" nil)))
;; Unset $PS1 when using here documents, in order to avoid
;; multiple prompts.
(setq command (concat "(PS1= ; " command "\n)")))
@@ -4670,7 +4777,7 @@ This is used internally by `tramp-file-mode-from-int'."
;; Variables local to connection.
(defun tramp-get-remote-path (vec)
- (with-connection-property
+ (with-tramp-connection-property
;; When `tramp-own-remote-path' is in `tramp-remote-path', we
;; cache the result for the session only. Otherwise, the result
;; is cached persistently.
@@ -4742,7 +4849,7 @@ This is used internally by `tramp-file-mode-from-int'."
remote-path)))))
(defun tramp-get-ls-command (vec)
- (with-connection-property vec "ls"
+ (with-tramp-connection-property vec "ls"
(tramp-message vec 5 "Finding a suitable `ls' command")
(or
(catch 'ls-found
@@ -4768,7 +4875,7 @@ This is used internally by `tramp-file-mode-from-int'."
(defun tramp-get-ls-command-with-dired (vec)
(save-match-data
- (with-connection-property vec "ls-dired"
+ (with-tramp-connection-property vec "ls-dired"
(tramp-message vec 5 "Checking, whether `ls --dired' works")
;; Some "ls" versions are sensible wrt the order of arguments,
;; they fail when "-al" is after the "--dired" argument (for
@@ -4777,7 +4884,7 @@ This is used internally by `tramp-file-mode-from-int'."
vec (format "%s --dired -al /dev/null" (tramp-get-ls-command vec))))))
(defun tramp-get-test-command (vec)
- (with-connection-property vec "test"
+ (with-tramp-connection-property vec "test"
(tramp-message vec 5 "Finding a suitable `test' command")
(if (tramp-send-command-and-check vec "test 0")
"test"
@@ -4787,7 +4894,7 @@ This is used internally by `tramp-file-mode-from-int'."
;; Does `test A -nt B' work? Use abominable `find' construct if it
;; doesn't. BSD/OS 4.0 wants the parentheses around the command,
;; for otherwise the shell crashes.
- (with-connection-property vec "test-nt"
+ (with-tramp-connection-property vec "test-nt"
(or
(progn
(tramp-send-command
@@ -4805,17 +4912,17 @@ This is used internally by `tramp-file-mode-from-int'."
"tramp_test_nt %s %s"))))
(defun tramp-get-file-exists-command (vec)
- (with-connection-property vec "file-exists"
+ (with-tramp-connection-property vec "file-exists"
(tramp-message vec 5 "Finding command to check if file exists")
(tramp-find-file-exists-command vec)))
(defun tramp-get-remote-ln (vec)
- (with-connection-property vec "ln"
+ (with-tramp-connection-property vec "ln"
(tramp-message vec 5 "Finding a suitable `ln' command")
(tramp-find-executable vec "ln" (tramp-get-remote-path vec))))
(defun tramp-get-remote-perl (vec)
- (with-connection-property vec "perl"
+ (with-tramp-connection-property vec "perl"
(tramp-message vec 5 "Finding a suitable `perl' command")
(let ((result
(or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
@@ -4823,16 +4930,16 @@ This is used internally by `tramp-file-mode-from-int'."
vec "perl" (tramp-get-remote-path vec)))))
;; We must check also for some Perl modules.
(when result
- (with-connection-property vec "perl-file-spec"
+ (with-tramp-connection-property vec "perl-file-spec"
(tramp-send-command-and-check
vec (format "%s -e 'use File::Spec;'" result)))
- (with-connection-property vec "perl-cwd-realpath"
+ (with-tramp-connection-property vec "perl-cwd-realpath"
(tramp-send-command-and-check
vec (format "%s -e 'use Cwd \"realpath\";'" result))))
result)))
(defun tramp-get-remote-stat (vec)
- (with-connection-property vec "stat"
+ (with-tramp-connection-property vec "stat"
(tramp-message vec 5 "Finding a suitable `stat' command")
(let ((result (tramp-find-executable
vec "stat" (tramp-get-remote-path vec)))
@@ -4850,7 +4957,7 @@ This is used internally by `tramp-file-mode-from-int'."
result)))
(defun tramp-get-remote-readlink (vec)
- (with-connection-property vec "readlink"
+ (with-tramp-connection-property vec "readlink"
(tramp-message vec 5 "Finding a suitable `readlink' command")
(let ((result (tramp-find-executable
vec "readlink" (tramp-get-remote-path vec))))
@@ -4860,12 +4967,12 @@ This is used internally by `tramp-file-mode-from-int'."
result))))
(defun tramp-get-remote-trash (vec)
- (with-connection-property vec "trash"
+ (with-tramp-connection-property vec "trash"
(tramp-message vec 5 "Finding a suitable `trash' command")
(tramp-find-executable vec "trash" (tramp-get-remote-path vec))))
(defun tramp-get-remote-id (vec)
- (with-connection-property vec "id"
+ (with-tramp-connection-property vec "id"
(tramp-message vec 5 "Finding POSIX `id' command")
(or
(catch 'id-found
@@ -4879,7 +4986,7 @@ This is used internally by `tramp-file-mode-from-int'."
(tramp-error vec 'file-error "Couldn't find a POSIX `id' command"))))
(defun tramp-get-remote-uid (vec id-format)
- (with-connection-property vec (format "uid-%s" id-format)
+ (with-tramp-connection-property vec (format "uid-%s" id-format)
(let ((res (tramp-send-command-and-read
vec
(format "%s -u%s %s"
@@ -4891,7 +4998,7 @@ This is used internally by `tramp-file-mode-from-int'."
(if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
(defun tramp-get-remote-gid (vec id-format)
- (with-connection-property vec (format "gid-%s" id-format)
+ (with-tramp-connection-property vec (format "gid-%s" id-format)
(let ((res (tramp-send-command-and-read
vec
(format "%s -g%s %s"
@@ -4917,9 +5024,10 @@ the length of the file to be compressed.
If no corresponding command is found, nil is returned."
(when (and (integerp tramp-inline-compress-start-size)
(> size tramp-inline-compress-start-size))
- (with-connection-property vec prop
+ (with-tramp-connection-property (tramp-get-connection-process vec) prop
(tramp-find-inline-compress vec)
- (tramp-get-connection-property vec prop nil))))
+ (tramp-get-connection-property
+ (tramp-get-connection-process vec) prop nil))))
(defun tramp-get-inline-coding (vec prop size)
"Return the coding command related to PROP.
@@ -4937,9 +5045,11 @@ function cell is returned to be applied on a buffer."
;; no inline coding is found.
(ignore-errors
(let ((coding
- (with-connection-property vec prop
+ (with-tramp-connection-property
+ (tramp-get-connection-process vec) prop
(tramp-find-inline-encoding vec)
- (tramp-get-connection-property vec prop nil)))
+ (tramp-get-connection-property
+ (tramp-get-connection-process vec) prop nil)))
(prop1 (if (string-match "encoding" prop)
"inline-compress" "inline-decompress"))
compress)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 73b9339e25a..f52129919cc 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1,6 +1,6 @@
;;; tramp-smb.el --- Tramp access functions for SMB servers
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -33,7 +33,7 @@
;; Define SMB method ...
;;;###tramp-autoload
(defconst tramp-smb-method "smb"
- "*Method to connect SAMBA and M$ SMB servers.")
+ "Method to connect SAMBA and M$ SMB servers.")
;; ... and add it to the method list.
;;;###tramp-autoload
@@ -43,7 +43,7 @@
;; We define an empty command, because `tramp-smb-call-winexe'
;; opens already the powershell. Used in `tramp-handle-shell-command'.
(tramp-remote-shell "")
- ;; This is just a guess. We don't know whether the share "$C"
+ ;; This is just a guess. We don't know whether the share "C$"
;; is available for public use, and whether the user has write
;; access.
(tramp-tmpdir "/C$/Temp"))))
@@ -68,22 +68,32 @@
'((tramp-parse-netrc "~/.netrc"))))
(defcustom tramp-smb-program "smbclient"
- "*Name of SMB client to run."
+ "Name of SMB client to run."
:group 'tramp
:type 'string)
(defcustom tramp-smb-conf "/dev/null"
- "*Path of the smb.conf file.
+ "Path of the smb.conf file.
If it is nil, no smb.conf will be added to the `tramp-smb-program'
call, letting the SMB client use the default one."
:group 'tramp
:type '(choice (const nil) (file :must-match t)))
(defvar tramp-smb-version nil
- "*Version string of the SMB client.")
+ "Version string of the SMB client.")
-(defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$"
- "Regexp used as prompt in smbclient.")
+(defconst tramp-smb-server-version
+ "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]"
+ "Regexp of SMB server identification.")
+
+(defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$"
+ "Regexp used as prompt in smbclient or powershell.")
+
+(defconst tramp-smb-wrong-passwd-regexp
+ (regexp-opt
+ '("NT_STATUS_LOGON_FAILURE"
+ "NT_STATUS_WRONG_PASSWORD"))
+ "Regexp for login error strings of SMB servers.")
(defconst tramp-smb-errors
(mapconcat
@@ -155,6 +165,16 @@ This list is used for login to SMB servers.
See `tramp-actions-before-shell' for more info.")
+(defconst tramp-smb-actions-with-tar
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-smb-action-with-tar))
+ "List of pattern/action pairs.
+This list is used for tar-like copy of directories.
+
+See `tramp-actions-before-shell' for more info.")
+
;; New handlers should be added here.
(defconst tramp-smb-file-name-handler-alist
'(
@@ -205,12 +225,14 @@ See `tramp-actions-before-shell' for more info.")
(make-directory . tramp-smb-handle-make-directory)
(make-directory-internal . tramp-smb-handle-make-directory-internal)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
+ (process-file . tramp-smb-handle-process-file)
(rename-file . tramp-smb-handle-rename-file)
(set-file-modes . tramp-smb-handle-set-file-modes)
;; `set-file-selinux-context' performed by default handler.
(set-file-times . ignore)
(set-visited-file-modtime . ignore)
- (shell-command . ignore)
+ (shell-command . tramp-handle-shell-command)
+ (start-file-process . tramp-smb-handle-start-file-process)
(substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(vc-registered . ignore)
@@ -220,11 +242,34 @@ See `tramp-actions-before-shell' for more info.")
"Alist of handler functions for Tramp SMB method.
Operations not mentioned here will be handled by the default Emacs primitives.")
+;; Options for remote processes via winexe.
+(defcustom tramp-smb-winexe-program "winexe"
+ "Name of winexe client to run.
+If it isn't found in the local $PATH, the absolute path of winexe
+shall be given. This is needed for remote processes."
+ :group 'tramp
+ :type 'string
+ :version "24.3")
+
+(defcustom tramp-smb-winexe-shell-command "powershell.exe"
+ "Shell to be used for processes on remote machines.
+This must be Powershell V2 compatible."
+ :group 'tramp
+ :type 'string
+ :version "24.3")
+
+(defcustom tramp-smb-winexe-shell-command-switch "-file -"
+ "Command switch used together with `tramp-smb-winexe-shell-command'.
+This can be used to disable echo etc."
+ :group 'tramp
+ :type 'string
+ :version "24.3")
+
;;;###tramp-autoload
(defsubst tramp-smb-file-name-p (filename)
"Check if it's a filename for SMB servers."
- (let ((v (tramp-dissect-file-name filename)))
- (string= (tramp-file-name-method v) tramp-smb-method)))
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-smb-method))
;;;###tramp-autoload
(defun tramp-smb-file-name-handler (operation &rest args)
@@ -287,14 +332,31 @@ pass to the OPERATION."
"error with add-name-to-file, see buffer `%s' for details"
(buffer-name))))))
+(defun tramp-smb-action-with-tar (proc vec)
+ "Untar from connection buffer."
+ (if (not (memq (process-status proc) '(run open)))
+ (throw 'tramp-action 'process-died)
+
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (when (search-forward-regexp tramp-smb-server-version nil t)
+ ;; There might be a hidden password prompt.
+ (widen)
+ (forward-line)
+ (tramp-message vec 6 (buffer-substring (point-min) (point)))
+ (delete-region (point-min) (point))
+ (throw 'tramp-action 'ok)))))
+
(defun tramp-smb-handle-copy-directory
- (dirname newname &optional keep-date parents)
- "Like `copy-directory' for Tramp files. KEEP-DATE is not handled."
+ (dirname newname &optional keep-date parents copy-contents)
+ "Like `copy-directory' for Tramp files."
(setq dirname (expand-file-name dirname)
newname (expand-file-name newname))
(let ((t1 (tramp-tramp-file-p dirname))
(t2 (tramp-tramp-file-p newname)))
(with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" dirname newname)
(cond
;; We must use a local temporary directory.
((and t1 t2)
@@ -311,87 +373,165 @@ pass to the OPERATION."
;; We can copy recursively.
((or t1 t2)
- (let ((prompt (tramp-smb-send-command v "prompt"))
- (recurse (tramp-smb-send-command v "recurse")))
- (unless (file-directory-p newname)
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname))
+ (if t2 (setq v (tramp-dissect-file-name newname))))
+ (if (not (file-directory-p newname))
(make-directory newname parents))
+
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-real-host v))
+
+ (let* ((real-user (tramp-file-name-real-user v))
+ (real-host (tramp-file-name-real-host v))
+ (domain (tramp-file-name-domain v))
+ (port (tramp-file-name-port v))
+ (share (tramp-smb-get-share v))
+ (localname (file-name-as-directory
+ (replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v))))
+ (tmpdir (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory))))
+ (args (list tramp-smb-program
+ (concat "//" real-host "/" share) "-E")))
+
+ (if (not (zerop (length real-user)))
+ (setq args (append args (list "-U" real-user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq args
+ (if t1
+ ;; Source is remote.
+ (append args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qc - *")
+ "|" "tar" "xfC" "-"
+ (shell-quote-argument tmpdir)))
+ ;; Target is remote.
+ (append (list "tar" "cfC" "-" (shell-quote-argument dirname)
+ "." "|")
+ args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qx -")))))
+
(unwind-protect
- (unless
- (and
- prompt recurse
- (tramp-smb-send-command
- v (format "cd \"%s\"" (tramp-smb-get-localname v)))
- (tramp-smb-send-command
- v (format "lcd \"%s\"" (if t1 newname dirname)))
- (if t1
- (tramp-smb-send-command v "mget *")
- (tramp-smb-send-command v "mput *")))
- ;; Error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (search-forward-regexp tramp-smb-errors nil t)
- (tramp-error
- v 'file-error
- "%s `%s'" (match-string 0) (if t1 dirname newname))))
- ;; Go home.
- (tramp-smb-send-command
- v (format
- "cd %s" (if (tramp-smb-get-cifs-capabilities v) "/" "\\")))
- ;; Toggle prompt and recurse OFF.
- (if prompt (tramp-smb-send-command v "prompt"))
- (if recurse (tramp-smb-send-command v "recurse")))))
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ (when t1
+ ;; The smbclient tar command creates always complete
+ ;; paths. We must emulate the directory structure,
+ ;; and symlink to the real target.
+ (make-directory
+ (expand-file-name ".." (concat tmpdir localname)) 'parents)
+ (make-symbolic-link
+ newname (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By this, password
+ ;; can be handled.
+ (let* ((default-directory tmpdir)
+ (p (start-process-shell-command
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ (mapconcat 'identity args " "))))
+
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-with-tar)
+
+ (while (memq (process-status p) '(run open))
+ (sit-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string))))
+
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)
+ (when t1 (delete-directory tmpdir 'recurse))))
+
+ ;; Handle KEEP-DATE argument.
+ (when keep-date
+ (set-file-times newname (nth 5 (file-attributes dirname))))
+
+ ;; Set the mode.
+ (unless keep-date
+ (set-file-modes newname (tramp-default-file-modes dirname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname))))
;; We must do it file-wise.
(t
(tramp-run-real-handler
- 'copy-directory (list dirname newname keep-date parents)))))))
+ 'copy-directory (list dirname newname keep-date parents))))))))
(defun tramp-smb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-selinux-context)
"Like `copy-file' for Tramp files.
-KEEP-DATE is not handled in case NEWNAME resides on an SMB server.
+KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
(tramp-dissect-file-name (if (file-remote-p filename) filename newname))
0 (format "Copying %s to %s" filename newname)
- (let ((tmpfile (file-local-copy filename)))
-
- (if tmpfile
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
- (when (file-directory-p newname)
- (setq newname
- (expand-file-name (file-name-nondirectory filename) newname)))
-
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)
- (unless (tramp-smb-get-share v)
- (tramp-error
- v 'file-error "Target `%s' must contain a share name" newname))
- (unless (tramp-smb-send-command
- v (format "put \"%s\" \"%s\""
- filename (tramp-smb-get-localname v)))
- (tramp-error v 'file-error "Cannot copy `%s'" filename))))))
+ (if (file-directory-p filename)
+ (tramp-compat-copy-directory filename newname keep-date t t)
+
+ (let ((tmpfile (file-local-copy filename)))
+ (if tmpfile
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Remote newname.
+ (when (file-directory-p newname)
+ (setq newname
+ (expand-file-name (file-name-nondirectory filename) newname)))
+
+ (with-parsed-tramp-file-name newname nil
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)
+ (unless (tramp-smb-get-share v)
+ (tramp-error
+ v 'file-error "Target `%s' must contain a share name" newname))
+ (unless (tramp-smb-send-command
+ v (format "put \"%s\" \"%s\""
+ filename (tramp-smb-get-localname v)))
+ (tramp-error v 'file-error "Cannot copy `%s'" filename))))))
- ;; KEEP-DATE handling.
- (when keep-date (set-file-times newname (nth 5 (file-attributes filename)))))
+ ;; KEEP-DATE handling.
+ (when keep-date
+ (set-file-times newname (nth 5 (file-attributes filename))))))
(defun tramp-smb-handle-delete-directory (directory &optional recursive)
"Like `delete-directory' for Tramp files."
@@ -502,7 +642,8 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
(unless id-format (setq id-format 'integer))
(ignore-errors
(with-parsed-tramp-file-name filename nil
- (with-file-property v localname (format "file-attributes-%s" id-format)
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
(if (and (tramp-smb-get-share v) (tramp-smb-get-stat-capability v))
(tramp-smb-do-file-attributes-with-stat v id-format)
;; Reading just the filename entry via "dir localname" is not
@@ -539,7 +680,7 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
"Implement `file-attributes' for Tramp files using stat command."
(tramp-message
vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
- (with-current-buffer (tramp-get-buffer vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
(let* (size id link uid gid atime mtime ctime mode inode)
(when (tramp-smb-send-command
vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
@@ -613,7 +754,7 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
v 'file-error
"Cannot make local copy of non-existing file `%s'" filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
(unless (tramp-smb-send-command
v (format "get \"%s\" \"%s\""
@@ -631,7 +772,7 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
(all-completions
filename
(with-parsed-tramp-file-name directory nil
- (with-file-property v localname "file-name-all-completions"
+ (with-tramp-file-property v localname "file-name-all-completions"
(save-match-data
(let ((entries (tramp-smb-get-file-entries directory)))
(mapcar
@@ -845,44 +986,170 @@ target of the symlink differ."
"error with make-symbolic-link, see buffer `%s' for details"
(buffer-name))))))
+(defun tramp-smb-handle-process-file
+ (program &optional infile destination display &rest args)
+ "Like `process-file' for Tramp files."
+ ;; The implementation is not complete yet.
+ (when (and (numberp destination) (zerop destination))
+ (error "Implementation does not handle immediate return"))
+
+ (with-parsed-tramp-file-name default-directory nil
+ (let* ((name (file-name-nondirectory program))
+ (name1 name)
+ (i 0)
+ input tmpinput outbuf command ret)
+
+ ;; Determine input.
+ (when infile
+ (setq infile (expand-file-name infile))
+ (if (tramp-equal-remote default-directory infile)
+ ;; INFILE is on the same remote host.
+ (setq input (with-parsed-tramp-file-name infile nil localname))
+ ;; INFILE must be copied to remote host.
+ (setq input (tramp-make-tramp-temp-file v)
+ tmpinput (tramp-make-tramp-file-name method user host input))
+ (copy-file infile tmpinput t))
+ ;; Transform input into a filename powershell does understand.
+ (setq input (format "//%s%s" host input)))
+
+ ;; Determine output.
+ (cond
+ ;; Just a buffer.
+ ((bufferp destination)
+ (setq outbuf destination))
+ ;; A buffer name.
+ ((stringp destination)
+ (setq outbuf (get-buffer-create destination)))
+ ;; (REAL-DESTINATION ERROR-DESTINATION)
+ ((consp destination)
+ ;; output.
+ (cond
+ ((bufferp (car destination))
+ (setq outbuf (car destination)))
+ ((stringp (car destination))
+ (setq outbuf (get-buffer-create (car destination))))
+ ((car destination)
+ (setq outbuf (current-buffer))))
+ ;; stderr.
+ (tramp-message v 2 "%s" "STDERR not supported"))
+ ;; 't
+ (destination
+ (setq outbuf (current-buffer))))
+
+ ;; Construct command.
+ (setq command (mapconcat 'identity (cons program args) " ")
+ command (if input
+ (format
+ "get-content %s | & %s"
+ (tramp-smb-shell-quote-argument input) command)
+ (format "& %s" command)))
+
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property
+ v "process-buffer"
+ (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
+
+ ;; Call it.
+ (condition-case nil
+ (with-current-buffer (tramp-get-connection-buffer v)
+ ;; Preserve buffer contents.
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format "cd \"//%s%s\"" host (file-name-directory localname))))
+ (tramp-smb-send-command v command)
+ ;; Preserve command output.
+ (narrow-to-region (point-max) (point-max))
+ (let ((p (tramp-get-connection-process v)))
+ (tramp-smb-send-command v "exit $lasterrorcode")
+ (while (memq (process-status p) '(run open))
+ (sleep-for 0.1)
+ (setq ret (process-exit-status p))))
+ (delete-region (point-min) (point-max))
+ (widen))
+
+ ;; When the user did interrupt, we should do it also. We use
+ ;; return code -1 as marker.
+ (quit
+ (setq ret -1))
+ ;; Handle errors.
+ (error
+ (setq ret 1)))
+
+ ;; We should show the output anyway.
+ (when (and outbuf display) (display-buffer outbuf))
+
+ ;; Cleanup. We remove all file cache values for the connection,
+ ;; because the remote process could have changed them.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)
+ (when tmpinput (delete-file tmpinput))
+ (unless outbuf
+ (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
+
+ ;; `process-file-side-effects' has been introduced with GNU
+ ;; Emacs 23.2. If set to `nil', no remote file will be changed
+ ;; by `program'. If it doesn't exist, we assume its default
+ ;; value `t'.
+ (unless (and (boundp 'process-file-side-effects)
+ (not (symbol-value 'process-file-side-effects)))
+ (tramp-flush-directory-property v ""))
+
+ ;; Return exit status.
+ (if (equal ret -1)
+ (keyboard-quit)
+ ret))))
+
(defun tramp-smb-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
- (tramp-with-progress-reporter
+
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error
+ (tramp-dissect-file-name
+ (if (file-remote-p filename) filename newname))
+ 'file-already-exists newname))
+
+ (with-tramp-progress-reporter
(tramp-dissect-file-name (if (file-remote-p filename) filename newname))
0 (format "Renaming %s to %s" filename newname)
- (let ((tmpfile (file-local-copy filename)))
-
- (if tmpfile
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
- (when (file-directory-p newname)
- (setq newname (expand-file-name
- (file-name-nondirectory filename) newname)))
-
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)
- (unless (tramp-smb-send-command
- v (format "put %s \"%s\""
- filename (tramp-smb-get-localname v)))
- (tramp-error v 'file-error "Cannot rename `%s'" filename)))))
+ (if (and (tramp-equal-remote filename newname)
+ (string-equal
+ (tramp-smb-get-share (tramp-dissect-file-name filename))
+ (tramp-smb-get-share (tramp-dissect-file-name newname))))
+ ;; We can rename directly.
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v2 (file-name-directory v2-localname))
+ (tramp-flush-file-property v2 v2-localname)
+ (unless (tramp-smb-get-share v2)
+ (tramp-error
+ v2 'file-error "Target `%s' must contain a share name" newname))
+ (unless (tramp-smb-send-command
+ v2 (format "rename \"%s\" \"%s\""
+ (tramp-smb-get-localname v1)
+ (tramp-smb-get-localname v2)))
+ (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
- (delete-file filename)))
+ ;; We must rename via copy.
+ (tramp-compat-copy-file filename newname ok-if-already-exists t t t)
+ (if (file-directory-p filename)
+ (tramp-compat-delete-directory filename 'recursive)
+ (delete-file filename)))))
(defun tramp-smb-handle-set-file-modes (filename mode)
"Like `set-file-modes' for Tramp files."
@@ -896,6 +1163,54 @@ target of the symlink differ."
(tramp-error
v 'file-error "Error while changing file's mode %s" filename)))))
+;; We use BUFFER also as connection buffer during setup. Because of
+;; this, its original contents must be saved, and restored once
+;; connection has been setup.
+(defun tramp-smb-handle-start-file-process (name buffer program &rest args)
+ "Like `start-file-process' for Tramp files."
+ (with-parsed-tramp-file-name default-directory nil
+ (let ((command (mapconcat 'identity (cons program args) " "))
+ (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
+ (name1 name)
+ (i 0))
+ (unwind-protect
+ (save-excursion
+ (save-restriction
+ (unless buffer
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ ;; Activate narrowing in order to save BUFFER contents.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (let ((buffer-undo-list t))
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format
+ "cd \"//%s%s\""
+ host (file-name-directory localname))))
+ (tramp-message v 6 "(%s); exit" command)
+ (tramp-send-string v command)))
+ ;; Return value.
+ (tramp-get-connection-process v)))
+
+ ;; Save exit.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (if (string-match tramp-temp-buffer-name (buffer-name))
+ (progn
+ (set-process-buffer (tramp-get-connection-process v) nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp)))
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)))))
+
(defun tramp-smb-handle-substitute-in-file-name (filename)
"Like `handle-substitute-in-file-name' for Tramp files.
\"//\" substitutes only in the local filename part. Catches
@@ -939,7 +1254,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(list start end tmpfile append 'no-message lockname confirm)
(list start end tmpfile append 'no-message lockname)))
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 3 (format "Moving tmp file %s to %s" tmpfile filename)
(unwind-protect
(unless (tramp-smb-send-command
@@ -973,7 +1288,7 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
(setq
localname
(if (string-match "^/?[^/]+\\(/.*\\)" localname)
- ;; There is a share, sparated by "/".
+ ;; There is a share, separated by "/".
(if (not (tramp-smb-get-cifs-capabilities vec))
(mapconcat
(lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
@@ -998,8 +1313,8 @@ Either the shares are listed, or the `dir' command is executed.
Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
(with-parsed-tramp-file-name (file-name-as-directory directory) nil
(setq localname (or localname "/"))
- (with-file-property v localname "file-entries"
- (with-current-buffer (tramp-get-buffer v)
+ (with-tramp-file-property v localname "file-entries"
+ (with-current-buffer (tramp-get-connection-buffer v)
(let* ((share (tramp-smb-get-share v))
(cache (tramp-get-connection-property v "share-cache" nil))
res entry)
@@ -1183,11 +1498,11 @@ Result is the list (LOCALNAME MODE SIZE MTIME)."
;; When we are not logged in yet, we return nil.
(if (let ((p (tramp-get-connection-process vec)))
(and p (processp p) (memq (process-status p) '(run open))))
- (with-connection-property
+ (with-tramp-connection-property
(tramp-get-connection-process vec) "cifs-capabilities"
(save-match-data
(when (tramp-smb-send-command vec "posix")
- (with-current-buffer (tramp-get-buffer vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
(when
(re-search-forward "Server supports CIFS capabilities" nil t)
@@ -1201,7 +1516,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)."
;; When we are not logged in yet, we return nil.
(if (let ((p (tramp-get-connection-process vec)))
(and p (processp p) (memq (process-status p) '(run open))))
- (with-connection-property
+ (with-tramp-connection-property
(tramp-get-connection-process vec) "stat-capability"
(tramp-smb-send-command vec "stat ."))))
@@ -1216,18 +1531,20 @@ Returns nil if there has been an error message from smbclient."
(tramp-send-string vec command)
(tramp-smb-wait-for-output vec))
-(defun tramp-smb-maybe-open-connection (vec)
+(defun tramp-smb-maybe-open-connection (vec &optional argument)
"Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
Does not do anything if a connection is already open, but re-opens the
-connection if a previous connection has died for some reason."
+connection if a previous connection has died for some reason.
+If ARGUMENT is non-nil, use it as argument for
+`tramp-smb-winexe-program', and suppress any checks."
(let* ((share (tramp-smb-get-share vec))
- (buf (tramp-get-buffer vec))
+ (buf (tramp-get-connection-buffer vec))
(p (get-buffer-process buf)))
;; Check whether we still have the same smbclient version.
;; Otherwise, we must delete the connection cache, because
;; capabilities migh have changed.
- (unless (processp p)
+ (unless (or argument (processp p))
(let ((default-directory (tramp-compat-temporary-file-directory))
(command (concat tramp-smb-program " -V")))
@@ -1271,9 +1588,10 @@ connection if a previous connection has died for some reason."
;; Check whether it is still the same share.
(unless
(and p (processp p) (memq (process-status p) '(run open))
- (string-equal
- share
- (tramp-get-connection-property p "smb-share" "")))
+ (or argument
+ (string-equal
+ share
+ (tramp-get-connection-property p "smb-share" ""))))
(save-match-data
;; There might be unread output from checking for share names.
@@ -1288,9 +1606,13 @@ connection if a previous connection has died for some reason."
(port (tramp-file-name-port vec))
args)
- (if share
- (setq args (list (concat "//" real-host "/" share)))
- (setq args (list "-g" "-L" real-host )))
+ (cond
+ (argument
+ (setq args (list (concat "//" real-host))))
+ (share
+ (setq args (list (concat "//" real-host "/" share))))
+ (t
+ (setq args (list "-g" "-L" real-host ))))
(if (not (zerop (length real-user)))
(setq args (append args (list "-U" real-user)))
@@ -1300,9 +1622,11 @@ connection if a previous connection has died for some reason."
(when port (setq args (append args (list "-p" port))))
(when tramp-smb-conf
(setq args (append args (list "-s" tramp-smb-conf))))
+ (when argument
+ (setq args (append args (list argument))))
;; OK, let's go.
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
vec 3
(format "Opening connection for //%s%s/%s"
(if (not (zerop (length user))) (concat user "@") "")
@@ -1313,8 +1637,11 @@ connection if a previous connection has died for some reason."
(p (let ((default-directory
(tramp-compat-temporary-file-directory)))
(apply #'start-process
- (tramp-buffer-name vec) (tramp-get-buffer vec)
- tramp-smb-program args))))
+ (tramp-get-connection-name vec)
+ (tramp-get-connection-buffer vec)
+ (if argument
+ tramp-smb-winexe-program tramp-smb-program)
+ args))))
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
@@ -1325,40 +1652,58 @@ connection if a previous connection has died for some reason."
tramp-current-user user
tramp-current-host host)
- ;; Play login scenario.
- (tramp-process-actions
- p vec nil
- (if share
- tramp-smb-actions-with-share
- tramp-smb-actions-without-share))
-
- ;; Check server version.
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- (search-forward-regexp
- "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t)
- (let ((smbserver-version (match-string 0)))
- (unless
- (string-equal
- smbserver-version
- (tramp-get-connection-property
- vec "smbserver-version" smbserver-version))
- (tramp-flush-directory-property vec "")
- (tramp-flush-connection-property vec))
- (tramp-set-connection-property
- vec "smbserver-version" smbserver-version)))
-
- ;; Set chunksize. Otherwise, `tramp-send-string' might
- ;; try it itself.
- (tramp-set-connection-property p "smb-share" share)
- (tramp-set-connection-property
- p "chunksize" tramp-chunksize))))))))
+ (condition-case err
+ (let (tramp-message-show-message)
+ ;; Play login scenario.
+ (tramp-process-actions
+ p vec nil
+ (if (or argument share)
+ tramp-smb-actions-with-share
+ tramp-smb-actions-without-share))
+
+ ;; Check server version.
+ (unless argument
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (search-forward-regexp tramp-smb-server-version nil t)
+ (let ((smbserver-version (match-string 0)))
+ (unless
+ (string-equal
+ smbserver-version
+ (tramp-get-connection-property
+ vec "smbserver-version" smbserver-version))
+ (tramp-flush-directory-property vec "")
+ (tramp-flush-connection-property vec))
+ (tramp-set-connection-property
+ vec "smbserver-version" smbserver-version))))
+
+ ;; Set chunksize to 1. smbclient reads its input
+ ;; character by character; if we send the string
+ ;; at once, it is read painfully slow.
+ (tramp-set-connection-property p "smb-share" share)
+ (tramp-set-connection-property p "chunksize" 1))
+
+ ;; Check for the error reason. If it was due to wrong
+ ;; password, reestablish the connection. We cannot
+ ;; handle this in `tramp-process-actions', because
+ ;; smbclient does not ask for the password, again.
+ (error
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (if (search-forward-regexp
+ tramp-smb-wrong-passwd-regexp nil t)
+ ;; Disable `auth-source' and `password-cache'.
+ (let (auth-sources)
+ (tramp-cleanup vec)
+ (tramp-smb-maybe-open-connection vec argument))
+ ;; Propagate the error.
+ (signal (car err) (cdr err)))))))))))))
;; We don't use timeouts. If needed, the caller shall wrap around.
(defun tramp-smb-wait-for-output (vec)
"Wait for output from smbclient command.
Returns nil if an error message has appeared."
- (with-current-buffer (tramp-get-buffer vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
(let ((p (get-buffer-process (current-buffer)))
(found (progn (goto-char (point-min))
(re-search-forward tramp-smb-prompt nil t)))
@@ -1372,7 +1717,7 @@ Returns nil if an error message has appeared."
(while (and (not found) (not err) (memq (process-status p) '(run open)))
;; Accept pending output.
- (tramp-accept-process-output p)
+ (tramp-accept-process-output p 0.1)
;; Search for prompt.
(goto-char (point-min))
@@ -1386,16 +1731,74 @@ Returns nil if an error message has appeared."
(while (and (not found) (memq (process-status p) '(run open)))
;; Accept pending output.
- (tramp-accept-process-output p)
+ (tramp-accept-process-output p 0.1)
;; Search for prompt.
(goto-char (point-min))
(setq found (re-search-forward tramp-smb-prompt nil t)))
- ;; Return value is whether no error message has appeared.
(tramp-message vec 6 "\n%s" (buffer-string))
+
+ ;; Remove prompt.
+ (when found
+ (goto-char (point-max))
+ (re-search-backward tramp-smb-prompt nil t)
+ (delete-region (point) (point-max)))
+
+ ;; Return value is whether no error message has appeared.
(not err))))
+(defun tramp-smb-kill-winexe-function ()
+ "Send SIGKILL to the winexe process."
+ (ignore-errors
+ (let ((p (get-buffer-process (current-buffer))))
+ (when (and p (processp p) (memq (process-status p) '(run open)))
+ (signal-process (process-id p) 'SIGINT)))))
+
+(defun tramp-smb-call-winexe (vec)
+ "Apply a remote command, if possible, using `tramp-smb-winexe-program'."
+
+ ;; We call `tramp-get-buffer' in order to get a debug buffer for
+ ;; messages.
+ (tramp-get-buffer vec)
+
+ ;; Check for program.
+ (unless (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (executable-find tramp-smb-winexe-program))
+ (tramp-error
+ vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
+
+ ;; winexe does not supports ports.
+ (when (tramp-file-name-port vec)
+ (tramp-error vec 'file-error "Port not supported for remote processes"))
+
+ (tramp-smb-maybe-open-connection
+ vec
+ (format
+ "%s %s"
+ tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
+
+ (set (make-local-variable 'kill-buffer-hook)
+ '(tramp-smb-kill-winexe-function))
+
+ ;; Suppress "^M". Shouldn't we specify utf8?
+ (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
+
+ ;; Set width to 128. This avoids mixing prompt and long error messages.
+ (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI")
+ (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize")
+ (tramp-smb-send-command vec "$winsize = $rawui.WindowSize")
+ (tramp-smb-send-command vec "$bufsize.Width = 128")
+ (tramp-smb-send-command vec "$winsize.Width = 128")
+ (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize")
+ (tramp-smb-send-command vec "$rawui.WindowSize = $winsize"))
+
+(defun tramp-smb-shell-quote-argument (s)
+ "Similar to `shell-quote-argument', but uses windows cmd syntax."
+ (let ((system-type 'ms-dos))
+ (shell-quote-argument s)))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-smb 'force)))
@@ -1404,12 +1807,9 @@ Returns nil if an error message has appeared."
;;; TODO:
-;; * Error handling in case password is wrong.
;; * Return more comprehensive file permission string.
;; * Try to remove the inclusion of dummy "" directory. Seems to be at
;; several places, especially in `tramp-smb-handle-insert-directory'.
-;; * (RMS) Use unwind-protect to clean up the state so as to make the state
-;; regular again.
;; * Ignore case in file names.
;;; tramp-smb.el ends here
diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el
index 391fba0b404..be612d011eb 100644
--- a/lisp/net/tramp-uu.el
+++ b/lisp/net/tramp-uu.el
@@ -1,6 +1,6 @@
;;; tramp-uu.el --- uuencode in Lisp
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
;; Keywords: comm, terminals
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 473ba00fbc2..d6f2177b03b 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1,6 +1,6 @@
;;; tramp.el --- Transparent Remote Access, Multiple Protocol
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
;; Michael Albinus <michael.albinus@gmx.de>
@@ -57,12 +57,13 @@
;;; Code:
+(eval-when-compile (require 'cl)) ; ignore-errors
(require 'tramp-compat)
;;; User Customizable Internal Variables:
(defgroup tramp nil
- "Edit remote files with a combination of rsh and rcp or similar programs."
+ "Edit remote files with a combination of ssh, scp, etc."
:group 'files
:group 'comm
:version "22.1")
@@ -70,13 +71,13 @@
;; Maybe we need once a real Tramp mode, with key bindings etc.
;;;###autoload
(defcustom tramp-mode t
- "*Whether Tramp is enabled.
+ "Whether Tramp is enabled.
If it is set to nil, all remote file names are used literally."
:group 'tramp
:type 'boolean)
(defcustom tramp-verbose 3
- "*Verbosity level for Tramp messages.
+ "Verbosity level for Tramp messages.
Any level x includes messages for all levels 1 .. x-1. The levels are
0 silent (no tramp messages at all)
@@ -116,7 +117,7 @@ policy for local files."
(eval-and-compile
(when (featurep 'xemacs)
(defcustom tramp-bkup-backup-directory-info nil
- "*Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
+ "Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
It has the same meaning like `bkup-backup-directory-info' from package
`backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local
file name, the backup directory is prepended with Tramp file name prefix
@@ -137,7 +138,7 @@ policy for local files."
:group 'tramp)))
(defcustom tramp-auto-save-directory nil
- "*Put auto-save files in this directory, if set.
+ "Put auto-save files in this directory, if set.
The idea is to use a local directory so that auto-saving is faster."
:group 'tramp
:type '(choice (const nil) string))
@@ -146,7 +147,7 @@ The idea is to use a local directory so that auto-saving is faster."
(if (memq system-type '(windows-nt))
(getenv "COMSPEC")
"/bin/sh")
- "*Use this program for encoding and decoding commands on the local host.
+ "Use this program for encoding and decoding commands on the local host.
This shell is used to execute the encoding and decoding command on the
local host, so if you want to use `~' in those commands, you should
choose a shell here which groks tilde expansion. `/bin/sh' normally
@@ -172,21 +173,22 @@ use for the remote host."
(if (string-match "cmd\\.exe" tramp-encoding-shell)
"/c"
"-c")
- "*Use this switch together with `tramp-encoding-shell' for local commands.
+ "Use this switch together with `tramp-encoding-shell' for local commands.
See the variable `tramp-encoding-shell' for more information."
:group 'tramp
:type 'string)
(defcustom tramp-encoding-command-interactive
(unless (string-match "cmd\\.exe" tramp-encoding-shell) "-i")
- "*Use this switch together with `tramp-encoding-shell' for interactive shells.
+ "Use this switch together with `tramp-encoding-shell' for interactive shells.
See the variable `tramp-encoding-shell' for more information."
+ :version "24.1"
:group 'tramp
:type '(choice (const nil) string))
;;;###tramp-autoload
(defvar tramp-methods nil
- "*Alist of methods for remote files.
+ "Alist of methods for remote files.
This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
Each NAME stands for a remote access method. Each PARAM is a
pair of the form (KEY VALUE). The following KEYs are defined:
@@ -246,15 +248,6 @@ pair of the form (KEY VALUE). The following KEYs are defined:
* `tramp-gw-args'
As the attribute name says, additional arguments are specified here
when a method is applied via a gateway.
- * `tramp-password-end-of-line'
- This specifies the string to use for terminating the line after
- submitting the password. If this method parameter is nil, then the
- value of the normal variable `tramp-default-password-end-of-line'
- is used. This parameter is necessary because the \"plink\" program
- requires any two characters after sending the password. These do
- not have to be newline or carriage return characters. Other login
- programs are happy with just one character, the newline character.
- We use \"xy\" as the value for methods using \"plink\".
* `tramp-tmpdir'
A directory on the remote host for temporary files. If not
specified, \"/tmp\" is taken as default.
@@ -333,7 +326,7 @@ shouldn't return t when it isn't."
(t "ssh")))
;; Fallback.
(t "ftp"))
- "*Default method to use for transferring files.
+ "Default method to use for transferring files.
See `tramp-methods' for possibilities.
Also see `tramp-default-method-alist'."
:group 'tramp
@@ -341,7 +334,7 @@ Also see `tramp-default-method-alist'."
;;;###tramp-autoload
(defcustom tramp-default-method-alist nil
- "*Default method to use for specific host/user pairs.
+ "Default method to use for specific host/user pairs.
This is an alist of items (HOST USER METHOD). The first matching item
specifies the method to use for a file name which does not specify a
method. HOST and USER are regular expressions or nil, which is
@@ -358,7 +351,7 @@ See `tramp-methods' for a list of possibilities for METHOD."
(choice :tag "Method name" string (const nil)))))
(defcustom tramp-default-user nil
- "*Default user to use for transferring files.
+ "Default user to use for transferring files.
It is nil by default; otherwise settings in configuration files like
\"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'.
@@ -368,7 +361,7 @@ This variable is regarded as obsolete, and will be removed soon."
;;;###tramp-autoload
(defcustom tramp-default-user-alist nil
- "*Default user to use for specific method/host pairs.
+ "Default user to use for specific method/host pairs.
This is an alist of items (METHOD HOST USER). The first matching item
specifies the user to use for a file name which does not specify a
user. METHOD and USER are regular expressions or nil, which is
@@ -383,13 +376,13 @@ empty string for the method name."
(choice :tag " User name" string (const nil)))))
(defcustom tramp-default-host (system-name)
- "*Default host to use for transferring files.
+ "Default host to use for transferring files.
Useful for su and sudo methods mostly."
:group 'tramp
:type 'string)
(defcustom tramp-default-proxies-alist nil
- "*Route to be followed for specific host/user pairs.
+ "Route to be followed for specific host/user pairs.
This is an alist of items (HOST USER PROXY). The first matching
item specifies the proxy to be passed for a file name located on
a remote target matching USER@HOST. HOST and USER are regular
@@ -407,6 +400,24 @@ interpreted as a regular expression which always matches."
(choice :tag "User regexp" regexp sexp)
(choice :tag " Proxy name" string (const nil)))))
+(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
+ (when (memq system-type '(windows-nt))
+ (list (concat "\\`" (regexp-quote (system-name)) "\\'")))
+ "List of hosts, which run a restricted shell.
+This is a list of regular expressions, which denote hosts running
+a registered shell like \"rbash\". Those hosts can be used as
+proxies only, see `tramp-default-proxies-alist'. If the local
+host runs a registered shell, it shall be added to this list, too."
+ :version "24.3"
+ :group 'tramp
+ :type '(repeat (regexp :tag "Host regexp")))
+
;;;###tramp-autoload
(defconst tramp-local-host-regexp
(concat
@@ -414,10 +425,10 @@ interpreted as a regular expression which always matches."
(regexp-opt
(list "localhost" "localhost6" (system-name) "127\.0\.0\.1" "::1") t)
"\\'")
- "*Host names which are regarded as local host.")
+ "Host names which are regarded as local host.")
(defvar tramp-completion-function-alist nil
- "*Alist of methods for remote files.
+ "Alist of methods for remote files.
This is a list of entries of the form \(NAME PAIR1 PAIR2 ...\).
Each NAME stands for a remote access method. Each PAIR is of the form
\(FUNCTION FILE\). FUNCTION is responsible to extract user names and host
@@ -431,7 +442,7 @@ names from FILE for completion. The following predefined FUNCTIONs exists:
* `tramp-parse-hosts' for \"/etc/hosts\" like files,
* `tramp-parse-passwd' for \"/etc/passwd\" like files.
* `tramp-parse-netrc' for \"~/.netrc\" like files.
- * `tramp-parse-putty' for PuTTY registry keys.
+ * `tramp-parse-putty' for PuTTY registered sessions.
FUNCTION can also be a customer defined function. For more details see
the info pages.")
@@ -460,33 +471,23 @@ usually suffice.")
"Regexp which matches `tramp-echo-mark' as it gets echoed by
the remote shell.")
-(defcustom tramp-rsh-end-of-line "\n"
- "*String used for end of line in rsh connections.
-I don't think this ever needs to be changed, so please tell me about it
-if you need to change this.
-Also see the method parameter `tramp-password-end-of-line' and the normal
-variable `tramp-default-password-end-of-line'."
+(defcustom tramp-local-end-of-line
+ (if (memq system-type '(windows-nt)) "\r\n" "\n")
+ "String used for end of line in local processes."
+ :version "24.1"
:group 'tramp
:type 'string)
-(defcustom tramp-default-password-end-of-line
- tramp-rsh-end-of-line
- "*String used for end of line after sending a password.
-This variable provides the default value for the method parameter
-`tramp-password-end-of-line', see `tramp-methods' for more details.
-
-It seems that people using plink under Windows need to send
-\"\\r\\n\" (carriage-return, then newline) after a password, but just
-\"\\n\" after all other lines. This variable can be used for the
-password, see `tramp-rsh-end-of-line' for the other cases.
-
-The default value is to use the same value as `tramp-rsh-end-of-line'."
+(defcustom tramp-rsh-end-of-line "\n"
+ "String used for end of line in rsh connections.
+I don't think this ever needs to be changed, so please tell me about it
+if you need to change this."
:group 'tramp
:type 'string)
(defcustom tramp-login-prompt-regexp
".*ogin\\( .*\\)?: *"
- "*Regexp matching login-like prompts.
+ "Regexp matching login-like prompts.
The regexp should match at end of buffer.
Sometimes the prompt is reported to look like \"login as:\"."
@@ -497,8 +498,10 @@ Sometimes the prompt is reported to look like \"login as:\"."
;; Allow a prompt to start right after a ^M since it indeed would be
;; displayed at the beginning of the line (and Zsh uses it). This
;; regexp works only for GNU Emacs.
+ ;; Allow also [] style prompts. They can appear only during
+ ;; connection initialization; Tramp redefines the prompt afterwards.
(concat (if (featurep 'xemacs) "" "\\(?:^\\|\r\\)")
- "[^#$%>\n]*#?[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
+ "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
"Regexp to match prompts from remote shell.
Normally, Tramp expects you to configure `shell-prompt-pattern'
correctly, but sometimes it happens that you are connecting to a
@@ -515,7 +518,7 @@ This regexp must match both `tramp-initial-end-of-output' and
(defcustom tramp-password-prompt-regexp
"^.*\\([pP]assword\\|[pP]assphrase\\).*:\^@? *"
- "*Regexp matching password-like prompts.
+ "Regexp matching password-like prompts.
The regexp should match at end of buffer.
The `sudo' program appears to insert a `^@' character into the prompt."
@@ -541,7 +544,7 @@ The `sudo' program appears to insert a `^@' character into the prompt."
;; Here comes a list of regexes, separated by \\|
"Received signal [0-9]+"
"\\).*")
- "*Regexp matching a `login failed' message.
+ "Regexp matching a `login failed' message.
The regexp should match at end of buffer."
:group 'tramp
:type 'regexp)
@@ -612,7 +615,7 @@ The answer will be provided by `tramp-action-process-alive',
:type 'regexp)
(defconst tramp-temp-name-prefix "tramp."
- "*Prefix to use for temporary files.
+ "Prefix to use for temporary files.
If this is a relative file name (such as \"tramp.\"), it is considered
relative to the directory name returned by the function
`tramp-compat-temporary-file-directory' (which see). It may also be an
@@ -662,76 +665,76 @@ It can have the following values:
((equal tramp-syntax 'sep) "/[")
((equal tramp-syntax 'url) "/")
(t (error "Wrong `tramp-syntax' defined")))
- "*String matching the very beginning of Tramp file names.
+ "String matching the very beginning of Tramp file names.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-prefix-regexp
(concat "^" (regexp-quote tramp-prefix-format))
- "*Regexp matching the very beginning of Tramp file names.
+ "Regexp matching the very beginning of Tramp file names.
Should always start with \"^\". Derived from `tramp-prefix-format'.")
(defconst tramp-method-regexp
"[a-zA-Z_0-9-]+"
- "*Regexp matching methods identifiers.")
+ "Regexp matching methods identifiers.")
(defconst tramp-postfix-method-format
(cond ((equal tramp-syntax 'ftp) ":")
((equal tramp-syntax 'sep) "/")
((equal tramp-syntax 'url) "://")
(t (error "Wrong `tramp-syntax' defined")))
- "*String matching delimiter between method and user or host names.
+ "String matching delimiter between method and user or host names.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-postfix-method-regexp
(regexp-quote tramp-postfix-method-format)
- "*Regexp matching delimiter between method and user or host names.
+ "Regexp matching delimiter between method and user or host names.
Derived from `tramp-postfix-method-format'.")
-(defconst tramp-user-regexp "[^:/ \t]+"
- "*Regexp matching user names.")
+(defconst tramp-user-regexp "[^/|: \t]+"
+ "Regexp matching user names.")
;;;###tramp-autoload
(defconst tramp-prefix-domain-format "%"
- "*String matching delimiter between user and domain names.")
+ "String matching delimiter between user and domain names.")
;;;###tramp-autoload
(defconst tramp-prefix-domain-regexp
(regexp-quote tramp-prefix-domain-format)
- "*Regexp matching delimiter between user and domain names.
+ "Regexp matching delimiter between user and domain names.
Derived from `tramp-prefix-domain-format'.")
(defconst tramp-domain-regexp "[-a-zA-Z0-9_.]+"
- "*Regexp matching domain names.")
+ "Regexp matching domain names.")
(defconst tramp-user-with-domain-regexp
(concat "\\(" tramp-user-regexp "\\)"
tramp-prefix-domain-regexp
"\\(" tramp-domain-regexp "\\)")
- "*Regexp matching user names with domain names.")
+ "Regexp matching user names with domain names.")
(defconst tramp-postfix-user-format "@"
- "*String matching delimiter between user and host names.
+ "String matching delimiter between user and host names.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-postfix-user-regexp
(regexp-quote tramp-postfix-user-format)
- "*Regexp matching delimiter between user and host names.
+ "Regexp matching delimiter between user and host names.
Derived from `tramp-postfix-user-format'.")
(defconst tramp-host-regexp "[a-zA-Z0-9_.-]+"
- "*Regexp matching host names.")
+ "Regexp matching host names.")
(defconst tramp-prefix-ipv6-format
(cond ((equal tramp-syntax 'ftp) "[")
((equal tramp-syntax 'sep) "")
((equal tramp-syntax 'url) "[")
(t (error "Wrong `tramp-syntax' defined")))
- "*String matching left hand side of IPv6 addresses.
+ "String matching left hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-prefix-ipv6-regexp
(regexp-quote tramp-prefix-ipv6-format)
- "*Regexp matching left hand side of IPv6 addresses.
+ "Regexp matching left hand side of IPv6 addresses.
Derived from `tramp-prefix-ipv6-format'.")
;; The following regexp is a bit sloppy. But it shall serve our
@@ -739,19 +742,19 @@ Derived from `tramp-prefix-ipv6-format'.")
;; "::ffff:192.168.0.1".
(defconst tramp-ipv6-regexp
"\\(?:\\(?:[a-zA-Z0-9]+\\)?:\\)+[a-zA-Z0-9.]+"
- "*Regexp matching IPv6 addresses.")
+ "Regexp matching IPv6 addresses.")
(defconst tramp-postfix-ipv6-format
(cond ((equal tramp-syntax 'ftp) "]")
((equal tramp-syntax 'sep) "")
((equal tramp-syntax 'url) "]")
(t (error "Wrong `tramp-syntax' defined")))
- "*String matching right hand side of IPv6 addresses.
+ "String matching right hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-postfix-ipv6-regexp
(regexp-quote tramp-postfix-ipv6-format)
- "*Regexp matching right hand side of IPv6 addresses.
+ "Regexp matching right hand side of IPv6 addresses.
Derived from `tramp-postfix-ipv6-format'.")
(defconst tramp-prefix-port-format
@@ -759,56 +762,68 @@ Derived from `tramp-postfix-ipv6-format'.")
((equal tramp-syntax 'sep) "#")
((equal tramp-syntax 'url) ":")
(t (error "Wrong `tramp-syntax' defined")))
- "*String matching delimiter between host names and port numbers.")
+ "String matching delimiter between host names and port numbers.")
(defconst tramp-prefix-port-regexp
(regexp-quote tramp-prefix-port-format)
- "*Regexp matching delimiter between host names and port numbers.
+ "Regexp matching delimiter between host names and port numbers.
Derived from `tramp-prefix-port-format'.")
(defconst tramp-port-regexp "[0-9]+"
- "*Regexp matching port numbers.")
+ "Regexp matching port numbers.")
(defconst tramp-host-with-port-regexp
(concat "\\(" tramp-host-regexp "\\)"
tramp-prefix-port-regexp
"\\(" tramp-port-regexp "\\)")
- "*Regexp matching host names with port numbers.")
+ "Regexp matching host names with port numbers.")
+
+(defconst tramp-postfix-hop-format "|"
+ "String matching delimiter after ad-hoc hop definitions.")
+
+(defconst tramp-postfix-hop-regexp
+ (regexp-quote tramp-postfix-hop-format)
+ "Regexp matching delimiter after ad-hoc hop definitions.
+Derived from `tramp-postfix-hop-format'.")
(defconst tramp-postfix-host-format
(cond ((equal tramp-syntax 'ftp) ":")
((equal tramp-syntax 'sep) "]")
((equal tramp-syntax 'url) "")
(t (error "Wrong `tramp-syntax' defined")))
- "*String matching delimiter between host names and localnames.
+ "String matching delimiter between host names and localnames.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-postfix-host-regexp
(regexp-quote tramp-postfix-host-format)
- "*Regexp matching delimiter between host names and localnames.
+ "Regexp matching delimiter between host names and localnames.
Derived from `tramp-postfix-host-format'.")
(defconst tramp-localname-regexp ".*$"
- "*Regexp matching localnames.")
+ "Regexp matching localnames.")
;;; File name format:
+(defconst tramp-remote-file-name-spec-regexp
+ (concat
+ "\\(?:" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
+ "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
+ "\\(" "\\(?:" tramp-host-regexp "\\|"
+ tramp-prefix-ipv6-regexp tramp-ipv6-regexp
+ tramp-postfix-ipv6-regexp "\\)"
+ "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?")
+"Regular expression matching a Tramp file name between prefix and postfix.")
+
(defconst tramp-file-name-structure
(list
(concat
tramp-prefix-regexp
- "\\(" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
- "\\(" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
- "\\(" "\\(" tramp-host-regexp
- "\\|"
- tramp-prefix-ipv6-regexp tramp-ipv6-regexp
- tramp-postfix-ipv6-regexp "\\)"
- "\\(" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"
- tramp-postfix-host-regexp
+ "\\(" "\\(?:" tramp-remote-file-name-spec-regexp
+ tramp-postfix-hop-regexp "\\)+" "\\)?"
+ tramp-remote-file-name-spec-regexp tramp-postfix-host-regexp
"\\(" tramp-localname-regexp "\\)")
- 2 4 5 8)
-
- "*List of five elements (REGEXP METHOD USER HOST FILE), detailing \
+ 5 6 7 8 1)
+ "List of six elements (REGEXP METHOD USER HOST FILE HOP), detailing \
the Tramp file name structure.
The first element REGEXP is a regular expression matching a Tramp file
@@ -819,6 +834,9 @@ The second element METHOD is a number, saying which pair of
parentheses matches the method name. The third element USER is
similar, but for the user name. The fourth element HOST is similar,
but for the host name. The fifth element FILE is for the file name.
+The last element HOP is the ad-hoc hop definition, which could be a
+cascade of several hops.
+
These numbers are passed directly to `match-string', which see. That
means the opening parentheses are counted to identify the pair.
@@ -827,8 +845,8 @@ See also `tramp-file-name-regexp'.")
;;;###autoload
(defconst tramp-file-name-regexp-unified
(if (memq system-type '(cygwin windows-nt))
- "\\`/\\([^[/:]\\{2,\\}\\|[^/]\\{2,\\}]\\):"
- "\\`/\\([^[/:]+\\|[^/]+]\\):")
+ "\\`/\\([^[/|:]\\{2,\\}\\|[^/|]\\{2,\\}]\\):"
+ "\\`/\\([^[/|:]+\\|[^/|]+]\\):")
"Value for `tramp-file-name-regexp' for unified remoting.
Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
Tramp. See `tramp-file-name-structure' for more explanations.
@@ -842,7 +860,7 @@ XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")
;;;###autoload
-(defconst tramp-file-name-regexp-url "\\`/[^/:]+://"
+(defconst tramp-file-name-regexp-url "\\`/[^/|:]+://"
"Value for `tramp-file-name-regexp' for URL-like remoting.
See `tramp-file-name-structure' for more explanations.")
@@ -852,7 +870,7 @@ See `tramp-file-name-structure' for more explanations.")
((equal tramp-syntax 'sep) tramp-file-name-regexp-separate)
((equal tramp-syntax 'url) tramp-file-name-regexp-url)
(t (error "Wrong `tramp-syntax' defined")))
- "*Regular expression matching file names handled by Tramp.
+ "Regular expression matching file names handled by Tramp.
This regexp should match Tramp file names but no other file names.
When tramp.el is loaded, this regular expression is prepended to
`file-name-handler-alist', and that is searched sequentially. Thus,
@@ -896,7 +914,7 @@ See `tramp-file-name-structure' for more explanations.")
((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate)
((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url)
(t (error "Wrong `tramp-syntax' defined")))
- "*Regular expression matching file names handled by Tramp completion.
+ "Regular expression matching file names handled by Tramp completion.
This regexp should match partial Tramp file names only.
Please note that the entry in `file-name-handler-alist' is made when
@@ -918,7 +936,7 @@ Also see `tramp-file-name-structure'.")
;; Parentheses in docstring starting at beginning of line are escaped.
;; Fontification is messed up when
;; `open-paren-in-column-0-is-defun-start' set to t.
- "*If non-nil, chunksize for sending input to local process.
+ "If non-nil, chunksize for sending input to local process.
It is necessary only on systems which have a buggy `process-send-string'
implementation. The necessity, whether this variable must be set, can be
checked via the following code:
@@ -1033,9 +1051,15 @@ calling HANDLER.")
;; internal data structure. Convenience functions for internal
;; data structure.
+(defun tramp-get-method-parameter (method param)
+ "Return the method parameter PARAM.
+If the `tramp-methods' entry does not exist, return nil."
+ (let ((entry (assoc param (assoc method tramp-methods))))
+ (when entry (cadr entry))))
+
(defun tramp-file-name-p (vec)
"Check, whether VEC is a Tramp object."
- (and (vectorp vec) (= 4 (length vec))))
+ (and (vectorp vec) (= 5 (length vec))))
(defun tramp-file-name-method (vec)
"Return method component of VEC."
@@ -1053,6 +1077,10 @@ calling HANDLER.")
"Return localname component of VEC."
(and (tramp-file-name-p vec) (aref vec 3)))
+(defun tramp-file-name-hop (vec)
+ "Return hop component of VEC."
+ (and (tramp-file-name-p vec) (aref vec 4)))
+
;; The user part of a Tramp file name vector can be of kind
;; "user%domain". Sometimes, we must extract these parts.
(defun tramp-file-name-real-user (vec)
@@ -1149,19 +1177,20 @@ values."
(let ((method (match-string (nth 1 tramp-file-name-structure) name))
(user (match-string (nth 2 tramp-file-name-structure) name))
(host (match-string (nth 3 tramp-file-name-structure) name))
- (localname (match-string (nth 4 tramp-file-name-structure) name)))
+ (localname (match-string (nth 4 tramp-file-name-structure) name))
+ (hop (match-string (nth 5 tramp-file-name-structure) name)))
(when host
(when (string-match tramp-prefix-ipv6-regexp host)
(setq host (replace-match "" nil t host)))
(when (string-match tramp-postfix-ipv6-regexp host)
(setq host (replace-match "" nil t host))))
(if nodefault
- (vector method user host localname)
+ (vector method user host localname hop)
(vector
(tramp-find-method method user host)
(tramp-find-user method user host)
(tramp-find-host method user host)
- localname))))))
+ localname hop))))))
(defun tramp-buffer-name (vec)
"A name for the connection buffer VEC."
@@ -1175,9 +1204,10 @@ values."
(format "*tramp/%s %s@%s*" method user host)
(format "*tramp/%s %s*" method host))))
-(defun tramp-make-tramp-file-name (method user host localname)
- "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
- (concat tramp-prefix-format
+(defun tramp-make-tramp-file-name (method user host localname &optional hop)
+ "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
+When not nil, an optional HOP is prepended."
+ (concat tramp-prefix-format hop
(when (not (zerop (length method)))
(concat method tramp-postfix-method-format))
(when (not (zerop (length user)))
@@ -1323,8 +1353,7 @@ ARGS to actually emit the message (if applicable)."
"tramp-debug-message"
"tramp-error"
"tramp-error-with-buffer"
- "tramp-message"
- "tramp-with-progress-reporter")
+ "tramp-message")
t)
"$")
fn)))
@@ -1349,6 +1378,10 @@ ARGS to actually emit the message (if applicable)."
This variable is used to disable messages from `tramp-error'.
The messages are visible anyway, because an error is raised.")
+(defvar tramp-message-show-progress-reporter-message t
+ "Show Tramp progress reporter message in the minibuffer.
+This variable is used to disable recursive progress reporter messages.")
+
(defsubst tramp-message (vec-or-proc level fmt-string &rest args)
"Emit a message depending on verbosity level.
VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
@@ -1414,13 +1447,14 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(unwind-protect
(apply 'tramp-error vec-or-proc signal fmt-string args)
(when (and vec-or-proc
+ tramp-message-show-message
(not (zerop tramp-verbose))
(not (tramp-completion-mode-p)))
(let ((enable-recursive-minibuffers t))
(pop-to-buffer
(or (and (bufferp buffer) buffer)
(and (processp vec-or-proc) (process-buffer vec-or-proc))
- (tramp-get-buffer vec-or-proc)))
+ (tramp-get-connection-buffer vec-or-proc)))
(sit-for 30))))))
(defmacro with-parsed-tramp-file-name (filename var &rest body)
@@ -1431,13 +1465,14 @@ Second arg VAR is a symbol. It is used as a variable name to hold
the filename structure. It is also used as a prefix for the variables
holding the components. For example, if VAR is the symbol `foo', then
`foo' will be bound to the whole structure, `foo-method' will be bound to
-the method component, and so on for `foo-user', `foo-host', `foo-localname'.
+the method component, and so on for `foo-user', `foo-host', `foo-localname',
+`foo-hop'.
Remaining args are Lisp expressions to be evaluated (inside an implicit
`progn').
If VAR is nil, then we bind `v' to the structure and `method', `user',
-`host', `localname' to the components."
+`host', `localname', `hop' to the components."
`(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
(,(if var (intern (concat (symbol-name var) "-method")) 'method)
(tramp-file-name-method ,(or var 'v)))
@@ -1446,7 +1481,9 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
(,(if var (intern (concat (symbol-name var) "-host")) 'host)
(tramp-file-name-host ,(or var 'v)))
(,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
- (tramp-file-name-localname ,(or var 'v))))
+ (tramp-file-name-localname ,(or var 'v)))
+ (,(if var (intern (concat (symbol-name var) "-hop")) 'hop)
+ (tramp-file-name-hop ,(or var 'v))))
,@body))
(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
@@ -1460,7 +1497,7 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
(when (string-match message (or (current-message) ""))
(tramp-compat-funcall 'progress-reporter-update reporter value))))
-(defmacro tramp-with-progress-reporter (vec level message &rest body)
+(defmacro with-tramp-progress-reporter (vec level message &rest body)
"Executes BODY, spinning a progress reporter with MESSAGE.
If LEVEL does not fit for visible messages, or if this is a
nested call of the macro, there are only traces without a visible
@@ -1470,7 +1507,8 @@ progress reporter."
(tramp-message ,vec ,level "%s..." ,message)
;; We start a pulsing progress reporter after 3 seconds. Feature
;; introduced in Emacs 24.1.
- (when (and tramp-message-show-message
+ (when (and tramp-message-show-progress-reporter-message
+ tramp-message-show-message
;; Display only when there is a minimum level.
(<= ,level (min tramp-verbose 3)))
(ignore-errors
@@ -1478,18 +1516,52 @@ progress reporter."
tm (when pr
(run-at-time 3 0.1 'tramp-progress-reporter-update pr)))))
(unwind-protect
- ;; Execute the body. Unset `tramp-message-show-message' when
- ;; the timer object is created, in order to suppress
- ;; concurrent timers.
- (let ((tramp-message-show-message
- (and tramp-message-show-message (not tm))))
+ ;; Execute the body. Suppress concurrent progress reporter
+ ;; messages.
+ (let ((tramp-message-show-progress-reporter-message
+ (and tramp-message-show-progress-reporter-message (not tm))))
,@body)
;; Stop progress reporter.
(if tm (tramp-compat-funcall 'cancel-timer tm))
(tramp-message ,vec ,level "%s...done" ,message))))
(tramp-compat-font-lock-add-keywords
- 'emacs-lisp-mode '("\\<tramp-with-progress-reporter\\>"))
+ 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
+
+(defmacro with-tramp-file-property (vec file property &rest body)
+ "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
+FILE must be a local file name on a connection identified via VEC."
+ `(if (file-name-absolute-p ,file)
+ (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
+ (when (eq value 'undef)
+ ;; We cannot pass @body as parameter to
+ ;; `tramp-set-file-property' because it mangles our
+ ;; debug messages.
+ (setq value (progn ,@body))
+ (tramp-set-file-property ,vec ,file ,property value))
+ value)
+ ,@body))
+
+(put 'with-tramp-file-property 'lisp-indent-function 3)
+(put 'with-tramp-file-property 'edebug-form-spec t)
+(tramp-compat-font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-tramp-file-property\\>"))
+
+(defmacro with-tramp-connection-property (key property &rest body)
+ "Check in Tramp for property PROPERTY, otherwise executes BODY and set."
+ `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
+ (when (eq value 'undef)
+ ;; We cannot pass ,@body as parameter to
+ ;; `tramp-set-connection-property' because it mangles our debug
+ ;; messages.
+ (setq value (progn ,@body))
+ (tramp-set-connection-property ,key ,property value))
+ value))
+
+(put 'with-tramp-connection-property 'lisp-indent-function 2)
+(put 'with-tramp-connection-property 'edebug-form-spec t)
+(tramp-compat-font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>"))
(defalias 'tramp-drop-volume-letter
(if (memq system-type '(cygwin windows-nt))
@@ -1506,6 +1578,22 @@ letter into the file name. This function removes it."
'identity))
+(if (featurep 'xemacs)
+ (defalias 'tramp-drop-volume-letter 'identity))
+
+(defun tramp-cleanup (vec)
+ "Cleanup connection VEC, but keep the debug buffer."
+ (with-current-buffer (tramp-get-debug-buffer vec)
+ ;; Keep the debug buffer.
+ (rename-buffer
+ (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
+ (tramp-cleanup-connection vec)
+ (if (= (point-min) (point-max))
+ (kill-buffer nil)
+ (rename-buffer (tramp-debug-buffer-name vec) 'unique))
+ ;; We call `tramp-get-buffer' in order to keep the debug buffer.
+ (tramp-get-buffer vec)))
+
;;; Config Manipulation Functions:
;;;###tramp-autoload
@@ -1514,9 +1602,7 @@ letter into the file name. This function removes it."
FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
The FUNCTION is intended to parse FILE according its syntax.
It might be a predefined FUNCTION, or a user defined FUNCTION.
-Predefined FUNCTIONs are `tramp-parse-rhosts', `tramp-parse-shosts',
-`tramp-parse-sconfig', `tramp-parse-hosts', `tramp-parse-passwd',
-and `tramp-parse-netrc'.
+For the list of predefined FUNCTIONs see `tramp-completion-function-alist'.
Example:
@@ -1609,7 +1695,9 @@ been set up by `rfn-eshadow-setup-minibuffer'."
(ignore-errors
(let ((end (or (tramp-compat-funcall
'overlay-end (symbol-value 'rfn-eshadow-overlay))
- (tramp-compat-funcall 'minibuffer-prompt-end))))
+ (tramp-compat-funcall 'minibuffer-prompt-end)))
+ ;; We do not want to send any remote command.
+ (non-essential t))
(when
(file-remote-p
(tramp-compat-funcall
@@ -1642,7 +1730,7 @@ been set up by `rfn-eshadow-setup-minibuffer'."
;; applied might be not so efficient (Ange-FTP uses hashes). But
;; performance isn't the major issue given that file transfer will
;; take time.
-(defvar tramp-inodes nil
+(defvar tramp-inodes 0
"Keeps virtual inodes numbers.")
;; Devices must distinguish physical file systems. The device numbers
@@ -1650,7 +1738,7 @@ been set up by `rfn-eshadow-setup-minibuffer'."
;; So we use virtual device numbers, generated by Tramp. Both Ange-FTP and
;; EFS use device number "-1". In order to be different, we use device number
;; (-1 . x), whereby "x" is unique for a given (method user host).
-(defvar tramp-devices nil
+(defvar tramp-devices 0
"Keeps virtual device numbers.")
(defun tramp-default-file-modes (filename)
@@ -1660,20 +1748,26 @@ value of `default-file-modes', without execute permissions."
(or (file-modes filename)
(logand (default-file-modes) (tramp-compat-octal-to-decimal "0666"))))
-(defun tramp-replace-environment-variables (filename)
- "Replace environment variables in FILENAME.
+(defalias 'tramp-replace-environment-variables
+ (if (ignore-errors
+ (equal "${ tramp?}" (substitute-env-vars "${ tramp?}" 'only-defined)))
+ (lambda (filename)
+ "Like `substitute-env-vars' with `only-defined' non-nil."
+ (substitute-env-vars filename 'only-defined))
+ (lambda (filename)
+ "Replace environment variables in FILENAME.
Return the string with the replaced variables."
- (save-match-data
- (let ((idx (string-match "$\\(\\w+\\)" filename)))
- ;; `$' is coded as `$$'.
- (when (and idx
- (or (zerop idx) (not (eq ?$ (aref filename (1- idx)))))
- (getenv (match-string 1 filename)))
- (setq filename
- (replace-match
- (substitute-in-file-name (match-string 0 filename))
- t nil filename)))
- filename)))
+ (save-match-data
+ (let ((idx (string-match "$\\(\\w+\\)" filename)))
+ ;; `$' is coded as `$$'.
+ (when (and idx
+ (or (zerop idx) (not (eq ?$ (aref filename (1- idx)))))
+ (getenv (match-string 1 filename)))
+ (setq filename
+ (replace-match
+ (substitute-in-file-name (match-string 0 filename))
+ t nil filename)))
+ filename)))))
;; In XEmacs, electricity is implemented via a key map for ?/ and ?~,
;; which calls corresponding functions (see minibuf.el).
@@ -1801,6 +1895,8 @@ ARGS are the arguments OPERATION has been called with."
'file-newer-than-file-p 'make-symbolic-link 'rename-file
;; Emacs 23+ only.
'copy-directory
+ ;; Emacs 24+ only.
+ 'file-in-directory-p 'file-equal-p
;; XEmacs only.
'dired-make-relative-symlink
'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail))
@@ -1876,8 +1972,9 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(with-parsed-tramp-file-name filename nil
;; Call the backend function.
(if foreign
- (condition-case err
- (let ((sf (symbol-function foreign)))
+ (tramp-compat-condition-case-unless-debug err
+ (let ((sf (symbol-function foreign))
+ result)
;; Some packages set the default directory to a
;; remote path, before respective Tramp packages
;; are already loaded. This results in
@@ -1887,7 +1984,32 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(let ((default-directory
(tramp-compat-temporary-file-directory)))
(load (cadr sf) 'noerror 'nomessage)))
- (apply foreign operation args))
+ ;; If `non-essential' is non-nil, Tramp shall
+ ;; not open a new connection.
+ ;; If Tramp detects that it shouldn't continue
+ ;; to work, it throws the `suppress' event.
+ ;; This could happen for example, when Tramp
+ ;; tries to open the same connection twice in a
+ ;; short time frame.
+ ;; In both cases, we try the default handler then.
+ (setq result
+ (catch 'non-essential
+ (catch 'suppress
+ (apply foreign operation args))))
+ (cond
+ ((eq result 'non-essential)
+ (tramp-message
+ v 5 "Non-essential received in operation %s"
+ (append (list operation) args))
+ (tramp-run-real-handler operation args))
+ ((eq result 'suppress)
+ (let (tramp-message-show-message)
+ (tramp-message
+ v 1 "Suppress received in operation %s"
+ (append (list operation) args))
+ (tramp-cleanup v)
+ (tramp-run-real-handler operation args)))
+ (t result)))
;; Trace that somebody has interrupted the operation.
((debug quit)
@@ -1902,8 +2024,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
;; operations shall return at least a default value
;; in order to give the user a chance to correct the
;; file name in the minibuffer.
- ;; We cannot use 'debug as error handler. In order
- ;; to get a full backtrace, one could apply
+ ;; In order to get a full backtrace, one could apply
;; (setq debug-on-error t debug-on-signal t)
(error
(cond
@@ -2114,18 +2235,27 @@ not in completion mode."
(defun tramp-completion-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for partial Tramp files."
- (let* ((fullname (tramp-drop-volume-letter
- (expand-file-name filename directory)))
- ;; Possible completion structures.
- (v (tramp-completion-dissect-file-name fullname))
- result result1)
-
- (while v
- (let* ((car (car v))
- (method (tramp-file-name-method car))
- (user (tramp-file-name-user car))
- (host (tramp-file-name-host car))
- (localname (tramp-file-name-localname car))
+ (let ((fullname
+ (tramp-drop-volume-letter (expand-file-name filename directory)))
+ hop result result1)
+
+ ;; Suppress hop from completion.
+ (when (string-match
+ (concat
+ tramp-prefix-regexp
+ "\\(" "\\(" tramp-remote-file-name-spec-regexp
+ tramp-postfix-hop-regexp
+ "\\)+" "\\)")
+ fullname)
+ (setq hop (match-string 1 fullname)
+ fullname (replace-match "" nil nil fullname 1)))
+
+ ;; Possible completion structures.
+ (dolist (elt (tramp-completion-dissect-file-name fullname))
+ (let* ((method (tramp-file-name-method elt))
+ (user (tramp-file-name-user elt))
+ (host (tramp-file-name-host elt))
+ (localname (tramp-file-name-localname elt))
(m (tramp-find-method method user host))
(tramp-current-user user) ; see `tramp-parse-passwd'
all-user-hosts)
@@ -2153,18 +2283,16 @@ not in completion mode."
;; Possible methods.
(setq result
- (append result (tramp-get-completion-methods m)))))
+ (append result (tramp-get-completion-methods m)))))))
- (setq v (cdr v))))
-
- ;; Unify list, remove nil elements.
- (while result
- (let ((car (car result)))
- (when car
- (add-to-list
- 'result1
- (substring car (length (tramp-drop-volume-letter directory)))))
- (setq result (cdr result))))
+ ;; Unify list, add hop, remove nil elements.
+ (dolist (elt result)
+ (when elt
+ (string-match tramp-prefix-regexp elt)
+ (setq elt (replace-match (concat tramp-prefix-format hop) nil nil elt))
+ (add-to-list
+ 'result1
+ (substring elt (length (tramp-drop-volume-letter directory))))))
;; Complete local parts.
(append
@@ -2312,9 +2440,9 @@ They are collected by `tramp-completion-dissect-file-name1'."
(concat tramp-prefix-regexp "/$"))
1 nil 3 nil)))
- (mapc (lambda (regexp)
+ (mapc (lambda (structure)
(add-to-list 'result
- (tramp-completion-dissect-file-name1 regexp name)))
+ (tramp-completion-dissect-file-name1 structure name)))
(list
tramp-completion-file-name-structure1
tramp-completion-file-name-structure2
@@ -2348,7 +2476,7 @@ remote host and localname (filename on remote host)."
(match-string (nth 3 structure) name)))
(localname (and (nth 4 structure)
(match-string (nth 4 structure) name))))
- (vector method user host localname)))))
+ (vector method user host localname nil)))))
;; This function returns all possible method completions, adding the
;; trailing method delimiter.
@@ -2362,7 +2490,8 @@ remote host and localname (filename on remote host)."
(mapcar 'car tramp-methods)))
;; Compares partial user and host names with possible completions.
-(defun tramp-get-completion-user-host (method partial-user partial-host user host)
+(defun tramp-get-completion-user-host
+ (method partial-user partial-host user host)
"Returns the most expanded string for user and host name completion.
PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
(cond
@@ -2393,21 +2522,36 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
(unless (zerop (+ (length user) (length host)))
(tramp-completion-make-tramp-file-name method user host nil)))
-;;;###tramp-autoload
-(defun tramp-parse-rhosts (filename)
+;; Generic function.
+(defun tramp-parse-group (regexp match-level skip-regexp)
+ "Return a (user host) tuple allowed to access.
+User is always nil."
+ (let (result)
+ (when (re-search-forward regexp (point-at-eol) t)
+ (setq result (list nil (match-string match-level))))
+ (or
+ (> (skip-chars-forward skip-regexp) 0)
+ (forward-line 1))
+ result))
+
+;; Generic function.
+(defun tramp-parse-file (filename function)
"Return a list of (user host) tuples allowed to access.
-Either user or host may be nil."
+User is always nil."
;; On Windows, there are problems in completion when
;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
+ (let ((default-directory (tramp-compat-temporary-file-directory)))
(when (file-readable-p filename)
(with-temp-buffer
(insert-file-contents filename)
(goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-rhosts-group) res))))
- res))
+ (loop while (not (eobp)) collect (funcall function))))))
+
+;;;###tramp-autoload
+(defun tramp-parse-rhosts (filename)
+ "Return a list of (user host) tuples allowed to access.
+Either user or host may be nil."
+ (tramp-parse-file filename 'tramp-parse-rhosts-group))
(defun tramp-parse-rhosts-group ()
"Return a (user host) tuple allowed to access.
@@ -2417,10 +2561,8 @@ Either user or host may be nil."
(concat
"^\\(" tramp-host-regexp "\\)"
"\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
+ (when (re-search-forward regexp (point-at-eol) t)
(setq result (append (list (match-string 3) (match-string 1)))))
- (widen)
(forward-line 1)
result))
@@ -2428,124 +2570,63 @@ Either user or host may be nil."
(defun tramp-parse-shosts (filename)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-shosts-group) res))))
- res))
+ (tramp-parse-file filename 'tramp-parse-shosts-group))
(defun tramp-parse-shosts-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
- (let ((result)
- (regexp (concat "^\\(" tramp-host-regexp "\\)")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
- (setq result (list nil (match-string 1))))
- (widen)
- (or
- (> (skip-chars-forward ",") 0)
- (forward-line 1))
- result))
+ (tramp-parse-group (concat "^\\(" tramp-host-regexp "\\)") 1 ","))
;;;###tramp-autoload
(defun tramp-parse-sconfig (filename)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-sconfig-group) res))))
- res))
+ (tramp-parse-file filename 'tramp-parse-sconfig-group))
(defun tramp-parse-sconfig-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
- (let ((result)
- (regexp (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
- (setq result (list nil (match-string 1))))
- (widen)
- (or
- (> (skip-chars-forward ",") 0)
- (forward-line 1))
- result))
+ (tramp-parse-group
+ (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)") 1 ","))
-;;;###tramp-autoload
-(defun tramp-parse-shostkeys (dirname)
+;; Generic function.
+(defun tramp-parse-shostkeys-sknownhosts (dirname regexp)
"Return a list of (user host) tuples allowed to access.
User is always nil."
;; On Windows, there are problems in completion when
;; `default-directory' is remote.
(let* ((default-directory (tramp-compat-temporary-file-directory))
- (regexp (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$"))
- (files (when (file-directory-p dirname) (directory-files dirname)))
- result)
- (while files
- (when (string-match regexp (car files))
- (push (list nil (match-string 1 (car files))) result))
- (setq files (cdr files)))
- result))
+ (files (and (file-directory-p dirname) (directory-files dirname))))
+ (loop for f in files
+ when (and (not (string-match "^\\.\\.?$" f)) (string-match regexp f))
+ collect (list nil (match-string 1 f)))))
+
+;;;###tramp-autoload
+(defun tramp-parse-shostkeys (dirname)
+ "Return a list of (user host) tuples allowed to access.
+User is always nil."
+ (tramp-parse-shostkeys-sknownhosts
+ dirname (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$")))
+;;;###tramp-autoload
(defun tramp-parse-sknownhosts (dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let* ((default-directory (tramp-compat-temporary-file-directory))
- (regexp (concat "^\\(" tramp-host-regexp
- "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$"))
- (files (when (file-directory-p dirname) (directory-files dirname)))
- result)
- (while files
- (when (string-match regexp (car files))
- (push (list nil (match-string 1 (car files))) result))
- (setq files (cdr files)))
- result))
+ (tramp-parse-shostkeys-sknownhosts
+ dirname
+ (concat "^\\(" tramp-host-regexp "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$")))
;;;###tramp-autoload
(defun tramp-parse-hosts (filename)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-hosts-group) res))))
- res))
+ (tramp-parse-file filename 'tramp-parse-hosts-group))
(defun tramp-parse-hosts-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
- (let ((result)
- (regexp
- (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
- (setq result (list nil (match-string 1))))
- (widen)
- (or
- (> (skip-chars-forward " \t") 0)
- (forward-line 1))
- result))
+ (tramp-parse-group
+ (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)") 1 " \t"))
;; For su-alike methods it would be desirable to return "root@localhost"
;; as default. Unfortunately, we have no information whether any user name
@@ -2555,29 +2636,17 @@ User is always nil."
(defun tramp-parse-passwd (filename)
"Return a list of (user host) tuples allowed to access.
Host is always \"localhost\"."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (if (zerop (length tramp-current-user))
- '(("root" nil))
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-passwd-group) res))))
- res)))
+ (if (zerop (length tramp-current-user))
+ '(("root" nil))
+ (tramp-parse-file filename 'tramp-parse-passwd-group)))
(defun tramp-parse-passwd-group ()
"Return a (user host) tuple allowed to access.
Host is always \"localhost\"."
(let ((result)
(regexp (concat "^\\(" tramp-user-regexp "\\):")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
+ (when (re-search-forward regexp (point-at-eol) t)
(setq result (list (match-string 1) "localhost")))
- (widen)
(forward-line 1)
result))
@@ -2585,17 +2654,7 @@ Host is always \"localhost\"."
(defun tramp-parse-netrc (filename)
"Return a list of (user host) tuples allowed to access.
User may be nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-netrc-group) res))))
- res))
+ (tramp-parse-file filename 'tramp-parse-netrc-group))
(defun tramp-parse-netrc-group ()
"Return a (user host) tuple allowed to access.
@@ -2605,37 +2664,33 @@ User may be nil."
(concat
"^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)"
"\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
+ (when (re-search-forward regexp (point-at-eol) t)
(setq result (list (match-string 3) (match-string 1))))
- (widen)
(forward-line 1)
result))
;;;###tramp-autoload
-(defun tramp-parse-putty (registry)
+(defun tramp-parse-putty (registry-or-dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (with-temp-buffer
- (when (zerop (tramp-compat-call-process "reg" nil t nil "query" registry))
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-putty-group registry) res))))
- res))
+ (if (memq system-type '(windows-nt))
+ (with-temp-buffer
+ (when (zerop (tramp-compat-call-process
+ "reg" nil t nil "query" registry-or-dirname))
+ (goto-char (point-min))
+ (loop while (not (eobp)) collect
+ (tramp-parse-putty-group registry-or-dirname))))
+ ;; UNIX case.
+ (tramp-parse-shostkeys-sknownhosts
+ registry-or-dirname (concat "^\\(" tramp-host-regexp "\\)$"))))
(defun tramp-parse-putty-group (registry)
"Return a (user host) tuple allowed to access.
User is always nil."
(let ((result)
(regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
+ (when (re-search-forward regexp (point-at-eol) t)
(setq result (list nil (match-string 1))))
- (widen)
(forward-line 1)
result))
@@ -2845,78 +2900,80 @@ User is always nil."
(setq filename (expand-file-name filename))
(let (result local-copy remote-copy)
(with-parsed-tramp-file-name filename nil
- (unwind-protect
- (if (not (file-exists-p filename))
- ;; We don't raise a Tramp error, because it might be
- ;; suppressed, like in `find-file-noselect-1'.
- (signal 'file-error
- (list "File not found on remote host" filename))
-
- (if (and (tramp-local-host-p v)
- (let (file-name-handler-alist)
- (file-readable-p localname)))
- ;; Short track: if we are on the local host, we can
- ;; run directly.
- (setq result
- (tramp-run-real-handler
- 'insert-file-contents
- (list localname visit beg end replace)))
-
- ;; When we shall insert only a part of the file, we copy
- ;; this part.
- (when (or beg end)
- (setq remote-copy (tramp-make-tramp-temp-file v))
- ;; This is defined in tramp-sh.el. Let's assume this
- ;; is loaded already.
- (tramp-compat-funcall 'tramp-send-command
- v
- (cond
- ((and beg end)
- (format "dd bs=1 skip=%d if=%s count=%d of=%s"
- beg (tramp-shell-quote-argument localname)
- (- end beg) remote-copy))
- (beg
- (format "dd bs=1 skip=%d if=%s of=%s"
- beg (tramp-shell-quote-argument localname)
- remote-copy))
- (end
- (format "dd bs=1 count=%d if=%s of=%s"
- end (tramp-shell-quote-argument localname)
- remote-copy)))))
-
- ;; `insert-file-contents-literally' takes care to avoid
- ;; calling jka-compr. By let-binding
- ;; `inhibit-file-name-operation', we propagate that care
- ;; to the `file-local-copy' operation.
- (setq local-copy
- (let ((inhibit-file-name-operation
- (when (eq inhibit-file-name-operation
- 'insert-file-contents)
- 'file-local-copy)))
- (cond
- ((stringp remote-copy)
- (file-local-copy
- (tramp-make-tramp-file-name
- method user host remote-copy)))
- ((stringp tramp-temp-buffer-file-name)
- (copy-file filename tramp-temp-buffer-file-name 'ok)
- tramp-temp-buffer-file-name)
- (t (file-local-copy filename)))))
-
- ;; When the file is not readable for the owner, it
- ;; cannot be inserted, even if it is readable for the
- ;; group or for everybody.
- (set-file-modes local-copy (tramp-compat-octal-to-decimal "0600"))
-
- (when (and (null remote-copy)
- (tramp-get-method-parameter
- method 'tramp-copy-keep-tmpfile))
- ;; We keep the local file for performance reasons,
- ;; useful for "rsync".
- (setq tramp-temp-buffer-file-name local-copy))
-
- (tramp-with-progress-reporter
- v 3 (format "Inserting local temp file `%s'" local-copy)
+ (with-tramp-progress-reporter
+ v 3 (format "Inserting `%s'" filename)
+ (unwind-protect
+ (if (not (file-exists-p filename))
+ ;; We don't raise a Tramp error, because it might be
+ ;; suppressed, like in `find-file-noselect-1'.
+ (signal 'file-error
+ (list "File not found on remote host" filename))
+
+ (if (and (tramp-local-host-p v)
+ (let (file-name-handler-alist)
+ (file-readable-p localname)))
+ ;; Short track: if we are on the local host, we can
+ ;; run directly.
+ (setq result
+ (tramp-run-real-handler
+ 'insert-file-contents
+ (list localname visit beg end replace)))
+
+ ;; When we shall insert only a part of the file, we
+ ;; copy this part.
+ (when (or beg end)
+ (setq remote-copy (tramp-make-tramp-temp-file v))
+ ;; This is defined in tramp-sh.el. Let's assume
+ ;; this is loaded already.
+ (tramp-compat-funcall
+ 'tramp-send-command
+ v
+ (cond
+ ((and beg end)
+ (format "dd bs=1 skip=%d if=%s count=%d of=%s"
+ beg (tramp-shell-quote-argument localname)
+ (- end beg) remote-copy))
+ (beg
+ (format "dd bs=1 skip=%d if=%s of=%s"
+ beg (tramp-shell-quote-argument localname)
+ remote-copy))
+ (end
+ (format "dd bs=1 count=%d if=%s of=%s"
+ end (tramp-shell-quote-argument localname)
+ remote-copy)))))
+
+ ;; `insert-file-contents-literally' takes care to
+ ;; avoid calling jka-compr. By let-binding
+ ;; `inhibit-file-name-operation', we propagate that
+ ;; care to the `file-local-copy' operation.
+ (setq local-copy
+ (let ((inhibit-file-name-operation
+ (when (eq inhibit-file-name-operation
+ 'insert-file-contents)
+ 'file-local-copy)))
+ (cond
+ ((stringp remote-copy)
+ (file-local-copy
+ (tramp-make-tramp-file-name
+ method user host remote-copy)))
+ ((stringp tramp-temp-buffer-file-name)
+ (copy-file filename tramp-temp-buffer-file-name 'ok)
+ tramp-temp-buffer-file-name)
+ (t (file-local-copy filename)))))
+
+ ;; When the file is not readable for the owner, it
+ ;; cannot be inserted, even if it is readable for the
+ ;; group or for everybody.
+ (set-file-modes
+ local-copy (tramp-compat-octal-to-decimal "0600"))
+
+ (when (and (null remote-copy)
+ (tramp-get-method-parameter
+ method 'tramp-copy-keep-tmpfile))
+ ;; We keep the local file for performance reasons,
+ ;; useful for "rsync".
+ (setq tramp-temp-buffer-file-name local-copy))
+
;; We must ensure that `file-coding-system-alist'
;; matches `local-copy'.
(let ((file-coding-system-alist
@@ -2924,21 +2981,21 @@ User is always nil."
filename local-copy)))
(setq result
(insert-file-contents
- local-copy nil nil nil replace))))))
-
- ;; Save exit.
- (progn
- (when visit
- (setq buffer-file-name filename)
- (setq buffer-read-only (not (file-writable-p filename)))
- (set-visited-file-modtime)
- (set-buffer-modified-p nil))
- (when (and (stringp local-copy)
- (or remote-copy (null tramp-temp-buffer-file-name)))
- (delete-file local-copy))
- (when (stringp remote-copy)
- (delete-file
- (tramp-make-tramp-file-name method user host remote-copy))))))
+ local-copy nil nil nil replace)))))
+
+ ;; Save exit.
+ (progn
+ (when visit
+ (setq buffer-file-name filename)
+ (setq buffer-read-only (not (file-writable-p filename)))
+ (set-visited-file-modtime)
+ (set-buffer-modified-p nil))
+ (when (and (stringp local-copy)
+ (or remote-copy (null tramp-temp-buffer-file-name)))
+ (delete-file local-copy))
+ (when (stringp remote-copy)
+ (delete-file
+ (tramp-make-tramp-file-name method user host remote-copy)))))))
;; Result.
(list (expand-file-name filename)
@@ -2966,7 +3023,7 @@ User is always nil."
(if (not (file-exists-p file))
nil
(let ((tramp-message-show-message (not nomessage)))
- (tramp-with-progress-reporter v 0 (format "Loading %s" file)
+ (with-tramp-progress-reporter v 0 (format "Loading %s" file)
(let ((local-copy (file-local-copy file)))
;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
(unwind-protect
@@ -3109,23 +3166,29 @@ beginning of local filename are not substituted."
(defun tramp-action-login (proc vec)
"Send the login name."
(when (not (stringp tramp-current-user))
- (save-window-excursion
- (let ((enable-recursive-minibuffers t))
- (pop-to-buffer (tramp-get-connection-buffer vec))
- (setq tramp-current-user (read-string (match-string 0))))))
- (tramp-message vec 3 "Sending login name `%s'" tramp-current-user)
+ (setq tramp-current-user
+ (with-tramp-connection-property vec "login-as"
+ (save-window-excursion
+ (let ((enable-recursive-minibuffers t))
+ (pop-to-buffer (tramp-get-connection-buffer vec))
+ (read-string (match-string 0)))))))
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string)))
- (tramp-send-string vec tramp-current-user))
+ (tramp-message vec 3 "Sending login name `%s'" tramp-current-user)
+ (tramp-send-string vec (concat tramp-current-user tramp-local-end-of-line)))
(defun tramp-action-password (proc vec)
"Query the user for a password."
(with-current-buffer (process-buffer proc)
- (tramp-check-for-regexp proc tramp-password-prompt-regexp)
- (tramp-message vec 3 "Sending %s" (match-string 1))
- (tramp-enter-password proc)
- ;; Hide password prompt.
- (narrow-to-region (point-max) (point-max))))
+ (let ((enable-recursive-minibuffers t))
+ (tramp-check-for-regexp proc tramp-password-prompt-regexp)
+ (tramp-message vec 3 "Sending %s" (match-string 1))
+ ;; We don't call `tramp-send-string' in order to hide the
+ ;; password from the debug buffer.
+ (process-send-string
+ proc (concat (tramp-read-passwd proc) tramp-local-end-of-line))
+ ;; Hide password prompt.
+ (narrow-to-region (point-max) (point-max)))))
(defun tramp-action-succeed (proc vec)
"Signal success in finding shell prompt."
@@ -3148,7 +3211,7 @@ See also `tramp-action-yn'."
(throw 'tramp-action 'permission-denied))
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string)))
- (tramp-send-string vec "yes"))))
+ (tramp-send-string vec (concat "yes" tramp-local-end-of-line)))))
(defun tramp-action-yn (proc vec)
"Ask the user for confirmation using `y-or-n-p'.
@@ -3162,7 +3225,7 @@ See also `tramp-action-yesno'."
(throw 'tramp-action 'permission-denied))
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string)))
- (tramp-send-string vec "y"))))
+ (tramp-send-string vec (concat "y" tramp-local-end-of-line)))))
(defun tramp-action-terminal (proc vec)
"Tell the remote host which terminal type to use.
@@ -3170,7 +3233,7 @@ The terminal type can be configured with `tramp-terminal-type'."
(tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string)))
- (tramp-send-string vec tramp-terminal-type))
+ (tramp-send-string vec (concat tramp-terminal-type tramp-local-end-of-line)))
(defun tramp-action-process-alive (proc vec)
"Check, whether a process has finished."
@@ -3227,7 +3290,7 @@ set, is the starting point of the region to be deleted in the
connection buffer."
;; Preserve message for `progress-reporter'.
(tramp-compat-with-temp-message ""
- ;; Enable auth-source and password-cache. We must use
+ ;; Enable `auth-source' and `password-cache'. We must use
;; tramp-current-* variables in case we have several hops.
(tramp-set-connection-property
(tramp-dissect-file-name
@@ -3271,7 +3334,9 @@ for process communication also."
;; Under Windows XP, accept-process-output doesn't return
;; sometimes. So we add an additional timeout.
(with-timeout ((or timeout 1))
- (accept-process-output proc timeout timeout-msecs)))
+ (if (featurep 'xemacs)
+ (accept-process-output proc timeout timeout-msecs)
+ (accept-process-output proc timeout timeout-msecs (and proc t)))))
(tramp-message proc 10 "\n%s" (buffer-string))))
(defun tramp-check-for-regexp (proc regexp)
@@ -3302,8 +3367,12 @@ Erase echoed commands if exists."
'buffer-substring-no-properties
1 (min (1+ tramp-echo-mark-marker-length) (point-max))))))
;; No echo to be handled, now we can look for the regexp.
- (goto-char (point-min))
- (re-search-forward regexp nil t))))
+ ;; Sometimes, lines are much to long, and we run into a "Stack
+ ;; overflow in regexp matcher". For example, //DIRED// lines of
+ ;; directory listings with some thousand files. Therefore, we
+ ;; look from the end.
+ (goto-char (point-max))
+ (ignore-errors (re-search-backward regexp nil t)))))
(defun tramp-wait-for-regexp (proc timeout regexp)
"Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
@@ -3343,18 +3412,6 @@ nil."
(tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
found)))
-;; We don't call `tramp-send-string' in order to hide the password
-;; from the debug buffer, and because end-of-line handling of the
-;; string.
-(defun tramp-enter-password (proc)
- "Prompt for a password and send it to the remote end."
- (process-send-string
- proc (concat (tramp-read-passwd proc)
- (or (tramp-get-method-parameter
- tramp-current-method
- 'tramp-password-end-of-line)
- tramp-default-password-end-of-line))))
-
;; It seems that Tru64 Unix does not like it if long strings are sent
;; to it in one go. (This happens when sending the Perl
;; `file-attributes' implementation, for instance.) Therefore, we
@@ -3400,28 +3457,14 @@ the remote host use line-endings as defined in the variable
(defun tramp-get-inode (vec)
"Returns the virtual inode number.
If it doesn't exist, generate a new one."
- (let ((string (tramp-make-tramp-file-name
- (tramp-file-name-method vec)
- (tramp-file-name-user vec)
- (tramp-file-name-host vec)
- "")))
- (unless (assoc string tramp-inodes)
- (add-to-list 'tramp-inodes
- (list string (length tramp-inodes))))
- (nth 1 (assoc string tramp-inodes))))
+ (with-tramp-file-property vec (tramp-file-name-localname vec) "inode"
+ (setq tramp-inodes (1+ tramp-inodes))))
(defun tramp-get-device (vec)
"Returns the virtual device number.
If it doesn't exist, generate a new one."
- (let ((string (tramp-make-tramp-file-name
- (tramp-file-name-method vec)
- (tramp-file-name-user vec)
- (tramp-file-name-host vec)
- "")))
- (unless (assoc string tramp-devices)
- (add-to-list 'tramp-devices
- (list string (length tramp-devices))))
- (cons -1 (nth 1 (assoc string tramp-devices)))))
+ (with-tramp-connection-property (tramp-get-connection-process vec) "device"
+ (cons -1 (setq tramp-devices (1+ tramp-devices)))))
(defun tramp-equal-remote (file1 file2)
"Check, whether the remote parts of FILE1 and FILE2 are identical.
@@ -3441,12 +3484,7 @@ would yield `t'. On the other hand, the following check results in nil:
(stringp (file-remote-p file2))
(string-equal (file-remote-p file1) (file-remote-p file2))))
-(defun tramp-get-method-parameter (method param)
- "Return the method parameter PARAM.
-If the `tramp-methods' entry does not exist, return nil."
- (let ((entry (assoc param (assoc method tramp-methods))))
- (when entry (cadr entry))))
-
+;;;###tramp-autoload
(defun tramp-mode-string-to-int (mode-string)
"Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
(let* (case-fold-search
@@ -3518,6 +3556,7 @@ If the `tramp-methods' entry does not exist, return nil."
(t (error "Tenth char `%c' must be one of `xtT-'"
other-execute-or-sticky)))))))
+;;;###tramp-autoload
(defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise."
;; We cannot use `tramp-file-name-real-host'. A port is an
@@ -3546,7 +3585,7 @@ If the `tramp-methods' entry does not exist, return nil."
(defun tramp-get-remote-tmpdir (vec)
"Return directory for temporary files on the remote host identified by VEC."
- (with-connection-property vec "tmpdir"
+ (with-tramp-connection-property vec "tmpdir"
(let ((dir (tramp-make-tramp-file-name
(tramp-file-name-method vec)
(tramp-file-name-user vec)
@@ -3559,6 +3598,7 @@ If the `tramp-methods' entry does not exist, return nil."
dir
(tramp-error vec 'file-error "Directory %s not accessible" dir)))))
+;;;###tramp-autoload
(defun tramp-make-tramp-temp-file (vec)
"Create a temporary file on the remote host identified by VEC.
Return the local name of the temporary file."
@@ -3653,6 +3693,7 @@ ALIST is of the form ((FROM . TO) ...)."
;;; Compatibility functions section:
+;;;###tramp-autoload
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
Consults the auth-source package.
@@ -3703,6 +3744,7 @@ Invokes `password-read' if available, `read-passwd' else."
(read-passwd pw-prompt))
(tramp-set-connection-property v "first-password-request" nil)))))
+;;;###tramp-autoload
(defun tramp-clear-passwd (vec)
"Clear password cache for connection related to VEC."
(tramp-compat-funcall
@@ -3725,6 +3767,8 @@ Invokes `password-read' if available, `read-passwd' else."
("oct" . 10) ("nov" . 11) ("dec" . 12))
"Alist mapping month names to integers.")
+;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2?
+;;;###tramp-autoload
(defun tramp-time-less-p (t1 t2)
"Say whether time value T1 is less than time value T2."
(unless t1 (setq t1 '(0 0)))
@@ -3733,6 +3777,7 @@ Invokes `password-read' if available, `read-passwd' else."
(and (= (car t1) (car t2))
(< (nth 1 t1) (nth 1 t2)))))
+;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2?
(defun tramp-time-subtract (t1 t2)
"Subtract two time values.
Return the difference in the format of a time value."
@@ -3742,6 +3787,7 @@ Return the difference in the format of a time value."
(list (- (car t1) (car t2) (if borrow 1 0))
(- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
+;;;###tramp-autoload
(defun tramp-time-diff (t1 t2)
"Return the difference between the two times, in seconds.
T1 and T2 are time values (as returned by `current-time' for example)."
@@ -3829,15 +3875,12 @@ Only works for Bourne-like shells."
;; * In Emacs 21, `insert-directory' shows total number of bytes used
;; by the files in that directory. Add this here.
;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
-;; * Make ffap.el grok Tramp filenames. (Eli Tziperman)
;; * abbreviate-file-name
;; * Better error checking. At least whenever we see something
;; strange when doing zerop, we should kill the process and start
;; again. (Greg Stark)
;; * Username and hostname completion.
;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode-p'.
-;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'.
-;; Code is nearly identical.
;; * Make `tramp-default-user' obsolete.
;; * Implement a general server-local-variable mechanism, as there are
;; probably other variables that need different values for different
@@ -3858,9 +3901,6 @@ Only works for Bourne-like shells."
;; * Run emerge on two remote files. Bug is described here:
;; <http://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>.
;; (Bug#6850)
-;; * It would be very useful if it were possible to load or save a
-;; buffer using Tramp in a non-blocking way so that use of Emacs on
-;; other buffers could continue. (Bug#9617)
;;; tramp.el ends here
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index fc0c936c407..331884691f4 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -1,7 +1,7 @@
;;; trampver.el --- Transparent Remote Access, Multiple Protocol
;;; lisp/trampver.el. Generated from trampver.el.in by configure.
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
;; Keywords: comm, processes
@@ -31,7 +31,7 @@
;; should be changed only there.
;;;###tramp-autoload
-(defconst tramp-version "2.2.3-24.1"
+(defconst tramp-version "2.2.7-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -44,7 +44,7 @@
(= emacs-major-version 21)
(>= emacs-minor-version 4)))
"ok"
- (format "Tramp 2.2.3-24.1 is not fit for %s"
+ (format "Tramp 2.2.7-pre is not fit for %s"
(when (string-match "^.*$" (emacs-version))
(match-string 0 (emacs-version)))))))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index 6ef24e9f354..d5de2f410c5 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -1,6 +1,6 @@
;;; webjump.el --- programmable Web hotlist
-;; Copyright (C) 1996-1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Neil W. Van Dyke <nwv@acm.org>
;; Created: 09-Aug-1996
@@ -38,7 +38,7 @@
;; example sites. You'll probably want to override it with your own favorite
;; sites. The documentation for the variable describes the syntax.
-;; You may wish to add something like the following to your `.emacs' file:
+;; You may wish to add something like the following to your init file:
;;
;; (require 'webjump)
;; (global-set-key "\C-cj" 'webjump)
@@ -276,7 +276,7 @@ function and the `webjump-sites' variable.")
(defvar webjump-sites
webjump-sample-sites
- "*Hotlist for WebJump.
+ "Hotlist for WebJump.
The hotlist is represented as an association list, with the CAR of each cell
being the name of the Web site, and the CDR being the definition for the URL of
diff --git a/lisp/net/xesam.el b/lisp/net/xesam.el
index 17b22aa03ba..585e5eed52d 100644
--- a/lisp/net/xesam.el
+++ b/lisp/net/xesam.el
@@ -1,6 +1,6 @@
;;; xesam.el --- Xesam interface to search engines.
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: tools, hypermedia
@@ -127,17 +127,8 @@
;;; Code:
-;; D-Bus support in the Emacs core can be disabled with configuration
-;; option "--without-dbus". Declare used subroutines and variables.
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
-
(require 'dbus)
-;; Pacify byte compiler.
-(eval-when-compile
- (require 'cl))
-
;; Widgets are used to highlight the search results.
(require 'widget)
(require 'wid-edit)
@@ -414,24 +405,24 @@ If there is no registered search engine at all, the function returns `nil'."
;; That is not the case now, so we set it ourselves.
;; Hopefully, this will change later.
(setq hit-fields
- (case (intern vendor-id)
- (Beagle
+ (pcase (intern vendor-id)
+ (`Beagle
'("xesam:mimeType" "xesam:url"))
- (Strigi
+ (`Strigi
'("xesam:author" "xesam:cc" "xesam:charset"
"xesam:contentType" "xesam:fileExtension"
"xesam:id" "xesam:lineCount" "xesam:links"
"xesam:mimeType" "xesam:name" "xesam:size"
"xesam:sourceModified" "xesam:subject" "xesam:to"
"xesam:url"))
- (TrackerXesamSession
+ (`TrackerXesamSession
'("xesam:relevancyRating" "xesam:url"))
- (Debbugs
+ (`Debbugs
'("xesam:keyword" "xesam:owner" "xesam:title"
"xesam:url" "xesam:sourceModified" "xesam:mimeType"
"debbugs:key"))
;; xesam-tools yahoo service.
- (t '("xesam:contentModified" "xesam:mimeType" "xesam:summary"
+ (_ '("xesam:contentModified" "xesam:mimeType" "xesam:summary"
"xesam:title" "xesam:url" "yahoo:displayUrl"))))
(xesam-set-property engine "hit.fields" hit-fields)
@@ -449,7 +440,7 @@ If there is no registered search engine at all, the function returns `nil'."
(defvar xesam-mode-map
(let ((map (copy-keymap special-mode-map)))
- (set-keymap-parent xesam-mode-map widget-keymap)
+ (set-keymap-parent map widget-keymap)
map))
(define-derived-mode xesam-mode special-mode "Xesam"
diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el
index a889a6a4177..6a1a009410b 100644
--- a/lisp/net/zeroconf.el
+++ b/lisp/net/zeroconf.el
@@ -1,6 +1,6 @@
;;; zeroconf.el --- Service browser using Avahi.
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, hardware
@@ -102,11 +102,6 @@
;; Pacify byte-compiler. D-Bus support in the Emacs core can be
;; disabled with configuration option "--without-dbus". Declare used
;; subroutines and variables of `dbus' therefore.
-(eval-when-compile
- (require 'cl))
-
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
(defvar dbus-debug)
(require 'dbus)
@@ -548,7 +543,7 @@ DOMAIN is nil, the local domain is used."
((string-equal (dbus-event-member-name last-input-event) "ItemNew")
;; Parameters: (interface protocol type domain flags)
;; Register a service browser.
- (let ((object-path (zeroconf-register-service-browser (nth-value 2 val))))
+ (let ((object-path (zeroconf-register-service-browser (nth 2 val))))
;; Register the signals.
(dolist (member '("ItemNew" "ItemRemove" "Failure"))
(dbus-register-signal
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 3f2338b3a4c..2ddfb2439af 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -1,6 +1,6 @@
;;; newcomment.el --- (un)comment regions of buffers -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: code extracted from Emacs-20's simple.el
;; Maintainer: Stefan Monnier <monnier@iro.umontreal.ca>
@@ -24,7 +24,13 @@
;;; Commentary:
-;; A replacement for simple.el's comment-related functions.
+;; This library contains functions and variables for commenting and
+;; uncommenting source code.
+
+;; Prior to calling any `comment-*' function, you should ensure that
+;; `comment-normalize-vars' is first called to set up the appropriate
+;; variables; except for the `comment-*' commands, which call
+;; `comment-normalize-vars' automatically as a subroutine.
;;; Bugs:
@@ -102,30 +108,35 @@ Comments might be indented to a different value in order not to go beyond
:type 'integer
:group 'comment)
(make-variable-buffer-local 'comment-column)
-;;;###autoload(put 'comment-column 'safe-local-variable 'integerp)
+;;;###autoload
+(put 'comment-column 'safe-local-variable 'integerp)
;;;###autoload
(defvar comment-start nil
- "*String to insert to start a new comment, or nil if no comment syntax.")
-;;;###autoload(put 'comment-start 'safe-local-variable 'string-or-null-p)
+ "String to insert to start a new comment, or nil if no comment syntax.")
+;;;###autoload
+(put 'comment-start 'safe-local-variable 'string-or-null-p)
;;;###autoload
(defvar comment-start-skip nil
- "*Regexp to match the start of a comment plus everything up to its body.
+ "Regexp to match the start of a comment plus everything up to its body.
If there are any \\(...\\) pairs, the comment delimiter text is held to begin
at the place matched by the close of the first pair.")
-;;;###autoload(put 'comment-start-skip 'safe-local-variable 'string-or-null-p)
+;;;###autoload
+(put 'comment-start-skip 'safe-local-variable 'stringp)
;;;###autoload
(defvar comment-end-skip nil
"Regexp to match the end of a comment plus everything back to its body.")
-;;;###autoload(put 'comment-end-skip 'safe-local-variable 'string-or-null-p)
+;;;###autoload
+(put 'comment-end-skip 'safe-local-variable 'stringp)
;;;###autoload
(defvar comment-end (purecopy "")
- "*String to insert to end a new comment.
+ "String to insert to end a new comment.
Should be an empty string if comments are terminated by end-of-line.")
-;;;###autoload(put 'comment-end 'safe-local-variable 'string-or-null-p)
+;;;###autoload
+(put 'comment-end 'safe-local-variable 'stringp)
;;;###autoload
(defvar comment-indent-function 'comment-indent-default
@@ -185,6 +196,7 @@ The `plain' comment style doubles this value.
This should generally stay 0, except for a few modes like Lisp where
it is 1 so that regions are commented with two or three semi-colons.")
+;;;###autoload
(defconst comment-styles
'((plain nil nil nil nil
"Start in column 0 (do not indent), as in Emacs-20")
@@ -224,7 +236,7 @@ ALIGN specifies that the `comment-end' markers should be aligned.
/* bli */
if `comment-end' is empty, this has no effect, unless EXTRA is also set,
in which case the comment gets wrapped in a box.
-
+
EXTRA specifies that an extra line should be used before and after the
region to comment (to put the `comment-end' and `comment-start').
e.g. in C it comments regions as
@@ -268,6 +280,19 @@ makes the comment easier to read. Default is 1. nil means 0."
:type '(choice string integer (const nil))
:group 'comment)
+(defcustom comment-inline-offset 1
+ "Inline comments have to be preceded by at least this many spaces.
+This is useful when style-conventions require a certain minimal offset.
+Python's PEP8 for example recommends two spaces, so you could do:
+
+\(add-hook 'python-mode-hook
+ (lambda () (set (make-local-variable 'comment-inline-offset) 2)))
+
+See `comment-padding' for whole-line comments."
+ :version "24.3"
+ :type 'integer
+ :group 'comment)
+
;;;###autoload
(defcustom comment-multi-line nil
"Non-nil means `comment-indent-new-line' continues comments.
@@ -307,10 +332,11 @@ 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
-the variables are properly set."
+ "Check and set up variables needed by other commenting functions.
+All the `comment-*' commands call this function to set up various
+variables, like `comment-start', to ensure that the commenting
+functions work correctly. Lisp callers of any other `comment-*'
+function should first call this function explicitly."
(unless (and (not comment-start) noerror)
(unless comment-start
(let ((cs (read-string "No comment syntax is defined. Use: ")))
@@ -586,7 +612,7 @@ Point is expected to be at the start of the comment."
(save-excursion (end-of-line) (current-column)))))
(other nil)
(min (save-excursion (skip-chars-backward " \t")
- (1+ (current-column)))))
+ (if (bolp) 0 (+ comment-inline-offset (current-column))))))
;; Fix up the range.
(if (< max min) (setq max min))
;; Don't move past the fill column.
@@ -686,7 +712,8 @@ If CONTINUE is non-nil, use the `comment-continue' markers if any."
(save-excursion
(skip-chars-backward " \t")
(unless (bolp)
- (setq indent (max indent (1+ (current-column))))))
+ (setq indent (max indent
+ (+ (current-column) comment-inline-offset)))))
;; If that's different from comment's current position, change it.
(unless (= (current-column) indent)
(delete-region (point) (progn (skip-chars-backward " \t") (point)))
@@ -872,14 +899,15 @@ comment markers."
(when (and sre (looking-at (concat "\\s-*\n\\s-*" srei)))
(goto-char (match-end 0)))
(if (null arg) (delete-region (point-min) (point))
- (skip-syntax-backward " ")
- (delete-char (- numarg))
- (unless (or (bobp)
- (save-excursion (goto-char (point-min))
- (looking-at comment-start-skip)))
- ;; If there's something left but it doesn't look like
- ;; a comment-start any more, just remove it.
- (delete-region (point-min) (point))))
+ (let ((opoint (point-marker)))
+ (skip-syntax-backward " ")
+ (delete-char (- numarg))
+ (unless (and (not (bobp))
+ (save-excursion (goto-char (point-min))
+ (looking-at comment-start-skip)))
+ ;; If there's something left but it doesn't look like
+ ;; a comment-start any more, just remove it.
+ (delete-region (point-min) opoint))))
;; Remove the end-comment (and leading padding and such).
(goto-char (point-max)) (comment-enter-backward)
diff --git a/lisp/notifications.el b/lisp/notifications.el
index e4e44fb0f67..6f477eb4cdd 100644
--- a/lisp/notifications.el
+++ b/lisp/notifications.el
@@ -1,6 +1,6 @@
;;; notifications.el --- Client interface to desktop notifications.
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: comm desktop notifications
@@ -23,7 +23,7 @@
;;; Commentary:
;; This package provides an implementation of the Desktop Notifications
-;; <http://www.galago-project.org/specs/notification/>.
+;; <http://developer.gnome.org/notification-spec/>.
;; In order to activate this package, you must add the following code
;; into your .emacs:
@@ -34,18 +34,9 @@
;; active D-Bus session bus.
;;; Code:
-(eval-when-compile
- (require 'cl))
-
-;; Pacify byte-compiler. D-Bus support in the Emacs core can be
-;; disabled with configuration option "--without-dbus". Declare used
-;; subroutines and variables of `dbus' therefore.
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
-
(require 'dbus)
-(defconst notifications-specification-version "1.1"
+(defconst notifications-specification-version "1.2"
"The version of the Desktop Notifications Specification implemented.")
(defconst notifications-application-name "Emacs"
@@ -64,13 +55,19 @@
"D-Bus notifications service path.")
(defconst notifications-interface "org.freedesktop.Notifications"
- "D-Bus notifications service path.")
+ "D-Bus notifications service interface.")
(defconst notifications-notify-method "Notify"
- "D-Bus notifications service path.")
+ "D-Bus notifications notify method.")
(defconst notifications-close-notification-method "CloseNotification"
- "D-Bus notifications service path.")
+ "D-Bus notifications close notification method.")
+
+(defconst notifications-get-capabilities-method "GetCapabilities"
+ "D-Bus notifications get capabilities method.")
+
+(defconst notifications-get-server-information-method "GetServerInformation"
+ "D-Bus notifications get server information method.")
(defconst notifications-action-signal "ActionInvoked"
"D-Bus notifications action signal.")
@@ -88,46 +85,50 @@
(defvar notifications-on-action-map nil
"Mapping between notification and action callback functions.")
+(defvar notifications-on-action-object nil
+ "Object for registered on-action signal.")
+
(defvar notifications-on-close-map nil
"Mapping between notification and close callback functions.")
+(defvar notifications-on-close-object nil
+ "Object for registered on-close signal.")
+
(defun notifications-on-action-signal (id action)
"Dispatch signals to callback functions from `notifications-on-action-map'."
- (let ((entry (assoc id notifications-on-action-map)))
+ (let* ((bus (dbus-event-bus-name last-input-event))
+ (unique-name (dbus-event-service-name last-input-event))
+ (entry (assoc (list bus unique-name id) notifications-on-action-map)))
(when entry
(funcall (cadr entry) id action)
- (remove entry 'notifications-on-action-map))))
-
-(when (fboundp 'dbus-register-signal)
- (dbus-register-signal
- :session
- notifications-service
- notifications-path
- notifications-interface
- notifications-action-signal
- 'notifications-on-action-signal))
-
-(defun notifications-on-closed-signal (id reason)
+ (when (and (not (setq notifications-on-action-map
+ (remove entry notifications-on-action-map)))
+ notifications-on-action-object)
+ (dbus-unregister-object notifications-on-action-object)
+ (setq notifications-on-action-object nil)))))
+
+(defun notifications-on-closed-signal (id &optional reason)
"Dispatch signals to callback functions from `notifications-on-closed-map'."
- (let ((entry (assoc id notifications-on-close-map)))
+ ;; notification-daemon prior 0.4.0 does not send a reason. So we
+ ;; make it optional, and assume `undefined' as default.
+ (let* ((bus (dbus-event-bus-name last-input-event))
+ (unique-name (dbus-event-service-name last-input-event))
+ (entry (assoc (list bus unique-name id) notifications-on-close-map))
+ (reason (or reason 4)))
(when entry
(funcall (cadr entry)
id (cadr (assoc reason notifications-closed-reason)))
- (remove entry 'notifications-on-close-map))))
-
-(when (fboundp 'dbus-register-signal)
- (dbus-register-signal
- :session
- notifications-service
- notifications-path
- notifications-interface
- notifications-closed-signal
- 'notifications-on-closed-signal))
+ (when (and (not (setq notifications-on-close-map
+ (remove entry notifications-on-close-map)))
+ notifications-on-close-object)
+ (dbus-unregister-object notifications-on-close-object)
+ (setq notifications-on-close-object nil)))))
(defun notifications-notify (&rest params)
"Send notification via D-Bus using the Freedesktop notification protocol.
Various PARAMS can be set:
+ :bus The D-Bus bus, if different from `:session'.
:title The notification title.
:body The notification body text.
:app-name The name of the application sending the notification.
@@ -153,6 +154,8 @@ Various PARAMS can be set:
Default value is -1.
:urgency The urgency level.
Either `low', `normal' or `critical'.
+ :action-items Whether the TITLE of the actions is interpreted as
+ a named icon.
:category The type of notification this is.
:desktop-entry This specifies the name of the desktop filename representing
the calling program.
@@ -169,6 +172,11 @@ Various PARAMS can be set:
be \"message-new-instant\".
:suppress-sound Causes the server to suppress playing any sounds, if it has
that ability.
+ :resident When set the server will not automatically remove the
+ notification when an action has been invoked.
+ :transient When set the server will treat the notification as transient
+ and by-pass the server's persistence capability, if it
+ should exist.
:x Specifies the X location on the screen that the notification
should point to. The \"y\" hint must also be specified.
:y Specifies the Y location on the screen that the notification
@@ -184,11 +192,18 @@ Various PARAMS can be set:
- `dismissed' if the notification was dismissed by the user
- `close-notification' if the notification was closed
by a call to CloseNotification
+ - `undefined' if the notification server hasn't provided
+ a reason
+
+Which parameters are accepted by the notification server can be
+checked via `notifications-get-capabilities'.
This function returns a notification id, an integer, which can be
used to manipulate the notification item with
-`notifications-close-notification'."
- (let ((title (plist-get params :title))
+`notifications-close-notification' or the `:replaces-id' argument
+of another `notifications-notify' call."
+ (let ((bus (or (plist-get params :bus) :session))
+ (title (plist-get params :title))
(body (plist-get params :body))
(app-name (plist-get params :app-name))
(replaces-id (plist-get params :replaces-id))
@@ -202,9 +217,12 @@ used to manipulate the notification item with
(desktop-entry (plist-get params :desktop-entry))
(image-data (plist-get params :image-data))
(image-path (plist-get params :image-path))
+ (action-items (plist-get params :action-items))
(sound-file (plist-get params :sound-file))
(sound-name (plist-get params :sound-name))
(suppress-sound (plist-get params :suppress-sound))
+ (resident (plist-get params :resident))
+ (transient (plist-get params :transient))
(x (plist-get params :x))
(y (plist-get params :y))
id)
@@ -212,10 +230,10 @@ used to manipulate the notification item with
(when urgency
(add-to-list 'hints `(:dict-entry
"urgency"
- (:variant :byte ,(case urgency
- (low 0)
- (critical 2)
- (t 1)))) t))
+ (:variant :byte ,(pcase urgency
+ (`low 0)
+ (`critical 2)
+ (_ 1)))) t))
(when category
(add-to-list 'hints `(:dict-entry
"category"
@@ -226,12 +244,16 @@ used to manipulate the notification item with
(:variant :string ,desktop-entry)) t))
(when image-data
(add-to-list 'hints `(:dict-entry
- "image_data"
+ "image-data"
(:variant :struct ,image-data)) t))
(when image-path
(add-to-list 'hints `(:dict-entry
- "image_path"
+ "image-path"
(:variant :string ,image-path)) t))
+ (when action-items
+ (add-to-list 'hints `(:dict-entry
+ "action-items"
+ (:variant :boolean ,action-items)) t))
(when sound-file
(add-to-list 'hints `(:dict-entry
"sound-file"
@@ -244,14 +266,22 @@ used to manipulate the notification item with
(add-to-list 'hints `(:dict-entry
"suppress-sound"
(:variant :boolean ,suppress-sound)) t))
+ (when resident
+ (add-to-list 'hints `(:dict-entry
+ "resident"
+ (:variant :boolean ,resident)) t))
+ (when transient
+ (add-to-list 'hints `(:dict-entry
+ "transient"
+ (:variant :boolean ,transient)) t))
(when x
(add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
(when y
(add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
- ;; Call Notify method
+ ;; Call Notify method.
(setq id
- (dbus-call-method :session
+ (dbus-call-method bus
notifications-service
notifications-path
notifications-interface
@@ -274,24 +304,104 @@ used to manipulate the notification item with
(or hints '(:array :signature "{sv}"))
:int32 (or timeout -1)))
- ;; Register close/action callback function
+ ;; Register close/action callback function. We must also remember
+ ;; the daemon's unique name, because the daemon could have
+ ;; restarted.
(let ((on-action (plist-get params :on-action))
- (on-close (plist-get params :on-close)))
+ (on-close (plist-get params :on-close))
+ (unique-name (dbus-get-name-owner bus notifications-service)))
(when on-action
- (add-to-list 'notifications-on-action-map (list id on-action)))
+ (add-to-list 'notifications-on-action-map
+ (list (list bus unique-name id) on-action))
+ (unless notifications-on-action-object
+ (setq notifications-on-action-object
+ (dbus-register-signal
+ bus
+ nil
+ notifications-path
+ notifications-interface
+ notifications-action-signal
+ 'notifications-on-action-signal))))
+
(when on-close
- (add-to-list 'notifications-on-close-map (list id on-close))))
+ (add-to-list 'notifications-on-close-map
+ (list (list bus unique-name id) on-close))
+ (unless notifications-on-close-object
+ (setq notifications-on-close-object
+ (dbus-register-signal
+ bus
+ nil
+ notifications-path
+ notifications-interface
+ notifications-closed-signal
+ 'notifications-on-closed-signal)))))
;; Return notification id
id))
-(defun notifications-close-notification (id)
- "Close a notification with identifier ID."
- (dbus-call-method :session
+(defun notifications-close-notification (id &optional bus)
+ "Close a notification with identifier ID.
+BUS can be a string denoting a D-Bus connection, the default is `:session'."
+ (dbus-call-method (or bus :session)
notifications-service
notifications-path
notifications-interface
notifications-close-notification-method
:int32 id))
+(defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
+
+(defun notifications-get-capabilities (&optional bus)
+ "Return the capabilities of the notification server, a list of symbols.
+BUS can be a string denoting a D-Bus connection, the default is `:session'.
+The following capabilities can be expected:
+
+ :actions The server will provide the specified actions
+ to the user.
+ :action-icons Supports using icons instead of text for
+ displaying actions.
+ :body Supports body text.
+ :body-hyperlinks The server supports hyperlinks in the notifications.
+ :body-images The server supports images in the notifications.
+ :body-markup Supports markup in the body text.
+ :icon-multi The server will render an animation of all the
+ frames in a given image array.
+ :icon-static Supports display of exactly 1 frame of any
+ given image array. This value is mutually exclusive
+ with `:icon-multi'.
+ :persistence The server supports persistence of notifications.
+ :sound The server supports sounds on notifications.
+
+Further vendor-specific caps start with `:x-vendor', like `:x-gnome-foo-cap'."
+ (dbus-ignore-errors
+ (mapcar
+ (lambda (x) (intern (concat ":" x)))
+ (dbus-call-method (or bus :session)
+ notifications-service
+ notifications-path
+ notifications-interface
+ notifications-get-capabilities-method))))
+
+(defun notifications-get-server-information (&optional bus)
+ "Return information on the notification server, a list of strings.
+BUS can be a string denoting a D-Bus connection, the default is `:session'.
+The returned list is (NAME VENDOR VERSION SPEC-VERSION).
+
+ NAME The product name of the server.
+ VENDOR The vendor name. For example, \"KDE\", \"GNOME\".
+ VERSION The server's version number.
+ SPEC-VERSION The specification version the server is compliant with.
+
+If SPEC_VERSION is missing, the server supports a specification
+prior to \"1.0\".
+
+See `notifications-specification-version' for the specification
+version this library is compliant with."
+ (dbus-ignore-errors
+ (dbus-call-method (or bus :session)
+ notifications-service
+ notifications-path
+ notifications-interface
+ notifications-get-server-information-method)))
+
(provide 'notifications)
diff --git a/lisp/novice.el b/lisp/novice.el
index e47b17cf346..c621ac4b692 100644
--- a/lisp/novice.el
+++ b/lisp/novice.el
@@ -1,6 +1,6 @@
;;; novice.el --- handling of disabled commands ("novice mode") for Emacs
-;; Copyright (C) 1985-1987, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1994, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal, help
@@ -33,16 +33,14 @@
;; The command is found in this-command
;; and the keys are returned by (this-command-keys).
-(eval-when-compile (require 'cl))
-
+;;;###autoload
+(define-obsolete-variable-alias 'disabled-command-hook
+ 'disabled-command-function "22.1")
;;;###autoload
(defvar disabled-command-function 'disabled-command-function
"Function to call to handle disabled commands.
If nil, the feature is disabled, i.e., all commands work normally.")
-;;;###autoload
-(define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1")
-
;; It is ok here to assume that this-command is a symbol
;; because we won't get called otherwise.
;;;###autoload
@@ -101,7 +99,7 @@ SPC to try the command just this once, but leave it disabled.
(ding)
(message "Please type y, n, ! or SPC (the space bar): "))))
(setq char (downcase char))
- (case char
+ (pcase char
(?\C-g (setq quit-flag t))
(?! (setq disabled-command-function nil))
(?y
@@ -161,8 +159,8 @@ to future sessions."
(defun disable-command (command)
"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."
(interactive "CDisable command: ")
(en/disable-command command t))
diff --git a/lisp/nxml/nxml-enc.el b/lisp/nxml/nxml-enc.el
index 350c5c77c7b..dffea031b97 100644
--- a/lisp/nxml/nxml-enc.el
+++ b/lisp/nxml/nxml-enc.el
@@ -1,6 +1,6 @@
;;; nxml-enc.el --- XML encoding auto-detection
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML
diff --git a/lisp/nxml/nxml-glyph.el b/lisp/nxml/nxml-glyph.el
index 1b48a3fa25f..4ac9764af08 100644
--- a/lisp/nxml/nxml-glyph.el
+++ b/lisp/nxml/nxml-glyph.el
@@ -1,6 +1,6 @@
;;; nxml-glyph.el --- glyph-handling for nxml-mode
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML
@@ -25,7 +25,7 @@
;; The entry point to this file is `nxml-glyph-display-string'.
;; The current implementation is heuristic due to a lack of
;; Emacs primitives necessary to implement it properly. The user
-;; can tweak the heuristics using `nxml-glyph-set-hook'.
+;; can tweak the heuristics using `nxml-glyph-set-functions'.
;;; Code:
@@ -332,21 +332,26 @@ This repertoire is supported for the following fonts:
(#xFB01 . #xFB02)]
"Glyph set corresponding to Windows Glyph List 4.")
-(defvar nxml-glyph-set-hook nil
- "*Hook for determining the set of glyphs in a face.
-The hook will receive a single argument FACE. If it can determine
-the set of glyphs representable by FACE, it must set the variable
-`nxml-glyph-set' and return non-nil. Otherwise, it must return nil.
-The hook will be run until success. The constants
-`nxml-ascii-glyph-set', `nxml-latin1-glyph-set',
+(defvar nxml-glyph-set-functions nil
+ "Abnormal hook for determining the set of glyphs in a face.
+Each function in this hook is called in turn, unless one of them
+returns non-nil. Each function is called with a single argument
+FACE. If it can determine the set of glyphs representable by
+FACE, it must set the variable `nxml-glyph-set' and return
+non-nil. Otherwise, it must return nil.
+
+The constants `nxml-ascii-glyph-set', `nxml-latin1-glyph-set',
`nxml-misc-fixed-1-glyph-set', `nxml-misc-fixed-2-glyph-set',
`nxml-misc-fixed-3-glyph-set' and `nxml-wgl4-glyph-set' are
-predefined for use by `nxml-glyph-set-hook'.")
+predefined for use by `nxml-glyph-set-functions'.")
+
+(define-obsolete-variable-alias 'nxml-glyph-set-hook
+ 'nxml-glyph-set-functions "24.3")
(defvar nxml-glyph-set nil
- "Used by `nxml-glyph-set-hook' to return set of glyphs in a FACE.
+ "Used by `nxml-glyph-set-functions' to return set of glyphs in a FACE.
This should dynamically bound by any function that runs
-`nxml-glyph-set-hook'. The value must be either nil representing an
+`nxml-glyph-set-functions'. The value must be either nil representing an
empty set or a vector. Each member of the vector is either a single
integer or a cons (FIRST . LAST) representing the range of integers
from FIRST to LAST. An integer represents a glyph with that Unicode
@@ -367,7 +372,7 @@ code-point. The vector must be ordered.")
(defun nxml-terminal-set-glyph-set (face)
(setq nxml-glyph-set nxml-ascii-glyph-set))
-(add-hook 'nxml-glyph-set-hook
+(add-hook 'nxml-glyph-set-functions
(or (cdr (assq window-system
'((x . nxml-x-set-glyph-set)
(w32 . nxml-w32-set-glyph-set)
@@ -381,7 +386,7 @@ code-point. The vector must be ordered.")
FACE gives the face that will be used for displaying the string.
Return nil if the face cannot display a glyph for N."
(let ((nxml-glyph-set nil))
- (run-hook-with-args-until-success 'nxml-glyph-set-hook face)
+ (run-hook-with-args-until-success 'nxml-glyph-set-functions face)
(and nxml-glyph-set
(nxml-glyph-set-contains-p n nxml-glyph-set)
(let ((ch (decode-char 'ucs n)))
diff --git a/lisp/nxml/nxml-maint.el b/lisp/nxml/nxml-maint.el
index e24a3d7172a..79d5c354ab1 100644
--- a/lisp/nxml/nxml-maint.el
+++ b/lisp/nxml/nxml-maint.el
@@ -1,6 +1,6 @@
;;; nxml-maint.el --- commands for maintainers of nxml-*.el
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 93e5f9d25f4..1e0e692be26 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -1,6 +1,6 @@
;;; nxml-mode.el --- a new XML mode
-;; Copyright (C) 2003-2004, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML
@@ -29,7 +29,7 @@
(when (featurep 'mucs)
(error "nxml-mode is not compatible with Mule-UCS"))
-(eval-when-compile (require 'cl)) ; for assert
+(eval-when-compile (require 'cl-lib))
(require 'xmltok)
(require 'nxml-enc)
@@ -54,9 +54,9 @@
(defcustom nxml-char-ref-display-glyph-flag t
"Non-nil means display glyph following character reference.
-The glyph is displayed in face `nxml-glyph'. The hook
-`nxml-glyph-set-hook' can be used to customize for which characters
-glyphs are displayed."
+The glyph is displayed in face `nxml-glyph'. The abnormal hook
+`nxml-glyph-set-functions' can be used to change the characters
+for which glyphs are displayed."
:group 'nxml
:type 'boolean)
@@ -86,18 +86,9 @@ as the first attribute on the previous line."
:group 'nxml
:type 'integer)
-(defcustom nxml-bind-meta-tab-to-complete-flag (not window-system)
- "Non-nil means bind M-TAB in `nxml-mode-map' to `nxml-complete'.
-C-return will be bound to `nxml-complete' in any case.
-M-TAB gets swallowed by many window systems/managers, and
-`documentation' will show M-TAB rather than C-return as the
-binding for `nxml-complete' when both are bound. So it's better
-to bind M-TAB only when it will work."
+(defcustom nxml-bind-meta-tab-to-complete-flag t
+ "Non-nil means to use nXML completion in \\[completion-at-point]."
:group 'nxml
- :set (lambda (sym flag)
- (set-default sym flag)
- (when (and (boundp 'nxml-mode-map) nxml-mode-map)
- (define-key nxml-mode-map "\M-\t" (and flag 'nxml-complete))))
:type 'boolean)
(defcustom nxml-prefer-utf-16-to-utf-8-flag nil
@@ -418,9 +409,7 @@ reference.")
(define-key map "\C-c\C-o" nxml-outline-prefix-map)
(define-key map [S-mouse-2] 'nxml-mouse-hide-direct-text-content)
(define-key map "/" 'nxml-electric-slash)
- (define-key map [C-return] 'nxml-complete)
- (when nxml-bind-meta-tab-to-complete-flag
- (define-key map "\M-\t" 'nxml-complete))
+ (define-key map "\M-\t" 'completion-at-point)
map)
"Keymap for nxml-mode.")
@@ -479,7 +468,7 @@ the start-tag, point, and end-tag are all left on separate lines.
If `nxml-slash-auto-complete-flag' is non-nil, then inserting a `</'
automatically inserts the rest of the end-tag.
-\\[nxml-complete] performs completion on the symbol preceding point.
+\\[completion-at-point] performs completion on the symbol preceding point.
\\[nxml-dynamic-markup-word] uses the contents of the current buffer
to choose a tag to put around the word preceding point.
@@ -555,6 +544,8 @@ Many aspects this mode can be customized using
(nxml-clear-inside (point-min) (point-max))
(nxml-with-invisible-motion
(nxml-scan-prolog)))))
+ (add-hook 'completion-at-point-functions
+ #'nxml-completion-at-point-function nil t)
(add-hook 'after-change-functions 'nxml-after-change nil t)
(add-hook 'change-major-mode-hook 'nxml-cleanup nil t)
@@ -939,16 +930,16 @@ Called with `font-lock-beg' and `font-lock-end' dynamically bound."
(nxml-debug-change "nxml-fontify-matcher" (point) bound)
(when (< (point) nxml-prolog-end)
- ;; prolog needs to be fontified in one go, and
+ ;; Prolog needs to be fontified in one go, and
;; nxml-extend-region makes sure we start at BOB.
- (assert (bobp))
+ (cl-assert (bobp))
(nxml-fontify-prolog)
(goto-char nxml-prolog-end))
(let (xmltok-dependent-regions
xmltok-errors)
(while (and (nxml-tokenize-forward)
- (<= (point) bound)) ; intervals are open-ended
+ (<= (point) bound)) ; Intervals are open-ended.
(nxml-apply-fontify-rule)))
(setq nxml-last-fontify-end (point)))
@@ -1245,7 +1236,7 @@ on the line, reindent the line."
(unless arg
(if nxml-slash-auto-complete-flag
(if end-tag-p
- (condition-case err
+ (condition-case nil
(let ((start-tag-end
(nxml-scan-element-backward (1- slash-pos) t)))
(when start-tag-end
@@ -1443,7 +1434,7 @@ its line. Otherwise return nil."
(nxml-token-after)
(= xmltok-start bol))
(eq xmltok-type 'data))
- (condition-case err
+ (condition-case nil
(nxml-scan-element-backward
(point)
nil
@@ -1568,8 +1559,7 @@ This expects the xmltok-* variables to be set up as by `xmltok-forward'."
(off 0))
(if value-boundary
;; inside an attribute value
- (let ((value-start (car value-boundary))
- (value-end (cdr value-boundary)))
+ (let ((value-start (car value-boundary)))
(goto-char pos)
(forward-line -1)
(if (< (point) value-start)
@@ -1654,6 +1644,11 @@ depend on `nxml-completion-hook'."
(ding)
(message "Cannot complete in this context")))
+(defun nxml-completion-at-point-function ()
+ "Call `nxml-complete' to perform completion at point."
+ (when nxml-bind-meta-tab-to-complete-flag
+ #'nxml-complete))
+
;;; Movement
(defun nxml-forward-balanced-item (&optional arg)
@@ -1757,7 +1752,7 @@ single name. A character reference contains a character number."
xmltok-name-end)
(t end)))
-(defun nxml-scan-backward-within (end)
+(defun nxml-scan-backward-within (_end)
(setq xmltok-start
(+ xmltok-start
(nxml-start-delimiter-length xmltok-type)))
@@ -2267,7 +2262,7 @@ ENDP is t in the former case, nil in the latter."
'nxml-in-mixed-content-hook))
nil)
;; See if the matching tag does not start or end a line.
- ((condition-case err
+ ((condition-case nil
(progn
(setq matching-tag-pos
(xmltok-save
@@ -2405,7 +2400,7 @@ Repeating \\[nxml-dynamic-markup-word] immediately after successful
\\[nxml-dynamic-markup-word] removes the previously inserted markup
and attempts to find another possible way to do the markup."
(interactive "*")
- (let (search-start-pos done)
+ (let (search-start-pos)
(if (and (integerp nxml-dynamic-markup-prev-pos)
(= nxml-dynamic-markup-prev-pos (point))
(eq last-command this-command)
diff --git a/lisp/nxml/nxml-ns.el b/lisp/nxml/nxml-ns.el
index 4cf7f50d096..1c6429cd467 100644
--- a/lisp/nxml/nxml-ns.el
+++ b/lisp/nxml/nxml-ns.el
@@ -1,6 +1,6 @@
;;; nxml-ns.el --- XML namespace processing
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML
diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el
index 53d2cabc2e5..850c31cfc9e 100644
--- a/lisp/nxml/nxml-outln.el
+++ b/lisp/nxml/nxml-outln.el
@@ -1,6 +1,6 @@
;;; nxml-outln.el --- outline support for nXML mode
-;; Copyright (C) 2004, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML
@@ -109,23 +109,20 @@ See the variable `nxml-section-element-name-regexp' for more details."
:group 'nxml
:type 'integer)
-(defface nxml-heading
- '((t (:weight bold)))
- "Face used for the contents of abbreviated heading elements."
+(defface nxml-heading '((t :weight bold))
+ "Face for the contents of abbreviated heading elements."
:group 'nxml-faces)
-(defface nxml-outline-indicator
- '((t (:inherit default)))
- "Face used for `+' or `-' before element names in outlines."
+(defface nxml-outline-indicator '((t))
+ "Face for `+' or `-' before element names in outlines."
:group 'nxml-faces)
(defface nxml-outline-active-indicator
- '((t (:box t :inherit nxml-outline-indicator)))
- "Face used for clickable `+' or `-' before element names in outlines."
+ '((t :box t :inherit nxml-outline-indicator))
+ "Face for clickable `+' or `-' before element names in outlines."
:group 'nxml-faces)
-(defface nxml-outline-ellipsis
- '((t (:bold t :inherit default)))
+(defface nxml-outline-ellipsis '((t :weight bold))
"Face used for `...' in outlines."
:group 'nxml-faces)
diff --git a/lisp/nxml/nxml-parse.el b/lisp/nxml/nxml-parse.el
index 36e112e4078..dfe98acd413 100644
--- a/lisp/nxml/nxml-parse.el
+++ b/lisp/nxml/nxml-parse.el
@@ -1,6 +1,6 @@
;;; nxml-parse.el --- XML parser, sharing infrastructure with nxml-mode
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML
diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el
index 05df6118325..e639bc409b8 100644
--- a/lisp/nxml/nxml-rap.el
+++ b/lisp/nxml/nxml-rap.el
@@ -1,6 +1,6 @@
;;; nxml-rap.el --- low-level support for random access parsing for nXML mode
-;; Copyright (C) 2003-2004, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML
diff --git a/lisp/nxml/nxml-uchnm.el b/lisp/nxml/nxml-uchnm.el
index e96ee345ae6..7a49dcc89c5 100644
--- a/lisp/nxml/nxml-uchnm.el
+++ b/lisp/nxml/nxml-uchnm.el
@@ -1,6 +1,6 @@
;;; nxml-uchnm.el --- support for Unicode standard cha names in nxml-mode
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML
diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el
index e2e4ed348bd..6b2c98433a9 100644
--- a/lisp/nxml/nxml-util.el
+++ b/lisp/nxml/nxml-util.el
@@ -1,6 +1,6 @@
;;; nxml-util.el --- utility functions for nxml-*.el
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index 09bd2b75038..9ea68c3e039 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -1,6 +1,6 @@
;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-dt.el b/lisp/nxml/rng-dt.el
index e320f8377b2..e2beaf4dec2 100644
--- a/lisp/nxml/rng-dt.el
+++ b/lisp/nxml/rng-dt.el
@@ -1,6 +1,6 @@
;;; rng-dt.el --- datatype library interface for RELAX NG
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el
index b9e31e0a09e..130183609cc 100644
--- a/lisp/nxml/rng-loc.el
+++ b/lisp/nxml/rng-loc.el
@@ -1,6 +1,6 @@
;;; rng-loc.el --- locate the schema to use for validation
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-maint.el b/lisp/nxml/rng-maint.el
index bd5b3136d54..71fa59f75cc 100644
--- a/lisp/nxml/rng-maint.el
+++ b/lisp/nxml/rng-maint.el
@@ -1,6 +1,6 @@
;;; rng-maint.el --- commands for RELAX NG maintainers
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-match.el b/lisp/nxml/rng-match.el
index 072d932678a..cf49b43ba14 100644
--- a/lisp/nxml/rng-match.el
+++ b/lisp/nxml/rng-match.el
@@ -1,6 +1,6 @@
;;; rng-match.el --- matching of RELAX NG patterns against XML events
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el
index 1686ebfc514..a587c14e01a 100644
--- a/lisp/nxml/rng-nxml.el
+++ b/lisp/nxml/rng-nxml.el
@@ -1,6 +1,6 @@
;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, RelaxNG
@@ -54,7 +54,7 @@
:group 'relax-ng)
(defvar rng-complete-end-tags-after-< t
- "*Non-nil means immediately after < complete on end-tag names.
+ "Non-nil means immediately after < complete on end-tag names.
Complete on start-tag names regardless.")
(defvar rng-nxml-easy-menu
diff --git a/lisp/nxml/rng-parse.el b/lisp/nxml/rng-parse.el
index 68a3aff3a0f..fcdb52bbc44 100644
--- a/lisp/nxml/rng-parse.el
+++ b/lisp/nxml/rng-parse.el
@@ -1,6 +1,6 @@
;;; rng-parse.el --- parse an XML file and validate it against a schema
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-pttrn.el b/lisp/nxml/rng-pttrn.el
index a803369d3d2..653980d5acd 100644
--- a/lisp/nxml/rng-pttrn.el
+++ b/lisp/nxml/rng-pttrn.el
@@ -1,6 +1,6 @@
;;; rng-pttrn.el --- RELAX NG patterns
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index 2b367b20072..675be9c5ccf 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -1,6 +1,6 @@
;;; rng-uri.el --- URI parsing and manipulation
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML
diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el
index 3e23b67c998..0d50507478a 100644
--- a/lisp/nxml/rng-util.el
+++ b/lisp/nxml/rng-util.el
@@ -1,6 +1,6 @@
;;; rng-util.el --- utility functions for RELAX NG library
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el
index 1f69f5d7bf3..61b583b56c2 100644
--- a/lisp/nxml/rng-valid.el
+++ b/lisp/nxml/rng-valid.el
@@ -1,6 +1,6 @@
;;; rng-valid.el --- real-time validation of XML using RELAX NG
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, RelaxNG
@@ -475,7 +475,7 @@ The schema is set like `rng-auto-set-schema'."
(save-restriction
(widen)
(nxml-with-invisible-motion
- (condition-case-no-debug err
+ (condition-case-unless-debug err
(and (rng-validate-prepare)
(let ((rng-dt-namespace-context-getter '(nxml-ns-get-context)))
(nxml-with-unmodifying-text-property-changes
@@ -570,7 +570,7 @@ Return t if there is work to do, nil otherwise."
(rng-clear-cached-state remove-start (1- pos)))
;; sync up with cached validation state
(setq continue nil)
- ;; do this before settting rng-validate-up-to-date-end
+ ;; do this before setting rng-validate-up-to-date-end
;; in case we get a quit
(rng-mark-xmltok-errors)
(rng-mark-xmltok-dependent-regions)
diff --git a/lisp/nxml/rng-xsd.el b/lisp/nxml/rng-xsd.el
index b481039fdab..d84ea5e1a71 100644
--- a/lisp/nxml/rng-xsd.el
+++ b/lisp/nxml/rng-xsd.el
@@ -1,6 +1,6 @@
;;; rng-xsd.el --- W3C XML Schema datatypes library for RELAX NG
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index a9b24955fa7..e4f6f3ca511 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -1,6 +1,6 @@
;;; xmltok.el --- XML tokenization
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML
diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el
index 9701b8dc6e0..37ed58b2074 100644
--- a/lisp/nxml/xsd-regexp.el
+++ b/lisp/nxml/xsd-regexp.el
@@ -1,6 +1,6 @@
;;; xsd-regexp.el --- translate W3C XML Schema regexps to Emacs regexps
-;; Copyright (C) 2003, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, regexp
diff --git a/lisp/obsolete/abbrevlist.el b/lisp/obsolete/abbrevlist.el
index 55940dfc1ce..36856ea0d71 100644
--- a/lisp/obsolete/abbrevlist.el
+++ b/lisp/obsolete/abbrevlist.el
@@ -1,6 +1,6 @@
;;; abbrevlist.el --- list one abbrev table alphabetically ordered
-;; Copyright (C) 1986, 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1992, 2001-2012 Free Software Foundation, Inc.
;; Suggested by a previous version by Gildea.
;; Maintainer: FSF
diff --git a/lisp/emacs-lisp/assoc.el b/lisp/obsolete/assoc.el
index e650995d3fe..5d213d193b3 100644
--- a/lisp/emacs-lisp/assoc.el
+++ b/lisp/obsolete/assoc.el
@@ -1,9 +1,10 @@
-;;; assoc.el --- insert/delete functions on association lists
+;;; assoc.el --- insert/delete functions on association lists -*- lexical-binding: t -*-
-;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Barry A. Warsaw <bwarsaw@cen.com>
;; Keywords: extensions
+;; Obsolete-since: 24.3
;; This file is part of GNU Emacs.
@@ -36,7 +37,7 @@ the order of any other key-value pair. Side effect sets alist to new
sorted list."
(set alist-symbol
(sort (copy-alist (symbol-value alist-symbol))
- (function (lambda (a b) (equal (car a) key))))))
+ (lambda (a _b) (equal (car a) key)))))
(defun aelement (key value)
@@ -71,8 +72,8 @@ If VALUE is not supplied, or is nil, the key-value pair will not be
modified, but will be moved to the head of the alist. If the key-value
pair cannot be found in the alist, it will be inserted into the head
of the alist (with value nil if VALUE is nil or not supplied)."
- (lexical-let ((elem (aelement key value))
- alist)
+ (let ((elem (aelement key value))
+ alist)
(asort alist-symbol key)
(setq alist (symbol-value alist-symbol))
(cond ((null alist) (set alist-symbol elem))
@@ -86,7 +87,7 @@ of the alist (with value nil if VALUE is nil or not supplied)."
Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
is pair matching KEY. Returns the altered alist."
(asort alist-symbol key)
- (lexical-let ((alist (symbol-value alist-symbol)))
+ (let ((alist (symbol-value alist-symbol)))
(cond ((null alist) nil)
((anot-head-p alist key) alist)
(t (set alist-symbol (cdr alist))))))
@@ -101,6 +102,7 @@ returned.
If no key-value pair matching KEY could be found in ALIST, or ALIST is
nil then nil is returned. ALIST is not altered."
+ (defvar copy)
(let ((copy (copy-alist alist)))
(cond ((null alist) nil)
((progn (asort 'copy key)
@@ -123,10 +125,10 @@ KEYLIST and VALUELIST should have the same number of elements, but
this isn't enforced. If VALUELIST is smaller than KEYLIST, remaining
keys are associated with nil. If VALUELIST is larger than KEYLIST,
extra values are ignored. Returns the created alist."
- (lexical-let ((keycar (car keylist))
- (keycdr (cdr keylist))
- (valcar (car valuelist))
- (valcdr (cdr valuelist)))
+ (let ((keycar (car keylist))
+ (keycdr (cdr keylist))
+ (valcar (car valuelist))
+ (valcdr (cdr valuelist)))
(cond ((null keycdr)
(aput alist-symbol keycar valcar))
(t
diff --git a/lisp/obsolete/awk-mode.el b/lisp/obsolete/awk-mode.el
index 1a6d08c08ef..c931af9df5e 100644
--- a/lisp/obsolete/awk-mode.el
+++ b/lisp/obsolete/awk-mode.el
@@ -1,6 +1,6 @@
;;; awk-mode.el --- AWK code editing commands for Emacs
-;; Copyright (C) 1988, 1994, 1996, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 1996, 2000-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: unix, languages
diff --git a/lisp/play/bruce.el b/lisp/obsolete/bruce.el
index a41d5a3d3d1..bd7d9a6e6bf 100644
--- a/lisp/play/bruce.el
+++ b/lisp/obsolete/bruce.el
@@ -1,11 +1,12 @@
;;; bruce.el --- bruce phrase utility for overloading the Communications -*- no-byte-compile: t -*-
;;; Decency Act snoops, if any.
-;; Copyright (C) 1988, 1993, 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1993, 1997, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: games
;; Created: Jan 1997
+;; Obsolete-since: 24.3
;; This file is part of GNU Emacs.
diff --git a/lisp/obsolete/cl-compat.el b/lisp/obsolete/cl-compat.el
index 21bb46179c5..a086de90b47 100644
--- a/lisp/obsolete/cl-compat.el
+++ b/lisp/obsolete/cl-compat.el
@@ -1,6 +1,6 @@
;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility)
-;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 2.02
diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el
index 925361566fb..5cb9456df42 100644
--- a/lisp/obsolete/complete.el
+++ b/lisp/obsolete/complete.el
@@ -1,6 +1,6 @@
;;; complete.el --- partial completion mechanism plus other goodies
-;; Copyright (C) 1990-1993, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 1999-2012 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Keywords: abbrev convenience
diff --git a/lisp/emacs-lisp/cust-print.el b/lisp/obsolete/cust-print.el
index e7f9aae1c60..fc00975ba37 100644
--- a/lisp/emacs-lisp/cust-print.el
+++ b/lisp/obsolete/cust-print.el
@@ -1,10 +1,11 @@
;;; cust-print.el --- handles print-level and print-circle
-;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@holonexus.org>
;; Adapted-By: ESR
;; Keywords: extensions
+;; Obsolete-since: 24.3
;; LCD Archive Entry:
;; cust-print|Daniel LaLiberte|liberte@holonexus.org
diff --git a/lisp/obsolete/erc-hecomplete.el b/lisp/obsolete/erc-hecomplete.el
index 67f51d690b2..8e939169a60 100644
--- a/lisp/obsolete/erc-hecomplete.el
+++ b/lisp/obsolete/erc-hecomplete.el
@@ -1,6 +1,6 @@
;;; erc-hecomplete.el --- Provides Nick name completion for ERC
-;; Copyright (C) 2001-2002, 2004, 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2002, 2004, 2006-2012 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion
@@ -73,7 +73,7 @@ or you may use an arbitrary lisp expression."
:group 'erc-hecomplete)
(defcustom erc-nick-completion-ignore-case t
- "*Non-nil means don't consider case significant in nick completion.
+ "Non-nil means don't consider case significant in nick completion.
Case will be automatically corrected when non-nil.
For instance if you type \"dely TAB\" the word completes and changes to
\"delYsid\"."
@@ -92,7 +92,7 @@ typing \"f o TAB\" will directly give you foobar. Use this with
(erc-get-channel-nickname-list)))
(defcustom erc-nick-completion-postfix ": "
- "*When `erc-complete' is used in the first word after the prompt,
+ "When `erc-complete' is used in the first word after the prompt,
add this string when a unique expansion was found."
:group 'erc-hecomplete
:type 'string)
diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el
index c42c2309413..125a5dbf6e0 100644
--- a/lisp/obsolete/fast-lock.el
+++ b/lisp/obsolete/fast-lock.el
@@ -1,6 +1,6 @@
;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode
-;; Copyright (C) 1994-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Simon Marshall <simon@gnu.org>
;; Maintainer: FSF
@@ -247,7 +247,7 @@
;; User Variables:
(defcustom fast-lock-minimum-size 25600
- "*Minimum size of a buffer for cached fontification.
+ "Minimum size of a buffer for cached fontification.
Only buffers more than this can have associated Font Lock cache files saved.
If nil, means cache files are never created.
If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
@@ -271,7 +271,7 @@ for buffers in Rmail mode, and size is irrelevant otherwise."
(defcustom fast-lock-cache-directories '("~/.emacs-flc")
; - `internal', keep each file's Font Lock cache file in the same file.
; - `external', keep each file's Font Lock cache file in the same directory.
- "*Directories in which Font Lock cache files are saved and read.
+ "Directories in which Font Lock cache files are saved and read.
Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where
DIR is a directory name (relative or absolute) and REGEXP is a regexp.
@@ -297,7 +297,7 @@ to avoid the possibility of using the cache of another user."
(put 'fast-lock-cache-directories 'risky-local-variable t)
(defcustom fast-lock-save-events '(kill-buffer kill-emacs)
- "*Events under which caches will be saved.
+ "Events under which caches will be saved.
Valid events are `save-buffer', `kill-buffer' and `kill-emacs'.
If concurrent editing sessions use the same associated cache file for a file's
buffer, then you should add `save-buffer' to this list."
@@ -307,14 +307,14 @@ buffer, then you should add `save-buffer' to this list."
:group 'fast-lock)
(defcustom fast-lock-save-others t
- "*If non-nil, save Font Lock cache files irrespective of file owner.
+ "If non-nil, save Font Lock cache files irrespective of file owner.
If nil, means only buffer files known to be owned by you can have associated
Font Lock cache files saved. Ownership may be unknown for networked files."
:type 'boolean
:group 'fast-lock)
(defcustom fast-lock-verbose font-lock-verbose
- "*If non-nil, means show status messages for cache processing.
+ "If non-nil, means show status messages for cache processing.
If a number, only buffers greater than this size have processing messages."
:type '(choice (const :tag "never" nil)
(other :tag "always" t)
diff --git a/lisp/obsolete/iso-acc.el b/lisp/obsolete/iso-acc.el
index 347db281f1a..7e81c4bfb9d 100644
--- a/lisp/obsolete/iso-acc.el
+++ b/lisp/obsolete/iso-acc.el
@@ -1,6 +1,6 @@
;;; iso-acc.el --- minor mode providing electric accent keys
-;; Copyright (C) 1993-1994, 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Johan Vromans
;; Maintainer: FSF
@@ -73,7 +73,7 @@
:group 'i18n)
(defcustom iso-accents-insert-offset nonascii-insert-offset
- "*Offset added by ISO Accents mode to character codes 0200 and above."
+ "Offset added by ISO Accents mode to character codes 0200 and above."
:type 'integer
:group 'iso-acc)
@@ -262,7 +262,7 @@ Change it with the `iso-accents-customize' function.")
"Association list for ISO accent combinations, for the chosen language.")
(defcustom iso-accents-mode nil
- "*Non-nil enables ISO Accents mode.
+ "Non-nil enables ISO Accents mode.
Setting this variable makes it local to the current buffer.
See the function `iso-accents-mode'."
:type 'boolean
@@ -270,7 +270,7 @@ See the function `iso-accents-mode'."
(make-variable-buffer-local 'iso-accents-mode)
(defcustom iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/)
- "*List of accent keys that become prefixes in ISO Accents mode.
+ "List of accent keys that become prefixes in ISO Accents mode.
The default is (?' ?` ?^ ?\" ?~ ?/), which contains all the supported
accent keys. If you set this variable to a list in which some of those
characters are missing, the missing ones do not act as accents.
diff --git a/lisp/obsolete/iso-insert.el b/lisp/obsolete/iso-insert.el
index c223d096730..e2f53ea32af 100644
--- a/lisp/obsolete/iso-insert.el
+++ b/lisp/obsolete/iso-insert.el
@@ -1,6 +1,6 @@
;;; iso-insert.el --- insert functions for ISO 8859/1 -*- coding: iso-8859-1;-*-
-;; Copyright (C) 1987, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: FSF
diff --git a/lisp/obsolete/iso-swed.el b/lisp/obsolete/iso-swed.el
index 43686283e89..c57b006036f 100644
--- a/lisp/obsolete/iso-swed.el
+++ b/lisp/obsolete/iso-swed.el
@@ -1,6 +1,6 @@
;;; iso-swed.el --- set up char tables for ISO 8859/1 for Swedish/Finnish ttys
-;; Copyright (C) 1987, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 2001-2012 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: FSF
diff --git a/lisp/obsolete/keyswap.el b/lisp/obsolete/keyswap.el
index ec1263e5189..e1257f8f1aa 100644
--- a/lisp/obsolete/keyswap.el
+++ b/lisp/obsolete/keyswap.el
@@ -1,6 +1,6 @@
;;; keyswap.el --- swap BS and DEL keys -*- no-byte-compile: t -*-
-;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Keywords: terminals
diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el
index a04db4a0c72..7f055ec8c8f 100644
--- a/lisp/obsolete/lazy-lock.el
+++ b/lisp/obsolete/lazy-lock.el
@@ -1,6 +1,6 @@
;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode
-;; Copyright (C) 1994-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Simon Marshall <simon@gnu.org>
;; Maintainer: FSF
diff --git a/lisp/ledit.el b/lisp/obsolete/ledit.el
index 09fe5001161..df6cb7b9db6 100644
--- a/lisp/ledit.el
+++ b/lisp/obsolete/ledit.el
@@ -1,9 +1,10 @@
;;; ledit.el --- Emacs side of ledit interface
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: languages
+;; Obsolete-since: 24.3
;; This file is part of GNU Emacs.
@@ -22,7 +23,7 @@
;;; Commentary:
-;; This is a major mode for editing Liszt. See etc/LEDIT for details.
+;; This is a major mode for editing Liszt.
;;; Code:
diff --git a/lisp/obsolete/levents.el b/lisp/obsolete/levents.el
index 96183cadb9b..bd7272db460 100644
--- a/lisp/obsolete/levents.el
+++ b/lisp/obsolete/levents.el
@@ -1,6 +1,6 @@
;;; levents.el --- emulate the Lucid event data type and associated functions
-;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: emulations
diff --git a/lisp/obsolete/lmenu.el b/lisp/obsolete/lmenu.el
index 3c188be93e2..8ee8200f900 100644
--- a/lisp/obsolete/lmenu.el
+++ b/lisp/obsolete/lmenu.el
@@ -1,6 +1,6 @@
;;; lmenu.el --- emulate Lucid's menubar support
-;; Copyright (C) 1992-1994, 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1994, 1997, 2001-2012 Free Software Foundation, Inc.
;; Keywords: emulations obsolete
;; Obsolete-since: 23.3
diff --git a/lisp/obsolete/lucid.el b/lisp/obsolete/lucid.el
index d5ef629ffb4..c442ad31d1d 100644
--- a/lisp/obsolete/lucid.el
+++ b/lisp/obsolete/lucid.el
@@ -1,6 +1,6 @@
;;; lucid.el --- emulate some Lucid Emacs functions
-;; Copyright (C) 1993, 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: emulations
diff --git a/lisp/mail/mailpost.el b/lisp/obsolete/mailpost.el
index 7c4bea830d8..b6bf0d1e1b9 100644
--- a/lisp/mail/mailpost.el
+++ b/lisp/obsolete/mailpost.el
@@ -9,6 +9,7 @@
;; Maintainer: FSF
;; Created: 13 Jan 1986
;; Keywords: mail
+;; Obsolete-since: 24.3
;;; Commentary:
diff --git a/lisp/mouse-sel.el b/lisp/obsolete/mouse-sel.el
index 7f04cac96fe..8df4b3613ed 100644
--- a/lisp/mouse-sel.el
+++ b/lisp/obsolete/mouse-sel.el
@@ -1,9 +1,10 @@
;;; mouse-sel.el --- multi-click selection support
-;; Copyright (C) 1993-1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Mike Williams <mdub@bigfoot.com>
;; Keywords: mouse
+;; Obsolete-since: 24.3
;; This file is part of GNU Emacs.
@@ -262,6 +263,8 @@ kill ring; mouse-1 or mouse-3 kills it."
interprogram-paste-function
mouse-sel-original-interprogram-paste-function))))
+(make-obsolete 'mouse-sel-mode "use the normal mouse modes" "24.3")
+
;;=== Internal Variables/Constants ========================================
(defvar mouse-sel-primary-thing nil
diff --git a/lisp/obsolete/old-emacs-lock.el b/lisp/obsolete/old-emacs-lock.el
index b45003fcecc..9bb084d7db4 100644
--- a/lisp/obsolete/old-emacs-lock.el
+++ b/lisp/obsolete/old-emacs-lock.el
@@ -1,6 +1,6 @@
;;; emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked
-;; Copyright (C) 1994, 1997, 2001-2011 Free Software Foundation, Inc
+;; Copyright (C) 1994, 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Tom Wurgler <twurgler@goodyear.com>
;; Created: 12/8/94
diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el
index 0c0580b55dc..02c8115f23a 100644
--- a/lisp/obsolete/old-whitespace.el
+++ b/lisp/obsolete/old-whitespace.el
@@ -1,6 +1,6 @@
;;; whitespace.el --- warn about and clean bogus whitespaces in the file
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Rajesh Vaidheeswarran <rv@gnu.org>
;; Keywords: convenience
@@ -35,9 +35,9 @@
;; 4. Spaces followed by a TAB. (Almost always, we never want that).
;; 5. Spaces or TABS at the end of a line.
;;
-;; Whitespace errors are reported in a buffer, and on the modeline.
+;; Whitespace errors are reported in a buffer, and on the mode line.
;;
-;; Modeline will show a W:<x>!<y> to denote a particular type of whitespace,
+;; Mode line will show a W:<x>!<y> to denote a particular type of whitespace,
;; where `x' and `y' can be one (or more) of:
;;
;; e - End-of-Line whitespace.
@@ -46,7 +46,7 @@
;; s - Space followed by Tab.
;; t - Trailing whitespace.
;;
-;; If any of the whitespace checks is turned off, the modeline will display a
+;; If any of the whitespace checks is turned off, the mode line will display a
;; !<y>.
;;
;; (since (3) is the most controversial one, here is the rationale: Most
@@ -230,7 +230,7 @@ this variable."
:group 'whitespace)
(defcustom whitespace-silent nil
- "All whitespace errors will be shown only in the modeline when t.
+ "All whitespace errors will be shown only in the mode line when t.
Note that setting this may cause all whitespaces introduced in a file to go
unnoticed when the buffer is killed, unless the user visits the `*Whitespace
@@ -653,7 +653,7 @@ If highlighting is enabled, highlight these characters."
nil)))
(defun whitespace-update-modeline (&optional whitespace-err)
- "Update modeline with whitespace errors.
+ "Update mode line with whitespace errors.
Also with whitespaces whose testing has been turned off."
(if whitespace-display-in-modeline
(progn
diff --git a/lisp/obsolete/options.el b/lisp/obsolete/options.el
index 7c1c3552e2d..fef2943c873 100644
--- a/lisp/obsolete/options.el
+++ b/lisp/obsolete/options.el
@@ -1,6 +1,6 @@
;;; options.el --- edit Options command for Emacs
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Obsolete-since: 22.1
diff --git a/lisp/patcomp.el b/lisp/obsolete/patcomp.el
index c1965a763ca..9aacdd8f4c3 100644
--- a/lisp/patcomp.el
+++ b/lisp/obsolete/patcomp.el
@@ -2,6 +2,8 @@
;; This file is part of GNU Emacs.
+;; Obsolete-since: 24.3
+
;;; Commentary:
;;; Code:
diff --git a/lisp/obsolete/pc-mode.el b/lisp/obsolete/pc-mode.el
index 192392d3821..f66cc10380e 100644
--- a/lisp/obsolete/pc-mode.el
+++ b/lisp/obsolete/pc-mode.el
@@ -1,6 +1,6 @@
;;; pc-mode.el --- emulate certain key bindings used on PCs
-;; Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: emulations
diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el
index 9a5f9e9d9dc..676d7817f1b 100644
--- a/lisp/obsolete/pc-select.el
+++ b/lisp/obsolete/pc-select.el
@@ -2,7 +2,7 @@
;;; (or MAC GUI or MS-windoze (bah)) look-and-feel
;;; including key bindings.
-;; Copyright (C) 1995-1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Michael Staats <michael@thp.Uni-Duisburg.DE>
;; Keywords: convenience emulations
diff --git a/lisp/obsolete/pgg-def.el b/lisp/obsolete/pgg-def.el
index 39aef5fd278..ec208ea816d 100644
--- a/lisp/obsolete/pgg-def.el
+++ b/lisp/obsolete/pgg-def.el
@@ -1,6 +1,6 @@
;;; pgg-def.el --- functions/macros for defining PGG functions
-;; Copyright (C) 1999, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2002-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/11/02
diff --git a/lisp/obsolete/pgg-gpg.el b/lisp/obsolete/pgg-gpg.el
index 2eafc631e98..03de093f6b4 100644
--- a/lisp/obsolete/pgg-gpg.el
+++ b/lisp/obsolete/pgg-gpg.el
@@ -1,6 +1,6 @@
;;; pgg-gpg.el --- GnuPG support for PGG.
-;; Copyright (C) 1999-2000, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Symmetric encryption and gpg-agent support added by:
diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el
index 3d4539d9466..c7484ddd747 100644
--- a/lisp/obsolete/pgg-parse.el
+++ b/lisp/obsolete/pgg-parse.el
@@ -1,6 +1,6 @@
;;; pgg-parse.el --- OpenPGP packet parsing
-;; Copyright (C) 1999, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2002-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/10/28
@@ -53,7 +53,7 @@
(defcustom pgg-parse-symmetric-key-algorithm-alist
'((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128))
- "Alist of the assigned number to the simmetric key algorithm."
+ "Alist of the assigned number to the symmetric key algorithm."
:group 'pgg-parse
:type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
diff --git a/lisp/obsolete/pgg-pgp.el b/lisp/obsolete/pgg-pgp.el
index 7a9c70249a1..8e42779a27f 100644
--- a/lisp/obsolete/pgg-pgp.el
+++ b/lisp/obsolete/pgg-pgp.el
@@ -1,6 +1,6 @@
;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
-;; Copyright (C) 1999-2000, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/11/02
diff --git a/lisp/obsolete/pgg-pgp5.el b/lisp/obsolete/pgg-pgp5.el
index 796310bcfdc..c6c8cd174e9 100644
--- a/lisp/obsolete/pgg-pgp5.el
+++ b/lisp/obsolete/pgg-pgp5.el
@@ -1,6 +1,6 @@
;;; pgg-pgp5.el --- PGP 5.* support for PGG.
-;; Copyright (C) 1999-2000, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/11/02
diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el
index 876f3744bc2..996ba824f73 100644
--- a/lisp/obsolete/pgg.el
+++ b/lisp/obsolete/pgg.el
@@ -1,6 +1,6 @@
;;; pgg.el --- glue for the various PGP implementations.
-;; Copyright (C) 1999-2000, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2012 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Symmetric encryption added by: Sascha Wilde <wilde@sha-bang.de>
diff --git a/lisp/obsolete/resume.el b/lisp/obsolete/resume.el
index c9df1184d90..0d4c815722e 100644
--- a/lisp/obsolete/resume.el
+++ b/lisp/obsolete/resume.el
@@ -1,6 +1,6 @@
;;; resume.el --- process command line args from within a suspended Emacs job
-;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;; Author: Joe Wells <jbw@bucsf.bu.edu>
;; Adapted-By: ESR
@@ -47,7 +47,7 @@
;;; Code:
(defvar resume-emacs-args-file (expand-file-name "~/.emacs_args")
- "*This file is where arguments are placed for a suspended Emacs job.")
+ "This file is where arguments are placed for a suspended Emacs job.")
(defvar resume-emacs-args-buffer " *Command Line Args*"
"Buffer that is used by `resume-process-args'.")
diff --git a/lisp/obsolete/s-region.el b/lisp/obsolete/s-region.el
index 8fb6703aa25..1e09cbb4db6 100644
--- a/lisp/obsolete/s-region.el
+++ b/lisp/obsolete/s-region.el
@@ -1,6 +1,6 @@
;;; s-region.el --- set region using shift key
-;; Copyright (C) 1994-1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
;; Keywords: terminals
diff --git a/lisp/obsolete/scribe.el b/lisp/obsolete/scribe.el
index 1fbc9bc4158..7ff944c14df 100644
--- a/lisp/obsolete/scribe.el
+++ b/lisp/obsolete/scribe.el
@@ -1,6 +1,6 @@
;;; scribe.el --- scribe mode, and its idiosyncratic commands
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
;; Author: William Sommerfeld
;; (according to ack.texi)
@@ -45,17 +45,17 @@
"Abbrev table used while in scribe mode.")
(defcustom scribe-fancy-paragraphs nil
- "*Non-nil makes Scribe mode use a different style of paragraph separation."
+ "Non-nil makes Scribe mode use a different style of paragraph separation."
:type 'boolean
:group 'scribe)
(defcustom scribe-electric-quote nil
- "*Non-nil makes insert of double quote use `` or '' depending on context."
+ "Non-nil makes insert of double quote use `` or '' depending on context."
:type 'boolean
:group 'scribe)
(defcustom scribe-electric-parenthesis nil
- "*Non-nil makes parenthesis char ( (]}> ) automatically insert its close
+ "Non-nil makes parenthesis char ( (]}> ) automatically insert its close
if typed after an @Command form."
:type 'boolean
:group 'scribe)
diff --git a/lisp/obsolete/spell.el b/lisp/obsolete/spell.el
index ec7f912455b..2105fc1cb86 100644
--- a/lisp/obsolete/spell.el
+++ b/lisp/obsolete/spell.el
@@ -1,6 +1,6 @@
;;; spell.el --- spelling correction interface for Emacs
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: wp, unix
diff --git a/lisp/obsolete/sregex.el b/lisp/obsolete/sregex.el
index d1c80a65672..73caf50aae3 100644
--- a/lisp/obsolete/sregex.el
+++ b/lisp/obsolete/sregex.el
@@ -1,6 +1,6 @@
;;; sregex.el --- symbolic regular expressions
-;; Copyright (C) 1997-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Bob Glickstein <bobg+sregex@zanshin.com>
;; Maintainer: Bob Glickstein <bobg+sregex@zanshin.com>
diff --git a/lisp/obsolete/swedish.el b/lisp/obsolete/swedish.el
index c31af8697ef..96f9b6110bd 100644
--- a/lisp/obsolete/swedish.el
+++ b/lisp/obsolete/swedish.el
@@ -1,6 +1,6 @@
;;; swedish.el --- miscellaneous functions for dealing with Swedish
-;; Copyright (C) 1988, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2012 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: FSF
diff --git a/lisp/obsolete/sym-comp.el b/lisp/obsolete/sym-comp.el
index 7e9a460ea14..53fdd3a66e3 100644
--- a/lisp/obsolete/sym-comp.el
+++ b/lisp/obsolete/sym-comp.el
@@ -1,6 +1,6 @@
;;; sym-comp.el --- mode-dependent symbol completion
-;; Copyright (C) 2004, 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2008-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: extensions
diff --git a/lisp/obsolete/vc-mcvs.el b/lisp/obsolete/vc-mcvs.el
index 980cdbfd71b..78221945073 100644
--- a/lisp/obsolete/vc-mcvs.el
+++ b/lisp/obsolete/vc-mcvs.el
@@ -1,6 +1,6 @@
;;; vc-mcvs.el --- VC backend for the Meta-CVS version-control system
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: None
@@ -329,7 +329,7 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
(if vc-mcvs-use-edit
(vc-mcvs-command nil 0 file "edit")
(set-file-modes file (logior (file-modes file) 128))
- (if (equal file buffer-file-name) (toggle-read-only -1))))
+ (if (equal file buffer-file-name) (read-only-mode -1))))
;; Check out a particular revision (or recreate the file).
(vc-file-setprop file 'vc-working-revision nil)
(apply 'vc-mcvs-command nil 0 file
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog
index 6f835c7bfa4..9bf731fb6b2 100644
--- a/lisp/org/ChangeLog
+++ b/lisp/org/ChangeLog
@@ -1,3 +1,7435 @@
+2012-10-26 Achim Gratz <stromeko@stromeko.de>
+
+ * ob-ditaa.el: Needs to (require 'org-compat) for
+ org-find-library-dir.
+
+ * org.el: Remove utf-8 codepoints in docstrings, bytecode doesn't
+ work when loaded from compressed files.
+
+ * org-compat.el: Make sure that file-name-directory is getting a
+ stringp. This avoids a possible " (wrong-type-argument stringp
+ nil)" error when the library in question does not exist.
+
+ * org-odt.el: Replace arc-mode.el by arc-mode.
+
+ * org.el: Replace org-macs.el by org-macs.
+
+ * org-install.el: Provide an empty file that prints a warning
+ about an outdated configuration.
+
+2012-10-26 Bastien Guerry <bzg@gnu.org>
+
+ * org-latex.el (org-export-as-latex): Remove obsolete argument
+ `hidden'. Also fix the docstring: using 'string as the value
+ for `to-buffer' outputs a string with no LaTeX header.
+ (org-export-as-latex-batch)
+ (org-export-as-latex-to-buffer, org-export-region-as-latex)
+ (org-export-as-pdf): Don't use the obsoleted argument.
+
+ * ob-haskell.el (org-export-as-latex): Don't use the obsoleted
+ argument `hidden'.
+
+ * org.el (org-refile): Run within `with-demoted-errors' so
+ that a corrupted bookmark file does not stop the refile
+ process.
+
+ * org-capture.el (org-capture-bookmark-last-stored-position):
+ Ditto for the capture process.
+
+ * org-src.el (org-edit-src-exit): Fix bug when saving an empty
+ source buffer.
+
+ * org-lparse.el (org-lparse): Fix bug by returning the output
+ of `org-do-lparse'.
+
+ * org.el (org-refile-check-position): Throw an error when the
+ refile target is the current buffer and is not a file.
+ (org-agenda-file-to-front, org-remove-file): Throw an error
+ when the current buffer is not a file.
+ (org-check-agenda-file): Enhance the message.
+ (org-element-type): Autoload.
+ (org-element-context, org-element-paragraph-parser): Don't
+ declare as these two functions are not used in org.el.
+
+ * org-lparse.el (browse-url-file-url): Declare.
+
+ * org.el (org-refile-check-position): Fix typo in docstring.
+
+ * org-clock.el (org-clock-modeline-total): Make obsolete.
+ (org-clock-mode-line-total): Rename from
+ `org-clock-modeline-total'.
+ (org-clock-get-sum-start): Fix references to
+ `org-clock-modeline-total'.
+
+ * org-faces.el (org-agenda-filter-tags)
+ (org-agenda-filter-category, mode-line): Use the 'mode-line
+ face instead of the obsolete 'modeline.
+
+ * org-odt.el (org-odt-styles-dir): Try more directories.
+ Don't throw an error, just send a message.
+
+ * org-odt.el (org-odt-lib-dir, org-odt-data-dir)
+ (org-odt-schema-dir-list, org-odt-styles-dir-list): Delete.
+ (org-export-odt-schema-dir, org-odt-styles-dir): Infer the
+ correct directories without requiring other variables.
+
+ * org-fixup.el (org-make-org-version, org-make-autoloads):
+ Don't define `org-odt-data-dir' in org-version.el.
+
+ * org-loaddefs.el: New file.
+
+ * org.el ("org-loaddefs.el"): Don't throw an error if the file
+ cannot be fund.
+ (org-version): Use org-loaddefs.el instead of org-install.el.
+
+ * org.el: Don't dynamically autoload already autoloaded
+ functions.
+ (org-clock-update-time-maybe): Move to org-clock.el.
+
+ * org-exp.el (org-insert-export-options-template): Remove
+ autoload cookie.
+
+ * org-clock.el (org-resolve-clocks, org-clock-in)
+ (org-clock-out, org-clock-cancel, org-clock-goto)
+ (org-clock-sum, org-clock-display, org-clock-report)
+ (org-dblock-write:clocktable): Add autoload cookie.
+ (org-clock-update-time-maybe): Moved from org.el.
+
+ * org-beamer.el (org-beamer-sectioning, org-beamer-mode): Ditto.
+
+ * org-ascii.el (org-export-ascii-preprocess): Ditto.
+
+ * org-archive.el (org-archive-subtree)
+ (org-archive-to-archive-sibling, org-toggle-archive-tag): Add
+ autoload cookie.
+
+ * org-colview.el (org-columns, org-dblock-write:columnview)
+ (org-insert-columns-dblock, org-agenda-columns): Ditto.
+
+ * org-table.el (org-table-create-with-table.el)
+ (org-table-create-or-convert-from-region, org-table-create)
+ (org-table-convert-region, org-table-import)
+ (org-table-export, org-table-align)
+ (org-table-justify-field-maybe, org-table-next-field)
+ (org-table-previous-field, org-table-next-row)
+ (org-table-copy-down, org-table-field-info)
+ (org-table-current-dline, org-table-goto-column)
+ (org-table-insert-column, org-table-delete-column)
+ (org-table-move-column-right, org-table-move-column-left)
+ (org-table-move-column, org-table-move-row-down)
+ (org-table-move-row-up, org-table-move-row)
+ (org-table-insert-row, org-table-insert-hline)
+ (org-table-hline-and-move, org-table-kill-row)
+ (org-table-sort-lines, org-table-cut-region)
+ (org-table-copy-region, org-table-paste-rectangle)
+ (org-table-convert, org-table-wrap-region)
+ (org-table-edit-field, org-table-sum)
+ (org-table-get-stored-formulas)
+ (org-table-maybe-eval-formula)
+ (org-table-rotate-recalc-marks)
+ (org-table-maybe-recalculate-line, org-table-eval-formula)
+ (org-table-recalculate, org-table-iterate)
+ (org-table-edit-formulas)
+ (org-table-toggle-coordinate-overlays)
+ (org-table-toggle-formula-debugger, orgtbl-to-generic)
+ (orgtbl-to-tsv, orgtbl-to-csv, orgtbl-to-latex)
+ (orgtbl-to-html, orgtbl-to-texinfo, orgtbl-to-orgtbl): Ditto.
+
+ * org.el (turn-on-orgtbl): Moved here from org-table.el.
+ (org-clock-persistence-insinuate): Moved here from org-clock.el.
+ (org-update-all-dblocks, org-map-entries)
+ (org-require-autoloaded-modules, org-forward-element)
+ (org-backward-element, org-up-element)
+ (org-element-greater-elements, org-drag-element-backward)
+ (org-drag-element-forward, org-mark-element)
+ (org-narrow-to-element, org-transpose-element)
+ (org-unindent-buffer): Don't autoload.
+
+ * org-clock.el (org-clock-get-clocktable): Rename from
+ `org-get-clocktable'.
+ (org-clock-persistence-insinuate): Move to org.el.
+
+ * org-capture.el: Do no set `generated-autoload-file' locally.
+ Minor code clean up.
+
+ * org-agenda.el (org-agenda-list): Use
+ `org-clock-get-clocktable'. Do no set
+ `generated-autoload-file' locally.
+
+ * org-table.el (org-table-iterate-buffer-tables): Minor
+ reformatting.
+ (turn-on-orgtbl): Move to org.el.
+
+ * org-html.el (org-export-htmlize-generate-css): Don't autoload.
+
+ * org-timer.el (org-timer-pause-or-continue, org-timer-stop):
+ Ditto.
+
+ * ob-tangle.el (org-babel-tangle-lang-exts): Ditto.
+
+ * ob-lob.el (org-babel-lob-ingest): Ditto.
+
+ * org-id.el (org-id-copy)
+ (org-id-get-with-outline-path-completion)
+ (org-id-get-with-outline-drilling): Ditto.
+
+ * org-lparse.el (org-lparse-and-open, org-lparse-batch)
+ (org-lparse-to-buffer, org-replace-region-by)
+ (org-lparse-region): Ditto.
+
+ * org-mobile.el (org-mobile-create-sumo-agenda): Ditto.
+
+ * org.el (org-cycle): Fix misplaced autoload cookie.
+
+ * org-agenda.el (org-agenda-get-timestamps): Check if the item
+ is an habit when formatting it with `org-agenda-format-item'.
+ (org-agenda-get-blocks): Fix bug: don't assume the item is an
+ habit when formatting with `org-agenda-format-item'.
+
+ * org.el (org-calendar-agenda-action-key): Delete an option.
+ (org-mode-map): Delete its keybinding.
+ (org-agenda-action-marker, org-mark-entry-for-agenda-action):
+ Delete.
+
+ * org-agenda.el (org-agenda-diary-entry): Don't prevent from
+ being used outside of Org agendas, as it can be used in
+ calendar buffers too.
+
+2012-10-26 Caio Tiago Oliveira <asrail@gmail.com> (tiny change)
+
+ * ob-scala.el (org-babel-scala-wrapper-method): Use a Scala
+ block enclosing the submitted code.
+
+2012-10-26 Myles English <mylesenglish@gmail.com> (tiny change)
+
+ * org-clock.el (org-clock-in): Moved the call to
+ org-clock-in-prepare-hook until the task's properties
+ can be accessed.
+
+2012-10-26 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-auto-fill-function): Make sure `adaptive-fill-mode'
+ mode is nil when pre-computed `fill-prefix' is the empty string.
+ Otherwise filling functions from fill.el think it has to be computed
+ again and overwrite it.
+
+ * org.el: Make `org-closest-date' aware of hours repeaters.
+
+ * org.el (org-end-of-line): Do not call `end-of-visual-line' when
+ moving to the end of line. Also improve behaviour on elements that
+ can be hidden.
+
+ * org.el (org-sparse-tree): Allow to call `org-show-todo-tree'
+ with an argument.
+
+ * org-element.el (org-element--get-next-object-candidates): Fix
+ parsing of objects of the same type in a single paragraph.
+
+ * org-element.el (org-element-sub/superscript-successor): Fix
+ parsing of sub/superscript at beginning of item.
+ (org-element-latex-or-entity-successor): Fix parsing of latex
+ fragments at beginning of item.
+
+ * org-agenda.el (org-agenda-later): Fix function when span is
+ a number and an argument was provided. Also fix typo in docstring.
+
+ * org.el (org-read-date-analyze): Fix analyzing for dates like
+ "29.03 16:40".
+
+ * org-element.el (org-element-center-block-parser)
+ (org-element-drawer-parser, , org-element-footnote-definition-parser)
+ (org-element-inlinetask-parser, org-element-plain-list-parser)
+ (org-element-quote-block-parser, org-element-special-block-parser)
+ (org-element-babel-call-parser, org-element-clock-parser)
+ (org-element-comment-parser, org-element-comment-block-parser)
+ (org-element-example-block-parser, org-element-export-block-parser)
+ (org-element-fixed-width-parser, org-element-horizontal-rule-parser)
+ (org-element-keyword-parser, org-element-latex-environment-parser)
+ (org-element-paragraph-parser, org-element-planning-parser)
+ (org-element-property-drawer-parser, org-element-src-block-parser)
+ (org-element-table-parser)
+ (org-element-verse-block-parserorg-element-dynamic-block-parser):
+ Make sure element never ends at the end of a blank non-empty line.
+
+ * org-element.el (org-element-context)
+ (org-element--get-next-object-candidates): Fix `org-element-context'.
+ In particular, the restrictions for an object may be different from
+ those of its container (i.e. table rows and table cells).
+
+ * org-element.el (org-element-example-block-parser)
+ (org-element-src-block-parser): Store value of example-blocks and
+ src-blocks unescaped.
+ (org-element-example-block-interpreter)
+ (org-element-src-block-interpreter): Escape value again when storing
+ it.
+
+ * org-src.el (org-escape-code-in-string)
+ (org-unescape-code-in-string, org-escape-code-in-region)
+ (org-unescape-code-in-region): New functions.
+ (org-edit-src-code, org-edit-src-exit): Use new functions.
+
+ * org.el (org-strip-protective-commas): Removed function.
+
+ * org-exp.el (org-export-select-backend-specific-text): Use new
+ function.
+
+ * ob.el (org-babel-parse-src-block-match)
+ (org-babel-parse-inline-src-block-match, org-babel-insert-result):
+ Always escape produced blocks, independently on the language of the
+ block, if any. Use new functions.
+
+ * org-element.el (org-element-paragraph-parser): Fix regexp
+ starting a block.
+
+ * org-element.el (org-element-center-block-parser):
+ (org-element-drawer-parser, org-element-dynamic-block-parser)
+ (org-element-example-block-parser, org-element-export-block-parser)
+ (org-element-latex-environment-parser, org-element-paragraph-parser)
+ (org-element-property-drawer-parser, org-element-src-block-parser)
+ (org-element-verse-block-parser): Use stricter regexps for boundaries
+ of elements.
+
+2012-10-26 Toby S. Cubitt <tsc25@cantab.net>
+
+ * org-agenda.el (org-agenda-get-sexps): Reset `extra' to nil at
+ beginning of re-search-forward loop, otherwise next iteration picks up
+ `extra' value from previous entry.
+
+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).
+ * org-id.el (org-id-uuid):
+ Change (random t) to (random), now that the latter is more random.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don't use the abbreviation "win" to refer to Windows (Bug#10421).
+ * ob-lilypond.el (ly-w32-ly-path): Rename from ly-win32-ly-path.
+ (ly-w32-pdf-path): Rename from ly-win32-pdf-path.
+ (ly-w32-midi-path): Rename from ly-win32-midi-path.
+ (ly-determine-ly-path, ly-determine-pdf-path, ly-determine-midi-path):
+ Check for "windows-nt", not "win32", in system-type.
+
+2012-06-02 Chong Yidong <cyd@gnu.org>
+
+ * 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".
+
+2012-05-27 Mark Shoulson <mark@kli.org> (tiny change)
+
+ * org.el (org-fontify-entities): Fix bug: The entities \sup[123] and
+ \there4 were not "prettified" when org-pretty-entities was enabled.
+
+2012-05-27 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-font-lock-add-priority-faces):
+ Restrict priorities fontification to headlines and inlinetasks.
+
+2012-05-27 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-init-outfile)
+ (org-odt-write-manifest-file):
+ Disable `nxml-auto-insert-xml-declaration-flag'.
+
+ * org-lparse.el (org-do-lparse): Don't trigger auto-mode processing.
+
+2012-05-27 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-scan-tags): Fix bug when building the scanner regexp.
+
+2012-05-27 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-capitalize-examplize-region-markers):
+ Controls the capitalization of begin and end example blocks.
+ (org-babel-examplize-region):
+ Optionally capitalize example block delimiters.
+
+ * ob-plantuml.el (org-babel-execute:plantuml):
+ Add a :java header argument to plantuml.
+
+ * org-exp-blocks.el (org-export-blocks-preprocess):
+ Even when the body of a block is not indented the boundary markers
+ should be indented to their original positions so things like list
+ indentation still work.
+
+ * ob.el (org-babel-parse-src-block-match):
+ Save match data during indentation check.
+
+2012-05-27 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-scan-tags): Correctly match TODO keywords.
+
+2012-05-27 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-list.el (org-list-struct): Fix white spaces.
+ (org-list-swap-items, org-list-send-item): Fix visibility preservation.
+
+ * org-list.el (org-list-swap-items, org-list-send-item):
+ Preserve visibility when moving items.
+
+2012-05-27 Mark E. Shoulson <mark@kli.org> (tiny change)
+
+ * org.el (org-fontify-entities): Hide {} when prettifying entities.
+
+2012-05-27 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-cycle-internal-global): Prevent the display of
+ messages when cycling from with a Gnus article buffer.
+
+ * org-table.el (org-table-time-seconds-to-string):
+ Fix bug about handling a negative duration value.
+
+2012-05-27 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-link-expand-abbrev): Fix docstring.
+
+ * org.el (org-translate-link): Fix bug.
+
+2012-05-27 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-bulk-mark-regexp):
+ Fix bug when setting the number of marked entries.
+
+ * org-table.el (org-tbl-calc-modes): Rename from `org-table-modes'.
+ (org-set-calc-mode, org-table-eval-formula): Use it.
+
+2012-05-27 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-find-named-result):
+ Fix bug finding empty named results.
+
+2012-05-27 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-set-regexps-and-options):
+ Fix `org-planning-or-clock-line-re' regexp. Indeed "\\>" will never
+ match since time keywords must end with colons, which are not word
+ constituents.
+
+2012-05-27 Bastien Guerry <bzg@gnu.org>
+
+ * org-ctags.el (org-ctags-new-topic-template):
+ Fix the option default value back again.
+
+2012-05-27 Eric Schulte <eric.schulte@gmx.com>
+
+ * org-bibtex.el (org-bibtex-export-to-kill-ring):
+ Don't rely on kill-new to return a string.
+
+ * org-bibtex.el (org-bibtex-headline):
+ Remove call to bibtex-reformat which often hangs.
+
+2012-04-27 Glenn Morris <rgm@gnu.org>
+
+ * org-ctags.el (org-ctags-new-topic-template):
+ Revert 2012-04-09 removal of * from defcustom value, not doc.
+
+2012-04-27 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-table.el (org-table-number-fraction): Fix typo.
+
+2012-04-27 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-python.el (org-babel-execute:python): Ensure newline precedes
+ automatically-added returns.
+
+2012-04-27 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-mouse.el (org-mode-hook): Do not move point when clicking on
+ a footnote reference.
+
+2012-04-27 Bastien Guerry <bzg@gnu.org>
+
+ * org-faces.el (org-date-selected): Fix docstring.
+
+2012-04-27 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * 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.
+
+2012-04-27 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-normalize): Fix positioning in
+ HTML export without a footnote section.
+
+2012-04-27 Madan Ramakrishnan <madanr79@gmail.com> (tiny change)
+
+ * org-agenda.el (org-agenda-bulk-mark): Truly make arg optional as
+ advertised by the function.
+
+2012-04-27 Zachary Kanfer <zkanfer@gmail.com> (tiny change)
+
+ * org.el (org-read-date-display): Fix bug when displaying the
+ overlay.
+
+2012-04-27 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-mode): Don't use `buffer-face-mode' by default.
+
+2012-04-27 Bastien Guerry <bzg@gnu.org>
+
+ * org-faces.el (org-date-selected): New face.
+
+2012-04-27 Jambunathan K <kjambunathan@gmail.com>
+
+ * 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.
+
+2012-04-27 Bastien Guerry <bzg@gnu.org>
+
+ * org-clock.el (org-program-exists): Fix docstring.
+
+2012-04-14 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-point-at-end-of-empty-headline): Only try to match
+ `org-todo-line-regexp' when the value is non-nil, e.g. in non-org
+ modes.
+ (org-fontify-meta-lines-and-blocks-1): Prevent errors when trying
+ to fontify beyond (point-max).
+
+ * org-clock.el (org-clock-task-overrun-text)
+ (org-task-overrun, org-clock-get-clock-string)
+ (org-clock-update-mode-line)
+ (org-clock-notify-once-if-expired): Rename `org-task-overrun'
+ and `org-task-overrun-text' to `org-clock-task-overrun' and
+ `org-clock-task-overrun-text' respectively.
+ (org-task-overrun-text): New alias.
+
+ * org-table.el (org-table-eval-formula): Fix bug about handling
+ remote references as durations.
+ (org-table-get-range): Fix bug: make sure references to $0 are
+ correctly handled.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option):
+ Fix bug in `pcomplete/org-mode/file-option'.
+ (org-thing-at-point): Also match line options like LATEX_CLASS
+ when pcompleting from LATEX_.
+
+ * org-agenda.el (org-agenda-filter-make-matcher)
+ (org-agenda-filter-apply): Allow filtering entries out by
+ category. Using `C-u <' from the agenda view will redisplay
+ the agenda without entries from categories of the current line.
+
+2012-04-14 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-C.el (org-babel-C-ensure-main-wrap):
+ Add an explicit return to automatically generated main methods.
+
+2012-04-14 Matt Lundin <mdl@imapmail.org>
+
+ * org.el (org-after-todo-state-change-hook):
+ Fix docstring to reflect name change of state to `org-state'.
+
+2012-04-14 Mike Sperber <sperber@deinprogramm.de> (tiny change)
+
+ * org-footnote.el (org-footnote-normalize):
+ Correctly pass keyword arguments to `org-export-preprocess-string'.
+
+2012-04-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-todo): Fix regression: rename `state' to
+ `org-state'.
+ (org-use-effective-time): Fix group and type.
+
+2012-04-02 Bastien Guerry <bzg@gnu.org>
+
+ * org-clock.el (org-clock-out-if-current): Fix regression: rename
+ `org-clock-state' to `org-state' to match the name of the
+ dynamically-scoped variable in `org-todo'.
+
+ * org-agenda.el (entry, org-diary, org-class): Fix regression:
+ rename `org-entry' to `entry'.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-todo): Fix regression in `org-todo'.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-C.el (org-babel-C-execute): Add .exe to the end of compiled
+ C files on windows.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * 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-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-fast-tag-selection): Fix an bug when listing tags
+ for completion.
+
+2012-04-01 Ilya Shlyakhter <ilya_shl@alum.mit.edu> (tiny change)
+
+ * org.el (org-delete-property-globally): Fixed a bug that left
+ blank line in place of the property, instead of removing the line.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * ob-maxima.el (org-babel-maxima-command): Add group information
+ to the defcustom.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-mode): Use `buffer-face-mode' to remap the 'default
+ face to 'org-default.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-ascii.el (org-export-as-ascii): Fix escaping of underscores
+ in links.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el: Prevent a bug while defining the menu by requiring
+ `org-beamer' when necessary.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-table.el (orgtbl-self-insert-command): Use
+ `backward-delete-char' instead of `delete-backward-char' as this
+ last command gets caught by the compiler which says to not use it
+ in programs. `backward-delete-char' is just an alias for
+ `delete-backward-char' which is internally remapped to
+ `org-delete-backward-char' for optimization purpose.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-latex.el (org-export-latex-subcontent): Bugfix: when
+ `org-export-latex-low-levels' is nil, do not export low levels.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-insert-result): Fix bug in indented wrapped
+ results insertion.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-set-tags): Include `org-tag-alist' in the list of
+ possible completions, even when there are tags defined in the
+ buffer.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-mime.el (org-mime-htmlize): Set
+ `org-export-with-LaTeX-fragments' correctly.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-set-tags): Don't add a column when there is only one
+ tag offered for completion.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-fast-tag-selection): Include tags from
+ `org-tag-alist' when completing with the TAB key.
+
+2012-04-01 Shoji Nishimura <nishimura.shoji@gmail.com> (tiny change)
+
+ * org.el (org-display-inline-images): Honor the ̀beg' parameter.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-latex.el (org-export-latex-subcontent): Don't insert a
+ linebreak when itemizing a subtree that is just a headline.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-lob.el (org-babel-lob-get-info): Removed extra []s when
+ parsing inline call_foo lines.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-maxima.el (org-babel-maxima-command): The maxima command used
+ should be configurable (defaults to maxima-command if defined).
+ (org-babel-execute:maxima): The maxima command used should be
+ configurable (defaults to maxima-command if defined).
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-C.el (org-babel-C-execute): Add the local directory to the
+ library search path for C/C++ block compilation.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-where-is-src-block-result): Don't truncate
+ results name on call line execution.
+
+2012-04-01 Ilya Shlyakhter <ilya_shl@alum.mit.edu> (tiny change)
+
+ * org-colview.el (org-columns-cleanup-item): Handle case of empty
+ headline.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-delete-definitions): Fix LaTeX
+ export error when a src block produces fake footnotes.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-read-date): Don't mention `parse-time-weekdays' and
+ `parse-time-months' in the docstring.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-filter-apply): Bugfix: Add let
+ binding.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org> (tiny change)
+
+ * org-colview.el (org-columns-compute): Also consider inline tasks
+ when computing the sum.
+
+2012-04-01 Thomas Morgan <tlm@ziiuu.com> (tiny change)
+
+ * org-habit.el (org-habit-insert-consistency-graphs): Fix
+ alignment of consistency graph in filtered agenda view.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-latex.el (org-export-as-latex): Fix bug in setting the
+ export directory according to the LaTeX options.
+
+2012-04-01 K.Nagashima <uni.naga@gmail.com> (tiny change)
+
+ * org.el (org-show-subtree): Make interactive.
+
+2012-04-01 Ilya Shlyakhter <ilya_shl@alum.mit.edu>
+
+ * org-clock.el (org-clock-get-table-data): Make sure todo-only
+ does not leak when it is set by make-org-tags-macher.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-cycle-internal-local): Don't try to hide drawers
+ within subtrees in this function, it slows cycling down.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-custom-commands-local-options): Fix
+ incorrect custom option definition.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-colview.el (org-columns-display-here): Bugfix: use the date
+ as the value for the ITEM column when displaying a summary.
+
+2012-04-01 Martyn Jago <martyn.jago@btinternet.com>
+
+ * ob-lilypond.el: Re-direct homepage to Worg.
+
+2012-04-01 Martyn Jago <martyn.jago@btinternet.com>
+
+ * ob-lilypond.el: Leave versioning to Org.
+
+2012-04-01 Martyn Jago <martyn.jago@btinternet.com>
+
+ * ob-lilypond.el: Fix compiler warning.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-format-entity-caption): Enumerate entities
+ that have either a caption or a label.
+ (org-odt-label-styles, org-odt-category-map-alist): Add a
+ separator between sequence number and caption. Introduced two
+ new label styles for handling of math formula and math label.
+ (org-odt-format-label-definition)
+ (org-export-odt-format-formula): Propagate above changes.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-enforce-todo-dependencies): Fix docstring.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-export-odt-category-strings): New custom
+ variable.
+ (org-odt-category-map-alist): Modify interpretation. Don't
+ use the same field to double up as both a OpenDocument
+ variable and a category string. Entries in this list now
+ specify only the OpenDocument variable. Category strings are
+ obtained through an indirect lookup of
+ `org-export-odt-category-strings'. Use same OpenDocument
+ variables as what LibreOffice uses for various entities. Fix
+ docstring.
+ (org-odt-add-label-definition)
+ (org-odt-format-label-definition)
+ (org-odt-format-label-reference): Propagate above changes.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org> (tiny change)
+
+ * org-latex.el (org-export-as-latex): Check TeX-master correctly.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-category-map-alist): Update docstring.
+ (org-export-odt-user-categories)
+ (org-export-odt-get-category-from-label)
+ (org-odt-get-label-category-and-style): Remove.
+ (org-odt-add-label-definition): Propagate above changes.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org> (tiny change)
+
+ * org.el (org-refile): Don't allow creation of parents when using
+ the refile command to go to a headline.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-format-org-link): Resolve links to headlines
+ as section numbers only if section numbering is on.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (format-spec): Require 'format-spec.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org> (tiny change)
+
+ * org-latex.el (org-export-as-latex): Fix TeX-master declaration.
+
+2012-04-01 Ilya Shlyakhter <ilya_shl@alum.mit.edu> (tiny change)
+
+ * org.el (org-imenu-get-tree): Check that looking-at succeeds
+ before using match results.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-exp-blocks.el (org-ditaa-jar-path): Make a defcustom.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-lparse.el (org-do-lparse): Make effective setting of
+ `org-export-headline-levels' available to the ODT exporter. Also
+ remove some stale comments.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-begin-toc): Handle named HTML entities in
+ per-language string for "Table Of Contents".
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-exp-blocks.el (org-ditaa-jar-path): Fix merge conflict.
+
+2012-04-01 Shaun Johnson <shaun@slugfest.demon.co.uk> (tiny change)
+
+ * org-exp-blocks.el (org-ditaa-jar-path): Better heuristic to find
+ the libary name.
+
+2012-04-01 Suvayu Ali <fatkasuvayu+linux@gmail.com>
+
+ * org-src.el (org-edit-src-code): Change let bind to let*, e.g. if
+ case-fold-search is bound to nil globally, the
+ (case-fold-search t) doesn't work until we get to the body.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org> (tiny change)
+
+ * org-latex.el (org-export-latex-tables): Allow to use
+ sidewaystable.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-expand-noweb-references): Fix bug in src name
+ regexp when using *org-babel-use-quick-and-dirty-noweb-expansion*.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-scan-tags): Require one or more spaces (+) between
+ keyword and headline.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-agenda.el (org-prepare-agenda): Don't reset
+ `org-done-keywords-for-agenda' when `org-agenda-multi'.
+
+2012-04-01 Thomas Morgan <tlm@ziiuu.com> (tiny change)
+
+ * org-habit.el (org-habit-insert-consistency-graphs): Fix bug
+ while inserting habit graph in the agenda buffer.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org> (tiny change)
+
+ * org-src.el (org-src-edit-buffer-p): New function.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org> (tiny change)
+
+ * org-agenda.el (org-agenda-skip-if): Fix the order conditions are
+ being checked. Also enhance the docstring a bit.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org> (tiny change)
+
+ * org-agenda.el (org-agenda-tree-to-indirect-buffer): Fix the
+ display of indirect agenda window.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org> (tiny change)
+
+ * org.el (org-create-formula-image, org-dvipng-color): Fix XEmacs
+ compatibility bug.
+
+2012-04-01 Carsten Dominik <carsten.dominik@gmail.com> (tiny change)
+
+ * org-clock.el (org-clock-get-table-data): Bind org-scanner-tags
+ to tags-list and org-trust-scanner-tags to t while evaluating the
+ matcher, since the matcher is always evaluated at the current
+ entry.
+
+2012-04-01 Ilya Shlyakhter <ilya_shl@alum.mit.edu> (tiny change)
+
+ * org.el (org-scan-tags): Bind org-trust-scanner-tags to t while
+ evaluating the matcher, since the matcher is always evaluated at
+ the current entry.
+
+2012-04-01 Ilya Shlyakhter <ilya_shl@alum.mit.edu> (tiny change)
+
+ * ob-lilypond.el (ly-compile-lilyfile): Fixed misplaced comma in a
+ quoting expression.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-merge-params): Add "eval" as acceptable noweb
+ argument.
+ (org-babel-noweb-p): The "eval" argument only expands during
+ evaluation.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-strip-protective-commas): Declared.
+
+ * org-agenda.el (org-agenda-filtered-by-category): Declared.
+ (org-agenda-filter-apply): Capture free variable.
+
+ * org-footnote.el (org-skip-whitespace): Declared.
+
+ * org-mobile.el (org-agenda-filter): Declared.
+
+ * org-src.el (org-strip-protective-commas): Declared.
+
+2012-04-01 Sebastien Vauban <sva@mygooglest.com> (tiny change)
+
+ * org.el (org-version): Add autoload cookie.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-attach.el (org-attach-store-link-p): Remove spurious quote
+ in customization form choice.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-sh.el (org-babel-execute:sh): Pass all params to subroutine.
+ (org-babel-sh-evaluate): Apply :shebang and :padline to shell script
+ execution.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-insert-result): Ensure correct order for empty
+ result wrapping blocks.
+
+2012-04-01 Martyn Jago <martyn.jago@btinternet.com>
+
+ * ob-lilypond.el: Make auditioning of midi and pdf asynchronous,
+ and add easy pdf generation in the form of `ly-gen-pdf' variable.
+
+2012-04-01 Deech <deech@deech-ThinkPad-X200.none> (tiny change)
+
+ * ob-tangle.el (org-babel-spec-to-string): The link generated by
+ org-store-link is escaped twice when tangling with ":comments yes"
+ flag.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-html.el (org-export-as-html): Remove another useless space
+ before tag.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-html.el (org-export-as-html): Remove another useless space
+ before tag.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-html.el (org-export-as-html): Remove useless space before
+ tag.
+
+2012-04-01 Sebastien Vauban <sva@mygooglest.com> (tiny change)
+
+ * org.el (org-version): Add autoload cookie.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-get-category): Save match data.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-tangle.el (org-babel-tangle): Don't prompt for a file name if
+ :tangle is specified.
+
+ * ob.el (org-babel-expand-noweb-references): Widen buffer when
+ expanding noweb references.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-table.el (sbe): Don't accidentally leave a `t' value when
+ variables are force interpreted as strings.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-bbdb.el (org-bbdb-open, org-bbdb-open-old)
+ (org-bbdb-open-new): Pass record name to avoid dynamic scoping.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-bbdb.el (bbdb-record-get-field, bbdb-search-name)
+ (bbdb-search-organization): Declare functions to silence byte
+ compiler.
+
+2012-04-01 Bernt Hansen <bernt@norang.ca>
+
+ * org.el (org-clone-subtree-with-time-shift): Fix task cloning for
+ repeating tasks using .+n and ++n syntax.
+
+2012-04-01 Karl Fogel <kfogel@red-bean.com> (tiny change)
+
+ * org-agenda.el (org-agenda-highlight-todo): Handle the case of a
+ heading that has a date but no todo keyword.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-find-named-result): Fix code block replacement
+ with results.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-normalize): Do not normalize
+ labels when sort-only is non-nil.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-normalize): Remove an useless part
+ of the function.
+ (org-insert-footnote-reference-near-definition): Remove function.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-normalize): Fix normalization of
+ inline footnotes with no footnote section.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-bbdb.el (org-bbdb-old): Replace `defvar' after loading 'bbdb
+ to check for old or new version by a check for the required
+ function in `org-bbdb-open' and `org-bbdb-store-link'.
+ (org-bbdb-store-link, org-bbdb-open): Check which version of bbdb is
+ to be used.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-find-named-result): Don't miss a code block
+ when there are confounding spaces after the result name.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-lob.el (org-babel-block-lob-one-liner-regexp): Less greedy
+ regular expressions.
+ (org-babel-inline-lob-one-liner-regexp): Less greedy regular
+ expressions.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-examplize-region): Fixed bug in examplization.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-link-search): Search for #+name affiliated keywords
+ and invisible targets.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-lparse.el (org-lparse-end-footnote-definition): Cleanup
+ newlines in a transcoded footnote definition. This ensures that
+ the line that is currently being processed by `org-do-lparse' loop
+ doesn't get broken up into multiple lines. Fix for the following
+ bug -
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-footnote.el (org-footnote-normalize): Force a paragraph
+ break after the last footnote definition. This is an an implicit
+ assumption made by the org-lparse.el library. With this change,
+ footnote definitions can reliably be exported with ODT backend.
+ See http://lists.gnu.org/archive/html/emacs-orgmode/2012-02/msg01013.html.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-ditaa.el (org-ditaa-jar-path): Fix a recursive load error.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-list.el (org-list-struct): Fix small bug introduced by
+ commit 8b7a3f249803aba612f9ad3ae50c2fc986247da4 in Org's git repo.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-ditaa.el (org-ditaa-jar-path): Already defined in
+ org-exp-blocks.el.
+
+ * org-exp-blocks.el (org-ditaa-jar-path): Declare appropriately
+ for the fact that this is really now a Babel thing -- even if it
+ is used here and the definition should remain here for reasons of
+ load dependencies.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-bbdb.el (org-bbdb-old): Wrap `defvar' so the variable gets
+ defined after bbdb was loaded.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org-latex.el (org-export-latex-tables): Don't add spurious
+ preceding newline if caption is not above a longtable.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-insert-toc): Remove this stray,
+ dysfunctional routine. This possibly has crept in because of the
+ broken merges between "maint" and "origin" branches.
+ (org-odt-begin-table): Don't emit an empty paragraph when a table is
+ neither labeled nor captioned.
+ (org-odt-init-outfile): Remove reference to an unused variable.
+
+2012-04-01 Viktor Rosenfeld <listuser36@googlemail.com>
+
+ * ob-sql.el (org-babel-execute:sql): Add support for MonetDB to
+ SQL code blocks.
+
+2012-04-01 Andreas Leha <andreas.leha@med.uni-goettingen.de>
+
+ * ob.el (org-babel-goto-named-src-block): Pushing the point to the
+ org-mark-ring and guessing at the code block name to jump to.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-agenda.el (org-agenda-tree-to-indirect-buffer): Fix handling
+ of indirect buffer and window.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-forbidden-blocks): Allow footnotes
+ in verse blocks.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-forbidden-blocks): Allow footnotes
+ in verse blocks.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-exp.el (org-table-clean-before-export): Ignore table rows
+ defining parameters for formulas during export.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-list.el (org-list-get-item-number): New function.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-list.el (org-list-ending-method, org-list-end-regexp):
+ Removed variables.
+ (org-in-item-p, org-list-separating-blank-lines-number)
+ (org-list-parse-list, org-list-struct): Apply changes.
+
+ * org-exp.el (org-export-mark-list-end)
+ (org-export-mark-list-properties): Apply changes.
+
+ * org-latex.el (org-export-latex-lists): Apply changes.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-cycle-internal-local): Correctly unfold headlines
+ containing an inlinetask.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-structure-template-alist): Fix missing angle
+ brackets for muse export style.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-recenter-calendar): Use `with-selected-window' to
+ select calendar window and save currently selected window and
+ current buffer.
+
+2012-04-01 Toby S. Cubitt <tsc25@cantab.net> (tiny change)
+
+ * org.el (org-goto): Call org-refile-get-location with NO-EXCLUDE
+ argument set, otherwise not only are headlines in the current
+ subtree excluded, but it throws an error if point happens not to
+ be within a subtree (e.g. at start of buffer).
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-scan-tags): Fix highlighting in sparse-tree.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-clock.el (org-in-clocktable-p): Moved to org.el.
+
+ * org.el (org-in-clocktable-p): New function. Moved from
+ org-clock.el.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-exp.el (org-export-get-title-from-subtree): Don't format
+ tags in title if title headline does not have tags.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-cycle-internal-local): Fix bug: hide drawers in
+ inline tasks too.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-format-preamble): Don't insert TOC here.
+ Delay it till the end of export.
+ (org-odt-begin-document-body): Make a note of the default
+ position of TOC in `org-lparse-dyn-first-heading-pos'.
+ (org-odt-insert-toc): Insert TOC as directed by
+ [TABLE-OF-CONTENTS] line or at the default position.
+ (org-odt-end-export): Call `org-odt-insert-toc'.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-preview-latex-fragment): Throw an error when called
+ from a non-file buffer.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-capture.el (org-capture-place-item): Don't search for
+ position in existing list if :exact-position was supplied.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-set-font-lock-defaults): Fix bug in done headline
+ fontification.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-format-textbox): Honor user-specified width
+ in captioned images.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.el (org-update-property-plist): Fix bug in property list
+ updates.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-balanced-split): Explicit checking if list
+ before calling member.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-sqlite.el (org-babel-execute:sqlite): Specify the use of ","
+ as the separator to `org-table-convert-region'. Fixes errors when
+ only one result per line of output.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-strip-protective-commas): Use
+ `org-strip-protective-commas'.
+
+ * org-exp.el (org-export-select-backend-specific-text): Use
+ `org-strip-protective-commas'.
+
+ * org-src.el (org-edit-src-code): Use
+ `org-strip-protective-commas'.
+
+ * org.el (org-strip-protective-commas): Single definition for this
+ functionality.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-sql.el: Mention ob-sqlite in the comments of ob-sql.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-capture.el (org-capture-prepare-finalize-hook): New hook.
+ Run before the finalization process starts.
+ (org-capture-finalize): Run new hook.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.el (org-entry-get): Generalize to multiple "prop+"
+ properties.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org-src.el (org-src-mode-map): Rebinding `org-edit-src-save' in
+ the `org-src-mode-map'.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-recenter-calendar): Use `with-selected-window' to
+ select calendar window and save currently selected window and
+ current buffer.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-list.el (org-list-ending-method, org-list-end-regexp):
+ Removed variables.
+ (org-in-item-p, org-list-separating-blank-lines-number)
+ (org-list-parse-list, org-list-struct): Apply changes.
+
+ * org-exp.el (org-export-mark-list-end)
+ (org-export-mark-list-properties): Apply changes.
+
+ * org-latex.el (org-export-latex-lists): Apply changes.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.el (org-entry-get): Accumulate properties from subtree
+ property drawers.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.el (org-entry-get): Accumulate properties from subtree
+ property drawers.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-export-odt-image-size-probe-method)
+ (org-odt-do-image-size): Use imagemagick preferentially to
+ determine image sizes.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-export-as-odt-to-buffer)
+ (org-replace-region-by-odt, org-export-region-as-odt): Remove
+ these interactive functions. They are of questionable value.
+
+2012-04-01 Toby S. Cubitt <tsc25@cantab.net> (tiny change)
+
+ * org.el (org-goto): Call org-refile-get-location with NO-EXCLUDE
+ argument set, otherwise not only are headlines in the current
+ subtree excluded, but it throws an error if point happens not to
+ be within a subtree (e.g. at start of buffer).
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-exp.el (org-export-kill-product-buffer-when-displayed)
+ (org-export-initial-scope, org-export-date-timestamp-format)
+ (org-export-with-tasks, org-export-email-info)
+ (org-export-table-remove-empty-lines): Add version tag.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-cycle-internal-local): Correctly unfold headlines
+ containing an inlinetask.
+
+2012-04-01 Bernt Hansen <bernt@norang.ca>
+
+ * org-clock.el (org-clock-out): Do not delete the current clocking
+ task when org-clock-out-hook clocks in another task.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-scan-tags): Fix highlighting in sparse-tree.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-export-odt-convert-processes): Re-define
+ (org-export-odt-convert-capabilities): Fix an accidental
+ regression.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-export-odt-convert-capabilities): Change the
+ default value.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-clock.el (org-in-clocktable-p): Moved to org.el.
+
+ * org.el (org-in-clocktable-p): New function. Moved from org-clock.el.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-exp.el (org-export-get-title-from-subtree): Don't format
+ tags in title if title headline does not have tags.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-blank-before-new-entry)
+ (org-export-footnotes-seen, org-export-footnotes-data): Fix bogus
+ declarations.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-beginning-of-line, org-end-of-line): Fix special C-a
+ and C-e behaviour with visual lines.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org-exp-blocks.el (org-export-blocks): Changed the name of
+ exporting comment blocks given that it seems regular comment
+ blocks no longer export.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-exp.el (org-babel-exp-get-export-buffer): Access current
+ export buffer.
+ (org-babel-exp-in-export-file): Access current export buffer.
+ (org-babel-exp-src-block): Access current export buffer.
+ (org-babel-exp-inline-src-blocks): Access current export buffer.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * ob-exp.el (org-babel-exp-in-export-file)
+ (org-babel-exp-src-block, org-babel-exp-inline-src-blocks): Allow
+ org-current-export-file to contain a buffer.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-lparse.el (org-lparse-do-convert): Replace `call-process'
+ with `shell-command-to-string'.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-create-definition): Fix space
+ insertion when creating a new footnote. This fixes newline
+ munching when `org-footnote-section' is nil and blank lines
+ stacking when it isn't nil.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-normalize): Make sure that
+ footnotes are moved to a single place during export.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-normalize): Ensure footnote
+ definition will be inserted at the end of the section
+ corresponding to to its first reference.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-at-definition-p): Make sure to
+ move point at the beginning of the separator before skiping white
+ spaces. Refactor code.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-exp.el (org-babel-exp-src-block): Strip noweb references on
+ export when "strip-export".
+
+ * ob.el (org-babel-common-header-args-w-values): New noweb
+ header value.
+ (org-babel-merge-params): New noweb header value.
+ (org-babel-noweb-p): New noweb header value.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-tangle.el (org-babel-tangle-clean): Just use default value.
+
+ * ob.el (org-babel-noweb-wrap): Add default value.
+ (org-babel-expand-noweb-references): Just use default value.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-exp.el (org-export-select-backend-specific-text): Always
+ preserve original indentation as a text property so that lists do
+ not get broken by indentation at column 0.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-expand-noweb-references): Don't allow newlines
+ in source names in noweb references.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-fill-line-break-nobreak-p): New function.
+ (org-set-autofill-regexps): Add previous function to
+ `fill-nobreak-predicate'.
+
+2012-04-01 Vitalie Spinu <spinuvit@gmail.com>
+
+ * ob-R.el (org-babel-R-evaluate-session): Inhibit R evaluation
+ visibility regardless of local user customization.
+
+2012-04-01 Vitalie Spinu <spinuvit@gmail.com>
+
+ * ob-R.el (org-babel-R-evaluate-session): Inhibit R evaluation
+ visibility regardless of local user customization.
+
+2012-04-01 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-inlinetask.el (org-inlinetask-show-first-star): New option.
+ (org-inlinetask-fontify): Honor `org-inlinetask-show-first-star'.
+
+ * org-indent.el (org-indent-set-line-properties): Honor
+ `org-inlinetask-show-first-star'.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-set-regexps-and-options): Ensure `org-drawers'
+ doesn't contain duplicates.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-at-drawer-p): Normalize the docstring to match other
+ `org-at-*-p' docstrings.
+ (org-indent-block, org-indent-drawer, org-at-block-p): New
+ functions.
+ (org-metaright): Use the new functions to indent a drawer or a
+ block depending on the context. Also update the docstring.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-set-regexps-and-options): Set the value of
+ `org-drawers' by adding the value of the infile #+DRAWERS option
+ to that of the existing `org-drawers'.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-cycle-internal-local): Fix bug: hide drawers in
+ inline tasks too.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-inlinetask.el (org-inlinetask-toggle-visibility): Use
+ `org-show-entry' instead of `outline-flag-region' to keep the
+ drawers folded when unfolding an inline task.
+
+2012-04-01 Torsten Anders <torsten.anders@beds.ac.uk> (tiny change)
+
+ * org-beamer.el (org-beamer-environments-default): Add support and
+ keybinding for the `exampleblock' environment.
+
+2012-04-01 Michael Brand <michael.ch.brand@gmail.com>
+
+ * org.el (org-open-link-from-string): Regard `reference-buffer'
+ when setting `org-inhibit-startup'.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-exp.el (org-babel-exp-non-block-elements): Don't insert extra
+ space between inline src block and results on export.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-get-inline-src-block-matches): Allow *any*
+ punctuation to proceed an inline src block.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-get-inline-src-block-matches): Add ( to the
+ list of characters allowed to proceed an inline src block.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-tangle.el (org-babel-tangle-clean): Use the customizable
+ noweb wrappers.
+
+ * ob.el (org-babel-noweb-wrap-start): Begin a noweb reference.
+ (org-babel-noweb-wrap-end): End a noweb reference.
+ (org-babel-noweb-wrap): Apply the customizable noweb wrappers.
+ (org-babel-expand-noweb-references): Use the customizable noweb
+ wrappers.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-beginning-of-line): Handle case when there's no
+ character after box.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-format-preamble): Don't insert TOC here.
+ Delay it till the end of export.
+ (org-odt-begin-document-body): Make a note of the default
+ position of TOC in `org-lparse-dyn-first-heading-pos'.
+ (org-odt-insert-toc): Insert TOC as directed by
+ [TABLE-OF-CONTENTS] line or at the default position.
+ (org-odt-end-export): Call `org-odt-insert-toc'.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-preview-latex-fragment): Throw an error when called
+ from a non-file buffer.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-insert-property-drawer): Not an interactive
+ command anymore.
+ (org-insert-drawer): With a prefix argument, insert a property
+ drawer. Check for headline within the region before inserting the
+ drawer. Don't include special drawers in the completion table.
+ (org-mode-map): New keybinding `C-c C-x d' for
+ `org-insert-drawer'.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-insert-drawer): Support completion over known drawer
+ names and inserting a drawer around the current region.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-insert-drawer): New function.
+ (org-insert-property-drawer): Use it.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-list.el (org-mark-list): New function.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-pcomplete.el (pcomplete/org-mode/drawer): New function to
+ complete drawer at point.
+ (org-thing-at-point): Use it.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-meta-return): Use `newline-and-indent' when in a
+ property drawer.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-structure-template-alist): Fix docstring: the
+ feature is not experimental anymore.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-show-and-scroll-up): Allow `C-u' to
+ display the item without unfolding drawers and logbooks.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-src.el (org-edit-src-code): Make sure `buffer-file-name' is
+ always nil.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-structure-template-alist): Fix missing angle
+ brackets for muse export style.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-read-date): New parameter `inactive' when reading
+ for insertion of inactive timestamps.
+ (org-time-stamp, org-read-date-display): Use the new
+ parameter.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-expand-noweb-references): Only allow
+ reference names which start and end with non-whitespace characters.
+ Also, raise errors as appropriate given org-babel-noweb-error-langs.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-src.el (org-src-in-org-buffer): Save and restore
+ `buffer-undo-list' after editing.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-common-header-args-w-values): Add new header
+ argument.
+ (org-babel-expand-noweb-references): Use header argument rather than
+ customization variable.
+
+2012-04-01 David Maus <dmaus@ictsoc.de>
+
+ * org-capture.el (org-capture-place-item): Don't search for
+ position in existing list if :exact-position was supplied.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-noweb-separator): Custom variable for
+ accumulated noweb references.
+ (org-babel-expand-noweb-references): Allow separator for noweb
+ references.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-beginning-of-line): In an item, special position
+ for C-a is after check-box, if any.
+ (org-special-ctrl-a/e): Modify doc-string accordingly.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-export-odt-format-formula): Use :style
+ property to specify custom table styles.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-exp.el (org-babel-exp-call-line-template): Control export of
+ additional call line information.
+ (org-babel-exp-non-block-elements): Fancier call line export.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-entity-frame-styles): Add frame params
+ for images that are anchored as character.
+ (org-export-odt-format-image): Handle new anchor type
+ "as-char".
+ (org-export-odt-default-image-sizes-alist): Misc. change.
+ (org-export-odt-format-formula): Misc. change.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-check-src-block): Don't report valid header
+ arguments as suspicious.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-exp.el (org-babel-exp-non-block-elements): Map over both
+ inline src blocks and call lines on export.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-label-styles): Add a new style.
+ (org-odt-category-map-alist): Use it.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-table-style-format): New. Template for
+ auto-generated table styles.
+ (org-odt-automatic-styles, org-odt-object-counters): New
+ variables.
+ (org-odt-add-automatic-style): New function.
+ (org-odt-write-automatic-styles): New function. Create
+ automatic styles for tables that have custom :rel-width.
+ (org-odt-begin-table): Parse attributes specified with
+ "#+ATTR_ODT: " option and use it to create an automatic table
+ style.
+ (org-odt-save-as-outfile): Call
+ `org-odt-add-write-automatic-styles'.
+ (org-odt-init-outfile): Init newly add variables.
+ (org-odt-section-count): Remove it.
+ (org-odt-begin-section): Use `org-odt-add-automatic-style' to
+ generate an automatic section name.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-map-executables): Correctly position point when
+ mapping hits an inline code block.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-execute-src-block): Ensure params are
+ incorporated *before* checking if evaluation is legal.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-exp.el (org-babel-exp-lob-one-liners): Ensure `end' is a
+ marker so it is updated as required during export.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org-src.el (org-src-in-org-buffer): Run commands in the parent
+ buffer.
+ (org-edit-src-save): Use new macro.
+ (org-src-tangle): Tangle the parent buffer.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-set-font-lock-defaults): Fix bug in done
+ headline fontification.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-set-font-lock-defaults): Fix bug in done
+ headline fontification.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-return): Act normally when in code blocks.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-in-src-block-p): New function.
+ (org-context): Return new contexts :clocktable and :src-block.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-set-tags-command, org-set-tags): Make ̀C-u C-c
+ C-q' do the right thing even when point is before the first
+ heading.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-noweb-p): Disambiguate intersection name.
+
+2012-04-01 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-format-textbox): Honor user-specified
+ width in captioned images.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-map-src-blocks): Replace gensym with make-symbol.
+ (org-babel-map-inline-src-blocks): Replace gensym with make-symbol.
+ (org-babel-map-call-lines): Replace gensym with make-symbol.
+ (org-babel-map-executables): Replace gensym with make-symbol.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-exp.el (org-babel-exp-results): Alter a copy of info.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-html.el (org-export-as-html): Initialize
+ `html-pre-real-contents' correctly.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-html.el (org-export-as-html): Initialize
+ `html-pre-real-contents' correctly.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-exp.el (org-babel-exp-code): Ensure code block name is a
+ string on export.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-exp.el (org-babel-exp-code-template): Customizable code
+ block export format string.
+ (org-babel-exp-code): Customizable code block export.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-clojure.el (org-babel-execute:clojure): Removed dependency
+ on deprecated swank-clojure.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-map-src-blocks): Don't pollute symbol space.
+ (org-babel-map-inline-src-blocks): Don't pollute symbol space.
+ (org-babel-map-call-lines): Don't pollute symbol space.
+ (org-babel-map-executables): Map over *all* executable Org-mode
+ elements.
+ (org-babel-execute-buffer): Execute elements in buffer order instead
+ of arbitrarily.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-ctrl-c-ctrl-c): Fix a naive structure backup.
+ Those must be done with `copy-tree'.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org-src.el (org-edit-src-code): Referenced code block should
+ not be evaluated on code block edit.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-structure-template-alist): Use uppercase for
+ keywords.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-insert-result): Capitalize RESULTS in :wrap'd
+ code block results.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-results-keyword): New user-configurable
+ results keyword.
+ (org-babel-where-is-src-block-result): Use new user-configurable
+ results keyword.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-refresh-maybe): Check for new
+ headlines from the beginning of the line to be sure to catch
+ any newly inserted headline there.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-exp.el (org-babel-exp-src-block): Use `org-babel-noweb-p'.
+ (org-babel-exp-inline-src-blocks): Use `org-babel-noweb-p'.
+
+ * ob-tangle.el (org-babel-tangle-collect-blocks): Use
+ `org-babel-noweb-p'.
+
+ * ob.el (org-babel-execute-src-block): Use `org-babel-noweb-p'.
+ (org-babel-expand-src-block): Use `org-babel-noweb-p'.
+ (org-babel-load-in-session): Use `org-babel-noweb-p'.
+ (org-babel-merge-params): Use `org-babel-noweb-p'.
+ (org-babel-noweb-p): New function used to determine if noweb
+ expansion should be carried out in a given context.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.el (org-update-property-plist): Fix bug in property list
+ updates.
+
+2012-04-01 François Pinard <pinard@iro.umontreal.ca> (tiny change)
+
+ * org.el (org-kill-line): Use `kill-visual-line' in
+ `visual-line-mode'.
+
+2012-04-01 Bernt Hansen <bernt@norang.ca>
+
+ * org-agenda.el (org-agenda-switch-to): Widen org buffer only if point
+ is outside the current restriction.
+
+2012-04-01 Bernt Hansen <bernt@norang.ca>
+
+ * org-agenda.el (org-agenda-clock-in): Save restriction when clocking
+ in from the agenda.
+
+2012-04-01 Bernt Hansen <bernt@norang.ca>
+
+ * org.el: Honour existing restrictions when regenerating the agenda.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el: New alias for `list-diary-entries-hook'.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-common-header-args-w-values): Add the new
+ header argument name.
+ (org-babel-insert-result): Respect the value of the :wrap header
+ argument when inserting results.
+ (org-babel-result-end): Find the end of arbitrarily named result
+ blocks.
+
+2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-refresh-maybe): Check for new
+ headlines from the beginning of the line to be sure to catch
+ any newly inserted headline there.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * org.el (org-update-property-plist): Remove old instances of
+ property when adding a new value for property.
+
+2012-04-01 Martyn Jago <martyn.jago@btinternet.com>
+
+ * ob-emacs-lisp.el: A comment on the last line of an emacs-lisp
+ code block would cause an error when the block is was executed.
+ This fix cures this behaviour.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-expand-noweb-references): Resurrect dropped
+ pieces of a previous patch.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-maxima.el (org-babel-execute:maxima): Fix compiler warning.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-expand-noweb-references): Resurrect dropped
+ pieces of a previous patch.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-maxima.el (org-babel-execute:maxima): Fix compiler warning.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-eshell.el (org-eshell-open): Use (goto-char (point-max))
+ instead of (end-of-buffer).
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-bbdb.el (name): Declare variable.
+ (bbdb-record-get-field, bbdb-search-name)
+ (bbdb-search-organization): Declare as part of ext:bbdb.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-mobile.el (org-mobile-push): Use `org-agenda-tag-filter'
+ instead of the obsolete `org-agenda-filter'.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el: Add an alias for `org-agenda-filter'.
+ (diary-list-entries-hook): Use the non-obsolete hook.
+ (org-agenda-filter-apply): Silent compiler warning.
+
+2012-04-01 Bastien Guerry <bzg@gnu.org>
+
+ * ob-ditaa.el (org-ditaa-jar-path): Make a defcustom.
+ (org-ditaa-jar-option): New option.
+ (org-babel-execute:ditaa): Use it.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-balanced-split): Explicit checking if list
+ before calling member.
+
+2012-04-01 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-balanced-split): Explicit checking if list
+ before calling member.
+
+2012-02-14 Chong Yidong <cyd@gnu.org>
+
+ * org-footnote.el: Remove bogus defvar values (Bug#10745).
+
+2012-01-05 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-expand-noweb-references): Resurrect dropped
+ pieces of a previous patch.
+
+ * ob-maxima.el (org-babel-execute:maxima): Fix compiler warning.
+
+2012-01-05 Bastien Guerry <bzg@gnu.org>
+
+ * org-eshell.el (org-eshell-open): Use (goto-char (point-max))
+ instead of (end-of-buffer).
+
+ * org-bbdb.el (name): Declare variable.
+ (bbdb-record-get-field, bbdb-search-name)
+ (bbdb-search-organization): Declare as part of ext:bbdb.
+
+ * org-agenda.el: Add an alias for `org-agenda-filter'.
+ (diary-list-entries-hook): Use the non-obsolete hook.
+ (org-agenda-filter-apply): Silent compiler warnings.
+
+ * org-mobile.el (org-mobile-push): Use `org-agenda-tag-filter'
+ instead of the obsolete `org-agenda-filter'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-ctrl-c-ctrl-c): Preserve symmetry when adding
+ and removing checkboxes with `C-u C-c C-c' on the first item
+ of a list. Also, don't reinitialize checkboxes that are
+ already ticked.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-ts-regexp0, org-ts-regexp1): Also match a time
+ value with only one digit for the hours.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-batch-agenda, org-batch-agenda-csv):
+ Remove deleted function `org-encode-for-stdout'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-show-context): Complete docstring.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-filter-by-tag): Use
+ `read-char-exclusive' instead of `read-char'.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> (tiny change)
+
+ * org-clock.el (org-clock-in, org-clock-find-position): Remove
+ erraneous space in regexp.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-expand-noweb-references): Rather than using
+ a pure regexp solution to resolve noweb references, actually
+ check the information of every code block in the buffer. This
+ will cause a slowdown in noweb reference expansion, but is
+ necessary for correct behavior.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-map-continue-from): Fix typo in docstring.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-property-re): Also match cumulating properties
+ like ":prop+:".
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-exp-blocks.el (org-export-blocks-preprocess): Fix regexp for
+ matching the end of a block.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-open-at-point): Escape link path for http:,
+ https:, ftp:, news:, and doi: links only if the path contains
+ space or non-ascii character.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-refile-get-targets): Ignore headlines without a
+ true headline.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-map-call-lines): Moved this file from
+ ob-lob.el into ob.el to ease dependency pains.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-publish.el (org-publish-index-generate-theindex): Use
+ theindex.inc for storing index entries, and theindex.org for
+ including theindex.inc.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-publish.el (org-publish-index-generate-theindex): Create
+ proper file target for index entries in subdirectories.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-protocol.el (org-protocol-check-filename-for-protocol):
+ Fix spelling mistake.
+
+2012-01-03 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-export-odt-default-org-styles-alist): Add styles
+ for title and subtitle.
+ (org-odt-format-toc): New.
+ (org-odt-format-preamble): New. Users can redefine this to
+ customize what goes before the document body. Currently it
+ outputs title, author and email, date and toc.
+ (org-odt-begin-document-body): Use `org-odt-format-preamble'.
+ (org-odt-format-date): Renamed from
+ `org-odt-iso-date-from-org-timestamp'. Also added an
+ additional param for format string.
+ (org-odt-begin-annotation, org-odt-update-meta-file): Use
+ `org-odt-format-date'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-at-drawer-p): New function.
+ (org-end-of-line): Use it.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (*org-babel-use-quick-and-dirty-noweb-expansion*):
+ Controls the method in which noweb references are expanded.
+ (org-babel-expand-noweb-references): Bring back the option for
+ regexp-based noweb expansion.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-ts-regexp0, org-ts-regexp1): Also match a time value
+ with only one digit for the hours.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-ctrl-c-ctrl-c): Don't make `C-c C-c' special
+ when ticking the checkbox of the first item.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-list.el (org-list-write-struct): Add an optional
+ argument for structure changes happening outside the function.
+
+ * org.el (org-ctrl-c-ctrl-c): Now, `C-u C-c C-c' on the first
+ item of a sub-list should toggle check-box presence of every
+ item in the same sub-list. Also fix check-box insertion on a
+ single item.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-filter-preset): New alias.
+ (org-agenda-filter-by-category): New command.
+ (org-agenda-mode-map): Add the new command.
+ (org-agenda-custom-commands-local-options): Add category
+ filter preset.
+ (org-agenda-mark-filtered-text): Mark both tag and filter
+ overlays.
+ (org-agenda-category-filter-preset): New variable.
+ (org-finalize-agenda, org-agenda-redo)
+ (org-agenda-filter-make-matcher, org-agenda-filter-apply): Handle
+ both category and tag filters.
+ (org-agenda-filter-show-all-tag): Rename from
+ `org-agenda-filter-by-tag-show-all'.
+ (org-agenda-filter-show-all-cat): New function.
+ (org-agenda-set-mode-name): Show the category filter in the
+ modeline.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-bbdb.el (org-bbdb-old): New variable.
+ (org-bbdb-store-link, org-bbdb-open): Check for
+ `org-bbdb-old'.
+ (org-bbdb-open-old, org-bbdb-open-new): New functions.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-batch-agenda, org-batch-agenda-csv):
+ Remove deleted function `org-encode-for-stdout'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-check-dates-range): New command.
+ (org-sparse-tree): Use it.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-write): Rename from
+ `org-write-agenda'.
+ (org-agenda-mode-map, org-agenda-menu)
+ (org-batch-store-agenda-views): Use new name
+ `org-agenda-write'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-loop-over-headlines-in-active-region): Fix
+ docstring.
+ (org-todo, org-deadline, org-schedule): Honor the 'start-level
+ value of `org-loop-over-headlines-in-active-region'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-archive.el (org-archive-subtree)
+ (org-archive-to-archive-sibling, org-toggle-archive-tag):
+ Bugfix: use 'region-start-level.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-show-context): Complete docstring.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-filter-by-tag): Use
+ `read-char-exclusive' instead of `read-char'.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.el (org-scan-tags): Make sure `org-map-continue-from' is
+ nil at each match.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> (tiny change)
+
+ * org-clock.el (org-clock-in, org-clock-find-position): Remove
+ erraneous space in regexp.
+
+2012-01-03 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-lib-dir): Add docstring.
+ (org-odt-data-dir): New variable. Use this variable to
+ control the locations from which the ODT exporter picks the
+ OpenDocument styles and schema files from. Set this variable
+ explicitly only if the in-built heuristics for locating the
+ above files fails.
+ (org-odt-styles-dir-list, org-odt-schema-dir-list): New
+ variables. Pay specific attention to (eval-when-compile ...)
+ form through which Makefile's $(datadir) - contained in
+ `org-odt-data-dir' - gets compiled in as a "hard coded"
+ constant.
+ (org-odt-styles-dir, org-export-odt-schema-dir): Add messages to
+ aid debugging.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-archive.el (org-archive-subtree)
+ (org-archive-to-archive-sibling, org-toggle-archive-tag)
+ (org-archive-set-tag): Handle the 'start-level value for
+ `org-loop-over-headlines-in-active-region'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-scan-tags): New parameter `start-level' to scan only
+ through headlines of that level.
+ (org-map-entries): New allowed value `region-start-level' for
+ the `scope' parameter, to allow scanning through headlines of
+ the same level than the first headline in the region.
+ (org-loop-over-headlines-in-active-region): New allowed value
+ 'start-level.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-archive.el (org-archive-subtree)
+ (org-archive-to-archive-sibling, org-archive-set-tag)
+ (org-toggle-archive-tag): Allow to loop over the active region by
+ using `org-loop-over-headlines-in-active-region'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-todo): Allow to loop over the active region by
+ using `org-loop-over-headlines-in-active-region'.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-expand-noweb-references): Rather than using
+ a pure regexp solution to resolve noweb references, actually
+ check the information of every code block in the buffer. This
+ will cause a slowdown in noweb reference expansion, but is
+ necessary for correct behavior.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-map-continue-from): Fix typo in docstring.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-write-buffer-name): New variable.
+ (org-write-agenda): Use it.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-exp.el (org-export-date-timestamp-format): New option to
+ define the way a timestamp in #+DATE will be exported.
+ (org-infile-export-plist): Use the new option.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-property-re): Also match cumulating properties
+ like ":prop+:".
+
+2012-01-03 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-styles-dir): Assume that the styles
+ files are located under `data-directory' of Emacs distribution
+ as etc/org/OrgOdtStyles.xml and
+ etc/org/OrgOdtContentTemplate.xml. Also update docstring.
+ (org-export-odt-schema-dir): Update docstring.
+
+2012-01-03 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-format-preamble): Honor following user
+ options: author, timestamp and email.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-exp-blocks.el (org-export-blocks-preprocess): Fix regexp
+ for matching the end of a block.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-eshell.el: New file.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-open-at-point): Escape link path for http:,
+ https:, ftp:, news:, and doi: links only if the path contains
+ space or non-ascii character.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-beamer.el (org-beamer-fragile-re): Also recognize
+ \lstinline and \verb as commands that make a frame fragile.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-refile-get-targets): Ignore headlines without a
+ true headline.
+
+2012-01-03 Litvinov Sergey <slitvinov@gmail.com>
+
+ * ob-octave.el: Add graphical output to png file.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-map-call-lines): Moved this file from
+ ob-lob.el into ob.el to ease dependency pains.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-publish.el (org-publish-index-generate-theindex): Use
+ theindex.inc for storing index entries, and theindex.org for
+ including theindex.inc.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-publish.el (org-publish-index-generate-theindex): Create
+ proper file target for index entries in subdirectories.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-protocol.el (org-protocol-check-filename-for-protocol):
+ Fix spelling mistake.
+
+2012-01-03 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-export-odt-default-org-styles-alist): Add
+ styles for title and subtitle.
+ (org-odt-format-toc): New.
+ (org-odt-format-preamble): New. Users can redefine this to
+ customize what goes before the document body. Currently it
+ outputs title, author and email, date and toc.
+ (org-odt-begin-document-body): Use `org-odt-format-preamble'.
+ (org-odt-format-date): Renamed from
+ `org-odt-iso-date-from-org-timestamp'. Also added an
+ additional param for format string.
+ (org-odt-begin-annotation, org-odt-update-meta-file): Use
+ `org-odt-format-date'.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-ref.el (org-babel-ref-split-args): Now uses
+ `org-babel-balanced-split'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-html.el (org-export-html-preamble)
+ (org-export-html-postamble): Fix docstrings.
+ (org-export-as-html): Insert the string used by a custom
+ function for `org-export-html-pre/postamble'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-block-regexp)
+ (org-heading-keyword-regexp-format)
+ (org-heading-keyword-maybe-regexp-format): Move up to keep the
+ byte-compiler happy.
+
+2012-01-03 Dave Abrahams <dave@boostpro.com> (tiny change)
+
+ * org-agenda.el (org-agenda-do-tree-to-indirect-buffer): New
+ function.
+ (org-agenda-tree-to-indirect-buffer): Use the new function.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-html.el (org-export-as-html): Fix bug when inserting the
+ output of a custom function for the pre/postamble.
+
+2012-01-03 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-format-source-code-or-example): Try
+ loading htmlfontify safely.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-odt.el (require): Require htmlfontify.el only if
+ emacs-version is greater than 23.2.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-faces.el (org-agenda-calendar-event)
+ (org-agenda-calendar-sexp): Use the default face.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-expand-noweb-references): Fixed regexp.
+
+2012-01-03 Michael Brand <michael.ch.brand@gmail.com>
+
+ * org.el (Key bindings): Remap the Outline functions from
+ `outline-mode-prefix-map' where possible.
+
+2012-01-03 Christian Moe <mail@christianmoe.com> (tiny change)
+
+ * org-html.el (org-export-as-html): Apply
+ `org-export-html-get-todo-kwd-class-name' to the class
+ attribute of the todo-keyword span tag, not to its text
+ content.
+
+2012-01-03 Sebastien Vauban <sva@mygooglest.com>
+
+ * org-agenda.el (org-agenda-get-timestamps)
+ (org-agenda-get-sexps): Use face for highlighting "calendar"
+ events.
+
+2012-01-03 Peter Münster <pmlists@free.fr> (tiny change)
+
+ * org.el (org-add-planning-info): Treat absolute time too.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-table.el (org-table-transpose-table-at-point): Don't use
+ ̀remove-if-not'.
+
+2012-01-03 Dave Abrahams <dave@boostpro.com> (tiny change)
+
+ * org-clock.el (org-clock-out-if-current): Check the clock
+ buffer is existing.
+
+2012-01-03 Bernt Hansen <bernt@norang.ca>
+
+ * org-clock.el (org-clock-out-if-current): Fix marker in no
+ buffer error for task state change in an indirect buffer.
+
+2012-01-03 Michael Brand <michael.ch.brand@gmail.com>
+
+ * org.el (org-offer-links-in-entry): Make list when assigning
+ a single link.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-expand-noweb-references): Rather than
+ collect the info from *every* block in the current buffer,
+ simply regexp search for those blocks which appear to match
+ the continued source name.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob.el (org-babel-insert-result): Do not examplize wrapped
+ scalar results, simply wrap them.
+ (org-babel-result-end): Find the end of results wrapped in a
+ RESULTS drawer.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-todo-yesterday): When called from the agenda,
+ use `org-agenda-todo-yesterday' instead.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-table.el (org-table-transpose-table-at-point): New command.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-html.el (org-export-html-headline-anchor-format): New
+ option.
+ (org-html-level-start): Use the new option.
+
+2012-01-03 Rob Giardina <rob@giardina.us> (tiny change)
+
+ * org-agenda.el (org-agenda-with-point-at-orig-entry): Small
+ bugfix.
+
+2012-01-03 Christian Moe <mail@christianmoe.com> (tiny change)
+
+ * org-special-blocks.el
+ (org-special-blocks-convert-html-special-cookies): Close
+ paragraph before opening or closing the <div>, and open
+ paragraph after. Also changed newline placement to be the same
+ as for other blocks.
+
+2012-01-03 Roberto Huelga <rhuelga@gmail.com>
+
+ * org-clock.el (org-program-exists): Make the function
+ compatible with darwin systems.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-exp.el (org-export-normalize-links): Mark bracket links
+ before normalization to avoid erroneous normalization of
+ bracket link parts.
+
+2012-01-03 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-odt.el (org-odt-data-dir): Removed.
+ (org-odt-styles-dir, org-export-odt-schema-dir): New
+ variables.
+
+ * org-odt.el, org-lparse.el: New files.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-capture.el (org-capture-set-target-location): Set the
+ capture default time also to the prompt time.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-exp.el (org-export-res/src-name-cleanup): Remove #+name
+ and #+results lines during preprocess.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-picolisp.el (ob-comint): Required.
+ (comint): Required.
+ (cl): Required.
+ (run-picolisp): Declared.
+ (org-babel-execute:picolisp): Capture free variable, and replace
+ function from cl-extra with core function.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-picolisp.el: New file.
+
+ * org.el (org-babel-load-languages): Add Pico Lisp to the list
+ of supported code block languages.
+
+2012-01-03 Eric Schulte <eric.schulte@gmx.com>
+
+ * org-bibtex.el (org-bibtex): Now catches bibtex errors and
+ directs the user to the location of the error.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-dim-blocked-tasks): Fix typo.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * ob.el (org-babel-execute-src-block): Fix typo.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-freemind.el (org-freemind-write-mm-buffer): Fix typo.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-link-unescape, org-link-unescape-compound): Fix
+ two typos in docstrings.
+
+2012-01-03 Thomas Dye <dk@poto.local>
+
+ * ob-R.el: Added tikzDevice support.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-clone-subtree-with-time-shift): Remove clocking
+ information and empty drawers when preparing a clone.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-exp.el: Don't add `org-exp-res/src-name-cleanup' to
+ `org-export-blocks-postblock-hook'.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-hide-result-toggle): Skip over header
+ argument lines when toggling named code block visibility.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org-exp.el (org-export-grab-title-from-buffer): Don't
+ license to kill text inside blocks when getting a title.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-confirm-evaluate): Adding support for new
+ range of :eval header arguments.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-confirm-evaluate): Inhibit evaluation
+ during export when eval is set to "non-export".
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-ref.el (org-babel-update-intermediate): New custom
+ variable.
+ (org-babel-ref-resolve): Optionally update the in-buffer results
+ of code blocks which are evaluated to resolve references.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-join-splits-near-ch): Rejoins a list of a
+ split string when a character appears on either side of the
+ split.
+ (org-babel-parse-multiple-vars): Rejoin splits around "=" signs.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org.el (org-reduce): Added a less functional Org-mode copy of
+ the cl reduce function.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-fontify-meta-lines-and-blocks-1): Recognize
+ "name" as a valid keyword that can preceed a block.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-exp.el (org-babel-exp-lob-one-liners): Don't limit
+ in-verbatim check to inline code blocks, do lob code blocks as
+ well.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.el (org-todo): Interpret 0 prefix arg as note inhibitor.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-named-src-block-regexp-for-name): Ensure
+ that partial names are not matched.
+ (org-babel-named-data-regexp-for-name): Ensure that partial names
+ are not matched.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-ref.el (org-babel-ref-resolve): Search for named code
+ blocks before named data.
+
+ * ob.el (org-babel-named-data-regexp-for-name): New function for
+ finding named data.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-insert-result): Gracefully handle results
+ which are neither lists nor strings.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-ref.el (org-babel-ref-resolve): Don't change location when
+ looking at the contents.
+
+2012-01-03 Milan Zamazal <pdm@zamazal.org>
+
+ * org.el (org-set-outline-overlay-data): Use
+ outline-flag-region to make a region invisible. This ensures
+ all necessary actions, especially adding
+ isearch-open-invisible property, are applied.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-lob.el (org-babel-in-example-or-verbatim): Fix
+ compilation warning.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-find-named-result): Downcase "name" before
+ comparison.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-lisp.el (org-babel-execute:lisp): Fixed typo.
+ (org-babel-lisp-vector-to-list): Fixed typo.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-exp.el (org-babel-in-example-or-verbatim): Some valid
+ execution contexts (e.g., call lines) look like commented
+ lines.
+
+ * ob.el (org-babel-get-src-block-info): Empty match string doesn't
+ count.
+ (org-babel-process-params): Always process parameters, even if
+ you don't to table splitting.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-exp.el (org-exp-res/src-name-cleanup): Updated Documentation.
+
+ * ob-lob.el (org-babel-block-lob-one-liner-regexp): Updated
+ regular expression.
+ (org-babel-inline-lob-one-liner-regexp): Updated regular
+ expression.
+
+ * ob-ref.el (org-babel-ref-resolve): Notice when something that
+ looks like a data results may actually be a code block.
+
+ * ob-table.el: Updated documentation.
+
+ * ob.el (org-babel-src-name-regexp): Simplified regexp.
+ (org-babel-get-src-block-info): Updated match strings.
+ (org-babel-data-names): Simplified acceptable names.
+ (org-babel-find-named-block): Indentation.
+ (org-babel-find-named-result): Updated to not return a code block
+ as a result.
+
+ * org.el (org-fontify-meta-lines-and-blocks-1): Removing
+ references to old syntactic elements.
+ (org-additional-option-like-keywords): Removing references to
+ old syntactic elements.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-agenda.el (org-agenda-get-todos): Swap calls to `org-trim'
+ and `buffer-substring'.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-agenda.el (org-agenda-get-todos): Prevent an error when
+ encountering tasks with only the TODO keyword.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-try-cdlatex-tab): Don't try to expand a LaTeX
+ environment when at an item or an headline, but allow LaTeX
+ fragments.
+ (org-cycle): Try to call `cdlatex-tab' before cycling item's or
+ headline's visibility, in order to catch LaTeX fragments within.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org-exp-blocks.el (org-export-blocks-preprocess): Require a
+ newline and spaces before a code block.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-lob.el (org-babel-map-call-lines): Allow mapping of code
+ over all call lines in a buffer.
+
+ * ob.el (org-babel-execute-buffer): Execute call lines when
+ executing an entire buffer.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-process-params): Don't disassemble tables
+ twice.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-clock.el (org-clock-in, org-clock-find-position): Make space
+ after date optional.
+
+ * org.el (org-set-regexps-and-options)
+ (org-ts-regexp, org-ts-regexp-both, org-ts-regexp1)
+ (org-ctrl-c-ctrl-c): Make `C-c C-c' on date fix the time stamp.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-lob.el (org-babel-lob-execute-maybe): Don't execute a call
+ inside a verbatim block.
+
+ * ob-exp.el (org-babel-in-example-or-verbatim): Check for example
+ blocks.
+
+2012-01-03 Litvinov Sergey <slitvinov@gmail.com>
+
+ * ob-maxima.el (org-babel-tangle-lang-exts): Maxima extension.
+ (org-babel-maxima-expand): Add input variables and graphic output.
+ (org-babel-execute:maxima): Add input variables and graphic output.
+ (org-babel-maxima-var-to-maxima): Add input variables and graphic
+ output.
+ (org-babel-maxima-graphical-output-file): Add input variables and
+ graphic output.
+ (org-babel-maxima-elisp-to-maxima): Add input variables and graphic
+ output.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-fortran.el: New file. Adding support for Fortran code blocks.
+ * org.el (org-babel-load-languages): Adding fortran to this list.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-new): Cannot insert an inline
+ footnote at beginning of line anymore.
+ (org-footnote-at-reference-p): Don't recognize inline footnotes at
+ beginning of line.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-set-font-lock-defaults): Fix small error in matching
+ group that prevented fontification of keywords like
+ org-comment-string and stars in headlines.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.el (org-catch-invisible-edits): New option.
+ (org-self-insert-command, org-delete-backward-char)
+ (org-delete-char): Call `org-check-before-invisible-edit'.
+ (org-check-before-invisible-edit): New function.
+
+2012-01-03 Suvayu Ali <fatkasuvayu+linux@gmail.com>
+
+ * org-exp.el (org-solidify-link-text): Respect
+ org-export-with-tags when forming the export title during subtree
+ export.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-heading-regexp, org-heading-keyword-regexp-format)
+ (org-heading-keyword-maybe-regexp-format): Globalize variables so
+ they are accessible even in buffers not in Org mode.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-insert-link): Don't use default-description if a
+ `org-make-link-description-function' is defined.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org.el (org-set-regexps-and-options): Use property blocks for
+ multi-line properties.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-self-insert-command): Don't throw an error when
+ editing takes place at the first point of the buffer.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-self-insert-command): Unfold invisible region at
+ point or right before point when editing.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-faces.el (org-agenda-filter-tags): Use the 'modeline face as
+ default.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-html.el (org-html-expand): Prevent a nil value for STRING to
+ return an error, just return nil.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-latex.el (org-export-latex-set-initial-vars): Allow "/"
+ character in the #+LaTeX_CLASS option.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-at-reference-p)
+ (org-footnote-at-definition-p): Don't store text-properties of
+ footnote definitions.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-html.el (org-export-as-html): Convert special characters in
+ meta tag "author", "date", "keyword" and "description".
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-capture.el (org-capture-before-finalize-hook): Docstring
+ improvement: mention that the buffer is widened when this hook is
+ run.
+
+2012-01-03 Sebastien Vauban <sva@mygooglest.com>
+
+ * org-html.el (org-export-as-html): Make sure the div for preamble
+ is not inserted when the preamble is empty.
+
+2012-01-03 Sebastien Vauban <sva@mygooglest.com>
+
+ * org-agenda.el (org-agenda-set-mode-name): Highlight tags used
+ for filtering (shown in the mode-line).
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-parse-multiple-vars): Trimming excess white
+ space from split variables.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-link-search): Add an optional argument preventing
+ function from revealing context around match.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (calendar-check-holidays): Declare function.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-return): Fix bug when matching the face property
+ before following a link.
+
+2012-01-03 Matt Lundin <mdl@imapmail.org>
+
+ * org-agenda.el (org-class): Fix holidays symbol in org-class.
+ This was resulting in an "Bad sexp..." warning.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.el (org-scan-tags): Also remember
+ `org-complex-heading-regexp' in a property.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-latex.el (org-export-as-latex): Turn off auto-insert and set
+ TeX-master to t when creating new TeX buffers.
+
+ * org-docbook.el (org-export-as-docbook): Turn off auto-insert
+ when creating new buffers.
+
+ * org-html.el (org-export-as-html): Turn off auto-insert
+ when creating new buffers.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-table.el (org-table-formula-handle-first/last-rc): Do not
+ expand pointers to first/last row/column that are inside a call to
+ `remote'.
+ (org-table-get-remote-range): Expand pointers to first/last
+ row/column.
+
+2012-01-03 Michael Sperber <sperber@deinprogramm.de> (tiny change)
+
+ * org-capture.el (org-capture-get-indirect-buffer): Fix XEmacs
+ compatibility issue when creating an indirect buffer.
+
+2012-01-03 Christophe Rhodes <csr21@cantab.net>
+
+ * org-exp.el (org-infile-export-plist): Handle LATEX_CLASS_OPTIONS
+ the same way than LATEX_CLASS.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-return): Check the presence of the 'org-link face
+ even in contexts where there is more than one face.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-sql.el (org-babel-header-arg-names:sql): SQL specific header
+ argument names which should be inherited.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-in-block-p): Return matched name of block, if any.
+ It can be useful when a list of block names is provided as
+ an argument.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-docbook.el (org-export-as-docbook): Fix regexp.
+
+ * org-html.el (org-export-as-html): Fix regexp.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-agenda.el (org-class): Allow holidays to be skipped.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-shen.el (org-babel-execute:shen): Fix two compilation errors.
+
+2012-01-03 Peter Münster <pmrb@free.fr> (tiny change)
+
+ * org-agenda.el (org-agenda-to-appt): Make sure filter-items are
+ strings before calling `string-match'.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-at-reference-p)
+ (org-footnote-at-definition-p): Remove text-properties from label.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-html.el (org-export-as-html): Add a "title" meta tag.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-to-appt): Allow to refine the scope of
+ entries to pass to `org-agenda-get-day-entries' and allow to
+ filter out entries using a function.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-agenda.el: Fix small display bug.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-set-regexps-and-options): Fix small bug introduced
+ by commit dfcb6faef11a2439b56b18a6289803361d402130.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-agenda.el (org-search-view): Simplify regexp.
+ (org-agenda-get-todos): Use new format string.
+
+ * org-archive.el (org-archive-all-done): Simplify regexp.
+
+ * org-ascii.el (org-export-as-ascii): More accurate regexp.
+
+ * org-colview.el (org-columns-capture-view): Use new format string
+ and new string.
+
+ * org-docbook.el (org-export-as-docbook): More accurate
+ regexp. Also use new regexp to match generic headlines.
+
+ * org-exp.el (org-export-protect-quoted-subtrees): More accurate
+ regexp. Also use new regexp to match generic headlines.
+
+ * org-html.el (org-export-as-html): More accurate regexp.
+ Also use new regexp to match generic headlines.
+
+ * org-mouse.el (org-mouse-match-todo-keyword): Remove unused
+ and now erroneous function.
+
+ * org.el (org-heading-regexp, org-heading-keyword-regexp-format):
+ New variables.
+ (org-set-regexps-and-options): Create regexps according to the
+ following rule: use spaces only to separate elements from an headline,
+ while allowing mixed tabs and spaces for any indentation job.
+ (org-nl-done-regexp, org-looking-at-done-regexp): Removed variables.
+ (org-set-font-lock-defaults): Fontify again headlines with a keyword
+ and no other text. Use new format strings.
+ (org-get-heading, org-toggle-comment, org-prepare-agenda-buffers)
+ (org-toggle-fixed-width-section): Use new format string.
+ (org-todo): More accurate regexps.
+ (org-point-at-end-of-empty-headline): Simplify regexp.
+ (org-insert-heading): Headline can sometimes be nil.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-agenda.el (org-agenda-bulk-action): Bind
+ `org-loop-over-headlines-in-active-region' to nil to avoid conflict
+ with bulk command.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-deadline, org-schedule): Skip invisible headlines when
+ mapping over headlines in active region.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-loop-over-headlines-in-active-region):
+ New customization variable. Loop over headlines in active region.
+ (org-schedule, org-deadline): Apply to headlines in region depending
+ on new customization variable.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-map-entries): Immediately return if scope is 'region
+ but no region is active.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-map-entries): Extend scope 'region to include entire
+ body of last headline in active region.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-src.el (org-edit-src-code): Fix typo-bug.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-format-agenda-item, org-scan-tags):
+ Rename `org-format-agenda-item' to `org-agenda-format-item'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el: Replace `category-pos' by `org-category-pos' to
+ silent byte-compiler.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el: Declare external function `cdlatex-compute-tables'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-latex.el (org-export-latex-set-initial-vars): Fix problem
+ when matching #+LaTeX_CLASS.
+
+2012-01-03 Rafael Laboissiere <rafael@laboissiere.net> (tiny change)
+
+ * org.el (org-link-search-must-match-exact-headline): Fix typos.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-latex.el (org-export-latex-make-header): Add some hyperref
+ options.
+
+2012-01-03 Kai Tetzlaff <kai.tetzlaff@web.de> (tiny change)
+
+ * org-publish.el (org-publish-file): Added 'eval'ing the value of
+ the :publishing-directory property before using it as destination
+ of the publishing project. This allows to construct the publish
+ destination directory dynamically at run-time using the return
+ value of a function.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-list-stuck-projects): Fix tiny bug.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-agenda.el (org-agenda-move-date-from-past-immediately-to-today):
+ New option.
+ (org-agenda-date-later): Improve the logical structure.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * ob-calc.el (featurep): Require calc-store.
+
+ * org-agenda.el (org-agenda-list-stuck-projects): Fix regexp
+ special handling.
+
+ * org-compat.el (fboundp): Support for XEmacs.
+
+ * org-exp.el (org-export): Protect XEmacs from `(redisplay)' call.
+
+ * org-footnote.el (org-footnote-re): Optimize macro processing.
+
+ * org.el (org-set-autofill-regexps): Xemacs compatibility.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-balanced-split): Balance both [] and ()
+ groupings.
+ (org-babel-parse-header-arguments): Be sure to replace removed ":"
+ characters.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-parse-header-arguments): Quick fix for a
+ tiny bug.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-params-from-properties): Now splits
+ multiple var arguments behind a single ":var".
+ (org-babel-balanced-split): Separated balanced splitting of
+ strings out into a new function.
+ (org-babel-parse-multiple-vars): Splits multiple var arguments
+ behind a single ":var".
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el: Remap `outline-promote' and `outline-demote' keys to
+ `org-promote-subtree' and `org-demote-subtree'.
+
+2012-01-03 Leo Liu <sdl.web@gmail.com>
+
+ * org-agenda.el (org-agenda-do-context-action): Check if marker is
+ valid before use.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> (tiny change)
+
+ * org-agenda.el (org-agenda-date-later): Fix shifting of date
+ ranges.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el: Removing `org-babel-params-from-buffer' and
+ #+PROPERTIES: entirely.
+
+ * ob-exp.el (org-babel-exp-src-block): Removing
+ `org-babel-params-from-buffer' and #+PROPERTIES: entirely.
+
+ * ob-lob.el (org-babel-lob-execute): Removing
+ `org-babel-params-from-buffer' and #+PROPERTIES: entirely.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-params-from-buffer): Removing #+BABEL:
+ lines in favor of general #+PROPERTIES: lines.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-sql.el (org-babel-execute:sql): Insert into a temporary
+ buffer.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.el (org-cdlatex-mode): Run `cdlatex-mode-hook' and
+ update the internal cdlatex tables.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-sql.el (org-babel-execute:sql): Respect literal-results
+ options.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-disassemble-tables): Fix multi-table bug in
+ code block colname and rowname handling.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-publish.el (org-publish-cache-file-needs-publishing):
+ Fix regexp to not inlcude newlines.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.el (org-ctrl-c-ctrl-c): Remove table overlays before
+ restart.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.el (org-fontify-entities): Match entities before
+ numbers, as in `\sim2'.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-agenda.el (org-agenda-date-later): Make pushing forward
+ a past date to jump immedialtely to today.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-exp.el (org-store-forced-table-alignment): Parse the
+ column cookie for both alignment and width
+ specification. Store the resulting value in `org-col-cookies'
+ property. Retire the previously used `org-forced-aligns'
+ property for consistency. Renamed local variable `aligns' to
+ `cookies'.
+
+ * org-html.el (org-format-org-table-html): Use
+ `org-col-cookies'. Renamed local variable forced-aligns to
+ col-cookies.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.el (org-latex-to-mathml-jar-file)
+ (org-latex-to-mathml-convert-command): New user-customizable
+ variables.
+ (org-format-latex-mathml-available-p, org-create-math-formula)
+ (org-format-latex-as-mathml): New functions.
+ (org-format-latex): Add a new local variable block-type that notes
+ the nature of the equation - inline or display. Associate it's
+ value to `org-latex-src-embed-type' property of dvipng links. Add
+ mathml as new processing type.
+
+2012-01-03 Sébastien Vauban <wxhgmqzgwmuf@spammotel.com>
+
+ * org.el (org-refile): Add tree name to prompt.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-latex.el (org-export-latex-tables): Honor
+ `org-export-latex-table-caption-above'
+ (org-export-latex-table-caption-above): New option.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-insert-header-arg): Now including language
+ specific header arg values in insertion options.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-insert-header-arg): Fixed typo.
+
+2012-01-03 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-exp.el (org-export-number-lines): Modified. Add a new
+ parameter `preprocess' and use this for backend-agnostic
+ handling of literal examples.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-match-substring-regexp)
+ (org-match-substring-with-braces-regexp): Allow subscripts and
+ superscripts to start at beginning of line.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-common-header-args-w-values): New variable to
+ hold common header arguments and their default values.
+ (org-babel-header-arg-names): Redefined using the new common
+ header arg variable.
+ (org-babel-insert-header-arg): New function to help when inserting
+ header arguments.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-html.el (org-html-handle-links): Remove unnecessary
+ protection markers when publishing link in default format.
+
+2012-01-03 Pieter Praet <pieter@praet.org> (tiny change)
+
+ * org-crypt.el (org-crypt-check-auto-save): New function, see
+ next change.
+
+ * org-crypt.el (org-decrypt-entry): Break the auto-save-mode
+ check out into a separate function, and call it at a later
+ point, to assure it only runs when visiting an encrypted
+ entry.
+
+2012-01-03 John J Foerch <jjfoerch@earthlink.net> (tiny change)
+
+ * org.el (org-log-note-headings): Document new %d and %D
+ escapes.
+ (org-store-log-note): Implement new %d and %D escapes.
+
+2012-01-03 Dave Abrahams <dave@boostpro.com>
+
+ * org-agenda.el (org-agenda-follow-indirect): New option.
+ (org-agenda-follow-mode): Call `org-agenda-do-context-action' fro
+ follow mode.
+ (org-agenda-do-context-action): Also do indirect follow mode
+ action.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-table.el (sbe): Fix typo in new sbe specification.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-table.el (sbe): If first variable is a string and not a
+ cons cell, then interpret it as a string of header arguments
+ to be passed to the code block.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-shen.el (shen-eval-defun): Declare external function.
+ (org-babel-execute:shen): Move requirement of inf-shen into
+ the function in which it is used to fix build error.
+
+ * ob-shen.el: New file.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> (tiny change)
+
+ * org.el (org-open-at-point): Make `org-open-at-point' only
+ ask once about creating a new headline.
+
+2012-01-03 Nick Dokos <nicholas.dokos@hp.com> (tiny change)
+
+ * org.el (org-refile-targets): Elaborated the documentation of
+ the variable as suggested by Dave Abrahams.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> (tiny change)
+
+ * org.el (org-align-tags-here): Allow tags to be placed right
+ after heading.
+ (org-tags-column): Document the meaning of tags column 0.
+
+2012-01-03 Niels Giesen <niels.giesen@gmail.com>
+
+ * org-agenda.el (org-agenda-get-blocks): Show timestamp ranges
+ in agenda if start day is same as end day.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.el (org-refile-get-location): Ignore errors when
+ collection heading to be excluded.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-special-blocks.el
+ (org-special-blocks-convert-html-special-cookies): Avoid XHTML
+ strict problems by not enclosing special blocks in paragraph tags.
+
+2012-01-03 Bernt Hansen <bernt@norang.ca>
+
+ * org-html.el (org-export-as-html): Check string-match
+ argument.
+ (org-html-handle-time-stamps): Check string-match argument.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-agenda.el
+ (org-agenda-skip-additional-timestamps-same-entry): Change
+ default value.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.el (org-time-string-to-time):
+ (org-time-string-to-absolute): Add optional arguments BUFFER and
+ POS for error reporting.
+
+ * org-agenda.el (org-get-all-dates):
+ (org-agenda-get-timestamps, org-agenda-get-deadlines)
+ (org-agenda-get-scheduled, org-agenda-get-blocks): Call time
+ stamp parsing functions with information on where the
+ timestamp was taken from.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.el (org-tree-to-indirect-buffer): Run `org-cycle-hook'
+ after `show-all' in indirect buffer.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-list.el (org-list-parents-alist): When no parent is found
+ for an item, set it as the closest less indented item above. If
+ none is found, make it a top level item.
+ (org-list-write-struct): Externalize code.
+ (org-list-struct-fix-item-end): New function.
+ (org-list-struct): Remove a now useless fix.
+
+ * org.el (org-ctrl-c-ctrl-c): Use new function.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-end-of-line): When on an item, move point at the
+ end of the line, but before any hidden text. Thus, it's still
+ possible to use commands, like `C-c C-c', acting at
+ items. This is still disabled if `org-special-ctrl-a/e'
+ ignores `C-e'.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-renumber-fn:N): Small refactoring.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-renumber-fn:N): Fix an
+ infloop.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-at-definition-p): Remove
+ useless `org-re'.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-renumber-fn:N): Verify point
+ is at a real footnote reference or definition before
+ renumbering it.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-goto-definition): This patch
+ makes sure the function says when a definition has been
+ found. Thus, moving from the reference to the definition
+ doesn't offer to create the latter again.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-create-definition):
+ Explicitely move point after tag, if it has just been
+ inserted.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-gnuplot.el (org-babel-execute:gnuplot): Don't quote file
+ names on Windows systems.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-create-definition): When the
+ tag is missing, it is created before any existing footnote, or
+ at end of buffer. In the latter case, the marker pointing at
+ the position where the new footnote is going to be inserted
+ (at end of buffer) stays before the tag. This patch makes
+ sure that the marker will be kept after the tag.
+
+2012-01-03 Eli Zaretskii <eliz@gnu.org>
+
+ * org.el (org-mode): Force left-to-right paragraphs in Org
+ buffers. For a related discussions, see
+ https://lists.gnu.org/archive/html/emacs-devel/2011-09/msg00349.html.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * ob-asymptote.el (org-babel-asymptote-define-type): Silence
+ byte-compiler.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-R.el (org-babel-R-evaluate): Fix bug in R session
+ evaluation.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org-bibtex.el (org-bibtex-type-property-name): Configurable
+ property name for bibtex entry types.
+ (org-bibtex-headline): Use new configurable property name.
+ (org-bibtex-check): Use new configurable property name.
+ (org-bibtex-create): Use new configurable property name.
+ (org-bibtex-write): Use new configurable property name.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org.el (org-paste-subtree): Remove unnecessary `concat'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-paste-subtree): Remove useless (concat ...).
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-C.el (org-babel-C-var-to-C): Replacing usage of
+ characterp with integerp (which should work w/Emacs22).
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-at-definition-p): Context must
+ be valid at the beginning of line, not at point.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-tangle.el (org-babel-tangle-collect-blocks): Better
+ delimiting of Org-mode text preceding a code block.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-get-src-block-info): Fixing bug,
+ accidentally deleted variable values.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-tangle.el (org-babel-process-comment-text): Customizable
+ function to process comment text.
+ (org-babel-tangle-collect-blocks): Make use of new
+ customizable processing function.
+ (org-babel-spec-to-string): Call customizable function rather than
+ `org-babel-trim'.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-R.el (org-babel-execute:R): Collect and pass along the
+ result-params.
+ (org-babel-R-evaluate): Accept result-params and if "scalar" or
+ "verbatim" don't process output.
+ (org-babel-R-evaluate-session): Accept result-params and if
+ "scalar" or "verbatim" don't process output.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-merge-params): Differentiate between result
+ types and wrappers.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-get-src-block-info): Check that
+ functional-syntax variables are initialized.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-check-src-block): Adding a note for a
+ future enhancement.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-exp.el (org-export): Restore point when exporting a subtree.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-parse-src-block-match): More robust to code
+ blocks with empty bodies.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-parse-src-block-match): Don't error on empty
+ code block body.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-open-at-point): Unescape plain link.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-html.el (org-html-handle-links): Remove unnecessary link
+ unescape.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-merge-params): Better error message for
+ unassigned variables.
+
+2012-01-03 Christian Egli <christian.egli@alumni.ethz.ch>
+
+ * org-taskjuggler.el (org-export-as-taskjuggler): Clone the
+ buffer local variables to the temporary buffer before
+ exporting.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org-exp.el (org-export-select-backend-specific-text): Only
+ remove commas on the front line of a code block.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-demarcate-block): Copy headers and indent to
+ column of point when a block is split.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-insert-result): Corrected file insertion
+ for inline results.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-in-valid-context-p): No
+ footnote in latex fragments.
+
+2012-01-03 Martin Rudalics <rudalics@gmx.at>
+
+ * org-compat.el (org-pop-to-buffer-same-window): Remove LABEL
+ argument from `pop-to-buffer-same-window' call.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-R.el (org-babel-R-evaluate-session): Improve prompt
+ detection regexp.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-inlinetask.el (org-inlinetask-goto-end): Small
+ refactoring.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * ob-asymptote.el (org-babel-asymptote-var-to-asymptote):
+ refactor code.
+ (org-babel-asymptote-table-to-array): Removed function.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * ob-asymptote.el (org-babel-asymptote-var-to-asymptote):
+ recognize non-nested lists as uni-dimensional arrays.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-params-from-properties): Don't check for
+ header arguments in properties with leading ":"s.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-inlinetask.el (org-inlinetask-goto-end): Correctly
+ detect the end of an inlinetask when the next one starts
+ immediately after the current one. Also, return position of
+ point.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * ob.el (org-babel-inline-src-block-regexp): Allow regexp to
+ start at bol.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * ob-asymptote.el (org-babel-asymptote-define-type): Elisp
+ floats are asymptote reals.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * ob-asymptote.el (org-babel-asymptote-table-to-array):
+ Require a new argument TYPE specifying the detected type of
+ array. If it's a string array, make sure every element is
+ returned as a string. Also improve doc-string.
+ (org-babel-asymptote-var-to-asymptote): Fill new argument.
+ Small refactoring.
+ (org-babel-asymptote-define-type): Rewrite to avoid stopping
+ search at first float found, as strings have precedence over
+ floats.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-normalize): Be sure to separate
+ the last footnote definition from the rest of the buffer.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-awk.el (org-babel-expand-body:awk): Allow for symbolic
+ variable names.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-latex-regexps): Allow matching latex fragments
+ of type "$" and "$1" at beginning of line.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-search-view, org-agenda-get-todos)
+ (org-agenda-get-deadlines, org-agenda-get-scheduled): Add
+ `category-pos' in let construct.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-get-definition): The function has
+ to widen buffer if definition has not been found in the current
+ narrowed part. Be sure to restore that restriction once the
+ definition is found.
+
+2012-01-03 Michal Sojka <sojka@os.inf.tu-dresden.de> (tiny change)
+
+ * org-icalendar.el (org-print-icalendar-entries): Make alarm
+ duration RFC5545 compliant.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-get-timestamps)
+ (org-agenda-get-sexps, org-agenda-get-progress): Correctly set
+ the `org-category-pos' property.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-html.el (org-export-html-divs): Improve docstring.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-table.el (org-table-fix-formulas): Throw error when
+ changing formula leads to an invalid formula.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-archive-location): Minor docstring fix.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-block-todo-from-checkboxes):
+ `org-list-search-forward' should be used when looking for an
+ item, as it filters out contexts where match couldn't be in a
+ list. Also use a correct item regexp, taking into account
+ alphabetical ordered lists and counters.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-html.el (org-html-make-link): Minor fix to the
+ docstring.
+
+2012-01-03 Suvayu Ali <fatkasuvayu+linux@gmail.com> (tiny change)
+
+ * org-inlinetask.el (org-inlinetask): New customizable face
+ for inlinetasks.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-get-todos): Properly set
+ `category-pos'.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-list.el (org-list-struct-apply-struct): Don't use
+ (copy-marker (point)) instead of (point-marker).
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-where-is-src-block-result): Don't try to
+ resolve variables when simply checking if we're inside of a
+ code block.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-refresh-category-properties): New text property
+ 'org-category-position to point at the beginning of the
+ headline from which the category is set.
+
+2012-01-03 Matt Lundin <mdl@imapmail.org>
+
+ * org.el (org-refile): Don't call `org-back-to-heading' with
+ goto argument.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-link-display-descriptive): Remove this option and
+ rely on the existing `org-descriptive-links' instead.
+ (org-toggle-link-display): Use `org-descriptive-links'.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-ref.el (org-babel-ref-resolve): Allow matching of results
+ with tags after the result name.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-table.el (org-table-get-specials): Allow the use of the
+ underscore character in column names.
+ (org-table-get-specials): Allow the use of the underscore
+ character in field names.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org-exp-blocks.el (org-export-blocks-preprocess): Explicitly
+ cleaning up markers.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-exp.el (org-babel-exp-inline-src-blocks): Save match data
+ around `org-babel-exp-do-export' which now searches in this case.
+ (org-babel-exp-results): Position the point in the inline source
+ block during export evaluation.
+
+ * ob.el (org-babel-insert-result): More readable code.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org-exp-blocks.el (org-export-blocks-preprocess): Use the built
+ in function rather than the superfluous (and now removed)
+ org-specific function.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-exp.el (org-babel-exp-inline-src-blocks): Don't examplize
+ inline code blocks which are already escaped.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org-exp-blocks.el (org-marker-from-point): Helper function to
+ create markers at specific points in source buffers.
+ (org-export-blocks-preprocess): Use markers instead of points
+ to delimit code blocks.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-list.el (org-list-separating-blank-lines-number): The
+ behaviour of `org-back-over-empty-lines' depends on the
+ associated value of `headline' in
+ `org-blank-before-new-entry', which is out of context in a
+ list.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-initialize-agent): When the current
+ buffer isn't being watched, resume initialization of other watched
+ buffers. In that case, give hand to others idle timers or
+ processes more frequently.
+ (org-indent-agent-active-delay): Renamed from
+ `org-indent-agent-process-duration'.
+ (org-indent-agent-passive-delay): New variable.
+ (org-indent-agent-resume-delay): Change value.
+ (org-indent-initialize-buffer): Change argument name.
+ (org-indent-add-properties): Change argument name and type
+ expected. It must be a time value now.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-set-property): Bugfix.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-remove-result): Idempotent code block
+ evaluation and result removal.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-ruby.el (org-babel-ruby-initiate-session): No longer
+ require inf-ruby when no session evaluation takes place.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-prefix-format): Mention "%e" in
+ the docstring.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-agenda.el (org-agenda-custom-commands): Set a default
+ value for this command.
+
+2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-agenda.el (org-agenda-include-all-todo): Declare this option
+ as no longer working.
+ (org-timeline): Rename the include-all argument to dotodo.
+ (org-arg-loc): Renamed from` org-include-all-loc'.
+ (org-agenda-list): Rename the INCLUDE-ALL argument to ARG,
+ because its function has changed.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-fixup-indentation): Fix various small bugs.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-agent-timer)
+ (org-indent-agentized-buffers, org-indent-agent-resume-timer)
+ (org-indent-agent-process-duration)
+ (org-indent-agent-resume-delay): New variables.
+ (org-indent-initial-marker): More accurate doc-string.
+ (org-indent-initial-timer, org-indent-initial-resume-timer)
+ (org-indent-initial-process-duration)
+ (org-indent-initial-resume-delay)
+ (org-indent-initial-lock): Removed variables.
+ (org-indent-mode): Set up an agent to watch current buffer, or
+ add it to the list of already watched buffers.
+ (org-indent-initialize-agent): New function.
+ (org-indent-initialize-buffer): Now requires a mandatory
+ buffer argument.
+ (org-indent-add-properties): Reflect changes to variables.
+ The resume timer is now global.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-normalize): Refactor, and fix
+ some blank lines deletion.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-mode):
+ `org-indent-initial-resume-timer ' needs to be local.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-fixup-indentation): Correctly indent meta lines.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-set-line-properties): Add text
+ properties down to the beginning of the next line.
+ (org-indent-add-properties): When last position to add
+ properties to is at the beginning of a line, all that line
+ will have properties.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-initial-resume-timer): New variable.
+ (org-indent-initialize-buffer): Also resume after a small break.
+ (org-indent-add-properties): When in asynchronous mode,
+ proceed for 2 seconds, then take a break.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-set-line-properties): New function.
+ (org-indent-add-properties): Externalize worker function.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-indent-buffer): Take into account
+ narrowing.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-modified-headline-flag): Renamed from
+ `org-indent-deleted-headline-flag'
+ (org-indent-notify-modified-headline): Renamed from
+ `org-indent-notify-deleted-headline'. Handle situations when
+ the stars of an headline are modified.
+ (org-indent-refresh-maybe): Remove case now handled by
+ previous function.
+ (org-indent-mode): Apply renames.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-inlinetask-first-star): New
+ variable.
+ (org-indent-add-properties): Set the first star of inline-tasks'
+ virtual indentation in `org-warning' face.
+
+ * org-inlinetask.el (org-inlinetask-insert-task): Create a new
+ inline-task slightly differently, so virtual indentation can
+ be applied normally.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-initial-marker)
+ (org-indent-initial-timer, org-indent-initial-lock): New
+ variables.
+ (org-indent-mode): At initialization, start an idle timer to indent
+ the whole buffer. When the user is asking for control, interrupt the
+ process, and resume at the same point when idle again.
+ (org-indent-initialize-buffer): New function.
+ (org-indent-add-properties): Throw an interrupt when indentation of
+ buffer is stopped during initialization.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-indent-buffer): Send more
+ appropriate messages.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-notify-deleted-headline)
+ (org-indent-refresh-maybe): Replace `org-indent-outline-re'
+ with `org-outline-regexp-bol'.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-max-levels): Modify default value and
+ add comment.
+ (org-indent-add-properties): Pay attention to `org-indent-max'
+ and `org-indent-max-levels' values.
+ (org-indent-refresh-maybe): Refactor code to avoid an unnecessary
+ save excursion.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-table.el (org-table-align): Remove now useless hack.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-fix-section-after-idle-time): Remove
+ variable.
+ (org-indent-initialize): Remove timer.
+ (org-indent-add-properties): Refactor code.
+ (org-indent-refresh-subtree, org-indent-refresh-section)
+ (org-indent-refresh-buffer,org-indent-set-initial-properties): Remove
+ functions.
+ (org-indent-deleted-headline): New variable.
+ (org-indent-notify-deleted-headline,org-indent-refresh-maybe): New
+ functions.
+ (org-indent-mode): Insert new functions into a hook.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-indent.el (org-indent-mode): Completely refresh buffer
+ before starting org-indent-mode. Also set idle timer to refresh
+ only visible portion of buffer, and refresh the subtree instead of
+ section when promoting or demoting it.
+ (org-indent-add-properties): Rewrite function to proceed line by
+ line, as required by `wrap-prefix' specificity.
+ (org-indent-refresh-section,org-indent-refresh-subtree): Refactor.
+ (org-indent-refresh-view): New function.
+ (org-indent-refresh-to, org-indent-refresh-section): Removed
+ functions.
+
+ * org.el (org-unfontify-region): Do not remove prefix
+ properties when unfontifying a region.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-colview.el (org-columns-cleanup-item): Correctly remove
+ leading stars in items displayed in the agenda column view.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-colview.el (org-columns-display-here): Clean up items in
+ `org-agenda-mode' too.
+ (org-columns-cleanup-item): Take a new argument CPHR to allow
+ passing a complex heading regexp. Rewrite to cleanup ITEM
+ correctly in `org-agenda-mode'.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-clock.el (org-duration-string-to-minutes)
+ (org-minutes-to-hh:mm-string, org-hh:mm-string-to-minutes): Move
+ from org.el.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-refile-active-region-within-subtree): New option to
+ allow refiling a region that is part of a subtree without
+ containing a subtree itself. This default to `nil'.
+ (org-refile): Use the new option. Put point at the beginning
+ of the region/subtree to be refiled, so that users understand
+ what will be refiled. Also improve the prompt to tell whether
+ the user is refiling a region or a headline.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-properties-postprocess-alist): New option to allow
+ postprocessing the values of properties set through
+ `org-set-property'.
+ (org-set-property): Use this option.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-outline-regexp, org-outline-regexp-bol): Add a
+ docstring.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-archive.el (org-archive-to-archive-sibling): Use
+ `org-outline-regexp' instead of `outline-regexp'.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-between-regexps-p): Searching up to pos may
+ match again beginning regexp.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-goto-definition): Don't send
+ erroneous message: suggested bindings might not be set outside
+ Org.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-normalize): Effectively remove
+ any footnote tag in non Org buffers, as detailled in the
+ docstring of `org-footnote-tag-for-non-org-mode-files'.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-tag-for-non-org-mode-files):
+ notify the opportunity to set the variable to the empty string.
+ (org-footnote-normalize, org-footnote-create-definition):
+ Carefully check for inserted newlines and presence of the
+ footnote tag.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-at-definition-p): Re-use
+ `org-footnote-definition-re'.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-definition-re): Remove an
+ useless group.
+ (org-footnote-at-definition-p): Reflect removal of the group.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-set-regexps-and-options): Enforce white space
+ after todo keyword, as word boundary isn't sufficient (i.e. in
+ matches * TODO/this).
+
+2012-01-03 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-inlinetask.el (org-inlinetask-export-templates): Fixed
+ template for html so that the exported file is valid
+ xhtml. Added template for odt.
+ (org-inlinetask-export-handler): Fix typo in the regexp that
+ trims content. Make sure that the content is flanked by
+ paragraph boundaries on either side.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-add-planning-info): Don't insert superfluous
+ space when updating timestamps.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-cmp-effort): Fix docstring.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-list.el (org-list-full-item-re): When an item has only a
+ bullet and no space after it, list structure would not be
+ recognized correctly.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-overview): Use `outline-regexp' instead of
+ `org-outline-regexp' so that global cycling using
+ `orgstruct-mode' works outside of Org buffers.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-table.el (org-table-eval-formula): Fix missing variable
+ in let construct.
+ (org-table-time-string-to-seconds): Fix missing variable in
+ let construct.
+
+2012-01-03 Michael Brand <michael.ch.brand@gmail.com>
+
+ * org-agenda.el (org-agenda-get-deadlines): Fix dfrac for the
+ case of wdays being 0. Don't pass wdays to
+ org-agenda-deadline-face, like before the old fix.
+ (org-agenda-deadline-face): Revert to old state that was without
+ wdays.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-latex.el (org-export-latex-fixed-width): Only add one
+ line break after exporting verbatim environments.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-mw.el (org-mw-export-lists): Fix list export.
+
+2012-01-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-list.el (org-list-item-trim-br): New function.
+ (org-list-to-generic): New parameter :nobr to use the new
+ function.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-paste-subtree): Fix wrong order of lines to move
+ before pasting.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-paste-subtree): Paste subtree above target
+ headline if point is at bol.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-list.el (org-toggle-checkbox): Don't clear lim-down
+ while used in the while loop.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-list.el (org-toggle-checkbox): Lim-down must be a
+ marker.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-activate-code): Correct regexp so ":.*" isn't
+ matched.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-macs.el (org-with-gensyms, org-called-interactively-p)
+ (with-silent-modifications, org-bound-and-true-p)
+ (org-unmodified, org-re, org-preserve-lc)
+ (org-without-partial-completion, org-with-point-at)
+ (org-no-warnings, org-if-unprotected, org-if-unprotected-1)
+ (org-if-unprotected-at, org-with-remote-undo)
+ (org-no-read-only, org-save-outline-visibility)
+ (org-with-wide-buffer, org-with-limited-levels)
+ (org-eval-in-environment): Provide edebug specifications.
+
+ * org-src.el (org-src-do-at-code-block): Dto.
+
+ * org-publish.el (org-publish-with-aux-preprocess-maybe): Dto.
+
+ * org-compat.el (org-xemacs-without-invisibility): Dto.
+
+ * org-clock.el (org-with-clock-position, org-with-clock): Dto.
+
+ * org-agenda.el (org-agenda-with-point-at-orig-entry)
+ (org-batch-agenda, org-batch-agenda-csv)
+ (org-batch-store-agenda-views): Dto.
+
+ * ob.el (org-babel-do-in-edit-buffer)
+ (org-babel-map-src-blocks, org-babel-map-inline-src-blocks): Dto.
+
+ * ob-tangle.el (org-babel-with-temp-filebuffer): Dto.
+
+ * ob-table.el (sbe): Dto.
+
+ * ob-exp.el (org-babel-exp-in-export-file): Dto.
+
+ * ob-comint.el (org-babel-comint-in-buffer)
+ (org-babel-comint-with-output): Dto.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-inlinetask.el (org-inlinetask-export-templates): Fix
+ docstring.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-inlinetask.el (org-inlinetask-insert-task): Error when
+ trying to nest inline tasks.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-activate-code, org-toggle-fixed-width-section)
+ (org-indent-line-function): Allow "[ \t]*:$" as a special case of
+ fixed-width section.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-paste-subtree): Don't eat headline when called
+ with point at existing headline.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-paste-subtree): Fix typo in variable name.
+
+2012-01-03 Jambunathan K <kjambunathan@gmail.com>
+
+ * org-inlinetask.el (org-inlinetask-export-handler): Don't
+ export inline tasks if the current backend has provided no
+ entries in `org-inlinetask-export-templates'.
+
+2012-01-03 Valentin Wüstholz <wuestholz@gmail.com> (tiny change)
+
+ * org.el (org-indent-line-function): Made the way in which
+ example blocks are indented more flexible.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-agenda.el (org-batch-agenda-csv): Fix argument to append
+ when creating final parameter alist.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-agenda.el (org-batch-store-agenda-views): Use macro
+ `org-eval-in-environment'.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-agenda.el (org-batch-agenda, org-batch-agenda-csv): Use
+ `org-eval-in-environment.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-macs.el (org-make-parameter-alist): New function. Turn
+ flat list of alternating symbol names and values into an alist
+ with symbol name in car and value in cdr.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-agenda.el (org-agenda-with-point-at-orig-entry): Use
+ macro `org-with-gensyms'.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-macs.el (org-substitute-posix-classes): New
+ function. Substitute posix classes in regular expression.
+ (org-re): Use new function.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-macs.el (org-eval-in-environment): New macro. Evaluate FORM
+ in ENVIRONMENT.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-macs.el (org-preserve-lc, org-with-point-at)
+ (org-with-remote-undo, org-save-outline-visibility): Use new
+ macro `org-with-gensyms'.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org-macs.el (org-with-gensyms): New macro. Wrap let-binding
+ of SYMBOLS to new uninterned symbols around BODY.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-inlinetask.el (org-inlinetask-export-handler): Make sure
+ the task starts a paragraph or the HTML exporter will produce
+ an incorrect output.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-return): When filling happens, `newline' can
+ change match data, hence modifying the indent column.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-new): Only forbid non-inlined
+ footnotes at column 0, as only them can be confused with a
+ footnote definition.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-new): Use `ido' or `iswitchb'
+ when available when prompted for a label. Also rename a local
+ variable to avoid confusion with an existing function.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-label-history): Removed
+ variable
+ (org-footnote-new): Remove call to that variable.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-insert-heading): With `force-heading' non-nil,
+ inserting an heading before any headline, and just after a
+ list would return an error.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-sha1-hash): Removed use of `copy-seq'.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * org-bibtex.el (org-bibtex-get): Make the "FILE" property
+ non-special when resolving bibtex values.
+
+2012-01-03 David Maus <dmaus@ictsoc.de>
+
+ * org.el (org-back-over-empty-lines): Don't move line upward
+ if point is at eob.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-in-valid-context-p): Check
+ `org-protected' property before allowing to match a footnote.
+ (org-footnote-at-reference-p): Remove an obsolete test. It is now
+ done in the previous function.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-between-regexps-p): Previous name implied the
+ function was related to blocks, which isn't mandatory.
+ (org-narrow-to-block, org-in-block-p)
+ (org-indent-line-function): Applied the rename.
+
+ * ob-exp.el (org-babel-in-example-or-verbatim): Applied
+ rename. Also removed a white space.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-in-regexps-block-p): Return an useful value when
+ point is between START-RE and END-RE. No incomplete block is
+ allowed anymore. Add another optional argument to bound the
+ bottom part of the search.
+ (org-narrow-to-block, org-in-block-p): Apply modifications.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob.el (org-babel-src-block-regexp): If a code block has a
+ body, its last character must be a newline.
+
+2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org-footnote.el (org-footnote-next-reference-or-definition):
+ If no more footnote is found, be sure to go back to the
+ original position. Otherwise, point might be left on a
+ footnote-like element that has been dished out.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-exp.el (org-babel-inline-src-block-regexp): Declare this
+ variable.
+
+ * ob.el (defvar): Wrap variable declaration in
+ `eval-when-compile'.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-keys.el (org-babel-key-bindings): Bound to `C-c C-v k'.
+
+2012-01-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-java.el (org-babel-execute:java): Allow cmdline flags
+ during compilation and evaluation.
+
2011-12-06 Juanma Barranquero <lekktu@gmail.com>
* ob.el (org-babel-expand-body:generic, org-babel-number-p):
@@ -322,7 +7754,7 @@
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
* org-capture.el (org-capture): If no file is associated to
- current buffer, check dired buffer and try to retreive a possibly
+ current buffer, check dired buffer and try to retrieve a possibly
directory associated.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
@@ -350,7 +7782,7 @@
2011-07-28 Matt Lundin <mdl@imapmail.org>
* org-bibtex.el (org-bibtex-create, org-bibtex-write): Change
- argument of `org-toggle-tag' to 'on. (Other arguments, e.g., t,
+ argument of `org-toggle-tag' to 'on. (Other arguments, e.g., t,
have no effect).
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
@@ -532,7 +7964,7 @@
* org-latex.el (org-export-latex-header-defs-re): Delete.
-2011-07-28 Bastien <bzg@gnu.org>
+2011-07-28 Bastien Guerry <bzg@gnu.org>
* org.el (org-last-set-property): New variable.
(org-read-property-name): Use the new variable: the prompt
@@ -734,7 +8166,7 @@
* ob-haskell.el (org-babel-haskell-export-to-lhs): Call
`kill-buffer' with argument indiciating to kill current
- buffer. Emacs 22 compatibility.
+ buffer. Emacs 22 compatibility.
2011-07-28 David Maus <dmaus@ictsoc.de>
@@ -926,7 +8358,7 @@
* org-exp.el (org-export-preprocess-string): If the last subtree
is commented, footnotes inserted during normalizing at the end of
- the buffer may get deleted. This patch ensures deletion comes
+ the buffer may get deleted. This patch ensures deletion comes
first, normalization second.
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
@@ -948,7 +8380,7 @@
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
* org-latex.el (org-export-latex-preprocess): Rely on
- `org-export-footnotes-markers' to retreive definition of the
+ `org-export-footnotes-markers' to retrieve definition of the
current footnote during export.
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
@@ -1007,7 +8439,7 @@
* org-footnote.el (org-footnote-goto-definition): Now, determining
if point is at a footnote reference is entirely determined by
- `org-footnote-at-reference-p'. No need to check if pattern isn't
+ `org-footnote-at-reference-p'. No need to check if pattern isn't
at beginning of the line elsewhere.
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
@@ -1259,7 +8691,7 @@
* org-exp.el (org-export-backends): New variable.
(org-export-select-backend-specific-text): Use above
- variable. Also mark text between #+BACKEND and
+ variable. Also mark text between #+BACKEND and
#+BEGIN_BACKEND...#+END_BACKEND with org-native-text property.
This text property is currently used only by the new line-oriented
generic exporter (which is not yet part of the repo).
@@ -1686,7 +9118,7 @@
* org-exp.el (org-export): Use new compatibility function
`org-activate-mark'.
- * org-compat.el (org-activate-mark): New function. Provide
+ * org-compat.el (org-activate-mark): New function. Provide
`activate-mark' if not present (e.g. Emacs 22).
2011-07-28 David Maus <dmaus@ictsoc.de>
@@ -1856,14 +9288,14 @@
* org-html.el (org-export-as-html): Don't expand non-data lines of
table.el tables.
(org-html-expand): Removed the (buggy) test for non-data lines
- in table.el tables. The test is now done as part of
+ in table.el tables. The test is now done as part of
org-export-as-html.
(org-format-table-table-html-using-table-generate-source):
Added test for spanning of cells in table.el tables using
- table.el's own library routine. Optionlly Suppress export of
+ table.el's own library routine. Optionally suppress export of
simple table.el tables.
(org-format-table-html): Removed the (buggy) test for spanned
- table.el tables. The test is now done as part of
+ table.el tables. The test is now done as part of
org-format-table-table-html-using-table-generate-source.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
@@ -1991,10 +9423,6 @@
* ob-exp.el (org-babel-exp-in-export-file): Bind
`org-link-search-inhibit-query' to t to inhibit prompts.
-2011-07-28 Julien Danjou <julien@danjou.info>
-
- * org-contacts.el: Merge org-contacts-wl.el.
-
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-add-options-to-plist): Use the right
@@ -2029,10 +9457,6 @@
* org-agenda.el (org-agenda-open-link): Pass entire text of agenda
line to `org-offer-links-in-entry'.
-2011-07-28 Michael Markert <markert.michael@googlemail.com>
-
- * org-contacts-wl.el: New file.
-
2011-07-28 Matt Lundin <mdl@imapmail.org>
* org-bibtex.el (org-bibtex-search): New function.
@@ -2245,7 +9669,7 @@
function would not pay attention to drawers or blocks indentation.
Thus, such constructs couldn't consistently end an item or a list.
This patch ensures line indentation is stored (if applicable)
- before skipping them. Also fixed doc-string and comments.
+ before skipping them. Also fixed doc-string and comments.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
@@ -2583,7 +10007,7 @@
2011-07-28 Julien Danjou <julien@danjou.info>
* org-latex.el (org-export-latex-date-format): Change default date
- format to \today. This has the same result but respects the
+ format to \today. This has the same result but respects the
language set in the document by default.
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
@@ -2798,11 +10222,8 @@
(org-agenda-open-link): Stop using prefix-length.
(org-agenda-change-all-lines): Stop using prefix-length.
- * org-colview-xemacs.el (org-columns-display-here): Stop using
- prefix-length. Always return claned items.
-
* org-colview.el (org-columns-display-here): Stop using
- prefix-length. Always return claned items.
+ prefix-length. Always return claned items.
* org-mobile.el (org-mobile-write-agenda-for-mobile): Stop using
prefix-length.
@@ -2906,7 +10327,7 @@
2011-07-28 Bastien Guerry <bzg@gnu.org>
- * org-html.el (org-export-as-html): bugfix: insert email
+ * org-html.el (org-export-as-html): Bugfix: insert email
correctly.
2011-07-28 Bastien Guerry <bzg@gnu.org>
@@ -3347,7 +10768,7 @@
2011-07-28 Julien Danjou <julien@danjou.info>
* org-macs.el (org-with-point-at): Store evaluated version of
- pom. This fixes a potential bug when using (org-with-point-at
+ pom. This fixes a potential bug when using (org-with-point-at
(func) …), where (func) would be evaluated multiple times,
therefore might return different results if a marker was returned
and different each time.
@@ -3616,7 +11037,7 @@
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
- * org.el (org-toggle-item): Now accepts a prefix argument. When
+ * org.el (org-toggle-item): Now accepts a prefix argument. When
used without argument on normal text, it will make the whole
region one item. With an argument, it defaults to old behavior:
change each line in region into an item.
@@ -3775,7 +11196,7 @@
* org-inlinetask.el (org-inlinetask-export-templates): Slightly
modify templates so environment boundaries don't interfere with
content of task. Unprotect content of task so it might benefit
- from further transformations. Set original-indentation property to
+ from further transformations. Set original-indentation property to
a high value to ensure that task is always in the last item of the
list. Also, apply templates later in export process.
@@ -3806,7 +11227,7 @@
* org-exp.el (org-export-preprocess-string): Mark list endings
before babel blocks preprocessing starts, so blank lines that may
be inserted do not break list's structure. Then, mark list with
- special properties required by exporters. Thus output from babel
+ special properties required by exporters. Thus output from babel
can easily be included in lists.
(org-export-mark-list-end): New function.
(org-export-mark-list-properties): New function.
@@ -3911,7 +11332,7 @@
helper function is not optional anymore.
(org-list-get-all-items): Shorten code with the help of cl.el.
(org-list-get-children): Now returns all children of item, even if
- they do not belong to the same list. Renamed from
+ they do not belong to the same list. Renamed from
`org-list-get-all-children'.
(org-list-get-list-begin): Function wasn't return value when item
was already the first item of the list at point.
@@ -4354,7 +11775,7 @@
* ob.el (org-babel-params-from-properties): Test for
"header-arg-name" and ":header-arg-name", in that order.
-2011-07-28 Bastien <bastien.guerry@wikimedia.fr>
+2011-07-28 Bastien Guerry <bzg@gnu.org>
* org-capture.el (org-capture-templates): Document "currentfile"
for capture template.
@@ -5862,7 +13283,7 @@
Remove hard-wired configuration of minted export
(org-export-latex-minted-with-line-numbers): Remove variable.
-2010-12-11 Bastien Guerry <bzg@altern.org>
+2010-12-11 Bastien Guerry <bzg@gnu.org>
* org-clock.el (org-dblock-write:clocktable): Fix double
reference to `link' in let construct.
@@ -6053,10 +13474,9 @@
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-capture.el (org-capture-templates): New capture property
- `:kill-buffer'. (org-capture-finalize): Kill target buffer if that
- is desired.
- (org-capture-target-buffer): Remember if we have to make the
- buffer.
+ `:kill-buffer'.
+ (org-capture-finalize): Kill target buffer if that is desired.
+ (org-capture-target-buffer): Remember if we have to make the buffer.
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
@@ -7256,7 +14676,7 @@
* org.el (org-make-link-string): Don't escape characters in link
type.
-2010-11-11 Bastien Guerry <bzg@altern.org>
+2010-11-11 Bastien Guerry <bzg@gnu.org>
* org-capture.el (org-capture-templates): Update docstring to
advertise %:org-date.
@@ -7341,7 +14761,7 @@
* ob-keys.el (org-babel-key-bindings): Key bindings for block
demarcation.
-2010-11-11 Bastien Guerry <bzg@altern.org>
+2010-11-11 Bastien Guerry <bzg@gnu.org>
* org.el (org-link-types): Add the "message" link type.
@@ -7350,7 +14770,7 @@
* org.el (org-link-types): Add 'message:' link type to default
link types.
-2010-11-11 Bastien Guerry <bzg@altern.org>
+2010-11-11 Bastien Guerry <bzg@gnu.org>
* org-gnus.el (org-gnus-store-link): Add the :date property to
gnus links, allowing the use of %:date in capture templates.
@@ -7575,15 +14995,15 @@
2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org-list.el (org-list-insert-item-generic): Updating checkboxes
- can modifiy bottom point of a list, so make it a marker before
+ can modify bottom point of a list, so make it a marker before
calling `org-update-checkbox-count-maybe'.
2010-11-11 Dan Davison <davison@stats.ox.ac.uk>
* org.el (org-src-fontify-natively): Set to nil by default.
- Supply cutomize interface.
+ Supply customize interface.
-2010-11-11 Bastien Guerry <bzg@altern.org>
+2010-11-11 Bastien Guerry <bzg@gnu.org>
* org-ascii.el (org-export-as-ascii): Fix bug in ASCII export: use
`org-bracket-link-analytic-regexp++' to match the link type.
@@ -8145,7 +15565,7 @@
* org-list.el (org-insert-item-internal): New function to handle
positioning and contents of an item being inserted at a specific
- pos. It is not possible anymore to split a term in a description
+ pos. It is not possible anymore to split a term in a description
list or a checkbox when inserting a new item.
* org-list.el (org-insert-item): Refactored by using the new
@@ -8841,7 +16261,7 @@
(org-org-menu): Remove the entry to configure LaTeX snippet
processing.
-2010-11-11 Bastien Guerry <bzg@altern.org>
+2010-11-11 Bastien Guerry <bzg@gnu.org>
* org-agenda.el (org-agenda-clock-goto): Use `\C-c\C-x\C-j' for
`org-clock-goto' and `J' for `org-agenda-clock-goto'. If the
@@ -9157,16 +16577,6 @@
* org-capture.el (org-capture-templates): Fix customize type.
-2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
-
- * org-colview-xemacs.el (org-columns-compile-map):
- (org-columns-number-to-string):
- (org-columns-string-to-number): Handle estimate ranges.
- (org-estimate-mean-and-var): New function.
- (org-estimate-combine): New function.
- (org-estimate-print): New function.
- (org-string-to-estimate): New function.
-
2010-09-25 Juanma Barranquero <lekktu@gmail.com>
* org.el (org-refile-targets):
@@ -9677,7 +17087,7 @@
* org-html.el (org-export-html-close-lists-maybe): Check if raw
HTML stuff was actually made from an example.
-2010-07-19 Bastien Guerry <bzg@altern.org>
+2010-07-19 Bastien Guerry <bzg@gnu.org>
* org-latex.el: Items are no longer skipped when their first line
ends on a protected element.
@@ -9690,18 +17100,18 @@
* org-exp-blocks.el (org-export-blocks-preprocess):
Cleanup trailing newline after block.
-2010-07-19 Bastien Guerry <bzg@altern.org>
+2010-07-19 Bastien Guerry <bzg@gnu.org>
* org-exp.el: Comment regexp now matches documentation. No more
protection check when deleting comments before export.
-2010-07-19 Bastien Guerry <bzg@altern.org>
+2010-07-19 Bastien Guerry <bzg@gnu.org>
* org-exp.el (org-export-preprocess-string):
Now using `org-export-handle-include-files-recurse' to resolve
included files.
-2010-07-19 Bastien Guerry <bzg@altern.org>
+2010-07-19 Bastien Guerry <bzg@gnu.org>
* org-agenda.el (org-agenda-get-deadlines)
(org-agenda-get-scheduled):
@@ -9712,7 +17122,7 @@
now instead of resetting on the cyclic repeating date. This makes it
much more obvious when you missed a repeating task after the repeater.
-2010-07-19 Bastien Guerry <bzg@altern.org>
+2010-07-19 Bastien Guerry <bzg@gnu.org>
* org-exp.el (org-export-mark-blockquote-verse-center):
Consider environments that end at eob.
@@ -9752,16 +17162,16 @@
from latex backend specific instructions (#+LaTeX) are already
protected and won't be treated as normal environments.
-2010-07-19 Bastien Guerry <bzg@altern.org>
+2010-07-19 Bastien Guerry <bzg@gnu.org>
* org-timer.el (org-timer-set-timer): Fix typo in the docstring.
-2010-07-19 Bastien Guerry <bzg@altern.org>
+2010-07-19 Bastien Guerry <bzg@gnu.org>
* org-timer.el (org-timer-set-timer): Use a prefix argument.
See the docstring of the function.
-2010-07-19 Bastien Guerry <bzg@altern.org>
+2010-07-19 Bastien Guerry <bzg@gnu.org>
* org-timer.el (org-timer-set-timer): Fix bug about canceling
timers.
@@ -9782,7 +17192,7 @@
t before calling `org-clock-out', so that that function can
know its call context.
-2010-07-19 Bastien Guerry <bzg@altern.org>
+2010-07-19 Bastien Guerry <bzg@gnu.org>
* org-timer.el (org-timer-default-timer): New variable.
(org-timer-set-timer): Use the new variable. Also offer the
@@ -10194,9 +17604,6 @@
* org-src.el (org-edit-src-find-region-and-lang): Test for
table.el as late as possible.
- * org-colview-xemacs.el: Make sure this file is never loaded into
- Emacs. Remove all tests for XEmacs.
-
* org-colview.el: Make sure this file is never loaded into XEmacs.
* org-agenda.el (org-highlight, org-unhighlight): Use direct
@@ -10232,7 +17639,7 @@
* org-compat.el (org-overlays-at): Function removed.
(org-overlays-in): Function removed.
-2010-07-19 Bastien Guerry <bzg@altern.org>
+2010-07-19 Bastien Guerry <bzg@gnu.org>
* org-clock.el (org-clock-set-current): Just return the headline
itself, strip the TODO keyword, the priority cookie and the tags.
@@ -10478,7 +17885,7 @@
* org-publish.el (org-publish-aux-preprocess): Control case
sensitivity.
-2010-04-10 Bastien Guerry <bzg@altern.org>
+2010-04-10 Bastien Guerry <bzg@gnu.org>
* org.el (org-splice-latex-header): Fix typo.
@@ -10966,7 +18373,7 @@
restricted, as an agenda mode.
(org-agenda-fontify-priorities): Allow simple colors as values.
-2010-04-10 Bastien Guerry <bzg@altern.org>
+2010-04-10 Bastien Guerry <bzg@gnu.org>
* org-timer.el (org-timer-current-timer): Rename from
`org-timer-last-timer'.
@@ -10984,7 +18391,7 @@
* org-exp.el (org-export-format-source-code-or-example):
Fix textarea tag.
-2010-04-10 Bastien Guerry <bzg@altern.org>
+2010-04-10 Bastien Guerry <bzg@gnu.org>
* org-clock.el (org-clock-current-task): New variable to store
last clocked in task.
@@ -11559,9 +18966,6 @@
* org-exp.el (org-export): Use "1" as a sign to export only the
subtree.
- * org-colview-xemacs.el (org-columns-edit-value):
- Use org-unrestricted property.
-
* org-colview.el (org-columns-edit-value):
Use org-unrestricted property.
@@ -11960,13 +19364,6 @@
(org-agenda-colview-summarize): Handle extended summary types
properly.
- * org-colview-xemacs.el (org-columns-display-here): Don't try to
- calculate values if the underlying property is not set.
- (org-columns-string-to-number): Convert age strings back into
- fractional days.
- (org-agenda-colview-summarize): Handle extended summary types
- properly.
-
2009-11-13 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-format-drawer-function): New variable.
@@ -12145,10 +19542,6 @@
org-return-follows-link' is set and there is nothing else to do in
this line.
-2009-11-13 James TD Smith <ahktenzero@mohorovi.cc>
-
- * org-colview-xemacs.el: Add in changes from org-colview.el.
-
2009-11-13 Dan Davison <davison@stats.ox.ac.uk>
* org-exp-blocks.el: Modify split separator regexp to avoid empty
@@ -12269,9 +19662,8 @@
2009-11-13 John Wiegley <jwiegley@gmail.com>
- * org-clock.el
- (org-clock-auto-clock-resolution): Now takes three values: nil, t
- and `when-no-clock-is-running'.
+ * org-clock.el (org-clock-auto-clock-resolution): Now takes three
+ values: nil, t and `when-no-clock-is-running'.
(org-clock-in): Use `org-clock-auto-clock-resolution' to determine
whether or not to resolve Org buffers on clock in.
@@ -12299,7 +19691,7 @@
(org-columns-compile-format): Support the additional parameter in
org-columns-compile-map.
-2009-11-13 Bastien Guerry <bzg@altern.org>
+2009-11-13 Bastien Guerry <bzg@gnu.org>
* org.el (org-mode-hook): Turn `org-mode-hook' into a customizable
variable.
@@ -12968,7 +20360,7 @@
* org.el (org-shifttab): Interpret arg differently when using only
odd levels.
-2009-10-01 Bastien Guerry <bzg@altern.org>
+2009-10-01 Bastien Guerry <bzg@gnu.org>
* org.el (org-check-agenda-file): Use a more explicit message.
@@ -12977,7 +20369,7 @@
* org-exp.el (org-export-remove-special-table-lines): Don't remove
normal lines.
-2009-10-01 Bastien Guerry <bzg@altern.org>
+2009-10-01 Bastien Guerry <bzg@gnu.org>
* org.el (org-offer-links-in-entry): Don't use "Select link" as a
prompt in the temporary window.
@@ -13188,7 +20580,7 @@
* org-gnus.el (org-gnus-store-link): Restore the linking to a
website.
-2009-09-02 Bastien Guerry <bzg@altern.org>
+2009-09-02 Bastien Guerry <bzg@gnu.org>
* org-latex.el (org-export-latex-first-lines): Bugfix.
@@ -13274,9 +20666,6 @@
* org-colview.el (org-columns, org-columns-redo)
(org-agenda-columns): Don't use `goto-line'.
- * org-colview-xemacs.el (org-columns, org-agenda-columns):
- Don't use `goto-line'.
-
* org-agenda.el (org-agenda-mode): Force visual line motion off.
(org-agenda-add-entry-text-maxlines): Improve docstring.
(org-agenda-start-with-entry-text-mode): New option.
@@ -13332,7 +20721,7 @@
(org-remember-apply-template): Use `org-remember-escaped-%' to
detect escaped % signs.
-2009-09-02 Bastien Guerry <bzg@altern.org>
+2009-09-02 Bastien Guerry <bzg@gnu.org>
* org-timer.el (org-timer-set-timer): Use `org-notify' and play a
sound when showing the notification.
@@ -13381,10 +20770,6 @@
* org-colview.el (org-columns-edit-value, org-columns-new)
(org-insert-columns-dblock): Use org-icompleting-read.
- * org-colview-xemacs.el (org-columns-edit-value)
- (org-columns-new, org-insert-columns-dblock):
- Use org-icompleting-read.
-
* org-attach.el (org-attach-delete-one, org-attach-open):
Use org-icompleting-read.
@@ -13466,7 +20851,7 @@
* org-exp.el (org-export-format-source-code-or-example):
Use listing package if requested by the user.
-2009-09-02 Bastien Guerry <bzg@altern.org>
+2009-09-02 Bastien Guerry <bzg@gnu.org>
* org.el (org-iswitchb): Fix bug when aborting the `org-iswitchb'
command before actually switching to a buffer.
@@ -13700,14 +21085,14 @@
* org-macs.el (org-unmodified): Turn of modification hooks while
running this macro.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
* org.el (org-adapt-indentation): Slightly improve the docstring.
(org-occur): Sends an error when the user inputs an empty string.
(org-priority): Bugfix: the tag alignement should happen within
save-excursion.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
* org.el (org-make-link-regexps): Don't exclude parentheses from
`org-plain-link-re'.
@@ -13721,7 +21106,7 @@
* org-clock.el (org-clock-in): Bugfix: recognize timestamps with
an abbreviated format for days.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
* org-protocol.el (org-protocol-default-template-key):
New option.
@@ -13738,7 +21123,7 @@
(org-update-parent-todo-statistics): Possibly use the new allowed
value of `org-provide-todo-statistics'.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
* org-timer.el: Add autoload cookie.
@@ -13763,7 +21148,7 @@
(org-update-parent-todo-statistics): Possibly use the new
'all-headline value from `org-provide-todo-statistics'.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
* org-clock.el (org-dblock-write:clocktable): Add a new option
:timestamp which allows display of timestamps in clock reports.
@@ -13779,7 +21164,7 @@
* org.el (org-eval-in-calendar): Select the right frame.
(org-save-frame-excursion): Remove this macro.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
* org-list.el (org-list-beginning-re): Bugfix: don't use * when
trying to find the beginning of a list.
@@ -13793,7 +21178,7 @@
(org-id-method): Use `org-id-uuid-program'.
(org-id-new): Use `org-id-uuid-program'.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
* org-exp.el (org-export-number-lines): Allow whitespace in code
references. Allow the -r switch to remove the references in the
@@ -13806,18 +21191,18 @@
* org-clock.el (org-show-notification-handler): New option.
(org-show-notification): Use the new option.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
* org.el (org-eval-in-calendar): Fix a bug about calendar
navigation when `calendar-setup' value is 'calendar-only.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
* org.el (orgstruct++-mode): Fix typo in docstring.
(org-insert-link): Clean up: (or (...)) => (...)
(org-insert-link): Use TAB for stored links completion.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
* org.el (org-get-refile-targets): Fix bug: don't ignore case when
building the list of targets.
@@ -13834,12 +21219,12 @@
* org-plot.el (org-plot/gnuplot): Run with an idle timer to avoid
premature deletion of the data when using org-plot in a script.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
* org-clock.el (org-clock-in-prepare-hook): New hook.
(org-clock-in): Use this new hook.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
* org.el (org-special-ctrl-a/e): Explicitly bind the value
'reversed for this option to the "true line boundary first"
@@ -14079,10 +21464,6 @@
in column values.
(org-columns-capture-view): Exclude comment and archived trees.
- * org-colview-xemacs.el (org-columns-capture-view):
- Protect vertical bars in column values.
- (org-columns-capture-view): Exclude comment and archived trees.
-
* org.el (org-quote-vert): New function.
* org-latex.el (org-export-latex-verbatim-wrap): New option.
@@ -14271,9 +21652,6 @@
* org-colview.el (org-dblock-write:columnview): Allow indented
#+TBLFM line.
- * org-colview-xemacs.el (org-dblock-write:columnview):
- Allow indented #+TBLFM line.
-
* org-clock.el (org-dblock-write:clocktable): Allow indented
#+TBLFM line.
@@ -14350,9 +21728,6 @@
* org.el (org-enable-priority-commands): New option.
- * org-colview-xemacs.el (org-columns-compute)
- (org-columns-number-to-string): Fix problems with empty fields.
-
* org-colview.el (org-columns-compute)
(org-columns-number-to-string): Fix problems with empty fields.
@@ -14555,9 +21930,6 @@
(org-export-region-as-latex): Use the property list.
(org-export-as-latex): ????
- * org-colview-xemacs.el (org-columns-remove-overlays)
- (org-columns): Fix call to `local-variable-p'.
-
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-after-blockquotes-hook): New hook.
@@ -14873,7 +22245,7 @@
* org-exp.el (org-export-splice-attributes): New function.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
Daniel M German <dmg@uvic.org>
Sebastian Rose <sebastian_rose@gmx.de>
Ross Patterson <me@rpatterson.net>
@@ -14993,12 +22365,6 @@
(org-columns-remove-overlays): Restore the value of `truncate-lines'.
(org-columns): Remember the value of `truncate-lines'.
- * org-colview-xemacs.el (org-colview-initial-truncate-line-value):
- New variable.
- (org-columns-remove-overlays): Restore the value of
- `truncate-lines'.
- (org-columns): Remember the value of `truncate-lines'.
-
* org.el (org-columns-skip-arrchived-trees): New option.
* org-agenda.el (org-agenda-export-html-style): Define color for
@@ -15084,7 +22450,7 @@
* org-exp.el (org-export-as-ascii): Improve export of plain lists.
-2009-08-06 Bastien Guerry <bzg@altern.org>
+2009-08-06 Bastien Guerry <bzg@gnu.org>
* org.el (org-toggle-fixed-width-section): Bug fix: insert a
column and a space, not only a column.
@@ -15740,10 +23106,6 @@
Better error catching when a date/time property does not have allowed
values defined.
- * org-colview-xemacs.el (org-colview-construct-allowed-dates):
- Better error catching when a date/time property does not have
- allowed values defined.
-
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-map-entries): Restore point and restriction after
@@ -16491,10 +23853,6 @@
* org-colview.el (org-columns-edit-value, org-columns-new)
(org-insert-columns-dblock): Use `org-ido-completing-read'.
- * org-colview-xemacs.el (org-columns-edit-value)
- (org-columns-new, org-insert-columns-dblock):
- Use `org-ido-completing-read'.
-
* org-attach.el (org-attach-delete-one, org-attach-open):
Use `org-ido-completing-read'.
@@ -16899,7 +24257,7 @@
* org-archive.el (org-archive-to-archive-sibling): Handle top
level headlines better.
-2008-10-26 Bastien Guerry <bzg@altern.org>
+2008-10-26 Bastien Guerry <bzg@gnu.org>
* org-export-latex.el (org-export-latex-classes):
Add \usepackage{graphicx} to the default list of packages.
@@ -17073,9 +24431,6 @@
* org-colview.el (org-columns-get-format-and-top-level):
Remove resetting the marker.
- * org-colview-xemacs.el (org-columns-get-format-and-top-level):
- Remove resetting the marker.
-
* org.el (org-entry-property-inherited-from): Improve docstring.
(org-entry-get-with-inheritance): Reset marker before starting the
search.
@@ -17123,7 +24478,7 @@
New functions, similar to the outline versions, but invisible headings
are OK.
-2008-10-12 Bastien Guerry <bzg@altern.org>
+2008-10-12 Bastien Guerry <bzg@gnu.org>
* org.el (org-auto-repeat-maybe): Insert a space between
the timestamp's type and the timestamp itself.
@@ -17135,13 +24490,13 @@
* org.el (org-map-entries): Protect the keyword-selecting variables.
-2008-10-12 Bastien Guerry <bzg@altern.org>
+2008-10-12 Bastien Guerry <bzg@gnu.org>
* org-agenda.el (org-agenda-to-appt): Make sure the function check
against all agenda files.
2008-10-12 Carsten Dominik <dominik@science.uva.nl>
- Bastien Guerry <bzg@altern.org>
+ Bastien Guerry <bzg@gnu.org>
* org-list.el: New file, aggregating list functions from org.el
and org-export-latex.el.
@@ -17153,7 +24508,7 @@
* org-agenda.el (org-agenda-to-appt): Fix bug with appointment
time before 1am.
-2008-10-12 Bastien Guerry <bzg@altern.org>
+2008-10-12 Bastien Guerry <bzg@gnu.org>
* org-export-latex.el (org-export-latex-keywords-maybe): Bug fix.
@@ -17198,7 +24553,7 @@
* org-compat.el (org-propertize): New function.
-2008-10-12 Bastien Guerry <bzg@altern.org>
+2008-10-12 Bastien Guerry <bzg@gnu.org>
* org-export-latex.el (org-export-latex-tables): Protect exported
tables from further special chars conversion.
@@ -17250,11 +24605,6 @@
(org-columns-next-allowed-value):
Use `org-colview-construct-allowed-dates'.
- * org-colview-xemacs.el (org-colview-construct-allowed-dates):
- New function.
- (org-columns-next-allowed-value):
- Use `org-colview-construct-allowed-dates'.
-
* org.el (org-protect-slash): New function.
(org-get-refile-targets): Use `org-protect-slash'.
@@ -17304,7 +24654,7 @@
* org.el (org-log-note-extra): New variable.
-2008-10-12 Bastien Guerry <bzg@altern.org>
+2008-10-12 Bastien Guerry <bzg@gnu.org>
* org.el (org-additional-option-like-keywords): Add keywords for
the _QUOTE, _VERSE and _SRC environments.
@@ -17384,9 +24734,6 @@
* org-colview.el (org-columns-display-here):
Use `org-columns-modify-value-for-display-function'.
- * org-colview-xemacs.el (org-columns-display-here):
- Use `org-columns-modify-value-for-display-function'.
-
* org.el (org-columns-modify-value-for-display-function): New option.
* org-publish.el (org-publish-file): Make sure the directory match
@@ -17577,8 +24924,6 @@
* org-colview.el (org-columns-next-allowed-value): Bug fix.
- * org-colview-xemacs.el (org-columns-next-allowed-value): Bug fix.
-
* org-agenda.el (org-agenda-get-closed): Get the end time into the
agenda prefix as well.
@@ -17699,9 +25044,6 @@
* org-colview.el (org-columns-next-allowed-value): Handle next
argument NTH to directly select a value.
- * org-colview-xemacs.el (org-columns-next-allowed-value): Handle next
- argument NTH to directly select a value.
-
2008-06-17 Carsten Dominik <dominik@science.uva.nl>
* org-agenda.el (org-agenda-scheduled-leaders): Fix docstring.
@@ -17845,9 +25187,6 @@
* org-clock.el (org-clock-display, org-clock-out)
(org-update-mode-line): Use `org-time-clocksum-format'.
- * org-colview-xemacs.el (org-columns-number-to-string):
- Use `org-time-clocksum-format'.
-
* org-colview.el (org-columns-number-to-string):
Use `org-time-clocksum-format'.
@@ -17957,7 +25296,7 @@
(org-structure-template-alist): New, experimental option.
(org-complete): Call `org-complete-expand-structure-template'.
-2008-06-17 Bastien Guerry <bzg@altern.org>
+2008-06-17 Bastien Guerry <bzg@gnu.org>
* org-export-latex.el (org-export-latex-preprocess):
Add support for blockquotes.
@@ -18054,7 +25393,7 @@
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el
index 4f8106cd66f..ba50722e325 100644
--- a/lisp/org/ob-C.el
+++ b/lisp/org/ob-C.el
@@ -1,11 +1,10 @@
;;; ob-C.el --- org-babel functions for C and similar languages
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -62,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)))
@@ -89,7 +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-"))
+ (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))
@@ -117,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
@@ -130,28 +129,28 @@ 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."
(if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body)
body
- (format "int main() {\n%s\n}\n" body)))
+ (format "int main() {\n%s\nreturn(0);\n}\n" body)))
(defun org-babel-prep-session:C (session params)
"This function does nothing as C is a compiled language with no
@@ -180,7 +179,7 @@ of the same value."
(format "int %S = %S;" var val))
((floatp val)
(format "double %S = %S;" var val))
- ((or (characterp val))
+ ((or (integerp val))
(format "char %S = '%S';" var val))
((stringp val)
(format "char %S[%d] = \"%s\";"
diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el
index 2b0e6d5e16a..3dedb393654 100644
--- a/lisp/org/ob-R.el
+++ b/lisp/org/ob-R.el
@@ -1,12 +1,11 @@
;;; ob-R.el --- org-babel functions for R code evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Dan Davison
;; Keywords: literate programming, reproducible research, R, statistics
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -40,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."
@@ -80,7 +103,8 @@
"Execute a block of R code.
This function is called by `org-babel-execute-src-block'."
(save-excursion
- (let* ((result-type (cdr (assoc :result-type params)))
+ (let* ((result-params (cdr (assoc :result-params params)))
+ (result-type (cdr (assoc :result-type params)))
(session (org-babel-R-initiate-session
(cdr (assoc :session params)) params))
(colnames-p (cdr (assoc :colnames params)))
@@ -89,7 +113,7 @@ This function is called by `org-babel-execute-src-block'."
(full-body (org-babel-expand-body:R body params graphics-file))
(result
(org-babel-R-evaluate
- session full-body result-type
+ session full-body result-type result-params
(or (equal "yes" colnames-p)
(org-babel-pick-name
(cdr (assoc :colname-names params)) colnames-p))
@@ -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
@@ -197,6 +240,7 @@ current code buffer."
'((:bmp . "bmp")
(:jpg . "jpeg")
(:jpeg . "jpeg")
+ (:tex . "tikz")
(:tiff . "tiff")
(:png . "png")
(:svg . "svg")
@@ -214,11 +258,11 @@ current code buffer."
(setq device (or (and device (cdr (assq (intern (concat ":" device))
devices))) "png"))
(setq filearg
- (if (member device '("pdf" "postscript" "svg")) "file" "filename"))
+ (if (member device '("pdf" "postscript" "svg" "tikz")) "file" "filename"))
(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 ""))
@@ -232,19 +276,19 @@ current code buffer."
(defvar org-babel-R-write-object-command "{function(object,transfer.file){object;invisible(if(inherits(try({tfile<-tempfile();write.table(object,file=tfile,sep=\"\\t\",na=\"nil\",row.names=%s,col.names=%s,quote=FALSE);file.rename(tfile,transfer.file)},silent=TRUE),\"try-error\")){if(!file.exists(transfer.file))file.create(transfer.file)})}}(object=%s,transfer.file=\"%s\")")
(defun org-babel-R-evaluate
- (session body result-type column-names-p row-names-p)
+ (session body result-type result-params column-names-p row-names-p)
"Evaluate R code in BODY."
(if session
(org-babel-R-evaluate-session
- session body result-type column-names-p row-names-p)
+ session body result-type result-params column-names-p row-names-p)
(org-babel-R-evaluate-external-process
- body result-type column-names-p row-names-p)))
+ body result-type result-params column-names-p row-names-p)))
(defun org-babel-R-evaluate-external-process
- (body result-type column-names-p row-names-p)
+ (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
@@ -258,21 +302,28 @@ last statement in BODY, as elisp."
(format "{function ()\n{\n%s\n}}()" body)
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-R-process-value-result
- (org-babel-import-elisp-from-file tmp-file '(16)) column-names-p)))
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params))
+ (with-temp-buffer
+ (insert-file-contents tmp-file)
+ (buffer-string))
+ (org-babel-import-elisp-from-file tmp-file '(16)))
+ column-names-p)))
(output (org-babel-eval org-babel-R-command body))))
(defun org-babel-R-evaluate-session
- (session body result-type column-names-p row-names-p)
+ (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
(with-temp-buffer
(insert (org-babel-chomp body))
(let ((ess-local-process-name
- (process-name (get-buffer-process session))))
+ (process-name (get-buffer-process session)))
+ (ess-eval-visibly-p nil))
(ess-eval-buffer nil)))
(let ((tmp-file (org-babel-temp-file "R-")))
(org-babel-comint-eval-invisibly-and-wait-for-file
@@ -284,7 +335,13 @@ last statement in BODY, as elisp."
"FALSE")
".Last.value" (org-babel-process-file-name tmp-file 'noquote)))
(org-babel-R-process-value-result
- (org-babel-import-elisp-from-file tmp-file '(16)) column-names-p)))
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params))
+ (with-temp-buffer
+ (insert-file-contents tmp-file)
+ (buffer-string))
+ (org-babel-import-elisp-from-file tmp-file '(16)))
+ column-names-p)))
(output
(mapconcat
#'org-babel-chomp
@@ -295,7 +352,7 @@ last statement in BODY, as elisp."
(mapcar
(lambda (line) ;; cleanup extra prompts left in output
(if (string-match
- "^\\([ ]*[>+][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
+ "^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
(substring line (match-end 1))
line))
(org-babel-comint-with-output (session org-babel-R-eoe-output)
diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el
index 6bae3581cf4..a3c5e3db954 100644
--- a/lisp/org/ob-asymptote.el
+++ b/lisp/org/ob-asymptote.el
@@ -1,11 +1,10 @@
;;; ob-asymptote.el --- org-babel functions for asymptote evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -89,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))))
@@ -98,9 +97,8 @@ Asymptote does not support sessions"
The elisp value PAIR is converted into Asymptote code specifying
a variable of the same value."
(let ((var (car pair))
- (val (if (symbolp (cdr pair))
- (symbol-name (cdr pair))
- (cdr pair))))
+ (val (let ((v (cdr pair)))
+ (if (symbolp v) (symbol-name v) v))))
(cond
((integerp val)
(format "int %S=%S;" var val))
@@ -108,55 +106,42 @@ a variable of the same value."
(format "real %S=%S;" var val))
((stringp val)
(format "string %S=\"%s\";" var val))
+ ((and (listp val) (not (listp (car val))))
+ (let* ((type (org-babel-asymptote-define-type val))
+ (fmt (if (eq 'string type) "\"%s\"" "%s"))
+ (vect (mapconcat (lambda (e) (format fmt e)) val ", ")))
+ (format "%s[] %S={%s};" type var vect)))
((listp val)
- (let* ((dimension-2-p (not (null (cdr val))))
- (dim (if dimension-2-p "[][]" "[]"))
- (type (org-babel-asymptote-define-type val))
- (array (org-babel-asymptote-table-to-array
- val
- (if dimension-2-p '(:lstart "{" :lend "}," :llend "}")))))
- (format "%S%s %S=%s;" type dim var array))))))
-
-(defun org-babel-asymptote-table-to-array (table params)
- "Convert values of an elisp table into a string of an asymptote array.
-Empty cells are ignored."
- (labels ((atom-to-string (table)
- (cond
- ((null table) '())
- ((not (listp (car table)))
- (cons (if (and (stringp (car table))
- (not (string= (car table) "")))
- (format "\"%s\"" (car table))
- (format "%s" (car table)))
- (atom-to-string (cdr table))))
- (t
- (cons (atom-to-string (car table))
- (atom-to-string (cdr table))))))
- ;; Remove any empty row
- (fix-empty-lines (table)
- (delq nil (mapcar (lambda (l) (delq "" l)) table))))
- (orgtbl-to-generic
- (fix-empty-lines (atom-to-string table))
- (org-combine-plists '(:hline nil :sep "," :tstart "{" :tend "}") params))))
+ (let* ((type (org-babel-asymptote-define-type val))
+ (fmt (if (eq 'string type) "\"%s\"" "%s"))
+ (array (mapconcat (lambda (row)
+ (concat "{"
+ (mapconcat (lambda (e) (format fmt e))
+ row ", ")
+ "}"))
+ val ",")))
+ (format "%S[][] %S={%s};" type var array))))))
(defun org-babel-asymptote-define-type (data)
"Determine type of DATA.
-DATA is a list. Type symbol is returned as 'symbol. The type is
-usually the type of the first atom encountered, except for arrays
-of int, where every cell must be of int type."
- (labels ((anything-but-int (el)
- (cond
- ((null el) nil)
- ((not (listp (car el)))
- (cond
- ((floatp (car el)) 'real)
- ((stringp (car el)) 'string)
- (t
- (anything-but-int (cdr el)))))
- (t
- (or (anything-but-int (car el))
- (anything-but-int (cdr el)))))))
- (or (anything-but-int data) 'int)))
+
+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
+floats, or `int'."
+ (let* ((type 'int)
+ find-type ; for byte-compiler
+ (find-type
+ (function
+ (lambda (row)
+ (catch 'exit
+ (mapc (lambda (el)
+ (cond ((listp el) (funcall find-type el))
+ ((stringp el) (throw 'exit (setq type 'string)))
+ ((floatp el) (setq type 'real))))
+ row))))))
+ (funcall find-type data) type))
(provide 'ob-asymptote)
diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el
index 66e07bf175c..6e139966eee 100644
--- a/lisp/org/ob-awk.el
+++ b/lisp/org/ob-awk.el
@@ -1,11 +1,10 @@
;;; ob-awk.el --- org-babel functions for awk evaluation
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -25,15 +24,16 @@
;;; Commentary:
;; Babel's awk can use special header argument:
-;;
+;;
;; - :in-file takes a path to a file of data to be processed by awk
-;;
+;;
;; - :stdin takes an Org-mode data or code block reference, the value
;; of which will be passed to the awk process through STDIN
;;; Code:
(require 'ob)
(require 'ob-eval)
+(require 'org-compat)
(eval-when-compile (require 'cl))
(declare-function org-babel-ref-resolve "ob-ref" (ref))
@@ -49,7 +49,7 @@
"Expand BODY according to PARAMS, return the expanded body."
(dolist (pair (mapcar #'cdr (org-babel-get-header params :var)))
(setf body (replace-regexp-in-string
- (regexp-quote (concat "$" (car pair))) (cdr pair) body)))
+ (regexp-quote (format "$%s" (car pair))) (cdr pair) body)))
body)
(defun org-babel-execute:awk (body params)
@@ -97,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 68694786729..c79d0b5d1b4 100644
--- a/lisp/org/ob-calc.el
+++ b/lisp/org/ob-calc.el
@@ -1,11 +1,10 @@
;;; ob-calc.el --- org-babel functions for calc code evaluation
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -29,10 +28,15 @@
;;; Code:
(require 'ob)
(require 'calc)
-(require 'calc-store)
-(unless (featurep 'xemacs) (require 'calc-trail))
+(unless (featurep 'xemacs)
+ (require 'calc-trail)
+ (require 'calc-store))
(eval-when-compile (require 'ob-comint))
+(declare-function calc-store-into "calc-store" (&optional var))
+(declare-function calc-recall "calc-store" (&optional var))
+(declare-function math-evaluate-expr "calc-ext" (x))
+
(defvar org-babel-default-header-args:calc nil
"Default arguments for evaluating an calc source block.")
@@ -67,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))))))))
@@ -87,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 090b60662f8..f3894047c72 100644
--- a/lisp/org/ob-clojure.el
+++ b/lisp/org/ob-clojure.el
@@ -1,12 +1,11 @@
;;; ob-clojure.el --- org-babel functions for clojure evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Joel Boehland
;; Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -32,7 +31,6 @@
;;; - clojure (at least 1.2.0)
;;; - clojure-mode
;;; - slime
-;;; - swank-clojure
;;; By far, the best way to install these components is by following
;;; the directions as set out by Phil Hagelberg (Technomancy) on the
@@ -47,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."
@@ -76,7 +74,7 @@
(defun org-babel-execute:clojure (body params)
"Execute a block of Clojure code with Babel."
- (require 'slime) (require 'swank-clojure)
+ (require 'slime)
(with-temp-buffer
(insert (org-babel-expand-body:clojure body params))
((lambda (result)
@@ -87,7 +85,7 @@
(condition-case nil (org-babel-script-escape result)
(error result)))))
(slime-eval
- `(swank:interactive-eval-region
+ `(swank:eval-and-grab-output
,(buffer-substring-no-properties (point-min) (point-max)))
(cdr (assoc :package params))))))
diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el
index efdac4d3818..ba3b99d5d70 100644
--- a/lisp/org/ob-comint.el
+++ b/lisp/org/ob-comint.el
@@ -1,11 +1,10 @@
;;; ob-comint.el --- org-babel functions for interaction with comint buffers
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -32,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))
@@ -51,9 +51,10 @@ 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))
(defmacro org-babel-comint-with-output (meta &rest body)
"Evaluate BODY in BUFFER and return process output.
@@ -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
@@ -115,6 +117,7 @@ or user `keyboard-quit' during execution of body."
string-buffer))
(setq raw (substring string-buffer (match-end 0))))
(split-string string-buffer comint-prompt-regexp)))))
+(def-edebug-spec org-babel-comint-with-output (form body))
(defun org-babel-comint-input-command (buffer cmd)
"Pass CMD to BUFFER.
@@ -141,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)
@@ -153,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 7bc97f82909..6259ebc0c2f 100644
--- a/lisp/org/ob-css.el
+++ b/lisp/org/ob-css.el
@@ -1,11 +1,10 @@
;;; ob-css.el --- org-babel functions for css evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -35,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 db638f6ef98..7c545c47437 100644
--- a/lisp/org/ob-ditaa.el
+++ b/lisp/org/ob-ditaa.el
@@ -1,11 +1,10 @@
;;; ob-ditaa.el --- org-babel functions for ditaa evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -35,15 +34,29 @@
;; 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)
+(require 'org-compat)
+
+(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'."
@@ -56,7 +69,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 cc78ac5bf95..99748b0a95b 100644
--- a/lisp/org/ob-dot.el
+++ b/lisp/org/ob-dot.el
@@ -1,11 +1,10 @@
;;; ob-dot.el --- org-babel functions for dot evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -65,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 2eccf19b6d1..d83ca246a84 100644
--- a/lisp/org/ob-emacs-lisp.el
+++ b/lisp/org/ob-emacs-lisp.el
@@ -1,11 +1,10 @@
;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -43,12 +42,12 @@
(print-level nil) (print-length nil)
(body (if (> (length vars) 0)
(concat "(let ("
- (mapconcat
- (lambda (var)
- (format "%S" (print `(,(car var) ',(cdr var)))))
- vars "\n ")
- ")\n" body ")")
- body)))
+ (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))
(concat "(pp " body ")") body)))
diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el
index e74be0b6e02..ddad067a560 100644
--- a/lisp/org/ob-eval.el
+++ b/lisp/org/ob-eval.el
@@ -1,11 +1,10 @@
;;; ob-eval.el --- org-babel functions for external code evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -65,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 0fceb184c5e..d17fd3475ae 100644
--- a/lisp/org/ob-exp.el
+++ b/lisp/org/ob-exp.el
@@ -1,12 +1,11 @@
;;; ob-exp.el --- Exportation of org-babel source blocks
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
-;; Author: Eric Schulte
+;; Authors: Eric Schulte
;; Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -33,12 +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-inline-src-blocks))
-(add-to-list 'org-export-interblocks '(lob org-babel-exp-lob-one-liners))
-(add-hook 'org-export-blocks-postblock-hook 'org-exp-res/src-name-cleanup)
+(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
@@ -46,34 +51,41 @@
When set to nil no code will be evaluated as part of the export
process."
:group 'org-babel
+ :version "24.1"
: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)))
+(def-edebug-spec org-babel-exp-in-export-file (form body))
(defun org-babel-exp-src-block (body &rest headers)
"Process source block for export.
@@ -105,137 +117,168 @@ none ----- do not display either code or results upon export"
(org-babel-process-params
(org-babel-merge-params
org-babel-default-header-args
- (org-babel-params-from-buffer)
(org-babel-params-from-properties lang)
(if (boundp lang-headers) (eval lang-headers) nil)
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)))))
-(defun org-babel-exp-inline-src-blocks (start end)
- "Process inline source blocks between START and END for export.
-See `org-babel-exp-src-block' for export options, currently the
-options and are taken from `org-babel-default-inline-header-args'."
+(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."
(interactive)
(save-excursion
(goto-char start)
- (while (and (< (point) end)
- (re-search-forward org-babel-inline-src-block-regexp end t))
- (let* ((info (save-match-data (org-babel-parse-inline-src-block-match)))
- (params (nth 2 info)) code-replacement)
- (save-match-data
- (goto-char (match-beginning 2))
- (when (not (org-babel-in-example-or-verbatim))
- ;; expand noweb references in the original file
- (setf (nth 1 info)
- (if (and (cdr (assoc :noweb params))
- (string= "yes" (cdr (assoc :noweb params))))
- (org-babel-expand-noweb-references
- info (get-file-buffer org-current-export-file))
- (nth 1 info)))
- (setq code-replacement (org-babel-exp-do-export info 'inline))))
- (if code-replacement
- (replace-match code-replacement nil nil nil 1)
- (org-babel-examplize-region (match-beginning 1) (match-end 1))
- (forward-char 2))))))
-
-(defun org-exp-res/src-name-cleanup ()
- "Clean up #+results and #+srcname lines for export.
-This function should only be called after all block processing
-has taken place."
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (while (org-re-search-forward-unprotected
- (concat
- "\\("org-babel-src-name-regexp"\\|"org-babel-result-regexp"\\)")
- nil t)
- (delete-region
- (progn (beginning-of-line) (point))
- (progn (end-of-line) (+ 1 (point)))))))
+ (unless (markerp end)
+ (let ((m (make-marker)))
+ (set-marker m end (current-buffer))
+ (setq end m)))
+ (let ((rx (concat "\\(" org-babel-inline-src-block-regexp
+ "\\|" org-babel-lob-one-liner-regexp "\\)")))
+ (while (and (< (point) (marker-position end))
+ (re-search-forward rx end t))
+ (if (save-excursion
+ (goto-char (match-beginning 0))
+ (looking-at org-babel-inline-src-block-regexp))
+ (progn
+ (forward-char 1)
+ (let* ((info (save-match-data
+ (org-babel-parse-inline-src-block-match)))
+ (params (nth 2 info)))
+ (save-match-data
+ (goto-char (match-beginning 2))
+ (unless (org-babel-in-example-or-verbatim)
+ ;; expand noweb references in the original file
+ (setf (nth 1 info)
+ (if (and (cdr (assoc :noweb params))
+ (string= "yes" (cdr (assoc :noweb params))))
+ (org-babel-expand-noweb-references
+ info (org-babel-exp-get-export-buffer))
+ (nth 1 info)))
+ (let ((code-replacement (save-match-data
+ (org-babel-exp-do-export
+ info 'inline))))
+ (if code-replacement
+ (progn (replace-match code-replacement nil nil nil 1)
+ (delete-char 1))
+ (org-babel-examplize-region (match-beginning 1)
+ (match-end 1))
+ (forward-char 2)))))))
+ (unless (org-babel-in-example-or-verbatim)
+ (let* ((lob-info (org-babel-lob-get-info))
+ (inlinep (match-string 11))
+ (inline-start (match-end 11))
+ (inline-end (match-end 0))
+ (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)
+ (delete-region inline-start inline-end)
+ (insert rep))
+ (replace-match rep t t)))))))))
(defun org-babel-in-example-or-verbatim ()
"Return true if point is in example or verbatim code.
Example and verbatim code include escaped portions of
an org-mode buffer code that should be treated as normal
org-mode text."
- (or (org-in-indented-comment-line)
- (save-match-data
+ (or (save-match-data
(save-excursion
(goto-char (point-at-bol))
(looking-at "[ \t]*:[ \t]")))
(org-in-verbatim-emphasis)
- (org-in-regexps-block-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src")))
-
-(defvar org-babel-default-lob-header-args)
-(defun org-babel-exp-lob-one-liners (start end)
- "Process Library of Babel calls between START and END for export.
-See `org-babel-exp-src-block' for export options. Currently the
-options are taken from `org-babel-default-header-args'."
- (interactive)
- (save-excursion
- (goto-char start)
- (while (and (< (point) end)
- (re-search-forward org-babel-lob-one-liner-regexp nil t))
- (unless (and (match-string 12) (org-babel-in-example-or-verbatim))
- (let* ((lob-info (org-babel-lob-get-info))
- (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-buffer)
- (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)))))
- (setq end (+ end (- (length rep)
- (- (length (match-string 0))
- (length (or (match-string 11) ""))))))
- (if inlinep
- (save-excursion
- (goto-char inline-start)
- (delete-region inline-start inline-end)
- (insert rep))
- (replace-match rep t t)))))))
+ (org-in-block-p org-list-forbidden-blocks)
+ (org-between-regexps-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src")))
(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\n"
+ org-babel-exp-code-template
`(("lang" . ,(nth 0 info))
+ ("body" . ,(if (string= (nth 0 info) "org")
+ (replace-regexp-in-string "^" "," (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)))
- ("body" . ,(nth 1 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.
@@ -246,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
@@ -258,7 +306,15 @@ inhibit insertion of results into the buffer."
(nth 2 info)
`((:results . ,(if silent "silent" "replace")))))))
(cond
- ((or (equal type 'block) (equal type 'inline))
+ ((equal type 'block)
+ (org-babel-execute-src-block nil info))
+ ((equal type 'inline)
+ ;; position the point on the inline source block allowing
+ ;; `org-babel-insert-result' to check that the block is
+ ;; inline
+ (re-search-backward "[ \f\t\n\r\v]" nil t)
+ (re-search-forward org-babel-inline-src-block-regexp nil t)
+ (re-search-backward "src_" nil t)
(org-babel-execute-src-block nil info))
((equal type 'lob)
(save-excursion
diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el
new file mode 100644
index 00000000000..7f2d1a8054b
--- /dev/null
+++ b/lisp/org/ob-fortran.el
@@ -0,0 +1,162 @@
+;;; ob-fortran.el --- org-babel functions for fortran
+
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+;; Authors: Sergey Litvinov
+;; Eric Schulte
+;; Keywords: literate programming, reproducible research, fortran
+;; 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:
+
+;; Org-Babel support for evaluating fortran code.
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+(require 'cc-mode)
+
+(declare-function org-entry-get "org"
+ (pom property &optional inherit literal-nil))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90"))
+
+(defvar org-babel-default-header-args:fortran '())
+
+(defvar org-babel-fortran-compiler "gfortran"
+ "fortran command used to compile a fortran source code file into an
+ executable.")
+
+(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-" org-babel-exeext))
+ (cmdline (cdr (assoc :cmdline params)))
+ (flags (cdr (assoc :flags params)))
+ (full-body (org-babel-expand-body:fortran body params))
+ (compile
+ (progn
+ (with-temp-file tmp-src-file (insert full-body))
+ (org-babel-eval
+ (format "%s -o %s %s %s"
+ org-babel-fortran-compiler
+ (org-babel-process-file-name tmp-bin-file)
+ (mapconcat 'identity
+ (if (listp flags) flags (list flags)) " ")
+ (org-babel-process-file-name tmp-src-file)) ""))))
+ ((lambda (results)
+ (org-babel-reassemble-table
+ (if (member "vector" (cdr (assoc :result-params params)))
+ (let ((tmp-file (org-babel-temp-file "f-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file))
+ (org-babel-read results))
+ (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)))))
+ (org-babel-trim
+ (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
+it's header arguments."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (main-p (not (string= (cdr (assoc :main params)) "no")))
+ (includes (or (cdr (assoc :includes params))
+ (org-babel-read (org-entry-get nil "includes" t))))
+ (defines (org-babel-read
+ (or (cdr (assoc :defines params))
+ (org-babel-read (org-entry-get nil "defines" t))))))
+ (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)
+ (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"))
+
+(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"))
+
+;; helper functions
+
+(defun org-babel-fortran-var-to-fortran (pair)
+ "Convert an elisp val into a string of fortran code specifying a var
+of the same value."
+ ;; TODO list support
+ (let ((var (car pair))
+ (val (cdr pair)))
+ (when (symbolp val)
+ (setq val (symbol-name val))
+ (when (= (length val) 1)
+ (setq val (string-to-char val))))
+ (cond
+ ((integerp val)
+ (format "integer, parameter :: %S = %S\n" var val))
+ ((floatp val)
+ (format "real, parameter :: %S = %S\n" var val))
+ ((or (integerp val))
+ (format "character, parameter :: %S = '%S'\n" var val))
+ ((stringp val)
+ (format "character(len=%d), parameter :: %S = '%s'\n"
+ (length val) var val))
+ ((listp val)
+ (format "real, parameter :: %S(%d) = %s\n"
+ 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 org-babel-fortran-transform-list (val)
+ "Return a fortran representation of enclose syntactic lists."
+ (if (listp val)
+ (concat "(/" (mapconcat #'org-babel-fortran-transform-list val ", ") "/)")
+ (format "%S" val)))
+
+(provide 'ob-fortran)
+
+;;; ob-fortran.el ends here
diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el
index 9bf0433f9fc..55c415320d6 100644
--- a/lisp/org/ob-gnuplot.el
+++ b/lisp/org/ob-gnuplot.el
@@ -1,11 +1,10 @@
;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -35,7 +34,7 @@
;;; Requirements:
;; - gnuplot :: http://www.gnuplot.info/
-;;
+;;
;; - gnuplot-mode :: http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html
;;; Code:
@@ -88,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.
@@ -149,7 +147,10 @@ This function is called by `org-babel-execute-src-block'."
(shell-command-to-string
(format
"gnuplot \"%s\""
- (org-babel-process-file-name script-file))))
+ (org-babel-process-file-name
+ script-file
+ (if (member system-type '(cygwin windows-nt ms-dos))
+ t nil)))))
(message output))
(with-temp-buffer
(insert (concat body "\n"))
@@ -181,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 236dbba28f1..03972efeec1 100644
--- a/lisp/org/ob-haskell.el
+++ b/lisp/org/ob-haskell.el
@@ -1,11 +1,10 @@
;;; ob-haskell.el --- org-babel functions for haskell evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -29,7 +28,7 @@
;; they can be run, but haskell code can also be run through an
;; interactive interpreter.
;;
-;; For now let's only allow evaluation using the haskell interpreter.
+;; For now lets only allow evaluation using the haskell interpreter.
;;; Requirements:
@@ -126,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.
@@ -148,6 +147,8 @@ specifying a variable of the same value."
(format "%S" var)))
(defvar org-src-preserve-indentation)
+(declare-function org-export-as-latex "org-latex"
+ (arg &optional ext-plist to-buffer body-only pub-dir))
(defun org-babel-haskell-export-to-lhs (&optional arg)
"Export to a .lhs file with all haskell code blocks escaped.
When called with a prefix argument the resulting
diff --git a/lisp/org/ob-io.el b/lisp/org/ob-io.el
new file mode 100644
index 00000000000..881f35afbda
--- /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))
+
+(defvar org-babel-tangle-lang-exts) ;; Autoloaded
+(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-java.el b/lisp/org/ob-java.el
index 20824d4cb30..75afda124d6 100644
--- a/lisp/org/ob-java.el
+++ b/lisp/org/ob-java.el
@@ -1,11 +1,10 @@
;;; ob-java.el --- org-babel functions for java evaluation
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -46,11 +45,14 @@
"Can't compile a java block without a classname")))
(packagename (file-name-directory classname))
(src-file (concat classname ".java"))
+ (cmpflag (or (cdr (assoc :cmpflag params)) ""))
+ (cmdline (or (cdr (assoc :cmdline params)) ""))
(full-body (org-babel-expand-body:generic body params))
(compile
(progn (with-temp-file src-file (insert full-body))
(org-babel-eval
- (concat org-babel-java-compiler " " src-file) ""))))
+ (concat org-babel-java-compiler
+ " " cmpflag " " src-file) ""))))
;; created package-name directories if missing
(unless (or (not packagename) (file-exists-p packagename))
(make-directory packagename 'parents))
@@ -65,7 +67,8 @@
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
- (org-babel-eval (concat org-babel-java-command " " classname) ""))))
+ (org-babel-eval (concat org-babel-java-command
+ " " cmdline " " classname) ""))))
(provide 'ob-java)
diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el
index 9e6751c9525..21381725cb1 100644
--- a/lisp/org/ob-js.el
+++ b/lisp/org/ob-js.el
@@ -1,11 +1,10 @@
;;; ob-js.el --- org-babel functions for Javascript
-;; Copyright (C) 2010-2011 Free Software Foundation
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, js
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -56,6 +55,7 @@
(defcustom org-babel-js-cmd "node"
"Name of command used to evaluate js blocks."
:group 'org-babel
+ :version "24.1"
:type 'string)
(defvar org-babel-js-function-wrapper
@@ -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-keys.el b/lisp/org/ob-keys.el
index b56ba5cf01a..3e3f496ff35 100644
--- a/lisp/org/ob-keys.el
+++ b/lisp/org/ob-keys.el
@@ -1,11 +1,10 @@
;;; ob-keys.el --- key bindings for org-babel
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -75,6 +74,8 @@ functions which are assigned key bindings, and see
("f" . org-babel-tangle-file)
("\C-c" . org-babel-check-src-block)
("c" . org-babel-check-src-block)
+ ("\C-j" . org-babel-insert-header-arg)
+ ("j" . org-babel-insert-header-arg)
("\C-l" . org-babel-load-in-session)
("l" . org-babel-load-in-session)
("\C-i" . org-babel-lob-ingest)
@@ -97,6 +98,8 @@ a-list placed behind the generic `org-babel-key-prefix'.")
(provide 'ob-keys)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; ob-keys.el ends here
diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el
index c27ca33080a..43f673edf59 100644
--- a/lisp/org/ob-latex.el
+++ b/lisp/org/ob-latex.el
@@ -1,11 +1,10 @@
;;; ob-latex.el --- org-babel functions for latex "evaluation"
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -73,6 +72,10 @@ This function is called by `org-babel-execute-src-block'."
(let* ((out-file (cdr (assoc :file params)))
(tex-file (org-babel-temp-file "latex-" ".tex"))
(border (cdr (assoc :border params)))
+ (imagemagick (cdr (assoc :imagemagick params)))
+ (im-in-options (cdr (assoc :iminoptions params)))
+ (im-out-options (cdr (assoc :imoutoptions params)))
+ (pdfpng (cdr (assoc :pdfpng params)))
(fit (or (cdr (assoc :fit params)) border))
(height (and fit (cdr (assoc :pdfheight params))))
(width (and fit (cdr (assoc :pdfwidth params))))
@@ -82,10 +85,10 @@ This function is called by `org-babel-execute-src-block'."
(append (cdr (assoc :packages params))
org-export-latex-packages-alist)))
(cond
- ((string-match "\\.png$" out-file)
+ ((and (string-match "\\.png$" out-file) (not imagemagick))
(org-create-formula-image
body out-file org-format-latex-options in-buffer))
- ((string-match "\\.pdf$" out-file)
+ ((or (string-match "\\.pdf$" out-file) imagemagick)
(require 'org-latex)
(with-temp-file tex-file
(insert
@@ -119,13 +122,29 @@ This function is called by `org-babel-execute-src-block'."
(concat "\n\\begin{document}\n" body "\n\\end{document}\n")))
(org-export-latex-fix-inputenc))
(when (file-exists-p out-file) (delete-file out-file))
- (rename-file (org-babel-latex-tex-to-pdf tex-file) out-file))
+ (let ((transient-pdf-file (org-babel-latex-tex-to-pdf tex-file)))
+ (cond
+ ((string-match "\\.pdf$" out-file)
+ (rename-file transient-pdf-file out-file))
+ (imagemagick
+ (convert-pdf
+ transient-pdf-file out-file im-in-options im-out-options)
+ (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"
+ (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))
+
+(defun convert-pdf (pdffile out-file im-in-options im-out-options)
+ "Generate a file from a pdf file using imagemagick."
+ (let ((cmd (concat "convert " im-in-options " " pdffile " "
+ im-out-options " " out-file)))
+ (message (concat "Converting pdffile file " cmd "..."))
+ (shell-command cmd)))
+
(defun org-babel-latex-tex-to-pdf (file)
"Generate a pdf file according to the contents FILE.
Extracted from `org-export-as-pdf' in org-latex.el."
@@ -171,7 +190,7 @@ Extracted from `org-export-as-pdf' in org-latex.el."
pdffile)))
(defun org-babel-prep-session:latex (session params)
- "Return an error because LaTeX doesn't support sesstions."
+ "Return an error because LaTeX doesn't support sessions."
(error "LaTeX does not support sessions"))
(provide 'ob-latex)
diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el
index 4fe61451982..2635730a93a 100644
--- a/lisp/org/ob-ledger.el
+++ b/lisp/org/ob-ledger.el
@@ -1,11 +1,10 @@
;;; ob-ledger.el --- org-babel functions for ledger evaluation
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Keywords: literate programming, reproducible research, accounting
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -53,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 23fc8f04c34..e19b0c34c6a 100644
--- a/lisp/org/ob-lilypond.el
+++ b/lisp/org/ob-lilypond.el
@@ -1,11 +1,10 @@
;;; ob-lilypond.el --- org-babel functions for lilypond evaluation
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Martyn Jago
;; Keywords: babel language, literate programming
-;; Homepage: https://github.com/mjago/ob-lilypond
-;; Version: 7.7
+;; Homepage: http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html
;; This file is part of GNU Emacs.
@@ -24,24 +23,26 @@
;;; 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)
+(require 'outline)
(defalias 'lilypond-mode 'LilyPond-mode)
-(declare-function show-all "outline" ())
-
(add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly"))
(defvar org-babel-default-header-args:lilypond '()
- "Default header arguments for js code blocks.")
-
-(defconst ly-version "0.3"
- "The version number of the file ob-lilypond.el.")
+ "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,
@@ -53,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,29 +72,33 @@ the midi file is not automatically played. Default value is t")
(defvar ly-nix-pdf-path "evince")
(defvar ly-nix-midi-path "timidity")
-(defvar ly-win32-ly-path "lilypond")
-(defvar ly-win32-pdf-path "")
-(defvar ly-win32-midi-path "")
+(defvar ly-w32-ly-path "lilypond")
+(defvar ly-w32-pdf-path "")
+(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.
@@ -102,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)
@@ -115,14 +119,13 @@ blocks")
body))))
vars)
body))
-
+
(defun org-babel-execute:lilypond (body params)
"This function is called by `org-babel-execute-src-block'.
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)
@@ -130,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))
@@ -148,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)
@@ -160,25 +160,22 @@ 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"))
(ly-temp-file (ly-switch-extension
(buffer-file-name) ".ly")))
(if (file-exists-p ly-tangled-file)
- (progn
+ (progn
(when (file-exists-p ly-temp-file)
(delete-file ly-temp-file))
(rename-file ly-tangled-file
@@ -198,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.
@@ -234,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)
@@ -244,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"))))
@@ -257,10 +253,9 @@ LINE is the erroneous line"
(set-mark (point))
(goto-char (- (point) (length line))))
(goto-char temp))))
-
+
(defun ly-parse-line-num (&optional buffer)
"Extract error line number."
-
(when buffer
(set-buffer buffer))
(let ((start
@@ -285,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,12 +289,11 @@ LINENO is the number of the erroneous line"
(forward-line (- lineNo 1))
(buffer-substring (point) (point-at-eol)))
nil)))
-
+
(defun ly-attempt-to-open-pdf (file-name &optional test)
"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)
@@ -308,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)
@@ -323,48 +319,48 @@ 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")
ly-OSX-ly-path)
- ((string= sys-type "win32")
- ly-win32-ly-path)
+ ((string= sys-type "windows-nt")
+ ly-w32-ly-path)
(t ly-nix-ly-path))))
(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")
ly-OSX-pdf-path)
- ((string= sys-type "win32")
- ly-win32-pdf-path)
+ ((string= sys-type "windows-nt")
+ ly-w32-pdf-path)
(t ly-nix-pdf-path))))
(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")
ly-OSX-midi-path)
- ((string= sys-type "win32")
- ly-win32-midi-path)
+ ((string= sys-type "windows-nt")
+ ly-w32-midi-path)
(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))
@@ -373,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))
@@ -383,52 +378,48 @@ 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))
(message (concat "Arrange mode has been "
(if ly-arrange-mode "ENABLED." "DISABLED."))))
-(defun ly-version (&optional insert-at-point)
- (interactive)
- (let ((version (format "ob-lilypond version %s" ly-version)))
- (when insert-at-point (insert version))
- (message version)))
-
- (defun ly-switch-extension (file-name ext)
+(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")
@@ -442,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 4ff9c4076ec..71e80bdf9ea 100644
--- a/lisp/org/ob-lisp.el
+++ b/lisp/org/ob-lisp.el
@@ -1,13 +1,12 @@
;;; ob-lisp.el --- org-babel functions for common lisp evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
-;; Author: Joel Boehland
-;; Eric Schulte
-;; David T. O'Toole <dto@gnu.org>
+;; Authors: Joel Boehland
+;; Eric Schulte
+;; David T. O'Toole <dto@gnu.org>
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -42,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)"
@@ -50,6 +49,7 @@
For example a value of \"(progn ;; %s\\n %%s)\" would ignore the
current directory string."
:group 'org-babel
+ :version "24.1"
:type 'string)
(defun org-babel-expand-body:lisp (body params)
@@ -79,14 +79,14 @@ current directory string."
(if (member "output" (cdr (assoc :result-params params)))
(car result)
(condition-case nil
- (read (org-bable-lisp-vector-to-list (cadr result)))
+ (read (org-babel-lisp-vector-to-list (cadr result)))
(error (cadr result)))))
(with-temp-buffer
(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
@@ -97,7 +97,7 @@ current directory string."
(org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rownames params)))))
-(defun org-bable-lisp-vector-to-list (results)
+(defun org-babel-lisp-vector-to-list (results)
;; TODO: better would be to replace #(...) with [...]
(replace-regexp-in-string "#(" "(" results))
diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el
index 5cb40a057f3..8b5f14d0252 100644
--- a/lisp/org/ob-lob.el
+++ b/lisp/org/ob-lob.el
@@ -1,12 +1,11 @@
;;; ob-lob.el --- functions supporting the Library of Babel
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
-;; Author: Eric Schulte
-;; Dan Davison
+;; Authors: Eric Schulte
+;; Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -29,6 +28,8 @@
(require 'ob)
(require 'ob-table)
+(declare-function org-babel-in-example-or-verbatim "ob-exp" nil)
+
(defvar org-babel-library-of-babel nil
"Library of source-code blocks.
This is an association list. Populate the library by adding
@@ -38,12 +39,12 @@ files to `org-babel-lob-files'.")
"Files used to populate the `org-babel-library-of-babel'.
To add files to this list use the `org-babel-lob-ingest' command."
:group 'org-babel
+ :version "24.1"
:type 'list)
(defvar org-babel-default-lob-header-args '((:exports . "results"))
"Default header arguments to use when exporting #+lob/call lines.")
-;;;###autoload
(defun org-babel-lob-ingest (&optional file)
"Add all named source-blocks defined in FILE to
`org-babel-library-of-babel'."
@@ -62,25 +63,16 @@ To add files to this list use the `org-babel-lob-ingest' command."
lob-ingest-count (if (> lob-ingest-count 1) "s" ""))
lob-ingest-count))
-(defconst org-babel-lob-call-aliases '("lob" "call")
- "Aliases to call a source block function.
-If you change the value of this variable then your files may
- become unusable by other org-babel users, and vice versa.")
-
(defconst org-babel-block-lob-one-liner-regexp
(concat
- "^\\([ \t]*\\)#\\+\\(?:"
- (mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|")
- "\\):[ \t]+\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)"
- "\(\\([^\n]*\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\(\\([^\n]*\\)\\)?")
+ "^\\([ \t]*?\\)#\\+call:[ \t]+\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)"
+ "\(\\([^\n]*?\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\(\\([^\n]*\\)\\)?")
"Regexp to match non-inline calls to predefined source block functions.")
(defconst org-babel-inline-lob-one-liner-regexp
(concat
- "\\([^\n]*\\)\\(?:"
- (mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|")
- "\\)_\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)"
- "\(\\([^\n]*\\)\)\\(\\[\\(.*?\\)\\]\\)?")
+ "\\([^\n]*?\\)call_\\([^\(\)\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)"
+ "\(\\([^\n]*?\\)\)\\(\\[\\(.*?\\)\\]\\)?")
"Regexp to match inline calls to predefined source block functions.")
(defconst org-babel-lob-one-liner-regexp
@@ -89,6 +81,7 @@ If you change the value of this variable then your files may
"Regexp to match calls to predefined source block functions.")
;; functions for executing lob one-liners
+
;;;###autoload
(defun org-babel-lob-execute-maybe ()
"Execute a Library of Babel source block, if appropriate.
@@ -96,47 +89,61 @@ Detect if this is context for a Library Of Babel source block and
if so then run the appropriate source block from the Library."
(interactive)
(let ((info (org-babel-lob-get-info)))
- (if (nth 0 info) (progn (org-babel-lob-execute info) t) nil)))
+ (if (and (nth 0 info) (not (org-babel-in-example-or-verbatim)))
+ (progn (org-babel-lob-execute info) t)
+ nil)))
;;;###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 13))))
- (concat "[" (nonempty 5 13) "]") "")
- (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-buffer)
- (org-babel-params-from-properties)
- (org-babel-parse-header-arguments
- (org-babel-clean-text-properties
- (concat ":var results="
- (mapconcat #'identity (butlast info) " "))))))))
- (org-babel-execute-src-block
- nil (list "emacs-lisp" "results" params nil nil (nth 2 info)))))
+ (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)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; ob-lob.el ends here
diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el
index bb32c5a29f5..717fc746dc6 100644
--- a/lisp/org/ob-matlab.el
+++ b/lisp/org/ob-matlab.el
@@ -1,11 +1,10 @@
;;; ob-matlab.el --- org-babel support for matlab evaluation
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el
index 279ba6b928b..06fa3cfe884 100644
--- a/lisp/org/ob-maxima.el
+++ b/lisp/org/ob-maxima.el
@@ -1,12 +1,11 @@
;;; ob-maxima.el --- org-babel functions for maxima evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric S Fraga
-;; Eric Schulte
+;; Eric Schulte
;; Keywords: literate programming, reproducible research, maxima
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -31,47 +30,101 @@
;;
;; 1) there is no such thing as a "session" in maxima
;;
-;; 2) we are generally only going to return output from maxima
-;;
-;; 3) we are adding the "cmdline" header argument
-;;
-;; 4) there are no variables
+;; 2) we are adding the "cmdline" header argument
;;; Code:
(require 'ob)
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("maxima" . "max"))
+
(defvar org-babel-default-header-args:maxima '())
+(defcustom org-babel-maxima-command
+ (if (boundp 'maxima-command) maxima-command "maxima")
+ "Command used to call maxima on the shell."
+ :group 'org-babel)
+
(defun org-babel-maxima-expand (body params)
"Expand a block of Maxima code according to its header arguments."
- body)
+ (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")))
(defun org-babel-execute:maxima (body params)
"Execute a block of Maxima entries with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Maxima source code block")
- (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (cmdline (cdr (assoc :cmdline params)))
- (in-file (org-babel-temp-file "maxima-"))
- (cmd (format "maxima --very-quiet -r 'batchload(%S)$' %s"
- in-file cmdline)))
- (with-temp-file in-file (insert body))
- (message cmd)
- ((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
- (mapconcat
- #'identity
- (delq nil
- (mapcar (lambda (line)
- (unless (or (string-match "batch" line)
- (string-match "^rat: replaced .*$" line)
- (= 0 (length line)))
- line))
- (split-string raw "[\r\n]"))) "\n"))
- (org-babel-eval cmd ""))))
+ (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
+ (result
+ (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)))
+ (with-temp-file in-file (insert (org-babel-maxima-expand body params)))
+ (message cmd)
+ ((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
+ (mapconcat
+ #'identity
+ (delq nil
+ (mapcar (lambda (line)
+ (unless (or (string-match "batch" line)
+ (string-match "^rat: replaced .*$" line)
+ (= 0 (length line)))
+ line))
+ (split-string raw "[\r\n]"))) "\n"))
+ (org-babel-eval cmd "")))))
+ (if (org-babel-maxima-graphical-output-file params)
+ nil
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params)
+ (member "output" result-params))
+ result
+ (let ((tmp-file (org-babel-temp-file "maxima-res-")))
+ (with-temp-file tmp-file (insert result))
+ (org-babel-import-elisp-from-file tmp-file))))))
+
(defun org-babel-prep-session:maxima (session params)
(error "Maxima does not support sessions"))
+(defun org-babel-maxima-var-to-maxima (pair)
+ "Convert an elisp val into a string of maxima code specifying a var
+of the same value."
+ (let ((var (car pair))
+ (val (cdr pair)))
+ (when (symbolp val)
+ (setq val (symbol-name val))
+ (when (= (length val) 1)
+ (setq val (string-to-char val))))
+ (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."
+ (and (member "graphics" (cdr (assq :result-params params)))
+ (cdr (assq :file params))))
+
+(defun org-babel-maxima-elisp-to-maxima (val)
+ "Return a string of maxima code which evaluates to VAL."
+ (if (listp val)
+ (concat "[" (mapconcat #'org-babel-maxima-elisp-to-maxima val ", ") "]")
+ (format "%s" val)))
+
+
(provide 'ob-maxima)
diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el
index dc800a875c6..64d35457b6b 100644
--- a/lisp/org/ob-mscgen.el
+++ b/lisp/org/ob-mscgen.el
@@ -1,11 +1,10 @@
;;; ob-msc.el --- org-babel functions for mscgen evaluation
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Juan Pechiar
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -25,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
@@ -65,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 78d309b9e13..d2bf36636a5 100644
--- a/lisp/org/ob-ocaml.el
+++ b/lisp/org/ob-ocaml.el
@@ -1,11 +1,10 @@
;;; ob-ocaml.el --- org-babel functions for ocaml evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -29,7 +28,7 @@
;; they can be run, but ocaml code can also be run through an
;; interactive interpreter.
;;
-;; For now let's only allow evaluation using the ocaml interpreter.
+;; For now lets only allow evaluation using the ocaml interpreter.
;;; Requirements:
@@ -73,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
@@ -94,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))))
@@ -132,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 2003a6f18f7..73f25eca155 100644
--- a/lisp/org/ob-octave.el
+++ b/lisp/org/ob-octave.el
@@ -1,11 +1,10 @@
;;; ob-octave.el --- org-babel functions for octave and matlab evaluation
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -53,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
@@ -87,20 +86,31 @@ end")
(org-babel-expand-body:generic
body params (org-babel-variable-assignments:octave params)))
(result (org-babel-octave-evaluate
- session full-body result-type matlabp)))
- (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))))))
+ session
+ (if (org-babel-octave-graphical-output-file params)
+ (mapconcat 'identity
+ (list
+ "set (0, \"defaultfigurevisible\", \"off\");"
+ full-body
+ (format "print -dpng %s" (org-babel-octave-graphical-output-file params)))
+ "\n")
+ full-body)
+ result-type matlabp)))
+ (if (org-babel-octave-graphical-output-file params)
+ nil
+ (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-prep-session:matlab (session params)
"Prepare SESSION according to PARAMS."
(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;"
@@ -118,7 +128,11 @@ specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-octave-var-to-octave var
(if (listp (car var)) "; " ",")) "]")
- (format "%s" (or var "nil"))))
+ (cond
+ ((stringp var)
+ (format "\'%s\'" var))
+ (t
+ (format "%s" var)))))
(defun org-babel-prep-session:octave (session params &optional matlabp)
"Prepare SESSION according to the header arguments specified in PARAMS."
@@ -133,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
@@ -211,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
@@ -251,11 +265,16 @@ 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))
+(defun org-babel-octave-graphical-output-file (params)
+ "Name of file to which maxima should send graphical output."
+ (and (member "graphics" (cdr (assq :result-params params)))
+ (cdr (assq :file params))))
+
(provide 'ob-octave)
diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el
index 37256d015c7..64de4b2ce45 100644
--- a/lisp/org/ob-org.el
+++ b/lisp/org/ob-org.el
@@ -1,11 +1,10 @@
;;; ob-org.el --- org-babel functions for org code block evaluation
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -33,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 13d71413731..abf0ed637d7 100644
--- a/lisp/org/ob-perl.el
+++ b/lisp/org/ob-perl.el
@@ -1,12 +1,11 @@
;;; ob-perl.el --- org-babel functions for perl evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
-;; Author: Dan Davison
-;; Eric Schulte
+;; Authors: Dan Davison
+;; Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -48,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
@@ -58,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;"
@@ -82,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
"
@@ -102,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
new file mode 100644
index 00000000000..025993c5847
--- /dev/null
+++ b/lisp/org/ob-picolisp.el
@@ -0,0 +1,195 @@
+;;; ob-picolisp.el --- org-babel functions for picolisp evaluation
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Authors: Thorsten Jolitz
+;; Eric Schulte
+;; 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:
+
+;; This library enables the use of PicoLisp in the multi-language
+;; programming framework Org-Babel. PicoLisp is a minimal yet
+;; fascinating lisp dialect and a highly productive application
+;; framework for web-based client-server applications on top of
+;; object-oriented databases. A good way to learn PicoLisp is to first
+;; read Paul Grahams essay "The hundred year language"
+;; (http://www.paulgraham.com/hundred.html) and then study the various
+;; documents and essays published in the PicoLisp wiki
+;; (http://picolisp.com/5000/-2.html). PicoLisp is included in some
+;; GNU/Linux Distributions, and can be downloaded here:
+;; http://software-lab.de/down.html. It ships with a picolisp-mode and
+;; a inferior-picolisp-mode for Emacs (to be found in the /lib/el/
+;; directory).
+
+;; Although it might seem more natural to use Emacs Lisp for most
+;; Lisp-based programming tasks inside Org-Mode, an Emacs library
+;; written in Emacs Lisp, PicoLisp has at least two outstanding
+;; features that make it a valuable addition to Org-Babel:
+
+;; PicoLisp _is_ an object-oriented database with a Prolog-based query
+;; language implemented in PicoLisp (Pilog). Database objects are
+;; first-class members of the language.
+
+;; PicoLisp is an extremely productive framework for the development
+;; of interactive web-applications (on top of a database).
+
+;;; Requirements:
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+(require 'ob-comint)
+(require 'comint)
+(eval-when-compile (require 'cl))
+
+(declare-function run-picolisp "ext:inferior-picolisp" (cmd))
+(defvar org-babel-tangle-lang-exts) ;; Autoloaded
+
+;; optionally define a file extension for this language
+(add-to-list 'org-babel-tangle-lang-exts '("picolisp" . "l"))
+
+;;; interferes with settings in org-babel buffer?
+;; optionally declare default header arguments for this language
+;; (defvar org-babel-default-header-args:picolisp
+;; '((:colnames . "no"))
+;; "Default arguments for evaluating a picolisp source block.")
+
+(defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe"
+ "String to indicate that evaluation has completed.")
+
+(defcustom org-babel-picolisp-cmd "pil"
+ "Name of command used to evaluate picolisp blocks."
+ :group 'org-babel
+ :version "24.1"
+ :type 'string)
+
+(defun org-babel-expand-body:picolisp (body params &optional processed-params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (result-params (cdr (assoc :result-params params)))
+ (print-level nil) (print-length nil))
+ (if (> (length vars) 0)
+ (concat "(prog (let ("
+ (mapconcat
+ (lambda (var)
+ (format "%S '%S)"
+ (print (car var))
+ (print (cdr var))))
+ vars "\n ")
+ " \n" body ") )")
+ body)))
+
+(defun org-babel-execute:picolisp (body params)
+ "Execute a block of Picolisp code with org-babel. This function is
+ called by `org-babel-execute-src-block'"
+ (message "executing Picolisp source code block")
+ (let* (
+ ;; name of the session or "none"
+ (session-name (cdr (assoc :session params)))
+ ;; set the session if the session variable is non-nil
+ (session (org-babel-picolisp-initiate-session session-name))
+ ;; either OUTPUT or VALUE which should behave as described above
+ (result-type (cdr (assoc :result-type params)))
+ (result-params (cdr (assoc :result-params params)))
+ ;; expand the body with `org-babel-expand-body:picolisp'
+ (full-body (org-babel-expand-body:picolisp body params))
+ ;; wrap body appropriately for the type of evaluation and results
+ (wrapped-body
+ (cond
+ ((or (member "code" result-params)
+ (member "pp" result-params))
+ (format "(pretty (out \"/dev/null\" %s))" full-body))
+ ((and (member "value" result-params) (not session))
+ (format "(print (out \"/dev/null\" %s))" full-body))
+ ((member "value" result-params)
+ (format "(out \"/dev/null\" %s)" full-body))
+ (t full-body))))
+
+ ((lambda (result)
+ (if (or (member "verbatim" result-params)
+ (member "scalar" result-params)
+ (member "output" result-params)
+ (member "code" result-params)
+ (member "pp" result-params)
+ (= (length result) 0))
+ result
+ (read result)))
+ (if (not (string= session-name "none"))
+ ;; session based evaluation
+ (mapconcat ;; <- joins the list back together into a single string
+ #'identity
+ (butlast ;; <- remove the org-babel-picolisp-eoe line
+ (delq nil
+ (mapcar
+ (lambda (line)
+ (org-babel-chomp ;; remove trailing newlines
+ (when (> (length line) 0) ;; remove empty lines
+ (cond
+ ;; remove leading "-> " from return values
+ ((and (>= (length line) 3)
+ (string= "-> " (substring line 0 3)))
+ (substring line 3))
+ ;; remove trailing "-> <<return-value>>" on the
+ ;; last line of output
+ ((and (member "output" result-params)
+ (string-match-p "->" line))
+ (substring line 0 (string-match "->" line)))
+ (t line)
+ )
+ ;; (if (and (>= (length line) 3) ;; remove leading "<- "
+ ;; (string= "-> " (substring line 0 3)))
+ ;; (substring line 3)
+ ;; line)
+ )))
+ ;; returns a list of the output of each evaluated expression
+ (org-babel-comint-with-output (session org-babel-picolisp-eoe)
+ (insert wrapped-body) (comint-send-input)
+ (insert "'" org-babel-picolisp-eoe) (comint-send-input)))))
+ "\n")
+ ;; external evaluation
+ (let ((script-file (org-babel-temp-file "picolisp-script-")))
+ (with-temp-file script-file
+ (insert (concat wrapped-body "(bye)")))
+ (org-babel-eval
+ (format "%s %s"
+ org-babel-picolisp-cmd
+ (org-babel-process-file-name script-file))
+ ""))))))
+
+(defun org-babel-picolisp-initiate-session (&optional session-name)
+ "If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session."
+ (unless (string= session-name "none")
+ (require 'inferior-picolisp)
+ ;; provide a reasonable default session name
+ (let ((session (or session-name "*inferior-picolisp*")))
+ ;; check if we already have a live session by this name
+ (if (org-babel-comint-buffer-livep session)
+ (get-buffer session)
+ (save-window-excursion
+ (run-picolisp org-babel-picolisp-cmd)
+ (rename-buffer session-name)
+ (current-buffer))))))
+
+(provide 'ob-picolisp)
+
+
+
+;;; ob-picolisp.el ends here
diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el
index 9fa55727592..37d8b7d1ee0 100644
--- a/lisp/org/ob-plantuml.el
+++ b/lisp/org/ob-plantuml.el
@@ -1,11 +1,10 @@
;;; ob-plantuml.el --- org-babel functions for plantuml evaluation
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Zhang Weize
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -45,6 +44,7 @@
(defcustom org-plantuml-jar-path nil
"Path to the plantuml.jar file."
:group 'org-babel
+ :version "24.1"
:type 'string)
(defun org-babel-execute:plantuml (body params)
@@ -52,12 +52,13 @@
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)) ""))
(cmd (if (not org-plantuml-jar-path)
(error "`org-plantuml-jar-path' is not set")
- (concat "java -jar "
+ (concat "java " java " -jar "
(shell-quote-argument
(expand-file-name org-plantuml-jar-path))
(if (string= (file-name-extension out-file) "svg")
diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el
index 5234d83ecee..71adf73073b 100644
--- a/lisp/org/ob-python.el
+++ b/lisp/org/ob-python.el
@@ -1,12 +1,11 @@
;;; ob-python.el --- org-babel functions for python evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
-;; Author: Eric Schulte
-;; Dan Davison
+;; Authors: Eric Schulte
+;; Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -45,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.
@@ -65,7 +64,7 @@ This function is called by `org-babel-execute-src-block'."
(preamble (cdr (assoc :preamble params)))
(full-body
(org-babel-expand-body:generic
- (concat body (if return-val (format "return %s" return-val) ""))
+ (concat body (if return-val (format "\nreturn %s" return-val) ""))
params (org-babel-variable-assignments:python params)))
(result (org-babel-python-evaluate
session full-body result-type result-params preamble)))
@@ -100,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"
@@ -161,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)))
@@ -191,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)
@@ -202,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)
@@ -237,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)
@@ -270,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 1e14021a364..af4ee6a1a4d 100644
--- a/lisp/org/ob-ref.el
+++ b/lisp/org/ob-ref.el
@@ -1,12 +1,11 @@
;;; ob-ref.el --- org-babel functions for referencing external data
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
-;; Author: Eric Schulte
-;; Dan Davison
+;; Authors: Eric Schulte
+;; Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -60,11 +59,17 @@
(declare-function org-at-item-p "org-list" ())
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
+(declare-function org-id-find-id-file "org-id" (id))
(declare-function org-show-context "org" (&optional key))
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
(defvar org-babel-ref-split-regexp
"[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*")
+(defvar org-babel-update-intermediate nil
+ "Update the in-buffer results of code blocks executed to resolve references.")
+
(defun org-babel-ref-parse (assignment)
"Parse a variable ASSIGNMENT in a header argument.
If the right hand side of the assignment has a literal value
@@ -94,7 +99,7 @@ the variable."
(m (when file (org-id-find-id-in-file id file 'marker))))
(when (and file m)
(message "file:%S" file)
- (switch-to-buffer (marker-buffer m))
+ (org-pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
(org-show-context)
@@ -116,83 +121,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* ((rx (regexp-quote ref))
- (res-rx (concat org-babel-result-regexp rx "[ \t]*$"))
- (src-rx (concat org-babel-src-name-regexp
- rx "\\(\(.*\)\\)?" "[ \t]*$")))
- ;; goto ref in the current buffer
- (or (and (not args)
- (or (re-search-forward res-rx nil t)
- (re-search-backward res-rx nil t)))
- (re-search-forward src-rx nil t)
- (re-search-backward src-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))
- (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 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.
@@ -208,46 +219,34 @@ 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)
"Split ARG-STRING into top-level arguments of balanced parenthesis."
- (let ((index 0) (depth 0) (buffer "") holder return)
- ;; crawl along string, splitting at any ","s which are on the top level
- (while (< index (length arg-string))
- (setq holder (substring arg-string index (+ 1 index)))
- (setq buffer (concat buffer holder))
- (setq index (+ 1 index))
- (cond
- ((string= holder ",")
- (when (= depth 0)
- (setq return (cons (substring buffer 0 -1) return))
- (setq buffer "")))
- ((or (string= holder "(") (string= holder "[")) (setq depth (+ depth 1)))
- ((or (string= holder ")") (string= holder "]")) (setq depth (- depth 1)))))
- (mapcar #'org-babel-trim (reverse (cons buffer return)))))
+ (mapcar #'org-babel-trim (org-babel-balanced-split arg-string 44)))
(defvar org-bracket-link-regexp)
(defun org-babel-ref-at-ref-p ()
diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el
index 02089b4a214..54077d0d685 100644
--- a/lisp/org/ob-ruby.el
+++ b/lisp/org/ob-ruby.el
@@ -1,11 +1,10 @@
;;; ob-ruby.el --- org-babel functions for ruby evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -29,10 +28,10 @@
;;; Requirements:
;; - ruby and irb executables :: http://www.ruby-lang.org/
-;;
+;;
;; - ruby-mode :: Can be installed through ELPA, or from
;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el
-;;
+;;
;; - inf-ruby mode :: Can be installed through ELPA, or from
;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el
@@ -65,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))
@@ -103,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"
@@ -129,8 +128,8 @@ Emacs-lisp table, otherwise return the results as a string."
"Initiate a ruby session.
If there is not a current inferior-process-buffer in SESSION
then create one. Return the initialized session."
- (require 'inf-ruby)
(unless (string= session "none")
+ (require 'inf-ruby)
(let ((session-buffer (save-window-excursion
(run-ruby nil session) (current-buffer))))
(if (org-babel-comint-buffer-livep session-buffer)
diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el
index 162113ea5a8..c9606104311 100644
--- a/lisp/org/ob-sass.el
+++ b/lisp/org/ob-sass.el
@@ -1,11 +1,10 @@
;;; ob-sass.el --- org-babel functions for the sass css generation language
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
diff --git a/lisp/org/ob-scala.el b/lisp/org/ob-scala.el
new file mode 100644
index 00000000000..ea3c3f28112
--- /dev/null
+++ b/lisp/org/ob-scala.el
@@ -0,0 +1,128 @@
+;;; 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))
+
+(defvar org-babel-tangle-lang-exts) ;; Autoloaded
+(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
+
+"var str_result :String = null;
+
+Console.withOut(new java.io.OutputStream() {def write(b: Int){
+}}) {
+ str_result = {
+%s
+ }.toString
+}
+
+print(str_result)
+")
+
+
+(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-scheme.el b/lisp/org/ob-scheme.el
index 3e93a3a74f7..ce2992840ca 100644
--- a/lisp/org/ob-scheme.el
+++ b/lisp/org/ob-scheme.el
@@ -1,11 +1,10 @@
;;; ob-scheme.el --- org-babel functions for Scheme
-;; Copyright (C) 2010-2011 Free Software Foundation
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, scheme
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -55,6 +54,7 @@
(defcustom org-babel-scheme-cmd "guile"
"Name of command used to evaluate scheme blocks."
:group 'org-babel
+ :version "24.1"
:type 'string)
(defun org-babel-expand-body:scheme (body params)
diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el
index 084beffd229..c6288924235 100644
--- a/lisp/org/ob-screen.el
+++ b/lisp/org/ob-screen.el
@@ -1,11 +1,10 @@
;;; ob-screen.el --- org-babel support for interactive terminal
-;; Copyright (C) 2009-2011 Free Software Foundation
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Benjamin Andresen
;; Keywords: literate programming, interactive shell
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -24,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
@@ -38,7 +37,7 @@
(require 'ob-ref)
(defvar org-babel-screen-location "screen"
- "The command location for screen.
+ "The command location for screen.
In case you want to use a different screen than one selected by your $PATH")
(defvar org-babel-default-header-args:screen
@@ -65,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
@@ -82,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\"."
@@ -112,7 +111,7 @@ In case you want to use a different screen than one selected by your $PATH")
(with-temp-file tmpfile
(insert body)
- ;; org-babel has superflous spaces
+ ;; org-babel has superfluous spaces
(goto-char (point-min))
(delete-matching-lines "^ +$"))
tmpfile))
@@ -138,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 f46ba45770a..1cb607f148d 100644
--- a/lisp/org/ob-sh.el
+++ b/lisp/org/ob-sh.el
@@ -1,11 +1,10 @@
;;; ob-sh.el --- org-babel functions for shell evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -57,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
@@ -92,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)
@@ -109,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.
@@ -135,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))))
@@ -183,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-shen.el b/lisp/org/ob-shen.el
new file mode 100644
index 00000000000..8f4b13217c6
--- /dev/null
+++ b/lisp/org/ob-shen.el
@@ -0,0 +1,79 @@
+;;; ob-shen.el --- org-babel functions for Shen
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research, shen
+;; 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 this only works using session evaluation as there is no
+;; defined method for executing shen code outside of a session.
+
+;;; Requirements:
+
+;; - shen-mode and inf-shen will soon be available through the GNU
+;; elpa, however in the interim they are available at
+;; https://github.com/eschulte/shen-mode
+
+;;; Code:
+(require 'ob)
+
+(declare-function shen-eval-defun "ext:inf-shen" (&optional and-go))
+
+(defvar org-babel-default-header-args:shen '()
+ "Default header arguments for shen code blocks.")
+
+(defun org-babel-expand-body:shen (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (if (> (length vars) 0)
+ (concat "(let "
+ (mapconcat (lambda (var)
+ (format "%s %s" (car var)
+ (org-babel-shen-var-to-shen (cdr var))))
+ vars " ")
+ body ")")
+ body)))
+
+(defun org-babel-shen-var-to-shen (var)
+ "Convert VAR into a shen variable."
+ (if (listp var)
+ (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var " ") "]")
+ (format "%S" var)))
+
+(defun org-babel-execute:shen (body params)
+ "Execute a block of Shen code with org-babel.
+This function is called by `org-babel-execute-src-block'"
+ (require 'inf-shen)
+ (let* ((result-type (cdr (assoc :result-type params)))
+ (result-params (cdr (assoc :result-params params)))
+ (full-body (org-babel-expand-body:shen body params)))
+ ((lambda (results)
+ (if (or (member 'scalar result-params)
+ (member 'verbatim result-params))
+ results
+ (condition-case nil (org-babel-script-escape results)
+ (error results))))
+ (with-temp-buffer
+ (insert full-body)
+ (call-interactively #'shen-eval-defun)))))
+
+(provide 'ob-shen)
+;;; ob-shen.el ends here
diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el
index 7a5c7c8a46a..20a136a80fb 100644
--- a/lisp/org/ob-sql.el
+++ b/lisp/org/ob-sql.el
@@ -1,11 +1,10 @@
;;; ob-sql.el --- org-babel functions for sql evaluation
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -25,6 +24,7 @@
;;; Commentary:
;; Org-Babel support for evaluating sql source code.
+;; (see also ob-sqlite.el)
;;
;; SQL is somewhat unique in that there are many different engines for
;; the evaluation of sql (Mysql, PostgreSQL, etc...), so much of this
@@ -32,7 +32,7 @@
;;
;; Also SQL evaluation generally takes place inside of a database.
;;
-;; For now let's just allow a generic ':cmdline' header argument.
+;; For now lets just allow a generic ':cmdline' header argument.
;;
;; TODO:
;;
@@ -47,10 +47,15 @@
(eval-when-compile (require 'cl))
(declare-function org-table-import "org-table" (file arg))
-(declare-function orgtbl-to-csv "org-table" (TABLE PARAMS))
+(declare-function orgtbl-to-csv "org-table" (table params))
+(declare-function org-table-to-lisp "org-table" (&optional txt))
(defvar org-babel-default-header-args:sql '())
+(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."
(org-babel-sql-expand-vars
@@ -67,6 +72,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)
@@ -77,39 +91,50 @@ 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)
- (with-temp-buffer
- ;; need to figure out what the delimiter is for the header row
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params)
+ (member "html" result-params)
+ (member "code" result-params)
+ (equal (point-min) (point-max)))
+ (with-temp-buffer
+ (progn (insert-file-contents-literally out-file) (buffer-string)))
(with-temp-buffer
- (insert-file-contents out-file)
- (goto-char (point-min))
- (when (re-search-forward "^\\(-+\\)[^-]" nil t)
- (setq header-delim (match-string-no-properties 1)))
- (goto-char (point-max))
- (forward-char -1)
- (while (looking-at "\n")
- (delete-char 1)
- (goto-char (point-max))
- (forward-char -1))
- (write-file out-file))
- (org-table-import out-file '(16))
- (org-babel-reassemble-table
- (mapcar (lambda (x)
- (if (string= (car x) header-delim)
- 'hline
- x))
- (org-table-to-lisp))
- (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)))))))
+ ;; need to figure out what the delimiter is for the header row
+ (with-temp-buffer
+ (insert-file-contents out-file)
+ (goto-char (point-min))
+ (when (re-search-forward "^\\(-+\\)[^-]" nil t)
+ (setq header-delim (match-string-no-properties 1)))
+ (goto-char (point-max))
+ (forward-char -1)
+ (while (looking-at "\n")
+ (delete-char 1)
+ (goto-char (point-max))
+ (forward-char -1))
+ (write-file out-file))
+ (org-table-import out-file '(16))
+ (org-babel-reassemble-table
+ (mapcar (lambda (x)
+ (if (string= (car x) header-delim)
+ 'hline
+ x))
+ (org-table-to-lisp))
+ (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-sql-expand-vars (body vars)
"Expand the variables held in VARS in BODY."
@@ -124,8 +149,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))))
@@ -136,7 +161,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 c08c7f38e8a..b1696d94d3c 100644
--- a/lisp/org/ob-sqlite.el
+++ b/lisp/org/ob-sqlite.el
@@ -1,11 +1,10 @@
;;; ob-sqlite.el --- org-babel functions for sqlite database interaction
-;; Copyright (C) 2010-2011 Free Software Foundation
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -34,12 +33,23 @@
(declare-function org-fill-template "org" (template alist))
(declare-function org-table-convert-region "org-table"
(beg0 end0 &optional separator))
-(declare-function orgtbl-to-csv "org-table" (TABLE PARAMS))
+(declare-function orgtbl-to-csv "org-table" (table params))
+(declare-function org-table-to-lisp "org-table" (&optional txt))
(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)
@@ -62,7 +72,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
@@ -94,7 +104,14 @@ This function is called by `org-babel-execute-src-block'."
(member "code" result-params)
(equal (point-min) (point-max)))
(buffer-string)
- (org-table-convert-region (point-min) (point-max))
+ (org-table-convert-region (point-min) (point-max)
+ (if (or (member :csv others)
+ (member :column others)
+ (member :line others)
+ (member :list others)
+ (member :html others) separator)
+ nil
+ '(4)))
(org-babel-sqlite-table-or-scalar
(org-babel-sqlite-offset-colnames
(org-table-to-lisp) headers-p))))))
@@ -112,8 +129,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))))
@@ -139,9 +156,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 ea253b2f048..242ddf09020 100644
--- a/lisp/org/ob-table.el
+++ b/lisp/org/ob-table.el
@@ -1,11 +1,10 @@
;;; ob-table.el --- support for calling org-babel functions from tables
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -31,7 +30,7 @@
;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2)))))
;; #+end_src
-;; #+srcname: fibbd
+;; #+name: fibbd
;; #+begin_src emacs-lisp :var n=2 :results silent
;; (fibbd n)
;; #+end_src
@@ -76,48 +75,61 @@ results
NOTE: by default string variable names are interpreted as
references to source-code blocks, to force interpretation of a
-cell's value as a string, prefix the identifier with two \"$\"s
-rather than a single \"$\" (i.e. \"$$2\" instead of \"$2\" in the
-example above."
- (let* (quote
- (variables
- (mapcar
- (lambda (var)
- ;; ensure that all cells prefixed with $'s are strings
- (cons (car var)
- (delq nil (mapcar
- (lambda (el)
- (if (eq '$ el)
- (setq quote t)
- (prog1 (if quote
- (format "\"%s\"" el)
- (org-babel-clean-text-properties el))
- (setq quote nil))))
- (cdr var)))))
- variables)))
- (unless (stringp source-block)
- (setq source-block (symbol-name source-block)))
- ((lambda (result)
- (org-babel-trim (if (stringp result) result (format "%S" result))))
- (if (and source-block (> (length source-block) 0))
- (let ((params
- (eval `(org-babel-parse-header-arguments
- (concat ":var results="
- ,source-block
- "("
- (mapconcat
- (lambda (var-spec)
- (if (> (length (cdr var-spec)) 1)
- (format "%S='%S"
- (car var-spec)
- (mapcar #'read (cdr var-spec)))
- (format "%S=%s"
- (car var-spec) (cadr var-spec))))
- ',variables ", ")
- ")")))))
- (org-babel-execute-src-block
- nil (list "emacs-lisp" "results" params) '((:results . "silent"))))
- ""))))
+cell's value as a string, prefix the identifier a \"$\" (e.g.,
+\"$$2\" instead of \"$2\" or \"$@2$2\" instead of \"@2$2\").
+
+NOTE: it is also possible to pass header arguments to the code
+block. In this case a table cell should hold the string value of
+the header argument which can then be passed before all variables
+as shown in the example below.
+
+| 1 | 2 | :file nothing.png | nothing.png |
+#+TBLFM: @1$4='(sbe test-sbe $3 (x $1) (y $2))"
+ (let* ((header-args (if (stringp (car variables)) (car variables) ""))
+ (variables (if (stringp (car variables)) (cdr variables) variables)))
+ (let* (quote
+ (variables
+ (mapcar
+ (lambda (var)
+ ;; ensure that all cells prefixed with $'s are strings
+ (cons (car var)
+ (delq nil (mapcar
+ (lambda (el)
+ (if (eq '$ el)
+ (prog1 nil (setq quote t))
+ (prog1 (if quote
+ (format "\"%s\"" el)
+ (org-no-properties el))
+ (setq quote nil))))
+ (cdr var)))))
+ variables)))
+ (unless (stringp source-block)
+ (setq source-block (symbol-name source-block)))
+ ((lambda (result)
+ (org-babel-trim (if (stringp result) result (format "%S" result))))
+ (if (and source-block (> (length source-block) 0))
+ (let ((params
+ (eval `(org-babel-parse-header-arguments
+ (concat
+ ":var results="
+ ,source-block
+ "[" ,header-args "]"
+ "("
+ (mapconcat
+ (lambda (var-spec)
+ (if (> (length (cdr var-spec)) 1)
+ (format "%S='%S"
+ (car var-spec)
+ (mapcar #'read (cdr var-spec)))
+ (format "%S=%s"
+ (car var-spec) (cadr var-spec))))
+ ',variables ", ")
+ ")")))))
+ (org-babel-execute-src-block
+ nil (list "emacs-lisp" "results" params)
+ '((:results . "silent"))))
+ "")))))
+(def-edebug-spec sbe (form form))
(provide 'ob-table)
diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el
index 26549126009..7e25b2cd1bc 100644
--- a/lisp/org/ob-tangle.el
+++ b/lisp/org/ob-tangle.el
@@ -1,11 +1,10 @@
;;; ob-tangle.el --- extract source code from org-mode files
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -39,7 +38,6 @@
(declare-function org-babel-update-block-body "org" (new-body))
(declare-function make-directory "files" (dir &optional parents))
-;;;###autoload
(defcustom org-babel-tangle-lang-exts
'(("emacs-lisp" . "el"))
"Alist mapping languages to their file extensions.
@@ -48,6 +46,7 @@ be inserted as the extension commonly used to identify files
written in this language. If no entry is found in this list,
then the name of the language is used."
:group 'org-babel-tangle
+ :version "24.1"
:type '(repeat
(cons
(string "Language name")
@@ -56,16 +55,19 @@ then the name of the language is used."
(defcustom org-babel-post-tangle-hook nil
"Hook run in code files tangled by `org-babel-tangle'."
:group 'org-babel
+ :version "24.1"
:type 'hook)
(defcustom org-babel-pre-tangle-hook '(save-buffer)
"Hook run at the beginning of `org-babel-tangle'."
:group 'org-babel
+ :version "24.1"
:type 'hook)
(defcustom org-babel-tangle-body-hook nil
"Hook run over the contents of each code block body."
:group 'org-babel
+ :version "24.1"
:type 'hook)
(defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]"
@@ -80,6 +82,7 @@ information into the output using `org-fill-template'.
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
+ :version "24.1"
:type 'string)
(defcustom org-babel-tangle-comment-format-end "%source-name ends here"
@@ -94,8 +97,18 @@ information into the output using `org-fill-template'.
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
+ :version "24.1"
:type 'string)
+(defcustom org-babel-process-comment-text #'org-babel-trim
+ "Function called to process raw Org-mode text collected to be
+inserted as comments in tangled source-code files. The function
+should take a single string argument and return a string
+result. The default value is `org-babel-trim'."
+ :group 'org-babel
+ :version "24.1"
+ :type 'function)
+
(defun org-babel-find-file-noselect-refresh (file)
"Find file ensuring that the latest changes on disk are
represented in the file."
@@ -108,17 +121,20 @@ 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))
,temp-result)))
+(def-edebug-spec org-babel-with-temp-filebuffer (form body))
;;;###autoload
(defun org-babel-load-file (file)
@@ -127,19 +143,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)
@@ -174,94 +190,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"))
- (unless 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'.
@@ -273,12 +290,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
@@ -295,7 +359,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)))))
@@ -309,7 +374,7 @@ code blocks by language."
(link ((lambda (link)
(and (string-match org-bracket-link-regexp link)
(match-string 1 link)))
- (org-babel-clean-text-properties
+ (org-no-properties
(org-store-link nil))))
(source-name
(intern (or (nth 4 info)
@@ -334,27 +399,27 @@ 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
(when (or (string= "both" (cdr (assoc :comments params)))
(string= "org" (cdr (assoc :comments params))))
;; from the previous heading or code-block end
- (buffer-substring
- (max (condition-case nil
- (save-excursion
- (org-back-to-heading t) (point))
- (error 0))
- (save-excursion
- (re-search-backward
- org-babel-src-block-regexp nil t)
- (match-end 0)))
- (point))))
+ (funcall
+ org-babel-process-comment-text
+ (buffer-substring
+ (max (condition-case nil
+ (save-excursion
+ (org-back-to-heading t) ; sets match data
+ (match-end 0))
+ (error (point-min)))
+ (save-excursion
+ (if (re-search-backward
+ org-babel-src-block-regexp nil t)
+ (match-end 0)
+ (point-min))))
+ (point)))))
by-lang)
;; add the spec for this block to blocks under it's language
(setq by-lang (cdr (assoc src-lang blocks)))
@@ -371,58 +436,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 (org-link-escape (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)
- (let ((text (org-babel-trim 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)
@@ -455,7 +474,7 @@ which enable the original code blocks to be found."
(org-babel-update-block-body new-body)))
(setq counter (+ 1 counter)))
(goto-char end))
- (prog1 counter (message "detangled %d code blocks" counter)))))
+ (prog1 counter (message "Detangled %d code blocks" counter)))))
(defun org-babel-tangle-jump-to-org ()
"Jump from a tangled code file to the related Org-mode file."
@@ -478,7 +497,7 @@ which enable the original code blocks to be found."
" ends here") nil t)
(setq end (point-at-bol))))))))
(unless (and start (< start mid) (< mid end))
- (error "not in tangled code"))
+ (error "Not in tangled code"))
(setq body (org-babel-trim (buffer-substring start end))))
(when (string-match "::" path)
(setq path (substring path 0 (match-beginning 0))))
@@ -494,6 +513,8 @@ which enable the original code blocks to be found."
(provide 'ob-tangle)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; ob-tangle.el ends here
diff --git a/lisp/org/ob.el b/lisp/org/ob.el
index 8bba4672169..b06aac11f69 100644
--- a/lisp/org/ob.el
+++ b/lisp/org/ob.el
@@ -1,12 +1,11 @@
;;; ob.el --- working with code blocks in org-mode
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
-;; Author: Eric Schulte
+;; Authors: Eric Schulte
;; Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -28,11 +27,18 @@
(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 tramp-compat-make-temp-file "tramp-compat"
(filename &optional dir-flag))
(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
@@ -44,7 +50,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" ())
@@ -79,6 +85,11 @@
(declare-function org-list-struct "org-list" ())
(declare-function org-list-prevs-alist "org-list" (struct))
(declare-function org-list-get-list-end "org-list" (item struct prevs))
+(declare-function org-remove-if "org" (predicate seq))
+(declare-function org-completing-read "org" (&rest args))
+(declare-function org-escape-code-in-region "org-src" (beg end))
+(declare-function org-unescape-code-in-string "org-src" (s))
+(declare-function org-table-to-lisp "org-table" (&optional txt))
(defgroup org-babel nil
"Code block evaluation and management in `org-mode' documents."
@@ -103,18 +114,44 @@ remove code block execution from C-c C-c as further protection
against accidental code block evaluation. The
`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to
remove code block execution from the C-c C-c keybinding."
- :group 'org-babel
- :type '(choice boolean function))
+ :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)))
(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil
"Remove code block evaluation from the C-c C-c key binding."
:group 'org-babel
+ :version "24.1"
:type 'boolean)
+(defcustom org-babel-results-keyword "RESULTS"
+ "Keyword used to name results generated by code blocks.
+Should be either RESULTS or NAME however any capitalization may
+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]*#\\+\\(srcname\\|source\\|function\\):[ \t]*"
+ "^[ \t]*#\\+name:[ \t]*"
"Regular expression used to match a source name line.")
(defvar org-babel-multi-line-header-regexp
@@ -144,7 +181,7 @@ remove code block execution from the C-c C-c keybinding."
(defvar org-babel-inline-src-block-regexp
(concat
;; (1) replacement target (2) lang
- "[^-[:alnum:]]\\(src_\\([^ \f\t\n\r\v]+\\)"
+ "\\(?:^\\|[^-[:alnum:]]\\)\\(src_\\([^ \f\t\n\r\v]+\\)"
;; (3,4) (unused, headers)
"\\(\\|\\[\\(.*?\\)\\]\\)"
;; (5) body
@@ -160,6 +197,39 @@ not match KEY should be returned."
(lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p))
params)))
+(defun org-babel-get-inline-src-block-matches()
+ "Set match data if within body of an inline source block.
+Returns non-nil if match-data set"
+ (let ((src-at-0-p (save-excursion
+ (beginning-of-line 1)
+ (string= "src" (thing-at-point 'word))))
+ (first-line-p (= 1 (line-number-at-pos)))
+ (orig (point)))
+ (let ((search-for (cond ((and src-at-0-p first-line-p "src_"))
+ (first-line-p "[[:punct:] \t]src_")
+ (t "[[:punct:] \f\t\n\r\v]src_")))
+ (lower-limit (if first-line-p
+ nil
+ (- (point-at-bol) 1))))
+ (save-excursion
+ (when (or (and src-at-0-p (bobp))
+ (and (re-search-forward "}" (point-at-eol) t)
+ (re-search-backward search-for lower-limit t)
+ (> orig (point))))
+ (when (looking-at org-babel-inline-src-block-regexp)
+ t ))))))
+
+(defvar org-babel-inline-lob-one-liner-regexp)
+(defun org-babel-get-lob-one-liner-matches()
+ "Set match data if on line of an lob one liner.
+Returns non-nil if match-data set"
+ (save-excursion
+ (unless (= (point) (point-at-bol)) ;; move before inline block
+ (re-search-backward "[ \f\t\n\r\v]" nil t))
+ (if (looking-at org-babel-inline-lob-one-liner-regexp)
+ t
+ nil)))
+
(defun org-babel-get-src-block-info (&optional light)
"Get information on the current source block.
@@ -184,22 +254,30 @@ 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 4)))
- (when (match-string 6)
+ (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
- (mapcar (lambda (ref) (cons :var ref))
- (org-babel-ref-split-args (match-string 6)))
+ (mapcar
+ (lambda (ref) (cons :var ref))
+ (mapcar
+ (lambda (var) ;; check that each variable is initialized
+ (if (string-match ".+=.+" var)
+ var
+ (error
+ "variable \"%s\"%s must be assigned a default value"
+ var (if name (format " in block \"%s\"" name) ""))))
+ (org-babel-ref-split-args (match-string 5))))
(nth 2 info))))))
;; inline source block
- (when (save-excursion (re-search-backward "[ \f\t\n\r\v]" nil t)
- (looking-at org-babel-inline-src-block-regexp))
+ (when (org-babel-get-inline-src-block-matches)
(setq info (org-babel-parse-inline-src-block-match))))
;; resolve variable references and add summary parameters
(when (and info (not light))
(setf (nth 2 info) (org-babel-process-params (nth 2 info))))
(when info (append info (list name indent)))))
+(defvar org-current-export-file) ; dynamically bound
(defun org-babel-confirm-evaluate (info)
"Confirm evaluation of the code block INFO.
This behavior can be suppressed by setting the value of
@@ -212,11 +290,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 (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 (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? "
@@ -224,7 +309,9 @@ of potentially harmful code."
(if (nth 4 info)
(format " (%s) " (nth 4 info)) " "))))))
(prog1 nil (message "Evaluation %s"
- (if (or (equal eval "never") (equal eval "no"))
+ (if (or (equal eval "never") (equal eval "no")
+ (equal eval "no-export")
+ (equal eval "never-export"))
"Disabled" "Aborted")))
t)))
@@ -257,27 +344,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 ()
@@ -314,10 +401,38 @@ then run `org-babel-pop-to-session'."
(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe)
+(defconst org-babel-common-header-args-w-values
+ '((cache . ((no yes)))
+ (cmdline . :any)
+ (colnames . ((nil no yes)))
+ (comments . ((no link yes org both noweb)))
+ (dir . :any)
+ (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 no-export strip-export)))
+ (noweb-ref . :any)
+ (noweb-sep . :any)
+ (padline . ((yes no)))
+ (results . ((file list vector table scalar verbatim)
+ (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)
+ (wrap . :any)))
+
(defconst org-babel-header-arg-names
- '(cache cmdline colnames dir exports file noweb results
- session tangle var eval noeval comments no-expand shebang
- padline noweb-ref)
+ (mapcar #'car org-babel-common-header-args-w-values)
"Common header arguments used by org-babel.
Note that individual languages may define their own language
specific header arguments as well.")
@@ -332,7 +447,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" "RESNAME" "RESULTS" "DATA"))
+(defvar org-babel-data-names '("tblname" "results" "name"))
(defvar org-babel-result-regexp
(concat "^[ \t]*#\\+"
@@ -350,8 +465,8 @@ be saved in the second match data.")
"The minimum number of lines for block output.
If number of lines of output is equal to or exceeds this
value, the output is placed in a #+begin_example...#+end_example
-block. Otherwise the output is marked as literal by inserting
-colons at the starts of the lines. This variable only takes
+block. Otherwise the output is marked as literal by inserting
+colons at the starts of the lines. This variable only takes
effect if the :results output option is in effect.")
(defvar org-babel-noweb-error-langs nil
@@ -365,24 +480,29 @@ can not be resolved.")
(defvar org-babel-after-execute-hook nil
"Hook for functions to be called after `org-babel-execute-src-block'")
+
(defun org-babel-named-src-block-regexp-for-name (name)
"This generates a regexp used to match a src block named NAME."
- (concat org-babel-src-name-regexp (regexp-quote name) "[ \t\n]*"
+ (concat org-babel-src-name-regexp (regexp-quote name)
+ "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*"
(substring org-babel-src-block-regexp 1)))
+(defun org-babel-named-data-regexp-for-name (name)
+ "This generates a regexp used to match data named NAME."
+ (concat org-babel-result-regexp (regexp-quote name) "\\([ \t]\\|$\\)"))
+
;;; functions
(defvar call-process-region)
-;;;###autoload
+;;;###autoload
(defun org-babel-execute-src-block (&optional arg info params)
"Execute the current source code block.
Insert the results of execution into the buffer. Source code
execution and the collection and formatting of results can be
controlled through a variety of header arguments.
-With prefix argument ARG, force re-execution even if an
-existing result cached in the buffer would otherwise have been
-returned.
+With prefix argument ARG, force re-execution even if an existing
+result cached in the buffer would otherwise have been returned.
Optionally supply a value for INFO in the form returned by
`org-babel-get-src-block-info'.
@@ -392,7 +512,10 @@ the header arguments specified at the front of the source code
block."
(interactive)
(let ((info (or info (org-babel-get-src-block-info))))
- (when (org-babel-confirm-evaluate info)
+ (when (org-babel-confirm-evaluate
+ (let ((i info))
+ (setf (nth 2 i) (org-babel-merge-params (nth 2 info) params))
+ i))
(let* ((lang (nth 0 info))
(params (if params
(org-babel-process-params
@@ -404,15 +527,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
@@ -420,15 +541,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
@@ -481,10 +603,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:"
@@ -501,17 +622,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 ()
@@ -519,20 +655,80 @@ arguments and pop open the results in a preview buffer."
(interactive)
;; TODO: report malformed code block
;; TODO: report incompatible combinations of header arguments
- (let ((too-close 2)) ;; <- control closeness to report potential match
+ ;; TODO: report uninitialized variables
+ (let ((too-close 2) ;; <- control closeness to report potential match
+ (names (mapcar #'symbol-name org-babel-header-arg-names)))
(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 (mapcar #'symbol-name org-babel-header-arg-names))
+ (dolist (name names)
(when (and (not (string= header name))
- (<= (org-babel-edit-distance header name) too-close))
- (error "supplied header \"%S\" is suspiciously close to \"%S\""
+ (<= (org-babel-edit-distance header name) too-close)
+ (not (member header names)))
+ (error "Supplied header \"%S\" is suspiciously close to \"%S\""
header name))))
(message "No suspicious header arguments found.")))
;;;###autoload
+(defun org-babel-insert-header-arg ()
+ "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-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))))
+ (insert ":" arg)
+ (let ((vals (cdr (assoc (intern arg) headers))))
+ (when vals
+ (insert
+ " "
+ (cond
+ ((eq vals :any)
+ (read-from-minibuffer "value: "))
+ ((listp vals)
+ (mapconcat
+ (lambda (group)
+ (let ((arg (org-icompleting-read
+ "value: "
+ (cons "default" (mapcar #'symbol-name group)))))
+ (if (and arg (not (string= "default" arg)))
+ (concat arg " ")
+ "")))
+ 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.
Evaluate the header arguments for the source block before
@@ -543,8 +739,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)))
@@ -562,7 +757,7 @@ session."
"Initiate session for current code block.
If called with a prefix argument then resolve any variable
references in the header arguments and assign these variables in
-the session. Copy the body of the code block to the kill ring."
+the session. Copy the body of the code block to the kill ring."
(interactive "P")
(let* ((info (or info (org-babel-get-src-block-info (not arg))))
(lang (nth 0 info))
@@ -589,7 +784,7 @@ the session. Copy the body of the code block to the kill ring."
;;;###autoload
(defun org-babel-switch-to-session (&optional arg info)
"Switch to the session of the current code block.
-Uses `org-babel-initiate-session' to start the session. If called
+Uses `org-babel-initiate-session' to start the session. If called
with a prefix argument then this is passed on to
`org-babel-initiate-session'."
(interactive "P")
@@ -602,18 +797,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.
@@ -625,13 +820,14 @@ Return t if a code block was found at point, nil otherwise."
(if (org-bound-and-true-p org-edit-src-from-org-mode)
(org-edit-src-exit)))
t)))
+(def-edebug-spec org-babel-do-in-edit-buffer (body))
(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."
@@ -641,6 +837,7 @@ evaluation mechanisms."
(key-binding (or key (read-key-sequence nil))))))
(defvar org-bracket-link-regexp)
+
;;;###autoload
(defun org-babel-open-src-block-result (&optional re-run)
"If `point' is on a src block then open the results of the
@@ -721,6 +918,7 @@ end-body --------- point at the end of the body"
(goto-char end-block))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
+(def-edebug-spec org-babel-map-src-blocks (form body))
;;;###autoload
(defmacro org-babel-map-inline-src-blocks (file &rest body)
@@ -743,6 +941,57 @@ buffer."
(goto-char (match-end 0))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
+(def-edebug-spec org-babel-map-inline-src-blocks (form body))
+
+(defvar org-babel-lob-one-liner-regexp)
+
+;;;###autoload
+(defmacro org-babel-map-call-lines (file &rest body)
+ "Evaluate BODY forms on each call line in FILE.
+If FILE is nil evaluate BODY forms on source blocks in current
+buffer."
+ (declare (indent 1))
+ (let ((tempvar (make-symbol "file")))
+ `(let* ((,tempvar ,file)
+ (visited-p (or (null ,tempvar)
+ (get-file-buffer (expand-file-name ,tempvar))))
+ (point (point)) to-be-removed)
+ (save-window-excursion
+ (when ,tempvar (find-file ,tempvar))
+ (setq to-be-removed (current-buffer))
+ (goto-char (point-min))
+ (while (re-search-forward org-babel-lob-one-liner-regexp nil t)
+ (goto-char (match-beginning 1))
+ (save-match-data ,@body)
+ (goto-char (match-end 0))))
+ (unless visited-p (kill-buffer to-be-removed))
+ (goto-char point))))
+(def-edebug-spec org-babel-map-call-lines (form body))
+
+;;;###autoload
+(defmacro org-babel-map-executables (file &rest body)
+ (declare (indent 1))
+ (let ((tempvar (make-symbol "file"))
+ (rx (make-symbol "rx")))
+ `(let* ((,tempvar ,file)
+ (,rx (concat "\\(" org-babel-src-block-regexp
+ "\\|" org-babel-inline-src-block-regexp
+ "\\|" org-babel-lob-one-liner-regexp "\\)"))
+ (visited-p (or (null ,tempvar)
+ (get-file-buffer (expand-file-name ,tempvar))))
+ (point (point)) to-be-removed)
+ (save-window-excursion
+ (when ,tempvar (find-file ,tempvar))
+ (setq to-be-removed (current-buffer))
+ (goto-char (point-min))
+ (while (re-search-forward ,rx nil t)
+ (goto-char (match-beginning 1))
+ (when (looking-at org-babel-inline-src-block-regexp)(forward-char 1))
+ (save-match-data ,@body)
+ (goto-char (match-end 0))))
+ (unless visited-p (kill-buffer to-be-removed))
+ (goto-char point))))
+(def-edebug-spec org-babel-map-executables (form body))
;;;###autoload
(defun org-babel-execute-buffer (&optional arg)
@@ -752,10 +1001,10 @@ the current buffer."
(interactive "P")
(org-babel-eval-wipe-error-buffer)
(org-save-outline-visibility t
- (org-babel-map-src-blocks nil
- (org-babel-execute-src-block arg))
- (org-babel-map-inline-src-blocks nil
- (org-babel-execute-src-block arg))))
+ (org-babel-map-executables nil
+ (if (looking-at org-babel-lob-one-liner-regexp)
+ (org-babel-lob-execute-maybe)
+ (org-babel-execute-src-block arg)))))
;;;###autoload
(defun org-babel-execute-subtree (&optional arg)
@@ -778,13 +1027,13 @@ 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-seq (cdr arg))
+ (copy-sequence (cdr arg))
(cdr arg))))
(when (and v (not (and (sequencep v)
(not (consp v))
@@ -792,19 +1041,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))) ":")
@@ -812,9 +1061,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.
@@ -900,8 +1157,11 @@ portions of results lines."
(beginning-of-line)
(if (re-search-forward org-babel-result-regexp nil t)
(let ((start (progn (beginning-of-line 2) (- (point) 1)))
- (end (progn (goto-char (- (org-babel-result-end) 1)) (point)))
- ov)
+ (end (progn
+ (while (looking-at org-babel-multi-line-header-regexp)
+ (forward-line 1))
+ (goto-char (- (org-babel-result-end) 1)) (point)))
+ ov)
(if (memq t (mapcar (lambda (overlay)
(eq (overlay-get overlay 'invisible)
'org-babel-hide-result))
@@ -944,126 +1204,163 @@ Return an association list of any source block params which
may be specified in the properties of the current outline entry."
(save-match-data
(let (val sym)
- (delq nil
- (mapcar
- (lambda (header-arg)
- (and (setq val
- (or (org-entry-get (point) header-arg t)
- (org-entry-get (point) (concat ":" header-arg) t)))
- (cons (intern (concat ":" header-arg))
- (org-babel-read val))))
+ (org-babel-parse-multiple-vars
+ (delq nil
(mapcar
- 'symbol-name
- (append
- org-babel-header-arg-names
- (progn
- (setq sym (intern (concat "org-babel-header-arg-names:" lang)))
- (and (boundp sym) (eval sym))))))))))
-
-(defun org-babel-params-from-buffer ()
- "Retrieve per-buffer parameters.
- Return an association list of any source block params which
-may be specified in the current buffer."
- (let (local-properties)
- (save-match-data
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward
- (org-make-options-regexp (list "BABEL" "PROPERTIES")) nil t)
- (setq local-properties
- (org-babel-merge-params
- local-properties
- (org-babel-parse-header-arguments
- (org-match-string-no-properties 2)))))
- local-properties)))))
+ (lambda (header-arg)
+ (and (setq val (org-entry-get (point) header-arg t))
+ (cons (intern (concat ":" header-arg))
+ (org-babel-read val))))
+ (mapcar
+ #'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 (string= "\n" (substring body sub-length))
+ (if (and (> sub-length 0)
+ (string= "\n" (substring body sub-length)))
(substring body 0 sub-length)
- body))))
+ (or body "")))))
(preserve-indentation (or org-src-preserve-indentation
- (string-match "-i\\>" switches))))
+ (save-match-data
+ (string-match "-i\\>" switches)))))
(list lang
;; get block body less properties, protective commas, and indentation
(with-temp-buffer
(save-match-data
- (insert (org-babel-strip-protective-commas body))
+ (insert (org-unescape-code-in-string body))
(unless preserve-indentation (org-do-remove-indentation))
(buffer-string)))
(org-babel-merge-params
org-babel-default-header-args
- (org-babel-params-from-buffer)
(org-babel-params-from-properties lang)
(if (boundp lang-headers) (eval lang-headers) nil)
(org-babel-parse-header-arguments
- (org-babel-clean-text-properties (or (match-string 4) ""))))
+ (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)))
+ (org-unescape-code-in-string (org-no-properties (match-string 5)))
(org-babel-merge-params
org-babel-default-inline-header-args
- (org-babel-params-from-buffer)
(org-babel-params-from-properties lang)
(if (boundp lang-headers) (eval lang-headers) nil)
(org-babel-parse-header-arguments
- (org-babel-clean-text-properties (or (match-string 4) "")))))))
+ (org-no-properties (or (match-string 4) "")))))))
+
+(defun org-babel-balanced-split (string alts)
+ "Split STRING on instances of ALTS.
+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)."
+ (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."
+ (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 (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."
(when (> (length arg-string) 0)
- (delq nil
- (mapcar
- (lambda (arg)
- (if (string-match
- "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)"
- arg)
- (cons (intern (match-string 1 arg))
- (org-babel-read (org-babel-chomp (match-string 2 arg))))
- (cons (intern (org-babel-chomp arg)) nil)))
- (let ((balance 0) (partial nil) (lst nil) (last 0))
- (mapc (lambda (ch) ; split on [] balanced instances of [ \t]:
- (setq balance (+ balance
- (cond ((equal 91 ch) 1)
- ((equal 93 ch) -1)
- (t 0))))
- (setq partial (cons ch partial))
- (when (and (= ch 58) (= balance 0)
- (or (= last 32) (= last 9)))
- (setq lst (cons (apply #'string (nreverse (cddr partial)))
- lst))
- (setq partial (list ch)))
- (setq last ch))
- (string-to-list arg-string))
- (nreverse (cons (apply #'string (nreverse partial)) lst)))))))
+ (org-babel-parse-multiple-vars
+ (delq nil
+ (mapcar
+ (lambda (arg)
+ (if (string-match
+ "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)"
+ arg)
+ (cons (intern (match-string 1 arg))
+ (org-babel-read (org-babel-chomp (match-string 2 arg))))
+ (cons (intern (org-babel-chomp arg)) nil)))
+ ((lambda (raw)
+ (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw))))
+ (org-babel-balanced-split arg-string '((32 9) . 58))))))))
+
+(defun org-babel-parse-multiple-vars (header-arguments)
+ "Expand multiple variable assignments behind a single :var keyword.
+
+This allows expression of multiple variables with one :var as
+shown below.
+
+#+PROPERTY: var foo=1, bar=2"
+ (let (results)
+ (mapc (lambda (pair)
+ (if (eq (car pair) :var)
+ (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results))
+ (org-babel-join-splits-near-ch
+ 61 (org-babel-balanced-split (cdr pair) 32)))
+ (push pair results)))
+ header-arguments)
+ (nreverse results)))
(defun org-babel-process-params (params)
"Expand variables in PARAMS and add summary parameters."
- (let* ((vars-and-names (org-babel-disassemble-tables
- (mapcar (lambda (el)
- (if (consp (cdr el))
- (cdr el) (org-babel-ref-parse (cdr el))))
- (org-babel-get-header params :var))
- (cdr (assoc :hlines params))
- (cdr (assoc :colnames params))
- (cdr (assoc :rownames params))))
+ (let* ((processed-vars (mapcar (lambda (el)
+ (if (consp (cdr el))
+ (cdr el)
+ (org-babel-ref-parse (cdr el))))
+ (org-babel-get-header params :var)))
+ (vars-and-names (if (and (assoc :colname-names params)
+ (assoc :rowname-names params))
+ (list processed-vars)
+ (org-babel-disassemble-tables
+ processed-vars
+ (cdr (assoc :hlines params))
+ (cdr (assoc :colnames params))
+ (cdr (assoc :rownames params)))))
(raw-result (or (cdr (assoc :results params)) ""))
(result-params (append
(split-string (if (stringp raw-result)
@@ -1102,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."
@@ -1170,7 +1467,7 @@ of the vars, cnames and rnames."
(setq var (cons (car var) (org-babel-del-hlines (cdr var))))))
var)
vars)
- cnames rnames)))
+ (reverse cnames) (reverse rnames))))
(defun org-babel-reassemble-table (table colnames rownames)
"Add column and row names to a table.
@@ -1190,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)
@@ -1198,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
@@ -1219,42 +1517,65 @@ 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)
(regexp (org-babel-named-src-block-regexp-for-name name)) msg)
(goto-char (point-min))
(when (or (re-search-forward regexp nil t)
- (re-search-backward regexp nil t))
+ (re-search-backward regexp nil t))
(match-beginning 0)))))
(defun org-babel-src-block-names (&optional file)
"Returns the names of source blocks in FILE or the current buffer."
(save-excursion
(when file (find-file file)) (goto-char (point-min))
- (let (names)
+ (let ((case-fold-search t) names)
(while (re-search-forward org-babel-src-name-w-name-regexp nil t)
- (setq names (cons (match-string 4) names)))
+ (setq names (cons (match-string 3) names)))
names)))
;;;###autoload
@@ -1270,22 +1591,29 @@ org-babel-named-src-block-regexp."
(progn (goto-char point) (org-show-context))
(message "result '%s' not found in this buffer" name))))
-(defun org-babel-find-named-result (name)
+(defun org-babel-find-named-result (name &optional point)
"Find a named result.
Return the location of the result named NAME in the current
buffer or nil if no such result exists."
(save-excursion
- (goto-char (point-min))
- (when (re-search-forward
- (concat org-babel-result-regexp
- "[ \t]" (regexp-quote name) "[ \t\n\f\v\r]") nil t)
- (beginning-of-line 0) (point))))
+ (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)))
@@ -1315,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
@@ -1334,6 +1662,8 @@ is created. In both cases if the region is demarcated and if the
region is not active then the point is demarcated."
(interactive "P")
(let ((info (org-babel-get-src-block-info 'light))
+ (headers (progn (org-babel-where-is-src-block-head)
+ (match-string 4)))
(stars (concat (make-string (or (org-current-level) 1) ?*) " ")))
(if info
(mapc
@@ -1346,19 +1676,24 @@ region is not active then the point is demarcated."
(buffer-substring (point-at-bol)
(point-at-eol)))
(delete-region (point-at-bol) (point-at-eol)))
- (insert (concat (if (looking-at "^") "" "\n")
- indent "#+end_src\n"
- (if arg stars indent) "\n"
- indent "#+begin_src " lang
- (if (looking-at "[\n\r]") "" "\n")))))
+ (insert (concat
+ (if (looking-at "^") "" "\n")
+ indent "#+end_src\n"
+ (if arg stars indent) "\n"
+ indent "#+begin_src " lang
+ (if (> (length headers) 1)
+ (concat " " headers) headers)
+ (if (looking-at "[\n\r]")
+ ""
+ (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"
@@ -1369,7 +1704,6 @@ region is not active then the point is demarcated."
(goto-char start) (move-end-of-line 1)))))
(defvar org-babel-lob-one-liner-regexp)
-(defvar org-babel-inline-lob-one-liner-regexp)
(defun org-babel-where-is-src-block-result (&optional insert info hash indent)
"Find where the current source block results begin.
Return the point at the beginning of the result of the current
@@ -1377,16 +1711,15 @@ 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 (save-excursion
- (re-search-backward "[ \f\t\n\r\v]" nil t)
- (when (looking-at org-babel-inline-src-block-regexp)
- (match-end 0))))
+ (inlinep (when (org-babel-get-inline-src-block-matches)
+ (match-end 0)))
(name (if on-lob-line
- (nth 0 (org-babel-lob-get-info))
- (nth 4 (or info (org-babel-get-src-block-info)))))
+ (mapconcat #'identity (butlast (org-babel-lob-get-info)) "")
+ (nth 4 (or info (org-babel-get-src-block-info 'light)))))
(head (unless on-lob-line (org-babel-where-is-src-block-head)))
found beg end)
(when head (goto-char head))
@@ -1438,7 +1771,7 @@ following the source block."
(lambda (el) " ")
(org-number-sequence 1 indent) "")
"")
- "#+results"
+ "#+" org-babel-results-keyword
(when hash (concat "["hash"]"))
":"
(when name (concat " " name)) "\n"))
@@ -1492,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
@@ -1504,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)
@@ -1522,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
@@ -1538,12 +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.
-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.
+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 ----- 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
@@ -1560,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
@@ -1571,10 +1904,8 @@ code ---- the results are extracted in the syntax of the source
(save-excursion
(let* ((inlinep
(save-excursion
- (or (= (point) (point-at-bol))
- (re-search-backward "[ \f\t\n\r\v]" nil t))
- (when (or (looking-at org-babel-inline-src-block-regexp)
- (looking-at org-babel-inline-lob-one-liner-regexp))
+ (when (or (org-babel-get-inline-src-block-matches)
+ (org-babel-get-lob-one-liner-matches))
(goto-char (match-end 0))
(insert (if (listp result) "\n" " "))
(point))))
@@ -1606,58 +1937,68 @@ 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) ""))
- ;; insert results based on type
- (cond
- ;; do nothing for an empty result
- ((= (length result) 0))
- ;; insert a list if preferred
- ((member "list" result-params)
- (insert
- (org-babel-trim
- (org-list-to-generic
- (cons 'unordered
- (mapcar
- (lambda (el) (list nil (if (stringp el) el (format "%S" el))))
- (if (listp result) result (list result))))
- '(:splicep nil :istart "- " :iend "\n")))
- "\n"))
- ;; assume the result is a table if it's not a string
- ((not (stringp result))
- (goto-char beg)
- (insert (concat (orgtbl-to-orgtbl
- (if (or (eq 'hline (car result))
- (and (listp (car result))
- (listp (cdr (car result)))))
- result (list result))
- '(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
- (goto-char beg) (when (org-at-table-p) (org-table-align)))
- ((member "file" result-params)
- (insert result))
- (t (goto-char beg) (insert result)))
- (when (listp result) (goto-char (org-table-end)))
- (setq end (point-marker))
- ;; possibly wrap result
- (flet ((wrap (start finish)
- (goto-char beg) (insert (concat start "\n"))
- (goto-char end) (insert (concat finish "\n"))
- (setq end (point-marker))))
+ (let ((wrap (lambda (start finish)
+ (goto-char end) (insert (concat finish "\n"))
+ (goto-char beg) (insert (concat start "\n"))
+ (org-escape-code-in-region (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
+ ((null result))
+ ;; insert a list if preferred
+ ((member "list" result-params)
+ (insert
+ (org-babel-trim
+ (org-list-to-generic
+ (cons 'unordered
+ (mapcar
+ (lambda (el) (list nil (if (stringp el) el (format "%S" el))))
+ (if (listp result) result (list result))))
+ '(:splicep nil :istart "- " :iend "\n")))
+ "\n"))
+ ;; assume the result is a table if it's not a string
+ ((funcall proper-list-p result)
+ (goto-char beg)
+ (insert (concat (orgtbl-to-orgtbl
+ (if (or (eq 'hline (car result))
+ (and (listp (car result))
+ (listp (cdr (car result)))))
+ result (list result))
+ '(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
+ (goto-char beg) (when (org-at-table-p) (org-table-align)))
+ ((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 (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"))
+ ((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)
- (when (and (stringp result) (not (member "file" result-params)))
- (org-babel-examplize-region beg end results-switches))
- (wrap "#+BEGIN_RESULT" "#+END_RESULT"))
- ((and (stringp result) (not (member "file" result-params)))
+ ((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)))))
;; possibly indent the results to match the #+results line
@@ -1666,7 +2007,7 @@ code ---- the results are extracted in the syntax of the source
(not (and (listp result)
(member "append" result-params))))
(indent-rigidly beg end indent))))
- (if (= (length result) 0)
+ (if (null result)
(if (member "value" result-params)
(message "Code block returned no value.")
(message "Code block produced no output."))
@@ -1677,53 +2018,59 @@ code ---- the results are extracted in the syntax of the source
(interactive)
(let ((location (org-babel-where-is-src-block-result nil info)) start)
(when location
+ (setq start (- location 1))
(save-excursion
- (goto-char location) (setq start (point)) (forward-line 1)
+ (goto-char location) (forward-line 1)
(delete-region start (org-babel-result-end))))))
(defun org-babel-result-end ()
- "Return the point at the end of the current set of results"
+ "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)))
+ ((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.")
(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) (string-match "[\\S]" (buffer-substring b e))))
- (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)
@@ -1738,15 +2085,17 @@ file's directory then expand relative links."
(t
(goto-char beg)
(insert (if results-switches
- (format "#+begin_example%s\n" results-switches)
- "#+begin_example\n"))
+ (format "%s%s\n"
+ (funcall maybe-cap "#+begin_example")
+ results-switches)
+ (funcall maybe-cap "#+begin_example\n")))
(if (markerp end) (goto-char end) (forward-char (- end beg)))
- (insert "#+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)))
@@ -1756,101 +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
- '(("file" "list" "vector" "table" "scalar" "verbatim" "raw" "org"
- "html" "latex" "code" "pp" "wrap")
- ("replace" "silent" "append" "prepend")
- ("output" "value")))
- (exports-exclusive-groups
- '(("code" "results" "both" "none")))
- (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, then assign to variables in order
- (prog1 (setf (cddr (nth variable-index vars))
- (concat (symbol-name
- (car (nth variable-index vars)))
- "=" (cdr pair)))
- (incf variable-index)))))
- (: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
@@ -1861,6 +2217,27 @@ parameters when merging lists."
'(results exports tangle noweb padline cache shebang comments))
params))
+(defvar *org-babel-use-quick-and-dirty-noweb-expansion* nil
+ "Set to true to use regular expressions to expand noweb references.
+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.
@@ -1895,91 +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)))))
- (new-body "") index source-name evaluate prefix blocks-in-buffer)
- (flet ((nb-add (text) (setq new-body (concat new-body text)))
- (c-wrap (text)
+ (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|"
+ ":noweb-ref[ \t]+" "\\)"))
+ (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))))
- (blocks () ;; return the info lists of all blocks in this buffer
- (let (infos)
- (save-restriction
- (widen)
- (org-babel-map-src-blocks nil
- (setq infos (cons (org-babel-get-src-block-info 'light)
- infos))))
- (reverse infos))))
- (with-temp-buffer
- (insert body) (goto-char (point-min))
- (setq index (point))
- (while (and (re-search-forward "<<\\(.+?\\)>>" nil t))
- (save-match-data (setf source-name (match-string 1)))
- (save-match-data (setq evaluate (string-match "\(.*\)" source-name)))
- (save-match-data
- (setq prefix
- (buffer-substring (match-beginning 0)
- (save-excursion
- (beginning-of-line 1) (point)))))
- ;; add interval to new-body (removing noweb reference)
- (goto-char (match-beginning 0))
- (nb-add (buffer-substring index (point)))
- (goto-char (match-end 0))
- (setq index (point))
- (nb-add
- (with-current-buffer parent-buffer
- (mapconcat ;; interpose PREFIX between every line
- #'identity
- (split-string
- (if evaluate
- (let ((raw (org-babel-ref-resolve 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
- (mapconcat
- (lambda (i)
- (when (string= source-name
- (or (cdr (assoc :noweb-ref (nth 2 i)))
- (nth 4 i)))
- (let ((body (org-babel-expand-noweb-references i)))
- (if comment
- ((lambda (cs)
- (concat (c-wrap (car cs)) "\n"
- body "\n" (c-wrap (cadr cs))))
- (org-babel-tangle-comment-links i))
- body))))
- (or blocks-in-buffer
- (setq blocks-in-buffer (blocks)))
- "")
- ;; 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)))))
+ (org-babel-trim (buffer-string)))))
+ 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)
- "Strip protective commas from bodies of source blocks."
- (when body
- (replace-regexp-in-string "^,#" "#" body)))
-
(defun org-babel-script-escape (str &optional force)
"Safely convert tables into elisp lists."
(let (in-single in-double out)
@@ -2058,14 +2448,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)))
@@ -2079,7 +2469,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."
@@ -2106,7 +2496,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 "")))
@@ -2118,7 +2508,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)))
@@ -2128,17 +2518,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))))
@@ -2199,6 +2588,8 @@ of `org-babel-temporary-directory'."
(provide 'ob)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; ob.el ends here
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index a54f3c4c3d3..36f3fcb9974 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -1,11 +1,10 @@
;;; org-agenda.el --- Dynamic task and appointment lists for Org
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -26,10 +25,28 @@
;;; Commentary:
;; This file contains the code for creating and using the Agenda for Org-mode.
+;;
+;; 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
+;; it is not necessary to quote the parameters passed to one of those
+;; 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
+;; have been implemented as a regular function you'd have to quote the
+;; 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.
+;;
;;; Code:
(require 'org)
+(require 'org-macs)
(eval-when-compile
(require 'cl))
@@ -50,6 +67,8 @@
(declare-function calendar-julian-date-string "cal-julian" (&optional date))
(declare-function calendar-mayan-date-string "cal-mayan" (&optional date))
(declare-function calendar-persian-date-string "cal-persia" (&optional date))
+(declare-function calendar-check-holidays "holidays" (date))
+
(declare-function org-datetree-find-date-create "org-datetree"
(date &optional keep-restriction))
(declare-function org-columns-quit "org-colview" ())
@@ -60,23 +79,32 @@
(declare-function org-is-habit-p "org-habit" (&optional pom))
(declare-function org-habit-parse-todo "org-habit" (&optional pom))
(declare-function org-habit-get-priority "org-habit" (habit &optional moment))
-
-(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-pop-to-buffer-same-window "org-compat"
+ (&optional buffer-or-name norecord label))
+(declare-function org-agenda-columns "org-colview" ())
+(declare-function org-add-archive-files "org-archive" (files))
+(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
@@ -107,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."
@@ -132,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))
@@ -141,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.
@@ -156,11 +184,11 @@ and `org-agenda-entry-text-maxlines'."
"Non-nil means export org-links as descriptive links in agenda added text.
This variable applies to the text added to the agenda when
`org-agenda-add-entry-text-maxlines' is larger than 0.
-When this variable is nil, the URL will (also) be shown."
+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'.
@@ -196,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)
@@ -208,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
@@ -225,112 +252,127 @@ you can \"misuse\" it to also add other text to the header. However,
(const user-defined-up) (const user-defined-down))
"Sorting choices.")
+;; Keep custom values for `org-agenda-filter-preset' compatible with
+;; the new variable `org-agenda-tag-filter-preset'.
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
+ (defvaralias 'org-agenda-filter 'org-agenda-tag-filter))
+
(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 "Tags filter preset"
- (const org-agenda-filter-preset)
- (list
- (const :format "" quote)
- (repeat
- (string :tag "+tag or -tag"))))
- (list :tag "Set daily/weekly entry types"
- (const org-agenda-entry-types)
- (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)
- (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)
+ (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")))))
- (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'.")
-(defcustom org-agenda-custom-commands nil
+(defcustom org-agenda-custom-commands '(("n" "Agenda and all TODO's"
+ ((agenda "") (alltodo))))
"Custom commands for the agenda.
These commands will be offered on the splash screen displayed by the
agenda dispatcher \\[org-agenda]. Each entry is a list like this:
@@ -339,7 +381,7 @@ agenda dispatcher \\[org-agenda]. Each entry is a list like this:
key The key (one or more characters as a string) to be associated
with the command.
-desc A description of the command; when omitted or nil, a default
+desc A description of the command, when omitted or nil, a default
description is built using MATCH.
type The command type, any of the following symbols:
agenda The daily/weekly agenda.
@@ -354,7 +396,7 @@ type The command type, any of the following symbols:
match What to search for:
- a single keyword for TODO keyword searches
- a tags match expression for tags searches
- - a word search expression for text searches
+ - a word search expression for text searches.
- a regular expression for occur searches
For all other commands, this should be the empty string.
settings A list of option settings, similar to that in a let form, so like
@@ -363,7 +405,7 @@ settings A list of option settings, similar to that in a let form, so like
files A list of files file to write the produced agenda buffer to
with the command `org-store-agenda-views'.
If a file name ends in \".html\", an HTML version of the buffer
- is written out. If it ends in \".ps\", a PostScript version is
+ is written out. If it ends in \".ps\", a postscript version is
produced. Otherwise, only the plain text is written to the file.
You can also define a set of commands, to create a composite agenda buffer.
@@ -375,7 +417,7 @@ where
desc A description string to be displayed in the dispatcher menu.
cmd An agenda command, similar to the above. However, tree commands
- are no allowed, but instead you can get agenda and global todo list.
+ are not allowed, but instead you can get agenda and global todo list.
So valid commands for a set are:
(agenda \"\" settings)
(alltodo \"\" settings)
@@ -401,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.
@@ -517,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.
@@ -603,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.
@@ -616,6 +658,7 @@ See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
to make his option also apply to the tags-todo list."
:group 'org-agenda-skip
:group 'org-agenda-todo-list
+ :version "24.1"
:type '(choice
(const :tag "Ignore future timestamp todos" future)
(const :tag "Ignore past or present timestamp todos" past)
@@ -640,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'.
@@ -681,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'.
@@ -740,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.
@@ -763,12 +821,13 @@ trigger you to schedule it, and then you don't want to be reminded of it
because you will take care of it on the day when scheduled."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
+ :version "24.1"
:type '(choice
(const :tag "Always show prewarning" nil)
(const :tag "Remove prewarning if entry is scheduled" t)
(integer :tag "Restart prewarning N days before deadline")))
-(defcustom org-agenda-skip-additional-timestamps-same-entry t
+(defcustom org-agenda-skip-additional-timestamps-same-entry nil
"When nil, multiple same-day timestamps in entry make multiple agenda lines.
When non-nil, after the search for timestamps has matched once in an
entry, the rest of the entry will not be searched."
@@ -825,19 +884,29 @@ 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."
:group 'org-agenda
+ :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)
@@ -853,6 +922,13 @@ Needs to be set before org.el is loaded."
:group 'org-agenda-startup
:type 'boolean)
+(defcustom org-agenda-follow-indirect nil
+ "Non-nil means `org-agenda-follow-mode' displays only the
+current item's tree, in an indirect buffer."
+ :group 'org-agenda
+ :version "24.1"
+ :type 'boolean)
+
(defcustom org-agenda-show-outline-path t
"Non-nil means show outline path in echo area after line motion."
:group 'org-agenda-startup
@@ -888,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."
@@ -931,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")
@@ -1003,11 +1080,13 @@ This function makes sure that dates are aligned for easy reading."
"Non-nil means use leading zero for military times in agenda.
For example, 9:30am would become 09:30 rather than 9:30."
:group 'org-agenda-daily/weekly
+ :version "24.1"
:type 'boolean)
(defcustom org-agenda-timegrid-use-ampm nil
"When set, show AM/PM style timestamps on the timegrid."
:group 'org-agenda
+ :version "24.1"
:type 'boolean)
(defun org-agenda-time-of-day-to-ampm (time)
@@ -1048,6 +1127,16 @@ and timeline buffers."
(const :tag "Saturday" 6)
(const :tag "Sunday" 0)))
+(defcustom org-agenda-move-date-from-past-immediately-to-today t
+ "Non-nil means jump to today when moving a past date forward in time.
+When using S-right in the agenda to move a a date forward, and the date
+stamp currently points to the past, the first key press will move it
+to today. WHen nil, just move one day forward even if the date stays
+in the past."
+ :group 'org-agenda-daily/weekly
+ :version "24.1"
+ :type 'boolean)
+
(defcustom org-agenda-include-diary nil
"If non-nil, include in the agenda entries from the Emacs Calendar's diary.
Custom commands can set this variable in the options section."
@@ -1058,14 +1147,7 @@ Custom commands can set this variable in the options section."
"If non-nil, include entries within their deadline warning period.
Custom commands can set this variable in the options section."
:group 'org-agenda-daily/weekly
- :type 'boolean)
-
-(defcustom org-agenda-include-all-todo nil
- "Set means weekly/daily agenda will always contain all TODO entries.
-The TODO entries will be listed at the top of the agenda, before
-the entries for specific days.
-This option is deprecated, it is better to define a block agenda instead."
- :group 'org-agenda-daily/weekly
+ :version "24.1"
:type 'boolean)
(defcustom org-agenda-repeating-timestamp-show-all t
@@ -1141,6 +1223,7 @@ issue display.
:short-face face for clock intervals that are too short"
:group 'org-agenda-daily/weekly
:group 'org-clock
+ :version "24.1"
:type 'plist)
(defcustom org-agenda-log-mode-add-notes t
@@ -1152,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."
@@ -1199,6 +1290,7 @@ by preceding the first snippet with \"+\" or \"-\". If the first snippet
is a regexp marked with braces like \"{abc}\", this will also switch to
boolean search."
:group 'org-agenda-search-view
+ :version "24.1"
:type 'boolean)
(if (fboundp 'defvaralias)
@@ -1209,6 +1301,7 @@ boolean search."
"Non-nil means, search words must be matches as complete words.
When nil, they may also match part of a word."
:group 'org-agenda-search-view
+ :version "24.1"
:type 'boolean)
(defgroup org-agenda-time-grid nil
@@ -1272,12 +1365,14 @@ a grid line."
(defcustom org-agenda-show-current-time-in-grid t
"Non-nil means show the current time in the time grid."
:group 'org-agenda-time-grid
+ :version "24.1"
:type 'boolean)
(defcustom org-agenda-current-time-string
"now - - - - - - - - - - - - - - - - - - - - - - - - -"
"The string for the current time marker in the agenda."
:group 'org-agenda-time-grid
+ :version "24.1"
:type 'string)
(defgroup org-agenda-sorting nil
@@ -1396,6 +1491,7 @@ This format works similar to a printf format, with the following meaning:
%c the category of the item, \"Diary\" for entries from the diary,
or as given by the CATEGORY keyword or derived from the file name
+ %e the effort required by the item
%i the icon category of the item, see `org-agenda-category-icon-alist'
%T the last tag of the item (ignore inherited tags, which come first)
%t the HH:MM time-of-day specification if one applies to the entry
@@ -1446,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.
@@ -1456,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
@@ -1487,6 +1595,7 @@ that passed since this item was scheduled first."
"Text preceding item pulled into the agenda by inactive time stamps.
These entries are added to the agenda when pressing \"[\"."
:group 'org-agenda-line-format
+ :version "24.1"
:type '(list
(string :tag "Scheduled today ")
(string :tag "Scheduled previously")))
@@ -1525,6 +1634,7 @@ the headline/diary entry."
"Non-nil means remove time ranges specifications in agenda
items that span on several days."
:group 'org-agenda-line-format
+ :version "24.1"
:type 'boolean)
(defcustom org-agenda-default-appointment-duration nil
@@ -1602,10 +1712,11 @@ 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
+ :version "24.1"
:type 'function)
(defcustom org-agenda-category-icon-alist nil
@@ -1638,6 +1749,7 @@ category, you can use:
(\"Emacs\" '(space . (:width (16))))"
:group 'org-agenda-line-format
+ :version "24.1"
:type '(alist :key-type (string :tag "Regexp matching category")
:value-type (choice (list :tag "Icon"
(string :tag "File or data")
@@ -1700,23 +1812,22 @@ With selected entries in an agenda buffer, `B R' will call
the custom function `set-category' on the selected entries.
Note that functions in this alist don't need to be quoted."
:type 'alist
+ :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
in that string. If STRING is nil, it will be fetched from the beginning
of the current line."
- `(let ((marker (get-text-property (if string 0 (point-at-bol))
- 'org-hd-marker string)))
- (with-current-buffer (marker-buffer marker)
- (save-excursion
- (goto-char marker)
- ,@body))))
+ (org-with-gensyms (marker)
+ `(let ((,marker (get-text-property (if string 0 (point-at-bol))
+ 'org-hd-marker ,string)))
+ (with-current-buffer (marker-buffer ,marker)
+ (save-excursion
+ (goto-char ,marker)
+ ,@body)))))
+(def-edebug-spec org-agenda-with-point-at-orig-entry (form body))
(defun org-add-agenda-custom-command (entry)
"Replace or add a command in `org-agenda-custom-commands'.
@@ -1727,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'.")
@@ -1735,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)
@@ -1743,10 +1854,82 @@ 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"))))))
+
+(autoload 'org-toggle-sticky-agenda "org-agenda" "\
+Toggle `org-agenda-sticky'.
+
+\(fn &optional ARG)" t nil)
+
+(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.
@@ -1755,7 +1938,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)
@@ -1767,14 +1973,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
@@ -1806,11 +2011,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)
@@ -1839,8 +2046,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)
@@ -1851,7 +2056,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)
@@ -1862,21 +2067,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-write-agenda)
+(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
@@ -1884,8 +2091,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)
@@ -1918,6 +2125,8 @@ The following commands are available:
(org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
(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)
@@ -1971,7 +2180,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)
@@ -1984,16 +2193,17 @@ The following commands are available:
:keys "v A"]
"--"
["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
- ["Write view to file" org-write-agenda t]
+ ["Write view to file" org-agenda-write t]
["Rebuild buffer" org-agenda-redo t]
["Save all Org-mode Buffers" org-save-all-org-buffers t]
"--"
["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]
@@ -2012,10 +2222,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]
@@ -2027,11 +2238,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"]
@@ -2052,7 +2258,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)]
@@ -2081,12 +2287,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.
@@ -2130,14 +2332,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:
@@ -2152,6 +2400,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.
@@ -2173,6 +2422,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
@@ -2190,9 +2440,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)
@@ -2207,10 +2460,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))
@@ -2229,11 +2488,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)
@@ -2241,44 +2504,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 ()
@@ -2294,27 +2558,66 @@ Pressing `<' twice means to restrict to the current subtree or region
(copy-sequence note))
nil 'face 'org-warning)))))))
t t))
- ((equal keys "L")
- (unless (org-mode-p)
+ ((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"))))))
+(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
+on to the selected command. The default selections are:
+
+a Call `org-agenda-list' to display the agenda for current day or week.
+t Call `org-todo-list' to display the global todo list.
+T Call `org-todo-list' to display the global todo list, select only
+ entries with a specific TODO keyword (the user gets a prompt).
+m Call `org-tags-view' to display headlines with tags matching
+ a condition (the user is prompted for the condition).
+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.
+ Press several times to get the desired effect.
+> Remove a previous restriction.
+# List \"stuck\" projects.
+! Configure what \"stuck\" means.
+C Configure custom agenda commands.
+
+More commands can be added by configuring the variable
+`org-agenda-custom-commands'. In particular, specific tags and TODO keyword
+searches can be pre-defined in this way.
+
+If the current buffer is in Org-mode and visiting a file, you can also
+first press `<' once to indicate that the agenda should be temporarily
+\(until the next use of \\[org-agenda]) restricted to the current file.
+Pressing `<' twice means to restrict to the current subtree or region
+\(if active).
+
+\(fn &optional ARG ORG-KEYS RESTRICTION)" t nil)
+
(defun org-agenda-append-agenda ()
"Append another agenda view to the current one.
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
@@ -2330,7 +2633,7 @@ Agenda views are separated by `org-agenda-block-separator'."
"The user interface for selecting an agenda command."
(catch 'exit
(let* ((bfn (buffer-file-name (buffer-base-buffer)))
- (restrict-ok (and bfn (org-mode-p)))
+ (restrict-ok (and bfn (derived-mode-p 'org-mode)))
(region-p (org-region-active-p))
(custom org-agenda-custom-commands)
(selstring "")
@@ -2343,15 +2646,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
@@ -2411,13 +2714,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
@@ -2434,7 +2736,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))
@@ -2484,6 +2786,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))
@@ -2505,7 +2810,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)
@@ -2514,55 +2819,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)
@@ -2572,23 +2894,23 @@ If CMD-KEY is a string of length 1, it is used as a key in
longer string it is used as a tags/todo match string.
Parameters are alternating variable names and values that will be bound
before running the agenda command."
- (let (pars)
- (while parameters
- (push (list (pop parameters) (if parameters (pop parameters))) pars))
+ (org-eval-in-environment (org-make-parameter-alist parameters)
(if (> (length cmd-key) 2)
- (eval (list 'let (nreverse pars)
- (list 'org-tags-view nil cmd-key)))
- (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key))))
- (set-buffer org-agenda-buffer-name)
- (princ (org-encode-for-stdout (buffer-string)))))
+ (org-tags-view nil cmd-key)
+ (org-agenda nil cmd-key)))
+ (set-buffer org-agenda-buffer-name)
+ (princ (buffer-string)))
-;(defun org-encode-for-stdout (string)
-; (if (fboundp 'encode-coding-string)
-; (encode-coding-string string buffer-file-coding-system)
-; string))
+(autoload 'org-batch-agenda "org-agenda" "\
+Run an agenda command in batch mode and send the result to STDOUT.
+If CMD-KEY is a string of length 1, it is used as a key in
+`org-agenda-custom-commands' and triggers this command. If it is a
+longer string it is used as a tags/todo match string.
+Parameters are alternating variable names and values that will be bound
+before running the agenda command.
-(defun org-encode-for-stdout (string)
- string)
+\(fn CMD-KEY &rest PARAMETERS)" nil t)
+(def-edebug-spec org-batch-agenda (form &rest sexp))
(defvar org-agenda-info nil)
@@ -2627,30 +2949,63 @@ extra Sting with extra planning info
priority-l The priority letter if any was given
priority-n The computed numerical priority
agenda-day The day in the agenda where this is listed"
-
- (let (pars)
- (while parameters
- (push (list (pop parameters) (if parameters (pop parameters))) pars))
- (push (list 'org-agenda-remove-tags t) pars)
+ (org-eval-in-environment (append '((org-agenda-remove-tags t))
+ (org-make-parameter-alist parameters))
(if (> (length cmd-key) 2)
- (eval (list 'let (nreverse pars)
- (list 'org-tags-view nil cmd-key)))
- (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key))))
- (set-buffer org-agenda-buffer-name)
- (let* ((lines (org-split-string (buffer-string) "\n"))
- line)
- (while (setq line (pop lines))
- (catch 'next
- (if (not (get-text-property 0 'org-category line)) (throw 'next nil))
- (setq org-agenda-info
- (org-fix-agenda-info (text-properties-at 0 line)))
- (princ
- (org-encode-for-stdout
- (mapconcat 'org-agenda-export-csv-mapper
- '(org-category txt type todo tags date time extra
- priority-letter priority agenda-day)
- ",")))
- (princ "\n"))))))
+ (org-tags-view nil cmd-key)
+ (org-agenda nil cmd-key)))
+ (set-buffer org-agenda-buffer-name)
+ (let* ((lines (org-split-string (buffer-string) "\n"))
+ line)
+ (while (setq line (pop lines))
+ (catch 'next
+ (if (not (get-text-property 0 'org-category line)) (throw 'next nil))
+ (setq org-agenda-info
+ (org-fix-agenda-info (text-properties-at 0 line)))
+ (princ
+ (mapconcat 'org-agenda-export-csv-mapper
+ '(org-category txt type todo tags date time extra
+ priority-letter priority agenda-day)
+ ","))
+ (princ "\n")))))
+
+(autoload 'org-batch-agenda-csv "org-agenda" "\
+Run an agenda command in batch mode and send the result to STDOUT.
+If CMD-KEY is a string of length 1, it is used as a key in
+`org-agenda-custom-commands' and triggers this command. If it is a
+longer string it is used as a tags/todo match string.
+Parameters are alternating variable names and values that will be bound
+before running the agenda command.
+
+The output gives a line for each selected agenda item. Each
+item is a list of comma-separated values, like this:
+
+category,head,type,todo,tags,date,time,extra,priority-l,priority-n
+
+category The category of the item
+head The headline, without TODO kwd, TAGS and PRIORITY
+type The type of the agenda entry, can be
+ todo selected in TODO match
+ tagsmatch selected in tags match
+ diary imported from diary
+ deadline a deadline on given date
+ scheduled scheduled on given date
+ timestamp entry has timestamp on given date
+ closed entry was closed on given date
+ upcoming-deadline warning about deadline
+ past-scheduled forwarded scheduled item
+ block entry has date block including g. date
+todo The todo keyword, if any
+tags All tags including inherited ones, separated by colons
+date The relevant date, like 2007-2-14
+time The time, like 15:00-16:50
+extra Sting with extra planning info
+priority-l The priority letter if any was given
+priority-n The computed numerical priority
+agenda-day The day in the agenda where this is listed
+
+\(fn CMD-KEY &rest PARAMETERS)" nil t)
+(def-edebug-spec org-batch-agenda-csv (form &rest sexp))
(defun org-fix-agenda-info (props)
"Make sure all properties on an agenda item have a canonical form.
@@ -2694,42 +3049,59 @@ 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)
(eval (list 'org-batch-store-agenda-views)))
-;; FIXME, why is this a macro?????
+(autoload 'org-store-agenda-views "org-agenda" "\
+
+
+\(fn &rest PARAMETERS)" t nil)
+
;;;###autoload
(defmacro org-batch-store-agenda-views (&rest parameters)
"Run all custom agenda commands that have a file argument."
(let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands))
(pop-up-frames nil)
(dir default-directory)
- pars cmd thiscmdkey files opts cmd-or-set)
- (while parameters
- (push (list (pop parameters) (if parameters (pop parameters))) pars))
- (setq pars (reverse pars))
+ (pars (org-make-parameter-alist parameters))
+ 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))
(if (stringp files) (setq files (list files)))
(when files
- (eval (list 'let (append org-agenda-exporter-settings opts pars)
- (list 'org-agenda nil thiscmdkey)))
- (set-buffer org-agenda-buffer-name)
+ (org-eval-in-environment (append org-agenda-exporter-settings
+ opts pars)
+ (org-agenda nil thiscmdkey))
+ (set-buffer bufname)
(while files
- (eval (list 'let (append org-agenda-exporter-settings opts pars)
- (list 'org-write-agenda
- (expand-file-name (pop files) dir) nil t))))
- (and (get-buffer org-agenda-buffer-name)
- (kill-buffer org-agenda-buffer-name)))))))
+ (org-eval-in-environment (append org-agenda-exporter-settings
+ opts pars)
+ (org-agenda-write (expand-file-name (pop files) dir) nil t bufname)))
+ (and (get-buffer bufname)
+ (kill-buffer bufname)))))))
+(autoload 'org-batch-store-agenda-views "org-agenda" "\
+Run all custom agenda commands that have a file argument.
+
+\(fn &rest PARAMETERS)" nil t)
+(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
@@ -2740,19 +3112,21 @@ 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)
-(defun org-write-agenda (file &optional open nosettings)
+(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 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.
-If the extension is .ics, run iCalendar export over all files used
+HTML (.html or .htm) or Postscript (.ps) is produced.
+If the extension is .ics, run icalendar export over all files used
to construct the agenda and limit the export to entries listed in the
agenda now.
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))
@@ -2763,7 +3137,7 @@ higher priority settings."
(let ((bs (copy-sequence (buffer-string))) beg)
(org-agenda-unmark-filtered-text)
(with-temp-buffer
- (rename-buffer "Agenda View" t)
+ (rename-buffer org-agenda-write-buffer-name t)
(set-buffer-modified-p nil)
(insert bs)
(org-agenda-remove-marked-text 'org-filtered)
@@ -2779,9 +3153,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)
@@ -2793,7 +3165,7 @@ higher priority settings."
((string-match "\\.ps\\'" file)
(require 'ps-print)
(ps-print-buffer-with-faces file)
- (message "PostScript written to %s" file))
+ (message "Postscript written to %s" file))
((string-match "\\.pdf\\'" file)
(require 'ps-print)
(ps-print-buffer-with-faces
@@ -2821,10 +3193,13 @@ 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-filter-overlays nil)
+(defvar org-agenda-tag-filter-overlays nil)
+(defvar org-agenda-cat-filter-overlays nil)
(defun org-agenda-mark-filtered-text ()
"Mark all text hidden by filtering with a text property."
@@ -2835,7 +3210,8 @@ higher priority settings."
(put-text-property
(overlay-start o) (overlay-end o)
'org-filtered t)))
- org-agenda-filter-overlays)))
+ (append org-agenda-tag-filter-overlays
+ org-agenda-cat-filter-overlays))))
(defun org-agenda-unmark-filtered-text ()
"Remove the filtering text property."
@@ -2882,7 +3258,7 @@ removed from the entry content. Currently only `planning' is allowed here."
(let (txt drawer-re kwd-time-re ind)
(save-excursion
(with-current-buffer (marker-buffer marker)
- (if (not (org-mode-p))
+ (if (not (derived-mode-p 'org-mode))
(setq txt "")
(save-excursion
(save-restriction
@@ -2972,7 +3348,7 @@ removed from the entry content. Currently only `planning' is allowed here."
(nreverse markers)))
(defun org-create-marker-find-array (marker-list)
- "Create an alist of files names with all marker positions in that file."
+ "Create a alist of files names with all marker positions in that file."
(let (f tbl m a p)
(while (setq m (pop marker-list))
(setq p (marker-position m)
@@ -2997,30 +3373,22 @@ removed from the entry content. Currently only `planning' is allowed here."
(member (point) (cdr a)))))))
(defun org-check-for-org-mode ()
- "Make sure current buffer is in Org-mode. Error if not."
- (or (org-mode-p)
+ "Make sure current buffer is in org-mode. Error if not."
+ (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-filter nil)
-(defvar org-agenda-filter-while-redo nil)
-(defvar org-agenda-filter-preset 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.
This must be a list of strings, each string must be a single tag preceded
by \"+\" or \"-\".
@@ -3030,61 +3398,117 @@ 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-done-keywords-for-agenda nil)
- (setq org-drawers-for-agenda nil)
- (unless org-agenda-persistent-filter
- (setq org-agenda-filter nil))
- (put 'org-agenda-filter :preset-filter org-agenda-filter-preset)
- (if org-agenda-multi
+(defvar org-agenda-category-filter-preset nil
+ "A preset of the category filter used for secondary agenda filtering.
+This must be a list of strings, each string must be a single category
+preceded by \"+\" or \"-\".
+This variable should not be set directly, but agenda custom commands can
+bind it in the options section. The preset filter is a global property of
+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-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)))
- (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)
- (switch-to-buffer 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)
- (switch-to-buffer 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
@@ -3113,11 +3537,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-filter (get 'org-agenda-filter :preset-filter))
- (org-agenda-filter-apply org-agenda-filter))
- )))
+ (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."
@@ -3137,7 +3564,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."
@@ -3190,17 +3617,9 @@ the global options and expect it to be applied to the entire view.")
(setq org-blocked-by-checkboxes nil invis1 invis)
(let ((marker (org-get-at-bol 'org-hd-marker)))
(when (and marker
- (not (with-current-buffer (marker-buffer marker)
- (save-excursion
- (goto-char marker)
- (if (org-entry-get nil "NOBLOCKING")
- t ;; Never block this entry
- (run-hook-with-args-until-failure
- 'org-blocker-hook
- (list :type 'todo-state-change
- :position marker
- :from 'todo
- :to 'done)))))))
+ (with-current-buffer (marker-buffer marker)
+ (save-excursion (goto-char marker)
+ (org-entry-blocked-p))))
(if org-blocked-by-checkboxes (setq invis1 nil))
(setq b (if invis1
(max (point-min) (1- (point-at-bol)))
@@ -3230,6 +3649,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)
@@ -3270,7 +3690,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 ()
@@ -3279,9 +3702,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
@@ -3334,7 +3761,7 @@ no longer in use."
(defvar org-agenda-only-exact-dates nil) ; dynamically scoped
-(defun org-timeline (&optional include-all)
+(defun org-timeline (&optional dotodo)
"Show a time-sorted view of the entries in the current org file.
Only entries with a time stamp of today or later will be listed. With
\\[universal-argument] prefix, all unfinished TODO items will also be shown,
@@ -3342,19 +3769,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)
- (dotodo include-all)
- (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))
@@ -3364,14 +3789,16 @@ dates."
(setq org-agenda-redo-command
(list 'progn
(list 'org-switch-to-buffer-other-window (current-buffer))
- (list 'org-timeline (list 'quote include-all))))
+ (list 'org-timeline (list 'quote dotodo))))
(if (not dopast)
;; Remove past dates from the list of 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)
@@ -3413,13 +3840,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)
@@ -3432,22 +3859,26 @@ 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)
+ dates dates1 date day day1 day2 ts1 ts2 pos)
(if force-today
(setq dates (list (org-today))))
(save-excursion
(goto-char beg)
(while (re-search-forward re end t)
(setq day (time-to-days (org-time-string-to-time
- (substring (match-string 1) 0 10))))
+ (substring (match-string 1) 0 10)
+ (current-buffer) (match-beginning 0))))
(or (memq day dates) (push day dates)))
(unless no-ranges
(goto-char beg)
(while (re-search-forward org-tr-regexp end t)
+ (setq pos (match-beginning 0))
(setq ts1 (substring (match-string 1) 0 10)
ts2 (substring (match-string 2) 0 10)
- day1 (time-to-days (org-time-string-to-time ts1))
- day2 (time-to-days (org-time-string-to-time ts2)))
+ day1 (time-to-days (org-time-string-to-time
+ ts1 (current-buffer) pos))
+ day2 (time-to-days (org-time-string-to-time
+ ts2 (current-buffer) pos)))
(while (< (setq day1 (1+ day1)) day2)
(or (memq day1 dates) (push day1 dates)))))
(setq dates (sort dates '<))
@@ -3467,12 +3898,10 @@ 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-include-all-loc nil) ; local variable
+(defvar org-arg-loc nil) ; local variable
(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
"List of types searched for when creating the daily/weekly agenda.
@@ -3507,180 +3936,209 @@ 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 include-all start-day span)
+(defun org-agenda-list (&optional arg start-day span)
"Produce a daily/weekly view from all files in variable `org-agenda-files'.
The view will be for the current day or week, but from the overview buffer
you will be able to go to other days/weeks.
With a numeric prefix argument in an interactive call, the agenda will
-span INCLUDE-ALL days. Lisp programs should instead specify SPAN to change
+span ARG days. Lisp programs should instead specify SPAN to change
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 include-all) (> include-all 0))
- (setq span include-all include-all nil))
- (setq start-day (or start-day org-agenda-start-day))
(if org-agenda-overriding-arguments
- (setq include-all (car 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 include-all 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 include-all) 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-include-all-loc include-all)
- (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))))
- (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
- (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-filter-while-redo
- (get 'org-agenda-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-clock-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 ""))))
+
+(autoload 'org-agenda-list "org-agenda" "\
+Produce a daily/weekly view from all files in variable `org-agenda-files'.
+The view will be for the current day or week, but from the overview buffer
+you will be able to go to other days/weeks.
+
+With a numeric prefix argument in an interactive call, the agenda will
+span ARG days. Lisp programs should instead specify SPAN to change
+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'.
+
+\(fn &optional ARG START-DAY SPAN)" t nil)
(defun org-agenda-ndays-to-span (n)
"Return a span symbol for a span of N days, or N if none matches."
@@ -3689,8 +4147,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)
@@ -3712,13 +4170,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, so
-that when \"+Ameli\" is searched as a word, it will also match \"Ameli's\"")
+ "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))
@@ -3773,9 +4231,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
@@ -3786,7 +4245,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 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)
@@ -3794,180 +4253,240 @@ 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 ".*?"
- 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 (org-mode-p)
- (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-on-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)
- tags (org-get-tags-at (point))
- txt (org-format-agenda-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
- '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))))
+
+(autoload 'org-search-view "org-agenda" "\
+Show all entries that contain a phrase or words or regular expressions.
+
+With optional prefix argument TODO-ONLY, only consider entries that are
+TODO entries. The argument STRING can be used to pass a default search
+string into this function. If EDIT-AT is non-nil, it means that the
+user should get a chance to edit this string, with cursor at position
+EDIT-AT.
+
+The search string can be viewed either as a phrase that should be found as
+is, or it can be broken into a number of snippets, each of which must match
+in a Boolean way to select an entry. The default depends on the variable
+`org-agenda-search-view-always-boolean'.
+Even if this is turned off (the default) you can always switch to
+Boolean search dynamically by preceding the first word with \"+\" or \"-\".
+
+The default is a direct search of the whole phrase, where each space in
+the search string can expand to an arbitrary amount of whitespace,
+including newlines.
+
+If using a Boolean search, the search string is split on whitespace and
+each snippet is searched separately, with logical AND to select an entry.
+Words prefixed with a minus must *not* occur in the entry. Words without
+a prefix or prefixed with a plus must occur in the entry. Matching is
+case-insensitive. Words are enclosed by word delimiters (i.e. they must
+match whole words, not parts of a word) if
+`org-agenda-search-view-force-full-words' is set (default is nil).
+
+Boolean search snippets enclosed by curly braces are interpreted as
+regular expressions that must or (when preceded with \"-\") must not
+match in the entry. Snippets enclosed into double quotes will be taken
+as a whole, to include whitespace.
+
+- If the search string starts with an asterisk, search only in headlines.
+- If (possibly after the leading star) the search string starts with an
+ exclamation mark, this also means to look at TODO entries only, an effect
+ that can also be achieved with a prefix argument.
+- If (possibly after star and exclamation mark) the search string starts
+ with a colon, this will mean that the (non-regexp) snippets of the
+ Boolean search must match as full words.
+
+This command searches the agenda files, and in addition the files listed
+in `org-agenda-text-search-extra-files'.
+
+\(fn &optional TODO-ONLY STRING EDIT-AT)" t nil)
;;; Agenda TODO list
@@ -3975,16 +4494,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))
@@ -3998,51 +4516,76 @@ 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))))
+
+(autoload 'org-todo-list "org-agenda" "\
+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'.
+
+\(fn &optional ARG)" t nil)
;;; Agenda tags match
@@ -4051,8 +4594,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)
@@ -4062,58 +4606,77 @@ 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 (org-mode-p)
- (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))))
+
+(autoload 'org-tags-view "org-agenda" "\
+Show all headlines for all `org-agenda-files' matching a TAGS criterion.
+The prefix arg TODO-ONLY limits the search to TODO entries.
+
+\(fn &optional TODO-ONLY MATCH)" t nil)
;;; Agenda Finding stuck projects
@@ -4177,7 +4740,7 @@ See `org-agenda-skip-if' for details."
(defun org-agenda-skip-if (subtree conditions)
"Checks current entity for CONDITIONS.
If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only
-the entry, i.e. the text before the next heading is checked.
+the entry (i.e. the text before the next heading) is checked.
CONDITIONS is a list of symbols, boolean OR is used to combine the results
from different tests. Valid conditions are:
@@ -4203,12 +4766,12 @@ keywords, which may include \"*\" to match any todo keyword.
would skip all entries with \"TODO\" or \"WAITING\" keywords.
-Instead of a list a keyword class may be given
+Instead of a list, a keyword class may be given. For example:
(org-agenda-skip-entry-if 'nottodo 'done)
would skip entries that haven't been marked with any of \"DONE\"
-keywords. Possible classes are: `todo', `done', `any'.
+keywords. Possible classes are: `todo', `done', `any'.
If any of these conditions is met, this function returns the end point of
the entity, causing the search to continue from there. This is a function
@@ -4241,16 +4804,19 @@ that can be put into `org-agenda-skip-function' for the duration of a command."
(stringp (nth 1 m))
(not (re-search-forward (nth 1 m) end t)))
(and (or
- (setq m (memq 'todo conditions))
- (setq m (memq 'nottodo conditions)))
+ (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)
@@ -4274,9 +4840,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)
@@ -4294,7 +4871,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
@@ -4305,8 +4882,8 @@ of what a project is and how to check if it stuck, customize the variable
"\\)\\>"))
(tags (nth 2 org-stuck-projects))
(tags-re (if (member "*" tags)
- (org-re (concat org-outline-regexp-bol
- ".*:[[:alnum:]_@#%]+:[ \t]*$"))
+ (concat org-outline-regexp-bol
+ (org-re ".*:[[:alnum:]_@#%]+:[ \t]*$"))
(if tags
(concat org-outline-regexp-bol
".*:\\("
@@ -4327,13 +4904,20 @@ 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)))))
+
+(autoload 'org-agenda-list-stuck-projects "org-agenda" "\
+Create agenda view for projects that are stuck.
+Stuck projects are project that have no next actions. For the definitions
+of what a project is and how to check if it stuck, customize the variable
+`org-stuck-projects'.
+
+\(fn &rest IGNORE)" t nil)
;;; 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."
@@ -4342,8 +4926,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
@@ -4380,7 +4964,7 @@ of what a project is and how to check if it stuck, customize the variable
(setq entries
(mapcar
(lambda (x)
- (setq x (org-format-agenda-item "" x "Diary" nil 'time))
+ (setq x (org-agenda-format-item "" x "Diary" nil 'time))
;; Extend the text properties to the beginning of the line
(org-add-props x (text-properties-at (1- (length x)) x)
'type "diary" 'date date 'face 'org-agenda-diary))
@@ -4425,7 +5009,7 @@ date. It also removes lines that contain only whitespace."
(setq string (org-modify-diary-entry-string string))))))
(defun org-modify-diary-entry-string (string)
- "Add text properties to string, allowing Org-mode to act on it."
+ "Add text properties to string, allowing org-mode to act on it."
(org-add-props string nil
'mouse-face 'highlight
'help-echo (if buffer-file-name
@@ -4454,7 +5038,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
@@ -4482,6 +5066,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)
@@ -4495,7 +5081,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.
@@ -4504,7 +5090,36 @@ 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"))))
+
+(autoload 'org-diary "org-agenda" "\
+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
+items should be listed. For a list of arguments allowed here, see the
+variable `org-agenda-entry-types'.
+
+The call in the diary file should look like this:
+
+ &%%(org-diary) ~/path/to/some/orgfile.org
+
+Use a separate line for each org file to check. Or, if you omit the file name,
+all files listed in `org-agenda-files' will be checked automatically:
+
+ &%%(org-diary)
+
+If you don't give any arguments (as in the example above), the default
+arguments (:deadline :scheduled :timestamp :sexp) are used.
+So the example above may also be written as
+
+ &%%(org-diary :deadline :timestamp :sexp :scheduled)
+
+The function expects the lisp variables `entry' and `date' to be provided
+by the caller, because this is how the calendar works. Don't use this
+function from a program - use `org-agenda-get-day-entries' instead.
+
+\(fn &rest ARGS)" nil nil)
;;; Agenda entry finders
@@ -4525,8 +5140,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 (org-mode-p)
+ (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
@@ -4545,7 +5161,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))
@@ -4562,6 +5178,7 @@ the documentation of `org-diary'."
(setq results (append results rtn))))))))
results))))
+(defvar org-heading-keyword-regexp-format) ; defined in org.el
(defun org-agenda-get-todos ()
"Return the TODO information for agenda display."
(let* ((props (list 'face nil
@@ -4573,16 +5190,20 @@ the documentation of `org-diary'."
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
- (regexp (concat "^\\*+[ \t]+\\("
- (if org-select-this-todo-keyword
- (if (equal org-select-this-todo-keyword "*")
- org-todo-regexp
- (concat "\\<\\("
- (mapconcat 'identity (org-split-string org-select-this-todo-keyword "|") "\\|")
- "\\)\\>"))
- org-not-done-regexp)
- "[^\n\r]*\\)"))
- marker priority category tags todo-state
+ (regexp (format org-heading-keyword-regexp-format
+ (cond
+ ((and org-select-this-todo-keyword
+ (equal org-select-this-todo-keyword "*"))
+ org-todo-regexp)
+ (org-select-this-todo-keyword
+ (concat "\\("
+ (mapconcat 'identity
+ (org-split-string
+ org-select-this-todo-keyword
+ "|")
+ "\\|") "\\)"))
+ (t org-not-done-regexp))))
+ marker priority category category-pos tags todo-state
ee txt beg end)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -4595,26 +5216,29 @@ the documentation of `org-diary'."
(goto-char (1+ beg))
(or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible))
(throw :skip nil)))
- (goto-char (match-beginning 1))
+ (goto-char (match-beginning 2))
(setq marker (org-agenda-new-marker (match-beginning 0))
category (org-get-category)
- txt (match-string 1)
+ 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-format-agenda-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 category-pos
'type "todo" 'todo-state todo-state)
(push txt ee)
(if org-agenda-todo-list-sublevels
- (goto-char (match-end 1))
+ (goto-char (match-end 2))
(org-end-of-subtree 'invisible))))
(nreverse ee)))
(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."
@@ -4623,7 +5247,6 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(>= days n)
(<= days n))))
-;;;###autoload
(defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
(&optional end)
"Do we have a reason to ignore this TODO entry because it has a time stamp?"
@@ -4686,12 +5309,17 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(match-string 1) org-agenda-todo-ignore-timestamp))
(t))))))))))
+(autoload 'org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item "org-agenda" "\
+Do we have a reason to ignore this TODO entry because it has a time stamp?
+
+\(fn &optional END)" nil nil)
+
(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 nil
+ (let* ((props (list 'face 'org-agenda-calendar-event
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
@@ -4700,13 +5328,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 "[[<]" "<")
@@ -4717,16 +5345,17 @@ 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 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 habitp)
(goto-char (point-min))
(while (setq end-of-match (re-search-forward regexp nil t))
(setq b0 (match-beginning 0)
b3 (match-beginning 3) e3 (match-end 3)
todo-state (save-match-data (ignore-errors (org-get-todo-state)))
+ habitp (and (functionp 'org-is-habit-p) (save-match-data (org-is-habit-p)))
show-all (or (eq org-agenda-repeating-timestamp-show-all t)
(member todo-state
org-agenda-repeating-timestamp-show-all)))
@@ -4735,7 +5364,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(org-agenda-skip)
(if (and (match-end 1)
(not (= d1 (org-time-string-to-absolute
- (match-string 1) d1 nil show-all))))
+ (match-string 1) d1 nil show-all
+ (current-buffer) b0))))
(throw :skip nil))
(if (and e3
(not (org-diary-sexp-entry (buffer-substring b3 e3) "" date)))
@@ -4752,6 +5382,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))
@@ -4760,25 +5391,31 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
;; substring should only run to end of time stamp
(setq timestr (substring timestr 0 (match-end 0))))
(setq marker (org-agenda-new-marker b0)
- category (org-get-category b0))
+ category (org-get-category b0)
+ 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]+\\)")
(setq head (or (match-string 1) ""))
- (setq txt (org-format-agenda-item
+ (setq txt (org-agenda-format-item
(if inactivep org-agenda-inactive-leader nil)
head category tags timestr
- remove-re)))
+ remove-re habitp)))
(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 category-pos
'todo-state todo-state
+ 'warntime warntime
'type "timestamp")
(push txt ee))
(if org-agenda-skip-additional-timestamps-same-entry
@@ -4789,13 +5426,14 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(defun org-agenda-get-sexps ()
"Return the sexp information for agenda display."
(require 'diary-lib)
- (let* ((props (list 'mouse-face 'highlight
+ (let* ((props (list 'face 'org-agenda-calendar-sexp
+ 'mouse-face 'highlight
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp "^&?%%(")
- marker category 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
@@ -4812,21 +5450,31 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(when result
(setq marker (org-agenda-new-marker beg)
category (org-get-category beg)
- 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")
+ extra nil)
(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-format-agenda-item
- "" txt category tags 'time))
+ (setq txt (org-agenda-format-item
+ 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
- 'type "sexp")
+ 'org-category-position category-pos 'tags tags
+ 'type "sexp" 'warntime warntime)
(push txt ee)))))
(nreverse ee)))
@@ -4860,9 +5508,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
;; Define the` org-class' function
(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
"Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
-DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS
-is any number of ISO weeks in the block period for which the item should
-be skipped."
+DAYNAME is a number between 0 (Sunday) and 6 (Saturday).
+SKIP-WEEKS is any number of ISO weeks in the block period for which the
+item should be skipped. If any of the SKIP-WEEKS arguments is the symbol
+`holidays', then any date that is known by the Emacs calendar to be a
+holiday will also be skipped."
(let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
(date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
(d (calendar-absolute-from-gregorian date)))
@@ -4874,6 +5524,8 @@ be skipped."
(progn
(require 'cal-iso)
(not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
+ (not (and (memq 'holidays skip-weeks)
+ (calendar-check-holidays date)))
entry)))
(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
@@ -4894,7 +5546,9 @@ please use `org-class' instead."
(nth 2 date1) (car date1) (nth 1 date1)
(nth 2 date2) (car date2) (nth 1 date2)
dayname skip-weeks)))
+(make-obsolete 'org-diary-class 'org-class "")
+(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."
@@ -4905,9 +5559,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
@@ -4929,8 +5583,8 @@ 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 tags closedp statep clockp state
- ee txt extra timestr rest clocked)
+ 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)
(catch :skip
@@ -4941,14 +5595,15 @@ please use `org-class' instead."
clockp (not (or closedp statep))
state (and statep (match-string 2))
category (org-get-category (match-beginning 0))
- timestr (buffer-substring (match-beginning 0) (point-at-eol))
- )
+ 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
(setq rest (substring timestr (match-end 0))
timestr (substring timestr 0 (match-end 0)))
(if (and (not closedp) (not statep)
- (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" rest))
+ (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)"
+ rest))
(progn (setq timestr (concat (substring timestr 0 -1)
"-" (match-string 1 rest) "]"))
(setq clocked (match-string 2 rest)))
@@ -4975,16 +5630,17 @@ please use `org-class' instead."
(setq txt (concat (substring txt 0 (match-beginning 1))
" - " extra " " (match-string 2 txt)))
(setq txt (concat txt " - " extra))))
- (setq txt (org-format-agenda-item
+ (setq txt (org-agenda-format-item
(cond
(closedp "Closed: ")
- (statep (concat "State: (" state ")"))
- (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 category-pos
'type "closed" 'date date
'undone-face 'org-warning 'done-face 'org-agenda-done)
(push txt ee))
@@ -5059,10 +5715,10 @@ See also the user option `org-agenda-clock-consistency-checks'."
(/ (- tlend ts) 60))
face (or (plist-get pl :overlap-face) face)))
((and (> tlend 0) (> ts (+ tlend (* 60 maxgap))))
- ;; There is a gap, let's see if we need to report it
+ ;; 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))
@@ -5122,9 +5778,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 tags
- suppress-prewarning
- ee txt head face s todo-state show-all upcomingp donep timestr)
+ d2 diff dfrac wdays pos pos1 category category-pos
+ tags suppress-prewarning ee txt head face s todo-state
+ show-all upcomingp donep timestr warntime)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(setq suppress-prewarning nil)
@@ -5145,15 +5801,16 @@ 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)
+ (match-string 1) d1 'past show-all
+ (current-buffer) pos)
diff (- d2 d1)
wdays (if suppress-prewarning
(let ((org-deadline-warning-days suppress-prewarning))
(org-get-wdays s))
(org-get-wdays s))
- dfrac (/ (* 1.0 (- wdays diff)) (max wdays 1))
+ dfrac (- 1 (/ (* 1.0 diff) (max wdays 1)))
upcomingp (and todayp (> diff 0)))
;; When to show a deadline in the calendar:
;; If the expiration is within wdays warning time.
@@ -5168,7 +5825,9 @@ See also the user option `org-agenda-clock-consistency-checks'."
(or org-agenda-skip-deadline-if-done
(not (= diff 0))))
(setq txt nil)
- (setq category (org-get-category))
+ (setq category (org-get-category)
+ 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))
@@ -5182,7 +5841,7 @@ See also the user option `org-agenda-clock-consistency-checks'."
(setq timestr
(concat (substring s (match-beginning 1)) " "))
(setq timestr 'time))
- (setq txt (org-format-agenda-item
+ (setq txt (org-agenda-format-item
(if (= diff 0)
(car org-agenda-deadline-leaders)
(if (functionp
@@ -5195,13 +5854,15 @@ See also the user option `org-agenda-clock-consistency-checks'."
head category tags
(if (not (= diff 0)) nil timestr)))))
(when txt
- (setq face (org-agenda-deadline-face dfrac wdays))
+ (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 category-pos
'todo-state todo-state
'type (if upcomingp "upcoming-deadline" "deadline")
'date (if upcomingp date d2)
@@ -5210,10 +5871,9 @@ See also the user option `org-agenda-clock-consistency-checks'."
(push txt ee))))))
(nreverse ee)))
-(defun org-agenda-deadline-face (fraction &optional wdays)
+(defun org-agenda-deadline-face (fraction)
"Return the face to displaying a deadline item.
FRACTION is what fraction of the head-warning time has passed."
- (if (equal wdays 0) (setq fraction 1.))
(let ((faces org-agenda-deadline-faces) f)
(catch 'exit
(while (setq f (pop faces))
@@ -5235,11 +5895,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 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
@@ -5252,15 +5913,26 @@ FRACTION is what fraction of the head-warning time has passed."
(member todo-state
org-agenda-repeating-timestamp-show-all))
d2 (org-time-string-to-absolute
- (match-string 1) d1 'past show-all)
- diff (- d2 d1))
+ (match-string 1) d1 'past show-all
+ (current-buffer) pos)
+ 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
@@ -5269,9 +5941,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 category (org-get-category))
+ (setq habitp (if did-habit-check-p habitp
+ (and (functionp 'org-is-habit-p)
+ (org-is-habit-p))))
+ (setq category (org-get-category)
+ category-pos (get-text-property (point) 'org-category-position))
(if (not (re-search-backward "^\\*+[ \t]+" nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-end 0))
@@ -5279,6 +5953,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
@@ -5295,7 +5970,7 @@ FRACTION is what fraction of the head-warning time has passed."
(setq timestr
(concat (substring s (match-beginning 1)) " "))
(setq timestr 'time))
- (setq txt (org-format-agenda-item
+ (setq txt (org-agenda-format-item
(if (= diff 0)
(car org-agenda-scheduled-leaders)
(format (nth 1 org-agenda-scheduled-leaders)
@@ -5318,10 +5993,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
+ 'category-position category-pos
'org-habit-p habitp
'todo-state todo-state)
(push txt ee))))))
@@ -5339,8 +6016,8 @@ FRACTION is what fraction of the head-warning time has passed."
(abbreviate-file-name buffer-file-name))))
(regexp org-tr-regexp)
(d0 (calendar-absolute-from-gregorian date))
- marker hdmarker ee txt d1 d2 s1 s2 category todo-state tags pos
- head donep)
+ marker hdmarker ee txt d1 d2 s1 s2 category category-pos
+ todo-state tags pos head donep)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@@ -5350,8 +6027,8 @@ FRACTION is what fraction of the head-warning time has passed."
(end-time (match-string 2)))
(setq s1 (match-string 1)
s2 (match-string 2)
- d1 (time-to-days (org-time-string-to-time s1))
- d2 (time-to-days (org-time-string-to-time s2)))
+ d1 (time-to-days (org-time-string-to-time s1 (current-buffer) pos))
+ d2 (time-to-days (org-time-string-to-time s2 (current-buffer) pos)))
(if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
;; Only allow days between the limits, because the normal
;; date stamps will catch the limits.
@@ -5361,7 +6038,8 @@ FRACTION is what fraction of the head-warning time has passed."
(if (and donep org-agenda-skip-timestamp-if-done)
(throw :skip t))
(setq marker (org-agenda-new-marker (point)))
- (setq category (org-get-category))
+ (setq category (org-get-category)
+ 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))
@@ -5376,23 +6054,25 @@ FRACTION is what fraction of the head-warning time has passed."
"--"
"<" (regexp-quote s2) ".*?>")
nil)))
- (setq txt (org-format-agenda-item
+ (setq txt (org-agenda-format-item
(format
(nth (if (= d1 d2) 0 1)
org-agenda-timerange-leaders)
(1+ (- d0 d1)) (1+ (- d2 d1)))
head category tags
- (cond ((= d1 d0)
+ (cond ((and (= d1 d0) (= d2 d0))
+ (concat "<" start-time ">--<" end-time ">"))
+ ((= d1 d0)
(concat "<" start-time ">"))
((= d2 d0)
- (concat "<" end-time ">"))
- (t nil))
+ (concat "<" end-time ">")))
remove-re))))
(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)
+ 'priority (org-get-priority txt) 'org-category category
+ 'org-category-position category-pos)
(push txt ee))))
(goto-char pos)))
;; Sort the entries by expiration date.
@@ -5420,9 +6100,9 @@ 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-format-agenda-item (extra txt &optional category tags dotime
+(defun org-agenda-format-item (extra txt &optional category tags dotime
remove-re habitp)
"Format TXT to be inserted into the agenda buffer.
In particular, it adds the prefix and corresponding text properties. EXTRA
@@ -5434,151 +6114,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 (org-mode-p) 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 (org-mode-p)
- (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.
@@ -5610,7 +6302,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)))
@@ -5642,14 +6334,14 @@ The modified list may contain inherited tags, and tags matched by
(while (setq time (pop gridtimes))
(unless (and remove (member time have))
(setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
- (push (org-format-agenda-item
+ (push (org-agenda-format-item
nil string "" nil
(concat (substring time 0 -2) ":" (substring time -2)))
new)
(put-text-property
2 (length (car new)) 'face 'org-time-grid (car new))))
(when (and todayp org-agenda-show-current-time-in-grid)
- (push (org-format-agenda-item
+ (push (org-agenda-format-item
nil
org-agenda-current-time-string
"" nil
@@ -5664,10 +6356,11 @@ 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)
+ org-prefix-category-length nil
+ org-prefix-has-effort nil)
(let ((s (cond
((stringp org-agenda-prefix-format)
org-agenda-prefix-format)
@@ -5708,7 +6401,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))
@@ -5729,23 +6429,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.
@@ -5767,7 +6467,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
@@ -5779,7 +6479,7 @@ could bind the variable in the options section of a custom command.")
(defun org-agenda-highlight-todo (x)
(let ((org-done-keywords org-done-keywords-for-agenda)
(case-fold-search nil)
- re)
+ re)
(if (eq x 'line)
(save-excursion
(beginning-of-line 1)
@@ -5795,18 +6495,28 @@ could bind the variable in the options section of a custom command.")
(let ((pl (text-property-any 0 (length x) 'org-heading t x)))
(setq re (get-text-property 0 'org-todo-regexp x))
(when (and re
+ ;; Test `pl' because if there's no heading content,
+ ;; there's no point matching to highlight. Note
+ ;; that if we didn't test `pl' first, and there
+ ;; happened to be no keyword from `org-todo-regexp'
+ ;; on this heading line, then the `equal' comparison
+ ;; afterwards would spuriously succeed in the case
+ ;; where `pl' is nil -- causing an args-out-of-range
+ ;; error when we try to add text properties to text
+ ;; that isn't there.
+ pl
(equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
- x (or pl 0)) pl))
+ x pl) pl))
(add-text-properties
(or (match-end 1) (match-end 0)) (match-end 0)
(list 'face (org-get-todo-face (match-string 2 x)))
- x)
+ x)
(when (match-end 1)
(setq x (concat (substring x 0 (match-end 1))
(format org-agenda-todo-keyword-format
(match-string 2 x))
- (org-add-props " " (text-properties-at 0 x))
- (substring x (match-end 3)))))))
+ (org-add-props " " (text-properties-at 0 x))
+ (substring x (match-end 3)))))))
x)))
(defsubst org-cmp-priority (a b)
@@ -5814,25 +6524,22 @@ 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 priorities of string A and B."
+ "Compare the effort values of string A and B."
(let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1))
(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."
@@ -5854,8 +6561,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."
@@ -5876,8 +6582,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."
@@ -5886,8 +6591,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."
@@ -5895,16 +6599,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)))
@@ -6027,13 +6729,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
@@ -6041,23 +6745,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.
@@ -6066,7 +6798,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.
@@ -6076,34 +6819,95 @@ 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)
- (filter org-agenda-filter)
- (preset (get 'org-agenda-filter :preset-filter))
- (org-agenda-filter-while-redo (or filter preset))
+(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)))
- (put 'org-agenda-filter :preset-filter nil)
+ (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")
- (put 'org-agenda-filter :preset-filter preset)
- (and (or filter preset) (org-agenda-filter-apply filter))
+ (put 'org-agenda-tag-filter :preset-filter tag-preset)
+ (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)))
-
(defvar org-global-tags-completion-table nil)
(defvar org-agenda-filter-form nil)
+(defvar org-agenda-filtered-by-category nil)
+
+(defun org-agenda-filter-by-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 (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.
@@ -6127,21 +6931,21 @@ to switch to narrowing."
(effort-op org-agenda-filter-effort-default-operator)
(effort-prompt "")
(inhibit-read-only t)
- (current org-agenda-filter)
+ (current org-agenda-tag-filter)
maybe-refresh a n tag)
(unless char
(message
"%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>=<?]:effort: "
(if narrow "Narrow" "Filter") tag-chars
(if org-agenda-auto-exclude-function "[RET], " ""))
- (setq char (read-char)))
+ (setq char (read-char-exclusive)))
(when (member char '(?+ ?-))
;; Narrowing down
(cond ((equal char ?-) (setq strip t narrow t))
((equal char ?+) (setq strip nil narrow t)))
(message
"Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars)
- (setq char (read-char)))
+ (setq char (read-char-exclusive)))
(when (member char '(?< ?> ?= ??))
;; An effort operator
(setq effort-op (char-to-string char))
@@ -6154,9 +6958,9 @@ to switch to narrowing."
(if (= i 9) "0" (int-to-string (1+ i)))
"]" (nth i efforts))))
(message "Effort%s: %s " effort-op effort-prompt)
- (setq char (read-char))
+ (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
@@ -6166,20 +6970,26 @@ to switch to narrowing."
"Tag: " org-global-tags-completion-table))))
(cond
((equal char ?\r)
- (org-agenda-filter-by-tag-show-all)
+ (org-agenda-filter-show-all-tag)
(when org-agenda-auto-exclude-function
- (setq org-agenda-filter '())
+ (setq org-agenda-tag-filter '())
(dolist (tag (org-agenda-get-represented-tags))
(let ((modifier (funcall org-agenda-auto-exclude-function tag)))
(if modifier
- (push modifier org-agenda-filter))))
- (if (not (null org-agenda-filter))
- (org-agenda-filter-apply org-agenda-filter)))
+ (push modifier org-agenda-tag-filter))))
+ (if (not (null org-agenda-tag-filter))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag)))
(setq maybe-refresh t))
((equal char ?/)
- (org-agenda-filter-by-tag-show-all)
- (when (get 'org-agenda-filter :preset-filter)
- (org-agenda-filter-apply org-agenda-filter))
+ (org-agenda-filter-show-all-tag)
+ (when (get 'org-agenda-tag-filter :preset-filter)
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (setq maybe-refresh t))
+ ((equal char ?. )
+ (setq org-agenda-tag-filter
+ (mapcar (lambda(tag) (concat "+" tag))
+ (org-get-at-bol 'tags)))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag)
(setq maybe-refresh t))
((or (equal char ?\ )
(setq a (rassoc char alist))
@@ -6191,12 +7001,12 @@ to switch to narrowing."
(setq tag "?eff")
a (cons tag nil))
(and tag (setq a (cons tag nil))))
- (org-agenda-filter-by-tag-show-all)
+ (org-agenda-filter-show-all-tag)
(setq tag (car a))
- (setq org-agenda-filter
+ (setq org-agenda-tag-filter
(cons (concat (if strip "-" "+") tag)
(if narrow current nil)))
- (org-agenda-filter-apply org-agenda-filter)
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag)
(setq maybe-refresh t))
(t (error "Invalid tag selection character %c" char)))
(when (and maybe-refresh
@@ -6215,15 +7025,17 @@ to switch to narrowing."
tags))
(defun org-agenda-filter-by-tag-refine (strip &optional char)
- "Refine the current filter. See `org-agenda-filter-by-tag."
+ "Refine the current filter. See `org-agenda-filter-by-tag'."
(interactive "P")
(org-agenda-filter-by-tag strip char 'refine))
(defun org-agenda-filter-make-matcher ()
- "Create the form that tests a line for the agenda filter."
+ "Create the form that tests a line for agenda filter."
(let (f f1)
- (dolist (x (append (get 'org-agenda-filter :preset-filter)
- org-agenda-filter))
+ ;; first compute the tag-filter matcher
+ (dolist (x (delete-dups
+ (append (get 'org-agenda-tag-filter
+ :preset-filter) org-agenda-tag-filter)))
(if (member x '("-" "+"))
(setq f1 (if (equal x "-") 'tags '(not tags)))
(if (string-match "[<=>?]" x)
@@ -6232,6 +7044,14 @@ to switch to narrowing."
(if (equal (string-to-char x) ?-)
(setq f1 (list 'not f1))))
(push f1 f))
+ ;; then compute the category-filter matcher
+ (dolist (x (delete-dups
+ (append (get 'org-agenda-category-filter
+ :preset-filter) org-agenda-category-filter)))
+ (if (equal "-" (substring x 0 1))
+ (setq f1 (list 'not (list 'equal (substring x 1) 'cat)))
+ (setq f1 (list 'equal (substring x 1) 'cat)))
+ (push f1 f))
(cons 'and (nreverse f))))
(defun org-agenda-filter-effort-form (e)
@@ -6256,49 +7076,84 @@ If the line does not have an effort defined, return nil."
(funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0))
value))))
-(defun org-agenda-filter-apply (filter)
+(defun org-agenda-filter-apply (filter type)
"Set FILTER as the new agenda filter and apply it."
- (let (tags)
- (setq org-agenda-filter filter
- org-agenda-filter-form (org-agenda-filter-make-matcher))
+ (let (tags cat)
+ (if (eq type 'tag)
+ (setq org-agenda-tag-filter filter)
+ (setq org-agenda-category-filter filter))
+ (setq org-agenda-filter-form (org-agenda-filter-make-matcher))
+ (if (and (eq type 'category)
+ (not (equal (substring (car filter) 0 1) "-")))
+ ;; Only set `org-agenda-filtered-by-category' to t
+ ;; when a unique category is used as the filter
+ (setq org-agenda-filtered-by-category t))
(org-agenda-set-mode-name)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(if (org-get-at-bol 'org-marker)
(progn
- (setq tags (org-get-at-bol 'tags)) ; used in eval
+ (setq tags (org-get-at-bol 'tags) ; used in eval
+ cat (get-text-property (point) 'org-category))
(if (not (eval org-agenda-filter-form))
- (org-agenda-filter-by-tag-hide-line))
+ (org-agenda-filter-hide-line type))
(beginning-of-line 2))
(beginning-of-line 2))))
(if (get-char-property (point) 'invisible)
- (org-agenda-previous-line))))
+ (ignore-errors (org-agenda-previous-line)))))
-(defun org-agenda-filter-by-tag-hide-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 'tags-filter)
- (push ov org-agenda-filter-overlays)))
+ (overlay-put ov 'type type)
+ (if (eq type 'tag)
+ (push ov org-agenda-tag-filter-overlays)
+ (push ov org-agenda-cat-filter-overlays))))
(defun org-agenda-fix-tags-filter-overlays-at (&optional pos)
(setq pos (or pos (point)))
(save-excursion
(dolist (ov (overlays-at pos))
(when (and (overlay-get ov 'invisible)
- (eq (overlay-get ov 'type) 'tags-filter))
+ (eq (overlay-get ov 'type) 'tag))
(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)
+ (setq org-agenda-tag-filter-overlays nil
+ org-agenda-tag-filter nil
+ org-agenda-filter-form nil)
+ (org-agenda-set-mode-name))
-(defun org-agenda-filter-by-tag-show-all ()
- (mapc 'delete-overlay org-agenda-filter-overlays)
- (setq org-agenda-filter-overlays nil)
- (setq org-agenda-filter nil)
- (setq org-agenda-filter-form nil)
+(defun org-agenda-filter-show-all-cat nil
+ (mapc 'delete-overlay org-agenda-cat-filter-overlays)
+ (setq org-agenda-cat-filter-overlays nil
+ org-agenda-filtered-by-category nil
+ org-agenda-category-filter nil
+ org-agenda-filter-form nil)
(org-agenda-set-mode-name))
(defun org-agenda-manipulate-query-add ()
@@ -6336,36 +7191,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)))
@@ -6376,19 +7253,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.
+ "Go forward in time by the 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 arg) sd)))
((eq span 'day)
(setq sd (+ arg sd)))
((eq span 'week)
@@ -6403,8 +7304,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))))
@@ -6417,10 +7323,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))
@@ -6487,18 +7392,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.
@@ -6577,23 +7486,23 @@ 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)
- (if (and org-agenda-follow-mode (org-get-at-bol 'org-marker))
- (org-agenda-show))
+ (org-agenda-do-context-action)
(message "Follow mode is %s"
(if org-agenda-follow-mode "on" "off")))
@@ -6714,13 +7623,33 @@ When called with a prefix argument, include all archive files as well."
((eq org-agenda-show-log 'clockcheck) " ClkCk")
(org-agenda-show-log " Log")
(t ""))
- (if (or org-agenda-filter (get 'org-agenda-filter
- :preset-filter))
- (concat " {" (mapconcat
- 'identity
- (append (get 'org-agenda-filter
- :preset-filter)
- org-agenda-filter) "") "}")
+ (if (or org-agenda-category-filter (get 'org-agenda-category-filter
+ :preset-filter))
+ '(:eval (org-propertize
+ (concat " <"
+ (mapconcat
+ 'identity
+ (append
+ (get 'org-agenda-category-filter :preset-filter)
+ org-agenda-category-filter)
+ "")
+ ">")
+ 'face 'org-agenda-filter-category
+ 'help-echo "Category used in filtering"))
+ "")
+ (if (or org-agenda-tag-filter (get 'org-agenda-tag-filter
+ :preset-filter))
+ '(:eval (org-propertize
+ (concat " {"
+ (mapconcat
+ 'identity
+ (append
+ (get 'org-agenda-tag-filter :preset-filter)
+ org-agenda-tag-filter)
+ "")
+ "}")
+ 'face 'org-agenda-filter-tags
+ 'help-echo "Tags used in filtering"))
"")
(if org-agenda-archives-mode
(if (eq org-agenda-archives-mode t)
@@ -6733,11 +7662,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."
@@ -6751,22 +7683,39 @@ 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)))
- (if (and org-agenda-follow-mode m)
- (org-agenda-show))
- (if (and m 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))))
+ (when (and (markerp m) (marker-buffer m))
+ (and org-agenda-follow-mode
+ (if org-agenda-follow-indirect
+ (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-tags ()
"Show the tags applicable to the current item."
@@ -6788,7 +7737,7 @@ and by additional input from the age of a schedules or deadline entry."
(widen)
(push-mark)
(goto-char pos)
- (when (org-mode-p)
+ (when (derived-mode-p 'org-mode)
(org-show-context 'agenda)
(save-excursion
(and (outline-next-heading)
@@ -6807,36 +7756,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 (org-mode-p) (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)
@@ -6863,19 +7814,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 (org-mode-p)
+ (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"))))))
@@ -6910,7 +7863,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))
@@ -6923,7 +7877,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))))
@@ -6970,17 +7925,18 @@ at the text of the entry itself."
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
- (switch-to-buffer buffer)
+ (org-pop-to-buffer-same-window buffer)
(and delete-other-windows (delete-other-windows))
(widen)
(goto-char pos)
- (when (org-mode-p)
+ (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."
@@ -7001,10 +7957,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))
@@ -7012,7 +7971,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)))
@@ -7130,14 +8089,35 @@ 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)
+ (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 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)
(org-agenda-error)))
@@ -7146,7 +8126,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
@@ -7227,7 +8207,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
&optional fixface just-this)
"Change all lines in the agenda buffer which match HDMARKER.
The new content of the line will be NEWHEAD (as modified by
-`org-format-agenda-item'). HDMARKER is checked with
+`org-agenda-format-item'). HDMARKER is checked with
`equal' against all `org-hd-marker' text properties in the file.
If FIXFACE is non-nil, the face of each item is modified according to
the new TODO state.
@@ -7235,6 +8215,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)
@@ -7254,14 +8235,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-format-agenda-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))
@@ -7281,9 +8262,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'."
@@ -7323,11 +8306,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)
@@ -7346,7 +8330,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)
@@ -7494,15 +8478,33 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
- (pos (marker-position marker)))
+ (pos (marker-position marker))
+ cdate today)
(org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (if (not (org-at-timestamp-p))
- (error "Cannot find time stamp"))
- (org-timestamp-change arg (or what 'day)))
- (org-agenda-show-new-time marker org-last-changed-timestamp))
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (if (not (org-at-timestamp-p))
+ (error "Cannot find time stamp"))
+ (when (and org-agenda-move-date-from-past-immediately-to-today
+ (equal arg 1)
+ (or (not what) (eq what 'day))
+ (not (save-match-data (org-at-date-range-p))))
+ (setq cdate (org-parse-time-string (match-string 0) 'nodefault)
+ cdate (calendar-absolute-from-gregorian
+ (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate)))
+ today (org-today))
+ (if (> today cdate)
+ ;; immediately shift to today
+ (setq arg (- today cdate))))
+ (org-timestamp-change arg (or what 'day))
+ (when (and (org-at-date-range-p)
+ (re-search-backward org-tr-regexp-both (point-at-bol)))
+ (let ((end org-last-changed-timestamp))
+ (org-timestamp-change arg (or what 'day))
+ (setq org-last-changed-timestamp
+ (concat org-last-changed-timestamp "--" end)))))
+ (org-agenda-show-new-time marker org-last-changed-timestamp))
(message "Time stamp changed to %s" org-last-changed-timestamp)))
(defun org-agenda-date-earlier (arg &optional what)
@@ -7620,73 +8622,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."
@@ -7811,8 +8747,15 @@ top-level as top-level entries at the end of the file."
(defcustom org-agenda-insert-diary-extract-time nil
"Non-nil means extract any time specification from the diary entry."
:group 'org-agenda
+ :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
@@ -7826,12 +8769,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-on-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)
@@ -7843,10 +8786,10 @@ the resulting entry will not be shown. When TEXT is empty, switch to
(org-agenda-time-leading-zero t)
fmt time time2)
(if org-agenda-insert-diary-extract-time
- ;; Use org-format-agenda-item to parse text for a time-range and
+ ;; Use org-agenda-format-item to parse text for a time-range and
;; remove it. FIXME: This is a hack, we should refactor
;; that function to make time extraction available separately
- (setq fmt (org-format-agenda-item nil text nil nil t)
+ (setq fmt (org-agenda-format-item nil text nil nil t)
time (get-text-property 0 'time fmt)
time2 (if (> (length time) 0)
;; split-string removes trailing ...... if
@@ -7929,7 +8872,6 @@ When `org-agenda-diary-file' points to a file,
`org-agenda-diary-entry-in-org-file' is called instead to create
entries in that Org-mode file."
(interactive)
- (org-agenda-check-type t 'agenda 'timeline)
(if (not (eq org-agenda-diary-file 'diary-file))
(org-agenda-diary-entry-in-org-file)
(require 'diary-lib)
@@ -7970,12 +8912,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
@@ -7983,14 +8924,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."
@@ -8002,9 +8943,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.
@@ -8023,7 +8964,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)
@@ -8041,10 +8982,16 @@ This is a command that has to be installed in `calendar-mode-map'."
(calendar-cursor-to-date))
nil))
+(autoload 'org-calendar-goto-agenda "org-agenda" "\
+Compute the Org-mode agenda for the calendar date displayed at the cursor.
+This is a command that has to be installed in `calendar-mode-map'.
+
+\(fn)" t nil)
+
(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"))
@@ -8071,9 +9018,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))
@@ -8081,7 +9025,7 @@ This is a command that has to be installed in `calendar-mode-map'."
(defun org-agenda-bulk-mark (&optional arg)
"Mark the entry at point for future bulk action."
(interactive "p")
- (dotimes (i (max arg 1))
+ (dotimes (i (or arg 1))
(unless (org-get-at-bol 'org-agenda-diary-link)
(let* ((m (org-get-at-bol 'org-hd-marker))
ov)
@@ -8089,7 +9033,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))
@@ -8099,41 +9043,49 @@ 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)
+ (let ((entries-marked 0))
(save-excursion
(goto-char (point-min))
(goto-char (next-single-property-change (point) 'txt))
(while (re-search-forward regexp nil t)
(when (string-match regexp (get-text-property (point) 'txt))
- (setq entries-marked (+ entries-marked 1))
+ (setq entries-marked (1+ entries-marked))
(call-interactively 'org-agenda-bulk-mark))))
(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.
@@ -8147,13 +9099,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.
@@ -8171,147 +9133,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)
- (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
@@ -8362,10 +9338,10 @@ 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)
+(defun org-agenda-to-appt (&optional refresh filter &rest args)
"Activate appointments found in `org-agenda-files'.
With a \\[universal-argument] prefix, refresh the list of
appointments.
@@ -8376,6 +9352,10 @@ expression, and filter out entries that don't match it.
If FILTER is a string, use this string as a regular expression
for filtering entries out.
+If FILTER is a function, filter out entries against which
+calling the function returns nil. This function takes one
+argument: an entry from `org-agenda-get-day-entries'.
+
FILTER can also be an alist with the car of each cell being
either 'headline or 'category. For example:
@@ -8383,12 +9363,21 @@ either 'headline or 'category. For example:
(category \"Work\"))
will only add headlines containing IMPORTANT or headlines
-belonging to the \"Work\" category."
+belonging to the \"Work\" category.
+
+ARGS are symbols indicating what kind of entries to consider.
+By default `org-agenda-to-appt' will use :deadline, :scheduled
+and :timestamp entries. See the docstring of `org-diary' for
+details and examples.
+
+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)
(setq filter (read-from-minibuffer "Regexp filter: ")))
(let* ((cnt 0) ; count added events
+ (scope (or args '(:deadline :scheduled :timestamp)))
(org-agenda-new-buffers nil)
(org-deadline-warning-days 0)
;; Do not use `org-today' here because appt only takes
@@ -8397,15 +9386,16 @@ belonging to the \"Work\" category."
(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
- (append entries
- (org-agenda-get-day-entries
- file today :timestamp :scheduled :deadline))))
- (setq entries (delq nil entries))
+ (delq nil
+ (append entries
+ (apply 'org-agenda-get-day-entries
+ file today scope)))))
;; Map thru entries and find if we should filter them out
(mapc
(lambda(x)
@@ -8414,11 +9404,15 @@ belonging to the \"Work\" category."
(tod (get-text-property 1 'time-of-day x))
(ok (or (null filter)
(and (stringp filter) (string-match filter evt))
+ (and (functionp filter) (funcall filter x))
(and (listp filter)
- (or (string-match
- (cadr (assoc 'category filter)) cat)
- (string-match
- (cadr (assoc 'headline filter)) evt))))))
+ (let ((cat-filter (cadr (assoc 'category filter)))
+ (evt-filter (cadr (assoc 'headline filter))))
+ (or (and (stringp cat-filter)
+ (string-match cat-filter cat))
+ (and (stringp evt-filter)
+ (string-match evt-filter evt)))))))
+ (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)
@@ -8427,13 +9421,49 @@ belonging to the \"Work\" category."
"\\([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)
(message "No event to add")
(message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))))
+(autoload 'org-agenda-to-appt "org-agenda" "\
+Activate appointments found in `org-agenda-files'.
+With a \\[universal-argument] prefix, refresh the list of
+appointments.
+
+If FILTER is t, interactively prompt the user for a regular
+expression, and filter out entries that don't match it.
+
+If FILTER is a string, use this string as a regular expression
+for filtering entries out.
+
+If FILTER is a function, filter out entries against which
+calling the function returns nil. This function takes one
+argument: an entry from `org-agenda-get-day-entries'.
+
+FILTER can also be an alist with the car of each cell being
+either 'headline or 'category. For example:
+
+ '((headline \"IMPORTANT\")
+ (category \"Work\"))
+
+will only add headlines containing IMPORTANT or headlines
+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.
+
+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)
+
(defun org-agenda-todayp (date)
"Does DATE mean today, when considering `org-extend-today-until'?"
(let ((today (org-today))
@@ -8441,8 +9471,14 @@ belonging to the \"Work\" category."
date)))
(eq date today)))
-(provide 'org-agenda)
-
+(defun org-agenda-todo-yesterday (&optional arg)
+ "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))))
+ (org-extend-today-until (1+ hour)))
+ (org-agenda-todo arg)))
+(provide 'org-agenda)
;;; org-agenda.el ends here
diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el
index 7436696433c..d41a1d38a89 100644
--- a/lisp/org/org-archive.el
+++ b/lisp/org/org-archive.el
@@ -1,11 +1,10 @@
;;; org-archive.el --- Archiving for Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -32,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."
@@ -44,6 +44,7 @@
(defcustom org-archive-reversed-order nil
"Non-nil means make the tree first child under the archive heading, not last."
:group 'org-archive
+ :version "24.1"
:type 'boolean)
(defcustom org-archive-sibling-heading "Archive"
@@ -73,6 +74,7 @@ This variable is obsolete and has no effect anymore, instead add or remove
(defcustom org-archive-subtree-add-inherited-tags 'infile
"Non-nil means append inherited tags when archiving a subtree."
:group 'org-archive
+ :version "24.1"
:type '(choice
(const :tag "Never" nil)
(const :tag "When archiving a subtree to the same file" infile)
@@ -99,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."
@@ -179,6 +181,7 @@ if LOCATION is not given, the value of `org-archive-location' is used."
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))
+;;;###autoload
(defun org-archive-subtree (&optional find-done)
"Move the current subtree to the archive.
The archive can be a certain top-level heading in the current file, or in
@@ -191,228 +194,266 @@ If the cursor is not at a headline when this command is called, try all level
1 trees. If the cursor is on a headline, only try the direct children of
this heading."
(interactive "P")
- (if find-done
- (org-archive-all-done)
- ;; Save all relevant TODO keyword-relatex variables
-
- (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
- (tr-org-todo-keywords-1 org-todo-keywords-1)
- (tr-org-todo-kwd-alist org-todo-kwd-alist)
- (tr-org-done-keywords org-done-keywords)
- (tr-org-todo-regexp org-todo-regexp)
- (tr-org-todo-line-regexp org-todo-line-regexp)
- (tr-org-odd-levels-only org-odd-levels-only)
- (this-buffer (current-buffer))
- ;; start of variables that will be used for saving context
- ;; The compiler complains about them - keep them anyway!
- (file (abbreviate-file-name
- (or (buffer-file-name (buffer-base-buffer))
- (error "No file associated to buffer"))))
- (olpath (mapconcat 'identity (org-get-outline-path) "/"))
- (time (format-time-string
- (substring (cdr org-time-stamp-formats) 1 -1)
- (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)
-
- ;; 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)))
- (unless afile
- (error "Invalid `org-archive-location'"))
-
- (if (> (length afile) 0)
- (setq newfile-p (not (file-exists-p afile))
- visiting (find-buffer-visiting afile)
- buffer (or visiting (find-file-noselect afile)))
- (setq buffer (current-buffer)))
- (unless buffer
- (error "Cannot access file \"%s\"" afile))
- (if (and (> (length heading) 0)
- (string-match "^\\*+" heading))
- (setq level (match-end 0))
- (setq heading nil level 0))
- (save-excursion
- (org-back-to-heading t)
- ;; Get context information that will be lost by moving the tree
- (setq category (org-get-category nil 'force-refresh)
- todo (and (looking-at org-todo-line-regexp)
- (match-string 2))
- priority (org-get-priority
- (if (match-end 3) (match-string 3) ""))
- ltags (org-get-tags)
- itags (org-delete-all ltags (org-get-tags-at))
- atags (org-get-tags-at))
- (setq ltags (mapconcat 'identity ltags " ")
- itags (mapconcat 'identity itags " "))
- ;; We first only copy, in case something goes wrong
- ;; we need to protect `this-command', to avoid kill-region sets it,
- ;; which would lead to duplication of subtrees
- (let (this-command) (org-copy-subtree 1 nil t))
- (set-buffer buffer)
- ;; Enforce org-mode for the archive buffer
- (if (not (org-mode-p))
- ;; Force the mode for future visits.
- (let ((org-insert-mode-line-in-empty-file t)
- (org-inhibit-startup t))
- (call-interactively 'org-mode)))
- (when newfile-p
- (goto-char (point-max))
- (insert (format "\nArchived entries from file %s\n\n"
- (buffer-file-name this-buffer))))
- ;; 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)
- (org-todo-kwd-alist tr-org-todo-kwd-alist)
- (org-done-keywords tr-org-done-keywords)
- (org-todo-regexp tr-org-todo-regexp)
- (org-todo-line-regexp tr-org-todo-line-regexp)
- (org-odd-levels-only
- (if (local-variable-p 'org-odd-levels-only (current-buffer))
- org-odd-levels-only
- tr-org-odd-levels-only)))
- (goto-char (point-min))
- (show-all)
- (if heading
- (progn
- (if (re-search-forward
- (concat "^" (regexp-quote heading)
- (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)"))
- nil t)
- (goto-char (match-end 0))
- ;; Heading not found, just insert it at the end
- (goto-char (point-max))
- (or (bolp) (insert "\n"))
- (insert "\n" heading "\n")
- (end-of-line 0))
- ;; Make the subtree visible
- (show-subtree)
- (if org-archive-reversed-order
- (progn
- (org-back-to-heading t)
- (outline-next-heading))
- (org-end-of-subtree t))
- (skip-chars-backward " \t\r\n")
- (and (looking-at "[ \t\r\n]*")
- (replace-match "\n\n")))
- ;; No specific heading, just go to end of file.
- (goto-char (point-max)) (insert "\n"))
- ;; Paste
- (org-paste-subtree (org-get-valid-level level (and heading 1)))
- ;; Shall we append inherited tags?
- (and itags
- (or (and (eq org-archive-subtree-add-inherited-tags 'infile)
- infile-p)
- (eq org-archive-subtree-add-inherited-tags t))
- (org-set-tags-to atags))
- ;; Mark the entry as done
- (when (and org-archive-mark-done
- (looking-at org-todo-line-regexp)
- (or (not (match-end 2))
- (not (member (match-string 2) org-done-keywords))))
- (let (org-log-done org-todo-log-states)
- (org-todo
- (car (or (member org-archive-mark-done org-done-keywords)
- org-done-keywords)))))
-
- ;; Add the context info
- (when org-archive-save-context-info
- (let ((l org-archive-save-context-info) e n v)
- (while (setq e (pop l))
- (when (and (setq v (symbol-value e))
- (stringp v) (string-match "\\S-" v))
- (setq n (concat "ARCHIVE_" (upcase (symbol-name e))))
- (org-entry-put (point) n v)))))
-
- ;; Save and kill the buffer, if it is not the same buffer.
- (when (not (eq this-buffer buffer))
- (save-buffer))))
- ;; Here we are back in the original buffer. Everything seems to have
- ;; worked. So now cut the tree and finish up.
- (let (this-command) (org-cut-subtree))
- (when (featurep 'org-inlinetask)
- (org-inlinetask-remove-END-maybe))
- (setq org-markers-to-move nil)
- (message "Subtree archived %s"
- (if (eq this-buffer buffer)
- (concat "under heading: " heading)
- (concat "in file: " (abbreviate-file-name afile))))))
- (org-reveal)
- (if (looking-at "^[ \t]*$")
- (outline-next-visible-heading 1)))
+ (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
+ `(progn (setq org-map-continue-from (progn (org-back-to-heading) (point)))
+ (org-archive-subtree ,find-done))
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (if find-done
+ (org-archive-all-done)
+ ;; Save all relevant TODO keyword-relatex variables
+ (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
+ (tr-org-todo-keywords-1 org-todo-keywords-1)
+ (tr-org-todo-kwd-alist org-todo-kwd-alist)
+ (tr-org-done-keywords org-done-keywords)
+ (tr-org-todo-regexp org-todo-regexp)
+ (tr-org-todo-line-regexp org-todo-line-regexp)
+ (tr-org-odd-levels-only org-odd-levels-only)
+ (this-buffer (current-buffer))
+ ;; start of variables that will be used for saving context
+ ;; The compiler complains about them - keep them anyway!
+ (file (abbreviate-file-name
+ (or (buffer-file-name (buffer-base-buffer))
+ (error "No file associated to buffer"))))
+ (olpath (mapconcat 'identity (org-get-outline-path) "/"))
+ (time (format-time-string
+ (substring (cdr org-time-stamp-formats) 1 -1)
+ (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
+ 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 (or afile ""))))
+ (unless afile
+ (error "Invalid `org-archive-location'"))
+
+ (if (> (length afile) 0)
+ (setq newfile-p (not (file-exists-p afile))
+ visiting (find-buffer-visiting afile)
+ buffer (or visiting (find-file-noselect afile)))
+ (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))
+ (setq heading nil level 0))
+ (save-excursion
+ (org-back-to-heading t)
+ ;; Get context information that will be lost by moving the tree
+ (setq category (org-get-category nil 'force-refresh)
+ todo (and (looking-at org-todo-line-regexp)
+ (match-string 2))
+ priority (org-get-priority
+ (if (match-end 3) (match-string 3) ""))
+ ltags (org-get-tags)
+ itags (org-delete-all ltags (org-get-tags-at))
+ atags (org-get-tags-at))
+ (setq ltags (mapconcat 'identity ltags " ")
+ itags (mapconcat 'identity itags " "))
+ ;; We first only copy, in case something goes wrong
+ ;; we need to protect `this-command', to avoid kill-region sets it,
+ ;; which would lead to duplication of subtrees
+ (let (this-command) (org-copy-subtree 1 nil t))
+ (set-buffer buffer)
+ ;; Enforce org-mode for the archive buffer
+ (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))
+ (call-interactively 'org-mode)))
+ (when newfile-p
+ (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)
+ (org-todo-kwd-alist tr-org-todo-kwd-alist)
+ (org-done-keywords tr-org-done-keywords)
+ (org-todo-regexp tr-org-todo-regexp)
+ (org-todo-line-regexp tr-org-todo-line-regexp)
+ (org-odd-levels-only
+ (if (local-variable-p 'org-odd-levels-only (current-buffer))
+ org-odd-levels-only
+ tr-org-odd-levels-only)))
+ (goto-char (point-min))
+ (show-all)
+ (if (and heading (not (and datetree-date (not datetree-subheading-p))))
+ (progn
+ (if (re-search-forward
+ (concat "^" (regexp-quote heading)
+ (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)"))
+ nil t)
+ (goto-char (match-end 0))
+ ;; Heading not found, just insert it at the end
+ (goto-char (point-max))
+ (or (bolp) (insert "\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)
+ (if org-archive-reversed-order
+ (progn
+ (org-back-to-heading t)
+ (outline-next-heading))
+ (org-end-of-subtree t))
+ (skip-chars-backward " \t\r\n")
+ (and (looking-at "[ \t\r\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)) (unless datetree-date (insert "\n")))
+ ;; Paste
+ (org-paste-subtree (org-get-valid-level level (and heading 1)))
+ ;; Shall we append inherited tags?
+ (and itags
+ (or (and (eq org-archive-subtree-add-inherited-tags 'infile)
+ infile-p)
+ (eq org-archive-subtree-add-inherited-tags t))
+ (org-set-tags-to atags))
+ ;; Mark the entry as done
+ (when (and org-archive-mark-done
+ (looking-at org-todo-line-regexp)
+ (or (not (match-end 2))
+ (not (member (match-string 2) org-done-keywords))))
+ (let (org-log-done org-todo-log-states)
+ (org-todo
+ (car (or (member org-archive-mark-done org-done-keywords)
+ org-done-keywords)))))
+
+ ;; Add the context info
+ (when org-archive-save-context-info
+ (let ((l org-archive-save-context-info) e n v)
+ (while (setq e (pop l))
+ (when (and (setq v (symbol-value e))
+ (stringp v) (string-match "\\S-" v))
+ (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))))
+ ;; Here we are back in the original buffer. Everything seems to have
+ ;; worked. So now cut the tree and finish up.
+ (let (this-command) (org-cut-subtree))
+ (when (featurep 'org-inlinetask)
+ (org-inlinetask-remove-END-maybe))
+ (setq org-markers-to-move nil)
+ (message "Subtree archived %s"
+ (if (eq this-buffer buffer)
+ (concat "under heading: " heading)
+ (concat "in file: " (abbreviate-file-name afile))))))
+ (org-reveal)
+ (if (looking-at "^[ \t]*$")
+ (outline-next-visible-heading 1))))
+;;;###autoload
(defun org-archive-to-archive-sibling ()
"Archive the current heading by moving it under the archive sibling.
The archive sibling is a sibling of the heading with the heading name
`org-archive-sibling-heading' and an `org-archive-tag' tag. If this
sibling does not exist, it will be created at the end of the subtree."
(interactive)
- (save-restriction
- (widen)
- (let (b e pos leader level)
- (org-back-to-heading t)
- (looking-at outline-regexp)
- (setq leader (match-string 0)
- level (funcall outline-level))
- (setq pos (point))
- (condition-case nil
- (outline-up-heading 1 t)
- (error (setq e (point-max)) (goto-char (point-min))))
- (setq b (point))
- (unless e
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (when (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ '(progn (setq org-map-continue-from
+ (progn (org-back-to-heading)
+ (if (looking-at (concat "^.*:" org-archive-tag ":.*$"))
+ (org-end-of-subtree t)
+ (point))))
+ (when (org-at-heading-p)
+ (org-archive-to-archive-sibling)))
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (save-restriction
+ (widen)
+ (let (b e pos leader level)
+ (org-back-to-heading t)
+ (looking-at org-outline-regexp)
+ (setq leader (match-string 0)
+ level (funcall outline-level))
+ (setq pos (point))
(condition-case nil
- (org-end-of-subtree t t)
- (error (goto-char (point-max))))
- (setq e (point)))
- (goto-char b)
- (unless (re-search-forward
- (concat "^" (regexp-quote leader)
- "[ \t]*"
- org-archive-sibling-heading
- "[ \t]*:"
- org-archive-tag ":") e t)
- (goto-char e)
- (or (bolp) (newline))
- (insert leader org-archive-sibling-heading "\n")
- (beginning-of-line 0)
- (org-toggle-tag org-archive-tag 'on))
- (beginning-of-line 1)
- (if org-archive-reversed-order
- (outline-next-heading)
- (org-end-of-subtree t t))
- (save-excursion
- (goto-char pos)
- (let ((this-command this-command)) (org-cut-subtree)))
- (org-paste-subtree (org-get-valid-level level 1))
- (org-set-property
- "ARCHIVE_TIME"
- (format-time-string
- (substring (cdr org-time-stamp-formats) 1 -1)
- (current-time)))
- (outline-up-heading 1 t)
- (hide-subtree)
- (org-cycle-show-empty-lines 'folded)
- (goto-char pos)))
- (org-reveal)
- (if (looking-at "^[ \t]*$")
- (outline-next-visible-heading 1)))
+ (outline-up-heading 1 t)
+ (error (setq e (point-max)) (goto-char (point-min))))
+ (setq b (point))
+ (unless e
+ (condition-case nil
+ (org-end-of-subtree t t)
+ (error (goto-char (point-max))))
+ (setq e (point)))
+ (goto-char b)
+ (unless (re-search-forward
+ (concat "^" (regexp-quote leader)
+ "[ \t]*"
+ org-archive-sibling-heading
+ "[ \t]*:"
+ org-archive-tag ":") e t)
+ (goto-char e)
+ (or (bolp) (newline))
+ (insert leader org-archive-sibling-heading "\n")
+ (beginning-of-line 0)
+ (org-toggle-tag org-archive-tag 'on))
+ (beginning-of-line 1)
+ (if org-archive-reversed-order
+ (outline-next-heading)
+ (org-end-of-subtree t t))
+ (save-excursion
+ (goto-char pos)
+ (let ((this-command this-command)) (org-cut-subtree)))
+ (org-paste-subtree (org-get-valid-level level 1))
+ (org-set-property
+ "ARCHIVE_TIME"
+ (format-time-string
+ (substring (cdr org-time-stamp-formats) 1 -1)
+ (current-time)))
+ (outline-up-heading 1 t)
+ (hide-subtree)
+ (org-cycle-show-empty-lines 'folded)
+ (goto-char pos)))
+ (org-reveal)
+ (if (looking-at "^[ \t]*$")
+ (outline-next-visible-heading 1))))
(defun org-archive-all-done (&optional tag)
"Archive sublevels of the current tree without open TODO items.
If the cursor is not on a headline, try all level 1 trees. If
it is on a headline, try all direct children.
When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
- (let ((re (concat org-outline-regexp-bol "+" org-not-done-regexp)) re1
+ (let ((re org-not-done-heading-regexp) re1
(rea (concat ".*:" org-archive-tag ":"))
(begm (make-marker))
(endm (make-marker))
(question (if tag "Set ARCHIVE tag (no open TODO items)? "
"Move subtree to archive (no open TODO items)? "))
beg end (cntarch 0))
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(progn
(setq re1 (concat "^" (regexp-quote
(make-string
@@ -444,25 +485,42 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
(goto-char end)))))
(message "%d trees archived" cntarch)))
+;;;###autoload
(defun org-toggle-archive-tag (&optional find-done)
"Toggle the archive tag for the current headline.
With prefix ARG, check all children of current headline and offer tagging
the children that do not contain any open TODO items."
(interactive "P")
- (if find-done
- (org-archive-all-done 'tag)
- (let (set)
- (save-excursion
- (org-back-to-heading t)
- (setq set (org-toggle-tag org-archive-tag))
- (when set (hide-subtree)))
- (and set (beginning-of-line 1))
- (message "Subtree %s" (if set "archived" "unarchived")))))
+ (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
+ `(org-toggle-archive-tag ,find-done)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (if find-done
+ (org-archive-all-done 'tag)
+ (let (set)
+ (save-excursion
+ (org-back-to-heading t)
+ (setq set (org-toggle-tag org-archive-tag))
+ (when set (hide-subtree)))
+ (and set (beginning-of-line 1))
+ (message "Subtree %s" (if set "archived" "unarchived"))))))
(defun org-archive-set-tag ()
"Set the ARCHIVE tag."
(interactive)
- (org-toggle-tag org-archive-tag 'on))
+ (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
+ 'org-archive-set-tag
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (org-toggle-tag org-archive-tag 'on)))
;;;###autoload
(defun org-archive-subtree-default ()
@@ -482,6 +540,8 @@ This command is set with the variable `org-archive-default-command'."
(provide 'org-archive)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-archive.el ends here
diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el
index d6a4e30714b..575b830f2c0 100644
--- a/lisp/org/org-ascii.el
+++ b/lisp/org/org-ascii.el
@@ -1,11 +1,10 @@
;;; org-ascii.el --- ASCII export for Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -37,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
@@ -109,7 +108,7 @@ utf8 Use all UTF-8 characters")
(defun org-export-as-utf8 (&rest args)
"Like `org-export-as-ascii', use encoding for special symbols."
(interactive)
- (org-export-as-encoding 'org-export-as-ascii
+ (org-export-as-encoding 'org-export-as-ascii
(org-called-interactively-p 'any)
'utf8 args))
@@ -145,9 +144,9 @@ command to convert it."
(interactive "r")
(let (reg ascii buf pop-up-frames)
(save-window-excursion
- (if (org-mode-p)
+ (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
@@ -155,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)))
@@ -194,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
@@ -284,7 +283,7 @@ publishing directory."
"UNTITLED"))
(email (plist-get opt-plist :email))
(language (plist-get opt-plist :language))
- (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
+ (quote-re0 (concat "^\\(" org-quote-string "\\)\\( +\\|[ \t]*$\\)"))
(todo nil)
(lang-words nil)
(region
@@ -374,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)))
-
- (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))))
@@ -439,7 +438,9 @@ publishing directory."
link (concat (match-string 1 line) path)
type (match-string 2 line)
desc0 (match-string 5 line)
- desc (or desc0 link))
+ desc0 (replace-regexp-in-string "\\\\_" "_" desc0)
+ desc (or desc0 link)
+ desc (replace-regexp-in-string "\\\\_" "_" desc))
(if (and (> (length link) 8)
(equal (substring link 0 8) "coderef:"))
(setq line (replace-match
@@ -552,6 +553,7 @@ publishing directory."
(kill-buffer (current-buffer)))
(current-buffer))))
+;;;###autoload
(defun org-export-ascii-preprocess (parameters)
"Do extra work for ASCII export."
;;
@@ -725,5 +727,8 @@ publishing directory."
(provide 'org-ascii)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-ascii.el ends here
diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el
index aa8c476e89b..25bd6e89d97 100644
--- a/lisp/org/org-attach.el
+++ b/lisp/org/org-attach.el
@@ -1,10 +1,9 @@
;;; org-attach.el --- Manage file attachments to org-mode tasks
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@newartisans.com>
;; Keywords: org data task
-;; Version: 7.7
;; This file is part of GNU Emacs.
;;
@@ -79,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."
@@ -102,10 +104,11 @@ ln create a hard link. Note that this is not supported
(defcustom org-attach-store-link-p nil
"Non-nil means store a link to a file when attaching it."
:group 'org-attach
+ :version "24.1"
:type '(choice
(const :tag "Don't store link" nil)
(const :tag "Link to origin location" t)
- (const :tag "Link to the attach-dir location" 'attached)))
+ (const :tag "Link to the attach-dir location" attached)))
;;;###autoload
(defun org-attach ()
@@ -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 ()
@@ -437,5 +451,8 @@ prefix."
(provide 'org-attach)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-attach.el ends here
diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el
index 8401196c81a..0fcf27565d5 100644
--- a/lisp/org/org-bbdb.el
+++ b/lisp/org/org-bbdb.el
@@ -1,12 +1,11 @@
;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
-;; Author: Carsten Dominik <carsten at orgmode dot org>,
-;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
+;; Authors: Carsten Dominik <carsten at orgmode dot org>
+;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -110,14 +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
@@ -132,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)
@@ -196,9 +202,12 @@ date year)."
"Store a link to a BBDB database entry."
(when (eq major-mode 'bbdb-mode)
;; This is BBDB, we make this link!
- (let* ((name (bbdb-record-name (bbdb-current-record)))
- (company (bbdb-record-getprop (bbdb-current-record) 'company))
- (link (org-make-link "bbdb:" name)))
+ (let* ((rec (bbdb-current-record))
+ (name (bbdb-record-name rec))
+ (company (if (fboundp 'bbdb-record-getprop)
+ (bbdb-record-getprop rec 'company)
+ (car (bbdb-record-get-field rec 'organization))))
+ (link (concat "bbdb:" name)))
(org-store-link-props :type "bbdb" :name name :company company
:link link :description name)
link)))
@@ -212,37 +221,64 @@ 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)
"Follow a BBDB link to NAME."
- (require 'bbdb)
+ (require 'bbdb-com)
(let ((inhibit-redisplay (not debug-on-error))
(bbdb-electric-p nil))
- (catch 'exit
- ;; Exact match on name
- (bbdb-name (concat "\\`" name "\\'") nil)
- (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
- ;; Exact match on name
- (bbdb-company (concat "\\`" name "\\'") nil)
- (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
- ;; Partial match on name
- (bbdb-name name nil)
- (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
- ;; Partial match on company
- (bbdb-company name nil)
- (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
- ;; General match including network address and notes
- (bbdb name nil)
- (when (= 0 (buffer-size (get-buffer "*BBDB*")))
- (delete-window (get-buffer-window "*BBDB*"))
- (error "No matching BBDB record")))))
+ (if (fboundp 'bbdb-name)
+ (org-bbdb-open-old name)
+ (org-bbdb-open-new name))))
+
+(defun org-bbdb-open-old (name)
+ (catch 'exit
+ ;; Exact match on name
+ (bbdb-name (concat "\\`" name "\\'") nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; Exact match on name
+ (bbdb-company (concat "\\`" name "\\'") nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; Partial match on name
+ (bbdb-name name nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; Partial match on company
+ (bbdb-company name nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; General match including network address and notes
+ (bbdb name nil)
+ (when (= 0 (buffer-size (get-buffer "*BBDB*")))
+ (delete-window (get-buffer-window "*BBDB*"))
+ (error "No matching BBDB record"))))
+
+(defun org-bbdb-open-new (name)
+ (catch 'exit
+ ;; Exact match on name
+ (bbdb-search-name (concat "\\`" name "\\'") nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; Exact match on name
+ (bbdb-search-organization (concat "\\`" name "\\'") nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; Partial match on name
+ (bbdb-search-name name nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; Partial match on company
+ (bbdb-search-organization name nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; General match including network address and notes
+ (bbdb name nil)
+ (when (= 0 (buffer-size (get-buffer "*BBDB*")))
+ (delete-window (get-buffer-window "*BBDB*"))
+ (error "No matching BBDB record"))))
(defun org-bbdb-anniv-extract-date (time-str)
"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)
@@ -269,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)
@@ -296,7 +338,7 @@ This is used by Org to re-create the anniversary hash table."
(add-hook 'bbdb-after-change-hook 'org-bbdb-updated)
;;;###autoload
-(defun org-bbdb-anniversaries()
+(defun org-bbdb-anniversaries ()
"Extract anniversaries from BBDB for display in the agenda."
(require 'bbdb)
(require 'diary-lib)
@@ -357,7 +399,7 @@ This is used by Org to re-create the anniversary hash table."
(bbdb-record-name (car (bbdb-completing-read-record "Name: ")))))
(defun org-bbdb-anniv-export-ical ()
- "Extract anniversaries from BBDB and convert them to iCalendar format."
+ "Extract anniversaries from BBDB and convert them to icalendar format."
(require 'bbdb)
(require 'diary-lib)
(unless (hash-table-p org-bbdb-anniv-hash)
@@ -391,6 +433,8 @@ END:VEVENT\n"
(provide 'org-bbdb)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-bbdb.el ends here
diff --git a/lisp/org/org-beamer.el b/lisp/org/org-beamer.el
index d5f9beea337..73d15416e60 100644
--- a/lisp/org/org-beamer.el
+++ b/lisp/org/org-beamer.el
@@ -1,8 +1,7 @@
;;; org-beamer.el --- Beamer-specific LaTeX export for org-mode
;;
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;;
-;; Version: 7.7
;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Keywords: org, wp, tex
@@ -44,6 +43,7 @@
(defcustom org-beamer-use-parts nil
""
:group 'org-beamer
+ :version "24.1"
:type 'boolean)
(defcustom org-beamer-frame-level 1
@@ -53,6 +53,7 @@ Setting this to 2 will allow sections, 3 will allow subsections as well.
You can set this to 4 as well, if you at the same time set
`org-beamer-use-parts' to make the top levels `\part'."
:group 'org-beamer
+ :version "24.1"
:type '(choice
(const :tag "Frames need a BEAMER_env property" nil)
(integer :tag "Specific level makes a frame")))
@@ -61,12 +62,14 @@ You can set this to 4 as well, if you at the same time set
"Default options string to use for frames, should contains the [brackets].
And example for this is \"[allowframebreaks]\"."
:group 'org-beamer
+ :version "24.1"
:type '(string :tag "[options]"))
(defcustom org-beamer-column-view-format
"%45ITEM %10BEAMER_env(Env) %10BEAMER_envargs(Env Args) %4BEAMER_col(Col) %8BEAMER_extra(Extra)"
"Default column view format that should be used to fill the template."
:group 'org-beamer
+ :version "24.1"
:type '(choice
(const :tag "Do not insert Beamer column view format" nil)
(string :tag "Beamer column view format")))
@@ -77,13 +80,14 @@ And example for this is \"[allowframebreaks]\"."
When a beamer template is filled, this will be the default for
BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}."
:group 'org-beamer
+ :version "24.1"
:type '(choice
(const :tag "Do not insert Beamer themes" nil)
(string :tag "Beamer themes")))
(defconst org-beamer-column-widths
"0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC"
-"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"
@@ -103,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
@@ -113,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
@@ -143,6 +148,7 @@ open The opening template for the environment, with the following escapes
close The closing string of the environment."
:group 'org-beamer
+ :version "24.1"
:type '(repeat
(list
(string :tag "Environment")
@@ -150,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)
@@ -216,7 +228,7 @@ the tag does not have any semantic meaning."
(org-entry-put nil "BEAMER_env" (match-string 1 tags)))
(t (org-entry-delete nil "BEAMER_env"))))))
-
+;;;###autoload
(defun org-beamer-sectioning (level text)
"Return the sectioning entry for the current headline.
LEVEL is the reduced level of the headline.
@@ -236,7 +248,7 @@ in org-export-latex-classes."
(envs (append org-beamer-environments-extra
org-beamer-environments-default))
(props (org-get-text-property-any 0 'org-props text))
- (in "") (out "") option action defaction environment extra
+ (in "") (out "") org-beamer-option org-beamer-action org-beamer-defaction org-beamer-environment org-beamer-extra
columns-option column-option
env have-text ass tmp)
(if (= frame-level 0) (setq frame-level nil))
@@ -267,10 +279,10 @@ in org-export-latex-classes."
(setq in (org-fill-template
"\\begin{frame}%a%A%o%T%S%x"
- (list (cons "a" (or action ""))
- (cons "A" (or defaction ""))
- (cons "o" (or option org-beamer-frame-default-options ""))
- (cons "x" (if extra (concat "\n" extra) ""))
+ (list (cons "a" (or org-beamer-action ""))
+ (cons "A" (or org-beamer-defaction ""))
+ (cons "o" (or org-beamer-option org-beamer-frame-default-options ""))
+ (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) ""))
(cons "h" "%s")
(cons "T" (if (string-match "\\S-" text)
"\n\\frametitle{%s}" ""))
@@ -295,10 +307,10 @@ in org-export-latex-classes."
(setq have-text (string-match "\\S-" text))
(setq in (org-fill-template
(nth 2 ass)
- (list (cons "a" (or action ""))
- (cons "A" (or defaction ""))
- (cons "o" (or option ""))
- (cons "x" (if extra (concat "\n" extra) ""))
+ (list (cons "a" (or org-beamer-action ""))
+ (cons "A" (or org-beamer-defaction ""))
+ (cons "o" (or org-beamer-option ""))
+ (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) ""))
(cons "h" "%s")
(cons "H" (if have-text (concat "{" text "}") ""))
(cons "U" (if have-text (concat "[" text "]") ""))))
@@ -322,31 +334,31 @@ in org-export-latex-classes."
(cons text (cdr (assoc level default))))
(t nil))))
-(defvar extra)
-(defvar option)
-(defvar action)
-(defvar defaction)
-(defvar environment)
+(defvar org-beamer-extra)
+(defvar org-beamer-option)
+(defvar org-beamer-action)
+(defvar org-beamer-defaction)
+(defvar org-beamer-environment)
(defun org-beamer-get-special (props)
"Extract an option, action, and default action string from text.
-The variables option, action, defaction, extra are all scoped into
-this function dynamically."
+The variables org-beamer-option, org-beamer-action, org-beamer-defaction,
+org-beamer-extra are all scoped into this function dynamically."
(let (tmp)
- (setq environment (org-beamer-assoc-not-empty "BEAMER_env" props))
- (setq extra (org-beamer-assoc-not-empty "BEAMER_extra" props))
- (when extra
- (setq extra (replace-regexp-in-string "\\\\n" "\n" extra)))
+ (setq org-beamer-environment (org-beamer-assoc-not-empty "BEAMER_env" props))
+ (setq org-beamer-extra (org-beamer-assoc-not-empty "BEAMER_extra" props))
+ (when org-beamer-extra
+ (setq org-beamer-extra (replace-regexp-in-string "\\\\n" "\n" org-beamer-extra)))
(setq tmp (org-beamer-assoc-not-empty "BEAMER_envargs" props))
(when tmp
(setq tmp (copy-sequence tmp))
(if (string-match "\\[<[^][<>]*>\\]" tmp)
- (setq defaction (match-string 0 tmp)
+ (setq org-beamer-defaction (match-string 0 tmp)
tmp (replace-match "" t t tmp)))
(if (string-match "\\[[^][]*\\]" tmp)
- (setq option (match-string 0 tmp)
+ (setq org-beamer-option (match-string 0 tmp)
tmp (replace-match "" t t tmp)))
(if (string-match "<[^<>]*>" tmp)
- (setq action (match-string 0 tmp)
+ (setq org-beamer-action (match-string 0 tmp)
tmp (replace-match "" t t tmp))))))
(defun org-beamer-assoc-not-empty (elt list)
@@ -358,6 +370,7 @@ this function dynamically."
"The keymap for `org-beamer-mode'.")
(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment)
+;;;###autoload
(define-minor-mode org-beamer-mode
"Special support for editing Org-mode files made to export to beamer."
nil " Bm" nil)
@@ -400,9 +413,10 @@ the value will be inserted right after the documentclass statement."
(insert org-beamer-header-extra)
(or (bolp) (insert "\n"))))))
-(defcustom org-beamer-fragile-re "^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\|minted\\)}"
+(defcustom org-beamer-fragile-re "\\\\\\(verb\\|lstinline\\)\\|^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\|minted\\)}"
"If this regexp matches in a frame, the frame is marked as fragile."
:group 'org-beamer
+ :version "24.1"
:type 'regexp)
(defface org-beamer-tag '((t (:box (:line-width 1 :color grey40))))
@@ -482,6 +496,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))))))
@@ -496,7 +516,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
@@ -512,16 +532,18 @@ This function will run in the final LaTeX document."
(defcustom org-beamer-outline-frame-title "Outline"
"Default title of a frame containing an outline."
: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}.
You might want to put e.g. [allowframebreaks=0.9] here. Remember to
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."
@@ -580,7 +602,7 @@ include square brackets."
(add-hook 'org-export-preprocess-before-selecting-backend-code-hook
'org-beamer-select-beamer-code)
-(defun org-insert-beamer-options-template (kind)
+(defun org-insert-beamer-options-template (&optional kind)
"Insert a settings template, to make sure users do this right."
(interactive (progn
(message "Current [s]ubtree or [g]lobal?")
@@ -632,6 +654,4 @@ include square brackets."
(provide 'org-beamer)
-
-
;;; org-beamer.el ends here
diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el
index 3607458a410..f8e07adcd8a 100644
--- a/lisp/org/org-bibtex.el
+++ b/lisp/org/org-bibtex.el
@@ -1,12 +1,11 @@
;;; org-bibtex.el --- Org links to BibTeX entries
;;
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;;
-;; Author: Bastien Guerry <bzg at altern dot org>
-;; Carsten Dominik <carsten dot dominik at gmail dot com>
-;; Eric Schulte <schulte dot eric at gmail dot com>
+;; Authors: Bastien Guerry <bzg at altern dot org>
+;; Carsten Dominik <carsten dot dominik at gmail dot com>
+;; Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: org, wp, remember
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -112,8 +111,9 @@
(require 'bibtex)
(eval-when-compile
(require 'cl))
+(require 'org-compat)
-(defvar description nil) ; dynamically scoped from org.el
+(defvar org-bibtex-description nil) ; dynamically scoped from org.el
(defvar org-id-locations)
(declare-function bibtex-beginning-of-entry "bibtex" ())
@@ -185,52 +185,55 @@
"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 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
"Set to a truth value to use `bibtex-generate-autokey' to generate keys."
:group 'org-bibtex
+ :version "24.1"
:type 'boolean)
(defcustom org-bibtex-prefix nil
"Optional prefix for all bibtex property names.
-For example setting to 'BIB_' would allow interoperability with Fireforg."
+For example setting to 'BIB_' would allow interoperability with fireforg."
:group 'org-bibtex
+ :version "24.1"
:type 'string)
(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"
:type 'boolean)
(defcustom org-bibtex-export-arbitrary-fields nil
@@ -239,48 +242,62 @@ This only has effect if `org-bibtex-prefix' is defined, so as to
ensure that other org-properties, such as CATEGORY or LOGGING are
not placed in the exported bibtex entry."
:group 'org-bibtex
+ :version "24.1"
:type 'boolean)
(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
+ :version "24.1"
:type 'string)
(defcustom org-bibtex-tags nil
"List of tag(s) that should be added to new bib entries."
:group 'org-bibtex
+ :version "24.1"
:type '(repeat :tag "Tag" (string)))
(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
+ :version "24.1"
:type 'boolean)
(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)))
+(defcustom org-bibtex-type-property-name "btype"
+ "Property in which to store bibtex entry type (e.g., article)."
+ :group 'org-bibtex
+ :version "24.1"
+ :type 'string)
+
;;; Utility functions
(defun org-bibtex-get (property)
((lambda (it) (when it (org-babel-trim it)))
- (or (org-entry-get (point) (upcase property))
- (org-entry-get (point) (concat org-bibtex-prefix (upcase property))))))
+ (let ((org-special-properties
+ (delete "FILE" (copy-sequence org-special-properties))))
+ (or
+ (org-entry-get (point) (upcase property))
+ (org-entry-get (point) (concat org-bibtex-prefix (upcase property)))))))
(defun org-bibtex-put (property value)
(let ((prop (upcase (if (keywordp property)
@@ -293,67 +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 "type"))
- (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)
+ (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 "TYPE")) (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 ", ")))
- (bibtex-reformat) (buffer-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)))
@@ -365,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))
@@ -384,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)))))))
@@ -456,7 +480,7 @@ With optional argument OPTIONAL, also prompt for optional fields."
:btype (or (cdr (assoc "=type=" entry)) "[no type]")
:type "bibtex"
:link link
- :description description))))
+ :description org-bibtex-description))))
(defun org-create-file-search-in-bibtex ()
"Create the search string and description for a BibTeX database entry."
@@ -474,7 +498,7 @@ With optional argument OPTIONAL, also prompt for optional fields."
(bibtex-autokey-titleword-case-convert-function 'identity)
(bibtex-autokey-titleword-length 'infty)
(bibtex-autokey-year-title-separator ": "))
- (setq description (bibtex-generate-autokey)))
+ (setq org-bibtex-description (bibtex-generate-autokey)))
;; Now parse the entry, get the key and return it.
(save-excursion
(bibtex-beginning-of-entry)
@@ -514,9 +538,20 @@ Headlines are exported using `org-bibtex-export-headline'."
"Bibtex file: " nil nil nil
(file-name-nondirectory
(concat (file-name-sans-extension (buffer-file-name)) ".bib")))))
- (let ((bibtex-entries (remove nil (org-map-entries #'org-bibtex-headline))))
- (with-temp-file filename
- (insert (mapconcat #'identity bibtex-entries "\n")))))
+ ((lambda (error-point)
+ (when error-point
+ (goto-char error-point)
+ (message "Bibtex error at %S" (nth 4 (org-heading-components)))))
+ (catch 'bib
+ (let ((bibtex-entries (remove nil (org-map-entries
+ (lambda ()
+ (condition-case foo
+ (org-bibtex-headline)
+ (error (throw 'bib (point)))))))))
+ (with-temp-file filename
+ (insert (mapconcat #'identity bibtex-entries "\n")))
+ (message "Successfully exported %d BibTeX entries to %s"
+ (length bibtex-entries) filename) nil))))
(defun org-bibtex-check (&optional optional)
"Check the current headline for required fields.
@@ -525,7 +560,7 @@ With prefix argument OPTIONAL also prompt for optional fields."
(save-restriction
(org-narrow-to-subtree)
(let ((type ((lambda (name) (when name (intern (concat ":" name))))
- (org-bibtex-get "TYPE"))))
+ (org-bibtex-get org-bibtex-type-property-name))))
(when type (org-bibtex-fleshout type optional)))))
(defun org-bibtex-check-all (&optional optional)
@@ -542,18 +577,20 @@ If nonew is t, add data to the headline of the entry at point."
"Type: " (mapcar (lambda (type)
(substring (symbol-name (car type)) 1))
org-bibtex-types)
- nil nil (when nonew (org-bibtex-get "TYPE"))))
+ nil nil (when nonew
+ (org-bibtex-get org-bibtex-type-property-name))))
(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)
(let ((title (org-bibtex-ask :title)))
(insert title)
(org-bibtex-put "TITLE" title)))
- (org-bibtex-put "TYPE" (substring (symbol-name type) 1))
+ (org-bibtex-put org-bibtex-type-property-name
+ (substring (symbol-name type) 1))
(org-bibtex-fleshout type arg)
(mapc (lambda (tag) (org-toggle-tag tag 'on)) org-bibtex-tags)))
@@ -564,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 "TYPE" (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."
@@ -623,12 +663,13 @@ 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."
(interactive)
- (kill-new (org-bibtex-headline)))
+ (let ((result (org-bibtex-headline)))
+ (kill-new result) result))
(defun org-bibtex-search (string)
"Search for bibliographical entries in agenda files.
@@ -637,11 +678,10 @@ This function relies `org-search-view' to locate results."
(let ((org-agenda-overriding-header "Bib search results:")
(org-agenda-search-view-always-boolean t))
(org-search-view nil
- (format "%s +{:%sTYPE:}"
- string org-bibtex-prefix))))
+ (format "%s +{:%s%s:}"
+ string org-bibtex-prefix
+ org-bibtex-type-property-name))))
(provide 'org-bibtex)
-
-
;;; org-bibtex.el ends here
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index e3a87b77b5c..1dfffc6fe1d 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -1,11 +1,10 @@
;;; org-capture.el --- Fast note taking in Org-mode
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -57,6 +56,11 @@
(date &optional keep-restriction))
(declare-function org-table-get-specials "org-table" ())
(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)
@@ -100,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
@@ -182,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.
@@ -210,138 +222,158 @@ 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
info | %:type %:file %:node
calendar | %:type %:date"
:group 'org-capture
+ :version "24.1"
: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.
-The capture buffer is still current when this hook runs."
+The capture buffer is still current when this hook runs and it is
+widened to the entire buffer."
:group 'org-capture
+ :version "24.1"
:type 'hook)
(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
@@ -389,18 +421,81 @@ 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)
;;; The main commands
+(defvar org-capture-initial nil)
+(defvar org-capture-entry nil)
+
+;;;###autoload
+(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.
@@ -419,10 +514,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))
@@ -433,9 +535,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)
@@ -484,7 +588,7 @@ bypassed."
(error "Capture template `%s': %s"
(org-capture-get :key)
(nth 1 error))))
- (if (and (org-mode-p)
+ (if (and (derived-mode-p 'org-mode)
(org-capture-get :clock-in))
(condition-case nil
(progn
@@ -525,6 +629,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)
@@ -572,9 +678,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 (org-mode-p)
+ (when (derived-mode-p 'org-mode)
(save-excursion
(when (ignore-errors (org-back-to-heading))
(org-update-parent-todo-statistics)
@@ -589,11 +696,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))
@@ -670,8 +783,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)))
@@ -695,9 +808,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
@@ -722,7 +837,7 @@ already gone. Any prefix argument will be passed to the refile command."
(widen)
(let ((hd (nth 2 target)))
(goto-char (point-min))
- (unless (org-mode-p)
+ (unless (derived-mode-p 'org-mode)
(error
"Target buffer \"%s\" for file+headline should be in Org mode"
(current-buffer)))
@@ -754,7 +869,7 @@ already gone. Any prefix argument will be passed to the refile command."
(goto-char (if (org-capture-get :prepend)
(match-beginning 0) (match-end 0)))
(org-capture-put :exact-position (point))
- (setq target-entry-p (and (org-mode-p) (org-at-heading-p))))
+ (setq target-entry-p (and (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))
@@ -776,10 +891,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)
+ (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)
@@ -788,12 +915,12 @@ already gone. Any prefix argument will be passed to the refile command."
(widen)
(funcall (nth 2 target))
(org-capture-put :exact-position (point))
- (setq target-entry-p (and (org-mode-p) (org-at-heading-p))))
+ (setq target-entry-p (and (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 (org-mode-p) (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)
@@ -806,8 +933,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.
@@ -847,6 +980,7 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(goto-char (org-capture-get :pos))
(org-set-local 'org-capture-target-marker
(move-marker (make-marker) (point)))
+ (org-set-local 'outline-level 'org-outline-level)
(let* ((template (org-capture-get :template))
(type (org-capture-get :type)))
(case type
@@ -886,7 +1020,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))
@@ -898,8 +1032,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."
@@ -907,30 +1042,30 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(target-entry-p (org-capture-get :target-entry-p))
(ind 0)
beg end)
- (cond
- ((org-capture-get :exact-position)
- (goto-char (org-capture-get :exact-position)))
- ((not target-entry-p)
- ;; Insert as top-level entry, either at beginning or at end of file
- (setq beg (point-min) end (point-max)))
- (t
- (setq beg (1+ (point-at-eol))
- end (save-excursion (outline-next-heading) (point)))))
- (if (org-capture-get :prepend)
- (progn
- (goto-char beg)
- (if (org-list-search-forward (org-item-beginning-re) end t)
- (progn
- (goto-char (match-beginning 0))
- (setq ind (org-get-indentation)))
- (goto-char end)
- (setq ind 0)))
- (goto-char end)
- (if (org-list-search-backward (org-item-beginning-re) beg t)
+ (if (org-capture-get :exact-position)
+ (goto-char (org-capture-get :exact-position))
+ (cond
+ ((not target-entry-p)
+ ;; Insert as top-level entry, either at beginning or at end of file
+ (setq beg (point-min) end (point-max)))
+ (t
+ (setq beg (1+ (point-at-eol))
+ end (save-excursion (outline-next-heading) (point)))))
+ (if (org-capture-get :prepend)
(progn
- (setq ind (org-get-indentation))
- (org-end-of-item))
- (setq ind 0)))
+ (goto-char beg)
+ (if (org-list-search-forward (org-item-beginning-re) end t)
+ (progn
+ (goto-char (match-beginning 0))
+ (setq ind (org-get-indentation)))
+ (goto-char end)
+ (setq ind 0)))
+ (goto-char end)
+ (if (org-list-search-backward (org-item-beginning-re) beg t)
+ (progn
+ (setq ind (org-get-indentation))
+ (org-end-of-item))
+ (setq ind 0))))
;; Remove common indentation
(setq txt (org-remove-indentation txt))
;; Make sure this is indeed an item
@@ -955,7 +1090,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."
@@ -975,9 +1112,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)
@@ -1033,7 +1170,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 ()
@@ -1068,7 +1207,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."
@@ -1109,7 +1250,8 @@ Of course, if exact position has been required, just put it there."
(save-restriction
(widen)
(goto-char pos)
- (bookmark-set "org-capture-last-stored")
+ (with-demoted-errors
+ (bookmark-set "org-capture-last-stored"))
(move-marker org-capture-last-stored-marker (point)))))))
(defun org-capture-narrow (beg end)
@@ -1121,7 +1263,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)
@@ -1130,7 +1273,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)))
@@ -1138,7 +1282,7 @@ Point will remain at the first line after the inserted text."
(goto-char pos)))
(defvar org-clock-marker) ; Defined in org.el
-;;;###autoload
+
(defun org-capture-insert-template-here ()
(let* ((template (org-capture-get :template))
(type (org-capture-get :type))
@@ -1146,11 +1290,11 @@ Point will remain at the first line after the inserted text."
(or (bolp) (newline))
(setq beg (point))
(cond
- ((and (eq type 'entry) (org-mode-p))
+ ((and (eq type 'entry) (derived-mode-p 'org-mode))
(org-capture-verify-tree (org-capture-get :template))
(org-paste-subtree nil template t))
((and (memq type '(item checkitem))
- (org-mode-p)
+ (derived-mode-p 'org-mode)
(save-excursion (skip-chars-backward " \t\n")
(setq pp (point))
(org-in-item-p)))
@@ -1199,7 +1343,7 @@ The user is queried for the template."
(error "No capture template selected"))
(org-capture-set-plist entry)
(org-capture-set-target-location)
- (switch-to-buffer (org-capture-get :buffer))
+ (org-pop-to-buffer-same-window (org-capture-get :buffer))
(goto-char (org-capture-get :pos))))
(defun org-capture-get-indirect-buffer (&optional buffer prefix)
@@ -1212,11 +1356,13 @@ Use PREFIX as a prefix for the name of the indirect buffer."
(setq bname (concat prefix "-" (number-to-string (incf n)) "-" base)))
(condition-case nil
(make-indirect-buffer buffer bname 'clone)
- (error (make-indirect-buffer buffer bname)))))
-
+ (error
+ (let ((buf (make-indirect-buffer buffer bname)))
+ (with-current-buffer buf (org-mode))
+ buf)))))
(defun org-capture-verify-tree (tree)
- "Throw error if TREE is not a valid tree"
+ "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")))
@@ -1226,7 +1372,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
@@ -1243,8 +1390,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))
@@ -1279,14 +1425,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))
@@ -1297,7 +1445,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)
@@ -1309,7 +1457,7 @@ The template may still contain \"%?\" for cursor positioning."
(sit-for 1))
(save-window-excursion
(delete-other-windows)
- (switch-to-buffer (get-buffer-create "*Capture*"))
+ (org-pop-to-buffer-same-window (get-buffer-create "*Capture*"))
(erase-buffer)
(insert template)
(goto-char (point-min))
@@ -1330,15 +1478,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))
@@ -1347,7 +1487,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
@@ -1357,7 +1497,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
@@ -1374,8 +1515,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)))
@@ -1406,12 +1547,12 @@ 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)
(or (equal (char-after) ?:) (insert ":"))
- (and (org-on-heading-p) (org-set-tags nil 'align)))))
+ (and (org-at-heading-p) (org-set-tags nil 'align)))))
((equal char "C")
(cond ((= (length clipboards) 1) (insert (car clipboards)))
((> (length clipboards) 1)
@@ -1427,7 +1568,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))
@@ -1439,11 +1580,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))
@@ -1462,6 +1613,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'."
@@ -1503,6 +1682,4 @@ The template may still contain \"%?\" for cursor positioning."
(provide 'org-capture)
-
-
;;; org-capture.el ends here
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index 09b646d40ba..3f252fd8c32 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -1,11 +1,10 @@
;;; org-clock.el --- The time clocking code for Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -27,7 +26,6 @@
;; This file contains the time clocking code for Org-mode
-(require 'org)
(require 'org-exp)
;;; Code:
@@ -36,8 +34,10 @@
(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
(declare-function notifications-notify "notifications" (&rest params))
+(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."
@@ -143,7 +143,7 @@ The function is called with point at the beginning of the headline."
:type 'function)
(defcustom org-clock-string-limit 0
- "Maximum length of clock strings in the modeline. 0 means no limit."
+ "Maximum length of clock strings in the mode line. 0 means no limit."
:group 'org-clock
:type 'integer)
@@ -201,8 +201,11 @@ file name play this sound file. If not possible, fall back to beep"
(const :tag "Standard beep" t)
(file :tag "Play sound file")))
-(defcustom org-clock-modeline-total 'auto
- "Default setting for the time included for the modeline clock.
+(define-obsolete-variable-alias 'org-clock-modeline-total
+ 'org-clock-mode-line-total "24.3")
+
+(defcustom org-clock-mode-line-total 'auto
+ "Default setting for the time included for the mode line clock.
This can be overruled locally using the CLOCK_MODELINE_TOTAL property.
Allowed values are:
@@ -219,13 +222,15 @@ auto Automatically, either `all', or `repeat' for repeating tasks"
(const :tag "All task time" all)
(const :tag "Automatically, `all' or since `repeat'" auto)))
-(defcustom org-task-overrun-text nil
- "The extra modeline text that should indicate that the clock is overrun.
+(defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text)
+(defcustom org-clock-task-overrun-text nil
+ "Extra mode line text to indicate that the clock is overrun.
The can be nil to indicate that instead of adding text, the clock time
should get a different face (`org-mode-line-clock-overrun').
When this is a string, it is prepended to the clock string as an indication,
also using the face `org-mode-line-clock-overrun'."
:group 'org-clock
+ :version "24.1"
:type '(choice
(const :tag "Just mark the time string" nil)
(string :tag "Text to prepend")))
@@ -245,34 +250,36 @@ 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"
:type 'plist)
(defcustom org-clock-clocktable-formatter 'org-clocktable-write-default
"Function to turn clocking data into a table.
For more information, see `org-clocktable-write-default'."
:group 'org-clocktable
+ :version "24.1"
:type 'function)
;; FIXME: translate es and nl last string "Clock summary at"
@@ -283,6 +290,7 @@ For more information, see `org-clocktable-write-default'."
("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at"))
"Terms used in clocktable, translated to different languages."
:group 'org-clocktable
+ :version "24.1"
:type 'alist)
(defcustom org-clock-clocktable-default-properties '(:maxlevel 2 :scope file)
@@ -310,13 +318,62 @@ play with them."
(defcustom org-clock-report-include-clocking-task nil
"When non-nil, include the current clocking task time in clock reports."
:group 'org-clock
+ :version "24.1"
:type 'boolean)
(defcustom org-clock-resolve-expert nil
"Non-nil means do not show the splash buffer with the clock resolver."
:group 'org-clock
+ :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
@@ -328,7 +385,7 @@ to add an effort property.")
"Hook run when stopping the current clock.")
(defvar org-clock-cancel-hook nil
- "Hook run when canceling the current clock.")
+ "Hook run when cancelling the current clock.")
(defvar org-clock-goto-hook nil
"Hook run when selecting the currently clocked-in entry.")
(defvar org-clock-has-been-used nil
@@ -346,7 +403,7 @@ to add an effort property.")
(defvar org-clock-start-time "")
(defvar org-clock-leftover-time nil
- "If non-nil, user canceled a clock; this is when leftover time started.")
+ "If non-nil, user cancelled a clock; this is when leftover time started.")
(defvar org-clock-effort ""
"Effort estimate of the currently clocking task.")
@@ -489,7 +546,7 @@ pointing to it."
(insert (format "[%c] %-15s %s\n" i cat task))
(cons i marker)))))
-(defvar org-task-overrun nil
+(defvar org-clock-task-overrun nil
"Internal flag indicating if the clock has overrun the planned time.")
(defvar org-clock-update-period 60
"Number of seconds between mode line clock string updates.")
@@ -510,11 +567,11 @@ If not, show simply the clocked time like 01:50."
(work-done-str
(org-propertize
(format org-time-clocksum-format h m)
- 'face (if (and org-task-overrun (not org-task-overrun-text))
+ 'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text))
'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))
@@ -526,7 +583,7 @@ If not, show simply the clocked time like 01:50."
(defun org-clock-update-mode-line ()
(if org-clock-effort
(org-clock-notify-once-if-expired)
- (setq org-task-overrun nil))
+ (setq org-clock-task-overrun nil))
(setq org-mode-line-string
(org-propertize
(let ((clock-string (org-clock-get-clock-string))
@@ -538,12 +595,11 @@ 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)
- ))
- (if (and org-task-overrun org-task-overrun-text)
+ '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
- org-task-overrun-text
+ org-clock-task-overrun-text
'face 'org-mode-line-clock-overrun) org-mode-line-string)))
(force-mode-line-update))
@@ -557,39 +613,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.")
@@ -600,7 +657,7 @@ Notification is shown only once."
(when (org-clocking-p)
(let ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort))
(clocked-time (org-clock-get-clocked-time)))
- (if (setq org-task-overrun
+ (if (setq org-clock-task-overrun
(if (or (null effort-in-minutes) (zerop effort-in-minutes))
nil
(>= clocked-time effort-in-minutes)))
@@ -625,15 +682,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
@@ -649,20 +705,15 @@ 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 and launch it."
- (if (eq system-type 'gnu/linux)
- (= 0 (call-process "which" nil nil nil program-name))))
-
(defvar org-clock-mode-line-entry nil
- "Information for the modeline about the running clock.")
+ "Information for the mode line about the running clock.")
(defun org-find-open-clocks (file)
"Search through the given file and find all open clocks."
@@ -691,7 +742,7 @@ Use alsa's aplay tool if available."
(goto-char (car ,clock))
(beginning-of-line)
,@forms))))
-
+(def-edebug-spec org-with-clock-position (form body))
(put 'org-with-clock-position 'lisp-indent-function 1)
(defmacro org-with-clock (clock &rest forms)
@@ -707,7 +758,7 @@ This macro also protects the current active clock from being altered."
(outline-back-to-heading t)
(point-marker))))
,@forms)))
-
+(def-edebug-spec org-with-clock (form body))
(put 'org-with-clock 'lisp-indent-function 1)
(defsubst org-clock-clock-in (clock &optional resume start-time)
@@ -722,9 +773,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)
@@ -914,6 +965,7 @@ to be CLOCKED OUT.")))
(not (memq ch '(?K ?G ?S ?C))))
fail-quietly)))))
+;;;###autoload
(defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid)
"Resolve all currently open org-mode clocks.
If `only-dangling-p' is non-nil, only ask to resolve dangling
@@ -927,18 +979,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."
@@ -951,6 +1003,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))
@@ -961,7 +1020,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))))
@@ -1003,15 +1062,20 @@ 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
+
+;;;###autoload
(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
@@ -1019,7 +1083,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)
@@ -1030,6 +1094,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
@@ -1062,14 +1131,13 @@ 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
- (if (and (eobp) (not (org-on-heading-p)))
+ (if (and (eobp) (not (org-at-heading-p)))
(point-at-bol 0)
(point)))
- (run-hooks 'org-clock-in-prepare-hook)
(save-excursion
(when (and selected-task (marker-buffer selected-task))
;; There is a selected task, move to the correct buffer
@@ -1083,7 +1151,13 @@ 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
+ (run-hooks 'org-clock-in-prepare-hook)
+ (org-clock-history-push))
(org-clock-set-current)
(cond ((functionp org-clock-in-switch-to-state)
(looking-at org-complex-heading-regexp)
@@ -1104,7 +1178,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)))
@@ -1115,9 +1190,9 @@ the clocking selection, associated with the letter `d'."
(cond
((and org-clock-in-resume
(looking-at
- (concat "^[ \t]* " org-clock-string
+ (concat "^[ \t]*" org-clock-string
" \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
- " +\\sw+\.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
+ " *\\sw+\.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
(message "Matched %s" (match-string 1))
(setq ts (concat "[" (match-string 1) "]"))
(goto-char (match-end 1))
@@ -1137,7 +1212,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)))
@@ -1148,7 +1223,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? "
@@ -1164,18 +1240,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))
@@ -1184,6 +1268,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)
@@ -1197,10 +1316,10 @@ the clocking selection, associated with the letter `d'."
This is for the currently running clock as it is displayed
in the mode line. This function looks at the properties
LAST_REPEAT and in particular CLOCK_MODELINE_TOTAL and the
-corresponding variable `org-clock-modeline-total' and then
+corresponding variable `org-clock-mode-line-total' and then
decides which time to use."
(let ((cmt (or (org-entry-get nil "CLOCK_MODELINE_TOTAL")
- (symbol-name org-clock-modeline-total)))
+ (symbol-name org-clock-mode-line-total)))
(lr (org-entry-get nil "LAST_REPEAT")))
(cond
((equal cmt "current")
@@ -1247,9 +1366,9 @@ line and position cursor in that line."
(goto-char beg)
(when (and find-unclosed
(re-search-forward
- (concat "^[ \t]* " org-clock-string
+ (concat "^[ \t]*" org-clock-string
" \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
- " +\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")
+ " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")
end t))
(beginning-of-line 1)
(throw 'exit t))
@@ -1261,7 +1380,7 @@ line and position cursor in that line."
(and (re-search-forward org-property-end-re nil t)
(goto-char (match-beginning 0))))
(throw 'exit t))
- ;; Let's count the CLOCK lines
+ ;; Lets count the CLOCK lines
(goto-char beg)
(while (re-search-forward re end t)
(setq first (or first (match-beginning 0))
@@ -1277,7 +1396,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")
@@ -1286,7 +1405,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
@@ -1306,28 +1425,42 @@ 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)
+;;;###autoload
+(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)
@@ -1339,8 +1472,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))
@@ -1367,6 +1499,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)
@@ -1387,7 +1520,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)
@@ -1400,7 +1534,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))))))
@@ -1459,28 +1594,34 @@ UPDOWN tells whether to change 'up or 'down."
((eq org-ts-what 'year) (* 24 3600 365.2)))))
org-ts-what 'updown)))))))
+;;;###autoload
(defun org-clock-cancel ()
"Cancel the running clock by removing the start timestamp."
(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))
+;;;###autoload
(defun org-clock-goto (&optional select)
"Go to the currently clocked-in entry, or to the most recently clocked one.
With prefix arg SELECT, offer recently clocked tasks for selection."
@@ -1497,7 +1638,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(setq recent t)
(car org-clock-history))
(t (error "No active or recent clock task")))))
- (switch-to-buffer (marker-buffer m))
+ (org-pop-to-buffer-same-window (marker-buffer m))
(if (or (< m (point-min)) (> m (point-max))) (widen))
(goto-char m)
(org-show-entry)
@@ -1513,13 +1654,21 @@ 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)))
+
+;;;###autoload
+(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]*"
@@ -1536,7 +1685,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))
@@ -1585,7 +1734,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
@@ -1609,6 +1759,7 @@ nil are excluded from the clock summation."
(org-clock-sum tstart)
org-clock-file-total-minutes)))
+;;;###autoload
(defun org-clock-display (&optional total-only)
"Show subtree times in the entire buffer.
If TOTAL-ONLY is non-nil, only show the total time for the entire file
@@ -1660,8 +1811,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
@@ -1691,16 +1842,18 @@ from the `before-change-functions' in the current buffer."
(remove-hook 'before-change-functions
'org-clock-remove-overlays 'local))))
-(defvar state) ;; dynamically scoped into this function
+(defvar org-state) ;; dynamically scoped into this function
(defun org-clock-out-if-current ()
"Clock out if the current entry contains the running clock.
This is used to stop the clock after a TODO entry is marked DONE,
and is only done if the variable `org-clock-out-when-done' is not nil."
- (when (and org-clock-out-when-done
+ (when (and (org-clocking-p)
+ org-clock-out-when-done
+ (marker-buffer org-clock-marker)
(or (and (eq t org-clock-out-when-done)
- (member state org-done-keywords))
+ (member org-state org-done-keywords))
(and (listp org-clock-out-when-done)
- (member state org-clock-out-when-done)))
+ (member org-state org-clock-out-when-done)))
(equal (or (buffer-base-buffer (org-clocking-buffer))
(org-clocking-buffer))
(or (buffer-base-buffer (current-buffer))
@@ -1717,7 +1870,7 @@ and is only done if the variable `org-clock-out-when-done' is not nil."
'org-clock-out-if-current)
;;;###autoload
-(defun org-get-clocktable (&rest props)
+(defun org-clock-get-clocktable (&rest props)
"Get a formatted clocktable with parameters according to PROPS.
The table is created in a temporary buffer, fully formatted and
fontified, and then returned."
@@ -1737,6 +1890,7 @@ fontified, and then returned."
(re-search-forward "^[ \t]*#\\+END" nil t)
(point-at-bol)))))
+;;;###autoload
(defun org-clock-report (&optional arg)
"Create a table containing a report about clocked time.
If the cursor is inside an existing clocktable block, then the table
@@ -1761,17 +1915,6 @@ buffer and update it."
(org-combine-plists org-clock-clocktable-default-properties props))))
(org-update-dblock))
-(defun org-in-clocktable-p ()
- "Check if the cursor is in a clocktable."
- (let ((pos (point)) start)
- (save-excursion
- (end-of-line 1)
- (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t)
- (setq start (match-beginning 0))
- (re-search-forward "^[ \t]*#\\+END:.*" nil t)
- (>= (match-end 0) pos)
- start))))
-
(defun org-day-of-week (day month year)
"Returns the day of the week as an integer."
(nth 6
@@ -1866,13 +2009,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)
@@ -1883,12 +2026,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))
@@ -1902,27 +2044,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)))
@@ -1940,7 +2082,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)
@@ -1978,61 +2120,64 @@ 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)))))
+;;;###autoload
(defun org-dblock-write:clocktable (params)
"Write the standard clocktable."
(setq params (org-combine-plists org-clocktable-defaults params))
@@ -2050,7 +2195,6 @@ the currently selected interval size."
'org-clocktable-write-default))
cc range-text ipos pos one-file-with-archives
scope-is-list tbls level)
-
;; Check if we need to do steps
(when block
;; Get the range text for the header
@@ -2083,7 +2227,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
@@ -2092,7 +2236,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))
@@ -2151,6 +2295,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)
@@ -2160,192 +2305,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))))
-
- (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))))
+ (unless (integerp ntcol)
+ (setq params (plist-put params :tcolumns (setq ntcol 100))))
- (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)))
+ (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))))
- ;; 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)
@@ -2442,6 +2591,7 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(tags (plist-get params :tags))
(properties (plist-get params :properties))
(inherit-property-p (plist-get params :inherit-props))
+ todo-only
(matcher (if tags (cdr (org-make-tags-matcher tags))))
cc range-text st p time level hdl props tsp tbl)
@@ -2464,7 +2614,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 +2648,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))))
@@ -2536,6 +2688,48 @@ This function is made for clock tables."
(defvar org-clock-loaded nil
"Was the clock file loaded?")
+(defun org-clock-update-time-maybe ()
+ "If this is a CLOCK line, update it and return t.
+Otherwise, return nil."
+ (interactive)
+ (save-excursion
+ (beginning-of-line 1)
+ (skip-chars-forward " \t")
+ (when (looking-at org-clock-string)
+ (let ((re (concat "[ \t]*" org-clock-string
+ " *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]"
+ "\\([ \t]*=>.*\\)?\\)?"))
+ ts te h m s neg)
+ (cond
+ ((not (looking-at re))
+ nil)
+ ((not (match-end 2))
+ (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
+ (> org-clock-marker (point))
+ (<= org-clock-marker (point-at-eol)))
+ ;; The clock is running here
+ (setq org-clock-start-time
+ (apply 'encode-time
+ (org-parse-time-string (match-string 1))))
+ (org-clock-update-mode-line)))
+ (t
+ (and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
+ (end-of-line 1)
+ (setq ts (match-string 1)
+ te (match-string 3))
+ (setq s (- (org-float-time
+ (apply 'encode-time (org-parse-time-string te)))
+ (org-float-time
+ (apply 'encode-time (org-parse-time-string ts))))
+ neg (< s 0)
+ s (abs s)
+ h (floor (/ s 3600))
+ s (- s (* 3600 h))
+ m (floor (/ s 60))
+ s (- s (* 60 s)))
+ (insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m))
+ t))))))
+
(defun org-clock-save ()
"Persist various clock-related data to disk.
The details of what will be saved are regulated by the variable
@@ -2566,7 +2760,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)
@@ -2627,17 +2821,13 @@ The details of what will be saved are regulated by the variable
(if (outline-invisible-p)
(org-show-context))))))))))
-;;;###autoload
-(defun org-clock-persistence-insinuate ()
- "Set up hooks for clock persistence."
- (add-hook 'org-mode-hook 'org-clock-load)
- (add-hook 'kill-emacs-hook 'org-clock-save))
-
;; Suggested bindings
(org-defkey org-mode-map "\C-c\C-x\C-e" 'org-clock-modify-effort-estimate)
(provide 'org-clock)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-clock.el ends here
diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el
index 0f6fc0bed6a..1be105d44fb 100644
--- a/lisp/org/org-colview.el
+++ b/lisp/org/org-colview.el
@@ -1,11 +1,10 @@
;;; org-colview.el --- Column View in Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -34,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
@@ -150,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))
@@ -187,15 +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 (org-mode-p)
+ (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
- (org-get-at-bol 'txt))))
+ (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)
@@ -209,9 +210,9 @@ This is the compiled version of the format.")
(funcall org-columns-modify-value-for-display-function
title val))
((equal property "ITEM")
- (if (org-mode-p)
- (org-columns-cleanup-item
- val org-columns-current-fmt-compiled)))
+ (org-columns-cleanup-item
+ val org-columns-current-fmt-compiled
+ (or org-complex-heading-regexp cphr)))
((and calc (functionp calc)
(not (string= val ""))
(not (get-text-property 0 'org-computed val)))
@@ -239,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")))))
@@ -303,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 ()
@@ -341,24 +342,28 @@ for the duration of the command.")
(when (local-variable-p 'org-colview-initial-truncate-line-value)
(setq truncate-lines org-colview-initial-truncate-line-value)))))
-(defun org-columns-cleanup-item (item fmt)
- "Remove from ITEM what is a column in the format FMT."
- (if (not org-complex-heading-regexp)
- item
- (when (string-match org-complex-heading-regexp item)
- (setq item
- (concat
- (org-add-props (match-string 1 item) nil
- 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
- (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
- (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
- " " (save-match-data (org-columns-compact-links (match-string 4 item)))
- (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))
- (add-text-properties
- 0 (1+ (match-end 1))
- (list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
- item)
- item)))
+(defun org-columns-cleanup-item (item fmt cphr)
+ "Remove from ITEM what is a column in the format FMT.
+CPHR is the complex heading regexp to use for parsing ITEM."
+ (let (fixitem)
+ (if (not cphr)
+ item
+ (unless (string-match "^\*+ " item)
+ (setq item (concat "* " item) fixitem t))
+ (if (string-match cphr item)
+ (setq item
+ (concat
+ (org-add-props (match-string 1 item) nil
+ 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
+ (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
+ (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
+ " " (save-match-data (org-columns-compact-links (or (match-string 4 item) "")))
+ (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))
+ (add-text-properties
+ 0 (1+ (match-end 1))
+ (list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
+ item))
+ (if fixitem (replace-regexp-in-string "^\*+ " "" item) item))))
(defun org-columns-compact-links (s)
"Replace [[link][desc]] with [desc] or [link]."
@@ -437,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))))
@@ -494,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 (org-mode-p)
+ (if (and (derived-mode-p 'org-mode)
(nth 3 (assoc key org-columns-current-fmt-compiled)))
(org-columns-update key)))))))
@@ -544,7 +549,7 @@ Where possible, use the standard interface for changing this line."
(beginning-of-line 1)
;; `next-line' is needed here, because it skips invisible line.
(condition-case nil (org-no-warnings (next-line 1)) (error nil))
- (setq hidep (org-on-heading-p 1)))
+ (setq hidep (org-at-heading-p 1)))
(eval form)
(and hidep (hide-entry))))
@@ -660,27 +665,39 @@ 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))))
+
+;;;###autoload
+(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))
@@ -695,6 +712,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 ":")))
@@ -872,7 +894,7 @@ display, or in the #+COLUMNS line of the current buffer."
(replace-match (concat "#+COLUMNS: " fmt) t t))
(unless (> cnt 0)
(goto-char (point-min))
- (or (org-on-heading-p t) (outline-next-heading))
+ (or (org-at-heading-p t) (outline-next-heading))
(let ((inhibit-read-only t))
(insert-before-markers "#+COLUMNS: " fmt "\n")))
(org-set-local 'org-columns-default-format fmt))))))
@@ -925,6 +947,8 @@ Don't set this, this is meant for dynamic scoping.")
(overlay-put ov 'display (format fmt val)))))
org-columns-overlays))))
+(defvar org-inlinetask-min-level
+ (if (featurep 'org-inlinetask) org-inlinetask-min-level 15))
(defun org-columns-compute (property)
"Sum the values of property PROPERTY hierarchically, for the entire buffer."
(interactive)
@@ -939,7 +963,9 @@ Don't set this, this is meant for dynamic scoping.")
(fun (nth 6 ass))
(calc (or (nth 7 ass) 'identity))
(beg org-columns-top-level-marker)
- last-level val valflag flag end sumpos sum-alist sum str str1 useval)
+ (inminlevel org-inlinetask-min-level)
+ (last-level org-inlinetask-min-level)
+ val valflag flag end sumpos sum-alist sum str str1 useval)
(save-excursion
;; Find the region to compute
(goto-char beg)
@@ -948,16 +974,21 @@ Don't set this, this is meant for dynamic scoping.")
;; Walk the tree from the back and do the computations
(while (re-search-backward re beg t)
(setq sumpos (match-beginning 0)
- last-level level
+ last-level (if (not (or (zerop level) (eq level inminlevel)))
+ level last-level)
level (org-outline-level)
val (org-entry-get nil property)
valflag (and val (string-match "\\S-" val)))
(cond
((< level last-level)
;; put the sum of lower levels here as a property
- (setq sum (when (aref lvals last-level)
- (apply fun (aref lvals last-level)))
- flag (aref lflag last-level) ; any valid entries from children?
+ (setq sum (+ (if (and (/= last-level inminlevel)
+ (aref lvals last-level))
+ (apply fun (aref lvals last-level)) 0)
+ (if (aref lvals inminlevel)
+ (apply fun (aref lvals inminlevel)) 0))
+ flag (or (aref lflag last-level) ; any valid entries from children?
+ (aref lflag inminlevel)) ; or inline tasks?
str (org-columns-number-to-string sum format printf)
str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
useval (if flag str1 (if valflag val ""))
@@ -1000,7 +1031,7 @@ Don't set this, this is meant for dynamic scoping.")
(if (marker-position org-columns-begin-marker)
(goto-char org-columns-begin-marker))
(org-columns-remove-overlays)
- (if (org-mode-p)
+ (if (derived-mode-p 'org-mode)
(call-interactively 'org-columns)
(org-agenda-redo)
(call-interactively 'org-agenda-columns)))
@@ -1069,6 +1100,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))
@@ -1139,6 +1178,8 @@ calc function to get values from base elements"
;;; Dynamic block for Column view
+(defvar org-heading-regexp) ; defined in org.el
+(defvar org-heading-keyword-regexp-format) ; defined in org.el
(defun org-columns-capture-view (&optional maxlevel skip-empty-rows)
"Get the column view of the current buffer or subtree.
The first optional argument MAXLEVEL sets the level limit. A
@@ -1149,11 +1190,12 @@ containing the title row and all other rows. Each row is a list
of fields."
(save-excursion
(let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
- (re-comment (concat "\\*+[ \t]+" org-comment-string "\\>"))
+ (re-comment (format org-heading-keyword-regexp-format
+ org-comment-string))
(re-archive (concat ".*:" org-archive-tag ":"))
(n (length title)) row tbl)
(goto-char (point-min))
- (while (re-search-forward "^\\(\\*+\\) " nil t)
+ (while (re-search-forward org-heading-regexp nil t)
(catch 'next
(when (and (or (null maxlevel)
(>= maxlevel
@@ -1181,6 +1223,7 @@ of fields."
(push row tbl)))))
(append (list title 'hline) (nreverse tbl)))))
+;;;###autoload
(defun org-dblock-write:columnview (params)
"Write the column view table.
PARAMS is a property list of parameters:
@@ -1198,13 +1241,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))
@@ -1233,7 +1279,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))))
@@ -1270,7 +1316,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))
@@ -1290,6 +1336,7 @@ and tailing newline characters."
(t (error "Garbage in listtable: %s" x))))
tbl "\n"))
+;;;###autoload
(defun org-insert-columns-dblock ()
"Create a dynamic block capturing a column view table."
(interactive)
@@ -1313,6 +1360,7 @@ and tailing newline characters."
(defvar org-agenda-columns-compute-summary-properties); defined in org-agenda.el
(defvar org-agenda-columns-add-appointments-to-effort-sum); as well
+;;;###autoload
(defun org-agenda-columns ()
"Turn on or update column view in the agenda."
(interactive)
@@ -1320,12 +1368,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)
@@ -1353,7 +1400,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)))
@@ -1380,8 +1427,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))
@@ -1468,23 +1516,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)
@@ -1502,10 +1552,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)))))
@@ -1525,6 +1575,4 @@ The string should be two numbers joined with a \"-\"."
(provide 'org-colview)
-
-
;;; org-colview.el ends here
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el
index 5e4935caa7e..6e582b8c1d6 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -1,11 +1,10 @@
;;; org-compat.el --- Compatibility code for Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -35,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
@@ -112,6 +110,7 @@ any other entries, and any resulting duplicates will be removed entirely."
t))
t)))
+
;;;; Emacs/XEmacs compatibility
;; Keys
@@ -252,8 +251,12 @@ Works on both Emacs and XEmacs."
(defun org-activate-mark ()
(when (mark t)
(setq mark-active t)
- (unless transient-mark-mode
- (setq transient-mark-mode 'lambda)))))
+ (when (and (boundp 'transient-mark-mode)
+ (not transient-mark-mode))
+ (setq transient-mark-mode 'lambda))
+ (when (boundp 'zmacs-regions)
+ (setq zmacs-regions t)))))
+
;; Invisibility compatibility
@@ -285,6 +288,7 @@ Works on both Emacs and XEmacs."
(dolist (ext-inv-spec ext-inv-specs)
(set-extent-property (car ext-inv-spec) 'invisible
(cadr ext-inv-spec)))))
+(def-edebug-spec org-xemacs-without-invisibility (body))
(defun org-indent-to-column (column &optional minimum buffer)
"Work around a bug with extents with invisibility in XEmacs."
@@ -322,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 (or (locate-library ,library) "")))
(defun org-count-lines (s)
"How many lines in string S?"
@@ -392,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)
@@ -432,8 +424,42 @@ With two arguments, return floor and remainder of their quotient."
(let ((q (floor x y)))
(list q (- x (if y (* y q) q)))))
-(provide 'org-compat)
-
+;; `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."
+ (if (fboundp 'pop-to-buffer-same-window)
+ (funcall
+ '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 b260391a0da..a187d2facfe 100644
--- a/lisp/org/org-crypt.el
+++ b/lisp/org/org-crypt.el
@@ -1,10 +1,9 @@
;;; org-crypt.el --- Public key encryption for org-mode entries
-;; Copyright (C) 2007, 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
;; Filename: org-crypt.el
-;; Version: 7.7
;; Keywords: org-mode
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: Peter Jones <pjones@pmade.com>
@@ -76,22 +75,22 @@
(context plain recipients &optional sign always-trust))
(defgroup org-crypt nil
- "Org Crypt"
- :tag "Org Crypt"
+ "Org Crypt."
+ :tag "Org Crypt"
:group 'org)
(defcustom org-crypt-tag-matcher "crypt"
"The tag matcher used to find headings whose contents should be encrypted.
See the \"Match syntax\" section of the org manual for more details."
- :type 'string
+ :type 'string
:group 'org-crypt)
(defcustom org-crypt-key ""
"The default key to use when encrypting the contents of a heading.
This setting can also be overridden in the CRYPTKEY property."
- :type 'string
+ :type 'string
:group 'org-crypt)
(defcustom org-crypt-disable-auto-save 'ask
@@ -112,11 +111,41 @@ 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)
(const :tag "Encrypt" encrypt)))
+(defun org-crypt-check-auto-save ()
+ "Check whether auto-save-mode is enabled for the current buffer.
+
+`auto-save-mode' may cause leakage when decrypting entries, so
+check whether it's enabled, and decide what to do about it.
+
+See `org-crypt-disable-auto-save'."
+ (when buffer-auto-save-file-name
+ (cond
+ ((or
+ (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? ")))
+ (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.
+ (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."))
+ ((eq org-crypt-disable-auto-save 'encrypt)
+ (message "org-decrypt: Enabling re-encryption on auto-save.")
+ (add-hook 'auto-save-hook
+ (lambda ()
+ (message "org-crypt: Re-encrypting all decrypted entries due to auto-save.")
+ (org-encrypt-entries))
+ nil t))
+ (t nil))))
+
(defun org-crypt-key-for-heading ()
"Return the encryption key for the current heading."
(save-excursion
@@ -165,30 +194,6 @@ nil : Leave auto-save-mode enabled.
(defun org-decrypt-entry ()
"Decrypt the content of the current headline."
(interactive)
-
- ; auto-save-mode may cause leakage, so check whether it's enabled.
- (when buffer-auto-save-file-name
- (cond
- ((or
- (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? ")))
- (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.
- (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."))
- ((eq org-crypt-disable-auto-save 'encrypt)
- (message "org-decrypt: Enabling re-encryption on auto-save.")
- (add-hook 'auto-save-hook
- (lambda ()
- (message "org-crypt: Re-encrypting all decrypted entries due to auto-save.")
- (org-encrypt-entries))
- nil t))
- (t nil)))
-
(require 'epg)
(unless (org-before-first-heading-p)
(save-excursion
@@ -200,6 +205,7 @@ nil : Leave auto-save-mode enabled.
(outline-invisible-p))))
(forward-line)
(when (looking-at "-----BEGIN PGP MESSAGE-----")
+ (org-crypt-check-auto-save)
(let* ((end (save-excursion
(search-forward "-----END PGP MESSAGE-----")
(forward-line)
@@ -216,7 +222,7 @@ nil : Leave auto-save-mode enabled.
;; 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
@@ -231,16 +237,28 @@ nil : Leave auto-save-mode enabled.
(defun org-encrypt-entries ()
"Encrypt all top-level entries in the current buffer."
(interactive)
- (org-scan-tags
- 'org-encrypt-entry
- (cdr (org-make-tags-matcher org-crypt-tag-matcher))))
+ (let (todo-only)
+ (org-scan-tags
+ 'org-encrypt-entry
+ (cdr (org-make-tags-matcher org-crypt-tag-matcher))
+ todo-only)))
(defun org-decrypt-entries ()
"Decrypt all entries in the current buffer."
(interactive)
- (org-scan-tags
- 'org-decrypt-entry
- (cdr (org-make-tags-matcher org-crypt-tag-matcher))))
+ (let (todo-only)
+ (org-scan-tags
+ 'org-decrypt-entry
+ (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."
@@ -252,6 +270,4 @@ nil : Leave auto-save-mode enabled.
(provide 'org-crypt)
-
-
;;; org-crypt.el ends here
diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el
index d567b929056..a951cf99648 100644
--- a/lisp/org/org-ctags.el
+++ b/lisp/org/org-ctags.el
@@ -1,12 +1,11 @@
;;; org-ctags.el - Integrate Emacs "tags" facility with org mode.
;;
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Paul Sexton <eeeickythump@gmail.com>
-;; Version: 7.7
+
;; Keywords: org, wp
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -27,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.
;;
@@ -64,44 +63,44 @@
;; with the same name as the link; then, if unsuccessful, ask the user if
;; he/she wants to rebuild the 'TAGS' database and try again; then ask if
;; the user wishes to append 'tag' as a new toplevel heading at the end of
-;; the buffer; and finally, defer to org's default behavior which is to
+;; the buffer; and finally, defer to org's default behaviour which is to
;; search the entire text of the current buffer for 'tag'.
;;
-;; This behavior can be modified by changing the value of
+;; This behaviour can be modified by changing the value of
;; ORG-CTAGS-OPEN-LINK-FUNCTIONS. For example I have the following in my
-;; .emacs, which describes the same behavior as the above paragraph with
+;; .emacs, which describes the same behaviour as the above paragraph with
;; one difference:
;;
;; (setq org-ctags-open-link-functions
;; '(org-ctags-find-tag
;; org-ctags-ask-rebuild-tags-file-then-find-tag
;; org-ctags-ask-append-topic
-;; org-ctags-fail-silently)) ; <-- prevents org default behavior
+;; org-ctags-fail-silently)) ; <-- prevents org default behaviour
;;
;;
;; Usage
;; =====
;;
;; 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)
;;
@@ -117,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
@@ -127,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
@@ -140,6 +139,8 @@
(require 'org)
+(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
+
(defgroup org-ctags nil
"Options concerning use of ctags within org mode."
:tag "Org-Ctags"
@@ -161,6 +162,7 @@ See the ctags documentation for more information.")
(t "ctags-exuberant"))
"Full path to the ctags executable file."
:group 'org-ctags
+ :version "24.1"
:type 'file)
(defcustom org-ctags-open-link-functions
@@ -169,6 +171,7 @@ See the ctags documentation for more information.")
org-ctags-ask-append-topic)
"List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS when ORG-CTAGS is active."
:group 'org-ctags
+ :version "24.1"
:type 'hook
:options '(org-ctags-find-tag
org-ctags-ask-rebuild-tags-file-then-find-tag
@@ -190,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)
@@ -244,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))))))
@@ -305,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 (org-mode-p) org-ctags-enabled-p)
+ (if (and (derived-mode-p 'org-mode) org-ctags-enabled-p)
(org-mark-ring-push))))
@@ -385,7 +389,7 @@ the new file."
(cond
((get-buffer (concat name ".org"))
;; Buffer is already open
- (switch-to-buffer (get-buffer (concat name ".org"))))
+ (org-pop-to-buffer-same-window (get-buffer (concat name ".org"))))
((file-exists-p filename)
;; File exists but is not open --> open it
(message "Opening existing org file `%S'..."
@@ -408,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: ")
@@ -453,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))
@@ -530,12 +534,11 @@ 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)
(provide 'org-ctags)
-
;;; org-ctags.el ends here
diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el
index f02f3789823..a2b2e5621da 100644
--- a/lisp/org/org-datetree.el
+++ b/lisp/org/org-datetree.el
@@ -1,11 +1,10 @@
;;; org-datetree.el --- Create date entries in a tree
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -39,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.
@@ -64,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))
@@ -120,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")
@@ -137,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)
@@ -156,45 +168,47 @@ before running this command, even though the command tries to be smart."
(let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'"))
(sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'"))
dct ts tmp date year month day pos hdl-pos)
- (while (re-search-forward org-ts-regexp nil t)
- (catch 'next
- (setq ts (match-string 0))
- (setq tmp (buffer-substring
- (max (point-at-bol) (- (match-beginning 0)
- org-ds-keyword-length))
- (match-beginning 0)))
- (if (or (string-match "-\\'" tmp)
- (string-match dre tmp)
- (string-match sre tmp))
+ (while (re-search-forward org-ts-regexp nil t)
+ (catch 'next
+ (setq ts (match-string 0))
+ (setq tmp (buffer-substring
+ (max (point-at-bol) (- (match-beginning 0)
+ org-ds-keyword-length))
+ (match-beginning 0)))
+ (if (or (string-match "-\\'" tmp)
+ (string-match dre tmp)
+ (string-match sre tmp))
+ (throw 'next nil))
+ (setq dct (decode-time (org-time-string-to-time (match-string 0)))
+ date (list (nth 4 dct) (nth 3 dct) (nth 5 dct))
+ year (nth 2 date)
+ month (car date)
+ day (nth 1 date)
+ pos (point))
+ (org-back-to-heading t)
+ (setq hdl-pos (point))
+ (unless (org-up-heading-safe)
+ ;; No parent, we are not in a date tree
+ (goto-char pos)
(throw 'next nil))
- (setq dct (decode-time (org-time-string-to-time (match-string 0)))
- date (list (nth 4 dct) (nth 3 dct) (nth 5 dct))
- year (nth 2 date)
- month (car date)
- day (nth 1 date)
- pos (point))
- (org-back-to-heading t)
- (setq hdl-pos (point))
- (unless (org-up-heading-safe)
- ;; No parent, we are not in a date tree
- (goto-char pos)
- (throw 'next nil))
- (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]")
- ;; Parent looks wrong, we are not in a date tree
- (goto-char pos)
- (throw 'next nil))
- (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day))
- ;; At correct date already, do nothing
+ (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]")
+ ;; Parent looks wrong, we are not in a date tree
+ (goto-char pos)
+ (throw 'next nil))
+ (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day))
+ ;; At correct date already, do nothing
(progn (goto-char pos) (throw 'next nil)))
- ;; OK, we need to refile this entry
- (goto-char hdl-pos)
- (org-cut-subtree)
- (save-excursion
- (save-restriction
- (org-datetree-file-entry-under (current-kill 0) date)))))))
+ ;; OK, we need to refile this entry
+ (goto-char hdl-pos)
+ (org-cut-subtree)
+ (save-excursion
+ (save-restriction
+ (org-datetree-file-entry-under (current-kill 0) date)))))))
(provide 'org-datetree)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-datetree.el ends here
diff --git a/lisp/org/org-docbook.el b/lisp/org/org-docbook.el
index f964a93fa1c..a40d5b969f3 100644
--- a/lisp/org/org-docbook.el
+++ b/lisp/org/org-docbook.el
@@ -1,10 +1,9 @@
;;; org-docbook.el --- DocBook exporter for org-mode
;;
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;;
;; Emacs Lisp Archive Entry
;; Filename: org-docbook.el
-;; Version: 7.7
;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
;; Keywords: org, wp, docbook
@@ -151,6 +150,7 @@ avoid same set of footnote IDs being used multiple times."
(defcustom org-export-docbook-footnote-separator "<superscript>, </superscript>"
"Text used to separate footnotes."
:group 'org-export-docbook
+ :version "24.1"
:type 'string)
(defcustom org-export-docbook-emphasis-alist
@@ -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
@@ -196,6 +196,7 @@ This XSLT stylesheet is used by
Object (FO) files. You can use either `fo/docbook.xsl' that
comes with DocBook, or any customization layer you may have."
:group 'org-export-docbook
+ :version "24.1"
:type 'string)
(defcustom org-export-docbook-xslt-proc-command nil
@@ -294,7 +295,7 @@ then use this command to convert it."
(interactive "r")
(let (reg docbook buf)
(save-window-excursion
- (if (org-mode-p)
+ (if (derived-mode-p 'org-mode)
(setq docbook (org-export-region-as-docbook
beg end t 'string))
(setq reg (buffer-substring beg end)
@@ -394,6 +395,8 @@ in a window. A non-interactive call will only return the buffer."
(org-open-file pdffile)
(error "PDF file was not produced"))))
+(defvar org-heading-keyword-regexp-format) ; defined in org.el
+
;;;###autoload
(defun org-export-as-docbook (&optional hidden ext-plist
to-buffer body-only pub-dir)
@@ -475,9 +478,11 @@ publishing directory."
(current-dir (if buffer-file-name
(file-name-directory buffer-file-name)
default-directory))
+ (auto-insert nil); Avoid any auto-insert stuff for the new file
(buffer (if to-buffer
(cond
- ((eq to-buffer 'string) (get-buffer-create "*Org DocBook Export*"))
+ ((eq to-buffer 'string)
+ (get-buffer-create "*Org DocBook Export*"))
(t (get-buffer-create to-buffer)))
(find-file-noselect filename)))
;; org-levels-open is a global variable
@@ -499,8 +504,9 @@ publishing directory."
;; We will use HTML table formatter to export tables to DocBook
;; format, so need to set html-table-tag here.
(html-table-tag (plist-get opt-plist :html-table-tag))
- (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
- (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
+ (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)"))
+ (quote-re (format org-heading-keyword-regexp-format
+ org-quote-string))
(inquote nil)
(infixed nil)
(inverse nil)
@@ -623,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>
@@ -970,7 +976,7 @@ publishing directory."
(push (cons num 1) footref-seen))))))
(cond
- ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
+ ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line)
;; This is a headline
(setq level (org-tr-level (- (match-end 1) (match-beginning 1)
level-offset))
@@ -1012,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 "-", "+", "*"
@@ -1060,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)
@@ -1349,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
@@ -1445,5 +1451,8 @@ the alist of previous items."
(provide 'org-docbook)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-docbook.el ends here
diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el
index 201567251d7..cb490137155 100644
--- a/lisp/org/org-docview.el
+++ b/lisp/org/org-docview.el
@@ -1,11 +1,10 @@
;;; org-docview.el --- support for links to doc-view-mode buffers
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Jan Böcker <jan.boecker at jboecker dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -88,6 +87,4 @@ and append it."
(provide 'org-docview)
-
-
;;; org-docview.el ends here
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
new file mode 100644
index 00000000000..5da2dec3fb3
--- /dev/null
+++ b/lisp/org/org-element.el
@@ -0,0 +1,4418 @@
+;;; 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[ \t]*$" 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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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:[ \t]*$" 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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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 "^[ \t]*#\\+END:?[ \t]*$" 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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position))))
+ (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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ ;; 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[ \t]*$" 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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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
+ (format "^[ \t]*#\\+END_%s[ \t]*$" 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 (skip-chars-forward " \r\t\n" limit)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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)
+ (skip-chars-backward " \t")
+ (unless (bolp) (end-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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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[ \t]*$" 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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position))))
+ (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[ \t]*$" 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 (org-unescape-code-in-string
+ (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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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-escape-code-in-string
+ (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
+ (format "^[ \t]*#\\+END_%s[ \t]*$" 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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position))))
+ (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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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}[ \t]*$" env) limit t)
+ (forward-line)
+ (point)))
+ (value (buffer-substring-no-properties code-begin code-end))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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* ((contents-begin (point))
+ ;; 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)))
+ (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)
+ (if (not (re-search-forward
+ org-element-paragraph-separate limit 'm))
+ limit
+ ;; A matching `org-element-paragraph-separate' is not
+ ;; necessarily the end of the paragraph. In
+ ;; particular, lines starting with # or : as a first
+ ;; non-space character are ambiguous. We have check
+ ;; if they are valid Org syntax (i.e. not an
+ ;; incomplete keyword).
+ (beginning-of-line)
+ (while (not
+ (or
+ ;; There's no ambiguity for other symbols or
+ ;; empty lines: stop here.
+ (looking-at "[ \t]*\\(?:[^:#]\\|$\\)")
+ ;; Stop at valid fixed-width areas.
+ (looking-at "[ \t]*:\\(?: \\|$\\)")
+ ;; Stop at drawers.
+ (and (looking-at org-drawer-regexp)
+ (save-excursion
+ (re-search-forward
+ "^[ \t]*:END:[ \t]*$" limit t)))
+ ;; Stop at valid comments.
+ (looking-at "[ \t]*#\\(?: \\|$\\)")
+ ;; Stop at valid dynamic blocks.
+ (and (looking-at org-dblock-start-re)
+ (save-excursion
+ (re-search-forward
+ "^[ \t]*#\\+END:?[ \t]*$" limit t)))
+ ;; Stop at valid blocks.
+ (and (looking-at
+ "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
+ (save-excursion
+ (re-search-forward
+ (format "^[ \t]*#\\+END_%s[ \t]*$"
+ (match-string 1))
+ limit t)))
+ ;; Stop at valid latex environments.
+ (and (looking-at
+ "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}[ \t]*$")
+ (save-excursion
+ (re-search-forward
+ (format "^[ \t]*\\\\end{%s}[ \t]*$"
+ (match-string 1))
+ limit t)))
+ ;; Stop at valid keywords.
+ (looking-at "[ \t]*#\\+\\S-+:")
+ ;; Skip everything else.
+ (not
+ (progn
+ (end-of-line)
+ (re-search-forward org-element-paragraph-separate
+ limit 'm)))))
+ (beginning-of-line)))
+ (if (= (point) limit) limit
+ (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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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)
+ (skip-chars-backward " \t")
+ (unless (bolp) (end-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:[ \t]*$"))
+ (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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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[ \t]*$"
+ 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 (org-unescape-code-in-string
+ (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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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))))
+ (org-escape-code-in-string 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
+ (if (re-search-forward org-table-any-border-regexp limit 'm)
+ (goto-char (match-beginning 0))
+ (point)))
+ (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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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[ \t]*$" 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)
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position)))))
+ (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
+ (unless (bolp) (backward-char))
+ (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
+ (unless (bolp) (backward-char))
+ (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."
+ ;; Filter out any object found but not belonging to RESTRICTION.
+ (setq objects
+ (org-remove-if-not
+ (lambda (obj)
+ (let ((type (car obj)))
+ (memq (or (cdr (assq type org-element-object-successor-alist))
+ type)
+ restriction)))
+ objects))
+ (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-row 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 parent)
+ (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
+ restriction (org-element-restriction 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)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; org-element.el ends here
diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el
index 1e7fd627a17..bd675c376bb 100644
--- a/lisp/org/org-entities.el
+++ b/lisp/org/org-entities.el
@@ -1,12 +1,11 @@
;;; org-entities.el --- Support for special entities in Org-mode
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>,
;; Ulf Stegemann <ulf at zeitform dot de>
;; Keywords: outlines, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -45,6 +44,7 @@
For example, this will replace \"\\nsup\" with \"[not a superset of]\"
in backends where the corresponding character is not available."
:group 'org-entities
+ :version "24.1"
:type 'boolean)
(defcustom org-entities-user nil
@@ -69,6 +69,7 @@ utf-8 replacement Use the special characters available in utf-8.
If you define new entities here that require specific LaTeX packages to be
loaded, add these packages to `org-export-latex-packages-alist'."
:group 'org-entities
+ :version "24.1"
:type '(repeat
(list
(string :tag "name ")
@@ -251,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" "§" "§")
@@ -259,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]" "‡")
@@ -491,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)))
@@ -568,6 +571,4 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'."
;; coding: utf-8
;; End:
-
-
;;; org-entities.el ends here
diff --git a/lisp/org/org-eshell.el b/lisp/org/org-eshell.el
new file mode 100644
index 00000000000..4335fce578c
--- /dev/null
+++ b/lisp/org/org-eshell.el
@@ -0,0 +1,65 @@
+;;; org-eshell.el - Support for links to working directories in eshell
+
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+;; Author: Konrad Hinsen <konrad.hinsen AT fastmail.net>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'org)
+(require 'eshell)
+(require 'esh-mode)
+
+(org-add-link-type "eshell" 'org-eshell-open)
+(add-hook 'org-store-link-functions 'org-eshell-store-link)
+
+(defun org-eshell-open (link)
+ "Switch to am eshell buffer and execute a command line.
+ The link can be just a command line (executed in the default
+ eshell buffer) or a command line prefixed by a buffer name
+ 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 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)))
+
+(defun org-eshell-store-link ()
+ "Store a link that, when opened, switches back to the current eshell buffer
+ and the current working directory."
+ (when (eq major-mode 'eshell-mode)
+ (let* ((command (concat "cd " dired-directory))
+ (link (concat (buffer-name) ":" command)))
+ (org-store-link-props
+ :link (concat "eshell:" link)
+ :description command))))
+
+(provide 'org-eshell)
+
+;;; org-eshell.el ends here
diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el
index 398da3859d0..89a0e5e5503 100644
--- a/lisp/org/org-exp-blocks.el
+++ b/lisp/org/org-exp-blocks.el
@@ -1,9 +1,8 @@
;;; org-exp-blocks.el --- pre-process blocks when exporting org files
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Eric Schulte
-;; Version: 7.7
;; This file is part of GNU Emacs.
;;
@@ -58,9 +57,9 @@
;; using the dot utility. For information on dot see
;; http://www.graphviz.org/
;;
-;; comment :: Wrap comments with titles and author information, in
-;; their own divs with author-specific ids allowing for css
-;; coloring of comments based on the author.
+;; export-comment :: Wrap comments with titles and author information,
+;; in their own divs with author-specific ids allowing for
+;; css coloring of comments based on the author.
;;
;;; Adding new blocks
;;
@@ -73,7 +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."
@@ -88,7 +93,7 @@
value))
(defcustom org-export-blocks
- '((comment org-export-blocks-format-comment t)
+ '((export-comment org-export-blocks-format-comment t)
(ditaa org-export-blocks-format-ditaa nil)
(dot org-export-blocks-format-dot nil))
"Use this alist to associate block types with block exporting functions.
@@ -136,12 +141,12 @@ export function should accept three arguments."
(defcustom org-export-blocks-postblock-hook nil
"Run after blocks have been processed with `org-export-blocks-preprocess'."
:group 'org-export-general
+ :version "24.1"
:type 'hook)
(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 "")
@@ -159,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
@@ -166,71 +172,88 @@ 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 (match-beginning 0))
- (body-start (match-end 0))
- (indentation (length (match-string 1)))
- (inner-re (format "[\r\n]*[ \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 (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)
- (unless preserve-indent
- (indent-code-rigidly match-start (point) indentation))))))
- (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
;;--------------------------------------------------------------------------------
;; ditaa: create images from ASCII art using the ditaa utility
-(defvar 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 (or load-file-name buffer-file-name)))))))
- "Path to the ditaa jar executable.")
+(defcustom org-ditaa-jar-path (expand-file-name
+ "ditaa.jar"
+ (file-name-as-directory
+ (expand-file-name
+ "scripts"
+ (file-name-as-directory
+ (expand-file-name
+ "../contrib"
+ (file-name-directory (org-find-library-dir "org")))))))
+ "Path to the ditaa jar executable."
+ :group 'org-babel
+ :type 'string)
(defvar org-export-current-backend) ; dynamically bound in org-exp.el
(defun org-export-blocks-format-ditaa (body &rest headers)
@@ -260,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
@@ -319,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
@@ -376,5 +399,4 @@ other backends, it converts the comment into an EXAMPLE segment."
(provide 'org-exp-blocks)
-
;;; org-exp-blocks.el ends here
diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el
index 35a51649452..a578fe70f07 100644
--- a/lisp/org/org-exp.el
+++ b/lisp/org/org-exp.el
@@ -1,11 +1,10 @@
-;;; org-exp.el --- ASCII, HTML, XOXO and iCalendar export for Org-mode
+;;; org-exp.el --- Export internals for Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -47,13 +46,16 @@
(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
(declare-function org-table-cookie-line-p "org-table" (line))
(declare-function org-table-colgroup-line-p "org-table" (line))
+(declare-function org-pop-to-buffer-same-window "org-compat"
+ (&optional buffer-or-name norecord label))
+(declare-function org-unescape-code-in-region "org-src" (beg end))
(autoload 'org-export-generic "org-export-generic" "Export using the generic exporter" t)
(autoload 'org-export-as-odt "org-odt"
- "Export the outline to a OpenDocumentText file." t)
+ "Export the outline to a OpenDocument Text file." t)
(autoload 'org-export-as-odt-and-open "org-odt"
- "Export the outline to a OpenDocumentText file and open it." t)
+ "Export the outline to a OpenDocument Text file and open it." t)
(defgroup org-export nil
"Options for exporting org-listings."
@@ -97,6 +99,7 @@ is nil, the buffer remains buried also in these cases."
This applied to the commands `org-export-as-html-and-open' and
`org-export-as-pdf-and-open'."
:group 'org-export-general
+ :version "24.1"
:type 'boolean)
(defcustom org-export-run-in-background nil
@@ -119,6 +122,7 @@ force an export command into the current process."
"The initial scope when exporting with `org-export'.
This variable can be either set to 'buffer or 'subtree."
:group 'org-export-general
+ :version "24.1"
:type '(choice
(const :tag "Export current buffer" 'buffer)
(const :tag "Export current subtree" 'subtree)))
@@ -187,16 +191,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."
@@ -216,6 +235,12 @@ and in `org-clock-clocktable-language-setup'."
:group 'org-export-general
:type 'string)
+(defcustom org-export-date-timestamp-format "%Y-%m-%d"
+ "Time string format for Org timestamps in the #+DATE option."
+ :group 'org-export-general
+ :version "24.1"
+ :type 'string)
+
(defvar org-export-page-description ""
"The page description, for the XHTML meta tag.
This is best set with the #+DESCRIPTION line in a file, it does not make
@@ -311,6 +336,7 @@ done include only tasks that are already done.
nil remove all tasks before export
list of TODO kwds keep only tasks with these keywords"
:group 'org-export-general
+ :version "24.1"
:type '(choice
(const :tag "All tasks" t)
(const :tag "No tasks" nil)
@@ -361,6 +387,7 @@ e.g. \"author:nil\"."
This option can also be set with the +OPTIONS line,
e.g. \"email:t\"."
:group 'org-export-general
+ :version "24.1"
:type 'boolean)
(defcustom org-export-creator-info t
@@ -514,12 +541,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."
@@ -529,6 +558,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)))
@@ -588,6 +618,7 @@ the values of constants may be useful to have."
This is the global equivalent of the :remove-nil-lines option
when locally sending a table with #+ORGTBL."
:group 'org-export-tables
+ :version "24.1"
:type 'boolean)
(defcustom org-export-prefer-native-exporter-for-tables nil
@@ -611,7 +642,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.")
@@ -690,7 +721,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."
@@ -701,8 +732,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))
@@ -725,6 +755,7 @@ must accept the property list as an argument, and must return the (possibly
modified) list.")
;; FIXME: should we fold case here?
+
(defun org-infile-export-plist ()
"Return the property list with file-local settings for export."
(save-excursion
@@ -736,13 +767,13 @@ modified) list.")
'("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"
"MATHJAX"
"LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE"
- "LATEX_HEADER" "LATEX_CLASS"
+ "LATEX_HEADER" "LATEX_CLASS" "LATEX_CLASS_OPTIONS"
"EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS"
"KEYWORDS" "DESCRIPTION" "MACRO" "BIND" "XSLT")
(mapcar 'car org-export-inbuffer-options-extra))))
(case-fold-search t)
p key val text options mathjax a pr style
- latex-header latex-class macros letbind
+ latex-header latex-class latex-class-options macros letbind
ext-setup-or-nil setup-file setup-dir setup-contents (start 0))
(while (or (and ext-setup-or-nil
(string-match re ext-setup-or-nil start)
@@ -758,7 +789,15 @@ modified) list.")
((string-equal key "TITLE") (setq p (plist-put p :title val)))
((string-equal key "AUTHOR")(setq p (plist-put p :author val)))
((string-equal key "EMAIL") (setq p (plist-put p :email val)))
- ((string-equal key "DATE") (setq p (plist-put p :date val)))
+ ((string-equal key "DATE")
+ ;; If date is an Org timestamp, convert it to a time
+ ;; string using `org-export-date-timestamp-format'
+ (when (string-match org-ts-regexp3 val)
+ (setq val (format-time-string
+ org-export-date-timestamp-format
+ (apply 'encode-time (org-parse-time-string
+ (match-string 0 val))))))
+ (setq p (plist-put p :date val)))
((string-equal key "KEYWORDS") (setq p (plist-put p :keywords val)))
((string-equal key "DESCRIPTION")
(setq p (plist-put p :description val)))
@@ -769,6 +808,8 @@ modified) list.")
(setq latex-header (concat latex-header "\n" val)))
((string-equal key "LATEX_CLASS")
(setq latex-class val))
+ ((string-equal key "LATEX_CLASS_OPTIONS")
+ (setq latex-class-options val))
((string-equal key "TEXT")
(setq text (if text (concat text "\n" val) val)))
((string-equal key "OPTIONS")
@@ -812,6 +853,8 @@ modified) list.")
(setq p (plist-put p :latex-header-extra (substring latex-header 1))))
(when latex-class
(setq p (plist-put p :latex-class latex-class)))
+ (when latex-class-options
+ (setq p (plist-put p :latex-class-options latex-class-options)))
(when options
(setq p (org-export-add-options-to-plist p options)))
(when mathjax
@@ -932,6 +975,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
@@ -947,7 +992,7 @@ Pressing `1' will switch between these two options."
\[D] export as DocBook [V] export as DocBook, process to PDF, and open
-\[o] export as OpenDocumentText [O] ... and open
+\[o] export as OpenDocument Text [O] ... and open
\[j] export as TaskJuggler [J] ... and open
@@ -1011,6 +1056,11 @@ Pressing `1' will switch between these two options."
(message "Export buffer: "))
((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)
@@ -1027,7 +1077,7 @@ Pressing `1' will switch between these two options."
(setq r1 (read-char-exclusive)))
(error "No enclosing node with LaTeX_CLASS or EXPORT_TITLE or EXPORT_FILE_NAME")
)))))
- (redisplay)
+ (if (fboundp 'redisplay) (redisplay)) ;; XEmacs does not have/need (redisplay)
(and bpos (goto-char bpos))
(setq r2 (if (< r1 27) (+ r1 96) r1))
(unless (setq ass (assq r2 cmds))
@@ -1048,8 +1098,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)))
@@ -1158,7 +1209,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)
@@ -1274,8 +1325,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 #+TBLFM #+TBLNAME #+NAME #+RESULTS lines
+ (org-export-handle-metalines)
;; Run the final hook
(run-hooks 'org-export-preprocess-final-hook)
@@ -1377,53 +1428,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-on-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."
@@ -1433,12 +1484,14 @@ 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.
-The function must accept three parameters:
+The function must accept two parameters:
NAME the drawer name, like \"PROPERTIES\"
CONTENT the content of the drawer.
You can check the export backend through `org-export-current-backend'.
@@ -1503,8 +1556,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
@@ -1518,7 +1571,7 @@ removed as well."
(setq beg (point))
(put-text-property beg (point-max) :org-delete t)
(while (re-search-forward re-sel nil t)
- (when (org-on-heading-p)
+ (when (org-at-heading-p)
(org-back-to-heading)
(remove-text-properties
(max (1- (point)) (point-min))
@@ -1565,8 +1618,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
@@ -1588,7 +1641,7 @@ from the buffer."
(when (not (eq export-archived-trees t))
(goto-char (point-min))
(while (re-search-forward re-archive nil t)
- (if (not (org-on-heading-p t))
+ (if (not (org-at-heading-p t))
(goto-char (point-at-eol))
(beginning-of-line 1)
(setq a (if export-archived-trees
@@ -1634,9 +1687,11 @@ from the buffer."
(org-if-unprotected
(replace-match "")))))
+(defvar org-heading-keyword-regexp-format) ; defined in org.el
(defun org-export-protect-quoted-subtrees ()
"Mark quoted subtrees with the protection property."
- (let ((org-re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>")))
+ (let ((org-re-quote (format org-heading-keyword-regexp-format
+ org-quote-string)))
(goto-char (point-min))
(while (re-search-forward org-re-quote nil t)
(goto-char (match-beginning 0))
@@ -1705,11 +1760,12 @@ from the buffer."
":[ \t]*\\(.*\\)") nil t)
(if (not (eq backend org-export-current-backend))
(delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
- (replace-match "\\1\\2" t)
- (add-text-properties
- (point-at-bol) (min (1+ (point-at-eol)) (point-max))
- `(org-protected t original-indentation ,ind org-native-text t))))
- ;; Delete #+ATTR_BACKEND: stuff of another backend. Those
+ (let ((ind (get-text-property (point-at-bol) 'original-indentation)))
+ (replace-match "\\1\\2" t)
+ (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
;; matching the current backend will be taken care of by
;; `org-export-attach-captions-and-attributes'
(goto-char (point-min))
@@ -1723,7 +1779,8 @@ from the buffer."
(while (re-search-forward (concat "^[ \t]*#\\+BEGIN_" backend-name "\\>.*\n?")
nil t)
(setq beg (match-beginning 0) beg-content (match-end 0))
- (setq ind (save-excursion (goto-char beg) (org-get-indentation)))
+ (setq ind (or (get-text-property beg 'original-indentation)
+ (save-excursion (goto-char beg) (org-get-indentation))))
(when (re-search-forward (concat "^[ \t]*#\\+END_" backend-name "\\>.*\n?")
nil t)
(setq end (match-end 0) end-content (match-beginning 0))
@@ -1734,11 +1791,7 @@ from the buffer."
beg-content end-content
`(org-protected t original-indentation ,ind org-native-text t))
;; strip protective commas
- (save-excursion
- (save-match-data
- (goto-char beg-content)
- (while (re-search-forward "^[ \t]*\\(,\\)" end-content t)
- (replace-match "" nil nil nil 1))))
+ (org-unescape-code-in-region beg-content end-content)
(delete-region (match-beginning 0) (match-end 0))
(save-excursion
(goto-char beg)
@@ -1785,15 +1838,14 @@ These special cookies will later be interpreted by the backend."
(top (point-at-bol))
(top-ind (org-list-get-ind top struct)))
(goto-char bottom)
- (when (and (not (eq org-list-ending-method 'indent))
- (not (looking-at "[ \t]*$"))
+ (when (and (not (looking-at "[ \t]*$"))
(looking-at org-list-end-re))
(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.
@@ -1810,7 +1862,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))
@@ -1838,21 +1890,20 @@ 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")
- (and (not (eq org-list-ending-method 'indent))
- (not (looking-at "[ \t]*$"))
+ (and (not (looking-at "[ \t]*$"))
(looking-at org-list-end-re)))
(replace-match ""))
(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.
@@ -1924,7 +1975,8 @@ table line. If it is a link, add it to the line containing the link."
(defun org-export-remove-comment-blocks-and-subtrees ()
"Remove the comment environment, and also commented subtrees."
- (let ((re-commented (concat "^\\*+[ \t]+" org-comment-string "\\>"))
+ (let ((re-commented (format org-heading-keyword-regexp-format
+ org-comment-string))
case-fold-search)
;; Remove comment environment
(goto-char (point-min))
@@ -1943,29 +1995,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))))))))
-
-(defun org-export-handle-table-metalines ()
- "Remove table specific metalines #+TBLNAME: and #+TBLFM:."
- (let ((re "^[ \t]*#\\+TBL\\(NAME\\|FM\\):\\(.*\n?\\)")
+ (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-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)
@@ -1994,23 +2050,28 @@ When it is nil, all comments will be removed."
(defun org-store-forced-table-alignment ()
"Find table lines which force alignment, store the results in properties."
- (let (line cnt aligns)
+ (let (line cnt cookies)
(goto-char (point-min))
- (while (re-search-forward "|[ \t]*<[lrc][0-9]*>[ \t]*|" nil t)
+ (while (re-search-forward "|[ \t]*<\\([lrc]?[0-9]+\\|[lrc]\\)>[ \t]*|"
+ nil t)
;; OK, this looks like a table line with an alignment cookie
(org-if-unprotected
(setq line (buffer-substring (point-at-bol) (point-at-eol)))
(when (and (org-at-table-p)
(org-table-cookie-line-p line))
- (setq cnt 0 aligns nil)
+ (setq cnt 0 cookies nil)
(mapc
(lambda (x)
(setq cnt (1+ cnt))
- (if (string-match "\\`<\\([lrc]\\)" x)
- (push (cons cnt (downcase (match-string 1 x))) aligns)))
+ (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" x)
+ (let ((align (and (match-end 1)
+ (downcase (match-string 1 x))))
+ (width (and (match-end 2)
+ (string-to-number (match-string 2 x)))))
+ (push (cons cnt (list align width)) cookies))))
(org-split-string line "[ \t]*|[ \t]*"))
(add-text-properties (org-table-begin) (org-table-end)
- (list 'org-forced-aligns aligns))))
+ (list 'org-col-cookies cookies))))
(goto-char (point-at-eol)))))
(defun org-export-remove-special-table-lines ()
@@ -2048,10 +2109,11 @@ Also, store forced alignment information found in such lines."
(re-angle-link (concat "\\([^[]\\)" org-angle-link-re))
nodesc)
(goto-char (point-min))
+ (while (re-search-forward org-bracket-link-regexp nil t)
+ (put-text-property (match-beginning 0) (match-end 0) 'org-normalized-link t))
+ (goto-char (point-min))
(while (re-search-forward re-plain-link nil t)
- (unless (org-string-match-p
- "\\[\\[\\S-+:\\S-*?\\<"
- (buffer-substring (point-at-bol) (match-beginning 0)))
+ (unless (get-text-property (match-beginning 0) 'org-normalized-link)
(goto-char (1- (match-end 0)))
(org-if-unprotected-at (1+ (match-beginning 0))
(let* ((s (concat (match-string 1)
@@ -2100,8 +2162,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.
@@ -2131,24 +2193,31 @@ can work correctly."
(save-excursion (outline-next-heading) (point)))))
(when (re-search-forward "^[ \t]*[^|# \t\r\n].*\n" end t)
;; Mark the line so that it will not be exported as normal text.
- (org-unmodified
- (add-text-properties (match-beginning 0) (match-end 0)
- (list :org-license-to-kill t)))
+ (unless (org-in-block-p org-list-forbidden-blocks)
+ (org-unmodified
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list :org-license-to-kill t))))
;; Return the title string
(org-trim (match-string 0)))))))
(defun org-export-get-title-from-subtree ()
"Return subtree title and exclude it from export."
(let ((rbeg (region-beginning)) (rend (region-end))
- (inhibit-read-only t) title)
+ (inhibit-read-only t)
+ (tags (plist-get (org-infile-export-plist) :tags))
+ title)
(save-excursion
(goto-char rbeg)
(when (and (org-at-heading-p)
(>= (org-end-of-subtree t t) rend))
+ (when (plist-member org-export-opt-plist :tags)
+ (setq tags (or (plist-get org-export-opt-plist :tags) tags)))
;; This is a subtree, we take the title from the first heading
(goto-char rbeg)
- (looking-at org-todo-line-regexp)
- (setq title (match-string 3))
+ (looking-at org-todo-line-tags-regexp)
+ (setq title (if (and (eq tags t) (match-string 4))
+ (format "%s\t%s" (match-string 3) (match-string 4))
+ (match-string 3)))
(org-unmodified
(add-text-properties (point) (1+ (point-at-eol))
(list :org-license-to-kill t)))
@@ -2290,7 +2359,7 @@ TYPE must be a string, any of:
(plist-get org-export-opt-plist
(intern (concat ":" key)))))
(save-match-data
- ;; If arguments are provided, first retreive them properly
+ ;; If arguments are provided, first retrieve them properly
;; (in ARGS, as a list), then replace them in VAL.
(when args
(setq args (org-split-string args ",") args2 nil)
@@ -2319,7 +2388,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)
@@ -2338,13 +2407,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))
@@ -2353,6 +2423,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)))
@@ -2368,7 +2439,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))
@@ -2385,13 +2456,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)
@@ -2424,6 +2497,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)
@@ -2495,7 +2576,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)
@@ -2509,10 +2590,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\".
@@ -2650,65 +2731,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}\n"
- "lstlisting" rtn "lstlisting"))
- (minted-p
- (format
- "\\begin{minted}[%s]{%s}\n%s\\end{minted}\n"
- (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)))))
@@ -2717,13 +2797,60 @@ INDENT was the original indentation of the block."
"\n#+BEGIN_" backend-name "\n"
(org-add-props rtn
'(org-protected t org-example t org-native-text t))
- "\n#+END_" backend-name "\n\n"))
+ "\n#+END_" backend-name "\n"))
(org-add-props rtn nil 'original-indentation indent))))
(defun org-export-number-lines (text &optional skip1 skip2 number cont
- replace-labels label-format)
+ replace-labels label-format preprocess)
+ "Apply line numbers to literal examples and handle code references.
+Handle user-specified options under info node `(org)Literal
+examples' and return the modified source block.
+
+TEXT contains the source or example block.
+
+SKIP1 and SKIP2 are the number of lines that are to be skipped at
+the beginning and end of TEXT. Use these to skip over
+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.
+
+CONT is non-nil if the literal example specifies \"+n\" switch.
+If CONT is nil, start numbering this block from 1. Otherwise
+continue numbering from the last numbered block.
+
+REPLACE-LABELS is dual-purpose.
+1. It controls the retention of labels in the exported block.
+2. It specifies in what manner the links (or references) to a
+ labeled line be formatted.
+
+REPLACE-LABELS is the symbol `keep' if the literal example
+specifies \"-k\" option, is numeric if the literal example
+specifies \"-r\" option and is nil otherwise.
+
+Handle REPLACE-LABELS as below:
+- If nil, retain labels in the exported block and use
+ user-provided labels for referencing the labeled lines.
+- If it is a number, remove labels in the exported block and use
+ one of line numbers or labels for referencing labeled lines based
+ on NUMBER option.
+- If it is a keep, retain labels in the exported block and use
+ one of line numbers or labels for referencing labeled lines
+ based on NUMBER option.
+
+LABEL-FORMAT is the value of \"-l\" switch associated with
+literal example. See `org-coderef-label-format'.
+
+PREPROCESS is intended for backend-agnostic handling of source
+block numbering. When non-nil do the following:
+- do not number the lines
+- always strip the labels from exported block
+- do not make the labeled line a target of an incoming link.
+ Instead mark the labeled line with `org-coderef' property and
+ store the label in it."
(setq skip1 (or skip1 0) skip2 (or skip2 0))
- (if (not cont) (setq org-export-last-code-line-counter-value 0))
+ (if (and number (not cont)) (setq org-export-last-code-line-counter-value 0))
(with-temp-buffer
(insert text)
(goto-char (point-max))
@@ -2737,7 +2864,7 @@ INDENT was the original indentation of the block."
(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)
@@ -2760,9 +2887,10 @@ INDENT was the original indentation of the block."
(org-goto-line (1+ skip1))
(while (and (re-search-forward "^" nil t) (not (eobp)) (< n nmax))
- (if number
- (insert (format fm (incf n)))
- (forward-char 1))
+ (when number (incf n))
+ (if (or preprocess (not number))
+ (forward-char 1)
+ (insert (format fm n)))
(when (looking-at lbl-re)
(setq ref (match-string 3))
(cond ((numberp replace-labels)
@@ -2775,7 +2903,8 @@ INDENT was the original indentation of the block."
;; lines are numbered, use labels otherwise
(goto-char (match-beginning 2))
(delete-region (match-beginning 2) (match-end 2))
- (insert "(" ref ")")
+ (unless preprocess
+ (insert "(" ref ")"))
(push (cons ref (if (> n 0) n (concat "(" ref ")")))
org-export-code-refs))
(t
@@ -2783,15 +2912,19 @@ INDENT was the original indentation of the block."
;; references
(goto-char (match-beginning 2))
(delete-region (match-beginning 2) (match-end 2))
- (insert "(" ref ")")
+ (unless preprocess
+ (insert "(" ref ")"))
(push (cons ref (concat "(" ref ")")) org-export-code-refs)))
- (when (eq org-export-current-backend 'html)
+ (when (and (eq org-export-current-backend 'html) (not preprocess))
(save-excursion
(beginning-of-line 1)
(insert (format "<span id=\"coderef-%s\" class=\"coderef-off\">"
ref))
(end-of-line 1)
- (insert "</span>")))))
+ (insert "</span>")))
+ (when preprocess
+ (add-text-properties
+ (point-at-bol) (point-at-eol) (list 'org-coderef ref)))))
(setq org-export-last-code-line-counter-value n)
(goto-char (point-max))
(newline)
@@ -2809,7 +2942,7 @@ INDENT was the original indentation of the block."
(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))))))))
@@ -2893,17 +3026,6 @@ command."
(switch-to-buffer-other-window buffer)
(goto-char (point-min)))))
-(defun org-find-visible ()
- (let ((s (point)))
- (while (and (not (= (point-max) (setq s (next-overlay-change s))))
- (get-char-property s 'invisible)))
- s))
-(defun org-find-invisible ()
- (let ((s (point)))
- (while (and (not (= (point-max) (setq s (next-overlay-change s))))
- (not (get-char-property s 'invisible))))
- s))
-
(defvar org-export-htmlized-org-css-url) ;; defined in org-html.el
(defun org-export-string (string fmt &optional dir)
@@ -2972,7 +3094,7 @@ directory."
(region (buffer-string))
str-ret)
(save-excursion
- (switch-to-buffer buffer)
+ (org-pop-to-buffer-same-window buffer)
(erase-buffer)
(insert region)
(let ((org-inhibit-startup t)) (org-mode))
@@ -3107,10 +3229,8 @@ 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 ()
"Insert into the buffer a template with information for exporting."
(interactive)
@@ -3149,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)
@@ -3171,14 +3290,13 @@ 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)
;; This line contains formatting cookies, discard it
nil)
- ((string-match "^[ \t]*| *[!_^/] *|" x)
+ ((string-match "^[ \t]*| *\\([!_^/$]\\|\\\\\\$\\) *|" x)
;; ignore this line
nil)
((or (string-match "^\\([ \t]*\\)|-+\\+" x)
@@ -3189,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)
@@ -3218,7 +3338,7 @@ If yes remove the column and the special lines."
(defun org-export-push-to-kill-ring (format)
"Push buffer content to kill ring.
-The depends on the variable `org-export-copy-to-kill'."
+The depends on the variable `org-export-copy-to-kill-ring'."
(when org-export-copy-to-kill-ring
(org-kill-new (buffer-string))
(when (fboundp 'x-set-selection)
@@ -3228,6 +3348,8 @@ The depends on the variable `org-export-copy-to-kill'."
(provide 'org-exp)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-exp.el ends here
diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el
index af9632eec44..58be52d9e28 100644
--- a/lisp/org/org-faces.el
+++ b/lisp/org/org-faces.el
@@ -1,11 +1,10 @@
;;; org-faces.el --- Face definitions for Org-mode.
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -286,6 +285,18 @@ column view defines special faces for each outline level. See the file
"Face for date/time stamps."
:group 'org-faces)
+(defface org-date-selected
+ (org-compatible-face 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'.
+Using a bold face here might cause discrepancies while displaying the
+calendar."
+ :group 'org-faces)
+
(defface org-sexp-date
'((((class color) (background light)) (:foreground "Purple"))
(((class color) (background dark)) (:foreground "Cyan"))
@@ -300,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))
@@ -352,6 +368,7 @@ keywords will then be interpreted as either foreground or background
color."
:group 'org-faces
:group 'org-todo
+ :version "24.1"
:type '(repeat
(cons (choice (const todo) (const tag) (const priority))
(choice (const :foreground) (const :background)))))
@@ -371,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.
@@ -388,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)
@@ -402,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)
@@ -429,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
@@ -474,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)
@@ -539,15 +556,16 @@ 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.
When nil, format these as normal Org. This is the default, because the
content of these blocks will still be treated as Org syntax."
:group 'org-faces
+ :version "24.1"
:type 'boolean)
(defface org-clock-overlay ;; copied from secondary-selection
@@ -563,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
@@ -591,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
@@ -673,6 +691,18 @@ month and 365.24 days for a year)."
"Face for showing the agenda restriction lock."
:group 'org-faces)
+(defface org-agenda-filter-tags
+ (org-compatible-face 'mode-line
+ nil)
+ "Face for tag(s) in the mode-line when filtering the agenda."
+ :group 'org-faces)
+
+(defface org-agenda-filter-category
+ (org-compatible-face 'mode-line
+ nil)
+ "Face for tag(s) in the mode-line when filtering the agenda."
+ :group 'org-faces)
+
(defface org-time-grid ;; originally copied from font-lock-variable-name-face
(org-compatible-face nil
'((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
@@ -690,10 +720,22 @@ month and 365.24 days for a year)."
"Face used for agenda entries that come from the Emacs diary."
:group 'org-faces)
+(defface org-agenda-calendar-event
+ (org-compatible-face 'default
+ nil)
+ "Face used to show events and appointments in the agenda."
+ :group 'org-faces)
+
+(defface org-agenda-calendar-sexp
+ (org-compatible-face 'default
+ nil)
+ "Face used to show events computed from a S-expression."
+ :group 'org-faces)
+
(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.
@@ -703,13 +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
- :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)
@@ -727,14 +770,12 @@ level org-n-level-faces"
"Face used to highlight math latex and other special exporter stuff."
:group 'org-faces)
-(org-copy-face 'modeline 'org-mode-line-clock
+(org-copy-face 'mode-line 'org-mode-line-clock
"Face used for clock display in mode line.")
-(org-copy-face 'modeline 'org-mode-line-clock-overrun
+(org-copy-face 'mode-line 'org-mode-line-clock-overrun
"Face used for clock display for overrun tasks in mode line."
:background "red")
(provide 'org-faces)
-
-
;;; org-faces.el ends here
diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el
index d1b31f11b4a..7724578ae58 100644
--- a/lisp/org/org-feed.el
+++ b/lisp/org/org-feed.el
@@ -1,11 +1,10 @@
;;; org-feed.el --- Add RSS feed items to Org files
;;
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -81,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
;; ---------------
@@ -101,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"
@@ -180,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.
@@ -226,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"))
@@ -252,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."
@@ -436,7 +441,7 @@ it can be a list structured like an entry in `org-feed-alist'."
(if (stringp feed) (setq feed (assoc feed org-feed-alist)))
(unless feed
(error "No such feed in `org-feed-alist"))
- (switch-to-buffer
+ (org-pop-to-buffer-same-window
(org-feed-update feed 'retrieve-only))
(goto-char (point-min)))
@@ -451,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)
@@ -507,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")
@@ -528,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))))))
@@ -674,5 +695,8 @@ formatted as a string, not the original XML data."
(provide 'org-feed)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-feed.el ends here
diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el
index 0d47132d2f8..c598965f4c7 100644
--- a/lisp/org/org-footnote.el
+++ b/lisp/org/org-footnote.el
@@ -1,11 +1,10 @@
;;; org-footnote.el --- Footnote support in Org and elsewhere
;;
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -38,28 +37,35 @@
(require 'org-macs)
(require 'org-compat)
+(declare-function message-point-in-header-p "message" ())
+(declare-function org-back-over-empty-lines "org" ())
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-combine-plists "org" (&rest plists))
+(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
+(declare-function org-export-preprocess-string "org-exp"
+ (string &rest parameters))
+(declare-function org-fill-paragraph "org" (&optional justify))
+(declare-function org-icompleting-read "org" (&rest args))
+(declare-function org-id-uuid "org-id" ())
+(declare-function org-in-block-p "org" (names))
(declare-function org-in-commented-line "org" ())
(declare-function org-in-indented-comment-line "org" ())
(declare-function org-in-regexp "org" (re &optional nlines visually))
-(declare-function org-in-block-p "org" (names))
-(declare-function org-mark-ring-push "org" (&optional pos buffer))
-(declare-function outline-next-heading "outline")
-(declare-function org-trim "org" (s))
-(declare-function org-show-context "org" (&optional key))
-(declare-function org-back-to-heading "org" (&optional invisible-ok))
-(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-in-verbatim-emphasis "org" ())
+(declare-function org-inside-LaTeX-fragment-p "org" ())
(declare-function org-inside-latex-macro-p "org" ())
-(declare-function org-id-uuid "org" ())
-(declare-function org-fill-paragraph "org" (&optional justify))
-(declare-function org-export-preprocess-string "org-exp"
- (string &rest parameters))
+(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" ())
-(defvar org-outline-regexp-bol) ; defined in org.el
-(defvar org-odd-levels-only) ;; defined in org.el
-(defvar org-bracket-link-regexp) ; defined in org.el
-(defvar message-signature-separator) ;; defined in message.el
+(defvar org-outline-regexp-bol) ; defined in org.el
+(defvar org-odd-levels-only) ; defined in org.el
+(defvar org-bracket-link-regexp) ; defined in org.el
+(defvar message-cite-prefix-regexp) ; defined in message.el
+(defvar message-signature-separator) ; defined in message.el
(defconst org-footnote-re
;; Only [1]-like footnotes are closed in this regexp, as footnotes
@@ -67,21 +73,21 @@
;; their definition.
;;
;; `org-re' is used for regexp compatibility with XEmacs.
- (org-re (concat "\\[\\(?:"
- ;; Match inline footnotes.
- "fn:\\([-_[:word:]]+\\)?:\\|"
- ;; Match other footnotes.
- "\\(?:\\([0-9]+\\)\\]\\)\\|"
- "\\(fn:[-_[:word:]]+\\)"
- "\\)"))
+ (concat "\\[\\(?:"
+ ;; Match inline footnotes.
+ (org-re "fn:\\([-_[:word:]]+\\)?:\\|")
+ ;; Match other footnotes.
+ "\\(?:\\([0-9]+\\)\\]\\)\\|"
+ (org-re "\\(fn:[-_[:word:]]+\\)")
+ "\\)")
"Regular expression for matching footnotes.")
(defconst org-footnote-definition-re
- (org-re "^\\(\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]\\)")
+ (org-re "^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]")
"Regular expression matching the definition of a footnote.")
-(defvar org-footnote-forbidden-blocks '("example" "verse" "src" "ascii" "beamer"
- "docbook" "html" "latex" "odt")
+(defconst org-footnote-forbidden-blocks
+ '("ascii" "beamer" "comment" "docbook" "example" "html" "latex" "odt" "src")
"Names of blocks where footnotes are not allowed.")
(defgroup org-footnote nil
@@ -106,13 +112,17 @@ heading will be removed after extracting footnote definitions."
(defcustom org-footnote-tag-for-non-org-mode-files "Footnotes:"
"Tag marking the beginning of footnote section.
-The Org-mode footnote engine can be used in arbitrary text files as well
-as in Org-mode. Outside Org-mode, new footnotes are always placed at
+The Org footnote engine can be used in arbitrary text files as well
+as in Org-mode. Outside Org mode, new footnotes are always placed at
the end of the file. When you normalize the notes, any line containing
only this tag will be removed, a new one will be inserted at the end
-of the file, followed by the collected and normalized footnotes."
+of the file, followed by the collected and normalized footnotes.
+
+If you don't want any tag in such buffers, set this variable to nil."
:group 'org-footnote
- :type 'string)
+ :type '(choice
+ (string :tag "Collect footnotes under tag")
+ (const :tag "Don't use a tag" nil)))
(defcustom org-footnote-define-inline nil
"Non-nil means define footnotes inline, at reference location.
@@ -171,8 +181,11 @@ extracted will be filled again."
(save-match-data
(not (or (org-in-commented-line)
(org-in-indented-comment-line)
- (org-in-verbatim-emphasis)
+ (org-inside-LaTeX-fragment-p)
+ ;; Avoid protected environments (LaTeX export)
+ (get-text-property (point) 'org-protected)
;; Avoid literal example.
+ (org-in-verbatim-emphasis)
(save-excursion
(beginning-of-line)
(looking-at "[ \t]*:[ \t]+"))
@@ -194,13 +207,13 @@ positions, and the definition, when inlined."
(or (looking-at org-footnote-re)
(org-in-regexp org-footnote-re)
(save-excursion (re-search-backward org-footnote-re nil t)))
- ;; Only inline footnotes can start at bol.
- (or (eq (char-before (match-end 0)) 58)
- (/= (match-beginning 0) (point-at-bol))))
+ (/= (match-beginning 0) (point-at-bol)))
(let* ((beg (match-beginning 0))
- (label (or (match-string 2) (match-string 3)
+ (label (or (org-match-string-no-properties 2)
+ (org-match-string-no-properties 3)
;; Anonymous footnotes don't have labels
- (and (match-string 1) (concat "fn:" (match-string 1)))))
+ (and (match-string 1)
+ (concat "fn:" (org-match-string-no-properties 1)))))
;; Inline footnotes don't end at (match-end 0) as
;; `org-footnote-re' stops just after the second colon.
;; Find the real ending with `scan-sexps', so Org doesn't
@@ -223,49 +236,52 @@ positions, and the definition, when inlined."
;; optional argument of the command. Thus, check
;; the `org-protected' property of that command.
(or (not (org-inside-latex-macro-p))
- (and (get-text-property (1- beg) 'org-protected)
- (not (get-text-property beg 'org-protected)))))
+ (get-text-property (1- beg) 'org-protected)))
(list label beg end
;; Definition: ensure this is an inline footnote first.
(and (or (not label) (match-string 1))
- (org-trim (buffer-substring (match-end 0) (1- end)))))))))
+ (org-trim (buffer-substring-no-properties
+ (match-end 0) (1- end)))))))))
(defun org-footnote-at-definition-p ()
- "Is the cursor at a footnote definition?
+ "Is point within a footnote definition?
-This matches only pure definitions like [1] or [fn:name] at the beginning
-of a line. It does not match references like [fn:name:definition], where the
-footnote text is included and defined locally.
+This matches only pure definitions like [1] or [fn:name] at the
+beginning of a line. It does not match references like
+\[fn:name:definition], where the footnote text is included and
+defined locally.
-The return value will be nil if not at a footnote definition, and a list with
-label, start, end and definition of the footnote otherwise."
- (when (org-footnote-in-valid-context-p)
+The return value will be nil if not at a footnote definition, and
+a list with label, start, end and definition of the footnote
+otherwise."
+ (when (save-excursion (beginning-of-line) (org-footnote-in-valid-context-p))
(save-excursion
(end-of-line)
+ ;; Footnotes definitions are separated by new headlines or blank
+ ;; lines.
(let ((lim (save-excursion (re-search-backward
(concat org-outline-regexp-bol
"\\|^[ \t]*$") nil t))))
(when (re-search-backward org-footnote-definition-re lim t)
- (end-of-line)
- (list (match-string 2)
- (match-beginning 0)
- (save-match-data
- ;; In a message, limit search to signature.
- (let ((bound (and (derived-mode-p 'message-mode)
- (save-excursion
- (goto-char (point-max))
- (re-search-backward
- message-signature-separator nil t)))))
- (or (and (re-search-forward
- (org-re
- (concat "^[ \t]*$" "\\|"
- org-outline-regexp-bol
- "\\|"
- "^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]"))
- bound 'move)
- (progn (skip-chars-forward " \t\n") (point-at-bol)))
- (point))))
- (org-trim (buffer-substring (match-end 0) (point)))))))))
+ (let ((label (org-match-string-no-properties 1))
+ (beg (match-beginning 0))
+ (beg-def (match-end 0))
+ ;; In message-mode, do not search after signature.
+ (end (let ((bound (and (derived-mode-p 'message-mode)
+ (save-excursion
+ (goto-char (point-max))
+ (re-search-backward
+ message-signature-separator nil t)))))
+ (if (progn
+ (end-of-line)
+ (re-search-forward
+ (concat org-outline-regexp-bol "\\|"
+ org-footnote-definition-re "\\|"
+ "^[ \t]*$") bound 'move))
+ (match-beginning 0)
+ (point)))))
+ (list label beg end
+ (org-trim (buffer-substring-no-properties beg-def end)))))))))
(defun org-footnote-get-next-reference (&optional label backward limit)
"Return complete reference of the next footnote.
@@ -295,10 +311,11 @@ LIMIT is the buffer position bounding the search.
Return value is a list like those provided by
`org-footnote-at-reference-p' or `org-footnote-at-definition-p'.
If no footnote is found, return nil."
- (let* (ref)
+ (let* (ref (origin (point)))
(catch 'exit
(while t
(unless (re-search-forward org-footnote-re limit t)
+ (goto-char origin)
(throw 'exit nil))
;; Beware: with [1]-like footnotes point will be just after
;; the closing square bracket.
@@ -320,19 +337,21 @@ If no footnote is found, return nil."
(re (format "^\\[%s\\]\\|.\\[%s:" label label))
pos)
(save-excursion
- (when (or (re-search-forward re nil t)
- (and (goto-char (point-min))
- (re-search-forward re nil t))
- (and (progn (widen) t)
- (goto-char (point-min))
- (re-search-forward re nil t)))
- (let ((refp (org-footnote-at-reference-p)))
- (cond
- ((and (nth 3 refp) refp))
- ((org-footnote-at-definition-p))))))))
+ (save-restriction
+ (when (or (re-search-forward re nil t)
+ (and (goto-char (point-min))
+ (re-search-forward re nil t))
+ (and (progn (widen) t)
+ (goto-char (point-min))
+ (re-search-forward re nil t)))
+ (let ((refp (org-footnote-at-reference-p)))
+ (cond
+ ((and (nth 3 refp) refp))
+ ((org-footnote-at-definition-p)))))))))
(defun org-footnote-goto-definition (label)
- "Move point to the definition of the footnote LABEL."
+ "Move point to the definition of the footnote LABEL.
+Return a non-nil value when a definition has been found."
(interactive "sLabel: ")
(org-mark-ring-push)
(let ((def (org-footnote-get-definition label)))
@@ -342,7 +361,9 @@ If no footnote is found, return nil."
(looking-at (format "\\[%s\\]\\|\\[%s:" label label))
(goto-char (match-end 0))
(org-show-context 'link-search)
- (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))))
+ (when (derived-mode-p 'org-mode)
+ (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))
+ t)))
(defun org-footnote-goto-previous-reference (label)
"Find the first closest (to point) reference of footnote with label LABEL."
@@ -406,7 +427,12 @@ and value definition."
(defun org-footnote-unique-label (&optional current)
"Return a new unique footnote label.
-The returns the firsts fn:N labels that is currently not used."
+
+The function returns the first \"fn:N\" or \"N\" label that is
+currently not used.
+
+Optional argument CURRENT is the list of labels active in the
+buffer."
(unless current (setq current (org-footnote-all-labels)))
(let ((fmt (if (eq org-footnote-auto-label 'plain) "%d" "fn:%d"))
(cnt 1))
@@ -414,21 +440,18 @@ The returns the firsts fn:N labels that is currently not used."
(incf cnt))
(format fmt cnt)))
-(defvar org-footnote-label-history nil
- "History of footnote labels entered in current buffer.")
-(make-variable-buffer-local 'org-footnote-label-history)
-
(defun org-footnote-new ()
"Insert a new footnote.
This command prompts for a label. If this is a label referencing an
existing label, only insert the label. If the footnote label is empty
or new, let the user edit the definition of the footnote."
(interactive)
- (unless (and (not (bolp)) (org-footnote-in-valid-context-p))
+ (unless (org-footnote-in-valid-context-p)
(error "Cannot insert a footnote here"))
- (let* ((labels (and (not (equal org-footnote-auto-label 'random))
- (org-footnote-all-labels)))
- (propose (org-footnote-unique-label labels))
+ (let* ((lbls (and (not (equal org-footnote-auto-label 'random))
+ (org-footnote-all-labels)))
+ (propose (and (not (equal org-footnote-auto-label 'random))
+ (org-footnote-unique-label lbls)))
(label
(org-footnote-normalize-label
(cond
@@ -438,16 +461,16 @@ or new, let the user edit the definition of the footnote."
(require 'org-id)
(substring (org-id-uuid) 0 8))
(t
- (completing-read
+ (org-icompleting-read
"Label (leave empty for anonymous): "
- (mapcar 'list labels) nil nil
- (if (eq org-footnote-auto-label 'confirm) propose nil)
- 'org-footnote-label-history))))))
+ (mapcar 'list lbls) nil nil
+ (if (eq org-footnote-auto-label 'confirm) propose nil)))))))
(cond
+ ((bolp) (error "Cannot create a footnote reference at left margin"))
((not label)
(insert "[fn:: ]")
(backward-char 1))
- ((member label labels)
+ ((member label lbls)
(insert "[" label "]")
(message "New reference to existing note"))
(org-footnote-define-inline
@@ -459,51 +482,80 @@ or new, let the user edit the definition of the footnote."
(org-footnote-create-definition label)
(org-footnote-auto-adjust-maybe)))))
+(defvar org-blank-before-new-entry) ; silence byte-compiler
(defun org-footnote-create-definition (label)
"Start the definition of a footnote with label LABEL."
(interactive "sLabel: ")
(let ((label (org-footnote-normalize-label label)))
(cond
- ((org-mode-p)
- ;; No section, put footnote into the current outline node Try to
- ;; find or make the special node
+ ;; In an Org file.
+ ((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
(goto-char (point-min))
(let ((re (concat "^\\*+[ \t]+" org-footnote-section "[ \t]*$")))
(unless (or (re-search-forward re nil t)
(and (progn (widen) t)
(re-search-forward re nil t)))
- (goto-char (point-max))
- (insert "\n\n* " org-footnote-section "\n"))))
- ;; Now go to the end of this entry and insert there.
+ (goto-char (point-max))
+ (skip-chars-backward " \t\r\n")
+ (unless (bolp) (newline))
+ ;; Insert new section. Separate it from the previous one
+ ;; with a blank line, unless `org-blank-before-new-entry'
+ ;; explicitly says no.
+ (when (and (cdr (assq 'heading org-blank-before-new-entry))
+ (zerop (save-excursion (org-back-over-empty-lines))))
+ (insert "\n"))
+ (insert "* " org-footnote-section "\n"))))
+ ;; Move to the end of this entry (which may be
+ ;; `org-footnote-section' or the current one).
(org-footnote-goto-local-insertion-point)
(org-show-context 'link-search))
(t
;; In a non-Org file. Search for footnote tag, or create it if
- ;; necessary (at the end of buffer, or before a signature if in
+ ;; specified (at the end of buffer, or before signature if in
;; Message mode). Set point after any definition already there.
- (let ((tag (concat "^" org-footnote-tag-for-non-org-mode-files "[ \t]*$"))
- (max (save-excursion
- (if (and (derived-mode-p 'message-mode)
- (re-search-forward
- message-signature-separator nil t))
- (copy-marker (point-at-bol) t)
- (copy-marker (point-max) t)))))
+ (let ((tag (and org-footnote-tag-for-non-org-mode-files
+ (concat "^" (regexp-quote
+ org-footnote-tag-for-non-org-mode-files)
+ "[ \t]*$")))
+ (max (if (and (derived-mode-p 'message-mode)
+ (goto-char (point-max))
+ (re-search-backward
+ message-signature-separator nil t))
+ (progn
+ ;; Ensure one blank line separates last
+ ;; footnote from signature.
+ (beginning-of-line)
+ (open-line 2)
+ (point-marker))
+ (point-max-marker))))
+ (set-marker-insertion-type max t)
(goto-char max)
- (unless (re-search-backward tag nil t)
+ ;; Check if the footnote tag is defined but missing. In this
+ ;; case, insert it, before any footnote or one blank line
+ ;; after any previous text.
+ (when (and tag (not (re-search-backward tag nil t)))
(skip-chars-backward " \t\r\n")
- (delete-region (point) max)
- (insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n"))
- ;; Skip existing footnotes.
- (while (re-search-forward org-footnote-definition-re max t))
- (let ((def (org-footnote-at-definition-p)))
- (when def (goto-char (nth 2 def))))
+ (while (re-search-backward org-footnote-definition-re nil t))
+ (unless (bolp) (newline 2))
+ (insert org-footnote-tag-for-non-org-mode-files "\n\n"))
+ ;; Remove superfluous white space and clear marker.
+ (goto-char max)
+ (skip-chars-backward " \t\r\n")
+ (delete-region (point) max)
+ (unless (bolp) (newline))
(set-marker max nil))))
- ;; Insert footnote label, position point and notify user.
- (unless (bolp) (insert "\n"))
- (insert "\n[" label "] \n")
+ ;; Insert footnote label.
+ (when (zerop (org-back-over-empty-lines)) (newline))
+ (insert "[" label "] \n")
(backward-char)
- (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))
+ ;; Only notify user about next possible action when in an Org
+ ;; buffer, as the bindings may have different meanings otherwise.
+ (when (derived-mode-p 'org-mode)
+ (message
+ "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))))
;;;###autoload
(defun org-footnote-action (&optional special)
@@ -552,8 +604,8 @@ With prefix arg SPECIAL, offer additional commands in a menu."
(defvar org-footnote-insert-pos-for-preprocessor 'point-max
"See `org-footnote-normalize'.")
-(defvar org-export-footnotes-seen nil) ; silence byte-compiler
-(defvar org-export-footnotes-data nil) ; silence byte-compiler
+(defvar org-export-footnotes-seen) ; silence byte-compiler
+(defvar org-export-footnotes-data) ; silence byte-compiler
;;;###autoload
(defun org-footnote-normalize (&optional sort-only export-props)
@@ -570,11 +622,11 @@ If Org is amidst an export process, EXPORT-PROPS will hold the
export properties of the buffer.
When EXPORT-PROPS is non-nil, the default action is to insert
-normalized footnotes towards the end of the pre-processing buffer.
-Some exporters like docbook, odt, etc. expect that footnote
-definitions be available before any references to them. Such
-exporters can let bind `org-footnote-insert-pos-for-preprocessor' to
-symbol 'point-min to achieve the desired behavior.
+normalized footnotes towards the end of the pre-processing
+buffer. Some exporters (docbook, odt...) expect footnote
+definitions to be available before any references to them. Such
+exporters can let bind `org-footnote-insert-pos-for-preprocessor'
+to symbol `point-min' to achieve the desired behaviour.
Additional note on `org-footnote-insert-pos-for-preprocessor':
1. This variable has not effect when FOR-PREPROCESSOR is nil.
@@ -608,6 +660,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(goto-char (point-min))
(while (setq ref (org-footnote-get-next-reference))
(let* ((lbl (car ref))
+ (pos (nth 1 ref))
;; When footnote isn't anonymous, check if it's label
;; (REF) is already stored in REF-TABLE. In that case,
;; extract number used to identify it (MARKER). If
@@ -624,8 +677,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; If EXPORT-PROPS isn't nil, also add `org-footnote'
;; property to it, so it can be easily recognized by
;; exporters.
- (if sort-only
- (goto-char (nth 2 ref))
+ (if sort-only (goto-char (nth 2 ref))
(delete-region (nth 1 ref) (nth 2 ref))
(goto-char (nth 1 ref))
(let ((new-ref (format "[%d]" marker)))
@@ -634,8 +686,9 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(and inlinep
org-footnote-fill-after-inline-note-extraction
(org-fill-paragraph)))
- ;; Add label (REF), identifier (MARKER) and definition (DEF)
- ;; to REF-TABLE if data was unknown.
+ ;; Add label (REF), identifier (MARKER), definition (DEF)
+ ;; type (INLINEP) and position (POS) to REF-TABLE if data
+ ;; was unknown.
(unless a
(let ((def (or (nth 3 ref) ; inline
(and export-props
@@ -646,52 +699,67 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; through `org-export-preprocess-string' so
;; it is ready to insert in the
;; backend-specific buffer.
- (if export-props
+ (if (and export-props def)
(let ((parameters
(org-combine-plists
export-props
'(:todo-keywords t :tags t :priority t))))
- (org-export-preprocess-string def parameters))
+ (apply #'org-export-preprocess-string def parameters))
def)
- inlinep) ref-table)))
- ;; Remove definition of non-inlined footnotes.
- (unless inlinep (org-footnote-delete-definitions lbl))))
+ ;; Reference beginning position is a marker
+ ;; to preserve it during further buffer
+ ;; modifications.
+ inlinep (copy-marker pos)) ref-table)))))
;; 2. Find and remove the footnote section, if any. Also
;; determine where footnotes shall be inserted (INS-POINT).
- (goto-char (point-min))
(cond
- ((org-mode-p)
- (if (and org-footnote-section
- (re-search-forward
- (concat "^\\*[ \t]+" (regexp-quote org-footnote-section)
- "[ \t]*$")
- nil t))
- (progn
- (setq ins-point (match-beginning 0))
- (delete-region (match-beginning 0) (org-end-of-subtree t)))
- (setq ins-point (point-max))))
+ ((and org-footnote-section (derived-mode-p 'org-mode))
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^\\*[ \t]+" (regexp-quote org-footnote-section)
+ "[ \t]*$") nil t)
+ (delete-region (match-beginning 0) (org-end-of-subtree t t)))
+ ;; A new footnote section is inserted by default at the end of
+ ;; the buffer.
+ (goto-char (point-max))
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (unless (bolp) (newline)))
+ ;; No footnote section set: Footnotes will be added at the end
+ ;; of the section containing their first reference.
+ ;; Nevertheless, in an export situation, set insertion point to
+ ;; `point-max' by default.
+ ((derived-mode-p 'org-mode)
+ (when export-props
+ (goto-char (point-max))
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (delete-region (point) (point-max))))
(t
- (when (re-search-forward
- (concat "^"
- (regexp-quote org-footnote-tag-for-non-org-mode-files)
- "[ \t]*$")
- nil t)
- (replace-match ""))
- ;; In message-mode, ensure footnotes are inserted before the
+ ;; Remove any left-over tag in the buffer, if one is set up.
+ (when org-footnote-tag-for-non-org-mode-files
+ (let ((tag (concat "^" (regexp-quote
+ org-footnote-tag-for-non-org-mode-files)
+ "[ \t]*$")))
+ (goto-char (point-min))
+ (while (re-search-forward tag nil t)
+ (replace-match "")
+ (delete-region (point) (progn (forward-line) (point))))))
+ ;; In Message mode, ensure footnotes are inserted before the
;; signature.
- (let ((pt-max
- (or (and (derived-mode-p 'message-mode)
- (save-excursion
- (goto-char (point-max))
- (re-search-backward
- message-signature-separator nil t)
- (1- (point))))
- (point-max))))
- (goto-char pt-max)
- (skip-chars-backward " \t\n\r")
- (forward-line)
- (delete-region (point) pt-max))
- (setq ins-point (point))))
+ (if (and (derived-mode-p 'message-mode)
+ (goto-char (point-max))
+ (re-search-backward message-signature-separator nil t))
+ (beginning-of-line)
+ (goto-char (point-max)))))
+ ;; During export, `org-footnote-insert-pos-for-preprocessor' has
+ ;; precedence over previously found position.
+ (setq ins-point
+ (copy-marker
+ (if (and export-props
+ (eq org-footnote-insert-pos-for-preprocessor 'point-min))
+ (point-min)
+ (point))))
;; 3. Clean-up REF-TABLE.
(setq ref-table
(delq nil
@@ -699,64 +767,76 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(lambda (x)
(cond
;; When only sorting, ignore inline footnotes.
- ((and sort-only (nth 3 x)) nil)
+ ;; Also clear position marker.
+ ((and sort-only (nth 3 x))
+ (set-marker (nth 4 x) nil) nil)
;; No definition available: provide one.
((not (nth 2 x))
- (append (butlast x 2)
- (list (format "DEFINITION NOT FOUND: %s" (car x))
- (nth 3 x))))
+ (append
+ (list (car x) (nth 1 x)
+ (format "DEFINITION NOT FOUND: %s" (car x)))
+ (nthcdr 3 x)))
(t x)))
ref-table)))
(setq ref-table (nreverse ref-table))
- ;; 4. Insert the footnotes again in the buffer, at the
+ ;; 4. Remove left-over definitions in the buffer.
+ (mapc (lambda (x)
+ (unless (nth 3 x) (org-footnote-delete-definitions (car x))))
+ ref-table)
+ ;; 5. Insert the footnotes again in the buffer, at the
;; appropriate spot.
- (goto-char (or
- (and export-props
- (eq org-footnote-insert-pos-for-preprocessor 'point-min)
- (point-min))
- ins-point
- (point-max)))
+ (goto-char ins-point)
(cond
;; No footnote: exit.
((not ref-table))
;; Cases when footnotes should be inserted in one place.
- ((or (not (org-mode-p))
+ ((or (not (derived-mode-p 'org-mode))
org-footnote-section
- (not sort-only))
- ;; Insert again the section title.
+ export-props)
+ ;; Insert again the section title, if any. Ensure that title,
+ ;; or the subsequent footnotes, will be separated by a blank
+ ;; lines from the rest of the document. In an Org buffer,
+ ;; separate section with a blank line, unless explicitly
+ ;; stated in `org-blank-before-new-entry'.
(cond
- ((not (org-mode-p))
- (insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n"))
+ ((not (derived-mode-p 'org-mode))
+ (skip-chars-backward " \t\n\r")
+ (delete-region (point) ins-point)
+ (unless (bolp) (newline))
+ (when org-footnote-tag-for-non-org-mode-files
+ (insert "\n" org-footnote-tag-for-non-org-mode-files "\n")))
((and org-footnote-section (not export-props))
- (or (bolp) (insert "\n"))
+ (when (and (cdr (assq 'heading org-blank-before-new-entry))
+ (zerop (save-excursion (org-back-over-empty-lines))))
+ (insert "\n"))
(insert "* " org-footnote-section "\n")))
- ;; Insert the footnotes.
- (insert "\n"
- (mapconcat (lambda (x) (format "[%s] %s"
- (nth (if sort-only 0 1) x) (nth 2 x)))
- ref-table "\n\n")
- "\n\n")
+ (set-marker ins-point nil)
+ ;; Insert the footnotes, separated by a blank line.
+ (insert
+ (mapconcat
+ (lambda (x)
+ ;; Clean markers.
+ (set-marker (nth 4 x) nil)
+ (format "\n[%s] %s" (nth (if sort-only 0 1) x) (nth 2 x)))
+ ref-table "\n"))
+ (unless (eobp) (insert "\n\n"))
;; When exporting, add newly inserted markers along with their
;; associated definition to `org-export-footnotes-seen'.
- (when export-props
- (setq org-export-footnotes-seen ref-table)))
- ;; Else, insert each definition at the end of the section
- ;; containing their first reference. Happens only in Org files
- ;; with no special footnote section, and only when doing
- ;; sorting.
- (t (mapc 'org-insert-footnote-reference-near-definition
- ref-table))))))
-
-(defun org-insert-footnote-reference-near-definition (entry)
- "Find first reference of footnote ENTRY and insert the definition there.
-ENTRY is (fn-label num-mark definition)."
- (when (car entry)
- (goto-char (point-min))
- (let ((ref (org-footnote-get-next-reference (car entry))))
- (when ref
- (goto-char (nth 2 ref))
- (org-footnote-goto-local-insertion-point)
- (insert (format "\n[%s] %s\n" (car entry) (nth 2 entry)))))))
+ (when export-props (setq org-export-footnotes-seen ref-table)))
+ ;; Each footnote definition has to be inserted at the end of
+ ;; the section where its first reference belongs.
+ (t
+ (mapc
+ (lambda (x)
+ (let ((pos (nth 4 x)))
+ (goto-char pos)
+ ;; Clean marker.
+ (set-marker pos nil))
+ (org-footnote-goto-local-insertion-point)
+ (insert (format "\n[%s] %s\n"
+ (if sort-only (car x) (nth 1 x))
+ (nth 2 x))))
+ ref-table))))))
(defun org-footnote-goto-local-insertion-point ()
"Find insertion point for footnote, just before next outline heading."
@@ -765,7 +845,7 @@ ENTRY is (fn-label num-mark definition)."
(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))
@@ -791,8 +871,13 @@ Return the number of footnotes removed."
(ndef 0))
(while (re-search-forward def-re nil t)
(let ((full-def (org-footnote-at-definition-p)))
- (delete-region (nth 1 full-def) (nth 2 full-def)))
- (incf ndef))
+ (when 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)))
(defun org-footnote-delete (&optional label)
@@ -807,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)
@@ -831,20 +916,21 @@ If LABEL is non-nil, delete that footnote instead."
(defun org-footnote-renumber-fn:N ()
"Renumber the simple footnotes like fn:17 into a sequence in the document."
(interactive)
- (let (map i (n 0))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward "\\[fn:\\([0-9]+\\)[]:]" nil t)
- (setq i (string-to-number (match-string 1)))
- (when (and (string-match "\\S-" (buffer-substring
- (point-at-bol) (match-beginning 0)))
- (not (assq i map)))
- (push (cons i (number-to-string (incf n))) map)))
- (goto-char (point-min))
- (while (re-search-forward "\\(\\[fn:\\)\\([0-9]+\\)\\([]:]\\)" nil t)
- (replace-match (concat "\\1" (cdr (assq (string-to-number (match-string 2)) map)) "\\3")))))))
+ (let (map (n 0))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "\\[fn:\\([0-9]+\\)[]:]" nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ ;; Ensure match is a footnote reference or definition.
+ (when (save-match-data (if (bolp)
+ (org-footnote-at-definition-p)
+ (org-footnote-at-reference-p)))
+ (let ((new-val (or (cdr (assoc (match-string 1) map))
+ (number-to-string (incf n)))))
+ (unless (assoc (match-string 1) map)
+ (push (cons (match-string 1) new-val) map))
+ (replace-match new-val nil nil nil 1))))))))
(defun org-footnote-auto-adjust-maybe ()
"Renumber and/or sort footnotes according to user settings."
@@ -862,6 +948,8 @@ If LABEL is non-nil, delete that footnote instead."
(provide 'org-footnote)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-footnote.el ends here
diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el
index b01f6d9fa6e..afc925d5426 100644
--- a/lisp/org/org-freemind.el
+++ b/lisp/org/org-freemind.el
@@ -1,11 +1,10 @@
;;; org-freemind.el --- Export Org files to freemind
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -61,7 +60,7 @@
(require 'xml)
(require 'org)
-;(require 'rx)
+ ;(require 'rx)
(require 'org-exp)
(eval-when-compile (require 'cl))
@@ -140,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
@@ -259,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))
@@ -292,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>.
@@ -335,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)
@@ -381,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)
@@ -411,10 +410,11 @@ 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).
+ :version "24.1"
:group 'org-freemind)
(defun org-freemind-org-text-to-freemind-subnode/note (node-name start end drawers-regexp)
@@ -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."
@@ -1217,7 +1219,8 @@ PATH should be a list of steps, where each step has the form
(provide 'org-freemind)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; org-freemind.el ends here
diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el
index 0ccb66ca497..77f9c0b8a7f 100644
--- a/lisp/org/org-gnus.el
+++ b/lisp/org/org-gnus.el
@@ -1,12 +1,11 @@
;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Tassilo Horn <tassilo at member dot fsf dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -33,6 +32,7 @@
;;; Code:
(require 'org)
+(require 'gnus-util)
(eval-when-compile (require 'gnus-sum))
;; Declare external functions and variables
@@ -63,6 +63,7 @@ configured) IMAP servers don't support this operation quickly.
So if following a link to a Gnus article takes ages, try setting
this variable to `t'."
:group 'org-link-store
+ :version "24.1"
:type 'boolean)
@@ -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."
@@ -176,7 +177,7 @@ If `org-store-link' was called with a prefix arg the meaning of
(setq to (or to (gnus-fetch-original-field "To"))
newsgroups (gnus-fetch-original-field "Newsgroups")
x-no-archive (gnus-fetch-original-field "x-no-archive")))
- (org-store-link-props :type "gnus" :from from :subject subject
+ (org-store-link-props :type "gnus" :from from :subject subject
:message-id message-id :group group :to to)
(when date
(org-add-link-props :date date :date-timestamp date-ts
@@ -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))))
@@ -291,5 +292,4 @@ If `org-store-link' was called with a prefix arg the meaning of
(provide 'org-gnus)
-
;;; org-gnus.el ends here
diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el
index c146a5bebbd..5b68ac32265 100644
--- a/lisp/org/org-habit.el
+++ b/lisp/org/org-habit.el
@@ -1,11 +1,10 @@
;;; org-habit.el --- The habit tracking code for Org-mode
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -68,6 +67,24 @@ 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
+ :version "24.1"
+ :type 'character)
+
+(defcustom org-habit-completed-glyph ?*
+ "Glyph character used to show completed days on which a task was done."
+ :group 'org-habit
+ :version "24.1"
+ :type 'character)
+
(defface org-habit-clear-face
'((((background light)) (:background "#8270f9"))
(((background dark)) (:background "blue")))
@@ -297,7 +314,7 @@ current time."
(days-to-time
(- start (time-to-days starting))))))
- (aset graph index ?*)
+ (aset graph index org-habit-completed-glyph)
(setq markedp t)
(put-text-property
index (1+ index) 'help-echo
@@ -307,7 +324,7 @@ current time."
(setq last-done-date (car done-dates)
done-dates (cdr done-dates))))
(if todayp
- (aset graph index ?!)))
+ (aset graph index org-habit-today-glyph)))
(setq face (if (or in-the-past-p todayp)
(car faces)
(cdr faces)))
@@ -325,7 +342,14 @@ current time."
(let ((inhibit-read-only t) l c
(buffer-invisibility-spec '(org-link))
(moment (time-subtract (current-time)
- (list 0 (* 3600 org-extend-today-until) 0))))
+ (list 0 (* 3600 org-extend-today-until) 0)))
+ disabled-overlays)
+ ;; Disable filters; this helps with alignment if there are links.
+ (mapc (lambda (ol)
+ (when (overlay-get ol 'invisible)
+ (overlay-put ol 'invisible nil)
+ (setq disabled-overlays (cons ol disabled-overlays))))
+ (overlays-in (point-min) (point-max)))
(save-excursion
(goto-char (if line (point-at-bol) (point-min)))
(while (not (eobp))
@@ -335,14 +359,15 @@ current time."
(delete-char (min (+ 1 org-habit-preceding-days
org-habit-following-days)
(- (line-end-position) (point))))
- (insert (org-habit-build-graph
- habit
- (time-subtract moment
- (days-to-time org-habit-preceding-days))
- moment
- (time-add moment
- (days-to-time org-habit-following-days))))))
- (forward-line)))))
+ (insert-before-markers
+ (org-habit-build-graph
+ habit
+ (time-subtract moment (days-to-time org-habit-preceding-days))
+ moment
+ (time-add moment (days-to-time org-habit-following-days))))))
+ (forward-line)))
+ (mapc (lambda (ol) (overlay-put ol 'invisible t))
+ disabled-overlays)))
(defun org-habit-toggle-habits ()
"Toggle display of habits in an agenda buffer."
@@ -358,6 +383,4 @@ current time."
(provide 'org-habit)
-
-
;;; org-habit.el ends here
diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el
index 46126ce2573..a6ca2d2a03b 100644
--- a/lisp/org/org-html.el
+++ b/lisp/org/org-html.el
@@ -1,11 +1,10 @@
;;; org-html.el --- HTML export for Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -34,6 +33,8 @@
(declare-function org-id-find-id-file "org-id" (id))
(declare-function htmlize-region "ext:htmlize" (beg end))
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
(defgroup org-export-html nil
"Options specific for HTML export of Org-mode files."
@@ -63,6 +64,7 @@ by the footnotes themselves."
(defcustom org-export-html-footnote-separator "<sup>, </sup>"
"Text used to separate footnotes."
:group 'org-export-html
+ :version "24.1"
:type 'string)
(defcustom org-export-html-coding-system nil
@@ -96,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)
{
@@ -119,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; }
@@ -155,6 +181,12 @@ not be modified."
dt { font-weight: bold; }
div.figure { padding: 0.5em; }
div.figure p { text-align: center; }
+ div.inlinetask {
+ padding:10px;
+ border:2px solid gray;
+ margin:10px;
+ background: #ffffcc;
+ }
textarea { overflow-x: auto; }
.linenr { font-size:smaller }
.code-highlighted {background-color:#ffff00;}
@@ -178,6 +210,7 @@ not be modified. Use the variables `org-export-html-style' to add
your own style information."
:group 'org-export-html
:type 'boolean)
+
;;;###autoload
(put 'org-export-html-style-include-default 'safe-local-variable 'booleanp)
@@ -245,17 +278,18 @@ You can also customize this for each buffer, using something like
#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\""
: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."
@@ -267,8 +301,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)
@@ -286,6 +321,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
@@ -328,6 +413,7 @@ You can also customize this for each buffer, using something like
</script>"
"The MathJax setup for XHTML files."
:group 'org-export-html
+ :version "24.1"
:type 'string)
(defcustom org-export-html-tag-class-prefix ""
@@ -348,6 +434,15 @@ CSS classes, then this prefix can be very useful."
:group 'org-export-html
:type 'string)
+(defcustom org-export-html-headline-anchor-format "<a name=\"%s\" id=\"%s\"></a>"
+ "Format for anchors in HTML headlines.
+It requires to %s: both will be replaced by the anchor referring
+to the headline (e.g. \"sec-2\"). When set to `nil', don't insert
+HTML anchors in headlines."
+ :group 'org-export-html
+ :version "24.1"
+ :type 'string)
+
(defcustom org-export-html-preamble t
"Non-nil means insert a preamble in HTML export.
@@ -355,19 +450,25 @@ When `t', insert a string as defined by one of the formatting
strings in `org-export-html-preamble-format'. When set to a
string, this string overrides `org-export-html-preamble-format'.
When set to a function, apply this function and insert the
-returned string. The function takes the property list of export
-options as its only argument.
+returned string. The function takes no argument, but you can
+use `opt-plist' to access the current export options.
Setting :html-preamble in publishing projects will take
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.
@@ -377,27 +478,28 @@ precedence over this variable."
If you need to use a \"%\" character, you need to escape it
like that: \"%%\"."
:group 'org-export-html
+ :version "24.1"
:type 'string)
(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
`org-export-author/email/creator-info' variables. When set to a
function, apply this function and insert the returned string.
-The function takes the property list of export options as its
-only argument.
+The function takes no argument, but you can use `opt-plist' to
+access the current export options.
Setting :html-postamble in publishing projects will take
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
@@ -406,7 +508,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.
@@ -417,6 +525,7 @@ precedence over this variable."
If you need to use a \"%\" character, you need to escape it
like that: \"%%\"."
:group 'org-export-html
+ :version "24.1"
:type 'string)
(defcustom org-export-html-home/up-format
@@ -533,6 +642,7 @@ When nil, alignment will only be specified in the column tags, but this
is ignored by some browsers (like Firefox, Safari). Opera does it right
though."
:group 'org-export-tables
+ :version "24.1"
:type 'boolean)
(defcustom org-export-html-table-use-header-tags-for-first-column nil
@@ -563,6 +673,7 @@ When nil, also column one will use data tags."
(">" . "&gt;"))
"Alist of characters to be converted by `org-html-protect'."
:group 'org-export-html
+ :version "24.1"
:type '(repeat (cons (string :tag "Character")
(string :tag "HTML equivalent"))))
@@ -619,13 +730,25 @@ This variable is obsolete since Org version 7.7.
Please set `org-export-html-divs' instead.")
(defcustom org-export-html-divs '("preamble" "content" "postamble")
- "The name of the main divs for HTML export."
+ "The name of the main divs for HTML export.
+This is a list of three strings, the first one for the preamble
+DIV, the second one for the content DIV and the third one for the
+postamble DIV."
:group 'org-export-html
+ :version "24.1"
:type '(list
(string :tag " Div for the preamble:")
(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
@@ -641,7 +764,7 @@ Please set `org-export-html-divs' instead.")
(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"
@@ -650,8 +773,8 @@ Please set `org-export-html-divs' instead.")
((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)
@@ -703,7 +826,7 @@ command to convert it."
(interactive "r")
(let (reg html buf pop-up-frames)
(save-window-excursion
- (if (org-mode-p)
+ (if (derived-mode-p 'org-mode)
(setq html (org-export-region-as-html
beg end t 'string))
(setq reg (buffer-substring beg end)
@@ -755,150 +878,150 @@ 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#locationx)
-FRAGMENT is the fragment part of the link, if any (foo.html#THIS)
+TYPE is the device-type of the link (THIS://foo.html).
+PATH is the path of the link (http://THIS#location).
+FRAGMENT is the fragment part of the link, if any (foo.html#THIS).
DESC is the link description, if any.
-ATTR is a string of other attributes of the a element.
+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)))
"file")
(t "internal")))
- (setq path (org-extract-attributes (org-link-unescape path)))
+ (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))
@@ -909,7 +1032,7 @@ OPT-PLIST is the export options list."
(if (string-match "^file:" desc)
(setq desc (substring desc (match-end 0)))))
(setq desc (org-add-props
- (concat "<img src=\"" desc "\" alt=\""
+ (concat "<img src=\"" desc "\" alt=\""
(file-name-nondirectory desc) "\"/>")
'(org-protected t))))
(cond
@@ -1036,14 +1159,17 @@ OPT-PLIST is the export options list."
(t
;; just publish the path, as default
- (setq rpl (concat "@<i>&lt;" type ":"
+ (setq rpl (concat "<i>&lt;" type ":"
(save-match-data (org-link-unescape path))
- "&gt;@</i>"))))
- (setq line (replace-match rpl t t line)
+ "&gt;</i>"))))
+ (setq org-line (replace-match rpl t t org-line)
start (+ start (length rpl))))
- line))
+ org-line))
;;; org-export-as-html
+
+(defvar org-heading-keyword-regexp-format) ; defined in org.el
+
;;;###autoload
(defun org-export-as-html (arg &optional hidden ext-plist
to-buffer body-only pub-dir)
@@ -1120,7 +1246,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
@@ -1137,14 +1263,15 @@ PUB-DIR is set, use this as the publishing directory."
(current-dir (if buffer-file-name
(file-name-directory buffer-file-name)
default-directory))
+ (auto-insert nil); Avoid any auto-insert stuff for the new file
(buffer (if to-buffer
(cond
((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
(t (get-buffer-create to-buffer)))
(find-file-noselect filename)))
(org-levels-open (make-vector org-level-max nil))
- (date (plist-get opt-plist :date))
- (author (plist-get opt-plist :author))
+ (date (org-html-expand (plist-get opt-plist :date)))
+ (author (org-html-expand (plist-get opt-plist :author)))
(html-validation-link (or org-export-html-validation-link ""))
(title (org-html-expand
(or (and subtree-p (org-export-get-title-from-subtree))
@@ -1165,15 +1292,16 @@ PUB-DIR is set, use this as the publishing directory."
(plist-get opt-plist :link-home)))
(dummy (setq opt-plist (plist-put opt-plist :title title)))
(html-table-tag (plist-get opt-plist :html-table-tag))
- (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
- (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
+ (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)"))
+ (quote-re (format org-heading-keyword-regexp-format
+ org-quote-string))
(inquote nil)
(infixed nil)
(inverse nil)
(email (plist-get opt-plist :email))
(language (plist-get opt-plist :language))
- (keywords (plist-get opt-plist :keywords))
- (description (plist-get opt-plist :description))
+ (keywords (org-html-expand (plist-get opt-plist :keywords)))
+ (description (org-html-expand (plist-get opt-plist :description)))
(num (plist-get opt-plist :section-numbers))
(lang-words nil)
(head-count 0) cnt
@@ -1195,6 +1323,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
@@ -1235,8 +1366,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
@@ -1253,7 +1383,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)
@@ -1287,11 +1417,11 @@ PUB-DIR is set, use this as the publishing directory."
"%s
<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
-<html xmlns=\"http://www.w3.org/1999/xhtml\"
-lang=\"%s\" xml:lang=\"%s\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\">
<head>
<title>%s</title>
<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
+<meta name=\"title\" content=\"%s\"/>
<meta name=\"generator\" content=\"Org-mode\"/>
<meta name=\"generated\" content=\"%s\"/>
<meta name=\"author\" content=\"%s\"/>
@@ -1314,7 +1444,7 @@ lang=\"%s\" xml:lang=\"%s\">
language language
title
(or charset "iso-8859-1")
- date author description keywords
+ title date author description keywords
style
mathjax
(if (or link-up link-home)
@@ -1327,35 +1457,42 @@ lang=\"%s\" xml:lang=\"%s\">
;; insert html preamble
(when (plist-get opt-plist :html-preamble)
- (let ((html-pre (plist-get opt-plist :html-preamble)))
- (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n")
+ (let ((html-pre (plist-get opt-plist :html-preamble))
+ (html-pre-real-contents ""))
(cond ((stringp html-pre)
- (insert
- (format-spec html-pre `((?t . ,title) (?a . ,author)
- (?d . ,date) (?e . ,email)))))
+ (setq html-pre-real-contents
+ (format-spec html-pre `((?t . ,title) (?a . ,author)
+ (?d . ,date) (?e . ,email)))))
((functionp html-pre)
- (funcall html-pre))
+ (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n")
+ (if (stringp (funcall html-pre)) (insert (funcall html-pre)))
+ (insert "\n</div>\n"))
(t
- (insert
- (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))))))
- (insert "\n</div>\n")))
+ (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))))))
+ ;; don't output an empty preamble DIV
+ (unless (and (functionp html-pre)
+ (equal html-pre-real-contents ""))
+ (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n")
+ (insert html-pre-real-contents)
+ (insert "\n</div>\n"))))
;; begin wrap around body
- (insert (format "\n<div id=\"%s\">"
+ (insert (format "\n<div id=\"%s\">"
;; FIXME org-export-html-content-div is obsolete since 7.7
- (or org-export-html-content-div
+ (or org-export-html-content-div
(nth 1 org-export-html-divs)))
;; FIXME this should go in the preamble but is here so
;; that org-infojs can still find it
"\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
@@ -1365,10 +1502,10 @@ lang=\"%s\" xml:lang=\"%s\">
(push "<div id=\"text-table-of-contents\">\n" thetoc)
(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)))
+ (mapcar
+ #'(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)
@@ -1378,21 +1515,21 @@ lang=\"%s\" xml:lang=\"%s\">
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
- "&nbsp;&nbsp;&nbsp;<span class=\"tag\"> \\1</span>" t nil txt)))
+ (setq txt (replace-match
+ "&nbsp;&nbsp;&nbsp;<span class=\"tag\">\\1</span>" t nil txt)))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt)))
(setq snumber (org-section-number level))
@@ -1417,18 +1554,18 @@ lang=\"%s\" xml:lang=\"%s\">
(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
(replace-regexp-in-string
"\\." "-" (format "sec-%s" snumber)))
- (setq href (org-solidify-link-text
- (or (cdr (assoc href
+ (setq href (org-solidify-link-text
+ (or (cdr (assoc href
org-export-preferred-target-alist)) href)))
(push
(format
@@ -1436,43 +1573,43 @@ lang=\"%s\" xml:lang=\"%s\">
"</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>"
"</li>\n<li><a href=\"#%s\">%s</a>")
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))
(push "</li>\n</ul>\n" thetoc))
(push "</div>\n" thetoc)
(setq thetoc (if have-headings (nreverse thetoc) nil))))
-
+
(setq head-count 0)
(org-init-section-numbers)
-
+
(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))))
@@ -1482,17 +1619,17 @@ lang=\"%s\" xml:lang=\"%s\">
(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)
@@ -1504,143 +1641,144 @@ lang=\"%s\" xml:lang=\"%s\">
(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 (string-match org-todo-line-regexp line)
+ (if (and org-todo-line-regexp
+ (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")
- " " (match-string 2 line)
- "\"> " (org-export-html-get-todo-kwd-class-name
- (match-string 2 line))
- "</span>" (substring line (match-end 2)))))
+ " " (org-export-html-get-todo-kwd-class-name
+ (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))
@@ -1651,19 +1789,19 @@ lang=\"%s\" xml:lang=\"%s\">
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]*\\)\\(|\\|\\+-+\\+\\)"
@@ -1678,15 +1816,15 @@ lang=\"%s\" xml:lang=\"%s\">
(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"))
@@ -1695,44 +1833,45 @@ lang=\"%s\" xml:lang=\"%s\">
;; 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
@@ -1774,7 +1913,8 @@ lang=\"%s\" xml:lang=\"%s\">
(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)
@@ -1785,18 +1925,19 @@ lang=\"%s\" xml:lang=\"%s\">
(?d . ,date) (?c . ,creator-info)
(?v . ,html-validation-link)))))
((functionp html-post)
- (funcall html-post))
+ (if (stringp (funcall html-post)) (insert (funcall html-post))))
((eq html-post 'auto)
;; fall back on default postamble
(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
@@ -1808,7 +1949,7 @@ lang=\"%s\" xml:lang=\"%s\">
(?d . ,date) (?c . ,creator-info)
(?v . ,html-validation-link))))))
(insert "\n</div>"))))
-
+
;; FIXME `org-export-html-with-timestamp' has been declared
;; obsolete since Org 7.7 -- don't forget to remove this.
(if org-export-html-with-timestamp
@@ -1891,7 +2032,7 @@ lang=\"%s\" xml:lang=\"%s\">
(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))
@@ -1899,21 +2040,21 @@ lang=\"%s\" xml:lang=\"%s\">
(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."
@@ -1929,7 +2070,7 @@ lang=\"%s\" xml:lang=\"%s\">
(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
@@ -1941,7 +2082,7 @@ NO-CSS is passed to the exporter."
(if (string-match "^[ \t]*|" (car lines))
;; A normal org table
(org-format-org-table-html lines nil no-css)
- ;; Table made by table.el
+ ;; Table made by table.el
(or (org-format-table-table-html-using-table-generate-source
olines (not org-export-prefer-native-exporter-for-tables))
;; We are here only when table.el table has NO col or row
@@ -1969,8 +2110,8 @@ for formatting. This is required for the DocBook exporter."
(let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
(label (org-find-text-property-in-string 'org-label (car lines)))
- (forced-aligns (org-find-text-property-in-string 'org-forced-aligns
- (car lines)))
+ (col-cookies (org-find-text-property-in-string 'org-col-cookies
+ (car lines)))
(attributes (org-find-text-property-in-string 'org-attributes
(car lines)))
(html-table-tag (org-export-splice-attributes
@@ -1980,18 +2121,18 @@ 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 forced-aligns org-table-clean-did-remove-column)
- (setq forced-aligns
- (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) forced-aligns)))
+ (when (and col-cookies org-table-clean-did-remove-column)
+ (setq col-cookies
+ (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies)))
(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)
@@ -2000,7 +2141,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
@@ -2046,8 +2187,8 @@ for formatting. This is required for the DocBook exporter."
(lambda (x)
(setq gr (pop org-table-colgroup-info)
i (1+ i)
- align (if (assoc i forced-aligns)
- (cdr (assoc (cdr (assoc i forced-aligns))
+ align (if (nth 1 (assoc i col-cookies))
+ (cdr (assoc (nth 1 (assoc i col-cookies))
'(("l" . "left") ("r" . "right")
("c" . "center"))))
(if (> (/ (float x) nline)
@@ -2074,11 +2215,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)
@@ -2115,14 +2257,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
@@ -2148,7 +2290,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)
@@ -2203,19 +2345,20 @@ for further information."
"Format time stamps in string S, or remove them."
(catch 'exit
(let (r b)
- (while (string-match org-maybe-keyword-time-regexp s)
- (or b (setq b (substring s 0 (match-beginning 0))))
- (setq r (concat
- r (substring s 0 (match-beginning 0))
- " @<span class=\"timestamp-wrapper\">"
- (if (match-end 1)
- (format "@<span class=\"timestamp-kwd\">%s @</span>"
- (match-string 1 s)))
- (format " @<span class=\"timestamp\">%s@</span>"
- (substring
- (org-translate-time (match-string 3 s)) 1 -1))
- "@</span>")
- s (substring s (match-end 0))))
+ (when org-maybe-keyword-time-regexp
+ (while (string-match org-maybe-keyword-time-regexp s)
+ (or b (setq b (substring s 0 (match-beginning 0))))
+ (setq r (concat
+ r (substring s 0 (match-beginning 0))
+ " @<span class=\"timestamp-wrapper\">"
+ (if (match-end 1)
+ (format "@<span class=\"timestamp-kwd\">%s @</span>"
+ (match-string 1 s)))
+ (format " @<span class=\"timestamp\">%s@</span>"
+ (substring
+ (org-translate-time (match-string 3 s)) 1 -1))
+ "@</span>")
+ s (substring s (match-end 0)))))
;; Line break if line started and ended with time stamp stuff
(if (not r)
s
@@ -2238,7 +2381,6 @@ the settings define in the org-... variables."
(plist-get htmlize-buffer-places 'content-end)))
(kill-buffer htmlbuf))))
-;;;###autoload
(defun org-export-htmlize-generate-css ()
"Create the CSS for all font definitions in the current Emacs session.
Use this to create face definitions in your CSS style file that can then
@@ -2263,7 +2405,7 @@ that uses these same face definitions."
(when (and (symbolp f) (or (not i) (not (listp i))))
(insert (org-add-props (copy-sequence "1") nil 'face f))))
(htmlize-region (point-min) (point-max))))
- (switch-to-buffer "*html*")
+ (org-pop-to-buffer-same-window "*html*")
(goto-char (point-min))
(if (re-search-forward "<style" nil t)
(delete-region (point-min) (match-beginning 0)))
@@ -2286,18 +2428,20 @@ Possible conversions are set in `org-export-html-protect-char-alist'."
(defun org-html-expand (string)
"Prepare STRING for HTML export. Apply all active conversions.
-If there are links in the string, don't modify these."
- (let* ((re (concat org-bracket-link-regexp "\\|"
- (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
- m s l res)
- (while (setq m (string-match re string))
- (setq s (substring string 0 m)
- l (match-string 0 string)
- string (substring string (match-end 0)))
- (push (org-html-do-expand s) res)
- (push l res))
- (push (org-html-do-expand string) res)
- (apply 'concat (nreverse res))))
+If there are links in the string, don't modify these. If STRING
+is nil, return nil."
+ (when string
+ (let* ((re (concat org-bracket-link-regexp "\\|"
+ (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
+ m s l res)
+ (while (setq m (string-match re string))
+ (setq s (substring string 0 m)
+ l (match-string 0 string)
+ string (substring string (match-end 0)))
+ (push (org-html-do-expand s) res)
+ (push l res))
+ (push (org-html-do-expand string) res)
+ (apply 'concat (nreverse res)))))
(defun org-html-do-expand (s)
"Apply all active conversions to translate special ASCII to HTML."
@@ -2412,8 +2556,9 @@ When TITLE is nil, just close all open levels."
(mapconcat (lambda (x)
(setq x (org-solidify-link-text
(if (org-uuidgen-p x) (concat "ID-" x) x)))
- (format "<a name=\"%s\" id=\"%s\"></a>"
- x x))
+ (if (stringp org-export-html-headline-anchor-format)
+ (format org-export-html-headline-anchor-format x x)
+ ""))
extra-targets
""))
(while (>= l level)
@@ -2425,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))
@@ -2509,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
@@ -2561,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
@@ -2598,11 +2743,14 @@ 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)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-html.el ends here
diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el
index 8a2d66306f3..a2d2117dcb4 100644
--- a/lisp/org/org-icalendar.el
+++ b/lisp/org/org-icalendar.el
@@ -1,11 +1,10 @@
;;; org-icalendar.el --- iCalendar export for Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -29,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)
@@ -55,6 +53,7 @@ for timed events. If non-zero, alarms are created.
- The alarm will go off N minutes before the event
- only a DISPLAY action is defined."
:group 'org-export-icalendar
+ :version "24.1"
:type 'integer)
(defcustom org-icalendar-combined-name "OrgMode"
@@ -65,6 +64,7 @@ for timed events. If non-zero, alarms are created.
(defcustom org-icalendar-combined-description nil
"Calendar description for the combined iCalendar (all agenda files)."
:group 'org-export-icalendar
+ :version "24.1"
:type 'string)
(defcustom org-icalendar-use-plain-timestamp t
@@ -75,6 +75,7 @@ for timed events. If non-zero, alarms are created.
(defcustom org-icalendar-honor-noexport-tag nil
"Non-nil means don't export entries with a tag in `org-export-exclude-tags'."
:group 'org-export-icalendar
+ :version "24.1"
:type 'boolean)
(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
@@ -192,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)
@@ -204,7 +205,7 @@ When nil of the empty string, use the abbreviation retrieved from Emacs."
(if org-icalendar-use-UTC-date-time
":%Y%m%dT%H%M%SZ"
":%Y%m%dT%H%M%S")
- "Format-string for exporting iCalendar DATE-TIME.
+ "Format-string for exporting icalendar DATE-TIME.
See `format-time-string' for a full documentation. The only
difference is that `org-icalendar-timezone' is used for %Z.
@@ -214,6 +215,7 @@ Interesting value are:
- \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time"
:group 'org-export-icalendar
+ :version "24.1"
:type '(choice
(const :tag "Local time" ":%Y%m%dT%H%M%S")
(const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S")
@@ -254,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)))
@@ -285,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
@@ -312,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
@@ -356,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))
@@ -400,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 ""))
@@ -416,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:-P0D0H%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)
@@ -443,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) "")
@@ -522,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)
@@ -585,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)
@@ -631,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"))
@@ -648,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
@@ -677,12 +677,15 @@ 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))))))
(provide 'org-icalendar)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-icalendar.el ends here
diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el
index c2d5cf0f25b..f870ccc5a52 100644
--- a/lisp/org/org-id.el
+++ b/lisp/org/org-id.el
@@ -1,11 +1,10 @@
;;; org-id.el --- Global identifiers for Org-mode entries
;;
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -74,6 +73,8 @@
(require 'org)
(declare-function message-make-fqdn "message" ())
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
;;; Customization
@@ -82,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
@@ -191,7 +233,6 @@ With optional argument FORCE, force the creation of a new ID."
(org-entry-put (point) "ID" nil))
(org-id-get (point) 'create))
-;;;###autoload
(defun org-id-copy ()
"Copy the ID of the entry at point to the kill ring.
Create an ID if necessary."
@@ -215,10 +256,8 @@ 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)
"Use outline-path-completion to retrieve the ID of an entry.
TARGETS may be a setting for `org-refile-targets' to define the eligible
@@ -235,7 +274,6 @@ It returns the ID of the entry. If necessary, the ID is created."
(prog1 (org-id-get pom 'create)
(move-marker pom nil))))
-;;;###autoload
(defun org-id-get-with-outline-drilling (&optional targets)
"Use an outline-cycling interface to retrieve the ID of an entry.
This only finds entries in the current buffer, using `org-get-location'.
@@ -253,7 +291,7 @@ Move the cursor to that entry in that buffer."
(let ((m (org-id-find id 'marker)))
(unless m
(error "Cannot find entry with ID \"%s\"" id))
- (switch-to-buffer (marker-buffer m))
+ (org-pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
(org-show-context)))
@@ -272,7 +310,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))))
@@ -317,7 +355,7 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
(defun org-id-uuid ()
"Return string with random (version 4) UUID."
(let ((rnd (md5 (format "%s%s%s%s%s%s%s"
- (random t)
+ (random)
(current-time)
(user-uid)
(emacs-pid)
@@ -402,7 +440,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
@@ -426,11 +464,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 (org-mode-p) (buffer-file-name))))
+ (and (derived-mode-p 'org-mode) (buffer-file-name))))
(buffer-list)))
;; All files known to have IDs
org-id-files)))
@@ -440,8 +478,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)
@@ -504,7 +543,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))))
@@ -599,8 +638,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)) (org-mode-p))
- (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)
@@ -639,8 +678,8 @@ optional argument MARKERP, return the position as a new marker."
(provide 'org-id)
-;;; org-id.el ends here
-
-
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+;;; org-id.el ends here
diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el
index a2099a4bde3..c4d74fbb2fa 100644
--- a/lisp/org/org-indent.el
+++ b/lisp/org/org-indent.el
@@ -1,10 +1,9 @@
;;; org-indent.el --- Dynamic indentation for Org-mode
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -28,7 +27,12 @@
;; This is an implementation of dynamic virtual indentation. It works
;; by adding text properties to a buffer to make sure lines are
;; indented according to outline structure.
-
+;;
+;; The process is synchronous, toggled at every buffer modification.
+;; Though, the initialization (indentation of text already in the
+;; buffer), which can take a few seconds in large buffers, happens on
+;; idle time.
+;;
;;; Code:
(require 'org-macs)
@@ -38,9 +42,10 @@
(eval-when-compile
(require 'cl))
-(defvar org-inlinetask-min-level)
(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."
@@ -49,8 +54,11 @@
(defconst org-indent-max 40
"Maximum indentation in characters.")
-(defconst org-indent-max-levels 40
- "Maximum indentation in characters.")
+(defconst org-indent-max-levels 20
+ "Maximum added level through virtual indentation, in characters.
+
+It is computed by multiplying `org-indent-indentation-per-level'
+minus one by actual level of the headline minus one.")
(defvar org-indent-strings nil
"Vector with all indentation strings.
@@ -58,8 +66,31 @@ It will be set in `org-indent-initialize'.")
(defvar org-indent-stars nil
"Vector with all indentation star strings.
It will be set in `org-indent-initialize'.")
+(defvar org-indent-inlinetask-first-star (org-add-props "*" '(face org-warning))
+ "First star of inline tasks, with correct face.")
+(defvar org-indent-agent-timer nil
+ "Timer running the initialize agent.")
+(defvar org-indent-agentized-buffers nil
+ "List of buffers watched by the initialize agent.")
+(defvar org-indent-agent-resume-timer nil
+ "Timer to reschedule agent after switching to other idle processes.")
+(defvar org-indent-agent-active-delay '(0 2 0)
+ "Time to run agent before switching to other idle processes.
+Delay used when the buffer to initialize is current.")
+(defvar org-indent-agent-passive-delay '(0 0 400000)
+ "Time to run agent before switching to other idle processes.
+Delay used when the buffer to initialize isn't current.")
+(defvar org-indent-agent-resume-delay '(0 0 100000)
+ "Minimal time for other idle processes before switching back to agent.")
+(defvar org-indent-initial-marker nil
+ "Position of initialization before interrupt.
+This is used locally in each buffer being initialized.")
(defvar org-hide-leading-stars-before-indent-mode nil
"Used locally.")
+(defvar org-indent-modified-headline-flag nil
+ "Non-nil means the last deletion operated on an headline.
+It is modified by `org-indent-notify-modified-headline'.")
+
(defcustom org-indent-boundary-char ?\ ; comment to protect space char
"The end of the virtual indentation strings, a single-character string.
@@ -90,28 +121,15 @@ turn on `org-hide-leading-stars'."
:group 'org-indent
:type 'integer)
-(defcustom org-indent-fix-section-after-idle-time 0.2
- "Seconds of idle time before fixing virtual indentation of section.
-The hooking-in of virtual indentation is not yet perfect. Occasionally,
-a change does not trigger to proper change of indentation. For this we
-have a timer action that fixes indentation in the current section after
-a short amount idle time. If we ever get the integration to work perfectly,
-this variable can be set to nil to get rid of the timer."
- :group 'org-indent
- :type '(choice
- (const "Do not install idle timer" nil)
- (number :tag "Idle time")))
+(defface org-indent
+ (org-compatible-face nil nil)
+ "Face for outline indentation.
+The default is to make it look like whitespace. But you may find it
+useful to make it ever so slightly different."
+ :group 'org-faces)
(defun org-indent-initialize ()
- "Initialize the indentation strings and set the idle timer."
- ;; We use an idle timer to "repair" the current section, because the
- ;; redisplay seems to have some problems.
- (unless org-indent-strings
- (when org-indent-fix-section-after-idle-time
- (run-with-idle-timer
- org-indent-fix-section-after-idle-time
- t 'org-indent-refresh-section)))
- ;; Initialize the indentation and star vectors
+ "Initialize the indentation strings."
(setq org-indent-strings (make-vector (1+ org-indent-max) nil))
(setq org-indent-stars (make-vector (1+ org-indent-max) nil))
(aset org-indent-strings 0 nil)
@@ -127,89 +145,93 @@ this variable can be set to nil to get rid of the timer."
(org-add-props (make-string i ?*)
nil 'face 'org-hide))))
+(defsubst org-indent-remove-properties (beg end)
+ "Remove indentations between BEG and END."
+ (with-silent-modifications
+ (remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))
+
;;;###autoload
(define-minor-mode org-indent-mode
"When active, indent text according to outline structure.
-Internally this works by adding `line-prefix' properties to all non-headlines.
-These properties are updated locally in idle time.
-FIXME: How to update when broken?"
- nil " Ind" nil
- (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))
- (when org-indent-mode-turns-off-org-adapt-indentation
- (org-set-local 'org-adapt-indentation nil))
- (when org-indent-mode-turns-on-hiding-stars
- (org-set-local 'org-hide-leading-stars-before-indent-mode
- org-hide-leading-stars)
- (org-set-local 'org-hide-leading-stars t))
- (make-local-variable 'buffer-substring-filters)
- (add-to-list 'buffer-substring-filters
- 'org-indent-remove-properties-from-string)
- (org-add-hook 'org-after-demote-entry-hook
- 'org-indent-refresh-section nil 'local)
- (org-add-hook 'org-after-promote-entry-hook
- 'org-indent-refresh-section nil 'local)
- (org-add-hook 'org-font-lock-hook
- 'org-indent-refresh-to nil 'local)
- (and font-lock-mode (org-restart-font-lock))
- )
- (t
- ;; mode was turned off (or we refused to turn it on)
- (save-excursion
- (save-restriction
- (org-indent-remove-properties (point-min) (point-max))
- (kill-local-variable 'org-adapt-indentation)
- (when (boundp 'org-hide-leading-stars-before-indent-mode)
- (org-set-local 'org-hide-leading-stars
- org-hide-leading-stars-before-indent-mode))
- (setq buffer-substring-filters
- (delq 'org-indent-remove-properties-from-string
- buffer-substring-filters))
- (remove-hook 'org-after-promote-entry-hook
- 'org-indent-refresh-section 'local)
- (remove-hook 'org-after-demote-entry-hook
- 'org-indent-refresh-section 'local)
- (and font-lock-mode (org-restart-font-lock))
- (redraw-display))))))
-
+Internally this works by adding `line-prefix' and `wrap-prefix'
+properties, after each buffer modification, on the modified zone.
-(defface org-indent
- (org-compatible-face nil nil)
- "Face for outline indentation.
-The default is to make it look like whitespace. But you may find it
-useful to make it ever so slightly different."
- :group 'org-faces)
+The process is synchronous. Though, initial indentation of
+buffer, which can take a few seconds on large buffers, is done
+during idle time." nil " Ind" nil
+(cond
+ ((org-bound-and-true-p org-inhibit-startup)
+ (setq org-indent-mode nil))
+ ((and org-indent-mode (featurep 'xemacs))
+ (message "org-indent-mode does not work in XEmacs - refusing to turn it on")
+ (setq org-indent-mode nil))
+ ((and org-indent-mode
+ (not (org-version-check "23.1.50" "Org Indent mode" :predicate)))
+ (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!")
+ (ding)
+ (sit-for 1)
+ (setq org-indent-mode nil))
+ (org-indent-mode
+ ;; mode was turned on.
+ (org-set-local 'indent-tabs-mode nil)
+ (or org-indent-strings (org-indent-initialize))
+ (org-set-local 'org-indent-initial-marker (copy-marker 1))
+ (when org-indent-mode-turns-off-org-adapt-indentation
+ (org-set-local 'org-adapt-indentation nil))
+ (when org-indent-mode-turns-on-hiding-stars
+ (org-set-local 'org-hide-leading-stars-before-indent-mode
+ org-hide-leading-stars)
+ (org-set-local 'org-hide-leading-stars t))
+ (make-local-variable 'filter-buffer-substring-functions)
+ (add-hook 'filter-buffer-substring-functions
+ (lambda (fun start end delete)
+ (org-indent-remove-properties-from-string
+ (funcall fun start end delete))))
+ (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
+ (org-add-hook 'before-change-functions
+ 'org-indent-notify-modified-headline nil 'local)
+ (and font-lock-mode (org-restart-font-lock))
+ (org-indent-remove-properties (point-min) (point-max))
+ ;; Submit current buffer to initialize agent. If it's the first
+ ;; buffer submitted, also start the agent. Current buffer is
+ ;; pushed in both cases to avoid a race condition.
+ (if org-indent-agentized-buffers
+ (push (current-buffer) org-indent-agentized-buffers)
+ (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 for the whole buffer."
+ "Add indentation properties to the accessible part of the buffer."
(interactive)
- (when org-indent-mode
- (save-excursion
- (save-restriction
- (widen)
- (org-indent-remove-properties (point-min) (point-max))
- (org-indent-add-properties (point-min) (point-max))))))
-
-(defun org-indent-remove-properties (beg end)
- "Remove indentations between BEG and END."
- (let ((inhibit-modification-hooks t))
- (with-silent-modifications
- (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))))
+ (if (not (derived-mode-p 'org-mode))
+ (error "Not in Org mode")
+ (message "Setting buffer indentation. It may take a few seconds...")
+ (org-indent-remove-properties (point-min) (point-max))
+ (org-indent-add-properties (point-min) (point-max))
+ (message "Indentation of buffer set.")))
(defun org-indent-remove-properties-from-string (string)
"Remove indentation properties from STRING."
@@ -217,110 +239,200 @@ useful to make it ever so slightly different."
'(line-prefix nil wrap-prefix nil) string)
string)
-(defvar org-indent-outline-re org-outline-regexp-bol
- "Outline heading regexp.")
+(defun org-indent-initialize-agent ()
+ "Start or resume current buffer initialization.
+Only buffers in `org-indent-agentized-buffers' trigger an action.
+When no more buffer is being watched, the agent suppress itself."
+ (when org-indent-agent-resume-timer
+ (cancel-timer org-indent-agent-resume-timer))
+ (setq org-indent-agentized-buffers
+ (org-remove-if-not #'buffer-live-p org-indent-agentized-buffers))
+ (cond
+ ;; Job done: kill agent.
+ ((not org-indent-agentized-buffers) (cancel-timer org-indent-agent-timer))
+ ;; Current buffer is agentized: start/resume initialization
+ ;; somewhat aggressively.
+ ((memq (current-buffer) org-indent-agentized-buffers)
+ (org-indent-initialize-buffer (current-buffer)
+ org-indent-agent-active-delay))
+ ;; Else, start/resume initialization of the last agentized buffer,
+ ;; softly.
+ (t (org-indent-initialize-buffer (car org-indent-agentized-buffers)
+ org-indent-agent-passive-delay))))
+
+(defun org-indent-initialize-buffer (buffer delay)
+ "Set virtual indentation for the buffer BUFFER, asynchronously.
+Give hand to other idle processes if it takes longer than DELAY,
+a time value."
+ (with-current-buffer buffer
+ (when org-indent-mode
+ (org-with-wide-buffer
+ (let ((interruptp
+ ;; Always nil unless interrupted.
+ (catch 'interrupt
+ (and org-indent-initial-marker
+ (marker-position org-indent-initial-marker)
+ (org-indent-add-properties org-indent-initial-marker
+ (point-max)
+ delay)
+ nil))))
+ (move-marker org-indent-initial-marker interruptp)
+ ;; Job is complete: un-agentize buffer.
+ (unless interruptp
+ (setq org-indent-agentized-buffers
+ (delq buffer org-indent-agentized-buffers))))))))
+
+(defsubst org-indent-set-line-properties (l w h)
+ "Set prefix properties on current line an move to next one.
-(defun org-indent-add-properties (beg end)
+Prefix properties `line-prefix' and `wrap-prefix' in current line
+are set to, respectively, length L and W.
+
+If H is non-nil, `line-prefix' will be starred. If H is
+`inline', the first star will have `org-warning' face.
+
+Assume point is at beginning of line."
+ (let ((line (cond
+ ((eq 'inline h)
+ (let ((stars (aref org-indent-stars
+ (min l org-indent-max-levels))))
+ (and stars
+ (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
+ (min l org-indent-max)))))
+ (wrap (aref org-indent-strings (min w org-indent-max))))
+ ;; Add properties down to the next line to indent empty lines.
+ (add-text-properties (point) (min (1+ (point-at-eol)) (point-max))
+ `(line-prefix ,line wrap-prefix ,wrap)))
+ (forward-line 1))
+
+(defun org-indent-add-properties (beg end &optional delay)
"Add indentation properties between BEG and END.
-Assumes that BEG is at the beginning of a line."
- (let* ((inhibit-modification-hooks t)
- (inlinetaskp (featurep 'org-inlinetask))
- (get-real-level (lambda (pos lvl)
- (save-excursion
- (goto-char pos)
- (if (and inlinetaskp (org-inlinetask-in-task-p))
- (org-inlinetask-get-task-level)
- lvl))))
- (b beg)
- (e end)
- (level 0)
- (n 0)
- exit nstars)
- (with-silent-modifications
- (save-excursion
- (goto-char beg)
- (while (not exit)
- (setq e end)
- (if (not (re-search-forward org-indent-outline-re nil t))
- (setq e (point-max) exit t)
- (setq e (match-beginning 0))
- (if (>= e end) (setq exit t))
- (unless (and inlinetaskp (org-inlinetask-in-task-p))
- (setq level (- (match-end 0) (match-beginning 0) 1)))
- (setq nstars (* (1- (funcall get-real-level e level))
- (1- org-indent-indentation-per-level)))
- (add-text-properties
- (point-at-bol) (point-at-eol)
- (list 'line-prefix
- (aref org-indent-stars nstars)
- 'wrap-prefix
- (aref org-indent-strings
- (* (funcall get-real-level e level)
- org-indent-indentation-per-level)))))
- (when (> e b)
- (add-text-properties
- b e (list 'line-prefix (aref org-indent-strings n)
- 'wrap-prefix (aref org-indent-strings n))))
- (setq b (1+ (point-at-eol))
- n (* (funcall get-real-level b level)
- org-indent-indentation-per-level)))))))
-
-(defvar org-inlinetask-min-level)
-(defun org-indent-refresh-section ()
- "Refresh indentation properties in the current outline section.
-Point is assumed to be at the beginning of a headline."
- (interactive)
- (when org-indent-mode
- (let (beg end)
- (save-excursion
- (when (ignore-errors (let ((org-outline-regexp (format "\\*\\{1,%s\\}[ \t]+"
- (if (featurep 'org-inlinetask)
- (1- org-inlinetask-min-level)
- ""))))
- (org-back-to-heading)))
- (setq beg (point))
- (setq end (or (save-excursion (or (outline-next-heading) (point)))))
- (org-indent-remove-properties beg end)
- (org-indent-add-properties beg end))))))
-
-(defun org-indent-refresh-to (limit)
- "Refresh indentation properties in the current outline section.
-Point is assumed to be at the beginning of a headline."
- (interactive)
- (when org-indent-mode
- (let ((beg (point)) (end limit))
- (save-excursion
- (and (ignore-errors (let ((org-outline-regexp (format "\\*\\{1,%s\\}[ \t]+"
- (if (featurep 'org-inlinetask)
- (1- org-inlinetask-min-level)
- ""))))
- (org-back-to-heading)))
- (setq beg (point))))
- (org-indent-remove-properties beg end)
- (org-indent-add-properties beg end)))
- (goto-char limit))
-
-(defun org-indent-refresh-subtree ()
- "Refresh indentation properties in the current outline subtree.
-Point is assumed to be at the beginning of a headline."
- (interactive)
+
+When DELAY is non-nil, it must be a time value. In that case,
+the process is asynchronous and can be interrupted, either by
+user request, or after DELAY. This is done by throwing the
+`interrupt' tag along with the buffer position where the process
+stopped."
+ (save-match-data
+ (org-with-wide-buffer
+ (goto-char beg)
+ (beginning-of-line)
+ ;; 1. Initialize prefix at BEG. This is done by storing two
+ ;; variables: INLINE-PF and PF, representing respectively
+ ;; length of current `line-prefix' when line is inside an
+ ;; inline task or not.
+ (let* ((case-fold-search t)
+ (limited-re (org-get-limited-outline-regexp))
+ (added-ind-per-lvl (1- org-indent-indentation-per-level))
+ (pf (save-excursion
+ (and (ignore-errors (let ((outline-regexp limited-re))
+ (org-back-to-heading t)))
+ (+ (* org-indent-indentation-per-level
+ (- (match-end 0) (match-beginning 0) 2)) 2))))
+ (pf-inline (and (featurep 'org-inlinetask)
+ (org-inlinetask-in-task-p)
+ (+ (* org-indent-indentation-per-level
+ (1- (org-inlinetask-get-task-level))) 2)))
+ (time-limit (and delay (time-add (current-time) delay))))
+ ;; 2. For each line, set `line-prefix' and `wrap-prefix'
+ ;; properties depending on the type of line (headline,
+ ;; inline task, item or other).
+ (with-silent-modifications
+ (while (and (<= (point) end) (not (eobp)))
+ (cond
+ ;; When in asynchronous mode, check if interrupt is
+ ;; required.
+ ((and delay (input-pending-p)) (throw 'interrupt (point)))
+ ;; In asynchronous mode, take a break of
+ ;; `org-indent-agent-resume-delay' every DELAY to avoid
+ ;; blocking any other idle timer or process output.
+ ((and delay (time-less-p time-limit (current-time)))
+ (setq org-indent-agent-resume-timer
+ (run-with-idle-timer
+ (time-add (current-idle-time)
+ org-indent-agent-resume-delay)
+ nil #'org-indent-initialize-agent))
+ (throw 'interrupt (point)))
+ ;; Headline or inline task.
+ ((looking-at org-outline-regexp)
+ (let* ((nstars (- (match-end 0) (match-beginning 0) 1))
+ (line (* added-ind-per-lvl (1- nstars)))
+ (wrap (+ line (1+ nstars))))
+ (cond
+ ;; Headline: new value for PF.
+ ((looking-at limited-re)
+ (org-indent-set-line-properties line wrap t)
+ (setq pf wrap))
+ ;; End of inline task: PF-INLINE is now nil.
+ ((looking-at "\\*+ end[ \t]*$")
+ (org-indent-set-line-properties line wrap 'inline)
+ (setq pf-inline nil))
+ ;; Start of inline task. Determine if it contains
+ ;; text, or if it is only one line long. Set
+ ;; PF-INLINE accordingly.
+ (t (org-indent-set-line-properties line wrap 'inline)
+ (setq pf-inline (and (org-inlinetask-in-task-p) wrap))))))
+ ;; List item: `wrap-prefix' is set where body starts.
+ ((org-at-item-p)
+ (let* ((line (or pf-inline pf 0))
+ (wrap (+ (org-list-item-body-column (point)) line)))
+ (org-indent-set-line-properties line wrap nil)))
+ ;; Normal line: use PF-INLINE, PF or nil as prefixes.
+ (t (let* ((line (or pf-inline pf 0))
+ (wrap (+ line (org-get-indentation))))
+ (org-indent-set-line-properties line wrap nil))))))))))
+
+(defun org-indent-notify-modified-headline (beg end)
+ "Set `org-indent-modified-headline-flag' depending on context.
+
+BEG and END are the positions of the beginning and end of the
+range of deleted text.
+
+This function is meant to be called by `before-change-functions'.
+Flag will be non-nil if command is going to modify or delete an
+headline."
(when org-indent-mode
- (save-excursion
- (let (beg end)
- (setq beg (point))
- (setq end (save-excursion (org-end-of-subtree t t)))
- (org-indent-remove-properties beg end)
- (org-indent-add-properties beg end)))))
+ (setq org-indent-modified-headline-flag
+ (save-excursion
+ (goto-char beg)
+ (save-match-data
+ (or (and (org-at-heading-p) (< beg (match-end 0)))
+ (re-search-forward org-outline-regexp-bol end t)))))))
-(defun org-indent-refresh-buffer ()
- "Refresh indentation properties in the current outline subtree.
-Point is assumed to be at the beginning of a headline."
- (interactive)
+(defun org-indent-refresh-maybe (beg end dummy)
+ "Refresh indentation properties in an adequate portion of buffer.
+BEG and END are the positions of the beginning and end of the
+range of inserted text. DUMMY is an unused argument.
+
+This function is meant to be called by `after-change-functions'."
(when org-indent-mode
- (org-indent-mode -1)
- (org-indent-mode 1)))
+ (save-match-data
+ ;; If an headline was modified or inserted, set properties until
+ ;; next headline.
+ (if (or org-indent-modified-headline-flag
+ (save-excursion
+ (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))
+ ;; Otherwise, only set properties on modified area.
+ (org-indent-add-properties beg end)))))
(provide 'org-indent)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-indent.el ends here
diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el
index 4f44045f9bf..31981ae1b29 100644
--- a/lisp/org/org-info.el
+++ b/lisp/org/org-info.el
@@ -1,11 +1,10 @@
;;; org-info.el --- Support for links to Info nodes from within Org-Mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -49,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
@@ -77,6 +76,4 @@
(provide 'org-info)
-
-
;;; org-info.el ends here
diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el
index 72c19062983..01f861e611a 100644
--- a/lisp/org/org-inlinetask.el
+++ b/lisp/org/org-inlinetask.el
@@ -1,11 +1,10 @@
;;; org-inlinetask.el --- Tasks independent of outline hierarchy
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -91,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
@@ -100,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."
@@ -107,11 +115,14 @@ When nil, they will not be exported."
:type 'boolean)
(defvar org-inlinetask-export-templates
- '((html "<pre class=\"inlinetask\"><b>%s%s</b><br />%s</pre>"
+ '((html "<div class=\"inlinetask\"><b>%s%s</b><br />%s</div>"
'((unless (eq todo "")
(format "<span class=\"%s %s\">%s%s</span> "
class todo todo priority))
heading content))
+ (odt "%s" '((org-odt-format-inlinetask heading content
+ todo priority tags)))
+
(latex "\\begin\{description\}\n\\item[%s%s]~%s\\end\{description\}"
'((unless (eq todo "") (format "\\textsc\{%s%s\} " todo priority))
heading content))
@@ -132,9 +143,9 @@ When nil, they will not be exported."
heading content)))
"Templates for inline tasks in various exporters.
-This variable is an alist in the shape of (BACKEND STRING OBJECTS).
+This variable is an alist in the shape of \(BACKEND STRING OBJECTS\).
-BACKEND is the name of the backend for the template (ascii, html...).
+BACKEND is the name of the backend for the template \(ascii, html...\).
STRING is a format control string.
@@ -151,14 +162,14 @@ defined in an inline task, their value is the empty string.
As an example, valid associations are:
-(html \"<ul><li>%s <p>%s</p></li></ul>\" (heading content))
+\(html \"<ul><li>%s <p>%s</p></li></ul>\" \(heading content\)\)
or, with the additional package \"todonotes\" for LaTeX,
-(latex \"\\todo[inline]{\\textbf{\\textsf{%s %s}}\\linebreak{} %s}\"
- '((unless (eq todo \"\")
- (format \"\\textsc{%s%s}\" todo priority))
- heading content)))")
+\(latex \"\\todo[inline]{\\textbf{\\textsf{%s %s}}\\linebreak{} %s}\"
+ '\(\(unless \(eq todo \"\"\)
+ \(format \"\\textsc{%s%s}\" todo priority\)\)
+ heading content\)\)\)")
(defvar org-odd-levels-only)
(defvar org-keyword-time-regexp)
@@ -171,6 +182,7 @@ or, with the additional package \"todonotes\" for LaTeX,
This should be the state `org-inlinetask-insert-task' should use by
default, or nil of no state should be assigned."
:group 'org-inlinetask
+ :version "24.1"
:type '(choice
(const :tag "No state" nil)
(string :tag "Specific state")))
@@ -179,15 +191,22 @@ default, or nil of no state should be assigned."
"Insert an inline task.
If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'."
(interactive "P")
+ ;; Error when inside an inline task, except if point was at its very
+ ;; beginning, in which case the new inline task will be inserted
+ ;; before this one.
+ (when (and (org-inlinetask-in-task-p)
+ (not (and (org-inlinetask-at-task-p) (bolp))))
+ (error "Cannot nest inline tasks"))
(or (bolp) (newline))
- (let ((indent org-inlinetask-min-level))
- (if org-odd-levels-only
- (setq indent (- (* 2 indent) 1)))
- (insert (make-string indent ?*)
- (if (or no-state (not org-inlinetask-default-state))
- " \n"
- (concat " " org-inlinetask-default-state " \n"))
- (make-string indent ?*) " END\n"))
+ (let* ((indent (if org-odd-levels-only
+ (1- (* 2 org-inlinetask-min-level))
+ org-inlinetask-min-level))
+ (indent-string (concat (make-string indent ?*) " ")))
+ (insert indent-string
+ (if (or no-state (not org-inlinetask-default-state))
+ "\n"
+ (concat org-inlinetask-default-state " \n"))
+ indent-string "END\n"))
(end-of-line -1))
(define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task)
@@ -228,21 +247,26 @@ The number of levels is controlled by `org-inlinetask-min-level'."
(re-search-backward inlinetask-re nil t))))
(defun org-inlinetask-goto-end ()
- "Go to the end of the inline task at point."
- (beginning-of-line)
- (let ((case-fold-search t)
- (inlinetask-re (org-inlinetask-outline-regexp)))
- (cond
- ((org-looking-at-p (concat inlinetask-re "END[ \t]*$"))
- (forward-line 1))
- ((org-looking-at-p inlinetask-re)
- (forward-line 1)
- (when (org-inlinetask-in-task-p)
- (re-search-forward inlinetask-re nil t)
- (forward-line 1)))
- (t
- (re-search-forward inlinetask-re nil t)
- (forward-line 1)))))
+ "Go to the end of the inline task at point.
+Return point."
+ (save-match-data
+ (beginning-of-line)
+ (let* ((case-fold-search t)
+ (inlinetask-re (org-inlinetask-outline-regexp))
+ (task-end-re (concat inlinetask-re "END[ \t]*$")))
+ (cond
+ ((looking-at task-end-re) (forward-line))
+ ((looking-at inlinetask-re)
+ (forward-line)
+ (cond
+ ((looking-at task-end-re) (forward-line))
+ ((looking-at inlinetask-re))
+ ((org-inlinetask-in-task-p)
+ (re-search-forward inlinetask-re nil t)
+ (forward-line))))
+ (t (re-search-forward inlinetask-re nil t)
+ (forward-line)))
+ (point))))
(defun org-inlinetask-get-task-level ()
"Get the level of the inline task around.
@@ -314,66 +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 org-inlinetask-export
- ;; 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" (org-remove-indentation content) "\n")
- '(org-protected 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)))
- (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))))
- (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."
@@ -386,21 +419,37 @@ Either remove headline and meta data, or do special formatting."
(goto-char (match-end 0))
(current-column)))
+(defvar org-indent-indentation-per-level) ; defined in org-indent.el
+
+(defface org-inlinetask
+ (org-compatible-face 'shadow '((t (:bold t))))
+ "Face for inlinetask headlines."
+ :group 'org-faces)
+
(defun org-inlinetask-fontify (limit)
- "Fontify the inline tasks."
+ "Fontify the inline tasks down to LIMIT."
(let* ((nstars (if org-odd-levels-only
(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.
+ (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 org-warning 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 shadow font-lock-fontified t)))))
+ '(face org-inlinetask font-lock-fontified t)))))
(defun org-inlinetask-toggle-visibility ()
"Toggle visibility of inline task at point."
@@ -415,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-install.el b/lisp/org/org-install.el
index eb2d011efb9..a31d8b79209 100644
--- a/lisp/org/org-install.el
+++ b/lisp/org/org-install.el
@@ -1,37 +1,13 @@
-;;; org-install.el --- Outline-based notes management and organizer
-;; Carstens outline-mode for keeping track of everything.
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;;; org-install.el --- autogenerated file, do not edit
;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
-;; Version: 6.06b
-;;
-;; 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:
-;;
-;; When Org-mode is distributed with Emacs, this is just a dummy file.
-;; In an Org-mode distribution outside Emacs, this file would provide
-;; the autoloads. We include this dummy version in Emacs, so that people
-;; can leave a (require 'org-install) in .emacs, independently of
-;; which kind of distribution they use.
-;;
-
+;;; Code:
+(warn "The file org-install is obsolete.
+Please change your configuration to (require 'org) instead.")
+
(provide 'org-install)
-
+
+;; Local Variables:
+;; no-byte-compile: t
+;; coding: utf-8
+;; End:
;;; org-install.el ends here
diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el
index 7a84d2053ad..d31b1828ddd 100644
--- a/lisp/org/org-irc.el
+++ b/lisp/org/org-irc.el
@@ -1,10 +1,9 @@
;;; org-irc.el --- Store links to IRC sessions
;;
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;;
;; Author: Philip Jackson <emacs@shellarchive.co.uk>
;; Keywords: erc, irc, link, org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -60,6 +59,8 @@
(declare-function erc-server-buffer "erc" ())
(declare-function erc-get-server-nickname-list "erc" ())
(declare-function erc-cmd-JOIN "erc" (channel &optional key))
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
(defvar org-irc-client 'erc
"The IRC client to act on.")
@@ -80,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.
@@ -101,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.
@@ -139,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.
@@ -163,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))
@@ -191,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."
@@ -232,7 +233,7 @@ default."
(throw 'found x))))))
(if chan-buf
(progn
- (switch-to-buffer chan-buf)
+ (org-pop-to-buffer-same-window chan-buf)
;; if we got a nick, and they're in the chan,
;; then start a chat with them
(let ((nick (pop link)))
@@ -241,16 +242,18 @@ default."
(progn
(goto-char (point-max))
(insert (concat nick ": ")))
- (error "%s not found in %s" nick chan-name)))))
- (progn
- (switch-to-buffer server-buffer)
- (erc-cmd-JOIN chan-name))))
- (switch-to-buffer 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)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-irc.el ends here
diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el
index 3ef8c4c809c..35d43dec8da 100644
--- a/lisp/org/org-jsinfo.el
+++ b/lisp/org/org-jsinfo.el
@@ -1,11 +1,10 @@
;;; org-jsinfo.el --- Support for org-info.js Javascript in Org HTML export
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -100,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
@@ -128,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"
@@ -204,6 +259,4 @@ Option settings will replace the %MANAGER-OPTIONS cookie."
(provide 'org-infojs)
(provide 'org-jsinfo)
-
-
;;; org-jsinfo.el ends here
diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el
index 7abf85a7092..9ce84f14e92 100644
--- a/lisp/org/org-latex.el
+++ b/lisp/org/org-latex.el
@@ -1,11 +1,10 @@
;;; org-latex.el --- LaTeX exporter for org-mode
;;
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;;
;; Emacs Lisp Archive Entry
;; Filename: org-latex.el
-;; Version: 7.7
-;; Author: Bastien Guerry <bzg AT altern DOT org>
+;; Author: Bastien Guerry <bzg AT gnu DOT org>
;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Keywords: org, wp, tex
;; Description: Converts an org-mode buffer into LaTeX
@@ -74,7 +73,6 @@
org-deadline-string "\\|"
org-closed-string"\\)")
"Regexp matching special time planning keywords plus the time after it.")
-
(defvar org-re-quote) ; dynamically scoped from org.el
(defvar org-commentsp) ; dynamically scoped from org.el
@@ -220,6 +218,7 @@ For example, adding an entry
will cause \\usepackage[utf8x]{inputenc} to be used for buffers that
are written as utf8 files."
:group 'org-export-latex
+ :version "24.1"
:type '(repeat
(cons
(string :tag "Derived from buffer")
@@ -236,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.
@@ -248,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)
@@ -285,6 +284,7 @@ markup defined, the first one in the association list will be used."
(defcustom org-export-latex-tag-markup "\\textbf{%s}"
"Markup for tags, as a printf format."
:group 'org-export-latex
+ :version "24.1"
:type 'string)
(defcustom org-export-latex-timestamp-markup "\\textit{%s}"
@@ -295,6 +295,7 @@ markup defined, the first one in the association list will be used."
(defcustom org-export-latex-timestamp-inactive-markup "\\textit{%s}"
"A printf format string to be applied to inactive time stamps."
:group 'org-export-latex
+ :version "24.1"
:type 'string)
(defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}"
@@ -309,6 +310,7 @@ If it contains two %s instances, the first will be filled with
the link, the second with the link description. If it contains
only one, the %s will be filled with the link."
:group 'org-export-latex
+ :version "24.1"
:type 'string)
(defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}"
@@ -316,11 +318,25 @@ only one, the %s will be filled with the link."
The format must contain one or two %s instances. The first one
will be filled with the link, the second with its description."
:group 'org-export-latex
+ :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
+ :version "24.1"
:type 'string)
(defcustom org-export-latex-quotes
@@ -338,6 +354,7 @@ For each item in a CONS, the first string is a regexp
for allowed characters before/after the quote, the second
string defines the replacement string for this quote."
:group 'org-export-latex
+ :version "24.1"
:type '(list
(cons :tag "Opening quote"
(string :tag "Regexp for char before")
@@ -359,12 +376,46 @@ string defines the replacement string for this quote."
:group 'org-export-latex
:type 'boolean)
+(defcustom org-export-latex-table-caption-above t
+ "When non-nil, the caption is set above the table. When nil,
+the caption is set below the table."
+ :group 'org-export-latex
+ :version "24.1"
+ :type 'boolean)
+
(defcustom org-export-latex-tables-column-borders nil
"When non-nil, grouping columns can cause outer vertical lines in tables.
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
@@ -402,7 +453,7 @@ will pass them (combined with the LaTeX default list parameters) to
:type 'plist)
(defcustom org-export-latex-verbatim-wrap
- '("\\begin{verbatim}\n" . "\\end{verbatim}\n")
+ '("\\begin{verbatim}\n" . "\\end{verbatim}")
"Environment to be wrapped around a fixed-width section in LaTeX export.
This is a cons with two strings, to be added before and after the
fixed-with text.
@@ -474,6 +525,7 @@ Code blocks exported with the listings package (controlled by the
`org-export-latex-listings' variable) can be named in the style
of noweb."
:group 'org-export-latex
+ :version "24.1"
:type 'boolean)
(defcustom org-export-latex-minted-langs
@@ -495,6 +547,7 @@ with:
pygmentize -L lexers
"
:group 'org-export-latex
+ :version "24.1"
:type '(repeat
(list
(symbol :tag "Major mode ")
@@ -504,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\")
@@ -518,6 +571,7 @@ black keywords.
Note that the same options will be applied to blocks of all
languages."
:group 'org-export-latex
+ :version "24.1"
:type '(repeat
(list
(string :tag "Listings option name ")
@@ -527,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\")))
@@ -538,9 +592,10 @@ 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"
:type '(repeat
(list
(string :tag "Minted option name ")
@@ -549,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\")))
@@ -582,11 +637,19 @@ and `org-export-with-tags' instead."
(defcustom org-latex-default-figure-position "htb"
"Default position for latex figures."
:group 'org-export-latex
+ :version "24.1"
:type 'string)
(defcustom org-export-latex-tabular-environment "tabular"
"Default environment used to build tables."
:group 'org-export-latex
+ :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
@@ -594,7 +657,7 @@ and `org-export-with-tags' instead."
"Extensions of image files that can be inlined into LaTeX.
Note that the image extension *actually* allowed depend on the way the
LaTeX file is processed. When used with pdflatex, pdf, jpg and png images
-are OK. When processing through dvi to PostScript, only ps and eps are
+are OK. When processing through dvi to Postscript, only ps and eps are
allowed. The default we use here encompasses both."
:group 'org-export-latex
:type '(repeat (string :tag "Extension")))
@@ -614,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
@@ -643,16 +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"))
+ (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"))
+ (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"))
(const :tag "texi2dvi"
("texi2dvi -p -b -c -V %f"))
(const :tag "rubber"
@@ -663,6 +751,7 @@ This function should accept the file name as its single argument."
'("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb")
"The list of file extensions to consider as LaTeX logfiles."
:group 'org-export-pdf
+ :version "24.1"
:type '(repeat (string :tag "Extension")))
(defcustom org-export-pdf-remove-logfiles t
@@ -698,14 +787,14 @@ emacs --batch
--load=$HOME/lib/emacs/org.el
--eval \"(setq org-export-headline-levels 2)\"
--visit=MyFile --funcall org-export-as-latex-batch"
- (org-export-as-latex org-export-headline-levels 'hidden))
+ (org-export-as-latex org-export-headline-levels))
;;;###autoload
(defun org-export-as-latex-to-buffer (arg)
"Call `org-export-as-latex` with output to a temporary buffer.
No file is created. The prefix ARG is passed through to `org-export-as-latex'."
(interactive "P")
- (org-export-as-latex arg nil nil "*Org LaTeX Export*")
+ (org-export-as-latex arg nil "*Org LaTeX Export*")
(when org-export-show-temporary-export-buffer
(switch-to-buffer-other-window "*Org LaTeX Export*")))
@@ -719,7 +808,7 @@ then use this command to convert it."
(interactive "r")
(let (reg latex buf)
(save-window-excursion
- (if (org-mode-p)
+ (if (derived-mode-p 'org-mode)
(setq latex (org-export-region-as-latex
beg end t 'string))
(setq reg (buffer-substring beg end)
@@ -759,7 +848,7 @@ in a window. A non-interactive call will only return the buffer."
(set-mark (point)) ;; to activate the region
(goto-char beg)
(setq rtn (org-export-as-latex
- nil nil ext-plist
+ nil ext-plist
buffer body-only))
(if (fboundp 'deactivate-mark) (deactivate-mark))
(if (and (org-called-interactively-p 'any) (bufferp rtn))
@@ -767,21 +856,19 @@ in a window. A non-interactive call will only return the buffer."
rtn)))
;;;###autoload
-(defun org-export-as-latex (arg &optional hidden ext-plist
- to-buffer body-only pub-dir)
+(defun org-export-as-latex (arg &optional ext-plist to-buffer body-only pub-dir)
"Export current buffer to a LaTeX file.
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 be exported
depending on `org-export-latex-low-levels'. The default is to
convert them as description lists.
-HIDDEN is obsolete and does nothing.
-EXT-PLIST is a property list with
-external parameters overriding org-mode's default settings, but
-still inferior to file-local settings. When TO-BUFFER is
-non-nil, create a buffer with that name and export to that
-buffer. If TO-BUFFER is the symbol `string', don't leave any
-buffer behind but just return the resulting LaTeX as a string.
+EXT-PLIST is a property list with external parameters overriding
+org-mode's default settings, but still inferior to file-local settings.
+When TO-BUFFER is non-nil, create a buffer with that name and export
+to that buffer. If TO-BUFFER is the symbol `string', don't leave any
+buffer behind and just return the resulting LaTeX as a string, with
+no LaTeX header.
When BODY-ONLY is set, don't produce the file header and footer,
simply return the content of \\begin{document}...\\end{document},
without even the \\begin{document} and \\end{document} commands.
@@ -851,7 +938,7 @@ when PUB-DIR is set, use this as the publishing directory."
(concat
(file-name-as-directory
(or pub-dir
- (org-export-directory :LaTeX ext-plist)))
+ (org-export-directory :LaTeX org-export-latex-options-plist)))
(file-name-sans-extension
(or (and subtree-p
(org-entry-get rbeg "EXPORT_FILE_NAME" t))
@@ -865,11 +952,12 @@ when PUB-DIR is set, use this as the publishing directory."
(file-truename (or buffer-file-name "dummy.org")))
(concat filename ".tex")
filename)))
+ (auto-insert nil); Avoid any auto-insert stuff for the new file
+ (TeX-master (boundp 'TeX-master))
(buffer (if to-buffer
- (cond
- ((eq to-buffer 'string) (get-buffer-create
- "*Org LaTeX Export*"))
- (t (get-buffer-create to-buffer)))
+ (if (eq to-buffer 'string)
+ (get-buffer-create "*Org LaTeX Export*")
+ (get-buffer-create to-buffer))
(find-file-noselect filename)))
(odd org-odd-levels-only)
(header (org-export-latex-make-header title opt-plist))
@@ -952,7 +1040,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))
@@ -1001,6 +1089,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))
@@ -1024,8 +1117,7 @@ when PUB-DIR is set, use this as the publishing directory."
(interactive "P")
(message "Exporting to PDF...")
(let* ((wconfig (current-window-configuration))
- (lbuf (org-export-as-latex arg hidden ext-plist
- to-buffer body-only pub-dir))
+ (lbuf (org-export-as-latex arg ext-plist to-buffer body-only pub-dir))
(file (buffer-file-name lbuf))
(base (file-name-sans-extension (buffer-file-name lbuf)))
(pdffile (concat base ".pdf"))
@@ -1051,22 +1143,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))
@@ -1218,7 +1312,7 @@ numbered sections and lower levels as unnumbered sections."
org-export-target-aliases))))
(sectioning org-export-latex-sectioning)
(depth org-export-latex-sectioning-depth)
- main-heading sub-heading)
+ main-heading sub-heading ctnt)
(when (symbolp (car sectioning))
(setq sectioning (funcall (car sectioning) level heading))
(when sectioning
@@ -1285,16 +1379,20 @@ numbered sections and lower levels as unnumbered sections."
(delete-region (point-at-bol 0) (point))
(insert (format "\\begin{%s}\n"
(symbol-name org-export-latex-low-levels))))
- (insert (format "\n\\item %s\\\\\n%s%%"
- heading
- (if label (format "\\label{%s}" label) "")))
- (insert (org-export-latex-content content))
+ (let ((ctnt (org-export-latex-content content)))
+ (insert (format (if (not (equal (replace-regexp-in-string "\n" "" ctnt) ""))
+ "\n\\item %s\\\\\n%s%%"
+ "\n\\item %s\n%s%%")
+ heading
+ (if label (format "\\label{%s}" label) "")))
+ (insert ctnt))
(cond ((stringp subcontent) (insert subcontent))
((listp subcontent) (org-export-latex-sub subcontent)))
(insert (format "\\end{%s} %% ends low level\n"
(symbol-name org-export-latex-low-levels))))
- ((listp org-export-latex-low-levels)
+ ((and (listp org-export-latex-low-levels)
+ org-export-latex-low-levels)
(if (string-match "% ends low level$"
(buffer-substring (point-at-bol 0) (point)))
(delete-region (point-at-bol 0) (point))
@@ -1340,7 +1438,7 @@ LEVEL indicates the default depth for export."
(save-restriction
(widen)
(goto-char (point-min))
- (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\(-[a-zA-Z]+\\)" nil t)
+ (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([-/a-zA-Z]+\\)" nil t)
(match-string 1))))
(plist-get org-export-latex-options-plist :latex-class)
org-export-latex-default-class)
@@ -1395,7 +1493,11 @@ OPT-PLIST is the options plist for current buffer."
(email (replace-regexp-in-string
"_" "\\\\_"
(org-export-apply-macros-in-string
- (plist-get opt-plist :email)))))
+ (plist-get opt-plist :email))))
+ (description (org-export-apply-macros-in-string
+ (plist-get opt-plist :description)))
+ (keywords (org-export-apply-macros-in-string
+ (plist-get opt-plist :keywords))))
(concat
(if (plist-get opt-plist :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
@@ -1429,6 +1531,11 @@ OPT-PLIST is the options plist for current buffer."
(format-time-string
(or (plist-get opt-plist :date)
org-export-latex-date-format)))
+ ;; add some hyperref options
+ (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
@@ -1522,7 +1629,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)
@@ -1644,13 +1751,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."
@@ -1676,8 +1783,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
@@ -1705,7 +1811,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
@@ -1830,19 +1936,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\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
@@ -1868,7 +1974,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
@@ -1886,10 +1992,14 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
'org-label raw-table)
longtblp (and attr (stringp attr)
(string-match "\\<longtable\\>" attr))
- tblenv (if (and attr (stringp attr)
- (or (string-match (regexp-quote "table*") attr)
- (string-match "\\<multicolumn\\>" attr)))
- "table*" "table")
+ tblenv (if (and attr (stringp attr))
+ (cond ((string-match "\\<sidewaystable\\>" attr)
+ "sidewaystable")
+ ((or (string-match (regexp-quote "table*") attr)
+ (string-match "\\<multicolumn\\>" attr))
+ "table*")
+ (t "table"))
+ "table")
tabular-env
(if (and attr (stringp attr)
(string-match "\\(tabular.\\)" attr))
@@ -1901,6 +2011,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)
@@ -1916,7 +2029,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)
@@ -1966,13 +2079,14 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(concat "\\begin{longtable}{" align "}\n")
(if floatp
(format "\\begin{%s}%s\n" tblenv placement)))
- (if floatp
+ (if (and floatp org-export-latex-table-caption-above)
(format
"\\caption%s{%s} %s"
(if shortn (concat "[" shortn "]") "")
(or caption "")
(if label (format "\\label{%s}" label) "")))
- (if (and longtblp caption) "\\\\\n" "\n")
+ (if (and longtblp caption org-export-latex-table-caption-above)
+ "\\\\\n" "\n")
(if (and org-export-latex-tables-centered (not longtblp))
"\\begin{center}\n")
(if (not longtblp)
@@ -1982,18 +2096,31 @@ 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
"\n\\end{center}\n" "\n"))
+ (if (and floatp (not org-export-latex-table-caption-above))
+ (format
+ "\\caption%s{%s} %s"
+ (if shortn (concat "[" shortn "]") "")
+ (or caption "")
+ (if label (format "\\label{%s}" label) "")))
(if longtblp
"\\end{longtable}"
(if floatp (format "\\end{%s}" tblenv)))))
@@ -2043,11 +2170,12 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(setq tbl (concat "\\begin{center}\n" tbl "\\end{center}")))
(when floatp
(setq tbl (concat "\\begin{table}\n"
+ (if (not org-export-latex-table-caption-above) tbl)
(format "\\caption%s{%s%s}\n"
(if shortn (format "[%s]" shortn) "")
(if label (format "\\label{%s}" label) "")
(or caption ""))
- tbl
+ (if org-export-latex-table-caption-above tbl)
"\n\\end{table}\n")))
(insert (org-export-latex-protect-string tbl))))
@@ -2213,8 +2341,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)
@@ -2323,7 +2451,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))
@@ -2338,7 +2466,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(let ((next (org-footnote-get-next-reference)))
(and next (= (nth 1 next) (nth 2 ref)))))
org-export-latex-footnote-separator ""))))
- (when (org-on-heading-p)
+ (when (org-at-heading-p)
(setq fnote (concat (org-export-latex-protect-string "\\protect")
fnote)))
;; Ensure a footnote at column 0 cannot end a list
@@ -2548,10 +2676,8 @@ 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.
- (let ((org-list-ending-method
- (if (eq org-list-ending-method 'regexp) 'regexp 'both))
- (org-list-end-re "^ORG-LIST-END-MARKER\n"))
+ ;; org-exp.el. Make sure it is taken into account.
+ (let ((org-list-end-re "^ORG-LIST-END-MARKER\n"))
(mapc
(lambda (e)
;; For each type of context allowed for list export (E), find
@@ -2581,181 +2707,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)
@@ -2769,6 +2895,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(provide 'org-export-latex)
(provide 'org-latex)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-latex.el ends here
diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el
index 72fc71854e2..10f5e6ec6a9 100644
--- a/lisp/org/org-list.el
+++ b/lisp/org/org-list.el
@@ -1,12 +1,11 @@
;;; org-list.el --- Plain lists for Org-mode
;;
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Bastien Guerry <bzg AT altern DOT org>
+;; Bastien Guerry <bzg AT gnu DOT org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -28,30 +27,31 @@
;; This file contains the code dealing with plain lists in Org-mode.
-;; The fundamental idea behind lists work is to use structures.
-;; A structure is a snapshot of the list, in the shape of data tree
-;; (see `org-list-struct').
+;; The core concept behind lists is their structure. A structure is
+;; a snapshot of the list, in the shape of a data tree (see
+;; `org-list-struct').
;; Once the list structure is stored, it is possible to make changes
-;; directly on it or get useful information about the list, with the
-;; two helper functions, namely `org-list-parents-alist' and
-;; `org-list-prevs-alist', and using accessors or methods.
+;; on it that will be mirrored to the real list or to get information
+;; about the list, using accessors and methods provided in the
+;; library. Most of them require the use of one or two helper
+;; functions, namely `org-list-parents-alist' and
+;; `org-list-prevs-alist'.
;; Structure is eventually applied to the buffer with
;; `org-list-write-struct'. This function repairs (bullets,
-;; indentation, checkboxes) the structure before applying it. It
-;; should be called near the end of any function working on
-;; structures.
+;; indentation, checkboxes) the list in the process. It should be
+;; called near the end of any function working on structures.
;; Thus, a function applying to lists should usually follow this
;; template:
;; 1. Verify point is in a list and grab item beginning (with the same
;; function `org-in-item-p'). If the function requires the cursor
-;; to be at item's bullet, `org-at-item-p' is more selective. If
-;; the cursor is amidst the buffer, it is possible to find the
-;; closest item with `org-list-search-backward', or
-;; `org-list-search-forward', applied to `org-item-beginning-re'.
+;; to be at item's bullet, `org-at-item-p' is more selective. It
+;; is also possible to move point to the closest item with
+;; `org-list-search-backward', or `org-list-search-forward',
+;; applied to the function `org-item-beginning-re'.
;; 2. Get list structure with `org-list-struct'.
@@ -62,12 +62,13 @@
;; 4. Proceed with the modifications, using methods and accessors.
;; 5. Verify and apply structure to buffer, using
-;; `org-list-write-struct'. Possibly use
-;; `org-update-checkbox-count-maybe' if checkboxes might have been
-;; modified.
+;; `org-list-write-struct'.
-;; Computing a list structure can be a costly operation on huge lists
-;; (a few thousand lines long). Thus, code should follow the rule :
+;; 6. If changes made to the list might have modified check-boxes,
+;; call `org-update-checkbox-count-maybe'.
+
+;; Computing a structure can be a costly operation on huge lists (a
+;; few thousand lines long). Thus, code should follow the rule:
;; "collect once, use many". As a corollary, it is usually a bad idea
;; to use directly an interactive function inside the code, as those,
;; being independent entities, read the whole list structure another
@@ -95,7 +96,6 @@
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-before-first-heading-p "org" ())
-(declare-function org-back-over-empty-lines "org" ())
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-combine-plists "org" (&rest plists))
(declare-function org-count "org" (cl-item cl-seq))
@@ -113,7 +113,7 @@
(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-level-increment "org" ())
(declare-function org-narrow-to-subtree "org" ())
-(declare-function org-on-heading-p "org" (&optional invisible-ok))
+(declare-function org-at-heading-p "org" (&optional invisible-ok))
(declare-function org-previous-line-empty-p "org" ())
(declare-function org-remove-if "org" (predicate seq))
(declare-function org-reduced-level "org" (L))
@@ -128,6 +128,8 @@
(declare-function outline-next-heading "outline" ())
(declare-function outline-previous-heading "outline" ())
+
+
;;; Configuration variables
(defgroup org-plain-lists nil
@@ -205,7 +207,7 @@ Valid values are ?. and ?\). To get both terminators, use t."
:group 'org-plain-lists
:type '(choice (const :tag "dot like in \"2.\"" ?.)
(const :tag "paren like in \"2)\"" ?\))
- (const :tab "both" t)))
+ (const :tag "both" t)))
(defcustom org-alphabetical-lists nil
"Non-nil means single character alphabetical bullets are allowed.
@@ -213,6 +215,7 @@ Both uppercase and lowercase are handled. Lists with more than
26 items will fallback to standard numbering. Alphabetical
counters like \"[@c]\" will be recognized."
:group 'org-plain-lists
+ :version "24.1"
:type 'boolean)
(defcustom org-list-two-spaces-after-bullet-regexp nil
@@ -227,73 +230,37 @@ spaces instead of one after the bullet in each item of the list."
(const :tag "never" nil)
(regexp)))
-(defcustom org-list-ending-method 'both
- "Determine where plain lists should end.
-Valid values are: `regexp', `indent' or `both'.
-
-When set to `regexp', Org will look into two variables,
-`org-empty-line-terminates-plain-lists' and the more general
-`org-list-end-regexp', to determine what will end lists.
-
-When set to `indent', a list will end whenever a line following
-an item, but not starting one, is less or equally indented than
-the first item of the list.
-
-When set to `both', each of the preceding methods is applied to
-determine lists endings. This is the default method."
- :group 'org-plain-lists
- :type '(choice
- (const :tag "With a regexp defining ending" regexp)
- (const :tag "With indentation of regular (no bullet) text" indent)
- (const :tag "With both methods" both)))
-
(defcustom org-empty-line-terminates-plain-lists nil
"Non-nil means an empty line ends all plain list levels.
-This variable only makes sense if `org-list-ending-method' is set
-to `regexp' or `both'. This is then equivalent to set
-`org-list-end-regexp' to \"^[ \\t]*$\"."
+Otherwise, two of them will be necessary."
:group 'org-plain-lists
:type 'boolean)
-(defcustom org-list-end-regexp "^[ \t]*\n[ \t]*\n"
- "Regexp matching the end of all plain list levels.
-It must start with \"^\" and end with \"\\n\". It defaults to 2
-blank lines. `org-empty-line-terminates-plain-lists' has
-precedence over it."
- :group 'org-plain-lists
- :type 'string)
-
-(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
\\[org-meta-return], \\[org-metaright], \\[org-metaleft],
\\[org-shiftmetaright], \\[org-shiftmetaleft],
\\[org-ctrl-c-minus], \\[org-toggle-checkbox] or
- \\[org-insert-todo-heading]. You can disable individually these
+ \\[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
- :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.
@@ -305,6 +272,7 @@ This affects the behavior of \\[org-move-item-up],
\\[org-move-item-down], \\[org-next-item] and
\\[org-previous-item]."
:group 'org-plain-lists
+ :version "24.1"
:type 'boolean)
(defvar org-checkbox-statistics-hook nil
@@ -334,6 +302,7 @@ When the indentation would be larger than this, it will become
By setting this to a small number, usually 1 or 2, one can more
clearly distinguish sub-items in a list."
:group 'org-plain-lists
+ :version "24.1"
:type 'integer)
(defcustom org-list-radio-list-templates
@@ -376,18 +345,18 @@ specifically, type `block' is determined by the variable
`org-list-forbidden-blocks'.")
+
;;; Predicates and regexps
-(defconst org-list-end-re (if org-empty-line-terminates-plain-lists
- "^[ \t]*\n"
- org-list-end-regexp)
+(defconst org-list-end-re (if org-empty-line-terminates-plain-lists "^[ \t]*\n"
+ "^[ \t]*\n[ \t]*\n")
"Regex corresponding to the end of a list.
It depends on `org-empty-line-terminates-plain-lists'.")
(defconst org-list-full-item-re
- (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\)"
+ (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)"
"\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
- "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
+ "\\(?:\\(\\[[ X-]\\]\\)\\(?:[ \t]+\\|$\\)\\)?"
"\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?")
"Matches a list item and puts everything into groups:
group 1: bullet
@@ -429,8 +398,7 @@ group 4: description tag")
(not (org-in-block-p org-list-forbidden-blocks)))
(defun org-in-item-p ()
- "Return item beginning position when in a plain list, nil otherwise.
-This checks `org-list-ending-method'."
+ "Return item beginning position when in a plain list, nil otherwise."
(save-excursion
(beginning-of-line)
(let* ((case-fold-search t)
@@ -457,8 +425,7 @@ This checks `org-list-ending-method'."
;; to compute its boundaries END-BOUNDS. When point is
;; in-between, move cursor before regexp beginning.
(let ((hl 0) (i -1) end-bounds)
- (when (and (not (eq org-list-ending-method 'indent))
- (progn
+ (when (and (progn
(while (setq i (string-match
"[\r\n]" org-list-end-re (1+ i)))
(setq hl (1+ hl)))
@@ -467,23 +434,18 @@ This checks `org-list-ending-method'."
(< (point) (cdr end-bounds)))
(goto-char (car end-bounds))
(forward-line -1)))
- ;; Look for an item, less indented that reference line if
- ;; `org-list-ending-method' isn't `regexp'.
+ ;; Look for an item, less indented that reference line.
(catch 'exit
(while t
(let ((ind (org-get-indentation)))
(cond
;; This is exactly what we want.
- ((and (looking-at item-re)
- (or (< ind ind-ref)
- (eq org-list-ending-method 'regexp)))
+ ((and (looking-at item-re) (< ind ind-ref))
(throw 'exit (point)))
;; At upper bound of search or looking at the end of a
;; previous list: search is over.
((<= (point) lim-up) (throw 'exit nil))
- ((and (not (eq org-list-ending-method 'indent))
- (looking-at org-list-end-re))
- (throw 'exit nil))
+ ((looking-at org-list-end-re) (throw 'exit nil))
;; Skip blocks, drawers, inline-tasks, blank lines
((and (looking-at "^[ \t]*#\\+end_")
(re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
@@ -522,7 +484,7 @@ This checks `org-list-ending-method'."
(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?"
@@ -535,6 +497,7 @@ This checks `org-list-ending-method'."
(match-string 2)))
+
;;; Structures and helper functions
(defun org-list-context ()
@@ -658,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.
@@ -699,8 +665,7 @@ Assume point is at an item."
(forward-line -1))
;; Looking at a list ending regexp. Dismiss useless
;; data recorded above BEG-CELL. Jump to part 2.
- ((and (not (eq org-list-ending-method 'indent))
- (looking-at org-list-end-re))
+ ((looking-at org-list-end-re)
(throw 'exit
(setq itm-lst
(memq (assq (car beg-cell) itm-lst) itm-lst))))
@@ -712,10 +677,7 @@ Assume point is at an item."
((looking-at item-re)
(push (funcall assoc-at-point ind) itm-lst)
(push (cons ind (point)) end-lst)
- (when (or (and (eq org-list-ending-method 'regexp)
- (<= ind (cdr beg-cell)))
- (< ind text-min-ind))
- (setq beg-cell (cons (point) ind)))
+ (when (< ind text-min-ind) (setq beg-cell (cons (point) ind)))
(forward-line -1))
;; Skip blocks, drawers, inline tasks, blank lines.
((and (looking-at "^[ \t]*#\\+end_")
@@ -728,14 +690,13 @@ Assume point is at an item."
(forward-line -1))
((looking-at "^[ \t]*$")
(forward-line -1))
- ;; From there, point is not at an item. Unless ending
- ;; method is `regexp', interpret line's indentation:
+ ;; 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
;; part 2.
;; - any other case may be an ending position for an
;; hypothetical item above. Store it and proceed.
- ((eq org-list-ending-method 'regexp) (forward-line -1))
((zerop ind)
(throw 'exit
(setq itm-lst
@@ -749,15 +710,15 @@ Assume point is at an item."
;; equally indented than BEG-CELL's cdr. Also, store ending
;; position of items in END-LST-2.
(catch 'exit
- (while t
- (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
+ (while t
+ (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
(org-get-indentation))))
- (cond
- ((>= (point) lim-down)
+ (cond
+ ((>= (point) lim-down)
;; At downward limit: this is de facto the end of the
;; list. Save point as an ending position, and jump to
;; part 3.
- (throw 'exit
+ (throw 'exit
(push (cons 0 (funcall end-before-blank)) end-lst-2)))
;; At a verbatim block, move to its end. Point is at bol
;; and 'org-example property is set by whole lines:
@@ -767,8 +728,7 @@ Assume point is at an item."
(next-single-property-change (point) 'org-example nil lim-down)))
;; Looking at a list ending regexp. Save point as an
;; ending position and jump to part 3.
- ((and (not (eq org-list-ending-method 'indent))
- (looking-at org-list-end-re))
+ ((looking-at org-list-end-re)
(throw 'exit (push (cons 0 (point)) end-lst-2)))
((looking-at item-re)
;; Point is at an item. Add data to ITM-LST-2. It may
@@ -784,16 +744,14 @@ Assume point is at an item."
;; Ind is lesser or equal than BEG-CELL's. The list is
;; over: store point as an ending position and jump to
;; part 3.
- ((and (not (eq org-list-ending-method 'regexp))
- (<= ind (cdr beg-cell)))
+ ((<= ind (cdr beg-cell))
(throw 'exit
(push (cons 0 (funcall end-before-blank)) end-lst-2)))
;; Else, if ind is lesser or equal than previous item's,
;; this is an ending position: store it. In any case,
;; skip block or drawer at point, and move to next line.
(t
- (when (and (not (eq org-list-ending-method 'regexp))
- (<= ind (nth 1 (car itm-lst-2))))
+ (when (<= ind (nth 1 (car itm-lst-2)))
(push (cons ind (point)) end-lst-2))
(cond
((and (looking-at "^[ \t]*#\\+begin_")
@@ -803,21 +761,9 @@ Assume point is at an item."
(forward-line 1))))))
(setq struct (append itm-lst (cdr (nreverse itm-lst-2)))
end-lst (append end-lst (cdr (nreverse end-lst-2))))
- ;; 3. Correct ill-formed lists by ensuring top item is the least
- ;; indented.
- (let ((min-ind (nth 1 (car struct))))
- (mapc (lambda (item)
- (let ((ind (nth 1 item))
- (bul (nth 2 item)))
- (when (< ind min-ind)
- (setcar (cdr item) min-ind)
- ;; Trim bullet so item will be seen as different
- ;; when compared with repaired version.
- (setcar (nthcdr 2 item) (org-trim bul)))))
- struct))
- ;; 4. Associate each item to its end pos.
+ ;; 3. Associate each item to its end position.
(org-list-struct-assoc-end struct end-lst)
- ;; 5. Return STRUCT
+ ;; 4. Return STRUCT
struct)))
(defun org-list-struct-assoc-end (struct end-list)
@@ -854,8 +800,9 @@ This function modifies STRUCT."
(defun org-list-parents-alist (struct)
"Return alist between item and parent in STRUCT."
- (let ((ind-to-ori (list (list (nth 1 (car struct)))))
- (prev-pos (list (caar struct))))
+ (let* ((ind-to-ori (list (list (nth 1 (car struct)))))
+ (top-item (org-list-get-top-point struct))
+ (prev-pos (list top-item)))
(cons prev-pos
(mapcar (lambda (item)
(let ((pos (car item))
@@ -864,17 +811,34 @@ This function modifies STRUCT."
(push pos prev-pos)
(cond
((> prev-ind ind)
+ ;; A sub-list is over. Find the associated
+ ;; origin in IND-TO-ORI. If it cannot be
+ ;; found (ill-formed list), set its parent as
+ ;; the first item less indented. If there is
+ ;; none, make it a top-level item.
(setq ind-to-ori
- (member (assq ind ind-to-ori) ind-to-ori))
+ (or (member (assq ind ind-to-ori) ind-to-ori)
+ (catch 'exit
+ (mapc
+ (lambda (e)
+ (when (< (car e) ind)
+ (throw 'exit (member e ind-to-ori))))
+ ind-to-ori)
+ (list (list ind)))))
(cons pos (cdar ind-to-ori)))
+ ;; A sub-list starts. Every item at IND will
+ ;; have previous item as its parent.
((< prev-ind ind)
(let ((origin (nth 1 prev-pos)))
(push (cons ind origin) ind-to-ori)
(cons pos origin)))
+ ;; Another item in the same sub-list: it shares
+ ;; the same parent as the previous item.
(t (cons pos (cdar ind-to-ori))))))
(cdr struct)))))
+
;;; Accessors
(defsubst org-list-get-nth (n key struct)
@@ -992,8 +956,8 @@ items, as returned by `org-list-prevs-alist'."
(defun org-list-get-children (item struct parents)
"List all children of ITEM, or nil.
-STRUCT is the list structure. PARENTS is the alist of parents, as
-returned by `org-list-parents-alist'."
+STRUCT is the list structure. PARENTS is the alist of parents,
+as returned by `org-list-parents-alist'."
(let (all child)
(while (setq child (car (rassq item parents)))
(setq parents (cdr (member (assq child parents) parents)))
@@ -1047,11 +1011,47 @@ 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
(defun org-list-search-generic (search re bound noerr)
@@ -1084,6 +1084,7 @@ Arguments REGEXP, BOUND and NOERROR are similar to those used in
regexp (or bound (point-max)) noerror))
+
;;; Methods on structures
(defsubst org-list-bullet-string (bullet)
@@ -1101,8 +1102,10 @@ It determines the number of whitespaces to append by looking at
(defun org-list-swap-items (beg-A beg-B struct)
"Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
-Blank lines at the end of items are left in place. Return the
-new structure after the changes.
+
+Blank lines at the end of items are left in place. Item
+visibility is preserved. Return the new structure after the
+changes.
Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong
to the same sub-list.
@@ -1119,7 +1122,17 @@ This function modifies STRUCT."
(body-B (buffer-substring beg-B end-B-no-blank))
(between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))
(sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
- (sub-B (cons beg-B (org-list-get-subtree beg-B struct))))
+ (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))
+ ;; 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)))))
;; 1. Move effectively items in buffer.
(goto-char beg-A)
(delete-region beg-A end-B-no-blank)
@@ -1152,7 +1165,22 @@ This function modifies STRUCT."
(setcar e (+ pos (- size-B size-A)))
(setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
struct)
- (sort struct (lambda (e1 e2) (< (car e1) (car e2)))))))
+ (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2)))))
+ ;; Restore visibility status, by moving overlays to their new
+ ;; position.
+ (mapc (lambda (ov)
+ (move-overlay
+ (car ov)
+ (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A))
+ (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A))))
+ (car overlays))
+ (mapc (lambda (ov)
+ (move-overlay (car ov)
+ (+ (nth 1 ov) (- beg-A beg-B))
+ (+ (nth 2 ov) (- beg-A beg-B))))
+ (cdr overlays))
+ ;; Return structure.
+ struct)))
(defun org-list-separating-blank-lines-number (pos struct prevs)
"Return number of blank lines that should separate items in list.
@@ -1168,30 +1196,36 @@ some heuristics to guess the result."
(let ((item (point))
(insert-blank-p
(cdr (assq 'plain-list-item org-blank-before-new-entry)))
- usr-blank)
+ usr-blank
+ (count-blanks
+ (function
+ (lambda ()
+ ;; Count blank lines above beginning of line.
+ (save-excursion
+ (count-lines (goto-char (point-at-bol))
+ (progn (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point))))))))
(cond
;; Trivial cases where there should be none.
- ((or (and (not (eq org-list-ending-method 'indent))
- org-empty-line-terminates-plain-lists)
- (not insert-blank-p)) 0)
+ ((or org-empty-line-terminates-plain-lists (not insert-blank-p)) 0)
;; When `org-blank-before-new-entry' says so, it is 1.
((eq insert-blank-p t) 1)
;; `plain-list-item' is 'auto. Count blank lines separating
- ;; neighboring items in list.
+ ;; neighbours items in list.
(t (let ((next-p (org-list-get-next-item item struct prevs)))
(cond
;; Is there a next item?
(next-p (goto-char next-p)
- (org-back-over-empty-lines))
+ (funcall count-blanks))
;; Is there a previous item?
((org-list-get-prev-item item struct prevs)
- (org-back-over-empty-lines))
+ (funcall count-blanks))
;; User inserted blank lines, trust him.
((and (> pos (org-list-get-item-end-before-blank item struct))
- (> (save-excursion
- (goto-char pos)
- (skip-chars-backward " \t")
- (setq usr-blank (org-back-over-empty-lines))) 0))
+ (> (save-excursion (goto-char pos)
+ (setq usr-blank (funcall count-blanks)))
+ 0))
usr-blank)
;; Are there blank lines inside the list so far?
((save-excursion
@@ -1207,7 +1241,7 @@ some heuristics to guess the result."
If POS is before first character after bullet of the item, the
new item will be created before the current one.
-STRUCT is the list structure. PREVS is the alist of previous
+STRUCT is the list structure. PREVS is the the alist of previous
items, as returned by `org-list-prevs-alist'.
Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
@@ -1222,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))
@@ -1267,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.
@@ -1364,8 +1404,8 @@ If DEST is a buffer position, the function will assume it points
to another item in the same list as ITEM, and will move the
latter just before the former.
-If DEST is `begin' \(resp. `end'\), ITEM will be moved at the
-beginning \(resp. end\) of the list it belongs to.
+If DEST is `begin' (respectively `end'), ITEM will be moved at
+the beginning (respectively end) of the list it belongs to.
If DEST is a string like \"N\", where N is an integer, ITEM will
be moved at the Nth position in the list.
@@ -1375,6 +1415,8 @@ added to the kill-ring.
If DEST is `delete', ITEM will be deleted.
+Visibility of item is preserved.
+
This function returns, destructively, the new list structure."
(let* ((prevs (org-list-prevs-alist struct))
(item-end (org-list-get-item-end item struct))
@@ -1417,7 +1459,9 @@ This function returns, destructively, the new list structure."
(org-list-get-last-item item struct prevs))
(point-at-eol)))))
(t dest)))
- (org-M-RET-may-split-line nil))
+ (org-M-RET-may-split-line nil)
+ ;; Store visibility.
+ (visibility (overlays-in item item-end)))
(cond
((eq dest 'delete) (org-list-delete-item item struct))
((eq dest 'kill)
@@ -1453,9 +1497,14 @@ This function returns, destructively, the new list structure."
(+ end shift)))))))
moved-items))
(lambda (e1 e2) (< (car e1) (car e2))))))
- ;; 2. Eventually delete extra copy of the item and clean marker.
- (prog1
- (org-list-delete-item (marker-position item) struct)
+ ;; 2. Restore visibility.
+ (mapc (lambda (ov)
+ (move-overlay ov
+ (+ (overlay-start ov) (- (point) item))
+ (+ (overlay-end ov) (- (point) item))))
+ visibility)
+ ;; 3. Eventually delete extra copy of the item and clean marker.
+ (prog1 (org-list-delete-item (marker-position item) struct)
(move-marker item nil)))
(t struct))))
@@ -1508,8 +1557,19 @@ bullets between START and END."
(change-bullet-maybe
(function
(lambda (item)
- (let* ((bul (org-trim (org-list-get-bullet item struct)))
- (new-bul-p (cdr (assoc bul org-list-demote-modify-bullet))))
+ (let ((new-bul-p
+ (cdr (assoc
+ ;; Normalize ordered bullets.
+ (let ((bul (org-trim
+ (org-list-get-bullet item struct))))
+ (cond ((string-match "[A-Z]\\." bul) "A.")
+ ((string-match "[A-Z])" bul) "A)")
+ ((string-match "[a-z]\\." bul) "a.")
+ ((string-match "[a-z])" bul) "a)")
+ ((string-match "[0-9]\\." bul) "1.")
+ ((string-match "[0-9])" bul) "1)")
+ (t bul)))
+ org-list-demote-modify-bullet))))
(when new-bul-p (org-list-set-bullet item struct new-bul-p))))))
(ind
(lambda (cell)
@@ -1543,12 +1603,13 @@ bullets between START and END."
(mapcar ind parents)))
+
;;; Repairing structures
(defun org-list-use-alpha-bul-p (first struct prevs)
"Non-nil if list starting at FIRST can have alphabetical bullets.
-STRUCT is list structure. PREVS is the alist of previous items,
+STRUCT is list structure. PREVS is the alist of previous items,
as returned by `org-list-prevs-alist'."
(and org-alphabetical-lists
(catch 'exit
@@ -1567,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)
@@ -1746,19 +1807,44 @@ This function modifies STRUCT."
;; Return blocking item.
(nth index all-items)))))))
+(defun org-list-struct-fix-item-end (struct)
+ "Verify and correct each item end position in STRUCT.
+
+This function modifies STRUCT."
+ (let (end-list acc-end)
+ (mapc (lambda (e)
+ (let* ((pos (car e))
+ (ind-pos (org-list-get-ind pos struct))
+ (end-pos (org-list-get-item-end pos struct)))
+ (unless (assq end-pos struct)
+ ;; To determine real ind of an ending position that is
+ ;; not at an item, we have to find the item it belongs
+ ;; to: it is the last item (ITEM-UP), whose ending is
+ ;; further than the position we're interested in.
+ (let ((item-up (assoc-default end-pos acc-end '>)))
+ (push (cons
+ ;; Else part is for the bottom point.
+ (if item-up (+ (org-list-get-ind item-up struct) 2) 0)
+ end-pos)
+ end-list)))
+ (push (cons ind-pos pos) end-list)
+ (push (cons end-pos pos) acc-end)))
+ struct)
+ (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2)))))
+ (org-list-struct-assoc-end struct end-list)))
+
(defun org-list-struct-apply-struct (struct old-struct)
- "Apply set-difference between STRUCT and OLD-STRUCT to the buffer.
+ "Apply set difference between STRUCT and OLD-STRUCT to the buffer.
OLD-STRUCT is the structure before any modifications, and STRUCT
the structure to be applied. The function will only modify parts
of the list which have changed.
Initial position of cursor is restored after the changes."
- (let* ((origin (copy-marker (point)))
+ (let* ((origin (point-marker))
(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.
@@ -1792,26 +1878,21 @@ 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))
((match-string 3)
- ;; (goto-char (or (match-end 2) (match-end 1)))
- ;; (skip-chars-backward " \t")
(looking-at ".*?\\([ \t]*\\[[ X-]\\]\\)")
(replace-match "" nil nil nil 1))
(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.
+ (insert (concat new-box (unless counterp " "))))))
+ ;; c. Indent item to appropriate column.
(unless (= new-ind old-ind)
(delete-region (goto-char (point-at-bol))
(progn (skip-chars-forward " \t") (point)))
@@ -1869,53 +1950,38 @@ Initial position of cursor is restored after the changes."
(goto-char origin)
(move-marker origin nil)))
-(defun org-list-write-struct (struct parents)
+(defun org-list-write-struct (struct parents &optional old-struct)
"Correct bullets, checkboxes and indentation in list at point.
+
STRUCT is the list structure. PARENTS is the alist of parents,
-as returned by `org-list-parents-alist'."
+as returned by `org-list-parents-alist'.
+
+When non-nil, optional argument OLD-STRUCT is the reference
+structure of the list. It should be provided whenever STRUCT
+doesn't correspond anymore to the real list in buffer."
;; Order of functions matters here: checkboxes and endings need
;; correct indentation to be set, and indentation needs correct
;; bullets.
;;
;; 0. Save a copy of structure before modifications
- (let ((old-struct (copy-tree struct)))
+ (let ((old-struct (or old-struct (copy-tree struct))))
;; 1. Set a temporary, but coherent with PARENTS, indentation in
;; order to get items endings and bullets properly
(org-list-struct-fix-ind struct parents 2)
- ;; 2. Get pseudo-alist of ending positions and sort it by position.
- ;; Then associate them to the structure.
- (let (end-list acc-end)
- (mapc (lambda (e)
- (let* ((pos (car e))
- (ind-pos (org-list-get-ind pos struct))
- (end-pos (org-list-get-item-end pos struct)))
- (unless (assq end-pos struct)
- ;; To determine real ind of an ending position that is
- ;; not at an item, we have to find the item it belongs
- ;; to: it is the last item (ITEM-UP), whose ending is
- ;; further than the position we're interested in.
- (let ((item-up (assoc-default end-pos acc-end '>)))
- (push (cons
- ;; Else part is for the bottom point.
- (if item-up (+ (org-list-get-ind item-up struct) 2) 0)
- end-pos)
- end-list)))
- (push (cons ind-pos pos) end-list)
- (push (cons end-pos pos) acc-end)))
- struct)
- (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2)))))
- (org-list-struct-assoc-end struct end-list))
- ;; 3. Get bullets right.
- (let ((prevs (org-list-prevs-alist struct)))
- (org-list-struct-fix-bul struct prevs)
- ;; 4. Now get real indentation.
- (org-list-struct-fix-ind struct parents)
- ;; 5. Eventually fix checkboxes.
- (org-list-struct-fix-box struct parents prevs))
- ;; 6. Apply structure modifications to buffer.
- (org-list-struct-apply-struct struct old-struct)))
-
-
+ ;; 2. Fix each item end to get correct prevs alist.
+ (org-list-struct-fix-item-end struct)
+ ;; 3. Get bullets right.
+ (let ((prevs (org-list-prevs-alist struct)))
+ (org-list-struct-fix-bul struct prevs)
+ ;; 4. Now get real indentation.
+ (org-list-struct-fix-ind struct parents)
+ ;; 5. Eventually fix checkboxes.
+ (org-list-struct-fix-box struct parents prevs))
+ ;; 6. Apply structure modifications to buffer.
+ (org-list-struct-apply-struct struct old-struct)))
+
+
+
;;; Misc Tools
(defun org-apply-on-list (function init-value &rest args)
@@ -1947,7 +2013,7 @@ beginning of the item."
(defun org-list-set-item-visibility (item struct view)
"Set visibility of ITEM in STRUCT to VIEW.
-Possible values are: `folded', `children' or `subtree'. See
+Possible values are: `folded', `children' or `subtree'. See
`org-cycle' for more information."
(cond
((eq view 'folded)
@@ -1974,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)))
@@ -1983,6 +2049,7 @@ Possible values are: `folded', `children' or `subtree'. See
tcol))
+
;;; Interactive functions
(defalias 'org-list-get-item-begin 'org-in-item-p)
@@ -2130,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 ()
@@ -2172,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
@@ -2187,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))))
@@ -2257,7 +2321,7 @@ in subtree, ignoring drawers."
(setq lim-up (point-at-bol))
(error "No item in region"))
(setq lim-down (copy-marker limit))))
- ((org-on-heading-p)
+ ((org-at-heading-p)
;; On an heading, start at first item after drawers and
;; time-stamps (scheduled, etc.).
(let ((limit (save-excursion (outline-next-heading) (point))))
@@ -2274,7 +2338,7 @@ in subtree, ignoring drawers."
((org-at-item-p)
(setq singlep t)
(setq lim-up (point-at-bol)
- lim-down (point-at-eol)))
+ lim-down (copy-marker (point-at-eol))))
(t (error "Not at an item or heading, and no active region"))))
;; Determine the checkbox going to be applied to all items
;; within bounds.
@@ -2305,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))
@@ -2328,9 +2392,9 @@ in subtree, ignoring drawers."
"Checkboxes were removed due to unchecked box at line %d"
(org-current-line block-item))))
(goto-char bottom)
- (move-marker lim-down nil)
(move-marker bottom nil)
- (org-list-struct-apply-struct struct struct-copy)))))
+ (org-list-struct-apply-struct struct struct-copy)))
+ (move-marker lim-down nil)))
(org-update-checkbox-count-maybe))
(defun org-reset-checkbox-state-subtree ()
@@ -2416,7 +2480,7 @@ With optional prefix argument ALL, do this for the whole buffer."
(cond ; boxes count
;; Cookie is at an heading, but specifically for todo,
;; not for checkboxes: skip it.
- ((and (org-on-heading-p)
+ ((and (org-at-heading-p)
(string-match "\\<todo\\>"
(downcase
(or (org-entry-get nil "COOKIE_DATA") ""))))
@@ -2425,14 +2489,14 @@ With optional prefix argument ALL, do this for the whole buffer."
;; heading already have been read. Use data collected
;; in STRUCTS-BAK. This should only happen when
;; heading has more than one cookie on it.
- ((and (org-on-heading-p)
+ ((and (org-at-heading-p)
(<= (save-excursion (outline-next-heading) (point))
backup-end))
(funcall count-boxes nil structs-bak recursivep))
;; Cookie is at a fresh heading. Grab structure of
;; every list containing a checkbox between point and
;; next headline, and save them in STRUCTS-BAK.
- ((org-on-heading-p)
+ ((org-at-heading-p)
(setq backup-end (save-excursion
(outline-next-heading) (point))
structs-bak nil)
@@ -2491,7 +2555,8 @@ Otherwise it will be `org-todo'."
'org-checkbox-statistics-todo)))
(defun org-update-checkbox-count-maybe (&optional all)
- "Update checkbox statistics unless turned off by user."
+ "Update checkbox statistics unless turned off by user.
+With an optional argument ALL, update them in the whole buffer."
(when (cdr (assq 'checkbox org-list-automatic-rules))
(org-update-checkbox-count all))
(run-hooks 'org-checkbox-statistics-hook))
@@ -2512,7 +2577,6 @@ STRUCT is the list structure.
Return t if successful."
(save-excursion
- (beginning-of-line)
(let* ((regionp (org-region-active-p))
(rbeg (and regionp (region-beginning)))
(rend (and regionp (region-end)))
@@ -2521,7 +2585,8 @@ Return t if successful."
(prevs (org-list-prevs-alist struct))
;; Are we going to move the whole list?
(specialp
- (and (= top (point))
+ (and (not regionp)
+ (= top (point-at-bol))
(cdr (assq 'indent org-list-automatic-rules))
(if no-subtree
(error
@@ -2535,12 +2600,12 @@ Return t if successful."
(progn
(set-marker org-last-indent-begin-marker rbeg)
(set-marker org-last-indent-end-marker rend))
- (set-marker org-last-indent-begin-marker (point))
+ (set-marker org-last-indent-begin-marker (point-at-bol))
(set-marker org-last-indent-end-marker
(cond
(specialp (org-list-get-bottom-point struct))
- (no-subtree (1+ (point)))
- (t (org-list-get-item-end (point) struct))))))
+ (no-subtree (1+ (point-at-bol)))
+ (t (org-list-get-item-end (point-at-bol) struct))))))
(let* ((beg (marker-position org-last-indent-begin-marker))
(end (marker-position org-last-indent-end-marker)))
(cond
@@ -2595,19 +2660,35 @@ Return t if successful."
"Outdent a local list item, but not its children.
If a region is active, all items inside will be moved."
(interactive)
- (if (org-at-item-p)
- (let ((struct (org-list-struct)))
- (org-list-indent-item-generic -1 t struct))
- (error "Not at an item")))
+ (let ((regionp (org-region-active-p)))
+ (cond
+ ((or (org-at-item-p)
+ (and regionp
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p))))
+ (let ((struct (if (not regionp) (org-list-struct)
+ (save-excursion (goto-char (region-beginning))
+ (org-list-struct)))))
+ (org-list-indent-item-generic -1 t struct)))
+ (regionp (error "Region not starting at an item"))
+ (t (error "Not at an item")))))
(defun org-indent-item ()
"Indent a local list item, but not its children.
If a region is active, all items inside will be moved."
(interactive)
- (if (org-at-item-p)
- (let ((struct (org-list-struct)))
- (org-list-indent-item-generic 1 t struct))
- (error "Not at an item")))
+ (let ((regionp (org-region-active-p)))
+ (cond
+ ((or (org-at-item-p)
+ (and regionp
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p))))
+ (let ((struct (if (not regionp) (org-list-struct)
+ (save-excursion (goto-char (region-beginning))
+ (org-list-struct)))))
+ (org-list-indent-item-generic 1 t struct)))
+ (regionp (error "Region not starting at an item"))
+ (t (error "Not at an item")))))
(defun org-outdent-item-tree ()
"Outdent a local list item including its children.
@@ -2616,10 +2697,12 @@ If a region is active, all items inside will be moved."
(let ((regionp (org-region-active-p)))
(cond
((or (org-at-item-p)
- (and (org-region-active-p)
- (goto-char (region-beginning))
- (org-at-item-p)))
- (let ((struct (org-list-struct)))
+ (and regionp
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p))))
+ (let ((struct (if (not regionp) (org-list-struct)
+ (save-excursion (goto-char (region-beginning))
+ (org-list-struct)))))
(org-list-indent-item-generic -1 nil struct)))
(regionp (error "Region not starting at an item"))
(t (error "Not at an item")))))
@@ -2631,10 +2714,12 @@ If a region is active, all items inside will be moved."
(let ((regionp (org-region-active-p)))
(cond
((or (org-at-item-p)
- (and (org-region-active-p)
- (goto-char (region-beginning))
- (org-at-item-p)))
- (let ((struct (org-list-struct)))
+ (and regionp
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p))))
+ (let ((struct (if (not regionp) (org-list-struct)
+ (save-excursion (goto-char (region-beginning))
+ (org-list-struct)))))
(org-list-indent-item-generic 1 nil struct)))
(regionp (error "Region not starting at an item"))
(t (error "Not at an item")))))
@@ -2711,7 +2796,7 @@ Capital letters will reverse the sort order.
If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
a function to be called with point at the beginning of the
record. It must return either a string or a number that should
-serve as the sorting key for that record. It will then use
+serve as the sorting key for that record. It will then use
COMPARE-FUNC to compare entries."
(interactive "P")
(let* ((case-func (if with-case 'identity 'downcase))
@@ -2737,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))))
@@ -2786,6 +2870,7 @@ COMPARE-FUNC to compare entries."
(message "Sorting items...done")))))
+
;;; Send and receive lists
(defun org-list-parse-list (&optional delete)
@@ -2854,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
@@ -2896,9 +2981,7 @@ Point is left at list end."
(goto-char top)
(when delete
(delete-region top bottom)
- (when (and (not (eq org-list-ending-method 'indent))
- (not (looking-at "[ \t]*$"))
- (looking-at org-list-end-re))
+ (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re))
(replace-match "")))
out))
@@ -2975,6 +3058,10 @@ for this list."
(insert txt "\n")))
(message "List converted and installed at receiver location"))))
+(defsubst org-list-item-trim-br (item)
+ "Trim line breaks in a list ITEM."
+ (setq item (replace-regexp-in-string "\n +" " " item)))
+
(defun org-list-to-generic (list params)
"Convert a LIST parsed through `org-list-parse-list' to other formats.
Valid parameters PARAMS are:
@@ -3006,6 +3093,8 @@ Valid parameters PARAMS are:
:cbon String to insert for a checked check-box
:cbtrans String to insert for a check-box in transitional state
+:nobr Non-nil means remove line breaks in lists items.
+
Alternatively, each parameter can also be a form returning
a string. These sexp can use keywords `counter' and `depth',
representing respectively counter associated to the current
@@ -3034,6 +3123,7 @@ items."
(cbon (plist-get p :cbon))
(cboff (plist-get p :cboff))
(cbtrans (plist-get p :cbtrans))
+ (nobr (plist-get p :nobr))
export-sublist ; for byte-compiler
(export-item
(function
@@ -3055,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
@@ -3065,6 +3155,8 @@ items."
(setq first (replace-match cboff t t first)))
((string-match "\\[CBTRANS\\]" first)
(setq first (replace-match cbtrans t t first))))
+ ;; Replace line breaks if required
+ (when nobr (setq first (org-list-item-trim-br first)))
;; Insert descriptive term if TYPE is `descriptive'.
(when (eq type 'descriptive)
(let* ((complete (string-match "^\\(.*\\)[ \t]+::" first))
@@ -3110,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)
@@ -3135,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)
@@ -3154,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)
@@ -3200,5 +3292,4 @@ with overruling parameters for `org-list-to-generic'."
(provide 'org-list)
-
;;; org-list.el ends here
diff --git a/lisp/org/org-lparse.el b/lisp/org/org-lparse.el
new file mode 100644
index 00000000000..c5ced3ef01c
--- /dev/null
+++ b/lisp/org/org-lparse.el
@@ -0,0 +1,2303 @@
+;;; org-lparse.el --- Line-oriented parser-exporter for Org-mode
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Jambunathan K <kjambunathan at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; 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:
+
+;; `org-lparse' is the entry point for the generic line-oriented
+;; exporter. `org-do-lparse' is the genericized version of the
+;; original `org-export-as-html' routine.
+
+;; `org-lparse-native-backends' is a good starting point for
+;; exploring the generic exporter.
+
+;; Following new interactive commands are provided by this library.
+;; `org-lparse', `org-lparse-and-open', `org-lparse-to-buffer'
+;; `org-replace-region-by', `org-lparse-region'.
+
+;; Note that the above routines correspond to the following routines
+;; in the html exporter `org-export-as-html',
+;; `org-export-as-html-and-open', `org-export-as-html-to-buffer',
+;; `org-replace-region-by-html' and `org-export-region-as-html'.
+
+;; The new interactive command `org-lparse-convert' can be used to
+;; convert documents between various formats. Use this to command,
+;; for example, to convert odt file to doc or pdf format.
+
+;;; Code:
+(eval-when-compile
+ (require 'cl))
+(require 'org-exp)
+(require 'org-list)
+(require 'format-spec)
+
+(defun org-lparse-and-open (target-backend native-backend arg
+ &optional file-or-buf)
+ "Export outline to TARGET-BACKEND via NATIVE-BACKEND and open exported file.
+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."
+ (let (f (file-or-buf (or file-or-buf
+ (org-lparse target-backend native-backend
+ arg 'hidden))))
+ (when file-or-buf
+ (setq f (cond
+ ((bufferp file-or-buf) buffer-file-name)
+ ((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 'system)
+ (when org-export-kill-product-buffer-when-displayed
+ (kill-buffer (current-buffer))))))
+
+(defun org-lparse-batch (target-backend &optional native-backend)
+ "Call the function `org-lparse'.
+This function can be used in batch processing as:
+emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --eval \"(setq org-export-headline-levels 2)\"
+ --visit=MyFile --funcall org-lparse-batch"
+ (setq native-backend (or native-backend target-backend))
+ (org-lparse target-backend native-backend
+ org-export-headline-levels 'hidden))
+
+(defun org-lparse-to-buffer (backend arg)
+ "Call `org-lparse' with output to a temporary buffer.
+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))))
+
+(defun org-replace-region-by (backend beg end)
+ "Assume the current region has org-mode syntax, and convert it to HTML.
+This can be used in any buffer. For example, you could write an
+itemized list in org-mode syntax in an HTML buffer and then use
+this command to convert it."
+ (let (reg backend-string buf pop-up-frames)
+ (save-window-excursion
+ (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*"))
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert reg)
+ (org-mode)
+ (setq backend-string (org-lparse-region backend (point-min)
+ (point-max) t 'string)))
+ (kill-buffer buf)))
+ (delete-region beg end)
+ (insert backend-string)))
+
+(defun org-lparse-region (backend beg end &optional body-only buffer)
+ "Convert region from BEG to END in org-mode buffer to HTML.
+If prefix arg BODY-ONLY is set, omit file header, footer, and table of
+contents, and only produce the region of converted text, useful for
+cut-and-paste operations.
+If BUFFER is a buffer or a string, use/create that buffer as a target
+of the converted HTML. If BUFFER is the symbol `string', return the
+produced HTML as a string and leave not buffer behind. For example,
+a Lisp program could call this function in the following way:
+
+ (setq html (org-lparse-region \"html\" beg end t 'string))
+
+When called interactively, the output buffer is selected, and shown
+in a window. A non-interactive call will only return the buffer."
+ (let ((transient-mark-mode t) (zmacs-regions t)
+ ext-plist rtn)
+ (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
+ (goto-char end)
+ (set-mark (point)) ;; to activate the region
+ (goto-char beg)
+ (setq rtn (org-lparse backend backend nil nil ext-plist buffer body-only))
+ (if (fboundp 'deactivate-mark) (deactivate-mark))
+ (if (and (org-called-interactively-p 'any) (bufferp rtn))
+ (switch-to-buffer-other-window rtn)
+ rtn)))
+
+(defvar org-lparse-par-open nil)
+
+(defun org-lparse-should-inline-p (filename descp)
+ "Return non-nil if link FILENAME should be inlined.
+The decision to inline the FILENAME link is based on the current
+settings. DESCP is the boolean of whether there was a link
+description. See variables `org-export-html-inline-images' and
+`org-export-html-inline-image-extensions'."
+ (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.
+OPT-PLIST is the export options list."
+ (let ((start 0)
+ (current-dir (if buffer-file-name
+ (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
+ org-lparse-link-description-is-image)
+ (while (string-match org-bracket-link-analytic-regexp++ line start)
+ (setq org-lparse-link-description-is-image nil)
+ (setq start (match-beginning 0))
+ (setq path (save-match-data (org-link-unescape
+ (match-string 3 line))))
+ (setq type (cond
+ ((match-end 2) (match-string 2 line))
+ ((save-match-data
+ (or (file-name-absolute-p path)
+ (string-match "^\\.\\.?/" path)))
+ "file")
+ (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))
+ desc2 (if (match-end 2) (concat type ":" path) path)
+ descp (and desc1 (not (equal desc1 desc2)))
+ desc (or desc1 desc2))
+ ;; Make an image out of the description if that is so wanted
+ (when (and descp (org-file-image-p
+ desc (org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
+ (setq org-lparse-link-description-is-image t)
+ (save-match-data
+ (if (string-match "^file:" desc)
+ (setq desc (substring desc (match-end 0)))))
+ (save-match-data
+ (setq desc (org-add-props
+ (org-lparse-format 'INLINE-IMAGE desc)
+ '(org-protected t)))))
+ (cond
+ ((equal type "internal")
+ (let
+ ((frag-0
+ (if (= (string-to-char path) ?#)
+ (substring path 1)
+ path)))
+ (setq rpl
+ (org-lparse-format
+ 'ORG-LINK opt-plist "" "" (org-solidify-link-text
+ (save-match-data
+ (org-link-unescape frag-0))
+ nil) desc attr descp))))
+ ((and (equal type "id")
+ (setq id-file (org-id-find-id-file path)))
+ ;; This is an id: link to another file (if it was the same file,
+ ;; it would have become an internal link...)
+ (save-match-data
+ (setq id-file (file-relative-name
+ id-file
+ (file-name-directory org-current-export-file)))
+ (setq rpl
+ (org-lparse-format
+ 'ORG-LINK opt-plist type id-file
+ (concat (if (org-uuidgen-p path) "ID-") path)
+ desc attr descp))))
+ ((member type '("http" "https"))
+ ;; standard URL, can inline as image
+ (setq rpl
+ (org-lparse-format
+ 'ORG-LINK opt-plist type path nil desc attr descp)))
+ ((member type '("ftp" "mailto" "news"))
+ ;; standard URL, can't inline as image
+ (setq rpl
+ (org-lparse-format
+ 'ORG-LINK opt-plist type path nil desc attr descp)))
+
+ ((string= type "coderef")
+ (setq rpl (org-lparse-format
+ 'ORG-LINK opt-plist type "" path desc nil descp)))
+
+ ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
+ ;; The link protocol has a function for format the link
+ (setq rpl (save-match-data
+ (funcall fnc (org-link-unescape path)
+ desc1 (and (boundp 'org-lparse-backend)
+ (case org-lparse-backend
+ (xhtml 'html)
+ (t org-lparse-backend)))))))
+ ((string= type "file")
+ ;; FILE link
+ (save-match-data
+ (let*
+ ((components
+ (if
+ (string-match "::\\(.*\\)" path)
+ (list
+ (replace-match "" t nil path)
+ (match-string 1 path))
+ (list path nil)))
+
+ ;;The proper path, without a fragment
+ (path-1
+ (first components))
+
+ ;;The raw fragment
+ (fragment-0
+ (second components))
+
+ ;;Check the fragment. If it can't be used as
+ ;;target fragment we'll pass nil instead.
+ (fragment-1
+ (if
+ (and fragment-0
+ (not (string-match "^[0-9]*$" fragment-0))
+ (not (string-match "^\\*" fragment-0))
+ (not (string-match "^/.*/$" fragment-0)))
+ (org-solidify-link-text
+ (org-link-unescape fragment-0))
+ nil))
+ (desc-2
+ ;;Description minus "file:" and ".org"
+ (if (string-match "^file:" desc)
+ (let
+ ((desc-1 (replace-match "" t t desc)))
+ (if (string-match "\\.org$" desc-1)
+ (replace-match "" t t desc-1)
+ desc-1))
+ desc)))
+
+ (setq rpl
+ (if
+ (and
+ (functionp link-validate)
+ (not (funcall link-validate path-1 current-dir)))
+ desc
+ (org-lparse-format
+ 'ORG-LINK opt-plist "file" path-1 fragment-1
+ desc-2 attr descp))))))
+
+ (t
+ ;; just publish the path, as default
+ (setq rpl (concat "<i>&lt;" type ":"
+ (save-match-data (org-link-unescape path))
+ "&gt;</i>"))))
+ (setq line (replace-match rpl t t line)
+ start (+ start (length rpl))))
+ line))
+
+(defvar org-lparse-par-open-stashed) ; bound during `org-do-lparse'
+(defun org-lparse-stash-save-paragraph-state ()
+ (assert (zerop org-lparse-par-open-stashed))
+ (setq org-lparse-par-open-stashed org-lparse-par-open)
+ (setq org-lparse-par-open nil))
+
+(defun org-lparse-stash-pop-paragraph-state ()
+ (setq org-lparse-par-open org-lparse-par-open-stashed)
+ (setq org-lparse-par-open-stashed 0))
+
+(defmacro with-org-lparse-preserve-paragraph-state (&rest body)
+ `(let ((org-lparse-do-open-par org-lparse-par-open))
+ (org-lparse-end-paragraph)
+ ,@body
+ (when org-lparse-do-open-par
+ (org-lparse-begin-paragraph))))
+(def-edebug-spec with-org-lparse-preserve-paragraph-state (body))
+
+(defvar org-lparse-native-backends nil
+ "List of native backends registered with `org-lparse'.
+A backend can use `org-lparse-register-backend' to add itself to
+this list.
+
+All native backends must implement a get routine and a mandatory
+set of callback routines.
+
+The get routine must be named as org-<backend>-get where backend
+is the name of the backend. The exporter uses `org-lparse-get'
+and retrieves the backend-specific callback by querying for
+ENTITY-CONTROL and ENTITY-FORMAT variables.
+
+For the sake of illustration, the html backend implements
+`org-xhtml-get'. It returns
+`org-xhtml-entity-control-callbacks-alist' and
+`org-xhtml-entity-format-callbacks-alist' as the values of
+ENTITY-CONTROL and ENTITY-FORMAT settings.")
+
+(defun org-lparse-register-backend (backend)
+ "Make BACKEND known to `org-lparse' library.
+Add BACKEND to `org-lparse-native-backends'."
+ (when backend
+ (setq backend (cond
+ ((symbolp backend) (symbol-name backend))
+ ((stringp backend) backend)
+ (t (error "Error while registering backend: %S" backend))))
+ (add-to-list 'org-lparse-native-backends backend)))
+
+(defun org-lparse-unregister-backend (backend)
+ (setq org-lparse-native-backends
+ (remove (cond
+ ((symbolp backend) (symbol-name backend))
+ ((stringp backend) backend))
+ org-lparse-native-backends))
+ (message "Unregistered backend %S" backend))
+
+(defun org-lparse-do-reachable-formats (in-fmt)
+ "Return verbose info about formats to which IN-FMT can be converted.
+Return a list where each element is of the
+form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See
+`org-export-odt-convert-processes' for CONVERTER-PROCESS and see
+`org-export-odt-convert-capabilities' for OUTPUT-FMT-ALIST."
+ (let (reachable-formats)
+ (dolist (backend org-lparse-native-backends reachable-formats)
+ (let* ((converter (org-lparse-backend-get
+ backend 'CONVERT-METHOD))
+ (capabilities (org-lparse-backend-get
+ backend 'CONVERT-CAPABILITIES)))
+ (when converter
+ (dolist (c capabilities)
+ (when (member in-fmt (nth 1 c))
+ (push (cons converter (nth 2 c)) reachable-formats))))))))
+
+(defun org-lparse-reachable-formats (in-fmt)
+ "Return list of formats to which IN-FMT can be converted.
+The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)."
+ (let (l)
+ (mapc (lambda (e) (add-to-list 'l e))
+ (apply 'append (mapcar
+ (lambda (e) (mapcar 'car (cdr e)))
+ (org-lparse-do-reachable-formats in-fmt))))
+ l))
+
+(defun org-lparse-reachable-p (in-fmt out-fmt)
+ "Return non-nil if IN-FMT can be converted to OUT-FMT."
+ (catch 'done
+ (let ((reachable-formats (org-lparse-do-reachable-formats in-fmt)))
+ (dolist (e reachable-formats)
+ (let ((out-fmt-spec (assoc out-fmt (cdr e))))
+ (when out-fmt-spec
+ (throw 'done (cons (car e) out-fmt-spec))))))))
+
+(defun org-lparse-backend-is-native-p (backend)
+ (member backend org-lparse-native-backends))
+
+(defun org-lparse (target-backend native-backend arg
+ &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export the outline to various formats.
+If there is an active region, export only the region. The
+outline is first exported to NATIVE-BACKEND and optionally
+converted to TARGET-BACKEND. See `org-lparse-native-backends'
+for list of known native backends. Each native backend can
+specify a converter and list of target backends it exports to
+using the CONVERT-PROCESS and OTHER-BACKENDS settings of it's get
+method. See `org-xhtml-get' for an illustrative example.
+
+ARG is a prefix argument that specifies how many levels of
+outline should become headlines. The default is 3. Lower levels
+will become bulleted lists.
+
+HIDDEN is obsolete and does nothing.
+
+EXT-PLIST is a property list that controls various aspects of
+export. The settings here override org-mode's default settings
+and but are inferior to file-local settings.
+
+TO-BUFFER dumps the exported lines to a buffer or a string
+instead of a file. If TO-BUFFER is the symbol `string' return the
+exported lines as a string. If TO-BUFFER is non-nil, create a
+buffer with that name and export to that buffer.
+
+BODY-ONLY controls the presence of header and footer lines in
+exported text. If BODY-ONLY is non-nil, don't produce the file
+header and footer, simply return the content of <body>...</body>,
+without even the body tags themselves.
+
+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))
+
+ (unless (or (equal native-backend target-backend)
+ (org-lparse-reachable-p native-backend target-backend))
+ (error "Don't know how to export to backend %s %s" target-backend
+ (format "via %s" native-backend)))
+ (run-hooks 'org-export-first-hook)
+ (prog1
+ (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'.
+When non-nil, messages are fontified with warning face and the
+exporter lingers for a while to catch user's attention."
+ :type 'boolean
+ :group 'org-lparse)
+
+(defun org-lparse-convert-read-params ()
+ "Return IN-FILE and OUT-FMT params for `org-lparse-do-convert'.
+This is a helper routine for interactive use."
+ (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
+ (in-file (read-file-name "File to be converted: "
+ nil buffer-file-name t))
+ (in-fmt (file-name-extension in-file))
+ (out-fmt-choices (org-lparse-reachable-formats in-fmt))
+ (out-fmt
+ (or (and out-fmt-choices
+ (funcall input "Output format: "
+ out-fmt-choices nil nil nil))
+ (error
+ "No known converter or no known output formats for %s files"
+ in-fmt))))
+ (list in-file out-fmt)))
+
+(eval-when-compile
+ (require 'browse-url))
+
+(declare-function browse-url-file-url "browse-url" (file))
+
+(defun org-lparse-do-convert (in-file out-fmt &optional prefix-arg)
+ "Workhorse routine for `org-export-odt-convert'."
+ (require 'browse-url)
+ (let* ((in-file (expand-file-name (or in-file buffer-file-name)))
+ (dummy (or (file-readable-p in-file)
+ (error "Cannot read %s" in-file)))
+ (in-fmt (file-name-extension in-file))
+ (out-fmt (or out-fmt (error "Output format unspecified")))
+ (how (or (org-lparse-reachable-p in-fmt out-fmt)
+ (error "Cannot convert from %s format to %s format?"
+ in-fmt out-fmt)))
+ (convert-process (car how))
+ (out-file (concat (file-name-sans-extension in-file) "."
+ (nth 1 (or (cdr how) out-fmt))))
+ (extra-options (or (nth 2 (cdr how)) ""))
+ (out-dir (file-name-directory in-file))
+ (cmd (format-spec convert-process
+ `((?i . ,(shell-quote-argument in-file))
+ (?I . ,(browse-url-file-url in-file))
+ (?f . ,out-fmt)
+ (?o . ,out-file)
+ (?O . ,(browse-url-file-url out-file))
+ (?d . , (shell-quote-argument out-dir))
+ (?D . ,(browse-url-file-url out-dir))
+ (?x . ,extra-options)))))
+ (when (file-exists-p out-file)
+ (delete-file out-file))
+
+ (message "Executing %s" cmd)
+ (let ((cmd-output (shell-command-to-string cmd)))
+ (message "%s" cmd-output))
+
+ (cond
+ ((file-exists-p out-file)
+ (message "Exported to %s" out-file)
+ (when prefix-arg
+ (message "Opening %s..." out-file)
+ (org-open-file out-file 'system))
+ out-file)
+ (t
+ (message "Export to %s failed" out-file)
+ nil))))
+
+(defvar org-lparse-insert-tag-with-newlines 'both)
+
+;; Following variables are let-bound during `org-lparse'
+(defvar org-lparse-dyn-first-heading-pos)
+(defvar org-lparse-toc)
+(defvar org-lparse-entity-control-callbacks-alist)
+(defvar org-lparse-entity-format-callbacks-alist)
+(defvar org-lparse-backend nil
+ "The native backend to which the document is currently exported.
+This variable is let bound during `org-lparse'. Valid values are
+one of the symbols corresponding to `org-lparse-native-backends'.
+
+Compare this variable with `org-export-current-backend' which is
+bound only during `org-export-preprocess-string' stage of the
+export process.
+
+See also `org-lparse-other-backend'.")
+
+(defvar org-lparse-other-backend nil
+ "The target backend to which the document is currently exported.
+This variable is let bound during `org-lparse'. This variable is
+set to either `org-lparse-backend' or one of the symbols
+corresponding to OTHER-BACKENDS specification of the
+org-lparse-backend.
+
+For example, if a document is exported to \"odt\" then both
+org-lparse-backend and org-lparse-other-backend are bound to
+'odt. On the other hand, if a document is exported to \"odt\"
+and then converted to \"doc\" then org-lparse-backend is set to
+'odt and org-lparse-other-backend is set to 'doc.")
+
+(defvar org-lparse-body-only nil
+ "Bind this to BODY-ONLY arg of `org-lparse'.")
+
+(defvar org-lparse-to-buffer nil
+ "Bind this to TO-BUFFER arg of `org-lparse'.")
+
+(defun org-lparse-get-block-params (params)
+ (save-match-data
+ (when params
+ (setq params (org-trim params))
+ (unless (string-match "\\`(.*)\\'" params)
+ (setq params (format "(%s)" params)))
+ (ignore-errors (read params)))))
+
+(defvar org-heading-keyword-regexp-format) ; defined in org.el
+(defvar org-lparse-special-blocks '("list-table" "annotation"))
+(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
+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.
+ (when (and (not (or to-buffer body-only))
+ (not buffer-file-name))
+ (if (buffer-base-buffer)
+ (org-set-local 'buffer-file-name
+ (with-current-buffer (buffer-base-buffer)
+ buffer-file-name))
+ (error "Need a file name to be able to export")))
+
+ (org-lparse-warn
+ (format "Exporting to %s using org-lparse..."
+ (upcase (symbol-name
+ (or org-lparse-backend org-lparse-other-backend)))))
+
+ (setq-default org-todo-line-regexp org-todo-line-regexp)
+ (setq-default org-deadline-line-regexp org-deadline-line-regexp)
+ (setq-default org-done-keywords org-done-keywords)
+ (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
+ (let* (hfy-user-sheet-assoc ; let `htmlfontify' know that
+ ; we are interested in
+ ; collecting styles
+ org-lparse-encode-pending
+ org-lparse-par-open
+ (org-lparse-par-open-stashed 0)
+
+ ;; list related vars
+ (org-lparse-list-stack '())
+
+ ;; list-table related vars
+ org-lparse-list-table-p
+ org-lparse-list-table:table-cell-open
+ org-lparse-list-table:table-row
+ org-lparse-list-table:lines
+
+ org-lparse-outline-text-open
+ (org-lparse-latex-fragment-fallback ; currently used only by
+ ; odt exporter
+ (or (ignore-errors (org-lparse-get 'LATEX-FRAGMENT-FALLBACK))
+ (if (and (org-check-external-command "latex" "" t)
+ (org-check-external-command "dvipng" "" t))
+ 'dvipng
+ 'verbatim)))
+ (org-lparse-insert-tag-with-newlines 'both)
+ (org-lparse-to-buffer to-buffer)
+ (org-lparse-body-only body-only)
+ (org-lparse-entity-control-callbacks-alist
+ (org-lparse-get 'ENTITY-CONTROL))
+ (org-lparse-entity-format-callbacks-alist
+ (org-lparse-get 'ENTITY-FORMAT))
+ (opt-plist
+ (org-export-process-option-filters
+ (org-combine-plists (org-default-export-plist)
+ ext-plist
+ (org-infile-export-plist))))
+ (body-only (or body-only (plist-get opt-plist :body-only)))
+ valid org-lparse-dyn-first-heading-pos
+ (odd org-odd-levels-only)
+ (region-p (org-region-active-p))
+ (rbeg (and region-p (region-beginning)))
+ (rend (and region-p (region-end)))
+ (subtree-p
+ (if (plist-get opt-plist :ignore-subtree-p)
+ nil
+ (when region-p
+ (save-excursion
+ (goto-char rbeg)
+ (and (org-at-heading-p)
+ (>= (org-end-of-subtree t t) rend))))))
+ (level-offset (if subtree-p
+ (save-excursion
+ (goto-char rbeg)
+ (+ (funcall outline-level)
+ (if org-odd-levels-only 1 0)))
+ 0))
+ (opt-plist (setq org-export-opt-plist
+ (if subtree-p
+ (org-export-add-subtree-options opt-plist rbeg)
+ opt-plist)))
+ ;; The following two are dynamically scoped into other
+ ;; routines below.
+ (org-current-export-dir
+ (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist)))
+ (org-current-export-file buffer-file-name)
+ (level 0) (line "") (origline "") txt todo
+ (umax nil)
+ (umax-toc nil)
+ (filename (if to-buffer nil
+ (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (or (and subtree-p
+ (org-entry-get (region-beginning)
+ "EXPORT_FILE_NAME" t))
+ (file-name-nondirectory buffer-file-name)))
+ "." (org-lparse-get 'FILE-NAME-EXTENSION opt-plist))
+ (file-name-as-directory
+ (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist))))))
+ (current-dir (if buffer-file-name
+ (file-name-directory buffer-file-name)
+ default-directory))
+ (auto-insert nil) ; Avoid any auto-insert stuff for the new file
+ (buffer (if to-buffer
+ (cond
+ ((eq to-buffer 'string)
+ (get-buffer-create (org-lparse-get 'EXPORT-BUFFER-NAME)))
+ (t (get-buffer-create to-buffer)))
+ (find-file-noselect
+ (or (let ((f (org-lparse-get 'INIT-METHOD)))
+ (and f (functionp f) (funcall f filename)))
+ filename))))
+ (org-levels-open (make-vector org-level-max nil))
+ (dummy (mapc
+ (lambda(p)
+ (let* ((val (plist-get opt-plist p))
+ (val (org-xml-encode-org-text-skip-links val)))
+ (setq opt-plist (plist-put opt-plist p val))))
+ '(:date :author :keywords :description)))
+ (date (plist-get opt-plist :date))
+ (date (cond
+ ((and date (string-match "%" date))
+ (format-time-string date))
+ (date date)
+ (t (format-time-string "%Y-%m-%d %T %Z"))))
+ (dummy (setq opt-plist (plist-put opt-plist :effective-date date)))
+ (title (org-xml-encode-org-text-skip-links
+ (or (and subtree-p (org-export-get-title-from-subtree))
+ (plist-get opt-plist :title)
+ (and (not body-only)
+ (not
+ (plist-get opt-plist :skip-before-1st-heading))
+ (org-export-grab-title-from-buffer))
+ (and buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name)))
+ "UNTITLED")))
+ (dummy (setq opt-plist (plist-put opt-plist :title title)))
+ (html-table-tag (plist-get opt-plist :html-table-tag))
+ (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)"))
+ (quote-re (format org-heading-keyword-regexp-format
+ org-quote-string))
+ (org-lparse-dyn-current-environment nil)
+ ;; Get the language-dependent settings
+ (lang-words (or (assoc (plist-get opt-plist :language)
+ org-export-language-setup)
+ (assoc "en" org-export-language-setup)))
+ (dummy (setq opt-plist (plist-put opt-plist :lang-words lang-words)))
+ (head-count 0) cnt
+ (start 0)
+ (coding-system-for-write
+ (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-WRITE))
+ (and (boundp 'buffer-file-coding-system)
+ buffer-file-coding-system)))
+ (save-buffer-coding-system
+ (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-SAVE))
+ (and (boundp 'buffer-file-coding-system)
+ buffer-file-coding-system)))
+ (region
+ (buffer-substring
+ (if region-p (region-beginning) (point-min))
+ (if region-p (region-end) (point-max))))
+ (org-export-have-math nil)
+ (org-export-footnotes-seen nil)
+ (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
+ (org-footnote-insert-pos-for-preprocessor 'point-min)
+ (org-lparse-opt-plist opt-plist)
+ (lines
+ (org-split-string
+ (org-export-preprocess-string
+ region
+ :emph-multiline t
+ :for-backend (if (equal org-lparse-backend 'xhtml) ; hack
+ 'html
+ org-lparse-backend)
+ :skip-before-1st-heading
+ (plist-get opt-plist :skip-before-1st-heading)
+ :drawers (plist-get opt-plist :drawers)
+ :todo-keywords (plist-get opt-plist :todo-keywords)
+ :tasks (plist-get opt-plist :tasks)
+ :tags (plist-get opt-plist :tags)
+ :priority (plist-get opt-plist :priority)
+ :footnotes (plist-get opt-plist :footnotes)
+ :timestamps (plist-get opt-plist :timestamps)
+ :archived-trees
+ (plist-get opt-plist :archived-trees)
+ :select-tags (plist-get opt-plist :select-tags)
+ :exclude-tags (plist-get opt-plist :exclude-tags)
+ :add-text
+ (plist-get opt-plist :text)
+ :LaTeX-fragments
+ (plist-get opt-plist :LaTeX-fragments))
+ "[\r\n]"))
+ table-open
+ table-buffer table-orig-buffer
+ ind
+ rpl path attr desc descp desc1 desc2 link
+ snumber fnc
+ footnotes footref-seen
+ org-lparse-output-buffer
+ org-lparse-footnote-definitions
+ org-lparse-footnote-number
+ ;; collection
+ org-lparse-collect-buffer
+ (org-lparse-collect-count 0) ; things will get haywire if
+ ; collections are chained. Use
+ ; this variable to assert this
+ ; pre-requisite
+ org-lparse-toc
+ href
+ )
+
+ (let ((inhibit-read-only t))
+ (org-unmodified
+ (remove-text-properties (point-min) (point-max)
+ '(:org-license-to-kill t))))
+
+ (message "Exporting...")
+ (org-init-section-numbers)
+
+ ;; Switch to the output buffer
+ (setq org-lparse-output-buffer buffer)
+ (set-buffer org-lparse-output-buffer)
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (fundamental-mode)
+ (org-install-letbind)
+
+ (and (fboundp 'set-buffer-file-coding-system)
+ (set-buffer-file-coding-system coding-system-for-write))
+
+ (let ((case-fold-search nil)
+ (org-odd-levels-only odd))
+ ;; create local variables for all options, to make sure all called
+ ;; functions get the correct information
+ (mapc (lambda (x)
+ (set (make-local-variable (nth 2 x))
+ (plist-get opt-plist (car x))))
+ org-export-plist-vars)
+ (setq umax (if arg (prefix-numeric-value arg)
+ org-export-headline-levels))
+ (setq umax-toc (if (integerp org-export-with-toc)
+ (min org-export-with-toc umax)
+ umax))
+ (setq org-lparse-opt-plist
+ (plist-put org-lparse-opt-plist :headline-levels umax))
+
+ (when (and org-export-with-toc (not body-only))
+ (setq lines (org-lparse-prepare-toc
+ lines level-offset opt-plist umax-toc)))
+
+ (unless body-only
+ (org-lparse-begin 'DOCUMENT-CONTENT opt-plist)
+ (org-lparse-begin 'DOCUMENT-BODY opt-plist))
+
+ (setq head-count 0)
+ (org-init-section-numbers)
+
+ (org-lparse-begin-paragraph)
+
+ (while (setq line (pop lines) origline line)
+ (catch 'nextline
+ (when (and (org-lparse-current-environment-p 'quote)
+ (string-match org-outline-regexp-bol line))
+ (org-lparse-end-environment 'quote))
+
+ (when (org-lparse-current-environment-p 'quote)
+ (org-lparse-insert 'LINE line)
+ (throw 'nextline nil))
+
+ ;; Fixed-width, verbatim lines (examples)
+ (when (and org-export-with-fixed-width
+ (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
+ (when (not (org-lparse-current-environment-p 'fixedwidth))
+ (org-lparse-begin-environment 'fixedwidth))
+ (org-lparse-insert 'LINE (match-string 3 line))
+ (when (or (not lines)
+ (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
+ (car lines))))
+ (org-lparse-end-environment 'fixedwidth))
+ (throw 'nextline nil))
+
+ ;; Native Text
+ (when (and (get-text-property 0 'org-native-text line)
+ ;; Make sure it is the entire line that is protected
+ (not (< (or (next-single-property-change
+ 0 'org-native-text line) 10000)
+ (length line))))
+ (let ((ind (get-text-property 0 'original-indentation line)))
+ (org-lparse-begin-environment 'native)
+ (org-lparse-insert 'LINE line)
+ (while (and lines
+ (or (= (length (car lines)) 0)
+ (not ind)
+ (equal ind (get-text-property
+ 0 'original-indentation (car lines))))
+ (or (= (length (car lines)) 0)
+ (get-text-property 0 'org-native-text (car lines))))
+ (org-lparse-insert 'LINE (pop lines)))
+ (org-lparse-end-environment 'native))
+ (throw 'nextline nil))
+
+ ;; Protected HTML
+ (when (and (get-text-property 0 'org-protected 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 ((ind (get-text-property 0 'original-indentation line)))
+ (org-lparse-insert 'LINE line)
+ (while (and lines
+ (or (= (length (car lines)) 0)
+ (not ind)
+ (equal ind (get-text-property
+ 0 'original-indentation (car lines))))
+ (or (= (length (car lines)) 0)
+ (get-text-property 0 'org-protected (car lines))))
+ (org-lparse-insert 'LINE (pop lines))))
+ (throw 'nextline nil))
+
+ ;; Blockquotes, verse, and center
+ (when (string-match
+ "^ORG-\\(.+\\)-\\(START\\|END\\)\\([ \t]+.*\\)?$" line)
+ (let* ((style (intern (downcase (match-string 1 line))))
+ (env-options-plist (org-lparse-get-block-params
+ (match-string 3 line)))
+ (f (cdr (assoc (match-string 2 line)
+ '(("START" . org-lparse-begin-environment)
+ ("END" . org-lparse-end-environment))))))
+ (when (memq style
+ (append
+ '(blockquote verse center)
+ (mapcar 'intern org-lparse-special-blocks)))
+ (funcall f style env-options-plist)
+ (throw 'nextline nil))))
+
+ (when (org-lparse-current-environment-p 'verse)
+ (let ((i (org-get-string-indentation line)))
+ (if (> i 0)
+ (setq line (concat
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format 'SPACES (* 2 i)))
+ " " (org-trim line))))
+ (unless (string-match "\\\\\\\\[ \t]*$" line)
+ (setq line (concat line "\\\\")))))
+
+ ;; make targets to anchors
+ (setq start 0)
+ (while (string-match
+ "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
+ (cond
+ ((get-text-property (match-beginning 1) 'org-protected line)
+ (setq start (match-end 1)))
+ ((match-end 2)
+ (setq line (replace-match
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format
+ 'ANCHOR "" (org-solidify-link-text
+ (match-string 1 line))))
+ t t line)))
+ ((and org-export-with-toc (equal (string-to-char line) ?*))
+ ;; FIXME: NOT DEPENDENT on TOC?????????????????????
+ (setq line (replace-match
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format
+ 'FONTIFY (match-string 1 line) "target"))
+ ;; (concat "@<i>" (match-string 1 line) "@</i> ")
+ t t line)))
+ (t
+ (setq line (replace-match
+ (concat
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format
+ 'ANCHOR (match-string 1 line)
+ (org-solidify-link-text (match-string 1 line))
+ "target")) " ")
+ t t line)))))
+
+ (let ((org-lparse-encode-pending t))
+ (setq line (org-lparse-handle-time-stamps 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-xml-encode-org-text-skip-links line)))
+
+ (setq line (org-lparse-format-org-link line opt-plist))
+
+ ;; TODO items
+ (if (and org-todo-line-regexp
+ (string-match org-todo-line-regexp line)
+ (match-beginning 2))
+ (setq line (concat
+ (substring line 0 (match-beginning 2))
+ (org-lparse-format 'TODO (match-string 2 line))
+ (substring line (match-end 2)))))
+
+ ;; Does this contain a reference to a footnote?
+ (when org-export-with-footnotes
+ (setq start 0)
+ (while (string-match "\\([^* \t].*?\\)[ \t]*\\[\\([0-9]+\\)\\]" 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)))
+ (setq start (match-end 2))
+ (let ((n (match-string 2 line)) refcnt a)
+ (if (setq a (assoc n footref-seen))
+ (progn
+ (setcdr a (1+ (cdr a)))
+ (setq refcnt (cdr a)))
+ (setq refcnt 1)
+ (push (cons n 1) footref-seen))
+ (setq line
+ (replace-match
+ (concat
+ (or (match-string 1 line) "")
+ (org-lparse-format
+ 'FOOTNOTE-REFERENCE
+ n (cdr (assoc n org-lparse-footnote-definitions))
+ refcnt)
+ ;; If another footnote is following the
+ ;; current one, add a separator.
+ (if (save-match-data
+ (string-match "\\`\\[[0-9]+\\]"
+ (substring line (match-end 0))))
+ (ignore-errors
+ (org-lparse-get 'FOOTNOTE-SEPARATOR))
+ ""))
+ t t line))))))
+
+ (cond
+ ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line)
+ ;; This is a headline
+ (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
+ level-offset))
+ txt (match-string 2 line))
+ (if (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt)))
+ (if (<= level (max umax umax-toc))
+ (setq head-count (+ head-count 1)))
+ (unless org-lparse-dyn-first-heading-pos
+ (setq org-lparse-dyn-first-heading-pos (point)))
+ (org-lparse-begin-level level txt umax head-count)
+
+ ;; QUOTES
+ (when (string-match quote-re line)
+ (org-lparse-begin-environment 'quote)))
+
+ ((and org-export-with-tables
+ (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" 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)
+ table-orig-buffer (cons origline table-orig-buffer))
+ (when (or (not lines)
+ (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
+ (car lines))))
+ (setq table-open nil
+ table-buffer (nreverse table-buffer)
+ table-orig-buffer (nreverse table-orig-buffer))
+ (org-lparse-end-paragraph)
+ (when org-lparse-list-table-p
+ (error "Regular tables are not allowed in a list-table block"))
+ (org-lparse-insert 'TABLE table-buffer table-orig-buffer)))
+
+ ;; Normal lines
+ (t
+ ;; This line either is list item or end a list.
+ (when (get-text-property 0 'list-item line)
+ (setq line (org-lparse-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))))
+
+ ;; Horizontal line
+ (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
+ (with-org-lparse-preserve-paragraph-state
+ (org-lparse-insert 'HORIZONTAL-LINE))
+ (throw 'nextline nil))
+
+ ;; Empty lines start a new paragraph. If hand-formatted lists
+ ;; are not fully interpreted, lines starting with "-", "+", "*"
+ ;; also start a new paragraph.
+ (when (string-match "^ [-+*]-\\|^[ \t]*$" line)
+ (when org-lparse-footnote-number
+ (org-lparse-end-footnote-definition org-lparse-footnote-number)
+ (setq org-lparse-footnote-number nil))
+ (org-lparse-begin-paragraph))
+
+ ;; 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))
+ ;; ignore this line
+ (throw 'nextline nil))
+ (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
+ (org-lparse-end-paragraph)
+ (setq org-lparse-footnote-number (match-string 1 line))
+ (setq line (replace-match "" t t line))
+ (org-lparse-begin-footnote-definition org-lparse-footnote-number)))
+ ;; Check if the line break needs to be conserved
+ (cond
+ ((string-match "\\\\\\\\[ \t]*$" line)
+ (setq line (replace-match
+ (org-lparse-format 'LINE-BREAK)
+ t t line)))
+ (org-export-preserve-breaks
+ (setq line (concat line (org-lparse-format 'LINE-BREAK)))))
+
+ ;; Check if a paragraph should be started
+ (let ((start 0))
+ (while (and org-lparse-par-open
+ (string-match "\\\\par\\>" line start))
+ (error "FIXME")
+ ;; 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)))
+ (setq start (match-end 0))))
+
+ (org-lparse-insert 'LINE line)))))
+
+ ;; Properly close all local lists and other lists
+ (when (org-lparse-current-environment-p 'quote)
+ (org-lparse-end-environment 'quote))
+
+ (org-lparse-end-level 1 umax)
+
+ ;; the </div> to close the last text-... div.
+ (when (and (> umax 0) org-lparse-dyn-first-heading-pos)
+ (org-lparse-end-outline-text-or-outline))
+
+ (org-lparse-end 'DOCUMENT-BODY opt-plist)
+ (unless body-only
+ (org-lparse-end 'DOCUMENT-CONTENT))
+
+ (org-lparse-end 'EXPORT)
+
+ ;; kill collection buffer
+ (when org-lparse-collect-buffer
+ (kill-buffer org-lparse-collect-buffer))
+
+ (goto-char (point-min))
+ (or (org-export-push-to-kill-ring
+ (upcase (symbol-name org-lparse-backend)))
+ (message "Exporting... done"))
+
+ (cond
+ ((not to-buffer)
+ (let ((f (org-lparse-get 'SAVE-METHOD)))
+ (or (and f (functionp f) (funcall f filename opt-plist))
+ (save-buffer)))
+ (or (and (boundp 'org-lparse-other-backend)
+ org-lparse-other-backend
+ (not (equal org-lparse-backend org-lparse-other-backend))
+ (org-lparse-do-convert
+ buffer-file-name (symbol-name org-lparse-other-backend)))
+ (current-buffer)))
+ ((eq to-buffer 'string)
+ (prog1 (buffer-substring (point-min) (point-max))
+ (kill-buffer (current-buffer))))
+ (t (current-buffer))))))
+
+(defun org-lparse-format-table (lines olines)
+ "Returns backend-specific code for org-type and table-type tables."
+ (if (stringp lines)
+ (setq lines (org-split-string lines "\n")))
+ (if (string-match "^[ \t]*|" (car lines))
+ ;; A normal org table
+ (org-lparse-format-org-table lines nil)
+ ;; Table made by table.el
+ (or (org-lparse-format-table-table-using-table-generate-source
+ ;; FIXME: Need to take care of this during merge
+ (if (eq org-lparse-backend 'xhtml) 'html org-lparse-backend)
+ olines
+ (not org-export-prefer-native-exporter-for-tables))
+ ;; We are here only when table.el table has NO col or row
+ ;; spanning and the user prefers using org's own converter for
+ ;; exporting of such simple table.el tables.
+ (org-lparse-format-table-table lines))))
+
+(defun org-lparse-table-get-colalign-info (lines)
+ (let ((col-cookies (org-find-text-property-in-string
+ '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)))
+ col-cookies))
+
+(defvar org-lparse-table-style)
+(defvar org-lparse-table-ncols)
+(defvar org-lparse-table-rownum)
+(defvar org-lparse-table-is-styled)
+(defvar org-lparse-table-begin-marker)
+(defvar org-lparse-table-num-numeric-items-per-column)
+(defvar org-lparse-table-colalign-info)
+(defvar org-lparse-table-colalign-vector)
+
+;; Following variables are defined in org-table.el
+(defvar org-table-number-fraction)
+(defvar org-table-number-regexp)
+(defun org-lparse-org-table-to-list-table (lines &optional splice)
+ "Convert org-table to list-table.
+LINES is a list of the form (ROW1 ROW2 ROW3 ...) where each
+element is a `string' representing a single row of org-table.
+Thus each ROW has vertical separators \"|\" separating the table
+fields. A ROW could also be a row-group separator of the form
+\"|---...|\". Return a list of the form (ROW1 ROW2 ROW3
+...). ROW could either be symbol `:hrule' or a list of the
+form (FIELD1 FIELD2 FIELD3 ...) as appropriate."
+ (let (line lines-1)
+ (cond
+ (splice
+ (while (setq line (pop lines))
+ (unless (string-match "^[ \t]*|-" line)
+ (push (org-split-string line "[ \t]*|[ \t]*") lines-1))))
+ (t
+ (while (setq line (pop lines))
+ (cond
+ ((string-match "^[ \t]*|-" line)
+ (when lines
+ (push :hrule lines-1)))
+ (t
+ (push (org-split-string line "[ \t]*|[ \t]*") lines-1))))))
+ (nreverse lines-1)))
+
+(defun org-lparse-insert-org-table (lines &optional splice)
+ "Format a org-type table into backend-specific code.
+LINES is a list of lines. Optional argument SPLICE means, do not
+insert header and surrounding <table> tags, just format the lines.
+Optional argument NO-CSS means use XHTML attributes instead of CSS
+for formatting. This is required for the DocBook exporter."
+ (require 'org-table)
+ ;; Get rid of hlines at beginning and end
+ (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
+ (setq lines (nreverse lines))
+ (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
+ (setq lines (nreverse lines))
+ (when org-export-table-remove-special-lines
+ ;; Check if the table has a marking column. If yes remove the
+ ;; 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
+ (car lines)))
+ (head (and org-export-highlight-first-table-line
+ (delq nil (mapcar
+ (lambda (x) (string-match "^[ \t]*|-" x))
+ (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
+ short-caption)))
+
+(defun org-lparse-insert-list-table (lines &optional splice
+ 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)
+ tbopen fields line
+ org-lparse-table-cur-rowgrp-is-hdr
+ org-lparse-table-rowgrp-open
+ org-lparse-table-num-numeric-items-per-column
+ org-lparse-table-colalign-vector n
+ org-lparse-table-rowgrp-info
+ org-lparse-table-begin-marker
+ (org-lparse-table-style 'org-table)
+ org-lparse-table-is-styled)
+ (cond
+ (splice
+ (setq org-lparse-table-is-styled nil)
+ (while (setq line (pop lines))
+ (insert (org-lparse-format-table-row line) "\n")))
+ (t
+ (setq org-lparse-table-is-styled t)
+ (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))
+ (cond
+ ((equal line :hrule)
+ (org-lparse-begin-table-rowgroup))
+ (t
+ (insert (org-lparse-format-table-row line) "\n"))))
+ (org-lparse-end 'TABLE-ROWGROUP)
+ (org-lparse-end-table)))))
+
+(defun org-lparse-format-org-table (lines &optional splice)
+ (with-temp-buffer
+ (org-lparse-insert-org-table lines splice)
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+(defun org-lparse-format-list-table (lines &optional splice)
+ (with-temp-buffer
+ (org-lparse-insert-list-table lines splice)
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+(defun org-lparse-insert-table-table (lines)
+ "Format a table generated by table.el into backend-specific code.
+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
+ (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 short-caption)
+ (while (setq line (pop lines))
+ (cond
+ ((string-match "^[ \t]*\\+-" line)
+ (when field-buffer
+ (let ((org-export-table-row-tags '("<tr>" . "</tr>"))
+ ;; (org-export-html-table-use-header-tags-for-first-column nil)
+ )
+ (insert (org-lparse-format-table-row field-buffer empty)))
+ (setq org-lparse-table-cur-rowgrp-is-hdr nil)
+ (setq field-buffer nil)))
+ (t
+ ;; Break the line into fields and store the fields
+ (setq fields (org-split-string line "[ \t]*|[ \t]*"))
+ (if field-buffer
+ (setq field-buffer (mapcar
+ (lambda (x)
+ (concat x (org-lparse-format 'LINE-BREAK)
+ (pop fields)))
+ field-buffer))
+ (setq field-buffer fields)))))
+ (org-lparse-end-table)))
+
+(defun org-lparse-format-table-table (lines)
+ (with-temp-buffer
+ (org-lparse-insert-table-table lines)
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+(defvar table-source-languages) ; defined in table.el
+(defun org-lparse-format-table-table-using-table-generate-source (backend
+ 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.
+
+When SPANNED-ONLY is nil, all table.el tables are exported. When
+SPANNED-ONLY is non-nil, only tables with either row or column
+spans are exported.
+
+This routine returns the generated source or nil as appropriate.
+
+Refer docstring of `org-export-prefer-native-exporter-for-tables'
+for further information."
+ (require 'table)
+ (with-current-buffer (get-buffer-create " org-tmp1 ")
+ (erase-buffer)
+ (insert (mapconcat 'identity lines "\n"))
+ (goto-char (point-min))
+ (if (not (re-search-forward "|[^+]" nil t))
+ (error "Error processing table"))
+ (table-recognize-table)
+ (when (or (not spanned-only)
+ (let* ((dim (table-query-dimension))
+ (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim)))
+ (not (= (* c r) cells))))
+ (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
+ (cond
+ ((member backend table-source-languages)
+ (table-generate-source backend " org-tmp2 ")
+ (set-buffer " org-tmp2 ")
+ (buffer-substring (point-min) (point-max)))
+ (t
+ ;; 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
+ ;; the table as ascii text in the output document.
+ (org-lparse-warn
+ (concat
+ "Found table.el-type table in the source org file. "
+ (format "table.el doesn't support %s backend. "
+ (upcase (symbol-name backend)))
+ "Skipping ahead ..."))
+ "")))))
+
+(defun org-lparse-handle-time-stamps (s)
+ "Format time stamps in string S, or remove them."
+ (catch 'exit
+ (let (r b)
+ (when org-maybe-keyword-time-regexp
+ (while (string-match org-maybe-keyword-time-regexp s)
+ (or b (setq b (substring s 0 (match-beginning 0))))
+ (setq r (concat
+ r (substring s 0 (match-beginning 0)) " "
+ (org-lparse-format
+ 'FONTIFY
+ (concat
+ (if (match-end 1)
+ (org-lparse-format
+ 'FONTIFY
+ (match-string 1 s) "timestamp-kwd"))
+ " "
+ (org-lparse-format
+ 'FONTIFY
+ (substring (org-translate-time (match-string 3 s)) 1 -1)
+ "timestamp"))
+ "timestamp-wrapper"))
+ s (substring s (match-end 0)))))
+
+ ;; Line break if line started and ended with time stamp stuff
+ (if (not r)
+ s
+ (setq r (concat r s))
+ (unless (string-match "\\S-" (concat b s))
+ (setq r (concat r (org-lparse-format 'LINE-BREAK))))
+ r))))
+
+(defun org-xml-encode-plain-text (s)
+ "Convert plain text characters to HTML equivalent.
+Possible conversions are set in `org-export-html-protect-char-alist'."
+ (let ((cl (org-lparse-get 'PLAIN-TEXT-MAP)) c)
+ (while (setq c (pop cl))
+ (let ((start 0))
+ (while (string-match (car c) s start)
+ (setq s (replace-match (cdr c) t t s)
+ start (1+ (match-beginning 0))))))
+ s))
+
+(defun org-xml-encode-org-text-skip-links (string)
+ "Prepare STRING for HTML export. Apply all active conversions.
+If there are links in the string, don't modify these. If STRING
+is nil, return nil."
+ (when string
+ (let* ((re (concat org-bracket-link-regexp "\\|"
+ (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
+ m s l res)
+ (while (setq m (string-match re string))
+ (setq s (substring string 0 m)
+ l (match-string 0 string)
+ string (substring string (match-end 0)))
+ (push (org-xml-encode-org-text s) res)
+ (push l res))
+ (push (org-xml-encode-org-text string) res)
+ (apply 'concat (nreverse res)))))
+
+(defun org-xml-encode-org-text (s)
+ "Apply all active conversions to translate special ASCII to HTML."
+ (setq s (org-xml-encode-plain-text s))
+ (if org-export-html-expand
+ (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
+ (setq s (replace-match "<\\1>" t nil s))))
+ (if org-export-with-emphasize
+ (setq s (org-lparse-apply-char-styles s)))
+ (if org-export-with-special-strings
+ (setq s (org-lparse-convert-special-strings s)))
+ (if org-export-with-sub-superscripts
+ (setq s (org-lparse-apply-sub-superscript-styles s)))
+ (if org-export-with-TeX-macros
+ (let ((start 0) wd rep)
+ (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?"
+ s start))
+ (if (get-text-property (match-beginning 0) 'org-protected s)
+ (setq start (match-end 0))
+ (setq wd (match-string 1 s))
+ (if (setq rep (org-lparse-format 'ORG-ENTITY wd))
+ (setq s (replace-match rep t t s))
+ (setq start (+ start (length wd))))))))
+ s)
+
+(defun org-lparse-convert-special-strings (string)
+ "Convert special characters in STRING to HTML."
+ (let ((all (org-lparse-get 'SPECIAL-STRING-REGEXPS))
+ e a re rpl start)
+ (while (setq a (pop all))
+ (setq re (car a) rpl (cdr a) start 0)
+ (while (string-match re string start)
+ (if (get-text-property (match-beginning 0) 'org-protected string)
+ (setq start (match-end 0))
+ (setq string (replace-match rpl t nil string)))))
+ string))
+
+(defun org-lparse-apply-sub-superscript-styles (string)
+ "Apply subscript and superscript styles to STRING.
+Use `org-export-with-sub-superscripts' to control application of
+sub and superscript styles."
+ (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
+ (while (string-match org-match-substring-regexp string s)
+ (cond
+ ((and requireb (match-end 8)) (setq s (match-end 2)))
+ ((get-text-property (match-beginning 2) 'org-protected string)
+ (setq s (match-end 2)))
+ (t
+ (setq s (match-end 1)
+ key (if (string= (match-string 2 string) "_")
+ 'subscript 'superscript)
+ c (or (match-string 8 string)
+ (match-string 6 string)
+ (match-string 5 string))
+ string (replace-match
+ (concat (match-string 1 string)
+ (org-lparse-format 'FONTIFY c key))
+ t t string)))))
+ (while (string-match "\\\\\\([_^]\\)" string)
+ (setq string (replace-match (match-string 1 string) t t string)))
+ string))
+
+(defvar org-lparse-char-styles
+ `(("*" bold)
+ ("/" emphasis)
+ ("_" underline)
+ ("=" code)
+ ("~" verbatim)
+ ("+" strike))
+ "Map Org emphasis markers to char styles.
+This is an alist where each element is of the
+form (ORG-EMPHASIS-CHAR . CHAR-STYLE).")
+
+(defun org-lparse-apply-char-styles (string)
+ "Apply char styles to STRING.
+The variable `org-lparse-char-styles' controls how the Org
+emphasis markers are interpreted."
+ (let ((s 0) rpl)
+ (while (string-match org-emph-re string s)
+ (if (not (equal
+ (substring string (match-beginning 3) (1+ (match-beginning 3)))
+ (substring string (match-beginning 4) (1+ (match-beginning 4)))))
+ (setq s (match-beginning 0)
+ rpl
+ (concat
+ (match-string 1 string)
+ (org-lparse-format
+ 'FONTIFY (match-string 4 string)
+ (nth 1 (assoc (match-string 3 string)
+ org-lparse-char-styles)))
+ (match-string 5 string))
+ string (replace-match rpl t t string)
+ s (+ s (- (length rpl) 2)))
+ (setq s (1+ s))))
+ string))
+
+(defun org-lparse-export-list-line (line pos struct prevs)
+ "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
+the alist of previous items."
+ (let* ((get-type
+ (function
+ ;; Translate type of list containing POS to "d", "o" or
+ ;; "u".
+ (lambda (pos struct prevs)
+ (let ((type (org-list-get-list-type pos struct prevs)))
+ (cond
+ ((eq 'ordered type) "o")
+ ((eq 'descriptive type) "d")
+ (t "u"))))))
+ (get-closings
+ (function
+ ;; Return list of all items and sublists ending at POS, in
+ ;; reverse order.
+ (lambda (pos)
+ (let (out)
+ (catch 'exit
+ (mapc (lambda (e)
+ (let ((end (nth 6 e))
+ (item (car e)))
+ (cond
+ ((= end pos) (push item out))
+ ((>= item pos) (throw 'exit nil)))))
+ struct))
+ out)))))
+ ;; First close any previous item, or list, ending at POS.
+ (mapc (lambda (e)
+ (let* ((lastp (= (org-list-get-last-item e struct prevs) e))
+ (first-item (org-list-get-list-begin e struct prevs))
+ (type (funcall get-type first-item struct prevs)))
+ (org-lparse-end-paragraph)
+ ;; Ending for every item
+ (org-lparse-end-list-item-1 type)
+ ;; We're ending last item of the list: end list.
+ (when lastp
+ (org-lparse-end-list type)
+ (org-lparse-begin-paragraph))))
+ (funcall get-closings pos))
+ (cond
+ ;; At an item: insert appropriate tags in export buffer.
+ ((assq pos struct)
+ (string-match
+ (concat "[ \t]*\\(\\S-+[ \t]*\\)"
+ "\\(?:\\[@\\(?: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) ""))
+ (list-beg (org-list-get-list-begin pos struct prevs))
+ (firstp (= list-beg pos))
+ ;; Always refer to first item to determine list type, in
+ ;; case list is ill-formed.
+ (type (funcall get-type list-beg struct prevs))
+ (counter (let ((count-tmp (org-list-get-counter pos struct)))
+ (cond
+ ((not count-tmp) nil)
+ ((string-match "[A-Za-z]" count-tmp)
+ (- (string-to-char (upcase count-tmp)) 64))
+ ((string-match "[0-9]+" count-tmp)
+ count-tmp)))))
+ (when firstp
+ (org-lparse-end-paragraph)
+ (org-lparse-begin-list type))
+
+ (let ((arg (cond ((equal type "d") desc-tag)
+ ((equal type "o") counter))))
+ (org-lparse-begin-list-item type arg))
+
+ ;; If line had a checkbox, some additional modification is required.
+ (when checkbox
+ (setq body
+ (concat
+ (org-lparse-format
+ 'FONTIFY (concat
+ "["
+ (cond
+ ((string-match "X" checkbox) "X")
+ ((string-match " " checkbox)
+ (org-lparse-format 'SPACES 1))
+ (t "-"))
+ "]")
+ 'code)
+ " "
+ body)))
+ ;; Return modified line
+ body))
+ ;; At a list ender: go to next line (side-effects only).
+ ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil))
+ ;; Not at an item: return line unchanged (side-effects only).
+ (t line))))
+
+(defun org-lparse-bind-local-variables (opt-plist)
+ (mapc (lambda (x)
+ (set (make-local-variable (nth 2 x))
+ (plist-get opt-plist (car x))))
+ org-export-plist-vars))
+
+(defvar org-lparse-table-rowgrp-open)
+(defvar org-lparse-table-cur-rowgrp-is-hdr)
+(defvar org-lparse-footnote-number)
+(defvar org-lparse-footnote-definitions)
+(defvar org-lparse-output-buffer nil
+ "Buffer to which `org-do-lparse' writes to.
+This buffer contains the contents of the to-be-created exported
+document.")
+
+(defcustom org-lparse-debug nil
+ "Enable or Disable logging of `org-lparse' callbacks.
+The parameters passed to the backend-registered ENTITY-CONTROL
+and ENTITY-FORMAT callbacks are logged as comment strings in the
+exported buffer. (org-lparse-format 'COMMENT fmt args) is used
+for logging. Customize this variable only if you are an expert
+user. Valid values of this variable are:
+nil : Disable logging
+control : Log all invocations of `org-lparse-begin' and
+ `org-lparse-end' callbacks.
+format : Log invocations of `org-lparse-format' callbacks.
+t : Log all invocations of `org-lparse-begin', `org-lparse-end'
+ and `org-lparse-format' callbacks,"
+ :group 'org-lparse
+ :type '(choice
+ (const :tag "Disable" nil)
+ (const :tag "Format callbacks" format)
+ (const :tag "Control callbacks" control)
+ (const :tag "Format and Control callbacks" t)))
+
+(defun org-lparse-begin (entity &rest args)
+ "Begin ENTITY in current buffer. ARGS is entity specific.
+ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM etc.
+
+Use (org-lparse-begin 'LIST \"o\") to begin a list in current
+buffer.
+
+See `org-xhtml-entity-control-callbacks-alist' for more
+information."
+ (when (and (member org-lparse-debug '(t control))
+ (not (eq entity 'DOCUMENT-CONTENT)))
+ (insert (org-lparse-format 'COMMENT "%s BEGIN %S" entity args)))
+
+ (let ((f (cadr (assoc entity org-lparse-entity-control-callbacks-alist))))
+ (unless f (error "Unknown entity: %s" entity))
+ (apply f args)))
+
+(defun org-lparse-end (entity &rest args)
+ "Close ENTITY in current buffer. ARGS is entity specific.
+ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM
+etc.
+
+Use (org-lparse-end 'LIST \"o\") to close a list in current
+buffer.
+
+See `org-xhtml-entity-control-callbacks-alist' for more
+information."
+ (when (and (member org-lparse-debug '(t control))
+ (not (eq entity 'DOCUMENT-CONTENT)))
+ (insert (org-lparse-format 'COMMENT "%s END %S" entity args)))
+
+ (let ((f (caddr (assoc entity org-lparse-entity-control-callbacks-alist))))
+ (unless f (error "Unknown entity: %s" entity))
+ (apply f args)))
+
+(defun org-lparse-begin-paragraph (&optional style)
+ "Insert <p>, but first close previous paragraph if any."
+ (org-lparse-end-paragraph)
+ (org-lparse-begin 'PARAGRAPH style)
+ (setq org-lparse-par-open t))
+
+(defun org-lparse-end-paragraph ()
+ "Close paragraph if there is one open."
+ (when org-lparse-par-open
+ (org-lparse-end 'PARAGRAPH)
+ (setq org-lparse-par-open nil)))
+
+(defun org-lparse-end-list-item-1 (&optional type)
+ "Close <li> if necessary."
+ (org-lparse-end-paragraph)
+ (org-lparse-end-list-item (or type "u")))
+
+(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
+ "^[ \t]*#\\+\\(begin\\|end\\)_\\(\\S-+\\)[ \t]*\\(.*\\)$" nil t)
+ (when (member (downcase (match-string 2)) org-lparse-special-blocks)
+ (replace-match
+ (if (equal (downcase (match-string 1)) "begin")
+ (format "ORG-%s-START %s" (upcase (match-string 2))
+ (match-string 3))
+ (format "ORG-%s-END %s" (upcase (match-string 2))
+ (match-string 3))) t t))))
+
+(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 ()
+ "Strip \"list-table\" and \"annotation\" blocks.
+Stripping happens only when the exported backend is not one of
+\"odt\" or \"xhtml\"."
+ (when (not org-lparse-backend)
+ (message "Stripping following blocks - %S" org-lparse-special-blocks)
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (while
+ (re-search-forward
+ "^[ \t]*#\\+begin_\\(\\S-+\\)\\([ \t]+.*\\)?\n\\([^\000]*?\\)\n[ \t]*#\\+end_\\1\\>.*"
+ nil t)
+ (when (member (match-string 1) org-lparse-special-blocks)
+ (replace-match "" t t))))))
+
+(defvar org-lparse-list-table-p nil
+ "Non-nil if `org-do-lparse' is within a list-table.")
+
+(defvar org-lparse-dyn-current-environment nil)
+(defun org-lparse-begin-environment (style &optional env-options-plist)
+ (case style
+ (list-table
+ (setq org-lparse-list-table-p t))
+ (t (setq org-lparse-dyn-current-environment style)
+ (org-lparse-begin 'ENVIRONMENT style env-options-plist))))
+
+(defun org-lparse-end-environment (style &optional env-options-plist)
+ (case style
+ (list-table
+ (setq org-lparse-list-table-p nil))
+ (t (org-lparse-end 'ENVIRONMENT style env-options-plist)
+ (setq org-lparse-dyn-current-environment nil))))
+
+(defun org-lparse-current-environment-p (style)
+ (eq org-lparse-dyn-current-environment style))
+
+(defun org-lparse-begin-footnote-definition (n)
+ (org-lparse-begin-collect)
+ (setq org-lparse-insert-tag-with-newlines nil)
+ (org-lparse-begin 'FOOTNOTE-DEFINITION n))
+
+(defun org-lparse-end-footnote-definition (n)
+ (org-lparse-end 'FOOTNOTE-DEFINITION n)
+ (setq org-lparse-insert-tag-with-newlines 'both)
+ (let ((footnote-def (org-lparse-end-collect)))
+ ;; Cleanup newlines in footnote definition. This ensures that a
+ ;; transcoded line is never (wrongly) broken in to multiple lines.
+ (let ((pos 0))
+ (while (string-match "[\r\n]+" footnote-def pos)
+ (setq pos (1+ (match-beginning 0)))
+ (setq footnote-def (replace-match " " t t footnote-def))))
+ (push (cons n footnote-def) org-lparse-footnote-definitions)))
+
+(defvar org-lparse-collect-buffer nil
+ "An auxiliary buffer named \"*Org Lparse Collect*\".
+`org-do-lparse' uses this as output buffer while collecting
+footnote definitions and table-cell contents of list-tables. See
+`org-lparse-begin-collect' and `org-lparse-end-collect'.")
+
+(defvar org-lparse-collect-count nil
+ "Count number of calls to `org-lparse-begin-collect'.
+Use this counter to catch chained collections if they ever
+happen.")
+
+(defun org-lparse-begin-collect ()
+ "Temporarily switch to `org-lparse-collect-buffer'.
+Also erase it's contents."
+ (unless (zerop org-lparse-collect-count)
+ (error "FIXME (org-lparse.el): Encountered chained collections"))
+ (incf org-lparse-collect-count)
+ (unless org-lparse-collect-buffer
+ (setq org-lparse-collect-buffer
+ (get-buffer-create "*Org Lparse Collect*")))
+ (set-buffer org-lparse-collect-buffer)
+ (erase-buffer))
+
+(defun org-lparse-end-collect ()
+ "Switch to `org-lparse-output-buffer'.
+Return contents of `org-lparse-collect-buffer' as a `string'."
+ (assert (> org-lparse-collect-count 0))
+ (decf org-lparse-collect-count)
+ (prog1 (buffer-string)
+ (erase-buffer)
+ (set-buffer org-lparse-output-buffer)))
+
+(defun org-lparse-format (entity &rest args)
+ "Format ENTITY in backend-specific way and return it.
+ARGS is specific to entity being formatted.
+
+Use (org-lparse-format 'HEADING \"text\" 1) to format text as
+level 1 heading.
+
+See `org-xhtml-entity-format-callbacks-alist' for more information."
+ (when (and (member org-lparse-debug '(t format))
+ (not (equal entity 'COMMENT)))
+ (insert (org-lparse-format 'COMMENT "%s: %S" entity args)))
+ (cond
+ ((consp entity)
+ (let ((text (pop args)))
+ (apply 'org-lparse-format 'TAGS entity text args)))
+ (t
+ (let ((f (cdr (assoc entity org-lparse-entity-format-callbacks-alist))))
+ (unless f (error "Unknown entity: %s" entity))
+ (apply f args)))))
+
+(defun org-lparse-insert (entity &rest args)
+ (insert (apply 'org-lparse-format entity args)))
+
+(defun org-lparse-prepare-toc (lines level-offset opt-plist umax-toc)
+ (let* ((quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
+ (org-min-level (org-get-min-level lines level-offset))
+ (org-last-level org-min-level)
+ level)
+ (with-temp-buffer
+ (org-lparse-bind-local-variables opt-plist)
+ (erase-buffer)
+ (org-lparse-begin 'TOC (nth 3 (plist-get opt-plist :lang-words)) umax-toc)
+ (setq
+ lines
+ (mapcar
+ #'(lambda (line)
+ (when (and (string-match org-todo-line-regexp line)
+ (not (get-text-property 0 'org-protected line))
+ (<= (setq level (org-tr-level
+ (- (match-end 1) (match-beginning 1)
+ level-offset)))
+ umax-toc))
+ (let ((txt (save-match-data
+ (org-xml-encode-org-text-skip-links
+ (org-export-cleanup-toc-line
+ (match-string 3 line)))))
+ (todo (and
+ org-export-mark-todo-in-toc
+ (or (and (match-beginning 2)
+ (not (member (match-string 2 line)
+ org-done-keywords)))
+ (and (= level umax-toc)
+ (org-search-todo-below
+ line lines level)))))
+ tags)
+ ;; Check for targets
+ (while (string-match org-any-target-regexp line)
+ (setq line
+ (replace-match
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format 'FONTIFY
+ (match-string 1 line) "target"))
+ t t line)))
+ (when (string-match
+ (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
+ (setq tags (match-string 1 txt)
+ txt (replace-match "" t nil txt)))
+ (when (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt)))
+ (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
+ (setq txt (replace-match "" t t txt)))
+ (org-lparse-format
+ 'TOC-ITEM
+ (let* ((snumber (org-section-number level))
+ (href (replace-regexp-in-string
+ "\\." "-" (format "sec-%s" snumber)))
+ (href
+ (or
+ (cdr (assoc
+ href org-export-preferred-target-alist))
+ href))
+ (href (org-solidify-link-text href)))
+ (org-lparse-format 'TOC-ENTRY snumber todo txt tags href))
+ level org-last-level)
+ (setq org-last-level level)))
+ line)
+ lines))
+ (org-lparse-end 'TOC)
+ (setq org-lparse-toc (buffer-string))))
+ lines)
+
+(defun org-lparse-format-table-row (fields &optional text-for-empty-fields)
+ (if org-lparse-table-ncols
+ ;; second and subsequent rows of the table
+ (when (and org-lparse-list-table-p
+ (> (length fields) org-lparse-table-ncols))
+ (error "Table row has %d columns but header row claims %d columns"
+ (length fields) org-lparse-table-ncols))
+ ;; first row of the table
+ (setq org-lparse-table-ncols (length fields))
+ (when org-lparse-table-is-styled
+ (setq org-lparse-table-num-numeric-items-per-column
+ (make-vector org-lparse-table-ncols 0))
+ (setq org-lparse-table-colalign-vector
+ (make-vector org-lparse-table-ncols nil))
+ (let ((c -1))
+ (while (< (incf c) org-lparse-table-ncols)
+ (let* ((col-cookie (cdr (assoc (1+ c) org-lparse-table-colalign-info)))
+ (align (nth 0 col-cookie)))
+ (setf (aref org-lparse-table-colalign-vector c)
+ (cond
+ ((string= align "l") "left")
+ ((string= align "r") "right")
+ ((string= align "c") "center"))))))))
+ (incf org-lparse-table-rownum)
+ (let ((i -1))
+ (org-lparse-format
+ 'TABLE-ROW
+ (mapconcat
+ (lambda (x)
+ (when (and (string= x "") text-for-empty-fields)
+ (setq x text-for-empty-fields))
+ (incf i)
+ (let (col-cookie horiz-span)
+ (when org-lparse-table-is-styled
+ (when (and (< i org-lparse-table-ncols)
+ (string-match org-table-number-regexp x))
+ (incf (aref org-lparse-table-num-numeric-items-per-column i)))
+ (setq col-cookie (cdr (assoc (1+ i) org-lparse-table-colalign-info))
+ horiz-span (nth 1 col-cookie)))
+ (org-lparse-format
+ 'TABLE-CELL x org-lparse-table-rownum i (or horiz-span 0))))
+ fields "\n"))))
+
+(defun org-lparse-get (what &optional opt-plist)
+ "Query for value of WHAT for the current backend `org-lparse-backend'.
+See also `org-lparse-backend-get'."
+ (if (boundp 'org-lparse-backend)
+ (org-lparse-backend-get (symbol-name org-lparse-backend) what opt-plist)
+ (error "org-lparse-backend is not bound yet")))
+
+(defun org-lparse-backend-get (backend what &optional opt-plist)
+ "Query BACKEND for value of WHAT.
+Dispatch the call to `org-<backend>-user-get'. If that throws an
+error, dispatch the call to `org-<backend>-get'. See
+`org-xhtml-get' for all known settings queried for by
+`org-lparse' during the course of export."
+ (assert (stringp backend) t)
+ (unless (org-lparse-backend-is-native-p backend)
+ (error "Unknown native backend %s" backend))
+ (let ((backend-get-method (intern (format "org-%s-get" backend)))
+ (backend-user-get-method (intern (format "org-%s-user-get" backend))))
+ (cond
+ ((functionp backend-get-method)
+ (condition-case nil
+ (funcall backend-user-get-method what opt-plist)
+ (error (funcall backend-get-method what opt-plist))))
+ (t
+ (error "Native backend %s doesn't define %s" backend backend-get-method)))))
+
+(defun org-lparse-insert-tag (tag &rest args)
+ (when (member org-lparse-insert-tag-with-newlines '(lead both))
+ (insert "\n"))
+ (insert (apply 'format tag args))
+ (when (member org-lparse-insert-tag-with-newlines '(trail both))
+ (insert "\n")))
+
+(defun org-lparse-get-targets-from-title (title)
+ (let* ((target (org-get-text-property-any 0 'target title))
+ (extra-targets (assoc target org-export-target-aliases))
+ (target (or (cdr (assoc target org-export-preferred-target-alist))
+ target)))
+ (cons target (remove target extra-targets))))
+
+(defun org-lparse-suffix-from-snumber (snumber)
+ (let* ((snu (replace-regexp-in-string "\\." "-" snumber))
+ (href (cdr (assoc (concat "sec-" snu)
+ org-export-preferred-target-alist))))
+ (org-solidify-link-text (or href snu))))
+
+(defun org-lparse-begin-level (level title umax head-count)
+ "Insert a new LEVEL in HTML export.
+When TITLE is nil, just close all open levels."
+ (org-lparse-end-level level umax)
+ (unless title (error "Why is heading nil"))
+ (let* ((targets (org-lparse-get-targets-from-title title))
+ (target (car targets)) (extra-targets (cdr targets))
+ (target (and target (org-solidify-link-text target)))
+ (extra-class (org-get-text-property-any 0 'html-container-class title))
+ snumber tags level1 class)
+ (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
+ (setq tags (and org-export-with-tags (match-string 1 title)))
+ (setq title (replace-match "" t t title)))
+ (if (> level umax)
+ (progn
+ (if (aref org-levels-open (1- level))
+ (org-lparse-end-list-item-1)
+ (aset org-levels-open (1- level) t)
+ (org-lparse-end-paragraph)
+ (org-lparse-begin-list 'unordered))
+ (org-lparse-begin-list-item
+ 'unordered target (org-lparse-format
+ 'HEADLINE title extra-targets tags)))
+ (aset org-levels-open (1- level) t)
+ (setq snumber (org-section-number level))
+ (setq level1 (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))
+ (unless (= head-count 1)
+ (org-lparse-end-outline-text-or-outline))
+ (org-lparse-begin-outline-and-outline-text
+ level1 snumber title tags target extra-targets extra-class)
+ (org-lparse-begin-paragraph))))
+
+(defun org-lparse-end-level (level umax)
+ (org-lparse-end-paragraph)
+ (loop for l from org-level-max downto level
+ do (when (aref org-levels-open (1- l))
+ ;; Terminate one level in HTML export
+ (if (<= l umax)
+ (org-lparse-end-outline-text-or-outline)
+ (org-lparse-end-list-item-1)
+ (org-lparse-end-list 'unordered))
+ (aset org-levels-open (1- l) nil))))
+
+(defvar org-lparse-outline-text-open)
+(defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags
+ 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))
+
+(defun org-lparse-end-outline-text-or-outline ()
+ (cond
+ (org-lparse-outline-text-open
+ (org-lparse-end 'OUTLINE-TEXT)
+ (setq org-lparse-outline-text-open nil))
+ (t (org-lparse-end 'OUTLINE))))
+
+(defun org-lparse-begin-outline-text (level1 snumber extra-class)
+ (assert (not org-lparse-outline-text-open) t)
+ (setq org-lparse-outline-text-open t)
+ (org-lparse-begin 'OUTLINE-TEXT level1 snumber extra-class))
+
+(defun org-lparse-html-list-type-to-canonical-list-type (ltype)
+ (cdr (assoc ltype '(("o" . ordered)
+ ("u" . unordered)
+ ("d" . description)))))
+
+;; following vars are bound during `org-do-lparse'
+(defvar org-lparse-list-stack)
+(defvar org-lparse-list-table:table-row)
+(defvar org-lparse-list-table:lines)
+
+;; Notes on LIST-TABLES
+;; ====================
+;; Lists withing "list-table" blocks (as shown below)
+;;
+;; #+begin_list-table
+;; - Row 1
+;; - 1.1
+;; - 1.2
+;; - 1.3
+;; - Row 2
+;; - 2.1
+;; - 2.2
+;; - 2.3
+;; #+end_list-table
+;;
+;; will be exported as though it were a table as shown below.
+;;
+;; | Row 1 | 1.1 | 1.2 | 1.3 |
+;; | Row 2 | 2.1 | 2.2 | 2.3 |
+;;
+;; 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
+;; table editor will be a cumbersome task. Furthermore inclusion of
+;; multi-paragraph text in a table cell is well-nigh impossible.
+;;
+;; LIST-TABLEs are meant to circumvent the above problems with
+;; org-tables.
+;;
+;; Note that in the example above the list items could be paragraphs
+;; themselves and the list can be arbitrarily deep.
+;;
+;; Inspired by following thread:
+;; https://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01101.html
+
+(defun org-lparse-begin-list (ltype)
+ (push ltype org-lparse-list-stack)
+ (let ((list-level (length org-lparse-list-stack)))
+ (cond
+ ((not org-lparse-list-table-p)
+ (org-lparse-begin 'LIST ltype))
+ ;; process LIST-TABLE
+ ((= 1 list-level)
+ ;; begin LIST-TABLE
+ (setq org-lparse-list-table:lines nil)
+ (setq org-lparse-list-table:table-row nil))
+ ((= 2 list-level)
+ (ignore))
+ (t
+ (org-lparse-begin 'LIST ltype)))))
+
+(defun org-lparse-end-list (ltype)
+ (pop org-lparse-list-stack)
+ (let ((list-level (length org-lparse-list-stack)))
+ (cond
+ ((not org-lparse-list-table-p)
+ (org-lparse-end 'LIST ltype))
+ ;; process LIST-TABLE
+ ((= 0 list-level)
+ ;; end LIST-TABLE
+ (insert (org-lparse-format-list-table
+ (nreverse org-lparse-list-table:lines))))
+ ((= 1 list-level)
+ (ignore))
+ (t
+ (org-lparse-end 'LIST ltype)))))
+
+(defun org-lparse-begin-list-item (ltype &optional arg headline)
+ (let ((list-level (length org-lparse-list-stack)))
+ (cond
+ ((not org-lparse-list-table-p)
+ (org-lparse-begin 'LIST-ITEM ltype arg headline))
+ ;; process LIST-TABLE
+ ((= 1 list-level)
+ ;; begin TABLE-ROW for LIST-TABLE
+ (setq org-lparse-list-table:table-row nil)
+ (org-lparse-begin-list-table:table-cell))
+ ((= 2 list-level)
+ ;; begin TABLE-CELL for LIST-TABLE
+ (org-lparse-begin-list-table:table-cell))
+ (t
+ (org-lparse-begin 'LIST-ITEM ltype arg headline)))))
+
+(defun org-lparse-end-list-item (ltype)
+ (let ((list-level (length org-lparse-list-stack)))
+ (cond
+ ((not org-lparse-list-table-p)
+ (org-lparse-end 'LIST-ITEM ltype))
+ ;; process LIST-TABLE
+ ((= 1 list-level)
+ ;; end TABLE-ROW for LIST-TABLE
+ (org-lparse-end-list-table:table-cell)
+ (push (nreverse org-lparse-list-table:table-row)
+ org-lparse-list-table:lines))
+ ((= 2 list-level)
+ ;; end TABLE-CELL for LIST-TABLE
+ (org-lparse-end-list-table:table-cell))
+ (t
+ (org-lparse-end 'LIST-ITEM ltype)))))
+
+(defvar org-lparse-list-table:table-cell-open)
+(defun org-lparse-begin-list-table:table-cell ()
+ (org-lparse-end-list-table:table-cell)
+ (setq org-lparse-list-table:table-cell-open t)
+ (org-lparse-begin-collect)
+ (org-lparse-begin-paragraph))
+
+(defun org-lparse-end-list-table:table-cell ()
+ (when org-lparse-list-table:table-cell-open
+ (setq org-lparse-list-table:table-cell-open nil)
+ (org-lparse-end-paragraph)
+ (push (org-lparse-end-collect)
+ org-lparse-list-table:table-row)))
+
+(defvar org-lparse-table-rowgrp-info)
+(defun org-lparse-begin-table-rowgroup (&optional is-header-row)
+ (push (cons (1+ org-lparse-table-rownum) :start) org-lparse-table-rowgrp-info)
+ (org-lparse-begin 'TABLE-ROWGROUP is-header-row))
+
+(defun org-lparse-end-table ()
+ (when org-lparse-table-is-styled
+ ;; column groups
+ (unless (car org-table-colgroup-info)
+ (setq org-table-colgroup-info
+ (cons :start (cdr org-table-colgroup-info))))
+
+ ;; column alignment
+ (let ((c -1))
+ (mapc
+ (lambda (x)
+ (incf c)
+ (setf (aref org-lparse-table-colalign-vector c)
+ (or (aref org-lparse-table-colalign-vector c)
+ (if (> (/ (float x) (1+ org-lparse-table-rownum))
+ org-table-number-fraction)
+ "right" "left"))))
+ org-lparse-table-num-numeric-items-per-column)))
+ (org-lparse-end 'TABLE))
+
+(defvar org-lparse-encode-pending nil)
+
+(defun org-lparse-format-tags (tag text prefix suffix &rest args)
+ (cond
+ ((consp tag)
+ (concat prefix (apply 'format (car tag) args) text suffix
+ (format (cdr tag))))
+ ((stringp tag) ; singleton tag
+ (concat prefix (apply 'format tag args) text))))
+
+(defun org-xml-fix-class-name (kwd) ; audit callers of this function
+ "Turn todo keyword into a valid class name.
+Replaces invalid characters with \"_\"."
+ (save-match-data
+ (while (string-match "[^a-zA-Z0-9_]" kwd)
+ (setq kwd (replace-match "_" t t kwd))))
+ kwd)
+
+(defun org-lparse-format-todo (todo)
+ (org-lparse-format 'FONTIFY
+ (concat
+ (ignore-errors (org-lparse-get 'TODO-KWD-CLASS-PREFIX))
+ (org-xml-fix-class-name todo))
+ (list (if (member todo org-done-keywords) "done" "todo")
+ todo)))
+
+(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 "")))
+
+(defun org-lparse-format-org-tags (tags)
+ (if (not tags) ""
+ (org-lparse-format
+ 'FONTIFY (mapconcat
+ (lambda (x)
+ (org-lparse-format
+ 'FONTIFY x
+ (concat
+ (ignore-errors (org-lparse-get 'TAG-CLASS-PREFIX))
+ (org-xml-fix-class-name x))))
+ (org-split-string tags ":")
+ (org-lparse-format 'SPACES 1)) "tag")))
+
+(defun org-lparse-format-section-number (&optional snumber level)
+ (and org-export-with-section-numbers
+ (not org-lparse-body-only) snumber level
+ (org-lparse-format 'FONTIFY snumber (format "section-number-%d" level))))
+
+(defun org-lparse-warn (msg)
+ (if (not org-lparse-use-flashy-warning)
+ (message msg)
+ (put-text-property 0 (length msg) 'face 'font-lock-warning-face msg)
+ (message msg)
+ (sleep-for 3)))
+
+(defun org-xml-format-href (s)
+ "Make sure the S is valid as a href reference in an XHTML document."
+ (save-match-data
+ (let ((start 0))
+ (while (string-match "&" s start)
+ (setq start (+ (match-beginning 0) 3)
+ s (replace-match "&amp;" t t s)))))
+ s)
+
+(defun org-xml-format-desc (s)
+ "Make sure the S is valid as a description in a link."
+ (if (and s (not (get-text-property 1 'org-protected s)))
+ (save-match-data
+ (org-xml-encode-org-text s))
+ s))
+
+(provide 'org-lparse)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; org-lparse.el ends here
diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el
index fc52b92a21d..91866b46c0a 100644
--- a/lisp/org/org-mac-message.el
+++ b/lisp/org/org-mac-message.el
@@ -1,11 +1,10 @@
;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
-;; Author: John Wiegley <johnw@gnu.org>
-;; Christopher Suckling <suckling at gmail dot com>
+;; Authors: John Wiegley <johnw@gnu.org>
+;; Christopher Suckling <suckling at gmail dot com>
-;; Version: 7.7
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
@@ -48,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)
@@ -85,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 ()
@@ -102,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)
@@ -214,6 +213,4 @@ list of message:// links to flagged mail after heading."
(provide 'org-mac-message)
-
-
;;; org-mac-message.el ends here
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index dc413f4d993..e99991702fe 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -1,11 +1,10 @@
;;; org-macs.el --- Top-level definitions for Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -46,25 +45,36 @@
(declare-function org-add-props "org-compat" (string plist &rest props))
(declare-function org-string-match-p "org-compat" (&rest args))
+(defmacro org-with-gensyms (symbols &rest body)
+ `(let ,(mapcar (lambda (s)
+ `(,s (make-symbol (concat "--" (symbol-name ',s))))) symbols)
+ ,@body))
+(def-edebug-spec org-with-gensyms (sexp body))
+(put 'org-with-gensyms 'lisp-indent-function 1)
+
(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))))
-
-(if (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)))
+ `(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)))
(defmacro org-bound-and-true-p (var)
"Return the value of symbol VAR if it is bound, else nil."
`(and (boundp (quote ,var)) ,var))
+(def-edebug-spec org-bound-and-true-p (symbolp))
(defun org-string-nw-p (s)
"Is S a string with a non-white character?"
@@ -85,42 +95,50 @@ Also, do not record undo information."
(let ((buffer-undo-list t)
before-change-functions after-change-functions)
,@body))))
+(def-edebug-spec org-unmodified (body))
+
+(defun org-substitute-posix-classes (re)
+ "Substitute posix classes in regular expression RE."
+ (let ((ss re))
+ (save-match-data
+ (while (string-match "\\[:alnum:\\]" ss)
+ (setq ss (replace-match "a-zA-Z0-9" t t ss)))
+ (while (string-match "\\[:word:\\]" ss)
+ (setq ss (replace-match "a-zA-Z0-9" t t ss)))
+ (while (string-match "\\[:alpha:\\]" ss)
+ (setq ss (replace-match "a-zA-Z" t t ss)))
+ (while (string-match "\\[:punct:\\]" ss)
+ (setq ss (replace-match "\001-@[-`{-~" t t ss)))
+ ss)))
(defmacro org-re (s)
"Replace posix classes in regular expression."
- (if (featurep 'xemacs)
- (let ((ss s))
- (save-match-data
- (while (string-match "\\[:alnum:\\]" ss)
- (setq ss (replace-match "a-zA-Z0-9" t t ss)))
- (while (string-match "\\[:word:\\]" ss)
- (setq ss (replace-match "a-zA-Z0-9" t t ss)))
- (while (string-match "\\[:alpha:\\]" ss)
- (setq ss (replace-match "a-zA-Z" t t ss)))
- (while (string-match "\\[:punct:\\]" ss)
- (setq ss (replace-match "\001-@[-`{-~" t t ss)))
- ss))
- s))
+ (if (featurep 'xemacs) `(org-substitute-posix-classes ,s) s))
+(def-edebug-spec org-re (form))
(defmacro org-preserve-lc (&rest body)
- `(let ((_line (org-current-line))
- (_col (current-column)))
- (unwind-protect
- (progn ,@body)
- (org-goto-line _line)
- (org-move-to-column _col))))
+ (org-with-gensyms (line col)
+ `(let ((,line (org-current-line))
+ (,col (current-column)))
+ (unwind-protect
+ (progn ,@body)
+ (org-goto-line ,line)
+ (org-move-to-column ,col)))))
+(def-edebug-spec org-preserve-lc (body))
(defmacro org-without-partial-completion (&rest body)
`(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
(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
@@ -135,31 +153,37 @@ We use a macro so that the test can happen at compilation time."
(defmacro org-with-point-at (pom &rest body)
"Move to buffer and point of point-or-marker POM for the duration of BODY."
- `(let ((pom ,pom))
- (save-excursion
- (if (markerp pom) (set-buffer (marker-buffer pom)))
+ (org-with-gensyms (mpom)
+ `(let ((,mpom ,pom))
(save-excursion
- (goto-char (or pom (point)))
- ,@body))))
+ (if (markerp ,mpom) (set-buffer (marker-buffer ,mpom)))
+ (save-excursion
+ (goto-char (or ,mpom (point)))
+ ,@body)))))
+(def-edebug-spec org-with-point-at (form body))
(put 'org-with-point-at 'lisp-indent-function 1)
(defmacro org-no-warnings (&rest body)
(cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body))
+(def-edebug-spec org-no-warnings (body))
(defmacro org-if-unprotected (&rest body)
"Execute BODY if there is no `org-protected' text property at point."
`(unless (get-text-property (point) 'org-protected)
,@body))
+(def-edebug-spec org-if-unprotected (body))
(defmacro org-if-unprotected-1 (&rest body)
"Execute BODY if there is no `org-protected' text property at point-1."
`(unless (get-text-property (1- (point)) 'org-protected)
,@body))
+(def-edebug-spec org-if-unprotected-1 (body))
(defmacro org-if-unprotected-at (pos &rest body)
"Execute BODY if there is no `org-protected' text property at POS."
`(unless (get-text-property ,pos 'org-protected)
,@body))
+(def-edebug-spec org-if-unprotected-at (form body))
(put 'org-if-unprotected-at 'lisp-indent-function 1)
(defun org-re-search-forward-unprotected (&rest args)
@@ -171,33 +195,37 @@ We use a macro so that the test can happen at compilation time."
(unless (get-text-property (match-beginning 0) 'org-protected)
(throw 'exit (point))))))
+;; FIXME: Normalize argument names
(defmacro org-with-remote-undo (_buffer &rest _body)
"Execute BODY while recording undo information in two buffers."
- `(let ((_cline (org-current-line))
- (_cmd this-command)
- (_buf1 (current-buffer))
- (_buf2 ,_buffer)
- (_undo1 buffer-undo-list)
- (_undo2 (with-current-buffer ,_buffer buffer-undo-list))
- _c1 _c2)
- ,@_body
- (when org-agenda-allow-remote-undo
- (setq _c1 (org-verify-change-for-undo
- _undo1 (with-current-buffer _buf1 buffer-undo-list))
- _c2 (org-verify-change-for-undo
- _undo2 (with-current-buffer _buf2 buffer-undo-list)))
- (when (or _c1 _c2)
- ;; make sure there are undo boundaries
- (and _c1 (with-current-buffer _buf1 (undo-boundary)))
- (and _c2 (with-current-buffer _buf2 (undo-boundary)))
- ;; remember which buffer to undo
- (push (list _cmd _cline _buf1 _c1 _buf2 _c2)
- org-agenda-undo-list)))))
+ (org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2)
+ `(let ((,cline (org-current-line))
+ (,cmd this-command)
+ (,buf1 (current-buffer))
+ (,buf2 ,_buffer)
+ (,undo1 buffer-undo-list)
+ (,undo2 (with-current-buffer ,_buffer buffer-undo-list))
+ ,c1 ,c2)
+ ,@_body
+ (when org-agenda-allow-remote-undo
+ (setq ,c1 (org-verify-change-for-undo
+ ,undo1 (with-current-buffer ,buf1 buffer-undo-list))
+ ,c2 (org-verify-change-for-undo
+ ,undo2 (with-current-buffer ,buf2 buffer-undo-list)))
+ (when (or ,c1 ,c2)
+ ;; make sure there are undo boundaries
+ (and ,c1 (with-current-buffer ,buf1 (undo-boundary)))
+ (and ,c2 (with-current-buffer ,buf2 (undo-boundary)))
+ ;; remember which buffer to undo
+ (push (list ,cmd ,cline ,buf1 ,c1 ,buf2 ,c2)
+ org-agenda-undo-list))))))
+(def-edebug-spec org-with-remote-undo (form body))
(put 'org-with-remote-undo 'lisp-indent-function 1)
(defmacro org-no-read-only (&rest body)
"Inhibit read-only for BODY."
`(let ((inhibit-read-only t)) ,@body))
+(def-edebug-spec org-no-read-only (body))
(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
rear-nonsticky t mouse-map t fontified t
@@ -211,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)
@@ -245,10 +278,6 @@ we turn off invisibility temporarily. Use this in a `let' form."
"Make VAR local in current buffer and set it to VALUE."
(set (make-local-variable var) value))
-(defsubst org-mode-p ()
- "Check if the current buffer is in Org-mode."
- (eq major-mode 'org-mode))
-
(defsubst org-last (list)
"Return the last element of LIST."
(car (last list)))
@@ -324,32 +353,37 @@ but it also means that the buffer should stay alive
during the operation, because otherwise all these markers will
point nowhere."
(declare (indent 1))
- `(let ((data (org-outline-overlay-data ,use-markers))
- rtn)
- (unwind-protect
- (progn
- (setq rtn (progn ,@body))
- (org-set-outline-overlay-data data))
- (when ,use-markers
- (mapc (lambda (c)
- (and (markerp (car c)) (move-marker (car c) nil))
- (and (markerp (cdr c)) (move-marker (cdr c) nil)))
- data)))
- rtn))
+ (org-with-gensyms (data rtn)
+ `(let ((,data (org-outline-overlay-data ,use-markers))
+ ,rtn)
+ (unwind-protect
+ (progn
+ (setq ,rtn (progn ,@body))
+ (org-set-outline-overlay-data ,data))
+ (when ,use-markers
+ (mapc (lambda (c)
+ (and (markerp (car c)) (move-marker (car c) nil))
+ (and (markerp (cdr c)) (move-marker (cdr c) nil)))
+ ,data)))
+ ,rtn)))
+(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))
(defvar org-outline-regexp) ; defined in org.el
(defvar org-odd-levels-only) ; defined in org.el
@@ -357,20 +391,32 @@ point nowhere."
(defun org-get-limited-outline-regexp ()
"Return outline-regexp with limited number of levels.
The number of levels is controlled by `org-inlinetask-min-level'"
- (if (or (not (org-mode-p)) (not (featurep 'org-inlinetask)))
+ (if (or (not (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))))
-(provide 'org-macs)
+(defmacro org-eval-in-environment (environment form)
+ `(eval (list 'let ,environment ',form)))
+(def-edebug-spec org-eval-in-environment (form form))
+(put 'org-eval-in-environment 'lisp-indent-function 1)
+(defun org-make-parameter-alist (flat)
+ "Return alist based on FLAT.
+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)))))
+(provide 'org-macs)
;;; org-macs.el ends here
diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el
index 97cad1ae316..74ace5a529f 100644
--- a/lisp/org/org-mew.el
+++ b/lisp/org/org-mew.el
@@ -1,11 +1,10 @@
;;; org-mew.el --- Support for links to Mew messages from within Org-mode
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
@@ -104,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)))
@@ -135,6 +133,4 @@
(provide 'org-mew)
-
-
;;; org-mew.el ends here
diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el
index 7075018894f..7c8b0b23905 100644
--- a/lisp/org/org-mhe.el
+++ b/lisp/org/org-mhe.el
@@ -1,11 +1,10 @@
;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -100,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))))
@@ -180,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.
@@ -225,6 +224,4 @@ folders."
(provide 'org-mhe)
-
-
;;; org-mhe.el ends here
diff --git a/lisp/org/org-mks.el b/lisp/org/org-mks.el
index 5f3ebbb6c81..95223ef848e 100644
--- a/lisp/org/org-mks.el
+++ b/lisp/org/org-mks.el
@@ -1,11 +1,10 @@
;;; org-mks.el --- Multi-key-selection for Org-mode
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -25,7 +24,7 @@
;;; Commentary:
-;;
+;;
;;; Code:
@@ -132,6 +131,4 @@ only the bare key is returned."
(provide 'org-mks)
-
-
;;; org-mks.el ends here
diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el
index f270419877e..ffdd66513be 100644
--- a/lisp/org/org-mobile.el
+++ b/lisp/org/org-mobile.el
@@ -1,10 +1,9 @@
;;; org-mobile.el --- Code for asymmetric sync with a mobile device
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -38,6 +37,9 @@
(eval-when-compile (require 'cl))
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
+
(defgroup org-mobile nil
"Options concerning support for a viewer/editor on a mobile device."
:tag "Org Mobile"
@@ -66,6 +68,7 @@ org-agenda-text-search-extra-files
(defcustom org-mobile-files-exclude-regexp ""
"A regexp to exclude files from `org-mobile-files'."
:group 'org-mobile
+ :version "24.1"
:type 'regexp)
(defcustom org-mobile-directory ""
@@ -82,6 +85,7 @@ Turning on encryption requires to set the same password in the MobileOrg
application. Before turning this on, check of MobileOrg does already
support it - at the time of this writing it did not yet."
:group 'org-mobile
+ :version "24.1"
:type 'boolean)
(defcustom org-mobile-encryption-tempfile "~/orgtmpcrypt"
@@ -89,6 +93,7 @@ support it - at the time of this writing it did not yet."
This must be local file on your local machine (not on the WebDAV server).
You might want to put this file into a directory where only you have access."
:group 'org-mobile
+ :version "24.1"
:type 'directory)
(defcustom org-mobile-encryption-password ""
@@ -109,6 +114,7 @@ it, this also limits the security of this approach. You can also leave
this variable empty - Org will then ask for the password once per Emacs
session."
:group 'org-mobile
+ :version "24.1"
:type '(string :tag "Password"))
(defvar org-mobile-encryption-password-session nil)
@@ -148,6 +154,7 @@ custom all custom agendas defined by the user
all the custom agendas and the default ones
list a list of selection key(s) as string."
:group 'org-mobile
+ :version "24.1"
:type '(choice
(const :tag "Default Agendas" default)
(const :tag "Custom Agendas" custom)
@@ -229,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
@@ -270,7 +277,7 @@ Also exclude files matching `org-mobile-files-exclude-regexp'."
(t nil)))
org-mobile-files)))
(files (delete
- nil
+ nil
(mapcar (lambda (f)
(unless (and (not (string= org-mobile-files-exclude-regexp ""))
(string-match org-mobile-files-exclude-regexp f))
@@ -293,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.
@@ -301,7 +310,7 @@ create all custom agenda views, for upload to the mobile phone."
(interactive)
(let ((a-buffer (get-buffer org-agenda-buffer-name)))
(let ((org-agenda-buffer-name "*SUMO*")
- (org-agenda-filter org-agenda-filter)
+ (org-agenda-tag-filter org-agenda-tag-filter)
(org-agenda-redo-command org-agenda-redo-command))
(save-excursion
(save-window-excursion
@@ -309,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...")
@@ -395,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."
@@ -407,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
@@ -447,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))
@@ -497,7 +500,7 @@ agenda view showing the flagged items."
org-mobile-directory))
(save-excursion
(setq buf (find-file file))
- (when (and (= (point-min) (point-max)))
+ (when (and (= (point-min) (point-max)))
(insert "\n")
(save-buffer)
(when org-mobile-use-encryption
@@ -572,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)))
@@ -589,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)))))
@@ -677,7 +680,6 @@ The table of checksums is written to the file mobile-checksums."
(let ((table '(?: ?/)))
(org-link-escape s table)))
-;;;###autoload
(defun org-mobile-create-sumo-agenda ()
"Create a file that contains all custom agenda views."
(interactive)
@@ -820,107 +822,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
- (switch-to-buffer (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)
@@ -981,7 +971,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))
@@ -997,7 +999,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
@@ -1055,6 +1057,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)
@@ -1096,7 +1128,8 @@ A and B must be strings or nil."
(provide 'org-mobile)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-mobile.el ends here
-
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el
index 8f1e7735693..b5a6dad733a 100644
--- a/lisp/org/org-mouse.el
+++ b/lisp/org/org-mouse.el
@@ -1,13 +1,12 @@
;;; org-mouse.el --- Better mouse support for org-mode
-;; Copyright (C) 2006-2011 Free Software Foundation
-;;
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
+
;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
-;; Version: 7.7
-;;
+
;; 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
@@ -20,8 +19,7 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
+
;;; Commentary:
;;
;; Org-mouse provides mouse support for org-mode.
@@ -70,8 +68,7 @@
;;
;; Since version 5.10: Changes are listed in the general org-mode docs.
;;
-;; Version 5.09
-;; + Version number synchronization with Org-mode.
+;; Version 5.09;; + Version number synchronization with Org-mode.
;;
;; Version 0.25
;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch)
@@ -263,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))))
@@ -272,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.
@@ -298,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."
@@ -318,18 +313,17 @@ nor a function, elements of KEYWORDS are used directly."
(replace-match "")
(just-one-space))
-(defvar rest)
+(defvar org-mouse-rest)
(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase
literal string subexp)
"The same as `replace-match', but surrounds the replacement with spaces."
- (apply 'replace-match rest)
+ (apply 'replace-match org-mouse-rest)
(save-excursion
(goto-char (match-beginning (or subexp 0)))
(just-one-space)
(goto-char (match-end (or subexp 0)))
(just-one-space)))
-
(defun org-mouse-keyword-replace-menu (keywords &optional group itemformat
nosurround)
"A helper function.
@@ -379,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.
@@ -395,15 +388,6 @@ DEFAULT is returned if no priority is given in the headline."
(match-string 1)
(when default (char-to-string org-default-priority)))))
-;; (defun org-mouse-at-link ()
-;; (and (eq (get-text-property (point) 'face) 'org-link)
-;; (save-excursion
-;; (goto-char (previous-single-property-change (point) 'face))
-;; (or (looking-at org-bracket-link-regexp)
-;; (looking-at org-angle-link-re)
-;; (looking-at org-plain-link-re)))))
-
-
(defun org-mouse-delete-timestamp ()
"Deletes the current timestamp as well as the preceding keyword.
SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
@@ -423,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."
@@ -454,7 +438,6 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
["Align Tags in Buffer" (org-set-tags t t) t]
["Set Tags ..." (org-set-tags) t])))
-
(defun org-mouse-set-tags (tags)
(save-excursion
;; remove existing tags first
@@ -478,13 +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
@@ -503,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)
@@ -547,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)]
@@ -571,7 +552,6 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
["Plain List to Outline" org-mouse-transform-to-outline
:visible (org-at-item-p)])))
-
(defun org-mouse-get-context (contextlist context)
(let ((contextdata (assq context contextlist)))
(when contextdata
@@ -599,45 +579,35 @@ This means, between the beginning of line and the point."
(open-line 1)
(org-indent-to-column (- (match-end 0) (match-beginning 0)))
(insert "+ "))
-
(:middle ; insert after
(end-of-line)
(newline t)
(indent-relative)
(insert "+ "))
-
(:end ; insert text here
(skip-chars-backward " \t")
(kill-region (point) (point-at-eol))
(unless (org-looking-back org-mouse-punctuation)
(insert (concat org-mouse-punctuation " ")))))
-
(insert text)
(beginning-of-line))
(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate)
- (if (org-mode-p)
+ (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 (org-mode-p)
+ (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)))))
-
-(defun org-mouse-match-todo-keyword ()
- (save-excursion
- (org-back-to-heading)
- (if (looking-at org-outline-regexp) (goto-char (match-end 0)))
- (or (looking-at (concat " +" org-todo-regexp " *"))
- (looking-at " \\( *\\)"))))
+ (save-match-data
+ (set-match-data ',match)
+ (apply ',function rest)))))
(defun org-mouse-yank-link (click)
(interactive "e")
@@ -649,247 +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))]
+ "--"
+ ["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]
"--"
- ["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)]
+ ("Column"
+ ["Move Column Left" org-metaleft]
+ ["Move Column Right" org-metaright]
+ ["Delete Column" org-shiftmetaleft]
+ ["Insert Column" org-shiftmetaright]
"--"
- ["Reverse Alphabetically" (org-sort-entries nil ?A)]
- ["Reverse Numerically" (org-sort-entries nil ?N)]
- ["Reverse By Time/Date" (org-sort-entries nil ?T)])
+ ["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)]
+ "--"
+ ["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))))))
-
-;; (defun org-mouse-at-regexp (regexp)
-;; (save-excursion
-;; (let ((point (point))
-;; (bol (progn (beginning-of-line) (point)))
-;; (eol (progn (end-of-line) (point))))
-;; (goto-char point)
-;; (re-search-backward regexp bol 1)
-;; (and (not (eolp))
-;; (progn (forward-char)
-;; (re-search-forward regexp eol t))
-;; (<= (match-beginning 0) point)))))
+ ["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))
@@ -907,54 +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)))
- (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")
@@ -974,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 ()
@@ -1029,10 +987,10 @@ This means, between the beginning of line and the point."
(replace-match replace-text))
(forward-line))))
-(defvar _cmd) ;dynamically scoped from `org-with-remote-undo'.
+(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))
@@ -1060,7 +1018,7 @@ This means, between the beginning of line and the point."
(setq marker (copy-marker (point)))
(goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
(funcall command)
- (message "_cmd: %S" _cmd)
+ (message "_cmd: %S" org-mouse-cmd)
(message "this-command: %S" this-command)
(unless (eq (marker-position marker) (marker-position endmarker))
(setq newhead (org-get-heading))))
@@ -1129,23 +1087,21 @@ 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)
-
-
;;; org-mouse.el ends here
diff --git a/lisp/org/org-odt.el b/lisp/org/org-odt.el
new file mode 100644
index 00000000000..2dc3af39b09
--- /dev/null
+++ b/lisp/org/org-odt.el
@@ -0,0 +1,2854 @@
+;;; org-odt.el --- OpenDocument Text exporter for Org-mode
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Jambunathan K <kjambunathan at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; 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:
+
+;;; Code:
+(eval-when-compile
+ (require 'cl))
+(require 'org-lparse)
+
+(defgroup org-export-odt nil
+ "Options specific for ODT export of Org-mode files."
+ :tag "Org Export ODT"
+ :group 'org-export
+ :version "24.1")
+
+(defvar org-lparse-dyn-first-heading-pos) ; let bound during org-do-lparse
+(defun org-odt-insert-toc ()
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward
+ "\\(<text:p [^>]*>\\)?\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*\\(</text:p>\\)?"
+ nil t)
+ (replace-match ""))
+ (t
+ (goto-char org-lparse-dyn-first-heading-pos)))
+ (insert (org-odt-format-toc)))
+
+(defun org-odt-end-export ()
+ (org-odt-insert-toc)
+ (org-odt-fixup-label-references)
+
+ ;; remove empty paragraphs
+ (goto-char (point-min))
+ (while (re-search-forward
+ "<text:p\\( text:style-name=\"Text_20_body\"\\)?>[ \r\n\t]*</text:p>"
+ nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+
+ ;; Convert whitespace place holders
+ (goto-char (point-min))
+ (let (beg end n)
+ (while (setq beg (next-single-property-change (point) 'org-whitespace))
+ (setq n (get-text-property beg 'org-whitespace)
+ end (next-single-property-change beg 'org-whitespace))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (format "<span style=\"visibility:hidden;\">%s</span>"
+ (make-string n ?x)))))
+
+ ;; Remove empty lines at the beginning of the file.
+ (goto-char (point-min))
+ (when (looking-at "\\s-+\n") (replace-match ""))
+
+ ;; Remove display properties
+ (remove-text-properties (point-min) (point-max) '(display t)))
+
+(defvar org-odt-suppress-xref nil)
+(defconst org-export-odt-special-string-regexps
+ '(("\\\\-" . "&#x00ad;\\1") ; shy
+ ("---\\([^-]\\)" . "&#x2014;\\1") ; mdash
+ ("--\\([^-]\\)" . "&#x2013;\\1") ; ndash
+ ("\\.\\.\\." . "&#x2026;")) ; hellip
+ "Regular expressions for special string conversion.")
+
+(defconst org-odt-lib-dir (file-name-directory load-file-name)
+ "Location of ODT exporter.
+Use this to infer values of `org-odt-styles-dir' and
+`org-export-odt-schema-dir'.")
+
+(defvar org-odt-data-dir nil
+ "Data directory for ODT exporter.
+Use this to infer values of `org-odt-styles-dir' and
+`org-export-odt-schema-dir'.")
+
+(defconst org-odt-schema-dir-list
+ (list
+ (and org-odt-data-dir
+ (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))))
+ "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
+populated heuristically based on the values of `org-odt-lib-dir'
+and `org-odt-data-dir'.")
+
+(defcustom org-export-odt-schema-dir
+ (let* ((schema-dir
+ (catch 'schema-dir
+ (message "Debug (org-odt): Searching for OpenDocument schema files...")
+ (mapc
+ (lambda (schema-dir)
+ (when schema-dir
+ (message "Debug (org-odt): Trying %s..." schema-dir)
+ (when (and (file-readable-p
+ (expand-file-name "od-manifest-schema-v1.2-cs01.rnc"
+ schema-dir))
+ (file-readable-p
+ (expand-file-name "od-schema-v1.2-cs01.rnc"
+ schema-dir))
+ (file-readable-p
+ (expand-file-name "schemas.xml" schema-dir)))
+ (message "Debug (org-odt): Using schema files under %s"
+ schema-dir)
+ (throw 'schema-dir schema-dir))))
+ org-odt-schema-dir-list)
+ (message "Debug (org-odt): No OpenDocument schema files installed")
+ nil)))
+ schema-dir)
+ "Directory that contains OpenDocument schema files.
+
+This directory contains:
+1. rnc files for OpenDocument schema
+2. a \"schemas.xml\" file that specifies locating rules needed
+ for auto validation of OpenDocument XML files.
+
+Use the customize interface to set this variable. This ensures
+that `rng-schema-locating-files' is updated and auto-validation
+of OpenDocument XML takes place based on the value
+`rng-nxml-auto-validate-flag'.
+
+The default value of this variable varies depending on the
+version of org in use and is initialized from
+`org-odt-schema-dir-list'. The OASIS schema files are available
+only in the org's private git repository. It is *not* bundled
+with GNU ELPA tar or standard Emacs distribution."
+ :type '(choice
+ (const :tag "Not set" nil)
+ (directory :tag "Schema directory"))
+ :group 'org-export-odt
+ :version "24.1"
+ :set
+ (lambda (var value)
+ "Set `org-export-odt-schema-dir'.
+Also add it to `rng-schema-locating-files'."
+ (let ((schema-dir value))
+ (set var
+ (if (and
+ (file-readable-p
+ (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" schema-dir))
+ (file-readable-p
+ (expand-file-name "od-schema-v1.2-cs01.rnc" schema-dir))
+ (file-readable-p
+ (expand-file-name "schemas.xml" schema-dir)))
+ schema-dir
+ (when value
+ (message "Error (org-odt): %s has no OpenDocument schema files"
+ value))
+ nil)))
+ (when org-export-odt-schema-dir
+ (eval-after-load 'rng-loc
+ '(add-to-list 'rng-schema-locating-files
+ (expand-file-name "schemas.xml"
+ org-export-odt-schema-dir))))))
+
+(defconst org-odt-styles-dir-list
+ (list
+ (and org-odt-data-dir
+ (expand-file-name "./styles/" 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 "./styles/" org-odt-data-dir)))
+ (expand-file-name "../etc/styles/" org-odt-lib-dir) ; git
+ (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa
+ (expand-file-name "./org/" data-directory) ; system
+ )
+ "List of directories to search for OpenDocument styles files.
+See `org-odt-styles-dir'. The entries in this list are populated
+heuristically based on the values of `org-odt-lib-dir' and
+`org-odt-data-dir'.")
+
+(defconst org-odt-styles-dir
+ (let* ((styles-dir
+ (catch 'styles-dir
+ (message "Debug (org-odt): Searching for OpenDocument styles files...")
+ (mapc (lambda (styles-dir)
+ (when styles-dir
+ (message "Debug (org-odt): Trying %s..." styles-dir)
+ (when (and (file-readable-p
+ (expand-file-name
+ "OrgOdtContentTemplate.xml" styles-dir))
+ (file-readable-p
+ (expand-file-name
+ "OrgOdtStyles.xml" styles-dir)))
+ (message "Debug (org-odt): Using styles under %s"
+ styles-dir)
+ (throw 'styles-dir styles-dir))))
+ org-odt-styles-dir-list)
+ nil)))
+ (unless styles-dir
+ (error "Error (org-odt): Cannot find factory styles files, aborting"))
+ styles-dir)
+ "Directory that holds auxiliary XML files used by the ODT exporter.
+
+This directory contains the following XML files -
+ \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These
+ XML files are used as the default values of
+ `org-export-odt-styles-file' and
+ `org-export-odt-content-template-file'.
+
+The default value of this variable varies depending on the
+version of org in use and is initialized from
+`org-odt-styles-dir-list'. Note that the user could be using org
+from one of: org's own private git repository, GNU ELPA tar or
+standard Emacs.")
+
+(defvar org-odt-file-extensions
+ '(("odt" . "OpenDocument Text")
+ ("ott" . "OpenDocument Text Template")
+ ("odm" . "OpenDocument Master Document")
+ ("ods" . "OpenDocument Spreadsheet")
+ ("ots" . "OpenDocument Spreadsheet Template")
+ ("odg" . "OpenDocument Drawing (Graphics)")
+ ("otg" . "OpenDocument Drawing Template")
+ ("odp" . "OpenDocument Presentation")
+ ("otp" . "OpenDocument Presentation Template")
+ ("odi" . "OpenDocument Image")
+ ("odf" . "OpenDocument Formula")
+ ("odc" . "OpenDocument Chart")))
+
+(mapc
+ (lambda (desc)
+ ;; Let Emacs open all OpenDocument files in archive mode
+ (add-to-list 'auto-mode-alist
+ (cons (concat "\\." (car desc) "\\'") 'archive-mode)))
+ org-odt-file-extensions)
+
+;; register the odt exporter with the pre-processor
+(add-to-list 'org-export-backends 'odt)
+
+;; register the odt exporter with org-lparse library
+(org-lparse-register-backend 'odt)
+
+(defun org-odt-unload-function ()
+ (org-lparse-unregister-backend 'odt)
+ (remove-hook 'org-export-preprocess-after-blockquote-hook
+ 'org-export-odt-preprocess-latex-fragments)
+ nil)
+
+(defcustom org-export-odt-content-template-file nil
+ "Template file for \"content.xml\".
+The exporter embeds the exported content just before
+\"</office:text>\" element.
+
+If unspecified, the file named \"OrgOdtContentTemplate.xml\"
+under `org-odt-styles-dir' is used."
+ :type 'file
+ :group 'org-export-odt
+ :version "24.1")
+
+(defcustom org-export-odt-styles-file nil
+ "Default styles file for use with ODT export.
+Valid values are one of:
+1. nil
+2. path to a styles.xml file
+3. path to a *.odt or a *.ott file
+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
+`org-odt-styles-dir' for more information.
+
+In case of option 3, the specified file is unzipped and the
+styles.xml embedded therein is used.
+
+In case of option 4, the specified ODT-OR-OTT-FILE is unzipped
+and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the
+generated odt file. Use relative path for specifying the
+FILE-MEMBERS. styles.xml must be specified as one of the
+FILE-MEMBERS.
+
+Use options 1, 2 or 3 only if styles.xml alone suffices for
+achieving the desired formatting. Use option 4, if the styles.xml
+references additional files like header and footer images for
+achieving the desired formatting.
+
+Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on
+a per-file basis. For example,
+
+#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or
+#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))."
+ :group 'org-export-odt
+ :version "24.1"
+ :type
+ '(choice
+ (const :tag "Factory settings" nil)
+ (file :must-match t :tag "styles.xml")
+ (file :must-match t :tag "ODT or OTT file")
+ (list :tag "ODT or OTT file + Members"
+ (file :must-match t :tag "ODF Text or Text Template file")
+ (cons :tag "Members"
+ (file :tag " Member" "styles.xml")
+ (repeat (file :tag "Member"))))))
+
+(eval-after-load 'org-exp
+ '(add-to-list 'org-export-inbuffer-options-extra
+ '("ODT_STYLES_FILE" :odt-styles-file)))
+
+(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?")
+
+(defvar org-export-odt-inline-images 'maybe)
+(defcustom org-export-odt-inline-image-extensions
+ '("png" "jpeg" "jpg" "gif")
+ "Extensions of image files that can be inlined into HTML."
+ :type '(repeat (string :tag "Extension"))
+ :group 'org-export-odt
+ :version "24.1")
+
+(defcustom org-export-odt-pixels-per-inch display-pixels-per-inch
+ "Scaling factor for converting images pixels to inches.
+Use this for sizing of embedded images. See Info node `(org)
+Images in ODT export' for more information."
+ :type 'float
+ :group 'org-export-odt
+ :version "24.1")
+
+(defcustom org-export-odt-create-custom-styles-for-srcblocks t
+ "Whether custom styles for colorized source blocks be automatically created.
+When this option is turned on, the exporter creates custom styles
+for source blocks based on the advice of `htmlfontify'. Creation
+of custom styles happen as part of `org-odt-hfy-face-to-css'.
+
+When this option is turned off exporter does not create such
+styles.
+
+Use the latter option if you do not want the custom styles to be
+based on your current display settings. It is necessary that the
+styles.xml already contains needed styles for colorizing to work.
+
+This variable is effective only if
+`org-export-odt-fontify-srcblocks' is turned on."
+ :group 'org-export-odt
+ :version "24.1"
+ :type 'boolean)
+
+(defvar org-export-odt-default-org-styles-alist
+ '((paragraph . ((default . "Text_20_body")
+ (fixedwidth . "OrgFixedWidthBlock")
+ (verse . "OrgVerse")
+ (quote . "Quotations")
+ (blockquote . "Quotations")
+ (center . "OrgCenter")
+ (left . "OrgLeft")
+ (right . "OrgRight")
+ (title . "OrgTitle")
+ (subtitle . "OrgSubtitle")
+ (footnote . "Footnote")
+ (src . "OrgSrcBlock")
+ (illustration . "Illustration")
+ (table . "Table")
+ (definition-term . "Text_20_body_20_bold")
+ (horizontal-line . "Horizontal_20_Line")))
+ (character . ((default . "Default")
+ (bold . "Bold")
+ (emphasis . "Emphasis")
+ (code . "OrgCode")
+ (verbatim . "OrgCode")
+ (strike . "Strikethrough")
+ (underline . "Underline")
+ (subscript . "OrgSubscript")
+ (superscript . "OrgSuperscript")))
+ (list . ((ordered . "OrgNumberedList")
+ (unordered . "OrgBulletedList")
+ (description . "OrgDescriptionList"))))
+ "Default styles for various entities.")
+
+(defvar org-export-odt-org-styles-alist org-export-odt-default-org-styles-alist)
+(defun org-odt-get-style-name-for-entity (category &optional entity)
+ (let ((entity (or entity 'default)))
+ (or
+ (cdr (assoc entity (cdr (assoc category
+ org-export-odt-org-styles-alist))))
+ (cdr (assoc entity (cdr (assoc category
+ org-export-odt-default-org-styles-alist))))
+ (error "Cannot determine style name for entity %s of type %s"
+ entity category))))
+
+(defcustom org-export-odt-preferred-output-format nil
+ "Automatically post-process to this format after exporting to \"odt\".
+Interactive commands `org-export-as-odt' and
+`org-export-as-odt-and-open' export first to \"odt\" format and
+then use `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'.
+
+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
+ (lambda (w)
+ (apply 'widget-convert (widget-type w)
+ (eval (car (widget-get w :args)))))
+ `((const :tag "None" nil)
+ ,@(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)
+ "Export the outline as ODT and immediately open it with a browser.
+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-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 ()
+ "Call the function `org-lparse-batch'.
+This function can be used in batch processing as:
+emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --eval \"(setq org-export-headline-levels 2)\"
+ --visit=MyFile --funcall org-export-as-odt-batch"
+ (org-lparse-batch "odt"))
+
+;;; org-export-as-odt
+;;;###autoload
+(defun org-export-as-odt (arg &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export the outline as a OpenDocumentText file.
+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. HIDDEN is obsolete and does nothing.
+EXT-PLIST is a property list with external parameters overriding
+org-mode's default settings, but still inferior to file-local
+settings. When TO-BUFFER is non-nil, create a buffer with that
+name and export to that buffer. If TO-BUFFER is the symbol
+`string', don't leave any buffer behind but just return the
+resulting XML as a string. When BODY-ONLY is set, don't produce
+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-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
+ . (org-odt-begin-export org-odt-end-export))
+ (DOCUMENT-CONTENT
+ . (org-odt-begin-document-content org-odt-end-document-content))
+ (DOCUMENT-BODY
+ . (org-odt-begin-document-body org-odt-end-document-body))
+ (TOC
+ . (org-odt-begin-toc org-odt-end-toc))
+ (ENVIRONMENT
+ . (org-odt-begin-environment org-odt-end-environment))
+ (FOOTNOTE-DEFINITION
+ . (org-odt-begin-footnote-definition org-odt-end-footnote-definition))
+ (TABLE
+ . (org-odt-begin-table org-odt-end-table))
+ (TABLE-ROWGROUP
+ . (org-odt-begin-table-rowgroup org-odt-end-table-rowgroup))
+ (LIST
+ . (org-odt-begin-list org-odt-end-list))
+ (LIST-ITEM
+ . (org-odt-begin-list-item org-odt-end-list-item))
+ (OUTLINE
+ . (org-odt-begin-outline org-odt-end-outline))
+ (OUTLINE-TEXT
+ . (org-odt-begin-outline-text org-odt-end-outline-text))
+ (PARAGRAPH
+ . (org-odt-begin-paragraph org-odt-end-paragraph)))
+ "")
+
+(defvar org-odt-entity-format-callbacks-alist
+ `((EXTRA-TARGETS . org-lparse-format-extra-targets)
+ (ORG-TAGS . org-lparse-format-org-tags)
+ (SECTION-NUMBER . org-lparse-format-section-number)
+ (HEADLINE . org-odt-format-headline)
+ (TOC-ENTRY . org-odt-format-toc-entry)
+ (TOC-ITEM . org-odt-format-toc-item)
+ (TAGS . org-odt-format-tags)
+ (SPACES . org-odt-format-spaces)
+ (TABS . org-odt-format-tabs)
+ (LINE-BREAK . org-odt-format-line-break)
+ (FONTIFY . org-odt-format-fontify)
+ (TODO . org-lparse-format-todo)
+ (LINK . org-odt-format-link)
+ (INLINE-IMAGE . org-odt-format-inline-image)
+ (ORG-LINK . org-odt-format-org-link)
+ (HEADING . org-odt-format-heading)
+ (ANCHOR . org-odt-format-anchor)
+ (TABLE . org-lparse-format-table)
+ (TABLE-ROW . org-odt-format-table-row)
+ (TABLE-CELL . org-odt-format-table-cell)
+ (FOOTNOTES-SECTION . ignore)
+ (FOOTNOTE-REFERENCE . org-odt-format-footnote-reference)
+ (HORIZONTAL-LINE . org-odt-format-horizontal-line)
+ (COMMENT . org-odt-format-comment)
+ (LINE . org-odt-format-line)
+ (ORG-ENTITY . org-odt-format-org-entity))
+ "")
+
+;;;_. callbacks
+;;;_. control callbacks
+;;;_ , document body
+(defun org-odt-begin-office-body ()
+ ;; automatic styles
+ (insert-file-contents
+ (or org-export-odt-content-template-file
+ (expand-file-name "OrgOdtContentTemplate.xml"
+ org-odt-styles-dir)))
+ (goto-char (point-min))
+ (re-search-forward "</office:text>" nil nil)
+ (delete-region (match-beginning 0) (point-max)))
+
+;; Following variable is let bound when `org-do-lparse' is in
+;; 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")))
+
+(defun org-odt-format-preamble (opt-plist)
+ (let* ((title (plist-get opt-plist :title))
+ (author (plist-get opt-plist :author))
+ (date (plist-get opt-plist :date))
+ (iso-date (org-odt-format-date date))
+ (date (org-odt-format-date date "%d %b %Y"))
+ (email (plist-get opt-plist :email))
+ ;; switch on or off above vars based on user settings
+ (author (and (plist-get opt-plist :author-info) (or author email)))
+ (email (and (plist-get opt-plist :email-info) email))
+ (date (and (plist-get opt-plist :time-stamp-file) date)))
+ (concat
+ ;; title
+ (when title
+ (concat
+ (org-odt-format-stylized-paragraph
+ 'title (org-odt-format-tags
+ '("<text:title>" . "</text:title>") title))
+ ;; separator
+ "<text:p text:style-name=\"OrgTitle\"/>"))
+ (cond
+ ((and author (not email))
+ ;; author only
+ (concat
+ (org-odt-format-stylized-paragraph
+ 'subtitle
+ (org-odt-format-tags
+ '("<text:initial-creator>" . "</text:initial-creator>")
+ author))
+ ;; separator
+ "<text:p text:style-name=\"OrgSubtitle\"/>"))
+ ((and author email)
+ ;; author and email
+ (concat
+ (org-odt-format-stylized-paragraph
+ 'subtitle
+ (org-odt-format-link
+ (org-odt-format-tags
+ '("<text:initial-creator>" . "</text:initial-creator>")
+ author) (concat "mailto:" email)))
+ ;; separator
+ "<text:p text:style-name=\"OrgSubtitle\"/>")))
+ ;; date
+ (when date
+ (concat
+ (org-odt-format-stylized-paragraph
+ 'subtitle
+ (org-odt-format-tags
+ '("<text:date style:data-style-name=\"%s\" text:date-value=\"%s\">"
+ . "</text:date>") date "N75" iso-date))
+ ;; separator
+ "<text:p text:style-name=\"OrgSubtitle\"/>")))))
+
+(defun org-odt-begin-document-body (opt-plist)
+ (org-odt-begin-office-body)
+ (insert (org-odt-format-preamble opt-plist))
+ (setq org-lparse-dyn-first-heading-pos (point)))
+
+(defvar org-lparse-body-only) ; let bound during org-do-lparse
+(defvar org-lparse-to-buffer) ; let bound during org-do-lparse
+(defun org-odt-end-document-body (opt-plist)
+ (unless org-lparse-body-only
+ (org-lparse-insert-tag "</office:text>")
+ (org-lparse-insert-tag "</office:body>")))
+
+(defun org-odt-begin-document-content (opt-plist)
+ (ignore))
+
+(defun org-odt-end-document-content ()
+ (org-lparse-insert-tag "</office:document-content>"))
+
+(defun org-odt-begin-outline (level1 snumber title tags
+ target extra-targets class)
+ (org-lparse-insert
+ 'HEADING (org-lparse-format
+ 'HEADLINE title extra-targets tags snumber level1)
+ level1 target))
+
+(defun org-odt-end-outline ()
+ (ignore))
+
+(defun org-odt-begin-outline-text (level1 snumber class)
+ (ignore))
+
+(defun org-odt-end-outline-text ()
+ (ignore))
+
+(defun org-odt-begin-section (style &optional name)
+ (let ((default-name (car (org-odt-add-automatic-style "Section"))))
+ (org-lparse-insert-tag
+ "<text:section text:style-name=\"%s\" text:name=\"%s\">"
+ style (or name default-name))))
+
+(defun org-odt-end-section ()
+ (org-lparse-insert-tag "</text:section>"))
+
+(defun org-odt-begin-paragraph (&optional style)
+ (org-lparse-insert-tag
+ "<text:p%s>" (org-odt-get-extra-attrs-for-paragraph-style style)))
+
+(defun org-odt-end-paragraph ()
+ (org-lparse-insert-tag "</text:p>"))
+
+(defun org-odt-get-extra-attrs-for-paragraph-style (style)
+ (let (style-name)
+ (setq style-name
+ (cond
+ ((stringp style) style)
+ ((symbolp style) (org-odt-get-style-name-for-entity
+ 'paragraph style))))
+ (unless style-name
+ (error "Don't know how to handle paragraph style %s" style))
+ (format " text:style-name=\"%s\"" style-name)))
+
+(defun org-odt-format-stylized-paragraph (style text)
+ (org-odt-format-tags
+ '("<text:p%s>" . "</text:p>") text
+ (org-odt-get-extra-attrs-for-paragraph-style style)))
+
+(defvar org-lparse-opt-plist) ; bound during org-do-lparse
+(defun org-odt-format-author (&optional author)
+ (when (setq author (or author (plist-get org-lparse-opt-plist :author)))
+ (org-odt-format-tags '("<dc:creator>" . "</dc:creator>") author)))
+
+(defun org-odt-format-date (&optional org-ts fmt)
+ (save-match-data
+ (let* ((time
+ (and (stringp org-ts)
+ (string-match org-ts-regexp0 org-ts)
+ (apply 'encode-time
+ (org-fix-decoded-time
+ (org-parse-time-string (match-string 0 org-ts) t)))))
+ date)
+ (cond
+ (fmt (format-time-string fmt time))
+ (t (setq date (format-time-string "%Y-%m-%dT%H:%M:%S%z" time))
+ (format "%s:%s" (substring date 0 -2) (substring date -2)))))))
+
+(defun org-odt-begin-annotation (&optional author date)
+ (org-lparse-insert-tag "<office:annotation>")
+ (when (setq author (org-odt-format-author author))
+ (insert author))
+ (insert (org-odt-format-tags
+ '("<dc:date>" . "</dc:date>")
+ (org-odt-format-date
+ (or date (plist-get org-lparse-opt-plist :date)))))
+ (org-lparse-begin-paragraph))
+
+(defun org-odt-end-annotation ()
+ (org-lparse-insert-tag "</office:annotation>"))
+
+(defun org-odt-begin-environment (style env-options-plist)
+ (case style
+ (annotation
+ (org-lparse-stash-save-paragraph-state)
+ (org-odt-begin-annotation (plist-get env-options-plist 'author)
+ (plist-get env-options-plist 'date)))
+ ((blockquote verse center quote)
+ (org-lparse-begin-paragraph style)
+ (list))
+ ((fixedwidth native)
+ (org-lparse-end-paragraph)
+ (list))
+ (t (error "Unknown environment %s" style))))
+
+(defun org-odt-end-environment (style env-options-plist)
+ (case style
+ (annotation
+ (org-lparse-end-paragraph)
+ (org-odt-end-annotation)
+ (org-lparse-stash-pop-paragraph-state))
+ ((blockquote verse center quote)
+ (org-lparse-end-paragraph)
+ (list))
+ ((fixedwidth native)
+ (org-lparse-begin-paragraph)
+ (list))
+ (t (error "Unknown environment %s" style))))
+
+(defvar org-lparse-list-stack) ; dynamically bound in org-do-lparse
+(defvar org-odt-list-stack-stashed)
+(defun org-odt-begin-list (ltype)
+ (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
+ ltype))
+ (let* ((style-name (org-odt-get-style-name-for-entity 'list ltype))
+ (extra (concat (if (or org-lparse-list-table-p
+ (and (= 1 (length org-lparse-list-stack))
+ (null org-odt-list-stack-stashed)))
+ " text:continue-numbering=\"false\""
+ " text:continue-numbering=\"true\"")
+ (when style-name
+ (format " text:style-name=\"%s\"" style-name)))))
+ (case ltype
+ ((ordered unordered description)
+ (org-lparse-end-paragraph)
+ (org-lparse-insert-tag "<text:list%s>" extra))
+ (t (error "Unknown list type: %s" ltype)))))
+
+(defun org-odt-end-list (ltype)
+ (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
+ ltype))
+ (if ltype
+ (org-lparse-insert-tag "</text:list>")
+ (error "Unknown list type: %s" ltype)))
+
+(defun org-odt-begin-list-item (ltype &optional arg headline)
+ (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
+ ltype))
+ (case ltype
+ (ordered
+ (assert (not headline) t)
+ (let* ((counter arg) (extra ""))
+ (org-lparse-insert-tag (if (= (length org-lparse-list-stack)
+ (length org-odt-list-stack-stashed))
+ "<text:list-header>" "<text:list-item>"))
+ (org-lparse-begin-paragraph)))
+ (unordered
+ (let* ((id arg) (extra ""))
+ (org-lparse-insert-tag (if (= (length org-lparse-list-stack)
+ (length org-odt-list-stack-stashed))
+ "<text:list-header>" "<text:list-item>"))
+ (org-lparse-begin-paragraph)
+ (insert (if headline (org-odt-format-target headline id)
+ (org-odt-format-bookmark "" id)))))
+ (description
+ (assert (not headline) t)
+ (let ((term (or arg "(no term)")))
+ (insert
+ (org-odt-format-tags
+ '("<text:list-item>" . "</text:list-item>")
+ (org-odt-format-stylized-paragraph 'definition-term term)))
+ (org-lparse-begin-list-item 'unordered)
+ (org-lparse-begin-list 'description)
+ (org-lparse-begin-list-item 'unordered)))
+ (t (error "Unknown list type"))))
+
+(defun org-odt-end-list-item (ltype)
+ (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
+ ltype))
+ (case ltype
+ ((ordered unordered)
+ (org-lparse-insert-tag (if (= (length org-lparse-list-stack)
+ (length org-odt-list-stack-stashed))
+ (prog1 "</text:list-header>"
+ (setq org-odt-list-stack-stashed nil))
+ "</text:list-item>")))
+ (description
+ (org-lparse-end-list-item-1)
+ (org-lparse-end-list 'description)
+ (org-lparse-end-list-item-1))
+ (t (error "Unknown list type"))))
+
+(defun org-odt-discontinue-list ()
+ (let ((stashed-stack org-lparse-list-stack))
+ (loop for list-type in stashed-stack
+ do (org-lparse-end-list-item-1 list-type)
+ (org-lparse-end-list list-type))
+ (setq org-odt-list-stack-stashed stashed-stack)))
+
+(defun org-odt-continue-list ()
+ (setq org-odt-list-stack-stashed (nreverse org-odt-list-stack-stashed))
+ (loop for list-type in org-odt-list-stack-stashed
+ do (org-lparse-begin-list list-type)
+ (org-lparse-begin-list-item list-type)))
+
+;; Following variables are let bound when table emission is in
+;; progress. See org-lparse.el.
+(defvar org-lparse-table-begin-marker)
+(defvar org-lparse-table-ncols)
+(defvar org-lparse-table-rowgrp-open)
+(defvar org-lparse-table-rownum)
+(defvar org-lparse-table-cur-rowgrp-is-hdr)
+(defvar org-lparse-table-is-styled)
+(defvar org-lparse-table-rowgrp-info)
+(defvar org-lparse-table-colalign-vector)
+
+(defvar org-odt-table-style nil
+ "Table style specified by \"#+ATTR_ODT: <style-name>\" line.
+This is set during `org-odt-begin-table'.")
+
+(defvar org-odt-table-style-spec nil
+ "Entry for `org-odt-table-style' in `org-export-odt-table-styles'.")
+
+(defcustom org-export-odt-table-styles
+ '(("OrgEquation" "OrgEquation"
+ ((use-first-column-styles . t)
+ (use-last-column-styles . t))))
+ "Specify how Table Styles should be derived from a Table Template.
+This is a list where each element is of the
+form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS).
+
+TABLE-STYLE-NAME is the style associated with the table through
+`org-odt-table-style'.
+
+TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic
+TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined
+below) that is included in
+`org-export-odt-content-template-file'.
+
+TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
+ \"TableCell\"
+PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
+ \"TableParagraph\"
+TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" |
+ \"FirstRow\" | \"LastRow\" |
+ \"EvenRow\" | \"OddRow\" |
+ \"EvenColumn\" | \"OddColumn\" | \"\"
+where \"+\" above denotes string concatenation.
+
+TABLE-CELL-OPTIONS is an alist where each element is of the
+form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF).
+TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' |
+ `use-last-row-styles' |
+ `use-first-column-styles' |
+ `use-last-column-styles' |
+ `use-banding-rows-styles' |
+ `use-banding-columns-styles' |
+ `use-first-row-styles'
+ON-OR-OFF := `t' | `nil'
+
+For example, with the following configuration
+
+\(setq org-export-odt-table-styles
+ '\(\(\"TableWithHeaderRowsAndColumns\" \"Custom\"
+ \(\(use-first-row-styles . t\)
+ \(use-first-column-styles . t\)\)\)
+ \(\"TableWithHeaderColumns\" \"Custom\"
+ \(\(use-first-column-styles . t\)\)\)\)\)
+
+1. A table associated with \"TableWithHeaderRowsAndColumns\"
+ style will use the following table-cell styles -
+ \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\",
+ \"CustomTableCell\" and the following paragraph styles
+ \"CustomFirstRowTableParagraph\",
+ \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\"
+ as appropriate.
+
+2. A table associated with \"TableWithHeaderColumns\" style will
+ use the following table-cell styles -
+ \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the
+ following paragraph styles
+ \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\"
+ as appropriate..
+
+Note that TABLE-TEMPLATE-NAME corresponds to the
+\"<table:table-template>\" elements contained within
+\"<office:styles>\". The entries (TABLE-STYLE-NAME
+TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to
+\"table:template-name\" and \"table:use-first-row-styles\" etc
+attributes of \"<table:table>\" element. Refer ODF-1.2
+specification for more information. Also consult the
+implementation filed under `org-odt-get-table-cell-styles'.
+
+The TABLE-STYLE-NAME \"OrgEquation\" is used internally for
+formatting of numbered display equations. Do not delete this
+style from the list."
+ :group 'org-export-odt
+ :version "24.1"
+ :type '(choice
+ (const :tag "None" nil)
+ (repeat :tag "Table Styles"
+ (list :tag "Table Style Specification"
+ (string :tag "Table Style Name")
+ (string :tag "Table Template Name")
+ (alist :options (use-first-row-styles
+ use-last-row-styles
+ use-first-column-styles
+ use-last-column-styles
+ use-banding-rows-styles
+ use-banding-columns-styles)
+ :key-type symbol
+ :value-type (const :tag "True" t))))))
+
+(defvar org-odt-table-style-format
+ "
+<style:style style:name=\"%s\" style:family=\"table\">
+ <style:table-properties style:rel-width=\"%d%%\" fo:margin-top=\"0cm\" fo:margin-bottom=\"0.20cm\" table:align=\"center\"/>
+</style:style>
+"
+ "Template for auto-generated Table styles.")
+
+(defvar org-odt-automatic-styles '()
+ "Registry of automatic styles for various OBJECT-TYPEs.
+The variable has the following form:
+\(\(OBJECT-TYPE-A
+ \(\(OBJECT-NAME-A.1 OBJECT-PROPS-A.1\)
+ \(OBJECT-NAME-A.2 OBJECT-PROPS-A.2\) ...\)\)
+ \(OBJECT-TYPE-B
+ \(\(OBJECT-NAME-B.1 OBJECT-PROPS-B.1\)
+ \(OBJECT-NAME-B.2 OBJECT-PROPS-B.2\) ...\)\)
+ ...\).
+
+OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc.
+OBJECT-PROPS is (typically) a plist created by passing
+\"#+ATTR_ODT: \" option to `org-lparse-get-block-params'.
+
+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
+`org-odt-add-automatic-style'.")
+
+(defun org-odt-write-automatic-styles ()
+ "Write automatic styles to \"content.xml\"."
+ (with-current-buffer
+ (find-file-noselect (expand-file-name "content.xml") t)
+ ;; position the cursor
+ (goto-char (point-min))
+ (re-search-forward " </office:automatic-styles>" nil t)
+ (goto-char (match-beginning 0))
+ ;; write automatic table styles
+ (loop for (style-name props) in
+ (plist-get org-odt-automatic-styles 'Table) do
+ (when (setq props (or (plist-get props :rel-width) 96))
+ (insert (format org-odt-table-style-format style-name props))))))
+
+(defun org-odt-add-automatic-style (object-type &optional object-props)
+ "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS.
+OBJECT-PROPS is (typically) a plist created by passing
+\"#+ATTR_ODT: \" option of the object in question to
+`org-lparse-get-block-params'.
+
+Use `org-odt-object-counters' to generate an automatic
+OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a
+new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
+. STYLE-NAME)."
+ (assert (stringp object-type))
+ (let* ((object (intern object-type))
+ (seqvar object)
+ (seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0)))
+ (object-name (format "%s%d" object-type seqno)) style-name)
+ (setq org-odt-object-counters
+ (plist-put org-odt-object-counters seqvar seqno))
+ (when object-props
+ (setq style-name (format "Org%s" object-name))
+ (setq org-odt-automatic-styles
+ (plist-put org-odt-automatic-styles object
+ (append (list (list style-name object-props))
+ (plist-get org-odt-automatic-styles object)))))
+ (cons object-name style-name)))
+
+(defvar org-odt-table-indentedp nil)
+(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.
+ ;; OpenDocument doesn't allow table to appear within list items.
+ ;; Temporarily terminate the list, emit the table and then
+ ;; re-continue the list.
+ (org-odt-discontinue-list)
+ ;; Put the Table in an indented section.
+ (let ((level (length org-odt-list-stack-stashed)))
+ (org-odt-begin-section (format "OrgIndentedSection-Level-%d" level))))
+ (setq attributes (org-lparse-get-block-params attributes))
+ (setq org-odt-table-style (plist-get attributes :style))
+ (setq org-odt-table-style-spec
+ (assoc org-odt-table-style org-export-odt-table-styles))
+ (when (or label caption)
+ (insert
+ (org-odt-format-stylized-paragraph
+ 'table (org-odt-format-entity-caption label caption "__Table__"))))
+ (let ((automatic-name (org-odt-add-automatic-style "Table" attributes)))
+ (org-lparse-insert-tag
+ "<table:table table:name=\"%s\" table:style-name=\"%s\">"
+ (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)
+(defun org-odt-end-table ()
+ (goto-char org-lparse-table-begin-marker)
+ (loop for level from 0 below org-lparse-table-ncols
+ do (let* ((col-cookie (and org-lparse-table-is-styled
+ (cdr (assoc (1+ level)
+ org-lparse-table-colalign-info))))
+ (extra-columns (or (nth 1 col-cookie) 0)))
+ (dotimes (i (1+ extra-columns))
+ (insert
+ (org-odt-format-tags
+ "<table:table-column table:style-name=\"%sColumn\"/>"
+ "" (or (nth 1 org-odt-table-style-spec) "OrgTable"))))
+ (insert "\n")))
+ ;; fill style attributes for table cells
+ (when org-lparse-table-is-styled
+ (while (re-search-forward "@@\\(table-cell:p\\|table-cell:style-name\\)@@\\([0-9]+\\)@@\\([0-9]+\\)@@" nil t)
+ (let* ((spec (match-string 1))
+ (r (string-to-number (match-string 2)))
+ (c (string-to-number (match-string 3)))
+ (cell-styles (org-odt-get-table-cell-styles
+ r c org-odt-table-style-spec))
+ (table-cell-style (car cell-styles))
+ (table-cell-paragraph-style (cdr cell-styles)))
+ (cond
+ ((equal spec "table-cell:p")
+ (replace-match table-cell-paragraph-style t t))
+ ((equal spec "table-cell:style-name")
+ (replace-match table-cell-style t t))))))
+ (goto-char (point-max))
+ (org-lparse-insert-tag "</table:table>")
+ (when org-odt-table-indentedp
+ (org-odt-end-section)
+ (org-odt-continue-list)))
+
+(defun org-odt-begin-table-rowgroup (&optional is-header-row)
+ (when org-lparse-table-rowgrp-open
+ (org-lparse-end 'TABLE-ROWGROUP))
+ (org-lparse-insert-tag (if is-header-row
+ "<table:table-header-rows>"
+ "<table:table-rows>"))
+ (setq org-lparse-table-rowgrp-open t)
+ (setq org-lparse-table-cur-rowgrp-is-hdr is-header-row))
+
+(defun org-odt-end-table-rowgroup ()
+ (when org-lparse-table-rowgrp-open
+ (setq org-lparse-table-rowgrp-open nil)
+ (org-lparse-insert-tag
+ (if org-lparse-table-cur-rowgrp-is-hdr
+ "</table:table-header-rows>" "</table:table-rows>"))))
+
+(defun org-odt-format-table-row (row)
+ (org-odt-format-tags
+ '("<table:table-row>" . "</table:table-row>") row))
+
+(defun org-odt-get-table-cell-styles (r c &optional style-spec)
+ "Retrieve styles applicable to a table cell.
+R and C are (zero-based) row and column numbers of the table
+cell. STYLE-SPEC is an entry in `org-export-odt-table-styles'
+applicable to the current table. It is `nil' if the table is not
+associated with any style attributes.
+
+Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME).
+
+When STYLE-SPEC is nil, style the table cell the conventional way
+- choose cell borders based on row and column groupings and
+choose paragraph alignment based on `org-col-cookies' text
+property. See also
+`org-odt-get-paragraph-style-cookie-for-table-cell'.
+
+When STYLE-SPEC is non-nil, ignore the above cookie and return
+styles congruent with the ODF-1.2 specification."
+ (cond
+ (style-spec
+
+ ;; LibreOffice - particularly the Writer - honors neither table
+ ;; templates nor custom table-cell styles. Inorder to retain
+ ;; inter-operability with LibreOffice, only automatic styles are
+ ;; used for styling of table-cells. The current implementation is
+ ;; congruent with ODF-1.2 specification and hence is
+ ;; future-compatible.
+
+ ;; 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
+ ;; by hand.
+
+ (let* ((template-name (nth 1 style-spec))
+ (cell-style-selectors (nth 2 style-spec))
+ (cell-type
+ (cond
+ ((and (cdr (assoc 'use-first-column-styles cell-style-selectors))
+ (= c 0)) "FirstColumn")
+ ((and (cdr (assoc 'use-last-column-styles cell-style-selectors))
+ (= c (1- org-lparse-table-ncols))) "LastColumn")
+ ((and (cdr (assoc 'use-first-row-styles cell-style-selectors))
+ (= r 0)) "FirstRow")
+ ((and (cdr (assoc 'use-last-row-styles cell-style-selectors))
+ (= r org-lparse-table-rownum))
+ "LastRow")
+ ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
+ (= (% r 2) 1)) "EvenRow")
+ ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
+ (= (% r 2) 0)) "OddRow")
+ ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
+ (= (% c 2) 1)) "EvenColumn")
+ ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
+ (= (% c 2) 0)) "OddColumn")
+ (t ""))))
+ (cons
+ (concat template-name cell-type "TableCell")
+ (concat template-name cell-type "TableParagraph"))))
+ (t
+ (cons
+ (concat
+ "OrgTblCell"
+ (cond
+ ((= r 0) "T")
+ ((eq (cdr (assoc r org-lparse-table-rowgrp-info)) :start) "T")
+ (t ""))
+ (when (= r org-lparse-table-rownum) "B")
+ (cond
+ ((= c 0) "")
+ ((or (memq (nth c org-table-colgroup-info) '(:start :startend))
+ (memq (nth (1- c) org-table-colgroup-info) '(:end :startend))) "L")
+ (t "")))
+ (capitalize (aref org-lparse-table-colalign-vector c))))))
+
+(defun org-odt-get-paragraph-style-cookie-for-table-cell (r c)
+ (concat
+ (and (not org-odt-table-style-spec)
+ (cond
+ (org-lparse-table-cur-rowgrp-is-hdr "OrgTableHeading")
+ ((and (= c 0) (org-lparse-get 'TABLE-FIRST-COLUMN-AS-LABELS))
+ "OrgTableHeading")
+ (t "OrgTableContents")))
+ (and org-lparse-table-is-styled
+ (format "@@table-cell:p@@%03d@@%03d@@" r c))))
+
+(defun org-odt-get-style-name-cookie-for-table-cell (r c)
+ (when org-lparse-table-is-styled
+ (format "@@table-cell:style-name@@%03d@@%03d@@" r c)))
+
+(defun org-odt-format-table-cell (data r c horiz-span)
+ (concat
+ (let* ((paragraph-style-cookie
+ (org-odt-get-paragraph-style-cookie-for-table-cell r c))
+ (style-name-cookie
+ (org-odt-get-style-name-cookie-for-table-cell r c))
+ (extra (and style-name-cookie
+ (format " table:style-name=\"%s\"" style-name-cookie)))
+ (extra (concat extra
+ (and (> horiz-span 0)
+ (format " table:number-columns-spanned=\"%d\""
+ (1+ horiz-span))))))
+ (org-odt-format-tags
+ '("<table:table-cell%s>" . "</table:table-cell>")
+ (if org-lparse-list-table-p data
+ (org-odt-format-stylized-paragraph paragraph-style-cookie data)) extra))
+ (let (s)
+ (dotimes (i horiz-span)
+ (setq s (concat s "\n<table:covered-table-cell/>"))) s)
+ "\n"))
+
+(defun org-odt-begin-footnote-definition (n)
+ (org-lparse-begin-paragraph 'footnote))
+
+(defun org-odt-end-footnote-definition (n)
+ (org-lparse-end-paragraph))
+
+(defun org-odt-begin-toc (lang-specific-heading max-level)
+ ;; Strings in `org-export-language-setup' can contain named html
+ ;; entities. Replace those with utf-8 equivalents.
+ (let ((i 0) entity rpl)
+ (while (string-match "&\\([^#].*?\\);" lang-specific-heading i)
+ (setq entity (match-string 1 lang-specific-heading))
+ (if (not (setq rpl (org-entity-get-representation entity 'utf8)))
+ (setq i (match-end 0))
+ (setq i (+ (match-beginning 0) (length rpl)))
+ (setq lang-specific-heading
+ (replace-match rpl t t lang-specific-heading)))))
+ (insert
+ (format "
+ <text:table-of-content text:style-name=\"Sect2\" text:protected=\"true\" text:name=\"Table of Contents1\">
+ <text:table-of-content-source text:outline-level=\"%d\">
+ <text:index-title-template text:style-name=\"Contents_20_Heading\">%s</text:index-title-template>
+" max-level lang-specific-heading))
+ (loop for level from 1 upto 10
+ do (insert (format
+ "
+ <text:table-of-content-entry-template text:outline-level=\"%d\" text:style-name=\"Contents_20_%d\">
+ <text:index-entry-link-start text:style-name=\"Internet_20_link\"/>
+ <text:index-entry-chapter/>
+ <text:index-entry-text/>
+ <text:index-entry-link-end/>
+ </text:table-of-content-entry-template>
+" level level)))
+
+ (insert
+ (format "
+ </text:table-of-content-source>
+
+ <text:index-body>
+ <text:index-title text:style-name=\"Sect1\" text:name=\"Table of Contents1_Head\">
+ <text:p text:style-name=\"Contents_20_Heading\">%s</text:p>
+ </text:index-title>
+" lang-specific-heading)))
+
+(defun org-odt-end-toc ()
+ (insert "
+ </text:index-body>
+ </text:table-of-content>
+"))
+
+(defun org-odt-format-toc-entry (snumber todo headline tags href)
+ (setq headline (concat
+ (and org-export-with-section-numbers
+ (concat snumber ". "))
+ headline
+ (and tags
+ (concat
+ (org-lparse-format 'SPACES 3)
+ (org-lparse-format 'FONTIFY tags "tag")))))
+ (when todo
+ (setq headline (org-lparse-format 'FONTIFY headline "todo")))
+
+ (let ((org-odt-suppress-xref t))
+ (org-odt-format-link headline (concat "#" href))))
+
+(defun org-odt-format-toc-item (toc-entry level org-last-level)
+ (let ((style (format "Contents_20_%d"
+ (+ 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
+;; org-html.el
+(defvar org-lparse-link-description-is-image nil)
+(defun org-odt-format-link (desc href &optional attr)
+ (cond
+ ((and (= (string-to-char href) ?#) (not org-odt-suppress-xref))
+ (setq href (substring href 1))
+ (let ((xref-format "text"))
+ (when (numberp desc)
+ (setq desc (format "%d" desc) xref-format "number"))
+ (when (listp desc)
+ (setq desc (mapconcat 'identity desc ".") xref-format "chapter"))
+ (setq href (concat org-export-odt-bookmark-prefix href))
+ (org-odt-format-tags
+ '("<text:bookmark-ref text:reference-format=\"%s\" text:ref-name=\"%s\">" .
+ "</text:bookmark-ref>")
+ desc xref-format href)))
+ (org-lparse-link-description-is-image
+ (org-odt-format-tags
+ '("<draw:a xlink:type=\"simple\" xlink:href=\"%s\" %s>" . "</draw:a>")
+ desc href (or attr "")))
+ (t
+ (org-odt-format-tags
+ '("<text:a xlink:type=\"simple\" xlink:href=\"%s\" %s>" . "</text:a>")
+ desc href (or attr "")))))
+
+(defun org-odt-format-spaces (n)
+ (cond
+ ((= n 1) " ")
+ ((> n 1) (concat
+ " " (org-odt-format-tags "<text:s text:c=\"%d\"/>" "" (1- n))))
+ (t "")))
+
+(defun org-odt-format-tabs (&optional n)
+ (let ((tab "<text:tab/>")
+ (n (or n 1)))
+ (insert tab)))
+
+(defun org-odt-format-line-break ()
+ (org-odt-format-tags "<text:line-break/>" ""))
+
+(defun org-odt-format-horizontal-line ()
+ (org-odt-format-stylized-paragraph 'horizontal-line ""))
+
+(defun org-odt-encode-plain-text (line &optional no-whitespace-filling)
+ (setq line (org-xml-encode-plain-text line))
+ (if no-whitespace-filling line
+ (org-odt-fill-tabs-and-spaces line)))
+
+(defun org-odt-format-line (line)
+ (case org-lparse-dyn-current-environment
+ (fixedwidth (concat
+ (org-odt-format-stylized-paragraph
+ 'fixedwidth (org-odt-encode-plain-text line)) "\n"))
+ (t (concat line "\n"))))
+
+(defun org-odt-format-comment (fmt &rest args)
+ (let ((comment (apply 'format fmt args)))
+ (format "\n<!-- %s -->\n" comment)))
+
+(defun org-odt-format-org-entity (wd)
+ (org-entity-get-representation wd 'utf8))
+
+(defun org-odt-fill-tabs-and-spaces (line)
+ (replace-regexp-in-string
+ "\\([\t]\\|\\([ ]+\\)\\)" (lambda (s)
+ (cond
+ ((string= s "\t") (org-odt-format-tabs))
+ (t (org-odt-format-spaces (length s))))) line))
+
+(defcustom org-export-odt-fontify-srcblocks t
+ "Specify whether or not source blocks need to be fontified.
+Turn this option on if you want to colorize the source code
+blocks in the exported file. For colorization to work, you need
+to make available an enhanced version of `htmlfontify' library."
+ :type 'boolean
+ :group 'org-export-odt
+ :version "24.1")
+
+(defun org-odt-format-source-line-with-line-number-and-label
+ (line rpllbl num fontifier par-style)
+
+ (let ((keep-label (not (numberp rpllbl)))
+ (ref (org-find-text-property-in-string 'org-coderef line)))
+ (setq line (concat line (and keep-label ref (format "(%s)" ref))))
+ (setq line (funcall fontifier line))
+ (when ref
+ (setq line (org-odt-format-target line (concat "coderef-" ref))))
+ (setq line (org-odt-format-stylized-paragraph par-style line))
+ (if (not num) line
+ (org-odt-format-tags '("<text:list-item>" . "</text:list-item>") line))))
+
+(defun org-odt-format-source-code-or-example-plain
+ (lines lang caption textareap cols rows num cont rpllbl fmt)
+ "Format source or example blocks much like fixedwidth blocks.
+Use this when `org-export-odt-fontify-srcblocks' option is turned
+off."
+ (let* ((lines (org-split-string lines "[\r\n]"))
+ (line-count (length lines))
+ (i 0))
+ (mapconcat
+ (lambda (line)
+ (incf i)
+ (org-odt-format-source-line-with-line-number-and-label
+ line rpllbl num 'org-odt-encode-plain-text
+ (if (= i line-count) "OrgFixedWidthBlockLastLine"
+ "OrgFixedWidthBlock")))
+ lines "\n")))
+
+(defvar org-src-block-paragraph-format
+ "<style:style style:name=\"OrgSrcBlock\" style:family=\"paragraph\" style:parent-style-name=\"Preformatted_20_Text\">
+ <style:paragraph-properties fo:background-color=\"%s\" fo:padding=\"0.049cm\" fo:border=\"0.51pt solid #000000\" style:shadow=\"none\">
+ <style:background-image/>
+ </style:paragraph-properties>
+ <style:text-properties fo:color=\"%s\"/>
+ </style:style>"
+ "Custom paragraph style for colorized source and example blocks.
+This style is much the same as that of \"OrgFixedWidthBlock\"
+except that the foreground and background colors are set
+according to the default face identified by the `htmlfontify'.")
+
+(defvar hfy-optimisations)
+(declare-function hfy-face-to-style "htmlfontify" (fn))
+(declare-function hfy-face-or-def-to-name "htmlfontify" (fn))
+
+(defun org-odt-hfy-face-to-css (fn)
+ "Create custom style for face FN.
+When FN is the default face, use it's foreground and background
+properties to create \"OrgSrcBlock\" paragraph style. Otherwise
+use it's color attribute to create a character style whose name
+is obtained from FN. Currently all attributes of FN other than
+color are ignored.
+
+The style name for a face FN is derived using the following
+operations on the face name in that order - de-dash, CamelCase
+and prefix with \"OrgSrc\". For example,
+`font-lock-function-name-face' is associated with
+\"OrgSrcFontLockFunctionNameFace\"."
+ (let* ((css-list (hfy-face-to-style fn))
+ (style-name ((lambda (fn)
+ (concat "OrgSrc"
+ (mapconcat
+ 'capitalize (split-string
+ (hfy-face-or-def-to-name fn) "-")
+ ""))) fn))
+ (color-val (cdr (assoc "color" css-list)))
+ (background-color-val (cdr (assoc "background" css-list)))
+ (style (and org-export-odt-create-custom-styles-for-srcblocks
+ (cond
+ ((eq fn 'default)
+ (format org-src-block-paragraph-format
+ background-color-val color-val))
+ (t
+ (format
+ "
+<style:style style:name=\"%s\" style:family=\"text\">
+ <style:text-properties fo:color=\"%s\"/>
+ </style:style>" style-name color-val))))))
+ (cons style-name style)))
+
+(defun org-odt-insert-custom-styles-for-srcblocks (styles)
+ "Save STYLES used for colorizing of source blocks.
+Update styles.xml with styles that were collected as part of
+`org-odt-hfy-face-to-css' callbacks."
+ (when styles
+ (with-current-buffer
+ (find-file-noselect (expand-file-name "styles.xml") t)
+ (goto-char (point-min))
+ (when (re-search-forward "</office:styles>" nil t)
+ (goto-char (match-beginning 0))
+ (insert "\n<!-- Org Htmlfontify Styles -->\n" styles "\n")))))
+
+(defun org-odt-format-source-code-or-example-colored
+ (lines lang caption textareap cols rows num cont rpllbl fmt)
+ "Format source or example blocks using `htmlfontify-string'.
+Use this routine when `org-export-odt-fontify-srcblocks' option
+is turned on."
+ (let* ((lang-m (and lang (or (cdr (assoc lang org-src-lang-modes)) lang)))
+ (mode (and lang-m (intern (concat (if (symbolp lang-m)
+ (symbol-name lang-m)
+ lang-m) "-mode"))))
+ (org-inhibit-startup t)
+ (org-startup-folded nil)
+ (lines (with-temp-buffer
+ (insert lines)
+ (if (functionp mode) (funcall mode) (fundamental-mode))
+ (font-lock-fontify-buffer)
+ (buffer-string)))
+ (hfy-html-quote-regex "\\([<\"&> ]\\)")
+ (hfy-html-quote-map '(("\"" "&quot;")
+ ("<" "&lt;")
+ ("&" "&amp;")
+ (">" "&gt;")
+ (" " "<text:s/>")
+ (" " "<text:tab/>")))
+ (hfy-face-to-css 'org-odt-hfy-face-to-css)
+ (hfy-optimisations-1 (copy-sequence hfy-optimisations))
+ (hfy-optimisations (add-to-list 'hfy-optimisations-1
+ 'body-text-only))
+ (hfy-begin-span-handler
+ (lambda (style text-block text-id text-begins-block-p)
+ (insert (format "<text:span text:style-name=\"%s\">" style))))
+ (hfy-end-span-handler (lambda nil (insert "</text:span>"))))
+ (when (fboundp 'htmlfontify-string)
+ (let* ((lines (org-split-string lines "[\r\n]"))
+ (line-count (length lines))
+ (i 0))
+ (mapconcat
+ (lambda (line)
+ (incf i)
+ (org-odt-format-source-line-with-line-number-and-label
+ line rpllbl num 'htmlfontify-string
+ (if (= i line-count) "OrgSrcBlockLastLine" "OrgSrcBlock")))
+ lines "\n")))))
+
+(defun org-odt-format-source-code-or-example (lines lang caption textareap
+ cols rows num cont
+ rpllbl fmt)
+ "Format source or example blocks for export.
+Use `org-odt-format-source-code-or-example-plain' or
+`org-odt-format-source-code-or-example-colored' depending on the
+value of `org-export-odt-fontify-srcblocks."
+ (setq lines (org-export-number-lines
+ lines 0 0 num cont rpllbl fmt 'preprocess)
+ lines (funcall
+ (or (and org-export-odt-fontify-srcblocks
+ (or (featurep 'htmlfontify)
+ ;; htmlfontify.el was introduced in Emacs 23.2
+ ;; So load it with some caution
+ (require 'htmlfontify nil t))
+ (fboundp 'htmlfontify-string)
+ 'org-odt-format-source-code-or-example-colored)
+ 'org-odt-format-source-code-or-example-plain)
+ lines lang caption textareap cols rows num cont rpllbl fmt))
+ (if (not num) lines
+ (let ((extra (format " text:continue-numbering=\"%s\""
+ (if cont "true" "false"))))
+ (org-odt-format-tags
+ '("<text:list text:style-name=\"OrgSrcBlockNumberedLine\"%s>"
+ . "</text:list>") lines extra))))
+
+(defun org-odt-remap-stylenames (style-name)
+ (or
+ (cdr (assoc style-name '(("timestamp-wrapper" . "OrgTimestampWrapper")
+ ("timestamp" . "OrgTimestamp")
+ ("timestamp-kwd" . "OrgTimestampKeyword")
+ ("tag" . "OrgTag")
+ ("todo" . "OrgTodo")
+ ("done" . "OrgDone")
+ ("target" . "OrgTarget"))))
+ style-name))
+
+(defun org-odt-format-fontify (text style &optional id)
+ (let* ((style-name
+ (cond
+ ((stringp style)
+ (org-odt-remap-stylenames style))
+ ((symbolp style)
+ (org-odt-get-style-name-for-entity 'character style))
+ ((listp style)
+ (assert (< 1 (length style)))
+ (let ((parent-style (pop style)))
+ (mapconcat (lambda (s)
+ ;; (assert (stringp s) t)
+ (org-odt-remap-stylenames s)) style "")
+ (org-odt-remap-stylenames parent-style)))
+ (t (error "Don't how to handle style %s" style)))))
+ (org-odt-format-tags
+ '("<text:span text:style-name=\"%s\">" . "</text:span>")
+ text style-name)))
+
+(defun org-odt-relocate-relative-path (path dir)
+ (if (file-name-absolute-p path) path
+ (file-relative-name (expand-file-name path dir)
+ (expand-file-name "eyecandy" dir))))
+
+(defun org-odt-format-inline-image (thefile)
+ (let* ((thelink (if (file-name-absolute-p thefile) thefile
+ (org-xml-format-href
+ (org-odt-relocate-relative-path
+ thefile org-current-export-file))))
+ (href
+ (org-odt-format-tags
+ "<draw:image xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>" ""
+ (if org-export-odt-embed-images
+ (org-odt-copy-image-file thefile) thelink))))
+ (org-export-odt-format-image thefile href)))
+
+(defvar org-odt-entity-labels-alist nil
+ "Associate Labels with the Labeled entities.
+Each element of the alist is of the form (LABEL-NAME
+CATEGORY-NAME SEQNO LABEL-STYLE-NAME). LABEL-NAME is same as
+that specified by \"#+LABEL: ...\" line. CATEGORY-NAME is the
+type of the entity that LABEL-NAME is attached to. CATEGORY-NAME
+can be one of \"Table\", \"Figure\" or \"Equation\". SEQNO is
+the unique number assigned to the referenced entity on a
+per-CATEGORY basis. It is generated sequentially and is 1-based.
+LABEL-STYLE-NAME is a key `org-odt-label-styles'.
+
+See `org-odt-add-label-definition' and
+`org-odt-fixup-label-references'.")
+
+(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
+ (org-find-text-property-in-string
+ 'org-latex-src-embed-type src))
+ (if (or caption label) 'paragraph 'character)))
+ width height)
+ (when latex-frag
+ (setq href (org-propertize href :title "LaTeX Fragment"
+ :description latex-frag)))
+ (cond
+ ((eq embed-as 'character)
+ (org-odt-format-entity "InlineFormula" href width height))
+ (t
+ (org-lparse-end-paragraph)
+ (org-lparse-insert-list-table
+ `((,(org-odt-format-entity
+ (if (not (or caption label)) "DisplayFormula"
+ "CaptionedDisplayFormula")
+ 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")
+ (apply 'org-odt-format-label-definition
+ caption label-props)))))
+ nil nil nil ":style \"OrgEquation\"" nil '((1 "c" 8) (2 "c" 1)))
+ (throw 'nextline nil))))))
+
+(defvar org-odt-embedded-formulas-count 0)
+(defun org-odt-copy-formula-file (path)
+ "Returns the internal name of the file"
+ (let* ((src-file (expand-file-name
+ path (file-name-directory org-current-export-file)))
+ (target-dir (format "Formula-%04d/"
+ (incf org-odt-embedded-formulas-count)))
+ (target-file (concat target-dir "content.xml")))
+ (when (not org-lparse-to-buffer)
+ (message "Embedding %s as %s ..."
+ (substring-no-properties path) target-file)
+
+ (make-directory target-dir)
+ (org-odt-create-manifest-file-entry
+ "application/vnd.oasis.opendocument.formula" target-dir "1.2")
+
+ (case (org-odt-is-formula-link-p src-file)
+ (mathml
+ (copy-file src-file target-file 'overwrite))
+ (odf
+ (org-odt-zip-extract-one src-file "content.xml" target-dir))
+ (t
+ (error "%s is not a formula file" src-file)))
+
+ (org-odt-create-manifest-file-entry "text/xml" target-file))
+ target-file))
+
+(defun org-odt-format-inline-formula (thefile)
+ (let* ((thelink (if (file-name-absolute-p thefile) thefile
+ (org-xml-format-href
+ (org-odt-relocate-relative-path
+ thefile org-current-export-file))))
+ (href
+ (org-odt-format-tags
+ "<draw:object xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>" ""
+ (file-name-directory (org-odt-copy-formula-file thefile)))))
+ (org-export-odt-format-formula thefile href)))
+
+(defun org-odt-is-formula-link-p (file)
+ (let ((case-fold-search nil))
+ (cond
+ ((string-match "\\.\\(mathml\\|mml\\)\\'" file)
+ 'mathml)
+ ((string-match "\\.odf\\'" file)
+ 'odf))))
+
+(defun org-odt-format-org-link (opt-plist type-1 path fragment desc attr
+ descp)
+ "Make a OpenDocument link.
+OPT-PLIST is an options list.
+TYPE-1 is the device-type of the link (THIS://foo.html).
+PATH is the path of the link (http://THIS#location).
+FRAGMENT is the fragment part of the link, if any (foo.html#THIS).
+DESC is the link description, if any.
+ATTR is a string of other attributes of the a element."
+ (declare (special org-lparse-par-open))
+ (save-match-data
+ (let* ((may-inline-p
+ (and (member type-1 '("http" "https" "file"))
+ (org-lparse-should-inline-p path descp)
+ (not fragment)))
+ (type (if (equal type-1 "id") "file" type-1))
+ (filename path)
+ (thefile path)
+ sec-frag sec-nos)
+ (cond
+ ;; check for inlined images
+ ((and (member type '("file"))
+ (not fragment)
+ (org-file-image-p
+ filename org-export-odt-inline-image-extensions)
+ (or (eq t org-export-odt-inline-images)
+ (and org-export-odt-inline-images (not descp))))
+ (org-odt-format-inline-image thefile))
+ ;; check for embedded formulas
+ ((and (member type '("file"))
+ (not fragment)
+ (org-odt-is-formula-link-p filename)
+ (or (not descp)))
+ (org-odt-format-inline-formula thefile))
+ ;; code references
+ ((string= type "coderef")
+ (let* ((ref fragment)
+ (lineno-or-ref (cdr (assoc ref org-export-code-refs)))
+ (desc (and descp desc))
+ (org-odt-suppress-xref nil)
+ (href (org-xml-format-href (concat "#coderef-" ref))))
+ (cond
+ ((and (numberp lineno-or-ref) (not desc))
+ (org-odt-format-link lineno-or-ref href))
+ ((and (numberp lineno-or-ref) desc
+ (string-match (regexp-quote (concat "(" ref ")")) desc))
+ (format (replace-match "%s" t t desc)
+ (org-odt-format-link lineno-or-ref href)))
+ (t
+ (setq desc (format
+ (if (and desc (string-match
+ (regexp-quote (concat "(" ref ")"))
+ desc))
+ (replace-match "%s" t t desc)
+ (or desc "%s"))
+ lineno-or-ref))
+ (org-odt-format-link (org-xml-format-desc desc) href)))))
+ ;; links to headlines
+ ((and (string= type "")
+ (or (not thefile) (string= thefile ""))
+ (plist-get org-lparse-opt-plist :section-numbers)
+ (setq sec-frag fragment)
+ (or (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag)
+ (and (setq sec-frag
+ (loop for alias in org-export-target-aliases do
+ (when (member fragment (cdr alias))
+ (return (car alias)))))
+ (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag)))
+ (setq sec-nos (org-split-string (match-string 1 sec-frag) "-"))
+ (<= (length sec-nos) (plist-get org-lparse-opt-plist
+ :headline-levels)))
+ (let ((org-odt-suppress-xref nil))
+ (org-odt-format-link sec-nos (concat "#" sec-frag) attr)))
+ (t
+ (when (string= type "file")
+ (setq thefile
+ (cond
+ ((file-name-absolute-p path)
+ (concat "file://" (expand-file-name path)))
+ (t (org-odt-relocate-relative-path
+ thefile org-current-export-file)))))
+
+ (when (and (member type '("" "http" "https" "file")) fragment)
+ (setq thefile (concat thefile "#" fragment)))
+
+ (setq thefile (org-xml-format-href thefile))
+
+ (when (not (member type '("" "file")))
+ (setq thefile (concat type ":" thefile)))
+
+ (let ((org-odt-suppress-xref nil))
+ (org-odt-format-link
+ (org-xml-format-desc desc) thefile attr)))))))
+
+(defun org-odt-format-heading (text level &optional id)
+ (let* ((text (if id (org-odt-format-target text id) text)))
+ (org-odt-format-tags
+ '("<text:h text:style-name=\"Heading_20_%s\" text:outline-level=\"%s\">" .
+ "</text:h>") text level level)))
+
+(defun org-odt-format-headline (title extra-targets tags
+ &optional snumber level)
+ (concat
+ (org-lparse-format 'EXTRA-TARGETS extra-targets)
+
+ ;; No need to generate section numbers. They are auto-generated by
+ ;; the application
+
+ ;; (concat (org-lparse-format 'SECTION-NUMBER snumber level) " ")
+ title
+ (and tags (concat (org-lparse-format 'SPACES 3)
+ (org-lparse-format 'ORG-TAGS tags)))))
+
+(defun org-odt-format-anchor (text name &optional class)
+ (org-odt-format-target text name))
+
+(defun org-odt-format-bookmark (text id)
+ (if id
+ (org-odt-format-tags "<text:bookmark text:name=\"%s\"/>" text id)
+ text))
+
+(defun org-odt-format-target (text id)
+ (let ((name (concat org-export-odt-bookmark-prefix id)))
+ (concat
+ (and id (org-odt-format-tags
+ "<text:bookmark-start text:name=\"%s\"/>" "" name))
+ (org-odt-format-bookmark text id)
+ (and id (org-odt-format-tags
+ "<text:bookmark-end text:name=\"%s\"/>" "" name)))))
+
+(defun org-odt-format-footnote (n def)
+ (let ((id (concat "fn" n))
+ (note-class "footnote")
+ (par-style "Footnote"))
+ (org-odt-format-tags
+ '("<text:note text:id=\"%s\" text:note-class=\"%s\">" .
+ "</text:note>")
+ (concat
+ (org-odt-format-tags
+ '("<text:note-citation>" . "</text:note-citation>")
+ n)
+ (org-odt-format-tags
+ '("<text:note-body>" . "</text:note-body>")
+ def))
+ id note-class)))
+
+(defun org-odt-format-footnote-reference (n def refcnt)
+ (if (= refcnt 1)
+ (org-odt-format-footnote n def)
+ (org-odt-format-footnote-ref n)))
+
+(defun org-odt-format-footnote-ref (n)
+ (let ((note-class "footnote")
+ (ref-format "text")
+ (ref-name (concat "fn" n)))
+ (org-odt-format-tags
+ '("<text:span text:style-name=\"%s\">" . "</text:span>")
+ (org-odt-format-tags
+ '("<text:note-ref text:note-class=\"%s\" text:reference-format=\"%s\" text:ref-name=\"%s\">" . "</text:note-ref>")
+ n note-class ref-format ref-name)
+ "OrgSuperscript")))
+
+(defun org-odt-get-image-name (file-name)
+ (require 'sha1)
+ (file-relative-name
+ (expand-file-name
+ (concat (sha1 file-name) "." (file-name-extension file-name)) "Pictures")))
+
+(defun org-export-odt-format-image (src href)
+ "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
+ 'org-latex-src src))
+ (category (and latex-frag "__DvipngImage__"))
+ (attr-plist (org-lparse-get-block-params attr))
+ (user-frame-anchor
+ (car (assoc-string (plist-get attr-plist :anchor)
+ '(("as-char") ("paragraph") ("page")) t)))
+ (user-frame-style
+ (and user-frame-anchor (plist-get attr-plist :style)))
+ (user-frame-attrs
+ (and user-frame-anchor (plist-get attr-plist :attributes)))
+ (user-frame-params
+ (list user-frame-style user-frame-attrs user-frame-anchor))
+ (embed-as (cond
+ (latex-frag
+ (symbol-name
+ (case (org-find-text-property-in-string
+ 'org-latex-src-embed-type src)
+ (paragraph 'paragraph)
+ (t 'as-char))))
+ (user-frame-anchor)
+ (t "paragraph")))
+ (size (org-odt-image-size-from-file
+ src (plist-get attr-plist :width)
+ (plist-get attr-plist :height)
+ (plist-get attr-plist :scale) nil embed-as))
+ (width (car size)) (height (cdr size)))
+ (when latex-frag
+ (setq href (org-propertize href :title "LaTeX Fragment"
+ :description latex-frag)))
+ (let ((frame-style-handle (concat (and (or caption label) "Captioned")
+ embed-as "Image")))
+ (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)
+ (concat (and title (org-odt-format-tags
+ '("<svg:title>" . "</svg:title>")
+ (org-odt-encode-plain-text title t)))
+ (and description (org-odt-format-tags
+ '("<svg:desc>" . "</svg:desc>")
+ (org-odt-encode-plain-text description t)))))
+
+(defun org-odt-format-frame (text width height style &optional
+ extra anchor-type)
+ (let ((frame-attrs
+ (concat
+ (if width (format " svg:width=\"%0.2fcm\"" width) "")
+ (if height (format " svg:height=\"%0.2fcm\"" height) "")
+ extra
+ (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph")))))
+ (org-odt-format-tags
+ '("<draw:frame draw:style-name=\"%s\"%s>" . "</draw:frame>")
+ (concat text (org-odt-format-object-description
+ (get-text-property 0 :title text)
+ (get-text-property 0 :description text)))
+ style frame-attrs)))
+
+(defun org-odt-format-textbox (text width height style &optional
+ extra anchor-type)
+ (org-odt-format-frame
+ (org-odt-format-tags
+ '("<draw:text-box %s>" . "</draw:text-box>")
+ text (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2))
+ (unless width
+ (format " fo:min-width=\"%0.2fcm\"" (or width .2)))))
+ width nil style extra anchor-type))
+
+(defun org-odt-format-inlinetask (heading content
+ &optional todo priority tags)
+ (org-odt-format-stylized-paragraph
+ nil (org-odt-format-textbox
+ (concat (org-odt-format-stylized-paragraph
+ "OrgInlineTaskHeading"
+ (org-lparse-format
+ 'HEADLINE (concat (org-lparse-format-todo todo) " " heading)
+ nil tags))
+ content) nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\"")))
+
+(defvar org-odt-entity-frame-styles
+ '(("As-CharImage" "__Figure__" ("OrgInlineImage" nil "as-char"))
+ ("ParagraphImage" "__Figure__" ("OrgDisplayImage" nil "paragraph"))
+ ("PageImage" "__Figure__" ("OrgPageImage" nil "page"))
+ ("CaptionedAs-CharImage" "__Figure__"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgInlineImage" nil "as-char"))
+ ("CaptionedParagraphImage" "__Figure__"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgImageCaptionFrame" nil "paragraph"))
+ ("CaptionedPageImage" "__Figure__"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgPageImageCaptionFrame" nil "page"))
+ ("InlineFormula" "__MathFormula__" ("OrgInlineFormula" nil "as-char"))
+ ("DisplayFormula" "__MathFormula__" ("OrgDisplayFormula" nil "as-char"))
+ ("CaptionedDisplayFormula" "__MathFormula__"
+ ("OrgCaptionedFormula" nil "paragraph")
+ ("OrgFormulaCaptionFrame" nil "as-char"))))
+
+(defun org-odt-merge-frame-params(default-frame-params user-frame-params)
+ (if (not user-frame-params) default-frame-params
+ (assert (= (length default-frame-params) 3))
+ (assert (= (length user-frame-params) 3))
+ (loop for user-frame-param in user-frame-params
+ for default-frame-param in default-frame-params
+ collect (or user-frame-param default-frame-param))))
+
+(defun* org-odt-format-entity (entity href width height
+ &key caption label category
+ user-frame-params short-caption)
+ (let* ((entity-style (assoc-string entity org-odt-entity-frame-styles t))
+ default-frame-params frame-params)
+ (cond
+ ((not (or caption label))
+ (setq default-frame-params (nth 2 entity-style))
+ (setq frame-params (org-odt-merge-frame-params
+ default-frame-params user-frame-params))
+ (apply 'org-odt-format-frame href width height frame-params))
+ (t
+ (setq default-frame-params (nth 3 entity-style))
+ (setq frame-params (org-odt-merge-frame-params
+ default-frame-params user-frame-params))
+ (apply 'org-odt-format-textbox
+ (org-odt-format-stylized-paragraph
+ 'illustration
+ (concat
+ (apply 'org-odt-format-frame href width height
+ (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)))))
+
+(defvar org-odt-embedded-images-count 0)
+(defun org-odt-copy-image-file (path)
+ "Returns the internal name of the file"
+ (let* ((image-type (file-name-extension path))
+ (media-type (format "image/%s" image-type))
+ (src-file (expand-file-name
+ path (file-name-directory org-current-export-file)))
+ (target-dir "Images/")
+ (target-file
+ (format "%s%04d.%s" target-dir
+ (incf org-odt-embedded-images-count) image-type)))
+ (when (not org-lparse-to-buffer)
+ (message "Embedding %s as %s ..."
+ (substring-no-properties path) target-file)
+
+ (when (= 1 org-odt-embedded-images-count)
+ (make-directory target-dir)
+ (org-odt-create-manifest-file-entry "" target-dir))
+
+ (copy-file src-file target-file 'overwrite)
+ (org-odt-create-manifest-file-entry media-type target-file))
+ target-file))
+
+(defvar org-export-odt-image-size-probe-method
+ (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675
+ '(emacs fixed))
+ "Ordered list of methods for determining image sizes.")
+
+(defvar org-export-odt-default-image-sizes-alist
+ '(("as-char" . (5 . 0.4))
+ ("paragraph" . (5 . 5)))
+ "Hardcoded image dimensions one for each of the anchor
+ 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 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)
+ (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
+ (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
+ (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)
+ (unless (file-name-absolute-p file)
+ (setq file (expand-file-name
+ file (file-name-directory org-current-export-file))))
+ (let* (size width height)
+ (unless (and user-height user-width)
+ (loop for probe-method in org-export-odt-image-size-probe-method
+ until size
+ do (setq size (org-odt-do-image-size
+ probe-method file dpi embed-as)))
+ (or size (error "Cannot determine image size, aborting"))
+ (setq width (car size) height (cdr size)))
+ (cond
+ (scale
+ (setq width (* width scale) height (* height scale)))
+ ((and user-height user-width)
+ (setq width user-width height user-height))
+ (user-height
+ (setq width (* user-height (/ width height)) height user-height))
+ (user-width
+ (setq height (* user-width (/ height width)) width user-width))
+ (t (ignore)))
+ ;; ensure that an embedded image fits comfortably within a page
+ (let ((max-width (car org-export-odt-max-image-size))
+ (max-height (cdr org-export-odt-max-image-size)))
+ (when (or (> width max-width) (> height max-height))
+ (let* ((scale1 (/ max-width width))
+ (scale2 (/ max-height height))
+ (scale (min scale1 scale2)))
+ (setq width (* scale width) height (* scale height)))))
+ (cons width height)))
+
+(defvar org-odt-entity-counts-plist nil
+ "Plist of running counters of SEQNOs for each of the CATEGORY-NAMEs.
+See `org-odt-entity-labels-alist' for known CATEGORY-NAMEs.")
+
+(defvar org-odt-label-styles
+ '(("math-formula" "%c" "text" "(%n)")
+ ("math-label" "(%n)" "text" "(%n)")
+ ("category-and-value" "%e %n: %c" "category-and-value" "%e %n")
+ ("value" "%e %n: %c" "value" "%n"))
+ "Specify how labels are applied and referenced.
+This is an alist where each element is of the
+form (LABEL-STYLE-NAME LABEL-ATTACH-FMT LABEL-REF-MODE
+LABEL-REF-FMT).
+
+LABEL-ATTACH-FMT controls how labels and captions are attached to
+an entity. It may contain following specifiers - %e, %n and %c.
+%e is replaced with the CATEGORY-NAME. %n is replaced with
+\"<text:sequence ...> SEQNO </text:sequence>\". %c is replaced
+with CAPTION. See `org-odt-format-label-definition'.
+
+LABEL-REF-MODE and LABEL-REF-FMT controls how label references
+are generated. The following XML is generated for a label
+reference - \"<text:sequence-ref
+text:reference-format=\"LABEL-REF-MODE\" ...> LABEL-REF-FMT
+</text:sequence-ref>\". LABEL-REF-FMT may contain following
+specifiers - %e and %n. %e is replaced with the CATEGORY-NAME.
+%n is replaced with SEQNO. See
+`org-odt-format-label-reference'.")
+
+(defcustom org-export-odt-category-strings
+ '(("en" "Table" "Figure" "Equation" "Equation"))
+ "Specify category strings for various captionable entities.
+Captionable entity can be one of a Table, an Embedded Image, a
+LaTeX fragment (generated with dvipng) or a Math Formula.
+
+For example, when `org-export-default-language' is \"en\", an
+embedded image will be captioned as \"Figure 1: Orgmode Logo\".
+If you want the images to be captioned instead as \"Illustration
+1: Orgmode Logo\", then modify the entry for \"en\" as shown
+below.
+
+ \(setq org-export-odt-category-strings
+ '\(\(\"en\" \"Table\" \"Illustration\"
+ \"Equation\" \"Equation\"\)\)\)"
+ :group 'org-export-odt
+ :version "24.1"
+ :type '(repeat (list (string :tag "Language tag")
+ (choice :tag "Table"
+ (const :tag "Use Default" nil)
+ (string :tag "Category string"))
+ (choice :tag "Figure"
+ (const :tag "Use Default" nil)
+ (string :tag "Category string"))
+ (choice :tag "Math Formula"
+ (const :tag "Use Default" nil)
+ (string :tag "Category string"))
+ (choice :tag "Dvipng Image"
+ (const :tag "Use Default" nil)
+ (string :tag "Category string")))))
+
+(defvar org-odt-category-map-alist
+ '(("__Table__" "Table" "value")
+ ("__Figure__" "Illustration" "value")
+ ("__MathFormula__" "Text" "math-formula")
+ ("__DvipngImage__" "Equation" "value")
+ ;; ("__Table__" "Table" "category-and-value")
+ ;; ("__Figure__" "Figure" "category-and-value")
+ ;; ("__DvipngImage__" "Equation" "category-and-value")
+ )
+ "Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE.
+This is a list where each entry is of the form \\(CATEGORY-HANDLE
+OD-VARIABLE LABEL-STYLE\\). CATEGORY_HANDLE identifies the
+captionable entity in question. OD-VARIABLE is the OpenDocument
+sequence counter associated with the entity. These counters are
+declared within
+\"<text:sequence-decls>...</text:sequence-decls>\" block of
+`org-export-odt-content-template-file'. LABEL-STYLE is a key
+into `org-odt-label-styles' and specifies how a given entity
+should be captioned and referenced.
+
+The position of a CATEGORY-HANDLE in this list is used as an
+index in to per-language entry for
+`org-export-odt-category-strings' to retrieve a CATEGORY-NAME.
+This CATEGORY-NAME is then used for qualifying the user-specified
+captions on export.")
+
+(defun org-odt-add-label-definition (label default-category)
+ "Create an entry in `org-odt-entity-labels-alist' and return it."
+ (let* ((label-props (assoc default-category org-odt-category-map-alist))
+ ;; identify the sequence number
+ (counter (nth 1 label-props))
+ (sequence-var (intern counter))
+ (seqno (1+ (or (plist-get org-odt-entity-counts-plist sequence-var)
+ 0)))
+ ;; assign an internal label, if user has not provided one
+ (label (if label (substring-no-properties label)
+ (format "%s-%s" default-category seqno)))
+ ;; identify label style
+ (label-style (nth 2 label-props))
+ ;; grok language setting
+ (en-strings (assoc-default "en" org-export-odt-category-strings))
+ (lang (plist-get org-lparse-opt-plist :language))
+ (lang-strings (assoc-default lang org-export-odt-category-strings))
+ ;; retrieve localized category sting
+ (pos (- (length org-odt-category-map-alist)
+ (length (memq label-props org-odt-category-map-alist))))
+ (category (or (nth pos lang-strings) (nth pos en-strings)))
+ (label-props (list label category counter seqno label-style)))
+ ;; synchronize internal counters
+ (setq org-odt-entity-counts-plist
+ (plist-put org-odt-entity-counts-plist sequence-var seqno))
+ ;; stash label properties for later retrieval
+ (push label-props org-odt-entity-labels-alist)
+ label-props))
+
+(defun org-odt-format-label-definition (caption label category counter
+ seqno label-style)
+ (assert label)
+ (format-spec
+ (cadr (assoc-string label-style org-odt-label-styles t))
+ `((?e . ,category)
+ (?n . ,(org-odt-format-tags
+ '("<text:sequence text:ref-name=\"%s\" text:name=\"%s\" text:formula=\"ooow:%s+1\" style:num-format=\"1\">" . "</text:sequence>")
+ (format "%d" seqno) label counter counter))
+ (?c . ,(or caption "")))))
+
+(defun org-odt-format-label-reference (label category counter
+ seqno label-style)
+ (assert label)
+ (save-match-data
+ (let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t)))
+ (fmt1 (car fmt))
+ (fmt2 (cadr fmt)))
+ (org-odt-format-tags
+ '("<text:sequence-ref text:reference-format=\"%s\" text:ref-name=\"%s\">"
+ . "</text:sequence-ref>")
+ (format-spec fmt2 `((?e . ,category)
+ (?n . ,(format "%d" seqno)))) fmt1 label))))
+
+(defun org-odt-fixup-label-references ()
+ (goto-char (point-min))
+ (while (re-search-forward
+ "<text:sequence-ref text:ref-name=\"\\([^\"]+\\)\">[ \t\n]*</text:sequence-ref>"
+ nil t)
+ (let* ((label (match-string 1))
+ (label-def (assoc label org-odt-entity-labels-alist))
+ (rpl (and label-def
+ (apply 'org-odt-format-label-reference label-def))))
+ (if rpl (replace-match rpl t t)
+ (org-lparse-warn
+ (format "Unable to resolve reference to label \"%s\"" label))))))
+
+(defun org-odt-format-entity-caption (label caption category)
+ (if (not (or label caption)) ""
+ (apply 'org-odt-format-label-definition caption
+ (org-odt-add-label-definition label category))))
+
+(defun org-odt-format-tags (tag text &rest args)
+ (let ((prefix (when org-lparse-encode-pending "@"))
+ (suffix (when org-lparse-encode-pending "@")))
+ (apply 'org-lparse-format-tags tag text prefix suffix args)))
+
+(defvar org-odt-manifest-file-entries nil)
+(defun org-odt-init-outfile (filename)
+ (unless (executable-find "zip")
+ ;; Not at all OSes ship with zip by default
+ (error "Executable \"zip\" needed for creating OpenDocument files"))
+
+ (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))
+ (find-file-noselect content-file t))
+
+ ;; reset variables
+ (setq org-odt-manifest-file-entries nil
+ org-odt-embedded-images-count 0
+ org-odt-embedded-formulas-count 0
+ org-odt-entity-labels-alist nil
+ org-odt-list-stack-stashed nil
+ org-odt-automatic-styles nil
+ org-odt-object-counters nil
+ org-odt-entity-counts-plist nil)
+ content-file))
+
+(defcustom org-export-odt-prettify-xml nil
+ "Specify whether or not the xml output should be prettified.
+When this option is turned on, `indent-region' is run on all
+component xml buffers before they are saved. Turn this off for
+regular use. Turn this on if you need to examine the xml
+visually."
+ :group 'org-export-odt
+ :version "24.1"
+ :type 'boolean)
+
+(defvar hfy-user-sheet-assoc) ; bound during org-do-lparse
+(defun org-odt-save-as-outfile (target opt-plist)
+ ;; write automatic styles
+ (org-odt-write-automatic-styles)
+
+ ;; write meta file
+ (org-odt-update-meta-file opt-plist)
+
+ ;; write styles file
+ (when (equal org-lparse-backend 'odt)
+ (org-odt-update-styles-file opt-plist))
+
+ ;; create mimetype file
+ (let ((mimetype (org-odt-write-mimetype-file org-lparse-backend)))
+ (org-odt-create-manifest-file-entry mimetype "/" "1.2"))
+
+ ;; create a manifest entry for content.xml
+ (org-odt-create-manifest-file-entry "text/xml" "content.xml")
+
+ ;; write out the manifest entries before zipping
+ (org-odt-write-manifest-file)
+
+ (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml"
+ "meta.xml")))
+ (when (equal org-lparse-backend 'odt)
+ (push "styles.xml" xml-files))
+
+ ;; save all xml files
+ (mapc (lambda (file)
+ (with-current-buffer
+ (find-file-noselect (expand-file-name file) t)
+ ;; prettify output if needed
+ (when org-export-odt-prettify-xml
+ (indent-region (point-min) (point-max)))
+ (save-buffer 0)))
+ xml-files)
+
+ (let* ((target-name (file-name-nondirectory target))
+ (target-dir (file-name-directory target))
+ (cmds `(("zip" "-mX0" ,target-name "mimetype")
+ ("zip" "-rmTq" ,target-name "."))))
+ (when (file-exists-p target)
+ ;; FIXME: If the file is locked this throws a cryptic error
+ (delete-file target))
+
+ (let ((coding-system-for-write 'no-conversion) exitcode err-string)
+ (message "Creating odt file...")
+ (mapc
+ (lambda (cmd)
+ (message "Running %s" (mapconcat 'identity cmd " "))
+ (setq err-string
+ (with-output-to-string
+ (setq exitcode
+ (apply 'call-process (car cmd)
+ nil standard-output nil (cdr cmd)))))
+ (or (zerop exitcode)
+ (ignore (message "%s" err-string))
+ (error "Unable to create odt file (%S)" exitcode)))
+ cmds))
+
+ ;; move the file from outdir to target-dir
+ (rename-file target-name target-dir)))
+
+ (message "Created %s" target)
+ (set-buffer (find-file-noselect target t)))
+
+(defconst org-odt-manifest-file-entry-tag
+ "
+<manifest:file-entry manifest:media-type=\"%s\" manifest:full-path=\"%s\"%s/>")
+
+(defun org-odt-create-manifest-file-entry (&rest args)
+ (push args org-odt-manifest-file-entries))
+
+(defun org-odt-write-manifest-file ()
+ (make-directory "META-INF")
+ (let ((manifest-file (expand-file-name "META-INF/manifest.xml")))
+ (with-current-buffer
+ (let ((nxml-auto-insert-xml-declaration-flag nil))
+ (find-file-noselect manifest-file t))
+ (insert
+ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+ <manifest:manifest xmlns:manifest=\"urn:oasis:names:tc:opendocument:xmlns:manifest:1.0\" manifest:version=\"1.2\">\n")
+ (mapc
+ (lambda (file-entry)
+ (let* ((version (nth 2 file-entry))
+ (extra (if version
+ (format " manifest:version=\"%s\"" version)
+ "")))
+ (insert
+ (format org-odt-manifest-file-entry-tag
+ (nth 0 file-entry) (nth 1 file-entry) extra))))
+ org-odt-manifest-file-entries)
+ (insert "\n</manifest:manifest>"))))
+
+(defun org-odt-update-meta-file (opt-plist)
+ (let ((date (org-odt-format-date (plist-get opt-plist :date)))
+ (author (or (plist-get opt-plist :author) ""))
+ (email (plist-get opt-plist :email))
+ (keywords (plist-get opt-plist :keywords))
+ (description (plist-get opt-plist :description))
+ (title (plist-get opt-plist :title)))
+ (write-region
+ (concat
+ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+ <office:document-meta
+ xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\"
+ xmlns:xlink=\"http://www.w3.org/1999/xlink\"
+ xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
+ xmlns:meta=\"urn:oasis:names:tc:opendocument:xmlns:meta:1.0\"
+ xmlns:ooo=\"http://openoffice.org/2004/office\"
+ office:version=\"1.2\">
+ <office:meta>" "\n"
+ (org-odt-format-author)
+ (org-odt-format-tags
+ '("\n<meta:initial-creator>" . "</meta:initial-creator>") author)
+ (org-odt-format-tags '("\n<dc:date>" . "</dc:date>") date)
+ (org-odt-format-tags
+ '("\n<meta:creation-date>" . "</meta:creation-date>") date)
+ (org-odt-format-tags '("\n<meta:generator>" . "</meta:generator>")
+ (when org-export-creator-info
+ (format "Org-%s/Emacs-%s"
+ (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)
+ "\n"
+ " </office:meta>" "</office:document-meta>")
+ nil (expand-file-name "meta.xml")))
+
+ ;; create a manifest entry for meta.xml
+ (org-odt-create-manifest-file-entry "text/xml" "meta.xml"))
+
+(defun org-odt-update-styles-file (opt-plist)
+ ;; write styles file
+ (let ((styles-file (plist-get opt-plist :odt-styles-file)))
+ (org-odt-copy-styles-file (and styles-file
+ (read (org-trim styles-file)))))
+
+ ;; 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
+ ;; prevents the backed-up styles.xml file from being zipped in to
+ ;; 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
+ ;; 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.
+ (set (make-local-variable 'backup-inhibited) t)
+
+ ;; Import local setting of `org-export-with-section-numbers'
+ (org-lparse-bind-local-variables opt-plist)
+ (org-odt-configure-outline-numbering
+ (if org-export-with-section-numbers org-export-headline-levels 0)))
+
+ ;; Write custom styles for source blocks
+ (org-odt-insert-custom-styles-for-srcblocks
+ (mapconcat
+ (lambda (style)
+ (format " %s\n" (cddr style)))
+ hfy-user-sheet-assoc "")))
+
+(defun org-odt-write-mimetype-file (format)
+ ;; create mimetype file
+ (let ((mimetype
+ (case format
+ (odt "application/vnd.oasis.opendocument.text")
+ (odf "application/vnd.oasis.opendocument.formula")
+ (t (error "Unknown OpenDocument backend %S" org-lparse-backend)))))
+ (write-region mimetype nil (expand-file-name "mimetype"))
+ mimetype))
+
+(defun org-odt-finalize-outfile ()
+ (org-odt-delete-empty-paragraphs))
+
+(defun org-odt-delete-empty-paragraphs ()
+ (goto-char (point-min))
+ (let ((open "<text:p[^>]*>")
+ (close "</text:p>"))
+ (while (re-search-forward (format "%s[ \r\n\t]*%s" open close) nil t)
+ (replace-match ""))))
+
+(defcustom org-export-odt-convert-processes
+ '(("LibreOffice"
+ "soffice --headless --convert-to %f%x --outdir %d %i")
+ ("unoconv"
+ "unoconv -f %f -o %d %i"))
+ "Specify a list of document converters and their usage.
+The converters in this list are offered as choices while
+customizing `org-export-odt-convert-process'.
+
+This variable is a list where each element is of the
+form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name
+of the converter. CONVERTER-CMD is the shell command for the
+converter and can contain format specifiers. These format
+specifiers are interpreted as below:
+
+%i input file name in full
+%I input file name as a URL
+%f format of the output file
+%o output file name in full
+%O output file name as a URL
+%d output dir in full
+%D output dir as a URL.
+%x extra options as set in `org-export-odt-convert-capabilities'."
+ :group 'org-export-odt
+ :version "24.1"
+ :type
+ '(choice
+ (const :tag "None" nil)
+ (alist :tag "Converters"
+ :key-type (string :tag "Converter Name")
+ :value-type (group (string :tag "Command line")))))
+
+(defcustom org-export-odt-convert-process "LibreOffice"
+ "Use this converter to convert from \"odt\" format to other formats.
+During customization, the list of converter names are populated
+from `org-export-odt-convert-processes'."
+ :group 'org-export-odt
+ :version "24.1"
+ :type '(choice :convert-widget
+ (lambda (w)
+ (apply 'widget-convert (widget-type w)
+ (eval (car (widget-get w :args)))))
+ `((const :tag "None" nil)
+ ,@(mapcar (lambda (c)
+ `(const :tag ,(car c) ,(car c)))
+ org-export-odt-convert-processes))))
+
+(defcustom org-export-odt-convert-capabilities
+ '(("Text"
+ ("odt" "ott" "doc" "rtf" "docx")
+ (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott")
+ ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html")))
+ ("Web"
+ ("html")
+ (("pdf" "pdf") ("odt" "odt") ("html" "html")))
+ ("Spreadsheet"
+ ("ods" "ots" "xls" "csv" "xlsx")
+ (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods")
+ ("xls" "xls") ("xlsx" "xlsx")))
+ ("Presentation"
+ ("odp" "otp" "ppt" "pptx")
+ (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt")
+ ("pptx" "pptx") ("odg" "odg"))))
+ "Specify input and output formats of `org-export-odt-convert-process'.
+More correctly, specify the set of input and output formats that
+the user is actually interested in.
+
+This variable is an alist where each element is of the
+form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST).
+INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an
+alist where each element is of the form (OUTPUT-FMT
+OUTPUT-FILE-EXTENSION EXTRA-OPTIONS).
+
+The variable is interpreted as follows:
+`org-export-odt-convert-process' can take any document that is in
+INPUT-FMT-LIST and produce any document that is in the
+OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have
+OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT
+serves dual purposes:
+- It is used for populating completion candidates during
+ `org-export-odt-convert' commands.
+- It is used as the value of \"%f\" specifier in
+ `org-export-odt-convert-process'.
+
+EXTRA-OPTIONS is used as the value of \"%x\" specifier in
+`org-export-odt-convert-process'.
+
+DOCUMENT-CLASS is used to group a set of file formats in
+INPUT-FMT-LIST in to a single class.
+
+Note that this variable inherently captures how LibreOffice based
+converters work. LibreOffice maps documents of various formats
+to classes like Text, Web, Spreadsheet, Presentation etc and
+allow document of a given class (irrespective of it's source
+format) to be converted to any of the export formats associated
+with that class.
+
+See default setting of this variable for an typical
+configuration."
+ :group 'org-export-odt
+ :version "24.1"
+ :type
+ '(choice
+ (const :tag "None" nil)
+ (alist :tag "Capabilities"
+ :key-type (string :tag "Document Class")
+ :value-type
+ (group (repeat :tag "Input formats" (string :tag "Input format"))
+ (alist :tag "Output formats"
+ :key-type (string :tag "Output format")
+ :value-type
+ (group (string :tag "Output file extension")
+ (choice
+ (const :tag "None" nil)
+ (string :tag "Extra options"))))))))
+
+(declare-function org-create-math-formula "org"
+ (latex-frag &optional mathml-file))
+
+;;;###autoload
+(defun org-export-odt-convert (&optional in-file out-fmt prefix-arg)
+ "Convert IN-FILE to format OUT-FMT using a command line converter.
+IN-FILE is the file to be converted. If unspecified, it defaults
+to variable `buffer-file-name'. OUT-FMT is the desired output
+format. Use `org-export-odt-convert-process' as the converter.
+If PREFIX-ARG is non-nil then the newly converted file is opened
+using `org-open-file'."
+ (interactive
+ (append (org-lparse-convert-read-params) current-prefix-arg))
+ (org-lparse-do-convert in-file out-fmt prefix-arg))
+
+(defun org-odt-get (what &optional opt-plist)
+ (case what
+ (BACKEND 'odt)
+ (EXPORT-DIR (org-export-directory :html opt-plist))
+ (FILE-NAME-EXTENSION "odt")
+ (EXPORT-BUFFER-NAME "*Org ODT Export*")
+ (ENTITY-CONTROL org-odt-entity-control-callbacks-alist)
+ (ENTITY-FORMAT org-odt-entity-format-callbacks-alist)
+ (INIT-METHOD 'org-odt-init-outfile)
+ (FINAL-METHOD 'org-odt-finalize-outfile)
+ (SAVE-METHOD 'org-odt-save-as-outfile)
+ (CONVERT-METHOD
+ (and org-export-odt-convert-process
+ (cadr (assoc-string org-export-odt-convert-process
+ org-export-odt-convert-processes t))))
+ (CONVERT-CAPABILITIES
+ (and org-export-odt-convert-process
+ (cadr (assoc-string org-export-odt-convert-process
+ org-export-odt-convert-processes t))
+ org-export-odt-convert-capabilities))
+ (TOPLEVEL-HLEVEL 1)
+ (SPECIAL-STRING-REGEXPS org-export-odt-special-string-regexps)
+ (INLINE-IMAGES 'maybe)
+ (INLINE-IMAGE-EXTENSIONS '("png" "jpeg" "jpg" "gif" "svg"))
+ (PLAIN-TEXT-MAP '(("&" . "&amp;") ("<" . "&lt;") (">" . "&gt;")))
+ (TABLE-FIRST-COLUMN-AS-LABELS nil)
+ (FOOTNOTE-SEPARATOR (org-lparse-format 'FONTIFY "," 'superscript))
+ (CODING-SYSTEM-FOR-WRITE 'utf-8)
+ (CODING-SYSTEM-FOR-SAVE 'utf-8)
+ (t (error "Unknown property: %s" what))))
+
+(defvar org-lparse-latex-fragment-fallback) ; set by org-do-lparse
+(defun org-export-odt-do-preprocess-latex-fragments ()
+ "Convert LaTeX fragments to images."
+ (let* ((latex-frag-opt (plist-get org-lparse-opt-plist :LaTeX-fragments))
+ (latex-frag-opt ; massage the options
+ (or (and (member latex-frag-opt '(mathjax t))
+ (not (and (fboundp 'org-format-latex-mathml-available-p)
+ (org-format-latex-mathml-available-p)))
+ (prog1 org-lparse-latex-fragment-fallback
+ (org-lparse-warn
+ (concat
+ "LaTeX to MathML converter not available. "
+ (format "Using %S instead."
+ org-lparse-latex-fragment-fallback)))))
+ latex-frag-opt))
+ cache-dir display-msg)
+ (cond
+ ((eq latex-frag-opt 'dvipng)
+ (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)
+ (setq cache-dir "ltxmathml/")
+ (setq display-msg "Creating MathML formula %s")))
+ (when (and org-current-export-file)
+ (org-format-latex
+ (concat cache-dir (file-name-sans-extension
+ (file-name-nondirectory org-current-export-file)))
+ org-current-export-dir nil display-msg
+ nil nil latex-frag-opt))))
+
+(defadvice org-format-latex-as-mathml
+ (after org-odt-protect-latex-fragment activate)
+ "Encode LaTeX fragment as XML.
+Do this when translation to MathML fails."
+ (when (or (not (> (length ad-return-value) 0))
+ (get-text-property 0 'org-protected ad-return-value))
+ (setq ad-return-value
+ (org-propertize (org-odt-encode-plain-text (ad-get-arg 0))
+ 'org-protected t))))
+
+(defun org-export-odt-preprocess-latex-fragments ()
+ (when (equal org-export-current-backend 'odt)
+ (org-export-odt-do-preprocess-latex-fragments)))
+
+(defun org-export-odt-preprocess-label-references ()
+ (goto-char (point-min))
+ (let (label label-components category value pretty-label)
+ (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t)
+ (org-if-unprotected-at (match-beginning 1)
+ (replace-match
+ (let ((org-lparse-encode-pending t)
+ (label (match-string 1)))
+ ;; markup generated below is mostly an eye-candy. At
+ ;; pre-processing stage, there is no information on which
+ ;; entity a label reference points to. The actual markup
+ ;; is generated as part of `org-odt-fixup-label-references'
+ ;; which gets called at the fag end of export. By this
+ ;; time we would have seen and collected all the label
+ ;; definitions in `org-odt-entity-labels-alist'.
+ (org-odt-format-tags
+ '("<text:sequence-ref text:ref-name=\"%s\">" .
+ "</text:sequence-ref>")
+ "" (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
+;; 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
+;; captions, labels and attributes to be attached to png images
+;; generated out of latex equations.
+(add-hook 'org-export-preprocess-after-blockquote-hook
+ 'org-export-odt-preprocess-latex-fragments)
+
+(defun org-export-odt-preprocess (parameters)
+ (org-export-odt-preprocess-label-references))
+
+(declare-function archive-zip-extract "arc-mode" (archive name))
+(defun org-odt-zip-extract-one (archive member &optional target)
+ (require 'arc-mode)
+ (let* ((target (or target default-directory))
+ (archive (expand-file-name archive))
+ (archive-zip-extract
+ (list "unzip" "-qq" "-o" "-d" target))
+ exit-code command-output)
+ (setq command-output
+ (with-temp-buffer
+ (setq exit-code (archive-zip-extract archive member))
+ (buffer-string)))
+ (unless (zerop exit-code)
+ (message command-output)
+ (error "Extraction failed"))))
+
+(defun org-odt-zip-extract (archive members &optional target)
+ (when (atom members) (setq members (list members)))
+ (mapc (lambda (member)
+ (org-odt-zip-extract-one archive member target))
+ members))
+
+(defun org-odt-copy-styles-file (&optional styles-file)
+ ;; 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
+ (expand-file-name "OrgOdtStyles.xml"
+ org-odt-styles-dir)
+ (error "org-odt: Missing styles file?")))
+ (cond
+ ((listp styles-file)
+ (let ((archive (nth 0 styles-file))
+ (members (nth 1 styles-file)))
+ (org-odt-zip-extract archive members)
+ (mapc
+ (lambda (member)
+ (when (org-file-image-p member)
+ (let* ((image-type (file-name-extension member))
+ (media-type (format "image/%s" image-type)))
+ (org-odt-create-manifest-file-entry media-type member))))
+ members)))
+ ((and (stringp styles-file) (file-exists-p styles-file))
+ (let ((styles-file-type (file-name-extension styles-file)))
+ (cond
+ ((string= styles-file-type "xml")
+ (copy-file styles-file "styles.xml" t))
+ ((member styles-file-type '("odt" "ott"))
+ (org-odt-zip-extract styles-file "styles.xml")))))
+ (t
+ (error (format "Invalid specification of styles.xml file: %S"
+ org-export-odt-styles-file))))
+
+ ;; create a manifest entry for styles.xml
+ (org-odt-create-manifest-file-entry "text/xml" "styles.xml"))
+
+(defun org-odt-configure-outline-numbering (level)
+ "Outline numbering is retained only upto LEVEL.
+To disable outline numbering pass a LEVEL of 0."
+ (goto-char (point-min))
+ (let ((regex
+ "<text:outline-level-style\\([^>]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>")
+ (replacement
+ "<text:outline-level-style\\1text:level=\"\\2\" style:num-format=\"\">"))
+ (while (re-search-forward regex nil t)
+ (when (> (string-to-number (match-string 2)) level)
+ (replace-match replacement t nil))))
+ (save-buffer 0))
+
+;;;###autoload
+(defun org-export-as-odf (latex-frag &optional odf-file)
+ "Export LATEX-FRAG as OpenDocument formula file ODF-FILE.
+Use `org-create-math-formula' to convert LATEX-FRAG first to
+MathML. When invoked as an interactive command, use
+`org-latex-regexps' to infer LATEX-FRAG from currently active
+region. If no LaTeX fragments are found, prompt for it. Push
+MathML source to kill ring, if `org-export-copy-to-kill-ring' is
+non-nil."
+ (interactive
+ `(,(let (frag)
+ (setq frag (and (setq frag (and (org-region-active-p)
+ (buffer-substring (region-beginning)
+ (region-end))))
+ (loop for e in org-latex-regexps
+ thereis (when (string-match (nth 1 e) frag)
+ (match-string (nth 2 e) frag)))))
+ (read-string "LaTeX Fragment: " frag nil frag))
+ ,(let ((odf-filename (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (or (file-name-nondirectory buffer-file-name)))
+ "." "odf")
+ (file-name-directory buffer-file-name))))
+ (read-file-name "ODF filename: " nil odf-filename nil
+ (file-name-nondirectory odf-filename)))))
+ (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 ()
+ "Export LaTeX fragment as OpenDocument formula and immediately open it.
+Use `org-export-as-odf' to read LaTeX fragment and OpenDocument
+formula file."
+ (interactive)
+ (org-lparse-and-open
+ nil nil nil (call-interactively 'org-export-as-odf)))
+
+(provide 'org-odt)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; org-odt.el ends here
diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el
index cede736d929..64678409920 100644
--- a/lisp/org/org-pcomplete.el
+++ b/lisp/org/org-pcomplete.el
@@ -1,12 +1,11 @@
;;; org-pcomplete.el --- In-buffer completion code
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -32,6 +31,7 @@
(require 'cl))
(require 'org-macs)
+(require 'org-compat)
(require 'pcomplete)
(declare-function org-split-string "org" (string &optional separators))
@@ -51,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
@@ -70,7 +73,7 @@ The return value is a string naming the thing at point."
(re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*"
(line-beginning-position) t))
(cons "file-option" (match-string-no-properties 1)))
- ((string-match "\\`[ \t]*#\\+[a-zA-Z]*\\'" line-to-here)
+ ((string-match "\\`[ \t]*#\\+[a-zA-Z_]*\\'" line-to-here)
(cons "file-option" nil))
((equal (char-before beg) ?\[)
(cons "link" nil))
@@ -85,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 ()
@@ -120,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
@@ -128,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)
@@ -138,16 +151,10 @@ 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"))
- org-additional-option-like-keywords)))))
+ (append org-options-keywords
+ org-additional-option-like-keywords)))
(substring pcomplete-stub 2)))
-
+
(defvar org-startup-options)
(defun pcomplete/org-mode/file-option/startup ()
"Complete arguments for the #+STARTUP file option."
@@ -162,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)))))
@@ -197,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 ()
@@ -240,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."
@@ -257,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"
@@ -276,6 +334,4 @@ Complete a language in the first field, the header arguments and switches."
(provide 'org-pcomplete)
-
-
;;; org-pcomplete.el ends here
diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el
index 419467226c9..5dec304363f 100644
--- a/lisp/org/org-plot.el
+++ b/lisp/org/org-plot.el
@@ -1,11 +1,10 @@
;;; org-plot.el --- Support for plotting from Org-mode
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;;
;; Author: Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: tables, plotting
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -136,7 +135,7 @@ Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
"Export the data in TABLE to DATA-FILE for gnuplot.
This means in a format appropriate for grid plotting by gnuplot.
PARAMS specifies which columns of TABLE should be plotted as independent
-and dependent variables."
+and dependant variables."
(interactive)
(let* ((ind (- (plist-get params :ind) 1))
(deps (if (plist-member params :deps)
@@ -145,7 +144,8 @@ and dependent 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)))
@@ -160,26 +160,26 @@ and dependent 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)
@@ -209,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))
@@ -264,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
@@ -350,5 +351,8 @@ line directly before or after the table."
(provide 'org-plot)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-plot.el ends here
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index bbb93b07fc9..31f6fb26711 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -1,14 +1,13 @@
;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions.
;;
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;;
-;; Author: Bastien Guerry <bzg AT altern DOT org>
-;; Author: Daniel M German <dmg AT uvic DOT org>
-;; Author: Sebastian Rose <sebastian_rose AT gmx DOT de>
-;; Author: Ross Patterson <me AT rpatterson DOT net>
+;; Authors: Bastien Guerry <bzg AT gnu DOT org>
+;; Daniel M German <dmg AT uvic DOT org>
+;; Sebastian Rose <sebastian_rose AT gmx DOT de>
+;; Ross Patterson <me AT rpatterson DOT net>
;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de>
;; Keywords: org, emacsclient, wp
-;; Version: 7.7
;; This file is part of GNU Emacs.
;;
@@ -188,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:
@@ -196,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.
@@ -226,7 +225,7 @@ Consider using the interactive functions `org-protocol-create' and
:type 'alist)
(defcustom org-protocol-protocol-alist nil
- "* Register custom handlers for org-protocol.
+ "Register custom handlers for org-protocol.
Each element of this list must be of the form:
@@ -237,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.
@@ -274,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)
@@ -317,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:
@@ -351,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))))
@@ -359,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:
@@ -368,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]")
@@ -434,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)))
@@ -530,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
@@ -549,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
@@ -567,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))
@@ -590,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)
@@ -626,23 +631,22 @@ 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))))
(provide 'org-protocol)
-
;;; org-protocol.el ends here
diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el
index 7a0d7b56e22..d10514255b6 100644
--- a/lisp/org/org-publish.el
+++ b/lisp/org/org-publish.el
@@ -1,10 +1,9 @@
;;; org-publish.el --- publish related org-mode files as a website
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: David O'Toole <dto@gnu.org>
;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
;; Keywords: hypermedia, outlines, wp
-;; Version: 7.7
;; This file is part of GNU Emacs.
;;
@@ -106,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
@@ -191,7 +190,7 @@ sitemap of files or summary page for a given project.
display folders first or last, respectively.
Any other value will mix files and folders.
:sitemap-sort-files The site map is normally sorted alphabetically.
- You can change this behavior setting this to
+ You can change this behaviour setting this to
`chronologically', `anti-chronologically' or nil.
:sitemap-ignore-case Should sorting be case-sensitive? Default nil.
@@ -249,6 +248,7 @@ nil won't sort files.
You can overwrite this default per project in your
`org-publish-project-alist', using `:sitemap-sort-files'."
:group 'org-publish
+ :version "24.1"
:type 'symbol)
(defcustom org-publish-sitemap-sort-folders 'first
@@ -261,6 +261,7 @@ Any other value will not mix files and folders.
You can overwrite this default per project in your
`org-publish-project-alist', using `:sitemap-sort-folders'."
:group 'org-publish
+ :version "24.1"
:type 'symbol)
(defcustom org-publish-sitemap-sort-ignore-case nil
@@ -269,12 +270,14 @@ You can overwrite this default per project in your
You can overwrite this default per project in your
`org-publish-project-alist', using `:sitemap-ignore-case'."
:group 'org-publish
+ :version "24.1"
:type 'boolean)
(defcustom org-publish-sitemap-date-format "%Y-%m-%d"
"Format for `format-time-string' which is used to print a date
in the sitemap."
:group 'org-publish
+ :version "24.1"
:type 'string)
(defcustom org-publish-sitemap-file-entry-format "%t"
@@ -285,6 +288,7 @@ You could use brackets to delimit on what part the link will be.
%a is the author.
%d is the date formatted using `org-publish-sitemap-date-format'."
:group 'org-publish
+ :version "24.1"
:type 'string)
@@ -311,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
@@ -321,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
@@ -330,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))
@@ -369,6 +373,8 @@ This is a compatibility function for Emacsen without `delete-dups'."
(declare-function org-publish-delete-dups "org-publish" (list))
(declare-function find-lisp-find-files "find-lisp" (directory regexp))
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Getting project information out of org-publish-project-alist
@@ -412,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))
@@ -500,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?
@@ -530,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
@@ -559,7 +565,7 @@ PUB-DIR is the publishing directory."
(make-directory pub-dir t))
(let ((visiting (find-buffer-visiting filename)))
(save-excursion
- (switch-to-buffer (or visiting (find-file filename)))
+ (org-pop-to-buffer-same-window (or visiting (find-file filename)))
(let* ((plist (cons :buffer-will-be-killed (cons t plist)))
(init-buf (current-buffer))
(init-point (point))
@@ -594,11 +600,12 @@ 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))
(defvar project-plist)
(defun org-publish-org-to-latex (plist filename pub-dir)
@@ -617,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.
@@ -628,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.
@@ -682,7 +689,7 @@ See `org-publish-projects'."
(pub-dir
(file-name-as-directory
(file-truename
- (or (plist-get project-plist :publishing-directory)
+ (or (eval (plist-get project-plist :publishing-directory))
(error "Project %s does not have :publishing-directory defined"
(car project))))))
tmp-pub-dir)
@@ -698,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)
@@ -726,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)
@@ -744,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)
@@ -760,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))
@@ -826,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."
@@ -860,7 +866,7 @@ system's modification time.
It returns time in `current-time' format."
(let ((visiting (find-buffer-visiting file)))
(save-excursion
- (switch-to-buffer (or visiting (find-file-noselect file nil t)))
+ (org-pop-to-buffer-same-window (or visiting (find-file-noselect file nil t)))
(let* ((plist (org-infile-export-plist))
(date (plist-get plist :date)))
(unless visiting
@@ -895,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)
@@ -910,7 +916,6 @@ directory and force publishing all files."
(if force nil org-publish-use-timestamps-flag)))
(org-publish-projects org-publish-project-alist))))
-
;;;###autoload
(defun org-publish-current-file (&optional force)
"Publish the current file.
@@ -982,7 +987,9 @@ the project."
main last-main letter last-letter file sub link tgext)
;; `files' contains the list of relative file names
(dolist (file files)
- (setq origfile (substring file 1 -1))
+ (setq origfile
+ (concat (file-name-directory file)
+ (substring (file-name-nondirectory file) 1 -1)))
(setq buf (find-file-noselect file))
(with-current-buffer buf
(goto-char (point-min))
@@ -993,7 +1000,7 @@ the project."
(kill-buffer buf))
(setq index (sort index (lambda (a b) (string< (downcase (car a))
(downcase (car b))))))
- (setq ibuffer (find-file-noselect (expand-file-name "theindex.org" directory)))
+ (setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory)))
(with-current-buffer ibuffer
(erase-buffer)
(insert "* Index\n")
@@ -1020,20 +1027,28 @@ the project."
(insert " - " link "\n")
(insert " - " link "\n")))
(save-buffer))
- (kill-buffer ibuffer)))
+ (kill-buffer ibuffer)
+ ;; 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)))))
;; 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))
@@ -1050,9 +1065,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))
@@ -1087,23 +1101,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\"]*\\)\"?[ \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))))
@@ -1155,31 +1170,29 @@ 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)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-publish.el ends here
diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el
index 8819f416f1d..d555ca65d21 100644
--- a/lisp/org/org-remember.el
+++ b/lisp/org/org-remember.el
@@ -1,11 +1,10 @@
;;; org-remember.el --- Fast note taking in Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -40,6 +39,8 @@
(declare-function remember "remember" (&optional initial))
(declare-function remember-buffer-desc "remember" ())
(declare-function remember-finalize "remember" ())
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
(defvar remember-save-after-remembering)
(defvar remember-register)
@@ -188,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."
@@ -276,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."
@@ -296,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
@@ -400,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)))
@@ -430,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))
@@ -448,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))
@@ -475,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.
@@ -504,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))
@@ -535,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))
@@ -598,7 +597,7 @@ to be run from that hook to function properly."
(car clipboards))))))
((equal char "p")
(let*
- ((prop (org-substring-no-properties prompt))
+ ((prop (org-no-properties prompt))
(pall (concat prop "_ALL"))
(allowed
(with-current-buffer
@@ -786,7 +785,7 @@ The user is queried for the template."
(setq heading org-remember-default-headline))
(setq visiting (org-find-base-buffer-visiting file))
(if (not visiting) (find-file-noselect file))
- (switch-to-buffer (or visiting (get-file-buffer file)))
+ (org-pop-to-buffer-same-window (or visiting (get-file-buffer file)))
(widen)
(goto-char (point-min))
(if (re-search-forward
@@ -942,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 (org-mode-p) (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
@@ -952,7 +951,7 @@ See also the variable `org-reverse-note-order'."
;; Find the default location
(when heading
(cond
- ((not (org-mode-p))
+ ((not (derived-mode-p 'org-mode))
(if (eq heading 'top)
(goto-char (point-min))
(goto-char (point-max))
@@ -994,7 +993,7 @@ See also the variable `org-reverse-note-order'."
(cond
((and fastp (memq heading '(top bottom)))
(setq spos org-goto-start-pos
- exitcmd (if (eq heading 'top) 'left nil)))
+ exitcmd (if (eq heading 'top) 'left nil)))
(fastp (setq spos org-goto-start-pos
exitcmd 'return))
((eq org-remember-interactive-interface 'outline)
@@ -1013,7 +1012,7 @@ See also the variable `org-reverse-note-order'."
; not handle this note
(and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately))
(goto-char spos)
- (cond ((org-on-heading-p t)
+ (cond ((org-at-heading-p t)
(org-back-to-heading t)
(setq level (funcall outline-level))
(cond
@@ -1122,7 +1121,7 @@ See also the variable `org-reverse-note-order'."
(condition-case nil
(require 'remember)
(error
- ;; Let's install our own micro version of remember
+ ;; Lets install our own micro version of remember
(defvar remember-register ?R)
(defvar remember-mode-hook nil)
(defvar remember-handler-functions nil)
@@ -1150,6 +1149,8 @@ See also the variable `org-reverse-note-order'."
(provide 'org-remember)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-remember.el ends here
diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el
index 1169c206981..4be7bcbb5f6 100644
--- a/lisp/org/org-rmail.el
+++ b/lisp/org/org-rmail.el
@@ -1,11 +1,10 @@
;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -34,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)
@@ -53,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"))
@@ -74,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)))))
@@ -98,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
@@ -114,6 +118,4 @@
(provide 'org-rmail)
-
-
;;; org-rmail.el ends here
diff --git a/lisp/org/org-special-blocks.el b/lisp/org/org-special-blocks.el
index c09b27de895..ddd612074b4 100644
--- a/lisp/org/org-special-blocks.el
+++ b/lisp/org/org-special-blocks.el
@@ -1,6 +1,5 @@
-;;; org-special-blocks.el --- Turn blocks into LaTeX envs and HTML divs
-
-;; Copyright (C) 2009, 2011 Free Software Foundation, Inc.
+;;; org-special-blocks.el --- handle Org special blocks
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Chris Gray <chrismgray@gmail.com>
@@ -38,8 +37,12 @@
;; user to add this class to his or her stylesheet if this div is to
;; mean anything.
+(require 'org-html)
(require 'org-compat)
+(declare-function org-open-par "org-html" ())
+(declare-function org-close-par-maybe "org-html" ())
+
(defvar org-special-blocks-ignore-regexp "^\\(LaTeX\\|HTML\\)$"
"A regexp indicating the names of blocks that should be ignored
by org-special-blocks. These blocks will presumably be
@@ -49,7 +52,7 @@ interpreted by other mechanisms.")
(defun org-special-blocks-make-special-cookies ()
"Adds special cookies when #+begin_foo and #+end_foo tokens are
seen. This is run after a few special cases are taken care of."
- (when (or (eq org-export-current-backend 'html)
+ (when (or (eq org-export-current-backend 'html)
(eq org-export-current-backend 'latex))
(goto-char (point-min))
(while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t)
@@ -77,16 +80,20 @@ 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)
-; (org-close-par-maybe)
+ ;; Uses the dynamically-bound variable `org-line'.
+ (when (and org-line (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" org-line))
(message "%s" (match-string 1))
- (if (equal (match-string 2 line) "START")
- (insert "<div class=\"" (match-string 1 line) "\">\n")
- (insert "</div>\n"))
+ (when (equal (match-string 2 org-line) "START")
+ (org-close-par-maybe)
+ (insert "\n<div class=\"" (match-string 1 org-line) "\">")
+ (org-open-par))
+ (when (equal (match-string 2 org-line) "END")
+ (org-close-par-maybe)
+ (insert "\n</div>")
+ (org-open-par))
(throw 'nextline nil)))
(add-hook 'org-export-html-after-blockquotes-hook
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el
index 5de55fa455f..b4d4c0489a9 100644
--- a/lisp/org/org-src.el
+++ b/lisp/org/org-src.el
@@ -1,13 +1,12 @@
;;; org-src.el --- Source code examples in Org
;;
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Bastien Guerry <bzg AT altern DOT org>
+;; Bastien Guerry <bzg AT gnu DOT org>
;; Dan Davison <davison at stats dot ox dot ac dot uk>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -42,6 +41,9 @@
(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-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
+(declare-function org-base-buffer "org" (buffer))
(defcustom org-edit-src-region-extra nil
"Additional regexps to identify regions for editing with `org-edit-src-code'.
@@ -109,8 +111,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.
@@ -127,7 +128,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."
@@ -152,7 +153,8 @@ but which mess up the display of a snippet in Org exported files.")
(defcustom org-src-lang-modes
'(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)
("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
- ("calc" . fundamental) ("C" . c))
+ ("calc" . fundamental) ("C" . c) ("cpp" . c++)
+ ("screen" . shell-script))
"Alist mapping languages to their major mode.
The key is the language name, the value is the string that should
be inserted as the name of the major mode. For many languages this is
@@ -170,6 +172,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)
@@ -183,9 +186,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)
@@ -198,28 +201,28 @@ 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)
(unless (eq context 'save)
(setq org-edit-src-saved-temp-window-config (current-window-configuration)))
- (let ((mark (and (org-region-active-p) (mark)))
- (case-fold-search t)
- (info (org-edit-src-find-region-and-lang))
- (full-info (org-babel-get-src-block-info))
- (org-mode-p (or (org-mode-p) (derived-mode-p 'org-mode)))
- (beg (make-marker))
- (end (make-marker))
- (allow-write-back-p (null code))
- block-nindent total-nindent ovl lang lang-f single lfmt buffer msg
- begline markline markcol line col transmitted-variables)
+ (let* ((mark (and (org-region-active-p) (mark)))
+ (case-fold-search t)
+ (info (org-edit-src-find-region-and-lang))
+ (full-info (org-babel-get-src-block-info 'light))
+ (org-mode-p (derived-mode-p 'org-mode)) ;; derived-mode-p is reflexive
+ (beg (make-marker))
+ (end (make-marker))
+ (allow-write-back-p (null code))
+ block-nindent total-nindent ovl lang lang-f single lfmt buffer msg
+ begline markline markcol line col transmitted-variables)
(if (not info)
nil
(setq beg (move-marker beg (nth 0 info))
@@ -267,8 +270,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
@@ -305,11 +309,8 @@ buffer."
(error "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
(dolist (pair transmitted-variables)
(org-set-local (car pair) (cadr pair)))
- (when org-mode-p
- (goto-char (point-min))
- (while (re-search-forward "^," nil t)
- (if (eq (org-current-line) line) (setq total-nindent (1+ total-nindent)))
- (replace-match "")))
+ ;; Remove protecting commas from visible part of buffer.
+ (org-unescape-code-in-region (point-min) (point-max))
(when markline
(org-goto-line (1+ (- markline begline)))
(org-move-to-column
@@ -322,6 +323,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))))
@@ -330,6 +332,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)))
@@ -339,7 +342,7 @@ buffer."
(defun org-src-switch-to-buffer (buffer context)
(case org-src-window-setup
('current-window
- (switch-to-buffer buffer))
+ (org-pop-to-buffer-same-window buffer))
('other-window
(switch-to-buffer-other-window buffer))
('other-frame
@@ -350,7 +353,7 @@ buffer."
(delete-frame frame)))
('save
(kill-buffer (current-buffer))
- (switch-to-buffer buffer))
+ (org-pop-to-buffer-same-window buffer))
(t
(switch-to-buffer-other-frame buffer))))
('reorganize-frame
@@ -362,12 +365,21 @@ buffer."
(t
(message "Invalid value %s for org-src-window-setup"
(symbol-name org-src-window-setup))
- (switch-to-buffer buffer))))
+ (org-pop-to-buffer-same-window buffer))))
(defun org-src-construct-edit-buffer-name (org-buffer-name lang)
"Construct the buffer name for a source editing buffer."
(concat "*Org Src " org-buffer-name "[ " lang " ]*"))
+(defun org-src-edit-buffer-p (&optional buffer)
+ "Test whether BUFFER (or the current buffer if BUFFER is nil)
+is a source block editing buffer."
+ (let ((buffer (org-base-buffer (or buffer (current-buffer)))))
+ (and (buffer-name buffer)
+ (string-match "\\`*Org Src " (buffer-name buffer))
+ (local-variable-p 'org-edit-src-beg-marker buffer)
+ (local-variable-p 'org-edit-src-end-marker buffer))))
+
(defun org-edit-src-find-buffer (beg end)
"Find a source editing buffer that is already editing the region BEG to END."
(catch 'exit
@@ -397,7 +409,7 @@ the fragment in the Org-mode buffer."
(case-fold-search t)
(msg (substitute-command-keys
"Edit, then exit with C-c ' (C-c and single quote)"))
- (org-mode-p (org-mode-p))
+ (org-mode-p (derived-mode-p 'org-mode))
(beg (make-marker))
(end (make-marker))
(preserve-indentation org-src-preserve-indentation)
@@ -421,8 +433,8 @@ 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: "))
- (switch-to-buffer buffer)
+ (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
(if (boundp 'org-edit-src-overlay)
@@ -437,12 +449,12 @@ 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")
- (switch-to-buffer buffer)
+ (org-pop-to-buffer-same-window buffer)
(insert code)
(remove-text-properties (point-min) (point-max)
'(display nil invisible nil intangible nil))
@@ -571,6 +583,39 @@ the language, a switch telling if the content should be in a single line."
(goto-char pos)
(org-get-indentation)))
+(defun org-escape-code-in-region (beg end)
+ "Escape lines between BEG and END.
+Escaping happens when a line starts with \"*\", \"#+\", \",*\" or
+\",#+\" by appending a comma to it."
+ (interactive "r")
+ (save-excursion
+ (goto-char beg)
+ (while (re-search-forward "^[ \t]*,?\\(\\*\\|#\\+\\)" end t)
+ (replace-match ",\\1" nil nil nil 1))))
+
+(defun org-escape-code-in-string (s)
+ "Escape lines in string S.
+Escaping happens when a line starts with \"*\", \"#+\", \",*\" or
+\",#+\" by appending a comma to it."
+ (replace-regexp-in-string "^[ \t]*,?\\(\\*\\|#\\+\\)" ",\\1" s nil nil 1))
+
+(defun org-unescape-code-in-region (beg end)
+ "Un-escape lines between BEG and END.
+Un-escaping happens by removing the first comma on lines starting
+with \",*\", \",#+\", \",,*\" and \",,#+\"."
+ (interactive "r")
+ (save-excursion
+ (goto-char beg)
+ (while (re-search-forward "^[ \t]*,?\\(,\\)\\(?:\\*\\|#\\+\\)" end t)
+ (replace-match "" nil nil nil 1))))
+
+(defun org-unescape-code-in-string (s)
+ "Un-escape lines in string S.
+Un-escaping happens by removing the first comma on lines starting
+with \",*\", \",#+\", \",,*\" and \",,#+\"."
+ (replace-regexp-in-string
+ "^[ \t]*,?\\(,\\)\\(?:\\*\\|#\\+\\)" "" s nil nil 1))
+
(defun org-edit-src-exit (&optional context)
"Exit special edit and protect problematic lines."
(interactive)
@@ -580,6 +625,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))
@@ -614,11 +660,12 @@ 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 (org-mode-p) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t)
- (if (eq (org-current-line) line) (setq delta (1+ delta)))
- (replace-match ",\\1")))
+ (org-escape-code-in-region (point-min) (point-max))
+ (setq delta (+ delta
+ (save-excursion
+ (org-goto-line line)
+ (if (looking-at "[ \t]*\\(,,\\)?\\(\\*\\|#+\\)") 1
+ 0)))))
(when (org-bound-and-true-p org-edit-src-picture)
(setq preserve-indentation nil)
(untabify (point-min) (point-max))
@@ -633,13 +680,19 @@ 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)
- (insert code)
+ (delete-region beg (max beg (1- end)))
+ (unless (string-match "^[ \t]*$" code)
+ (insert code)
+ (delete-char 1))
(goto-char beg)
(if single (just-one-space)))
(if (memq t (mapcar (lambda (overlay)
@@ -651,28 +704,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)
@@ -715,6 +781,7 @@ the language, a switch telling if the content should be in a single line."
(with-current-buffer (marker-buffer beg-marker)
(goto-char (marker-position beg-marker))
,@body))))
+(def-edebug-spec org-src-do-at-code-block (body))
(defun org-src-do-key-sequence-at-code-block (&optional key)
"Execute key sequence at code block in the source Org buffer.
@@ -723,7 +790,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
@@ -745,6 +812,7 @@ Org-babel commands."
"If non-nil, the effect of TAB in a code block is as if it were
issued in the language major mode buffer."
:type 'boolean
+ :version "24.1"
:group 'org-babel)
(defun org-src-native-tab-command-maybe ()
@@ -760,7 +828,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)))
@@ -773,13 +841,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
@@ -796,7 +864,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)))
@@ -811,5 +879,4 @@ LANG is a string, and the returned major mode is a symbol."
(provide 'org-src)
-
;;; org-src.el ends here
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 76e4eae4b45..0555041231b 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -1,11 +1,10 @@
;;; org-table.el --- The table editor for Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -42,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
@@ -86,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."
@@ -103,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\\)$"
@@ -132,12 +138,14 @@ 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
"Fraction of numbers in a column required to make the column align right.
-In a column all non-white fields are considered. If at least this
-fraction of fields is matched by `org-table-number-fraction',
+In a column all non-white fields are considered. If at least
+this fraction of fields is matched by `org-table-number-regexp',
alignment to the right border applies."
:group 'org-table-settings
:type 'number)
@@ -170,11 +178,13 @@ window configuration, it is not recommended to set this variable to nil,
except maybe locally in a special file that has mostly tables with long
fields."
:group 'org-table
+ :version "24.1"
:type 'boolean)
(defcustom org-table-fix-formulas-confirm nil
"Whether the user should confirm when Org fixes formulas."
:group 'org-table-editing
+ :version "24.1"
:type '(choice
(const :tag "with yes-or-no" yes-or-no-p)
(const :tag "with y-or-n" y-or-n-p)
@@ -216,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
@@ -237,11 +247,21 @@ number of hours. Other allowed values are 'seconds, 'minutes and
'days, and the output will be a fraction of seconds, minutes or
days."
:group 'org-table-calculation
+ :version "24.1"
:type '(choice (symbol :tag "Seconds" 'seconds)
(symbol :tag "Minutes" 'minutes)
(symbol :tag "Hours " 'hours)
(symbol :tag "Days " 'days)))
+(defcustom org-table-formula-field-format "%s"
+ "Format for fields which contain the result of a formula.
+For example, using \"~%s~\" will display the result within tilde
+characters. Beware that modifying the display can prevent the
+field from being used in another formula."
+ :group 'org-table-settings
+ :version "24.1"
+ :type 'string)
+
(defcustom org-table-formula-evaluate-inline t
"Non-nil means TAB and RET evaluate a formula in current table field.
If the current field starts with an equal sign, it is assumed to be a formula
@@ -357,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
@@ -403,6 +423,7 @@ available parameters."
(concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")
"Match a reference that needs translation, for reference display.")
+;;;###autoload
(defun org-table-create-with-table.el ()
"Use the table.el package to insert a new table.
If there is already a table at point, convert between Org-mode tables
@@ -419,6 +440,7 @@ and table.el tables."
(org-table-convert)))
(t (call-interactively 'table-insert))))
+;;;###autoload
(defun org-table-create-or-convert-from-region (arg)
"Convert region to table, or create an empty table.
If there is an active region, convert it to a table, using the function
@@ -431,6 +453,7 @@ If there is no such region, create an empty table with `org-table-create'."
(org-table-convert-region (region-beginning) (region-end) arg)
(org-table-create arg)))
+;;;###autoload
(defun org-table-create (&optional size)
"Query for a size and insert a table skeleton.
SIZE is a string Columns x Rows like for example \"3x2\"."
@@ -463,6 +486,7 @@ SIZE is a string Columns x Rows like for example \"3x2\"."
(goto-char pos)))
(org-table-align)))
+;;;###autoload
(defun org-table-convert-region (beg0 end0 &optional separator)
"Convert region to a table.
The region goes from BEG0 to END0, but these borders will be moved
@@ -523,6 +547,7 @@ nil When nil, the command tries to be smart and figure out the
(goto-char beg)
(org-table-align)))
+;;;###autoload
(defun org-table-import (file arg)
"Import FILE as a table.
The file is assumed to be tab-separated. Such files can be produced by most
@@ -538,17 +563,21 @@ are found, lines will be split on whitespace into fields."
(defvar org-table-last-alignment)
(defvar org-table-last-column-widths)
+;;;###autoload
(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"))
@@ -558,9 +587,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))
@@ -572,19 +605,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)
@@ -649,6 +679,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(defconst org-narrow-column-arrow "=>"
"Used as display property in narrowed table columns.")
+;;;###autoload
(defun org-table-align ()
"Align the table at point by aligning all vertical bars."
(interactive)
@@ -684,7 +715,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)))
@@ -721,7 +752,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
@@ -753,7 +784,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\""
@@ -816,23 +847,13 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(append (pop fields) emptystrings))
hfmt))
lines ""))
- (if (equal (char-before) ?\n)
- ;; This hack is for org-indent, to force redisplay of the
- ;; line prefix of the first line. Apparently the redisplay
- ;; is tied to the newline, which is, I think, a bug.
- ;; To force this redisplay, we remove and re-insert the
- ;; newline, so that the redisplay engine thinks it belongs
- ;; to the changed text.
- (progn
- (backward-delete-char 1)
- (insert "\n")))
(move-marker org-table-aligned-begin-marker (point))
(insert new)
;; Replace the old one
(delete-region (point) end)
(move-marker end nil)
(move-marker org-table-aligned-end-marker (point))
- (when (and orgtbl-mode (not (org-mode-p)))
+ (when (and orgtbl-mode (not (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
@@ -870,6 +891,7 @@ With argument TABLE-TYPE, go to the end of a table.el-type table."
(goto-char (match-beginning 0)))
(point-marker)))
+;;;###autoload
(defun org-table-justify-field-maybe (&optional new)
"Justify the current field, text to left, number to right.
Optional argument NEW may specify text to replace the current field content."
@@ -910,6 +932,7 @@ Optional argument NEW may specify text to replace the current field content."
(setq org-table-may-need-update t))
(goto-char pos))))))
+;;;###autoload
(defun org-table-next-field ()
"Go to the next field in the current table, creating new lines as needed.
Before doing so, re-align the table if necessary."
@@ -939,6 +962,7 @@ Before doing so, re-align the table if necessary."
(error
(org-table-insert-row 'below)))))
+;;;###autoload
(defun org-table-previous-field ()
"Go to the previous field in the table.
Before doing so, re-align the table if necessary."
@@ -992,6 +1016,7 @@ With numeric argument N, move N-1 fields backward first."
(forward-char 1)))
(if (<= (point) pos) (org-table-end-of-field 2))))
+;;;###autoload
(defun org-table-next-row ()
"Go to the next row (same column) in the current table.
Before doing so, re-align the table if necessary."
@@ -1015,6 +1040,7 @@ Before doing so, re-align the table if necessary."
(skip-chars-backward "^|\n\r")
(if (looking-at " ") (forward-char 1)))))
+;;;###autoload
(defun org-table-copy-down (n)
"Copy a field down in the current column.
If the field at the cursor is empty, copy into it the content of
@@ -1159,6 +1185,7 @@ is always the old value."
val)
(forward-char 1) ""))
+;;;###autoload
(defun org-table-field-info (arg)
"Show info about the current field, and highlight any reference at point."
(interactive "P")
@@ -1214,6 +1241,7 @@ is always the old value."
(message "In table column %d" cnt))
cnt)))
+;;;###autoload
(defun org-table-current-dline ()
"Find out what table data line we are in.
Only data lines count for this."
@@ -1230,6 +1258,7 @@ Only data lines count for this."
(message "This is table line %d" cnt))
cnt)))
+;;;###autoload
(defun org-table-goto-column (n &optional on-delim force)
"Move the cursor to the Nth column in the current table line.
With optional argument ON-DELIM, stop with point before the left delimiter
@@ -1252,6 +1281,7 @@ However, when FORCE is non-nil, create new columns if necessary."
(backward-char 1)
(if (looking-at " ") (forward-char 1)))))
+;;;###autoload
(defun org-table-insert-column ()
"Insert a new column into the table."
(interactive)
@@ -1302,7 +1332,7 @@ However, when FORCE is non-nil, create new columns if necessary."
(defun org-table-line-to-dline (line &optional above)
"Turn a buffer line number into a data line number.
If there is no data line in this line, return nil.
-If there is no matching dline (most likely the reference was a hline), the
+If there is no matching dline (most likely te reference was a hline), the
first dline below it is used. When ABOVE is non-nil, the one above is used."
(catch 'exit
(let ((ll (length org-table-dlines))
@@ -1318,9 +1348,10 @@ 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))
+;;;###autoload
(defun org-table-delete-column ()
"Delete a column from the table."
(interactive)
@@ -1353,15 +1384,18 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
(org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID"))
col -1 col))))
+;;;###autoload
(defun org-table-move-column-right ()
"Move column to the right."
(interactive)
(org-table-move-column nil))
+;;;###autoload
(defun org-table-move-column-left ()
"Move column to the left."
(interactive)
(org-table-move-column 'left))
+;;;###autoload
(defun org-table-move-column (&optional left)
"Move the current column to the right. With arg LEFT, move to the left."
(interactive "P")
@@ -1401,15 +1435,18 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
"$LR" (list (cons (number-to-string col) (number-to-string colpos))
(cons (number-to-string colpos) (number-to-string col)))))))
+;;;###autoload
(defun org-table-move-row-down ()
"Move table row down."
(interactive)
(org-table-move-row nil))
+;;;###autoload
(defun org-table-move-row-up ()
"Move table row up."
(interactive)
(org-table-move-row 'up))
+;;;###autoload
(defun org-table-move-row (&optional up)
"Move the current table line down. With arg UP, move it up."
(interactive "P")
@@ -1443,6 +1480,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
"@" (list (cons (number-to-string dline1) (number-to-string dline2))
(cons (number-to-string dline2) (number-to-string dline1)))))))
+;;;###autoload
(defun org-table-insert-row (&optional arg)
"Insert a new row above the current line into the table.
With prefix ARG, insert below the current line."
@@ -1464,6 +1502,7 @@ With prefix ARG, insert below the current line."
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))))
+;;;###autoload
(defun org-table-insert-hline (&optional above)
"Insert a horizontal-line below the current line into the table.
With prefix ABOVE, insert above the current line."
@@ -1487,6 +1526,7 @@ With prefix ABOVE, insert above the current line."
(org-move-to-column col)
(and org-table-overlay-coordinates (org-table-align))))
+;;;###autoload
(defun org-table-hline-and-move (&optional same-column)
"Insert a hline and move to the row below that line."
(interactive "P")
@@ -1513,6 +1553,7 @@ In particular, this does handle wide and invisible characters."
t t s)))
s))
+;;;###autoload
(defun org-table-kill-row ()
"Delete the current row or horizontal line from the table."
(interactive)
@@ -1528,6 +1569,7 @@ In particular, this does handle wide and invisible characters."
(org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
dline -1 dline))))
+;;;###autoload
(defun org-table-sort-lines (with-case &optional sorting-type)
"Sort table lines according to the column at point.
@@ -1608,7 +1650,7 @@ should be done in reverse order."
(org-table-goto-column thiscol)
(message "%d lines sorted, based on column %d" (length lns) column)))
-
+;;;###autoload
(defun org-table-cut-region (beg end)
"Copy region in table to the clipboard and blank all relevant fields.
If there is no active region, use just the field at point."
@@ -1617,6 +1659,7 @@ If there is no active region, use just the field at point."
(if (org-region-active-p) (region-end) (point))))
(org-table-copy-region beg end 'cut))
+;;;###autoload
(defun org-table-copy-region (beg end &optional cut)
"Copy rectangular region in table to clipboard.
A special clipboard is used which can only be accessed
@@ -1626,8 +1669,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)
@@ -1654,6 +1697,7 @@ with `org-table-paste-rectangle'."
(if cut (org-table-align))
org-table-clip))
+;;;###autoload
(defun org-table-paste-rectangle ()
"Paste a rectangular region into a table.
The upper right corner ends up in the current field. All involved fields
@@ -1684,6 +1728,7 @@ lines."
(org-table-goto-column col)
(org-table-align)))
+;;;###autoload
(defun org-table-convert ()
"Convert from `org-mode' table to table.el and back.
Obviously, this only works within limits. When an Org-mode table is
@@ -1729,6 +1774,35 @@ blindly applies a recipe that works for simple tables."
(replace-match "-+"))
(goto-char beg)))))
+(defun org-table-transpose-table-at-point ()
+ "Transpose orgmode table at point and eliminate hlines.
+So a table like
+
+| 1 | 2 | 4 | 5 |
+|---+---+---+---|
+| a | b | c | d |
+| e | f | g | h |
+
+will be transposed as
+
+| 1 | a | e |
+| 2 | b | f |
+| 4 | c | g |
+| 5 | d | h |
+
+Note that horizontal lines disappeared."
+ (interactive)
+ (let ((contents
+ (apply #'mapcar* #'list
+ ;; remove 'hline from list
+ (delq nil (mapcar (lambda (x) (when (listp x) x))
+ (org-table-to-lisp))))))
+ (delete-region (org-table-begin) (org-table-end))
+ (insert (mapconcat (lambda(x) (concat "| " (mapconcat 'identity x " | " ) " |\n" ))
+ contents ""))
+ (org-table-align)))
+
+;;;###autoload
(defun org-table-wrap-region (arg)
"Wrap several fields in a column like a paragraph.
This is useful if you'd like to spread the contents of a field over several
@@ -1799,6 +1873,7 @@ blank, and the content is appended to the field above."
(defvar org-field-marker nil)
+;;;###autoload
(defun org-table-edit-field (arg)
"Edit table field in a different window.
This is mainly useful for fields that contain hidden parts.
@@ -1902,6 +1977,7 @@ table (but see `org-table-exit-follow-field-mode-when-leaving-table')."
(defvar org-timecnt) ; dynamically scoped parameter
+;;;###autoload
(defun org-table-sum (&optional beg end nlast)
"Sum numbers in region of current table column.
The result will be displayed in the echo area, and will be available
@@ -2059,22 +2135,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)
@@ -2101,13 +2178,14 @@ When NAMED is non-nil, look for a named equation."
(bs (org-table-formula-make-cmp-string (car b))))
(and as bs (string< as bs))))
+;;;###autoload
(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)
+ (interactive) ;; FIXME interactive?
+ (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))
@@ -2135,8 +2213,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"))
@@ -2147,16 +2226,20 @@ For all numbers larger than LIMIT, shift them by DELTA."
(when remove
(while (re-search-forward re2 (point-at-eol) t)
(unless (save-match-data (org-in-regexp "remote([^)]+?)"))
- (replace-match ""))))
+ (if (equal (char-before (match-beginning 0)) ?.)
+ (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)
(unless (save-match-data (org-in-regexp "remote([^)]+?)"))
(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."
@@ -2177,7 +2260,7 @@ For all numbers larger than LIMIT, shift them by DELTA."
cnt 1)
(while (setq name (pop names))
(setq cnt (1+ cnt))
- (if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name)
+ (if (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" name)
(push (cons name (int-to-string cnt)) org-table-column-names))))
(setq org-table-column-names (nreverse org-table-column-names))
(setq org-table-column-name-regexp
@@ -2201,10 +2284,10 @@ For all numbers larger than LIMIT, shift them by DELTA."
(while (and fields1 (setq field (pop fields)))
(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))))
- ;; Analyze the line types
+ (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))))
+ ;; Analyse the line types
(goto-char beg)
(setq org-table-current-begin-line (org-current-line)
org-table-current-begin-pos (point)
@@ -2235,6 +2318,7 @@ For all numbers larger than LIMIT, shift them by DELTA."
(setq org-table-local-parameters
(append org-table-local-parameters al2))))))
+;;;###autoload
(defun org-table-maybe-eval-formula ()
"Check if the current field starts with \"=\" or \":=\".
If yes, store the formula and apply it."
@@ -2243,7 +2327,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)
@@ -2260,11 +2344,12 @@ 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.")))
+;;;###autoload
(defun org-table-rotate-recalc-marks (&optional newchar)
"Rotate the recalculation mark in the first column.
If in any row, the first field is not consistent with a mark,
@@ -2326,6 +2411,7 @@ of the new mark."
(and (org-called-interactively-p 'interactive)
(message "%s" (cdr (assoc new org-recalc-marks))))))
+;;;###autoload
(defun org-table-maybe-recalculate-line ()
"Recompute the current line if marked for it, and if we haven't just done it."
(interactive)
@@ -2336,7 +2422,7 @@ of the new mark."
(looking-at org-table-auto-recalculate-regexp))
(org-table-recalculate) t))
-(defvar modes)
+(defvar org-tbl-calc-modes) ;; Dynamically bound in `org-table-eval-formula'
(defsubst org-set-calc-mode (var &optional value)
(if (stringp var)
(setq var (assoc var '(("D" calc-angle-mode deg)
@@ -2344,11 +2430,12 @@ of the new mark."
("F" calc-prefer-frac t)
("S" calc-symbolic-mode t)))
value (nth 2 var) var (nth 1 var)))
- (if (memq var modes)
- (setcar (cdr (memq var modes)) value)
- (cons var (cons value modes)))
- modes)
+ (if (memq var org-tbl-calc-modes)
+ (setcar (cdr (memq var org-tbl-calc-modes)) value)
+ (cons var (cons value org-tbl-calc-modes)))
+ org-tbl-calc-modes)
+;;;###autoload
(defun org-table-eval-formula (&optional arg equation
suppress-align suppress-const
suppress-store suppress-analysis)
@@ -2405,10 +2492,11 @@ not overwrite the stored one."
equation
(org-table-get-formula equation (equal arg '(4)))))
(n0 (org-table-current-column))
- (modes (copy-sequence org-calc-default-modes))
+ (org-tbl-calc-modes (copy-sequence org-calc-default-modes))
(numbers nil) ; was a variable, now fixed default
(keep-empty nil)
- n form form0 formrpl formrg bw fmt x ev orig c lispp literal duration)
+ n form form0 formrpl formrg bw fmt x ev orig c lispp literal
+ duration duration-output-format)
;; Parse the format string. Since we have a lot of modes, this is
;; a lot of work. However, I think calc still uses most of the time.
(if (string-match ";" formula)
@@ -2420,12 +2508,13 @@ not overwrite the stored one."
(setq c (string-to-char (match-string 1 fmt))
n (string-to-number (match-string 2 fmt)))
(if (= c ?p)
- (setq modes (org-set-calc-mode 'calc-internal-prec n))
- (setq modes (org-set-calc-mode
- 'calc-float-format
- (list (cdr (assoc c '((?n . float) (?f . fix)
- (?s . sci) (?e . eng))))
- n))))
+ (setq org-tbl-calc-modes (org-set-calc-mode 'calc-internal-prec n))
+ (setq org-tbl-calc-modes
+ (org-set-calc-mode
+ 'calc-float-format
+ (list (cdr (assoc c '((?n . float) (?f . fix)
+ (?s . sci) (?e . eng))))
+ n))))
(setq fmt (replace-match "" t t fmt)))
(if (string-match "T" fmt)
(setq duration t numbers t
@@ -2446,7 +2535,7 @@ not overwrite the stored one."
(setq keep-empty t
fmt (replace-match "" t t fmt)))
(while (string-match "[DRFS]" fmt)
- (setq modes (org-set-calc-mode (match-string 0 fmt)))
+ (setq org-tbl-calc-modes (org-set-calc-mode (match-string 0 fmt)))
(setq fmt (replace-match "" t t fmt)))
(unless (string-match "\\S-" fmt)
(setq fmt nil))))
@@ -2455,8 +2544,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
@@ -2493,8 +2581,13 @@ not overwrite the stored one."
(replace-match
(save-match-data
(org-table-make-reference
- (org-table-get-remote-range
- (match-string 1 form) (match-string 2 form))
+ (let ((rmtrng (org-table-get-remote-range
+ (match-string 1 form) (match-string 2 form))))
+ (if duration
+ (if (listp rmtrng)
+ (mapcar (lambda(x) (org-table-time-string-to-seconds x)) rmtrng)
+ (org-table-time-string-to-seconds rmtrng))
+ rmtrng))
keep-empty numbers lispp))
t t form)))
;; Insert complex ranges
@@ -2550,10 +2643,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 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*"
@@ -2579,7 +2679,8 @@ $1-> %s\n" orig formula form0 form))
(message "")))
(if (listp ev) (setq fmt nil ev "#ERROR"))
(org-table-justify-field-maybe
- (if fmt (format fmt (string-to-number ev)) ev))
+ (format org-table-formula-field-format
+ (if fmt (format fmt (string-to-number ev)) ev)))
(if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]"))
(call-interactively 'org-return)
(setq ndown 0)))
@@ -2626,11 +2727,11 @@ 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 (not c1) (setq c1 col))
- (if (not c2) (setq c2 col))
+ (if (or (not c1) (= 0 c1)) (setq c1 col))
+ (if (or (not c2) (= 0 c2)) (setq c2 col))
(if (and (not corners-only)
(or (not rangep) (and (= r1 r2) (= c1 c2))))
;; just one field
@@ -2761,6 +2862,7 @@ LISPP means to return something appropriate for a Lisp list."
elements
",") "]"))))
+;;;###autoload
(defun org-table-recalculate (&optional all noalign)
"Recalculate the current table line by applying all stored formulas.
With prefix arg ALL, do this for all lines in the table.
@@ -2841,7 +2943,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)
@@ -2899,9 +3001,10 @@ known that the table will be realigned a little later anyway."
(or noalign (and org-table-may-need-update (org-table-align))
(and all (message "Re-applying formulas...done"))))))
+;;;###autoload
(defun org-table-iterate (&optional arg)
"Recalculate the table until it does not change anymore.
-The maximum number of iterations is 10, but you can chose a different value
+The maximum number of iterations is 10, but you can choose a different value
with the prefix ARG."
(interactive "P")
(let ((imax (if arg (prefix-numeric-value arg) 10))
@@ -2921,6 +3024,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)
@@ -2929,27 +3033,27 @@ 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)
+ (i imax)
+ (checksum (md5 (buffer-string)))
+ c1)
+ (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.
@@ -2959,10 +3063,10 @@ 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)
+ ((string-match "^[a-zA-Z][_a-zA-Z0-9]*$" lhs)
;; This just refers to one fixed named field
(push e res))
((string-match "^@[0-9]+$" lhs)
@@ -2989,24 +3093,28 @@ them to individual field equations for each field."
So @< and $< will always be replaced with @1 and $1, respectively.
The advantage of these special markers are that structure editing of
the table will not change them, while @1 and $1 will be modified
-when a line/row is swaped out of that privileged position. So for
+when a line/row is swapped out of that privileged position. So for
formulas that use a range of rows or columns, it may often be better
to anchor the formula with \"I\" row markers, or to offset from the
borders of the table using the @< @> $< $> makers."
- (let (n nmax len char)
- (while (string-match "\\([@$]\\)\\(<+\\|>+\\)" s)
- (setq nmax (if (equal (match-string 1 s) "@")
- (1- (length org-table-dlines))
- org-table-current-ncol)
- len (- (match-end 2) (match-beginning 2))
- char (string-to-char (match-string 2 s))
- n (if (= char ?<)
- len
- (- nmax len -1)))
- (if (or (< n 1) (> n nmax))
- (error "Reference \"%s\" in expression \"%s\" points outside table"
- (match-string 0 s) s))
- (setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s))))
+ (let (n nmax len char (start 0))
+ (while (string-match "\\([@$]\\)\\(<+\\|>+\\)\\|\\(remote([^\)]+)\\)"
+ s start)
+ (if (match-end 3)
+ (setq start (match-end 3))
+ (setq nmax (if (equal (match-string 1 s) "@")
+ (1- (length org-table-dlines))
+ org-table-current-ncol)
+ len (- (match-end 2) (match-beginning 2))
+ char (string-to-char (match-string 2 s))
+ n (if (= char ?<)
+ len
+ (- nmax len -1)))
+ (if (or (< n 1) (> n nmax))
+ (error "Reference \"%s\" in expression \"%s\" points outside table"
+ (match-string 0 s) s))
+ (setq start (match-beginning 0))
+ (setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s)))))
s)
(defun org-table-formula-substitute-names (f)
@@ -3096,10 +3204,11 @@ Parameters get priority."
(defvar org-pos)
+;;;###autoload
(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)
@@ -3173,7 +3282,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
@@ -3224,8 +3333,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)
@@ -3241,40 +3350,45 @@ 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 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.
If OUTPUT-FORMAT is non-nil, return a number of days, hours,
minutes or seconds."
- (cond ((eq output-format 'days)
- (format "%.3f" (/ (float secs) 86400)))
- ((eq output-format 'hours)
- (format "%.2f" (/ (float secs) 3600)))
- ((eq output-format 'minutes)
- (format "%.1f" (/ (float secs) 60)))
- ((eq output-format 'seconds)
- (format "%d" secs))
- (t (org-format-seconds "%.2h:%.2m:%.2s" secs))))
+ (let* ((secs0 (abs secs))
+ (res
+ (cond ((eq output-format 'days)
+ (format "%.3f" (/ (float secs0) 86400)))
+ ((eq output-format 'hours)
+ (format "%.2f" (/ (float secs0) 3600)))
+ ((eq output-format 'minutes)
+ (format "%.1f" (/ (float secs0) 60)))
+ ((eq output-format 'seconds)
+ (format "%d" secs0))
+ (t (org-format-seconds "%.2h:%.2m:%.2s" secs0)))))
+ (if (< secs 0) (concat "-" res) res)))
(defun org-table-fedit-convert-buffer (function)
"Convert all references in this buffer, using FUNCTION."
@@ -3523,7 +3637,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
@@ -3728,11 +3842,12 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
(org-overlay-display ov str 'org-special-keyword 'evaporate)))
(beginning-of-line 2)))))
+;;;###autoload
(defun org-table-toggle-coordinate-overlays ()
"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))
@@ -3740,6 +3855,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
(mapc 'delete-overlay org-table-coordinate-overlays)
(setq org-table-coordinate-overlays nil)))
+;;;###autoload
(defun org-table-toggle-formula-debugger ()
"Toggle the formula debugger in tables."
(interactive)
@@ -3779,16 +3895,11 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
(defvar orgtbl-mode-map (make-keymap)
"Keymap for `orgtbl-mode'.")
-;;;###autoload
-(defun turn-on-orgtbl ()
- "Unconditionally turn on `orgtbl-mode'."
- (orgtbl-mode 1))
-
(defvar org-old-auto-fill-inhibit-regexp nil
"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
@@ -3806,7 +3917,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
:lighter " OrgTbl" :keymap orgtbl-mode-map
(org-load-modules-maybe)
(cond
- ((org-mode-p)
+ ((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"))
@@ -3901,6 +4012,7 @@ to execute outside of tables."
("\C-c\C-w" org-table-cut-region)
("\C-c\M-w" org-table-copy-region)
("\C-c\C-y" org-table-paste-rectangle)
+ ("\C-c\C-w" org-table-wrap-region)
("\C-c-" org-table-insert-hline)
("\C-c}" org-table-toggle-coordinate-overlays)
("\C-c{" org-table-toggle-formula-debugger)
@@ -3927,37 +4039,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)
@@ -4035,13 +4147,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)
@@ -4119,7 +4231,7 @@ overwritten, and the table is not marked as requiring realignment."
(looking-at "[^|\n]* +|"))
(let (org-table-may-need-update)
(goto-char (1- (match-end 0)))
- (delete-char -1)
+ (backward-delete-char 1)
(goto-char (match-beginning 0))
(self-insert-command N))
(setq org-table-may-need-update t)
@@ -4130,7 +4242,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))
@@ -4250,11 +4362,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)
@@ -4276,7 +4392,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))))
@@ -4296,12 +4412,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
@@ -4401,6 +4518,7 @@ First element has index 0, or I0 if given."
(*orgtbl-lfmt* *orgtbl-llfmt*))
(orgtbl-format-line prevline))))))
+;;;###autoload
(defun orgtbl-to-generic (table params)
"Convert the orgtbl-mode TABLE to some other format.
This generic routine can be used for many standard cases.
@@ -4410,7 +4528,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
@@ -4423,9 +4541,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.
@@ -4436,6 +4554,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.
@@ -4443,14 +4562,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
@@ -4459,10 +4578,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)
@@ -4508,7 +4626,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.
@@ -4527,9 +4645,11 @@ directly by `orgtbl-send-table'. See manual."
(remq nil *orgtbl-rtn*)
*orgtbl-rtn*)) "\n")))
+;;;###autoload
(defun orgtbl-to-tsv (table params)
"Convert the orgtbl-mode table to TAB separated material."
(orgtbl-to-generic table (org-combine-plists '(:sep "\t") params)))
+;;;###autoload
(defun orgtbl-to-csv (table params)
"Convert the orgtbl-mode table to CSV material.
This does take care of the proper quoting of fields with comma or quotes."
@@ -4537,6 +4657,7 @@ This does take care of the proper quoting of fields with comma or quotes."
'(:sep "," :fmt org-quote-csv-field)
params)))
+;;;###autoload
(defun orgtbl-to-latex (table params)
"Convert the orgtbl-mode TABLE to LaTeX.
TABLE is a list, each entry either the symbol `hline' for a horizontal
@@ -4575,6 +4696,7 @@ this function is called."
:efmt "%s\\,(%s)" :hline "\\hline")))
(orgtbl-to-generic table (org-combine-plists params2 params))))
+;;;###autoload
(defun orgtbl-to-html (table params)
"Convert the orgtbl-mode TABLE to HTML.
TABLE is a list, each entry either the symbol `hline' for a horizontal
@@ -4605,6 +4727,7 @@ so you cannot specify parameters for it."
(setq html (replace-match "" t t html)))
html))
+;;;###autoload
(defun orgtbl-to-texinfo (table params)
"Convert the orgtbl-mode TABLE to TeXInfo.
TABLE is a list, each entry either the symbol `hline' for a horizontal
@@ -4643,6 +4766,7 @@ this function is called."
:hlstart "@headitem ")))
(orgtbl-to-generic table (org-combine-plists params2 params))))
+;;;###autoload
(defun orgtbl-to-orgtbl (table params)
"Convert the orgtbl-mode TABLE into another orgtbl-mode table.
Useful when slicing one table into many. The :hline, :sep,
@@ -4658,7 +4782,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.
@@ -4674,7 +4828,9 @@ 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
org-table-local-parameters org-table-named-field-locations
org-table-current-line-types org-table-current-begin-line
@@ -4691,7 +4847,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))
@@ -4711,7 +4867,8 @@ list of the fields in the rectangle ."
(error "Cannot find a table at NAME or ID %s" name-or-id))
(setq tbeg (point-at-bol))
(org-table-get-specials)
- (setq form (org-table-formula-substitute-names form))
+ (setq form (org-table-formula-substitute-names
+ (org-table-formula-handle-first/last-rc form)))
(if (and (string-match org-table-range-regexp form)
(> (length (match-string 0 form)) 1))
(save-match-data
@@ -4720,6 +4877,8 @@ list of the fields in the rectangle ."
(provide 'org-table)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-table.el ends here
diff --git a/lisp/org/org-taskjuggler.el b/lisp/org/org-taskjuggler.el
index 45b16aecf12..a3de6e41239 100644
--- a/lisp/org/org-taskjuggler.el
+++ b/lisp/org/org-taskjuggler.el
@@ -1,10 +1,9 @@
;;; org-taskjuggler.el --- TaskJuggler exporter for org-mode
;;
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;;
;; Emacs Lisp Archive Entry
;; Filename: org-taskjuggler.el
-;; Version: 7.7
;; Author: Christian Egli
;; Maintainer: Christian Egli
;; Keywords: org, taskjuggler, project planning
@@ -30,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
@@ -43,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
@@ -61,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.
@@ -76,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
@@ -85,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
@@ -111,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:
@@ -145,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.
;;
@@ -167,28 +166,33 @@
(defcustom org-export-taskjuggler-extension ".tjp"
"Extension of TaskJuggler files."
:group 'org-export-taskjuggler
+ :version "24.1"
:type 'string)
(defcustom org-export-taskjuggler-project-tag "taskjuggler_project"
"Tag, property or todo used to find the tree containing all
the tasks for the project."
:group 'org-export-taskjuggler
+ :version "24.1"
:type 'string)
(defcustom org-export-taskjuggler-resource-tag "taskjuggler_resource"
"Tag, property or todo used to find the tree containing all the
resources for the project."
:group 'org-export-taskjuggler
+ :version "24.1"
:type 'string)
(defcustom org-export-taskjuggler-target-version 2.4
"Which version of TaskJuggler the exporter is targeting."
:group 'org-export-taskjuggler
+ :version "24.1"
:type 'number)
(defcustom org-export-taskjuggler-default-project-version "1.0"
"Default version string for the project."
:group 'org-export-taskjuggler
+ :version "24.1"
:type 'string)
(defcustom org-export-taskjuggler-default-project-duration 280
@@ -196,6 +200,7 @@ resources for the project."
in the root node of the task tree, i.e. the tree that has been marked
with `org-export-taskjuggler-project-tag'"
:group 'org-export-taskjuggler
+ :version "24.1"
:type 'integer)
(defcustom org-export-taskjuggler-default-reports
@@ -206,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
@@ -215,6 +220,7 @@ with `org-export-taskjuggler-project-tag'"
}")
"Default reports for the project."
:group 'org-export-taskjuggler
+ :version "24.1"
:type '(repeat (string :tag "Report")))
(defcustom org-export-taskjuggler-default-global-properties
@@ -222,15 +228,16 @@ 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
but before any resource and task declarations."
:group 'org-export-taskjuggler
+ :version "24.1"
:type '(string :tag "Preamble"))
;;; Hooks
@@ -248,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)
@@ -278,6 +285,7 @@ defined in `org-export-taskjuggler-default-reports'."
(file-name-nondirectory buffer-file-name))
org-export-taskjuggler-extension)))
(buffer (find-file-noselect filename))
+ (old-buffer (current-buffer))
(org-export-taskjuggler-old-level 0)
task resource)
(unless tasks
@@ -305,6 +313,7 @@ defined in `org-export-taskjuggler-default-reports'."
(setcar tasks (push (cons "version" version) task))))
(with-current-buffer buffer
(erase-buffer)
+ (org-clone-local-variables old-buffer "^org-")
(org-taskjuggler-open-project (car tasks))
(insert org-export-taskjuggler-default-global-properties)
(insert "\n")
@@ -343,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"))))
@@ -364,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)
@@ -397,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)
@@ -443,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))
@@ -457,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)
@@ -471,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)
@@ -484,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 ."
@@ -514,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)))))
@@ -532,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))
@@ -550,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)))
@@ -571,9 +580,9 @@ with separator \"\n\"."
(and filtered-items (mapconcat 'identity filtered-items "\n"))))
(defun org-taskjuggler-get-attributes (item attributes)
- "Return all attributes 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
@@ -594,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
@@ -613,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)
@@ -683,4 +692,8 @@ org-mode priority string."
(provide 'org-taskjuggler)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
;;; org-taskjuggler.el ends here
diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el
index b8fbc4ff388..a314564b94a 100644
--- a/lisp/org/org-timer.el
+++ b/lisp/org/org-timer.el
@@ -1,11 +1,10 @@
;;; org-timer.el --- The relative timer code for Org-mode
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -54,8 +53,25 @@ the value of the relative timer."
"The default timer when a timer is set.
When 0, the user is prompted for a value."
:group 'org-time
+ :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.")
@@ -181,7 +197,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 +240,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 +286,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,51 +396,53 @@ 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)))))))
- ((org-mode-p)
- (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)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-timer.el ends here
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
new file mode 100644
index 00000000000..564b49a5cea
--- /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
+(defvar 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 d0991b81116..b919cd19fea 100644
--- a/lisp/org/org-vm.el
+++ b/lisp/org/org-vm.el
@@ -1,11 +1,14 @@
;;; org-vm.el --- Support for links to VM messages from within Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
+;;
+;; 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.
;;
@@ -43,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
@@ -62,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)
@@ -74,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))))
@@ -122,20 +135,43 @@
(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)
diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el
index bce90092e6e..bad20036b82 100644
--- a/lisp/org/org-w3m.el
+++ b/lisp/org/org-w3m.el
@@ -1,11 +1,10 @@
;;; org-w3m.el --- Support from copy and paste from w3m to Org-mode
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Andy Stewart <lazycat dot manatee at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -168,6 +167,4 @@ Return t if there is no previous link; otherwise, return nil."
(provide 'org-w3m)
-
-
;;; org-w3m.el ends here
diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el
index 9bc49c8b91a..724b07a288c 100644
--- a/lisp/org/org-wl.el
+++ b/lisp/org/org-wl.el
@@ -1,12 +1,11 @@
;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
;; David Maus <dmaus at ictsoc dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -35,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."
@@ -47,11 +46,13 @@
(defcustom org-wl-link-remove-filter nil
"Remove filter condition if message is filter folder."
:group 'org-wl
+ :version "24.1"
:type 'boolean)
(defcustom org-wl-shimbun-prefer-web-links nil
"If non-nil create web links for shimbun messages."
:group 'org-wl
+ :version "24.1"
:type 'boolean)
(defcustom org-wl-nntp-prefer-web-links nil
@@ -59,16 +60,19 @@
When folder name contains string \"gmane\" link to gmane,
googlegroups otherwise."
:type 'boolean
+ :version "24.1"
:group 'org-wl)
(defcustom org-wl-disable-folder-check t
"Disable check for new messages when open a link."
:type 'boolean
+ :version "24.1"
:group 'org-wl)
(defcustom org-wl-namazu-default-index nil
"Default namazu search index."
:type 'directory
+ :version "24.1"
:group 'org-wl)
;; Declare external functions and variables
@@ -157,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)
@@ -242,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
@@ -305,10 +309,8 @@ 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)
-
-
;;; org-wl.el ends here
diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el
index 02f351fe724..6ff78b56839 100644
--- a/lisp/org/org-xoxo.el
+++ b/lisp/org/org-xoxo.el
@@ -1,11 +1,10 @@
;;; org-xoxo.el --- XOXO export for Org-mode
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -50,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
@@ -123,5 +122,8 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
(provide 'org-xoxo)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; org-xoxo.el ends here
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 8aca74e69cc..45dbe2754e8 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -1,11 +1,12 @@
;;; org.el --- Outline-based notes management and organizer
+
;; Carstens outline-mode for keeping track of everything.
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Maintainer: Bastien Guerry <bzg at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
@@ -74,6 +75,29 @@
(require 'gnus-sum))
(require 'calendar)
+(require 'find-func)
+(require 'format-spec)
+
+(load "org-loaddefs.el" t t)
+
+;; `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)
@@ -86,40 +110,32 @@
(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" ())
+(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
(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))
+
+(declare-function orgtbl-mode "org-table" (&optional arg))
+(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time))
+(declare-function org-beamer-mode "org-beamer" ())
+(declare-function org-table-edit-field "org-table" (arg))
+(declare-function org-table-justify-field-maybe "org-table" (&optional new))
+(declare-function org-id-get-create "org-id" (&optional force))
+(declare-function org-id-find-id-file "org-id" (id))
+(declare-function org-tags-view "org-agenda" (&optional todo-only match))
+(declare-function org-agenda-list "org-agenda" (&optional arg start-day span))
+(declare-function org-table-align "org-table" ())
+(declare-function org-table-paste-rectangle "org-table" ())
+(declare-function org-table-maybe-eval-formula "org-table" ())
+(declare-function org-table-maybe-recalculate-line "org-table" ())
;; load languages based on value of `org-babel-load-languages'
(defvar org-babel-load-languages)
+
;;;###autoload
(defun org-babel-do-load-languages (sym value)
"Load the languages defined in `org-babel-load-languages'."
@@ -149,6 +165,7 @@ keybinding. By default only Emacs Lisp (which has no
requirements) is loaded."
:group 'org-babel
:set 'org-babel-do-load-languages
+ :version "24.1"
:type '(alist :tag "Babel Languages"
:key-type
(choice
@@ -162,13 +179,16 @@ requirements) is loaded."
(const :tag "Ditaa" ditaa)
(const :tag "Dot" dot)
(const :tag "Emacs Lisp" emacs-lisp)
+ (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)
@@ -176,13 +196,16 @@ requirements) is loaded."
(const :tag "Octave" octave)
(const :tag "Org" org)
(const :tag "Perl" perl)
+ (const :tag "Pico Lisp" picolisp)
(const :tag "PlantUML" plantuml)
(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)
+ (const :tag "Shen" shen)
(const :tag "Sql" sql)
(const :tag "Sqlite" sqlite))
:value-type (boolean :tag "Activate" :value t)))
@@ -194,40 +217,45 @@ When non-nil, clones of a subtree don't inherit the ID property.
Otherwise they inherit the ID property with a new unique
identifier."
:type 'boolean
+ :version "24.1"
:group 'org-id)
;;; Version
+(require 'org-compat)
+(org-check-version)
-(defconst org-version "7.7"
- "The version number of the file org.el.")
-
-(defun org-version (&optional here)
+;;;###autoload
+(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-loaddefs.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-loaddefs.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
@@ -249,6 +277,12 @@ With prefix arg HERE, insert it at point."
:group 'org
:type 'hook)
+(defcustom org-log-buffer-setup-hook nil
+ "Hook that is run after an Org log buffer is created."
+ :group 'org
+ :version "24.1"
+ :type 'hook)
+
(defvar org-modules) ; defined below
(defvar org-modules-loaded nil
"Have the modules been loaded already?")
@@ -338,7 +372,6 @@ to add the symbol `xyz', and the package must have a call to
(const :tag "C mac-link-grabber Grab links and URLs from various Mac applications" org-mac-link-grabber)
(const :tag "C man: Support for links to manpages in Org-mode" org-man)
(const :tag "C mtags: Support for muse-like tags" org-mtags)
- (const :tag "C odt: OpenDocumentText exporter for Org-mode" org-odt)
(const :tag "C panel: Simple routines for us with bad memory" org-panel)
(const :tag "C registry: A registry for Org-mode links" org-registry)
(const :tag "C org2rem: Convert org appointments into reminders" org2rem)
@@ -354,12 +387,12 @@ to add the symbol `xyz', and the package must have a call to
(defcustom org-support-shift-select nil
"Non-nil means make shift-cursor commands select text when possible.
-In Emacs 23, when `shift-select-mode' is on, shifted cursor keys start
-selecting a region, or enlarge regions started in this way.
-In Org-mode, in special contexts, these same keys are used for other
-purposes, important enough to compete with shift selection. Org tries
-to balance these needs by supporting `shift-select-mode' outside these
-special contexts, under control of this variable.
+In Emacs 23, when `shift-select-mode' is on, shifted cursor keys
+start selecting a region, or enlarge regions started in this way.
+In Org-mode, in special contexts, these same keys are used for
+other purposes, important enough to compete with shift selection.
+Org tries to balance these needs by supporting `shift-select-mode'
+outside these special contexts, under control of this variable.
The default of this variable is nil, to avoid confusing behavior. Shifted
cursor keys will then execute Org commands in the following contexts:
@@ -370,30 +403,57 @@ cursor keys will then execute Org commands in the following contexts:
- in the BEGIN line of a clock table (changing the time block).
Outside these contexts, the commands will throw an error.
-When this variable is t and the cursor is not in a special context,
-Org-mode will support shift-selection for making and enlarging regions.
-To make this more effective, the bullet cycling will no longer happen
-anywhere in an item line, but only if the cursor is exactly on the bullet.
+When this variable is t and the cursor is not in a special
+context, Org-mode will support shift-selection for making and
+enlarging regions. To make this more effective, the bullet
+cycling will no longer happen anywhere in an item line, but only
+if the cursor is exactly on the bullet.
If you set this variable to the symbol `always', then the keys
-will not be special in headlines, property lines, and item lines, to make
-shift selection work there as well. If this is what you want, you can
-use the following alternative commands: `C-c C-t' and `C-c ,' to
-change TODO state and priority, `C-u C-u C-c C-t' can be used to switch
-TODO sets, `C-c -' to cycle item bullet types, and properties can be
-edited by hand or in column view.
+will not be special in headlines, property lines, and item lines,
+to make shift selection work there as well. If this is what you
+want, you can use the following alternative commands: `C-c C-t'
+and `C-c ,' to change TODO state and priority, `C-u C-u C-c C-t'
+can be used to switch TODO sets, `C-c -' to cycle item bullet
+types, and properties can be edited by hand or in column view.
However, when the cursor is on a timestamp, shift-cursor commands
will still edit the time stamp - this is just too good to give up.
-XEmacs user should have this variable set to nil, because shift-select-mode
-is Emacs 23 only."
+XEmacs user should have this variable set to nil, because
+`shift-select-mode' is in Emacs 23 or later only."
:group 'org
:type '(choice
(const :tag "Never" nil)
(const :tag "When outside special context" t)
(const :tag "Everywhere except timestamps" always)))
+(defcustom org-loop-over-headlines-in-active-region nil
+ "Shall some commands act upon headlines in the active region?
+
+When set to `t', some commands will be performed in all headlines
+within the active region.
+
+When set to `start-level', some commands will be performed in all
+headlines within the active region, provided that these headlines
+are of the same level than the first one.
+
+When set to a string, those commands will be performed on the
+matching headlines within the active region. Such string must be
+a tags/property/todo match as it is used in the agenda tags view.
+
+The list of commands is: `org-schedule', `org-deadline',
+`org-todo', `org-archive-subtree', `org-archive-set-tag' and
+`org-archive-to-archive-sibling'. The archiving commands skip
+already archived entries."
+ :type '(choice (const :tag "Don't loop" nil)
+ (const :tag "All headlines in active region" t)
+ (const :tag "In active region, headlines at the same level than the first one" 'start-level)
+ (string :tag "Tags/Property/Todo matcher"))
+ :version "24.1"
+ :group 'org-todo
+ :group 'org-archive)
+
(defgroup org-startup nil
"Options concerning startup of Org-mode."
:tag "Org Startup"
@@ -456,9 +516,10 @@ 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"
:type '(choice
(const :tag "Always interpret" t)
(const :tag "Only with braces" {})
@@ -475,6 +536,7 @@ the following lines anywhere in the buffer:
#+STARTUP: beamer"
:group 'org-startup
+ :version "24.1"
:type 'boolean)
(defcustom org-startup-align-all-tables nil
@@ -495,6 +557,7 @@ the following lines anywhere in the buffer:
#+STARTUP: inlineimages
#+STARTUP: noinlineimages"
:group 'org-startup
+ :version "24.1"
:type 'boolean)
(defcustom org-insert-mode-line-in-empty-file nil
@@ -629,6 +692,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
@@ -647,7 +717,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.")
@@ -771,7 +841,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.
@@ -782,15 +852,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."
@@ -817,7 +887,7 @@ than its value."
(const :tag "No limit" nil)
(integer :tag "Maximum level")))
-(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK")
+(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK" "RESULTS")
"Names of drawers. Drawers are not opened by cycling on the headline above.
Drawers only open with a TAB on the drawer line itself. A drawer looks like
this:
@@ -847,13 +917,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)
@@ -925,7 +993,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)
@@ -979,23 +1047,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)
@@ -1032,11 +1102,35 @@ used to kill (part-of) a headline that has hidden text behind it.
Any other non-nil value will result in a query to the user, if it is
OK to kill that hidden subtree. When nil, kill without remorse."
:group 'org-edit-structure
+ :version "24.1"
:type '(choice
(const :tag "Do not protect hidden subtrees" nil)
(const :tag "Protect hidden subtrees with a security query" t)
(const :tag "Never kill a hidden subtree with C-k" error)))
+(defcustom org-catch-invisible-edits nil
+ "Check if in invisible region before inserting or deleting a character.
+Valid values are:
+
+nil Do not check, so just do invisible edits.
+error Throw an error and do nothing.
+show Make point visible, and do the requested edit.
+show-and-error Make point visible, then throw an error and abort the edit.
+smart Make point visible, and do insertion/deletion if it is
+ adjacent to visible text and the change feels predictable.
+ Never delete a previously invisible character or add in the
+ middle or right after an invisible region. Basically, this
+ allows insertion and backward-delete right before ellipses.
+ FIXME: maybe in this case we should not even show?"
+ :group 'org-edit-structure
+ :version "24.1"
+ :type '(choice
+ (const :tag "Do not check" nil)
+ (const :tag "Throw error when trying to edit" error)
+ (const :tag "Unhide, but do not do the edit" show-and-error)
+ (const :tag "Show invisible part and do the edit" show)
+ (const :tag "Be smart and do the right thing" smart)))
+
(defcustom org-yank-folded-subtrees t
"Non-nil means when yanking subtrees, fold them.
If the kill is a single subtree, or a sequence of subtrees, i.e. if
@@ -1206,7 +1300,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.
@@ -1243,9 +1338,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.
@@ -1260,10 +1358,14 @@ See the manual for examples."
(function)))))
(defcustom org-descriptive-links t
- "Non-nil means hide link part and only show description of bracket links.
-Bracket links are like [[link][description]]. This variable sets the initial
-state in new org-mode buffers. The setting can then be toggled on a
-per-buffer basis from the Org->Hyperlinks menu."
+ "Non-nil means Org will display descriptive links.
+E.g. [[http://orgmode.org][Org website]] will be displayed as
+\"Org Website\", hiding the link itself and just displaying its
+description. When set to `nil', Org will display the full links
+literally.
+
+You can interactively set the value of this variable by calling
+`org-toggle-link-display' or from the menu Org>Hyperlinks menu."
:group 'org-link
:type 'boolean)
@@ -1311,11 +1413,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)
@@ -1324,6 +1426,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:
@@ -1357,52 +1465,12 @@ 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
used to find the context when the link is activated by the command
-`org-open-at-point'. When this option is t, the entire active region
-will be placed in the search string of the file link. If set to a
+`org-open-at-point'. When this option is t, the entire active region
+will be placed in the search string of the file link. If set to a
positive integer, only the first n lines of context will be stored.
Using a prefix arg to the command \\[org-store-link] (`org-store-link')
@@ -1479,6 +1547,7 @@ Changing this requires a restart of Emacs to work correctly."
When nil, the link search tries to match a phrase with all words
in the search text."
:group 'org-link-follow
+ :version "24.1"
:type '(choice
(const :tag "Use fuzzy text search" nil)
(const :tag "Match only exact headline" t)
@@ -1487,6 +1556,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))
@@ -1598,6 +1668,7 @@ single keystroke rather than having to type \"yes\"."
(defcustom org-confirm-shell-link-not-regexp ""
"A regexp to skip confirmation for shell links."
:group 'org-link-follow
+ :version "24.1"
:type 'regexp)
(defcustom org-confirm-elisp-link-function 'yes-or-no-p
@@ -1623,6 +1694,7 @@ single keystroke rather than having to type \"yes\"."
(defcustom org-confirm-elisp-link-not-regexp ""
"A regexp to skip confirmation for Elisp links."
:group 'org-link-follow
+ :version "24.1"
:type 'regexp)
(defconst org-file-apps-defaults-gnu
@@ -1758,7 +1830,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."
@@ -1771,14 +1847,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")
@@ -1787,6 +1864,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))
@@ -1816,6 +1894,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)
@@ -1845,6 +1924,7 @@ When bulk-refiling from the agenda, the value `note' is forbidden and
will temporarily be changed to `time'."
:group 'org-refile
:group 'org-progress
+ :version "24.1"
:type '(choice
(const :tag "No logging" nil)
(const :tag "Record timestamp" time)
@@ -1852,7 +1932,7 @@ will temporarily be changed to `time'."
(defcustom org-refile-targets nil
"Targets for refiling entries with \\[org-refile].
-This is list of cons cells. Each cell contains:
+This is a list of cons cells. Each cell contains:
- a specification of the files to be considered, either a list of files,
or a symbol whose function or variable value will be used to retrieve
a file name or a list of file names. If you use `org-agenda-files' for
@@ -1870,10 +1950,14 @@ This is list of cons cells. Each cell contains:
- a cons cell (:level . N). Any headline of level N is considered a target.
Note that, when `org-odd-levels-only' is set, level corresponds to
order in hierarchy, not to the number of stars.
- - a cons cell (:maxlevel . N). Any headline with level <= N is a target.
+ - a cons cell (:maxlevel . N). Any headline with level <= N is a target.
Note that, when `org-odd-levels-only' is set, level corresponds to
order in hierarchy, not to the number of stars.
+Each element of this list generates a set of possible targets.
+The union of these sets is presented (with completion) to
+the user by `org-refile'.
+
You can set the variable `org-refile-target-verify-function' to a function
to verify each headline found by the simple criteria above.
@@ -1887,11 +1971,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.
@@ -1916,6 +2000,7 @@ If you have added new entries to a buffer that might themselves be targets,
you need to clear the cache manually by pressing `C-0 C-c C-w' or, if you
find that easier, `C-u C-u C-u C-c C-w'."
:group 'org-refile
+ :version "24.1"
:type 'boolean)
(defcustom org-refile-use-outline-path nil
@@ -1963,6 +2048,17 @@ heading."
(const :tag "Always" t)
(const :tag "Prompt for confirmation" confirm)))
+(defcustom org-refile-active-region-within-subtree nil
+ "Non-nil means also refile active region within a subtree.
+
+By default `org-refile' doesn't allow refiling regions if they
+don't contain a set of subtrees, but it might be convenient to
+do so sometimes: in that case, the first line of the region is
+converted to a headline before refiling."
+ :group 'org-refile
+ :version "24.1"
+ :type 'boolean)
+
(defgroup org-todo nil
"Options concerning TODO items in Org-mode."
:tag "Org TODO"
@@ -2001,9 +2097,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
@@ -2017,7 +2113,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
@@ -2088,16 +2184,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)
@@ -2133,7 +2229,7 @@ property and include the word \"recursive\" into the value."
(defcustom org-after-todo-state-change-hook nil
"Hook which is run after the state of a TODO item was changed.
The new state (a string with a TODO keyword, or nil) is available in the
-Lisp variable `state'."
+Lisp variable `org-state'."
:group 'org-todo
:type 'hook)
@@ -2171,10 +2267,7 @@ TODO state changes
Also, if a parent has an :ORDERED: property, switching an entry to DONE will
be blocked if any prior sibling is not yet done.
Finally, if the parent is blocked because of ordered siblings of its own,
-the child will also be blocked.
-This variable needs to be set before org.el is loaded, and you need to
-restart Emacs after a change to make the change effective. The only way
-to change is while Emacs is running is through the customize interface."
+the child will also be blocked."
:set (lambda (var val)
(set var val)
(if val
@@ -2232,9 +2325,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")
@@ -2348,6 +2441,8 @@ context, and the cdr is the heading to be used. The heading may also be the
empty string.
%t in the heading will be replaced by a time stamp.
%T will be an active time stamp instead the default inactive one
+%d will be replaced by a short-format time stamp.
+%D will be replaced by an active short-format time stamp.
%s will be replaced by the new TODO state, in double quotes.
%S will be replaced by the old TODO state, in double quotes.
%u will be replaced by the user name.
@@ -2358,17 +2453,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))
@@ -2435,6 +2530,7 @@ By default this is the first task in a TODO sequence, or the previous state
in a TODO_TYP set. But you can specify another task here.
alternatively, set the :REPEAT_TO_STATE: property of the entry."
:group 'org-todo
+ :version "24.1"
:type '(choice (const :tag "Head of sequence" nil)
(string :tag "Specific state")))
@@ -2444,17 +2540,17 @@ An auto-repeating task is immediately switched back to TODO when
marked DONE. If you are not logging state changes (by adding \"@\"
or \"!\" to the TODO keyword definition), or set `org-log-done' to
record a closing note, there will be no record of the task moving
-through DONE. This variable forces taking a note anyway.
+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."
@@ -2519,6 +2615,7 @@ an integer, increasing by 1000 for each priority level.
The user can set a different function here, which should take a string
as an argument and return the numeric priority."
:group 'org-priorities
+ :version "24.1"
:type 'function)
(defgroup org-time nil
@@ -2554,9 +2651,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")))
@@ -2638,8 +2735,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.
@@ -2660,6 +2757,7 @@ But you can also set a deviating value here.
This may t or nil, or the symbol `org-read-date-prefer-future'."
:group 'org-agenda
:group 'org-time
+ :version "24.1"
:type '(choice
(const :tag "Use org-read-date-prefer-future"
org-read-date-prefer-future)
@@ -2681,7 +2779,7 @@ When this variable is set to t, the date/time prompt will not let
you specify dates outside the 1970-2037 range, so it is certain that
these dates will work in whatever version of Emacs you are
running, and also that you can move a file from one Emacs implementation
-to another. Whenever Org is forcing the year for you, it will display
+to another. WHenever Org is forcing the year for you, it will display
a message and beep.
When this variable is nil, Org will check if the date is
@@ -2694,6 +2792,7 @@ has limited date range is not negligible.
A workaround for this problem is to use diary sexp dates for time
stamps outside of this range."
:group 'org-time
+ :version "24.1"
:type 'boolean)
(defcustom org-read-date-display-live t
@@ -2727,7 +2826,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
@@ -2735,6 +2834,15 @@ be the favorite working time of John Wiegley :-)"
:group 'org-time
:type 'integer)
+(defcustom org-use-effective-time nil
+ "If non-nil, consider `org-extend-today-until' when creating timestamps.
+For example, if `org-extend-today-until' is 8, and it's 4am, then the
+\"effective time\" of any timestamps between midnight and 8am will be
+23:59 of the previous day."
+ :group 'org-time
+ :version "24.1"
+ :type 'boolean)
+
(defcustom org-edit-timestamp-down-means-later nil
"Non-nil means S-down will increase the time in a time stamp.
When nil, S-up will increase."
@@ -2806,6 +2914,7 @@ tags in that file can be created dynamically (there are none).
'org-complete-tags-always-offer-all-agenda-tags)
t)))"
:group 'org-tags
+ :version "24.1"
:type 'boolean)
(defvar org-file-tags nil
@@ -2849,7 +2958,9 @@ This is an undocumented feature, you should not rely on it.")
"The column to which tags should be indented in a headline.
If this number is positive, it specifies the column. If it is negative,
it means that the tags should be flushright to that column. For example,
--80 works well for a normal 80 character screen."
+-80 works well for a normal 80 character screen.
+When 0, place tags directly after headline text, with only one space in
+between."
:group 'org-tags
:type 'integer)
@@ -2924,7 +3035,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)
@@ -2952,6 +3063,30 @@ lined-up with respect to each other."
:group 'org-properties
:type 'string)
+(defcustom org-properties-postprocess-alist nil
+ "Alist of properties and functions to adjust inserted values.
+Elements of this alist must be of the form
+
+ ([string] [function])
+
+where [string] must be a property name and [function] must be a
+lambda expression: this lambda expression must take one argument,
+the value to adjust, and return the new value as a string.
+
+For example, this element will allow the property \"Remaining\"
+to be updated wrt the relation between the \"Effort\" property
+and the clock summary:
+
+ ((\"Remaining\" (lambda(value)
+ (let ((clocksum (org-clock-sum-current-item))
+ (effort (org-duration-string-to-minutes
+ (org-entry-get (point) \"Effort\"))))
+ (org-minutes-to-hh:mm-string (- effort clocksum))))))"
+ :group 'org-properties
+ :version "24.1"
+ :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.
@@ -3126,8 +3261,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
@@ -3147,13 +3282,6 @@ forth between agenda and calendar."
:group 'org-agenda
:type 'sexp)
-(defcustom org-calendar-agenda-action-key [?k]
- "The key to be installed in `calendar-mode-map' for agenda-action.
-The command `org-agenda-action' will be bound to this key. The
-default is the character `k' because we use the same key in the agenda."
- :group 'org-agenda
- :type 'sexp)
-
(defcustom org-calendar-insert-diary-entry-key [?i]
"The key to be installed in `calendar-mode-map' for adding diary entries.
This option is irrelevant until `org-agenda-diary-file' has been configured
@@ -3179,8 +3307,6 @@ points to a file, `org-agenda-diary-entry' will be used instead."
'(progn
(org-defkey calendar-mode-map org-calendar-to-agenda-key
'org-calendar-goto-agenda)
- (org-defkey calendar-mode-map org-calendar-agenda-action-key
- 'org-agenda-action)
(add-hook 'calendar-mode-hook
(lambda ()
(unless (eq org-agenda-diary-file 'diary-file)
@@ -3195,8 +3321,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\".
@@ -3221,8 +3347,74 @@ This is a property list with the following properties:
"Non-nil means signal an error when image creation of LaTeX snippets fails.
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.
+
+When using MathToWeb as the converter, specify the full-path to
+your mathtoweb.jar file."
+ :group 'org-latex
+ :version "24.1"
+ :type '(choice
+ (const :tag "None" nil)
+ (file :tag "JAR file" :must-match t)))
+
+(defcustom org-latex-to-mathml-convert-command nil
+ "Command to convert LaTeX fragments to MathML.
+Replace format-specifiers in the command as noted below and use
+`shell-command' to convert LaTeX to MathML.
+%j: Executable file in fully expanded form as specified by
+ `org-latex-to-mathml-jar-file'.
+%I: Input LaTeX file in fully expanded form
+%o: Output MathML file
+This command is used by `org-create-math-formula'.
+
+When using MathToWeb as the converter, set this to
+\"java -jar %j -unicode -force -df %o %I\"."
+ :group 'org-latex
+ :version "24.1"
+ :type '(choice
+ (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
+ (when (and (boundp 'org-latex-to-mathml-convert-command)
+ org-latex-to-mathml-convert-command)
+ (let ((executable (car (split-string
+ org-latex-to-mathml-convert-command))))
+ (when (executable-find executable)
+ (if (string-match
+ "%j" org-latex-to-mathml-convert-command)
+ (file-readable-p org-latex-to-mathml-jar-file)
+ t))))))
+
(defcustom org-format-latex-header "\\documentclass{article}
\\usepackage[usenames]{color}
\\usepackage{amsmath}
@@ -3315,6 +3507,7 @@ compiling LaTeX snippets into images for inclusion into HTML."
:group 'org-export-latex
:set 'org-set-packages-alist
:get 'org-get-packages-alist
+ :version "24.1"
:type '(repeat
(choice
(list :tag "options/package pair"
@@ -3380,11 +3573,21 @@ lines to the buffer:
For example, a value '(title) for this list will make the document's title
appear in the buffer without the initial #+TITLE: keyword."
:group 'org-appearance
+ :version "24.1"
:type '(set (const :tag "#+AUTHOR" author)
(const :tag "#+DATE" date)
(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.
@@ -3420,18 +3623,20 @@ org-level-* faces."
"Non-nil means show entities as UTF8 characters.
When nil, the \\name form remains in the buffer."
:group 'org-appearance
+ :version "24.1"
:type 'boolean)
(defcustom org-pretty-entities-include-sub-superscripts t
"Non-nil means, pretty entity display includes formatting sub/superscripts."
:group 'org-appearance
+ :version "24.1"
:type 'boolean)
(defvar org-emph-re nil
"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
@@ -3609,6 +3814,7 @@ Normal means, no org-mode-specific context."
(defvar calc-embedded-close-formula)
(defvar calc-embedded-open-formula)
(declare-function cdlatex-tab "ext:cdlatex" ())
+(declare-function cdlatex-compute-tables "ext:cdlatex" ())
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(defvar font-lock-unfontify-region-function)
(declare-function iswitchb-read-buffer "iswitchb"
@@ -3618,7 +3824,7 @@ Normal means, no org-mode-specific context."
(defvar org-agenda-tags-todo-honor-ignore-options)
(declare-function org-agenda-skip "org-agenda" ())
(declare-function
- org-format-agenda-item "org-agenda"
+ org-agenda-format-item "org-agenda"
(extra txt &optional category tags dotime noprefix remove-re habitp))
(declare-function org-agenda-new-marker "org-agenda" (&optional pos))
(declare-function org-agenda-change-all-lines "org-agenda"
@@ -3672,30 +3878,13 @@ 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-begin org-table-blank-field org-table-end)))
+
+;;;###autoload
+(defun turn-on-orgtbl ()
+ "Unconditionally turn on `orgtbl-mode'."
+ (require 'org-table)
+ (orgtbl-mode 1))
(defun org-at-table-p (&optional table-type)
"Return t if the cursor is inside an org-type table.
@@ -3760,7 +3949,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)))
@@ -3772,62 +3963,14 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(declare-function org-default-export-plist "org-exp")
(declare-function org-infile-export-plist "org-exp")
(declare-function org-get-current-options "org-exp")
-(eval-and-compile
- (org-autoload "org-exp"
- '(org-export org-export-visible
- org-insert-export-options-template
- 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-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-autoload "org-html"
- '(org-export-as-html-and-open
- org-export-as-html-batch org-export-as-html-to-buffer
- org-replace-region-by-html org-export-region-as-html
- 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-autoload "org-icalendar"
- '(org-export-icalendar-this-file
- org-export-icalendar-all-agenda-files
- org-export-icalendar-combine-agenda-files))
- (org-autoload "org-xoxo" '(org-export-as-xoxo))
- (org-autoload "org-beamer" '(org-beamer-mode org-beamer-sectioning)))
;; Declare and autoload functions from org-agenda.el
(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)))
-
-;; 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-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))
-(eval-and-compile
- (org-autoload "org-capture"
- '(org-capture org-capture-insert-template-here
- org-capture-import-remember-templates)))
-
-;; Autoload org-clock.el
-
-(declare-function org-clock-save-markers-for-cut-and-paste "org-clock"
- (beg end))
+(declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end))
(declare-function org-clock-update-mode-line "org-clock" ())
(declare-function org-resolve-clocks "org-clock"
(&optional also-non-dangling-p prompt last-valid))
@@ -3839,60 +3982,14 @@ 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
- "org-clock"
- '(org-clock-in org-clock-out org-clock-cancel
- org-clock-goto org-clock-sum org-clock-display
- org-clock-remove-overlays org-clock-report
- org-clocktable-shift org-dblock-write:clocktable
- org-get-clocktable org-resolve-clocks)))
-
-(defun org-clock-update-time-maybe ()
- "If this is a CLOCK line, update it and return t.
-Otherwise, return nil."
- (interactive)
- (save-excursion
- (beginning-of-line 1)
- (skip-chars-forward " \t")
- (when (looking-at org-clock-string)
- (let ((re (concat "[ \t]*" org-clock-string
- " *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]"
- "\\([ \t]*=>.*\\)?\\)?"))
- ts te h m s neg)
- (cond
- ((not (looking-at re))
- nil)
- ((not (match-end 2))
- (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
- (> org-clock-marker (point))
- (<= org-clock-marker (point-at-eol)))
- ;; The clock is running here
- (setq org-clock-start-time
- (apply 'encode-time
- (org-parse-time-string (match-string 1))))
- (org-clock-update-mode-line)))
- (t
- (and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
- (end-of-line 1)
- (setq ts (match-string 1)
- te (match-string 3))
- (setq s (- (org-float-time
- (apply 'encode-time (org-parse-time-string te)))
- (org-float-time
- (apply 'encode-time (org-parse-time-string ts))))
- neg (< s 0)
- s (abs s)
- h (floor (/ s 3600))
- s (- s (* 3600 h))
- m (floor (/ s 60))
- s (- s (* 60 s)))
- (insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m))
- t))))))
+ (org-autoload "org-clock" '(org-clock-remove-overlays
+ org-clock-update-time-maybe
+ org-clocktable-shift)))
(defun org-check-running-clock ()
"Check if the current buffer contains the running clock.
@@ -3909,44 +4006,18 @@ If yes, offer to stop it and to save the buffer with the changes."
(when (org-match-line "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>")
(org-clocktable-shift dir n)))
-;; Autoload org-timer.el
-
-(eval-and-compile
- (org-autoload
- "org-timer"
- '(org-timer-start org-timer org-timer-item
- org-timer-change-times-in-region
- org-timer-set-timer
- org-timer-reset-timers
- org-timer-show-remaining-time)))
-
-;; Autoload org-feed.el
-
-(eval-and-compile
- (org-autoload
- "org-feed"
- '(org-feed-update org-feed-update-all org-feed-goto-inbox)))
-
-
-;; Autoload org-indent.el
+;;;###autoload
+(defun org-clock-persistence-insinuate ()
+ "Set up hooks for clock persistence."
+ (require 'org-clock)
+ (add-hook 'org-mode-hook 'org-clock-load)
+ (add-hook 'kill-emacs-hook 'org-clock-save))
;; Define the variable already here, to make sure we have it.
(defvar org-indent-mode nil
"Non-nil if Org-Indent mode is enabled.
Use the command `org-indent-mode' to change this variable.")
-(eval-and-compile
- (org-autoload
- "org-indent"
- '(org-indent-mode)))
-
-;; Autoload org-mobile.el
-
-(eval-and-compile
- (org-autoload
- "org-mobile"
- '(org-mobile-push org-mobile-pull org-mobile-create-sumo-agenda)))
-
;; Autoload archiving code
;; The stuff that is needed for cycling and tags has to be defined here.
@@ -3986,10 +4057,19 @@ Here are a few examples:
\"~/org/archive.org::\"
Archive in file ~/org/archive.org (absolute path), as top-level trees.
-\"~/org/archive.org::From %s\"
+\"~/org/archive.org::* From %s\"
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\".
@@ -4047,6 +4127,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)
@@ -4074,10 +4173,12 @@ collapsed state."
(let* ((re (concat ":" org-archive-tag ":")))
(goto-char beg)
(while (re-search-forward re end t)
- (when (org-on-heading-p)
+ (when (org-at-heading-p)
(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)
@@ -4090,21 +4191,19 @@ 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)))
;; 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-columns-remove-overlays))
;; Autoload ID code
@@ -4113,19 +4212,14 @@ 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))
-
-;; Autoload Plotting Code
-
-(org-autoload "org-plot"
- '(org-plot/gnuplot))
+ '(org-id-new
+ org-id-copy
+ org-id-get-with-outline-path-completion
+ org-id-get-with-outline-drilling))
;;; 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
@@ -4150,22 +4244,16 @@ group 5: Tags")
(make-variable-buffer-local 'org-complex-heading-regexp)
(defvar org-complex-heading-regexp-format nil
"Printf format to make regexp to match an exact headline.
-This regexp will match the headline of any node which hase the exact
-headline text that is put into the format, but may have any TODO state,
-priority and tags.")
+This regexp will match the headline of any node which has the
+exact headline text that is put into the format, but may have any
+TODO state, priority and tags.")
(make-variable-buffer-local 'org-complex-heading-regexp-format)
(defvar org-todo-line-tags-regexp nil
"Matches a headline and puts TODO state into group 2 if present.
Also put tags into group 4 if tags are present.")
(make-variable-buffer-local 'org-todo-line-tags-regexp)
-(defvar org-nl-done-regexp nil
- "Matches newline followed by a headline with the DONE keyword.")
-(make-variable-buffer-local 'org-nl-done-regexp)
-(defvar org-looking-at-done-regexp nil
- "Matches the DONE keyword a point.")
-(make-variable-buffer-local 'org-looking-at-done-regexp)
(defvar org-ds-keyword-length 12
- "Maximum length of the Deadline and SCHEDULED keywords.")
+ "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.")
@@ -4195,9 +4283,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)
@@ -4295,14 +4380,40 @@ 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)
+ "Update PROPS with KEY and VAL."
+ (let* ((appending (string= "+" (substring key (- (length key) 1))))
+ (key (if appending (substring key 0 (- (length key) 1)) key))
+ (remainder (org-remove-if (lambda (p) (string= (car p) key)) props))
+ (previous (cdr (assoc key props))))
+ (if appending
+ (cons (cons key (if previous (concat previous " " val) val)) remainder)
+ (cons (cons key val) remainder))))
+
+(defconst org-block-regexp
+ "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$"
+ "Regular expression for hiding blocks.")
+(defconst org-heading-keyword-regexp-format
+ "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
+ "Printf format for a regexp matching an headline with some keyword.
+This regexp will match the headline of any node which has the
+exact keyword that is put into the format. The keyword isn't in
+any group by default, but the stars and the body are.")
+(defconst org-heading-keyword-maybe-regexp-format
+ "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$"
+ "Printf format for a regexp matching an headline, possibly with some keyword.
+This regexp can match any headline with the specified keyword, or
+without a keyword. The keyword isn't in any group by default,
+but the stars and the body are.")
+
(defun org-set-regexps-and-options ()
"Precompute regular expressions for current buffer."
- (when (org-mode-p)
+ (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)
@@ -4361,8 +4472,9 @@ means to push this value onto the list in the variable.")
(setq prio (org-split-string value " +")))
((equal key "PROPERTY")
(when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
- (push (cons (match-string 1 value) (match-string 2 value))
- props)))
+ (setq props (org-update-property-plist (match-string 1 value)
+ (match-string 2 value)
+ props))))
((equal key "FILETAGS")
(when (string-match "\\S-" value)
(setq ftags
@@ -4372,7 +4484,7 @@ means to push this value onto the list in the variable.")
(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")
@@ -4406,8 +4518,17 @@ means to push this value onto the list in the variable.")
(setq ext-setup-or-nil
(concat (substring ext-setup-or-nil 0 start)
"\n" setup-contents "\n"
- (substring ext-setup-or-nil start)))))
- ))))
+ (substring ext-setup-or-nil start)))))))
+ ;; search for property blocks
+ (goto-char (point-min))
+ (while (re-search-forward org-block-regexp nil t)
+ (when (equal "PROPERTY" (upcase (match-string 1)))
+ (setq value (replace-regexp-in-string
+ "[\n\r]" " " (match-string 4)))
+ (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
+ (setq props (org-update-property-plist (match-string 1 value)
+ (match-string 2 value)
+ props)))))))
(org-set-local 'org-use-sub-superscripts scripts)
(when cat
(org-set-local 'org-category (intern cat))
@@ -4498,7 +4619,9 @@ means to push this value onto the list in the variable.")
(assoc (car e) org-tag-alist))
(push e org-tag-alist)))))
- ;; Compute the regular expressions and other local variables
+ ;; Compute the regular expressions and other local variables.
+ ;; Using `org-outline-regexp-bol' would complicate them much,
+ ;; because of the fixed white space at the end of that string.
(if (not org-done-keywords)
(setq org-done-keywords (and org-todo-keywords-1
(list (org-last org-todo-keywords-1)))))
@@ -4513,47 +4636,42 @@ means to push this value onto the list in the variable.")
org-not-done-keywords
(org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1))
org-todo-regexp
- (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1
- "\\|") "\\)\\>")
+ (concat "\\("
+ (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
+ "\\)")
org-not-done-regexp
- (concat "\\<\\("
+ (concat "\\("
(mapconcat 'regexp-quote org-not-done-keywords "\\|")
- "\\)\\>")
+ "\\)")
org-not-done-heading-regexp
- (concat "^\\(\\*+\\)[ \t]+\\("
- (mapconcat 'regexp-quote org-not-done-keywords "\\|")
- "\\)\\>")
+ (format org-heading-keyword-regexp-format org-not-done-regexp)
org-todo-line-regexp
- (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
- (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
- "\\)\\>\\)?[ \t]*\\(.*\\)")
+ (format org-heading-keyword-maybe-regexp-format org-todo-regexp)
org-complex-heading-regexp
- (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
- (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
- "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)"
- "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$")
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(\\[#.\\]\\)\\)?"
+ "\\(?: +\\(.*?\\)\\)??"
+ (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?")
+ "[ \t]*$")
org-complex-heading-regexp-format
- (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
- (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
- "\\)\\>\\)?"
- "\\(?:[ \t]*\\(\\[#.\\]\\)\\)?"
- "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie
- "[ \t]*\\(%s\\)"
- "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie
- "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?[ \t]*$")
- org-nl-done-regexp
- (concat "\n\\*+[ \t]+"
- "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|")
- "\\)" "\\>")
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(\\[#.\\]\\)\\)?"
+ "\\(?: +"
+ ;; Stats cookies can be stuck to body.
+ "\\(?:\\[[0-9%%/]+\\] *\\)?"
+ "\\(%s\\)"
+ "\\(?: *\\[[0-9%%/]+\\]\\)?"
+ "\\)"
+ (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?")
+ "[ \t]*$")
org-todo-line-tags-regexp
- (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
- (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
- (org-re
- "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@#%]+:[ \t]*\\)?$\\)"))
- org-looking-at-done-regexp
- (concat "^" "\\(?:"
- (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)"
- "\\>")
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(.*?\\)\\)??"
+ (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?")
+ "[ \t]*$")
org-deadline-regexp (concat "\\<" org-deadline-string)
org-deadline-time-regexp
(concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
@@ -4582,12 +4700,7 @@ means to push this value onto the list in the variable.")
"\\|" org-deadline-string
"\\|" 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
- "\\)\\>\\)")
+ " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)")
org-all-time-keywords
(mapcar (lambda (w) (substring w 0 -1))
(list org-scheduled-string org-deadline-string
@@ -4660,14 +4773,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)
-(defvar last-state)
-(defvar date)
+(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
+(defvar org-last-state)
+(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
@@ -4677,10 +4790,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
@@ -4698,10 +4807,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
-(defvar org-outline-regexp "\\*+ ")
-(defconst org-outline-regexp-bol "^\\*+ ")
+(defvar bidi-paragraph-direction)
+(defvar buffer-face-mode-face)
+
+(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
+
+;; 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"
@@ -4758,7 +4894,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)
@@ -4777,13 +4913,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
@@ -4799,10 +4940,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
@@ -4824,7 +4961,7 @@ The following commands are available:
(lambda (&rest ignore) (org-show-context 'isearch))))
;; Turn on org-beamer-mode?
- (and org-startup-with-beamer-mode (org-beamer-mode 1))
+ (and org-startup-with-beamer-mode (org-beamer-mode))
;; Setup the pcomplete hooks
(set (make-local-variable 'pcomplete-command-completion-function)
@@ -4836,8 +4973,8 @@ The following commands are available:
(set (make-local-variable 'pcomplete-parse-arguments-function)
'org-parse-arguments)
(set (make-local-variable 'pcomplete-termination-string) "")
- (set (make-local-variable 'face-remapping-alist)
- '((default org-default)))
+ (when (>= emacs-major-version 23)
+ (set (make-local-variable 'buffer-face-mode-face) 'org-default))
;; If empty file that did not turn on org-mode automatically, make it to.
(if (and org-insert-mode-line-in-empty-file
@@ -4855,7 +4992,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
@@ -4863,6 +5002,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)
@@ -4894,19 +5046,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
@@ -4948,7 +5100,7 @@ stacked delimiters is N. Escaping delimiters is not possible."
(defvar org-match-substring-regexp
(concat
- "\\([^\\]\\)\\([_^]\\)\\("
+ "\\([^\\]\\|^\\)\\([_^]\\)\\("
"\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
"\\|"
"\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
@@ -4958,7 +5110,7 @@ stacked delimiters is N. Escaping delimiters is not possible."
(defvar org-match-substring-with-braces-regexp
(concat
- "\\([^\\]\\)\\([_^]\\)\\("
+ "\\([^\\]\\|^\\)\\([_^]\\)\\("
"\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
"\\)")
"The regular expression matching a sub- or superscript, forcing braces.")
@@ -5022,15 +5174,16 @@ This should be called after the variable `org-link-types' has changed."
(org-make-link-regexps)
-(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)>"
+(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>"
"Regular expression for fast time stamp matching.")
-(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?\\)[]>]"
+(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]\\{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.")
-(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) +\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
+(defconst org-ts-regexp1 "\\(\\([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.")
(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>")
"Regular expression matching time stamps, with groups.")
@@ -5139,22 +5292,21 @@ 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)
+ (if (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
(progn
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(remove-text-properties (match-beginning 0) (match-end 0)
@@ -5164,9 +5316,18 @@ will be prompted for."
(defcustom org-src-fontify-natively nil
"When non-nil, fontify code in code blocks."
:type 'boolean
+ :version "24.1"
: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)
@@ -5176,7 +5337,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))
@@ -5187,7 +5348,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)
@@ -5198,14 +5359,15 @@ 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))
(when (re-search-forward
(concat "^[ \t]*#\\+end" (match-string 4) "\\>.*")
nil t) ;; on purpose, we look further than LIMIT
- (setq end (match-end 0) end1 (1- (match-beginning 0)))
+ (setq end (min (point-max) (match-end 0))
+ end1 (min (point-max) (1- (match-beginning 0))))
(setq block-end (match-beginning 0))
(when quoting
(remove-text-properties beg end
@@ -5233,13 +5395,14 @@ will be prompted for."
'(face org-block))) ; end of source block
((not org-fontify-quote-and-verse-blocks))
((string= block-type "quote")
- (add-text-properties beg1 (1+ end1) '(face org-quote)))
+ (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote)))
((string= block-type "verse")
- (add-text-properties beg1 (1+ end1) '(face org-verse))))
+ (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse))))
(add-text-properties beg beg1 '(face org-block-begin-line))
- (add-text-properties (1+ end) (1+ end1) '(face org-block-end-line))
+ (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)
@@ -5247,20 +5410,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 (1+ (match-end 0))
- '(font-lock-fontified t face org-meta-line))
- t)
- ((or (member dc1 '("begin:" "end:" "caption:" "label:"
- "orgtbl:" "tblfm:" "tblname:" "result:"
- "results:" "source:" "srcname:" "call:"
- "data:" "header:" "headers:"))
- (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))
@@ -5269,6 +5426,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-activate-angle-links (limit)
@@ -5428,8 +5591,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)))
@@ -5450,7 +5612,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)))
@@ -5541,7 +5703,7 @@ Use `org-reduced-level' to remove the effect of `org-odd-levels'."
(defvar org-font-lock-keywords nil)
-(defconst org-property-re (org-re "^[ \t]*\\(:\\([-[:alnum:]_]+\\):\\)[ \t]*\\([^ \t\r\n].*\\)")
+(defconst org-property-re (org-re "^[ \t]*\\(:\\([-[:alnum:]_]+\\+?\\):\\)[ \t]*\\([^ \t\r\n].*\\)")
"Regular expression matching a property line.")
(defvar org-font-lock-hook nil
@@ -5554,9 +5716,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
@@ -5595,14 +5759,17 @@ needs to be inserted at a specific position in the font-lock sequence.")
(if (memq 'footnote lk) '(org-activate-footnote-links))
'("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
'(org-hide-wide-columns (0 nil append))
- ;; TODO lines
- (list (concat "^\\*+[ \t]+" org-todo-regexp "\\([ \t]\\|$\\)")
- '(1 (org-get-todo-face 1) t))
+ ;; TODO keyword
+ (list (format org-heading-keyword-regexp-format
+ org-todo-regexp)
+ '(2 (org-get-todo-face 2) t))
;; DONE
(if org-fontify-done-headline
- (list (concat "^[*]+ +\\<\\("
- (mapconcat 'regexp-quote org-done-keywords "\\|")
- "\\)\\(.*\\)")
+ (list (format org-heading-keyword-regexp-format
+ (concat
+ "\\(?:"
+ (mapconcat 'regexp-quote org-done-keywords "\\|")
+ "\\)"))
'(2 'org-headline-done t))
nil)
;; Priorities
@@ -5627,7 +5794,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
@@ -5640,10 +5807,11 @@ needs to be inserted at a specific position in the font-lock sequence.")
;; Code
'(org-activate-code (1 'org-code t))
;; COMMENT
- (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string
- "\\|" org-quote-string "\\)\\>")
- '(1 'org-special-keyword t))
- '("^#.*" (0 'font-lock-comment-face t))
+ (list (format org-heading-keyword-regexp-format
+ (concat "\\("
+ org-comment-string "\\|" org-quote-string
+ "\\)"))
+ '(2 'org-special-keyword t))
;; Blocks and meta lines
'(org-fontify-meta-lines-and-blocks)
)))
@@ -5667,22 +5835,49 @@ 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)
(when org-pretty-entities
(catch 'match
(while (re-search-forward
- "\\\\\\([a-zA-Z][a-zA-Z0-9]*\\)\\($\\|[^[:alnum:]\n]\\)"
+ "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)"
limit t)
(if (and (not (org-in-indented-comment-line))
(setq ee (org-entity-get (match-string 1)))
(= (length (nth 6 ee)) 1))
- (progn
+ (let*
+ ((end (if (equal (match-string 2) "{}")
+ (match-end 2)
+ (match-end 1))))
(add-text-properties
- (match-beginning 0) (match-end 1)
+ (match-beginning 0) end
(list 'font-lock-fontified t))
- (compose-region (match-beginning 0) (match-end 1)
+ (compose-region (match-beginning 0) end
(nth 6 ee) nil)
(backward-char 1)
(throw 'match t))))
@@ -5701,16 +5896,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)
@@ -5743,14 +5938,15 @@ When FACE-OR-COLOR is not a string, just return it."
(defun org-font-lock-add-priority-faces (limit)
"Add the special priority faces."
(while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t)
- (add-text-properties
- (match-beginning 0) (match-end 0)
- (list 'face (or (org-face-from-face-or-color
- 'priority 'org-special-keyword
- (cdr (assoc (char-after (match-beginning 1))
- org-priority-faces)))
- 'org-special-keyword)
- 'font-lock-fontified t))))
+ (when (save-match-data (org-at-heading-p))
+ (add-text-properties
+ (match-beginning 0) (match-end 0)
+ (list 'face (or (org-face-from-face-or-color
+ 'priority 'org-special-keyword
+ (cdr (assoc (char-after (match-beginning 1))
+ org-priority-faces)))
+ 'org-special-keyword)
+ 'font-lock-fontified t)))))
(defun org-get-tag-face (kwd)
"Get the right face for a TODO keyword KWD.
@@ -5768,17 +5964,10 @@ If KWD is a number, get the corresponding match group."
(inhibit-modification-hooks t)
deactivate-mark buffer-file-name buffer-file-truename)
(org-decompose-region beg end)
- (remove-text-properties
- beg end
- (if org-indent-mode
- ;; also remove line-prefix and wrap-prefix properties
- '(mouse-face t keymap t org-linked-text t
- invisible t intangible t
- line-prefix t wrap-prefix 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)))
+ (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))
(org-remove-font-lock-display-properties beg end)))
(defconst org-script-display '(((raise -0.3) (height 0.7))
@@ -5848,10 +6037,9 @@ and subscripts."
(defvar org-cycle-subtree-status nil)
(make-variable-buffer-local 'org-cycle-subtree-status)
-;;;###autoload
-
(defvar org-inlinetask-min-level)
+;;;###autoload
(defun org-cycle (&optional arg)
"TAB-action and visibility cycling for Org-mode.
@@ -5911,11 +6099,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 (org-mode-p))
+ (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)
@@ -5978,6 +6166,8 @@ in special contexts.
(or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
(org-inlinetask-toggle-visibility))
+ ((org-try-cdlatex-tab))
+
;; At an item/headline: delegate to `org-cycle-internal-local'.
((and (or (and org-cycle-include-plain-lists (org-at-item-p))
(save-excursion (beginning-of-line 1)
@@ -5993,8 +6183,6 @@ in special contexts.
((org-try-structure-completion))
- ((org-try-cdlatex-tab))
-
((run-hook-with-args-until-success
'org-tab-before-tab-emulation-hook))
@@ -6019,34 +6207,36 @@ in special contexts.
(defun org-cycle-internal-global ()
"Do the global cycling action."
- (cond
- ((and (eq last-command this-command)
- (eq org-cycle-global-status 'overview))
- ;; We just created the overview - now do table of contents
- ;; This can be slow in very large buffers, so indicate action
- (run-hook-with-args 'org-pre-cycle-hook 'contents)
- (message "CONTENTS...")
- (org-content)
- (message "CONTENTS...done")
- (setq org-cycle-global-status 'contents)
- (run-hook-with-args 'org-cycle-hook 'contents))
-
- ((and (eq last-command this-command)
- (eq org-cycle-global-status 'contents))
- ;; We just showed the table of contents - now show everything
- (run-hook-with-args 'org-pre-cycle-hook 'all)
- (show-all)
- (message "SHOW ALL")
- (setq org-cycle-global-status 'all)
- (run-hook-with-args 'org-cycle-hook 'all))
+ ;; Hack to avoid display of messages for .org attachments in Gnus
+ (let ((ga (string-match "\\*fontification" (buffer-name))))
+ (cond
+ ((and (eq last-command this-command)
+ (eq org-cycle-global-status 'overview))
+ ;; We just created the overview - now do table of contents
+ ;; This can be slow in very large buffers, so indicate action
+ (run-hook-with-args 'org-pre-cycle-hook 'contents)
+ (unless ga (message "CONTENTS..."))
+ (org-content)
+ (unless ga (message "CONTENTS...done"))
+ (setq org-cycle-global-status 'contents)
+ (run-hook-with-args 'org-cycle-hook 'contents))
+
+ ((and (eq last-command this-command)
+ (eq org-cycle-global-status 'contents))
+ ;; We just showed the table of contents - now show everything
+ (run-hook-with-args 'org-pre-cycle-hook 'all)
+ (show-all)
+ (unless ga (message "SHOW ALL"))
+ (setq org-cycle-global-status 'all)
+ (run-hook-with-args 'org-cycle-hook 'all))
- (t
- ;; Default action: go to overview
- (run-hook-with-args 'org-pre-cycle-hook 'overview)
- (org-overview)
- (message "OVERVIEW")
- (setq org-cycle-global-status 'overview)
- (run-hook-with-args 'org-cycle-hook 'overview))))
+ (t
+ ;; Default action: go to overview
+ (run-hook-with-args 'org-pre-cycle-hook 'overview)
+ (org-overview)
+ (unless ga (message "OVERVIEW"))
+ (setq org-cycle-global-status 'overview)
+ (run-hook-with-args 'org-cycle-hook 'overview)))))
(defun org-cycle-internal-local ()
"Do the local cycling action."
@@ -6109,7 +6299,12 @@ in special contexts.
(if (org-at-item-p)
(org-list-set-item-visibility (point-at-bol) struct 'children)
(org-show-entry)
- (show-children)
+ (org-with-limited-levels (show-children))
+ ;; FIXME: This slows down the func way too much.
+ ;; How keep drawers hidden in subtree anyway?
+ ;; (when (memq 'org-cycle-hide-drawers org-cycle-hook)
+ ;; (org-cycle-hide-drawers 'subtree))
+
;; Fold every list in subtree to top-level items.
(when (eq org-cycle-include-plain-lists 'integrate)
(save-excursion
@@ -6154,7 +6349,7 @@ With \\[universal-argument] prefix arg, switch to startup visibility.
With a numeric prefix, show all headlines up to that level."
(interactive "P")
(let ((org-cycle-include-plain-lists
- (if (org-mode-p) org-cycle-include-plain-lists nil)))
+ (if (derived-mode-p 'org-mode) org-cycle-include-plain-lists nil)))
(cond
((integerp arg)
(show-all)
@@ -6213,6 +6408,9 @@ With a numeric prefix, show all headlines up to that level."
(org-cycle-hide-drawers 'all)
(org-cycle-show-empty-lines 'all)))))
+;; This function uses outline-regexp instead of the more fundamental
+;; org-outline-regexp so that org-cycle-global works outside of Org
+;; buffers, where outline-regexp is needed.
(defun org-overview ()
"Switch to overview mode, showing only top-level headlines.
Really, this shows all headlines with level equal or greater than the level
@@ -6222,7 +6420,7 @@ results."
(interactive)
(let ((level (save-excursion
(goto-char (point-min))
- (if (re-search-forward org-outline-regexp-bol nil t)
+ (if (re-search-forward (concat "^" outline-regexp) nil t)
(progn
(goto-char (match-beginning 0))
(funcall outline-level))))))
@@ -6334,7 +6532,7 @@ are at least `org-cycle-separator-lines' empty lines before the headline."
(org-back-over-empty-lines)
(if (save-excursion
(goto-char (max (point-min) (1- (point))))
- (org-on-heading-p))
+ (org-at-heading-p))
(1- (point))
(point))))
(setq b (match-beginning 1)))
@@ -6361,7 +6559,7 @@ open and agenda-wise Org files."
(let ((files (mapcar 'expand-file-name (org-agenda-files))))
(dolist (buf (buffer-list))
(with-current-buffer buf
- (if (and (org-mode-p) (buffer-file-name))
+ (if (and (derived-mode-p 'org-mode) (buffer-file-name))
(let ((file (expand-file-name (buffer-file-name))))
(unless (member file files)
(push file files))))))
@@ -6377,7 +6575,7 @@ open and agenda-wise Org files."
(defun org-cycle-hide-drawers (state)
"Re-hide all drawers after a visibility state change."
- (when (and (org-mode-p)
+ (when (and (derived-mode-p 'org-mode)
(not (memq state '(overview folded contents))))
(save-excursion
(let* ((globalp (memq state '(contents all)))
@@ -6391,6 +6589,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]*:")
@@ -6447,16 +6647,11 @@ DATA should have been made by `org-outline-overlay-data'."
(widen)
(show-all)
(mapc (lambda (c)
- (setq o (make-overlay (car c) (cdr c)))
- (overlay-put o 'invisible 'outline))
+ (outline-flag-region (car c) (cdr c) t))
data)))))
;;; Folding of blocks
-(defconst org-block-regexp
- "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$"
- "Regular expression for hiding blocks.")
-
(defvar org-hide-block-overlays nil
"Overlays hiding blocks.")
(make-variable-buffer-local 'org-hide-block-overlays)
@@ -6583,7 +6778,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")
@@ -6593,18 +6788,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 is 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)
@@ -6619,7 +6818,7 @@ hierarchy above."
(selected-point
(if (eq interface 'outline)
(car (org-get-location (current-buffer) org-goto-help))
- (let ((pa (org-refile-get-location "Goto")))
+ (let ((pa (org-refile-get-location "Goto" nil nil t)))
(org-refile-check-position pa)
(nth 3 pa)))))
(if selected-point
@@ -6651,7 +6850,7 @@ or nil."
(save-window-excursion
(delete-other-windows)
(and (get-buffer "*org-goto*") (kill-buffer "*org-goto*"))
- (switch-to-buffer
+ (org-pop-to-buffer-same-window
(condition-case nil
(make-indirect-buffer (current-buffer) "*org-goto*")
(error (make-indirect-buffer (current-buffer) "*org-goto*"))))
@@ -6699,12 +6898,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."
@@ -6716,7 +6915,7 @@ or nil."
(defun org-goto-left ()
"Finish `org-goto' by going to the new location."
(interactive)
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(progn
(beginning-of-line 1)
(setq org-goto-selected-point (point)
@@ -6727,7 +6926,7 @@ or nil."
(defun org-goto-right ()
"Finish `org-goto' by going to the new location."
(interactive)
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(progn
(setq org-goto-selected-point (point)
org-goto-exit-command 'right)
@@ -6749,8 +6948,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 \
@@ -6772,11 +6972,11 @@ 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)
- (if (org-on-heading-p) (backward-char 1))
+ (if (org-at-heading-p) (backward-char 1))
(setq end (point)))
(if (and (buffer-live-p org-last-indirect-buffer)
(not (eq org-indirect-buffer-display 'new-frame))
@@ -6789,7 +6989,7 @@ frame is not changed."
(and arg (eq org-indirect-buffer-display 'dedicated-frame)))
(select-frame (make-frame))
(delete-other-windows)
- (switch-to-buffer ibuf)
+ (org-pop-to-buffer-same-window ibuf)
(org-set-frame-title heading))
((eq org-indirect-buffer-display 'dedicated-frame)
(raise-frame
@@ -6798,10 +6998,10 @@ frame is not changed."
org-indirect-dedicated-frame)
(setq org-indirect-dedicated-frame (make-frame)))))
(delete-other-windows)
- (switch-to-buffer ibuf)
+ (org-pop-to-buffer-same-window ibuf)
(org-set-frame-title (concat "Indirect: " heading)))
((eq org-indirect-buffer-display 'current-window)
- (switch-to-buffer ibuf))
+ (org-pop-to-buffer-same-window ibuf))
((eq org-indirect-buffer-display 'other-window)
(pop-to-buffer ibuf))
(t (error "Invalid value")))
@@ -6810,6 +7010,7 @@ frame is not changed."
(narrow-to-region beg end)
(show-all)
(goto-char pos)
+ (run-hook-with-args 'org-cycle-hook 'all)
(and (window-live-p cwin) (select-window cwin))))
(defun org-get-indirect-buffer (&optional buffer)
@@ -6853,15 +7054,15 @@ This is important for non-interactive uses of the command."
(if (or (= (buffer-size) 0)
(and (not (save-excursion
(and (ignore-errors (org-back-to-heading invisible-ok))
- (org-on-heading-p))))
- (not (org-in-item-p))))
+ (org-at-heading-p))))
+ (or force-heading (not (org-in-item-p)))))
(progn
(insert "\n* ")
(run-hooks 'org-insert-heading-hook))
(when (or force-heading (not (org-insert-item)))
(let* ((empty-line-p nil)
(level nil)
- (on-heading (org-on-heading-p))
+ (on-heading (org-at-heading-p))
(head (save-excursion
(condition-case nil
(progn
@@ -6874,7 +7075,7 @@ This is important for non-interactive uses of the command."
;; Find a heading level before the inline task
(while (and (setq level (org-up-heading-safe))
(>= level org-inlinetask-min-level)))
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(org-back-to-heading invisible-ok)
(error "This should not happen")))
(setq empty-line-p (org-previous-line-empty-p))
@@ -6884,7 +7085,7 @@ This is important for non-interactive uses of the command."
(blank (if (eq blank-a 'auto) empty-line-p blank-a))
pos hide-previous previous-pos)
(cond
- ((and (org-on-heading-p) (bolp)
+ ((and (org-at-heading-p) (bolp)
(or (bobp)
(save-excursion (backward-char 1) (not (outline-invisible-p)))))
;; insert before the current line
@@ -6909,6 +7110,7 @@ This is important for non-interactive uses of the command."
(let ((p (point)))
(goto-char (point-at-bol))
(and (looking-at org-complex-heading-regexp)
+ (match-beginning 4)
(> p (match-beginning 4)))))))
tags pos)
(cond
@@ -6924,7 +7126,7 @@ This is important for non-interactive uses of the command."
(or (org-previous-line-empty-p)
(and blank (newline)))
(open-line 1))
- ((org-on-heading-p)
+ ((org-at-heading-p)
(when hide-previous
(show-children)
(org-show-entry))
@@ -6969,14 +7171,15 @@ When NO-TODO is non-nil, don't include TODO keywords."
(looking-at org-complex-heading-regexp)
(match-string 4))
(no-tags
- (looking-at "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@#%]+:[ \t]*\\)?$")
+ (looking-at (concat org-outline-regexp
+ "\\(.*?\\)"
+ "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$"))
(match-string 1))
(no-todo
- (looking-at (concat "\\*+[ \t]+" org-todo-regexp " +"
- "\\([^\n\r]*?[ \t]+:[[:alnum:]:_@#%]+:[ \t]*\\)?$"))
- (match-string 2))
- (t (looking-at "\\*+[ \t]+\\([^\r\n]*\\)")
- (match-string 1)))))
+ (looking-at org-todo-line-regexp)
+ (match-string 3))
+ (t (looking-at org-heading-regexp)
+ (match-string 2)))))
(defun org-heading-components ()
"Return the components of the current heading.
@@ -7058,7 +7261,7 @@ Works for outline headings and for plain lists alike."
(interactive "P")
(org-insert-heading arg)
(cond
- ((org-on-heading-p) (org-do-demote))
+ ((org-at-heading-p) (org-do-demote))
((org-at-item-p) (org-indent-item))))
(defun org-insert-todo-subheading (arg)
@@ -7067,7 +7270,7 @@ Works for outline headings and for plain lists alike."
(interactive "P")
(org-insert-todo-heading arg)
(cond
- ((org-on-heading-p) (org-do-demote))
+ ((org-at-heading-p) (org-do-demote))
((org-at-item-p) (org-indent-item))))
;;; Promotion and Demotion
@@ -7137,9 +7340,8 @@ in the region."
The level is the number of stars at the beginning of the headline."
(save-excursion
(org-with-limited-levels
- (ignore-errors
- (org-back-to-heading t)
- (funcall outline-level)))))
+ (if (ignore-errors (org-back-to-heading t))
+ (funcall outline-level)))))
(defun org-get-previous-line-level ()
"Return the outline depth of the last headline before the current line.
@@ -7186,6 +7388,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
@@ -7193,14 +7397,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 ()
@@ -7210,7 +7419,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)
@@ -7282,6 +7491,7 @@ After top level, it switches back to sibling level."
(not (eobp)))
(funcall fun)))))
+(defvar org-property-end-re) ; silence byte-compiler
(defun org-fixup-indentation (diff)
"Change the indentation in the current entry by DIFF.
However, if any line in the current entry has no indentation, or if it
@@ -7468,7 +7678,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)
@@ -7512,30 +7722,29 @@ 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)
- (^re_ (concat "\\(\\*+\\)[ \t]*")) ;FIXME: Why `concat'?
+ (^re_ "\\(\\*+\\)[ \t]*")
(old-level (if (string-match org-outline-regexp-bol txt)
(- (match-end 0) (match-beginning 0) 1)
-1))
(force-level (cond (level (prefix-numeric-value level))
((and (looking-at "[ \t]*$")
(string-match
- ^re_ (buffer-substring
- (point-at-bol) (point))))
+ "^\\*+$" (buffer-substring
+ (point-at-bol) (point))))
(- (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
(outline-previous-visible-heading 1)
- (if (looking-at re) ;FIXME: What's `re'?
+ (if (looking-at ^re_)
(- (match-end 0) (match-beginning 0) 1)
1))
(error 1))))
@@ -7544,7 +7753,7 @@ the inserted text when done."
(progn
(or (looking-at org-outline-regexp)
(outline-next-visible-heading 1))
- (if (looking-at re) ;FIXME: What's `re'?
+ (if (looking-at ^re_)
(- (match-end 0) (match-beginning 0) 1)
1))
(error 1))))
@@ -7562,7 +7771,7 @@ the inserted text when done."
(if force-level
(delete-region (point-at-bol) (point)))
;; Paste
- (beginning-of-line 1)
+ (beginning-of-line (if (bolp) 1 2))
(unless for-yank (org-back-over-empty-lines))
(setq beg (point))
(and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
@@ -7663,23 +7872,17 @@ If yes, remember the marker and the distance to BEG."
(narrow-to-region
(progn (org-back-to-heading t) (point))
(progn (org-end-of-subtree t t)
- (if (and (org-on-heading-p) (not (eobp))) (backward-char 1))
+ (if (and (org-at-heading-p) (not (eobp))) (backward-char 1))
(point)))))))
(defun org-narrow-to-block ()
"Narrow buffer to the current block."
(interactive)
- (let ((bstart "^[ \t]*#\\+begin")
- (bend "[ \t]*#\\+end")
- (case-fold-search t) ;; allow #+BEGIN
- b_start b_end)
- (if (org-in-regexps-block-p bstart bend)
- (progn
- (save-excursion (re-search-backward bstart nil t)
- (setq b_start (match-beginning 0)))
- (save-excursion (re-search-forward bend nil t)
- (setq b_end (match-end 0)))
- (narrow-to-region b_start b_end))
+ (let* ((case-fold-search t)
+ (blockp (org-between-regexps-p "^[ \t]*#\\+begin_.*"
+ "^[ \t]*#\\+end_.*")))
+ (if blockp
+ (narrow-to-region (car blockp) (cdr blockp))
(error "Not in a block"))))
(eval-when-compile
@@ -7709,15 +7912,16 @@ the following will happen:
repeater intact.
- the start days in the repeater in the original entry will be shifted
to past the last clone.
-I this way you can spell out a number of instances of a repeating task,
+In this way you can spell out a number of instances of a repeating task,
and still retain the repeater to cover future instances of the task."
(interactive "nNumber of clones to produce: \nsDate shift per clone (e.g. +1w, empty to copy unchanged): ")
(let (beg end template task idprop
- shift-n shift-what doshift nmin nmax (n-no-remove -1))
+ shift-n shift-what doshift nmin nmax (n-no-remove -1)
+ (drawer-re org-drawer-regexp))
(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
@@ -7734,21 +7938,8 @@ and still retain the repeater to cover future instances of the task."
(or (bolp) (insert "\n"))
(setq end (point))
(setq template (buffer-substring beg end))
- ;; Remove clocks and empty drawers
- (with-temp-buffer
- (insert template)
- (goto-char (point-min))
- (while (re-search-forward
- "^[ \t]*CLOCK:.*$" (save-excursion (org-end-of-subtree t t)) t)
- (replace-match "")
- (kill-whole-line))
- (goto-char (point-min))
- (while (re-search-forward
- (concat "^[ \t]*:" (regexp-opt org-drawers) ":[ \t]*$") nil t)
- (mapc (lambda(d) (org-remove-empty-drawer-at d (point))) org-drawers))
- (setq template (buffer-substring (point-min) (point-max))))
(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))
@@ -7759,11 +7950,17 @@ and still retain the repeater to cover future instances of the task."
(insert template)
(org-mode)
(goto-char (point-min))
+ (org-show-subtree)
(and idprop (if org-clone-delete-id
(org-entry-delete nil "ID")
(org-id-get-create t)))
- (while (re-search-forward org-property-start-re nil t)
- (org-remove-empty-drawer-at "PROPERTIES" (point)))
+ (unless (= n 0)
+ (while (re-search-forward "^[ \t]*CLOCK:.*$" nil t)
+ (kill-whole-line))
+ (goto-char (point-min))
+ (while (re-search-forward drawer-re nil t)
+ (mapc (lambda (d)
+ (org-remove-empty-drawer-at d (point))) org-drawers)))
(goto-char (point-min))
(when doshift
(while (re-search-forward org-ts-regexp-both nil t)
@@ -7773,7 +7970,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))
@@ -7783,8 +7980,7 @@ and still retain the repeater to cover future instances of the task."
(defun org-sort (with-case)
"Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'.
-Optional argument WITH-CASE means sort case-sensitively.
-With a double prefix argument, also remove duplicate entries."
+Optional argument WITH-CASE means sort case-sensitively."
(interactive "P")
(cond
((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case))
@@ -7853,9 +8049,9 @@ WITH-CASE, the sorting considers case as well."
(setq end (region-end)
what "region")
(goto-char (region-beginning))
- (if (not (org-on-heading-p)) (outline-next-heading))
+ (if (not (org-at-heading-p)) (outline-next-heading))
(setq start (point)))
- ((or (org-on-heading-p)
+ ((or (org-at-heading-p)
(condition-case nil (progn (org-back-to-heading) t) (error nil)))
;; we will sort the children of the current headline
(org-back-to-heading)
@@ -7871,7 +8067,7 @@ WITH-CASE, the sorting considers case as well."
(t
;; we will sort the top-level entries in this file
(goto-char (point-min))
- (or (org-on-heading-p) (outline-next-heading))
+ (or (org-at-heading-p) (outline-next-heading))
(setq start (point))
(goto-char (point-max))
(beginning-of-line 1)
@@ -7995,8 +8191,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")))
@@ -8103,26 +8298,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))))
@@ -8178,6 +8378,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"))
@@ -8186,21 +8389,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"))
@@ -8238,6 +8441,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'."
@@ -8254,7 +8528,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)
@@ -8269,7 +8543,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))))
@@ -8302,15 +8576,18 @@ call CMD."
(defun org-get-category (&optional pos force-refresh)
"Get the category applying to position POS."
- (if force-refresh (org-refresh-category-properties))
- (let ((pos (or pos (point))))
- (or (get-text-property pos 'org-category)
- (progn (org-refresh-category-properties)
- (get-text-property pos 'org-category)))))
+ (save-match-data
+ (if force-refresh (org-refresh-category-properties))
+ (let ((pos (or pos (point))))
+ (or (get-text-property pos 'org-category)
+ (progn (org-refresh-category-properties)
+ (get-text-property pos 'org-category))))))
(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
@@ -8335,6 +8612,7 @@ call CMD."
(org-back-to-heading t)
(setq beg (point) end (org-end-of-subtree t t)))
(put-text-property beg end 'org-category cat)
+ (put-text-property beg end 'org-category-position beg)
(goto-char pos)))))))
@@ -8343,7 +8621,7 @@ call CMD."
;;; Link abbreviations
(defun org-link-expand-abbrev (link)
- "Apply replacements as defined in `org-link-abbrev-alist."
+ "Apply replacements as defined in `org-link-abbrev-alist'."
(if (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link)
(let* ((key (match-string 1 link))
(as (or (assoc key org-link-abbrev-alist-local)
@@ -8355,6 +8633,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))
@@ -8393,7 +8673,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'.
@@ -8427,7 +8707,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)
@@ -8449,7 +8730,7 @@ For file links, arg negates `org-context-in-file-links'."
(setq link (plist-get org-store-link-plist :link)
desc (or (plist-get org-store-link-plist :description) link)))
- ((equal (buffer-name) "*Org Edit Src Example*")
+ ((org-src-edit-buffer-p)
(let (label gc)
(while (or (not label)
(save-excursion
@@ -8489,17 +8770,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
@@ -8511,7 +8799,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)
@@ -8523,9 +8811,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)) (org-mode-p))
+ ((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 "<<\\(.*?\\)>>")
@@ -8534,22 +8822,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:"
@@ -8563,10 +8848,9 @@ For file links, arg negates `org-context-in-file-links'."
;; Add a context search string
(when (org-xor org-context-in-file-links arg)
(setq txt (cond
- ((org-on-heading-p) nil)
+ ((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 "::"
@@ -8577,7 +8861,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.
@@ -8594,7 +8878,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"))
@@ -8700,10 +8984,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)
@@ -8740,8 +9020,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.
@@ -8754,29 +9032,28 @@ 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
-encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ö'."
+encodeURIComponent. E.g. `%C3%B6' is the german o-Umlaut."
(unless (and (null str) (string= "" str))
(let ((pos 0) (case-fold-search t) unhexed)
(while (setq pos (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str pos))
@@ -8786,9 +9063,9 @@ encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ö'."
str)
(defun org-link-unescape-compound (hex)
- "Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ö'.
+ "Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German o-Umlaut.
Note: this function also decodes single byte encodings like
-`%E1' (\"á\") if not followed by another `%[A-F0-9]{2}' group."
+`%E1' (a-acute) if not followed by another `%[A-F0-9]{2}' group."
(save-match-data
(let* ((bytes (cdr (split-string hex "%")))
(ret "")
@@ -8845,6 +9122,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.
@@ -8853,7 +9138,39 @@ This command can be called in any mode to insert a link in Org-mode syntax."
(org-load-modules-maybe)
(org-run-like-in-org-mode 'org-insert-link))
-(defun org-insert-link (&optional complete-file link-location)
+(defun org-insert-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.
Completion can be used to insert any of the link protocol prefixes like
@@ -8871,8 +9188,8 @@ be displayed in the buffer instead of the link.
If there is already a link at point, this command will allow you to edit link
and description parts.
-With a \\[universal-argument] prefix, prompts for a file to link to. The file name can
-be selected using completion. The path to the file will be relative to the
+With a \\[universal-argument] prefix, prompts for a file to link to. The file name can
+be selected using completion. The path to the file will be relative to the
current directory if the file is in the current directory or a subdirectory.
Otherwise, the link will be the absolute path as completed in the minibuffer
\(i.e. normally ~/path/to/file). You can configure this behavior using the
@@ -8889,7 +9206,10 @@ called with the link target, and the result will be the default
link description.
If the LINK-LOCATION parameter is non-nil, this value will be
-used as the link location instead of reading one interactively."
+used as the link location instead of reading one interactively.
+
+If the DEFAULT-DESCRIPTION parameter is non-nil, this value will
+be used as the default description."
(interactive "P")
(let* ((wcf (current-window-configuration))
(region (if (org-region-active-p)
@@ -8898,7 +9218,8 @@ used as the link location instead of reading one interactively."
(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)
@@ -8919,25 +9240,27 @@ used as the link location instead of reading one interactively."
(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)
+ (with-current-buffer "*Org Links*" (setq truncate-lines t))
(unless (pos-visible-in-window-p (point-max))
(org-fit-window-to-buffer))
(and (window-live-p cw) (select-window cw)))
;; 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
@@ -8950,12 +9273,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)
@@ -8965,15 +9292,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.
@@ -9017,9 +9345,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)))
+ (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))))
@@ -9040,24 +9376,26 @@ 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)
"Completing-read with SPACE being a normal character."
- (let ((minibuffer-local-completion-map
+ (let ((enable-recursive-minibuffers t)
+ (minibuffer-local-completion-map
(copy-keymap minibuffer-local-completion-map)))
(org-defkey minibuffer-local-completion-map " " 'self-insert-command)
(org-defkey minibuffer-local-completion-map "?" 'self-insert-command)
+ (org-defkey minibuffer-local-completion-map (kbd "C-c !") 'org-time-stamp-inactive)
(apply 'org-icompleting-read args)))
(defun org-completing-read-no-i (&rest args)
@@ -9195,31 +9533,31 @@ If the link is in hidden text, expose it."
(string-match "\\([a-zA-Z0-9]+\\):\\(.*\\)" s))
(progn
(setq s (funcall org-link-translation-function
- (match-string 1) (match-string 2)))
+ (match-string 1 s) (match-string 2 s)))
(concat (car s) ":" (cdr s)))
s))
(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."
@@ -9228,7 +9566,8 @@ This is still an experimental function, your mileage may vary."
(org-open-at-point 'in-emacs))
(defun org-open-at-mouse (ev)
- "Open file link or URL at mouse."
+ "Open file link or URL at mouse.
+See the docstring of `org-open-file' for details."
(interactive "e")
(mouse-set-point ev)
(if (eq major-mode 'org-agenda-mode)
@@ -9256,7 +9595,7 @@ Org-mode syntax."
(interactive "sLink: \nP")
(let ((reference-buffer (or reference-buffer (current-buffer))))
(with-temp-buffer
- (let ((org-inhibit-startup t))
+ (let ((org-inhibit-startup (not reference-buffer)))
(org-mode)
(insert s)
(goto-char (point-min))
@@ -9273,6 +9612,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
@@ -9284,192 +9624,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-on-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 (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))))
-
- (cond
+ (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))))
- ((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 ":" (org-link-escape
- path org-link-escape-chars-browser))))
-
- ((string= type "doi")
- (browse-url (concat "http://dx.doi.org/"
- (org-link-escape
- path org-link-escape-chars-browser))))
-
- ((member type '("message"))
- (browse-url (concat type ":" path)))
-
- ((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 (eval cmd)
- (error (progn (widen) (eval cmd))))))
+ (cond
- (t
- (browse-url-at-point)))))))
- (move-marker org-open-link-marker nil)
- (run-hook-with-args 'org-follow-link-hook)))
+ ((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 ((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.
@@ -9499,7 +9860,7 @@ there is one, offer it as link number zero."
((equal (length links) 1)
(setq link (list (car links))))
((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
- (setq link (nth (if have-zero nth (1- nth)) links)))
+ (setq link (list (nth (if have-zero nth (1- nth)) links))))
(t ; we have to select a link
(save-excursion
(save-window-excursion
@@ -9607,13 +9968,18 @@ the window configuration before `org-open-at-point' was called using:
(set-window-configuration org-window-config-before-follow-link)")
(defvar org-link-search-inhibit-query nil) ;; dynamically scoped
-(defun org-link-search (s &optional type avoid-pos)
+(defun org-link-search (s &optional type avoid-pos stealth)
"Search for a link search option.
If S is surrounded by forward slashes, it is interpreted as a
regular expression. In org-mode files, this will create an `org-occur'
sparse tree. In ordinary files, `occur' will be used to list matches.
If the current buffer is in `dired-mode', grep will be used to search
-in all files. If AVOID-POS is given, ignore matches near that position."
+in all files. If AVOID-POS is given, ignore matches near that position.
+
+When optional argument STEALTH is non-nil, do not modify
+visibility around point, thus ignoring
+`org-show-hierarchy-above', `org-show-following-heading' and
+`org-show-siblings' variables."
(let ((case-fold-search t)
(s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " "))
(markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x)))
@@ -9648,6 +10014,22 @@ in all files. If AVOID-POS is given, ignore matches near that position."
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))
@@ -9664,12 +10046,12 @@ in all files. If AVOID-POS is given, ignore matches near that position."
((string-match "^/\\(.*\\)/$" s)
;; A regular expression
(cond
- ((org-mode-p)
+ ((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 (org-mode-p) 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
@@ -9737,7 +10119,9 @@ in all files. If AVOID-POS is given, ignore matches near that position."
(goto-char (match-beginning 1))
(goto-char pos)
(error "No match"))))))
- (and (org-mode-p) (org-show-context 'link-search))
+ (and (derived-mode-p 'org-mode)
+ (not stealth)
+ (org-show-context 'link-search))
type))
(defun org-search-not-self (group &rest args)
@@ -9816,8 +10200,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.
@@ -9833,7 +10217,7 @@ onto the ring."
(setq p org-mark-ring))
(setq org-mark-ring-last-goto p)
(setq m (car p))
- (switch-to-buffer (marker-buffer m))
+ (org-pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(if (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
@@ -9853,18 +10237,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"))))
@@ -9891,6 +10281,10 @@ Optional LINE specifies a line to go to, optional SEARCH a string
to search for. If LINE or SEARCH is given, the file will be
opened in Emacs, unless an entry from org-file-apps that makes
use of groups in a regexp matches.
+
+If you want to change the way frames are used when following a
+link, please customize `org-link-frame-setup'.
+
If the file does not exist, an error is thrown."
(let* ((file (if (equal path "")
buffer-file-name
@@ -9909,9 +10303,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))))
@@ -9931,8 +10325,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
@@ -9940,8 +10334,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))
@@ -10002,7 +10396,7 @@ If the file does not exist, an error is thrown."
(set-match-data link-match-data)
(eval cmd))))
(t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
- (and (org-mode-p) (eq old-mode 'org-mode)
+ (and (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))))
@@ -10067,8 +10461,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
@@ -10215,7 +10608,8 @@ on the system \"/user@host:\"."
(or (funcall org-refile-target-verify-function)
(throw 'next t))))
(when (and (looking-at org-complex-heading-regexp)
- (not (member (match-string 4) excluded-entries)))
+ (not (member (match-string 4) excluded-entries))
+ (match-string 4))
(setq level (org-reduced-level
(- (match-end 1) (match-beginning 1)))
txt (org-link-display-format (match-string 4))
@@ -10325,7 +10719,7 @@ such as the file name."
(interactive "P")
(let* ((bfn (buffer-file-name (buffer-base-buffer)))
(case-fold-search nil)
- (path (and (org-mode-p) (org-get-outline-path))))
+ (path (and (derived-mode-p 'org-mode) (org-get-outline-path))))
(if current (setq path (append path
(save-excursion
(org-back-to-heading t)
@@ -10372,7 +10766,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')."
@@ -10391,8 +10785,10 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(goto-char region-start)
(or (bolp) (goto-char (point-at-bol)))
(setq region-start (point))
- (unless (org-kill-is-subtree-p
- (buffer-substring region-start region-end))
+ (unless (or (org-kill-is-subtree-p
+ (buffer-substring region-start region-end))
+ (prog1 org-refile-active-region-within-subtree
+ (org-toggle-heading)))
(error "The region is not a (sequence of) subtree(s)")))
(if (equal goto '(16))
(org-refile-goto-last-stored)
@@ -10407,10 +10803,21 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(marker-position org-clock-hd-marker)))
(setq goto nil)))
(setq it (or rfloc
- (save-excursion
- (org-refile-get-location
- (if goto "Goto" "Refile to") default-buffer
- org-refile-allow-creating-parent-nodes)))))
+ (let (heading-text)
+ (save-excursion
+ (unless goto
+ (org-back-to-heading t)
+ (setq heading-text
+ (nth 4 (org-heading-components))))
+ (org-refile-get-location
+ (cond (goto "Goto")
+ (regionp "Refile region to")
+ (t (concat "Refile subtree \""
+ heading-text "\" to")))
+ default-buffer
+ (and (not (equal '(4) goto))
+ org-refile-allow-creating-parent-nodes)
+ goto))))))
(setq file (nth 1 it)
re (nth 2 it)
pos (nth 3 it))
@@ -10429,7 +10836,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(find-file-noselect file)))
(if goto
(progn
- (switch-to-buffer nbuf)
+ (org-pop-to-buffer-same-window nbuf)
(goto-char pos)
(org-show-context 'org-goto))
(if regionp
@@ -10466,12 +10873,16 @@ 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))
- (bookmark-set "org-refile-last-stored")
+ (and org-auto-align-tags
+ (let ((org-loop-over-headlines-in-active-region nil))
+ (org-set-tags nil t)))
+ (with-demoted-errors
+ (bookmark-set "org-refile-last-stored"))
;; If we are refiling for capture, make sure that the
;; last-capture pointers point here
(when (org-bound-and-true-p org-refile-for-capture)
- (bookmark-set "org-capture-last-stored-marker")
+ (with-demoted-errors
+ (bookmark-set "org-capture-last-stored-marker"))
(move-marker org-capture-last-stored-marker (point)))
(if (fboundp 'deactivate-mark) (deactivate-mark))
(run-hooks 'org-after-refile-insert-hook))))
@@ -10489,16 +10900,20 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(bookmark-jump "org-refile-last-stored")
(message "This is the location of the last refile"))
-(defun org-refile-get-location (&optional prompt default-buffer new-nodes)
+(defun org-refile-get-location (&optional prompt default-buffer new-nodes
+ no-exclude)
"Prompt the user for a refile location, using PROMPT.
PROMPT should not be suffixed with a colon and a space, because
this function appends the default value from
-`org-refile-history' automatically, if that is not empty."
+`org-refile-history' automatically, if that is not empty.
+When NO-EXCLUDE is set, do not exclude headlines in the current subtree,
+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)
- (not org-refile-use-cache))
+ (when (and (derived-mode-p 'org-mode)
+ (not org-refile-use-cache)
+ (not no-exclude))
(org-map-tree
(lambda()
(setq excluded-entries
@@ -10563,25 +10978,28 @@ this function appends the default value from
(org-refile-new-child parent-target child)))
(error "Invalid target location")))))
+(declare-function org-string-nw-p "org-macs" (s))
(defun org-refile-check-position (refile-pointer)
- "Check if the refile pointer matches the readline to which it points."
+ "Check if the refile pointer matches the headline to which it points."
(let* ((file (nth 1 refile-pointer))
(re (nth 2 refile-pointer))
(pos (nth 3 refile-pointer))
buffer)
- (when (org-string-nw-p re)
- (setq buffer (if (markerp pos)
- (marker-buffer pos)
- (or (find-buffer-visiting file)
- (find-file-noselect file))))
- (with-current-buffer buffer
- (save-excursion
- (save-restriction
- (widen)
- (goto-char pos)
- (beginning-of-line 1)
- (unless (org-looking-at-p re)
- (error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
+ (if (and (not (markerp pos)) (not file))
+ (error "Please save the buffer to a file before refiling")
+ (when (org-string-nw-p re)
+ (setq buffer (if (markerp pos)
+ (marker-buffer pos)
+ (or (find-buffer-visiting file)
+ (find-file-noselect file))))
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char pos)
+ (beginning-of-line 1)
+ (unless (org-looking-at-p re)
+ (error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling")))))))))
(defun org-refile-new-child (parent-target child)
"Use refile target PARENT-TARGET to add new CHILD below it."
@@ -10637,8 +11055,7 @@ this function appends the default value from
rtn))
((eq flag 'lambda)
;; exact match?
- (assoc string thetable)))
- ))
+ (assoc string thetable)))))
args)))
;;;; Dynamic blocks
@@ -10646,20 +11063,20 @@ this function appends the default value from
(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)
@@ -10748,15 +11165,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.
@@ -10776,7 +11193,7 @@ Error if there is no such block at point."
"Update all dynamic blocks in the buffer.
This function can be used in a hook."
(interactive)
- (when (org-mode-p)
+ (when (derived-mode-p 'org-mode)
(org-map-dblocks 'org-update-dblock)))
@@ -10790,48 +11207,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"
- "SOURCE:" "SRCNAME:" "FUNCTION:"
- "RESULTS:" "DATA:"
+ "BEGIN_lstlisting" "END_lstlisting"
+ "NAME:" "RESULTS:"
"HEADER:" "HEADERS:"
- "BABEL:"
- "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>")
- ("v" "#+begin_verse\n?\n#+end_verse"
- "<verse>\n?\n/verse>")
- ("c" "#+begin_center\n?\n#+end_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=\"?\">")
+ ("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>")
+ ("c" "#+BEGIN_CENTER\n?\n#+END_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=\"?\">")
)
"Structure completion elements.
This is a list of abbreviation keys and values. The value gets inserted
@@ -10842,8 +11279,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")
@@ -10897,13 +11333,16 @@ expands them."
(save-excursion
(org-back-to-heading)
(let (case-fold-search)
- (if (looking-at (concat org-outline-regexp
- "\\( *\\<" org-comment-string "\\>[ \t]*\\)"))
- (replace-match "" t t nil 1)
- (if (looking-at org-outline-regexp)
- (progn
- (goto-char (match-end 0))
- (insert org-comment-string " ")))))))
+ (cond
+ ((looking-at (format org-heading-keyword-regexp-format
+ org-comment-string))
+ (goto-char (match-end 1))
+ (looking-at (concat " +" org-comment-string))
+ (replace-match "" t t)
+ (when (eolp) (insert " ")))
+ ((looking-at org-outline-regexp)
+ (goto-char (match-end 0))
+ (insert org-comment-string " "))))))
(defvar org-last-todo-state-is-todo nil
"This is non-nil when the last TODO state change led to a TODO state.
@@ -10925,30 +11364,25 @@ 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 (< (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)
- "Like `org-todo' but the time of change will be 23:59 of yesterday"
+ "Like `org-todo' but the time of change will be 23:59 of yesterday."
(interactive "P")
- (let* ((hour (third (decode-time
- (org-current-time))))
- (org-extend-today-until (1+ hour)))
- (org-todo arg)))
-
-(defun org-agenda-todo-yesterday (&optional arg)
- "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))))
- (org-extend-today-until (1+ hour)))
- (org-agenda-todo arg)))
+ (if (eq major-mode 'org-agenda-mode)
+ (apply 'org-agenda-todo-yesterday arg)
+ (let* ((hour (third (decode-time
+ (org-current-time))))
+ (org-extend-today-until (1+ hour)))
+ (org-todo arg))))
(defun org-todo (&optional arg)
"Change the TODO state of an item.
@@ -10969,6 +11403,7 @@ With numeric prefix arg, switch to that state.
With a double \\[universal-argument] prefix, switch to the next set of TODO \
keywords (nextset).
With a triple \\[universal-argument] prefix, circumvent any state blocking.
+With a numeric prefix arg of 0, inhibit note taking for the change.
For calling through lisp, arg is also interpreted in the following way:
'none -> empty state
@@ -10979,191 +11414,202 @@ For calling through lisp, arg is also interpreted in the following way:
\"WAITING\" -> switch to the specified keyword, but only if it
really is a member of `org-todo-keywords'."
(interactive "P")
- (if (equal arg '(16)) (setq arg 'nextset))
- (let ((org-blocker-hook org-blocker-hook)
- (case-fold-search nil))
- (when (equal arg '(64))
- (setq arg nil org-blocker-hook nil))
- (when (and org-blocker-hook
- (or org-inhibit-blocking
- (org-entry-get nil "NOBLOCKING")))
- (setq org-blocker-hook nil))
- (save-excursion
- (catch 'exit
- (org-back-to-heading t)
- (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
- (or (looking-at (concat " +" org-todo-regexp "\\( +\\|$\\)"))
- (looking-at " *"))
- (let* ((match-data (match-data))
- (startpos (point-at-bol))
- (logging (save-match-data (org-entry-get nil "LOGGING" t t)))
- (org-log-done org-log-done)
- (org-log-repeat org-log-repeat)
- (org-todo-log-states org-todo-log-states)
- (this (match-string 1))
- (hl-pos (match-beginning 0))
- (head (org-get-todo-sequence-head this))
- (ass (assoc head org-todo-kwd-alist))
- (interpret (nth 1 ass))
- (done-word (nth 3 ass))
- (final-done-word (nth 4 ass))
- (last-state (or this ""))
- (completion-ignore-case t)
- (member (member this org-todo-keywords-1))
- (tail (cdr member))
- (state (cond
- ((and org-todo-key-trigger
- (or (and (equal arg '(4))
- (eq org-use-fast-todo-selection 'prefix))
- (and (not arg) org-use-fast-todo-selection
- (not (eq org-use-fast-todo-selection
- 'prefix)))))
- ;; Use fast selection
- (org-fast-todo-selection))
- ((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))))
- (state (or
- (run-hook-with-args-until-success
- 'org-todo-get-default-hook state last-state)
- state))
- (next (if state (concat " " state " ") " "))
- (change-plist (list :type 'todo-state-change :from this :to state
- :position startpos))
- dolog now-done-p)
- (when org-blocker-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
+ `(org-todo ,arg)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (if (equal arg '(16)) (setq arg 'nextset))
+ (let ((org-blocker-hook org-blocker-hook)
+ (case-fold-search nil))
+ (when (equal arg '(64))
+ (setq arg nil org-blocker-hook nil))
+ (when (and org-blocker-hook
+ (or org-inhibit-blocking
+ (org-entry-get nil "NOBLOCKING")))
+ (setq org-blocker-hook nil))
+ (save-excursion
+ (catch 'exit
+ (org-back-to-heading t)
+ (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
+ (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)"))
+ (looking-at "\\(?: *\\|[ \t]*$\\)"))
+ (let* ((match-data (match-data))
+ (startpos (point-at-bol))
+ (logging (save-match-data (org-entry-get nil "LOGGING" t t)))
+ (org-log-done org-log-done)
+ (org-log-repeat org-log-repeat)
+ (org-todo-log-states org-todo-log-states)
+ (org-inhibit-logging
+ (if (equal arg 0)
+ (progn (setq arg nil) 'note) org-inhibit-logging))
+ (this (match-string 1))
+ (hl-pos (match-beginning 0))
+ (head (org-get-todo-sequence-head this))
+ (ass (assoc head org-todo-kwd-alist))
+ (interpret (nth 1 ass))
+ (done-word (nth 3 ass))
+ (final-done-word (nth 4 ass))
+ (org-last-state (or this ""))
+ (completion-ignore-case t)
+ (member (member this org-todo-keywords-1))
+ (tail (cdr member))
+ (org-state (cond
+ ((and org-todo-key-trigger
+ (or (and (equal arg '(4))
+ (eq org-use-fast-todo-selection 'prefix))
+ (and (not arg) org-use-fast-todo-selection
+ (not (eq org-use-fast-todo-selection
+ 'prefix)))))
+ ;; Use fast selection
+ (org-fast-todo-selection))
+ ((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))))
+ (org-state (or
+ (run-hook-with-args-until-success
+ 'org-todo-get-default-hook org-state org-last-state)
+ org-state))
+ (next (if org-state (concat " " org-state " ") " "))
+ (change-plist (list :type 'todo-state-change :from this :to org-state
+ :position startpos))
+ dolog now-done-p)
+ (when org-blocker-hook
+ (setq org-last-todo-state-is-todo
+ (not (member this org-done-keywords)))
+ (unless (save-excursion
+ (save-match-data
+ (org-with-wide-buffer
+ (run-hook-with-args-until-failure
+ 'org-blocker-hook change-plist))))
+ (if (org-called-interactively-p 'interactive)
+ (error "TODO state change from %s to %s blocked" this org-state)
+ ;; fail silently
+ (message "TODO state change from %s to %s blocked" this org-state)
+ (throw 'exit nil))))
+ (store-match-data match-data)
+ (replace-match next t t)
+ (unless (pos-visible-in-window-p hl-pos)
+ (message "TODO state changed to %s" (org-trim next)))
+ (unless head
+ (setq head (org-get-todo-sequence-head org-state)
+ ass (assoc head org-todo-kwd-alist)
+ interpret (nth 1 ass)
+ done-word (nth 3 ass)
+ final-done-word (nth 4 ass)))
+ (when (memq arg '(nextset previousset))
+ (message "Keyword-Set %d/%d: %s"
+ (- (length org-todo-sets) -1
+ (length (memq (assoc org-state org-todo-sets) org-todo-sets)))
+ (length org-todo-sets)
+ (mapconcat 'identity (assoc org-state org-todo-sets) " ")))
(setq org-last-todo-state-is-todo
- (not (member this org-done-keywords)))
- (unless (save-excursion
- (save-match-data
- (org-with-wide-buffer
- (run-hook-with-args-until-failure
- 'org-blocker-hook change-plist))))
- (if (org-called-interactively-p 'interactive)
- (error "TODO state change from %s to %s blocked" this state)
- ;; fail silently
- (message "TODO state change from %s to %s blocked" this state)
- (throw 'exit nil))))
- (store-match-data match-data)
- (replace-match next t t)
- (unless (pos-visible-in-window-p hl-pos)
- (message "TODO state changed to %s" (org-trim next)))
- (unless head
- (setq head (org-get-todo-sequence-head state)
- ass (assoc head org-todo-kwd-alist)
- interpret (nth 1 ass)
- done-word (nth 3 ass)
- final-done-word (nth 4 ass)))
- (when (memq arg '(nextset previousset))
- (message "Keyword-Set %d/%d: %s"
- (- (length org-todo-sets) -1
- (length (memq (assoc state org-todo-sets) org-todo-sets)))
- (length org-todo-sets)
- (mapconcat 'identity (assoc state org-todo-sets) " ")))
- (setq org-last-todo-state-is-todo
- (not (member state org-done-keywords)))
- (setq now-done-p (and (member state org-done-keywords)
- (not (member this org-done-keywords))))
- (and logging (org-local-logging logging))
- (when (and (or org-todo-log-states org-log-done)
- (not (eq org-inhibit-logging t))
- (not (memq arg '(nextset previousset))))
- ;; we need to look at recording a time and note
- (setq dolog (or (nth 1 (assoc state org-todo-log-states))
- (nth 2 (assoc this org-todo-log-states))))
- (if (and (eq dolog 'note) (eq org-inhibit-logging 'note))
- (setq dolog 'time))
- (when (and state
- (member state org-not-done-keywords)
- (not (member this org-not-done-keywords)))
- ;; This is now a todo state and was not one before
- ;; If there was a CLOSED time stamp, get rid of it.
- (org-add-planning-info nil nil 'closed))
- (when (and now-done-p org-log-done)
- ;; It is now done, and it was not done before
- (org-add-planning-info 'closed (org-current-effective-time))
- (if (and (not dolog) (eq 'note org-log-done))
- (org-add-log-setup 'done state this 'findpos 'note)))
- (when (and state dolog)
- ;; This is a non-nil state, and we need to log it
- (org-add-log-setup 'state state this 'findpos dolog)))
- ;; Fixup tag positioning
- (org-todo-trigger-tag-changes state)
- (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
- (when org-provide-todo-statistics
- (org-update-parent-todo-statistics))
- (run-hooks 'org-after-todo-state-change-hook)
- (if (and arg (not (member state org-done-keywords)))
- (setq head (org-get-todo-sequence-head state)))
- (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
- ;; Do we need to trigger a repeat?
- (when now-done-p
- (when (boundp 'org-agenda-headline-snapshot-before-repeat)
- ;; This is for the agenda, take a snapshot of the headline.
- (save-match-data
- (setq org-agenda-headline-snapshot-before-repeat
- (org-get-heading))))
- (org-auto-repeat-maybe state))
- ;; Fixup cursor location if close to the keyword
- (if (and (outline-on-heading-p)
- (not (bolp))
- (save-excursion (beginning-of-line 1)
- (looking-at org-todo-line-regexp))
- (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
- (progn
- (goto-char (or (match-end 2) (match-end 1)))
- (and (looking-at " ") (just-one-space))))
- (when org-trigger-hook
- (save-excursion
- (run-hook-with-args 'org-trigger-hook change-plist))))))))
+ (not (member org-state org-done-keywords)))
+ (setq now-done-p (and (member org-state org-done-keywords)
+ (not (member this org-done-keywords))))
+ (and logging (org-local-logging logging))
+ (when (and (or org-todo-log-states org-log-done)
+ (not (eq org-inhibit-logging t))
+ (not (memq arg '(nextset previousset))))
+ ;; we need to look at recording a time and note
+ (setq dolog (or (nth 1 (assoc org-state org-todo-log-states))
+ (nth 2 (assoc this org-todo-log-states))))
+ (if (and (eq dolog 'note) (eq org-inhibit-logging 'note))
+ (setq dolog 'time))
+ (when (and org-state
+ (member org-state org-not-done-keywords)
+ (not (member this org-not-done-keywords)))
+ ;; This is now a todo state and was not one before
+ ;; If there was a CLOSED time stamp, get rid of it.
+ (org-add-planning-info nil nil 'closed))
+ (when (and now-done-p org-log-done)
+ ;; It is now done, and it was not done before
+ (org-add-planning-info 'closed (org-current-effective-time))
+ (if (and (not dolog) (eq 'note org-log-done))
+ (org-add-log-setup 'done org-state this 'findpos 'note)))
+ (when (and org-state dolog)
+ ;; This is a non-nil state, and we need to log it
+ (org-add-log-setup 'state org-state this 'findpos dolog)))
+ ;; Fixup tag positioning
+ (org-todo-trigger-tag-changes org-state)
+ (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
+ (when org-provide-todo-statistics
+ (org-update-parent-todo-statistics))
+ (run-hooks 'org-after-todo-state-change-hook)
+ (if (and arg (not (member org-state org-done-keywords)))
+ (setq head (org-get-todo-sequence-head org-state)))
+ (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
+ ;; Do we need to trigger a repeat?
+ (when now-done-p
+ (when (boundp 'org-agenda-headline-snapshot-before-repeat)
+ ;; This is for the agenda, take a snapshot of the headline.
+ (save-match-data
+ (setq org-agenda-headline-snapshot-before-repeat
+ (org-get-heading))))
+ (org-auto-repeat-maybe org-state))
+ ;; Fixup cursor location if close to the keyword
+ (if (and (outline-on-heading-p)
+ (not (bolp))
+ (save-excursion (beginning-of-line 1)
+ (looking-at org-todo-line-regexp))
+ (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
+ (progn
+ (goto-char (or (match-end 2) (match-end 1)))
+ (and (looking-at " ") (just-one-space))))
+ (when org-trigger-hook
+ (save-excursion
+ (run-hook-with-args 'org-trigger-hook change-plist)))))))))
(defun org-block-todo-from-children-or-siblings-or-parent (change-plist)
"Block turning an entry into a TODO, using the hierarchy.
@@ -11291,8 +11737,11 @@ changes because there are unchecked boxes in this entry."
(outline-next-heading)
(setq end (point))
(goto-char beg)
- (if (re-search-forward "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\[[- ]\\]"
- end t)
+ (if (org-list-search-forward
+ (concat (org-item-beginning-re)
+ "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
+ "\\[[- ]\\]")
+ end t)
(progn
(if (boundp 'org-blocked-by-checkboxes)
(setq org-blocked-by-checkboxes t))
@@ -11319,17 +11768,17 @@ This should be called with the cursor in a line with a statistics cookie."
(progn
(org-update-checkbox-count 'all)
(org-map-entries 'org-update-parent-todo-statistics))
- (if (not (org-on-heading-p))
+ (if (not (org-at-heading-p))
(org-update-checkbox-count)
(let ((pos (move-marker (make-marker) (point)))
end l1 l2)
(ignore-errors (org-back-to-heading t))
- (if (not (org-on-heading-p))
+ (if (not (org-at-heading-p))
(org-update-checkbox-count)
(setq l1 (org-outline-level))
(setq end (save-excursion
(outline-next-heading)
- (if (org-on-heading-p) (setq l2 (org-outline-level)))
+ (if (org-at-heading-p) (setq l2 (org-outline-level)))
(point)))
(if (and (save-excursion
(re-search-forward
@@ -11620,10 +12069,10 @@ of repeating deadline/scheduled time stamps to new date.
This function is run automatically after each state change to a DONE state."
;; last-state is dynamically scoped into this function
(let* ((repeat (org-get-repeat))
- (aa (assoc last-state org-todo-kwd-alist))
+ (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)
@@ -11633,7 +12082,7 @@ This function is run automatically after each state change to a DONE state."
(setq to-state (or (org-entry-get nil "REPEAT_TO_STATE")
org-todo-repeat-to-state))
(unless (and to-state (member to-state org-todo-keywords-1))
- (setq to-state (if (eq interpret 'type) last-state head)))
+ (setq to-state (if (eq interpret 'type) org-last-state head)))
(org-todo to-state)
(when (or org-log-repeat (org-entry-get nil "CLOCK"))
(org-entry-put nil "LAST_REPEAT" (format-time-string
@@ -11647,7 +12096,7 @@ This function is run automatically after each state change to a DONE state."
(setq org-log-note-how 'note))
;; Set up for taking a record
(org-add-log-setup 'state (or done-word (car org-done-keywords))
- last-state
+ org-last-state
'findpos org-log-repeat)))
(org-back-to-heading t)
(org-add-planning-info nil nil 'closed)
@@ -11659,10 +12108,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)))
@@ -11688,7 +12139,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)
@@ -11707,7 +12158,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 "|") "\\|")
"\\)\\>")))
@@ -11724,39 +12175,47 @@ With argument REMOVE, remove any deadline from the item.
With argument TIME, set the deadline at the corresponding date. TIME
can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(interactive "P")
- (let* ((old-date (org-entry-get nil "DEADLINE"))
- (repeater (and old-date
- (string-match
- "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
- old-date)
- (match-string 1 old-date))))
- (if remove
- (progn
- (when (and old-date org-log-redeadline)
- (org-add-log-setup 'deldeadline nil old-date 'findpos
- org-log-redeadline))
- (org-remove-timestamp-with-keyword org-deadline-string)
- (message "Item no longer has a deadline."))
- (org-add-planning-info 'deadline time 'closed)
- (when (and old-date org-log-redeadline
- (not (equal old-date
- (substring org-last-inserted-timestamp 1 -1))))
- (org-add-log-setup 'redeadline nil old-date 'findpos
- org-log-redeadline))
- (when repeater
- (save-excursion
- (org-back-to-heading t)
- (when (re-search-forward (concat org-deadline-string " "
- org-last-inserted-timestamp)
- (save-excursion
- (outline-next-heading) (point)) t)
- (goto-char (1- (match-end 0)))
- (insert " " repeater)
- (setq org-last-inserted-timestamp
- (concat (substring org-last-inserted-timestamp 0 -1)
- " " repeater
- (substring org-last-inserted-timestamp -1))))))
- (message "Deadline on %s" org-last-inserted-timestamp))))
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((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
+ `(org-deadline ',remove ,time)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (let* ((old-date (org-entry-get nil "DEADLINE"))
+ (repeater (and old-date
+ (string-match
+ "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
+ old-date)
+ (match-string 1 old-date))))
+ (if remove
+ (progn
+ (when (and old-date org-log-redeadline)
+ (org-add-log-setup 'deldeadline nil old-date 'findpos
+ org-log-redeadline))
+ (org-remove-timestamp-with-keyword org-deadline-string)
+ (message "Item no longer has a deadline."))
+ (org-add-planning-info 'deadline time 'closed)
+ (when (and old-date org-log-redeadline
+ (not (equal old-date
+ (substring org-last-inserted-timestamp 1 -1))))
+ (org-add-log-setup 'redeadline nil old-date 'findpos
+ org-log-redeadline))
+ (when repeater
+ (save-excursion
+ (org-back-to-heading t)
+ (when (re-search-forward (concat org-deadline-string " "
+ org-last-inserted-timestamp)
+ (save-excursion
+ (outline-next-heading) (point)) t)
+ (goto-char (1- (match-end 0)))
+ (insert " " repeater)
+ (setq org-last-inserted-timestamp
+ (concat (substring org-last-inserted-timestamp 0 -1)
+ " " repeater
+ (substring org-last-inserted-timestamp -1))))))
+ (message "Deadline on %s" org-last-inserted-timestamp)))))
(defun org-schedule (&optional remove time)
"Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
@@ -11764,39 +12223,47 @@ With argument REMOVE, remove any scheduling date from the item.
With argument TIME, scheduled at the corresponding date. TIME can
either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(interactive "P")
- (let* ((old-date (org-entry-get nil "SCHEDULED"))
- (repeater (and old-date
- (string-match
- "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
- old-date)
- (match-string 1 old-date))))
- (if remove
- (progn
- (when (and old-date org-log-reschedule)
- (org-add-log-setup 'delschedule nil old-date 'findpos
- org-log-reschedule))
- (org-remove-timestamp-with-keyword org-scheduled-string)
- (message "Item is no longer scheduled."))
- (org-add-planning-info 'scheduled time 'closed)
- (when (and old-date org-log-reschedule
- (not (equal old-date
- (substring org-last-inserted-timestamp 1 -1))))
- (org-add-log-setup 'reschedule nil old-date 'findpos
- org-log-reschedule))
- (when repeater
- (save-excursion
- (org-back-to-heading t)
- (when (re-search-forward (concat org-scheduled-string " "
- org-last-inserted-timestamp)
- (save-excursion
- (outline-next-heading) (point)) t)
- (goto-char (1- (match-end 0)))
- (insert " " repeater)
- (setq org-last-inserted-timestamp
- (concat (substring org-last-inserted-timestamp 0 -1)
- " " repeater
- (substring org-last-inserted-timestamp -1))))))
- (message "Scheduled to %s" org-last-inserted-timestamp))))
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((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
+ `(org-schedule ',remove ,time)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (let* ((old-date (org-entry-get nil "SCHEDULED"))
+ (repeater (and old-date
+ (string-match
+ "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
+ old-date)
+ (match-string 1 old-date))))
+ (if remove
+ (progn
+ (when (and old-date org-log-reschedule)
+ (org-add-log-setup 'delschedule nil old-date 'findpos
+ org-log-reschedule))
+ (org-remove-timestamp-with-keyword org-scheduled-string)
+ (message "Item is no longer scheduled."))
+ (org-add-planning-info 'scheduled time 'closed)
+ (when (and old-date org-log-reschedule
+ (not (equal old-date
+ (substring org-last-inserted-timestamp 1 -1))))
+ (org-add-log-setup 'reschedule nil old-date 'findpos
+ org-log-reschedule))
+ (when repeater
+ (save-excursion
+ (org-back-to-heading t)
+ (when (re-search-forward (concat org-scheduled-string " "
+ org-last-inserted-timestamp)
+ (save-excursion
+ (outline-next-heading) (point)) t)
+ (goto-char (1- (match-end 0)))
+ (insert " " repeater)
+ (setq org-last-inserted-timestamp
+ (concat (substring org-last-inserted-timestamp 0 -1)
+ " " repeater
+ (substring org-last-inserted-timestamp -1))))))
+ (message "Scheduled to %s" org-last-inserted-timestamp)))))
(defun org-get-scheduled-time (pom &optional inherit)
"Get the scheduled time as a time tuple, of a format suitable
@@ -11861,9 +12328,8 @@ be removed."
default-input (and ts (org-get-compact-tod ts))))))
(when what
(setq time
- (if (and (stringp time)
- (string-match "^[-+]+[0-9]" time))
- ;; This is a relative time, set the proper date
+ (if (stringp time)
+ ;; This is a string (relative or absolute), set proper date
(apply 'encode-time
(org-read-date-analyze
time default-time (decode-time default-time)))
@@ -11914,7 +12380,7 @@ be removed."
(re-search-forward org-closed-time-regexp nil t)))
(replace-match "")
(if (looking-at "--+<[^>]+>") (replace-match ""))))
- (and (looking-at "^[ \t]+") (replace-match ""))
+ (and (looking-at "[ \t]+") (replace-match ""))
(and org-adapt-indentation (bolp) (org-indent-to-column col))
(when what
(insert
@@ -11976,8 +12442,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
@@ -11999,9 +12464,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
@@ -12041,7 +12506,7 @@ EXTRA is additional text that will be inserted into the notes buffer."
(setq org-log-note-window-configuration (current-window-configuration))
(delete-other-windows)
(move-marker org-log-note-return-to (point))
- (switch-to-buffer (marker-buffer org-log-note-marker))
+ (org-pop-to-buffer-same-window (marker-buffer org-log-note-marker))
(goto-char org-log-note-marker)
(org-switch-to-buffer-other-window "*Org Note*")
(erase-buffer)
@@ -12071,7 +12536,8 @@ EXTRA is additional text that will be inserted into the notes buffer."
"this entry")
(t (error "This should not happen")))))
(if org-log-note-extra (insert org-log-note-extra))
- (org-set-local 'org-finish-function 'org-store-log-note)))
+ (org-set-local 'org-finish-function 'org-store-log-note)
+ (run-hooks 'org-log-buffer-setup-hook)))
(defvar org-note-abort nil) ; dynamically scoped
(defun org-store-log-note ()
@@ -12080,7 +12546,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)))
@@ -12097,6 +12563,12 @@ EXTRA is additional text that will be inserted into the notes buffer."
(cons "%T" (format-time-string
(org-time-stamp-format 'long nil)
org-log-note-effective-time))
+ (cons "%d" (format-time-string
+ (org-time-stamp-format nil 'inactive)
+ org-log-note-effective-time))
+ (cons "%D" (format-time-string
+ (org-time-stamp-format nil nil)
+ org-log-note-effective-time))
(cons "%s" (if org-log-note-state
(concat "\"" org-log-note-state "\"")
""))
@@ -12159,7 +12631,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:
@@ -12169,32 +12642,46 @@ 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")
+ (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)
(call-interactively 'org-check-before-date))
((equal ans ?a)
(call-interactively 'org-check-after-date))
+ ((equal ans ?D)
+ (call-interactively 'org-check-dates-range))
((equal ans ?t)
- (org-show-todo-tree nil))
+ (call-interactively 'org-show-todo-tree))
((equal ans ?T)
(org-show-todo-tree '(4)))
((member ans '(?T ?m))
(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)))
@@ -12286,9 +12773,9 @@ starting point when no match is found."
(defun org-show-context (&optional key)
"Make sure point and context are visible.
How much context is shown depends upon the variables
-`org-show-hierarchy-above', `org-show-following-heading'. and
-`org-show-siblings'."
- (let ((heading-p (org-on-heading-p t))
+`org-show-hierarchy-above', `org-show-following-heading',
+`org-show-entry-below' and `org-show-siblings'."
+ (let ((heading-p (org-at-heading-p t))
(hierarchy-p (org-get-alist-option org-show-hierarchy-above key))
(following-p (org-get-alist-option org-show-following-heading key))
(entry-p (org-get-alist-option org-show-entry-below key))
@@ -12379,10 +12866,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))
@@ -12459,7 +12948,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."
@@ -12476,7 +12979,7 @@ ACTION can be `set', `up', `down', or a character."
(defvar org-agenda-archives-mode)
(defvar org-map-continue-from nil
"Position from where mapping should continue.
-Can be set by the action argument to `org-scan-tag's and `org-map-entries'.")
+Can be set by the action argument to `org-scan-tags' and `org-map-entries'.")
(defvar org-scanner-tags nil
"The current tag list while the tags scanner is running.")
@@ -12491,7 +12994,7 @@ obtain a list of properties. Building the tags list for each entry in such
a file becomes an N^2 operation - but with this variable set, it scales
as N.")
-(defun org-scan-tags (action matcher &optional todo-only)
+(defun org-scan-tags (action matcher todo-only &optional start-level)
"Scan headline tags with inheritance and produce output ACTION.
ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
@@ -12501,18 +13004,28 @@ this case the return value is a list of all return values from these calls.
MATCHER is a Lisp form to be evaluated, testing if a given set of tags
qualifies a headline for inclusion. When TODO-ONLY is non-nil,
-only lines with a TODO keyword are included in the output."
+only lines with a not-done TODO keyword are included in the output.
+This should be the same variable that was scoped into
+and set by `org-make-tags-matcher' when it constructed MATCHER.
+
+START-LEVEL can be a string with asterisks, reducing the scope to
+headlines matching this string."
(require 'org-agenda)
- (let* ((re (concat "^" org-outline-regexp " *\\(\\<\\("
+ (let* ((re (concat "^"
+ (if start-level
+ ;; Get the correct level to match
+ (concat "\\*\\{" (number-to-string start-level) "\\} ")
+ org-outline-regexp)
+ " *\\(\\<\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
- (org-re
- "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")))
+ (org-re "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")))
(props (list 'face 'default
'done-face 'org-agenda-done
'undone-face 'default
'mouse-face 'highlight
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
+ 'org-complex-heading-regexp org-complex-heading-regexp
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name
@@ -12532,6 +13045,7 @@ only lines with a TODO keyword are included in the output."
(org-overview)
(org-remove-occur-highlights))
(while (re-search-forward re nil t)
+ (setq org-map-continue-from nil)
(catch :skip
(setq todo (if (match-end 1) (org-match-string-no-properties 2))
tags (if (match-end 4) (org-match-string-no-properties 4)))
@@ -12571,7 +13085,8 @@ only lines with a TODO keyword are included in the output."
;; 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
@@ -12600,18 +13115,17 @@ only lines with a TODO keyword are included in the output."
(and org-highlight-sparse-tree-matches
(org-get-heading) (match-end 0)
(org-highlight-new-match
- (match-beginning 0) (match-beginning 1)))
+ (match-beginning 1) (match-end 1)))
(org-show-context 'tags-tree))
((eq action 'agenda)
- (setq txt (org-format-agenda-item
+ (setq txt (org-agenda-format-item
""
(concat
(if (eq org-tags-match-list-sublevels 'indented)
(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))
@@ -12661,8 +13175,6 @@ only lines with a TODO keyword are included in the output."
(if (member x org-use-tag-inheritance) x nil))
tags)))))
-(defvar todo-only) ;; dynamically scoped
-
(defun org-match-sparse-tree (&optional todo-only match)
"Create a sparse tree according to tags string MATCH.
MATCH can contain positive and negative selection of tags, like
@@ -12670,7 +13182,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)
@@ -12691,7 +13203,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
@@ -12709,9 +13221,28 @@ instead of the agenda files."
(org-agenda-files))))))))
(defun org-make-tags-matcher (match)
- "Create the TAGS/TODO matcher form for the selection string MATCH."
- ;; todo-only is scoped dynamically into this function, and the function
- ;; may change it if the matcher asks for it.
+ "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,
+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
+of the entry (if any) must be specified as the text property
+'org-category on the headline.
+
+See also `org-scan-tags'.
+"
+ (declare (special todo-only))
+ (unless (boundp 'todo-only)
+ (error "org-make-tags-matcher expects todo-only to be scoped in"))
(unless match
;; Get a new match request, with completion
(let ((org-last-tags-completion-table
@@ -12828,6 +13359,9 @@ instead of the agenda files."
(setq matcher (if todomatcher
(list 'and tagsmatcher todomatcher)
tagsmatcher))
+ (when todo-only
+ (setq matcher (list 'and '(member todo org-not-done-keywords)
+ matcher)))
(cons match0 matcher)))
(defun org-op-to-function (op &optional stringp)
@@ -12880,7 +13414,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)
@@ -12996,7 +13530,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state."
(goto-char (match-beginning 1))
(insert " ")
(delete-region (point) (1+ (match-beginning 2)))
- (setq ncol (max (1+ (current-column))
+ (setq ncol (max (current-column)
(1+ col)
(if (> to-col 0)
to-col
@@ -13011,7 +13545,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-on-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)
@@ -13030,8 +13564,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)
@@ -13055,7 +13588,7 @@ If DATA is nil or the empty string, any tags will be removed."
(save-excursion
(or (ignore-errors (org-back-to-heading t))
(outline-next-heading))
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(org-set-tags t)
(message "No headings"))))
@@ -13064,94 +13597,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 t))
- (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.
@@ -13159,7 +13702,7 @@ This works in the agenda, and also in an org-mode buffer."
(interactive
(list (region-beginning) (region-end)
(let ((org-last-tags-completion-table
- (if (org-mode-p)
+ (if (derived-mode-p 'org-mode)
(org-get-buffer-tags)
(org-global-tags-completion-table))))
(org-icompleting-read
@@ -13178,7 +13721,7 @@ This works in the agenda, and also in an org-mode buffer."
(loop for l from l1 to l2 do
(org-goto-line l)
(setq m (get-text-property (point) 'org-hd-marker))
- (when (or (and (org-mode-p) (org-on-heading-p))
+ (when (or (and (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)))
@@ -13337,8 +13880,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)) ?\ ))
@@ -13439,7 +13981,7 @@ Returns the new tags string, or nil to not change the current settings."
(defun org-get-tags-string ()
"Get the TAGS string in the current headline."
- (unless (org-on-heading-p t)
+ (unless (org-at-heading-p t)
(error "Not on a heading"))
(save-excursion
(beginning-of-line 1)
@@ -13466,7 +14008,6 @@ Returns the new tags string, or nil to not change the current settings."
;;;; The mapping API
-;;;###autoload
(defun org-map-entries (func &optional match scope &rest skip)
"Call FUNC at each headline selected by MATCH in SCOPE.
@@ -13496,6 +14037,9 @@ SCOPE determines the scope of this command. It can be any of:
nil The current buffer, respecting the restriction if any
tree The subtree started with the entry at point
region The entries within the active region, if any
+region-start-level
+ The entries within the active region, but only those at
+ the same level than the first one.
file The current buffer, without restriction
file-with-archives
The current buffer, and any archives associated with it
@@ -13524,61 +14068,77 @@ with `org-get-tags-at'. If your function gets properties with
to t around the call to `org-entry-properties' to get the same speedup.
Note that if your function moves around to retrieve tags and properties at
a *different* entry, you cannot use these techniques."
- (let* ((org-agenda-archives-mode nil) ; just to make sure
- (org-agenda-skip-archived-trees (memq 'archive skip))
- (org-agenda-skip-comment-trees (memq 'comment skip))
- (org-agenda-skip-function
- (car (org-delete-all '(comment archive) skip)))
- (org-tags-match-list-sublevels t)
- matcher file res
- org-todo-keywords-for-agenda
- org-done-keywords-for-agenda
- org-todo-keyword-alist-for-agenda
- org-drawers-for-agenda
- org-tag-alist-for-agenda)
+ (unless (and (or (eq scope 'region) (eq scope 'region-start-level))
+ (not (org-region-active-p)))
+ (let* ((org-agenda-archives-mode nil) ; just to make sure
+ (org-agenda-skip-archived-trees (memq 'archive skip))
+ (org-agenda-skip-comment-trees (memq 'comment skip))
+ (org-agenda-skip-function
+ (car (org-delete-all '(comment archive) skip)))
+ (org-tags-match-list-sublevels t)
+ (start-level (eq scope 'region-start-level))
+ matcher file res
+ org-todo-keywords-for-agenda
+ org-done-keywords-for-agenda
+ org-todo-keyword-alist-for-agenda
+ org-drawers-for-agenda
+ org-tag-alist-for-agenda
+ todo-only)
- (cond
- ((eq match t) (setq matcher t))
- ((eq match nil) (setq matcher t))
- (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
+ (cond
+ ((eq match t) (setq matcher t))
+ ((eq match nil) (setq matcher t))
+ (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
- (save-excursion
- (save-restriction
- (cond ((eq scope 'tree)
- (org-back-to-heading t)
- (org-narrow-to-subtree)
- (setq scope nil))
- ((and (eq scope 'region) (org-region-active-p))
- (narrow-to-region (region-beginning) (region-end))
- (setq scope nil)))
-
- (if (not scope)
- (progn
- (org-prepare-agenda-buffers
- (list (buffer-file-name (current-buffer))))
- (setq res (org-scan-tags func matcher)))
- ;; Get the right scope
- (cond
- ((and scope (listp scope) (symbolp (car scope)))
- (setq scope (eval scope)))
- ((eq scope 'agenda)
- (setq scope (org-agenda-files t)))
- ((eq scope 'agenda-with-archives)
- (setq scope (org-agenda-files t))
- (setq scope (org-add-archive-files scope)))
- ((eq scope 'file)
- (setq scope (list (buffer-file-name))))
- ((eq scope 'file-with-archives)
- (setq scope (org-add-archive-files (list (buffer-file-name))))))
- (org-prepare-agenda-buffers scope)
- (while (setq file (pop scope))
- (with-current-buffer (org-find-base-buffer-visiting file)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (setq res (append res (org-scan-tags func matcher))))))))))
- res))
+ (save-excursion
+ (save-restriction
+ (cond ((eq scope 'tree)
+ (org-back-to-heading t)
+ (org-narrow-to-subtree)
+ (setq scope nil))
+ ((and (or (eq scope 'region) (eq scope 'region-start-level))
+ (org-region-active-p))
+ ;; If needed, set start-level to a string like "2"
+ (when start-level
+ (save-excursion
+ (goto-char (region-beginning))
+ (unless (org-at-heading-p) (outline-next-heading))
+ (setq start-level (org-current-level))))
+ (narrow-to-region (region-beginning)
+ (save-excursion
+ (goto-char (region-end))
+ (unless (and (bolp) (org-at-heading-p))
+ (outline-next-heading))
+ (point)))
+ (setq scope nil)))
+
+ (if (not scope)
+ (progn
+ (org-agenda-prepare-buffers
+ (list (buffer-file-name (current-buffer))))
+ (setq res (org-scan-tags func matcher todo-only start-level)))
+ ;; Get the right scope
+ (cond
+ ((and scope (listp scope) (symbolp (car scope)))
+ (setq scope (eval scope)))
+ ((eq scope 'agenda)
+ (setq scope (org-agenda-files t)))
+ ((eq scope 'agenda-with-archives)
+ (setq scope (org-agenda-files t))
+ (setq scope (org-add-archive-files scope)))
+ ((eq scope 'file)
+ (setq scope (list (buffer-file-name))))
+ ((eq scope 'file-with-archives)
+ (setq scope (org-add-archive-files (list (buffer-file-name))))))
+ (org-agenda-prepare-buffers scope)
+ (while (setq file (pop scope))
+ (with-current-buffer (org-find-base-buffer-visiting file)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (setq res (append res (org-scan-tags func matcher todo-only))))))))))
+ res)))
;;;; Properties
@@ -13586,7 +14146,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,
@@ -13626,10 +14186,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)
@@ -13648,10 +14213,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)
@@ -13665,6 +14237,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) "")
@@ -13681,7 +14256,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)
@@ -13701,13 +14276,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)))
@@ -13724,7 +14302,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)))))
@@ -13745,14 +14323,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 (org-mode-p) (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))
@@ -13787,11 +14366,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
@@ -13812,8 +14390,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: ...
@@ -13830,14 +14407,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
@@ -13857,19 +14439,26 @@ 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))))
- (if (and range
- (goto-char (car range))
- (re-search-forward
- (org-re-property property)
- (cdr range) t))
- ;; Found the property, return it.
- (if (match-end 1)
- (if literal-nil
- (org-match-string-no-properties 1)
- (org-not-nil (org-match-string-no-properties 1)))
- "")))))))
+ (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
+ (org-update-property-plist
+ key
+ (if (match-end 1)
+ (org-match-string-no-properties 1) "")
+ props)))))
+ 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.
@@ -13964,24 +14553,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))
@@ -14011,7 +14601,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)
@@ -14035,17 +14625,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)
@@ -14111,11 +14701,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))
@@ -14149,6 +14738,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:
@@ -14221,8 +14875,11 @@ xxx_ALL property) or on existing values in other instances of this property
in the current file."
(interactive (list nil nil))
(let* ((property (or property (org-read-property-name)))
- (value (or value (org-read-property-value property))))
+ (value (or value (org-read-property-value property)))
+ (fn (cdr (assoc property org-properties-postprocess-alist))))
(setq org-last-set-property property)
+ ;; Possibly postprocess the inserted value:
+ (when fn (setq value (funcall fn value)))
(unless (equal (org-entry-get nil property) value)
(org-entry-put nil property value))))
@@ -14255,7 +14912,7 @@ in the current file."
(org-re-property property)
nil t)
(setq cnt (1+ cnt))
- (replace-match ""))
+ (delete-region (match-beginning 0) (1+ (point-at-eol))))
(message "Property \"%s\" removed from %d entries" property cnt)))))
(defvar org-columns-current-fmt-compiled) ; defined in org-colview.el
@@ -14340,7 +14997,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)))
@@ -14387,7 +15044,7 @@ only headings."
(goto-char found)
(setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
(setq end (save-excursion (org-end-of-subtree t t))))
- (when (org-on-heading-p)
+ (when (org-at-heading-p)
(move-marker (make-marker) (point))))))))
(defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only)
@@ -14459,13 +15116,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
@@ -14483,7 +15147,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)
@@ -14493,14 +15157,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
@@ -14511,9 +15175,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))))))
@@ -14544,7 +15210,7 @@ So these are more for recording a certain time/date."
(org-time-stamp arg 'inactive))
(defvar org-date-ovl (make-overlay 1 1))
-(overlay-put org-date-ovl 'face 'org-warning)
+(overlay-put org-date-ovl 'face 'org-date-selected)
(org-detach-overlay org-date-ovl)
(defvar org-ans1) ; dynamically scoped parameter
@@ -14559,15 +15225,16 @@ 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 with-time to-time from-string prompt
- default-time default-input)
+(defun org-read-date (&optional org-with-time to-time from-string prompt
+ 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'.
Unrecognized parts of the date will default to the current day, month, year,
hour and minute. If this command is called to replace a timestamp at point,
-of to enter the second timestamp of a range, the default time is taken
+or to enter the second timestamp of a range, the default time is taken
from the existing stamp. Furthermore, the command prefers the future,
so if you are giving a date where the year is not given, and the day-month
combination is already past in the current year, it will assume you
@@ -14584,7 +15251,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.
@@ -14593,9 +15260,7 @@ plus or minus, it is relative to the date in DEFAULT-TIME. E.g.
+2w --> two weeks from today
++5 --> five days from default date
-The function understands only English month and weekday abbreviations,
-but this can be configured with the variables `parse-time-months' and
-`parse-time-weekdays'.
+The function understands only English month and weekday abbreviations.
While prompting, a calendar is popped up - you can also select the
date with the mouse (button 1). The calendar shows a period of three
@@ -14605,35 +15270,35 @@ 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
user."
(require 'parse-time)
(let* ((org-time-stamp-rounding-minutes
- (if (equal with-time '(16)) '(0 0) org-time-stamp-rounding-minutes))
+ (if (equal org-with-time '(16)) '(0 0) org-time-stamp-rounding-minutes))
(org-dcst org-display-custom-times)
(ct (org-current-time))
- (def (or org-overriding-default-time default-time ct))
- (defdecode (decode-time def))
+ (org-def (or org-overriding-default-time default-time ct))
+ (org-defdecode (decode-time org-def))
(dummy (progn
- (when (< (nth 2 defdecode) org-extend-today-until)
- (setcar (nthcdr 2 defdecode) -1)
- (setcar (nthcdr 1 defdecode) 59)
- (setq def (apply 'encode-time defdecode)
- defdecode (decode-time def)))))
+ (when (< (nth 2 org-defdecode) org-extend-today-until)
+ (setcar (nthcdr 2 org-defdecode) -1)
+ (setcar (nthcdr 1 org-defdecode) 59)
+ (setq org-def (apply 'encode-time org-defdecode)
+ org-defdecode (decode-time org-def)))))
(calendar-frame-setup nil)
(calendar-setup nil)
(calendar-move-hook nil)
(calendar-view-diary-initially-flag nil)
(calendar-view-holidays-initially-flag nil)
(timestr (format-time-string
- (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def))
+ (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") org-def))
(prompt (concat (if prompt (concat prompt " ") "")
(format "Date+time [%s]: " timestr)))
ans (org-ans0 "") org-ans1 org-ans2 final)
@@ -14644,9 +15309,10 @@ 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 def)
+ (calendar-forward-day (- (time-to-days org-def)
(calendar-absolute-from-gregorian
(calendar-current-date))))
(org-eval-in-calendar nil t)
@@ -14710,6 +15376,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))
@@ -14732,7 +15399,7 @@ user."
(delete-overlay org-read-date-overlay)
(setq org-read-date-overlay nil)))))
- (setq final (org-read-date-analyze ans def defdecode))
+ (setq final (org-read-date-analyze ans org-def org-defdecode))
(when org-read-date-analyze-forced-year
(message "Year was forced into %s"
@@ -14754,45 +15421,47 @@ user."
(nth 2 final) (nth 1 final))
(format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))))
-(defvar def)
-(defvar defdecode)
-(defvar with-time)
+(defvar org-def)
+(defvar org-defdecode)
+(defvar org-with-time)
(defun org-read-date-display ()
"Display the current date prompt interpretation in the minibuffer."
(when org-read-date-display-live
(when org-read-date-overlay
(delete-overlay org-read-date-overlay))
- (let ((p (point)))
- (end-of-line 1)
- (while (not (equal (buffer-substring
- (max (point-min) (- (point) 4)) (point))
- " "))
- (insert " "))
- (goto-char p))
- (let* ((ans (concat (buffer-substring (point-at-bol) (point-max))
- " " (or org-ans1 org-ans2)))
- (org-end-time-was-given nil)
- (f (org-read-date-analyze ans def defdecode))
- (fmts (if org-dcst
- org-time-stamp-custom-formats
- org-time-stamp-formats))
- (fmt (if (or with-time
- (and (boundp 'org-time-was-given) org-time-was-given))
- (cdr fmts)
- (car fmts)))
- (txt (concat "=> " (format-time-string fmt (apply 'encode-time f)))))
- (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)) "-"
- org-end-time-was-given
- (substring txt (match-end 0)))))
- (when org-read-date-analyze-futurep
- (setq txt (concat txt " (=>F)")))
- (setq org-read-date-overlay
- (make-overlay (1- (point-at-eol)) (point-at-eol)))
- (org-overlay-display org-read-date-overlay txt 'secondary-selection))))
-
-(defun org-read-date-analyze (ans def defdecode)
+ (when (minibufferp (current-buffer))
+ (save-excursion
+ (end-of-line 1)
+ (while (not (equal (buffer-substring
+ (max (point-min) (- (point) 4)) (point))
+ " "))
+ (insert " ")))
+ (let* ((ans (concat (buffer-substring (point-at-bol) (point-max))
+ " " (or org-ans1 org-ans2)))
+ (org-end-time-was-given nil)
+ (f (org-read-date-analyze ans org-def org-defdecode))
+ (fmts (if org-dcst
+ org-time-stamp-custom-formats
+ org-time-stamp-formats))
+ (fmt (if (or org-with-time
+ (and (boundp 'org-time-was-given) org-time-was-given))
+ (cdr fmts)
+ (car fmts)))
+ (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)) "-"
+ org-end-time-was-given
+ (substring txt (match-end 0)))))
+ (when org-read-date-analyze-futurep
+ (setq txt (concat txt " (=>F)")))
+ (setq org-read-date-overlay
+ (make-overlay (1- (point-at-eol)) (point-at-eol)))
+ (org-overlay-display org-read-date-overlay txt 'secondary-selection)))))
+
+(defun org-read-date-analyze (ans org-def org-defdecode)
"Analyze the combined answer of the date prompt."
;; FIXME: cleanup and comment
(let ((nowdecode (decode-time (current-time)))
@@ -14804,15 +15473,15 @@ user."
(when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans)
(setq ans "+0"))
- (when (setq delta (org-read-date-get-relative ans (current-time) def))
+ (when (setq delta (org-read-date-get-relative ans (current-time) org-def))
(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
@@ -14837,15 +15506,14 @@ user."
;; Help matching dotted european dates
(when (string-match
- "^ *\\(3[01]\\|0?[1-9]\\|[12][0-9]\\)\\. ?\\(0?[1-9]\\|1[012]\\)\\. ?\\([1-9][0-9][0-9][0-9]\\)?" ans)
- (setq year (if (match-end 3)
- (string-to-number (match-string 3 ans))
- (progn (setq kill-year t)
- (string-to-number (format-time-string "%Y"))))
+ "^ *\\(3[01]\\|0?[1-9]\\|[12][0-9]\\)\\. ?\\(0?[1-9]\\|1[012]\\)\\.\\( ?[1-9][0-9]\\{3\\}\\)?" ans)
+ (setq year (if (match-end 3) (string-to-number (match-string 3 ans))
+ (setq kill-year t)
+ (string-to-number (format-time-string "%Y")))
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)))
+ ans (replace-match (format "%04d-%02d-%02d" year month day)
+ t nil ans)))
;; Help matching american dates, like 5/30 or 5/30/7
(when (string-match
@@ -14898,19 +15566,19 @@ user."
(substring ans (match-end 7))))))
(setq tl (parse-time-string ans)
- day (or (nth 3 tl) (nth 3 defdecode))
+ day (or (nth 3 tl) (nth 3 org-defdecode))
month (or (nth 4 tl)
(if (and org-read-date-prefer-future
(nth 3 tl) (< (nth 3 tl) (nth 3 nowdecode)))
(prog1 (1+ (nth 4 nowdecode)) (setq futurep t))
- (nth 4 defdecode)))
+ (nth 4 org-defdecode)))
year (or (and (not kill-year) (nth 5 tl))
(if (and org-read-date-prefer-future
(nth 4 tl) (< (nth 4 tl) (nth 4 nowdecode)))
(prog1 (1+ (nth 5 nowdecode)) (setq futurep t))
- (nth 5 defdecode)))
- hour (or (nth 2 tl) (nth 2 defdecode))
- minute (or (nth 1 tl) (nth 1 defdecode))
+ (nth 5 org-defdecode)))
+ hour (or (nth 2 tl) (nth 2 org-defdecode))
+ minute (or (nth 1 tl) (nth 1 org-defdecode))
second (or (nth 0 tl) 0)
wday (nth 6 tl))
@@ -14939,15 +15607,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)))
@@ -14961,7 +15629,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))))
@@ -14981,13 +15648,12 @@ user."
(condition-case nil
(ignore (encode-time second minute hour day month year))
(error
- (setq year (nth 5 defdecode))
+ (setq year (nth 5 org-defdecode))
(setq org-read-date-analyze-forced-year t))))
(setq org-read-date-analyze-futurep futurep)
(list second minute hour day month year)))
(defvar parse-time-weekdays)
-
(defun org-read-date-get-relative (s today default)
"Check string S for special relative date string.
TODAY and DEFAULT are internal times, for today and for a default.
@@ -14996,12 +15662,13 @@ WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year.
N is the number of WHATs to shift.
DEF-FLAG is t when a double ++ or -- indicates shift relative to
the DEFAULT date rather than TODAY."
+ (require 'parse-time)
(when (and
(string-match
(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))
@@ -15035,14 +15702,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))
@@ -15118,7 +15786,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)
@@ -15189,7 +15857,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)
@@ -15230,16 +15898,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)))
@@ -15248,17 +15934,34 @@ 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)))
+(defun org-check-dates-range (start-date end-date)
+ "Check for deadlines/scheduled entries between START-DATE and END-DATE."
+ (interactive (list (org-read-date nil nil nil "Range starts")
+ (org-read-date nil nil nil "Range end")))
+ (let ((case-fold-search nil)
+ (regexp (org-re-timestamp org-ts-type))
+ (callback
+ (lambda ()
+ (let ((match (match-string 1)))
+ (and
+ (not (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time start-date)))
+ (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time end-date)))))))
+ (message "%d entries between %s and %s"
+ (org-occur regexp nil callback) start-date end-date)))
+
(defun org-evaluate-time-range (&optional to-buffer)
"Evaluate a time range by computing the difference between start and end.
Normally the result is just printed in the echo area, but with prefix arg
@@ -15336,12 +16039,21 @@ days in order to avoid rounding problems."
l (push m l)))
(apply 'format fmt (nreverse l))))
-(defun org-time-string-to-time (s)
- (apply 'encode-time (org-parse-time-string s)))
+(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"
+ s (if (not (and buffer pos))
+ ""
+ (format " at %d in buffer `%s'" pos buffer))
+ (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)
+(defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos)
"Convert a time stamp to an absolute day number.
If there is a specifier for a cyclic time stamp, get the closest date to
DAYNR.
@@ -15352,11 +16064,18 @@ 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))
- (t (time-to-days (apply 'encode-time (org-parse-time-string s))))))
+ (t (time-to-days
+ (condition-case errdata
+ (apply 'encode-time (org-parse-time-string s))
+ (error (error "Bad timestamp `%s'%s\nError was: %s"
+ s (if (not (and buffer pos))
+ ""
+ (format " at %d in buffer `%s'" pos buffer))
+ (cdr errdata))))))))
(defun org-days-to-iso-week (days)
"Return the iso week number."
@@ -15408,8 +16127,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.
@@ -15442,7 +16160,12 @@ When PREFER is `future', return a date that is either CURRENT or future.
When SHOW-ALL is nil, only return the current occurrence of a time stamp."
;; Make the proper lists from the dates
(catch 'exit
- (let ((a1 '(("d" . day) ("w" . week) ("m" . month) ("y" . year)))
+ (let ((a1 '(("h" . hour)
+ ("d" . day)
+ ("w" . week)
+ ("m" . month)
+ ("y" . year)))
+ (shour (nth 2 (org-parse-time-string start)))
dn dw sday cday n1 n2 n0
d m y y1 y2 date1 date2 nmonths nm ny m2)
@@ -15456,12 +16179,19 @@ 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))
(if (eq dw 'week) (setq dw 'day dn (* 7 dn)))
(cond
+ ((eq dw 'hour)
+ (let ((missing-hours
+ (mod (+ (- (* 24 (- cday sday)) shour) org-extend-today-until)
+ dn)))
+ (setq n1 (if (zerop missing-hours) cday
+ (- cday (1+ (floor (/ missing-hours 24)))))
+ n2 (+ cday (floor (/ (- dn missing-hours) 24))))))
((eq dw 'day)
(setq n1 (+ sday (* dn (floor (/ (- cday sday) dn))))
n2 (+ n1 dn)))
@@ -15552,7 +16282,7 @@ With prefix ARG, change by that many units."
With prefix ARG, change that many days."
(interactive "p")
(if (and (not (org-at-timestamp-p t))
- (org-on-heading-p))
+ (org-at-heading-p))
(org-todo 'up)
(org-timestamp-change (prefix-numeric-value arg) 'day 'updown)))
@@ -15561,7 +16291,7 @@ With prefix ARG, change that many days."
With prefix ARG, change that many days."
(interactive "p")
(if (and (not (org-at-timestamp-p t))
- (org-on-heading-p))
+ (org-at-heading-p))
(org-todo 'down)
(org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown))
@@ -15579,19 +16309,22 @@ With prefix ARG, change that many days."
(and ans
(boundp 'org-ts-what)
(setq org-ts-what
- (cond
- ((= pos (match-beginning 0)) 'bracket)
- ((= pos (1- (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 ()
@@ -15608,6 +16341,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',
@@ -15618,7 +16353,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))
@@ -15637,7 +16372,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)
@@ -15700,6 +16435,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)
@@ -15745,14 +16513,12 @@ in the timestamp determines what will be changed."
(defun org-recenter-calendar (date)
"If the calendar is visible, recenter it to DATE."
- (let* ((win (selected-window))
- (cwin (get-buffer-window "*Calendar*" t))
- (calendar-move-hook nil))
+ (let ((cwin (get-buffer-window "*Calendar*" t)))
(when cwin
- (select-window cwin)
- (calendar-goto-date (if (listp date) date
- (calendar-gregorian-from-absolute date)))
- (select-window win))))
+ (let ((calendar-move-hook nil))
+ (with-selected-window cwin
+ (calendar-goto-date (if (listp date) date
+ (calendar-gregorian-from-absolute date))))))))
(defun org-goto-calendar (&optional arg)
"Go to the Emacs calendar at the current date.
@@ -15829,10 +16595,11 @@ minutes.
For example, if the value of this variable is ((\"hours\" . 60)), then an
effort string \"2hours\" is equivalent to 120 minutes."
:group 'org-agenda
+ :version "24.1"
: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
@@ -15841,15 +16608,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
@@ -15857,7 +16625,7 @@ Entries containing a colon are interpreted as H:MM by
"Save all Org-mode buffers without user confirmation."
(interactive)
(message "Saving all Org-mode buffers...")
- (save-some-buffers t 'org-mode-p)
+ (save-some-buffers t (lambda () (derived-mode-p 'org-mode)))
(when (featurep 'org-id) (org-id-locations-save))
(message "Saving all Org-mode buffers... done"))
@@ -15881,9 +16649,9 @@ changes from another. I believe the procedure must be like this:
(save-window-excursion
(mapc
(lambda (b)
- (when (and (with-current-buffer b (org-mode-p))
+ (when (and (with-current-buffer b (derived-mode-p 'org-mode))
(with-current-buffer b buffer-file-name))
- (switch-to-buffer b)
+ (org-pop-to-buffer-same-window b)
(revert-buffer t 'no-confirm)))
(buffer-list))
(when (and (featurep 'org-id) org-id-track-globally)
@@ -15894,7 +16662,7 @@ changes from another. I believe the procedure must be like this:
;;;###autoload
(defun org-switchb (&optional arg)
"Switch between Org buffers.
-With a prefix argument, restrict available to files.
+With one prefix argument, restrict available buffers to files.
With two prefix arguments, restrict available buffers to agenda files.
Defaults to `iswitchb' for buffer name completion.
@@ -15907,7 +16675,7 @@ Set `org-completion-use-ido' to make it use ido instead."
(org-completion-use-ido org-completion-use-ido))
(unless (or org-completion-use-ido org-completion-use-iswitchb)
(setq org-completion-use-iswitchb t))
- (switch-to-buffer
+ (org-pop-to-buffer-same-window
(org-icompleting-read "Org buffer: "
(mapcar 'list (mapcar 'buffer-name blist))
nil t))))
@@ -15933,17 +16701,17 @@ If EXCLUDE-TMP is non-nil, ignore temporary buffers."
(filter
(cond
((eq predicate 'files)
- (lambda (b) (with-current-buffer b (org-mode-p))))
+ (lambda (b) (with-current-buffer b (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 (org-mode-p)
+ (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 (org-mode-p)
+ (or (derived-mode-p 'org-mode)
(string-match "\*Org .*Export"
(buffer-name b)))))))))
(delq nil
@@ -16074,7 +16842,7 @@ If the current buffer does not, find the first agenda file."
(find-file (car files))
(throw 'exit t))))
(find-file (car fs)))
- (if (buffer-base-buffer) (switch-to-buffer (buffer-base-buffer)))))
+ (if (buffer-base-buffer) (org-pop-to-buffer-same-window (buffer-base-buffer)))))
(defun org-agenda-file-to-front (&optional to-end)
"Move/add the current file to the top of the agenda file list.
@@ -16086,7 +16854,9 @@ end of the list."
(file-alist (mapcar (lambda (x)
(cons (file-truename x) x))
(org-agenda-files t)))
- (ctf (file-truename buffer-file-name))
+ (ctf (file-truename
+ (or buffer-file-name
+ (error "Please save the current buffer to a file"))))
x had)
(setq x (assoc ctf file-alist) had x)
@@ -16105,7 +16875,8 @@ These are the files which are being checked for agenda entries.
Optional argument FILE means use this file instead of the current."
(interactive)
(let* ((org-agenda-skip-unavailable-files nil)
- (file (or file buffer-file-name))
+ (file (or file buffer-file-name
+ (error "Current buffer does not visit a file")))
(true-file (file-truename file))
(afile (abbreviate-file-name file))
(files (delq nil (mapcar
@@ -16127,7 +16898,7 @@ Optional argument FILE means use this file instead of the current."
(defun org-check-agenda-file (file)
"Make sure FILE exists. If not, ask user what to do."
(when (not (file-exists-p file))
- (message "non-existent agenda file %s. [R]emove from list or [A]bort?"
+ (message "Non-existent agenda file %s. [R]emove from list or [A]bort?"
(abbreviate-file-name file))
(let ((r (downcase (read-char-exclusive))))
(cond
@@ -16160,7 +16931,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))
@@ -16168,7 +16939,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))
@@ -16196,10 +16967,11 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(when org-agenda-skip-archived-trees
(goto-char (point-min))
(while (re-search-forward rea nil t)
- (if (org-on-heading-p t)
+ (if (org-at-heading-p t)
(add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
(goto-char (point-min))
- (setq re (concat org-outline-regexp-bol "+" org-comment-string "\\>"))
+ (setq re (format org-heading-keyword-regexp-format
+ org-comment-string))
(while (re-search-forward re nil t)
(add-text-properties
(match-beginning 0) (org-end-of-subtree t) pc)))
@@ -16230,7 +17002,10 @@ This mode supports entering LaTeX environment and math in LaTeX fragments
in Org-mode.
\\{org-cdlatex-mode-map}"
nil " OCDL" nil
- (when org-cdlatex-mode (require 'cdlatex))
+ (when org-cdlatex-mode
+ (require 'cdlatex)
+ (run-hooks 'cdlatex-mode-hook)
+ (cdlatex-compute-tables))
(unless org-cdlatex-texmathp-advice-is-done
(setq org-cdlatex-texmathp-advice-is-done t)
(defadvice texmathp (around org-math-always-on activate)
@@ -16242,7 +17017,7 @@ an embedded LaTeX fragment, let texmathp do its job.
(interactive)
(let (p)
(cond
- ((not (org-mode-p)) 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)))
@@ -16315,14 +17090,16 @@ It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is
insert a LaTeX environment."
(when org-cdlatex-mode
(cond
+ ;; Before any word on the line: No expansion possible.
+ ((save-excursion (skip-chars-backward " \t") (bolp)) nil)
+ ;; Just after first word on the line: Expand it. Make sure it
+ ;; cannot happen on headlines, though.
((save-excursion
(skip-chars-backward "a-zA-Z0-9*")
(skip-chars-backward " \t")
- (bolp))
- (cdlatex-tab) t)
- ((org-inside-LaTeX-fragment-p)
+ (and (bolp) (not (org-at-heading-p))))
(cdlatex-tab) t)
- (t nil))))
+ ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t))))
(defun org-cdlatex-underscore-caret (&optional arg)
"Execute `cdlatex-sub-superscript' in LaTeX fragments.
@@ -16362,6 +17139,8 @@ the cursor is before the first headline,
display all fragments in the buffer.
The images can be removed again with \\[org-ctrl-c-ctrl-c]."
(interactive "P")
+ (unless buffer-file-name
+ (error "Can't preview LaTeX fragment in a non-file buffer"))
(org-remove-latex-fragment-image-overlays)
(save-excursion
(save-restriction
@@ -16387,18 +17166,19 @@ 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)
;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil)
;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
- ("$1" "\\([^$]\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
- ("$" "\\([^$]\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
+ ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
+ ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
@@ -16421,11 +17201,11 @@ Some of the options can be changed using the variable
(plist-get (org-infile-export-plist) :latex-header-extra))
(cnt 0) txt hash link beg end re e checkdir
executables-checked string
- m n block linkfile movefile ov)
+ m n block-type block linkfile movefile ov)
;; Check the different regular expressions
(while (setq e (pop re-list))
- (setq m (car e) re (nth 1 e) n (nth 2 e)
- block (if (nth 3 e) "\n\n" ""))
+ (setq m (car e) re (nth 1 e) n (nth 2 e) block-type (nth 3 e)
+ block (if block-type "\n\n" ""))
(when (member m matchers)
(goto-char (point-min))
(while (re-search-forward re nil t)
@@ -16454,7 +17234,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))))
- ((or (eq processing-type 'dvipng) t)
+ ((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)
@@ -16475,17 +17256,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)
@@ -16510,10 +17299,118 @@ Some of the options can be changed using the variable
(insert (org-add-props link
(list 'org-latex-src
(replace-regexp-in-string
- "\"" "" txt)))))))))))))
+ "\"" "" txt)
+ 'org-latex-src-embed-type
+ (if block-type 'paragraph 'character))))))
+ ((eq processing-type 'mathml)
+ ;; Process to MathML
+ (unless executables-checked
+ (unless (save-match-data (org-format-latex-mathml-available-p))
+ (error "LaTeX to MathML converter not configured"))
+ (setq executables-checked t))
+ (setq txt (match-string n)
+ beg (match-beginning n) end (match-end n)
+ cnt (1+ cnt))
+ (if msg (message msg cnt))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (org-format-latex-as-mathml
+ txt block-type prefix dir)))
+ (t
+ (error "Unknown conversion type %s for latex fragments"
+ processing-type)))))))))
+
+(defun org-create-math-formula (latex-frag &optional mathml-file)
+ "Convert LATEX-FRAG to MathML and store it in MATHML-FILE.
+Use `org-latex-to-mathml-convert-command'. If the conversion is
+sucessful, return the portion between \"<math...> </math>\"
+elements otherwise return nil. When MATHML-FILE is specified,
+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 (org-region-active-p)
+ (buffer-substring-no-properties
+ (region-beginning) (region-end)))))
+ (read-string "LaTeX Fragment: " frag nil frag))))
+ (unless latex-frag (error "Invalid latex-frag"))
+ (let* ((tmp-in-file (file-relative-name
+ (make-temp-name (expand-file-name "ltxmathml-in"))))
+ (ignore (write-region latex-frag nil tmp-in-file))
+ (tmp-out-file (file-relative-name
+ (make-temp-name (expand-file-name "ltxmathml-out"))))
+ (cmd (format-spec
+ org-latex-to-mathml-convert-command
+ `((?j . ,(shell-quote-argument
+ (expand-file-name org-latex-to-mathml-jar-file)))
+ (?I . ,(shell-quote-argument tmp-in-file))
+ (?o . ,(shell-quote-argument tmp-out-file)))))
+ mathml shell-command-output)
+ (when (org-called-interactively-p 'any)
+ (unless (org-format-latex-mathml-available-p)
+ (error "LaTeX to MathML converter not configured")))
+ (message "Running %s" cmd)
+ (setq shell-command-output (shell-command-to-string cmd))
+ (setq mathml
+ (when (file-readable-p tmp-out-file)
+ (with-current-buffer (find-file-noselect tmp-out-file t)
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat
+ (regexp-quote
+ "<math xmlns=\"http://www.w3.org/1998/Math/MathML\">")
+ "\\(.\\|\n\\)*"
+ (regexp-quote "</math>")) nil t)
+ (prog1 (match-string 0) (kill-buffer))))))
+ (cond
+ (mathml
+ (setq mathml
+ (concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" mathml))
+ (when mathml-file
+ (write-region mathml nil mathml-file))
+ (when (org-called-interactively-p 'any)
+ (message mathml)))
+ ((message "LaTeX to MathML conversion failed")
+ (message shell-command-output)))
+ (delete-file tmp-in-file)
+ (when (file-exists-p tmp-out-file)
+ (delete-file tmp-out-file))
+ mathml))
+
+(defun org-format-latex-as-mathml (latex-frag latex-frag-type
+ prefix &optional dir)
+ "Use `org-create-math-formula' but check local cache first."
+ (let* ((absprefix (expand-file-name prefix dir))
+ (print-length nil) (print-level nil)
+ (formula-id (concat
+ "formula-"
+ (sha1
+ (prin1-to-string
+ (list latex-frag
+ org-latex-to-mathml-convert-command)))))
+ (formula-cache (format "%s-%s.mathml" absprefix formula-id))
+ (formula-cache-dir (file-name-directory formula-cache)))
+
+ (unless (file-directory-p formula-cache-dir)
+ (make-directory formula-cache-dir t))
+
+ (unless (file-exists-p formula-cache)
+ (org-create-math-formula latex-frag formula-cache))
+
+ (if (file-exists-p formula-cache)
+ ;; Successful conversion. Return the link to MathML file.
+ (org-add-props
+ (format "[[file:%s]]" (file-relative-name formula-cache dir))
+ (list 'org-latex-src (replace-regexp-in-string "\"" "" latex-frag)
+ 'org-latex-src-embed-type (if latex-frag-type
+ 'paragraph 'character)))
+ ;; Failed conversion. Return the LaTeX fragment verbatim
+ (add-text-properties
+ 0 (1- (length latex-frag)) '(org-protected t) latex-frag)
+ 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)
@@ -16525,7 +17422,7 @@ Some of the options can be changed using the variable
(dvifile (concat texfilebase ".dvi"))
(pngfile (concat texfilebase ".png"))
(fnh (if (featurep 'xemacs)
- (font-height (get-face-font 'default))
+ (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.))))))
@@ -16554,13 +17451,125 @@ Some of the options can be changed using the variable
(if (not (file-exists-p dvifile))
(progn (message "Failed to create dvi file from %s" texfile) nil)
(condition-case nil
- (call-process "dvipng" nil nil nil
- "-fg" fg "-bg" bg
- "-D" dpi
- ;;"-x" scale "-y" scale
- "-T" "tight"
- "-o" pngfile
- dvifile)
+ (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
+ "-D" dpi
+ ;;"-x" scale "-y" scale
+ "-T" "tight"
+ "-o" pngfile
+ dvifile))
+ (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 '(".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
@@ -16569,8 +17578,9 @@ Some of the options can be changed using the variable
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 '(".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)
@@ -16633,10 +17643,32 @@ 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
- (color-values (face-attribute 'default attr nil)))))
+ (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 (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."
@@ -16662,6 +17694,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
@@ -16680,7 +17720,7 @@ BEG and END default to the buffer boundaries."
(save-restriction
(widen)
(setq beg (or beg (point-min)) end (or end (point-max)))
- (goto-char (point-min))
+ (goto-char beg)
(let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
(substring (org-image-file-name-regexp) 0 -2)
"\\)\\]" (if include-linked "" "\\]")))
@@ -16700,10 +17740,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)
@@ -16718,6 +17761,48 @@ BEG and END default to the buffer boundaries."
;;;; Key bindings
+;; Outline functions from `outline-mode-prefix-map'
+;; that can be remapped in Org:
+(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-heading-same-level)
+(define-key org-mode-map [remap outline-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:
+;;
+;; - 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 |
+;; | `hide-body' | overridden | no replacement |
+;; | `hide-entry' | overridden | visibility cycling |
+;; | `hide-leaves' | overridden | no replacement |
+;; | `hide-sublevels' | overridden | no replacement |
+;; | `hide-other' | overridden | no replacement |
+
;; Make `C-c C-x' a prefix key
(org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap))
@@ -16725,9 +17810,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-i" 'org-cycle)
(org-defkey org-mode-map [(tab)] 'org-cycle)
(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived)
-(org-defkey org-mode-map [(meta tab)] 'pcomplete)
(org-defkey org-mode-map "\M-\t" 'pcomplete)
-(org-defkey org-mode-map "\M-\C-i" 'pcomplete)
;; The following line is necessary under Suse GNU/Linux
(unless (featurep 'xemacs)
(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab))
@@ -16801,7 +17884,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)
@@ -16811,11 +17894,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)
@@ -16837,6 +17929,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)
@@ -16880,28 +17973,32 @@ 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)
-(org-defkey org-mode-map "\C-c\C-x\C-k" 'org-mark-entry-for-agenda-action)
(org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special)
(org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special)
(org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special)
(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)
@@ -16932,8 +18029,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))
@@ -16941,6 +18038,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)
@@ -16954,17 +18052,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)
@@ -17011,7 +18114,7 @@ If not, return to the original position and throw an error."
(interactive)
(let ((pos (point)))
(call-interactively cmd)
- (unless (and (bolp) (org-on-heading-p))
+ (unless (and (bolp) (org-at-heading-p))
(goto-char pos)
(error "Boundary reached while executing %s" cmd))))
@@ -17020,17 +18123,23 @@ 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."
+`org-speed-commands-default' specifies a minimal command set.
+Use `org-speed-commands-user' for further customization."
(when (or (and (bolp) (looking-at org-outline-regexp))
(and (functionp org-use-speed-commands)
(funcall org-use-speed-commands)))
(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))))
@@ -17045,12 +18154,13 @@ Each hook takes a single argument, a user-pressed command key
which is also a `self-insert-command' from the global map.
Within the hook, examine the cursor position and the command key
-and return nil or a valid handler as appropriate. Handler could
+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)
@@ -17058,6 +18168,7 @@ hook. The default setting is `org-speed-command-default-hook'."
If the cursor is in a table looking at whitespace, the whitespace is
overwritten, and the table is not marked as requiring realignment."
(interactive "p")
+ (org-check-before-invisible-edit 'insert)
(cond
((and org-use-speed-commands
(setq org-speed-command
@@ -17083,14 +18194,14 @@ 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)
(looking-at "[^|\n]* |"))
(let (org-table-may-need-update)
(goto-char (1- (match-end 0)))
- (delete-char -1)
+ (backward-delete-char 1)
(goto-char (match-beginning 0))
(self-insert-command N)))
(t
@@ -17109,9 +18220,58 @@ overwritten, and the table is not marked as requiring realignment."
(setq org-self-insert-command-undo-counter
(1+ org-self-insert-command-undo-counter))))))))
+(defun org-check-before-invisible-edit (kind)
+ "Check is editing if kind KIND would be dangerous with invisible text around.
+The detailed reaction depends on the user option `org-catch-invisible-edits'."
+ ;; First, try to get out of here as quickly as possible, to reduce overhead
+ (if (and org-catch-invisible-edits
+ (or (not (boundp 'visible-mode)) (not visible-mode))
+ (or (get-char-property (point) 'invisible)
+ (get-char-property (max (point-min) (1- (point))) 'invisible)))
+ ;; OK, we need to take a closer look
+ (let* ((invisible-at-point (get-char-property (point) 'invisible))
+ (invisible-before-point (if (bobp) nil (get-char-property
+ (1- (point)) 'invisible)))
+ (border-and-ok-direction
+ (or
+ ;; Check if we are acting predictably before invisible text
+ (and invisible-at-point (not invisible-before-point)
+ (memq kind '(insert delete-backward)))
+ ;; Check if we are acting predictably after invisible text
+ ;; This works not well, and I have turned it off. It seems
+ ;; better to always show and stop after invisible text.
+ ;; (and (not invisible-at-point) invisible-before-point
+ ;; (memq kind '(insert delete)))
+ )))
+ (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"))
+ (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)) ?*)
- (org-on-heading-p))
+ (org-at-heading-p))
(org-align-tags-here org-tags-column)))
(defun org-delete-backward-char (N)
@@ -17121,6 +18281,7 @@ front of the next \"|\" separator, to keep the table aligned. The table will
still be marked for re-alignment if the field did fill the entire column,
because, in this case the deletion might narrow the column."
(interactive "p")
+ (org-check-before-invisible-edit 'delete-backward)
(if (and (org-table-p)
(eq N 1)
(string-match "|" (buffer-substring (point-at-bol) (point)))
@@ -17147,6 +18308,7 @@ front of the next \"|\" separator, to keep the table aligned. The table will
still be marked for re-alignment if the field did fill the entire column,
because, in this case the deletion might narrow the column."
(interactive "p")
+ (org-check-before-invisible-edit 'delete)
(if (and (org-table-p)
(not (bolp))
(not (= (char-after) ?|))
@@ -17350,54 +18512,64 @@ See the individual commands for more information."
(defun org-shiftmetaleft ()
"Promote subtree or delete table column.
-Calls `org-promote-subtree', `org-outdent-item',
-or `org-table-delete-column', depending on context.
-See the individual commands for more information."
+Calls `org-promote-subtree', `org-outdent-item-tree', or
+`org-table-delete-column', depending on context. See the
+individual commands for more information."
(interactive)
(cond
((run-hook-with-args-until-success 'org-shiftmetaleft-hook))
((org-at-table-p) (call-interactively 'org-table-delete-column))
- ((org-on-heading-p) (call-interactively 'org-promote-subtree))
- ((org-at-item-p) (call-interactively 'org-outdent-item-tree))
+ ((org-at-heading-p) (call-interactively 'org-promote-subtree))
+ ((if (not (org-region-active-p)) (org-at-item-p)
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p)))
+ (call-interactively 'org-outdent-item-tree))
(t (org-modifier-cursor-error))))
(defun org-shiftmetaright ()
"Demote subtree or insert table column.
-Calls `org-demote-subtree', `org-indent-item',
-or `org-table-insert-column', depending on context.
-See the individual commands for more information."
+Calls `org-demote-subtree', `org-indent-item-tree', or
+`org-table-insert-column', depending on context. See the
+individual commands for more information."
(interactive)
(cond
((run-hook-with-args-until-success 'org-shiftmetaright-hook))
((org-at-table-p) (call-interactively 'org-table-insert-column))
- ((org-on-heading-p) (call-interactively 'org-demote-subtree))
- ((org-at-item-p) (call-interactively 'org-indent-item-tree))
+ ((org-at-heading-p) (call-interactively 'org-demote-subtree))
+ ((if (not (org-region-active-p)) (org-at-item-p)
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p)))
+ (call-interactively 'org-indent-item-tree))
(t (org-modifier-cursor-error))))
(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-on-heading-p) (call-interactively 'org-move-subtree-up))
+ ((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-on-heading-p) (call-interactively 'org-move-subtree-down))
+ ((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 ()
@@ -17414,15 +18586,15 @@ See the individual commands for more information."
((run-hook-with-args-until-success 'org-metaleft-hook))
((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left))
((org-with-limited-levels
- (or (org-on-heading-p)
+ (or (org-at-heading-p)
(and (org-region-active-p)
(save-excursion
(goto-char (region-beginning))
- (org-on-heading-p)))))
+ (org-at-heading-p)))))
(when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
(call-interactively 'org-do-promote))
;; At an inline task.
- ((org-on-heading-p)
+ ((org-at-heading-p)
(call-interactively 'org-inlinetask-promote))
((or (org-at-item-p)
(and (org-region-active-p)
@@ -17434,24 +18606,26 @@ 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-on-heading-p)
+ (or (org-at-heading-p)
(and (org-region-active-p)
(save-excursion
(goto-char (region-beginning))
- (org-on-heading-p)))))
+ (org-at-heading-p)))))
(when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
(call-interactively 'org-do-demote))
;; At an inline task.
- ((org-on-heading-p)
+ ((org-at-heading-p)
(call-interactively 'org-inlinetask-demote))
((or (org-at-item-p)
(and (org-region-active-p)
@@ -17489,6 +18663,19 @@ this function returns t, nil otherwise."
(throw 'exit t))))
nil))))
+(autoload 'org-element-at-point "org-element")
+(autoload 'org-element-type "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-contents "org-element" (element))
+(declare-function org-element-property "org-element" (property element))
+(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
@@ -17497,10 +18684,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-on-heading-p) (call-interactively 'org-move-subtree-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.
@@ -17510,10 +18706,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-on-heading-p) (call-interactively 'org-move-subtree-down))
+ ((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.
@@ -17529,7 +18734,7 @@ depending on context. See the individual commands for more information."
'org-timestamp-down 'org-timestamp-up)))
((and (not (eq org-support-shift-select 'always))
org-enable-priority-commands
- (org-on-heading-p))
+ (org-at-heading-p))
(call-interactively 'org-priority-up))
((and (not org-support-shift-select) (org-at-item-p))
(call-interactively 'org-previous-item))
@@ -17553,7 +18758,7 @@ depending on context. See the individual commands for more information."
'org-timestamp-up 'org-timestamp-down)))
((and (not (eq org-support-shift-select 'always))
org-enable-priority-commands
- (org-on-heading-p))
+ (org-at-heading-p))
(call-interactively 'org-priority-down))
((and (not org-support-shift-select) (org-at-item-p))
(call-interactively 'org-next-item))
@@ -17579,7 +18784,7 @@ Depending on context, this does one of the following:
(org-call-for-shift-select 'forward-char))
((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
((and (not (eq org-support-shift-select 'always))
- (org-on-heading-p))
+ (org-at-heading-p))
(let ((org-inhibit-logging
(not org-treat-S-cursor-todo-selection-as-state-change))
(org-inhibit-blocking
@@ -17615,7 +18820,7 @@ Depending on context, this does one of the following:
(org-call-for-shift-select 'backward-char))
((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
((and (not (eq org-support-shift-select 'always))
- (org-on-heading-p))
+ (org-at-heading-p))
(let ((org-inhibit-logging
(not org-treat-S-cursor-todo-selection-as-state-change))
(org-inhibit-blocking
@@ -17642,7 +18847,7 @@ Depending on context, this does one of the following:
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'forward-word))
((and (not (eq org-support-shift-select 'always))
- (org-on-heading-p))
+ (org-at-heading-p))
(org-call-with-arg 'org-todo 'nextset))
(org-support-shift-select
(org-call-for-shift-select 'forward-word))
@@ -17655,7 +18860,7 @@ Depending on context, this does one of the following:
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'backward-word))
((and (not (eq org-support-shift-select 'always))
- (org-on-heading-p))
+ (org-at-heading-p))
(org-call-with-arg 'org-todo 'previousset))
(org-support-shift-select
(org-call-for-shift-select 'backward-word))
@@ -17686,19 +18891,30 @@ Depending on context, this does one of the following:
((org-at-table-p) (call-interactively 'org-table-hline-and-move))
(t (call-interactively 'org-insert-heading))))
+(defun org-find-visible ()
+ (let ((s (point)))
+ (while (and (not (= (point-max) (setq s (next-overlay-change s))))
+ (get-char-property s 'invisible)))
+ s))
+(defun org-find-invisible ()
+ (let ((s (point)))
+ (while (and (not (= (point-max) (setq s (next-overlay-change s))))
+ (not (get-char-property s 'invisible))))
+ s))
+
(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.
@@ -17753,10 +18969,11 @@ 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))))
+(defvar org-table-coordinate-overlays) ; defined in org-table.el
(defun org-ctrl-c-ctrl-c (&optional arg)
"Set tags in headline, or update according to changed information at point.
@@ -17815,14 +19032,16 @@ This command does many different things, depending on context:
(fboundp org-finish-function))
(funcall org-finish-function))
((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
+ ((org-in-regexp org-ts-regexp-both)
+ (org-timestamp-change 0 'day))
((or (looking-at org-property-start-re)
(org-at-property-p))
(call-interactively 'org-property-action))
- ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp))
+ ((org-at-target-p) (call-interactively 'org-update-radio-target-regexp))
((and (org-in-regexp "\\[\\([0-9]*%\\|[0-9]*/[0-9]*\\)\\]")
- (or (org-on-heading-p) (org-at-item-p)))
+ (or (org-at-heading-p) (org-at-item-p)))
(call-interactively 'org-update-statistics-cookies))
- ((org-on-heading-p) (call-interactively 'org-set-tags))
+ ((org-at-heading-p) (call-interactively 'org-set-tags))
((org-at-table.el-p)
(message "Use C-c ' to edit table.el tables"))
((org-at-table-p)
@@ -17836,50 +19055,67 @@ 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))
(old-struct (copy-tree struct))
(parents (org-list-parents-alist struct))
- (prevs (org-list-prevs-alist struct))
(orderedp (org-entry-get nil "ORDERED"))
(firstp (= (org-list-get-top-point struct) (point-at-bol)))
block-item)
;; Use a light version of `org-toggle-checkbox' to avoid
;; computing list structure twice.
- (org-list-set-checkbox (point-at-bol) struct
- (cond
- ((equal arg '(16)) "[-]")
- ((equal arg '(4)) nil)
- ((equal "[X]" cbox) "[ ]")
- (t "[X]")))
- (org-list-struct-fix-ind struct parents)
- (org-list-struct-fix-bul struct prevs)
- (setq block-item
- (org-list-struct-fix-box struct parents prevs orderedp))
+ (let ((new-box (cond
+ ((equal arg '(16)) "[-]")
+ ((equal arg '(4)) nil)
+ ((equal "[X]" cbox) "[ ]")
+ (t "[X]"))))
+ (if (and firstp arg)
+ ;; If at first item of sub-list, remove check-box from
+ ;; every item at the same level.
+ (mapc
+ (lambda (pos) (org-list-set-checkbox pos struct new-box))
+ (org-list-get-all-items
+ (point-at-bol) struct (org-list-prevs-alist struct)))
+ (org-list-set-checkbox (point-at-bol) struct new-box)))
+ ;; Replicate `org-list-write-struct', while grabbing a return
+ ;; value from `org-list-struct-fix-box'.
+ (org-list-struct-fix-ind struct parents 2)
+ (org-list-struct-fix-item-end struct)
+ (let ((prevs (org-list-prevs-alist struct)))
+ (org-list-struct-fix-bul struct prevs)
+ (org-list-struct-fix-ind struct parents)
+ (setq block-item
+ (org-list-struct-fix-box struct parents prevs orderedp)))
+ (org-list-struct-apply-struct struct old-struct)
+ (org-update-checkbox-count-maybe)
(when block-item
(message
"Checkboxes were removed due to unchecked box at line %d"
(org-current-line block-item)))
- (org-list-struct-apply-struct struct old-struct)
- (org-update-checkbox-count-maybe)
(when firstp (org-list-send-list 'maybe))))
((org-at-item-p)
- ;; Cursor at an item: repair list. Do checkbox related actions
- ;; only if function was called with an argument. Send list only
+ ;; Cursor at an item: repair list. Do checkbox related actions
+ ;; only if function was called with an argument. Send list only
;; if at top item.
(let* ((struct (org-list-struct))
- (old-struct (copy-tree struct))
- (parents (org-list-parents-alist struct))
- (prevs (org-list-prevs-alist struct))
- (firstp (= (org-list-get-top-point struct) (point-at-bol))))
- (org-list-struct-fix-ind struct parents)
- (org-list-struct-fix-bul struct prevs)
+ (firstp (= (org-list-get-top-point struct) (point-at-bol)))
+ old-struct)
(when arg
- (org-list-set-checkbox (point-at-bol) struct "[ ]")
- (org-list-struct-fix-box struct parents prevs))
- (org-list-struct-apply-struct struct old-struct)
+ (setq old-struct (copy-tree struct))
+ (if firstp
+ ;; If at first item of sub-list, add check-box to every
+ ;; item at the same level.
+ (mapc
+ (lambda (pos)
+ (unless (org-list-get-checkbox pos struct)
+ (org-list-set-checkbox pos struct "[ ]")))
+ (org-list-get-all-items
+ (point-at-bol) struct (org-list-prevs-alist struct)))
+ (org-list-set-checkbox (point-at-bol) struct "[ ]")))
+ (org-list-write-struct
+ struct (org-list-parents-alist struct) old-struct)
(when arg (org-update-checkbox-count-maybe))
(when firstp (org-list-send-list 'maybe))))
((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re))
@@ -17887,10 +19123,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)
@@ -17900,6 +19138,9 @@ This command does many different things, depending on context:
(t
(let ((org-inhibit-startup-visibility-stuff t)
(org-startup-align-all-tables nil))
+ (when (boundp 'org-table-coordinate-overlays)
+ (mapc 'delete-overlay org-table-coordinate-overlays)
+ (setq org-table-coordinate-overlays nil))
(org-save-outline-visibility 'use-markers (org-mode-restart)))
(message "Local setup has been refreshed"))))
((org-clock-update-time-maybe))
@@ -17929,33 +19170,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
+ (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)
- (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
- (eq (get-text-property (point) 'face) 'org-link))
- (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)))))
+ (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.
@@ -18001,7 +19250,7 @@ all headlines to items, shifting text accordingly.
If it is an item, convert all items to normal lines.
-If it is normal text, change region into an item. With a prefix
+If it is normal text, change region into an item. With a prefix
argument ARG, change each line in region into an item."
(interactive "P")
(let ((shift-text
@@ -18055,7 +19304,7 @@ argument ARG, change each line in region into an item."
(save-excursion
(goto-char beg)
(cond
- ;; Case 1. Start at an item: de-itemize. Note that it only
+ ;; Case 1. Start at an item: de-itemize. Note that it only
;; happens when a region is active: `org-ctrl-c-minus'
;; would call `org-cycle-list-bullet' otherwise.
((org-at-item-p)
@@ -18065,7 +19314,7 @@ argument ARG, change each line in region into an item."
(delete-region (point) (match-end 0)))
(forward-line)))
;; Case 2. Start at an heading: convert to items.
- ((org-on-heading-p)
+ ((org-at-heading-p)
(let* ((bul (org-list-bullet-string "-"))
(bul-len (length bul))
;; Indentation of the first heading. It should be
@@ -18075,7 +19324,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)
@@ -18099,7 +19348,7 @@ argument ARG, change each line in region into an item."
;; an item.
(arg
(while (< (point) end)
- (unless (or (org-on-heading-p) (org-at-item-p))
+ (unless (or (org-at-heading-p) (org-at-item-p))
(if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
(replace-match
(concat "\\1" (org-list-bullet-string "-") "\\2"))))
@@ -18126,13 +19375,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.
-If it is a plain list item, turn all plain list items into headings.
+In a 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 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 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,
@@ -18146,11 +19400,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
@@ -18164,10 +19425,11 @@ stars to add."
(goto-char beg)
(cond
;; Case 1. Started at an heading: de-star headings.
- ((org-on-heading-p)
+ ((org-at-heading-p)
(while (< (point) end)
- (when (org-on-heading-p t)
- (looking-at org-outline-regexp) (replace-match ""))
+ (when (org-at-heading-p t)
+ (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'.
@@ -18195,7 +19457,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.
@@ -18211,10 +19474,11 @@ stars to add."
(t "*"))) ; inside heading, oddeven
(rpl (concat stars add-stars " ")))
(while (< (point) end)
- (when (and (not (org-on-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.
@@ -18223,12 +19487,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"
@@ -18311,23 +19582,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)]
+ "--"
+ ["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 (not (org-at-table-p))]
- ["Cut Subtree" org-cut-special (not (org-at-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])
@@ -18338,11 +19611,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"
@@ -18355,23 +19628,23 @@ See the individual commands for more information."
["Previous link" org-previous-link t]
"--"
["Descriptive Links"
- (progn (add-to-invisibility-spec '(org-link)) (org-restart-font-lock))
+ org-toggle-link-display
:style radio
- :selected (member '(org-link) buffer-invisibility-spec)]
+ :selected org-descriptive-links
+ ]
["Literal Links"
- (progn
- (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock))
+ org-toggle-link-display
:style radio
- :selected (not (member '(org-link) buffer-invisibility-spec))])
+ :selected (not org-descriptive-links)])
"--"
("TODO Lists"
["TODO/DONE/-" org-todo t]
("Select keyword"
- ["Next keyword" org-shiftright (org-on-heading-p)]
- ["Previous keyword" org-shiftleft (org-on-heading-p)]
+ ["Next keyword" org-shiftright (org-at-heading-p)]
+ ["Previous keyword" org-shiftleft (org-at-heading-p)]
["Complete Keyword" pcomplete (assq :todo-keyword (org-context))]
- ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]
- ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))])
+ ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))]
+ ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))])
["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"]
["Global TODO list" org-todo-list :active t :keys "C-c a t"]
"--"
@@ -18393,23 +19666,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]
@@ -18461,7 +19734,8 @@ See the individual commands for more information."
(org-inside-LaTeX-fragment-p)]
["Insert citation" org-reftex-citation t]
"--"
- ["Template for BEAMER" org-insert-beamer-options-template t])
+ ["Template for BEAMER" (progn (require 'org-beamer)
+ (org-insert-beamer-options-template)) t])
"--"
("MobileOrg"
["Push Files and Views" org-mobile-push t]
@@ -18508,10 +19782,10 @@ 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
- (switch-to-buffer (get-buffer-create "*Warn about privacy*"))
+ (org-pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*"))
(delete-other-windows)
(erase-buffer)
(insert "You are about to submit a bug report to the Org-mode mailing list.
@@ -18557,8 +19831,8 @@ Your bug report will be posted to the Org-mode mailing list.
(save-excursion
(while bl
(set-buffer (pop bl))
- (if (org-mode-p) (setq bl nil)))
- (when (org-mode-p)
+ (if (derived-mode-p 'org-mode) (setq bl nil)))
+ (when (derived-mode-p 'org-mode)
(easy-menu-change
'("Org") "File List for Agenda"
(append
@@ -18573,7 +19847,6 @@ Your bug report will be posted to the Org-mode mailing list.
;;;; Documentation
-;;;###autoload
(defun org-require-autoloaded-modules ()
(interactive)
(mapc 'require
@@ -18589,25 +19862,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")
"\\'")))
@@ -18621,10 +19894,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 ()
@@ -18688,6 +19962,17 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(eval form)
(error (format "%%![Error: %s]" error))))
+(defun org-in-clocktable-p ()
+ "Check if the cursor is in a clocktable."
+ (let ((pos (point)) start)
+ (save-excursion
+ (end-of-line 1)
+ (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t)
+ (setq start (match-beginning 0))
+ (re-search-forward "^[ \t]*#\\+END:.*" nil t)
+ (>= (match-end 0) pos)
+ start))))
+
(defun org-in-commented-line ()
"Is point in a line starting with `#'?"
(equal (char-after (point-at-bol)) ?#))
@@ -18708,7 +19993,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(if (and marker (marker-buffer marker)
(buffer-live-p (marker-buffer marker)))
(progn
- (switch-to-buffer (marker-buffer marker))
+ (org-pop-to-buffer-same-window (marker-buffer marker))
(if (or (> marker (point-max)) (< marker (point-min)))
(widen))
(goto-char marker)
@@ -18849,7 +20134,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)
@@ -18938,6 +20223,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.
@@ -18956,8 +20249,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
@@ -18968,10 +20263,11 @@ 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
- ((org-on-heading-p t)
+ ((org-at-heading-p t)
(push (list :headline (point-at-bol) (point-at-eol)) clist)
(when (progn
(beginning-of-line 1)
@@ -19002,6 +20298,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)
@@ -19014,7 +20328,7 @@ and :keyword."
(push (list :keyword
(previous-single-property-change p 'face)
(next-single-property-change p 'face)) clist))
- ((org-on-target-p)
+ ((org-at-target-p)
(push (org-point-in-group p 0 :target) clist)
(goto-char (1- (match-beginning 0)))
(if (looking-at org-radio-target-regexp)
@@ -19066,37 +20380,58 @@ really on, so that the block visually is on the match."
(throw 'exit t)))
nil))))
-(defun org-in-regexps-block-p (start-re end-re &optional bound)
- "Return t if the current point is between matches of START-RE and END-RE.
-This will also return t if point is on one of the two matches or
-in an unfinished block. END-RE can be a string or a form
-returning a string.
+(defun org-between-regexps-p (start-re end-re &optional lim-up lim-down)
+ "Non-nil when point is between matches of START-RE and END-RE.
-An optional third argument bounds the search for START-RE. It
-defaults to previous heading or `point-min'."
- (let ((pos (point))
- (limit (or bound (save-excursion (outline-previous-heading)))))
- (save-excursion
- ;; we're on a block when point is on start-re...
- (or (org-at-regexp-p start-re)
- ;; ... or start-re can be found above...
- (and (re-search-backward start-re limit t)
- ;; ... but no end-re between start-re and point.
- (not (re-search-forward (eval end-re) pos t)))))))
+Also return a non-nil value when point is on one of the matches.
+
+Optional arguments LIM-UP and LIM-DOWN bound the search; they are
+buffer positions. Default values are the positions of headlines
+surrounding the point.
+
+The functions returns a cons cell whose car (resp. cdr) is the
+position before START-RE (resp. after END-RE)."
+ (save-match-data
+ (let ((pos (point))
+ (limit-up (or lim-up (save-excursion (outline-previous-heading))))
+ (limit-down (or lim-down (save-excursion (outline-next-heading))))
+ beg end)
+ (save-excursion
+ ;; Point is on a block when on START-RE or if START-RE can be
+ ;; found before it...
+ (and (or (org-at-regexp-p start-re)
+ (re-search-backward start-re limit-up t))
+ (setq beg (match-beginning 0))
+ ;; ... and END-RE after it...
+ (goto-char (match-end 0))
+ (re-search-forward end-re limit-down t)
+ (> (setq end (match-end 0)) pos)
+ ;; ... without another START-RE in-between.
+ (goto-char (match-beginning 0))
+ (not (re-search-backward start-re (1+ beg) t))
+ ;; Return value.
+ (cons beg end))))))
(defun org-in-block-p (names)
- "Is point inside any block whose name belongs to NAMES?
+ "Non-nil when point belongs to a block whose name belongs to NAMES.
-NAMES is a list of strings containing names of blocks."
+NAMES is a list of strings containing names of blocks.
+
+Return first block name matched, or nil. Beware that in case of
+nested blocks, the returned name may not belong to the closest
+block from point."
(save-match-data
(catch 'exit
- (let ((case-fold-search t))
+ (let ((case-fold-search t)
+ (lim-up (save-excursion (outline-previous-heading)))
+ (lim-down (save-excursion (outline-next-heading))))
(mapc (lambda (name)
(let ((n (regexp-quote name)))
- (when (org-in-regexps-block-p
+ (when (org-between-regexps-p
(concat "^[ \t]*#\\+begin_" n)
- (concat "^[ \t]*#\\+end_" n))
- (throw 'exit t))))
+ (concat "^[ \t]*#\\+end_" n)
+ lim-up lim-down)
+ (throw 'exit n))))
names))
nil)))
@@ -19127,18 +20462,18 @@ NAMES is a list of strings containing names of blocks."
;; Emacs 23
(add-hook 'occur-mode-find-occurrence-hook
(lambda ()
- (when (org-mode-p)
+ (when (derived-mode-p 'org-mode)
(org-reveal))))
;; Emacs 22
(defadvice occur-mode-goto-occurrence
(after org-occur-reveal activate)
- (and (org-mode-p) (org-reveal)))
+ (and (derived-mode-p 'org-mode) (org-reveal)))
(defadvice occur-mode-goto-occurrence-other-window
(after org-occur-reveal activate)
- (and (org-mode-p) (org-reveal)))
+ (and (derived-mode-p 'org-mode) (org-reveal)))
(defadvice occur-mode-display-occurrence
(after org-occur-reveal activate)
- (when (org-mode-p)
+ (when (derived-mode-p 'org-mode)
(let ((pos (occur-mode-find-occurrence)))
(with-current-buffer (marker-buffer pos)
(save-excursion
@@ -19194,13 +20529,26 @@ Taken from `count' in cl-seq.el with all keyword arguments removed."
(if (funcall predicate e) (push e res)))
(nreverse res)))
+(defun org-reduce (cl-func cl-seq &rest cl-keys)
+ "Reduce two-argument FUNCTION across SEQ.
+Taken from `reduce' in cl-seq.el with all keyword arguments but
+\":initial-value\" removed."
+ (let ((cl-accum (cond ((memq :initial-value cl-keys)
+ (cadr (memq :initial-value cl-keys)))
+ (cl-seq (pop cl-seq))
+ (t (funcall cl-func)))))
+ (while cl-seq
+ (setq cl-accum (funcall cl-func cl-accum (pop cl-seq))))
+ cl-accum))
+
(defun org-back-over-empty-lines ()
"Move backwards over whitespace, to the beginning of the first empty line.
Returns the number of empty lines passed."
(let ((pos (point)))
(if (cdr (assoc 'heading org-blank-before-new-entry))
- (skip-chars-backward " \t\n\r")
- (forward-line -1))
+ (skip-chars-backward " \t\n\r")
+ (unless (eobp)
+ (forward-line -1)))
(beginning-of-line 2)
(goto-char (min (point) pos))
(count-lines (point) pos)))
@@ -19242,32 +20590,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.
@@ -19352,48 +20674,24 @@ returns the current time."
(nth 2 date))))))
(or defd (current-time))))
-(defvar org-agenda-action-marker (make-marker)
- "Marker pointing to the entry for the next agenda action.")
-
-(defun org-mark-entry-for-agenda-action ()
- "Mark the current entry as target of an agenda action.
-Agenda actions are actions executed from the agenda with the key `k',
-which make use of the date at the cursor."
- (interactive)
- (move-marker org-agenda-action-marker
- (save-excursion (org-back-to-heading t) (point))
- (current-buffer))
- (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))
@@ -19405,278 +20703,478 @@ 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]*:[ \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-in-regexps-block-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_"))
- (save-excursion
- (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t))
- (setq column
- (if (equal (downcase (match-string 1)) "src")
- ;; src blocks: let `org-edit-src-exit' handle them
- (org-get-indentation)
- (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.
- (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))
+ ;; Enforce empty fill prefix, if required. Otherwise, it
+ ;; will be computed again.
+ (adaptive-fill-mode (not (equal fill-prefix ""))))
+ (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.
@@ -19695,7 +21193,7 @@ this line is also exported in fixed-width font."
(end (if regionp (region-end)))
(nlines (or arg (if (and beg end) (count-lines beg end) 1)))
(case-fold-search nil)
- (re "[ \t]*\\(: \\)")
+ (re "[ \t]*\\(:\\(?: \\|$\\)\\)")
off)
(if regionp
(save-excursion
@@ -19717,13 +21215,16 @@ this line is also exported in fixed-width font."
(forward-line 1)))
(save-excursion
(org-back-to-heading)
- (if (looking-at (concat org-outline-regexp
- "\\( *\\<" org-quote-string "\\>[ \t]*\\)"))
- (replace-match "" t t nil 1)
- (if (looking-at org-outline-regexp)
- (progn
- (goto-char (match-end 0))
- (insert org-quote-string " "))))))))
+ (cond
+ ((looking-at (format org-heading-keyword-regexp-format
+ org-quote-string))
+ (goto-char (match-end 1))
+ (looking-at (concat " +" org-quote-string))
+ (replace-match "" t t)
+ (when (eolp) (insert " ")))
+ ((looking-at org-outline-regexp)
+ (goto-char (match-end 0))
+ (insert org-quote-string " ")))))))
(defun org-reftex-citation ()
"Use reftex-citation to insert a citation into the buffer.
@@ -19797,49 +21298,70 @@ beyond the end of the headline."
((not (eq last-command this-command)) (point))
(t refpos)))))
((org-at-item-p)
- (goto-char
- (if (eq special t)
- (cond ((> pos (match-end 0)) (match-end 0))
- ((= pos (point)) (match-end 0))
- (t (point)))
- (cond ((> pos (point)) (point))
- ((not (eq last-command this-command)) (point))
- (t (match-end 0))))))))
+ ;; Being at an item and not looking at an the item means point
+ ;; was previously moved to beginning of a visual line, which
+ ;; doesn't contain the item. Therefore, do nothing special,
+ ;; just stay here.
+ (when (looking-at org-list-full-item-re)
+ ;; Set special position at first white space character after
+ ;; bullet, and check-box, if any.
+ (let ((after-bullet
+ (let ((box (match-end 3)))
+ (if (not box) (match-end 1)
+ (let ((after (char-after box)))
+ (if (and after (= after ? )) (1+ box) box))))))
+ ;; Special case: Move point to special position when
+ ;; currently after it or at beginning of line.
+ (if (eq special t)
+ (when (or (> pos after-bullet) (= (point) pos))
+ (goto-char after-bullet))
+ ;; Reversed case: Move point to special position when
+ ;; point was already at beginning of line and command is
+ ;; repeated.
+ (when (and (= (point) pos) (eq last-command this-command))
+ (goto-char after-bullet))))))))
(org-no-warnings
(and (featurep 'xemacs) (setq zmacs-region-stays t)))))
(defun org-end-of-line (&optional arg)
"Go to the end of the line.
-If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
-first attempt, and only move to after the tags when the cursor is already
-beyond the end of the headline."
+If this is a headline, and `org-special-ctrl-a/e' is set, ignore
+tags on the first attempt, and only move to after the tags when
+the cursor is already beyond the end of the headline."
(interactive "P")
- (let ((special (if (consp org-special-ctrl-a/e)
- (cdr org-special-ctrl-a/e)
- org-special-ctrl-a/e)))
- (if (or (not special)
- (not (org-on-heading-p))
- arg)
- (call-interactively
- (cond ((org-bound-and-true-p line-move-visual) 'end-of-visual-line)
- ((fboundp 'move-end-of-line) 'move-end-of-line)
- (t 'end-of-line)))
+ (let ((special (if (consp org-special-ctrl-a/e) (cdr org-special-ctrl-a/e)
+ org-special-ctrl-a/e))
+ (type (org-element-type
+ (save-excursion (beginning-of-line) (org-element-at-point)))))
+ (cond
+ ((or (not special) arg)
+ (call-interactively
+ (if (fboundp 'move-end-of-line) 'move-end-of-line 'end-of-line)))
+ ((memq type '(headline inlinetask))
(let ((pos (point)))
- (beginning-of-line 1)
- (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$"))
- (if (eq special t)
- (if (or (< pos (match-beginning 1))
- (= pos (match-end 0)))
- (goto-char (match-beginning 1))
- (goto-char (match-end 0)))
- (if (or (< pos (match-end 0)) (not (eq this-command last-command)))
- (goto-char (match-end 0))
- (goto-char (match-beginning 1))))
- (call-interactively (if (fboundp 'move-end-of-line)
- 'move-end-of-line
- 'end-of-line)))))
- (org-no-warnings
- (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
+ (beginning-of-line 1)
+ (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$"))
+ (if (eq special t)
+ (if (or (< pos (match-beginning 1)) (= pos (match-end 0)))
+ (goto-char (match-beginning 1))
+ (goto-char (match-end 0)))
+ (if (or (< pos (match-end 0))
+ (not (eq this-command last-command)))
+ (goto-char (match-end 0))
+ (goto-char (match-beginning 1))))
+ (call-interactively
+ (if (fboundp 'move-end-of-line) 'move-end-of-line 'end-of-line)))))
+ ((memq type
+ '(center-block comment-block drawer dynamic-block example-block
+ export-block item plain-list property-drawer
+ quote-block special-block src-block verse-block))
+ ;; Never move past the ellipsis.
+ (or (eolp) (move-end-of-line 1))
+ (when (org-invisible-p2) (backward-char)))
+ (t
+ (call-interactively
+ (if (fboundp 'move-end-of-line) 'move-end-of-line 'end-of-line))))
+ (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
(define-key org-mode-map "\C-a" 'org-beginning-of-line)
(define-key org-mode-map "\C-e" 'org-end-of-line)
@@ -19871,13 +21393,14 @@ depending on context."
(cond
((or (not org-special-ctrl-k)
(bolp)
- (not (org-on-heading-p)))
+ (not (org-at-heading-p)))
(if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible)
org-ctrl-k-protect-subtree)
(if (or (eq org-ctrl-k-protect-subtree 'error)
(not (y-or-n-p "Kill hidden subtree along with headline? ")))
(error "C-k aborted - would kill hidden subtree")))
- (call-interactively 'kill-line))
+ (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))
@@ -19917,7 +21440,7 @@ plainly yank the text as it is.
"Perform some yank-like command.
This function implements the behavior described in the `org-yank'
-documentation. However, it has been generalized to work for any
+documentation. However, it has been generalized to work for any
interactive command with similar behavior."
;; pretend to be command COMMAND
@@ -19940,7 +21463,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)
@@ -19969,7 +21492,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?"
@@ -20013,40 +21536,55 @@ 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
(end-of-line)
(null (re-search-backward org-outline-regexp-bol nil t))))
-(defun org-on-heading-p (&optional ignored)
- (outline-on-heading-p t))
(defun org-at-heading-p (&optional ignored)
(outline-on-heading-p t))
+;; 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
+ "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
empty."
(and (looking-at "[ \t]*$")
- (save-excursion
- (beginning-of-line 1)
- (let ((case-fold-search nil))
- (looking-at (concat "^\\(\\*+\\)[ \t]+\\(" org-todo-regexp
- "\\)?[ \t]*$"))))))
+ (when org-todo-line-regexp
+ (save-excursion
+ (beginning-of-line 1)
+ (let ((case-fold-search nil))
+ (looking-at org-todo-line-regexp)
+ (string= (match-string 3) ""))))))
+
(defun org-at-heading-or-item-p ()
- (or (org-on-heading-p) (org-at-item-p)))
+ (or (org-at-heading-p) (org-at-item-p)))
-(defun org-on-target-p ()
+(defun org-at-target-p ()
(or (org-in-regexp org-radio-target-regexp)
(org-in-regexp org-target-regexp)))
+;; Compatibility alias with Org versions < 7.8.03
+(defalias 'org-on-target-p 'org-at-target-p)
(defun org-up-heading-all (arg)
"Move to the heading line of which the present line is a subheading.
@@ -20117,7 +21655,7 @@ move point."
(defun org-goto-first-child ()
"Goto the first child, even if it is invisible.
-Return t when a child was found. Otherwise don't move point and
+Return t when a child was found. Otherwise don't move point and
return nil."
(let (level (pos (point)) (re org-outline-regexp-bol))
(when (condition-case nil (org-back-to-heading t) (error nil))
@@ -20174,18 +21712,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 (org-mode-p) (< 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
@@ -20210,7 +21749,7 @@ If there is no such heading, return nil."
(defadvice outline-end-of-subtree (around prefer-org-version activate compile)
"Use Org version in org-mode, for dramatic speed-up."
- (if (org-mode-p)
+ (if (derived-mode-p 'org-mode)
(progn
(org-end-of-subtree nil t)
(unless (eobp) (backward-char 1)))
@@ -20235,14 +21774,14 @@ 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-on-heading-p)
+ (org-at-heading-p)
(let* ((level (- (match-end 0) (match-beginning 0) 1))
(re (format "^\\*\\{1,%d\\} " level))
l)
@@ -20257,12 +21796,12 @@ 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")
(org-back-to-heading)
- (org-on-heading-p)
+ (org-at-heading-p)
(let* ((level (- (match-end 0) (match-beginning 0) 1))
(re (format "^\\*\\{1,%d\\} " level))
l)
@@ -20275,8 +21814,204 @@ Stop at the first and last subheadings of a superior heading."
(if (< l level) (setq arg 1)))
(setq arg (1- arg)))))
+(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))))))
+
+(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)))))))
+
+(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)))))))
+
+(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")))))
+
+(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)))))))))
+
+(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))))))
+
+(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))))))
+
+(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))))))
+
+(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)))
+
+(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)
(outline-flag-region
(point)
(save-excursion
@@ -20305,12 +22040,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 ()
@@ -20365,8 +22098,8 @@ Show the heading too, if it is currently invisible."
(goto-char (point-max))
(while (re-search-backward re nil t)
(setq level (org-reduced-level (funcall outline-level)))
- (when (<= level n)
- (looking-at org-complex-heading-regexp)
+ (when (and (<= level n)
+ (looking-at org-complex-heading-regexp))
(setq head (org-link-display-format
(org-match-string-no-properties 4))
m (org-imenu-new-marker))
@@ -20382,7 +22115,7 @@ Show the heading too, if it is currently invisible."
'(progn
(add-hook 'imenu-after-jump-hook
(lambda ()
- (if (org-mode-p)
+ (if (derived-mode-p 'org-mode)
(org-show-context 'org-goto))))))
(defun org-link-display-format (link)
@@ -20390,21 +22123,32 @@ 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 ()
+ "Toggle the literal or descriptive display of links."
+ (interactive)
+ (if org-descriptive-links
+ (progn (org-remove-from-invisibility-spec '(org-link))
+ (org-restart-font-lock)
+ (setq org-descriptive-links nil))
+ (progn (add-to-invisibility-spec '(org-link))
+ (org-restart-font-lock)
+ (setq org-descriptive-links t))))
+
;; Speedbar support
(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 ()
@@ -20432,7 +22176,7 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(with-current-buffer (find-file-noselect
(let ((default-directory dir))
(expand-file-name txt)))
- (unless (org-mode-p)
+ (unless (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")))
@@ -20449,7 +22193,7 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
(define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
(add-hook 'speedbar-visiting-tag-hook
- (lambda () (and (org-mode-p) (org-show-context 'org-goto))))))
+ (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto))))))
;;; Fixes and Hacks for problems with other packages
@@ -20463,7 +22207,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."
@@ -20492,12 +22238,12 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(eval-after-load "ecb"
'(defadvice ecb-method-clicked (after esf/org-show-context activate)
"Make hierarchy visible when jumping into location from ECB tree buffer."
- (if (org-mode-p)
+ (if (derived-mode-p 'org-mode)
(org-show-context))))
(defun org-bookmark-jump-unhide ()
"Unhide the current position, to show the bookmark location."
- (and (org-mode-p)
+ (and (derived-mode-p 'org-mode)
(or (outline-invisible-p)
(save-excursion (goto-char (max (point-min) (1- (point))))
(outline-invisible-p)))
@@ -20536,6 +22282,4 @@ Still experimental, may disappear in the future."
(run-hooks 'org-load-hook)
-
-
;;; org.el ends here
diff --git a/lisp/outline.el b/lisp/outline.el
index b5bf8296455..40974a2c829 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -1,6 +1,6 @@
;;; outline.el --- outline mode commands for Emacs
-;; Copyright (C) 1986, 1993-1995, 1997, 2000-2011
+;; Copyright (C) 1986, 1993-1995, 1997, 2000-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -284,10 +284,10 @@ in the file it applies to."
"Normal hook to be run after outline visibility changes.")
(defvar outline-mode-hook nil
- "*This hook is run when outline mode starts.")
+ "This hook is run when outline mode starts.")
(defvar outline-blank-line nil
- "*Non-nil means to leave unhidden blank line before heading.")
+ "Non-nil means to leave unhidden blank line before heading.")
;;;###autoload
(define-derived-mode outline-mode text-mode "Outline"
@@ -380,7 +380,7 @@ See the command `outline-mode' for more information on this mode."
(show-all)))
(defvar outline-level 'outline-level
- "*Function of no args to compute a header's nesting level in an outline.
+ "Function of no args to compute a header's nesting level in an outline.
It can assume point is at the beginning of a header line and that the match
data reflects the `outline-regexp'.")
;;;###autoload(put 'outline-level 'risky-local-variable t)
@@ -751,6 +751,7 @@ If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
;; very end of the heading, before the newline, so text inserted at FROM
;; belongs to the heading rather than to the entry.
(let ((o (make-overlay from to nil 'front-advance)))
+ (overlay-put o 'evaporate t)
(overlay-put o 'invisible 'outline)
(overlay-put o 'isearch-open-invisible
(or outline-isearch-open-invisible-function
diff --git a/lisp/paren.el b/lisp/paren.el
index ee550228d48..ab856380d3f 100644
--- a/lisp/paren.el
+++ b/lisp/paren.el
@@ -1,6 +1,6 @@
;;; paren.el --- highlight matching paren
-;; Copyright (C) 1993, 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: rms@gnu.org
;; Maintainer: FSF
@@ -52,8 +52,17 @@ otherwise)."
:group 'paren-showing)
(defcustom show-paren-delay 0.125
- "Time in seconds to delay before showing a matching paren."
+ "Time in seconds to delay before showing a matching paren.
+If you change this without using customize while `show-paren-mode' is
+active, you must toggle the mode off and on again for this to take effect."
:type '(number :tag "seconds")
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (if (not show-paren-mode)
+ (set sym val)
+ (show-paren-mode -1)
+ (set sym val)
+ (show-paren-mode 1)))
:group 'paren-showing)
(defcustom show-paren-priority 1000
@@ -96,7 +105,7 @@ otherwise)."
'show-paren-mismatch "22.1")
(defvar show-paren-highlight-openparen t
- "*Non-nil turns on openparen highlighting when matching forward.")
+ "Non-nil turns on openparen highlighting when matching forward.")
(defvar show-paren-idle-timer nil)
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index c425e0aa7e8..83815a6a270 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -1,6 +1,6 @@
;;; password-cache.el --- Read passwords, possibly using a password cache.
-;; Copyright (C) 1999-2000, 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2003-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Created: 2003-12-21
@@ -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/paths.el b/lisp/paths.el
deleted file mode 100644
index 161caf9cb8c..00000000000
--- a/lisp/paths.el
+++ /dev/null
@@ -1,188 +0,0 @@
-;;; paths.el --- define pathnames for use by various Emacs commands -*- no-byte-compile: t -*-
-
-;; Copyright (C) 1986, 1988, 1994, 1999-2011 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: internal
-;; Package: emacs
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; These are default settings for names of certain files and directories
-;; that Emacs needs to refer to from time to time.
-
-;; If these settings are not right, override them with `setq'
-;; in site-init.el. Do not change this file.
-
-;;; Code:
-
-;; Docstrings in this file should, where reasonable, follow the
-;; conventions described in make-docfile, so that they get put in the
-;; DOC file rather than in memory.
-
-(defun prune-directory-list (dirs &optional keep reject)
- "\
-Return a copy of DIRS with all non-existent directories removed.
-The optional argument KEEP is a list of directories to retain even if
-they don't exist, and REJECT is a list of directories to remove from
-DIRS, even if they exist; REJECT takes precedence over KEEP.
-
-Note that membership in REJECT and KEEP is checked using simple string
-comparison."
- (apply #'nconc
- (mapcar (lambda (dir)
- (and (not (member dir reject))
- (or (member dir keep) (file-directory-p dir))
- (list dir)))
- dirs)))
-
-(defvar Info-default-directory-list
- (let* ((config-dir
- (file-name-as-directory configure-info-directory))
- (config
- (list config-dir))
- (unpruned-prefixes
- ;; Directory trees that may not exist at installation time, and
- ;; so shouldn't be pruned based on existence.
- '("/usr/local/"))
- (prefixes
- ;; Directory trees in which to look for info subdirectories
- (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/")
- unpruned-prefixes))
- (suffixes
- ;; Subdirectories in each directory tree that may contain info
- ;; directories.
- '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/"
- "emacs/" "lib/" "lib/emacs/"))
- (standard-info-dirs
- (apply #'nconc
- (mapcar (lambda (pfx)
- (let ((dirs
- (mapcar (lambda (sfx)
- (concat pfx sfx "info/"))
- suffixes)))
- (if (member pfx unpruned-prefixes)
- dirs
- (prune-directory-list dirs config))))
- prefixes))))
- ;; If $(prefix)/share/info is not one of the standard info
- ;; directories, they are probably installing an experimental
- ;; version of Emacs, so make sure that experimental version's Info
- ;; files override the ones in standard directories.
- (if (member config-dir standard-info-dirs)
- (nconc standard-info-dirs config)
- (cons config-dir standard-info-dirs)))
- "Default list of directories to search for Info documentation files.
-They are searched in the order they are given in the list.
-Therefore, the directory of Info files that come with Emacs
-normally should come last (so that local files override standard ones),
-unless Emacs is installed into a non-standard directory. In the latter
-case, the directory of Info files that come with Emacs should be
-first in this list.
-
-Once Info is started, the list of directories to search
-comes from the variable `Info-directory-list'.
-This variable `Info-default-directory-list' is used as the default
-for initializing `Info-directory-list' when Info is started, unless
-the environment variable INFOPATH is set.")
-
-(defvar news-directory
- (purecopy (if (file-exists-p "/usr/spool/news/")
- "/usr/spool/news/"
- "/var/spool/news/"))
- "The root directory below which all news files are stored.")
-(defvaralias 'news-path 'news-directory)
-
-(defvar news-inews-program
- (purecopy
- (cond ((file-exists-p "/usr/bin/inews") "/usr/bin/inews")
- ((file-exists-p "/usr/local/inews") "/usr/local/inews")
- ((file-exists-p "/usr/local/bin/inews") "/usr/local/bin/inews")
- ((file-exists-p "/usr/contrib/lib/news/inews") "/usr/contrib/lib/news/inews")
- ((file-exists-p "/usr/lib/news/inews") "/usr/lib/news/inews")
- (t "inews")))
- "Program to post news.")
-
-;; set this to your local server
-(defvar gnus-default-nntp-server (purecopy "") "\
-The name of the host running an NNTP server.
-The null string means use the local host as the server site.")
-
-(defvar gnus-nntp-service (purecopy "nntp") "\
-NNTP service name, usually \"nntp\" or 119.
-Go to a local news spool if its value is nil, in which case `gnus-nntp-server'
-should be set to `(system-name)'.")
-
-(defvar gnus-local-organization nil "\
-*The name of your organization, as a string.
-The `ORGANIZATION' environment variable is used instead if defined.")
-
-(defcustom rmail-file-name (purecopy "~/RMAIL") "\
-Name of user's primary mail file."
- :type 'string
- :group 'rmail
- :version "21.1")
-
-(defvar rmail-spool-directory
- (purecopy
- (cond ((file-exists-p "/var/mail")
- ;; SVR4 and recent BSD are said to use this.
- ;; Rather than trying to know precisely which systems use it,
- ;; let's assume this dir is never used for anything else.
- "/var/mail/")
- ;; Many GNU/Linux systems use this name.
- ((file-exists-p "/var/spool/mail")
- "/var/spool/mail/")
- ((memq system-type '(hpux usg-unix-v irix))
- "/usr/mail/")
- (t "/usr/spool/mail/")))
- "Name of directory used by system mailer for delivering new mail.
-Its name should end with a slash.")
-
-(defcustom remote-shell-program
- (purecopy
- (cond
- ;; Some systems use rsh for the remote shell; others use that name for the
- ;; restricted shell and use remsh for the remote shell. Let's try to guess
- ;; based on what we actually find out there. The restricted shell is
- ;; almost certainly in /bin or /usr/bin, so it's probably safe to assume
- ;; that an rsh found elsewhere is the remote shell program. The converse
- ;; is not true: /usr/bin/rsh could be either one, so check that last.
- ((file-exists-p "/usr/ucb/remsh") "/usr/ucb/remsh")
- ((file-exists-p "/usr/bsd/remsh") "/usr/bsd/remsh")
- ((file-exists-p "/bin/remsh") "/bin/remsh")
- ((file-exists-p "/usr/bin/remsh") "/usr/bin/remsh")
- ((file-exists-p "/usr/local/bin/remsh") "/usr/local/bin/remsh")
- ((file-exists-p "/usr/ucb/rsh") "/usr/ucb/rsh")
- ((file-exists-p "/usr/bsd/rsh") "/usr/bsd/rsh")
- ((file-exists-p "/usr/local/bin/rsh") "/usr/local/bin/rsh")
- ((file-exists-p "/usr/bin/rcmd") "/usr/bin/rcmd")
- ((file-exists-p "/bin/rcmd") "/bin/rcmd")
- ((file-exists-p "/bin/rsh") "/bin/rsh")
- ((file-exists-p "/usr/bin/rsh") "/usr/bin/rsh")
- (t "rsh")))
- "File name for remote-shell program (often rsh or remsh)."
- :group 'environment
- :type 'file)
-
-(defvar term-file-prefix (purecopy "term/") "\
-If non-nil, Emacs startup does (load (concat term-file-prefix (getenv \"TERM\")))
-You may set this variable to nil in your `.emacs' file if you do not wish
-the terminal-initialization file to be loaded.")
-
-;;; paths.el ends here
diff --git a/lisp/pcmpl-cvs.el b/lisp/pcmpl-cvs.el
index 9c9b72ab701..7a23b5f6090 100644
--- a/lisp/pcmpl-cvs.el
+++ b/lisp/pcmpl-cvs.el
@@ -1,6 +1,6 @@
;;; pcmpl-cvs.el --- functions for dealing with cvs completions
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Package: pcomplete
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index 3b2a944f5bb..be389e9c25a 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -1,6 +1,6 @@
;;; pcmpl-gnu.el --- completions for GNU project tools -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Package: pcomplete
@@ -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)
@@ -243,6 +244,8 @@
"--volno-file=")))
(pcomplete-opt "01234567ABCFGKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz"))
(cond
+ ((pcomplete-match "\\`-\\'" 0)
+ (pcomplete-here*))
((pcomplete-match "\\`--after-date=" 0)
(pcomplete-here*))
((pcomplete-match "\\`--backup=" 0)
diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el
index d75479fab3e..10e762132d8 100644
--- a/lisp/pcmpl-linux.el
+++ b/lisp/pcmpl-linux.el
@@ -1,6 +1,6 @@
;;; pcmpl-linux.el --- functions for dealing with GNU/Linux completions
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Package: pcomplete
diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el
index 716b0a59555..f2d1618f124 100644
--- a/lisp/pcmpl-rpm.el
+++ b/lisp/pcmpl-rpm.el
@@ -1,6 +1,6 @@
;;; pcmpl-rpm.el --- functions for dealing with rpm completions
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Package: pcomplete
@@ -27,11 +27,66 @@
(require 'pcomplete)
+(defgroup pcmpl-rpm nil
+ "Options for rpm completion."
+ :group 'pcomplete
+ :prefix "pcmpl-rpm-")
+
+;; rpm -qa can be slow. Adding --nodigest --nosignature is MUCH faster.
+(defcustom pcmpl-rpm-query-options
+ (let (opts)
+ (with-temp-buffer
+ (when (ignore-errors (call-process "rpm" nil t nil "--help"))
+ (if (search-backward "--nodigest " nil 'move)
+ (setq opts '("--nodigest")))
+ (goto-char (point-min))
+ (if (search-forward "--nosignature " nil t)
+ (push "--nosignature" opts))))
+ opts)
+ "String, or list of strings, with extra options for an rpm query command."
+ :version "24.3"
+ :type '(choice (const :tag "No options" nil)
+ (string :tag "Single option")
+ (repeat :tag "List of options" string))
+ :group 'pcmpl-rpm)
+
+(defcustom pcmpl-rpm-cache t
+ "Whether to cache the list of installed packages."
+ :version "24.3"
+ :type 'boolean
+ :group 'pcmpl-rpm)
+
+(defconst pcmpl-rpm-cache-stamp-file "/var/lib/rpm/Packages"
+ "File used to check that the list of installed packages is up-to-date.")
+
+(defvar pcmpl-rpm-cache-time nil
+ "Time at which the list of installed packages was updated.")
+
+(defvar pcmpl-rpm-packages nil
+ "List of installed packages.")
+
;; Functions:
-(defsubst pcmpl-rpm-packages ()
- (split-string (pcomplete-process-result "rpm" "-q" "-a")))
+(defun pcmpl-rpm-packages ()
+ "Return a list of all installed rpm packages."
+ (if (and pcmpl-rpm-cache
+ pcmpl-rpm-cache-time
+ (let ((mtime (nth 5 (file-attributes pcmpl-rpm-cache-stamp-file))))
+ (and mtime (not (time-less-p pcmpl-rpm-cache-time mtime)))))
+ pcmpl-rpm-packages
+ (message "Getting list of installed rpms...")
+ (setq pcmpl-rpm-cache-time (current-time)
+ pcmpl-rpm-packages
+ (split-string (apply 'pcomplete-process-result "rpm"
+ (append '("-q" "-a")
+ (if (stringp pcmpl-rpm-query-options)
+ (list pcmpl-rpm-query-options)
+ pcmpl-rpm-query-options)))))
+ (message "Getting list of installed rpms...done")
+ pcmpl-rpm-packages))
+;; Should this use pcmpl-rpm-query-options?
+;; I don't think it would speed it up at all (?).
(defun pcmpl-rpm-all-query (flag)
(message "Querying all packages with `%s'..." flag)
(let ((pkgs (pcmpl-rpm-packages))
@@ -92,6 +147,7 @@
'("--changelog"
"--dbpath"
"--dump"
+ "--file"
"--ftpport" ;nyi for the next four
"--ftpproxy"
"--httpport"
@@ -112,6 +168,8 @@
(pcomplete-here*))
((pcomplete-test "--rcfile")
(pcomplete-here* (pcomplete-entries)))
+ ((pcomplete-test "--file")
+ (pcomplete-here* (pcomplete-entries)))
((pcomplete-test "--root")
(pcomplete-here* (pcomplete-dirs)))
((pcomplete-test "--scripts")
@@ -129,7 +187,9 @@
(pcomplete-opt "af.p(pcmpl-rpm-files)ilsdcvR")
(if (pcomplete-test "-[^-]*p" 'first 1)
(pcomplete-here (pcmpl-rpm-files))
- (pcomplete-here (pcmpl-rpm-packages))))))
+ (if (pcomplete-test "-[^-]*f" 'first 1)
+ (pcomplete-here* (pcomplete-entries))
+ (pcomplete-here (pcmpl-rpm-packages)))))))
((pcomplete-test "--pipe")
(pcomplete-here* (funcall pcomplete-command-completion-function)))
((pcomplete-test "--rmsource")
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index a34458506e2..ae4bd270b09 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -1,6 +1,6 @@
;;; pcmpl-unix.el --- standard UNIX completions
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Package: pcomplete
@@ -152,13 +152,15 @@ documentation), this function returns nil."
(file-readable-p pcmpl-ssh-known-hosts-file))
(with-temp-buffer
(insert-file-contents-literally pcmpl-ssh-known-hosts-file)
- (let (ssh-hosts-list)
- (while (re-search-forward "^ *\\([-.[:alnum:]]+\\)[, ]" nil t)
- (add-to-list 'ssh-hosts-list (match-string 1))
+ (let ((host-re "\\(?:\\([-.[:alnum:]]+\\)\\|\\[\\([-.[:alnum:]]+\\)\\]:[0-9]+\\)[, ]")
+ ssh-hosts-list)
+ (while (re-search-forward (concat "^ *" host-re) nil t)
+ (add-to-list 'ssh-hosts-list (concat (match-string 1)
+ (match-string 2)))
(while (and (looking-back ",")
- (re-search-forward "\\([-.[:alnum:]]+\\)[, ]"
- (line-end-position) t))
- (add-to-list 'ssh-hosts-list (match-string 1))))
+ (re-search-forward host-re (line-end-position) t))
+ (add-to-list 'ssh-hosts-list (concat (match-string 1)
+ (match-string 2)))))
ssh-hosts-list))))
(defun pcmpl-ssh-config-hosts ()
@@ -203,8 +205,8 @@ Includes files as well as host names followed by a colon."
;; Avoid connecting to the remote host when we're
;; only completing the host name.
(list string)
- (comint--table-subvert (pcomplete-all-entries)
- "" "/ssh:")))
+ (completion-table-subvert (pcomplete-all-entries)
+ "" "/ssh:")))
((string-match "/" string) ; Local file name.
(pcomplete-all-entries))
(t ;Host name or local file name.
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 8ae1e203849..13cf7356e7f 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -1,6 +1,6 @@
;;; pcomplete.el --- programmable completion -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Keywords: processes abbrev
@@ -28,7 +28,7 @@
;; argument position.
;;
;; To use pcomplete with shell-mode, for example, you will need the
-;; following in your .emacs file:
+;; following in your init file:
;;
;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup)
;;
@@ -118,7 +118,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'comint)
(defgroup pcomplete nil
@@ -165,22 +164,8 @@ A non-nil value is useful if `pcomplete-autolist' is non-nil too."
:type 'boolean
:group 'pcomplete)
-(defcustom pcomplete-arg-quote-list nil
- "List of characters to quote when completing an argument."
- :type '(choice (repeat character)
- (const :tag "Don't quote" nil))
- :group 'pcomplete)
-
-(defcustom pcomplete-quote-arg-hook nil
- "A hook which is run to quote a character within a filename.
-Each function is passed both the filename to be quoted, and the index
-to be considered. If the function wishes to provide an alternate
-quoted form, it need only return the replacement string. If no
-function provides a replacement, quoting shall proceed as normal,
-using a backslash to quote any character which is a member of
-`pcomplete-arg-quote-list'."
- :type 'hook
- :group 'pcomplete)
+(define-obsolete-variable-alias
+ 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3")
(defcustom pcomplete-man-function 'man
"A function to that will be called to display a manual page.
@@ -370,47 +355,28 @@ modified to be an empty string, or the desired separation string."
;; it pretty much impossible to have completion other than
;; prefix-completion.
;;
-;; pcomplete--common-quoted-suffix and comint--table-subvert try to
-;; work around this difficulty with heuristics, but it's
-;; really a hack.
-
-(defvar pcomplete-unquote-argument-function nil)
-
-(defun pcomplete-unquote-argument (s)
- (cond
- (pcomplete-unquote-argument-function
- (funcall pcomplete-unquote-argument-function s))
- ((null pcomplete-arg-quote-list) s)
- (t
- (replace-regexp-in-string "\\\\\\(.\\)" "\\1" s t))))
-
-(defun pcomplete--common-quoted-suffix (s1 s2)
- ;; FIXME: Copied in comint.el.
- "Find the common suffix between S1 and S2 where S1 is the expanded S2.
-S1 is expected to be the unquoted and expanded version of S1.
-Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that
-S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and
-SS1 = (unquote SS2)."
- (let* ((cs (comint--common-suffix s1 s2))
- (ss1 (substring s1 (- (length s1) cs)))
- (qss1 (pcomplete-quote-argument ss1))
- qc)
- (if (and (not (equal ss1 qss1))
- (setq qc (pcomplete-quote-argument (substring ss1 0 1)))
- (eq t (compare-strings s2 (- (length s2) cs (length qc) -1)
- (- (length s2) cs -1)
- qc nil nil)))
- ;; The difference found is just that one char is quoted in S2
- ;; but not in S1, keep looking before this difference.
- (pcomplete--common-quoted-suffix
- (substring s1 0 (- (length s1) cs))
- (substring s2 0 (- (length s2) cs (length qc) -1)))
- (cons (substring s1 0 (- (length s1) cs))
- (substring s2 0 (- (length s2) cs))))))
-
-;; I don't think such commands are usable before first setting up buffer-local
-;; variables to parse args, so there's no point autoloading it.
-;; ;;;###autoload
+;; pcomplete--common-suffix and completion-table-subvert try to work around
+;; this difficulty with heuristics, but it's really a hack.
+
+(defvar pcomplete-unquote-argument-function #'comint--unquote-argument)
+
+(defsubst pcomplete-unquote-argument (s)
+ (funcall pcomplete-unquote-argument-function s))
+
+(defvar pcomplete-requote-argument-function #'comint--requote-argument)
+
+(defun pcomplete--common-suffix (s1 s2)
+ ;; Since S2 is expected to be the "unquoted/expanded" version of S1,
+ ;; there shouldn't be any case difference, even if the completion is
+ ;; case-insensitive.
+ (let ((case-fold-search nil))
+ (string-match
+ ;; \x3FFF7F is just an arbitrary char among the ones Emacs accepts
+ ;; that hopefully will never appear in normal text.
+ "\\(?:.\\|\n\\)*?\\(\\(?:.\\|\n\\)*\\)\x3FFF7F\\(?:.\\|\n\\)*\\1\\'"
+ (concat s1 "\x3FFF7F" s2))
+ (- (match-end 1) (match-beginning 1))))
+
(defun pcomplete-completions-at-point ()
"Provide standard completion using pcomplete's completion tables.
Same as `pcomplete' but using the standard completion UI."
@@ -441,34 +407,31 @@ Same as `pcomplete' but using the standard completion UI."
;; pcomplete-stub and works from the buffer's text instead,
;; we need to trick minibuffer-complete, into using
;; pcomplete-stub without its knowledge. To that end, we
- ;; use comint--table-subvert to construct a completion
+ ;; use completion-table-subvert to construct a completion
;; table which expects strings using a prefix from the
;; buffer's text but internally uses the corresponding
;; prefix from pcomplete-stub.
(beg (max (- (point) (length pcomplete-stub))
(pcomplete-begin)))
- (buftext (buffer-substring beg (point))))
+ (buftext (pcomplete-unquote-argument
+ (buffer-substring beg (point)))))
(when completions
(let ((table
- (cond
- ((not (equal pcomplete-stub buftext))
- ;; This isn't always strictly right (e.g. if
- ;; FOO="toto/$FOO", then completion of /$FOO/bar may
- ;; result in something incorrect), but given the lack of
- ;; any other info, it's about as good as it gets, and in
- ;; practice it should work just fine (fingers crossed).
- (let ((prefixes (pcomplete--common-quoted-suffix
+ (completion-table-with-quoting
+ (if (equal pcomplete-stub buftext)
+ completions
+ ;; This may not always be strictly right, but given the lack
+ ;; of any other info, it's about as good as it gets, and in
+ ;; practice it should work just fine (fingers crossed).
+ (let ((suf-len (pcomplete--common-suffix
pcomplete-stub buftext)))
- (comint--table-subvert
- completions (cdr prefixes) (car prefixes)
- #'pcomplete-quote-argument #'pcomplete-unquote-argument)))
- (t
- (lambda (string pred action)
- (let ((res (complete-with-action
- action completions string pred)))
- (if (stringp res)
- (pcomplete-quote-argument res)
- res))))))
+ (completion-table-subvert
+ completions
+ (substring buftext 0 (- (length buftext) suf-len))
+ (substring pcomplete-stub 0
+ (- (length pcomplete-stub) suf-len)))))
+ pcomplete-unquote-argument-function
+ pcomplete-requote-argument-function))
(pred
;; Pare it down, if applicable.
(when (and pcomplete-use-paring pcomplete-seen)
@@ -488,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))
@@ -758,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)
@@ -777,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."
@@ -827,22 +792,8 @@ this is `comint-dynamic-complete-functions'."
(throw 'pcompleted t)
pcomplete-args))))))
-(defun pcomplete-quote-argument (filename)
- "Return FILENAME with magic characters quoted.
-Magic characters are those in `pcomplete-arg-quote-list'."
- (if (null pcomplete-arg-quote-list)
- filename
- (let ((index 0))
- (mapconcat (lambda (c)
- (prog1
- (or (run-hook-with-args-until-success
- 'pcomplete-quote-arg-hook filename index)
- (when (memq c pcomplete-arg-quote-list)
- (string ?\\ c))
- (char-to-string c))
- (setq index (1+ index))))
- filename
- ""))))
+(define-obsolete-function-alias
+ 'pcomplete-quote-argument #'comint-quote-filename "24.3")
;; file-system completion lists
@@ -882,7 +833,8 @@ Magic characters are those in `pcomplete-arg-quote-list'."
. ,(lambda (comps)
(sort comps pcomplete-compare-entry-function)))
,@(cdr (completion-file-name-table s p a)))
- (let ((completion-ignored-extensions nil))
+ (let ((completion-ignored-extensions nil)
+ (completion-ignore-case pcomplete-ignore-case))
(completion-table-with-predicate
#'comint-completion-file-name-table pred 'strict s p a))))))
@@ -925,9 +877,9 @@ component, `default-directory' is used as the basis for completion."
;; The env-var is "out of bounds".
(if (eq action t)
(complete-with-action action table newstring pred)
- (list* 'boundaries
- (+ (car bounds) (- orig-length (length newstring)))
- (cdr bounds)))
+ `(boundaries
+ ,(+ (car bounds) (- orig-length (length newstring)))
+ . ,(cdr bounds)))
;; The env-var is in the file bounds.
(if (eq action t)
(let ((comps (complete-with-action
@@ -936,9 +888,9 @@ component, `default-directory' is used as the basis for completion."
;; Strip the part of each completion that's actually
;; coming from the env-var.
(mapcar (lambda (s) (substring s len)) comps))
- (list* 'boundaries
- (+ envpos (- orig-length (length newstring)))
- (cdr bounds))))))))))
+ `(boundaries
+ ,(+ envpos (- orig-length (length newstring)))
+ . ,(cdr bounds))))))))))
(defsubst pcomplete-all-entries (&optional regexp predicate)
"Like `pcomplete-entries', but doesn't ignore any entries."
@@ -1138,7 +1090,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
@@ -1178,14 +1130,14 @@ Returns non-nil if a space was appended at the end."
(if (not pcomplete-ignore-case)
(insert-and-inherit (if raw-p
(substring entry (length stub))
- (pcomplete-quote-argument
+ (comint-quote-filename
(substring entry (length stub)))))
;; the stub is not quoted at this time, so to determine the
;; length of what should be in the buffer, we must quote it
;; FIXME: Here we presume that quoting `stub' gives us the exact
;; text in the buffer before point, which is not guaranteed;
;; e.g. it is not the case in eshell when completing ${FOO}tm[TAB].
- (delete-char (- (length (pcomplete-quote-argument stub))))
+ (delete-char (- (length (comint-quote-filename stub))))
;; if there is already a backslash present to handle the first
;; character, don't bother quoting it
(when (eq (char-before) ?\\)
@@ -1193,7 +1145,7 @@ Returns non-nil if a space was appended at the end."
(setq entry (substring entry 1)))
(insert-and-inherit (if raw-p
entry
- (pcomplete-quote-argument entry))))
+ (comint-quote-filename entry))))
(let (space-added)
(when (and (not (memq (char-before) pcomplete-suffix-list))
addsuffix)
@@ -1203,7 +1155,7 @@ Returns non-nil if a space was appended at the end."
pcomplete-last-completion-stub stub)
space-added)))
-;; selection of completions
+;; Selection of completions.
(defun pcomplete-do-complete (stub completions)
"Dynamically complete at point using STUB and COMPLETIONS.
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index e111e743608..abc78cd495c 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -1,6 +1,6 @@
;;; 5x5.el --- simple little puzzle game -*- coding: utf-8 -*-
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Dave Pearson <davep@davep.org>
;; Maintainer: Dave Pearson <davep@davep.org>
@@ -50,8 +50,7 @@
;; Things we need.
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
;; Customize options.
@@ -260,8 +259,8 @@ Quit current game \\[5x5-quit-game]"
(defun 5x5-make-new-grid ()
"Create and return a new `5x5' grid structure."
(let ((grid (make-vector 5x5-grid-size nil)))
- (loop for y from 0 to (1- 5x5-grid-size) do
- (aset grid y (make-vector 5x5-grid-size nil)))
+ (dotimes (y 5x5-grid-size)
+ (aset grid y (make-vector 5x5-grid-size nil)))
grid))
(defun 5x5-cell (grid y x)
@@ -279,9 +278,9 @@ Quit current game \\[5x5-quit-game]"
(defun 5x5-copy-grid (grid)
"Make a new copy of GRID."
(let ((copy (5x5-make-new-grid)))
- (loop for y from 0 to (1- 5x5-grid-size) do
- (loop for x from 0 to (1- 5x5-grid-size) do
- (5x5-set-cell copy y x (5x5-cell grid y x))))
+ (dotimes (y 5x5-grid-size)
+ (dotimes (x 5x5-grid-size)
+ (5x5-set-cell copy y x (5x5-cell grid y x))))
copy))
(defun 5x5-make-move (grid row col)
@@ -299,45 +298,46 @@ Quit current game \\[5x5-quit-game]"
(defun 5x5-row-value (row)
"Get the \"on-value\" for grid row ROW."
- (loop for y from 0 to (1- 5x5-grid-size) sum (if (aref row y) 1 0)))
+ (cl-loop for y from 0 to (1- 5x5-grid-size) sum (if (aref row y) 1 0)))
(defun 5x5-grid-value (grid)
"Get the \"on-value\" for grid GRID."
- (loop for y from 0 to (1- 5x5-grid-size) sum (5x5-row-value (aref grid y))))
+ (cl-loop for y from 0 to (1- 5x5-grid-size)
+ sum (5x5-row-value (aref grid y))))
(defun 5x5-draw-grid-end ()
"Draw the top/bottom of the grid."
(insert "+")
- (loop for x from 0 to (1- 5x5-grid-size) do
- (insert "-" (make-string 5x5-x-scale ?-)))
+ (dotimes (x 5x5-grid-size)
+ (insert "-" (make-string 5x5-x-scale ?-)))
(insert "-+ "))
(defun 5x5-draw-grid (grids)
"Draw the grids GRIDS into the current buffer."
(let ((inhibit-read-only t) grid-org)
(erase-buffer)
- (loop for grid in grids do (5x5-draw-grid-end))
+ (dolist (grid grids) (5x5-draw-grid-end))
(insert "\n")
(setq grid-org (point))
- (loop for y from 0 to (1- 5x5-grid-size) do
- (loop for lines from 0 to (1- 5x5-y-scale) do
- (loop for grid in grids do
- (loop for x from 0 to (1- 5x5-grid-size) do
- (insert (if (zerop x) "| " " ")
- (make-string 5x5-x-scale
- (if (5x5-cell grid y x) ?# ?.))))
- (insert " | "))
- (insert "\n")))
+ (dotimes (y 5x5-grid-size)
+ (dotimes (lines 5x5-y-scale)
+ (dolist (grid grids)
+ (dotimes (x 5x5-grid-size)
+ (insert (if (zerop x) "| " " ")
+ (make-string 5x5-x-scale
+ (if (5x5-cell grid y x) ?# ?.))))
+ (insert " | "))
+ (insert "\n")))
(when 5x5-solver-output
(if (= (car 5x5-solver-output) 5x5-moves)
(save-excursion
(goto-char grid-org)
(beginning-of-line (+ 1 (/ 5x5-y-scale 2)))
- (let ((solution-grid (cdadr 5x5-solver-output)))
- (dotimes (y 5x5-grid-size)
+ (let ((solution-grid (cl-cdadr 5x5-solver-output)))
+ (dotimes (y 5x5-grid-size)
(save-excursion
(forward-char (+ 1 (/ (1+ 5x5-x-scale) 2)))
- (dotimes (x 5x5-grid-size)
+ (dotimes (x 5x5-grid-size)
(when (5x5-cell solution-grid y x)
(if (= 0 (mod 5x5-x-scale 2))
(progn
@@ -350,7 +350,7 @@ Quit current game \\[5x5-quit-game]"
(forward-char (1+ 5x5-x-scale))))
(forward-line 5x5-y-scale))))
(setq 5x5-solver-output nil)))
- (loop for grid in grids do (5x5-draw-grid-end))
+ (dolist (grid grids) (5x5-draw-grid-end))
(insert "\n")
(insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves))))
@@ -362,16 +362,16 @@ Quit current game \\[5x5-quit-game]"
(defun 5x5-made-move ()
"Keep track of how many moves have been made."
- (incf 5x5-moves))
+ (cl-incf 5x5-moves))
(defun 5x5-make-random-grid (&optional move)
"Make a random grid."
(setq move (or move (symbol-function '5x5-flip-cell)))
(let ((grid (5x5-make-new-grid)))
- (loop for y from 0 to (1- 5x5-grid-size) do
- (loop for x from 0 to (1- 5x5-grid-size) do
- (if (zerop (random 2))
- (funcall move grid y x))))
+ (dotimes (y 5x5-grid-size)
+ (dotimes (x 5x5-grid-size)
+ (if (zerop (random 2))
+ (funcall move grid y x))))
grid))
;; Cracker functions.
@@ -444,20 +444,20 @@ should return a grid vector array that is the new solution."
(defun 5x5-make-xor-with-mutation (current best)
"Xor current and best solution then mutate the result."
(let ((xored (5x5-make-new-grid)))
- (loop for y from 0 to (1- 5x5-grid-size) do
- (loop for x from 0 to (1- 5x5-grid-size) do
- (5x5-set-cell xored y x
- (5x5-xor (5x5-cell current y x)
- (5x5-cell best y x)))))
+ (dotimes (y 5x5-grid-size)
+ (dotimes (x 5x5-grid-size)
+ (5x5-set-cell xored y x
+ (5x5-xor (5x5-cell current y x)
+ (5x5-cell best y x)))))
(5x5-mutate-solution xored)))
(defun 5x5-mutate-solution (solution)
"Randomly flip bits in the solution."
- (loop for y from 0 to (1- 5x5-grid-size) do
- (loop for x from 0 to (1- 5x5-grid-size) do
- (if (= (random (/ (* 5x5-grid-size 5x5-grid-size) 2))
- (/ (/ (* 5x5-grid-size 5x5-grid-size) 2) 2))
- (5x5-flip-cell solution y x))))
+ (dotimes (y 5x5-grid-size)
+ (dotimes (x 5x5-grid-size)
+ (if (= (random (/ (* 5x5-grid-size 5x5-grid-size) 2))
+ (/ (/ (* 5x5-grid-size 5x5-grid-size) 2) 2))
+ (5x5-flip-cell solution y x))))
solution)
(defun 5x5-play-solution (solution best)
@@ -465,15 +465,15 @@ should return a grid vector array that is the new solution."
in progress because it is an animated attempt."
(5x5-new-game)
(let ((inhibit-quit t))
- (loop for y from 0 to (1- 5x5-grid-size) do
- (loop for x from 0 to (1- 5x5-grid-size) do
- (setq 5x5-y-pos y
- 5x5-x-pos x)
- (if (5x5-cell solution y x)
- (5x5-flip-current))
- (5x5-draw-grid (list 5x5-grid solution best))
- (5x5-position-cursor)
- (sit-for 5x5-animate-delay))))
+ (dotimes (y 5x5-grid-size)
+ (dotimes (x 5x5-grid-size)
+ (setq 5x5-y-pos y
+ 5x5-x-pos x)
+ (if (5x5-cell solution y x)
+ (5x5-flip-current))
+ (5x5-draw-grid (list 5x5-grid solution best))
+ (5x5-position-cursor)
+ (sit-for 5x5-animate-delay))))
5x5-grid)
;; Arithmetic solver
@@ -568,14 +568,14 @@ to complete the 5x5.
Solutions are sorted from least to greatest Hamming weight."
(require 'calc-ext)
- (flet ((5x5-mat-mode-2
- (a)
- (math-map-vec
- (lambda (y)
- (math-map-vec
- (lambda (x) `(mod ,x 2))
- y))
- a)))
+ (cl-flet ((5x5-mat-mode-2
+ (a)
+ (math-map-vec
+ (lambda (y)
+ (math-map-vec
+ (lambda (x) `(mod ,x 2))
+ y))
+ a)))
(let* (calc-command-flags
(grid-size-squared (* 5x5-grid-size 5x5-grid-size))
@@ -658,8 +658,8 @@ Solutions are sorted from least to greatest Hamming weight."
(cdr (5x5-mat-mode-2
'(vec (vec 0 1 1 1 0 1 0 1 0 1 1 1 0 1
1 1 0 1 0 1 0 1 1 1 0)
- (vec 1 1 0 1 1 0 0 0 0 0 1 1 0 1
- 1 0 0 0 0 0 1 1 0 1 1)))))
+ (vec 1 1 0 1 1 0 0 0 0 0 1 1 0 1
+ 1 0 0 0 0 0 1 1 0 1 1)))))
(calcFunc-trn id))))
(inv-base-change
@@ -758,9 +758,9 @@ Solutions are sorted from least to greatest Hamming weight."
;; The Hamming Weight is computed by matrix reduction
;; with an ad-hoc operator.
(math-reduce-vec
- ;; (cadadr '(vec (mod x 2))) => x
- (lambda (r x) (+ (if (integerp r) r (cadadr r))
- (cadadr x)))
+ ;; (cl-cadadr '(vec (mod x 2))) => x
+ (lambda (r x) (+ (if (integerp r) r (cl-cadadr r))
+ (cl-cadadr x)))
solution); car
(5x5-vec-to-grid
(calcFunc-arrange solution 5x5-grid-size));cdr
@@ -878,28 +878,28 @@ lest."
"Move up."
(interactive)
(unless (zerop 5x5-y-pos)
- (decf 5x5-y-pos)
+ (cl-decf 5x5-y-pos)
(5x5-position-cursor)))
(defun 5x5-down ()
"Move down."
(interactive)
(unless (= 5x5-y-pos (1- 5x5-grid-size))
- (incf 5x5-y-pos)
+ (cl-incf 5x5-y-pos)
(5x5-position-cursor)))
(defun 5x5-left ()
"Move left."
(interactive)
(unless (zerop 5x5-x-pos)
- (decf 5x5-x-pos)
+ (cl-decf 5x5-x-pos)
(5x5-position-cursor)))
(defun 5x5-right ()
"Move right."
(interactive)
(unless (= 5x5-x-pos (1- 5x5-grid-size))
- (incf 5x5-x-pos)
+ (cl-incf 5x5-x-pos)
(5x5-position-cursor)))
(defun 5x5-bol ()
@@ -953,8 +953,6 @@ lest."
(y-or-n-p prompt)
t))
-(random t)
-
(provide '5x5)
;;; 5x5.el ends here
diff --git a/lisp/play/animate.el b/lisp/play/animate.el
index ec0cacc4a68..2398a7b89c7 100644
--- a/lisp/play/animate.el
+++ b/lisp/play/animate.el
@@ -1,6 +1,6 @@
;;; animate.el --- make text dance
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Maintainer: Richard Stallman <rms@gnu.org>
;; Keywords: games
@@ -92,7 +92,7 @@
"*Number of steps `animate-string' will place a char before its last position.")
(defvar animation-buffer-name nil
- "*String naming the default buffer for animations.
+ "String naming the default buffer for animations.
When nil animations displayed in the buffer named *Animation*.")
;;;###autoload
@@ -201,8 +201,6 @@ the buffer *Birthday-Present-for-Name*."
(animate-string "my sunshine" 18 34)
(animate-string "to stay!" 19 34))
-(random t)
-
(provide 'animate)
;;; animate.el ends here
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
index 42d1d8e09fa..16189600156 100644
--- a/lisp/play/blackbox.el
+++ b/lisp/play/blackbox.el
@@ -1,6 +1,6 @@
;;; blackbox.el --- blackbox game in Emacs Lisp
-;; Copyright (C) 1985-1987, 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992, 2001-2012 Free Software Foundation, Inc.
;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
;; Adapted-By: ESR
@@ -93,11 +93,13 @@
(define-key map (vector 'remap oldfun) newfun))
-(defvar blackbox-mode-map
+(defvar blackbox-mode-map
(let ((map (make-keymap)))
(suppress-keymap map t)
(blackbox-redefine-key map 'backward-char 'bb-left)
+ (blackbox-redefine-key map 'left-char 'bb-left)
(blackbox-redefine-key map 'forward-char 'bb-right)
+ (blackbox-redefine-key map 'right-char 'bb-right)
(blackbox-redefine-key map 'previous-line 'bb-up)
(blackbox-redefine-key map 'next-line 'bb-down)
(blackbox-redefine-key map 'move-end-of-line 'bb-eol)
@@ -257,7 +259,6 @@ a reflection."
(bb-goto (cons bb-x bb-y)))
(defun bb-init-board (num-balls)
- (random t)
(let (board pos)
(while (>= (setq num-balls (1- num-balls)) 0)
(while
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index 62d486ffca5..3b6035473fd 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -1,6 +1,6 @@
;;; bubbles.el --- Puzzle game for Emacs
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; URL: http://ulf.epplejasper.de/
@@ -33,7 +33,7 @@
;; Installation
;; ------------
-;; Add the following lines to your Emacs startup file (`~/.emacs').
+;; Add the following lines to your init file:
;; (add-to-list 'load-path "/path/to/bubbles/")
;; (autoload 'bubbles "bubbles" "Play Bubbles" t)
@@ -82,7 +82,6 @@
(defconst bubbles-version "0.5" "Version number of bubbles.el.")
(require 'gamegrid)
-(eval-when-compile (require 'cl)) ; for 'case
;; User options
@@ -718,58 +717,58 @@ static char * dot3d_xpm[] = {
(defsubst bubbles--grid-width ()
"Return the grid width for the current game theme."
- (car (case bubbles-game-theme
- (easy
+ (car (pcase bubbles-game-theme
+ (`easy
bubbles--grid-small)
- (medium
+ (`medium
bubbles--grid-medium)
- (difficult
+ (`difficult
bubbles--grid-large)
- (hard
+ (`hard
bubbles--grid-huge)
- (user-defined
+ (`user-defined
bubbles-grid-size))))
(defsubst bubbles--grid-height ()
"Return the grid height for the current game theme."
- (cdr (case bubbles-game-theme
- (easy
+ (cdr (pcase bubbles-game-theme
+ (`easy
bubbles--grid-small)
- (medium
+ (`medium
bubbles--grid-medium)
- (difficult
+ (`difficult
bubbles--grid-large)
- (hard
+ (`hard
bubbles--grid-huge)
- (user-defined
+ (`user-defined
bubbles-grid-size))))
(defsubst bubbles--colors ()
"Return the color list for the current game theme."
- (case bubbles-game-theme
- (easy
+ (pcase bubbles-game-theme
+ (`easy
bubbles--colors-2)
- (medium
+ (`medium
bubbles--colors-3)
- (difficult
+ (`difficult
bubbles--colors-4)
- (hard
+ (`hard
bubbles--colors-5)
- (user-defined
+ (`user-defined
bubbles-colors)))
(defsubst bubbles--shift-mode ()
"Return the shift mode for the current game theme."
- (case bubbles-game-theme
- (easy
+ (pcase bubbles-game-theme
+ (`easy
'default)
- (medium
+ (`medium
'default)
- (difficult
+ (`difficult
'always)
- (hard
+ (`hard
'always)
- (user-defined
+ (`user-defined
bubbles-shift-mode)))
(defun bubbles-save-settings ()
@@ -1345,12 +1344,12 @@ Return t if new char is non-empty."
"Prepare images for playing `bubbles'."
(when (and (display-images-p)
(not (eq bubbles-graphics-theme 'ascii)))
- (let ((template (case bubbles-graphics-theme
- (circles bubbles--image-template-circle)
- (balls bubbles--image-template-ball)
- (squares bubbles--image-template-square)
- (diamonds bubbles--image-template-diamond)
- (emacs bubbles--image-template-emacs))))
+ (let ((template (pcase bubbles-graphics-theme
+ (`circles bubbles--image-template-circle)
+ (`balls bubbles--image-template-ball)
+ (`squares bubbles--image-template-square)
+ (`diamonds bubbles--image-template-diamond)
+ (`emacs bubbles--image-template-emacs))))
(setq bubbles--empty-image
(create-image (replace-regexp-in-string
"^\"\\(.*\\)\t.*c .*\",$"
diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el
index 837213665fc..dbd6e893473 100644
--- a/lisp/play/cookie1.el
+++ b/lisp/play/cookie1.el
@@ -1,6 +1,6 @@
;;; cookie1.el --- retrieve random phrases from fortune cookie files
-;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: FSF
@@ -46,16 +46,13 @@
;; In order to achieve total compatibility with strfile(1), cookie files
;; should start with two consecutive delimiters (and no comment).
;;
-;; This code derives from Steve Strassman's 1987 spook.el package, but
+;; This code derives from Steve Strassmann's 1987 spook.el package, but
;; has been generalized so that it supports multiple simultaneous
;; cookie databases and fortune files. It is intended to be called
;; from other packages such as yow.el and spook.el.
;;; Code:
-; Randomize the seed in the random number generator.
-(random t)
-
(defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0"
"Delimiter used to separate cookie file entries.")
@@ -96,6 +93,8 @@ of load, ENDMSG at the end."
"Reads in the PHRASE-FILE, returns it as a vector of strings.
Emit STARTMSG and ENDMSG before and after. Caches the result; second
and subsequent calls on the same file won't go to disk."
+ (or (file-readable-p phrase-file)
+ (error "Cannot read file `%s'" phrase-file))
(let ((sym (intern-soft phrase-file cookie-cache)))
(and sym (not (equal (symbol-function sym)
(nth 5 (file-attributes phrase-file))))
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index 4d4ea71cd7a..ade0d15006a 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -1,6 +1,6 @@
;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers
;;
-;; Copyright (C) 1995-1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 2001-2012 Free Software Foundation, Inc.
;;
;; Author: Christopher J. Madsen <chris_madsen@geocities.com>
;; Keywords: games
@@ -88,8 +88,7 @@
;;; Variables:
;;;===================================================================
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup decipher nil
"Cryptanalyze monoalphabetic substitution ciphers."
@@ -139,19 +138,7 @@ the tail of the list."
("^)\\([A-Z ]+\\)\\([a-z ]+\\)"
(1 font-lock-keyword-face)
(2 font-lock-string-face)))
- "Expressions to fontify in Decipher mode.
-
-Ciphertext uses `font-lock-keyword-face', plaintext uses
-`font-lock-string-face', comments use `font-lock-comment-face', and
-checkpoints use `font-lock-constant-face'. You can customize the
-display by changing these variables. For best results, I recommend
-that all faces use the same background color.
-
-For example, to display ciphertext in the `bold' face, use
- (add-hook 'decipher-mode-hook
- (lambda () (set (make-local-variable 'font-lock-keyword-face)
- 'bold)))
-in your `.emacs' file.")
+ "Font Lock keywords for Decipher mode.")
(defvar decipher-mode-map
(let ((map (make-keymap)))
@@ -170,7 +157,7 @@ in your `.emacs' file.")
(let ((key ?a))
(while (<= key ?z)
(define-key map (vector key) 'decipher-keypress)
- (incf key)))
+ (cl-incf key)))
map)
"Keymap for Decipher mode.")
@@ -194,7 +181,7 @@ in your `.emacs' file.")
(c ?0))
(while (<= c ?9)
(modify-syntax-entry c "_" table) ;Digits are not part of words
- (incf c))
+ (cl-incf c))
(setq decipher-mode-syntax-table table)))
(defvar decipher-alphabet nil)
@@ -414,7 +401,7 @@ The most useful commands are:
(if undo-rec
(progn
(push undo-rec decipher-undo-list)
- (incf decipher-undo-list-size)
+ (cl-incf decipher-undo-list-size)
(if (> decipher-undo-list-size decipher-undo-limit)
(let ((new-size (- decipher-undo-limit 100)))
;; Truncate undo list to NEW-SIZE elements:
@@ -588,7 +575,7 @@ you have determined the keyword."
(progn
(while (rassoc cipher-char decipher-alphabet)
;; Find the next unused letter
- (incf cipher-char))
+ (cl-incf cipher-char))
(push (cons ?\s cipher-char) undo-rec)
(decipher-set-map cipher-char (car plain-map) t))))
(decipher-add-undo undo-rec)))
@@ -644,7 +631,7 @@ You should use this if you edit the ciphertext."
(while (>= plain-char ?a)
(backward-char)
(push (cons plain-char (following-char)) decipher-alphabet)
- (decf plain-char)))))
+ (cl-decf plain-char)))))
;;;===================================================================
;;; Analyzing ciphertext:
@@ -805,8 +792,8 @@ TOTAL is the total number of letters in the ciphertext."
(while temp-list
(insert (caar temp-list)
(format "%4d%3d%% "
- (cadar temp-list)
- (/ (* 100 (cadar temp-list)) total)))
+ (cl-cadar temp-list)
+ (/ (* 100 (cl-cadar temp-list)) total)))
(setq temp-list (nthcdr 4 temp-list)))
(insert ?\n)
(setq freq-list (cdr freq-list)
@@ -838,17 +825,17 @@ TOTAL is the total number of letters in the ciphertext."
;; A vector of 26 integers, counting the number of occurrences
;; of the corresponding characters.
(setq decipher--digram (format "%c%c" decipher--prev-char decipher-char))
- (incf (cdr (or (assoc decipher--digram decipher--digram-list)
+ (cl-incf (cdr (or (assoc decipher--digram decipher--digram-list)
(car (push (cons decipher--digram 0)
decipher--digram-list)))))
(and (>= decipher--prev-char ?A)
- (incf (aref (aref decipher--before (- decipher--prev-char ?A))
+ (cl-incf (aref (aref decipher--before (- decipher--prev-char ?A))
(if (equal decipher-char ?\s)
26
(- decipher-char ?A)))))
(and (>= decipher-char ?A)
- (incf (aref decipher--freqs (- decipher-char ?A)))
- (incf (aref (aref decipher--after (- decipher-char ?A))
+ (cl-incf (aref decipher--freqs (- decipher-char ?A)))
+ (cl-incf (aref (aref decipher--after (- decipher-char ?A))
(if (equal decipher--prev-char ?\s)
26
(- decipher--prev-char ?A)))))
@@ -859,8 +846,8 @@ TOTAL is the total number of letters in the ciphertext."
(let ((total 0))
(concat
(mapconcat (lambda (x)
- (cond ((> x 99) (incf total) "XX")
- ((> x 0) (incf total) (format "%2d" x))
+ (cond ((> x 99) (cl-incf total) "XX")
+ ((> x 0) (cl-incf total) (format "%2d" x))
(t " ")))
counts
"")
@@ -873,10 +860,10 @@ TOTAL is the total number of letters in the ciphertext."
;; We do not include spaces (word divisions) in this count.
(let ((total 0)
(i 26))
- (while (>= (decf i) 0)
+ (while (>= (cl-decf i) 0)
(if (or (> (aref before-count i) 0)
(> (aref after-count i) 0))
- (incf total)))
+ (cl-incf total)))
total))
(defun decipher-analyze-buffer ()
@@ -890,7 +877,7 @@ Creates the statistics buffer if it doesn't exist."
decipher--digram decipher--digram-list freq-list)
(message "Scanning buffer...")
(let ((i 26))
- (while (>= (decf i) 0)
+ (while (>= (cl-decf i) 0)
(aset decipher--before i (make-vector 27 0))
(aset decipher--after i (make-vector 27 0))))
(if decipher-ignore-spaces
@@ -898,7 +885,7 @@ Creates the statistics buffer if it doesn't exist."
(decipher-loop-no-breaks 'decipher--analyze)
;; The first character of ciphertext was marked as following a space:
(let ((i 26))
- (while (>= (decf i) 0)
+ (while (>= (cl-decf i) 0)
(aset (aref decipher--after i) 26 0))))
(decipher-loop-with-breaks 'decipher--analyze))
(message "Processing results...")
@@ -913,7 +900,7 @@ Creates the statistics buffer if it doesn't exist."
;; of times it occurs, and DIFFERENT is the number of different
;; letters it appears next to.
(let ((i 26))
- (while (>= (decf i) 0)
+ (while (>= (cl-decf i) 0)
(setq freq-list
(cons (list (+ i ?A)
(aref decipher--freqs i)
@@ -933,7 +920,7 @@ Creates the statistics buffer if it doesn't exist."
(insert ?\n)
;; Display frequency counts for letters in order of frequency:
(setq freq-list (sort freq-list
- (lambda (a b) (> (second a) (second b)))))
+ (lambda (a b) (> (cl-second a) (cl-second b)))))
(decipher-insert-frequency-counts freq-list total-chars)
;; Display letters in order of frequency:
(insert ?\n (mapconcat (lambda (a) (char-to-string (car a)))
@@ -957,11 +944,11 @@ Creates the statistics buffer if it doesn't exist."
;; Display adjacency list for each letter, sorted in descending
;; order of the number of adjacent letters:
(setq freq-list (sort freq-list
- (lambda (a b) (> (third a) (third b)))))
+ (lambda (a b) (> (cl-third a) (cl-third b)))))
(let ((temp-list freq-list)
entry i)
(while (setq entry (pop temp-list))
- (if (equal 0 (second entry))
+ (if (equal 0 (cl-second entry))
nil ;This letter was not used
(setq i (- (car entry) ?A))
(insert ?\n " "
@@ -969,8 +956,8 @@ Creates the statistics buffer if it doesn't exist."
(car entry)
": A B C D E F G H I J K L M N O P Q R S T U V W X Y Z *"
(format "%4d %4d %3d%%\n "
- (third entry) (second entry)
- (/ (* 100 (second entry)) total-chars))
+ (cl-third entry) (cl-second entry)
+ (/ (* 100 (cl-second entry)) total-chars))
(decipher--digram-counts (aref decipher--after i)) ?\n))))
(setq buffer-read-only t)
(set-buffer-modified-p nil)
diff --git a/lisp/play/dissociate.el b/lisp/play/dissociate.el
index 4530e586de8..238b2a86c17 100644
--- a/lisp/play/dissociate.el
+++ b/lisp/play/dissociate.el
@@ -1,6 +1,6 @@
;;; dissociate.el --- scramble text amusingly for Emacs
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: games
@@ -94,8 +94,6 @@ Default is 2."
(funcall search-function overlap opoint t))))))
(sit-for 0))))
-(random t)
-
(provide 'dissociate)
;;; dissociate.el ends here
diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el
index b20f6968088..57dbb1452f3 100644
--- a/lisp/play/doctor.el
+++ b/lisp/play/doctor.el
@@ -1,6 +1,6 @@
;;; doctor.el --- psychological help for frustrated users
-;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2011
+;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -832,17 +832,17 @@ Otherwise call the Doctor to parse preceding sentence."
(doctor-read-print)
(newline arg)))
-(defun doctor-read-print nil
+(defun doctor-read-print ()
"Top level loop."
(interactive)
- (let ((sent (doctor-readin)))
- (insert "\n")
- (setq doctor--lincount (1+ doctor--lincount))
- (doctor-doc sent)
- (insert "\n")
- (setq doctor--bak sent)))
-
-(defun doctor-readin nil
+ (setq doctor-sent (doctor-readin))
+ (insert "\n")
+ (setq doctor--lincount (1+ doctor--lincount))
+ (doctor-doc)
+ (insert "\n")
+ (setq doctor--bak doctor-sent))
+
+(defun doctor-readin ()
"Read a sentence. Return it as a list of words."
(let (sentence)
(backward-sentence 1)
@@ -860,25 +860,25 @@ Otherwise call the Doctor to parse preceding sentence."
;; Main processing function for sentences that have been read.
-(defun doctor-doc (sent)
+(defun doctor-doc ()
(cond
- ((equal sent '(foo))
+ ((equal doctor-sent '(foo))
(doctor-type '(bar! (doc$ doctor--please) (doc$ doctor--continue) \.)))
- ((member sent doctor--howareyoulst)
+ ((member doctor-sent doctor--howareyoulst)
(doctor-type '(i\'m ok \. (doc$ doctor--describe) yourself \.)))
- ((or (member sent '((good bye) (see you later) (i quit) (so long)
- (go away) (get lost)))
- (memq (car sent)
+ ((or (member doctor-sent '((good bye) (see you later) (i quit) (so long)
+ (go away) (get lost)))
+ (memq (car doctor-sent)
'(bye halt break quit done exit goodbye
bye\, stop pause goodbye\, stop pause)))
(doctor-type (doc$ doctor--bye)))
- ((and (eq (car sent) 'you)
- (memq (cadr sent) doctor--abusewords))
- (setq doctor-found (cadr sent))
+ ((and (eq (car doctor-sent) 'you)
+ (memq (cadr doctor-sent) doctor--abusewords))
+ (setq doctor-found (cadr doctor-sent))
(doctor-type (doc$ doctor--abuselst)))
- ((eq (car sent) 'whatmeans)
- (doctor-def (cadr sent)))
- ((equal sent '(parse))
+ ((eq (car doctor-sent) 'whatmeans)
+ (doctor-def (cadr doctor-sent)))
+ ((equal doctor-sent '(parse))
(doctor-type (list 'subj '= doctor-subj ", "
'verb '= doctor-verb "\n"
'object 'phrase '= doctor-obj ","
@@ -890,29 +890,31 @@ Otherwise call the Doctor to parse preceding sentence."
'sentence 'used 'was
"..."
'(doc// doctor--bak))))
- ((memq (car sent) '(are is do has have how when where who why))
+ ((memq (car doctor-sent) '(are is do has have how when where who why))
(doctor-type (doc$ doctor--qlist)))
;; ((eq (car sent) 'forget)
;; (set (cadr sent) nil)
;; (doctor-type '((doc$ doctor--isee) (doc$ doctor--please)
;; (doc$ doctor--continue)\.)))
(t
- (if (doctor-defq sent) (doctor-define sent doctor-found))
- (if (> (length sent) 12) (setq sent (doctor-shorten sent)))
- (setq sent (doctor-correct-spelling (doctor-replace sent doctor--replist)))
- (cond ((and (not (memq 'me sent)) (not (memq 'i sent))
- (memq 'am sent))
- (setq sent (doctor-replace sent '((am . (are)))))))
- (cond ((equal (car sent) 'yow) (doctor-zippy))
- ((< (length sent) 2)
- (cond ((eq (doctor-meaning (car sent)) 'howdy)
+ (if (doctor-defq doctor-sent) (doctor-define doctor-sent doctor-found))
+ (if (> (length doctor-sent) 12)
+ (setq doctor-sent (doctor-shorten doctor-sent)))
+ (setq doctor-sent (doctor-correct-spelling
+ (doctor-replace doctor-sent doctor--replist)))
+ (cond ((and (not (memq 'me doctor-sent)) (not (memq 'i doctor-sent))
+ (memq 'am doctor-sent))
+ (setq doctor-sent (doctor-replace doctor-sent '((am . (are)))))))
+ (cond ((equal (car doctor-sent) 'yow) (doctor-zippy))
+ ((< (length doctor-sent) 2)
+ (cond ((eq (doctor-meaning (car doctor-sent)) 'howdy)
(doctor-howdy))
(t (doctor-short))))
(t
- (if (memq 'am sent)
- (setq sent (doctor-replace sent '((me . (i))))))
- (setq sent (doctor-fixup sent))
- (if (and (eq (car sent) 'do) (eq (cadr sent) 'not))
+ (if (memq 'am doctor-sent)
+ (setq doctor-sent (doctor-replace doctor-sent '((me . (i))))))
+ (setq doctor-sent (doctor-fixup doctor-sent))
+ (if (and (eq (car doctor-sent) 'do) (eq (cadr doctor-sent) 'not))
(cond ((zerop (random 3))
(doctor-type '(are you (doc$ doctor--afraidof) that \?)))
((zerop (random 2))
@@ -921,9 +923,9 @@ Otherwise call the Doctor to parse preceding sentence."
(doctor-rthing))
(t
(doctor-type '((doc$ doctor--whysay) that i shouldn\'t
- (cddr sent)
+ (cddr doctor-sent)
\?))))
- (doctor-go (doctor-wherego sent))))))))
+ (doctor-go (doctor-wherego doctor-sent))))))))
;; Things done to process sentences once read.
@@ -1576,9 +1578,9 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result."
(equal doctor-found 'killing))
(memq 'yourself doctor-sent)))
(setq doctor--suicide-flag t)
- (doctor-type '(If you are really suicidal, you might
+ (doctor-type '(If you are really suicidal\, you might
want to contact the Samaritans via
- E-mail: jo@samaritans.org or, at your option,
+ E-mail: jo@samaritans.org or\, at your option\,
anonymous E-mail: samaritans@anon.twwells.com\ \.
or find a Befrienders crisis center at
http://www.befrienders.org/\ \.
@@ -1618,8 +1620,6 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result."
(defun doctor-chat () (doctor-type (doc$ doctor--chatlst)))
-(random t)
-
(provide 'doctor)
;;; doctor.el ends here
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index 696442ee8cb..2d62b800ef4 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -1,6 +1,6 @@
;;; dunnet.el --- text adventure for Emacs -*- byte-compile-warnings: nil -*-
-;; Copyright (C) 1992-1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: Ron Schnell <ronnie@driver-aces.com>
;; Created: 25 Jul 1992
@@ -2183,7 +2183,7 @@ A hole leads north."
nil nil nil nil nil
(list obj-box) ;; stair-landing
nil nil nil
- (list obj-axe) ;; smal-crawlspace
+ (list obj-axe) ;; small-crawlspace
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
nil nil nil nil nil
(list obj-special) ;; fourth-vermont-intersection
@@ -3010,7 +3010,6 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
(dun-uexit nil)))
-(random t)
(setq tloc (+ 60 (random 18)))
(dun-replace dun-room-objects tloc
(append (nth tloc dun-room-objects) (list 18)))
diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el
index a46c2ba8171..61de49aadf0 100644
--- a/lisp/play/fortune.el
+++ b/lisp/play/fortune.el
@@ -1,6 +1,6 @@
;;; fortune.el --- use fortune to create signatures
-;; Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Holger Schauer <Holger.Schauer@gmx.de>
;; Keywords: games utils mail
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index e245e70a55c..8af877c7843 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -1,6 +1,6 @@
;;; gamegrid.el --- library for implementing grid-based games on Emacs
-;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Glynn Clements <glynn@sensei.co.uk>
;; Version: 1.02
@@ -26,9 +26,6 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
-
;; ;;;;;;;;;;;;; buffer-local variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar gamegrid-use-glyphs t
@@ -178,7 +175,7 @@ static unsigned char gamegrid_bits[] = {
(defun gamegrid-make-mono-tty-face ()
(let ((face (make-face 'gamegrid-mono-tty-face)))
- (set-face-inverse-video-p face t)
+ (set-face-inverse-video face t)
face))
(defun gamegrid-make-color-tty-face (color)
@@ -212,20 +209,20 @@ static unsigned char gamegrid_bits[] = {
(defun gamegrid-make-face (data-spec-list color-spec-list)
(let ((data (gamegrid-match-spec-list data-spec-list))
(color (gamegrid-match-spec-list color-spec-list)))
- (case data
- (color-x
+ (pcase data
+ (`color-x
(gamegrid-make-color-x-face color))
- (grid-x
+ (`grid-x
(unless gamegrid-grid-x-face
(setq gamegrid-grid-x-face (gamegrid-make-grid-x-face)))
gamegrid-grid-x-face)
- (mono-x
+ (`mono-x
(unless gamegrid-mono-x-face
(setq gamegrid-mono-x-face (gamegrid-make-mono-x-face)))
gamegrid-mono-x-face)
- (color-tty
+ (`color-tty
(gamegrid-make-color-tty-face color))
- (mono-tty
+ (`mono-tty
(unless gamegrid-mono-tty-face
(setq gamegrid-mono-tty-face (gamegrid-make-mono-tty-face)))
gamegrid-mono-tty-face))))
@@ -311,13 +308,13 @@ static unsigned char gamegrid_bits[] = {
(intern (concat "gamegrid-face-" (buffer-name)))))
(when (eq gamegrid-display-mode 'glyph)
(let ((max-height nil))
- (loop for c from 0 to 255 do
- (let ((glyph (aref gamegrid-display-table c)))
- (when (and (listp glyph) (eq (car glyph) 'image))
- (let ((height (cdr (image-size glyph))))
- (if (or (null max-height)
- (< max-height height))
- (setq max-height height))))))
+ (dotimes (c 256)
+ (let ((glyph (aref gamegrid-display-table c)))
+ (when (and (listp glyph) (eq (car glyph) 'image))
+ (let ((height (cdr (image-size glyph))))
+ (if (or (null max-height)
+ (< max-height height))
+ (setq max-height height))))))
(when (and max-height (< max-height 1))
(let ((default-font-height (face-attribute 'default :height))
(resy (/ (display-pixel-height) (/ (display-mm-height) 25.4)))
@@ -332,10 +329,10 @@ static unsigned char gamegrid_bits[] = {
(setq gamegrid-display-mode (gamegrid-display-type))
(setq gamegrid-display-table (make-display-table))
(setq gamegrid-face-table (make-vector 256 nil))
- (loop for c from 0 to 255 do
+ (dotimes (c 256)
(let* ((spec (aref gamegrid-display-options c))
- (glyph (gamegrid-make-glyph (car spec) (caddr spec)))
- (face (gamegrid-make-face (cadr spec) (caddr spec))))
+ (glyph (gamegrid-make-glyph (car spec) (nth 2 spec)))
+ (face (gamegrid-make-face (cadr spec) (nth 2 spec))))
(aset gamegrid-face-table c face)
(aset gamegrid-display-table c glyph)))
(gamegrid-setup-default-font)
@@ -451,10 +448,10 @@ group. You probably need special user privileges to do this.
On non-POSIX systems Emacs searches for FILE in the directory
specified by the variable `temporary-file-directory'. If necessary,
FILE is created there."
- (case system-type
- ((ms-dos windows-nt)
+ (pcase system-type
+ ((or `ms-dos `windows-nt)
(gamegrid-add-score-insecure file score))
- (t
+ (_
(gamegrid-add-score-with-update-game-score file score))))
@@ -563,7 +560,7 @@ FILE is created there."
(goto-char (point-min))
(search-forward (concat (int-to-string score)
" " (user-login-name) " "
- marker-string))
+ marker-string) nil t)
(beginning-of-line)))))
(defun gamegrid-add-score-insecure (file score &optional directory)
diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el
index e7ed146b4a1..60bbc7129e2 100644
--- a/lisp/play/gametree.el
+++ b/lisp/play/gametree.el
@@ -1,6 +1,6 @@
;;; gametree.el --- manage game analysis trees in Emacs
-;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Ian T Zimmerman <itz@rahul.net>
;; Created: Wed Dec 10 07:41:46 PST 1997
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index ee6b67e6109..90f021ab265 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -1,6 +1,6 @@
;;; gomoku.el --- Gomoku game between you and Emacs
-;; Copyright (C) 1988, 1994, 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr>
;; Maintainer: FSF
@@ -89,16 +89,16 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces."
;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1).
(defconst gomoku-square-width 4
- "*Horizontal spacing between squares on the Gomoku board.")
+ "Horizontal spacing between squares on the Gomoku board.")
(defconst gomoku-square-height 2
- "*Vertical spacing between squares on the Gomoku board.")
+ "Vertical spacing between squares on the Gomoku board.")
(defconst gomoku-x-offset 3
- "*Number of columns between the Gomoku board and the side of the window.")
+ "Number of columns between the Gomoku board and the side of the window.")
(defconst gomoku-y-offset 1
- "*Number of lines between the Gomoku board and the top of the window.")
+ "Number of lines between the Gomoku board and the top of the window.")
(defvar gomoku-mode-map
@@ -161,7 +161,7 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces."
(defface gomoku-O
'((((class color)) (:foreground "red" :weight bold)))
- "Face to use for Emacs' O."
+ "Face to use for Emacs's O."
:group 'gomoku)
(defface gomoku-X
@@ -173,7 +173,7 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces."
'(("O" . 'gomoku-O)
("X" . 'gomoku-X)
("[-|/\\]" 0 (if gomoku-emacs-won 'gomoku-O 'gomoku-X)))
- "*Font lock rules for Gomoku.")
+ "Font lock rules for Gomoku.")
(put 'gomoku-mode 'front-sticky
(put 'gomoku-mode 'rear-nonsticky '(intangible)))
@@ -1054,16 +1054,18 @@ If the game is finished, this command requests for another game."
(defun gomoku-display-statistics ()
"Obnoxiously display some statistics about previous games in mode line."
- ;; We store this string in the mode-line-process local variable.
- ;; This is certainly not the cleanest way out ...
- (setq mode-line-process
- (format ": Won %d, lost %d%s"
- gomoku-number-of-human-wins
- gomoku-number-of-emacs-wins
- (if (zerop gomoku-number-of-draws)
- ""
- (format ", drew %d" gomoku-number-of-draws))))
- (force-mode-line-update))
+ ;; Update mode line only if Gomoku buffer is current (Bug#12771).
+ (when (string-equal (buffer-name) gomoku-buffer-name)
+ ;; We store this string in the mode-line-process local variable.
+ ;; This is certainly not the cleanest way out ...
+ (setq mode-line-process
+ (format ": won %d, lost %d%s"
+ gomoku-number-of-human-wins
+ gomoku-number-of-emacs-wins
+ (if (zerop gomoku-number-of-draws)
+ ""
+ (format ", drew %d" gomoku-number-of-draws))))
+ (force-mode-line-update)))
(defun gomoku-switch-to-window ()
"Find or create the Gomoku buffer, and display it."
@@ -1197,8 +1199,6 @@ If the game is finished, this command requests for another game."
(move-to-column (+ gomoku-x-offset
(* gomoku-square-width (1- gomoku-board-width)))))
-(random t)
-
(provide 'gomoku)
;;; gomoku.el ends here
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index 70c10da5405..85c128b08e2 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -1,6 +1,6 @@
;;; handwrite.el --- turns your emacs buffer into a handwritten document -*- coding: iso-latin-1; -*-
-;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Danny Roozendaal (was: <danny@tvs.kun.nl>)
;; Created: October 21 1996
@@ -45,7 +45,7 @@
;; Installation
;;
;; type at your prompt "emacs -l handwrite.el" or put this file on your
-;; Emacs-Lisp load path, add the following into your ~/.emacs startup file
+;; Emacs-Lisp load path, add the following into your init file:
;;
;; (require 'handwrite)
;;
@@ -189,7 +189,7 @@ Variables: `handwrite-linespace' (default 12)
(setq next-line-add-newlines t)
(switch-to-buffer ps-buf-name)
(handwrite-insert-header buf-name)
- (insert "%%Creator: GNU Emacs' handwrite version " emacs-version "\n")
+ (insert "%%Creator: GNU Emacs's handwrite version " emacs-version "\n")
(handwrite-insert-preamble)
(handwrite-insert-info)
(handwrite-insert-font)
diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el
index 31a6d6f425b..9e8b6ff97eb 100644
--- a/lisp/play/hanoi.el
+++ b/lisp/play/hanoi.el
@@ -56,15 +56,14 @@
;;; Code:
-(eval-when-compile
- (require 'cl)
- ;; dynamic bondage:
- (defvar baseward-step)
- (defvar fly-step)
- (defvar fly-row-start)
- (defvar pole-width)
- (defvar pole-char)
- (defvar line-offset))
+(eval-when-compile (require 'cl-lib))
+;; dynamic bondage:
+(defvar baseward-step)
+(defvar fly-step)
+(defvar fly-row-start)
+(defvar pole-width)
+(defvar pole-char)
+(defvar line-offset)
(defgroup hanoi nil
"The Towers of Hanoi."
@@ -124,9 +123,9 @@ second since 1970-01-01 00:00:00 GMT.
Repent before ring 31 moves."
(interactive)
(let* ((start (ftruncate (float-time)))
- (bits (loop repeat 32
- for x = (/ start (expt 2.0 31)) then (* x 2.0)
- collect (truncate (mod x 2.0))))
+ (bits (cl-loop repeat 32
+ for x = (/ start (expt 2.0 31)) then (* x 2.0)
+ collect (truncate (mod x 2.0))))
(hanoi-move-period 1.0))
(hanoi-internal 32 bits start)))
@@ -138,9 +137,9 @@ current-time interface is made s2G-compliant, hanoi.el will need
to be updated."
(interactive)
(let* ((start (ftruncate (float-time)))
- (bits (loop repeat 64
- for x = (/ start (expt 2.0 63)) then (* x 2.0)
- collect (truncate (mod x 2.0))))
+ (bits (cl-loop repeat 64
+ for x = (/ start (expt 2.0 63)) then (* x 2.0)
+ collect (truncate (mod x 2.0))))
(hanoi-move-period 1.0))
(hanoi-internal 64 bits start)))
@@ -197,22 +196,22 @@ BITS must be of length nrings. Start at START-TIME."
(setq fly-row-start (1- line-offset))
(setq fly-step line-offset)
(setq baseward-step -1)
- (loop repeat base-len do
- (unless (zerop base-lines)
- (insert-char ?\ (1- base-lines))
- (insert base-char)
- (hanoi-put-face (1- (point)) (point) hanoi-base-face))
- (insert-char ?\ (+ 2 nrings))
- (insert ?\n))
+ (cl-loop repeat base-len do
+ (unless (zerop base-lines)
+ (insert-char ?\ (1- base-lines))
+ (insert base-char)
+ (hanoi-put-face (1- (point)) (point) hanoi-base-face))
+ (insert-char ?\ (+ 2 nrings))
+ (insert ?\n))
(delete-char -1)
- (loop for coord in pole-coords do
- (loop for row from (- coord (/ pole-width 2))
- for start = (+ (* row line-offset) base-lines 1)
- repeat pole-width do
- (subst-char-in-region start (+ start nrings 1)
- ?\ pole-char)
- (hanoi-put-face start (+ start nrings 1)
- hanoi-pole-face))))
+ (dolist (coord pole-coords)
+ (cl-loop for row from (- coord (/ pole-width 2))
+ for start = (+ (* row line-offset) base-lines 1)
+ repeat pole-width do
+ (subst-char-in-region start (+ start nrings 1)
+ ?\ pole-char)
+ (hanoi-put-face start (+ start nrings 1)
+ hanoi-pole-face))))
;; vertical
(setq line-offset (1+ base-len))
(setq fly-step 1)
@@ -222,17 +221,17 @@ BITS must be of length nrings. Start at START-TIME."
(setq fly-row-start (point))
(insert-char ?\ base-len)
(insert ?\n)
- (loop repeat (1+ nrings)
- with pole-line =
- (loop with line = (make-string base-len ?\ )
- for coord in pole-coords
- for start = (- coord (/ pole-width 2))
- for end = (+ start pole-width) do
- (hanoi-put-face start end hanoi-pole-face line)
- (loop for i from start below end do
- (aset line i pole-char))
- finally return line)
- do (insert pole-line ?\n))
+ (cl-loop repeat (1+ nrings)
+ with pole-line =
+ (cl-loop with line = (make-string base-len ?\ )
+ for coord in pole-coords
+ for start = (- coord (/ pole-width 2))
+ for end = (+ start pole-width) do
+ (hanoi-put-face start end hanoi-pole-face line)
+ (cl-loop for i from start below end do
+ (aset line i pole-char))
+ finally return line)
+ do (insert pole-line ?\n))
(insert-char base-char base-len)
(hanoi-put-face (- (point) base-len) (point) hanoi-base-face)
(set-window-start (selected-window)
@@ -244,40 +243,41 @@ BITS must be of length nrings. Start at START-TIME."
;; the car is the position of the top ring currently on the pole,
;; (or the base of the pole if it is empty).
;; the cdr is in the fly-row just above the pole.
- (poles (loop for coord in pole-coords
- for fly-pos = (+ fly-row-start (* fly-step coord))
- for base = (+ fly-pos (* baseward-step (+ 2 nrings)))
- collect (cons base fly-pos)))
+ (poles
+ (cl-loop for coord in pole-coords
+ for fly-pos = (+ fly-row-start (* fly-step coord))
+ for base = (+ fly-pos (* baseward-step (+ 2 nrings)))
+ collect (cons base fly-pos)))
;; compute the string for each ring and make the list of
;; ring pairs. Each ring pair is initially (str . diameter).
;; Once placed in buffer it is changed to (center-pos . diameter).
(rings
- (loop
- ;; radii are measured from the edge of the pole out.
- ;; So diameter = 2 * radius + pole-width. When
- ;; there's room, we make each ring's radius =
- ;; pole-number + 1. If there isn't room, we step
- ;; evenly from the max radius down to 1.
- with max-radius = (min nrings
- (/ (- max-ring-diameter pole-width) 2))
- for n from (1- nrings) downto 0
- for radius = (1+ (/ (* n max-radius) nrings))
- for diameter = (+ pole-width (* 2 radius))
- with format-str = (format "%%0%dd" pole-width)
- for str = (concat (if vert "<" "^")
- (make-string (1- radius) (if vert ?\- ?\|))
- (format format-str n)
- (make-string (1- radius) (if vert ?\- ?\|))
- (if vert ">" "v"))
- for face =
- (if (eq (logand n 1) 1) ; oddp would require cl at runtime
- hanoi-odd-ring-face hanoi-even-ring-face)
- do (hanoi-put-face 0 (length str) face str)
- collect (cons str diameter)))
+ (cl-loop
+ ;; radii are measured from the edge of the pole out.
+ ;; So diameter = 2 * radius + pole-width. When
+ ;; there's room, we make each ring's radius =
+ ;; pole-number + 1. If there isn't room, we step
+ ;; evenly from the max radius down to 1.
+ with max-radius = (min nrings
+ (/ (- max-ring-diameter pole-width) 2))
+ for n from (1- nrings) downto 0
+ for radius = (1+ (/ (* n max-radius) nrings))
+ for diameter = (+ pole-width (* 2 radius))
+ with format-str = (format "%%0%dd" pole-width)
+ for str = (concat (if vert "<" "^")
+ (make-string (1- radius) (if vert ?\- ?\|))
+ (format format-str n)
+ (make-string (1- radius) (if vert ?\- ?\|))
+ (if vert ">" "v"))
+ for face =
+ (if (eq (logand n 1) 1) ; oddp would require cl at runtime
+ hanoi-odd-ring-face hanoi-even-ring-face)
+ do (hanoi-put-face 0 (length str) face str)
+ collect (cons str diameter)))
;; Disable display of line and column numbers, for speed.
(line-number-mode nil) (column-number-mode nil))
;; do it!
- (hanoi-n bits rings (car poles) (cadr poles) (caddr poles)
+ (hanoi-n bits rings (car poles) (cadr poles) (cl-caddr poles)
start-time))
(message "Done"))
(setq buffer-read-only t)
@@ -322,14 +322,14 @@ BITS must be of length nrings. Start at START-TIME."
;; put never-before-placed RING on POLE and update their cars.
(defun hanoi-insert-ring (ring pole)
- (decf (car pole) baseward-step)
+ (cl-decf (car pole) baseward-step)
(let ((str (car ring))
(start (- (car pole) (* (/ (cdr ring) 2) fly-step))))
(setcar ring (car pole))
- (loop for pos upfrom start by fly-step
- for i below (cdr ring) do
- (subst-char-in-region pos (1+ pos) (char-after pos) (aref str i))
- (set-text-properties pos (1+ pos) (text-properties-at i str)))
+ (cl-loop for pos upfrom start by fly-step
+ for i below (cdr ring) do
+ (subst-char-in-region pos (1+ pos) (char-after pos) (aref str i))
+ (set-text-properties pos (1+ pos) (text-properties-at i str)))
(hanoi-goto-char (car pole))))
;; like goto-char, but if position is outside the window, then move to
@@ -341,8 +341,8 @@ BITS must be of length nrings. Start at START-TIME."
;; do one pole-to-pole move and update the ring and pole pairs.
(defun hanoi-move-ring (ring from to start-time)
- (incf (car from) baseward-step)
- (decf (car to) baseward-step)
+ (cl-incf (car from) baseward-step)
+ (cl-decf (car to) baseward-step)
(let* ;; We move flywards-steps steps up the pole to the fly row,
;; then fly fly-steps steps across the fly row, then go
;; baseward-steps steps down the new pole.
@@ -378,15 +378,15 @@ BITS must be of length nrings. Start at START-TIME."
(/ (- tick flyward-ticks fly-ticks)
ticks-per-pole-step))))))))
(if hanoi-move-period
- (loop for elapsed = (- (float-time) start-time)
- while (< elapsed hanoi-move-period)
- with tick-period = (/ (float hanoi-move-period) total-ticks)
- for tick = (ceiling (/ elapsed tick-period)) do
- (hanoi-ring-to-pos ring (funcall tick-to-pos tick))
- (hanoi-sit-for (- (* tick tick-period) elapsed)))
- (loop for tick from 1 to total-ticks by 2 do
- (hanoi-ring-to-pos ring (funcall tick-to-pos tick))
- (hanoi-sit-for 0)))
+ (cl-loop for elapsed = (- (float-time) start-time)
+ while (< elapsed hanoi-move-period)
+ with tick-period = (/ (float hanoi-move-period) total-ticks)
+ for tick = (ceiling (/ elapsed tick-period)) do
+ (hanoi-ring-to-pos ring (funcall tick-to-pos tick))
+ (hanoi-sit-for (- (* tick tick-period) elapsed)))
+ (cl-loop for tick from 1 to total-ticks by 2 do
+ (hanoi-ring-to-pos ring (funcall tick-to-pos tick))
+ (hanoi-sit-for 0)))
;; Always make last move to keep pole and ring data consistent
(hanoi-ring-to-pos ring (car to))
(if hanoi-move-period (+ start-time hanoi-move-period))))
@@ -403,11 +403,12 @@ BITS must be of length nrings. Start at START-TIME."
(let* ((start (- (car ring) (* (/ (cdr ring) 2) fly-step)))
(new-start (- pos (- (car ring) start))))
(if hanoi-horizontal-flag
- (loop for i below (cdr ring)
- for j = (if (< new-start start) i (- (cdr ring) i 1))
- for old-pos = (+ start (* j fly-step))
- for new-pos = (+ new-start (* j fly-step)) do
- (transpose-regions old-pos (1+ old-pos) new-pos (1+ new-pos)))
+ (cl-loop for i below (cdr ring)
+ for j = (if (< new-start start) i (- (cdr ring) i 1))
+ for old-pos = (+ start (* j fly-step))
+ for new-pos = (+ new-start (* j fly-step)) do
+ (transpose-regions old-pos (1+ old-pos)
+ new-pos (1+ new-pos)))
(let ((end (+ start (cdr ring)))
(new-end (+ new-start (cdr ring))))
(if (< (abs (- new-start start)) (- end start))
@@ -425,9 +426,9 @@ BITS must be of length nrings. Start at START-TIME."
(curr-char (if on-pole ?\ pole-char))
(face (if on-pole hanoi-pole-face nil)))
(if hanoi-horizontal-flag
- (loop for pos from pole-start below pole-end by line-offset do
- (subst-char-in-region pos (1+ pos) curr-char new-char)
- (hanoi-put-face pos (1+ pos) face))
+ (cl-loop for pos from pole-start below pole-end by line-offset do
+ (subst-char-in-region pos (1+ pos) curr-char new-char)
+ (hanoi-put-face pos (1+ pos) face))
(subst-char-in-region pole-start pole-end curr-char new-char)
(hanoi-put-face pole-start pole-end face))))
(setcar ring pos))
diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el
index 9ef03725c60..e103249da49 100644
--- a/lisp/play/landmark.el
+++ b/lisp/play/landmark.el
@@ -1,6 +1,6 @@
;;; landmark.el --- neural-network robot that learns landmarks
-;; Copyright (C) 1996-1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Terrence Brannon (was: <brannon@rana.usc.edu>)
;; Created: December 16, 1996 - first release to usenet
@@ -56,7 +56,7 @@
;; concise problem description.
;;;_* Require
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;;_* From Gomoku
@@ -139,16 +139,16 @@
;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1).
(defconst landmark-square-width 2
- "*Horizontal spacing between squares on the Landmark board.")
+ "Horizontal spacing between squares on the Landmark board.")
(defconst landmark-square-height 1
- "*Vertical spacing between squares on the Landmark board.")
+ "Vertical spacing between squares on the Landmark board.")
(defconst landmark-x-offset 3
- "*Number of columns between the Landmark board and the side of the window.")
+ "Number of columns between the Landmark board and the side of the window.")
(defconst landmark-y-offset 1
- "*Number of lines between the Landmark board and the top of the window.")
+ "Number of lines between the Landmark board and the top of the window.")
;;;_ + LANDMARK MODE AND KEYMAP.
@@ -206,11 +206,11 @@
(defvar landmark-emacs-won ()
- "*For making font-lock use the winner's face for the line.")
+ "For making font-lock use the winner's face for the line.")
(defface landmark-font-lock-face-O '((((class color)) :foreground "red")
(t :weight bold))
- "Face to use for Emacs' O."
+ "Face to use for Emacs's O."
:version "22.1"
:group 'landmark)
@@ -226,7 +226,7 @@
("[-|/\\]" 0 (if landmark-emacs-won
'landmark-font-lock-face-O
'landmark-font-lock-face-X)))
- "*Font lock rules for Landmark.")
+ "Font lock rules for Landmark.")
(put 'landmark-mode 'front-sticky
(put 'landmark-mode 'rear-nonsticky '(intangible)))
@@ -1417,7 +1417,7 @@ After this limit is reached, landmark-random-move is called to push him out of i
(put 'z 't-1 (get 'z 't))
(put 'z 't (calc-smell-internal 'landmark-tree))
(if (= (- (get 'z 't) (get 'z 't-1)) 0.0)
- (incf landmark-no-payoff)
+ (cl-incf landmark-no-payoff)
(setf landmark-no-payoff 0)))
(defun landmark-store-old-y_t ()
@@ -1464,7 +1464,7 @@ After this limit is reached, landmark-random-move is called to push him out of i
(landmark-e forward-char)
(landmark-w backward-char)))
(landmark-plot-square (landmark-point-square) 1)
- (incf landmark-number-of-moves)
+ (cl-incf landmark-number-of-moves)
(if landmark-output-moves
(message "Moves made: %d" landmark-number-of-moves)))
@@ -1591,11 +1591,11 @@ If the game is finished, this command requests for another game."
; this a worka!
; (eval (cons '+ list))
;;;_ - landmark-set-landmark-signal-strengths ()
-;;; on a screen higher than wide, I noticed that the robot would amble
-;;; left and right and not move forward. examining *landmark-blackbox*
-;;; revealed that there was no scent from the north and south
-;;; landmarks, hence, they need less factoring down of the effect of
-;;; distance on scent.
+;; on a screen higher than wide, I noticed that the robot would amble
+;; left and right and not move forward. examining *landmark-blackbox*
+;; revealed that there was no scent from the north and south
+;; landmarks, hence, they need less factoring down of the effect of
+;; distance on scent.
(defun landmark-set-landmark-signal-strengths ()
(setq landmark-tree-r (* (sqrt (+ (square landmark-cx) (square landmark-cy))) 1.5))
@@ -1683,8 +1683,6 @@ Use \\[describe-mode] for more info."
;;;allout-layout: (0 : -1 -1 0)
;;;End:
-(random t)
-
(provide 'landmark)
;;; landmark.el ends here
diff --git a/lisp/play/life.el b/lisp/play/life.el
index 7cdc4136194..87ec0226af5 100644
--- a/lisp/play/life.el
+++ b/lisp/play/life.el
@@ -1,6 +1,6 @@
;;; life.el --- John Horton Conway's `Life' game for GNU Emacs
-;; Copyright (C) 1988, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2012 Free Software Foundation, Inc.
;; Author: Kyle Jones <kyleuunet.uu.net>
;; Maintainer: FSF
@@ -111,9 +111,6 @@
;; Sadly, mode-line-format won't display numbers.
(defvar life-generation-string nil)
-(defvar life-initialized nil
- "Non-nil if `life' has been run at least once.")
-
;;;###autoload
(defun life (&optional sleeptime)
"Run Conway's Life simulation.
@@ -121,9 +118,6 @@ The starting pattern is randomly selected. Prefix arg (optional first
arg non-nil from a program) is the number of seconds to sleep between
generations (this defaults to 1)."
(interactive "p")
- (or life-initialized
- (random t))
- (setq life-initialized t)
(or sleeptime (setq sleeptime 1))
(life-setup)
(catch 'life-exit
diff --git a/lisp/play/morse.el b/lisp/play/morse.el
index fa0887c0ac5..6bf34ddb851 100644
--- a/lisp/play/morse.el
+++ b/lisp/play/morse.el
@@ -1,6 +1,6 @@
;;; morse.el --- convert text to morse code and back -*- coding: utf-8 -*-
-;; Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Rick Farnbach <rick_farnbach@MENTORG.COM>
;; Keywords: games
diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el
index 3e1659628f4..e16bb2f1bde 100644
--- a/lisp/play/mpuz.el
+++ b/lisp/play/mpuz.el
@@ -1,6 +1,6 @@
;;; mpuz.el --- multiplication puzzle for GNU Emacs
-;; Copyright (C) 1990, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 2001-2012 Free Software Foundation, Inc.
;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr>
;; Overhauled: Daniel Pfeiffer <occitan@esperanto.org>
@@ -35,8 +35,6 @@
:prefix "mpuz-"
:group 'games)
-(random t) ; randomize
-
(defcustom mpuz-silent 'error
"Set this to nil if you want dings on inputs.
The value t means never ding, and `error' means only ding on wrong input."
@@ -56,26 +54,26 @@ The value t means never ding, and `error' means only ding on wrong input."
:group 'mpuz)
(defface mpuz-unsolved
- '((((class color)) (:foreground "red1" :bold t))
- (t (:bold t)))
- "Face to use for letters to be solved."
+ '((default :weight bold)
+ (((class color)) :foreground "red1"))
+ "Face for letters to be solved."
:group 'mpuz)
(defface mpuz-solved
- '((((class color)) (:foreground "green1" :bold t))
- (t (:bold t)))
- "Face to use for solved digits."
+ '((default :weight bold)
+ (((class color)) :foreground "green1"))
+ "Face for solved digits."
:group 'mpuz)
(defface mpuz-trivial
- '((((class color)) (:foreground "blue" :bold t))
- (t (:bold t)))
- "Face to use for trivial digits solved for you."
+ '((default :weight bold)
+ (((class color)) :foreground "blue"))
+ "Face for trivial digits solved for you."
:group 'mpuz)
(defface mpuz-text
- '((t (:inherit variable-pitch)))
- "Face to use for text on right."
+ '((t :inherit variable-pitch))
+ "Face for text on right."
:group 'mpuz)
diff --git a/lisp/play/pong.el b/lisp/play/pong.el
index e993e769756..cb165cdf31e 100644
--- a/lisp/play/pong.el
+++ b/lisp/play/pong.el
@@ -1,6 +1,6 @@
;;; pong.el --- classical implementation of pong
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Benjamin Drieu <bdrieu@april.org>
;; Keywords: games
@@ -26,7 +26,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'gamegrid)
@@ -214,18 +214,18 @@
(defun pong-display-options ()
"Computes display options (required by gamegrid for colors)."
(let ((options (make-vector 256 nil)))
- (loop for c from 0 to 255 do
+ (dotimes (c 256)
(aset options c
- (cond ((= c pong-blank)
- pong-blank-options)
+ (cond ((= c pong-blank)
+ pong-blank-options)
((= c pong-bat)
- pong-bat-options)
+ pong-bat-options)
((= c pong-ball)
- pong-ball-options)
+ pong-ball-options)
((= c pong-border)
- pong-border-options)
+ pong-border-options)
(t
- '(nil nil nil)))))
+ '(nil nil nil)))))
options))
@@ -246,18 +246,19 @@
?\s)
(let ((buffer-read-only nil))
- (loop for y from 0 to (1- pong-height) do
- (loop for x from 0 to (1- pong-width) do
- (gamegrid-set-cell x y pong-border)))
- (loop for y from 1 to (- pong-height 2) do
- (loop for x from 1 to (- pong-width 2) do
- (gamegrid-set-cell x y pong-blank))))
-
- (loop for y from pong-bat-player1 to (1- (+ pong-bat-player1 pong-bat-width)) do
- (gamegrid-set-cell 2 y pong-bat))
- (loop for y from pong-bat-player2 to (1- (+ pong-bat-player2 pong-bat-width)) do
- (gamegrid-set-cell (- pong-width 3) y pong-bat)))
+ (dotimes (y pong-height)
+ (dotimes (x pong-width)
+ (gamegrid-set-cell x y pong-border)))
+ (cl-loop for y from 1 to (- pong-height 2) do
+ (cl-loop for x from 1 to (- pong-width 2) do
+ (gamegrid-set-cell x y pong-blank))))
+ (cl-loop for y from pong-bat-player1
+ to (1- (+ pong-bat-player1 pong-bat-width))
+ do (gamegrid-set-cell 2 y pong-bat))
+ (cl-loop for y from pong-bat-player2
+ to (1- (+ pong-bat-player2 pong-bat-width))
+ do (gamegrid-set-cell (- pong-width 3) y pong-bat)))
(defun pong-move-left ()
@@ -401,13 +402,12 @@ detection and checks if a player scores."
(defun pong-update-score ()
"Update score and print it on bottom of the game grid."
- (let* ((string (format "Score: %d / %d" pong-score-player1 pong-score-player2))
+ (let* ((string (format "Score: %d / %d"
+ pong-score-player1 pong-score-player2))
(len (length string)))
- (loop for x from 0 to (1- len) do
- (if (string-equal (buffer-name (current-buffer)) pong-buffer-name)
- (gamegrid-set-cell x
- pong-height
- (aref string x))))))
+ (dotimes (x len)
+ (if (string-equal (buffer-name (current-buffer)) pong-buffer-name)
+ (gamegrid-set-cell x pong-height (aref string x))))))
diff --git a/lisp/play/snake.el b/lisp/play/snake.el
index 418c898e825..a3480d0b0fa 100644
--- a/lisp/play/snake.el
+++ b/lisp/play/snake.el
@@ -1,6 +1,6 @@
;;; snake.el --- implementation of Snake for Emacs
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Glynn Clements <glynn@sensei.co.uk>
;; Created: 1997-09-10
@@ -25,8 +25,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'gamegrid)
@@ -195,7 +194,7 @@ and then start moving it leftwards.")
(defun snake-display-options ()
(let ((options (make-vector 256 nil)))
- (loop for c from 0 to 255 do
+ (dotimes (c 256)
(aset options c
(cond ((= c snake-blank)
snake-blank-options)
@@ -214,7 +213,7 @@ and then start moving it leftwards.")
(defun snake-update-score ()
(let* ((string (format "Score: %05d" snake-score))
(len (length string)))
- (loop for x from 0 to (1- len) do
+ (dotimes (x len)
(gamegrid-set-cell (+ snake-score-x x)
snake-score-y
(aref string x)))))
@@ -224,12 +223,12 @@ and then start moving it leftwards.")
snake-buffer-height
snake-space)
(let ((buffer-read-only nil))
- (loop for y from 0 to (1- snake-height) do
- (loop for x from 0 to (1- snake-width) do
- (gamegrid-set-cell x y snake-border)))
- (loop for y from 1 to (- snake-height 2) do
- (loop for x from 1 to (- snake-width 2) do
- (gamegrid-set-cell x y snake-blank)))))
+ (dotimes (y snake-height)
+ (dotimes (x snake-width)
+ (gamegrid-set-cell x y snake-border)))
+ (cl-loop for y from 1 to (- snake-height 2) do
+ (cl-loop for x from 1 to (- snake-width 2) do
+ (gamegrid-set-cell x y snake-blank)))))
(defun snake-reset-game ()
(gamegrid-kill-timer)
@@ -248,8 +247,8 @@ and then start moving it leftwards.")
(dotimes (i snake-length)
(gamegrid-set-cell x y snake-snake)
(setq snake-positions (cons (vector x y) snake-positions))
- (incf x snake-velocity-x)
- (incf y snake-velocity-y)))
+ (cl-incf x snake-velocity-x)
+ (cl-incf y snake-velocity-y)))
(snake-update-score))
(defun snake-update-game (snake-buffer)
@@ -267,8 +266,8 @@ Argument SNAKE-BUFFER is the name of the buffer."
(= c snake-snake))
(snake-end-game)
(cond ((= c snake-dot)
- (incf snake-length)
- (incf snake-score)
+ (cl-incf snake-length)
+ (cl-incf snake-score)
(snake-update-score))
(t
(let* ((last-cons (nthcdr (- snake-length 2)
@@ -280,7 +279,7 @@ Argument SNAKE-BUFFER is the name of the buffer."
(if (= (% snake-cycle 5) 0)
snake-dot
snake-blank))
- (incf snake-cycle)
+ (cl-incf snake-cycle)
(setcdr last-cons nil))))
(gamegrid-set-cell x y snake-snake)
(setq snake-positions
diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el
index b52ade6fdb7..f249faa0e15 100644
--- a/lisp/play/solitaire.el
+++ b/lisp/play/solitaire.el
@@ -1,6 +1,6 @@
;;; solitaire.el --- game of solitaire in Emacs Lisp
-;; Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Jan Schormann <Jan.Schormann@rechen-gilde.de>
;; Created: Fri afternoon, Jun 3, 1994
@@ -201,12 +201,12 @@ Pick your favorite shortcuts:
(setq buffer-read-only t)
(setq solitaire-stones 32)
(solitaire-insert-board)
- (solitaire-build-modeline)
+ (solitaire-build-mode-line)
(goto-char (point-max))
(setq solitaire-center (search-backward "."))
(setq buffer-undo-list (list (point)))))
-(defun solitaire-build-modeline ()
+(defun solitaire-build-mode-line ()
(setq mode-line-format
(list "" "---" 'mode-line-buffer-identification
(if (< 1 solitaire-stones)
@@ -353,7 +353,7 @@ which a stone will be taken away) and target."
(insert ?o)
(goto-char target)
(setq solitaire-stones (1- solitaire-stones))
- (solitaire-build-modeline)
+ (solitaire-build-mode-line)
(if solitaire-auto-eval (solitaire-do-check))))))
(defun solitaire-undo (arg)
@@ -372,7 +372,7 @@ which a stone will be taken away) and target."
(<= (solitaire-current-line) solitaire-end-y)
(setq count (1+ count))))
count)))
- (solitaire-build-modeline)
+ (solitaire-build-mode-line)
(when solitaire-auto-eval (solitaire-do-check)))
(defun solitaire-check ()
diff --git a/lisp/play/spook.el b/lisp/play/spook.el
index 6cab994a9cc..e79df0e88c7 100644
--- a/lisp/play/spook.el
+++ b/lisp/play/spook.el
@@ -1,6 +1,6 @@
;;; spook.el --- spook phrase utility for overloading the NSA line eater
-;; Copyright (C) 1988, 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1993, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: games
diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el
index 053b07adfc7..9cc33304589 100644
--- a/lisp/play/tetris.el
+++ b/lisp/play/tetris.el
@@ -1,6 +1,6 @@
;;; tetris.el --- implementation of Tetris for Emacs
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Glynn Clements <glynn@sensei.co.uk>
;; Version: 2.01
@@ -26,8 +26,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'gamegrid)
@@ -285,20 +284,20 @@ each one of its four blocks.")
(defun tetris-display-options ()
(let ((options (make-vector 256 nil)))
- (loop for c from 0 to 255 do
+ (dotimes (c 256)
(aset options c
(cond ((= c tetris-blank)
- tetris-blank-options)
+ tetris-blank-options)
((and (>= c 0) (<= c 6))
(append
tetris-cell-options
`((((glyph color-x) ,(aref tetris-x-colors c))
(color-tty ,(aref tetris-tty-colors c))
(t nil)))))
- ((= c tetris-border)
- tetris-border-options)
- ((= c tetris-space)
- tetris-space-options)
+ ((= c tetris-border)
+ tetris-border-options)
+ ((= c tetris-space)
+ tetris-space-options)
(t
'(nil nil nil)))))
options))
@@ -325,13 +324,13 @@ each one of its four blocks.")
(let ((strings (vector (format "Shapes: %05d" tetris-n-shapes)
(format "Rows: %05d" tetris-n-rows)
(format "Score: %05d" tetris-score))))
- (loop for y from 0 to 2 do
- (let* ((string (aref strings y))
- (len (length string)))
- (loop for x from 0 to (1- len) do
- (gamegrid-set-cell (+ tetris-score-x x)
- (+ tetris-score-y y)
- (aref string x)))))))
+ (dotimes (y 3)
+ (let* ((string (aref strings y))
+ (len (length string)))
+ (dotimes (x len)
+ (gamegrid-set-cell (+ tetris-score-x x)
+ (+ tetris-score-y y)
+ (aref string x)))))))
(defun tetris-update-score ()
(tetris-draw-score)
@@ -351,88 +350,88 @@ each one of its four blocks.")
(tetris-update-score)))
(defun tetris-draw-next-shape ()
- (loop for x from 0 to 3 do
- (loop for y from 0 to 3 do
- (gamegrid-set-cell (+ tetris-next-x x)
- (+ tetris-next-y y)
- tetris-blank)))
- (loop for i from 0 to 3 do
- (let ((tetris-shape tetris-next-shape)
- (tetris-rot 0))
- (gamegrid-set-cell (+ tetris-next-x
- (aref (tetris-get-shape-cell i) 0))
- (+ tetris-next-y
- (aref (tetris-get-shape-cell i) 1))
- tetris-shape))))
+ (dotimes (x 4)
+ (dotimes (y 4)
+ (gamegrid-set-cell (+ tetris-next-x x)
+ (+ tetris-next-y y)
+ tetris-blank)))
+ (dotimes (i 4)
+ (let ((tetris-shape tetris-next-shape)
+ (tetris-rot 0))
+ (gamegrid-set-cell (+ tetris-next-x
+ (aref (tetris-get-shape-cell i) 0))
+ (+ tetris-next-y
+ (aref (tetris-get-shape-cell i) 1))
+ tetris-shape))))
(defun tetris-draw-shape ()
- (loop for i from 0 to 3 do
- (let ((c (tetris-get-shape-cell i)))
- (gamegrid-set-cell (+ tetris-top-left-x
- tetris-pos-x
- (aref c 0))
- (+ tetris-top-left-y
- tetris-pos-y
- (aref c 1))
- tetris-shape))))
+ (dotimes (i 4)
+ (let ((c (tetris-get-shape-cell i)))
+ (gamegrid-set-cell (+ tetris-top-left-x
+ tetris-pos-x
+ (aref c 0))
+ (+ tetris-top-left-y
+ tetris-pos-y
+ (aref c 1))
+ tetris-shape))))
(defun tetris-erase-shape ()
- (loop for i from 0 to 3 do
- (let ((c (tetris-get-shape-cell i)))
- (gamegrid-set-cell (+ tetris-top-left-x
- tetris-pos-x
- (aref c 0))
- (+ tetris-top-left-y
- tetris-pos-y
- (aref c 1))
- tetris-blank))))
+ (dotimes (i 4)
+ (let ((c (tetris-get-shape-cell i)))
+ (gamegrid-set-cell (+ tetris-top-left-x
+ tetris-pos-x
+ (aref c 0))
+ (+ tetris-top-left-y
+ tetris-pos-y
+ (aref c 1))
+ tetris-blank))))
(defun tetris-test-shape ()
(let ((hit nil))
- (loop for i from 0 to 3 do
- (unless hit
- (setq hit
- (let* ((c (tetris-get-shape-cell i))
- (xx (+ tetris-pos-x
- (aref c 0)))
- (yy (+ tetris-pos-y
- (aref c 1))))
- (or (>= xx tetris-width)
- (>= yy tetris-height)
- (/= (gamegrid-get-cell
- (+ xx tetris-top-left-x)
- (+ yy tetris-top-left-y))
- tetris-blank))))))
+ (dotimes (i 4)
+ (unless hit
+ (setq hit
+ (let* ((c (tetris-get-shape-cell i))
+ (xx (+ tetris-pos-x
+ (aref c 0)))
+ (yy (+ tetris-pos-y
+ (aref c 1))))
+ (or (>= xx tetris-width)
+ (>= yy tetris-height)
+ (/= (gamegrid-get-cell
+ (+ xx tetris-top-left-x)
+ (+ yy tetris-top-left-y))
+ tetris-blank))))))
hit))
(defun tetris-full-row (y)
(let ((full t))
- (loop for x from 0 to (1- tetris-width) do
- (if (= (gamegrid-get-cell (+ tetris-top-left-x x)
- (+ tetris-top-left-y y))
- tetris-blank)
- (setq full nil)))
+ (dotimes (x tetris-width)
+ (if (= (gamegrid-get-cell (+ tetris-top-left-x x)
+ (+ tetris-top-left-y y))
+ tetris-blank)
+ (setq full nil)))
full))
(defun tetris-shift-row (y)
(if (= y 0)
- (loop for x from 0 to (1- tetris-width) do
+ (dotimes (x tetris-width)
(gamegrid-set-cell (+ tetris-top-left-x x)
(+ tetris-top-left-y y)
tetris-blank))
- (loop for x from 0 to (1- tetris-width) do
- (let ((c (gamegrid-get-cell (+ tetris-top-left-x x)
- (+ tetris-top-left-y y -1))))
- (gamegrid-set-cell (+ tetris-top-left-x x)
- (+ tetris-top-left-y y)
+ (dotimes (x tetris-width)
+ (let ((c (gamegrid-get-cell (+ tetris-top-left-x x)
+ (+ tetris-top-left-y y -1))))
+ (gamegrid-set-cell (+ tetris-top-left-x x)
+ (+ tetris-top-left-y y)
c)))))
(defun tetris-shift-down ()
- (loop for y0 from 0 to (1- tetris-height) do
- (if (tetris-full-row y0)
- (progn (setq tetris-n-rows (1+ tetris-n-rows))
- (loop for y from y0 downto 0 do
- (tetris-shift-row y))))))
+ (dotimes (y0 tetris-height)
+ (when (tetris-full-row y0)
+ (setq tetris-n-rows (1+ tetris-n-rows))
+ (cl-loop for y from y0 downto 0 do
+ (tetris-shift-row y)))))
(defun tetris-draw-border-p ()
(or (not (eq gamegrid-display-mode 'glyph))
@@ -444,22 +443,22 @@ each one of its four blocks.")
tetris-space)
(let ((buffer-read-only nil))
(if (tetris-draw-border-p)
- (loop for y from -1 to tetris-height do
- (loop for x from -1 to tetris-width do
- (gamegrid-set-cell (+ tetris-top-left-x x)
- (+ tetris-top-left-y y)
- tetris-border))))
- (loop for y from 0 to (1- tetris-height) do
- (loop for x from 0 to (1- tetris-width) do
- (gamegrid-set-cell (+ tetris-top-left-x x)
- (+ tetris-top-left-y y)
- tetris-blank)))
+ (cl-loop for y from -1 to tetris-height do
+ (cl-loop for x from -1 to tetris-width do
+ (gamegrid-set-cell (+ tetris-top-left-x x)
+ (+ tetris-top-left-y y)
+ tetris-border))))
+ (dotimes (y tetris-height)
+ (dotimes (x tetris-width)
+ (gamegrid-set-cell (+ tetris-top-left-x x)
+ (+ tetris-top-left-y y)
+ tetris-blank)))
(if (tetris-draw-border-p)
- (loop for y from -1 to 4 do
- (loop for x from -1 to 4 do
- (gamegrid-set-cell (+ tetris-next-x x)
- (+ tetris-next-y y)
- tetris-border))))))
+ (cl-loop for y from -1 to 4 do
+ (cl-loop for x from -1 to 4 do
+ (gamegrid-set-cell (+ tetris-next-x x)
+ (+ tetris-next-y y)
+ tetris-border))))))
(defun tetris-reset-game ()
(gamegrid-kill-timer)
@@ -636,8 +635,6 @@ tetris-mode keybindings:
(tetris-mode)
(tetris-start-game))
-(random t)
-
(provide 'tetris)
;;; tetris.el ends here
diff --git a/lisp/play/yow.el b/lisp/play/yow.el
index d75e04eb74f..cb02a839cde 100644
--- a/lisp/play/yow.el
+++ b/lisp/play/yow.el
@@ -1,6 +1,6 @@
;;; yow.el --- quote random zippyisms
-;; Copyright (C) 1993-1995, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Author: Richard Mlynarik
@@ -24,10 +24,6 @@
;;; Commentary:
;; Important pinheadery for GNU Emacs.
-;;
-;; See cookie1.el for implementation. Note --- the `n' argument of yow
-;; from the 18.xx implementation is no longer; we only support *random*
-;; random access now.
;;; Code:
@@ -38,7 +34,7 @@
:prefix "yow-"
:group 'games)
-(defcustom yow-file (concat data-directory "yow.lines")
+(defcustom yow-file (expand-file-name "yow.lines" data-directory)
"File containing pertinent pinhead phrases."
:type 'file
:group 'yow)
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index d194a8af919..1cfc6c59987 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -1,6 +1,6 @@
;;; zone.el --- idle display hacks
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Victor Zandy <zandy@cs.wisc.edu>
;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
@@ -30,9 +30,6 @@
;; Bored by the zone pyrotechnics? Write your own! Add it to
;; `zone-programs'. See `zone-call' for higher-ordered zoning.
-;; WARNING: Not appropriate for Emacs sessions over modems or
-;; computers as slow as mine.
-
;; THANKS: Christopher Mayer, Scott Flinchbaugh,
;; Rachel Kalmar, Max Froumentin, Juri Linkov,
;; Luigi Panzeri, John Paul Wallington.
@@ -43,7 +40,7 @@
"The timer we use to decide when to zone out, or nil if none.")
(defvar zone-timeout nil
- "*Seconds to timeout the zoning.
+ "Seconds to timeout the zoning.
If nil, don't interrupt for about 1^26 seconds.")
;; Vector of functions that zone out. `zone' will execute one of
@@ -78,7 +75,7 @@ If nil, don't interrupt for about 1^26 seconds.")
`(with-current-buffer (get 'zone 'orig-buffer)
,@body))
-(defmacro zone-hiding-modeline (&rest body)
+(defmacro zone-hiding-mode-line (&rest body)
;; This formerly worked by temporarily altering face `mode-line',
;; which did not even work right, it seems.
`(let (mode-line-format)
@@ -116,7 +113,6 @@ If the element is a function or a list of a function and a number,
(wp (1+ (- (window-point (selected-window))
(window-start)))))
(put 'zone 'orig-buffer (current-buffer))
- (put 'zone 'modeline-hidden-level 0)
(switch-to-buffer outbuf)
(setq mode-name "Zone")
(erase-buffer)
@@ -586,7 +582,7 @@ If the element is a function or a list of a function and a number,
(setq ok (zerop (forward-line 1))
lines (cons (buffer-substring p (point)) lines))))
(sit-for 5)
- (zone-hiding-modeline
+ (zone-hiding-mode-line
(let ((msg "Zoning... (zone-pgm-stress)"))
(while (not (string= msg ""))
(message (setq msg (substring msg 1)))
@@ -595,8 +591,7 @@ If the element is a function or a list of a function and a number,
(when (< 50 (random 100))
(goto-char (point-max))
(forward-line -1)
- (let ((kill-whole-line t))
- (kill-line))
+ (delete-region (point) (line-beginning-position 2))
(goto-char (point-min))
(insert (nth (random (length lines)) lines)))
(message (concat (make-string (random (- (frame-width) 5)) ? ) "grrr"))
@@ -604,7 +599,7 @@ If the element is a function or a list of a function and a number,
(defun zone-pgm-stress-destress ()
(zone-call 'zone-pgm-stress 25)
- (zone-hiding-modeline
+ (zone-hiding-mode-line
(sit-for 3)
(erase-buffer)
(sit-for 3)
@@ -623,7 +618,7 @@ If the element is a function or a list of a function and a number,
;;;; the lyfe so short the craft so long to lerne --chaucer
(defvar zone-pgm-random-life-wait nil
- "*Seconds to wait between successive `life' generations.
+ "Seconds to wait between successive `life' generations.
If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
(defvar life-patterns) ; from life.el
@@ -680,8 +675,6 @@ If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
(kill-buffer nil))))
-(random t)
-
;;;;;;;;;;;;;;;
(provide 'zone)
diff --git a/lisp/printing.el b/lisp/printing.el
index a604b9f1027..26a7648f68e 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -1,6 +1,6 @@
;;; printing.el --- printing utilities
-;; Copyright (C) 2000-2001, 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2001, 2003-2012 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
@@ -139,10 +139,9 @@ Please send all bug fixes and enhancements to
;;
;; One way to set variables is by calling `pr-customize', customize all
;; variables and save the customization by future sessions (see Options
-;; section). Other way is by coding your settings on Emacs init file (that is,
-;; ~/.emacs file), see below for a first setting template that it should be
-;; inserted on your ~/.emacs file (or c:/_emacs, if you're using Windows 9x/NT
-;; or MS-DOS):
+;; section). Other way is by adding code to your init file; see below
+;; for a first setting template that it should be inserted on your
+;; init file:
;;
;; * Example of setting for Windows system:
;;
@@ -297,8 +296,7 @@ Please send all bug fixes and enhancements to
;; Using `printing'
;; ----------------
;;
-;; To use `printing' insert in your ~/.emacs file (or c:/_emacs, if you're
-;; using Windows 9x/NT or MS-DOS):
+;; To use `printing' insert in your init file:
;;
;; (require 'printing)
;; ;; ...some user settings...
@@ -1385,6 +1383,10 @@ Used by `pr-menu-bind' and `pr-update-menus'.")
(eval-when-compile
(require 'easymenu)) ; to avoid compilation gripes
+ (declare-function easy-menu-add-item "easymenu"
+ (map path item &optional before))
+ (declare-function easy-menu-remove-item "easymenu" (map path name))
+
(eval-and-compile
(defun pr-global-menubar (pr-menu-spec)
(require 'easymenu)
@@ -2141,7 +2143,7 @@ Useful links:
`http://bama.ua.edu/cgi-bin/man-cgi?lp'
`http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lp'
-* GNU utilities for Win32 (cp.exe)
+* GNU utilities for w32 (cp.exe)
`http://unxutils.sourceforge.net/'
"
:type '(repeat
@@ -6081,6 +6083,8 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(and pr-i-region ; let region activated
(pr-keep-region-active)))
+(declare-function widget-field-action "wid-edit" (widget &optional _event))
+(declare-function widget-value-set "wid-edit" (widget value))
(defun pr-insert-section-1 ()
;; 1. Print:
diff --git a/lisp/proced.el b/lisp/proced.el
index baee7c0f6ee..e3ff9fb5c95 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -1,6 +1,6 @@
;;; proced.el --- operate on system processes like dired
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Roland Winkler <winkler@gnu.org>
;; Keywords: Processes, Unix
@@ -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 ()
@@ -659,11 +672,14 @@ After displaying or updating a Proced buffer, Proced runs the normal hook
;;;###autoload
(defun proced (&optional arg)
"Generate a listing of UNIX system processes.
-If invoked with optional ARG the window displaying the process
-information will be displayed but not selected.
-Runs the normal hook `proced-post-display-hook'.
+\\<proced-mode-map>
+If invoked with optional ARG, do not select the window displaying
+the process information.
-See `proced-mode' for a description of features available in Proced buffers."
+This function runs the normal hook `proced-post-display-hook'.
+
+See `proced-mode' for a description of features available in
+Proced buffers."
(interactive "P")
(unless proced-available
(error "Proced is not available on this system"))
@@ -1170,14 +1186,16 @@ Return nil otherwise."
(defun proced-time-lessp (t1 t2)
"Return t if time value T1 is less than time value T2.
Return `equal' if T1 equals T2. Return nil otherwise."
- (with-decoded-time-value ((high1 low1 micro1 t1)
- (high2 low2 micro2 t2))
+ (with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1)
+ (high2 low2 micro2 pico2 type2 t2))
(cond ((< high1 high2))
((< high2 high1) nil)
((< low1 low2))
((< low2 low1) nil)
((< micro1 micro2))
((< micro2 micro1) nil)
+ ((< pico1 pico2))
+ ((< pico2 pico1) nil)
(t 'equal))))
;;; Sorting
@@ -1651,8 +1669,8 @@ After updating a displayed Proced buffer run the normal hook
(goto-char new-pos)
(goto-char (point-min))
(proced-move-to-goal-column)))
- ;; update modeline
- ;; Does the long `mode-name' clutter the modeline? It would be nice
+ ;; update mode line
+ ;; Does the long `mode-name' clutter the mode line? It would be nice
;; to have some other location for displaying the values of the various
;; flags that affect the behavior of proced (flags one might want
;; to change on the fly). Where??
@@ -1681,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
@@ -1701,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..00b51ffe099
--- /dev/null
+++ b/lisp/profiler.el
@@ -0,0 +1,769 @@
+;;; 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: jump to definition\n\
+RET: expand or collapse"))
+ (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)))
+ (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)
+ (easy-menu-define profiler-report-menu map "Menu for Profiler Report mode."
+ '("Profiler"
+ ["Next Entry" profiler-report-next-entry :active t
+ :help "Move to next entry"]
+ ["Previous Entry" profiler-report-previous-entry :active t
+ :help "Move to previous entry"]
+ "--"
+ ["Toggle Entry" profiler-report-toggle-entry
+ :active (profiler-report-calltree-at-point)
+ :help "Expand or collapse the current entry"]
+ ["Find Entry" profiler-report-find-entry
+ ;; FIXME should deactivate if not on a known function.
+ :active (profiler-report-calltree-at-point)
+ :help "Find the definition of the current entry"]
+ ["Describe Entry" profiler-report-describe-entry
+ :active (profiler-report-calltree-at-point)
+ :help "Show the documentation of the current entry"]
+ "--"
+ ["Show Calltree" profiler-report-render-calltree
+ :active profiler-report-reversed
+ :help "Show calltree view"]
+ ["Show Reversed Calltree" profiler-report-render-reversed-calltree
+ :active (not profiler-report-reversed)
+ :help "Show reversed calltree view"]
+ ["Sort Ascending" profiler-report-ascending-sort
+ :active (not (eq profiler-report-order 'ascending))
+ :help "Sort calltree view in ascending order"]
+ ["Sort Descending" profiler-report-descending-sort
+ :active (not (eq profiler-report-order 'descending))
+ :help "Sort calltree view in descending order"]
+ "--"
+ ["Compare Profile..." profiler-report-compare-profile :active t
+ :help "Compare current profile with another"]
+ ["Write Profile..." profiler-report-write-profile :active t
+ :help "Write current profile to a file"]))
+ map)
+ "Keymap for `profiler-report-mode'.")
+
+(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))
+ (with-current-buffer
+ (if event (window-buffer (posn-window (event-start event)))
+ (current-buffer))
+ (and event (setq event (event-end event))
+ (posn-set-point 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 17ff4bd32a6..745320b6eb2 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -1,6 +1,6 @@
;;; ada-mode.el --- major-mode for editing Ada sources
-;; Copyright (C) 1994-1995, 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997-2012 Free Software Foundation, Inc.
;; Author: Rolf Ebert <ebert@inf.enst.fr>
;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
@@ -105,7 +105,7 @@
;; should be loaded before the ada-mode, which will then setup some variables
;; to improve the support for Ada code.
;; Here is the list of these modes:
-;; `which-function-mode': Display in the modeline the name of the subprogram
+;; `which-function-mode': Display in the mode line the name of the subprogram
;; the cursor is in.
;; `outline-mode': Provides the capability to collapse or expand the code
;; for specific language constructs, for instance if you want to hide the
@@ -139,7 +139,7 @@
version-string)))
(defvar ada-mode-hook nil
- "*List of functions to call when Ada mode is invoked.
+ "List of functions to call when Ada mode is invoked.
This hook is automatically executed after the `ada-mode' is
fully loaded.
This is a good place to add Ada environment specific bindings.")
@@ -150,13 +150,13 @@ This is a good place to add Ada environment specific bindings.")
:group 'languages)
(defcustom ada-auto-case t
- "*Non-nil means automatically change case of preceding word while typing.
+ "Non-nil means automatically change case of preceding word while typing.
Casing is done according to `ada-case-keyword', `ada-case-identifier'
and `ada-case-attribute'."
:type 'boolean :group 'ada)
(defcustom ada-broken-decl-indent 0
- "*Number of columns to indent a broken declaration.
+ "Number of columns to indent a broken declaration.
An example is :
declare
@@ -165,7 +165,7 @@ An example is :
:type 'integer :group 'ada)
(defcustom ada-broken-indent 2
- "*Number of columns to indent the continuation of a broken line.
+ "Number of columns to indent the continuation of a broken line.
An example is :
My_Var : My_Type := (Field1 =>
@@ -173,7 +173,7 @@ An example is :
:type 'integer :group 'ada)
(defcustom ada-continuation-indent ada-broken-indent
- "*Number of columns to indent the continuation of broken lines in parenthesis.
+ "Number of columns to indent the continuation of broken lines in parenthesis.
An example is :
Func (Param1,
@@ -181,7 +181,7 @@ An example is :
:type 'integer :group 'ada)
(defcustom ada-case-attribute 'ada-capitalize-word
- "*Function to call to adjust the case of Ada attributes.
+ "Function to call to adjust the case of Ada attributes.
It may be `downcase-word', `upcase-word', `ada-loose-case-word',
`ada-capitalize-word' or `ada-no-auto-case'."
:type '(choice (const downcase-word)
@@ -193,7 +193,7 @@ It may be `downcase-word', `upcase-word', `ada-loose-case-word',
(defcustom ada-case-exception-file
(list (convert-standard-filename' "~/.emacs_case_exceptions"))
- "*List of special casing exceptions dictionaries for identifiers.
+ "List of special casing exceptions dictionaries for identifiers.
The first file is the one where new exceptions will be saved by Emacs
when you call `ada-create-case-exception'.
@@ -207,7 +207,7 @@ by a comment."
:group 'ada)
(defcustom ada-case-keyword 'downcase-word
- "*Function to call to adjust the case of an Ada keywords.
+ "Function to call to adjust the case of an Ada keywords.
It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
`ada-capitalize-word'."
:type '(choice (const downcase-word)
@@ -218,7 +218,7 @@ It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
:group 'ada)
(defcustom ada-case-identifier 'ada-loose-case-word
- "*Function to call to adjust the case of an Ada identifier.
+ "Function to call to adjust the case of an Ada identifier.
It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
`ada-capitalize-word'."
:type '(choice (const downcase-word)
@@ -229,7 +229,7 @@ It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
:group 'ada)
(defcustom ada-clean-buffer-before-saving t
- "*Non-nil means remove trailing spaces and untabify the buffer before saving."
+ "Non-nil means remove trailing spaces and untabify the buffer before saving."
:type 'boolean :group 'ada)
(make-obsolete-variable 'ada-clean-buffer-before-saving
"use the `write-file-functions' hook."
@@ -237,7 +237,7 @@ It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
(defcustom ada-indent 3
- "*Size of Ada indentation.
+ "Size of Ada indentation.
An example is :
procedure Foo is
@@ -246,11 +246,11 @@ begin
:type 'integer :group 'ada)
(defcustom ada-indent-after-return t
- "*Non-nil means automatically indent after RET or LFD."
+ "Non-nil means automatically indent after RET or LFD."
:type 'boolean :group 'ada)
(defcustom ada-indent-align-comments t
- "*Non-nil means align comments on previous line comments, if any.
+ "Non-nil means align comments on previous line comments, if any.
If nil, indentation is calculated as usual.
Note that indentation is calculated only if `ada-indent-comment-as-code' is t.
@@ -260,12 +260,12 @@ For instance:
:type 'boolean :group 'ada)
(defcustom ada-indent-comment-as-code t
- "*Non-nil means indent comment lines as code.
+ "Non-nil means indent comment lines as code.
A nil value means do not auto-indent comments."
:type 'boolean :group 'ada)
(defcustom ada-indent-handle-comment-special nil
- "*Non-nil if comment lines should be handled specially inside parenthesis.
+ "Non-nil if comment lines should be handled specially inside parenthesis.
By default, if the line that contains the open parenthesis has some
text following it, then the following lines will be indented in the
same column as this text. This will not be true if the first line is
@@ -287,11 +287,11 @@ type A is
:type 'boolean :group 'ada)
(defcustom ada-indent-is-separate t
- "*Non-nil means indent 'is separate' or 'is abstract' if on a single line."
+ "Non-nil means indent 'is separate' or 'is abstract' if on a single line."
:type 'boolean :group 'ada)
(defcustom ada-indent-record-rel-type 3
- "*Indentation for 'record' relative to 'type' or 'use'.
+ "Indentation for 'record' relative to 'type' or 'use'.
An example is:
type A is
@@ -299,7 +299,7 @@ An example is:
:type 'integer :group 'ada)
(defcustom ada-indent-renames ada-broken-indent
- "*Indentation for renames relative to the matching function statement.
+ "Indentation for renames relative to the matching function statement.
If `ada-indent-return' is null or negative, the indentation is done relative to
the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
@@ -310,7 +310,7 @@ An example is:
:type 'integer :group 'ada)
(defcustom ada-indent-return 0
- "*Indentation for 'return' relative to the matching 'function' statement.
+ "Indentation for 'return' relative to the matching 'function' statement.
If `ada-indent-return' is null or negative, the indentation is done relative to
the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
@@ -320,22 +320,22 @@ An example is:
:type 'integer :group 'ada)
(defcustom ada-indent-to-open-paren t
- "*Non-nil means indent according to the innermost open parenthesis."
+ "Non-nil means indent according to the innermost open parenthesis."
:type 'boolean :group 'ada)
(defcustom ada-fill-comment-prefix "-- "
- "*Text inserted in the first columns when filling a comment paragraph.
+ "Text inserted in the first columns when filling a comment paragraph.
Note: if you modify this variable, you will have to invoke `ada-mode'
again to take account of the new value."
:type 'string :group 'ada)
(defcustom ada-fill-comment-postfix " --"
- "*Text inserted at the end of each line when filling a comment paragraph.
+ "Text inserted at the end of each line when filling a comment paragraph.
Used by `ada-fill-comment-paragraph-postfix'."
:type 'string :group 'ada)
(defcustom ada-label-indent -4
- "*Number of columns to indent a label.
+ "Number of columns to indent a label.
An example is:
procedure Foo is
@@ -346,15 +346,15 @@ This is also used for <<..>> labels"
:type 'integer :group 'ada)
(defcustom ada-language-version 'ada95
- "*Ada language version; one of `ada83', `ada95', `ada2005'."
+ "Ada language version; one of `ada83', `ada95', `ada2005'."
:type '(choice (const ada83) (const ada95) (const ada2005)) :group 'ada)
(defcustom ada-move-to-declaration nil
- "*Non-nil means `ada-move-to-start' moves to the subprogram declaration, not to 'begin'."
+ "Non-nil means `ada-move-to-start' moves to the subprogram declaration, not to 'begin'."
:type 'boolean :group 'ada)
(defcustom ada-popup-key '[down-mouse-3]
- "*Key used for binding the contextual menu.
+ "Key used for binding the contextual menu.
If nil, no contextual menu is available."
:type '(restricted-sexp :match-alternatives (stringp vectorp))
:group 'ada)
@@ -364,7 +364,7 @@ If nil, no contextual menu is available."
(split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
'("/usr/adainclude" "/usr/local/adainclude"
"/opt/gnu/adainclude"))
- "*Default list of directories to search for Ada files.
+ "Default list of directories to search for Ada files.
See the description for the `ff-search-directories' variable. This variable
is the initial value of `ada-search-directories-internal'."
:type '(repeat (choice :tag "Directory"
@@ -379,7 +379,7 @@ and the standard runtime location, and the value of the user-defined
`ada-search-directories'.")
(defcustom ada-stmt-end-indent 0
- "*Number of columns to indent the end of a statement on a separate line.
+ "Number of columns to indent the end of a statement on a separate line.
An example is:
if A = B
@@ -387,7 +387,7 @@ An example is:
:type 'integer :group 'ada)
(defcustom ada-tab-policy 'indent-auto
- "*Control the behavior of the TAB key.
+ "Control the behavior of the TAB key.
Must be one of :
`indent-rigidly' : always adds `ada-indent' blanks at the beginning of the line.
`indent-auto' : use indentation functions in this file.
@@ -398,7 +398,7 @@ Must be one of :
:group 'ada)
(defcustom ada-use-indent ada-broken-indent
- "*Indentation for the lines in a 'use' statement.
+ "Indentation for the lines in a 'use' statement.
An example is:
use Ada.Text_IO,
@@ -406,7 +406,7 @@ An example is:
:type 'integer :group 'ada)
(defcustom ada-when-indent 3
- "*Indentation for 'when' relative to 'exception' or 'case'.
+ "Indentation for 'when' relative to 'exception' or 'case'.
An example is:
case A is
@@ -414,7 +414,7 @@ An example is:
:type 'integer :group 'ada)
(defcustom ada-with-indent ada-broken-indent
- "*Indentation for the lines in a 'with' statement.
+ "Indentation for the lines in a 'with' statement.
An example is:
with Ada.Text_IO,
@@ -422,7 +422,7 @@ An example is:
:type 'integer :group 'ada)
(defcustom ada-which-compiler 'gnat
- "*Name of the compiler to use.
+ "Name of the compiler to use.
This will determine what features are made available through the Ada mode.
The possible choices are:
`gnat': Use Ada Core Technologies' GNAT compiler. Add some cross-referencing
@@ -4728,7 +4728,7 @@ Moves to 'begin' if in a declarative part."
["Entry family" ada-entry-family t]
["Select" ada-select t]
["Accept" ada-accept t]
- ["Or accept" ada-or-accep t]
+ ["Or accept" ada-or-accept t]
["Or delay" ada-or-delay t]
["Or terminate" ada-or-terminate t]
["---" nil nil]
@@ -5055,7 +5055,7 @@ Since the search can be long, the results are cached."
(re-search-backward ada-imenu-subprogram-menu-re nil t))
;; Get the function name, but not the properties, or this changes
- ;; the face in the modeline on Emacs 21
+ ;; the face in the mode line on Emacs 21
(setq func-name (match-string-no-properties 3))
(if (and (not (ada-in-comment-p))
(not (save-excursion
@@ -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/ada-prj.el b/lisp/progmodes/ada-prj.el
index a32e22828fc..10497acbe4b 100644
--- a/lisp/progmodes/ada-prj.el
+++ b/lisp/progmodes/ada-prj.el
@@ -1,6 +1,6 @@
;;; ada-prj.el --- GUI editing of project files for the ada-mode
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Emmanuel Briot <briot@gnat.com>
;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
diff --git a/lisp/progmodes/ada-stmt.el b/lisp/progmodes/ada-stmt.el
index b33da441eeb..50c5b695dbc 100644
--- a/lisp/progmodes/ada-stmt.el
+++ b/lisp/progmodes/ada-stmt.el
@@ -1,6 +1,6 @@
;;; ada-stmt.el --- an extension to Ada mode for inserting statement templates
-;; Copyright (C) 1987, 1993-1994, 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1993-1994, 1996-2012 Free Software Foundation, Inc.
;; Authors: Daniel Pfeiffer
;; Markus Heritsch
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index f30457992a3..1bee783bb17 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -1,6 +1,6 @@
;; ada-xref.el --- for lookup and completion in Ada mode
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
;; Rolf Ebert <ebert@inf.enst.fr>
@@ -50,21 +50,21 @@
;; ------ User variables
(defcustom ada-xref-other-buffer t
- "*If nil, always display the cross-references in the same buffer.
+ "If nil, always display the cross-references in the same buffer.
Otherwise create either a new buffer or a new frame."
:type 'boolean :group 'ada)
(defcustom ada-xref-create-ali nil
- "*If non-nil, run gcc whenever the cross-references are not up-to-date.
+ "If non-nil, run gcc whenever the cross-references are not up-to-date.
If nil, the cross-reference mode never runs gcc."
:type 'boolean :group 'ada)
(defcustom ada-xref-confirm-compile nil
- "*If non-nil, ask for confirmation before compiling or running the application."
+ "If non-nil, ask for confirmation before compiling or running the application."
:type 'boolean :group 'ada)
(defcustom ada-krunch-args "0"
- "*Maximum number of characters for filenames created by `gnatkr'.
+ "Maximum number of characters for filenames created by `gnatkr'.
Set to 0, if you don't use crunched filenames. This should be a string."
:type 'string :group 'ada)
@@ -76,7 +76,7 @@ is faster, available from Ada mode web site."
:type 'string :group 'ada)
(defcustom ada-gnatls-args '("-v")
- "*Arguments to pass to `gnatls' to find location of the runtime.
+ "Arguments to pass to `gnatls' to find location of the runtime.
Typical use is to pass `--RTS=soft-floats' on some systems that support it.
You can also add `-I-' if you do not want the current directory to be included.
@@ -125,7 +125,7 @@ The command `gnatfind' is used every time you choose the menu
(defcustom ada-prj-default-check-cmd
(concat "${cross_prefix}gnatmake -u -c -gnatc ${gnatmake_opt} ${full_current}"
" -cargs ${comp_opt}")
- "*Default command to be used to compile a single file.
+ "Default command to be used to compile a single file.
Emacs will substitute the current filename for ${full_current}, or add
the filename at the end. This is the same syntax as in the project file."
:type 'string :group 'ada)
@@ -133,35 +133,35 @@ the filename at the end. This is the same syntax as in the project file."
(defcustom ada-prj-default-comp-cmd
(concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"
" ${comp_opt}")
- "*Default command to be used to compile a single file.
+ "Default command to be used to compile a single file.
Emacs will substitute the current filename for ${full_current}, or add
the filename at the end. This is the same syntax as in the project file."
:type 'string :group 'ada)
(defcustom ada-prj-default-debugger "${cross_prefix}gdb"
- "*Default name of the debugger."
+ "Default name of the debugger."
:type 'string :group 'ada)
(defcustom ada-prj-default-make-cmd
(concat "${cross_prefix}gnatmake -o ${main} ${main} ${gnatmake_opt} "
"-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}")
- "*Default command to be used to compile the application.
+ "Default command to be used to compile the application.
This is the same syntax as in the project file."
:type 'string :group 'ada)
(defcustom ada-prj-default-project-file ""
- "*Name of the current project file.
+ "Name of the current project file.
Emacs will not try to use the search algorithm to find the project file if
this string is not empty. It is set whenever a project file is found."
:type '(file :must-match t) :group 'ada)
(defcustom ada-gnatstub-opts "-q -I${src_dir}"
- "*Options to pass to `gnatsub' to generate the body of a package.
+ "Options to pass to `gnatsub' to generate the body of a package.
This has the same syntax as in the project file (with variable substitution)."
:type 'string :group 'ada)
(defcustom ada-always-ask-project nil
- "*If nil, use default values when no project file was found.
+ "If nil, use default values when no project file was found.
Otherwise, ask the user for the name of the project file to use."
:type 'boolean :group 'ada)
@@ -169,12 +169,12 @@ Otherwise, ask the user for the name of the project file to use."
"True if we are running on Windows.")
(defcustom ada-tight-gvd-integration nil
- "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
+ "If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
If GVD is not the debugger used, nothing happens."
:type 'boolean :group 'ada)
(defcustom ada-xref-search-with-egrep t
- "*If non-nil, use egrep to find the possible declarations for an entity.
+ "If non-nil, use egrep to find the possible declarations for an entity.
This alternate method is used when the exact location was not found in the
information provided by GNAT. However, it might be expensive if you have a lot
of sources, since it will search in all the files in your project."
@@ -1533,7 +1533,7 @@ the project file."
;; .ali file for a spec file. If we are, go to step 3.
;; 3- If the file is not found or step 2 failed:
;; find the name of the "other file", ie the body, and look
- ;; for its associated .ali file by subtituing the extension
+ ;; for its associated .ali file by substituting the extension
;;
;; We must also handle the case of separate packages and subprograms:
;; 4- If no ali file was found, we try to modify the file name by removing
@@ -1544,9 +1544,7 @@ the project file."
;; also a separate.
(with-current-buffer (get-file-buffer file)
- (let ((short-ali-file-name
- (concat (file-name-sans-extension (file-name-nondirectory file))
- ".ali"))
+ (let ((short-ali-file-name (concat (file-name-base file) ".ali"))
ali-file-name
is-spec)
@@ -1566,10 +1564,7 @@ the project file."
(if is-spec
(set 'ali-file-name
(ada-find-ali-file-in-dir
- (concat (file-name-sans-extension
- (file-name-nondirectory
- (ada-other-file-name)))
- ".ali"))))
+ (concat (file-name-base (ada-other-file-name)) ".ali"))))
(setq ali-file-name
@@ -1584,15 +1579,12 @@ the project file."
;; file_s.ada and file_b.ada), try to go to the other file
;; and look for its ali file
(ada-find-ali-file-in-dir
- (concat (file-name-sans-extension
- (file-name-nondirectory (ada-other-file-name)))
- ".ali"))
+ (concat (file-name-base (ada-other-file-name)) ".ali"))
;; If we still don't have an ali file, try to get the one
;; from the parent unit, in case we have a separate entity.
- (let ((parent-name (file-name-sans-extension
- (file-name-nondirectory file))))
+ (let ((parent-name (file-name-base file)))
(while (and (not ali-file-name)
(string-match "^\\(.*\\)[.-][^.-]*" parent-name))
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index d1ff1aead10..5a054af9883 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -1,6 +1,6 @@
;;; antlr-mode.el --- major mode for ANTLR grammar files
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Christoph.Wedler@sap.com
;; Keywords: languages, ANTLR, code generator
@@ -69,7 +69,7 @@
;; This file requires Emacs-20.3, XEmacs-20.4 or higher and package cc-mode.
;; If antlr-mode is not part of your distribution, put this file into your
-;; load-path and the following into your ~/.emacs:
+;; load-path and the following into your init file:
;; (autoload 'antlr-mode "antlr-mode" nil t)
;; (setq auto-mode-alist (cons '("\\.g\\'" . antlr-mode) auto-mode-alist))
;; (add-hook 'speedbar-load-hook ; would be too late in antlr-mode.el
@@ -235,11 +235,11 @@ MAJOR-MODE, the major mode of the code in the grammar's actions, is the
value of `antlr-language' if the first group in the string matched by
REGEXP in `antlr-language-limit-n-regexp' is one of the OPTION-VALUEs.
An OPTION-VALUE of nil denotes the fallback element. MODELINE-STRING is
-also displayed in the modeline next to \"Antlr\"."
+also displayed in the mode line next to \"Antlr\"."
:group 'antlr
:type '(repeat (group :value (java-mode "")
(function :tag "Major mode")
- (string :tag "Modeline string")
+ (string :tag "Mode line string")
(repeat :tag "ANTLR language option" :inline t
(choice (const :tag "Default" nil)
string )))))
@@ -269,7 +269,7 @@ greater than this number."
(integer :tag "Hidden if longer than" :value 3)))
(defcustom antlr-indent-comment 'tab
- "*Non-nil, if the indentation should touch lines in block comments.
+ "Non-nil, if the indentation should touch lines in block comments.
If nil, no continuation line of a block comment is changed. If t, they
are changed according to `c-indentation-line'. When not nil and not t,
they are only changed by \\[antlr-indent-command]."
@@ -296,7 +296,7 @@ ANTLR's and Java's indentation styles. Used by `antlr-set-tabs'."
(boolean :tag "Indent-tabs-mode"))))
(defcustom antlr-indent-style "java"
- "*If non-nil, cc-mode indentation style used for `antlr-mode'.
+ "If non-nil, cc-mode indentation style used for `antlr-mode'.
See `c-set-style' and for details, where the most interesting part in
`c-style-alist' is the value of `c-basic-offset'."
:group 'antlr
@@ -339,14 +339,14 @@ to the normal rules of `antlr-indent-line'."
;;;===========================================================================
(defcustom antlr-options-use-submenus t
- "*Non-nil, if the major mode menu should include option submenus.
+ "Non-nil, if the major mode menu should include option submenus.
If nil, the menu just includes a command to insert options. Otherwise,
it includes four submenus to insert file/grammar/rule/subrule options."
:group 'antlr
:type 'boolean)
(defcustom antlr-tool-version 20701
- "*The version number of the Antlr tool.
+ "The version number of the Antlr tool.
The value is an integer of the form XYYZZ which stands for vX.YY.ZZ.
This variable is used to warn about non-supported options and to supply
version correct option values when using \\[antlr-insert-option].
@@ -358,7 +358,7 @@ can make this variable buffer-local."
:type 'integer)
(defcustom antlr-options-auto-colon t
- "*Non-nil, if `:' is inserted with a rule or subrule options section.
+ "Non-nil, if `:' is inserted with a rule or subrule options section.
A `:' is only inserted if this value is non-nil, if a rule or subrule
option is inserted with \\[antlr-insert-option], if there was no rule or
subrule options section before, and if a `:' is not already present
@@ -378,7 +378,7 @@ is `language-as-string'. See also `antlr-read-value'."
:type '(repeat (symbol :tag "Style symbol")))
(defcustom antlr-options-push-mark t
- "*Non-nil, if inserting an option should set & push mark.
+ "Non-nil, if inserting an option should set & push mark.
If nil, never set mark when inserting an option with command
\\[antlr-insert-option]. If t, always set mark via `push-mark'. If a
number, only set mark if point was outside the options area before and
@@ -392,7 +392,7 @@ options area before."
(sexp :tag "If outside options" :format "%t" :value outside)))
(defcustom antlr-options-assign-string " = "
- "*String containing `=' to use between option name and value.
+ "String containing `=' to use between option name and value.
This string is only used if the option to insert did not exist before
or if there was no `=' after it. In other words, the spacing around an
existing `=' won't be changed when changing an option value."
@@ -578,21 +578,21 @@ AS-STRING is non-nil and is either t or a symbol which is a member of
;;;===========================================================================
(defcustom antlr-tool-command "java antlr.Tool"
- "*Command used in \\[antlr-run-tool] to run the Antlr tool.
+ "Command used in \\[antlr-run-tool] to run the Antlr tool.
This variable should include all options passed to Antlr except the
option \"-glib\" which is automatically suggested if necessary."
:group 'antlr
:type 'string)
(defcustom antlr-ask-about-save t
- "*If not nil, \\[antlr-run-tool] asks which buffers to save.
+ "If not nil, \\[antlr-run-tool] asks which buffers to save.
Otherwise, it saves all modified buffers before running without asking."
:group 'antlr
:type 'boolean)
(defcustom antlr-makefile-specification
'("\n" ("GENS" "GENS%d" " \\\n\t") "$(ANTLR)")
- "*Variable to specify the appearance of the generated makefile rules.
+ "Variable to specify the appearance of the generated makefile rules.
This variable influences the output of \\[antlr-show-makefile-rules].
It looks like \(RULE-SEP GEN-VAR-SPEC COMMAND).
@@ -650,7 +650,7 @@ See variable `antlr-file-formats-alist' for language dependent
formats.")
(defvar antlr-unknown-file-formats '("?%s?.g" "?%s?")
- "*Formats which specify the names of unknown files.
+ "Formats which specify the names of unknown files.
The value looks like \(SUPER-GRAMMAR-FILE-FORMAT SUPER-EVOCAB-FORMAT).
SUPER-GRAMMAR-FORMAT is a format string, it specifies with substitution
@@ -685,7 +685,7 @@ DIRECTORY is the name of the current directory.")
;;;===========================================================================
(defcustom antlr-imenu-name t ; (featurep 'xemacs) ; TODO: Emacs-21 bug?
- "*Non-nil, if a \"Index\" menu should be added to the menubar.
+ "Non-nil, if a \"Index\" menu should be added to the menubar.
If it is a string, it is used instead \"Index\". Requires package
imenu."
:group 'antlr
@@ -774,7 +774,7 @@ imenu."
;;;===========================================================================
(defcustom antlr-font-lock-maximum-decoration 'inherit
- "*The maximum decoration level for fontifying actions.
+ "The maximum decoration level for fontifying actions.
Value `none' means, do not fontify actions, just normal grammar code
according to `antlr-font-lock-additional-keywords'. Value `inherit'
means, use value of `font-lock-maximum-decoration'. Any other value is
@@ -961,7 +961,7 @@ group. The string matched by the first group is highlighted with
(antlr-re-search-forward
"^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?"
limit))
- (1 font-lock-type-face) ; not XEmacs' java level-3 fruit salad
+ (1 font-lock-type-face) ; not XEmacs's java level-3 fruit salad
(3 (if (antlr-upcase-p (char-after (match-beginning 3)))
antlr-tokendef-face
antlr-ruledef-face) nil t)
@@ -1030,7 +1030,7 @@ not to confuse their context_cache.")
(define-abbrev-table 'antlr-mode-abbrev-table ())
(defvar antlr-slow-cache-enabling-symbol 'loudly
-;; Emacs' font-lock changes buffer's tick counter, therefore this value should
+;; Emacs's font-lock changes buffer's tick counter, therefore this value should
;; be a parameter of a font-lock function, but not any other variable of
;; functions which call `antlr-slow-syntactic-context'.
"If value is a bound symbol, cache will be used even with text changes.
@@ -1113,7 +1113,7 @@ WARNING: this may alter `match-data'."
(or (buffer-syntactic-context) (buffer-syntactic-context-depth))
:EMACS
(let ((orig (point)) diff state
- ;; Arg, Emacs' (buffer-modified-tick) changes with font-lock. Use
+ ;; Arg, Emacs's (buffer-modified-tick) changes with font-lock. Use
;; hack that `loudly' is bound during font-locking => cache use will
;; increase from 7% to 99.99% during font-locking.
(tick (or (boundp antlr-slow-cache-enabling-symbol)
diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el
index 3ac8b119fe1..5e15371b406 100644
--- a/lisp/progmodes/asm-mode.el
+++ b/lisp/progmodes/asm-mode.el
@@ -1,6 +1,6 @@
;;; asm-mode.el --- mode for editing assembler code
-;; Copyright (C) 1991, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 2001-2012 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: FSF
@@ -53,7 +53,7 @@
:group 'languages)
(defcustom asm-comment-char ?\;
- "*The comment-start character assumed by Asm mode."
+ "The comment-start character assumed by Asm mode."
:type 'character
:group 'asm)
diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el
index fce725c3b3c..ac3a7282952 100644
--- a/lisp/progmodes/autoconf.el
+++ b/lisp/progmodes/autoconf.el
@@ -1,6 +1,6 @@
-;;; autoconf.el --- mode for editing Autoconf configure.in files
+;;; autoconf.el --- mode for editing Autoconf configure.ac files
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: languages
@@ -23,33 +23,31 @@
;;; Commentary:
;; Provides fairly minimal font-lock, imenu and indentation support
-;; for editing configure.in files. Only Autoconf syntax is processed.
+;; for editing configure.ac files. Only Autoconf syntax is processed.
;; There is no attempt to deal with shell text -- probably that will
;; always lose.
-;; This is specialized for configure.in files. It doesn't inherit the
+;; This is specialized for configure.ac files. It doesn't inherit the
;; general M4 stuff from M4 mode.
;; There is also an autoconf-mode.el in existence. That appears to be
-;; for editing the Autoconf M4 source, rather than configure.in files.
+;; for editing the Autoconf M4 source, rather than configure.ac files.
;;; Code:
-(defvar font-lock-syntactic-keywords)
-
(defvar autoconf-mode-map (make-sparse-keymap))
(defvar autoconf-mode-hook nil
"Hook run by `autoconf-mode'.")
(defconst autoconf-definition-regexp
- "AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\[*\\(\\sw+\\)\\]*")
+ "A\\(?:H_TEMPLATE\\|C_\\(?:SUBST\\|DEFINE\\(?:_UNQUOTED\\)?\\)\\)(\\[*\\(\\sw+\\)\\]*")
(defvar autoconf-font-lock-keywords
`(("\\_<A[CHMS]_\\sw+" . font-lock-keyword-face)
(,autoconf-definition-regexp
- 3 font-lock-function-name-face)
- ;; Are any other M4 keywords really appropriate for configure.in,
+ 1 font-lock-function-name-face)
+ ;; Are any other M4 keywords really appropriate for configure.ac,
;; given that we do `dnl'?
("changequote" . font-lock-keyword-face)))
@@ -61,7 +59,7 @@
table))
(defvar autoconf-imenu-generic-expression
- (list (list nil autoconf-definition-regexp 3)))
+ (list (list nil autoconf-definition-regexp 1)))
;; It's not clear how best to implement this.
(defun autoconf-current-defun-function ()
@@ -71,14 +69,15 @@ searching backwards at another AC_... command."
(save-excursion
(with-syntax-table (copy-syntax-table autoconf-mode-syntax-table)
(modify-syntax-entry ?_ "w")
+ (skip-syntax-forward "w" (line-end-position))
(if (re-search-backward autoconf-definition-regexp
(save-excursion (beginning-of-defun) (point))
t)
- (match-string-no-properties 3)))))
+ (match-string-no-properties 1)))))
;;;###autoload
(define-derived-mode autoconf-mode prog-mode "Autoconf"
- "Major mode for editing Autoconf configure.in files."
+ "Major mode for editing Autoconf configure.ac files."
(set (make-local-variable 'parens-require-spaces) nil) ; for M4 arg lists
(set (make-local-variable 'defun-prompt-regexp)
"^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+")
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 12eddfef1aa..3561105e59d 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -1,6 +1,6 @@
;; bug-reference.el --- buttonize bug references
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Created: 21 Mar 2007
@@ -30,6 +30,13 @@
;; Two minor modes are provided. One works on any text in the buffer;
;; the other operates only on comments and strings.
+;;; Code:
+
+(defgroup bug-reference nil
+ "Hyperlinking references to bug reports"
+ ;; Somewhat arbitrary, by analogy with eg goto-address.
+ :group 'comm)
+
(defvar bug-reference-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'bug-reference-push-button)
@@ -61,9 +68,14 @@ so that it is considered safe, see `enable-local-variables'.")
(and (symbolp s)
(get s 'bug-reference-url-format)))))
-(defconst bug-reference-bug-regexp
- "\\([Bb]ug ?#\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z-+]+/\\)\\([0-9]+\\)"
- "Regular expression which matches bug references.")
+(defcustom bug-reference-bug-regexp
+ "\\([Bb]ug ?#\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z-+]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
+ "Regular expression matching bug references.
+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 ()
"Set properties of bug reference overlays."
@@ -154,4 +166,5 @@ the mode if ARG is omitted or nil."
(widen)
(bug-reference-unfontify (point-min) (point-max)))))
+(provide 'bug-reference)
;;; bug-reference.el ends here
diff --git a/lisp/progmodes/cap-words.el b/lisp/progmodes/cap-words.el
index d7b7dfef1ec..6d4d9f0544d 100644
--- a/lisp/progmodes/cap-words.el
+++ b/lisp/progmodes/cap-words.el
@@ -1,6 +1,6 @@
;;; cap-words.el --- minor mode for motion in CapitalizedWordIdentifiers
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: languages
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index 81045d63abf..b12020b26be 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -1,6 +1,6 @@
;;; cc-align.el --- custom indentation functions for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2012 Free Software Foundation, Inc.
;; Authors: 2004- Alan Mackenzie
;; 1998- Martin Stjernholm
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index ef67a18d807..d7829853e3c 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -1,6 +1,6 @@
;;; cc-awk.el --- AWK specific code within cc-mode.
-;; Copyright (C) 1988, 1994, 1996, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 1996, 2000-2012 Free Software Foundation, Inc.
;; Author: Alan Mackenzie <acm@muc.de> (originally based on awk-mode.el)
;; Maintainer: FSF
diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el
index 823430f2d38..4236f1c983f 100644
--- a/lisp/progmodes/cc-bytecomp.el
+++ b/lisp/progmodes/cc-bytecomp.el
@@ -1,6 +1,6 @@
;;; cc-bytecomp.el --- compile time setup for proper compilation
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Martin Stjernholm
;; Maintainer: bug-cc-mode@gnu.org
@@ -338,30 +338,6 @@ at compile time, e.g. for macros and inline functions."
(cc-bytecomp-debug-msg
"cc-bytecomp-defun: Covered function %s" ',fun))))))
-(put 'cc-bytecomp-defmacro 'lisp-indent-function 'defun)
-(defmacro cc-bytecomp-defmacro (fun &rest temp-macro)
- "Bind the symbol as a macro during compilation (and evaluation) of the
-file. Don't use outside `eval-when-compile'."
- `(let ((orig-fun (assq ',fun cc-bytecomp-original-functions)))
- (if (not orig-fun)
- (setq orig-fun
- (list ',fun
- nil
- (if (fboundp ',fun)
- (progn
- (cc-bytecomp-debug-msg
- "cc-bytecomp-defmacro: Saving %s" ',fun)
- (symbol-function ',fun))
- (cc-bytecomp-debug-msg
- "cc-bytecomp-defmacro: Saving %s as unbound" ',fun)
- 'unbound))
- cc-bytecomp-original-functions
- (cons orig-fun cc-bytecomp-original-functions)))
- (defmacro ,fun ,@temp-macro)
- (cc-bytecomp-debug-msg
- "cc-bytecomp-defmacro: Bound macro %s" ',fun)
- (setcar (cdr orig-fun) (symbol-function ',fun))))
-
(defmacro cc-bytecomp-put (symbol propname value)
"Set a property on a symbol during compilation (and evaluation) of
the file. Don't use outside `eval-when-compile'."
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 686695bc838..eec6873dc19 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1,6 +1,6 @@
;;; cc-cmds.el --- user level commands for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2012 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -310,7 +310,7 @@ left out.
Turning on auto-newline automatically enables electric indentation.
When the auto-newline feature is enabled (indicated by \"/la\" on the
-modeline after the mode name) newlines are automatically inserted
+mode line after the mode name) newlines are automatically inserted
after special characters such as brace, comma, semi-colon, and colon."
(interactive "P")
(setq c-auto-newline
@@ -329,7 +329,7 @@ positive, turns it off when negative, and just toggles it when zero or
left out.
When the hungry-delete-key feature is enabled (indicated by \"/h\" on
-the modeline after the mode name) the delete key gobbles all preceding
+the mode line after the mode name) the delete key gobbles all preceding
whitespace in one fell swoop."
(interactive "P")
(setq c-hungry-delete-key (c-calculate-state arg c-hungry-delete-key))
@@ -493,13 +493,16 @@ inside a literal or a macro, nothing special happens."
(insert-char ?\n 1)
;; In AWK (etc.) or in a macro, make sure this CR hasn't changed
;; the syntax. (There might already be an escaped NL there.)
- (when (or (c-at-vsemi-p (1- (point)))
- (let ((pt (point)))
- (save-excursion
- (backward-char)
- (and (c-beginning-of-macro)
- (progn (c-end-of-macro)
- (< (point) pt))))))
+ (when (or
+ (save-excursion
+ (c-skip-ws-backward (c-point 'bopl))
+ (c-at-vsemi-p))
+ (let ((pt (point)))
+ (save-excursion
+ (backward-char)
+ (and (c-beginning-of-macro)
+ (progn (c-end-of-macro)
+ (< (point) pt))))))
(backward-char)
(insert-char ?\\ 1)
(forward-char))
@@ -679,7 +682,7 @@ settings of `c-cleanup-list' are done."
;; We want to inhibit blinking the paren since this would be
;; most disruptive. We'll blink it ourselves later on.
(old-blink-paren blink-paren-function)
- blink-paren-function)
+ blink-paren-function case-fold-search)
(c-save-buffer-state ()
(setq safepos (c-safe-position (point) (c-parse-state))
@@ -1086,7 +1089,7 @@ numeric argument is supplied, or the point is inside a literal."
(interactive "*P")
(let ((c-echo-syntactic-information-p nil)
- final-pos close-paren-inserted found-delim)
+ final-pos close-paren-inserted found-delim case-fold-search)
(self-insert-command (prefix-numeric-value arg))
(setq final-pos (point))
@@ -1172,7 +1175,8 @@ newline cleanups are done if appropriate; see the variable `c-cleanup-list'."
(interactive "*P")
(let ((literal (c-save-buffer-state () (c-in-literal)))
;; shut this up
- (c-echo-syntactic-information-p nil))
+ (c-echo-syntactic-information-p nil)
+ case-fold-search)
(self-insert-command (prefix-numeric-value arg))
(if (and (not arg) (not literal))
@@ -1585,7 +1589,7 @@ defun."
; structure with other users of c-state-cache.
(orig-point-min (point-min)) (orig-point-max (point-max))
lim ; Position of { which has been widened to.
- where pos)
+ where pos case-fold-search)
(save-restriction
(if (eq c-defun-tactic 'go-outward)
@@ -1709,7 +1713,8 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'."
; structure with other users of c-state-cache.
(orig-point-min (point-min)) (orig-point-max (point-max))
lim
- where pos)
+ where pos case-fold-search)
+
(save-restriction
(if (eq c-defun-tactic 'go-outward)
(setq lim (c-widen-to-enclosing-decl-scope ; e.g. class, namespace
@@ -1769,8 +1774,8 @@ with a brace block."
(interactive)
(c-save-buffer-state
(beginning-of-defun-function end-of-defun-function
- where pos name-end)
-
+ where pos name-end case-fold-search)
+
(save-restriction
(widen)
(save-excursion
@@ -1824,6 +1829,17 @@ with a brace block."
;; DEFFLAGSET(syslog_opt_flags,LOG_PID ...) ==> syslog_opt_flags
(match-string-no-properties 1))
+ ;; Objc selectors.
+ ((assq 'objc-method-intro (c-guess-basic-syntax))
+ (let ((bound (save-excursion (c-end-of-statement) (point)))
+ (kw-re (concat "\\(?:" c-symbol-key "\\)?:"))
+ (stretches))
+ (when (c-syntactic-re-search-forward c-symbol-key bound t t t)
+ (push (match-string-no-properties 0) stretches)
+ (while (c-syntactic-re-search-forward kw-re bound t t t)
+ (push (match-string-no-properties 0) stretches)))
+ (apply 'concat (nreverse stretches))))
+
(t
;; Normal function or initializer.
(when (c-syntactic-re-search-forward "[{(]" nil t)
@@ -1958,13 +1974,18 @@ with a brace block."
(defun c-mark-function ()
"Put mark at end of the current top-level declaration or macro, point at beginning.
-If point is not inside any then the closest following one is chosen.
+If point is not inside any then the closest following one is
+chosen. Each successive call of this command extends the marked
+region by one function.
+
+A mark is left where the command started, unless the region is already active
+\(in Transient Mark mode).
As opposed to \\[c-beginning-of-defun] and \\[c-end-of-defun], this
function does not require the declaration to contain a brace block."
(interactive)
- (let (decl-limits)
+ (let (decl-limits case-fold-search)
(c-save-buffer-state nil
;; We try to be line oriented, unless there are several
;; declarations on the same line.
@@ -1974,17 +1995,34 @@ function does not require the declaration to contain a brace block."
(if (not decl-limits)
(error "Cannot find any declaration")
- (goto-char (car decl-limits))
- (push-mark (cdr decl-limits) nil t))))
+ (let* ((extend-region-p
+ (and (eq this-command 'c-mark-function)
+ (eq last-command 'c-mark-function)))
+ (push-mark-p (and (eq this-command 'c-mark-function)
+ (not extend-region-p)
+ (not (and transient-mark-mode mark-active)))))
+ (if push-mark-p (push-mark (point)))
+ (if extend-region-p
+ (progn
+ (exchange-point-and-mark)
+ (setq decl-limits (c-declaration-limits t))
+ (when (not decl-limits)
+ (exchange-point-and-mark)
+ (error "Cannot find any declaration"))
+ (goto-char (cdr decl-limits))
+ (exchange-point-and-mark))
+ (goto-char (car decl-limits))
+ (push-mark (cdr decl-limits) nil t))))))
(defun c-cpp-define-name ()
"Return the name of the current CPP macro, or NIL if we're not in one."
(interactive)
- (save-excursion
- (and c-opt-cpp-macro-define-start
- (c-beginning-of-macro)
- (looking-at c-opt-cpp-macro-define-start)
- (match-string-no-properties 1))))
+ (let (case-fold-search)
+ (save-excursion
+ (and c-opt-cpp-macro-define-start
+ (c-beginning-of-macro)
+ (looking-at c-opt-cpp-macro-define-start)
+ (match-string-no-properties 1)))))
;; Movement by statements.
@@ -2867,7 +2905,8 @@ See `c-indent-comment-alist' for a description."
(eq (match-end 0) eot))
'cpp-end-block)
(t
- 'other))))
+ 'other)))
+ case-fold-search)
(if (and (memq line-type '(anchored-comment empty-line))
c-indent-comments-syntactically-p)
(let ((c-syntactic-context (c-guess-basic-syntax)))
@@ -3003,7 +3042,7 @@ are treated as conditional clause limits. Normally they are ignored."
(let* ((forward (> count 0))
(increment (if forward -1 1))
(search-function (if forward 're-search-forward 're-search-backward))
- new)
+ new case-fold-search)
(unless (integerp target-depth)
(setq target-depth (if target-depth -1 0)))
(save-excursion
@@ -3205,7 +3244,7 @@ balanced expression is found."
In the macro case this also has the effect of realigning any line
continuation backslashes, unless `c-auto-align-backslashes' is nil."
(interactive "*")
- (let ((here (point-marker)) decl-limits)
+ (let ((here (point-marker)) decl-limits case-fold-search)
(unwind-protect
(progn
(c-save-buffer-state nil
@@ -4382,11 +4421,8 @@ Optional prefix ARG means justify paragraph as well."
(let ((fill-paragraph-function
;; Avoid infinite recursion.
(if (not (eq fill-paragraph-function 'c-fill-paragraph))
- fill-paragraph-function))
- (start-point (point-marker)))
- (c-mask-paragraph
- t nil (lambda () (fill-region-as-paragraph (point-min) (point-max) arg)))
- (goto-char start-point))
+ fill-paragraph-function)))
+ (c-mask-paragraph t nil 'fill-paragraph arg))
;; Always return t. This has the effect that if filling isn't done
;; above, it isn't done at all, and it's therefore effectively
;; disabled in normal code.
@@ -4620,7 +4656,8 @@ inside a preprocessor directive."
(interactive "*")
(let* (c-lit-limits c-lit-type
- (c-macro-start c-macro-start))
+ (c-macro-start c-macro-start)
+ case-fold-search)
(c-save-buffer-state ()
(setq c-lit-limits (c-literal-limits nil nil t)
diff --git a/lisp/progmodes/cc-compat.el b/lisp/progmodes/cc-compat.el
index 01f7379b1b0..bf0ac8c5619 100644
--- a/lisp/progmodes/cc-compat.el
+++ b/lisp/progmodes/cc-compat.el
@@ -1,6 +1,6 @@
;;; cc-compat.el --- cc-mode compatibility with c-mode.el confusion
-;; Copyright (C) 1985, 1987, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2012 Free Software Foundation, Inc.
;; Authors: 1998- Martin Stjernholm
;; 1994-1999 Barry A. Warsaw
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 2991b511830..17bd2760baa 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -1,6 +1,6 @@
;;; cc-defs.el --- compile time definitions for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2012 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -93,7 +93,7 @@
;;; Variables also used at compile time.
-(defconst c-version "5.32.2"
+(defconst c-version "5.32.4"
"CC Mode version number.")
(defconst c-version-sym (intern c-version))
@@ -1818,9 +1818,7 @@ system."
(t
;; Being evaluated interactively.
(buffer-file-name)))))
- (and file
- (file-name-sans-extension
- (file-name-nondirectory file)))))
+ (and file (file-name-base file))))
(defmacro c-lang-defconst-eval-immediately (form)
"Can be used inside a VAL in `c-lang-defconst' to evaluate FORM
@@ -1831,7 +1829,7 @@ itself is evaluated."
(eval form))
;; Only used at compile time - suppress "might not be defined at runtime".
-(declare-function cl-macroexpand-all "cl-extra" (form &optional env))
+(declare-function cl-macroexpand-all "cl" (form &optional env))
(defmacro c-lang-defconst (name &rest args)
"Set the language specific values of the language constant NAME.
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 0865ddfed69..10355451480 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -1,6 +1,6 @@
;;; cc-engine.el --- core syntax guessing engine for CC mode
-;; Copyright (C) 1985, 1987, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2012 Free Software Foundation, Inc.
;; Authors: 2001- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -219,6 +219,38 @@
(point))))
c-macro-start))
+;; One element macro cache to cope with continual movement within very large
+;; CPP macros.
+(defvar c-macro-cache nil)
+(make-variable-buffer-local 'c-macro-cache)
+;; Nil or cons of the bounds of the most recent CPP form probed by
+;; `c-beginning-of-macro', `c-end-of-macro' or `c-syntactic-end-of-macro'.
+;; The cdr will be nil if we know only the start of the CPP form.
+(defvar c-macro-cache-start-pos nil)
+(make-variable-buffer-local 'c-macro-cache-start-pos)
+;; The starting position from where we determined `c-macro-cache'.
+(defvar c-macro-cache-syntactic nil)
+(make-variable-buffer-local 'c-macro-cache-syntactic)
+;; non-nil iff `c-macro-cache' has both elements set AND the cdr is at a
+;; syntactic end of macro, not merely an apparent one.
+
+(defun c-invalidate-macro-cache (beg end)
+ ;; Called from a before-change function. If the change region is before or
+ ;; in the macro characterized by `c-macro-cache' etc., nullify it
+ ;; appropriately. BEG and END are the standard before-change-functions
+ ;; parameters. END isn't used.
+ (cond
+ ((null c-macro-cache))
+ ((< beg (car c-macro-cache))
+ (setq c-macro-cache nil
+ c-macro-cache-start-pos nil
+ c-macro-cache-syntactic nil))
+ ((and (cdr c-macro-cache)
+ (< beg (cdr c-macro-cache)))
+ (setcdr c-macro-cache nil)
+ (setq c-macro-cache-start-pos beg
+ c-macro-cache-syntactic nil))))
+
(defun c-beginning-of-macro (&optional lim)
"Go to the beginning of a preprocessor directive.
Leave point at the beginning of the directive and return t if in one,
@@ -226,19 +258,36 @@ otherwise return nil and leave point unchanged.
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
- (when c-opt-cpp-prefix
- (let ((here (point)))
- (save-restriction
- (if lim (narrow-to-region lim (point-max)))
- (beginning-of-line)
- (while (eq (char-before (1- (point))) ?\\)
- (forward-line -1))
- (back-to-indentation)
- (if (and (<= (point) here)
- (looking-at c-opt-cpp-start))
- t
- (goto-char here)
- nil)))))
+ (let ((here (point)))
+ (when c-opt-cpp-prefix
+ (if (and (car c-macro-cache)
+ (>= (point) (car c-macro-cache))
+ (or (and (cdr c-macro-cache)
+ (<= (point) (cdr c-macro-cache)))
+ (<= (point) c-macro-cache-start-pos)))
+ (unless (< (car c-macro-cache) (or lim (point-min)))
+ (progn (goto-char (max (or lim (point-min)) (car c-macro-cache)))
+ (setq c-macro-cache-start-pos
+ (max c-macro-cache-start-pos here))
+ t))
+ (setq c-macro-cache nil
+ c-macro-cache-start-pos nil
+ c-macro-cache-syntactic nil)
+
+ (save-restriction
+ (if lim (narrow-to-region lim (point-max)))
+ (beginning-of-line)
+ (while (eq (char-before (1- (point))) ?\\)
+ (forward-line -1))
+ (back-to-indentation)
+ (if (and (<= (point) here)
+ (looking-at c-opt-cpp-start))
+ (progn
+ (setq c-macro-cache (cons (point) nil)
+ c-macro-cache-start-pos here)
+ t)
+ (goto-char here)
+ nil))))))
(defun c-end-of-macro ()
"Go to the end of a preprocessor directive.
@@ -248,12 +297,24 @@ done that the point is inside a cpp directive to begin with.
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
- (while (progn
- (end-of-line)
- (when (and (eq (char-before) ?\\)
- (not (eobp)))
- (forward-char)
- t))))
+ (if (and (cdr c-macro-cache)
+ (<= (point) (cdr c-macro-cache))
+ (>= (point) (car c-macro-cache)))
+ (goto-char (cdr c-macro-cache))
+ (unless (and (car c-macro-cache)
+ (<= (point) c-macro-cache-start-pos)
+ (>= (point) (car c-macro-cache)))
+ (setq c-macro-cache nil
+ c-macro-cache-start-pos nil
+ c-macro-cache-syntactic nil))
+ (while (progn
+ (end-of-line)
+ (when (and (eq (char-before) ?\\)
+ (not (eobp)))
+ (forward-char)
+ t)))
+ (when (car c-macro-cache)
+ (setcdr c-macro-cache (point)))))
(defun c-syntactic-end-of-macro ()
;; Go to the end of a CPP directive, or a "safe" pos just before.
@@ -268,12 +329,15 @@ comment at the start of cc-engine.el for more info."
;; at the start of cc-engine.el for more info.
(let* ((here (point))
(there (progn (c-end-of-macro) (point)))
- (s (parse-partial-sexp here there)))
- (while (and (or (nth 3 s) ; in a string
- (nth 4 s)) ; in a comment (maybe at end of line comment)
- (> there here)) ; No infinite loops, please.
- (setq there (1- (nth 8 s)))
- (setq s (parse-partial-sexp here there)))
+ s)
+ (unless c-macro-cache-syntactic
+ (setq s (parse-partial-sexp here there))
+ (while (and (or (nth 3 s) ; in a string
+ (nth 4 s)) ; in a comment (maybe at end of line comment)
+ (> there here)) ; No infinite loops, please.
+ (setq there (1- (nth 8 s)))
+ (setq s (parse-partial-sexp here there)))
+ (setq c-macro-cache-syntactic (car c-macro-cache)))
(point)))
(defun c-forward-over-cpp-define-id ()
@@ -1182,7 +1246,7 @@ comment at the start of cc-engine.el for more info."
(c-at-vsemi-p))))
(throw 'done vsemi-pos))
;; In a string/comment?
- ((setq lit-range (c-literal-limits))
+ ((setq lit-range (c-literal-limits from))
(goto-char (cdr lit-range)))
((eq (char-after) ?:)
(forward-char)
@@ -1624,6 +1688,7 @@ comment at the start of cc-engine.el for more info."
;; high as possible.
(setq rung-pos (point)))
+ (with-silent-modifications
(while
(progn
(while
@@ -1779,7 +1844,7 @@ comment at the start of cc-engine.el for more info."
(1- last-put-in-sws-pos))
(c-remove-is-and-in-sws (1- last-put-in-sws-pos)
last-put-in-sws-pos))))
- )))
+ ))))
(defun c-backward-sws ()
;; Used by `c-backward-syntactic-ws' to implement the unbounded search.
@@ -1817,6 +1882,7 @@ comment at the start of cc-engine.el for more info."
(goto-char (setq rung-pos rung-is-marked))
(goto-char simple-ws-beg))
+ (with-silent-modifications
(while
(progn
(while
@@ -2002,7 +2068,7 @@ comment at the start of cc-engine.el for more info."
last-put-in-sws-pos)
(c-remove-is-and-in-sws last-put-in-sws-pos
(1+ last-put-in-sws-pos)))))
- )))
+ ))))
;; Other whitespace tools
@@ -2074,7 +2140,7 @@ comment at the start of cc-engine.el for more info."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; We maintain a simple cache of positions which aren't in a literal, so as to
;; speed up testing for non-literality.
-(defconst c-state-nonlit-pos-interval 10000)
+(defconst c-state-nonlit-pos-interval 3000)
;; The approximate interval between entries in `c-state-nonlit-pos-cache'.
(defvar c-state-nonlit-pos-cache nil)
@@ -2089,6 +2155,18 @@ comment at the start of cc-engine.el for more info."
;; reduced by buffer changes, and increased by invocations of
;; `c-state-literal-at'.
+(defvar c-state-semi-nonlit-pos-cache nil)
+(make-variable-buffer-local 'c-state-semi-nonlit-pos-cache)
+;; A list of buffer positions which are known not to be in a literal. This is
+;; ordered with higher positions at the front of the list. Only those which
+;; are less than `c-state-semi-nonlit-pos-cache-limit' are valid.
+
+(defvar c-state-semi-nonlit-pos-cache-limit 1)
+(make-variable-buffer-local 'c-state-semi-nonlit-pos-cache-limit)
+;; An upper limit on valid entries in `c-state-semi-nonlit-pos-cache'. This is
+;; reduced by buffer changes, and increased by invocations of
+;; `c-state-literal-at'. FIXME!!!
+
(defsubst c-state-pp-to-literal (from to)
;; Do a parse-partial-sexp from FROM to TO, returning either
;; (STATE TYPE (BEG . END)) if TO is in a literal; or
@@ -2129,38 +2207,100 @@ comment at the start of cc-engine.el for more info."
(widen)
(save-excursion
(let ((c c-state-nonlit-pos-cache)
- pos npos lit)
+ pos npos high-pos lit macro-beg macro-end)
;; Trim the cache to take account of buffer changes.
(while (and c (> (car c) c-state-nonlit-pos-cache-limit))
(setq c (cdr c)))
(setq c-state-nonlit-pos-cache c)
(while (and c (> (car c) here))
+ (setq high-pos (car c))
(setq c (cdr c)))
(setq pos (or (car c) (point-min)))
- (while (<= (setq npos (+ pos c-state-nonlit-pos-interval))
- here)
- (setq lit (car (cddr (c-state-pp-to-literal pos npos))))
- (setq pos (or (cdr lit) npos)) ; end of literal containing npos.
- (goto-char pos)
- (when (and (c-beginning-of-macro) (/= (point) pos))
- (c-syntactic-end-of-macro)
- (or (eobp) (forward-char))
- (setq pos (point)))
- (setq c-state-nonlit-pos-cache (cons pos c-state-nonlit-pos-cache)))
+ (unless high-pos
+ (while
+ ;; Add an element to `c-state-nonlit-pos-cache' each iteration.
+ (and
+ (<= (setq npos (+ pos c-state-nonlit-pos-interval)) here)
+
+ ;; Test for being in a literal. If so, go to after it.
+ (progn
+ (setq lit (car (cddr (c-state-pp-to-literal pos npos))))
+ (or (null lit)
+ (prog1 (<= (cdr lit) here)
+ (setq npos (cdr lit)))))
+
+ ;; Test for being in a macro. If so, go to after it.
+ (progn
+ (goto-char npos)
+ (setq macro-beg
+ (and (c-beginning-of-macro) (/= (point) npos) (point)))
+ (when macro-beg
+ (c-syntactic-end-of-macro)
+ (or (eobp) (forward-char))
+ (setq macro-end (point)))
+ (or (null macro-beg)
+ (prog1 (<= macro-end here)
+ (setq npos macro-end)))))
+
+ (setq pos npos)
+ (setq c-state-nonlit-pos-cache (cons pos c-state-nonlit-pos-cache)))
+ ;; Add one extra element above HERE so as to to avoid the previous
+ ;; expensive calculation when the next call is close to the current
+ ;; one. This is especially useful when inside a large macro.
+ (setq c-state-nonlit-pos-cache (cons npos c-state-nonlit-pos-cache)))
(if (> pos c-state-nonlit-pos-cache-limit)
(setq c-state-nonlit-pos-cache-limit pos))
pos))))
+
+(defun c-state-semi-safe-place (here)
+ ;; Return a buffer position before HERE which is "safe", i.e. outside any
+ ;; string or comment. It may be in a macro.
+ (save-restriction
+ (widen)
+ (save-excursion
+ (let ((c c-state-semi-nonlit-pos-cache)
+ pos npos high-pos lit macro-beg macro-end)
+ ;; Trim the cache to take account of buffer changes.
+ (while (and c (> (car c) c-state-semi-nonlit-pos-cache-limit))
+ (setq c (cdr c)))
+ (setq c-state-semi-nonlit-pos-cache c)
+
+ (while (and c (> (car c) here))
+ (setq high-pos (car c))
+ (setq c (cdr c)))
+ (setq pos (or (car c) (point-min)))
+ (unless high-pos
+ (while
+ ;; Add an element to `c-state-semi-nonlit-pos-cache' each iteration.
+ (and
+ (<= (setq npos (+ pos c-state-nonlit-pos-interval)) here)
+
+ ;; Test for being in a literal. If so, go to after it.
+ (progn
+ (setq lit (car (cddr (c-state-pp-to-literal pos npos))))
+ (or (null lit)
+ (prog1 (<= (cdr lit) here)
+ (setq npos (cdr lit))))))
+
+ (setq pos npos)
+ (setq c-state-semi-nonlit-pos-cache
+ (cons pos c-state-semi-nonlit-pos-cache))))
+
+ (if (> pos c-state-semi-nonlit-pos-cache-limit)
+ (setq c-state-semi-nonlit-pos-cache-limit pos))
+ pos))))
+
(defun c-state-literal-at (here)
;; If position HERE is inside a literal, return (START . END), the
;; boundaries of the literal (which may be outside the accessible bit of the
;; buffer). Otherwise, return nil.
;;
;; This function is almost the same as `c-literal-limits'. Previously, it
- ;; differed in that it was a lower level function, and that it rigourously
+ ;; differed in that it was a lower level function, and that it rigorously
;; followed the syntax from BOB. `c-literal-limits' is now (2011-12)
;; virtually identical to this function.
(save-restriction
@@ -2421,8 +2561,11 @@ comment at the start of cc-engine.el for more info."
start-point cache-pos)))
;; Might we be better off starting from the top level, two defuns back,
- ;; instead?
- (when (> how-far c-state-cache-too-far)
+ ;; instead? This heuristic no longer works well in C++, where
+ ;; declarations inside namespace brace blocks are frequently placed at
+ ;; column zero.
+ (when (and (not (c-major-mode-is 'c++-mode))
+ (> how-far c-state-cache-too-far))
(setq BOD-pos (c-get-fallback-scan-pos here)) ; somewhat EXPENSIVE!!!
(if (< (- here BOD-pos) how-far)
(setq strategy 'BOD
@@ -2474,13 +2617,24 @@ comment at the start of cc-engine.el for more info."
(setq c-state-point-min (point-min)))
(defun c-append-lower-brace-pair-to-state-cache (from &optional upper-lim)
- ;; If there is a brace pair preceding FROM in the buffer (not necessarily
- ;; immediately preceding), push a cons onto `c-state-cache' to represent it.
- ;; FROM must not be inside a literal. If UPPER-LIM is non-nil, we append
- ;; the highest brace pair whose "}" is below UPPER-LIM.
+ ;; If there is a brace pair preceding FROM in the buffer, at the same level
+ ;; of nesting (not necessarily immediately preceding), push a cons onto
+ ;; `c-state-cache' to represent it. FROM must not be inside a literal. If
+ ;; UPPER-LIM is non-nil, we append the highest brace pair whose "}" is below
+ ;; UPPER-LIM.
;;
;; Return non-nil when this has been done.
;;
+ ;; The situation it copes with is this transformation:
+ ;;
+ ;; OLD: { (.) {...........}
+ ;; ^ ^
+ ;; FROM HERE
+ ;;
+ ;; NEW: { {....} (.) {.........
+ ;; ^ ^ ^
+ ;; LOWER BRACE PAIR HERE or HERE
+ ;;
;; This routine should be fast. Since it can get called a LOT, we maintain
;; `c-state-brace-pair-desert', a small cache of "failures", such that we
;; reduce the time wasted in repeated fruitless searches in brace deserts.
@@ -2498,11 +2652,29 @@ comment at the start of cc-engine.el for more info."
;; If we're essentially repeating a fruitless search, just give up.
(unless (and c-state-brace-pair-desert
(eq cache-pos (car c-state-brace-pair-desert))
+ (or (null (car c-state-brace-pair-desert))
+ (> from (car c-state-brace-pair-desert)))
(<= from (cdr c-state-brace-pair-desert)))
- ;; Only search what we absolutely need to:
- (if (and c-state-brace-pair-desert
- (eq cache-pos (car c-state-brace-pair-desert)))
- (narrow-to-region (cdr c-state-brace-pair-desert) (point-max)))
+ ;; DESERT-LIM. Avoid repeated searching through the cached desert.
+ (let ((desert-lim
+ (and c-state-brace-pair-desert
+ (eq cache-pos (car c-state-brace-pair-desert))
+ (>= from (cdr c-state-brace-pair-desert))
+ (cdr c-state-brace-pair-desert)))
+ ;; CACHE-LIM. This limit will be necessary when an opening
+ ;; paren at `cache-pos' has just had its matching close paren
+ ;; inserted into the buffer. `cache-pos' continues to be a
+ ;; search bound, even though the algorithm below would skip
+ ;; over the new paren pair.
+ (cache-lim (and cache-pos (< cache-pos from) cache-pos)))
+ (narrow-to-region
+ (cond
+ ((and desert-lim cache-lim)
+ (max desert-lim cache-lim))
+ (desert-lim)
+ (cache-lim)
+ ((point-min)))
+ (point-max)))
;; In the next pair of nested loops, the inner one moves back past a
;; pair of (mis-)matching parens or brackets; the outer one moves
@@ -2536,7 +2708,7 @@ comment at the start of cc-engine.el for more info."
(cons new-cons (cdr c-state-cache))))
(t (setq c-state-cache (cons new-cons c-state-cache)))))
- ;; We haven't found a brace pair. Record this.
+ ;; We haven't found a brace pair. Record this in the cache.
(setq c-state-brace-pair-desert (cons cache-pos from))))))))
(defsubst c-state-push-any-brace-pair (bra+1 macro-start-or-here)
@@ -2594,7 +2766,7 @@ comment at the start of cc-engine.el for more info."
mstart) ; start of a macro.
(save-excursion
- ;; Each time round the following loop, we enter a succesively deeper
+ ;; Each time round the following loop, we enter a successively deeper
;; level of brace/paren nesting. (Except sometimes we "continue at
;; the existing level".) `pa+1' is a pos inside an opening
;; brace/paren/bracket, usually just after it.
@@ -2925,6 +3097,8 @@ comment at the start of cc-engine.el for more info."
c-state-cache-good-pos 1
c-state-nonlit-pos-cache nil
c-state-nonlit-pos-cache-limit 1
+ c-state-semi-nonlit-pos-cache nil
+ c-state-semi-nonlit-pos-cache-limit 1
c-state-brace-pair-desert nil
c-state-point-min 1
c-state-point-min-lit-type nil
@@ -2968,9 +3142,11 @@ comment at the start of cc-engine.el for more info."
;;
;; This function is called from c-after-change.
- ;; The cache of non-literals:
+ ;; The caches of non-literals:
(if (< here c-state-nonlit-pos-cache-limit)
(setq c-state-nonlit-pos-cache-limit here))
+ (if (< here c-state-semi-nonlit-pos-cache-limit)
+ (setq c-state-semi-nonlit-pos-cache-limit here))
;; `c-state-cache':
;; Case 1: if `here' is in a literal containing point-min, everything
@@ -3110,8 +3286,7 @@ comment at the start of cc-engine.el for more info."
(if scan-forward-p
(progn (narrow-to-region (point-min) here)
(c-append-to-state-cache good-pos))
-
- (c-get-cache-scan-pos good-pos))))
+ good-pos)))
(t ; (eq strategy 'IN-LIT)
(setq c-state-cache nil
@@ -3173,23 +3348,32 @@ comment at the start of cc-engine.el for more info."
(fset 'c-real-parse-state (symbol-function 'c-parse-state)))
(cc-bytecomp-defun c-real-parse-state)
+(defvar c-parse-state-point nil)
(defvar c-parse-state-state nil)
(defun c-record-parse-state-state ()
+ (setq c-parse-state-point (point))
(setq c-parse-state-state
(mapcar
(lambda (arg)
- (cons arg (symbol-value arg)))
+ (let ((val (symbol-value arg)))
+ (cons arg
+ (if (consp val)
+ (copy-tree val)
+ val))))
'(c-state-cache
c-state-cache-good-pos
c-state-nonlit-pos-cache
c-state-nonlit-pos-cache-limit
+ c-state-semi-nonlit-pos-cache
+ c-state-semi-nonlit-pos-cache-limit
c-state-brace-pair-desert
c-state-point-min
c-state-point-min-lit-type
c-state-point-min-lit-start
c-state-min-scan-pos
c-state-old-cpp-beg
- c-state-old-cpp-end))))
+ c-state-old-cpp-end
+ c-parse-state-point))))
(defun c-replay-parse-state-state ()
(message
(concat "(setq "
@@ -3199,6 +3383,16 @@ comment at the start of cc-engine.el for more info."
c-parse-state-state " ")
")")))
+(defun c-debug-parse-state-double-cons (state)
+ (let (state-car conses-not-ok)
+ (while state
+ (setq state-car (car state)
+ state (cdr state))
+ (if (and (consp state-car)
+ (consp (car state)))
+ (setq conses-not-ok t)))
+ conses-not-ok))
+
(defun c-debug-parse-state ()
(let ((here (point)) (res1 (c-real-parse-state)) res2)
(let ((c-state-cache nil)
@@ -3231,8 +3425,16 @@ comment at the start of cc-engine.el for more info."
here res1 res2)
(message "Old state:")
(c-replay-parse-state-state))
+
+ (when (c-debug-parse-state-double-cons res1)
+ (message "c-parse-state INVALIDITY at %s: %s"
+ here res1)
+ (message "Old state:")
+ (c-replay-parse-state-state))
+
(c-record-parse-state-state)
- res1))
+ res2 ; res1 correct a cascading series of errors ASAP
+ ))
(defun c-toggle-parse-state-debug (&optional arg)
(interactive "P")
@@ -3240,7 +3442,9 @@ comment at the start of cc-engine.el for more info."
(fset 'c-parse-state (symbol-function (if c-debug-parse-state
'c-debug-parse-state
'c-real-parse-state)))
- (c-keep-region-active))
+ (c-keep-region-active)
+ (message "c-debug-parse-state %sabled"
+ (if c-debug-parse-state "en" "dis")))
(when c-debug-parse-state
(c-toggle-parse-state-debug 1))
@@ -4211,12 +4415,14 @@ The last point calculated is cached if the cache is enabled, i.e. if
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
- (let* ((safe-place (c-state-safe-place (point)))
- (lit (c-state-pp-to-literal safe-place (point))))
- (or (cadr lit)
- (and detect-cpp
- (save-excursion (c-beginning-of-macro))
- 'pound))))
+ (save-restriction
+ (widen)
+ (let* ((safe-place (c-state-semi-safe-place (point)))
+ (lit (c-state-pp-to-literal safe-place (point))))
+ (or (cadr lit)
+ (and detect-cpp
+ (save-excursion (c-beginning-of-macro))
+ 'pound)))))
(defun c-literal-limits (&optional lim near not-in-delimiter)
"Return a cons of the beginning and end positions of the comment or
@@ -4235,10 +4441,11 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(let* ((pos (point))
- (lim (or lim (c-state-safe-place pos)))
- (pp-to-lit (c-state-pp-to-literal lim pos))
+ (lim (or lim (c-state-semi-safe-place pos)))
+ (pp-to-lit (save-restriction
+ (widen)
+ (c-state-pp-to-literal lim pos)))
(state (car pp-to-lit))
- (lit-type (cadr pp-to-lit))
(lit-limits (car (cddr pp-to-lit))))
(cond
@@ -4348,6 +4555,110 @@ comment at the start of cc-engine.el for more info."
(t 'c))) ; Assuming the range is valid.
range))
+(defsubst c-determine-limit-get-base (start try-size)
+ ;; Get a "safe place" approximately TRY-SIZE characters before START.
+ ;; This doesn't preserve point.
+ (let* ((pos (max (- start try-size) (point-min)))
+ (base (c-state-semi-safe-place pos))
+ (s (parse-partial-sexp base pos)))
+ (if (or (nth 4 s) (nth 3 s)) ; comment or string
+ (nth 8 s)
+ (point))))
+
+(defun c-determine-limit (how-far-back &optional start try-size)
+ ;; Return a buffer position HOW-FAR-BACK non-literal characters from START
+ ;; (default point). This is done by going back further in the buffer then
+ ;; searching forward for literals. The position found won't be in a
+ ;; literal. We start searching for the sought position TRY-SIZE (default
+ ;; twice HOW-FAR-BACK) bytes back from START. This function must be fast.
+ ;; :-)
+ (save-excursion
+ (let* ((start (or start (point)))
+ (try-size (or try-size (* 2 how-far-back)))
+ (base (c-determine-limit-get-base start try-size))
+ (pos base)
+
+ (s (parse-partial-sexp pos pos)) ; null state.
+ stack elt size
+ (count 0))
+ (while (< pos start)
+ ;; Move forward one literal each time round this loop.
+ ;; Move forward to the start of a comment or string.
+ (setq s (parse-partial-sexp
+ pos
+ start
+ nil ; target-depth
+ nil ; stop-before
+ s ; state
+ 'syntax-table)) ; stop-comment
+
+ ;; Gather details of the non-literal-bit - starting pos and size.
+ (setq size (- (if (or (nth 4 s) (nth 3 s))
+ (nth 8 s)
+ (point))
+ pos))
+ (if (> size 0)
+ (setq stack (cons (cons pos size) stack)))
+
+ ;; Move forward to the end of the comment/string.
+ (if (or (nth 4 s) (nth 3 s))
+ (setq s (parse-partial-sexp
+ (point)
+ start
+ nil ; target-depth
+ nil ; stop-before
+ s ; state
+ 'syntax-table))) ; stop-comment
+ (setq pos (point)))
+
+ ;; Now try and find enough non-literal characters recorded on the stack.
+ ;; Go back one recorded literal each time round this loop.
+ (while (and (< count how-far-back)
+ stack)
+ (setq elt (car stack)
+ stack (cdr stack))
+ (setq count (+ count (cdr elt))))
+
+ ;; Have we found enough yet?
+ (cond
+ ((>= count how-far-back)
+ (+ (car elt) (- count how-far-back)))
+ ((eq base (point-min))
+ (point-min))
+ (t
+ (c-determine-limit (- how-far-back count) base try-size))))))
+
+(defun c-determine-+ve-limit (how-far &optional start-pos)
+ ;; Return a buffer position about HOW-FAR non-literal characters forward
+ ;; from START-POS (default point), which must not be inside a literal.
+ (save-excursion
+ (let ((pos (or start-pos (point)))
+ (count how-far)
+ (s (parse-partial-sexp (point) (point)))) ; null state
+ (while (and (not (eobp))
+ (> count 0))
+ ;; Scan over counted characters.
+ (setq s (parse-partial-sexp
+ pos
+ (min (+ pos count) (point-max))
+ nil ; target-depth
+ nil ; stop-before
+ s ; state
+ 'syntax-table)) ; stop-comment
+ (setq count (- count (- (point) pos) 1)
+ pos (point))
+ ;; Scan over literal characters.
+ (if (nth 8 s)
+ (setq s (parse-partial-sexp
+ pos
+ (point-max)
+ nil ; target-depth
+ nil ; stop-before
+ s ; state
+ 'syntax-table) ; stop-comment
+ pos (point))))
+ (point))))
+
;; `c-find-decl-spots' and accompanying stuff.
@@ -4484,13 +4795,14 @@ comment at the start of cc-engine.el for more info."
;; Call CFD-FUN for each possible spot for a declaration, cast or
;; label from the point to CFD-LIMIT.
;;
- ;; CFD-FUN is called with point at the start of the spot. It's
- ;; passed two arguments: The first is the end position of the token
- ;; preceding the spot, or 0 for the implicit match at bob. The
- ;; second is a flag that is t when the match is inside a macro. If
- ;; CFD-FUN adds `c-decl-end' properties somewhere below the current
- ;; spot, it should return non-nil to ensure that the next search
- ;; will find them.
+ ;; CFD-FUN is called with point at the start of the spot. It's passed two
+ ;; arguments: The first is the end position of the token preceding the spot,
+ ;; or 0 for the implicit match at bob. The second is a flag that is t when
+ ;; the match is inside a macro. Point should be moved forward by at least
+ ;; one token.
+ ;;
+ ;; If CFD-FUN adds `c-decl-end' properties somewhere below the current spot,
+ ;; it should return non-nil to ensure that the next search will find them.
;;
;; Such a spot is:
;; o The first token after bob.
@@ -4864,7 +5176,8 @@ comment at the start of cc-engine.el for more info."
(goto-char cfd-continue-pos)
(if (= cfd-continue-pos cfd-limit)
(setq cfd-match-pos cfd-limit)
- (c-find-decl-prefix-search)))))
+ (c-find-decl-prefix-search))))) ; Moves point, sets cfd-continue-pos,
+ ; cfd-match-pos, etc.
;; A cache for found types.
@@ -5134,7 +5447,7 @@ comment at the start of cc-engine.el for more info."
new-beg new-end need-new-beg need-new-end)
;; Locate the barrier before the changed region
(goto-char (if beg-lit-limits (car beg-lit-limits) beg))
- (c-syntactic-skip-backward "^;{}" (max (- beg 2048) (point-min)))
+ (c-syntactic-skip-backward "^;{}" (c-determine-limit 512))
(setq new-beg (point))
;; Remove the syntax-table properties from each pertinent <...> pair.
@@ -5145,8 +5458,7 @@ comment at the start of cc-engine.el for more info."
;; Locate the barrier after END.
(goto-char (if end-lit-limits (cdr end-lit-limits) end))
- (c-syntactic-re-search-forward "[;{}]"
- (min (+ end 2048) (point-max)) 'end)
+ (c-syntactic-re-search-forward "[;{}]" (c-determine-+ve-limit 512) 'end)
(setq new-end (point))
;; Remove syntax-table properties from the remaining pertinent <...>
@@ -7303,6 +7615,7 @@ comment at the start of cc-engine.el for more info."
(let ((start (point))
start-char
(c-promote-possible-types t)
+ lim
;; Turn off recognition of angle bracket arglists while parsing
;; types here since the protocol reference list might then be
;; considered part of the preceding name or superclass-name.
@@ -7330,6 +7643,7 @@ comment at the start of cc-engine.el for more info."
; (c-forward-token-2) ; 2006/1/13 This doesn't move if the token's
; at EOB.
(goto-char (match-end 0))
+ (setq lim (point))
(c-skip-ws-forward)
(c-forward-type))
@@ -7354,7 +7668,7 @@ comment at the start of cc-engine.el for more info."
t))))
(progn
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws lim)
(c-clear-c-type-property start (1- (point)) 'c-decl-end)
(c-put-c-type-property (1- (point)) 'c-decl-end)
t)
@@ -7451,8 +7765,8 @@ comment at the start of cc-engine.el for more info."
(and
(eq (c-beginning-of-statement-1 lim) 'same)
- (not (or (c-major-mode-is 'objc-mode)
- (c-forward-objc-directive)))
+ (not (and (c-major-mode-is 'objc-mode)
+ (c-forward-objc-directive)))
(setq id-start
(car-safe (c-forward-decl-or-cast-1 (c-point 'bosws) nil nil)))
@@ -7497,14 +7811,17 @@ comment at the start of cc-engine.el for more info."
(save-restriction
;; If we're in a macro, our search range is restricted to it. Narrow to
;; the searchable range.
- (let* ((macro-start (c-query-macro-start))
- (lim (max (or lim (point-min)) (or macro-start (point-min))))
+ (let* ((macro-start (save-excursion (and (c-beginning-of-macro) (point))))
+ (macro-end (save-excursion (and macro-start (c-end-of-macro) (point))))
+ (low-lim (max (or lim (point-min)) (or macro-start (point-min))))
before-lparen after-rparen
- (pp-count-out 20)) ; Max number of paren/brace constructs before we give up
- (narrow-to-region lim (c-point 'eol))
+ (pp-count-out 20)) ; Max number of paren/brace constructs before
+ ; we give up
+ (narrow-to-region low-lim (or macro-end (point-max)))
;; Search backwards for the defun's argument list. We give up if we
- ;; encounter a "}" (end of a previous defun) or BOB.
+ ;; encounter a "}" (end of a previous defun) an "=" (which can't be in
+ ;; a knr region) or BOB.
;;
;; The criterion for a paren structure being the arg list is:
;; o - there is non-WS stuff after it but before any "{"; AND
@@ -7524,12 +7841,13 @@ comment at the start of cc-engine.el for more info."
(catch 'knr
(while (> pp-count-out 0) ; go back one paren/bracket pair each time.
(setq pp-count-out (1- pp-count-out))
- (c-syntactic-skip-backward "^)]}")
+ (c-syntactic-skip-backward "^)]}=")
(cond ((eq (char-before) ?\))
(setq after-rparen (point)))
((eq (char-before) ?\])
(setq after-rparen nil))
- (t ; either } (hit previous defun) or no more parens/brackets
+ (t ; either } (hit previous defun) or = or no more
+ ; parens/brackets.
(throw 'knr nil)))
(if after-rparen
@@ -7545,18 +7863,18 @@ comment at the start of cc-engine.el for more info."
;; It can't be the arg list if next token is ; or {
(progn (goto-char after-rparen)
(c-forward-syntactic-ws)
- (not (memq (char-after) '(?\; ?\{))))
+ (not (memq (char-after) '(?\; ?\{ ?\=))))
;; Is the thing preceding the list an identifier (the
;; function name), or a macro expansion?
(progn
(goto-char before-lparen)
(eq (c-backward-token-2) 0)
- (or (c-on-identifier)
+ (or (eq (c-on-identifier) (point))
(and (eq (char-after) ?\))
(c-go-up-list-backward)
(eq (c-backward-token-2) 0)
- (c-on-identifier))))
+ (eq (c-on-identifier) (point)))))
;; Have we got a non-empty list of comma-separated
;; identifiers?
@@ -8044,6 +8362,23 @@ comment at the start of cc-engine.el for more info."
next-open-brace (c-pull-open-brace paren-state)))
open-brace))
+(defun c-cheap-inside-bracelist-p (paren-state)
+ ;; Return the position of the L-brace if point is inside a brace list
+ ;; initialization of an array, etc. This is an approximate function,
+ ;; designed for speed over accuracy. It will not find every bracelist, but
+ ;; a non-nil result is reliable. We simply search for "= {" (naturally with
+ ;; syntactic whitespace allowed). PAREN-STATE is the normal thing that it
+ ;; is everywhere else.
+ (let (b-pos)
+ (save-excursion
+ (while
+ (and (setq b-pos (c-pull-open-brace paren-state))
+ (progn (goto-char b-pos)
+ (c-backward-sws)
+ (c-backward-token-2)
+ (not (looking-at "=")))))
+ b-pos)))
+
(defun c-inside-bracelist-p (containing-sexp paren-state)
;; return the buffer position of the beginning of the brace list
;; statement if we're inside a brace list, otherwise return nil.
@@ -8395,7 +8730,6 @@ comment at the start of cc-engine.el for more info."
(setq pos (point)))
(and
c-macro-with-semi-re
- (not (c-in-literal))
(eq (skip-chars-backward " \t") 0)
;; Check we've got nothing after this except comments and empty lines
@@ -8426,7 +8760,9 @@ comment at the start of cc-engine.el for more info."
(c-backward-syntactic-ws)
t))
(c-simple-skip-symbol-backward)
- (looking-at c-macro-with-semi-re)))))
+ (looking-at c-macro-with-semi-re)
+ (goto-char pos)
+ (not (c-in-literal)))))) ; The most expensive check last.
(defun c-macro-vsemi-status-unknown-p () t) ; See cc-defs.el.
@@ -8967,6 +9303,10 @@ comment at the start of cc-engine.el for more info."
containing-sexp nil)))
(setq lim (1+ containing-sexp))))
(setq lim (point-min)))
+ (when (c-beginning-of-macro)
+ (goto-char indent-point)
+ (let ((lim1 (c-determine-limit 2000)))
+ (setq lim (max lim lim1))))
;; If we're in a parenthesis list then ',' delimits the
;; "statements" rather than being an operator (with the
@@ -9276,12 +9616,12 @@ comment at the start of cc-engine.el for more info."
(setq tmpsymbol nil)
(while (and (> (point) placeholder)
(zerop (c-backward-token-2 1 t))
- (/= (char-after) ?=))
+ (not (looking-at "=\\([^=]\\|$\\)")))
(and c-opt-inexpr-brace-list-key
(not tmpsymbol)
(looking-at c-opt-inexpr-brace-list-key)
(setq tmpsymbol 'topmost-intro-cont)))
- (eq (char-after) ?=))
+ (looking-at "=\\([^=]\\|$\\)"))
(looking-at c-brace-list-key))
(save-excursion
(while (and (< (point) indent-point)
@@ -9331,13 +9671,14 @@ comment at the start of cc-engine.el for more info."
;; CASE 5B: After a function header but before the body (or
;; the ending semicolon if there's no body).
((save-excursion
- (when (setq placeholder (c-just-after-func-arglist-p lim))
+ (when (setq placeholder (c-just-after-func-arglist-p
+ (max lim (c-determine-limit 500))))
(setq tmp-pos (point))))
(cond
;; CASE 5B.1: Member init list.
((eq (char-after tmp-pos) ?:)
- (if (or (> tmp-pos indent-point)
+ (if (or (>= tmp-pos indent-point)
(= (c-point 'bosws) (1+ tmp-pos)))
(progn
;; There is no preceding member init clause.
@@ -9539,7 +9880,7 @@ comment at the start of cc-engine.el for more info."
;; top level construct. Or, perhaps, an unrecognized construct.
(t
(while (and (setq placeholder (point))
- (eq (car (c-beginning-of-decl-1 containing-sexp))
+ (eq (car (c-beginning-of-decl-1 containing-sexp)) ; Can't use `lim' here.
'same)
(save-excursion
(c-backward-syntactic-ws)
@@ -9642,7 +9983,7 @@ comment at the start of cc-engine.el for more info."
(eq (cdar c-state-cache) (point)))
;; Speed up the backward search a bit.
(goto-char (caar c-state-cache)))
- (c-beginning-of-decl-1 containing-sexp)
+ (c-beginning-of-decl-1 containing-sexp) ; Can't use `lim' here.
(setq placeholder (point))
(if (= start (point))
;; The '}' is unbalanced.
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 97cfe808322..2d116e1ecdc 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1,6 +1,6 @@
;;; cc-fonts.el --- font lock support for CC Mode
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 2002- Martin Stjernholm
@@ -446,10 +446,12 @@
;; `parse-sexp-lookup-properties' (when it exists).
(parse-sexp-lookup-properties
(cc-eval-when-compile
- (boundp 'parse-sexp-lookup-properties))))
+ (boundp 'parse-sexp-lookup-properties)))
+ (BOD-limit
+ (c-determine-limit 1000)))
(goto-char
(let ((here (point)))
- (if (eq (car (c-beginning-of-decl-1)) 'same)
+ (if (eq (car (c-beginning-of-decl-1 BOD-limit)) 'same)
(point)
here)))
,(c-make-font-lock-search-form regexp highlights))
@@ -1240,6 +1242,7 @@ casts and declarations are fontified. Used on level 2 and higher."
;; it finds any. That's necessary so that we later will
;; stop inside them to fontify types there.
(c-parse-and-markup-<>-arglists t)
+ lbrace ; position of some {.
;; The font-lock package in Emacs is known to clobber
;; `parse-sexp-lookup-properties' (when it exists).
(parse-sexp-lookup-properties
@@ -1351,7 +1354,6 @@ casts and declarations are fontified. Used on level 2 and higher."
(or (looking-at c-typedef-key)
(goto-char start-pos)))
- ;; Now analyze the construct.
;; In QT, "more" is an irritating keyword that expands to nothing.
;; We skip over it to prevent recognition of "more slots: <symbol>"
;; as a bitfield declaration.
@@ -1360,6 +1362,8 @@ casts and declarations are fontified. Used on level 2 and higher."
(concat "\\(more\\)\\([^" c-symbol-chars "]\\|$\\)")))
(goto-char (match-end 1))
(c-forward-syntactic-ws))
+
+ ;; Now analyze the construct.
(setq decl-or-cast (c-forward-decl-or-cast-1
match-pos context last-cast-end))
@@ -1428,11 +1432,60 @@ casts and declarations are fontified. Used on level 2 and higher."
(c-fontify-recorded-types-and-refs)
nil)
+ ;; Restore point, since at this point in the code it has been
+ ;; left undefined by c-forward-decl-or-cast-1 above.
+ ((progn (goto-char start-pos) nil))
+
+ ;; If point is inside a bracelist, there's no point checking it
+ ;; being at a declarator.
+ ((let ((paren-state (c-parse-state)))
+ (setq lbrace (c-cheap-inside-bracelist-p paren-state)))
+ ;; Move past this bracelist to prevent an endless loop.
+ (goto-char lbrace)
+ (unless (c-safe (progn (forward-list) t))
+ (goto-char start-pos)
+ (c-forward-token-2))
+ nil)
+
+ ;; If point is just after a ")" which is followed by an
+ ;; identifier which isn't a label, or at the matching "(", we're
+ ;; at either a macro invocation, a cast, or a
+ ;; for/while/etc. statement. The cast case is handled above.
+ ;; None of these cases can contain a declarator.
+ ((or (and (eq (char-before match-pos) ?\))
+ (c-on-identifier)
+ (save-excursion (not (c-forward-label))))
+ (and (eq (char-after) ?\()
+ (save-excursion
+ (and
+ (progn (c-backward-token-2) (c-on-identifier))
+ (save-excursion (not (c-forward-label)))
+ (progn (c-backward-token-2)
+ (eq (char-after) ?\())))))
+ (c-forward-token-2) ; Must prevent looping.
+ nil)
+
+ ((and (not c-enums-contain-decls)
+ ;; An optimization quickly to eliminate scans of long enum
+ ;; declarations in the next cond arm.
+ (let ((paren-state (c-parse-state)))
+ (and
+ (numberp (car paren-state))
+ (save-excursion
+ (goto-char (car paren-state))
+ (c-backward-token-2)
+ (or (looking-at c-brace-list-key)
+ (progn
+ (c-backward-token-2)
+ (looking-at c-brace-list-key)))))))
+ (c-forward-token-2)
+ nil)
+
(t
;; Are we at a declarator? Try to go back to the declaration
;; to check this. If we get there, check whether a "typedef"
;; is there, then fontify the declarators accordingly.
- (let ((decl-search-lim (max (- (point) 50000) (point-min)))
+ (let ((decl-search-lim (c-determine-limit 1000))
paren-state bod-res encl-pos is-typedef
c-recognize-knr-p) ; Strictly speaking, bogus, but it
; speeds up lisp.h tremendously.
diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el
index 6553021e783..4dd802ead0b 100644
--- a/lisp/progmodes/cc-guess.el
+++ b/lisp/progmodes/cc-guess.el
@@ -1,6 +1,6 @@
;;; cc-guess.el --- guess indentation values by scanning existing code
-;; Copyright (C) 1985, 1987, 1992-2006, 2011
+;; Copyright (C) 1985, 1987, 1992-2006, 2011-2012
;; Free Software Foundation, Inc.
;; Author: 1994-1995 Barry A. Warsaw
@@ -85,6 +85,7 @@ Discard an examined offset if its absolute value is greater than this.
The offset of a line included in the indent information returned by
`c-guess-basic-syntax'."
+ :version "24.1"
:type 'integer
:group 'c)
@@ -92,6 +93,7 @@ The offset of a line included in the indent information returned by
"The maximum region size for examining indent information with `c-guess'.
It takes a long time to examine indent information from a large region;
this option helps you limit that time. `nil' means no limit."
+ :version "24.1"
:type 'integer
:group 'c)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 2aca885ca35..d5a1be572ba 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -1,6 +1,6 @@
;;; cc-langs.el --- language specific settings for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2012 Free Software Foundation, Inc.
;; Authors: 2002- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -208,9 +208,10 @@ the evaluated constant value at compile time."
;; Suppress "might not be defined at runtime" warning.
;; This file is only used when compiling other cc files.
-(declare-function delete-duplicates "cl-seq" (cl-seq &rest cl-keys))
-(declare-function mapcan "cl-extra" (cl-func cl-seq &rest cl-rest))
-(declare-function cl-macroexpand-all "cl-extra" (form &optional env))
+;; These are defined in cl as aliases to the cl- versions.
+(declare-function delete-duplicates "cl-seq" (cl-seq &rest cl-keys) t)
+(declare-function mapcan "cl-extra" (cl-func cl-seq &rest cl-rest) t)
+(declare-function cl-macroexpand-all "cl" (form &optional env))
(eval-and-compile
;; Some helper functions used when building the language constants.
@@ -459,8 +460,10 @@ so that all identifiers are recognized as words.")
;; For documentation see the following c-lang-defvar of the same name.
;; The value here may be a list of functions or a single function.
t nil
- c++ '(c-extend-region-for-CPP c-before-change-check-<>-operators)
- (c objc) 'c-extend-region-for-CPP
+ c++ '(c-extend-region-for-CPP
+ c-before-change-check-<>-operators
+ c-invalidate-macro-cache)
+ (c objc) '(c-extend-region-for-CPP c-invalidate-macro-cache)
;; java 'c-before-change-check-<>-operators
awk 'c-awk-record-region-clear-NL)
(c-lang-defvar c-get-state-before-change-functions
@@ -576,7 +579,7 @@ keyword. It's unspecified how far it matches. Does not contain a \\|
operator at the top level."
t (concat "[" c-alpha "_]")
java (concat "[" c-alpha "_@]")
- objc (concat "[" c-alpha "@]")
+ objc (concat "[" c-alpha "_@]")
pike (concat "[" c-alpha "_`]"))
(c-lang-defvar c-symbol-start (c-lang-const c-symbol-start))
@@ -2938,6 +2941,12 @@ expression is considered to be a type."
(consp (c-lang-const c-<>-arglist-kwds))))
(c-lang-defvar c-recognize-<>-arglists (c-lang-const c-recognize-<>-arglists))
+(c-lang-defconst c-enums-contain-decls
+ "Non-nil means that an enum structure can contain declarations."
+ t nil
+ java t)
+(c-lang-defvar c-enums-contain-decls (c-lang-const c-enums-contain-decls))
+
(c-lang-defconst c-recognize-paren-inits
"Non-nil means that parenthesis style initializers exist,
i.e. constructs like
diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el
index 942303b1096..76e3002abd2 100644
--- a/lisp/progmodes/cc-menus.el
+++ b/lisp/progmodes/cc-menus.el
@@ -1,6 +1,6 @@
;;; cc-menus.el --- imenu support for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2012 Free Software Foundation, Inc.
;; Authors: 1998- Martin Stjernholm
;; 1992-1999 Barry A. Warsaw
@@ -63,6 +63,20 @@ For example:
A sample value might look like: `\\(_P\\|_PROTO\\)'.")
+;; *Warning for cc-mode developers*
+;;
+;; `cc-imenu-objc-generic-expression' elements depend on
+;; `cc-imenu-c++-generic-expression'. So if you change this
+;; expression, you need to change following variables,
+;; `cc-imenu-objc-generic-expression-*-index',
+;; too. `cc-imenu-objc-function' uses these *-index variables, in
+;; order to know where the each regexp *group \\(foobar\\)* elements
+;; are started.
+;;
+;; *-index variables are initialized during `cc-imenu-objc-generic-expression'
+;; being initialized.
+;;
+
(defvar cc-imenu-c++-generic-expression
`(
;; Try to match ::operator definitions first. Otherwise `X::operator new ()'
@@ -187,23 +201,8 @@ A sample value might look like: `\\(_P\\|_PROTO\\)'.")
")"
"[.," c-alnum " \t\n\r]*"
"{"
- )) 1))
- "Imenu generic expression for Java mode. See
-`imenu-generic-expression'.")
-
-;; *Warning for cc-mode developers*
-;;
-;; `cc-imenu-objc-generic-expression' elements depend on
-;; `cc-imenu-c++-generic-expression'. So if you change this
-;; expression, you need to change following variables,
-;; `cc-imenu-objc-generic-expression-*-index',
-;; too. `cc-imenu-objc-function' uses these *-index variables, in
-;; order to know where the each regexp *group \\(foobar\\)* elements
-;; are started.
-;;
-;; *-index variables are initialized during `cc-imenu-objc-generic-expression'
-;; being initialized.
-;;
+ )) 1))
+ "Imenu generic expression for Java mode. See `imenu-generic-expression'.")
;; Internal variables
(defvar cc-imenu-objc-generic-expression-noreturn-index nil)
@@ -224,7 +223,7 @@ A sample value might look like: `\\(_P\\|_PROTO\\)'.")
"\\|"
;; > General function name regexp
;; Pick a token by (match-string 3)
- (car (cdr (nth 2 cc-imenu-c++-generic-expression))) ; -> index += 5
+ (car (cdr (nth 2 cc-imenu-c++-generic-expression))) ; -> index += 6
(prog2 (setq cc-imenu-objc-generic-expression-general-func-index 3) "")
;; > Special case for definitions using phony prototype macros like:
;; > `int main _PROTO( (int argc,char *argv[]) )'.
@@ -233,11 +232,11 @@ A sample value might look like: `\\(_P\\|_PROTO\\)'.")
(concat
"\\|"
(car (cdr (nth 3 cc-imenu-c++-generic-expression))) ; -> index += 1
- (prog2 (setq cc-imenu-objc-generic-expression-objc-base-index 9) "")
+ (prog2 (setq cc-imenu-objc-generic-expression-objc-base-index 10) "")
)
- (prog2 (setq cc-imenu-objc-generic-expression-objc-base-index 8) "")
+ (prog2 (setq cc-imenu-objc-generic-expression-objc-base-index 9) "")
"") ; -> index += 0
- (prog2 (setq cc-imenu-objc-generic-expression-proto-index 8) "")
+ (prog2 (setq cc-imenu-objc-generic-expression-proto-index 9) "")
;;
;; For Objective-C
;; Pick a token by (match-string 8 or 9)
@@ -400,14 +399,10 @@ Example:
str2 "@protocol")))
(setq str (cc-imenu-objc-remove-white-space str))
(setq methodlist (cons (cons str2
- (match-beginning langnum))
+ (match-beginning langnum))
methodlist))
- (setq toplist (cons nil (cons (cons str
- methodlist) toplist))
+ (setq toplist (cons (cons str methodlist) toplist)
methodlist nil))))
- ;;
- (if (eq (car toplist) nil)
- (setq toplist (cdr toplist)))
;; In this buffer, there is only one or zero @{interface|implementation|protocol}.
(if (< classcount 2)
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 1bc0741b0aa..91866278e28 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1,6 +1,6 @@
;;; cc-mode.el --- major mode for editing C and similar languages
-;; Copyright (C) 1985, 1987, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2012 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -490,6 +490,7 @@ that requires a literal mode spec at compile time."
(make-local-variable 'paragraph-ignore-fill-prefix)
(make-local-variable 'adaptive-fill-mode)
(make-local-variable 'adaptive-fill-regexp)
+ (make-local-variable 'fill-paragraph-handle-comment)
;; now set their values
(set (make-local-variable 'parse-sexp-ignore-comments) t)
@@ -500,6 +501,9 @@ that requires a literal mode spec at compile time."
(set (make-local-variable 'comment-line-break-function)
'c-indent-new-comment-line)
+ ;; For the benefit of adaptive file, which otherwise mis-fills.
+ (setq fill-paragraph-handle-comment nil)
+
;; Install `c-fill-paragraph' on `fill-paragraph-function' so that a
;; direct call to `fill-paragraph' behaves better. This still
;; doesn't work with filladapt but it's better than nothing.
@@ -921,8 +925,8 @@ Note that the style variables are always made local to the buffer."
;; inside a string, comment, or macro.
(setq new-bounds (c-extend-font-lock-region-for-macros
c-new-BEG c-new-END old-len))
- (setq c-new-BEG (car new-bounds)
- c-new-END (cdr new-bounds))
+ (setq c-new-BEG (max (car new-bounds) (c-determine-limit 500 begg))
+ c-new-END (min (cdr new-bounds) (c-determine-+ve-limit 500 endd)))
;; Clear all old relevant properties.
(c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1))
(c-clear-char-property-with-value c-new-BEG c-new-END 'category 'c-cpp-delimiter)
@@ -1030,7 +1034,10 @@ Note that the style variables are always made local to the buffer."
(mapc (lambda (fn)
(funcall fn beg end))
c-get-state-before-change-functions))
- ))))
+ )))
+ ;; The following must be done here rather than in `c-after-change' because
+ ;; newly inserted parens would foul up the invalidation algorithm.
+ (c-invalidate-state-cache beg))
(defvar c-in-after-change-fontification nil)
(make-variable-buffer-local 'c-in-after-change-fontification)
@@ -1078,7 +1085,7 @@ Note that the style variables are always made local to the buffer."
(c-trim-found-types beg end old-len) ; maybe we don't need all of these.
(c-invalidate-sws-region-after beg end)
- (c-invalidate-state-cache beg)
+ ;; (c-invalidate-state-cache beg) ; moved to `c-before-change'.
(c-invalidate-find-decl-cache beg)
(when c-recognize-<>-arglists
@@ -1102,7 +1109,7 @@ Note that the style variables are always made local to the buffer."
;; nested.
;;
;; This function is called indirectly from font locking stuff - either from
- ;; c-after-change (to prepare for after-change font-lockng) or from font
+ ;; c-after-change (to prepare for after-change font-locking) or from font
;; lock context (etc.) fontification.
(let ((lit-limits (c-literal-limits))
(new-pos pos)
@@ -1110,7 +1117,7 @@ Note that the style variables are always made local to the buffer."
(goto-char (c-point 'bol new-pos))
(when lit-limits ; Comment or string.
(goto-char (car lit-limits)))
- (setq bod-lim (max (- (point) 500) (point-min)))
+ (setq bod-lim (c-determine-limit 500))
(while
;; Go to a less nested declaration each time round this loop.
@@ -1128,11 +1135,12 @@ Note that the style variables are always made local to the buffer."
;; Try and go out a level to search again.
(progn
(c-backward-syntactic-ws bod-lim)
- (or (memq (char-before) '(?\( ?\[))
- (and (eq (char-before) ?\<)
- (eq (c-get-char-property
- (1- (point)) 'syntax-table)
- c-<-as-paren-syntax))))
+ (and (> (point) bod-lim)
+ (or (memq (char-before) '(?\( ?\[))
+ (and (eq (char-before) ?\<)
+ (eq (c-get-char-property
+ (1- (point)) 'syntax-table)
+ c-<-as-paren-syntax)))))
(not (bobp)))
(backward-char))
new-pos)) ; back over (, [, <.
@@ -1158,7 +1166,7 @@ Note that the style variables are always made local to the buffer."
;; Effectively advice around `font-lock-fontify-region' which extends the
;; region (BEG END), for example, to avoid context fontification chopping
;; off the start of the context. Do not do anything if it's already been
- ;; done (i.e. from and after-change fontification. An example (C++) where
+ ;; done (i.e. from an after-change fontification. An example (C++) where
;; this used to happen is this:
;;
;; template <typename T>
@@ -1168,7 +1176,7 @@ Note that the style variables are always made local to the buffer."
;;
;; Type a space in the first blank line, and the fontification of the next
;; line was fouled up by context fontification.
- (let ((new-beg beg) (new-end end) new-region)
+ (let ((new-beg beg) (new-end end) new-region case-fold-search)
(if c-in-after-change-fontification
(setq c-in-after-change-fontification nil)
(save-restriction
@@ -1180,10 +1188,10 @@ Note that the style variables are always made local to the buffer."
c-before-context-fontification-functions))))
(funcall c-standard-font-lock-fontify-region-function
new-beg new-end verbose)))
-
+
(defun c-after-font-lock-init ()
;; Put on `font-lock-mode-hook'. This function ensures our after-change
- ;; function will get excuted before the font-lock one. Amongst other
+ ;; function will get executed before the font-lock one. Amongst other
;; things.
(remove-hook 'after-change-functions 'c-after-change t)
(add-hook 'after-change-functions 'c-after-change nil t)
@@ -1579,7 +1587,7 @@ Key bindings:
(easy-menu-define c-pike-menu pike-mode-map "Pike Mode Commands"
(cons "Pike" (c-lang-const c-mode-menu pike)))
-;;;###autoload (add-to-list 'auto-mode-alist '("\\.\\(u?lpc\\|pike\\|pmod\\(.in\\)?\\)\\'" . pike-mode))
+;;;###autoload (add-to-list 'auto-mode-alist '("\\.\\(u?lpc\\|pike\\|pmod\\(\\.in\\)?\\)\\'" . pike-mode))
;;;###autoload (add-to-list 'interpreter-mode-alist '("pike" . pike-mode))
;;;###autoload
@@ -1698,7 +1706,9 @@ Key bindings:
(message "Using CC Mode version %s" c-version)
(c-keep-region-active))
-(defvar c-prepare-bug-report-hooks nil)
+(define-obsolete-variable-alias 'c-prepare-bug-report-hooks
+ 'c-prepare-bug-report-hook "24.3")
+(defvar c-prepare-bug-report-hook nil)
;; Dynamic variables used by reporter.
(defvar reporter-prompt-for-summary-p)
@@ -1765,7 +1775,7 @@ Key bindings:
lookup-syntax-properties))
vars)
(lambda ()
- (run-hooks 'c-prepare-bug-report-hooks)
+ (run-hooks 'c-prepare-bug-report-hook)
(insert (format "Buffer Style: %s\nc-emacs-features: %s\n"
style c-features)))))))
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index 96cb15f2a72..20aa2bc2775 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -1,6 +1,6 @@
;;; cc-styles.el --- support for styles in CC Mode
-;; Copyright (C) 1985, 1987, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2012 Free Software Foundation, Inc.
;; Authors: 2004- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -352,8 +352,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
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index a4338a3193b..d56c1124a9c 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -1,6 +1,6 @@
;;; cc-vars.el --- user customization variables for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2012 Free Software Foundation, Inc.
;; Authors: 2002- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -49,16 +49,6 @@
(require 'custom)
(require 'widget))
-(cc-eval-when-compile
- ;; Need the function form of `backquote', which isn't standardized
- ;; between Emacsen. It's called `bq-process' in XEmacs, and
- ;; `backquote-process' in Emacs. `backquote-process' returns a
- ;; slightly more convoluted form, so let `bq-process' be the norm.
- (if (fboundp 'backquote-process)
- (cc-bytecomp-defmacro bq-process (form)
- `(cdr (backquote-process ,form)))))
-
-
;;; Helpers
;; This widget exists in newer versions of the Custom library
@@ -349,6 +339,7 @@ Its value is one of:
go-outward -- Nested functions are also recognized. Should a function
command hit the beginning/end of a nested scope, it will
carry on at the less nested level."
+ :version "24.1"
:type '(radio
(const :tag "Functions are at the top-level" t)
(const :tag "Functions are also recognized inside declaration scopes" go-outward))
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index ffe8edfaeb6..64e99fb1f3d 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -1,6 +1,6 @@
;;; cfengine.el --- mode for editing Cfengine files
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
@@ -54,7 +54,7 @@
:group 'languages)
(defcustom cfengine-indent 2
- "*Size of a CFEngine indentation step in columns."
+ "Size of a CFEngine indentation step in columns."
:group 'cfengine
:type 'integer)
diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el
index 322492c5566..525b1c9671e 100644
--- a/lisp/progmodes/cmacexp.el
+++ b/lisp/progmodes/cmacexp.el
@@ -1,6 +1,6 @@
;;; cmacexp.el --- expand C macros in a region
-;; Copyright (C) 1992, 1994, 1996, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 1996, 2000-2012 Free Software Foundation, Inc.
;; Author: Francesco Potorti` <pot@gnu.org>
;; Adapted-By: ESR
@@ -49,7 +49,7 @@
;; INSTALLATION ======================================================
-;; Put the following in your ~/.emacs file.
+;; Put the following in your init file.
;; If you want the *Macroexpansion* window to be not higher than
;; necessary:
@@ -80,7 +80,7 @@
;; making comments visible in the expansion.
;; - All work is done in core memory, no need for temporary files.
-;; ACKNOWLEDGEMENTS ==================================================
+;; ACKNOWLEDGMENTS ===================================================
;; A lot of thanks to Don Maszle who did a great work of testing, bug
;; reporting and suggestion of new features. This work has been
@@ -106,12 +106,12 @@
(defcustom c-macro-shrink-window-flag nil
- "*Non-nil means shrink the *Macroexpansion* window to fit its contents."
+ "Non-nil means shrink the *Macroexpansion* window to fit its contents."
:type 'boolean
:group 'c-macro)
(defcustom c-macro-prompt-flag nil
- "*Non-nil makes `c-macro-expand' prompt for preprocessor arguments."
+ "Non-nil makes `c-macro-expand' prompt for preprocessor arguments."
:type 'boolean
:group 'c-macro)
@@ -141,7 +141,7 @@ option, or to set an equivalent one."
:group 'c-macro)
(defcustom c-macro-cppflags ""
- "*Preprocessor flags used by `c-macro-expand'."
+ "Preprocessor flags used by `c-macro-expand'."
:type 'string
:group 'c-macro)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 73e990e2755..06525b354b1 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1,6 +1,6 @@
;;; compile.el --- run compiler as inferior of Emacs, parse error messages
-;; Copyright (C) 1985-1987, 1993-1999, 2001-2011
+;; Copyright (C) 1985-1987, 1993-1999, 2001-2012
;; Free Software Foundation, Inc.
;; Authors: Roland McGrath <roland@gnu.org>,
@@ -30,7 +30,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'tool-bar)
(require 'comint)
@@ -74,11 +74,14 @@ If Emacs lacks asynchronous process support, this hook is run
after `call-process' inserts the grep output into the buffer.")
(defvar compilation-filter-start nil
- "Start of the text inserted by `compilation-filter'.
-This is bound to a buffer position before running `compilation-filter-hook'.")
+ "Position of the start of the text inserted by `compilation-filter'.
+This is bound before running `compilation-filter-hook'.")
(defvar compilation-first-column 1
- "*This is how compilers number the first column, usually 1 or 0.")
+ "This is how compilers number the first column, usually 1 or 0.
+If this is buffer-local in the destination buffer, Emacs obeys
+that value, otherwise it uses the value in the *compilation*
+buffer. This enables a major-mode to specify its own value.")
(defvar compilation-parse-errors-filename-function nil
"Function to call to post-process filenames while parsing error messages.
@@ -87,7 +90,7 @@ in the compilation output, and should return a transformed file name.")
;;;###autoload
(defvar compilation-process-setup-function nil
- "*Function to call to customize the compilation process.
+ "Function to call to customize the compilation process.
This function is called immediately before the compilation process is
started. It can be used to set any variables or functions that are used
while processing the output of the compilation process.")
@@ -168,6 +171,15 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
"\\(?:^cucumber\\(?: -p [^[:space:]]+\\)?\\|#\\)\
\\(?: \\)\\([^\(].*\\):\\([1-9][0-9]*\\)" 1 2)
+ (msft
+ ;; Must be before edg-1, so that MSVC's longer messages are
+ ;; considered before EDG.
+ ;; The message may be a "warning", "error", or "fatal error" with
+ ;; an error code, or "see declaration of" without an error code.
+ "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) ?\
+: \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)"
+ 2 3 nil (4))
+
(edg-1
"^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
1 2 nil (3 . 4))
@@ -206,7 +218,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
;; due to matching filenames via \\(.*?\\). This might be faster.
(maven
;; Maven is a popular free software build tool for Java.
- "\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\] " 1 2 3)
+ "\\([^ \n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\] " 1 2 3)
(jikes-line
"^ *\\([0-9]+\\)\\.[ \t]+.*\n +\\(<-*>\n\\*\\*\\* \\(?:Error\\|Warnin\\(g\\)\\)\\)"
@@ -485,9 +497,12 @@ What matched the HYPERLINK'th subexpression has `mouse-face' and
`compilation-message-face' applied. If this is nil, the text
matched by the whole REGEXP becomes the hyperlink.
-Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where SUBMATCH is
-the number of a submatch that should be highlighted when it matches,
-and FACE is an expression returning the face to use for that submatch.."
+Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where
+SUBMATCH is the number of a submatch and FACE is an expression
+which evaluates to a face name (a symbol or string).
+Alternatively, FACE can evaluate to a property list of the
+form (face FACE PROP1 VAL1 PROP2 VAL2 ...), in which case all the
+listed text properties PROP# are given values VAL# as well."
:type '(repeat (choice (symbol :tag "Predefined symbol")
(sexp :tag "Error specification")))
:link `(file-link :tag "example file"
@@ -547,7 +562,10 @@ Otherwise they are interpreted as character positions, with
each character occupying one column.
The default is to use screen columns, which requires that the compilation
program and Emacs agree about the display width of the characters,
-especially the TAB character."
+especially the TAB character.
+If this is buffer-local in the destination buffer, Emacs obeys
+that value, otherwise it uses the value in the *compilation*
+buffer. This enables a major-mode to specify its own value."
:type 'boolean
:group 'compilation
:version "20.4")
@@ -627,7 +645,7 @@ This only affects platforms that support asynchronous processes (see
(defvar compilation-locs ())
(defvar compilation-debug nil
- "*Set this to t before creating a *compilation* buffer.
+ "Set this to t before creating a *compilation* buffer.
Then every error line will have a debug text property with the matcher that
fit this line and the match data. Use `describe-text-properties'.")
@@ -668,6 +686,34 @@ starting the compilation process."
:group 'compilation
:version "22.1")
+;; The next three faces must be able to stand out against the
+;; `mode-line' and `mode-line-inactive' faces.
+
+(defface compilation-mode-line-fail
+ '((default :inherit compilation-error)
+ (((class color) (min-colors 16)) (:foreground "Red1" :weight bold))
+ (((class color) (min-colors 8)) (:foreground "red"))
+ (t (:inverse-video t :weight bold)))
+ "Face for Compilation mode's \"error\" mode line indicator."
+ :group 'compilation
+ :version "24.3")
+
+(defface compilation-mode-line-run
+ '((t :inherit compilation-warning))
+ "Face for Compilation mode's \"running\" mode line indicator."
+ :group 'compilation
+ :version "24.3")
+
+(defface compilation-mode-line-exit
+ '((default :inherit compilation-info)
+ (((class color) (min-colors 16))
+ (:foreground "ForestGreen" :weight bold))
+ (((class color)) (:foreground "green" :weight bold))
+ (t (:weight bold)))
+ "Face for Compilation mode's \"exit\" mode line indicator."
+ :group 'compilation
+ :version "24.3")
+
(defface compilation-line-number
'((t :inherit font-lock-keyword-face))
"Face for displaying line numbers in compiler messages."
@@ -711,12 +757,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."
@@ -733,7 +777,7 @@ Faces `compilation-error-face', `compilation-warning-face',
;; (make-variable-buffer-local 'compilation-buffer-modtime)
(defvar compilation-skip-to-next-location t
- "*If non-nil, skip multiple error messages for the same source location.")
+ "If non-nil, skip multiple error messages for the same source location.")
(defcustom compilation-skip-threshold 1
"Compilation motion commands skip less important messages.
@@ -757,7 +801,7 @@ info, are considered errors."
3)))
(setq compilation-skip-threshold level)
(message "Skipping %s"
- (case compilation-skip-threshold
+ (pcase compilation-skip-threshold
(0 "Nothing")
(1 "Info messages")
(2 "Warnings and info"))))
@@ -792,7 +836,7 @@ from a different message."
;; modified using the same *compilation* buffer. this necessitates
;; re-parsing markers.
-;; (defstruct (compilation--loc
+;; (cl-defstruct (compilation--loc
;; (:constructor nil)
;; (:copier nil)
;; (:constructor compilation--make-loc
@@ -841,7 +885,7 @@ from a different message."
;; These are the value of the `compilation-message' text-properties in the
;; compilation buffer.
-(defstruct (compilation--message
+(cl-defstruct (compilation--message
(:constructor nil)
(:copier nil)
;; (:type list) ;Old representation.
@@ -1058,17 +1102,18 @@ FMTS is a list of format specs for transforming the file name.
(marker
(if marker-line (compilation--loc->marker (cadr marker-line))))
(screen-columns compilation-error-screen-columns)
+ (first-column compilation-first-column)
end-marker loc end-loc)
(if (not (and marker (marker-buffer marker)))
(setq marker nil) ; no valid marker for this file
- (setq loc (or line 1)) ; normalize no linenumber to line 1
+ (unless line (setq line 1)) ; normalize no linenumber to line 1
(catch 'marker ; find nearest loc, at least one exists
(dolist (x (cddr (compilation--file-struct->loc-tree
file-struct))) ; Loop over remaining lines.
- (if (> (car x) loc) ; Still bigger.
+ (if (> (car x) line) ; Still bigger.
(setq marker-line x)
- (if (> (- (or (car marker-line) 1) loc)
- (- loc (car x))) ; Current line is nearer.
+ (if (> (- (or (car marker-line) 1) line)
+ (- line (car x))) ; Current line is nearer.
(setq marker-line x))
(throw 'marker t))))
(setq marker (compilation--loc->marker (cadr marker-line))
@@ -1078,20 +1123,23 @@ FMTS is a list of format specs for transforming the file name.
;; Obey the compilation-error-screen-columns of the target
;; buffer if its major mode set it buffer-locally.
(if (local-variable-p 'compilation-error-screen-columns)
- compilation-error-screen-columns screen-columns)))
+ compilation-error-screen-columns screen-columns))
+ (compilation-first-column
+ (if (local-variable-p 'compilation-first-column)
+ compilation-first-column first-column)))
(save-excursion
(save-restriction
(widen)
(goto-char (marker-position marker))
- (when (or end-col end-line)
+ ;; Set end-marker if appropriate and go to line.
+ (if (not (or end-col end-line))
+ (beginning-of-line (- line marker-line -1))
(beginning-of-line (- (or end-line line) marker-line -1))
(if (or (null end-col) (< end-col 0))
(end-of-line)
(compilation-move-to-column end-col screen-columns))
- (setq end-marker (point-marker)))
- (beginning-of-line (if end-line
- (- line end-line -1)
- (- loc marker-line -1)))
+ (setq end-marker (point-marker))
+ (when end-line (beginning-of-line (- line end-line -1))))
(if col
(compilation-move-to-column col screen-columns)
(forward-to-indentation 0))
@@ -1174,7 +1222,7 @@ FMTS is a list of format specs for transforming the file name.
(goto-char end)
(unless (bolp)
;; We generally don't like to parse partial lines.
- (assert (eobp))
+ (cl-assert (eobp))
(when (let ((proc (get-buffer-process (current-buffer))))
(and proc (memq (process-status proc) '(run open))))
(setq end (line-beginning-position))))
@@ -1290,16 +1338,27 @@ to `compilation-error-regexp-alist' if RULES is nil."
(compilation--put-prop
end-col 'font-lock-face compilation-column-face)
+ ;; Obey HIGHLIGHT.
(dolist (extra-item (nthcdr 6 item))
(let ((mn (pop extra-item)))
(when (match-beginning mn)
(let ((face (eval (car extra-item))))
(cond
((null face))
- ((symbolp face)
+ ((or (symbolp face) (stringp face))
(put-text-property
(match-beginning mn) (match-end mn)
'font-lock-face face))
+ ((and (listp face)
+ (eq (car face) 'face)
+ (or (symbolp (cadr face))
+ (stringp (cadr face))))
+ (put-text-property
+ (match-beginning mn) (match-end mn)
+ 'font-lock-face (cadr face))
+ (add-text-properties
+ (match-beginning mn) (match-end mn)
+ (nthcdr 2 face)))
(t
(error "Don't know how to handle face %S"
face)))))))
@@ -1447,23 +1506,12 @@ 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."
+ :type 'boolean
+ :version "24.3"
+ :group 'compilation)
;;;###autoload
(defun compilation-start (command &optional mode name-function highlight-regexp)
@@ -1497,19 +1545,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))
- (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.
@@ -1519,12 +1568,20 @@ Returns the compilation buffer created."
;; Then evaluate a cd command if any, but don't perform it yet, else
;; start-command would do it again through the shell: (cd "..") AND
;; sh -c "cd ..; make"
- (cd (if (string-match "\\`\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]"
- command)
- (if (match-end 1)
- (substitute-env-vars (match-string 1 command))
- "~")
- default-directory))
+ (cd (cond
+ ((not (string-match "\\`\\s *cd\\(?:\\s +\\(\\S +?\\|'[^']*'\\|\"\\(?:[^\"`$\\]\\|\\\\.\\)*\"\\)\\)?\\s *[;&\n]"
+ command))
+ default-directory)
+ ((not (match-end 1)) "~")
+ ((eq (aref command (match-beginning 1)) ?\')
+ (substring command (1+ (match-beginning 1))
+ (1- (match-end 1))))
+ ((eq (aref command (match-beginning 1)) ?\")
+ (replace-regexp-in-string
+ "\\\\\\(.\\)" "\\1"
+ (substring command (1+ (match-beginning 1))
+ (1- (match-end 1)))))
+ (t (substitute-env-vars (match-string 1 command)))))
(erase-buffer)
;; Select the desired mode.
(if (not (eq mode t))
@@ -1564,7 +1621,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)))
@@ -1614,13 +1671,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
- (list (propertize ":%s" 'face 'compilation-warning)))
- (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,
@@ -1636,9 +1700,9 @@ Returns the compilation buffer created."
(cons proc compilation-in-progress)))
;; No asynchronous processes available.
(message "Executing `%s'..." command)
- ;; Fake modeline display as if `start-process' were run.
+ ;; Fake mode line display as if `start-process' were run.
(setq mode-line-process
- (list (propertize ":run" 'face 'compilation-warning)))
+ '(:propertize ":run" face compilation-mode-line-run))
(force-mode-line-update)
(sit-for 0) ; Force redisplay
(save-excursion
@@ -1874,6 +1938,9 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
(setq buffer-read-only t)
(run-mode-hooks 'compilation-mode-hook))
+;;;###autoload
+(put 'define-compilation-mode 'doc-string-elt 3)
+
(defmacro define-compilation-mode (mode name doc &rest body)
"This is like `define-derived-mode' without the PARENT argument.
The parent is always `compilation-mode' and the customizable `compilation-...'
@@ -2033,9 +2100,10 @@ commands of Compilation major mode are available. See
(car status)))))
(message "%s" msg)
(propertize out-string
- 'help-echo msg 'face (if (> exit-status 0)
- 'compilation-error
- 'compilation-info))))
+ 'help-echo msg
+ 'face (if (> exit-status 0)
+ 'compilation-mode-line-fail
+ 'compilation-mode-line-exit))))
;; Force mode line redisplay soon.
(force-mode-line-update)
(if (and opoint (< opoint omax))
@@ -2122,14 +2190,14 @@ and runs `compilation-filter-hook'."
(if (or (eq (get-text-property ,limit 'compilation-message)
(get-text-property opt 'compilation-message))
(eq pt opt))
- (error ,error compilation-error)
+ (user-error ,error compilation-error)
(setq pt ,limit)))
;; prop 'compilation-message usually has 2 changes, on and off, so
;; re-search if off
(or (setq msg (get-text-property pt 'compilation-message))
(if (setq pt (,property-change pt 'compilation-message nil ,limit))
(setq msg (get-text-property pt 'compilation-message)))
- (error ,error compilation-error))
+ (user-error ,error compilation-error))
(or (< (compilation--message->type msg) compilation-skip-threshold)
(if different-file
(eq (prog1 last
@@ -2271,6 +2339,7 @@ This is the value of `next-error-function' in Compilation buffers."
(when reset
(setq compilation-current-error nil))
(let* ((screen-columns compilation-error-screen-columns)
+ (first-column compilation-first-column)
(last 1)
(msg (compilation-next-error (or n 1) nil
(or compilation-current-error
@@ -2309,7 +2378,10 @@ This is the value of `next-error-function' in Compilation buffers."
;; Obey the compilation-error-screen-columns of the target
;; buffer if its major mode set it buffer-locally.
(if (local-variable-p 'compilation-error-screen-columns)
- compilation-error-screen-columns screen-columns)))
+ compilation-error-screen-columns screen-columns))
+ (compilation-first-column
+ (if (local-variable-p 'compilation-first-column)
+ compilation-first-column first-column)))
(save-restriction
(widen)
(goto-char (point-min))
@@ -2369,7 +2441,7 @@ region and the first line of the next region."
(push fs compilation-gcpro)
(let ((loc (compilation-assq (or line 1) (cdr fs))))
(setq loc (compilation-assq col loc))
- (assert (null (cdr loc)))
+ (cl-assert (null (cdr loc)))
(setcdr loc (compilation--make-cdrloc line fs marker))
loc)))
@@ -2415,10 +2487,7 @@ and overlay is highlighted between MK and END-MK."
;; the error location if the two buffers are in two
;; different frames. So don't do it if it's not necessary.
pre-existing
- (let ((display-buffer-reuse-frames t)
- (pop-up-windows t))
- ;; Pop up a window.
- (display-buffer (marker-buffer msg)))))
+ (display-buffer (marker-buffer msg))))
(highlight-regexp (with-current-buffer (marker-buffer msg)
;; also do this while we change buffer
(compilation-set-window w msg)
@@ -2639,16 +2708,13 @@ The file-structure looks like this:
(defun compilation--flush-file-structure (file)
(or (consp file) (setq file (list file)))
(let ((fs (compilation-get-file-structure file)))
- (assert (eq fs (gethash file compilation-locs)))
- (assert (eq fs (gethash (cons (caar fs) (cadr (car fs)))
+ (cl-assert (eq fs (gethash file compilation-locs)))
+ (cl-assert (eq fs (gethash (cons (caar fs) (cadr (car fs)))
compilation-locs)))
(maphash (lambda (k v)
(if (eq v fs) (remhash k compilation-locs)))
compilation-locs)))
-(add-to-list 'debug-ignored-errors "\\`No more [-a-z ]+s yet\\'")
-(add-to-list 'debug-ignored-errors "\\`Moved past last .*")
-
;;; Compatibility with the old compile.el.
(defvaralias 'compilation-last-buffer 'next-error-last-buffer)
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 86284eaa30a..e1430b67e99 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1,6 +1,6 @@
;;; cperl-mode.el --- Perl code editing commands for Emacs
-;; Copyright (C) 1985-1987, 1991-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1991-2012 Free Software Foundation, Inc.
;; Author: Ilya Zakharevich
;; Bob Olson
@@ -1838,7 +1838,13 @@ or as help on variables `cperl-tips', `cperl-problems',
(set (make-local-variable 'cperl-syntax-done-to) nil)
(set (make-local-variable 'syntax-propertize-function)
(lambda (start end)
- (goto-char start) (cperl-fontify-syntaxically end))))
+ (goto-char start)
+ ;; Even if cperl-fontify-syntaxically has already gone
+ ;; beyond `start', syntax-propertize has just removed
+ ;; syntax-table properties between start and end, so we have
+ ;; to re-apply them.
+ (setq cperl-syntax-done-to start)
+ (cperl-fontify-syntaxically end))))
(make-local-variable 'parse-sexp-lookup-properties)
;; Do not introduce variable if not needed, we check it!
(set 'parse-sexp-lookup-properties t)
@@ -2322,8 +2328,7 @@ to nil."
nil t)))) ; Only one
(progn
(forward-word 1)
- (setq name (file-name-sans-extension
- (file-name-nondirectory (buffer-file-name)))
+ (setq name (file-name-base)
p (point))
(insert " NAME\n\n" name
" - \n\n=head1 SYNOPSIS\n\n\n\n"
@@ -3498,7 +3503,8 @@ Works before syntax recognition is done."
(if end
;; Do the same for end, going small steps
(save-excursion
- (while (and end (get-text-property end 'syntax-type))
+ (while (and end (< end (point-max))
+ (get-text-property end 'syntax-type))
(setq pos end
end (next-single-property-change end 'syntax-type nil (point-max)))
(if end (progn (goto-char end)
@@ -8951,14 +8957,15 @@ do extra unwind via `cperl-unwind-to-safe'."
(setq cperl-syntax-done-to (min cperl-syntax-done-to beg))))
(defun cperl-update-syntaxification (from to)
- (if (and cperl-use-syntax-table-text-property
- cperl-syntaxify-by-font-lock
- (or (null cperl-syntax-done-to)
- (< cperl-syntax-done-to to)))
- (progn
- (save-excursion
- (goto-char from)
- (cperl-fontify-syntaxically to)))))
+ (cond
+ ((not cperl-use-syntax-table-text-property) nil)
+ ((fboundp 'syntax-propertize) (syntax-propertize to))
+ ((and cperl-syntaxify-by-font-lock
+ (or (null cperl-syntax-done-to)
+ (< cperl-syntax-done-to to)))
+ (save-excursion
+ (goto-char from)
+ (cperl-fontify-syntaxically to)))))
(defvar cperl-version
(let ((v "Revision: 6.2"))
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
index e5bfda54728..1b36fe2800d 100644
--- a/lisp/progmodes/cpp.el
+++ b/lisp/progmodes/cpp.el
@@ -1,6 +1,6 @@
;;; cpp.el --- highlight or hide text according to cpp conditionals
-;; Copyright (C) 1994-1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: c, faces, tools
@@ -52,7 +52,7 @@
:prefix "cpp-")
(defcustom cpp-config-file (convert-standard-filename ".cpp.el")
- "*File name to save cpp configuration."
+ "File name to save cpp configuration."
:type 'file
:group 'cpp)
@@ -61,17 +61,17 @@
:type '(choice (const invisible) (face)))
(defcustom cpp-known-face 'invisible
- "*Face used for known cpp symbols."
+ "Face used for known cpp symbols."
:type 'cpp-face
:group 'cpp)
(defcustom cpp-unknown-face 'highlight
- "*Face used for unknown cpp symbols."
+ "Face used for unknown cpp symbols."
:type 'cpp-face
:group 'cpp)
(defcustom cpp-face-type 'light
- "*Indicate what background face type you prefer.
+ "Indicate what background face type you prefer.
Can be either light or dark for color screens, mono for monochrome
screens, and none if you don't use a window system and don't have
a color-capable display."
@@ -80,12 +80,12 @@ a color-capable display."
:group 'cpp)
(defcustom cpp-known-writable t
- "*Non-nil means you are allowed to modify the known conditionals."
+ "Non-nil means you are allowed to modify the known conditionals."
:type 'boolean
:group 'cpp)
(defcustom cpp-unknown-writable t
- "*Non-nil means you are allowed to modify the unknown conditionals."
+ "Non-nil means you are allowed to modify the unknown conditionals."
:type 'boolean
:group 'cpp)
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index 0516aca8d2b..becbcb7a3de 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -1,6 +1,6 @@
;;; cwarn.el --- highlight suspicious C and C++ constructions
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Anders Lindgren <andersl@andersl.com>
;; Keywords: c, languages, faces
@@ -105,8 +105,6 @@
;;{{{ Dependencies
-(eval-when-compile (require 'cl))
-
(require 'custom)
(require 'font-lock)
(require 'cc-mode)
@@ -117,19 +115,12 @@
(defgroup cwarn nil
"Highlight suspicious C and C++ constructions."
:version "21.1"
- :link '(url-link "http://www.andersl.com/emacs")
:group 'faces)
-(defvar cwarn-mode nil
- "*Non-nil when Cwarn mode is active.
-
-Never set this variable directly, use the command `cwarn-mode'
-instead.")
-
(defcustom cwarn-configuration
'((c-mode (not reference))
(c++-mode t))
- "*List of items each describing which features are enable for a mode.
+ "List of items each describing which features are enable for a mode.
Each item is on the form (mode featurelist), where featurelist can be
on one of three forms:
@@ -158,7 +149,7 @@ keyword list."
:group 'cwarn)
(defcustom cwarn-verbose t
- "*When nil, CWarn mode will not generate any messages.
+ "When nil, CWarn mode will not generate any messages.
Currently, messages are generated when the mode is activated and
deactivated."
@@ -166,7 +157,7 @@ deactivated."
:type 'boolean)
(defcustom cwarn-mode-text " CWarn"
- "*String to display in the mode line when CWarn mode is active.
+ "String to display in the mode line when CWarn mode is active.
\(When the string is not empty, make sure that it has a leading space.)"
:tag "CWarn mode text" ; To separate it from `global-...'
@@ -174,7 +165,7 @@ deactivated."
:type 'string)
(defcustom cwarn-load-hook nil
- "*Functions to run when CWarn mode is first loaded."
+ "Functions to run when CWarn mode is first loaded."
:tag "Load Hook"
:group 'cwarn
:type 'hook)
@@ -192,18 +183,15 @@ Note, in addition to enabling this minor mode, the major mode must
be included in the variable `cwarn-configuration'. By default C and
C++ modes are included.
-With ARG, turn CWarn mode on if and only if arg is positive."
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
:group 'cwarn :lighter cwarn-mode-text
(cwarn-font-lock-keywords cwarn-mode)
(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))
+(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1")
;;}}}
;;{{{ Help functions
@@ -247,29 +235,6 @@ If ADDP is non-nil, install else remove."
nil keywords)))))
;;}}}
-;;{{{ Backward compatibility
-
-;; This piece of code will be part of CC mode as of Emacs 20.4.
-(if (not (fboundp 'c-at-toplevel-p))
-(defun c-at-toplevel-p ()
- "Return a determination as to whether point is at the `top-level'.
-Being at the top-level means that point is either outside any
-enclosing block (such function definition), or inside a class
-definition, but outside any method blocks.
-
-If point is not at the top-level (e.g. it is inside a method
-definition), then nil is returned. Otherwise, if point is at a
-top-level not enclosed within a class definition, t is returned.
-Otherwise, a 2-vector is returned where the zeroth element is the
-buffer position of the start of the class declaration, and the first
-element is the buffer position of the enclosing class' opening
-brace."
- (let ((state (c-parse-state)))
- (or (not (c-most-enclosing-brace state))
- (c-search-uplist-for-classkey state))))
-)
-
-;;}}}
;;{{{ Font-lock keywords and match functions
;; This section contains font-lock keywords. A font lock keyword can
@@ -368,7 +333,7 @@ The semicolon after a `do { ... } while (x);' construction is not matched."
"Turn on CWarn mode in the current buffer if applicable.
The mode is turned if some feature is enabled for the current
`major-mode' in `cwarn-configuration'."
- (if (cwarn-is-enabled major-mode) (turn-on-cwarn-mode)))
+ (when (cwarn-is-enabled major-mode) (cwarn-mode 1)))
;;;###autoload
(define-globalized-minor-mode global-cwarn-mode
diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el
index eeb145e2b1a..af0ae9d1123 100644
--- a/lisp/progmodes/dcl-mode.el
+++ b/lisp/progmodes/dcl-mode.el
@@ -1,6 +1,6 @@
;;; dcl-mode.el --- major mode for editing DCL command files
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Odd Gripenstam <gripenstamol@decus.se>
;; Maintainer: Odd Gripenstam <gripenstamol@decus.se>
@@ -98,7 +98,7 @@ Presently this includes some syntax, .OP.erators, and \"f$\" lexicals.")
:group 'languages)
(defcustom dcl-basic-offset 4
- "*Number of columns to indent a block in DCL.
+ "Number of columns to indent a block in DCL.
A block is the commands between THEN-ELSE-ENDIF and between the commands
dcl-block-begin-regexp and dcl-block-end-regexp.
@@ -109,7 +109,7 @@ dcl-calc-command-indent-function is set to a function."
(defcustom dcl-continuation-offset 6
- "*Number of columns to indent a continuation line in DCL.
+ "Number of columns to indent a continuation line in DCL.
A continuation line is a line that follows a line ending with `-'.
The meaning of this variable may be changed if
@@ -119,7 +119,7 @@ dcl-calc-cont-indent-function is set to a function."
(defcustom dcl-margin-offset 8
- "*Indentation for the first command line in DCL.
+ "Indentation for the first command line in DCL.
The first command line in a file or after a SUBROUTINE statement is indented
this much. Other command lines are indented the same number of columns as
the preceding command line.
@@ -129,7 +129,7 @@ A command line is a line that starts with `$'."
(defcustom dcl-margin-label-offset 2
- "*Number of columns to indent a margin label in DCL.
+ "Number of columns to indent a margin label in DCL.
A margin label is a label that doesn't begin or end a block, i.e. it
doesn't match dcl-block-begin-regexp or dcl-block-end-regexp."
:type 'integer
@@ -137,28 +137,28 @@ doesn't match dcl-block-begin-regexp or dcl-block-end-regexp."
(defcustom dcl-comment-line-regexp "^\\$!"
- "*Regexp describing the start of a comment line in DCL.
+ "Regexp describing the start of a comment line in DCL.
Comment lines are not indented."
:type 'regexp
:group 'dcl)
(defcustom dcl-block-begin-regexp "loop[0-9]*:"
- "*Regexp describing a command that begins an indented block in DCL.
+ "Regexp describing a command that begins an indented block in DCL.
Set to nil to only indent at THEN-ELSE-ENDIF."
:type 'regexp
:group 'dcl)
(defcustom dcl-block-end-regexp "endloop[0-9]*:"
- "*Regexp describing a command that ends an indented block in DCL.
+ "Regexp describing a command that ends an indented block in DCL.
Set to nil to only indent at THEN-ELSE-ENDIF."
:type 'regexp
:group 'dcl)
(defcustom dcl-calc-command-indent-function nil
- "*Function to calculate indentation for a command line in DCL.
+ "Function to calculate indentation for a command line in DCL.
If this variable is non-nil it is called as a function:
\(func INDENT-TYPE CUR-INDENT EXTRA-INDENT LAST-POINT THIS-POINT)
@@ -190,7 +190,7 @@ This package includes two functions suitable for this:
(defcustom dcl-calc-cont-indent-function 'dcl-calc-cont-indent-relative
- "*Function to calculate indentation for a continuation line.
+ "Function to calculate indentation for a continuation line.
If this variable is non-nil it is called as a function:
\(func CUR-INDENT EXTRA-INDENT)
@@ -208,7 +208,7 @@ This package includes one function suitable for this:
(defcustom dcl-tab-always-indent t
- "*Controls the operation of the TAB key in DCL mode.
+ "Controls the operation of the TAB key in DCL mode.
If t, pressing TAB always indents the current line.
If nil, pressing TAB indents the current line if point is at the left margin.
Data lines (i.e. lines not part of a command line or continuation line) are
@@ -218,43 +218,43 @@ never indented."
(defcustom dcl-electric-characters t
- "*Non-nil means reindent immediately when a label, ELSE or ENDIF is inserted."
+ "Non-nil means reindent immediately when a label, ELSE or ENDIF is inserted."
:type 'boolean
:group 'dcl)
(defcustom dcl-tempo-comma ", "
- "*Text to insert when a comma is needed in a template, in DCL mode."
+ "Text to insert when a comma is needed in a template, in DCL mode."
:type 'string
:group 'dcl)
(defcustom dcl-tempo-left-paren "("
- "*Text to insert when a left parenthesis is needed in a template in DCL."
+ "Text to insert when a left parenthesis is needed in a template in DCL."
:type 'string
:group 'dcl)
(defcustom dcl-tempo-right-paren ")"
- "*Text to insert when a right parenthesis is needed in a template in DCL."
+ "Text to insert when a right parenthesis is needed in a template in DCL."
:type 'string
:group 'dcl)
; I couldn't decide what looked best, so I'll let you decide...
; Remember, you can also customize this with imenu-submenu-name-format.
(defcustom dcl-imenu-label-labels "Labels"
- "*Imenu menu title for sub-listing with label names."
+ "Imenu menu title for sub-listing with label names."
:type 'string
:group 'dcl)
(defcustom dcl-imenu-label-goto "GOTO"
- "*Imenu menu title for sub-listing with GOTO statements."
+ "Imenu menu title for sub-listing with GOTO statements."
:type 'string
:group 'dcl)
(defcustom dcl-imenu-label-gosub "GOSUB"
- "*Imenu menu title for sub-listing with GOSUB statements."
+ "Imenu menu title for sub-listing with GOSUB statements."
:type 'string
:group 'dcl)
(defcustom dcl-imenu-label-call "CALL"
- "*Imenu menu title for sub-listing with CALL statements."
+ "Imenu menu title for sub-listing with CALL statements."
:type 'string
:group 'dcl)
@@ -265,7 +265,7 @@ never indented."
(,dcl-imenu-label-goto "\\s-GOTO[ \t]+\\([A-Za-z0-9_\$]+\\)" 1)
(,dcl-imenu-label-gosub "\\s-GOSUB[ \t]+\\([A-Za-z0-9_\$]+\\)" 1)
(,dcl-imenu-label-call "\\s-CALL[ \t]+\\([A-Za-z0-9_\$]+\\)" 1))
- "*Default imenu generic expression for DCL.
+ "Default imenu generic expression for DCL.
The default includes SUBROUTINE labels in the main listing and
sub-listings for other labels, CALL, GOTO and GOSUB statements.
@@ -275,7 +275,7 @@ See `imenu-generic-expression' for details."
(defcustom dcl-mode-hook nil
- "*Hook called by `dcl-mode'."
+ "Hook called by `dcl-mode'."
:type 'hook
:group 'dcl)
@@ -400,7 +400,7 @@ optionally followed by a comment, followed by a newline."
(defcustom dcl-electric-reindent-regexps
(list "endif" "else" dcl-label-r)
- "*Regexps that can trigger an electric reindent.
+ "Regexps that can trigger an electric reindent.
A list of regexps that will trigger a reindent if the last letter
is defined as dcl-electric-character.
diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el
index e513b617022..d533135c70d 100644
--- a/lisp/progmodes/delphi.el
+++ b/lisp/progmodes/delphi.el
@@ -1,6 +1,6 @@
;;; delphi.el --- major mode for editing Delphi source (Object Pascal) in Emacs
-;; Copyright (C) 1998-1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc.
;; Authors: Ray Blaak <blaak@infomatch.com>,
;; Simon South <ssouth@member.fsf.org>
@@ -74,7 +74,7 @@
"True if in debug mode.")
(defcustom delphi-search-path "."
- "*Directories to search when finding external units.
+ "Directories to search when finding external units.
It is a list of directory strings. If only a single directory,
it can be a single string instead of a list. If a directory
ends in \"...\" then that directory is recursively searched."
@@ -82,7 +82,7 @@ ends in \"...\" then that directory is recursively searched."
:group 'delphi)
(defcustom delphi-indent-level 3
- "*Indentation of Delphi statements with respect to containing block.
+ "Indentation of Delphi statements with respect to containing block.
E.g.
begin
@@ -92,7 +92,7 @@ end;"
:group 'delphi)
(defcustom delphi-compound-block-indent 0
- "*Extra indentation for blocks in compound statements. E.g.
+ "Extra indentation for blocks in compound statements. E.g.
// block indent = 0 vs // block indent = 2
if b then if b then
@@ -105,7 +105,7 @@ end; else
:group 'delphi)
(defcustom delphi-case-label-indent delphi-indent-level
- "*Extra indentation for case statement labels. E.g.
+ "Extra indentation for case statement labels. E.g.
// case indent = 0 vs // case indent = 3
case value of case value of
@@ -118,18 +118,18 @@ end; end;"
:group 'delphi)
(defcustom delphi-verbose t ; nil
- "*If true then Delphi token processing progress is reported to the user."
+ "If true then Delphi token processing progress is reported to the user."
:type 'boolean
:group 'delphi)
(defcustom delphi-tab-always-indents t
- "*Non-nil means TAB in Delphi mode should always reindent the current line,
+ "Non-nil means TAB in Delphi mode should always reindent the current line,
regardless of where in the line point is when the TAB command is used."
:type 'boolean
:group 'delphi)
(defcustom delphi-newline-always-indents t
- "*Non-nil means NEWLINE in Delphi mode should always reindent the current
+ "Non-nil means NEWLINE in Delphi mode should always reindent the current
line, insert a blank line and move to the default indent column of the blank
line. If nil, then no indentation occurs, and NEWLINE does the usual
behavior. This is useful when one needs to do customized indentation that
@@ -138,22 +138,22 @@ differs from the default."
:group 'delphi)
(defcustom delphi-comment-face 'font-lock-comment-face
- "*Face used to color Delphi comments."
+ "Face used to color Delphi comments."
:type 'face
:group 'delphi)
(defcustom delphi-string-face 'font-lock-string-face
- "*Face used to color Delphi strings."
+ "Face used to color Delphi strings."
:type 'face
:group 'delphi)
(defcustom delphi-keyword-face 'font-lock-keyword-face
- "*Face used to color Delphi keywords."
+ "Face used to color Delphi keywords."
:type 'face
:group 'delphi)
(defcustom delphi-other-face nil
- "*Face used to color everything else."
+ "Face used to color everything else."
:type '(choice (const :tag "None" nil) face)
:group 'delphi)
diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el
index b45a47f8a3f..009770eff60 100644
--- a/lisp/progmodes/ebnf-abn.el
+++ b/lisp/progmodes/ebnf-abn.el
@@ -1,6 +1,6 @@
;;; ebnf-abn.el --- parser for ABNF (Augmented BNF)
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el
index cb8ebf8aab0..7d549cb9b47 100644
--- a/lisp/progmodes/ebnf-bnf.el
+++ b/lisp/progmodes/ebnf-bnf.el
@@ -1,6 +1,6 @@
;;; ebnf-bnf.el --- parser for EBNF
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el
index 7b63575195e..be1de11add6 100644
--- a/lisp/progmodes/ebnf-dtd.el
+++ b/lisp/progmodes/ebnf-dtd.el
@@ -1,6 +1,6 @@
;;; ebnf-dtd.el --- parser for DTD (Data Type Description for XML)
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el
index 7d697e889b7..ae15e09f4ca 100644
--- a/lisp/progmodes/ebnf-ebx.el
+++ b/lisp/progmodes/ebnf-ebx.el
@@ -1,6 +1,6 @@
;;; ebnf-ebx.el --- parser for EBNF used to specify XML (EBNFX)
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el
index d33167093a3..f8e2520c29c 100644
--- a/lisp/progmodes/ebnf-iso.el
+++ b/lisp/progmodes/ebnf-iso.el
@@ -1,6 +1,6 @@
;;; ebnf-iso.el --- parser for ISO EBNF
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el
index 0392505972d..0aa2948cf19 100644
--- a/lisp/progmodes/ebnf-otz.el
+++ b/lisp/progmodes/ebnf-otz.el
@@ -1,6 +1,6 @@
;;; ebnf-otz.el --- syntactic chart OpTimiZer
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el
index 5ff239bfa21..8e0ca260928 100644
--- a/lisp/progmodes/ebnf-yac.el
+++ b/lisp/progmodes/ebnf-yac.el
@@ -1,6 +1,6 @@
;;; ebnf-yac.el --- parser for Yacc/Bison
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
@@ -73,8 +73,8 @@
;; example: this_is_a_valid.name, Another_EXAMPLE, mIxEd.CaSe.
;;
;;
-;; Acknowledgements
-;; ----------------
+;; Acknowledgments
+;; ---------------
;;
;; Thanks to Matthew K. Junker <junker@alum.mit.edu> for the suggestion to deal
;; with %right, %left and %prec pragmas. His suggestion was extended to deal
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index 240deb39ce3..0f18cffc3de 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -1,6 +1,6 @@
;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
@@ -43,7 +43,7 @@ Please send all bug fixes and enhancements to
;;
;; This package translates an EBNF to a syntactic chart on PostScript.
;;
-;; To use ebnf2ps, insert in your ~/.emacs:
+;; To use ebnf2ps, insert in your init file:
;;
;; (require 'ebnf2ps)
;;
@@ -772,7 +772,7 @@ Please send all bug fixes and enhancements to
;;
;; To set the above options you may:
;;
-;; a) insert the code in your ~/.emacs, like:
+;; a) insert the code in your init file, like:
;;
;; (setq ebnf-terminal-shape 'bevel)
;;
@@ -1128,8 +1128,8 @@ Please send all bug fixes and enhancements to
;; . Optimizations...
;;
;;
-;; Acknowledgements
-;; ----------------
+;; Acknowledgments
+;; ---------------
;;
;; Thanks to Eli Zaretskii <eliz@gnu.org> for some doc fixes.
;;
@@ -1181,10 +1181,10 @@ Elements of ALIST that are not conses are ignored."
;;; Interface to the command system
(defgroup postscript nil
- "PostScript Group."
+ "Printing with PostScript"
:tag "PostScript"
:version "20"
- :group 'emacs)
+ :group 'environment)
(defgroup ebnf2ps nil
@@ -1276,14 +1276,14 @@ Elements of ALIST that are not conses are ignored."
(defcustom ebnf-horizontal-orientation nil
- "*Non-nil means productions are drawn horizontally."
+ "Non-nil means productions are drawn horizontally."
:type 'boolean
:version "20"
:group 'ebnf-displacement)
(defcustom ebnf-horizontal-max-height nil
- "*Non-nil means to use maximum production height in horizontal orientation.
+ "Non-nil means to use maximum production height in horizontal orientation.
It is only used when `ebnf-horizontal-orientation' is non-nil."
:type 'boolean
@@ -1292,7 +1292,7 @@ It is only used when `ebnf-horizontal-orientation' is non-nil."
(defcustom ebnf-production-horizontal-space 0.0 ; use ebnf2ps default value
- "*Specify horizontal space in points between productions.
+ "Specify horizontal space in points between productions.
Value less or equal to zero forces ebnf2ps to set a proper default value."
:type 'number
@@ -1301,7 +1301,7 @@ Value less or equal to zero forces ebnf2ps to set a proper default value."
(defcustom ebnf-production-vertical-space 0.0 ; use ebnf2ps default value
- "*Specify vertical space in points between productions.
+ "Specify vertical space in points between productions.
Value less or equal to zero forces ebnf2ps to set a proper default value."
:type 'number
@@ -1310,7 +1310,7 @@ Value less or equal to zero forces ebnf2ps to set a proper default value."
(defcustom ebnf-justify-sequence 'center
- "*Specify justification of terms in a sequence inside alternatives.
+ "Specify justification of terms in a sequence inside alternatives.
Valid values are:
@@ -1324,14 +1324,14 @@ Valid values are:
(defcustom ebnf-special-show-delimiter t
- "*Non-nil means special delimiter (character `?') is shown."
+ "Non-nil means special delimiter (character `?') is shown."
:type 'boolean
:version "20"
:group 'ebnf-special)
(defcustom ebnf-special-font '(7 Courier "Black" "Gray95" bold italic)
- "*Specify special font.
+ "Specify special font.
See documentation for `ebnf-production-font'."
:type '(list :tag "Special Font"
@@ -1353,7 +1353,7 @@ See documentation for `ebnf-production-font'."
(defcustom ebnf-special-shape 'bevel
- "*Specify special box shape.
+ "Specify special box shape.
See documentation for `ebnf-non-terminal-shape'."
:type '(radio :tag "Special Shape"
@@ -1363,28 +1363,28 @@ See documentation for `ebnf-non-terminal-shape'."
(defcustom ebnf-special-shadow nil
- "*Non-nil means special box will have a shadow."
+ "Non-nil means special box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-special)
(defcustom ebnf-special-border-width 0.5
- "*Specify border width for special box."
+ "Specify border width for special box."
:type 'number
:version "20"
:group 'ebnf-special)
(defcustom ebnf-special-border-color "Black"
- "*Specify border color for special box."
+ "Specify border color for special box."
:type 'string
:version "20"
:group 'ebnf-special)
(defcustom ebnf-except-font '(7 Courier "Black" "Gray90" bold italic)
- "*Specify except font.
+ "Specify except font.
See documentation for `ebnf-production-font'."
:type '(list :tag "Except Font"
@@ -1406,7 +1406,7 @@ See documentation for `ebnf-production-font'."
(defcustom ebnf-except-shape 'bevel
- "*Specify except box shape.
+ "Specify except box shape.
See documentation for `ebnf-non-terminal-shape'."
:type '(radio :tag "Except Shape"
@@ -1416,28 +1416,28 @@ See documentation for `ebnf-non-terminal-shape'."
(defcustom ebnf-except-shadow nil
- "*Non-nil means except box will have a shadow."
+ "Non-nil means except box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-except)
(defcustom ebnf-except-border-width 0.25
- "*Specify border width for except box."
+ "Specify border width for except box."
:type 'number
:version "20"
:group 'ebnf-except)
(defcustom ebnf-except-border-color "Black"
- "*Specify border color for except box."
+ "Specify border color for except box."
:type 'string
:version "20"
:group 'ebnf-except)
(defcustom ebnf-repeat-font '(7 Courier "Black" "Gray85" bold italic)
- "*Specify repeat font.
+ "Specify repeat font.
See documentation for `ebnf-production-font'."
:type '(list :tag "Repeat Font"
@@ -1459,7 +1459,7 @@ See documentation for `ebnf-production-font'."
(defcustom ebnf-repeat-shape 'bevel
- "*Specify repeat box shape.
+ "Specify repeat box shape.
See documentation for `ebnf-non-terminal-shape'."
:type '(radio :tag "Repeat Shape"
@@ -1469,28 +1469,28 @@ See documentation for `ebnf-non-terminal-shape'."
(defcustom ebnf-repeat-shadow nil
- "*Non-nil means repeat box will have a shadow."
+ "Non-nil means repeat box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-repeat)
(defcustom ebnf-repeat-border-width 0.0
- "*Specify border width for repeat box."
+ "Specify border width for repeat box."
:type 'number
:version "20"
:group 'ebnf-repeat)
(defcustom ebnf-repeat-border-color "Black"
- "*Specify border color for repeat box."
+ "Specify border color for repeat box."
:type 'string
:version "20"
:group 'ebnf-repeat)
(defcustom ebnf-terminal-font '(7 Courier "Black" "White")
- "*Specify terminal font.
+ "Specify terminal font.
See documentation for `ebnf-production-font'."
:type '(list :tag "Terminal Font"
@@ -1512,7 +1512,7 @@ See documentation for `ebnf-production-font'."
(defcustom ebnf-terminal-shape 'miter
- "*Specify terminal box shape.
+ "Specify terminal box shape.
See documentation for `ebnf-non-terminal-shape'."
:type '(radio :tag "Terminal Shape"
@@ -1522,35 +1522,35 @@ See documentation for `ebnf-non-terminal-shape'."
(defcustom ebnf-terminal-shadow nil
- "*Non-nil means terminal box will have a shadow."
+ "Non-nil means terminal box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-terminal)
(defcustom ebnf-terminal-border-width 1.0
- "*Specify border width for terminal box."
+ "Specify border width for terminal box."
:type 'number
:version "20"
:group 'ebnf-terminal)
(defcustom ebnf-terminal-border-color "Black"
- "*Specify border color for terminal box."
+ "Specify border color for terminal box."
:type 'string
:version "20"
:group 'ebnf-terminal)
(defcustom ebnf-production-name-p t
- "*Non-nil means production name will be printed."
+ "Non-nil means production name will be printed."
:type 'boolean
:version "20"
:group 'ebnf-production)
(defcustom ebnf-sort-production nil
- "*Specify how productions are sorted.
+ "Specify how productions are sorted.
Valid values are:
@@ -1566,7 +1566,7 @@ Valid values are:
(defcustom ebnf-production-font '(10 Helvetica "Black" "White" bold)
- "*Specify production header font.
+ "Specify production header font.
It is a list with the following form:
@@ -1609,7 +1609,7 @@ See `ps-font-info-database' for valid font name."
(defcustom ebnf-non-terminal-font '(7 Helvetica "Black" "White")
- "*Specify non-terminal font.
+ "Specify non-terminal font.
See documentation for `ebnf-production-font'."
:type '(list :tag "Non-Terminal Font"
@@ -1631,7 +1631,7 @@ See documentation for `ebnf-production-font'."
(defcustom ebnf-non-terminal-shape 'round
- "*Specify non-terminal box shape.
+ "Specify non-terminal box shape.
Valid values are:
@@ -1655,28 +1655,28 @@ Any other value is treated as `miter'."
(defcustom ebnf-non-terminal-shadow nil
- "*Non-nil means non-terminal box will have a shadow."
+ "Non-nil means non-terminal box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-non-terminal)
(defcustom ebnf-non-terminal-border-width 1.0
- "*Specify border width for non-terminal box."
+ "Specify border width for non-terminal box."
:type 'number
:version "20"
:group 'ebnf-non-terminal)
(defcustom ebnf-non-terminal-border-color "Black"
- "*Specify border color for non-terminal box."
+ "Specify border color for non-terminal box."
:type 'string
:version "20"
:group 'ebnf-non-terminal)
(defcustom ebnf-arrow-shape 'hollow
- "*Specify the arrow shape.
+ "Specify the arrow shape.
Valid values are:
@@ -1733,7 +1733,7 @@ Any other value is treated as `none'."
(defcustom ebnf-chart-shape 'round
- "*Specify chart flow shape.
+ "Specify chart flow shape.
See documentation for `ebnf-non-terminal-shape'."
:type '(radio :tag "Chart Flow Shape"
@@ -1743,7 +1743,7 @@ See documentation for `ebnf-non-terminal-shape'."
(defcustom ebnf-user-arrow nil
- "*Specify a sexp for user arrow shape (a PostScript code).
+ "Specify a sexp for user arrow shape (a PostScript code).
When evaluated, the sexp should return nil or a string containing PostScript
code. PostScript code should draw a right arrow.
@@ -1783,7 +1783,7 @@ symbol `user'."
(defcustom ebnf-syntax 'ebnf
- "*Specify syntax to be recognized.
+ "Specify syntax to be recognized.
Valid values are:
@@ -1827,7 +1827,7 @@ Any other value is treated as `ebnf'."
(defcustom ebnf-lex-comment-char ?\;
- "*Specify the line comment character.
+ "Specify the line comment character.
It's used only when `ebnf-syntax' is `ebnf'."
:type 'character
@@ -1836,7 +1836,7 @@ It's used only when `ebnf-syntax' is `ebnf'."
(defcustom ebnf-lex-eop-char ?.
- "*Specify the end of production character.
+ "Specify the end of production character.
It's used only when `ebnf-syntax' is `ebnf'."
:type 'character
@@ -1845,7 +1845,7 @@ It's used only when `ebnf-syntax' is `ebnf'."
(defcustom ebnf-terminal-regexp nil
- "*Specify how it's a terminal name.
+ "Specify how it's a terminal name.
If it's nil, the terminal name must be enclosed by `\"'.
If it's a string, it should be a regexp that it'll be used to determine a
@@ -1859,7 +1859,7 @@ It's used only when `ebnf-syntax' is `ebnf'."
(defcustom ebnf-case-fold-search nil
- "*Non-nil means ignore case on matching.
+ "Non-nil means ignore case on matching.
It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
`ebnf'."
@@ -1869,7 +1869,7 @@ It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
(defcustom ebnf-iso-alternative-p nil
- "*Non-nil means use alternative ISO EBNF.
+ "Non-nil means use alternative ISO EBNF.
It's only used when `ebnf-syntax' is `iso-ebnf'.
@@ -1888,7 +1888,7 @@ This variable affects the following symbol set:
(defcustom ebnf-iso-normalize-p nil
- "*Non-nil means normalize ISO EBNF syntax names.
+ "Non-nil means normalize ISO EBNF syntax names.
Normalize a name means that several contiguous spaces inside name become a
single space, so \"A B C\" is normalized to \"A B C\".
@@ -1900,7 +1900,7 @@ It's only used when `ebnf-syntax' is `iso-ebnf'."
(defcustom ebnf-file-suffix-regexp "\.[Bb][Nn][Ff]$"
- "*Specify file name suffix that contains EBNF.
+ "Specify file name suffix that contains EBNF.
See `ebnf-eps-directory' command."
:type 'regexp
@@ -1909,7 +1909,7 @@ See `ebnf-eps-directory' command."
(defcustom ebnf-eps-prefix "ebnf--"
- "*Specify EPS prefix file name.
+ "Specify EPS prefix file name.
See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
:type 'string
@@ -1918,7 +1918,7 @@ See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
(defcustom ebnf-eps-header-font '(11 Helvetica "Black" "White" bold)
- "*Specify EPS header font.
+ "Specify EPS header font.
See documentation for `ebnf-production-font'.
@@ -1942,7 +1942,7 @@ See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
(defcustom ebnf-eps-header nil
- "*Specify EPS header.
+ "Specify EPS header.
The value should be a string, a symbol or nil.
@@ -1978,7 +1978,7 @@ empty string, no header is generated until a non-empty header is specified or
(defcustom ebnf-eps-footer-font '(7 Helvetica "Black" "White" bold)
- "*Specify EPS footer font.
+ "Specify EPS footer font.
See documentation for `ebnf-production-font'.
@@ -2002,7 +2002,7 @@ See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
(defcustom ebnf-eps-footer nil
- "*Specify EPS footer.
+ "Specify EPS footer.
The value should be a string, a symbol or nil.
@@ -2038,7 +2038,7 @@ empty string, no footer is generated until a non-empty footer is specified or
(defcustom ebnf-entry-percentage 0.5 ; middle
- "*Specify entry height on alternatives.
+ "Specify entry height on alternatives.
It must be a float between 0.0 (top) and 1.0 (bottom)."
:type 'number
@@ -2047,7 +2047,7 @@ It must be a float between 0.0 (top) and 1.0 (bottom)."
(defcustom ebnf-default-width 0.6
- "*Specify additional border width over default terminal, non-terminal or
+ "Specify additional border width over default terminal, non-terminal or
special."
:type 'number
:version "20"
@@ -2057,21 +2057,21 @@ special."
;; Printing color requires x-color-values.
(defcustom ebnf-color-p (or (fboundp 'x-color-values) ; Emacs
(fboundp 'color-instance-rgb-components)) ; XEmacs
- "*Non-nil means use color."
+ "Non-nil means use color."
:type 'boolean
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-line-width 1.0
- "*Specify flow line width."
+ "Specify flow line width."
:type 'number
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-line-color "Black"
- "*Specify flow line color."
+ "Specify flow line color."
:type 'string
:version "20"
:group 'ebnf2ps)
@@ -2081,7 +2081,7 @@ special."
(if (eq ebnf-arrow-shape 'none)
0.0
(* (sqrt 5.0) 0.65 ebnf-line-width))
- "*Specify extra width for arrow shape drawing.
+ "Specify extra width for arrow shape drawing.
The extra width is used to avoid that the arrowhead and the terminal border
overlap. It depends on `ebnf-arrow-shape' and `ebnf-line-width'."
@@ -2091,7 +2091,7 @@ overlap. It depends on `ebnf-arrow-shape' and `ebnf-line-width'."
(defcustom ebnf-arrow-scale 1.0
- "*Specify the arrow scale.
+ "Specify the arrow scale.
Values lower than 1.0, shrink the arrow.
Values greater than 1.0, expand the arrow."
@@ -2101,7 +2101,7 @@ Values greater than 1.0, expand the arrow."
(defcustom ebnf-debug-ps nil
- "*Non-nil means to generate PostScript debug procedures.
+ "Non-nil means to generate PostScript debug procedures.
It is intended to help PostScript programmers in debugging."
:type 'boolean
@@ -2110,7 +2110,7 @@ It is intended to help PostScript programmers in debugging."
(defcustom ebnf-use-float-format t
- "*Non-nil means use `%f' float format.
+ "Non-nil means use `%f' float format.
The advantage of using float format is that ebnf2ps generates a little short
PostScript file.
@@ -2126,14 +2126,14 @@ when executing ebnf2ps, set `ebnf-use-float-format' to nil."
(defcustom ebnf-stop-on-error nil
- "*Non-nil means signal error and stop. Otherwise, signal error and continue."
+ "Non-nil means signal error and stop. Otherwise, signal error and continue."
:type 'boolean
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-yac-ignore-error-recovery nil
- "*Non-nil means ignore error recovery.
+ "Non-nil means ignore error recovery.
It's only used when `ebnf-syntax' is `yacc'."
:type 'boolean
@@ -2142,7 +2142,7 @@ It's only used when `ebnf-syntax' is `yacc'."
(defcustom ebnf-ignore-empty-rule nil
- "*Non-nil means ignore empty rules.
+ "Non-nil means ignore empty rules.
It's interesting to set this variable if your Yacc/Bison grammar has a lot of
middle action rule."
@@ -2152,7 +2152,7 @@ middle action rule."
(defcustom ebnf-optimize nil
- "*Non-nil means optimize syntactic chart of rules.
+ "Non-nil means optimize syntactic chart of rules.
The following optimizations are done:
@@ -2179,7 +2179,7 @@ The above optimizations are specially useful when `ebnf-syntax' is `yacc'."
(defcustom ebnf-log nil
- "*Non-nil means generate log messages.
+ "Non-nil means generate log messages.
The log messages are generated into the buffer *Ebnf2ps Log*.
These messages are intended to help debugging ebnf2ps."
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index dd7a9824af3..8ac54d6524e 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -1,6 +1,6 @@
;;; ebrowse.el --- Emacs C++ class browser & tags facility
-;; Copyright (C) 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Maintainer: FSF
@@ -38,7 +38,7 @@
(require 'ebuff-menu)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'helper))
@@ -48,9 +48,8 @@
"Settings for the C++ class browser."
:group 'tools)
-
(defcustom ebrowse-search-path nil
- "*List of directories to search for source files in a class tree.
+ "List of directories to search for source files in a class tree.
Elements should be directory names; nil as an element means to try
to find source files relative to the location of the BROWSE file loaded."
:group 'ebrowse
@@ -59,25 +58,25 @@ to find source files relative to the location of the BROWSE file loaded."
(defcustom ebrowse-view/find-hook nil
- "*Hooks run after finding or viewing a member or class."
+ "Hooks run after finding or viewing a member or class."
:group 'ebrowse
:type 'hook)
(defcustom ebrowse-not-found-hook nil
- "*Hooks run when finding or viewing a member or class was not successful."
+ "Hooks run when finding or viewing a member or class was not successful."
:group 'ebrowse
:type 'hook)
(defcustom ebrowse-electric-list-mode-hook nil
- "*Hook called by `ebrowse-electric-position-mode'."
+ "Hook called by `ebrowse-electric-position-mode'."
:group 'ebrowse
:type 'hook)
(defcustom ebrowse-max-positions 50
- "*Number of markers saved on electric position stack."
+ "Number of markers saved on electric position stack."
:group 'ebrowse
:type 'integer)
@@ -89,31 +88,31 @@ to find source files relative to the location of the BROWSE file loaded."
(defcustom ebrowse-tree-mode-hook nil
- "*Hook run in each new tree buffer."
+ "Hook run in each new tree buffer."
:group 'ebrowse-tree
:type 'hook)
(defcustom ebrowse-tree-buffer-name "*Tree*"
- "*The default name of class tree buffers."
+ "The default name of class tree buffers."
:group 'ebrowse-tree
:type 'string)
(defcustom ebrowse--indentation 4
- "*The amount by which subclasses are indented in the tree."
+ "The amount by which subclasses are indented in the tree."
:group 'ebrowse-tree
:type 'integer)
(defcustom ebrowse-source-file-column 40
- "*The column in which source file names are displayed in the tree."
+ "The column in which source file names are displayed in the tree."
:group 'ebrowse-tree
:type 'integer)
(defcustom ebrowse-tree-left-margin 2
- "*Amount of space left at the left side of the tree display.
+ "Amount of space left at the left side of the tree display.
This space is used to display markers."
:group 'ebrowse-tree
:type 'integer)
@@ -126,25 +125,25 @@ This space is used to display markers."
(defcustom ebrowse-default-declaration-column 25
- "*The column in which member declarations are displayed in member buffers."
+ "The column in which member declarations are displayed in member buffers."
:group 'ebrowse-member
:type 'integer)
(defcustom ebrowse-default-column-width 25
- "*The width of the columns in member buffers (short display form)."
+ "The width of the columns in member buffers (short display form)."
:group 'ebrowse-member
:type 'integer)
(defcustom ebrowse-member-buffer-name "*Members*"
- "*The name of the buffer for member display."
+ "The name of the buffer for member display."
:group 'ebrowse-member
:type 'string)
(defcustom ebrowse-member-mode-hook nil
- "*Run in each new member buffer."
+ "Run in each new member buffer."
:group 'ebrowse-member
:type 'hook)
@@ -154,61 +153,42 @@ This space is used to display markers."
"Faces used by Ebrowse."
:group 'ebrowse)
-
(defface ebrowse-tree-mark
- '((((min-colors 88)) (:foreground "red1"))
- (t (:foreground "red")))
- "*The face used for the mark character in the tree."
+ '((((min-colors 88)) :foreground "red1")
+ (t :foreground "red"))
+ "Face for the mark character in the Ebrowse tree."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-tree-mark-face 'ebrowse-tree-mark "22.1")
-
(defface ebrowse-root-class
- '((((min-colors 88)) (:weight bold :foreground "blue1"))
- (t (:weight bold :foreground "blue")))
- "*The face used for root classes in the tree."
+ '((((min-colors 88)) :weight bold :foreground "blue1")
+ (t :weight bold :foreground "blue"))
+ "Face for root classes in the Ebrowse tree."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-root-class-face 'ebrowse-root-class "22.1")
-
-(defface ebrowse-file-name
- '((t (:italic t)))
- "*The face for filenames displayed in the tree."
+(defface ebrowse-file-name '((t :slant italic))
+ "Face for filenames in the Ebrowse tree."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-file-name-face 'ebrowse-file-name "22.1")
-
-(defface ebrowse-default
- '((t nil))
- "*Face for everything else in the tree not having other faces."
+(defface ebrowse-default '((t))
+ "Face for items in the Ebrowse tree which do not have other faces."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-default-face 'ebrowse-default "22.1")
-
(defface ebrowse-member-attribute
- '((((min-colors 88)) (:foreground "red1"))
- (t (:foreground "red")))
- "*Face used to display member attributes."
+ '((((min-colors 88)) :foreground "red1")
+ (t :foreground "red"))
+ "Face for member attributes."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-member-attribute-face
- 'ebrowse-member-attribute "22.1")
-
(defface ebrowse-member-class
- '((t (:foreground "purple")))
- "*Face used to display the class title in member buffers."
+ '((t :foreground "purple"))
+ "Face used to display the class title in member buffers."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-member-class-face
- 'ebrowse-member-class "22.1")
-
(defface ebrowse-progress
- '((((min-colors 88)) (:background "blue1"))
- (t (:background "blue")))
- "*Face for progress indicator."
+ '((((min-colors 88)) :background "blue1")
+ (t :background "blue"))
+ "Face for progress indicator."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-progress-face 'ebrowse-progress "22.1")
-
;;; Utilities.
@@ -269,6 +249,7 @@ This is a destructive operation."
(defmacro ebrowse-output (&rest body)
"Eval BODY with a writable current buffer.
Preserve buffer's modified state."
+ (declare (indent 0) (debug t))
(let ((modified (make-symbol "--ebrowse-output--")))
`(let (buffer-read-only (,modified (buffer-modified-p)))
(unwind-protect
@@ -278,35 +259,30 @@ Preserve buffer's modified state."
(defmacro ebrowse-ignoring-completion-case (&rest body)
"Eval BODY with `completion-ignore-case' bound to t."
+ (declare (indent 0) (debug t))
`(let ((completion-ignore-case t))
,@body))
-
(defmacro ebrowse-save-selective (&rest body)
"Eval BODY with `selective-display' restored at the end."
- (let ((var (make-symbol "var")))
- `(let ((,var selective-display))
- (unwind-protect
- (progn ,@body)
- (setq selective-display ,var)))))
-
+ (declare (indent 0) (debug t))
+ ;; FIXME: Don't use selective-display.
+ `(let ((selective-display selective-display))
+ ,@body))
(defmacro ebrowse-for-all-trees (spec &rest body)
"For all trees in SPEC, eval BODY."
+ (declare (indent 1) (debug ((sexp form) body)))
(let ((var (make-symbol "var"))
(spec-var (car spec))
(array (cadr spec)))
- `(loop for ,var being the symbols of ,array
- as ,spec-var = (get ,var 'ebrowse-root) do
- (when (vectorp ,spec-var)
- ,@body))))
+ `(cl-loop for ,var being the symbols of ,array
+ as ,spec-var = (get ,var 'ebrowse-root) do
+ (when (vectorp ,spec-var)
+ ,@body))))
;;; Set indentation for macros above.
-(put 'ebrowse-output 'lisp-indent-hook 0)
-(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
-(put 'ebrowse-save-selective 'lisp-indent-hook 0)
-(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
(defsubst ebrowse-set-face (start end face)
@@ -327,17 +303,6 @@ is STRING, but point is placed POSITION characters into the string."
(ebrowse-ignoring-completion-case
(completing-read prompt table nil t initial-input)))
-
-(defun ebrowse-value-in-buffer (sym buffer)
- "Return the value of SYM in BUFFER."
- (let ((old-buffer (current-buffer)))
- (unwind-protect
- (progn
- (set-buffer buffer)
- (symbol-value sym))
- (set-buffer old-buffer))))
-
-
(defun ebrowse-rename-buffer (new-name)
"Rename current buffer to NEW-NAME.
If a buffer with name NEW-NAME already exists, delete it first."
@@ -353,9 +318,9 @@ If a buffer with name NEW-NAME already exists, delete it first."
Replace sequences of newlines with a single space."
(when (string-match "^[ \t\n\r]+" string)
(setq string (substring string (match-end 0))))
- (loop while (string-match "[\n]+" string)
- finally return string do
- (setq string (replace-match " " nil t string))))
+ (cl-loop while (string-match "[\n]+" string)
+ finally return string do
+ (setq string (replace-match " " nil t string))))
(defun ebrowse-width-of-drawable-area ()
@@ -370,7 +335,7 @@ otherwise use the current frame's width."
;;; Structure definitions
-(defstruct (ebrowse-hs (:type vector) :named)
+(cl-defstruct (ebrowse-hs (:type vector) :named)
"Header structure found at the head of BROWSE files."
;; A version string that is compared against the version number of
;; the Lisp package when the file is loaded. This is done to
@@ -387,7 +352,7 @@ otherwise use the current frame's width."
member-table)
-(defstruct (ebrowse-ts (:type vector) :named)
+(cl-defstruct (ebrowse-ts (:type vector) :named)
"Tree structure.
Following the header structure, a BROWSE file contains a number
of `ebrowse-ts' structures, each one describing one root class of
@@ -407,7 +372,7 @@ the class hierarchy with all its subclasses."
mark)
-(defstruct (ebrowse-bs (:type vector) :named)
+(cl-defstruct (ebrowse-bs (:type vector) :named)
"Common sub-structure.
A common structure defining an occurrence of some name in the
source files."
@@ -434,14 +399,14 @@ source files."
point)
-(defstruct (ebrowse-cs (:include ebrowse-bs) (:type vector) :named)
+(cl-defstruct (ebrowse-cs (:include ebrowse-bs) (:type vector) :named)
"Class structure.
This is the structure stored in the CLASS slot of a `ebrowse-ts'
structure. It describes the location of the class declaration."
source-file)
-(defstruct (ebrowse-ms (:include ebrowse-bs) (:type vector) :named)
+(cl-defstruct (ebrowse-ms (:include ebrowse-bs) (:type vector) :named)
"Member structure.
This is the structure describing a single member. The `ebrowse-ts'
structure contains various lists for the different types of
@@ -711,7 +676,7 @@ MARKED-ONLY non-nil means include marked classes only."
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
(when (or (not marked-only) (ebrowse-ts-mark tree))
(let ((class (ebrowse-ts-class tree)))
- (when (zerop (% (incf i) 20))
+ (when (zerop (% (cl-incf i) 20))
(ebrowse-show-progress "Preparing file list" (zerop i)))
;; Add files mentioned in class description
(let ((source-file (ebrowse-cs-source-file class))
@@ -721,14 +686,14 @@ MARKED-ONLY non-nil means include marked classes only."
(when file
(puthash file file files))
;; For all member lists in this class
- (loop for accessor in ebrowse-member-list-accessors do
- (loop for m in (funcall accessor tree)
- for file = (ebrowse-ms-file m)
- for def-file = (ebrowse-ms-definition-file m) do
- (when file
- (puthash file file files))
- (when def-file
- (puthash def-file def-file files))))))))
+ (dolist (accessor ebrowse-member-list-accessors)
+ (cl-loop for m in (funcall accessor tree)
+ for file = (ebrowse-ms-file m)
+ for def-file = (ebrowse-ms-definition-file m) do
+ (when file
+ (puthash file file files))
+ (when def-file
+ (puthash def-file def-file files))))))))
files))
@@ -741,11 +706,11 @@ MARKED-ONLY non-nil means include marked classes only."
list))
-(defun* ebrowse-marked-classes-p ()
+(cl-defun ebrowse-marked-classes-p ()
"Value is non-nil if any class in the current class tree is marked."
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
(when (ebrowse-ts-mark tree)
- (return-from ebrowse-marked-classes-p tree))))
+ (cl-return-from ebrowse-marked-classes-p tree))))
(defsubst ebrowse-globals-tree-p (tree)
@@ -772,12 +737,13 @@ The class tree is found in the buffer-local variable `ebrowse--tree-obarray'."
(if qualified-names-p
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
(setq alist
- (acons (ebrowse-qualified-class-name (ebrowse-ts-class tree))
- tree alist)))
+ (cl-acons (ebrowse-qualified-class-name
+ (ebrowse-ts-class tree))
+ tree alist)))
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
(setq alist
- (acons (ebrowse-cs-name (ebrowse-ts-class tree))
- tree alist))))
+ (cl-acons (ebrowse-cs-name (ebrowse-ts-class tree))
+ tree alist))))
alist))
@@ -812,15 +778,15 @@ This function must be used instead of the struct slot
computes this information lazily."
(or (ebrowse-ts-base-classes tree)
(setf (ebrowse-ts-base-classes tree)
- (loop with to-search = (list tree)
- with result = nil
- as search = (pop to-search)
- while search finally return result
- do (ebrowse-for-all-trees (ti ebrowse--tree-obarray)
- (when (memq search (ebrowse-ts-subclasses ti))
- (unless (memq ti result)
- (setq result (nconc result (list ti))))
- (push ti to-search)))))))
+ (cl-loop with to-search = (list tree)
+ with result = nil
+ as search = (pop to-search)
+ while search finally return result
+ do (ebrowse-for-all-trees (ti ebrowse--tree-obarray)
+ (when (memq search (ebrowse-ts-subclasses ti))
+ (unless (memq ti result)
+ (setq result (nconc result (list ti))))
+ (push ti to-search)))))))
(defun ebrowse-direct-base-classes (tree)
@@ -840,8 +806,8 @@ computes this information lazily."
ACCESSOR is the accessor function for the member list.
Elements of the result have the form (NAME . ACCESSOR), where NAME
is the member name."
- (loop for member in (funcall accessor tree)
- collect (cons (ebrowse-ms-name member) accessor)))
+ (cl-loop for member in (funcall accessor tree)
+ collect (cons (ebrowse-ms-name member) accessor)))
(defun ebrowse-name/accessor-alist-for-visible-members ()
@@ -854,10 +820,10 @@ structure. The list includes inherited members if these are visible."
ebrowse--accessor)))
(if ebrowse--show-inherited-flag
(nconc list
- (loop for tree in (ebrowse-base-classes
- ebrowse--displayed-class)
- nconc (ebrowse-name/accessor-alist
- tree ebrowse--accessor)))
+ (cl-loop for tree in (ebrowse-base-classes
+ ebrowse--displayed-class)
+ nconc (ebrowse-name/accessor-alist
+ tree ebrowse--accessor)))
list)))
@@ -928,8 +894,7 @@ and TREE is a list of `ebrowse-ts' structures forming the class tree."
See that variable's documentation for the meaning of IGNORE-AUTO-SAVE and
NOCONFIRM."
(when (or noconfirm (yes-or-no-p "Revert tree from disk? "))
- (loop for member-buffer in (ebrowse-same-tree-member-buffer-list)
- do (kill-buffer member-buffer))
+ (mapc #'kill-buffer (ebrowse-same-tree-member-buffer-list))
(erase-buffer)
(with-no-warnings
(insert-file (or buffer-file-name ebrowse--tags-file-name)))
@@ -954,9 +919,9 @@ Return the buffer created."
ebrowse--frozen-flag nil)
(ebrowse-redraw-tree)
(set-buffer-modified-p nil)
- (case pop
- (switch (switch-to-buffer name))
- (pop (pop-to-buffer name)))
+ (pcase pop
+ (`switch (switch-to-buffer name))
+ (`pop (pop-to-buffer name)))
(current-buffer)))
@@ -982,14 +947,14 @@ type `ebrowse-hs' is set to the resulting obarray."
(garbage-collect)
;; For all classes...
(ebrowse-for-all-trees (c ebrowse--tree-obarray)
- (when (zerop (% (incf i) 10))
+ (when (zerop (% (cl-incf i) 10))
(ebrowse-show-progress "Preparing member lookup" (zerop i)))
- (loop for f in ebrowse-member-list-accessors do
- (loop for m in (funcall f c) do
- (let* ((member-name (ebrowse-ms-name m))
- (value (gethash member-name members)))
- (push (list c f m) value)
- (puthash member-name value members)))))
+ (dolist (f ebrowse-member-list-accessors)
+ (dolist (m (funcall f c))
+ (let* ((member-name (ebrowse-ms-name m))
+ (value (gethash member-name members)))
+ (push (list c f m) value)
+ (puthash member-name value members)))))
(setf (ebrowse-hs-member-table ebrowse--header) members)))
@@ -997,11 +962,11 @@ type `ebrowse-hs' is set to the resulting obarray."
"Return the member obarray. Build it if it hasn't been set up yet.
HEADER is the tree header structure of the class tree."
(when (null (ebrowse-hs-member-table header))
- (loop for buffer in (ebrowse-browser-buffer-list)
- until (eq header (ebrowse-value-in-buffer 'ebrowse--header buffer))
- finally do
- (with-current-buffer buffer
- (ebrowse-fill-member-table))))
+ (cl-loop for buffer in (ebrowse-browser-buffer-list)
+ until (eq header (buffer-local-value 'ebrowse--header buffer))
+ finally do
+ (with-current-buffer buffer
+ (ebrowse-fill-member-table))))
(ebrowse-hs-member-table header))
@@ -1013,11 +978,12 @@ HEADER is the tree header structure of the class tree."
Build obarray of all classes in TREE."
(let ((classes (make-vector 127 0)))
;; Add root classes...
- (loop for root in tree
- as sym =
- (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) classes)
- do (unless (get sym 'ebrowse-root)
- (setf (get sym 'ebrowse-root) root)))
+ (cl-loop for root in tree
+ as sym =
+ (intern (ebrowse-qualified-class-name (ebrowse-ts-class root))
+ classes)
+ do (unless (get sym 'ebrowse-root)
+ (setf (get sym 'ebrowse-root) root)))
;; Process subclasses
(ebrowse-insert-supers tree classes)
classes))
@@ -1035,29 +1001,30 @@ beginning of the base-class list.
We have to be cautious here not to end up in an infinite recursion
if for some reason a circle is in the inheritance graph."
- (loop for class in tree
- as subclasses = (ebrowse-ts-subclasses class) do
- ;; Make sure every class is represented by a unique object
- (loop for subclass on subclasses
- as sym = (intern
- (ebrowse-qualified-class-name (ebrowse-ts-class (car subclass)))
- classes)
- as next = nil
- do
- ;; Replace the subclass tree with the one found in
- ;; CLASSES if there is already an entry for that class
- ;; in it. Otherwise make a new entry.
- ;;
- ;; CAVEAT: If by some means (e.g., use of the
- ;; preprocessor in class declarations, a name is marked
- ;; as a subclass of itself on some path, we would end up
- ;; in an endless loop. We have to omit subclasses from
- ;; the recursion that already have been processed.
- (if (get sym 'ebrowse-root)
- (setf (car subclass) (get sym 'ebrowse-root))
- (setf (get sym 'ebrowse-root) (car subclass))))
- ;; Process subclasses
- (ebrowse-insert-supers subclasses classes)))
+ (cl-loop for class in tree
+ as subclasses = (ebrowse-ts-subclasses class) do
+ ;; Make sure every class is represented by a unique object
+ (cl-loop for subclass on subclasses
+ as sym = (intern
+ (ebrowse-qualified-class-name
+ (ebrowse-ts-class (car subclass)))
+ classes)
+ as next = nil
+ do
+ ;; Replace the subclass tree with the one found in
+ ;; CLASSES if there is already an entry for that class
+ ;; in it. Otherwise make a new entry.
+ ;;
+ ;; CAVEAT: If by some means (e.g., use of the
+ ;; preprocessor in class declarations, a name is marked
+ ;; as a subclass of itself on some path, we would end up
+ ;; in an endless loop. We have to omit subclasses from
+ ;; the recursion that already have been processed.
+ (if (get sym 'ebrowse-root)
+ (setf (car subclass) (get sym 'ebrowse-root))
+ (setf (get sym 'ebrowse-root) (car subclass))))
+ ;; Process subclasses
+ (ebrowse-insert-supers subclasses classes)))
;;; Tree buffers
@@ -1131,7 +1098,7 @@ Tree mode key bindings:
(unless (zerop (buffer-size))
(goto-char (point-min))
- (multiple-value-setq (header tree) (values-list (ebrowse-read)))
+ (cl-multiple-value-setq (header tree) (cl-values-list (ebrowse-read)))
(message "Sorting. Please be patient...")
(setq tree (ebrowse-sort-tree-list tree))
(erase-buffer)
@@ -1219,32 +1186,32 @@ If given a numeric N-TIMES argument, mark that many classes."
;; Get the classes whose mark must be toggled. Note that
;; ebrowse-tree-at-point might issue an error.
(ignore-errors
- (loop repeat (or n-times 1)
- as tree = (ebrowse-tree-at-point)
- do (progn
- (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree)))
- (forward-line 1)
- (push tree to-change))))
+ (cl-loop repeat (or n-times 1)
+ as tree = (ebrowse-tree-at-point)
+ do (progn
+ (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree)))
+ (forward-line 1)
+ (push tree to-change))))
(save-excursion
;; For all these classes, reverse the mark char in the display
;; by a regexp replace over the whole buffer. The reason for this
;; is that classes might have multiple base classes. If this is
;; the case, they are displayed more than once in the tree.
(ebrowse-output
- (loop for tree in to-change
- as regexp = (concat "^.*\\b"
- (regexp-quote
- (ebrowse-cs-name (ebrowse-ts-class tree)))
- "\\b")
- do
- (goto-char (point-min))
- (loop while (re-search-forward regexp nil t)
- do (progn
- (goto-char (match-beginning 0))
- (delete-char 1)
- (insert-char (if (ebrowse-ts-mark tree) ?> ? ) 1)
- (ebrowse-set-mark-props (1- (point)) (point) tree)
- (goto-char (match-end 0)))))))))
+ (cl-loop
+ for tree in to-change
+ as regexp = (concat "^.*\\b"
+ (regexp-quote
+ (ebrowse-cs-name (ebrowse-ts-class tree)))
+ "\\b")
+ do
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (goto-char (match-beginning 0))
+ (delete-char 1)
+ (insert-char (if (ebrowse-ts-mark tree) ?> ? ) 1)
+ (ebrowse-set-mark-props (1- (point)) (point) tree)
+ (goto-char (match-end 0))))))))
(defun ebrowse-mark-all-classes (prefix)
@@ -1365,7 +1332,7 @@ one buffer. Prefer tree buffers over member buffers."
(set (make-hash-table))
result)
(dolist (buffer buffers)
- (let ((tree (ebrowse-value-in-buffer 'ebrowse--tree buffer)))
+ (let ((tree (buffer-local-value 'ebrowse--tree buffer)))
(unless (gethash tree set)
(push buffer result))
(puthash tree t set)))
@@ -1376,7 +1343,7 @@ one buffer. Prefer tree buffers over member buffers."
"Return a list of members buffers with same tree as current buffer."
(ebrowse-delete-if-not
(lambda (buffer)
- (eq (ebrowse-value-in-buffer 'ebrowse--tree buffer)
+ (eq (buffer-local-value 'ebrowse--tree buffer)
ebrowse--tree))
(ebrowse-member-buffer-list)))
@@ -1387,7 +1354,7 @@ one buffer. Prefer tree buffers over member buffers."
Switch to buffer if prefix ARG.
If no member buffer exists, make one."
(interactive "P")
- (let ((buf (or (first (ebrowse-same-tree-member-buffer-list))
+ (let ((buf (or (cl-first (ebrowse-same-tree-member-buffer-list))
(get-buffer ebrowse-member-buffer-name)
(ebrowse-tree-command:show-member-functions))))
(when buf
@@ -1411,9 +1378,9 @@ If no member buffer exists, make one."
(defun ebrowse-kill-member-buffers-displaying (tree)
"Kill all member buffers displaying TREE."
- (loop for buffer in (ebrowse-member-buffer-list)
- as class = (ebrowse-value-in-buffer 'ebrowse--displayed-class buffer)
- when (eq class tree) do (kill-buffer buffer)))
+ (cl-loop for buffer in (ebrowse-member-buffer-list)
+ as class = (buffer-local-value 'ebrowse--displayed-class buffer)
+ when (eq class tree) do (kill-buffer buffer)))
(defun ebrowse-frozen-tree-buffer-name (tags-file)
@@ -1449,7 +1416,7 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise."
(int-to-string ebrowse--indentation)
"): ")
nil nil ebrowse--indentation))))
- (when (plusp width)
+ (when (cl-plusp width)
(set (make-local-variable 'ebrowse--indentation) width)
(ebrowse-redraw-tree))))
@@ -1524,7 +1491,7 @@ Read a class name from the minibuffer if CLASS is nil."
(error "Not on a class")))
-(defun* ebrowse-view/find-class-declaration (&key view where)
+(cl-defun ebrowse-view/find-class-declaration (&key view where)
"View or find the declarator of the class point is on.
VIEW non-nil means view it. WHERE is additional position info."
(let* ((class (ebrowse-ts-class (ebrowse-tree-at-point)))
@@ -1603,9 +1570,9 @@ and possibly kill the viewed buffer."
exit-action ebrowse--view-exit-action))
;; Delete the frame in which we viewed.
(mapc 'delete-frame
- (loop for frame in (frame-list)
- when (not (assq frame original-frame-configuration))
- collect frame))
+ (cl-loop for frame in (frame-list)
+ when (not (assq frame original-frame-configuration))
+ collect frame))
(when exit-action
(funcall exit-action buffer))))
@@ -1659,15 +1626,15 @@ specifies where to find/view the result."
(unless (boundp 'view-mode-hook)
(setq view-mode-hook nil))
(push 'ebrowse-find-pattern view-mode-hook)
- (case where
- (other-window (view-file-other-window file))
- (other-frame (ebrowse-view-file-other-frame file))
- (t (view-file file))))
+ (pcase where
+ (`other-window (view-file-other-window file))
+ (`other-frame (ebrowse-view-file-other-frame file))
+ (_ (view-file file))))
(t
- (case where
- (other-window (find-file-other-window file))
- (other-frame (find-file-other-frame file))
- (t (find-file file)))
+ (pcase where
+ (`other-window (find-file-other-window file))
+ (`other-frame (find-file-other-frame file))
+ (_ (find-file file)))
(ebrowse-find-pattern struc info))))
@@ -1677,14 +1644,14 @@ This is `regexp-quote' for most symbols, except for operator names
which may contain whitespace. For these symbols, replace white
space in the symbol name (generated by BROWSE) with a regular
expression matching any number of whitespace characters."
- (loop with regexp = (regexp-quote name)
- with start = 0
- finally return regexp
- while (string-match "[ \t]+" regexp start)
- do (setq regexp (concat (substring regexp 0 (match-beginning 0))
- "[ \t]*"
- (substring regexp (match-end 0)))
- start (+ (match-beginning 0) 5))))
+ (cl-loop with regexp = (regexp-quote name)
+ with start = 0
+ finally return regexp
+ while (string-match "[ \t]+" regexp start)
+ do (setq regexp (concat (substring regexp 0 (match-beginning 0))
+ "[ \t]*"
+ (substring regexp (match-end 0)))
+ start (+ (match-beginning 0) 5))))
(defun ebrowse-class-declaration-regexp (name)
@@ -1712,7 +1679,7 @@ expression matching any number of whitespace characters."
(concat "^[ \t]*#[ \t]*define[ \t]+" (regexp-quote name)))
-(defun* ebrowse-find-pattern (&optional position info &aux viewing)
+(cl-defun ebrowse-find-pattern (&optional position info &aux viewing)
"Find a pattern.
This is a kluge: Ebrowse allows you to find or view a file containing
@@ -1731,25 +1698,26 @@ INFO is a list (TREE-HEADER TREE-OR-MEMBER MEMBER-LIST)."
(start (ebrowse-bs-point position))
(offset 100)
found)
- (destructuring-bind (header class-or-member member-list) info
+ (pcase-let ((`(,header ,class-or-member ,member-list) info))
;; If no pattern is specified, construct one from the member name.
(when (stringp pattern)
(setq pattern (concat "^.*" (regexp-quote pattern))))
;; Construct a regular expression if none given.
(unless pattern
- (typecase class-or-member
+ (cl-typecase class-or-member
(ebrowse-ms
- (case member-list
- ((ebrowse-ts-member-variables
- ebrowse-ts-static-variables
- ebrowse-ts-types)
- (setf pattern (ebrowse-variable-declaration-regexp
- (ebrowse-bs-name position))))
- (otherwise
- (if (ebrowse-define-p class-or-member)
- (setf pattern (ebrowse-pp-define-regexp (ebrowse-bs-name position)))
- (setf pattern (ebrowse-function-declaration/definition-regexp
- (ebrowse-bs-name position)))))))
+ (setf pattern
+ (pcase member-list
+ ((or `ebrowse-ts-member-variables
+ `ebrowse-ts-static-variables
+ `ebrowse-ts-types)
+ (ebrowse-variable-declaration-regexp
+ (ebrowse-bs-name position)))
+ (_
+ (if (ebrowse-define-p class-or-member)
+ (ebrowse-pp-define-regexp (ebrowse-bs-name position))
+ (ebrowse-function-declaration/definition-regexp
+ (ebrowse-bs-name position)))))))
(ebrowse-cs
(setf pattern (ebrowse-class-declaration-regexp
(ebrowse-bs-name position))))))
@@ -1763,10 +1731,11 @@ INFO is a list (TREE-HEADER TREE-OR-MEMBER MEMBER-LIST)."
(y-or-n-p (format "start = %d? " start))
(y-or-n-p pattern))
(setf found
- (loop do (goto-char (max (point-min) (- start offset)))
- when (re-search-forward pattern (+ start offset) t) return t
- never (bobp)
- do (incf offset offset)))
+ (cl-loop do (goto-char (max (point-min) (- start offset)))
+ when (re-search-forward pattern (+ start offset) t)
+ return t
+ never (bobp)
+ do (cl-incf offset offset)))
(cond (found
(beginning-of-line)
(run-hooks 'ebrowse-view/find-hook))
@@ -1810,57 +1779,57 @@ TREE denotes the class shown."
(ebrowse-set-face start end 'ebrowse-tree-mark))
-(defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start)
+(cl-defun ebrowse-draw-tree-fn (&aux stack1 stack2 start)
"Display a single class and recursively its subclasses.
This function may look weird, but this is faster than recursion."
(setq stack1 (make-list (length ebrowse--tree) 0)
stack2 (copy-sequence ebrowse--tree))
- (loop while stack2
- as level = (pop stack1)
- as tree = (pop stack2)
- as class = (ebrowse-ts-class tree) do
- (let ((start-of-line (point))
- start-of-class-name end-of-class-name)
- ;; Insert mark
- (insert (if (ebrowse-ts-mark tree) ">" " "))
-
- ;; Indent and insert class name
- (indent-to (+ (* level ebrowse--indentation)
- ebrowse-tree-left-margin))
- (setq start (point))
- (insert (ebrowse-qualified-class-name class))
-
- ;; If template class, add <>
- (when (ebrowse-template-p class)
- (insert "<>"))
- (ebrowse-set-face start (point) (if (zerop level)
- 'ebrowse-root-class
- 'ebrowse-default))
- (setf start-of-class-name start
- end-of-class-name (point))
- ;; If filenames are to be displayed...
- (when ebrowse--show-file-names-flag
- (indent-to ebrowse-source-file-column)
- (setq start (point))
- (insert "("
- (or (ebrowse-cs-file class)
- "unknown")
- ")")
- (ebrowse-set-face start (point) 'ebrowse-file-name))
- (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree)
- (add-text-properties
- start-of-class-name end-of-class-name
- `(mouse-face highlight ebrowse-what class-name
- ebrowse-tree ,tree
- help-echo "double-mouse-1: (un)expand tree; mouse-2: member functions, mouse-3: menu"))
- (insert "\n"))
- ;; Push subclasses, if any.
- (when (ebrowse-ts-subclasses tree)
- (setq stack2
- (nconc (copy-sequence (ebrowse-ts-subclasses tree)) stack2)
- stack1
- (nconc (make-list (length (ebrowse-ts-subclasses tree))
- (1+ level)) stack1)))))
+ (cl-loop while stack2
+ as level = (pop stack1)
+ as tree = (pop stack2)
+ as class = (ebrowse-ts-class tree) do
+ (let ((start-of-line (point))
+ start-of-class-name end-of-class-name)
+ ;; Insert mark
+ (insert (if (ebrowse-ts-mark tree) ">" " "))
+
+ ;; Indent and insert class name
+ (indent-to (+ (* level ebrowse--indentation)
+ ebrowse-tree-left-margin))
+ (setq start (point))
+ (insert (ebrowse-qualified-class-name class))
+
+ ;; If template class, add <>
+ (when (ebrowse-template-p class)
+ (insert "<>"))
+ (ebrowse-set-face start (point) (if (zerop level)
+ 'ebrowse-root-class
+ 'ebrowse-default))
+ (setf start-of-class-name start
+ end-of-class-name (point))
+ ;; If filenames are to be displayed...
+ (when ebrowse--show-file-names-flag
+ (indent-to ebrowse-source-file-column)
+ (setq start (point))
+ (insert "("
+ (or (ebrowse-cs-file class)
+ "unknown")
+ ")")
+ (ebrowse-set-face start (point) 'ebrowse-file-name))
+ (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree)
+ (add-text-properties
+ start-of-class-name end-of-class-name
+ `(mouse-face highlight ebrowse-what class-name
+ ebrowse-tree ,tree
+ help-echo "double-mouse-1: (un)expand tree; mouse-2: member functions, mouse-3: menu"))
+ (insert "\n"))
+ ;; Push subclasses, if any.
+ (when (ebrowse-ts-subclasses tree)
+ (setq stack2
+ (nconc (copy-sequence (ebrowse-ts-subclasses tree)) stack2)
+ stack1
+ (nconc (make-list (length (ebrowse-ts-subclasses tree))
+ (1+ level)) stack1)))))
@@ -2116,8 +2085,8 @@ See 'Electric-command-loop' for a description of STATE and CONDITION."
"Read a browser buffer name from the minibuffer and return that buffer."
(let* ((buffers (ebrowse-known-class-trees-buffer-list)))
(if buffers
- (if (not (second buffers))
- (first buffers)
+ (if (not (cl-second buffers))
+ (cl-first buffers)
(or (ebrowse-electric-choose-tree) (error "No tree buffer")))
(let* ((insert-default-directory t)
(file (read-file-name "Find tree: " nil nil t)))
@@ -2303,7 +2272,7 @@ The new width is read from the minibuffer."
ebrowse--decl-column
ebrowse--column-width))
"): ")))))
- (when (plusp width)
+ (when (cl-plusp width)
(if ebrowse--long-display-flag
(setq ebrowse--decl-column width)
(setq ebrowse--column-width width))
@@ -2343,15 +2312,15 @@ make one."
(let ((index (ebrowse-position ebrowse--accessor
ebrowse-member-list-accessors)))
(setf ebrowse--accessor
- (cond ((plusp incr)
+ (cond ((cl-plusp incr)
(or (nth (1+ index)
ebrowse-member-list-accessors)
- (first ebrowse-member-list-accessors)))
- ((minusp incr)
- (or (and (>= (decf index) 0)
+ (cl-first ebrowse-member-list-accessors)))
+ ((cl-minusp incr)
+ (or (and (>= (cl-decf index) 0)
(nth index
ebrowse-member-list-accessors))
- (first (last ebrowse-member-list-accessors))))))
+ (cl-first (last ebrowse-member-list-accessors))))))
(ebrowse-display-member-list-for-accessor ebrowse--accessor)))
@@ -2536,7 +2505,7 @@ find file in another frame."
(ebrowse-view/find-member-declaration/definition prefix t))
-(defun* ebrowse-view/find-member-declaration/definition
+(cl-defun ebrowse-view/find-member-declaration/definition
(prefix view &optional definition info header tags-file)
"Find or view a member declaration or definition.
With PREFIX 4. find file in another window, with prefix 5
@@ -2556,15 +2525,15 @@ TAGS-FILE is the file name of the BROWSE file."
;; If not given as parameters, get the necessary information
;; out of the member buffer.
(if info
- (setq tree (first info)
- accessor (second info)
- member (third info))
- (multiple-value-setq (tree member on-class)
- (values-list (ebrowse-member-info-from-point)))
+ (setq tree (cl-first info)
+ accessor (cl-second info)
+ member (cl-third info))
+ (cl-multiple-value-setq (tree member on-class)
+ (cl-values-list (ebrowse-member-info-from-point)))
(setq accessor ebrowse--accessor))
;; View/find class if on a line containing a class name.
(when on-class
- (return-from ebrowse-view/find-member-declaration/definition
+ (cl-return-from ebrowse-view/find-member-declaration/definition
(ebrowse-view/find-file-and-search-pattern
(ebrowse-ts-class tree)
(list ebrowse--header (ebrowse-ts-class tree) nil)
@@ -2822,11 +2791,11 @@ TREE is the class tree in which the members are found."
mouse-face highlight
ebrowse-tree ,tree
help-echo "mouse-2: view definition; mouse-3: menu"))
- (incf i)
+ (cl-incf i)
(when (>= i ebrowse--n-columns)
(setf i 0)
(insert "\n")))))
- (when (plusp i)
+ (when (cl-plusp i)
(insert "\n"))
(goto-char (point-min))))
@@ -2904,7 +2873,7 @@ REPEAT, if specified, says repeat the search REPEAT times."
(error "Not found"))))
-(defun* ebrowse-move-point-to-member (name &optional count &aux member)
+(cl-defun ebrowse-move-point-to-member (name &optional count &aux member)
"Set point on member NAME in the member buffer
COUNT, if specified, says search the COUNT'th member with the same name."
(goto-char (point-min))
@@ -2925,8 +2894,8 @@ COUNT, if specified, says search the COUNT'th member with the same name."
"Switch member buffer to a class read from the minibuffer.
Use TITLE as minibuffer prompt.
COMPL-LIST is a completion list to use."
- (let* ((initial (unless (second compl-list)
- (first (first compl-list))))
+ (let* ((initial (unless (cl-second compl-list)
+ (cl-first (cl-first compl-list))))
(class (or (ebrowse-completing-read-value title compl-list initial)
(error "Not found"))))
(setf ebrowse--displayed-class class
@@ -2946,14 +2915,14 @@ COMPL-LIST is a completion list to use."
(interactive "P")
(let ((supers (or (ebrowse-direct-base-classes ebrowse--displayed-class)
(error "No base classes"))))
- (if (and arg (second supers))
- (let ((alist (loop for s in supers
- collect (cons (ebrowse-qualified-class-name
- (ebrowse-ts-class s))
- s))))
+ (if (and arg (cl-second supers))
+ (let ((alist (cl-loop for s in supers
+ collect (cons (ebrowse-qualified-class-name
+ (ebrowse-ts-class s))
+ s))))
(ebrowse-switch-member-buffer-to-other-class
"Goto base class: " alist))
- (setq ebrowse--displayed-class (first supers)
+ (setq ebrowse--displayed-class (cl-first supers)
ebrowse--member-list
(funcall ebrowse--accessor ebrowse--displayed-class))
(ebrowse-redisplay-member-buffer))))
@@ -2977,21 +2946,22 @@ Prefix arg INC specifies which one."
(let ((containing-list ebrowse--tree)
index cls
(supers (ebrowse-direct-base-classes ebrowse--displayed-class)))
- (flet ((trees-alist (trees)
- (loop for tr in trees
- collect (cons (ebrowse-cs-name
- (ebrowse-ts-class tr)) tr))))
+ (cl-flet ((trees-alist (trees)
+ (cl-loop for tr in trees
+ collect (cons (ebrowse-cs-name
+ (ebrowse-ts-class tr))
+ tr))))
(when supers
- (let ((tree (if (second supers)
+ (let ((tree (if (cl-second supers)
(ebrowse-completing-read-value
"Relative to base class: "
(trees-alist supers) nil)
- (first supers))))
+ (cl-first supers))))
(unless tree (error "Not found"))
(setq containing-list (ebrowse-ts-subclasses tree)))))
(setq index (+ inc (ebrowse-position ebrowse--displayed-class
containing-list)))
- (cond ((minusp index) (message "No previous class"))
+ (cond ((cl-minusp index) (message "No previous class"))
((null (nth index containing-list)) (message "No next class")))
(setq index (max 0 (min index (1- (length containing-list)))))
(setq cls (nth index containing-list))
@@ -3005,17 +2975,17 @@ Prefix arg INC specifies which one."
Prefix arg ARG says which class should be displayed. Default is
the first derived class."
(interactive "P")
- (flet ((ebrowse-tree-obarray-as-alist ()
- (loop for s in (ebrowse-ts-subclasses
- ebrowse--displayed-class)
- collect (cons (ebrowse-cs-name
- (ebrowse-ts-class s)) s))))
+ (cl-flet ((ebrowse-tree-obarray-as-alist ()
+ (cl-loop for s in (ebrowse-ts-subclasses
+ ebrowse--displayed-class)
+ collect (cons (ebrowse-cs-name
+ (ebrowse-ts-class s)) s))))
(let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class)
(error "No derived classes"))))
- (if (and arg (second subs))
+ (if (and arg (cl-second subs))
(ebrowse-switch-member-buffer-to-other-class
"Goto derived class: " (ebrowse-tree-obarray-as-alist))
- (setq ebrowse--displayed-class (first subs)
+ (setq ebrowse--displayed-class (cl-first subs)
ebrowse--member-list
(funcall ebrowse--accessor ebrowse--displayed-class))
(ebrowse-redisplay-member-buffer)))))
@@ -3211,15 +3181,15 @@ the first derived class."
EVENT is the mouse event."
(interactive "e")
(mouse-set-point event)
- (case (event-click-count event)
+ (pcase (event-click-count event)
(2 (ebrowse-find-member-definition))
- (1 (case (get-text-property (posn-point (event-start event))
- 'ebrowse-what)
- (member-name
+ (1 (pcase (get-text-property (posn-point (event-start event))
+ 'ebrowse-what)
+ (`member-name
(ebrowse-popup-menu ebrowse-member-name-object-menu event))
- (class-name
+ (`class-name
(ebrowse-popup-menu ebrowse-member-class-name-object-menu event))
- (t
+ (_
(ebrowse-popup-menu ebrowse-member-buffer-object-menu event))))))
@@ -3228,11 +3198,11 @@ EVENT is the mouse event."
EVENT is the mouse event."
(interactive "e")
(mouse-set-point event)
- (case (event-click-count event)
+ (pcase (event-click-count event)
(2 (ebrowse-find-member-definition))
- (1 (case (get-text-property (posn-point (event-start event))
+ (1 (pcase (get-text-property (posn-point (event-start event))
'ebrowse-what)
- (member-name
+ (`member-name
(ebrowse-view-member-definition 0))))))
@@ -3253,11 +3223,11 @@ member was found. The CDR of the acons is described in function
alist)
(when name
(dolist (info (gethash name table) alist)
- (unless (memq (first info) known-classes)
- (setf alist (acons (ebrowse-qualified-class-name
- (ebrowse-ts-class (first info)))
- info alist)
- known-classes (cons (first info) known-classes)))))))
+ (unless (memq (cl-first info) known-classes)
+ (setf alist (cl-acons (ebrowse-qualified-class-name
+ (ebrowse-ts-class (cl-first info)))
+ info alist)
+ known-classes (cons (cl-first info) known-classes)))))))
(defun ebrowse-choose-tree ()
@@ -3267,8 +3237,8 @@ the one he wants. Value is (TREE HEADER BUFFER), with TREE being
the class tree, HEADER the header structure of the tree, and BUFFER
being the tree or member buffer containing the tree."
(let* ((buffer (ebrowse-choose-from-browser-buffers)))
- (if buffer (list (ebrowse-value-in-buffer 'ebrowse--tree buffer)
- (ebrowse-value-in-buffer 'ebrowse--header buffer)
+ (if buffer (list (buffer-local-value 'ebrowse--tree buffer)
+ (buffer-local-value 'ebrowse--header buffer)
buffer))))
@@ -3279,8 +3249,8 @@ Prompt with PROMPT. Insert into the minibuffer a C++ identifier read
from point as default. Value is a list (CLASS-NAME MEMBER-NAME)."
(save-excursion
(let ((members (ebrowse-member-table header)))
- (multiple-value-bind (class-name member-name)
- (values-list (ebrowse-tags-read-member+class-name))
+ (cl-multiple-value-bind (class-name member-name)
+ (cl-values-list (ebrowse-tags-read-member+class-name))
(unless member-name
(error "No member name at point"))
(if members
@@ -3292,7 +3262,7 @@ from point as default. Value is a list (CLASS-NAME MEMBER-NAME)."
(unless (gethash name members)
(if (y-or-n-p "No exact match found. Try substrings? ")
(setq name
- (or (first (ebrowse-list-of-matching-members
+ (or (cl-first (ebrowse-list-of-matching-members
members (regexp-quote name) name))
(error "Sorry, nothing found")))
(error "Canceled")))
@@ -3325,15 +3295,15 @@ Value is a list (TREE ACCESSOR MEMBER) for the member."
(let ((alist (or (ebrowse-class-alist-for-member header name)
(error "No classes with member `%s' found" name))))
(ebrowse-ignoring-completion-case
- (if (null (second alist))
- (cdr (first alist))
+ (if (null (cl-second alist))
+ (cdr (cl-first alist))
(push ?\? unread-command-events)
(cdr (assoc (completing-read "In class: "
alist nil t initial-class-name)
alist))))))
-(defun* ebrowse-tags-view/find-member-decl/defn
+(cl-defun ebrowse-tags-view/find-member-decl/defn
(prefix &key view definition member-name)
"If VIEW is t, view, else find an occurrence of MEMBER-NAME.
@@ -3344,16 +3314,16 @@ of all classes containing a member with the given name and lets
the user choose the class to use. As a last step, a tags search
is performed that positions point on the member declaration or
definition."
- (multiple-value-bind
- (tree header tree-buffer) (values-list (ebrowse-choose-tree))
+ (cl-multiple-value-bind
+ (tree header tree-buffer) (cl-values-list (ebrowse-choose-tree))
(unless tree (error "No class tree"))
(let* ((marker (point-marker))
class-name
(name member-name)
info)
(unless name
- (multiple-value-setq (class-name name)
- (values-list
+ (cl-multiple-value-setq (class-name name)
+ (cl-values-list
(ebrowse-tags-read-name
header
(concat (if view "View" "Find") " member "
@@ -3364,7 +3334,7 @@ definition."
(ebrowse-view/find-member-declaration/definition
prefix view definition info
header
- (ebrowse-value-in-buffer 'ebrowse--tags-file-name tree-buffer))
+ (buffer-local-value 'ebrowse--tags-file-name tree-buffer))
;; Record position jumped to
(ebrowse-push-position (point-marker) info t))))
@@ -3459,14 +3429,14 @@ It is a list (TREE ACCESSOR MEMBER)."
(cond ((null buffer)
(set-buffer tree-buffer)
(switch-to-buffer (ebrowse-display-member-buffer
- (second info) nil (first info))))
+ (cl-second info) nil (cl-first info))))
(t
(switch-to-buffer buffer)
- (setq ebrowse--displayed-class (first info)
- ebrowse--accessor (second info)
+ (setq ebrowse--displayed-class (cl-first info)
+ ebrowse--accessor (cl-second info)
ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class))
(ebrowse-redisplay-member-buffer)))
- (ebrowse-move-point-to-member (ebrowse-ms-name (third info)))))
+ (ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info)))))
(defun ebrowse-tags-display-member-buffer (&optional fix-name)
@@ -3474,13 +3444,13 @@ It is a list (TREE ACCESSOR MEMBER)."
FIX-NAME non-nil means display the buffer for that member.
Otherwise read a member name from point."
(interactive)
- (multiple-value-bind
- (tree header tree-buffer) (values-list (ebrowse-choose-tree))
+ (cl-multiple-value-bind
+ (tree header tree-buffer) (cl-values-list (ebrowse-choose-tree))
(unless tree (error "No class tree"))
(let* ((marker (point-marker)) class-name (name fix-name) info)
(unless name
- (multiple-value-setq (class-name name)
- (values-list
+ (cl-multiple-value-setq (class-name name)
+ (cl-values-list
(ebrowse-tags-read-name header
(concat "Find member list of: ")))))
(setq info (ebrowse-tags-choose-class tree header name class-name))
@@ -3507,7 +3477,7 @@ are not performed."
(interactive)
(let* ((buffer (or (ebrowse-choose-from-browser-buffers)
(error "No tree buffer")))
- (header (ebrowse-value-in-buffer 'ebrowse--header buffer))
+ (header (buffer-local-value 'ebrowse--header buffer))
(members (ebrowse-member-table header))
temp-buffer-setup-hook
(regexp (read-from-minibuffer "List members matching regexp: ")))
@@ -3515,9 +3485,9 @@ are not performed."
(set-buffer standard-output)
(erase-buffer)
(insert "Members matching `" regexp "'\n\n")
- (loop for s in (ebrowse-list-of-matching-members members regexp) do
- (loop for info in (gethash s members) do
- (ebrowse-draw-file-member-info info))))))
+ (cl-loop for s in (ebrowse-list-of-matching-members members regexp) do
+ (cl-loop for info in (gethash s members) do
+ (ebrowse-draw-file-member-info info))))))
(defun ebrowse-tags-list-members-in-file ()
@@ -3528,50 +3498,50 @@ The file name is read from the minibuffer."
(error "No tree buffer")))
(files (with-current-buffer buffer (ebrowse-files-table)))
(file (completing-read "List members in file: " files nil t))
- (header (ebrowse-value-in-buffer 'ebrowse--header buffer))
+ (header (buffer-local-value 'ebrowse--header buffer))
temp-buffer-setup-hook
(members (ebrowse-member-table header)))
(with-output-to-temp-buffer (concat "*Members in file " file "*")
(set-buffer standard-output)
(maphash
(lambda (_member-name list)
- (loop for info in list
- as member = (third info)
- as class = (ebrowse-ts-class (first info))
- when (or (and (null (ebrowse-ms-file member))
- (string= (ebrowse-cs-file class) file))
- (string= file (ebrowse-ms-file member)))
- do (ebrowse-draw-file-member-info info "decl.")
- when (or (and (null (ebrowse-ms-definition-file member))
- (string= (ebrowse-cs-source-file class) file))
- (string= file (ebrowse-ms-definition-file member)))
- do (ebrowse-draw-file-member-info info "defn.")))
+ (cl-loop for info in list
+ as member = (cl-third info)
+ as class = (ebrowse-ts-class (cl-first info))
+ when (or (and (null (ebrowse-ms-file member))
+ (string= (ebrowse-cs-file class) file))
+ (string= file (ebrowse-ms-file member)))
+ do (ebrowse-draw-file-member-info info "decl.")
+ when (or (and (null (ebrowse-ms-definition-file member))
+ (string= (ebrowse-cs-source-file class) file))
+ (string= file (ebrowse-ms-definition-file member)))
+ do (ebrowse-draw-file-member-info info "defn.")))
members))))
-(defun* ebrowse-draw-file-member-info (info &optional (kind ""))
+(cl-defun ebrowse-draw-file-member-info (info &optional (kind ""))
"Display a line in the members info buffer.
INFO describes the member. It has the form (TREE ACCESSOR MEMBER).
TREE is the class of the member to display.
ACCESSOR is the accessor symbol of its member list.
MEMBER is the member structure.
KIND is an additional string printed in the buffer."
- (let* ((tree (first info))
+ (let* ((tree (cl-first info))
(globals-p (ebrowse-globals-tree-p tree)))
(unless globals-p
(insert (ebrowse-cs-name (ebrowse-ts-class tree))))
- (insert "::" (ebrowse-ms-name (third info)))
+ (insert "::" (ebrowse-ms-name (cl-third info)))
(indent-to 40)
(insert kind)
(indent-to 50)
- (insert (case (second info)
- (ebrowse-ts-member-functions "member function")
- (ebrowse-ts-member-variables "member variable")
- (ebrowse-ts-static-functions "static function")
- (ebrowse-ts-static-variables "static variable")
- (ebrowse-ts-friends (if globals-p "define" "friend"))
- (ebrowse-ts-types "type")
- (t "unknown"))
+ (insert (pcase (cl-second info)
+ (`ebrowse-ts-member-functions "member function")
+ (`ebrowse-ts-member-variables "member variable")
+ (`ebrowse-ts-static-functions "static function")
+ (`ebrowse-ts-static-variables "static variable")
+ (`ebrowse-ts-friends (if globals-p "define" "friend"))
+ (`ebrowse-ts-types "type")
+ (_ "unknown"))
"\n")))
(defvar ebrowse-last-completion nil
@@ -3602,11 +3572,11 @@ KIND is an additional string printed in the buffer."
If there's only one tree loaded, use that. Otherwise let the
use choose a tree."
(let* ((buffers (ebrowse-known-class-trees-buffer-list))
- (buffer (cond ((and (first buffers) (not (second buffers)))
- (first buffers))
+ (buffer (cond ((and (cl-first buffers) (not (cl-second buffers)))
+ (cl-first buffers))
(t (or (ebrowse-electric-choose-tree)
(error "No tree buffer")))))
- (header (ebrowse-value-in-buffer 'ebrowse--header buffer)))
+ (header (buffer-local-value 'ebrowse--header buffer)))
(ebrowse-member-table header)))
@@ -3614,13 +3584,13 @@ use choose a tree."
"Return the item following STRING in LIST.
If STRING is the last element, return the first element as successor."
(or (nth (1+ (ebrowse-position string list 'string=)) list)
- (first list)))
+ (cl-first list)))
;;; Symbol completion
;;;###autoload
-(defun* ebrowse-tags-complete-symbol (prefix)
+(cl-defun ebrowse-tags-complete-symbol (prefix)
"Perform completion on the C++ symbol preceding point.
A second call of this function without changing point inserts the next match.
A call with prefix PREFIX reads the symbol to insert from the minibuffer with
@@ -3660,7 +3630,7 @@ completion."
;; buffer: Start new completion.
(t
(let* ((members (ebrowse-some-member-table))
- (completion (first (all-completions pattern members nil))))
+ (completion (cl-first (all-completions pattern members nil))))
(cond ((eq completion t))
((null completion)
(error "Can't find completion for `%s'" pattern))
@@ -3786,15 +3756,15 @@ Searches in all files mentioned in a class tree for something that
looks like a function call to the member."
(interactive)
;; Choose the tree to use if there is more than one.
- (multiple-value-bind (tree header tree-buffer)
- (values-list (ebrowse-choose-tree))
+ (cl-multiple-value-bind (tree header tree-buffer)
+ (cl-values-list (ebrowse-choose-tree))
(unless tree
(error "No class tree"))
;; Get the member name NAME (class-name is ignored).
(let ((name fix-name) class-name regexp)
(unless name
- (multiple-value-setq (class-name name)
- (values-list (ebrowse-tags-read-name header "Find calls of: "))))
+ (cl-multiple-value-setq (class-name name)
+ (cl-values-list (ebrowse-tags-read-name header "Find calls of: "))))
;; Set tags loop form to search for member and begin loop.
(setq regexp (concat "\\<" name "[ \t]*(")
ebrowse-tags-loop-form (list 're-search-forward regexp nil t))
@@ -3806,7 +3776,7 @@ looks like a function call to the member."
;;; Structures of this kind are the elements of the position stack.
-(defstruct (ebrowse-position (:type vector) :named)
+(cl-defstruct (ebrowse-position (:type vector) :named)
file-name ; in which file
point ; point in file
target ; t if target of a jump
@@ -3826,8 +3796,8 @@ looks like a function call to the member."
The string is printed in the electric position list buffer."
(let ((info (ebrowse-position-info position)))
(concat (if (ebrowse-position-target position) "at " "to ")
- (ebrowse-cs-name (ebrowse-ts-class (first info)))
- "::" (ebrowse-ms-name (third info)))))
+ (ebrowse-cs-name (ebrowse-ts-class (cl-first info)))
+ "::" (ebrowse-ms-name (cl-third info)))))
(defun ebrowse-view/find-position (position &optional view)
@@ -3857,7 +3827,7 @@ Positions in buffers that have no file names are not saved."
(let ((too-much (- (length ebrowse-position-stack)
ebrowse-max-positions)))
;; Do not let the stack grow to infinity.
- (when (plusp too-much)
+ (when (cl-plusp too-much)
(setq ebrowse-position-stack
(butlast ebrowse-position-stack too-much)))
;; Push the position.
@@ -4128,9 +4098,9 @@ Otherwise, FILE-NAME specifies the file to save the tree in."
(let ((tree-file (buffer-file-name))
temp-buffer-setup-hook)
(with-output-to-temp-buffer "*Tree Statistics*"
- (multiple-value-bind (classes member-functions member-variables
+ (cl-multiple-value-bind (classes member-functions member-variables
static-functions static-variables)
- (values-list (ebrowse-gather-statistics))
+ (cl-values-list (ebrowse-gather-statistics))
(set-buffer standard-output)
(erase-buffer)
(insert "STATISTICS FOR TREE " (or tree-file "unknown") ":\n\n")
@@ -4162,11 +4132,11 @@ NUMBER-OF-STATIC-VARIABLES:"
(let ((classes 0) (member-functions 0) (member-variables 0)
(static-functions 0) (static-variables 0))
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
- (incf classes)
- (incf member-functions (length (ebrowse-ts-member-functions tree)))
- (incf member-variables (length (ebrowse-ts-member-variables tree)))
- (incf static-functions (length (ebrowse-ts-static-functions tree)))
- (incf static-variables (length (ebrowse-ts-static-variables tree))))
+ (cl-incf classes)
+ (cl-incf member-functions (length (ebrowse-ts-member-functions tree)))
+ (cl-incf member-variables (length (ebrowse-ts-member-variables tree)))
+ (cl-incf static-functions (length (ebrowse-ts-static-functions tree)))
+ (cl-incf static-variables (length (ebrowse-ts-static-variables tree))))
(list classes member-functions member-variables
static-functions static-variables)))
@@ -4178,7 +4148,7 @@ NUMBER-OF-STATIC-VARIABLES:"
;; prefix `\C-c\C-m' to browse commands.
(defvar ebrowse-global-map nil
- "*Keymap for Ebrowse commands.")
+ "Keymap for Ebrowse commands.")
(defvar ebrowse-global-prefix-key "\C-c\C-m"
@@ -4240,7 +4210,7 @@ NUMBER-OF-STATIC-VARIABLES:"
;; this will select the buffer from which the buffer menu was
;; invoked. But this buffer is not displayed in the buffer list if
;; it isn't a tree buffer. I therefore let the buffer menu command
-;; loop read the command `p' via `unread-command-char'. This command
+;; loop read the command `p' via `unread-command-events'. This command
;; has no effect since we are on the first line of the buffer.
(defvar electric-buffer-menu-mode-hook nil)
@@ -4410,12 +4380,12 @@ EVENT is the mouse event."
(mouse-set-point event)
(let* ((where (posn-point (event-start event)))
(property (get-text-property where 'ebrowse-what)))
- (case (event-click-count event)
+ (pcase (event-click-count event)
(1
- (case property
- (class-name
+ (pcase property
+ (`class-name
(ebrowse-popup-menu ebrowse-tree-buffer-class-object-menu event))
- (t
+ (_
(ebrowse-popup-menu ebrowse-tree-buffer-object-menu event)))))))
@@ -4426,9 +4396,9 @@ EVENT is the mouse event."
(mouse-set-point event)
(let* ((where (posn-point (event-start event)))
(property (get-text-property where 'ebrowse-what)))
- (case (event-click-count event)
- (1 (case property
- (class-name
+ (pcase (event-click-count event)
+ (1 (pcase property
+ (`class-name
(ebrowse-tree-command:show-member-functions)))))))
@@ -4439,13 +4409,13 @@ EVENT is the mouse event."
(mouse-set-point event)
(let* ((where (posn-point (event-start event)))
(property (get-text-property where 'ebrowse-what)))
- (case (event-click-count event)
- (2 (case property
- (class-name
+ (pcase (event-click-count event)
+ (2 (pcase property
+ (`class-name
(let ((collapsed (save-excursion (skip-chars-forward "^\r\n")
(looking-at "\r"))))
(ebrowse-collapse-fn (not collapsed))))
- (mark
+ (`mark
(ebrowse-toggle-mark-at-point 1)))))))
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 2d0b18f3dae..071a0fb6037 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1,6 +1,6 @@
-;;; etags.el --- etags facility for Emacs
+;;; etags.el --- etags facility for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2011
+;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
@@ -26,14 +26,12 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
(require 'ring)
(require 'button)
;;;###autoload
(defvar tags-file-name nil
- "*File name of tags table.
+ "File name of tags table.
To switch to a new tags table, setting this variable is sufficient.
If you set this variable, do not also set `tags-table-list'.
Use the `etags' program to make a tags table file.")
@@ -46,7 +44,7 @@ Use the `etags' program to make a tags table file.")
;;;###autoload
(defcustom tags-case-fold-search 'default
- "*Whether tags operations should be case-sensitive.
+ "Whether tags operations should be case-sensitive.
A value of t means case-insensitive, a value of nil means case-sensitive.
Any other value means use the setting of `case-fold-search'."
:group 'etags
@@ -58,7 +56,7 @@ Any other value means use the setting of `case-fold-search'."
;;;###autoload
;; Use `visit-tags-table-buffer' to cycle through tags tables in this list.
(defcustom tags-table-list nil
- "*List of file names of tags tables to search.
+ "List of file names of tags tables to search.
An element that is a directory means the file \"TAGS\" in that directory.
To switch to a new list of tags tables, setting this variable is sufficient.
If you set this variable, do not also set `tags-file-name'.
@@ -69,7 +67,7 @@ Use the `etags' program to make a tags table file."
;;;###autoload
(defcustom tags-compression-info-list
(purecopy '("" ".Z" ".bz2" ".gz" ".xz" ".tgz"))
- "*List of extensions tried by etags when jka-compr is used.
+ "List of extensions tried by etags when jka-compr is used.
An empty string means search the non-compressed file.
These extensions will be tried only if jka-compr was activated
\(i.e. via customize of `auto-compression-mode' or by calling the function
@@ -90,7 +88,7 @@ These extensions will be tried only if jka-compr was activated
;;;###autoload
(defcustom tags-add-tables 'ask-user
- "*Control whether to add a new tags table to the current list.
+ "Control whether to add a new tags table to the current list.
t means do; nil means don't (always start a new list).
Any other value means ask the user whether to add a new tags table
to the current list (as opposed to starting a new list)."
@@ -100,7 +98,7 @@ to the current list (as opposed to starting a new list)."
(other :tag "Ask" ask-user)))
(defcustom tags-revert-without-query nil
- "*Non-nil means reread a TAGS table without querying, if it has changed."
+ "Non-nil means reread a TAGS table without querying, if it has changed."
:group 'etags
:type 'boolean)
@@ -131,7 +129,7 @@ Each element is a list of strings which are file names.")
;;;###autoload
(defcustom find-tag-hook nil
- "*Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
+ "Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
The value in the buffer in which \\[find-tag] is done is used,
not the value in the buffer \\[find-tag] goes to."
:group 'etags
@@ -139,7 +137,7 @@ not the value in the buffer \\[find-tag] goes to."
;;;###autoload
(defcustom find-tag-default-function nil
- "*A function of no arguments used by \\[find-tag] to pick a default tag.
+ "A function of no arguments used by \\[find-tag] to pick a default tag.
If nil, and the symbol that is the value of `major-mode'
has a `find-tag-default-function' property (see `put'), that is used.
Otherwise, `find-tag-default' is used."
@@ -147,13 +145,13 @@ Otherwise, `find-tag-default' is used."
:type '(choice (const nil) function))
(defcustom find-tag-marker-ring-length 16
- "*Length of marker rings `find-tag-marker-ring' and `tags-location-ring'."
+ "Length of marker rings `find-tag-marker-ring' and `tags-location-ring'."
:group 'etags
:type 'integer
:version "20.3")
(defcustom tags-tag-face 'default
- "*Face for tags in the output of `tags-apropos'."
+ "Face for tags in the output of `tags-apropos'."
:group 'etags
:type 'face
:version "21.1")
@@ -463,7 +461,7 @@ Returns non-nil if it is a valid table."
;; Subroutine of visit-tags-table-buffer. Search the current tags tables
;; for one that has tags for THIS-FILE (or that includes a table that
-;; does). Return the name of the first table table listing THIS-FILE; if
+;; does). Return the name of the first table listing THIS-FILE; if
;; the table is one included by another table, it is the master table that
;; we return. If CORE-ONLY is non-nil, check only tags tables that are
;; already in buffers--don't visit any new files.
@@ -554,11 +552,10 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
(cond ((eq cont 'same)
;; Use the ambient value of tags-file-name.
(or tags-file-name
- (error "%s"
- (substitute-command-keys
- (concat "No tags table in use; "
- "use \\[visit-tags-table] to select one")))))
-
+ (user-error "%s"
+ (substitute-command-keys
+ (concat "No tags table in use; "
+ "use \\[visit-tags-table] to select one")))))
((eq t cont)
;; Find the next table.
(if (tags-next-table)
@@ -566,7 +563,6 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
(while (and (not (or (get-file-buffer tags-file-name)
(file-exists-p tags-file-name)))
(tags-next-table)))))
-
(t
;; Pick a table out of our hat.
(tags-table-check-computed-list) ;Get it up to date, we might use it.
@@ -706,7 +702,8 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
(kill-local-variable 'tags-file-name)
(if (eq local-tags-file-name tags-file-name)
(setq tags-file-name nil))
- (error "File %s is not a valid tags table" local-tags-file-name)))))
+ (user-error "File %s is not a valid tags table"
+ local-tags-file-name)))))
(defun tags-reset-tags-tables ()
"Reset tags state to cancel effect of any previous \\[visit-tags-table] or \\[find-tag]."
@@ -781,7 +778,7 @@ tags table and its (recursively) included tags tables."
(setq tags-completion-table nil)))))
(defun tags-lazy-completion-table ()
- (lexical-let ((buf (current-buffer)))
+ (let ((buf (current-buffer)))
(lambda (string pred action)
(with-current-buffer buf
(save-excursion
@@ -809,10 +806,11 @@ If no tags table is loaded, do nothing and return nil."
beg)
(when pattern
(save-excursion
- (search-backward pattern) ;FIXME: will fail if we're inside pattern.
- (setq beg (point))
- (forward-char (length pattern))
- (list beg (point) (tags-lazy-completion-table) :exclusive 'no))))))
+ (forward-char (1- (length pattern)))
+ (search-backward pattern)
+ (setq beg (point))
+ (forward-char (length pattern))
+ (list beg (point) (tags-lazy-completion-table) :exclusive 'no))))))
(defun find-tag-tag (string)
"Read a tag name, with defaulting and completion."
@@ -830,7 +828,7 @@ If no tags table is loaded, do nothing and return nil."
(tags-lazy-completion-table)
nil nil nil nil default)))
(if (equal spec "")
- (or default (error "There is no default tag"))
+ (or default (user-error "There is no default tag"))
spec)))
(defvar last-tag nil
@@ -885,7 +883,7 @@ See documentation of variable `tags-file-name'."
(if (eq '- next-p)
;; Pop back to a previous location.
(if (ring-empty-p tags-location-ring)
- (error "No previous tag locations")
+ (user-error "No previous tag locations")
(let ((marker (ring-remove tags-location-ring 0)))
(prog1
;; Move to the saved location.
@@ -1149,8 +1147,8 @@ error message."
(set-marker (car tag-lines-already-matched) nil nil)
(setq tag-lines-already-matched (cdr tag-lines-already-matched)))
(set-marker match-marker nil nil)
- (error "No %stags %s %s" (if first-search "" "more ")
- matching pattern))
+ (user-error "No %stags %s %s" (if first-search "" "more ")
+ matching pattern))
;; Found a tag; extract location info.
(beginning-of-line)
@@ -1390,8 +1388,8 @@ hits the start of file."
offset (* 3 offset))) ; expand search window
(or found
(re-search-forward pat nil t)
- (error "Rerun etags: `%s' not found in %s"
- pat buffer-file-name)))
+ (user-error "Rerun etags: `%s' not found in %s"
+ pat buffer-file-name)))
;; Position point at the right place
;; if the search string matched an extra Ctrl-m at the beginning.
(and (eq selective-display t)
@@ -1409,7 +1407,9 @@ hits the start of file."
tag tag-info pt)
(forward-line 1)
(while (not (or (eobp) (looking-at "\f")))
- (setq tag-info (save-excursion (funcall snarf-tag-function t))
+ ;; We used to use explicit tags when available, but the current goto-func
+ ;; can only handle implicit tags.
+ (setq tag-info (save-excursion (funcall snarf-tag-function nil))
tag (car tag-info)
pt (with-current-buffer standard-output (point)))
(princ tag)
@@ -1684,7 +1684,7 @@ Point should be just after a string that matches TAG."
(re-search-backward re bol t)))))
(defcustom tags-loop-revert-buffers nil
- "*Non-nil means tags-scanning loops should offer to reread changed files.
+ "Non-nil means tags-scanning loops should offer to reread changed files.
These loops normally read each file into Emacs, but when a file
is already visited, they use the existing buffer.
When this flag is non-nil, they offer to revert the existing buffer
@@ -1739,7 +1739,7 @@ if the file was newly read in, the value is the filename."
(and novisit
(get-buffer " *next-file*")
(kill-buffer " *next-file*"))
- (error "All files processed"))
+ (user-error "All files processed"))
(let* ((next (car next-file-list))
(buffer (get-file-buffer next))
(new (not buffer)))
@@ -1772,9 +1772,9 @@ if the file was newly read in, the value is the filename."
"Form for `tags-loop-continue' to eval to change one file.")
(defvar tags-loop-scan
- '(error "%s"
- (substitute-command-keys
- "No \\[tags-search] or \\[tags-query-replace] in progress"))
+ '(user-error "%s"
+ (substitute-command-keys
+ "No \\[tags-search] or \\[tags-query-replace] in progress"))
"Form for `tags-loop-continue' to eval to scan one file.
If it returns non-nil, this file needs processing by evalling
\`tags-loop-operate'. Otherwise, move on to the next file.")
@@ -1934,7 +1934,7 @@ directory specification."
(if (funcall list-tags-function file)
(setq gotany t)))
(or gotany
- (error "File %s not in current tags tables" file)))))
+ (user-error "File %s not in current tags tables" file)))))
(with-current-buffer "*Tags List*"
(require 'apropos)
(with-no-warnings
@@ -2064,28 +2064,15 @@ for \\[find-tag] (which see)."
(interactive)
(or tags-table-list
tags-file-name
- (error "%s"
- (substitute-command-keys
- "No tags table loaded; try \\[visit-tags-table]")))
+ (user-error "%s"
+ (substitute-command-keys
+ "No tags table loaded; try \\[visit-tags-table]")))
(let ((comp-data (tags-completion-at-point-function)))
(if (null comp-data)
- (error "Nothing to complete")
+ (user-error "Nothing to complete")
(completion-in-region (car comp-data) (cadr comp-data)
(nth 2 comp-data)
(plist-get (nthcdr 3 comp-data) :predicate)))))
-
-(dolist (x '("^No tags table in use; use .* to select one$"
- "^There is no default tag$"
- "^No previous tag locations$"
- "^File .* is not a valid tags table$"
- "^No \\(more \\|\\)tags \\(matching\\|containing\\) "
- "^Rerun etags: `.*' not found in "
- "^All files processed$"
- "^No .* or .* in progress$"
- "^File .* not in current tags tables$"
- "^No tags table loaded"
- "^Nothing to complete$"))
- (add-to-list 'debug-ignored-errors x))
(provide 'etags)
diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el
index 281fa3cef72..092e1a4d578 100644
--- a/lisp/progmodes/executable.el
+++ b/lisp/progmodes/executable.el
@@ -1,6 +1,6 @@
;;; executable.el --- base functionality for executable interpreter scripts -*- byte-compile-dynamic: t -*-
-;; Copyright (C) 1994-1996, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2000-2012 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: languages, unix
@@ -57,7 +57,7 @@
;; This used to default to `other', but that doesn't seem to have any
;; significance. fx 2000-02-11.
(defcustom executable-insert t ; 'other
- "*Non-nil means offer to add a magic number to a file.
+ "Non-nil means offer to add a magic number to a file.
This takes effect when you switch to certain major modes,
including Shell-script mode (`sh-mode').
When you type \\[executable-set-magic], it always offers to add or
@@ -70,7 +70,7 @@ update the magic number."
(defcustom executable-query 'function
- "*If non-nil, ask user before changing an existing magic number.
+ "If non-nil, ask user before changing an existing magic number.
When this is `function', only ask when called non-interactively."
:type '(choice (const :tag "Don't Ask" nil)
(const :tag "Ask when non-interactive" function)
@@ -79,19 +79,20 @@ When this is `function', only ask when called non-interactively."
(defcustom executable-magicless-file-regexp "/[Mm]akefile$\\|/\\.\\(z?profile\\|bash_profile\\|z?login\\|bash_login\\|z?logout\\|bash_logout\\|.+shrc\\|esrc\\|rcrc\\|[kz]shenv\\)$"
- "*On files with this kind of name no magic is inserted or changed."
+ "On files with this kind of name no magic is inserted or changed."
:type 'regexp
:group 'executable)
-(defcustom executable-prefix "#! "
- "*Interpreter magic number prefix inserted when there was no magic number."
+(defcustom executable-prefix "#!"
+ "Interpreter magic number prefix inserted when there was no magic number."
+ :version "24.3" ; "#! " -> "#!"
:type 'string
:group 'executable)
(defcustom executable-chmod 73
- "*After saving, if the file is not executable, set this mode.
+ "After saving, if the file is not executable, set this mode.
This mode passed to `set-file-modes' is taken absolutely when negative, or
relative to the files existing modes. Do nothing if this is nil.
Typical values are 73 (+x) or -493 (rwxr-xr-x)."
@@ -103,7 +104,7 @@ Typical values are 73 (+x) or -493 (rwxr-xr-x)."
(defvar executable-command nil)
(defcustom executable-self-display "tail"
- "*Command you use with argument `+2' to make text files self-display.
+ "Command you use with argument `+2' to make text files self-display.
Note that the like of `more' doesn't work too well under Emacs \\[shell]."
:type 'string
:group 'executable)
@@ -111,7 +112,7 @@ Note that the like of `more' doesn't work too well under Emacs \\[shell]."
(defvar executable-font-lock-keywords
'(("\\`#!.*/\\([^ \t\n]+\\)" 1 font-lock-keyword-face t))
- "*Rules for highlighting executable scripts' magic number.
+ "Rules for highlighting executable scripts' magic number.
This can be included in `font-lock-keywords' by modes that call `executable'.")
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index 95b8d810028..f42952685d0 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -1,6 +1,6 @@
-;;; f90.el --- Fortran-90 mode (free format)
+;;; f90.el --- Fortran-90 mode (free format) -*- lexical-binding: t -*-
-;; Copyright (C) 1995-1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Torbjörn Einarsson <Torbjorn.Einarsson@era.ericsson.se>
;; Maintainer: Glenn Morris <rgm@gnu.org>
@@ -102,10 +102,9 @@
;; (abbrev-mode 1) ; turn on abbreviation mode
;; (f90-add-imenu-menu) ; extra menu with functions etc.
;; (if f90-auto-keyword-case ; change case of all keywords on startup
-;; (f90-change-keywords f90-auto-keyword-case))
-;; ))
+;; (f90-change-keywords f90-auto-keyword-case))))
;;
-;; in your .emacs file. You can also customize the lists
+;; in your init file. You can also customize the lists
;; f90-font-lock-keywords, etc.
;;
;; The auto-fill and abbreviation minor modes are accessible from the F90 menu,
@@ -233,6 +232,7 @@
:safe 'stringp
:group 'f90-indent)
+;; Should we add ^# to this? That's not really a comment.
(defcustom f90-directive-comment-re "!hpf\\$"
"Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented."
:type 'regexp
@@ -627,7 +627,14 @@ logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*"
'("\\<\\(do\\|go[ \t]*to\\)\\>[ \t]*\\([0-9]+\\)"
(1 font-lock-keyword-face) (2 font-lock-constant-face))
;; Line numbers (lines whose first character after number is letter).
- '("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t))))
+ '("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t))
+ ;; Override eg for "#include".
+ '("^#[ \t]*\\w+" (0 font-lock-preprocessor-face t)
+ ("\\<defined\\>" nil nil (0 font-lock-preprocessor-face)))
+ '("^#" ("\\(&&\\|||\\)" nil nil (0 font-lock-constant-face t)))
+ '("^#[ \t]*define[ \t]+\\(\\w+\\)(" (1 font-lock-function-name-face))
+ '("^#[ \t]*define[ \t]+\\(\\w+\\)" (1 font-lock-variable-name-face))
+ '("^#[ \t]*include[ \t]+\\(<.+>\\)" (1 font-lock-string-face))))
"Highlights declarations, do-loops and other constructs.")
(defvar f90-font-lock-keywords-3
@@ -651,7 +658,7 @@ logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*"
(defvar f90-font-lock-keywords
f90-font-lock-keywords-2
- "*Default expressions to highlight in F90 mode.
+ "Default expressions to highlight in F90 mode.
Can be overridden by the value of `font-lock-maximum-decoration'.")
@@ -2204,18 +2211,13 @@ Leave point at the end of line."
"Typing `\\[help-command] or `? lists all the F90 abbrevs.
Any other key combination is executed normally."
(interactive "*")
- (insert last-command-event)
- (let (char event)
- (if (fboundp 'next-command-event) ; XEmacs
- (setq event (next-command-event)
- char (and (fboundp 'event-to-character)
- (event-to-character event)))
- (setq event (read-event)
- char event))
- ;; Insert char if not equal to `?', or if abbrev-mode is off.
- (if (and abbrev-mode (memq char (list ?? help-char)))
- (f90-abbrev-help)
- (setq unread-command-events (list event)))))
+ (self-insert-command 1)
+ (when abbrev-mode
+ (set-temporary-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [??] 'f90-abbrev-help)
+ (define-key map (vector help-char) 'f90-abbrev-help)
+ map))))
(defun f90-abbrev-help ()
"List the currently defined abbrevs in F90 mode."
@@ -2319,7 +2321,6 @@ escape character."
;; Local Variables:
;; coding: utf-8
-;; lexical-binding: t
;; End:
;;; f90.el ends here
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 1c138f053d3..5ba84f8991e 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -1,6 +1,6 @@
;;; flymake.el -- a universal on-the-fly syntax checker
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
;; Maintainer: Pavel Kobyakov <pk_at_work@yahoo.com>
@@ -35,7 +35,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(if (featurep 'xemacs) (require 'overlay))
(defvar flymake-is-running nil
@@ -253,7 +253,7 @@ are the string substitutions (see `format')."
(make-variable-buffer-local 'flymake-output-residual)
(defgroup flymake nil
- "A universal on-the-fly syntax checker."
+ "Universal on-the-fly syntax checker."
:version "23.1"
:group 'tools)
@@ -408,7 +408,7 @@ File contents are not checked."
This function is used in sort to move most possible file names
to the beginning of the list (File.h -> File.cpp moved to top)."
(and (equal (file-name-sans-extension flymake-included-file-name)
- (file-name-sans-extension (file-name-nondirectory file-one)))
+ (file-name-base file-one))
(not (equal file-one file-two))))
(defcustom flymake-check-file-limit 8192
@@ -684,7 +684,7 @@ It's flymake process filter."
(defun flymake-er-get-line-err-info-list (err-info)
(nth 1 err-info))
-(defstruct (flymake-ler
+(cl-defstruct (flymake-ler
(:constructor nil)
(:constructor flymake-ler-make-ler (file line type text &optional full-file)))
file line type text full-file)
@@ -763,15 +763,63 @@ line number outside the file being compiled."
"Determine whether overlay OV was created by flymake."
(and (overlayp ov) (overlay-get ov 'flymake-overlay)))
-(defun flymake-make-overlay (beg end tooltip-text face mouse-face)
+(defcustom flymake-error-bitmap '(exclamation-mark error)
+ "Bitmap (a symbol) used in the fringe for indicating errors.
+The value may also be a list of two elements where the second
+element specifies the face for the bitmap. For possible bitmap
+symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'.
+
+The option `flymake-fringe-indicator-position' controls how and where
+this is used."
+ :group 'flymake
+ :version "24.3"
+ :type '(choice (symbol :tag "Bitmap")
+ (list :tag "Bitmap and face"
+ (symbol :tag "Bitmap")
+ (face :tag "Face"))))
+
+(defcustom flymake-warning-bitmap 'question-mark
+ "Bitmap (a symbol) used in the fringe for indicating warnings.
+The value may also be a list of two elements where the second
+element specifies the face for the bitmap. For possible bitmap
+symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'.
+
+The option `flymake-fringe-indicator-position' controls how and where
+this is used."
+ :group 'flymake
+ :version "24.3"
+ :type '(choice (symbol :tag "Bitmap")
+ (list :tag "Bitmap and face"
+ (symbol :tag "Bitmap")
+ (face :tag "Face"))))
+
+(defcustom flymake-fringe-indicator-position 'left-fringe
+ "The position to put flymake fringe indicator.
+The value can be nil (do not use indicators), `left-fringe' or `right-fringe'.
+See `flymake-error-bitmap' and `flymake-warning-bitmap'."
+ :group 'flymake
+ :version "24.3"
+ :type '(choice (const left-fringe)
+ (const right-fringe)
+ (const :tag "No fringe indicators" nil)))
+
+(defun flymake-make-overlay (beg end tooltip-text face bitmap mouse-face)
"Allocate a flymake overlay in range BEG and END."
(when (not (flymake-region-has-flymake-overlays beg end))
- (let ((ov (make-overlay beg end nil t t)))
+ (let ((ov (make-overlay beg end nil t t))
+ (fringe (and flymake-fringe-indicator-position
+ (propertize "!" 'display
+ (cons flymake-fringe-indicator-position
+ (if (listp bitmap)
+ bitmap
+ (list bitmap)))))))
(overlay-put ov 'face face)
(overlay-put ov 'mouse-face mouse-face)
(overlay-put ov 'help-echo tooltip-text)
(overlay-put ov 'flymake-overlay t)
(overlay-put ov 'priority 100)
+ (overlay-put ov 'evaporate t)
+ (overlay-put ov 'before-string fringe)
;;+(flymake-log 3 "created overlay %s" ov)
ov)
(flymake-log 3 "created an overlay at (%d-%d)" beg end)))
@@ -796,16 +844,12 @@ Return t if it has at least one flymake overlay, nil if no overlay."
has-flymake-overlays))
(defface flymake-errline
- '((((class color) (background dark)) (:background "Firebrick4"))
- (((class color) (background light)) (:background "LightPink"))
- (t (:bold t)))
+ '((t :inherit error))
"Face used for marking error lines."
:group 'flymake)
(defface flymake-warnline
- '((((class color) (background dark)) (:background "DarkBlue"))
- (((class color) (background light)) (:background "LightBlue2"))
- (t (:bold t)))
+ '((t :inherit warning))
"Face used for marking warning lines."
:group 'flymake)
@@ -819,7 +863,8 @@ Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting."
(beg line-beg)
(end line-end)
(tooltip-text (flymake-ler-text (nth 0 line-err-info-list)))
- (face nil))
+ (face nil)
+ (bitmap nil))
(goto-char line-beg)
(while (looking-at "[ \t]")
@@ -843,10 +888,12 @@ Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting."
(setq end (point)))
(if (> (flymake-get-line-err-count line-err-info-list "e") 0)
- (setq face 'flymake-errline)
- (setq face 'flymake-warnline))
+ (setq face 'flymake-errline
+ bitmap flymake-error-bitmap)
+ (setq face 'flymake-warnline
+ bitmap flymake-warning-bitmap))
- (flymake-make-overlay beg end tooltip-text face nil)))
+ (flymake-make-overlay beg end tooltip-text face bitmap nil)))
(defun flymake-parse-err-lines (err-info-list lines)
"Parse err LINES, store info in ERR-INFO-LIST."
@@ -947,6 +994,9 @@ from compile.el")
;; :type '(repeat (string number number number))
;;)
+(defvar flymake-warning-re "^[wW]arning"
+ "Regexp matching against err-text to detect a warning.")
+
(defun flymake-parse-line (line)
"Parse LINE to see if it is an error or warning.
Return its components if so, nil otherwise."
@@ -967,7 +1017,7 @@ Return its components if so, nil otherwise."
(match-string (nth 4 (car patterns)) line)
(flymake-patch-err-text (substring line (match-end 0)))))
(or err-text (setq err-text "<no error text>"))
- (if (and err-text (string-match "^[wW]arning" err-text))
+ (if (and err-text (string-match flymake-warning-re err-text))
(setq err-type "w")
)
(flymake-log 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" file-idx line-idx
@@ -1331,9 +1381,10 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
;;;###autoload
(define-minor-mode flymake-mode
- "Minor mode to do on-the-fly syntax checking.
-When called interactively, toggles the minor mode.
-With arg, turn Flymake mode on if and only if arg is positive."
+ "Toggle on-the-fly syntax checking.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
:group 'flymake :lighter flymake-mode-line
(cond
@@ -1355,8 +1406,12 @@ With arg, turn Flymake mode on if and only if arg is positive."
(setq flymake-timer
(run-at-time nil 1 'flymake-on-timer-event (current-buffer)))
- (when flymake-start-syntax-check-on-find-file
- (flymake-start-syntax-check)))))
+ (when (and flymake-start-syntax-check-on-find-file
+ ;; Since we write temp files in current dir, there's no point
+ ;; trying if the directory is read-only (bug#8954).
+ (file-writable-p (file-name-directory buffer-file-name)))
+ (with-demoted-errors
+ (flymake-start-syntax-check))))))
;; Turning the mode OFF.
(t
@@ -1494,10 +1549,11 @@ With arg, turn Flymake mode on if and only if arg is positive."
(error "Invalid file-name"))
(or prefix
(setq prefix "flymake"))
- (let* ((temp-name (concat (file-name-sans-extension file-name)
- "_" prefix
- (and (file-name-extension file-name)
- (concat "." (file-name-extension file-name))))))
+ (let* ((ext (file-name-extension file-name))
+ (temp-name (file-truename
+ (concat (file-name-sans-extension file-name)
+ "_" prefix
+ (and ext (concat "." ext))))))
(flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name)
temp-name))
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 2dac46a6d5b..665b0767b2c 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -1,6 +1,6 @@
;;; fortran.el --- Fortran mode for GNU Emacs
-;; Copyright (C) 1986, 1993-1995, 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1993-1995, 1997-2012 Free Software Foundation, Inc.
;; Author: Michael D. Prange <prange@erl.mit.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
@@ -165,7 +165,7 @@ allow trailing comments on a line."
(defcustom fortran-directive-re
"^[ \t]*#.*"
"Regexp to match a directive line.
-The matching text will be fontified with `font-lock-keyword-face'.
+The matching text will be fontified with `font-lock-preprocessor-face'.
The matching line will be given zero indentation."
:version "22.1"
:type 'regexp
@@ -452,7 +452,7 @@ The only difference is, it returns t in a case when the default returns nil."
;; Standard continuation character and in a TAB-formatted line.
'("^ \\{5\\}\\([^ 0\n]\\)" 1 font-lock-string-face)
'("^\t\\([1-9]\\)" 1 font-lock-string-face))
- `((,fortran-directive-re (0 font-lock-keyword-face t)))
+ `((,fortran-directive-re (0 font-lock-preprocessor-face t)))
;; `fortran-font-lock-keywords-2' without types (see above).
(cdr (nthcdr (length fortran-font-lock-keywords-1)
fortran-font-lock-keywords-2)))
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 128ff4bb143..805ffa36e4e 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -1,6 +1,6 @@
;;; gdb-mi.el --- User Interface for running GDB
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Nick Roberts <nickrob@gnu.org>
;; Maintainer: FSF
@@ -26,7 +26,7 @@
;;; Credits:
;; This file was written by Nick Roberts following the general design
-;; used in gdb-ui.el for Emacs 22.1 - 23.1. It is currently being developed
+;; used in gdb-ui.el for Emacs 22.1 - 23.1. It was further developed
;; by Dmitry Dzhus <dima@sphinx.net.ru> as part of the Google Summer
;; of Code 2009 Project "Emacs GDB/MI migration".
@@ -45,7 +45,7 @@
;; This file uses GDB/MI as the primary interface to GDB. It runs gdb with
;; GDB/MI (-interp=mi) and access CLI using "-interpreter-exec console
-;; cli-command". This code works without gdb-ui.el and uses MI tokens instead
+;; cli-command". This code replaces gdb-ui.el and uses MI tokens instead
;; of queues. Eventually MI should be asynchronous.
;; Windows Platforms:
@@ -91,7 +91,7 @@
(require 'gud)
(require 'json)
(require 'bindat)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(declare-function speedbar-change-initial-expansion-list
"speedbar" (new-default))
@@ -375,9 +375,8 @@ Emacs always switches to the thread which caused the stop."
:version "23.2"
:link '(info-link "(gdb)GDB/MI Async Records"))
-(defcustom gdb-stopped-hooks nil
- "This variable holds a list of functions to be called whenever
-GDB stops.
+(defcustom gdb-stopped-functions nil
+ "List of functions called whenever GDB stops.
Each function takes one argument, a parsed MI response, which
contains fields of corresponding MI *stopped async record:
@@ -460,9 +459,14 @@ Most recent commands are listed first. This list stores only the last
`gdb-debug-log-max' values. This variable is used to debug GDB-MI.")
;;;###autoload
-(defcustom gdb-enable-debug nil
- "Non-nil means record the process input and output in `gdb-debug-log'."
- :type 'boolean
+(define-minor-mode gdb-enable-debug
+ "Toggle logging of transaction between Emacs and Gdb.
+The log is stored in `gdb-debug-log' as an alist with elements
+whose cons is send, send-item or recv and whose cdr is the string
+being transferred. This list may grow up to a size of
+`gdb-debug-log-max' after which the oldest element (at the end of
+the list) is deleted every time a new one is added (at the front)."
+ :global t
:group 'gdb
:version "22.1")
@@ -513,21 +517,6 @@ Also display the main routine in the disassembly buffer if present."
;; Force mode line redisplay soon.
(force-mode-line-update)))))
-(defun gdb-enable-debug (arg)
- "Toggle logging of transaction between Emacs and Gdb.
-The log is stored in `gdb-debug-log' as an alist with elements
-whose cons is send, send-item or recv and whose cdr is the string
-being transferred. This list may grow up to a size of
-`gdb-debug-log-max' after which the oldest element (at the end of
-the list) is deleted every time a new one is added (at the front)."
- (interactive "P")
- (setq gdb-enable-debug
- (if (null arg)
- (not gdb-enable-debug)
- (> (prefix-numeric-value arg) 0)))
- (message (format "Logging of transaction %sabled"
- (if gdb-enable-debug "en" "dis"))))
-
;; These two are used for menu and toolbar
(defun gdb-control-all-threads ()
"Switch to non-stop/A mode."
@@ -604,6 +593,8 @@ NOARG must be t when this macro is used outside `gud-def'"
(set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter))
(funcall filter proc string))))
+(defvar gdb-control-level 0)
+
;;;###autoload
(defun gdb (command-line)
"Run gdb on program FILE in buffer *gud-FILE*.
@@ -678,6 +669,7 @@ detailed description of this mode.
(set-process-filter proc #'gdb--check-interpreter))
(set (make-local-variable 'gud-minor-mode) 'gdbmi)
+ (set (make-local-variable 'gdb-control-level) 0)
(setq comint-input-sender 'gdb-send)
(when (ring-empty-p comint-input-ring) ; cf shell-mode
(let ((hfile (expand-file-name (or (getenv "GDBHISTFILE")
@@ -779,9 +771,9 @@ detailed description of this mode.
(gud-def gud-pp
(gud-call
(concat
- "pp1 " (if (eq (buffer-local-value
- 'major-mode (window-buffer)) 'speedbar-mode)
- (gdb-find-watch-expression) "%e")) arg)
+ "pp " (if (eq (buffer-local-value
+ 'major-mode (window-buffer)) 'speedbar-mode)
+ (gdb-find-watch-expression) "%e")) arg)
nil "Print the Emacs s-expression.")
(define-key gud-minor-mode-map [left-margin mouse-1]
@@ -818,6 +810,8 @@ detailed description of this mode.
nil 'local)
(local-set-key "\C-i" 'completion-at-point)
+ (local-set-key [remap comint-delchar-or-maybe-eof] 'gdb-delchar-or-quit)
+
(setq gdb-first-prompt t)
(setq gud-running nil)
@@ -826,7 +820,7 @@ detailed description of this mode.
(run-hooks 'gdb-mode-hook))
(defun gdb-init-1 ()
- ;; (re-)initialize
+ ;; (Re-)initialize.
(setq gdb-selected-frame nil
gdb-frame-number nil
gdb-thread-number nil
@@ -859,17 +853,15 @@ detailed description of this mode.
(gdb-get-buffer-create 'gdb-inferior-io)
(gdb-clear-inferior-io)
- (set-process-filter (get-process "gdb-inferior") 'gdb-inferior-filter)
- (gdb-input
- ;; Needs GDB 6.4 onwards
- (concat "-inferior-tty-set "
- (or
- ;; The process can run on a remote host.
- (process-get (get-process "gdb-inferior") 'remote-tty)
- (process-tty-name (get-process "gdb-inferior"))))
- 'ignore)
- (if (eq window-system 'w32)
- (gdb-input "-gdb-set new-console off" 'ignore))
+ (gdb-inferior-io--init-proc (get-process "gdb-inferior"))
+
+ (when (eq system-type 'windows-nt)
+ ;; Don't create a separate console window for the debuggee.
+ (gdb-input "-gdb-set new-console off" 'ignore)
+ ;; Force GDB to behave as if its input and output stream were
+ ;; connected to a TTY device (since on Windows we use pipes for
+ ;; communicating with GDB).
+ (gdb-input "-gdb-set interactive-mode on" 'ignore))
(gdb-input "-gdb-set height 0" 'ignore)
(when gdb-non-stop
@@ -877,7 +869,7 @@ detailed description of this mode.
(gdb-input "-enable-pretty-printing" 'ignore)
- ;; find source file and compilation directory here
+ ;; Find source file and compilation directory here.
(if gdb-create-source-file-list
;; Needs GDB 6.2 onwards.
(gdb-input "-file-list-exec-source-files" 'gdb-get-source-file-list))
@@ -905,6 +897,25 @@ detailed description of this mode.
(setq gdb-non-stop nil)
(gdb-input "-gdb-set non-stop 0" 'ignore)))
+(defun gdb-delchar-or-quit (arg)
+ "Delete ARG characters or send a quit command to GDB.
+Send a quit only if point is at the end of the buffer, there is
+no input, and GDB is waiting for input."
+ (interactive "p")
+ (unless (and (eq (current-buffer) gud-comint-buffer)
+ (eq gud-minor-mode 'gdbmi))
+ (error "Not in a GDB-MI buffer"))
+ (let ((proc (get-buffer-process gud-comint-buffer)))
+ (if (and (eobp) proc (process-live-p proc)
+ (not gud-running)
+ (= (point) (marker-position (process-mark proc))))
+ ;; Sending an EOF does not work with GDB-MI; submit an
+ ;; explicit quit command.
+ (progn
+ (insert "quit")
+ (comint-send-input t t))
+ (delete-char arg))))
+
(defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.")
(defun gdb-create-define-alist ()
@@ -929,16 +940,20 @@ detailed description of this mode.
(push (cons name define) gdb-define-alist))))
(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
-(defvar tooltip-use-echo-area)
(defun gdb-tooltip-print (expr)
(with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
(goto-char (point-min))
- (if (re-search-forward ".*value=\\(\".*\"\\)" nil t)
- (tooltip-show
- (concat expr " = " (read (match-string 1)))
- (or gud-tooltip-echo-area tooltip-use-echo-area
- (not (display-graphic-p)))))))
+ (cond
+ ((re-search-forward ".*value=\\(\".*\"\\)" nil t)
+ (tooltip-show
+ (concat expr " = " (read (match-string 1)))
+ (or gud-tooltip-echo-area
+ (not (display-graphic-p)))))
+ ((re-search-forward "msg=\\(\".+\"\\)$" nil t)
+ (tooltip-show (read (match-string 1))
+ (or gud-tooltip-echo-area
+ (not (display-graphic-p))))))))
;; If expr is a macro for a function don't print because of possible dangerous
;; side-effects. Also printing a function within a tooltip generates an
@@ -948,7 +963,7 @@ detailed description of this mode.
(goto-char (point-min))
(if (search-forward "expands to: " nil t)
(unless (looking-at "\\S-+.*(.*).*")
- (gdb-input (concat "-data-evaluate-expression " expr)
+ (gdb-input (concat "-data-evaluate-expression \"" expr "\"")
`(lambda () (gdb-tooltip-print ,expr)))))))
(defun gdb-init-buffer ()
@@ -959,15 +974,17 @@ detailed description of this mode.
(gdb-create-define-alist)
(add-hook 'after-save-hook 'gdb-create-define-alist nil t)))
-(defmacro gdb-if-arrow (arrow-position &rest body)
- `(if ,arrow-position
- (let ((buffer (marker-buffer ,arrow-position)) (line))
- (if (equal buffer (window-buffer (posn-window end)))
- (with-current-buffer buffer
- (when (or (equal start end)
- (equal (posn-point start)
- (marker-position ,arrow-position)))
- ,@body))))))
+(defmacro gdb--if-arrow (arrow-position start-posn end-posn &rest body)
+ (declare (indent 3))
+ (let ((buffer (make-symbol "buffer")))
+ `(if ,arrow-position
+ (let ((,buffer (marker-buffer ,arrow-position)))
+ (if (equal ,buffer (window-buffer (posn-window ,end-posn)))
+ (with-current-buffer ,buffer
+ (when (or (equal ,start-posn ,end-posn)
+ (equal (posn-point ,start-posn)
+ (marker-position ,arrow-position)))
+ ,@body)))))))
(defun gdb-mouse-until (event)
"Continue running until a source line past the current line.
@@ -977,15 +994,15 @@ with mouse-1 (default bindings)."
(interactive "e")
(let ((start (event-start event))
(end (event-end event)))
- (gdb-if-arrow gud-overlay-arrow-position
- (setq line (line-number-at-pos (posn-point end)))
- (gud-call (concat "until " (number-to-string line))))
- (gdb-if-arrow gdb-disassembly-position
- (save-excursion
- (goto-char (point-min))
- (forward-line (1- (line-number-at-pos (posn-point end))))
- (forward-char 2)
- (gud-call (concat "until *%a"))))))
+ (gdb--if-arrow gud-overlay-arrow-position start end
+ (let ((line (line-number-at-pos (posn-point end))))
+ (gud-call (concat "until " (number-to-string line)))))
+ (gdb--if-arrow gdb-disassembly-position start end
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- (line-number-at-pos (posn-point end))))
+ (forward-char 2)
+ (gud-call (concat "until *%a"))))))
(defun gdb-mouse-jump (event)
"Set execution address/line.
@@ -996,19 +1013,17 @@ line, and no execution takes place."
(interactive "e")
(let ((start (event-start event))
(end (event-end event)))
- (gdb-if-arrow gud-overlay-arrow-position
- (setq line (line-number-at-pos (posn-point end)))
- (progn
- (gud-call (concat "tbreak " (number-to-string line)))
- (gud-call (concat "jump " (number-to-string line)))))
- (gdb-if-arrow gdb-disassembly-position
- (save-excursion
- (goto-char (point-min))
- (forward-line (1- (line-number-at-pos (posn-point end))))
- (forward-char 2)
- (progn
- (gud-call (concat "tbreak *%a"))
- (gud-call (concat "jump *%a")))))))
+ (gdb--if-arrow gud-overlay-arrow-position start end
+ (let ((line (line-number-at-pos (posn-point end))))
+ (gud-call (concat "tbreak " (number-to-string line)))
+ (gud-call (concat "jump " (number-to-string line)))))
+ (gdb--if-arrow gdb-disassembly-position start end
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- (line-number-at-pos (posn-point end))))
+ (forward-char 2)
+ (gud-call (concat "tbreak *%a"))
+ (gud-call (concat "jump *%a"))))))
(defcustom gdb-show-changed-values t
"If non-nil change the face of out of scope variables and changed values.
@@ -1030,10 +1045,11 @@ Changed values are highlighted with the face `font-lock-warning-face'."
:group 'gdb
:version "22.2")
-(defcustom gdb-speedbar-auto-raise nil
- "If non-nil raise speedbar every time display of watch expressions is\
- updated."
- :type 'boolean
+(define-minor-mode gdb-speedbar-auto-raise
+ "Minor mode to automatically raise the speedbar for watch expressions.
+With prefix argument ARG, automatically raise speedbar if ARG is
+positive, otherwise don't automatically raise it."
+ :global t
:group 'gdb
:version "22.1")
@@ -1043,20 +1059,8 @@ Changed values are highlighted with the face `font-lock-warning-face'."
:group 'gdb
:version "22.1")
-(defun gdb-speedbar-auto-raise (arg)
- "Toggle automatic raising of the speedbar for watch expressions.
-With prefix argument ARG, automatically raise speedbar if ARG is
-positive, otherwise don't automatically raise it."
- (interactive "P")
- (setq gdb-speedbar-auto-raise
- (if (null arg)
- (not gdb-speedbar-auto-raise)
- (> (prefix-numeric-value arg) 0)))
- (message (format "Auto raising %sabled"
- (if gdb-speedbar-auto-raise "en" "dis"))))
-
(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch)
-(define-key global-map (concat gud-key-prefix "\C-w") 'gud-watch)
+(define-key global-map (vconcat gud-key-prefix "\C-w") 'gud-watch)
(declare-function tooltip-identifier-from-point "tooltip" (point))
@@ -1192,8 +1196,8 @@ With arg, enter name of variable to be watched in the minibuffer."
(defun gdb-edit-value (_text _token _indent)
"Assign a value to a variable displayed in the speedbar."
(let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
- (varnum (car var)) (value))
- (setq value (read-string "New value: "))
+ (varnum (car var))
+ (value (read-string "New value: ")))
(gdb-input (concat "-var-assign " varnum " " value)
`(lambda () (gdb-edit-value-handler ,value)))))
@@ -1409,29 +1413,6 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
(with-current-buffer ,buffer
(apply ',expr args))))
-;; Used to define all gdb-frame-*-buffer functions except
-;; `gdb-frame-io-buffer'
-(defmacro def-gdb-frame-for-buffer (name buffer &optional doc)
- "Define a function NAME which shows gdb BUFFER in a separate frame.
-
-DOC is an optional documentation string."
- `(defun ,name (&optional thread)
- ,(when doc doc)
- (interactive)
- (let ((special-display-regexps (append special-display-regexps '(".*")))
- (special-display-frame-alist gdb-frame-parameters))
- (display-buffer (gdb-get-buffer-create ,buffer thread)))))
-
-(defmacro def-gdb-display-buffer (name buffer &optional doc)
- "Define a function NAME which shows gdb BUFFER.
-
-DOC is an optional documentation string."
- `(defun ,name (&optional thread)
- ,(when doc doc)
- (interactive)
- (gdb-display-buffer
- (gdb-get-buffer-create ,buffer thread) t)))
-
;; Used to display windows with thread-bound buffers
(defmacro def-gdb-preempt-display-buffer (name buffer &optional doc
split-horizontal)
@@ -1507,22 +1488,55 @@ DOC is an optional documentation string."
(defun gdb-display-io-buffer ()
"Display IO of debugged program in a separate window."
(interactive)
- (gdb-display-buffer
- (gdb-get-buffer-create 'gdb-inferior-io) t))
-
-(defconst gdb-frame-parameters
- '((height . 14) (width . 80)
- (unsplittable . t)
- (tool-bar-lines . nil)
- (menu-bar-lines . nil)
- (minibuffer . nil)))
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))
+
+(defun gdb-inferior-io--init-proc (proc)
+ ;; Set up inferior I/O. Needs GDB 6.4 onwards.
+ (set-process-filter proc 'gdb-inferior-filter)
+ (set-process-sentinel proc 'gdb-inferior-io-sentinel)
+ ;; The process can run on a remote host.
+ (let ((tty (or (process-get proc 'remote-tty)
+ (process-tty-name proc))))
+ (unless (or (null tty)
+ (string= tty ""))
+ (gdb-input
+ (concat "-inferior-tty-set " tty) 'ignore))))
+
+(defun gdb-inferior-io-sentinel (proc str)
+ (when (eq (process-status proc) 'failed)
+ ;; When the debugged process exits, Emacs gets an EIO error on
+ ;; read from the pty, and stops listening to it. If the gdb
+ ;; process is still running, remove the pty, make a new one, and
+ ;; pass it to gdb.
+ (let ((gdb-proc (get-buffer-process gud-comint-buffer))
+ (io-buffer (process-buffer proc)))
+ (when (and gdb-proc (process-live-p gdb-proc)
+ (buffer-live-p io-buffer))
+ ;; `comint-exec' deletes the original process as a side effect.
+ (comint-exec io-buffer "gdb-inferior" nil nil nil)
+ (gdb-inferior-io--init-proc (get-buffer-process io-buffer))))))
+
+(defcustom gdb-display-buffer-other-frame-action
+ '((display-buffer-reuse-window display-buffer-pop-up-frame)
+ (reusable-frames . visible)
+ (inhibit-same-window . t)
+ (pop-up-frame-parameters (height . 14)
+ (width . 80)
+ (unsplittable . t)
+ (tool-bar-lines . nil)
+ (menu-bar-lines . nil)
+ (minibuffer . nil)))
+ "`display-buffer' action for displaying GDB utility frames."
+ :group 'gdb
+ :type display-buffer--action-custom-type
+ :risky t
+ :version "24.3")
(defun gdb-frame-io-buffer ()
- "Display IO of debugged program in a new frame."
+ "Display IO of debugged program in another frame."
(interactive)
- (let ((special-display-regexps (append special-display-regexps '(".*")))
- (special-display-frame-alist gdb-frame-parameters))
- (display-buffer (gdb-get-buffer-create 'gdb-inferior-io))))
+ (display-buffer (gdb-get-buffer-create 'gdb-inferior-io)
+ gdb-display-buffer-other-frame-action))
(defvar gdb-inferior-io-mode-map
(let ((map (make-sparse-keymap)))
@@ -1541,7 +1555,7 @@ DOC is an optional documentation string."
(defun gdb-inferior-filter (proc string)
(unless (string-equal string "")
- (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io) t))
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))
(with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
(comint-output-filter proc string)))
@@ -1663,6 +1677,16 @@ static char *magick[] = {
:group 'gdb)
+(defvar gdb-control-commands-regexp
+ (concat
+ "^\\("
+ "commands\\|if\\|while\\|define\\|document\\|python\\|"
+ "while-stepping\\|stepping\\|ws\\|actions"
+ "\\)\\([[:blank:]]+.*\\)?$")
+ "Regexp matching GDB commands that enter a recursive reading loop.
+As long as GDB is in the recursive reading loop, it does not expect
+commands to be prefixed by \"-interpreter-exec console\".")
+
(defun gdb-send (proc string)
"A comint send filter for gdb."
(with-current-buffer gud-comint-buffer
@@ -1672,20 +1696,39 @@ static char *magick[] = {
(if (not (string= "" string))
(setq gdb-last-command string)
(if gdb-last-command (setq string gdb-last-command)))
- (if gdb-enable-debug
- (push (cons 'mi-send (concat string "\n")) gdb-debug-log))
- (if (string-match "^-" string)
- ;; MI command
+ (if (or (string-match "^-" string)
+ (> gdb-control-level 0))
+ ;; Either MI command or we are feeding GDB's recursive reading loop.
(progn
(setq gdb-first-done-or-error t)
- (process-send-string proc (concat string "\n")))
+ (process-send-string proc (concat string "\n"))
+ (if (and (string-match "^end$" string)
+ (> gdb-control-level 0))
+ (setq gdb-control-level (1- gdb-control-level))))
;; CLI command
(if (string-match "\\\\$" string)
(setq gdb-continuation (concat gdb-continuation string "\n"))
(setq gdb-first-done-or-error t)
- (process-send-string proc (concat "-interpreter-exec console \""
- gdb-continuation string "\"\n"))
- (setq gdb-continuation nil))))
+ (let ((to-send (concat "-interpreter-exec console "
+ (gdb-mi-quote string)
+ "\n")))
+ (if gdb-enable-debug
+ (push (cons 'mi-send to-send) gdb-debug-log))
+ (process-send-string proc to-send))
+ (if (and (string-match "^end$" string)
+ (> gdb-control-level 0))
+ (setq gdb-control-level (1- gdb-control-level)))
+ (setq gdb-continuation nil)))
+ (if (string-match gdb-control-commands-regexp string)
+ (setq gdb-control-level (1+ gdb-control-level))))
+
+(defun gdb-mi-quote (string)
+ "Return STRING quoted properly as an MI argument.
+The string is enclosed in double quotes.
+All embedded quotes, newlines, and backslashes are preceded with a backslash."
+ (setq string (replace-regexp-in-string "\\([\"\\]\\)" "\\\\\\&" string))
+ (setq string (replace-regexp-in-string "\n" "\\n" string t t))
+ (concat "\"" string "\""))
(defun gdb-input (command handler-function)
"Send COMMAND to GDB via the MI interface.
@@ -1736,24 +1779,27 @@ If `gdb-thread-number' is nil, just wrap NAME in asterisks."
(setq gdb-output-sink 'user)
(setq gdb-pending-triggers nil))
-(defun gdb-update ()
- "Update buffers showing status of debug session."
+(defun gdb-update (&optional no-proc)
+ "Update buffers showing status of debug session.
+If NO-PROC is non-nil, do not try to contact the GDB process."
(when gdb-first-prompt
(gdb-force-mode-line-update
(propertize "initializing..." 'face font-lock-variable-name-face))
(gdb-init-1)
(setq gdb-first-prompt nil))
- (gdb-get-main-selected-frame)
+ (unless no-proc
+ (gdb-get-main-selected-frame))
+
;; We may need to update gdb-threads-list so we can use
(gdb-get-buffer-create 'gdb-threads-buffer)
;; gdb-break-list is maintained in breakpoints handler
(gdb-get-buffer-create 'gdb-breakpoints-buffer)
- (gdb-emit-signal gdb-buf-publisher 'update)
+ (unless no-proc
+ (gdb-emit-signal gdb-buf-publisher 'update))
(gdb-get-changed-registers)
-
(when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
(dolist (var gdb-var-list)
(setcar (nthcdr 5 var) nil))
@@ -1788,7 +1834,7 @@ is running."
(setq gud-running
(string= (bindat-get-field (gdb-current-buffer-thread) 'state)
"running"))
- ;; Set frame number to "0" when _current_ threads stops
+ ;; Set frame number to "0" when _current_ threads stops.
(when (and (gdb-current-buffer-thread)
(not (eq gud-running old-value)))
(setq gdb-frame-number "0"))))
@@ -1856,10 +1902,10 @@ is running."
(> (length gdb-debug-log) gdb-debug-log-max))
(setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil)))
- ;; Recall the left over gud-marker-acc from last time
+ ;; Recall the left over gud-marker-acc from last time.
(setq gud-marker-acc (concat gud-marker-acc string))
- ;; Start accumulating output for the GUD buffer
+ ;; Start accumulating output for the GUD buffer.
(setq gdb-filter-output "")
(let (output-record-list)
@@ -1905,9 +1951,8 @@ is running."
(defun gdb-gdb (_output-field))
(defun gdb-shell (output-field)
- (let ((gdb-output-sink gdb-output-sink))
- (setq gdb-filter-output
- (concat output-field gdb-filter-output))))
+ (setq gdb-filter-output
+ (concat output-field gdb-filter-output)))
(defun gdb-ignored-notification (_output-field))
@@ -1991,14 +2036,15 @@ current thread and update GDB buffers."
(concat " --thread " thread-id)))
'gdb-register-names-handler))
-;;; Don't set gud-last-frame here as it's currently done in gdb-frame-handler
-;;; because synchronous GDB doesn't give these fields with CLI.
-;;; (when file
-;;; (setq
-;;; ;; Extract the frame position from the marker.
-;;; gud-last-frame (cons file
-;;; (string-to-number
-;;; (match-string 6 gud-marker-acc)))))
+ ;; Don't set gud-last-frame here as it's currently done in
+ ;; gdb-frame-handler because synchronous GDB doesn't give these fields
+ ;; with CLI.
+ ;;(when file
+ ;; (setq
+ ;; ;; Extract the frame position from the marker.
+ ;; gud-last-frame (cons file
+ ;; (string-to-number
+ ;; (match-string 6 gud-marker-acc)))))
(setq gdb-inferior-status (or reason "unknown"))
(gdb-force-mode-line-update
@@ -2035,7 +2081,7 @@ current thread and update GDB buffers."
;; In all-stop this updates gud-running properly as well.
(gdb-update)
(setq gdb-first-done-or-error nil))
- (run-hook-with-args 'gdb-stopped-hooks result)))
+ (run-hook-with-args 'gdb-stopped-functions result)))
;; Remove the trimmings from log stream containing debugging messages
;; being produced by GDB's internals, use warning face and send to GUD
@@ -2044,13 +2090,15 @@ current thread and update GDB buffers."
(setq gdb-filter-output
(gdb-concat-output
gdb-filter-output
- (let ((error-message
- (read output-field)))
- (put-text-property
- 0 (length error-message)
- 'face font-lock-warning-face
- error-message)
- error-message))))
+ (if (string= output-field "\"\\n\"")
+ ""
+ (let ((error-message
+ (read output-field)))
+ (put-text-property
+ 0 (length error-message)
+ 'face font-lock-warning-face
+ error-message)
+ error-message)))))
;; Remove the trimmings from the console stream and send to GUD buffer
;; (frontend MI commands should not print to this stream)
@@ -2075,23 +2123,28 @@ current thread and update GDB buffers."
(setq gdb-output-sink 'emacs))
(gdb-clear-partial-output)
- (when gdb-first-done-or-error
- (unless (or token-number gud-running)
- (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
- (gdb-update)
- (setq gdb-first-done-or-error nil))
- (setq gdb-filter-output
- (gdb-concat-output gdb-filter-output output-field))
+ ;; The process may already be dead (e.g. C-d at the gdb prompt).
+ (let* ((proc (get-buffer-process gud-comint-buffer))
+ (no-proc (or (null proc)
+ (memq (process-status proc) '(exit signal)))))
- (if token-number
- (progn
- (with-current-buffer
- (gdb-get-buffer-create 'gdb-partial-output-buffer)
- (funcall
- (cdr (assoc (string-to-number token-number) gdb-handler-alist))))
- (setq gdb-handler-alist
- (assq-delete-all token-number gdb-handler-alist)))))
+ (when gdb-first-done-or-error
+ (unless (or token-number gud-running no-proc)
+ (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
+ (gdb-update no-proc)
+ (setq gdb-first-done-or-error nil))
+
+ (setq gdb-filter-output
+ (gdb-concat-output gdb-filter-output output-field))
+
+ (when token-number
+ (with-current-buffer
+ (gdb-get-buffer-create 'gdb-partial-output-buffer)
+ (funcall
+ (cdr (assoc (string-to-number token-number) gdb-handler-alist))))
+ (setq gdb-handler-alist
+ (assq-delete-all token-number gdb-handler-alist)))))
(defun gdb-concat-output (so-far new)
(cond
@@ -2208,8 +2261,7 @@ Return position where LINE begins."
;; gdb-table struct is a way to programmatically construct simple
;; tables. It help to reliably align columns of data in GDB buffers
;; and provides
-(defstruct
- gdb-table
+(cl-defstruct gdb-table
(column-sizes nil)
(rows nil)
(row-properties nil)
@@ -2277,8 +2329,9 @@ calling `gdb-table-string'."
(defun gdb-get-many-fields (struct &rest fields)
"Return a list of FIELDS values from STRUCT."
(let ((values))
- (dolist (field fields values)
- (setq values (append values (list (bindat-get-field struct field)))))))
+ (dolist (field fields)
+ (push (bindat-get-field struct field) values))
+ (nreverse values)))
(defmacro def-gdb-auto-update-trigger (trigger-name gdb-command
handler-name
@@ -2387,15 +2440,15 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See
(gdb-table-add-row table
(list
(bindat-get-field breakpoint 'number)
- type
- (bindat-get-field breakpoint 'disp)
+ (or type "")
+ (or (bindat-get-field breakpoint 'disp) "")
(let ((flag (bindat-get-field breakpoint 'enabled)))
(if (string-equal flag "y")
(propertize "y" 'font-lock-face font-lock-warning-face)
(propertize "n" 'font-lock-face font-lock-comment-face)))
(bindat-get-field breakpoint 'addr)
- (bindat-get-field breakpoint 'times)
- (if (string-match ".*watchpoint" type)
+ (or (bindat-get-field breakpoint 'times) "")
+ (if (and type (string-match ".*watchpoint" type))
(bindat-get-field breakpoint 'what)
(or pending at
(concat "in "
@@ -2426,20 +2479,23 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See
(let ((file (bindat-get-field breakpoint 'fullname))
(flag (bindat-get-field breakpoint 'enabled))
(bptno (bindat-get-field breakpoint 'number)))
- (unless (file-exists-p file)
+ (unless (and file (file-exists-p file))
(setq file (cdr (assoc bptno gdb-location-alist))))
- (if (and file
- (not (string-equal file "File not found")))
- (with-current-buffer
- (find-file-noselect file 'nowarn)
- (gdb-init-buffer)
- ;; Only want one breakpoint icon at each location.
- (gdb-put-breakpoint-icon (string-equal flag "y") bptno
- (string-to-number line)))
- (gdb-input (concat "list " file ":1") 'ignore)
- (gdb-input "-file-list-exec-source-file"
- `(lambda () (gdb-get-location
- ,bptno ,line ,flag)))))))))
+ (if (or (null file)
+ (string-equal file "File not found"))
+ ;; If the full filename is not recorded in the
+ ;; breakpoint structure or in `gdb-location-alist', use
+ ;; -file-list-exec-source-file to extract it.
+ (when (setq file (bindat-get-field breakpoint 'file))
+ (gdb-input (concat "list " file ":1") 'ignore)
+ (gdb-input "-file-list-exec-source-file"
+ `(lambda () (gdb-get-location
+ ,bptno ,line ,flag))))
+ (with-current-buffer (find-file-noselect file 'nowarn)
+ (gdb-init-buffer)
+ ;; Only want one breakpoint icon at each location.
+ (gdb-put-breakpoint-icon (string-equal flag "y") bptno
+ (string-to-number line)))))))))
(defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"")
@@ -2543,15 +2599,16 @@ If not in a source or disassembly buffer just set point."
(defun gdb-breakpoints-buffer-name ()
(concat "*breakpoints of " (gdb-get-target-string) "*"))
-(def-gdb-display-buffer
- gdb-display-breakpoints-buffer
- 'gdb-breakpoints-buffer
- "Display status of user-settable breakpoints.")
+(defun gdb-display-breakpoints-buffer (&optional thread)
+ "Display GDB breakpoints."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-breakpoints-buffer thread)))
-(def-gdb-frame-for-buffer
- gdb-frame-breakpoints-buffer
- 'gdb-breakpoints-buffer
- "Display status of user-settable breakpoints in a new frame.")
+(defun gdb-frame-breakpoints-buffer (&optional thread)
+ "Display GDB breakpoints in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-breakpoints-buffer thread)
+ gdb-display-buffer-other-frame-action))
(defvar gdb-breakpoints-mode-map
(let ((map (make-sparse-keymap))
@@ -2612,15 +2669,16 @@ corresponding to the mode line clicked."
(defun gdb-threads-buffer-name ()
(concat "*threads of " (gdb-get-target-string) "*"))
-(def-gdb-display-buffer
- gdb-display-threads-buffer
- 'gdb-threads-buffer
- "Display GDB threads.")
+(defun gdb-display-threads-buffer (&optional thread)
+ "Display GDB threads."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-threads-buffer thread)))
-(def-gdb-frame-for-buffer
- gdb-frame-threads-buffer
- 'gdb-threads-buffer
- "Display GDB threads in a new frame.")
+(defun gdb-frame-threads-buffer (&optional thread)
+ "Display GDB threads in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-threads-buffer thread)
+ gdb-display-buffer-other-frame-action))
(def-gdb-trigger-and-handler
gdb-invalidate-threads (gdb-current-context-command "-thread-info")
@@ -2695,9 +2753,9 @@ corresponding to the mode line clicked."
(add-to-list 'gdb-threads-list
(cons (bindat-get-field thread 'id)
thread))
- (if running
- (incf gdb-running-threads-count)
- (incf gdb-stopped-threads-count))
+ (cl-incf (if running
+ gdb-running-threads-count
+ gdb-stopped-threads-count))
(gdb-table-add-row table
(list
@@ -2796,26 +2854,22 @@ on the current line."
(def-gdb-thread-buffer-simple-command
gdb-frame-stack-for-thread
gdb-frame-stack-buffer
- "Display a new frame with stack buffer for the thread at
-current line.")
+ "Display another frame with stack buffer for thread at current line.")
(def-gdb-thread-buffer-simple-command
gdb-frame-locals-for-thread
gdb-frame-locals-buffer
- "Display a new frame with locals buffer for the thread at
-current line.")
+ "Display another frame with locals buffer for thread at current line.")
(def-gdb-thread-buffer-simple-command
gdb-frame-registers-for-thread
gdb-frame-registers-buffer
- "Display a new frame with registers buffer for the thread at
-current line.")
+ "Display another frame with registers buffer for the thread at current line.")
(def-gdb-thread-buffer-simple-command
gdb-frame-disassembly-for-thread
gdb-frame-disassembly-buffer
- "Display a new frame with disassembly buffer for the thread at
-current line.")
+ "Display another frame with disassembly buffer for the thread at current line.")
(defmacro def-gdb-thread-buffer-gud-command (name gud-command &optional doc)
"Define a NAME which will execute GUD-COMMAND with
@@ -3218,21 +3272,16 @@ DOC is an optional documentation string."
(defun gdb-memory-buffer-name ()
(concat "*memory of " (gdb-get-target-string) "*"))
-(def-gdb-display-buffer
- gdb-display-memory-buffer
- 'gdb-memory-buffer
- "Display memory contents.")
+(defun gdb-display-memory-buffer (&optional thread)
+ "Display GDB memory contents."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-memory-buffer thread)))
(defun gdb-frame-memory-buffer ()
- "Display memory contents in a new frame."
+ "Display memory contents in another frame."
(interactive)
- (let* ((special-display-regexps (append special-display-regexps '(".*")))
- (special-display-frame-alist
- `((left-fringe . 0)
- (right-fringe . 0)
- (width . 83)
- ,@gdb-frame-parameters)))
- (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer))))
+ (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer)
+ gdb-display-buffer-other-frame-action))
;;; Disassembly view
@@ -3241,26 +3290,31 @@ DOC is an optional documentation string."
(gdb-current-context-buffer-name
(concat "disassembly of " (gdb-get-target-string))))
-(def-gdb-display-buffer
- gdb-display-disassembly-buffer
- 'gdb-disassembly-buffer
- "Display disassembly for current stack frame.")
+(defun gdb-display-disassembly-buffer (&optional thread)
+ "Display GDB disassembly information."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-disassembly-buffer thread)))
(def-gdb-preempt-display-buffer
gdb-preemptively-display-disassembly-buffer
'gdb-disassembly-buffer)
-(def-gdb-frame-for-buffer
- gdb-frame-disassembly-buffer
- 'gdb-disassembly-buffer
- "Display disassembly in a new frame.")
+(defun gdb-frame-disassembly-buffer (&optional thread)
+ "Display GDB disassembly information in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-disassembly-buffer thread)
+ gdb-display-buffer-other-frame-action))
(def-gdb-auto-update-trigger gdb-invalidate-disassembly
(let* ((frame (gdb-current-buffer-frame))
(file (bindat-get-field frame 'fullname))
(line (bindat-get-field frame 'line)))
- (when file
- (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line)))
+ (if file
+ (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line)
+ ;; If we're unable to get a file name / line for $PC, simply
+ ;; follow $PC, disassembling the next 10 (x ~15 (on IA) ==
+ ;; 150 bytes) instructions.
+ "-data-disassemble -s $pc -e \"$pc + 150\" -- 0"))
gdb-disassembly-handler
;; We update disassembly only after we have actual frame information
;; about all threads, so no there's `update' signal in this list
@@ -3319,8 +3373,12 @@ DOC is an optional documentation string."
(gdb-table-add-row table
(list
(bindat-get-field instr 'address)
- (apply #'format "<%s+%s>:"
- (gdb-get-many-fields instr 'func-name 'offset))
+ (let
+ ((func-name (bindat-get-field instr 'func-name))
+ (offset (bindat-get-field instr 'offset)))
+ (if func-name
+ (format "<%s+%s>:" func-name offset)
+ ""))
(bindat-get-field instr 'inst)))
(when (string-equal (bindat-get-field instr 'address)
address)
@@ -3480,19 +3538,20 @@ member."
(gdb-current-context-buffer-name
(concat "stack frames of " (gdb-get-target-string))))
-(def-gdb-display-buffer
- gdb-display-stack-buffer
- 'gdb-stack-buffer
- "Display backtrace of current stack.")
+(defun gdb-display-stack-buffer (&optional thread)
+ "Display GDB backtrace for current stack."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-stack-buffer thread)))
(def-gdb-preempt-display-buffer
gdb-preemptively-display-stack-buffer
'gdb-stack-buffer nil t)
-(def-gdb-frame-for-buffer
- gdb-frame-stack-buffer
- 'gdb-stack-buffer
- "Display backtrace of current stack in a new frame.")
+(defun gdb-frame-stack-buffer (&optional thread)
+ "Display GDB backtrace for current stack in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-stack-buffer thread)
+ gdb-display-buffer-other-frame-action))
(defvar gdb-frames-mode-map
(let ((map (make-sparse-keymap)))
@@ -3639,19 +3698,20 @@ member."
(gdb-current-context-buffer-name
(concat "locals of " (gdb-get-target-string))))
-(def-gdb-display-buffer
- gdb-display-locals-buffer
- 'gdb-locals-buffer
- "Display local variables of current stack and their values.")
+(defun gdb-display-locals-buffer (&optional thread)
+ "Display the local variables of current GDB stack."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-locals-buffer thread)))
(def-gdb-preempt-display-buffer
gdb-preemptively-display-locals-buffer
'gdb-locals-buffer nil t)
-(def-gdb-frame-for-buffer
- gdb-frame-locals-buffer
- 'gdb-locals-buffer
- "Display local variables of current stack and their values in a new frame.")
+(defun gdb-frame-locals-buffer (&optional thread)
+ "Display the local variables of the current GDB stack in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-locals-buffer thread)
+ gdb-display-buffer-other-frame-action))
;; Registers buffer.
@@ -3738,19 +3798,20 @@ member."
(gdb-current-context-buffer-name
(concat "registers of " (gdb-get-target-string))))
-(def-gdb-display-buffer
- gdb-display-registers-buffer
- 'gdb-registers-buffer
- "Display integer register contents.")
+(defun gdb-display-registers-buffer (&optional thread)
+ "Display GDB register contents."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-registers-buffer thread)))
(def-gdb-preempt-display-buffer
gdb-preemptively-display-registers-buffer
'gdb-registers-buffer nil t)
-(def-gdb-frame-for-buffer
- gdb-frame-registers-buffer
- 'gdb-registers-buffer
- "Display integer register contents in a new frame.")
+(defun gdb-frame-registers-buffer (&optional thread)
+ "Display GDB register contents in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-registers-buffer thread)
+ gdb-display-buffer-other-frame-action))
;; Needs GDB 6.4 onwards (used to fail with no stack).
(defun gdb-get-changed-registers ()
@@ -3787,9 +3848,7 @@ is set in them."
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (member buffer-file-name gdb-source-file-list)
- (gdb-init-buffer))))
- (gdb-force-mode-line-update
- (propertize "ready" 'face font-lock-variable-name-face)))
+ (gdb-init-buffer)))))
(defun gdb-get-main-selected-frame ()
"Trigger for `gdb-frame-handler' which uses main current
@@ -3839,26 +3898,26 @@ overlay arrow in source buffer."
(setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
;;;; Window management
-(defun gdb-display-buffer (buf dedicated &optional frame)
- "Show buffer BUF.
-
-If BUF is already displayed in some window, show it, deiconifying
-the frame if necessary. Otherwise, find least recently used
-window and show BUF there, if the window is not used for GDB
-already, in which case that window is split first."
- (let ((answer (get-buffer-window buf (or frame 0))))
- (if answer
- (display-buffer buf nil (or frame 0)) ;Deiconify frame if necessary.
- (let ((window (get-lru-window)))
- (if (eq (buffer-local-value 'gud-minor-mode (window-buffer window))
- 'gdbmi)
- (let ((largest (get-largest-window)))
- (setq answer (split-window largest))
- (set-window-buffer answer buf)
- (set-window-dedicated-p answer dedicated)
- answer)
- (set-window-buffer window buf)
- window)))))
+(defun gdb-display-buffer (buf)
+ "Show buffer BUF, and make that window dedicated."
+ (let ((window (display-buffer buf)))
+ (set-window-dedicated-p window t)
+ window))
+
+ ;; (let ((answer (get-buffer-window buf 0)))
+ ;; (if answer
+ ;; (display-buffer buf nil 0) ;Deiconify frame if necessary.
+ ;; (let ((window (get-lru-window)))
+ ;; (if (eq (buffer-local-value 'gud-minor-mode (window-buffer window))
+ ;; 'gdbmi)
+ ;; (let ((largest (get-largest-window)))
+ ;; (setq answer (split-window largest))
+ ;; (set-window-buffer answer buf)
+ ;; (set-window-dedicated-p answer t)
+ ;; answer)
+ ;; (set-window-buffer window buf)
+ ;; window)))))
+
(defun gdb-preempt-existing-or-display-buffer (buf &optional split-horizontal)
"Find window displaying a buffer with the same
@@ -3885,7 +3944,7 @@ SPLIT-HORIZONTAL and show BUF in the new window."
(if dedicated-window
(set-window-buffer
(split-window dedicated-window nil split-horizontal) buf)
- (gdb-display-buffer buf t))))))
+ (gdb-display-buffer buf))))))
(error "Null buffer")))
;;; Shared keymap initialization:
@@ -3989,7 +4048,7 @@ SPLIT-HORIZONTAL and show BUF in the new window."
'all-threads)
(defun gdb-frame-gdb-buffer ()
- "Display GUD buffer in a new frame."
+ "Display GUD buffer in another frame."
(interactive)
(display-buffer-other-frame gud-comint-buffer))
@@ -4011,13 +4070,12 @@ window is dedicated."
(defun gdb-setup-windows ()
"Layout the window pattern for `gdb-many-windows'."
- (gdb-display-locals-buffer)
- (gdb-display-stack-buffer)
- (delete-other-windows)
- (gdb-display-breakpoints-buffer)
- (delete-other-windows)
- ;; Don't dedicate.
+ (gdb-get-buffer-create 'gdb-locals-buffer)
+ (gdb-get-buffer-create 'gdb-stack-buffer)
+ (gdb-get-buffer-create 'gdb-breakpoints-buffer)
+ (set-window-dedicated-p (selected-window) nil)
(switch-to-buffer gud-comint-buffer)
+ (delete-other-windows)
(let ((win0 (selected-window))
(win1 (split-window nil ( / ( * (window-height) 3) 4)))
(win2 (split-window nil ( / (window-height) 3)))
@@ -4046,31 +4104,19 @@ window is dedicated."
nil win5))
(select-window win0)))
-(defcustom gdb-many-windows nil
+(define-minor-mode gdb-many-windows
"If nil just pop up the GUD buffer unless `gdb-show-main' is t.
In this case it starts with two windows: one displaying the GUD
buffer and the other with the source file with the main routine
of the debugged program. Non-nil means display the layout shown for
`gdb'."
- :type 'boolean
+ :global t
:group 'gdb
- :version "22.1")
-
-(defun gdb-many-windows (arg)
- "Toggle the number of windows in the basic arrangement.
-With arg, display additional buffers iff arg is positive."
- (interactive "P")
- (setq gdb-many-windows
- (if (null arg)
- (not gdb-many-windows)
- (> (prefix-numeric-value arg) 0)))
- (message (format "Display of other windows %sabled"
- (if gdb-many-windows "en" "dis")))
+ :version "22.1"
(if (and gud-comint-buffer
(buffer-name gud-comint-buffer))
- (condition-case nil
- (gdb-restore-windows)
- (error nil))))
+ (ignore-errors
+ (gdb-restore-windows))))
(defun gdb-restore-windows ()
"Restore the basic arrangement of windows used by gdb.
@@ -4089,9 +4135,15 @@ This arrangement depends on the value of `gdb-many-windows'."
(gud-find-file gdb-main-file)))
(setq gdb-source-window win)))))
+;; Called from `gud-sentinel' in gud.el:
(defun gdb-reset ()
"Exit a debugging session cleanly.
Kills the gdb buffers, and resets variables and the source buffers."
+ ;; The gdb-inferior buffer has a pty hooked up to the main gdb
+ ;; process. This pty must be deleted explicitly.
+ (let ((pty (get-process "gdb-inferior")))
+ (if pty (delete-process pty)))
+ ;; Find gdb-mi buffers and kill them.
(dolist (buffer (buffer-list))
(unless (eq buffer gud-comint-buffer)
(with-current-buffer buffer
@@ -4126,9 +4178,11 @@ buffers, if required."
(if gdb-many-windows
(gdb-setup-windows)
(gdb-get-buffer-create 'gdb-breakpoints-buffer)
- (if (and gdb-show-main gdb-main-file)
- (let ((pop-up-windows t))
- (display-buffer (gud-find-file gdb-main-file))))))
+ (and gdb-show-main
+ gdb-main-file
+ (display-buffer (gud-find-file gdb-main-file))))
+ (gdb-force-mode-line-update
+ (propertize "ready" 'face font-lock-variable-name-face)))
;;from put-image
(defun gdb-put-string (putstring pos &optional dprop &rest sprops)
diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el
index 6792e861888..a5ac7b43057 100644
--- a/lisp/progmodes/glasses.el
+++ b/lisp/progmodes/glasses.el
@@ -1,6 +1,6 @@
;;; glasses.el --- make cantReadThis readable
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Milan Zamazal <pdm@zamazal.org>
;; Maintainer: Milan Zamazal <pdm@zamazal.org>
@@ -51,10 +51,6 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
-
-
;;; User variables
@@ -78,7 +74,7 @@ string."
(defcustom glasses-original-separator "_"
- "*String to be displayed as `glasses-separator' in separator positions.
+ "String to be displayed as `glasses-separator' in separator positions.
For instance, if you set it to \"_\" and set `glasses-separator' to \"-\",
underscore separators are displayed as hyphens.
If `glasses-original-separator' is an empty string, no such display change is
@@ -316,8 +312,10 @@ recognized according to the current value of the variable `glasses-separator'."
;;;###autoload
(define-minor-mode glasses-mode
"Minor mode for making identifiers likeThis readable.
-When this mode is active, it tries to add virtual separators (like underscores)
-at places they belong to."
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil. When this mode is active, it tries to
+add virtual separators (like underscores) at places they belong to."
:group 'glasses :lighter " o^o"
(save-excursion
(save-restriction
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 38b17a9b1ee..c056b0f4e26 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -1,6 +1,6 @@
;;; grep.el --- run `grep' and display the results
-;; Copyright (C) 1985-1987, 1993-1999, 2001-2011
+;; Copyright (C) 1985-1987, 1993-1999, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
@@ -61,7 +61,7 @@ SYMBOL should be one of `grep-command', `grep-template',
;;;###autoload
(defcustom grep-window-height nil
- "*Number of lines in a grep window. If nil, use `compilation-window-height'."
+ "Number of lines in a grep window. If nil, use `compilation-window-height'."
:type '(choice (const :tag "Default" nil)
integer)
:version "22.1"
@@ -104,7 +104,7 @@ To change the default value, use Customize or call the function
:group 'grep)
(defcustom grep-scroll-output nil
- "*Non-nil to scroll the *grep* buffer window as output appears.
+ "Non-nil to scroll the *grep* buffer window as output appears.
Setting it causes the grep commands to put point at the end of their
output window so that the end of the output is always visible rather
@@ -203,13 +203,13 @@ Customize or call the function `grep-apply-setting'."
("tex" . "*.tex")
("texi" . "*.texi")
("asm" . "*.[sS]"))
- "*Alist of aliases for the FILES argument to `lgrep' and `rgrep'."
+ "Alist of aliases for the FILES argument to `lgrep' and `rgrep'."
:type 'alist
:group 'grep)
(defcustom grep-find-ignored-directories
vc-directory-exclusion-list
- "*List of names of sub-directories which `rgrep' shall not recurse into.
+ "List of names of sub-directories which `rgrep' shall not recurse into.
If an element is a cons cell, the car is called on the search directory
to determine whether cdr should not be recursed into."
:type '(choice (repeat :tag "Ignored directories" string)
@@ -221,7 +221,7 @@ to determine whether cdr should not be recursed into."
(unless (string-match-p "/\\'" s)
(concat "*" s)))
completion-ignored-extensions)))
- "*List of file names which `rgrep' and `lgrep' shall exclude.
+ "List of file names which `rgrep' and `lgrep' shall exclude.
If an element is a cons cell, the car is called on the search directory
to determine whether cdr should not be excluded."
:type '(choice (repeat :tag "Ignored file" string)
@@ -229,7 +229,7 @@ to determine whether cdr should not be excluded."
:group 'grep)
(defcustom grep-error-screen-columns nil
- "*If non-nil, column numbers in grep hits are screen columns.
+ "If non-nil, column numbers in grep hits are screen columns.
See `compilation-error-screen-columns'"
:type '(choice (const :tag "Default" nil)
integer)
@@ -374,6 +374,9 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
("^Binary file \\(.+\\) matches$" 1 nil nil 0 1))
"Regexp used to match grep hits. See `compilation-error-regexp-alist'.")
+(defvar grep-first-column 0 ; bug#10594
+ "Value to use for `compilation-first-column' in grep buffers.")
+
(defvar grep-error "grep hit"
"Message to print when no matches are found.")
@@ -725,9 +728,9 @@ This function is called from `compilation-filter-hook'."
(defun grep (command-args)
"Run grep, with user-specified args, and collect output in a buffer.
While grep runs asynchronously, you can use \\[next-error] (M-x next-error),
-or \\<grep-mode-map>\\[compile-goto-error] in the grep \
-output buffer, to go to the lines where grep
-found matches.
+or \\<grep-mode-map>\\[compile-goto-error] in the *grep* \
+buffer, to go to the lines where grep found
+matches. To kill the grep job before it finishes, type \\[kill-compilation].
For doing a recursive `grep', see the `rgrep' command. For running
`grep' in a specific directory, see `lgrep'.
@@ -814,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."
@@ -954,10 +957,11 @@ With \\[universal-argument] prefix, you can edit the constructed shell command l
before it is executed.
With two \\[universal-argument] prefixes, directly edit and run `grep-find-command'.
-Collect output in a buffer. While find runs asynchronously, you
-can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
+Collect output in a buffer. While the recursive grep is running,
+you can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
in the grep output buffer,
-to go to the lines where grep found matches.
+to visit the lines where matches were found. To kill the job
+before it finishes, type \\[kill-compilation].
This command shares argument histories with \\[lgrep] and \\[grep-find].
@@ -1021,7 +1025,8 @@ to specify a command to run."
(shell-quote-argument ")")
" -prune -o "))
(and grep-find-ignored-files
- (concat (shell-quote-argument "(")
+ (concat (shell-quote-argument "!") " -type d "
+ (shell-quote-argument "(")
;; we should use shell-quote-argument here
" -name "
(mapconcat
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 7215ac4ea73..13eac8392a2 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -1,6 +1,6 @@
;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers
-;; Copyright (C) 1992-1996, 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: FSF
@@ -37,8 +37,6 @@
;;; Code:
-(eval-when-compile (require 'cl)) ; for case macro
-
(require 'comint)
(defvar gdb-active-process)
@@ -58,18 +56,19 @@
;; GUD commands must be visible in C buffers visited by GUD
(defgroup gud nil
- "Grand Unified Debugger mode for gdb and other debuggers under Emacs.
-Supported debuggers include gdb, sdb, dbx, xdb, perldb, pdb (Python) and jdb."
+ "The \"Grand Unified Debugger\" interface.
+Supported debuggers include gdb, sdb, dbx, xdb, perldb,
+pdb (Python), and jdb."
:group 'processes
:group 'tools)
(defcustom gud-key-prefix "\C-x\C-a"
"Prefix of all GUD commands valid in C buffers."
- :type 'string
+ :type 'key-sequence
:group 'gud)
-(global-set-key (concat gud-key-prefix "\C-l") 'gud-refresh)
+(global-set-key (vconcat gud-key-prefix "\C-l") 'gud-refresh)
(define-key ctl-x-map " " 'gud-break) ;; backward compatibility hack
(defvar gud-marker-filter nil)
@@ -149,7 +148,8 @@ Used to gray out relevant toolbar icons.")
([run] menu-item "Run" gud-run
:enable (not gud-running)
:visible (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
- ([go] menu-item (if gdb-active-process "Continue" "Run") gud-go
+ ([go] menu-item (if (bound-and-true-p gdb-active-process)
+ "Continue" "Run") gud-go
:visible (and (eq gud-minor-mode 'gdbmi)
(gdb-show-run-p)))
([stop] menu-item "Stop" gud-stop-subjob
@@ -179,7 +179,7 @@ Used to gray out relevant toolbar icons.")
'(gdbmi gdb dbx xdb jdb pdb)))
([pp] menu-item "Print S-expression" gud-pp
:enable (and (not gud-running)
- gdb-active-process)
+ (bound-and-true-p gdb-active-process))
:visible (and (string-equal
(buffer-local-value
'gud-target-name gud-comint-buffer) "emacs")
@@ -527,10 +527,10 @@ required by the caller."
nil 'gdb-edit-value)
nil
(if gdb-show-changed-values
- (or parent (case status
- (changed 'font-lock-warning-face)
- (out-of-scope 'shadow)
- (t t)))
+ (or parent (pcase status
+ (`changed 'font-lock-warning-face)
+ (`out-of-scope 'shadow)
+ (_ t)))
t)
depth)
(if (eq status 'out-of-scope) (setq parent 'shadow))
@@ -548,10 +548,10 @@ required by the caller."
nil 'gdb-edit-value)
nil
(if gdb-show-changed-values
- (or parent (case status
- (changed 'font-lock-warning-face)
- (out-of-scope 'shadow)
- (t t)))
+ (or parent (pcase status
+ (`changed 'font-lock-warning-face)
+ (`out-of-scope 'shadow)
+ (_ t)))
t)
depth)
(speedbar-make-tag-line
@@ -749,7 +749,7 @@ directory and source-file directory for your debugger."
"Evaluate C dereferenced pointer expression at point.")
;; For debugging Emacs only.
- (gud-def gud-pv "pv1 %e" "\C-v" "Print the value of the lisp variable.")
+ (gud-def gud-pv "pv %e" "\C-v" "Print the value of the lisp variable.")
(gud-def gud-until "until %l" "\C-u" "Continue to current line.")
(gud-def gud-run "run" nil "Run the program.")
@@ -1046,7 +1046,7 @@ and source-file directory for your debugger."
(defvar gud-dbx-history nil)
(defcustom gud-dbx-directories nil
- "*A list of directories that dbx should search for source code.
+ "A list of directories that dbx should search for source code.
If nil, only source files in the program directory
will be known to dbx.
@@ -1358,7 +1358,7 @@ and source-file directory for your debugger."
(defvar gud-xdb-history nil)
(defcustom gud-xdb-directories nil
- "*A list of directories that xdb should search for source code.
+ "A list of directories that xdb should search for source code.
If nil, only source files in the program directory
will be known to xdb.
@@ -1646,8 +1646,8 @@ and source-file directory for your debugger."
(gud-common-init command-line nil 'gud-pdb-marker-filter)
(set (make-local-variable 'gud-minor-mode) 'pdb)
- (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.")
- (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line")
+ (gud-def gud-break "break %d%f:%l" "\C-b" "Set breakpoint at current line.")
+ (gud-def gud-remove "clear %d%f:%l" "\C-d" "Remove breakpoint at current line")
(gud-def gud-step "step" "\C-s" "Step one source line with display.")
(gud-def gud-next "next" "\C-n" "Step one line (skip functions).")
(gud-def gud-cont "continue" "\C-r" "Continue with display.")
@@ -1811,7 +1811,7 @@ source file information.")
;; List of Java source file directories.
(defvar gud-jdb-directories (list ".")
- "*A list of directories that gud jdb should search for source code.
+ "A list of directories that gud jdb should search for source code.
The file names should be absolute, or relative to the current
directory.
@@ -2686,7 +2686,6 @@ Obeying it means displaying in another window the specified file and line."
(declare-function global-hl-line-highlight "hl-line" ())
(declare-function hl-line-highlight "hl-line" ())
(declare-function gdb-display-source-buffer "gdb-mi" (buffer))
-(declare-function gdb-display-buffer "gdb-mi" (buf dedicated &optional size))
;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
;; and that its line LINE is visible.
@@ -2702,45 +2701,39 @@ Obeying it means displaying in another window the specified file and line."
(gud-find-file true-file)))
(window (and buffer
(or (get-buffer-window buffer)
- (if (eq gud-minor-mode 'gdbmi)
- (or (if (get-buffer-window buffer 'visible)
- (display-buffer buffer nil 'visible))
- (unless (gdb-display-source-buffer buffer)
- (gdb-display-buffer buffer nil 'visible))))
(display-buffer buffer))))
(pos))
- (if buffer
- (progn
- (with-current-buffer buffer
- (unless (or (verify-visited-file-modtime buffer) gud-keep-buffer)
- (if (yes-or-no-p
- (format "File %s changed on disk. Reread from disk? "
- (buffer-name)))
- (revert-buffer t t)
- (setq gud-keep-buffer t)))
- (save-restriction
- (widen)
- (goto-char (point-min))
- (forward-line (1- line))
- (setq pos (point))
- (or gud-overlay-arrow-position
- (setq gud-overlay-arrow-position (make-marker)))
- (set-marker gud-overlay-arrow-position (point) (current-buffer))
- ;; If they turned on hl-line, move the hl-line highlight to
- ;; the arrow's line.
- (when (featurep 'hl-line)
- (cond
- (global-hl-line-mode
- (global-hl-line-highlight))
- ((and hl-line-mode hl-line-sticky-flag)
- (hl-line-highlight)))))
- (cond ((or (< pos (point-min)) (> pos (point-max)))
- (widen)
- (goto-char pos))))
- (when window
- (set-window-point window gud-overlay-arrow-position)
- (if (eq gud-minor-mode 'gdbmi)
- (setq gdb-source-window window)))))))
+ (when buffer
+ (with-current-buffer buffer
+ (unless (or (verify-visited-file-modtime buffer) gud-keep-buffer)
+ (if (yes-or-no-p
+ (format "File %s changed on disk. Reread from disk? "
+ (buffer-name)))
+ (revert-buffer t t)
+ (setq gud-keep-buffer t)))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (setq pos (point))
+ (or gud-overlay-arrow-position
+ (setq gud-overlay-arrow-position (make-marker)))
+ (set-marker gud-overlay-arrow-position (point) (current-buffer))
+ ;; If they turned on hl-line, move the hl-line highlight to
+ ;; the arrow's line.
+ (when (featurep 'hl-line)
+ (cond
+ (global-hl-line-mode
+ (global-hl-line-highlight))
+ ((and hl-line-mode hl-line-sticky-flag)
+ (hl-line-highlight)))))
+ (cond ((or (< pos (point-min)) (> pos (point-max)))
+ (widen)
+ (goto-char pos))))
+ (when window
+ (set-window-point window gud-overlay-arrow-position)
+ (if (eq gud-minor-mode 'gdbmi)
+ (setq gdb-source-window window))))))
;; The gud-call function must do the right thing whether its invoking
;; keystroke is from the GUD buffer itself (via major-mode binding)
@@ -2762,10 +2755,9 @@ Obeying it means displaying in another window the specified file and line."
(buffer-file-name)
(car frame)))))
((eq key ?F)
- (setq subst (file-name-sans-extension
- (file-name-nondirectory (if insource
- (buffer-file-name)
- (car frame))))))
+ (setq subst (file-name-base (if insource
+ (buffer-file-name)
+ (car frame)))))
((eq key ?d)
(setq subst (file-name-directory (if insource
(buffer-file-name)
@@ -3412,11 +3404,11 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference."
(defun gud-tooltip-print-command (expr)
"Return a suitable command to print the expression EXPR."
- (case gud-minor-mode
- (gdbmi (concat "-data-evaluate-expression " expr))
- (dbx (concat "print " expr))
- ((xdb pdb) (concat "p " expr))
- (sdb (concat expr "/"))))
+ (pcase gud-minor-mode
+ (`gdbmi (concat "-data-evaluate-expression \"" expr "\""))
+ (`dbx (concat "print " expr))
+ ((or `xdb `pdb) (concat "p " expr))
+ (`sdb (concat expr "/"))))
(declare-function gdb-input "gdb-mi" (command handler))
(declare-function tooltip-expr-to-print "tooltip" (event))
@@ -3458,7 +3450,10 @@ This function must return nil if it doesn't handle EVENT."
(let ((cmd (gud-tooltip-print-command expr)))
(when (and gud-tooltip-mode (eq gud-minor-mode 'gdb))
(gud-tooltip-mode -1)
- (message-box "Using GUD tooltips in this mode is unsafe\n\
+ ;; The blank before the newline is for MS-Windows,
+ ;; whose emulation of message box removes newlines and
+ ;; displays a single long line.
+ (message-box "Using GUD tooltips in this mode is unsafe \n\
so they have been disabled."))
(unless (null cmd) ; CMD can be nil if unknown debugger
(if (eq gud-minor-mode 'gdbmi)
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 82961376669..7bddbff9596 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -1,6 +1,6 @@
;;; hideif.el --- hides selected code within ifdef
-;; Copyright (C) 1988, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Brian Marick
;; Daniel LaLiberte <liberte@holonexus.org>
@@ -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) ===
@@ -1003,7 +1010,7 @@ Return as (TOP . BOTTOM) the extent of ifdef block."
"Compress the define list ENV into a list of defined symbols only."
(let ((new-defs nil))
(dolist (def env new-defs)
- (if (hif-lookup (car def)) (push (car env) new-defs)))))
+ (if (hif-lookup (car def)) (push (car def) new-defs)))))
(defun hide-ifdef-set-define-alist (name)
"Set the association for NAME to `hide-ifdef-env'."
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 9cbc1dc6d32..2a77ad013c7 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -1,6 +1,6 @@
;;; hideshow.el --- minor mode cmds to selectively display code/comment blocks
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;; Dan Nicolaescu <dann@ics.uci.edu>
@@ -52,7 +52,7 @@
;;
;; First make sure hideshow.el is in a directory in your `load-path'.
;; You can optionally byte-compile it using `M-x byte-compile-file'.
-;; Then, add the following to your ~/.emacs:
+;; Then, add the following to your init file:
;;
;; (load-library "hideshow")
;; (add-hook 'X-mode-hook ; other modes similarly
@@ -238,18 +238,18 @@
:group 'languages)
(defcustom hs-hide-comments-when-hiding-all t
- "*Hide the comments too when you do an `hs-hide-all'."
+ "Hide the comments too when you do an `hs-hide-all'."
:type 'boolean
:group 'hideshow)
(defcustom hs-minor-mode-hook nil
- "*Hook called when hideshow minor mode is activated or deactivated."
+ "Hook called when hideshow minor mode is activated or deactivated."
:type 'hook
:group 'hideshow
:version "21.1")
(defcustom hs-isearch-open 'code
- "*What kind of hidden blocks to open when doing `isearch'.
+ "What kind of hidden blocks to open when doing `isearch'.
One of the following symbols:
code -- open only code blocks
@@ -272,7 +272,7 @@ This has effect only if `search-invisible' is set to `open'."
(bibtex-mode ("@\\S(*\\(\\s(\\)" 1))
(java-mode "{" "}" "/[*/]" nil nil)
(js-mode "{" "}" "/[*/]" nil)))
- "*Alist for initializing the hideshow variables for different modes.
+ "Alist for initializing the hideshow variables for different modes.
Each element has the form
(MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
@@ -300,25 +300,25 @@ appropriate values. The regexps should not contain leading or trailing
whitespace. Case does not matter.")
(defvar hs-hide-all-non-comment-function nil
- "*Function called if non-nil when doing `hs-hide-all' for non-comments.")
+ "Function called if non-nil when doing `hs-hide-all' for non-comments.")
(defvar hs-allow-nesting nil
- "*If non-nil, hiding remembers internal blocks.
+ "If non-nil, hiding remembers internal blocks.
This means that when the outer block is shown again,
any previously hidden internal blocks remain hidden.")
(defvar hs-hide-hook nil
- "*Hook called (with `run-hooks') at the end of commands to hide text.
+ "Hook called (with `run-hooks') at the end of commands to hide text.
These commands include the toggling commands (when the result is to hide
a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'.")
(defvar hs-show-hook nil
- "*Hook called (with `run-hooks') at the end of commands to show text.
+ "Hook called (with `run-hooks') at the end of commands to show text.
These commands include the toggling commands (when the result is to show
a block), `hs-show-all' and `hs-show-block'.")
(defvar hs-set-up-overlay nil
- "*Function called with one arg, OV, a newly initialized overlay.
+ "Function called with one arg, OV, a newly initialized overlay.
Hideshow puts a unique overlay on each range of text to be hidden
in the buffer. Here is a simple example of how to use this variable:
@@ -408,6 +408,8 @@ element (using `match-beginning') before calling `hs-forward-sexp-func'.")
(defvar hs-block-end-regexp nil
"Regexp for end of block.")
+(make-variable-buffer-local 'hs-block-end-regexp)
+
(defvar hs-forward-sexp-func 'forward-sexp
"Function used to do a `forward-sexp'.
@@ -604,9 +606,10 @@ we return a list having a nil as its car and the end of comment position
as cdr."
(save-excursion
;; the idea is to look backwards for a comment start regexp, do a
- ;; forward comment, and see if we are inside, then extend extend
+ ;; forward comment, and see if we are inside, then extend
;; forward and backward as long as we have comments
(let ((q (point)))
+ (skip-chars-forward "[:blank:]")
(when (or (looking-at hs-c-start-regexp)
(re-search-backward hs-c-start-regexp (point-min) t))
;; first get to the beginning of this comment...
@@ -801,12 +804,15 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
(forward-comment (point-max)))
(re-search-forward re (point-max) t))
(if (match-beginning 1)
- ;; we have found a block beginning
+ ;; We have found a block beginning.
(progn
(goto-char (match-beginning 1))
- (if hs-hide-all-non-comment-function
- (funcall hs-hide-all-non-comment-function)
- (hs-hide-block-at-point t)))
+ (unless (if hs-hide-all-non-comment-function
+ (funcall hs-hide-all-non-comment-function)
+ (hs-hide-block-at-point t))
+ ;; Go to end of matched data to prevent from getting stuck
+ ;; with an endless loop.
+ (goto-char (match-end 0))))
;; found a comment, probably
(let ((c-reg (hs-inside-comment-p)))
(when (and c-reg (car c-reg))
@@ -928,6 +934,10 @@ This can be useful if you have huge RCS logs in those comments."
;;;###autoload
(define-minor-mode hs-minor-mode
"Minor mode to selectively hide/show code and comment blocks.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
+
When hideshow minor mode is on, the menu bar is augmented with hideshow
commands and the hideshow commands are enabled.
The value '(hs . t) is added to `buffer-invisibility-spec'.
diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el
index 5382ce1386d..205b226160a 100644
--- a/lisp/progmodes/icon.el
+++ b/lisp/progmodes/icon.el
@@ -1,6 +1,6 @@
;;; icon.el --- mode for editing Icon code
-;; Copyright (C) 1989, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 2001-2012 Free Software Foundation, Inc.
;; Author: Chris Smith <csmith@convex.com>
;; Created: 15 Feb 89
@@ -85,39 +85,39 @@
:group 'languages)
(defcustom icon-indent-level 4
- "*Indentation of Icon statements with respect to containing block."
+ "Indentation of Icon statements with respect to containing block."
:type 'integer
:group 'icon)
(defcustom icon-brace-imaginary-offset 0
- "*Imagined indentation of a Icon open brace that actually follows a statement."
+ "Imagined indentation of a Icon open brace that actually follows a statement."
:type 'integer
:group 'icon)
(defcustom icon-brace-offset 0
- "*Extra indentation for braces, compared with other text in same context."
+ "Extra indentation for braces, compared with other text in same context."
:type 'integer
:group 'icon)
(defcustom icon-continued-statement-offset 4
- "*Extra indent for Icon lines not starting new statements."
+ "Extra indent for Icon lines not starting new statements."
:type 'integer
:group 'icon)
(defcustom icon-continued-brace-offset 0
- "*Extra indent for Icon substatements that start with open-braces.
+ "Extra indent for Icon substatements that start with open-braces.
This is in addition to `icon-continued-statement-offset'."
:type 'integer
:group 'icon)
(defcustom icon-auto-newline nil
- "*Non-nil means automatically newline before and after braces Icon code.
+ "Non-nil means automatically newline before and after braces Icon code.
This applies when braces are inserted."
:type 'boolean
:group 'icon)
(defcustom icon-tab-always-indent t
- "*Non-nil means TAB in Icon mode should always reindent the current line.
+ "Non-nil means TAB in Icon mode should always reindent the current line.
It will then reindent, regardless of where in the line point is
when the TAB command is used."
:type 'boolean
diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el
index a967fc03e40..24613d14634 100644
--- a/lisp/progmodes/idlw-complete-structtag.el
+++ b/lisp/progmodes/idlw-complete-structtag.el
@@ -1,6 +1,6 @@
;;; idlw-complete-structtag.el --- Completion of structure tags.
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@astro.uva.nl>
;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu>
@@ -53,8 +53,8 @@
;;
;; INSTALLATION
;; ============
-;; Put this file on the emacs load path and load it with the following
-;; line in your .emacs file:
+;; Put this file on the emacs load path and load it with the following
+;; line in your init file:
;;
;; (add-hook 'idlwave-load-hook
;; (lambda () (require 'idlw-complete-structtag)))
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index 0266fc17f9c..0cb8b7da4aa 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -1,6 +1,6 @@
;;; idlw-help.el --- HTML Help code for IDLWAVE
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;;
;; Authors: J.D. Smith <jdsmith@as.arizona.edu>
;; Carsten Dominik <dominik@science.uva.nl>
@@ -115,7 +115,7 @@ must be explicitly set non-nil in order for the variable
"Obsolete variable. See `idlwave-html-help-location'.")
(defcustom idlwave-help-use-dedicated-frame t
- "*Non-nil means, use a separate frame for Online Help if possible."
+ "Non-nil means, use a separate frame for Online Help if possible."
:group 'idlwave-online-help
:type 'boolean)
@@ -164,12 +164,12 @@ probably a good idea to still call this function as a fallback."
:type 'symbol)
(defcustom idlwave-help-fontify-source-code nil
- "*Non-nil means, fontify source code displayed as help like normal code."
+ "Non-nil means, fontify source code displayed as help like normal code."
:group 'idlwave-online-help
:type 'boolean)
(defcustom idlwave-help-source-try-header t
- "*Non-nil means, try to find help in routine header when displaying source.
+ "Non-nil means, try to find help in routine header when displaying source.
Routines which are not documented in the system manual use their source as
help text. When this variable is non-nil, we try to find a description of
the help item in the first routine doclib header above the routine definition.
@@ -180,14 +180,14 @@ definition is displayed instead."
(defcustom idlwave-help-doclib-name "name"
- "*A regexp for the heading word to search for in doclib headers
+ "A regexp for the heading word to search for in doclib headers
which specifies the `name' section. Can be used for localization
support."
:group 'idlwave-online-help
:type 'string)
(defcustom idlwave-help-doclib-keyword "KEYWORD"
- "*A regexp for the heading word to search for in doclib headers
+ "A regexp for the heading word to search for in doclib headers
which specifies the `keywords' section. Can be used for localization
support."
:group 'idlwave-online-help
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index aa46b54d848..0abd4daf61b 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -1,6 +1,6 @@
;; idlw-shell.el --- run IDL as an inferior process of Emacs.
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Authors: J.D. Smith <jdsmith@as.arizona.edu>
;; Carsten Dominik <dominik@astro.uva.nl>
@@ -48,7 +48,7 @@
;;
;; Follow the instructions in the INSTALL file of the distribution.
;; In short, put this file on your load path and add the following
-;; lines to your .emacs file:
+;; lines to your init file:
;;
;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t)
;;
@@ -106,19 +106,17 @@
:group 'idlwave)
(defcustom idlwave-shell-prompt-pattern "^\r? ?IDL> "
- "*Regexp to match IDL prompt at beginning of a line.
+ "Regexp to match IDL prompt at beginning of a line.
For example, \"^\r?IDL> \" or \"^\r?WAVE> \".
The \"^\r?\" is needed, to indicate the beginning of the line, with
optional return character (which IDL seems to output randomly).
This variable is used to initialize `comint-prompt-regexp' in the
-process buffer.
-
-This is a fine thing to set in your `.emacs' file."
+process buffer."
:group 'idlwave-shell-general-setup
:type 'regexp)
(defcustom idlwave-shell-process-name "idl"
- "*Name to be associated with the IDL process. The buffer for the
+ "Name to be associated with the IDL process. The buffer for the
process output is made by surrounding this name with `*'s."
:group 'idlwave-shell-general-setup
:type 'string)
@@ -126,12 +124,12 @@ process output is made by surrounding this name with `*'s."
;; (defcustom idlwave-shell-automatic-start...) See idlwave.el
(defcustom idlwave-shell-use-dedicated-window nil
- "*Non-nil means, never replace the shell frame with another buffer."
+ "Non-nil means, never replace the shell frame with another buffer."
:group 'idlwave-shell-general-setup
:type 'boolean)
(defcustom idlwave-shell-use-dedicated-frame nil
- "*Non-nil means, IDLWAVE should use a special frame to display shell buffer."
+ "Non-nil means, IDLWAVE should use a special frame to display shell buffer."
:group 'idlwave-shell-general-setup
:type 'boolean)
@@ -145,12 +143,12 @@ The default makes the frame splittable, so that completion works correctly."
(cons symbol sexp)))
(defcustom idlwave-shell-raise-frame t
- "*Non-nil means, `idlwave-shell' raises the frame showing the shell window."
+ "Non-nil means, `idlwave-shell' raises the frame showing the shell window."
:group 'idlwave-shell-general-setup
:type 'boolean)
(defcustom idlwave-shell-arrows-do-history t
- "*Non-nil means UP and DOWN arrows move through command history.
+ "Non-nil means UP and DOWN arrows move through command history.
This variable can have 3 values:
nil Arrows just move the cursor
t Arrows force the cursor back to the current command line and
@@ -166,7 +164,7 @@ t Arrows force the cursor back to the current command line and
;; FIXME: add comint-input-ring-size?
(defcustom idlwave-shell-use-toolbar t
- "*Non-nil means, use the debugging toolbar in all IDL related buffers.
+ "Non-nil means, use the debugging toolbar in all IDL related buffers.
Starting the shell will then add the toolbar to all idlwave-mode buffers.
Exiting the shell will removed everywhere.
Available on XEmacs and on Emacs 21.x or later.
@@ -176,21 +174,15 @@ At any time you can toggle the display of the toolbar with
:type 'boolean)
(defcustom idlwave-shell-temp-pro-prefix "/tmp/idltemp"
- "*The prefix for temporary IDL files used when compiling regions.
+ "The prefix for temporary IDL files used when compiling regions.
It should be an absolute pathname.
The full temporary file name is obtained by using `make-temp-file'
so that the name will be unique among multiple Emacs processes."
:group 'idlwave-shell-general-setup
:type 'string)
-(defvar idlwave-shell-fix-inserted-breaks nil
- "*OBSOLETE VARIABLE, is no longer used.
-
-The documentation of this variable used to be:
-If non-nil then run `idlwave-shell-remove-breaks' to clean up IDL messages.")
-
(defcustom idlwave-shell-prefix-key "\C-c\C-d"
- "*The prefix key for the debugging map `idlwave-shell-mode-prefix-map'.
+ "The prefix key for the debugging map `idlwave-shell-mode-prefix-map'.
This variable must already be set when idlwave-shell.el is loaded.
Setting it in the mode-hook is too late."
:group 'idlwave-shell-general-setup
@@ -223,11 +215,8 @@ window, but is useful for stepping, etc."
;; (defcustom idlwave-shell-debug-modifiers... See idlwave.el
-(defvar idlwave-shell-activate-alt-keybindings nil
- "Obsolete variable. See `idlwave-shell-debug-modifiers'.")
-
(defcustom idlwave-shell-use-truename nil
- "*Non-nil means, use use `file-truename' when looking for buffers.
+ "Non-nil means, use `file-truename' when looking for buffers.
If this variable is non-nil, Emacs will use the function `file-truename' to
resolve symbolic links in the file paths printed by e.g., STOP commands.
This means, unvisited files will be loaded under their truename.
@@ -247,7 +236,7 @@ because these are used as separators by IDL."
:type 'string)
(defcustom idlwave-shell-mode-hook '()
- "*Hook for customizing `idlwave-shell-mode'."
+ "Hook for customizing `idlwave-shell-mode'."
:group 'idlwave-shell-general-setup
:type 'hook)
@@ -292,7 +281,7 @@ is non-nil."
(defcustom idlwave-shell-show-commands
'(run misc breakpoint)
- "*A list of command types to show output from in the shell.
+ "A list of command types to show output from in the shell.
Possibilities are 'run, 'debug, 'breakpoint, and 'misc. Unselected
types are not displayed in the shell. The type 'everything causes all
the copious shell traffic to be displayed."
@@ -335,11 +324,8 @@ expression being examined."
(string :tag "Label ")
(string :tag "Command"))))
-(defvar idlwave-shell-print-expression-function nil
- "*OBSOLETE VARIABLE, is no longer used.")
-
(defcustom idlwave-shell-separate-examine-output t
- "*Non-nil means, put output of examine commands in their own buffer."
+ "Non-nil means, put output of examine commands in their own buffer."
:group 'idlwave-shell-command-setup
:type 'boolean)
@@ -359,12 +345,12 @@ newly created."
(cons variable sexp)))
(defcustom idlwave-shell-query-for-class t
- "*Non-nil means query the shell for object class on object completions."
+ "Non-nil means query the shell for object class on object completions."
:group 'idlwave-shell-command-setup
:type 'boolean)
(defcustom idlwave-shell-use-input-mode-magic nil
- "*Non-nil means, IDLWAVE should check for input mode spells in output.
+ "Non-nil means, IDLWAVE should check for input mode spells in output.
The spells are strings printed by your IDL program and matched
by the regular expressions in `idlwave-shell-input-mode-spells'.
When these expressions match, IDLWAVE switches to character input mode and
@@ -432,7 +418,7 @@ end"
(regexp :tag "Line-mode regexp")))
(defcustom idlwave-shell-breakpoint-popup-menu t
- "*If non-nil, provide a menu on mouse-3 on breakpoint lines, and
+ "If non-nil, provide a menu on mouse-3 on breakpoint lines, and
popup help text on the line."
:group 'idlwave-shell-command-setup
:type 'boolean)
@@ -449,7 +435,7 @@ popup help text on the line."
:group 'idlwave)
(defcustom idlwave-shell-mark-stop-line t
- "*Non-nil means, mark the source code line where IDL is currently stopped.
+ "Non-nil means, mark the source code line where IDL is currently stopped.
Value decides about the method which is used to mark the line. Valid values
are:
@@ -471,7 +457,7 @@ hides any code, so setting this to 'arrow on Emacs 21 sounds like a good idea."
(const :tag "Face or arrow." t)))
(defcustom idlwave-shell-overlay-arrow ">"
- "*The overlay arrow to display at source lines where execution halts.
+ "The overlay arrow to display at source lines where execution halts.
We use a single character by default, since the main block of IDL procedures
often has no indentation. Where possible, IDLWAVE will use overlays to
display the stop-lines. The arrow is only used on character-based terminals.
@@ -480,33 +466,33 @@ See also `idlwave-shell-use-overlay-arrow'."
:type 'string)
(defcustom idlwave-shell-stop-line-face 'highlight
- "*The face for `idlwave-shell-stop-line-overlay'.
+ "The face for `idlwave-shell-stop-line-overlay'.
Allows you to choose the font, color and other properties for
line where IDL is stopped. See also `idlwave-shell-mark-stop-line'."
:group 'idlwave-shell-highlighting-and-faces
:type 'symbol)
(defcustom idlwave-shell-electric-stop-color "Violet"
- "*The color for the default face or overlay arrow when stopped."
+ "The color for the default face or overlay arrow when stopped."
:group 'idlwave-shell-highlighting-and-faces
:type 'string)
(defcustom idlwave-shell-electric-stop-line-face
(prog1
- (copy-face 'modeline 'idlwave-shell-electric-stop-line)
+ (copy-face 'mode-line 'idlwave-shell-electric-stop-line)
(set-face-background 'idlwave-shell-electric-stop-line
idlwave-shell-electric-stop-color)
(condition-case nil
(set-face-foreground 'idlwave-shell-electric-stop-line nil)
(error nil)))
- "*The face for `idlwave-shell-stop-line-overlay' when in electric debug mode.
+ "The face for `idlwave-shell-stop-line-overlay' when in electric debug mode.
Allows you to choose the font, color and other properties for the line
where IDL is stopped, when in Electric Debug Mode."
:group 'idlwave-shell-highlighting-and-faces
:type 'symbol)
(defcustom idlwave-shell-mark-breakpoints t
- "*Non-nil means, mark breakpoints in the source files.
+ "Non-nil means, mark breakpoints in the source files.
Valid values are:
nil Do not mark breakpoints.
'face Highlight line with `idlwave-shell-breakpoint-face'.
@@ -520,11 +506,8 @@ t Glyph when possible, otherwise face (same effect as 'glyph)."
(const :tag "Display glyph (red dot)" glyph)
(const :tag "Glyph or face." t)))
-(defvar idlwave-shell-use-breakpoint-glyph t
- "Obsolete variable. See `idlwave-shell-mark-breakpoints'.")
-
(defcustom idlwave-shell-breakpoint-face 'idlwave-shell-bp
- "*The face for breakpoint lines in the source code.
+ "The face for breakpoint lines in the source code.
Allows you to choose the font, color and other properties for
lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'."
:group 'idlwave-shell-highlighting-and-faces
@@ -542,7 +525,7 @@ lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'."
(defcustom idlwave-shell-disabled-breakpoint-face
'idlwave-shell-disabled-bp
- "*The face for disabled breakpoint lines in the source code.
+ "The face for disabled breakpoint lines in the source code.
Allows you to choose the font, color and other properties for
lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'."
:group 'idlwave-shell-highlighting-and-faces
@@ -560,14 +543,14 @@ lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'."
(defcustom idlwave-shell-expression-face 'secondary-selection
- "*The face for `idlwave-shell-expression-overlay'.
+ "The face for `idlwave-shell-expression-overlay'.
Allows you to choose the font, color and other properties for
the expression printed by IDL."
:group 'idlwave-shell-highlighting-and-faces
:type 'symbol)
(defcustom idlwave-shell-output-face 'secondary-selection
- "*The face for `idlwave-shell-output-overlay'.
+ "The face for `idlwave-shell-output-overlay'.
Allows you to choose the font, color and other properties for
the expression output by IDL."
:group 'idlwave-shell-highlighting-and-faces
@@ -784,7 +767,7 @@ with `*'s."
"^% Skipped to:"
"^% Stop encountered:"
)
- "*A list of regular expressions matching IDL messages.
+ "A list of regular expressions matching IDL messages.
These are the messages containing file and line information where
IDL is currently stopped.")
@@ -795,19 +778,19 @@ IDL is currently stopped.")
(defconst idlwave-shell-trace-message-re
"^% At " ;; First line of a trace message
- "*A regular expression matching IDL trace messages. These are the
+ "A regular expression matching IDL trace messages. These are the
messages containing file and line information of a current
traceback.")
(defconst idlwave-shell-step-messages
'("^% Stepped to:"
)
- "*A list of regular expressions matching stepped execution messages.
+ "A list of regular expressions matching stepped execution messages.
These are IDL messages containing file and line information where
IDL has currently stepped.")
(defvar idlwave-shell-break-message "^% Breakpoint at:"
- "*Regular expression matching an IDL breakpoint message line.")
+ "Regular expression matching an IDL breakpoint message line.")
(defconst idlwave-shell-electric-debug-help
" ==> IDLWAVE Electric Debug Mode Help <==
@@ -1672,7 +1655,7 @@ number.")
"\\([ \t]*\n[ \t]*[^ \t\n]+\\)*" ; continuation lines file name (6)
"\\)" ; end line number group (5)
)
- "*A regular expression to parse out the file name and line number.
+ "A regular expression to parse out the file name and line number.
The 1st group should match the subroutine name.
The 3rd group is the line number.
The 5th group is the file name.
@@ -2187,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."
@@ -4198,12 +4181,8 @@ Otherwise, just expand the file name."
([( ?[)] ?[ idlwave-shell-goto-previous-bp t t)
([( ?])] ?] idlwave-shell-goto-next-bp t t)
([(control ?f)] ?f idlwave-shell-window)))
- (mod (cond ((and idlwave-shell-debug-modifiers
- (listp idlwave-shell-debug-modifiers)
- (not (equal '() idlwave-shell-debug-modifiers)))
- idlwave-shell-debug-modifiers)
- (idlwave-shell-activate-alt-keybindings
- '(alt))))
+ (mod (and (listp idlwave-shell-debug-modifiers)
+ idlwave-shell-debug-modifiers))
(shift (memq 'shift mod))
(mod-noshift (delete 'shift (copy-sequence mod)))
s k1 c2 k2 cmd electric only-buffer cannotshift)
diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el
index d4eddee9722..1dad455d37e 100644
--- a/lisp/progmodes/idlw-toolbar.el
+++ b/lisp/progmodes/idlw-toolbar.el
@@ -1,6 +1,6 @@
;;; idlw-toolbar.el --- a debugging toolbar for IDLWAVE
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@astro.uva.nl>
;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu>
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 6ce415b563d..e58fb2b3eab 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -1,6 +1,6 @@
;; idlwave.el --- IDL editing mode for GNU Emacs
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Authors: J.D. Smith <jdsmith@as.arizona.edu>
;; Carsten Dominik <dominik@science.uva.nl>
@@ -51,7 +51,7 @@
;;
;; Follow the instructions in the INSTALL file of the distribution.
;; In short, put this file on your load path and add the following
-;; lines to your .emacs file:
+;; lines to your init file:
;;
;; (autoload 'idlwave-mode "idlwave" "IDLWAVE Mode" t)
;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t)
@@ -195,34 +195,34 @@
:group 'idlwave)
(defcustom idlwave-main-block-indent 2
- "*Extra indentation for the main block of code.
+ "Extra indentation for the main block of code.
That is the block between the FUNCTION/PRO statement and the END
statement for that program unit."
:group 'idlwave-code-formatting
:type 'integer)
(defcustom idlwave-block-indent 3
- "*Extra indentation applied to block lines.
+ "Extra indentation applied to block lines.
If you change this, you probably also want to change `idlwave-end-offset'."
:group 'idlwave-code-formatting
:type 'integer)
(defcustom idlwave-end-offset -3
- "*Extra indentation applied to block END lines.
+ "Extra indentation applied to block END lines.
A value equal to negative `idlwave-block-indent' will make END lines
line up with the block BEGIN lines."
:group 'idlwave-code-formatting
:type 'integer)
(defcustom idlwave-continuation-indent 3
- "*Extra indentation applied to continuation lines.
+ "Extra indentation applied to continuation lines.
This extra offset applies to the first of a set of continuation lines.
The following lines receive the same indentation as the first."
:group 'idlwave-code-formatting
:type 'integer)
(defcustom idlwave-max-extra-continuation-indent 40
- "*Maximum additional indentation for special continuation indent.
+ "Maximum additional indentation for special continuation indent.
Several special indentations are tried to help line up continuation
lines in routine calls or definitions, other statements with
parentheses, or assignment statements. This variable specifies a
@@ -236,7 +236,7 @@ this variable."
:type 'integer)
(defcustom idlwave-indent-to-open-paren t
- "*Non-nil means, indent continuation lines to innermost open parenthesis.
+ "Non-nil means, indent continuation lines to innermost open parenthesis.
This indentation occurs even if otherwise disallowed by
`idlwave-max-extra-continuation-indent'. Matching parens and the
interleaving args are lined up. Example:
@@ -260,38 +260,38 @@ would yield:
:type 'boolean)
(defcustom idlwave-indent-parens-nested nil
- "*Non-nil means, indent continuation lines with parens by nesting
+ "Non-nil means, indent continuation lines with parens by nesting
lines at consecutively deeper levels."
:group 'idlwave-code-formatting
:type 'boolean)
(defcustom idlwave-hanging-indent t
- "*If set non-nil then comment paragraphs are indented under the
+ "If set non-nil then comment paragraphs are indented under the
hanging indent given by `idlwave-hang-indent-regexp' match in the first line
of the paragraph."
:group 'idlwave-code-formatting
:type 'boolean)
(defcustom idlwave-hang-indent-regexp "- "
- "*Regular expression matching the position of the hanging indent
+ "Regular expression matching the position of the hanging indent
in the first line of a comment paragraph. The size of the indent
extends to the end of the match for the regular expression."
:group 'idlwave-code-formatting
:type 'regexp)
(defcustom idlwave-use-last-hang-indent nil
- "*If non-nil then use last match on line for `idlwave-indent-regexp'."
+ "If non-nil then use last match on line for `idlwave-indent-regexp'."
:group 'idlwave-code-formatting
:type 'boolean)
(defcustom idlwave-fill-comment-line-only t
- "*If non-nil then auto fill will only operate on comment lines."
+ "If non-nil then auto fill will only operate on comment lines."
:group 'idlwave-code-formatting
:type 'boolean)
(defcustom idlwave-auto-fill-split-string t
- "*If non-nil then auto fill will split strings with the IDL `+' operator.
+ "If non-nil then auto fill will split strings with the IDL `+' operator.
When the line end falls within a string, string concatenation with the
'+' operator will be used to distribute a long string over lines.
If nil and a string is split then a terminal beep and warning are issued.
@@ -302,7 +302,7 @@ non-nil, since in this case code is not auto-filled."
:type 'boolean)
(defcustom idlwave-split-line-string t
- "*If non-nil then `idlwave-split-line' will split strings with `+'.
+ "If non-nil then `idlwave-split-line' will split strings with `+'.
When the splitting point of a line falls inside a string, split the string
using the `+' string concatenation operator. If nil and a string is
split then a terminal beep and warning are issued."
@@ -310,14 +310,14 @@ split then a terminal beep and warning are issued."
:type 'boolean)
(defcustom idlwave-no-change-comment ";;;"
- "*The indentation of a comment that starts with this regular
+ "The indentation of a comment that starts with this regular
expression will not be changed. Note that the indentation of a comment
at the beginning of a line is never changed."
:group 'idlwave-code-formatting
:type 'string)
(defcustom idlwave-begin-line-comment nil
- "*A comment anchored at the beginning of line.
+ "A comment anchored at the beginning of line.
A comment matching this regular expression will not have its
indentation changed. If nil the default is \"^;\", i.e., any line
beginning with a \";\". Expressions for comments at the beginning of
@@ -327,7 +327,7 @@ the line should begin with \"^\"."
'regexp))
(defcustom idlwave-code-comment ";;[^;]"
- "*A comment that starts with this regular expression on a line by
+ "A comment that starts with this regular expression on a line by
itself is indented as if it is a part of IDL code. As a result if
the comment is not preceded by whitespace it is unchanged."
:group 'idlwave-code-formatting
@@ -343,7 +343,7 @@ the comment is not preceded by whitespace it is unchanged."
:group 'idlwave)
(defcustom idlwave-use-library-catalogs t
- "*Non-nil means search the IDL path for library catalog files.
+ "Non-nil means search the IDL path for library catalog files.
These files, named .idlwave_catalog, document routine information for
individual directories and libraries of IDL .pro files. Many popular
@@ -353,7 +353,7 @@ usually a good idea."
:type 'boolean)
(defcustom idlwave-init-rinfo-when-idle-after 10
- "*Seconds of idle time before routine info is automatically initialized.
+ "Seconds of idle time before routine info is automatically initialized.
Initializing the routine info can take a long time, in particular if a
large number of library catalogs are involved. When Emacs is idle for
more than the number of seconds specified by this variable, it starts
@@ -370,7 +370,7 @@ needed, and initialize then."
:type 'number)
(defcustom idlwave-scan-all-buffers-for-routine-info t
- "*Non-nil means, scan buffers for IDL programs when updating info.
+ "Non-nil means, scan buffers for IDL programs when updating info.
The scanning is done by the command `idlwave-update-routine-info'.
The following values are allowed:
@@ -384,7 +384,7 @@ current Scan only the current buffer, but no other buffers."
(const :tag "Current buffer only" 'current)))
(defcustom idlwave-query-shell-for-routine-info t
- "*Non-nil means query the shell for info about compiled routines.
+ "Non-nil means query the shell for info about compiled routines.
Querying the shell is useful to get information about compiled modules,
and it is turned on by default. However, when you have a complete library
scan, this is not necessary."
@@ -393,7 +393,7 @@ scan, this is not necessary."
(defcustom idlwave-auto-routine-info-updates
'(find-file save-buffer kill-buffer compile-buffer)
- "*Controls under what circumstances routine info is updated automatically.
+ "Controls under what circumstances routine info is updated automatically.
Possible values:
nil Never
t All available
@@ -413,7 +413,7 @@ t All available
(const :tag "After a buffer was compiled successfully, update shell info" compile-buffer))))
(defcustom idlwave-rinfo-max-source-lines 5
- "*Maximum number of source files displayed in the Routine Info window.
+ "Maximum number of source files displayed in the Routine Info window.
When an integer, it is the maximum number of source files displayed.
A value of t means to show all source files."
:group 'idlwave-routine-info
@@ -448,7 +448,7 @@ value of `!DIR'. See also `idlwave-library-path'."
;; Configuration files
(defcustom idlwave-config-directory
(convert-standard-filename "~/.idlwave")
- "*Directory for configuration files and user-library catalog."
+ "Directory for configuration files and user-library catalog."
:group 'idlwave-routine-info
:type 'file)
@@ -456,9 +456,6 @@ value of `!DIR'. See also `idlwave-library-path'."
(defvar idlwave-xml-system-rinfo-converted-file "idl_xml_rinfo.el")
(defvar idlwave-path-file "idlpath.el")
-(defvar idlwave-libinfo-file nil
- "*Obsolete variable, no longer used.")
-
(defcustom idlwave-special-lib-alist nil
"Alist of regular expressions matching special library directories.
When listing routine source locations, IDLWAVE gives a short hint where
@@ -538,7 +535,7 @@ After changing this variable, you need to either restart Emacs or press
,idlwave-tmp)))
(defcustom idlwave-completion-force-default-case nil
- "*Non-nil means, completion will always honor `idlwave-completion-case'.
+ "Non-nil means, completion will always honor `idlwave-completion-case'.
When nil, only the completion of a mixed case or upper case string
will honor the default settings in `idlwave-completion-case', while
the completion of lower case strings will be completed entirely in
@@ -547,7 +544,7 @@ lower case."
:type 'boolean)
(defcustom idlwave-complete-empty-string-as-lower-case nil
- "*Non-nil means, the empty string is considered downcase for completion.
+ "Non-nil means, the empty string is considered downcase for completion.
The case of what is already in the buffer determines the case of completions.
When this variable is non-nil, the empty string is considered to be downcase.
Completing on the empty string then offers downcase versions of the possible
@@ -555,12 +552,8 @@ completions."
:group 'idlwave-completion
:type 'boolean)
-(defvar idlwave-default-completion-case-is-down nil
- "Obsolete variable. See `idlwave-complete-empty-string-as-lower-case' and
-`idlwave-completion-case'.")
-
(defcustom idlwave-buffer-case-takes-precedence nil
- "*Non-nil means, the case of tokens in buffers dominates over system stuff.
+ "Non-nil means, the case of tokens in buffers dominates over system stuff.
To make this possible, we need to re-case everything each time we update
the routine info from the buffers. This is slow.
The default is to consider the case given in the system and library files
@@ -569,7 +562,7 @@ first which makes updating much faster."
:type 'boolean)
(defcustom idlwave-highlight-help-links-in-completion t
- "*Non-nil means, highlight completions for which system help is available.
+ "Non-nil means, highlight completions for which system help is available.
Help can then be accessed with mouse-3.
This option is only effective when the online help system is installed."
:group 'idlwave-completion
@@ -594,7 +587,7 @@ for which to assume this can be set here."
(defcustom idlwave-completion-show-classes 1
- "*Number of classes to show when completing object methods and keywords.
+ "Number of classes to show when completing object methods and keywords.
When completing methods or keywords for an object with unknown class,
the *Completions* buffer will show the valid classes for each completion
like this:
@@ -613,7 +606,7 @@ negative integer, the `help-echo' property will be suppressed."
(integer :tag "Number of classes shown" 1)))
(defcustom idlwave-completion-fontify-classes t
- "*Non-nil means, fontify the classes in completions buffer.
+ "Non-nil means, fontify the classes in completions buffer.
This makes it easier to distinguish the completion items from the extra
class info listed. See `idlwave-completion-show-classes'."
:group 'idlwave-completion
@@ -673,7 +666,7 @@ method, add an entry (\"INIT\" . t). The method name must be ALL-CAPS."
(boolean :tag "Determine class for this method")))))
(defcustom idlwave-store-inquired-class t
- "*Non-nil means, store class of a method call as text property on `->'.
+ "Non-nil means, store class of a method call as text property on `->'.
IDLWAVE sometimes has to ask the user for the class associated with a
particular object method call. This happens during the commands
`idlwave-routine-info' and `idlwave-complete', depending upon the
@@ -698,7 +691,7 @@ at point."
:type 'boolean)
(defcustom idlwave-class-arrow-face 'bold
- "*Face to highlight object operator arrows `->' which carry a class property.
+ "Face to highlight object operator arrows `->' which carry a class property.
When IDLWAVE stores a class name as text property on an object arrow
\(see variable `idlwave-store-inquired-class', it highlights the arrow
with this font in order to remind the user that this arrow is special."
@@ -706,17 +699,17 @@ with this font in order to remind the user that this arrow is special."
:type 'symbol)
(defcustom idlwave-resize-routine-help-window t
- "*Non-nil means, resize the Routine-info *Help* window to fit the content."
+ "Non-nil means, resize the Routine-info *Help* window to fit the content."
:group 'idlwave-completion
:type 'boolean)
(defcustom idlwave-keyword-completion-adds-equal t
- "*Non-nil means, completion automatically adds `=' after completed keywords."
+ "Non-nil means, completion automatically adds `=' after completed keywords."
:group 'idlwave-completion
:type 'boolean)
(defcustom idlwave-function-completion-adds-paren t
- "*Non-nil means, completion automatically adds `(' after completed function.
+ "Non-nil means, completion automatically adds `(' after completed function.
nil means, don't add anything.
A value of `2' means, also add the closing parenthesis and position cursor
between the two."
@@ -726,7 +719,7 @@ between the two."
(const :tag "()" 2)))
(defcustom idlwave-completion-restore-window-configuration t
- "*Non-nil means, try to restore the window configuration after completion.
+ "Non-nil means, try to restore the window configuration after completion.
When completion is not unique, Emacs displays a list of completions.
This messes up your window configuration. With this variable set, IDLWAVE
restores the old configuration after successful completion."
@@ -741,25 +734,25 @@ The variables in this group govern this."
:group 'idlwave)
(defcustom idlwave-do-actions nil
- "*Non-nil means performs actions when indenting.
+ "Non-nil means performs actions when indenting.
The actions that can be performed are listed in `idlwave-indent-action-table'."
:group 'idlwave-abbrev-and-indent-action
:type 'boolean)
(defcustom idlwave-abbrev-start-char "\\"
- "*A single character string used to start abbreviations in abbrev mode.
+ "A single character string used to start abbreviations in abbrev mode.
Possible characters to chose from: ~`\%
or even '?'. '.' is not a good choice because it can make structure
field names act like abbrevs in certain circumstances.
Changes to this in `idlwave-mode-hook' will have no effect. Instead a user
-must set it directly using `setq' in the .emacs file before idlwave.el
+must set it directly using `setq' in the init file before idlwave.el
is loaded."
:group 'idlwave-abbrev-and-indent-action
:type 'string)
(defcustom idlwave-surround-by-blank nil
- "*Non-nil means, enable `idlwave-surround'.
+ "Non-nil means, enable `idlwave-surround'.
If non-nil, `=',`<',`>',`&',`,', `->' are surrounded with spaces by
`idlwave-surround'.
See help for `idlwave-indent-action-table' for symbols using `idlwave-surround'.
@@ -774,7 +767,7 @@ Also see help for `idlwave-surround'."
:type 'boolean)
(defcustom idlwave-pad-keyword t
- "*Non-nil means pad '=' in keywords (routine calls or defs) like assignment.
+ "Non-nil means pad '=' in keywords (routine calls or defs) like assignment.
Whenever `idlwave-surround' is non-nil then this affects how '=' is
padded for keywords and for variables. If t, pad the same as for
assignments. If nil then spaces are removed. With any other value,
@@ -786,22 +779,22 @@ spaces are left unchanged."
(const :tag "Keep space near `='" 'keep)))
(defcustom idlwave-show-block t
- "*Non-nil means point blinks to block beginning for `idlwave-show-begin'."
+ "Non-nil means point blinks to block beginning for `idlwave-show-begin'."
:group 'idlwave-abbrev-and-indent-action
:type 'boolean)
(defcustom idlwave-expand-generic-end nil
- "*Non-nil means expand generic END to ENDIF/ENDELSE/ENDWHILE etc."
+ "Non-nil means expand generic END to ENDIF/ENDELSE/ENDWHILE etc."
:group 'idlwave-abbrev-and-indent-action
:type 'boolean)
(defcustom idlwave-reindent-end t
- "*Non-nil means re-indent line after END was typed."
+ "Non-nil means re-indent line after END was typed."
:group 'idlwave-abbrev-and-indent-action
:type 'boolean)
(defcustom idlwave-abbrev-move t
- "*Non-nil means the abbrev hook can move point.
+ "Non-nil means the abbrev hook can move point.
Set to nil by `idlwave-expand-region-abbrevs'. To see the abbrev
definitions, use the command `list-abbrevs', for abbrevs that move
point. Moving point is useful, for example, to place point between
@@ -812,7 +805,7 @@ See `idlwave-check-abbrev'."
:type 'boolean)
(defcustom idlwave-abbrev-change-case nil
- "*Non-nil means all abbrevs will be forced to either upper or lower case.
+ "Non-nil means all abbrevs will be forced to either upper or lower case.
If the value t, all expanded abbrevs will be upper case.
If the value is 'down then abbrevs will be forced to lower case.
If nil, the case will not change.
@@ -822,7 +815,7 @@ upper case, regardless of this variable."
:type 'boolean)
(defcustom idlwave-reserved-word-upcase nil
- "*Non-nil means, reserved words will be made upper case via abbrev expansion.
+ "Non-nil means, reserved words will be made upper case via abbrev expansion.
If nil case of reserved words is controlled by `idlwave-abbrev-change-case'.
Has effect only if in abbrev-mode."
:group 'idlwave-abbrev-and-indent-action
@@ -859,7 +852,7 @@ Has effect only if in abbrev-mode."
;; '(capitalize-word -1) t)
(defvar idlwave-indent-action-table nil
- "*Associated array containing action lists of search string (car),
+ "Associated array containing action lists of search string (car),
and function as a cdr. This table is used by `idlwave-indent-line'.
See documentation for `idlwave-do-action' for a complete description of
the action lists.
@@ -869,7 +862,7 @@ binding is not requested.
See help on `idlwave-action-and-binding' for examples.")
(defvar idlwave-indent-expand-table nil
- "*Associated array containing action lists of search string (car),
+ "Associated array containing action lists of search string (car),
and function as a cdr. The table is used by the
`idlwave-indent-and-action' function. See documentation for
`idlwave-do-action' for a complete description of the action lists.
@@ -948,14 +941,14 @@ See help on `idlwave-action-and-binding' for examples.")
;
;-
")
- "*A list (PATHNAME STRING) specifying the doc-header template to use for
+ "A list (PATHNAME STRING) specifying the doc-header template to use for
summarizing a file. If PATHNAME is non-nil then this file will be included.
Otherwise STRING is used. If nil, the file summary will be omitted.
For example you might set PATHNAME to the path for the
lib_template.pro file included in the IDL distribution.")
(defcustom idlwave-header-to-beginning-of-file t
- "*Non-nil means, the documentation header will always be at start of file.
+ "Non-nil means, the documentation header will always be at start of file.
When nil, the header is positioned between the PRO/FUNCTION line of
the current routine and the code, allowing several routine headers in
a file."
@@ -963,12 +956,12 @@ a file."
:type 'boolean)
(defcustom idlwave-timestamp-hook 'idlwave-default-insert-timestamp
- "*The hook function used to update the timestamp of a function."
+ "The hook function used to update the timestamp of a function."
:group 'idlwave-documentation
:type 'function)
(defcustom idlwave-doc-modifications-keyword "HISTORY"
- "*The modifications keyword to use with the log documentation commands.
+ "The modifications keyword to use with the log documentation commands.
A ':' is added to the keyword end.
Inserted by doc-header and used to position logs by doc-modification.
If nil it will not be inserted."
@@ -976,12 +969,12 @@ If nil it will not be inserted."
:type 'string)
(defcustom idlwave-doclib-start "^;+\\+"
- "*Regexp matching the start of a document library header."
+ "Regexp matching the start of a document library header."
:group 'idlwave-documentation
:type 'regexp)
(defcustom idlwave-doclib-end "^;+-"
- "*Regexp matching the end of a document library header."
+ "Regexp matching the end of a document library header."
:group 'idlwave-documentation
:type 'regexp)
@@ -992,7 +985,7 @@ If nil it will not be inserted."
:group 'idlwave)
(defcustom idlwave-shell-explicit-file-name "idl"
- "*If non-nil, this is the command to run IDL.
+ "If non-nil, this is the command to run IDL.
Should be an absolute file path or path relative to the current environment
execution search path. If you want to specify command line switches
for the IDL program, use `idlwave-shell-command-line-options'.
@@ -1003,7 +996,7 @@ it without compromising backwards-compatibility."
:type 'string)
(defcustom idlwave-shell-command-line-options nil
- "*A list of command line options for calling the IDL program.
+ "A list of command line options for calling the IDL program.
Since IDL is executed directly without going through a shell like /bin/sh,
this should be a list of strings like '(\"-rt=file\" \"-nw\") with a separate
string for each argument. But you may also give a single string which
@@ -1015,7 +1008,7 @@ split it for you."
:group 'idlwave-external-programs)
(defcustom idlwave-help-application "idlhelp"
- "*The external application providing reference help for programming.
+ "The external application providing reference help for programming.
Obsolete, if the IDL Assistant is being used for help."
:group 'idlwave-external-programs
:type 'string)
@@ -1040,7 +1033,7 @@ are `control', `meta', `super', `hyper', `alt', and `shift'."
(const shift)))
(defcustom idlwave-shell-automatic-start nil
- "*If non-nil attempt invoke `idlwave-shell' if not already running.
+ "If non-nil attempt invoke `idlwave-shell' if not already running.
This is checked when an attempt to send a command to an
IDL process is made."
:group 'idlwave-shell-general-setup
@@ -1054,7 +1047,7 @@ IDL process is made."
:group 'idlwave)
(defcustom idlwave-startup-message t
- "*Non-nil displays a startup message when `idlwave-mode' is first called."
+ "Non-nil displays a startup message when `idlwave-mode' is first called."
:group 'idlwave-misc
:type 'boolean)
@@ -1158,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
@@ -1176,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
@@ -1202,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
@@ -4525,8 +4518,6 @@ information updated immediately, leave NO-CONCATENATE nil."
nil 'idlwave-load-rinfo-next-step)))
(error nil))))
-(defvar idlwave-library-routines nil "Obsolete variable.")
-
;;------ XML Help routine info system
(defun idlwave-load-system-routine-info ()
;; Load the system routine info from the cached routine info file,
@@ -5244,9 +5235,7 @@ Can run from `after-save-hook'."
class
(cond ((not (boundp 'idlwave-scanning-lib))
(list 'buffer (buffer-file-name)))
-; ((string= (downcase
-; (file-name-sans-extension
-; (file-name-nondirectory (buffer-file-name))))
+; ((string= (downcase (file-name-base))
; (downcase name))
; (list 'lib))
; (t (cons 'lib (file-name-nondirectory (buffer-file-name))))
@@ -7855,7 +7844,7 @@ Restore the pre-completion window configuration if possible."
If point is on a keyword, help for that keyword will be shown. If
point is on a routine name or in the argument list of a routine, help
for that routine will be displayed. Works for system routines and
-keywords, it pulls up text help. For other routies and keywords,
+keywords, it pulls up text help. For other routines and keywords,
visits the source file, finding help in the header (if
`idlwave-help-source-try-header' is non-nil) or the routine definition
itself."
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index dd24aeea9a3..f2578c14066 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -1,6 +1,6 @@
;;; inf-lisp.el --- an inferior-lisp mode
-;; Copyright (C) 1988, 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
;; Keywords: processes, lisp
@@ -69,10 +69,9 @@
:group 'lisp
:version "22.1")
-;;;###autoload
(defcustom inferior-lisp-filter-regexp
- (purecopy "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'")
- "*What not to save on inferior Lisp's input history.
+ "\\`\\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.)"
@@ -137,15 +136,13 @@ 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")
- "*Program name for invoking an inferior Lisp in Inferior Lisp mode."
+(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")
- "*Format-string for building a Lisp expression to load a file.
+(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
to load that file. The default works acceptably on most Lisps.
@@ -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
@@ -168,9 +164,7 @@ This variable is only used if the variable
More precise choices:
Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
-kcl: \"^>+ *\"
-
-This is a fine thing to set in your .emacs file or through Custom."
+kcl: \"^>+ *\""
:type 'regexp
:group 'inferior-lisp)
@@ -209,9 +203,8 @@ 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.")
+ "Hook for customizing Inferior Lisp mode.")
(put 'inferior-lisp-mode 'mode-class 'special)
@@ -453,7 +446,7 @@ This holds a cons cell of the form `(DIRECTORY . FILE)'
describing the last `lisp-load-file' or `lisp-compile-file' command.")
(defcustom lisp-source-modes '(lisp-mode)
- "*Used to determine if a buffer contains Lisp source code.
+ "Used to determine if a buffer contains Lisp source code.
If it's loaded into a buffer that is in one of these major modes, it's
considered a Lisp source file by `lisp-load-file' and `lisp-compile-file'.
Used by these commands to determine defaults."
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index f0c86265232..33ef7607671 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -1,6 +1,6 @@
-;;; js.el --- Major mode for editing JavaScript
+;;; js.el --- Major mode for editing JavaScript -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Karl Landstrom <karl.landstrom@brgeight.se>
;; Daniel Colascione <dan.colascione@gmail.com>
@@ -54,7 +54,7 @@
(require 'json nil t)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'comint)
(require 'ido))
@@ -240,12 +240,11 @@ name as matched contains
")
(defconst js--available-frameworks
- (loop with available-frameworks
- for style in js--class-styles
- for framework = (plist-get style :framework)
- unless (memq framework available-frameworks)
- collect framework into available-frameworks
- finally return available-frameworks)
+ (cl-loop for style in js--class-styles
+ for framework = (plist-get style :framework)
+ unless (memq framework available-frameworks)
+ collect framework into available-frameworks
+ finally return available-frameworks)
"List of available JavaScript frameworks symbols.")
(defconst js--function-heading-1-re
@@ -369,11 +368,12 @@ Match group 1 is the name of the macro.")
;; must be h-end.
;;
;; js--pitem instances are never modified (with the exception
-;; of the b-end field). Instead, modified copies are added at subseqnce parse points.
+;; of the b-end field). Instead, modified copies are added at
+;; subsequence parse points.
;; (The exception for b-end and its caveats is described below.)
;;
-(defstruct (js--pitem (:type list))
+(cl-defstruct (js--pitem (:type list))
;; IMPORTANT: Do not alter the position of fields within the list.
;; Various bits of code depend on their positions, particularly
;; anything that manipulates the list of children.
@@ -426,18 +426,21 @@ Match group 1 is the name of the macro.")
(defcustom js-indent-level 4
"Number of spaces for each indentation step in `js-mode'."
:type 'integer
+ :safe 'integerp
:group 'js)
(defcustom js-expr-indent-offset 0
"Number of additional spaces for indenting continued expressions.
The value must be no less than minus `js-indent-level'."
:type 'integer
+ :safe 'integerp
:group 'js)
(defcustom js-paren-indent-offset 0
"Number of additional spaces for indenting expressions in parentheses.
The value must be no less than minus `js-indent-level'."
:type 'integer
+ :safe 'integerp
:group 'js
:version "24.1")
@@ -445,6 +448,7 @@ The value must be no less than minus `js-indent-level'."
"Number of additional spaces for indenting expressions in square braces.
The value must be no less than minus `js-indent-level'."
:type 'integer
+ :safe 'integerp
:group 'js
:version "24.1")
@@ -452,6 +456,7 @@ The value must be no less than minus `js-indent-level'."
"Number of additional spaces for indenting expressions in curly braces.
The value must be no less than minus `js-indent-level'."
:type 'integer
+ :safe 'integerp
:group 'js
:version "24.1")
@@ -554,10 +559,10 @@ getting timeout messages."
(make-variable-buffer-local 'js--state-at-last-parse-pos)
(defun js--flatten-list (list)
- (loop for item in list
- nconc (cond ((consp item)
- (js--flatten-list item))
- (item (list item)))))
+ (cl-loop for item in list
+ nconc (cond ((consp item)
+ (js--flatten-list item))
+ (item (list item)))))
(defun js--maybe-join (prefix separator suffix &rest list)
"Helper function for `js--update-quick-match-re'.
@@ -767,13 +772,13 @@ If invoked while inside a macro, treat the macro as normal text."
"Move forward over a whole JavaScript expression.
This function doesn't move over expressions continued across
lines."
- (loop
+ (cl-loop
;; non-continued case; simplistic, but good enough?
- do (loop until (or (eolp)
- (progn
- (forward-comment most-positive-fixnum)
- (memq (char-after) '(?\, ?\; ?\] ?\) ?\}))))
- do (forward-sexp))
+ do (cl-loop until (or (eolp)
+ (progn
+ (forward-comment most-positive-fixnum)
+ (memq (char-after) '(?\, ?\; ?\] ?\) ?\}))))
+ do (forward-sexp))
while (and (eq (char-after) ?\n)
(save-excursion
@@ -787,7 +792,7 @@ This puts point at the 'function' keyword.
If this is a syntactically-correct non-expression function,
return the name of the function, or t if the name could not be
determined. Otherwise, return nil."
- (assert (looking-at "\\_<function\\_>"))
+ (cl-assert (looking-at "\\_<function\\_>"))
(let ((name t))
(forward-word)
(forward-comment most-positive-fixnum)
@@ -846,32 +851,32 @@ anything."
"Helper function for `js--beginning-of-defun-nested'.
If PSTATE represents a non-empty top-level defun, return the
top-most pitem. Otherwise, return nil."
- (loop for pitem in pstate
- with func-depth = 0
- with func-pitem
- if (eq 'function (js--pitem-type pitem))
- do (incf func-depth)
- and do (setq func-pitem pitem)
- finally return (if (eq func-depth 1) func-pitem)))
+ (cl-loop for pitem in pstate
+ with func-depth = 0
+ with func-pitem
+ if (eq 'function (js--pitem-type pitem))
+ do (cl-incf func-depth)
+ and do (setq func-pitem pitem)
+ finally return (if (eq func-depth 1) func-pitem)))
(defun js--beginning-of-defun-nested ()
"Helper function for `js--beginning-of-defun'.
Return the pitem of the function we went to the beginning of."
(or
;; Look for the smallest function that encloses point...
- (loop for pitem in (js--parse-state-at-point)
- if (and (eq 'function (js--pitem-type pitem))
- (js--inside-pitem-p pitem))
- do (goto-char (js--pitem-h-begin pitem))
- and return pitem)
+ (cl-loop for pitem in (js--parse-state-at-point)
+ if (and (eq 'function (js--pitem-type pitem))
+ (js--inside-pitem-p pitem))
+ do (goto-char (js--pitem-h-begin pitem))
+ and return pitem)
;; ...and if that isn't found, look for the previous top-level
;; defun
- (loop for pstate = (js--backward-pstate)
- while pstate
- if (js--pstate-is-toplevel-defun pstate)
- do (goto-char (js--pitem-h-begin it))
- and return it)))
+ (cl-loop for pstate = (js--backward-pstate)
+ while pstate
+ if (js--pstate-is-toplevel-defun pstate)
+ do (goto-char (js--pitem-h-begin it))
+ and return it)))
(defun js--beginning-of-defun-flat ()
"Helper function for `js-beginning-of-defun'."
@@ -883,7 +888,7 @@ Return the pitem of the function we went to the beginning of."
"Value of `beginning-of-defun-function' for `js-mode'."
(setq arg (or arg 1))
(while (and (not (eobp)) (< arg 0))
- (incf arg)
+ (cl-incf arg)
(when (and (not js-flat-functions)
(or (eq (js-syntactic-context) 'function)
(js--function-prologue-beginning)))
@@ -895,7 +900,7 @@ Return the pitem of the function we went to the beginning of."
(goto-char (point-max))))
(while (> arg 0)
- (decf arg)
+ (cl-decf arg)
;; If we're just past the end of a function, the user probably wants
;; to go to the beginning of *that* function
(when (eq (char-before) ?})
@@ -924,14 +929,14 @@ BEG defaults to `point-min', meaning to flush the entire cache."
(defun js--ensure-cache--pop-if-ended (open-items paren-depth)
(let ((top-item (car open-items)))
(when (<= paren-depth (js--pitem-paren-depth top-item))
- (assert (not (get-text-property (1- (point)) 'js-pend)))
+ (cl-assert (not (get-text-property (1- (point)) 'js-pend)))
(put-text-property (1- (point)) (point) 'js--pend top-item)
(setf (js--pitem-b-end top-item) (point))
(setq open-items
;; open-items must contain at least two items for this to
;; work, but because we push a dummy item to start with,
;; that assumption holds.
- (cons (js--pitem-add-child (second open-items) top-item)
+ (cons (js--pitem-add-child (cl-second open-items) top-item)
(cddr open-items)))))
open-items)
@@ -949,7 +954,7 @@ the body of `js--ensure-cache'."
;; Make sure parse-partial-sexp doesn't stop because we *entered*
;; the given depth -- i.e., make sure we're deeper than the target
;; depth.
- (assert (> (nth 0 parse)
+ (cl-assert (> (nth 0 parse)
(js--pitem-paren-depth (car open-items))))
(setq parse (parse-partial-sexp
prev-parse-point goal-point
@@ -1035,24 +1040,19 @@ LIMIT defaults to point."
(c-save-buffer-state
(open-items
- orig-match-start
- orig-match-end
- orig-depth
parse
prev-parse-point
name
case-fold-search
filtered-class-styles
- new-item
- goal-point
- end-prop)
+ goal-point)
;; Figure out which class styles we need to look for
(setq filtered-class-styles
- (loop for style in js--class-styles
- if (memq (plist-get style :framework)
- js-enabled-frameworks)
- collect style))
+ (cl-loop for style in js--class-styles
+ if (memq (plist-get style :framework)
+ js-enabled-frameworks)
+ collect style))
(save-excursion
(save-restriction
@@ -1071,7 +1071,7 @@ LIMIT defaults to point."
(unless (bobp)
(setq open-items (get-text-property (1- (point))
'js--pstate))
- (assert open-items))))
+ (cl-assert open-items))))
(unless open-items
;; Make a placeholder for the top-level definition
@@ -1084,97 +1084,98 @@ LIMIT defaults to point."
(narrow-to-region (point-min) limit)
- (loop while (re-search-forward js--quick-match-re-func nil t)
- for orig-match-start = (goto-char (match-beginning 0))
- for orig-match-end = (match-end 0)
- do (js--ensure-cache--update-parse)
- for orig-depth = (nth 0 parse)
-
- ;; Each of these conditions should return non-nil if
- ;; we should add a new item and leave point at the end
- ;; of the new item's header (h-end in the
- ;; js--pitem diagram). This point is the one
- ;; after the last character we need to unambiguously
- ;; detect this construct. If one of these evaluates to
- ;; nil, the location of the point is ignored.
- if (cond
- ;; In comment or string
- ((nth 8 parse) nil)
-
- ;; Regular function declaration
- ((and (looking-at "\\_<function\\_>")
- (setq name (js--forward-function-decl)))
-
- (when (eq name t)
- (setq name (js--guess-function-name orig-match-end))
- (if name
- (when js--guess-function-name-start
- (setq orig-match-start
- js--guess-function-name-start))
-
- (setq name t)))
-
- (assert (eq (char-after) ?{))
- (forward-char)
- (make-js--pitem
- :paren-depth orig-depth
- :h-begin orig-match-start
- :type 'function
- :name (if (eq name t)
- name
- (js--split-name name))))
-
- ;; Macro
- ((looking-at js--macro-decl-re)
-
- ;; Macros often contain unbalanced parentheses.
- ;; Make sure that h-end is at the textual end of
- ;; the macro no matter what the parenthesis say.
- (c-end-of-macro)
- (js--ensure-cache--update-parse)
-
- (make-js--pitem
- :paren-depth (nth 0 parse)
- :h-begin orig-match-start
- :type 'macro
- :name (list (match-string-no-properties 1))))
-
- ;; "Prototype function" declaration
- ((looking-at js--plain-method-re)
- (goto-char (match-beginning 3))
- (when (save-match-data
- (js--forward-function-decl))
- (forward-char)
- (make-js--pitem
- :paren-depth orig-depth
- :h-begin orig-match-start
- :type 'function
- :name (nconc (js--split-name
- (match-string-no-properties 1))
- (list (match-string-no-properties 2))))))
-
- ;; Class definition
- ((loop with syntactic-context =
- (js--syntactic-context-from-pstate open-items)
- for class-style in filtered-class-styles
- if (and (memq syntactic-context
- (plist-get class-style :contexts))
- (looking-at (plist-get class-style
- :class-decl)))
- do (goto-char (match-end 0))
- and return
- (make-js--pitem
- :paren-depth orig-depth
- :h-begin orig-match-start
- :type class-style
- :name (js--split-name
- (match-string-no-properties 1))))))
-
- do (js--ensure-cache--update-parse)
- and do (push it open-items)
- and do (put-text-property
- (1- (point)) (point) 'js--pstate open-items)
- else do (goto-char orig-match-end))
+ (cl-loop while (re-search-forward js--quick-match-re-func nil t)
+ for orig-match-start = (goto-char (match-beginning 0))
+ for orig-match-end = (match-end 0)
+ do (js--ensure-cache--update-parse)
+ for orig-depth = (nth 0 parse)
+
+ ;; Each of these conditions should return non-nil if
+ ;; we should add a new item and leave point at the end
+ ;; of the new item's header (h-end in the
+ ;; js--pitem diagram). This point is the one
+ ;; after the last character we need to unambiguously
+ ;; detect this construct. If one of these evaluates to
+ ;; nil, the location of the point is ignored.
+ if (cond
+ ;; In comment or string
+ ((nth 8 parse) nil)
+
+ ;; Regular function declaration
+ ((and (looking-at "\\_<function\\_>")
+ (setq name (js--forward-function-decl)))
+
+ (when (eq name t)
+ (setq name (js--guess-function-name orig-match-end))
+ (if name
+ (when js--guess-function-name-start
+ (setq orig-match-start
+ js--guess-function-name-start))
+
+ (setq name t)))
+
+ (cl-assert (eq (char-after) ?{))
+ (forward-char)
+ (make-js--pitem
+ :paren-depth orig-depth
+ :h-begin orig-match-start
+ :type 'function
+ :name (if (eq name t)
+ name
+ (js--split-name name))))
+
+ ;; Macro
+ ((looking-at js--macro-decl-re)
+
+ ;; Macros often contain unbalanced parentheses.
+ ;; Make sure that h-end is at the textual end of
+ ;; the macro no matter what the parenthesis say.
+ (c-end-of-macro)
+ (js--ensure-cache--update-parse)
+
+ (make-js--pitem
+ :paren-depth (nth 0 parse)
+ :h-begin orig-match-start
+ :type 'macro
+ :name (list (match-string-no-properties 1))))
+
+ ;; "Prototype function" declaration
+ ((looking-at js--plain-method-re)
+ (goto-char (match-beginning 3))
+ (when (save-match-data
+ (js--forward-function-decl))
+ (forward-char)
+ (make-js--pitem
+ :paren-depth orig-depth
+ :h-begin orig-match-start
+ :type 'function
+ :name (nconc (js--split-name
+ (match-string-no-properties 1))
+ (list (match-string-no-properties 2))))))
+
+ ;; Class definition
+ ((cl-loop
+ with syntactic-context =
+ (js--syntactic-context-from-pstate open-items)
+ for class-style in filtered-class-styles
+ if (and (memq syntactic-context
+ (plist-get class-style :contexts))
+ (looking-at (plist-get class-style
+ :class-decl)))
+ do (goto-char (match-end 0))
+ and return
+ (make-js--pitem
+ :paren-depth orig-depth
+ :h-begin orig-match-start
+ :type class-style
+ :name (js--split-name
+ (match-string-no-properties 1))))))
+
+ do (js--ensure-cache--update-parse)
+ and do (push it open-items)
+ and do (put-text-property
+ (1- (point)) (point) 'js--pstate open-items)
+ else do (goto-char orig-match-end))
(goto-char limit)
(js--ensure-cache--update-parse)
@@ -1185,12 +1186,12 @@ LIMIT defaults to point."
(defun js--end-of-defun-flat ()
"Helper function for `js-end-of-defun'."
- (loop while (js--re-search-forward "}" nil t)
- do (js--ensure-cache)
- if (get-text-property (1- (point)) 'js--pend)
- if (eq 'function (js--pitem-type it))
- return t
- finally do (goto-char (point-max))))
+ (cl-loop while (js--re-search-forward "}" nil t)
+ do (js--ensure-cache)
+ if (get-text-property (1- (point)) 'js--pend)
+ if (eq 'function (js--pitem-type it))
+ return t
+ finally do (goto-char (point-max))))
(defun js--end-of-defun-nested ()
"Helper function for `js-end-of-defun'."
@@ -1222,14 +1223,14 @@ LIMIT defaults to point."
"Value of `end-of-defun-function' for `js-mode'."
(setq arg (or arg 1))
(while (and (not (bobp)) (< arg 0))
- (incf arg)
+ (cl-incf arg)
(js-beginning-of-defun)
(js-beginning-of-defun)
(unless (bobp)
(js-end-of-defun)))
(while (> arg 0)
- (decf arg)
+ (cl-decf arg)
;; look for function backward. if we're inside it, go to that
;; function's end. otherwise, search for the next function's end and
;; go there
@@ -1353,7 +1354,7 @@ REGEXPS, but only if FRAMEWORK is in `js-enabled-frameworks'."
If FUNC is supplied, call it with no arguments before every
variable name in the spec. Return true iff this was actually a
spec. FUNC must preserve the match data."
- (case (char-after)
+ (pcase (char-after)
(?\[
(forward-char)
(while
@@ -1558,8 +1559,8 @@ point of view of font-lock. It applies highlighting directly with
(defun js--inside-pitem-p (pitem)
"Return whether point is inside the given pitem's header or body."
(js--ensure-cache)
- (assert (js--pitem-h-begin pitem))
- (assert (js--pitem-paren-depth pitem))
+ (cl-assert (js--pitem-h-begin pitem))
+ (cl-assert (js--pitem-paren-depth pitem))
(and (> (point) (js--pitem-h-begin pitem))
(or (null (js--pitem-b-end pitem))
@@ -1580,11 +1581,11 @@ will be returned."
;; Loop until we either hit a pitem at BOB or pitem ends after
;; point (or at point if we're at eob)
- (loop for pitem = (car pstate)
- until (or (eq (js--pitem-type pitem)
- 'toplevel)
- (js--inside-pitem-p pitem))
- do (pop pstate))
+ (cl-loop for pitem = (car pstate)
+ until (or (eq (js--pitem-type pitem)
+ 'toplevel)
+ (js--inside-pitem-p pitem))
+ do (pop pstate))
pstate))))
@@ -1613,22 +1614,22 @@ context."
(defun js--class-decl-matcher (limit)
"Font lock function used by `js-mode'.
This performs fontification according to `js--class-styles'."
- (loop initially (js--ensure-cache limit)
- while (re-search-forward js--quick-match-re limit t)
- for orig-end = (match-end 0)
- do (goto-char (match-beginning 0))
- if (loop for style in js--class-styles
- for decl-re = (plist-get style :class-decl)
- if (and (memq (plist-get style :framework)
- js-enabled-frameworks)
- (memq (js-syntactic-context)
- (plist-get style :contexts))
- decl-re
- (looking-at decl-re))
- do (goto-char (match-end 0))
- and return t)
- return t
- else do (goto-char orig-end)))
+ (cl-loop initially (js--ensure-cache limit)
+ while (re-search-forward js--quick-match-re limit t)
+ for orig-end = (match-end 0)
+ do (goto-char (match-beginning 0))
+ if (cl-loop for style in js--class-styles
+ for decl-re = (plist-get style :class-decl)
+ if (and (memq (plist-get style :framework)
+ js-enabled-frameworks)
+ (memq (js-syntactic-context)
+ (plist-get style :contexts))
+ decl-re
+ (looking-at decl-re))
+ do (goto-char (match-end 0))
+ and return t)
+ return t
+ else do (goto-char orig-end)))
(defconst js--font-lock-keywords
'(js--font-lock-keywords-3 js--font-lock-keywords-1
@@ -1650,6 +1651,11 @@ This performs fontification according to `js--class-styles'."
(funcall
(syntax-propertize-rules
;; Distinguish /-division from /-regexp chars (and from /-comment-starter).
+ ;; FIXME: Allow regexps after infix ops like + ...
+ ;; https://developer.mozilla.org/en/JavaScript/Reference/Operators
+ ;; We can probably just add +, -, !, <, >, %, ^, ~, |, &, ?, : at which
+ ;; point I think only * and / would be missing which could also be added,
+ ;; but need care to avoid affecting the // and */ comment markers.
("\\(?:^\\|[=([{,:;]\\)\\(?:[ \t]\\)*\\(/\\)[^/*]"
(1 (ignore
(forward-char -1)
@@ -1788,7 +1794,7 @@ nil."
js-expr-indent-offset))
(t
(+ (current-column) js-indent-level
- (case (char-after (nth 1 parse-status))
+ (pcase (char-after (nth 1 parse-status))
(?\( js-paren-indent-offset)
(?\[ js-square-indent-offset)
(?\{ js-curly-indent-offset))))))
@@ -1817,20 +1823,31 @@ nil."
;;; Filling
+(defvar js--filling-paragraph nil)
+
+;; FIXME: Such redefinitions are bad style. We should try and use some other
+;; way to get the same result.
+(defadvice c-forward-sws (around js-fill-paragraph activate)
+ (if js--filling-paragraph
+ (setq ad-return-value (js--forward-syntactic-ws (ad-get-arg 0)))
+ ad-do-it))
+
+(defadvice c-backward-sws (around js-fill-paragraph activate)
+ (if js--filling-paragraph
+ (setq ad-return-value (js--backward-syntactic-ws (ad-get-arg 0)))
+ ad-do-it))
+
+(defadvice c-beginning-of-macro (around js-fill-paragraph activate)
+ (if js--filling-paragraph
+ (setq ad-return-value (js--beginning-of-macro (ad-get-arg 0)))
+ ad-do-it))
+
(defun js-c-fill-paragraph (&optional justify)
"Fill the paragraph with `c-fill-paragraph'."
(interactive "*P")
- (flet ((c-forward-sws
- (&optional limit)
- (js--forward-syntactic-ws limit))
- (c-backward-sws
- (&optional limit)
- (js--backward-syntactic-ws limit))
- (c-beginning-of-macro
- (&optional limit)
- (js--beginning-of-macro limit)))
- (let ((fill-paragraph-function 'c-fill-paragraph))
- (c-fill-paragraph justify))))
+ (let ((js--filling-paragraph t)
+ (fill-paragraph-function 'c-fill-paragraph))
+ (c-fill-paragraph justify)))
;;; Type database and Imenu
@@ -1923,8 +1940,8 @@ the broken-down class name of the item to insert."
name-parts
(mapcar #'js--pitem-name items))
- (assert (stringp top-name))
- (assert (> (length top-name) 0))
+ (cl-assert (stringp top-name))
+ (cl-assert (> (length top-name) 0))
;; If top-name isn't found in items, then we build a copy of items
;; and throw it away. But that's okay, since most of the time, we
@@ -1989,10 +2006,10 @@ the broken-down class name of the item to insert."
(defun js--pitem-add-child (pitem child)
"Copy `js--pitem' PITEM, and push CHILD onto its list of children."
- (assert (integerp (js--pitem-h-begin child)))
- (assert (if (consp (js--pitem-name child))
- (loop for part in (js--pitem-name child)
- always (stringp part))
+ (cl-assert (integerp (js--pitem-h-begin child)))
+ (cl-assert (if (consp (js--pitem-name child))
+ (cl-loop for part in (js--pitem-name child)
+ always (stringp part))
t))
;; This trick works because we know (based on our defstructs) that
@@ -2014,7 +2031,7 @@ the broken-down class name of the item to insert."
;; name is a list here because down in
;; `js--ensure-cache', we made sure to only add
;; class entries with lists for :name
- (assert (consp name))
+ (cl-assert (consp name))
(js--splice-into-items (car pitem) child name))
(t
@@ -2039,11 +2056,11 @@ the broken-down class name of the item to insert."
(setq pitem-name (js--pitem-strname pitem))
(when (eq pitem-name t)
(setq pitem-name (format "[unknown %s]"
- (incf (car unknown-ctr)))))
+ (cl-incf (car unknown-ctr)))))
(cond
((memq pitem-type '(function macro))
- (assert (integerp (js--pitem-h-begin pitem)))
+ (cl-assert (integerp (js--pitem-h-begin pitem)))
(push (cons pitem-name
(js--maybe-make-marker
(js--pitem-h-begin pitem)))
@@ -2058,7 +2075,7 @@ the broken-down class name of the item to insert."
imenu-items))
((js--pitem-h-begin pitem)
- (assert (integerp (js--pitem-h-begin pitem)))
+ (cl-assert (integerp (js--pitem-h-begin pitem)))
(setq subitems (list
(cons "[empty]"
(js--maybe-make-marker
@@ -2077,7 +2094,7 @@ the broken-down class name of the item to insert."
(widen)
(goto-char (point-max))
(js--ensure-cache)
- (assert (or (= (point-min) (point-max))
+ (cl-assert (or (= (point-min) (point-max))
(eq js--last-parse-pos (point))))
(when js--last-parse-pos
(let ((state js--state-at-last-parse-pos)
@@ -2086,10 +2103,10 @@ the broken-down class name of the item to insert."
;; Make sure everything is closed
(while (cdr state)
(setq state
- (cons (js--pitem-add-child (second state) (car state))
+ (cons (js--pitem-add-child (cl-second state) (car state))
(cddr state))))
- (assert (= (length state) 1))
+ (cl-assert (= (length state) 1))
;; Convert the new-finalized state into what imenu expects
(js--pitems-to-imenu
@@ -2103,34 +2120,34 @@ the broken-down class name of the item to insert."
(mapconcat #'identity parts "."))
(defun js--imenu-to-flat (items prefix symbols)
- (loop for item in items
- if (imenu--subalist-p item)
- do (js--imenu-to-flat
- (cdr item) (concat prefix (car item) ".")
- symbols)
- else
- do (let* ((name (concat prefix (car item)))
- (name2 name)
- (ctr 0))
+ (cl-loop for item in items
+ if (imenu--subalist-p item)
+ do (js--imenu-to-flat
+ (cdr item) (concat prefix (car item) ".")
+ symbols)
+ else
+ do (let* ((name (concat prefix (car item)))
+ (name2 name)
+ (ctr 0))
- (while (gethash name2 symbols)
- (setq name2 (format "%s<%d>" name (incf ctr))))
+ (while (gethash name2 symbols)
+ (setq name2 (format "%s<%d>" name (cl-incf ctr))))
- (puthash name2 (cdr item) symbols))))
+ (puthash name2 (cdr item) symbols))))
(defun js--get-all-known-symbols ()
"Return a hash table of all JavaScript symbols.
This searches all existing `js-mode' buffers. Each key is the
name of a symbol (possibly disambiguated with <N>, where N > 1),
and each value is a marker giving the location of that symbol."
- (loop with symbols = (make-hash-table :test 'equal)
- with imenu-use-markers = t
- for buffer being the buffers
- for imenu-index = (with-current-buffer buffer
- (when (derived-mode-p 'js-mode)
- (js--imenu-create-index)))
- do (js--imenu-to-flat imenu-index "" symbols)
- finally return symbols))
+ (cl-loop with symbols = (make-hash-table :test 'equal)
+ with imenu-use-markers = t
+ for buffer being the buffers
+ for imenu-index = (with-current-buffer buffer
+ (when (derived-mode-p 'js-mode)
+ (js--imenu-create-index)))
+ do (js--imenu-to-flat imenu-index "" symbols)
+ finally return symbols))
(defvar js--symbol-history nil
"History of entered JavaScript symbols.")
@@ -2148,8 +2165,8 @@ marker."
(let ((choice (ido-completing-read
prompt
- (loop for key being the hash-keys of symbols-table
- collect key)
+ (cl-loop for key being the hash-keys of symbols-table
+ collect key)
nil t initial-input 'js--symbol-history)))
(cons choice (gethash choice symbols-table))))
@@ -2203,20 +2220,20 @@ On timeout, return nil. On success, return t with match data
set. If START is non-nil, look for output starting from START.
Otherwise, use the current value of `process-mark'."
(with-current-buffer (process-buffer process)
- (loop with start-pos = (or start
- (marker-position (process-mark process)))
- with end-time = (+ (float-time) timeout)
- for time-left = (- end-time (float-time))
- do (goto-char (point-max))
- if (looking-back regexp start-pos) return t
- while (> time-left 0)
- do (accept-process-output process time-left nil t)
- do (goto-char (process-mark process))
- finally do (signal
- 'js-moz-bad-rpc
- (list (format "Timed out waiting for output matching %S" regexp))))))
-
-(defstruct js--js-handle
+ (cl-loop with start-pos = (or start
+ (marker-position (process-mark process)))
+ with end-time = (+ (float-time) timeout)
+ for time-left = (- end-time (float-time))
+ do (goto-char (point-max))
+ if (looking-back regexp start-pos) return t
+ while (> time-left 0)
+ do (accept-process-output process time-left nil t)
+ do (goto-char (process-mark process))
+ finally do (signal
+ 'js-moz-bad-rpc
+ (list (format "Timed out waiting for output matching %S" regexp))))))
+
+(cl-defstruct js--js-handle
;; Integer, mirrors the value we see in JS
(id nil :read-only t)
@@ -2625,11 +2642,11 @@ with `js--js-encode-value'."
(inferior-moz-process) js--js-repl-prompt-regexp
js-js-timeout))
- (incf js--js-repl-depth)))
+ (cl-incf js--js-repl-depth)))
(defun js--js-leave-repl ()
- (assert (> js--js-repl-depth 0))
- (when (= 0 (decf js--js-repl-depth))
+ (cl-assert (> js--js-repl-depth 0))
+ (when (= 0 (cl-decf js--js-repl-depth))
(with-current-buffer inferior-moz-buffer
(goto-char (point-max))
(js--js-wait-for-eval-prompt)
@@ -2648,33 +2665,33 @@ with `js--js-encode-value'."
(eval-and-compile
(defun js--optimize-arglist (arglist)
"Convert immediate js< and js! references to deferred ones."
- (loop for item in arglist
- if (eq (car-safe item) 'js<)
- collect (append (list 'list ''js--funcall
- '(list 'interactor "_getProp"))
- (js--optimize-arglist (cdr item)))
- else if (eq (car-safe item) 'js>)
- collect (append (list 'list ''js--funcall
- '(list 'interactor "_putProp"))
-
- (if (atom (cadr item))
- (list (cadr item))
- (list
- (append
- (list 'list ''js--funcall
- '(list 'interactor "_mkArray"))
- (js--optimize-arglist (cadr item)))))
- (js--optimize-arglist (cddr item)))
- else if (eq (car-safe item) 'js!)
- collect (destructuring-bind (ignored function &rest body) item
- (append (list 'list ''js--funcall
- (if (consp function)
- (cons 'list
- (js--optimize-arglist function))
- function))
- (js--optimize-arglist body)))
- else
- collect item)))
+ (cl-loop for item in arglist
+ if (eq (car-safe item) 'js<)
+ collect (append (list 'list ''js--funcall
+ '(list 'interactor "_getProp"))
+ (js--optimize-arglist (cdr item)))
+ else if (eq (car-safe item) 'js>)
+ collect (append (list 'list ''js--funcall
+ '(list 'interactor "_putProp"))
+
+ (if (atom (cadr item))
+ (list (cadr item))
+ (list
+ (append
+ (list 'list ''js--funcall
+ '(list 'interactor "_mkArray"))
+ (js--optimize-arglist (cadr item)))))
+ (js--optimize-arglist (cddr item)))
+ else if (eq (car-safe item) 'js!)
+ collect (pcase-let ((`(,_ ,function . ,body) item))
+ (append (list 'list ''js--funcall
+ (if (consp function)
+ (cons 'list
+ (js--optimize-arglist function))
+ function))
+ (js--optimize-arglist body)))
+ else
+ collect item)))
(defmacro js--js-get-service (class-name interface-name)
`(js! ("Components" "classes" ,class-name "getService")
@@ -2697,56 +2714,56 @@ Inside the lexical scope of `with-js', `js?', `js!',
`(progn
(js--js-enter-repl)
(unwind-protect
- (macrolet ((js? (&rest body) `(js--js-true ,@body))
- (js! (function &rest body)
- `(js--js-funcall
- ,(if (consp function)
- (cons 'list
- (js--optimize-arglist function))
- function)
- ,@(js--optimize-arglist body)))
-
- (js-new (function &rest body)
- `(js--js-new
+ (cl-macrolet ((js? (&rest body) `(js--js-true ,@body))
+ (js! (function &rest body)
+ `(js--js-funcall
,(if (consp function)
(cons 'list
(js--optimize-arglist function))
function)
- ,@body))
-
- (js-eval (thisobj js)
- `(js--js-eval
- ,@(js--optimize-arglist
- (list thisobj js))))
-
- (js-list (&rest args)
- `(js--js-list
- ,@(js--optimize-arglist args)))
-
- (js-get-service (&rest args)
- `(js--js-get-service
- ,@(js--optimize-arglist args)))
-
- (js-create-instance (&rest args)
- `(js--js-create-instance
- ,@(js--optimize-arglist args)))
-
- (js-qi (&rest args)
- `(js--js-qi
- ,@(js--optimize-arglist args)))
-
- (js< (&rest body) `(js--js-get
- ,@(js--optimize-arglist body)))
- (js> (props value)
- `(js--js-funcall
- '(interactor "_putProp")
- ,(if (consp props)
- (cons 'list
- (js--optimize-arglist props))
- props)
- ,@(js--optimize-arglist (list value))
- ))
- (js-handle? (arg) `(js--js-handle-p ,arg)))
+ ,@(js--optimize-arglist body)))
+
+ (js-new (function &rest body)
+ `(js--js-new
+ ,(if (consp function)
+ (cons 'list
+ (js--optimize-arglist function))
+ function)
+ ,@body))
+
+ (js-eval (thisobj js)
+ `(js--js-eval
+ ,@(js--optimize-arglist
+ (list thisobj js))))
+
+ (js-list (&rest args)
+ `(js--js-list
+ ,@(js--optimize-arglist args)))
+
+ (js-get-service (&rest args)
+ `(js--js-get-service
+ ,@(js--optimize-arglist args)))
+
+ (js-create-instance (&rest args)
+ `(js--js-create-instance
+ ,@(js--optimize-arglist args)))
+
+ (js-qi (&rest args)
+ `(js--js-qi
+ ,@(js--optimize-arglist args)))
+
+ (js< (&rest body) `(js--js-get
+ ,@(js--optimize-arglist body)))
+ (js> (props value)
+ `(js--js-funcall
+ '(interactor "_putProp")
+ ,(if (consp props)
+ (cons 'list
+ (js--optimize-arglist props))
+ props)
+ ,@(js--optimize-arglist (list value))
+ ))
+ (js-handle? (arg) `(js--js-handle-p ,arg)))
,@forms)
(js--js-leave-repl))))
@@ -2755,21 +2772,22 @@ Inside the lexical scope of `with-js', `js?', `js!',
If nil, the whole Array is treated as a JS symbol.")
(defun js--js-decode-retval (result)
- (ecase (intern (first result))
- (atom (second result))
- (special (intern (second result)))
- (array
- (mapcar #'js--js-decode-retval (second result)))
- (objid
- (or (gethash (second result)
- js--js-references)
- (puthash (second result)
- (make-js--js-handle
- :id (second result)
- :process (inferior-moz-process))
- js--js-references)))
-
- (error (signal 'js-js-error (list (second result))))))
+ (pcase (intern (cl-first result))
+ (`atom (cl-second result))
+ (`special (intern (cl-second result)))
+ (`array
+ (mapcar #'js--js-decode-retval (cl-second result)))
+ (`objid
+ (or (gethash (cl-second result)
+ js--js-references)
+ (puthash (cl-second result)
+ (make-js--js-handle
+ :id (cl-second result)
+ :process (inferior-moz-process))
+ js--js-references)))
+
+ (`error (signal 'js-js-error (list (cl-second result))))
+ (x (error "Unmatched case in js--js-decode-retval: %S" x))))
(defun js--js-funcall (function &rest arguments)
"Call the Mozilla function FUNCTION with arguments ARGUMENTS.
@@ -2852,9 +2870,9 @@ With argument, run even if no intervening GC has happened."
(looking-back js--js-prompt-regexp
(save-excursion (forward-line 0) (point))))))
- (setq keys (loop for x being the hash-keys
- of js--js-references
- collect x))
+ (setq keys (cl-loop for x being the hash-keys
+ of js--js-references
+ collect x))
(setq num (js--js-funcall '(repl "_jsGC") (or keys [])))
(setq js--js-last-gcs-done this-gcs-done)
@@ -2888,58 +2906,58 @@ left-to-right."
(with-js
(let (windows)
- (loop with window-mediator = (js! ("Components" "classes"
- "@mozilla.org/appshell/window-mediator;1"
- "getService")
- (js< "Components" "interfaces"
- "nsIWindowMediator"))
- with enumerator = (js! (window-mediator "getEnumerator") nil)
-
- while (js? (js! (enumerator "hasMoreElements")))
- for window = (js! (enumerator "getNext"))
- for window-info = (js-list window
- (js< window "document" "title")
- (js! (window "location" "toString"))
- (js< window "closed")
- (js< window "windowState"))
-
- unless (or (js? (fourth window-info))
- (eq (fifth window-info) 2))
- do (push window-info windows))
-
- (loop for window-info in windows
- for window = (first window-info)
- collect (list (second window-info)
- (third window-info)
- window)
-
- for gbrowser = (js< window "gBrowser")
- if (js-handle? gbrowser)
- nconc (loop
- for x below (js< gbrowser "browsers" "length")
- collect (js-list (js< gbrowser
- "browsers"
- x
- "contentDocument"
- "title")
-
- (js! (gbrowser
- "browsers"
- x
- "contentWindow"
- "location"
- "toString"))
- (js< gbrowser
- "browsers"
- x)
-
- (js! (gbrowser
- "tabContainer"
- "childNodes"
- "item")
- x)
-
- gbrowser))))))
+ (cl-loop with window-mediator = (js! ("Components" "classes"
+ "@mozilla.org/appshell/window-mediator;1"
+ "getService")
+ (js< "Components" "interfaces"
+ "nsIWindowMediator"))
+ with enumerator = (js! (window-mediator "getEnumerator") nil)
+
+ while (js? (js! (enumerator "hasMoreElements")))
+ for window = (js! (enumerator "getNext"))
+ for window-info = (js-list window
+ (js< window "document" "title")
+ (js! (window "location" "toString"))
+ (js< window "closed")
+ (js< window "windowState"))
+
+ unless (or (js? (cl-fourth window-info))
+ (eq (cl-fifth window-info) 2))
+ do (push window-info windows))
+
+ (cl-loop for window-info in windows
+ for window = (cl-first window-info)
+ collect (list (cl-second window-info)
+ (cl-third window-info)
+ window)
+
+ for gbrowser = (js< window "gBrowser")
+ if (js-handle? gbrowser)
+ nconc (cl-loop
+ for x below (js< gbrowser "browsers" "length")
+ collect (js-list (js< gbrowser
+ "browsers"
+ x
+ "contentDocument"
+ "title")
+
+ (js! (gbrowser
+ "browsers"
+ x
+ "contentWindow"
+ "location"
+ "toString"))
+ (js< gbrowser
+ "browsers"
+ x)
+
+ (js! (gbrowser
+ "tabContainer"
+ "childNodes"
+ "item")
+ x)
+
+ gbrowser))))))
(defvar js-read-tab-history nil)
@@ -2955,111 +2973,114 @@ browser, respectively."
(ido-mode -1))
(with-js
- (lexical-let ((tabs (js--get-tabs)) selected-tab-cname
- selected-tab prev-hitab)
+ (let ((tabs (js--get-tabs)) selected-tab-cname
+ selected-tab prev-hitab)
;; Disambiguate names
- (setq tabs (loop with tab-names = (make-hash-table :test 'equal)
- for tab in tabs
- for cname = (format "%s (%s)" (second tab) (first tab))
- for num = (incf (gethash cname tab-names -1))
- if (> num 0)
- do (setq cname (format "%s <%d>" cname num))
- collect (cons cname tab)))
-
- (labels ((find-tab-by-cname
- (cname)
- (loop for tab in tabs
- if (equal (car tab) cname)
- return (cdr tab)))
-
- (mogrify-highlighting
- (hitab unhitab)
-
- ;; Hack to reduce the number of
- ;; round-trips to mozilla
- (let (cmds)
- (cond
- ;; Highlighting tab
- ((fourth hitab)
- (push '(js! ((fourth hitab) "setAttribute")
- "style"
- "color: red; font-weight: bold")
- cmds)
-
- ;; Highlight window proper
- (push '(js! ((third hitab)
- "setAttribute")
- "style"
- "border: 8px solid red")
- cmds)
-
- ;; Select tab, when appropriate
- (when js-js-switch-tabs
- (push
- '(js> ((fifth hitab) "selectedTab") (fourth hitab))
- cmds)))
-
- ;; Highlighting whole window
- ((third hitab)
- (push '(js! ((third hitab) "document"
- "documentElement" "setAttribute")
- "style"
- (concat "-moz-appearance: none;"
- "border: 8px solid red;"))
- cmds)))
-
- (cond
- ;; Unhighlighting tab
- ((fourth unhitab)
- (push '(js! ((fourth unhitab) "setAttribute") "style" "")
- cmds)
- (push '(js! ((third unhitab) "setAttribute") "style" "")
- cmds))
-
- ;; Unhighlighting window
- ((third unhitab)
- (push '(js! ((third unhitab) "document"
- "documentElement" "setAttribute")
- "style" "")
- cmds)))
-
- (eval (list 'with-js
- (cons 'js-list (nreverse cmds))))))
-
- (command-hook
- ()
- (let* ((tab (find-tab-by-cname (car ido-matches))))
- (mogrify-highlighting tab prev-hitab)
- (setq prev-hitab tab)))
-
- (setup-hook
- ()
- ;; Fiddle with the match list a bit: if our first match
- ;; is a tabbrowser window, rotate the match list until
- ;; the active tab comes up
- (let ((matched-tab (find-tab-by-cname (car ido-matches))))
- (when (and matched-tab
- (null (fourth matched-tab))
- (equal "navigator:browser"
- (js! ((third matched-tab)
- "document"
- "documentElement"
- "getAttribute")
- "windowtype")))
-
- (loop with tab-to-match = (js< (third matched-tab)
- "gBrowser"
- "selectedTab")
-
- with index = 0
- for match in ido-matches
- for candidate-tab = (find-tab-by-cname match)
- if (eq (fourth candidate-tab) tab-to-match)
- do (setq ido-cur-list (ido-chop ido-cur-list match))
- and return t)))
-
- (add-hook 'post-command-hook #'command-hook t t)))
+ (setq tabs
+ (cl-loop with tab-names = (make-hash-table :test 'equal)
+ for tab in tabs
+ for cname = (format "%s (%s)"
+ (cl-second tab) (cl-first tab))
+ for num = (cl-incf (gethash cname tab-names -1))
+ if (> num 0)
+ do (setq cname (format "%s <%d>" cname num))
+ collect (cons cname tab)))
+
+ (cl-labels
+ ((find-tab-by-cname
+ (cname)
+ (cl-loop for tab in tabs
+ if (equal (car tab) cname)
+ return (cdr tab)))
+
+ (mogrify-highlighting
+ (hitab unhitab)
+
+ ;; Hack to reduce the number of
+ ;; round-trips to mozilla
+ (let (cmds)
+ (cond
+ ;; Highlighting tab
+ ((cl-fourth hitab)
+ (push '(js! ((cl-fourth hitab) "setAttribute")
+ "style"
+ "color: red; font-weight: bold")
+ cmds)
+
+ ;; Highlight window proper
+ (push '(js! ((cl-third hitab)
+ "setAttribute")
+ "style"
+ "border: 8px solid red")
+ cmds)
+
+ ;; Select tab, when appropriate
+ (when js-js-switch-tabs
+ (push
+ '(js> ((cl-fifth hitab) "selectedTab") (cl-fourth hitab))
+ cmds)))
+
+ ;; Highlighting whole window
+ ((cl-third hitab)
+ (push '(js! ((cl-third hitab) "document"
+ "documentElement" "setAttribute")
+ "style"
+ (concat "-moz-appearance: none;"
+ "border: 8px solid red;"))
+ cmds)))
+
+ (cond
+ ;; Unhighlighting tab
+ ((cl-fourth unhitab)
+ (push '(js! ((cl-fourth unhitab) "setAttribute") "style" "")
+ cmds)
+ (push '(js! ((cl-third unhitab) "setAttribute") "style" "")
+ cmds))
+
+ ;; Unhighlighting window
+ ((cl-third unhitab)
+ (push '(js! ((cl-third unhitab) "document"
+ "documentElement" "setAttribute")
+ "style" "")
+ cmds)))
+
+ (eval (list 'with-js
+ (cons 'js-list (nreverse cmds))))))
+
+ (command-hook
+ ()
+ (let* ((tab (find-tab-by-cname (car ido-matches))))
+ (mogrify-highlighting tab prev-hitab)
+ (setq prev-hitab tab)))
+
+ (setup-hook
+ ()
+ ;; Fiddle with the match list a bit: if our first match
+ ;; is a tabbrowser window, rotate the match list until
+ ;; the active tab comes up
+ (let ((matched-tab (find-tab-by-cname (car ido-matches))))
+ (when (and matched-tab
+ (null (cl-fourth matched-tab))
+ (equal "navigator:browser"
+ (js! ((cl-third matched-tab)
+ "document"
+ "documentElement"
+ "getAttribute")
+ "windowtype")))
+
+ (cl-loop with tab-to-match = (js< (cl-third matched-tab)
+ "gBrowser"
+ "selectedTab")
+
+ for match in ido-matches
+ for candidate-tab = (find-tab-by-cname match)
+ if (eq (cl-fourth candidate-tab) tab-to-match)
+ do (setq ido-cur-list
+ (ido-chop ido-cur-list match))
+ and return t)))
+
+ (add-hook 'post-command-hook #'command-hook t t)))
(unwind-protect
@@ -3078,13 +3099,12 @@ browser, respectively."
(add-to-history 'js-read-tab-history selected-tab-cname)
- (setq selected-tab (loop for tab in tabs
- if (equal (car tab) selected-tab-cname)
- return (cdr tab)))
+ (setq selected-tab (cl-loop for tab in tabs
+ if (equal (car tab) selected-tab-cname)
+ return (cdr tab)))
- (if (fourth selected-tab)
- (cons 'browser (third selected-tab))
- (cons 'window (third selected-tab)))))))
+ (cons (if (cl-fourth selected-tab) 'browser 'window)
+ (cl-third selected-tab))))))
(defun js--guess-eval-defun-info (pstate)
"Helper function for `js-eval-defun'.
@@ -3092,19 +3112,19 @@ Return a list (NAME . CLASSPARTS), where CLASSPARTS is a list of
strings making up the class name and NAME is the name of the
function part."
(cond ((and (= (length pstate) 3)
- (eq (js--pitem-type (first pstate)) 'function)
- (= (length (js--pitem-name (first pstate))) 1)
- (consp (js--pitem-type (second pstate))))
+ (eq (js--pitem-type (cl-first pstate)) 'function)
+ (= (length (js--pitem-name (cl-first pstate))) 1)
+ (consp (js--pitem-type (cl-second pstate))))
- (append (js--pitem-name (second pstate))
- (list (first (js--pitem-name (first pstate))))))
+ (append (js--pitem-name (cl-second pstate))
+ (list (cl-first (js--pitem-name (cl-first pstate))))))
((and (= (length pstate) 2)
- (eq (js--pitem-type (first pstate)) 'function))
+ (eq (js--pitem-type (cl-first pstate)) 'function))
(append
- (butlast (js--pitem-name (first pstate)))
- (list (car (last (js--pitem-name (first pstate)))))))
+ (butlast (js--pitem-name (cl-first pstate)))
+ (list (car (last (js--pitem-name (cl-first pstate)))))))
(t (error "Function not a toplevel defun or class member"))))
@@ -3148,19 +3168,21 @@ If one hasn't been set, or if it's stale, prompt for a new one."
(with-js
(when (or (null js--js-context)
(js--js-handle-expired-p (cdr js--js-context))
- (ecase (car js--js-context)
- (window (js? (js< (cdr js--js-context) "closed")))
- (browser (not (js? (js< (cdr js--js-context)
- "contentDocument"))))))
+ (pcase (car js--js-context)
+ (`window (js? (js< (cdr js--js-context) "closed")))
+ (`browser (not (js? (js< (cdr js--js-context)
+ "contentDocument"))))
+ (x (error "Unmatched case in js--get-js-context: %S" x))))
(setq js--js-context (js--read-tab "Javascript Context: ")))
js--js-context))
(defun js--js-content-window (context)
(with-js
- (ecase (car context)
- (window (cdr context))
- (browser (js< (cdr context)
- "contentWindow" "wrappedJSObject")))))
+ (pcase (car context)
+ (`window (cdr context))
+ (`browser (js< (cdr context)
+ "contentWindow" "wrappedJSObject"))
+ (x (error "Unmatched case in js--js-content-window: %S" x)))))
(defun js--make-nsilocalfile (path)
(with-js
@@ -3179,7 +3201,7 @@ If one hasn't been set, or if it's stale, prompt for a new one."
(path-uri (js! (io-service "newFileURI") path-file)))
(js! (res-prot "setSubstitution") alias path-uri))))
-(defun* js-eval-defun ()
+(cl-defun js-eval-defun ()
"Update a Mozilla tab using the JavaScript defun at point."
(interactive)
@@ -3215,7 +3237,7 @@ If one hasn't been set, or if it's stale, prompt for a new one."
(unless (y-or-n-p (format "Send %s to Mozilla? "
(mapconcat #'identity defun-info ".")))
(message "") ; question message lingers until next command
- (return-from js-eval-defun))
+ (cl-return-from js-eval-defun))
(delete-overlay overlay)))
(setq defun-body (buffer-substring-no-properties begin end))
@@ -3329,7 +3351,7 @@ If one hasn't been set, or if it's stale, prompt for a new one."
comment-start-skip "\\(//+\\|/\\*+\\)\\s *")
(set (make-local-variable 'electric-indent-chars)
- (append "{}():;," electric-indent-chars))
+ (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*".
(set (make-local-variable 'electric-layout-rules)
'((?\; . after) (?\{ . after) (?\} . before)))
diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el
index c682bfa0280..9cbed855d5e 100644
--- a/lisp/progmodes/ld-script.el
+++ b/lisp/progmodes/ld-script.el
@@ -1,6 +1,6 @@
;;; ld-script.el --- GNU linker script editing mode for Emacs
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Masatake YAMATO<jet@gyve.org>
;; Keywords: languages, faces
diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el
index 98df1c69468..20f91ce2d9e 100644
--- a/lisp/progmodes/m4-mode.el
+++ b/lisp/progmodes/m4-mode.el
@@ -1,6 +1,6 @@
;;; m4-mode.el --- m4 code editing commands for Emacs
-;; Copyright (C) 1996-1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Andrew Csillag <drew_csillag@geocities.com>
;; Maintainer: Andrew Csillag <drew_csillag@geocities.com>
@@ -80,7 +80,7 @@
"Default font-lock-keywords for `m4 mode'.")
(defcustom m4-mode-hook nil
- "*Hook called by `m4-mode'."
+ "Hook called by `m4-mode'."
:type 'hook
:group 'm4)
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 024744957c6..2f4419ba2ea 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -1,6 +1,6 @@
;;; make-mode.el --- makefile editing commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1992, 1994, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 1999-2012 Free Software Foundation, Inc.
;; Author: Thomas Neumann <tom@smart.bo.open.de>
;; Eric S. Raymond <esr@snark.thyrsus.com>
@@ -129,18 +129,18 @@
:version "22.1")
(defcustom makefile-browser-buffer-name "*Macros and Targets*"
- "*Name of the macro- and target browser buffer."
+ "Name of the macro- and target browser buffer."
:type 'string
:group 'makefile)
(defcustom makefile-target-colon ":"
- "*String to append to all target names inserted by `makefile-insert-target'.
+ "String to append to all target names inserted by `makefile-insert-target'.
\":\" or \"::\" are common values."
:type 'string
:group 'makefile)
(defcustom makefile-macro-assign " = "
- "*String to append to all macro names inserted by `makefile-insert-macro'.
+ "String to append to all macro names inserted by `makefile-insert-macro'.
The normal value should be \" = \", since this is what
standard make expects. However, newer makes such as dmake
allow a larger variety of different macro assignments, so you
@@ -149,69 +149,69 @@ might prefer to use \" += \" or \" := \" ."
:group 'makefile)
(defcustom makefile-electric-keys nil
- "*If non-nil, Makefile mode should install electric keybindings.
+ "If non-nil, Makefile mode should install electric keybindings.
Default is nil."
:type 'boolean
:group 'makefile)
(defcustom makefile-use-curly-braces-for-macros-p nil
- "*Controls the style of generated macro references.
+ "Controls the style of generated macro references.
Non-nil means macro references should use curly braces, like `${this}'.
nil means use parentheses, like `$(this)'."
:type 'boolean
:group 'makefile)
(defcustom makefile-tab-after-target-colon t
- "*If non-nil, insert a TAB after a target colon.
+ "If non-nil, insert a TAB after a target colon.
Otherwise, a space is inserted.
The default is t."
:type 'boolean
:group 'makefile)
(defcustom makefile-browser-leftmost-column 10
- "*Number of blanks to the left of the browser selection mark."
+ "Number of blanks to the left of the browser selection mark."
:type 'integer
:group 'makefile)
(defcustom makefile-browser-cursor-column 10
- "*Column the cursor goes to when it moves up or down in the Makefile browser."
+ "Column the cursor goes to when it moves up or down in the Makefile browser."
:type 'integer
:group 'makefile)
(defcustom makefile-backslash-column 48
- "*Column in which `makefile-backslash-region' inserts backslashes."
+ "Column in which `makefile-backslash-region' inserts backslashes."
:type 'integer
:group 'makefile)
(defcustom makefile-backslash-align t
- "*If non-nil, `makefile-backslash-region' will align backslashes."
+ "If non-nil, `makefile-backslash-region' will align backslashes."
:type 'boolean
:group 'makefile)
(defcustom makefile-browser-selected-mark "+ "
- "*String used to mark selected entries in the Makefile browser."
+ "String used to mark selected entries in the Makefile browser."
:type 'string
:group 'makefile)
(defcustom makefile-browser-unselected-mark " "
- "*String used to mark unselected entries in the Makefile browser."
+ "String used to mark unselected entries in the Makefile browser."
:type 'string
:group 'makefile)
(defcustom makefile-browser-auto-advance-after-selection-p t
- "*If non-nil, cursor will move after item is selected in Makefile browser."
+ "If non-nil, cursor will move after item is selected in Makefile browser."
:type 'boolean
:group 'makefile)
(defcustom makefile-pickup-everything-picks-up-filenames-p nil
- "*If non-nil, `makefile-pickup-everything' picks up filenames as targets.
+ "If non-nil, `makefile-pickup-everything' picks up filenames as targets.
This means it calls `makefile-pickup-filenames-as-targets'.
Otherwise filenames are omitted."
:type 'boolean
:group 'makefile)
(defcustom makefile-cleanup-continuations nil
- "*If non-nil, automatically clean up continuation lines when saving.
+ "If non-nil, automatically clean up continuation lines when saving.
A line is cleaned up by removing all whitespace following a trailing
backslash. This is done silently.
IMPORTANT: Please note that enabling this option causes Makefile mode
@@ -220,7 +220,7 @@ to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\"."
:group 'makefile)
(defcustom makefile-mode-hook nil
- "*Normal hook run by `makefile-mode'."
+ "Normal hook run by `makefile-mode'."
:type 'hook
:group 'makefile)
@@ -247,7 +247,7 @@ you enter a \".\" at the beginning of a line in `makefile-mode'."
(defcustom makefile-runtime-macros-list
'(("@") ("&") (">") ("<") ("*") ("^") ("+") ("?") ("%") ("$"))
- "*List of macros that are resolved by make at runtime.
+ "List of macros that are resolved by make at runtime.
If you insert a macro reference using `makefile-insert-macro-ref', the name
of the macro is checked against this list. If it can be found its name will
not be enclosed in { } or ( )."
@@ -553,14 +553,14 @@ not be enclosed in { } or ( )."
;; ------------------------------------------------------------
(defcustom makefile-brave-make "make"
- "*How to invoke make, for `makefile-query-targets'.
+ "How to invoke make, for `makefile-query-targets'.
This should identify a `make' command that can handle the `-q' option."
:type 'string
:group 'makefile)
(defcustom makefile-query-one-target-method-function
'makefile-query-by-make-minus-q
- "*Function to call to determine whether a make target is up to date.
+ "Function to call to determine whether a make target is up to date.
The function must satisfy this calling convention:
* As its first argument, it must accept the name of the target to
@@ -579,7 +579,7 @@ The function must satisfy this calling convention:
'makefile-query-one-target-method-function)
(defcustom makefile-up-to-date-buffer-name "*Makefile Up-to-date overview*"
- "*Name of the Up-to-date overview buffer."
+ "Name of the Up-to-date overview buffer."
:type 'string
:group 'makefile)
@@ -1493,7 +1493,6 @@ Insertion takes place at point."
(setq buffer-read-only t))
(defun makefile-browse (targets macros)
- (interactive)
(if (zerop (+ (length targets) (length macros)))
(progn
(beep)
diff --git a/lisp/progmodes/mantemp.el b/lisp/progmodes/mantemp.el
index c8963d2a6dd..a2a976a6d37 100644
--- a/lisp/progmodes/mantemp.el
+++ b/lisp/progmodes/mantemp.el
@@ -1,6 +1,6 @@
;;; mantemp.el --- create manual template instantiations from g++ 2.7.2 output
-;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Tom Houlder <thoulder@icor.fr>
;; Created: 10 Dec 1996
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index d0a34179cc8..9978ee62687 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -1,6 +1,6 @@
;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
;; Version: 1.0
@@ -384,7 +384,7 @@ Each entry is a list with the following elements:
1. Regexp matching the preceding text.
2. A number indicating the subgroup in the regexp containing the text.
3. A function returning an alist of possible completions.
-4. Text to append after a succesful completion (if any).
+4. Text to append after a successful completion (if any).
Or alternatively:
1. Regexp matching the preceding text.
@@ -829,6 +829,7 @@ The environment marked is the one that contains point or follows point."
st)
"Syntax table used in Metafont or MetaPost mode.")
+(define-obsolete-variable-alias 'meta-mode-map 'meta-common-mode-map "24.1")
(defvar meta-common-mode-map
(let ((map (make-sparse-keymap)))
;; Comment Paragraphs:
@@ -858,7 +859,6 @@ The environment marked is the one that contains point or follows point."
;; (define-key map "\C-c\C-l" 'meta-recenter-output)
map)
"Keymap used in Metafont or MetaPost mode.")
-(define-obsolete-variable-alias 'meta-mode-map 'meta-common-mode-map "24.1")
(easy-menu-define
meta-mode-menu meta-common-mode-map
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index 7d1f12595ab..a59176a5aa6 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -1,6 +1,6 @@
;;; mixal-mode.el --- Major mode for the mix asm language.
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Pieter E.J. Pareit <pieter.pareit@gmail.com>
;; Maintainer: Pieter E.J. Pareit <pieter.pareit@gmail.com>
@@ -32,7 +32,7 @@
;; GNU MDK from `https://savannah.gnu.org/projects/mdk/' and
;; `ftp://ftp.gnu.org/pub/gnu/mdk'.
;;
-;; To use this mode, place the following in your .emacs file:
+;; To use this mode, place the following in your init file:
;; `(load-file "/PATH-TO-FILE/mixal-mode.el")'.
;; When you load a file with the extension .mixal the mode will be started
;; automatic. If you want to start the mode manual, use `M-x mixal-mode'.
@@ -145,43 +145,43 @@ zeros to make a word."
(LD1 loading "load I1" 9 field
"Put in rI1 the contents of cell no. M.
Uses a + when there is no sign in subfield. Subfield is left padded with
-zeros to make a word. Index registers only have 2 bytes and a sign, Trying
-to set anything more that that will result in undefined behavior."
+zeros to make a word. Index registers only have 2 bytes and a sign; trying
+to set anything more than that will result in undefined behavior."
2)
(LD2 loading "load I2" 10 field
"Put in rI2 the contents of cell no. M.
Uses a + when there is no sign in subfield. Subfield is left padded with
-zeros to make a word. Index registers only have 2 bytes and a sign, Trying
-to set anything more that that will result in undefined behavior."
+zeros to make a word. Index registers only have 2 bytes and a sign; trying
+to set anything more than that will result in undefined behavior."
2)
(LD3 loading "load I3" 11 field
"Put in rI3 the contents of cell no. M.
Uses a + when there is no sign in subfield. Subfield is left padded with
-zeros to make a word. Index registers only have 2 bytes and a sign, Trying
-to set anything more that that will result in undefined behavior."
+zeros to make a word. Index registers only have 2 bytes and a sign; trying
+to set anything more than that will result in undefined behavior."
2)
(LD4 loading "load I4" 12 field
"Put in rI4 the contents of cell no. M.
Uses a + when there is no sign in subfield. Subfield is left padded with
-zeros to make a word. Index registers only have 2 bytes and a sign, Trying
-to set anything more that that will result in undefined behavior."
+zeros to make a word. Index registers only have 2 bytes and a sign; trying
+to set anything more than that will result in undefined behavior."
2)
(LD5 loading "load I5" 13 field
"Put in rI5 the contents of cell no. M.
Uses a + when there is no sign in subfield. Subfield is left padded with
-zeros to make a word. Index registers only have 2 bytes and a sign, Trying
-to set anything more that that will result in undefined behavior."
+zeros to make a word. Index registers only have 2 bytes and a sign; trying
+to set anything more than that will result in undefined behavior."
2)
(LD6 loading "load I6" 14 field
"Put in rI6 the contents of cell no. M.
Uses a + when there is no sign in subfield. Subfield is left padded with
-zeros to make a word. Index registers only have 2 bytes and a sign, Trying
-to set anything more that that will result in undefined behavior."
+zeros to make a word. Index registers only have 2 bytes and a sign; trying
+to set anything more than that will result in undefined behavior."
2)
(LDAN loading "load A negative" 16 field
@@ -200,7 +200,7 @@ Subfield is left padded with zeros to make a word."
"Put in rI1 the contents of cell no. M, with opposite sign.
Uses a + when there is no sign in subfield, otherwise use the opposite sign.
Subfield is left padded with zeros to make a word. Index registers only
-have 2 bytes and a sign, Trying to set anything more that that will result
+have 2 bytes and a sign; trying to set anything more than that will result
in undefined behavior."
2)
@@ -208,7 +208,7 @@ in undefined behavior."
"Put in rI2 the contents of cell no. M, with opposite sign.
Uses a + when there is no sign in subfield, otherwise use the opposite sign.
Subfield is left padded with zeros to make a word. Index registers only
-have 2 bytes and a sign, Trying to set anything more that that will result
+have 2 bytes and a sign; trying to set anything more than that will result
in undefined behavior."
2)
@@ -216,7 +216,7 @@ in undefined behavior."
"Put in rI3 the contents of cell no. M, with opposite sign.
Uses a + when there is no sign in subfield, otherwise use the opposite sign.
Subfield is left padded with zeros to make a word. Index registers only
-have 2 bytes and a sign, Trying to set anything more that that will result
+have 2 bytes and a sign; trying to set anything more than that will result
in undefined behavior."
2)
@@ -224,7 +224,7 @@ in undefined behavior."
"Put in rI4 the contents of cell no. M, with opposite sign.
Uses a + when there is no sign in subfield, otherwise use the opposite sign.
Subfield is left padded with zeros to make a word. Index registers only
-have 2 bytes and a sign, Trying to set anything more that that will result
+have 2 bytes and a sign; trying to set anything more than that will result
in undefined behavior."
2)
@@ -232,7 +232,7 @@ in undefined behavior."
"Put in rI5 the contents of cell no. M, with opposite sign.
Uses a + when there is no sign in subfield, otherwise use the opposite sign.
Subfield is left padded with zeros to make a word. Index registers only
-have 2 bytes and a sign, Trying to set anything more that that will result
+have 2 bytes and a sign; trying to set anything more than that will result
in undefined behavior."
2)
@@ -240,7 +240,7 @@ in undefined behavior."
"Put in rI6 the contents of cell no. M, with opposite sign.
Uses a + when there is no sign in subfield, otherwise use the opposite sign.
Subfield is left padded with zeros to make a word. Index registers only
-have 2 bytes and a sign, Trying to set anything more that that will result
+have 2 bytes and a sign; trying to set anything more than that will result
in undefined behavior."
2)
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index 0c43a3ed354..d634efebe5b 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -65,7 +65,7 @@
:group 'modula2)
(defcustom m2-end-comment-column 75
- "*Column for aligning the end of a comment, in Modula-2."
+ "Column for aligning the end of a comment, in Modula-2."
:type 'integer
:group 'modula2)
@@ -104,7 +104,7 @@
"Keymap used in Modula-2 mode.")
(defcustom m2-indent 5
- "*This variable gives the indentation in Modula-2-Mode."
+ "This variable gives the indentation in Modula-2-Mode."
:type 'integer
:group 'modula2)
(put 'm2-indent 'safe-local-variable
diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el
index 421f476016e..f77e24e665a 100644
--- a/lisp/progmodes/octave-inf.el
+++ b/lisp/progmodes/octave-inf.el
@@ -1,9 +1,9 @@
;;; octave-inf.el --- running Octave as an inferior Emacs process
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>
-;; Author: John Eaton <jwe@bevo.che.wisc.edu>
+;; John Eaton <jwe@bevo.che.wisc.edu>
;; Maintainer: FSF
;; Keywords: languages
;; Package: octave-mod
@@ -79,7 +79,7 @@ mode, set this to (\"-q\" \"--traditional\")."
"Syntax table in use in inferior-octave-mode buffers.")
(defcustom inferior-octave-mode-hook nil
- "*Hook to be run when Inferior Octave mode is started."
+ "Hook to be run when Inferior Octave mode is started."
:type 'hook
:group 'octave-inferior)
diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el
index 28e25a35c70..ab5a19f8a2f 100644
--- a/lisp/progmodes/octave-mod.el
+++ b/lisp/progmodes/octave-mod.el
@@ -1,9 +1,9 @@
;;; octave-mod.el --- editing Octave source files under Emacs
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>
-;; Author: John Eaton <jwe@octave.org>
+;; John Eaton <jwe@octave.org>
;; Maintainer: FSF
;; Keywords: languages
@@ -585,12 +585,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 ()
@@ -989,18 +989,13 @@ If Abbrev mode is turned on, typing ` (grave accent) followed by ? or
executed normally.
Note that all Octave mode abbrevs start with a grave accent."
(interactive)
- (if (not abbrev-mode)
- (self-insert-command 1)
- (let (c)
- (insert last-command-event)
- (if (if (featurep 'xemacs)
- (or (eq (event-to-character (setq c (next-event))) ??)
- (eq (event-to-character c) help-char))
- (or (eq (setq c (read-event)) ??)
- (eq c help-char)))
- (let ((abbrev-table-name-list '(octave-abbrev-table)))
- (list-abbrevs))
- (setq unread-command-events (list c))))))
+ (self-insert-command 1)
+ (when abbrev-mode
+ (set-temporary-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [??] 'list-abbrevs)
+ (define-key map (vector help-char) 'list-abbrevs)
+ map))))
(define-skeleton octave-insert-defun
"Insert an Octave function skeleton.
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index 2db4309d9e0..b313fd4aee6 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -1,6 +1,6 @@
;;; pascal.el --- major mode for editing pascal source in Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1993-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-2012 Free Software Foundation, Inc.
;; Author: Espen Skoglund <esk@gnu.org>
;; Keywords: languages
@@ -57,7 +57,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(defgroup pascal nil
"Major mode for editing Pascal source in Emacs."
@@ -183,42 +182,42 @@
(put 'pascal-mode 'font-lock-defaults '(pascal-font-lock-keywords nil t))
(defcustom pascal-indent-level 3
- "*Indentation of Pascal statements with respect to containing block."
+ "Indentation of Pascal statements with respect to containing block."
:type 'integer
:group 'pascal)
(defcustom pascal-case-indent 2
- "*Indentation for case statements."
+ "Indentation for case statements."
:type 'integer
:group 'pascal)
(defcustom pascal-auto-newline nil
- "*Non-nil means automatically insert newlines in certain cases.
+ "Non-nil means automatically insert newlines in certain cases.
These include after semicolons and after the punctuation mark after an `end'."
:type 'boolean
:group 'pascal)
(defcustom pascal-indent-nested-functions t
- "*Non-nil means nested functions are indented."
+ "Non-nil means nested functions are indented."
:type 'boolean
:group 'pascal)
(defcustom pascal-tab-always-indent t
- "*Non-nil means TAB in Pascal mode should always reindent the current line.
+ "Non-nil means TAB in Pascal mode should always reindent the current line.
If this is nil, TAB inserts a tab if it is at the end of the line
and follows non-whitespace text."
:type 'boolean
:group 'pascal)
(defcustom pascal-auto-endcomments t
- "*Non-nil means automatically insert comments after certain `end's.
+ "Non-nil means automatically insert comments after certain `end's.
Specifically, this is done after the ends of cases statements and functions.
The name of the function or case is included between the braces."
:type 'boolean
:group 'pascal)
(defcustom pascal-auto-lineup '(all)
- "*List of contexts where auto lineup of :'s or ='s should be done.
+ "List of contexts where auto lineup of :'s or ='s should be done.
Elements can be of type: 'paramlist', 'declaration' or 'case', which will
do auto lineup in parameterlist, declarations or case-statements
respectively. The word 'all' will do all lineups. '(case paramlist) for
@@ -232,16 +231,16 @@ will do all lineups."
:group 'pascal)
(defvar pascal-toggle-completions nil
- "*Non-nil meant \\<pascal-mode-map>\\[pascal-complete-word] would try all possible completions one by one.
-Repeated use of \\[pascal-complete-word] would show you all of them.
-Normally, when there is more than one possible completion,
-it displays a list of all possible completions.")
+ "If non-nil, `pascal-complete-word' tries all possible completions.
+Repeated use of \\[pascal-complete-word] then shows all
+completions in turn, instead of displaying a list of all possible
+completions.")
(make-obsolete-variable 'pascal-toggle-completions
'completion-cycle-threshold "24.1")
(defcustom pascal-type-keywords
'("array" "file" "packed" "char" "integer" "real" "string" "record")
- "*Keywords for types used when completing a word in a declaration or parmlist.
+ "Keywords for types used when completing a word in a declaration or parmlist.
These include integer, real, char, etc.
The types defined within the Pascal program
are handled in another way, and should not be added to this list."
@@ -251,7 +250,7 @@ are handled in another way, and should not be added to this list."
(defcustom pascal-start-keywords
'("begin" "end" "function" "procedure" "repeat" "until" "while"
"read" "readln" "reset" "rewrite" "write" "writeln")
- "*Keywords to complete when standing at the first word of a statement.
+ "Keywords to complete when standing at the first word of a statement.
These are keywords such as begin, repeat, until, readln.
The procedures and variables defined within the Pascal program
are handled in another way, and should not be added to this list."
@@ -260,7 +259,7 @@ are handled in another way, and should not be added to this list."
(defcustom pascal-separator-keywords
'("downto" "else" "mod" "div" "then")
- "*Keywords to complete when NOT standing at the first word of a statement.
+ "Keywords to complete when NOT standing at the first word of a statement.
These are keywords such as downto, else, mod, then.
Variables and function names defined within the Pascal program
are handled in another way, and should not be added to this list."
@@ -467,6 +466,8 @@ no args, if that value is non-nil."
;;;
;;; Interactive functions
;;;
+(defvar pascal--extra-indent 0)
+
(defun pascal-insert-block ()
"Insert Pascal begin ... end; block in the code with right indentation."
(interactive)
@@ -757,14 +758,14 @@ on the line which ends a function or procedure named NAME."
;;; Indentation
;;;
(defconst pascal-indent-alist
- '((block . (+ ind pascal-indent-level))
- (case . (+ ind pascal-case-indent))
- (caseblock . ind) (cpp . 0)
- (declaration . (+ ind pascal-indent-level))
+ '((block . (+ pascal--extra-indent pascal-indent-level))
+ (case . (+ pascal--extra-indent pascal-case-indent))
+ (caseblock . pascal--extra-indent) (cpp . 0)
+ (declaration . (+ pascal--extra-indent pascal-indent-level))
(paramlist . (pascal-indent-paramlist t))
(comment . (pascal-indent-comment))
- (defun . ind) (contexp . ind)
- (unknown . ind) (string . 0) (progbeg . 0)))
+ (defun . pascal--extra-indent) (contexp . pascal--extra-indent)
+ (unknown . pascal--extra-indent) (string . 0) (progbeg . 0)))
(defun pascal-indent-command ()
"Indent for special part of code."
@@ -786,12 +787,11 @@ on the line which ends a function or procedure named NAME."
(if (looking-at "[ \t]+$")
(skip-chars-forward " \t"))))
-(defvar ind) ;Used via `eval' in pascal-indent-alist.
(defun pascal-indent-line ()
"Indent current line as a Pascal statement."
(let* ((indent-str (pascal-calculate-indent))
(type (car indent-str))
- (ind (car (cdr indent-str))))
+ (pascal--extra-indent (car (cdr indent-str))))
;; Labels should not be indented.
(if (and (looking-at "^[0-9a-zA-Z]+[ \t]*:[^=]")
(not (eq type 'declaration)))
@@ -803,13 +803,13 @@ on the line which ends a function or procedure named NAME."
())
(; Other things should have no extra indent
(looking-at pascal-noindent-re)
- (indent-to ind))
+ (indent-to pascal--extra-indent))
(; Nested functions should be indented
(looking-at pascal-defun-re)
(if (and pascal-indent-nested-functions
(eq type 'defun))
- (indent-to (+ ind pascal-indent-level))
- (indent-to ind)))
+ (indent-to (+ pascal--extra-indent pascal-indent-level))
+ (indent-to pascal--extra-indent)))
(; But most lines are treated this way
(indent-to (eval (cdr (assoc type pascal-indent-alist))))
))))
@@ -949,7 +949,7 @@ Do not count labels, case-statements or records."
(point-marker)
(re-search-backward "\\<case\\>" nil t)))
(beg (point))
- (ind 0))
+ (pascal--extra-indent 0))
;; Get right indent
(while (< (point) end)
(if (re-search-forward
@@ -959,8 +959,8 @@ Do not count labels, case-statements or records."
(if (< (point) end)
(progn
(delete-horizontal-space)
- (if (> (current-column) ind)
- (setq ind (current-column)))
+ (if (> (current-column) pascal--extra-indent)
+ (setq pascal--extra-indent (current-column)))
(pascal-end-of-statement))))
(goto-char beg)
;; Indent all case statements
@@ -969,7 +969,7 @@ Do not count labels, case-statements or records."
"^[ \t]*[^][ \t,\\.:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
(marker-position end) 'move)
(forward-char -1))
- (indent-to (1+ ind))
+ (indent-to (1+ pascal--extra-indent))
(if (/= (following-char) ?:)
()
(forward-char 1)
@@ -1017,7 +1017,7 @@ indent of the current line in parameterlist."
(max (progn (pascal-declaration-end)
(point))
pos))))
- ind)
+ pascal--extra-indent)
(goto-char stpos)
;; Indent lines in record block
@@ -1031,13 +1031,13 @@ indent of the current line in parameterlist."
(forward-line 1)))
;; Do lineup
- (setq ind (pascal-get-lineup-indent stpos edpos lineup))
+ (setq pascal--extra-indent (pascal-get-lineup-indent stpos edpos lineup))
(goto-char stpos)
(while (and (<= (point) edpos) (not (eobp)))
(if (search-forward lineup (point-at-eol) 'move)
(forward-char -1))
(delete-horizontal-space)
- (indent-to ind)
+ (indent-to pascal--extra-indent)
(if (not (looking-at lineup))
(forward-line 1) ; No more indent if there is no : or =
(forward-char 1)
@@ -1056,7 +1056,7 @@ indent of the current line in parameterlist."
;from b to e nicely. The lineup string is str."
(defun pascal-get-lineup-indent (b e str)
(save-excursion
- (let ((ind 0)
+ (let ((pascal--extra-indent 0)
(reg (concat str "\\|\\(\\<record\\>\\)\\|" pascal-defun-re)))
(goto-char b)
;; Get rightmost position
@@ -1071,14 +1071,14 @@ indent of the current line in parameterlist."
(t
(goto-char (match-beginning 0))
(skip-chars-backward " \t")
- (if (> (current-column) ind)
- (setq ind (current-column)))
+ (if (> (current-column) pascal--extra-indent)
+ (setq pascal--extra-indent (current-column)))
(goto-char (match-end 0))
(end-of-line)
))))
;; In case no lineup was found
- (if (> ind 0)
- (1+ ind)
+ (if (> pascal--extra-indent 0)
+ (1+ pascal--extra-indent)
;; No lineup-string found
(goto-char b)
(end-of-line)
@@ -1353,21 +1353,21 @@ The default is a name found in the buffer around point."
(default (if (pascal-comp-defun default nil 'lambda)
default ""))
(label
- ;; Do completion with default
+ ;; Do completion with default.
(completing-read (if (not (string= default ""))
(concat "Label (default " default "): ")
"Label: ")
;; Complete with the defuns found in the
;; current-buffer.
- (lexical-let ((buf (current-buffer)))
+ (let ((buf (current-buffer)))
(lambda (s p a)
(with-current-buffer buf
(pascal-comp-defun s p a))))
nil t "")))
- ;; If there was no response on prompt, use default value
+ ;; If there was no response on prompt, use default value.
(if (string= label "")
(setq label default))
- ;; Goto right place in buffer if label is not an empty string
+ ;; Goto right place in buffer if label is not an empty string.
(or (string= label "")
(progn
(goto-char (point-min))
@@ -1394,8 +1394,12 @@ The default is a name found in the buffer around point."
(define-obsolete-function-alias 'pascal-outline 'pascal-outline-mode "22.1")
(define-minor-mode pascal-outline-mode
"Outline-line minor mode for Pascal mode.
-When in Pascal Outline mode, portions
-of the text being edited may be made invisible. \\<pascal-outline-map>
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
+
+When enabled, portions of the text being edited may be made
+invisible. \\<pascal-outline-map>
Pascal Outline mode provides some additional commands.
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index f051b49fe2a..d2f7fc7a059 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -1,6 +1,6 @@
-;;; perl-mode.el --- Perl code editing commands for GNU Emacs
+;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- coding: utf-8 -*-
-;; Copyright (C) 1990, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: William F. Mann
;; Maintainer: FSF
@@ -28,14 +28,14 @@
;;; Commentary:
;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode")
-;; to your .emacs file and change the first line of your perl script to:
+;; to your init file and change the first line of your perl script to:
;; #!/usr/bin/perl -- # -*-Perl-*-
;; With arguments to perl:
;; #!/usr/bin/perl -P- # -*-Perl-*-
;; To handle files included with do 'filename.pl';, add something like
;; (setq auto-mode-alist (append (list (cons "\\.pl\\'" 'perl-mode))
;; auto-mode-alist))
-;; to your .emacs file; otherwise the .pl suffix defaults to prolog-mode.
+;; to your init file; otherwise the .pl suffix defaults to prolog-mode.
;; This code is based on the 18.53 version c-mode.el, with extensive
;; rewriting. Most of the features of c-mode survived intact.
@@ -102,12 +102,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
-(defvar font-lock-comment-face)
-(defvar font-lock-doc-face)
-(defvar font-lock-string-face)
-
(defgroup perl nil
"Major mode for editing Perl code."
:link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
@@ -120,24 +114,14 @@
(defvar perl-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "{" 'perl-electric-terminator)
- (define-key map "}" 'perl-electric-terminator)
- (define-key map ";" 'perl-electric-terminator)
- (define-key map ":" 'perl-electric-terminator)
(define-key map "\e\C-a" 'perl-beginning-of-function)
(define-key map "\e\C-e" 'perl-end-of-function)
(define-key map "\e\C-h" 'perl-mark-function)
(define-key map "\e\C-q" 'perl-indent-exp)
(define-key map "\177" 'backward-delete-char-untabify)
- (define-key map "\t" 'perl-indent-command)
map)
"Keymap used in Perl mode.")
-(autoload 'c-macro-expand "cmacexp"
- "Display the result of expanding all C macros occurring in the region.
-The expansion is entirely correct because it uses the C preprocessor."
- t)
-
(defvar perl-mode-syntax-table
(let ((st (make-syntax-table (standard-syntax-table))))
(modify-syntax-entry ?\n ">" st)
@@ -164,16 +148,54 @@ The expansion is entirely correct because it uses the C preprocessor."
(defvar perl-imenu-generic-expression
'(;; Functions
- (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1)
+ (nil "^[ \t]*sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1)
;;Variables
("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1)
- ("Packages" "^package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1)
+ ("Packages" "^[ \t]*package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1)
("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1))
"Imenu generic expression for Perl mode. See `imenu-generic-expression'.")
;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and
;; Jim Campbell <jec@murzim.ca.boeing.com>.
+(defcustom perl-prettify-symbols t
+ "If non-nil, some symbols will be displayed using Unicode chars."
+ :type 'boolean)
+
+(defconst perl--prettify-symbols-alist
+ '(;;("andalso" . ?∧) ("orelse" . ?∨) ("as" . ?≡)("not" . ?¬)
+ ;;("div" . ?÷) ("*" . ?×) ("o" . ?○)
+ ("->" . ?→)
+ ("=>" . ?⇒)
+ ;;("<-" . ?←) ("<>" . ?≠) (">=" . ?≥) ("<=" . ?≤) ("..." . ?⋯)
+ ("::" . ?∷)
+ ))
+
+(defun perl--font-lock-compose-symbol ()
+ "Compose a sequence of ascii chars into a symbol.
+Regexp match data 0 points to the chars."
+ ;; Check that the chars should really be composed into a symbol.
+ (let* ((start (match-beginning 0))
+ (end (match-end 0))
+ (syntaxes (if (eq (char-syntax (char-after start)) ?w)
+ '(?w) '(?. ?\\))))
+ (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes)
+ (memq (char-syntax (or (char-after end) ?\ )) syntaxes)
+ (nth 8 (syntax-ppss)))
+ ;; No composition for you. Let's actually remove any composition
+ ;; we may have added earlier and which is now incorrect.
+ (remove-text-properties start end '(composition))
+ ;; That's a symbol alright, so add the composition.
+ (compose-region start end (cdr (assoc (match-string 0)
+ perl--prettify-symbols-alist)))))
+ ;; Return nil because we're not adding any face property.
+ nil)
+
+(defun perl--font-lock-symbols-keywords ()
+ (when perl-prettify-symbols
+ `((,(regexp-opt (mapcar 'car perl--prettify-symbols-alist) t)
+ (0 (perl--font-lock-compose-symbol))))))
+
(defconst perl-font-lock-keywords-1
'(;; What is this for?
;;("\\(--- .* ---\\|=== .* ===\\)" . font-lock-string-face)
@@ -196,32 +218,32 @@ The expansion is entirely correct because it uses the C preprocessor."
"Subdued level highlighting for Perl mode.")
(defconst perl-font-lock-keywords-2
- (append perl-font-lock-keywords-1
- (list
- ;;
- ;; Fontify keywords, except those fontified otherwise.
- (concat "\\<"
- (regexp-opt '("if" "until" "while" "elsif" "else" "unless"
- "do" "dump" "for" "foreach" "exit" "die"
- "BEGIN" "END" "return" "exec" "eval") t)
- "\\>")
- ;;
- ;; Fontify local and my keywords as types.
- '("\\<\\(local\\|my\\)\\>" . font-lock-type-face)
- ;;
- ;; Fontify function, variable and file name references.
- '("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
- ;; Additionally underline non-scalar variables. Maybe this is a bad idea.
- ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face)
- '("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
- '("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
+ (append
+ perl-font-lock-keywords-1
+ `( ;; Fontify keywords, except those fontified otherwise.
+ ,(concat "\\<"
+ (regexp-opt '("if" "until" "while" "elsif" "else" "unless"
+ "do" "dump" "for" "foreach" "exit" "die"
+ "BEGIN" "END" "return" "exec" "eval") t)
+ "\\>")
+ ;;
+ ;; Fontify local and my keywords as types.
+ ("\\<\\(local\\|my\\)\\>" . font-lock-type-face)
+ ;;
+ ;; Fontify function, variable and file name references.
+ ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
+ ;; Additionally underline non-scalar variables. Maybe this is a bad idea.
+ ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face)
+ ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
+ ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
(2 (cons font-lock-variable-name-face '(underline))))
- '("<\\(\\sw+\\)>" 1 font-lock-constant-face)
- ;;
- ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
- '("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?"
+ ("<\\(\\sw+\\)>" 1 font-lock-constant-face)
+ ;;
+ ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
+ ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?"
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
- '("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face)))
+ ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face)
+ ,@(perl--font-lock-symbols-keywords)))
"Gaudy level highlighting for Perl mode.")
(defvar perl-font-lock-keywords perl-font-lock-keywords-1
@@ -378,7 +400,7 @@ The expansion is entirely correct because it uses the C preprocessor."
;; we are: we have to go back to the beginning of this
;; "string" and count from there.
(condition-case nil
- (progn
+ (progn
;; Start after the first char since it doesn't have
;; paren-syntax (an alternative would be to let-bind
;; parse-sexp-lookup-properties).
@@ -388,7 +410,11 @@ The expansion is entirely correct because it uses the C preprocessor."
;; In case of error, make sure we don't move backward.
(scan-error (goto-char startpos) nil))
(not (or (nth 8 (parse-partial-sexp
- (point) limit nil nil state 'syntax-table))
+ ;; Since we don't know if point is within
+ ;; the first or the scond arg, we have to
+ ;; start from the beginning.
+ (if twoargs (1+ (nth 8 state)) (point))
+ limit nil nil state 'syntax-table))
;; If we have a self-paired opener and a twoargs
;; command, the form is s/../../ so we have to skip
;; a second time.
@@ -411,17 +437,17 @@ The expansion is entirely correct because it uses the C preprocessor."
;; s{...}{...}) we're right after the first arg, so we still have to
;; handle the second part.
(when (and twoargs close)
- ;; Skip whitespace and make sure that font-lock will
- ;; refontify the second part in the proper context.
- (put-text-property
- (point) (progn (forward-comment (point-max)) (point))
+ ;; Skip whitespace and make sure that font-lock will
+ ;; refontify the second part in the proper context.
+ (put-text-property
+ (point) (progn (forward-comment (point-max)) (point))
'syntax-multiline t)
- ;;
+ ;;
(when (< (point) limit)
- (put-text-property (point) (1+ (point))
- 'syntax-table
- (if (assoc (char-after)
- perl-quote-like-pairs)
+ (put-text-property (point) (1+ (point))
+ 'syntax-table
+ (if (assoc (char-after)
+ perl-quote-like-pairs)
;; Put an `e' in the cdr to mark this
;; char as "second arg starter".
(string-to-syntax "|e")
@@ -464,7 +490,7 @@ The expansion is entirely correct because it uses the C preprocessor."
(t (funcall (default-value 'font-lock-syntactic-face-function) state))))
(defcustom perl-indent-level 4
- "*Indentation of Perl statements with respect to containing block."
+ "Indentation of Perl statements with respect to containing block."
:type 'integer
:group 'perl)
@@ -481,32 +507,40 @@ The expansion is entirely correct because it uses the C preprocessor."
;;;###autoload(put 'perl-label-offset 'safe-local-variable 'integerp)
(defcustom perl-continued-statement-offset 4
- "*Extra indent for lines not starting new statements."
+ "Extra indent for lines not starting new statements."
:type 'integer
:group 'perl)
(defcustom perl-continued-brace-offset -4
- "*Extra indent for substatements that start with open-braces.
+ "Extra indent for substatements that start with open-braces.
This is in addition to `perl-continued-statement-offset'."
:type 'integer
:group 'perl)
(defcustom perl-brace-offset 0
- "*Extra indentation for braces, compared with other text in same context."
+ "Extra indentation for braces, compared with other text in same context."
:type 'integer
:group 'perl)
(defcustom perl-brace-imaginary-offset 0
- "*Imagined indentation of an open brace that actually follows a statement."
+ "Imagined indentation of an open brace that actually follows a statement."
:type 'integer
:group 'perl)
(defcustom perl-label-offset -2
- "*Offset of Perl label lines relative to usual indentation."
+ "Offset of Perl label lines relative to usual indentation."
:type 'integer
:group 'perl)
(defcustom perl-indent-continued-arguments nil
- "*If non-nil offset of argument lines relative to usual indentation.
+ "If non-nil offset of argument lines relative to usual indentation.
If nil, continued arguments are aligned with the first argument."
:type '(choice integer (const nil))
:group 'perl)
+(defcustom perl-indent-parens-as-block nil
+ "Non-nil means that non-block ()-, {}- and []-groups are indented as blocks.
+The closing bracket is aligned with the line of the opening bracket,
+not the contents of the brackets."
+ :version "24.3"
+ :type 'boolean
+ :group 'perl)
+
(defcustom perl-tab-always-indent tab-always-indent
"Non-nil means TAB in Perl mode always indents the current line.
Otherwise it inserts a tab character if you type it past the first
@@ -517,7 +551,7 @@ nonwhite character on the line."
;; I changed the default to nil for consistency with general Emacs
;; conventions -- rms.
(defcustom perl-tab-to-comment nil
- "*Non-nil means TAB moves to eol or makes a comment in some cases.
+ "Non-nil means TAB moves to eol or makes a comment in some cases.
For lines which don't need indenting, TAB either indents an
existing comment, moves to end-of-line, or if at end-of-line already,
create a new comment."
@@ -525,7 +559,7 @@ create a new comment."
:group 'perl)
(defcustom perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:[^:]"
- "*Lines starting with this regular expression are not auto-indented."
+ "Lines starting with this regular expression are not auto-indented."
:type 'regexp
:group 'perl)
@@ -537,8 +571,10 @@ create a new comment."
(defun perl-outline-level ()
(cond
- ((looking-at "package\\s-") 0)
- ((looking-at "sub\\s-") 1)
+ ((looking-at "[ \t]*\\(package\\)\\s-")
+ (- (match-beginning 1) (match-beginning 0)))
+ ((looking-at "[ \t]*s\\(ub\\)\\s-")
+ (- (match-beginning 1) (match-beginning 0)))
((looking-at "=head[0-9]") (- (char-before (match-end 0)) ?0))
((looking-at "=cut") 1)
(t 3)))
@@ -615,6 +651,11 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
#'perl-syntax-propertize-function)
(add-hook 'syntax-propertize-extend-region-functions
#'syntax-propertize-multiline 'append 'local)
+ ;; Electricity.
+ ;; FIXME: setup electric-layout-rules.
+ (set (make-local-variable 'electric-indent-chars)
+ (append '(?\{ ?\} ?\; ?\:) electric-indent-chars))
+ (add-hook 'electric-indent-functions #'perl-electric-noindent-p nil t)
;; Tell imenu how to handle Perl.
(set (make-local-variable 'imenu-generic-expression)
perl-imenu-generic-expression)
@@ -631,7 +672,11 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
0 ;Existing comment at bol stays there.
comment-column))
-(defalias 'electric-perl-terminator 'perl-electric-terminator)
+(define-obsolete-function-alias 'electric-perl-terminator
+ 'perl-electric-terminator "22.1")
+(defun perl-electric-noindent-p (char)
+ (unless (eolp) 'no-indent))
+
(defun perl-electric-terminator (arg)
"Insert character and maybe adjust indentation.
If at end-of-line, and not in a comment or a quote, correct the indentation."
@@ -655,6 +700,7 @@ If at end-of-line, and not in a comment or a quote, correct the indentation."
(perl-indent-line)
(delete-char -1))))
(self-insert-command (prefix-numeric-value arg)))
+(make-obsolete 'perl-electric-terminator 'electric-indent-mode "24.4")
;; not used anymore, but may be useful someday:
;;(defun perl-inside-parens-p ()
@@ -738,6 +784,7 @@ following list:
(t
(message "Use backslash to quote # characters.")
(ding t)))))))))
+(make-obsolete 'perl-indent-command 'indent-according-to-mode "24.4")
(defun perl-indent-line (&optional nochange parse-start)
"Indent current line as Perl code.
@@ -752,6 +799,7 @@ changed by, or (parse-state) if line starts in a quoted string."
(setq shift-amt
(cond ((eq (char-after bof) ?=) 0)
((listp (setq indent (perl-calculate-indent bof))) indent)
+ ((eq 'noindent indent) indent)
((looking-at (or nochange perl-nochange)) 0)
(t
(skip-chars-forward " \t\f")
@@ -845,10 +893,11 @@ Optional argument PARSE-START should be the position of `beginning-of-defun'."
;; following_quotep minimum_paren-depth_this_scan)
;; Parsing stops if depth in parentheses becomes equal to third arg.
(setq containing-sexp (nth 1 state)))
- (cond ((nth 3 state) state) ; In a quoted string?
+ (cond ((nth 3 state) 'noindent) ; In a quoted string?
((null containing-sexp) ; Line is at top level.
(skip-chars-forward " \t\f")
- (if (= (following-char) ?{)
+ (if (memq (following-char)
+ (if perl-indent-parens-as-block '(?\{ ?\( ?\[) '(?\{)))
0 ; move to beginning of line if it starts a function body
;; indent a little if this is a continuation line
(perl-backward-to-noncomment)
@@ -892,7 +941,9 @@ Optional argument PARSE-START should be the position of `beginning-of-defun'."
0 perl-continued-statement-offset)
(current-column)
(if (save-excursion (goto-char indent-point)
- (looking-at "[ \t]*{"))
+ (looking-at
+ (if perl-indent-parens-as-block
+ "[ \t]*[{(\[]" "[ \t]*{")))
perl-continued-brace-offset 0)))
;; This line starts a new statement.
;; Position at last unclosed open.
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 0efc2ca231b..99df94d3805 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -1,6 +1,6 @@
;;; prolog.el --- major mode for editing and running Prolog (and Mercury) code
-;; Copyright (C) 1986-1987, 1997-1999, 2002-2003, 2011
+;; Copyright (C) 1986-1987, 1997-1999, 2002-2003, 2011-2012
;; Free Software Foundation, Inc.
;; Authors: Emil strm <emil_astrom(at)hotmail(dot)com>
@@ -37,7 +37,8 @@
;; Some ideas and also a few lines of code have been borrowed (not stolen ;-)
;; from Oz.el, the Emacs major mode for the Oz programming language,
;; Copyright (C) 1993 DFKI GmbH, Germany, with permission.
-;; Authors: Ralf Scheidhauer and Michael Mehl ([scheidhr|mehl](at)dfki(dot)uni-sb(dot)de)
+;; Authored by Ralf Scheidhauer and Michael Mehl
+;; ([scheidhr|mehl](at)dfki(dot)uni-sb(dot)de)
;;
;; More ideas and code have been taken from the SICStus debugger mode
;; (http://www.csd.uu.se/~perm/source_debug/index.shtml -- broken link
@@ -59,9 +60,7 @@
;;; Installation:
;;
-;; Insert the following lines in your init file--typically ~/.emacs
-;; (GNU Emacs and XEmacs <21.4), or ~/.xemacs/init.el (XEmacs
-;; 21.4)--to use this mode when editing Prolog files under Emacs:
+;; Insert the following lines in your init file:
;;
;; (setq load-path (cons "/usr/lib/xemacs/site-lisp" load-path))
;; (autoload 'run-prolog "prolog" "Start a Prolog sub-process." t)
@@ -294,7 +293,7 @@
(defgroup prolog nil
- "Major modes for editing and running Prolog and Mercury files."
+ "Editing and running Prolog and Mercury files."
:group 'languages)
(defgroup prolog-faces nil
@@ -329,7 +328,7 @@
;; General configuration
(defcustom prolog-system nil
- "*Prolog interpreter/compiler used.
+ "Prolog interpreter/compiler used.
The value of this variable is nil or a symbol.
If it is a symbol, it determines default values of other configuration
variables with respect to properties of the specified Prolog
@@ -341,6 +340,7 @@ mercury - Mercury
sicstus - SICStus Prolog
swi - SWI Prolog
gnu - GNU Prolog"
+ :version "24.1"
:group 'prolog
:type '(choice (const :tag "SICStus" :value sicstus)
(const :tag "SWI Prolog" :value swi)
@@ -361,63 +361,74 @@ gnu - GNU Prolog"
(eclipse (3 . 7))
(gnu (0 . 0)))
;; FIXME: This should be auto-detected instead of user-provided.
- "*Alist of Prolog system versions.
+ "Alist of Prolog system versions.
The version numbers are of the format (Major . Minor)."
+ :version "24.1"
+ :type '(repeat (list (symbol :tag "System")
+ (cons :tag "Version numbers" (integer :tag "Major")
+ (integer :tag "Minor"))))
:group 'prolog)
;; Indentation
(defcustom prolog-indent-width 4
- "*The indentation width used by the editing buffer."
+ "The indentation width used by the editing buffer."
:group 'prolog-indentation
:type 'integer)
(defcustom prolog-align-comments-flag t
- "*Non-nil means automatically align comments when indenting."
+ "Non-nil means automatically align comments when indenting."
+ :version "24.1"
:group 'prolog-indentation
:type 'boolean)
(defcustom prolog-indent-mline-comments-flag t
- "*Non-nil means indent contents of /* */ comments.
+ "Non-nil means indent contents of /* */ comments.
Otherwise leave such lines as they are."
+ :version "24.1"
:group 'prolog-indentation
:type 'boolean)
(defcustom prolog-object-end-to-0-flag t
- "*Non-nil means indent closing '}' in SICStus object definitions to level 0.
+ "Non-nil means indent closing '}' in SICStus object definitions to level 0.
Otherwise indent to `prolog-indent-width'."
+ :version "24.1"
:group 'prolog-indentation
:type 'boolean)
(defcustom prolog-left-indent-regexp "\\(;\\|\\*?->\\)"
- "*Regexp for character sequences after which next line is indented.
+ "Regexp for character sequences after which next line is indented.
Next line after such a regexp is indented to the opening parenthesis level."
+ :version "24.1"
:group 'prolog-indentation
:type 'regexp)
(defcustom prolog-paren-indent-p nil
- "*If non-nil, increase indentation for parenthesis expressions.
+ "If non-nil, increase indentation for parenthesis expressions.
The second and subsequent line in a parenthesis expression other than
a compound term can either be indented `prolog-paren-indent' to the
right (if this variable is non-nil) or in the same way as for compound
terms (if this variable is nil, default)."
+ :version "24.1"
:group 'prolog-indentation
:type 'boolean)
(defcustom prolog-paren-indent 4
- "*The indentation increase for parenthesis expressions.
+ "The indentation increase for parenthesis expressions.
Only used in ( If -> Then ; Else) and ( Disj1 ; Disj2 ) style expressions."
+ :version "24.1"
:group 'prolog-indentation
:type 'integer)
(defcustom prolog-parse-mode 'beg-of-clause
- "*The parse mode used (decides from which point parsing is done).
+ "The parse mode used (decides from which point parsing is done).
Legal values:
'beg-of-line - starts parsing at the beginning of a line, unless the
previous line ends with a backslash. Fast, but has
problems detecting multiline /* */ comments.
'beg-of-clause - starts parsing at the beginning of the current clause.
Slow, but copes better with /* */ comments."
+ :version "24.1"
:group 'prolog-indentation
:type '(choice (const :value beg-of-line)
(const :value beg-of-clause)))
@@ -447,7 +458,8 @@ Legal values:
(t
;; FIXME: Shouldn't we just use the union of all the above here?
("dynamic" "module")))
- "*Alist of Prolog keywords which is used for font locking of directives."
+ "Alist of Prolog keywords which is used for font locking of directives."
+ :version "24.1"
:group 'prolog-font-lock
:type 'sexp)
@@ -455,7 +467,8 @@ Legal values:
'((mercury
("char" "float" "int" "io__state" "string" "univ"))
(t nil))
- "*Alist of Prolog types used by font locking."
+ "Alist of Prolog types used by font locking."
+ :version "24.1"
:group 'prolog-font-lock
:type 'sexp)
@@ -463,7 +476,8 @@ Legal values:
'((mercury
("bound" "di" "free" "ground" "in" "mdi" "mui" "muo" "out" "ui" "uo"))
(t nil))
- "*Alist of Prolog mode specificators used by font locking."
+ "Alist of Prolog mode specificators used by font locking."
+ :version "24.1"
:group 'prolog-font-lock
:type 'sexp)
@@ -472,7 +486,8 @@ Legal values:
("cc_multi" "cc_nondet" "det" "erroneous" "failure" "multi" "nondet"
"semidet"))
(t nil))
- "*Alist of Prolog determinism specificators used by font locking."
+ "Alist of Prolog determinism specificators used by font locking."
+ :version "24.1"
:group 'prolog-font-lock
:type 'sexp)
@@ -480,7 +495,8 @@ Legal values:
'((mercury
("^#[0-9]+"))
(t nil))
- "*Alist of Prolog source code directives used by font locking."
+ "Alist of Prolog source code directives used by font locking."
+ :version "24.1"
:group 'prolog-font-lock
:type 'sexp)
@@ -488,17 +504,19 @@ Legal values:
;; Keyboard
(defcustom prolog-electric-newline-flag (not (fboundp 'electric-indent-mode))
- "*Non-nil means automatically indent the next line when the user types RET."
+ "Non-nil means automatically indent the next line when the user types RET."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-hungry-delete-key-flag nil
- "*Non-nil means delete key consumes all preceding spaces."
+ "Non-nil means delete key consumes all preceding spaces."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-dot-flag nil
- "*Non-nil means make dot key electric.
+ "Non-nil means make dot key electric.
Electric dot appends newline or inserts head of a new clause.
If dot is pressed at the end of a line where at least one white space
precedes the point, it inserts a recursive call to the current predicate.
@@ -506,53 +524,61 @@ If dot is pressed at the beginning of an empty line, it inserts the head
of a new clause for the current predicate. It does not apply in strings
and comments.
It does not apply in strings and comments."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-dot-full-predicate-template nil
- "*If nil, electric dot inserts only the current predicate's name and `('
+ "If nil, electric dot inserts only the current predicate's name and `('
for recursive calls or new clause heads. Non-nil means to also
insert enough commas to cover the predicate's arity and `)',
and dot and newline for recursive calls."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-underscore-flag nil
- "*Non-nil means make underscore key electric.
+ "Non-nil means make underscore key electric.
Electric underscore replaces the current variable with underscore.
If underscore is pressed not on a variable then it behaves as usual."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-tab-flag nil
- "*Non-nil means make TAB key electric.
+ "Non-nil means make TAB key electric.
Electric TAB inserts spaces after parentheses, ->, and ;
in ( If -> Then ; Else) and ( Disj1 ; Disj2 ) style expressions."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-if-then-else-flag nil
- "*Non-nil makes `(', `>' and `;' electric
+ "Non-nil makes `(', `>' and `;' electric
to automatically indent if-then-else constructs."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-colon-flag nil
- "*Makes `:' electric (inserts `:-' on a new line).
+ "Makes `:' electric (inserts `:-' on a new line).
If non-nil, pressing `:' at the end of a line that starts in
the first column (i.e., clause heads) inserts ` :-' and newline."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-dash-flag nil
- "*Makes `-' electric (inserts a `-->' on a new line).
+ "Makes `-' electric (inserts a `-->' on a new line).
If non-nil, pressing `-' at the end of a line that starts in
the first column (i.e., DCG heads) inserts ` -->' and newline."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-old-sicstus-keys-flag nil
- "*Non-nil means old SICStus Prolog mode keybindings are used."
+ "Non-nil means old SICStus Prolog mode keybindings are used."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
@@ -570,7 +596,7 @@ the first column (i.e., DCG heads) inserts ` -->' and newline."
(not (executable-find (car names))))
(setq names (cdr names)))
(or (car names) "prolog"))))
- "*Alist of program names for invoking an inferior Prolog with `run-prolog'."
+ "Alist of program names for invoking an inferior Prolog with `run-prolog'."
:group 'prolog-inferior
:type 'sexp)
(defun prolog-program-name ()
@@ -579,7 +605,8 @@ the first column (i.e., DCG heads) inserts ` -->' and newline."
(defcustom prolog-program-switches
'((sicstus ("-i"))
(t nil))
- "*Alist of switches given to inferior Prolog run with `run-prolog'."
+ "Alist of switches given to inferior Prolog run with `run-prolog'."
+ :version "24.1"
:group 'prolog-inferior
:type 'sexp)
(defun prolog-program-switches ()
@@ -594,7 +621,7 @@ the first column (i.e., DCG heads) inserts ` -->' and newline."
(swi "[%f].")
(gnu "[%f].")
(t "reconsult(%f)."))
- "*Alist of strings defining predicate for reconsulting.
+ "Alist of strings defining predicate for reconsulting.
Some parts of the string are replaced:
`%f' by the name of the consulted file (can be a temporary file)
@@ -616,7 +643,7 @@ Some parts of the string are replaced:
"prolog:zap_file(%m,%b,compile).")))
(swi "[%f].")
(t "compile(%f)."))
- "*Alist of strings and lists defining predicate for recompilation.
+ "Alist of strings and lists defining predicate for recompilation.
Some parts of the string are replaced:
`%f' by the name of the compiled file (can be a temporary file)
@@ -634,7 +661,7 @@ If `prolog-program-name' is nil, it is an argument to the `compile' function."
(prolog-find-value-by-system prolog-compile-string))
(defcustom prolog-eof-string "end_of_file.\n"
- "*Alist of strings that represent end of file for prolog.
+ "Alist of strings that represent end of file for prolog.
nil means send actual operating system end of file."
:group 'prolog-inferior
:type 'sexp)
@@ -645,7 +672,8 @@ nil means send actual operating system end of file."
(swi "^\\(\\[[a-zA-Z]*\\] \\)?[1-9]?[0-9]*[ ]?\\?- \\|^| +")
(gnu "^| \\?-")
(t "^|? *\\?-"))
- "*Alist of prompts of the prolog system command line."
+ "Alist of prompts of the prolog system command line."
+ :version "24.1"
:group 'prolog-inferior
:type 'sexp)
(defun prolog-prompt-regexp ()
@@ -654,42 +682,48 @@ nil means send actual operating system end of file."
;; (defcustom prolog-continued-prompt-regexp
;; '((sicstus "^\\(| +\\| +\\)")
;; (t "^|: +"))
-;; "*Alist of regexps matching the prompt when consulting `user'."
+;; "Alist of regexps matching the prompt when consulting `user'."
;; :group 'prolog-inferior
;; :type 'sexp)
(defcustom prolog-debug-on-string "debug.\n"
- "*Predicate for enabling debug mode."
+ "Predicate for enabling debug mode."
+ :version "24.1"
:group 'prolog-inferior
:type 'string)
(defcustom prolog-debug-off-string "nodebug.\n"
- "*Predicate for disabling debug mode."
+ "Predicate for disabling debug mode."
+ :version "24.1"
:group 'prolog-inferior
:type 'string)
(defcustom prolog-trace-on-string "trace.\n"
- "*Predicate for enabling tracing."
+ "Predicate for enabling tracing."
+ :version "24.1"
:group 'prolog-inferior
:type 'string)
(defcustom prolog-trace-off-string "notrace.\n"
- "*Predicate for disabling tracing."
+ "Predicate for disabling tracing."
+ :version "24.1"
:group 'prolog-inferior
:type 'string)
(defcustom prolog-zip-on-string "zip.\n"
- "*Predicate for enabling zip mode for SICStus."
+ "Predicate for enabling zip mode for SICStus."
+ :version "24.1"
:group 'prolog-inferior
:type 'string)
(defcustom prolog-zip-off-string "nozip.\n"
- "*Predicate for disabling zip mode for SICStus."
+ "Predicate for disabling zip mode for SICStus."
+ :version "24.1"
:group 'prolog-inferior
:type 'string)
(defcustom prolog-use-standard-consult-compile-method-flag t
- "*Non-nil means use the standard compilation method.
+ "Non-nil means use the standard compilation method.
Otherwise the new compilation method will be used. This
utilizes a special compilation buffer with the associated
features such as parsing of error messages and automatically
@@ -698,6 +732,7 @@ jumping to the source code responsible for the error.
Warning: the new method is so far only experimental and
does contain bugs. The recommended setting for the novice user
is non-nil for this variable."
+ :version "24.1"
:group 'prolog-inferior
:type 'boolean)
@@ -706,41 +741,48 @@ is non-nil for this variable."
(defcustom prolog-use-prolog-tokenizer-flag
(not (fboundp 'syntax-propertize-rules))
- "*Non-nil means use the internal prolog tokenizer for indentation etc.
+ "Non-nil means use the internal prolog tokenizer for indentation etc.
Otherwise use `parse-partial-sexp' which is faster but sometimes incorrect."
+ :version "24.1"
:group 'prolog-other
:type 'boolean)
(defcustom prolog-imenu-flag t
- "*Non-nil means add a clause index menu for all prolog files."
+ "Non-nil means add a clause index menu for all prolog files."
+ :version "24.1"
:group 'prolog-other
:type 'boolean)
(defcustom prolog-imenu-max-lines 3000
- "*The maximum number of lines of the file for imenu to be enabled.
+ "The maximum number of lines of the file for imenu to be enabled.
Relevant only when `prolog-imenu-flag' is non-nil."
+ :version "24.1"
:group 'prolog-other
:type 'integer)
(defcustom prolog-info-predicate-index
"(sicstus)Predicate Index"
- "*The info node for the SICStus predicate index."
+ "The info node for the SICStus predicate index."
+ :version "24.1"
:group 'prolog-other
:type 'string)
(defcustom prolog-underscore-wordchar-flag nil
- "*Non-nil means underscore (_) is a word-constituent character."
+ "Non-nil means underscore (_) is a word-constituent character."
+ :version "24.1"
:group 'prolog-other
:type 'boolean)
(defcustom prolog-use-sicstus-sd nil
- "*If non-nil, use the source level debugger of SICStus 3#7 and later."
+ "If non-nil, use the source level debugger of SICStus 3#7 and later."
+ :version "24.1"
:group 'prolog-other
:type 'boolean)
(defcustom prolog-char-quote-workaround nil
- "*If non-nil, declare 0 as a quote character to handle 0'<char>.
+ "If non-nil, declare 0 as a quote character to handle 0'<char>.
This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24."
+ :version "24.1"
:group 'prolog-other
:type 'boolean)
@@ -789,18 +831,116 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24."
)
table))
(defvar prolog-mode-abbrev-table nil)
-(defvar prolog-upper-case-string ""
- "A string containing all upper case characters.
-Set by prolog-build-case-strings.")
-(defvar prolog-lower-case-string ""
- "A string containing all lower case characters.
-Set by prolog-build-case-strings.")
-
-(defvar prolog-atom-char-regexp ""
- "Set by prolog-set-atom-regexps.")
-;; "Regexp specifying characters which constitute atoms without quoting.")
-(defvar prolog-atom-regexp ""
- "Set by prolog-set-atom-regexps.")
+
+(if (eval-when-compile
+ (and (string-match "[[:upper:]]" "A")
+ (with-temp-buffer
+ (insert "A") (skip-chars-backward "[:upper:]") (bolp))))
+ (progn
+ (defconst prolog-upper-case-string "[:upper:]"
+ "A string containing a char-range matching all upper case characters.")
+ (defconst prolog-lower-case-string "[:lower:]"
+ "A string containing a char-range matching all lower case characters."))
+
+ ;; GNU Emacs compatibility: GNU Emacs does not differentiate between
+ ;; ints and chars, or at least these two are interchangeable.
+ (defalias 'prolog-int-to-char
+ (if (fboundp 'int-to-char) #'int-to-char #'identity))
+
+ (defalias 'prolog-char-to-int
+ (if (fboundp 'char-to-int) #'char-to-int #'identity))
+
+ (defun prolog-ints-intervals (ints)
+ "Return a list of intervals (from . to) covering INTS."
+ (when ints
+ (setq ints (sort ints '<))
+ (let ((prev (car ints))
+ (interval-start (car ints))
+ intervals)
+ (while ints
+ (let ((next (car ints)))
+ (when (> next (1+ prev)) ; start of new interval
+ (setq intervals (cons (cons interval-start prev) intervals))
+ (setq interval-start next))
+ (setq prev next)
+ (setq ints (cdr ints))))
+ (setq intervals (cons (cons interval-start prev) intervals))
+ (reverse intervals))))
+
+ (defun prolog-dash-letters (string)
+ "Return a condensed regexp covering all letters in STRING."
+ (let ((intervals (prolog-ints-intervals (mapcar #'prolog-char-to-int
+ (string-to-list string))))
+ codes)
+ (while intervals
+ (let* ((i (car intervals))
+ (from (car i))
+ (to (cdr i))
+ (c (cond ((= from to) `(,from))
+ ((= (1+ from) to) `(,from ,to))
+ (t `(,from ?- ,to)))))
+ (setq codes (cons c codes)))
+ (setq intervals (cdr intervals)))
+ (apply 'concat (reverse codes))))
+
+ (let ((up_string "")
+ (low_string ""))
+ ;; Use `map-char-table' if it is defined. Otherwise enumerate all
+ ;; numbers between 0 and 255. `map-char-table' is probably safer.
+ ;;
+ ;; `map-char-table' causes problems under Emacs 23.0.0.1, the
+ ;; while loop seems to do its job well (Ryszard Szopa)
+ ;;
+ ;;(if (and (not (featurep 'xemacs))
+ ;; (fboundp 'map-char-table))
+ ;; (map-char-table
+ ;; (lambda (key value)
+ ;; (cond
+ ;; ((and
+ ;; (eq (prolog-int-to-char key) (downcase key))
+ ;; (eq (prolog-int-to-char key) (upcase key)))
+ ;; ;; Do nothing if upper and lower case are the same
+ ;; )
+ ;; ((eq (prolog-int-to-char key) (downcase key))
+ ;; ;; The char is lower case
+ ;; (setq low_string (format "%s%c" low_string key)))
+ ;; ((eq (prolog-int-to-char key) (upcase key))
+ ;; ;; The char is upper case
+ ;; (setq up_string (format "%s%c" up_string key)))
+ ;; ))
+ ;; (current-case-table))
+ ;; `map-char-table' was undefined.
+ (let ((key 0))
+ (while (< key 256)
+ (cond
+ ((and
+ (eq (prolog-int-to-char key) (downcase key))
+ (eq (prolog-int-to-char key) (upcase key)))
+ ;; Do nothing if upper and lower case are the same
+ )
+ ((eq (prolog-int-to-char key) (downcase key))
+ ;; The char is lower case
+ (setq low_string (format "%s%c" low_string key)))
+ ((eq (prolog-int-to-char key) (upcase key))
+ ;; The char is upper case
+ (setq up_string (format "%s%c" up_string key)))
+ )
+ (setq key (1+ key))))
+ ;; )
+ ;; The strings are single-byte strings.
+ (defconst prolog-upper-case-string (prolog-dash-letters up_string)
+ "A string containing a char-range matching all upper case characters.")
+ (defconst prolog-lower-case-string (prolog-dash-letters low_string)
+ "A string containing a char-range matching all lower case characters.")
+ ))
+
+(defconst prolog-atom-char-regexp
+ (if (string-match "[[:alnum:]]" "0")
+ "[[:alnum:]_$]"
+ (format "[%s%s0-9_$]" prolog-lower-case-string prolog-upper-case-string))
+ "Regexp specifying characters which constitute atoms without quoting.")
+(defconst prolog-atom-regexp
+ (format "[%s$]%s*" prolog-lower-case-string prolog-atom-char-regexp))
(defconst prolog-left-paren "[[({]" ;FIXME: Why not \\s(?
"The characters used as left parentheses for the indentation code.")
@@ -843,6 +983,96 @@ Set by prolog-build-case-strings.")
'(("dcg" . "-->") ("rule" . ":-") ("simplification" . "<=>")
("propagation" . "==>")))))
+;; SMIE support
+
+(require 'smie)
+
+(defvar prolog-use-smie t)
+
+(defun prolog-smie-forward-token ()
+ ;; FIXME: Add support for 0'<char>, if needed after adding it to
+ ;; syntax-propertize-functions.
+ (forward-comment (point-max))
+ (buffer-substring-no-properties
+ (point)
+ (progn (cond
+ ((looking-at "[!;]") (forward-char 1))
+ ((not (zerop (skip-chars-forward "#&*+-./:<=>?@\\^`~"))))
+ ((not (zerop (skip-syntax-forward "w_'"))))
+ ;; In case of non-ASCII punctuation.
+ ((not (zerop (skip-syntax-forward ".")))))
+ (point))))
+
+(defun prolog-smie-backward-token ()
+ ;; FIXME: Add support for 0'<char>, if needed after adding it to
+ ;; syntax-propertize-functions.
+ (forward-comment (- (point-max)))
+ (buffer-substring-no-properties
+ (point)
+ (progn (cond
+ ((memq (char-before) '(?! ?\;)) (forward-char -1))
+ ((not (zerop (skip-chars-backward "#&*+-./:<=>?@\\^`~"))))
+ ((not (zerop (skip-syntax-backward "w_'"))))
+ ;; In case of non-ASCII punctuation.
+ ((not (zerop (skip-syntax-backward ".")))))
+ (point))))
+
+(defconst prolog-smie-grammar
+ ;; Rather than construct the operator levels table from the BNF,
+ ;; we directly provide the operator precedences from GNU Prolog's
+ ;; manual (7.14.10 op/3). The only problem is that GNU Prolog's
+ ;; manual uses precedence levels in the opposite sense (higher
+ ;; numbers bind less tightly) than SMIE, so we use negative numbers.
+ '(("." -10000 -10000)
+ (":-" -1200 -1200)
+ ("-->" -1200 -1200)
+ (";" -1100 -1100)
+ ("->" -1050 -1050)
+ ("," -1000 -1000)
+ ("\\+" -900 -900)
+ ("=" -700 -700)
+ ("\\=" -700 -700)
+ ("=.." -700 -700)
+ ("==" -700 -700)
+ ("\\==" -700 -700)
+ ("@<" -700 -700)
+ ("@=<" -700 -700)
+ ("@>" -700 -700)
+ ("@>=" -700 -700)
+ ("is" -700 -700)
+ ("=:=" -700 -700)
+ ("=\\=" -700 -700)
+ ("<" -700 -700)
+ ("=<" -700 -700)
+ (">" -700 -700)
+ (">=" -700 -700)
+ (":" -600 -600)
+ ("+" -500 -500)
+ ("-" -500 -500)
+ ("/\\" -500 -500)
+ ("\\/" -500 -500)
+ ("*" -400 -400)
+ ("/" -400 -400)
+ ("//" -400 -400)
+ ("rem" -400 -400)
+ ("mod" -400 -400)
+ ("<<" -400 -400)
+ (">>" -400 -400)
+ ("**" -200 -200)
+ ("^" -200 -200)
+ ;; Prefix
+ ;; ("+" 200 200)
+ ;; ("-" 200 200)
+ ;; ("\\" 200 200)
+ (:smie-closer-alist (t . "."))
+ )
+ "Precedence levels of infix operators.")
+
+(defun prolog-smie-rules (kind token)
+ (pcase (cons kind token)
+ (`(:elem . basic) prolog-indent-width)
+ (`(:after . ".") '(column . 0)) ;; To work around smie-closer-alist.
+ (`(:after . ,(or `":-" `"->" `"-->")) prolog-indent-width)))
;;-------------------------------------------------------------------
@@ -915,7 +1145,6 @@ VERSION is of the format (Major . Minor)"
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'paragraph-ignore-fill-prefix) t)
(set (make-local-variable 'normal-auto-fill-function) 'prolog-do-auto-fill)
- (set (make-local-variable 'indent-line-function) 'prolog-indent-line)
(set (make-local-variable 'comment-start) "%")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'comment-add) 1)
@@ -924,7 +1153,6 @@ VERSION is of the format (Major . Minor)"
;; inside quoted atoms or strings
(format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)\\(/\\*+ *\\|%%+ *\\)"
prolog-quoted-atom-regexp prolog-string-regexp))
- (set (make-local-variable 'comment-indent-function) 'prolog-comment-indent)
(set (make-local-variable 'parens-require-spaces) nil)
;; Initialize Prolog system specific variables
(dolist (var '(prolog-keywords prolog-types prolog-mode-specificators
@@ -940,6 +1168,13 @@ VERSION is of the format (Major . Minor)"
'(prolog-font-lock-keywords nil nil ((?_ . "w"))))
(set (make-local-variable 'syntax-propertize-function)
prolog-syntax-propertize-function)
+
+ (if prolog-use-smie
+ ;; Setup SMIE.
+ (smie-setup prolog-smie-grammar #'prolog-smie-rules
+ :forward-token #'prolog-smie-forward-token
+ :backward-token #'prolog-smie-backward-token)
+ (set (make-local-variable 'indent-line-function) 'prolog-indent-line))
)
(defun prolog-mode-keybindings-common (map)
@@ -1052,11 +1287,9 @@ if that value is non-nil."
((eq prolog-system 'gnu) "[GNU]")
(t ""))))
(prolog-mode-variables)
- (prolog-build-case-strings)
- (prolog-set-atom-regexps)
(dolist (ar prolog-align-rules) (add-to-list 'align-rules-list ar))
- ;; imenu entry moved to the appropriate hook for consistency
+ ;; `imenu' entry moved to the appropriate hook for consistency.
;; Load SICStus debugger if suitable
(if (and (eq prolog-system 'sicstus)
@@ -1570,7 +1803,8 @@ For use with the `compilation-parse-errors-function' variable."
limit t)
(setq filepath (match-string 2)))
- ;; ###### Does this work with SICStus under Windows (i.e. backslashes and stuff?)
+ ;; ###### Does this work with SICStus under Windows
+ ;; (i.e. backslashes and stuff?)
(if (string-match "\\(.*/\\)\\([^/]*\\)$" filepath)
(progn
(setq dir (match-string 1 filepath))
@@ -1794,7 +2028,8 @@ Argument BOUND is a buffer position limiting searching."
(defface prolog-builtin-face
'((((class color) (background light)) (:foreground "Purple"))
(((class color) (background dark)) (:foreground "Cyan"))
- (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+ (((class grayscale) (background light))
+ :foreground "LightGray" :bold t)
(((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
(t (:bold t)))
"Face name to use for compiler warnings."
@@ -1875,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
@@ -2049,20 +2284,6 @@ rigidly along with this one (not yet)."
(prolog-insert-spaces-after-paren))
))
-(defun prolog-comment-indent ()
- "Compute prolog comment indentation."
- ;; FIXME: Only difference with default behavior is that %%% is not
- ;; flushed to column 0 but just left where the user put it.
- (cond ((looking-at "%%%") (prolog-indentation-level-of-line))
- ((looking-at "%%") (prolog-indent-level))
- (t
- (save-excursion
- (skip-chars-backward " \t")
- ;; Insert one space at least, except at left margin.
- (max (+ (current-column) (if (bolp) 0 1))
- comment-column)))
- ))
-
(defun prolog-indent-level ()
"Compute prolog indentation level."
(save-excursion
@@ -3156,7 +3377,8 @@ When called with prefix argument ARG, disable zipping instead."
(save-excursion
(let ((state (prolog-clause-info))
(object (prolog-in-object)))
- (if (or (equal (nth 0 state) "") (equal (prolog-in-string-or-comment) 'cmt))
+ (if (or (equal (nth 0 state) "")
+ (equal (prolog-in-string-or-comment) 'cmt))
nil
(if (and (eq prolog-system 'sicstus)
object)
@@ -3185,6 +3407,7 @@ STRING should be given if the last search was by `string-match' on STRING."
(defun prolog-pred-start ()
"Return the starting point of the first clause of the current predicate."
+ ;; FIXME: Use SMIE.
(save-excursion
(goto-char (prolog-clause-start))
;; Find first clause, unless it was a directive
@@ -3217,8 +3440,9 @@ STRING should be given if the last search was by `string-match' on STRING."
(defun prolog-pred-end ()
"Return the position at the end of the last clause of the current predicate."
+ ;; FIXME: Use SMIE.
(save-excursion
- (goto-char (prolog-clause-end)) ; if we are before the first predicate
+ (goto-char (prolog-clause-end)) ; If we are before the first predicate.
(goto-char (prolog-clause-start))
(let* ((pinfo (prolog-clause-info))
(predname (nth 0 pinfo))
@@ -3262,7 +3486,7 @@ STRING should be given if the last search was by `string-match' on STRING."
(defun prolog-clause-start (&optional not-allow-methods)
"Return the position at the start of the head of the current clause.
If NOTALLOWMETHODS is non-nil then do not match on methods in
-objects (relevent only if 'prolog-system' is set to 'sicstus)."
+objects (relevant only if 'prolog-system' is set to 'sicstus)."
(save-excursion
(let ((notdone t)
(retval (point-min)))
@@ -3328,7 +3552,7 @@ objects (relevent only if 'prolog-system' is set to 'sicstus)."
(defun prolog-clause-end (&optional not-allow-methods)
"Return the position at the end of the current clause.
If NOTALLOWMETHODS is non-nil then do not match on methods in
-objects (relevent only if 'prolog-system' is set to 'sicstus)."
+objects (relevant only if 'prolog-system' is set to 'sicstus)."
(save-excursion
(beginning-of-line) ; Necessary since we use "^...." for the search.
(if (re-search-forward
@@ -3473,6 +3697,7 @@ If already at the end of clause, move to next clause."
(defun prolog-beginning-of-predicate ()
"Go to the nearest beginning of predicate before current point.
Return the final point or nil if no such a beginning was found."
+ ;; FIXME: Hook into beginning-of-defun.
(interactive)
(let ((op (point))
(pos (prolog-pred-start)))
@@ -3492,6 +3717,7 @@ Return the final point or nil if no such a beginning was found."
(defun prolog-end-of-predicate ()
"Go to the end of the current predicate."
+ ;; FIXME: Hook into end-of-defun.
(interactive)
(let ((op (point)))
(goto-char (prolog-pred-end))
@@ -3577,12 +3803,12 @@ a new comment is created."
(indent-for-comment)))
(defun prolog-indent-predicate ()
- "*Indent the current predicate."
+ "Indent the current predicate."
(interactive)
(indent-region (prolog-pred-start) (prolog-pred-end) nil))
(defun prolog-indent-buffer ()
- "*Indent the entire buffer."
+ "Indent the entire buffer."
(interactive)
(indent-region (point-min) (point-max) nil))
@@ -3613,7 +3839,7 @@ a new comment is created."
"Delete preceding character or whitespace.
If `prolog-hungry-delete-key-flag' is non-nil, then all preceding whitespace is
consumed. If however an ARG is supplied, or `prolog-hungry-delete-key-flag' is
-nil, or point is inside a literal then the function in the variable
+nil, or point is inside a literal then the function
`backward-delete-char' is called."
(interactive "P")
(if (or (not prolog-hungry-delete-key-flag)
@@ -3633,6 +3859,7 @@ nil, or point is inside a literal then the function in the variable
(defun prolog-electric-if-then-else (arg)
"If `prolog-electric-if-then-else-flag' is non-nil, indent if-then-else constructs.
Bound to the >, ; and ( keys."
+ ;; FIXME: Use post-self-insert-hook or electric-indent-mode.
(interactive "P")
(self-insert-command (prefix-numeric-value arg))
(if prolog-electric-if-then-else-flag (prolog-insert-spaces-after-paren)))
@@ -3642,6 +3869,7 @@ Bound to the >, ; and ( keys."
That is, insert space (if appropriate), `:-' and newline if colon is pressed
at the end of a line that starts in the first column (i.e., clause
heads)."
+ ;; FIXME: Use post-self-insert-hook.
(interactive "P")
(if (and prolog-electric-colon-flag
(null arg)
@@ -3652,7 +3880,7 @@ heads)."
(unless (save-excursion (backward-char 1) (looking-at "\\s "))
(insert " "))
(insert ":-\n")
- (prolog-indent-line))
+ (indent-according-to-mode))
(self-insert-command (prefix-numeric-value arg))))
(defun prolog-electric-dash (arg)
@@ -3660,6 +3888,7 @@ heads)."
that is, insert space (if appropriate), `-->' and newline if dash is pressed
at the end of a line that starts in the first column (i.e., DCG
heads)."
+ ;; FIXME: Use post-self-insert-hook.
(interactive "P")
(if (and prolog-electric-dash-flag
(null arg)
@@ -3670,7 +3899,7 @@ heads)."
(unless (save-excursion (backward-char 1) (looking-at "\\s "))
(insert " "))
(insert "-->\n")
- (prolog-indent-line))
+ (indent-according-to-mode))
(self-insert-command (prefix-numeric-value arg))))
(defun prolog-electric-dot (arg)
@@ -3685,6 +3914,7 @@ When invoked at the beginning of line, insert a head of a new clause
of the current predicate.
When called with prefix argument ARG, insert just dot."
+ ;; FIXME: Use post-self-insert-hook.
(interactive "P")
;; Check for situations when the electricity should not be active
(if (or (not prolog-electric-dot-flag)
@@ -3744,6 +3974,7 @@ If `prolog-electric-underscore-flag' is non-nil and the point is
on a variable then replace the variable with underscore and skip
the following comma and whitespace, if any.
If the point is not on a variable then insert underscore."
+ ;; FIXME: Use post-self-insert-hook.
(interactive)
(if prolog-electric-underscore-flag
(let (;start
@@ -3818,144 +4049,36 @@ PREFIX is the prefix of the search regexp."
(backward-char)))
)))
+;;(defun prolog-regexp-dash-continuous-chars (chars)
+;; (let ((ints (mapcar #'prolog-char-to-int (string-to-list chars)))
+;; (beg 0)
+;; (end 0))
+;; (if (null ints)
+;; chars
+;; (while (and (< (+ beg 1) (length chars))
+;; (not (or (= (+ (nth beg ints) 1) (nth (+ beg 1) ints))
+;; (= (nth beg ints) (nth (+ beg 1) ints)))))
+;; (setq beg (+ beg 1)))
+;; (setq beg (+ beg 1)
+;; end beg)
+;; (while (and (< (+ end 1) (length chars))
+;; (or (= (+ (nth end ints) 1) (nth (+ end 1) ints))
+;; (= (nth end ints) (nth (+ end 1) ints))))
+;; (setq end (+ end 1)))
+;; (if (equal (substring chars end) "")
+;; (substring chars 0 beg)
+;; (concat (substring chars 0 beg) "-"
+;; (prolog-regexp-dash-continuous-chars (substring chars end))))
+;; )))
+
+;;(defun prolog-condense-character-sets (regexp)
+;; "Condense adjacent characters in character sets of REGEXP."
+;; (let ((next -1))
+;; (while (setq next (string-match "\\[\\(.*?\\)\\]" regexp (1+ next)))
+;; (setq regexp (replace-match (prolog-dash-letters (match-string 1 regexp))
+;; t t regexp 1))))
+;; regexp)
-(defun prolog-set-atom-regexps ()
- "Set the `prolog-atom-char-regexp' and `prolog-atom-regexp' variables.
-Must be called after `prolog-build-case-strings'."
- (setq prolog-atom-char-regexp
- (format "[%s%s0-9_$]"
- ;; FIXME: why not a-zA-Z?
- prolog-lower-case-string
- prolog-upper-case-string))
- (setq prolog-atom-regexp
- (format "[%s$]%s*"
- prolog-lower-case-string
- prolog-atom-char-regexp))
- )
-
-(defun prolog-build-case-strings ()
- "Set `prolog-upper-case-string' and `prolog-lower-case-string'.
-Uses the current case-table for extracting the relevant information."
- (let ((up_string "")
- (low_string ""))
- ;; Use `map-char-table' if it is defined. Otherwise enumerate all
- ;; numbers between 0 and 255. `map-char-table' is probably safer.
- ;;
- ;; `map-char-table' causes problems under Emacs 23.0.0.1, the
- ;; while loop seems to do its job well (Ryszard Szopa)
- ;;
- ;;(if (and (not (featurep 'xemacs))
- ;; (fboundp 'map-char-table))
- ;; (map-char-table
- ;; (lambda (key value)
- ;; (cond
- ;; ((and
- ;; (eq (prolog-int-to-char key) (downcase key))
- ;; (eq (prolog-int-to-char key) (upcase key)))
- ;; ;; Do nothing if upper and lower case are the same
- ;; )
- ;; ((eq (prolog-int-to-char key) (downcase key))
- ;; ;; The char is lower case
- ;; (setq low_string (format "%s%c" low_string key)))
- ;; ((eq (prolog-int-to-char key) (upcase key))
- ;; ;; The char is upper case
- ;; (setq up_string (format "%s%c" up_string key)))
- ;; ))
- ;; (current-case-table))
- ;; `map-char-table' was undefined.
- (let ((key 0))
- (while (< key 256)
- (cond
- ((and
- (eq (prolog-int-to-char key) (downcase key))
- (eq (prolog-int-to-char key) (upcase key)))
- ;; Do nothing if upper and lower case are the same
- )
- ((eq (prolog-int-to-char key) (downcase key))
- ;; The char is lower case
- (setq low_string (format "%s%c" low_string key)))
- ((eq (prolog-int-to-char key) (upcase key))
- ;; The char is upper case
- (setq up_string (format "%s%c" up_string key)))
- )
- (setq key (1+ key))))
- ;; )
- ;; The strings are single-byte strings
- (setq prolog-upper-case-string (prolog-dash-letters up_string))
- (setq prolog-lower-case-string (prolog-dash-letters low_string))
- ))
-
-;(defun prolog-regexp-dash-continuous-chars (chars)
-; (let ((ints (mapcar #'prolog-char-to-int (string-to-list chars)))
-; (beg 0)
-; (end 0))
-; (if (null ints)
-; chars
-; (while (and (< (+ beg 1) (length chars))
-; (not (or (= (+ (nth beg ints) 1) (nth (+ beg 1) ints))
-; (= (nth beg ints) (nth (+ beg 1) ints)))))
-; (setq beg (+ beg 1)))
-; (setq beg (+ beg 1)
-; end beg)
-; (while (and (< (+ end 1) (length chars))
-; (or (= (+ (nth end ints) 1) (nth (+ end 1) ints))
-; (= (nth end ints) (nth (+ end 1) ints))))
-; (setq end (+ end 1)))
-; (if (equal (substring chars end) "")
-; (substring chars 0 beg)
-; (concat (substring chars 0 beg) "-"
-; (prolog-regexp-dash-continuous-chars (substring chars end))))
-; )))
-
-(defun prolog-ints-intervals (ints)
- "Return a list of intervals (from . to) covering INTS."
- (when ints
- (setq ints (sort ints '<))
- (let ((prev (car ints))
- (interval-start (car ints))
- intervals)
- (while ints
- (let ((next (car ints)))
- (when (> next (1+ prev)) ; start of new interval
- (setq intervals (cons (cons interval-start prev) intervals))
- (setq interval-start next))
- (setq prev next)
- (setq ints (cdr ints))))
- (setq intervals (cons (cons interval-start prev) intervals))
- (reverse intervals))))
-
-(defun prolog-dash-letters (string)
- "Return a condensed regexp covering all letters in STRING."
- (let ((intervals (prolog-ints-intervals (mapcar #'prolog-char-to-int
- (string-to-list string))))
- codes)
- (while intervals
- (let* ((i (car intervals))
- (from (car i))
- (to (cdr i))
- (c (cond ((= from to) `(,from))
- ((= (1+ from) to) `(,from ,to))
- (t `(,from ?- ,to)))))
- (setq codes (cons c codes)))
- (setq intervals (cdr intervals)))
- (apply 'concat (reverse codes))))
-
-;(defun prolog-condense-character-sets (regexp)
-; "Condense adjacent characters in character sets of REGEXP."
-; (let ((next -1))
-; (while (setq next (string-match "\\[\\(.*?\\)\\]" regexp (1+ next)))
-; (setq regexp (replace-match (prolog-dash-letters (match-string 1 regexp))
-; t t regexp 1))))
-; regexp)
-
-;; GNU Emacs compatibility: GNU Emacs does not differentiate between
-;; ints and chars, or at least these two are interchangeable.
-(defalias 'prolog-int-to-char
- (if (fboundp 'int-to-char) #'int-to-char #'identity))
-
-(defalias 'prolog-char-to-int
- (if (fboundp 'char-to-int) #'char-to-int #'identity))
-
;;-------------------------------------------------------------------
;; Menu stuff (both for the editing buffer and for the inferior
;; prolog buffer)
@@ -4066,7 +4189,7 @@ Uses the current case-table for extracting the relevant information."
["Beginning of predicate" prolog-beginning-of-predicate t]
["End of predicate" prolog-end-of-predicate t]
"---"
- ["Indent line" prolog-indent-line t]
+ ["Indent line" indent-according-to-mode t]
["Indent region" indent-region (region-exists-p)]
["Indent predicate" prolog-indent-predicate t]
["Indent buffer" prolog-indent-buffer t]
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index c2adc3b801b..a8fc11f71c0 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -1,6 +1,6 @@
;;; ps-mode.el --- PostScript mode for GNU Emacs
-;; Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Peter Kleiweg <p.c.j.kleiweg@rug.nl>
;; Maintainer: Peter Kleiweg <p.c.j.kleiweg@rug.nl>
@@ -60,17 +60,17 @@
;; User variables.
(defcustom ps-mode-auto-indent t
- "*Should we use autoindent?"
+ "Should we use autoindent?"
:group 'PostScript-edit
:type 'boolean)
(defcustom ps-mode-tab 4
- "*Number of spaces to use when indenting."
+ "Number of spaces to use when indenting."
:group 'PostScript-edit
:type 'integer)
(defcustom ps-mode-paper-size '(595 842)
- "*Default paper size.
+ "Default paper size.
When inserting an EPSF template these values are used
to set the boundingbox to include the whole page.
@@ -117,12 +117,12 @@ When the figure is finished these values should be replaced."
(lpr-command (if (memq system-type '(usg-unix-v hpux irix))
"lp" "lpr")))
(lpr-buffer)))
- "*Lisp function to print current buffer as PostScript."
+ "Lisp function to print current buffer as PostScript."
:group 'PostScript-edit
:type 'function)
(defcustom ps-run-prompt "\\(GS\\(<[0-9]+\\)?>\\)+"
- "*Regexp to match prompt in interactive PostScript."
+ "Regexp to match prompt in interactive PostScript."
:group 'PostScript-interaction
:type 'regexp)
@@ -139,7 +139,7 @@ When the figure is finished these values should be replaced."
("^\\(Current file position is\\) \\([0-9]+\\)"
(1 font-lock-comment-face nil nil)
(2 font-lock-warning-face nil nil))))
- "*Medium level highlighting of messages from the PostScript interpreter.
+ "Medium level highlighting of messages from the PostScript interpreter.
See documentation on font-lock for details."
:group 'PostScript-interaction
@@ -155,17 +155,17 @@ See documentation on font-lock for details."
(boolean :tag "Laxmatch" :value t))))))
(defcustom ps-run-x '("gs" "-r72" "-sPAPERSIZE=a4")
- "*Command as list to run PostScript with graphic display."
+ "Command as list to run PostScript with graphic display."
:group 'PostScript-interaction
:type '(repeat string))
(defcustom ps-run-dumb '("gs" "-dNODISPLAY")
- "*Command as list to run PostScript without graphic display."
+ "Command as list to run PostScript without graphic display."
:group 'PostScript-interaction
:type '(repeat string))
(defcustom ps-run-init nil
- "*String of commands to send to PostScript to start interactive.
+ "String of commands to send to PostScript to start interactive.
Example: \"executive\"
@@ -174,13 +174,13 @@ You won't need to set this option for Ghostscript."
:type '(choice (const nil) string))
(defcustom ps-run-error-line-numbers nil
- "*What values are used by the PostScript interpreter in error messages?"
+ "What values are used by the PostScript interpreter in error messages?"
:group 'PostScript-interaction
:type '(choice (const :tag "line numbers" t)
(const :tag "byte counts" nil)))
(defcustom ps-run-tmp-dir nil
- "*Name of directory to place temporary file.
+ "Name of directory to place temporary file.
If nil, use `temporary-file-directory'."
:group 'PostScript-interaction
:type '(choice (const nil) directory))
@@ -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 6081d8e838b..550c5f5a129 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -1,342 +1,578 @@
-;;; python.el --- silly walks for Python -*- coding: iso-8859-1 -*-
+;;; python.el --- Python's flying circus support for Emacs
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
-;; Author: Dave Love <fx@gnu.org>
+;; Author: Fabián E. Gallina <fabian@anue.biz>
+;; URL: https://github.com/fgallina/python.el
+;; Version: 0.24.2
;; Maintainer: FSF
-;; Created: Nov 2003
+;; Created: Jul 2010
;; Keywords: languages
;; 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.
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
-;; Major mode for editing Python, with support for inferior processes.
-
-;; There is another Python mode, python-mode.el:
-;; http://launchpad.net/python-mode
-;; used by XEmacs, and originally maintained with Python.
-;; That isn't covered by an FSF copyright assignment (?), unlike this
-;; code, and seems not to be well-maintained for Emacs (though I've
-;; submitted fixes). This mode is rather simpler and is better in
-;; other ways. In particular, using the syntax functions with text
-;; properties maintained by font-lock makes it more correct with
-;; arbitrary string and comment contents.
-
-;; This doesn't implement all the facilities of python-mode.el. Some
-;; just need doing, e.g. catching exceptions in the inferior Python
-;; buffer (but see M-x pdb for debugging). [Actually, the use of
-;; `compilation-shell-minor-mode' now is probably enough for that.]
-;; Others don't seem appropriate. For instance,
-;; `forward-into-nomenclature' should be done separately, since it's
-;; not specific to Python, and I've installed a minor mode to do the
-;; job properly in Emacs 23. [CC mode 5.31 contains an incompatible
-;; feature, `subword-mode' which is intended to have a similar
-;; effect, but actually only affects word-oriented keybindings.]
-
-;; Other things seem more natural or canonical here, e.g. the
-;; {beginning,end}-of-defun implementation dealing with nested
-;; definitions, and the inferior mode following `cmuscheme'. (The
-;; inferior mode can find the source of errors from
-;; `python-send-region' & al via `compilation-shell-minor-mode'.)
-;; There is (limited) symbol completion using lookup in Python and
-;; Eldoc support also using the inferior process. Successive TABs
-;; cycle between possible indentations for the line.
-
-;; Even where it has similar facilities, this mode is incompatible
-;; with python-mode.el in some respects. For instance, various key
-;; bindings are changed to obey Emacs conventions.
-
-;; TODO: See various Fixmes below.
-
-;; Fixme: This doesn't support (the nascent) Python 3 .
+;; Major mode for editing Python files with some fontification and
+;; indentation bits extracted from original Dave Love's python.el
+;; found in GNU/Emacs.
+
+;; Implements Syntax highlighting, Indentation, Movement, Shell
+;; interaction, Shell completion, Shell virtualenv support, Pdb
+;; tracking, Symbol completion, Skeletons, FFAP, Code Check, Eldoc,
+;; imenu.
+
+;; Syntax highlighting: Fontification of code is provided and supports
+;; python's triple quoted strings properly.
+
+;; Indentation: Automatic indentation with indentation cycling is
+;; provided, it allows you to navigate different available levels of
+;; indentation by hitting <tab> several times. Also when inserting a
+;; colon the `python-indent-electric-colon' command is invoked and
+;; causes the current line to be dedented automatically if needed.
+
+;; Movement: `beginning-of-defun' and `end-of-defun' functions are
+;; properly implemented. There are also specialized
+;; `forward-sentence' and `backward-sentence' replacements called
+;; `python-nav-forward-block', `python-nav-backward-block'
+;; respectively which navigate between beginning of blocks of code.
+;; Extra functions `python-nav-forward-statement',
+;; `python-nav-backward-statement',
+;; `python-nav-beginning-of-statement', `python-nav-end-of-statement',
+;; `python-nav-beginning-of-block' and `python-nav-end-of-block' are
+;; included but no bound to any key. At last but not least the
+;; specialized `python-nav-forward-sexp' allows easy
+;; navigation between code blocks.
+
+;; Shell interaction: is provided and allows you to execute easily any
+;; block of code of your current buffer in an inferior Python process.
+
+;; Shell completion: hitting tab will try to complete the current
+;; word. Shell completion is implemented in a manner that if you
+;; change the `python-shell-interpreter' to any other (for example
+;; IPython) it should be easy to integrate another way to calculate
+;; completions. You just need to specify your custom
+;; `python-shell-completion-setup-code' and
+;; `python-shell-completion-string-code'.
+
+;; Here is a complete example of the settings you would use for
+;; iPython 0.11:
+
+;; (setq
+;; python-shell-interpreter "ipython"
+;; python-shell-interpreter-args ""
+;; python-shell-prompt-regexp "In \\[[0-9]+\\]: "
+;; python-shell-prompt-output-regexp "Out\\[[0-9]+\\]: "
+;; python-shell-completion-setup-code
+;; "from IPython.core.completerlib import module_completion"
+;; python-shell-completion-module-string-code
+;; "';'.join(module_completion('''%s'''))\n"
+;; python-shell-completion-string-code
+;; "';'.join(get_ipython().Completer.all_completions('''%s'''))\n")
+
+;; For iPython 0.10 everything would be the same except for
+;; `python-shell-completion-string-code' and
+;; `python-shell-completion-module-string-code':
+
+;; (setq python-shell-completion-string-code
+;; "';'.join(__IP.complete('''%s'''))\n"
+;; python-shell-completion-module-string-code "")
+
+;; Unfortunately running iPython on Windows needs some more tweaking.
+;; The way you must set `python-shell-interpreter' and
+;; `python-shell-interpreter-args' is as follows:
+
+;; (setq
+;; python-shell-interpreter "C:\\Python27\\python.exe"
+;; python-shell-interpreter-args
+;; "-i C:\\Python27\\Scripts\\ipython-script.py")
+
+;; That will spawn the iPython process correctly (Of course you need
+;; to modify the paths according to your system).
+
+;; Please note that the default completion system depends on the
+;; readline module, so if you are using some Operating System that
+;; bundles Python without it (like Windows) just install the
+;; pyreadline from http://ipython.scipy.org/moin/PyReadline/Intro and
+;; you should be good to go.
+
+;; Shell virtualenv support: The shell also contains support for
+;; virtualenvs and other special environment modifications thanks to
+;; `python-shell-process-environment' and `python-shell-exec-path'.
+;; These two variables allows you to modify execution paths and
+;; environment variables to make easy for you to setup virtualenv rules
+;; or behavior modifications when running shells. Here is an example
+;; of how to make shell processes to be run using the /path/to/env/
+;; virtualenv:
+
+;; (setq python-shell-process-environment
+;; (list
+;; (format "PATH=%s" (mapconcat
+;; 'identity
+;; (reverse
+;; (cons (getenv "PATH")
+;; '("/path/to/env/bin/")))
+;; ":"))
+;; "VIRTUAL_ENV=/path/to/env/"))
+;; (python-shell-exec-path . ("/path/to/env/bin/"))
+
+;; Since the above is cumbersome and can be programmatically
+;; calculated, the variable `python-shell-virtualenv-path' is
+;; provided. When this variable is set with the path of the
+;; virtualenv to use, `process-environment' and `exec-path' get proper
+;; values in order to run shells inside the specified virtualenv. So
+;; the following will achieve the same as the previous example:
+
+;; (setq python-shell-virtualenv-path "/path/to/env/")
+
+;; Also the `python-shell-extra-pythonpaths' variable have been
+;; introduced as simple way of adding paths to the PYTHONPATH without
+;; affecting existing values.
+
+;; Pdb tracking: when you execute a block of code that contains some
+;; call to pdb (or ipdb) it will prompt the block of code and will
+;; follow the execution of pdb marking the current line with an arrow.
+
+;; Symbol completion: you can complete the symbol at point. It uses
+;; the shell completion in background so you should run
+;; `python-shell-send-buffer' from time to time to get better results.
+
+;; Skeletons: 6 skeletons are provided for simple inserting of class,
+;; def, for, if, try and while. These skeletons are integrated with
+;; dabbrev. If you have `dabbrev-mode' activated and
+;; `python-skeleton-autoinsert' is set to t, then whenever you type
+;; the name of any of those defined and hit SPC, they will be
+;; automatically expanded.
+
+;; FFAP: You can find the filename for a given module when using ffap
+;; out of the box. This feature needs an inferior python shell
+;; running.
+
+;; Code check: Check the current file for errors with `python-check'
+;; using the program defined in `python-check-command'.
+
+;; Eldoc: returns documentation for object at point by using the
+;; inferior python subprocess to inspect its documentation. As you
+;; might guessed you should run `python-shell-send-buffer' from time
+;; to time to get better results too.
+
+;; imenu: This mode supports imenu in its most basic form, letting it
+;; build the necessary alist via `imenu-default-create-index-function'
+;; by having set `imenu-extract-index-name-function' to
+;; `python-info-current-defun'.
+
+;; If you used python-mode.el you probably will miss auto-indentation
+;; when inserting newlines. To achieve the same behavior you have
+;; two options:
+
+;; 1) Use GNU/Emacs' standard binding for `newline-and-indent': C-j.
+
+;; 2) Add the following hook in your .emacs:
+
+;; (add-hook 'python-mode-hook
+;; #'(lambda ()
+;; (define-key python-mode-map "\C-m" 'newline-and-indent)))
+
+;; I'd recommend the first one since you'll get the same behavior for
+;; all modes out-of-the-box.
+
+;;; Installation:
+
+;; Add this to your .emacs:
+
+;; (add-to-list 'load-path "/folder/containing/file")
+;; (require 'python)
+
+;;; TODO:
;;; Code:
+(require 'ansi-color)
(require 'comint)
+(eval-when-compile (require 'cl-lib))
-(eval-when-compile
- (require 'compile)
- (require 'hippie-exp))
+;; Avoid compiler warnings
+(defvar view-return-to-alist)
+(defvar compilation-error-regexp-alist)
+(defvar outline-heading-end-regexp)
(autoload 'comint-mode "comint")
+;;;###autoload
+(add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode))
+;;;###autoload
+(add-to-list 'interpreter-mode-alist (cons (purecopy "python") 'python-mode))
+
(defgroup python nil
- "Silly walks in the Python language."
+ "Python Language's flying circus support for Emacs."
:group 'languages
- :version "22.1"
+ :version "23.2"
:link '(emacs-commentary-link "python"))
+
-;;;###autoload
-(add-to-list 'interpreter-mode-alist (cons (purecopy "jython") 'jython-mode))
-;;;###autoload
-(add-to-list 'interpreter-mode-alist (cons (purecopy "python") 'python-mode))
-;;;###autoload
-(add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode))
+;;; Bindings
+
+(defvar python-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; Movement
+ (define-key map [remap backward-sentence] 'python-nav-backward-block)
+ (define-key map [remap forward-sentence] 'python-nav-forward-block)
+ (define-key map [remap backward-up-list] 'python-nav-backward-up-list)
+ (define-key map "\C-c\C-j" 'imenu)
+ ;; Indent specific
+ (define-key map "\177" 'python-indent-dedent-line-backspace)
+ (define-key map (kbd "<backtab>") 'python-indent-dedent-line)
+ (define-key map "\C-c<" 'python-indent-shift-left)
+ (define-key map "\C-c>" 'python-indent-shift-right)
+ (define-key map ":" 'python-indent-electric-colon)
+ ;; Skeletons
+ (define-key map "\C-c\C-tc" 'python-skeleton-class)
+ (define-key map "\C-c\C-td" 'python-skeleton-def)
+ (define-key map "\C-c\C-tf" 'python-skeleton-for)
+ (define-key map "\C-c\C-ti" 'python-skeleton-if)
+ (define-key map "\C-c\C-tt" 'python-skeleton-try)
+ (define-key map "\C-c\C-tw" 'python-skeleton-while)
+ ;; Shell interaction
+ (define-key map "\C-c\C-p" 'run-python)
+ (define-key map "\C-c\C-s" 'python-shell-send-string)
+ (define-key map "\C-c\C-r" 'python-shell-send-region)
+ (define-key map "\C-\M-x" 'python-shell-send-defun)
+ (define-key map "\C-c\C-c" 'python-shell-send-buffer)
+ (define-key map "\C-c\C-l" 'python-shell-send-file)
+ (define-key map "\C-c\C-z" 'python-shell-switch-to-shell)
+ ;; Some util commands
+ (define-key map "\C-c\C-v" 'python-check)
+ (define-key map "\C-c\C-f" 'python-eldoc-at-point)
+ ;; Utilities
+ (substitute-key-definition 'complete-symbol 'completion-at-point
+ map global-map)
+ (easy-menu-define python-menu map "Python Mode menu"
+ `("Python"
+ :help "Python-specific Features"
+ ["Shift region left" python-indent-shift-left :active mark-active
+ :help "Shift region left by a single indentation step"]
+ ["Shift region right" python-indent-shift-right :active mark-active
+ :help "Shift region right by a single indentation step"]
+ "-"
+ ["Start of def/class" beginning-of-defun
+ :help "Go to start of outermost definition around point"]
+ ["End of def/class" end-of-defun
+ :help "Go to end of definition around point"]
+ ["Mark def/class" mark-defun
+ :help "Mark outermost definition around point"]
+ ["Jump to def/class" imenu
+ :help "Jump to a class or function definition"]
+ "--"
+ ("Skeletons")
+ "---"
+ ["Start interpreter" run-python
+ :help "Run inferior Python process in a separate buffer"]
+ ["Switch to shell" python-shell-switch-to-shell
+ :help "Switch to running inferior Python process"]
+ ["Eval string" python-shell-send-string
+ :help "Eval string in inferior Python session"]
+ ["Eval buffer" python-shell-send-buffer
+ :help "Eval buffer in inferior Python session"]
+ ["Eval region" python-shell-send-region
+ :help "Eval region in inferior Python session"]
+ ["Eval defun" python-shell-send-defun
+ :help "Eval defun in inferior Python session"]
+ ["Eval file" python-shell-send-file
+ :help "Eval file in inferior Python session"]
+ ["Debugger" pdb :help "Run pdb under GUD"]
+ "----"
+ ["Check file" python-check
+ :help "Check file for errors"]
+ ["Help on symbol" python-eldoc-at-point
+ :help "Get help on symbol at point"]
+ ["Complete symbol" completion-at-point
+ :help "Complete symbol before point"]))
+ map)
+ "Keymap for `python-mode'.")
+
+
+;;; Python specialized rx
+
+(eval-when-compile
+ (defconst python-rx-constituents
+ `((block-start . ,(rx symbol-start
+ (or "def" "class" "if" "elif" "else" "try"
+ "except" "finally" "for" "while" "with")
+ symbol-end))
+ (decorator . ,(rx line-start (* space) ?@ (any letter ?_)
+ (* (any word ?_))))
+ (defun . ,(rx symbol-start (or "def" "class") symbol-end))
+ (if-name-main . ,(rx line-start "if" (+ space) "__name__"
+ (+ space) "==" (+ space)
+ (any ?' ?\") "__main__" (any ?' ?\")
+ (* space) ?:))
+ (symbol-name . ,(rx (any letter ?_) (* (any word ?_))))
+ (open-paren . ,(rx (or "{" "[" "(")))
+ (close-paren . ,(rx (or "}" "]" ")")))
+ (simple-operator . ,(rx (any ?+ ?- ?/ ?& ?^ ?~ ?| ?* ?< ?> ?= ?%)))
+ ;; FIXME: rx should support (not simple-operator).
+ (not-simple-operator . ,(rx
+ (not
+ (any ?+ ?- ?/ ?& ?^ ?~ ?| ?* ?< ?> ?= ?%))))
+ ;; FIXME: Use regexp-opt.
+ (operator . ,(rx (or "+" "-" "/" "&" "^" "~" "|" "*" "<" ">"
+ "=" "%" "**" "//" "<<" ">>" "<=" "!="
+ "==" ">=" "is" "not")))
+ ;; FIXME: Use regexp-opt.
+ (assignment-operator . ,(rx (or "=" "+=" "-=" "*=" "/=" "//=" "%=" "**="
+ ">>=" "<<=" "&=" "^=" "|=")))
+ (string-delimiter . ,(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 "\"" "\"\"\"" "'" "'''"))))))
+ "Additional Python specific sexps for `python-rx'")
+
+ (defmacro python-rx (&rest regexps)
+ "Python mode specialized rx macro.
+This variant of `rx' supports common python named REGEXPS."
+ (let ((rx-constituents (append python-rx-constituents rx-constituents)))
+ (cond ((null regexps)
+ (error "No regexp"))
+ ((cdr regexps)
+ (rx-to-string `(and ,@regexps) t))
+ (t
+ (rx-to-string (car regexps) t))))))
+
-;;;; Font lock
+;;; Font-lock and syntax
+
+(defun python-syntax-context (type &optional syntax-ppss)
+ "Return non-nil if point is on TYPE using SYNTAX-PPSS.
+TYPE can be `comment', `string' or `paren'. It returns the start
+character address of the specified TYPE."
+ (declare (compiler-macro
+ (lambda (form)
+ (pcase type
+ (`'comment
+ `(let ((ppss (or ,syntax-ppss (syntax-ppss))))
+ (and (nth 4 ppss) (nth 8 ppss))))
+ (`'string
+ `(let ((ppss (or ,syntax-ppss (syntax-ppss))))
+ (and (nth 3 ppss) (nth 8 ppss))))
+ (`'paren
+ `(nth 1 (or ,syntax-ppss (syntax-ppss))))
+ (_ form)))))
+ (let ((ppss (or syntax-ppss (syntax-ppss))))
+ (pcase type
+ (`comment (and (nth 4 ppss) (nth 8 ppss)))
+ (`string (and (nth 3 ppss) (nth 8 ppss)))
+ (`paren (nth 1 ppss))
+ (_ nil))))
+
+(defun python-syntax-context-type (&optional syntax-ppss)
+ "Return the context type using SYNTAX-PPSS.
+The type returned can be `comment', `string' or `paren'."
+ (let ((ppss (or syntax-ppss (syntax-ppss))))
+ (cond
+ ((nth 8 ppss) (if (nth 4 ppss) 'comment 'string))
+ ((nth 1 ppss) 'paren))))
+
+(defsubst python-syntax-comment-or-string-p ()
+ "Return non-nil if point is inside 'comment or 'string."
+ (nth 8 (syntax-ppss)))
+
+(define-obsolete-function-alias
+ 'python-info-ppss-context #'python-syntax-context "24.3")
+
+(define-obsolete-function-alias
+ 'python-info-ppss-context-type #'python-syntax-context-type "24.3")
+
+(define-obsolete-function-alias
+ 'python-info-ppss-comment-or-string-p
+ #'python-syntax-comment-or-string-p "24.3")
(defvar python-font-lock-keywords
+ ;; Keywords
`(,(rx symbol-start
- ;; From v 2.7 reference, keywords.
- ;; def and class dealt with separately below
- (or "and" "as" "assert" "break" "continue" "del" "elif" "else"
- "except" "exec" "finally" "for" "from" "global" "if"
- "import" "in" "is" "lambda" "not" "or" "pass" "print"
- "raise" "return" "try" "while" "with" "yield"
- ;; Not real keywords, but close enough to be fontified as such
- "self" "True" "False"
- ;; Python 3
- "nonlocal")
- symbol-end)
- (,(rx symbol-start "None" symbol-end) ; see Keywords in 2.7 manual
- . font-lock-constant-face)
- ;; Definitions
- (,(rx symbol-start (group "class") (1+ space) (group (1+ (or word ?_))))
- (1 font-lock-keyword-face) (2 font-lock-type-face))
- (,(rx symbol-start (group "def") (1+ space) (group (1+ (or word ?_))))
- (1 font-lock-keyword-face) (2 font-lock-function-name-face))
- ;; Top-level assignments are worth highlighting.
- (,(rx line-start (group (1+ (or word ?_))) (0+ space)
- (opt (or "+" "-" "*" "**" "/" "//" "&" "%" "|" "^" "<<" ">>")) "=")
- (1 font-lock-variable-name-face))
+ (or
+ "and" "del" "from" "not" "while" "as" "elif" "global" "or" "with"
+ "assert" "else" "if" "pass" "yield" "break" "except" "import" "class"
+ "in" "raise" "continue" "finally" "is" "return" "def" "for" "lambda"
+ "try"
+ ;; Python 2:
+ "print" "exec"
+ ;; Python 3:
+ ;; False, None, and True are listed as keywords on the Python 3
+ ;; documentation, but since they also qualify as constants they are
+ ;; fontified like that in order to keep font-lock consistent between
+ ;; Python versions.
+ "nonlocal"
+ ;; Extra:
+ "self")
+ symbol-end)
+ ;; functions
+ (,(rx symbol-start "def" (1+ space) (group (1+ (or word ?_))))
+ (1 font-lock-function-name-face))
+ ;; classes
+ (,(rx symbol-start "class" (1+ space) (group (1+ (or word ?_))))
+ (1 font-lock-type-face))
+ ;; Constants
+ (,(rx symbol-start
+ (or
+ "Ellipsis" "False" "None" "NotImplemented" "True" "__debug__"
+ ;; copyright, license, credits, quit and exit are added by the site
+ ;; module and they are not intended to be used in programs
+ "copyright" "credits" "exit" "license" "quit")
+ symbol-end) . font-lock-constant-face)
;; Decorators.
(,(rx line-start (* (any " \t")) (group "@" (1+ (or word ?_))
- (0+ "." (1+ (or word ?_)))))
+ (0+ "." (1+ (or word ?_)))))
(1 font-lock-type-face))
- ;; Built-ins. (The next three blocks are from
- ;; `__builtin__.__dict__.keys()' in Python 2.7) These patterns
- ;; are debatable, but they at least help to spot possible
- ;; shadowing of builtins.
- (,(rx symbol-start (or
- ;; exceptions
- "ArithmeticError" "AssertionError" "AttributeError"
- "BaseException" "DeprecationWarning" "EOFError"
- "EnvironmentError" "Exception" "FloatingPointError"
- "FutureWarning" "GeneratorExit" "IOError" "ImportError"
- "ImportWarning" "IndentationError" "IndexError" "KeyError"
- "KeyboardInterrupt" "LookupError" "MemoryError" "NameError"
- "NotImplemented" "NotImplementedError" "OSError"
- "OverflowError" "PendingDeprecationWarning" "ReferenceError"
- "RuntimeError" "RuntimeWarning" "StandardError"
- "StopIteration" "SyntaxError" "SyntaxWarning" "SystemError"
- "SystemExit" "TabError" "TypeError" "UnboundLocalError"
- "UnicodeDecodeError" "UnicodeEncodeError" "UnicodeError"
- "UnicodeTranslateError" "UnicodeWarning" "UserWarning"
- "ValueError" "Warning" "ZeroDivisionError"
- ;; Python 2.7
- "BufferError" "BytesWarning" "WindowsError") symbol-end)
- . font-lock-type-face)
- (,(rx (or line-start (not (any ". \t"))) (* (any " \t")) symbol-start
- (group (or
- ;; callable built-ins, fontified when not appearing as
- ;; object attributes
- "abs" "all" "any" "apply" "basestring" "bool" "buffer" "callable"
- "chr" "classmethod" "cmp" "coerce" "compile" "complex"
- "copyright" "credits" "delattr" "dict" "dir" "divmod"
- "enumerate" "eval" "execfile" "exit" "file" "filter" "float"
- "frozenset" "getattr" "globals" "hasattr" "hash" "help"
- "hex" "id" "input" "int" "intern" "isinstance" "issubclass"
- "iter" "len" "license" "list" "locals" "long" "map" "max"
- "min" "object" "oct" "open" "ord" "pow" "property" "quit"
- "range" "raw_input" "reduce" "reload" "repr" "reversed"
- "round" "set" "setattr" "slice" "sorted" "staticmethod"
- "str" "sum" "super" "tuple" "type" "unichr" "unicode" "vars"
- "xrange" "zip"
- ;; Python 2.7.
- "bin" "bytearray" "bytes" "format" "memoryview" "next" "print"
- )) symbol-end)
- (1 font-lock-builtin-face))
- (,(rx symbol-start (or
- ;; other built-ins
- "True" "False" "None" "Ellipsis"
- "_" "__debug__" "__doc__" "__import__" "__name__" "__package__")
- symbol-end)
- . font-lock-builtin-face)))
+ ;; Builtin Exceptions
+ (,(rx symbol-start
+ (or
+ "ArithmeticError" "AssertionError" "AttributeError" "BaseException"
+ "DeprecationWarning" "EOFError" "EnvironmentError" "Exception"
+ "FloatingPointError" "FutureWarning" "GeneratorExit" "IOError"
+ "ImportError" "ImportWarning" "IndexError" "KeyError"
+ "KeyboardInterrupt" "LookupError" "MemoryError" "NameError"
+ "NotImplementedError" "OSError" "OverflowError"
+ "PendingDeprecationWarning" "ReferenceError" "RuntimeError"
+ "RuntimeWarning" "StopIteration" "SyntaxError" "SyntaxWarning"
+ "SystemError" "SystemExit" "TypeError" "UnboundLocalError"
+ "UnicodeDecodeError" "UnicodeEncodeError" "UnicodeError"
+ "UnicodeTranslateError" "UnicodeWarning" "UserWarning" "VMSError"
+ "ValueError" "Warning" "WindowsError" "ZeroDivisionError"
+ ;; Python 2:
+ "StandardError"
+ ;; Python 3:
+ "BufferError" "BytesWarning" "IndentationError" "ResourceWarning"
+ "TabError")
+ symbol-end) . font-lock-type-face)
+ ;; Builtins
+ (,(rx symbol-start
+ (or
+ "abs" "all" "any" "bin" "bool" "callable" "chr" "classmethod"
+ "compile" "complex" "delattr" "dict" "dir" "divmod" "enumerate"
+ "eval" "filter" "float" "format" "frozenset" "getattr" "globals"
+ "hasattr" "hash" "help" "hex" "id" "input" "int" "isinstance"
+ "issubclass" "iter" "len" "list" "locals" "map" "max" "memoryview"
+ "min" "next" "object" "oct" "open" "ord" "pow" "print" "property"
+ "range" "repr" "reversed" "round" "set" "setattr" "slice" "sorted"
+ "staticmethod" "str" "sum" "super" "tuple" "type" "vars" "zip"
+ "__import__"
+ ;; Python 2:
+ "basestring" "cmp" "execfile" "file" "long" "raw_input" "reduce"
+ "reload" "unichr" "unicode" "xrange" "apply" "buffer" "coerce"
+ "intern"
+ ;; Python 3:
+ "ascii" "bytearray" "bytes" "exec"
+ ;; Extra:
+ "__all__" "__doc__" "__name__" "__package__")
+ symbol-end) . font-lock-builtin-face)
+ ;; assignments
+ ;; support for a = b = c = 5
+ (,(lambda (limit)
+ (let ((re (python-rx (group (+ (any word ?. ?_)))
+ (? ?\[ (+ (not (any ?\]))) ?\]) (* space)
+ assignment-operator)))
+ (when (re-search-forward re limit t)
+ (while (and (python-syntax-context 'paren)
+ (re-search-forward re limit t)))
+ (if (not (or (python-syntax-context 'paren)
+ (equal (char-after (point-marker)) ?=)))
+ t
+ (set-match-data nil)))))
+ (1 font-lock-variable-name-face nil nil))
+ ;; support for a, b, c = (1, 2, 3)
+ (,(lambda (limit)
+ (let ((re (python-rx (group (+ (any word ?. ?_))) (* space)
+ (* ?, (* space) (+ (any word ?. ?_)) (* space))
+ ?, (* space) (+ (any word ?. ?_)) (* space)
+ assignment-operator)))
+ (when (and (re-search-forward re limit t)
+ (goto-char (nth 3 (match-data))))
+ (while (and (python-syntax-context 'paren)
+ (re-search-forward re limit t))
+ (goto-char (nth 3 (match-data))))
+ (if (not (python-syntax-context 'paren))
+ t
+ (set-match-data nil)))))
+ (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))))
- ;; This doesn't really help.
- ;;((rx (and ?\\ (group ?\n))) (1 " "))
- ))
-
-(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 "|"))))
- )))
-
-;; This isn't currently in `font-lock-defaults' as probably not worth
-;; it -- we basically only mess with a few normally-symbol characters.
-
-;; (defun python-font-lock-syntactic-face-function (state)
-;; "`font-lock-syntactic-face-function' for Python mode.
-;; Returns the string or comment face as usual, with side effect of putting
-;; a `syntax-table' property on the inside of the string or comment which is
-;; the standard syntax table."
-;; (if (nth 3 state)
-;; (save-excursion
-;; (goto-char (nth 8 state))
-;; (condition-case nil
-;; (forward-sexp)
-;; (error nil))
-;; (put-text-property (1+ (nth 8 state)) (1- (point))
-;; 'syntax-table (standard-syntax-table))
-;; 'font-lock-string-face)
-;; (put-text-property (1+ (nth 8 state)) (line-end-position)
-;; 'syntax-table (standard-syntax-table))
-;; 'font-lock-comment-face))
-
-;;;; Keymap and syntax
-
-(defvar python-mode-map
- (let ((map (make-sparse-keymap)))
- ;; Mostly taken from python-mode.el.
- (define-key map ":" 'python-electric-colon)
- (define-key map "\177" 'python-backspace)
- (define-key map "\C-c<" 'python-shift-left)
- (define-key map "\C-c>" 'python-shift-right)
- (define-key map "\C-c\C-k" 'python-mark-block)
- (define-key map "\C-c\C-d" 'python-pdbtrack-toggle-stack-tracking)
- (define-key map "\C-c\C-n" 'python-next-statement)
- (define-key map "\C-c\C-p" 'python-previous-statement)
- (define-key map "\C-c\C-u" 'python-beginning-of-block)
- (define-key map "\C-c\C-f" 'python-describe-symbol)
- (define-key map "\C-c\C-w" 'python-check)
- (define-key map "\C-c\C-v" 'python-check) ; a la sgml-mode
- (define-key map "\C-c\C-s" 'python-send-string)
- (define-key map [?\C-\M-x] 'python-send-defun)
- (define-key map "\C-c\C-r" 'python-send-region)
- (define-key map "\C-c\M-r" 'python-send-region-and-go)
- (define-key map "\C-c\C-c" 'python-send-buffer)
- (define-key map "\C-c\C-z" 'python-switch-to-python)
- (define-key map "\C-c\C-m" 'python-load-file)
- (define-key map "\C-c\C-l" 'python-load-file) ; a la cmuscheme
- (substitute-key-definition 'complete-symbol 'completion-at-point
- map global-map)
- (define-key map "\C-c\C-i" 'python-find-imports)
- (define-key map "\C-c\C-t" 'python-expand-template)
- (easy-menu-define python-menu map "Python Mode menu"
- `("Python"
- :help "Python-specific Features"
- ["Shift region left" python-shift-left :active mark-active
- :help "Shift by a single indentation step"]
- ["Shift region right" python-shift-right :active mark-active
- :help "Shift by a single indentation step"]
- "-"
- ["Mark block" python-mark-block
- :help "Mark innermost block around point"]
- ["Mark def/class" mark-defun
- :help "Mark innermost definition around point"]
- "-"
- ["Start of block" python-beginning-of-block
- :help "Go to start of innermost definition around point"]
- ["End of block" python-end-of-block
- :help "Go to end of innermost definition around point"]
- ["Start of def/class" beginning-of-defun
- :help "Go to start of innermost definition around point"]
- ["End of def/class" end-of-defun
- :help "Go to end of innermost definition around point"]
- "-"
- ("Templates..."
- :help "Expand templates for compound statements"
- :filter (lambda (&rest junk)
- (abbrev-table-menu python-mode-abbrev-table)))
- "-"
- ["Start interpreter" run-python
- :help "Run `inferior' Python in separate buffer"]
- ["Import/reload file" python-load-file
- :help "Load into inferior Python session"]
- ["Eval buffer" python-send-buffer
- :help "Evaluate buffer en bloc in inferior Python session"]
- ["Eval region" python-send-region :active mark-active
- :help "Evaluate region en bloc in inferior Python session"]
- ["Eval def/class" python-send-defun
- :help "Evaluate current definition in inferior Python session"]
- ["Switch to interpreter" python-switch-to-python
- :help "Switch to inferior Python buffer"]
- ["Set default process" python-set-proc
- :help "Make buffer's inferior process the default"
- :active (buffer-live-p python-buffer)]
- ["Check file" python-check :help "Run pychecker"]
- ["Debugger" pdb :help "Run pdb under GUD"]
- "-"
- ["Help on symbol" python-describe-symbol
- :help "Use pydoc on symbol at point"]
- ["Complete symbol" completion-at-point
- :help "Complete (qualified) symbol before point"]
- ["Find function" python-find-function
- :help "Try to find source definition of function at point"]
- ["Update imports" python-find-imports
- :help "Update list of top-level imports for completion"]))
- map))
-;; Fixme: add toolbar stuff for useful things like symbol help, send
-;; region, at least. (Shouldn't be specific to Python, obviously.)
-;; eric has items including: (un)indent, (un)comment, restart script,
-;; run script, debug script; also things for profiling, unit testing.
+ ((python-rx string-delimiter)
+ (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))
+ (cl-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)))
;; Give punctuation syntax to ASCII that normally has symbol
;; syntax or has word syntax and isn't a letter.
(let ((symbol (string-to-syntax "_"))
- (sst (standard-syntax-table)))
+ (sst (standard-syntax-table)))
(dotimes (i 128)
- (unless (= i ?_)
- (if (equal symbol (aref sst i))
- (modify-syntax-entry i "." table)))))
+ (unless (= i ?_)
+ (if (equal symbol (aref sst i))
+ (modify-syntax-entry i "." table)))))
(modify-syntax-entry ?$ "." table)
(modify-syntax-entry ?% "." table)
;; exceptions
@@ -344,1880 +580,2024 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)."
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?' "\"" table)
(modify-syntax-entry ?` "$" table)
- table))
-
-;;;; Utility stuff
-
-(defsubst python-in-string/comment ()
- "Return non-nil if point is in a Python literal (a comment or string)."
- ;; We don't need to save the match data.
- (nth 8 (syntax-ppss)))
-
-(defconst python-space-backslash-table
- (let ((table (copy-syntax-table python-mode-syntax-table)))
- (modify-syntax-entry ?\\ " " table)
table)
- "`python-mode-syntax-table' with backslash given whitespace syntax.")
-
-(defun python-skip-comments/blanks (&optional backward)
- "Skip comments and blank lines.
-BACKWARD non-nil means go backwards, otherwise go forwards.
-Backslash is treated as whitespace so that continued blank lines
-are skipped. Doesn't move out of comments -- should be outside
-or at end of line."
- (let ((arg (if backward
- ;; If we're in a comment (including on the trailing
- ;; newline), forward-comment doesn't move backwards out
- ;; of it. Don't set the syntax table round this bit!
- (let ((syntax (syntax-ppss)))
- (if (nth 4 syntax)
- (goto-char (nth 8 syntax)))
- (- (point-max)))
- (point-max))))
- (with-syntax-table python-space-backslash-table
- (forward-comment arg))))
-
-(defun python-backslash-continuation-line-p ()
- "Non-nil if preceding line ends with backslash that is not in a comment."
- (and (eq ?\\ (char-before (line-end-position 0)))
- (not (syntax-ppss-context (syntax-ppss)))))
-
-(defun python-continuation-line-p ()
- "Return non-nil if current line continues a previous one.
-The criteria are that the previous line ends in a backslash outside
-comments and strings, or that point is within brackets/parens."
- (or (python-backslash-continuation-line-p)
- (let ((depth (syntax-ppss-depth
- (save-excursion ; syntax-ppss with arg changes point
- (syntax-ppss (line-beginning-position))))))
- (or (> depth 0)
- (if (< depth 0) ; Unbalanced brackets -- act locally
- (save-excursion
- (condition-case ()
- (progn (backward-up-list) t) ; actually within brackets
- (error nil))))))))
-
-(defun python-comment-line-p ()
- "Return non-nil if and only if current line has only a comment."
- (save-excursion
- (end-of-line)
- (when (eq 'comment (syntax-ppss-context (syntax-ppss)))
- (back-to-indentation)
- (looking-at (rx (or (syntax comment-start) line-end))))))
+ "Syntax table for Python files.")
-(defun python-blank-line-p ()
- "Return non-nil if and only if current line is blank."
- (save-excursion
- (beginning-of-line)
- (looking-at "\\s-*$")))
-
-(defun python-beginning-of-string ()
- "Go to beginning of string around point.
-Do nothing if not in string."
- (let ((state (syntax-ppss)))
- (when (eq 'string (syntax-ppss-context state))
- (goto-char (nth 8 state)))))
-
-(defun python-open-block-statement-p (&optional bos)
- "Return non-nil if statement at point opens a block.
-BOS non-nil means point is known to be at beginning of statement."
- (save-excursion
- (unless bos (python-beginning-of-statement))
- (looking-at (rx (and (or "if" "else" "elif" "while" "for" "def"
- "class" "try" "except" "finally" "with")
- symbol-end)))))
-
-(defun python-close-block-statement-p (&optional bos)
- "Return non-nil if current line is a statement closing a block.
-BOS non-nil means point is at beginning of statement.
-The criteria are that the line isn't a comment or in string and
- starts with keyword `raise', `break', `continue' or `pass'."
- (save-excursion
- (unless bos (python-beginning-of-statement))
- (back-to-indentation)
- (looking-at (rx (or "return" "raise" "break" "continue" "pass")
- symbol-end))))
+(defvar python-dotty-syntax-table
+ (let ((table (make-syntax-table python-mode-syntax-table)))
+ (modify-syntax-entry ?. "w" table)
+ (modify-syntax-entry ?_ "w" table)
+ table)
+ "Dotty syntax table for Python files.
+It makes underscores and dots word constituent chars.")
-(defun python-outdent-p ()
- "Return non-nil if current line should outdent a level."
- (save-excursion
- (back-to-indentation)
- (and (looking-at (rx (and (or "else" "finally" "except" "elif")
- symbol-end)))
- (not (python-in-string/comment))
- ;; Ensure there's a previous statement and move to it.
- (zerop (python-previous-statement))
- (not (python-close-block-statement-p t))
- ;; Fixme: check this
- (not (python-open-block-statement-p)))))
-;;;; Indentation.
+;;; Indentation
-(defcustom python-indent 4
- "Number of columns for a unit of indentation in Python mode.
-See also `\\[python-guess-indent]'"
+(defcustom python-indent-offset 4
+ "Default indentation offset for Python."
:group 'python
- :type 'integer)
-(put 'python-indent 'safe-local-variable 'integerp)
+ :type 'integer
+ :safe 'integerp)
-(defcustom python-guess-indent t
- "Non-nil means Python mode guesses `python-indent' for the buffer."
+(defcustom python-indent-guess-indent-offset t
+ "Non-nil tells Python mode to guess `python-indent-offset' value."
:type 'boolean
- :group 'python)
-
-(defcustom python-indent-string-contents t
- "Non-nil means indent contents of multi-line strings together.
-This means indent them the same as the preceding non-blank line.
-Otherwise preserve their indentation.
-
-This only applies to `doc' strings, i.e. those that form statements;
-the indentation is preserved in others."
- :type '(choice (const :tag "Align with preceding" t)
- (const :tag "Preserve indentation" nil))
- :group 'python)
-
-(defcustom python-honour-comment-indentation nil
- "Non-nil means indent relative to preceding comment line.
-Only do this for comments where the leading comment character is
-followed by space. This doesn't apply to comment lines, which
-are always indented in lines with preceding comments."
- :type 'boolean
- :group 'python)
-
-(defcustom python-continuation-offset 4
- "Number of columns of additional indentation for continuation lines.
-Continuation lines follow a backslash-terminated line starting a
-statement."
:group 'python
- :type 'integer)
-
-
-(defcustom python-pdbtrack-do-tracking-p t
- "*Controls whether the pdbtrack feature is enabled or not.
-
-When non-nil, pdbtrack is enabled in all comint-based buffers,
-e.g. shell interaction buffers and the *Python* buffer.
-
-When using pdb to debug a Python program, pdbtrack notices the
-pdb prompt and presents the line in the source file where the
-program is stopped in a pop-up buffer. It's similar to what
-gud-mode does for debugging C programs with gdb, but without
-having to restart the program."
- :type 'boolean
- :group 'python)
-(make-variable-buffer-local 'python-pdbtrack-do-tracking-p)
+ :safe 'booleanp)
-(defcustom python-pdbtrack-minor-mode-string " PDB"
- "*Minor-mode sign to be displayed when pdbtrack is active."
- :type 'string
- :group 'python)
+(define-obsolete-variable-alias
+ 'python-indent 'python-indent-offset "24.3")
-;; Add a designator to the minor mode strings
-(or (assq 'python-pdbtrack-is-tracking-p minor-mode-alist)
- (push '(python-pdbtrack-is-tracking-p python-pdbtrack-minor-mode-string)
- minor-mode-alist))
-
-(defcustom python-shell-prompt-alist
- '(("ipython" . "^In \\[[0-9]+\\]: *")
- (t . "^>>> "))
- "Alist of Python input prompts.
-Each element has the form (PROGRAM . REGEXP), where PROGRAM is
-the value of `python-python-command' for the python process and
-REGEXP is a regular expression matching the Python prompt.
-PROGRAM can also be t, which specifies the default when no other
-element matches `python-python-command'."
- :type 'string
- :group 'python
- :version "24.1")
-
-(defcustom python-shell-continuation-prompt-alist
- '(("ipython" . "^ [.][.][.]+: *")
- (t . "^[.][.][.] "))
- "Alist of Python continued-line prompts.
-Each element has the form (PROGRAM . REGEXP), where PROGRAM is
-the value of `python-python-command' for the python process and
-REGEXP is a regular expression matching the Python prompt for
-continued lines.
-PROGRAM can also be t, which specifies the default when no other
-element matches `python-python-command'."
- :type 'string
- :group 'python
- :version "24.1")
+(define-obsolete-variable-alias
+ 'python-guess-indent 'python-indent-guess-indent-offset "24.3")
-(defvar python-pdbtrack-is-tracking-p nil)
+(defvar python-indent-current-level 0
+ "Current indentation level `python-indent-line-function' is using.")
-(defconst python-pdbtrack-stack-entry-regexp
- "^> \\(.*\\)(\\([0-9]+\\))\\([?a-zA-Z0-9_<>]+\\)()"
- "Regular expression pdbtrack uses to find a stack trace entry.")
+(defvar python-indent-levels '(0)
+ "Levels of indentation available for `python-indent-line-function'.")
-(defconst python-pdbtrack-input-prompt "\n[(<]*[Ii]?[Pp]db[>)]+ "
- "Regular expression pdbtrack uses to recognize a pdb prompt.")
+(defvar python-indent-dedenters '("else" "elif" "except" "finally")
+ "List of words that should be dedented.
+These make `python-indent-calculate-indentation' subtract the value of
+`python-indent-offset'.")
-(defconst python-pdbtrack-track-range 10000
- "Max number of characters from end of buffer to search for stack entry.")
-
-(defun python-guess-indent ()
- "Guess step for indentation of current buffer.
-Set `python-indent' locally to the value guessed."
+(defun python-indent-guess-indent-offset ()
+ "Guess and set `python-indent-offset' for the current buffer."
(interactive)
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
- (let (done indent)
- (while (and (not done) (not (eobp)))
- (when (and (re-search-forward (rx ?: (0+ space)
- (or (syntax comment-start)
- line-end))
- nil 'move)
- (python-open-block-statement-p))
- (save-excursion
- (python-beginning-of-statement)
- (let ((initial (current-indentation)))
- (if (zerop (python-next-statement))
- (setq indent (- (current-indentation) initial)))
- (if (and indent (>= indent 2) (<= indent 8)) ; sanity check
- (setq done t))))))
- (when done
- (when (/= indent (default-value 'python-indent))
- (set (make-local-variable 'python-indent) indent)
- (unless (= tab-width python-indent)
- (setq indent-tabs-mode nil)))
- indent)))))
-
-;; Alist of possible indentations and start of statement they would
-;; close. Used in indentation cycling (below).
-(defvar python-indent-list nil
- "Internal use.")
-;; Length of the above
-(defvar python-indent-list-length nil
- "Internal use.")
-;; Current index into the alist.
-(defvar python-indent-index nil
- "Internal use.")
-
-(defun python-calculate-indentation ()
- "Calculate Python indentation for line at point."
- (setq python-indent-list nil
- python-indent-list-length 1)
- (save-excursion
- (beginning-of-line)
- (let ((syntax (syntax-ppss))
- start)
- (cond
- ((eq 'string (syntax-ppss-context syntax)) ; multi-line string
- (if (not python-indent-string-contents)
- (current-indentation)
- ;; Only respect `python-indent-string-contents' in doc
- ;; strings (defined as those which form statements).
- (if (not (save-excursion
- (python-beginning-of-statement)
- (looking-at (rx (or (syntax string-delimiter)
- (syntax string-quote))))))
- (current-indentation)
- ;; Find indentation of preceding non-blank line within string.
- (setq start (nth 8 syntax))
- (forward-line -1)
- (while (and (< start (point)) (looking-at "\\s-*$"))
- (forward-line -1))
- (current-indentation))))
- ((python-continuation-line-p) ; after backslash, or bracketed
- (let ((point (point))
- (open-start (cadr syntax))
- (backslash (python-backslash-continuation-line-p))
- (colon (eq ?: (char-before (1- (line-beginning-position))))))
- (if open-start
- ;; Inside bracketed expression.
- (progn
- (goto-char (1+ open-start))
- ;; Look for first item in list (preceding point) and
- ;; align with it, if found.
- (if (with-syntax-table python-space-backslash-table
- (let ((parse-sexp-ignore-comments t))
- (condition-case ()
- (progn (forward-sexp)
- (backward-sexp)
- (< (point) point))
- (error nil))))
- ;; Extra level if we're backslash-continued or
- ;; following a key.
- (if (or backslash colon)
- (+ python-indent (current-column))
- (current-column))
- ;; Otherwise indent relative to statement start, one
- ;; level per bracketing level.
- (goto-char (1+ open-start))
- (python-beginning-of-statement)
- (+ (current-indentation) (* (car syntax) python-indent))))
- ;; Otherwise backslash-continued.
- (forward-line -1)
- (if (python-continuation-line-p)
- ;; We're past first continuation line. Align with
- ;; previous line.
- (current-indentation)
- ;; First continuation line. Indent one step, with an
- ;; extra one if statement opens a block.
- (python-beginning-of-statement)
- (+ (current-indentation) python-continuation-offset
- (if (python-open-block-statement-p t)
- python-indent
- 0))))))
- ((bobp) 0)
- ;; Fixme: Like python-mode.el; not convinced by this.
- ((looking-at (rx (0+ space) (syntax comment-start)
- (not (any " \t\n")))) ; non-indentable comment
- (current-indentation))
- ((and python-honour-comment-indentation
- ;; Back over whitespace, newlines, non-indentable comments.
- (catch 'done
- (while (cond ((bobp) nil)
- ((not (forward-comment -1))
- nil) ; not at comment start
- ;; Now at start of comment -- trailing one?
- ((/= (current-column) (current-indentation))
- nil)
- ;; Indentable comment, like python-mode.el?
- ((and (looking-at (rx (syntax comment-start)
- (or space line-end)))
- (/= 0 (current-column)))
- (throw 'done (current-column)))
- ;; Else skip it (loop).
- (t))))))
- (t
- (python-indentation-levels)
- ;; Prefer to indent comments with an immediately-following
- ;; statement, e.g.
- ;; ...
- ;; # ...
- ;; def ...
- (when (and (> python-indent-list-length 1)
- (python-comment-line-p))
- (forward-line)
- (unless (python-comment-line-p)
- (let ((elt (assq (current-indentation) python-indent-list)))
- (setq python-indent-list
- (nconc (delete elt python-indent-list)
- (list elt))))))
- (caar (last python-indent-list)))))))
-
-;;;; Cycling through the possible indentations with successive TABs.
-
-;; These don't need to be buffer-local since they're only relevant
-;; during a cycle.
-
-(defun python-initial-text ()
- "Text of line following indentation and ignoring any trailing comment."
- (save-excursion
- (buffer-substring (progn
- (back-to-indentation)
- (point))
- (progn
- (end-of-line)
- (forward-comment -1)
- (point)))))
-
-(defconst python-block-pairs
- '(("else" "if" "elif" "while" "for" "try" "except")
- ("elif" "if" "elif")
- ("except" "try" "except")
- ("finally" "else" "try" "except"))
- "Alist of keyword matches.
-The car of an element is a keyword introducing a statement which
-can close a block opened by a keyword in the cdr.")
-
-(defun python-first-word ()
- "Return first word (actually symbol) on the line."
- (save-excursion
- (back-to-indentation)
- (current-word t)))
-
-(defun python-indentation-levels ()
- "Return a list of possible indentations for this line.
-It is assumed not to be a continuation line or in a multi-line string.
-Includes the default indentation and those which would close all
-enclosing blocks. Elements of the list are actually pairs:
-\(INDENTATION . TEXT), where TEXT is the initial text of the
-corresponding block opening (or nil)."
- (save-excursion
- (let ((initial "")
- levels indent)
- ;; Only one possibility immediately following a block open
- ;; statement, assuming it doesn't have a `suite' on the same line.
- (cond
- ((save-excursion (and (python-previous-statement)
- (python-open-block-statement-p t)
- (setq indent (current-indentation))
- ;; Check we don't have something like:
- ;; if ...: ...
- (if (progn (python-end-of-statement)
- (python-skip-comments/blanks t)
- (eq ?: (char-before)))
- (setq indent (+ python-indent indent)))))
- (push (cons indent initial) levels))
- ;; Only one possibility for comment line immediately following
- ;; another.
- ((save-excursion
- (when (python-comment-line-p)
- (forward-line -1)
- (if (python-comment-line-p)
- (push (cons (current-indentation) initial) levels)))))
- ;; Fixme: Maybe have a case here which indents (only) first
- ;; line after a lambda.
- (t
- (let ((start (car (assoc (python-first-word) python-block-pairs))))
- (python-previous-statement)
- ;; Is this a valid indentation for the line of interest?
- (unless (or (if start ; potentially only outdentable
- ;; Check for things like:
- ;; if ...: ...
- ;; else ...:
- ;; where the second line need not be outdented.
- (not (member (python-first-word)
- (cdr (assoc start
- python-block-pairs)))))
- ;; Not sensible to indent to the same level as
- ;; previous `return' &c.
- (python-close-block-statement-p))
- (push (cons (current-indentation) (python-initial-text))
- levels))
- (while (python-beginning-of-block)
- (when (or (not start)
- (member (python-first-word)
- (cdr (assoc start python-block-pairs))))
- (push (cons (current-indentation) (python-initial-text))
- levels))))))
- (prog1 (or levels (setq levels '((0 . ""))))
- (setq python-indent-list levels
- python-indent-list-length (length python-indent-list))))))
-
-;; This is basically what `python-indent-line' would be if we didn't
-;; do the cycling.
-(defun python-indent-line-1 (&optional leave)
- "Subroutine of `python-indent-line'.
-Does non-repeated indentation. LEAVE non-nil means leave
-indentation if it is valid, i.e. one of the positions returned by
-`python-calculate-indentation'."
- (let ((target (python-calculate-indentation))
- (pos (- (point-max) (point))))
- (if (or (= target (current-indentation))
- ;; Maybe keep a valid indentation.
- (and leave python-indent-list
- (assq (current-indentation) python-indent-list)))
- (if (< (current-column) (current-indentation))
- (back-to-indentation))
+ (let ((block-end))
+ (while (and (not block-end)
+ (re-search-forward
+ (python-rx line-start block-start) nil t))
+ (when (and
+ (not (python-syntax-context-type))
+ (progn
+ (goto-char (line-end-position))
+ (python-util-forward-comment -1)
+ (if (equal (char-before) ?:)
+ t
+ (forward-line 1)
+ (when (python-info-block-continuation-line-p)
+ (while (and (python-info-continuation-line-p)
+ (not (eobp)))
+ (forward-line 1))
+ (python-util-forward-comment -1)
+ (when (equal (char-before) ?:)
+ t)))))
+ (setq block-end (point-marker))))
+ (let ((indentation
+ (when block-end
+ (goto-char block-end)
+ (python-util-forward-comment)
+ (current-indentation))))
+ (if indentation
+ (setq python-indent-offset indentation)
+ (message "Can't guess python-indent-offset, using defaults: %s"
+ python-indent-offset)))))))
+
+(defun python-indent-context ()
+ "Get information on indentation context.
+Context information is returned with a cons with the form:
+ \(STATUS . START)
+
+Where status can be any of the following symbols:
+ * inside-paren: If point in between (), {} or []
+ * inside-string: If point is inside a string
+ * after-backslash: Previous line ends in a backslash
+ * after-beginning-of-block: Point is after beginning of block
+ * after-line: Point is after normal line
+ * no-indent: Point is at beginning of buffer or other special case
+START is the buffer position where the sexp starts."
+ (save-restriction
+ (widen)
+ (let ((ppss (save-excursion (beginning-of-line) (syntax-ppss)))
+ (start))
+ (cons
+ (cond
+ ;; Beginning of buffer
+ ((save-excursion
+ (goto-char (line-beginning-position))
+ (bobp))
+ 'no-indent)
+ ;; 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)))
+ (let ((line-beg-pos (line-beginning-position)))
+ (when (python-info-line-ends-backslash-p
+ (1- line-beg-pos))
+ (- line-beg-pos 2)))))
+ 'after-backslash)
+ ;; After beginning of block
+ ((setq start (save-excursion
+ (when (progn
+ (back-to-indentation)
+ (python-util-forward-comment -1)
+ (equal (char-before) ?:))
+ ;; Move to the first block start that's not in within
+ ;; a string, comment or paren and that's not a
+ ;; continuation line.
+ (while (and (re-search-backward
+ (python-rx block-start) nil t)
+ (or
+ (python-syntax-context-type)
+ (python-info-continuation-line-p))))
+ (when (looking-at (python-rx block-start))
+ (point-marker)))))
+ 'after-beginning-of-block)
+ ;; After normal line
+ ((setq start (save-excursion
+ (back-to-indentation)
+ (skip-chars-backward (rx (or whitespace ?\n)))
+ (python-nav-beginning-of-statement)
+ (point-marker)))
+ 'after-line)
+ ;; Do not indent
+ (t 'no-indent))
+ start))))
+
+(defun python-indent-calculate-indentation ()
+ "Calculate correct indentation offset for the current line."
+ (let* ((indentation-context (python-indent-context))
+ (context-status (car indentation-context))
+ (context-start (cdr indentation-context)))
+ (save-restriction
+ (widen)
+ (save-excursion
+ (pcase context-status
+ (`no-indent 0)
+ ;; When point is after beginning of block just add one level
+ ;; of indentation relative to the context-start
+ (`after-beginning-of-block
+ (goto-char context-start)
+ (+ (current-indentation) python-indent-offset))
+ ;; When after a simple line just use previous line
+ ;; indentation, in the case current line starts with a
+ ;; `python-indent-dedenters' de-indent one level.
+ (`after-line
+ (-
+ (save-excursion
+ (goto-char context-start)
+ (current-indentation))
+ (if (progn
+ (back-to-indentation)
+ (looking-at (regexp-opt python-indent-dedenters)))
+ python-indent-offset
+ 0)))
+ ;; When inside of a string, do nothing. just use the current
+ ;; indentation. XXX: perhaps it would be a good idea to
+ ;; invoke standard text indentation here
+ (`inside-string
+ (goto-char context-start)
+ (current-indentation))
+ ;; After backslash we have several possibilities.
+ (`after-backslash
+ (cond
+ ;; Check if current line is a dot continuation. For this
+ ;; the current line must start with a dot and previous
+ ;; line must contain a dot too.
+ ((save-excursion
+ (back-to-indentation)
+ (when (looking-at "\\.")
+ ;; If after moving one line back point is inside a paren it
+ ;; needs to move back until it's not anymore
+ (while (prog2
+ (forward-line -1)
+ (and (not (bobp))
+ (python-syntax-context 'paren))))
+ (goto-char (line-end-position))
+ (while (and (re-search-backward
+ "\\." (line-beginning-position) t)
+ (python-syntax-context-type)))
+ (if (and (looking-at "\\.")
+ (not (python-syntax-context-type)))
+ ;; The indentation is the same column of the
+ ;; first matching dot that's not inside a
+ ;; comment, a string or a paren
+ (current-column)
+ ;; No dot found on previous line, just add another
+ ;; indentation level.
+ (+ (current-indentation) python-indent-offset)))))
+ ;; Check if prev line is a block continuation
+ ((let ((block-continuation-start
+ (python-info-block-continuation-line-p)))
+ (when block-continuation-start
+ ;; If block-continuation-start is set jump to that
+ ;; marker and use first column after the block start
+ ;; as indentation value.
+ (goto-char block-continuation-start)
+ (re-search-forward
+ (python-rx block-start (* space))
+ (line-end-position) t)
+ (current-column))))
+ ;; Check if current line is an assignment continuation
+ ((let ((assignment-continuation-start
+ (python-info-assignment-continuation-line-p)))
+ (when assignment-continuation-start
+ ;; If assignment-continuation is set jump to that
+ ;; marker and use first column after the assignment
+ ;; operator as indentation value.
+ (goto-char assignment-continuation-start)
+ (current-column))))
+ (t
+ (forward-line -1)
+ (goto-char (python-info-beginning-of-backslash))
+ (if (save-excursion
+ (and
+ (forward-line -1)
+ (goto-char
+ (or (python-info-beginning-of-backslash) (point)))
+ (python-info-line-ends-backslash-p)))
+ ;; The two previous lines ended in a backslash so we must
+ ;; respect previous line indentation.
+ (current-indentation)
+ ;; What happens here is that we are dealing with the second
+ ;; line of a backslash continuation, in that case we just going
+ ;; to add one indentation level.
+ (+ (current-indentation) python-indent-offset)))))
+ ;; When inside a paren there's a need to handle nesting
+ ;; correctly
+ (`inside-paren
+ (cond
+ ;; If current line closes the outermost open paren use the
+ ;; current indentation of the context-start line.
+ ((save-excursion
+ (skip-syntax-forward "\s" (line-end-position))
+ (when (and (looking-at (regexp-opt '(")" "]" "}")))
+ (progn
+ (forward-char 1)
+ (not (python-syntax-context 'paren))))
+ (goto-char context-start)
+ (current-indentation))))
+ ;; If open paren is contained on a line by itself add another
+ ;; indentation level, else look for the first word after the
+ ;; opening paren and use it's column position as indentation
+ ;; level.
+ ((let* ((content-starts-in-newline)
+ (indent
+ (save-excursion
+ (if (setq content-starts-in-newline
+ (progn
+ (goto-char context-start)
+ (forward-char)
+ (save-restriction
+ (narrow-to-region
+ (line-beginning-position)
+ (line-end-position))
+ (python-util-forward-comment))
+ (looking-at "$")))
+ (+ (current-indentation) python-indent-offset)
+ (current-column)))))
+ ;; Adjustments
+ (cond
+ ;; If current line closes a nested open paren de-indent one
+ ;; level.
+ ((progn
+ (back-to-indentation)
+ (looking-at (regexp-opt '(")" "]" "}"))))
+ (- indent python-indent-offset))
+ ;; If the line of the opening paren that wraps the current
+ ;; line starts a block add another level of indentation to
+ ;; follow new pep8 recommendation. See: http://ur1.ca/5rojx
+ ((save-excursion
+ (when (and content-starts-in-newline
+ (progn
+ (goto-char context-start)
+ (back-to-indentation)
+ (looking-at (python-rx block-start))))
+ (+ indent python-indent-offset))))
+ (t indent)))))))))))
+
+(defun python-indent-calculate-levels ()
+ "Calculate `python-indent-levels' and reset `python-indent-current-level'."
+ (let* ((indentation (python-indent-calculate-indentation))
+ (remainder (% indentation python-indent-offset))
+ (steps (/ (- indentation remainder) python-indent-offset)))
+ (setq python-indent-levels (list 0))
+ (dotimes (step steps)
+ (push (* python-indent-offset (1+ step)) python-indent-levels))
+ (when (not (eq 0 remainder))
+ (push (+ (* python-indent-offset steps) remainder) python-indent-levels))
+ (setq python-indent-levels (nreverse python-indent-levels))
+ (setq python-indent-current-level (1- (length python-indent-levels)))))
+
+(defun python-indent-toggle-levels ()
+ "Toggle `python-indent-current-level' over `python-indent-levels'."
+ (setq python-indent-current-level (1- python-indent-current-level))
+ (when (< python-indent-current-level 0)
+ (setq python-indent-current-level (1- (length python-indent-levels)))))
+
+(defun python-indent-line (&optional force-toggle)
+ "Internal implementation of `python-indent-line-function'.
+Uses the offset calculated in
+`python-indent-calculate-indentation' and available levels
+indicated by the variable `python-indent-levels' to set the
+current indentation.
+
+When the variable `last-command' is equal to
+`indent-for-tab-command' or FORCE-TOGGLE is non-nil it cycles
+levels indicated in the variable `python-indent-levels' by
+setting the current level in the variable
+`python-indent-current-level'.
+
+When the variable `last-command' is not equal to
+`indent-for-tab-command' and FORCE-TOGGLE is nil it calculates
+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')"
+ (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 target)
- (if (> (- (point-max) pos) (point))
- (goto-char (- (point-max) pos))))))
-
-(defun python-indent-line ()
- "Indent current line as Python code.
-When invoked via `indent-for-tab-command', cycle through possible
-indentations for current line. The cycle is broken by a command
-different from `indent-for-tab-command', i.e. successive TABs do
-the cycling."
- (interactive)
- (if (and (eq this-command 'indent-for-tab-command)
- (eq last-command this-command))
- (if (= 1 python-indent-list-length)
- (message "Sole indentation")
- (progn (setq python-indent-index
- (% (1+ python-indent-index) python-indent-list-length))
- (beginning-of-line)
- (delete-horizontal-space)
- (indent-to (car (nth python-indent-index python-indent-list)))
- (if (python-block-end-p)
- (let ((text (cdr (nth python-indent-index
- python-indent-list))))
- (if text
- (message "Closes: %s" text))))))
- (python-indent-line-1)
- (setq python-indent-index (1- python-indent-list-length))))
+ (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 ()
+ "`indent-line-function' for Python mode.
+See `python-indent-line' for details."
+ (python-indent-line))
+
+(defun python-indent-dedent-line ()
+ "De-indent current line."
+ (interactive "*")
+ (when (and (not (python-syntax-comment-or-string-p))
+ (<= (point-marker) (save-excursion
+ (back-to-indentation)
+ (point-marker)))
+ (> (current-column) 0))
+ (python-indent-line t)
+ t))
+
+(defun python-indent-dedent-line-backspace (arg)
+ "De-indent current line.
+Argument ARG is passed to `backward-delete-char-untabify' when
+point is not in between the indentation."
+ (interactive "*p")
+ (when (not (python-indent-dedent-line))
+ (backward-delete-char-untabify arg)))
+(put 'python-indent-dedent-line-backspace 'delete-selection 'supersede)
(defun python-indent-region (start end)
- "`indent-region-function' for Python.
-Leaves validly-indented lines alone, i.e. doesn't indent to
-another valid position."
- (save-excursion
- (goto-char end)
- (setq end (point-marker))
- (goto-char start)
- (or (bolp) (forward-line 1))
- (while (< (point) end)
- (or (and (bolp) (eolp))
- (python-indent-line-1 t))
- (forward-line 1))
- (move-marker end nil)))
-
-(defun python-block-end-p ()
- "Non-nil if this is a line in a statement closing a block,
-or a blank line indented to where it would close a block."
- (and (not (python-comment-line-p))
- (or (python-close-block-statement-p t)
- (< (current-indentation)
- (save-excursion
- (python-previous-statement)
- (current-indentation))))))
+ "Indent a python region automagically.
+
+Called from a program, START and END specify the region to indent."
+ (let ((deactivate-mark nil))
+ (save-excursion
+ (goto-char end)
+ (setq end (point-marker))
+ (goto-char start)
+ (or (bolp) (forward-line 1))
+ (while (< (point) end)
+ (or (and (bolp) (eolp))
+ (let (word)
+ (forward-line -1)
+ (back-to-indentation)
+ (setq word (current-word))
+ (forward-line 1)
+ (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)))))
+ (forward-line 1))
+ (move-marker end nil))))
+
+(defun python-indent-shift-left (start end &optional count)
+ "Shift lines contained in region START END by COUNT columns to the left.
+COUNT defaults to `python-indent-offset'. If region isn't
+active, the current line is shifted. The shifted region includes
+the lines in which START and END lie. An error is signaled if
+any lines in the region are indented less than COUNT columns."
+ (interactive
+ (if mark-active
+ (list (region-beginning) (region-end) current-prefix-arg)
+ (list (line-beginning-position) (line-end-position) current-prefix-arg)))
+ (if count
+ (setq count (prefix-numeric-value count))
+ (setq count python-indent-offset))
+ (when (> count 0)
+ (let ((deactivate-mark nil))
+ (save-excursion
+ (goto-char start)
+ (while (< (point) end)
+ (if (and (< (current-indentation) count)
+ (not (looking-at "[ \t]*$")))
+ (error "Can't shift all lines enough"))
+ (forward-line))
+ (indent-rigidly start end (- count))))))
+
+(add-to-list 'debug-ignored-errors "^Can't shift all lines enough")
+
+(defun python-indent-shift-right (start end &optional count)
+ "Shift lines contained in region START END by COUNT columns to the left.
+COUNT defaults to `python-indent-offset'. If region isn't
+active, the current line is shifted. The shifted region includes
+the lines in which START and END lie."
+ (interactive
+ (if mark-active
+ (list (region-beginning) (region-end) current-prefix-arg)
+ (list (line-beginning-position) (line-end-position) current-prefix-arg)))
+ (let ((deactivate-mark nil))
+ (if count
+ (setq count (prefix-numeric-value count))
+ (setq count python-indent-offset))
+ (indent-rigidly start end count)))
+
+(defun python-indent-electric-colon (arg)
+ "Insert a colon and maybe de-indent the current line.
+With numeric ARG, just insert that many colons. With
+\\[universal-argument], just insert a single colon."
+ (interactive "*P")
+ (self-insert-command (if (not (integerp arg)) 1 arg))
+ (when (and (not arg)
+ (eolp)
+ (not (equal ?: (char-after (- (point-marker) 2))))
+ (not (python-syntax-comment-or-string-p)))
+ (let ((indentation (current-indentation))
+ (calculated-indentation (python-indent-calculate-indentation)))
+ (python-info-closing-block-message)
+ (when (> indentation calculated-indentation)
+ (save-excursion
+ (indent-line-to calculated-indentation)
+ (when (not (python-info-closing-block-message))
+ (indent-line-to indentation)))))))
+(put 'python-indent-electric-colon 'delete-selection t)
+
+(defun python-indent-post-self-insert-function ()
+ "Adjust closing paren line indentation after a char is added.
+This function is intended to be added to the
+`post-self-insert-hook.' If a line renders a paren alone, after
+adding a char before it, the line will be re-indented
+automatically if needed."
+ (when (and (eq (char-before) last-command-event)
+ (not (bolp))
+ (memq (char-after) '(?\) ?\] ?\})))
+ (save-excursion
+ (goto-char (line-beginning-position))
+ ;; If after going to the beginning of line the point
+ ;; is still inside a paren it's ok to do the trick
+ (when (python-syntax-context 'paren)
+ (let ((indentation (python-indent-calculate-indentation)))
+ (when (< (current-indentation) indentation)
+ (indent-line-to indentation)))))))
+
-;;;; Movement.
-
-;; Fixme: Define {for,back}ward-sexp-function? Maybe skip units like
-;; block, statement, depending on context.
-
-(defun python-beginning-of-defun ()
- "`beginning-of-defun-function' for Python.
-Finds beginning of innermost nested class or method definition.
-Returns the name of the definition found at the end, or nil if
-reached start of buffer."
- (let ((ci (current-indentation))
- (def-re (rx line-start (0+ space) (or "def" "class") (1+ space)
- (group (1+ (or word (syntax symbol))))))
- found lep) ;; def-line
- (if (python-comment-line-p)
- (setq ci most-positive-fixnum))
- (while (and (not (bobp)) (not found))
- ;; Treat bol at beginning of function as outside function so
- ;; that successive C-M-a makes progress backwards.
- ;;(setq def-line (looking-at def-re))
- (unless (bolp) (end-of-line))
- (setq lep (line-end-position))
- (if (and (re-search-backward def-re nil 'move)
- ;; Must be less indented or matching top level, or
- ;; equally indented if we started on a definition line.
- (let ((in (current-indentation)))
- (or (and (zerop ci) (zerop in))
- (= lep (line-end-position)) ; on initial line
- ;; Not sure why it was like this -- fails in case of
- ;; last internal function followed by first
- ;; non-def statement of the main body.
-;; (and def-line (= in ci))
- (= in ci)
- (< in ci)))
- (not (python-in-string/comment)))
- (setq found t)))
+;;; Navigation
+
+(defvar python-nav-beginning-of-defun-regexp
+ (python-rx line-start (* space) defun (+ space) (group symbol-name))
+ "Regexp matching class or function definition.
+The name of the defun should be grouped so it can be retrieved
+via `match-string'.")
+
+(defun python-nav--beginning-of-defun (&optional arg)
+ "Internal implementation of `python-nav-beginning-of-defun'.
+With positive ARG search backwards, else search forwards."
+ (when (or (null arg) (= arg 0)) (setq arg 1))
+ (let* ((re-search-fn (if (> arg 0)
+ #'re-search-backward
+ #'re-search-forward))
+ (line-beg-pos (line-beginning-position))
+ (line-content-start (+ line-beg-pos (current-indentation)))
+ (pos (point-marker))
+ (beg-indentation
+ (and (> arg 0)
+ (save-excursion
+ (and (python-info-current-line-empty-p)
+ (python-util-forward-comment -1))
+ (python-nav-beginning-of-statement)
+ (if (python-info-looking-at-beginning-of-defun)
+ (+ (current-indentation) python-indent-offset)
+ (current-indentation)))))
+ (found
+ (progn
+ (when (and (< arg 0)
+ (python-info-looking-at-beginning-of-defun))
+ (end-of-line 1))
+ (while (and (funcall re-search-fn
+ python-nav-beginning-of-defun-regexp nil t)
+ (or (python-syntax-context-type)
+ ;; Handle nested defuns when moving
+ ;; backwards by checking indentation.
+ (and (> arg 0)
+ (not (= (current-indentation) 0))
+ (>= (current-indentation) beg-indentation)))))
+ (and (python-info-looking-at-beginning-of-defun)
+ (or (not (= (line-number-at-pos pos)
+ (line-number-at-pos)))
+ (and (>= (point) line-beg-pos)
+ (<= (point) line-content-start)
+ (> pos line-content-start)))))))
+ (if found
+ (or (beginning-of-line 1) t)
+ (and (goto-char pos) nil))))
+
+(defun python-nav-beginning-of-defun (&optional arg)
+ "Move point to `beginning-of-defun'.
+With positive ARG search backwards else search forward. When ARG
+is nil or 0 defaults to 1. When searching backwards nested
+defuns are handled with care depending on current point
+position. Return non-nil if point is moved to
+`beginning-of-defun'."
+ (when (or (null arg) (= arg 0)) (setq arg 1))
+ (let ((found))
+ (cond ((and (eq this-command 'mark-defun)
+ (python-info-looking-at-beginning-of-defun)))
+ (t
+ (dotimes (i (if (> arg 0) arg (- arg)))
+ (when (and (python-nav--beginning-of-defun arg)
+ (not found))
+ (setq found t)))))
found))
-(defun python-end-of-defun ()
- "`end-of-defun-function' for Python.
-Finds end of innermost nested class or method definition."
- (let ((orig (point))
- (pattern (rx line-start (0+ space) (or "def" "class") space)))
- ;; Go to start of current block and check whether it's at top
- ;; level. If it is, and not a block start, look forward for
- ;; definition statement.
- (when (python-comment-line-p)
- (end-of-line)
- (forward-comment most-positive-fixnum))
- (if (not (python-open-block-statement-p))
- (python-beginning-of-block))
- (if (zerop (current-indentation))
- (unless (python-open-block-statement-p)
- (while (and (re-search-forward pattern nil 'move)
- (python-in-string/comment))) ; just loop
- (unless (eobp)
- (beginning-of-line)))
- ;; Don't move before top-level statement that would end defun.
- (end-of-line)
- (python-beginning-of-defun))
- ;; If we got to the start of buffer, look forward for
- ;; definition statement.
- (if (and (bobp) (not (looking-at "def\\|class")))
- (while (and (not (eobp))
- (re-search-forward pattern nil 'move)
- (python-in-string/comment)))) ; just loop
- ;; We're at a definition statement (or end-of-buffer).
- (unless (eobp)
- (python-end-of-block)
- ;; Count trailing space in defun (but not trailing comments).
- (skip-syntax-forward " >")
- (unless (eobp) ; e.g. missing final newline
- (beginning-of-line)))
- ;; Catch pathological cases like this, where the beginning-of-defun
- ;; skips to a definition we're not in:
- ;; if ...:
- ;; ...
- ;; else:
- ;; ... # point here
- ;; ...
- ;; def ...
- (if (< (point) orig)
- (goto-char (point-max)))))
-
-(defun python-beginning-of-statement ()
- "Go to start of current statement.
-Accounts for continuation lines, multi-line strings, and
-multi-line bracketed expressions."
- (while
- (if (python-backslash-continuation-line-p)
- (progn (forward-line -1) t)
- (beginning-of-line)
- (or (python-beginning-of-string)
- (python-skip-out))))
- (back-to-indentation))
-
-(defun python-skip-out (&optional forward syntax)
- "Skip out of any nested brackets.
-Skip forward if FORWARD is non-nil, else backward.
-If SYNTAX is non-nil it is the state returned by `syntax-ppss' at point.
-Return non-nil if and only if skipping was done."
- ;; FIXME: Use syntax-ppss-toplevel-pos.
- (let ((depth (syntax-ppss-depth (or syntax (syntax-ppss))))
- (forward (if forward -1 1)))
- (unless (zerop depth)
- (if (> depth 0)
- ;; Skip forward out of nested brackets.
- (condition-case () ; beware invalid syntax
- (progn (backward-up-list (* forward depth)) t)
- (error nil))
- ;; Invalid syntax (too many closed brackets).
- ;; Skip out of as many as possible.
- (let (done)
- (while (condition-case ()
- (progn (backward-up-list forward)
- (setq done t))
- (error nil)))
- done)))))
-
-(defun python-end-of-statement ()
- "Go to the end of the current statement and return point.
-Usually this is the start of the next line, but if this is a
-multi-line statement we need to skip over the continuation lines.
-On a comment line, go to end of line."
- (end-of-line)
- (while (let (comment)
- ;; Move past any enclosing strings and sexps, or stop if
- ;; we're in a comment.
- (while (let ((s (syntax-ppss)))
- (cond ((eq 'comment (syntax-ppss-context s))
- (setq comment t)
- nil)
- ((eq 'string (syntax-ppss-context s))
- ;; Go to start of string and skip it.
- (let ((pos (point)))
- (goto-char (nth 8 s))
- (condition-case () ; beware invalid syntax
- (progn (forward-sexp) t)
- ;; If there's a mismatched string, make sure
- ;; we still overall move *forward*.
- (error (goto-char pos) (end-of-line)))))
- ((python-skip-out t s))))
- (end-of-line))
- (unless comment
- (eq ?\\ (char-before)))) ; Line continued?
- (end-of-line 2)) ; Try next line.
- (point))
-
-(defun python-previous-statement (&optional count)
- "Go to start of previous statement.
-With argument COUNT, do it COUNT times. Stop at beginning of buffer.
-Return count of statements left to move."
- (interactive "p")
- (unless count (setq count 1))
- (if (< count 0)
- (python-next-statement (- count))
- (python-beginning-of-statement)
- (while (and (> count 0) (not (bobp)))
- (python-skip-comments/blanks t)
- (python-beginning-of-statement)
- (unless (bobp) (setq count (1- count))))
- count))
-
-(defun python-next-statement (&optional count)
- "Go to start of next statement.
-With argument COUNT, do it COUNT times. Stop at end of buffer.
-Return count of statements left to move."
- (interactive "p")
- (unless count (setq count 1))
- (if (< count 0)
- (python-previous-statement (- count))
- (beginning-of-line)
- (let (bogus)
- (while (and (> count 0) (not (eobp)) (not bogus))
- (python-end-of-statement)
- (python-skip-comments/blanks)
- (if (eq 'string (syntax-ppss-context (syntax-ppss)))
- (setq bogus t)
- (unless (eobp)
- (setq count (1- count))))))
- count))
-
-(defun python-beginning-of-block (&optional arg)
- "Go to start of current block.
-With numeric arg, do it that many times. If ARG is negative, call
-`python-end-of-block' instead.
-If point is on the first line of a block, use its outer block.
-If current statement is in column zero, don't move and return nil.
-Otherwise return non-nil."
- (interactive "p")
- (unless arg (setq arg 1))
- (cond
- ((zerop arg))
- ((< arg 0) (python-end-of-block (- arg)))
- (t
- (let ((point (point)))
- (if (or (python-comment-line-p)
- (python-blank-line-p))
- (python-skip-comments/blanks t))
- (python-beginning-of-statement)
- (let ((ci (current-indentation)))
- (if (zerop ci)
- (not (goto-char point)) ; return nil
- ;; Look upwards for less indented statement.
- (if (catch 'done
-;;; This is slower than the below.
-;;; (while (zerop (python-previous-statement))
-;;; (when (and (< (current-indentation) ci)
-;;; (python-open-block-statement-p t))
-;;; (beginning-of-line)
-;;; (throw 'done t)))
- (while (and (zerop (forward-line -1)))
- (when (and (< (current-indentation) ci)
- (not (python-comment-line-p))
- ;; Move to beginning to save effort in case
- ;; this is in string.
- (progn (python-beginning-of-statement) t)
- (python-open-block-statement-p t))
- (beginning-of-line)
- (throw 'done t)))
- (not (goto-char point))) ; Failed -- return nil
- (python-beginning-of-block (1- arg)))))))))
-
-(defun python-end-of-block (&optional arg)
- "Go to end of current block.
-With numeric arg, do it that many times. If ARG is negative,
-call `python-beginning-of-block' instead.
-If current statement is in column zero and doesn't open a block,
-don't move and return nil. Otherwise return t."
- (interactive "p")
- (unless arg (setq arg 1))
- (if (< arg 0)
- (python-beginning-of-block (- arg))
- (while (and (> arg 0)
- (let* ((point (point))
- (_ (if (python-comment-line-p)
- (python-skip-comments/blanks t)))
- (ci (current-indentation))
- (open (python-open-block-statement-p)))
- (if (and (zerop ci) (not open))
- (not (goto-char point))
- (catch 'done
- (while (zerop (python-next-statement))
- (when (or (and open (<= (current-indentation) ci))
- (< (current-indentation) ci))
- (python-skip-comments/blanks t)
- (beginning-of-line 2)
- (throw 'done t)))))))
+(defun python-nav-end-of-defun ()
+ "Move point to the end of def or class.
+Returns nil if point is not in a def or class."
+ (interactive)
+ (let ((beg-defun-indent)
+ (beg-pos (point)))
+ (when (or (python-info-looking-at-beginning-of-defun)
+ (python-nav-beginning-of-defun 1)
+ (python-nav-beginning-of-defun -1))
+ (setq beg-defun-indent (current-indentation))
+ (while (progn
+ (python-nav-end-of-statement)
+ (python-util-forward-comment 1)
+ (and (> (current-indentation) beg-defun-indent)
+ (not (eobp)))))
+ (python-util-forward-comment -1)
+ (forward-line 1)
+ ;; Ensure point moves forward.
+ (and (> beg-pos (point)) (goto-char beg-pos)))))
+
+(defun python-nav-beginning-of-statement ()
+ "Move to start of current statement."
+ (interactive "^")
+ (while (and (or (back-to-indentation) t)
+ (not (bobp))
+ (when (or
+ (save-excursion
+ (forward-line -1)
+ (python-info-line-ends-backslash-p))
+ (python-syntax-context 'string)
+ (python-syntax-context 'paren))
+ (forward-line -1))))
+ (point-marker))
+
+(defun python-nav-end-of-statement ()
+ "Move to end of current statement."
+ (interactive "^")
+ (while (and (goto-char (line-end-position))
+ (not (eobp))
+ (when (or
+ (python-info-line-ends-backslash-p)
+ (python-syntax-context 'string)
+ (python-syntax-context 'paren))
+ (forward-line 1))))
+ (point-marker))
+
+(defun python-nav-backward-statement (&optional arg)
+ "Move backward to previous statement.
+With ARG, repeat. See `python-nav-forward-statement'."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (python-nav-forward-statement (- arg)))
+
+(defun python-nav-forward-statement (&optional arg)
+ "Move forward to next statement.
+With ARG, repeat. With negative argument, move ARG times
+backward to previous statement."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (while (> arg 0)
+ (python-nav-end-of-statement)
+ (python-util-forward-comment)
+ (python-nav-beginning-of-statement)
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (python-nav-beginning-of-statement)
+ (python-util-forward-comment -1)
+ (python-nav-beginning-of-statement)
+ (setq arg (1+ arg))))
+
+(defun python-nav-beginning-of-block ()
+ "Move to start of current block."
+ (interactive "^")
+ (let ((starting-pos (point))
+ (block-regexp (python-rx
+ line-start (* whitespace) block-start)))
+ (if (progn
+ (python-nav-beginning-of-statement)
+ (looking-at (python-rx block-start)))
+ (point-marker)
+ ;; Go to first line beginning a statement
+ (while (and (not (bobp))
+ (or (and (python-nav-beginning-of-statement) nil)
+ (python-info-current-line-comment-p)
+ (python-info-current-line-empty-p)))
+ (forward-line -1))
+ (let ((block-matching-indent
+ (- (current-indentation) python-indent-offset)))
+ (while
+ (and (python-nav-backward-block)
+ (> (current-indentation) block-matching-indent)))
+ (if (and (looking-at (python-rx block-start))
+ (= (current-indentation) block-matching-indent))
+ (point-marker)
+ (and (goto-char starting-pos) nil))))))
+
+(defun python-nav-end-of-block ()
+ "Move to end of current block."
+ (interactive "^")
+ (when (python-nav-beginning-of-block)
+ (let ((block-indentation (current-indentation)))
+ (python-nav-end-of-statement)
+ (while (and (forward-line 1)
+ (not (eobp))
+ (or (and (> (current-indentation) block-indentation)
+ (or (python-nav-end-of-statement) t))
+ (python-info-current-line-comment-p)
+ (python-info-current-line-empty-p))))
+ (python-util-forward-comment -1)
+ (point-marker))))
+
+(defun python-nav-backward-block (&optional arg)
+ "Move backward to previous block of code.
+With ARG, repeat. See `python-nav-forward-block'."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (python-nav-forward-block (- arg)))
+
+(defun python-nav-forward-block (&optional arg)
+ "Move forward to next block of code.
+With ARG, repeat. With negative argument, move ARG times
+backward to previous block."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (let ((block-start-regexp
+ (python-rx line-start (* whitespace) block-start))
+ (starting-pos (point)))
+ (while (> arg 0)
+ (python-nav-end-of-statement)
+ (while (and
+ (re-search-forward block-start-regexp nil t)
+ (python-syntax-context-type)))
(setq arg (1- arg)))
- (zerop arg)))
+ (while (< arg 0)
+ (python-nav-beginning-of-statement)
+ (while (and
+ (re-search-backward block-start-regexp nil t)
+ (python-syntax-context-type)))
+ (setq arg (1+ arg)))
+ (python-nav-beginning-of-statement)
+ (if (not (looking-at (python-rx block-start)))
+ (and (goto-char starting-pos) nil)
+ (and (not (= (point) starting-pos)) (point-marker)))))
+
+(defun python-nav-lisp-forward-sexp-safe (&optional arg)
+ "Safe version of standard `forward-sexp'.
+When ARG > 0 move forward, else if ARG is < 0."
+ (or arg (setq arg 1))
+ (let ((forward-sexp-function nil)
+ (paren-regexp
+ (if (> arg 0) (python-rx close-paren) (python-rx open-paren)))
+ (search-fn
+ (if (> arg 0) #'re-search-forward #'re-search-backward)))
+ (condition-case nil
+ (forward-sexp arg)
+ (error
+ (while (and (funcall search-fn paren-regexp nil t)
+ (python-syntax-context 'paren)))))))
+
+(defun python-nav--forward-sexp (&optional dir)
+ "Move to forward sexp.
+With positive Optional argument DIR direction move forward, else
+backwards."
+ (setq dir (or dir 1))
+ (unless (= dir 0)
+ (let* ((forward-p (if (> dir 0)
+ (and (setq dir 1) t)
+ (and (setq dir -1) nil)))
+ (re-search-fn (if forward-p
+ 're-search-forward
+ 're-search-backward))
+ (context-type (python-syntax-context-type)))
+ (cond
+ ((eq context-type 'string)
+ ;; Inside of a string, get out of it.
+ (while (and (funcall re-search-fn "[\"']" nil t)
+ (python-syntax-context 'string))))
+ ((eq context-type 'comment)
+ ;; Inside of a comment, just move forward.
+ (python-util-forward-comment dir))
+ ((or (eq context-type 'paren)
+ (and forward-p (looking-at (python-rx open-paren)))
+ (and (not forward-p)
+ (eq (syntax-class (syntax-after (1- (point))))
+ (car (string-to-syntax ")")))))
+ ;; Inside a paren or looking at it, lisp knows what to do.
+ (python-nav-lisp-forward-sexp-safe dir))
+ (t
+ ;; This part handles the lispy feel of
+ ;; `python-nav-forward-sexp'. Knowing everything about the
+ ;; current context and the context of the next sexp tries to
+ ;; follow the lisp sexp motion commands in a symmetric manner.
+ (let* ((context
+ (cond
+ ((python-info-beginning-of-block-p) 'block-start)
+ ((python-info-end-of-block-p) 'block-end)
+ ((python-info-beginning-of-statement-p) 'statement-start)
+ ((python-info-end-of-statement-p) 'statement-end)))
+ (next-sexp-pos
+ (save-excursion
+ (python-nav-lisp-forward-sexp-safe dir)
+ (point)))
+ (next-sexp-context
+ (save-excursion
+ (goto-char next-sexp-pos)
+ (cond
+ ((python-info-beginning-of-block-p) 'block-start)
+ ((python-info-end-of-block-p) 'block-end)
+ ((python-info-beginning-of-statement-p) 'statement-start)
+ ((python-info-end-of-statement-p) 'statement-end)
+ ((python-info-statement-starts-block-p) 'starts-block)
+ ((python-info-statement-ends-block-p) 'ends-block)))))
+ (if forward-p
+ (cond ((and (not (eobp))
+ (python-info-current-line-empty-p))
+ (python-util-forward-comment dir)
+ (python-nav--forward-sexp dir))
+ ((eq context 'block-start)
+ (python-nav-end-of-block))
+ ((eq context 'statement-start)
+ (python-nav-end-of-statement))
+ ((and (memq context '(statement-end block-end))
+ (eq next-sexp-context 'ends-block))
+ (goto-char next-sexp-pos)
+ (python-nav-end-of-block))
+ ((and (memq context '(statement-end block-end))
+ (eq next-sexp-context 'starts-block))
+ (goto-char next-sexp-pos)
+ (python-nav-end-of-block))
+ ((memq context '(statement-end block-end))
+ (goto-char next-sexp-pos)
+ (python-nav-end-of-statement))
+ (t (goto-char next-sexp-pos)))
+ (cond ((and (not (bobp))
+ (python-info-current-line-empty-p))
+ (python-util-forward-comment dir)
+ (python-nav--forward-sexp dir))
+ ((eq context 'block-end)
+ (python-nav-beginning-of-block))
+ ((eq context 'statement-end)
+ (python-nav-beginning-of-statement))
+ ((and (memq context '(statement-start block-start))
+ (eq next-sexp-context 'starts-block))
+ (goto-char next-sexp-pos)
+ (python-nav-beginning-of-block))
+ ((and (memq context '(statement-start block-start))
+ (eq next-sexp-context 'ends-block))
+ (goto-char next-sexp-pos)
+ (python-nav-beginning-of-block))
+ ((memq context '(statement-start block-start))
+ (goto-char next-sexp-pos)
+ (python-nav-beginning-of-statement))
+ (t (goto-char next-sexp-pos))))))))))
+
+(defun python-nav--backward-sexp ()
+ "Move to backward sexp."
+ (python-nav--forward-sexp -1))
+
+(defun python-nav-forward-sexp (&optional arg)
+ "Move forward across one block of code.
+With ARG, do it that many times. Negative arg -N means
+move backward N times."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (while (> arg 0)
+ (python-nav--forward-sexp)
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (python-nav--backward-sexp)
+ (setq arg (1+ arg))))
+
+(defun python-nav--up-list (&optional dir)
+ "Internal implementation of `python-nav-up-list'.
+DIR is always 1 or -1 and comes sanitized from
+`python-nav-up-list' calls."
+ (let ((context (python-syntax-context-type))
+ (forward-p (> dir 0)))
+ (cond
+ ((memq context '(string comment)))
+ ((eq context 'paren)
+ (let ((forward-sexp-function))
+ (up-list dir)))
+ ((and forward-p (python-info-end-of-block-p))
+ (let ((parent-end-pos
+ (save-excursion
+ (let ((indentation (and
+ (python-nav-beginning-of-block)
+ (current-indentation))))
+ (while (and indentation
+ (> indentation 0)
+ (>= (current-indentation) indentation)
+ (python-nav-backward-block)))
+ (python-nav-end-of-block)))))
+ (and (> (or parent-end-pos (point)) (point))
+ (goto-char parent-end-pos))))
+ (forward-p (python-nav-end-of-block))
+ ((and (not forward-p)
+ (> (current-indentation) 0)
+ (python-info-beginning-of-block-p))
+ (let ((prev-block-pos
+ (save-excursion
+ (let ((indentation (current-indentation)))
+ (while (and (python-nav-backward-block)
+ (>= (current-indentation) indentation))))
+ (point))))
+ (and (> (point) prev-block-pos)
+ (goto-char prev-block-pos))))
+ ((not forward-p) (python-nav-beginning-of-block)))))
+
+(defun python-nav-up-list (&optional arg)
+ "Move forward out of one level of parentheses (or blocks).
+With ARG, do this that many times.
+A negative argument means move backward but still to a less deep spot.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (while (> arg 0)
+ (python-nav--up-list 1)
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (python-nav--up-list -1)
+ (setq arg (1+ arg))))
+
+(defun python-nav-backward-up-list (&optional arg)
+ "Move backward out of one level of parentheses (or blocks).
+With ARG, do this that many times.
+A negative argument means move backward but still to a less deep spot.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (python-nav-up-list (- arg)))
-(defvar python-which-func-length-limit 40
- "Non-strict length limit for `python-which-func' output.")
+
+;;; Shell integration
-(defun python-which-func ()
- (let ((function-name (python-current-defun python-which-func-length-limit)))
- (set-text-properties 0 (length function-name) nil function-name)
- function-name))
+(defcustom python-shell-buffer-name "Python"
+ "Default buffer name for Python interpreter."
+ :type 'string
+ :group 'python
+ :safe 'stringp)
-
-;;;; Imenu.
-
-;; For possibly speeding this up, here's the top of the ELP profile
-;; for rescanning pydoc.py (2.2k lines, 90kb):
-;; Function Name Call Count Elapsed Time Average Time
-;; ==================================== ========== ============= ============
-;; python-imenu-create-index 156 2.430906 0.0155827307
-;; python-end-of-defun 155 1.2718260000 0.0082053290
-;; python-end-of-block 155 1.1898689999 0.0076765741
-;; python-next-statement 2970 1.024717 0.0003450225
-;; python-end-of-statement 2970 0.4332190000 0.0001458649
-;; python-beginning-of-defun 265 0.0918479999 0.0003465962
-;; python-skip-comments/blanks 3125 0.0753319999 2.410...e-05
-
-(defvar python-recursing)
-(defun python-imenu-create-index ()
- "`imenu-create-index-function' for Python.
-
-Makes nested Imenu menus from nested `class' and `def' statements.
-The nested menus are headed by an item referencing the outer
-definition; it has a space prepended to the name so that it sorts
-first with `imenu--sort-by-name' (though, unfortunately, sub-menus
-precede it)."
- (unless (boundp 'python-recursing) ; dynamically bound below
- ;; Normal call from Imenu.
- (goto-char (point-min))
- ;; Without this, we can get an infloop if the buffer isn't all
- ;; fontified. I guess this is really a bug in syntax.el. OTOH,
- ;; _with_ this, imenu doesn't immediately work; I can't figure out
- ;; what's going on, but it must be something to do with timers in
- ;; font-lock.
- ;; This can't be right, especially not when jit-lock is not used. --Stef
- ;; (unless (get-text-property (1- (point-max)) 'fontified)
- ;; (font-lock-fontify-region (point-min) (point-max)))
- )
- (let (index-alist) ; accumulated value to return
- (while (re-search-forward
- (rx line-start (0+ space) ; leading space
- (or (group "def") (group "class")) ; type
- (1+ space) (group (1+ (or word ?_)))) ; name
- nil t)
- (unless (python-in-string/comment)
- (let ((pos (match-beginning 0))
- (name (match-string-no-properties 3)))
- (if (match-beginning 2) ; def or class?
- (setq name (concat "class " name)))
- (save-restriction
- (narrow-to-defun)
- (let* ((python-recursing t)
- (sublist (python-imenu-create-index)))
- (if sublist
- (progn (push (cons (concat " " name) pos) sublist)
- (push (cons name sublist) index-alist))
- (push (cons name pos) index-alist)))))))
- (unless (boundp 'python-recursing)
- ;; Look for module variables.
- (let (vars)
- (goto-char (point-min))
- (while (re-search-forward
- (rx line-start (group (1+ (or word ?_))) (0+ space) "=")
- nil t)
- (unless (python-in-string/comment)
- (push (cons (match-string 1) (match-beginning 1))
- vars)))
- (setq index-alist (nreverse index-alist))
- (if vars
- (push (cons "Module variables"
- (nreverse vars))
- index-alist))))
- index-alist))
-
-;;;; `Electric' commands.
+(defcustom python-shell-interpreter "python"
+ "Default Python interpreter for shell."
+ :type 'string
+ :group 'python)
-(defun python-electric-colon (arg)
- "Insert a colon and maybe outdent the line if it is a statement like `else'.
-With numeric ARG, just insert that many colons. With \\[universal-argument],
-just insert a single colon."
- (interactive "*P")
- (self-insert-command (if (not (integerp arg)) 1 arg))
- (and (not arg)
- (eolp)
- (python-outdent-p)
- (not (python-in-string/comment))
- (> (current-indentation) (python-calculate-indentation))
- (python-indent-line))) ; OK, do it
-(put 'python-electric-colon 'delete-selection t)
-
-(defun python-backspace (arg)
- "Maybe delete a level of indentation on the current line.
-Do so if point is at the end of the line's indentation outside
-strings and comments.
-Otherwise just call `backward-delete-char-untabify'.
-Repeat ARG times."
- (interactive "*p")
- (if (or (/= (current-indentation) (current-column))
- (bolp)
- (python-continuation-line-p)
- (python-in-string/comment))
- (backward-delete-char-untabify arg)
- ;; Look for the largest valid indentation which is smaller than
- ;; the current indentation.
- (let ((indent 0)
- (ci (current-indentation))
- (indents (python-indentation-levels))
- initial)
- (dolist (x indents)
- (if (< (car x) ci)
- (setq indent (max indent (car x)))))
- (setq initial (cdr (assq indent indents)))
- (if (> (length initial) 0)
- (message "Closes %s" initial))
- (delete-horizontal-space)
- (indent-to indent))))
-(put 'python-backspace 'delete-selection 'supersede)
-
-;;;; pychecker
+(defcustom python-shell-internal-buffer-name "Python Internal"
+ "Default buffer name for the Internal Python interpreter."
+ :type 'string
+ :group 'python
+ :safe 'stringp)
-(defcustom python-check-command "pychecker --stdlib"
- "Command used to check a Python file."
+(defcustom python-shell-interpreter-args "-i"
+ "Default arguments for the Python interpreter."
:type 'string
:group 'python)
-(defvar python-saved-check-command nil
- "Internal use.")
+(defcustom python-shell-prompt-regexp ">>> "
+ "Regular Expression matching top\-level input prompt of python shell.
+It should not contain a caret (^) at the beginning."
+ :type 'string
+ :group 'python
+ :safe 'stringp)
-;; After `sgml-validate-command'.
-(defun python-check (command)
- "Check a Python file (default current buffer's file).
-Runs COMMAND, a shell command, as if by `compile'.
-See `python-check-command' for the default."
- (interactive
- (list (read-string "Checker command: "
- (or python-saved-check-command
- (concat python-check-command " "
- (let ((name (buffer-file-name)))
- (if name
- (file-name-nondirectory name))))))))
- (set (make-local-variable 'python-saved-check-command) command)
- (require 'compile) ;To define compilation-* variables.
- (save-some-buffers (not compilation-ask-about-save) nil)
- (let ((compilation-error-regexp-alist
- (cons '("(\\([^,]+\\), line \\([0-9]+\\))" 1 2)
- compilation-error-regexp-alist)))
- (compilation-start command)))
-
-;;;; Inferior mode stuff (following cmuscheme).
+(defcustom python-shell-prompt-block-regexp "[.][.][.] "
+ "Regular Expression matching block input prompt of python shell.
+It should not contain a caret (^) at the beginning."
+ :type 'string
+ :group 'python
+ :safe 'stringp)
+
+(defcustom python-shell-prompt-output-regexp ""
+ "Regular Expression matching output prompt of python shell.
+It should not contain a caret (^) at the beginning."
+ :type 'string
+ :group 'python
+ :safe 'stringp)
-(defcustom python-python-command "python"
- "Shell command to run Python interpreter.
-Any arguments can't contain whitespace."
+(defcustom python-shell-prompt-pdb-regexp "[(<]*[Ii]?[Pp]db[>)]+ "
+ "Regular Expression matching pdb input prompt of python shell.
+It should not contain a caret (^) at the beginning."
+ :type 'string
:group 'python
- :type 'string)
+ :safe 'stringp)
-(defcustom python-jython-command "jython"
- "Shell command to run Jython interpreter.
-Any arguments can't contain whitespace."
+(defcustom python-shell-enable-font-lock t
+ "Should syntax highlighting be enabled in the python shell buffer?
+Restart the python shell after changing this variable for it to take effect."
+ :type 'boolean
+ :group 'python
+ :safe 'booleanp)
+
+(defcustom python-shell-process-environment nil
+ "List of environment variables for Python shell.
+This variable follows the same rules as `process-environment'
+since it merges with it before the process creation routines are
+called. When this variable is nil, the Python shell is run with
+the default `process-environment'."
+ :type '(repeat string)
+ :group 'python
+ :safe 'listp)
+
+(defcustom python-shell-extra-pythonpaths nil
+ "List of extra pythonpaths for Python shell.
+The values of this variable are added to the existing value of
+PYTHONPATH in the `process-environment' variable."
+ :type '(repeat string)
+ :group 'python
+ :safe 'listp)
+
+(defcustom python-shell-exec-path nil
+ "List of path to search for binaries.
+This variable follows the same rules as `exec-path' since it
+merges with it before the process creation routines are called.
+When this variable is nil, the Python shell is run with the
+default `exec-path'."
+ :type '(repeat string)
+ :group 'python
+ :safe 'listp)
+
+(defcustom python-shell-virtualenv-path nil
+ "Path to virtualenv root.
+This variable, when set to a string, makes the values stored in
+`python-shell-process-environment' and `python-shell-exec-path'
+to be modified properly so shells are started with the specified
+virtualenv."
+ :type 'string
:group 'python
- :type 'string)
-
-(defvar python-command python-python-command
- "Actual command used to run Python.
-May be `python-python-command' or `python-jython-command', possibly
-modified by the user. Additional arguments are added when the command
-is used by `run-python' et al.")
-
-(defvar python-buffer nil
- "*The current Python process buffer.
-
-Commands that send text from source buffers to Python processes have
-to choose a process to send to. This is determined by buffer-local
-value of `python-buffer'. If its value in the current buffer,
-i.e. both any local value and the default one, is nil, `run-python'
-and commands that send to the Python process will start a new process.
-
-Whenever \\[run-python] starts a new process, it resets the default
-value of `python-buffer' to be the new process's buffer and sets the
-buffer-local value similarly if the current buffer is in Python mode
-or Inferior Python mode, so that source buffer stays associated with a
-specific sub-process.
-
-Use \\[python-set-proc] to set the default value from a buffer with a
-local value.")
-(make-variable-buffer-local 'python-buffer)
-
-(defconst python-compilation-regexp-alist
- ;; FIXME: maybe these should move to compilation-error-regexp-alist-alist.
- ;; The first already is (for CAML), but the second isn't. Anyhow,
- ;; these are specific to the inferior buffer. -- fx
+ :safe 'stringp)
+
+(defcustom python-shell-setup-codes '(python-shell-completion-setup-code
+ python-ffap-setup-code
+ python-eldoc-setup-code)
+ "List of code run by `python-shell-send-setup-codes'."
+ :type '(repeat symbol)
+ :group 'python
+ :safe 'listp)
+
+(defcustom python-shell-compilation-regexp-alist
`((,(rx line-start (1+ (any " \t")) "File \""
- (group (1+ (not (any "\"<")))) ; avoid `<stdin>' &c
- "\", line " (group (1+ digit)))
+ (group (1+ (not (any "\"<")))) ; avoid `<stdin>' &c
+ "\", line " (group (1+ digit)))
1 2)
(,(rx " in file " (group (1+ not-newline)) " on line "
- (group (1+ digit)))
+ (group (1+ digit)))
1 2)
- ;; pdb stack trace
(,(rx line-start "> " (group (1+ (not (any "(\"<"))))
- "(" (group (1+ digit)) ")" (1+ (not (any "("))) "()")
+ "(" (group (1+ digit)) ")" (1+ (not (any "("))) "()")
1 2))
- "`compilation-error-regexp-alist' for inferior Python.")
+ "`compilation-error-regexp-alist' for inferior Python."
+ :type '(alist string)
+ :group 'python)
+
+(defun python-shell-get-process-name (dedicated)
+ "Calculate the appropriate process name for inferior Python process.
+If DEDICATED is t and the variable `buffer-file-name' is non-nil
+returns a string with the form
+`python-shell-buffer-name'[variable `buffer-file-name'] else
+returns the value of `python-shell-buffer-name'."
+ (let ((process-name
+ (if (and dedicated
+ buffer-file-name)
+ (format "%s[%s]" python-shell-buffer-name buffer-file-name)
+ (format "%s" python-shell-buffer-name))))
+ process-name))
+
+(defun python-shell-internal-get-process-name ()
+ "Calculate the appropriate process name for Internal Python process.
+The name is calculated from `python-shell-global-buffer-name' and
+a hash of all relevant global shell settings in order to ensure
+uniqueness for different types of configurations."
+ (format "%s [%s]"
+ python-shell-internal-buffer-name
+ (md5
+ (concat
+ (python-shell-parse-command)
+ python-shell-prompt-regexp
+ python-shell-prompt-block-regexp
+ python-shell-prompt-output-regexp
+ (mapconcat #'symbol-value python-shell-setup-codes "")
+ (mapconcat #'identity python-shell-process-environment "")
+ (mapconcat #'identity python-shell-extra-pythonpaths "")
+ (mapconcat #'identity python-shell-exec-path "")
+ (or python-shell-virtualenv-path "")
+ (mapconcat #'identity python-shell-exec-path "")))))
+
+(defun python-shell-parse-command ()
+ "Calculate the string used to execute the inferior Python process."
+ (format "%s %s" python-shell-interpreter python-shell-interpreter-args))
+
+(defun python-shell-calculate-process-environment ()
+ "Calculate process environment given `python-shell-virtualenv-path'."
+ (let ((process-environment (append
+ python-shell-process-environment
+ process-environment nil))
+ (virtualenv (if python-shell-virtualenv-path
+ (directory-file-name python-shell-virtualenv-path)
+ nil)))
+ (when python-shell-extra-pythonpaths
+ (setenv "PYTHONPATH"
+ (format "%s%s%s"
+ (mapconcat 'identity
+ python-shell-extra-pythonpaths
+ path-separator)
+ path-separator
+ (or (getenv "PYTHONPATH") ""))))
+ (if (not virtualenv)
+ process-environment
+ (setenv "PYTHONHOME" nil)
+ (setenv "PATH" (format "%s/bin%s%s"
+ virtualenv path-separator
+ (or (getenv "PATH") "")))
+ (setenv "VIRTUAL_ENV" virtualenv))
+ process-environment))
+
+(defun python-shell-calculate-exec-path ()
+ "Calculate exec path given `python-shell-virtualenv-path'."
+ (let ((path (append python-shell-exec-path
+ exec-path nil)))
+ (if (not python-shell-virtualenv-path)
+ path
+ (cons (format "%s/bin"
+ (directory-file-name python-shell-virtualenv-path))
+ path))))
+
+(defun python-comint-output-filter-function (output)
+ "Hook run after content is put into comint buffer.
+OUTPUT is a string with the contents of the buffer."
+ (ansi-color-filter-apply output))
+
+(defvar python-shell--parent-buffer nil)
+
+(defvar python-shell-output-syntax-table
+ (let ((table (make-syntax-table python-dotty-syntax-table)))
+ (modify-syntax-entry ?\' "." table)
+ (modify-syntax-entry ?\" "." table)
+ (modify-syntax-entry ?\( "." table)
+ (modify-syntax-entry ?\[ "." table)
+ (modify-syntax-entry ?\{ "." table)
+ (modify-syntax-entry ?\) "." table)
+ (modify-syntax-entry ?\] "." table)
+ (modify-syntax-entry ?\} "." table)
+ table)
+ "Syntax table for shell output.
+It makes parens and quotes be treated as punctuation chars.")
-(defvar inferior-python-mode-map
- (let ((map (make-sparse-keymap)))
- ;; This will inherit from comint-mode-map.
- (define-key map "\C-c\C-l" 'python-load-file)
- (define-key map "\C-c\C-v" 'python-check)
- ;; Note that we _can_ still use these commands which send to the
- ;; Python process even at the prompt if we have a normal prompt,
- ;; i.e. '>>> ' and not '... '. See the comment before
- ;; python-send-region. Fixme: uncomment these if we address that.
-
- ;; (define-key map [(meta ?\t)] 'python-complete-symbol)
- ;; (define-key map "\C-c\C-f" 'python-describe-symbol)
- map))
-
-(defvar inferior-python-mode-syntax-table
- (let ((st (make-syntax-table python-mode-syntax-table)))
- ;; Don't get confused by apostrophes in the process's output (e.g. if
- ;; you execute "help(os)").
- (modify-syntax-entry ?\' "." st)
- ;; Maybe we should do the same for double quotes?
- ;; (modify-syntax-entry ?\" "." st)
- st))
-
-;; Autoloaded.
-(declare-function compilation-shell-minor-mode "compile" (&optional arg))
-
-(defvar python--prompt-regexp nil)
-
-(defun python--set-prompt-regexp ()
- (let ((prompt (cdr-safe (or (assoc python-python-command
- python-shell-prompt-alist)
- (assq t python-shell-prompt-alist))))
- (cprompt (cdr-safe (or (assoc python-python-command
- python-shell-continuation-prompt-alist)
- (assq t python-shell-continuation-prompt-alist)))))
- (set (make-local-variable 'comint-prompt-regexp)
- (concat "\\("
- (mapconcat 'identity
- (delq nil (list prompt cprompt "^([Pp]db) "))
- "\\|")
- "\\)"))
- (set (make-local-variable 'python--prompt-regexp) prompt)))
-
-;; Fixme: This should inherit some stuff from `python-mode', but I'm
-;; not sure how much: at least some keybindings, like C-c C-f;
-;; syntax?; font-locking, e.g. for triple-quoted strings?
(define-derived-mode inferior-python-mode comint-mode "Inferior Python"
- "Major mode for interacting with an inferior Python process.
-A Python process can be started with \\[run-python].
-
-Hooks `comint-mode-hook' and `inferior-python-mode-hook' are run in
-that order.
-
-You can send text to the inferior Python process from other buffers
-containing Python source.
- * \\[python-switch-to-python] switches the current buffer to the Python
- process buffer.
- * \\[python-send-region] sends the current region to the Python process.
- * \\[python-send-region-and-go] switches to the Python process buffer
- after sending the text.
-For running multiple processes in multiple buffers, see `run-python' and
-`python-buffer'.
-
-\\{inferior-python-mode-map}"
- :group 'python
- (require 'ansi-color) ; for ipython
+ "Major mode for Python inferior process.
+Runs a Python interpreter as a subprocess of Emacs, with Python
+I/O through an Emacs buffer. Variables
+`python-shell-interpreter' and `python-shell-interpreter-args'
+controls which Python interpreter is run. Variables
+`python-shell-prompt-regexp',
+`python-shell-prompt-output-regexp',
+`python-shell-prompt-block-regexp',
+`python-shell-enable-font-lock',
+`python-shell-completion-setup-code',
+`python-shell-completion-string-code',
+`python-shell-completion-module-string-code',
+`python-eldoc-setup-code', `python-eldoc-string-code',
+`python-ffap-setup-code' and `python-ffap-string-code' can
+customize this mode for different Python interpreters.
+
+You can also add additional setup code to be run at
+initialization of the interpreter via `python-shell-setup-codes'
+variable.
+
+\(Type \\[describe-mode] in the process buffer for a list of commands.)"
+ (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))
(setq mode-line-process '(":%s"))
- (set (make-local-variable 'comint-input-filter) 'python-input-filter)
- (add-hook 'comint-preoutput-filter-functions #'python-preoutput-filter
- nil t)
- (python--set-prompt-regexp)
+ (make-local-variable 'comint-output-filter-functions)
+ (add-hook 'comint-output-filter-functions
+ 'python-comint-output-filter-function)
+ (add-hook 'comint-output-filter-functions
+ 'python-pdbtrack-comint-output-filter-function)
(set (make-local-variable 'compilation-error-regexp-alist)
- python-compilation-regexp-alist)
+ python-shell-compilation-regexp-alist)
+ (define-key inferior-python-mode-map [remap complete-symbol]
+ 'completion-at-point)
+ (add-hook 'completion-at-point-functions
+ 'python-shell-completion-complete-at-point nil 'local)
+ (add-to-list (make-local-variable 'comint-dynamic-complete-functions)
+ 'python-shell-completion-complete-at-point)
+ (define-key inferior-python-mode-map "\t"
+ 'python-shell-completion-complete-or-indent)
+ (make-local-variable 'python-pdbtrack-buffers-to-kill)
+ (make-local-variable 'python-pdbtrack-tracked-buffer)
+ (make-local-variable 'python-shell-internal-last-output)
+ (when python-shell-enable-font-lock
+ (set-syntax-table python-mode-syntax-table)
+ (set (make-local-variable 'font-lock-defaults)
+ '(python-font-lock-keywords nil nil nil nil))
+ (set (make-local-variable 'syntax-propertize-function)
+ (eval
+ ;; XXX: Unfortunately eval is needed here to make use of the
+ ;; dynamic value of `comint-prompt-regexp'.
+ `(syntax-propertize-rules
+ (,comint-prompt-regexp
+ (0 (ignore
+ (put-text-property
+ comint-last-input-start end 'syntax-table
+ python-shell-output-syntax-table)
+ ;; XXX: This might look weird, but it is the easiest
+ ;; way to ensure font lock gets cleaned up before the
+ ;; current prompt, which is needed for unclosed
+ ;; strings to not mess up with current input.
+ (font-lock-unfontify-region comint-last-input-start end))))
+ (,(python-rx string-delimiter)
+ (0 (ignore
+ (and (not (eq (get-text-property start 'field) 'output))
+ (python-syntax-stringify)))))))))
(compilation-shell-minor-mode 1))
-(defcustom inferior-python-filter-regexp "\\`\\s-*\\S-?\\S-?\\s-*\\'"
- "Input matching this regexp is not saved on the history list.
-Default ignores all inputs of 0, 1, or 2 non-blank characters."
- :type 'regexp
- :group 'python)
-
-(defcustom python-remove-cwd-from-path t
- "Whether to allow loading of Python modules from the current directory.
-If this is non-nil, Emacs removes '' from sys.path when starting
-an inferior Python process. This is the default, for security
-reasons, as it is easy for the Python process to be started
-without the user's realization (e.g. to perform completion)."
- :type 'boolean
- :group 'python
- :version "23.3")
-
-(defun python-input-filter (str)
- "`comint-input-filter' function for inferior Python.
-Don't save anything for STR matching `inferior-python-filter-regexp'."
- (not (string-match inferior-python-filter-regexp str)))
-
-;; Fixme: Loses with quoted whitespace.
-(defun python-args-to-list (string)
- (let ((where (string-match "[ \t]" string)))
- (cond ((null where) (list string))
- ((not (= where 0))
- (cons (substring string 0 where)
- (python-args-to-list (substring string (+ 1 where)))))
- (t (let ((pos (string-match "[^ \t]" string)))
- (if pos (python-args-to-list (substring string pos))))))))
-
-(defvar python-preoutput-result nil
- "Data from last `_emacs_out' line seen by the preoutput filter.")
-
-(defvar python-preoutput-continuation nil
- "If non-nil, funcall this when `python-preoutput-filter' sees `_emacs_ok'.")
-
-(defvar python-preoutput-leftover nil)
-(defvar python-preoutput-skip-next-prompt nil)
-
-;; Using this stops us getting lines in the buffer like
-;; >>> ... ... >>>
-;; Also look for (and delete) an `_emacs_ok' string and call
-;; `python-preoutput-continuation' if we get it.
-(defun python-preoutput-filter (s)
- "`comint-preoutput-filter-functions' function: ignore prompts not at bol."
- (when python-preoutput-leftover
- (setq s (concat python-preoutput-leftover s))
- (setq python-preoutput-leftover nil))
- (let ((start 0)
- (res ""))
- ;; First process whole lines.
- (while (string-match "\n" s start)
- (let ((line (substring s start (setq start (match-end 0)))))
- ;; Skip prompt if needed.
- (when (and python-preoutput-skip-next-prompt
- (string-match comint-prompt-regexp line))
- (setq python-preoutput-skip-next-prompt nil)
- (setq line (substring line (match-end 0))))
- ;; Recognize special _emacs_out lines.
- (if (and (string-match "\\`_emacs_out \\(.*\\)\n\\'" line)
- (local-variable-p 'python-preoutput-result))
- (progn
- (setq python-preoutput-result (match-string 1 line))
- (set (make-local-variable 'python-preoutput-skip-next-prompt) t))
- (setq res (concat res line)))))
- ;; Then process the remaining partial line.
- (unless (zerop start) (setq s (substring s start)))
- (cond ((and (string-match comint-prompt-regexp s)
- ;; Drop this prompt if it follows an _emacs_out...
- (or python-preoutput-skip-next-prompt
- ;; ... or if it's not gonna be inserted at BOL.
- ;; Maybe we could be more selective here.
- (if (zerop (length res))
- (not (bolp))
- (string-match ".\\'" res))))
- ;; The need for this seems to be system-dependent:
- ;; What is this all about, exactly? --Stef
- ;; (if (and (eq ?. (aref s 0)))
- ;; (accept-process-output (get-buffer-process (current-buffer)) 1))
- (setq python-preoutput-skip-next-prompt nil)
- res)
- ((let ((end (min (length "_emacs_out ") (length s))))
- (eq t (compare-strings s nil end "_emacs_out " nil end)))
- ;; The leftover string is a prefix of _emacs_out so we don't know
- ;; yet whether it's an _emacs_out or something else: wait until we
- ;; get more output so we can resolve this ambiguity.
- (set (make-local-variable 'python-preoutput-leftover) s)
- res)
- (t (concat res s)))))
-
-(autoload 'comint-check-proc "comint")
-
-(defvar python-version-checked nil)
-(defun python-check-version (cmd)
- "Check that CMD runs a suitable version of Python."
- ;; Fixme: Check on Jython.
- (unless (or python-version-checked
- (equal 0 (string-match (regexp-quote python-python-command)
- cmd)))
- (unless (shell-command-to-string cmd)
- (error "Can't run Python command `%s'" cmd))
- (let* ((res (shell-command-to-string
- (concat cmd
- " -c \"from sys import version_info;\
-print version_info >= (2, 2) and version_info < (3, 0)\""))))
- (unless (string-match "True" res)
- (error "Only Python versions >= 2.2 and < 3.0 are supported")))
- (setq python-version-checked t)))
+(defun python-shell-make-comint (cmd proc-name &optional pop internal)
+ "Create a python shell comint buffer.
+CMD is the python command to be executed and PROC-NAME is the
+process name the comint buffer will get. After the comint buffer
+is created the `inferior-python-mode' is activated. When
+optional argument POP is non-nil the buffer is shown. When
+optional argument INTERNAL is non-nil this process is run on a
+buffer with a name that starts with a space, following the Emacs
+convention for temporary/internal buffers, and also makes sure
+the user is not queried for confirmation when the process is
+killed."
+ (save-excursion
+ (let* ((proc-buffer-name
+ (format (if (not internal) "*%s*" " *%s*") proc-name))
+ (process-environment (python-shell-calculate-process-environment))
+ (exec-path (python-shell-calculate-exec-path)))
+ (when (not (comint-check-proc proc-buffer-name))
+ (let* ((cmdlist (split-string-and-unquote cmd))
+ (buffer (apply #'make-comint-in-buffer proc-name proc-buffer-name
+ (car cmdlist) nil (cdr cmdlist)))
+ (python-shell--parent-buffer (current-buffer))
+ (process (get-buffer-process buffer)))
+ (with-current-buffer 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))))
+ proc-buffer-name)))
;;;###autoload
-(defun run-python (&optional cmd noshow new)
- "Run an inferior Python process, input and output via buffer *Python*.
-CMD is the Python command to run. NOSHOW non-nil means don't
-show the buffer automatically.
-
-Interactively, a prefix arg means to prompt for the initial
-Python command line (default is `python-command').
-
-A new process is started if one isn't running attached to
-`python-buffer', or if called from Lisp with non-nil arg NEW.
-Otherwise, if a process is already running in `python-buffer',
-switch to that buffer.
-
-This command runs the hook `inferior-python-mode-hook' after
-running `comint-mode-hook'. Type \\[describe-mode] in the
-process buffer for a list of commands.
-
-By default, Emacs inhibits the loading of Python modules from the
-current working directory, for security reasons. To disable this
-behavior, change `python-remove-cwd-from-path' to nil."
- (interactive (if current-prefix-arg
- (list (read-string "Run Python: " python-command) nil t)
- (list python-command)))
- (require 'ansi-color) ; for ipython
- (unless cmd (setq cmd python-command))
- (python-check-version cmd)
- (setq python-command cmd)
- ;; Fixme: Consider making `python-buffer' buffer-local as a buffer
- ;; (not a name) in Python buffers from which `run-python' &c is
- ;; invoked. Would support multiple processes better.
- (when (or new (not (comint-check-proc python-buffer)))
- (with-current-buffer
- (let* ((cmdlist
- (append (python-args-to-list cmd) '("-i")
- (if python-remove-cwd-from-path
- '("-c" "import sys; sys.path.remove('')"))))
- (path (getenv "PYTHONPATH"))
- (process-environment ; to import emacs.py
- (cons (concat "PYTHONPATH="
- (if path (concat path path-separator))
- data-directory)
- process-environment))
- ;; If we use a pipe, Unicode characters are not printed
- ;; correctly (Bug#5794) and IPython does not work at
- ;; all (Bug#5390).
- (process-connection-type t))
- (apply 'make-comint-in-buffer "Python"
- (generate-new-buffer "*Python*")
- (car cmdlist) nil (cdr cmdlist)))
- (setq-default python-buffer (current-buffer))
- (setq python-buffer (current-buffer))
- (accept-process-output (get-buffer-process python-buffer) 5)
- (inferior-python-mode)
- ;; Load function definitions we need.
- ;; Before the preoutput function was used, this was done via -c in
- ;; cmdlist, but that loses the banner and doesn't run the startup
- ;; file. The code might be inline here, but there's enough that it
- ;; seems worth putting in a separate file, and it's probably cleaner
- ;; to put it in a module.
- ;; Ensure we're at a prompt before doing anything else.
- (python-send-string "import emacs")
- ;; The following line was meant to ensure that we're at a prompt
- ;; before doing anything else. However, this can cause Emacs to
- ;; hang waiting for a response, if that Python function fails
- ;; (i.e. raises an exception).
- ;; (python-send-receive "print '_emacs_out ()'")
- ))
- (if (derived-mode-p 'python-mode)
- (setq python-buffer (default-value 'python-buffer))) ; buffer-local
- ;; Without this, help output goes into the inferior python buffer if
- ;; the process isn't already running.
- (sit-for 1 t) ;Should we use accept-process-output instead? --Stef
- (unless noshow (pop-to-buffer python-buffer t)))
-
-(defun python-send-command (command)
- "Like `python-send-string' but resets `compilation-shell-minor-mode'."
- (when (python-check-comint-prompt)
- (with-current-buffer (process-buffer (python-proc))
- (goto-char (point-max))
- (compilation-forget-errors)
- (python-send-string command)
- (setq compilation-last-buffer (current-buffer)))))
-
-(defun python-send-region (start end)
- "Send the region to the inferior Python process."
- ;; The region is evaluated from a temporary file. This avoids
- ;; problems with blank lines, which have different semantics
- ;; interactively and in files. It also saves the inferior process
- ;; buffer filling up with interpreter prompts. We need a Python
- ;; function to remove the temporary file when it has been evaluated
- ;; (though we could probably do it in Lisp with a Comint output
- ;; filter). This function also catches exceptions and truncates
- ;; tracebacks not to mention the frame of the function itself.
- ;;
- ;; The `compilation-shell-minor-mode' parsing takes care of relating
- ;; the reference to the temporary file to the source.
- ;;
- ;; Fixme: Write a `coding' header to the temp file if the region is
- ;; non-ASCII.
- (interactive "r")
- (let* ((f (make-temp-file "py"))
- (command
- ;; IPython puts the FakeModule module into __main__ so
- ;; emacs.eexecfile becomes useless.
- (if (string-match "^ipython" python-command)
- (format "execfile %S" f)
- (format "emacs.eexecfile(%S)" f)))
- (orig-start (copy-marker start)))
- (when (save-excursion
- (goto-char start)
- (/= 0 (current-indentation))) ; need dummy block
- (save-excursion
- (goto-char orig-start)
- ;; Wrong if we had indented code at buffer start.
- (set-marker orig-start (line-beginning-position 0)))
- (write-region "if True:\n" nil f nil 'nomsg))
- (write-region start end f t 'nomsg)
- (python-send-command command)
- (with-current-buffer (process-buffer (python-proc))
- ;; Tell compile.el to redirect error locations in file `f' to
- ;; positions past marker `orig-start'. It has to be done *after*
- ;; `python-send-command''s call to `compilation-forget-errors'.
- (compilation-fake-loc orig-start f))))
-
-(defun python-send-string (string)
- "Evaluate STRING in inferior Python process."
+(defun run-python (cmd &optional dedicated show)
+ "Run an inferior Python process.
+Input and output via buffer named after
+`python-shell-buffer-name'. If there is a process already
+running in that buffer, just switch to it.
+
+With argument, allows you to define CMD so you can edit the
+command used to call the interpreter and define DEDICATED, so a
+dedicated process for the current buffer is open. When numeric
+prefix arg is other than 0 or 4 do not SHOW.
+
+Runs the hook `inferior-python-mode-hook' (after the
+`comint-mode-hook' is run). \(Type \\[describe-mode] in the
+process buffer for a list of commands.)"
+ (interactive
+ (if current-prefix-arg
+ (list
+ (read-string "Run Python: " (python-shell-parse-command))
+ (y-or-n-p "Make dedicated process? ")
+ (= (prefix-numeric-value current-prefix-arg) 4))
+ (list (python-shell-parse-command) nil t)))
+ (python-shell-make-comint
+ cmd (python-shell-get-process-name dedicated) show)
+ dedicated)
+
+(defun run-python-internal ()
+ "Run an inferior Internal Python process.
+Input and output via buffer named after
+`python-shell-internal-buffer-name' and what
+`python-shell-internal-get-process-name' returns.
+
+This new kind of shell is intended to be used for generic
+communication related to defined configurations, the main
+difference with global or dedicated shells is that these ones are
+attached to a configuration, not a buffer. This means that can
+be used for example to retrieve the sys.path and other stuff,
+without messing with user shells. Note that
+`python-shell-enable-font-lock' and `inferior-python-mode-hook'
+are set to nil for these shells, so setup codes are not sent at
+startup."
+ (let ((python-shell-enable-font-lock nil)
+ (inferior-python-mode-hook nil))
+ (get-buffer-process
+ (python-shell-make-comint
+ (python-shell-parse-command)
+ (python-shell-internal-get-process-name) nil t))))
+
+(defun python-shell-get-process ()
+ "Get inferior Python process for current buffer and return it."
+ (let* ((dedicated-proc-name (python-shell-get-process-name t))
+ (dedicated-proc-buffer-name (format "*%s*" dedicated-proc-name))
+ (global-proc-name (python-shell-get-process-name nil))
+ (global-proc-buffer-name (format "*%s*" global-proc-name))
+ (dedicated-running (comint-check-proc dedicated-proc-buffer-name))
+ (global-running (comint-check-proc global-proc-buffer-name)))
+ ;; Always prefer dedicated
+ (get-buffer-process (or (and dedicated-running dedicated-proc-buffer-name)
+ (and global-running global-proc-buffer-name)))))
+
+(defun python-shell-get-or-create-process ()
+ "Get or create an inferior Python process for current buffer and return it."
+ (let* ((dedicated-proc-name (python-shell-get-process-name t))
+ (dedicated-proc-buffer-name (format "*%s*" dedicated-proc-name))
+ (global-proc-name (python-shell-get-process-name nil))
+ (global-proc-buffer-name (format "*%s*" global-proc-name))
+ (dedicated-running (comint-check-proc dedicated-proc-buffer-name))
+ (global-running (comint-check-proc global-proc-buffer-name))
+ (current-prefix-arg 16))
+ (when (and (not dedicated-running) (not global-running))
+ (if (call-interactively 'run-python)
+ (setq dedicated-running t)
+ (setq global-running t)))
+ ;; Always prefer dedicated
+ (get-buffer-process (if dedicated-running
+ dedicated-proc-buffer-name
+ global-proc-buffer-name))))
+
+(defvar python-shell-internal-buffer nil
+ "Current internal shell buffer for the current buffer.
+This is really not necessary at all for the code to work but it's
+there for compatibility with CEDET.")
+
+(defvar python-shell-internal-last-output nil
+ "Last output captured by the internal shell.
+This is really not necessary at all for the code to work but it's
+there for compatibility with CEDET.")
+
+(defun python-shell-internal-get-or-create-process ()
+ "Get or create an inferior Internal Python process."
+ (let* ((proc-name (python-shell-internal-get-process-name))
+ (proc-buffer-name (format " *%s*" proc-name)))
+ (when (not (process-live-p proc-name))
+ (run-python-internal)
+ (setq python-shell-internal-buffer proc-buffer-name)
+ ;; XXX: Why is this `sit-for' needed?
+ ;; `python-shell-make-comint' calls `accept-process-output'
+ ;; already but it is not helping to get proper output on
+ ;; 'gnu/linux when the internal shell process is not running and
+ ;; a call to `python-shell-internal-send-string' is issued.
+ (sit-for 0.1 t))
+ (get-buffer-process proc-buffer-name)))
+
+(define-obsolete-function-alias
+ 'python-proc 'python-shell-internal-get-or-create-process "24.3")
+
+(define-obsolete-variable-alias
+ 'python-buffer 'python-shell-internal-buffer "24.3")
+
+(define-obsolete-variable-alias
+ 'python-preoutput-result 'python-shell-internal-last-output "24.3")
+
+(defun python-shell-send-string (string &optional process msg)
+ "Send STRING to inferior Python PROCESS.
+When MSG is non-nil messages the first line of STRING."
(interactive "sPython command: ")
- (comint-send-string (python-proc) string)
- (unless (string-match "\n\\'" string)
- ;; Make sure the text is properly LF-terminated.
- (comint-send-string (python-proc) "\n"))
- (when (string-match "\n[ \t].*\n?\\'" string)
- ;; If the string contains a final indented line, add a second newline so
- ;; as to make sure we terminate the multiline instruction.
- (comint-send-string (python-proc) "\n")))
-
-(defun python-send-buffer ()
- "Send the current buffer to the inferior Python process."
- (interactive)
- (python-send-region (point-min) (point-max)))
+ (let ((process (or process (python-shell-get-or-create-process)))
+ (lines (split-string string "\n" t)))
+ (and msg (message "Sent: %s..." (nth 0 lines)))
+ (if (> (length lines) 1)
+ (let* ((temporary-file-directory
+ (if (file-remote-p default-directory)
+ (concat (file-remote-p default-directory) "/tmp")
+ temporary-file-directory))
+ (temp-file-name (make-temp-file "py"))
+ (file-name (or (buffer-file-name) temp-file-name)))
+ (with-temp-file temp-file-name
+ (insert string)
+ (delete-trailing-whitespace))
+ (python-shell-send-file file-name process temp-file-name))
+ (comint-send-string process string)
+ (when (or (not (string-match "\n$" 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
+ ;; XXX: It seems on OSX an extra carriage return is attached
+ ;; at the end of output, this handles that too.
+ (format "\r?\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 ((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)
+ (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)))))
+
+(defun python-shell-internal-send-string (string)
+ "Send STRING to the Internal Python interpreter.
+Returns the output. See `python-shell-send-string-no-output'."
+ ;; XXX Remove `python-shell-internal-last-output' once CEDET is
+ ;; updated to support this new mode.
+ (setq python-shell-internal-last-output
+ (python-shell-send-string-no-output
+ ;; Makes this function compatible with the old
+ ;; python-send-receive. (At least for CEDET).
+ (replace-regexp-in-string "_emacs_out +" "" string)
+ (python-shell-internal-get-or-create-process) nil)))
+
+(define-obsolete-function-alias
+ 'python-send-receive 'python-shell-internal-send-string "24.3")
+
+(define-obsolete-function-alias
+ 'python-send-string 'python-shell-internal-send-string "24.3")
+
+(defun python-shell-send-region (start end)
+ "Send the region delimited by START and END to inferior Python process."
+ (interactive "r")
+ (python-shell-send-string (buffer-substring start end) nil t))
-;; Fixme: Try to define the function or class within the relevant
-;; module, not just at top level.
-(defun python-send-defun ()
- "Send the current defun (class or method) to the inferior Python process."
+(defun python-shell-send-buffer (&optional arg)
+ "Send the entire buffer to inferior Python process.
+With prefix ARG allow execution of code inside blocks delimited
+by \"if __name__== '__main__':\""
+ (interactive "P")
+ (save-restriction
+ (widen)
+ (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.
+When argument ARG is non-nil do not include decorators."
+ (interactive "P")
+ (save-excursion
+ (python-shell-send-region
+ (progn
+ (end-of-line 1)
+ (while (and (or (python-nav-beginning-of-defun)
+ (beginning-of-line 1))
+ (> (current-indentation) 0)))
+ (when (not arg)
+ (while (and (forward-line -1)
+ (looking-at (python-rx decorator))))
+ (forward-line 1))
+ (point-marker))
+ (progn
+ (or (python-nav-end-of-defun)
+ (end-of-line 1))
+ (point-marker)))))
+
+(defun python-shell-send-file (file-name &optional process temp-file-name)
+ "Send FILE-NAME to inferior Python PROCESS.
+If TEMP-FILE-NAME is passed then that file is used for processing
+instead, while internally the shell will continue to use
+FILE-NAME."
+ (interactive "fFile to send: ")
+ (let* ((process (or process (python-shell-get-or-create-process)))
+ (temp-file-name (when temp-file-name
+ (expand-file-name
+ (or (file-remote-p temp-file-name 'localname)
+ temp-file-name))))
+ (file-name (or (when file-name
+ (expand-file-name
+ (or (file-remote-p file-name 'localname)
+ file-name)))
+ temp-file-name)))
+ (when (not file-name)
+ (error "If FILE-NAME is nil then TEMP-FILE-NAME must be non-nil"))
+ (python-shell-send-string
+ (format
+ (concat "__pyfile = open('''%s''');"
+ "exec(compile(__pyfile.read(), '''%s''', 'exec'));"
+ "__pyfile.close()")
+ (or temp-file-name file-name) file-name)
+ process)))
+
+(defun python-shell-switch-to-shell ()
+ "Switch to inferior Python process buffer."
(interactive)
- (save-excursion (python-send-region (progn (beginning-of-defun) (point))
- (progn (end-of-defun) (point)))))
+ (pop-to-buffer (process-buffer (python-shell-get-or-create-process)) t))
+
+(defun python-shell-send-setup-code ()
+ "Send all setup code for shell.
+This function takes the list of setup code to send from the
+`python-shell-setup-codes' list."
+ (let ((process (get-buffer-process (current-buffer))))
+ (dolist (code python-shell-setup-codes)
+ (when code
+ (message "Sent %s" code)
+ (python-shell-send-string
+ (symbol-value code) process)))))
+
+(add-hook 'inferior-python-mode-hook
+ #'python-shell-send-setup-code)
-(defun python-switch-to-python (eob-p)
- "Switch to the Python process buffer, maybe starting new process.
-With prefix arg, position cursor at end of buffer."
- (interactive "P")
- (pop-to-buffer (process-buffer (python-proc)) t) ;Runs python if needed.
- (when eob-p
- (push-mark)
- (goto-char (point-max))))
-
-(defun python-send-region-and-go (start end)
- "Send the region to the inferior Python process.
-Then switch to the process buffer."
- (interactive "r")
- (python-send-region start end)
- (python-switch-to-python t))
-
-(defcustom python-source-modes '(python-mode jython-mode)
- "Used to determine if a buffer contains Python source code.
-If a file is loaded into a buffer that is in one of these major modes,
-it is considered Python source by `python-load-file', which uses the
-value to determine defaults."
- :type '(repeat function)
+
+;;; Shell completion
+
+(defcustom python-shell-completion-setup-code
+ "try:
+ import readline
+except ImportError:
+ def __COMPLETER_all_completions(text): []
+else:
+ import rlcompleter
+ readline.set_completer(rlcompleter.Completer().complete)
+ def __COMPLETER_all_completions(text):
+ import sys
+ completions = []
+ try:
+ i = 0
+ while True:
+ res = readline.get_completer()(text, i)
+ if not res: break
+ i += 1
+ completions.append(res)
+ except NameError:
+ pass
+ return completions"
+ "Code used to setup completion in inferior Python processes."
+ :type 'string
:group 'python)
-(defvar python-prev-dir/file nil
- "Caches (directory . file) pair used in the last `python-load-file' command.
-Used for determining the default in the next one.")
-
-(autoload 'comint-get-source "comint")
-
-(defun python-load-file (file-name)
- "Load a Python file FILE-NAME into the inferior Python process.
-If the file has extension `.py' import or reload it as a module.
-Treating it as a module keeps the global namespace clean, provides
-function location information for debugging, and supports users of
-module-qualified names."
- (interactive (comint-get-source "Load Python file: " python-prev-dir/file
- python-source-modes
- t)) ; because execfile needs exact name
- (comint-check-source file-name) ; Check to see if buffer needs saving.
- (setq python-prev-dir/file (cons (file-name-directory file-name)
- (file-name-nondirectory file-name)))
- (with-current-buffer (process-buffer (python-proc)) ;Runs python if needed.
- ;; Fixme: I'm not convinced by this logic from python-mode.el.
- (python-send-command
- (if (string-match "\\.py\\'" file-name)
- (let ((module (file-name-sans-extension
- (file-name-nondirectory file-name))))
- (format "emacs.eimport(%S,%S)"
- module (file-name-directory file-name)))
- (format "execfile(%S)" file-name)))
- (message "%s loaded" file-name)))
-
-(defun python-proc ()
- "Return the current Python process.
-See variable `python-buffer'. Starts a new process if necessary."
- ;; Fixme: Maybe should look for another active process if there
- ;; isn't one for `python-buffer'.
- (unless (comint-check-proc python-buffer)
- (run-python nil t))
- (get-buffer-process (if (derived-mode-p 'inferior-python-mode)
- (current-buffer)
- python-buffer)))
-
-(defun python-set-proc ()
- "Set the default value of `python-buffer' to correspond to this buffer.
-If the current buffer has a local value of `python-buffer', set the
-default (global) value to that. The associated Python process is
-the one that gets input from \\[python-send-region] et al when used
-in a buffer that doesn't have a local value of `python-buffer'."
- (interactive)
- (if (local-variable-p 'python-buffer)
- (setq-default python-buffer python-buffer)
- (error "No local value of `python-buffer'")))
-
-;;;; Context-sensitive help.
+(defcustom python-shell-completion-string-code
+ "';'.join(__COMPLETER_all_completions('''%s'''))\n"
+ "Python code used to get a string of completions separated by semicolons."
+ :type 'string
+ :group 'python)
-(defconst python-dotty-syntax-table
- (let ((table (make-syntax-table)))
- (set-char-table-parent table python-mode-syntax-table)
- (modify-syntax-entry ?. "_" table)
- table)
- "Syntax table giving `.' symbol syntax.
-Otherwise inherits from `python-mode-syntax-table'.")
+(defcustom python-shell-completion-module-string-code ""
+ "Python code used to get completions separated by semicolons for imports.
-(defvar view-return-to-alist)
-(eval-when-compile (autoload 'help-buffer "help-fns"))
+For IPython v0.11, add the following line to
+`python-shell-completion-setup-code':
-(defvar python-imports) ; forward declaration
+from IPython.core.completerlib import module_completion
-;; Fixme: Should this actually be used instead of info-look, i.e. be
-;; bound to C-h S? [Probably not, since info-look may work in cases
-;; where this doesn't.]
-(defun python-describe-symbol (symbol)
- "Get help on SYMBOL using `help'.
-Interactively, prompt for symbol.
+and use the following as the value of this variable:
-Symbol may be anything recognized by the interpreter's `help'
-command -- e.g. `CALLS' -- not just variables in scope in the
-interpreter. This only works for Python version 2.2 or newer
-since earlier interpreters don't support `help'.
+';'.join(module_completion('''%s'''))\n"
+ :type 'string
+ :group 'python)
-In some cases where this doesn't find documentation, \\[info-lookup-symbol]
-will."
- ;; Note that we do this in the inferior process, not a separate one, to
- ;; ensure the environment is appropriate.
- (interactive
- (let ((symbol (with-syntax-table python-dotty-syntax-table
- (current-word)))
- (enable-recursive-minibuffers t))
- (list (read-string (if symbol
- (format "Describe symbol (default %s): " symbol)
- "Describe symbol: ")
- nil nil symbol))))
- (if (equal symbol "") (error "No symbol"))
- ;; Ensure we have a suitable help buffer.
- ;; Fixme: Maybe process `Related help topics' a la help xrefs and
- ;; allow C-c C-f in help buffer.
- (let ((temp-buffer-show-hook ; avoid xref stuff
- (lambda ()
- (toggle-read-only 1)
- (setq view-return-to-alist
- (list (cons (selected-window) help-return-method))))))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- ;; Fixme: Is this actually useful?
- (help-setup-xref (list 'python-describe-symbol symbol)
- (called-interactively-p 'interactive))
- (set (make-local-variable 'comint-redirect-subvert-readonly) t)
- (help-print-return-message))))
- (comint-redirect-send-command-to-process (format "emacs.ehelp(%S, %s)"
- symbol python-imports)
- "*Help*" (python-proc) nil nil))
-
-(add-to-list 'debug-ignored-errors "^No symbol")
-
-(defun python-send-receive (string)
- "Send STRING to inferior Python (if any) and return result.
-The result is what follows `_emacs_out' in the output.
-This is a no-op if `python-check-comint-prompt' returns nil."
- (python-send-string string)
- (let ((proc (python-proc)))
- (with-current-buffer (process-buffer proc)
- (when (python-check-comint-prompt proc)
- (set (make-local-variable 'python-preoutput-result) nil)
- (while (progn
- (accept-process-output proc 5)
- (null python-preoutput-result)))
- (prog1 python-preoutput-result
- (kill-local-variable 'python-preoutput-result))))))
-
-(defun python-check-comint-prompt (&optional proc)
- "Return non-nil if and only if there's a normal prompt in the inferior buffer.
-If there isn't, it's probably not appropriate to send input to return Eldoc
-information etc. If PROC is non-nil, check the buffer for that process."
- (with-current-buffer (process-buffer (or proc (python-proc)))
- (save-excursion
- (save-match-data
- (re-search-backward (concat python--prompt-regexp " *\\=")
- nil t)))))
+(defcustom python-shell-completion-pdb-string-code
+ "';'.join(globals().keys() + locals().keys())"
+ "Python code used to get completions separated by semicolons for [i]pdb."
+ :type 'string
+ :group 'python)
+
+(defun python-shell-completion-get-completions (process line input)
+ "Do completion at point for PROCESS.
+LINE is used to detect the context on how to complete given
+INPUT."
+ (let* ((prompt
+ ;; Get the last prompt for the inferior process
+ ;; buffer. This is used for the completion code selection
+ ;; heuristic.
+ (with-current-buffer (process-buffer process)
+ (buffer-substring-no-properties
+ (overlay-start comint-last-prompt-overlay)
+ (overlay-end comint-last-prompt-overlay))))
+ (completion-context
+ ;; Check whether a prompt matches a pdb string, an import
+ ;; statement or just the standard prompt and use the
+ ;; correct python-shell-completion-*-code string
+ (cond ((and (> (length python-shell-completion-pdb-string-code) 0)
+ (string-match
+ (concat "^" python-shell-prompt-pdb-regexp) prompt))
+ 'pdb)
+ ((and (>
+ (length python-shell-completion-module-string-code) 0)
+ (string-match
+ (concat "^" python-shell-prompt-regexp) prompt)
+ (string-match "^[ \t]*\\(from\\|import\\)[ \t]" line))
+ 'import)
+ ((string-match
+ (concat "^" python-shell-prompt-regexp) prompt)
+ 'default)
+ (t nil)))
+ (completion-code
+ (pcase completion-context
+ (`pdb python-shell-completion-pdb-string-code)
+ (`import python-shell-completion-module-string-code)
+ (`default python-shell-completion-string-code)
+ (_ nil)))
+ (input
+ (if (eq completion-context 'import)
+ (replace-regexp-in-string "^[ \t]+" "" line)
+ input)))
+ (and completion-code
+ (> (length input) 0)
+ (with-current-buffer (process-buffer process)
+ (let ((completions (python-shell-send-string-no-output
+ (format completion-code input) process)))
+ (and (> (length completions) 2)
+ (split-string completions
+ "^'\\|^\"\\|;\\|'$\\|\"$" t)))))))
+
+(defun python-shell-completion-complete-at-point (&optional process)
+ "Perform completion at point in inferior Python.
+Optional argument PROCESS forces completions to be retrieved
+using that one instead of current buffer's process."
+ (setq process (or process (get-buffer-process (current-buffer))))
+ (let* ((start
+ (save-excursion
+ (with-syntax-table python-dotty-syntax-table
+ (let* ((paren-depth (car (syntax-ppss)))
+ (syntax-string "w_")
+ (syntax-list (string-to-syntax syntax-string)))
+ ;; Stop scanning for the beginning of the completion
+ ;; subject after the char before point matches a
+ ;; delimiter
+ (while (member
+ (car (syntax-after (1- (point)))) syntax-list)
+ (skip-syntax-backward syntax-string)
+ (when (or (equal (char-before) ?\))
+ (equal (char-before) ?\"))
+ (forward-char -1))
+ (while (or
+ ;; honor initial paren depth
+ (> (car (syntax-ppss)) paren-depth)
+ (python-syntax-context 'string))
+ (forward-char -1)))
+ (point)))))
+ (end (point)))
+ (list start end
+ (completion-table-dynamic
+ (apply-partially
+ #'python-shell-completion-get-completions
+ process (buffer-substring-no-properties
+ (line-beginning-position) end))))))
+
+(defun python-shell-completion-complete-or-indent ()
+ "Complete or indent depending on the context.
+If content before pointer is all whitespace indent. If not try
+to complete."
+ (interactive)
+ (if (string-match "^[[:space:]]*$"
+ (buffer-substring (comint-line-beginning-position)
+ (point-marker)))
+ (indent-for-tab-command)
+ (completion-at-point)))
-;; Fixme: Is there anything reasonable we can do with random methods?
-;; (Currently only works with functions.)
-(defun python-eldoc-function ()
- "`eldoc-documentation-function' for Python.
-Only works when point is in a function name, not its arg list, for
-instance. Assumes an inferior Python is running."
- (let ((symbol (with-syntax-table python-dotty-syntax-table
- (current-word))))
- ;; This is run from timers, so inhibit-quit tends to be set.
- (with-local-quit
- ;; First try the symbol we're on.
- (or (and symbol
- (python-send-receive (format "emacs.eargs(%S, %s)"
- symbol python-imports)))
- ;; Try moving to symbol before enclosing parens.
- (let ((s (syntax-ppss)))
- (unless (zerop (car s))
- (when (eq ?\( (char-after (nth 1 s)))
- (save-excursion
- (goto-char (nth 1 s))
- (skip-syntax-backward "-")
- (let ((point (point)))
- (skip-chars-backward "a-zA-Z._")
- (if (< (point) point)
- (python-send-receive
- (format "emacs.eargs(%S, %s)"
- (buffer-substring-no-properties (point) point)
- python-imports))))))))))))
-;;;; Info-look functionality.
+;;; PDB Track integration
-(declare-function info-lookup-maybe-add-help "info-look" (&rest arg))
+(defcustom python-pdbtrack-activate t
+ "Non-nil makes python shell enable pdbtracking."
+ :type 'boolean
+ :group 'python
+ :safe 'booleanp)
+
+(defcustom python-pdbtrack-stacktrace-info-regexp
+ "^> \\([^\"(<]+\\)(\\([0-9]+\\))\\([?a-zA-Z0-9_<>]+\\)()"
+ "Regular Expression matching stacktrace information.
+Used to extract the current line and module being inspected."
+ :type 'string
+ :group 'python
+ :safe 'stringp)
+
+(defvar python-pdbtrack-tracked-buffer nil
+ "Variable containing the value of the current tracked buffer.
+Never set this variable directly, use
+`python-pdbtrack-set-tracked-buffer' instead.")
+
+(defvar python-pdbtrack-buffers-to-kill nil
+ "List of buffers to be deleted after tracking finishes.")
+
+(defun python-pdbtrack-set-tracked-buffer (file-name)
+ "Set the buffer for FILE-NAME as the tracked buffer.
+Internally it uses the `python-pdbtrack-tracked-buffer' variable.
+Returns the tracked buffer."
+ (let ((file-buffer (get-file-buffer file-name)))
+ (if file-buffer
+ (setq python-pdbtrack-tracked-buffer file-buffer)
+ (setq file-buffer (find-file-noselect file-name))
+ (when (not (member file-buffer python-pdbtrack-buffers-to-kill))
+ (add-to-list 'python-pdbtrack-buffers-to-kill file-buffer)))
+ file-buffer))
+
+(defun python-pdbtrack-comint-output-filter-function (output)
+ "Move overlay arrow to current pdb line in tracked buffer.
+Argument OUTPUT is a string with the output from the comint process."
+ (when (and python-pdbtrack-activate (not (string= output "")))
+ (let* ((full-output (ansi-color-filter-apply
+ (buffer-substring comint-last-input-end (point-max))))
+ (line-number)
+ (file-name
+ (with-temp-buffer
+ (insert full-output)
+ (goto-char (point-min))
+ ;; OK, this sucked but now it became a cool hack. The
+ ;; stacktrace information normally is on the first line
+ ;; but in some cases (like when doing a step-in) it is
+ ;; on the second.
+ (when (or (looking-at python-pdbtrack-stacktrace-info-regexp)
+ (and
+ (forward-line)
+ (looking-at python-pdbtrack-stacktrace-info-regexp)))
+ (setq line-number (string-to-number
+ (match-string-no-properties 2)))
+ (match-string-no-properties 1)))))
+ (if (and file-name line-number)
+ (let* ((tracked-buffer
+ (python-pdbtrack-set-tracked-buffer file-name))
+ (shell-buffer (current-buffer))
+ (tracked-buffer-window (get-buffer-window tracked-buffer))
+ (tracked-buffer-line-pos))
+ (with-current-buffer tracked-buffer
+ (set (make-local-variable 'overlay-arrow-string) "=>")
+ (set (make-local-variable 'overlay-arrow-position) (make-marker))
+ (setq tracked-buffer-line-pos (progn
+ (goto-char (point-min))
+ (forward-line (1- line-number))
+ (point-marker)))
+ (when tracked-buffer-window
+ (set-window-point
+ tracked-buffer-window tracked-buffer-line-pos))
+ (set-marker overlay-arrow-position tracked-buffer-line-pos))
+ (pop-to-buffer tracked-buffer)
+ (switch-to-buffer-other-window shell-buffer))
+ (when python-pdbtrack-tracked-buffer
+ (with-current-buffer python-pdbtrack-tracked-buffer
+ (set-marker overlay-arrow-position nil))
+ (mapc #'(lambda (buffer)
+ (ignore-errors (kill-buffer buffer)))
+ python-pdbtrack-buffers-to-kill)
+ (setq python-pdbtrack-tracked-buffer nil
+ python-pdbtrack-buffers-to-kill nil)))))
+ output)
-;;;###autoload
-(defun python-after-info-look ()
- "Set up info-look for Python.
-Used with `eval-after-load'."
- (let* ((version (let ((s (shell-command-to-string (concat python-command
- " -V"))))
- (string-match "^Python \\([0-9]+\\.[0-9]+\\>\\)" s)
- (match-string 1 s)))
- ;; Whether info files have a Python version suffix, e.g. in Debian.
- (versioned
- (with-temp-buffer
- (with-no-warnings (Info-mode))
- (condition-case ()
- ;; Don't use `info' because it would pop-up a *info* buffer.
- (with-no-warnings
- (Info-goto-node (format "(python%s-lib)Miscellaneous Index"
- version))
- t)
- (error nil)))))
- (info-lookup-maybe-add-help
- :mode 'python-mode
- :regexp "[[:alnum:]_]+"
- :doc-spec
- ;; Fixme: Can this reasonably be made specific to indices with
- ;; different rules? Is the order of indices optimal?
- ;; (Miscellaneous in -ref first prefers lookup of keywords, for
- ;; instance.)
- (if versioned
- ;; The empty prefix just gets us highlighted terms.
- `((,(concat "(python" version "-ref)Miscellaneous Index") nil "")
- (,(concat "(python" version "-ref)Module Index" nil ""))
- (,(concat "(python" version "-ref)Function-Method-Variable Index"
- nil ""))
- (,(concat "(python" version "-ref)Class-Exception-Object Index"
- nil ""))
- (,(concat "(python" version "-lib)Module Index" nil ""))
- (,(concat "(python" version "-lib)Class-Exception-Object Index"
- nil ""))
- (,(concat "(python" version "-lib)Function-Method-Variable Index"
- nil ""))
- (,(concat "(python" version "-lib)Miscellaneous Index" nil "")))
- '(("(python-ref)Miscellaneous Index" nil "")
- ("(python-ref)Module Index" nil "")
- ("(python-ref)Function-Method-Variable Index" nil "")
- ("(python-ref)Class-Exception-Object Index" nil "")
- ("(python-lib)Module Index" nil "")
- ("(python-lib)Class-Exception-Object Index" nil "")
- ("(python-lib)Function-Method-Variable Index" nil "")
- ("(python-lib)Miscellaneous Index" nil ""))))))
-(eval-after-load "info-look" '(python-after-info-look))
-;;;; Miscellany.
+;;; Symbol completion
-(defcustom python-jython-packages '("java" "javax" "org" "com")
- "Packages implying `jython-mode'.
-If these are imported near the beginning of the buffer, `python-mode'
-actually punts to `jython-mode'."
- :type '(repeat string)
+(defun python-completion-complete-at-point ()
+ "Complete current symbol at point.
+For this to work the best as possible you should call
+`python-shell-send-buffer' from time to time so context in
+inferior python process is updated properly."
+ (let ((process (python-shell-get-process)))
+ (if (not process)
+ (error "Completion needs an inferior Python process running")
+ (python-shell-completion-complete-at-point process))))
+
+(add-to-list 'debug-ignored-errors
+ "^Completion needs an inferior Python process running.")
+
+
+;;; Fill paragraph
+
+(defcustom python-fill-comment-function 'python-fill-comment
+ "Function to fill comments.
+This is the function used by `python-fill-paragraph' to
+fill comments."
+ :type 'symbol
:group 'python)
-;; Called from `python-mode', this causes a recursive call of the
-;; mode. See logic there to break out of the recursion.
-(defun python-maybe-jython ()
- "Invoke `jython-mode' if the buffer appears to contain Jython code.
-The criterion is either a match for `jython-mode' via
-`interpreter-mode-alist' or an import of a module from the list
-`python-jython-packages'."
- ;; The logic is taken from python-mode.el.
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let ((interpreter (if (looking-at auto-mode-interpreter-regexp)
- (match-string 2))))
- (if (and interpreter (eq 'jython-mode
- (cdr (assoc (file-name-nondirectory
- interpreter)
- interpreter-mode-alist))))
- (jython-mode)
- (if (catch 'done
- (while (re-search-forward
- (rx line-start (or "import" "from") (1+ space)
- (group (1+ (not (any " \t\n.")))))
- (+ (point-min) 10000) ; Probably not worth customizing.
- t)
- (if (member (match-string 1) python-jython-packages)
- (throw 'done t))))
- (jython-mode)))))))
+(defcustom python-fill-string-function 'python-fill-string
+ "Function to fill strings.
+This is the function used by `python-fill-paragraph' to
+fill strings."
+ :type 'symbol
+ :group 'python)
-(defun python-fill-paragraph (&optional justify)
- "`fill-paragraph-function' handling multi-line strings and possibly comments.
-If any of the current line is in or at the end of a multi-line string,
-fill the string or the paragraph of it that point is in, preserving
-the string's indentation."
- (interactive "P")
- (or (fill-comment-paragraph justify)
- (save-excursion
- (end-of-line)
- (let* ((syntax (syntax-ppss))
- (orig (point))
- start end)
- (cond ((nth 4 syntax) ; comment. fixme: loses with trailing one
- (let (fill-paragraph-function)
- (fill-paragraph justify)))
- ;; The `paragraph-start' and `paragraph-separate'
- ;; variables don't allow us to delimit the last
- ;; paragraph in a multi-line string properly, so narrow
- ;; to the string and then fill around (the end of) the
- ;; current line.
- ((eq t (nth 3 syntax)) ; in fenced string
- (goto-char (nth 8 syntax)) ; string start
- (setq start (line-beginning-position))
- (setq end (condition-case () ; for unbalanced quotes
- (progn (forward-sexp)
- (- (point) 3))
- (error (point-max)))))
- ((re-search-backward "\\s|\\s-*\\=" nil t) ; end of fenced string
- (forward-char)
- (setq end (point))
- (condition-case ()
- (progn (backward-sexp)
- (setq start (line-beginning-position)))
- (error nil))))
- (when end
- (save-restriction
- (narrow-to-region start end)
- (goto-char orig)
- ;; Avoid losing leading and trailing newlines in doc
- ;; strings written like:
- ;; """
- ;; ...
- ;; """
- (let ((paragraph-separate
- ;; Note that the string could be part of an
- ;; expression, so it can have preceding and
- ;; trailing non-whitespace.
- (concat
- (rx (or
- ;; Opening triple quote without following text.
- (and (* nonl)
- (group (syntax string-delimiter))
- (repeat 2 (backref 1))
- ;; Fixme: Not sure about including
- ;; trailing whitespace.
- (* (any " \t"))
- eol)
- ;; Closing trailing quote without preceding text.
- (and (group (any ?\" ?')) (backref 2)
- (syntax string-delimiter))))
- "\\(?:" paragraph-separate "\\)"))
- fill-paragraph-function)
- (fill-paragraph justify))))))) t)
-
-(defun python-shift-left (start end &optional count)
- "Shift lines in region COUNT (the prefix arg) columns to the left.
-COUNT defaults to `python-indent'. If region isn't active, just shift
-current line. The region shifted includes the lines in which START and
-END lie. It is an error if any lines in the region are indented less than
-COUNT columns."
- (interactive
- (if mark-active
- (list (region-beginning) (region-end) current-prefix-arg)
- (list (line-beginning-position) (line-end-position) current-prefix-arg)))
- (if count
- (setq count (prefix-numeric-value count))
- (setq count python-indent))
- (when (> count 0)
- (save-excursion
- (goto-char start)
- (while (< (point) end)
- (if (and (< (current-indentation) count)
- (not (looking-at "[ \t]*$")))
- (error "Can't shift all lines enough"))
- (forward-line))
- (indent-rigidly start end (- count)))))
+(defcustom python-fill-decorator-function 'python-fill-decorator
+ "Function to fill decorators.
+This is the function used by `python-fill-paragraph' to
+fill decorators."
+ :type 'symbol
+ :group 'python)
-(add-to-list 'debug-ignored-errors "^Can't shift all lines enough")
+(defcustom python-fill-paren-function 'python-fill-paren
+ "Function to fill parens.
+This is the function used by `python-fill-paragraph' to
+fill parens."
+ :type 'symbol
+ :group 'python)
-(defun python-shift-right (start end &optional count)
- "Shift lines in region COUNT (the prefix arg) columns to the right.
-COUNT defaults to `python-indent'. If region isn't active, just shift
-current line. The region shifted includes the lines in which START and
-END lie."
- (interactive
- (if mark-active
- (list (region-beginning) (region-end) current-prefix-arg)
- (list (line-beginning-position) (line-end-position) current-prefix-arg)))
- (if count
- (setq count (prefix-numeric-value count))
- (setq count python-indent))
- (indent-rigidly start end count))
-
-(defun python-outline-level ()
- "`outline-level' function for Python mode.
-The level is the number of `python-indent' steps of indentation
-of current line."
- (1+ (/ (current-indentation) python-indent)))
-
-;; Fixme: Consider top-level assignments, imports, &c.
-(defun python-current-defun (&optional length-limit)
- "`add-log-current-defun-function' for Python."
- (save-excursion
- ;; Move up the tree of nested `class' and `def' blocks until we
- ;; get to zero indentation, accumulating the defined names.
- (let ((accum)
- (length -1))
- (catch 'done
- (while (or (null length-limit)
- (null (cdr accum))
- (< length length-limit))
- (let ((started-from (point)))
- (python-beginning-of-block)
- (end-of-line)
- (beginning-of-defun)
- (when (= (point) started-from)
- (throw 'done nil)))
- (when (looking-at (rx (0+ space) (or "def" "class") (1+ space)
- (group (1+ (or word (syntax symbol))))))
- (push (match-string 1) accum)
- (setq length (+ length 1 (length (car accum)))))
- (when (= (current-indentation) 0)
- (throw 'done nil))))
- (when accum
- (when (and length-limit (> length length-limit))
- (setcar accum ".."))
- (mapconcat 'identity accum ".")))))
-
-(defun python-mark-block ()
- "Mark the block around point.
-Uses `python-beginning-of-block', `python-end-of-block'."
- (interactive)
- (push-mark)
- (python-beginning-of-block)
- (push-mark (point) nil t)
- (python-end-of-block)
- (exchange-point-and-mark))
-
-;; Fixme: Provide a find-function-like command to find source of a
-;; definition (separate from BicycleRepairMan). Complicated by
-;; finding the right qualified name.
-
-;;;; Completion.
-
-;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-01/msg00076.html
-(defvar python-imports "None"
- "String of top-level import statements updated by `python-find-imports'.")
-(make-variable-buffer-local 'python-imports)
-
-;; Fixme: Should font-lock try to run this when it deals with an import?
-;; Maybe not a good idea if it gets run multiple times when the
-;; statement is being edited, and is more likely to end up with
-;; something syntactically incorrect.
-;; However, what we should do is to trundle up the block tree from point
-;; to extract imports that appear to be in scope, and add those.
-(defun python-find-imports ()
- "Find top-level imports, updating `python-imports'."
- (interactive)
- (save-excursion
- (let (lines)
- (goto-char (point-min))
- (while (re-search-forward "^import\\>\\|^from\\>" nil t)
- (unless (syntax-ppss-context (syntax-ppss))
- (let ((start (line-beginning-position)))
- ;; Skip over continued lines.
- (while (and (eq ?\\ (char-before (line-end-position)))
- (= 0 (forward-line 1)))
- t)
- (push (buffer-substring start (line-beginning-position 2))
- lines))))
- (setq python-imports
- (if lines
- (apply #'concat
-;; This is probably best left out since you're unlikely to need the
-;; doc for a function in the buffer and the import will lose if the
-;; Python sub-process' working directory isn't the same as the
-;; buffer's.
-;; (if buffer-file-name
-;; (concat
-;; "import "
-;; (file-name-sans-extension
-;; (file-name-nondirectory buffer-file-name))))
- (nreverse lines))
- "None"))
- (when lines
- (set-text-properties 0 (length python-imports) nil python-imports)
- ;; The output ends up in the wrong place if the string we
- ;; send contains newlines (from the imports).
- (setq python-imports
- (replace-regexp-in-string "\n" "\\n"
- (format "%S" python-imports) t t))))))
-
-;; Fixme: This fails the first time if the sub-process isn't already
-;; running. Presumably a timing issue with i/o to the process.
-(defun python-symbol-completions (symbol)
- "Return a list of completions of the string SYMBOL from Python process.
-The list is sorted.
-Uses `python-imports' to load modules against which to complete."
- (when (stringp symbol)
- (let ((completions
- (condition-case ()
- (car (read-from-string
- (python-send-receive
- (format "emacs.complete(%S,%s)"
- (substring-no-properties symbol)
- python-imports))))
- (error nil))))
- (sort
- ;; We can get duplicates from the above -- don't know why.
- (delete-dups completions)
- #'string<))))
-
-(defun python-completion-at-point ()
- (let ((end (point))
- (start (save-excursion
- (and (re-search-backward
- (rx (or buffer-start (regexp "[^[:alnum:]._]"))
- (group (1+ (regexp "[[:alnum:]._]"))) point)
- nil t)
- (match-beginning 1)))))
- (when start
- (list start end
- (completion-table-dynamic 'python-symbol-completions)))))
-
-;;;; FFAP support
+(defcustom python-fill-docstring-style 'pep-257
+ "Style used to fill docstrings.
+This affects `python-fill-string' behavior with regards to
+triple quotes positioning.
-(defun python-module-path (module)
- "Function for `ffap-alist' to return path to MODULE."
- (python-send-receive (format "emacs.modpath (%S)" module)))
+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:
-(eval-after-load "ffap"
- '(push '(python-mode . python-module-path) ffap-alist))
-
-;;;; Find-function support
+DJANGO:
-;; Fixme: key binding?
+ \"\"\"
+ Process foo, return bar.
+ \"\"\"
-(defun python-find-function (name)
- "Find source of definition of function NAME.
-Interactively, prompt for name."
- (interactive
- (let ((symbol (with-syntax-table python-dotty-syntax-table
- (current-word)))
- (enable-recursive-minibuffers t))
- (list (read-string (if symbol
- (format "Find location of (default %s): " symbol)
- "Find location of: ")
- nil nil symbol))))
- (unless python-imports
- (error "Not called from buffer visiting Python file"))
- (let* ((loc (python-send-receive (format "emacs.location_of (%S, %s)"
- name python-imports)))
- (loc (car (read-from-string loc)))
- (file (car loc))
- (line (cdr loc)))
- (unless file (error "Don't know where `%s' is defined" name))
- (pop-to-buffer (find-file-noselect file))
- (when (integerp line)
+ \"\"\"
+ 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 (lambda (val)
+ (memq val '(django onetwo pep-257 pep-257-nn symmetric nil))))
+
+(defun python-fill-paragraph (&optional justify)
+ "`fill-paragraph-function' handling multi-line strings and possibly comments.
+If any of the current line is in or at the end of a multi-line string,
+fill the string or the paragraph of it that point is in, preserving
+the string's indentation.
+Optional argument JUSTIFY defines if the paragraph should be justified."
+ (interactive "P")
+ (save-excursion
+ (cond
+ ;; Comments
+ ((python-syntax-context 'comment)
+ (funcall python-fill-comment-function justify))
+ ;; Strings/Docstrings
+ ((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
+ (python-nav-beginning-of-statement))) ?@)
+ (funcall python-fill-decorator-function justify))
+ ;; Parens
+ ((or (python-syntax-context 'paren)
+ (looking-at (python-rx open-paren))
+ (save-excursion
+ (skip-syntax-forward "^(" (line-end-position))
+ (looking-at (python-rx open-paren))))
+ (funcall python-fill-paren-function justify))
+ (t t))))
+
+(defun python-fill-comment (&optional justify)
+ "Comment fill function for `python-fill-paragraph'.
+JUSTIFY should be used (if applicable) as in `fill-paragraph'."
+ (fill-comment-paragraph justify))
+
+(defun python-fill-string (&optional justify)
+ "String fill function for `python-fill-paragraph'.
+JUSTIFY should be used (if applicable) as in `fill-paragraph'."
+ (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
+ (pcase 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 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'.
+JUSTIFY should be used (if applicable) as in `fill-paragraph'."
+ t)
+
+(defun python-fill-paren (&optional justify)
+ "Paren fill function for `python-fill-paragraph'.
+JUSTIFY should be used (if applicable) as in `fill-paragraph'."
+ (save-restriction
+ (narrow-to-region (progn
+ (while (python-syntax-context 'paren)
+ (goto-char (1- (point-marker))))
+ (point-marker)
+ (line-beginning-position))
+ (progn
+ (when (not (python-syntax-context 'paren))
+ (end-of-line)
+ (when (not (python-syntax-context 'paren))
+ (skip-syntax-backward "^)")))
+ (while (python-syntax-context 'paren)
+ (goto-char (1+ (point-marker))))
+ (point-marker)))
+ (let ((paragraph-start "\f\\|[ \t]*$")
+ (paragraph-separate ",")
+ (fill-paragraph-function))
(goto-char (point-min))
- (forward-line (1- line)))))
+ (fill-paragraph justify))
+ (while (not (eobp))
+ (forward-line 1)
+ (python-indent-line)
+ (goto-char (line-end-position)))) t)
+
-;;;; Skeletons
+;;; Skeletons
-(defcustom python-use-skeletons nil
+(defcustom python-skeleton-autoinsert nil
"Non-nil means template skeletons will be automagically inserted.
This happens when pressing \"if<SPACE>\", for example, to prompt for
the if condition."
:type 'boolean
- :group 'python)
+ :group 'python
+ :safe 'booleanp)
+
+(define-obsolete-variable-alias
+ 'python-use-skeletons 'python-skeleton-autoinsert "24.3")
+
+(defvar python-skeleton-available '()
+ "Internal list of available skeletons.")
(define-abbrev-table 'python-mode-abbrev-table ()
"Abbrev table for Python mode."
@@ -2225,507 +2605,668 @@ the if condition."
;; Allow / inside abbrevs.
:regexp "\\(?:^\\|[^/]\\)\\<\\([[:word:]/]+\\)\\W*"
;; Only expand in code.
- :enable-function (lambda () (not (python-in-string/comment))))
-
-(eval-when-compile
- ;; Define a user-level skeleton and add it to the abbrev table.
-(defmacro def-python-skeleton (name &rest elements)
+ :enable-function (lambda ()
+ (and
+ (not (python-syntax-comment-or-string-p))
+ python-skeleton-autoinsert)))
+
+(defmacro python-skeleton-define (name doc &rest skel)
+ "Define a `python-mode' skeleton using NAME DOC and SKEL.
+The skeleton will be bound to python-skeleton-NAME and will
+be added to `python-mode-abbrev-table'."
(declare (indent 2))
(let* ((name (symbol-name name))
- (function (intern (concat "python-insert-" name))))
+ (function-name (intern (concat "python-skeleton-" name))))
`(progn
- ;; Usual technique for inserting a skeleton, but expand
- ;; to the original abbrev instead if in a comment or string.
- (when python-use-skeletons
- (define-abbrev python-mode-abbrev-table ,name ""
- ',function
- nil t)) ; system abbrev
- (define-skeleton ,function
- ,(format "Insert Python \"%s\" template." name)
- ,@elements)))))
-
-;; From `skeleton-further-elements' set below:
-;; `<': outdent a level;
-;; `^': delete indentation on current line and also previous newline.
-;; Not quite like `delete-indentation'. Assumes point is at
-;; beginning of indentation.
-
-(def-python-skeleton if
+ (define-abbrev python-mode-abbrev-table ,name "" ',function-name
+ :system t)
+ (setq python-skeleton-available
+ (cons ',function-name python-skeleton-available))
+ (define-skeleton ,function-name
+ ,(or doc
+ (format "Insert %s statement." name))
+ ,@skel))))
+
+(defmacro python-define-auxiliary-skeleton (name doc &optional &rest skel)
+ "Define a `python-mode' auxiliary skeleton using NAME DOC and SKEL.
+The skeleton will be bound to python-skeleton-NAME."
+ (declare (indent 2))
+ (let* ((name (symbol-name name))
+ (function-name (intern (concat "python-skeleton--" name)))
+ (msg (format
+ "Add '%s' clause? " name)))
+ (when (not skel)
+ (setq skel
+ `(< ,(format "%s:" name) \n \n
+ > _ \n)))
+ `(define-skeleton ,function-name
+ ,(or doc
+ (format "Auxiliary skeleton for %s statement." name))
+ nil
+ (unless (y-or-n-p ,msg)
+ (signal 'quit t))
+ ,@skel)))
+
+(python-define-auxiliary-skeleton else nil)
+
+(python-define-auxiliary-skeleton except nil)
+
+(python-define-auxiliary-skeleton finally nil)
+
+(python-skeleton-define if nil
"Condition: "
"if " str ":" \n
- > -1 ; Fixme: I don't understand the spurious space this removes.
_ \n
("other condition, %s: "
- < ; Avoid wrong indentation after block opening.
+ <
"elif " str ":" \n
> _ \n nil)
- '(python-else) | ^)
+ '(python-skeleton--else) | ^)
-(define-skeleton python-else
- "Auxiliary skeleton."
- nil
- (unless (eq ?y (read-char "Add `else' clause? (y for yes or RET for no) "))
- (signal 'quit t))
- < "else:" \n
- > _ \n)
-
-(def-python-skeleton while
+(python-skeleton-define while nil
"Condition: "
"while " str ":" \n
- > -1 _ \n
- '(python-else) | ^)
+ > _ \n
+ '(python-skeleton--else) | ^)
-(def-python-skeleton for
- "Target, %s: "
- "for " str " in " (skeleton-read "Expression, %s: ") ":" \n
- > -1 _ \n
- '(python-else) | ^)
+(python-skeleton-define for nil
+ "Iteration spec: "
+ "for " str ":" \n
+ > _ \n
+ '(python-skeleton--else) | ^)
-(def-python-skeleton try/except
+(python-skeleton-define try nil
nil
"try:" \n
- > -1 _ \n
+ > _ \n
("Exception, %s: "
- < "except " str '(python-target) ":" \n
+ <
+ "except " str ":" \n
> _ \n nil)
- < "except:" \n
- > _ \n
- '(python-else) | ^)
-
-(define-skeleton python-target
- "Auxiliary skeleton."
- "Target, %s: " ", " str | -2)
-
-(def-python-skeleton try/finally
- nil
- "try:" \n
- > -1 _ \n
- < "finally:" \n
- > _ \n)
-
-(def-python-skeleton def
- "Name: "
- "def " str " (" ("Parameter, %s: " (unless (equal ?\( (char-before)) ", ")
- str) "):" \n
- "\"\"\"" - "\"\"\"" \n ; Fixme: extra space inserted -- why?).
- > _ \n)
-
-(def-python-skeleton class
- "Name: "
+ resume:
+ '(python-skeleton--except)
+ '(python-skeleton--else)
+ '(python-skeleton--finally) | ^)
+
+(python-skeleton-define def nil
+ "Function name: "
+ "def " str " (" ("Parameter, %s: "
+ (unless (equal ?\( (char-before)) ", ")
+ str) "):" \n
+ "\"\"\"" - "\"\"\"" \n
+ > _ \n)
+
+(python-skeleton-define class nil
+ "Class name: "
"class " str " (" ("Inheritance, %s: "
- (unless (equal ?\( (char-before)) ", ")
- str)
- & ")" | -2 ; close list or remove opening
+ (unless (equal ?\( (char-before)) ", ")
+ str)
+ & ")" | -2
":" \n
"\"\"\"" - "\"\"\"" \n
> _ \n)
-(defvar python-default-template "if"
- "Default template to expand by `python-expand-template'.
-Updated on each expansion.")
+(defun python-skeleton-add-menu-items ()
+ "Add menu items to Python->Skeletons menu."
+ (let ((skeletons (sort python-skeleton-available 'string<))
+ (items))
+ (dolist (skeleton skeletons)
+ (easy-menu-add-item
+ nil '("Python" "Skeletons")
+ `[,(format
+ "Insert %s" (nth 2 (split-string (symbol-name skeleton) "-")))
+ ,skeleton t]))))
+
+;;; FFAP
+
+(defcustom python-ffap-setup-code
+ "def __FFAP_get_module_path(module):
+ try:
+ import os
+ path = __import__(module).__file__
+ if path[-4:] == '.pyc' and os.path.exists(path[0:-1]):
+ path = path[:-1]
+ return path
+ except:
+ return ''"
+ "Python code to get a module path."
+ :type 'string
+ :group 'python)
+
+(defcustom python-ffap-string-code
+ "__FFAP_get_module_path('''%s''')\n"
+ "Python code used to get a string with the path of a module."
+ :type 'string
+ :group 'python)
+
+(defun python-ffap-module-path (module)
+ "Function for `ffap-alist' to return path for MODULE."
+ (let ((process (or
+ (and (eq major-mode 'inferior-python-mode)
+ (get-buffer-process (current-buffer)))
+ (python-shell-get-process))))
+ (if (not process)
+ nil
+ (let ((module-file
+ (python-shell-send-string-no-output
+ (format python-ffap-string-code module) process)))
+ (when module-file
+ (substring-no-properties module-file 1 -1))))))
+
+(eval-after-load "ffap"
+ '(progn
+ (push '(python-mode . python-ffap-module-path) ffap-alist)
+ (push '(inferior-python-mode . python-ffap-module-path) ffap-alist)))
-(defun python-expand-template (name)
- "Expand template named NAME.
-Interactively, prompt for the name with completion."
- (interactive
- (list (completing-read (format "Template to expand (default %s): "
- python-default-template)
- python-mode-abbrev-table nil t nil nil
- python-default-template)))
- (if (equal "" name)
- (setq name python-default-template)
- (setq python-default-template name))
- (let ((sym (abbrev-symbol name python-mode-abbrev-table)))
- (if sym
- (abbrev-insert sym)
- (error "Undefined template: %s" name))))
-;;;; Bicycle Repair Man support
-
-(autoload 'pymacs-load "pymacs" nil t)
-(autoload 'brm-init "bikeemacs")
-(defvar brm-menu)
-
-;; I'm not sure how useful BRM really is, and it's certainly dangerous
-;; the way it modifies files outside Emacs... Also note that the
-;; current BRM loses with tabs used for indentation -- I submitted a
-;; fix <URL:http://www.loveshack.ukfsn.org/emacs/bikeemacs.py.diff>.
-(defun python-setup-brm ()
- "Set up Bicycle Repair Man refactoring tool (if available).
-
-Note that the `refactoring' features change files independently of
-Emacs and may modify and save the contents of the current buffer
-without confirmation."
- (interactive)
- (condition-case data
- (unless (fboundp 'brm-rename)
- (pymacs-load "bikeemacs" "brm-") ; first line of normal recipe
- (let ((py-mode-map (make-sparse-keymap)) ; it assumes this
- (features (cons 'python-mode features))) ; and requires this
- (brm-init) ; second line of normal recipe
- (remove-hook 'python-mode-hook ; undo this from `brm-init'
- (lambda () (easy-menu-add brm-menu)))
- (easy-menu-define
- python-brm-menu python-mode-map
- "Bicycle Repair Man"
- '("BicycleRepairMan"
- :help "Interface to navigation and refactoring tool"
- "Queries"
- ["Find References" brm-find-references
- :help "Find references to name at point in compilation buffer"]
- ["Find Definition" brm-find-definition
- :help "Find definition of name at point"]
- "-"
- "Refactoring"
- ["Rename" brm-rename
- :help "Replace name at point with a new name everywhere"]
- ["Extract Method" brm-extract-method
- :active (and mark-active (not buffer-read-only))
- :help "Replace statements in region with a method"]
- ["Extract Local Variable" brm-extract-local-variable
- :active (and mark-active (not buffer-read-only))
- :help "Replace expression in region with an assignment"]
- ["Inline Local Variable" brm-inline-local-variable
- :help
- "Substitute uses of variable at point with its definition"]
- ;; Fixme: Should check for anything to revert.
- ["Undo Last Refactoring" brm-undo :help ""]))))
- (error (error "BicycleRepairMan setup failed: %s" data))))
+;;; Code check
+
+(defcustom python-check-command
+ "pyflakes"
+ "Command used to check a Python file."
+ :type 'string
+ :group 'python)
+
+(defcustom python-check-buffer-name
+ "*Python check: %s*"
+ "Buffer name used for check commands."
+ :type 'string
+ :group 'python)
+
+(defvar python-check-custom-command nil
+ "Internal use.")
+
+(defun python-check (command)
+ "Check a Python file (default current buffer's file).
+Runs COMMAND, a shell command, as if by `compile'. See
+`python-check-command' for the default."
+ (interactive
+ (list (read-string "Check command: "
+ (or python-check-custom-command
+ (concat python-check-command " "
+ (shell-quote-argument
+ (or
+ (let ((name (buffer-file-name)))
+ (and name
+ (file-name-nondirectory name)))
+ "")))))))
+ (setq python-check-custom-command command)
+ (save-some-buffers (not compilation-ask-about-save) nil)
+ (let ((process-environment (python-shell-calculate-process-environment))
+ (exec-path (python-shell-calculate-exec-path)))
+ (compilation-start command nil
+ (lambda (mode-name)
+ (format python-check-buffer-name command)))))
+
-;;;; Modes.
+;;; Eldoc
+
+(defcustom python-eldoc-setup-code
+ "def __PYDOC_get_help(obj):
+ try:
+ import inspect
+ if hasattr(obj, 'startswith'):
+ obj = eval(obj, globals())
+ doc = inspect.getdoc(obj)
+ if not doc and callable(obj):
+ target = None
+ if inspect.isclass(obj) and hasattr(obj, '__init__'):
+ target = obj.__init__
+ objtype = 'class'
+ else:
+ target = obj
+ objtype = 'def'
+ if target:
+ args = inspect.formatargspec(
+ *inspect.getargspec(target)
+ )
+ name = obj.__name__
+ doc = '{objtype} {name}{args}'.format(
+ objtype=objtype, name=name, args=args
+ )
+ else:
+ doc = doc.splitlines()[0]
+ except:
+ doc = ''
+ try:
+ exec('print doc')
+ except SyntaxError:
+ print(doc)"
+ "Python code to setup documentation retrieval."
+ :type 'string
+ :group 'python)
+
+(defcustom python-eldoc-string-code
+ "__PYDOC_get_help('''%s''')\n"
+ "Python code used to get a string with the documentation of an object."
+ :type 'string
+ :group 'python)
-;; pdb tracking is alert once this file is loaded, but takes no action if
-;; `python-pdbtrack-do-tracking-p' is nil.
-(add-hook 'comint-output-filter-functions 'python-pdbtrack-track-stack-file)
+(defun python-eldoc--get-doc-at-point (&optional force-input force-process)
+ "Internal implementation to get documentation at point.
+If not FORCE-INPUT is passed then what
+`python-info-current-symbol' returns will be used. If not
+FORCE-PROCESS is passed what `python-shell-get-process' returns
+is used."
+ (let ((process (or force-process (python-shell-get-process))))
+ (if (not process)
+ (error "Eldoc needs an inferior Python process running")
+ (let ((input (or force-input
+ (python-info-current-symbol t))))
+ (and input
+ (python-shell-send-string-no-output
+ (format python-eldoc-string-code input)
+ process))))))
-(defvar outline-heading-end-regexp)
-(defvar eldoc-documentation-function)
-(defvar python-mode-running) ;Dynamically scoped var.
+(defun python-eldoc-function ()
+ "`eldoc-documentation-function' for Python.
+For this to work the best as possible you should call
+`python-shell-send-buffer' from time to time so context in
+inferior python process is updated properly."
+ (python-eldoc--get-doc-at-point))
+(defun python-eldoc-at-point (symbol)
+ "Get help on SYMBOL using `help'.
+Interactively, prompt for symbol."
+ (interactive
+ (let ((symbol (python-info-current-symbol t))
+ (enable-recursive-minibuffers t))
+ (list (read-string (if symbol
+ (format "Describe symbol (default %s): " symbol)
+ "Describe symbol: ")
+ nil nil symbol))))
+ (message (python-eldoc--get-doc-at-point symbol)))
+
+(add-to-list 'debug-ignored-errors
+ "^Eldoc needs an inferior Python process running.")
+
+
+;;; Misc helpers
+
+(defun python-info-current-defun (&optional include-type)
+ "Return name of surrounding function with Python compatible dotty syntax.
+Optional argument INCLUDE-TYPE indicates to include the type of the defun.
+This function is compatible to be used as
+`add-log-current-defun-function' since it returns nil if point is
+not inside a defun."
+ (save-restriction
+ (widen)
+ (save-excursion
+ (end-of-line 1)
+ (let ((names)
+ (starting-indentation
+ (save-excursion
+ (and
+ (python-nav-beginning-of-defun 1)
+ ;; This extra number is just for checking code
+ ;; against indentation to work well on first run.
+ (+ (current-indentation) 4))))
+ (starting-point (point)))
+ ;; Check point is inside a defun.
+ (when (and starting-indentation
+ (< starting-point
+ (save-excursion
+ (python-nav-end-of-defun)
+ (point))))
+ (catch 'exit
+ (while (python-nav-beginning-of-defun 1)
+ (when (< (current-indentation) starting-indentation)
+ (setq starting-indentation (current-indentation))
+ (setq names
+ (cons
+ (if (not include-type)
+ (match-string-no-properties 1)
+ (mapconcat 'identity
+ (split-string
+ (match-string-no-properties 0)) " "))
+ names)))
+ (and (= (current-indentation) 0) (throw 'exit t)))))
+ (and names
+ (mapconcat (lambda (string) string) names "."))))))
+
+(defun python-info-current-symbol (&optional replace-self)
+ "Return current symbol using dotty syntax.
+With optional argument REPLACE-SELF convert \"self\" to current
+parent defun name."
+ (let ((name
+ (and (not (python-syntax-comment-or-string-p))
+ (with-syntax-table python-dotty-syntax-table
+ (let ((sym (symbol-at-point)))
+ (and sym
+ (substring-no-properties (symbol-name sym))))))))
+ (when name
+ (if (not replace-self)
+ name
+ (let ((current-defun (python-info-current-defun)))
+ (if (not current-defun)
+ name
+ (replace-regexp-in-string
+ (python-rx line-start word-start "self" word-end ?.)
+ (concat
+ (mapconcat 'identity
+ (butlast (split-string current-defun "\\."))
+ ".") ".")
+ name)))))))
+
+(defun python-info-statement-starts-block-p ()
+ "Return non-nil if current statement opens a block."
+ (save-excursion
+ (python-nav-beginning-of-statement)
+ (looking-at (python-rx block-start))))
+
+(defun python-info-statement-ends-block-p ()
+ "Return non-nil if point is at end of block."
+ (let ((end-of-block-pos (save-excursion
+ (python-nav-end-of-block)))
+ (end-of-statement-pos (save-excursion
+ (python-nav-end-of-statement))))
+ (and end-of-block-pos end-of-statement-pos
+ (= end-of-block-pos end-of-statement-pos))))
+
+(defun python-info-beginning-of-statement-p ()
+ "Return non-nil if point is at beginning of statement."
+ (= (point) (save-excursion
+ (python-nav-beginning-of-statement)
+ (point))))
+
+(defun python-info-end-of-statement-p ()
+ "Return non-nil if point is at end of statement."
+ (= (point) (save-excursion
+ (python-nav-end-of-statement)
+ (point))))
+
+(defun python-info-beginning-of-block-p ()
+ "Return non-nil if point is at beginning of block."
+ (and (python-info-beginning-of-statement-p)
+ (python-info-statement-starts-block-p)))
+
+(defun python-info-end-of-block-p ()
+ "Return non-nil if point is at end of block."
+ (and (python-info-end-of-statement-p)
+ (python-info-statement-ends-block-p)))
+
+(defun python-info-closing-block ()
+ "Return the point of the block the current line closes."
+ (let ((closing-word (save-excursion
+ (back-to-indentation)
+ (current-word)))
+ (indentation (current-indentation)))
+ (when (member closing-word python-indent-dedenters)
+ (save-excursion
+ (forward-line -1)
+ (while (and (> (current-indentation) indentation)
+ (not (bobp))
+ (not (back-to-indentation))
+ (forward-line -1)))
+ (back-to-indentation)
+ (cond
+ ((not (equal indentation (current-indentation))) nil)
+ ((string= closing-word "elif")
+ (when (member (current-word) '("if" "elif"))
+ (point-marker)))
+ ((string= closing-word "else")
+ (when (member (current-word) '("if" "elif" "except" "for" "while"))
+ (point-marker)))
+ ((string= closing-word "except")
+ (when (member (current-word) '("try"))
+ (point-marker)))
+ ((string= closing-word "finally")
+ (when (member (current-word) '("except" "else"))
+ (point-marker))))))))
+
+(defun python-info-closing-block-message (&optional closing-block-point)
+ "Message the contents of the block the current line closes.
+With optional argument CLOSING-BLOCK-POINT use that instead of
+recalculating it calling `python-info-closing-block'."
+ (let ((point (or closing-block-point (python-info-closing-block))))
+ (when point
+ (save-restriction
+ (widen)
+ (message "Closes %s" (save-excursion
+ (goto-char point)
+ (back-to-indentation)
+ (buffer-substring
+ (point) (line-end-position))))))))
+
+(defun python-info-line-ends-backslash-p (&optional line-number)
+ "Return non-nil if current line ends with backslash.
+With optional argument LINE-NUMBER, check that line instead."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (when line-number
+ (goto-char line-number))
+ (while (and (not (eobp))
+ (goto-char (line-end-position))
+ (python-syntax-context 'paren)
+ (not (equal (char-before (point)) ?\\)))
+ (forward-line 1))
+ (when (equal (char-before) ?\\)
+ (point-marker)))))
+
+(defun python-info-beginning-of-backslash (&optional line-number)
+ "Return the point where the backslashed line start.
+Optional argument LINE-NUMBER forces the line number to check against."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (when line-number
+ (goto-char line-number))
+ (when (python-info-line-ends-backslash-p)
+ (while (save-excursion
+ (goto-char (line-beginning-position))
+ (python-syntax-context 'paren))
+ (forward-line -1))
+ (back-to-indentation)
+ (point-marker)))))
+
+(defun python-info-continuation-line-p ()
+ "Check if current line is continuation of another.
+When current line is continuation of another return the point
+where the continued line ends."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let* ((context-type (progn
+ (back-to-indentation)
+ (python-syntax-context-type)))
+ (line-start (line-number-at-pos))
+ (context-start (when context-type
+ (python-syntax-context context-type))))
+ (cond ((equal context-type 'paren)
+ ;; Lines inside a paren are always a continuation line
+ ;; (except the first one).
+ (python-util-forward-comment -1)
+ (point-marker))
+ ((member context-type '(string comment))
+ ;; move forward an roll again
+ (goto-char context-start)
+ (python-util-forward-comment)
+ (python-info-continuation-line-p))
+ (t
+ ;; Not within a paren, string or comment, the only way
+ ;; we are dealing with a continuation line is that
+ ;; previous line contains a backslash, and this can
+ ;; only be the previous line from current
+ (back-to-indentation)
+ (python-util-forward-comment -1)
+ (when (and (equal (1- line-start) (line-number-at-pos))
+ (python-info-line-ends-backslash-p))
+ (point-marker))))))))
+
+(defun python-info-block-continuation-line-p ()
+ "Return non-nil if current line is a continuation of a block."
+ (save-excursion
+ (when (python-info-continuation-line-p)
+ (forward-line -1)
+ (back-to-indentation)
+ (when (looking-at (python-rx block-start))
+ (point-marker)))))
+
+(defun python-info-assignment-continuation-line-p ()
+ "Check if current line is a continuation of an assignment.
+When current line is continuation of another with an assignment
+return the point of the first non-blank character after the
+operator."
+ (save-excursion
+ (when (python-info-continuation-line-p)
+ (forward-line -1)
+ (back-to-indentation)
+ (when (and (not (looking-at (python-rx block-start)))
+ (and (re-search-forward (python-rx not-simple-operator
+ assignment-operator
+ not-simple-operator)
+ (line-end-position) t)
+ (not (python-syntax-context-type))))
+ (skip-syntax-forward "\s")
+ (point-marker)))))
+
+(defun python-info-looking-at-beginning-of-defun (&optional syntax-ppss)
+ "Check if point is at `beginning-of-defun' using SYNTAX-PPSS."
+ (and (not (python-syntax-context-type (or syntax-ppss (syntax-ppss))))
+ (save-excursion
+ (beginning-of-line 1)
+ (looking-at python-nav-beginning-of-defun-regexp))))
+
+(defun python-info-current-line-comment-p ()
+ "Check if current line is a comment line."
+ (char-equal (or (char-after (+ (point) (current-indentation))) ?_) ?#))
+
+(defun python-info-current-line-empty-p ()
+ "Check if current line is empty, ignoring whitespace."
+ (save-excursion
+ (beginning-of-line 1)
+ (looking-at
+ (python-rx line-start (* whitespace)
+ (group (* not-newline))
+ (* whitespace) line-end))
+ (string-equal "" (match-string-no-properties 1))))
+
+
+;;; Utility functions
+
+(defun python-util-position (item seq)
+ "Find the first occurrence of ITEM in SEQ.
+Return the index of the matching item, or nil if not found."
+ (let ((member-result (member item seq)))
+ (when member-result
+ (- (length seq) (length member-result)))))
+
+;; Stolen from org-mode
+(defun python-util-clone-local-variables (from-buffer &optional regexp)
+ "Clone local variables from FROM-BUFFER.
+Optional argument REGEXP selects variables to clone and defaults
+to \"^python-\"."
+ (mapc
+ (lambda (pair)
+ (and (symbolp (car pair))
+ (string-match (or regexp "^python-")
+ (symbol-name (car pair)))
+ (set (make-local-variable (car pair))
+ (cdr pair))))
+ (buffer-local-variables from-buffer)))
+
+(defun python-util-forward-comment (&optional direction)
+ "Python mode specific version of `forward-comment'.
+Optional argument DIRECTION defines the direction to move to."
+ (let ((comment-start (python-syntax-context 'comment))
+ (factor (if (< (or direction 0) 0)
+ -99999
+ 99999)))
+ (when comment-start
+ (goto-char comment-start))
+ (forward-comment factor)))
+
+
;;;###autoload
(define-derived-mode python-mode prog-mode "Python"
"Major mode for editing Python files.
-Turns on Font Lock mode unconditionally since it is currently required
-for correct parsing of the source.
-See also `jython-mode', which is actually invoked if the buffer appears to
-contain Jython code. See also `run-python' and associated Python mode
-commands for running Python under Emacs.
-
-The Emacs commands which work with `defun's, e.g. \\[beginning-of-defun], deal
-with nested `def' and `class' blocks. They take the innermost one as
-current without distinguishing method and class definitions. Used multiple
-times, they move over others at the same indentation level until they reach
-the end of definitions at that level, when they move up a level.
-\\<python-mode-map>
-Colon is electric: it outdents the line if appropriate, e.g. for
-an else statement. \\[python-backspace] at the beginning of an indented statement
-deletes a level of indentation to close the current block; otherwise it
-deletes a character backward. TAB indents the current line relative to
-the preceding code. Successive TABs, with no intervening command, cycle
-through the possibilities for indentation on the basis of enclosing blocks.
-
-\\[fill-paragraph] fills comments and multi-line strings appropriately, but has no
-effect outside them.
-
-Supports Eldoc mode (only for functions, using a Python process),
-Info-Look and Imenu. In Outline minor mode, `class' and `def'
-lines count as headers. Symbol completion is available in the
-same way as in the Python shell using the `rlcompleter' module
-and this is added to the Hippie Expand functions locally if
-Hippie Expand mode is turned on. Completion of symbols of the
-form x.y only works if the components are literal
-module/attribute names, not variables. An abbrev table is set up
-with skeleton expansions for compound statement templates.
-
-\\{python-mode-map}"
- :group 'python
+
+\\{python-mode-map}
+Entry to this mode calls the value of `python-mode-hook'
+if that value is non-nil."
+ (set (make-local-variable 'tab-width) 8)
+ (set (make-local-variable 'indent-tabs-mode) nil)
+
+ (set (make-local-variable 'comment-start) "# ")
+ (set (make-local-variable 'comment-start-skip) "#+\\s-*")
+
+ (set (make-local-variable 'parse-sexp-lookup-properties) t)
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+
+ (set (make-local-variable 'forward-sexp-function)
+ 'python-nav-forward-sexp)
+
(set (make-local-variable 'font-lock-defaults)
- '(python-font-lock-keywords nil nil nil nil
- ;; This probably isn't worth it.
- ;; (font-lock-syntactic-face-function
- ;; . python-font-lock-syntactic-face-function)
- ))
+ '(python-font-lock-keywords nil nil nil nil))
+
(set (make-local-variable 'syntax-propertize-function)
python-syntax-propertize-function)
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'indent-line-function) #'python-indent-line)
+
+ (set (make-local-variable 'indent-line-function)
+ #'python-indent-line-function)
(set (make-local-variable 'indent-region-function) #'python-indent-region)
+
(set (make-local-variable 'paragraph-start) "\\s-*$")
- (set (make-local-variable 'fill-paragraph-function) 'python-fill-paragraph)
- (set (make-local-variable 'require-final-newline) mode-require-final-newline)
- (set (make-local-variable 'add-log-current-defun-function)
- #'python-current-defun)
- (set (make-local-variable 'outline-regexp)
- (rx (* space) (or "class" "def" "elif" "else" "except" "finally"
- "for" "if" "try" "while" "with")
- symbol-end))
- (set (make-local-variable 'outline-heading-end-regexp) ":\\s-*\n")
- (set (make-local-variable 'outline-level) #'python-outline-level)
- (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
+ (set (make-local-variable 'fill-paragraph-function)
+ 'python-fill-paragraph)
+
(set (make-local-variable 'beginning-of-defun-function)
- 'python-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function) 'python-end-of-defun)
- (add-hook 'which-func-functions 'python-which-func nil t)
- (setq imenu-create-index-function #'python-imenu-create-index)
+ #'python-nav-beginning-of-defun)
+ (set (make-local-variable 'end-of-defun-function)
+ #'python-nav-end-of-defun)
+
+ (add-hook 'completion-at-point-functions
+ 'python-completion-complete-at-point nil 'local)
+
+ (add-hook 'post-self-insert-hook
+ 'python-indent-post-self-insert-function nil 'local)
+
+ (set (make-local-variable 'imenu-extract-index-name-function)
+ #'python-info-current-defun)
+
+ (set (make-local-variable 'add-log-current-defun-function)
+ #'python-info-current-defun)
+
+ (add-hook 'which-func-functions #'python-info-current-defun nil t)
+
+ (set (make-local-variable 'skeleton-further-elements)
+ '((abbrev-mode nil)
+ (< '(backward-delete-char-untabify (min python-indent-offset
+ (current-column))))
+ (^ '(- (1+ (current-indentation))))))
+
(set (make-local-variable 'eldoc-documentation-function)
#'python-eldoc-function)
- (add-hook 'eldoc-mode-hook
- (lambda () (run-python nil t)) ; need it running
- nil t)
- (add-hook 'completion-at-point-functions
- 'python-completion-at-point nil 'local)
- ;; Fixme: should be in hideshow. This seems to be of limited use
- ;; since it isn't (can't be) indentation-based. Also hide-level
- ;; doesn't seem to work properly.
+
(add-to-list 'hs-special-modes-alist
- `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#"
- ,(lambda (_arg)
- (python-end-of-defun)
- (skip-chars-backward " \t\n"))
- nil))
- (set (make-local-variable 'skeleton-further-elements)
- '((< '(backward-delete-char-untabify (min python-indent
- (current-column))))
- (^ '(- (1+ (current-indentation))))))
- ;; Python defines TABs as being 8-char wide.
- (set (make-local-variable 'tab-width) 8)
- (when python-guess-indent (python-guess-indent))
- ;; Let's make it harder for the user to shoot himself in the foot.
- (unless (= tab-width python-indent)
- (setq indent-tabs-mode nil))
- (set (make-local-variable 'python-command) python-python-command)
- (python-find-imports)
- (unless (boundp 'python-mode-running) ; kill the recursion from jython-mode
- (let ((python-mode-running t))
- (python-maybe-jython))))
-
-;; Not done automatically in Emacs 21 or 22.
-(defcustom python-mode-hook nil
- "Hook run when entering Python mode."
- :group 'python
- :type 'hook)
-(custom-add-option 'python-mode-hook 'imenu-add-menubar-index)
-(custom-add-option 'python-mode-hook
- (lambda ()
- "Turn off Indent Tabs mode."
- (setq indent-tabs-mode nil)))
-(custom-add-option 'python-mode-hook 'turn-on-eldoc-mode)
-(custom-add-option 'python-mode-hook 'abbrev-mode)
-(custom-add-option 'python-mode-hook 'python-setup-brm)
+ `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#"
+ ,(lambda (arg)
+ (python-nav-end-of-defun)) nil))
-;;;###autoload
-(define-derived-mode jython-mode python-mode "Jython"
- "Major mode for editing Jython files.
-Like `python-mode', but sets up parameters for Jython subprocesses.
-Runs `jython-mode-hook' after `python-mode-hook'."
- :group 'python
- (set (make-local-variable 'python-command) python-jython-command))
+ (set (make-local-variable 'mode-require-final-newline) t)
-
+ (set (make-local-variable 'outline-regexp)
+ (python-rx (* space) block-start))
+ (set (make-local-variable 'outline-heading-end-regexp) ":\\s-*\n")
+ (set (make-local-variable 'outline-level)
+ #'(lambda ()
+ "`outline-level' function for Python mode."
+ (1+ (/ (current-indentation) python-indent-offset))))
-;; pdbtrack features
-
-(defun python-pdbtrack-overlay-arrow (activation)
- "Activate or deactivate arrow at beginning-of-line in current buffer."
- (if activation
- (progn
- (setq overlay-arrow-position (make-marker)
- overlay-arrow-string "=>"
- python-pdbtrack-is-tracking-p t)
- (set-marker overlay-arrow-position
- (line-beginning-position)
- (current-buffer)))
- (setq overlay-arrow-position nil
- python-pdbtrack-is-tracking-p nil)))
-
-(defun python-pdbtrack-track-stack-file (_text)
- "Show the file indicated by the pdb stack entry line, in a separate window.
-
-Activity is disabled if the buffer-local variable
-`python-pdbtrack-do-tracking-p' is nil.
-
-We depend on the pdb input prompt being a match for
-`python-pdbtrack-input-prompt'.
-
-If the traceback target file path is invalid, we look for the
-most recently visited python-mode buffer which either has the
-name of the current function or class, or which defines the
-function or class. This is to provide for scripts not in the
-local file system (e.g., Zope's 'Script \(Python)', but it's not
-Zope specific). If you put a copy of the script in a buffer
-named for the script and activate python-mode, then pdbtrack will
-find it."
- ;; Instead of trying to piece things together from partial text
- ;; (which can be almost useless depending on Emacs version), we
- ;; monitor to the point where we have the next pdb prompt, and then
- ;; check all text from comint-last-input-end to process-mark.
- ;;
- ;; Also, we're very conservative about clearing the overlay arrow,
- ;; to minimize residue. This means, for instance, that executing
- ;; other pdb commands wipe out the highlight. You can always do a
- ;; 'where' (aka 'w') PDB command to reveal the overlay arrow.
-
- (let* ((origbuf (current-buffer))
- (currproc (get-buffer-process origbuf)))
-
- (if (not (and currproc python-pdbtrack-do-tracking-p))
- (python-pdbtrack-overlay-arrow nil)
-
- (let* ((procmark (process-mark currproc))
- (block (buffer-substring (max comint-last-input-end
- (- procmark
- python-pdbtrack-track-range))
- procmark))
- target target_fname target_lineno target_buffer)
-
- (if (not (string-match (concat python-pdbtrack-input-prompt "$") block))
- (python-pdbtrack-overlay-arrow nil)
-
- (setq block (ansi-color-filter-apply block))
- (setq target (python-pdbtrack-get-source-buffer block))
-
- (if (stringp target)
- (progn
- (python-pdbtrack-overlay-arrow nil)
- (message "pdbtrack: %s" target))
-
- (setq target_lineno (car target)
- target_buffer (cadr target)
- target_fname (buffer-file-name target_buffer))
- (switch-to-buffer-other-window target_buffer)
- (goto-char (point-min))
- (forward-line (1- target_lineno))
- (message "pdbtrack: line %s, file %s" target_lineno target_fname)
- (python-pdbtrack-overlay-arrow t)
- (pop-to-buffer origbuf t)
- ;; in large shell buffers, above stuff may cause point to lag output
- (goto-char procmark)
- )))))
- )
-
-(defun python-pdbtrack-get-source-buffer (block)
- "Return line number and buffer of code indicated by block's traceback text.
-
-We look first to visit the file indicated in the trace.
-
-Failing that, we look for the most recently visited python-mode buffer
-with the same name or having the named function.
-
-If we're unable find the source code we return a string describing the
-problem."
-
- (if (not (string-match python-pdbtrack-stack-entry-regexp block))
-
- "Traceback cue not found"
-
- (let* ((filename (match-string 1 block))
- (lineno (string-to-number (match-string 2 block)))
- (funcname (match-string 3 block))
- funcbuffer)
-
- (cond ((file-exists-p filename)
- (list lineno (find-file-noselect filename)))
-
- ((setq funcbuffer (python-pdbtrack-grub-for-buffer funcname lineno))
- (if (string-match "/Script (Python)$" filename)
- ;; Add in number of lines for leading '##' comments:
- (setq lineno
- (+ lineno
- (with-current-buffer funcbuffer
- (if (equal (point-min)(point-max))
- 0
- (count-lines
- (point-min)
- (max (point-min)
- (string-match "^\\([^#]\\|#[^#]\\|#$\\)"
- (buffer-substring
- (point-min) (point-max)))
- )))))))
- (list lineno funcbuffer))
-
- ((= (elt filename 0) ?\<)
- (format "(Non-file source: '%s')" filename))
-
- (t (format "Not found: %s(), %s" funcname filename)))
- )
- )
- )
-
-(defun python-pdbtrack-grub-for-buffer (funcname _lineno)
- "Find recent Python mode buffer named, or having function named FUNCNAME."
- (let ((buffers (buffer-list))
- buf
- got)
- (while (and buffers (not got))
- (setq buf (car buffers)
- buffers (cdr buffers))
- (if (and (with-current-buffer buf
- (string= major-mode "python-mode"))
- (or (string-match funcname (buffer-name buf))
- (string-match (concat "^\\s-*\\(def\\|class\\)\\s-+"
- funcname "\\s-*(")
- (with-current-buffer buf
- (buffer-substring (point-min)
- (point-max))))))
- (setq got buf)))
- got))
-
-;; Python subprocess utilities and filters
-(defun python-execute-file (proc filename)
- "Send to Python interpreter process PROC \"execfile('FILENAME')\".
-Make that process's buffer visible and force display. Also make
-comint believe the user typed this string so that
-`kill-output-from-shell' does The Right Thing."
- (let ((curbuf (current-buffer))
- (procbuf (process-buffer proc))
-; (comint-scroll-to-bottom-on-output t)
- (msg (format "## working on region in file %s...\n" filename))
- ;; add some comment, so that we can filter it out of history
- (cmd (format "execfile(r'%s') # PYTHON-MODE\n" filename)))
- (unwind-protect
- (with-current-buffer procbuf
- (goto-char (point-max))
- (move-marker (process-mark proc) (point))
- (funcall (process-filter proc) proc msg))
- (set-buffer curbuf))
- (process-send-string proc cmd)))
-
-(defun python-pdbtrack-toggle-stack-tracking (arg)
- (interactive "P")
- (if (not (get-buffer-process (current-buffer)))
- (error "No process associated with buffer '%s'" (current-buffer)))
- ;; missing or 0 is toggle, >0 turn on, <0 turn off
- (if (or (not arg)
- (zerop (setq arg (prefix-numeric-value arg))))
- (setq python-pdbtrack-do-tracking-p (not python-pdbtrack-do-tracking-p))
- (setq python-pdbtrack-do-tracking-p (> arg 0)))
- (message "%sabled Python's pdbtrack"
- (if python-pdbtrack-do-tracking-p "En" "Dis")))
-
-(defun turn-on-pdbtrack ()
- (interactive)
- (python-pdbtrack-toggle-stack-tracking 1))
+ (python-skeleton-add-menu-items)
-(defun turn-off-pdbtrack ()
- (interactive)
- (python-pdbtrack-toggle-stack-tracking 0))
+ (make-local-variable 'python-shell-internal-buffer)
-(defun python-sentinel (_proc _msg)
- (setq overlay-arrow-position nil))
+ (when python-indent-guess-indent-offset
+ (python-indent-guess-indent-offset)))
-(defun python-unload-function ()
- "Unload the Python library."
- (remove-hook 'comint-output-filter-functions 'python-pdbtrack-track-stack-file)
- (setq minor-mode-alist (assq-delete-all 'python-pdbtrack-is-tracking-p
- minor-mode-alist))
- (dolist (error '("^No symbol" "^Can't shift all lines enough"))
- (setq debug-ignored-errors (delete error debug-ignored-errors)))
- ;; continue standard unloading
- nil)
(provide 'python)
-(provide 'python-21)
+
+;; Local Variables:
+;; coding: utf-8
+;; indent-tabs-mode: nil
+;; End:
;;; python.el ends here
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index c8b156c5441..9d78b20ba4c 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -1,6 +1,6 @@
;;; ruby-mode.el --- Major mode for editing Ruby files
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Authors: Yukihiro Matsumoto
;; Nobuyoshi Nakada
@@ -64,8 +64,8 @@
"Regexp to match keywords that nest without blocks.")
(defconst ruby-indent-beg-re
- (concat "\\(\\s *" (regexp-opt '("class" "module" "def") t) "\\)\\|"
- (regexp-opt '("if" "unless" "case" "while" "until" "for" "begin")))
+ (concat "^\\s *" (regexp-opt '("class" "module" "def" "if" "unless" "case"
+ "while" "until" "for" "begin")) "\\_>")
"Regexp to match where the indentation gets deeper.")
(defconst ruby-modifier-beg-keywords
@@ -96,12 +96,19 @@
(regexp-opt (append ruby-modifier-beg-keywords ruby-block-op-keywords))
"Regexp to match hanging block modifiers.")
-(defconst ruby-block-end-re "\\<end\\>")
+(defconst ruby-block-end-re "\\_<end\\_>")
+
+(defconst ruby-defun-beg-re
+ '"\\(def\\|class\\|module\\)"
+ "Regexp to match the beginning of a defun, in the general sense.")
(eval-and-compile
(defconst ruby-here-doc-beg-re
"\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)"
- "Regexp to match the beginning of a heredoc."))
+ "Regexp to match the beginning of a heredoc.")
+
+ (defconst ruby-expression-expansion-re
+ "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)"))
(defun ruby-here-doc-end-match ()
"Return a regexp to find the end of a heredoc.
@@ -115,9 +122,9 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
(match-string 6)))))
(defconst ruby-delimiter
- (concat "[?$/%(){}#\"'`.:]\\|<<\\|\\[\\|\\]\\|\\<\\("
+ (concat "[?$/%(){}#\"'`.:]\\|<<\\|\\[\\|\\]\\|\\_<\\("
ruby-block-beg-re
- "\\)\\>\\|" ruby-block-end-re
+ "\\)\\_>\\|" ruby-block-end-re
"\\|^=begin\\|" ruby-here-doc-beg-re))
(defconst ruby-negative
@@ -138,20 +145,12 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
(defvar ruby-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "{" 'ruby-electric-brace)
- (define-key map "}" 'ruby-electric-brace)
- (define-key map (kbd "M-C-a") 'ruby-beginning-of-defun)
- (define-key map (kbd "M-C-e") 'ruby-end-of-defun)
(define-key map (kbd "M-C-b") 'ruby-backward-sexp)
(define-key map (kbd "M-C-f") 'ruby-forward-sexp)
(define-key map (kbd "M-C-p") 'ruby-beginning-of-block)
(define-key map (kbd "M-C-n") 'ruby-end-of-block)
- (define-key map (kbd "M-C-h") 'ruby-mark-defun)
(define-key map (kbd "M-C-q") 'ruby-indent-exp)
- (define-key map (kbd "C-M-h") 'backward-kill-word)
- (define-key map (kbd "C-j") 'reindent-then-newline-and-indent)
- (define-key map (kbd "C-m") 'newline)
- (define-key map (kbd "C-c C-c") 'comment-region)
+ (define-key map (kbd "C-c {") 'ruby-toggle-block)
map)
"Keymap used in Ruby mode.")
@@ -166,6 +165,7 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
(modify-syntax-entry ?$ "." table)
(modify-syntax-entry ?? "_" table)
(modify-syntax-entry ?_ "_" table)
+ (modify-syntax-entry ?: "_" table)
(modify-syntax-entry ?< "." table)
(modify-syntax-entry ?> "." table)
(modify-syntax-entry ?& "." table)
@@ -379,11 +379,21 @@ and `\\' when preceded by `?'."
((and (eq c ?:) (or (not b) (eq (char-syntax b) ? ))))
((eq c ?\\) (eq b ??)))))
+(defun ruby-singleton-class-p (&optional pos)
+ (save-excursion
+ (when pos (goto-char pos))
+ (forward-word -1)
+ (and (or (bolp) (not (eq (char-before (point)) ?_)))
+ (looking-at "class\\s *<<"))))
+
(defun ruby-expr-beg (&optional option)
- "TODO: document."
+ "Check if point is possibly at the beginning of an expression.
+OPTION specifies the type of the expression.
+Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
(save-excursion
(store-match-data nil)
- (let ((space (skip-chars-backward " \t")))
+ (let ((space (skip-chars-backward " \t"))
+ (start (point)))
(cond
((bolp) t)
((progn
@@ -392,9 +402,10 @@ and `\\' when preceded by `?'."
(or (eq (char-syntax (char-before (point))) ?w)
(ruby-special-char-p))))
nil)
- ((and (eq option 'heredoc) (< space 0)) t)
- ((or (looking-at ruby-operator-re)
- (looking-at "[\\[({,;]")
+ ((looking-at ruby-operator-re))
+ ((eq option 'heredoc)
+ (and (< space 0) (not (ruby-singleton-class-p start))))
+ ((or (looking-at "[\\[({,;]")
(and (looking-at "[!?]")
(or (not (eq option 'modifier))
(bolp)
@@ -408,7 +419,7 @@ and `\\' when preceded by `?'."
ruby-block-mid-keywords)
'words))
(goto-char (match-end 0))
- (not (looking-at "\\s_")))
+ (not (looking-at "\\s_\\|!")))
((eq option 'expr-qstr)
(looking-at "[a-zA-Z][a-zA-z0-9_]* +%[^ \t]"))
((eq option 'expr-re)
@@ -565,7 +576,7 @@ and `\\' when preceded by `?'."
(setq nest (cons (cons nil pnt) nest))
(setq depth (1+ depth))))
(goto-char (match-end 0)))
- ((looking-at (concat "\\<\\(" ruby-block-beg-re "\\)\\>"))
+ ((looking-at (concat "\\_<\\(" ruby-block-beg-re "\\)\\_>"))
(and
(save-match-data
(or (not (looking-at (concat "do" ruby-keyword-end-re)))
@@ -580,9 +591,7 @@ and `\\' when preceded by `?'."
(eq ?. w)))))
(goto-char pnt)
(setq w (char-after (point)))
- (not (eq ?_ w))
(not (eq ?! w))
- (not (eq ?? w))
(skip-chars-forward " \t")
(goto-char (match-beginning 0))
(or (not (looking-at ruby-modifier-re))
@@ -593,7 +602,7 @@ and `\\' when preceded by `?'."
(goto-char pnt))
((looking-at ":\\(['\"]\\)")
(goto-char (match-beginning 1))
- (ruby-forward-string (buffer-substring (match-beginning 1) (match-end 1)) end))
+ (ruby-forward-string (match-string 1) end t))
((looking-at ":\\([-,.+*/%&|^~<>]=?\\|===?\\|<=>\\|![~=]?\\)")
(goto-char (match-end 0)))
((looking-at ":\\([a-zA-Z_][a-zA-Z_0-9]*[!?=]?\\)?")
@@ -783,7 +792,7 @@ and `\\' when preceded by `?'."
(not (looking-at "[a-z_]"))))
(and (looking-at ruby-operator-re)
(not (ruby-special-char-p))
- ;; operator at the end of line
+ ;; Operator at the end of line.
(let ((c (char-after (point))))
(and
;; (or (null begin)
@@ -793,8 +802,9 @@ and `\\' when preceded by `?'."
;; (not (or (eolp) (looking-at "#")
;; (and (eq (car (nth 1 state)) ?{)
;; (looking-at "|"))))))
- (or (not (eq ?/ c))
- (null (nth 0 (ruby-parse-region (or begin parse-start) (point)))))
+ ;; Not a regexp or percent literal.
+ (null (nth 0 (ruby-parse-region (or begin parse-start)
+ (point))))
(or (not (eq ?| (char-after (point))))
(save-excursion
(or (eolp) (forward-char -1))
@@ -832,20 +842,13 @@ and `\\' when preceded by `?'."
(+ indent ruby-indent-level)
indent))))
-(defun ruby-electric-brace (arg)
- "Insert a brace and re-indent the current line."
- (interactive "P")
- (self-insert-command (prefix-numeric-value arg))
- (ruby-indent-line t))
-
-;; TODO: Why isn't one ruby-*-of-defun written in terms of the other?
(defun ruby-beginning-of-defun (&optional arg)
"Move backward to the beginning of the current top-level defun.
With ARG, move backward multiple defuns. Negative ARG means
move forward."
(interactive "p")
- (and (re-search-backward (concat "^\\(" ruby-block-beg-re "\\)\\b")
- nil 'move (or arg 1))
+ (and (re-search-backward (concat "^\\s *" ruby-defun-beg-re "\\_>")
+ nil t (or arg 1))
(beginning-of-line)))
(defun ruby-end-of-defun (&optional arg)
@@ -853,54 +856,69 @@ move forward."
With ARG, move forward multiple defuns. Negative ARG means
move backward."
(interactive "p")
- (and (re-search-forward (concat "^\\(" ruby-block-end-re "\\)\\($\\|\\b[^_]\\)")
- nil 'move (or arg 1))
- (beginning-of-line))
- (forward-line 1))
+ (ruby-forward-sexp)
+ (when (looking-back (concat "^\\s *" ruby-block-end-re))
+ (forward-line 1)))
(defun ruby-beginning-of-indent ()
- "TODO: document"
- ;; I don't understand this function.
- ;; It seems like it should move to the line where indentation should deepen,
- ;; but ruby-indent-beg-re only accounts for whitespace before class, module and def,
- ;; so this will only match other block beginners at the beginning of the line.
- (and (re-search-backward (concat "^\\(" ruby-indent-beg-re "\\)\\b") nil 'move)
- (beginning-of-line)))
+ "Backtrack to a line which can be used as a reference for
+calculating indentation on the lines after it."
+ (while (and (re-search-backward ruby-indent-beg-re nil 'move)
+ (if (ruby-in-ppss-context-p 'anything)
+ t
+ ;; We can stop, then.
+ (beginning-of-line)))))
(defun ruby-move-to-block (n)
- "Move to the beginning (N < 0) or the end (N > 0) of the current block
-or blocks containing the current block."
- ;; TODO: Make this work for n > 1,
- ;; make it not loop for n = 0,
- ;; document body
- (let (start pos done down)
- (setq start (ruby-calculate-indent))
- (setq down (looking-at (if (< n 0) ruby-block-end-re
- (concat "\\<\\(" ruby-block-beg-re "\\)\\>"))))
- (while (and (not done) (not (if (< n 0) (bobp) (eobp))))
- (forward-line n)
- (cond
- ((looking-at "^\\s *$"))
- ((looking-at "^\\s *#"))
- ((and (> n 0) (looking-at "^=begin\\>"))
- (re-search-forward "^=end\\>"))
- ((and (< n 0) (looking-at "^=end\\>"))
- (re-search-backward "^=begin\\>"))
- (t
- (setq pos (current-indentation))
+ "Move to the beginning (N < 0) or the end (N > 0) of the
+current block, a sibling block, or an outer block. Do that (abs N) times."
+ (let ((orig (point))
+ (start (ruby-calculate-indent))
+ (signum (if (> n 0) 1 -1))
+ (backward (< n 0))
+ down pos done)
+ (dotimes (_ (abs n))
+ (setq done nil)
+ (setq down (save-excursion
+ (back-to-indentation)
+ ;; There is a block start or block end keyword on this
+ ;; line, don't need to look for another block.
+ (and (re-search-forward
+ (if backward ruby-block-end-re
+ (concat "\\_<\\(" ruby-block-beg-re "\\)\\_>"))
+ (line-end-position) t)
+ (not (nth 8 (syntax-ppss))))))
+ (while (and (not done) (not (if backward (bobp) (eobp))))
+ (forward-line signum)
(cond
- ((< start pos)
- (setq down t))
- ((and down (= pos start))
- (setq done t))
- ((> start pos)
- (setq done t)))))
- (if done
- (save-excursion
- (back-to-indentation)
- (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>"))
- (setq done nil))))))
- (back-to-indentation))
+ ;; Skip empty and commented out lines.
+ ((looking-at "^\\s *$"))
+ ((looking-at "^\\s *#"))
+ ;; Skip block comments;
+ ((and (not backward) (looking-at "^=begin\\>"))
+ (re-search-forward "^=end\\>"))
+ ((and backward (looking-at "^=end\\>"))
+ (re-search-backward "^=begin\\>"))
+ (t
+ (setq pos (current-indentation))
+ (cond
+ ;; Deeper indentation, we found a block.
+ ;; FIXME: We can't recognize empty blocks this way.
+ ((< start pos)
+ (setq down t))
+ ;; Block found, and same indentation as when started, stop.
+ ((and down (= pos start))
+ (setq done t))
+ ;; Shallower indentation, means outer block, can stop now.
+ ((> start pos)
+ (setq done t)))))
+ (if done
+ (save-excursion
+ (back-to-indentation)
+ ;; Not really at the first or last line of the block, move on.
+ (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>"))
+ (setq done nil))))))
+ (back-to-indentation)))
(defun ruby-beginning-of-block (&optional arg)
"Move backward to the beginning of the current block.
@@ -911,8 +929,7 @@ With ARG, move up multiple blocks."
(defun ruby-end-of-block (&optional arg)
"Move forward to the end of the current block.
With ARG, move out of multiple blocks."
- ;; Passing a value > 1 to ruby-move-to-block currently doesn't work.
- (interactive)
+ (interactive "p")
(ruby-move-to-block (or arg 1)))
(defun ruby-forward-sexp (&optional arg)
@@ -1005,15 +1022,6 @@ With ARG, do it many times. Negative ARG means move forward."
((error)))
i)))
-(defun ruby-mark-defun ()
- "Put mark at end of this Ruby function, point at beginning."
- (interactive)
- (push-mark (point))
- (ruby-end-of-defun)
- (push-mark (point) nil t)
- (ruby-beginning-of-defun)
- (re-search-backward "^\n" (- (point) 1) t))
-
(defun ruby-indent-exp (&optional ignored)
"Indent each line in the balanced expression following the point."
(interactive "*P")
@@ -1044,21 +1052,19 @@ For example:
#exit
String#gsub
Net::HTTP#active?
- File::open.
+ File.open
See `add-log-current-defun-function'."
- ;; TODO: Document body
- ;; Why does this append a period to class methods?
(condition-case nil
(save-excursion
(let (mname mlist (indent 0))
- ;; get current method (or class/module)
+ ;; Get the current method definition (or class/module).
(if (re-search-backward
- (concat "^[ \t]*\\(def\\|class\\|module\\)[ \t]+"
+ (concat "^[ \t]*" ruby-defun-beg-re "[ \t]+"
"\\("
- ;; \\. and :: for class method
- "\\([A-Za-z_]" ruby-symbol-re "*\\|\\.\\|::" "\\)"
- "+\\)")
+ ;; \\. and :: for class methods
+ "\\([A-Za-z_]" ruby-symbol-re "*\\|\\.\\|::" "\\)"
+ "+\\)")
nil t)
(progn
(setq mname (match-string 2))
@@ -1067,7 +1073,7 @@ See `add-log-current-defun-function'."
(goto-char (match-beginning 1))
(setq indent (current-column))
(beginning-of-line)))
- ;; nest class/module
+ ;; Walk up the class/module nesting.
(while (and (> indent 0)
(re-search-backward
(concat
@@ -1080,64 +1086,185 @@ See `add-log-current-defun-function'."
(setq mlist (cons (match-string 2) mlist))
(setq indent (current-column))
(beginning-of-line))))
+ ;; Process the method name.
(when mname
(let ((mn (split-string mname "\\.\\|::")))
(if (cdr mn)
(progn
- (cond
- ((string-equal "" (car mn))
- (setq mn (cdr mn) mlist nil))
- ((string-equal "self" (car mn))
- (setq mn (cdr mn)))
- ((let ((ml (nreverse mlist)))
+ (unless (string-equal "self" (car mn)) ; def self.foo
+ ;; def C.foo
+ (let ((ml (nreverse mlist)))
+ ;; If the method name references one of the
+ ;; containing modules, drop the more nested ones.
(while ml
(if (string-equal (car ml) (car mn))
(setq mlist (nreverse (cdr ml)) ml nil))
- (or (setq ml (cdr ml)) (nreverse mlist))))))
- (if mlist
- (setcdr (last mlist) mn)
- (setq mlist mn))
- (setq mn (last mn 2))
- (setq mname (concat "." (cadr mn)))
- (setcdr mn nil))
+ (or (setq ml (cdr ml)) (nreverse mlist))))
+ (if mlist
+ (setcdr (last mlist) (butlast mn))
+ (setq mlist (butlast mn))))
+ (setq mname (concat "." (car (last mn)))))
(setq mname (concat "#" mname)))))
- ;; generate string
+ ;; Generate the string.
(if (consp mlist)
(setq mlist (mapconcat (function identity) mlist "::")))
(if mname
(if mlist (concat mlist mname) mname)
mlist)))))
+(defun ruby-brace-to-do-end (orig end)
+ (let (beg-marker end-marker)
+ (goto-char end)
+ (when (eq (char-before) ?\})
+ (delete-char -1)
+ (when (save-excursion
+ (skip-chars-backward " \t")
+ (not (bolp)))
+ (insert "\n"))
+ (insert "end")
+ (setq end-marker (point-marker))
+ (when (and (not (eobp)) (eq (char-syntax (char-after)) ?w))
+ (insert " "))
+ (goto-char orig)
+ (delete-char 1)
+ (when (eq (char-syntax (char-before)) ?w)
+ (insert " "))
+ (insert "do")
+ (setq beg-marker (point-marker))
+ (when (looking-at "\\(\\s \\)*|")
+ (unless (match-beginning 1)
+ (insert " "))
+ (goto-char (1+ (match-end 0)))
+ (search-forward "|"))
+ (unless (looking-at "\\s *$")
+ (insert "\n"))
+ (indent-region beg-marker end-marker)
+ (goto-char beg-marker)
+ t)))
+
+(defun ruby-do-end-to-brace (orig end)
+ (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.
+The block must begin on the current line or above it and end after the point.
+If the result is do-end block, it will always be multiline."
+ (interactive)
+ (let ((start (point)) beg end)
+ (end-of-line)
+ (unless
+ (if (and (re-search-backward "\\({\\)\\|\\_<do\\(\\s \\|$\\||\\)")
+ (progn
+ (setq beg (point))
+ (save-match-data (ruby-forward-sexp))
+ (setq end (point))
+ (> end start)))
+ (if (match-beginning 1)
+ (ruby-brace-to-do-end beg end)
+ (ruby-do-end-to-brace beg end)))
+ (goto-char start))))
+
(declare-function ruby-syntax-propertize-heredoc "ruby-mode" (limit))
+(declare-function ruby-syntax-enclosing-percent-literal "ruby-mode" (limit))
+(declare-function ruby-syntax-propertize-percent-literal "ruby-mode" (limit))
(if (eval-when-compile (fboundp #'syntax-propertize-rules))
;; New code that works independently from font-lock.
(progn
+ (eval-and-compile
+ (defconst ruby-percent-literal-beg-re
+ "\\(%\\)[qQrswWx]?\\([[:punct:]]\\)"
+ "Regexp to match the beginning of percent literal.")
+
+ (defconst ruby-syntax-methods-before-regexp
+ '("gsub" "gsub!" "sub" "sub!" "scan" "split" "split!" "index" "match"
+ "assert_match" "Given" "Then" "When")
+ "Methods that can take regexp as the first argument.
+It will be properly highlighted even when the call omits parens."))
+
(defun ruby-syntax-propertize-function (start end)
"Syntactic keywords for Ruby mode. See `syntax-propertize-function'."
(goto-char start)
(ruby-syntax-propertize-heredoc end)
+ (ruby-syntax-enclosing-percent-literal end)
(funcall
(syntax-propertize-rules
- ;; #{ }, #$hoge, #@foo are not comments
- ("\\(#\\)[{$@]" (1 "."))
- ;; $' $" $` .... are variables
- ;; ?' ?" ?` are ascii codes
+ ;; $' $" $` .... are variables.
+ ;; ?' ?" ?` are ascii codes.
("\\([?$]\\)[#\"'`]"
(1 (unless (save-excursion
;; Not within a string.
(nth 3 (syntax-ppss (match-beginning 0))))
(string-to-syntax "\\"))))
- ;; regexps
- ("\\(^\\|[[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
- (4 "\"/")
- (6 "\"/"))
+ ;; Regexps: regexps are distinguished from division because
+ ;; of the keyword, symbol, or method name before them.
+ ((concat
+ ;; Special tokens that can't be followed by a division operator.
+ "\\(^\\|[[=(,~?:;<>]"
+ ;; Control flow keywords and operators following bol or whitespace.
+ "\\|\\(?:^\\|\\s \\)"
+ (regexp-opt '("if" "elsif" "unless" "while" "until" "when" "and"
+ "or" "not" "&&" "||"))
+ ;; Method name from the list.
+ "\\|\\_<"
+ (regexp-opt ruby-syntax-methods-before-regexp)
+ "\\)\\s *"
+ ;; The regular expression itself.
+ "\\(/\\)[^/\n\\\\]*\\(?:\\\\.[^/\n\\\\]*\\)*\\(/\\)")
+ (2 (string-to-syntax "\"/"))
+ (3 (string-to-syntax "\"/")))
("^=en\\(d\\)\\_>" (1 "!"))
("^\\(=\\)begin\\_>" (1 "!"))
;; Handle here documents.
((concat ruby-here-doc-beg-re ".*\\(\n\\)")
- (7 (prog1 "\"" (ruby-syntax-propertize-heredoc end)))))
- (point) end))
+ (7 (unless (ruby-singleton-class-p (match-beginning 0))
+ (put-text-property (match-beginning 7) (match-end 7)
+ 'syntax-table (string-to-syntax "\""))
+ (ruby-syntax-propertize-heredoc end))))
+ ;; Handle percent literals: %w(), %q{}, etc.
+ ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re)
+ (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end)))))
+ (point) end)
+ (remove-text-properties start end '(ruby-expansion-match-data))
+ (goto-char start)
+ ;; Find all expression expansions and
+ ;; - set the syntax of all text inside to whitespace,
+ ;; - save the match data to a text property, for font-locking later.
+ (while (re-search-forward ruby-expression-expansion-re end 'move)
+ (when (ruby-in-ppss-context-p 'string)
+ (put-text-property (match-beginning 2) (match-end 2)
+ 'syntax-table (string-to-syntax "-"))
+ (put-text-property (match-beginning 2) (1+ (match-beginning 2))
+ 'ruby-expansion-match-data
+ (match-data)))))
(defun ruby-syntax-propertize-heredoc (limit)
(let ((ppss (syntax-ppss))
@@ -1148,7 +1275,8 @@ See `add-log-current-defun-function'."
(beginning-of-line)
(while (re-search-forward ruby-here-doc-beg-re
(line-end-position) t)
- (push (concat (ruby-here-doc-end-match) "\n") res)))
+ (unless (ruby-singleton-class-p (match-beginning 0))
+ (push (concat (ruby-here-doc-end-match) "\n") res))))
(let ((start (point)))
;; With multiple openers on the same line, we don't know in which
;; part `start' is, so we have to go back to the beginning.
@@ -1162,6 +1290,47 @@ See `add-log-current-defun-function'."
;; Make extra sure we don't move back, lest we could fall into an
;; inf-loop.
(if (< (point) start) (goto-char start))))))
+
+ (defun ruby-syntax-enclosing-percent-literal (limit)
+ (let ((state (syntax-ppss))
+ (start (point)))
+ ;; When already inside percent literal, re-propertize it.
+ (when (eq t (nth 3 state))
+ (goto-char (nth 8 state))
+ (when (looking-at ruby-percent-literal-beg-re)
+ (ruby-syntax-propertize-percent-literal limit))
+ (when (< (point) start) (goto-char start)))))
+
+ (defun ruby-syntax-propertize-percent-literal (limit)
+ (goto-char (match-beginning 2))
+ ;; Not inside a simple string or comment.
+ (when (eq t (nth 3 (syntax-ppss)))
+ (let* ((op (char-after))
+ (ops (char-to-string op))
+ (cl (or (cdr (aref (syntax-table) op))
+ (cdr (assoc op '((?< . ?>))))))
+ parse-sexp-lookup-properties)
+ (condition-case nil
+ (progn
+ (if cl ; Paired delimiters.
+ ;; Delimiter pairs of the same kind can be nested
+ ;; inside the literal, as long as they are balanced.
+ ;; Create syntax table that ignores other characters.
+ (with-syntax-table (make-char-table 'syntax-table nil)
+ (modify-syntax-entry op (concat "(" (char-to-string cl)))
+ (modify-syntax-entry cl (concat ")" ops))
+ (modify-syntax-entry ?\\ "\\")
+ (save-restriction
+ (narrow-to-region (point) limit)
+ (forward-list))) ; skip to the paired character
+ ;; Single character delimiter.
+ (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*"
+ (regexp-quote ops)) limit nil))
+ ;; Found the closing delimiter.
+ (put-text-property (1- (point)) (point) 'syntax-table
+ (string-to-syntax "|")))
+ ;; Unclosed literal, leave the following text unpropertized.
+ ((scan-error search-failed) (goto-char limit))))))
)
;; For Emacsen where syntax-propertize-rules is not (yet) available,
@@ -1191,8 +1360,7 @@ This should only be called after matching against `ruby-here-doc-end-re'."
(concat "-?\\([\"']\\|\\)" contents "\\1"))))))
(defconst ruby-font-lock-syntactic-keywords
- `( ;; #{ }, #$hoge, #@foo are not comments
- ("\\(#\\)[{$@]" 1 (1 . nil))
+ `(
;; the last $', $", $` in the respective string is not variable
;; the last ?', ?", ?` in the respective string is not ascii code
("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
@@ -1206,6 +1374,10 @@ This should only be called after matching against `ruby-here-doc-end-re'."
(4 (7 . ?/))
(6 (7 . ?/)))
("^=en\\(d\\)\\_>" 1 "!")
+ ;; Percent literal.
+ ("\\(^\\|[[ \t\n<+(,=]\\)\\(%[xrqQwW]?\\([^<[{(a-zA-Z0-9 \n]\\)[^\n\\\\]*\\(\\\\.[^\n\\\\]*\\)*\\(\\3\\)\\)"
+ (3 "\"")
+ (5 "\""))
("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax))
;; Currently, the following case is highlighted incorrectly:
;;
@@ -1245,7 +1417,8 @@ isn't in a string or another comment."
(let ((old-point (point)) (case-fold-search nil))
(beginning-of-line)
(catch 'found-beg
- (while (re-search-backward ruby-here-doc-beg-re nil t)
+ (while (and (re-search-backward ruby-here-doc-beg-re nil t)
+ (not (ruby-singleton-class-p)))
(if (not (or (ruby-in-ppss-context-p 'anything)
(ruby-here-doc-find-end old-point)))
(throw 'found-beg t)))))))
@@ -1405,34 +1578,42 @@ See `font-lock-syntax-table'.")
ruby-keyword-end-re)
2)
;; here-doc beginnings
- (list ruby-here-doc-beg-re 0 'font-lock-string-face)
+ `(,ruby-here-doc-beg-re 0 (unless (ruby-singleton-class-p (match-beginning 0))
+ 'font-lock-string-face))
;; variables
'("\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(nil\\|self\\|true\\|false\\)\\>"
2 font-lock-variable-name-face)
+ ;; symbols
+ '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|@?\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
+ 2 font-lock-constant-face)
;; variables
'("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W"
1 font-lock-variable-name-face)
'("\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+"
0 font-lock-variable-name-face)
- ;; general delimited string
- '("\\(^\\|[[ \t\n<+(,=]\\)\\(%[xrqQwW]?\\([^<[{(a-zA-Z0-9 \n]\\)[^\n\\\\]*\\(\\\\.[^\n\\\\]*\\)*\\(\\3\\)\\)"
- (2 font-lock-string-face))
;; constants
'("\\(^\\|[^_]\\)\\b\\([A-Z]+\\(\\w\\|_\\)*\\)"
2 font-lock-type-face)
- ;; symbols
- '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
- 2 font-lock-reference-face)
- '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-reference-face)
+ '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face)
;; expression expansion
- '("#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)"
- 0 font-lock-variable-name-face t)
+ '(ruby-match-expression-expansion
+ 2 font-lock-variable-name-face t)
;; warn lower camel case
;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)"
; 0 font-lock-warning-face)
)
"Additional expressions to highlight in Ruby mode.")
+(defun ruby-match-expression-expansion (limit)
+ (let ((prop 'ruby-expansion-match-data) pos value)
+ (when (and (setq pos (next-single-char-property-change (point) prop
+ nil limit))
+ (> pos (point)))
+ (goto-char pos)
+ (or (and (setq value (get-text-property pos prop))
+ (progn (set-match-data value) t))
+ (ruby-match-expression-expansion limit)))))
+
;;;###autoload
(define-derived-mode ruby-mode prog-mode "Ruby"
"Major mode for editing Ruby scripts.
@@ -1449,6 +1630,10 @@ The variable `ruby-indent-level' controls the amount of indentation.
'ruby-imenu-create-index)
(set (make-local-variable 'add-log-current-defun-function)
'ruby-add-log-current-method)
+ (set (make-local-variable 'beginning-of-defun-function)
+ 'ruby-beginning-of-defun)
+ (set (make-local-variable 'end-of-defun-function)
+ 'ruby-end-of-defun)
(add-hook
(cond ((boundp 'before-save-hook) 'before-save-hook)
@@ -1476,6 +1661,8 @@ The variable `ruby-indent-level' controls the amount of indentation.
;;;###autoload
(add-to-list 'auto-mode-alist (cons (purecopy "\\.rb\\'") 'ruby-mode))
+;;;###autoload
+(add-to-list 'auto-mode-alist '("Rakefile\\'" . ruby-mode))
;;;###autoload
(dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8"))
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index 66300d97621..7cab07fe387 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -1,6 +1,6 @@
;;; scheme.el --- Scheme (and DSSSL) editing mode
-;; Copyright (C) 1986-1988, 1997-1998, 2001-2011
+;; Copyright (C) 1986-1988, 1997-1998, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Bill Rozas <jinx@martigny.ai.mit.edu>
@@ -201,7 +201,7 @@ Editing commands are similar to those of `lisp-mode'.
In addition, if an inferior Scheme process is running, some additional
commands will be defined, for evaluating expressions and controlling
the interpreter, and the state of the process will be displayed in the
-modeline of all Scheme buffers. The names of commands that interact
+mode line of all Scheme buffers. The names of commands that interact
with the Scheme process start with \"xscheme-\" if you use the MIT
Scheme-specific `xscheme' package; for more information see the
documentation for `xscheme-interaction-mode'. Use \\[run-scheme] to
@@ -229,7 +229,7 @@ Set this to nil if you normally use another dialect."
(defcustom dsssl-sgml-declaration
"<!DOCTYPE style-sheet PUBLIC \"-//James Clark//DTD DSSSL Style Sheet//EN\">
"
- "*An SGML declaration for the DSSSL file.
+ "An SGML declaration for the DSSSL file.
If it is defined as a string this will be inserted into an empty buffer
which is in `dsssl-mode'. It is typically James Clark's style-sheet
doctype, as required for Jade."
@@ -251,7 +251,7 @@ See `run-hooks'."
;; This is shared by cmuscheme and xscheme.
(defcustom scheme-program-name "scheme"
- "*Program invoked by the `run-scheme' command."
+ "Program invoked by the `run-scheme' command."
:type 'string
:group 'scheme)
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 62ca2ce085f..5af14e51f49 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1,6 +1,6 @@
;;; sh-script.el --- shell-script editing commands for Emacs
-;; Copyright (C) 1993-1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1997, 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Version: 2.0f
@@ -198,10 +198,15 @@
(eval-when-compile
(require 'skeleton)
- (require 'cl)
+ (require 'cl-lib)
(require 'comint))
(require 'executable)
+(autoload 'comint-completion-at-point "comint")
+(autoload 'comint-filename-completion "comint")
+(autoload 'shell-command-completion "shell")
+(autoload 'shell-environment-variable-completion "shell")
+
(defvar font-lock-comment-face)
(defvar font-lock-set-defaults)
(defvar font-lock-string-face)
@@ -326,7 +331,16 @@ shell it really is."
(defcustom sh-imenu-generic-expression
`((sh
- . ((nil "^\\s-*\\(function\\s-+\\)?\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*()" 2))))
+ . ((nil
+ ;; function FOO
+ ;; function FOO()
+ "^\\s-*function\\s-+\\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*\\(?:()\\)?"
+ 1)
+ ;; FOO()
+ (nil
+ "^\\s-*\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*()"
+ 1)
+ )))
"Alist of regular expressions for recognizing shell function definitions.
See `sh-feature' and `imenu-generic-expression'."
:type '(alist :key-type (symbol :tag "Shell")
@@ -460,16 +474,7 @@ This is buffer-local in every such buffer.")
(define-key map "\C-c+" 'sh-add)
(define-key map "\C-\M-x" 'sh-execute-region)
(define-key map "\C-c\C-x" 'executable-interpret)
- ;; FIXME: Use post-self-insert-hook.
- (define-key map "<" 'sh-maybe-here-document)
- (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 "`" 'skeleton-pair-insert-maybe)
- (define-key map "\"" 'skeleton-pair-insert-maybe)
-
- (define-key map [remap complete-tag] 'comint-dynamic-complete)
+
(define-key map [remap delete-backward-char]
'backward-delete-char-untabify)
(define-key map "\C-c:" 'sh-set-shell)
@@ -478,10 +483,10 @@ This is buffer-local in every such buffer.")
(define-key map [menu-bar sh-script] (cons "Sh-Script" menu-map))
(define-key menu-map [sh-learn-buffer-indent]
'(menu-item "Learn buffer indentation" sh-learn-buffer-indent
- :help "Learn how to indent the buffer the way it currently is."))
+ :help "Learn how to indent the buffer the way it currently is."))
(define-key menu-map [sh-learn-line-indent]
'(menu-item "Learn line indentation" sh-learn-line-indent
- :help "Learn how to indent a line as it currently is indented"))
+ :help "Learn how to indent a line as it currently is indented"))
(define-key menu-map [sh-show-indent]
'(menu-item "Show indentation" sh-show-indent
:help "Show the how the current line would be indented"))
@@ -491,13 +496,9 @@ This is buffer-local in every such buffer.")
(define-key menu-map [sh-pair]
'(menu-item "Insert braces and quotes in pairs"
- (lambda ()
- (interactive)
- (require 'skeleton)
- (setq skeleton-pair (not skeleton-pair)))
- :button (:toggle . (and (boundp 'skeleton-pair)
- skeleton-pair))
- :help "Inserting a brace or quote automatically inserts the matching pair"))
+ electric-pair-mode
+ :button (:toggle . (bound-and-true-p electric-pair-mode))
+ :help "Inserting a brace or quote automatically inserts the matching pair"))
(define-key menu-map [sh-s0] '("--"))
;; Insert
@@ -506,7 +507,7 @@ This is buffer-local in every such buffer.")
:help "Insert a function definition"))
(define-key menu-map [sh-add]
'(menu-item "Addition..." sh-add
- :help "Insert an addition of VAR and prefix DELTA for Bourne (type) shell"))
+ :help "Insert an addition of VAR and prefix DELTA for Bourne (type) shell"))
(define-key menu-map [sh-until]
'(menu-item "Until Loop" sh-until
:help "Insert an until loop"))
@@ -537,16 +538,16 @@ This is buffer-local in every such buffer.")
(define-key menu-map [sh-s1] '("--"))
(define-key menu-map [sh-exec]
'(menu-item "Execute region" sh-execute-region
- :help "Pass optional header and region to a subshell for noninteractive execution"))
+ :help "Pass optional header and region to a subshell for noninteractive execution"))
(define-key menu-map [sh-exec-interpret]
'(menu-item "Execute script..." executable-interpret
- :help "Run script with user-specified args, and collect output in a buffer"))
+ :help "Run script with user-specified args, and collect output in a buffer"))
(define-key menu-map [sh-set-shell]
'(menu-item "Set shell type..." sh-set-shell
:help "Set this buffer's shell to SHELL (a string)"))
(define-key menu-map [sh-backslash-region]
'(menu-item "Backslash region" sh-backslash-region
- :help "Insert, align, or delete end-of-line backslashes on the lines in the region."))
+ :help "Insert, align, or delete end-of-line backslashes on the lines in the region."))
map)
"Keymap used in Shell-Script mode.")
@@ -556,17 +557,18 @@ This is buffer-local in every such buffer.")
"Value to use for `skeleton-pair-default-alist' in Shell-Script mode.")
(defcustom sh-dynamic-complete-functions
- '(shell-dynamic-complete-environment-variable
- shell-dynamic-complete-command
- comint-dynamic-complete-filename)
+ '(shell-environment-variable-completion
+ shell-command-completion
+ comint-filename-completion)
"Functions for doing TAB dynamic completion."
:type '(repeat function)
:group 'sh-script)
(defcustom sh-assignment-regexp
- '((csh . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=")
+ `((csh . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=")
;; actually spaces are only supported in let/(( ... ))
- (ksh88 . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?[ \t]*\\([-+*/%&|~^]\\|<<\\|>>\\)?=")
+ (ksh88 . ,(concat "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?"
+ "[ \t]*\\(?:[-+*/%&|~^]\\|<<\\|>>\\)?="))
(bash . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?\\+?=")
(rc . "\\<\\([[:alnum:]_*]+\\)[ \t]*=")
(sh . "\\<\\([[:alnum:]_]+\\)="))
@@ -938,6 +940,17 @@ See `sh-feature'.")
(concat "<<-?\\s-*\\\\?\\(\\(?:['\"][^'\"]+['\"]\\|\\sw\\|[-/~._]\\)+\\)"
sh-escaped-line-re "\\(\n\\)")))
+(defun sh--inside-noncommand-expression (pos)
+ (save-excursion
+ (let ((ppss (syntax-ppss pos)))
+ (when (nth 1 ppss)
+ (goto-char (nth 1 ppss))
+ (pcase (char-after)
+ ;; $((...)) or $[...] or ${...}.
+ (`?\( (and (eq ?\( (char-before))
+ (eq ?\$ (char-before (1- (point))))))
+ ((or `?\{ `?\[) (eq ?\$ (char-before))))))))
+
(defun sh-font-lock-open-heredoc (start string eol)
"Determine the syntax of the \\n after a <<EOF.
START is the position of <<.
@@ -946,7 +959,8 @@ INDENTED is non-nil if the here document's content (and the EOF mark) can
be indented (i.e. a <<- was used rather than just <<).
Point is at the beginning of the next line."
(unless (or (memq (char-before start) '(?< ?>))
- (sh-in-comment-or-string start))
+ (sh-in-comment-or-string start)
+ (sh--inside-noncommand-expression start))
;; We're looking at <<STRING, so we add "^STRING$" to the syntactic
;; font-lock keywords to detect the end of this here document.
(let ((str (replace-regexp-in-string "['\"]" "" string))
@@ -996,31 +1010,31 @@ subshells can nest."
(while (and state (progn (skip-chars-forward "^'\\\\\"`$()" limit)
(< (point) limit)))
;; unescape " inside a $( ... ) construct.
- (case (char-after)
- (?\' (case state
- (double-quote nil)
- (t (forward-char 1) (skip-chars-forward "^'" limit))))
+ (pcase (char-after)
+ (?\' (pcase state
+ (`double-quote nil)
+ (_ (forward-char 1) (skip-chars-forward "^'" limit))))
(?\\ (forward-char 1))
- (?\" (case state
- (double-quote (setq state (pop states)))
- (t (push state states) (setq state 'double-quote)))
+ (?\" (pcase state
+ (`double-quote (setq state (pop states)))
+ (_ (push state states) (setq state 'double-quote)))
(if state (put-text-property (point) (1+ (point))
'syntax-table '(1))))
- (?\` (case state
- (backquote (setq state (pop states)))
- (t (push state states) (setq state 'backquote))))
+ (?\` (pcase state
+ (`backquote (setq state (pop states)))
+ (_ (push state states) (setq state 'backquote))))
(?\$ (if (not (eq (char-after (1+ (point))) ?\())
nil
(forward-char 1)
- (case state
- (t (push state states) (setq state 'code)))))
- (?\( (case state
- (double-quote nil)
- (t (push state states) (setq state 'code))))
- (?\) (case state
- (double-quote nil)
- (t (setq state (pop states)))))
- (t (error "Internal error in sh-font-lock-quoted-subshell")))
+ (pcase state
+ (_ (push state states) (setq state 'code)))))
+ (?\( (pcase state
+ (`double-quote nil)
+ (_ (push state states) (setq state 'code))))
+ (?\) (pcase state
+ (`double-quote nil)
+ (_ (setq state (pop states)))))
+ (_ (error "Internal error in sh-font-lock-quoted-subshell")))
(forward-char 1)))))
@@ -1031,50 +1045,57 @@ subshells can nest."
(defun sh-font-lock-paren (start)
(unless (nth 8 (syntax-ppss))
(save-excursion
- (goto-char start)
- ;; Skip through all patterns
- (while
- (progn
- (while
- (progn
- (forward-comment (- (point-max)))
- (when (and (eolp) (sh-is-quoted-p (point)))
- (forward-char -1)
- t)))
- ;; Skip through one pattern
- (while
- (or (/= 0 (skip-syntax-backward "w_"))
- (/= 0 (skip-chars-backward "-$=?[]*@/\\\\"))
- (and (sh-is-quoted-p (1- (point)))
- (goto-char (- (point) 2)))
- (when (memq (char-before) '(?\" ?\' ?\}))
- (condition-case nil (progn (backward-sexp 1) t)
- (error nil)))))
- ;; Patterns can be preceded by an open-paren (Bug#1320).
- (if (eq (char-before (point)) ?\()
+ (let ((open nil))
+ (goto-char start)
+ ;; Skip through all patterns
+ (while
+ (progn
+ (while
+ (progn
+ (forward-comment (- (point-max)))
+ (when (and (eolp) (sh-is-quoted-p (point)))
+ (forward-char -1)
+ t)))
+ ;; Skip through one pattern
+ (while
+ (or (/= 0 (skip-syntax-backward "w_"))
+ (/= 0 (skip-chars-backward "-$=?[]*@/\\\\"))
+ (and (sh-is-quoted-p (1- (point)))
+ (goto-char (- (point) 2)))
+ (when (memq (char-before) '(?\" ?\' ?\}))
+ (condition-case nil (progn (backward-sexp 1) t)
+ (error nil)))))
+ ;; Patterns can be preceded by an open-paren (bug#1320).
+ (when (eq (char-before (point)) ?\()
+ (backward-char 1)
+ (setq open (point)))
+ (while (progn
+ (forward-comment (- (point-max)))
+ ;; Maybe we've bumped into an escaped newline.
+ (sh-is-quoted-p (point)))
(backward-char 1))
- (while (progn
- (forward-comment (- (point-max)))
- ;; Maybe we've bumped into an escaped newline.
- (sh-is-quoted-p (point)))
- (backward-char 1))
- (when (eq (char-before) ?|)
- (backward-char 1) t)))
- (when (progn (backward-char 2)
- (if (> start (line-end-position))
- (put-text-property (point) (1+ start)
- 'syntax-multiline t))
- ;; FIXME: The `in' may just be a random argument to
- ;; a normal command rather than the real `in' keyword.
- ;; I.e. we should look back to try and find the
- ;; corresponding `case'.
- (and (looking-at ";[;&]\\|\\_<in")
- ;; ";; esac )" is a case that looks like a case-pattern
- ;; but it's really just a close paren after a case
- ;; statement. I.e. if we skipped over `esac' just now,
- ;; we're not looking at a case-pattern.
- (not (looking-at "..[ \t\n]+esac[^[:word:]_]"))))
- sh-st-punc))))
+ (when (eq (char-before) ?|)
+ (backward-char 1) t)))
+ (and (> (point) (1+ (point-min)))
+ (progn (backward-char 2)
+ (if (> start (line-end-position))
+ (put-text-property (point) (1+ start)
+ 'syntax-multiline t))
+ ;; FIXME: The `in' may just be a random argument to
+ ;; a normal command rather than the real `in' keyword.
+ ;; I.e. we should look back to try and find the
+ ;; corresponding `case'.
+ (and (looking-at ";[;&]\\|\\_<in")
+ ;; ";; esac )" is a case that looks
+ ;; like a case-pattern but it's really just a close
+ ;; paren after a case statement. I.e. if we skipped
+ ;; over `esac' just now, we're not looking
+ ;; at a case-pattern.
+ (not (looking-at "..[ \t\n]+esac[^[:word:]_]"))))
+ (progn
+ (when open
+ (put-text-property open (1+ open) 'syntax-table sh-st-punc))
+ sh-st-punc))))))
(defun sh-font-lock-backslash-quote ()
(if (eq (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) ?\')
@@ -1096,7 +1117,7 @@ subshells can nest."
;; metacharacters. The list of special chars is taken from
;; the single-unix spec of the shell command language (under
;; `quoting') but with `$' removed.
- ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_"))
+ ("\\(?:[^|&;<>()`\\\"' \t\n]\\|\\${\\)\\(#+\\)" (1 "_"))
;; In a '...' the backslash is not escaping.
("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote)))
;; Make sure $@ and $? are correctly recognized as sexps.
@@ -1105,16 +1126,15 @@ subshells can nest."
(")" (0 (sh-font-lock-paren (match-beginning 0))))
;; Highlight (possibly nested) subshells inside "" quoted
;; regions correctly.
- ("\"\\(?:\\(?:[^\\\"]\\|\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)"
+ ("\"\\(?:\\(?:[^\\\"]\\|\\\\.\\)*?\\)??\\(\\$(\\|`\\)"
(1 (ignore
- ;; Save excursion because we want to also apply other
- ;; syntax-propertize rules within the affected region.
- (if (nth 8 (syntax-ppss))
+ (if (nth 8 (save-excursion (syntax-ppss (match-beginning 0))))
(goto-char (1+ (match-beginning 0)))
+ ;; Save excursion because we want to also apply other
+ ;; syntax-propertize rules within the affected region.
(save-excursion
(sh-font-lock-quoted-subshell end)))))))
(point) end))
-
(defun sh-font-lock-syntactic-face-function (state)
(let ((q (nth 3 state)))
(if q
@@ -1190,7 +1210,7 @@ This value is used for the `+' and `-' symbols in an indentation variable."
:group 'sh-indentation)
(put 'sh-basic-offset 'safe-local-variable 'integerp)
-(defcustom sh-indent-comment nil
+(defcustom sh-indent-comment t
"How a comment line is to be indented.
nil means leave it as it is;
t means indent it as a normal line, aligning it to previous non-blank
@@ -1201,6 +1221,7 @@ a number means align to that column, e.g. 0 means first column."
(const :tag "Indent as a normal line." t)
(integer :menu-tag "Indent to this col (0 means first col)."
:tag "Indent to column number.") )
+ :version "24.3"
:group 'sh-indentation)
@@ -1379,10 +1400,10 @@ punctuation characters like '-'."
(defconst sh-indent-supported
- '((sh . t)
+ '((sh . sh)
(csh . nil)
- (rc . t))
- "Shell types that shell indenting can do something with.")
+ (rc . rc))
+ "Indentation rule set to use for each shell type.")
(defvar sh-indent-supported-here nil
"Non-nil if we support indentation for the current buffer's shell type.")
@@ -1410,7 +1431,7 @@ This list is used when switching between buffer-local and global
values of variables, and for the commands using indentation styles.")
(defvar sh-make-vars-local t
- "*Controls whether indentation variables are local to the buffer.
+ "Controls whether indentation variables are local to the buffer.
If non-nil, indentation variables are made local initially.
If nil, you can later make the variables local by invoking
command `sh-make-vars-local'.
@@ -1464,9 +1485,8 @@ buffer indents as it currently is indented.
\\[sh-set-shell] Set this buffer's shell, and maybe its magic number.
\\[sh-execute-region] Have optional header and region be executed in a subshell.
-\\[sh-maybe-here-document] Without prefix, following an unquoted < inserts here document.
-\{, (, [, ', \", `
- Unless quoted with \\, insert the pairs {}, (), [], or '', \"\", ``.
+`sh-electric-here-document-mode' controls whether insertion of two
+unquoted < insert a here document.
If you generally program a shell different from your login shell you can
set `sh-shell-file' accordingly. If your shell's file name doesn't correctly
@@ -1489,6 +1509,7 @@ with your script for an edit-interpret-debug cycle."
(set (make-local-variable 'local-abbrev-table) sh-mode-abbrev-table)
(set (make-local-variable 'comint-dynamic-complete-functions)
sh-dynamic-complete-functions)
+ (add-hook 'completion-at-point-functions 'comint-completion-at-point nil t)
;; we can't look if previous line ended with `\'
(set (make-local-variable 'comint-prompt-regexp) "^[ \t]*")
(set (make-local-variable 'imenu-case-fold-search) nil)
@@ -1503,13 +1524,13 @@ with your script for an edit-interpret-debug cycle."
#'sh-syntax-propertize-function)
(add-hook 'syntax-propertize-extend-region-functions
#'syntax-propertize-multiline 'append 'local)
+ (sh-electric-here-document-mode 1)
(set (make-local-variable 'skeleton-pair-alist) '((?` _ ?`)))
(set (make-local-variable 'skeleton-pair-filter-function) 'sh-quoted-p)
(set (make-local-variable 'skeleton-further-elements)
'((< '(- (min sh-indentation (current-column))))))
(set (make-local-variable 'skeleton-filter-function) 'sh-feature)
(set (make-local-variable 'skeleton-newline-indent-rigidly) t)
- (set (make-local-variable 'sh-indent-supported-here) nil)
(set (make-local-variable 'defun-prompt-regexp)
(concat "^\\(function[ \t]\\|[[:alnum:]]+[ \t]+()[ \t]+\\)"))
;; Parse or insert magic number for exec, and set all variables depending
@@ -1519,23 +1540,15 @@ with your script for an edit-interpret-debug cycle."
(goto-char (point-min))
(looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)"))
(match-string 2))
- ((not buffer-file-name)
- sh-shell-file)
+ ((not buffer-file-name) sh-shell-file)
;; Checks that use `buffer-file-name' follow.
- ((string-match "\\.m?spec\\'" buffer-file-name)
- "rpm")
- ((string-match "[.]sh\\>" buffer-file-name)
- "sh")
- ((string-match "[.]bash\\>" buffer-file-name)
- "bash")
- ((string-match "[.]ksh\\>" buffer-file-name)
- "ksh")
- ((string-match "[.]csh\\>" buffer-file-name)
- "csh")
- ((equal (file-name-nondirectory buffer-file-name) ".profile")
- "sh")
- (t
- sh-shell-file))
+ ((string-match "\\.m?spec\\'" buffer-file-name) "rpm")
+ ((string-match "[.]sh\\>" buffer-file-name) "sh")
+ ((string-match "[.]bash\\>" buffer-file-name) "bash")
+ ((string-match "[.]ksh\\>" buffer-file-name) "ksh")
+ ((string-match "[.]csh\\>" buffer-file-name) "csh")
+ ((equal (file-name-nondirectory buffer-file-name) ".profile") "sh")
+ (t sh-shell-file))
nil nil))
;;;###autoload
@@ -1578,6 +1591,431 @@ This adds rules for comments and assignments."
"Function to get better fontification including keywords and builtins."
(sh-font-lock-keywords-1 t))
+;;; Indentation and navigation with SMIE.
+
+(require 'smie)
+
+;; The SMIE code should generally be preferred, but it currently does not obey
+;; the various indentation custom-vars, and it misses some important features
+;; of the old code, mostly: sh-learn-line/buffer-indent, sh-show-indent,
+;; sh-name/save/load-style.
+(defvar sh-use-smie nil
+ "Whether to use the SMIE code for navigation and indentation.")
+
+(defun sh-smie--keyword-p (tok)
+ "Non-nil if TOK (at which we're looking) really is a keyword."
+ (let ((prev (funcall smie-backward-token-function)))
+ (if (zerop (length prev))
+ (looking-back "\\s(" (1- (point)))
+ (assoc prev smie-grammar))))
+
+(defun sh-smie--newline-semi-p (&optional tok)
+ "Return non-nil if a newline should be treated as a semi-colon.
+Here we assume that a newline should be treated as a semi-colon unless it
+comes right after a special keyword.
+This function does not pay attention to line-continuations.
+If TOK is nil, point should be before the newline; otherwise, TOK is the token
+before the newline and in that case point should be just before the token."
+ (save-excursion
+ (unless tok
+ (setq tok (funcall smie-backward-token-function)))
+ (if (and (zerop (length tok))
+ (looking-back "\\s(" (1- (point))))
+ nil
+ (not (numberp (nth 2 (assoc tok smie-grammar)))))))
+
+;;;; SMIE support for `sh'.
+
+(defconst sh-smie-sh-grammar
+ (smie-prec2->grammar
+ (smie-bnf->prec2
+ '((exp) ;A constant, or a $var, or a sequence of them...
+ (cmd ("case" exp "in" branches "esac")
+ ("if" cmd "then" cmd "fi")
+ ("if" cmd "then" cmd "else" cmd "fi")
+ ("if" cmd "then" cmd "elif" cmd "then" cmd "fi")
+ ("if" cmd "then" cmd "elif" cmd "then" cmd "else" cmd "fi")
+ ("if" cmd "then" cmd "elif" cmd "then" cmd
+ "elif" cmd "then" cmd "else" cmd "fi")
+ ("while" cmd "do" cmd "done")
+ ("until" cmd "do" cmd "done")
+ ("for" exp "in" cmd "do" cmd "done")
+ ("for" exp "do" cmd "done")
+ ("select" exp "in" cmd "do" cmd "done") ;bash&zsh&ksh88.
+ ("repeat" exp "do" cmd "done") ;zsh.
+ (exp "always" exp) ;zsh.
+ (cmd "|" cmd) (cmd "|&" cmd)
+ (cmd "&&" cmd) (cmd "||" cmd)
+ (cmd ";" cmd) (cmd "&" cmd))
+ (rpattern (rpattern "|" rpattern))
+ (pattern (rpattern) ("case-(" rpattern))
+ (branches (branches ";;" branches)
+ (branches ";&" branches) (branches ";;&" branches) ;bash.
+ (pattern "case-)" cmd)))
+ '((assoc ";;" ";&" ";;&"))
+ '((assoc ";" "&") (assoc "&&" "||") (assoc "|" "|&")))))
+
+(defconst sh-smie--sh-operators
+ (delq nil (mapcar (lambda (x)
+ (setq x (car x))
+ (and (stringp x)
+ (not (string-match "\\`[a-z]" x))
+ x))
+ sh-smie-sh-grammar)))
+
+(defconst sh-smie--sh-operators-re (regexp-opt sh-smie--sh-operators))
+(defconst sh-smie--sh-operators-back-re
+ (concat "\\(?:^\\|[^\\]\\)\\(?:\\\\\\\\\\)*"
+ "\\(" sh-smie--sh-operators-re "\\)"))
+
+(defun sh-smie--sh-keyword-in-p ()
+ "Assuming we're looking at \"in\", return non-nil if it's a keyword.
+Does not preserve point."
+ (let ((forward-sexp-function nil)
+ (words nil) ;We've seen words.
+ (newline nil) ;We've seen newlines after the words.
+ (res nil)
+ prev)
+ (while (not res)
+ (setq prev (funcall smie-backward-token-function))
+ (cond
+ ((zerop (length prev))
+ (if newline
+ (progn (cl-assert words) (setq res 'word))
+ (setq words t)
+ (condition-case nil
+ (forward-sexp -1)
+ (scan-error (setq res 'unknown)))))
+ ((equal prev ";")
+ (if words (setq newline t)
+ (setq res 'keyword)))
+ ((member prev '("case" "for" "select")) (setq res 'keyword))
+ ((assoc prev smie-grammar) (setq res 'word))
+ (t
+ (if newline
+ (progn (cl-assert words) (setq res 'word))
+ (setq words t)))))
+ (eq res 'keyword)))
+
+(defun sh-smie--sh-keyword-p (tok)
+ "Non-nil if TOK (at which we're looking) really is a keyword."
+ (if (equal tok "in")
+ (sh-smie--sh-keyword-in-p)
+ (sh-smie--keyword-p tok)))
+
+(defun sh-smie-sh-forward-token ()
+ (if (and (looking-at "[ \t]*\\(?:#\\|\\(\\s|\\)\\|$\\)")
+ (save-excursion
+ (skip-chars-backward " \t")
+ (not (bolp))))
+ (if (and (match-end 1) (not (nth 3 (syntax-ppss))))
+ ;; Right before a here-doc.
+ (let ((forward-sexp-function nil))
+ (forward-sexp 1)
+ ;; Pretend the here-document is a "newline representing a
+ ;; semi-colon", since the here-doc otherwise covers the newline(s).
+ ";")
+ (let ((semi (sh-smie--newline-semi-p)))
+ (forward-line 1)
+ (if semi ";"
+ (sh-smie-sh-forward-token))))
+ (forward-comment (point-max))
+ (cond
+ ((looking-at "\\\\\n") (forward-line 1) (sh-smie-sh-forward-token))
+ ((looking-at sh-smie--sh-operators-re)
+ (goto-char (match-end 0))
+ (let ((tok (match-string-no-properties 0)))
+ (if (and (memq (aref tok (1- (length tok))) '(?\; ?\& ?\|))
+ (looking-at "[ \t]*\\(?:#\\|$\\)"))
+ (forward-line 1))
+ tok))
+ (t
+ (let* ((pos (point))
+ (tok (smie-default-forward-token)))
+ (cond
+ ((equal tok ")") "case-)")
+ ((equal tok "(") "case-(")
+ ((and tok (string-match "\\`[a-z]" tok)
+ (assoc tok smie-grammar)
+ (not
+ (save-excursion
+ (goto-char pos)
+ (sh-smie--sh-keyword-p tok))))
+ " word ")
+ (t tok)))))))
+
+(defun sh-smie--looking-back-at-continuation-p ()
+ (save-excursion
+ (and (if (eq (char-before) ?\n) (progn (forward-char -1) t) (eolp))
+ (looking-back "\\(?:^\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\\\"
+ (line-beginning-position)))))
+
+(defun sh-smie-sh-backward-token ()
+ (let ((bol (line-beginning-position))
+ pos tok)
+ (forward-comment (- (point)))
+ (cond
+ ((and (bolp) (not (bobp))
+ (equal (syntax-after (1- (point))) (string-to-syntax "|"))
+ (not (nth 3 (syntax-ppss))))
+ ;; Right after a here-document.
+ (let ((forward-sexp-function nil))
+ (forward-sexp -1)
+ ;; Pretend the here-document is a "newline representing a
+ ;; semi-colon", since the here-doc otherwise covers the newline(s).
+ ";"))
+ ((< (point) bol)
+ (cond
+ ((sh-smie--looking-back-at-continuation-p)
+ (forward-char -1)
+ (funcall smie-backward-token-function))
+ ((sh-smie--newline-semi-p) ";")
+ (t (funcall smie-backward-token-function))))
+ ((looking-back sh-smie--sh-operators-back-re
+ (line-beginning-position) 'greedy)
+ (goto-char (match-beginning 1))
+ (match-string-no-properties 1))
+ (t
+ (let ((tok (smie-default-backward-token)))
+ (cond
+ ((equal tok ")") "case-)")
+ ((equal tok "(") "case-(")
+ ((and tok (string-match "\\`[a-z]" tok)
+ (assoc tok smie-grammar)
+ (not (save-excursion (sh-smie--sh-keyword-p tok))))
+ " word ")
+ (t tok)))))))
+
+(defcustom sh-indent-after-continuation t
+ "If non-nil, try to make sure text is indented after a line continuation."
+ :version "24.3"
+ :type 'boolean
+ :group 'sh-indentation)
+
+(defun sh-smie--continuation-start-indent ()
+ "Return the initial indentation of a continued line.
+May return nil if the line should not be treated as continued."
+ (save-excursion
+ (forward-line -1)
+ (unless (sh-smie--looking-back-at-continuation-p)
+ (current-indentation))))
+
+(defun sh-smie-sh-rules (kind token)
+ (pcase (cons kind token)
+ (`(:elem . basic) sh-indentation)
+ (`(:after . "case-)") (or sh-indentation smie-indent-basic))
+ ((and `(:before . ,_)
+ (guard (when sh-indent-after-continuation
+ (save-excursion
+ (ignore-errors
+ (skip-chars-backward " \t")
+ (sh-smie--looking-back-at-continuation-p))))))
+ ;; After a line-continuation, make sure the rest is indented.
+ (let* ((sh-indent-after-continuation nil)
+ (indent (smie-indent-calculate))
+ (initial (sh-smie--continuation-start-indent)))
+ (when (and (numberp indent) (numberp initial)
+ (<= indent initial))
+ `(column . ,(+ initial sh-indentation)))))
+ (`(:before . ,(or `"(" `"{" `"["))
+ (if (smie-rule-hanging-p) (smie-rule-parent)))
+ ;; FIXME: Maybe this handling of ;; should be made into
+ ;; a smie-rule-terminator function that takes the substitute ";" as arg.
+ (`(:before . ,(or `";;" `";&" `";;&"))
+ (if (and (smie-rule-bolp) (looking-at ";;?&?[ \t]*\\(#\\|$\\)"))
+ (cons 'column (smie-indent-keyword ";"))
+ (smie-rule-separator kind)))
+ (`(:after . ,(or `";;" `";&" `";;&"))
+ (with-demoted-errors
+ (smie-backward-sexp token)
+ (cons 'column
+ (if (or (smie-rule-bolp)
+ (save-excursion
+ (and (member (funcall smie-backward-token-function)
+ '("in" ";;"))
+ (smie-rule-bolp))))
+ (current-column)
+ (smie-indent-calculate)))))
+ (`(:after . "|") (if (smie-rule-parent-p "|") nil 4))
+ ))
+
+;; (defconst sh-smie-csh-grammar
+;; (smie-prec2->grammar
+;; (smie-bnf->prec2
+;; '((exp) ;A constant, or a $var, or a sequence of them…
+;; (elseifcmd (cmd)
+;; (cmd "else" "else-if" exp "then" elseifcmd))
+;; (cmd ("switch" branches "endsw")
+;; ("if" exp)
+;; ("if" exp "then" cmd "endif")
+;; ("if" exp "then" cmd "else" cmd "endif")
+;; ("if" exp "then" elseifcmd "endif")
+;; ;; ("if" exp "then" cmd "else" cmd "endif")
+;; ;; ("if" exp "then" cmd "else" "if" exp "then" cmd "endif")
+;; ;; ("if" exp "then" cmd "else" "if" exp "then" cmd
+;; ;; "else" cmd "endif")
+;; ;; ("if" exp "then" cmd "else" "if" exp "then" cmd
+;; ;; "else" "if" exp "then" cmd "endif")
+;; ("while" cmd "end")
+;; ("foreach" cmd "end")
+;; (cmd "|" cmd) (cmd "|&" cmd)
+;; (cmd "&&" cmd) (cmd "||" cmd)
+;; (cmd ";" cmd) (cmd "&" cmd))
+;; ;; This is a lie, but (combined with the corresponding disambiguation
+;; ;; rule) it makes it more clear that `case' and `default' are the key
+;; ;; separators and the `:' is a secondary tokens.
+;; (branches (branches "case" branches)
+;; (branches "default" branches)
+;; (exp ":" branches)))
+;; '((assoc "else" "then" "endif"))
+;; '((assoc "case" "default") (nonassoc ":"))
+;; '((assoc ";;" ";&" ";;&"))
+;; '((assoc ";" "&") (assoc "&&" "||") (assoc "|" "|&")))))
+
+;;;; SMIE support for `rc'.
+
+(defconst sh-smie-rc-grammar
+ (smie-prec2->grammar
+ (smie-bnf->prec2
+ '((exp) ;A constant, or a $var, or a sequence of them...
+ (cmd (cmd "case" cmd)
+ ("if" exp)
+ ("switch" exp)
+ ("for" exp) ("while" exp)
+ (cmd "|" cmd) (cmd "|&" cmd)
+ (cmd "&&" cmd) (cmd "||" cmd)
+ (cmd ";" cmd) (cmd "&" cmd))
+ (pattern (pattern "|" pattern))
+ (branches (branches ";;" branches)
+ (branches ";&" branches) (branches ";;&" branches) ;bash.
+ (pattern "case-)" cmd)))
+ '((assoc ";;" ";&" ";;&"))
+ '((assoc "case") (assoc ";" "&") (assoc "&&" "||") (assoc "|" "|&")))))
+
+(defun sh-smie--rc-after-special-arg-p ()
+ "Check if we're after the first arg of an if/while/for/... construct.
+Returns the construct's token and moves point before it, if so."
+ (forward-comment (- (point)))
+ (when (looking-back ")\\|\\_<not" (- (point) 3))
+ (ignore-errors
+ (let ((forward-sexp-function nil))
+ (forward-sexp -1)
+ (car (member (funcall smie-backward-token-function)
+ '("if" "for" "switch" "while")))))))
+
+(defun sh-smie--rc-newline-semi-p ()
+ "Return non-nil if a newline should be treated as a semi-colon.
+Point should be before the newline."
+ (save-excursion
+ (let ((tok (funcall smie-backward-token-function)))
+ (if (or (when (equal tok "not") (forward-word 1) t)
+ (and (zerop (length tok)) (eq (char-before) ?\))))
+ (not (sh-smie--rc-after-special-arg-p))
+ (sh-smie--newline-semi-p tok)))))
+
+(defun sh-smie-rc-forward-token ()
+ ;; FIXME: Code duplication with sh-smie-sh-forward-token.
+ (if (and (looking-at "[ \t]*\\(?:#\\|\\(\\s|\\)\\|$\\)")
+ (save-excursion
+ (skip-chars-backward " \t")
+ (not (bolp))))
+ (if (and (match-end 1) (not (nth 3 (syntax-ppss))))
+ ;; Right before a here-doc.
+ (let ((forward-sexp-function nil))
+ (forward-sexp 1)
+ ;; Pretend the here-document is a "newline representing a
+ ;; semi-colon", since the here-doc otherwise covers the newline(s).
+ ";")
+ (let ((semi (sh-smie--rc-newline-semi-p)))
+ (forward-line 1)
+ (if semi ";"
+ (sh-smie-rc-forward-token))))
+ (forward-comment (point-max))
+ (cond
+ ((looking-at "\\\\\n") (forward-line 1) (sh-smie-rc-forward-token))
+ ;; ((looking-at sh-smie--rc-operators-re)
+ ;; (goto-char (match-end 0))
+ ;; (let ((tok (match-string-no-properties 0)))
+ ;; (if (and (memq (aref tok (1- (length tok))) '(?\; ?\& ?\|))
+ ;; (looking-at "[ \t]*\\(?:#\\|$\\)"))
+ ;; (forward-line 1))
+ ;; tok))
+ (t
+ (let* ((pos (point))
+ (tok (smie-default-forward-token)))
+ (cond
+ ;; ((equal tok ")") "case-)")
+ ((and tok (string-match "\\`[a-z]" tok)
+ (assoc tok smie-grammar)
+ (not
+ (save-excursion
+ (goto-char pos)
+ (sh-smie--keyword-p tok))))
+ " word ")
+ (t tok)))))))
+
+(defun sh-smie-rc-backward-token ()
+ ;; FIXME: Code duplication with sh-smie-sh-backward-token.
+ (let ((bol (line-beginning-position))
+ pos tok)
+ (forward-comment (- (point)))
+ (cond
+ ((and (bolp) (not (bobp))
+ (equal (syntax-after (1- (point))) (string-to-syntax "|"))
+ (not (nth 3 (syntax-ppss))))
+ ;; Right after a here-document.
+ (let ((forward-sexp-function nil))
+ (forward-sexp -1)
+ ;; Pretend the here-document is a "newline representing a
+ ;; semi-colon", since the here-doc otherwise covers the newline(s).
+ ";"))
+ ((< (point) bol) ;We skipped over a newline.
+ (cond
+ ;; A continued line.
+ ((and (eolp)
+ (looking-back "\\(?:^\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\\\"
+ (line-beginning-position)))
+ (forward-char -1)
+ (funcall smie-backward-token-function))
+ ((sh-smie--rc-newline-semi-p) ";")
+ (t (funcall smie-backward-token-function))))
+ ;; ((looking-back sh-smie--sh-operators-back-re
+ ;; (line-beginning-position) 'greedy)
+ ;; (goto-char (match-beginning 1))
+ ;; (match-string-no-properties 1))
+ (t
+ (let ((tok (smie-default-backward-token)))
+ (cond
+ ;; ((equal tok ")") "case-)")
+ ((and tok (string-match "\\`[a-z]" tok)
+ (assoc tok smie-grammar)
+ (not (save-excursion (sh-smie--keyword-p tok))))
+ " word ")
+ (t tok)))))))
+
+(defun sh-smie-rc-rules (kind token)
+ (pcase (cons kind token)
+ (`(:elem . basic) sh-indentation)
+ ;; (`(:after . "case") (or sh-indentation smie-indent-basic))
+ (`(:after . ";") (if (smie-rule-parent-p "case")
+ (smie-rule-parent sh-indentation)))
+ (`(:before . "{")
+ (save-excursion
+ (when (sh-smie--rc-after-special-arg-p)
+ `(column . ,(current-column)))))
+ (`(:before . ,(or `"(" `"{" `"["))
+ (if (smie-rule-hanging-p) (smie-rule-parent)))
+ ;; FIXME: SMIE parses "if (exp) cmd" as "(if ((exp) cmd))" so "cmd" is
+ ;; treated as an arg to (exp) by default, which indents it all wrong.
+ ;; To handle it right, we should extend smie-indent-exps so that the
+ ;; preceding keyword can give special rules. Currently the only special
+ ;; rule we have is the :list-intro hack, which we use here to align "cmd"
+ ;; with "(exp)", which is rarely the right thing to do, but is better
+ ;; than nothing.
+ (`(:list-intro . ,(or `"for" `"if" `"while")) t)
+ ))
+
+;;; End of SMIE code.
(defvar sh-regexp-for-done nil
"A buffer-local regexp to match opening keyword for done.")
@@ -1677,19 +2115,28 @@ Calls the value of `sh-set-shell-hook' if set."
(set-syntax-table sh-mode-syntax-table)))
(dolist (var (sh-feature sh-variables))
(sh-remember-variable var))
- (if (setq sh-indent-supported-here (sh-feature sh-indent-supported))
+ (if (set (make-local-variable 'sh-indent-supported-here)
+ (sh-feature sh-indent-supported))
(progn
(message "Setting up indent for shell type %s" sh-shell)
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
- (set (make-local-variable 'sh-kw-alist) (sh-feature sh-kw))
- (let ((regexp (sh-feature sh-kws-for-done)))
- (if regexp
- (set (make-local-variable 'sh-regexp-for-done)
- (sh-mkword-regexpr (regexp-opt regexp t)))))
- (message "setting up indent stuff")
- ;; sh-mode has already made indent-line-function local
- ;; but do it in case this is called before that.
- (set (make-local-variable 'indent-line-function) 'sh-indent-line)
+ (if sh-use-smie
+ (let ((mksym (lambda (name)
+ (intern (format "sh-smie-%s-%s"
+ sh-indent-supported-here name)))))
+ (smie-setup (symbol-value (funcall mksym "grammar"))
+ (funcall mksym "rules")
+ :forward-token (funcall mksym "forward-token")
+ :backward-token (funcall mksym "backward-token")))
+ (set (make-local-variable 'parse-sexp-lookup-properties) t)
+ (set (make-local-variable 'sh-kw-alist) (sh-feature sh-kw))
+ (let ((regexp (sh-feature sh-kws-for-done)))
+ (if regexp
+ (set (make-local-variable 'sh-regexp-for-done)
+ (sh-mkword-regexpr (regexp-opt regexp t)))))
+ (message "setting up indent stuff")
+ ;; sh-mode has already made indent-line-function local
+ ;; but do it in case this is called before that.
+ (set (make-local-variable 'indent-line-function) 'sh-indent-line))
(if sh-make-vars-local
(sh-make-vars-local))
(message "Indentation setup for shell type %s" sh-shell))
@@ -1876,7 +2323,7 @@ region, clear header."
;; Indentation stuff.
(defun sh-must-support-indent ()
- "*Signal an error if the shell type for this buffer is not supported.
+ "Signal an error if the shell type for this buffer is not supported.
Also, the buffer must be in Shell-script mode."
(unless sh-indent-supported-here
(error "This buffer's shell does not support indentation through Emacs")))
@@ -2885,7 +3332,7 @@ so that `occur-next' and `occur-prev' will work."
;; Is this really worth having?
(defvar sh-learned-buffer-hook nil
- "*An abnormal hook, called with an alist of learned variables.")
+ "An abnormal hook, called with an alist of learned variables.")
;; Example of how to use sh-learned-buffer-hook
;;
;; (defun what-i-learned (list)
@@ -3237,8 +3684,9 @@ overwritten if
(defun sh-save-styles-to-buffer (buff)
"Save all current styles in elisp to buffer BUFF.
This is always added to the end of the buffer."
- (interactive (list
- (read-from-minibuffer "Buffer to save styles in? " "*scratch*")))
+ (interactive
+ (list
+ (read-from-minibuffer "Buffer to save styles in? " "*scratch*")))
(with-current-buffer (get-buffer-create buff)
(goto-char (point-max))
(insert "\n")
@@ -3654,10 +4102,13 @@ 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
- (not (looking-back "[^<]<<"))
+ (or arg (sh--maybe-here-document)))
+
+(defun sh--maybe-here-document ()
+ (or (not (looking-back "[^<]<<"))
(save-excursion
(backward-char 2)
(sh-quoted-p))
@@ -3678,30 +4129,24 @@ The document is bounded by `sh-here-document-word'."
(insert ?\n tabs (replace-regexp-in-string
"\\`-?[ \t]*" "" delim))))))
+(define-minor-mode sh-electric-here-document-mode
+ "Make << insert a here document skeleton."
+ nil nil nil
+ (if sh-electric-here-document-mode
+ (add-hook 'post-self-insert-hook #'sh--maybe-here-document nil t)
+ (remove-hook 'post-self-insert-hook #'sh--maybe-here-document t)))
;; various other commands
-(autoload 'comint-dynamic-complete "comint"
- "Dynamically perform completion at point." t)
-
-(autoload 'shell-dynamic-complete-command "shell"
- "Dynamically complete the command at point." t)
-
-(autoload 'comint-dynamic-complete-filename "comint"
- "Dynamically complete the filename at point." t)
-
-(autoload 'shell-dynamic-complete-environment-variable "shell"
- "Dynamically complete the environment variable at point." t)
-
-
-
(defun sh-beginning-of-command ()
+ ;; FIXME: Redefine using SMIE.
"Move point to successive beginnings of commands."
(interactive)
(if (re-search-backward sh-beginning-of-command nil t)
(goto-char (match-beginning 2))))
(defun sh-end-of-command ()
+ ;; FIXME: Redefine using SMIE.
"Move point to successive ends of commands."
(interactive)
(if (re-search-forward sh-end-of-command nil t)
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index dc2773a9efe..2adb34c7824 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -1,6 +1,6 @@
;;; simula.el --- SIMULA 87 code editing commands for Emacs
-;; Copyright (C) 1992, 1994, 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Hans Henrik Eriksen <hhe@ifi.uio.no>
;; Maintainer: simula-mode@ifi.uio.no
@@ -48,7 +48,7 @@ Otherwise TAB indents only when point is within
the run of whitespace at the beginning of the line.")
(defcustom simula-tab-always-indent simula-tab-always-indent-default
- "*Non-nil means TAB in SIMULA mode should always reindent the current line.
+ "Non-nil means TAB in SIMULA mode should always reindent the current line.
Otherwise TAB indents only when point is within
the run of whitespace at the beginning of the line."
:type 'boolean
@@ -58,7 +58,7 @@ the run of whitespace at the beginning of the line."
"Indentation of SIMULA statements with respect to containing block.")
(defcustom simula-indent-level simula-indent-level-default
- "*Indentation of SIMULA statements with respect to containing block."
+ "Indentation of SIMULA statements with respect to containing block."
:type 'integer
:group 'simula)
@@ -67,7 +67,7 @@ the run of whitespace at the beginning of the line."
"Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.")
(defcustom simula-substatement-offset simula-substatement-offset-default
- "*Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE."
+ "Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE."
:type 'integer
:group 'simula)
@@ -79,7 +79,7 @@ the previous line of the statement.")
(defcustom simula-continued-statement-offset
simula-continued-statement-offset-default
- "*Extra indentation for lines not starting a statement or substatement.
+ "Extra indentation for lines not starting a statement or substatement.
If value is a list, each line in a multipleline continued statement
will have the car of the list extra indentation with respect to
the previous line of the statement."
@@ -90,7 +90,7 @@ the previous line of the statement."
"Offset of SIMULA label lines relative to usual indentation.")
(defcustom simula-label-offset simula-label-offset-default
- "*Offset of SIMULA label lines relative to usual indentation."
+ "Offset of SIMULA label lines relative to usual indentation."
:type 'integer
:group 'simula)
@@ -100,7 +100,7 @@ Value is a cons cell, the car is extra THEN indentation and the cdr
extra ELSE indentation. IF after ELSE is indented as the starting IF.")
(defcustom simula-if-indent simula-if-indent-default
- "*Extra indentation of THEN and ELSE with respect to the starting IF.
+ "Extra indentation of THEN and ELSE with respect to the starting IF.
Value is a cons cell, the car is extra THEN indentation and the cdr
extra ELSE indentation. IF after ELSE is indented as the starting IF."
:type '(cons integer integer)
@@ -112,7 +112,7 @@ Value is a cons cell, the car is extra WHEN indentation
and the cdr extra OTHERWISE indentation.")
(defcustom simula-inspect-indent simula-inspect-indent-default
- "*Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
+ "Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
Value is a cons cell, the car is extra WHEN indentation
and the cdr extra OTHERWISE indentation."
:type '(cons integer integer)
@@ -122,7 +122,7 @@ and the cdr extra OTHERWISE indentation."
"Non-nil means `simula-indent-line' function may reindent previous line.")
(defcustom simula-electric-indent simula-electric-indent-default
- "*Non-nil means `simula-indent-line' function may reindent previous line."
+ "Non-nil means `simula-indent-line' function may reindent previous line."
:type 'boolean
:group 'simula)
@@ -132,7 +132,7 @@ Value is one of the symbols `upcase', `downcase', `capitalize',
\(as in) `abbrev-table' or nil if they should not be changed.")
(defcustom simula-abbrev-keyword simula-abbrev-keyword-default
- "*Specify how to convert case for SIMULA keywords.
+ "Specify how to convert case for SIMULA keywords.
Value is one of the symbols `upcase', `downcase', `capitalize',
\(as in) `abbrev-table' or nil if they should not be changed."
:type '(choice (const upcase) (const downcase) (const capitalize)(const nil))
@@ -144,7 +144,7 @@ Value is one of the symbols `upcase', `downcase', `capitalize',
\(as in) `abbrev-table', or nil if they should not be changed.")
(defcustom simula-abbrev-stdproc simula-abbrev-stdproc-default
- "*Specify how to convert case for standard SIMULA procedure and class names.
+ "Specify how to convert case for standard SIMULA procedure and class names.
Value is one of the symbols `upcase', `downcase', `capitalize',
\(as in) `abbrev-table', or nil if they should not be changed."
:type '(choice (const upcase) (const downcase) (const capitalize)
@@ -152,7 +152,7 @@ Value is one of the symbols `upcase', `downcase', `capitalize',
:group 'simula)
(defcustom simula-abbrev-file nil
- "*File with extra abbrev definitions for use in SIMULA mode.
+ "File with extra abbrev definitions for use in SIMULA mode.
These are used together with the standard abbrev definitions for SIMULA.
Please note that the standard definitions are required
for SIMULA mode to function correctly."
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 60ba768a80e..d84d57cad22 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -1,10 +1,10 @@
;;; sql.el --- specialized comint.el for SQL interpreters
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Michael Mauger <mmaug@yahoo.com>
-;; Version: 3.0
+;; Version: 3.1
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/projects/emacs/
@@ -218,7 +218,12 @@
;; Michael Mauger <mmaug@yahoo.com> -- improved product support
;; Drew Adams <drew.adams@oracle.com> -- Emacs 20 support
;; Harald Maier <maierh@myself.com> -- sql-send-string
-;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections; code polish
+;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections;
+;; code polish
+;; Paul Sleigh <bat@flurf.net> -- MySQL keyword enhancement
+;; Andrew Schein <andrew@andrewschein.com> -- sql-port bug
+;; Ian Bjorhovde <idbjorh@dataproxy.com> -- db2 escape newlines
+;; incorrectly enabled by default
@@ -263,9 +268,8 @@
(defcustom sql-password ""
"Default password.
-
-Storing your password in a textfile such as ~/.emacs could be dangerous.
-Customizing your password will store it in your ~/.emacs file."
+If you customize this, the value will be stored in your init
+file. Since that is a plaintext file, this could be dangerous."
:type 'string
:group 'SQL
:risky t)
@@ -283,7 +287,7 @@ Customizing your password will store it in your ~/.emacs file."
:safe 'stringp)
(defcustom sql-port 0
- "Default port."
+ "Default port for connecting to a MySQL or Postgres server."
:version "24.1"
:type 'number
:group 'SQL
@@ -611,30 +615,22 @@ settings.")
'(:font-lock :sqli-program :sqli-options :sqli-login :statement))
(defcustom sql-connection-alist nil
- "An alist of connection parameters for interacting with a SQL
- product.
-
+ "An alist of connection parameters for interacting with a SQL product.
Each element of the alist is as follows:
\(CONNECTION \(SQL-VARIABLE VALUE) ...)
Where CONNECTION is a symbol identifying the connection, SQL-VARIABLE
is the symbol name of a SQL mode variable, and VALUE is the value to
-be assigned to the variable.
-
-The most common SQL-VARIABLE settings associated with a connection
-are:
-
- `sql-product'
- `sql-user'
- `sql-password'
- `sql-port'
- `sql-server'
- `sql-database'
+be assigned to the variable. The most common SQL-VARIABLE settings
+associated with a connection are: `sql-product', `sql-user',
+`sql-password', `sql-port', `sql-server', and `sql-database'.
If a SQL-VARIABLE is part of the connection, it will not be
-prompted for during login."
-
+prompted for during login. The command `sql-connect' starts a
+predefined SQLi session using the parameters from this list.
+Connections defined here appear in the submenu SQL->Start... for
+making new SQLi sessions."
:type `(alist :key-type (string :tag "Connection")
:value-type
(set
@@ -740,15 +736,15 @@ this variable is nil, that buffer is shown using
(defvar sql-imenu-generic-expression
;; Items are in reverse order because they are rendered in reverse.
- '(("Rules/Defaults" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(rule\\|default\\)\\s-+\\(\\w+\\)" 3)
- ("Sequences" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*sequence\\s-+\\(\\w+\\)" 2)
- ("Triggers" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*trigger\\s-+\\(\\w+\\)" 2)
- ("Functions" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?function\\s-+\\(\\w+\\)" 3)
- ("Procedures" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?proc\\(edure\\)?\\s-+\\(\\w+\\)" 4)
- ("Packages" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*package\\s-+\\(body\\s-+\\)?\\(\\w+\\)" 3)
- ("Types" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*type\\s-+\\(body\\s-+\\)?\\(\\w+\\)" 3)
- ("Indexes" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*index\\s-+\\(\\w+\\)" 2)
- ("Tables/Views" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(table\\|view\\)\\s-+\\(\\w+\\)" 3))
+ '(("Rules/Defaults" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:rule\\|default\\)\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\s-+\\(\\w+\\)" 1)
+ ("Sequences" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*sequence\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1)
+ ("Triggers" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*trigger\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1)
+ ("Functions" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?function\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1)
+ ("Procedures" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?proc\\(?:edure\\)?\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1)
+ ("Packages" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*package\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1)
+ ("Types" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*type\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1)
+ ("Indexes" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*index\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1)
+ ("Tables/Views" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:table\\|view\\)\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1))
"Define interesting points in the SQL buffer for `imenu'.
This is used to set `imenu-generic-expression' when SQL mode is
@@ -811,6 +807,15 @@ is changed."
:type 'hook
:group 'SQL)
+(defcustom sql-login-hook '()
+ "Hook for interacting with a buffer in `sql-interactive-mode'.
+
+This hook is invoked in a buffer once it is ready to accept input
+for the first time."
+ :version "24.1"
+ :type 'hook
+ :group 'SQL)
+
;; Customization for ANSI
(defcustom sql-ansi-statement-starters (regexp-opt '(
@@ -822,7 +827,10 @@ is changed."
All products share this list; products should define a regexp to
identify additional keywords in a variable defined by
-the :statement feature.")
+the :statement feature."
+ :version "24.1"
+ :type 'string
+ :group 'SQL)
;; Customization for Oracle
@@ -849,8 +857,12 @@ You will find the file in your Orant\\bin directory."
:version "24.1"
:group 'SQL)
-(defcustom sql-oracle-statement-starters (regexp-opt '("declare" "begin" "with"))
- "Additional statement starting keywords in Oracle.")
+(defcustom sql-oracle-statement-starters
+ (regexp-opt '("declare" "begin" "with"))
+ "Additional statement starting keywords in Oracle."
+ :version "24.1"
+ :type 'string
+ :group 'SQL)
(defcustom sql-oracle-scan-on t
"Non-nil if placeholders should be replaced in Oracle SQLi.
@@ -865,6 +877,17 @@ You need to issue the following command in SQL*Plus to be safe:
SET DEFINE OFF
In older versions of SQL*Plus, this was the SET SCAN OFF command."
+ :version "24.1"
+ :type 'boolean
+ :group 'SQL)
+
+(defcustom sql-db2-escape-newlines nil
+ "Non-nil if newlines should be escaped by a backslash in DB2 SQLi.
+
+When non-nil, Emacs will automatically insert a space and
+backslash prior to every newline in multi-line SQL statements as
+they are submitted to an interactive DB2 session."
+ :version "24.3"
:type 'boolean
:group 'SQL)
@@ -1261,8 +1284,8 @@ Based on `comint-mode-map'.")
["List all objects" sql-list-all (sql-get-product-feature sql-product :list-all)]
["List table details" sql-list-table (sql-get-product-feature sql-product :list-table)]))
-;; Abbreviations -- if you want more of them, define them in your
-;; ~/.emacs file. Abbrevs have to be enabled in your ~/.emacs, too.
+;; Abbreviations -- if you want more of them, define them in your init
+;; file. Abbrevs have to be enabled in your init file, too.
(defvar sql-mode-abbrev-table nil
"Abbrev table used in `sql-mode' and `sql-interactive-mode'.")
@@ -1316,6 +1339,7 @@ Based on `comint-mode-map'.")
"\\(?:\\w+\\s-+\\)*" ;; optional intervening keywords
"\\(?:table\\|view\\|\\(?:package\\|type\\)\\(?:\\s-+body\\)?\\|proc\\(?:edure\\)?"
"\\|function\\|trigger\\|sequence\\|rule\\|default\\)\\s-+"
+ "\\(?:if\\s-+not\\s-+exists\\s-+\\)?" ;; IF NOT EXISTS
"\\(\\w+\\)")
1 'font-lock-function-name-face))
@@ -1594,6 +1618,7 @@ to add functions and PL/SQL keywords.")
"atan" "atan2" "avg" "bfilename" "bin_to_num" "bitand" "cardinality"
"cast" "ceil" "chartorowid" "chr" "cluster_id" "cluster_probability"
"cluster_set" "coalesce" "collect" "compose" "concat" "convert" "corr"
+"connect_by_root" "connect_by_iscycle" "connect_by_isleaf"
"corr_k" "corr_s" "cos" "cosh" "count" "covar_pop" "covar_samp"
"cube_table" "cume_dist" "current_date" "current_timestamp" "cv"
"dataobj_to_partition" "dbtimezone" "decode" "decompose" "deletexml"
@@ -2279,7 +2304,7 @@ you define your own `sql-mode-solid-font-lock-keywords'.")
"collation" "column" "columns" "comment" "committed" "concurrent"
"constraint" "create" "cross" "data" "database" "default"
"delay_key_write" "delayed" "delete" "desc" "directory" "disable"
-"distinct" "distinctrow" "do" "drop" "dumpfile" "duplicate" "else"
+"distinct" "distinctrow" "do" "drop" "dumpfile" "duplicate" "else" "elseif"
"enable" "enclosed" "end" "escaped" "exists" "fields" "first" "for"
"force" "foreign" "from" "full" "fulltext" "global" "group" "handler"
"having" "heap" "high_priority" "if" "ignore" "in" "index" "infile"
@@ -2778,8 +2803,12 @@ each line with INDENT."
doc))
;;;###autoload
-(defun sql-help ()
- "Show short help for the SQL modes.
+(eval
+ ;; FIXME: This dynamic-docstring-function trick doesn't work for byte-compiled
+ ;; functions, because of the lazy-loading of docstrings, which strips away
+ ;; text properties.
+ '(defun sql-help ()
+ #("Show short help for the SQL modes.
Use an entry function to open an interactive SQL buffer. This buffer is
usually named `*SQL*'. The name of the major mode is SQLi.
@@ -2810,40 +2839,34 @@ anything. The name of the major mode is SQL.
In this SQL buffer (SQL mode), you can send the region or the entire
buffer to the interactive SQL buffer (SQLi mode). The results are
appended to the SQLi buffer without disturbing your SQL buffer."
+ 0 1 (dynamic-docstring-function sql--make-help-docstring))
(interactive)
+ (describe-function 'sql-help)))
- ;; Insert references to loaded products into the help buffer string
- (let ((doc (documentation 'sql-help t))
- changedp)
- (setq changedp nil)
+(defun sql--make-help-docstring (doc _fun)
+ "Insert references to loaded products into the help buffer string."
- ;; Insert FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
- t t doc 0)
- changedp t))
+ ;; Insert FREE software list
+ (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0)
+ (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
+ t t doc 0)))
- ;; Insert non-FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
- t t doc 0)
- changedp t))
-
- ;; If we changed the help text, save the change so that the help
- ;; sub-system will see it
- (when changedp
- (put 'sql-help 'function-documentation doc)))
-
- ;; Call help on this function
- (describe-function 'sql-help))
+ ;; Insert non-FREE software list
+ (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0)
+ (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
+ t t doc 0)))
+ doc)
(defun sql-read-passwd (prompt &optional default)
"Read a password using PROMPT. Optional DEFAULT is password to start with."
(read-passwd prompt nil default))
-(defun sql-get-login-ext (prompt last-value history-var plist)
+(defun sql-get-login-ext (symbol prompt history-var plist)
"Prompt user with extended login parameters.
+The global value of SYMBOL is the last value and the global value
+of the SYMBOL is set based on the user's input.
+
If PLIST is nil, then the user is simply prompted for a string
value.
@@ -2856,38 +2879,41 @@ regexp pattern specified in its value.
The `:completion' property prompts for a string specified by its
value. (The property value is used as the PREDICATE argument to
`completing-read'.)"
- (let* ((default (plist-get plist :default))
- (prompt-def
- (if default
- (if (string-match "\\(\\):[ \t]*\\'" prompt)
- (replace-match (format " (default \"%s\")" default) t t prompt 1)
- (replace-regexp-in-string "[ \t]*\\'"
- (format " (default \"%s\") " default)
- prompt t t))
- prompt))
- (use-dialog-box nil))
- (cond
- ((plist-member plist :file)
- (expand-file-name
- (read-file-name prompt
- (file-name-directory last-value) default t
- (file-name-nondirectory last-value)
- (when (plist-get plist :file)
- `(lambda (f)
- (string-match
- (concat "\\<" ,(plist-get plist :file) "\\>")
- (file-name-nondirectory f)))))))
-
- ((plist-member plist :completion)
- (completing-read prompt-def (plist-get plist :completion) nil t
- last-value history-var default))
-
- ((plist-get plist :number)
- (read-number prompt (or default last-value 0)))
-
- (t
- (let ((r (read-from-minibuffer prompt-def last-value nil nil history-var nil)))
- (if (string= "" r) (or default "") r))))))
+ (set-default
+ symbol
+ (let* ((default (plist-get plist :default))
+ (last-value (default-value symbol))
+ (prompt-def
+ (if default
+ (if (string-match "\\(\\):[ \t]*\\'" prompt)
+ (replace-match (format " (default \"%s\")" default) t t prompt 1)
+ (replace-regexp-in-string "[ \t]*\\'"
+ (format " (default \"%s\") " default)
+ prompt t t))
+ prompt))
+ (use-dialog-box nil))
+ (cond
+ ((plist-member plist :file)
+ (expand-file-name
+ (read-file-name prompt
+ (file-name-directory last-value) default t
+ (file-name-nondirectory last-value)
+ (when (plist-get plist :file)
+ `(lambda (f)
+ (string-match
+ (concat "\\<" ,(plist-get plist :file) "\\>")
+ (file-name-nondirectory f)))))))
+
+ ((plist-member plist :completion)
+ (completing-read prompt-def (plist-get plist :completion) nil t
+ last-value history-var default))
+
+ ((plist-get plist :number)
+ (read-number prompt (or default last-value 0)))
+
+ (t
+ (let ((r (read-from-minibuffer prompt-def last-value nil nil history-var nil)))
+ (if (string= "" r) (or default "") r)))))))
(defun sql-get-login (&rest what)
"Get username, password and database from the user.
@@ -2925,28 +2951,20 @@ function like this: (sql-get-login 'user 'password 'database)."
(cond
((eq token 'user) ; user
- (setq sql-user
- (sql-get-login-ext "User: " sql-user
- 'sql-user-history plist)))
+ (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist))
- ((eq token 'password) ; password
- (setq sql-password
- (sql-read-passwd "Password: " sql-password)))
+ ((eq token 'password) ; password
+ (setq-default sql-password
+ (sql-read-passwd "Password: " sql-password)))
- ((eq token 'server) ; server
- (setq sql-server
- (sql-get-login-ext "Server: " sql-server
- 'sql-server-history plist)))
+ ((eq token 'server) ; server
+ (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist))
- ((eq token 'database) ; database
- (setq sql-database
- (sql-get-login-ext "Database: " sql-database
- 'sql-database-history plist)))
+ ((eq token 'database) ; database
+ (sql-get-login-ext 'sql-database "Database: " 'sql-database-history plist))
((eq token 'port) ; port
- (setq sql-port
- (sql-get-login-ext "Port: " sql-port
- nil (append '(:number t) plist)))))))
+ (sql-get-login-ext 'sql-port "Port: " nil (append '(:number t) plist))))))
what))
(defun sql-find-sqli-buffer (&optional product connection)
@@ -3178,20 +3196,23 @@ Placeholders are words starting with an ampersand like &this."
;; Using DB2 interactively, newlines must be escaped with " \".
;; The space before the backslash is relevant.
+
(defun sql-escape-newlines-filter (string)
"Escape newlines in STRING.
Every newline in STRING will be preceded with a space and a backslash."
- (let ((result "") (start 0) mb me)
- (while (string-match "\n" string start)
- (setq mb (match-beginning 0)
- me (match-end 0)
- result (concat result
- (substring string start mb)
- (if (and (> mb 1)
- (string-equal " \\" (substring string (- mb 2) mb)))
- "" " \\\n"))
- start me))
- (concat result (substring string start))))
+ (if (not sql-db2-escape-newlines)
+ string
+ (let ((result "") (start 0) mb me)
+ (while (string-match "\n" string start)
+ (setq mb (match-beginning 0)
+ me (match-end 0)
+ result (concat result
+ (substring string start mb)
+ (if (and (> mb 1)
+ (string-equal " \\" (substring string (- mb 2) mb)))
+ "" " \\\n"))
+ start me))
+ (concat result (substring string start)))))
@@ -3423,7 +3444,7 @@ list of SQLi command strings."
:prompt-regexp))
(start nil))
(with-current-buffer buf
- (toggle-read-only -1)
+ (setq view-read-only nil)
(unless save-prior
(erase-buffer))
(goto-char (point-max))
@@ -3532,7 +3553,7 @@ buffer is popped into a view window. "
(get-lru-window))))
(with-current-buffer outbuf
(set-buffer-modified-p nil)
- (toggle-read-only 1))
+ (setq view-read-only t))
(view-buffer-other-window outbuf)
(when one-win
(shrink-window-if-larger-than-buffer)))))
@@ -3636,7 +3657,9 @@ The list is maintained in SQL interactive buffers.")
(read-from-minibuffer prompt tname))))
(defun sql-list-all (&optional enhanced)
- "List all database objects."
+ "List all database objects.
+With optional prefix argument ENHANCED, displays additional
+details or extends the listing to include other schemas objects."
(interactive "P")
(let ((sqlbuf (sql-find-sqli-buffer)))
(unless sqlbuf
@@ -3648,7 +3671,9 @@ The list is maintained in SQL interactive buffers.")
(set (make-local-variable 'sql-buffer) sqlbuf))))
(defun sql-list-table (name &optional enhanced)
- "List the details of a database table. "
+ "List the details of a database table named NAME.
+Displays the columns in the relation. With optional prefix argument
+ENHANCED, displays additional details about each column."
(interactive
(list (sql-read-table-name "Table name: ")
current-prefix-arg))
@@ -3685,8 +3710,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 ()
@@ -3776,7 +3801,7 @@ cause the window to scroll to the end of the buffer.
If you want to make SQL buffers limited in length, add the function
`comint-truncate-buffer' to `comint-output-filter-functions'.
-Here is an example for your .emacs file. It keeps the SQLi buffer a
+Here is an example for your init file. It keeps the SQLi buffer a
certain length.
\(add-hook 'sql-interactive-mode-hook
@@ -3825,6 +3850,7 @@ you entered, right above the output it created.
(set (make-local-variable 'sql-server) sql-server)
(set (make-local-variable 'sql-port) sql-port)
(set (make-local-variable 'sql-connection) sql-connection)
+ (setq-default sql-connection nil)
;; Contains the name of database objects
(set (make-local-variable 'sql-contains-names) t)
;; Keep track of existing object names
@@ -3919,43 +3945,50 @@ is specified in the connection settings."
;; Settings are defined
(if connect-set
;; Set the desired parameters
- (eval `(let*
- (,@(cdr connect-set)
- ;; :sqli-login params variable
- (param-var (sql-get-product-feature sql-product
- :sqli-login nil t))
- ;; :sqli-login params value
- (login-params (sql-get-product-feature sql-product
- :sqli-login))
- ;; which params are in the connection
- (set-params (mapcar
- (lambda (v)
- (cond
- ((eq (car v) 'sql-user) 'user)
- ((eq (car v) 'sql-password) 'password)
- ((eq (car v) 'sql-server) 'server)
- ((eq (car v) 'sql-database) 'database)
- ((eq (car v) 'sql-port) 'port)
- (t (car v))))
- (cdr connect-set)))
- ;; the remaining params (w/o the connection params)
- (rem-params (sql-for-each-login
- login-params
- (lambda (token plist)
- (unless (member token set-params)
- (if plist
- (cons token plist)
- token))))))
-
- ;; Set the remaining parameters and start the
- ;; interactive session
- (eval `(let ((sql-connection ,connection)
- (,param-var ',rem-params))
- (sql-product-interactive sql-product
- new-name)))))
+ (let (param-var login-params set-params rem-params)
+
+ ;; :sqli-login params variable
+ (setq param-var
+ (sql-get-product-feature sql-product :sqli-login nil t))
+
+ ;; :sqli-login params value
+ (setq login-params
+ (sql-get-product-feature sql-product :sqli-login))
+
+ ;; Params in the connection
+ (setq set-params
+ (mapcar
+ (lambda (v)
+ (cond
+ ((eq (car v) 'sql-user) 'user)
+ ((eq (car v) 'sql-password) 'password)
+ ((eq (car v) 'sql-server) 'server)
+ ((eq (car v) 'sql-database) 'database)
+ ((eq (car v) 'sql-port) 'port)
+ (t (car v))))
+ (cdr connect-set)))
+
+ ;; the remaining params (w/o the connection params)
+ (setq rem-params
+ (sql-for-each-login login-params
+ (lambda (token plist)
+ (unless (member token set-params)
+ (if plist (cons token plist) token)))))
+
+ ;; Set the parameters and start the interactive session
+ (mapc
+ (lambda (vv)
+ (set-default (car vv) (eval (cadr vv))))
+ (cdr connect-set))
+ (setq-default sql-connection connection)
+
+ ;; Start the SQLi session with revised list of login parameters
+ (eval `(let ((,param-var ',rem-params))
+ (sql-product-interactive sql-product new-name))))
(message "SQL Connection <%s> does not exist" connection)
nil)))
+
(message "No SQL Connections defined")
nil))
@@ -4085,9 +4118,14 @@ the call to \\[sql-product-interactive] with
;; Connect to database.
(message "Login...")
- (funcall (sql-get-product-feature product :sqli-comint-func)
- product
- (sql-get-product-feature product :sqli-options))
+ (let ((sql-user (default-value 'sql-user))
+ (sql-password (default-value 'sql-password))
+ (sql-server (default-value 'sql-server))
+ (sql-database (default-value 'sql-database))
+ (sql-port (default-value 'sql-port)))
+ (funcall (sql-get-product-feature product :sqli-comint-func)
+ product
+ (sql-get-product-feature product :sqli-options)))
;; Set SQLi mode.
(let ((sql-interactive-product product))
@@ -4097,7 +4135,8 @@ the call to \\[sql-product-interactive] with
(setq new-sqli-buffer (current-buffer))
(when new-name
(sql-rename-buffer new-name))
- (setq sql-buffer (buffer-name new-sqli-buffer))
+ (set (make-local-variable 'sql-buffer)
+ (buffer-name new-sqli-buffer))
;; Set `sql-buffer' in the start buffer
(with-current-buffer start-buffer
@@ -4107,6 +4146,7 @@ the call to \\[sql-product-interactive] with
;; All done.
(message "Login...done")
+ (run-hooks 'sql-login-hook)
(pop-to-buffer new-sqli-buffer)))))
(message "No default SQL product defined. Set `sql-product'.")))
@@ -4117,10 +4157,12 @@ PRODUCT is the SQL product. PARAMS is a list of strings which are
passed as command line arguments."
(let ((program (sql-get-product-feature product :sqli-program))
(buf-name "SQL"))
- ;; make sure we can find the program
- (unless (executable-find program)
+ ;; Make sure we can find the program. `executable-find' does not
+ ;; work for remote hosts; we suppress the check there.
+ (unless (or (file-remote-p default-directory)
+ (executable-find program))
(error "Unable to locate SQL program \'%s\'" program))
- ;; Make sure buffer name is unique
+ ;; Make sure buffer name is unique.
(when (sql-buffer-live-p (format "*%s*" buf-name))
(setq buf-name (format "SQL-%s" product))
(when (sql-buffer-live-p (format "*%s*" buf-name))
diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el
index 9c61da89008..e541aed8867 100644
--- a/lisp/progmodes/subword.el
+++ b/lisp/progmodes/subword.el
@@ -1,6 +1,6 @@
;;; subword.el --- Handling capitalized subwords in a nomenclature
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Masatake YAMATO
@@ -80,6 +80,20 @@
;;; Code:
+(defvar subword-forward-function 'subword-forward-internal
+ "Function to call for forward subword movement.")
+
+(defvar subword-backward-function 'subword-backward-internal
+ "Function to call for backward subword movement.")
+
+(defvar subword-forward-regexp
+ "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)"
+ "Regexp used by `subword-forward-internal'.")
+
+(defvar subword-backward-regexp
+ "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)"
+ "Regexp used by `subword-backward-internal'.")
+
(defvar subword-mode-map
(let ((map (make-sparse-keymap)))
(dolist (cmd '(forward-word backward-word mark-word kill-word
@@ -138,10 +152,10 @@ Optional argument ARG is the same as for `forward-word'."
(cond
((< 0 arg)
(dotimes (i arg (point))
- (subword-forward-internal)))
+ (funcall subword-forward-function)))
((> 0 arg)
(dotimes (i (- arg) (point))
- (subword-backward-internal)))
+ (funcall subword-backward-function)))
(t
(point))))
@@ -249,9 +263,7 @@ Optional argument ARG is the same as for `capitalize-word'."
(if (and
(save-excursion
(let ((case-fold-search nil))
- (re-search-forward
- (concat "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)")
- nil t)))
+ (re-search-forward subword-forward-regexp nil t)))
(> (match-end 0) (point)))
(goto-char
(cond
@@ -265,11 +277,7 @@ Optional argument ARG is the same as for `capitalize-word'."
(defun subword-backward-internal ()
(if (save-excursion
(let ((case-fold-search nil))
- (re-search-backward
- (concat
- "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)"
- "\\|\\W\\w+\\)")
- nil t)))
+ (re-search-backward subword-backward-regexp nil t)))
(goto-char
(cond
((and (match-end 3)
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index d0e2c5abe7d..c82566ca5b6 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -1,6 +1,6 @@
;;; tcl.el --- Tcl code editing commands for Emacs
-;; Copyright (C) 1994, 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1998-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Author: Tom Tromey <tromey@redhat.com>
@@ -104,7 +104,6 @@
(eval-when-compile
(require 'imenu)
- (require 'outline)
(require 'dabbrev)
(require 'add-log))
@@ -120,24 +119,24 @@
:group 'languages)
(defcustom tcl-indent-level 4
- "*Indentation of Tcl statements with respect to containing block."
+ "Indentation of Tcl statements with respect to containing block."
:type 'integer
:group 'tcl)
(put 'tcl-indent-level 'safe-local-variable 'integerp)
(defcustom tcl-continued-indent-level 4
- "*Indentation of continuation line relative to first line of command."
+ "Indentation of continuation line relative to first line of command."
:type 'integer
:group 'tcl)
(put 'tcl-continued-indent-level 'safe-local-variable 'integerp)
(defcustom tcl-auto-newline nil
- "*Non-nil means automatically newline before and after braces you insert."
+ "Non-nil means automatically newline before and after braces you insert."
:type 'boolean
:group 'tcl)
(defcustom tcl-tab-always-indent tab-always-indent
- "*Control effect of TAB key.
+ "Control effect of TAB key.
If t (the default), always indent current line.
If nil and point is not in the indentation area at the beginning of
the line, a TAB is inserted.
@@ -157,7 +156,7 @@ to take place:
(defcustom tcl-electric-hash-style nil ;; 'smart
- "*Style of electric hash insertion to use.
+ "Style of electric hash insertion to use.
Possible values are `backslash', meaning that `\\' quoting should be
done; `quote', meaning that `\"' quoting should be done; `smart',
meaning that the choice between `backslash' and `quote' should be
@@ -168,27 +167,27 @@ taken to mean `smart'. The default is nil."
:group 'tcl)
(defcustom tcl-help-directory-list nil
- "*List of topmost directories containing TclX help files."
+ "List of topmost directories containing TclX help files."
:type '(repeat directory)
:group 'tcl)
(defcustom tcl-use-smart-word-finder t
- "*If not nil, use smart way to find current word, for Tcl help feature."
+ "If not nil, use smart way to find current word, for Tcl help feature."
:type 'boolean
:group 'tcl)
(defcustom tcl-application "wish"
- "*Name of Tcl program to run in inferior Tcl mode."
+ "Name of Tcl program to run in inferior Tcl mode."
:type 'string
:group 'tcl)
(defcustom tcl-command-switches nil
- "*List of switches to supply to the `tcl-application' program."
+ "List of switches to supply to the `tcl-application' program."
:type '(repeat string)
:group 'tcl)
(defcustom tcl-prompt-regexp "^\\(% \\|\\)"
- "*If not nil, a regexp that will match the prompt in the inferior process.
+ "If not nil, a regexp that will match the prompt in the inferior process.
If nil, the prompt is the name of the application with \">\" appended.
The default is \"^\\(% \\|\\)\", which will match the default primary
@@ -197,7 +196,7 @@ and secondary prompts for tclsh and wish."
:group 'tcl)
(defcustom inferior-tcl-source-command "source %s\n"
- "*Format-string for building a Tcl command to load a file.
+ "Format-string for building a Tcl command to load a file.
This format string should use `%s' to substitute a file name
and should result in a Tcl expression that will command the
inferior Tcl to load that file. The filename will be appropriately
@@ -301,7 +300,7 @@ quoted for Tcl."
["Tcl help" tcl-help-on-word tcl-help-directory-list]))
(defvar inferior-tcl-buffer nil
- "*The current inferior-tcl process buffer.
+ "The current inferior-tcl process buffer.
MULTIPLE PROCESS SUPPORT
===========================================================================
@@ -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 434984c8bf1..a2f71ff2ab8 100644
--- a/lisp/progmodes/vera-mode.el
+++ b/lisp/progmodes/vera-mode.el
@@ -1,6 +1,6 @@
;;; vera-mode.el --- major mode for editing Vera files
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Author: Reto Zimmermann <reto@gnu.org>
;; Maintainer: Reto Zimmermann <reto@gnu.org>
@@ -90,12 +90,12 @@
:group 'languages)
(defcustom vera-basic-offset 2
- "*Amount of basic offset used for indentation."
+ "Amount of basic offset used for indentation."
:type 'integer
:group 'vera)
(defcustom vera-underscore-is-part-of-word nil
- "*Non-nil means consider the underscore character `_' as part of word.
+ "Non-nil means consider the underscore character `_' as part of word.
An identifier containing underscores is then treated as a single word in
select and move operations. All parts of an identifier separated by underscore
are treated as single words otherwise."
@@ -103,7 +103,7 @@ are treated as single words otherwise."
:group 'vera)
(defcustom vera-intelligent-tab t
- "*Non-nil means `TAB' does indentation, word completion and tab insertion.
+ "Non-nil means `TAB' does indentation, word completion and tab insertion.
That is, if preceding character is part of a word then complete word,
else if not at beginning of line then insert tab,
else if last command was a `TAB' or `RET' then dedent one step,
@@ -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'."
@@ -670,23 +664,23 @@ Adapted from `font-lock-match-c-style-declaration-item-and-skip-to-next'."
"Face name to use for interface names.")
(defface vera-font-lock-number
- '((((class color) (background light)) (:foreground "Gold4"))
- (((class color) (background dark)) (:foreground "BurlyWood1"))
- (t (:italic t :bold t)))
+ '((((class color) (background light)) :foreground "Gold4")
+ (((class color) (background dark)) :foreground "BurlyWood1")
+ (t :slant italic :weight bold))
"Font lock mode face used to highlight @ definitions."
:group 'font-lock-highlighting-faces)
(defface vera-font-lock-function
- '((((class color) (background light)) (:foreground "DarkCyan"))
- (((class color) (background dark)) (:foreground "Orchid1"))
- (t (:italic t :bold t)))
+ '((((class color) (background light)) :foreground "DarkCyan")
+ (((class color) (background dark)) :foreground "Orchid1")
+ (t :slant italic :weight bold))
"Font lock mode face used to highlight predefined functions and tasks."
:group 'font-lock-highlighting-faces)
(defface vera-font-lock-interface
- '((((class color) (background light)) (:foreground "Grey40"))
- (((class color) (background dark)) (:foreground "Grey80"))
- (t (:italic t :bold t)))
+ '((((class color) (background light)) :foreground "Grey40")
+ (((class color) (background dark)) :foreground "Grey80")
+ (t :slant italic :weight bold))
"Font lock mode face used to highlight interface names."
:group 'font-lock-highlighting-faces)
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 52e7b6e2429..6ffe88f721e 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -1,6 +1,6 @@
;; verilog-mode.el --- major mode for editing verilog source in Emacs
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Michael McNamara (mac@verilog.com),
;; Wilson Snyder (wsnyder@wsnyder.org)
@@ -123,9 +123,9 @@
;;; Code:
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "725"
+(defconst verilog-mode-version (substring "$$Revision: 820 $$" 12 -3)
"Version of this Verilog mode.")
-(defconst verilog-mode-release-date "2011-11-27-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.")
@@ -393,7 +393,7 @@ Set `verilog-in-hooks' during this time, to assist AUTO caches."
(parse-partial-sexp (point-min) (or pos (point)))))
(defgroup verilog-mode nil
- "Facilitates easy editing of Verilog source text."
+ "Major mode for Verilog source code."
:version "22.2"
:group 'languages)
@@ -415,11 +415,14 @@ Set `verilog-in-hooks' during this time, to assist AUTO caches."
:group 'verilog-mode)
(defvar verilog-debug nil
- "If set, enable debug messages for `verilog-mode' internals.")
+ "Non-nil means enable debug messages for `verilog-mode' internals.")
+
+(defvar verilog-warn-fatal nil
+ "Non-nil means `verilog-warn-error' warnings are fatal `error's.")
(defcustom verilog-linter
"echo 'No verilog-linter set, see \"M-x describe-variable verilog-linter\"'"
- "*Unix program and arguments to call to run a lint checker on Verilog source.
+ "Unix program and arguments to call to run a lint checker on Verilog source.
Depending on the `verilog-set-compile-command', this may be invoked when
you type \\[compile]. When the compile completes, \\[next-error] will take
you to the next lint error."
@@ -429,7 +432,7 @@ you to the next lint error."
(defcustom verilog-coverage
"echo 'No verilog-coverage set, see \"M-x describe-variable verilog-coverage\"'"
- "*Program and arguments to use to annotate for coverage Verilog source.
+ "Program and arguments to use to annotate for coverage Verilog source.
Depending on the `verilog-set-compile-command', this may be invoked when
you type \\[compile]. When the compile completes, \\[next-error] will take
you to the next lint error."
@@ -439,7 +442,7 @@ you to the next lint error."
(defcustom verilog-simulator
"echo 'No verilog-simulator set, see \"M-x describe-variable verilog-simulator\"'"
- "*Program and arguments to use to interpret Verilog source.
+ "Program and arguments to use to interpret Verilog source.
Depending on the `verilog-set-compile-command', this may be invoked when
you type \\[compile]. When the compile completes, \\[next-error] will take
you to the next lint error."
@@ -449,7 +452,7 @@ you to the next lint error."
(defcustom verilog-compiler
"echo 'No verilog-compiler set, see \"M-x describe-variable verilog-compiler\"'"
- "*Program and arguments to use to compile Verilog source.
+ "Program and arguments to use to compile Verilog source.
Depending on the `verilog-set-compile-command', this may be invoked when
you type \\[compile]. When the compile completes, \\[next-error] will take
you to the next lint error."
@@ -460,7 +463,7 @@ you to the next lint error."
(defcustom verilog-preprocessor
;; Very few tools give preprocessed output, so we'll default to Verilog-Perl
"vppreproc __FLAGS__ __FILE__"
- "*Program and arguments to use to preprocess Verilog source.
+ "Program and arguments to use to preprocess Verilog source.
This is invoked with `verilog-preprocess', and depending on the
`verilog-set-compile-command', may also be invoked when you type
\\[compile]. When the compile completes, \\[next-error] will
@@ -480,7 +483,7 @@ Alternatively use the \"Choose Compilation Action\" menu. See
`verilog-set-compile-command' for more information.")
(defcustom verilog-highlight-translate-off nil
- "*Non-nil means background-highlight code excluded from translation.
+ "Non-nil means background-highlight code excluded from translation.
That is, all code between \"// synopsys translate_off\" and
\"// synopsys translate_on\" is highlighted using a different background color
\(face `verilog-font-lock-translate-off-face').
@@ -495,7 +498,7 @@ entry \"Fontify Buffer\"). XEmacs: turn off and on font locking."
(put 'verilog-highlight-translate-off 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-lineup 'declarations
- "*Type of statements to lineup across multiple lines.
+ "Type of statements to lineup across multiple lines.
If 'all' is selected, then all line ups described below are done.
If 'declaration', then just declarations are lined up with any
@@ -524,15 +527,17 @@ are lineup only when \\[verilog-pretty-declarations] is typed."
(const :tag "Line up Declarations" declarations)
(function :tag "Other"))
:group 'verilog-mode-indent )
+(put 'verilog-auto-lineup 'safe-local-variable
+ '(lambda (x) (memq x '(nil all assignments declarations))))
(defcustom verilog-indent-level 3
- "*Indentation of Verilog statements with respect to containing block."
+ "Indentation of Verilog statements with respect to containing block."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-indent-level 'safe-local-variable 'integerp)
(defcustom verilog-indent-level-module 3
- "*Indentation of Module level Verilog statements (eg always, initial).
+ "Indentation of Module level Verilog statements (eg always, initial).
Set to 0 to get initial and always statements lined up on the left side of
your screen."
:group 'verilog-mode-indent
@@ -540,14 +545,14 @@ your screen."
(put 'verilog-indent-level-module 'safe-local-variable 'integerp)
(defcustom verilog-indent-level-declaration 3
- "*Indentation of declarations with respect to containing block.
+ "Indentation of declarations with respect to containing block.
Set to 0 to get them list right under containing block."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-indent-level-declaration 'safe-local-variable 'integerp)
(defcustom verilog-indent-declaration-macros nil
- "*How to treat macro expansions in a declaration.
+ "How to treat macro expansions in a declaration.
If nil, indent as:
input [31:0] a;
input `CP;
@@ -561,7 +566,7 @@ If non nil, treat as:
(put 'verilog-indent-declaration-macros 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-indent-lists t
- "*How to treat indenting items in a list.
+ "How to treat indenting items in a list.
If t (the default), indent as:
always @( posedge a or
reset ) begin
@@ -574,73 +579,72 @@ If nil, treat as:
(put 'verilog-indent-lists 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-indent-level-behavioral 3
- "*Absolute indentation of first begin in a task or function block.
+ "Absolute indentation of first begin in a task or function block.
Set to 0 to get such code to start at the left side of the screen."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-indent-level-behavioral 'safe-local-variable 'integerp)
(defcustom verilog-indent-level-directive 1
- "*Indentation to add to each level of `ifdef declarations.
+ "Indentation to add to each level of `ifdef declarations.
Set to 0 to have all directives start at the left side of the screen."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-indent-level-directive 'safe-local-variable 'integerp)
(defcustom verilog-cexp-indent 2
- "*Indentation of Verilog statements split across lines."
+ "Indentation of Verilog statements split across lines."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-cexp-indent 'safe-local-variable 'integerp)
(defcustom verilog-case-indent 2
- "*Indentation for case statements."
+ "Indentation for case statements."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-case-indent 'safe-local-variable 'integerp)
(defcustom verilog-auto-newline t
- "*True means automatically newline after semicolons."
+ "Non-nil means automatically newline after semicolons."
:group 'verilog-mode-indent
:type 'boolean)
(put 'verilog-auto-newline 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-indent-on-newline t
- "*True means automatically indent line after newline."
+ "Non-nil means automatically indent line after newline."
:group 'verilog-mode-indent
:type 'boolean)
(put 'verilog-auto-indent-on-newline 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-tab-always-indent t
- "*True means TAB should always re-indent the current line.
+ "Non-nil means TAB should always re-indent the current line.
A nil value means TAB will only reindent when at the beginning of the line."
:group 'verilog-mode-indent
:type 'boolean)
(put 'verilog-tab-always-indent 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-tab-to-comment nil
- "*True means TAB moves to the right hand column in preparation for a comment."
+ "Non-nil means TAB moves to the right hand column in preparation for a comment."
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-tab-to-comment 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-indent-begin-after-if t
- "*If true, indent begin statements following if, else, while, for and repeat.
+ "Non-nil means indent begin statements following if, else, while, etc.
Otherwise, line them up."
:group 'verilog-mode-indent
:type 'boolean)
(put 'verilog-indent-begin-after-if 'safe-local-variable 'verilog-booleanp)
-
(defcustom verilog-align-ifelse nil
- "*If true, align `else' under matching `if'.
+ "Non-nil means align `else' under matching `if'.
Otherwise else is lined up with first character on line holding matching if."
:group 'verilog-mode-indent
:type 'boolean)
(put 'verilog-align-ifelse 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-minimum-comment-distance 10
- "*Minimum distance (in lines) between begin and end required before a comment.
+ "Minimum distance (in lines) between begin and end required before a comment.
Setting this variable to zero results in every end acquiring a comment; the
default avoids too many redundant comments in tight quarters."
:group 'verilog-mode-indent
@@ -648,7 +652,7 @@ default avoids too many redundant comments in tight quarters."
(put 'verilog-minimum-comment-distance 'safe-local-variable 'integerp)
(defcustom verilog-highlight-p1800-keywords nil
- "*True means highlight words newly reserved by IEEE-1800.
+ "Non-nil means highlight words newly reserved by IEEE-1800.
These will appear in `verilog-font-lock-p1800-face' in order to gently
suggest changing where these words are used as variables to something else.
A nil value means highlight these words as appropriate for the SystemVerilog
@@ -659,7 +663,7 @@ to see the effect as font color choices are cached by Emacs."
(put 'verilog-highlight-p1800-keywords 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-highlight-grouping-keywords nil
- "*True means highlight grouping keywords 'begin' and 'end' more dramatically.
+ "Non-nil means highlight grouping keywords 'begin' and 'end' more dramatically.
If false, these words are in the `font-lock-type-face'; if True then they are in
`verilog-font-lock-ams-face'. Some find that special highlighting on these
grouping constructs allow the structure of the code to be understood at a glance."
@@ -668,7 +672,7 @@ grouping constructs allow the structure of the code to be understood at a glance
(put 'verilog-highlight-grouping-keywords 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-highlight-modules nil
- "*True means highlight module statements for `verilog-load-file-at-point'.
+ "Non-nil means highlight module statements for `verilog-load-file-at-point'.
When true, mousing over module names will allow jumping to the
module definition. If false, this is not supported. Setting
this is experimental, and may lead to bad performance."
@@ -677,7 +681,7 @@ this is experimental, and may lead to bad performance."
(put 'verilog-highlight-modules 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-highlight-includes t
- "*True means highlight module statements for `verilog-load-file-at-point'.
+ "Non-nil means highlight module statements for `verilog-load-file-at-point'.
When true, mousing over include file names will allow jumping to the
file referenced. If false, this is not supported."
:group 'verilog-mode-indent
@@ -685,36 +689,39 @@ file referenced. If false, this is not supported."
(put 'verilog-highlight-includes 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-declare-nettype nil
- "*Non-nil specifies the data type to use with `verilog-auto-input' etc.
+ "Non-nil specifies the data type to use with `verilog-auto-input' etc.
Set this to \"wire\" if the Verilog code uses \"`default_nettype
none\". Note using `default_nettype none isn't recommended practice; this
mode is experimental."
+ :version "24.1" ;; rev670
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-auto-declare-nettype 'safe-local-variable `stringp)
(defcustom verilog-auto-wire-type nil
- "*Non-nil specifies the data type to use with `verilog-auto-wire' etc.
+ "Non-nil specifies the data type to use with `verilog-auto-wire' etc.
Set this to \"logic\" for SystemVerilog code, or use `verilog-auto-logic'."
+ :version "24.1" ;; rev673
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-auto-wire-type 'safe-local-variable `stringp)
(defcustom verilog-auto-endcomments t
- "*True means insert a comment /* ... */ after 'end's.
+ "Non-nil means insert a comment /* ... */ after 'end's.
The name of the function or case will be set between the braces."
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-auto-endcomments 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-delete-trailing-whitespace nil
- "*True means to `delete-trailing-whitespace' in `verilog-auto'."
+ "Non-nil means to `delete-trailing-whitespace' in `verilog-auto'."
+ :version "24.1" ;; rev703
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-auto-delete-trailing-whitespace 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-ignore-concat nil
- "*True means ignore signals in {...} concatenations for AUTOWIRE etc.
+ "Non-nil means ignore signals in {...} concatenations for AUTOWIRE etc.
This will exclude signals referenced as pin connections in {...}
from AUTOWIRE, AUTOOUTPUT and friends. This flag should be set
for backward compatibility only and not set in new designs; it
@@ -724,7 +731,7 @@ may be removed in future versions."
(put 'verilog-auto-ignore-concat 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-read-includes nil
- "*True means to automatically read includes before AUTOs.
+ "Non-nil means to automatically read includes before AUTOs.
This will do a `verilog-read-defines' and `verilog-read-includes' before
each AUTO expansion. This makes it easier to embed defines and includes,
but can result in very slow reading times if there are many or large
@@ -734,7 +741,7 @@ include files."
(put 'verilog-auto-read-includes 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-save-policy nil
- "*Non-nil indicates action to take when saving a Verilog buffer with AUTOs.
+ "Non-nil indicates action to take when saving a Verilog buffer with AUTOs.
A value of `force' will always do a \\[verilog-auto] automatically if
needed on every save. A value of `detect' will do \\[verilog-auto]
automatically when it thinks necessary. A value of `ask' will query the
@@ -747,15 +754,15 @@ sub-module's port list has changed."
:type '(choice (const nil) (const ask) (const detect) (const force)))
(defcustom verilog-auto-star-expand t
- "*Non-nil indicates to expand a SystemVerilog .* instance ports.
-They will be expanded in the same way as if there was a AUTOINST in the
+ "Non-nil means to expand SystemVerilog .* instance ports.
+They will be expanded in the same way as if there was an AUTOINST in the
instantiation. See also `verilog-auto-star' and `verilog-auto-star-save'."
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-auto-star-expand 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-star-save nil
- "*Non-nil indicates to save to disk SystemVerilog .* instance expansions.
+ "Non-nil means save to disk SystemVerilog .* instance expansions.
A nil value indicates direct connections will be removed before saving.
Only meaningful to those created due to `verilog-auto-star-expand' being set.
@@ -772,7 +779,7 @@ always be saved."
"Text from file-local-variables during last evaluation.")
(defvar verilog-diff-function 'verilog-diff-report
- "*Function to run when `verilog-diff-auto' detects differences.
+ "Function to run when `verilog-diff-auto' detects differences.
Function takes three arguments, the original buffer, the
difference buffer, and the point in original buffer with the
first difference.")
@@ -866,11 +873,11 @@ See `compilation-error-regexp-alist-alist' for the formatting. For XEmacs.")
("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 1 bold t)
("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 2 bold t)
)
- "*Keywords to also highlight in Verilog *compilation* buffers.
+ "Keywords to also highlight in Verilog *compilation* buffers.
Only used in XEmacs; GNU Emacs uses `verilog-error-regexp-emacs-alist'.")
(defcustom verilog-library-flags '("")
- "*List of standard Verilog arguments to use for /*AUTOINST*/.
+ "List of standard Verilog arguments to use for /*AUTOINST*/.
These arguments are used to find files for `verilog-auto', and match
the flags accepted by a standard Verilog-XL simulator.
@@ -901,7 +908,7 @@ See also the variables mentioned above."
(put 'verilog-library-flags 'safe-local-variable 'listp)
(defcustom verilog-library-directories '(".")
- "*List of directories when looking for files for /*AUTOINST*/.
+ "List of directories when looking for files for /*AUTOINST*/.
The directory may be relative to the current file, or absolute.
Environment variables are also expanded in the directory names.
Having at least the current directory is a good idea.
@@ -924,7 +931,7 @@ and `verilog-library-extensions'."
(put 'verilog-library-directories 'safe-local-variable 'listp)
(defcustom verilog-library-files '()
- "*List of files to search for modules.
+ "List of files to search for modules.
AUTOINST will use this when it needs to resolve a module name.
This is a complete path, usually to a technology file with many standard
cells defined in it.
@@ -946,14 +953,14 @@ See also `verilog-library-flags', `verilog-library-directories'."
(put 'verilog-library-files 'safe-local-variable 'listp)
(defcustom verilog-library-extensions '(".v" ".sv")
- "*List of extensions to use when looking for files for /*AUTOINST*/.
+ "List of extensions to use when looking for files for /*AUTOINST*/.
See also `verilog-library-flags', `verilog-library-directories'."
:type '(repeat string)
:group 'verilog-mode-auto)
(put 'verilog-library-extensions 'safe-local-variable 'listp)
(defcustom verilog-active-low-regexp nil
- "*If set, treat signals matching this regexp as active low.
+ "If set, treat signals matching this regexp as active low.
This is used for AUTORESET and AUTOTIEOFF. For proper behavior,
you will probably also need `verilog-auto-reset-widths' set."
:group 'verilog-mode-auto
@@ -961,7 +968,7 @@ you will probably also need `verilog-auto-reset-widths' set."
(put 'verilog-active-low-regexp 'safe-local-variable 'stringp)
(defcustom verilog-auto-sense-include-inputs nil
- "*If true, AUTOSENSE should include all inputs.
+ "Non-nil means AUTOSENSE should include all inputs.
If nil, only inputs that are NOT output signals in the same block are
included."
:group 'verilog-mode-auto
@@ -969,7 +976,7 @@ included."
(put 'verilog-auto-sense-include-inputs 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-sense-defines-constant nil
- "*If true, AUTOSENSE should assume all defines represent constants.
+ "Non-nil means AUTOSENSE should assume all defines represent constants.
When true, the defines will not be included in sensitivity lists. To
maintain compatibility with other sites, this should be set at the bottom
of each Verilog file that requires it, rather than being set globally."
@@ -978,36 +985,45 @@ of each Verilog file that requires it, rather than being set globally."
(put 'verilog-auto-sense-defines-constant 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-reset-blocking-in-non t
- "*If true, AUTORESET will reset those signals which were
-assigned with blocking assignments (=) even in a block with
-non-blocking assignments (<=).
+ "Non-nil means AUTORESET will reset blocking statements.
+When true, AUTORESET will reset in blocking statements those
+signals which were assigned with blocking assignments (=) even in
+a block with non-blocking assignments (<=).
If nil, all blocking assigned signals are ignored when any
non-blocking assignment is in the AUTORESET block. This allows
blocking assignments to be used for temporary values and not have
those temporaries reset. See example in `verilog-auto-reset'."
+ :version "24.1" ;; rev718
:type 'boolean
:group 'verilog-mode-auto)
(put 'verilog-auto-reset-blocking-in-non 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-reset-widths t
- "*If true, AUTORESET should determine the width of signals.
+ "True means AUTORESET should determine the width of signals.
This is then used to set the width of the zero (32'h0 for example). This
is required by some lint tools that aren't smart enough to ignore widths of
-the constant zero. This may result in ugly code when parameters determine
-the MSB or LSB of a signal inside an AUTORESET."
+the constant zero. This may result in ugly code when parameters determine
+the MSB or LSB of a signal inside an AUTORESET.
+
+If nil, AUTORESET uses \"0\" as the constant.
+
+If 'unbased', AUTORESET used the unbased unsized literal \"'0\"
+as the constant. This setting is strongly recommended for
+SystemVerilog designs."
:type 'boolean
:group 'verilog-mode-auto)
-(put 'verilog-auto-reset-widths 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-reset-widths 'safe-local-variable
+ '(lambda (x) (memq x '(nil t unbased))))
(defcustom verilog-assignment-delay ""
- "*Text used for delays in delayed assignments. Add a trailing space if set."
+ "Text used for delays in delayed assignments. Add a trailing space if set."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-assignment-delay 'safe-local-variable 'stringp)
(defcustom verilog-auto-arg-sort nil
- "*If set, AUTOARG signal names will be sorted, not in declaration order.
+ "Non-nil means AUTOARG signal names will be sorted, not in declaration order.
Declaration order is advantageous with order based instantiations
and is the default for backward compatibility. Sorted order
reduces changes when declarations are moved around in a file, and
@@ -1019,7 +1035,7 @@ See also `verilog-auto-inst-sort'."
(put 'verilog-auto-arg-sort 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-inst-dot-name nil
- "*If true, when creating ports with AUTOINST, use .name syntax.
+ "Non-nil means when creating ports with AUTOINST, use .name syntax.
This will use \".port\" instead of \".port(port)\" when possible.
This is only legal in SystemVerilog files, and will confuse older
simulators. Setting `verilog-auto-inst-vector' to nil may also
@@ -1029,7 +1045,7 @@ be desirable to increase how often .name will be used."
(put 'verilog-auto-inst-dot-name 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-inst-param-value nil
- "*If set, AUTOINST will replace parameters with the parameter value.
+ "Non-nil means AUTOINST will replace parameters with the parameter value.
If nil, leave parameters as symbolic names.
Parameters must be in Verilog 2001 format #(...), and if a parameter is not
@@ -1037,7 +1053,7 @@ listed as such there (as when the default value is acceptable), it will not
be replaced, and will remain symbolic.
For example, imagine a submodule uses parameters to declare the size of its
-inputs. This is then used by a upper module:
+inputs. This is then used by an upper module:
module InstModule (o,i);
parameter WIDTH;
@@ -1066,19 +1082,20 @@ instead expand to:
(put 'verilog-auto-inst-param-value 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-inst-sort nil
- "*If set, AUTOINST signal names will be sorted, not in declaration order.
+ "Non-nil means AUTOINST signals will be sorted, not in declaration order.
Also affects AUTOINSTPARAM. Declaration order is the default for
backward compatibility, and as some teams prefer signals that are
declared together to remain together. Sorted order reduces
changes when declarations are moved around in a file.
See also `verilog-auto-arg-sort'."
+ :version "24.1" ;; rev688
:group 'verilog-mode-auto
:type 'boolean)
(put 'verilog-auto-inst-sort 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-inst-vector t
- "*If true, when creating default ports with AUTOINST, use bus subscripts.
+ "Non-nil means when creating default ports with AUTOINST, use bus subscripts.
If nil, skip the subscript when it matches the entire bus as declared in
the module (AUTOWIRE signals always are subscripted, you must manually
declare the wire to have the subscripts removed.) Setting this to nil may
@@ -1088,7 +1105,7 @@ speed up some simulators, but is less general and harder to read, so avoid."
(put 'verilog-auto-inst-vector 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-inst-template-numbers nil
- "*If true, when creating templated ports with AUTOINST, add a comment.
+ "If true, when creating templated ports with AUTOINST, add a comment.
If t, the comment will add the line number of the template that
was used for that port declaration. This setting is suggested
@@ -1105,96 +1122,124 @@ won't merge conflict."
'(lambda (x) (memq x '(nil t lhs))))
(defcustom verilog-auto-inst-column 40
- "*Indent-to column number for net name part of AUTOINST created pin."
+ "Indent-to column number for net name part of AUTOINST created pin."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-auto-inst-column 'safe-local-variable 'integerp)
+(defcustom verilog-auto-inst-interfaced-ports nil
+ "Non-nil means include interfaced ports in AUTOINST expansions."
+ :group 'verilog-mode-auto
+ :type 'boolean
+ :version "24.3")
+(put 'verilog-auto-inst-interfaced-ports 'safe-local-variable 'verilog-booleanp)
+
(defcustom verilog-auto-input-ignore-regexp nil
- "*If set, when creating AUTOINPUT list, ignore signals matching this regexp.
+ "If set, when creating AUTOINPUT list, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-auto-input-ignore-regexp 'safe-local-variable 'stringp)
(defcustom verilog-auto-inout-ignore-regexp nil
- "*If set, when creating AUTOINOUT list, ignore signals matching this regexp.
+ "If set, when creating AUTOINOUT list, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-auto-inout-ignore-regexp 'safe-local-variable 'stringp)
(defcustom verilog-auto-output-ignore-regexp nil
- "*If set, when creating AUTOOUTPUT list, ignore signals matching this regexp.
+ "If set, when creating AUTOOUTPUT list, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-auto-output-ignore-regexp 'safe-local-variable 'stringp)
+(defcustom verilog-auto-template-warn-unused nil
+ "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)
+
(defcustom verilog-auto-tieoff-declaration "wire"
- "*Data type used for the declaration for AUTOTIEOFF. If \"wire\" then
-create a wire, if \"assign\" create an assignment, else the data type for
-variable creation."
+ "Data type used for the declaration for AUTOTIEOFF.
+If \"wire\" then create a wire, if \"assign\" create an
+assignment, else the data type for variable creation."
+ :version "24.1" ;; rev713
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-auto-tieoff-declaration 'safe-local-variable 'stringp)
(defcustom verilog-auto-tieoff-ignore-regexp nil
- "*If set, when creating AUTOTIEOFF list, ignore signals matching this regexp.
+ "If set, when creating AUTOTIEOFF list, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-auto-tieoff-ignore-regexp 'safe-local-variable 'stringp)
(defcustom verilog-auto-unused-ignore-regexp nil
- "*If set, when creating AUTOUNUSED list, ignore signals matching this regexp.
+ "If set, when creating AUTOUNUSED list, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-auto-unused-ignore-regexp 'safe-local-variable 'stringp)
(defcustom verilog-typedef-regexp nil
- "*If non-nil, regular expression that matches Verilog-2001 typedef names.
+ "If non-nil, regular expression that matches Verilog-2001 typedef names.
For example, \"_t$\" matches typedefs named with _t, as in the C language."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-typedef-regexp 'safe-local-variable 'stringp)
(defcustom verilog-mode-hook 'verilog-set-compile-command
- "*Hook run after Verilog mode is loaded."
+ "Hook run after Verilog mode is loaded."
:type 'hook
:group 'verilog-mode)
(defcustom verilog-auto-hook nil
- "*Hook run after `verilog-mode' updates AUTOs."
+ "Hook run after `verilog-mode' updates AUTOs."
:group 'verilog-mode-auto
:type 'hook)
(defcustom verilog-before-auto-hook nil
- "*Hook run before `verilog-mode' updates AUTOs."
+ "Hook run before `verilog-mode' updates AUTOs."
:group 'verilog-mode-auto
:type 'hook)
(defcustom verilog-delete-auto-hook nil
- "*Hook run after `verilog-mode' deletes AUTOs."
+ "Hook run after `verilog-mode' deletes AUTOs."
:group 'verilog-mode-auto
:type 'hook)
(defcustom verilog-before-delete-auto-hook nil
- "*Hook run before `verilog-mode' deletes AUTOs."
+ "Hook run before `verilog-mode' deletes AUTOs."
:group 'verilog-mode-auto
:type 'hook)
(defcustom verilog-getopt-flags-hook nil
- "*Hook run after `verilog-getopt-flags' determines the Verilog option lists."
+ "Hook run after `verilog-getopt-flags' determines the Verilog option lists."
:group 'verilog-mode-auto
:type 'hook)
(defcustom verilog-before-getopt-flags-hook nil
- "*Hook run before `verilog-getopt-flags' determines the Verilog option lists."
+ "Hook run before `verilog-getopt-flags' determines the Verilog option lists."
:group 'verilog-mode-auto
:type 'hook)
+(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
'((nil "^\\s-*\\(\\(m\\(odule\\|acromodule\\)\\)\\|primitive\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 4)
("*Vars*" "^\\s-*\\(reg\\|wire\\)\\s-+\\(\\|\\[[^]]+\\]\\s-+\\)\\([A-Za-z0-9_]+\\)" 3))
@@ -1205,17 +1250,17 @@ For example, \"_t$\" matches typedefs named with _t, as in the C language."
;; Customization variables:
;;
(defvar verilog-date-scientific-format nil
- "*If non-nil, dates are written in scientific format (e.g. 1997/09/17).
+ "If non-nil, dates are written in scientific format (e.g. 1997/09/17).
If nil, in European format (e.g. 17.09.1997). The brain-dead American
format (e.g. 09/17/1997) is not supported.")
(defvar verilog-company nil
- "*Default name of Company for Verilog header.
+ "Default name of Company for Verilog header.
If set will become buffer local.")
(make-variable-buffer-local 'verilog-company)
(defvar verilog-project nil
- "*Default name of Project for Verilog header.
+ "Default name of Project for Verilog header.
If set will become buffer local.")
(make-variable-buffer-local 'verilog-project)
@@ -1390,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)
@@ -1423,7 +1474,9 @@ If set will become buffer local.")
["AUTOSENSE" (describe-function 'verilog-auto-sense)
:help "Help on AUTOSENSE - sensitivity lists for always blocks"]
["AUTOTIEOFF" (describe-function 'verilog-auto-tieoff)
- :help "Help on AUTOTIEOFF - tieing off unused outputs"]
+ :help "Help on AUTOTIEOFF - tying off unused outputs"]
+ ["AUTOUNDEF" (describe-function 'verilog-auto-undef)
+ :help "Help on AUTOUNDEF - undefine all local defines"]
["AUTOUNUSED" (describe-function 'verilog-auto-unused)
:help "Help on AUTOUNUSED - terminating unused inputs"]
["AUTOWIRE" (describe-function 'verilog-auto-wire)
@@ -1546,7 +1599,7 @@ If set will become buffer local.")
FIXEDCASE and LITERAL as in `replace-match`. STRING is what to replace.
The case (verilog-string-replace-matches \"o\" \"oo\" nil nil \"foobar\")
will break, as the o's continuously replace. xa -> x works ok though."
- ;; Hopefully soon to a emacs built-in
+ ;; Hopefully soon to an Emacs built-in
;; Also note \ in the replacement prevent multiple replacements; IE
;; (verilog-string-replace-matches "@" "\\\\([0-9]+\\\\)" nil nil "wire@_@")
;; Gives "wire\([0-9]+\)_@" not "wire\([0-9]+\)_\([0-9]+\)"
@@ -1663,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 syntatic WS as no formfeed
- (replace-match "" nil nil))))
+ (while (re-search-forward "[ \t]+$" nil t) ;; Not syntactic WS as no formfeed
+ (replace-match "" nil nil))
+ (goto-char (point-max))
+ (unless (bolp) (insert "\n"))))
(defvar compile-command)
@@ -2395,7 +2455,6 @@ find the errors."
"\\|\\(\\<`[ou]vm_[a-z_]+_begin\\>\\)" ;28
"\\|\\(\\<`vmm_[a-z_]+_member_begin\\>\\)"
;;
-
))
(defconst verilog-end-block-ordered-rry
@@ -2623,11 +2682,11 @@ find the errors."
"endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass"
))))
(defconst verilog-disable-fork-re "\\(disable\\|wait\\)\\s-+fork\\>")
-(defconst verilog-extended-case-re "\\(unique\\s-+\\|priority\\s-+\\)?case[xz]?")
+(defconst verilog-extended-case-re "\\(\\(unique\\s-+\\|priority\\s-+\\)?case[xz]?\\)")
(defconst verilog-extended-complete-re
- (concat "\\(\\<extern\\s-+\\|\\<\\(\\<pure\\>\\s-+\\)?virtual\\s-+\\|\\<protected\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)"
- "\\|\\(\\<typedef\\>\\s-+\\)*\\(\\<struct\\>\\|\\<union\\>\\|\\<class\\>\\)"
- "\\|\\(\\<import\\>\\s-+\\)?\"DPI-C\"\\s-+\\(function\\>\\|task\\>\\)"
+ (concat "\\(\\(\\<extern\\s-+\\|\\<\\(\\<pure\\>\\s-+\\)?virtual\\s-+\\|\\<protected\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)\\)"
+ "\\|\\(\\(\\<typedef\\>\\s-+\\)*\\(\\<struct\\>\\|\\<union\\>\\|\\<class\\>\\)\\)"
+ "\\|\\(\\(\\<import\\>\\s-+\\)?\\(\"DPI-C\"\\s-+\\)?\\(\\<pure\\>\\s-+\\)?\\(function\\>\\|task\\>\\)\\)"
"\\|" verilog-extended-case-re ))
(defconst verilog-basic-complete-re
(eval-when-compile
@@ -2639,9 +2698,7 @@ find the errors."
))))
(defconst verilog-complete-reg
(concat
- verilog-extended-complete-re
- "\\|"
- verilog-basic-complete-re))
+ verilog-extended-complete-re "\\|\\(" verilog-basic-complete-re "\\)"))
(defconst verilog-end-statement-re
(concat "\\(" verilog-beg-block-re "\\)\\|\\("
@@ -2758,7 +2815,8 @@ See also `verilog-font-lock-extra-types'.")
(defvar verilog-font-lock-keywords-3 nil
"Gaudy level highlighting for Verilog mode.
See also `verilog-font-lock-extra-types'.")
-(defvar verilog-font-lock-translate-off-face
+
+(defvar verilog-font-lock-translate-off-face
'verilog-font-lock-translate-off-face
"Font to use for translated off regions.")
(defface verilog-font-lock-translate-off-face
@@ -2836,8 +2894,8 @@ See also `verilog-font-lock-extra-types'.")
(verilog-pragma-keywords
(eval-when-compile
(verilog-regexp-opt
- '("surefire" "synopsys" "rtl_synthesis" "verilint" "leda" "0in") nil
- )))
+ '("surefire" "auto" "synopsys" "rtl_synthesis" "verilint" "leda" "0in"
+ ) nil )))
(verilog-1800-2005-keywords
(eval-when-compile
@@ -2962,7 +3020,7 @@ See also `verilog-font-lock-extra-types'.")
(append verilog-font-lock-keywords-1
(list
;; Fontify pragmas
- (concat "\\(//\\s-*" verilog-pragma-keywords "\\s-.*\\)")
+ (concat "\\(//\\s-*\\(" verilog-pragma-keywords "\\)\\s-.*\\)")
;; Fontify escaped names
'("\\(\\\\\\S-*\\s-\\)" 0 font-lock-function-name-face)
;; Fontify macro definitions/ uses
@@ -3024,6 +3082,31 @@ For insignificant changes, see instead `verilog-save-buffer-state'."
after-change-functions)
(progn ,@body)))
+(defvar verilog-save-font-mod-hooked nil
+ "Local variable when inside a `verilog-save-font-mods' block.")
+(make-variable-buffer-local 'verilog-save-font-mod-hooked)
+
+(defmacro verilog-save-font-mods (&rest body)
+ "Execute BODY forms, disabling text modifications to allow performing BODY.
+Includes temporary disabling of `font-lock' to restore the buffer
+to full text form for parsing. Additional actions may be specified with
+`verilog-before-save-font-hook' and `verilog-after-save-font-hook'."
+ ;; Before version 20, match-string with font-lock returns a
+ ;; vector that is not equal to the string. IE if on "input"
+ ;; nil==(equal "input" (progn (looking-at "input") (match-string 0)))
+ `(let* ((hooked (unless verilog-save-font-mod-hooked
+ (verilog-run-hooks 'verilog-before-save-font-hook)
+ t))
+ (verilog-save-font-mod-hooked t)
+ (fontlocked (when (and (boundp 'font-lock-mode) font-lock-mode)
+ (font-lock-mode 0)
+ t)))
+ (unwind-protect
+ (progn ,@body)
+ ;; Unwind forms
+ (when fontlocked (font-lock-mode t))
+ (when hooked (verilog-run-hooks 'verilog-after-save-font-hook)))))
+
;;
;; Comment detection and caching
@@ -3155,7 +3238,7 @@ to establish comment properties on all text."
(defun verilog-insert (&rest stuff)
"Insert STUFF arguments, tracking for `verilog-inside-comment-or-string-p'.
-Any insert that includes a comment must have the entire commente
+Any insert that includes a comment must have the entire comment
inserted using a single call to `verilog-insert'."
(let ((pt (point)))
(while stuff
@@ -3559,9 +3642,10 @@ Key bindings specific to `verilog-mode-map' are:
;; Stuff for GNU Emacs
(set (make-local-variable 'font-lock-defaults)
- `((verilog-font-lock-keywords verilog-font-lock-keywords-1
- verilog-font-lock-keywords-2
- verilog-font-lock-keywords-3)
+ `((verilog-font-lock-keywords
+ verilog-font-lock-keywords-1
+ verilog-font-lock-keywords-2
+ verilog-font-lock-keywords-3)
nil nil nil
,(if (functionp 'syntax-ppss)
;; verilog-beg-of-defun uses syntax-ppss, and syntax-ppss uses
@@ -3586,7 +3670,7 @@ Key bindings specific to `verilog-mode-map' are:
(set (make-local-variable 'imenu-generic-expression)
verilog-imenu-generic-expression)
;; Tell which-func-modes that imenu knows about verilog
- (when (boundp 'which-func-modes)
+ (when (and (boundp 'which-func-modes) (listp which-func-modes))
(add-to-list 'which-func-modes 'verilog-mode))
;; hideshow support
(when (boundp 'hs-special-modes-alist)
@@ -4043,7 +4127,7 @@ With ARG, first kill any existing labels."
(if (looking-at verilog-label-re)
(setq h (point))))
(goto-char h)))
- ;; stop if we see a complete reg, perhaps an extended one
+ ;; stop if we see an extended complete reg, perhaps a complete one
(and
(looking-at verilog-complete-reg)
(let* ((p (point)))
@@ -4180,32 +4264,20 @@ More specifically, point @ in the line foo : @ begin"
nil)))
(defun verilog-backward-up-list (arg)
- "Like `backward-up-list', but deal with comments."
+ "Call `backward-up-list' ARG, ignoring comments."
(let ((parse-sexp-ignore-comments t))
(backward-up-list arg)))
(defun verilog-forward-sexp-cmt (arg)
- "Call `forward-sexp', inside comments."
+ "Call `forward-sexp' ARG, inside comments."
(let ((parse-sexp-ignore-comments nil))
(forward-sexp arg)))
(defun verilog-forward-sexp-ign-cmt (arg)
- "Call `forward-sexp', ignoring comments."
+ "Call `forward-sexp' ARG, ignoring comments."
(let ((parse-sexp-ignore-comments t))
(forward-sexp arg)))
-(defun verilog-in-struct-region-p ()
- "Return true if in a struct region.
-More specifically, in a list after a struct|union keyword."
- (interactive)
- (save-excursion
- (let* ((state (verilog-syntax-ppss))
- (depth (nth 0 state)))
- (if depth
- (progn (verilog-backward-up-list depth)
- (verilog-beg-of-statement)
- (looking-at "\\<typedef\\>?\\s-*\\<struct\\|union\\>"))))))
-
(defun verilog-in-generate-region-p ()
"Return true if in a generate region.
More specifically, after a generate and before an endgenerate."
@@ -4652,10 +4724,10 @@ primitive or interface named NAME."
(cond
((match-end 5) ;; of verilog-end-block-ordered-re
(setq reg "\\(\\<function\\>\\)\\|\\(\\<\\(endfunction\\|task\\|\\(macro\\)?module\\|primitive\\)\\>\\)")
- (setq name-re "\\w+\\s-*(")
- )
+ (setq name-re "\\w+\\s-*("))
((match-end 6) ;; of verilog-end-block-ordered-re
- (setq reg "\\(\\<task\\>\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)"))
+ (setq reg "\\(\\<task\\>\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)")
+ (setq name-re "\\w+\\s-*("))
((match-end 7) ;; of verilog-end-block-ordered-re
(setq reg "\\(\\<\\(macro\\)?module\\>\\)\\|\\<endmodule\\>"))
((match-end 8) ;; of verilog-end-block-ordered-re
@@ -4971,25 +5043,24 @@ becomes:
(compile compile-command))
(defun verilog-preprocess (&optional command filename)
- "Preprocess the buffer, similar to `compile', but leave output in Verilog-Mode.
+ "Preprocess the buffer, similar to `compile', but put output in Verilog-Mode.
Takes optional COMMAND or defaults to `verilog-preprocessor', and
-FILENAME or defaults to `buffer-file-name`."
+FILENAME to find directory to run in, or defaults to `buffer-file-name`."
(interactive
(list
(let ((default (verilog-expand-command verilog-preprocessor)))
(set (make-local-variable `verilog-preprocessor)
- (read-from-minibuffer "Run Preprocessor (like this): "
- default nil nil
- 'verilog-preprocess-history default)))))
+ (read-from-minibuffer "Run Preprocessor (like this): "
+ default nil nil
+ 'verilog-preprocess-history default)))))
(unless command (setq command (verilog-expand-command verilog-preprocessor)))
(let* ((fontlocked (and (boundp 'font-lock-mode) font-lock-mode))
- (dir (file-name-directory (or filename buffer-file-name)))
- (file (file-name-nondirectory (or filename buffer-file-name)))
- (cmd (concat "cd " dir "; " command " " file)))
+ (dir (file-name-directory (or filename buffer-file-name)))
+ (cmd (concat "cd " dir "; " command)))
(with-output-to-temp-buffer "*Verilog-Preprocessed*"
(with-current-buffer (get-buffer "*Verilog-Preprocessed*")
(insert (concat "// " cmd "\n"))
- (shell-command cmd "*Verilog-Preprocessed*")
+ (call-process shell-file-name nil t nil shell-command-switch cmd)
(verilog-mode)
;; Without this force, it takes a few idle seconds
;; to get the color, which is very jarring
@@ -5000,17 +5071,30 @@ FILENAME or defaults to `buffer-file-name`."
;; Batch
;;
+(defun verilog-warn (string &rest args)
+ "Print a warning with `format' using STRING and optional ARGS."
+ (apply 'message (concat "%%Warning: " string) args))
+
+(defun verilog-warn-error (string &rest args)
+ "Call `error' using STRING and optional ARGS.
+If `verilog-warn-fatal' is non-nil, call `verilog-warn' instead."
+ (if verilog-warn-fatal
+ (apply 'error string args)
+ (apply 'verilog-warn string args)))
+
(defmacro verilog-batch-error-wrapper (&rest body)
"Execute BODY and add error prefix to any errors found.
This lets programs calling batch mode to easily extract error messages."
- `(condition-case err
- (progn ,@body)
- (error
- (error "%%Error: %s%s" (error-message-string err)
- (if (featurep 'xemacs) "\n" ""))))) ;; XEmacs forgets to add a newline
+ `(let ((verilog-warn-fatal nil))
+ (condition-case err
+ (progn ,@body)
+ (error
+ (error "%%Error: %s%s" (error-message-string err)
+ (if (featurep 'xemacs) "\n" "")))))) ;; XEmacs forgets to add a newline
(defun verilog-batch-execute-func (funref &optional no-save)
- "Internal processing of a batch command, running FUNREF on all command arguments.
+ "Internal processing of a batch command.
+Runs FUNREF on all command arguments.
Save the result unless optional NO-SAVE is t."
(verilog-batch-error-wrapper
;; Setting global variables like that is *VERY NASTY* !!! --Stef
@@ -5061,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
@@ -5082,7 +5175,7 @@ line in bottom-up order."
(verilog-batch-execute-func `verilog-inject-auto))
(defun verilog-batch-indent ()
- "For use with --batch, reindent an a entire file as a stand-alone tool.
+ "For use with --batch, reindent an entire file as a stand-alone tool.
This sets up the appropriate Verilog mode environment, calls
\\[verilog-indent-buffer] on all command-line files, and saves the buffers."
(unless noninteractive
@@ -5213,7 +5306,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(verilog-beg-of-statement) ;; doesn't get to beginning
(if (looking-at verilog-property-re)
(throw 'nesting 'statement) ; We don't need an endproperty for these
- (throw 'nesting 'block) ;We still need a endproperty
+ (throw 'nesting 'block) ;We still need an endproperty
))
(t ; endblock
; try to leap back to matching outward block by striding across
@@ -5306,7 +5399,6 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(t
(setq depth (verilog-current-indent-level)))))
(message "You are at nesting %s depth %d" type depth))))
-
(defun verilog-calc-1 ()
(catch 'nesting
(let ((re (concat "\\({\\|}\\|" verilog-indent-re "\\)")))
@@ -5364,9 +5456,10 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
; endfunction
(verilog-beg-of-statement)
(if (looking-at verilog-beg-block-re-ordered)
- (throw 'nesting 'block)
- (throw 'nesting 'defun)))
+ (throw 'nesting 'block)
+ (throw 'nesting 'defun)))
+ ;;
((looking-at "\\<property\\>")
; *sigh*
; {assert|assume|cover} property (); are complete
@@ -5376,7 +5469,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(verilog-beg-of-statement)
(if (looking-at verilog-property-re)
(throw 'continue 'statement) ; We don't need an endproperty for these
- (throw 'nesting 'block) ;We still need a endproperty
+ (throw 'nesting 'block) ;We still need an endproperty
))
(t (throw 'nesting 'block))))
@@ -5709,7 +5802,7 @@ Set point to where line starts."
(forward-comment (- (buffer-size))))
(defun verilog-backward-syntactic-ws-quick ()
- "As with `verilog-backward-syntactic-ws' but uses `verilog-scan' cache."
+ "As with `verilog-backward-syntactic-ws' but use `verilog-scan' cache."
(while (cond ((bobp)
nil) ; Done
((> (skip-syntax-backward " ") 0)
@@ -5858,7 +5951,7 @@ May cache result using `verilog-syntax-ppss'."
(defun verilog-in-paren-quick ()
"Return true if in a parenthetical expression.
-Always starts from point-min, to allow inserts with hooks disabled."
+Always starts from `point-min', to allow inserts with hooks disabled."
;; The -quick refers to its use alongside the other -quick functions,
;; not that it's likely to be faster than verilog-in-paren.
(let ((state (save-excursion (parse-partial-sexp (point-min) (point)))))
@@ -6112,7 +6205,7 @@ Only look at a few lines to determine indent level."
(indent-line-to val)
(if (and (not verilog-indent-lists)
(verilog-in-paren))
- (verilog-pretty-declarations))
+ (verilog-pretty-declarations-auto))
))
((= (preceding-char) ?\) )
(goto-char here)
@@ -6148,7 +6241,7 @@ Only look at a few lines to determine indent level."
(looking-at verilog-declaration-re))))
(indent-line-to val)
(if decl
- (verilog-pretty-declarations))))
+ (verilog-pretty-declarations-auto))))
(;-- Handle the ends
(or
@@ -6279,6 +6372,12 @@ ARG is ignored, for `comment-indent-function' compatibility."
;;
+(defun verilog-pretty-declarations-auto (&optional quiet)
+ "Call `verilog-pretty-declarations' QUIET based on `verilog-auto-lineup'."
+ (when (or (eq 'all verilog-auto-lineup)
+ (eq 'declarations verilog-auto-lineup))
+ (verilog-pretty-declarations quiet)))
+
(defun verilog-pretty-declarations (&optional quiet)
"Line up declarations around point.
Be verbose about progress unless optional QUIET set."
@@ -6425,100 +6524,101 @@ Be verbose about progress unless optional QUIET set."
(interactive)
(if (not (verilog-in-comment-or-string-p))
(save-excursion
- (let ((rexp (concat "^\\s-*" verilog-complete-reg)))
- (beginning-of-line)
- (if (and (not (looking-at rexp ))
- (looking-at verilog-assignment-operation-re)
- (save-excursion
- (goto-char (match-end 2))
- (and (not (verilog-in-attribute-p))
- (not (verilog-in-parameter-p))
- (not (verilog-in-comment-or-string-p)))))
- (let* ((here (point))
- (e) (r)
- (start
- (progn
- (beginning-of-line)
- (setq e (point))
- (verilog-backward-syntactic-ws)
- (beginning-of-line)
- (while (and (not (looking-at rexp ))
- (looking-at verilog-assignment-operation-re)
- (not (bobp))
- )
- (setq e (point))
- (verilog-backward-syntactic-ws)
- (beginning-of-line)
- ) ;Ack, need to grok `define
- e))
- (end
- (progn
- (goto-char here)
- (end-of-line)
- (setq e (point)) ;Might be on last line
- (verilog-forward-syntactic-ws)
- (beginning-of-line)
- (while (and
- (not (looking-at rexp ))
- (looking-at verilog-assignment-operation-re)
- (progn
- (end-of-line)
- (not (eq e (point)))))
- (setq e (point))
- (verilog-forward-syntactic-ws)
- (beginning-of-line)
- )
- e))
- (endpos (set-marker (make-marker) end))
- (ind)
- )
- (goto-char start)
- (verilog-do-indent (verilog-calculate-indent))
- (if (and (not quiet)
- (> (- end start) 100))
- (message "Lining up expressions..(please stand by)"))
-
- ;; Set indent to minimum throughout region
- (while (< (point) (marker-position endpos))
- (beginning-of-line)
- (verilog-just-one-space verilog-assignment-operation-re)
- (beginning-of-line)
- (verilog-do-indent (verilog-calculate-indent))
- (end-of-line)
- (verilog-forward-syntactic-ws)
- )
-
- ;; Now find biggest prefix
- (setq ind (verilog-get-lineup-indent-2 verilog-assignment-operation-re start endpos))
-
- ;; Now indent each line.
- (goto-char start)
- (while (progn (setq e (marker-position endpos))
- (setq r (- e (point)))
- (> r 0))
- (setq e (point))
- (if (not quiet) (message "%d" r))
- (cond
- ((looking-at verilog-assignment-operation-re)
- (goto-char (match-beginning 2))
- (if (not (or (verilog-in-parenthesis-p) ;; leave attributes and comparisons alone
- (verilog-in-coverage-p)))
- (if (eq (char-after) ?=)
- (indent-to (1+ ind)) ; line up the = of the <= with surrounding =
- (indent-to ind)
- ))
- )
- ((verilog-continued-line-1 start)
- (goto-char e)
- (indent-line-to ind))
- (t ; Must be comment or white space
- (goto-char e)
- (verilog-forward-ws&directives)
- (forward-line -1))
- )
- (forward-line 1))
- (unless quiet (message ""))
- ))))))
+ (let ( (rexp (concat "^\\s-*" verilog-complete-reg))
+ (rexp1 (concat "^\\s-*" verilog-basic-complete-re)))
+ (beginning-of-line)
+ (if (and (not (looking-at rexp ))
+ (looking-at verilog-assignment-operation-re)
+ (save-excursion
+ (goto-char (match-end 2))
+ (and (not (verilog-in-attribute-p))
+ (not (verilog-in-parameter-p))
+ (not (verilog-in-comment-or-string-p)))))
+ (let* ((here (point))
+ (e) (r)
+ (start
+ (progn
+ (beginning-of-line)
+ (setq e (point))
+ (verilog-backward-syntactic-ws)
+ (beginning-of-line)
+ (while (and (not (looking-at rexp1))
+ (looking-at verilog-assignment-operation-re)
+ (not (bobp))
+ )
+ (setq e (point))
+ (verilog-backward-syntactic-ws)
+ (beginning-of-line)
+ ) ;Ack, need to grok `define
+ e))
+ (end
+ (progn
+ (goto-char here)
+ (end-of-line)
+ (setq e (point)) ;Might be on last line
+ (verilog-forward-syntactic-ws)
+ (beginning-of-line)
+ (while (and
+ (not (looking-at rexp1 ))
+ (looking-at verilog-assignment-operation-re)
+ (progn
+ (end-of-line)
+ (not (eq e (point)))))
+ (setq e (point))
+ (verilog-forward-syntactic-ws)
+ (beginning-of-line)
+ )
+ e))
+ (endpos (set-marker (make-marker) end))
+ (ind)
+ )
+ (goto-char start)
+ (verilog-do-indent (verilog-calculate-indent))
+ (if (and (not quiet)
+ (> (- end start) 100))
+ (message "Lining up expressions..(please stand by)"))
+
+ ;; Set indent to minimum throughout region
+ (while (< (point) (marker-position endpos))
+ (beginning-of-line)
+ (verilog-just-one-space verilog-assignment-operation-re)
+ (beginning-of-line)
+ (verilog-do-indent (verilog-calculate-indent))
+ (end-of-line)
+ (verilog-forward-syntactic-ws)
+ )
+
+ ;; Now find biggest prefix
+ (setq ind (verilog-get-lineup-indent-2 verilog-assignment-operation-re start endpos))
+
+ ;; Now indent each line.
+ (goto-char start)
+ (while (progn (setq e (marker-position endpos))
+ (setq r (- e (point)))
+ (> r 0))
+ (setq e (point))
+ (if (not quiet) (message "%d" r))
+ (cond
+ ((looking-at verilog-assignment-operation-re)
+ (goto-char (match-beginning 2))
+ (if (not (or (verilog-in-parenthesis-p) ;; leave attributes and comparisons alone
+ (verilog-in-coverage-p)))
+ (if (eq (char-after) ?=)
+ (indent-to (1+ ind)) ; line up the = of the <= with surrounding =
+ (indent-to ind)
+ ))
+ )
+ ((verilog-continued-line-1 start)
+ (goto-char e)
+ (indent-line-to ind))
+ (t ; Must be comment or white space
+ (goto-char e)
+ (verilog-forward-ws&directives)
+ (forward-line -1))
+ )
+ (forward-line 1))
+ (unless quiet (message ""))
+ ))))))
(defun verilog-just-one-space (myre)
"Remove extra spaces around regular expression MYRE."
@@ -6680,7 +6780,7 @@ Region is defined by B and EDPOS."
(defvar verilog-buffer-to-use nil)
(defvar verilog-flag nil)
(defvar verilog-toggle-completions nil
- "*True means \\<verilog-mode-map>\\[verilog-complete-word] should try all possible completions one by one.
+ "True means \\<verilog-mode-map>\\[verilog-complete-word] should try all possible completions one by one.
Repeated use of \\[verilog-complete-word] will show you all of them.
Normally, when there is more than one possible completion,
it displays a list of all possible completions.")
@@ -6695,13 +6795,13 @@ it displays a list of all possible completions.")
"rtranif1" "semaphore" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1"
"triand" "trior" "trireg" "wand" "wire" "wor" "xnor" "xor"
)
- "*Keywords for types used when completing a word in a declaration or parmlist.
+ "Keywords for types used when completing a word in a declaration or parmlist.
\(integer, real, reg...)")
(defvar verilog-cpp-keywords
'("module" "macromodule" "primitive" "timescale" "define" "ifdef" "ifndef" "else"
"endif")
- "*Keywords to complete when at first word of a line in declarative scope.
+ "Keywords to complete when at first word of a line in declarative scope.
\(initial, always, begin, assign...)
The procedures and variables defined within the Verilog program
will be completed at runtime and should not be added to this list.")
@@ -6715,7 +6815,7 @@ will be completed at runtime and should not be added to this list.")
"task" "endtask" "primitive" "endprimitive"
)
verilog-type-keywords)
- "*Keywords to complete when at first word of a line in declarative scope.
+ "Keywords to complete when at first word of a line in declarative scope.
\(initial, always, begin, assign...)
The procedures and variables defined within the Verilog program
will be completed at runtime and should not be added to this list.")
@@ -6726,28 +6826,28 @@ will be completed at runtime and should not be added to this list.")
"endgenerate" "endinterface" "endpackage" "endspecify" "endtask"
"for" "fork" "if" "join" "join_any" "join_none" "repeat" "return"
"while")
- "*Keywords to complete when at first word of a line in behavioral scope.
+ "Keywords to complete when at first word of a line in behavioral scope.
\(begin, if, then, else, for, fork...)
The procedures and variables defined within the Verilog program
will be completed at runtime and should not be added to this list.")
(defvar verilog-tf-keywords
'("begin" "break" "fork" "join" "join_any" "join_none" "case" "end" "endtask" "endfunction" "if" "else" "for" "while" "repeat")
- "*Keywords to complete when at first word of a line in a task or function.
+ "Keywords to complete when at first word of a line in a task or function.
\(begin, if, then, else, for, fork.)
The procedures and variables defined within the Verilog program
will be completed at runtime and should not be added to this list.")
(defvar verilog-case-keywords
'("begin" "fork" "join" "join_any" "join_none" "case" "end" "endcase" "if" "else" "for" "repeat")
- "*Keywords to complete when at first word of a line in case scope.
+ "Keywords to complete when at first word of a line in case scope.
\(begin, if, then, else, for, fork...)
The procedures and variables defined within the Verilog program
will be completed at runtime and should not be added to this list.")
(defvar verilog-separator-keywords
'("else" "then" "begin")
- "*Keywords to complete when NOT standing at the first word of a statement.
+ "Keywords to complete when NOT standing at the first word of a statement.
\(else, then, begin...)
Variables and function names defined within the Verilog program
will be completed at runtime and should not be added to this list.")
@@ -6780,10 +6880,10 @@ will be completed at runtime and should not be added to this list.")
("tranif1" "inout" "inout")
("xnor" "output")
("xor" "output"))
- "*Map of direction for each positional argument to each gate primitive.")
+ "Map of direction for each positional argument to each gate primitive.")
(defvar verilog-gate-keywords (mapcar `car verilog-gate-ios)
- "*Keywords for gate primitives.")
+ "Keywords for gate primitives.")
(defun verilog-string-diff (str1 str2)
"Return index of first letter where STR1 and STR2 differs."
@@ -7359,6 +7459,7 @@ See also `verilog-sk-header' for an alternative format."
;;
;; Elements of a signal list
+;; Unfortunately we use 'assoc' on this, so can't be a vector
(defsubst verilog-sig-new (name bits comment mem enum signed type multidim modport)
(list name bits comment mem enum signed type multidim modport))
(defsubst verilog-sig-name (sig)
@@ -7375,6 +7476,8 @@ See also `verilog-sk-header' for an alternative format."
(nth 5 sig))
(defsubst verilog-sig-type (sig)
(nth 6 sig))
+(defsubst verilog-sig-type-set (sig type)
+ (setcar (nthcdr 6 sig) type))
(defsubst verilog-sig-multidim (sig)
(nth 7 sig))
(defsubst verilog-sig-multidim-string (sig)
@@ -7390,17 +7493,30 @@ See also `verilog-sk-header' for an alternative format."
(verilog-make-width-expression (verilog-sig-bits sig)))
(defsubst verilog-alw-new (outputs-del outputs-imm temps inputs)
- (list outputs-del outputs-imm temps inputs))
+ (vector outputs-del outputs-imm temps inputs))
(defsubst verilog-alw-get-outputs-delayed (sigs)
- (nth 0 sigs))
+ (aref sigs 0))
(defsubst verilog-alw-get-outputs-immediate (sigs)
- (nth 1 sigs))
+ (aref sigs 1))
(defsubst verilog-alw-get-temps (sigs)
- (nth 2 sigs))
+ (aref sigs 2))
(defsubst verilog-alw-get-inputs (sigs)
- (nth 3 sigs))
+ (aref sigs 3))
(defsubst verilog-alw-get-uses-delayed (sigs)
- (nth 0 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))
@@ -7419,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)
@@ -7429,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)
@@ -7440,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)
@@ -7453,6 +7577,41 @@ See also `verilog-sk-header' for an alternative format."
(defsubst verilog-subdecls-get-interfaced (subdecls)
(aref subdecls 4))
+(defun verilog-signals-from-signame (signame-list)
+ "Return signals in standard form from SIGNAME-LIST, a simple list of names."
+ (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.
@@ -7465,17 +7624,17 @@ Signals must be in standard (base vector) form."
(puthash (car (car not-list)) t ht)
(setq not-list (cdr not-list)))
(while in-list
- (when (not (gethash (car (car in-list)) ht))
+ (when (not (gethash (verilog-sig-name (car in-list)) ht))
(setq out-list (cons (car in-list) out-list))
- (puthash (car (car in-list)) t ht))
+ (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 (not (or (assoc (car (car in-list)) not-list)
- (assoc (car (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)))))
@@ -7493,13 +7652,22 @@ Signals must be in standard (base vector) form."
(defun verilog-signals-sort-compare (a b)
"Compare signal A and B for sorting."
- (string< (car a) (car b)))
+ (string< (verilog-sig-name a) (verilog-sig-name b)))
(defun verilog-signals-not-params (in-list)
"Return list of signals in IN-LIST that aren't parameters or numeric constants."
(let (out-list)
(while in-list
- (unless (boundp (intern (concat "vh-" (car (car in-list)))))
+ (unless (boundp (intern (concat "vh-" (verilog-sig-name (car in-list)))))
+ (setq out-list (cons (car in-list) out-list)))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list)))
+
+(defun verilog-signals-with (func in-list)
+ "Return IN-LIST with only signals where FUNC passed each signal is true."
+ (let (out-list)
+ (while in-list
+ (when (funcall func (car in-list))
(setq out-list (cons (car in-list) out-list)))
(setq in-list (cdr in-list)))
(nreverse out-list)))
@@ -7588,20 +7756,87 @@ Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]."
;;
out-list))
-(defun verilog-sig-tieoff (sig &optional no-width)
+(defun verilog-sig-tieoff (sig)
"Return tieoff expression for given SIG, with appropriate width.
-Ignore width if optional NO-WIDTH is set."
- (let* ((width (if no-width nil (verilog-sig-width sig))))
- (concat
- (if (and verilog-active-low-regexp
- (string-match verilog-active-low-regexp (verilog-sig-name sig)))
- "~" "")
- (cond ((not width)
- "0")
- ((string-match "^[0-9]+$" width)
- (concat width (if (verilog-sig-signed sig) "'sh0" "'h0")))
- (t
- (concat "{" width "{1'b0}}"))))))
+Tieoff value uses `verilog-active-low-regexp' and
+`verilog-auto-reset-widths'."
+ (concat
+ (if (and verilog-active-low-regexp
+ (string-match verilog-active-low-regexp (verilog-sig-name sig)))
+ "~" "")
+ (cond ((not verilog-auto-reset-widths)
+ "0")
+ ((equal verilog-auto-reset-widths 'unbased)
+ "'0")
+ ;; Else presume verilog-auto-reset-widths is true
+ (t
+ (let* ((width (verilog-sig-width sig)))
+ (if (string-match "^[0-9]+$" width)
+ (concat width (if (verilog-sig-signed sig) "'sh0" "'h0"))
+ (concat "{" width "{1'b0}}")))))))
+
+;;
+;; Dumping
+;;
+
+(defun verilog-decls-princ (decls &optional header prefix)
+ "For debug, dump the `verilog-read-decls' structure DECLS."
+ (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
+ (if header (princ header))
+ (while signals
+ (let ((sig (car signals)))
+ (setq signals (cdr signals))
+ (princ prefix)
+ (princ "\"") (princ (verilog-sig-name sig)) (princ "\"")
+ (princ " bits=") (princ (verilog-sig-bits sig))
+ (princ " cmt=") (princ (verilog-sig-comment sig))
+ (princ " mem=") (princ (verilog-sig-memory sig))
+ (princ " enum=") (princ (verilog-sig-enum sig))
+ (princ " sign=") (princ (verilog-sig-signed sig))
+ (princ " type=") (princ (verilog-sig-type sig))
+ (princ " dim=") (princ (verilog-sig-multidim sig))
+ (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
@@ -7695,7 +7930,7 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters."
(let ((olist))
(save-excursion
;; /*AUTOPUNT("parameter", "parameter")*/
- (search-backward "(")
+ (backward-sexp 1)
(while (looking-at "(?\\s *\"\\([^\"]*\\)\"\\s *,?")
(setq olist (cons (match-string 1) olist))
(goto-char (match-end 0))))
@@ -7710,14 +7945,15 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters."
(defun verilog-read-decls ()
"Compute signal declaration information for the current module at point.
-Return a array of [outputs inouts inputs wire reg assign const]."
+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 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))
@@ -7725,13 +7961,13 @@ Return a array of [outputs inouts inputs wire reg assign const]."
;;(if dbg (setq dbg (concat dbg (format "Pt %s Vec %s C%c Kwd'%s'\n" (point) vec (following-char) keywd))))
(cond
((looking-at "//")
- (if (looking-at "[^\n]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
- (setq enum (match-string 1)))
+ (if (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
+ (setq enum (match-string 2)))
(search-forward "\n"))
((looking-at "/\\*")
(forward-char 2)
- (if (looking-at "[^\n]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
- (setq enum (match-string 1)))
+ (if (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
+ (setq enum (match-string 2)))
(or (search-forward "*/")
(error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point))))
((looking-at "(\\*")
@@ -7743,6 +7979,17 @@ Return a 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))
@@ -7789,51 +8036,72 @@ Return a array of [outputs inouts inputs wire reg assign const]."
(when (string-match "^\\\\" (match-string 1))
(setq keywd (concat keywd " ")))) ;; Escaped ID needs space at end
(cond ((equal keywd "input")
- (setq vec nil enum nil rvalue nil newsig nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-in io t modport nil))
+ (setq vec nil enum nil rvalue nil newsig nil signed nil
+ typedefed nil multidim nil ptype nil modport nil
+ expect-signal 'sigs-in io t sig-paren paren))
((equal keywd "output")
- (setq vec nil enum nil rvalue nil newsig nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-out io t modport nil))
+ (setq vec nil enum nil rvalue nil newsig nil signed nil
+ typedefed nil multidim nil ptype nil modport nil
+ expect-signal 'sigs-out io t sig-paren paren))
((equal keywd "inout")
- (setq vec nil enum nil rvalue nil newsig nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-inout io t modport nil))
+ (setq vec nil enum nil rvalue nil newsig nil signed nil
+ typedefed nil multidim nil ptype nil modport nil
+ expect-signal 'sigs-inout io t sig-paren paren))
((equal keywd "parameter")
- (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-gparam io t modport nil))
- ((member keywd '("wire"
- "tri" "tri0" "tri1" "triand" "trior" "wand" "wor"
- "reg" "trireg"
+ (setq vec nil enum nil rvalue nil signed nil
+ typedefed nil multidim nil ptype nil modport nil
+ expect-signal 'sigs-gparam io t sig-paren paren))
+ ((member keywd '("wire" "reg" ; Fast
+ ;; net_type
+ "tri" "tri0" "tri1" "triand" "trior" "trireg"
+ "uwire" "wand" "wor"
+ ;; integer_atom_type
"byte" "shortint" "int" "longint" "integer" "time"
+ "supply0" "supply1"
+ ;; integer_vector_type - "reg" above
"bit" "logic"
+ ;; non_integer_type
"shortreal" "real" "realtime"
+ ;; data_type
"string" "event" "chandle"))
- (unless io (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-var modport nil)))
+ (cond (io
+ (setq typedefed
+ (if typedefed (concat typedefed " " keywd) keywd)))
+ (t (setq vec nil enum nil rvalue nil signed nil
+ typedefed nil multidim nil sig-paren paren
+ expect-signal 'sigs-var modport nil))))
((equal keywd "assign")
- (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-assign modport nil))
- ((member keywd '("supply0" "supply1" "supply"
- "localparam" "genvar"))
- (unless io (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-const modport nil)))
+ (setq vec nil enum nil rvalue nil signed nil
+ typedefed nil multidim nil ptype nil modport nil
+ expect-signal 'sigs-assign sig-paren paren))
+ ((member keywd '("localparam" "genvar"))
+ (unless io
+ (setq vec nil enum nil rvalue nil signed nil
+ typedefed nil multidim nil ptype nil modport nil
+ expect-signal 'sigs-const sig-paren paren)))
((member keywd '("signed" "unsigned"))
(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
((member keywd '("`ifdef" "`ifndef" "`elsif"))
(setq rvalue t))
;; Type?
- ((verilog-typedef-name-p keywd)
+ ((unless ptype
+ (verilog-typedef-name-p keywd))
(setq typedefed keywd))
;; Interface with optional modport in v2k arglist?
;; Skip over parsing modport, and take the interface name as the type
@@ -7842,18 +8110,56 @@ Return a array of [outputs inouts inputs wire reg assign const]."
(not rvalue)
(looking-at "\\s-*\\(\\.\\(\\s-*[a-zA-Z`_$][a-zA-Z0-9`_$]*\\)\\|\\)\\s-*[a-zA-Z`_$][a-zA-Z0-9`_$]*"))
(when (match-end 2) (goto-char (match-end 2)))
- (setq vec nil enum nil rvalue nil newsig nil signed nil typedefed keywd multidim nil sig-paren paren
- expect-signal 'sigs-intf io t modport (match-string 2)))
+ (setq vec nil enum nil rvalue nil signed nil
+ typedefed keywd multidim nil ptype nil modport (match-string 2)
+ newsig nil sig-paren paren
+ expect-signal 'sigs-intf io t ))
;; Ignore dotted LHS assignments: "assign foo.bar = z;"
((looking-at "\\s-*\\.")
(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))
@@ -7863,15 +8169,17 @@ Return a 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.")
@@ -7882,7 +8190,7 @@ Return a array of [outputs inouts inputs wire reg assign const]."
(eval-when-compile
;; Prevent compile warnings; these are let's, not globals
;; Do not remove the eval-when-compile
- ;; - we want a error when we are debugging this code if they are refed.
+ ;; - we want an error when we are debugging this code if they are refed.
(defvar sigs-in)
(defvar sigs-inout)
(defvar sigs-out)
@@ -7912,7 +8220,8 @@ Return a array of [outputs inouts inputs wire reg assign const]."
(verilog-sig-memory portdata)
nil
(verilog-sig-signed portdata)
- (verilog-sig-type portdata)
+ (unless (member (verilog-sig-type portdata) '("wire" "reg"))
+ (verilog-sig-type portdata))
multidim nil)
sigs-inout)))
((or (setq portdata (assoc port (verilog-decls-get-outputs submoddecls)))
@@ -7925,7 +8234,13 @@ Return a array of [outputs inouts inputs wire reg assign const]."
(verilog-sig-memory portdata)
nil
(verilog-sig-signed portdata)
- (verilog-sig-type portdata)
+ ;; Though ok in SV, in V2K code, propagating the
+ ;; "reg" in "output reg" upwards isn't legal.
+ ;; Also for backwards compatibility we don't propagate
+ ;; "input wire" upwards.
+ ;; See also `verilog-signals-edit-wire-reg'.
+ (unless (member (verilog-sig-type portdata) '("wire" "reg"))
+ (verilog-sig-type portdata))
multidim nil)
sigs-out)))
((or (setq portdata (assoc port (verilog-decls-get-inputs submoddecls)))
@@ -7938,7 +8253,8 @@ Return a array of [outputs inouts inputs wire reg assign const]."
(verilog-sig-memory portdata)
nil
(verilog-sig-signed portdata)
- (verilog-sig-type portdata)
+ (unless (member (verilog-sig-type portdata) '("wire" "reg"))
+ (verilog-sig-type portdata))
multidim nil)
sigs-in)))
((setq portdata (assoc port (verilog-decls-get-interfaces submoddecls)))
@@ -8104,9 +8420,9 @@ Inserts the list of signals found."
(defun verilog-read-sub-decls ()
"Internally parse signals going to modules under this module.
-Return a array of [ outputs inouts inputs ] signals for modules that are
+Return an array of [ outputs inouts inputs ] signals for modules that are
instantiated in this module. For example if declare A A (.B(SIG)) and SIG
-is a output, then SIG will be included in the list.
+is an output, then SIG will be included in the list.
This only works on instantiations created with /*AUTOINST*/ converted by
\\[verilog-auto-inst]. Otherwise, it would have to read in the whole
@@ -8239,7 +8555,7 @@ For example if declare A A (.B(SIG)) then B will be included in the list."
(setq verilog-cache-has-lisp (re-search-forward "\\<AUTO_LISP(" nil t))))
(defun verilog-read-auto-lisp (start end)
- "Look for and evaluate a AUTO_LISP between START and END.
+ "Look for and evaluate an AUTO_LISP between START and END.
Must call `verilog-read-auto-lisp-present' before this function."
;; This function is expensive for large buffers, so we cache if any AUTO_LISP exists
(when verilog-cache-has-lisp
@@ -8249,13 +8565,14 @@ Must call `verilog-read-auto-lisp-present' before this function."
(backward-char)
(let* ((beg-pt (prog1 (point)
(verilog-forward-sexp-cmt 1))) ;; Closing paren
- (end-pt (point)))
+ (end-pt (point))
+ (verilog-in-hooks t))
(eval-region beg-pt end-pt nil))))))
(eval-when-compile
;; Prevent compile warnings; these are let's, not globals
;; Do not remove the eval-when-compile
- ;; - we want a error when we are debugging this code if they are refed.
+ ;; - we want an error when we are debugging this code if they are refed.
(defvar sigs-in)
(defvar sigs-out-d)
(defvar sigs-out-i)
@@ -8449,17 +8766,89 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement."
instants-list))
-(defun verilog-read-auto-template (module)
- "Look for a auto_template for the instantiation of the given MODULE.
-If found returns the signal name connections. Return REGEXP and
-list of ( (signal_name connection_name)... )."
+(defun verilog-read-auto-template-middle ()
+ "With point in middle of an AUTO_TEMPLATE, parse it.
+Returns REGEXP and list of ( (signal_name connection_name)... )."
(save-excursion
;; Find beginning
(let ((tpl-regexp "\\([0-9]+\\)")
(lineno -1) ; -1 to offset for the AUTO_TEMPLATE's newline
(templateno 0)
- (pt (point))
tpl-sig-list tpl-wild-list tpl-end-pt rep)
+ ;; Parse "REGEXP"
+ ;; We reserve @"..." for future lisp expressions that evaluate
+ ;; once-per-AUTOINST
+ (when (looking-at "\\s-*\"\\([^\"]*\\)\"")
+ (setq tpl-regexp (match-string 1))
+ (goto-char (match-end 0)))
+ (search-forward "(")
+ ;; Parse lines in the template
+ (when (or verilog-auto-inst-template-numbers
+ verilog-auto-template-warn-unused)
+ (save-excursion
+ (let ((pre-pt (point)))
+ (goto-char (point-min))
+ (while (search-forward "AUTO_TEMPLATE" pre-pt t)
+ (setq templateno (1+ templateno)))
+ (while (< (point) pre-pt)
+ (forward-line 1)
+ (setq lineno (1+ lineno))))))
+ (setq tpl-end-pt (save-excursion
+ (backward-char 1)
+ (verilog-forward-sexp-cmt 1) ;; Moves to paren that closes argdecl's
+ (backward-char 1)
+ (point)))
+ ;;
+ (while (< (point) tpl-end-pt)
+ (cond ((looking-at "\\s-*\\.\\([a-zA-Z0-9`_$]+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
+ (setq tpl-sig-list
+ (cons (list
+ (match-string-no-properties 1)
+ (match-string-no-properties 2)
+ templateno lineno)
+ tpl-sig-list))
+ (goto-char (match-end 0)))
+ ;; Regexp form??
+ ((looking-at
+ ;; Regexp bug in XEmacs disallows ][ inside [], and wants + last
+ "\\s-*\\.\\(\\([a-zA-Z0-9`_$+@^.*?|---]+\\|[][]\\|\\\\[()|]\\)+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
+ (setq rep (match-string-no-properties 3))
+ (goto-char (match-end 0))
+ (setq tpl-wild-list
+ (cons (list
+ (concat "^"
+ (verilog-string-replace-matches "@" "\\\\([0-9]+\\\\)" nil nil
+ (match-string 1))
+ "$")
+ rep
+ templateno lineno)
+ tpl-wild-list)))
+ ((looking-at "[ \t\f]+")
+ (goto-char (match-end 0)))
+ ((looking-at "\n")
+ (setq lineno (1+ lineno))
+ (goto-char (match-end 0)))
+ ((looking-at "//")
+ (search-forward "\n")
+ (setq lineno (1+ lineno)))
+ ((looking-at "/\\*")
+ (forward-char 2)
+ (or (search-forward "*/")
+ (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point))))
+ (t
+ (error "%s: AUTO_TEMPLATE parsing error: %s"
+ (verilog-point-text)
+ (progn (looking-at ".*$") (match-string 0))))))
+ ;; Return
+ (vector tpl-regexp
+ (list tpl-sig-list tpl-wild-list)))))
+
+(defun verilog-read-auto-template (module)
+ "Look for an auto_template for the instantiation of the given MODULE.
+If found returns `verilog-read-auto-template-inside' structure."
+ (save-excursion
+ ;; Find beginning
+ (let ((pt (point)))
;; Note this search is expensive, as we hunt from mod-begin to point
;; for every instantiation. Likewise in verilog-read-auto-lisp.
;; So, we look first for an exact string rather than a slow regexp.
@@ -8467,6 +8856,7 @@ list of ( (signal_name connection_name)... )."
;; need to record the relative position of each AUTOINST, as multiple
;; templates exist for each module, and we're inserting lines.
(cond ((or
+ ;; See also regexp in `verilog-auto-template-lint'
(verilog-re-search-backward-substr
"AUTO_TEMPLATE"
(concat "^\\s-*/?\\*?\\s-*" module "\\s-+AUTO_TEMPLATE") nil t)
@@ -8478,76 +8868,24 @@ list of ( (signal_name connection_name)... )."
"AUTO_TEMPLATE"
(concat "^\\s-*/?\\*?\\s-*" module "\\s-+AUTO_TEMPLATE") nil t)))
(goto-char (match-end 0))
- ;; Parse "REGEXP"
- ;; We reserve @"..." for future lisp expressions that evaluate
- ;; once-per-AUTOINST
- (when (looking-at "\\s-*\"\\([^\"]*\\)\"")
- (setq tpl-regexp (match-string 1))
- (goto-char (match-end 0)))
- (search-forward "(")
- ;; Parse lines in the template
- (when verilog-auto-inst-template-numbers
- (save-excursion
- (let ((pre-pt (point)))
- (goto-char (point-min))
- (while (search-forward "AUTO_TEMPLATE" pre-pt t)
- (setq templateno (1+ templateno)))
- (while (< (point) pre-pt)
- (forward-line 1)
- (setq lineno (1+ lineno))))))
- (setq tpl-end-pt (save-excursion
- (backward-char 1)
- (verilog-forward-sexp-cmt 1) ;; Moves to paren that closes argdecl's
- (backward-char 1)
- (point)))
- ;;
- (while (< (point) tpl-end-pt)
- (cond ((looking-at "\\s-*\\.\\([a-zA-Z0-9`_$]+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
- (setq tpl-sig-list
- (cons (list
- (match-string-no-properties 1)
- (match-string-no-properties 2)
- templateno lineno)
- tpl-sig-list))
- (goto-char (match-end 0)))
- ;; Regexp form??
- ((looking-at
- ;; Regexp bug in XEmacs disallows ][ inside [], and wants + last
- "\\s-*\\.\\(\\([a-zA-Z0-9`_$+@^.*?|---]+\\|[][]\\|\\\\[()|]\\)+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
- (setq rep (match-string-no-properties 3))
- (goto-char (match-end 0))
- (setq tpl-wild-list
- (cons (list
- (concat "^"
- (verilog-string-replace-matches "@" "\\\\([0-9]+\\\\)" nil nil
- (match-string 1))
- "$")
- rep
- templateno lineno)
- tpl-wild-list)))
- ((looking-at "[ \t\f]+")
- (goto-char (match-end 0)))
- ((looking-at "\n")
- (setq lineno (1+ lineno))
- (goto-char (match-end 0)))
- ((looking-at "//")
- (search-forward "\n")
- (setq lineno (1+ lineno)))
- ((looking-at "/\\*")
- (forward-char 2)
- (or (search-forward "*/")
- (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point))))
- (t
- (error "%s: AUTO_TEMPLATE parsing error: %s"
- (verilog-point-text)
- (progn (looking-at ".*$") (match-string 0))))))
- ;; Return
- (vector tpl-regexp
- (list tpl-sig-list tpl-wild-list)))
+ (verilog-read-auto-template-middle))
;; If no template found
- (t (vector tpl-regexp nil))))))
+ (t (vector "" nil))))))
;;(progn (find-file "auto-template.v") (verilog-read-auto-template "ptl_entry"))
+(defvar verilog-auto-template-hits nil "Successful lookups with `verilog-read-auto-template-hit'.")
+(make-variable-buffer-local 'verilog-auto-template-hits)
+
+(defun verilog-read-auto-template-hit (tpl-ass)
+ "Record that TPL-ASS template from `verilog-read-auto-template' was used."
+ (when (eval-when-compile (fboundp 'make-hash-table)) ;; else feature not allowed
+ (when verilog-auto-template-warn-unused
+ (unless verilog-auto-template-hits
+ (setq verilog-auto-template-hits
+ (make-hash-table :test 'equal :rehash-size 4.0)))
+ (puthash (vector (nth 2 tpl-ass) (nth 3 tpl-ass)) t
+ verilog-auto-template-hits))))
+
(defun verilog-set-define (defname defvalue &optional buffer enumname)
"Set the definition DEFNAME to the DEFVALUE in the given BUFFER.
Optionally associate it with the specified enumeration ENUMNAME."
@@ -8601,7 +8939,7 @@ Note these are only read when the file is first visited, you must use
\\[find-alternate-file] RET to have these take effect after editing them!
If you want to disable the \"Process `eval' or hook local variables\"
-warning message, you need to add to your .emacs file:
+warning message, you need to add to your init file:
(setq enable-local-eval t)"
(let ((origbuf (current-buffer)))
@@ -8636,15 +8974,15 @@ warning message, you need to add to your .emacs file:
(let (enumname)
;; The primary way of getting defines is verilog-read-decls
;; However, that isn't called yet for included files, so we'll add another scheme
- (if (looking-at "[^\n]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
- (setq enumname (match-string-no-properties 1)))
- (forward-comment 999)
+ (if (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
+ (setq enumname (match-string-no-properties 2)))
+ (forward-comment 99999)
(while (looking-at (concat "\\s-*,?\\s-*\\(?:/[/*].*?$\\)?\\s-*\\([a-zA-Z0-9_$]+\\)"
"\\s-*=\\s-*\\([^;,]*\\),?\\s-*\\(/[/*].*?$\\)?\\s-*"))
(verilog-set-define (match-string-no-properties 1)
(match-string-no-properties 2) origbuf enumname)
(goto-char (match-end 0))
- (forward-comment 999)))))))
+ (forward-comment 99999)))))))
(defun verilog-read-includes ()
"Read `includes for the current file.
@@ -8669,7 +9007,7 @@ this process, Verilint, and readability. To prevent defining the same
variable over and over when many modules are compiled together, put a test
around the inside each include file:
-foo.v (a include):
+foo.v (an include file):
`ifdef _FOO_V // include if not already included
`else
`define _FOO_V
@@ -9032,7 +9370,7 @@ Or, just the existing dirnames themselves if there are no wildcards."
(defun verilog-library-filenames (filename &optional current check-ext)
"Return a search path to find the given FILENAME or module name.
-Uses the optional CURRENT filename or buffer-file-name, plus
+Uses the optional CURRENT filename or variable `buffer-file-name', plus
`verilog-library-directories' and `verilog-library-extensions'
variables to build the path. With optional CHECK-EXT also check
`verilog-library-extensions'."
@@ -9085,7 +9423,7 @@ variables to build the path."
;; A modi is: [module-name-string file-name begin-point]
(defvar verilog-cache-enabled t
- "If true, enable caching of signals, etc. Set to nil for debugging to make things SLOW!")
+ "Non-nil enables caching of signals, etc. Set to nil for debugging to make things SLOW!")
(defvar verilog-modi-cache-list nil
"Cache of ((Module Function) Buf-Tick Buf-Modtime Func-Returns)...
@@ -9100,7 +9438,7 @@ Use `verilog-preserve-modi-cache' to set it.")
"Modification tick after which the cache is still considered valid.
Use `verilog-preserve-modi-cache' to set it.")
(defvar verilog-modi-cache-current-enable nil
- "If true, allow caching `verilog-modi-current', set by let().")
+ "Non-nil means allow caching `verilog-modi-current', set by let().")
(defvar verilog-modi-cache-current nil
"Currently active `verilog-modi-current', if any, set by let().")
(defvar verilog-modi-cache-current-max nil
@@ -9163,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))
@@ -9176,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"
@@ -9239,13 +9577,9 @@ Cache the output of function so next call may have faster access."
(t
;; Read from file
;; Clear then restore any highlighting to make emacs19 happy
- (let ((fontlocked (when (and (boundp 'font-lock-mode)
- font-lock-mode)
- (font-lock-mode 0)
- t))
- func-returns)
- (setq func-returns (funcall function))
- (when fontlocked (font-lock-mode t))
+ (let (func-returns)
+ (verilog-save-font-mods
+ (setq func-returns (funcall function)))
;; Cache for next time
(setq verilog-modi-cache-list
(cons (list (list modi function)
@@ -9280,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)
@@ -9335,9 +9708,16 @@ if non-nil."
(setq in-list (cdr in-list)))
(nreverse out-list))))
+(defun verilog-signals-edit-wire-reg (in-list)
+ "Return all signals in IN-LIST with wire/reg data types made blank."
+ (mapcar (lambda (sig)
+ (when (member (verilog-sig-type sig) '("wire" "reg"))
+ (verilog-sig-type-set sig nil))
+ sig) in-list))
+
;; Combined
(defun verilog-decls-get-signals (decls)
- "Return all declared signals, excluding 'assign' statements."
+ "Return all declared signals in DECLS, excluding 'assign' statements."
(append
(verilog-decls-get-outputs decls)
(verilog-decls-get-inouts decls)
@@ -9352,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)
@@ -9360,11 +9747,9 @@ 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))
-(defun verilog-signals-from-signame (signame-list)
- "Return signals in standard form from SIGNAME-LIST, a simple list of signal names."
- (mapcar (function (lambda (name) (list name nil nil)))
- signame-list))
;;
;; Auto creation utilities
@@ -9420,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
@@ -9466,8 +9853,13 @@ 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 a open parenthesis or endif."
+ "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.
;; Also want "`ifdef X input foo `endif" to just leave things to the human to deal with
(save-excursion
@@ -9483,7 +9875,7 @@ Presumes that any newlines end a list element."
(defun verilog-repair-close-comma ()
"If point is at a comma followed by a close parenthesis, fix it.
-This repairs those mis-inserted by a AUTOARG."
+This repairs those mis-inserted by an AUTOARG."
;; It would be much nicer if Verilog allowed extra commas like Perl does!
(save-excursion
(verilog-forward-close-paren)
@@ -9553,6 +9945,17 @@ This repairs those mis-inserted by a 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 "\\([[({:*+-]\\)"
@@ -9589,6 +9992,7 @@ This repairs those mis-inserted by a 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
@@ -9597,6 +10001,14 @@ This repairs those mis-inserted by a 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."
@@ -9968,15 +10380,16 @@ Ignores WHITESPACE if t, and writes output to stdout if SHOW."
Differences are between buffers B1 and B2, starting at point
DIFFPT. This function is called via `verilog-diff-function'."
(let ((name1 (with-current-buffer b1 (buffer-file-name))))
- (message "%%Warning: %s:%d: Difference in AUTO expansion found"
- name1 (with-current-buffer b1 (1+ (count-lines (point-min) (point)))))
+ (verilog-warn "%s:%d: Difference in AUTO expansion found"
+ name1 (with-current-buffer b1
+ (1+ (count-lines (point-min) (point)))))
(cond (noninteractive
(verilog-diff-file-with-buffer name1 b2 t t))
(t
(ediff-buffers b1 b2)))))
(defun verilog-diff-auto ()
- "Expand AUTOs in a temporary buffer and indicate any changes.
+ "Expand AUTOs in a temporary buffer and indicate any change.
Whitespace differences are ignored to determine identicalness, but
once a difference is detected, whitespace differences may be shown.
@@ -10070,7 +10483,7 @@ If FORCE, always reread it."
;;
(defun verilog-auto-arg-ports (sigs message indent-pt)
- "Print a list of ports for a AUTOINST.
+ "Print a list of ports for an AUTOINST.
Takes SIGS list, adds MESSAGE to front and inserts each at INDENT-PT."
(when sigs
(when verilog-auto-arg-sort
@@ -10159,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)
@@ -10172,7 +10665,7 @@ Avoid declaring ports manually, as it makes code harder to maintain."
(defvar vl-mbits nil "See `verilog-auto-inst'.") ; Prevent compile warning
(defun verilog-auto-inst-port (port-st indent-pt tpl-list tpl-num for-star par-values)
- "Print out a instantiation connection for this PORT-ST.
+ "Print out an instantiation connection for this PORT-ST.
Insert to INDENT-PT, use template TPL-LIST.
@ are instantiation numbers, replaced with TPL-NUM.
@\"(expression @)\" are evaluated, with @ as a variable.
@@ -10260,6 +10753,7 @@ If PAR-VALUES replace final strings with these parameter values."
(insert "(" tpl-net ")"))
(insert ",")
(cond (tpl-ass
+ (verilog-read-auto-template-hit tpl-ass)
(indent-to (+ (if (< verilog-auto-inst-column 48) 24 16)
verilog-auto-inst-column))
;; verilog-insert requires the complete comment in one call - including the newline
@@ -10296,7 +10790,7 @@ If PAR-VALUES replace final strings with these parameter values."
(defun verilog-auto-inst-first ()
"Insert , etc before first ever port in this instant, as part of \\[verilog-auto-inst]."
;; Do we need a trailing comma?
- ;; There maybe a ifdef or something similar before us. What a mess. Thus
+ ;; There maybe an ifdef or something similar before us. What a mess. Thus
;; to avoid trouble we only insert on preceding ) or *.
;; Insert first port on new line
(insert "\n") ;; Must insert before search, so point will move forward if insert comma
@@ -10369,7 +10863,7 @@ For example, first take the submodule InstModule.v:
wire [31:0] o = {32{i}};
endmodule
-This is then used in a upper level module:
+This is then used in an upper level module:
module ExampInst (o,i);
output o;
@@ -10432,6 +10926,8 @@ Templates:
expanded `verilog-mode' simply searches up for the closest template.
Thus you can have multiple templates for the same module, just alternate
between the template for an instantiation and the instantiation itself.
+ (For backward compatibility if no template is found above, it
+ will also look below, but do not use this behavior in new designs.)
The module name must be the same as the name of the module in the
instantiation name, and the code \"AUTO_TEMPLATE\" must be in these exact
@@ -10450,6 +10946,9 @@ Templates:
debugging is completed though, it will result in lots of extra differences
and merge conflicts.
+ Setting `verilog-auto-template-warn-unused' will report errors
+ if any template lines are unused.
+
For example:
/* InstModule AUTO_TEMPLATE (
@@ -10650,7 +11149,7 @@ For more information see the \\[verilog-faq] and forums at URL
(when (and (not (member submod verilog-gate-keywords))
(setq submodi (verilog-modi-lookup submod t)))
(setq submoddecls (verilog-modi-get-decls submodi))
- ;; If there's a number in the instantiation, it may be a argument to the
+ ;; If there's a number in the instantiation, it may be an argument to the
;; automatic variable instantiation program.
(let* ((tpl-info (verilog-read-auto-template submod))
(tpl-regexp (aref tpl-info 0)))
@@ -10664,7 +11163,8 @@ For more information see the \\[verilog-faq] and forums at URL
(verilog-decls-get-vars submoddecls)
skip-pins)))
(vl-dir "interfaced"))
- (when sig-list
+ (when (and sig-list
+ verilog-auto-inst-interfaced-ports)
(when (not did-first) (verilog-auto-inst-first) (setq did-first t))
;; Note these are searched for in verilog-read-sub-decls.
(verilog-insert-indent "// Interfaced\n")
@@ -10734,7 +11234,7 @@ For example, first take the submodule InstModule.v:
parameter PAR;
endmodule
-This is then used in a upper level module:
+This is then used in an upper level module:
module ExampInst (o,i);
parameter PAR;
@@ -10792,7 +11292,7 @@ Templates:
;; Note this may raise an error
(when (setq submodi (verilog-modi-lookup submod t))
(setq submoddecls (verilog-modi-get-decls submodi))
- ;; If there's a number in the instantiation, it may be a argument to the
+ ;; If there's a number in the instantiation, it may be an argument to the
;; automatic variable instantiation program.
(let* ((tpl-info (verilog-read-auto-template submod))
(tpl-regexp (aref tpl-info 0)))
@@ -10861,15 +11361,18 @@ Typing \\[verilog-auto] will make this into:
(modsubdecls (verilog-modi-get-sub-decls modi))
(sig-list (verilog-signals-not-in
(verilog-decls-get-outputs moddecls)
- (append (verilog-decls-get-vars moddecls)
+ (append (verilog-signals-with ;; ignore typed signals
+ 'verilog-sig-type
+ (verilog-decls-get-outputs moddecls))
+ (verilog-decls-get-vars moddecls)
(verilog-decls-get-assigns moddecls)
(verilog-decls-get-consts moddecls)
(verilog-decls-get-gparams moddecls)
(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")))))
@@ -10923,12 +11426,18 @@ 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")))))
+(defun verilog-auto-logic-setup ()
+ "Prepare variables due to AUTOLOGIC."
+ (unless verilog-auto-wire-type
+ (set (make-local-variable 'verilog-auto-wire-type)
+ "logic")))
+
(defun verilog-auto-logic ()
"Expand AUTOLOGIC statements, as part of \\[verilog-auto].
Make wire statements using the SystemVerilog logic keyword.
@@ -10945,15 +11454,13 @@ with the below at the bottom of the file
In the future AUTOLOGIC may declare additional identifiers,
while AUTOWIRE will not."
(save-excursion
- (unless verilog-auto-wire-type
- (set (make-local-variable 'verilog-auto-wire-type)
- "logic"))
+ (verilog-auto-logic-setup)
(verilog-auto-wire)))
(defun verilog-auto-wire ()
"Expand AUTOWIRE statements, as part of \\[verilog-auto].
Make wire statements for instantiations outputs that aren't
-already declared. `verilog-auto-wire-type' may be used to change
+already declared. `verilog-auto-wire-type' may be used to change
the datatype of the declarations.
Limitations:
@@ -11007,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")
@@ -11018,10 +11525,10 @@ 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 a input to another AUTOINST. This is useful for modules which
+isn't an input to another AUTOINST. This is useful for modules which
only instantiate other modules.
Limitations:
@@ -11031,7 +11538,7 @@ Limitations:
Verilog 2001 style, else uses Verilog 1995 style.
If any concatenation, or bit-subscripts are missing in the AUTOINSTant's
- instantiation, all bets are off. (For example due to a AUTO_TEMPLATE).
+ instantiation, all bets are off. (For example due to an AUTO_TEMPLATE).
Typedefs must match `verilog-typedef-regexp', which is disabled by default.
@@ -11070,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))
@@ -11087,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")
@@ -11098,7 +11605,7 @@ same expansion will result from only extracting outputs starting with ov:
(defun verilog-auto-output-every ()
"Expand AUTOOUTPUTEVERY statements, as part of \\[verilog-auto].
Make output statements for any signals that aren't primary inputs or
-outputs already. This makes every signal in the design a output. This is
+outputs already. This makes every signal in the design an output. This is
useful to get Synopsys to preserve every signal in the design, since it
won't optimize away the outputs.
@@ -11137,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")
@@ -11145,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
@@ -11158,7 +11665,7 @@ Limitations:
Verilog 2001 style, else uses Verilog 1995 style.
If any concatenation, or bit-subscripts are missing in the AUTOINSTant's
- instantiation, all bets are off. (For example due to a AUTO_TEMPLATE).
+ instantiation, all bets are off. (For example due to an AUTO_TEMPLATE).
Typedefs must match `verilog-typedef-regexp', which is disabled by default.
@@ -11196,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))
@@ -11217,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")
@@ -11225,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.
@@ -11237,7 +11744,7 @@ Limitations:
Verilog 2001 style, else uses Verilog 1995 style.
If any concatenation, or bit-subscripts are missing in the AUTOINSTant's
- instantiation, all bets are off. (For example due to a AUTO_TEMPLATE).
+ instantiation, all bets are off. (For example due to an AUTO_TEMPLATE).
Typedefs must match `verilog-typedef-regexp', which is disabled by default.
@@ -11276,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))
@@ -11294,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")
@@ -11320,9 +11827,14 @@ Limitations:
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 a AUTOINST
+ 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*/);
@@ -11402,22 +11914,25 @@ against the previous example's module:
(verilog-decls-get-interfaces submoddecls)
(append (verilog-decls-get-interfaces moddecls)))))
(forward-line 1)
- (setq sig-list-i (verilog-signals-matching-dir-re
- (verilog-signals-matching-regexp sig-list-i regexp)
- "input" direction-re)
- sig-list-o (verilog-signals-matching-dir-re
- (verilog-signals-matching-regexp sig-list-o regexp)
- "output" direction-re)
- sig-list-io (verilog-signals-matching-dir-re
- (verilog-signals-matching-regexp sig-list-io regexp)
- "inout" direction-re)
+ (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))
sig-list-if (verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-if regexp)
"interface" 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 specific module)\n")
- ;; Don't sort them so a upper AUTOINST will match the main module
+ ;; 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)
@@ -11444,7 +11959,7 @@ Limitations:
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 a AUTOINST
+ though they will appear to be in the same order to an AUTOINST
instantiating either module.
An example:
@@ -11495,7 +12010,7 @@ Limitations:
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 a AUTOINST
+ though they will appear to be in the same order to an AUTOINST
instantiating either module.
An example:
@@ -11528,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
@@ -11545,7 +12279,7 @@ An example:
// For this example we declare the function in the
// module's file itself. Often you'd define it instead
- // in a site-start.el or .emacs file.
+ // in a site-start.el or init file.
/*
Local Variables:
eval:
@@ -11578,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")
@@ -11618,7 +12352,7 @@ Limitations:
Constant signals:
AUTOSENSE cannot always determine if a `define is a constant or a signal
- (it could be in a include file for example). If a `define or other signal
+ (it could be in an include file for example). If a `define or other signal
is put into the AUTOSENSE list and is not desired, use the AUTO_CONSTANT
declaration anywhere in the module (parenthesis are required):
@@ -11720,12 +12454,12 @@ begin/case/if statement and the AUTORESET comment are being reset manually
and should not be automatically reset. This includes omitting any signals
used on the right hand side of assignments.
-By default, AUTORESET will include the width of the signal in the autos,
-this is a recent change. To control this behavior, see
-`verilog-auto-reset-widths'.
+By default, AUTORESET will include the width of the signal in the
+autos, SystemVerilog designs may want to change this. To control
+this behavior, see `verilog-auto-reset-widths'.
AUTORESET ties signals to deasserted, which is presumed to be zero.
-Signals that match `verilog-active-low-regexp' will be deasserted by tieing
+Signals that match `verilog-active-low-regexp' will be deasserted by tying
them to a one.
An example:
@@ -11800,7 +12534,7 @@ Typing \\[verilog-auto] will make this into:
(if (assoc (verilog-sig-name sig) dly-list)
(concat " <= " verilog-assignment-delay)
" = ")
- (verilog-sig-tieoff sig (not verilog-auto-reset-widths))
+ (verilog-sig-tieoff sig)
";\n")
(setq sig-list (cdr sig-list))))
(verilog-insert-indent "// End of automatics")))))
@@ -11816,7 +12550,7 @@ finds all outputs in the module, and if that input is not otherwise declared
as a register or wire, creates a tieoff.
AUTORESET ties signals to deasserted, which is presumed to be zero.
-Signals that match `verilog-active-low-regexp' will be deasserted by tieing
+Signals that match `verilog-active-low-regexp' will be deasserted by tying
them to a one.
You can add signals you do not want included in AUTOTIEOFF with
@@ -11825,9 +12559,13 @@ You can add signals you do not want included in AUTOTIEOFF with
`verilog-auto-wire-type' may be used to change the datatype of
the declarations.
+`verilog-auto-reset-widths' may be used to change how the tieoff
+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
@@ -11840,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;
@@ -11870,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
@@ -11887,6 +12626,73 @@ Typing \\[verilog-auto] will make this into:
(setq sig-list (cdr sig-list))))
(verilog-insert-indent "// End of automatics\n")))))
+(defun verilog-auto-undef ()
+ "Expand AUTOUNDEF statements, as part of \\[verilog-auto].
+Take any `defines since the last AUTOUNDEF in the current file
+and create `undefs for them. This is used to insure that
+file-local defines do not pollute the global `define name space.
+
+Limitations:
+ AUTOUNDEF presumes any identifier following `define is the
+ name of a define. Any `ifdefs are ignored.
+
+ AUTOUNDEF suppresses creating an `undef for any define that was
+ `undefed before the AUTOUNDEF. This may be used to work around
+ the ignoring of `ifdefs as shown below.
+
+An example:
+
+ `define XX_FOO
+ `define M_BAR(x)
+ `define M_BAZ
+ ...
+ `ifdef NEVER
+ `undef M_BAZ // Emacs will see this and not `undef M_BAZ
+ `endif
+ ...
+ /*AUTOUNDEF*/
+
+Typing \\[verilog-auto] will make this into:
+
+ ...
+ /*AUTOUNDEF*/
+ // Beginning of automatic undefs
+ `undef XX_FOO
+ `undef M_BAR
+ // End of automatics
+
+You may also provide an optional regular expression, in which case only
+defines the regular expression will be undefed."
+ (save-excursion
+ (let* ((params (verilog-read-auto-params 0 1))
+ (regexp (nth 0 params))
+ (indent-pt (current-indentation))
+ (end-pt (point))
+ defs def)
+ (save-excursion
+ ;; Scan from start of file, or last AUTOUNDEF
+ (or (verilog-re-search-backward-quick "/\\*AUTOUNDEF\\>" end-pt t)
+ (goto-char (point-min)))
+ (while (verilog-re-search-forward-quick
+ "`\\(define\\|undef\\)\\s-*\\([a-zA-Z_][a-zA-Z_0-9]*\\)" end-pt t)
+ (cond ((equal (match-string-no-properties 1) "define")
+ (setq def (match-string-no-properties 2))
+ (when (and (or (not regexp)
+ (string-match regexp def))
+ (not (member def defs))) ;; delete-dups not in 21.1
+ (setq defs (cons def defs))))
+ (t
+ (setq defs (delete (match-string-no-properties 2) defs))))))
+ ;; Insert
+ (setq defs (sort defs 'string<))
+ (when defs
+ (verilog-forward-or-insert-line)
+ (verilog-insert-indent "// Beginning of automatic undefs\n")
+ (while defs
+ (verilog-insert-indent "`undef " (car defs) "\n")
+ (setq defs (cdr defs)))
+ (verilog-insert-indent "// End of automatics\n")))))
+
(defun verilog-auto-unused ()
"Expand AUTOUNUSED statements, as part of \\[verilog-auto].
Replace the /*AUTOUNUSED*/ comment with a comma separated list of all unused
@@ -11917,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
@@ -11955,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
@@ -11975,17 +12782,17 @@ Remove user provided prefix ELIM-REGEXP."
(defun verilog-auto-ascii-enum ()
"Expand AUTOASCIIENUM statements, as part of \\[verilog-auto].
-Create a register to contain the ASCII decode of a enumerated signal type.
+Create a register to contain the ASCII decode of an enumerated signal type.
This will allow trace viewers to show the ASCII name of states.
-First, parameters are built into a enumeration using the synopsys enum
+First, parameters are built into an enumeration using the synopsys enum
comment. The comment must be between the keyword and the symbol.
\(Annoying, but that's what Synopsys's dc_shell FSM reader requires.)
Next, registers which that enum applies to are also tagged with the same
enum.
-Finally, a AUTOASCIIENUM command is used.
+Finally, an AUTOASCIIENUM command is used.
The first parameter is the name of the signal to be decoded.
@@ -11995,17 +12802,19 @@ Finally, a AUTOASCIIENUM command is used.
tell viewers like Dinotrace to display in ASCII format.
The third optional parameter is a string which will be removed
- from the state names. It defaults to "" which removes nothing.
+ from the state names. It defaults to \"\" which removes nothing.
The fourth optional parameter is \"onehot\" to force one-hot
- decoding. If unspecified, if and only if the first parameter
+ decoding. If unspecified, if and only if the first parameter
width is 2^(number of states in enum) and does NOT match the
- width of the enum, the signal is assumed to be a one hot
+ width of the enum, the signal is assumed to be a one-hot
decode. Otherwise, it's a normal encoded state vector.
`verilog-auto-wire-type' may be used to change the datatype of
the declarations.
+ \"auto enum\" may be used in place of \"synopsys enum\".
+
An example:
//== State enumeration
@@ -12052,15 +12861,12 @@ 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)))
(undecode-enum (or (verilog-sig-enum undecode-sig)
- (error "%s: Signal %s does not have a enum tag" (verilog-point-text) undecode-name)))
+ (error "%s: Signal %s does not have an enum tag" (verilog-point-text) undecode-name)))
;;
(enum-sigs (verilog-signals-not-in
(or (verilog-signals-matching-enum sig-list-consts undecode-enum)
@@ -12088,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))))
@@ -12153,12 +12959,39 @@ being different from the final output's line numbering."
(string-to-number (match-string 2)))))
t t))))
+(defun verilog-auto-template-lint ()
+ "Check AUTO_TEMPLATEs for unused lines.
+Enable with `verilog-auto-template-warn-unused'."
+ (let ((name1 (or (buffer-file-name) (buffer-name))))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\s-*/?\\*?\\s-*[a-zA-Z0-9`_$]+\\s-+AUTO_TEMPLATE" nil t)
+ (let* ((tpl-info (verilog-read-auto-template-middle))
+ (tpl-list (aref tpl-info 1))
+ (tlines (append (nth 0 tpl-list) (nth 1 tpl-list)))
+ tpl-ass)
+ (while tlines
+ (setq tpl-ass (car tlines)
+ tlines (cdr tlines))
+ ;;;
+ (unless (or (not (eval-when-compile (fboundp 'make-hash-table))) ;; Not supported, no warning
+ (not verilog-auto-template-hits)
+ (gethash (vector (nth 2 tpl-ass) (nth 3 tpl-ass))
+ verilog-auto-template-hits))
+ (verilog-warn-error "%s:%d: AUTO_TEMPLATE line unused: \".%s (%s)\""
+ name1
+ (+ (elt tpl-ass 3) ;; Template line number
+ (count-lines (point-min) (point)))
+ (elt tpl-ass 0) (elt tpl-ass 1))
+ )))))))
+
;;
;; Auto top level
;;
-(defun verilog-auto (&optional inject) ; Use verilog-inject-auto instead of passing a arg
+(defun verilog-auto (&optional inject) ; Use verilog-inject-auto instead of passing an arg
"Expand AUTO statements.
Look for any /*AUTO...*/ commands in the code, as used in
instantiations or argument headers. Update the list of signals
@@ -12196,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
@@ -12213,6 +13049,7 @@ Using \\[describe-function], see also:
`verilog-auto-reset' for AUTORESET flop resets
`verilog-auto-sense' for AUTOSENSE always sensitivity lists
`verilog-auto-tieoff' for AUTOTIEOFF output tieoffs
+ `verilog-auto-undef' for AUTOUNDEF `undef of local `defines
`verilog-auto-unused' for AUTOUNUSED unused inputs/inouts
`verilog-auto-wire' for AUTOWIRE instantiation wires
@@ -12226,21 +13063,15 @@ Wilson Snyder (wsnyder@wsnyder.org)."
(unless noninteractive (message "Updating AUTOs..."))
(if (fboundp 'dinotrace-unannotate-all)
(dinotrace-unannotate-all))
- (let ((oldbuf (if (not (buffer-modified-p))
- (buffer-string)))
- ;; Before version 20, match-string with font-lock returns a
- ;; vector that is not equal to the string. IE if on "input"
- ;; nil==(equal "input" (progn (looking-at "input") (match-string 0)))
- (fontlocked (when (and (boundp 'font-lock-mode)
- font-lock-mode)
- (font-lock-mode 0)
- t))
- ;; Cache directories; we don't write new files, so can't change
- (verilog-dir-cache-preserving t)
- ;; Cache current module
- (verilog-modi-cache-current-enable t)
- (verilog-modi-cache-current-max (point-min)) ; IE it's invalid
- verilog-modi-cache-current)
+ (verilog-save-font-mods
+ (let ((oldbuf (if (not (buffer-modified-p))
+ (buffer-string)))
+ ;; Cache directories; we don't write new files, so can't change
+ (verilog-dir-cache-preserving t)
+ ;; Cache current module
+ (verilog-modi-cache-current-enable t)
+ (verilog-modi-cache-current-max (point-min)) ; IE it's invalid
+ verilog-modi-cache-current)
(unwind-protect
;; Disable change hooks for speed
;; This let can't be part of above let; must restore
@@ -12251,6 +13082,8 @@ Wilson Snyder (wsnyder@wsnyder.org)."
;; Wipe cache; otherwise if we AUTOed a block above this one,
;; we'll misremember we have generated IOs, confusing AUTOOUTPUT
(setq verilog-modi-cache-list nil)
+ ;; Local state
+ (setq verilog-auto-template-hits nil)
;; If we're not in verilog-mode, change syntax table so parsing works right
(unless (eq major-mode `verilog-mode) (verilog-mode))
;; Allow user to customize
@@ -12266,6 +13099,8 @@ Wilson Snyder (wsnyder@wsnyder.org)."
(when verilog-auto-read-includes
(verilog-read-includes)
(verilog-read-defines nil nil t))
+ ;; Setup variables due to SystemVerilog expansion
+ (verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic-setup)
;; This particular ordering is important
;; INST: Lower modules correct, no internal dependencies, FIRST
(verilog-preserve-modi-cache
@@ -12278,7 +13113,7 @@ Wilson Snyder (wsnyder@wsnyder.org)."
(verilog-inject-arg))
;;
;; Do user inserts first, so their code can insert AUTOs
- ;; We may provide a AUTOINSERTLISPLAST if another cleanup pass is needed
+ ;; We may provide an AUTOINSERTLISPLAST if another cleanup pass is needed
(verilog-auto-re-search-do "/\\*AUTOINSERTLISP(.*?)\\*/"
'verilog-auto-insert-lisp)
;; Expand instances before need the signals the instances input/output
@@ -12289,25 +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)
;; 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)
@@ -12320,7 +13154,9 @@ Wilson Snyder (wsnyder@wsnyder.org)."
(verilog-auto-re-search-do "/\\*AUTOARG\\*/" 'verilog-auto-arg)
;; Fix line numbers (comments only)
(when verilog-auto-inst-template-numbers
- (verilog-auto-templated-rel))))
+ (verilog-auto-templated-rel))
+ (when verilog-auto-template-warn-unused
+ (verilog-auto-template-lint))))
;;
(verilog-run-hooks 'verilog-auto-hook)
;;
@@ -12337,9 +13173,8 @@ Wilson Snyder (wsnyder@wsnyder.org)."
;; End of after-change protection
)))
;; Unwind forms
- (progn
- ;; Restore font-lock
- (when fontlocked (font-lock-mode t))))))
+ ;; Currently handled in verilog-save-font-mods
+ ))))
;;
@@ -12384,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
@@ -12644,7 +13479,7 @@ and the case items."
(define-skeleton verilog-sk-def-reg
"Insert a reg definition."
()
- > "reg [" '(verilog-sk-prompt-width) | -1 verilog-sk-signal ";" \n (verilog-pretty-declarations) )
+ > "reg [" '(verilog-sk-prompt-width) | -1 verilog-sk-signal ";" \n (verilog-pretty-declarations-auto) )
(defun verilog-sk-define-signal ()
"Insert a definition of signal under point at top of module."
@@ -12908,9 +13743,12 @@ Files are checked based on `verilog-library-flags'."
(concat "verilog-mode v" verilog-mode-version)
'(
verilog-active-low-regexp
+ verilog-after-save-font-hook
verilog-align-ifelse
verilog-assignment-delay
verilog-auto-arg-sort
+ verilog-auto-declare-nettype
+ verilog-auto-delete-trailing-whitespace
verilog-auto-endcomments
verilog-auto-hook
verilog-auto-ignore-concat
@@ -12919,23 +13757,32 @@ Files are checked based on `verilog-library-flags'."
verilog-auto-input-ignore-regexp
verilog-auto-inst-column
verilog-auto-inst-dot-name
+ verilog-auto-inst-interfaced-ports
verilog-auto-inst-param-value
+ verilog-auto-inst-sort
verilog-auto-inst-template-numbers
verilog-auto-inst-vector
verilog-auto-lineup
verilog-auto-newline
verilog-auto-output-ignore-regexp
verilog-auto-read-includes
+ verilog-auto-reset-blocking-in-non
verilog-auto-reset-widths
verilog-auto-save-policy
verilog-auto-sense-defines-constant
verilog-auto-sense-include-inputs
verilog-auto-star-expand
verilog-auto-star-save
+ verilog-auto-template-warn-unused
+ verilog-auto-tieoff-declaration
+ verilog-auto-tieoff-ignore-regexp
verilog-auto-unused-ignore-regexp
+ verilog-auto-wire-type
verilog-before-auto-hook
verilog-before-delete-auto-hook
verilog-before-getopt-flags-hook
+ verilog-before-save-font-hook
+ verilog-cache-enabled
verilog-case-indent
verilog-cexp-indent
verilog-compiler
@@ -12943,6 +13790,8 @@ Files are checked based on `verilog-library-flags'."
verilog-delete-auto-hook
verilog-getopt-flags-hook
verilog-highlight-grouping-keywords
+ verilog-highlight-includes
+ verilog-highlight-modules
verilog-highlight-p1800-keywords
verilog-highlight-translate-off
verilog-indent-begin-after-if
@@ -12960,11 +13809,15 @@ Files are checked based on `verilog-library-flags'."
verilog-linter
verilog-minimum-comment-distance
verilog-mode-hook
+ verilog-mode-release-date
+ verilog-mode-release-emacs
+ verilog-mode-version
verilog-preprocessor
verilog-simulator
verilog-tab-always-indent
verilog-tab-to-comment
verilog-typedef-regexp
+ verilog-warn-fatal
)
nil nil
(concat "Hi Mac,
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index deac85581d2..6ad7d3b168a 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -1,6 +1,6 @@
;;; vhdl-mode.el --- major mode for editing VHDL code
-;; Copyright (C) 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
;; Authors: Reto Zimmermann <reto@gnu.org>
;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net>
@@ -13,10 +13,10 @@
;; filed in the Emacs bug reporting system against this file, a copy
;; of the bug report be sent to the maintainer's email address.
-(defconst vhdl-version "3.33.6"
+(defconst vhdl-version "3.33.28"
"VHDL Mode version number.")
-(defconst vhdl-time-stamp "2005-08-30"
+(defconst vhdl-time-stamp "2010-09-22"
"VHDL Mode time stamp for last update.")
;; This file is part of GNU Emacs.
@@ -72,13 +72,13 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Emacs Versions
-;; supported: GNU Emacs 20.X/21.X/22.X, XEmacs 20.X/21.X
-;; tested on: GNU Emacs 20.4, XEmacs 21.1 (marginally)
+;; supported: GNU Emacs 20.X/21.X/22.X,23.X, XEmacs 20.X/21.X
+;; tested on: GNU Emacs 20.4/21.3/22.1,23.X, XEmacs 21.1 (marginally)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Installation
-;; Prerequisites: GNU Emacs 20.X/21.X/22.X, XEmacs 20.X/21.X.
+;; Prerequisites: GNU Emacs 20.X/21.X/22.X/23.X, XEmacs 20.X/21.X.
;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
;; or into an arbitrary directory that is added to the load path by the
@@ -93,7 +93,7 @@
;; Add the following lines to the `site-start.el' file in the `site-lisp'
;; directory of your Emacs installation or to your Emacs start-up file `.emacs'
-;; (not required in Emacs 20.X):
+;; (not required in Emacs 20 and higher):
;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t)
;; (setq auto-mode-alist (cons '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist))
@@ -102,7 +102,7 @@
;; VHDL Mode distribution.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Acknowledgements
+;; Acknowledgments
;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu>
;; and Steve Grout.
@@ -184,7 +184,7 @@ Examples:
\".*\" \"\" inserts empty string")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; User variables
+;; User variables (customization options)
(defgroup vhdl nil
"Customizations for VHDL Mode."
@@ -198,7 +198,7 @@ Examples:
:group 'vhdl)
(defcustom vhdl-indent-tabs-mode nil
- "*Non-nil means indentation can insert tabs.
+ "Non-nil means indentation can insert tabs.
Overrides local variable `indent-tabs-mode'."
:type 'boolean
:group 'vhdl-mode)
@@ -210,6 +210,17 @@ Overrides local variable `indent-tabs-mode'."
(defcustom vhdl-compiler-alist
'(
+ ("ADVance MS" "vacom" "-work \\1" "make" "-f \\1"
+ nil "valib \\1; vamap \\2 \\1" "./" "work/" "Makefile" "adms"
+ ("\\s-\\([0-9]+\\):" 0 1 0) ("Compiling file \\(.+\\)" 1)
+ ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
+ "PACK/\\1.vif" "BODY/\\1.vif" upcase))
+ ;; Aldec
+ ;; COMP96 ERROR COMP96_0078: "Unknown identifier "Addr_Bits"." "<filename>" 40 30
+ ("Aldec" "vcom" "-93 -work \\1" "make" "-f \\1"
+ nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec"
+ (".+?[ \t]+\\(?:ERROR\\)[^:]+:.+?\\(?:.+\"\\(.+?\\)\"[ \t]+\\([0-9]+\\)\\)" 1 2 0) ("" 0)
+ nil)
;; Cadence Leapfrog: cv -file test.vhd
;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared
("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1"
@@ -225,6 +236,12 @@ Overrides local variable `indent-tabs-mode'."
("ncvhdl_p: \\*E,\\w+ (\\(.+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db"
"\\1/package/pc.db" "\\1/body/pc.db" downcase))
+ ;; ghdl vhdl: ghdl test.vhd
+ ("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1"
+ nil "mkdir \\1" "./" "work/" "Makefile" "ghdl"
+ ("ghdl_p: \\*E,\\w+ (\\(.+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
+ ("\\1/entity" "\\2/\\1" "\\1/configuration"
+ "\\1/package" "\\1/body" downcase))
;; Ikos Voyager: analyze test.vhd
;; analyze test.vhd
;; E L4/C5: this library unit is inaccessible
@@ -236,10 +253,11 @@ Overrides local variable `indent-tabs-mode'."
;; ModelSim, Model Technology: vcom test.vhd
;; ERROR: test.vhd(14): Unknown identifier: positiv
;; WARNING[2]: test.vhd(85): Possible infinite loop
+ ;; ** Warning: [4] ../src/emacsvsim.vhd(43): An abstract ...
;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb
("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1"
nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim"
- ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0)
+ ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\(.+\\)(\\([0-9]+\\)):" 3 4 0) ("" 0)
("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
"\\1/_primary.dat" "\\1/body.dat" downcase))
;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd
@@ -321,8 +339,14 @@ Overrides local variable `indent-tabs-mode'."
("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0)
("^ *Compiling \"\\(.+\\)\" " 1)
nil)
+ ;; Xilinx XST:
+ ;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error
+ ("Xilinx XST" "xflow" "" "make" "-f \\1"
+ nil "mkdir \\1" "./" "work/" "Makefile" "xilinx"
+ ("^ERROR:HDLParsers:[0-9]+ - \"\\(.+\\)\" Line \\([0-9]+\\)\." 1 2 0) ("" 0)
+ nil)
)
- "*List of available VHDL compilers and their properties.
+ "List of available VHDL compilers and their properties.
Each list entry specifies the following items for a compiler:
Compiler:
Compiler name : name used in option `vhdl-compiler' to choose compiler
@@ -428,8 +452,8 @@ NOTE: Activate new error and file message regexps and reflect the new setting
(vhdl-custom-set variable value 'vhdl-update-mode-menu))
:group 'vhdl-compile)
-(defcustom vhdl-compiler "ModelSim"
- "*Specifies the VHDL compiler to be used for syntax analysis.
+(defcustom vhdl-compiler "GHDL"
+ "Specifies the VHDL compiler to be used for syntax analysis.
Select a compiler name from the ones defined in option `vhdl-compiler-alist'."
:type (let ((alist vhdl-compiler-alist) list)
(while alist
@@ -439,7 +463,7 @@ Select a compiler name from the ones defined in option `vhdl-compiler-alist'."
:group 'vhdl-compile)
(defcustom vhdl-compile-use-local-error-regexp t
- "*Non-nil means use buffer-local `compilation-error-regexp-alist'.
+ "Non-nil means use buffer-local `compilation-error-regexp-alist'.
In this case, only error message regexps for VHDL compilers are active if
compilation is started from a VHDL buffer. Otherwise, the error message
regexps are appended to the predefined global regexps, and all regexps are
@@ -450,8 +474,20 @@ NOTE: Activate the new setting by restarting Emacs."
:type 'boolean
:group 'vhdl-compile)
+(defcustom vhdl-makefile-default-targets '("all" "clean" "library")
+ "List of default target names in Makefiles.
+Automatically generated Makefiles include three default targets to compile
+the entire design, clean the entire design and to create the design library.
+This option allows to change the names of these targets to avoid conflicts
+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
- "*Functions to run at the end of Makefile generation.
+ "Functions to run at the end of Makefile generation.
Allows to insert user specific parts into a Makefile.
Example:
@@ -462,7 +498,7 @@ Example:
:group 'vhdl-compile)
(defcustom vhdl-default-library "work"
- "*Name of default library.
+ "Name of default library.
Is overwritten by project settings if a project is active."
:type 'string
:group 'vhdl-compile)
@@ -488,7 +524,7 @@ Is overwritten by project settings if a project is active."
-- This is a multi-line project description
-- that can be used as a project dependent part of the file header.
"))
- "*List of projects and their properties.
+ "List of projects and their properties.
Name : name used in option `vhdl-project' to choose project
Title : title of project (single-line string)
Default directory: default project directory (absolute path)
@@ -594,7 +630,7 @@ NOTE: Reflect the new setting in the choice list of option `vhdl-project'
:group 'vhdl-project)
(defcustom vhdl-project nil
- "*Specifies the default for the current project.
+ "Specifies the default for the current project.
Select a project name from the ones defined in option `vhdl-project-alist'.
Is used to determine the project title and description to be inserted in file
headers and the source files/directories to be scanned in the hierarchy
@@ -608,7 +644,7 @@ browser. The current project can also be changed temporarily in the menu."
:group 'vhdl-project)
(defcustom vhdl-project-file-name '("\\1.prj")
- "*List of file names/paths for importing/exporting project setups.
+ "List of file names/paths for importing/exporting project setups.
\"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is
replaced by the user name (allows to have user-specific project setups).
The first entry is used as file name to import/export individual project
@@ -624,7 +660,7 @@ in global directories)."
:group 'vhdl-project)
(defcustom vhdl-project-auto-load '(startup)
- "*Automatically load project setups from files.
+ "Automatically load project setups from files.
All project setup files that match the file names specified in option
`vhdl-project-file-name' are automatically loaded. The project of the
\(alphabetically) last loaded setup of the first `vhdl-project-file-name'
@@ -635,7 +671,7 @@ A project setup file can be obtained by exporting a project (see menu).
:group 'vhdl-project)
(defcustom vhdl-project-sort t
- "*Non-nil means projects are displayed in alphabetical order."
+ "Non-nil means projects are displayed in alphabetical order."
:type 'boolean
:group 'vhdl-project)
@@ -647,11 +683,11 @@ A project setup file can be obtained by exporting a project (see menu).
:group 'vhdl-port
:group 'vhdl-compose)
-(defcustom vhdl-standard '(87 nil)
- "*VHDL standards used.
+(defcustom vhdl-standard '(93 nil)
+ "VHDL standards used.
Basic standard:
VHDL'87 : IEEE Std 1076-1987
- VHDL'93 : IEEE Std 1076-1993
+ VHDL'93/02 : IEEE Std 1076-1993/2002
Additional standards:
VHDL-AMS : IEEE Std 1076.1 (analog-mixed-signal)
Math packages: IEEE Std 1076.2 (`math_real', `math_complex')
@@ -660,7 +696,7 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
\"Activate Options\"."
:type '(list (choice :tag "Basic standard"
(const :tag "VHDL'87" 87)
- (const :tag "VHDL'93" 93))
+ (const :tag "VHDL'93/02" 93))
(set :tag "Additional standards" :indent 2
(const :tag "VHDL-AMS" ams)
(const :tag "Math packages" math)))
@@ -675,13 +711,13 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
:group 'vhdl-style)
(defcustom vhdl-basic-offset 2
- "*Amount of basic offset used for indentation.
+ "Amount of basic offset used for indentation.
This value is used by + and - symbols in `vhdl-offsets-alist'."
:type 'integer
:group 'vhdl-style)
(defcustom vhdl-upper-case-keywords nil
- "*Non-nil means convert keywords to upper case.
+ "Non-nil means convert keywords to upper case.
This is done when typed or expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
@@ -689,7 +725,7 @@ This is done when typed or expanded or by the fix case functions."
:group 'vhdl-style)
(defcustom vhdl-upper-case-types nil
- "*Non-nil means convert standardized types to upper case.
+ "Non-nil means convert standardized types to upper case.
This is done when expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
@@ -697,7 +733,7 @@ This is done when expanded or by the fix case functions."
:group 'vhdl-style)
(defcustom vhdl-upper-case-attributes nil
- "*Non-nil means convert standardized attributes to upper case.
+ "Non-nil means convert standardized attributes to upper case.
This is done when expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
@@ -705,7 +741,7 @@ This is done when expanded or by the fix case functions."
:group 'vhdl-style)
(defcustom vhdl-upper-case-enum-values nil
- "*Non-nil means convert standardized enumeration values to upper case.
+ "Non-nil means convert standardized enumeration values to upper case.
This is done when expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
@@ -713,7 +749,7 @@ This is done when expanded or by the fix case functions."
:group 'vhdl-style)
(defcustom vhdl-upper-case-constants t
- "*Non-nil means convert standardized constants to upper case.
+ "Non-nil means convert standardized constants to upper case.
This is done when expanded."
:type 'boolean
:set (lambda (variable value)
@@ -721,7 +757,7 @@ This is done when expanded."
:group 'vhdl-style)
(defcustom vhdl-use-direct-instantiation 'standard
- "*Non-nil means use VHDL'93 direct component instantiation.
+ "Non-nil means use VHDL'93 direct component instantiation.
Never : never
Standard: only in VHDL standards that allow it (VHDL'93 and higher)
Always : always"
@@ -730,6 +766,15 @@ This is done when expanded."
(const :tag "Always" always))
:group 'vhdl-style)
+(defcustom vhdl-array-index-record-field-in-sensitivity-list t
+ "Non-nil means include array indices / record fields in sensitivity list.
+If a signal read in a process is a record field or pointed to by an array
+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
"Customizations for naming conventions."
@@ -737,7 +782,7 @@ This is done when expanded."
(defcustom vhdl-entity-file-name '(".*" . "\\&")
(concat
- "*Specifies how the entity file name is obtained.
+ "Specifies how the entity file name is obtained.
The entity file name can be obtained by modifying the entity name (e.g.
attaching or stripping off a substring). The file extension is automatically
taken from the file name of the current buffer."
@@ -749,7 +794,7 @@ taken from the file name of the current buffer."
(defcustom vhdl-architecture-file-name '("\\(.*\\) \\(.*\\)" . "\\1_\\2")
(concat
- "*Specifies how the architecture file name is obtained.
+ "Specifies how the architecture file name is obtained.
The architecture file name can be obtained by modifying the entity
and/or architecture name (e.g. attaching or stripping off a substring). The
file extension is automatically taken from the file name of the current
@@ -764,7 +809,7 @@ access to both names (see default setting as example)."
(defcustom vhdl-configuration-file-name '(".*" . "\\&")
(concat
- "*Specifies how the configuration file name is obtained.
+ "Specifies how the configuration file name is obtained.
The configuration file name can be obtained by modifying the configuration
name (e.g. attaching or stripping off a substring). The file extension is
automatically taken from the file name of the current buffer."
@@ -776,7 +821,7 @@ automatically taken from the file name of the current buffer."
(defcustom vhdl-package-file-name '(".*" . "\\&")
(concat
- "*Specifies how the package file name is obtained.
+ "Specifies how the package file name is obtained.
The package file name can be obtained by modifying the package name (e.g.
attaching or stripping off a substring). The file extension is automatically
taken from the file name of the current buffer. Package files can be created
@@ -789,7 +834,7 @@ file name."
:group 'vhdl-compose)
(defcustom vhdl-file-name-case 'identity
- "*Specifies how to change case for obtaining file names.
+ "Specifies how to change case for obtaining file names.
When deriving a file name from a VHDL unit name, case can be changed as
follows:
As Is: case is not changed (taken as is)
@@ -809,7 +854,7 @@ follows:
:group 'vhdl)
(defcustom vhdl-electric-keywords '(vhdl user)
- "*Type of keywords for which electrification is enabled.
+ "Type of keywords for which electrification is enabled.
VHDL keywords: invoke built-in templates
User keywords: invoke user models (see option `vhdl-model-alist')"
:type '(set (const :tag "VHDL keywords" vhdl)
@@ -819,7 +864,7 @@ follows:
:group 'vhdl-template)
(defcustom vhdl-optional-labels 'process
- "*Constructs for which labels are to be queried.
+ "Constructs for which labels are to be queried.
Template generators prompt for optional labels for:
None : no constructs
Processes only: processes only (also procedurals in VHDL-AMS)
@@ -830,7 +875,7 @@ Template generators prompt for optional labels for:
:group 'vhdl-template)
(defcustom vhdl-insert-empty-lines 'unit
- "*Specifies whether to insert empty lines in some templates.
+ "Specifies whether to insert empty lines in some templates.
This improves readability of code. Empty lines are inserted in:
None : no constructs
Design units only: entities, architectures, configurations, packages only
@@ -845,7 +890,7 @@ Replaces option `vhdl-additional-empty-lines'."
:group 'vhdl-compose)
(defcustom vhdl-argument-list-indent nil
- "*Non-nil means indent argument lists relative to opening parenthesis.
+ "Non-nil means indent argument lists relative to opening parenthesis.
That is, argument, association, and port lists start on the same line as the
opening parenthesis and subsequent lines are indented accordingly.
Otherwise, lists start on a new line and are indented as normal code."
@@ -855,7 +900,7 @@ Otherwise, lists start on a new line and are indented as normal code."
:group 'vhdl-compose)
(defcustom vhdl-association-list-with-formals t
- "*Non-nil means write association lists with formal parameters.
+ "Non-nil means write association lists with formal parameters.
Templates prompt for formal and actual parameters (ports/generics).
When pasting component instantiations, formals are included.
If nil, only a list of actual parameters is entered."
@@ -865,17 +910,17 @@ If nil, only a list of actual parameters is entered."
:group 'vhdl-compose)
(defcustom vhdl-conditions-in-parenthesis nil
- "*Non-nil means place parenthesis around condition expressions."
+ "Non-nil means place parenthesis around condition expressions."
:type 'boolean
:group 'vhdl-template)
(defcustom vhdl-zero-string "'0'"
- "*String to use for a logic zero."
+ "String to use for a logic zero."
:type 'string
:group 'vhdl-template)
(defcustom vhdl-one-string "'1'"
- "*String to use for a logic one."
+ "String to use for a logic one."
:type 'string
:group 'vhdl-template)
@@ -906,7 +951,7 @@ If nil, only a list of actual parameters is entered."
-------------------------------------------------------------------------------
"
- "*String or file to insert as file header.
+ "String or file to insert as file header.
If the string specifies an existing file name, the contents of the file is
inserted, otherwise the string itself is inserted as file header.
Type `C-j' for newlines.
@@ -916,7 +961,8 @@ if the header needs to be version controlled.
The following keywords for template generation are supported:
<filename> : replaced by the name of the buffer
<author> : replaced by the user name and email address
- \(`user-full-name', `mail-host-address', `user-mail-address')
+ \(`user-full-name',`mail-host-address', `user-mail-address')
+ <authorfull> : replaced by the user full name (`user-full-name')
<login> : replaced by user login name (`user-login-name')
<company> : replaced by contents of option `vhdl-company-name'
<date> : replaced by the current date
@@ -936,7 +982,7 @@ dependent part of the file header and can also contain the above keywords."
:group 'vhdl-header)
(defcustom vhdl-file-footer ""
- "*String or file to insert as file footer.
+ "String or file to insert as file footer.
If the string specifies an existing file name, the contents of the file is
inserted, otherwise the string itself is inserted as file footer (i.e. at
the end of the file).
@@ -946,7 +992,7 @@ The same keywords as in option `vhdl-file-header' can be used."
:group 'vhdl-header)
(defcustom vhdl-company-name ""
- "*Name of company to insert in file header.
+ "Name of company to insert in file header.
See option `vhdl-file-header'."
:type 'string
:group 'vhdl-header)
@@ -955,14 +1001,14 @@ See option `vhdl-file-header'."
-------------------------------------------------------------------------------
-- Copyright (c) <year> <company>
"
- "*Copyright string to insert in file header.
+ "Copyright string to insert in file header.
Can be multi-line string (type `C-j' for newline) and contain other file
header keywords (see option `vhdl-file-header')."
:type 'string
:group 'vhdl-header)
(defcustom vhdl-platform-spec ""
- "*Specification of VHDL platform to insert in file header.
+ "Specification of VHDL platform to insert in file header.
The platform specification should contain names and versions of the
simulation and synthesis tools used.
See option `vhdl-file-header'."
@@ -970,7 +1016,7 @@ See option `vhdl-file-header'."
:group 'vhdl-header)
(defcustom vhdl-date-format "%Y-%m-%d"
- "*Specifies the date format to use in the header.
+ "Specifies the date format to use in the header.
This string is passed as argument to the command `format-time-string'.
For more information on format strings, see the documentation for the
`format-time-string' command (C-h f `format-time-string')."
@@ -978,7 +1024,7 @@ For more information on format strings, see the documentation for the
:group 'vhdl-header)
(defcustom vhdl-modify-date-prefix-string "-- Last update: "
- "*Prefix string of modification date in VHDL file header.
+ "Prefix string of modification date in VHDL file header.
If actualization of the modification date is called (menu,
`\\[vhdl-template-modify]'), this string is searched and the rest
of the line replaced by the current date."
@@ -986,7 +1032,7 @@ of the line replaced by the current date."
:group 'vhdl-header)
(defcustom vhdl-modify-date-on-saving t
- "*Non-nil means update the modification date when the buffer is saved.
+ "Non-nil means update the modification date when the buffer is saved.
Calls function `\\[vhdl-template-modify]').
NOTE: Activate the new setting in a VHDL buffer by using the menu entry
@@ -999,27 +1045,28 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
"Customizations for sequential processes."
:group 'vhdl-template)
-(defcustom vhdl-reset-kind 'async
- "*Specifies which kind of reset to use in sequential processes."
+(defcustom vhdl-reset-kind 'async
+ "Specifies which kind of reset to use in sequential processes."
:type '(choice (const :tag "None" none)
(const :tag "Synchronous" sync)
- (const :tag "Asynchronous" async))
+ (const :tag "Asynchronous" async)
+ (const :tag "Query" query))
:group 'vhdl-sequential-process)
(defcustom vhdl-reset-active-high nil
- "*Non-nil means reset in sequential processes is active high.
+ "Non-nil means reset in sequential processes is active high.
Otherwise, reset is active low."
:type 'boolean
:group 'vhdl-sequential-process)
(defcustom vhdl-clock-rising-edge t
- "*Non-nil means rising edge of clock triggers sequential processes.
+ "Non-nil means rising edge of clock triggers sequential processes.
Otherwise, falling edge triggers."
:type 'boolean
:group 'vhdl-sequential-process)
(defcustom vhdl-clock-edge-condition 'standard
- "*Syntax of the clock edge condition.
+ "Syntax of the clock edge condition.
Standard: \"clk'event and clk = '1'\"
Function: \"rising_edge(clk)\""
:type '(choice (const :tag "Standard" standard)
@@ -1027,12 +1074,12 @@ Otherwise, falling edge triggers."
:group 'vhdl-sequential-process)
(defcustom vhdl-clock-name ""
- "*Name of clock signal to use in templates."
+ "Name of clock signal to use in templates."
:type 'string
:group 'vhdl-sequential-process)
(defcustom vhdl-reset-name ""
- "*Name of reset signal to use in templates."
+ "Name of reset signal to use in templates."
:type 'string
:group 'vhdl-sequential-process)
@@ -1054,7 +1101,7 @@ begin -- process <label>
end if;
end process <label>;"
"e" ""))
- "*List of user models.
+ "List of user models.
VHDL models (templates) can be specified by the user in this list. They can be
invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword
electrification (i.e. overriding existing or creating new keywords, see
@@ -1103,7 +1150,7 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
(defcustom vhdl-compose-architecture-name '(".*" . "str")
(concat
- "*Specifies how the component architecture name is obtained.
+ "Specifies how the component architecture name is obtained.
The component architecture name can be obtained by modifying the entity name
\(e.g. attaching or stripping off a substring).
If TO STRING is empty, the architecture name is queried."
@@ -1115,7 +1162,7 @@ If TO STRING is empty, the architecture name is queried."
(defcustom vhdl-compose-configuration-name
'("\\(.*\\) \\(.*\\)" . "\\1_\\2_cfg")
(concat
- "*Specifies how the configuration name is obtained.
+ "Specifies how the configuration name is obtained.
The configuration name can be obtained by modifying the entity and/or
architecture name (e.g. attaching or stripping off a substring). The string
that is matched against the regexp is the concatenation of the entity and the
@@ -1129,7 +1176,7 @@ default setting as example)."
(defcustom vhdl-components-package-name
'((".*" . "\\&_components") . "components")
(concat
- "*Specifies how the name for the components package is obtained.
+ "Specifies how the name for the components package is obtained.
The components package is a package containing all component declarations for
the current design. Its name can be obtained by modifying the project name
\(e.g. attaching or stripping off a substring). If no project is defined, the
@@ -1142,19 +1189,19 @@ DIRECTORY entry is chosen."
:group 'vhdl-compose)
(defcustom vhdl-use-components-package nil
- "*Non-nil means use a separate components package for component declarations.
+ "Non-nil means use a separate components package for component declarations.
Otherwise, component declarations are inserted and searched for in the
architecture declarative parts."
:type 'boolean
:group 'vhdl-compose)
(defcustom vhdl-compose-include-header t
- "*Non-nil means include a header in automatically generated files."
+ "Non-nil means include a header in automatically generated files."
:type 'boolean
:group 'vhdl-compose)
(defcustom vhdl-compose-create-files 'single
- "*Specifies whether new files should be created for the new component.
+ "Specifies whether new files should be created for the new component.
The component's entity and architecture are inserted:
None : in current buffer
Single file : in new single file
@@ -1167,14 +1214,14 @@ The file names are obtained from variables `vhdl-entity-file-name' and
:group 'vhdl-compose)
(defcustom vhdl-compose-configuration-create-file nil
- "*Specifies whether a new file should be created for the configuration.
+ "Specifies whether a new file should be created for the configuration.
If non-nil, a new file is created for the configuration.
The file name is obtained from variable `vhdl-configuration-file-name'."
:type 'boolean
:group 'vhdl-compose)
(defcustom vhdl-compose-configuration-hierarchical t
- "*Specifies whether hierarchical configurations should be created.
+ "Specifies whether hierarchical configurations should be created.
If non-nil, automatically created configurations are hierarchical and include
the whole hierarchy of subcomponents. Otherwise the configuration only
includes one level of subcomponents."
@@ -1182,7 +1229,7 @@ includes one level of subcomponents."
:group 'vhdl-compose)
(defcustom vhdl-compose-configuration-use-subconfiguration t
- "*Specifies whether subconfigurations should be used inside configurations.
+ "Specifies whether subconfigurations should be used inside configurations.
If non-nil, automatically created configurations use configurations in binding
indications for subcomponents, if such configurations exist. Otherwise,
entities are used in binding indications for subcomponents."
@@ -1196,22 +1243,22 @@ entities are used in binding indications for subcomponents."
:group 'vhdl-compose)
(defcustom vhdl-include-port-comments nil
- "*Non-nil means include port comments when a port is pasted."
+ "Non-nil means include port comments when a port is pasted."
:type 'boolean
:group 'vhdl-port)
(defcustom vhdl-include-direction-comments nil
- "*Non-nil means include port direction in instantiations as comments."
+ "Non-nil means include port direction in instantiations as comments."
:type 'boolean
:group 'vhdl-port)
(defcustom vhdl-include-type-comments nil
- "*Non-nil means include generic/port type in instantiations as comments."
+ "Non-nil means include generic/port type in instantiations as comments."
:type 'boolean
:group 'vhdl-port)
(defcustom vhdl-include-group-comments 'never
- "*Specifies whether to include group comments and spacings.
+ "Specifies whether to include group comments and spacings.
The comments and empty lines between groups of ports are pasted:
Never : never
Declarations: in entity/component/constant/signal declarations only
@@ -1223,7 +1270,7 @@ The comments and empty lines between groups of ports are pasted:
(defcustom vhdl-actual-port-name '(".*" . "\\&")
(concat
- "*Specifies how actual port names are obtained from formal port names.
+ "Specifies how actual port names are obtained from formal port names.
In a component instantiation, an actual port name can be obtained by
modifying the formal port name (e.g. attaching or stripping off a substring)."
vhdl-name-doc-string)
@@ -1233,7 +1280,7 @@ modifying the formal port name (e.g. attaching or stripping off a substring)."
(defcustom vhdl-instance-name '(".*" . "\\&_%d")
(concat
- "*Specifies how an instance name is obtained.
+ "Specifies how an instance name is obtained.
The instance name can be obtained by modifying the name of the component to be
instantiated (e.g. attaching or stripping off a substring). \"%d\" is replaced
by a unique number (starting with 1).
@@ -1250,7 +1297,7 @@ If TO STRING is empty, the instance name is queried."
(defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb")
(concat
- "*Specifies how the testbench entity name is obtained.
+ "Specifies how the testbench entity name is obtained.
The entity name of a testbench can be obtained by modifying the name of
the component to be tested (e.g. attaching or stripping off a substring)."
vhdl-name-doc-string)
@@ -1260,7 +1307,7 @@ the component to be tested (e.g. attaching or stripping off a substring)."
(defcustom vhdl-testbench-architecture-name '(".*" . "")
(concat
- "*Specifies how the testbench architecture name is obtained.
+ "Specifies how the testbench architecture name is obtained.
The testbench architecture name can be obtained by modifying the name of
the component to be tested (e.g. attaching or stripping off a substring).
If TO STRING is empty, the architecture name is queried."
@@ -1271,7 +1318,7 @@ If TO STRING is empty, the architecture name is queried."
(defcustom vhdl-testbench-configuration-name vhdl-compose-configuration-name
(concat
- "*Specifies how the testbench configuration name is obtained.
+ "Specifies how the testbench configuration name is obtained.
The configuration name of a testbench can be obtained by modifying the entity
and/or architecture name (e.g. attaching or stripping off a substring). The
string that is matched against the regexp is the concatenation of the entity
@@ -1284,7 +1331,7 @@ names (see default setting as example)."
(defcustom vhdl-testbench-dut-name '(".*" . "DUT")
(concat
- "*Specifies how a DUT instance name is obtained.
+ "Specifies how a DUT instance name is obtained.
The design-under-test instance name (i.e. the component instantiated in the
testbench) can be obtained by modifying the component name (e.g. attaching
or stripping off a substring)."
@@ -1294,7 +1341,7 @@ or stripping off a substring)."
:group 'vhdl-testbench)
(defcustom vhdl-testbench-include-header t
- "*Non-nil means include a header in automatically generated files."
+ "Non-nil means include a header in automatically generated files."
:type 'boolean
:group 'vhdl-testbench)
@@ -1302,7 +1349,7 @@ or stripping off a substring)."
-- clock
signal Clk : std_logic := '1';
"
- "*String or file to be inserted in the testbench declarative part.
+ "String or file to be inserted in the testbench declarative part.
If the string specifies an existing file name, the contents of the file is
inserted, otherwise the string itself is inserted in the testbench
architecture before the BEGIN keyword.
@@ -1322,7 +1369,7 @@ Type `C-j' for newlines."
wait until Clk = '1';
end process WaveGen_Proc;
"
- "*String or file to be inserted in the testbench statement part.
+ "String or file to be inserted in the testbench statement part.
If the string specifies an existing file name, the contents of the file is
inserted, otherwise the string itself is inserted in the testbench
architecture before the END keyword.
@@ -1331,22 +1378,22 @@ Type `C-j' for newlines."
:group 'vhdl-testbench)
(defcustom vhdl-testbench-initialize-signals nil
- "*Non-nil means initialize signals with `0' when declared in testbench."
+ "Non-nil means initialize signals with `0' when declared in testbench."
:type 'boolean
:group 'vhdl-testbench)
(defcustom vhdl-testbench-include-library t
- "*Non-nil means a library/use clause for std_logic_1164 is included."
+ "Non-nil means a library/use clause for std_logic_1164 is included."
:type 'boolean
:group 'vhdl-testbench)
(defcustom vhdl-testbench-include-configuration t
- "*Non-nil means a testbench configuration is attached at the end."
+ "Non-nil means a testbench configuration is attached at the end."
:type 'boolean
:group 'vhdl-testbench)
(defcustom vhdl-testbench-create-files 'single
- "*Specifies whether new files should be created for the testbench.
+ "Specifies whether new files should be created for the testbench.
testbench entity and architecture are inserted:
None : in current buffer
Single file : in new single file
@@ -1360,7 +1407,7 @@ and `vhdl-testbench-architecture-file-name'."
(defcustom vhdl-testbench-entity-file-name vhdl-entity-file-name
(concat
- "*Specifies how the testbench entity file name is obtained.
+ "Specifies how the testbench entity file name is obtained.
The entity file name can be obtained by modifying the testbench entity name
\(e.g. attaching or stripping off a substring). The file extension is
automatically taken from the file name of the current buffer. Testbench
@@ -1373,7 +1420,7 @@ absolute path to the file name."
(defcustom vhdl-testbench-architecture-file-name vhdl-architecture-file-name
(concat
- "*Specifies how the testbench architecture file name is obtained.
+ "Specifies how the testbench architecture file name is obtained.
The architecture file name can be obtained by modifying the testbench entity
and/or architecture name (e.g. attaching or stripping off a substring). The
string that is matched against the regexp is the concatenation of the entity
@@ -1392,17 +1439,17 @@ name."
:group 'vhdl)
(defcustom vhdl-self-insert-comments t
- "*Non-nil means various templates automatically insert help comments."
+ "Non-nil means various templates automatically insert help comments."
:type 'boolean
:group 'vhdl-comment)
(defcustom vhdl-prompt-for-comments t
- "*Non-nil means various templates prompt for user definable comments."
+ "Non-nil means various templates prompt for user definable comments."
:type 'boolean
:group 'vhdl-comment)
(defcustom vhdl-inline-comment-column 40
- "*Column to indent and align inline comments to.
+ "Column to indent and align inline comments to.
Overrides local option `comment-column'.
NOTE: Activate the new setting in a VHDL buffer by using the menu entry
@@ -1411,7 +1458,7 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
:group 'vhdl-comment)
(defcustom vhdl-end-comment-column 79
- "*End of comment column.
+ "End of comment column.
Comments that exceed this column number are wrapped.
NOTE: Activate the new setting in a VHDL buffer by using the menu entry
@@ -1427,19 +1474,19 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
:group 'vhdl)
(defcustom vhdl-auto-align t
- "*Non-nil means align some templates automatically after generation."
+ "Non-nil means align some templates automatically after generation."
:type 'boolean
:group 'vhdl-align)
(defcustom vhdl-align-groups t
- "*Non-nil means align groups of code lines separately.
+ "Non-nil means align groups of code lines separately.
A group of code lines is a region of consecutive lines between two lines that
match the regexp in option `vhdl-align-group-separate'."
:type 'boolean
:group 'vhdl-align)
(defcustom vhdl-align-group-separate "^\\s-*$"
- "*Regexp for matching a line that separates groups of lines for alignment.
+ "Regexp for matching a line that separates groups of lines for alignment.
Examples:
\"^\\s-*$\": matches an empty line
\"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line"
@@ -1447,7 +1494,7 @@ Examples:
:group 'vhdl-align)
(defcustom vhdl-align-same-indent t
- "*Non-nil means align blocks with same indent separately.
+ "Non-nil means align blocks with same indent separately.
When a region or the entire buffer is aligned, the code is divided into
blocks of same indent which are aligned separately (except for argument/port
lists). This gives nicer alignment in most cases.
@@ -1461,7 +1508,7 @@ Option `vhdl-align-groups' still applies within these blocks."
:group 'vhdl)
(defcustom vhdl-highlight-keywords t
- "*Non-nil means highlight VHDL keywords and other standardized words.
+ "Non-nil means highlight VHDL keywords and other standardized words.
The following faces are used:
`font-lock-keyword-face' : keywords
`font-lock-type-face' : standardized types
@@ -1477,7 +1524,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:group 'vhdl-highlight)
(defcustom vhdl-highlight-names t
- "*Non-nil means highlight declaration names and construct labels.
+ "Non-nil means highlight declaration names and construct labels.
The following faces are used:
`font-lock-function-name-face' : names in declarations of units,
subprograms, components, as well as labels of VHDL constructs
@@ -1494,7 +1541,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:group 'vhdl-highlight)
(defcustom vhdl-highlight-special-words nil
- "*Non-nil means highlight words with special syntax.
+ "Non-nil means highlight words with special syntax.
The words with syntax and color specified in option `vhdl-special-syntax-alist'
are highlighted accordingly.
Can be used for visual support of naming conventions.
@@ -1507,7 +1554,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:group 'vhdl-highlight)
(defcustom vhdl-highlight-forbidden-words nil
- "*Non-nil means highlight forbidden words.
+ "Non-nil means highlight forbidden words.
The reserved words specified in option `vhdl-forbidden-words' or having the
syntax specified in option `vhdl-forbidden-syntax' are highlighted in a
warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to
@@ -1522,7 +1569,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:group 'vhdl-highlight)
(defcustom vhdl-highlight-verilog-keywords nil
- "*Non-nil means highlight Verilog keywords as reserved words.
+ "Non-nil means highlight Verilog keywords as reserved words.
Verilog keywords are highlighted in a warning color (face
`vhdl-font-lock-reserved-words-face') to indicate not to use them.
@@ -1535,7 +1582,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:group 'vhdl-highlight)
(defcustom vhdl-highlight-translate-off nil
- "*Non-nil means background-highlight code excluded from translation.
+ "Non-nil means background-highlight code excluded from translation.
That is, all code between \"-- pragma translate_off\" and
\"-- pragma translate_on\" is highlighted using a different background color
\(face `vhdl-font-lock-translate-off-face').
@@ -1549,7 +1596,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:group 'vhdl-highlight)
(defcustom vhdl-highlight-case-sensitive nil
- "*Non-nil means consider case for highlighting.
+ "Non-nil means consider case for highlighting.
Possible trade-off:
non-nil also upper-case VHDL words are highlighted, but case of words with
special syntax is not considered
@@ -1563,22 +1610,25 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:group 'vhdl-highlight)
(defcustom vhdl-special-syntax-alist
- '(("generic/constant" "\\w+_[cg]" "Gold3" "BurlyWood1")
- ("type" "\\w+_t" "ForestGreen" "PaleGreen")
- ("variable" "\\w+_v" "Grey50" "Grey80"))
- "*List of special syntax to be highlighted.
+ '(("generic/constant" "\\<\\w+_[cg]\\>" "Gold3" "BurlyWood1" nil)
+ ("type" "\\<\\w+_t\\>" "ForestGreen" "PaleGreen" nil)
+ ("variable" "\\<\\w+_v\\>" "Grey50" "Grey80" nil))
+ "List of special syntax to be highlighted.
If option `vhdl-highlight-special-words' is non-nil, words with the specified
syntax (as regular expression) are highlighted in the corresponding color.
Name : string of words and spaces
Regexp : regular expression describing word syntax
- (e.g. \"\\\w+_c\" matches word with suffix \"_c\")
+ (e.g. \"\\\\=\<\\\w+_c\\\\=\>\" matches word with suffix \"_c\")
+ expression must start with \"\\\\=\<\" and end with \"\\\\=\>\"
+ if only whole words should be matched (no substrings)
Color (light): foreground color for light background
(matching color examples: Gold3, Grey50, LimeGreen, Tomato,
LightSeaGreen, DodgerBlue, Gold, PaleVioletRed)
Color (dark) : foreground color for dark background
(matching color examples: BurlyWood1, Grey80, Green, Coral,
AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1)
+ In comments : If non-nil, words are also highlighted inside comments
Can be used for visual support of naming conventions, such as highlighting
different kinds of signals (e.g. \"Clk50\", \"Rst_n\") or objects (e.g.
@@ -1593,13 +1643,14 @@ NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu
(string :tag "Name ")
(regexp :tag "Regexp " "\\w+_")
(string :tag "Color (light)")
- (string :tag "Color (dark) ")))
+ (string :tag "Color (dark) ")
+ (boolean :tag "In comments ")))
:set (lambda (variable value)
(vhdl-custom-set variable value 'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-forbidden-words '()
- "*List of forbidden words to be highlighted.
+ "List of forbidden words to be highlighted.
If option `vhdl-highlight-forbidden-words' is non-nil, these reserved
words are highlighted in a warning color to indicate not to use them.
@@ -1612,7 +1663,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:group 'vhdl-highlight)
(defcustom vhdl-forbidden-syntax ""
- "*Syntax of forbidden words to be highlighted.
+ "Syntax of forbidden words to be highlighted.
If option `vhdl-highlight-forbidden-words' is non-nil, words with this
syntax are highlighted in a warning color to indicate not to use them.
Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\"
@@ -1627,7 +1678,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:group 'vhdl-highlight)
(defcustom vhdl-directive-keywords '("pragma" "synopsys")
- "*List of compiler directive keywords recognized for highlighting.
+ "List of compiler directive keywords recognized for highlighting.
NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
entry \"Fontify Buffer\")."
@@ -1643,13 +1694,13 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:group 'vhdl)
(defcustom vhdl-speedbar-auto-open nil
- "*Non-nil means automatically open speedbar at startup.
+ "Non-nil means automatically open speedbar at startup.
Alternatively, the speedbar can be opened from the VHDL menu."
:type 'boolean
:group 'vhdl-speedbar)
(defcustom vhdl-speedbar-display-mode 'files
- "*Specifies the default displaying mode when opening speedbar.
+ "Specifies the default displaying mode when opening speedbar.
Alternatively, the displaying mode can be selected from the speedbar menu or
by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)."
:type '(choice (const :tag "Files" files)
@@ -1658,7 +1709,7 @@ by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)."
:group 'vhdl-speedbar)
(defcustom vhdl-speedbar-scan-limit '(10000000 (1000000 50))
- "*Limits scanning of large files and netlists.
+ "Limits scanning of large files and netlists.
Design units: maximum file size to scan for design units
Hierarchy (instances of subcomponents):
File size: maximum file size to scan for instances (in bytes)
@@ -1685,18 +1736,18 @@ prevent the scanning of large netlists."
:group 'vhdl-speedbar)
(defcustom vhdl-speedbar-jump-to-unit t
- "*Non-nil means jump to the design unit code when opened in a buffer.
+ "Non-nil means jump to the design unit code when opened in a buffer.
The buffer cursor position is left unchanged otherwise."
:type 'boolean
:group 'vhdl-speedbar)
(defcustom vhdl-speedbar-update-on-saving t
- "*Automatically update design hierarchy when buffer is saved."
+ "Automatically update design hierarchy when buffer is saved."
:type 'boolean
:group 'vhdl-speedbar)
(defcustom vhdl-speedbar-save-cache '(hierarchy display)
- "*Automatically save modified hierarchy caches when exiting Emacs.
+ "Automatically save modified hierarchy caches when exiting Emacs.
Hierarchy: design hierarchy information
Display: displaying information (which design units to expand)"
:type '(set (const :tag "Hierarchy" hierarchy)
@@ -1704,7 +1755,7 @@ The buffer cursor position is left unchanged otherwise."
:group 'vhdl-speedbar)
(defcustom vhdl-speedbar-cache-file-name ".emacs-vhdl-cache-\\1-\\2"
- "*Name of file for saving hierarchy cache.
+ "Name of file for saving hierarchy cache.
\"\\1\" is replaced by the project name if a project is specified,
\"directory\" otherwise. \"\\2\" is replaced by the user name (allows for
different users to have cache files in the same directory). Can also have
@@ -1718,20 +1769,20 @@ an absolute path (i.e. all caches can be stored in one global directory)."
:group 'vhdl)
(defcustom vhdl-index-menu nil
- "*Non-nil means add an index menu for a source file when loading.
+ "Non-nil means add an index menu for a source file when loading.
Alternatively, the speedbar can be used. Note that the index menu scans a file
when it is opened, while speedbar only scans the file upon request."
:type 'boolean
:group 'vhdl-menu)
(defcustom vhdl-source-file-menu nil
- "*Non-nil means add a menu of all source files in current directory.
+ "Non-nil means add a menu of all source files in current directory.
Alternatively, the speedbar can be used."
:type 'boolean
:group 'vhdl-menu)
(defcustom vhdl-hideshow-menu nil
- "*Non-nil means add hideshow menu and functionality at startup.
+ "Non-nil means add hideshow menu and functionality at startup.
Hideshow can also be enabled from the VHDL Mode menu.
Hideshow allows hiding code of various VHDL constructs.
@@ -1741,7 +1792,7 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
:group 'vhdl-menu)
(defcustom vhdl-hide-all-init nil
- "*Non-nil means hide all design units initially after a file is loaded."
+ "Non-nil means hide all design units initially after a file is loaded."
:type 'boolean
:group 'vhdl-menu)
@@ -1751,7 +1802,7 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
:group 'vhdl)
(defcustom vhdl-print-two-column t
- "*Non-nil means print code in two columns and landscape format.
+ "Non-nil means print code in two columns and landscape format.
Adjusts settings in a way that PostScript printing (\"File\" menu, `ps-print')
prints VHDL files in a nice two-column landscape style.
@@ -1761,7 +1812,7 @@ NOTE: Activate the new setting by restarting Emacs.
:group 'vhdl-print)
(defcustom vhdl-print-customize-faces t
- "*Non-nil means use an optimized set of faces for PostScript printing.
+ "Non-nil means use an optimized set of faces for PostScript printing.
NOTE: Activate the new setting by restarting Emacs.
Overrides `ps-print' settings locally."
@@ -1774,7 +1825,7 @@ NOTE: Activate the new setting by restarting Emacs.
:group 'vhdl)
(defcustom vhdl-intelligent-tab t
- "*Non-nil means `TAB' does indentation, word completion and tab insertion.
+ "Non-nil means `TAB' does indentation, word completion and tab insertion.
That is, if preceding character is part of a word then complete word,
else if not at beginning of line then insert tab,
else if last command was a `TAB' or `RET' then dedent one step,
@@ -1788,28 +1839,37 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
:group 'vhdl-misc)
(defcustom vhdl-indent-syntax-based t
- "*Non-nil means indent lines of code based on their syntactic context.
+ "Non-nil means indent lines of code based on their syntactic context.
Otherwise, a line is indented like the previous nonblank line. This can be
useful in large files where syntax-based indentation gets very slow."
:type 'boolean
:group 'vhdl-misc)
+(defcustom vhdl-indent-comment-like-next-code-line t
+ "*Non-nil means comment lines are indented like the following code line.
+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
- "*Non-nil means word completion using `TAB' is case sensitive.
+ "Non-nil means word completion using `TAB' is case sensitive.
That is, `TAB' completes words that start with the same letters and case.
Otherwise, case is ignored."
:type 'boolean
:group 'vhdl-misc)
(defcustom vhdl-word-completion-in-minibuffer t
- "*Non-nil enables word completion in minibuffer (for template prompts).
+ "Non-nil enables word completion in minibuffer (for template prompts).
NOTE: Activate the new setting by restarting Emacs."
:type 'boolean
:group 'vhdl-misc)
(defcustom vhdl-underscore-is-part-of-word nil
- "*Non-nil means consider the underscore character `_' as part of word.
+ "Non-nil means consider the underscore character `_' as part of word.
An identifier containing underscores is then treated as a single word in
select and move operations. All parts of an identifier separated by underscore
are treated as single words otherwise.
@@ -1833,6 +1893,7 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
(custom-add-to-group 'vhdl-related 'paren-showing 'custom-group))
(custom-add-to-group 'vhdl-related 'ps-print 'custom-group)
(custom-add-to-group 'vhdl-related 'speedbar 'custom-group)
+(custom-add-to-group 'vhdl-related 'comment-style 'custom-variable)
(custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable)
(unless (featurep 'xemacs)
(custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable))
@@ -1841,27 +1902,36 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
(custom-add-to-group 'vhdl-related 'user-mail-address 'custom-variable)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Hidden user variables
+
+(defvar vhdl-compile-absolute-path nil
+ "If non-nil, use absolute instead of relative path for compiled files.")
+
+(defvar vhdl-comment-display-line-char ?-
+ "Character to use in comment display line.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal variables
(defvar vhdl-menu-max-size 20
- "*Specifies the maximum size of a menu before splitting it into submenus.")
+ "Specifies the maximum size of a menu before splitting it into submenus.")
(defvar vhdl-progress-interval 1
- "*Interval used to update progress status during long operations.
+ "Interval used to update progress status during long operations.
If a number, percentage complete gets updated after each interval of
that many seconds. To inhibit all messages, set this option to nil.")
(defvar vhdl-inhibit-startup-warnings-p nil
- "*If non-nil, inhibits start up compatibility warnings.")
+ "If non-nil, inhibits start up compatibility warnings.")
(defvar vhdl-strict-syntax-p nil
- "*If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'.
+ "If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'.
If the syntactic symbol for a particular line does not match a symbol
in the offsets alist, an error is generated, otherwise no error is
reported and the syntactic symbol is ignored.")
(defvar vhdl-echo-syntactic-information-p nil
- "*If non-nil, syntactic info is echoed when the line is indented.")
+ "If non-nil, syntactic info is echoed when the line is indented.")
(defconst vhdl-offsets-alist-default
'((string . -1000)
@@ -1889,7 +1959,7 @@ Do not change this constant! See the variable `vhdl-offsets-alist' for
more information.")
(defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default)
- "*Association list of syntactic element symbols and indentation offsets.
+ "Association list of syntactic element symbols and indentation offsets.
As described below, each cons cell in this list has the form:
(SYNTACTIC-SYMBOL . OFFSET)
@@ -1950,7 +2020,7 @@ Here is the current list of valid syntactic element symbols:
package-body -- inside a package body")
(defvar vhdl-comment-only-line-offset 0
- "*Extra offset for line which contains only the start of a comment.
+ "Extra offset for line which contains only the start of a comment.
Can contain an integer or a cons cell of the form:
(NON-ANCHORED-OFFSET . ANCHORED-OFFSET)
@@ -1961,7 +2031,7 @@ the amount of offset to give column-zero anchored comment-only lines.
Just an integer as value is equivalent to (<val> . 0)")
(defvar vhdl-special-indent-hook nil
- "*Hook for user defined special indentation adjustments.
+ "Hook for user defined special indentation adjustments.
This hook gets called after a line is indented by the mode.")
(defvar vhdl-style-alist
@@ -2003,7 +2073,7 @@ your style, only those that are different from the default.")
(setq vhdl-style-alist (cons default vhdl-style-alist))))
(defvar vhdl-mode-hook nil
- "*Hook called by `vhdl-mode'.")
+ "Hook called by `vhdl-mode'.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2040,7 +2110,7 @@ Ignore byte-compiler warnings you might see."
;; `wildcard-to-regexp' is included only in XEmacs 21
(unless (fboundp 'wildcard-to-regexp)
(defun wildcard-to-regexp (wildcard)
- "Simplified version of `wildcard-to-regexp' from Emacs' `files.el'."
+ "Simplified version of `wildcard-to-regexp' from Emacs's `files.el'."
(let* ((i (string-match "[*?]" wildcard))
(result (substring wildcard 0 i))
(len (length wildcard)))
@@ -2087,7 +2157,7 @@ Ignore byte-compiler warnings you might see."
;; `file-expand-wildcards' undefined (XEmacs)
(unless (fboundp 'file-expand-wildcards)
(defun file-expand-wildcards (pattern &optional full)
- "Taken from Emacs' `files.el'."
+ "Taken from Emacs's `files.el'."
(let* ((nondir (file-name-nondirectory pattern))
(dirpart (file-name-directory pattern))
(dirs (if (and dirpart (string-match "[[*?]" dirpart))
@@ -3270,9 +3340,6 @@ STRING are replaced by `-' and substrings are converted to lower case."
(list
(append
'("Package")
- (when (vhdl-standard-p 'math)
- '(["math_complex" vhdl-template-package-math-complex t]
- ["math_real" vhdl-template-package-math-real t]))
'(["numeric_bit" vhdl-template-package-numeric-bit t]
["numeric_std" vhdl-template-package-numeric-std t]
["std_logic_1164" vhdl-template-package-std-logic-1164 t]
@@ -3283,8 +3350,22 @@ STRING are replaced by `-' and substrings are converted to lower case."
["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t]
["std_logic_misc" vhdl-template-package-std-logic-misc t]
["std_logic_textio" vhdl-template-package-std-logic-textio t]
- "--"
- ["Insert Package..." vhdl-template-insert-package
+ "--")
+ (when (vhdl-standard-p 'ams)
+ '(["fundamental_constants" vhdl-template-package-fundamental-constants t]
+ ["material_constants" vhdl-template-package-material-constants t]
+ ["energy_systems" vhdl-template-package-energy-systems t]
+ ["electrical_systems" vhdl-template-package-electrical-systems t]
+ ["mechanical_systems" vhdl-template-package-mechanical-systems t]
+ ["radiant_systems" vhdl-template-package-radiant-systems t]
+ ["thermal_systems" vhdl-template-package-thermal-systems t]
+ ["fluidic_systems" vhdl-template-package-fluidic-systems t]
+ "--"))
+ (when (vhdl-standard-p 'math)
+ '(["math_complex" vhdl-template-package-math-complex t]
+ ["math_real" vhdl-template-package-math-real t]
+ "--"))
+ '(["Insert Package..." vhdl-template-insert-package
:keys "C-c C-i C-p"])))
'(("Directive"
["translate_on" vhdl-template-directive-translate-on t]
@@ -3417,6 +3498,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
["Buffer" vhdl-beautify-buffer t])
("Fix"
["Generic/Port Clause" vhdl-fix-clause t]
+ ["Generic/Port Clause Buffer" vhdl-fix-clause t]
"--"
["Case Region" vhdl-fix-case-region (mark)]
["Case Buffer" vhdl-fix-case-buffer t]
@@ -3449,11 +3531,13 @@ STRING are replaced by `-' and substrings are converted to lower case."
("Mode"
["Electric Mode"
(progn (customize-set-variable 'vhdl-electric-mode
- (not vhdl-electric-mode)))
+ (not vhdl-electric-mode))
+ (vhdl-mode-line-update))
:style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"]
["Stutter Mode"
(progn (customize-set-variable 'vhdl-stutter-mode
- (not vhdl-stutter-mode)))
+ (not vhdl-stutter-mode))
+ (vhdl-mode-line-update))
:style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"]
["Indent Tabs Mode"
(progn (customize-set-variable 'vhdl-indent-tabs-mode
@@ -3515,6 +3599,8 @@ STRING are replaced by `-' and substrings are converted to lower case."
(customize-set-variable 'vhdl-compile-use-local-error-regexp
(not vhdl-compile-use-local-error-regexp))
:style toggle :selected vhdl-compile-use-local-error-regexp]
+ ["Makefile Default Targets..."
+ (customize-option 'vhdl-makefile-default-targets) t]
["Makefile Generation Hook..."
(customize-option 'vhdl-makefile-generation-hook) t]
["Default Library Name" (customize-option 'vhdl-default-library) t]
@@ -3527,7 +3613,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
(list '87 (cadr vhdl-standard)))
(vhdl-activate-customizations))
:style radio :selected (eq '87 (car vhdl-standard))]
- ["VHDL'93"
+ ["VHDL'93/02"
(progn (customize-set-variable 'vhdl-standard
(list '93 (cadr vhdl-standard)))
(vhdl-activate-customizations))
@@ -3580,6 +3666,10 @@ STRING are replaced by `-' and substrings are converted to lower case."
["Always"
(customize-set-variable 'vhdl-use-direct-instantiation 'always)
:style radio :selected (eq 'always vhdl-use-direct-instantiation)])
+ ["Include Array Index and Record Field in Sensitivity List"
+ (customize-set-variable 'vhdl-array-index-record-field-in-sensitivity-list
+ (not vhdl-array-index-record-field-in-sensitivity-list))
+ :style toggle :selected vhdl-array-index-record-field-in-sensitivity-list]
"--"
["Customize Group..." (customize-group 'vhdl-style) t])
("Naming"
@@ -3676,7 +3766,10 @@ STRING are replaced by `-' and substrings are converted to lower case."
:style radio :selected (eq 'sync vhdl-reset-kind)]
["Asynchronous"
(customize-set-variable 'vhdl-reset-kind 'async)
- :style radio :selected (eq 'async vhdl-reset-kind)])
+ :style radio :selected (eq 'async vhdl-reset-kind)]
+ ["Query"
+ (customize-set-variable 'vhdl-reset-kind 'query)
+ :style radio :selected (eq 'query vhdl-reset-kind)])
["Reset is Active High"
(customize-set-variable 'vhdl-reset-active-high
(not vhdl-reset-active-high))
@@ -3966,6 +4059,10 @@ STRING are replaced by `-' and substrings are converted to lower case."
(customize-set-variable 'vhdl-indent-syntax-based
(not vhdl-indent-syntax-based))
:style toggle :selected vhdl-indent-syntax-based]
+ ["Indent Comments Like Next Code Line"
+ (customize-set-variable 'vhdl-indent-comment-like-next-code-line
+ (not vhdl-indent-comment-like-next-code-line))
+ :style toggle :selected vhdl-indent-comment-like-next-code-line]
["Word Completion is Case Sensitive"
(customize-set-variable 'vhdl-word-completion-case-sensitive
(not vhdl-word-completion-case-sensitive))
@@ -4009,7 +4106,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
"^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)"
4)
("Instance"
- "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>"
+ "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(entity\\s-+\\(\\w\\|\\s_\\)+\\.\\)?\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>"
1)
("Component"
"^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
@@ -4044,10 +4141,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
(set (make-local-variable 'imenu-generic-expression)
vhdl-imenu-generic-expression)
(when (and vhdl-index-menu (fboundp 'imenu))
- (if (or (not (boundp 'font-lock-maximum-size))
- (> font-lock-maximum-size (buffer-size)))
- (imenu-add-to-menubar "Index")
- (message "Scanning buffer for index...buffer too big"))))
+ (imenu-add-to-menubar "Index")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Source file menu (using `easy-menu.el')
@@ -4132,7 +4226,7 @@ Usage:
brackets and removed if the queried string is left empty. Prompts for
mandatory arguments remain in the code if the queried string is left
empty. They can be queried again by `C-c C-t C-q'. Enabled
- electrification is indicated by `/e' in the modeline.
+ electrification is indicated by `/e' in the mode line.
Typing `M-SPC' after a keyword inserts a space without calling the
template generator. Automatic template generation (i.e.
@@ -4159,7 +4253,7 @@ Usage:
Double striking of some keys inserts cumbersome VHDL syntax elements.
Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by
option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in
- the modeline. The stuttering keys and their effects are:
+ the mode line. The stuttering keys and their effects are:
;; --> \" : \" [ --> ( -- --> comment
;;; --> \" := \" [[ --> [ --CR --> comment-out code
@@ -4193,8 +4287,10 @@ Usage:
with a comment in between.
`--CR' comments out code on that line. Re-hitting CR comments
out following lines.
- `C-c c' comments out a region if not commented out,
- uncomments a region if already commented out.
+ `C-c C-c' comments out a region if not commented out,
+ uncomments a region if already commented out. Option
+ `comment-style' defines where the comment characters
+ should be placed (beginning of line, indent, etc.).
You are prompted for comments after object definitions (i.e. signals,
variables, constants, ports) and after subprogram and process
@@ -4215,7 +4311,8 @@ Usage:
`TAB' indents a line if at the beginning of the line. The amount of
indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l'
always indents the current line (is bound to `TAB' if option
- `vhdl-intelligent-tab' is nil).
+ `vhdl-intelligent-tab' is nil). If a region is active, `TAB' indents
+ the entire region.
Indentation can be done for a group of lines (`C-c C-i C-g'), a region
\(`M-C-\\') or the entire buffer (menu). Argument and port lists are
@@ -4229,6 +4326,10 @@ Usage:
Syntax-based indentation can be very slow in large files. Option
`vhdl-indent-syntax-based' allows to use faster but simpler indentation.
+ Option `vhdl-indent-comment-like-next-code-line' controls whether
+ comment lines are indented like the preceding or like the following code
+ line.
+
ALIGNMENT:
The alignment functions align operators, keywords, and inline comments
@@ -4357,12 +4458,12 @@ Usage:
STRUCTURAL COMPOSITION:
- Enables simple structural composition. `C-c C-c C-n' creates a skeleton
+ Enables simple structural composition. `C-c C-m C-n' creates a skeleton
for a new component. Subcomponents (i.e. component declaration and
instantiation) can be automatically placed from a previously read port
- \(`C-c C-c C-p') or directly from the hierarchy browser (`P'). Finally,
+ \(`C-c C-m C-p') or directly from the hierarchy browser (`P'). Finally,
all subcomponents can be automatically connected using internal signals
- and ports (`C-c C-c C-w') following these rules:
+ and ports (`C-c C-m C-w') following these rules:
- subcomponent actual ports with same name are considered to be
connected by a signal (internal signal or port)
- signals that are only inputs to subcomponents are considered as
@@ -4383,25 +4484,25 @@ Usage:
Component declarations can be placed in a components package (option
`vhdl-use-components-package') which can be automatically generated for
- an entire directory or project (`C-c C-c M-p'). The VHDL'93 direct
+ an entire directory or project (`C-c C-m M-p'). The VHDL'93 direct
component instantiation is also supported (option
`vhdl-use-direct-instantiation').
-| Configuration declarations can automatically be generated either from
-| the menu (`C-c C-c C-f') (for the architecture the cursor is in) or from
-| the speedbar menu (for the architecture under the cursor). The
-| configurations can optionally be hierarchical (i.e. include all
-| component levels of a hierarchical design, option
-| `vhdl-compose-configuration-hierarchical') or include subconfigurations
-| (option `vhdl-compose-configuration-use-subconfiguration'). For
-| subcomponents in hierarchical configurations, the most-recently-analyzed
-| (mra) architecture is selected. If another architecture is desired, it
-| can be marked as most-recently-analyzed (speedbar menu) before
-| generating the configuration.
-|
-| Note: Configurations of subcomponents (i.e. hierarchical configuration
-| declarations) are currently not considered when displaying
-| configurations in speedbar.
+ Configuration declarations can automatically be generated either from
+ the menu (`C-c C-m C-f') (for the architecture the cursor is in) or from
+ the speedbar menu (for the architecture under the cursor). The
+ configurations can optionally be hierarchical (i.e. include all
+ component levels of a hierarchical design, option
+ `vhdl-compose-configuration-hierarchical') or include subconfigurations
+ (option `vhdl-compose-configuration-use-subconfiguration'). For
+ subcomponents in hierarchical configurations, the most-recently-analyzed
+ (mra) architecture is selected. If another architecture is desired, it
+ can be marked as most-recently-analyzed (speedbar menu) before
+ generating the configuration.
+
+ Note: Configurations of subcomponents (i.e. hierarchical configuration
+ declarations) are currently not considered when displaying
+ configurations in speedbar.
See the options group `vhdl-compose' for all relevant user options.
@@ -4433,11 +4534,13 @@ Usage:
The Makefile's default target \"all\" compiles the entire design, the
target \"clean\" removes it and the target \"library\" creates the
- library directory if not existent. The Makefile also includes a target
- for each primary library unit which allows selective compilation of this
- unit, its secondary units and its subhierarchy (example: compilation of
- a design specified by a configuration). User specific parts can be
- inserted into a Makefile with option `vhdl-makefile-generation-hook'.
+ library directory if not existent. These target names can be customized
+ by option `vhdl-makefile-default-targets'. The Makefile also includes a
+ target for each primary library unit which allows selective compilation
+ of this unit, its secondary units and its subhierarchy (example:
+ compilation of a design specified by a configuration). User specific
+ parts can be inserted into a Makefile with option
+ `vhdl-makefile-generation-hook'.
Limitations:
- Only library units and dependencies within the current library are
@@ -4483,7 +4586,7 @@ Usage:
VHDL STANDARDS:
The VHDL standards to be used are specified in option `vhdl-standard'.
- Available standards are: VHDL'87/'93, VHDL-AMS, and Math Packages.
+ Available standards are: VHDL'87/'93(02), VHDL-AMS, and Math Packages.
KEYWORD CASE:
@@ -4559,6 +4662,9 @@ Usage:
- Out parameters of procedures are considered to be read.
Use option `vhdl-entity-file-name' to specify the entity file name
\(used to obtain the port names).
+ Use option `vhdl-array-index-record-field-in-sensitivity-list' to
+ specify whether to include array indices and record fields in
+ sensitivity lists.
CODE FIXING:
@@ -4632,16 +4738,17 @@ releases. You are kindly invited to participate in beta testing. Subscribe
to above mailing lists by sending an email to <reto@gnu.org>.
VHDL Mode is officially distributed at
-URL `http://opensource.ethz.ch/emacs/vhdl-mode.html'
+http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
where the latest version can be found.
Known problems:
---------------
-- Indentation bug in simultaneous if- and case-statements (VHDL-AMS).
- XEmacs: Incorrect start-up when automatically opening speedbar.
- XEmacs: Indentation in XEmacs 21.4 (and higher).
+- Indentation incorrect for new 'postponed' VHDL keyword.
+- Indentation incorrect for 'protected body' construct.
The VHDL Mode Authors
@@ -4764,7 +4871,7 @@ Key bindings:
;;; Keywords and standardized words
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defconst vhdl-93-keywords
+(defconst vhdl-02-keywords
'(
"abs" "access" "after" "alias" "all" "and" "architecture" "array"
"assert" "attribute"
@@ -4779,7 +4886,7 @@ Key bindings:
"map" "mod"
"nand" "new" "next" "nor" "not" "null"
"of" "on" "open" "or" "others" "out"
- "package" "port" "postponed" "procedure" "process" "pure"
+ "package" "port" "postponed" "procedure" "process" "protected" "pure"
"range" "record" "register" "reject" "rem" "report" "return"
"rol" "ror"
"select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype"
@@ -4789,7 +4896,7 @@ Key bindings:
"wait" "when" "while" "with"
"xnor" "xor"
)
- "List of VHDL'93 keywords.")
+ "List of VHDL'02 keywords.")
(defconst vhdl-ams-keywords
'(
@@ -4822,7 +4929,7 @@ Key bindings:
)
"List of Verilog keywords as candidate for additional reserved words.")
-(defconst vhdl-93-types
+(defconst vhdl-02-types
'(
"boolean" "bit" "bit_vector" "character" "severity_level" "integer"
"real" "time" "natural" "positive" "string" "line" "text" "side"
@@ -4830,25 +4937,72 @@ Key bindings:
"std_logic" "std_logic_vector"
"std_ulogic" "std_ulogic_vector"
)
- "List of VHDL'93 standardized types.")
+ "List of VHDL'02 standardized types.")
(defconst vhdl-ams-types
+ ;; standards: IEEE Std 1076.1-2007, IEEE Std 1076.1.1-2004
'(
+ ;; package `standard'
"domain_type" "real_vector"
- ;; from `nature_pkg' package
- "voltage" "current" "electrical" "position" "velocity" "force"
- "mechanical_vf" "mechanical_pf" "rotvel" "torque" "rotational"
- "pressure" "flowrate" "fluid"
- )
+ ;; package `energy_systems'
+ "energy" "power" "periodicity" "real_across" "real_through" "unspecified"
+ "unspecified_vector" "energy_vector" "power_vector" "periodicity_vector"
+ "real_across_vector" "real_through_vector"
+ ;; package `electrical_systems'
+ "voltage" "current" "charge" "resistance" "conductance" "capacitance"
+ "mmf" "electric_flux" "electric_flux_density" "electric_field_strength"
+ "magnetic_flux" "magnetic_flux_density" "magnetic_field_strength"
+ "inductance" "reluctance" "electrical" "electrical_vector" "magnetic"
+ "magnetic_vector" "voltage_vector" "current_vector" "mmf_vector"
+ "magnetic_flux_vector" "charge_vector" "resistance_vector"
+ "conductance_vector" "capacitance_vector" "electric_flux_vector"
+ "electric_flux_density_vector" "electric_field_strength_vector"
+ "magnetic_flux_density_vector" "magnetic_field_strength_vector"
+ "inductance_vector" "reluctance_vector" "ground"
+ ;; package `mechanical_systems'
+ "displacement" "force" "velocity" "acceleration" "mass" "stiffness"
+ "damping" "momentum" "angle" "torque" "angular_velocity"
+ "angular_acceleration" "moment_inertia" "angular_momentum"
+ "angular_stiffness" "angular_damping" "translational"
+ "translational_vector" "translational_velocity"
+ "translational_velocity_vector" "rotational" "rotational_vector"
+ "rotational_velocity" "rotational_velocity_vector" "displacement_vector"
+ "force_vector" "velocity_vector" "force_velocity_vector" "angle_vector"
+ "torque_vector" "angular_velocity_vector" "torque_velocity_vector"
+ "acceleration_vector" "mass_vector" "stiffness_vector" "damping_vector"
+ "momentum_vector" "angular_acceleration_vector" "moment_inertia_vector"
+ "angular_momentum_vector" "angular_stiffness_vector"
+ "angular_damping_vector" "anchor" "translational_v_ref"
+ "rotational_v_ref" "translational_v" "rotational_v"
+ ;; package `radiant_systems'
+ "illuminance" "luminous_flux" "luminous_intensity" "irradiance" "radiant"
+ "radiant_vector" "luminous_intensity_vector" "luminous_flux_vector"
+ "illuminance_vector" "irradiance_vector"
+ ;; package `thermal_systems'
+ "temperature" "heat_flow" "thermal_capacitance" "thermal_resistance"
+ "thermal_conductance" "thermal" "thermal_vector" "temperature_vector"
+ "heat_flow_vector" "thermal_capacitance_vector"
+ "thermal_resistance_vector" "thermal_conductance_vector"
+ ;; package `fluidic_systems'
+ "pressure" "vflow_rate" "mass_flow_rate" "volume" "density" "viscosity"
+ "fresistance" "fconductance" "fcapacitance" "inertance" "cfresistance"
+ "cfcapacitance" "cfinertance" "cfconductance" "fluidic" "fluidic_vector"
+ "compressible_fluidic" "compressible_fluidic_vector" "pressure_vector"
+ "vflow_rate_vector" "mass_flow_rate_vector" "volume_vector"
+ "density_vector" "viscosity_vector" "fresistance_vector"
+ "fconductance_vector" "fcapacitance_vector" "inertance_vector"
+ "cfresistance_vector" "cfconductance_vector" "cfcapacitance_vector"
+ "cfinertance_vector"
+ )
"List of VHDL-AMS standardized types.")
(defconst vhdl-math-types
'(
- "complex" "complex_polar"
+ "complex" "complex_polar" "positive_real" "principal_value"
)
"List of Math Packages standardized types.")
-(defconst vhdl-93-attributes
+(defconst vhdl-02-attributes
'(
"base" "left" "right" "high" "low" "pos" "val" "succ"
"pred" "leftof" "rightof" "range" "reverse_range"
@@ -4858,7 +5012,7 @@ Key bindings:
"simple_name" "instance_name" "path_name"
"foreign"
)
- "List of VHDL'93 standardized attributes.")
+ "List of VHDL'02 standardized attributes.")
(defconst vhdl-ams-attributes
'(
@@ -4869,7 +5023,7 @@ Key bindings:
)
"List of VHDL-AMS standardized attributes.")
-(defconst vhdl-93-enum-values
+(defconst vhdl-02-enum-values
'(
"true" "false"
"note" "warning" "error" "failure"
@@ -4878,7 +5032,7 @@ Key bindings:
"fs" "ps" "ns" "us" "ms" "sec" "min" "hr"
"right" "left"
)
- "List of VHDL'93 standardized enumeration values.")
+ "List of VHDL'02 standardized enumeration values.")
(defconst vhdl-ams-enum-values
'(
@@ -4888,22 +5042,38 @@ Key bindings:
)
"List of VHDL-AMS standardized enumeration values.")
+(defconst vhdl-ams-constants
+ ;; standard: IEEE Std 1076.1.1-2004
+ '(
+ ;; package `fundamental_constants'
+ "phys_q" "phys_eps0" "phys_mu0" "phys_k" "phys_gravity" "phys_ctok"
+ "phys_c" "phys_h" "phys_h_over_2_pi" "yocto" "zepto" "atto" "femto"
+ "pico" "nano" "micro" "milli" "centi" "deci" "deka" "hecto" "kilo" "mega"
+ "giga" "tera" "peta" "exa" "zetta" "yotta" "deca"
+ ;; package `material_constants'
+ "phys_eps_si" "phys_eps_sio2" "phys_e_si" "phys_e_sio2" "phys_e_poly"
+ "phys_nu_si" "phys_nu_poly" "phys_rho_poly" "phys_rho_sio2"
+ "ambient_temperature" "ambient_pressure" "ambient_illuminance"
+ )
+ "List of VHDL-AMS standardized constants.")
+
(defconst vhdl-math-constants
+ ;; standard: IEEE Std 1076.2-1996
'(
- "math_e" "math_1_over_e"
- "math_pi" "math_two_pi" "math_1_over_pi"
- "math_half_pi" "math_q_pi" "math_3_half_pi"
- "math_log_of_2" "math_log_of_10" "math_log2_of_e" "math_log10_of_e"
- "math_sqrt2" "math_sqrt1_2" "math_sqrt_pi"
- "math_deg_to_rad" "math_rad_to_deg"
- "cbase_1" "cbase_j" "czero"
+ "math_1_over_e" "math_1_over_pi" "math_1_over_sqrt_2" "math_2_pi"
+ "math_3_pi_over_2" "math_cbase_1" "math_cbase_j" "math_czero"
+ "math_deg_to_rad" "math_e" "math_log10_of_e" "math_log2_of_e"
+ "math_log_of_10" "math_log_of_2" "math_pi" "math_pi_over_2"
+ "math_pi_over_3" "math_pi_over_4" "math_rad_to_deg" "math_sqrt_2"
+ "math_sqrt_pi"
)
"List of Math Packages standardized constants.")
-(defconst vhdl-93-functions
+(defconst vhdl-02-functions
'(
"now" "resolved" "rising_edge" "falling_edge"
- "read" "readline" "write" "writeline" "endfile"
+ "read" "readline" "hread" "oread" "write" "writeline" "hwrite" "owrite"
+ "endfile"
"resize" "is_X" "std_match"
"shift_left" "shift_right" "rotate_left" "rotate_right"
"to_unsigned" "to_signed" "to_integer"
@@ -4913,25 +5083,27 @@ Key bindings:
"shl" "shr" "ext" "sxt"
"deallocate"
)
- "List of VHDL'93 standardized functions.")
+ "List of VHDL'02 standardized functions.")
(defconst vhdl-ams-functions
'(
+ ;; package `standard'
"frequency"
)
"List of VHDL-AMS standardized functions.")
(defconst vhdl-math-functions
+ ;; standard: IEEE Std 1076.2-1996
'(
- "sign" "ceil" "floor" "round" "trunc" "fmax" "fmin" "uniform"
- "sqrt" "cbrt" "exp" "log"
- "sin" "cos" "tan" "arcsin" "arccos" "arctan"
- "sinh" "cosh" "tanh" "arcsinh" "arccosh" "arctanh"
- "cmplx" "complex_to_polar" "polar_to_complex" "arg" "conj"
+ "arccos" "arccosh" "arcsin" "arcsinh" "arctan" "arctanh" "arg"
+ "cbrt" "ceil" "cmplx" "complex_to_polar" "conj" "cos" "cosh" "exp"
+ "floor" "get_principal_value" "log" "log10" "log2" "polar_to_complex"
+ "realmax" "realmin" "round" "sign" "sin" "sinh" "sqrt"
+ "tan" "tanh" "trunc" "uniform"
)
"List of Math Packages standardized functions.")
-(defconst vhdl-93-packages
+(defconst vhdl-02-packages
'(
"std_logic_1164" "numeric_std" "numeric_bit"
"standard" "textio"
@@ -4939,12 +5111,13 @@ Key bindings:
"std_logic_misc" "std_logic_textio"
"ieee" "std" "work"
)
- "List of VHDL'93 standardized packages and libraries.")
+ "List of VHDL'02 standardized packages and libraries.")
(defconst vhdl-ams-packages
'(
- ;; from `nature_pkg' package
- "nature_pkg"
+ "fundamental_constants" "material_constants" "energy_systems"
+ "electrical_systems" "mechanical_systems" "radiant_systems"
+ "thermal_systems" "fluidic_systems"
)
"List of VHDL-AMS standardized packages and libraries.")
@@ -4990,6 +5163,9 @@ Key bindings:
(defvar vhdl-enum-values-regexp nil
"Regexp for VHDL standardized enumeration values.")
+(defvar vhdl-constants-regexp nil
+ "Regexp for VHDL standardized constants.")
+
(defvar vhdl-functions-regexp nil
"Regexp for VHDL standardized functions.")
@@ -5002,29 +5178,50 @@ Key bindings:
(defvar vhdl-directive-keywords-regexp nil
"Regexp for compiler directive keywords.")
+(defun vhdl-upcase-list (condition list)
+ "Upcase all elements in LIST based on CONDITION."
+ (when condition
+ (let ((tmp-list list))
+ (while tmp-list
+ (setcar tmp-list (upcase (car tmp-list)))
+ (setq tmp-list (cdr tmp-list)))))
+ list)
+
(defun vhdl-words-init ()
"Initialize reserved words."
(setq vhdl-keywords
- (append vhdl-93-keywords
- (when (vhdl-standard-p 'ams) vhdl-ams-keywords)))
+ (vhdl-upcase-list
+ (and vhdl-highlight-case-sensitive vhdl-upper-case-keywords)
+ (append vhdl-02-keywords
+ (when (vhdl-standard-p 'ams) vhdl-ams-keywords))))
(setq vhdl-types
- (append vhdl-93-types
- (when (vhdl-standard-p 'ams) vhdl-ams-types)
- (when (vhdl-standard-p 'math) vhdl-math-types)))
+ (vhdl-upcase-list
+ (and vhdl-highlight-case-sensitive vhdl-upper-case-types)
+ (append vhdl-02-types
+ (when (vhdl-standard-p 'ams) vhdl-ams-types)
+ (when (vhdl-standard-p 'math) vhdl-math-types))))
(setq vhdl-attributes
- (append vhdl-93-attributes
- (when (vhdl-standard-p 'ams) vhdl-ams-attributes)))
+ (vhdl-upcase-list
+ (and vhdl-highlight-case-sensitive vhdl-upper-case-attributes)
+ (append vhdl-02-attributes
+ (when (vhdl-standard-p 'ams) vhdl-ams-attributes))))
(setq vhdl-enum-values
- (append vhdl-93-enum-values
- (when (vhdl-standard-p 'ams) vhdl-ams-enum-values)))
+ (vhdl-upcase-list
+ (and vhdl-highlight-case-sensitive vhdl-upper-case-enum-values)
+ (append vhdl-02-enum-values
+ (when (vhdl-standard-p 'ams) vhdl-ams-enum-values))))
(setq vhdl-constants
- (append (when (vhdl-standard-p 'math) vhdl-math-constants)))
+ (vhdl-upcase-list
+ (and vhdl-highlight-case-sensitive vhdl-upper-case-constants)
+ (append (when (vhdl-standard-p 'ams) vhdl-ams-constants)
+ (when (vhdl-standard-p 'math) vhdl-math-constants)
+ '(""))))
(setq vhdl-functions
- (append vhdl-93-functions
+ (append vhdl-02-functions
(when (vhdl-standard-p 'ams) vhdl-ams-functions)
(when (vhdl-standard-p 'math) vhdl-math-functions)))
(setq vhdl-packages
- (append vhdl-93-packages
+ (append vhdl-02-packages
(when (vhdl-standard-p 'ams) vhdl-ams-packages)
(when (vhdl-standard-p 'math) vhdl-math-packages)))
(setq vhdl-reserved-words
@@ -5039,6 +5236,8 @@ Key bindings:
(concat "\\<\\(" (regexp-opt vhdl-attributes) "\\)\\>"))
(setq vhdl-enum-values-regexp
(concat "\\<\\(" (regexp-opt vhdl-enum-values) "\\)\\>"))
+ (setq vhdl-constants-regexp
+ (concat "\\<\\(" (regexp-opt vhdl-constants) "\\)\\>"))
(setq vhdl-functions-regexp
(concat "\\<\\(" (regexp-opt vhdl-functions) "\\)\\>"))
(setq vhdl-packages-regexp
@@ -5090,7 +5289,7 @@ We cannot use just `word' syntax class since `_' cannot be in word
class. Putting underscore in word class breaks forward word movement
behavior that users are familiar with.")
-(defconst vhdl-case-header-key "case[( \t\n][^;=>]+[) \t\n]is"
+(defconst vhdl-case-header-key "case[( \t\n\r\f][^;=>]+[) \t\n\r\f]is"
"Regexp describing a case statement header key.")
(defconst vhdl-label-key
@@ -5318,6 +5517,17 @@ the offset is simply returned."
"Check if point is in a string."
(eq (vhdl-in-literal) 'string))
+(defun vhdl-in-quote-p ()
+ "Check if point is in a quote ('x')."
+ (or (and (> (point) (point-min))
+ (< (1+ (point)) (point-max))
+ (= (char-before (point)) ?\')
+ (= (char-after (1+ (point))) ?\'))
+ (and (> (1- (point)) (point-min))
+ (< (point) (point-max))
+ (= (char-before (1- (point))) ?\')
+ (= (char-after (point)) ?\'))))
+
(defun vhdl-in-literal ()
"Determine if point is in a VHDL literal."
(save-excursion
@@ -5328,6 +5538,12 @@ the offset is simply returned."
((vhdl-beginning-of-macro) 'pound)
(t nil)))))
+(defun vhdl-in-extended-identifier-p ()
+ "Determine if point is inside extended identifier (delimited by '\')."
+ (save-match-data
+ (and (save-excursion (re-search-backward "\\\\" (vhdl-point 'bol) t))
+ (save-excursion (re-search-forward "\\\\" (vhdl-point 'eol) t)))))
+
(defun vhdl-forward-comment (&optional direction)
"Skip all comments (including whitespace). Skip backwards if DIRECTION is
negative, skip forward otherwise."
@@ -5335,20 +5551,30 @@ negative, skip forward otherwise."
(if (and direction (< direction 0))
;; skip backwards
(progn
- (skip-chars-backward " \t\n")
+ (skip-chars-backward " \t\n\r\f")
(while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t)
(goto-char (match-beginning 3))
- (skip-chars-backward " \t\n")))
+ (skip-chars-backward " \t\n\r\f")))
;; skip forwards
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(while (looking-at "--.*")
(goto-char (match-end 0))
- (skip-chars-forward " \t\n"))))
+ (skip-chars-forward " \t\n\r\f"))))
;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
(unless (and (featurep 'xemacs) (string< "21.2" emacs-version))
(defalias 'vhdl-forward-comment 'forward-comment))
+(defun vhdl-back-to-indentation ()
+ "Move point to the first non-whitespace character on this line."
+ (interactive)
+ (beginning-of-line 1)
+ (skip-syntax-forward " " (vhdl-point 'eol)))
+
+;; XEmacs hack: work around old `back-to-indentation' in XEmacs
+(when (featurep 'xemacs)
+ (defalias 'back-to-indentation 'vhdl-back-to-indentation))
+
;; This is the best we can do in Win-Emacs.
(defun vhdl-win-il (&optional lim)
"Determine if point is in a VHDL literal."
@@ -5513,7 +5739,7 @@ that point, else nil."
(and
(save-excursion
(forward-sexp)
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(not (looking-at "is\\b[^_]")))
(save-excursion
(backward-sexp)
@@ -5553,12 +5779,12 @@ corresponding \"begin\" keyword, else return nil."
"is"))))
(defconst vhdl-begin-fwd-re
- "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\|units\\|record\\|for\\)\\b\\([^_]\\|\\'\\)"
+ "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b\\([^_]\\|\\'\\)"
"A regular expression for searching forward that matches all known
\"begin\" keywords.")
(defconst vhdl-begin-bwd-re
- "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\|units\\|record\\|for\\)\\b[^_]"
+ "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b[^_]"
"A regular expression for searching backward that matches all known
\"begin\" keywords.")
@@ -5591,21 +5817,21 @@ keyword."
(and (/= (following-char) ?\;)
(not (looking-at "is\\|begin\\|process\\|procedural\\|block")))))
t)
- ;; "begin", "then":
- ((looking-at "be\\|t")
+ ;; "begin", "then", "use":
+ ((looking-at "be\\|t\\|use")
t)
;; "else":
((and (looking-at "e")
;; make sure that the "else" isn't inside a
;; conditional signal assignment.
(save-excursion
- (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
+ (vhdl-re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
(or (eq (following-char) ?\;)
(eq (point) lim))))
t)
;; "block", "generate", "loop", "process", "procedural",
- ;; "units", "record":
- ((and (looking-at "bl\\|[glpur]")
+ ;; "units", "record", "protected body":
+ ((and (looking-at "block\\|generate\\|loop\\|process\\|procedural\\|protected\\(\\s-+body\\)?\\|units\\|record")
(save-excursion
(backward-sexp)
(not (looking-at "end\\s-+\\w"))))
@@ -5633,7 +5859,7 @@ keyword."
(cond
((looking-at "is\\|block\\|generate\\|process\\|procedural")
"begin")
- ((looking-at "then")
+ ((looking-at "then\\|use")
"<else>")
(t
"end")))
@@ -5648,6 +5874,9 @@ Assumes that the caller will make sure that we are not in the middle
of an identifier that just happens to contain a \"begin\" keyword."
(save-excursion
(and (looking-at vhdl-begin-fwd-re)
+ (or (not (looking-at "\\<use\\>"))
+ (save-excursion (back-to-indentation)
+ (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
(/= (preceding-char) ?_)
(not (vhdl-in-literal))
(vhdl-begin-p lim)
@@ -5670,8 +5899,8 @@ of an identifier that just happens to contain a \"begin\" keyword."
(vhdl-beginning-of-statement-1 lim)
(vhdl-backward-skip-label lim)
(vhdl-first-word (point)))))))
- ;; "component", "units", "record":
- ((looking-at "[cur]")
+ ;; "component", "units", "record", "protected body":
+ ((looking-at "component\\|units\\|protected\\(\\s-+body\\)?\\|record")
;; The first end found will close the block
(vector "end" nil))
;; "block", "process", "procedural":
@@ -5683,8 +5912,8 @@ of an identifier that just happens to contain a \"begin\" keyword."
(vhdl-backward-skip-label lim)
(vhdl-first-word (point))))))
;; "then":
- ((looking-at "t")
- (vector "elsif\\|else\\|end\\s-+if"
+ ((looking-at "t\\|use")
+ (vector "elsif\\|else\\|end\\s-+\\(if\\|use\\)"
(and (vhdl-last-word (point))
(or (vhdl-first-word (point))
(save-excursion
@@ -5730,25 +5959,25 @@ of an identifier that just happens to contain an \"end\" keyword."
(vhdl-end-p lim))
(if (looking-at "el")
;; "else", "elsif":
- (vector "if\\|elsif" (vhdl-first-word (point)) "then" nil)
+ (vector "if\\|elsif" (vhdl-first-word (point)) "then\\|use" nil)
;; "end ...":
(setq pos (point))
(forward-sexp)
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(cond
;; "end if":
((looking-at "if\\b[^_]")
(vector "else\\|elsif\\|if"
(vhdl-first-word pos)
- "else\\|then" nil))
+ "else\\|then\\|use" nil))
;; "end component":
((looking-at "component\\b[^_]")
(vector (buffer-substring (match-beginning 1)
(match-end 1))
(vhdl-first-word pos)
nil nil))
- ;; "end units", "end record":
- ((looking-at "\\(units\\|record\\)\\b[^_]")
+ ;; "end units", "end record", "end protected":
+ ((looking-at "\\(units\\|record\\|protected\\(\\s-+body\\)?\\)\\b[^_]")
(vector (buffer-substring (match-beginning 1)
(match-end 1))
(vhdl-first-word pos)
@@ -5805,38 +6034,38 @@ of an identifier that just happens to contain an \"end\" keyword."
(cond ((looking-at "block\\|process\\|procedural")
(if (save-excursion
(forward-sexp)
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(= (following-char) ?\())
(forward-sexp 2)
(forward-sexp))
- (when (looking-at "[ \t\n]*is")
+ (when (looking-at "[ \t\n\r\f]*is")
(goto-char (match-end 0)))
(point))
((looking-at "component")
(forward-sexp 2)
- (when (looking-at "[ \t\n]*is")
+ (when (looking-at "[ \t\n\r\f]*is")
(goto-char (match-end 0)))
(point))
((looking-at "for")
(forward-sexp 2)
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(while (looking-at "[,:(]")
(forward-sexp)
- (skip-chars-forward " \t\n"))
+ (skip-chars-forward " \t\n\r\f"))
(point))
(t nil)
)))
(defconst vhdl-trailer-re
- "\\b\\(is\\|then\\|generate\\|loop\\|record\\)\\b[^_]")
+ "\\b\\(is\\|then\\|generate\\|loop\\|record\\|protected\\(\\s-+body\\)?\\|use\\)\\b[^_]")
(defconst vhdl-statement-fwd-re
- "\\b\\(if\\|for\\|while\\)\\b\\([^_]\\|\\'\\)"
+ "\\b\\(if\\|for\\|while\\|loop\\)\\b\\([^_]\\|\\'\\)"
"A regular expression for searching forward that matches all known
\"statement\" keywords.")
(defconst vhdl-statement-bwd-re
- "\\b\\(if\\|for\\|while\\)\\b[^_]"
+ "\\b\\(if\\|for\\|while\\|loop\\)\\b[^_]"
"A regular expression for searching backward that matches all known
\"statement\" keywords.")
@@ -5852,7 +6081,7 @@ in the middle of an identifier that just happens to contain a
;; Make sure it's the start of a parameter specification.
(save-excursion
(forward-sexp 2)
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(looking-at "in\\b[^_]"))
;; Make sure it's not an "end for".
(save-excursion
@@ -5871,7 +6100,7 @@ in the middle of an identifier that just happens to contain a
t)
))
-(defconst vhdl-case-alternative-re "when[( \t\n][^;=>]+=>"
+(defconst vhdl-case-alternative-re "when[( \t\n\r\f][^;=>]+=>"
"Regexp describing a case statement alternative key.")
(defun vhdl-case-alternative-p (&optional lim)
@@ -5908,6 +6137,9 @@ contain a \"when\" keyword."
(cond
;; "begin" keyword:
((and (looking-at vhdl-begin-fwd-re)
+ (or (not (looking-at "\\<use\\>"))
+ (save-excursion (back-to-indentation)
+ (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
(/= (preceding-char) ?_)
(vhdl-begin-p lim))
(setq foundp 'begin))
@@ -5931,7 +6163,7 @@ With COUNT, do it that many times."
(save-excursion
(while (> count 0)
;; skip whitespace
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
;; Check for an unbalanced "end" keyword
(if (and (looking-at vhdl-end-fwd-re)
(/= (preceding-char) ?_)
@@ -6007,6 +6239,10 @@ searches."
nil
(backward-sexp)
(if (and (looking-at vhdl-begin-fwd-re)
+ (or (not (looking-at "\\<use\\>"))
+ (save-excursion
+ (back-to-indentation)
+ (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
(/= (preceding-char) ?_)
(not (vhdl-in-literal))
(vhdl-begin-p lim))
@@ -6278,7 +6514,7 @@ search, and an argument indicating an interactive call."
(re-search-forward vhdl-e-o-s-re))
(defconst vhdl-b-o-s-re
- (concat ";\\|\(\\|\)\\|\\bwhen\\b[^_]\\|"
+ (concat ";[^_]\\|\([^_]\\|\)[^_]\\|\\bwhen\\b[^_]\\|"
vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re))
(defun vhdl-beginning-of-statement-1 (&optional lim)
@@ -6299,7 +6535,7 @@ statement if already at the beginning of one."
(while (and (not donep)
(not (bobp))
;; look backwards for a statement boundary
- (re-search-backward vhdl-b-o-s-re lim 'move))
+ (progn (forward-char) (re-search-backward vhdl-b-o-s-re lim 'move)))
(if (or (= (preceding-char) ?_)
(vhdl-in-literal))
(backward-char)
@@ -6319,13 +6555,17 @@ statement if already at the beginning of one."
(vhdl-forward-syntactic-ws here)
(setq donep t))))
;; If we are looking at a semicolon, then stop
- ((eq (following-char) ?\;)
+ ((and (eq (following-char) ?\;) (not (vhdl-in-quote-p)))
(progn
(forward-char)
(vhdl-forward-syntactic-ws here)
(setq donep t)))
;; If we are looking at a "begin", then stop
((and (looking-at vhdl-begin-fwd-re)
+ (or (not (looking-at "\\<use\\>"))
+ (save-excursion
+ (back-to-indentation)
+ (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
(/= (preceding-char) ?_)
(vhdl-begin-p nil))
;; If it's a leader "begin", then find the
@@ -6576,6 +6816,10 @@ is not moved."
(setq begin-after-ip (and
(not literal)
(looking-at vhdl-begin-fwd-re)
+ (or (not (looking-at "\\<use\\>"))
+ (save-excursion
+ (back-to-indentation)
+ (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
(vhdl-begin-p)))
(setq end-after-ip (and
(not literal)
@@ -6624,7 +6868,8 @@ is not moved."
((progn
(vhdl-backward-syntactic-ws lim)
(or (bobp)
- (= (preceding-char) ?\;)))
+ (and (= (preceding-char) ?\;)
+ (not (vhdl-in-quote-p)))))
(vhdl-add-syntax 'statement placeholder))
;; CASE 2D: we are looking at a top-level statement-cont
(t
@@ -6662,6 +6907,10 @@ is not moved."
(save-excursion
(vhdl-beginning-of-statement-1 containing-sexp)
(skip-chars-backward " \t(")
+ (while (and (= (preceding-char) ?\;)
+ (not (vhdl-in-quote-p)))
+ (vhdl-beginning-of-statement-1 containing-sexp)
+ (skip-chars-backward " \t("))
(<= (point) containing-sexp)))
(goto-char containing-sexp)
(vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi)))
@@ -6891,7 +7140,7 @@ only-lines."
(let* ((relpos (cdr langelem))
(assignp (save-excursion
(goto-char (vhdl-point 'boi))
- (and (re-search-forward "\\(<\\|:\\)="
+ (and (re-search-forward "\\(<\\|:\\|=\\)="
(vhdl-point 'eol) t)
(- (point) (vhdl-point 'boi)))))
(curcol (progn
@@ -6900,7 +7149,7 @@ only-lines."
foundp)
(while (and (not foundp)
(< (point) (vhdl-point 'eol)))
- (re-search-forward "\\(<\\|:\\)=\\|(" (vhdl-point 'eol) 'move)
+ (re-search-forward "\\(<\\|:\\|=\\)=\\|(" (vhdl-point 'eol) 'move)
(if (vhdl-in-literal)
(forward-char)
(if (= (preceding-char) ?\()
@@ -7001,7 +7250,8 @@ character is a space."
(interactive)
(if (and (= (preceding-char) ? ) (vhdl-in-comment-p))
(indent-new-comment-line)
- (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))
+ (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)
+ (not (vhdl-in-comment-p)))
(vhdl-fix-case-word -1))
(newline-and-indent)))
@@ -7011,6 +7261,7 @@ indentation change."
(interactive)
(let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context)))
(pos (- (point-max) (point)))
+ (is-comment nil)
(indent
(if syntax
;; indent syntax-based
@@ -7018,6 +7269,15 @@ indentation change."
(>= (vhdl-get-offset (car syntax)) comment-column))
;; special case: comments at or right of comment-column
(vhdl-get-offset (car syntax))
+ ;; align comments like following code line
+ (when vhdl-indent-comment-like-next-code-line
+ (save-excursion
+ (while (eq (caar syntax) 'comment)
+ (setq is-comment t)
+ (beginning-of-line 2)
+ (setq syntax (vhdl-get-syntactic-context)))))
+ (when is-comment
+ (setq syntax (cons (cons 'comment nil) syntax)))
(apply '+ (mapcar 'vhdl-get-offset syntax)))
;; indent like previous nonblank line
(save-excursion (beginning-of-line)
@@ -7026,10 +7286,13 @@ indentation change."
(shift-amt (- indent (current-indentation))))
(and vhdl-echo-syntactic-information-p
(message "syntax: %s, indent= %d" syntax indent))
- (unless (zerop shift-amt)
- (delete-region (vhdl-point 'bol) (vhdl-point 'boi))
- (beginning-of-line)
- (indent-to indent))
+ (let ((has-formfeed
+ (save-excursion (beginning-of-line) (looking-at "\\s-*\f"))))
+ (when (or (not (zerop shift-amt)) has-formfeed)
+ (delete-region (vhdl-point 'bol) (vhdl-point 'boi))
+ (beginning-of-line)
+ (when has-formfeed (insert "\f"))
+ (indent-to indent)))
(if (< (point) (vhdl-point 'boi))
(back-to-indentation)
;; If initial point was within line's indentation, position after
@@ -7040,7 +7303,7 @@ indentation change."
(vhdl-update-progress-info "Indenting" (vhdl-current-line))
shift-amt))
-(defun vhdl-indent-region (beg end column)
+(defun vhdl-indent-region (beg end &optional column)
"Indent region as VHDL code.
Adds progress reporting to `indent-region'."
(interactive "r\nP")
@@ -7055,7 +7318,7 @@ Adds progress reporting to `indent-region'."
"Indent whole buffer as VHDL code.
Calls `indent-region' for whole buffer and adds progress reporting."
(interactive)
- (vhdl-indent-region (point-min) (point-max) nil))
+ (vhdl-indent-region (point-min) (point-max)))
(defun vhdl-indent-group ()
"Indent group of lines between empty lines."
@@ -7068,7 +7331,7 @@ Calls `indent-region' for whole buffer and adds progress reporting."
(if (re-search-forward vhdl-align-group-separate nil t)
(point-marker)
(point-max-marker)))))
- (vhdl-indent-region beg end nil)))
+ (vhdl-indent-region beg end)))
(defun vhdl-indent-sexp (&optional endpos)
"Indent each line of the list starting just after point.
@@ -7131,21 +7394,23 @@ ENDPOS is encountered."
(defconst vhdl-align-alist
'(
;; after some keywords
- (vhdl-mode "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)[ \t]"
- "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)\\([ \t]+\\)" 2)
+ (vhdl-mode "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)[ \t]"
+ "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)\\([ \t]+\\)" 2)
;; before ':'
(vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]")
;; after direction specifications
(vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>"
":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2)
;; before "==", ":=", "=>", and "<="
- (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "<= ... =>" can occur
+ (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "<= ... =>" can occur
(vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
- (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "=> ... <=" can occur
+ (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "=> ... <=" can occur
;; before some keywords
(vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1)
(vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1)
(vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1)
+ (vhdl-mode "[ \t]across\\>" "[^ \t]\\([ \t]+\\)across\\>" 1)
+ (vhdl-mode "[ \t]through\\>" "[^ \t]\\([ \t]+\\)through\\>" 1)
;; before "=>" since "when/else ... =>" can occur
(vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
)
@@ -7195,7 +7460,7 @@ parentheses."
(forward-list)
(setq end (point))
(goto-char (1+ beg))
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(setq beg (point))))
;; run FUNCTION
(if beg
@@ -7280,8 +7545,14 @@ the token in MATCH."
bol (setq begin (progn (beginning-of-line) (point))))
(while (< bol end)
(save-excursion
- (when (and (re-search-forward match eol t)
- (not (vhdl-in-literal)))
+ (when (and (vhdl-re-search-forward match eol t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (forward-char)
+ (and (not (vhdl-in-literal))
+ (not (vhdl-in-quote-p))
+ (not (vhdl-in-extended-identifier-p))))
+ (not (looking-at "\\s-*$")))
(setq distance (- (match-beginning substr) bol))
(when (> distance max)
(setq max distance))))
@@ -7295,8 +7566,16 @@ the token in MATCH."
(goto-char (setq bol begin))
(setq eol (point-at-eol))
(while (> lines 0)
- (when (and (re-search-forward match eol t)
- (not (vhdl-in-literal)))
+ (when (and (vhdl-re-search-forward match eol t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (forward-char)
+ (and (not (vhdl-in-literal))
+ (not (vhdl-in-quote-p))
+ (not (vhdl-in-extended-identifier-p))))
+ (not (looking-at "\\s-*$"))
+ (> (match-beginning 0) ; not if at boi
+ (save-excursion (back-to-indentation) (point))))
(setq width (- (match-end substr) (match-beginning substr)))
(setq distance (- (match-beginning substr) bol))
(goto-char (match-beginning substr))
@@ -7449,7 +7728,7 @@ the token in MATCH."
;; search for comment start positions and lengths
(while (< (point) end)
(when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
- (looking-at "^\\(.*[^ \t\n-]+\\)\\s-*\\(--.*\\)$")
+ (looking-at "^\\(.*[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$")
(not (save-excursion (goto-char (match-beginning 2))
(vhdl-in-literal))))
(setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
@@ -7474,7 +7753,7 @@ the token in MATCH."
(while (< (point) end)
(setq cur-start nil)
(when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
- (or (and (looking-at "^\\(.*[^ \t\n-]+\\)\\(\\s-*\\)\\(--.*\\)$")
+ (or (and (looking-at "^\\(.*[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$")
(not (save-excursion
(goto-char (match-beginning 3))
(vhdl-in-literal))))
@@ -7582,32 +7861,35 @@ end of line, do nothing in comments and strings."
(setq end (point-marker))
;; have no space before and one space after `,' and ';'
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
(if (match-string 1)
(goto-char (match-end 1))
- (replace-match "\\3 " nil nil nil 3)))
+ (replace-match "\\3 " nil nil nil 2)))
;; have no space after `('
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\((\\)\\s-+" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t)
(if (match-string 1)
(goto-char (match-end 1))
(replace-match "\\2")))
;; have no space before `)'
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
(if (match-string 1)
(goto-char (match-end 1))
(replace-match "\\2")))
;; surround operator symbols by one space
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\(\\([^/:<>=]\\)\\(:\\|=\\|<\\|>\\|:=\\|<=\\|>=\\|=>\\|/=\\)\\([^=>]\\|$\\)\\)" end t)
- (if (match-string 1)
- (goto-char (match-end 1))
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>]\\|$\\)\\)" end t)
+ (if (or (match-string 1)
+ (<= (match-beginning 0) ; not if at boi
+ (save-excursion (back-to-indentation) (point))))
+ (goto-char (match-end 0))
(replace-match "\\3 \\4 \\5")
(goto-char (match-end 2))))
;; eliminate multiple spaces and spaces at end of line
(goto-char beg)
(while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t))
+ (and (looking-at "--.*") (re-search-forward "--.*" end t))
(and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t))
(and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t)
(progn (replace-match "" nil nil) t))
@@ -7618,6 +7900,7 @@ end of line, do nothing in comments and strings."
(progn (replace-match " " nil nil) t))
(and (looking-at "\\s-+") (re-search-forward "\\s-+" end t)
(progn (replace-match " " nil nil) t))
+ (and (looking-at "-") (re-search-forward "-" end t))
; (re-search-forward "[^ \t-]+" end t))))
(re-search-forward "[^ \t\"-]+" end t))))
(unless no-message (message "Fixing up whitespace...done")))
@@ -7639,7 +7922,7 @@ case fixing to a region. Calls functions `vhdl-indent-buffer',
`vhdl-fix-case-buffer'."
(interactive "r")
(setq end (save-excursion (goto-char end) (point-marker)))
- (vhdl-indent-region beg end nil)
+ (vhdl-indent-region beg end)
(let ((vhdl-align-groups t))
(vhdl-align-region beg end))
(vhdl-fix-case-region beg end))
@@ -7720,7 +8003,7 @@ buffer."
(vhdl-prepare-search-2
(end-of-line)
;; look whether in process
- (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t)
+ (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t)
(equal (upcase (match-string 2)) "PROCESS")
(save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t))))
(error "ERROR: Not within a process")
@@ -7735,7 +8018,7 @@ buffer."
(vhdl-prepare-search-2
(goto-char (point-min))
(message "Updating sensitivity lists...")
- (while (re-search-forward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?process\\>" nil t)
+ (while (re-search-forward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?process\\>" nil t)
(goto-char (match-beginning 0))
(condition-case nil (vhdl-update-sensitivity-list) (error "")))
(message "Updating sensitivity lists...done"))))
@@ -7744,9 +8027,13 @@ buffer."
"Update sensitivity list."
(let ((proc-beg (point))
(proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
- (proc-mid (re-search-backward "^\\s-*begin\\>" nil t))
+ (proc-mid (vhdl-re-search-backward
+ "\\(\\(\\<begin\\>\\)\\|^\\s-*process\\>\\)" nil t))
seq-region-list)
(cond
+ ;; error if 'begin' keyword missing
+ ((not (match-string 2))
+ (error "ERROR: No 'begin' keyword found"))
;; search for wait statement (no sensitivity list allowed)
((progn (goto-char proc-mid)
(vhdl-re-search-forward "\\<wait\\>" proc-end t))
@@ -7780,19 +8067,19 @@ buffer."
;; case expression
((re-search-forward "^\\s-*case\\>" proc-end t)
(re-search-forward "\\<is\\>" proc-end t))
- ;; parameter list of procedure call
- ((and (re-search-forward "^\\s-*\\w+[ \t\n]*(" proc-end t)
+ ;; parameter list of procedure call, array index
+ ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t)
(1- (point)))
(progn (backward-char) (forward-sexp)
(while (looking-at "(") (forward-sexp)) (point)))))
- name read-list sens-list signal-list
+ name field read-list sens-list signal-list
sens-beg sens-end beg end margin)
;; scan for signals in old sensitivity list
(goto-char proc-beg)
(re-search-forward "\\<process\\>" proc-mid t)
- (if (not (looking-at "[ \t\n]*("))
+ (if (not (looking-at "[ \t\n\r\f]*("))
(setq sens-beg (point))
- (setq sens-beg (re-search-forward "\\([ \t\n]*\\)([ \t\n]*" nil t))
+ (setq sens-beg (re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t))
(goto-char (match-end 1))
(forward-sexp)
(setq sens-end (1- (point)))
@@ -7825,15 +8112,17 @@ buffer."
(< (point) (caar tmp-list)))
(setq tmp-list (cdr tmp-list)))
(and tmp-list (< (point) (cdar tmp-list))))))
- (while (vhdl-re-search-forward "[^'\"]\\<\\([a-zA-Z]\\w*\\)\\>[ \t\n]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t)
+ (while (vhdl-re-search-forward "[^'\".]\\<\\([a-zA-Z]\\w*\\)\\(\\(\\.\\w+\\|[ \t\n\r\f]*([^)]*)\\)*\\)[ \t\n\r\f]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t)
(setq name (match-string 1))
- (when (and (not (match-string 4)) ; not when formal parameter
- (not (and (match-string 3) ; not event attribute
- (not (member (downcase (match-string 3))
+ (when vhdl-array-index-record-field-in-sensitivity-list
+ (setq field (match-string 2)))
+ (when (and (not (match-string 6)) ; not when formal parameter
+ (not (and (match-string 5) ; not event attribute
+ (not (member (downcase (match-string 5))
'("event" "last_event" "transaction")))))
(member (downcase name) signal-list))
- (unless (member-ignore-case name read-list)
- (setq read-list (cons name read-list))))
+ (unless (member-ignore-case (concat name field) read-list)
+ (setq read-list (cons (concat name field) read-list))))
(goto-char (match-end 1)))))
(setq scan-regions-list (cdr scan-regions-list)))
;; update sensitivity list
@@ -7879,17 +8168,17 @@ buffer."
(goto-char (point-min))
(if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t))
(error "ERROR: Entity \"%s\" not found:\n --> see option `vhdl-entity-file-name'" entity-name)
- (when (setq beg (re-search-forward
- "^\\s-*port[ \t\n]*("
+ (when (setq beg (vhdl-re-search-forward
+ "\\<port[ \t\n\r\f]*("
(save-excursion
(re-search-forward "^end\\>" nil t)) t))
(setq end (save-excursion
(backward-char) (forward-sexp) (point)))
(vhdl-forward-syntactic-ws)
(while (< (point) end)
- (when (looking-at "signal[ \t\n]+")
+ (when (looking-at "signal[ \t\n\r\f]+")
(goto-char (match-end 0)))
- (while (looking-at "\\(\\w+\\)[ \t\n,]+")
+ (while (looking-at "\\(\\w+\\)[ \t\n\r\f,]+")
(setq signal-list
(cons (downcase (match-string 1)) signal-list))
(goto-char (match-end 0))
@@ -7908,12 +8197,12 @@ buffer."
(when (= 0 (nth 0 (parse-partial-sexp beg (point))))
(if (match-string 2)
;; scan signal name
- (while (looking-at "[ \t\n,]+\\(\\w+\\)")
+ (while (looking-at "[ \t\n\r\f,]+\\(\\w+\\)")
(setq signal-list
(cons (downcase (match-string 1)) signal-list))
(goto-char (match-end 0)))
;; scan alias name, check is alias of (declared) signal
- (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)")
+ (when (and (looking-at "[ \t\n\r\f]+\\(\\w+\\)[^;]*\\<is[ \t\n\r\f]+\\(\\w+\\)")
(member (downcase (match-string 2)) signal-list))
(setq signal-list
(cons (downcase (match-string 1)) signal-list))
@@ -7950,6 +8239,18 @@ buffer."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Generic/port clause fixing
+(defun vhdl-fix-clause-buffer ()
+ "Fix all generic/port clauses in current buffer."
+ (interactive)
+ (save-excursion
+ (vhdl-prepare-search-2
+ (goto-char (point-min))
+ (message "Fixing generic/port clauses...")
+ (while (re-search-forward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t)
+ (goto-char (match-end 0))
+ (condition-case nil (vhdl-fix-clause) (error "")))
+ (message "Fixing generic/port clauses...done"))))
+
(defun vhdl-fix-clause ()
"Fix closing parenthesis within generic/port clause."
(interactive)
@@ -7957,13 +8258,14 @@ buffer."
(vhdl-prepare-search-2
(let ((pos (point))
beg end)
- (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n]*(" nil t))
+ (end-of-line)
+ (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t))
(error "ERROR: Not within a generic/port clause")
;; search for end of clause
(goto-char (match-end 0))
(setq beg (1- (point)))
(vhdl-forward-syntactic-ws)
- (while (looking-at "\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*[ \t\n]*:[ \t\n]*\\w+[^;]*;")
+ (while (looking-at "\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*[ \t\n\r\f]*:[ \t\n\r\f]*\\w+[^;]*;")
(goto-char (1- (match-end 0)))
(setq end (point-marker))
(forward-char)
@@ -8317,7 +8619,8 @@ is omitted or nil."
(let ((margin (current-indentation))
(start (point))
label)
- (unless kind (setq kind (if (vhdl-sequential-statement-p) 'is 'use)))
+ (unless kind (setq kind (if (or (vhdl-sequential-statement-p)
+ (not (vhdl-standard-p 'ams))) 'is 'use)))
(if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87))
(vhdl-insert-keyword "CASE ")
(vhdl-insert-keyword ": CASE ")
@@ -8905,7 +9208,7 @@ otherwise."
(vhdl-insert-keyword
(concat " " (if (eq kind 'then) "THEN" "USE") "\n\n"))
(indent-to margin)
- (vhdl-insert-keyword "END IF")
+ (vhdl-insert-keyword (concat "END " (if (eq kind 'then) "IF" "USE")))
(when label (insert " " label))
(insert ";")
(forward-line -1)
@@ -9226,6 +9529,7 @@ otherwise."
(interactive)
(let ((margin (current-indentation))
(start (point))
+ (reset-kind vhdl-reset-kind)
label seq input-signals clock reset final-pos)
(setq seq (if kind (eq kind 'seq)
(eq (vhdl-decision-query
@@ -9248,7 +9552,13 @@ otherwise."
(setq clock (or (and (not (equal "" vhdl-clock-name))
(progn (insert vhdl-clock-name) vhdl-clock-name))
(vhdl-template-field "clock name") "<clock>"))
- (when (eq vhdl-reset-kind 'async)
+ (when (eq reset-kind 'query)
+ (setq reset-kind
+ (if (eq (vhdl-decision-query
+ "" "(a)synchronous or (s)ynchronous reset?" t) ?a)
+ 'async
+ 'sync)))
+ (when (eq reset-kind 'async)
(insert ", ")
(setq reset (or (and (not (equal "" vhdl-reset-name))
(progn (insert vhdl-reset-name) vhdl-reset-name))
@@ -9257,7 +9567,7 @@ otherwise."
(unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
(insert "\n")
(vhdl-template-begin-end "PROCESS" label margin)
- (when seq (setq reset (vhdl-template-seq-process clock reset)))
+ (when seq (setq reset (vhdl-template-seq-process clock reset reset-kind)))
(when vhdl-prompt-for-comments
(setq final-pos (point-marker))
(vhdl-prepare-search-2
@@ -9589,13 +9899,13 @@ otherwise."
(in-arglist (vhdl-in-argument-list-p)))
(vhdl-prepare-search-2
(if (or (save-excursion
- (and (vhdl-re-search-backward
- "\\<function\\|procedure\\|process\\|procedural\\|end\\>"
- nil t)
- (not (progn (backward-word 1) (looking-at "\\<end\\>")))))
+ (progn (vhdl-beginning-of-block)
+ (looking-at "\\s-*\\(\\w+\\s-*:\\s-*\\)?\\<\\(\\<function\\|procedure\\|process\\|procedural\\)\\>")))
(save-excursion (backward-word 1) (looking-at "\\<shared\\>")))
(vhdl-insert-keyword "VARIABLE ")
- (vhdl-insert-keyword "SHARED VARIABLE ")))
+ (if (vhdl-standard-p '87)
+ (error "ERROR: Not within sequential block")
+ (vhdl-insert-keyword "SHARED VARIABLE "))))
(when (vhdl-template-field "names" nil t start (point))
(insert " : ")
(when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t))
@@ -9692,14 +10002,16 @@ otherwise."
(concat (if vhdl-clock-rising-edge "rising" "falling")
" clock edge")))))
-(defun vhdl-template-seq-process (clock reset)
+(defun vhdl-template-seq-process (clock reset reset-kind)
"Insert a template for the body of a sequential process."
(let ((margin (current-indentation))
position)
(vhdl-insert-keyword "IF ")
- (when (eq vhdl-reset-kind 'async)
+ (when vhdl-conditions-in-parenthesis (insert "("))
+ (when (eq reset-kind 'async)
(insert reset " = "
(if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
+ (when vhdl-conditions-in-parenthesis (insert ")"))
(vhdl-insert-keyword " THEN")
(vhdl-comment-insert-inline
(concat "asynchronous reset (active "
@@ -9707,7 +10019,8 @@ otherwise."
(insert "\n") (indent-to (+ margin vhdl-basic-offset))
(setq position (point))
(insert "\n") (indent-to margin)
- (vhdl-insert-keyword "ELSIF "))
+ (vhdl-insert-keyword "ELSIF ")
+ (when vhdl-conditions-in-parenthesis (insert "(")))
(if (eq vhdl-clock-edge-condition 'function)
(insert (if vhdl-clock-rising-edge "rising" "falling")
"_edge(" clock ")")
@@ -9715,17 +10028,20 @@ otherwise."
(vhdl-insert-keyword " AND ")
(insert clock " = "
(if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string)))
+ (when vhdl-conditions-in-parenthesis (insert ")"))
(vhdl-insert-keyword " THEN")
(vhdl-comment-insert-inline
(concat (if vhdl-clock-rising-edge "rising" "falling") " clock edge"))
(insert "\n") (indent-to (+ margin vhdl-basic-offset))
- (when (eq vhdl-reset-kind 'sync)
+ (when (eq reset-kind 'sync)
(vhdl-insert-keyword "IF ")
+ (when vhdl-conditions-in-parenthesis (insert "("))
(setq reset (or (and (not (equal "" vhdl-reset-name))
(progn (insert vhdl-reset-name) vhdl-reset-name))
(vhdl-template-field "reset name") "<reset>"))
(insert " = "
(if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
+ (when vhdl-conditions-in-parenthesis (insert ")"))
(vhdl-insert-keyword " THEN")
(vhdl-comment-insert-inline
(concat "synchronous reset (active "
@@ -9737,7 +10053,7 @@ otherwise."
(insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset)))
(insert "\n") (indent-to (+ margin vhdl-basic-offset))
(vhdl-insert-keyword "END IF;"))
- (when (eq vhdl-reset-kind 'none)
+ (when (eq reset-kind 'none)
(setq position (point)))
(insert "\n") (indent-to margin)
(vhdl-insert-keyword "END IF;")
@@ -9761,21 +10077,11 @@ specification, if not already there."
(insert library ";")
(when package
(insert "\n")
- (indent-to margin)))
- (when package
- (vhdl-insert-keyword "USE ")
- (insert library "." package)
- (vhdl-insert-keyword ".ALL;")))))
-
-(defun vhdl-template-package-math-complex ()
- "Insert specification of `math_complex' package."
- (interactive)
- (vhdl-template-standard-package "ieee" "math_complex"))
-
-(defun vhdl-template-package-math-real ()
- "Insert specification of `math_real' package."
- (interactive)
- (vhdl-template-standard-package "ieee" "math_real"))
+ (indent-to margin))))
+ (when package
+ (vhdl-insert-keyword "USE ")
+ (insert library "." package)
+ (vhdl-insert-keyword ".ALL;"))))
(defun vhdl-template-package-numeric-bit ()
"Insert specification of `numeric_bit' package."
@@ -9822,6 +10128,56 @@ specification, if not already there."
(interactive)
(vhdl-template-standard-package "std" "textio"))
+(defun vhdl-template-package-fundamental-constants ()
+ "Insert specification of `fundamental_constants' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "fundamental_constants"))
+
+(defun vhdl-template-package-material-constants ()
+ "Insert specification of `material_constants' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "material_constants"))
+
+(defun vhdl-template-package-energy-systems ()
+ "Insert specification of `energy_systems' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "energy_systems"))
+
+(defun vhdl-template-package-electrical-systems ()
+ "Insert specification of `electrical_systems' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "electrical_systems"))
+
+(defun vhdl-template-package-mechanical-systems ()
+ "Insert specification of `mechanical_systems' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "mechanical_systems"))
+
+(defun vhdl-template-package-radiant-systems ()
+ "Insert specification of `radiant_systems' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "radiant_systems"))
+
+(defun vhdl-template-package-thermal-systems ()
+ "Insert specification of `thermal_systems' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "thermal_systems"))
+
+(defun vhdl-template-package-fluidic-systems ()
+ "Insert specification of `fluidic_systems' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "fluidic_systems"))
+
+(defun vhdl-template-package-math-complex ()
+ "Insert specification of `math_complex' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "math_complex"))
+
+(defun vhdl-template-package-math-real ()
+ "Insert specification of `math_real' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "math_real"))
+
(defun vhdl-template-directive (directive)
"Insert directive."
(unless (= (current-indentation) (current-column))
@@ -9900,6 +10256,9 @@ specification, if not already there."
(insert (user-full-name))
(when user-mail-address (insert " <" user-mail-address ">")))
(goto-char beg)
+ (while (search-forward "<authorfull>" end t)
+ (replace-match (user-full-name) t t))
+ (goto-char beg)
(while (search-forward "<login>" end t)
(replace-match (user-login-name) t t))
(goto-char beg)
@@ -9915,7 +10274,7 @@ specification, if not already there."
(while (search-forward "<standard>" end t)
(replace-match
(concat "VHDL" (cond ((vhdl-standard-p '87) "'87")
- ((vhdl-standard-p '93) "'93"))
+ ((vhdl-standard-p '93) "'93/02"))
(when (vhdl-standard-p 'ams) ", VHDL-AMS")
(when (vhdl-standard-p 'math) ", Math Packages")) t t))
(goto-char beg)
@@ -10021,9 +10380,10 @@ If starting after end-comment-column, start a new line."
"Displays one line of dashes."
(interactive)
(while (= (preceding-char) ?-) (delete-char -2))
+ (insert "--")
(let* ((col (current-column))
(len (- end-comment-column col)))
- (insert-char ?- len)))
+ (insert-char vhdl-comment-display-line-char len)))
(defun vhdl-comment-append-inline ()
"Append empty inline comment to current line."
@@ -10084,7 +10444,7 @@ If starting after end-comment-column, start a new line."
(goto-char beg)
(beginning-of-line)
(setq beg (point))
- (if (looking-at comment-start)
+ (if (looking-at (concat "\\s-*" comment-start))
(comment-region beg end '(4))
(comment-region beg end))))
@@ -10119,7 +10479,7 @@ If starting after end-comment-column, start a new line."
(goto-char beg)
(beginning-of-line)
(while (< (point) end)
- (when (looking-at "^.*[^ \t\n-]+\\(\\s-*--.*\\)$")
+ (when (looking-at "^.*[^ \t\n\r\f-]+\\(\\s-*--.*\\)$")
(delete-region (match-beginning 1) (match-end 1)))
(beginning-of-line 2))))
@@ -10323,9 +10683,9 @@ if in comment and past end-comment-column."
(self-insert-command count)
(cond ((>= (current-column) (+ 2 end-comment-column))
(backward-char 1)
- (skip-chars-backward "^ \t\n")
+ (skip-chars-backward "^ \t\n\r\f")
(indent-new-comment-line)
- (skip-chars-forward "^ \t\n")
+ (skip-chars-forward "^ \t\n\r\f")
(forward-char 1))
((>= (current-column) end-comment-column)
(indent-new-comment-line))
@@ -10369,7 +10729,9 @@ with double-quotes is to be inserted. DEFAULT specifies a default string."
(vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes
(concat "'" vhdl-attributes-regexp))
(vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values
- vhdl-enum-values-regexp))
+ vhdl-enum-values-regexp)
+ (vhdl-fix-case-region-1 position (point) vhdl-upper-case-constants
+ vhdl-constants-regexp))
(when (or (not (equal string "")) (not optional))
(insert (or follow-string "")))
(if (equal string "") nil string)))
@@ -10455,55 +10817,57 @@ else insert tab (used for word completion in VHDL minibuffer)."
(defun vhdl-beginning-of-block ()
"Move cursor to the beginning of the enclosing block."
(let (pos)
- (save-excursion
- (beginning-of-line)
- ;; search backward for block beginning or end
- (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t))
- ;; not consider subprogram declarations
- (or (and (match-string 5)
- (save-match-data
- (save-excursion
- (goto-char (match-end 5))
- (forward-word 1)
- (vhdl-forward-syntactic-ws)
- (when (looking-at "(")
- (forward-sexp))
- (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
- (match-string 1)))
- ;; not consider configuration specifications
- (and (match-string 6)
- (save-match-data
- (save-excursion
- (vhdl-end-of-block)
- (beginning-of-line)
- (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
- (match-string 2))
- ;; skip subblock if block end found
- (vhdl-beginning-of-block)))
+ (vhdl-prepare-search-2
+ (save-excursion
+ (beginning-of-line)
+ ;; search backward for block beginning or end
+ (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
+ ;; not consider subprogram declarations
+ (or (and (match-string 5)
+ (save-match-data
+ (save-excursion
+ (goto-char (match-end 5))
+ (forward-word 1)
+ (vhdl-forward-syntactic-ws)
+ (when (looking-at "(")
+ (forward-sexp))
+ (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
+ (match-string 1)))
+ ;; not consider configuration specifications
+ (and (match-string 6)
+ (save-match-data
+ (save-excursion
+ (vhdl-end-of-block)
+ (beginning-of-line)
+ (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
+ (match-string 2))
+ ;; skip subblock if block end found
+ (vhdl-beginning-of-block))))
(when pos (goto-char pos))))
(defun vhdl-end-of-block ()
"Move cursor to the end of the enclosing block."
(let (pos)
- (save-excursion
- (end-of-line)
- ;; search forward for block beginning or end
- (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t))
- ;; not consider subprogram declarations
- (or (and (match-string 5)
- (save-match-data
- (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
- (match-string 1)))
- ;; not consider configuration specifications
- (and (match-string 6)
- (save-match-data
- (save-excursion
- (vhdl-end-of-block)
- (beginning-of-line)
- (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
- (not (match-string 2)))
- ;; skip subblock if block beginning found
- (vhdl-end-of-block)))
+ (vhdl-prepare-search-2
+ (save-excursion
+ (end-of-line)
+ ;; search forward for block beginning or end
+ (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
+ ;; not consider subprogram declarations
+ (or (and (match-string 5)
+ (save-match-data
+ (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
+ (match-string 1)))
+ ;; not consider configuration specifications
+ (and (match-string 6)
+ (save-match-data
+ (save-excursion
+ (vhdl-end-of-block)
+ (beginning-of-line)
+ (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
+ (not (match-string 2)))
+ ;; skip subblock if block beginning found
+ (vhdl-end-of-block))))
(when pos (goto-char pos))))
(defun vhdl-sequential-statement-p ()
@@ -10518,7 +10882,7 @@ else insert tab (used for word completion in VHDL minibuffer)."
(< start (point)))
;; ... a sequential block
(progn (vhdl-beginning-of-block)
- (looking-at "^\\s-*\\(\\(\\w+[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(\\w+[ \t\n]+\\)?\\(procedural\\|process\\)\\)\\>")))))))
+ (looking-at "^\\s-*\\(\\(\\w+[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(\\w+[ \t\n\r\f]+\\)?\\(procedural\\|process\\)\\)\\>")))))))
(defun vhdl-in-argument-list-p ()
"Check if within an argument list."
@@ -10542,7 +10906,9 @@ but not if inside a comment or quote."
(progn
(insert " ")
(unexpand-abbrev)
- (delete-char -1))
+ (backward-word 1)
+ (vhdl-case-word 1)
+ (delete-char 1))
(if (not vhdl-electric-mode)
(progn
(insert " ")
@@ -10821,7 +11187,10 @@ but not if inside a comment or quote."
(defun vhdl-parse-string (string &optional optional)
"Check that the text following point matches the regexp in STRING."
(if (looking-at string)
- (goto-char (match-end 0))
+ (progn (goto-char (match-end 0))
+ (when (vhdl-in-literal)
+ (end-of-line))
+ (point))
(unless optional
(throw 'parse (format "ERROR: Syntax error near line %s, expecting \"%s\""
(vhdl-current-line) string)))
@@ -10919,7 +11288,9 @@ reflected in a subsequent paste operation."
port-dir (car port-dir-car))
(setcar port-dir-car
(cond ((equal port-dir "in") "out")
+ ((equal port-dir "IN") "OUT")
((equal port-dir "out") "in")
+ ((equal port-dir "OUT") "IN")
(t port-dir)))
(setq port-list (cdr port-list)))
(setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction))
@@ -10949,20 +11320,23 @@ reflected in a subsequent paste operation."
(message "Reading port of %s \"%s\"..." decl-type name)
(vhdl-forward-syntactic-ws)
;; parse generic clause
- (when (vhdl-parse-string "generic[ \t\n]*(" t)
+ (when (vhdl-parse-string "generic[ \t\n\r\f]*(" t)
;; parse group comment and spacing
(setq group-comment (vhdl-parse-group-comment))
- (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t))
+ (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t))
(while (not end-of-list)
;; parse names (accept extended identifiers)
- (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
+ (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
(setq names (list (match-string-no-properties 1)))
- (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\)[ \t\n]*" t)
+ (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
(setq names
(append names (list (match-string-no-properties 1)))))
;; parse type
- (vhdl-parse-string ":[ \t\n]*\\([^():;\n]+\\)")
+ (vhdl-parse-string ":[ \t\n\r\f]*\\([^():;\n]+\\)")
(setq type (match-string-no-properties 1))
+ (when (vhdl-in-comment-p) ; if stuck in comment
+ (setq type (concat type (and (vhdl-parse-string ".*")
+ (match-string-no-properties 0)))))
(setq comment nil)
(while (looking-at "(")
(setq type
@@ -10980,7 +11354,7 @@ reflected in a subsequent paste operation."
(setq type (substring type 0 (match-end 1)))
;; parse initialization expression
(setq init nil)
- (when (vhdl-parse-string ":=[ \t\n]*" t)
+ (when (vhdl-parse-string ":=[ \t\n\r\f]*" t)
(vhdl-parse-string "\\([^();\n]*\\)")
(setq init (match-string-no-properties 1))
(while (looking-at "(")
@@ -11014,28 +11388,31 @@ reflected in a subsequent paste operation."
;; parse group comment and spacing
(setq group-comment (vhdl-parse-group-comment))))
;; parse port clause
- (when (vhdl-parse-string "port[ \t\n]*(" t)
+ (when (vhdl-parse-string "port[ \t\n\r\f]*(" t)
;; parse group comment and spacing
(setq group-comment (vhdl-parse-group-comment))
- (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t))
+ (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t))
(while (not end-of-list)
;; parse object
(setq object
- (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n]*" t)
+ (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n\r\f]*" t)
(match-string-no-properties 1)))
;; parse names (accept extended identifiers)
- (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
+ (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
(setq names (list (match-string-no-properties 1)))
- (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t)
+ (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
(setq names (append names (list (match-string-no-properties 1)))))
;; parse direction
- (vhdl-parse-string ":[ \t\n]*")
+ (vhdl-parse-string ":[ \t\n\r\f]*")
(setq direct
- (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n]+" t)
+ (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n\r\f]+" t)
(match-string-no-properties 1)))
;; parse type
(vhdl-parse-string "\\([^();\n]+\\)")
(setq type (match-string-no-properties 1))
+ (when (vhdl-in-comment-p) ; if stuck in comment
+ (setq type (concat type (and (vhdl-parse-string ".*")
+ (match-string-no-properties 0)))))
(setq comment nil)
(while (looking-at "(")
(setq type (concat type
@@ -11313,7 +11690,7 @@ reflected in a subsequent paste operation."
(setq port-list (cdr port-list))
(insert (if port-list "," ");"))
;; paste comment
- (when (or vhdl-include-direction-comments
+ (when (or (and vhdl-include-direction-comments (nth 2 port))
vhdl-include-type-comments
(and vhdl-include-port-comments (nth 4 port)))
(vhdl-comment-insert-inline
@@ -11454,12 +11831,17 @@ reflected in a subsequent paste operation."
;; paste type
(insert " : " (nth 3 port))
;; paste initialization (inputs only)
- (when (and initialize (equal "IN" (upcase (nth 2 port))))
- (insert " := " (if (string-match "(.+)" (nth 3 port))
- "(others => '0')" "'0'")))
+ (when (and initialize (nth 2 port) (equal "IN" (upcase (nth 2 port))))
+ (insert " := "
+ (cond ((string-match "integer" (nth 3 port)) "0")
+ ((string-match "natural" (nth 3 port)) "0")
+ ((string-match "positive" (nth 3 port)) "0")
+ ((string-match "real" (nth 3 port)) "0.0")
+ ((string-match "(.+)" (nth 3 port)) "(others => '0')")
+ (t "'0'"))))
(insert ";")
;; paste comment
- (when (or vhdl-include-direction-comments
+ (when (or (and vhdl-include-direction-comments (nth 2 port))
(and vhdl-include-port-comments (nth 4 port)))
(vhdl-comment-insert-inline
(concat
@@ -11495,8 +11877,14 @@ reflected in a subsequent paste operation."
(setq name (car (nth 0 port)))
(insert (vhdl-replace-string vhdl-actual-port-name name))
;; paste initialization
- (insert " <= " (if (string-match "(.+)" (nth 3 port))
- "(others => '0')" "'0'") ";"))
+ (insert " <= "
+ (cond ((string-match "integer" (nth 3 port)) "0")
+ ((string-match "natural" (nth 3 port)) "0")
+ ((string-match "positive" (nth 3 port)) "0")
+ ((string-match "real" (nth 3 port)) "0.0")
+ ((string-match "(.+)" (nth 3 port)) "(others => '0')")
+ (t "'0'"))
+ ";"))
(setq port-list (cdr port-list))
(when (and port-list
(equal "IN" (upcase (nth 2 (car port-list)))))
@@ -11609,7 +11997,9 @@ reflected in a subsequent paste operation."
;; paste custom declarations
(unless (equal "" vhdl-testbench-declarations)
(insert "\n")
- (vhdl-insert-string-or-file vhdl-testbench-declarations))
+ (setq position (point))
+ (vhdl-insert-string-or-file vhdl-testbench-declarations)
+ (vhdl-indent-region position (point)))
(setq position (point))
(insert "\n\n")
(vhdl-comment-display-line) (insert "\n")
@@ -11638,7 +12028,9 @@ reflected in a subsequent paste operation."
;; paste custom statements
(unless (equal "" vhdl-testbench-statements)
(insert "\n")
- (vhdl-insert-string-or-file vhdl-testbench-statements))
+ (setq position (point))
+ (vhdl-insert-string-or-file vhdl-testbench-statements)
+ (vhdl-indent-region position (point)))
(insert "\n")
(indent-to vhdl-basic-offset)
(unless (eq vhdl-testbench-create-files 'none)
@@ -11707,8 +12099,8 @@ reflected in a subsequent paste operation."
;; check if within function declaration
(setq pos (point))
(end-of-line)
- (when (looking-at "[ \t\n]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0)))
- (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n]*\\(\\((\\)\\|;\\|is\\>\\)" nil t)
+ (when (looking-at "[ \t\n\r\f]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0)))
+ (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n\r\f]*\\(\\((\\)\\|;\\|is\\>\\)" nil t)
(goto-char (match-end 0))
(save-excursion (backward-char)
(forward-sexp)
@@ -11721,21 +12113,21 @@ reflected in a subsequent paste operation."
;; parse parameter list
(setq group-comment (vhdl-parse-group-comment))
(setq end-of-list (or end-of-list
- (vhdl-parse-string ")[ \t\n]*\\(;\\|\\(is\\|return\\)\\>\\)" t)))
+ (vhdl-parse-string ")[ \t\n\r\f]*\\(;\\|\\(is\\|return\\)\\>\\)" t)))
(while (not end-of-list)
;; parse object
(setq object
- (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n]*" t)
+ (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n\r\f]*" t)
(match-string-no-properties 1)))
;; parse names (accept extended identifiers)
- (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
+ (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
(setq names (list (match-string-no-properties 1)))
- (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t)
+ (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
(setq names (append names (list (match-string-no-properties 1)))))
;; parse direction
- (vhdl-parse-string ":[ \t\n]*")
+ (vhdl-parse-string ":[ \t\n\r\f]*")
(setq direct
- (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n]+" t)
+ (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n\r\f]+" t)
(match-string-no-properties 1)))
;; parse type
(vhdl-parse-string "\\([^():;\n]+\\)")
@@ -11757,7 +12149,7 @@ reflected in a subsequent paste operation."
(setq type (substring type 0 (match-end 1)))
;; parse initialization expression
(setq init nil)
- (when (vhdl-parse-string ":=[ \t\n]*" t)
+ (when (vhdl-parse-string ":=[ \t\n\r\f]*" t)
(vhdl-parse-string "\\([^();\n]*\\)")
(setq init (match-string-no-properties 1))
(while (looking-at "(")
@@ -11787,7 +12179,7 @@ reflected in a subsequent paste operation."
(vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*")
;; parse return type
(when (match-string 3)
- (vhdl-parse-string "[ \t\n]*\\(.+\\)[ \t\n]*\\(;\\|is\\>\\)\\s-*")
+ (vhdl-parse-string "[ \t\n\r\f]*\\(.+\\)[ \t\n\r\f]*\\(;\\|is\\>\\)\\s-*")
(setq return-type (match-string-no-properties 1))
(when (and return-type
(string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type))
@@ -12015,17 +12407,15 @@ expressions (e.g. for index ranges of types and signals)."
(defalias 'he-list-beg 'vhdl-he-list-beg))
;; function for expanding abbrevs and dabbrevs
-(defun vhdl-expand-abbrev (arg))
-(fset 'vhdl-expand-abbrev (make-hippie-expand-function
- '(try-expand-dabbrev
- try-expand-dabbrev-all-buffers
- vhdl-try-expand-abbrev)))
+(defalias 'vhdl-expand-abbrev (make-hippie-expand-function
+ '(try-expand-dabbrev
+ try-expand-dabbrev-all-buffers
+ vhdl-try-expand-abbrev)))
;; function for expanding parenthesis
-(defun vhdl-expand-paren (arg))
-(fset 'vhdl-expand-paren (make-hippie-expand-function
- '(try-expand-list
- try-expand-list-all-buffers)))
+(defalias 'vhdl-expand-paren (make-hippie-expand-function
+ '(try-expand-list
+ try-expand-list-all-buffers)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Case fixing
@@ -12049,7 +12439,7 @@ depending on parameter UPPER-CASE."
(< vhdl-progress-interval
(- (nth 1 (current-time)) last-update)))
(message "Fixing case... (%2d%s)"
- (+ (* count 25) (/ (* 25 (- (point) beg)) (- end beg)))
+ (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg)))
"%")
(setq last-update (nth 1 (current-time)))))
(goto-char end)))))
@@ -12066,6 +12456,8 @@ options vhdl-upper-case-{keywords,types,attributes,enum-values}."
beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2)
(vhdl-fix-case-region-1
beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3)
+ (vhdl-fix-case-region-1
+ beg end vhdl-upper-case-constants vhdl-constants-regexp 4)
(when vhdl-progress-interval (message "Fixing case...done")))
(defun vhdl-fix-case-buffer ()
@@ -12091,6 +12483,9 @@ options vhdl-upper-case-{keywords,types,attributes,enum-values}."
(upcase-word 1))
(when (and vhdl-upper-case-enum-values
(looking-at vhdl-enum-values-regexp))
+ (upcase-word 1))
+ (when (and vhdl-upper-case-constants
+ (looking-at vhdl-constants-regexp))
(upcase-word 1)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -12130,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)))
@@ -12205,6 +12601,9 @@ it works within comments too."
(interactive)
(let ((no-stats 0)
(no-code-lines 0)
+ (no-empty-lines 0)
+ (no-comm-lines 0)
+ (no-comments 0)
(no-lines (count-lines (point-min) (point-max))))
(save-excursion
;; count statements
@@ -12218,15 +12617,40 @@ it works within comments too."
(while (not (eobp))
(unless (looking-at "^\\s-*\\(--.*\\)?$")
(setq no-code-lines (1+ no-code-lines)))
- (beginning-of-line 2)))
+ (beginning-of-line 2))
+ ;; count empty lines
+ (goto-char (point-min))
+ (while (and (re-search-forward "^\\s-*$" nil t)
+ (not (eq (point) (point-max))))
+ (if (match-string 1)
+ (goto-char (match-end 1))
+ (setq no-empty-lines (1+ no-empty-lines))
+ (unless (eq (point) (point-max))
+ (forward-char))))
+ ;; count comment-only lines
+ (goto-char (point-min))
+ (while (re-search-forward "^\\s-*--.*" nil t)
+ (if (match-string 1)
+ (goto-char (match-end 1))
+ (setq no-comm-lines (1+ no-comm-lines))))
+ ;; count comments
+ (goto-char (point-min))
+ (while (re-search-forward "--.*" nil t)
+ (if (match-string 1)
+ (goto-char (match-end 1))
+ (setq no-comments (1+ no-comments)))))
;; print results
(message "\n\
File statistics: \"%s\"\n\
---------------------\n\
-# statements : %5d\n\
-# code lines : %5d\n\
-# total lines : %5d\n\ "
- (buffer-file-name) no-stats no-code-lines no-lines)
+# statements : %5d\n\
+# code lines : %5d\n\
+# empty lines : %5d\n\
+# comment lines : %5d\n\
+# comments : %5d\n\
+# total lines : %5d\n\ "
+ (buffer-file-name) no-stats no-code-lines no-empty-lines
+ no-comm-lines no-comments no-lines)
(unless vhdl-emacs-21 (vhdl-show-messages))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -12390,18 +12814,18 @@ File statistics: \"%s\"\n\
(concat
"\\(^\\)\\s-*\\("
;; generic/port clause
- "\\(generic\\|port\\)[ \t\n]*(\\|"
+ "\\(generic\\|port\\)[ \t\n\r\f]*(\\|"
;; component
"component\\>\\|"
;; component instantiation
- "\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*"
- "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?"
- "\\(\\w\\|\\s_\\)+\\([ \t\n]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n]*"
- "\\(generic\\|port\\)[ \t\n]+map[ \t\n]*(\\|"
+ "\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*"
+ "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?"
+ "\\(\\w\\|\\s_\\)+\\([ \t\n\r\f]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n\r\f]*"
+ "\\(generic\\|port\\)[ \t\n\r\f]+map[ \t\n\r\f]*(\\|"
;; subprogram
"\\(function\\|procedure\\)\\>\\|"
;; process, block
- "\\(\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*\\)?\\(process\\|block\\)\\>\\|"
+ "\\(\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|block\\)\\>\\|"
;; configuration declaration
"configuration\\>"
"\\)")
@@ -12414,7 +12838,7 @@ File statistics: \"%s\"\n\
(beginning-of-line)
(cond
;; generic/port clause
- ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n]*(")
+ ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(")
(goto-char (match-end 0))
(backward-char)
(forward-sexp))
@@ -12424,16 +12848,16 @@ File statistics: \"%s\"\n\
;; component instantiation
((looking-at
(concat
- "^\\s-*\\w+\\s-*:[ \t\n]*"
- "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?"
- "\\w+\\(\\s-*(\\w+)\\)?[ \t\n]*"
- "\\(generic\\|port\\)\\s-+map[ \t\n]*("))
+ "^\\s-*\\w+\\s-*:[ \t\n\r\f]*"
+ "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?"
+ "\\w+\\(\\s-*(\\w+)\\)?[ \t\n\r\f]*"
+ "\\(generic\\|port\\)\\s-+map[ \t\n\r\f]*("))
(goto-char (match-end 0))
(backward-char)
(forward-sexp)
(setq pos (point))
(vhdl-forward-syntactic-ws)
- (when (looking-at "port\\s-+map[ \t\n]*(")
+ (when (looking-at "port\\s-+map[ \t\n\r\f]*(")
(goto-char (match-end 0))
(backward-char)
(forward-sexp)
@@ -12585,7 +13009,7 @@ This does highlighting of keywords and standard identifiers.")
;; highlight labels of common constructs
(list
(concat
- "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\("
+ "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\("
"assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|"
"postponed\\|process\\|"
(when (vhdl-standard-p 'ams) "procedural\\|")
@@ -12596,14 +13020,14 @@ This does highlighting of keywords and standard identifiers.")
;; highlight label and component name of component instantiations
(list
(concat
- "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\w+\\)"
- "\\(\\s-*\\(--[^\n]*\\)?$\\|\\s-+\\(generic\\|port\\)\\s-+map\\>\\)")
+ "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]*"
+ "\\(--[^\n]*[ \t\n\r\f]+\\)*\\(generic\\|port\\)\\s-+map\\>")
'(1 font-lock-function-name-face) '(2 font-lock-function-name-face))
;; highlight label and instantiated unit of component instantiations
(list
(concat
- "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*"
+ "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*"
"\\(component\\|configuration\\|entity\\)\\s-+"
"\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?")
'(1 font-lock-function-name-face) '(3 font-lock-function-name-face)
@@ -12638,7 +13062,7 @@ This does highlighting of keywords and standard identifiers.")
(list
(concat
"^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*"
- "\\(:[ \t\n]*\\(\\w+\\)\\|[^i \t]\\)")
+ "\\(:[ \t\n\r\f]*\\(\\w+\\)\\|[^i \t]\\)")
'(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t))
;; highlight names in library clauses
@@ -12662,8 +13086,8 @@ This does highlighting of keywords and standard identifiers.")
;; highlight type/nature name in (sub)type/(sub)nature declarations
(list
(concat
- "^\\s-*\\(sub\\)?\\(nature\\|type\\)\\s-+\\(\\w+\\)")
- 3 'font-lock-type-face)
+ "^\\s-*\\(\\(sub\\)?\\(nature\\|type\\)\\|end\\s-+\\(record\\|protected\\)\\)\\s-+\\(\\w+\\)")
+ 5 'font-lock-type-face)
;; highlight signal/variable/constant declaration names
(list "\\(:[^=]\\)"
@@ -12867,6 +13291,7 @@ This does background highlighting of translate-off regions.")
(list vhdl-functions-regexp 1 'vhdl-font-lock-function-face)
(list vhdl-packages-regexp 1 'vhdl-font-lock-function-face)
(list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face)
+ (list vhdl-constants-regexp 1 'font-lock-constant-face)
(list vhdl-keywords-regexp 1 'font-lock-keyword-face)))
;; highlight words with special syntax.
(setq vhdl-font-lock-keywords-3
@@ -12875,9 +13300,10 @@ This does background highlighting of translate-off regions.")
(while syntax-alist
(setq keywords
(cons
- (cons (concat "\\<\\(" (nth 1 (car syntax-alist)) "\\)\\>")
+ (list (concat "\\(" (nth 1 (car syntax-alist)) "\\)") 1
(vhdl-function-name
- "vhdl-font-lock" (nth 0 (car syntax-alist)) "face"))
+ "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")
+ (nth 4 (car syntax-alist)))
keywords))
(setq syntax-alist (cdr syntax-alist)))
keywords))
@@ -13066,7 +13492,7 @@ hierarchy otherwise.")
(when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t)
(while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t)
(equal "USE" (upcase (match-string 1))))
- (when (looking-at "^[ \t]*use[ \t\n]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
+ (when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
(setq lib-alist (cons (cons (match-string-no-properties 1)
(vhdl-match-string-downcase 2))
lib-alist))))))
@@ -13140,7 +13566,7 @@ hierarchy otherwise.")
(setq big-files t))
;; scan for entities
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*entity[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
+ (while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((ent-name (match-string-no-properties 1))
(ent-key (downcase ent-name))
(ent-entry (aget ent-alist ent-key t))
@@ -13157,7 +13583,7 @@ hierarchy otherwise.")
lib-alist)))))
;; scan for architectures
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
+ (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((arch-name (match-string-no-properties 1))
(arch-key (downcase arch-name))
(ent-name (match-string-no-properties 2))
@@ -13183,7 +13609,7 @@ hierarchy otherwise.")
arch-key (nth 5 ent-entry))))))
;; scan for configurations
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*configuration[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
+ (while (re-search-forward "^[ \t]*configuration[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((conf-name (match-string-no-properties 1))
(conf-key (downcase conf-name))
(conf-entry (aget conf-alist conf-key t))
@@ -13195,7 +13621,7 @@ hierarchy otherwise.")
arch-key comp-conf-list inst-key-list
inst-comp-key inst-ent-key inst-arch-key
inst-conf-key inst-lib-key)
- (when (vhdl-re-search-forward "\\<for[ \t\n]+\\(\\w+\\)")
+ (when (vhdl-re-search-forward "\\<for[ \t\n\r\f]+\\(\\w+\\)")
(setq arch-key (vhdl-match-string-downcase 1)))
(if conf-entry
(vhdl-warning-when-idle
@@ -13204,13 +13630,13 @@ hierarchy otherwise.")
(nth 2 conf-entry) file-name conf-line)
(setq conf-list (cons conf-key conf-list))
;; scan for subconfigurations and subentities
- (while (re-search-forward "^[ \t]*for[ \t\n]+\\(\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*\\)[ \t\n]*:[ \t\n]*\\(\\w+\\)[ \t\n]+" end-of-unit t)
+ (while (re-search-forward "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+" end-of-unit t)
(setq inst-comp-key (vhdl-match-string-downcase 3)
inst-key-list (split-string
(vhdl-match-string-downcase 1)
- "[ \t\n]*,[ \t\n]*"))
+ "[ \t\n\r\f]*,[ \t\n\r\f]*"))
(vhdl-forward-syntactic-ws)
- (when (looking-at "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n]*\\((\\(\\w+\\))\\)?")
+ (when (looking-at "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n\r\f]*\\((\\(\\w+\\))\\)?")
(setq
inst-lib-key (vhdl-match-string-downcase 3)
inst-ent-key (and (match-string 2)
@@ -13232,7 +13658,7 @@ hierarchy otherwise.")
arch-key comp-conf-list lib-alist)))))
;; scan for packages
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*package[ \t\n]+\\(body[ \t\n]+\\)?\\(\\w+\\)[ \t\n]+is\\>" nil t)
+ (while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((pack-name (match-string-no-properties 2))
(pack-key (downcase pack-name))
(is-body (match-string-no-properties 1))
@@ -13250,7 +13676,7 @@ hierarchy otherwise.")
;; scan for context clauses
(setq lib-alist (vhdl-scan-context-clause))
;; scan for component and subprogram declarations/bodies
- (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n]+\\(\\w+\\|\".*\"\\)" end-of-unit t)
+ (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n\r\f]+\\(\\w+\\|\".*\"\\)" end-of-unit t)
(if (equal (upcase (match-string 1)) "COMPONENT")
(setq comp-name (match-string-no-properties 2)
comp-alist
@@ -13286,7 +13712,7 @@ hierarchy otherwise.")
(setq big-files t))
;; scan for architectures
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
+ (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((ent-name (match-string-no-properties 2))
(ent-key (downcase ent-name))
(arch-name (match-string-no-properties 1))
@@ -13300,12 +13726,12 @@ hierarchy otherwise.")
inst-alist inst-path)
;; scan for contained instantiations
(while (and (re-search-forward
- (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\("
- "\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(generic\\|port\\)[ \t\n]+map\\>\\|"
- "component[ \t\n]+\\(\\w+\\)\\|"
- "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?\\|"
+ (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\("
+ "\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(generic\\|port\\)[ \t\n\r\f]+map\\>\\|"
+ "component[ \t\n\r\f]+\\(\\w+\\)\\|"
+ "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|"
"\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|"
- "\\(^[ \t]*end[ \t\n]+\\(generate\\|block\\)\\>\\)") end-of-unit t)
+ "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t)
(or (not limit-hier-inst-no)
(<= (setq inst-no (1+ inst-no))
limit-hier-inst-no)))
@@ -13349,8 +13775,8 @@ hierarchy otherwise.")
;; scan for contained configuration specifications
(goto-char beg-of-unit)
(while (re-search-forward
- (concat "^[ \t]*for[ \t\n]+\\(\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*\\)[ \t\n]*:[ \t\n]*\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*"
- "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?") end-of-unit t)
+ (concat "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*"
+ "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?") end-of-unit t)
(let* ((inst-comp-name (match-string-no-properties 3))
(inst-ent-key
(and (match-string 6)
@@ -13362,7 +13788,7 @@ hierarchy otherwise.")
(inst-lib-key (vhdl-match-string-downcase 8))
(inst-key-list
(split-string (vhdl-match-string-downcase 1)
- "[ \t\n]*,[ \t\n]*"))
+ "[ \t\n\r\f]*,[ \t\n\r\f]*"))
(tmp-inst-alist inst-alist)
inst-entry)
(while tmp-inst-alist
@@ -13960,10 +14386,10 @@ if required."
(define-key vhdl-speedbar-key-map (int-to-string key)
`(lambda () (interactive) (vhdl-speedbar-set-depth ,key)))
(setq key (1+ key)))))
- (define-key speedbar-key-map "h"
+ (define-key speedbar-mode-map "h"
(lambda () (interactive)
(speedbar-change-initial-expansion-list "vhdl directory")))
- (define-key speedbar-key-map "H"
+ (define-key speedbar-mode-map "H"
(lambda () (interactive)
(speedbar-change-initial-expansion-list "vhdl project")))
;; menu
@@ -15347,7 +15773,7 @@ expansion function)."
(read-from-minibuffer "architecture name: "
nil vhdl-minibuffer-local-map)
(vhdl-replace-string vhdl-compose-architecture-name ent-name)))
- ent-file-name arch-file-name ent-buffer arch-buffer project)
+ ent-file-name arch-file-name ent-buffer arch-buffer project end-pos)
(message "Creating component \"%s(%s)\"..." ent-name arch-name)
;; open entity file
(unless (eq vhdl-compose-create-files 'none)
@@ -15364,6 +15790,7 @@ expansion function)."
;; insert header
(if vhdl-compose-include-header
(progn (vhdl-template-header)
+ (setq end-pos (point))
(goto-char (point-max)))
(vhdl-comment-display-line) (insert "\n\n"))
;; insert library clause
@@ -15390,6 +15817,7 @@ expansion function)."
;; open architecture file
(if (not (eq vhdl-compose-create-files 'separate))
(insert "\n")
+ (goto-char (or end-pos (point-min)))
(setq ent-buffer (current-buffer))
(setq arch-file-name
(concat (vhdl-replace-string vhdl-architecture-file-name
@@ -15434,7 +15862,7 @@ expansion function)."
(if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
(vhdl-template-footer)
(vhdl-comment-display-line) (insert "\n"))
- (goto-char (point-min))
+ (goto-char (or end-pos (point-min)))
(setq arch-buffer (current-buffer))
(when ent-buffer (set-buffer ent-buffer) (save-buffer))
(set-buffer arch-buffer) (save-buffer)
@@ -15453,8 +15881,8 @@ component instantiation."
(error "ERROR: No port has been read")
(save-excursion
(vhdl-prepare-search-2
- (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
- (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t))
+ (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
+ (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t))
(error "ERROR: No architecture found"))
(let* ((ent-name (match-string 1))
(ent-file-name
@@ -15471,13 +15899,13 @@ component instantiation."
(car vhdl-port-list) "\\>") nil t)))
(re-search-forward "^begin\\>" nil)
(beginning-of-line)
- (skip-chars-backward " \t\n")
+ (skip-chars-backward " \t\n\r\f")
(insert "\n\n") (indent-to vhdl-basic-offset)
(vhdl-port-paste-component t))
;; place component instantiation
(re-search-forward "^end\\>" nil)
(beginning-of-line)
- (skip-chars-backward " \t\n")
+ (skip-chars-backward " \t\n\r\f")
(insert "\n\n") (indent-to vhdl-basic-offset)
(vhdl-port-paste-instance nil t t)
;; place use clause for used packages
@@ -15486,7 +15914,7 @@ component instantiation."
(when (file-exists-p ent-file-name)
(find-file ent-file-name))
(goto-char (point-min))
- (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t)
+ (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t)
(error "ERROR: Entity not found: \"%s\"" ent-name))
(goto-char (match-beginning 0))
(if (and (save-excursion
@@ -15505,8 +15933,8 @@ component instantiation."
(interactive)
(save-excursion
(vhdl-prepare-search-2
- (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
- (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t))
+ (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
+ (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t))
(error "ERROR: No architecture found"))
(let* ((ent-name (match-string 1))
(ent-file-name
@@ -15532,11 +15960,11 @@ component instantiation."
;; process all instances
(goto-char arch-stat-pos)
(while (re-search-forward
- (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\("
- "\\(component[ \t\n]+\\)?\\(\\w+\\)"
- "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\|"
- "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?"
- "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\)[ \t\n]*(") arch-end-pos t)
+ (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\("
+ "\\(component[ \t\n\r\f]+\\)?\\(\\w+\\)"
+ "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\|"
+ "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?"
+ "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\)[ \t\n\r\f]*(") arch-end-pos t)
(setq inst-name (match-string-no-properties 1)
comp-name (match-string-no-properties 4)
comp-ent-name (match-string-no-properties 12)
@@ -15548,7 +15976,7 @@ component instantiation."
(when vhdl-use-components-package pack-file-name) t
(save-excursion
(goto-char (point-min))
- (unless (re-search-forward (concat "^\\s-*component[ \t\n]+" comp-name "\\>") nil t)
+ (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t)
(error "ERROR: Component declaration not found: \"%s\"" comp-name))
(vhdl-port-copy)))
;; ... from entity declaration (direct instantiation)
@@ -15559,7 +15987,7 @@ component instantiation."
comp-ent-file-name t
(save-excursion
(goto-char (point-min))
- (unless (re-search-forward (concat "^\\s-*entity[ \t\n]+" comp-ent-name "\\>") nil t)
+ (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t)
(error "ERROR: Entity declaration not found: \"%s\"" comp-ent-name))
(vhdl-port-copy))))
(vhdl-port-flatten t)
@@ -15571,7 +15999,7 @@ component instantiation."
(when has-generic
;; process all constants in generic map
(vhdl-forward-syntactic-ws)
- (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t)
+ (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
(setq constant-name (match-string-no-properties 3))
(setq constant-entry
(cons constant-name
@@ -15589,10 +16017,10 @@ component instantiation."
(unless (match-string 1)
(setq generic-alist (cdr generic-alist)))
(vhdl-forward-syntactic-ws))
- (vhdl-re-search-forward "\\<port\\s-+map[ \t\n]*(" nil t))
+ (vhdl-re-search-forward "\\<port\\s-+map[ \t\n\r\f]*(" nil t))
;; process all signals in port map
(vhdl-forward-syntactic-ws)
- (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t)
+ (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
(setq signal-name (match-string-no-properties 3))
(setq signal-entry (cons signal-name
(if (match-string 1)
@@ -15638,7 +16066,7 @@ component instantiation."
;; prepare signal insertion
(vhdl-goto-marker arch-decl-pos)
(forward-line 1)
- (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n]*-*\n" arch-stat-pos t)
+ (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n\r\f]*-*\n" arch-stat-pos t)
(setq signal-pos (point-marker))
(while (progn (vhdl-forward-syntactic-ws)
(looking-at "signal\\>"))
@@ -15649,10 +16077,10 @@ component instantiation."
(when (file-exists-p ent-file-name)
(find-file ent-file-name))
(goto-char (point-min))
- (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t)
+ (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t)
(error "ERROR: Entity not found: \"%s\"" ent-name))
;; prepare generic clause insertion
- (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n]*(\\)\\|^end\\>" nil t)
+ (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n\r\f]*(\\)\\|^end\\>" nil t)
(match-string 1))
(goto-char (match-beginning 0))
(indent-to vhdl-basic-offset)
@@ -15670,7 +16098,7 @@ component instantiation."
(setq generic-beg-pos (point-marker) generic-pos (point-marker)
generic-inst-pos (point-marker) generic-end-pos (point-marker))
;; prepare port clause insertion
- (unless (and (re-search-forward "\\(^\\s-*port[ \t\n]*(\\)\\|^end\\>" nil t)
+ (unless (and (re-search-forward "\\(^\\s-*port[ \t\n\r\f]*(\\)\\|^end\\>" nil t)
(match-string 1))
(goto-char (match-beginning 0))
(indent-to vhdl-basic-offset)
@@ -15894,7 +16322,8 @@ current project/directory."
(message "Generating components package \"%s\"...done\n File created: \"%s\""
pack-name pack-file-name)))
-(defun vhdl-compose-configuration-architecture (ent-name arch-name inst-alist
+(defun vhdl-compose-configuration-architecture (ent-name arch-name ent-alist
+ conf-alist inst-alist
&optional insert-conf)
"Generate block configuration for architecture."
(let ((margin (current-indentation))
@@ -15970,7 +16399,7 @@ current project/directory."
(nth 3 ent-entry))
(indent-to (+ margin vhdl-basic-offset))
(vhdl-compose-configuration-architecture
- (nth 0 ent-entry) arch-name
+ (nth 0 ent-entry) arch-name ent-alist conf-alist
(nth 3 (aget (nth 3 ent-entry) (downcase arch-name) t))))))
;; insert component configuration end
(indent-to margin)
@@ -16052,7 +16481,8 @@ current project/directory."
(vhdl-insert-keyword " IS\n")
(indent-to vhdl-basic-offset)
;; insert block configuration (for architecture)
- (vhdl-compose-configuration-architecture ent-name arch-name inst-alist t)
+ (vhdl-compose-configuration-architecture
+ ent-name arch-name ent-alist conf-alist inst-alist t)
(vhdl-insert-keyword "END ") (insert conf-name ";")
(when conf-file-name
;; insert footer and save
@@ -16072,6 +16502,9 @@ current project/directory."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (using `compile.el')
+(defvar vhdl-compile-post-command ""
+ "String appended to compile command after file name.")
+
(defun vhdl-makefile-name ()
"Return the Makefile name of the current project or the current compiler if
no project is defined."
@@ -16226,9 +16659,11 @@ do not print any file names."
(compiler (or (aget vhdl-compiler-alist vhdl-compiler nil)
(error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
(command (nth 0 compiler))
- (file-name (buffer-file-name))
- (options (vhdl-get-compile-options project compiler file-name))
(default-directory (vhdl-compile-directory))
+ (file-name (if vhdl-compile-absolute-path
+ (buffer-file-name)
+ (file-relative-name (buffer-file-name))))
+ (options (vhdl-get-compile-options project compiler file-name))
compilation-process-setup-function)
(unless (file-directory-p default-directory)
(error "ERROR: Compile directory does not exist: \"%s\"" default-directory))
@@ -16236,14 +16671,18 @@ do not print any file names."
(when (string-match " " file-name)
(setq file-name (concat "\"" file-name "\"")))
;; print out file name if compiler does not
- (setq vhdl-compile-file-name (buffer-file-name))
+ (setq vhdl-compile-file-name (if vhdl-compile-absolute-path
+ (buffer-file-name)
+ (file-relative-name (buffer-file-name))))
(when (and (= 0 (nth 1 (nth 10 compiler)))
(= 0 (nth 1 (nth 11 compiler))))
(setq compilation-process-setup-function 'vhdl-compile-print-file-name))
;; run compilation
(if options
(when command
- (compile (concat command " " options " " file-name)))
+ (compile (concat command " " options " " file-name
+ (unless (equal vhdl-compile-post-command "")
+ (concat " " vhdl-compile-post-command)))))
(vhdl-warning "Your project settings tell me not to compile this file"))))
(defvar vhdl-make-target "all"
@@ -16551,6 +16990,8 @@ specified by a target."
(insert "\n\n# Define compilation command and options\n"
"\nCOMPILE = " (nth 0 compiler)
"\nOPTIONS = " (vhdl-get-compile-options project compiler nil)
+ (if (equal vhdl-compile-post-command "") ""
+ (concat "\nPOST-COMPILE = " vhdl-compile-post-command))
"\n")
;; insert library paths
(setq library-directory
@@ -16580,16 +17021,16 @@ specified by a target."
(setq unit-list tmp-list)
;; insert `make all' rule
(insert "\n\n\n# Rule for compiling entire design\n"
- "\nall :"
- " \\\n\t\tlibrary"
+ "\n" (nth 0 vhdl-makefile-default-targets) " :"
+ " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)
" \\\n\t\t$(ALL_UNITS)\n")
;; insert `make clean' rule
(insert "\n\n# Rule for cleaning entire design\n"
- "\nclean : "
+ "\n" (nth 1 vhdl-makefile-default-targets) " : "
"\n\t-rm -f $(ALL_UNITS)\n")
;; insert `make library' rule
(insert "\n\n# Rule for creating library directory\n"
- "\nlibrary :"
+ "\n" (nth 2 vhdl-makefile-default-targets) " :"
" \\\n\t\t$(LIBRARY-" work-library ")\n"
"\n$(LIBRARY-" work-library ") :"
"\n\t"
@@ -16597,6 +17038,11 @@ specified by a target."
(cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler))
(concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library)))
"\n")
+ ;; insert '.PHONY' declaration
+ (insert "\n\n.PHONY : "
+ (nth 0 vhdl-makefile-default-targets) " "
+ (nth 1 vhdl-makefile-default-targets) " "
+ (nth 2 vhdl-makefile-default-targets) "\n")
;; insert rule for each library unit
(insert "\n\n# Rules for compiling single library units and their subhierarchy\n")
(while prim-list
@@ -16611,7 +17057,7 @@ specified by a target."
(unless (equal unit-key unit-name)
(insert " \\\n" unit-name))
(insert " :"
- " \\\n\t\tlibrary"
+ " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)
" \\\n\t\t$(UNIT-" work-library "-" unit-key ")")
(while second-list
(insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")")
@@ -16653,7 +17099,9 @@ specified by a target."
(if options
(insert "\n\t$(COMPILE) "
(if (eq options 'default) "$(OPTIONS)" options) " "
- (nth 0 rule) "\n")
+ (nth 0 rule)
+ (if (equal vhdl-compile-post-command "") ""
+ " $(POST-COMPILE)") "\n")
(setq tmp-list target-list)
(while target-list
(insert "\n\t@touch $(UNIT-" work-library "-" (car target-list) ")"
@@ -16712,6 +17160,7 @@ specified by a target."
'vhdl-compiler-alist
'vhdl-compiler
'vhdl-compile-use-local-error-regexp
+ 'vhdl-makefile-default-targets
'vhdl-makefile-generation-hook
'vhdl-default-library
'vhdl-standard
@@ -16722,6 +17171,7 @@ specified by a target."
'vhdl-upper-case-enum-values
'vhdl-upper-case-constants
'vhdl-use-direct-instantiation
+ 'vhdl-array-index-record-field-in-sensitivity-list
'vhdl-compose-configuration-name
'vhdl-entity-file-name
'vhdl-architecture-file-name
@@ -16812,6 +17262,7 @@ specified by a target."
'vhdl-print-customize-faces
'vhdl-intelligent-tab
'vhdl-indent-syntax-based
+ 'vhdl-indent-comment-like-next-code-line
'vhdl-word-completion-case-sensitive
'vhdl-word-completion-in-minibuffer
'vhdl-underscore-is-part-of-word
@@ -16851,6 +17302,17 @@ CONFIGURATION DECLARATION GENERATION:
(See documentation (`C-c C-h') in section on STRUCTURAL COMPOSITION.)
+Key Bindings
+------------
+
+For Emacs compliance the following key bindings have been changed:
+
+- `C-c c' -> `C-c C-c' `vhdl-comment-uncomment-region'
+- `C-c f' -> `C-c C-i C-f' `vhdl-fontify-buffer'
+- `C-c s' -> `C-c C-i C-s' `vhdl-statistics-buffer'
+- `C-c C-c ...' -> `C-c C-m ...' `vhdl-compose-...'
+
+
User Options
------------
@@ -16864,6 +17326,12 @@ User Options
Specify whether hierarchical configurations should be created.
`vhdl-compose-configuration-use-subconfiguration': (new)
Specify whether subconfigurations should be used inside configurations.
+`vhdl-makefile-default-targets': (new)
+ Customize names of Makefile default targets.
+`vhdl-indent-comment-like-next-code-line': (new)
+ Specify whether comment lines are indented like following code line.
+`vhdl-array-index-record-field-in-sensitivity-list': (new)
+ Specify whether to include array indices / record fields in sensitivity list.
")
@@ -16872,19 +17340,20 @@ User Options
Reserved words in VHDL
----------------------
-VHDL'93 (IEEE Std 1076-1993):
- `vhdl-93-keywords' : keywords
- `vhdl-93-types' : standardized types
- `vhdl-93-attributes' : standardized attributes
- `vhdl-93-enum-values' : standardized enumeration values
- `vhdl-93-functions' : standardized functions
- `vhdl-93-packages' : standardized packages and libraries
+VHDL'93/02 (IEEE Std 1076-1993/2002):
+ `vhdl-02-keywords' : keywords
+ `vhdl-02-types' : standardized types
+ `vhdl-02-attributes' : standardized attributes
+ `vhdl-02-enum-values' : standardized enumeration values
+ `vhdl-02-functions' : standardized functions
+ `vhdl-02-packages' : standardized packages and libraries
-VHDL-AMS (IEEE Std 1076.1):
+VHDL-AMS (IEEE Std 1076.1 / 1076.1.1):
`vhdl-ams-keywords' : keywords
`vhdl-ams-types' : standardized types
`vhdl-ams-attributes' : standardized attributes
`vhdl-ams-enum-values' : standardized enumeration values
+ `vhdl-ams-constants' : standardized constants
`vhdl-ams-functions' : standardized functions
Math Packages (IEEE Std 1076.2):
@@ -16932,7 +17401,8 @@ to visually support naming conventions.")
"Display VARIABLE's documentation in *Help* buffer."
(interactive)
(unless (featurep 'xemacs)
- (help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p)))
+ (help-setup-xref (list #'vhdl-doc-variable variable)
+ (called-interactively-p 'interactive)))
(with-output-to-temp-buffer
(if (fboundp 'help-buffer) (help-buffer) "*Help*")
(princ (documentation-property variable 'variable-documentation))
@@ -16944,7 +17414,8 @@ to visually support naming conventions.")
"Display VHDL Mode documentation in *Help* buffer."
(interactive)
(unless (featurep 'xemacs)
- (help-setup-xref (list #'vhdl-doc-mode) (interactive-p)))
+ (help-setup-xref (list #'vhdl-doc-mode)
+ (called-interactively-p 'interactive)))
(with-output-to-temp-buffer
(if (fboundp 'help-buffer) (help-buffer) "*Help*")
(princ mode-name)
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index e27d07854c8..c2ce12b6ad4 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -1,6 +1,6 @@
;;; which-func.el --- print current function in mode line
-;; Copyright (C) 1994, 1997-1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Alex Rezinsky <alexr@msil.sps.mot.com>
;; (doesn't seem to be responsive any more)
@@ -68,18 +68,19 @@
"String to display in the mode line when current function is unknown.")
(defgroup which-func nil
- "Mode to display the current function name in the modeline."
+ "Display the current function name in the mode line."
:group 'tools
:version "20.3")
-(defcustom which-func-modes
- '(emacs-lisp-mode c-mode c++-mode perl-mode cperl-mode python-mode
- makefile-mode sh-mode fortran-mode f90-mode ada-mode
- diff-mode)
+(defcustom which-func-modes t
+ ;; '(emacs-lisp-mode c-mode c++-mode objc-mode perl-mode cperl-mode python-mode
+ ;; makefile-mode sh-mode fortran-mode f90-mode ada-mode
+ ;; diff-mode)
"List of major modes for which Which Function mode should be used.
For other modes it is disabled. If this is equal to t,
then Which Function mode is enabled in any major mode that supports it."
:group 'which-func
+ :version "24.3" ; explicit list -> t
:type '(choice (const :tag "All modes" t)
(repeat (symbol :tag "Major mode"))))
@@ -143,12 +144,13 @@ Zero means compute the Imenu menu regardless of size."
(:propertize which-func-current
local-map ,which-func-keymap
face which-func
- ;;mouse-face highlight ; currently not evaluated :-(
+ mouse-face mode-line-highlight
help-echo "mouse-1: go to beginning\n\
mouse-2: toggle rest visibility\n\
mouse-3: go to end")
"]")
"Format for displaying the function in the mode line."
+ :version "24.2" ; added mouse-face; 24point2 is correct
:group 'which-func
:type 'sexp)
;;;###autoload (put 'which-func-format 'risky-local-variable t)
@@ -162,7 +164,7 @@ single string, the new name of the item.")
(defvar which-func-cleanup-function nil
"Function to transform a string before displaying it in the mode line.
The function is called with one argument, the string to display.
-Its return value is displayed in the modeline.
+Its return value is displayed in the mode line.
If nil, no function is called. The default value is nil.
This feature can be useful if Imenu is set up to make more
@@ -178,7 +180,10 @@ and you want to simplify them for the mode line
(defvar which-func-table (make-hash-table :test 'eq :weakness 'key))
(defconst which-func-current
- '(:eval (gethash (selected-window) which-func-table which-func-unknown)))
+ '(:eval (replace-regexp-in-string
+ "%" "%%"
+ (or (gethash (selected-window) which-func-table)
+ which-func-unknown))))
;;;###autoload (put 'which-func-current 'risky-local-variable t)
(defvar which-func-mode nil
@@ -206,7 +211,8 @@ It creates the Imenu index for the buffer, if necessary."
(setq imenu--index-alist
(save-excursion (funcall imenu-create-index-function))))
(error
- (unless (equal err '(error "This buffer cannot use `imenu-default-create-index-function'"))
+ (unless (equal err
+ '(user-error "This buffer cannot use `imenu-default-create-index-function'"))
(message "which-func-ff-hook error: %S" err))
(setq which-func-mode nil))))
@@ -229,7 +235,7 @@ It creates the Imenu index for the buffer, if necessary."
(error "Error in which-func-update: %S" info))))))
;;;###autoload
-(defalias 'which-func-mode 'which-function-mode)
+(define-obsolete-function-alias 'which-func-mode 'which-function-mode "24.1")
(defvar which-func-update-timer nil)
@@ -331,6 +337,22 @@ If no function name is found, return nil."
(funcall which-func-cleanup-function name)
name))))
+
+;;; Integration with other packages
+
+(defun which-func-update-ediff-windows ()
+ "Update Which-Function mode display for Ediff windows.
+This function is meant to be called from `ediff-select-hook'."
+ (when (eq major-mode 'ediff-mode)
+ (when ediff-window-A
+ (which-func-update-1 ediff-window-A))
+ (when ediff-window-B
+ (which-func-update-1 ediff-window-B))
+ (when ediff-window-C
+ (which-func-update-1 ediff-window-C))))
+
+(add-hook 'ediff-select-hook 'which-func-update-ediff-windows)
+
(provide 'which-func)
;;; which-func.el ends here
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index dfa91b3fe30..52ebdfbdcdf 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -1,6 +1,6 @@
;;; xscheme.el --- run MIT Scheme under Emacs
-;; Copyright (C) 1986-1987, 1989-1990, 2001-2011
+;; Copyright (C) 1986-1987, 1989-1990, 2001-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -48,7 +48,7 @@
"Name of xscheme buffer that we're currently interacting with.")
(defvar xscheme-expressions-ring-max 30
- "*Maximum length of Scheme expressions ring.")
+ "Maximum length of Scheme expressions ring.")
(defvar xscheme-expressions-ring nil
"List of expressions recently transmitted to the Scheme process.")
@@ -74,7 +74,7 @@ by the scheme process, so additional control-g's are to be ignored.")
(defconst default-xscheme-runlight
'(": " xscheme-runlight-string)
- "Default global (shared) xscheme-runlight modeline format.")
+ "Default global (shared) xscheme-runlight mode line format.")
(defvar xscheme-runlight "")
(defvar xscheme-runlight-string nil)
@@ -116,12 +116,12 @@ from being inserted into the process-buffer.")
:group 'lisp)
(defcustom scheme-band-name nil
- "*Band loaded by the `run-scheme' command."
+ "Band loaded by the `run-scheme' command."
:type '(choice (const nil) string)
:group 'xscheme)
(defcustom scheme-program-arguments nil
- "*Arguments passed to the Scheme program by the `run-scheme' command."
+ "Arguments passed to the Scheme program by the `run-scheme' command."
:type '(choice (const nil) string)
:group 'xscheme)
@@ -326,7 +326,7 @@ buffer is not visible at that time, the value will also be displayed
in the minibuffer. If an error occurs, the process buffer will
automatically pop up to show you the error message.
-While the Scheme process is running, the modelines of all buffers in
+While the Scheme process is running, the mode lines of all buffers in
scheme-mode are modified to show the state of the process. The
possible states and their meanings are:
@@ -334,7 +334,7 @@ input waiting for input
run evaluating
gc garbage collecting
-The process buffer's modeline contains additional information where
+The process buffer's mode line contains additional information where
the buffer's name is normally displayed: the command interpreter level
and type.
@@ -404,7 +404,7 @@ with no args, if that value is non-nil.
(cons (process-filter process)
(process-sentinel process)))
(xscheme-process-filter-initialize t)
- (xscheme-modeline-initialize xscheme-buffer-name)
+ (xscheme-mode-line-initialize xscheme-buffer-name)
(set-process-sentinel process 'xscheme-process-sentinel)
(set-process-filter process 'xscheme-process-filter))
(setq xscheme-previous-process-state (cons nil nil)))))))
@@ -817,7 +817,7 @@ Control returns to the top level rep loop."
xscheme-buffer-name)
(set-marker (process-mark process) (point-max))
(xscheme-process-filter-initialize t)
- (xscheme-modeline-initialize xscheme-buffer-name)
+ (xscheme-mode-line-initialize xscheme-buffer-name)
(set-process-sentinel process 'xscheme-process-sentinel)
(set-process-filter process 'xscheme-process-filter)
(run-hooks 'xscheme-start-hook)))))
@@ -951,7 +951,7 @@ the remaining input.")
(if running-p
(let ((name (buffer-name (current-buffer))))
(setq scheme-mode-line-process '(": " xscheme-runlight-string))
- (xscheme-modeline-initialize name)
+ (xscheme-mode-line-initialize name)
(if (equal name (default-value 'xscheme-buffer-name))
(setq-default xscheme-runlight default-xscheme-runlight))))
(if (or (eq xscheme-runlight default-xscheme-runlight)
@@ -1059,7 +1059,7 @@ the remaining input.")
(set-buffer (process-buffer process))
(goto-char (process-mark process))))
-(defun xscheme-modeline-initialize (name)
+(defun xscheme-mode-line-initialize (name)
(setq xscheme-runlight-string "")
(if (equal name (default-value 'xscheme-buffer-name))
(setq-default xscheme-runlight-string ""))
diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el
index 14aee8c3ecf..477aee1b2da 100644
--- a/lisp/ps-bdf.el
+++ b/lisp/ps-bdf.el
@@ -1,6 +1,6 @@
;;; ps-bdf.el --- BDF font file handler for ps-print
-;; Copyright (C) 1998-1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -70,20 +70,15 @@ for BDFNAME."
(defsubst bdf-file-mod-time (filename)
"Return modification time of FILENAME.
-The value is a list of two integers, the first integer has high-order
-16 bits, the second has low 16 bits."
+The value is a list of integers in the same format as `current-time'."
(nth 5 (file-attributes filename)))
(defun bdf-file-newer-than-time (filename mod-time)
"Return non-nil if and only if FILENAME is newer than MOD-TIME.
-MOD-TIME is a modification time as a list of two integers, the first
-integer has high-order 16 bits, the second has low 16 bits."
- (let* ((new-mod-time (bdf-file-mod-time filename))
- (new-time (car new-mod-time))
- (time (car mod-time)))
- (or (> new-time time)
- (and (= new-time time)
- (> (nth 1 new-mod-time) (nth 1 mod-time))))))
+MOD-TIME is a modification time as a list of integers in the same
+format as `current-time'."
+ (let ((new-mod-time (bdf-file-mod-time filename)))
+ (time-less-p mod-time new-mod-time)))
(defun bdf-find-file (bdfname)
"Return a buffer visiting a bdf file BDFNAME.
@@ -178,8 +173,8 @@ FONT-INFO is a list of the following format:
(BDFFILE MOD-TIME FONT-BOUNDING-BOX
RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
-MOD-TIME is last modification time as a list of two integers, the
-first integer has high-order 16 bits, the second has low 16 bits.
+MOD-TIME is last modification time as a list of integers in the
+same format as `current-time'.
SIZE is a size of the font on 72 dpi device. This value is got
from SIZE record of the font.
diff --git a/lisp/ps-def.el b/lisp/ps-def.el
index 639183e5ab3..279f2ea6177 100644
--- a/lisp/ps-def.el
+++ b/lisp/ps-def.el
@@ -1,6 +1,6 @@
;;; ps-def.el --- XEmacs and Emacs definitions for ps-print
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index db5b57f8585..7db326403f6 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -1,6 +1,6 @@
;;; ps-mule.el --- provide multi-byte character facility to ps-print
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
@@ -1141,7 +1141,7 @@ It checks if all multi-byte characters in the region are printable or not."
(aref ps-mule-font-spec-tables font-type) 0)))
(ps-output-prologue
(list (if (ps-mule-font-spec-src (cdr (car font-spec-alist)))
- ;; We ignore a font specfied in ps-font-info-database.
+ ;; We ignore a font specified in ps-font-info-database.
(format "/V%s VTOP%d def\n" fonttag font-type)
(format "/V%s [ VTOP%d aload pop ] def\n
V%s 0 /%s-latin1 /%s Latin1Encoding put\n"
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index da804d99ae0..930e750ab27 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -1,6 +1,6 @@
;;; ps-print.el --- print text from the buffer as PostScript
-;; Copyright (C) 1993-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-2012 Free Software Foundation, Inc.
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Jacques Duthen (was <duthen@cegelec-red.fr>)
@@ -1042,7 +1042,7 @@ Please send all bug fixes and enhancements to
;; variables `ps-bold-faces', `ps-italic-faces' and `ps-underlined-faces'.
;; These variables contain lists of faces that ps-print should consider bold,
;; italic or underline; to set them, put code like the following into your
-;; .emacs file:
+;; init file:
;;
;; (setq ps-bold-faces '(my-blue-face))
;; (setq ps-italic-faces '(my-red-face))
@@ -6658,7 +6658,7 @@ If FACE is not a valid face name, use default face."
;; But autoload them here to make the separation invisible.
;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize
-;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "01641c7c3af4e45e1c3afeb75a73120c")
+;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "86bf8e46dac41afe73df5ab098038ab0")
;;; Generated autoloads from ps-mule.el
(defvar ps-multibyte-buffer nil "\
diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el
index bfdcd91d26a..5e7fbb2ca9a 100644
--- a/lisp/ps-samp.el
+++ b/lisp/ps-samp.el
@@ -1,6 +1,6 @@
;;; ps-samp.el --- ps-print sample setup code
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Jacques Duthen (was <duthen@cegelec-red.fr>)
@@ -251,8 +251,6 @@
;; * CUPS has enabled the option "Share published printers connected
;; to this system" (see <http://localhost:631/admin>).
-(eval-when-compile
- (require 'cl))
(require 'printing)
(require 'zeroconf)
diff --git a/lisp/recentf.el b/lisp/recentf.el
index 2dac870afd5..636110f41de 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1,6 +1,6 @@
;;; recentf.el --- setup a menu of recently opened files
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Created: July 19 1999
@@ -1061,6 +1061,8 @@ Go to the beginning of buffer if not found."
(let ((km (copy-keymap recentf--shortcuts-keymap)))
(set-keymap-parent km widget-keymap)
(define-key km "q" 'recentf-cancel-dialog)
+ (define-key km "n" 'next-line)
+ (define-key km "p" 'previous-line)
(define-key km [follow-link] "\C-m")
km)
"Keymap used in recentf dialogs.")
diff --git a/lisp/rect.el b/lisp/rect.el
index 0756ec3bc0a..c5e9a790ca2 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -1,6 +1,6 @@
;;; rect.el --- rectangle functions for GNU Emacs
-;; Copyright (C) 1985, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1999-2012 Free Software Foundation, Inc.
;; Maintainer: Didier Verna <didier@xemacs.org>
;; Keywords: internal
@@ -29,16 +29,6 @@
;; ### NOTE: this file was almost completely rewritten by Didier Verna
;; <didier@xemacs.org> in July 1999.
-;;; Global key bindings
-
-;;;###autoload (define-key ctl-x-r-map "c" 'clear-rectangle)
-;;;###autoload (define-key ctl-x-r-map "k" 'kill-rectangle)
-;;;###autoload (define-key ctl-x-r-map "d" 'delete-rectangle)
-;;;###autoload (define-key ctl-x-r-map "y" 'yank-rectangle)
-;;;###autoload (define-key ctl-x-r-map "o" 'open-rectangle)
-;;;###autoload (define-key ctl-x-r-map "t" 'string-rectangle)
-;;;###autoload (define-key ctl-x-r-map "N" 'rectangle-number-lines)
-
;;; Code:
;; FIXME: this function should be replaced by `apply-on-rectangle'
@@ -229,6 +219,7 @@ even beep.)"
(condition-case nil
(setq killed-rectangle (delete-extract-rectangle start end fill))
((buffer-read-only text-read-only)
+ (setq deactivate-mark t)
(setq killed-rectangle (extract-rectangle start end))
(if kill-read-only-ok
(progn (message "Read only text copied to kill ring") nil)
@@ -236,6 +227,15 @@ even beep.)"
(signal 'text-read-only (list (current-buffer)))))))
;;;###autoload
+(defun copy-rectangle-as-kill (start end)
+ "Copy the region-rectangle and save it as the last killed one."
+ (interactive "r")
+ (setq killed-rectangle (extract-rectangle start end))
+ (setq deactivate-mark t)
+ (if (called-interactively-p 'interactive)
+ (indicate-copied-region (length (car killed-rectangle)))))
+
+;;;###autoload
(defun yank-rectangle ()
"Yank the last killed rectangle with upper left corner at point."
(interactive "*")
diff --git a/lisp/register.el b/lisp/register.el
index 89a725f28c5..7c2d9337fa2 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -1,6 +1,6 @@
;;; register.el --- register commands for Emacs
-;; Copyright (C) 1985, 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
@@ -28,31 +28,15 @@
;; pieces of buffer state to named variables. The entry points are
;; documented in the Emacs user's manual.
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag))
(declare-function semantic-tag-buffer "semantic/tag" (tag))
(declare-function semantic-tag-start "semantic/tag" (tag))
-;;; Global key bindings
-
-(define-key ctl-x-r-map "\C-@" 'point-to-register)
-(define-key ctl-x-r-map [?\C-\ ] 'point-to-register)
-(define-key ctl-x-r-map " " 'point-to-register)
-(define-key ctl-x-r-map "j" 'jump-to-register)
-(define-key ctl-x-r-map "s" 'copy-to-register)
-(define-key ctl-x-r-map "x" 'copy-to-register)
-(define-key ctl-x-r-map "i" 'insert-register)
-(define-key ctl-x-r-map "g" 'insert-register)
-(define-key ctl-x-r-map "r" 'copy-rectangle-to-register)
-(define-key ctl-x-r-map "n" 'number-to-register)
-(define-key ctl-x-r-map "+" 'increment-register)
-(define-key ctl-x-r-map "w" 'window-configuration-to-register)
-(define-key ctl-x-r-map "f" 'frame-configuration-to-register)
-
;;; Code:
-(defstruct
+(cl-defstruct
(registerv (:constructor nil)
(:constructor registerv--make (&optional data print-func
jump-func insert-func))
@@ -64,7 +48,7 @@
(jump-func nil :read-only t)
(insert-func nil :read-only t))
-(defun* registerv-make (data &key print-func jump-func insert-func)
+(cl-defun registerv-make (data &key print-func jump-func insert-func)
"Create a register value object.
DATA can be any value.
@@ -92,6 +76,22 @@ A list of the form (WINDOW-CONFIGURATION POSITION)
A list of the form (FRAME-CONFIGURATION POSITION)
represents a saved frame configuration plus a saved value of point.")
+(defgroup register nil
+ "Register commands."
+ :group 'convenience
+ :version "24.3")
+
+(defcustom register-separator nil
+ "Register containing the text to put between collected texts, or nil if none.
+
+When collecting text with
+`append-to-register' (resp. `prepend-to-register') contents of
+this register is added to the beginning (resp. end) of the marked
+text."
+ :group 'register
+ :type '(choice (const :tag "None" nil)
+ (character :tag "Use register" :value ?+)))
+
(defun get-register (register)
"Return contents of Emacs register named REGISTER, or nil if none."
(cdr (assq register register-alist)))
@@ -150,7 +150,7 @@ delete any existing frames that the frame configuration doesn't mention.
(let ((val (get-register register)))
(cond
((registerv-p val)
- (assert (registerv-jump-func val) nil
+ (cl-assert (registerv-jump-func val) nil
"Don't know how to jump to register %s"
(single-key-description register))
(funcall (registerv-jump-func val) (registerv-data val)))
@@ -208,13 +208,24 @@ Interactively, NUMBER is the prefix arg (none means nil)."
(string-to-number (match-string 0)))
0))))
-(defun increment-register (number register)
- "Add NUMBER to the contents of register REGISTER.
-Interactively, NUMBER is the prefix arg."
- (interactive "p\ncIncrement register: ")
- (or (numberp (get-register register))
- (error "Register does not contain a number"))
- (set-register register (+ number (get-register register))))
+(defun increment-register (prefix register)
+ "Augment contents of REGISTER.
+Interactively, PREFIX is in raw form.
+
+If REGISTER contains a number, add `prefix-numeric-value' of
+PREFIX to it.
+
+If REGISTER is empty or if it contains text, call
+`append-to-register' with `delete-flag' set to PREFIX."
+ (interactive "P\ncIncrement register: ")
+ (let ((register-val (get-register register)))
+ (cond
+ ((numberp register-val)
+ (let ((number (prefix-numeric-value prefix)))
+ (set-register register (+ number register-val))))
+ ((or (not register-val) (stringp register-val))
+ (append-to-register register (region-beginning) (region-end) prefix))
+ (t (error "Register does not contain a number or text")))))
(defun view-register (register)
"Display what is contained in register named REGISTER.
@@ -325,7 +336,7 @@ Interactively, second arg is non-nil if prefix arg is supplied."
(let ((val (get-register register)))
(cond
((registerv-p val)
- (assert (registerv-insert-func val) nil
+ (cl-assert (registerv-insert-func val) nil
"Don't know how to insert register %s"
(single-key-description register))
(funcall (registerv-insert-func val) (registerv-data val)))
@@ -352,7 +363,11 @@ Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
START and END are buffer positions indicating what to copy."
(interactive "cCopy to register: \nr\nP")
(set-register register (filter-buffer-substring start end))
- (if delete-flag (delete-region start end)))
+ (setq deactivate-mark t)
+ (cond (delete-flag
+ (delete-region start end))
+ ((called-interactively-p 'interactive)
+ (indicate-copied-region))))
(defun append-to-register (register start end &optional delete-flag)
"Append region to text in register REGISTER.
@@ -361,12 +376,17 @@ Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
START and END are buffer positions indicating what to append."
(interactive "cAppend to register: \nr\nP")
(let ((reg (get-register register))
- (text (filter-buffer-substring start end)))
+ (text (filter-buffer-substring start end))
+ (separator (and register-separator (get-register register-separator))))
(set-register
register (cond ((not reg) text)
- ((stringp reg) (concat reg text))
+ ((stringp reg) (concat reg separator text))
(t (error "Register does not contain text")))))
- (if delete-flag (delete-region start end)))
+ (setq deactivate-mark t)
+ (cond (delete-flag
+ (delete-region start end))
+ ((called-interactively-p 'interactive)
+ (indicate-copied-region))))
(defun prepend-to-register (register start end &optional delete-flag)
"Prepend region to text in register REGISTER.
@@ -375,12 +395,17 @@ Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
START and END are buffer positions indicating what to prepend."
(interactive "cPrepend to register: \nr\nP")
(let ((reg (get-register register))
- (text (filter-buffer-substring start end)))
+ (text (filter-buffer-substring start end))
+ (separator (and register-separator (get-register register-separator))))
(set-register
register (cond ((not reg) text)
- ((stringp reg) (concat text reg))
+ ((stringp reg) (concat text separator reg))
(t (error "Register does not contain text")))))
- (if delete-flag (delete-region start end)))
+ (setq deactivate-mark t)
+ (cond (delete-flag
+ (delete-region start end))
+ ((called-interactively-p 'interactive)
+ (indicate-copied-region))))
(defun copy-rectangle-to-register (register start end &optional delete-flag)
"Copy rectangular region into register REGISTER.
@@ -390,10 +415,15 @@ To insert this register in the buffer, use \\[insert-register].
Called from a program, takes four args: REGISTER, START, END and DELETE-FLAG.
START and END are buffer positions giving two corners of rectangle."
(interactive "cCopy rectangle to register: \nr\nP")
- (set-register register
- (if delete-flag
- (delete-extract-rectangle start end)
- (extract-rectangle start end))))
+ (let ((rectangle (if delete-flag
+ (delete-extract-rectangle start end)
+ (extract-rectangle start end))))
+ (set-register register rectangle)
+ (when (and (null delete-flag)
+ (called-interactively-p 'interactive))
+ (setq deactivate-mark t)
+ (indicate-copied-region (length (car rectangle))))))
+
(provide 'register)
;;; register.el ends here
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 13b6a1d2315..a6c803ae773 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -1,6 +1,6 @@
-;;; repeat.el --- convenient way to repeat the previous command
+;;; repeat.el --- convenient way to repeat the previous command -*- lexical-binding: t -*-
-;; Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Will Mengarini <seldon@eskimo.com>
;; Created: Mo 02 Mar 98
@@ -156,15 +156,6 @@ member of that sequence. If this variable is nil, no re-execution occurs."
;; `repeat' now repeats that command instead of `real-last-command' to
;; avoid a "... must be bound to an event with parameters" error.
-(defvar repeat-last-self-insert nil
- "If last repeated command was `self-insert-command', it inserted this.")
-
-;; That'll require another keystroke count so we know we're in a string of
-;; repetitions of self-insert commands:
-
-(defvar repeat-num-input-keys-at-self-insert -1
- "# key sequences read in Emacs session when `self-insert-command' repeated.")
-
;;;;; *************** ANALOGOUS HACKS TO `repeat' ITSELF **************** ;;;;;
;; That mechanism of checking num-input-keys to figure out what's really
@@ -199,20 +190,12 @@ this function is always whether the value of `this-command' would've been
(defvar repeat-previous-repeated-command nil
"The previous repeated command.")
-;; The following variable counts repeated self-insertions. The idea is
-;; that repeating a self-insertion command and subsequently undoing it
-;; should have almost the same effect as if the characters were inserted
-;; manually. The basic difference is that we leave in one undo-boundary
-;; between the original insertion and its first repetition.
-(defvar repeat-undo-count nil
- "Number of self-insertions since last `undo-boundary'.")
-
;;;###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
@@ -254,7 +237,7 @@ recently executed command not bound to an input event\"."
(let ((repeat-repeat-char
(if (eq repeat-on-final-keystroke t)
last-command-event
- ;; allow only specified final keystrokes
+ ;; Allow only specified final keystrokes.
(car (memq last-command-event
(listify-key-sequence
repeat-on-final-keystroke))))))
@@ -269,90 +252,49 @@ recently executed command not bound to an input event\"."
(setq current-prefix-arg repeat-arg)
(repeat-message
"Repeating command %S %S" repeat-arg last-repeatable-command))
- (if (eq last-repeatable-command 'self-insert-command)
- (let ((insertion
- (if (<= (- num-input-keys
- repeat-num-input-keys-at-self-insert)
- 1)
- repeat-last-self-insert
- (let ((range (nth 1 buffer-undo-list)))
- (condition-case nil
- (setq repeat-last-self-insert
- (buffer-substring (car range)
- (cdr range)))
- (error (error "%s %s %s" ;Danger, Will Robinson!
- "repeat can't intuit what you"
- "inserted before auto-fill"
- "clobbered it, sorry")))))))
- (setq repeat-num-input-keys-at-self-insert num-input-keys)
- ;; If the self-insert had a repeat count, INSERTION
- ;; includes that many copies of the same character.
- ;; So use just the first character
- ;; and repeat it the right number of times.
- (setq insertion (substring insertion -1))
- (let ((count (prefix-numeric-value repeat-arg))
- (i 0))
- ;; Run pre- and post-command hooks for self-insertion too.
- (run-hooks 'pre-command-hook)
- (cond
- ((not repeat-undo-count))
- ((< repeat-undo-count 20)
- ;; Don't make an undo-boundary here.
- (setq repeat-undo-count (1+ repeat-undo-count)))
- (t
- ;; Make an undo-boundary after 20 repetitions only.
- (undo-boundary)
- (setq repeat-undo-count 1)))
- (while (< i count)
- (repeat-self-insert insertion)
- (setq i (1+ i)))
- (run-hooks 'post-command-hook)))
- (let ((indirect (indirect-function last-repeatable-command)))
- ;; Make each repetition undo separately.
- (undo-boundary)
- (if (or (stringp indirect)
- (vectorp indirect))
- ;; Bind real-last-command so that executing the macro does
- ;; not alter it. Do the same for last-repeatable-command.
- (let ((real-last-command real-last-command)
- (last-repeatable-command last-repeatable-command))
- (execute-kbd-macro last-repeatable-command))
- (run-hooks 'pre-command-hook)
- (call-interactively last-repeatable-command)
- (run-hooks 'post-command-hook)))))
+ (when (eq last-repeatable-command 'self-insert-command)
+ ;; We used to use a much more complex code to try and figure out
+ ;; what key was used to run that self-insert-command:
+ ;; (if (<= (- num-input-keys
+ ;; repeat-num-input-keys-at-self-insert)
+ ;; 1)
+ ;; repeat-last-self-insert
+ ;; (let ((range (nth 1 buffer-undo-list)))
+ ;; (condition-case nil
+ ;; (setq repeat-last-self-insert
+ ;; (buffer-substring (car range)
+ ;; (cdr range)))
+ ;; (error (error "%s %s %s" ;Danger, Will Robinson!
+ ;; "repeat can't intuit what you"
+ ;; "inserted before auto-fill"
+ ;; "clobbered it, sorry")))))
+ (setq last-command-event (char-before)))
+ (let ((indirect (indirect-function last-repeatable-command)))
+ (if (or (stringp indirect)
+ (vectorp indirect))
+ ;; Bind last-repeatable-command so that executing the macro does
+ ;; not alter it.
+ (let ((last-repeatable-command last-repeatable-command))
+ (execute-kbd-macro last-repeatable-command))
+ (call-interactively last-repeatable-command))))
(when repeat-repeat-char
- ;; A simple recursion here gets into trouble with max-lisp-eval-depth
- ;; on long sequences of repetitions of a command like `forward-word'
- ;; (only 32 repetitions are possible given the default value of 200 for
- ;; max-lisp-eval-depth), but if I now locally disable the repeat char I
- ;; can iterate indefinitely here around a single level of recursion.
- (let (repeat-on-final-keystroke
- ;; Bind `undo-inhibit-record-point' to t in order to avoid
- ;; recording point in `buffer-undo-list' here. We have to
- ;; do this since the command loop does not set the last
- ;; position of point thus confusing the point recording
- ;; mechanism when inserting or deleting text.
- (undo-inhibit-record-point t))
- (setq real-last-command 'repeat)
- (setq repeat-undo-count 1)
- (unwind-protect
- (while (let ((evt (read-key)))
- ;; For clicks, we need to strip the meta-data to
- ;; check the underlying event name.
- (eq (or (car-safe evt) evt)
- (or (car-safe repeat-repeat-char)
- repeat-repeat-char)))
- (repeat repeat-arg))
- ;; Make sure `repeat-undo-count' is reset.
- (setq repeat-undo-count nil))
- (setq unread-command-events (list last-input-event))))))
-
-(defun repeat-self-insert (string)
- (let ((i 0))
- (while (< i (length string))
- (let ((last-command-event (aref string i)))
- (self-insert-command 1))
- (setq i (1+ i)))))
+ (set-temporary-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (vector repeat-repeat-char)
+ (if (null repeat-message-function) 'repeat
+ ;; If repeat-message-function is let-bound, preserve it for the
+ ;; next "iterations of the loop".
+ (let ((fun repeat-message-function))
+ (lambda ()
+ (interactive)
+ (let ((repeat-message-function fun))
+ (setq this-command 'repeat)
+ ;; Beware: messing with `real-this-command' is *bad*, but we
+ ;; need it so `last-repeatable-command' can be recognized
+ ;; later (bug#12232).
+ (setq real-this-command 'repeat)
+ (call-interactively 'repeat))))))
+ map)))))
(defun repeat-message (format &rest args)
"Like `message' but displays with `repeat-message-function' if non-nil."
diff --git a/lisp/replace.el b/lisp/replace.el
index a46f62ae139..4013e4e5df5 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1,6 +1,6 @@
;;; replace.el --- replace commands for Emacs
-;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2011
+;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -33,6 +33,22 @@
:type 'boolean
:group 'matching)
+(defcustom replace-lax-whitespace nil
+ "Non-nil means `query-replace' matches a sequence of whitespace chars.
+When you enter a space or spaces in the strings to be replaced,
+it will match any sequence matched by the regexp `search-whitespace-regexp'."
+ :type 'boolean
+ :group 'matching
+ :version "24.3")
+
+(defcustom replace-regexp-lax-whitespace nil
+ "Non-nil means `query-replace-regexp' matches a sequence of whitespace chars.
+When you enter a space or spaces in the regexps to be replaced,
+it will match any sequence matched by the regexp `search-whitespace-regexp'."
+ :type 'boolean
+ :group 'matching
+ :version "24.3")
+
(defvar query-replace-history nil
"Default history list for query-replace commands.
See `query-replace-from-history-variable' and
@@ -46,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.
@@ -112,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
@@ -214,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
@@ -226,6 +250,10 @@ letters. \(Transferring the case pattern means that if the old text
matched is all caps, or capitalized, then its replacement is upcased
or capitalized.)
+If `replace-lax-whitespace' is non-nil, a space or spaces in the string
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
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.
@@ -258,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
@@ -270,6 +300,10 @@ pattern of the old text to the new text, if `case-replace' and
all caps, or capitalized, then its replacement is upcased or
capitalized.)
+If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
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.
@@ -339,45 +373,47 @@ 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.
+If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
+to be replaced will match a sequence of whitespace chars defined by the
+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
@@ -390,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))
@@ -437,6 +470,10 @@ are non-nil and FROM-STRING has no uppercase letters.
\(Preserving case means that if the string matched is all caps, or capitalized,
then its replacement is upcased or capitalized.)
+If `replace-lax-whitespace' is non-nil, a space or spaces in the string
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
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.
@@ -444,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:
@@ -475,6 +512,10 @@ and TO-STRING is also null.)"
Preserve case in each match if `case-replace' and `case-fold-search'
are non-nil and REGEXP has no uppercase letters.
+If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
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.
@@ -505,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:
@@ -538,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)
@@ -763,45 +814,47 @@ a previously found match."
(defvar occur-menu-map
(let ((map (make-sparse-keymap)))
- (define-key map [next-error-follow-minor-mode]
- `(menu-item ,(purecopy "Auto Occurrence Display")
+ (bindings--define-key map [next-error-follow-minor-mode]
+ '(menu-item "Auto Occurrence Display"
next-error-follow-minor-mode
- :help ,(purecopy
- "Display another occurrence when moving the cursor")
+ :help "Display another occurrence when moving the cursor"
:button (:toggle . (and (boundp 'next-error-follow-minor-mode)
next-error-follow-minor-mode))))
- (define-key map [separator-1] menu-bar-separator)
- (define-key map [kill-this-buffer]
- `(menu-item ,(purecopy "Kill Occur Buffer") kill-this-buffer
- :help ,(purecopy "Kill the current *Occur* buffer")))
- (define-key map [quit-window]
- `(menu-item ,(purecopy "Quit Occur Window") quit-window
- :help ,(purecopy "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame")))
- (define-key map [revert-buffer]
- `(menu-item ,(purecopy "Revert Occur Buffer") revert-buffer
- :help ,(purecopy "Replace the text in the *Occur* buffer with the results of rerunning occur")))
- (define-key map [clone-buffer]
- `(menu-item ,(purecopy "Clone Occur Buffer") clone-buffer
- :help ,(purecopy "Create and return a twin copy of the current *Occur* buffer")))
- (define-key map [occur-rename-buffer]
- `(menu-item ,(purecopy "Rename Occur Buffer") occur-rename-buffer
- :help ,(purecopy "Rename the current *Occur* buffer to *Occur: original-buffer-name*.")))
- (define-key map [separator-2] menu-bar-separator)
- (define-key map [occur-mode-goto-occurrence-other-window]
- `(menu-item ,(purecopy "Go To Occurrence Other Window") occur-mode-goto-occurrence-other-window
- :help ,(purecopy "Go to the occurrence the current line describes, in another window")))
- (define-key map [occur-mode-goto-occurrence]
- `(menu-item ,(purecopy "Go To Occurrence") occur-mode-goto-occurrence
- :help ,(purecopy "Go to the occurrence the current line describes")))
- (define-key map [occur-mode-display-occurrence]
- `(menu-item ,(purecopy "Display Occurrence") occur-mode-display-occurrence
- :help ,(purecopy "Display in another window the occurrence the current line describes")))
- (define-key map [occur-next]
- `(menu-item ,(purecopy "Move to Next Match") occur-next
- :help ,(purecopy "Move to the Nth (default 1) next match in an Occur mode buffer")))
- (define-key map [occur-prev]
- `(menu-item ,(purecopy "Move to Previous Match") occur-prev
- :help ,(purecopy "Move to the Nth (default 1) previous match in an Occur mode buffer")))
+ (bindings--define-key map [separator-1] menu-bar-separator)
+ (bindings--define-key map [kill-this-buffer]
+ '(menu-item "Kill Occur Buffer" kill-this-buffer
+ :help "Kill the current *Occur* buffer"))
+ (bindings--define-key map [quit-window]
+ '(menu-item "Quit Occur Window" quit-window
+ :help "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame"))
+ (bindings--define-key map [revert-buffer]
+ '(menu-item "Revert Occur Buffer" revert-buffer
+ :help "Replace the text in the *Occur* buffer with the results of rerunning occur"))
+ (bindings--define-key map [clone-buffer]
+ '(menu-item "Clone Occur Buffer" clone-buffer
+ :help "Create and return a twin copy of the current *Occur* buffer"))
+ (bindings--define-key map [occur-rename-buffer]
+ '(menu-item "Rename Occur Buffer" occur-rename-buffer
+ :help "Rename the current *Occur* buffer to *Occur: original-buffer-name*."))
+ (bindings--define-key map [occur-edit-buffer]
+ '(menu-item "Edit Occur Buffer" occur-edit-mode
+ :help "Edit the *Occur* buffer and apply changes to the original buffers."))
+ (bindings--define-key map [separator-2] menu-bar-separator)
+ (bindings--define-key map [occur-mode-goto-occurrence-other-window]
+ '(menu-item "Go To Occurrence Other Window" occur-mode-goto-occurrence-other-window
+ :help "Go to the occurrence the current line describes, in another window"))
+ (bindings--define-key map [occur-mode-goto-occurrence]
+ '(menu-item "Go To Occurrence" occur-mode-goto-occurrence
+ :help "Go to the occurrence the current line describes"))
+ (bindings--define-key map [occur-mode-display-occurrence]
+ '(menu-item "Display Occurrence" occur-mode-display-occurrence
+ :help "Display in another window the occurrence the current line describes"))
+ (bindings--define-key map [occur-next]
+ '(menu-item "Move to Next Match" occur-next
+ :help "Move to the Nth (default 1) next match in an Occur mode buffer"))
+ (bindings--define-key map [occur-prev]
+ '(menu-item "Move to Previous Match" occur-prev
+ :help "Move to the Nth (default 1) previous match in an Occur mode buffer"))
map)
"Menu keymap for `occur-mode'.")
@@ -819,7 +872,7 @@ a previously found match."
(define-key map "r" 'occur-rename-buffer)
(define-key map "c" 'clone-buffer)
(define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
- (define-key map [menu-bar occur] (cons (purecopy "Occur") occur-menu-map))
+ (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map))
map)
"Keymap for `occur-mode'.")
@@ -867,7 +920,7 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
(define-key map "\C-c\C-c" 'occur-cease-edit)
(define-key map "\C-o" 'occur-mode-display-occurrence)
(define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
- (define-key map [menu-bar occur] (cons (purecopy "Occur") occur-menu-map))
+ (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map))
map)
"Keymap for `occur-edit-mode'.")
@@ -910,7 +963,9 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]."
(line-number-at-pos (window-start))))
(readonly (with-current-buffer buf buffer-read-only))
(win (or (get-buffer-window buf)
- (display-buffer buf t)))
+ (display-buffer buf
+ '(nil (inhibit-same-window . t)
+ (inhibit-switch-frame . t)))))
(line-end (line-end-position))
(text (save-excursion
(goto-char (next-single-property-change
@@ -1090,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))))))
@@ -1138,8 +1193,8 @@ contain \\& and \\N which convention follows `replace-match'.
For example, providing \"defun\\s +\\(\\S +\\)\" for REGEXP and
\"\\1\" for NLINES collects all the function names in a lisp
program. When there is no parenthesized subexpressions in REGEXP
-the entire match is collected. In any case the searched buffers
-are not modified."
+the entire match is collected. In any case the searched buffer
+is not modified."
(interactive (occur-read-primary-args))
(occur-1 regexp nlines (list (current-buffer))))
@@ -1179,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))
@@ -1552,9 +1603,13 @@ Comma to replace but not move point immediately,
C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
C-w to delete match and recursive edit,
C-l to clear the screen, redisplay, and offer same replacement again,
-! to replace all remaining matches with no more questions,
+! to replace all remaining matches in this buffer with no more questions,
^ to move point back to previous match,
-E to edit the replacement string"
+E to edit the replacement string.
+In multi-buffer replacements type `Y' to replace all remaining
+matches in all remaining buffers with no more questions,
+`N' to skip to the next buffer without replacing remaining matches
+in the current buffer."
"Help message while in `query-replace'.")
(defvar query-replace-map
@@ -1585,14 +1640,28 @@ E to edit the replacement string"
(define-key map "?" 'help)
(define-key map "\C-g" 'quit)
(define-key map "\C-]" 'quit)
- (define-key map "\e" 'exit-prefix)
+ (define-key map "\C-v" 'scroll-up)
+ (define-key map "\M-v" 'scroll-down)
+ (define-key map [next] 'scroll-up)
+ (define-key map [prior] 'scroll-down)
+ (define-key map [?\C-\M-v] 'scroll-other-window)
+ (define-key map [M-next] 'scroll-other-window)
+ (define-key map [?\C-\M-\S-v] 'scroll-other-window-down)
+ (define-key map [M-prior] 'scroll-other-window-down)
+ ;; Binding ESC would prohibit the M-v binding. Instead, callers
+ ;; should check for ESC specially.
+ ;; (define-key map "\e" 'exit-prefix)
(define-key map [escape] 'exit-prefix)
map)
- "Keymap that defines the responses to questions in `query-replace'.
+ "Keymap of responses to questions posed by commands like `query-replace'.
The \"bindings\" in this map are not commands; they are answers.
The valid answers include `act', `skip', `act-and-show',
-`exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
-`automatic', `backup', `exit-prefix', and `help'.")
+`act-and-exit', `exit', `exit-prefix', `recenter', `scroll-up',
+`scroll-down', `scroll-other-window', `scroll-other-window-down',
+`edit', `edit-replacement', `delete-and-edit', `automatic',
+`backup', `quit', and `help'.
+
+This keymap is used by `y-or-n-p' as well as `query-replace'.")
(defvar multi-query-replace-map
(let ((map (make-sparse-keymap)))
@@ -1713,12 +1782,12 @@ passed in. If LITERAL is set, no checking is done, anyway."
(replace-match newtext fixedcase literal)
noedit)
-(defvar replace-search-function 'search-forward
+(defvar replace-search-function nil
"Function to use when searching for strings to replace.
It is used by `query-replace' and `replace-string', and is called
with three arguments, as if it were `search-forward'.")
-(defvar replace-re-search-function 're-search-forward
+(defvar replace-re-search-function nil
"Function to use when searching for regexps to replace.
It is used by `query-replace-regexp', `replace-regexp',
`query-replace-regexp-eval', and `map-query-replace-regexp'.
@@ -1751,9 +1820,18 @@ make, or the user didn't cancel the call."
(nocasify (not (and case-replace case-fold-search)))
(literal (or (not regexp-flag) (eq regexp-flag 'literal)))
(search-function
- (if regexp-flag
- replace-re-search-function
- replace-search-function))
+ (or (if regexp-flag
+ replace-re-search-function
+ replace-search-function)
+ (let ((isearch-regexp regexp-flag)
+ (isearch-word delimited-flag)
+ (isearch-lax-whitespace
+ replace-lax-whitespace)
+ (isearch-regexp-lax-whitespace
+ replace-regexp-lax-whitespace)
+ (isearch-case-fold-search case-fold-search)
+ (isearch-forward t))
+ (isearch-search-fun))))
(search-string from-string)
(real-match-data nil) ; The match data for the current match.
(next-replacement nil)
@@ -1807,12 +1885,6 @@ make, or the user didn't cancel the call."
(vector repeat-count repeat-count
replacements replacements)))))
- (if delimited-flag
- (setq search-function 're-search-forward
- search-string (concat "\\b"
- (if regexp-flag from-string
- (regexp-quote from-string))
- "\\b")))
(when query-replace-lazy-highlight
(setq isearch-lazy-highlight-last-string nil))
@@ -1894,7 +1966,7 @@ make, or the user didn't cancel the call."
(replace-highlight
(nth 0 real-match-data) (nth 1 real-match-data)
start end search-string
- (or delimited-flag regexp-flag) case-fold-search))
+ regexp-flag delimited-flag case-fold-search))
(setq noedit
(replace-match-maybe-edit
next-replacement nocasify literal
@@ -1913,7 +1985,7 @@ make, or the user didn't cancel the call."
(replace-highlight
(match-beginning 0) (match-end 0)
start end search-string
- (or delimited-flag regexp-flag) case-fold-search)
+ regexp-flag delimited-flag case-fold-search)
;; Bind message-log-max so we don't fill up the message log
;; with a bunch of identical messages.
(let ((message-log-max nil)
@@ -2095,15 +2167,11 @@ make, or the user didn't cancel the call."
(if (= replace-count 1) "" "s")))
(or (and keep-going stack) multi-buffer)))
-(defvar isearch-error)
-(defvar isearch-forward)
-(defvar isearch-case-fold-search)
-(defvar isearch-string)
-
(defvar replace-overlay nil)
(defun replace-highlight (match-beg match-end range-beg range-end
- string regexp case-fold)
+ search-string regexp-flag delimited-flag
+ case-fold-search)
(if query-replace-highlight
(if replace-overlay
(move-overlay replace-overlay match-beg match-end (current-buffer))
@@ -2111,15 +2179,16 @@ make, or the user didn't cancel the call."
(overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
(overlay-put replace-overlay 'face 'query-replace)))
(if query-replace-lazy-highlight
- (let ((isearch-string string)
- (isearch-regexp regexp)
- (search-whitespace-regexp nil)
- (isearch-case-fold-search case-fold)
+ (let ((isearch-string search-string)
+ (isearch-regexp regexp-flag)
+ (isearch-word delimited-flag)
+ (isearch-lax-whitespace
+ replace-lax-whitespace)
+ (isearch-regexp-lax-whitespace
+ replace-regexp-lax-whitespace)
+ (isearch-case-fold-search case-fold-search)
(isearch-forward t)
(isearch-error nil))
- ;; Set isearch-word to nil because word-replace is regexp-based,
- ;; so `isearch-search-fun' should not use `word-search-forward'.
- (if (and isearch-word isearch-regexp) (setq isearch-word nil))
(isearch-lazy-highlight-new-loop range-beg range-end))))
(defun replace-dehighlight ()
diff --git a/lisp/reposition.el b/lisp/reposition.el
index 51dd630a0c6..87b27855357 100644
--- a/lisp/reposition.el
+++ b/lisp/reposition.el
@@ -1,6 +1,6 @@
;;; reposition.el --- center a Lisp function or comment on the screen
-;; Copyright (C) 1991, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Michael D. Ernst <mernst@theory.lcs.mit.edu>
;; Created: Jan 1991
diff --git a/lisp/reveal.el b/lisp/reveal.el
index 8b4ac22a717..6c0b4c6687d 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -1,6 +1,6 @@
;;; reveal.el --- Automatically reveal hidden text at point -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: outlines
diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el
index ded76f9fbcb..3c4962d3e5c 100644
--- a/lisp/rfn-eshadow.el
+++ b/lisp/rfn-eshadow.el
@@ -1,6 +1,6 @@
;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text
;;
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: convenience minibuffer
diff --git a/lisp/rot13.el b/lisp/rot13.el
index d4885395900..44b27d26ce2 100644
--- a/lisp/rot13.el
+++ b/lisp/rot13.el
@@ -1,6 +1,6 @@
;;; rot13.el --- display a buffer in ROT13
-;; Copyright (C) 1988, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2012 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: FSF
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 046c29471ac..9a8bb8e82ea 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -1,6 +1,6 @@
;;; ruler-mode.el --- display a ruler in the header line
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
diff --git a/lisp/savehist.el b/lisp/savehist.el
index faeab324e5a..cca958ff0a1 100644
--- a/lisp/savehist.el
+++ b/lisp/savehist.el
@@ -1,6 +1,6 @@
;;; savehist.el --- Save minibuffer history
-;; Copyright (C) 1997, 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2005-2012 Free Software Foundation, Inc.
;; Author: Hrvoje Niksic <hniksic@xemacs.org>
;; Maintainer: FSF
@@ -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.
@@ -278,6 +278,13 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved,
(print-level nil)
(print-readably t)
(print-quoted t))
+ ;; During the 24.3 development, read-passwd had a bug which resulted in
+ ;; the passwords being saved by savehist. Trim them, retroactively.
+ ;; This code can be removed after the 24.3 release.
+ (dolist (sym savehist-minibuffer-history-variables)
+ (if (and (symbolp sym) (equal (symbol-name sym) "forget-history"))
+ (setq savehist-minibuffer-history-variables
+ (delq sym savehist-minibuffer-history-variables))))
;; Save the minibuffer histories, along with the value of
;; savehist-minibuffer-history-variables itself.
(when savehist-save-minibuffer-history
@@ -369,9 +376,11 @@ trimming of history lists to `history-length' items."
"Return non-nil if VALUE is printable."
(cond
;; Quick response for oft-encountered types known to be printable.
- ((stringp value))
((numberp value))
((symbolp value))
+ ;; String without properties
+ ((and (stringp value)
+ (equal-including-properties value (substring-no-properties value))))
(t
;; For others, check explicitly.
(with-temp-buffer
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index 9d776877ca6..0c082169462 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -1,6 +1,6 @@
;;; saveplace.el --- automatically save place in files
-;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Maintainer: FSF
@@ -56,13 +56,12 @@ This means when you visit a file, point goes to the last place
where it was when you previously visited the same file.
This variable is automatically buffer-local.
-If you wish your place in any file to always be automatically saved,
-simply put this in your `~/.emacs' file:
+If you wish your place in any file to always be automatically
+saved, set this to t using the Customize facility, or put the
+following code in your init file:
\(setq-default save-place t)
-\(require 'saveplace)
-
-or else use the Custom facility to set this option."
+\(require 'saveplace)"
:type 'boolean
:require 'saveplace
:group 'save-place)
@@ -130,6 +129,15 @@ Files for which such a check may be inconvenient include those on
removable and network volumes."
:type 'regexp :group 'save-place)
+(defcustom save-place-ignore-files-regexp
+ "\\(?:COMMIT_EDITMSG\\|hg-editor-[[:alnum:]]+\\.txt\\|svn-commit\\.tmp\\|bzr_log\\.[[:alnum:]]+\\)$"
+ "Regexp matching files for which no position should be recorded.
+Useful for temporary file such as commit message files that are
+automatically created by the VCS. If set to nil, this feature is
+disabled, i.e., the position is recorded for all files."
+ :version "24.1"
+ :type 'regexp :group 'save-place)
+
(defun toggle-save-place (&optional parg)
"Toggle whether to save your place in this file between sessions.
If this mode is enabled, point is recorded when you kill the buffer
@@ -139,7 +147,8 @@ even in a later Emacs session.
If called with a prefix arg, the mode is enabled if and only if
the argument is positive.
-To save places automatically in all files, put this in your `.emacs' file:
+To save places automatically in all files, put this in your init
+file:
\(setq-default save-place t\)"
(interactive "P")
@@ -160,20 +169,22 @@ To save places automatically in all files, put this in your `.emacs' file:
;; file. If not, do so, then feel free to modify the alist. It
;; will be saved again when Emacs is killed.
(or save-place-loaded (load-save-place-alist-from-file))
- (if buffer-file-name
- (progn
- (let ((cell (assoc buffer-file-name save-place-alist))
- (position (if (not (eq major-mode 'hexl-mode))
- (point)
- (with-no-warnings
- (1+ (hexl-current-address))))))
- (if cell
- (setq save-place-alist (delq cell save-place-alist)))
- (if (and save-place
- (not (= position 1))) ;; Optimize out the degenerate case.
- (setq save-place-alist
- (cons (cons buffer-file-name position)
- save-place-alist)))))))
+ (when (and buffer-file-name
+ (or (not save-place-ignore-files-regexp)
+ (not (string-match save-place-ignore-files-regexp
+ buffer-file-name))))
+ (let ((cell (assoc buffer-file-name save-place-alist))
+ (position (if (not (eq major-mode 'hexl-mode))
+ (point)
+ (with-no-warnings
+ (1+ (hexl-current-address))))))
+ (if cell
+ (setq save-place-alist (delq cell save-place-alist)))
+ (if (and save-place
+ (not (= position 1))) ;; Optimize out the degenerate case.
+ (setq save-place-alist
+ (cons (cons buffer-file-name position)
+ save-place-alist))))))
(defun save-place-forget-unreadable-files ()
"Remove unreadable files from `save-place-alist'.
diff --git a/lisp/sb-image.el b/lisp/sb-image.el
index 843186218a5..f2c7f09f1d1 100644
--- a/lisp/sb-image.el
+++ b/lisp/sb-image.el
@@ -1,6 +1,6 @@
;;; sb-image --- Image management for speedbar
-;; Copyright (C) 1999-2003, 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2003, 2005-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el
index 81a4d2c86e1..fed886c2b55 100644
--- a/lisp/scroll-all.el
+++ b/lisp/scroll-all.el
@@ -1,6 +1,6 @@
;;; scroll-all.el --- scroll all buffers together minor mode
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Gary D. Foster <Gary.Foster@corp.sun.com>
;; Keywords: scroll crisp brief lock
@@ -111,7 +111,6 @@ one window apply to all visible windows in the same frame."
nil " *SL*" nil
:global t
:group 'windows
- :group 'scrolling
(if scroll-all-mode
(add-hook 'post-command-hook 'scroll-all-check-to-scroll)
(remove-hook 'post-command-hook 'scroll-all-check-to-scroll)))
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index 37a31460cdb..0d693c52c81 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -1,6 +1,6 @@
;;; scroll-bar.el --- window system-independent scroll bar support
-;; Copyright (C) 1993-1995, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1999-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: hardware
@@ -29,7 +29,7 @@
;;; Code:
(require 'mouse)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;;; Utilities.
@@ -112,8 +112,9 @@ Setting the variable with a customization buffer also takes effect."
;; If it is set again, that is for real.
(setq scroll-bar-mode-explicit t)
-(defun get-scroll-bar-mode () scroll-bar-mode)
-(defsetf get-scroll-bar-mode set-scroll-bar-mode)
+(defun get-scroll-bar-mode ()
+ (declare (gv-setter set-scroll-bar-mode))
+ scroll-bar-mode)
(define-minor-mode scroll-bar-mode
"Toggle vertical scroll bars on all frames (Scroll Bar mode).
@@ -123,9 +124,10 @@ the mode if ARG is omitted or nil.
This command applies to all frames that exist and frames to be
created in the future."
- :variable (eq (get-scroll-bar-mode)
- (or previous-scroll-bar-mode
- default-frame-scroll-bars)))
+ :variable ((get-scroll-bar-mode)
+ . (lambda (v) (set-scroll-bar-mode
+ (if v (or previous-scroll-bar-mode
+ default-frame-scroll-bars))))))
(defun toggle-scroll-bar (arg)
"Toggle whether or not the selected frame has vertical scroll bars.
diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el
index 0fe39c2ac3e..c5c19c046f1 100644
--- a/lisp/scroll-lock.el
+++ b/lisp/scroll-lock.el
@@ -1,6 +1,6 @@
;;; scroll-lock.el --- Scroll lock scrolling.
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
;; Maintainer: FSF
@@ -49,10 +49,12 @@
;;;###autoload
(define-minor-mode scroll-lock-mode
"Buffer-local minor mode for pager-like scrolling.
-Keys which normally move point by line or paragraph will scroll
-the buffer by the respective amount of lines instead and point
-will be kept vertically fixed relative to window boundaries
-during scrolling."
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil. When enabled, keys that normally move
+point by line or paragraph will scroll the buffer by the
+respective amount of lines instead and point will be kept
+vertically fixed relative to window boundaries during scrolling."
:lighter " ScrLck"
:keymap scroll-lock-mode-map
(if scroll-lock-mode
diff --git a/lisp/select.el b/lisp/select.el
index 10c8f0b1efd..54520704261 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -1,6 +1,6 @@
;;; select.el --- lisp portion of standard selection support
-;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
@@ -72,7 +72,7 @@ variable is set, it is used for the next communication only.
After the communication, this variable is set to nil.")
(declare-function x-get-selection-internal "xselect.c"
- (selection-symbol target-type &optional time-stamp))
+ (selection-symbol target-type &optional time-stamp terminal))
;; Only declared obsolete in 23.3.
(define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34")
@@ -106,7 +106,7 @@ in `selection-converter-alist', which see."
((eq data-type 'STRING)
'iso-8859-1)
(t
- (error "Unknow selection data type: %S" type))))
+ (error "Unknown selection data type: %S" type))))
data (if coding (decode-coding-string data coding)
(string-to-multibyte data)))
(setq next-selection-coding-system nil)
@@ -118,9 +118,9 @@ in `selection-converter-alist', which see."
(x-get-selection-internal 'CLIPBOARD 'STRING))
(declare-function x-own-selection-internal "xselect.c"
- (selection-name selection-value))
+ (selection-name selection-value &optional frame))
(declare-function x-disown-selection-internal "xselect.c"
- (selection &optional time))
+ (selection &optional time terminal))
(defun x-set-selection (type data)
"Make an X selection of type TYPE and value DATA.
@@ -213,44 +213,55 @@ two markers or an overlay. Otherwise, it is nil."
(defun xselect--int-to-cons (n)
(cons (ash n -16) (logand n 65535)))
-(defun xselect-convert-to-string (_selection type value)
- (let (str coding)
- ;; Get the actual string from VALUE.
- (cond ((stringp value)
- (setq str value))
- ((setq value (xselect--selection-bounds value))
- (with-current-buffer (nth 2 value)
- (setq str (buffer-substring (nth 0 value)
- (nth 1 value))))))
- (when str
- ;; If TYPE is nil, this is a local request, thus return STR as
- ;; is. Otherwise, encode STR.
- (if (not type)
- str
- (setq coding (or next-selection-coding-system selection-coding-system))
+(defun xselect--encode-string (type str &optional can-modify)
+ (when str
+ ;; If TYPE is nil, this is a local request; return STR as-is.
+ (if (null type)
+ str
+ ;; Otherwise, encode STR.
+ (let ((coding (or next-selection-coding-system
+ selection-coding-system)))
(if coding
(setq coding (coding-system-base coding)))
(let ((inhibit-read-only t))
;; Suppress producing escape sequences for compositions.
+ ;; But avoid modifying the string if it's a buffer name etc.
+ (unless can-modify (setq str (substring str 0)))
(remove-text-properties 0 (length str) '(composition nil) str)
- (if (eq type 'TEXT)
- ;; TEXT is a polymorphic target. We must select the
- ;; actual type from `UTF8_STRING', `COMPOUND_TEXT',
- ;; `STRING', and `C_STRING'.
- (if (not (multibyte-string-p str))
- (setq type 'C_STRING)
- (let (non-latin-1 non-unicode eight-bit)
- (mapc #'(lambda (x)
- (if (>= x #x100)
- (if (< x #x110000)
- (setq non-latin-1 t)
- (if (< x #x3FFF80)
- (setq non-unicode t)
- (setq eight-bit t)))))
- str)
- (setq type (if non-unicode 'COMPOUND_TEXT
- (if non-latin-1 'UTF8_STRING
- (if eight-bit 'C_STRING 'STRING)))))))
+ ;; For X selections, TEXT is a polymorphic target; choose
+ ;; the actual type from `UTF8_STRING', `COMPOUND_TEXT',
+ ;; `STRING', and `C_STRING'. On Nextstep, always use UTF-8
+ ;; (see ns_string_to_pasteboard_internal in nsselect.m).
+ (when (eq type 'TEXT)
+ (cond
+ ((featurep 'ns)
+ (setq type 'UTF8_STRING))
+ ((not (multibyte-string-p str))
+ (setq type 'C_STRING))
+ (t
+ (let (non-latin-1 non-unicode eight-bit)
+ (mapc #'(lambda (x)
+ (if (>= x #x100)
+ (if (< x #x110000)
+ (setq non-latin-1 t)
+ (if (< x #x3FFF80)
+ (setq non-unicode t)
+ (setq eight-bit t)))))
+ str)
+ (setq type (if (or non-unicode
+ (and
+ non-latin-1
+ ;; If a coding is specified for
+ ;; selection, and that is
+ ;; compatible with COMPOUND_TEXT,
+ ;; use it.
+ coding
+ (eq (coding-system-get coding :mime-charset)
+ 'x-ctext)))
+ 'COMPOUND_TEXT
+ (if non-latin-1 'UTF8_STRING
+ (if eight-bit 'C_STRING
+ 'STRING))))))))
(cond
((eq type 'UTF8_STRING)
(if (or (not coding)
@@ -279,6 +290,14 @@ two markers or an overlay. Otherwise, it is nil."
(setq next-selection-coding-system nil)
(cons type str))))
+(defun xselect-convert-to-string (_selection type value)
+ (let ((str (cond ((stringp value) value)
+ ((setq value (xselect--selection-bounds value))
+ (with-current-buffer (nth 2 value)
+ (buffer-substring (nth 0 value)
+ (nth 1 value)))))))
+ (xselect--encode-string type str t)))
+
(defun xselect-convert-to-length (_selection _type value)
(let ((len (cond ((stringp value)
(length value))
@@ -311,7 +330,7 @@ two markers or an overlay. Otherwise, it is nil."
(defun xselect-convert-to-filename (_selection _type value)
(when (setq value (xselect--selection-bounds value))
- (buffer-file-name (nth 2 value))))
+ (xselect--encode-string 'TEXT (buffer-file-name (nth 2 value)))))
(defun xselect-convert-to-charpos (_selection _type value)
(when (setq value (xselect--selection-bounds value))
@@ -337,13 +356,13 @@ two markers or an overlay. Otherwise, it is nil."
(xselect--int-to-cons (max beg end))))))))
(defun xselect-convert-to-os (_selection _type _size)
- (symbol-name system-type))
+ (xselect--encode-string 'TEXT (symbol-name system-type)))
(defun xselect-convert-to-host (_selection _type _size)
- (system-name))
+ (xselect--encode-string 'TEXT (system-name)))
(defun xselect-convert-to-user (_selection _type _size)
- (user-full-name))
+ (xselect--encode-string 'TEXT (user-full-name)))
(defun xselect-convert-to-class (_selection _type _size)
"Convert selection to class.
diff --git a/lisp/server.el b/lisp/server.el
index edd8f2afa93..c78e3e376aa 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1,6 +1,6 @@
;;; server.el --- Lisp code for GNU Emacs running as server process -*- lexical-binding: t -*-
-;; Copyright (C) 1986-1987, 1992, 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1986-1987, 1992, 1994-2012 Free Software Foundation, Inc.
;; Author: William Sommerfeld <wesommer@athena.mit.edu>
;; Maintainer: FSF
@@ -81,7 +81,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup server nil
"Emacs running as a server process."
@@ -94,7 +94,6 @@
(setq val t)
(unless load-in-progress
(message "Local sockets unsupported, using TCP sockets")))
- (when val (random t))
(set-default sym val))
:group 'server
:type 'boolean
@@ -102,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")
@@ -126,6 +130,8 @@ port number."
(defcustom server-auth-dir (locate-user-emacs-file "server/")
"Directory for server authentication files.
+We only use this if `server-use-tcp' is non-nil.
+Otherwise we use `server-socket-dir'.
NOTE: On FAT32 filesystems, directories are not secure;
files can be read and modified by any user or process.
@@ -137,6 +143,34 @@ directory residing in a NTFS partition instead."
;;;###autoload
(put 'server-auth-dir 'risky-local-variable t)
+(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. 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),
+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).
+
+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.
+
+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)
+ (string :tag "Password"))
+ :version "24.3")
+
(defcustom server-raise-frame t
"If non-nil, raise frame when switching to a buffer."
:group 'server
@@ -365,18 +399,27 @@ If CLIENT is non-nil, add a description of it to the logged message."
(server-log (format "Status changed to %s: %s" (process-status proc) msg) proc)
(server-delete-client proc))
+(defun server--on-display-p (frame display)
+ (and (equal (frame-parameter frame 'display) display)
+ ;; Note: TTY frames still get a `display' parameter set to the value of
+ ;; $DISPLAY. This is useful when running from that tty frame
+ ;; sub-processes that want to connect to the X server, but that means we
+ ;; have to be careful here not to be tricked into thinking those frames
+ ;; are on `display'.
+ (not (eq (framep frame) t))))
+
(defun server-select-display (display)
;; If the current frame is on `display' we're all set.
;; Similarly if we are unable to open frames on other displays, there's
;; nothing more we can do.
(unless (or (not (fboundp 'make-frame-on-display))
- (equal (frame-parameter (selected-frame) 'display) display))
+ (server--on-display-p (selected-frame) display))
;; Otherwise, look for an existing frame there and select it.
(dolist (frame (frame-list))
- (when (equal (frame-parameter frame 'display) display)
+ (when (server--on-display-p frame display)
(select-frame frame)))
;; If there's no frame on that display yet, create and select one.
- (unless (equal (frame-parameter (selected-frame) 'display) display)
+ (unless (server--on-display-p (selected-frame) display)
(let* ((buffer (generate-new-buffer " *server-dummy*"))
(frame (make-frame-on-display
display
@@ -397,16 +440,19 @@ If CLIENT is non-nil, add a description of it to the logged message."
;; visible. If not (which can happen if the user's customizations call
;; pop-to-buffer etc.), delete it to avoid preserving the connection after
;; the last real frame is deleted.
- (if (and (eq (frame-first-window frame)
- (next-window (frame-first-window frame) 'nomini))
- (eq (window-buffer (frame-first-window frame))
- (frame-parameter frame 'server-dummy-buffer)))
- ;; The temp frame still only shows one buffer, and that is the
- ;; internal temp buffer.
- (delete-frame frame)
- (set-frame-parameter frame 'visibility t))
- (kill-buffer (frame-parameter frame 'server-dummy-buffer))
- (set-frame-parameter frame 'server-dummy-buffer nil)))
+
+ ;; Rewritten to avoid inadvertently killing the current buffer after
+ ;; `delete-frame' removed FRAME (Bug#10729).
+ (let ((buffer (frame-parameter frame 'server-dummy-buffer)))
+ (if (and (one-window-p 'nomini frame)
+ (eq (window-buffer (frame-first-window frame)) buffer))
+ ;; The temp frame still only shows one buffer, and that is the
+ ;; internal temp buffer.
+ (delete-frame frame)
+ (set-frame-parameter frame 'visibility t)
+ (set-frame-parameter frame 'server-dummy-buffer nil))
+ (when (buffer-live-p buffer)
+ (kill-buffer buffer)))))
(defun server-handle-delete-frame (frame)
"Delete the client connection when the emacsclient frame is deleted.
@@ -438,11 +484,11 @@ If CLIENT is non-nil, add a description of it to the logged message."
See `server-quote-arg' and `server-process-filter'."
(replace-regexp-in-string
"&." (lambda (s)
- (case (aref s 1)
+ (pcase (aref s 1)
(?& "&")
(?- "-")
(?n "\n")
- (t " ")))
+ (_ " ")))
arg t t))
(defun server-quote-arg (arg)
@@ -453,7 +499,7 @@ contains a space.
See `server-unquote-arg' and `server-process-filter'."
(replace-regexp-in-string
"[-&\n ]" (lambda (s)
- (case (aref s 0)
+ (pcase (aref s 0)
(?& "&&")
(?- "&-")
(?\n "&n")
@@ -474,47 +520,68 @@ Creates the directory if necessary and makes sure:
(setq dir (directory-file-name dir))
(let ((attrs (file-attributes dir 'integer)))
(unless attrs
- (letf (((default-file-modes) ?\700)) (make-directory dir t))
+ (cl-letf (((default-file-modes) ?\700)) (make-directory dir t))
(setq attrs (file-attributes dir 'integer)))
;; Check that it's safe for use.
(let* ((uid (nth 2 attrs))
(w32 (eq system-type 'windows-nt))
- (safe (catch :safe
- (unless (eq t (car attrs)) ; is a dir?
- (throw :safe nil))
- (when (and w32 (zerop uid)) ; on FAT32?
- (display-warning
- 'server
- (format "Using `%s' to store Emacs-server authentication files.
+ (safe (cond
+ ((not (eq t (car attrs))) nil) ; is a dir?
+ ((and w32 (zerop uid)) ; on FAT32?
+ (display-warning
+ 'server
+ (format "Using `%s' to store Emacs-server authentication files.
Directories on FAT32 filesystems are NOT secure against tampering.
See variable `server-auth-dir' for details."
- (file-name-as-directory dir))
- :warning)
- (throw :safe t))
- (unless (or (= uid (user-uid)) ; is the dir ours?
- (and w32
- ;; Files created on Windows by
- ;; Administrator (RID=500) have
- ;; the Administrators (RID=544)
- ;; group recorded as the owner.
- (= uid 544) (= (user-uid) 500)))
- (throw :safe nil))
- (when w32 ; on NTFS?
- (throw :safe t))
- (unless (zerop (logand ?\077 (file-modes dir)))
- (throw :safe nil))
- t)))
+ (file-name-as-directory dir))
+ :warning)
+ t)
+ ((and (/= uid (user-uid)) ; is the dir ours?
+ (or (not w32)
+ ;; Files created on Windows by Administrator
+ ;; (RID=500) have the Administrators (RID=544)
+ ;; group recorded as the owner.
+ (/= uid 544) (/= (user-uid) 500)))
+ nil)
+ (w32 t) ; on NTFS?
+ (t ; else, check permissions
+ (zerop (logand ?\077 (file-modes dir)))))))
(unless safe
(error "The directory `%s' is unsafe" dir)))))
+(defun server-generate-key ()
+ "Generate and return a random authentication key.
+The key is a 64-byte string of random chars in the range `!'..`~'.
+If called interactively, also inserts it into current buffer."
+ (interactive)
+ (let ((auth-key
+ (cl-loop repeat 64
+ collect (+ 33 (random 94)) into auth
+ finally return (concat auth))))
+ (if (called-interactively-p 'interactive)
+ (insert auth-key))
+ auth-key))
+
+(defun server-get-auth-key ()
+ "Return server's authentication key.
+
+If `server-auth-key' is nil, just call `server-generate-key'.
+Otherwise, if `server-auth-key' is a valid key, return it.
+If the key is not valid, signal an error."
+ (if server-auth-key
+ (if (string-match-p "^[!-~]\\{64\\}$" server-auth-key)
+ server-auth-key
+ (error "The key '%s' is invalid" server-auth-key))
+ (server-generate-key)))
+
;;;###autoload
(defun server-start (&optional leave-dead inhibit-prompt)
"Allow this Emacs process to be a server for client processes.
-This starts a server communications subprocess through which
-client \"editors\" can send your editing commands to this Emacs
-job. To use the server, set up the program `emacsclient' in the
-Emacs distribution as your standard \"editor\".
+This starts a server communications subprocess through which client
+\"editors\" can send your editing commands to this Emacs job.
+To use the server, set up the program `emacsclient' in the Emacs
+distribution as your standard \"editor\".
Optional argument LEAVE-DEAD (interactively, a prefix arg) means just
kill any existing server communications subprocess.
@@ -571,11 +638,13 @@ server or call `M-x server-force-delete' to forcibly disconnect it.")
(server-ensure-safe-dir server-dir)
(when server-process
(server-log (message "Restarting server")))
- (letf (((default-file-modes) ?\700))
+ (cl-letf (((default-file-modes) ?\700))
(add-hook 'suspend-tty-functions 'server-handle-suspend-tty)
(add-hook 'delete-frame-functions 'server-handle-delete-frame)
- (add-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function)
- (add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
+ (add-hook 'kill-buffer-query-functions
+ 'server-kill-buffer-query-function)
+ (add-hook 'kill-emacs-query-functions
+ 'server-kill-emacs-query-function)
(add-hook 'kill-emacs-hook 'server-force-stop) ;Cleanup upon exit.
(setq server-process
(apply #'make-network-process
@@ -601,13 +670,7 @@ server or call `M-x server-force-delete' to forcibly disconnect it.")
(unless server-process (error "Could not start server process"))
(process-put server-process :server-file server-file)
(when server-use-tcp
- (let ((auth-key
- (loop
- ;; The auth key is a 64-byte string of random chars in the
- ;; range `!'..`~'.
- repeat 64
- collect (+ 33 (random 94)) into auth
- finally return (concat auth))))
+ (let ((auth-key (server-get-auth-key)))
(process-put server-process :auth-key auth-key)
(with-temp-file server-file
(set-buffer-multibyte nil)
@@ -701,9 +764,29 @@ Server mode runs a process that accepts commands from the
(pp v)
(let ((text (buffer-substring-no-properties
(point-min) (point-max))))
- (server-send-string
- proc (format "-print %s\n"
- (server-quote-arg text)))))))))
+ (server-reply-print (server-quote-arg text) proc)))))))
+
+(defconst server-msg-size 1024
+ "Maximum size of a message sent to a client.")
+
+(defun server-reply-print (qtext proc)
+ "Send a `-print QTEXT' command to client PROC.
+QTEXT must be already quoted.
+This handles splitting the command if it would be bigger than
+`server-msg-size'."
+ (let ((prefix "-print ")
+ part)
+ (while (> (+ (length qtext) (length prefix) 1) server-msg-size)
+ ;; We have to split the string
+ (setq part (substring qtext 0 (- server-msg-size (length prefix) 1)))
+ ;; Don't split in the middle of a quote sequence
+ (if (string-match "\\(^\\|[^&]\\)\\(&&\\)+$" part)
+ ;; There is an uneven number of & at the end
+ (setq part (substring part 0 -1)))
+ (setq qtext (substring qtext (length part)))
+ (server-send-string proc (concat prefix part "\n"))
+ (setq prefix "-print-nonl "))
+ (server-send-string proc (concat prefix qtext "\n"))))
(defun server-create-tty-frame (tty type proc)
(unless tty
@@ -746,46 +829,53 @@ Server mode runs a process that accepts commands from the
(select-frame frame)
(process-put proc 'frame frame)
(process-put proc 'terminal (frame-terminal frame))
-
- ;; Display *scratch* by default.
- (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
-
frame))
(defun server-create-window-system-frame (display nowait proc parent-id
&optional parameters)
- (add-to-list 'frame-inherited-parameters 'client)
- (if (not (fboundp 'make-frame-on-display))
- (progn
- ;; This emacs does not support X.
- (server-log "Window system unsupported" proc)
- (server-send-string proc "-window-system-unsupported \n")
- nil)
- ;; Flag frame as client-created, but use a dummy client.
- ;; This will prevent the frame from being deleted when
- ;; emacsclient quits while also preventing
- ;; `server-save-buffers-kill-terminal' from unexpectedly
- ;; killing emacs on that frame.
- (let* ((params `((client . ,(if nowait 'nowait proc))
- ;; This is a leftover, see above.
- (environment . ,(process-get proc 'env))
- ,@parameters))
- (display (or display
- (frame-parameter nil 'display)
- (getenv "DISPLAY")
- (error "Please specify display")))
- frame)
- (if parent-id
- (push (cons 'parent-id (string-to-number parent-id)) params))
- (setq frame (make-frame-on-display display params))
- (server-log (format "%s created" frame) proc)
- (select-frame frame)
- (process-put proc 'frame frame)
- (process-put proc 'terminal (frame-terminal frame))
-
- ;; Display *scratch* by default.
- (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
- frame)))
+ (let* ((display (or display
+ (frame-parameter nil 'display)
+ (error "Please specify display.")))
+ (w (or (cdr (assq 'window-system parameters))
+ (window-system-for-display display))))
+
+ (unless (assq w window-system-initialization-alist)
+ (setq w nil))
+
+ ;; Special case for ns. This is because DISPLAY may not be set at all
+ ;; which in the ns case isn't an error. The variable display then becomes
+ ;; the fully qualified hostname, which make-frame-on-display below
+ ;; does not understand and throws an error.
+ ;; It may also be a valid X display, but if Emacs is compiled for ns, it
+ ;; can not make X frames.
+ (if (featurep 'ns-win)
+ (setq w 'ns display "ns"))
+
+ (cond (w
+ ;; Flag frame as client-created, but use a dummy client.
+ ;; This will prevent the frame from being deleted when
+ ;; emacsclient quits while also preventing
+ ;; `server-save-buffers-kill-terminal' from unexpectedly
+ ;; killing emacs on that frame.
+ (let* ((params `((client . ,(if nowait 'nowait proc))
+ ;; This is a leftover, see above.
+ (environment . ,(process-get proc 'env))
+ ,@parameters))
+ frame)
+ (if parent-id
+ (push (cons 'parent-id (string-to-number parent-id)) params))
+ (add-to-list 'frame-inherited-parameters 'client)
+ (setq frame (make-frame-on-display display params))
+ (server-log (format "%s created" frame) proc)
+ (select-frame frame)
+ (process-put proc 'frame frame)
+ (process-put proc 'terminal (frame-terminal frame))
+ frame))
+
+ (t
+ (server-log "Window system unsupported" proc)
+ (server-send-string proc "-window-system-unsupported \n")
+ nil))))
(defun server-goto-toplevel (proc)
(condition-case nil
@@ -818,7 +908,7 @@ Server mode runs a process that accepts commands from the
(process-put proc 'continuation nil)
(if continuation (ignore-errors (funcall continuation)))))
-(defun* server-process-filter (proc string)
+(cl-defun server-process-filter (proc string)
"Process a request from the server to edit some files.
PROC is the server process. STRING consists of a sequence of
commands prefixed by a dash. Some commands have arguments;
@@ -906,6 +996,11 @@ The following commands are accepted by the client:
Print STRING on stdout. Used to send values
returned by -eval.
+`-print-nonl STRING'
+ Print STRING on stdout. Used to continue a
+ preceding -print command that would be too big to send
+ in a single message.
+
`-error DESCRIPTION'
Signal an error and delete process PROC.
@@ -928,8 +1023,8 @@ The following commands are accepted by the client:
;; receive the error string and shut down on its own.
(sit-for 1)
(delete-process proc)
- ;; We return immediately
- (return-from server-process-filter)))
+ ;; We return immediately.
+ (cl-return-from server-process-filter)))
(let ((prev (process-get proc 'previous-string)))
(when prev
(setq string (concat prev string))
@@ -948,7 +1043,7 @@ The following commands are accepted by the client:
;; In earlier versions of server.el (where we used an `emacsserver'
;; process), there could be multiple lines. Nowadays this is not
;; supported any more.
- (assert (eq (match-end 0) (length string)))
+ (cl-assert (eq (match-end 0) (length string)))
(let ((request (substring string 0 (match-beginning 0)))
(coding-system (and (default-value 'enable-multibyte-characters)
(or file-name-coding-system
@@ -1003,8 +1098,9 @@ The following commands are accepted by the client:
;; -window-system: Open a new X frame.
(`"-window-system"
- (setq dontkill t)
- (setq tty-name 'window-system))
+ (if (fboundp 'x-create-frame)
+ (setq dontkill t
+ tty-name 'window-system)))
;; -resume: Resume a suspended tty frame.
(`"-resume"
@@ -1032,15 +1128,20 @@ The following commands are accepted by the client:
(setq dontkill t)
(pop args-left))
- ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client.
+ ;; -tty DEVICE-NAME TYPE: Open a new tty frame.
+ ;; (But if we see -window-system later, use that.)
(`"-tty"
(setq tty-name (pop args-left)
tty-type (pop args-left)
dontkill (or dontkill
(not use-current-frame)))
- ;; On Windows, emacsclient always asks for a tty frame.
- ;; If running a GUI server, force the frame type to GUI.
- (when (eq window-system 'w32)
+ ;; On Windows, emacsclient always asks for a tty
+ ;; frame. If running a GUI server, force the frame
+ ;; type to GUI. (Cygwin is perfectly happy with
+ ;; multi-tty support, so don't override the user's
+ ;; choice there.)
+ (when (and (eq system-type 'windows-nt)
+ (eq window-system 'w32))
(push "-window-system" args-left)))
;; -position LINE[:COLUMN]: Set point to the given
@@ -1089,11 +1190,19 @@ The following commands are accepted by the client:
(setq dir (pop args-left))
(if coding-system
(setq dir (decode-coding-string dir coding-system)))
- (setq dir (command-line-normalize-file-name dir)))
+ (setq dir (command-line-normalize-file-name dir))
+ (process-put proc 'server-client-directory dir))
;; Unknown command.
(arg (error "Unknown command: %s" arg))))
+ ;; If both -no-wait and -tty are given with file or sexp
+ ;; arguments, use an existing frame.
+ (and nowait
+ (not (eq tty-name 'window-system))
+ (or files commands)
+ (setq use-current-frame t))
+
(setq frame
(cond
((and use-current-frame
@@ -1143,12 +1252,17 @@ The following commands are accepted by the client:
;; including code that needs to wait.
(with-local-quit
(condition-case err
- (let* ((buffers
- (when files
- (server-visit-files files proc nowait))))
-
+ (let ((buffers (server-visit-files files proc nowait)))
(mapc 'funcall (nreverse commands))
+ ;; If we were told only to open a new client, obey
+ ;; `initial-buffer-choice' if it specifies a file.
+ (unless (or files commands)
+ (if (stringp initial-buffer-choice)
+ (find-file initial-buffer-choice)
+ (switch-to-buffer (get-buffer-create "*scratch*")
+ 'norecord)))
+
;; Delete the client if necessary.
(cond
(nowait
@@ -1525,43 +1639,58 @@ only these files will be asked to be saved."
nil)
(defun server-eval-at (server form)
- "Eval FORM on Emacs Server SERVER."
- (let ((auth-file (expand-file-name server server-auth-dir))
- (coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- address port secret process)
- (unless (file-exists-p auth-file)
- (error "No such server definition: %s" auth-file))
+ "Contact the Emacs server named SERVER and evaluate FORM there.
+Returns the result of the evaluation, or signals an error if it
+cannot contact the specified server. For example:
+ \(server-eval-at \"server\" '(emacs-pid))
+returns the process ID of the Emacs instance running \"server\"."
+ (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))
+ (server-file (expand-file-name server server-dir))
+ (coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ address port secret process)
+ (unless (file-exists-p server-file)
+ (error "No such server: %s" server))
(with-temp-buffer
- (insert-file-contents auth-file)
- (unless (looking-at "\\([0-9.]+\\):\\([0-9]+\\)")
- (error "Invalid auth file"))
- (setq address (match-string 1)
- port (string-to-number (match-string 2)))
- (forward-line 1)
- (setq secret (buffer-substring (point) (line-end-position)))
- (erase-buffer)
- (unless (setq process (open-network-stream "eval-at" (current-buffer)
- address port))
- (error "Unable to contact the server"))
- (set-process-query-on-exit-flag process nil)
- (process-send-string
- process
- (concat "-auth " secret " -eval "
- (replace-regexp-in-string
- " " "&_" (format "%S" form))
- "\n"))
+ (when server-use-tcp
+ (let ((coding-system-for-read 'no-conversion))
+ (insert-file-contents server-file)
+ (unless (looking-at "\\([0-9.]+\\):\\([0-9]+\\)")
+ (error "Invalid auth file"))
+ (setq address (match-string 1)
+ port (string-to-number (match-string 2)))
+ (forward-line 1)
+ (setq secret (buffer-substring (point) (line-end-position)))
+ (erase-buffer)))
+ (unless (setq process (make-network-process
+ :name "eval-at"
+ :buffer (current-buffer)
+ :host address
+ :service (if server-use-tcp port server-file)
+ :family (if server-use-tcp 'ipv4 'local)
+ :noquery t))
+ (error "Unable to contact the server"))
+ (if server-use-tcp
+ (process-send-string process (concat "-auth " secret "\n")))
+ (process-send-string process
+ (concat "-eval "
+ (server-quote-arg (format "%S" form))
+ "\n"))
(while (memq (process-status process) '(open run))
(accept-process-output process 0 10))
(goto-char (point-min))
;; If the result is nil, there's nothing in the buffer. If the
;; result is non-nil, it's after "-print ".
- (when (search-forward "\n-print" nil t)
- (let ((start (point)))
- (while (search-forward "&_" nil t)
- (replace-match " " t t))
- (goto-char start)
- (read (current-buffer)))))))
+ (let ((answer ""))
+ (while (re-search-forward "\n-print\\(-nonl\\)? " nil t)
+ (setq answer
+ (concat answer
+ (buffer-substring (point)
+ (progn (skip-chars-forward "^\n")
+ (point))))))
+ (if (not (equal answer ""))
+ (read (decode-coding-string (server-unquote-arg answer)
+ 'emacs-internal)))))))
(provide 'server)
diff --git a/lisp/ses.el b/lisp/ses.el
index d5947472c1a..a0b69232e19 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -1,6 +1,6 @@
;;; ses.el -- Simple Emacs Spreadsheet -*- coding: utf-8 -*-
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Vincent Belaïche <vincentb1@users.sourceforge.net>
@@ -56,7 +56,7 @@
;;; Code:
(require 'unsafep)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;----------------------------------------------------------------------------
@@ -65,6 +65,7 @@
(defgroup ses nil
"Simple Emacs Spreadsheet."
+ :tag "SES"
:group 'applications
:prefix "ses-"
:version "21.1")
@@ -277,11 +278,15 @@ default printer and then modify its output.")
ses--default-printer
ses--deferred-narrow ses--deferred-recalc
ses--deferred-write ses--file-format
+ ses--named-cell-hashmap
(ses--header-hscroll . -1) ; Flag for "initial recalc needed"
ses--header-row ses--header-string ses--linewidth
ses--numcols ses--numrows ses--symbolic-formulas
ses--data-marker ses--params-marker (ses--Dijkstra-attempt-nb . 0)
ses--Dijkstra-weight-bound
+ ;; This list is useful to speed-up clean-up of symbols when
+ ;; an area containing renamed cell is deleted.
+ ses--renamed-cell-symb-list
;; Global variables that we override
mode-line-process next-line-add-newlines transient-mark-mode)
"Buffer-local variables used by SES.")
@@ -358,6 +363,10 @@ when to emit a progress message.")
"From a CELL or a pair (ROW,COL), get the function that computes its value."
`(aref ,(if col `(ses-get-cell ,row ,col) row) 1))
+(defmacro ses-cell-formula-aset (cell formula)
+ "From a CELL set the function that computes its value."
+ `(aset ,cell 1 ,formula))
+
(defmacro ses-cell-printer (row &optional col)
"From a CELL or a pair (ROW,COL), get the function that prints its value."
`(aref ,(if col `(ses-get-cell ,row ,col) row) 2))
@@ -367,6 +376,19 @@ when to emit a progress message.")
functions refer to its value."
`(aref ,(if col `(ses-get-cell ,row ,col) row) 3))
+(defmacro ses-cell-references-aset (cell references)
+ "From a CELL set the list REFERENCES of symbols for cells the
+function of which refer to its value."
+ `(aset ,cell 3 ,references))
+
+(defun ses-cell-p (cell)
+ "Return non `nil' is CELL is a cell of current buffer."
+ (and (vectorp cell)
+ (= (length cell) 5)
+ (eq cell (let ((rowcol (ses-sym-rowcol (ses-cell-symbol cell))))
+ (and (consp rowcol)
+ (ses-get-cell (car rowcol) (cdr rowcol)))))))
+
(defun ses-cell-property-get-fun (property-name cell)
;; To speed up property fetching, each time a property is found it is placed
;; in the first position. This way, after the first get, the full property
@@ -490,9 +512,22 @@ PROPERTY-NAME."
`(aref ses--col-printers ,col))
(defmacro ses-sym-rowcol (sym)
- "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0).
-Result is nil if SYM is not a symbol that names a cell."
- `(and (symbolp ,sym) (get ,sym 'ses-cell)))
+ "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0). Result
+is nil if SYM is not a symbol that names a cell."
+ `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell))))
+ (if (eq rc :ses-named)
+ (gethash ,sym ses--named-cell-hashmap)
+ rc)))
+
+(defun ses-is-cell-sym-p (sym)
+ "Check whether SYM point at a cell of this spread sheet."
+ (let ((rowcol (get sym 'ses-cell)))
+ (and rowcol
+ (if (eq rowcol :ses-named)
+ (and ses--named-cell-hashmap (gethash sym ses--named-cell-hashmap))
+ (and (< (car rowcol) ses--numrows)
+ (< (cdr rowcol) ses--numcols)
+ (eq (ses-cell-symbol (car rowcol) (cdr rowcol)) sym))))))
(defmacro ses-cell (sym value formula printer references)
"Load a cell SYM from the spreadsheet file. Does not recompute VALUE from
@@ -661,6 +696,28 @@ for this spreadsheet."
"Produce a symbol that names the cell (ROW,COL). (0,0) => 'A1."
(intern (concat (ses-column-letter col) (number-to-string (1+ row)))))
+(defun ses-decode-cell-symbol (str)
+ "Decode a symbol \"A1\" => (0,0). Returns `nil' if STR is not a
+ canonical cell name. Does not save match data."
+ (let (case-fold-search)
+ (and (string-match "\\`\\([A-Z]+\\)\\([0-9]+\\)\\'" str)
+ (let* ((col-str (match-string-no-properties 1 str))
+ (col 0)
+ (col-offset 0)
+ (col-base 1)
+ (col-idx (1- (length col-str)))
+ (row (1- (string-to-number (match-string-no-properties 2 str)))))
+ (and (>= row 0)
+ (progn
+ (while
+ (progn
+ (setq col (+ col (* (- (aref col-str col-idx) ?A) col-base))
+ col-base (* col-base 26)
+ col-idx (1- col-idx))
+ (and (>= col-idx 0)
+ (setq col (+ col col-base)))))
+ (cons row col)))))))
+
(defun ses-create-cell-variable-range (minrow maxrow mincol maxcol)
"Create buffer-local variables for cells. This is undoable."
(push `(apply ses-destroy-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol)
@@ -674,6 +731,21 @@ for this spreadsheet."
(put sym 'ses-cell (cons xrow xcol))
(make-local-variable sym)))))
+(defun ses-create-cell-variable (sym row col)
+ "Create a buffer-local variable `SYM' for cell at position (ROW, COL).
+
+SYM is the symbol for that variable, ROW and COL are integers for
+row and column of the cell, with numbering starting from 0.
+
+Return nil in case of failure."
+ (unless (local-variable-p sym)
+ (make-local-variable sym)
+ (if (let (case-fold-search) (string-match "\\`[A-Z]+[0-9]+\\'" (symbol-name sym)))
+ (put sym 'ses-cell (cons row col))
+ (put sym 'ses-cell :ses-named)
+ (setq ses--named-cell-hashmap (or ses--named-cell-hashmap (make-hash-table :test 'eq)))
+ (puthash sym (cons row col) ses--named-cell-hashmap))))
+
;; We do not delete the ses-cell properties for the cell-variables, in
;; case a formula that refers to this cell is in the kill-ring and is
;; later pasted back in.
@@ -682,7 +754,10 @@ for this spreadsheet."
(let (sym)
(dotimes (row (1+ (- maxrow minrow)))
(dotimes (col (1+ (- maxcol mincol)))
- (setq sym (ses-create-cell-symbol (+ row minrow) (+ col mincol)))
+ (let ((xrow (+ row minrow)) (xcol (+ col mincol)))
+ (setq sym (if (and (< xrow ses--numrows) (< xcol ses--numcols))
+ (ses-cell-symbol xrow xcol)
+ (ses-create-cell-symbol xrow xcol))))
(if (boundp sym)
(push `(apply ses-set-with-undo ,sym ,(symbol-value sym))
buffer-undo-list))
@@ -923,6 +998,7 @@ the old and FORCE is nil."
(defcustom ses-self-reference-early-detection nil
"True if cycle detection is early for cells that refer to themselves."
+ :version "24.1"
:type 'boolean
:group 'ses)
@@ -1234,11 +1310,9 @@ when the width of cell (ROW,COL) has changed."
;; The data area
;;----------------------------------------------------------------------------
-(defun ses-narrowed-p () (/= (- (point-max) (point-min)) (buffer-size)))
-
(defun ses-widen ()
"Turn off narrowing, to be reenabled at end of command loop."
- (if (ses-narrowed-p)
+ (if (buffer-narrowed-p)
(setq ses--deferred-narrow t))
(widen))
@@ -1399,7 +1473,8 @@ removed. Example:
Sets `ses-relocate-return' to 'delete if cell-references were removed."
(let (rowcol result)
(if (or (atom formula) (eq (car formula) 'quote))
- (if (setq rowcol (ses-sym-rowcol formula))
+ (if (and (setq rowcol (ses-sym-rowcol formula))
+ (string-match "\\`[A-Z]+[0-9]+\\'" (symbol-name formula)))
(ses-relocate-symbol formula rowcol
startrow startcol rowincr colincr)
formula) ; Pass through as-is.
@@ -1500,21 +1575,22 @@ if the range was altered."
(funcall field (ses-sym-rowcol min))))
;; This range has changed size.
(setq ses-relocate-return 'range))
- `(ses-range ,min ,max ,@(cdddr range)))))
+ `(ses-range ,min ,max ,@(cl-cdddr range)))))
(defun ses-relocate-all (minrow mincol rowincr colincr)
"Alter all cell values, symbols, formulas, and reference-lists to relocate
the rectangle (MINROW,MINCOL)..(NUMROWS,NUMCOLS) by adding ROWINCR and COLINCR
to each symbol."
(let (reform)
- (let (mycell newval)
+ (let (mycell newval xrow)
(dotimes-with-progress-reporter
(row ses--numrows) "Relocating formulas..."
(dotimes (col ses--numcols)
(setq ses-relocate-return nil
mycell (ses-get-cell row col)
newval (ses-relocate-formula (ses-cell-formula mycell)
- minrow mincol rowincr colincr))
+ minrow mincol rowincr colincr)
+ xrow (- row rowincr))
(ses-set-cell row col 'formula newval)
(if (eq ses-relocate-return 'range)
;; This cell contains a (ses-range X Y) where a cell has been
@@ -1530,8 +1606,22 @@ to each symbol."
minrow mincol rowincr colincr))
(ses-set-cell row col 'references newval)
(and (>= row minrow) (>= col mincol)
- (ses-set-cell row col 'symbol
- (ses-create-cell-symbol row col))))))
+ (let ((sym (ses-cell-symbol row col))
+ (xcol (- col colincr)))
+ (if (and
+ sym
+ (>= xrow 0)
+ (>= xcol 0)
+ (null (eq sym
+ (ses-create-cell-symbol xrow xcol))))
+ ;; This is a renamed cell, do not update the cell
+ ;; name, but just update the coordinate property.
+ (put sym 'ses-cell (cons row col))
+ (ses-set-cell row col 'symbol
+ (setq sym (ses-create-cell-symbol row col)))
+ (unless (and (boundp sym) (local-variable-p sym))
+ (set (make-local-variable sym) nil)
+ (put sym 'ses-cell (cons row col)))))) )))
;; Relocate the cell values.
(let (oldval myrow mycol xrow xcol)
(cond
@@ -1544,11 +1634,17 @@ to each symbol."
(setq mycol (+ col mincol)
xrow (- myrow rowincr)
xcol (- mycol colincr))
- (if (and (< xrow ses--numrows) (< xcol ses--numcols))
- (setq oldval (ses-cell-value xrow xcol))
- ;; Cell is off the end of the array.
- (setq oldval (symbol-value (ses-create-cell-symbol xrow xcol))))
- (ses-set-cell myrow mycol 'value oldval))))
+ (let ((sym (ses-cell-symbol myrow mycol))
+ (xsym (ses-create-cell-symbol xrow xcol)))
+ ;; Make the value relocation only when if the cell is not
+ ;; a renamed cell. Otherwise this is not needed.
+ (and (eq sym xsym)
+ (ses-set-cell myrow mycol 'value
+ (if (and (< xrow ses--numrows) (< xcol ses--numcols))
+ (ses-cell-value xrow xcol)
+ ;;Cell is off the end of the array
+ (symbol-value xsym))))))))
+
((and (wholenump rowincr) (wholenump colincr))
;; Insertion of rows and/or columns. Run the loop backwards.
(let ((disty (1- ses--numrows))
@@ -1658,7 +1754,6 @@ Does not execute cell formulas or print functions."
(message "Upgrading from SES-1 file format")))
(or (= ses--file-format 2)
(error "This file needs a newer version of the SES library code"))
- (ses-create-cell-variable-range 0 (1- ses--numrows) 0 (1- ses--numcols))
;; Initialize cell array.
(setq ses--cells (make-vector ses--numrows nil))
(dotimes (row ses--numrows)
@@ -1678,11 +1773,10 @@ Does not execute cell formulas or print functions."
(dotimes (row ses--numrows)
(dotimes (col ses--numcols)
(let* ((x (read (current-buffer)))
- (rowcol (ses-sym-rowcol (car-safe (cdr-safe x)))))
+ (sym (car-safe (cdr-safe x))))
(or (and (looking-at "\n")
(eq (car-safe x) 'ses-cell)
- (eq row (car rowcol))
- (eq col (cdr rowcol)))
+ (ses-create-cell-variable sym row col))
(error "Cell-def error"))
(eval x)))
(or (looking-at "\n\n")
@@ -1894,7 +1988,7 @@ narrows the buffer now."
;; do the narrowing.
(narrow-to-region (point-min) ses--data-marker)
(setq ses--deferred-narrow nil))
- ;; Update the modeline.
+ ;; Update the mode line.
(let ((oldcell ses--curcell))
(ses-set-curcell)
(unless (eq ses--curcell oldcell)
@@ -3139,6 +3233,88 @@ highlighted range in the spreadsheet."
(mouse-set-point event)
(ses-insert-ses-range))
+(defun ses-replace-name-in-formula (formula old-name new-name)
+ (let ((new-formula formula))
+ (unless (and (consp formula)
+ (eq (car-safe formula) 'quote))
+ (while formula
+ (let ((elt (car-safe formula)))
+ (cond
+ ((consp elt)
+ (setcar formula (ses-replace-name-in-formula elt old-name new-name)))
+ ((and (symbolp elt)
+ (eq (car-safe formula) old-name))
+ (setcar formula new-name))))
+ (setq formula (cdr formula))))
+ new-formula))
+
+(defun ses-rename-cell (new-name &optional cell)
+ "Rename current cell."
+ (interactive "*SEnter new name: ")
+ (or
+ (and (local-variable-p new-name)
+ (ses-is-cell-sym-p new-name)
+ (error "Already a cell name"))
+ (and (boundp new-name)
+ (null (yes-or-no-p (format "`%S' is already bound outside this buffer, continue? "
+ new-name)))
+ (error "Already a bound cell name")))
+ (let* (curcell
+ (sym (if (ses-cell-p cell)
+ (ses-cell-symbol cell)
+ (setq cell nil
+ curcell t)
+ (ses-check-curcell)
+ ses--curcell))
+ (rowcol (ses-sym-rowcol sym))
+ (row (car rowcol))
+ (col (cdr rowcol))
+ new-rowcol old-name)
+ (setq cell (or cell (ses-get-cell row col))
+ old-name (ses-cell-symbol cell)
+ new-rowcol (ses-decode-cell-symbol (symbol-name new-name)))
+ (if new-rowcol
+ (if (equal new-rowcol rowcol)
+ (put new-name 'ses-cell rowcol)
+ (error "Not a valid name for this cell location"))
+ (setq ses--named-cell-hashmap (or ses--named-cell-hashmap (make-hash-table :test 'eq)))
+ (put new-name 'ses-cell :ses-named)
+ (puthash new-name rowcol ses--named-cell-hashmap))
+ (push `(ses-rename-cell ,old-name ,cell) buffer-undo-list)
+ ;; replace name by new name in formula of cells refering to renamed cell
+ (dolist (ref (ses-cell-references cell))
+ (let* ((x (ses-sym-rowcol ref))
+ (xcell (ses-get-cell (car x) (cdr x))))
+ (ses-cell-formula-aset xcell
+ (ses-replace-name-in-formula
+ (ses-cell-formula xcell)
+ sym
+ new-name))))
+ ;; replace name by new name in reference list of cells to which renamed cell refers to
+ (dolist (ref (ses-formula-references (ses-cell-formula cell)))
+ (let* ((x (ses-sym-rowcol ref))
+ (xcell (ses-get-cell (car x) (cdr x))))
+ (ses-cell-references-aset xcell
+ (cons new-name (delq sym
+ (ses-cell-references xcell))))))
+ (push new-name ses--renamed-cell-symb-list)
+ (set new-name (symbol-value sym))
+ (aset cell 0 new-name)
+ (makunbound sym)
+ (and curcell (setq ses--curcell new-name))
+ (let* ((pos (point))
+ (inhibit-read-only t)
+ (col (current-column))
+ (end (save-excursion
+ (move-to-column (1+ col))
+ (if (eolp)
+ (+ pos (ses-col-width col) 1)
+ (point)))))
+ (put-text-property pos end 'intangible new-name))
+ ;; update mode line
+ (setq mode-line-process (list " cell "
+ (symbol-name new-name)))
+ (force-mode-line-update)))
;;----------------------------------------------------------------------------
;; Checking formulas for safety
@@ -3249,19 +3425,20 @@ Use `math-format-value' as a printer for Calc objects."
(push result-row result)
(while rest
(let ((x (pop rest)))
- (case x
- ((>v) (setq transpose nil reorient-x nil reorient-y nil))
- ((>^)(setq transpose nil reorient-x nil reorient-y t))
- ((<^)(setq transpose nil reorient-x t reorient-y t))
- ((<v)(setq transpose nil reorient-x t reorient-y nil))
- ((v>)(setq transpose t reorient-x nil reorient-y t))
- ((^>)(setq transpose t reorient-x nil reorient-y nil))
- ((^<)(setq transpose t reorient-x t reorient-y nil))
- ((v<)(setq transpose t reorient-x t reorient-y t))
- ((* *2 *1) (setq vectorize x))
- ((!) (setq clean 'ses--clean-!))
- ((_) (setq clean `(lambda (&rest x) (ses--clean-_ x ,(if rest (pop rest) 0)))))
- (t
+ (pcase x
+ (`>v (setq transpose nil reorient-x nil reorient-y nil))
+ (`>^ (setq transpose nil reorient-x nil reorient-y t))
+ (`<^ (setq transpose nil reorient-x t reorient-y t))
+ (`<v (setq transpose nil reorient-x t reorient-y nil))
+ (`v> (setq transpose t reorient-x nil reorient-y t))
+ (`^> (setq transpose t reorient-x nil reorient-y nil))
+ (`^< (setq transpose t reorient-x t reorient-y nil))
+ (`v< (setq transpose t reorient-x t reorient-y t))
+ ((or `* `*2 `*1) (setq vectorize x))
+ (`! (setq clean 'ses--clean-!))
+ (`_ (setq clean `(lambda (&rest x)
+ (ses--clean-_ x ,(if rest (pop rest) 0)))))
+ (_
(cond
; shorthands one row
((and (null (cddr result)) (memq x '(> <)))
@@ -3284,21 +3461,23 @@ Use `math-format-value' as a printer for Calc objects."
(setq iter (cdr iter))))
(setq result ret)))
- (flet ((vectorize-*1
- (clean result)
- (cons clean (cons (quote 'vec) (apply 'append result))))
- (vectorize-*2
- (clean result)
- (cons clean (cons (quote 'vec) (mapcar (lambda (x)
- (cons clean (cons (quote 'vec) x)))
- result)))))
- (case vectorize
- ((nil) (cons clean (apply 'append result)))
- ((*1) (vectorize-*1 clean result))
- ((*2) (vectorize-*2 clean result))
- ((*) (if (cdr result)
- (vectorize-*2 clean result)
- (vectorize-*1 clean result)))))))
+ (cl-flet ((vectorize-*1
+ (clean result)
+ (cons clean (cons (quote 'vec) (apply 'append result))))
+ (vectorize-*2
+ (clean result)
+ (cons clean (cons (quote 'vec)
+ (mapcar (lambda (x)
+ (cons clean (cons (quote 'vec) x)))
+ result)))))
+ (pcase vectorize
+ (`nil (cons clean (apply 'append result)))
+ (`*1 (vectorize-*1 clean result))
+ (`*2 (vectorize-*2 clean result))
+ (`* (funcall (if (cdr result)
+ #'vectorize-*2
+ #'vectorize-*1)
+ clean result))))))
(defun ses-delete-blanks (&rest args)
"Return ARGS reversed, with the blank elements (nil and *skip*) removed."
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 1a929ebb58a..6d432f6caba 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -1,6 +1,6 @@
;;; shadowfile.el --- automatic file copying
-;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: comm files
diff --git a/lisp/shell.el b/lisp/shell.el
index fdfc8b3cf19..77a42389785 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -1,6 +1,6 @@
;;; shell.el --- specialized comint.el for running the shell -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 1993-1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1993-1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
;; Simon Marshall <simon@gnu.org>
@@ -46,7 +46,7 @@
;; YOUR .EMACS FILE
;;=============================================================================
-;; Some suggestions for your .emacs file.
+;; Some suggestions for your init file.
;;
;; ;; Define M-# to run some strange command:
;; (eval-after-load "shell"
@@ -96,7 +96,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'comint)
(require 'pcomplete)
@@ -137,9 +136,7 @@ how Shell mode treats paragraphs.
The pattern should probably not match more than one line. If it does,
Shell mode may become confused trying to distinguish prompt from input
-on lines which don't start with a prompt.
-
-This is a fine thing to set in your `.emacs' file."
+on lines which don't start with a prompt."
:type 'regexp
:group 'shell)
@@ -147,55 +144,51 @@ This is a fine thing to set in your `.emacs' file."
"List of suffixes to be disregarded during file/command completion.
This variable is used to initialize `comint-completion-fignore' in the shell
buffer. The default is nil, for compatibility with most shells.
-Some people like (\"~\" \"#\" \"%\").
-
-This is a fine thing to set in your `.emacs' file."
+Some people like (\"~\" \"#\" \"%\")."
:type '(repeat (string :tag "Suffix"))
:group 'shell)
-(defcustom shell-delimiter-argument-list nil ; '(?\| ?& ?< ?> ?\( ?\) ?\;)
+(defcustom shell-delimiter-argument-list '(?\| ?& ?< ?> ?\( ?\) ?\;)
"List of characters to recognize as separate arguments.
This variable is used to initialize `comint-delimiter-argument-list' in the
shell buffer. The value may depend on the operating system or shell."
:type '(choice (const nil)
(repeat :tag "List of characters" character))
- :version "24.1" ; changed to nil (bug#8027)
:group 'shell)
-(defvar shell-file-name-chars
+(defcustom shell-file-name-chars
(if (memq system-type '(ms-dos windows-nt cygwin))
"~/A-Za-z0-9_^$!#%&{}@`'.,:()-"
"[]~/A-Za-z0-9+@:_.$#%,={}-")
"String of characters valid in a file name.
This variable is used to initialize `comint-file-name-chars' in the
-shell buffer. The value may depend on the operating system or shell.
-
-This is a fine thing to set in your `.emacs' file.")
+shell buffer. The value may depend on the operating system or shell."
+ :type 'string
+ :group 'shell)
-(defvar shell-file-name-quote-list
+(defcustom shell-file-name-quote-list
(if (memq system-type '(ms-dos windows-nt))
nil
(append shell-delimiter-argument-list '(?\s ?$ ?\* ?\! ?\" ?\' ?\` ?\# ?\\)))
"List of characters to quote when in a file name.
This variable is used to initialize `comint-file-name-quote-list' in the
-shell buffer. The value may depend on the operating system or shell.
-
-This is a fine thing to set in your `.emacs' file.")
+shell buffer. The value may depend on the operating system or shell."
+ :type '(repeat character)
+ :group 'shell)
-(defvar shell-dynamic-complete-functions
+(defcustom shell-dynamic-complete-functions
'(comint-c-a-p-replace-by-expanded-history
shell-environment-variable-completion
shell-command-completion
shell-c-a-p-replace-by-expanded-directory
pcomplete-completions-at-point
shell-filename-completion
- ;; Not sure when this one would still be useful. --Stef
comint-filename-completion)
"List of functions called to perform completion.
This variable is used to initialize `comint-dynamic-complete-functions' in the
-shell buffer.
-
-This is a fine thing to set in your `.emacs' file.")
+shell buffer."
+ :type '(repeat function)
+ :group 'shell)
(defcustom shell-command-regexp "[^;&|\n]+"
"Regexp to match a single command within a pipeline.
@@ -372,20 +365,57 @@ Thus, this does not include the shell's current directory.")
;;; Basic Procedures
-(defcustom shell-dir-cookie-re nil
- "Regexp matching your prompt, including some part of the current directory.
-If your prompt includes the current directory or the last few elements of it,
-set this to a pattern that matches your prompt and whose subgroup 1 matches
-the directory part of it.
-This is used by `shell-dir-cookie-watcher' to try and use this info
-to track your current directory. It can be used instead of or in addition
-to `dirtrack-mode'."
- :group 'shell
- :type '(choice (const nil) regexp)
- :version "24.1")
-
-(defun shell-parse-pcomplete-arguments ()
+(defun shell--unquote&requote-argument (qstr &optional upos)
+ (unless upos (setq upos 0))
+ (let* ((qpos 0)
+ (dquotes nil)
+ (ustrs '())
+ (re (concat
+ "[\"']"
+ "\\|\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
+ "\\|{\\(?1:[^{}]+\\)}\\)"
+ (when (memq system-type '(ms-dos windows-nt))
+ "\\|%\\(?1:[^\\\\/]*\\)%")
+ (when comint-file-name-quote-list
+ "\\|\\\\\\(.\\)")))
+ (qupos nil)
+ (push (lambda (str end)
+ (push str ustrs)
+ (setq upos (- upos (length str)))
+ (unless (or qupos (> upos 0))
+ (setq qupos (if (< end 0) (- end) (+ upos end))))))
+ match)
+ (while (setq match (string-match re qstr qpos))
+ (funcall push (substring qstr qpos match) match)
+ (cond
+ ((match-beginning 2) (funcall push (match-string 2 qstr) (match-end 0)))
+ ((match-beginning 1) (funcall push (getenv (match-string 1 qstr))
+ (- (match-end 0))))
+ ((eq (aref qstr match) ?\") (setq dquotes (not dquotes)))
+ ((eq (aref qstr match) ?\')
+ (cond
+ (dquotes (funcall push "'" (match-end 0)))
+ ((< match (1+ (length qstr)))
+ (let ((end (string-match "'" qstr (1+ match))))
+ (funcall push (substring qstr (1+ match) end)
+ (or end (length qstr)))))
+ (t nil)))
+ (t (error "Unexpected case in shell--unquote&requote-argument!")))
+ (setq qpos (match-end 0)))
+ (funcall push (substring qstr qpos) (length qstr))
+ (list (mapconcat #'identity (nreverse ustrs) "")
+ qupos #'comint-quote-filename)))
+
+(defun shell--unquote-argument (str)
+ (car (shell--unquote&requote-argument str)))
+(defun shell--requote-argument (upos qstr)
+ ;; See `completion-table-with-quoting'.
+ (let ((res (shell--unquote&requote-argument qstr upos)))
+ (cons (nth 1 res) (nth 2 res))))
+
+(defun shell--parse-pcomplete-arguments ()
"Parse whitespace separated arguments in the current region."
+ ;; FIXME: share code with shell--unquote&requote-argument.
(let ((begin (save-excursion (shell-backward-command 1) (point)))
(end (point))
begins args)
@@ -405,12 +435,16 @@ to `dirtrack-mode'."
(goto-char (match-end 0))
(cond
((match-beginning 3) ;Backslash escape.
- (push (if (= (match-beginning 3) (match-end 3))
- "\\" (match-string 3))
+ (push (cond
+ ((null comint-file-name-quote-list)
+ (goto-char (match-beginning 3)) "\\")
+ ((= (match-beginning 3) (match-end 3)) "\\")
+ (t (match-string 3)))
arg))
((match-beginning 2) ;Double quote.
- (push (replace-regexp-in-string
- "\\\\\\(.\\)" "\\1" (match-string 2))
+ (push (if (null comint-file-name-quote-list) (match-string 2)
+ (replace-regexp-in-string
+ "\\\\\\(.\\)" "\\1" (match-string 2)))
arg))
((match-beginning 1) ;Single quote.
(push (match-string 1) arg))
@@ -418,6 +452,15 @@ to `dirtrack-mode'."
(push (mapconcat #'identity (nreverse arg) "") args)))
(cons (nreverse args) (nreverse begins)))))
+(defun shell-command-completion-function ()
+ "Completion function for shell command names.
+This is the value of `pcomplete-command-completion-function' for
+Shell buffers. It implements `shell-completion-execonly' for
+`pcomplete' completion."
+ (pcomplete-here (pcomplete-entries nil
+ (if shell-completion-execonly
+ 'file-executable-p))))
+
(defun shell-completion-vars ()
"Setup completion vars for `shell-mode' and `read-shell-command'."
(set (make-local-variable 'comint-completion-fignore)
@@ -429,16 +472,18 @@ to `dirtrack-mode'."
shell-file-name-quote-list)
(set (make-local-variable 'comint-dynamic-complete-functions)
shell-dynamic-complete-functions)
+ (setq-local comint-unquote-function #'shell--unquote-argument)
+ (setq-local comint-requote-function #'shell--requote-argument)
(set (make-local-variable 'pcomplete-parse-arguments-function)
- #'shell-parse-pcomplete-arguments)
- (set (make-local-variable 'pcomplete-arg-quote-list)
- (append "\\ \t\n\r\"'`$|&;(){}[]<>#" nil))
+ #'shell--parse-pcomplete-arguments)
(set (make-local-variable 'pcomplete-termination-string)
(cond ((not comint-completion-addsuffix) "")
((stringp comint-completion-addsuffix)
comint-completion-addsuffix)
((not (consp comint-completion-addsuffix)) " ")
(t (cdr comint-completion-addsuffix))))
+ (set (make-local-variable 'pcomplete-command-completion-function)
+ #'shell-command-completion-function)
;; Don't use pcomplete's defaulting mechanism, rely on
;; shell-dynamic-complete-functions instead.
(set (make-local-variable 'pcomplete-default-completion-function) #'ignore)
@@ -472,7 +517,7 @@ to continue it.
keep this buffer's default directory the same as the shell's working directory.
While directory tracking is enabled, the shell's working directory is displayed
by \\[list-buffers] or \\[mouse-buffer-menu] in the `File' field.
-\\[dirs] queries the shell and resyncs Emacs' idea of what the current
+\\[dirs] queries the shell and resyncs Emacs's idea of what the current
directory stack is.
\\[shell-dirtrack-mode] turns directory tracking on and off.
\(The `dirtrack' package provides an alternative implementation of this
@@ -511,6 +556,16 @@ buffer."
(set (make-local-variable 'shell-dirstack) nil)
(set (make-local-variable 'shell-last-dir) nil)
(shell-dirtrack-mode 1)
+
+ ;; By default, ansi-color applies faces using overlays. This is
+ ;; very inefficient in Shell buffers (e.g. Bug#10835). We use a
+ ;; custom `ansi-color-apply-face-function' to convert color escape
+ ;; sequences into `font-lock-face' properties.
+ (set (make-local-variable 'ansi-color-apply-face-function)
+ (lambda (beg end face)
+ (when face
+ (put-text-property beg end 'font-lock-face face))))
+
;; This is not really correct, since the shell buffer does not really
;; edit this directory. But it is useful in the buffer list and menus.
(setq list-buffers-directory (expand-file-name default-directory))
@@ -546,10 +601,6 @@ buffer."
(when (string-equal shell "bash")
(add-hook 'comint-preoutput-filter-functions
'shell-filter-ctrl-a-ctrl-b nil t)))
- (when shell-dir-cookie-re
- ;; Watch for magic cookies in the output to track the current dir.
- (add-hook 'comint-output-filter-functions
- 'shell-dir-cookie-watcher nil t))
(comint-read-input-ring t)))
(defun shell-filter-ctrl-a-ctrl-b (string)
@@ -630,7 +681,6 @@ Otherwise, one argument `-i' is passed to the shell.
(read-directory-name
"Default directory: " default-directory default-directory
t nil))))))))
- (require 'ansi-color)
(setq buffer (if (or buffer (not (derived-mode-p 'shell-mode))
(comint-check-proc (current-buffer)))
(get-buffer-create (or buffer "*shell*"))
@@ -710,20 +760,6 @@ Otherwise, one argument `-i' is passed to the shell.
;; replace it with a process filter that watches for and strips out
;; these messages.
-(defun shell-dir-cookie-watcher (text)
- ;; This is fragile: the TEXT could be split into several chunks and we'd
- ;; miss it. Oh well. It's a best effort anyway. I'd expect that it's
- ;; rather unusual to have the prompt split into several packets, but
- ;; I'm sure Murphy will prove me wrong.
- (when (and shell-dir-cookie-re (string-match shell-dir-cookie-re text))
- (let ((dir (match-string 1 text)))
- (cond
- ((file-name-absolute-p dir) (shell-cd dir))
- ;; Let's try and see if it seems to be up or down from where we were.
- ((string-match "\\`\\(.*\\)\\(?:/.*\\)?\n\\(.*/\\)\\1\\(?:/.*\\)?\\'"
- (setq text (concat dir "\n" default-directory)))
- (shell-cd (concat (match-string 2 text) dir)))))))
-
(defun shell-directory-tracker (str)
"Tracks cd, pushd and popd commands issued to the shell.
This function is called on each input passed to the shell.
@@ -1200,7 +1236,7 @@ Returns non-nil if successful."
(variables (mapcar (lambda (x)
(substring x 0 (string-match "=" x)))
process-environment))
- (suffix (case (char-before start) (?\{ "}") (?\( ")") (t ""))))
+ (suffix (pcase (char-before start) (?\{ "}") (?\( ")") (_ ""))))
(list start end variables
:exit-function
(lambda (s finished)
diff --git a/lisp/simple.el b/lisp/simple.el
index b7165c9f6a9..5867561da26 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1,6 +1,6 @@
;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985-1987, 1993-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
@@ -28,8 +28,6 @@
;;; Code:
-(eval-when-compile (require 'cl)) ;For define-minor-mode.
-
(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())
@@ -321,9 +319,11 @@ select the source buffer."
(define-minor-mode next-error-follow-minor-mode
"Minor mode for compilation, occur and diff modes.
+With a prefix argument ARG, enable mode if ARG is positive, and
+disable it otherwise. If called from Lisp, enable mode if ARG is
+omitted or nil.
When turned on, cursor motion in the compilation, grep, occur or diff
-buffer causes automatic display of the corresponding source code
-location."
+buffer causes automatic display of the corresponding source code location."
:group 'next-error :init-value nil :lighter " Fol"
(if (not next-error-follow-minor-mode)
(remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t)
@@ -365,7 +365,6 @@ Other major modes are defined by comparison with this one."
(define-key map ">" 'end-of-buffer)
(define-key map "<" 'beginning-of-buffer)
(define-key map "g" 'revert-buffer)
- (define-key map "z" 'kill-this-buffer)
map))
(put 'special-mode 'mode-class 'special)
@@ -564,13 +563,28 @@ On nonblank line, delete any immediately following blank lines."
(if (looking-at "^[ \t]*\n\\'")
(delete-region (point) (point-max)))))
+(defcustom delete-trailing-lines t
+ "If non-nil, \\[delete-trailing-whitespace] deletes trailing lines.
+Trailing lines are deleted only if `delete-trailing-whitespace'
+is called on the entire buffer (rather than an active region)."
+ :type 'boolean
+ :group 'editing
+ :version "24.3")
+
(defun delete-trailing-whitespace (&optional start end)
- "Delete all the trailing whitespace across the current buffer.
-All whitespace after the last non-whitespace character in a line is deleted.
-This respects narrowing, created by \\[narrow-to-region] and friends.
-A formfeed is not considered whitespace by this function.
-If END is nil, also delete all trailing lines at the end of the buffer.
-If the region is active, only delete whitespace within the region."
+ "Delete trailing whitespace between START and END.
+If called interactively, START and END are the start/end of the
+region if the mark is active, or of the buffer's accessible
+portion if the mark is inactive.
+
+This command deletes whitespace characters after the last
+non-whitespace character in each line between START and END. It
+does not consider formfeed characters to be whitespace.
+
+If this command acts on the entire buffer (i.e. if called
+interactively with the mark inactive, or called from Lisp with
+END nil), it also deletes all trailing lines at the end of the
+buffer if the variable `delete-trailing-lines' is non-nil."
(interactive (progn
(barf-if-buffer-read-only)
(if (use-region-p)
@@ -590,8 +604,9 @@ If the region is active, only delete whitespace within the region."
;; Delete trailing empty lines.
(goto-char end-marker)
(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))))
@@ -815,7 +830,7 @@ instead of deleted."
:type '(choice (const :tag "Delete active region" t)
(const :tag "Kill active region" kill)
(const :tag "Do ordinary deletion" nil))
- :group 'editing
+ :group 'killing
:version "24.1")
(defun delete-backward-char (n &optional killflag)
@@ -891,16 +906,23 @@ that uses or sets the mark."
;; Counting lines, one way or another.
(defun goto-line (line &optional buffer)
- "Goto LINE, counting from line 1 at beginning of buffer.
-Normally, move point in the current buffer, and leave mark at the
-previous position. With just \\[universal-argument] as argument,
-move point in the most recently selected other buffer, and switch to it.
+ "Go to LINE, counting from line 1 at beginning of buffer.
+If called interactively, a numeric prefix argument specifies
+LINE; without a numeric prefix argument, read LINE from the
+minibuffer.
-If there's a number in the buffer at point, it is the default for LINE.
+If optional argument BUFFER is non-nil, switch to that buffer and
+move to line LINE there. If called interactively with \\[universal-argument]
+as argument, BUFFER is the most recently selected other buffer.
+
+Prior to moving point, this function sets the mark (without
+activating it), unless Transient Mark mode is enabled and the
+mark is already active.
This function is usually the wrong thing to use in a Lisp program.
What you probably want instead is something like:
- (goto-char (point-min)) (forward-line (1- N))
+ (goto-char (point-min))
+ (forward-line (1- N))
If at all possible, an even better solution is to use char counts
rather than line counts."
(interactive
@@ -925,11 +947,8 @@ rather than line counts."
(concat " in " (buffer-name buffer))
"")))
;; Read the argument, offering that number (if any) as default.
- (list (read-number (format (if default "Goto line%s (%s): "
- "Goto line%s: ")
- buffer-prompt
- default)
- default)
+ (list (read-number (format "Goto line%s: " buffer-prompt)
+ (list default (line-number-at-pos)))
buffer))))
;; Switch to the desired buffer, one way or another.
(if buffer
@@ -946,47 +965,65 @@ rather than line counts."
(re-search-forward "[\n\C-m]" nil 'end (1- line))
(forward-line (1- line)))))
-(defun count-words-region (start end)
- "Return the number of words between START and END.
+(defun count-words-region (start end &optional arg)
+ "Count the number of words in the region.
If called interactively, print a message reporting the number of
-lines, words, and characters in the region."
- (interactive "r")
- (let ((words 0))
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (while (forward-word 1)
- (setq words (1+ words)))))
- (when (called-interactively-p 'interactive)
- (count-words--message "Region"
- (count-lines start end)
- words
- (- end start)))
- words))
-
-(defun count-words ()
- "Display the number of lines, words, and characters in the buffer.
-In Transient Mark mode when the mark is active, display the
-number of lines, words, and characters in the region."
- (interactive)
- (if (use-region-p)
- (call-interactively 'count-words-region)
- (let* ((beg (point-min))
- (end (point-max))
- (lines (count-lines beg end))
- (words (count-words-region beg end))
- (chars (- end beg)))
- (count-words--message "Buffer" lines words chars))))
-
-(defun count-words--message (str lines words chars)
- (message "%s has %d line%s, %d word%s, and %d character%s."
- str
- lines (if (= lines 1) "" "s")
- words (if (= words 1) "" "s")
- chars (if (= chars 1) "" "s")))
-
-(defalias 'count-lines-region 'count-words-region)
+lines, words, and characters in the region (whether or not the
+region is active); with prefix ARG, report for the entire buffer
+rather than the region.
+
+If called from Lisp, return the number of words between positions
+START and END."
+ (interactive (if current-prefix-arg
+ (list nil nil current-prefix-arg)
+ (list (region-beginning) (region-end) nil)))
+ (cond ((not (called-interactively-p 'any))
+ (count-words start end))
+ (arg
+ (count-words--buffer-message))
+ (t
+ (count-words--message "Region" start end))))
+
+(defun count-words (start end)
+ "Count words between START and END.
+If called interactively, START and END are normally the start and
+end of the buffer; but if the region is active, START and END are
+the start and end of the region. Print a message reporting the
+number of lines, words, and chars.
+
+If called from Lisp, return the number of words between START and
+END, without printing any message."
+ (interactive (list nil nil))
+ (cond ((not (called-interactively-p 'any))
+ (let ((words 0))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (forward-word 1)
+ (setq words (1+ words)))))
+ words))
+ ((use-region-p)
+ (call-interactively 'count-words-region))
+ (t
+ (count-words--buffer-message))))
+
+(defun count-words--buffer-message ()
+ (count-words--message
+ (if (buffer-narrowed-p) "Narrowed part of buffer" "Buffer")
+ (point-min) (point-max)))
+
+(defun count-words--message (str start end)
+ (let ((lines (count-lines start end))
+ (words (count-words start end))
+ (chars (- end start)))
+ (message "%s has %d line%s, %d word%s, and %d character%s."
+ str
+ lines (if (= lines 1) "" "s")
+ words (if (= words 1) "" "s")
+ chars (if (= chars 1) "" "s"))))
+
+(define-obsolete-function-alias 'count-lines-region 'count-words-region "24.1")
(defun what-line ()
"Print the current buffer line number and narrowed line number of point."
@@ -1340,6 +1377,60 @@ to get different commands to edit and resubmit."
"M-x ")
obarray 'commandp t nil 'extended-command-history)))
+(defcustom suggest-key-bindings t
+ "Non-nil means show the equivalent key-binding when M-x command has one.
+The value can be a length of time to show the message for.
+If the value is non-nil and not a number, we wait 2 seconds."
+ :group 'keyboard
+ :type '(choice (const :tag "off" nil)
+ (integer :tag "time" 2)
+ (other :tag "on")))
+
+(defun execute-extended-command (prefixarg &optional command-name)
+ ;; Based on Fexecute_extended_command in keyboard.c of Emacs.
+ ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
+ "Read function name, then read its arguments and call it.
+
+To pass a numeric argument to the command you are invoking with, specify
+the numeric argument to this command.
+
+Noninteractively, the argument PREFIXARG is the prefix argument to
+give to the command you invoke, if it asks for an argument."
+ (interactive (list current-prefix-arg (read-extended-command)))
+ ;; Emacs<24 calling-convention was with a single `prefixarg' argument.
+ (if (null command-name) (setq command-name (read-extended-command)))
+ (let* ((function (and (stringp command-name) (intern-soft command-name)))
+ (binding (and suggest-key-bindings
+ (not executing-kbd-macro)
+ (where-is-internal function overriding-local-map t))))
+ (unless (commandp function)
+ (error "`%s' is not a valid command name" command-name))
+ (setq this-command function)
+ ;; Normally `real-this-command' should never be changed, but here we really
+ ;; want to pretend that M-x <cmd> RET is nothing more than a "key
+ ;; binding" for <cmd>, so the command the user really wanted to run is
+ ;; `function' and not `execute-extended-command'. The difference is
+ ;; visible in cases such as M-x <cmd> RET and then C-x z (bug#11506).
+ (setq real-this-command function)
+ (let ((prefix-arg prefixarg))
+ (command-execute function 'record))
+ ;; If enabled, show which key runs this command.
+ (when binding
+ ;; But first wait, and skip the message if there is input.
+ (let* ((waited
+ ;; If this command displayed something in the echo area;
+ ;; wait a few seconds, then display our suggestion message.
+ (sit-for (cond
+ ((zerop (length (current-message))) 0)
+ ((numberp suggest-key-bindings) suggest-key-bindings)
+ (t 2)))))
+ (when (and waited (not (consp unread-command-events)))
+ (with-temp-message
+ (format "You can run the command `%s' with %s"
+ function (key-description binding))
+ (sit-for (if (numberp suggest-key-bindings)
+ suggest-key-bindings
+ 2))))))))
(defvar minibuffer-history nil
"Default minibuffer history list.
@@ -1401,7 +1492,7 @@ See also `minibuffer-history-case-insensitive-variables'."
(list (if (string= regexp "")
(if minibuffer-history-search-history
(car minibuffer-history-search-history)
- (error "No previous history search regexp"))
+ (user-error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
(unless (zerop n)
@@ -1427,9 +1518,9 @@ See also `minibuffer-history-case-insensitive-variables'."
(setq prevpos pos)
(setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
(when (= pos prevpos)
- (error (if (= pos 1)
- "No later matching history item"
- "No earlier matching history item")))
+ (user-error (if (= pos 1)
+ "No later matching history item"
+ "No earlier matching history item")))
(setq match-string
(if (eq minibuffer-history-sexp-flag (minibuffer-depth))
(let ((print-level nil))
@@ -1472,7 +1563,7 @@ makes the search case-sensitive."
(list (if (string= regexp "")
(if minibuffer-history-search-history
(car minibuffer-history-search-history)
- (error "No previous history search regexp"))
+ (user-error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
(previous-matching-history-element regexp (- n)))
@@ -1531,11 +1622,11 @@ The argument NABS specifies the absolute history position."
(setq minibuffer-text-before-history
(minibuffer-contents-no-properties)))
(if (< nabs minimum)
- (if minibuffer-default
- (error "End of defaults; no next item")
- (error "End of history; no default available")))
+ (user-error (if minibuffer-default
+ "End of defaults; no next item"
+ "End of history; no default available")))
(if (> nabs (length (symbol-value minibuffer-history-variable)))
- (error "Beginning of history; no preceding item"))
+ (user-error "Beginning of history; no preceding item"))
(unless (memq last-command '(next-history-element
previous-history-element))
(let ((prompt-end (minibuffer-prompt-end)))
@@ -1635,58 +1726,50 @@ Intended to be added to `minibuffer-setup-hook'."
(defun minibuffer-history-isearch-search ()
"Return the proper search function, for isearch in minibuffer history."
- (cond
- (isearch-word
- (if isearch-forward 'word-search-forward 'word-search-backward))
- (t
- (lambda (string bound noerror)
- (let ((search-fun
- ;; Use standard functions to search within minibuffer text
- (cond
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward))))
- found)
- ;; Avoid lazy-highlighting matches in the minibuffer prompt when
- ;; searching forward. Lazy-highlight calls this lambda with the
- ;; bound arg, so skip the minibuffer prompt.
- (if (and bound isearch-forward (< (point) (minibuffer-prompt-end)))
- (goto-char (minibuffer-prompt-end)))
- (or
- ;; 1. First try searching in the initial minibuffer text
- (funcall search-fun string
- (if isearch-forward bound (minibuffer-prompt-end))
- noerror)
- ;; 2. If the above search fails, start putting next/prev history
- ;; elements in the minibuffer successively, and search the string
- ;; in them. Do this only when bound is nil (i.e. not while
- ;; lazy-highlighting search strings in the current minibuffer text).
- (unless bound
- (condition-case nil
- (progn
- (while (not found)
- (cond (isearch-forward
- (next-history-element 1)
- (goto-char (minibuffer-prompt-end)))
- (t
- (previous-history-element 1)
- (goto-char (point-max))))
- (setq isearch-barrier (point) isearch-opoint (point))
- ;; After putting the next/prev history element, search
- ;; the string in them again, until next-history-element
- ;; or previous-history-element raises an error at the
- ;; beginning/end of history.
- (setq found (funcall search-fun string
- (unless isearch-forward
- ;; For backward search, don't search
- ;; in the minibuffer prompt
- (minibuffer-prompt-end))
- noerror)))
- ;; Return point of the new search result
- (point))
- ;; Return nil when next(prev)-history-element fails
- (error nil)))))))))
+ (lambda (string bound noerror)
+ (let ((search-fun
+ ;; Use standard functions to search within minibuffer text
+ (isearch-search-fun-default))
+ found)
+ ;; Avoid lazy-highlighting matches in the minibuffer prompt when
+ ;; searching forward. Lazy-highlight calls this lambda with the
+ ;; bound arg, so skip the minibuffer prompt.
+ (if (and bound isearch-forward (< (point) (minibuffer-prompt-end)))
+ (goto-char (minibuffer-prompt-end)))
+ (or
+ ;; 1. First try searching in the initial minibuffer text
+ (funcall search-fun string
+ (if isearch-forward bound (minibuffer-prompt-end))
+ noerror)
+ ;; 2. If the above search fails, start putting next/prev history
+ ;; elements in the minibuffer successively, and search the string
+ ;; in them. Do this only when bound is nil (i.e. not while
+ ;; lazy-highlighting search strings in the current minibuffer text).
+ (unless bound
+ (condition-case nil
+ (progn
+ (while (not found)
+ (cond (isearch-forward
+ (next-history-element 1)
+ (goto-char (minibuffer-prompt-end)))
+ (t
+ (previous-history-element 1)
+ (goto-char (point-max))))
+ (setq isearch-barrier (point) isearch-opoint (point))
+ ;; After putting the next/prev history element, search
+ ;; the string in them again, until next-history-element
+ ;; or previous-history-element raises an error at the
+ ;; beginning/end of history.
+ (setq found (funcall search-fun string
+ (unless isearch-forward
+ ;; For backward search, don't search
+ ;; in the minibuffer prompt
+ (minibuffer-prompt-end))
+ noerror)))
+ ;; Return point of the new search result
+ (point))
+ ;; Return nil when next(prev)-history-element fails
+ (error nil)))))))
(defun minibuffer-history-isearch-message (&optional c-q-hack ellipsis)
"Display the minibuffer history search prompt.
@@ -1717,14 +1800,13 @@ Otherwise, it displays the standard isearch message returned from
"Wrap the minibuffer history search when search fails.
Move point to the first history element for a forward search,
or to the last history element for a backward search."
- (unless isearch-word
- ;; When `minibuffer-history-isearch-search' fails on reaching the
- ;; beginning/end of the history, wrap the search to the first/last
- ;; minibuffer history element.
- (if isearch-forward
- (goto-history-element (length (symbol-value minibuffer-history-variable)))
- (goto-history-element 0))
- (setq isearch-success t))
+ ;; When `minibuffer-history-isearch-search' fails on reaching the
+ ;; beginning/end of the history, wrap the search to the first/last
+ ;; minibuffer history element.
+ (if isearch-forward
+ (goto-history-element (length (symbol-value minibuffer-history-variable)))
+ (goto-history-element 0))
+ (setq isearch-success t)
(goto-char (if isearch-forward (minibuffer-prompt-end) (point-max))))
(defun minibuffer-history-isearch-push-state ()
@@ -1773,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'.
@@ -1804,9 +1890,10 @@ as an argument limits undo to changes within the current region."
;; so, ask the user whether she wants to skip the redo/undo pair.
(let ((equiv (gethash pending-undo-list undo-equiv-table)))
(or (eq (selected-window) (minibuffer-window))
- (setq message (if undo-in-region
- (if equiv "Redo in region!" "Undo in region!")
- (if equiv "Redo!" "Undo!"))))
+ (setq message (format "%s%s!"
+ (if (or undo-no-redo (not equiv))
+ "Undo" "Redo")
+ (if undo-in-region " in region" ""))))
(when (and (consp equiv) undo-no-redo)
;; The equiv entry might point to another redo record if we have done
;; undo-redo-undo-redo-... so skip to the very last equiv.
@@ -1852,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))))
@@ -1881,8 +1969,8 @@ Some change-hooks test this variable to do something different.")
Call `undo-start' to get ready to undo recent changes,
then call `undo-more' one or more times to undo them."
(or (listp pending-undo-list)
- (error (concat "No further undo information"
- (and undo-in-region " for region"))))
+ (user-error (concat "No further undo information"
+ (and undo-in-region " for region"))))
(let ((undo-in-progress t))
;; Note: The following, while pulling elements off
;; `pending-undo-list' will call primitive change functions which
@@ -1908,7 +1996,7 @@ If BEG and END are specified, then only undo elements
that apply to text between BEG and END are used; other undo elements
are ignored. If BEG and END are nil, all undo elements are used."
(if (eq buffer-undo-list t)
- (error "No undo information in this buffer"))
+ (user-error "No undo information in this buffer"))
(setq pending-undo-list
(if (and beg end (not (= beg end)))
(undo-make-selective-list (min beg end) (max beg end))
@@ -2136,7 +2224,7 @@ of `history-length', which see.")
"Switch used to have the shell execute its command line argument.")
(defvar shell-command-default-error-buffer nil
- "*Buffer name for `shell-command' and `shell-command-on-region' error output.
+ "Buffer name for `shell-command' and `shell-command-on-region' error output.
This buffer is used when `shell-command' or `shell-command-on-region'
is run interactively. A value of nil means that output to stderr and
stdout will be intermixed in the output stream.")
@@ -2187,12 +2275,41 @@ to `shell-command-history'."
(or hist 'shell-command-history)
args)))
+(defcustom async-shell-command-buffer 'confirm-new-buffer
+ "What to do when the output buffer is used by another shell command.
+This option specifies how to resolve the conflict where a new command
+wants to direct its output to the buffer `*Async Shell Command*',
+but this buffer is already taken by another running shell command.
+
+The value `confirm-kill-process' is used to ask for confirmation before
+killing the already running process and running a new process
+in the same buffer, `confirm-new-buffer' for confirmation before running
+the command in a new buffer with a name other than the default buffer name,
+`new-buffer' for doing the same without confirmation,
+`confirm-rename-buffer' for confirmation before renaming the existing
+output buffer and running a new command in the default buffer,
+`rename-buffer' for doing the same without confirmation."
+ :type '(choice (const :tag "Confirm killing of running command"
+ confirm-kill-process)
+ (const :tag "Confirm creation of a new buffer"
+ confirm-new-buffer)
+ (const :tag "Create a new buffer"
+ new-buffer)
+ (const :tag "Confirm renaming of existing buffer"
+ confirm-rename-buffer)
+ (const :tag "Rename the existing buffer"
+ rename-buffer))
+ :group 'shell
+ :version "24.3")
+
(defun async-shell-command (command &optional output-buffer error-buffer)
"Execute string COMMAND asynchronously in background.
-Like `shell-command' but if COMMAND doesn't end in ampersand, adds `&'
-surrounded by whitespace and executes the command asynchronously.
+Like `shell-command', but adds `&' at the end of COMMAND
+to execute it asynchronously.
+
The output appears in the buffer `*Async Shell Command*'.
+That buffer is in shell mode.
In Elisp, you will often be better served by calling `start-process'
directly, since it offers more control and does not impose the use of a
@@ -2200,8 +2317,12 @@ shell (with its need to quote arguments)."
(interactive
(list
(read-shell-command "Async shell command: " nil nil
- (and buffer-file-name
- (file-relative-name buffer-file-name)))
+ (let ((filename
+ (cond
+ (buffer-file-name)
+ ((eq major-mode 'dired-mode)
+ (dired-get-filename nil t)))))
+ (and filename (file-relative-name filename))))
current-prefix-arg
shell-command-default-error-buffer))
(unless (string-match "&[ \t]*\\'" command)
@@ -2212,9 +2333,10 @@ shell (with its need to quote arguments)."
"Execute string COMMAND in inferior shell; display output, if any.
With prefix argument, insert the COMMAND's output at point.
-If COMMAND ends in ampersand, execute it asynchronously.
+If COMMAND ends in `&', execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
-That buffer is in shell mode.
+That buffer is in shell mode. You can also use
+`async-shell-command' that automatically adds `&'.
Otherwise, COMMAND is executed synchronously. The output appears in
the buffer `*Shell Command Output*'. If the output is short enough to
@@ -2334,12 +2456,40 @@ the use of a shell (with its need to quote arguments)."
proc)
;; Remove the ampersand.
(setq command (substring command 0 (match-beginning 0)))
- ;; If will kill a process, query first.
+ ;; Ask the user what to do with already running process.
(setq proc (get-buffer-process buffer))
- (if proc
- (if (yes-or-no-p "A command is running. Kill it? ")
+ (when proc
+ (cond
+ ((eq async-shell-command-buffer 'confirm-kill-process)
+ ;; If will kill a process, query first.
+ (if (yes-or-no-p "A command is running in the default buffer. Kill it? ")
(kill-process proc)
(error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'confirm-new-buffer)
+ ;; If will create a new buffer, query first.
+ (if (yes-or-no-p "A command is running in the default buffer. Use a new buffer? ")
+ (setq buffer (generate-new-buffer
+ (or output-buffer "*Async Shell Command*")))
+ (error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'new-buffer)
+ ;; It will create a new buffer.
+ (setq buffer (generate-new-buffer
+ (or output-buffer "*Async Shell Command*"))))
+ ((eq async-shell-command-buffer 'confirm-rename-buffer)
+ ;; If will rename the buffer, query first.
+ (if (yes-or-no-p "A command is running in the default buffer. Rename it? ")
+ (progn
+ (with-current-buffer buffer
+ (rename-uniquely))
+ (setq buffer (get-buffer-create
+ (or output-buffer "*Async Shell Command*"))))
+ (error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'rename-buffer)
+ ;; It will rename the buffer.
+ (with-current-buffer buffer
+ (rename-uniquely))
+ (setq buffer (get-buffer-create
+ (or output-buffer "*Async Shell Command*"))))))
(with-current-buffer buffer
(setq buffer-read-only nil)
;; Setting buffer-read-only to nil doesn't suffice
@@ -2450,12 +2600,10 @@ COMMAND.
To specify a coding system for converting non-ASCII characters
in the input and output to the shell command, use \\[universal-coding-system-argument]
before this command. By default, the input (from the current buffer)
-is encoded in the same coding system that will be used to save the file,
-`buffer-file-coding-system'. If the output is going to replace the region,
-then it is decoded from that same coding system.
+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'.
@@ -2463,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"))
@@ -2663,13 +2811,13 @@ value passed."
(defvar process-file-side-effects t
"Whether a call of `process-file' changes remote files.
-Per default, this variable is always set to `t', meaning that a
+By default, this variable is always set to `t', meaning that a
call of `process-file' could potentially change any file on a
remote host. When set to `nil', a file handler could optimize
-its behavior with respect to remote file attributes caching.
+its behavior with respect to remote file attribute caching.
-This variable should never be changed by `setq'. Instead of, it
-shall be set only by let-binding.")
+You should only ever change this variable with a let-binding;
+never with `setq'.")
(defun start-file-process (name buffer program &rest program-args)
"Start a program in a subprocess. Return the process object for it.
@@ -2713,47 +2861,52 @@ support pty association, if PROGRAM is nil."
(tabulated-list-init-header))
(defun list-processes--refresh ()
- "Recompute the list of processes for the Process List buffer."
+ "Recompute the list of processes for the Process List buffer.
+Also, delete any process that is exited or signaled."
(setq tabulated-list-entries nil)
(dolist (p (process-list))
- (when (or (not process-menu-query-only)
- (process-query-on-exit-flag p))
- (let* ((buf (process-buffer p))
- (type (process-type p))
- (name (process-name p))
- (status (symbol-name (process-status p)))
- (buf-label (if (buffer-live-p buf)
- `(,(buffer-name buf)
- face link
- help-echo ,(concat "Visit buffer `"
- (buffer-name buf) "'")
- follow-link t
- process-buffer ,buf
- action process-menu-visit-buffer)
- "--"))
- (tty (or (process-tty-name p) "--"))
- (cmd
- (if (memq type '(network serial))
- (let ((contact (process-contact p t)))
- (if (eq type 'network)
- (format "(%s %s)"
- (if (plist-get contact :type)
- "datagram"
- "network")
- (if (plist-get contact :server)
- (format "server on %s"
- (plist-get contact :server))
- (format "connection to %s"
- (plist-get contact :host))))
- (format "(serial port %s%s)"
- (or (plist-get contact :port) "?")
- (let ((speed (plist-get contact :speed)))
- (if speed
- (format " at %s b/s" speed)
- "")))))
- (mapconcat 'identity (process-command p) " "))))
- (push (list p (vector name status buf-label tty cmd))
- tabulated-list-entries)))))
+ (cond ((memq (process-status p) '(exit signal closed))
+ (delete-process p))
+ ((or (not process-menu-query-only)
+ (process-query-on-exit-flag p))
+ (let* ((buf (process-buffer p))
+ (type (process-type p))
+ (name (process-name p))
+ (status (symbol-name (process-status p)))
+ (buf-label (if (buffer-live-p buf)
+ `(,(buffer-name buf)
+ face link
+ help-echo ,(concat "Visit buffer `"
+ (buffer-name buf) "'")
+ follow-link t
+ process-buffer ,buf
+ action process-menu-visit-buffer)
+ "--"))
+ (tty (or (process-tty-name p) "--"))
+ (cmd
+ (if (memq type '(network serial))
+ (let ((contact (process-contact p t)))
+ (if (eq type 'network)
+ (format "(%s %s)"
+ (if (plist-get contact :type)
+ "datagram"
+ "network")
+ (if (plist-get contact :server)
+ (format "server on %s"
+ (or
+ (plist-get contact :host)
+ (plist-get contact :local)))
+ (format "connection to %s"
+ (plist-get contact :host))))
+ (format "(serial port %s%s)"
+ (or (plist-get contact :port) "?")
+ (let ((speed (plist-get contact :speed)))
+ (if speed
+ (format " at %s b/s" speed)
+ "")))))
+ (mapconcat 'identity (process-command p) " "))))
+ (push (list p (vector name status buf-label tty cmd))
+ tabulated-list-entries))))))
(defun process-menu-visit-buffer (button)
(display-buffer (button-get button 'process-buffer)))
@@ -2765,7 +2918,7 @@ the query-on-exit flag set are listed.
Any process listed as exited or signaled is actually eliminated
after the listing is made.
Optional argument BUFFER specifies a buffer to use, instead of
-\"*Process List\".
+\"*Process List*\".
The return value is always nil."
(interactive)
(or (fboundp 'process-list)
@@ -2914,28 +3067,46 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(defvar filter-buffer-substring-functions nil
- "Wrapper hook around `filter-buffer-substring'.
-The functions on this special hook are called with four arguments:
- NEXT-FUN BEG END DELETE
-NEXT-FUN is a function of three arguments (BEG END DELETE)
-that performs the default operation. The other three arguments
-are like the ones passed to `filter-buffer-substring'.")
+ "This variable is a wrapper hook around `filter-buffer-substring'.
+Each member of the hook should be a function accepting four arguments:
+\(FUN BEG END DELETE), where FUN is itself a function of three arguments
+\(BEG END DELETE). The arguments BEG, END, and DELETE are the same
+as those of `filter-buffer-substring' in each case.
+
+The first hook function to be called receives a FUN equivalent
+to the default operation of `filter-buffer-substring',
+i.e. one that returns the buffer-substring between BEG and
+END (processed by any `buffer-substring-filters'). Normally,
+the hook function will call FUN and then do its own processing
+of the result. The next hook function receives a FUN equivalent
+to the previous hook function, calls it, and does its own
+processing, and so on. The overall result is that of all hook
+functions acting in sequence.
+
+Any hook may choose not to call FUN though, in which case it
+effectively replaces the default behavior with whatever it chooses.
+Of course, a later hook function may do the same thing.")
(defvar buffer-substring-filters nil
"List of filter functions for `filter-buffer-substring'.
Each function must accept a single argument, a string, and return
a string. The buffer substring is passed to the first function
in the list, and the return value of each function is passed to
-the next. The return value of the last function is used as the
-return value of `filter-buffer-substring'.
+the next. The final result (if `buffer-substring-filters' is
+nil, this is the unfiltered buffer-substring) is passed to the
+first function on `filter-buffer-substring-functions'.
-If this variable is nil, no filtering is performed.")
+As a special convention, point is set to the start of the buffer text
+being operated on (i.e., the first argument of `filter-buffer-substring')
+before these functions are called.")
(make-obsolete-variable 'buffer-substring-filters
'filter-buffer-substring-functions "24.1")
(defun filter-buffer-substring (beg end &optional delete)
"Return the buffer substring between BEG and END, after filtering.
-The filtering is performed by `filter-buffer-substring-functions'.
+The wrapper hook `filter-buffer-substring-functions' performs
+the actual filtering. The obsolete variable `buffer-substring-filters'
+is also consulted. If both of these are nil, no filtering is done.
If DELETE is non-nil, the text between BEG and END is deleted
from the buffer.
@@ -2964,41 +3135,43 @@ be copied into other buffers."
(defvar interprogram-cut-function nil
"Function to call to make a killed region available to other programs.
+Most window systems provide a facility for cutting and pasting
+text between different programs, such as the clipboard on X and
+MS-Windows, or the pasteboard on Nextstep/Mac OS.
-Most window systems provide some sort of facility for cutting and
-pasting text between the windows of different programs.
-This variable holds a function that Emacs calls whenever text
-is put in the kill ring, to make the new kill available to other
-programs.
-
-The function takes one argument, TEXT, which is a string containing
-the text which should be made available.")
+This variable holds a function that Emacs calls whenever text is
+put in the kill ring, to make the new kill available to other
+programs. The function takes one argument, TEXT, which is a
+string containing the text which should be made available.")
(defvar interprogram-paste-function nil
"Function to call to get text cut from other programs.
-
-Most window systems provide some sort of facility for cutting and
-pasting text between the windows of different programs.
-This variable holds a function that Emacs calls to obtain
-text that other programs have provided for pasting.
-
-The function should be called with no arguments. If the function
-returns nil, then no other program has provided such text, and the top
-of the Emacs kill ring should be used. If the function returns a
-string, then the caller of the function \(usually `current-kill')
-should put this string in the kill ring as the latest kill.
-
-This function may also return a list of strings if the window
+Most window systems provide a facility for cutting and pasting
+text between different programs, such as the clipboard on X and
+MS-Windows, or the pasteboard on Nextstep/Mac OS.
+
+This variable holds a function that Emacs calls to obtain text
+that other programs have provided for pasting. The function is
+called with no arguments. If no other program has provided text
+to paste, the function should return nil (in which case the
+caller, usually `current-kill', should use the top of the Emacs
+kill ring). If another program has provided text to paste, the
+function should return that text as a string (in which case the
+caller should put this string in the kill ring as the latest
+kill).
+
+The function may also return a list of strings if the window
system supports multiple selections. The first string will be
-used as the pasted text, but the other will be placed in the
-kill ring for easy access via `yank-pop'.
-
-Note that the function should return a string only if a program other
-than Emacs has provided a string for pasting; if Emacs provided the
-most recent string, the function should return nil. If it is
-difficult to tell whether Emacs or some other program provided the
-current string, it is probably good enough to return nil if the string
-is equal (according to `string=') to the last text Emacs provided.")
+used as the pasted text, but the other will be placed in the kill
+ring for easy access via `yank-pop'.
+
+Note that the function should return a string only if a program
+other than Emacs has provided a string for pasting; if Emacs
+provided the most recent string, the function should return nil.
+If it is difficult to tell whether Emacs or some other program
+provided the current string, it is probably good enough to return
+nil if the string is equal (according to `string=') to the last
+text Emacs provided.")
@@ -3034,7 +3207,8 @@ before the Emacs kill and one can still paste it using \\[yank] \\[yank-pop]."
:version "23.2")
(defcustom kill-do-not-save-duplicates nil
- "Do not add a new string to `kill-ring' when it is the same as the last one."
+ "Do not add a new string to `kill-ring' if it duplicates the last one.
+The comparison is done using `equal-including-properties'."
:type 'boolean
:group 'killing
:version "23.2")
@@ -3062,7 +3236,10 @@ argument should still be a \"useful\" string for such uses."
(signal 'args-out-of-range
(list string "yank-handler specified for empty string"))))
(unless (and kill-do-not-save-duplicates
- (equal string (car kill-ring)))
+ ;; Due to text properties such as 'yank-handler that
+ ;; can alter the contents to yank, comparison using
+ ;; `equal' is unsafe.
+ (equal-including-properties string (car kill-ring)))
(if (fboundp 'menu-bar-update-yank-menu)
(menu-bar-update-yank-menu string (and replace (car kill-ring)))))
(when save-interprogram-paste-before-kill
@@ -3073,10 +3250,10 @@ argument should still be a \"useful\" string for such uses."
(nreverse interprogram-paste)
(list interprogram-paste)))
(unless (and kill-do-not-save-duplicates
- (equal s (car kill-ring)))
+ (equal-including-properties s (car kill-ring)))
(push s kill-ring))))))
(unless (and kill-do-not-save-duplicates
- (equal string (car kill-ring)))
+ (equal-including-properties string (car kill-ring)))
(if (and replace kill-ring)
(setcar kill-ring string)
(push string kill-ring)
@@ -3100,7 +3277,10 @@ If `interprogram-cut-function' is set, pass the resulting kill to it."
(set-advertised-calling-convention 'kill-append '(string before-p) "23.3")
(defcustom yank-pop-change-selection nil
- "If non-nil, rotating the kill ring changes the window system selection."
+ "Whether rotating the kill ring changes the window system selection.
+If non-nil, whenever the kill ring is rotated (usually via the
+`yank-pop' command), Emacs also calls `interprogram-cut-function'
+to copy the new kill to the window system selection."
:type 'boolean
:group 'killing
:version "23.1")
@@ -3155,10 +3335,6 @@ move the yanking point; just return the Nth kill forward."
:type 'boolean
:group 'killing)
-(put 'text-read-only 'error-conditions
- '(text-read-only buffer-read-only error))
-(put 'text-read-only 'error-message (purecopy "Text is read-only"))
-
(defun kill-region (beg end &optional yank-handler)
"Kill (\"cut\") text between point and mark.
This deletes the text from the buffer and saves it in the kill ring.
@@ -3243,38 +3419,50 @@ This command is similar to `copy-region-as-kill', except that it gives
visual feedback indicating the extent of the region being copied."
(interactive "r")
(copy-region-as-kill beg end)
- ;; This use of called-interactively-p is correct
- ;; because the code it controls just gives the user visual feedback.
+ ;; This use of called-interactively-p is correct because the code it
+ ;; controls just gives the user visual feedback.
(if (called-interactively-p 'interactive)
- (let ((other-end (if (= (point) beg) end beg))
- (opoint (point))
- ;; Inhibit quitting so we can make a quit here
- ;; look like a C-g typed as a command.
- (inhibit-quit t))
- (if (pos-visible-in-window-p other-end (selected-window))
- ;; Swap point-and-mark quickly so as to show the region that
- ;; was selected. Don't do it if the region is highlighted.
- (unless (and (region-active-p)
- (face-background 'region))
- ;; Swap point and mark.
- (set-marker (mark-marker) (point) (current-buffer))
- (goto-char other-end)
- (sit-for blink-matching-delay)
- ;; Swap back.
- (set-marker (mark-marker) other-end (current-buffer))
- (goto-char opoint)
- ;; If user quit, deactivate the mark
- ;; as C-g would as a command.
- (and quit-flag mark-active
- (deactivate-mark)))
- (let* ((killed-text (current-kill 0))
- (message-len (min (length killed-text) 40)))
- (if (= (point) beg)
- ;; Don't say "killed"; that is misleading.
- (message "Saved text until \"%s\""
- (substring killed-text (- message-len)))
- (message "Saved text from \"%s\""
- (substring killed-text 0 message-len))))))))
+ (indicate-copied-region)))
+
+(defun indicate-copied-region (&optional message-len)
+ "Indicate that the region text has been copied interactively.
+If the mark is visible in the selected window, blink the cursor
+between point and mark if there is currently no active region
+highlighting.
+
+If the mark lies outside the selected window, display an
+informative message containing a sample of the copied text. The
+optional argument MESSAGE-LEN, if non-nil, specifies the length
+of this sample text; it defaults to 40."
+ (let ((mark (mark t))
+ (point (point))
+ ;; Inhibit quitting so we can make a quit here
+ ;; look like a C-g typed as a command.
+ (inhibit-quit t))
+ (if (pos-visible-in-window-p mark (selected-window))
+ ;; Swap point-and-mark quickly so as to show the region that
+ ;; was selected. Don't do it if the region is highlighted.
+ (unless (and (region-active-p)
+ (face-background 'region))
+ ;; Swap point and mark.
+ (set-marker (mark-marker) (point) (current-buffer))
+ (goto-char mark)
+ (sit-for blink-matching-delay)
+ ;; Swap back.
+ (set-marker (mark-marker) mark (current-buffer))
+ (goto-char point)
+ ;; If user quit, deactivate the mark
+ ;; as C-g would as a command.
+ (and quit-flag mark-active
+ (deactivate-mark)))
+ (let ((len (min (abs (- mark point))
+ (or message-len 40))))
+ (if (< point mark)
+ ;; Don't say "killed"; that is misleading.
+ (message "Saved text until \"%s\""
+ (buffer-substring-no-properties (- mark len) mark))
+ (message "Saved text from \"%s\""
+ (buffer-substring-no-properties mark (+ mark len))))))))
(defun append-next-kill (&optional interactive)
"Cause following command, if it kills, to append to previous kill.
@@ -3289,16 +3477,36 @@ The argument is used for internal purposes; do not supply one."
;; Yanking.
+(defcustom yank-handled-properties
+ '((font-lock-face . yank-handle-font-lock-face-property)
+ (category . yank-handle-category-property))
+ "List of special text property handling conditions for yanking.
+Each element should have the form (PROP . FUN), where PROP is a
+property symbol and FUN is a function. When the `yank' command
+inserts text into the buffer, it scans the inserted text for
+stretches of text that have `eq' values of the text property
+PROP; for each such stretch of text, FUN is called with three
+arguments: the property's value in that text, and the start and
+end positions of the text.
+
+This is done prior to removing the properties specified by
+`yank-excluded-properties'."
+ :group 'killing
+ :version "24.3")
+
;; This is actually used in subr.el but defcustom does not work there.
(defcustom yank-excluded-properties
- '(read-only invisible intangible field mouse-face help-echo local-map keymap
- yank-handler follow-link fontified)
+ '(category field follow-link fontified font-lock-face help-echo
+ intangible invisible keymap local-map mouse-face read-only
+ yank-handler)
"Text properties to discard when yanking.
The value should be a list of text properties to discard or t,
-which means to discard all text properties."
+which means to discard all text properties.
+
+See also `yank-handled-properties'."
:type '(choice (const :tag "All" t) (repeat symbol))
:group 'killing
- :version "22.1")
+ :version "24.3")
(defvar yank-window-start nil)
(defvar yank-undo-function nil
@@ -3350,15 +3558,16 @@ doc string for `insert-for-yank-1', which see."
(defun yank (&optional arg)
"Reinsert (\"paste\") the last stretch of killed text.
-More precisely, reinsert the stretch of killed text most recently
-killed OR yanked. Put point at end, and set mark at beginning.
-With just \\[universal-argument] as argument, same but put point at beginning (and mark at end).
-With argument N, reinsert the Nth most recently killed stretch of killed
-text.
+More precisely, reinsert the most recent kill, which is the
+stretch of killed text most recently killed OR yanked. Put point
+at the end, and set mark at the beginning without activating it.
+With just \\[universal-argument] as argument, put point at beginning, and mark at end.
+With argument N, reinsert the Nth most recent kill.
-When this command inserts killed text into the buffer, it honors
-`yank-excluded-properties' and `yank-handler' as described in the
-doc string for `insert-for-yank-1', which see.
+When this command inserts text into the buffer, it honors the
+`yank-handled-properties' and `yank-excluded-properties'
+variables, and the `yank-handler' text property. See
+`insert-for-yank-1' for details.
See also the command `yank-pop' (\\[yank-pop])."
(interactive "*P")
@@ -3435,8 +3644,10 @@ and KILLP is t if a prefix arg was specified."
((eq backward-delete-char-untabify-method 'all)
" \t\n\r")))
(n (if skip
- (let ((wh (- (point) (save-excursion (skip-chars-backward skip)
- (point)))))
+ (let* ((oldpt (point))
+ (wh (- oldpt (save-excursion
+ (skip-chars-backward skip)
+ (constrain-to-field nil oldpt)))))
(+ arg (if (zerop wh) 0 (1- wh))))
arg)))
;; Avoid warning about delete-backward-char
@@ -3446,20 +3657,20 @@ and KILLP is t if a prefix arg was specified."
"Kill up to and including ARGth occurrence of CHAR.
Case is ignored if `case-fold-search' is non-nil in the current buffer.
Goes backward if ARG is negative; error if CHAR not found."
- (interactive "p\ncZap to char: ")
+ (interactive (list (prefix-numeric-value current-prefix-arg)
+ (read-char "Zap to char: " t)))
;; Avoid "obsolete" warnings for translation-table-for-input.
(with-no-warnings
(if (char-table-p translation-table-for-input)
(setq char (or (aref translation-table-for-input char) char))))
(kill-region (point) (progn
(search-forward (char-to-string char) nil nil arg)
-; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
(point))))
;; kill-line and its subroutines.
(defcustom kill-whole-line nil
- "If non-nil, `kill-line' with no arg at beg of line kills the whole line."
+ "If non-nil, `kill-line' with no arg at start of line kills the whole line."
:type 'boolean
:group 'killing)
@@ -3647,7 +3858,8 @@ If ARG is zero, move to the beginning of the current line."
(assq prop buffer-invisibility-spec))))))
(skip-chars-forward "^\n")
(if (get-text-property (point) 'invisible)
- (goto-char (next-single-property-change (point) 'invisible))
+ (goto-char (or (next-single-property-change (point) 'invisible)
+ (point-max)))
(goto-char (next-overlay-change (point))))
(end-of-line)))
@@ -3751,10 +3963,18 @@ a mistake; see the documentation of `set-mark'."
(signal 'mark-inactive nil)))
(defsubst deactivate-mark (&optional force)
- "Deactivate the mark by setting `mark-active' to nil.
-Unless FORCE is non-nil, this function does nothing if Transient
-Mark mode is disabled.
-This function also runs `deactivate-mark-hook'."
+ "Deactivate the mark.
+If Transient Mark mode is disabled, this function normally does
+nothing; but if FORCE is non-nil, it deactivates the mark anyway.
+
+Deactivating the mark sets `mark-active' to nil, updates the
+primary selection according to `select-active-regions', and runs
+`deactivate-mark-hook'.
+
+If Transient Mark mode was temporarily enabled, reset the value
+of the variable `transient-mark-mode'; if this causes Transient
+Mark mode to be disabled, don't change `mark-active' to nil or
+run `deactivate-mark-hook'."
(when (or transient-mark-mode force)
(when (and (if (eq select-active-regions 'only)
(eq (car-safe transient-mark-mode) 'only)
@@ -3767,11 +3987,14 @@ This function also runs `deactivate-mark-hook'."
(cond (saved-region-selection
(x-set-selection 'PRIMARY saved-region-selection)
(setq saved-region-selection nil))
- ((/= (region-beginning) (region-end))
+ ;; If another program has acquired the selection, region
+ ;; deactivation should not clobber it (Bug#11772).
+ ((and (/= (region-beginning) (region-end))
+ (or (x-selection-owner-p 'PRIMARY)
+ (null (x-selection-exists-p 'PRIMARY))))
(x-set-selection 'PRIMARY
- (buffer-substring-no-properties
- (region-beginning)
- (region-end))))))
+ (buffer-substring (region-beginning)
+ (region-end))))))
(if (and (null force)
(or (eq transient-mark-mode 'lambda)
(and (eq (car-safe transient-mark-mode) 'only)
@@ -4355,23 +4578,28 @@ lines."
;; a cleaner solution to the problem of making C-n do something
;; useful given a tall image.
(defun line-move (arg &optional noerror to-end try-vscroll)
- (unless (and auto-window-vscroll try-vscroll
- ;; Only vscroll for single line moves
- (= (abs arg) 1)
- ;; But don't vscroll in a keyboard macro.
- (not defining-kbd-macro)
- (not executing-kbd-macro)
- (line-move-partial arg noerror to-end))
- (set-window-vscroll nil 0 t)
- (if (and line-move-visual
- ;; Display-based column are incompatible with goal-column.
- (not goal-column)
- ;; When the text in the window is scrolled to the left,
- ;; display-based motion doesn't make sense (because each
- ;; logical line occupies exactly one screen line).
- (not (> (window-hscroll) 0)))
- (line-move-visual arg noerror)
- (line-move-1 arg noerror to-end))))
+ (if noninteractive
+ (forward-line arg)
+ (unless (and auto-window-vscroll try-vscroll
+ ;; Only vscroll for single line moves
+ (= (abs arg) 1)
+ ;; Under scroll-conservatively, the display engine
+ ;; does this better.
+ (zerop scroll-conservatively)
+ ;; But don't vscroll in a keyboard macro.
+ (not defining-kbd-macro)
+ (not executing-kbd-macro)
+ (line-move-partial arg noerror to-end))
+ (set-window-vscroll nil 0 t)
+ (if (and line-move-visual
+ ;; Display-based column are incompatible with goal-column.
+ (not goal-column)
+ ;; When the text in the window is scrolled to the left,
+ ;; display-based motion doesn't make sense (because each
+ ;; logical line occupies exactly one screen line).
+ (not (> (window-hscroll) 0)))
+ (line-move-visual arg noerror)
+ (line-move-1 arg noerror to-end)))))
;; Display-based alternative to line-move-1.
;; Arg says how many lines to move. The value is t if we can move the
@@ -5271,7 +5499,7 @@ Returns t if it really did any work."
t)))
(defvar comment-line-break-function 'comment-indent-new-line
- "*Mode-specific function which line breaks and continues a comment.
+ "Mode-specific function which line breaks and continues a comment.
This function is called during auto-filling when a comment syntax
is defined.
The function should take a single optional argument, which is a flag
@@ -5332,7 +5560,9 @@ non-`nil'.
The value of `normal-auto-fill-function' specifies the function to use
for `auto-fill-function' when turning Auto Fill mode on."
- :variable (eq auto-fill-function normal-auto-fill-function))
+ :variable (auto-fill-function
+ . (lambda (v) (setq auto-fill-function
+ (if v normal-auto-fill-function)))))
;; This holds a document string used to document auto-fill-mode.
(defun auto-fill-function ()
@@ -5445,7 +5675,8 @@ the line. Before a tab, such characters insert until the tab is
filled in. \\[quoted-insert] still inserts characters in
overwrite mode; this is supposed to make it easier to insert
characters when necessary."
- :variable (eq overwrite-mode 'overwrite-mode-textual))
+ :variable (overwrite-mode
+ . (lambda (v) (setq overwrite-mode (if v 'overwrite-mode-textual)))))
(define-minor-mode binary-overwrite-mode
"Toggle Binary Overwrite mode.
@@ -5464,7 +5695,8 @@ ordinary typing characters do.
Note that Binary Overwrite mode is not its own minor mode; it is
a specialization of overwrite mode, entered by setting the
`overwrite-mode' variable to `overwrite-mode-binary'."
- :variable (eq overwrite-mode 'overwrite-mode-binary))
+ :variable (overwrite-mode
+ . (lambda (v) (setq overwrite-mode (if v 'overwrite-mode-binary)))))
(define-minor-mode line-number-mode
"Toggle line number display in the mode line (Line Number mode).
@@ -5779,8 +6011,8 @@ Valid values include:
`mh-e-user-agent' -- use the Emacs interface to the MH mail system.
See Info node `(mh-e)'.
`gnus-user-agent' -- like `message-user-agent', but with Gnus
- paraphernalia, particularly the Gcc: header for
- archiving.
+ paraphernalia if Gnus is running, particularly
+ the Gcc: header for archiving.
Additional valid symbols may be available; check with the author of
your package for details. The function should return non-nil if it
@@ -5933,7 +6165,7 @@ in the definition is used to check that VALUE is valid.
With a prefix argument, set VARIABLE to VALUE buffer-locally."
(interactive
(let* ((default-var (variable-at-point))
- (var (if (user-variable-p default-var)
+ (var (if (custom-variable-p default-var)
(read-variable (format "Set variable (default %s): " default-var)
default-var)
(read-variable "Set variable: ")))
@@ -6109,21 +6341,11 @@ With prefix argument N, move N items (negative N means move backward)."
(setq beg (previous-single-property-change beg 'mouse-face))
(setq end (or (next-single-property-change end 'mouse-face)
(point-max)))
- (buffer-substring-no-properties beg end))))
- (owindow (selected-window)))
+ (buffer-substring-no-properties beg end)))))
(unless (buffer-live-p buffer)
(error "Destination buffer is dead"))
- (select-window (posn-window (event-start event)))
- (if (and (one-window-p t 'selected-frame)
- (window-dedicated-p (selected-window)))
- ;; This is a special buffer's frame
- (iconify-frame (selected-frame))
- (or (window-dedicated-p (selected-window))
- (bury-buffer)))
- (select-window
- (or (get-buffer-window buffer 0)
- owindow))
+ (quit-window nil (posn-window (event-start event)))
(with-current-buffer buffer
(choose-completion-string
@@ -6161,9 +6383,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.
@@ -6260,7 +6481,7 @@ Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
"Finish setup of the completions buffer.
Called from `temp-buffer-show-hook'."
(when (eq major-mode 'completion-list-mode)
- (toggle-read-only 1)))
+ (setq buffer-read-only t)))
(add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)
@@ -6654,7 +6875,7 @@ call `normal-erase-is-backspace-mode' (which see) instead."
(if (if (eq normal-erase-is-backspace 'maybe)
(and (not noninteractive)
(or (memq system-type '(ms-dos windows-nt))
- (memq window-system '(ns))
+ (memq window-system '(w32 ns))
(and (memq window-system '(x))
(fboundp 'x-backspace-delete-keys-p)
(x-backspace-delete-keys-p))
@@ -6697,8 +6918,10 @@ probably not turn on this mode on a text-only terminal if you don't
have both Backspace, Delete and F1 keys.
See also `normal-erase-is-backspace'."
- :variable (eq (terminal-parameter
- nil 'normal-erase-is-backspace) 1)
+ :variable ((eq (terminal-parameter nil 'normal-erase-is-backspace) 1)
+ . (lambda (v)
+ (setf (terminal-parameter nil 'normal-erase-is-backspace)
+ (if v 1 0))))
(let ((enabled (eq 1 (terminal-parameter
nil 'normal-erase-is-backspace))))
@@ -6743,6 +6966,32 @@ See also `normal-erase-is-backspace'."
(defvar vis-mode-saved-buffer-invisibility-spec nil
"Saved value of `buffer-invisibility-spec' when Visible mode is on.")
+(define-minor-mode read-only-mode
+ "Change whether the current buffer is read-only.
+With prefix argument ARG, make the buffer read-only if ARG is
+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 \\[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
+ignore read-only status in a Lisp program (whether due to text
+properties or buffer state), bind `inhibit-read-only' temporarily
+to a non-nil value."
+ :variable buffer-read-only
+ (cond
+ ((and (not buffer-read-only) view-mode)
+ (View-exit-and-edit)
+ (make-local-variable 'view-read-only)
+ (setq view-read-only t)) ; Must leave view mode.
+ ((and buffer-read-only view-read-only
+ ;; If view-mode is already active, `view-mode-enter' is a nop.
+ (not view-mode)
+ (not (eq (get major-mode 'mode-class) 'special)))
+ (view-mode-enter))))
+
(define-minor-mode visible-mode
"Toggle making all invisible text temporarily visible (Visible mode).
With a prefix argument ARG, enable Visible mode if ARG is
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index 946e0a4480d..b6e1d0a58f2 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -1,6 +1,6 @@
;;; skeleton.el --- Lisp language extension for writing statement skeletons -*- coding: utf-8 -*-
-;; Copyright (C) 1993-1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Maintainer: FSF
@@ -37,7 +37,7 @@
(defvar skeleton-transformation-function 'identity
- "*If non-nil, function applied to literal strings before they are inserted.
+ "If non-nil, function applied to literal strings before they are inserted.
It should take strings and characters and return them transformed, or nil
which means no transformation.
Typical examples might be `upcase' or `capitalize'.")
@@ -77,7 +77,7 @@ The variables `v1' and `v2' are still set when calling this.")
"Function for transforming a skeleton proxy's aliases' variable value.")
(defvaralias 'skeleton-filter 'skeleton-filter-function)
-(defvar skeleton-untabify t
+(defvar skeleton-untabify nil ; bug#12223
"When non-nil untabifies when deleting backwards with element -ARG.")
(defvar skeleton-newline-indent-rigidly nil
@@ -95,11 +95,11 @@ skeleton elements.")
(defvar skeleton-subprompt
(substitute-command-keys
"RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]")
- "*Replacement for %s in prompts of recursive subskeletons.")
+ "Replacement for %s in prompts of recursive subskeletons.")
(defvar skeleton-debug nil
- "*If non-nil `define-skeleton' will override previous definition.")
+ "If non-nil `define-skeleton' will override previous definition.")
(defvar skeleton-positions nil
"List of positions marked with @, after skeleton insertion.
@@ -121,7 +121,7 @@ are integer buffer positions in the reverse order of the insertion order.")
"Define a user-configurable COMMAND that enters a statement skeleton.
DOCUMENTATION is that of the command.
SKELETON is as defined under `skeleton-insert'."
- (declare (debug (&define name stringp skeleton-edebug-spec)))
+ (declare (doc-string 2) (debug (&define name stringp skeleton-edebug-spec)))
(if skeleton-debug
(set command skeleton))
`(progn
@@ -456,7 +456,7 @@ automatically, and you are prompted to fill in the variable parts.")))
;; obarray
;; (lambda (symbol)
;; (or (eq symbol 'eval)
-;; (user-variable-p symbol)))
+;; (custom-variable-p symbol)))
;; t)
;; comment-start str ": "
;; (read-from-minibuffer "Expression: " nil read-expression-map nil
@@ -468,13 +468,13 @@ automatically, and you are prompted to fill in the variable parts.")))
;; Variables and command for automatically inserting pairs like () or "".
(defvar skeleton-pair nil
- "*If this is nil pairing is turned off, no matter what else is set.
+ "If this is nil pairing is turned off, no matter what else is set.
Otherwise modes with `skeleton-pair-insert-maybe' on some keys
will attempt to insert pairs of matching characters.")
(defvar skeleton-pair-on-word nil
- "*If this is nil, paired insertion is inhibited before or inside a word.")
+ "If this is nil, paired insertion is inhibited before or inside a word.")
(defvar skeleton-pair-filter-function (lambda () nil)
diff --git a/lisp/sort.el b/lisp/sort.el
index 8ea3decb76f..44f90fff379 100644
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -1,6 +1,6 @@
;;; sort.el --- commands to sort text in an Emacs buffer
-;; Copyright (C) 1986-1987, 1994-1995, 2001-2011
+;; Copyright (C) 1986-1987, 1994-1995, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Howie Kaye
@@ -401,18 +401,23 @@ the sort order."
;;;###autoload
(defun sort-regexp-fields (reverse record-regexp key-regexp beg end)
- "Sort the region lexicographically as specified by RECORD-REGEXP and KEY.
-RECORD-REGEXP specifies the textual units which should be sorted.
- For example, to sort lines RECORD-REGEXP would be \"^.*$\"
-KEY specifies the part of each record (ie each match for RECORD-REGEXP)
- is to be used for sorting.
- If it is \"\\\\digit\" then the digit'th \"\\\\(...\\\\)\" match field from
- RECORD-REGEXP is used.
- If it is \"\\\\&\" then the whole record is used.
- Otherwise, it is a regular-expression for which to search within the record.
-If a match for KEY is not found within a record then that record is ignored.
-
-With a negative prefix arg sorts in reverse order.
+ "Sort the text in the region region lexicographically.
+If called interactively, prompt for two regular expressions,
+RECORD-REGEXP and KEY-REGEXP.
+
+RECORD-REGEXP specifies the textual units to be sorted.
+ For example, to sort lines, RECORD-REGEXP would be \"^.*$\".
+
+KEY-REGEXP specifies the part of each record (i.e. each match for
+ RECORD-REGEXP) to be used for sorting.
+ If it is \"\\\\digit\", use the digit'th \"\\\\(...\\\\)\"
+ match field specified by RECORD-REGEXP.
+ If it is \"\\\\&\", use the whole record.
+ Otherwise, KEY-REGEXP should be a regular expression with which
+ to search within the record. If a match for KEY-REGEXP is not
+ found within a record, that record is ignored.
+
+With a negative prefix arg, sort in reverse order.
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order.
@@ -423,7 +428,7 @@ For example: to sort lines in the region by the first word on each line
;; using negative prefix arg to mean "reverse" is now inconsistent with
;; other sort-.*fields functions but then again this was before, since it
;; didn't use the magnitude of the arg to specify anything.
- (interactive "P\nsRegexp specifying records to sort:
+ (interactive "P\nsRegexp specifying records to sort: \n\
sRegexp specifying key within record: \nr")
(cond ((or (equal key-regexp "") (equal key-regexp "\\&"))
(setq key-regexp 0))
diff --git a/lisp/soundex.el b/lisp/soundex.el
index dbe92dc2670..ea73c93660c 100644
--- a/lisp/soundex.el
+++ b/lisp/soundex.el
@@ -1,6 +1,6 @@
;;; soundex.el --- implement Soundex algorithm
-;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
;; Author: Christian Plaunt <chris@bliss.berkeley.edu>
;; Maintainer: FSF
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index efe7832aca6..dd104d436b5 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1,6 +1,6 @@
;;; speedbar --- quick access to files and tags in a frame
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
@@ -125,7 +125,6 @@ this version is not backward compatible to 0.14 or earlier.")
;;; TODO:
;; - Timeout directories we haven't visited in a while.
-(require 'assoc)
(require 'easymenu)
(require 'dframe)
(require 'sb-image)
@@ -707,7 +706,7 @@ will be stripped by a simplified optimizer when compiled into a
singular expression. This variable will be turned into
`speedbar-file-regexp' for use with speedbar. You should use the
function `speedbar-add-supported-extension' to add a new extension at
-runtime, or use the configuration dialog to set it in your .emacs file.
+runtime, or use the configuration dialog to set it in your init file.
If you add an extension to this list, and it does not appear, you may
need to also modify `completion-ignored-extension' which will also help
file completion."
@@ -764,7 +763,7 @@ DIRECTORY-EXPRESSION to `speedbar-ignored-directory-expressions'."
"Non-nil means to automatically update the display.
When this is nil then speedbar will not follow the attached frame's directory.
If you want to change this while speedbar is active, either use
-\\[customize] or call \\<speedbar-key-map> `\\[speedbar-toggle-updates]'."
+\\[customize] or call \\<speedbar-mode-map> `\\[speedbar-toggle-updates]'."
:group 'speedbar
:initialize 'custom-initialize-default
:set (lambda (sym val)
@@ -775,6 +774,8 @@ If you want to change this while speedbar is active, either use
(defvar speedbar-update-flag-disable nil
"Permanently disable changing of the update flag.")
+(define-obsolete-variable-alias
+ 'speedbar-syntax-table 'speedbar-mode-syntax-table "24.1")
(defvar speedbar-mode-syntax-table
(let ((st (make-syntax-table)))
;; Turn off paren matching around here.
@@ -788,10 +789,9 @@ If you want to change this while speedbar is active, either use
(modify-syntax-entry ?\] " " st)
st)
"Syntax-table used on the speedbar.")
-(define-obsolete-variable-alias
- 'speedbar-syntax-table 'speedbar-mode-syntax-table "24.1")
+(define-obsolete-variable-alias 'speedbar-key-map 'speedbar-mode-map "24.1")
(defvar speedbar-mode-map
(let ((map (make-keymap)))
(suppress-keymap map t)
@@ -826,7 +826,6 @@ If you want to change this while speedbar is active, either use
(dframe-update-keymap map)
map)
"Keymap used in speedbar buffer.")
-(define-obsolete-variable-alias 'speedbar-key-map 'speedbar-mode-map "24.1")
(defun speedbar-make-specialized-keymap ()
"Create a keymap for use with a speedbar major or minor display mode.
@@ -1022,7 +1021,7 @@ supported at a time.
(set (make-local-variable 'dframe-delete-frame-function)
'speedbar-handle-delete-frame)
;; hscroll
- (set (make-local-variable 'automatic-hscrolling) nil) ; Emacs 21
+ (set (make-local-variable 'auto-hscroll-mode) nil)
;; reset the selection variable
(setq speedbar-last-selected-file nil))
@@ -1084,7 +1083,7 @@ Return nil if it doesn't exist."
(define-derived-mode speedbar-mode fundamental-mode "Speedbar"
"Major mode for managing a display of directories and tags.
-\\<speedbar-key-map>
+\\<speedbar-mode-map>
The first line represents the default directory of the speedbar frame.
Each directory segment is a button which jumps speedbar's default
directory to that directory. Buttons are activated by clicking `\\[speedbar-click]'.
@@ -1121,7 +1120,7 @@ category of tags. Click the {+} to expand the category. Jump-able
tags start with >. Click the name of the tag to go to that position
in the selected file.
-\\{speedbar-key-map}"
+\\{speedbar-mode-map}"
(save-excursion
(setq font-lock-keywords nil) ;; no font-locking please
(setq truncate-lines t)
@@ -1413,9 +1412,10 @@ Argument ARG represents to force a refresh past any caches that may exist."
(dframe-power-click arg)
deactivate-mark)
;; We need to hack something so this works in detached frames.
- (while dl
- (adelete 'speedbar-directory-contents-alist (car dl))
- (setq dl (cdr dl)))
+ (dolist (d dl)
+ (setq speedbar-directory-contents-alist
+ (delq (assoc d speedbar-directory-contents-alist)
+ speedbar-directory-contents-alist)))
(if (<= 1 speedbar-verbosity-level)
(speedbar-message "Refreshing speedbar..."))
(speedbar-update-contents)
@@ -1864,9 +1864,7 @@ of the special mode functions."
;; If it is autoloaded, we need to load it now so that
;; we have access to the variable -speedbar-menu-items.
;; Is this XEmacs safe?
- (let ((sf (symbol-function v)))
- (if (and (listp sf) (eq (car sf) 'autoload))
- (load-library (car (cdr sf)))))
+ (autoload-do-load (symbol-function v) v)
(setq speedbar-special-mode-expansion-list (list v))
(setq v (intern-soft (concat ms "-speedbar-key-map")))
(if (not v)
@@ -1898,12 +1896,9 @@ matching ignored headers. Cache any directory files found in
`speedbar-directory-contents-alist' and use that cache before scanning
the file-system."
(setq directory (expand-file-name directory))
- ;; If in powerclick mode, then the directory we are getting
- ;; should be rescanned.
- (if dframe-power-click
- (adelete 'speedbar-directory-contents-alist directory))
;; find the directory, either in the cache, or build it.
- (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
+ (or (and (not dframe-power-click) ;; In powerclick mode, always rescan.
+ (cdr-safe (assoc directory speedbar-directory-contents-alist)))
(let ((default-directory directory)
(dir (directory-files directory nil))
(dirs nil)
@@ -1917,8 +1912,11 @@ the file-system."
(setq dirs (cons (car dir) dirs))
(setq files (cons (car dir) files))))
(setq dir (cdr dir)))
- (let ((nl (cons (nreverse dirs) (list (nreverse files)))))
- (aput 'speedbar-directory-contents-alist directory nl)
+ (let ((nl (cons (nreverse dirs) (list (nreverse files))))
+ (ae (assoc directory speedbar-directory-contents-alist)))
+ (if ae (setcdr ae nl)
+ (push (cons directory nl)
+ speedbar-directory-contents-alist))
nl))
))
@@ -3063,7 +3061,7 @@ a function if appropriate."
(let* ((speedbar-frame (speedbar-current-frame))
(fn (get-text-property (point) 'speedbar-function))
(tok (get-text-property (point) 'speedbar-token))
- ;; The 1-,+ is safe because scaning starts AFTER the point
+ ;; The 1-,+ is safe because scanning starts AFTER the point
;; specified. This lets the search include the character the
;; cursor is on.
(tp (previous-single-property-change
@@ -3610,6 +3608,7 @@ functions to do caching and flushing if appropriate."
nil
(eval-when-compile (condition-case nil (require 'imenu) (error nil)))
+(declare-function imenu--make-index-alist "imenu" (&optional no-error))
(defun speedbar-fetch-dynamic-imenu (file)
"Load FILE into a buffer, and generate tags using Imenu.
@@ -3987,11 +3986,11 @@ TEXT is the buffer's name, TOKEN and INDENT are unused."
(defun speedbar-unhighlight-one-tag-line ()
"Unhighlight the currently highlighted line."
- (if speedbar-highlight-one-tag-line
- (progn
- (speedbar-delete-overlay speedbar-highlight-one-tag-line)
- (setq speedbar-highlight-one-tag-line nil)))
- (remove-hook 'pre-command-hook 'speedbar-unhighlight-one-tag-line))
+ (when (and speedbar-highlight-one-tag-line
+ (not (eq this-command 'handle-switch-frame)))
+ (speedbar-delete-overlay speedbar-highlight-one-tag-line)
+ (setq speedbar-highlight-one-tag-line nil)
+ (remove-hook 'pre-command-hook 'speedbar-unhighlight-one-tag-line)))
(defun speedbar-recenter-to-top ()
"Recenter the current buffer so point is on the top of the window."
@@ -4005,73 +4004,68 @@ TEXT is the buffer's name, TOKEN and INDENT are unused."
;;; Color loading section.
;;
(defface speedbar-button-face '((((class color) (background light))
- (:foreground "green4"))
+ :foreground "green4")
(((class color) (background dark))
- (:foreground "green3")))
- "Face used for +/- buttons."
+ :foreground "green3"))
+ "Speedbar face for +/- buttons."
:group 'speedbar-faces)
(defface speedbar-file-face '((((class color) (background light))
- (:foreground "cyan4"))
+ :foreground "cyan4")
(((class color) (background dark))
- (:foreground "cyan"))
- (t (:bold t)))
- "Face used for file names."
+ :foreground "cyan")
+ (t :weight bold))
+ "Speedbar face for file names."
:group 'speedbar-faces)
(defface speedbar-directory-face '((((class color) (background light))
- (:foreground "blue4"))
+ :foreground "blue4")
(((class color) (background dark))
- (:foreground "light blue")))
- "Face used for directory names."
+ :foreground "light blue"))
+ "Speedbar face for directory names."
:group 'speedbar-faces)
+
(defface speedbar-tag-face '((((class color) (background light))
- (:foreground "brown"))
+ :foreground "brown")
(((class color) (background dark))
- (:foreground "yellow")))
- "Face used for displaying tags."
+ :foreground "yellow"))
+ "Speedbar face for tags."
:group 'speedbar-faces)
(defface speedbar-selected-face '((((class color) (background light))
- (:foreground "red" :underline t))
+ :foreground "red" :underline t)
(((class color) (background dark))
- (:foreground "red" :underline t))
- (t (:underline t)))
- "Face used to underline the file in the active window."
+ :foreground "red" :underline t)
+ (t :underline t))
+ "Speedbar face for the file in the active window."
:group 'speedbar-faces)
(defface speedbar-highlight-face '((((class color) (background light))
- (:background "green"))
+ :background "green")
(((class color) (background dark))
- (:background "sea green"))
- (((class grayscale monochrome)
- (background light))
- (:background "black"))
- (((class grayscale monochrome)
- (background dark))
- (:background "white")))
- "Face used for highlighting buttons with the mouse."
+ :background "sea green"))
+ "Speedbar face for highlighting buttons with the mouse."
:group 'speedbar-faces)
(defface speedbar-separator-face '((((class color) (background light))
- (:background "blue"
- :foreground "white"
- :overline "gray"))
+ :background "blue"
+ :foreground "white"
+ :overline "gray")
(((class color) (background dark))
- (:background "blue"
- :foreground "white"
- :overline "gray"))
+ :background "blue"
+ :foreground "white"
+ :overline "gray")
(((class grayscale monochrome)
(background light))
- (:background "black"
- :foreground "white"
- :overline "white"))
+ :background "black"
+ :foreground "white"
+ :overline "white")
(((class grayscale monochrome)
(background dark))
- (:background "white"
- :foreground "black"
- :overline "black")))
- "Face used for separator labels in a display."
+ :background "white"
+ :foreground "black"
+ :overline "black"))
+ "Speedbar face for separator labels in a display."
:group 'speedbar-faces)
;; some edebug hooks
diff --git a/lisp/startup.el b/lisp/startup.el
index 06911e00d0d..2e8b6b7f8c4 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1,6 +1,6 @@
;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1992, 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1992, 1994-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
@@ -41,9 +41,12 @@
(defcustom initial-buffer-choice nil
"Buffer to show after starting Emacs.
If the value is nil and `inhibit-startup-screen' is nil, show the
-startup screen. If the value is string, visit the specified file
+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 "~/")
@@ -65,16 +68,19 @@ once you are familiar with the contents of the startup screen."
(defvar startup-screen-inhibit-startup-screen nil)
+;; FIXME? Why does this get such weirdly extreme treatment, when the
+;; more important inhibit-startup-screen does not.
(defcustom inhibit-startup-echo-area-message nil
"Non-nil inhibits the initial startup echo area message.
Setting this variable takes effect
only if you do it with the customization buffer
-or if your `.emacs' file contains a line of this form:
+or if your init file contains a line of this form:
(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
-If your `.emacs' file is byte-compiled, use the following form instead:
+If your init file is byte-compiled, use the following form
+instead:
(eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
-Thus, someone else using a copy of your `.emacs' file will see
-the startup message unless he personally acts to inhibit it."
+Thus, someone else using a copy of your init file will see the
+startup message unless he personally acts to inhibit it."
:type '(choice (const :tag "Don't inhibit")
(string :tag "Enter your user name, to inhibit"))
:group 'initialization)
@@ -99,16 +105,15 @@ the remaining command-line args are in the variable `command-line-args-left'.")
"List of command-line args not yet processed.")
(defvaralias 'argv 'command-line-args-left
- ;; FIXME: Bad name for a dynamically bound variable.
"List of command-line args not yet processed.
This is a convenience alias, so that one can write \(pop argv\)
inside of --eval command line arguments in order to access
following arguments.")
+(internal-make-var-non-special 'argv)
-(with-no-warnings
- ;; FIXME: Bad name for a dynamically bound variable
- (defvar argi nil
- "Current command-line argument."))
+(defvar argi nil
+ "Current command-line argument.")
+(internal-make-var-non-special 'argi)
(defvar command-line-functions nil ;; lrs 7/31/89
"List of functions to process unrecognized command-line arguments.
@@ -122,8 +127,8 @@ altering `command-line-args-left' to remove them.")
"Default directory to use for command line arguments.
This is normally copied from `default-directory' when Emacs starts.")
-;;; This is here, rather than in x-win.el, so that we can ignore these
-;;; options when we are not using X.
+;; This is here, rather than in x-win.el, so that we can ignore these
+;; options when we are not using X.
(defconst command-line-x-option-alist
'(("-bw" 1 x-handle-numeric-switch border-width)
("-d" 1 x-handle-display)
@@ -214,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)
@@ -260,10 +265,14 @@ and VALUE is the value which is given to that frame parameter
"Normal hook run after handling urgent options but before loading init files.")
(defvar after-init-hook nil
- "Normal hook run after loading the init files, `~/.emacs' and `default.el'.
-There is no `condition-case' around the running of these functions;
-therefore, if you set `debug-on-error' non-nil in `.emacs',
-an error in one of these functions will invoke the debugger.")
+ "Normal hook run after initializing the Emacs session.
+It is run after Emacs loads the init file, `default' library, the
+abbrevs file, and additional Lisp packages (if any), and setting
+the value of `after-init-time'.
+
+There is no `condition-case' around the running of this hook;
+therefore, if `debug-on-error' is non-nil, an error in one of
+these functions will invoke the debugger.")
(defvar emacs-startup-hook nil
"Normal hook run after loading init files and handling the command line.")
@@ -295,7 +304,7 @@ the user's init file.")
:group 'initialization)
(defvar init-file-user nil
- "Identity of user whose `.emacs' file is or was read.
+ "Identity of user whose init file is or was read.
The value is nil if `-q' or `--no-init-file' was specified,
meaning do not load any init file.
@@ -305,7 +314,7 @@ or it may be a string containing a user's name meaning
use that person's init file.
In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
-evaluates to the name of the directory where the `.emacs' file was
+evaluates to the name of the directory where the init file was
looked for.
Setting `init-file-user' does not prevent Emacs from loading
@@ -337,7 +346,9 @@ this variable usefully is to set it while building and dumping Emacs."
(error "Customizing `site-run-file' does not work")))
(defcustom mail-host-address nil
- "Name of this machine, for purposes of naming users."
+ "Name of this machine, for purposes of naming users.
+If non-nil, Emacs uses this instead of `system-name' when constructing
+email addresses."
:type '(choice (const nil) string)
:group 'mail)
@@ -362,7 +373,7 @@ init file is read, in case it sets `mail-host-address'."
(t
(concat user-emacs-directory "auto-save-list/.saves-")))
"Prefix for generating `auto-save-list-file-name'.
-This is used after reading your `.emacs' file to initialize
+This is used after reading your init file to initialize
`auto-save-list-file-name', by appending Emacs's pid and the system name,
if you have not already set `auto-save-list-file-name' yourself.
Directories in the prefix will be created if necessary.
@@ -464,6 +475,10 @@ DIRS are relative."
(setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))))
(defun normal-top-level ()
+ "Emacs calls this function when it first starts up.
+It sets `command-line-processed', processes the command-line,
+reads the initialization files, etc.
+It is the default value of the variable `top-level'."
(if command-line-processed
(message "Back to top level.")
(setq command-line-processed t)
@@ -482,13 +497,20 @@ DIRS are relative."
;; of that dir into load-path,
;; Look for a leim-list.el file too. Loading it will register
;; available input methods.
- (let ((tail load-path) dir)
+ (let ((tail load-path)
+ (lispdir (expand-file-name "../lisp" data-directory))
+ ;; For out-of-tree builds, leim-list is generated in the build dir.
+;;; (leimdir (expand-file-name "../leim" doc-directory))
+ dir)
(while tail
(setq dir (car tail))
(let ((default-directory dir))
(load (expand-file-name "subdirs.el") t t t))
- (let ((default-directory dir))
- (load (expand-file-name "leim-list.el") t t t))
+ ;; Do not scan standard directories that won't contain a leim-list.el.
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html
+ (or (string-match (concat "\\`" lispdir) dir)
+ (let ((default-directory dir))
+ (load (expand-file-name "leim-list.el") t t t)))
;; We don't use a dolist loop and we put this "setq-cdr" command at
;; the end, because the subdirs.el files may add elements to the end
;; of load-path and we want to take it into account.
@@ -701,6 +723,8 @@ opening the first frame (e.g. open a connection to an X server).")
(defvar server-process)
(defun command-line ()
+ "A subroutine of `normal-top-level'.
+Amongst another things, it parses the command-line arguments."
(setq before-init-time (current-time)
after-init-time nil
command-line-default-directory default-directory)
@@ -866,7 +890,8 @@ opening the first frame (e.g. open a connection to an X server).")
;; Initialize the window system. (Open connection, etc.)
(funcall
(or (cdr (assq initial-window-system window-system-initialization-alist))
- (error "Unsupported window system `%s'" initial-window-system))))
+ (error "Unsupported window system `%s'" initial-window-system)))
+ (put initial-window-system 'window-system-initialized t))
;; If there was an error, print the error message and exit.
(error
(princ
@@ -888,33 +913,12 @@ opening the first frame (e.g. open a connection to an X server).")
(run-hooks 'before-init-hook)
- ;; Under X, this creates the X frame and deletes the terminal frame.
+ ;; Under X, create the X frame and delete the terminal frame.
(unless (daemonp)
-
- ;; If X resources are available, use them to initialize the values
- ;; of `tool-bar-mode' and `menu-bar-mode', as well as the value of
- ;; `no-blinking-cursor' and the `cursor' face.
- (cond
- ((or noninteractive emacs-basic-display)
- (setq menu-bar-mode nil
- tool-bar-mode nil
- no-blinking-cursor t))
- ((memq initial-window-system '(x w32 ns))
- (let ((no-vals '("no" "off" "false" "0")))
- (if (member (x-get-resource "menuBar" "MenuBar") no-vals)
- (setq menu-bar-mode nil))
- (if (member (x-get-resource "toolBar" "ToolBar") no-vals)
- (setq tool-bar-mode nil))
- (if (member (x-get-resource "cursorBlink" "CursorBlink")
- no-vals)
- (setq no-blinking-cursor t)))
- ;; If the cursorColor X resource exists, alter the `cursor' face
- ;; spec, but mark it as changed outside of Customize.
- (let ((color (x-get-resource "cursorColor" "CursorColor")))
- (when color
- (put 'cursor 'theme-face
- `((changed ((t :background ,color)))))
- (put 'cursor 'face-modified t)))))
+ (if (or noninteractive emacs-basic-display)
+ (setq menu-bar-mode nil
+ tool-bar-mode nil
+ no-blinking-cursor t))
(frame-initialize))
(when (fboundp 'x-create-frame)
@@ -929,7 +933,7 @@ opening the first frame (e.g. open a connection to an X server).")
emacs-basic-display
(and (memq window-system '(x w32 ns))
(not (member (x-get-resource "cursorBlink" "CursorBlink")
- '("off" "false")))))
+ '("no" "off" "false" "0")))))
(setq no-blinking-cursor t))
;; Re-evaluate predefined variables whose initial value depends on
@@ -967,7 +971,6 @@ opening the first frame (e.g. open a connection to an X server).")
(not (eq 0 (cdr tool-bar-lines)))))))
(let ((old-scalable-fonts-allowed scalable-fonts-allowed)
- (old-font-list-limit font-list-limit)
(old-face-ignored-fonts face-ignored-fonts))
;; Run the site-start library if it exists. The point of this file is
@@ -1006,7 +1009,9 @@ opening the first frame (e.g. open a connection to an X server).")
nil
(display-warning 'initialization
(format "User %s has no home directory"
- init-file-user)
+ (if (equal init-file-user "")
+ (user-real-login-name)
+ init-file-user))
:error))))
;; Load that user's init file, or the default one, or none.
@@ -1152,43 +1157,10 @@ the `--debug-init' option to view a complete error backtrace."
(or mail-host-address
(system-name))))))
- ;; Originally face attributes were specified via
- ;; `font-lock-face-attributes'. Users then changed the default
- ;; face attributes by setting that variable. However, we try and
- ;; be back-compatible and respect its value if set except for
- ;; faces where M-x customize has been used to save changes for the
- ;; face.
- (when (boundp 'font-lock-face-attributes)
- (let ((face-attributes font-lock-face-attributes))
- (while face-attributes
- (let* ((face-attribute (pop face-attributes))
- (face (car face-attribute)))
- ;; Rustle up a `defface' SPEC from a
- ;; `font-lock-face-attributes' entry.
- (unless (get face 'saved-face)
- (let ((foreground (nth 1 face-attribute))
- (background (nth 2 face-attribute))
- (bold-p (nth 3 face-attribute))
- (italic-p (nth 4 face-attribute))
- (underline-p (nth 5 face-attribute))
- face-spec)
- (when foreground
- (setq face-spec (cons ':foreground (cons foreground face-spec))))
- (when background
- (setq face-spec (cons ':background (cons background face-spec))))
- (when bold-p
- (setq face-spec (append '(:weight bold) face-spec)))
- (when italic-p
- (setq face-spec (append '(:slant italic) face-spec)))
- (when underline-p
- (setq face-spec (append '(:underline t) face-spec)))
- (face-spec-set face (list (list t face-spec)) nil)))))))
-
;; If parameter have been changed in the init file which influence
;; face realization, clear the face cache so that new faces will
;; be realized.
(unless (and (eq scalable-fonts-allowed old-scalable-fonts-allowed)
- (eq font-list-limit old-font-list-limit)
(eq face-ignored-fonts old-face-ignored-fonts))
(clear-face-cache)))
@@ -1281,6 +1253,29 @@ the `--debug-init' option to view a complete error backtrace."
(with-no-warnings
(emacs-session-restore x-session-previous-id))))
+(defun x-apply-session-resources ()
+ "Apply X resources which specify initial values for Emacs variables.
+This is called from a window-system initialization function, such
+as `x-initialize-window-system' for X, either at startup (prior
+to reading the init file), or afterwards when the user first
+opens a graphical frame.
+
+This can set the values of `menu-bar-mode', `tool-bar-mode', and
+`no-blinking-cursor', as well as the `cursor' face. Changed
+settings will be marked as \"CHANGED outside of Customize\"."
+ (let ((no-vals '("no" "off" "false" "0"))
+ (settings '(("menuBar" "MenuBar" menu-bar-mode nil)
+ ("toolBar" "ToolBar" tool-bar-mode nil)
+ ("cursorBlink" "CursorBlink" no-blinking-cursor t))))
+ (dolist (x settings)
+ (if (member (x-get-resource (nth 0 x) (nth 1 x)) no-vals)
+ (set (nth 2 x) (nth 3 x)))))
+ (let ((color (x-get-resource "cursorColor" "Foreground")))
+ (when color
+ (put 'cursor 'theme-face
+ `((changed ((t :background ,color)))))
+ (put 'cursor 'face-modified t))))
+
(defcustom initial-scratch-message (purecopy "\
;; This buffer is for notes you don't want to save, and for Lisp evaluation.
;; If you want to create a file, visit that file with C-x C-f,
@@ -1325,7 +1320,15 @@ If this is nil, no message will be displayed."
(title (with-temp-buffer
(insert-file-contents
(expand-file-name tut tutorial-directory)
- nil 0 256)
+ ;; We used to read only the first 256 bytes of
+ ;; the tutorial, but that prevents the coding:
+ ;; setting, if any, in file-local variables
+ ;; section to be seen by insert-file-contents,
+ ;; and results in gibberish when the language
+ ;; environment's preferred encoding is
+ ;; different from what the file-local variable
+ ;; says. One case in point is Hebrew.
+ nil)
(search-forward ".")
(buffer-substring (point-min) (1- (point))))))
;; If there is a specific tutorial for the current language
@@ -1505,7 +1508,8 @@ a face or button specification."
(if (image-type-available-p 'xpm)
"splash.xpm"
"splash.pbm"))
- ((image-type-available-p 'svg)
+ ((or (image-type-available-p 'svg)
+ (image-type-available-p 'imagemagick))
"splash.svg")
((image-type-available-p 'png)
"splash.png")
@@ -1689,7 +1693,6 @@ splash screen in another window."
(force-mode-line-update))
(use-local-map splash-screen-keymap)
(setq tab-width 22)
- (message "%s" (startup-echo-area-message))
(setq buffer-read-only t)
(goto-char (point-min))
(forward-line 3))))
@@ -2076,6 +2079,7 @@ A fancy display is used on graphic displays, normal otherwise."
(defalias 'display-splash-screen 'display-startup-screen)
(defun command-line-1 (args-left)
+ "A subroutine of `command-line'."
(display-startup-echo-area-message)
(when (and pure-space-overflow
(not noninteractive))
@@ -2330,6 +2334,7 @@ A fancy display is used on graphic displays, normal otherwise."
(if (or inhibit-startup-screen
initial-buffer-choice
noninteractive
+ (daemonp)
inhibit-x-resources)
;; Not displaying a startup screen. If 3 or more files
@@ -2372,9 +2377,7 @@ A fancy display is used on graphic displays, normal otherwise."
;; (with-no-warnings
;; (setq menubar-bindings-done t))
- (if (> file-count 0)
- (display-startup-screen t)
- (display-startup-screen nil)))))
+ (display-startup-screen (> file-count 0)))))
(defun command-line-normalize-file-name (file)
"Collapse multiple slashes to one, to handle non-Emacs file names."
diff --git a/lisp/strokes.el b/lisp/strokes.el
index 5ff94bb22c6..9a3a7608d2b 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -1,6 +1,6 @@
;;; strokes.el --- control Emacs through mouse strokes
-;; Copyright (C) 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2012 Free Software Foundation, Inc.
;; Author: David Bakhash <cadet@alum.mit.edu>
;; Maintainer: FSF
@@ -180,7 +180,7 @@
;;; Requirements and provisions...
(autoload 'mail-position-on-field "sendmail")
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; Constants...
@@ -212,8 +212,11 @@ static char * stroke_xpm[] = {
:link '(emacs-commentary-link "strokes")
:group 'mouse)
-(defcustom strokes-modeline-string " Strokes"
- "Modeline identification when Strokes mode is on \(default is \" Strokes\"\)."
+(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)
@@ -540,10 +543,10 @@ The return value is a list ((XMIN . YMIN) (XMAX . YMAX))."
(defun strokes-eliminate-consecutive-redundancies (entries)
"Return a list with no consecutive redundant entries."
;; defun a grande vitesse grace a Dave G.
- (loop for element on entries
- if (not (equal (car element) (cadr element)))
- collect (car element)))
-;; (loop for element on entries
+ (cl-loop for element on entries
+ if (not (equal (car element) (cadr element)))
+ collect (car element)))
+;; (cl-loop for element on entries
;; nconc (if (not (equal (car el) (cadr el)))
;; (list (car el)))))
;; yet another (orig) way of doing it...
@@ -582,68 +585,70 @@ NOTE: This is where the global variable `strokes-last-stroke' is set."
(if (and (strokes-click-p unfilled-stroke)
(not force))
unfilled-stroke
- (loop for grid-locs on unfilled-stroke
- nconc (let* ((current (car grid-locs))
- (current-is-a-point-p (consp current))
- (next (cadr grid-locs))
- (next-is-a-point-p (consp next))
- (both-are-points-p (and current-is-a-point-p
- next-is-a-point-p))
- (x1 (and current-is-a-point-p
- (car current)))
- (y1 (and current-is-a-point-p
- (cdr current)))
- (x2 (and next-is-a-point-p
- (car next)))
- (y2 (and next-is-a-point-p
- (cdr next)))
- (delta-x (and both-are-points-p
- (- x2 x1)))
- (delta-y (and both-are-points-p
- (- y2 y1)))
- (slope (and both-are-points-p
- (if (zerop delta-x)
- nil ; undefined vertical slope
- (/ (float delta-y)
- delta-x)))))
- (cond ((not both-are-points-p)
- (list current))
- ((null slope) ; undefined vertical slope
- (if (>= delta-y 0)
- (loop for y from y1 below y2
- collect (cons x1 y))
- (loop for y from y1 above y2
- collect (cons x1 y))))
- ((zerop slope) ; (= y1 y2)
- (if (>= delta-x 0)
- (loop for x from x1 below x2
- collect (cons x y1))
- (loop for x from x1 above x2
- collect (cons x y1))))
- ((>= (abs delta-x) (abs delta-y))
- (if (> delta-x 0)
- (loop for x from x1 below x2
- collect (cons x
- (+ y1
- (round (* slope
- (- x x1))))))
- (loop for x from x1 above x2
- collect (cons x
- (+ y1
- (round (* slope
- (- x x1))))))))
- (t ; (< (abs delta-x) (abs delta-y))
- (if (> delta-y 0)
- (loop for y from y1 below y2
- collect (cons (+ x1
- (round (/ (- y y1)
- slope)))
- y))
- (loop for y from y1 above y2
- collect (cons (+ x1
- (round (/ (- y y1)
- slope)))
- y))))))))))
+ (cl-loop
+ for grid-locs on unfilled-stroke
+ nconc (let* ((current (car grid-locs))
+ (current-is-a-point-p (consp current))
+ (next (cadr grid-locs))
+ (next-is-a-point-p (consp next))
+ (both-are-points-p (and current-is-a-point-p
+ next-is-a-point-p))
+ (x1 (and current-is-a-point-p
+ (car current)))
+ (y1 (and current-is-a-point-p
+ (cdr current)))
+ (x2 (and next-is-a-point-p
+ (car next)))
+ (y2 (and next-is-a-point-p
+ (cdr next)))
+ (delta-x (and both-are-points-p
+ (- x2 x1)))
+ (delta-y (and both-are-points-p
+ (- y2 y1)))
+ (slope (and both-are-points-p
+ (if (zerop delta-x)
+ nil ; undefined vertical slope
+ (/ (float delta-y)
+ delta-x)))))
+ (cond ((not both-are-points-p)
+ (list current))
+ ((null slope) ; undefined vertical slope
+ (if (>= delta-y 0)
+ (cl-loop for y from y1 below y2
+ collect (cons x1 y))
+ (cl-loop for y from y1 above y2
+ collect (cons x1 y))))
+ ((zerop slope) ; (= y1 y2)
+ (if (>= delta-x 0)
+ (cl-loop for x from x1 below x2
+ collect (cons x y1))
+ (cl-loop for x from x1 above x2
+ collect (cons x y1))))
+ ((>= (abs delta-x) (abs delta-y))
+ (if (> delta-x 0)
+ (cl-loop for x from x1 below x2
+ collect (cons x
+ (+ y1
+ (round (* slope
+ (- x x1))))))
+ (cl-loop for x from x1 above x2
+ collect (cons x
+ (+ y1
+ (round (* slope
+ (- x x1))))))))
+ (t ; (< (abs delta-x) (abs delta-y))
+ (if (> delta-y 0)
+ ;; FIXME: Reduce redundancy between branches.
+ (cl-loop for y from y1 below y2
+ collect (cons (+ x1
+ (round (/ (- y y1)
+ slope)))
+ y))
+ (cl-loop for y from y1 above y2
+ collect (cons (+ x1
+ (round (/ (- y y1)
+ slope)))
+ y))))))))))
(defun strokes-rate-stroke (stroke1 stroke2)
"Rates STROKE1 with STROKE2 and return a score based on a distance metric.
@@ -721,9 +726,9 @@ Returns the corresponding match as (COMMAND . SCORE)."
(defsubst strokes-fill-current-buffer-with-whitespace ()
"Erase the contents of the current buffer and fill it with whitespace."
(erase-buffer)
- (loop repeat (frame-height) do
- (insert-char ?\s (1- (frame-width)))
- (newline))
+ (cl-loop repeat (frame-height) do
+ (insert-char ?\s (1- (frame-width)))
+ (newline))
(goto-char (point-min)))
;;;###autoload
@@ -929,14 +934,7 @@ and then safely save them for later use, send letters to friends
extracting the strokes for editing use once again, so the editing
cycle can continue.
-Strokes are easy to program and fun to use. To start strokes going,
-you'll want to put the following line in your .emacs file as mentioned
-in the commentary to strokes.el.
-
-This will load strokes when and only when you start Emacs on a window
-system, with a mouse or other pointer device defined.
-
-To toggle strokes-mode, you just do
+To toggle strokes-mode, invoke the command
> M-x strokes-mode
@@ -1171,40 +1169,40 @@ the stroke as a character in some language."
(set-buffer buf)
(erase-buffer)
(insert strokes-xpm-header)
- (loop repeat 33 do
- (insert ?\")
- (insert-char ?\s 33)
- (insert "\",")
- (newline)
- finally
- (forward-line -1)
- (end-of-line)
- (insert "}\n"))
- (loop for point in stroke
- for x = (car-safe point)
- for y = (cdr-safe point) do
- (cond ((consp point)
- ;; draw a point, and possibly a starting-point
- (if (and lift-flag (not b/w-only))
- ;; mark starting point with the appropriate color
- (let ((char (or (car rainbow-chars) ?\.)))
- (loop for i from 0 to 2 do
- (loop for j from 0 to 2 do
- (goto-char (point-min))
- (forward-line (+ 15 i y))
- (forward-char (+ 1 j x))
- (delete-char 1)
- (insert char)))
- (setq rainbow-chars (cdr rainbow-chars)
- lift-flag nil))
- ;; Otherwise, just plot the point...
- (goto-char (point-min))
- (forward-line (+ 16 y))
- (forward-char (+ 2 x))
- (subst-char-in-region (point) (1+ (point)) ?\s ?\*)))
- ((strokes-lift-p point)
- ;; a lift--tell the loop to X out the next point...
- (setq lift-flag t))))
+ (cl-loop repeat 33 do
+ (insert ?\")
+ (insert-char ?\s 33)
+ (insert "\",")
+ (newline)
+ finally
+ (forward-line -1)
+ (end-of-line)
+ (insert "}\n"))
+ (cl-loop for point in stroke
+ for x = (car-safe point)
+ for y = (cdr-safe point) do
+ (cond ((consp point)
+ ;; draw a point, and possibly a starting-point
+ (if (and lift-flag (not b/w-only))
+ ;; mark starting point with the appropriate color
+ (let ((char (or (car rainbow-chars) ?\.)))
+ (cl-loop for i from 0 to 2 do
+ (cl-loop for j from 0 to 2 do
+ (goto-char (point-min))
+ (forward-line (+ 15 i y))
+ (forward-char (+ 1 j x))
+ (delete-char 1)
+ (insert char)))
+ (setq rainbow-chars (cdr rainbow-chars)
+ lift-flag nil))
+ ;; Otherwise, just plot the point...
+ (goto-char (point-min))
+ (forward-line (+ 16 y))
+ (forward-char (+ 2 x))
+ (subst-char-in-region (point) (1+ (point)) ?\s ?\*)))
+ ((strokes-lift-p point)
+ ;; a lift--tell the loop to X out the next point...
+ (setq lift-flag t))))
(when (called-interactively-p 'interactive)
(pop-to-buffer " *strokes-xpm*")
;; (xpm-mode 1)
@@ -1286,7 +1284,7 @@ the stroke as a character in some language."
;; (insert
;; "Command Stroke\n"
;; "------- ------")
-;; (loop for def in strokes-map
+;; (cl-loop for def in strokes-map
;; for i from 0 to (1- (length strokes-map)) do
;; (let ((stroke (car def))
;; (command-name (symbol-name (cdr def))))
@@ -1341,27 +1339,28 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead."
(insert
"Command Stroke\n"
"------- ------")
- (loop for def in strokes-map do
- (let ((stroke (car def))
- (command-name (if (symbolp (cdr def))
- (symbol-name (cdr def))
- (prin1-to-string (cdr def)))))
- (strokes-xpm-for-stroke stroke " *strokes-xpm*")
- (newline 2)
- (insert-char ?\s 45)
- (beginning-of-line)
- (insert command-name)
- (beginning-of-line)
- (forward-char 45)
- (insert-image
- (create-image (with-current-buffer " *strokes-xpm*"
- (buffer-string))
- 'xpm t
- :color-symbols
- `(("foreground"
- . ,(frame-parameter nil 'foreground-color))))))
- finally do (unless (eobp)
- (kill-region (1+ (point)) (point-max))))
+ (cl-loop
+ for def in strokes-map do
+ (let ((stroke (car def))
+ (command-name (if (symbolp (cdr def))
+ (symbol-name (cdr def))
+ (prin1-to-string (cdr def)))))
+ (strokes-xpm-for-stroke stroke " *strokes-xpm*")
+ (newline 2)
+ (insert-char ?\s 45)
+ (beginning-of-line)
+ (insert command-name)
+ (beginning-of-line)
+ (forward-char 45)
+ (insert-image
+ (create-image (with-current-buffer " *strokes-xpm*"
+ (buffer-string))
+ 'xpm t
+ :color-symbols
+ `(("foreground"
+ . ,(frame-parameter nil 'foreground-color))))))
+ finally do (unless (eobp)
+ (kill-region (1+ (point)) (point-max))))
(view-buffer "*Strokes List*" nil)
(set (make-local-variable 'view-mode-map)
(let ((map (copy-keymap view-mode-map)))
@@ -1403,7 +1402,7 @@ Encode/decode your strokes with \\[strokes-encode-buffer],
\\[strokes-decode-buffer].
\\{strokes-mode-map}"
- nil strokes-modeline-string strokes-mode-map
+ nil strokes-lighter strokes-mode-map
:group 'strokes :global t
(cond ((not (display-mouse-p))
(error "Can't use Strokes without a mouse"))
@@ -1586,7 +1585,7 @@ XPM-BUFFER defaults to ` *strokes-xpm*'."
;; yet another of the same bit-type, so we continue
;; counting...
(progn
- (incf count)
+ (cl-incf count)
(forward-char 1))
;; otherwise, it's the opposite bit-type, so we do a
;; write and then restart count ### NOTE (for myself
@@ -1725,10 +1724,10 @@ Store XPM in buffer BUFNAME if supplied \(default is ` *strokes-xpm*'\)"
(delete-char 1)
(setq current-char-is-on-p (not current-char-is-on-p)))
(goto-char (point-min))
- (loop repeat 33 do
- (insert ?\")
- (forward-char 33)
- (insert "\",\n"))
+ (cl-loop repeat 33 do
+ (insert ?\")
+ (forward-char 33)
+ (insert "\",\n"))
(goto-char (point-min))
(insert strokes-xpm-header))))
diff --git a/lisp/subr.el b/lisp/subr.el
index 36937e8f370..c0479d35987 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1,6 +1,6 @@
;;; subr.el --- basic lisp subroutines for Emacs -*- coding: utf-8 -*-
-;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2011
+;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -26,6 +26,9 @@
;;; Code:
+;; Beware: while this file has tag `utf-8', before it's compiled, it gets
+;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap.
+
(defvar custom-declare-variable-list nil
"Record `defcustom' calls made before `custom.el' is loaded to handle them.
Each element of this list holds the arguments to one call to `defcustom'.")
@@ -77,6 +80,7 @@ For more information, see Info node `(elisp)Declaring Functions'."
(defmacro noreturn (form)
"Evaluate FORM, expecting it not to return.
If FORM does return, signal an error."
+ (declare (debug t))
`(prog1 ,form
(error "Form marked with `noreturn' did return")))
@@ -84,6 +88,7 @@ If FORM does return, signal an error."
"Evaluate FORM, expecting a constant return value.
This is the global do-nothing version. There is also `testcover-1value'
that complains if FORM ever does return differing values."
+ (declare (debug t))
form)
(defmacro def-edebug-spec (symbol spec)
@@ -112,10 +117,29 @@ It may also be omitted.
BODY should be a list of Lisp expressions.
\(fn ARGS [DOCSTRING] [INTERACTIVE] BODY)"
+ (declare (doc-string 2) (indent defun)
+ (debug (&define lambda-list
+ [&optional stringp]
+ [&optional ("interactive" interactive)]
+ def-body)))
;; Note that this definition should not use backquotes; subr.el should not
;; depend on backquote.el.
(list 'function (cons 'lambda cdr)))
+(defmacro setq-local (var val)
+ "Set variable VAR to value VAL in current buffer."
+ ;; Can't use backquote here, it's too early in the bootstrap.
+ (list 'set (list 'make-local-variable (list 'quote var)) val))
+
+(defmacro defvar-local (var val &optional docstring)
+ "Define VAR as a buffer-local variable with default value VAL.
+Like `defvar' but additionally marks the variable as being automatically
+buffer-local wherever it is set."
+ (declare (debug defvar) (doc-string 3))
+ ;; Can't use backquote here, it's too early in the bootstrap.
+ (list 'progn (list 'defvar var val docstring)
+ (list 'make-variable-buffer-local (list 'quote var))))
+
(defun apply-partially (fun &rest args)
"Return a function that is a partial application of FUN to ARGS.
ARGS is a list of the first N arguments to pass to FUN.
@@ -125,29 +149,33 @@ was called."
`(closure (t) (&rest args)
(apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args)))
-(if (null (featurep 'cl))
- (progn
- ;; If we reload subr.el after having loaded CL, be careful not to
- ;; overwrite CL's extended definition of `dolist', `dotimes',
- ;; `declare', `push' and `pop'.
-(defmacro push (newelt listname)
- "Add NEWELT to the list stored in the symbol LISTNAME.
-This is equivalent to (setq LISTNAME (cons NEWELT LISTNAME)).
-LISTNAME must be a symbol."
- (declare (debug (form sexp)))
- (list 'setq listname
- (list 'cons newelt listname)))
-
-(defmacro pop (listname)
- "Return the first element of LISTNAME's value, and remove it from the list.
-LISTNAME must be a symbol whose value is a list.
+(defmacro push (newelt place)
+ "Add NEWELT to the list stored in the generalized variable PLACE.
+This is morally equivalent to (setf PLACE (cons NEWELT PLACE)),
+except that PLACE is only evaluated once (after NEWELT)."
+ (declare (debug (form gv-place)))
+ (if (symbolp place)
+ ;; Important special case, to avoid triggering GV too early in
+ ;; the bootstrap.
+ (list 'setq place
+ (list 'cons newelt place))
+ (require 'macroexp)
+ (macroexp-let2 macroexp-copyable-p v newelt
+ (gv-letplace (getter setter) place
+ (funcall setter `(cons ,v ,getter))))))
+
+(defmacro pop (place)
+ "Return the first element of PLACE's value, and remove it from the list.
+PLACE must be a generalized variable whose value is a list.
If the value is nil, `pop' returns nil but does not actually
change the list."
- (declare (debug (sexp)))
+ (declare (debug (gv-place)))
(list 'car
- (list 'prog1 listname
- (list 'setq listname (list 'cdr listname)))))
-))
+ (if (symbolp place)
+ ;; So we can use `pop' in the bootstrap before `gv' can be used.
+ (list 'prog1 place (list 'setq place (list 'cdr place)))
+ (gv-letplace (getter setter) place
+ `(prog1 ,getter ,(funcall setter `(cdr ,getter)))))))
(defmacro when (cond &rest body)
"If COND yields non-nil, do BODY, else return nil.
@@ -167,12 +195,6 @@ value of last one, or nil if there are none.
(declare (indent 1) (debug t))
(cons 'if (cons cond (cons nil body))))
-(if (null (featurep 'cl))
- (progn
- ;; If we reload subr.el after having loaded CL, be careful not to
- ;; overwrite CL's extended definition of `dolist', `dotimes',
- ;; `declare', `push' and `pop'.
-
(defmacro dolist (spec &rest body)
"Loop over a list.
Evaluate BODY with VAR bound to each car from LIST, in turn.
@@ -195,9 +217,7 @@ Then evaluate RESULT to get return value, default nil.
(let ((,(car spec) (car ,temp)))
,@body
(setq ,temp (cdr ,temp))))
- ,@(if (cdr (cdr spec))
- ;; FIXME: This let often leads to "unused var" warnings.
- `((let ((,(car spec) nil)) ,@(cdr (cdr spec))))))
+ ,@(cdr (cdr spec)))
`(let ((,temp ,(nth 1 spec))
,(car spec))
(while ,temp
@@ -244,15 +264,22 @@ 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)))
@@ -274,6 +301,17 @@ for the sake of consistency."
(signal 'error (list (apply 'format args)))))
(set-advertised-calling-convention 'error '(string &rest args) "23.1")
+(defun user-error (format &rest args)
+ "Signal a pilot error, making error message by passing all args to `format'.
+In Emacs, the convention is that error messages start with a capital
+letter but *do not* end with a period. Please follow this convention
+for the sake of consistency.
+This is just like `error' except that `user-error's are expected to be the
+result of an incorrect manipulation on the part of the user, rather than the
+result of an actual problem."
+ (while t
+ (signal 'user-error (list (apply #'format format args)))))
+
;; We put this here instead of in frame.el so that it's defined even on
;; systems where frame.el isn't loaded.
(defun frame-configuration-p (object)
@@ -420,18 +458,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)
@@ -495,11 +533,14 @@ side-effects, and the argument LIST is not modified."
;;;; Keymap support.
-(defmacro kbd (keys)
+(defun kbd (keys)
"Convert KEYS to the internal Emacs key representation.
KEYS should be a string constant in the format used for
saving keyboard macros (see `edmacro-mode')."
+ ;; Don't use a defalias, since the `pure' property is only true for
+ ;; the calling convention of `kbd'.
(read-kbd-macro keys))
+(put 'kbd 'pure t)
(defun undefined ()
"Beep to tell the user this binding is undefined."
@@ -678,7 +719,6 @@ Subkeymaps may be modified but are not canonicalized."
;; Process the bindings starting from the end.
(dolist (binding (prog1 bindings (setq bindings ())))
(let* ((key (car binding))
- (item (cdr binding))
(oldbind (assq key bindings)))
(push (if (not oldbind)
;; The normal case: no duplicate bindings.
@@ -693,7 +733,7 @@ Subkeymaps may be modified but are not canonicalized."
(put 'keyboard-translate-table 'char-table-extra-slots 0)
(defun keyboard-translate (from to)
- "Translate character FROM to TO at a low level.
+ "Translate character FROM to TO on the current terminal.
This function creates a `keyboard-translate-table' if necessary
and then modifies one entry in it."
(or (char-table-p keyboard-translate-table)
@@ -868,18 +908,12 @@ The normal global definition of the character C-x indirects to this keymap.")
c)))
key)))
-(defsubst eventp (obj)
+(defun eventp (obj)
"True if the argument is an event object."
- (or (and (integerp obj)
- ;; Filter out integers too large to be events.
- ;; M is the biggest modifier.
- (zerop (logand obj (lognot (1- (lsh ?\M-\^@ 1)))))
- (characterp (event-basic-type obj)))
- (and (symbolp obj)
- (get obj 'event-symbol-elements))
- (and (consp obj)
- (symbolp (car obj))
- (get (car obj) 'event-symbol-elements))))
+ (when obj
+ (or (integerp obj)
+ (and (symbolp obj) obj (not (keywordp obj)))
+ (and (consp obj) (symbolp (car obj))))))
(defun event-modifiers (event)
"Return a list of symbols representing the modifier keys in event EVENT.
@@ -943,7 +977,7 @@ in the current Emacs session, then this function may return nil."
;; is this really correct? maybe remove mouse-movement?
(memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement)))
-(defsubst event-start (event)
+(defun event-start (event)
"Return the starting position of EVENT.
EVENT should be a click, drag, or key press event.
If it is a key press event, the return value has the form
@@ -958,9 +992,10 @@ If EVENT is a mouse or key press or a mouse click, this is the
position of the event. If EVENT is a drag, this is the starting
position of the drag."
(if (consp event) (nth 1 event)
- (list (selected-window) (point) '(0 . 0) 0)))
+ (or (posn-at-point)
+ (list (selected-window) (point) '(0 . 0) 0))))
-(defsubst event-end (event)
+(defun event-end (event)
"Return the ending location of EVENT.
EVENT should be a click, drag, or key press event.
If EVENT is a key press event, the return value has the form
@@ -977,7 +1012,8 @@ If EVENT is a mouse or key press or a mouse click, this is the
position of the event. If EVENT is a drag, this is the starting
position of the drag."
(if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
- (list (selected-window) (point) '(0 . 0) 0)))
+ (or (posn-at-point)
+ (list (selected-window) (point) '(0 . 0) 0))))
(defsubst event-click-count (event)
"Return the multi-click count of EVENT, a click or drag event.
@@ -986,6 +1022,13 @@ The return value is a positive integer."
;;;; Extracting fields of the positions in an event.
+(defun posnp (obj)
+ "Return non-nil if OBJ appears to be a valid `posn' object."
+ (and (windowp (car-safe obj))
+ (atom (car-safe (setq obj (cdr obj)))) ;AREA-OR-POS.
+ (integerp (car-safe (car-safe (setq obj (cdr obj))))) ;XOFFSET.
+ (integerp (car-safe (cdr obj))))) ;TIMESTAMP.
+
(defsubst posn-window (position)
"Return the window in POSITION.
POSITION should be a list of the form returned by the `event-start'
@@ -1127,17 +1170,19 @@ be a list of the form returned by `event-start' and `event-end'."
(define-obsolete-function-alias 'string-to-int 'string-to-number "22.1")
(make-obsolete 'forward-point "use (+ (point) N) instead." "23.1")
+(make-obsolete 'buffer-has-markers-at nil "24.3")
(defun insert-string (&rest args)
"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 "")
@@ -1146,11 +1191,10 @@ is converted into a string by expressing it in decimal."
(make-obsolete 'unfocus-frame "it does nothing." "22.1")
(make-obsolete 'make-variable-frame-local
"explicitly check for a frame-parameter instead." "22.2")
-(make-obsolete 'interactive-p 'called-interactively-p "23.2")
-(set-advertised-calling-convention 'called-interactively-p '(kind) "23.1")
(set-advertised-calling-convention
'all-completions '(string collection &optional predicate) "23.1")
(set-advertised-calling-convention 'unintern '(name obarray) "23.3")
+(set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3")
;;;; Obsolescence declarations for variables, and aliases.
@@ -1202,26 +1246,14 @@ 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")
-(make-obsolete-variable
- 'unread-command-char
- "use `unread-command-events' instead. That variable is a list of events
-to reread, so it now uses nil to mean `no event', instead of -1."
- "before 19.15")
-
;; Lisp manual only updated in 22.1.
(define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
"before 19.34")
-(defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions)
-(make-obsolete-variable 'x-lost-selection-hooks
- 'x-lost-selection-functions "22.1")
-(defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
-(make-obsolete-variable 'x-sent-selection-hooks
- 'x-sent-selection-functions "22.1")
+(define-obsolete-variable-alias 'x-lost-selection-hooks
+ 'x-lost-selection-functions "22.1")
+(define-obsolete-variable-alias 'x-sent-selection-hooks
+ 'x-sent-selection-functions "22.1")
;; This was introduced in 21.4 for pre-unicode unification. That
;; usage was rendered obsolete in 23.1 which uses Unicode internally.
@@ -1230,16 +1262,6 @@ to reread, so it now uses nil to mean `no event', instead of -1."
(make-obsolete-variable 'translation-table-for-input nil "23.1")
(defvaralias 'messages-buffer-max-lines 'message-log-max)
-
-;; These aliases exist in Emacs 19.34, and probably before, but were
-;; only marked as obsolete in 23.1.
-;; The lisp manual (since at least Emacs 21) describes them as
-;; existing "for compatibility with Emacs version 18".
-(define-obsolete-variable-alias 'last-input-char 'last-input-event
- "at least 19.34")
-(define-obsolete-variable-alias 'last-command-char 'last-command-event
- "at least 19.34")
-
;;;; Alternate names for functions - these are not being phased out.
@@ -1373,16 +1395,19 @@ around the preceding ones, like a set of nested `around' advices.
Each hook function should accept an argument list consisting of a
function FUN, followed by the additional arguments in ARGS.
-The FUN passed to the first hook function in HOOK performs BODY,
-if it is called with arguments ARGS. The FUN passed to each
-successive hook function is defined based on the preceding hook
-functions; if called with arguments ARGS, it does what the
-`with-wrapper-hook' call would do if the preceding hook functions
-were the only ones present in HOOK.
+The first hook function in HOOK is passed a FUN that, if it is called
+with arguments ARGS, performs BODY (i.e., the default operation).
+The FUN passed to each successive hook function is defined based
+on the preceding hook functions; if called with arguments ARGS,
+it does what the `with-wrapper-hook' call would do if the
+preceding hook functions were the only ones present in HOOK.
+
+Each hook function may call its FUN argument as many times as it wishes,
+including never. In that case, such a hook function acts to replace
+the default definition altogether, and any preceding hook functions.
+Of course, a subsequent hook function may do the same thing.
-In the function definition of each hook function, FUN can be
-called any number of times (including not calling it at all).
-That function definition is then used to construct the FUN passed
+Each hook function definition is used to construct the FUN passed
to the next hook function, if any. The last (or \"outermost\")
FUN is then called once."
(declare (indent 2) (debug (form sexp body)))
@@ -1511,7 +1536,7 @@ if it is empty or a duplicate."
(or keep-all
(not (equal (car history) newelt))))
(if history-delete-duplicates
- (delete newelt history))
+ (setq history (delete newelt history)))
(setq history (cons newelt history))
(when (integerp maxelt)
(if (= 0 maxelt)
@@ -1539,10 +1564,12 @@ if it is empty or a duplicate."
(defun run-mode-hooks (&rest hooks)
"Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.
-Execution is delayed if the variable `delay-mode-hooks' is non-nil.
-Otherwise, runs the mode hooks and then `after-change-major-mode-hook'.
-Major mode functions should use this instead of `run-hooks' when running their
-FOO-mode-hook."
+If the variable `delay-mode-hooks' is non-nil, does not run any hooks,
+just adds the HOOKS to the list `delayed-mode-hooks'.
+Otherwise, runs hooks in the sequence: `change-major-mode-after-body-hook',
+`delayed-mode-hooks' (in reverse order), HOOKS, and finally
+`after-change-major-mode-hook'. Major mode functions should use
+this instead of `run-hooks' when running their FOO-mode-hook."
(if delay-mode-hooks
;; Delaying case.
(dolist (hook hooks)
@@ -1662,6 +1689,23 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label."
;;; Load history
+(defsubst autoloadp (object)
+ "Non-nil if OBJECT is an autoload."
+ (eq 'autoload (car-safe object)))
+
+;; (defun autoload-type (object)
+;; "Returns the type of OBJECT or `function' or `command' if the type is nil.
+;; OBJECT should be an autoload object."
+;; (when (autoloadp object)
+;; (let ((type (nth 3 object)))
+;; (cond ((null type) (if (nth 2 object) 'command 'function))
+;; ((eq 'keymap t) 'macro)
+;; (type)))))
+
+;; (defalias 'autoload-file #'cadr
+;; "Return the name of the file from which AUTOLOAD will be loaded.
+;; \n\(fn AUTOLOAD)")
+
(defun symbol-file (symbol &optional type)
"Return the name of the file that defined SYMBOL.
The value is normally an absolute file name. It can also be nil,
@@ -1674,7 +1718,7 @@ TYPE is `defun', `defvar', or `defface', that specifies function
definition, variable definition, or face definition only."
(if (and (or (null type) (eq type 'defun))
(symbolp symbol) (fboundp symbol)
- (eq 'autoload (car-safe (symbol-function symbol))))
+ (autoloadp (symbol-function symbol)))
(nth 1 (symbol-function symbol))
(let ((files load-history)
file)
@@ -1780,6 +1824,8 @@ this name matching.
Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
is evaluated at the end of any file that `provide's this feature.
+If the feature is provided when evaluating code not associated with a
+file, FORM is evaluated immediately after the provide statement.
Usually FILE is just a library name like \"font-lock\" or a feature name
like 'font-lock.
@@ -1809,14 +1855,16 @@ This function makes or adds to an entry on `after-load-alist'."
;; make sure that `form' is really run "after-load" in case the provide
;; call happens early.
(setq form
- `(when load-file-name
- (let ((fun (make-symbol "eval-after-load-helper")))
- (fset fun `(lambda (file)
- (if (not (equal file ',load-file-name))
- nil
- (remove-hook 'after-load-functions ',fun)
- ,',form)))
- (add-hook 'after-load-functions fun)))))
+ `(if load-file-name
+ (let ((fun (make-symbol "eval-after-load-helper")))
+ (fset fun `(lambda (file)
+ (if (not (equal file ',load-file-name))
+ nil
+ (remove-hook 'after-load-functions ',fun)
+ ,',form)))
+ (add-hook 'after-load-functions fun))
+ ;; Not being provided from a file, run form right now.
+ ,form)))
;; Add FORM to the element unless it's already there.
(unless (member form (cdr elt))
(nconc elt (purecopy (list form)))))))
@@ -1852,20 +1900,41 @@ 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'.
-This is the default value of `delayed-warnings-hook'."
+Used from `delayed-warnings-hook' (which see)."
(dolist (warning (nreverse delayed-warnings-list))
(apply 'display-warning warning))
(setq delayed-warnings-list nil))
-(defvar delayed-warnings-hook '(display-delayed-warnings)
- "Normal hook run to process delayed warnings.
-Functions in this hook should access the `delayed-warnings-list'
-variable (which see) and remove from it the warnings they process.")
+(defun collapse-delayed-warnings ()
+ "Remove duplicates from `delayed-warnings-list'.
+Collapse identical adjacent warnings into one (plus count).
+Used from `delayed-warnings-hook' (which see)."
+ (let ((count 1)
+ collapsed warning)
+ (while delayed-warnings-list
+ (setq warning (pop delayed-warnings-list))
+ (if (equal warning (car delayed-warnings-list))
+ (setq count (1+ count))
+ (when (> count 1)
+ (setcdr warning (cons (format "%s [%d times]" (cadr warning) count)
+ (cddr warning)))
+ (setq count 1))
+ (push warning collapsed)))
+ (setq delayed-warnings-list (nreverse collapsed))))
+
+;; At present this is only used for Emacs internals.
+;; Ref http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00085.html
+(defvar delayed-warnings-hook '(collapse-delayed-warnings
+ display-delayed-warnings)
+ "Normal hook run to process and display delayed warnings.
+By default, this hook contains functions to consolidate the
+warnings listed in `delayed-warnings-list', display them, and set
+`delayed-warnings-list' back to nil.")
;;;; Process stuff.
@@ -1937,7 +2006,7 @@ It can be retrieved with `(process-get PROCESS PROPNAME)'."
;;;; Input and display facilities.
(defvar read-quoted-char-radix 8
- "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
+ "Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
Legitimate radix values are 8, 10 and 16.")
(custom-declare-variable-early
@@ -1958,6 +2027,10 @@ obey the input decoding and translations usually done by `read-key-sequence'.
So escape sequences and keyboard encoding are taken into account.
When there's an ambiguity because the key looks like the prefix of
some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
+ ;; This overriding-terminal-local-map binding also happens to
+ ;; disable quail's input methods, so although read-key-sequence
+ ;; always inherits the input method, in practice read-key does not
+ ;; inherit the input method (at least not if it's based on quail).
(let ((overriding-terminal-local-map read-key-empty-map)
(overriding-local-map nil)
(echo-keystrokes 0)
@@ -1989,7 +2062,10 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
(let ((map (make-sparse-keymap)))
;; Don't hide the menu-bar and tool-bar entries.
(define-key map [menu-bar] (lookup-key global-map [menu-bar]))
- (define-key map [tool-bar] (lookup-key global-map [tool-bar]))
+ (define-key map [tool-bar]
+ ;; This hack avoids evaluating the :filter (Bug#9922).
+ (or (cdr (assq 'tool-bar global-map))
+ (lookup-key global-map [tool-bar])))
map))
(aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0))
(cancel-timer timer)
@@ -2055,6 +2131,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.
@@ -2062,100 +2147,79 @@ Optional DEFAULT is a default password to use instead of empty input.
This function echoes `.' for each character that the user types.
-The user ends with RET, LFD, or ESC. DEL or C-h rubs out.
-C-y yanks the current kill. C-u kills line.
-C-g quits; if `inhibit-quit' was non-nil around this function,
-then it returns nil if the user types C-g, but `quit-flag' remains set.
-
Once the caller uses the password, it can erase the password
by doing (clear-string STRING)."
- (with-local-quit
- (if confirm
- (let (success)
- (while (not success)
- (let ((first (read-passwd prompt nil default))
- (second (read-passwd "Confirm password: " nil default)))
- (if (equal first second)
- (progn
- (and (arrayp second) (clear-string second))
- (setq success first))
- (and (arrayp first) (clear-string first))
- (and (arrayp second) (clear-string second))
- (message "Password not repeated accurately; please start over")
- (sit-for 1))))
- success)
- (let ((pass nil)
- ;; Copy it so that add-text-properties won't modify
- ;; the object that was passed in by the caller.
- (prompt (copy-sequence prompt))
- (c 0)
- (echo-keystrokes 0)
- (cursor-in-echo-area t)
- (message-log-max nil)
- (stop-keys (list 'return ?\r ?\n ?\e))
- (rubout-keys (list 'backspace ?\b ?\177)))
- (add-text-properties 0 (length prompt)
- minibuffer-prompt-properties prompt)
- (while (progn (message "%s%s"
- prompt
- (make-string (length pass) ?.))
- (setq c (read-key))
- (not (memq c stop-keys)))
- (clear-this-command-keys)
- (cond ((memq c rubout-keys) ; rubout
- (when (> (length pass) 0)
- (let ((new-pass (substring pass 0 -1)))
- (and (arrayp pass) (clear-string pass))
- (setq pass new-pass))))
- ((eq c ?\C-g) (keyboard-quit))
- ((not (numberp c)))
- ((= c ?\C-u) ; kill line
- (and (arrayp pass) (clear-string pass))
- (setq pass ""))
- ((= c ?\C-y) ; yank
- (let* ((str (condition-case nil
- (current-kill 0)
- (error nil)))
- new-pass)
- (when str
- (setq new-pass
- (concat pass
- (substring-no-properties str)))
- (and (arrayp pass) (clear-string pass))
- (setq c ?\0)
- (setq pass new-pass))))
- ((characterp c) ; insert char
- (let* ((new-char (char-to-string c))
- (new-pass (concat pass new-char)))
- (and (arrayp pass) (clear-string pass))
- (clear-string new-char)
- (setq c ?\0)
- (setq pass new-pass)))))
- (message nil)
- (or pass default "")))))
+ (if confirm
+ (let (success)
+ (while (not success)
+ (let ((first (read-passwd prompt nil default))
+ (second (read-passwd "Confirm password: " nil default)))
+ (if (equal first second)
+ (progn
+ (and (arrayp second) (clear-string second))
+ (setq success first))
+ (and (arrayp first) (clear-string first))
+ (and (arrayp second) (clear-string second))
+ (message "Password not repeated accurately; please start over")
+ (sit-for 1))))
+ success)
+ (let ((hide-chars-fun
+ (lambda (beg end _len)
+ (clear-this-command-keys)
+ (setq beg (min end (max (minibuffer-prompt-end)
+ beg)))
+ (dotimes (i (- end beg))
+ (put-text-property (+ i beg) (+ 1 i beg)
+ 'display (string ?.)))))
+ minibuf)
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq minibuf (current-buffer))
+ ;; Turn off electricity.
+ (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))
+ (read-string prompt nil t default)) ; t = "no history"
+ (when (buffer-live-p minibuf)
+ (with-current-buffer minibuf
+ ;; Not sure why but it seems that there might be cases where the
+ ;; minibuffer is not always properly reset later on, so undo
+ ;; whatever we've done here (bug#11392).
+ (remove-hook 'after-change-functions hide-chars-fun 'local)
+ (kill-local-variable 'post-self-insert-hook)
+ ;; And of course, don't keep the sensitive data around.
+ (erase-buffer))))))))
;; This should be used by `call-interactively' for `n' specs.
(defun read-number (prompt &optional default)
"Read a numeric value in the minibuffer, prompting with PROMPT.
DEFAULT specifies a default value to return if the user just types RET.
The value of DEFAULT is inserted into PROMPT."
- (let ((n nil))
- (when default
+ (let ((n nil)
+ (default1 (if (consp default) (car default) default)))
+ (when default1
(setq prompt
(if (string-match "\\(\\):[ \t]*\\'" prompt)
- (replace-match (format " (default %s)" default) t t prompt 1)
+ (replace-match (format " (default %s)" default1) t t prompt 1)
(replace-regexp-in-string "[ \t]*\\'"
- (format " (default %s) " default)
+ (format " (default %s) " default1)
prompt t t))))
(while
(progn
- (let ((str (read-from-minibuffer prompt nil nil nil nil
- (and default
- (number-to-string default)))))
+ (let ((str (read-from-minibuffer
+ prompt nil nil nil nil
+ (when default
+ (if (consp default)
+ (mapcar 'number-to-string (delq nil default))
+ (number-to-string default))))))
(condition-case nil
(setq n (cond
- ((zerop (length str)) default)
- ((stringp str) (read str))))
+ ((zerop (length str)) default1)
+ ((stringp str) (string-to-number str))))
(error nil)))
(unless (numberp n)
(message "Please enter a number.")
@@ -2173,7 +2237,8 @@ keyboard-quit events while waiting for a valid input."
(error "Called `read-char-choice' without valid char choices"))
(let (char done show-help (helpbuf " *Char Help*"))
(let ((cursor-in-echo-area t)
- (executing-kbd-macro executing-kbd-macro))
+ (executing-kbd-macro executing-kbd-macro)
+ (esc-flag nil))
(save-window-excursion ; in case we call help-form-show
(while (not done)
(unless (get-text-property 0 'face prompt)
@@ -2197,8 +2262,12 @@ keyboard-quit events while waiting for a valid input."
;; there are no more events in the macro. Attempt to
;; get an event interactively.
(setq executing-kbd-macro nil))
- ((and (not inhibit-keyboard-quit) (eq char ?\C-g))
- (keyboard-quit))))))
+ ((not inhibit-keyboard-quit)
+ (cond
+ ((and (null esc-flag) (eq char ?\e))
+ (setq esc-flag t))
+ ((memq char '(?\C-g ?\e))
+ (keyboard-quit))))))))
;; Display the question with the answer. But without cursor-in-echo-area.
(message "%s%s" prompt (char-to-string char))
char))
@@ -2250,11 +2319,19 @@ floating point support."
PROMPT is the string to display to ask the question. It should
end in a space; `y-or-n-p' adds \"(y or n) \" to it.
-No confirmation of the answer is requested; a single character is enough.
-Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses
-the bindings in `query-replace-map'; see the documentation of that variable
-for more information. In this case, the useful bindings are `act', `skip',
-`recenter', and `quit'.\)
+No confirmation of the answer is requested; a single character is
+enough. SPC also means yes, and DEL means no.
+
+To be precise, this function translates user input into responses
+by consulting the bindings in `query-replace-map'; see the
+documentation of that variable for more information. In this
+case, the useful bindings are `act', `skip', `recenter',
+`scroll-up', `scroll-down', and `quit'.
+An `act' response means yes, and a `skip' response means no.
+A `quit' response means to invoke `keyboard-quit'.
+If the user enters `recenter', `scroll-up', or `scroll-down'
+responses, perform the requested window recentering or scrolling
+and ask again.
Under a windowing system a dialog box will be used if `last-nonmenu-event'
is nil and `use-dialog-box' is non-nil."
@@ -2286,25 +2363,39 @@ is nil and `use-dialog-box' is non-nil."
"" " ")
"(y or n) "))
(while
- (let* ((key
+ (let* ((scroll-actions '(recenter scroll-up scroll-down
+ scroll-other-window scroll-other-window-down))
+ (key
(let ((cursor-in-echo-area t))
(when minibuffer-auto-raise
(raise-frame (window-frame (minibuffer-window))))
- (read-key (propertize (if (eq answer 'recenter)
+ (read-key (propertize (if (memq answer scroll-actions)
prompt
(concat "Please answer y or n. "
prompt))
'face 'minibuffer-prompt)))))
(setq answer (lookup-key query-replace-map (vector key) t))
(cond
- ((memq answer '(skip act)) nil)
- ((eq answer 'recenter) (recenter) t)
- ((memq answer '(exit-prefix quit)) (signal 'quit nil) t)
- (t t)))
+ ((memq answer '(skip act)) nil)
+ ((eq answer 'recenter)
+ (recenter) t)
+ ((eq answer 'scroll-up)
+ (ignore-errors (scroll-up-command)) t)
+ ((eq answer 'scroll-down)
+ (ignore-errors (scroll-down-command)) t)
+ ((eq answer 'scroll-other-window)
+ (ignore-errors (scroll-other-window)) t)
+ ((eq answer 'scroll-other-window-down)
+ (ignore-errors (scroll-other-window-down)) t)
+ ((or (memq answer '(exit-prefix quit)) (eq key ?\e))
+ (signal 'quit nil) t)
+ (t t)))
(ding)
(discard-input))))
(let ((ret (eq answer 'act)))
(unless noninteractive
+ ;; FIXME this prints one too many spaces, since prompt
+ ;; already ends in a space. Eg "... (y or n) y".
(message "%s %s" prompt (if ret "y" "n")))
ret)))
@@ -2387,7 +2478,7 @@ to `accept-change-group' or `cancel-change-group'."
This finishes the change group by accepting its changes as final."
(dolist (elt handle)
(with-current-buffer (car elt)
- (if (eq elt t)
+ (if (eq (cdr elt) t)
(setq buffer-undo-list t)))))
(defun cancel-change-group (handle)
@@ -2424,7 +2515,8 @@ This finishes the change group by reverting all of its changes."
;;;; Display-related functions.
;; For compatibility.
-(defalias 'redraw-modeline 'force-mode-line-update)
+(define-obsolete-function-alias 'redraw-modeline
+ 'force-mode-line-update "24.3")
(defun force-mode-line-update (&optional all)
"Force redisplay of the current buffer's mode line and header line.
@@ -2555,13 +2647,17 @@ See also `locate-user-emacs-file'.")
(defun locate-user-emacs-file (new-name &optional old-name)
"Return an absolute per-user Emacs-specific file name.
-If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME.
+If NEW-NAME exists in `user-emacs-directory', return it.
+Else If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME.
Else return NEW-NAME in `user-emacs-directory', creating the
directory if it does not exist."
(convert-standard-filename
(let* ((home (concat "~" (or init-file-user "")))
- (at-home (and old-name (expand-file-name old-name home))))
- (if (and at-home (file-readable-p at-home))
+ (at-home (and old-name (expand-file-name old-name home)))
+ (bestname (abbreviate-file-name
+ (expand-file-name new-name user-emacs-directory))))
+ (if (and at-home (not (file-readable-p bestname))
+ (file-readable-p at-home))
at-home
;; Make sure `user-emacs-directory' exists,
;; unless we're in batch mode or dumping Emacs
@@ -2575,11 +2671,14 @@ directory if it does not exist."
(set-default-file-modes ?\700)
(make-directory user-emacs-directory))
(set-default-file-modes umask))))
- (abbreviate-file-name
- (expand-file-name new-name user-emacs-directory))))))
+ bestname))))
;;;; Misc. useful functions.
+(defsubst buffer-narrowed-p ()
+ "Return non-nil if the current buffer is narrowed."
+ (/= (- (point-max) (point-min)) (buffer-size)))
+
(defun find-tag-default ()
"Determine default tag to search for, based on text at point.
If there is no plausible default, return nil."
@@ -2702,6 +2801,12 @@ Otherwise, return nil."
Otherwise, return nil."
(and (memq object '(nil t)) t))
+(defun special-form-p (object)
+ "Non-nil if and only if OBJECT is a special form."
+ (if (and (symbolp object) (fboundp object))
+ (setq object (indirect-function object)))
+ (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
+
(defun field-at-pos (pos)
"Return the field at position POS, taking stickiness etc into account."
(let ((raw-field (get-char-property (field-beginning pos) 'field)))
@@ -2717,38 +2822,45 @@ computing the hash. If BINARY is non-nil, return a string in binary
form."
(secure-hash 'sha1 object start end binary))
+(defun function-get (f prop &optional autoload)
+ "Return the value of property PROP of function F.
+If AUTOLOAD is non-nil and F is autoloaded, try to autoload it
+in the hope that it will set PROP. If AUTOLOAD is `macro', only do it
+if it's an autoloaded macro."
+ (let ((val nil))
+ (while (and (symbolp f)
+ (null (setq val (get f prop)))
+ (fboundp f))
+ (let ((fundef (symbol-function f)))
+ (if (and autoload (autoloadp fundef)
+ (not (equal fundef
+ (autoload-do-load fundef f
+ (if (eq autoload 'macro)
+ 'macro)))))
+ nil ;Re-try `get' on the same `f'.
+ (setq f fundef))))
+ val))
;;;; Support for yanking and text properties.
+(defvar yank-handled-properties)
(defvar yank-excluded-properties)
(defun remove-yank-excluded-properties (start end)
- "Remove `yank-excluded-properties' between START and END positions.
-Replaces `category' properties with their defined properties."
+ "Process text properties between START and END, inserted for a `yank'.
+Perform the handling specified by `yank-handled-properties', then
+remove properties specified by `yank-excluded-properties'."
(let ((inhibit-read-only t))
- ;; Replace any `category' property with the properties it stands
- ;; for. This is to remove `mouse-face' properties that are placed
- ;; on categories in *Help* buffers' buttons. See
- ;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html
- ;; for the details.
- (unless (memq yank-excluded-properties '(t nil))
- (save-excursion
- (goto-char start)
- (while (< (point) end)
- (let ((cat (get-text-property (point) 'category))
- run-end)
- (setq run-end
- (next-single-property-change (point) 'category nil end))
- (when cat
- (let (run-end2 original)
- (remove-list-of-text-properties (point) run-end '(category))
- (while (< (point) run-end)
- (setq run-end2 (next-property-change (point) nil run-end))
- (setq original (text-properties-at (point)))
- (set-text-properties (point) run-end2 (symbol-plist cat))
- (add-text-properties (point) run-end2 original)
- (goto-char run-end2))))
- (goto-char run-end)))))
+ (dolist (handler yank-handled-properties)
+ (let ((prop (car handler))
+ (fun (cdr handler))
+ (run-start start))
+ (while (< run-start end)
+ (let ((value (get-text-property run-start prop))
+ (run-end (next-single-property-change
+ run-start prop nil end)))
+ (funcall fun value run-start run-end)
+ (setq run-start run-end)))))
(if (eq yank-excluded-properties t)
(set-text-properties start end nil)
(remove-list-of-text-properties start end yank-excluded-properties))))
@@ -2766,29 +2878,31 @@ See `insert-for-yank-1' for more details."
(insert-for-yank-1 string))
(defun insert-for-yank-1 (string)
- "Insert STRING at point, stripping some text properties.
-
-Strip text properties from the inserted text according to
-`yank-excluded-properties'. Otherwise just like (insert STRING).
-
-If STRING has a non-nil `yank-handler' property on the first character,
-the normal insert behavior is modified in various ways. The value of
-the yank-handler property must be a list with one to four elements
-with the following format: (FUNCTION PARAM NOEXCLUDE UNDO).
-When FUNCTION is present and non-nil, it is called instead of `insert'
- to insert the string. FUNCTION takes one argument--the object to insert.
-If PARAM is present and non-nil, it replaces STRING as the object
- passed to FUNCTION (or `insert'); for example, if FUNCTION is
- `yank-rectangle', PARAM may be a list of strings to insert as a
- rectangle.
-If NOEXCLUDE is present and non-nil, the normal removal of the
+ "Insert STRING at point for the `yank' command.
+This function is like `insert', except it honors the variables
+`yank-handled-properties' and `yank-excluded-properties', and the
+`yank-handler' text property.
+
+Properties listed in `yank-handled-properties' are processed,
+then those listed in `yank-excluded-properties' are discarded.
+
+If STRING has a non-nil `yank-handler' property on its first
+character, the normal insert behavior is altered. The value of
+the `yank-handler' property must be a list of one to four
+elements, of the form (FUNCTION PARAM NOEXCLUDE UNDO).
+FUNCTION, if non-nil, should be a function of one argument, an
+ object to insert; it is called instead of `insert'.
+PARAM, if present and non-nil, replaces STRING as the argument to
+ FUNCTION or `insert'; e.g. if FUNCTION is `yank-rectangle', PARAM
+ may be a list of strings to insert as a rectangle.
+If NOEXCLUDE is present and non-nil, the normal removal of
`yank-excluded-properties' is not performed; instead FUNCTION is
- responsible for removing those properties. This may be necessary
- if FUNCTION adjusts point before or after inserting the object.
-If UNDO is present and non-nil, it is a function that will be called
+ responsible for the removal. This may be necessary if FUNCTION
+ adjusts point before or after inserting the object.
+UNDO, if present and non-nil, should be a function to be called
by `yank-pop' to undo the insertion of the current object. It is
- called with two arguments, the start and end of the current region.
- FUNCTION may set `yank-undo-function' to override the UNDO value."
+ given two arguments, the start and end of the region. FUNCTION
+ may set `yank-undo-function' to override UNDO."
(let* ((handler (and (stringp string)
(get-text-property 0 'yank-handler string)))
(param (or (nth 1 handler) string))
@@ -2797,7 +2911,7 @@ If UNDO is present and non-nil, it is a function that will be called
end)
(setq yank-undo-function t)
- (if (nth 0 handler) ;; FUNCTION
+ (if (nth 0 handler) ; FUNCTION
(funcall (car handler) param)
(insert param))
(setq end (point))
@@ -2806,34 +2920,17 @@ If UNDO is present and non-nil, it is a function that will be called
;; following text property changes.
(setq inhibit-read-only t)
- ;; What should we do with `font-lock-face' properties?
- (if font-lock-defaults
- ;; No, just wipe them.
- (remove-list-of-text-properties opoint end '(font-lock-face))
- ;; Convert them to `face'.
- (save-excursion
- (goto-char opoint)
- (while (< (point) end)
- (let ((face (get-text-property (point) 'font-lock-face))
- run-end)
- (setq run-end
- (next-single-property-change (point) 'font-lock-face nil end))
- (when face
- (remove-text-properties (point) run-end '(font-lock-face nil))
- (put-text-property (point) run-end 'face face))
- (goto-char run-end)))))
-
- (unless (nth 2 handler) ;; NOEXCLUDE
- (remove-yank-excluded-properties opoint (point)))
+ (unless (nth 2 handler) ; NOEXCLUDE
+ (remove-yank-excluded-properties opoint end))
;; If last inserted char has properties, mark them as rear-nonsticky.
(if (and (> end opoint)
(text-properties-at (1- end)))
(put-text-property (1- end) end 'rear-nonsticky t))
- (if (eq yank-undo-function t) ;; not set by FUNCTION
- (setq yank-undo-function (nth 3 handler))) ;; UNDO
- (if (nth 4 handler) ;; COMMAND
+ (if (eq yank-undo-function t) ; not set by FUNCTION
+ (setq yank-undo-function (nth 3 handler))) ; UNDO
+ (if (nth 4 handler) ; COMMAND
(setq this-command (nth 4 handler)))))
(defun insert-buffer-substring-no-properties (buffer &optional start end)
@@ -2851,14 +2948,35 @@ They default to the values of (point-min) and (point-max) in BUFFER."
BUFFER may be a buffer or a buffer name.
Arguments START and END are character positions specifying the substring.
They default to the values of (point-min) and (point-max) in BUFFER.
-Strip text properties from the inserted text according to
-`yank-excluded-properties'."
+Before insertion, process text properties according to
+`yank-handled-properties' and `yank-excluded-properties'."
;; Since the buffer text should not normally have yank-handler properties,
;; there is no need to handle them here.
(let ((opoint (point)))
(insert-buffer-substring buffer start end)
(remove-yank-excluded-properties opoint (point))))
+(defun yank-handle-font-lock-face-property (face start end)
+ "If `font-lock-defaults' is nil, apply FACE as a `face' property.
+START and END denote the start and end of the text to act on.
+Do nothing if FACE is nil."
+ (and face
+ (null font-lock-defaults)
+ (put-text-property start end 'face face)))
+
+;; This removes `mouse-face' properties in *Help* buffer buttons:
+;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html
+(defun yank-handle-category-property (category start end)
+ "Apply property category CATEGORY's properties between START and END."
+ (when category
+ (let ((start2 start))
+ (while (< start2 end)
+ (let ((end2 (next-property-change start2 nil end))
+ (original (text-properties-at start2)))
+ (set-text-properties start2 end2 (symbol-plist category))
+ (add-text-properties start2 end2 original)
+ (setq start2 end2))))))
+
;;;; Synchronous shell commands.
@@ -2943,6 +3061,30 @@ also `with-temp-buffer'."
(set-buffer ,buffer-or-name)
,@body))
+(defun internal--before-with-selected-window (window)
+ (let ((other-frame (window-frame window)))
+ (list window (selected-window)
+ ;; Selecting a window on another frame also changes that
+ ;; frame's frame-selected-window. We must save&restore it.
+ (unless (eq (selected-frame) other-frame)
+ (frame-selected-window other-frame))
+ ;; Also remember the top-frame if on ttys.
+ (unless (eq (selected-frame) other-frame)
+ (tty-top-frame other-frame)))))
+
+(defun internal--after-with-selected-window (state)
+ ;; First reset frame-selected-window.
+ (when (window-live-p (nth 2 state))
+ ;; We don't use set-frame-selected-window because it does not
+ ;; pass the `norecord' argument to Fselect_window.
+ (select-window (nth 2 state) 'norecord)
+ (and (frame-live-p (nth 3 state))
+ (not (eq (tty-top-frame) (nth 3 state)))
+ (select-frame (nth 3 state) 'norecord)))
+ ;; Then reset the actual selected-window.
+ (when (window-live-p (nth 1 state))
+ (select-window (nth 1 state) 'norecord)))
+
(defmacro with-selected-window (window &rest body)
"Execute the forms in BODY with WINDOW as the selected window.
The value returned is the value of the last form in BODY.
@@ -2960,31 +3102,21 @@ current buffer, since otherwise its normal operation could
potentially make a different buffer current. It does not alter
the buffer list ordering."
(declare (indent 1) (debug t))
- ;; Most of this code is a copy of save-selected-window.
- `(let ((save-selected-window-window (selected-window))
- ;; It is necessary to save all of these, because calling
- ;; select-window changes frame-selected-window for whatever
- ;; frame that window is in.
- (save-selected-window-alist
- (mapcar (lambda (frame) (list frame (frame-selected-window frame)))
- (frame-list))))
+ `(let ((save-selected-window--state
+ (internal--before-with-selected-window ,window)))
(save-current-buffer
(unwind-protect
- (progn (select-window ,window 'norecord)
+ (progn (select-window (car save-selected-window--state) 'norecord)
,@body)
- (dolist (elt save-selected-window-alist)
- (and (frame-live-p (car elt))
- (window-live-p (cadr elt))
- (set-frame-selected-window (car elt) (cadr elt) 'norecord)))
- (when (window-live-p save-selected-window-window)
- (select-window save-selected-window-window 'norecord))))))
+ (internal--after-with-selected-window save-selected-window--state)))))
(defmacro with-selected-frame (frame &rest body)
"Execute the forms in BODY with FRAME as the selected frame.
The value returned is the value of the last form in BODY.
-This macro neither changes the order of recently selected windows
-nor the buffer list."
+This macro saves and restores the selected frame, and changes the
+order of neither the recently selected windows nor the buffers in
+the buffer list."
(declare (indent 1) (debug t))
(let ((old-frame (make-symbol "old-frame"))
(old-buffer (make-symbol "old-buffer")))
@@ -2999,13 +3131,12 @@ nor the buffer list."
(set-buffer ,old-buffer))))))
(defmacro save-window-excursion (&rest body)
- "Execute BODY, preserving window sizes and contents.
-Return the value of the last form in BODY.
-Restore which buffer appears in which window, where display starts,
-and the value of point and mark for each window.
-Also restore the choice of selected window.
-Also restore which buffer is current.
-Does not restore the value of point in current buffer.
+ "Execute BODY, then restore previous window configuration.
+This macro saves the window configuration on the selected frame,
+executes BODY, then calls `set-window-configuration' to restore
+the saved window configuration. The return value is the last
+form in BODY. The window configuration is also restored if BODY
+exits nonlocally.
BEWARE: Most uses of this macro introduce bugs.
E.g. it should not be used to try and prevent some code from opening
@@ -3017,6 +3148,46 @@ in which case `save-window-excursion' cannot help."
(unwind-protect (progn ,@body)
(set-window-configuration ,c)))))
+(defun internal-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)
+
+;; Doc is very similar to with-temp-buffer-window.
(defmacro with-output-to-temp-buffer (bufname &rest body)
"Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
@@ -3042,7 +3213,9 @@ with the buffer BUFNAME temporarily current. It runs the hook
`temp-buffer-show-hook' after displaying buffer BUFNAME, with that
buffer temporarily current, and the window that was used to display it
temporarily selected. But it doesn't run `temp-buffer-show-hook'
-if it uses `temp-buffer-show-function'."
+if it uses `temp-buffer-show-function'.
+
+See the related form `with-temp-buffer-window'."
(declare (debug t))
(let ((old-dir (make-symbol "old-dir"))
(buf (make-symbol "buf")))
@@ -3192,7 +3365,7 @@ If BODY finishes, `while-no-input' returns whatever value BODY produced."
(or (input-pending-p)
(progn ,@body)))))))
-(defmacro condition-case-no-debug (var bodyform &rest handlers)
+(defmacro condition-case-unless-debug (var bodyform &rest handlers)
"Like `condition-case' except that it does not catch anything when debugging.
More specifically if `debug-on-error' is set, then it does not catch any signal."
(declare (debug condition-case) (indent 2))
@@ -3204,6 +3377,9 @@ More specifically if `debug-on-error' is set, then it does not catch any signal.
(funcall ,bodysym)
,@handlers)))))
+(define-obsolete-function-alias 'condition-case-no-debug
+ 'condition-case-unless-debug "24.1")
+
(defmacro with-demoted-errors (&rest body)
"Run BODY and demote any errors to simple messages.
If `debug-on-error' is non-nil, run BODY without catching its errors.
@@ -3211,7 +3387,7 @@ This is to be used around code which is not expected to signal an error
but which should be robust in the unexpected case that an error is signaled."
(declare (debug t) (indent 0))
(let ((err (make-symbol "err")))
- `(condition-case-no-debug ,err
+ `(condition-case-unless-debug ,err
(progn ,@body)
(error (message "Error: %S" ,err) nil))))
@@ -3523,8 +3699,7 @@ of STRING.
To replace only the first match (if any), make REGEXP match up to \\'
and replace a sub-expression, e.g.
(replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1)
- => \" bar foo\"
-"
+ => \" bar foo\""
;; To avoid excessive consing from multiple matches in long strings,
;; don't just call `replace-match' continually. Walk down the
@@ -3633,7 +3808,7 @@ from `standard-syntax-table' otherwise."
table))
(defun syntax-after (pos)
- "Return the raw syntax of the char after POS.
+ "Return the raw syntax descriptor for the char after POS.
If POS is outside the buffer's accessible portion, return nil."
(unless (or (< pos (point-min)) (>= pos (point-max)))
(let ((st (if parse-sexp-lookup-properties
@@ -3642,7 +3817,12 @@ If POS is outside the buffer's accessible portion, return nil."
(aref (or st (syntax-table)) (char-after pos))))))
(defun syntax-class (syntax)
- "Return the syntax class part of the syntax descriptor SYNTAX.
+ "Return the code for the syntax class described by SYNTAX.
+
+SYNTAX should be a raw syntax descriptor; the return value is a
+integer which encodes the corresponding syntax class. See Info
+node `(elisp)Syntax Table Internals' for a list of codes.
+
If SYNTAX is nil, return nil."
(and syntax (logand (car syntax) 65535)))
@@ -3781,6 +3961,186 @@ The properties used on SYMBOL are `composefunc', `sendfunc',
(put symbol 'abortfunc (or abortfunc 'kill-buffer))
(put symbol 'hookvar (or hookvar 'mail-send-hook)))
+(defvar called-interactively-p-functions nil
+ "Special hook called to skip special frames in `called-interactively-p'.
+The functions are called with 3 arguments: (I FRAME1 FRAME2),
+where FRAME1 is a \"current frame\", FRAME2 is the next frame,
+I is the index of the frame after FRAME2. It should return nil
+if those frames don't seem special and otherwise, it should return
+the number of frames to skip (minus 1).")
+
+(defmacro internal--called-interactively-p--get-frame (n)
+ ;; `sym' will hold a global variable, which will be used kind of like C's
+ ;; "static" variables.
+ (let ((sym (make-symbol "base-index")))
+ `(progn
+ (defvar ,sym
+ (let ((i 1))
+ (while (not (eq (nth 1 (backtrace-frame i))
+ 'called-interactively-p))
+ (setq i (1+ i)))
+ i))
+ ;; (unless (eq (nth 1 (backtrace-frame ,sym)) 'called-interactively-p)
+ ;; (error "called-interactively-p: %s is out-of-sync!" ,sym))
+ (backtrace-frame (+ ,sym ,n)))))
+
+(defun called-interactively-p (&optional kind)
+ "Return t if the containing function was called by `call-interactively'.
+If KIND is `interactive', then only return t if the call was made
+interactively by the user, i.e. not in `noninteractive' mode nor
+when `executing-kbd-macro'.
+If KIND is `any', on the other hand, it will return t for any kind of
+interactive call, including being called as the binding of a key or
+from a keyboard macro, even in `noninteractive' mode.
+
+This function is very brittle, it may fail to return the intended result when
+the code is debugged, advised, or instrumented in some form. Some macros and
+special forms (such as `condition-case') may also sometimes wrap their bodies
+in a `lambda', so any call to `called-interactively-p' from those bodies will
+indicate whether that lambda (rather than the surrounding function) was called
+interactively.
+
+Instead of using this function, it is cleaner and more reliable to give your
+function an extra optional argument whose `interactive' spec specifies
+non-nil unconditionally (\"p\" is a good way to do this), or via
+\(not (or executing-kbd-macro noninteractive)).
+
+The only known proper use of `interactive' for KIND is in deciding
+whether to display a helpful message, or how to display it. If you're
+thinking of using it for any other purpose, it is quite likely that
+you're making a mistake. Think: what do you want to do when the
+command is called from a keyboard macro?"
+ (declare (advertised-calling-convention (kind) "23.1"))
+ (when (not (and (eq kind 'interactive)
+ (or executing-kbd-macro noninteractive)))
+ (let* ((i 1) ;; 0 is the called-interactively-p frame.
+ frame nextframe
+ (get-next-frame
+ (lambda ()
+ (setq frame nextframe)
+ (setq nextframe (internal--called-interactively-p--get-frame i))
+ ;; (message "Frame %d = %S" i nextframe)
+ (setq i (1+ i)))))
+ (funcall get-next-frame) ;; Get the first frame.
+ (while
+ ;; FIXME: The edebug and advice handling should be made modular and
+ ;; provided directly by edebug.el and nadvice.el.
+ (progn
+ ;; frame =(backtrace-frame i-2)
+ ;; nextframe=(backtrace-frame i-1)
+ (funcall get-next-frame)
+ ;; `pcase' would be a fairly good fit here, but it sometimes moves
+ ;; branches within local functions, which then messes up the
+ ;; `backtrace-frame' data we get,
+ (or
+ ;; Skip special forms (from non-compiled code).
+ (and frame (null (car frame)))
+ ;; Skip also `interactive-p' (because we don't want to know if
+ ;; interactive-p was called interactively but if it's caller was)
+ ;; and `byte-code' (idem; this appears in subexpressions of things
+ ;; like condition-case, which are wrapped in a separate bytecode
+ ;; chunk).
+ ;; FIXME: For lexical-binding code, this is much worse,
+ ;; because the frames look like "byte-code -> funcall -> #[...]",
+ ;; which is not a reliable signature.
+ (memq (nth 1 frame) '(interactive-p 'byte-code))
+ ;; Skip package-specific stack-frames.
+ (let ((skip (run-hook-with-args-until-success
+ 'called-interactively-p-functions
+ i frame nextframe)))
+ (pcase skip
+ (`nil nil)
+ (`0 t)
+ (_ (setq i (+ i skip -1)) (funcall get-next-frame)))))))
+ ;; Now `frame' should be "the function from which we were called".
+ (pcase (cons frame nextframe)
+ ;; No subr calls `interactive-p', so we can rule that out.
+ (`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil)
+ ;; Somehow, I sometimes got `command-execute' rather than
+ ;; `call-interactively' on my stacktrace !?
+ ;;(`(,_ . (t command-execute . ,_)) t)
+ (`(,_ . (t call-interactively . ,_)) t)))))
+
+(defun interactive-p ()
+ "Return t if the containing function was run directly by user input.
+This means that the function was called with `call-interactively'
+\(which includes being called as the binding of a key)
+and input is currently coming from the keyboard (not a keyboard macro),
+and Emacs is not running in batch mode (`noninteractive' is nil).
+
+The only known proper use of `interactive-p' is in deciding whether to
+display a helpful message, or how to display it. If you're thinking
+of using it for any other purpose, it is quite likely that you're
+making a mistake. Think: what do you want to do when the command is
+called from a keyboard macro or in batch mode?
+
+To test whether your function was called with `call-interactively',
+either (i) add an extra optional argument and give it an `interactive'
+spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
+use `called-interactively-p'."
+ (declare (obsolete called-interactively-p "23.2"))
+ (called-interactively-p 'interactive))
+
+(defun function-arity (f &optional num)
+ "Return the (MIN . MAX) arity of F.
+If the maximum arity is infinite, MAX is `many'.
+F can be a function or a macro.
+If NUM is non-nil, return non-nil iff F can be called with NUM args."
+ (if (symbolp f) (setq f (indirect-function f)))
+ (if (eq (car-safe f) 'macro) (setq f (cdr f)))
+ (let ((res
+ (if (subrp f)
+ (let ((x (subr-arity f)))
+ (if (eq (cdr x) 'unevalled) (cons (car x) 'many)))
+ (let* ((args (if (consp f) (cadr f) (aref f 0)))
+ (max (length args))
+ (opt (memq '&optional args))
+ (rest (memq '&rest args))
+ (min (- max (length opt))))
+ (if opt
+ (cons min (if rest 'many (1- max)))
+ (if rest
+ (cons (- max (length rest)) 'many)
+ (cons min max)))))))
+ (if (not num)
+ res
+ (and (>= num (car res))
+ (or (eq 'many (cdr res)) (<= num (cdr res)))))))
+
+(defun set-temporary-overlay-map (map &optional keep-pred)
+ "Set MAP as a temporary keymap taking precedence over most other keymaps.
+Note that this does NOT take precedence over the \"overriding\" maps
+`overriding-terminal-local-map' and `overriding-local-map' (or the
+`keymap' text property). Unlike those maps, if no match for a key is
+found in MAP, the normal key lookup sequence then continues.
+
+Normally, MAP is used only once. If the optional argument
+KEEP-PRED is t, MAP stays active if a key from MAP is used.
+KEEP-PRED can also be a function of no arguments: if it returns
+non-nil then MAP stays active."
+ (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
+ (overlaysym (make-symbol "t"))
+ (alist (list (cons overlaysym map)))
+ (clearfun
+ ;; FIXME: Use lexical-binding.
+ `(lambda ()
+ (unless ,(cond ((null keep-pred) nil)
+ ((eq t keep-pred)
+ `(eq this-command
+ (lookup-key ',map
+ (this-command-keys-vector))))
+ (t `(funcall ',keep-pred)))
+ (set ',overlaysym nil) ;Just in case.
+ (remove-hook 'pre-command-hook ',clearfunsym)
+ (setq emulation-mode-map-alists
+ (delq ',alist emulation-mode-map-alists))))))
+ (set overlaysym overlaysym)
+ (fset clearfunsym clearfun)
+ (add-hook 'pre-command-hook clearfunsym)
+ ;; FIXME: That's the keymaps with highest precedence, except for
+ ;; the `keymap' text-property ;-(
+ (push alist emulation-mode-map-alists)))
+
;;;; Progress reporters.
;; Progress reporter has the following structure:
diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el
index 78857b04143..e0fbe8c3bdb 100644
--- a/lisp/t-mouse.el
+++ b/lisp/t-mouse.el
@@ -4,7 +4,7 @@
;; Maintainer: FSF
;; Keywords: mouse gpm linux
-;; Copyright (C) 1994-1995, 1998, 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1998, 2006-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/lisp/tabify.el b/lisp/tabify.el
index 0b2411d0316..26762acf4b7 100644
--- a/lisp/tabify.el
+++ b/lisp/tabify.el
@@ -1,6 +1,6 @@
;;; tabify.el --- tab conversion commands for Emacs
-;; Copyright (C) 1985, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Package: emacs
diff --git a/lisp/talk.el b/lisp/talk.el
index 98c7f6d31ca..70a3376d8e8 100644
--- a/lisp/talk.el
+++ b/lisp/talk.el
@@ -1,6 +1,6 @@
;;; talk.el --- allow several users to talk to each other through Emacs
-;; Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: comm, frames
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index ff528fcc9df..2622a8215b8 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -1,6 +1,6 @@
;;; tar-mode.el --- simple editing of tar files from GNU Emacs
-;; Copyright (C) 1990-1991, 1993-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1991, 1993-2012 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Maintainer: FSF
@@ -97,7 +97,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup tar nil
"Simple editing of tar files."
@@ -168,7 +168,7 @@ This information is useful, but it takes screen space away from file names."
;; state correctly: the raw data is expected to be always larger than
;; the summary.
(progn
- (assert (or (= (buffer-size tar-data-buffer) (buffer-size))
+ (cl-assert (or (= (buffer-size tar-data-buffer) (buffer-size))
(eq tar-data-swapped
(> (buffer-size tar-data-buffer) (buffer-size)))))
tar-data-swapped)))
@@ -186,7 +186,7 @@ Preserve the modified states of the buffers and set `buffer-swapped-with'."
;;; down to business.
-(defstruct (tar-header
+(cl-defstruct (tar-header
(:constructor nil)
(:type vector)
:named
@@ -226,8 +226,8 @@ Preserve the modified states of the buffers and set `buffer-swapped-with'."
This is a list of name, mode, uid, gid, size,
write-date, checksum, link-type, and link-name."
(if (> (+ pos 512) (point-max)) (error "Malformed Tar header"))
- (assert (zerop (mod (- pos (point-min)) 512)))
- (assert (not enable-multibyte-characters))
+ (cl-assert (zerop (mod (- pos (point-min)) 512)))
+ (cl-assert (not enable-multibyte-characters))
(let ((string (buffer-substring pos (setq pos (+ pos 512)))))
(when ;(some 'plusp string) ; <-- oops, massive cycle hog!
(or (not (= 0 (aref string 0))) ; This will do.
@@ -325,13 +325,10 @@ write-date, checksum, link-type, and link-name."
(defun tar-header-data-end (descriptor)
(let* ((data-start (tar-header-data-start descriptor))
(link-type (tar-header-link-type descriptor))
- (size (tar-header-size descriptor))
- (fudge (cond
- ;; Foo. There's an extra empty block after these.
- ((memq link-type '(20 55)) 512)
- (t 0))))
- (+ data-start fudge
- (if (and (null link-type) (> size 0))
+ (size (tar-header-size descriptor)))
+ (+ data-start
+ ;; Ignore size for files of type 1-6
+ (if (and (not (memq link-type '(1 2 3 4 5 6))) (> size 0))
(tar-roundup-512 size)
0))))
@@ -373,7 +370,7 @@ write-date, checksum, link-type, and link-name."
(defun tar-header-block-checksum (string)
"Compute and return a tar-acceptable checksum for this block."
- (assert (not (multibyte-string-p string)))
+ (cl-assert (not (multibyte-string-p string)))
(let* ((chk-field-start tar-chk-offset)
(chk-field-end (+ chk-field-start 8))
(sum 0)
@@ -396,7 +393,7 @@ write-date, checksum, link-type, and link-name."
(defun tar-clip-time-string (time)
(let ((str (current-time-string time)))
- (concat " " (substring str 4 16) (substring str 19 24))))
+ (concat " " (substring str 4 16) (format-time-string " %Y" time))))
(defun tar-grind-file-mode (mode)
"Construct a `-rw--r--r--' string indicating MODE.
@@ -445,7 +442,8 @@ MODE should be an integer which is a file mode value."
((eq type 29) ?M) ; multivolume continuation
((eq type 35) ?S) ; sparse
((eq type 38) ?V) ; volume header
- ((eq type 55) ?H) ; extended pax header
+ ((eq type 55) ?H) ; pax global extended header
+ ((eq type 72) ?X) ; pax extended header
(t ?\s)
)
(tar-grind-file-mode mode)
@@ -486,7 +484,7 @@ MODE should be an integer which is a file mode value."
(defun tar-summarize-buffer ()
"Parse the contents of the tar file in the current buffer."
- (assert (tar-data-swapped-p))
+ (cl-assert (tar-data-swapped-p))
(let* ((modified (buffer-modified-p))
(result '())
(pos (point-min))
@@ -520,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)))
@@ -549,6 +548,7 @@ MODE should be an integer which is a file mode value."
(define-key map "R" 'tar-rename-entry)
(define-key map "u" 'tar-unflag)
(define-key map "v" 'tar-view)
+ (define-key map "w" 'woman-tar-extract-file)
(define-key map "x" 'tar-expunge)
(define-key map "\177" 'tar-unflag-backwards)
(define-key map "E" 'tar-extract-other-window)
@@ -566,6 +566,8 @@ MODE should be an integer which is a file mode value."
(define-key map [menu-bar immediate]
(cons "Immediate" (make-sparse-keymap "Immediate")))
+ (define-key map [menu-bar immediate woman]
+ '("Read Man Page (WoMan)" . woman-tar-extract-file))
(define-key map [menu-bar immediate view]
'("View This File" . tar-view))
(define-key map [menu-bar immediate display]
@@ -634,6 +636,9 @@ inside of a tar archive without extracting it and re-archiving it.
See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
\\{tar-mode-map}"
+ (and buffer-file-name
+ (file-writable-p buffer-file-name)
+ (setq buffer-read-only nil)) ; undo what `special-mode' did
(make-local-variable 'tar-parse-info)
(set (make-local-variable 'require-final-newline) nil) ; binary data, dude...
(set (make-local-variable 'local-enable-local-variables) nil)
@@ -648,7 +653,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
(widen)
;; Now move the Tar data into an auxiliary buffer, so we can use the main
;; buffer for the summary.
- (assert (not (tar-data-swapped-p)))
+ (cl-assert (not (tar-data-swapped-p)))
(set (make-local-variable 'revert-buffer-function) 'tar-mode-revert)
;; We started using write-contents-functions, but this hook is not
;; used during auto-save, so we now use
@@ -674,12 +679,17 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
(fundamental-mode)
(signal (car err) (cdr err)))))
+(autoload 'woman-tar-extract-file "woman"
+ "In tar mode, run the WoMan man-page browser on this file." t)
(define-minor-mode tar-subfile-mode
"Minor mode for editing an element of a tar-file.
-This mode arranges for \"saving\" this buffer to write the data
-into the tar-file buffer that it came from. The changes will actually
-appear on disk when you save the tar-file's buffer."
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil. This mode arranges for \"saving\" this
+buffer to write the data into the tar-file buffer that it came
+from. The changes will actually appear on disk when you save the
+tar-file's buffer."
;; Don't do this, because it is redundant and wastes mode line space.
;; :lighter " TarFile"
nil nil nil
@@ -740,7 +750,8 @@ appear on disk when you save the tar-file's buffer."
((eq link-p 29) "a multivolume-continuation")
((eq link-p 35) "a sparse entry")
((eq link-p 38) "a volume header")
- ((eq link-p 55) "an extended pax header")
+ ((eq link-p 55) "a pax global extended header")
+ ((eq link-p 72) "a pax extended header")
(t "a link"))))
(if (zerop size) (message "This is a zero-length file"))
descriptor))
@@ -1108,15 +1119,15 @@ for this to be permanent."
(insert (tar-header-block-summarize descriptor) "\n")))
(forward-line -1) (move-to-column col))
- (assert (tar-data-swapped-p))
+ (cl-assert (tar-data-swapped-p))
(with-current-buffer tar-data-buffer
(let* ((start (- (tar-header-data-start descriptor) 512)))
;;
;; delete the old field and insert a new one.
(goto-char (+ start data-position))
(delete-region (point) (+ (point) (length new-data-string))) ; <--
- (assert (not (or enable-multibyte-characters
- (multibyte-string-p new-data-string))))
+ (cl-assert (not (or enable-multibyte-characters
+ (multibyte-string-p new-data-string))))
(insert new-data-string)
;;
;; compute a new checksum and insert it.
diff --git a/lisp/tempo.el b/lisp/tempo.el
index 9b997f3387c..e279314540f 100644
--- a/lisp/tempo.el
+++ b/lisp/tempo.el
@@ -1,6 +1,6 @@
;;; tempo.el --- Flexible template insertion
-;; Copyright (C) 1994-1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2012 Free Software Foundation, Inc.
;; Author: David K}gedal <davidk@lysator.liu.se>
;; Created: 16 Feb 1994
diff --git a/lisp/term.el b/lisp/term.el
index 47cda9beeed..a7c50d65562 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -1,6 +1,6 @@
;;; term.el --- general command interpreter in a window stuff
-;; Copyright (C) 1988, 1990, 1992, 1994-1995, 2001-2011
+;; Copyright (C) 1988, 1990, 1992, 1994-1995, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Per Bothner <per@bothner.com>
@@ -108,11 +108,6 @@
;;
;; Blink, is not supported. Currently it's mapped as bold.
;;
-;; Important caveat:
-;; -----------------
-;; if you want custom colors in term.el redefine term-default-fg-color
-;; and term-default-bg-color BEFORE loading it.
-;;
;; ----------------------------------------
;;
;; If you'd like to check out my complete configuration, you can download
@@ -398,12 +393,16 @@
;; so it is important to increase it if there are protocol-relevant changes.
(defconst term-protocol-version "0.96")
-(eval-when-compile
- (require 'ange-ftp)
- (require 'cl))
+(eval-when-compile (require 'ange-ftp))
(require 'ring)
(require 'ehelp)
+(declare-function ring-empty-p "ring" (ring))
+(declare-function ring-ref "ring" (ring index))
+(declare-function ring-insert-at-beginning "ring" (ring item))
+(declare-function ring-length "ring" (ring))
+(declare-function ring-insert "ring" (ring item))
+
(defgroup term nil
"General command interpreter in a window."
:group 'processes)
@@ -459,7 +458,7 @@ state 4: term-terminal-parameter contains pending output.")
"A queue of strings whose echo we want suppressed.")
(defvar term-terminal-parameter)
(defvar term-terminal-previous-parameter)
-(defvar term-current-face 'default)
+(defvar term-current-face 'term)
(defvar term-scroll-start 0 "Top-most line (inclusive) of scrolling region.")
(defvar term-scroll-end) ; Number of line (zero-based) after scrolling region.
(defvar term-pager-count nil
@@ -652,31 +651,61 @@ executed once when the buffer is created."
(define-key map "\C-c\C-k" 'term-char-mode)
(define-key map "\C-c\C-j" 'term-line-mode)
(define-key map "\C-c\C-q" 'term-pager-toggle)
+ ;; completion: (line mode only)
+ (easy-menu-define nil map "Complete menu for Term mode."
+ '("Complete"
+ ["Complete Before Point" term-dynamic-complete t]
+ ["Complete File Name" term-dynamic-complete-filename t]
+ ["File Completion Listing" term-dynamic-list-filename-completions t]
+ ["Expand File Name" term-replace-by-expanded-filename t]))
+ ;; Input history: (line mode only)
+ (easy-menu-define nil map "In/Out menu for Term mode."
+ '("In/Out"
+ ["Expand History Before Point" term-replace-by-expanded-history
+ term-input-autoexpand]
+ ["List Input History" term-dynamic-list-input-ring t]
+ ["Previous Input" term-previous-input t]
+ ["Next Input" term-next-input t]
+ ["Previous Matching Current Input"
+ term-previous-matching-input-from-input t]
+ ["Next Matching Current Input" term-next-matching-input-from-input t]
+ ["Previous Matching Input..." term-previous-matching-input t]
+ ["Next Matching Input..." term-next-matching-input t]
+ ["Backward Matching Input..." term-backward-matching-input t]
+ ["Forward Matching Input..." term-forward-matching-input t]
+ ["Copy Old Input" term-copy-old-input t]
+ ["Kill Current Input" term-kill-input t]
+ ["Show Current Output Group" term-show-output t]
+ ["Show Maximum Output" term-show-maximum-output t]
+ ["Backward Output Group" term-previous-prompt t]
+ ["Forward Output Group" term-next-prompt t]
+ ["Kill Current Output Group" term-kill-output t]))
+ map)
+ "Keymap for Term mode.")
- ;; ;; completion:
- ;; (define-key map [menu-bar completion]
- ;; (cons "Complete" (make-sparse-keymap "Complete")))
- ;; (define-key map [menu-bar completion complete-expand]
- ;; '("Expand File Name" . term-replace-by-expanded-filename))
- ;; (define-key map [menu-bar completion complete-listing]
- ;; '("File Completion Listing" . term-dynamic-list-filename-completions))
- ;; (define-key map [menu-bar completion complete-file]
- ;; '("Complete File Name" . term-dynamic-complete-filename))
- ;; (define-key map [menu-bar completion complete]
- ;; '("Complete Before Point" . term-dynamic-complete))
- ;; ;; Put them in the menu bar:
- ;; (setq menu-bar-final-items (append '(terminal completion inout signals)
- ;; menu-bar-final-items))
- map))
-
-(defvar term-raw-map nil
- "Keyboard map for sending characters directly to the inferior process.")
(defvar term-escape-char nil
"Escape character for char sub-mode of term mode.
Do not change it directly; use `term-set-escape-char' instead.")
-(defvar term-raw-escape-map nil)
-(defvar term-pager-break-map nil)
+(defvar term-pager-break-map
+ (let ((map (make-keymap)))
+ ;; (dotimes (i 128)
+ ;; (define-key map (make-string 1 i) 'term-send-raw))
+ (define-key map "\e" (lookup-key (current-global-map) "\e"))
+ (define-key map "\C-x" (lookup-key (current-global-map) "\C-x"))
+ (define-key map "\C-u" (lookup-key (current-global-map) "\C-u"))
+ (define-key map " " 'term-pager-page)
+ (define-key map "\r" 'term-pager-line)
+ (define-key map "?" 'term-pager-help)
+ (define-key map "h" 'term-pager-help)
+ (define-key map "b" 'term-pager-back-page)
+ (define-key map "\177" 'term-pager-back-line)
+ (define-key map "q" 'term-pager-discard)
+ (define-key map "D" 'term-pager-disable)
+ (define-key map "<" 'term-pager-bob)
+ (define-key map ">" 'term-pager-eob)
+ map)
+ "Keymap used in Term pager mode.")
(defvar term-ptyp t
"True if communications via pty; false if by pipe. Buffer local.
@@ -697,7 +726,6 @@ Buffer local variable.")
; assuming this is Emacs 19.20 or newer.
(defvar term-pager-filter t)
-(put 'term-replace-by-expanded-history 'menu-enable 'term-input-autoexpand)
(put 'term-input-ring 'permanent-local t)
(put 'term-input-ring-index 'permanent-local t)
(put 'term-input-autoexpand 'permanent-local t)
@@ -713,9 +741,6 @@ Buffer local variable.")
(defmacro term-handling-pager () 'term-pager-old-local-map)
(defmacro term-using-alternate-sub-buffer () 'term-saved-home-marker)
-(defvar term-signals-menu)
-(defvar term-terminal-menu)
-
;; Let's silence the byte-compiler -mm
(defvar term-ansi-at-host nil)
(defvar term-ansi-at-dir nil)
@@ -738,28 +763,89 @@ Buffer local variable.")
(defvar term-terminal-previous-parameter-3 -1)
(defvar term-terminal-previous-parameter-4 -1)
-;;; faces -mm
-
-(defcustom term-default-fg-color
- ;; FIXME: This depends on the current frame, so depending on when
- ;; it's loaded, the result may be different.
- (face-foreground term-current-face)
- "Default color for foreground in `term'."
+;;; Faces
+(defvar ansi-term-color-vector
+ [term
+ term-color-black
+ term-color-red
+ term-color-green
+ term-color-yellow
+ term-color-blue
+ term-color-magenta
+ term-color-cyan
+ term-color-white])
+
+(defcustom term-default-fg-color nil
+ "If non-nil, default color for foreground in Term mode."
:group 'term
:type 'string)
+(make-obsolete-variable 'term-default-fg-color "use the face `term' instead."
+ "24.3")
-(defcustom term-default-bg-color
- ;; FIXME: This depends on the current frame, so depending on when
- ;; it's loaded, the result may be different.
- (face-background term-current-face)
- "Default color for background in `term'."
+(defcustom term-default-bg-color nil
+ "If non-nil, default color for foreground in Term mode."
:group 'term
:type 'string)
+(make-obsolete-variable 'term-default-bg-color "use the face `term' instead."
+ "24.3")
+
+(defface term
+ `((t
+ :foreground ,term-default-fg-color
+ :background ,term-default-bg-color
+ :inherit default))
+ "Default face to use in Term mode."
+ :group 'term)
-;; Use the same colors that xterm uses, see `xterm-standard-colors'.
-(defvar ansi-term-color-vector
- [unspecified "black" "red3" "green3" "yellow3" "blue2"
- "magenta3" "cyan3" "white"])
+(defface term-bold
+ '((t :bold t))
+ "Default face to use for bold text."
+ :group 'term)
+
+(defface term-underline
+ '((t :underline t))
+ "Default face to use for underlined text."
+ :group 'term)
+
+(defface term-color-black
+ '((t :foreground "black" :background "black"))
+ "Face used to render black color code."
+ :group 'term)
+
+(defface term-color-red
+ '((t :foreground "red3" :background "red3"))
+ "Face used to render red color code."
+ :group 'term)
+
+(defface term-color-green
+ '((t :foreground "green3" :background "green3"))
+ "Face used to render green color code."
+ :group 'term)
+
+(defface term-color-yellow
+ '((t :foreground "yellow3" :background "yellow3"))
+ "Face used to render yellow color code."
+ :group 'term)
+
+(defface term-color-blue
+ '((t :foreground "blue2" :background "blue2"))
+ "Face used to render blue color code."
+ :group 'term)
+
+(defface term-color-magenta
+ '((t :foreground "magenta3" :background "magenta3"))
+ "Face used to render magenta color code."
+ :group 'term)
+
+(defface term-color-cyan
+ '((t :foreground "cyan3" :background "cyan3"))
+ "Face used to render cyan color code."
+ :group 'term)
+
+(defface term-color-white
+ '((t :foreground "white" :background "white"))
+ "Face used to render white color code."
+ :group 'term)
;; Inspiration came from comint.el -mm
(defcustom term-buffer-maximum-size 2048
@@ -770,179 +856,120 @@ is buffer-local."
:group 'term
:type 'integer)
-(when (featurep 'xemacs)
- (defvar term-terminal-menu
- '("Terminal"
- [ "Character mode" term-char-mode (term-in-line-mode)]
- [ "Line mode" term-line-mode (term-in-char-mode)]
- [ "Enable paging" term-pager-toggle (not term-pager-count)]
- [ "Disable paging" term-pager-toggle term-pager-count])))
-
-;; Menu bars:
-(unless (featurep 'xemacs)
- ;; terminal:
- (let (newmap)
- (setq newmap (make-sparse-keymap "Terminal"))
- (define-key newmap [terminal-pager-enable]
- '(menu-item "Enable paging" term-fake-pager-enable
- :help "Enable paging feature"))
- (define-key newmap [terminal-pager-disable]
- '(menu-item "Disable paging" term-fake-pager-disable
- :help "Disable paging feature"))
- (define-key newmap [terminal-char-mode]
- '(menu-item "Character mode" term-char-mode
- :help "Switch to char (raw) sub-mode of term mode"))
- (define-key newmap [terminal-line-mode]
- '(menu-item "Line mode" term-line-mode
- :help "Switch to line (cooked) sub-mode of term mode"))
- (setq term-terminal-menu (cons "Terminal" newmap))
-
- ;; completion: (line mode only)
- (defvar term-completion-menu (make-sparse-keymap "Complete"))
- (define-key term-mode-map [menu-bar completion]
- (cons "Complete" term-completion-menu))
- (define-key term-completion-menu [complete-expand]
- '("Expand File Name" . term-replace-by-expanded-filename))
- (define-key term-completion-menu [complete-listing]
- '("File Completion Listing" . term-dynamic-list-filename-completions))
- (define-key term-completion-menu [menu-bar completion complete-file]
- '("Complete File Name" . term-dynamic-complete-filename))
- (define-key term-completion-menu [menu-bar completion complete]
- '("Complete Before Point" . term-dynamic-complete))
-
- ;; Input history: (line mode only)
- (defvar term-inout-menu (make-sparse-keymap "In/Out"))
- (define-key term-mode-map [menu-bar inout]
- (cons "In/Out" term-inout-menu))
- (define-key term-inout-menu [kill-output]
- '("Kill Current Output Group" . term-kill-output))
- (define-key term-inout-menu [next-prompt]
- '("Forward Output Group" . term-next-prompt))
- (define-key term-inout-menu [previous-prompt]
- '("Backward Output Group" . term-previous-prompt))
- (define-key term-inout-menu [show-maximum-output]
- '("Show Maximum Output" . term-show-maximum-output))
- (define-key term-inout-menu [show-output]
- '("Show Current Output Group" . term-show-output))
- (define-key term-inout-menu [kill-input]
- '("Kill Current Input" . term-kill-input))
- (define-key term-inout-menu [copy-input]
- '("Copy Old Input" . term-copy-old-input))
- (define-key term-inout-menu [forward-matching-history]
- '("Forward Matching Input..." . term-forward-matching-input))
- (define-key term-inout-menu [backward-matching-history]
- '("Backward Matching Input..." . term-backward-matching-input))
- (define-key term-inout-menu [next-matching-history]
- '("Next Matching Input..." . term-next-matching-input))
- (define-key term-inout-menu [previous-matching-history]
- '("Previous Matching Input..." . term-previous-matching-input))
- (define-key term-inout-menu [next-matching-history-from-input]
- '("Next Matching Current Input" . term-next-matching-input-from-input))
- (define-key term-inout-menu [previous-matching-history-from-input]
- '("Previous Matching Current Input" .
- term-previous-matching-input-from-input))
- (define-key term-inout-menu [next-history]
- '("Next Input" . term-next-input))
- (define-key term-inout-menu [previous-history]
- '("Previous Input" . term-previous-input))
- (define-key term-inout-menu [list-history]
- '("List Input History" . term-dynamic-list-input-ring))
- (define-key term-inout-menu [expand-history]
- '("Expand History Before Point" . term-replace-by-expanded-history))
-
- ;; Signals
- (setq newmap (make-sparse-keymap "Signals"))
- (define-key term-mode-map [menu-bar signals]
- (setq term-signals-menu (cons "Signals" newmap)))
- (define-key newmap [eof]
- '(menu-item "EOF" term-send-eof
- :help "Send an EOF to the current buffer's process"))
- (define-key newmap [kill]
- '(menu-item "KILL" term-kill-subjob
- :help "Send kill signal to the current subjob"))
- (define-key newmap [quit]
- '(menu-item "QUIT" term-quit-subjob
- :help "Send quit signal to the current subjob."))
- (define-key newmap [cont]
- '(menu-item "CONT" term-continue-subjob
- :help "Send CONT signal to process buffer's process group"))
- (define-key newmap [stop]
- '(menu-item "STOP" term-stop-subjob
- :help "Stop the current subjob"))
- (define-key newmap [brk]
- '(menu-item "BREAK" term-interrupt-subjob
- :help "Interrupt the current subjob"))
- ))
-
;; Set up term-raw-map, etc.
-(defun term-set-escape-char (c)
+(defvar term-raw-map
+ (let* ((map (make-keymap))
+ (esc-map (make-keymap))
+ (i 0))
+ (while (< i 128)
+ (define-key map (make-string 1 i) 'term-send-raw)
+ ;; Avoid O and [. They are used in escape sequences for various keys.
+ (unless (or (eq i ?O) (eq i 91))
+ (define-key esc-map (make-string 1 i) 'term-send-raw-meta))
+ (setq i (1+ i)))
+ (define-key map [remap self-insert-command] 'term-send-raw)
+ (define-key map "\e" esc-map)
+
+ ;; Added nearly all the 'gray keys' -mm
+
+ (if (featurep 'xemacs)
+ (define-key map [button2] 'term-mouse-paste)
+ (define-key map [mouse-2] 'term-mouse-paste))
+ (define-key map [up] 'term-send-up)
+ (define-key map [down] 'term-send-down)
+ (define-key map [right] 'term-send-right)
+ (define-key map [left] 'term-send-left)
+ (define-key map [delete] 'term-send-del)
+ (define-key map [deletechar] 'term-send-del)
+ (define-key map [backspace] 'term-send-backspace)
+ (define-key map [home] 'term-send-home)
+ (define-key map [end] 'term-send-end)
+ (define-key map [insert] 'term-send-insert)
+ (define-key map [S-prior] 'scroll-down)
+ (define-key map [S-next] 'scroll-up)
+ (define-key map [S-insert] 'term-paste)
+ (define-key map [prior] 'term-send-prior)
+ (define-key map [next] 'term-send-next)
+ map)
+ "Keyboard map for sending characters directly to the inferior process.")
+
+(easy-menu-define term-terminal-menu
+ (list term-mode-map term-raw-map term-pager-break-map)
+ "Terminal menu for Term mode."
+ '("Terminal"
+ ["Line mode" term-line-mode :active (term-in-char-mode)
+ :help "Switch to line (cooked) sub-mode of term mode"]
+ ["Character mode" term-char-mode :active (term-in-line-mode)
+ :help "Switch to char (raw) sub-mode of term mode"]
+ ["Paging" term-pager-toggle :style toggle :selected term-pager-count
+ :help "Toggle paging feature"]))
+
+(easy-menu-define term-signals-menu
+ (list term-mode-map term-raw-map term-pager-break-map)
+ "Signals menu for Term mode."
+ '("Signals"
+ ["BREAK" term-interrupt-subjob :active t
+ :help "Interrupt the current subjob"]
+ ["STOP" term-stop-subjob :active t :help "Stop the current subjob"]
+ ["CONT" term-continue-subjob :active t
+ :help "Send CONT signal to process buffer's process group"]
+ ["QUIT" term-quit-subjob :active t
+ :help "Send quit signal to the current subjob"]
+ ["KILL" term-kill-subjob :active t
+ :help "Send kill signal to the current subjob"]
+ ["EOF" term-send-eof :active t
+ :help "Send an EOF to the current buffer's process"]))
+
+(easy-menu-define term-pager-menu term-pager-break-map
+ "Menu for Term pager mode."
+ '("More pages?"
+ ["1 page forwards" term-pager-page t]
+ ["1 page backwards" term-pager-back-page t]
+ ["1 line backwards" term-pager-back-line t]
+ ["1 line forwards" term-pager-line t]
+ ["Goto to beginning" term-pager-bob t]
+ ["Goto to end" term-pager-eob t]
+ ["Discard remaining output" term-pager-discard t]
+ ["Disable paging" term-pager-toggle t]
+ ["Help" term-pager-help t]))
+
+(defvar term-raw-escape-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map 'Control-X-prefix)
+ ;; Define standard bindings in term-raw-escape-map.
+ (define-key map "\C-v" (lookup-key (current-global-map) "\C-v"))
+ (define-key map "\C-u" (lookup-key (current-global-map) "\C-u"))
+ (define-key map "\C-q" 'term-pager-toggle)
+ ;; The keybinding for term-char-mode is needed by the menubar code.
+ (define-key map "\C-k" 'term-char-mode)
+ (define-key map "\C-j" 'term-line-mode)
+ ;; It's convenient to have execute-extended-command here.
+ (define-key map [?\M-x] 'execute-extended-command)
+ map))
+
+(defun term-set-escape-char (key)
"Change `term-escape-char' and keymaps that depend on it."
(when term-escape-char
+ ;; Undo previous term-set-escape-char.
(define-key term-raw-map term-escape-char 'term-send-raw))
- (setq c (make-string 1 c))
- (define-key term-raw-map c term-raw-escape-map)
- ;; Define standard bindings in term-raw-escape-map
- (define-key term-raw-escape-map "\C-v"
- (lookup-key (current-global-map) "\C-v"))
- (define-key term-raw-escape-map "\C-u"
- (lookup-key (current-global-map) "\C-u"))
- (define-key term-raw-escape-map c 'term-send-raw)
- (define-key term-raw-escape-map "\C-q" 'term-pager-toggle)
- ;; The keybinding for term-char-mode is needed by the menubar code.
- (define-key term-raw-escape-map "\C-k" 'term-char-mode)
- (define-key term-raw-escape-map "\C-j" 'term-line-mode)
- ;; It's convenient to have execute-extended-command here.
- (define-key term-raw-escape-map [?\M-x] 'execute-extended-command))
-
-(let* ((map (make-keymap))
- (esc-map (make-keymap))
- (i 0))
- (while (< i 128)
- (define-key map (make-string 1 i) 'term-send-raw)
- ;; Avoid O and [. They are used in escape sequences for various keys.
- (unless (or (eq i ?O) (eq i 91))
- (define-key esc-map (make-string 1 i) 'term-send-raw-meta))
- (setq i (1+ i)))
- (define-key map [remap self-insert-command] 'term-send-raw)
- (define-key map "\e" esc-map)
- (setq term-raw-map map)
- (setq term-raw-escape-map
- (copy-keymap (lookup-key (current-global-map) "\C-x")))
-
- ;; Added nearly all the 'gray keys' -mm
+ (setq term-escape-char (vector key))
+ (define-key term-raw-map term-escape-char term-raw-escape-map)
+ ;; FIXME: If we later call term-set-escape-char again with another key,
+ ;; we should undo this binding.
+ (define-key term-raw-escape-map term-escape-char 'term-send-raw))
- (if (featurep 'xemacs)
- (define-key term-raw-map [button2] 'term-mouse-paste)
- (define-key term-raw-map [mouse-2] 'term-mouse-paste)
- (define-key term-raw-map [menu-bar terminal] term-terminal-menu)
- (define-key term-raw-map [menu-bar signals] term-signals-menu))
- (define-key term-raw-map [up] 'term-send-up)
- (define-key term-raw-map [down] 'term-send-down)
- (define-key term-raw-map [right] 'term-send-right)
- (define-key term-raw-map [left] 'term-send-left)
- (define-key term-raw-map [delete] 'term-send-del)
- (define-key term-raw-map [deletechar] 'term-send-del)
- (define-key term-raw-map [backspace] 'term-send-backspace)
- (define-key term-raw-map [home] 'term-send-home)
- (define-key term-raw-map [end] 'term-send-end)
- (define-key term-raw-map [insert] 'term-send-insert)
- (define-key term-raw-map [S-prior] 'scroll-down)
- (define-key term-raw-map [S-next] 'scroll-up)
- (define-key term-raw-map [S-insert] 'term-paste)
- (define-key term-raw-map [prior] 'term-send-prior)
- (define-key term-raw-map [next] 'term-send-next))
-
-(term-set-escape-char ?\C-c)
+(term-set-escape-char (or term-escape-char ?\C-c))
(defvar overflow-newline-into-fringe)
(defun term-window-width ()
- (if (featurep 'xemacs)
- (1- (window-width))
- (if (and window-system overflow-newline-into-fringe)
- (window-width)
- (1- (window-width)))))
+ (if (and (not (featurep 'xemacs))
+ (display-graphic-p)
+ overflow-newline-into-fringe
+ (/= (frame-parameter nil 'right-fringe) 0))
+ (window-width)
+ (1- (window-width))))
(put 'term-mode 'mode-class 'special)
@@ -969,20 +996,19 @@ is buffer-local."
dt))
(defun term-ansi-reset ()
- (setq term-current-face (nconc
- (if term-default-bg-color
- (list :background term-default-bg-color))
- (if term-default-fg-color
- (list :foreground term-default-fg-color))))
+ (setq term-current-face 'term)
(setq term-ansi-current-underline nil)
(setq term-ansi-current-bold nil)
(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))
-(defun term-mode ()
+(define-derived-mode term-mode fundamental-mode "Term"
"Major mode for interacting with an inferior interpreter.
The interpreter name is same as buffer name, sans the asterisks.
@@ -1026,56 +1052,38 @@ Commands in line mode:
\\{term-mode-map}
Entry to this mode runs the hooks on `term-mode-hook'."
- (interactive)
- ;; Do not remove this. All major modes must do this.
- (kill-all-local-variables)
- (setq major-mode 'term-mode)
- (setq mode-name "Term")
- (use-local-map term-mode-map)
;; we do not want indent to sneak in any tabs
(setq indent-tabs-mode nil)
(setq buffer-display-table term-display-table)
- (make-local-variable 'term-home-marker)
- (setq term-home-marker (copy-marker 0))
+ (set (make-local-variable 'term-home-marker) (copy-marker 0))
+ (set (make-local-variable 'term-height) (1- (window-height)))
+ (set (make-local-variable 'term-width) (term-window-width))
+ (set (make-local-variable 'term-last-input-start) (make-marker))
+ (set (make-local-variable 'term-last-input-end) (make-marker))
+ (set (make-local-variable 'term-last-input-match) "")
+ (set (make-local-variable 'term-command-hook)
+ (symbol-function 'term-command-hook))
+
+ ;; These local variables are set to their local values:
(make-local-variable 'term-saved-home-marker)
- (make-local-variable 'term-height)
- (make-local-variable 'term-width)
- (setq term-width (term-window-width))
- (setq term-height (1- (window-height)))
(make-local-variable 'term-terminal-parameter)
(make-local-variable 'term-saved-cursor)
- (make-local-variable 'term-last-input-start)
- (setq term-last-input-start (make-marker))
- (make-local-variable 'term-last-input-end)
- (setq term-last-input-end (make-marker))
- (make-local-variable 'term-last-input-match)
- (setq term-last-input-match "")
- (make-local-variable 'term-prompt-regexp) ; Don't set; default
- (make-local-variable 'term-input-ring-size) ; ...to global val.
+ (make-local-variable 'term-prompt-regexp)
+ (make-local-variable 'term-input-ring-size)
(make-local-variable 'term-input-ring)
(make-local-variable 'term-input-ring-file-name)
- (or (and (boundp 'term-input-ring) term-input-ring)
- (setq term-input-ring (make-ring term-input-ring-size)))
(make-local-variable 'term-input-ring-index)
- (or (and (boundp 'term-input-ring-index) term-input-ring-index)
- (setq term-input-ring-index nil))
-
- (make-local-variable 'term-command-hook)
- (setq term-command-hook (symbol-function 'term-command-hook))
+ (unless term-input-ring
+ (setq term-input-ring (make-ring term-input-ring-size)))
;; I'm not sure these saves are necessary but, since I
;; haven't tested the whole thing on a net connected machine with
;; a properly configured ange-ftp, I've decided to be conservative
;; and put them in. -mm
- (make-local-variable 'term-ansi-at-host)
- (setq term-ansi-at-host (system-name))
-
- (make-local-variable 'term-ansi-at-dir)
- (setq term-ansi-at-dir default-directory)
-
- (make-local-variable 'term-ansi-at-message)
- (setq term-ansi-at-message nil)
+ (set (make-local-variable 'term-ansi-at-host) (system-name))
+ (set (make-local-variable 'term-ansi-at-dir) default-directory)
+ (set (make-local-variable 'term-ansi-at-message) nil)
;; For user tracking purposes -mm
(make-local-variable 'ange-ftp-default-user)
@@ -1108,8 +1116,7 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(make-local-variable 'term-current-row)
(make-local-variable 'term-log-buffer)
(make-local-variable 'term-scroll-start)
- (make-local-variable 'term-scroll-end)
- (setq term-scroll-end term-height)
+ (set (make-local-variable 'term-scroll-end) term-height)
(make-local-variable 'term-scroll-with-delete)
(make-local-variable 'term-pager-count)
(make-local-variable 'term-pager-old-local-map)
@@ -1131,18 +1138,17 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(make-local-variable 'term-ptyp)
(make-local-variable 'term-exec-hook)
(make-local-variable 'term-vertical-motion)
- (make-local-variable 'term-pending-delete-marker)
- (setq term-pending-delete-marker (make-marker))
+ (set (make-local-variable 'term-pending-delete-marker) (make-marker))
(make-local-variable 'term-current-face)
(term-ansi-reset)
- (make-local-variable 'term-pending-frame)
- (setq term-pending-frame nil)
+ (set (make-local-variable 'term-pending-frame) nil)
;; Cua-mode's keybindings interfere with the term keybindings, disable it.
(set (make-local-variable 'cua-mode) nil)
- (run-mode-hooks 'term-mode-hook)
- (when (featurep 'xemacs)
- (set-buffer-menubar
- (append current-menubar (list term-terminal-menu))))
+
+ (set (make-local-variable 'font-lock-defaults) '(nil t))
+
+ (easy-menu-add term-terminal-menu)
+ (easy-menu-add term-signals-menu)
(or term-input-ring
(setq term-input-ring (make-ring term-input-ring-size)))
(term-update-mode-line))
@@ -1184,9 +1190,9 @@ Entry to this mode runs the hooks on `term-mode-hook'."
found))
(defun term-check-size (process)
- (when (or (/= term-height (1- (window-height)))
+ (when (or (/= term-height (window-text-height))
(/= term-width (term-window-width)))
- (term-reset-size (1- (window-height)) (term-window-width))
+ (term-reset-size (window-text-height) (term-window-width))
(set-process-window-size process term-height term-width)))
(defun term-send-raw-string (chars)
@@ -1211,21 +1217,21 @@ without any interpretation."
(defun term-send-raw-meta ()
(interactive)
(let ((char last-input-event))
- (when (symbolp last-input-event)
+ (when (symbolp char)
;; Convert `return' to C-m, etc.
(let ((tmp (get char 'event-symbol-elements)))
- (when tmp
- (setq char (car tmp)))
- (when (symbolp char)
- (setq tmp (get char 'ascii-character))
- (when tmp
- (setq char tmp)))))
- (setq char (event-basic-type char))
- (term-send-raw-string (if (and (numberp char)
- (> char 127)
- (< char 256))
- (make-string 1 char)
- (format "\e%c" char)))))
+ (if tmp (setq char (car tmp)))
+ (and (symbolp char)
+ (setq tmp (get char 'ascii-character))
+ (setq char tmp))))
+ (when (numberp char)
+ (let ((base (event-basic-type char))
+ (mods (delq 'meta (event-modifiers char))))
+ (if (memq 'control mods)
+ (setq mods (delq 'shift mods)))
+ (term-send-raw-string
+ (format "\e%c"
+ (event-convert-list (append mods (list base)))))))))
(defun term-mouse-paste (click)
"Insert the primary selection at the position clicked on."
@@ -1280,6 +1286,8 @@ intervention from Emacs, except for the escape character (usually C-c)."
(when (term-in-line-mode)
(setq term-old-mode-map (current-local-map))
(use-local-map term-raw-map)
+ (easy-menu-add term-terminal-menu)
+ (easy-menu-add term-signals-menu)
;; Send existing partial line to inferior (without newline).
(let ((pmark (process-mark (get-buffer-process (current-buffer))))
@@ -1304,8 +1312,31 @@ you type \\[term-send-input] which sends the current line to the inferior."
(term-update-mode-line)))
(defun term-update-mode-line ()
- (let ((term-mode (if (term-in-char-mode) "char" "line"))
- (term-page (when (term-pager-enabled) " page"))
+ (let ((term-mode
+ (if (term-in-char-mode)
+ (propertize "char"
+ 'help-echo "mouse-1: Switch to line mode"
+ 'mouse-face 'mode-line-highlight
+ 'local-map
+ '(keymap
+ (mode-line keymap (down-mouse-1 . term-line-mode))))
+ (propertize "line"
+ 'help-echo "mouse-1: Switch to char mode"
+ 'mouse-face 'mode-line-highlight
+ 'local-map
+ '(keymap
+ (mode-line keymap (down-mouse-1 . term-char-mode))))))
+ (term-page
+ (when (term-pager-enabled)
+ (concat " "
+ (propertize
+ "page"
+ 'help-echo "mouse-1: Disable paging"
+ 'mouse-face 'mode-line-highlight
+ 'local-map
+ '(keymap
+ (mode-line keymap (down-mouse-1 .
+ term-pager-toggle)))))))
(serial-item-speed)
(serial-item-config)
(proc (get-buffer-process (current-buffer))))
@@ -2622,13 +2653,13 @@ See `term-prompt-regexp'."
;; from the last character on the line, set the face for the chars
;; to default.
(when (> (point) point-at-eol)
- (put-text-property point-at-eol (point) 'face 'default))))
+ (put-text-property point-at-eol (point) 'font-lock-face 'default))))
;; Insert COUNT copies of CHAR in the default face.
(defun term-insert-char (char count)
(let ((old-point (point)))
(insert-char char count)
- (put-text-property old-point (point) 'face 'default)))
+ (put-text-property old-point (point) 'font-lock-face 'default)))
(defun term-current-row ()
(cond (term-current-row)
@@ -2729,10 +2760,8 @@ See `term-prompt-regexp'."
(str-length (length str)))
(save-selected-window
- ;; Let's handle the messages. -mm
-
- (let* ((newstr (term-handle-ansi-terminal-messages str)))
- (when (not (eq str newstr))
+ (let ((newstr (term-handle-ansi-terminal-messages str)))
+ (unless (eq str newstr)
(setq handled-ansi-message t
str newstr)))
(setq str-length (length str))
@@ -2742,18 +2771,19 @@ See `term-prompt-regexp'."
(delete-region term-pending-delete-marker (process-mark proc))
(set-marker term-pending-delete-marker nil))
+ (when (/= (point) (process-mark proc))
+ (setq save-point (point-marker)))
+
+ ;; Note if the window size has changed. We used to reset
+ ;; point too, but that gives incorrect results (Bug#4635).
(if (eq (window-buffer) (current-buffer))
(progn
(setq term-vertical-motion (symbol-function 'vertical-motion))
(term-check-size proc))
(setq term-vertical-motion
(symbol-function 'term-buffer-vertical-motion)))
-
(setq save-marker (copy-marker (process-mark proc)))
-
- (when (/= (point) (process-mark proc))
- (setq save-point (point-marker))
- (goto-char (process-mark proc)))
+ (goto-char (process-mark proc))
(save-restriction
;; If the buffer is in line mode, and there is a partial
@@ -2853,7 +2883,7 @@ See `term-prompt-regexp'."
(setq term-current-column nil)
(put-text-property old-point (point)
- 'face term-current-face)
+ 'font-lock-face term-current-face)
;; If the last char was written in last column,
;; back up one column, but remember we did so.
;; Thus we emulate xterm/vt100-style line-wrapping.
@@ -3126,10 +3156,6 @@ See `term-prompt-regexp'."
;; New function to deal with ansi colorized output, as you can see you can
;; have any bold/underline/fg/bg/reverse combination. -mm
-(defvar term-bold-attribute '(:weight bold)
- "Attribute to use for the bold terminal attribute.
-Set it to nil to disable bold.")
-
(defun term-handle-colors-array (parameter)
(cond
@@ -3191,46 +3217,32 @@ Set it to nil to disable bold.")
;; term-ansi-current-color
;; term-ansi-current-bg-color)
-
(unless term-ansi-face-already-done
(if term-ansi-current-invisible
(let ((color
(if term-ansi-current-reverse
- (if (= term-ansi-current-color 0)
- term-default-fg-color
- (elt ansi-term-color-vector term-ansi-current-color))
- (if (= term-ansi-current-bg-color 0)
- term-default-bg-color
- (elt ansi-term-color-vector term-ansi-current-bg-color)))))
+ (face-foreground
+ (elt ansi-term-color-vector term-ansi-current-color))
+ (face-background
+ (elt ansi-term-color-vector term-ansi-current-bg-color)))))
(setq term-current-face
(list :background color
:foreground color))
) ;; No need to bother with anything else if it's invisible.
-
(setq term-current-face
- (if term-ansi-current-reverse
- (if (= term-ansi-current-color 0)
- (list :background term-default-fg-color
- :foreground term-default-bg-color)
- (list :background
- (elt ansi-term-color-vector term-ansi-current-color)
- :foreground
- (elt ansi-term-color-vector term-ansi-current-bg-color)))
-
- (if (= term-ansi-current-color 0)
- (list :foreground term-default-fg-color
- :background term-default-bg-color)
- (list :foreground
- (elt ansi-term-color-vector term-ansi-current-color)
- :background
- (elt ansi-term-color-vector term-ansi-current-bg-color)))))
+ (list :foreground
+ (face-foreground (elt ansi-term-color-vector term-ansi-current-color))
+ :background
+ (face-background (elt ansi-term-color-vector term-ansi-current-bg-color))
+ :inverse-video term-ansi-current-reverse))
(when term-ansi-current-bold
(setq term-current-face
- (append term-bold-attribute term-current-face)))
+ `(,term-current-face :inherit term-bold)))
+
(when term-ansi-current-underline
(setq term-current-face
- (list* :underline t term-current-face)))))
+ `(,term-current-face :inherit term-underline)))))
;; (message "Debug %S" term-current-face)
;; FIXME: shouldn't we set term-ansi-face-already-done to t here? --Stef
@@ -3471,54 +3483,13 @@ The top-most line is line 0."
;; The page is full, so enter "pager" mode, and wait for input.
(defun term-process-pager ()
- (when (not term-pager-break-map)
- (let* ((map (make-keymap))
- ;; (i 0)
- tmp)
- ;; (while (< i 128)
- ;; (define-key map (make-string 1 i) 'term-send-raw)
- ;; (setq i (1+ i)))
- (define-key map "\e"
- (lookup-key (current-global-map) "\e"))
- (define-key map "\C-x"
- (lookup-key (current-global-map) "\C-x"))
- (define-key map "\C-u"
- (lookup-key (current-global-map) "\C-u"))
- (define-key map " " 'term-pager-page)
- (define-key map "\r" 'term-pager-line)
- (define-key map "?" 'term-pager-help)
- (define-key map "h" 'term-pager-help)
- (define-key map "b" 'term-pager-back-page)
- (define-key map "\177" 'term-pager-back-line)
- (define-key map "q" 'term-pager-discard)
- (define-key map "D" 'term-pager-disable)
- (define-key map "<" 'term-pager-bob)
- (define-key map ">" 'term-pager-eob)
-
- ;; Add menu bar.
- (unless (featurep 'xemacs)
- (define-key map [menu-bar terminal] term-terminal-menu)
- (define-key map [menu-bar signals] term-signals-menu)
- (setq tmp (make-sparse-keymap "More pages?"))
- (define-key tmp [help] '("Help" . term-pager-help))
- (define-key tmp [disable]
- '("Disable paging" . term-fake-pager-disable))
- (define-key tmp [discard]
- '("Discard remaining output" . term-pager-discard))
- (define-key tmp [eob] '("Goto to end" . term-pager-eob))
- (define-key tmp [bob] '("Goto to beginning" . term-pager-bob))
- (define-key tmp [line] '("1 line forwards" . term-pager-line))
- (define-key tmp [bline] '("1 line backwards" . term-pager-back-line))
- (define-key tmp [back] '("1 page backwards" . term-pager-back-page))
- (define-key tmp [page] '("1 page forwards" . term-pager-page))
- (define-key map [menu-bar page] (cons "More pages?" tmp))
- )
-
- (setq term-pager-break-map map)))
;; (let ((process (get-buffer-process (current-buffer))))
;; (stop-process process))
(setq term-pager-old-local-map (current-local-map))
(use-local-map term-pager-break-map)
+ (easy-menu-add term-terminal-menu)
+ (easy-menu-add term-signals-menu)
+ (easy-menu-add term-pager-menu)
(make-local-variable 'term-old-mode-line-format)
(setq term-old-mode-line-format mode-line-format)
(setq mode-line-format
@@ -3599,14 +3570,6 @@ The top-most line is line 0."
(interactive)
(if (term-pager-enabled) (term-pager-disable) (term-pager-enable)))
-(unless (featurep 'xemacs)
- (defalias 'term-fake-pager-enable 'term-pager-toggle)
- (defalias 'term-fake-pager-disable 'term-pager-toggle)
- (put 'term-char-mode 'menu-enable '(term-in-line-mode))
- (put 'term-line-mode 'menu-enable '(term-in-char-mode))
- (put 'term-fake-pager-enable 'menu-enable '(not term-pager-count))
- (put 'term-fake-pager-disable 'menu-enable 'term-pager-count))
-
(defun term-pager-help ()
"Provide help on commands available in a terminal-emulator **MORE** break."
(interactive)
@@ -3753,7 +3716,7 @@ all pending output has been dealt with."))
(when wrapped
(insert ? ))
(insert ?\n)
- (put-text-property saved-point (point) 'face 'default)
+ (put-text-property saved-point (point) 'font-lock-face 'default)
(goto-char saved-point))))
(defun term-erase-in-display (kind)
@@ -3801,7 +3764,7 @@ if KIND is 1, erase from home to point; else erase from home to point-max."
;; from the last character on the line, set the face for the chars
;; to default.
(when (>= (point) pnt-at-eol)
- (put-text-property pnt-at-eol (point) 'face 'default))
+ (put-text-property pnt-at-eol (point) 'font-lock-face 'default))
(when (> save-eol (point))
(delete-region (point) save-eol))
(goto-char save-point)
@@ -4096,6 +4059,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)))
@@ -4129,8 +4093,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."
@@ -4222,11 +4184,16 @@ the process. Any more args are arguments to PROGRAM."
(term-mode)
(term-char-mode)
- ;; I wanna have find-file on C-x C-f -mm
- ;; your mileage may definitely vary, maybe it's better to put this in your
- ;; .emacs ...
-
- (term-set-escape-char ?\C-x)
+ ;; Historical baggage. A call to term-set-escape-char used to not
+ ;; undo any previous call to t-s-e-c. Because of this, ansi-term
+ ;; ended up with both C-x and C-c as escape chars. Who knows what
+ ;; the original intention was, but people could have become used to
+ ;; either. (Bug#12842)
+ (let (term-escape-char)
+ ;; I wanna have find-file on C-x C-f -mm
+ ;; your mileage may definitely vary, maybe it's better to put this in your
+ ;; .emacs ...
+ (term-set-escape-char ?\C-x))
(switch-to-buffer term-ansi-buffer-name))
diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el
index 4453c9e3b8c..12707c12ba2 100644
--- a/lisp/term/AT386.el
+++ b/lisp/term/AT386.el
@@ -1,6 +1,6 @@
-;;; AT386.el --- terminal support package for IBM AT keyboards -*- no-byte-compile: t -*-
+;;; AT386.el --- terminal support package for IBM AT keyboards
-;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Keywords: terminals
diff --git a/lisp/term/README b/lisp/term/README
index 6d2e0acbd20..188495acf53 100644
--- a/lisp/term/README
+++ b/lisp/term/README
@@ -1,4 +1,4 @@
-Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/lisp/term/apollo.el b/lisp/term/apollo.el
index c570a20112b..e4cabac3bf1 100644
--- a/lisp/term/apollo.el
+++ b/lisp/term/apollo.el
@@ -1,4 +1,3 @@
-;; -*- no-byte-compile: t -*-
(defun terminal-init-apollo ()
"Terminal initialization function for apollo."
(tty-run-terminal-initialization (selected-frame) "vt100"))
diff --git a/lisp/term/bobcat.el b/lisp/term/bobcat.el
index d9ab1a5fb16..f26dc6b9198 100644
--- a/lisp/term/bobcat.el
+++ b/lisp/term/bobcat.el
@@ -1,4 +1,3 @@
-;; -*- no-byte-compile: t -*-
(defun terminal-init-bobcat ()
"Terminal initialization function for bobcat."
diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el
index 63c8840621c..b44e092cc0a 100644
--- a/lisp/term/common-win.el
+++ b/lisp/term/common-win.el
@@ -1,6 +1,6 @@
;;; common-win.el --- common part of handling window systems
-;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: terminals
@@ -57,7 +57,7 @@ clipboard as well.
On Nextstep, put TEXT in the pasteboard (`x-select-enable-clipboard'
is not used)."
- (cond ((eq system-type 'windows-nt)
+ (cond ((eq (framep (selected-frame)) 'w32)
(if x-select-enable-clipboard
(w32-set-clipboard-data text))
(setq x-last-selected-text text))
diff --git a/lisp/term/cygwin.el b/lisp/term/cygwin.el
index cfce07035cf..d69433a77c2 100644
--- a/lisp/term/cygwin.el
+++ b/lisp/term/cygwin.el
@@ -1,4 +1,4 @@
-;;; cygwin.el --- support for the Cygwin terminal -*- no-byte-compile: t -*-
+;;; cygwin.el --- support for the Cygwin terminal
;;; The Cygwin terminal can't really display underlines.
diff --git a/lisp/term/internal.el b/lisp/term/internal.el
index a43864e36d6..d8280b13acd 100644
--- a/lisp/term/internal.el
+++ b/lisp/term/internal.el
@@ -1,6 +1,6 @@
;;; internal.el --- support for PC internal terminal
-;; Copyright (C) 1993-1994, 1998-1999, 2001-2011
+;; Copyright (C) 1993-1994, 1998-1999, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
diff --git a/lisp/term/iris-ansi.el b/lisp/term/iris-ansi.el
index 3e06810cce6..aea2e8c1092 100644
--- a/lisp/term/iris-ansi.el
+++ b/lisp/term/iris-ansi.el
@@ -1,6 +1,6 @@
-;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps -*- no-byte-compile: t -*-
+;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Dan Nicolaescu <dann@ics.uci.edu>
@@ -322,7 +322,7 @@
"Terminal initialization function for iris-ansi."
;; Use inheritance to let the main keymap override these defaults.
;; This way we don't override terminfo-derived settings or settings
- ;; made in the .emacs file.
+ ;; made in the init file.
(let ((m (copy-keymap iris-function-map)))
(set-keymap-parent m (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map m)))
diff --git a/lisp/term/linux.el b/lisp/term/linux.el
index 76115e7d58a..00bcdfdf542 100644
--- a/lisp/term/linux.el
+++ b/lisp/term/linux.el
@@ -1,6 +1,7 @@
-;; -*- no-byte-compile: t -*-
;; The Linux console handles Latin-1 by default.
+(declare-function gpm-mouse-enable "t-mouse" ())
+
(defun terminal-init-linux ()
"Terminal initialization function for linux."
(unless (terminal-coding-system)
diff --git a/lisp/term/lk201.el b/lisp/term/lk201.el
index e1da0f6f1db..6b9e1301003 100644
--- a/lisp/term/lk201.el
+++ b/lisp/term/lk201.el
@@ -1,4 +1,3 @@
-;; -*- no-byte-compile: t -*-
;; Define function key sequences for DEC terminals.
(defvar lk201-function-map
@@ -76,7 +75,7 @@
(defun terminal-init-lk201 ()
;; Use inheritance to let the main keymap override these defaults.
;; This way we don't override terminfo-derived settings or settings
- ;; made in the .emacs file.
+ ;; made in the init file.
(let ((m (copy-keymap lk201-function-map)))
(set-keymap-parent m (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map m)))
diff --git a/lisp/term/news.el b/lisp/term/news.el
index ba6346997c5..70a1be8497e 100644
--- a/lisp/term/news.el
+++ b/lisp/term/news.el
@@ -1,6 +1,6 @@
-;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard -*- no-byte-compile: t -*-
+;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard
-;; Copyright (C) 1989, 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1993, 2001-2012 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index df0ddd7de8b..e255fec1240 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -1,6 +1,6 @@
-;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system
+;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1994, 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2005-2012 Free Software Foundation, Inc.
;; Authors: Carl Edman
;; Christian Limpach
@@ -39,13 +39,11 @@
;; this file, which works in close coordination with src/nsfns.m.
;;; Code:
-
+(eval-when-compile (require 'cl-lib))
(or (featurep 'ns)
(error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS"
(invocation-name)))
-(eval-when-compile (require 'cl)) ; lexical-let
-
;; Documentation-purposes only: actually loaded in loadup.el.
(require 'frame)
(require 'mouse)
@@ -65,7 +63,7 @@
;; nsterm.m.
(defvar ns-input-file)
-(defun ns-handle-nxopen (switch &optional temp)
+(defun ns-handle-nxopen (_switch &optional temp)
(setq unread-command-events (append unread-command-events
(if temp '(ns-open-temp-file)
'(ns-open-file)))
@@ -74,7 +72,7 @@
(defun ns-handle-nxopentemp (switch)
(ns-handle-nxopen switch t))
-(defun ns-ignore-1-arg (switch)
+(defun ns-ignore-1-arg (_switch)
(setq x-invocation-args (cdr x-invocation-args)))
(defun ns-parse-geometry (geom)
@@ -163,7 +161,7 @@ The properties returned may include `top', `left', `height', and `width'."
(define-key global-map [ns-power-off] 'save-buffers-kill-emacs)
(define-key global-map [ns-open-file] 'ns-find-file)
(define-key global-map [ns-open-temp-file] [ns-open-file])
-(define-key global-map [ns-drag-file] 'ns-insert-file)
+(define-key global-map [ns-drag-file] 'ns-find-file)
(define-key global-map [ns-drag-color] 'ns-set-foreground-at-mouse)
(define-key global-map [S-ns-drag-color] 'ns-set-background-at-mouse)
(define-key global-map [ns-drag-text] 'ns-insert-text)
@@ -201,21 +199,20 @@ The properties returned may include `top', `left', `height', and `width'."
(mapconcat 'identity (cons "ns-service" path) "-")))))
;; This defines the function.
(defalias name
- (lexical-let ((service service))
- (lambda (arg)
- (interactive "p")
- (let* ((in-string
- (cond ((stringp arg) arg)
- (mark-active
- (buffer-substring (region-beginning) (region-end)))))
- (out-string (ns-perform-service service in-string)))
- (cond
- ((stringp arg) out-string)
- ((and out-string (or (not in-string)
- (not (string= in-string out-string))))
- (if mark-active (delete-region (region-beginning) (region-end)))
- (insert out-string)
- (setq deactivate-mark nil)))))))
+ (lambda (arg)
+ (interactive "p")
+ (let* ((in-string
+ (cond ((stringp arg) arg)
+ (mark-active
+ (buffer-substring (region-beginning) (region-end)))))
+ (out-string (ns-perform-service service in-string)))
+ (cond
+ ((stringp arg) out-string)
+ ((and out-string (or (not in-string)
+ (not (string= in-string out-string))))
+ (if mark-active (delete-region (region-beginning) (region-end)))
+ (insert out-string)
+ (setq deactivate-mark nil))))))
(cond
((lookup-key global-map mapping)
(while (cdr path)
@@ -451,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)
@@ -566,7 +574,7 @@ unless the current buffer is a scratch buffer."
parameters))))))))
;; frame will be focused anyway, so select it
-;; (if this is not done, modeline is dimmed until first interaction)
+;; (if this is not done, mode line is dimmed until first interaction)
(add-hook 'after-make-frame-functions 'select-frame)
(defvar tool-bar-mode)
@@ -625,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))
@@ -647,18 +656,6 @@ This defines a fontset consisting of the Courier and other fonts that
come with OS X.
See the documentation of `create-fontset-from-fontset-spec' for the format.")
-;; Conditional on new-fontset so bootstrapping works on non-GUI compiles.
-(when (fboundp 'new-fontset)
- ;; Setup the default fontset.
- (create-default-fontset)
- ;; Create the standard fontset.
- (condition-case err
- (create-fontset-from-fontset-spec ns-standard-fontset-spec t)
- (error (display-warning
- 'initialization
- (format "Creation of the standard fontset failed: %s" err)
- :error))))
-
(defvar ns-reg-to-script) ; nsfont.m
;; This maps font registries (not exposed by NS APIs for font selection) to
@@ -826,7 +823,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
((not window-pos)
nil)
((eq window-pos 'mode-line)
- 'modeline)
+ 'mode-line)
((eq window-pos 'vertical-line)
'default)
((consp window-pos)
@@ -900,10 +897,21 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; defines functions and variables that we use now.
(defun ns-initialize-window-system ()
"Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing."
+ (cl-assert (not ns-initialized))
;; PENDING: not needed?
(setq command-line-args (x-handle-args command-line-args))
+ ;; Setup the default fontset.
+ (create-default-fontset)
+ ;; Create the standard fontset.
+ (condition-case err
+ (create-fontset-from-fontset-spec ns-standard-fontset-spec t)
+ (error (display-warning
+ 'initialization
+ (format "Creation of the standard fontset failed: %s" err)
+ :error)))
+
(x-open-connection (system-name) nil t)
(dolist (service (ns-list-services))
@@ -924,8 +932,10 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html
(ns-set-resource nil "ApplePressAndHoldEnabled" "NO")
+ (x-apply-session-resources)
(setq ns-initialized t))
+(add-to-list 'display-format-alist '("\\`ns\\'" . ns))
(add-to-list 'handle-args-function-alist '(ns . x-handle-args))
(add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces))
(add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system))
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index 284c164150d..9fd3bf14fe1 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -1,6 +1,6 @@
;;; pc-win.el --- setup support for `PC windows' (whatever that is)
-;; Copyright (C) 1994, 1996-1997, 1999, 2001-2011
+;; Copyright (C) 1994, 1996-1997, 1999, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
@@ -40,8 +40,6 @@
(error "%s: Loading pc-win.el but not compiled for MS-DOS"
(invocation-name)))
-(load "term/internal" nil t)
-
(declare-function msdos-remember-default-colors "msdos.c")
(declare-function w16-set-clipboard-data "w16select.c")
(declare-function w16-get-clipboard-data "w16select.c")
@@ -159,6 +157,12 @@ created."
;; returned value matters. Also, by the way, recall that `ignore' is
;; a useful function for returning 'nil regardless of argument.
+;; Note: Any re-definition in this file of a function that is defined
+;; in C on other platforms, should either have no doc-string, or one
+;; that is identical to the C version, but with the arglist signature
+;; at the end. Otherwise help-split-fundoc gets confused on other
+;; platforms. (Bug#10783)
+
;; From src/xfns.c
(defun x-list-fonts (pattern &optional face frame maximum width)
(if (or (null width) (and (numberp width) (= width 1)))
@@ -218,11 +222,12 @@ On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the
clipboard. If `x-select-enable-primary' is non-nil, put TEXT in
the primary selection.
-On Windows, make TEXT the current selection. If
+On MS-Windows, make TEXT the current selection. If
`x-select-enable-clipboard' is non-nil, copy the text to the
clipboard as well.
-On Nextstep, put TEXT in the pasteboard."
+On Nextstep, put TEXT in the pasteboard (`x-select-enable-clipboard'
+is not used)."
(if x-select-enable-clipboard
(w16-set-clipboard-data text))
(setq x-last-selected-text text))
@@ -248,13 +253,21 @@ On Nextstep, put TEXT in the pasteboard."
(setq x-last-selected-text text))))))
;; x-selection-owner-p is used in simple.el.
-(defun x-selection-owner-p (&optional type)
+(defun x-selection-owner-p (&optional selection terminal)
"Whether the current Emacs process owns the given X Selection.
The arg should be the name of the selection in question, typically one of
the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
\(Those are literal upper-case symbol names, since that's what X expects.)
For convenience, the symbol nil is the same as `PRIMARY',
-and t is the same as `SECONDARY'."
+and t is the same as `SECONDARY'.
+
+TERMINAL should be a terminal object or a frame specifying the X
+server to query. If omitted or nil, that stands for the selected
+frame's display, or the first available X display.
+
+On Nextstep, TERMINAL is unused.
+
+\(fn &optional SELECTION TERMINAL)"
(if x-select-enable-clipboard
(let (text)
;; Don't die if w16-get-clipboard-data signals an error.
@@ -272,30 +285,58 @@ and t is the same as `SECONDARY'."
;; x-own-selection-internal and x-disown-selection-internal are used
;; in select.el:x-set-selection.
-(defun x-own-selection-internal (type value)
- "Assert an X selection of the given TYPE with the given VALUE.
-TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+(defun x-own-selection-internal (selection value &optional frame)
+ "Assert an X selection of the type SELECTION with and value VALUE.
+SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
\(Those are literal upper-case symbol names, since that's what X expects.)
VALUE is typically a string, or a cons of two markers, but may be
-anything that the functions on `selection-converter-alist' know about."
+anything that the functions on `selection-converter-alist' know about.
+
+FRAME should be a frame that should own the selection. If omitted or
+nil, it defaults to the selected frame.
+
+On Nextstep, FRAME is unused.
+
+\(fn SELECTION VALUE &optional FRAME)"
(ignore-errors
(x-select-text value))
value)
-(defun x-disown-selection-internal (selection &optional time)
+(defun x-disown-selection-internal (selection &optional time-object terminal)
"If we own the selection SELECTION, disown it.
-Disowning it means there is no such selection."
+Disowning it means there is no such selection.
+
+Sets the last-change time for the selection to TIME-OBJECT (by default
+the time of the last event).
+
+TERMINAL should be a terminal object or a frame specifying the X
+server to query. If omitted or nil, that stands for the selected
+frame's display, or the first available X display.
+
+On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
+On MS-DOS, all this does is return non-nil if we own the selection.
+
+\(fn SELECTION &optional TIME-OBJECT TERMINAL)"
(if (x-selection-owner-p selection)
t))
;; x-get-selection-internal is used in select.el
-(defun x-get-selection-internal (selection type &optional time_stamp)
+(defun x-get-selection-internal (selection-symbol target-type &optional time-stamp terminal)
"Return text selected from some X window.
-SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
\(Those are literal upper-case symbol names, since that's what X expects.)
-TYPE is the type of data desired, typically `STRING'.
-TIME_STAMP is the time to use in the XConvertSelection call for foreign
-selections. If omitted, defaults to the time for the last event."
+TARGET-TYPE is the type of data desired, typically `STRING'.
+
+TIME-STAMP is the time to use in the XConvertSelection call for foreign
+selections. If omitted, defaults to the time for the last event.
+
+TERMINAL should be a terminal object or a frame specifying the X
+server to query. If omitted or nil, that stands for the selected
+frame's display, or the first available X display.
+
+On Nextstep, TIME-STAMP and TERMINAL are unused.
+
+\(fn SELECTION-SYMBOL TARGET-TYPE &optional TIME-STAMP TERMINAL)"
(x-get-selection-value))
;; From src/fontset.c:
diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el
index c64dc0e7a19..98141563006 100644
--- a/lisp/term/rxvt.el
+++ b/lisp/term/rxvt.el
@@ -1,6 +1,6 @@
;;; rxvt.el --- define function key sequences and standard colors for rxvt
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Eli Zaretskii
;; Keywords: terminals
@@ -166,7 +166,7 @@
;; Use inheritance to let the main keymap override those defaults.
;; This way we don't override terminfo-derived settings or settings
- ;; made in the .emacs file.
+ ;; made in the init file.
(let ((m (copy-keymap rxvt-function-map)))
(set-keymap-parent m (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map m))
diff --git a/lisp/term/screen.el b/lisp/term/screen.el
index 4931a422e09..d37a695086a 100644
--- a/lisp/term/screen.el
+++ b/lisp/term/screen.el
@@ -1,7 +1,8 @@
-;; -*- no-byte-compile: t -*-
;; Treat a screen terminal similar to an xterm.
(load "term/xterm")
+(declare-function xterm-register-default-colors "xterm" ())
+
(defun terminal-init-screen ()
"Terminal initialization function for screen."
;; Use the xterm color initialization code.
diff --git a/lisp/term/sun.el b/lisp/term/sun.el
index ab7ca8bf5a8..dfe7a63ac1b 100644
--- a/lisp/term/sun.el
+++ b/lisp/term/sun.el
@@ -1,6 +1,6 @@
;;; sun.el --- keybinding for standard default sunterm keys
-;; Copyright (C) 1987, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 2001-2012 Free Software Foundation, Inc.
;; Author: Jeff Peck <peck@sun.com>
;; Keywords: terminals
@@ -123,6 +123,7 @@
(defvar sun-raw-prefix-hooks nil
"List of forms to evaluate after setting sun-raw-prefix.")
+(make-obsolete-variable 'sun-raw-prefix-hooks 'term-setup-hook "21.1")
diff --git a/lisp/term/sup-mouse.el b/lisp/term/sup-mouse.el
index 6d77241008c..c70080c9062 100644
--- a/lisp/term/sup-mouse.el
+++ b/lisp/term/sup-mouse.el
@@ -1,6 +1,6 @@
;;; sup-mouse.el --- supdup mouse support for lisp machines
-;; Copyright (C) 1985-1986, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 2001-2012 Free Software Foundation, Inc.
;; Author: Wolfgang Rupprecht
;; Maintainer: FSF
@@ -63,7 +63,7 @@ executes the mouse commands.
2R delete region |
3R copy region |
-on modeline on \"scroll bar\" in minibuffer
+on mode line on \"scroll bar\" in minibuffer
L scroll-up line to top execute-extended-command
C proportional goto-char line to middle mouse-help
R scroll-down line to bottom eval-expression"
@@ -79,14 +79,14 @@ on modeline on \"scroll bar\" in minibuffer
(old-window (selected-window))
(in-minibuf-p (eq y (1- (frame-height))))
(same-window-p (and (not in-minibuf-p) (eq window old-window)))
- (in-modeline-p (eq y (1- (nth 3 edges))))
+ (in-mode-line-p (eq y (1- (nth 3 edges))))
(in-scrollbar-p (>= x (1- (nth 2 edges)))))
(setq x (- x (nth 0 edges)))
(setq y (- y (nth 1 edges)))
; (error "mouse-hit %d %d %d" buttons x y) ;;;; debug
- (cond (in-modeline-p
+ (cond (in-mode-line-p
(select-window window)
(cond ((= buttons mouse-left)
(scroll-up))
diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el
index d62db664d21..b39869419c0 100644
--- a/lisp/term/tty-colors.el
+++ b/lisp/term/tty-colors.el
@@ -1,6 +1,6 @@
;;; tty-colors.el --- color support for character terminals
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Eli Zaretskii
;; Maintainer: FSF
diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el
index e154074a033..f1b6eea8875 100644
--- a/lisp/term/tvi970.el
+++ b/lisp/term/tvi970.el
@@ -1,6 +1,6 @@
;;; tvi970.el --- terminal support for the Televideo 970
-;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;; Author: Jim Blandy <jimb@occs.cs.oberlin.edu>
;; Keywords: terminals
@@ -27,8 +27,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(defvar tvi970-terminal-map
(let ((map (make-sparse-keymap)))
@@ -95,7 +93,7 @@
"Terminal initialization function for tvi970."
;; Use inheritance to let the main keymap override these defaults.
;; This way we don't override terminfo-derived settings or settings
- ;; made in the .emacs file.
+ ;; made in the init file.
(let ((m (copy-keymap tvi970-terminal-map)))
(set-keymap-parent m (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map m))
diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el
index ca16f356b20..01b21a5b58e 100644
--- a/lisp/term/vt100.el
+++ b/lisp/term/vt100.el
@@ -1,6 +1,6 @@
;;; vt100.el --- define VT100 function key sequences in function-key-map
-;; Copyright (C) 1989, 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1993, 2001-2012 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals
diff --git a/lisp/term/vt102.el b/lisp/term/vt102.el
index 0f2e3805f58..261b0bb5fd6 100644
--- a/lisp/term/vt102.el
+++ b/lisp/term/vt102.el
@@ -1,4 +1,3 @@
-;; -*- no-byte-compile: t -*-
(defun terminal-init-vt102 ()
"Terminal initialization function for vt102."
diff --git a/lisp/term/vt125.el b/lisp/term/vt125.el
index 029f762ef3f..2b2098d483d 100644
--- a/lisp/term/vt125.el
+++ b/lisp/term/vt125.el
@@ -1,4 +1,3 @@
-;; -*- no-byte-compile: t -*-
(defun terminal-init-vt125 ()
"Terminal initialization function for vt125."
diff --git a/lisp/term/vt200.el b/lisp/term/vt200.el
index 09ad64d01f6..550266816e0 100644
--- a/lisp/term/vt200.el
+++ b/lisp/term/vt200.el
@@ -1,4 +1,3 @@
-;; -*- no-byte-compile: t -*-
;; For our purposes we can treat the vt200 and vt100 almost alike.
;; Most differences are handled by the termcap entry.
(defun terminal-init-vt200 ()
diff --git a/lisp/term/vt201.el b/lisp/term/vt201.el
index cbeba00b651..a65b4737731 100644
--- a/lisp/term/vt201.el
+++ b/lisp/term/vt201.el
@@ -1,4 +1,3 @@
-;; -*- no-byte-compile: t -*-
;; For our purposes we can treat the vt200 and vt100 almost alike.
;; Most differences are handled by the termcap entry.
(defun terminal-init-vt201 ()
diff --git a/lisp/term/vt220.el b/lisp/term/vt220.el
index 647b79ea357..0dd43353c55 100644
--- a/lisp/term/vt220.el
+++ b/lisp/term/vt220.el
@@ -1,4 +1,3 @@
-;; -*- no-byte-compile: t -*-
;; For our purposes we can treat the vt200 and vt100 almost alike.
;; Most differences are handled by the termcap entry.
(defun terminal-init-vt220 ()
diff --git a/lisp/term/vt240.el b/lisp/term/vt240.el
index 2da4e7ed3c7..b58d4211ce7 100644
--- a/lisp/term/vt240.el
+++ b/lisp/term/vt240.el
@@ -1,4 +1,3 @@
-;; -*- no-byte-compile: t -*-
;; For our purposes we can treat the vt200 and vt100 almost alike.
;; Most differences are handled by the termcap entry.
(defun terminal-init-vt240 ()
diff --git a/lisp/term/vt300.el b/lisp/term/vt300.el
index 52198d840ae..a2664552a64 100644
--- a/lisp/term/vt300.el
+++ b/lisp/term/vt300.el
@@ -1,4 +1,3 @@
-;; -*- no-byte-compile: t -*-
(defun terminal-init-vt300 ()
"Terminal initialization function for vt300."
(tty-run-terminal-initialization (selected-frame) "vt100")
diff --git a/lisp/term/vt320.el b/lisp/term/vt320.el
index 9b04a5d6ee4..08ed9a8ffb9 100644
--- a/lisp/term/vt320.el
+++ b/lisp/term/vt320.el
@@ -1,4 +1,3 @@
-;; -*- no-byte-compile: t -*-
(defun terminal-init-vt320 ()
"Terminal initialization function for vt320."
(tty-run-terminal-initialization (selected-frame) "vt100")
diff --git a/lisp/term/vt400.el b/lisp/term/vt400.el
index 4c5870c5ad8..ad4a5fdbb4f 100644
--- a/lisp/term/vt400.el
+++ b/lisp/term/vt400.el
@@ -1,4 +1,3 @@
-;; -*- no-byte-compile: t -*-
(defun terminal-init-vt400 ()
"Terminal initialization function for vt400."
(tty-run-terminal-initialization (selected-frame) "vt100")
diff --git a/lisp/term/vt420.el b/lisp/term/vt420.el
index 0476b639c23..f6745a3953a 100644
--- a/lisp/term/vt420.el
+++ b/lisp/term/vt420.el
@@ -1,4 +1,3 @@
-;; -*- no-byte-compile: t -*-
(defun terminal-init-vt420 ()
"Terminal initialization function for vt420."
(tty-run-terminal-initialization (selected-frame) "vt100")
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index b7f2a69e77b..95dab10101b 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -1,6 +1,6 @@
-;;; w32-win.el --- parse switches controlling interface with W32 window system
+;;; w32-win.el --- parse switches controlling interface with W32 window system -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Kevin Gallo
;; Keywords: terminals
@@ -68,6 +68,7 @@
;; (if (not (eq window-system 'w32))
;; (error "%s: Loading w32-win.el but not compiled for w32" (invocation-name)))
+(eval-when-compile (require 'cl-lib))
(require 'frame)
(require 'mouse)
(require 'scroll-bar)
@@ -88,7 +89,10 @@
(make-obsolete 'w32-default-color-map nil "24.1")
(declare-function w32-send-sys-command "w32fns.c")
-(declare-function set-message-beep "w32console.c")
+(declare-function set-message-beep "w32fns.c")
+
+(declare-function cygwin-convert-file-name-from-windows "cygw32.c"
+ (path &optional absolute_p))
;; Conditional on new-fontset so bootstrapping works on non-GUI compiles
(if (fboundp 'new-fontset)
@@ -102,7 +106,26 @@
;; (interactive "e")
;; (princ event))
-(defun w32-drag-n-drop (event)
+(defun w32-handle-dropped-file (window file-name)
+ (let ((f (if (eq system-type 'cygwin)
+ (cygwin-convert-file-name-from-windows file-name t)
+ (subst-char-in-string ?\\ ?/ file-name)))
+ (coding (or file-name-coding-system
+ default-file-name-coding-system)))
+
+ (setq file-name
+ (mapconcat 'url-hexify-string
+ (split-string (encode-coding-string f coding)
+ "/")
+ "/")))
+ (dnd-handle-one-url window 'private
+ (concat
+ (if (eq system-type 'cygwin)
+ "file://"
+ "file:")
+ file-name)))
+
+(defun w32-drag-n-drop (event &optional new-frame)
"Edit the files listed in the drag-n-drop EVENT.
Switch to a buffer editing the last file dropped."
(interactive "e")
@@ -116,26 +139,21 @@ Switch to a buffer editing the last file dropped."
(y (cdr coords)))
(if (and (> x 0) (> y 0))
(set-frame-selected-window nil window))
- (mapc (lambda (file-name)
- (let ((f (subst-char-in-string ?\\ ?/ file-name))
- (coding (or file-name-coding-system
- default-file-name-coding-system)))
- (setq file-name
- (mapconcat 'url-hexify-string
- (split-string (encode-coding-string f coding)
- "/")
- "/")))
- (dnd-handle-one-url window 'private
- (concat "file:" file-name)))
- (car (cdr (cdr event)))))
- (raise-frame)))
+
+ (when new-frame
+ (select-frame (make-frame)))
+ (raise-frame)
+ (setq window (selected-window))
+
+ (mapc (apply-partially #'w32-handle-dropped-file window)
+ (car (cdr (cdr event)))))))
(defun w32-drag-n-drop-other-frame (event)
"Edit the files listed in the drag-n-drop EVENT, in other frames.
May create new frames, or reuse existing ones. The frame editing
the last file dropped is selected."
(interactive "e")
- (mapcar 'find-file-other-frame (car (cdr (cdr event)))))
+ (w32-drag-n-drop event t))
;; Bind the drag-n-drop event.
(global-set-key [drag-n-drop] 'w32-drag-n-drop)
@@ -210,7 +228,8 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
'(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
'(glib "libglib-2.0-0.dll")
'(gobject "libgobject-2.0-0.dll")
- '(gnutls "libgnutls-26.dll")))
+ '(gnutls "libgnutls-28.dll" "libgnutls-26.dll")
+ '(libxml2 "libxml2-2.dll" "libxml2.dll")))
;;; multi-tty support
(defvar w32-initialized nil
@@ -229,6 +248,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(defun w32-initialize-window-system ()
"Initialize Emacs for W32 GUI frames."
+ (cl-assert (not w32-initialized))
;; Do the actual Windows setup here; the above code just defines
;; functions and variables that we use now.
@@ -242,7 +262,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; so as not to choke when we use it in X resource queries.
(replace-regexp-in-string "[.*]" "-" (invocation-name))))
- (x-open-connection "" x-command-line-resources
+ (x-open-connection "w32" x-command-line-resources
;; Exit with a fatal error if this fails and we
;; are the initial display
(eq initial-window-system 'w32))
@@ -293,7 +313,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(setq default-frame-alist
(cons '(reverse . t) default-frame-alist)))))
- ;; Don't let Emacs suspend under w32 gui
+ ;; Don't let Emacs suspend under Windows.
(add-hook 'suspend-hook 'x-win-suspend-error)
;; Turn off window-splitting optimization; w32 is usually fast enough
@@ -308,8 +328,10 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; Set to a system sound if you want a fancy bell.
(set-message-beep 'ok)
+ (x-apply-session-resources)
(setq w32-initialized t))
+(add-to-list 'display-format-alist '("\\`w32\\'" . w32))
(add-to-list 'handle-args-function-alist '(w32 . x-handle-args))
(add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces))
(add-to-list 'window-system-initialization-alist '(w32 . w32-initialize-window-system))
diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el
index cd5aed31982..ceaa936e79b 100644
--- a/lisp/term/w32console.el
+++ b/lisp/term/w32console.el
@@ -1,6 +1,6 @@
;;; w32console.el -- Setup w32 console keys and colors.
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals
@@ -52,6 +52,18 @@
"Terminal initialization function for w32 console."
;; Share function key initialization with w32 gui frames
(x-setup-function-keys (selected-frame))
+ ;; Set terminal and keyboard encodings to the current OEM codepage.
+ (let ((oem-code-page-coding
+ (intern (format "cp%d" (w32-get-console-codepage))))
+ (oem-code-page-output-coding
+ (intern (format "cp%d" (w32-get-console-output-codepage))))
+ oem-cs-p oem-o-cs-p)
+ (setq oem-cs-p (coding-system-p oem-code-page-coding))
+ (setq oem-o-cs-p (coding-system-p oem-code-page-output-coding))
+ (when oem-cs-p
+ (set-keyboard-coding-system oem-code-page-coding)
+ (set-terminal-coding-system
+ (if oem-o-cs-p oem-code-page-output-coding oem-code-page-coding))))
(let* ((colors w32-tty-standard-colors)
(color (car colors)))
(tty-color-clear)
diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el
index b818c769bab..ce148b62dba 100644
--- a/lisp/term/wyse50.el
+++ b/lisp/term/wyse50.el
@@ -1,6 +1,6 @@
-;;; wyse50.el --- terminal support code for Wyse 50 -*- no-byte-compile: t -*-
+;;; wyse50.el --- terminal support code for Wyse 50
-;; Copyright (C) 1989, 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>,
;; Jim Blandy <jimb@occs.cs.oberlin.edu>
@@ -109,7 +109,7 @@
"Terminal initialization function for wyse50."
;; Use inheritance to let the main keymap override these defaults.
;; This way we don't override terminfo-derived settings or settings
- ;; made in the .emacs file.
+ ;; made in the init file.
(let ((m (copy-keymap wyse50-terminal-map)))
(set-keymap-parent m (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map m))
@@ -141,7 +141,7 @@ C-l Scrn CLR
M-r M-x move-to-window-line, Funct up-arrow or down-arrow are similar"
(interactive)
;; Not needed any more now that we use input-decode-map.
- ;; (dolist (key-definition
+ ;; (dolist (key-definition
;; ;; By unsetting C-a and then binding it to a prefix, we
;; ;; allow the rest of the function keys which start with C-a
;; ;; to be recognized.
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index ac0f833da63..2f2125a31db 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1,6 +1,6 @@
;;; x-win.el --- parse relevant switches and set up for X -*-coding: iso-2022-7bit;-*-
-;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals, i18n
@@ -67,6 +67,8 @@
;; An alist of X options and the function which handles them. See
;; ../startup.el.
+(eval-when-compile (require 'cl-lib))
+
(if (not (fboundp 'x-create-frame))
(error "%s: Loading x-win.el but not compiled for X" (invocation-name)))
@@ -1305,12 +1307,15 @@ Request data types in the order specified by `x-select-request-type'."
(declare-function accelerate-menu "xmenu.c" (&optional frame) t)
(defun x-menu-bar-open (&optional frame)
- "Open the menu bar if `menu-bar-mode' is on, otherwise call `tmm-menubar'."
+ "Open the menu bar if it is shown.
+`popup-menu' is used if it is off."
(interactive "i")
- (if (and menu-bar-mode
- (fboundp 'accelerate-menu))
- (accelerate-menu frame)
- (tmm-menubar)))
+ (cond
+ ((and (not (zerop (or (frame-parameter nil 'menu-bar-lines) 0)))
+ (fboundp 'accelerate-menu))
+ (accelerate-menu frame))
+ (t
+ (popup-menu (mouse-menu-bar-map) last-nonmenu-event))))
;;; Window system initialization.
@@ -1335,6 +1340,8 @@ Request data types in the order specified by `x-select-request-type'."
(defun x-initialize-window-system ()
"Initialize Emacs for X frames and open the first connection to an X server."
+ (cl-assert (not x-initialized))
+
;; Make sure we have a valid resource name.
(or (stringp x-resource-name)
(let (i)
@@ -1408,11 +1415,12 @@ Request data types in the order specified by `x-select-request-type'."
(cons '(reverse . t) default-frame-alist)))))
;; Set x-selection-timeout, measured in milliseconds.
- (let ((res-selection-timeout
- (x-get-resource "selectionTimeout" "SelectionTimeout")))
- (setq x-selection-timeout 20000)
- (if res-selection-timeout
- (setq x-selection-timeout (string-to-number res-selection-timeout))))
+ (let ((res-selection-timeout (x-get-resource "selectionTimeout"
+ "SelectionTimeout")))
+ (setq x-selection-timeout
+ (if res-selection-timeout
+ (string-to-number res-selection-timeout)
+ 5000)))
;; Don't let Emacs suspend under X.
(add-hook 'suspend-hook 'x-win-suspend-error)
@@ -1444,8 +1452,10 @@ Request data types in the order specified by `x-select-request-type'."
;; :help "Paste (yank) text most recently cut/copied")
;; nil))
+ (x-apply-session-resources)
(setq x-initialized t))
+(add-to-list 'display-format-alist '("\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" . x))
(add-to-list 'handle-args-function-alist '(x . x-handle-args))
(add-to-list 'frame-creation-function-alist '(x . x-create-frame-with-faces))
(add-to-list 'window-system-initialization-alist '(x . x-initialize-window-system))
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index f9d11cb2685..e4871658b98 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -1,6 +1,6 @@
;;; xterm.el --- define function key sequences and standard colors for xterm
-;; Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals
@@ -27,12 +27,19 @@
(defgroup xterm nil
"XTerm support."
:version "24.1"
- :group 'emacs)
+ :group 'environment)
(defcustom xterm-extra-capabilities 'check
- "Set to a list if the XTerm supports modifyOtherKeys or
-reporting the background color. Set to 'check to check for those
-features. Set to nil to skip the checks."
+ "Whether Xterm supports some additional, more modern, features.
+If nil, just assume that it does not.
+If `check', try to check if it does.
+If a list, assume that the listed features are supported, without checking.
+
+The relevant features are:
+ modifyOtherKeys -- if supported, more key bindings work (e.g, \"\\C-,\")
+ reportBackground -- if supported, Xterm reports its background color
+"
+ :version "24.1"
:group 'xterm
:type '(choice (const :tag "No" nil)
(const :tag "Check" check)
@@ -473,7 +480,7 @@ features. Set to nil to skip the checks."
;; Use inheritance to let the main keymap override those defaults.
;; This way we don't override terminfo-derived settings or settings
- ;; made in the .emacs file.
+ ;; made in the init file.
(set-keymap-parent map (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map map)))
@@ -532,6 +539,7 @@ features. Set to nil to skip the checks."
(and (memq 'reportBackground tocheck-capabilities)
version
(>= version 242)))
+ (discard-input)
(send-string-to-terminal "\e]11;?\e\\")
(when (and (equal (read-event nil nil 2) ?\e)
(equal (read-event nil nil 2) ?\]))
diff --git a/lisp/terminal.el b/lisp/terminal.el
index 99f652f7df4..7aaac26f1b0 100644
--- a/lisp/terminal.el
+++ b/lisp/terminal.el
@@ -1,6 +1,6 @@
;;; terminal.el --- terminal emulator for GNU Emacs
-;; Copyright (C) 1986-1989, 1993-1994, 2001-2011
+;; Copyright (C) 1986-1989, 1993-1994, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Richard Mlynarik <mly@eddie.mit.edu>
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 2e90a4bf241..a545f313650 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -1,6 +1,6 @@
;;; artist.el --- draw ascii graphics with your mouse
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Tomas Abrahamsson <tab@lysator.liu.se>
;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se>
@@ -349,7 +349,7 @@ Example:
(defvar artist-pointer-shape (if (eq window-system 'x) x-pointer-crosshair nil)
- "*If in X Windows, use this pointer shape while drawing with the mouse.")
+ "If in X Windows, use this pointer shape while drawing with the mouse.")
(defcustom artist-text-renderer-function 'artist-figlet
@@ -397,13 +397,13 @@ Example:
;; This is a defvar, not a defcustom, since the custom
;; package shows lists of characters as a lists of integers,
;; which is confusing
- "*Characters (``color'') to use when spraying.
+ "Characters (``color'') to use when spraying.
They should be ordered from the ``lightest'' to the ``heaviest''
since spraying replaces a light character with the next heavier one.")
(defvar artist-spray-new-char ?.
- "*Initial character to use when spraying.
+ "Initial character to use when spraying.
This character is used if spraying upon a character that is not in
`artist-spray-chars'. The character defined by this variable should
be in `artist-spray-chars', or spraying will behave strangely.")
@@ -535,7 +535,8 @@ This variable is initialized by the `artist-make-prev-next-op-alist' function.")
("Text" artist-select-op-text-overwrite text-ovwrt)
("Ellipse" artist-select-op-circle circle)
("Poly-line" artist-select-op-straight-poly-line spolyline)
- ("Rectangle" artist-select-op-square square)
+ ("Square" artist-select-op-square square)
+ ("Rectangle" artist-select-op-rectangle rectangle)
("Line" artist-select-op-straight-line s-line)
("Pen" artist-select-op-pen-line pen-line)))
(define-key map (vector (nth 2 op))
@@ -1196,9 +1197,9 @@ PREV-OP-ARG are used when invoked recursively during the build-up."
;;; ---------------------------------
;;;###autoload
-(defun artist-mode (&optional state)
+(define-minor-mode artist-mode
"Toggle Artist mode.
-With argument STATE, turn Artist mode on if STATE is positive.
+With argument ARG, turn Artist mode on if ARG is positive.
Artist lets you draw lines, squares, rectangles and poly-lines,
ellipses and circles with your mouse and/or keyboard.
@@ -1387,36 +1388,24 @@ Variables
Hooks
- When entering artist-mode, the hook `artist-mode-init-hook' is called.
- When quitting artist-mode, the hook `artist-mode-exit-hook' is called.
+ Turning the mode on or off runs `artist-mode-hook'.
Keymap summary
\\{artist-mode-map}"
- (interactive)
- (if (setq artist-mode
- (if (null state) (not artist-mode)
- (> (prefix-numeric-value state) 0)))
- (artist-mode-init)
- (artist-mode-exit)))
-
-;; insert our minor mode string
-(or (assq 'artist-mode minor-mode-alist)
- (setq minor-mode-alist
- (cons '(artist-mode artist-mode-name)
- minor-mode-alist)))
-
-;; insert our minor mode keymap
-(or (assq 'artist-mode minor-mode-map-alist)
- (setq minor-mode-map-alist
- (cons (cons 'artist-mode artist-mode-map)
- minor-mode-map-alist)))
-
+ :init-value nil :group 'artist :lighter artist-mode-name
+ :keymap artist-mode-map
+ (cond ((null artist-mode)
+ ;; Turn mode off
+ (artist-mode-exit))
+ (t
+ ;; Turn mode on
+ (artist-mode-init))))
;; Init and exit
(defun artist-mode-init ()
- "Init Artist mode. This will call the hook `artist-mode-init-hook'."
+ "Init Artist mode. This will call the hook `artist-mode-hook'."
;; Set up a conversion table for mapping tabs and new-lines to spaces.
;; the last case, 0, is for the last position in buffer/region, where
;; the `following-char' function returns 0.
@@ -1458,15 +1447,13 @@ Keymap summary
(progn
(picture-mode)
(message "")))
- (run-hooks 'artist-mode-init-hook)
(artist-mode-line-show-curr-operation artist-key-is-drawing))
(defun artist-mode-exit ()
- "Exit Artist mode. This will call the hook `artist-mode-exit-hook'."
+ "Exit Artist mode. This will call the hook `artist-mode-hook'."
(if (and artist-picture-compatibility (eq major-mode 'picture-mode))
(picture-mode-exit))
- (kill-local-variable 'next-line-add-newlines)
- (run-hooks 'artist-mode-exit-hook))
+ (kill-local-variable 'next-line-add-newlines))
(defun artist-mode-off ()
"Turn Artist mode off."
@@ -1803,7 +1790,7 @@ info-variant-part."
;;
(defmacro artist-funcall (fn &rest args)
"Call function FN with ARGS, if FN is not nil."
- (list 'if fn (cons 'funcall (cons fn args))))
+ `(if ,fn (funcall ,fn ,@args)))
(defun artist-uniq (l)
"Remove consecutive duplicates in list L. Comparison is done with `equal'."
@@ -2397,8 +2384,8 @@ in the coord."
;;
(defmacro artist-put-pixel (point-list x y)
"In POINT-LIST, store a ``pixel'' at coord X,Y."
- (list 'setq point-list
- (list 'append point-list (list 'list (list 'artist-new-coord x y)))))
+ `(setq ,point-list
+ (append ,point-list (list (artist-new-coord ,x ,y)))))
;; Calculate list of points using eight point algorithm
;; return a list of coords
diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el
index 17ddd1de954..c8881fa5f9d 100644
--- a/lisp/textmodes/bib-mode.el
+++ b/lisp/textmodes/bib-mode.el
@@ -1,6 +1,6 @@
;;; bib-mode.el --- major mode for editing bib files
-;; Copyright (C) 1989, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 2001-2012 Free Software Foundation, Inc.
;; Author: Henry Kautz
;; (according to authors.el)
@@ -137,7 +137,7 @@ with the cdr.")
(defcustom bib-auto-capitalize t
- "*True to automatically capitalize appropriate fields in Bib mode."
+ "True to automatically capitalize appropriate fields in Bib mode."
:type 'boolean
:group 'bib)
diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el
index bc5326240a3..b0371ed0f6c 100644
--- a/lisp/textmodes/bibtex-style.el
+++ b/lisp/textmodes/bibtex-style.el
@@ -1,6 +1,6 @@
;;; bibtex-style.el --- Major mode for BibTeX Style files -*- lexical-binding: t -*-
-;; Copyright (C) 2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: tex
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 8df2e81c723..e0d93b68056 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1,6 +1,6 @@
;;; bibtex.el --- BibTeX mode for GNU Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 1994-1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994-1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de>
;; Bengt Martensson <bengt@mathematik.uni-Bremen.de>
@@ -443,6 +443,7 @@ which is called to determine the initial content of the field.
ALTERNATIVE if non-nil is an integer that numbers sets of
alternatives, starting from zero."
:group 'BibTeX
+ :version "24.1"
:type 'bibtex-entry-alist)
(put 'bibtex-BibTeX-entry-alist 'risky-local-variable t)
@@ -696,6 +697,7 @@ alternatives, starting from zero."
"Alist of biblatex entry types and their associated fields.
It has the same format as `bibtex-BibTeX-entry-alist'."
:group 'bibtex
+ :version "24.1"
:type 'bibtex-entry-alist)
(put 'bibtex-biblatex-entry-alist 'risky-local-variable t)
@@ -717,6 +719,7 @@ It has the same format as `bibtex-BibTeX-entry-alist'."
Each element is a list (FIELD COMMENT). COMMENT is used as a default
if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD."
:group 'bibtex
+ :version "24.1"
:type 'bibtex-field-alist)
(defcustom bibtex-biblatex-field-alist
@@ -814,6 +817,7 @@ if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD."
"Alist of biblatex fields.
It has the same format as `bibtex-BibTeX-entry-alist'."
:group 'bibtex
+ :version "24.1"
:type 'bibtex-field-alist)
(defcustom bibtex-dialect-list '(BibTeX biblatex)
@@ -822,12 +826,14 @@ For each DIALECT (a symbol) a variable bibtex-DIALECT-entry-alist defines
the allowed entries and bibtex-DIALECT-field-alist defines known field types.
Predefined dialects include BibTeX and biblatex."
:group 'bibtex
+ :version "24.1"
:type '(repeat (symbol :tag "Dialect")))
(defcustom bibtex-dialect 'BibTeX
"Current BibTeX dialect. For allowed values see `bibtex-dialect-list'.
-During a session change it via `bibtex-set-dialect'."
+To interactively change the dialect use the command `bibtex-set-dialect'."
:group 'bibtex
+ :version "24.1"
:set '(lambda (symbol value)
(set-default symbol value)
;; `bibtex-set-dialect' is undefined during loading (no problem)
@@ -836,11 +842,13 @@ During a session change it via `bibtex-set-dialect'."
:type '(choice (const BibTeX)
(const biblatex)
(symbol :tag "Custom")))
+(put 'bibtex-dialect 'safe-local-variable 'symbolp)
(defcustom bibtex-no-opt-remove-re "\\`option"
"If a field name matches this regexp, the prefix OPT is not removed.
If nil prefix OPT is always removed"
:group 'bibtex
+ :version "24.1"
:type '(choice (regexp) (const nil)))
(defcustom bibtex-comment-start "@Comment"
@@ -908,8 +916,10 @@ to the directories specified in `bibtex-string-file-path'."
:group 'bibtex
:type '(repeat file))
-(defvar bibtex-string-file-path (getenv "BIBINPUTS")
- "*Colon separated list of paths to search for `bibtex-string-files'.")
+(defcustom bibtex-string-file-path (getenv "BIBINPUTS")
+ "Colon-separated list of paths to search for `bibtex-string-files'."
+ :group 'bibtex
+ :type 'string)
(defcustom bibtex-files nil
"List of BibTeX files that are searched for entry keys.
@@ -922,13 +932,16 @@ See also `bibtex-search-entry-globally'."
:type '(repeat (choice (const :tag "bibtex-file-path" bibtex-file-path)
directory file)))
-(defvar bibtex-file-path (getenv "BIBINPUTS")
- "*Colon separated list of paths to search for `bibtex-files'.")
+(defcustom bibtex-file-path (getenv "BIBINPUTS")
+ "Colon separated list of paths to search for `bibtex-files'."
+ :group 'bibtex
+ :type 'string)
(defcustom bibtex-search-entry-globally nil
"If non-nil, interactive calls of `bibtex-search-entry' search globally.
A global search includes all files in `bibtex-files'."
:group 'bibtex
+ :version "24.1"
:type 'boolean)
(defcustom bibtex-help-message t
@@ -989,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.
@@ -1290,6 +1304,7 @@ Set this variable before loading BibTeX mode."
(defcustom bibtex-search-buffer "*BibTeX Search*"
"Buffer for BibTeX search results."
:group 'bibtex
+ :version "24.1"
:type 'string)
;; `bibtex-font-lock-keywords' is a user option, too. But since the
@@ -1442,11 +1457,13 @@ Set this variable before loading BibTeX mode."
;; Internal Variables
-(defvar bibtex-entry-alist bibtex-BibTeX-entry-alist
- "Alist of currently active entry types.")
+(defvar bibtex-entry-alist nil
+ "Alist of currently active entry types.
+Initialized by `bibtex-set-dialect'.")
-(defvar bibtex-field-alist bibtex-BibTeX-field-alist
- "Alist of currently active field types.")
+(defvar bibtex-field-alist nil
+ "Alist of currently active field types.
+Initialized by `bibtex-set-dialect'.")
(defvar bibtex-field-braces-opt nil
"Optimized value of `bibtex-field-braces-alist'.
@@ -1602,7 +1619,7 @@ Initialized by `bibtex-set-dialect'.")
,@(mapcar (lambda (matcher)
`((lambda (bound) (bibtex-font-lock-cite ',matcher bound))))
bibtex-cite-matcher-alist))
- "*Default expressions to highlight in BibTeX mode.")
+ "Default expressions to highlight in BibTeX mode.")
(defvar bibtex-font-lock-url-regexp
;; Assume that field names begin at the beginning of a line.
@@ -2188,6 +2205,10 @@ Optional arg COMMA is as in `bibtex-enclosing-field'."
(let ((fun (lambda (kryp kr) ; adapted from `current-kill'
(car (set kryp (nthcdr (mod (- n (length (eval kryp)))
(length kr)) kr))))))
+ ;; We put the mark at the beginning of the inserted field or entry
+ ;; and point at its end - a behavior similar to what `yank' does.
+ ;; The mark is then used by `bibtex-yank-pop', which needs to know
+ ;; what we have inserted.
(if (eq bibtex-last-kill-command 'field)
(progn
;; insert past the current field
@@ -2216,7 +2237,7 @@ Optional arg COMMA is as in `bibtex-enclosing-field'."
(aset vec idx (cons newelt (aref vec idx))))
(defsubst bibtex-vec-incr (vec idx)
- "Add NEWELT to the list stored in VEC at index IDX."
+ "Increment by 1 the counter which is stored in VEC at index IDX."
(aset vec idx (1+ (aref vec idx))))
(defun bibtex-format-entry ()
@@ -3376,104 +3397,124 @@ if that value is non-nil.
(setq imenu-generic-expression
(list (list nil bibtex-entry-head bibtex-key-in-head))
imenu-case-fold-search t)
- (bibtex-set-dialect bibtex-dialect))
-
-(defun bibtex-set-dialect (dialect)
- "Select BibTeX mode DIALECT.
-This sets the variable `bibtex-dialect' which holds the currently active
-dialect. Dialects are listed in `bibtex-dialect-list'."
+ ;; Allow `bibtex-dialect' as a file-local variable.
+ (add-hook 'hack-local-variables-hook 'bibtex-set-dialect nil t))
+
+(defun bibtex-entry-alist (dialect)
+ "Return entry-alist for DIALECT."
+ (let ((var (intern (format "bibtex-%s-entry-alist" dialect)))
+ entry-alist)
+ (if (boundp var)
+ (setq entry-alist (symbol-value var))
+ (error "BibTeX dialect `%s' undefined" dialect))
+ (if (not (consp (nth 1 (car entry-alist))))
+ ;; new format
+ entry-alist
+ ;; Convert old format of `bibtex-entry-field-alist'
+ (unless (get var 'entry-list-format)
+ (put var 'entry-list-format "pre-24")
+ (message "Old format of `%s' (pre GNU Emacs 24).
+Please convert to the new format."
+ (if (eq (indirect-variable 'bibtex-entry-field-alist) var)
+ 'bibtex-entry-field-alist var))
+ (sit-for 3))
+ (let (lst)
+ (dolist (entry entry-alist)
+ (let ((fl (nth 1 entry)) req xref opt)
+ (dolist (field (copy-tree (car fl)))
+ (if (nth 3 field) (setcar (nthcdr 3 field) 0))
+ (if (or (not (nth 2 entry))
+ (assoc-string (car field) (car (nth 2 entry)) t))
+ (push field req)
+ (push field xref)))
+ (dolist (field (nth 1 fl))
+ (push field opt))
+ (push (list (car entry) nil (nreverse req)
+ (nreverse xref) (nreverse opt))
+ lst)))
+ (nreverse lst)))))
+
+(defun bibtex-set-dialect (&optional dialect local)
+ "Select BibTeX DIALECT for editing BibTeX files.
+This sets the user variable `bibtex-dialect' as well as the dialect-dependent
+internal variables. Allowed dialects are listed in `bibtex-dialect-list'.
+If DIALECT is nil use current value of `bibtex-dialect'.
+If LOCAL is non-nil make buffer-local bindings for these variables rather than
+setting the global values. The dialect-dependent internal variables
+are also bound buffer-locally if `bibtex-dialect' is already buffer-local
+in the current buffer (for example, as a file-local variable).
+LOCAL is t for interactive calls."
(interactive (list (intern (completing-read "Dialect: "
(mapcar 'list bibtex-dialect-list)
- nil t))))
- (unless (eq dialect (get 'bibtex-dialect 'dialect))
- (put 'bibtex-dialect 'dialect dialect)
- (setq bibtex-dialect dialect)
-
- ;; Bind variables
- (setq bibtex-entry-alist
- (let ((var (intern (format "bibtex-%s-entry-alist" dialect)))
- entry-alist)
- (if (boundp var)
- (setq entry-alist (symbol-value var))
- (error "BibTeX dialect `%s' undefined" dialect))
- (if (not (consp (nth 1 (car entry-alist))))
- ;; new format
- entry-alist
- ;; Convert old format
- (unless (get var 'entry-list-format)
- (put var 'entry-list-format "pre-24")
- (message "Old format of `%s' (pre GNU Emacs 24).
-Please convert to the new format."
- (if (eq (indirect-variable 'bibtex-entry-field-alist) var)
- 'bibtex-entry-field-alist var))
- (sit-for 3))
- (let (lst)
- (dolist (entry entry-alist)
- (let ((fl (nth 1 entry)) req xref opt)
- (dolist (field (copy-tree (car fl)))
- (if (nth 3 field) (setcar (nthcdr 3 field) 0))
- (if (or (not (nth 2 entry))
- (assoc-string (car field) (car (nth 2 entry)) t))
- (push field req)
- (push field xref)))
- (dolist (field (nth 1 fl))
- (push field opt))
- (push (list (car entry) nil (nreverse req)
- (nreverse xref) (nreverse opt))
- lst)))
- (nreverse lst))))
- bibtex-field-alist
- (let ((var (intern (format "bibtex-%s-field-alist" dialect))))
- (if (boundp var)
- (symbol-value var)
- (error "Field types for BibTeX dialect `%s' undefined" dialect)))
- bibtex-entry-type
- (concat "@[ \t]*\\(?:"
- (regexp-opt (mapcar 'car bibtex-entry-alist)) "\\)")
- bibtex-entry-head (concat "^[ \t]*\\("
- bibtex-entry-type
- "\\)[ \t]*[({][ \t\n]*\\("
- bibtex-reference-key
- "\\)")
- bibtex-entry-maybe-empty-head (concat bibtex-entry-head "?")
- bibtex-any-valid-entry-type
- (concat "^[ \t]*@[ \t]*\\(?:"
- (regexp-opt (append '("String" "Preamble")
- (mapcar 'car bibtex-entry-alist))) "\\)"))
- ;; Define entry commands
- (dolist (elt bibtex-entry-alist)
- (let* ((entry (car elt))
- (fname (intern (concat "bibtex-" entry))))
- (unless (fboundp fname)
- (eval (list 'defun fname nil
- (format "Insert a new BibTeX @%s entry; see also `bibtex-entry'."
- entry)
- '(interactive "*")
- `(bibtex-entry ,entry))))))
- ;; Define menu
- ;; We use the same keymap for all BibTeX buffers. So all these buffers
- ;; have the same BibTeX dialect. To define entry types buffer-locally,
- ;; it would be necessary to give each BibTeX buffer a new keymap that
- ;; becomes a child of `bibtex-mode-map'. Useful??
- (easy-menu-define
- nil bibtex-mode-map "Entry-Types Menu in BibTeX mode"
- (apply 'list "Entry-Types"
- (append
- (mapcar (lambda (entry)
- (vector (or (nth 1 entry) (car entry))
- (intern (format "bibtex-%s" (car entry))) t))
- bibtex-entry-alist)
- `("---"
- ["String" bibtex-String t]
- ["Preamble" bibtex-Preamble t]
- "---"
- ,(append '("BibTeX dialect")
- (mapcar (lambda (dialect)
- (vector (symbol-name dialect)
- `(lambda () (interactive)
- (bibtex-set-dialect ',dialect))
- t))
- bibtex-dialect-list))))))))
+ nil t)) t))
+ (let ((setfun (if (or local (local-variable-p 'bibtex-dialect))
+ (lambda (var val) (set (make-local-variable var) val))
+ 'set)))
+ (if dialect (funcall setfun 'bibtex-dialect dialect))
+
+ ;; Set internal variables
+ (funcall setfun 'bibtex-entry-alist (bibtex-entry-alist bibtex-dialect))
+ (funcall setfun 'bibtex-field-alist
+ (let ((var (intern (format "bibtex-%s-field-alist"
+ bibtex-dialect))))
+ (if (boundp var)
+ (symbol-value var)
+ (error "Field types for BibTeX dialect `%s' undefined"
+ bibtex-dialect))))
+ (funcall setfun 'bibtex-entry-type
+ (concat "@[ \t]*\\(?:"
+ (regexp-opt (mapcar 'car bibtex-entry-alist)) "\\)"))
+ (funcall setfun 'bibtex-entry-head
+ (concat "^[ \t]*\\(" bibtex-entry-type "\\)[ \t]*[({][ \t\n]*\\("
+ bibtex-reference-key "\\)"))
+ (funcall setfun 'bibtex-entry-maybe-empty-head
+ (concat bibtex-entry-head "?"))
+ (funcall setfun 'bibtex-any-valid-entry-type
+ (concat "^[ \t]*@[ \t]*\\(?:"
+ (regexp-opt
+ (append '("String" "Preamble")
+ (mapcar 'car bibtex-entry-alist))) "\\)"))))
+
+;; Entry commands and menus for BibTeX dialects
+;; We do not use `easy-menu-define' here because this gets confused
+;; if we want to have multiple versions of the "same" menu.
+(let ((select-map (make-sparse-keymap)))
+ ;; Submenu for selecting the dialect
+ (dolist (dialect (reverse bibtex-dialect-list))
+ (define-key select-map (vector dialect)
+ `(menu-item ,(symbol-name dialect)
+ (lambda () (interactive) (bibtex-set-dialect ',dialect t))
+ :button (:radio . (eq bibtex-dialect ',dialect)))))
+ ;; We define a menu for each dialect.
+ ;; Then we select the menu we want via the :visible keyword
+ (dolist (dialect bibtex-dialect-list)
+ (let ((entry-alist (bibtex-entry-alist dialect))
+ (menu-map (make-sparse-keymap)))
+ (define-key menu-map [select]
+ `(menu-item "BibTeX dialect" ,select-map))
+ (define-key menu-map [nil-2] '(menu-item "--"))
+ (define-key menu-map [bibtex-preamble]
+ '(menu-item "Preamble" bibtex-Preamble))
+ (define-key menu-map [bibtex-String]
+ '(menu-item "String" bibtex-String))
+ (define-key menu-map [nil-1] '(menu-item "--"))
+ (dolist (elt (reverse entry-alist))
+ ;; Entry commands
+ (let* ((entry (car elt))
+ (fname (intern (format "bibtex-%s" entry))))
+ (unless (fboundp fname)
+ (eval (list 'defun fname nil
+ (format "Insert a template for a @%s entry; see also `bibtex-entry'."
+ entry)
+ '(interactive "*")
+ `(bibtex-entry ,entry))))
+ ;; Menu entries
+ (define-key menu-map (vector fname)
+ `(menu-item ,(or (nth 1 elt) (car elt)) ,fname))))
+ (define-key bibtex-mode-map
+ (vector 'menu-bar dialect)
+ `(menu-item "Entry-Types" ,menu-map
+ :visible (eq bibtex-dialect ',dialect))))))
(defun bibtex-field-list (entry-type)
"Return list of allowed fields for entry ENTRY-TYPE.
@@ -3505,7 +3546,7 @@ and `bibtex-user-optional-fields'."
(cons required optional)))
(defun bibtex-entry (entry-type)
- "Insert a new BibTeX entry of type ENTRY-TYPE.
+ "Insert a template for a BibTeX entry of type ENTRY-TYPE.
After insertion call the value of `bibtex-add-entry-hook' if that value
is non-nil."
(interactive
@@ -4853,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.
@@ -5140,7 +5182,7 @@ Return the URL or nil if none can be generated."
(message "No URL known."))
url)))
-;; We could combine multiple seach results with set operations
+;; We could combine multiple search results with set operations
;; AND, OR, MINUS, and NOT. Would this be useful?
;; How complicated are searches in real life?
;; We could also have other searches such as "publication year newer than...".
diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el
index 40d682c3d93..4cd36cfe7ca 100644
--- a/lisp/textmodes/conf-mode.el
+++ b/lisp/textmodes/conf-mode.el
@@ -1,6 +1,6 @@
;;; conf-mode.el --- Simple major mode for editing conf/ini/properties files
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: conf ini windows java
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index d98aa183f21..d50aadef25b 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1,6 +1,6 @@
;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: hypermedia
@@ -37,7 +37,6 @@
"Cascading Style Sheets (CSS) editing mode."
:group 'languages)
-(eval-when-compile (require 'cl))
(defun css-extract-keyword-list (res)
(with-temp-buffer
diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el
index 0d5d28f8e5d..ee293a0f243 100644
--- a/lisp/textmodes/dns-mode.el
+++ b/lisp/textmodes/dns-mode.el
@@ -1,6 +1,6 @@
;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files
-;; Copyright (C) 2000-2001, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2001, 2004-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: DNS master zone file SOA comm
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index 357b9d6c94e..a28fcfc7e4b 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -1,6 +1,6 @@
;;; enriched.el --- read and save files in text/enriched format
-;; Copyright (C) 1994-1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: wp, faces
@@ -191,6 +191,11 @@ The value is a list of \(VAR VALUE VAR VALUE...).")
"Minor mode for editing text/enriched files.
These are files with embedded formatting information in the MIME standard
text/enriched format.
+
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
+
Turning the mode on or off runs `enriched-mode-hook'.
More information about Enriched mode is available in the file
@@ -432,7 +437,7 @@ Return value is \(begin end name positive-p), or nil if none was found."
(progn (goto-char (match-beginning 0))
(not (looking-at enriched-annotation-regexp))))
(forward-char 1)
- (if (= ?< (char-after (point)))
+ (if (eq ?< (char-after (point)))
(delete-char 1)
;; A single < that does not start an annotation is an error,
;; which we note and then ignore.
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 610b0c71357..d0e90c99516 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -1,6 +1,6 @@
;;; fill.el --- fill commands for Emacs -*- coding: utf-8 -*-
-;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2011
+;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -93,6 +93,7 @@ reinserts the fill prefix in each resulting line."
;; Added `!' for doxygen comments starting with `//!' or `/*!'.
;; Added `%' for TeX comments.
;; RMS: deleted the code to match `1.' and `(1)'.
+ ;; Update mail-mode's paragraph-separate if you change this.
(purecopy "[ \t]*\\([-–!|#%;>*·•‣⁃◦]+[ \t]*\\)*")
"Regexp to match text at start of line that constitutes indentation.
If Adaptive Fill mode is enabled, a prefix matching this pattern
@@ -1010,7 +1011,8 @@ space does not end a sentence, so don't break a line there."
(if current-prefix-arg 'full))))
(unless (memq justify '(t nil none full center left right))
(setq justify 'full))
- (let (max beg fill-pfx)
+ (let ((start-point (point-marker))
+ max beg fill-pfx)
(goto-char (max from to))
(when to-eop
(skip-chars-backward "\n")
@@ -1041,6 +1043,8 @@ space does not end a sentence, so don't break a line there."
(setq fill-pfx
(fill-region-as-paragraph (point) end justify nosqueeze))
(goto-char end))))
+ (goto-char start-point)
+ (set-marker start-point nil)
fill-pfx))
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 6b4c1a2940d..42f0418b690 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -1,6 +1,6 @@
;;; flyspell.el --- on-the-fly spell checker
-;; Copyright (C) 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr>
;; Maintainer: FSF
@@ -143,10 +143,9 @@ whose length is specified by `flyspell-delay'."
:type '(repeat (symbol)))
(defcustom flyspell-default-deplacement-commands
- '(next-line
- previous-line
- scroll-up
- scroll-down)
+ '(next-line previous-line
+ handle-switch-frame handle-select-window
+ scroll-up scroll-down)
"The standard list of deplacement commands for Flyspell.
See `flyspell-deplacement-commands'."
:group 'flyspell
@@ -233,8 +232,8 @@ URL `http://www.gnu.org/software/auctex/'"
:type 'boolean)
(defcustom flyspell-mode-line-string " Fly"
- "String displayed on the modeline when flyspell is active.
-Set this to nil if you don't want a modeline indicator."
+ "String displayed on the mode line when flyspell is active.
+Set this to nil if you don't want a mode line indicator."
:group 'flyspell
:type '(choice string (const :tag "None" nil)))
@@ -291,9 +290,9 @@ If this variable is nil, all regions are treated as small."
;;* Mode specific options enable users to disable flyspell on */
;;* certain word depending of the emacs mode. For instance, when */
;;* using flyspell with mail-mode add the following expression */
-;;* in your .emacs file: */
+;;* in your init file: */
;;* (add-hook 'mail-mode */
-;;* (lambda () (setq flyspell-generic-check-word-predicate */
+;;* (lambda () (setq flyspell-generic-check-word-predicate */
;;* 'mail-mode-flyspell-verify))) */
;;*---------------------------------------------------------------------*/
(defvar flyspell-generic-check-word-predicate nil
@@ -436,7 +435,7 @@ like <img alt=\"Some thing.\">."
;; dash character machinery
(defvar flyspell-consider-dash-as-word-delimiter-flag nil
- "*Non-nil means that the `-' char is considered as a word delimiter.")
+ "Non-nil means that the `-' char is considered as a word delimiter.")
(make-variable-buffer-local 'flyspell-consider-dash-as-word-delimiter-flag)
(defvar flyspell-dash-dictionary nil)
(make-variable-buffer-local 'flyspell-dash-dictionary)
@@ -446,20 +445,14 @@ like <img alt=\"Some thing.\">."
;;*---------------------------------------------------------------------*/
;;* Highlighting */
;;*---------------------------------------------------------------------*/
-(defface flyspell-incorrect
- '((((class color)) (:foreground "OrangeRed" :bold t :underline t))
- (t (:bold t)))
- "Face used for marking a misspelled word in Flyspell."
+(defface flyspell-incorrect '((t :underline t :inherit error))
+ "Flyspell face for misspelled words."
:group 'flyspell)
-(define-obsolete-face-alias 'flyspell-incorrect-face 'flyspell-incorrect "22.1")
-(defface flyspell-duplicate
- '((((class color)) (:foreground "Gold3" :bold t :underline t))
- (t (:bold t)))
- "Face used for marking a misspelled word that appears twice in the buffer.
+(defface flyspell-duplicate '((t :underline t :inherit warning))
+ "Flyspell face for words that appear twice in a row.
See also `flyspell-duplicate-distance'."
:group 'flyspell)
-(define-obsolete-face-alias 'flyspell-duplicate-face 'flyspell-duplicate "22.1")
(defvar flyspell-overlay nil)
@@ -495,7 +488,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."
@@ -616,7 +609,9 @@ in your .emacs file.
;; the welcome message
(if (and flyspell-issue-message-flag
flyspell-issue-welcome-flag
- (called-interactively-p 'interactive))
+ (if (featurep 'xemacs)
+ (interactive-p) ;; XEmacs does not have (called-interactively-p)
+ (called-interactively-p 'interactive)))
(let ((binding (where-is-internal 'flyspell-auto-correct-word
nil 'non-ascii)))
(message "%s"
@@ -631,7 +626,7 @@ in your .emacs file.
(defun flyspell-delay-commands ()
"Install the standard set of Flyspell delayed commands."
(mapc 'flyspell-delay-command flyspell-default-delayed-commands)
- (mapcar 'flyspell-delay-command flyspell-delayed-commands))
+ (mapc 'flyspell-delay-command flyspell-delayed-commands))
;;*---------------------------------------------------------------------*/
;;* flyspell-delay-command ... */
@@ -639,7 +634,7 @@ in your .emacs file.
(defun flyspell-delay-command (command)
"Set COMMAND to be delayed, for Flyspell.
When flyspell `post-command-hook' is invoked because a delayed command
-as been used the current word is not immediately checked.
+has been used, the current word is not immediately checked.
It will be checked only after `flyspell-delay' seconds."
(interactive "SDelay Flyspell after Command: ")
(put command 'flyspell-delayed t))
@@ -650,16 +645,15 @@ It will be checked only after `flyspell-delay' seconds."
(defun flyspell-deplacement-commands ()
"Install the standard set of Flyspell deplacement commands."
(mapc 'flyspell-deplacement-command flyspell-default-deplacement-commands)
- (mapcar 'flyspell-deplacement-command flyspell-deplacement-commands))
+ (mapc 'flyspell-deplacement-command flyspell-deplacement-commands))
;;*---------------------------------------------------------------------*/
;;* flyspell-deplacement-command ... */
;;*---------------------------------------------------------------------*/
(defun flyspell-deplacement-command (command)
"Set COMMAND that implement cursor movements, for Flyspell.
-When flyspell `post-command-hook' is invoked because of a deplacement command
-as been used the current word is checked only if the previous command was
-not the very same deplacement command."
+When flyspell `post-command-hook' is invoked because a deplacement command
+has been used, the current word is not checked."
(interactive "SDeplacement Flyspell after Command: ")
(put command 'flyspell-deplacement t))
@@ -680,12 +674,12 @@ not the very same deplacement command."
;;* post command hook, we will check, if the word at this position */
;;* has to be spell checked. */
;;*---------------------------------------------------------------------*/
-(defvar flyspell-pre-buffer nil)
-(defvar flyspell-pre-point nil)
-(defvar flyspell-pre-column nil)
+(defvar flyspell-pre-buffer nil "Buffer current before `this-command'.")
+(defvar flyspell-pre-point nil "Point before running `this-command'")
+(defvar flyspell-pre-column nil "Column before running `this-command'")
(defvar flyspell-pre-pre-buffer nil)
(defvar flyspell-pre-pre-point nil)
-(make-variable-buffer-local 'flyspell-pre-point)
+(make-variable-buffer-local 'flyspell-pre-point) ;Why?? --Stef
;;*---------------------------------------------------------------------*/
;;* flyspell-previous-command ... */
@@ -709,18 +703,18 @@ not the very same deplacement command."
;;;###autoload
(defun flyspell-mode-off ()
"Turn Flyspell mode off."
- ;; we remove the hooks
+ ;; We remove the hooks.
(remove-hook 'post-command-hook (function flyspell-post-command-hook) t)
(remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t)
(remove-hook 'after-change-functions 'flyspell-after-change-function t)
(remove-hook 'hack-local-variables-hook
(function flyspell-hack-local-variables-hook) t)
- ;; we remove all the flyspell highlightings
+ ;; We remove all the flyspell highlightings.
(flyspell-delete-all-overlays)
- ;; we have to erase pre cache variables
+ ;; We have to erase pre cache variables.
(setq flyspell-pre-buffer nil)
(setq flyspell-pre-point nil)
- ;; we mark the mode as killed
+ ;; We mark the mode as killed.
(setq flyspell-mode nil))
;;*---------------------------------------------------------------------*/
@@ -730,39 +724,49 @@ not the very same deplacement command."
"Return non-nil if we should check the word before point.
More precisely, it applies to the word that was before point
before the current command."
- (cond
- ((or (not (numberp flyspell-pre-point))
- (not (bufferp flyspell-pre-buffer))
- (not (buffer-live-p flyspell-pre-buffer)))
- nil)
- ((and (eq flyspell-pre-pre-point flyspell-pre-point)
- (eq flyspell-pre-pre-buffer flyspell-pre-buffer))
- nil)
- ((or (and (= flyspell-pre-point (- (point) 1))
- (eq (char-syntax (char-after flyspell-pre-point)) ?w))
- (= flyspell-pre-point (point))
- (= flyspell-pre-point (+ (point) 1)))
- nil)
- ((and (symbolp this-command)
- (not executing-kbd-macro)
- (or (get this-command 'flyspell-delayed)
- (and (get this-command 'flyspell-deplacement)
- (eq flyspell-previous-command this-command)))
- (or (= (current-column) 0)
- (= (current-column) flyspell-pre-column)
- ;; If other post-command-hooks change the buffer,
- ;; flyspell-pre-point can lie past eob (bug#468).
- (null (char-after flyspell-pre-point))
- (eq (char-syntax (char-after flyspell-pre-point)) ?w)))
- nil)
- ((not (eq (current-buffer) flyspell-pre-buffer))
- t)
- ((not (and (numberp flyspell-word-cache-start)
- (numberp flyspell-word-cache-end)))
- t)
- (t
- (or (< flyspell-pre-point flyspell-word-cache-start)
- (> flyspell-pre-point flyspell-word-cache-end)))))
+ (let ((ispell-otherchars (ispell-get-otherchars)))
+ (cond
+ ((not (and (numberp flyspell-pre-point)
+ (buffer-live-p flyspell-pre-buffer)))
+ nil)
+ ((and (eq flyspell-pre-pre-point flyspell-pre-point)
+ (eq flyspell-pre-pre-buffer flyspell-pre-buffer))
+ nil)
+ ((or (and (= flyspell-pre-point (- (point) 1))
+ (or (eq (char-syntax (char-after flyspell-pre-point)) ?w)
+ (and (not (string= "" ispell-otherchars))
+ (string-match
+ ispell-otherchars
+ (buffer-substring-no-properties
+ flyspell-pre-point (1+ flyspell-pre-point))))))
+ (= flyspell-pre-point (point))
+ (= flyspell-pre-point (+ (point) 1)))
+ nil)
+ ((and (symbolp this-command)
+ (not executing-kbd-macro)
+ (or (get this-command 'flyspell-delayed)
+ (and (get this-command 'flyspell-deplacement)
+ (eq flyspell-previous-command this-command)))
+ (or (= (current-column) 0)
+ (= (current-column) flyspell-pre-column)
+ ;; If other post-command-hooks change the buffer,
+ ;; flyspell-pre-point can lie past eob (bug#468).
+ (null (char-after flyspell-pre-point))
+ (or (eq (char-syntax (char-after flyspell-pre-point)) ?w)
+ (and (not (string= "" ispell-otherchars))
+ (string-match
+ ispell-otherchars
+ (buffer-substring-no-properties
+ flyspell-pre-point (1+ flyspell-pre-point)))))))
+ nil)
+ ((not (eq (current-buffer) flyspell-pre-buffer))
+ t)
+ ((not (and (numberp flyspell-word-cache-start)
+ (numberp flyspell-word-cache-end)))
+ t)
+ (t
+ (or (< flyspell-pre-point flyspell-word-cache-start)
+ (> flyspell-pre-point flyspell-word-cache-end))))))
;;*---------------------------------------------------------------------*/
;;* The flyspell after-change-hook, store the change position. In */
@@ -783,21 +787,15 @@ before the current command."
;;* flyspell-check-changed-word-p ... */
;;*---------------------------------------------------------------------*/
(defun flyspell-check-changed-word-p (start stop)
- "Return t when the changed word has to be checked.
+ "Return non-nil when the changed word has to be checked.
The answer depends of several criteria.
Mostly we check word delimiters."
- (cond
- ((and (memq (char-after start) '(?\n ? )) (> stop start))
- t)
- ((not (numberp flyspell-pre-point))
- t)
- ((and (>= flyspell-pre-point start) (<= flyspell-pre-point stop))
- nil)
- ((let ((pos (point)))
- (or (>= pos start) (<= pos stop) (= pos (1+ stop))))
- nil)
- (t
- t)))
+ (not (and (not (and (memq (char-after start) '(?\n ? )) (> stop start)))
+ (numberp flyspell-pre-point)
+ (or
+ (and (>= flyspell-pre-point start) (<= flyspell-pre-point stop))
+ (let ((pos (point)))
+ (or (>= pos start) (<= pos stop) (= pos (1+ stop))))))))
;;*---------------------------------------------------------------------*/
;;* flyspell-check-word-p ... */
@@ -806,30 +804,33 @@ Mostly we check word delimiters."
"Return t when the word at `point' has to be checked.
The answer depends of several criteria.
Mostly we check word delimiters."
- (cond
- ((<= (- (point-max) 1) (point-min))
- ;; the buffer is not filled enough
- nil)
- ((and (and (> (current-column) 0)
- (not (eq (current-column) flyspell-pre-column)))
- (save-excursion
- (backward-char 1)
- (and (looking-at (flyspell-get-not-casechars))
- (or flyspell-consider-dash-as-word-delimiter-flag
- (not (looking-at "-"))))))
- ;; yes because we have reached or typed a word delimiter.
- t)
- ((symbolp this-command)
+ (let ((ispell-otherchars (ispell-get-otherchars)))
(cond
- ((get this-command 'flyspell-deplacement)
- (not (eq flyspell-previous-command this-command)))
- ((get this-command 'flyspell-delayed)
- ;; the current command is not delayed, that
- ;; is that we must check the word now
- (and (not unread-command-events)
- (sit-for flyspell-delay)))
- (t t)))
- (t t)))
+ ((<= (- (point-max) 1) (point-min))
+ ;; The buffer is not filled enough.
+ nil)
+ ((and (and (> (current-column) 0)
+ (not (eq (current-column) flyspell-pre-column)))
+ (save-excursion
+ (backward-char 1)
+ (and (looking-at (flyspell-get-not-casechars))
+ (or (string= "" ispell-otherchars)
+ (not (looking-at ispell-otherchars)))
+ (or flyspell-consider-dash-as-word-delimiter-flag
+ (not (looking-at "-"))))))
+ ;; Yes because we have reached or typed a word delimiter.
+ t)
+ ((symbolp this-command)
+ (cond
+ ((get this-command 'flyspell-deplacement)
+ (not (eq flyspell-previous-command this-command)))
+ ((get this-command 'flyspell-delayed)
+ ;; The current command is not delayed, that
+ ;; is that we must check the word now.
+ (and (not unread-command-events)
+ (sit-for flyspell-delay)))
+ (t t)))
+ (t t))))
;;*---------------------------------------------------------------------*/
;;* flyspell-debug-signal-no-check ... */
@@ -859,52 +860,55 @@ Mostly we check word delimiters."
;;*---------------------------------------------------------------------*/
(defun flyspell-debug-signal-word-checked ()
(setq debug-on-error t)
- (let ((oldbuf (current-buffer))
+ (let ((ispell-otherchars (ispell-get-otherchars))
+ (oldbuf (current-buffer))
(point (point)))
(with-current-buffer (get-buffer-create "*flyspell-debug*")
- (insert "WORD:\n")
- (insert (format " this-cmd : %S\n" this-command))
- (insert (format " delayed : %S\n" (and (symbolp this-command)
- (get this-command 'flyspell-delayed))))
- (insert (format " point : %S\n" point))
- (insert (format " prev-char : [%c] %S\n"
- (with-current-buffer oldbuf
- (let ((c (if (> (point) (point-min))
- (save-excursion
- (backward-char 1)
- (char-after (point)))
- ? )))
- c))
- (with-current-buffer oldbuf
- (let ((c (if (> (point) (point-min))
- (save-excursion
- (backward-char 1)
- (and (and (looking-at (flyspell-get-not-casechars)) 1)
- (and (or flyspell-consider-dash-as-word-delimiter-flag
- (not (looking-at "\\-"))) 2))))))
- c))))
- (insert (format " because : %S\n"
- (cond
- ((not (and (symbolp this-command)
- (get this-command 'flyspell-delayed)))
- ;; the current command is not delayed, that
- ;; is that we must check the word now
- 'not-delayed)
- ((with-current-buffer oldbuf
- (let ((c (if (> (point) (point-min))
- (save-excursion
- (backward-char 1)
- (and (looking-at (flyspell-get-not-casechars))
- (or flyspell-consider-dash-as-word-delimiter-flag
- (not (looking-at "\\-"))))))))
- c))
- ;; yes because we have reached or typed a word delimiter.
- 'separator)
- ((not (integerp flyspell-delay))
- ;; yes because the user had set up a no-delay configuration.
- 'no-delay)
- (t
- 'sit-for))))
+ (insert
+ "WORD:\n"
+ (format " this-cmd : %S\n" this-command)
+ (format " delayed : %S\n" (and (symbolp this-command)
+ (get this-command
+ 'flyspell-delayed)))
+ (format " point : %S\n" point)
+ (format " prev-char : [%c] %S\n"
+ (with-current-buffer oldbuf
+ (if (bobp) ?\ (char-before)))
+ (with-current-buffer oldbuf
+ (if (bobp)
+ nil
+ (save-excursion
+ (backward-char 1)
+ (and (looking-at (flyspell-get-not-casechars))
+ (or (string= "" ispell-otherchars)
+ (not (looking-at ispell-otherchars)))
+ (or flyspell-consider-dash-as-word-delimiter-flag
+ (not (looking-at "\\-")))
+ 2)))))
+ (format " because : %S\n"
+ (cond
+ ((not (and (symbolp this-command)
+ (get this-command 'flyspell-delayed)))
+ ;; The current command is not delayed, that
+ ;; is that we must check the word now.
+ 'not-delayed)
+ ((with-current-buffer oldbuf
+ (if (bobp)
+ nil
+ (save-excursion
+ (backward-char 1)
+ (and (looking-at (flyspell-get-not-casechars))
+ (or (string= "" ispell-otherchars)
+ (not (looking-at ispell-otherchars)))
+ (or flyspell-consider-dash-as-word-delimiter-flag
+ (not (looking-at "\\-")))))))
+ ;; Yes because we have reached or typed a word delimiter.
+ 'separator)
+ ((not (integerp flyspell-delay))
+ ;; Yes because the user set up a no-delay configuration.
+ 'no-delay)
+ (t
+ 'sit-for))))
(goto-char (point-max)))))
;;*---------------------------------------------------------------------*/
@@ -927,7 +931,7 @@ Mostly we check word delimiters."
;;* 2- the word that used to be the current word before the */
;;* THIS-COMMAND is checked if: */
;;* a- the previous word is different from the current word */
-;;* b- the previous word as not just been checked by the */
+;;* b- the previous word has not just been checked by the */
;;* previous FLYSPELL-POST-COMMAND-HOOK */
;;* 3- the words changed by the THIS-COMMAND that are neither the */
;;* previous word nor the current word */
@@ -954,7 +958,7 @@ Mostly we check word delimiters."
;; we remember which word we have just checked.
;; this will be used next time we will check a word
;; to compare the next current word with the word
- ;; that as been registered in the pre-command-hook
+ ;; that has been registered in the pre-command-hook
;; that is these variables are used within the predicate
;; FLYSPELL-CHECK-PRE-WORD-P
(setq flyspell-pre-pre-buffer (current-buffer))
@@ -1104,7 +1108,9 @@ misspelling and skips redundant spell-checking step."
(ispell-send-string (concat "^" word "\n"))
;; we mark the ispell process so it can be killed
;; when emacs is exited without query
- (set-process-query-on-exit-flag ispell-process nil)
+ (if (featurep 'xemacs)
+ (process-kill-without-query ispell-process)
+ (set-process-query-on-exit-flag ispell-process nil))
;; Wait until ispell has processed word.
(while (progn
(accept-process-output ispell-process)
@@ -1221,63 +1227,8 @@ misspelling and skips redundant spell-checking step."
(>= (match-end 0) b))))))
(flyspell-math-tex-command-p)))
-;;*---------------------------------------------------------------------*/
-;;* flyspell-casechars-cache ... */
-;;*---------------------------------------------------------------------*/
-(defvar flyspell-casechars-cache nil)
-(defvar flyspell-ispell-casechars-cache nil)
-(make-variable-buffer-local 'flyspell-casechars-cache)
-(make-variable-buffer-local 'flyspell-ispell-casechars-cache)
-
-;;*---------------------------------------------------------------------*/
-;;* flyspell-get-casechars ... */
-;;*---------------------------------------------------------------------*/
-(defun flyspell-get-casechars ()
- "This function builds a string that is the regexp of word chars.
-In order to avoid one useless string construction,
-this function changes the last char of the `ispell-casechars' string."
- (let ((ispell-casechars (ispell-get-casechars)))
- (cond
- ((eq ispell-parser 'tex)
- (setq flyspell-ispell-casechars-cache ispell-casechars)
- (setq flyspell-casechars-cache
- (concat (substring ispell-casechars
- 0
- (- (length ispell-casechars) 1))
- "]"))
- flyspell-casechars-cache)
- (t
- (setq flyspell-ispell-casechars-cache ispell-casechars)
- (setq flyspell-casechars-cache ispell-casechars)
- flyspell-casechars-cache))))
-
-;;*---------------------------------------------------------------------*/
-;;* flyspell-get-not-casechars-cache ... */
-;;*---------------------------------------------------------------------*/
-(defvar flyspell-not-casechars-cache nil)
-(defvar flyspell-ispell-not-casechars-cache nil)
-(make-variable-buffer-local 'flyspell-not-casechars-cache)
-(make-variable-buffer-local 'flyspell-ispell-not-casechars-cache)
-
-;;*---------------------------------------------------------------------*/
-;;* flyspell-get-not-casechars ... */
-;;*---------------------------------------------------------------------*/
-(defun flyspell-get-not-casechars ()
- "This function builds a string that is the regexp of non-word chars."
- (let ((ispell-not-casechars (ispell-get-not-casechars)))
- (cond
- ((eq ispell-parser 'tex)
- (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
- (setq flyspell-not-casechars-cache
- (concat (substring ispell-not-casechars
- 0
- (- (length ispell-not-casechars) 1))
- "]"))
- flyspell-not-casechars-cache)
- (t
- (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
- (setq flyspell-not-casechars-cache ispell-not-casechars)
- flyspell-not-casechars-cache))))
+(defalias 'flyspell-get-casechars 'ispell-get-casechars)
+(defalias 'flyspell-get-not-casechars 'ispell-get-not-casechars)
;;*---------------------------------------------------------------------*/
;;* flyspell-get-word ... */
@@ -1414,7 +1365,7 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
(goto-char buffer-scan-pos)
(let ((keep t))
;; Iterate on string search until string is found as word,
- ;; not as substring
+ ;; not as substring.
(while keep
(if (search-forward word
flyspell-large-region-end t)
@@ -1430,13 +1381,14 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
(when (or
;; Size matches, we really found it.
(= found-length misspell-length)
- ;; Matches as part of a boundary-char separated word
+ ;; Matches as part of a boundary-char separated
+ ;; word.
(member word
(split-string found ispell-otherchars))
;; Misspelling has higher length than
- ;; what flyspell considers the
- ;; word. Caused by boundary-chars
- ;; mismatch. Validating seems safe.
+ ;; what flyspell considers the word.
+ ;; Caused by boundary-chars mismatch.
+ ;; Validating seems safe.
(< found-length misspell-length)
;; ispell treats beginning of some TeX
;; commands as nroff control sequences
@@ -1479,7 +1431,8 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
;;* declared correct. */
;;*---------------------------------------------------------------------*/
(defun flyspell-process-localwords (misspellings-buffer)
- (let (localwords case-fold-search
+ (let ((localwords ispell-buffer-session-localwords)
+ case-fold-search
(ispell-casechars (ispell-get-casechars)))
;; Get localwords from the original buffer
(save-excursion
@@ -1576,10 +1529,11 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
(if ispell-encoding8-command
(setq args
(append args
- (list
- (concat ispell-encoding8-command
- (symbol-name
- encoding))))))
+ (if ispell-really-hunspell
+ (list ispell-encoding8-command
+ (upcase (symbol-name encoding)))
+ (list (concat ispell-encoding8-command
+ (symbol-name encoding)))))))
(let ((process-coding-system-alist (list (cons "\\.*" encoding))))
(setq c (apply 'ispell-call-process-region beg
@@ -1690,12 +1644,19 @@ FLYSPELL-BUFFER."
;;*---------------------------------------------------------------------*/
(defun flyspell-delete-region-overlays (beg end)
"Delete overlays used by flyspell in a given region."
- (remove-overlays beg end 'flyspell-overlay t))
-
+ (if (featurep 'emacs)
+ (remove-overlays beg end 'flyspell-overlay t)
+ ;; XEmacs does not have `remove-overlays'
+ (let ((l (overlays-in beg end)))
+ (while (consp l)
+ (progn
+ (if (flyspell-overlay-p (car l))
+ (delete-overlay (car l)))
+ (setq l (cdr l)))))))
(defun flyspell-delete-all-overlays ()
"Delete all the overlays used by flyspell."
- (remove-overlays (point-min) (point-max) 'flyspell-overlay t))
+ (flyspell-delete-region-overlays (point-min) (point-max)))
;;*---------------------------------------------------------------------*/
;;* flyspell-unhighlight-at ... */
@@ -1899,11 +1860,11 @@ This command proposes various successive corrections for the current word."
(interactive)
(let ((pos (point))
(old-max (point-max)))
- ;; use the correct dictionary
+ ;; Use the correct dictionary.
(flyspell-accept-buffer-local-defs)
(if (and (eq flyspell-auto-correct-pos pos)
(consp flyspell-auto-correct-region))
- ;; we have already been using the function at the same location
+ ;; We have already been using the function at the same location.
(let* ((start (car flyspell-auto-correct-region))
(len (cdr flyspell-auto-correct-region)))
(flyspell-unhighlight-at start)
@@ -1925,7 +1886,7 @@ This command proposes various successive corrections for the current word."
(flyspell-display-next-corrections flyspell-auto-correct-ring))
(flyspell-ajust-cursor-point pos (point) old-max)
(setq flyspell-auto-correct-pos (point)))
- ;; fetch the word to be checked
+ ;; Fetch the word to be checked.
(let ((word (flyspell-get-word)))
(if (consp word)
(let ((start (car (cdr word)))
@@ -1933,30 +1894,30 @@ This command proposes various successive corrections for the current word."
(word (car word))
poss ispell-filter)
(setq flyspell-auto-correct-word word)
- ;; now check spelling of word.
- (ispell-send-string "%\n") ;put in verbose mode
+ ;; Now check spelling of word..
+ (ispell-send-string "%\n") ;Put in verbose mode.
(ispell-send-string (concat "^" word "\n"))
- ;; wait until ispell has processed word.
+ ;; Wait until ispell has processed word.
(while (progn
(accept-process-output ispell-process)
(not (string= "" (car ispell-filter)))))
- ;; Remove leading empty element
+ ;; Remove leading empty element.
(setq ispell-filter (cdr ispell-filter))
- ;; ispell process should return something after word is sent.
- ;; Tag word as valid (i.e., skip) otherwise
+ ;; Ispell process should return something after word is sent.
+ ;; Tag word as valid (i.e., skip) otherwise.
(or ispell-filter
(setq ispell-filter '(*)))
(if (consp ispell-filter)
(setq poss (ispell-parse-output (car ispell-filter))))
(cond
((or (eq poss t) (stringp poss))
- ;; don't correct word
+ ;; Don't correct word.
t)
((null poss)
- ;; ispell error
+ ;; Ispell error.
(error "Ispell: error in Ispell process"))
(t
- ;; the word is incorrect, we have to propose a replacement
+ ;; The word is incorrect, we have to propose a replacement.
(let ((replacements (if flyspell-sort-corrections
(sort (car (cdr (cdr poss))) 'string<)
(car (cdr (cdr poss))))))
@@ -2146,6 +2107,9 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement."
(setq ispell-pdict-modified-p '(t)))
((or (eq replace 'buffer) (eq replace 'session))
(ispell-send-string (concat "@" word "\n"))
+ (add-to-list 'ispell-buffer-session-localwords word)
+ (or ispell-buffer-local-name ; session localwords might conflict
+ (setq ispell-buffer-local-name (buffer-name)))
(flyspell-unhighlight-at cursor-location)
(if (null ispell-pdict-modified-p)
(setq ispell-pdict-modified-p
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index ba7b84fe1dd..f667525397c 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1,6 +1,6 @@
;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2
-;; Copyright (C) 1994-1995, 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997-2012 Free Software Foundation, Inc.
;; Author: Ken Stevens <k.stevens@ieee.org>
;; Maintainer: Ken Stevens <k.stevens@ieee.org>
@@ -254,6 +254,10 @@ full featured `looking-back' function is missing."
(save-excursion
(re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
+;;; XEmacs21 does not have `with-no-warnings'. Taken from org mode.
+(defmacro ispell-with-no-warnings (&rest body)
+ (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body))
+
;;; Code:
(defvar mail-yank-prefix)
@@ -277,13 +281,13 @@ full featured `looking-back' function is missing."
;;; ******* THIS FILE IS WRITTEN FOR ISPELL VERSION 3.1+
(defcustom ispell-highlight-p 'block
- "*Highlight spelling errors when non-nil.
+ "Highlight spelling errors when non-nil.
When set to `block', assumes a block cursor with TTY displays."
:type '(choice (const block) (const :tag "off" nil) (const :tag "on" t))
:group 'ispell)
(defcustom ispell-lazy-highlight (boundp 'lazy-highlight-cleanup)
- "*Controls the lazy-highlighting of spelling errors.
+ "Controls the lazy-highlighting of spelling errors.
When non-nil, all text in the buffer matching the current spelling
error is highlighted lazily using isearch lazy highlighting (see
`lazy-highlight-initial-delay' and `lazy-highlight-interval')."
@@ -293,9 +297,7 @@ error is highlighted lazily using isearch lazy highlighting (see
:version "22.1")
(defcustom ispell-highlight-face (if ispell-lazy-highlight 'isearch 'highlight)
- "*The face used for Ispell highlighting. For Emacsen with overlays.
-Possible values are `highlight', `modeline', `secondary-selection',
-`region', and `underline'.
+ "Face used for Ispell highlighting.
This variable can be set by the user to whatever face they desire.
It's most convenient if the cursor color and highlight color are
slightly different."
@@ -303,7 +305,7 @@ slightly different."
:group 'ispell)
(defcustom ispell-check-comments t
- "*Spelling of comments checked when non-nil.
+ "Spelling of comments checked when non-nil.
When set to `exclusive', ONLY comments are checked. (For code comments).
Warning! Not checking comments, when a comment start is embedded in strings,
may produce undesired results."
@@ -314,19 +316,19 @@ may produce undesired results."
(lambda (a) (memq a '(nil t exclusive))))
(defcustom ispell-query-replace-choices nil
- "*Corrections made throughout region when non-nil.
+ "Corrections made throughout region when non-nil.
Uses `query-replace' (\\[query-replace]) for corrections."
:type 'boolean
:group 'ispell)
(defcustom ispell-skip-tib nil
- "*Does not spell check `tib' bibliography references when non-nil.
+ "Does not spell check `tib' bibliography references when non-nil.
Skips any text between strings matching regular expressions
`ispell-tib-ref-beginning' and `ispell-tib-ref-end'.
-TeX users beware: Any field starting with [. will skip until a .] -- even
-your whole buffer -- unless you set `ispell-skip-tib' to nil. That includes
-a [.5mm] type of number...."
+TeX users beware: Any text between [. and .] will be skipped -- even if
+that's your whole buffer -- unless you set `ispell-skip-tib' to nil.
+That includes the [.5mm] type of number..."
:type 'boolean
:group 'ispell)
@@ -337,24 +339,28 @@ a [.5mm] type of number...."
"Regexp matching the end of a Tib reference.")
(defcustom ispell-keep-choices-win t
- "*When non-nil, the `*Choices*' window remains for spelling session.
+ "If non-nil, keep the `*Choices*' window for the entire spelling session.
This minimizes redisplay thrashing."
:type 'boolean
:group 'ispell)
(defcustom ispell-choices-win-default-height 2
- "*The default size of the `*Choices*' window, including mode line.
+ "The default size of the `*Choices*' window, including the mode line.
Must be greater than 1."
:type 'integer
:group 'ispell)
(defcustom ispell-program-name
- (or (locate-file "aspell" exec-path exec-suffixes 'file-executable-p)
- (locate-file "ispell" exec-path exec-suffixes 'file-executable-p)
- (locate-file "hunspell" exec-path exec-suffixes 'file-executable-p)
+ (or (executable-find "aspell")
+ (executable-find "ispell")
+ (executable-find "hunspell")
"ispell")
"Program invoked by \\[ispell-word] and \\[ispell-region] commands."
:type 'string
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (if (featurep 'ispell)
+ (ispell-set-spellchecker-params)))
:group 'ispell)
(defcustom ispell-alternate-dictionary
@@ -366,18 +372,18 @@ Must be greater than 1."
((file-readable-p "/usr/share/lib/dict/words")
"/usr/share/lib/dict/words")
((file-readable-p "/sys/dict") "/sys/dict"))
- "*Alternate plain word-list dictionary for spelling help."
+ "Alternate plain word-list dictionary for spelling help."
:type '(choice file (const :tag "None" nil))
:group 'ispell)
(defcustom ispell-complete-word-dict nil
- "*Plain word-list dictionary used for word completion if
+ "Plain word-list dictionary used for word completion if
different from `ispell-alternate-dictionary'."
:type '(choice file (const :tag "None" nil))
:group 'ispell)
(defcustom ispell-message-dictionary-alist nil
- "*List used by `ispell-message' to select a new dictionary.
+ "List used by `ispell-message' to select a new dictionary.
It consists of pairs (REGEXP . DICTIONARY). If REGEXP is found
in the message headers, `ispell-local-dictionary' will be set to
DICTIONARY if `ispell-local-dictionary' is not buffer-local.
@@ -389,7 +395,7 @@ E.g. you may use the following value:
(defcustom ispell-message-fcc-skip 50000
- "*Query before saving Fcc message copy if attachment larger than this value.
+ "Query before saving Fcc message copy if attachment larger than this value.
Always stores Fcc copy of message when nil."
:type '(choice integer (const :tag "off" nil))
:group 'ispell)
@@ -423,13 +429,13 @@ This must be an absolute file name."
:group 'ispell)
(defcustom ispell-look-p (file-exists-p ispell-look-command)
- "*Non-nil means use `look' rather than `grep'.
+ "Non-nil means use `look' rather than `grep'.
Default is based on whether `look' seems to be available."
:type 'boolean
:group 'ispell)
(defcustom ispell-have-new-look nil
- "*Non-nil means use the `-r' option (regexp) when running `look'."
+ "Non-nil means use the `-r' option (regexp) when running `look'."
:type 'boolean
:group 'ispell)
@@ -445,13 +451,13 @@ When nil, Emacs uses pipes."
:group 'ispell)
(defcustom ispell-following-word nil
- "*Non-nil means `ispell-word' checks the word around or after point.
+ "Non-nil means `ispell-word' checks the word around or after point.
Otherwise `ispell-word' checks the preceding word."
:type 'boolean
:group 'ispell)
(defcustom ispell-help-in-bufferp nil
- "*Non-nil means display interactive keymap help in a buffer.
+ "Non-nil means display interactive keymap help in a buffer.
The following values are supported:
nil Expand the minibuffer and display a short help message
there for a couple of seconds.
@@ -463,12 +469,12 @@ The following values are supported:
:group 'ispell)
(defcustom ispell-quietly nil
- "*Non-nil means suppress messages in `ispell-word'."
+ "Non-nil means suppress messages in `ispell-word'."
:type 'boolean
:group 'ispell)
(defcustom ispell-format-word-function (function upcase)
- "*Formatting function for displaying word being spell checked.
+ "Formatting function for displaying word being spell checked.
The function must take one string argument and return a string."
:type 'function
:group 'ispell)
@@ -484,7 +490,7 @@ window system by evaluating the following on startup to set this variable:
;;;###autoload
(defcustom ispell-personal-dictionary nil
- "*File name of your personal spelling dictionary, or nil.
+ "File name of your personal spelling dictionary, or nil.
If nil, the default personal dictionary, (\"~/.ispell_DICTNAME\" for ispell or
\"~/.aspell.LANG.pws\" for aspell) is used, where DICTNAME is the name of your
default dictionary and LANG the two letter language code."
@@ -493,7 +499,7 @@ default dictionary and LANG the two letter language code."
:group 'ispell)
(defcustom ispell-silently-savep nil
- "*When non-nil, save the personal dictionary without confirmation."
+ "When non-nil, save personal dictionary without asking for confirmation."
:type 'boolean
:group 'ispell)
@@ -527,7 +533,7 @@ is automatically set when defined in the file with either
:group 'ispell)
(defcustom ispell-extra-args nil
- "*If non-nil, a list of extra switches to pass to the Ispell program.
+ "If non-nil, a list of extra switches to pass to the Ispell program.
For example, (\"-W\" \"3\") to cause it to accept all 1-3 character
words as correct. See also `ispell-dictionary-alist', which may be used
for language-specific arguments."
@@ -537,7 +543,7 @@ for language-specific arguments."
(defcustom ispell-skip-html 'use-mode-name
- "*Indicates whether ispell should skip spell checking of SGML markup.
+ "Indicates whether ispell should skip spell checking of SGML markup.
If t, always skip SGML markup; if nil, never skip; if non-t and non-nil,
guess whether SGML markup should be skipped according to the name of the
buffer's major mode."
@@ -549,7 +555,7 @@ buffer's major mode."
(defcustom ispell-local-dictionary-alist nil
- "*List of local or customized dictionary definitions.
+ "List of local or customized dictionary definitions.
These can override the values in `ispell-dictionary-alist'.
To make permanent changes to your dictionary definitions, you
@@ -574,12 +580,12 @@ re-start Emacs."
(defvar ispell-dictionary-base-alist
- '((nil
+ '((nil ; default
;; The default dictionary. It may be English.aff, or any other
;; dictionary depending on locale and such things. We should probably
;; ask ispell what dictionary it's using, but until we do that, let's
- ;; just use an approximate regexp.
- "[[:alpha:]]" "[^[:alpha:]]" "[']" nil ("-B") nil iso-8859-1)
+ ;; just use a minimal regexp. [:alpha:] will later be set if possible.
+ "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1)
("american" ; Yankee English
"[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1)
("brasileiro" ; Brazilian mode
@@ -684,7 +690,8 @@ re-start Emacs."
("svenska" ; Swedish mode
"[A-Za-z\345\344\366\351\340\374\350\346\370\347\305\304\326\311\300\334\310\306\330\307]"
"[^A-Za-z\345\344\366\351\340\374\350\346\370\347\305\304\326\311\300\334\310\306\330\307]"
- "[']" nil ("-C") "~list" iso-8859-1))
+ "[']" nil ("-C") "~list" iso-8859-1)
+ ("hebrew" "[\340\341\342\343\344\345\346\347\350\351\353\352\354\356\355\360\357\361\362\364\363\367\366\365\370\371\372]" "[^\340\341\342\343\344\345\346\347\350\351\353\352\354\356\355\360\357\361\362\364\363\367\366\365\370\371\372]" "" nil ("-B") nil cp1255))
"Base value for `ispell-dictionary-alist'.")
(defvar ispell-dictionary-alist nil
@@ -714,7 +721,7 @@ Hint: regexp syntax requires the hyphen to be declared first here.
CASECHARS, NOT-CASECHARS, and OTHERCHARS must be unibyte strings
containing bytes of CHARACTER-SET. In addition, if they contain
-a non-ASCII byte, the regular expression must be a single
+non-ASCII bytes, the regular expression must be a single
`character set' construct that doesn't specify a character range
for non-ASCII bytes.
@@ -734,27 +741,31 @@ but the dictionary can control the extended character mode.
Both defaults can be overruled in a buffer-local fashion. See
`ispell-parsing-keyword' for details on this.
-CHARACTER-SET used for languages with multibyte characters.
+CHARACTER-SET used to encode text sent to the ispell subprocess
+when the language uses non-ASCII characters.
-Note that the CASECHARS and OTHERCHARS slots of the alist should
-contain the same character set as casechars and otherchars in the
-LANGUAGE.aff file \(e.g., english.aff\).")
+Note that with \"ispell\" as the speller, the CASECHARS and
+OTHERCHARS slots of the alist should contain the same character
+set as casechars and otherchars in the LANGUAGE.aff file \(e.g.,
+english.aff\). aspell and hunspell don't have this limitation.")
(defvar ispell-really-aspell nil) ; Non-nil if we can use aspell extensions.
(defvar ispell-really-hunspell nil) ; Non-nil if we can use hunspell extensions.
(defvar ispell-encoding8-command nil
- "Command line option prefix to select UTF-8 if supported, nil otherwise.
-If UTF-8 if supported by spellchecker and is selectable from the command line
-this variable will contain \"--encoding=\" for aspell and \"-i \" for hunspell,
-so UTF-8 or other mime charsets can be selected. That will be set for hunspell
->=1.1.6 or aspell >= 0.60 in `ispell-check-version'.
-
-For aspell non-nil means to try to automatically find aspell dictionaries.
-Earlier aspell versions do not consistently support UTF-8. Handling
+ "Command line option prefix to select encoding if supported, nil otherwise.
+If setting the encoding is supported by spellchecker and is selectable from
+the command line, this variable will contain \"--encoding=\" for aspell
+and \"-i \" for hunspell, so the appropriate mime charset can be selected.
+That will be set in `ispell-check-version' for hunspell >= 1.1.6 and
+aspell >= 0.60.
+
+For aspell, non-nil also means to try to automatically find its dictionaries.
+
+Earlier aspell versions do not consistently support charset encoding. Handling
this would require some extra guessing in `ispell-aspell-find-dictionary'.")
(defvar ispell-aspell-supports-utf8 nil
- "Non nil if aspell has consistent command line UTF-8 support. Obsolete.
+ "Non-nil if aspell has consistent command line UTF-8 support. Obsolete.
ispell.el and flyspell.el will use for this purpose the more generic
variable `ispell-encoding8-command' for both aspell and hunspell. Is left
here just for backwards compatibility.")
@@ -762,6 +773,12 @@ here just for backwards compatibility.")
(make-obsolete-variable 'ispell-aspell-supports-utf8
'ispell-encoding8-command "23.1")
+(defvar ispell-emacs-alpha-regexp
+ (if (string-match "^[[:alpha:]]+$" "abcde")
+ "[[:alpha:]]"
+ nil)
+ "[[:alpha:]] if Emacs supports [:alpha:] regexp, nil
+otherwise (current XEmacs does not support it).")
;;; **********************************************************************
;;; The following are used by ispell, and should not be changed.
@@ -780,7 +797,7 @@ here just for backwards compatibility.")
(defun ispell-check-version (&optional interactivep)
- "Ensure that `ispell-program-name' is valid and the correct version.
+ "Ensure that `ispell-program-name' is valid and has the correct version.
Returns version number if called interactively.
Otherwise returns the library directory name, if that is defined."
;; This is a little wasteful as we actually launch ispell twice: once
@@ -870,7 +887,7 @@ Otherwise returns the library directory name, if that is defined."
(setq ispell-really-aspell nil)))
(ispell-really-hunspell
(if (ispell-check-minver hunspell8-minver ispell-really-hunspell)
- (setq ispell-encoding8-command "-i ")
+ (setq ispell-encoding8-command "-i")
(setq ispell-really-hunspell nil))))))
result))
@@ -890,6 +907,24 @@ Otherwise returns the library directory name, if that is defined."
(setq default-directory (expand-file-name "~/")))
(apply 'call-process-region args)))
+(defun ispell-create-debug-buffer (&optional append)
+ "Create an ispell debug buffer for debugging output.
+Use APPEND to append the info to previous buffer if exists,
+otherwise is reset. Returns name of ispell debug buffer.
+See `ispell-buffer-with-debug' for an example of use."
+ (let ((ispell-debug-buffer (get-buffer-create "*ispell-debug*")))
+ (with-current-buffer ispell-debug-buffer
+ (if append
+ (insert
+ (format "-----------------------------------------------\n"))
+ (erase-buffer)))
+ ispell-debug-buffer))
+
+(defsubst ispell-print-if-debug (string)
+ "Print STRING to `ispell-debug-buffer' buffer if enabled."
+ (if (boundp 'ispell-debug-buffer)
+ (with-current-buffer ispell-debug-buffer
+ (insert string))))
;; The preparation of the menu bar menu must be autoloaded
@@ -898,7 +933,7 @@ Otherwise returns the library directory name, if that is defined."
;;;###autoload
(defvar ispell-menu-map nil "Key map for ispell menu.")
-;;; redo menu when loading ispell to get dictionary modifications
+;; Redo menu when loading ispell to get dictionary modifications
(setq ispell-menu-map nil)
;;;###autoload
@@ -957,9 +992,9 @@ Internal use.")
;; Ensure aspell's alias dictionary will override standard
;; definitions.
(setq found (ispell-aspell-add-aliases found))
- ;; Merge into FOUND any elements from the standard ispell-dictionary-alist
+ ;; Merge into FOUND any elements from the standard ispell-dictionary-base-alist
;; which have no element in FOUND at all.
- (dolist (dict ispell-dictionary-alist)
+ (dolist (dict ispell-dictionary-base-alist)
(unless (assoc (car dict) found)
(setq found (nconc found (list dict)))))
(setq ispell-aspell-dictionary-alist found)
@@ -983,8 +1018,8 @@ Assumes that value contains no whitespace."
(defun ispell-aspell-find-dictionary (dict-name)
"For aspell dictionary DICT-NAME, return a list of parameters if an
- associated data file is found or nil otherwise. List format is
- that of `ispell-dictionary-base-alist' elements."
+associated data file is found or nil otherwise. List format is that
+of `ispell-dictionary-base-alist' elements."
;; Make sure `ispell-aspell-data-dir' is defined
(or ispell-aspell-data-dir
(setq ispell-aspell-data-dir
@@ -1051,8 +1086,7 @@ Return the new dictionary alist."
(insert-file-contents alias-file)
;; Look for a line "add FOO.multi", extract FOO
(when (search-forward-regexp "^add \\([^.]+\\)\\.multi" nil t)
- (let* ((aliasname (file-name-sans-extension
- (file-name-nondirectory alias-file)))
+ (let* ((aliasname (file-name-base alias-file))
(already-exists-p (assoc aliasname alist))
(realname (match-string 1))
(realdict (assoc realname alist)))
@@ -1087,8 +1121,7 @@ aspell is used along with Emacs).")
(error nil))
ispell-really-aspell
ispell-encoding8-command
- ;; XEmacs does not like [:alpha:] regexps.
- (string-match "^[[:alpha:]]+$" "abcde"))
+ ispell-emacs-alpha-regexp)
(unless ispell-aspell-dictionary-alist
(ispell-find-aspell-dictionaries)))
@@ -1112,12 +1145,32 @@ aspell is used along with Emacs).")
ispell-dictionary-base-alist))
(unless (assoc (car dict) all-dicts-alist)
(add-to-list 'all-dicts-alist dict)))
- (setq ispell-dictionary-alist all-dicts-alist))))
-
+ (setq ispell-dictionary-alist all-dicts-alist))
+
+ ;; If Emacs flavor supports [:alpha:] use it for global dicts. If
+ ;; spellchecker also supports UTF-8 via command-line option use it
+ ;; in communication. This does not affect definitions in your
+ ;; init file.
+ (if ispell-emacs-alpha-regexp
+ (let (tmp-dicts-alist)
+ (dolist (adict ispell-dictionary-alist)
+ (add-to-list 'tmp-dicts-alist
+ (list
+ (nth 0 adict) ; dict name
+ "[[:alpha:]]" ; casechars
+ "[^[:alpha:]]" ; not-casechars
+ (nth 3 adict) ; otherchars
+ (nth 4 adict) ; many-otherchars-p
+ (nth 5 adict) ; ispell-args
+ (nth 6 adict) ; extended-character-mode
+ (if ispell-encoding8-command
+ 'utf-8
+ (nth 7 adict)))))
+ (setq ispell-dictionary-alist tmp-dicts-alist)))))
(defun ispell-valid-dictionary-list ()
"Return a list of valid dictionaries.
-The variable `ispell-library-directory' defines the library location."
+The variable `ispell-library-directory' defines their location."
;; Initialize variables and dictionaries alists for desired spellchecker.
;; Make sure ispell.el is loaded to avoid some autoload loops in XEmacs
;; (and may be others)
@@ -1146,7 +1199,7 @@ The variable `ispell-library-directory' defines the library location."
(push name dict-list)))
dict-list))
-;;; define commands in menu in opposite order you want them to appear.
+;; Define commands in menu in opposite order you want them to appear.
;;;###autoload
(if ispell-menu-map-needed
(progn
@@ -1155,7 +1208,8 @@ The variable `ispell-library-directory' defines the library location."
`(menu-item ,(purecopy "Change Dictionary...") ispell-change-dictionary
:help ,(purecopy "Supply explicit dictionary file name")))
(define-key ispell-menu-map [ispell-kill-ispell]
- `(menu-item ,(purecopy "Kill Process") ispell-kill-ispell
+ `(menu-item ,(purecopy "Kill Process")
+ (lambda () (interactive) (ispell-kill-ispell nil 'clear))
:enable (and (boundp 'ispell-process) ispell-process
(eq (ispell-process-status) 'run))
:help ,(purecopy "Terminate Ispell subprocess")))
@@ -1239,7 +1293,7 @@ The variable `ispell-library-directory' defines the library location."
["Continue Check" ispell-continue t]
["Complete Word Frag"ispell-complete-word-interior-frag t]
["Complete Word" ispell-complete-word t]
- ["Kill Process" ispell-kill-ispell t]
+ ["Kill Process" (ispell-kill-ispell nil 'clear) t]
["Customize..." (customize-group 'ispell) t]
;; flyspell-mode may not be bound...
;;["flyspell" flyspell-mode
@@ -1307,7 +1361,8 @@ Protects against bogus binding of `enable-multibyte-characters' in XEmacs."
(let* ((slot (or
(assoc ispell-current-dictionary ispell-local-dictionary-alist)
(assoc ispell-current-dictionary ispell-dictionary-alist)
- (error "No match for the current dictionary")))
+ (error "No data for dictionary \"%s\", neither in `ispell-local-dictionary-alist' nor in `ispell-dictionary-alist'"
+ ispell-current-dictionary)))
(str (nth n slot)))
(when (and (> (length str) 0)
(not (multibyte-string-p str)))
@@ -1329,8 +1384,10 @@ Protects against bogus binding of `enable-multibyte-characters' in XEmacs."
(nth 5 (or (assoc ispell-current-dictionary ispell-local-dictionary-alist)
(assoc ispell-current-dictionary ispell-dictionary-alist))))
(defun ispell-get-extended-character-mode ()
- (nth 6 (or (assoc ispell-current-dictionary ispell-local-dictionary-alist)
- (assoc ispell-current-dictionary ispell-dictionary-alist))))
+ (if ispell-really-hunspell ;; hunspell treats ~word as ordinary words
+ nil ;; in pipe mode. Disable extended-char-mode
+ (nth 6 (or (assoc ispell-current-dictionary ispell-local-dictionary-alist)
+ (assoc ispell-current-dictionary ispell-dictionary-alist)))))
(defun ispell-get-coding-system ()
(nth 7 (or (assoc ispell-current-dictionary ispell-local-dictionary-alist)
(assoc ispell-current-dictionary ispell-dictionary-alist))))
@@ -1339,9 +1396,9 @@ Protects against bogus binding of `enable-multibyte-characters' in XEmacs."
(defvar ispell-pdict-modified-p nil
"Non-nil means personal dictionary has modifications to be saved.")
-;;; If you want to save the dictionary when quitting, must do so explicitly.
-;;; When non-nil, the spell session is terminated.
-;;; When numeric, contains cursor location in buffer, and cursor remains there.
+;; If you want to save the dictionary when quitting, must do so explicitly.
+;; When non-nil, the spell session is terminated.
+;; When numeric, contains cursor location in buffer, and cursor remains there.
(defvar ispell-quit nil)
(defvar ispell-process-directory nil
@@ -1381,7 +1438,7 @@ Set to the MIME boundary locations when checking messages.")
(defconst ispell-words-keyword "LocalWords: "
"The keyword for local oddly-spelled words to accept.
The keyword will be followed by any number of local word spellings.
-There can be multiple of these keywords in the file.")
+There can be multiple instances of this keyword in the file.")
(defconst ispell-dictionary-keyword "Local IspellDict: "
"The keyword for a local dictionary to use.
@@ -1463,7 +1520,7 @@ Valid forms include:
("list" ispell-tex-arg-end 2)
("program" . "\\\\end[ \t\n]*{[ \t\n]*program[ \t\n]*}")
("verbatim\\*?" . "\\\\end[ \t\n]*{[ \t\n]*verbatim\\*?[ \t\n]*}"))))
- "*Lists of regions to be skipped in TeX mode.
+ "Lists of regions to be skipped in TeX mode.
First list is used raw.
Second list has key placed inside \\begin{}.
@@ -1482,7 +1539,7 @@ for skipping in latex mode.")
("<[tT][tT]/" "/")
("<[^ \t\n>]" ">")
("&[^ \t\n;]" "[; \t\n]"))
- "*Lists of start and end keys to skip in HTML buffers.
+ "Lists of start and end keys to skip in HTML buffers.
Same format as `ispell-skip-region-alist'.
Note - substrings of other matches must come last
(e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").")
@@ -1505,8 +1562,13 @@ local variable syntax.")
"Contains the buffer name if local word definitions were used.
Ispell is then restarted because the local words could conflict.")
+(defvar ispell-buffer-session-localwords nil
+ "List of words accepted for session in this buffer.")
+
+(make-variable-buffer-local 'ispell-buffer-session-localwords)
+
(defvar ispell-parser 'use-mode-name
- "*Indicates whether ispell should parse the current buffer as TeX Code.
+ "Indicates whether ispell should parse the current buffer as TeX Code.
Special value `use-mode-name' tries to guess using the name of `major-mode'.
Default parser is `nroff'.
Currently the only other valid parser is `tex'.
@@ -1633,16 +1695,6 @@ This allows it to improve the suggestion list based on actual misspellings."
(setq more-lines (= 0 (forward-line))))))))))))))
-;; Insert WORD while possibly translating characters by
-;; translation-table-for-input.
-(defun ispell-insert-word (word)
- (let ((pos (point)))
- (insert word)
- ;; Avoid "obsolete" warnings for translation-table-for-input.
- (with-no-warnings
- (if (char-table-p translation-table-for-input)
- (translate-region pos (point) translation-table-for-input)))))
-
;;;###autoload
(defun ispell-word (&optional following quietly continue region)
"Check spelling of word under or before the cursor.
@@ -1675,7 +1727,12 @@ nil word is correct or spelling is accepted.
quit spell session exited."
(interactive (list ispell-following-word ispell-quietly current-prefix-arg t))
(cond
- ((and region (use-region-p))
+ ((and region
+ (if (featurep 'emacs)
+ (use-region-p)
+ (and (boundp 'transient-mark-mode) transient-mark-mode
+ (boundp 'mark-active) mark-active
+ (not (eq (region-beginning) (region-end))))))
(ispell-region (region-beginning) (region-end)))
(continue (ispell-continue))
(t
@@ -1755,7 +1812,7 @@ quit spell session exited."
;; Insert first and then delete,
;; to avoid collapsing markers before and after
;; into a single place.
- (ispell-insert-word new-word)
+ (insert new-word)
(delete-region (point) end)
;; It is meaningless to preserve the cursor position
;; inside a word that has changed.
@@ -1786,7 +1843,8 @@ If optional argument FOLLOWING is non-nil or if `ispell-following-word'
is non-nil when called interactively, then the following word
\(rather than preceding\) is checked when the cursor is not over a word.
Optional second argument contains otherchars that can be included in word
-many times.
+many times (see the doc string of `ispell-dictionary-alist' for details
+about otherchars).
Word syntax is controlled by the definition of the chosen dictionary,
which is in `ispell-local-dictionary-alist' or `ispell-dictionary-alist'."
@@ -1845,10 +1903,10 @@ which is in `ispell-local-dictionary-alist' or `ispell-dictionary-alist'."
(list word start end))))
-;;; Global ispell-pdict-modified-p is set by ispell-command-loop and
-;;; tracks changes in the dictionary. The global may either be
-;;; a value or a list, whose value is the state of whether the
-;;; dictionary needs to be saved.
+;; Global ispell-pdict-modified-p is set by ispell-command-loop and
+;; tracks changes in the dictionary. The global may either be
+;; a value or a list, whose value is the state of whether the
+;; dictionary needs to be saved.
;;;###autoload
(defun ispell-pdict-save (&optional no-query force-save)
@@ -1857,11 +1915,14 @@ If so, ask if it needs to be saved."
(interactive (list ispell-silently-savep t))
(if (and ispell-pdict-modified-p (listp ispell-pdict-modified-p))
(setq ispell-pdict-modified-p (car ispell-pdict-modified-p)))
- (if (or ispell-pdict-modified-p force-save)
- (if (or no-query (y-or-n-p "Personal dictionary modified. Save? "))
- (progn
- (ispell-send-string "#\n") ; save dictionary
- (message "Personal dictionary saved."))))
+ (when (and (or ispell-pdict-modified-p force-save)
+ (or no-query
+ (y-or-n-p "Personal dictionary modified. Save? ")))
+ (ispell-send-string "#\n") ; save dictionary
+ (message "Personal dictionary saved.")
+ (when flyspell-mode
+ (flyspell-mode 0)
+ (flyspell-mode 1)))
;; unassert variable, even if not saved to avoid questioning.
(setq ispell-pdict-modified-p nil))
@@ -1900,7 +1961,7 @@ Global `ispell-quit' set to start location to continue spell session."
" -- dict: " (or ispell-current-dictionary "default")
" -- prog: " (file-name-nondirectory ispell-program-name)))
;; XEmacs: no need for horizontal scrollbar in choices window
- (with-no-warnings
+ (ispell-with-no-warnings
(and (fboundp 'set-specifier)
(boundp 'horizontal-scrollbar-visible-p)
(set-specifier horizontal-scrollbar-visible-p nil
@@ -2002,6 +2063,9 @@ Global `ispell-quit' set to start location to continue spell session."
nil)
((or (= char ?a) (= char ?A)) ; accept word without insert
(ispell-send-string (concat "@" word "\n"))
+ (add-to-list 'ispell-buffer-session-localwords word)
+ (or ispell-buffer-local-name ; session localwords might conflict
+ (setq ispell-buffer-local-name (buffer-name)))
(if (null ispell-pdict-modified-p)
(setq ispell-pdict-modified-p
(list ispell-pdict-modified-p)))
@@ -2384,8 +2448,8 @@ if defined."
(setq start end)))))) ; else move start to next line of input
-;;; This function destroys the mark location if it is in the word being
-;;; highlighted.
+;; This function destroys the mark location if it is in the word being
+;; highlighted.
(defun ispell-highlight-spelling-error-generic (start end &optional highlight
refresh)
"Highlight the word from START to END with a kludge using `inverse-video'.
@@ -2517,7 +2581,7 @@ scrolling the current window. Leave the new window selected."
(set-window-start (next-window) top))))
-;;; Should we add a compound word match return value?
+;; Should we add a compound word match return value?
(defun ispell-parse-output (output &optional accept-list shift)
"Parse the OUTPUT string from Ispell process and return:
1: t for an exact match.
@@ -2583,8 +2647,8 @@ When asynchronous processes are not supported, `run' is always returned."
(defun ispell-start-process ()
- "Start the ispell process, with support for no asynchronous processes.
-Keeps argument list for future ispell invocations for no async support."
+ "Start the Ispell process, with support for no asynchronous processes.
+Keeps argument list for future Ispell invocations for no async support."
;; Local dictionary becomes the global dictionary in use.
(setq ispell-current-dictionary
(or ispell-local-dictionary ispell-dictionary))
@@ -2610,9 +2674,12 @@ Keeps argument list for future ispell invocations for no async support."
;; right encoding for communication. ispell or older aspell/hunspell
;; does not support this.
(if ispell-encoding8-command
- (list
- (concat ispell-encoding8-command
- (symbol-name (ispell-get-coding-system)))))
+ (if ispell-really-hunspell
+ (list ispell-encoding8-command
+ (upcase (symbol-name (ispell-get-coding-system))))
+ (list
+ (concat ispell-encoding8-command
+ (symbol-name (ispell-get-coding-system))))))
ispell-extra-args)))
;; Initially we don't know any buffer's local words.
@@ -2672,7 +2739,8 @@ Keeps argument list for future ispell invocations for no async support."
(setq ispell-filter nil ispell-filter-continue nil)
;; may need to restart to select new personal dictionary.
(ispell-kill-ispell t)
- (message "Starting new Ispell process [%s] ..."
+ (message "Starting new Ispell process [%s::%s] ..."
+ ispell-program-name
(or ispell-local-dictionary ispell-dictionary "default"))
(sit-for 0)
(setq ispell-library-directory (ispell-check-version)
@@ -2744,21 +2812,27 @@ Keeps argument list for future ispell invocations for no async support."
(process-kill-without-query ispell-process)))))))
;;;###autoload
-(defun ispell-kill-ispell (&optional no-error)
+(defun ispell-kill-ispell (&optional no-error clear)
"Kill current Ispell process (so that you may start a fresh one).
-With NO-ERROR, just return non-nil if there was no Ispell running."
+With NO-ERROR, just return non-nil if there was no Ispell running.
+With CLEAR, buffer session localwords are cleaned."
(interactive)
;; This hook is typically used by flyspell to flush some variables used
;; to optimize the common cases.
(run-hooks 'ispell-kill-ispell-hook)
+ (if (or clear
+ (if (featurep 'xemacs)
+ (interactive-p)
+ (called-interactively-p 'interactive)))
+ (setq ispell-buffer-session-localwords nil))
(if (not (and ispell-process
(eq (ispell-process-status) 'run)))
(or no-error
- (error "There is no ispell process running!"))
+ (error "There is no Ispell process running!"))
(if ispell-async-processp
(delete-process ispell-process)
- ;; synchronous processes
- (ispell-send-string "\n") ; make sure side effects occurred.
+ ;; Synchronous processes.
+ (ispell-send-string "\n") ; Make sure side effects occurred.
(kill-buffer ispell-output-buffer)
(kill-buffer ispell-session-buffer)
(setq ispell-output-buffer nil
@@ -2767,8 +2841,8 @@ With NO-ERROR, just return non-nil if there was no Ispell running."
(message "Ispell process killed")
nil))
-;;; ispell-change-dictionary is set in some people's hooks. Maybe this should
-;;; call ispell-init-process rather than wait for a spell checking command?
+;; ispell-change-dictionary is set in some people's hooks. Maybe this should
+;; call ispell-init-process rather than wait for a spell checking command?
;;;###autoload
(defun ispell-change-dictionary (dict &optional arg)
@@ -2798,7 +2872,9 @@ By just answering RET you can find out what the current dictionary is."
;; Specified dictionary is the default already. Could reload
;; the dictionaries if needed.
(ispell-internal-change-dictionary)
- (and (interactive-p)
+ (and (if (featurep 'xemacs)
+ (interactive-p)
+ (called-interactively-p 'interactive))
(message "No change, using %s dictionary" dict)))
(t ; reset dictionary!
(if (or (assoc dict ispell-local-dictionary-alist)
@@ -2811,14 +2887,15 @@ By just answering RET you can find out what the current dictionary is."
(setq ispell-local-dictionary-overridden t))
(error "Undefined dictionary: %s" dict))
(ispell-internal-change-dictionary)
+ (setq ispell-buffer-session-localwords nil)
(message "%s Ispell dictionary set to %s"
(if arg "Global" "Local")
dict))))
(defun ispell-internal-change-dictionary ()
"Update the dictionary and the personal dictionary used by Ispell.
-This may kill the Ispell process; if so,
-a new one will be started when needed."
+This may kill the Ispell process; if so, a new one will be started
+when needed."
(let ((dict (or ispell-local-dictionary ispell-dictionary))
(pdict (or ispell-local-pdict ispell-personal-dictionary)))
(unless (and (equal ispell-current-dictionary dict)
@@ -2836,127 +2913,155 @@ a new one will be started when needed."
;;;###autoload
(defun ispell-region (reg-start reg-end &optional recheckp shift)
"Interactively check a region for spelling errors.
-Return nil if spell session is quit,
- otherwise returns shift offset amount for last line processed."
+Return nil if spell session was terminated, otherwise returns shift offset
+amount for last line processed."
(interactive "r") ; Don't flag errors on read-only bufs.
(ispell-set-spellchecker-params) ; Initialize variables and dicts alists
(if (not recheckp)
(ispell-accept-buffer-local-defs)) ; set up dictionary, local words, etc.
(let ((skip-region-start (make-marker))
- (rstart (make-marker)))
- (unwind-protect
- (save-excursion
- (message "Spell-checking %s using %s with %s dictionary..."
- (if (and (= reg-start (point-min)) (= reg-end (point-max)))
- (buffer-name) "region")
- (file-name-nondirectory ispell-program-name)
- (or ispell-current-dictionary "default"))
- ;; Returns cursor to original location.
- (save-window-excursion
- (goto-char reg-start)
- (let ((transient-mark-mode)
- (case-fold-search case-fold-search)
- (query-fcc t)
- in-comment key)
- (let (message-log-max)
- (message "searching for regions to skip"))
- (if (re-search-forward (ispell-begin-skip-region-regexp) reg-end t)
- (progn
- (setq key (match-string-no-properties 0))
- (set-marker skip-region-start (- (point) (length key)))
- (goto-char reg-start)))
- (let (message-log-max)
- (message
- "Continuing spelling check using %s with %s dictionary..."
- (file-name-nondirectory ispell-program-name)
- (or ispell-current-dictionary "default")))
- (set-marker rstart reg-start)
- (set-marker ispell-region-end reg-end)
- (while (and (not ispell-quit)
- (< (point) ispell-region-end))
- ;; spell-check region with skipping
- (if (and (marker-position skip-region-start)
- (<= skip-region-start (point)))
+ (rstart (make-marker))
+ (region-type (if (and (= reg-start (point-min)) (= reg-end (point-max)))
+ (buffer-name) "region"))
+ (program-basename (file-name-nondirectory ispell-program-name))
+ (dictionary (or ispell-current-dictionary "default")))
+ (unwind-protect
+ (save-excursion
+ (message "Spell-checking %s using %s with %s dictionary..."
+ region-type program-basename dictionary)
+ ;; Returns cursor to original location.
+ (save-window-excursion
+ (goto-char reg-start)
+ (let ((transient-mark-mode)
+ (case-fold-search case-fold-search)
+ (query-fcc t)
+ in-comment key)
+ (ispell-print-if-debug
+ (concat
+ (format
+ "ispell-region: (ispell-skip-region-list):\n%s\n"
+ (ispell-skip-region-list))
+ (format
+ "ispell-region: (ispell-begin-skip-region-regexp):\n%s\n"
+ (ispell-begin-skip-region-regexp))
+ "ispell-region: Search for first region to skip after (ispell-begin-skip-region-regexp)\n"))
+ (if (re-search-forward (ispell-begin-skip-region-regexp) reg-end t)
(progn
- ;; If region inside line comment, must keep comment start.
- (setq in-comment (point)
- in-comment
- (and comment-start
- (or (null comment-end) (string= "" comment-end))
- (save-excursion
- (beginning-of-line)
- (re-search-forward comment-start in-comment t))
- comment-start))
- ;; Can change skip-regexps (in ispell-message)
- (ispell-skip-region key) ; moves pt past region.
- (set-marker rstart (point))
- ;; check for saving large attachments...
- (setq query-fcc (and query-fcc
- (ispell-ignore-fcc skip-region-start
- rstart)))
- (if (and (< rstart ispell-region-end)
- (re-search-forward
- (ispell-begin-skip-region-regexp)
- ispell-region-end t))
- (progn
- (setq key (match-string-no-properties 0))
- (set-marker skip-region-start
- (- (point) (length key)))
- (goto-char rstart))
- (set-marker skip-region-start nil))))
- (setq reg-end (max (point)
- (if (marker-position skip-region-start)
- (min skip-region-start ispell-region-end)
- (marker-position ispell-region-end))))
- (let* ((ispell-start (point))
- (ispell-end (min (point-at-eol) reg-end))
- (string (ispell-get-line
- ispell-start ispell-end in-comment)))
- (if in-comment ; account for comment chars added
- (setq ispell-start (- ispell-start (length in-comment))
- in-comment nil))
- (setq ispell-end (point)) ; "end" tracks region retrieved.
- (if string ; there is something to spell check!
- ;; (special start end)
- (setq shift (ispell-process-line string
- (and recheckp shift))))
- (goto-char ispell-end)))))
- (if ispell-quit
- nil
- (or shift 0)))
- ;; protected
- (if (and (not (and recheckp ispell-keep-choices-win))
- (get-buffer ispell-choices-buffer))
- (kill-buffer ispell-choices-buffer))
- (set-marker skip-region-start nil)
- (set-marker rstart nil)
- (if ispell-quit
- (progn
- ;; preserve or clear the region for ispell-continue.
- (if (not (numberp ispell-quit))
- (set-marker ispell-region-end nil)
- ;; Ispell-continue enabled - ispell-region-end is set.
- (goto-char ispell-quit))
- ;; Check for aborting
- (if (and ispell-checking-message (numberp ispell-quit))
- (progn
- (setq ispell-quit nil)
- (error "Message send aborted")))
- (if (not recheckp) (setq ispell-quit nil)))
- (if (not recheckp) (set-marker ispell-region-end nil))
- ;; Only save if successful exit.
- (ispell-pdict-save ispell-silently-savep)
- (message "Spell-checking %s using %s with %s dictionary...done"
- (if (and (= reg-start (point-min)) (= reg-end (point-max)))
- (buffer-name) "region")
- (file-name-nondirectory ispell-program-name)
- (or ispell-current-dictionary "default"))))))
+ (setq key (match-string-no-properties 0))
+ (set-marker skip-region-start (- (point) (length key)))
+ (goto-char reg-start)
+ (ispell-print-if-debug
+ (format "ispell-region: First skip: %s at (pos,line,column): (%s,%s,%s).\n"
+ key
+ (save-excursion (goto-char skip-region-start) (point))
+ (line-number-at-pos skip-region-start)
+ (save-excursion (goto-char skip-region-start) (current-column))))))
+ (ispell-print-if-debug
+ (format
+ "ispell-region: Continue spell-checking with %s and %s dictionary...\n"
+ program-basename dictionary))
+ (set-marker rstart reg-start)
+ (set-marker ispell-region-end reg-end)
+ (while (and (not ispell-quit)
+ (< (point) ispell-region-end))
+ ;; spell-check region with skipping
+ (if (and (marker-position skip-region-start)
+ (<= skip-region-start (point)))
+ (progn
+ ;; If region inside line comment, must keep comment start.
+ (setq in-comment (point)
+ in-comment
+ (and comment-start
+ (or (null comment-end) (string= "" comment-end))
+ (save-excursion
+ (beginning-of-line)
+ (re-search-forward comment-start in-comment t))
+ comment-start))
+ ;; Can change skip-regexps (in ispell-message)
+ (ispell-skip-region key) ; moves pt past region.
+ (set-marker rstart (point))
+ ;; check for saving large attachments...
+ (setq query-fcc (and query-fcc
+ (ispell-ignore-fcc skip-region-start
+ rstart)))
+ (if (and (< rstart ispell-region-end)
+ (re-search-forward
+ (ispell-begin-skip-region-regexp)
+ ispell-region-end t))
+ (progn
+ (setq key (match-string-no-properties 0))
+ (set-marker skip-region-start
+ (- (point) (length key)))
+ (goto-char rstart)
+ (ispell-print-if-debug
+ (format "ispell-region: Next skip: %s at (pos,line,column): (%s,%s,%s).\n"
+ key
+ (save-excursion (goto-char skip-region-start) (point))
+ (line-number-at-pos skip-region-start)
+ (save-excursion (goto-char skip-region-start) (current-column)))))
+ (set-marker skip-region-start nil))))
+ (setq reg-end (max (point)
+ (if (marker-position skip-region-start)
+ (min skip-region-start ispell-region-end)
+ (marker-position ispell-region-end))))
+ (let* ((ispell-start (point))
+ (ispell-end (min (point-at-eol) reg-end))
+ ;; See if line must be prefixed by comment string to let ispell know this is
+ ;; part of a comment string. This is only supported in some modes.
+ ;; In particular, this is not supported in autoconf mode where adding the
+ ;; comment string messes everything up because ispell tries to spellcheck the
+ ;; `dnl' string header causing misalignments in some cases (debbugs.gnu.org: #12768).
+ (add-comment (and in-comment
+ (not (string= in-comment "dnl "))
+ in-comment))
+ (string (ispell-get-line
+ ispell-start ispell-end add-comment)))
+ (ispell-print-if-debug
+ (format
+ "ispell-region: string pos (%s->%s), eol: %s, [in-comment]: [%s], [add-comment]: [%s], [string]: [%s]\n"
+ ispell-start ispell-end (point-at-eol) in-comment add-comment string))
+ (if add-comment ; account for comment chars added
+ (setq ispell-start (- ispell-start (length add-comment))
+ add-comment nil))
+ (setq ispell-end (point)) ; "end" tracks region retrieved.
+ (if string ; there is something to spell check!
+ ;; (special start end)
+ (setq shift (ispell-process-line string
+ (and recheckp shift))))
+ (goto-char ispell-end)))))
+ (if ispell-quit
+ nil
+ (or shift 0)))
+ ;; protected
+ (if (and (not (and recheckp ispell-keep-choices-win))
+ (get-buffer ispell-choices-buffer))
+ (kill-buffer ispell-choices-buffer))
+ (set-marker skip-region-start nil)
+ (set-marker rstart nil)
+ (if ispell-quit
+ (progn
+ ;; preserve or clear the region for ispell-continue.
+ (if (not (numberp ispell-quit))
+ (set-marker ispell-region-end nil)
+ ;; Ispell-continue enabled - ispell-region-end is set.
+ (goto-char ispell-quit))
+ ;; Check for aborting
+ (if (and ispell-checking-message (numberp ispell-quit))
+ (progn
+ (setq ispell-quit nil)
+ (error "Message send aborted")))
+ (if (not recheckp) (setq ispell-quit nil)))
+ (if (not recheckp) (set-marker ispell-region-end nil))
+ ;; Only save if successful exit.
+ (ispell-pdict-save ispell-silently-savep)
+ (message "Spell-checking %s using %s with %s dictionary...done"
+ region-type program-basename dictionary)))))
(defun ispell-begin-skip-region-regexp ()
"Return a regexp of the search keys for region skipping.
Includes `ispell-skip-region-alist' plus tex, tib, html, and comment keys.
-Must call after `ispell-buffer-local-parsing' due to dependence on mode."
+Must be called after `ispell-buffer-local-parsing' due to dependence on mode."
(mapconcat
'identity
(delq nil
@@ -3016,7 +3121,7 @@ Includes regions defined by `ispell-skip-region-alist', tex mode,
`ispell-html-skip-alists', and `ispell-checking-message'.
Manual checking must include comments and tib references.
The list is of the form described by variable `ispell-skip-region-alist'.
-Must call after `ispell-buffer-local-parsing' due to dependence on mode."
+Must be called after `ispell-buffer-local-parsing' due to dependence on mode."
(let ((skip-alist ispell-skip-region-alist))
;; only additional explicit region definition is tex.
(if (eq ispell-parser 'tex)
@@ -3046,7 +3151,7 @@ Must call after `ispell-buffer-local-parsing' due to dependence on mode."
(defun ispell-ignore-fcc (start end)
"Delete the Fcc: message header when large attachments are included.
-Return value `nil' if file with large attachments are saved.
+Return value `nil' if file with large attachments is saved.
This can be used to avoid multiple questions for multiple large attachments.
Returns point to starting location afterwards."
(let ((result t))
@@ -3153,7 +3258,7 @@ Returns a string with the line data."
coding)))))
(defun ispell-process-line (string shift)
- "Send STRING, a line of text, to ispell and processes the result.
+ "Send STRING, a line of text, to ispell and process the result.
This will modify the buffer for spelling errors.
Requires variables ISPELL-START and ISPELL-END to be defined in its
dynamic scope.
@@ -3197,10 +3302,19 @@ Returns the sum SHIFT due to changes in word replacements."
;; Alignment cannot be tracked and this error will occur when
;; `query-replace' makes multiple corrections on the starting line.
(or (ispell-looking-at (car poss))
- ;; This occurs due to filter pipe problems
- (error (concat "Ispell misalignment: word "
- "`%s' point %d; probably incompatible versions")
- (car poss) (marker-position word-start)))
+ ;; This error occurs due to filter pipe problems
+ (let* ((ispell-pipe-word (car poss))
+ (actual-point (marker-position word-start))
+ (actual-line (line-number-at-pos actual-point))
+ (actual-column (save-excursion (goto-char actual-point) (current-column))))
+ (ispell-print-if-debug
+ (concat
+ "ispell-process-line: Ispell misalignment error:\n"
+ (format " [Word from ispell pipe]: [%s], actual (point,line,column): (%s,%s,%s)\n"
+ ispell-pipe-word actual-point actual-line actual-column)))
+ (error (concat "Ispell misalignment: word "
+ "`%s' point %d; probably incompatible versions")
+ ispell-pipe-word actual-point)))
;; ispell-cmd-loop can go recursive & change buffer
(if ispell-keep-choices-win
(setq replace (ispell-command-loop
@@ -3241,7 +3355,7 @@ Returns the sum SHIFT due to changes in word replacements."
(delete-region (point) (+ word-len (point)))
(if (not (listp replace))
(progn
- (ispell-insert-word replace) ; insert dictionary word
+ (insert replace) ; insert dictionary word
(ispell-send-replacement (car poss) replace)
(setq accept-list (cons replace accept-list)))
(let ((replace-word (car replace)))
@@ -3334,6 +3448,13 @@ Returns the sum SHIFT due to changes in word replacements."
(interactive)
(ispell-region (point-min) (point-max)))
+;;;###autoload
+(defun ispell-buffer-with-debug (&optional append)
+ "`ispell-buffer' with some output sent to `ispell-debug-buffer' buffer.
+Use APPEND to append the info to previous buffer if exists."
+ (interactive)
+ (let ((ispell-debug-buffer (ispell-create-debug-buffer append)))
+ (ispell-buffer)))
;;;###autoload
(defun ispell-continue ()
@@ -3372,6 +3493,7 @@ If optional INTERIOR-FRAG is non-nil then the word may be a character
sequence inside of a word.
Standard ispell choices are then available."
+ ;; FIXME: completion-at-point-function.
(interactive "P")
(let ((cursor-location (point))
(case-fold-search-val case-fold-search)
@@ -3415,7 +3537,7 @@ Standard ispell choices are then available."
(setq word (if (atom replacement) replacement (car replacement))
cursor-location (+ (- (length word) (- end start))
cursor-location))
- (ispell-insert-word word)
+ (insert word)
(if (not (atom replacement)) ; recheck spelling of replacement.
(progn
(goto-char cursor-location)
@@ -3468,7 +3590,7 @@ With a prefix argument ARG, enable Ispell minor mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-Ispell minor mode is a buffer-local mior mode. When enabled,
+Ispell minor mode is a buffer-local minor mode. When enabled,
typing SPC or RET warns you if the previous word is incorrectly
spelled.
@@ -3481,7 +3603,7 @@ RET, use `flyspell-mode'."
nil " Spell" ispell-minor-keymap)
(defun ispell-minor-check ()
- "Check previous word then continue with the normal binding of this key.
+ "Check previous word, then continue with the normal binding of this key.
Don't check previous word when character before point is a space or newline.
Don't read buffer-local settings or word lists."
(interactive "*")
@@ -3519,8 +3641,8 @@ Don't read buffer-local settings or word lists."
;; Matches commonly used "cut" boundaries
"^\\(- \\)?[-=_]+\\s ?\\(cut here\\|Environment Follows\\)")
"\\|")
- "*End of text which will be checked in `ispell-message'.
-If it is a string, limit at first occurrence of that regular expression.
+ "Text beyond which `ispell-message' will not spell-check.
+If it is a string, limit is the first occurrence of that regular expression.
Otherwise, it must be a function which is called to get the limit.")
(put 'ispell-message-text-end 'risky-local-variable t)
@@ -3625,10 +3747,10 @@ Don't check included messages.
To abort spell checking of a message region and send the message anyway,
use the `x' command. (Any subsequent regions will be checked.)
-The `X' command aborts the message send so that you can edit the buffer.
+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)
@@ -3667,23 +3789,23 @@ You can bind this to the key C-c i in GNUS or mail by adding to
(cite-regexp ;Prefix of quoted text
(cond
((functionp 'sc-cite-regexp) ; sc 3.0
- (with-no-warnings
- (concat "\\(" (sc-cite-regexp) "\\)" "\\|"
- (ispell-non-empty-string sc-reference-tag-string))))
+ (ispell-with-no-warnings
+ (concat "\\(" (sc-cite-regexp) "\\)" "\\|"
+ (ispell-non-empty-string sc-reference-tag-string))))
((boundp 'sc-cite-regexp) ; sc 2.3
(concat "\\(" sc-cite-regexp "\\)" "\\|"
- (with-no-warnings
+ (ispell-with-no-warnings
(ispell-non-empty-string sc-reference-tag-string))))
((or (equal major-mode 'news-reply-mode) ;GNUS 4 & below
(equal major-mode 'message-mode)) ;GNUS 5
(concat "In article <" "\\|"
"[^,;&+=\n]+ <[^,;&+=]+> writes:" "\\|"
- (with-no-warnings message-cite-prefix-regexp)
+ (ispell-with-no-warnings message-cite-prefix-regexp)
"\\|"
default-prefix))
((equal major-mode 'mh-letter-mode) ; mh mail message
(concat "[^,;&+=\n]+ writes:" "\\|"
- (with-no-warnings
+ (ispell-with-no-warnings
(ispell-non-empty-string mh-ins-buf-prefix))))
((not internal-messagep) ; Assume nn sent us this message.
(concat "In [a-zA-Z.]+ you write:" "\\|"
@@ -3788,7 +3910,7 @@ You can bind this to the key C-c i in GNUS or mail by adding to
(defun ispell-buffer-local-parsing ()
"Place Ispell into parsing mode for this buffer.
Overrides the default parsing mode.
-Includes Latex/Nroff modes and extended character mode."
+Includes LaTeX/Nroff modes and extended character mode."
;; (ispell-init-process) must already be called.
(ispell-send-string "!\n") ; Put process in terse mode.
;; We assume all major modes with "tex-mode" in them should use latex parsing
@@ -3838,7 +3960,7 @@ Includes Latex/Nroff modes and extended character mode."
(defun ispell-buffer-local-dict (&optional no-reload)
"Initializes local dictionary and local personal dictionary.
-If optional NO-RELOAD is non-nil, do not make any dictionary reloading.
+If optional NO-RELOAD is non-nil, do not reload any dictionary.
When a dictionary is defined in the buffer (see variable
`ispell-dictionary-keyword'), it will override the local setting
from \\[ispell-change-dictionary].
@@ -3880,6 +4002,11 @@ Both should not be used to define a buffer-local dictionary."
;; Actually start a new ispell process, because we need
;; to send commands now to specify the local words to it.
(ispell-init-process)
+ (dolist (session-localword ispell-buffer-session-localwords)
+ (ispell-send-string (concat "@" session-localword "\n")))
+ (or ispell-buffer-local-name
+ (if ispell-buffer-session-localwords
+ (setq ispell-buffer-local-name (buffer-name))))
(save-excursion
(goto-char (point-min))
(while (search-forward ispell-words-keyword nil t)
@@ -3899,7 +4026,7 @@ Both should not be used to define a buffer-local dictionary."
(ispell-send-string (concat "@" string "\n"))))))))
-;;; returns optionally adjusted region-end-point.
+;; Returns optionally adjusted region-end-point.
;; If comment-padright is defined, newcomment must be loaded.
(declare-function comment-add "newcomment" (arg))
@@ -3977,7 +4104,7 @@ Both should not be used to define a buffer-local dictionary."
; LocalWords: alists minibuffer bufferp autoload loaddefs aff Dansk KOI SPC op
; LocalWords: Francais Nederlands charset autoloaded popup nonmenu regexp num
; LocalWords: AMStex hspace includeonly nocite epsfig displaymath eqnarray reg
-; LocalWords: minipage modeline pers dict unhighlight buf grep sync prev inc
+; LocalWords: minipage pers dict unhighlight buf grep sync prev inc
; LocalWords: fn oldot NB AIX msg init read's bufs pt cmd Quinlan eg
; LocalWords: uuencoded unidiff sc nn VM SGML eval IspellPersDict
; LocalWords: lns XEmacs HTML casechars Multibyte
diff --git a/lisp/textmodes/makeinfo.el b/lisp/textmodes/makeinfo.el
index 4d701a9d268..8cc2e7d2993 100644
--- a/lisp/textmodes/makeinfo.el
+++ b/lisp/textmodes/makeinfo.el
@@ -1,6 +1,6 @@
;;; makeinfo.el --- run makeinfo conveniently
-;; Copyright (C) 1991, 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1993, 2001-2012 Free Software Foundation, Inc.
;; Author: Robert J. Chassell
;; Maintainer: FSF
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el
index 1be78ed293f..4bd400dcd8c 100644
--- a/lisp/textmodes/nroff-mode.el
+++ b/lisp/textmodes/nroff-mode.el
@@ -1,6 +1,6 @@
;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source
-;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2011
+;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el
index 91f6624e7a3..a45be0ae7f6 100644
--- a/lisp/textmodes/page-ext.el
+++ b/lisp/textmodes/page-ext.el
@@ -1,6 +1,6 @@
;;; page-ext.el --- extended page handling commands
-;; Copyright (C) 1990-1991, 1993-1994, 2001-2011
+;; Copyright (C) 1990-1991, 1993-1994, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Robert J. Chassell <bob@gnu.org>
diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el
index 95ba7ebd86f..953c7e65490 100644
--- a/lisp/textmodes/page.el
+++ b/lisp/textmodes/page.el
@@ -1,6 +1,6 @@
;;; page.el --- page motion commands for Emacs
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: wp convenience
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index b47924bc1f2..5a5942aa29d 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -1,6 +1,6 @@
;;; paragraphs.el --- paragraph and sentence parsing
-;; Copyright (C) 1985-1987, 1991, 1994-1997, 1999-2011
+;; Copyright (C) 1985-1987, 1991, 1994-1997, 1999-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index 3356ce195f2..e663c1b45f4 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -1,6 +1,6 @@
;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
-;; Copyright (C) 1985, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: FSF
@@ -31,7 +31,7 @@
;;; Code:
(defgroup picture nil
- "Picture mode --- editing using quarter-plane screen model."
+ "Editing text-based pictures (\"ASCII art\")."
:prefix "picture-"
:group 'wp)
@@ -63,15 +63,17 @@
;; Picture Movement Commands
-;; When a cursor is on a wide-column character (e.g. Chinese,
-;; Japanese, Korean), this variable tells the desired current column
-;; which may be different from (current-column).
-(defvar picture-desired-column 0)
+(defvar picture-desired-column 0
+ "Desired current column for Picture mode.
+When a cursor is on a wide-column character (e.g. Chinese,
+Japanese, Korean), this may may be different from `current-column'.")
+
-;; If the value of picture-desired-column is far from the current
-;; column, or if the arg ADJUST-TO-CURRENT is non-nil, set it to the
-;; current column. Return the current column.
(defun picture-update-desired-column (adjust-to-current)
+ "Maybe update `picture-desired-column'.
+If the value of `picture-desired-column' is more than one column
+from `current-column', or if the argument ADJUST-TO-CURRENT is
+non-nil, set it to the current column. Return `current-column'."
(let ((current-column (current-column)))
(if (or adjust-to-current
(< picture-desired-column (1- current-column))
@@ -211,7 +213,7 @@ The mode line is updated to reflect the current direction."
"Move point in direction of current picture motion in Picture mode.
With ARG do it that many times. Useful for delineating rectangles in
conjunction with diagonal picture motion.
-Do \\[command-apropos] picture-movement to see commands which control motion."
+Use \"\\[command-apropos] picture-movement\" to see commands which control motion."
(interactive "^p")
(picture-move-down (* arg picture-vertical-step))
(picture-forward-column (* arg picture-horizontal-step)))
@@ -220,7 +222,7 @@ Do \\[command-apropos] picture-movement to see commands which control motion."
"Move point in direction opposite of current picture motion in Picture mode.
With ARG do it that many times. Useful for delineating rectangles in
conjunction with diagonal picture motion.
-Do \\[command-apropos] picture-movement to see commands which control motion."
+Use \"\\[command-apropos] picture-movement\" to see commands which control motion."
(interactive "^p")
(picture-motion (- arg)))
@@ -240,8 +242,7 @@ Do \\[command-apropos] picture-movement to see commands which control motion."
(spacing (when (display-graphic-p frame)
(or (with-current-buffer (window-buffer window)
line-spacing)
- (frame-parameter frame 'line-spacing))))
- rows cols)
+ (frame-parameter frame 'line-spacing)))))
(cond ((floatp spacing)
(setq spacing (truncate (* spacing char-ht))))
((null spacing)
@@ -280,7 +281,7 @@ Do \\[command-apropos] picture-movement to see commands which control motion."
"Insert this character in place of character previously at the cursor.
The cursor then moves in the direction you previously specified
with the commands `picture-movement-right', `picture-movement-up', etc.
-Do \\[command-apropos] `picture-movement' to see those commands."
+Use \"\\[command-apropos] picture-movement\" to see those commands."
(interactive "p")
(picture-update-desired-column (not (eq this-command last-command)))
(picture-insert last-command-event arg)) ; Always a character in this case.
@@ -378,8 +379,10 @@ With positive argument insert that many lines."
(defcustom picture-tab-chars "!-~"
"A character set which controls behavior of commands.
-\\[picture-set-tab-stops] and \\[picture-tab-search]. It is NOT a
-regular expression, any regexp special characters will be quoted.
+\\[picture-set-tab-stops] and \\[picture-tab-search].
+The syntax for this variable is like the syntax used inside of `[...]'
+in a regular expression--but without the `[' and the `]'.
+It is NOT a regular expression, any regexp special characters will be quoted.
It defines a set of \"interesting characters\" to look for when setting
\(or searching for) tab stops, initially \"!-~\" (all printing characters).
For example, suppose that you are editing a table which is formatted thus:
@@ -602,64 +605,65 @@ Leaves the region surrounding the rectangle."
;; Picture Keymap, entry and exit points.
-(defvar picture-mode-map nil)
-
-(defun picture-substitute (oldfun newfun)
- (define-key picture-mode-map (vector 'remap oldfun) newfun))
+(defalias 'picture-delete-char 'delete-char)
-(if (not picture-mode-map)
- (progn
- (setq picture-mode-map (make-keymap))
- (picture-substitute 'self-insert-command 'picture-self-insert)
- (picture-substitute 'completion-separator-self-insert-command
+(defvar picture-mode-map
+ (let ((map (make-keymap)))
+ (define-key map [remap self-insert-command] 'picture-self-insert)
+ (define-key map [remap self-insert-command] 'picture-self-insert)
+ (define-key map [remap completion-separator-self-insert-command]
'picture-self-insert)
- (picture-substitute 'completion-separator-self-insert-autofilling
+ (define-key map [remap completion-separator-self-insert-autofilling]
'picture-self-insert)
- (picture-substitute 'forward-char 'picture-forward-column)
- (picture-substitute 'backward-char 'picture-backward-column)
- (picture-substitute 'delete-char 'picture-clear-column)
+ (define-key map [remap forward-char] 'picture-forward-column)
+ (define-key map [remap right-char] 'picture-forward-column)
+ (define-key map [remap backward-char] 'picture-backward-column)
+ (define-key map [remap left-char] 'picture-backward-column)
+ (define-key map [remap delete-char] 'picture-clear-column)
;; There are two possibilities for what is normally on DEL.
- (picture-substitute 'backward-delete-char-untabify 'picture-backward-clear-column)
- (picture-substitute 'delete-backward-char 'picture-backward-clear-column)
- (picture-substitute 'kill-line 'picture-clear-line)
- (picture-substitute 'open-line 'picture-open-line)
- (picture-substitute 'newline 'picture-newline)
- (picture-substitute 'newline-and-indent 'picture-duplicate-line)
- (picture-substitute 'next-line 'picture-move-down)
- (picture-substitute 'previous-line 'picture-move-up)
- (picture-substitute 'beginning-of-line 'picture-beginning-of-line)
- (picture-substitute 'end-of-line 'picture-end-of-line)
- (picture-substitute 'mouse-set-point 'picture-mouse-set-point)
-
- (define-key picture-mode-map "\C-c\C-d" 'delete-char)
- (define-key picture-mode-map "\e\t" 'picture-toggle-tab-state)
- (define-key picture-mode-map "\t" 'picture-tab)
- (define-key picture-mode-map "\e\t" 'picture-tab-search)
- (define-key picture-mode-map "\C-c\t" 'picture-set-tab-stops)
- (define-key picture-mode-map "\C-c\C-k" 'picture-clear-rectangle)
- (define-key picture-mode-map "\C-c\C-w" 'picture-clear-rectangle-to-register)
- (define-key picture-mode-map "\C-c\C-y" 'picture-yank-rectangle)
- (define-key picture-mode-map "\C-c\C-x" 'picture-yank-rectangle-from-register)
- (define-key picture-mode-map "\C-c\C-r" 'picture-draw-rectangle)
- (define-key picture-mode-map "\C-c\C-c" 'picture-mode-exit)
- (define-key picture-mode-map "\C-c\C-f" 'picture-motion)
- (define-key picture-mode-map "\C-c\C-b" 'picture-motion-reverse)
- (define-key picture-mode-map "\C-c<" 'picture-movement-left)
- (define-key picture-mode-map "\C-c>" 'picture-movement-right)
- (define-key picture-mode-map "\C-c^" 'picture-movement-up)
- (define-key picture-mode-map "\C-c." 'picture-movement-down)
- (define-key picture-mode-map "\C-c`" 'picture-movement-nw)
- (define-key picture-mode-map "\C-c'" 'picture-movement-ne)
- (define-key picture-mode-map "\C-c/" 'picture-movement-sw)
- (define-key picture-mode-map "\C-c\\" 'picture-movement-se)
- (define-key picture-mode-map [(control ?c) left] 'picture-movement-left)
- (define-key picture-mode-map [(control ?c) right] 'picture-movement-right)
- (define-key picture-mode-map [(control ?c) up] 'picture-movement-up)
- (define-key picture-mode-map [(control ?c) down] 'picture-movement-down)
- (define-key picture-mode-map [(control ?c) home] 'picture-movement-nw)
- (define-key picture-mode-map [(control ?c) prior] 'picture-movement-ne)
- (define-key picture-mode-map [(control ?c) end] 'picture-movement-sw)
- (define-key picture-mode-map [(control ?c) next] 'picture-movement-se)))
+ (define-key map [remap backward-delete-char-untabify]
+ 'picture-backward-clear-column)
+ (define-key map [remap delete-backward-char] 'picture-backward-clear-column)
+ (define-key map [remap kill-line] 'picture-clear-line)
+ (define-key map [remap open-line] 'picture-open-line)
+ (define-key map [remap newline] 'picture-newline)
+ (define-key map [remap newline-and-indent] 'picture-duplicate-line)
+ (define-key map [remap next-line] 'picture-move-down)
+ (define-key map [remap previous-line] 'picture-move-up)
+ (define-key map [remap move-beginning-of-line] 'picture-beginning-of-line)
+ (define-key map [remap move-end-of-line] 'picture-end-of-line)
+ (define-key map [remap mouse-set-point] 'picture-mouse-set-point)
+ (define-key map "\C-c\C-d" 'picture-delete-char)
+ (define-key map "\e\t" 'picture-toggle-tab-state)
+ (define-key map "\t" 'picture-tab)
+ (define-key map "\e\t" 'picture-tab-search)
+ (define-key map "\C-c\t" 'picture-set-tab-stops)
+ (define-key map "\C-c\C-k" 'picture-clear-rectangle)
+ (define-key map "\C-c\C-w" 'picture-clear-rectangle-to-register)
+ (define-key map "\C-c\C-y" 'picture-yank-rectangle)
+ (define-key map "\C-c\C-x" 'picture-yank-rectangle-from-register)
+ (define-key map "\C-c\C-r" 'picture-draw-rectangle)
+ (define-key map "\C-c\C-c" 'picture-mode-exit)
+ (define-key map "\C-c\C-f" 'picture-motion)
+ (define-key map "\C-c\C-b" 'picture-motion-reverse)
+ (define-key map "\C-c<" 'picture-movement-left)
+ (define-key map "\C-c>" 'picture-movement-right)
+ (define-key map "\C-c^" 'picture-movement-up)
+ (define-key map "\C-c." 'picture-movement-down)
+ (define-key map "\C-c`" 'picture-movement-nw)
+ (define-key map "\C-c'" 'picture-movement-ne)
+ (define-key map "\C-c/" 'picture-movement-sw)
+ (define-key map "\C-c\\" 'picture-movement-se)
+ (define-key map [(control ?c) left] 'picture-movement-left)
+ (define-key map [(control ?c) right] 'picture-movement-right)
+ (define-key map [(control ?c) up] 'picture-movement-up)
+ (define-key map [(control ?c) down] 'picture-movement-down)
+ (define-key map [(control ?c) home] 'picture-movement-nw)
+ (define-key map [(control ?c) prior] 'picture-movement-ne)
+ (define-key map [(control ?c) end] 'picture-movement-sw)
+ (define-key map [(control ?c) next] 'picture-movement-se)
+ map)
+ "Keymap used in `picture-mode'.")
(defcustom picture-mode-hook nil
"If non-nil, its value is called on entry to Picture mode.
@@ -720,7 +724,7 @@ You can edit tabular text with these commands:
You can manipulate text with these commands:
Clear ARG columns after point without moving: \\[picture-clear-column]
- Delete char at point: \\[delete-char]
+ Delete char at point: \\[picture-delete-char]
Clear ARG columns backward: \\[picture-backward-clear-column]
Clear ARG lines, advancing over them: \\[picture-clear-line]
(the cleared text is saved in the kill ring)
diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el
index 7810cc6d57a..a47d6cfa1b1 100644
--- a/lisp/textmodes/po.el
+++ b/lisp/textmodes/po.el
@@ -1,6 +1,6 @@
;;; po.el --- basic support of PO translation files -*- coding: latin-1; -*-
-;; Copyright (C) 1995-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1998, 2000-2012 Free Software Foundation, Inc.
;; Authors: Franois Pinard <pinard@iro.umontreal.ca>,
;; Greg McGary <gkm@magilla.cichlid.com>,
diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el
index 557978395c1..62fa68ca793 100644
--- a/lisp/textmodes/refbib.el
+++ b/lisp/textmodes/refbib.el
@@ -1,6 +1,6 @@
;;; refbib.el --- convert refer-style references to ones usable by Latex bib
-;; Copyright (C) 1989, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 2001-2012 Free Software Foundation, Inc.
;; Author: Henry Kautz <kautz@research.att.com>
;; Maintainer: FSF
@@ -64,7 +64,7 @@
:group 'wp)
(defcustom r2b-trace-on nil
- "*Non-nil means trace conversion."
+ "Non-nil means trace conversion."
:type 'boolean
:group 'refbib)
@@ -128,7 +128,7 @@ in `r2b-proceedings-list' (although it wouldn't cause an error)."
This is in addition to the `r2b-capitalize-title-stop-words'.")
(defcustom r2b-delimit-with-quote t
- "*If true, then use \" to delimit fields, otherwise use braces."
+ "If true, then use \" to delimit fields, otherwise use braces."
:type 'boolean
:group 'refbib)
@@ -204,12 +204,12 @@ This is in addition to the `r2b-capitalize-title-stop-words'.")
(buffer-substring (match-beginning exp) (match-end exp)))
(defcustom r2b-out-buf-name "*Out*"
- "*Name of buffer for output from refer-to-bibtex."
+ "Name of buffer for output from refer-to-bibtex."
:type 'string
:group 'refbib)
(defcustom r2b-log-name "*Log*"
- "*Name of buffer for logs errors from refer-to-bibtex."
+ "Name of buffer for logs errors from refer-to-bibtex."
:type 'string
:group 'refbib)
diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el
index 7ee0fcf9da6..ad1996b005e 100644
--- a/lisp/textmodes/refer.el
+++ b/lisp/textmodes/refer.el
@@ -1,6 +1,6 @@
;;; refer.el --- look up references in bibliography files
-;; Copyright (C) 1992, 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Ashwin Ram <ashwin@cc.gatech.edu>
;; Maintainer: Gernot Heiser <gernot@acm.org>
diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el
index d60b7594c07..d6b355bdd0d 100644
--- a/lisp/textmodes/refill.el
+++ b/lisp/textmodes/refill.el
@@ -1,6 +1,6 @@
;;; refill.el --- `auto-fill' by refilling paragraphs on changes
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Maintainer: Miles Bader <miles@gnu.org>
@@ -83,8 +83,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(defgroup refill nil
"Refilling paragraphs on changes."
:group 'fill)
@@ -169,8 +167,8 @@ complex processing.")
"Post-command function to do refilling (conditionally)."
(when refill-doit ; there was a change
;; There's probably scope for more special cases here...
- (case this-command
- (self-insert-command
+ (pcase this-command
+ (`self-insert-command
;; Treat self-insertion commands specially, since they don't
;; always reset `refill-doit' -- for self-insertion commands that
;; *don't* cause a refill, we want to leave it turned on so that
@@ -180,9 +178,9 @@ complex processing.")
;; newline, covered below).
(refill-fill-paragraph-at refill-doit)
(setq refill-doit nil)))
- ((quoted-insert fill-paragraph fill-region) nil)
- ((newline newline-and-indent open-line indent-new-comment-line
- reindent-then-newline-and-indent)
+ ((or `quoted-insert `fill-paragraph `fill-region) nil)
+ ((or `newline `newline-and-indent `open-line `indent-new-comment-line
+ `reindent-then-newline-and-indent)
;; Don't zap what was just inserted.
(save-excursion
(beginning-of-line) ; for newline-and-indent
@@ -196,7 +194,7 @@ complex processing.")
(save-restriction
(narrow-to-region (line-beginning-position) (point-max))
(refill-fill-paragraph-at refill-doit))))
- (t
+ (_
(refill-fill-paragraph-at refill-doit)))
(setq refill-doit nil)))
diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el
index eba19c25ef6..72013c5b241 100644
--- a/lisp/textmodes/reftex-auc.el
+++ b/lisp/textmodes/reftex-auc.el
@@ -1,11 +1,9 @@
;;; reftex-auc.el --- RefTeX's interface to AUCTeX
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; 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 e0fd940208a..52fa6dbf9d2 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -1,11 +1,9 @@
;;; reftex-cite.el --- creating citations with RefTeX
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; 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 2aecc34e2b0..7d102e5a802 100644
--- a/lisp/textmodes/reftex-dcr.el
+++ b/lisp/textmodes/reftex-dcr.el
@@ -1,11 +1,9 @@
;;; reftex-dcr.el --- viewing cross references and citations with RefTeX
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; 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))
@@ -316,7 +315,7 @@ With argument, actually select the window showing the cross reference."
(run-hooks 'reftex-display-copied-context-hook)))))
(defvar reftex-use-itimer-in-xemacs nil
- "*Non-nil means use the idle timers in XEmacs for crossref display.
+ "Non-nil means use the idle timers in XEmacs for crossref display.
Currently, idle timer restart is broken and we use the post-command-hook.")
(defun reftex-toggle-auto-view-crossref ()
@@ -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 bf46635c479..ebe0aae73f8 100644
--- a/lisp/textmodes/reftex-global.el
+++ b/lisp/textmodes/reftex-global.el
@@ -1,11 +1,9 @@
;;; reftex-global.el --- operations on entire documents with RefTeX
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
-;; Package: reftex
;; This file is part of GNU Emacs.
@@ -350,9 +348,8 @@ Also checks if buffers visiting the files are in read-only mode."
;; variable `multi-isearch-next-buffer-function'.
(defun reftex-isearch-wrap-function ()
- (if (not isearch-word)
- (switch-to-buffer
- (funcall isearch-next-buffer-function (current-buffer) t)))
+ (switch-to-buffer
+ (funcall isearch-next-buffer-function (current-buffer) t))
(goto-char (if isearch-forward (point-min) (point-max))))
(defun reftex-isearch-push-state-function ()
@@ -364,14 +361,7 @@ Also checks if buffers visiting the files are in read-only mode."
(defun reftex-isearch-isearch-search (string bound noerror)
(let ((nxt-buff nil)
- (search-fun
- (cond
- (isearch-word
- (if isearch-forward 'word-search-forward 'word-search-backward))
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward)))))
+ (search-fun (isearch-search-fun-default)))
(or
(funcall search-fun string bound noerror)
(unless bound
@@ -415,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))
@@ -445,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)
@@ -468,7 +459,7 @@ With no argument, this command toggles
(kill-local-variable 'isearch-next-buffer-function))
(setq reftex-isearch-minor-mode nil))))
(remove-hook 'reftex-mode-hook 'reftex-isearch-minor-mode)))
- ;; Force modeline redisplay.
+ ;; Force mode line redisplay.
(set-buffer-modified-p (buffer-modified-p))))
(add-minor-mode 'reftex-isearch-minor-mode "/I" nil nil
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index f0ceaa74d26..5b884dd8480 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -1,11 +1,9 @@
;;; reftex-index.el --- index support with RefTeX
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; 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
@@ -274,6 +268,8 @@ will prompt for other arguments."
(and newtag (cdr cell) (not (member newtag (cdr cell)))
(push newtag (cdr cell)))))
+(define-obsolete-variable-alias
+ 'reftex-index-map 'reftex-index-mode-map "24.1")
(defvar reftex-index-mode-map
(let ((map (make-sparse-keymap)))
;; Index map
@@ -377,8 +373,6 @@ will prompt for other arguments."
map)
"Keymap used for *Index* buffers.")
-(define-obsolete-variable-alias
- 'reftex-index-map 'reftex-index-mode-map "24.1")
(defvar reftex-index-menu)
@@ -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
@@ -1179,6 +1171,8 @@ This gets refreshed in every phrases command.")
"Font lock keywords for reftex-index-phrases-mode.")
(defvar reftex-index-phrases-font-lock-defaults nil
"Font lock defaults for reftex-index-phrases-mode.")
+(define-obsolete-variable-alias
+ 'reftex-index-phrases-map 'reftex-index-phrases-mode-map "24.1")
(defvar reftex-index-phrases-mode-map
(let ((map (make-sparse-keymap)))
;; Keybindings and Menu for phrases buffer
@@ -1244,9 +1238,11 @@ This gets refreshed in every phrases command.")
map)
"Keymap used for *toc* buffer.")
-(define-obsolete-variable-alias
- 'reftex-index-phrases-map 'reftex-index-phrases-mode-map "24.1")
-
+(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 1a0f7ec5836..791b5d7b945 100644
--- a/lisp/textmodes/reftex-parse.el
+++ b/lisp/textmodes/reftex-parse.el
@@ -1,11 +1,9 @@
;;; reftex-parse.el --- parser functions for RefTeX
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; 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 d622603236e..9b9f1a0f68f 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -1,11 +1,9 @@
;;; reftex-ref.el --- code to create labels and references with RefTeX
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; 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.
@@ -313,8 +310,7 @@ also applies `reftex-translate-to-ascii-function' to the string."
(save-match-data
(cond
((equal letter "f")
- (file-name-sans-extension
- (file-name-nondirectory (buffer-file-name))))
+ (file-name-base))
((equal letter "F")
(let ((masterdir (file-name-directory (reftex-TeX-master-file)))
(file (file-name-sans-extension (buffer-file-name))))
@@ -323,8 +319,7 @@ also applies `reftex-translate-to-ascii-function' to the string."
(substring file (length masterdir))
file)))
((equal letter "m")
- (file-name-sans-extension
- (file-name-nondirectory (reftex-TeX-master-file))))
+ (file-name-base (reftex-TeX-master-file)))
((equal letter "M")
(file-name-nondirectory
(substring (file-name-directory (reftex-TeX-master-file))
@@ -415,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))
@@ -474,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))
@@ -793,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.
@@ -849,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 f4f10f1d1e0..68355f9b16f 100644
--- a/lisp/textmodes/reftex-sel.el
+++ b/lisp/textmodes/reftex-sel.el
@@ -1,11 +1,9 @@
;;; reftex-sel.el --- the selection modes for RefTeX
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; 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.
@@ -71,6 +68,8 @@
(define-key map "-" 'negative-argument)
map))
+(define-obsolete-variable-alias
+ 'reftex-select-label-map 'reftex-select-label-mode-map "24.1")
(defvar reftex-select-label-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map reftex-select-shared-map)
@@ -84,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)
@@ -102,8 +101,6 @@
"Keymap used for *RefTeX Select* buffer, when selecting a label.
This keymap can be used to configure the label selection process which is
started with the command \\[reftex-reference].")
-(define-obsolete-variable-alias
- 'reftex-select-label-map 'reftex-select-label-mode-map "24.1")
(define-derived-mode reftex-select-label-mode fundamental-mode "LSelect"
"Major mode for selecting a label in a LaTeX document.
@@ -126,6 +123,8 @@ During a selection process, these are the local bindings.
;; We do not set a local map - reftex-select-item does this.
)
+(define-obsolete-variable-alias
+ 'reftex-select-bib-map 'reftex-select-bib-mode-map "24.1")
(defvar reftex-select-bib-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map reftex-select-shared-map)
@@ -147,8 +146,6 @@ During a selection process, these are the local bindings.
"Keymap used for *RefTeX Select* buffer, when selecting a BibTeX entry.
This keymap can be used to configure the BibTeX selection process which is
started with the command \\[reftex-citation].")
-(define-obsolete-variable-alias
- 'reftex-select-bib-map 'reftex-select-bib-mode-map "24.1")
(define-derived-mode reftex-select-bib-mode fundamental-mode "BSelect"
"Major mode for selecting a citation key in a LaTeX document.
@@ -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 25be64a3af2..4f73322d3f5 100644
--- a/lisp/textmodes/reftex-toc.el
+++ b/lisp/textmodes/reftex-toc.el
@@ -1,11 +1,9 @@
;;; reftex-toc.el --- RefTeX's table of contents mode
-;; Copyright (C) 1997-2000, 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2000, 2003-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
-;; Package: reftex
;; This file is part of GNU Emacs.
@@ -31,6 +29,7 @@
(require 'reftex)
;;;
+(define-obsolete-variable-alias 'reftex-toc-map 'reftex-toc-mode-map "24.1")
(defvar reftex-toc-mode-map
(let ((map (make-sparse-keymap)))
@@ -122,7 +121,6 @@
map)
"Keymap used for *toc* buffer.")
-(define-obsolete-variable-alias 'reftex-toc-map 'reftex-toc-mode-map "24.1")
(defvar reftex-toc-menu)
(defvar reftex-last-window-height nil)
@@ -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 1b503c78afd..2c1fc972057 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -1,11 +1,9 @@
;;; reftex-vars.el --- configuration variables for RefTeX
-;; Copyright (C) 1997-1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
-;; Version: 4.31
-;; Package: reftex
;; This file is part of GNU Emacs.
@@ -90,6 +88,15 @@
(wrapfig "The wrapfigure environment"
(("wrapfigure" ?f nil nil caption)))
+ (ctable "The ctable package"
+ (("\\ctable[]{}{}{}" ?t "tab:" "\\ref{%s}" 1 ("table" "Tabelle"))))
+
+ (listings "The listings package"
+ (("lstlisting" ?l "lst:" "~\\ref{%s}" nil (regexp "[Ll]isting"))))
+
+ (minted "The minted package"
+ (("minted" ?l "lst:" "~\\ref{%s}" nil (regexp "[Ll]isting"))))
+
;; The LaTeX core stuff
(LaTeX "LaTeX default environments"
(("section" ?s "%S" "~\\ref{%s}" (nil . t)
@@ -120,9 +127,7 @@
;; The label macro is hard coded, but it *could* be defined like this:
;;("\\label{*}" nil nil nil nil)
- ))
-
- )
+ )))
"The default label environment descriptions.
Lower-case symbols correspond to a style file of the same name in the LaTeX
distribution. Mixed-case symbols are convenience aliases.")
@@ -200,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:
@@ -232,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-"
@@ -254,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)
@@ -294,7 +304,7 @@ select the nearest entry with the correct new level."
(symbol :tag "function " my-level-func)))))
(defcustom reftex-toc-max-level 100
- "*The maximum level of toc entries which will be included in the TOC.
+ "The maximum level of toc entries which will be included in the TOC.
Section headings with a bigger level will be ignored. In RefTeX, chapters
are level 1, sections are level 2 etc.
This variable can be changed from within the *toc* buffer with the `t' key."
@@ -302,7 +312,7 @@ This variable can be changed from within the *toc* buffer with the `t' key."
:type 'integer)
(defcustom reftex-part-resets-chapter nil
- "*Non-nil means, \\part is like any other sectioning command.
+ "Non-nil means, \\part is like any other sectioning command.
This means, part numbers will be included in the numbering of chapters, and
chapter counters will be reset for each part.
When nil (the default), parts are special, do not reset the chapter counter
@@ -312,7 +322,7 @@ and also do not show up in chapter numbers."
(defcustom reftex-auto-recenter-toc 'frame
- "*Non-nil means, turn automatic recentering of *TOC* window on.
+ "Non-nil means, turn automatic recentering of *TOC* window on.
When active, the *TOC* window will always show the section you
are currently working in. Recentering happens whenever Emacs is idle for
more than `reftex-idle-time' seconds.
@@ -322,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.
@@ -335,12 +345,12 @@ This feature can be turned on and off from the menu
(const :tag "in dedicated frame only" frame)))
(defcustom reftex-toc-split-windows-horizontally nil
- "*Non-nil means, create TOC window by splitting window horizontally."
+ "Non-nil means, create TOC window by splitting window horizontally."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(defcustom reftex-toc-split-windows-fraction .3
- "*Fraction of the width or height of the frame to be used for TOC window.
+ "Fraction of the width or height of the frame to be used for TOC window.
See also `reftex-toc-split-windows-horizontally'."
:group 'reftex-table-of-contents-browser
:type 'number)
@@ -349,7 +359,7 @@ See also `reftex-toc-split-windows-horizontally'."
"This variable is obsolete, use `reftex-toc-split-windows-fraction' instead.")
(defcustom reftex-toc-keep-other-windows t
- "*Non-nil means, split the selected window to display the *toc* buffer.
+ "Non-nil means, split the selected window to display the *toc* buffer.
This helps to keep the window configuration, but makes the *toc* small.
When nil, all other windows except the selected one will be deleted, so
that the *toc* window fills half the frame."
@@ -357,27 +367,27 @@ that the *toc* window fills half the frame."
:type 'boolean)
(defcustom reftex-toc-include-file-boundaries nil
- "*Non-nil means, include file boundaries in *toc* buffer.
+ "Non-nil means, include file boundaries in *toc* buffer.
This flag can be toggled from within the *toc* buffer with the `F' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(defcustom reftex-toc-include-labels nil
- "*Non-nil means, include labels in *toc* buffer.
+ "Non-nil means, include labels in *toc* buffer.
This flag can be toggled from within the *toc* buffer with the `l' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(defcustom reftex-toc-include-index-entries nil
- "*Non-nil means, include index entries in *toc* buffer.
+ "Non-nil means, include index entries in *toc* buffer.
This flag can be toggled from within the *toc* buffer with the `i' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(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
+ "Non-nil means, promotion/demotion commands first prompt for confirmation.
+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
@@ -386,22 +396,22 @@ changed."
(number :tag "When more than N sections" :value 2)))
(defcustom reftex-toc-include-context nil
- "*Non-nil means, include context with labels in the *toc* buffer.
+ "Non-nil means, include context with labels in the *toc* buffer.
Context will only be shown when labels are visible as well.
This flag can be toggled from within the *toc* buffer with the `c' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(defcustom reftex-toc-follow-mode nil
- "*Non-nil means, point in *toc* buffer will cause other window to follow.
+ "Non-nil means, point in *toc* buffer will cause other window to follow.
The other window will show the corresponding part of the document.
This flag can be toggled from within the *toc* buffer with the `f' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(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."
+ "Non-nil means, follow-mode will revisit files if necessary.
+If nil, follow-mode will be suspended for stuff in unvisited files."
:group 'reftex-table-of-contents-browser
:group 'reftex-referencing-labels
:type 'boolean)
@@ -423,7 +433,8 @@ When nil, follow-mode will be suspended for stuff in unvisited files."
(defcustom reftex-default-label-alist-entries
'(amsmath endnotes fancybox floatfig longtable picinpar
- rotating sidecap subfigure supertab wrapfig LaTeX)
+ rotating sidecap subfigure supertab wrapfig
+ listings minted ctable LaTeX)
"Default label alist specifications. LaTeX should always be the last entry.
The value of this variable is a list of symbols with associations in the
constant `reftex-label-alist-builtin'. Check that constant for a full list
@@ -444,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
@@ -473,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).
@@ -492,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:\".
@@ -508,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.
@@ -525,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.
@@ -576,7 +586,7 @@ will use
Any list entry may also be a symbol. If that has an association in
`reftex-label-alist-builtin', the cddr of that association is spliced into the
list. However, builtin defaults should normally be set with the variable
-`reftex-default-label-alist-entries."
+`reftex-default-label-alist-entries'."
:group 'reftex-defining-label-environments
:set 'reftex-set-dirty
:type
@@ -747,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)
@@ -812,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)
@@ -939,36 +950,90 @@ 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."
+ "Number of spaces to be used for indentation per section level."
:group 'reftex-referencing-labels
:type 'integer)
;;;###autoload(put 'reftex-level-indent 'safe-local-variable 'integerp)
(defcustom reftex-guess-label-type t
- "*Non-nil means, `reftex-reference' will try to guess the label type.
+ "Non-nil means, `reftex-reference' will try to guess the label type.
To do that, RefTeX will look at the word before the cursor and compare it with
the words given in `reftex-label-alist'. When it finds a match, RefTeX will
immediately offer the correct label menu - otherwise it will prompt you for
@@ -979,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)
@@ -1001,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))
@@ -1009,7 +1078,7 @@ string to insert into the buffer."
(defvar reftex-bibfile-ignore-list nil) ; compatibility
(defcustom reftex-bibfile-ignore-regexps nil
- "*List of regular expressions to exclude files in \\bibliography{..}.
+ "List of regular expressions to exclude files in \\bibliography{..}.
File names matched by these regexps will not be parsed by RefTeX.
Intended for files which contain only `@string' macro definitions and the
like, which are ignored by RefTeX anyway."
@@ -1018,7 +1087,7 @@ like, which are ignored by RefTeX anyway."
:type '(repeat (regexp)))
(defcustom reftex-default-bibliography nil
- "*List of BibTeX database files which should be used if none are specified.
+ "List of BibTeX database files which should be used if none are specified.
When `reftex-citation' is called from a document which has neither a
`\\bibliography{..}' statement nor a `thebibliography' environment,
RefTeX will scan these files instead. Intended for using `reftex-citation'
@@ -1028,7 +1097,7 @@ path."
:type '(repeat (file)))
(defcustom reftex-sort-bibtex-matches 'reverse-year
- "*Sorting of the entries found in BibTeX databases by reftex-citation.
+ "Sorting of the entries found in BibTeX databases by reftex-citation.
Possible values:
nil Do not sort entries.
'author Sort entries by author name.
@@ -1041,7 +1110,7 @@ nil Do not sort entries.
(const :tag "by year, reversed" reverse-year)))
(defcustom reftex-cite-format 'default
- "*The format of citations to be inserted into the buffer.
+ "The format of citations to be inserted into the buffer.
It can be a string or an alist or a symbol. In the simplest case this
is just the string \"\\cite{%l}\", which is also the default. See the
definition of `reftex-cite-format-builtin' for more complex examples.
@@ -1105,8 +1174,8 @@ E.g.: (setq reftex-cite-format 'natbib)"
(string :tag "Format string" "")))))
(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
+ "Non-nil means, prompt for empty optional arguments in cite macros.
+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:
@@ -1123,7 +1192,7 @@ the buffer. See `reftex-cite-cleanup-optional-args'."
(const :tag "Never" nil)))
(defcustom reftex-cite-cleanup-optional-args t
- "*Non-nil means, remove unnecessary empty optional arguments in cite macros.
+ "Non-nil means, remove unnecessary empty optional arguments in cite macros.
The cite macros provided by some packages (for example
natbib) allow specifying two optional arguments, one for a prefix to
the citation, and a second for a postfix. When only one optional
@@ -1141,7 +1210,7 @@ can be turned off."
:type 'boolean)
(defcustom reftex-comment-citations nil
- "*Non-nil means add a comment for each citation describing the full entry.
+ "Non-nil means add a comment for each citation describing the full entry.
The comment is formatted according to `reftex-cite-comment-format'."
:group 'reftex-citation-support
:type 'boolean)
@@ -1181,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
@@ -1195,7 +1282,7 @@ should return the string to insert into the buffer."
:group 'reftex)
(defcustom reftex-support-index t
- "*Non-nil means, index entries are parsed as well.
+ "Non-nil means, index entries are parsed as well.
Index support is resource intensive and the internal structure holding the
parsed information can become quite big. Therefore it can be turned off.
When this is nil and you execute a command which requires index support,
@@ -1215,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)
@@ -1354,7 +1443,7 @@ has higher priority than this logical `or'."
:type 'regexp)
(defcustom reftex-index-phrases-search-whole-words t
- "*Non-nil means phrases search will look for whole words, not subwords.
+ "Non-nil means phrases search will look for whole words, not subwords.
This works by requiring word boundaries at the beginning and end of
the search string. When the search phrase already has a non-word-char
at one of these points, no word boundary is required there."
@@ -1362,7 +1451,7 @@ at one of these points, no word boundary is required there."
:type 'boolean)
(defcustom reftex-index-phrases-case-fold-search t
- "*Non-nil means, searching for index phrases will ignore case."
+ "Non-nil means, searching for index phrases will ignore case."
:group 'reftex-index-support
:type 'boolean)
@@ -1375,7 +1464,7 @@ If the function returns nil, the current match is skipped."
(function)))
(defcustom reftex-index-phrases-skip-indexed-matches nil
- "*Non-nil means, skip matches which appear to be indexed already.
+ "Non-nil means, skip matches which appear to be indexed already.
When doing global indexing from the phrases buffer, searches for some
phrases may match at places where that phrase was already indexed. In
particular when indexing an already processed document again, this
@@ -1387,7 +1476,7 @@ be ignored."
:type 'boolean)
(defcustom reftex-index-phrases-wrap-long-lines nil
- "*Non-nil means, when indexing from the phrases buffer, wrap lines.
+ "Non-nil means, when indexing from the phrases buffer, wrap lines.
Inserting indexing commands in a line makes the line longer - often
so long that it does not fit onto the screen. When this variable is
non-nil, newlines will be added as necessary before and/or after the
@@ -1397,7 +1486,7 @@ phrase and its index command will always end up on a single line."
:type 'boolean)
(defcustom reftex-index-phrases-sort-prefers-entry nil
- "*Non-nil means when sorting phrase lines, the explicit index entry is used.
+ "Non-nil means when sorting phrase lines, the explicit index entry is used.
Phrase lines in the phrases buffer contain a search phrase, and
sorting is normally based on these. Some phrase lines also have
an explicit index argument specified. When this variable is non-nil,
@@ -1406,7 +1495,7 @@ the index argument will be used for sorting."
:type 'boolean)
(defcustom reftex-index-phrases-sort-in-blocks t
- "*Non-nil means, empty and comment lines separate phrase buffer into blocks.
+ "Non-nil means, empty and comment lines separate phrase buffer into blocks.
Sorting will then preserve blocks, so that lines are re-arranged only
within blocks."
:group 'reftex-index-support
@@ -1425,13 +1514,13 @@ to that section."
:type '(string :tag "Capital letters"))
(defcustom reftex-index-include-context nil
- "*Non-nil means, display the index definition context in the index buffer.
+ "Non-nil means, display the index definition context in the index buffer.
This flag may also be toggled from the index buffer with the `c' key."
:group 'reftex-index-support
:type 'boolean)
(defcustom reftex-index-follow-mode nil
- "*Non-nil means, point in *Index* buffer will cause other window to follow.
+ "Non-nil means, point in *Index* buffer will cause other window to follow.
The other window will show the corresponding part of the document.
This flag can be toggled from within the *Index* buffer with the `f' key."
:group 'reftex-table-of-contents-browser
@@ -1448,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).
@@ -1463,7 +1552,7 @@ which subgroup of the match should be highlighted."
(integer :tag "Highlight Group"))))
(defcustom reftex-auto-view-crossref t
- "*Non-nil means, initially turn automatic viewing of crossref info on.
+ "Non-nil means, initially turn automatic viewing of crossref info on.
Automatic viewing of crossref info normally uses the echo area.
Whenever point is idle for more than `reftex-idle-time' seconds on the
argument of a \\ref or \\cite macro, and no other message is being
@@ -1478,28 +1567,30 @@ This feature can be turned on and off from the menu
(const :tag "in Other Window" window)))
(defcustom reftex-idle-time 1.2
- "*Time (secs) Emacs has to be idle before automatic crossref display is done.
+ "Time (secs) Emacs has to be idle before automatic crossref display is done.
Applies also to toc recentering."
:group 'reftex-viewing-cross-references
:type 'number)
(defcustom reftex-revisit-to-echo nil
- "*Non-nil means, automatic citation display will revisit files if necessary.
+ "Non-nil means, automatic citation display will revisit files if necessary.
When nil, citation display in echo area will only be active for cached
entries and for BibTeX database files with live associated buffers."
:group 'reftex-viewing-cross-references
: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)
@@ -1511,7 +1602,7 @@ for X-Symbol, but may have other uses as well."
:group 'reftex)
(defcustom reftex-texpath-environment-variables '("TEXINPUTS")
- "*List of specifications how to retrieve the search path for TeX files.
+ "List of specifications how to retrieve the search path for TeX files.
Several entries are possible.
- If an element is the name of an environment variable, its content is used.
- If an element starts with an exclamation mark, it is used as a command
@@ -1526,7 +1617,7 @@ See also `reftex-use-external-file-finders'."
:type '(repeat (string :tag "Specification")))
(defcustom reftex-bibpath-environment-variables '("BIBINPUTS" "TEXBIB")
- "*List of specifications how to retrieve search path for .bib database files.
+ "List of specifications how to retrieve search path for .bib database files.
Several entries are possible.
- If an element is the name of an environment variable, its content is used.
- If an element starts with an exclamation mark, it is used as a command
@@ -1543,7 +1634,7 @@ See also `reftex-use-external-file-finders'."
(defcustom reftex-file-extensions '(("tex" . (".tex" ".ltx"))
("bib" . (".bib")))
- "*Association list with file extensions for different file types.
+ "Association list with file extensions for different file types.
This is a list of items, each item is like: (TYPE . (DEF-EXT OTHER-EXT ...))
TYPE: File type like \"bib\" or \"tex\".
@@ -1572,7 +1663,7 @@ Note that if you are using external file finders, this option has no effect."
:type 'boolean)
(defcustom reftex-search-unrecursed-path-first t
- "*Non-nil means, search all specified directories before trying recursion.
+ "Non-nil means, search all specified directories before trying recursion.
Thus, in a path \".//:/tex/\", search first \"./\", then \"/tex/\" and then
all subdirectories of \"./\". If this option is nil, the subdirectories of
\"./\" are searched before \"/tex/\". This is mainly for speed - most of the
@@ -1583,7 +1674,7 @@ in wrong sequence."
:type 'boolean)
(defcustom reftex-use-external-file-finders nil
- "*Non-nil means, use external programs to find files.
+ "Non-nil means, use external programs to find files.
Normally, RefTeX searches the paths given in the environment variables
TEXINPUTS and BIBINPUTS to find TeX files and BibTeX database files.
With this option turned on, it calls an external program specified in the
@@ -1595,7 +1686,7 @@ the variables `reftex-texpath-environment-variables' and
(defcustom reftex-external-file-finders '(("tex" . "kpsewhich -format=.tex %f")
("bib" . "kpsewhich -format=.bib %f"))
- "*Association list with external programs to call for finding files.
+ "Association list with external programs to call for finding files.
Each entry is a cons cell (TYPE . PROGRAM).
TYPE is either \"tex\" or \"bib\". PROGRAM is the external program to use with
any arguments. %f will be replaced by the name of the file to be found.
@@ -1612,7 +1703,7 @@ Only relevant when `reftex-use-external-file-finders' is non-nil."
:group 'reftex)
(defcustom reftex-keep-temporary-buffers 1
- "*Non-nil means, keep buffers created for parsing and lookup.
+ "Non-nil means, keep buffers created for parsing and lookup.
RefTeX sometimes needs to visit files related to the current document.
We distinguish files visited for
PARSING: Parts of a multifile document loaded when (re)-parsing the document.
@@ -1637,7 +1728,7 @@ upon the variable `reftex-initialize-temporary-buffers'."
(const :tag "Keep lookup buffers only" 1)))
(defcustom reftex-initialize-temporary-buffers nil
- "*Non-nil means do initializations even when visiting file temporarily.
+ "Non-nil means do initializations even when visiting file temporarily.
When nil, RefTeX may turn off find-file hooks and other stuff to briefly
visit a file.
When t, the full default initializations are done (find-file-hook etc.).
@@ -1651,14 +1742,14 @@ do a minimal initialization."
(function-item))))
(defcustom reftex-no-include-regexps '("\\.pstex_t\\'")
- "*List of regular expressions to exclude certain input files from parsing.
+ "List of regular expressions to exclude certain input files from parsing.
If the name of a file included via \\include or \\input is matched by any
of the regular expressions in this list, that file is not parsed by RefTeX."
:group 'reftex-optimizations-for-large-documents
:type '(repeat (regexp)))
(defcustom reftex-enable-partial-scans nil
- "*Non-nil means, re-parse only 1 file when asked to re-parse.
+ "Non-nil means, re-parse only 1 file when asked to re-parse.
Re-parsing is normally requested with a `C-u' prefix to many RefTeX commands,
or with the `r' key in menus. When this option is t in a multifile document,
we will only parse the current buffer, or the file associated with the label
@@ -1669,7 +1760,7 @@ in menus."
:type 'boolean)
(defcustom reftex-allow-automatic-rescan t
- "*Non-nil means, RefTeX may rescan the document when this seems necessary.
+ "Non-nil means, RefTeX may rescan the document when this seems necessary.
Currently this applies only to rescanning after label insertion, when
the new label cannot be inserted correctly into the internal label
list."
@@ -1677,24 +1768,24 @@ list."
:type 'boolean)
(defcustom reftex-save-parse-info nil
- "*Non-nil means, save information gathered with parsing in a file.
+ "Non-nil means, save information gathered with parsing in a file.
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)
(defcustom reftex-parse-file-extension ".rel"
- "*File extension for the file in which parser information is stored.
+ "File extension for the file in which parser information is stored.
This extension is added to the base name of the master file."
:group 'reftex-optimizations-for-large-documents
:type 'string)
(defcustom reftex-use-multiple-selection-buffers nil
- "*Non-nil means use a separate selection buffer for each label type.
+ "Non-nil means use a separate selection buffer for each label type.
These buffers are kept from one selection to the next and need not to be
created for each use - so the menu generally comes up faster. The
selection buffers will be erased (and therefore updated) automatically
@@ -1705,7 +1796,7 @@ when new labels in its category are added. See the variable
:type 'boolean)
(defcustom reftex-auto-update-selection-buffers t
- "*Non-nil means, selection buffers will be updated automatically.
+ "Non-nil means, selection buffers will be updated automatically.
When a new label is defined with `reftex-label', all selection buffers
associated with that label category are emptied, in order to force an
update upon next use. When nil, the buffers are left alone and have to be
@@ -1724,14 +1815,14 @@ The value of this variable will only have any effect when
:group 'reftex)
(defcustom reftex-use-fonts t
- "*Non-nil means, use fonts in *toc* and selection buffers.
+ "Non-nil means, use fonts in *toc* and selection buffers.
Font-lock must be loaded as well to actually get fontified display.
When changing this option, a rescan may be necessary to activate the change."
:group 'reftex-fontification-configurations
:type 'boolean)
(defcustom reftex-refontify-context 1
- "*Non-nil means, re-fontify the context in the label menu with font-lock.
+ "Non-nil means, re-fontify the context in the label menu with font-lock.
This slightly slows down the creation of the label menu. It is only necessary
when you definitely want the context fontified.
@@ -1748,9 +1839,9 @@ The option is ignored when `reftex-use-fonts' is nil."
(const :tag "When necessary" 1)))
(defcustom reftex-highlight-selection 'cursor
- "*Non-nil mean, highlight selected text in selection and *toc* buffers.
+ "Non-nil mean, highlight selected text in selection and *toc* buffers.
Normally, the text near the cursor is the selected text, and it is
-highlighted. This is the entry most keys in the selction and *toc*
+highlighted. This is the entry most keys in the selection and *toc*
buffers act on. However, if you mainly use the mouse to select an
item, you may find it nice to have mouse-triggered highlighting
instead or as well. The variable may have one of these values:
@@ -1847,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,
+ "Plug-in flags for AUCTeX interface.
+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)
@@ -1892,11 +1974,10 @@ 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.
+ "Non-nil means, allow arguments of macros to be detached by whitespace.
When this is t, `aaa' will be considered as argument of \\bb in the following
construct: \\bbb [xxx] {aaa}."
:group 'reftex-miscellaneous-configurations
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index b73056a803b..bdee0fcf1d4 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -1,9 +1,8 @@
;;; reftex.el --- minor mode for doing \label, \ref, \cite, \index in LaTeX
-;; Copyright (C) 1997-2000, 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2000, 2003-2012 Free Software Foundation, Inc.
;; 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 .emacs 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 `.emacs' 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,19 +1066,33 @@ 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
- (label-re "\\\\label{\\([^}]*\\)}")
+ (wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because
+ ; match numbers are hard coded
+ (label-re (concat "\\(?:"
+ ;; Normal \label{...}
+ "\\\\label{\\([^}]*\\)}"
+ "\\|"
+ ;; keyvals [..., label = {foo}, ...]
+ ;; forms used by ctable, listings,
+ ;; minted, ...
+ "\\[[^]]*label[[:space:]]*=[[:space:]]*{?\\(?1:[^],}]+\\)}?"
+ "\\)"))
(include-re (concat wbol
"\\\\\\("
(mapconcat 'identity
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
@@ -1312,6 +1110,8 @@ This enforces rescanning the buffer on next use."
"\\)\\([[{][^]}]*[]}]\\)*[[{]\\(%s\\)[]}]"))
(find-label-re-format
(concat "\\("
+ "label[[:space:]]*=[[:space:]]*"
+ "\\|"
(mapconcat 'regexp-quote (append '("\\label")
macros-with-labels) "\\|")
"\\)\\([[{][^]}]*[]}]\\)*[[{]\\(%s\\)[]}]"))
@@ -1770,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
@@ -1986,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)))))))
@@ -2113,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
@@ -2233,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
@@ -2301,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))
@@ -2382,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))))
;;; =========================================================================
;;;
@@ -2480,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)
@@ -2560,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)
@@ -2571,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)
@@ -2586,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/remember.el b/lisp/textmodes/remember.el
index c184a90dfc2..6500160a7d3 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -1,6 +1,6 @@
;;; remember --- a mode for quickly jotting down things to remember
-;; Copyright (C) 1999-2001, 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2001, 2003-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Created: 29 Mar 1999
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index f2dba1575c2..b0adb35f768 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -1,10 +1,12 @@
;;; rst.el --- Mode for viewing and editing reStructuredText-documents.
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
-;; Authors: Martin Blais <blais@furius.ca>,
-;; Stefan Merten <smerten@oekonux.de>,
-;; David Goodger <goodger@python.org>
+;; Maintainer: Stefan Merten <smerten@oekonux.de>
+;; Author: Stefan Merten <smerten@oekonux.de>,
+;; Martin Blais <blais@furius.ca>,
+;; David Goodger <goodger@python.org>,
+;; Wei-Wei Guo <wwguocn@gmail.com>
;; This file is part of GNU Emacs.
@@ -23,19 +25,23 @@
;;; Commentary:
-;; This package provides major mode rst-mode, which supports documents marked up
-;; using the reStructuredText format. Support includes font locking as well as
-;; some convenience functions for editing. It does this by defining a Emacs
-;; major mode: rst-mode (ReST). This mode is derived from text-mode (and
-;; inherits much of it). This package also contains:
+;; This package provides major mode rst-mode, which supports documents marked
+;; up using the reStructuredText format. Support includes font locking as well
+;; as a lot of convenience functions for editing. It does this by defining a
+;; Emacs major mode: rst-mode (ReST). This mode is derived from text-mode.
+;; This package also contains:
;;
;; - Functions to automatically adjust and cycle the section underline
-;; decorations;
+;; adornments;
;; - A mode that displays the table of contents and allows you to jump anywhere
;; from it;
;; - Functions to insert and automatically update a TOC in your source
;; document;
-;; - Font-lock highlighting of notable reStructuredText structures;
+;; - Function to insert list, processing item bullets and enumerations
+;; automatically;
+;; - Font-lock highlighting of most reStructuredText structures;
+;; - Indentation and filling according to reStructuredText syntax;
+;; - Cursor movement according to reStructuredText syntax;
;; - Some other convenience functions.
;;
;; See the accompanying document in the docutils documentation about
@@ -48,21 +54,12 @@
;; http://docutils.sourceforge.net/docs/user/emacs.html
;;
;;
-;; There are a number of convenient keybindings provided by rst-mode.
-;; The main one is
-;;
-;; C-c C-a (also C-=): rst-adjust
-;;
-;; Updates or rotates the section title around point or promotes/demotes the
-;; decorations within the region (see full details below). Note that C-= is a
-;; good binding, since it allows you to specify a negative arg easily with C--
-;; C-= (easy to type), as well as ordinary prefix arg with C-u C-=.
-;;
+;; There are a number of convenient key bindings provided by rst-mode.
;; For more on bindings, see rst-mode-map below. There are also many variables
-;; that can be customized, look for defcustom and defvar in this file.
+;; that can be customized, look for defcustom in this file.
;;
;; If you use the table-of-contents feature, you may want to add a hook to
-;; update the TOC automatically everytime you adjust a section title::
+;; update the TOC automatically every time you adjust a section title::
;;
;; (add-hook 'rst-adjust-hook 'rst-toc-update)
;;
@@ -71,56 +68,20 @@
;;
;; (setq font-lock-global-modes '(not rst-mode ...))
;;
-
-
-;; CUSTOMIZATION
-;;
-;; rst
-;; ---
-;; This group contains some general customizable features.
-;;
-;; The group is contained in the wp group.
-;;
-;; rst-faces
-;; ---------
-;; This group contains all necessary for customizing fonts. The default
-;; settings use standard font-lock-*-face's so if you set these to your
-;; liking they are probably good in rst-mode also.
-;;
-;; The group is contained in the faces group as well as in the rst group.
-;;
-;; rst-faces-defaults
-;; ------------------
-;; This group contains all necessary for customizing the default fonts used for
-;; section title faces.
-;;
-;; The general idea for section title faces is to have a non-default background
-;; but do not change the background. The section level is shown by the
-;; lightness of the background color. If you like this general idea of
-;; generating faces for section titles but do not like the details this group
-;; is the point where you can customize the details. If you do not like the
-;; general idea, however, you should customize the faces used in
-;; rst-adornment-faces-alist.
;;
-;; Note: If you are using a dark background please make sure the variable
-;; frame-background-mode is set to the symbol dark. This triggers
-;; some default values which are probably right for you.
;;
-;; The group is contained in the rst-faces group.
+;; Customization is done by customizable variables contained in customization
+;; group "rst" and subgroups. Group "rst" is contained in the "wp" group.
;;
-;; All customizable features have a comment explaining their meaning.
-;; Refer to the customization of your Emacs (try ``M-x customize``).
-
;;; DOWNLOAD
-;; The latest version of this file lies in the docutils source code repository:
-;; http://svn.berlios.de/svnroot/repos/docutils/trunk/docutils/tools/editors/emacs/rst.el
-
+;; The latest release of this file lies in the docutils source code repository:
+;; http://docutils.svn.sourceforge.net/svnroot/docutils/trunk/docutils/tools/editors/emacs/rst.el
;;; INSTALLATION
-;; Add the following lines to your `.emacs' file:
+;; Add the following lines to your init file:
;;
;; (require 'rst)
;;
@@ -135,170 +96,641 @@
;; want automatically enter rst-mode from any file with compatible extensions:
;;
;; (setq auto-mode-alist
-;; (append '(("\\.txt$" . rst-mode)
-;; ("\\.rst$" . rst-mode)
-;; ("\\.rest$" . rst-mode)) auto-mode-alist))
+;; (append '(("\\.txt\\'" . rst-mode)
+;; ("\\.rst\\'" . rst-mode)
+;; ("\\.rest\\'" . rst-mode)) auto-mode-alist))
;;
-;;; BUGS
-
-;; - rst-enumeration-region: Select a single paragraph, with the top at one
-;; blank line before the beginning, and it will fail.
-;; - The active region goes away when we shift it left or right, and this
-;; prevents us from refilling it automatically when shifting many times.
-;; - The suggested decorations when adjusting should not have to cycle
-;; below one below the last section decoration level preceding the
-;; cursor. We need to fix that.
-
-;;; TODO LIST
-
-;; rst-toc-insert features
-;; ------------------------
-;; - rst-toc-insert: We should parse the contents:: options to figure out how
-;; deep to render the inserted TOC.
-;; - On load, detect any existing TOCs and set the properties for links.
-;; - TOC insertion should have an option to add empty lines.
-;; - TOC insertion should deal with multiple lines.
-;; - There is a bug on redo after undo of adjust when rst-adjust-hook uses the
-;; automatic toc update. The cursor ends up in the TOC and this is
-;; annoying. Gotta fix that.
-;; - numbering: automatically detect if we have a section-numbering directive in
-;; the corresponding section, to render the toc.
-;;
-;; bulleted and enumerated list items
-;; ----------------------------------
-;; - We need to provide way to rebullet bulleted lists, and that would include
-;; automatic enumeration as well.
-;;
-;; Other
-;; -----
-;; - It would be nice to differentiate between text files using
-;; reStructuredText_ and other general text files. If we had a
-;; function to automatically guess whether a .txt file is following the
-;; reStructuredText_ conventions, we could trigger rst-mode without
-;; having to hard-code this in every text file, nor forcing the user to
-;; add a local mode variable at the top of the file.
-;; We could perform this guessing by searching for a valid decoration
-;; at the top of the document or searching for reStructuredText_
-;; directives further on.
-;;
-;; - We should support imenu in our major mode, with the menu filled with the
-;; section titles (this should be really easy).
-;;
-;; - We should rename "adornment" to "decoration" or vice-versa in this
-;; document (Stefan's code ("adornment") vs Martin ("decoration")), maybe some
-;; functions even overlap.
-;;
-;; - We need to automatically recenter on rst-forward-section movement commands.
+;;; Code:
+;; FIXME: Check through major mode conventions again.
-;;; HISTORY
-;;
+;; FIXME: Add proper ";;;###autoload" comments.
-;;; Code:
+;; FIXME: When 24.1 is common place remove use of `lexical-let' and put "-*-
+;; lexical-binding: t -*-" in the first line.
-
-(defgroup rst nil "Support for reStructuredText documents."
- :group 'wp
- :version "23.1"
- :link '(url-link "http://docutils.sourceforge.net/rst.html"))
+;; 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)))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Define some generic support functions.
+;; Common Lisp stuff
-(eval-when-compile (require 'cl)) ;; We need this for destructuring-bind below.
+;; Only use of macros is allowed - may be replaced by `cl-lib' some time.
+(eval-when-compile
+ (require 'cl))
+;; Redefine some functions from `cl.el' in a proper namespace until they may be
+;; used from there.
-;; From Emacs-22
-(unless (fboundp 'line-number-at-pos)
- (defun line-number-at-pos (&optional pos)
- "Return (narrowed) buffer line number at position POS.
- If POS is nil, use current buffer location."
- (let ((opoint (or pos (point))) start)
- (save-excursion
- (goto-char (point-min))
- (setq start (point))
- (goto-char opoint)
- (forward-line 0)
- (1+ (count-lines start (point)))))) )
+(defun rst-signum (x)
+ "Return 1 if X is positive, -1 if negative, 0 if zero."
+ (cond
+ ((> x 0) 1)
+ ((< x 0) -1)
+ (t 0)))
+
+(defun rst-some (seq &optional pred)
+ "Return non-nil if any element of SEQ yields non-nil when PRED is applied.
+Apply PRED to each element of list SEQ until the first non-nil
+result is yielded and return this result. PRED defaults to
+`identity'."
+ (unless pred
+ (setq pred 'identity))
+ (catch 'rst-some
+ (dolist (elem seq)
+ (let ((r (funcall pred elem)))
+ (when r
+ (throw 'rst-some r))))))
+
+(defun rst-position-if (pred seq)
+ "Return position of first element satisfying PRED in list SEQ or nil."
+ (catch 'rst-position-if
+ (let ((i 0))
+ (dolist (elem seq)
+ (when (funcall pred elem)
+ (throw 'rst-position-if i))
+ (incf i)))))
+
+(defun rst-position (elem seq)
+ "Return position of ELEM in list SEQ or nil.
+Comparison done with `equal'."
+ ;; Create a closure containing `elem' so the `lambda' always sees our
+ ;; parameter instead of an `elem' which may be in dynamic scope at the time
+ ;; of execution of the `lambda'.
+ (lexical-let ((elem elem))
+ (rst-position-if (function (lambda (e)
+ (equal elem e)))
+ seq)))
+
+;; FIXME: Embed complicated `defconst's in `eval-when-compile'.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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
+and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match."
+ (if (string-match
+ (concat delim-re head-re "\\(" re "\\)" tail-re delim-re)
+ var)
+ (match-string 1 var)
+ default))
+
+;; 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.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")
+ "The CVS revision of this file. CVS revision is the development revision.")
+(defconst rst-cvs-timestamp
+ (rst-extract-version "\\$" "CVSHeader: \\S + \\S + "
+ "[0-9]+-[0-9]+-[0-9]+ [0-9]+:[0-9]+:[0-9]+" " .*"
+ rst-cvs-header "1970-01-01 00:00:00")
+ "The CVS time stamp of this file.")
+
+;; Use LastChanged... to really get information from SVN.
+(defconst rst-svn-rev
+ (rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " "
+ "$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-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.4.0 %")
+ "Official version of the package.")
+(defconst rst-official-cvs-rev
+ (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
+ "%Revision: 1.327 %")
+ "CVS revision of this file in the official version.")
+
+(defconst rst-version
+ (if (equal rst-official-cvs-rev rst-cvs-rev)
+ rst-official-version
+ (format "%s (development %s [%s])" rst-official-version
+ rst-cvs-rev rst-cvs-timestamp))
+ "The version string.
+Starts with the current official version. For developer versions
+in parentheses follows the development revision and the time stamp.")
+
+(defconst rst-package-emacs-version-alist
+ '(("1.0.0" . "24.3")
+ ("1.1.0" . "24.3")
+ ("1.2.0" . "24.3")
+ ("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)
+ (error "Version %s not listed in `rst-package-emacs-version-alist'"
+ rst-version))
+
+(add-to-list 'customize-package-emacs-version-alist
+ (cons 'ReST rst-package-emacs-version-alist))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Initialize customization
+
+
+(defgroup rst nil "Support for reStructuredText documents."
+ :group 'wp
+ :version "23.1"
+ :link '(url-link "http://docutils.sourceforge.net/rst.html"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Facilities for regular expressions used everywhere
+
+;; The trailing numbers in the names give the number of referenceable regex
+;; groups contained in the regex.
+
+;; Used to be customizable but really is not customizable but fixed by the reST
+;; syntax.
+(defconst rst-bullets
+ ;; Sorted so they can form a character class when concatenated.
+ '(?- ?* ?+ ?\u2022 ?\u2023 ?\u2043)
+ "List of all possible bullet characters for bulleted lists.")
+
+(defconst rst-uri-schemes
+ '("acap" "cid" "data" "dav" "fax" "file" "ftp" "gopher" "http" "https" "imap"
+ "ldap" "mailto" "mid" "modem" "news" "nfs" "nntp" "pop" "prospero" "rtsp"
+ "service" "sip" "tel" "telnet" "tip" "urn" "vemmi" "wais")
+ "Supported URI schemes.")
+
+(defconst rst-adornment-chars
+ ;; Sorted so they can form a character class when concatenated.
+ '(?\]
+ ?! ?\" ?# ?$ ?% ?& ?' ?\( ?\) ?* ?+ ?, ?. ?/ ?: ?\; ?< ?= ?> ?? ?@ ?\[ ?\\
+ ?^ ?_ ?` ?{ ?| ?} ?~
+ ?-)
+ "Characters which may be used in adornments for sections and transitions.")
+
+(defconst rst-max-inline-length
+ 1000
+ "Maximum length of inline markup to recognize.")
+
+(defconst rst-re-alist-def
+ ;; `*-beg' matches * at the beginning of a line.
+ ;; `*-end' matches * at the end of a line.
+ ;; `*-prt' matches a part of *.
+ ;; `*-tag' matches *.
+ ;; `*-sta' matches the start of * which may be followed by respective content.
+ ;; `*-pfx' matches the delimiter left of *.
+ ;; `*-sfx' matches the delimiter right of *.
+ ;; `*-hlp' helper for *.
+ ;;
+ ;; A trailing number says how many referenceable groups are contained.
+ `(
+
+ ;; Horizontal white space (`hws')
+ (hws-prt "[\t ]")
+ (hws-tag hws-prt "*") ; Optional sequence of horizontal white space.
+ (hws-sta hws-prt "+") ; Mandatory sequence of horizontal white space.
+
+ ;; Lines (`lin')
+ (lin-beg "^" hws-tag) ; Beginning of a possibly indented line.
+ (lin-end hws-tag "$") ; End of a line with optional trailing white space.
+ (linemp-tag "^" hws-tag "$") ; Empty line with optional white space.
+
+ ;; Various tags and parts
+ (ell-tag "\\.\\.\\.") ; Ellipsis
+ (bul-tag ,(concat "[" rst-bullets "]")) ; A bullet.
+ (ltr-tag "[a-zA-Z]") ; A letter enumerator tag.
+ (num-prt "[0-9]") ; A number enumerator part.
+ (num-tag num-prt "+") ; A number enumerator tag.
+ (rom-prt "[IVXLCDMivxlcdm]") ; A roman enumerator part.
+ (rom-tag rom-prt "+") ; A roman enumerator tag.
+ (aut-tag "#") ; An automatic enumerator tag.
+ (dcl-tag "::") ; Double colon.
+
+ ;; Block lead in (`bli')
+ (bli-sfx (:alt hws-sta "$")) ; Suffix of a block lead-in with *optional*
+ ; immediate content.
+
+ ;; Various starts
+ (bul-sta bul-tag bli-sfx) ; Start of a bulleted item.
+
+ ;; Explicit markup tag (`exm')
+ (exm-tag "\\.\\.")
+ (exm-sta exm-tag hws-sta)
+ (exm-beg lin-beg exm-sta)
+
+ ;; Counters in enumerations (`cnt')
+ (cntany-tag (:alt ltr-tag num-tag rom-tag aut-tag)) ; An arbitrary counter.
+ (cntexp-tag (:alt ltr-tag num-tag rom-tag)) ; An arbitrary explicit counter.
+
+ ;; Enumerator (`enm')
+ (enmany-tag (:alt
+ (:seq cntany-tag "\\.")
+ (:seq "(?" cntany-tag ")"))) ; An arbitrary enumerator.
+ (enmexp-tag (:alt
+ (:seq cntexp-tag "\\.")
+ (:seq "(?" cntexp-tag ")"))) ; An arbitrary explicit
+ ; enumerator.
+ (enmaut-tag (:alt
+ (:seq aut-tag "\\.")
+ (:seq "(?" aut-tag ")"))) ; An automatic enumerator.
+ (enmany-sta enmany-tag bli-sfx) ; An arbitrary enumerator start.
+ (enmexp-sta enmexp-tag bli-sfx) ; An arbitrary explicit enumerator start.
+ (enmexp-beg lin-beg enmexp-sta) ; An arbitrary explicit enumerator start
+ ; at the beginning of a line.
+
+ ;; Items may be enumerated or bulleted (`itm')
+ (itmany-tag (:alt enmany-tag bul-tag)) ; An arbitrary item tag.
+ (itmany-sta-1 (:grp itmany-tag) bli-sfx) ; An arbitrary item start, group
+ ; is the item tag.
+ (itmany-beg-1 lin-beg itmany-sta-1) ; An arbitrary item start at the
+ ; beginning of a line, group is the
+ ; item tag.
+
+ ;; Inline markup (`ilm')
+ (ilm-pfx (:alt "^" hws-prt "[-'\"([{<\u2018\u201c\u00ab\u2019/:]"))
+ (ilm-sfx (:alt "$" hws-prt "[]-'\")}>\u2019\u201d\u00bb/:.,;!?\\]"))
+
+ ;; Inline markup content (`ilc')
+ (ilcsgl-tag "\\S ") ; A single non-white character.
+ (ilcast-prt (:alt "[^*\\]" "\\\\.")) ; Part of non-asterisk content.
+ (ilcbkq-prt (:alt "[^`\\]" "\\\\.")) ; Part of non-backquote content.
+ (ilcbkqdef-prt (:alt "[^`\\\n]" "\\\\.")) ; Part of non-backquote
+ ; definition.
+ (ilcbar-prt (:alt "[^|\\]" "\\\\.")) ; Part of non-vertical-bar content.
+ (ilcbardef-prt (:alt "[^|\\\n]" "\\\\.")) ; Part of non-vertical-bar
+ ; definition.
+ (ilcast-sfx "[^\t *\\]") ; Suffix of non-asterisk content.
+ (ilcbkq-sfx "[^\t `\\]") ; Suffix of non-backquote content.
+ (ilcbar-sfx "[^\t |\\]") ; Suffix of non-vertical-bar content.
+ (ilcrep-hlp ,(format "\\{0,%d\\}" rst-max-inline-length)) ; Repeat count.
+ (ilcast-tag (:alt ilcsgl-tag
+ (:seq ilcsgl-tag
+ ilcast-prt ilcrep-hlp
+ ilcast-sfx))) ; Non-asterisk content.
+ (ilcbkq-tag (:alt ilcsgl-tag
+ (:seq ilcsgl-tag
+ ilcbkq-prt ilcrep-hlp
+ ilcbkq-sfx))) ; Non-backquote content.
+ (ilcbkqdef-tag (:alt ilcsgl-tag
+ (:seq ilcsgl-tag
+ ilcbkqdef-prt ilcrep-hlp
+ ilcbkq-sfx))) ; Non-backquote definition.
+ (ilcbar-tag (:alt ilcsgl-tag
+ (:seq ilcsgl-tag
+ ilcbar-prt ilcrep-hlp
+ ilcbar-sfx))) ; Non-vertical-bar content.
+ (ilcbardef-tag (:alt ilcsgl-tag
+ (:seq ilcsgl-tag
+ ilcbardef-prt ilcrep-hlp
+ ilcbar-sfx))) ; Non-vertical-bar definition.
+
+ ;; Fields (`fld')
+ (fldnam-prt (:alt "[^:\n]" "\\\\:")) ; Part of a field name.
+ (fldnam-tag fldnam-prt "+") ; A field name.
+ (fld-tag ":" fldnam-tag ":") ; A field marker.
+
+ ;; Options (`opt')
+ (optsta-tag (:alt "[-+/]" "--")) ; Start of an option.
+ (optnam-tag "\\sw" (:alt "-" "\\sw") "*") ; Name of an option.
+ (optarg-tag (:shy "[ =]\\S +")) ; Option argument.
+ (optsep-tag (:shy "," hws-prt)) ; Separator between options.
+ (opt-tag (:shy optsta-tag optnam-tag optarg-tag "?")) ; A complete option.
+
+ ;; Footnotes and citations (`fnc')
+ (fncnam-prt "[^\]\n]") ; Part of a footnote or citation name.
+ (fncnam-tag fncnam-prt "+") ; A footnote or citation name.
+ (fnc-tag "\\[" fncnam-tag "]") ; A complete footnote or citation tag.
+ (fncdef-tag-2 (:grp exm-sta)
+ (:grp fnc-tag)) ; A complete footnote or citation definition
+ ; tag. First group is the explicit markup
+ ; start, second group is the footnote /
+ ; citation tag.
+ (fnc-sta-2 fncdef-tag-2 bli-sfx) ; Start of a footnote or citation
+ ; definition. First group is the explicit
+ ; markup start, second group is the
+ ; footnote / citation tag.
+
+ ;; Substitutions (`sub')
+ (sub-tag "|" ilcbar-tag "|") ; A complete substitution tag.
+ (subdef-tag "|" ilcbardef-tag "|") ; A complete substitution definition
+ ; tag.
+
+ ;; Symbol (`sym')
+ (sym-prt "[-+.:_]") ; Non-word part of a symbol.
+ (sym-tag (:shy "\\sw+" (:shy sym-prt "\\sw+") "*"))
+
+ ;; URIs (`uri')
+ (uri-tag (:alt ,@rst-uri-schemes))
+
+ ;; Adornment (`ado')
+ (ado-prt "[" ,(concat rst-adornment-chars) "]")
+ (adorep3-hlp "\\{3,\\}") ; There must be at least 3 characters because
+ ; otherwise explicit markup start would be
+ ; recognized.
+ (adorep2-hlp "\\{2,\\}") ; As `adorep3-hlp' but when the first of three
+ ; characters is matched differently.
+ (ado-tag-1-1 (:grp ado-prt)
+ "\\1" adorep2-hlp) ; A complete adornment, group is the first
+ ; adornment character and MUST be the FIRST
+ ; group in the whole expression.
+ (ado-tag-1-2 (:grp ado-prt)
+ "\\2" adorep2-hlp) ; A complete adornment, group is the first
+ ; adornment character and MUST be the
+ ; SECOND group in the whole expression.
+ (ado-beg-2-1 "^" (:grp ado-tag-1-2)
+ lin-end) ; A complete adornment line; first group is the whole
+ ; adornment and MUST be the FIRST group in the whole
+ ; expression; second group is the first adornment
+ ; character.
+
+ ;; Titles (`ttl')
+ (ttl-tag "\\S *\\w\\S *") ; A title text.
+ (ttl-beg lin-beg ttl-tag) ; A title text at the beginning of a line.
+
+ ;; Directives and substitution definitions (`dir')
+ (dir-tag-3 (:grp exm-sta)
+ (:grp (:shy subdef-tag hws-sta) "?")
+ (:grp sym-tag dcl-tag)) ; A directive or substitution definition
+ ; tag. First group is explicit markup
+ ; start, second group is a possibly
+ ; empty substitution tag, third group is
+ ; the directive tag including the double
+ ; colon.
+ (dir-sta-3 dir-tag-3 bli-sfx) ; Start of a directive or substitution
+ ; definition. Groups are as in dir-tag-3.
+
+ ;; Literal block (`lit')
+ (lit-sta-2 (:grp (:alt "[^.\n]" "\\.[^.\n]") ".*") "?"
+ (:grp dcl-tag) "$") ; Start of a literal block. First group is
+ ; any text before the double colon tag which
+ ; may not exist, second group is the double
+ ; colon tag.
+
+ ;; Comments (`cmt')
+ (cmt-sta-1 (:grp exm-sta) "[^\[|_\n]"
+ (:alt "[^:\n]" (:seq ":" (:alt "[^:\n]" "$")))
+ "*$") ; Start of a comment block; first group is explicit markup
+ ; start.
+
+ ;; Paragraphs (`par')
+ (par-tag- (:alt itmany-tag fld-tag opt-tag fncdef-tag-2 dir-tag-3 exm-tag)
+ ) ; Tag at the beginning of a paragraph; there may be groups in
+ ; certain cases.
+ )
+ "Definition alist of relevant regexes.
+Each entry consists of the symbol naming the regex and an
+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:
+
+A string which is inserted unchanged.
+
+A character which is resolved to a quoted regex.
+
+A symbol which is resolved to a string using `rst-re-alist-def'.
+
+A list with a keyword in the car. Each element of the cdr of such
+a list is recursively interpreted as ARGS. The results of this
+interpretation are concatenated according to the keyword.
+
+For the keyword `:seq' the results are simply concatenated.
+
+For the keyword `:shy' the results are concatenated and
+surrounded by a shy-group (\"\\(?:...\\)\").
+
+For the keyword `:alt' the results form an alternative (\"\\|\")
+which is shy-grouped (\"\\(?:...\\)\").
+
+For the keyword `:grp' the results are concatenated and form a
+referenceable group (\"\\(...\\)\").
+
+After interpretation of ARGS the results are concatenated as for
+`:seq'."
+ (apply 'concat
+ (mapcar
+ (lambda (re)
+ (cond
+ ((stringp re)
+ re)
+ ((symbolp re)
+ (cadr (assoc re rst-re-alist)))
+ ((characterp re)
+ (regexp-quote (char-to-string re)))
+ ((listp re)
+ (let ((nested
+ (mapcar (lambda (elt)
+ (rst-re elt))
+ (cdr re))))
+ (cond
+ ((eq (car re) :seq)
+ (mapconcat 'identity nested ""))
+ ((eq (car re) :shy)
+ (concat "\\(?:" (mapconcat 'identity nested "") "\\)"))
+ ((eq (car re) :grp)
+ (concat "\\(" (mapconcat 'identity nested "") "\\)"))
+ ((eq (car re) :alt)
+ (concat "\\(?:" (mapconcat 'identity nested "\\|") "\\)"))
+ (t
+ (error "Unknown list car: %s" (car re))))))
+ (t
+ (error "Unknown object type for building regex: %s" re))))
+ args)))
+
+;; FIXME: Remove circular dependency between `rst-re' and `rst-re-alist'.
+(with-no-warnings ; Silence byte-compiler about this construction.
+ (defconst rst-re-alist
+ ;; Shadow global value we are just defining so we can construct it step by
+ ;; step.
+ (let (rst-re-alist)
+ (dolist (re rst-re-alist-def rst-re-alist)
+ (setq rst-re-alist
+ (nconc rst-re-alist
+ (list (list (car re) (apply 'rst-re (cdr re))))))))
+ "Alist mapping symbols from `rst-re-alist-def' to regex strings."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Mode definition.
+;; 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
+definitions should be in vector notation. These are defined as
+well but give an additional message."
+ (define-key keymap key def)
+ (dolist (dep-key deprecated)
+ (define-key keymap dep-key
+ `(lambda ()
+ ,(format "Deprecated binding for %s, use \\[%s] instead." def def)
+ (interactive)
+ (call-interactively ',def)
+ (message "[Deprecated use of key %s; use key %s instead]"
+ (key-description (this-command-keys))
+ (key-description ,key))))))
;; Key bindings.
(defvar rst-mode-map
(let ((map (make-sparse-keymap)))
+ ;; \C-c is the general keymap.
+ (rst-define-key map [?\C-c ?\C-h] 'describe-prefix-bindings)
+
;;
- ;; Section Decorations.
+ ;; Section Adornments
;;
- ;; The adjustment function that decorates or rotates a section title.
- (define-key map [(control c) (control a)] 'rst-adjust)
- (define-key map [(control c) (control ?=)] 'rst-adjust)
- (define-key map [(control ?=)] 'rst-adjust) ;; (Does not work on the Mac OSX.)
- ;; Display the hierarchy of decorations implied by the current document contents.
- (define-key map [(control c) (control h)] 'rst-display-decorations-hierarchy)
- ;; Homogenize the decorations in the document.
- (define-key map [(control c) (control s)] 'rst-straighten-decorations)
-;; (define-key map [(control c) (control s)] 'rst-straighten-deco-spacing)
+ ;; The adjustment function that adorns or rotates a section title.
+ (rst-define-key map [?\C-c ?\C-=] 'rst-adjust [?\C-c ?\C-a t])
+ (rst-define-key map [?\C-=] 'rst-adjust) ; Does not work on the Mac OSX and
+ ; on consoles.
+
+ ;; \C-c \C-a is the keymap for adornments.
+ (rst-define-key map [?\C-c ?\C-a ?\C-h] 'describe-prefix-bindings)
+ ;; Another binding which works with all types of input.
+ (rst-define-key map [?\C-c ?\C-a ?\C-a] 'rst-adjust)
+ ;; Display the hierarchy of adornments implied by the current document
+ ;; contents.
+ (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-adornments-hierarchy)
+ ;; Homogenize the adornments in the document.
+ (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-adornments
+ [?\C-c ?\C-s])
;;
- ;; Section Movement and Selection.
+ ;; Section Movement and Selection
;;
;; Mark the subsection where the cursor is.
- (define-key map [(control c) (control m)] 'rst-mark-section)
- ;; Move forward/backward between section titles.
- (define-key map [(control c) (control n)] 'rst-forward-section)
- (define-key map [(control c) (control p)] 'rst-backward-section)
+ (rst-define-key map [?\C-\M-h] 'rst-mark-section
+ ;; Same as mark-defun sgml-mark-current-element.
+ [?\C-c ?\C-m])
+ ;; Move backward/forward between section titles.
+ ;; FIXME: Also bind similar to outline mode.
+ (rst-define-key map [?\C-\M-a] 'rst-backward-section
+ ;; Same as beginning-of-defun.
+ [?\C-c ?\C-n])
+ (rst-define-key map [?\C-\M-e] 'rst-forward-section
+ ;; Same as end-of-defun.
+ [?\C-c ?\C-p])
+
+ ;;
+ ;; Operating on regions
+ ;;
+ ;; \C-c \C-r is the keymap for regions.
+ (rst-define-key map [?\C-c ?\C-r ?\C-h] 'describe-prefix-bindings)
+ ;; Makes region a line-block.
+ (rst-define-key map [?\C-c ?\C-r ?\C-l] 'rst-line-block-region
+ [?\C-c ?\C-d])
+ ;; Shift region left or right according to tabs.
+ (rst-define-key map [?\C-c ?\C-r tab] 'rst-shift-region
+ [?\C-c ?\C-r t] [?\C-c ?\C-l t])
;;
- ;; Operating on Blocks of Text.
+ ;; Operating on lists
;;
+ ;; \C-c \C-l is the keymap for lists.
+ (rst-define-key map [?\C-c ?\C-l ?\C-h] 'describe-prefix-bindings)
;; Makes paragraphs in region as a bullet list.
- (define-key map [(control c) (control b)] 'rst-bullet-list-region)
+ (rst-define-key map [?\C-c ?\C-l ?\C-b] 'rst-bullet-list-region
+ [?\C-c ?\C-b])
;; Makes paragraphs in region as a enumeration.
- (define-key map [(control c) (control e)] 'rst-enumerate-region)
+ (rst-define-key map [?\C-c ?\C-l ?\C-e] 'rst-enumerate-region
+ [?\C-c ?\C-e])
;; Converts bullets to an enumeration.
- (define-key map [(control c) (control v)] 'rst-convert-bullets-to-enumeration)
- ;; Makes region a line-block.
- (define-key map [(control c) (control d)] 'rst-line-block-region)
+ (rst-define-key map [?\C-c ?\C-l ?\C-c] 'rst-convert-bullets-to-enumeration
+ [?\C-c ?\C-v])
;; Make sure that all the bullets in the region are consistent.
- (define-key map [(control c) (control w)] 'rst-straighten-bullets-region)
- ;; Shift region left or right (taking into account of enumerations/bullets, etc.).
- (define-key map [(control c) (control l)] 'rst-shift-region-left)
- (define-key map [(control c) (control r)] 'rst-shift-region-right)
- ;; Comment/uncomment the active region.
- (define-key map [(control c) (control c)] 'comment-region)
+ (rst-define-key map [?\C-c ?\C-l ?\C-s] 'rst-straighten-bullets-region
+ [?\C-c ?\C-w])
+ ;; Insert a list item.
+ (rst-define-key map [?\C-c ?\C-l ?\C-i] 'rst-insert-list)
;;
- ;; Table-of-Contents Features.
+ ;; Table-of-Contents Features
;;
+ ;; \C-c \C-t is the keymap for table of contents.
+ (rst-define-key map [?\C-c ?\C-t ?\C-h] 'describe-prefix-bindings)
;; Enter a TOC buffer to view and move to a specific section.
- (define-key map [(control c) (control t)] 'rst-toc)
+ (rst-define-key map [?\C-c ?\C-t ?\C-t] 'rst-toc)
;; Insert a TOC here.
- (define-key map [(control c) (control i)] 'rst-toc-insert)
+ (rst-define-key map [?\C-c ?\C-t ?\C-i] 'rst-toc-insert
+ [?\C-c ?\C-i])
;; Update the document's TOC (without changing the cursor position).
- (define-key map [(control c) (control u)] 'rst-toc-update)
- ;; Got to the section under the cursor (cursor must be in TOC).
- (define-key map [(control c) (control f)] 'rst-goto-section)
+ (rst-define-key map [?\C-c ?\C-t ?\C-u] 'rst-toc-update
+ [?\C-c ?\C-u])
+ ;; Go to the section under the cursor (cursor must be in TOC).
+ (rst-define-key map [?\C-c ?\C-t ?\C-j] 'rst-goto-section
+ [?\C-c ?\C-f])
;;
- ;; Converting Documents from Emacs.
+ ;; Converting Documents from Emacs
;;
+ ;; \C-c \C-c is the keymap for compilation.
+ (rst-define-key map [?\C-c ?\C-c ?\C-h] 'describe-prefix-bindings)
;; Run one of two pre-configured toolset commands on the document.
- (define-key map [(control c) (?1)] 'rst-compile)
- (define-key map [(control c) (?2)] 'rst-compile-alt-toolset)
+ (rst-define-key map [?\C-c ?\C-c ?\C-c] 'rst-compile
+ [?\C-c ?1])
+ (rst-define-key map [?\C-c ?\C-c ?\C-a] 'rst-compile-alt-toolset
+ [?\C-c ?2])
;; Convert the active region to pseudo-xml using the docutils tools.
- (define-key map [(control c) (?3)] 'rst-compile-pseudo-region)
+ (rst-define-key map [?\C-c ?\C-c ?\C-x] 'rst-compile-pseudo-region
+ [?\C-c ?3])
;; Convert the current document to PDF and launch a viewer on the results.
- (define-key map [(control c) (?4)] 'rst-compile-pdf-preview)
+ (rst-define-key map [?\C-c ?\C-c ?\C-p] 'rst-compile-pdf-preview
+ [?\C-c ?4])
;; Convert the current document to S5 slides and view in a web browser.
- (define-key map [(control c) (?5)] 'rst-compile-slides-preview)
+ (rst-define-key map [?\C-c ?\C-c ?\C-s] 'rst-compile-slides-preview
+ [?\C-c ?5])
map)
"Keymap for reStructuredText mode commands.
@@ -306,8 +738,6 @@ This inherits from Text mode.")
;; Abbrevs.
-(defvar rst-mode-abbrev-table nil
- "Abbrev table used while in Rst mode.")
(define-abbrev-table 'rst-mode-abbrev-table
(mapcar (lambda (x) (append x '(nil 0 system)))
'(("contents" ".. contents::\n..\n ")
@@ -316,49 +746,47 @@ This inherits from Text mode.")
("skip" "\n\n[...]\n\n ")
("seq" "\n\n[...]\n\n ")
;; FIXME: Add footnotes, links, and more.
- )))
+ ))
+ "Abbrev table used while in `rst-mode'.")
;; Syntax table.
(defvar rst-mode-syntax-table
(let ((st (copy-syntax-table text-mode-syntax-table)))
-
(modify-syntax-entry ?$ "." st)
(modify-syntax-entry ?% "." st)
(modify-syntax-entry ?& "." st)
(modify-syntax-entry ?' "." st)
(modify-syntax-entry ?* "." st)
(modify-syntax-entry ?+ "." st)
- (modify-syntax-entry ?. "_" st)
+ (modify-syntax-entry ?- "." st)
(modify-syntax-entry ?/ "." st)
(modify-syntax-entry ?< "." st)
(modify-syntax-entry ?= "." st)
(modify-syntax-entry ?> "." st)
(modify-syntax-entry ?\\ "\\" st)
- (modify-syntax-entry ?| "." st)
(modify-syntax-entry ?_ "." st)
+ (modify-syntax-entry ?| "." st)
+ (modify-syntax-entry ?\u00ab "." st)
+ (modify-syntax-entry ?\u00bb "." st)
+ (modify-syntax-entry ?\u2018 "." st)
+ (modify-syntax-entry ?\u2019 "." st)
+ (modify-syntax-entry ?\u201c "." st)
+ (modify-syntax-entry ?\u201d "." st)
st)
"Syntax table used while in `rst-mode'.")
(defcustom rst-mode-hook nil
- "Hook run when Rst mode is turned on.
-The hook for Text mode is run before this one."
+ "Hook run when `rst-mode' is turned on.
+The hook for `text-mode' is run before this one."
:group 'rst
:type '(hook))
+(rst-testcover-defcustom)
-
-(defcustom rst-mode-lazy t
- "If non-nil Rst mode tries to font-lock multi-line elements correctly.
-Because this is really slow it should be set to nil if neither `jit-lock-mode'
-not `lazy-lock-mode' and activated.
-
-If nil, comments and literal blocks are font-locked only on the line they start.
-
-The value of this variable is used when Rst mode is turned on."
- :group 'rst
- :type '(boolean))
+;; Pull in variable definitions silencing byte-compiler.
+(require 'newcomment)
;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files
;; use *.txt, but this is too generic to be set as a default.
@@ -367,78 +795,76 @@ The value of this variable is used when Rst mode is turned on."
(define-derived-mode rst-mode text-mode "ReST"
"Major mode for editing reStructuredText documents.
\\<rst-mode-map>
-There are a number of convenient keybindings provided by
-Rst mode. The main one is \\[rst-adjust], it updates or rotates
-the section title around point or promotes/demotes the
-decorations within the region (see full details below).
-Use negative prefix arg to rotate in the other direction.
Turning on `rst-mode' calls the normal hooks `text-mode-hook'
and `rst-mode-hook'. This mode also supports font-lock
-highlighting. You may customize `rst-mode-lazy' to toggle
-font-locking of blocks.
+highlighting.
\\{rst-mode-map}"
:abbrev-table rst-mode-abbrev-table
:syntax-table rst-mode-syntax-table
:group 'rst
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'indent-line-function) 'indent-relative-maybe)
+ ;; Paragraph recognition.
+ (set (make-local-variable 'paragraph-separate)
+ (rst-re '(:alt
+ "\f"
+ lin-end)))
(set (make-local-variable 'paragraph-start)
- "\f\\|>*[ \t]*$\\|>*[ \t]*[-+*] \\|>*[ \t]*[0-9#]+\\. ")
- (set (make-local-variable 'adaptive-fill-mode) t)
+ (rst-re '(:alt
+ "\f"
+ lin-end
+ (:seq hws-tag par-tag- bli-sfx))))
- ;; FIXME: No need to reset this.
- ;; (set (make-local-variable 'indent-line-function) 'indent-relative)
+ ;; Indenting and filling.
+ (set (make-local-variable 'indent-line-function) 'rst-indent-line)
+ (set (make-local-variable 'adaptive-fill-mode) t)
+ (set (make-local-variable 'adaptive-fill-regexp)
+ (rst-re 'hws-tag 'par-tag- "?" 'hws-tag))
+ (set (make-local-variable 'adaptive-fill-function) 'rst-adaptive-fill)
+ (set (make-local-variable 'fill-paragraph-handle-comment) nil)
- ;; The details of the following comment setup is important because it affects
- ;; auto-fill, and it is pretty common in running text to have an ellipsis
- ;; ("...") which trips because of the rest comment syntax (".. ").
+ ;; Comments.
(set (make-local-variable 'comment-start) ".. ")
- (set (make-local-variable 'comment-start-skip) "^\\.\\. ")
- (set (make-local-variable 'comment-multi-line) nil)
-
- ;; Special variables
- (make-local-variable 'rst-adornment-level-alist)
-
- ;; Font lock
+ (set (make-local-variable 'comment-start-skip)
+ (rst-re 'lin-beg 'exm-tag 'bli-sfx))
+ (set (make-local-variable 'comment-continue) " ")
+ (set (make-local-variable 'comment-multi-line) t)
+ (set (make-local-variable 'comment-use-syntax) nil)
+ ;; reStructuredText has not really a comment ender but nil is not really a
+ ;; permissible value.
+ (set (make-local-variable 'comment-end) "")
+ (set (make-local-variable 'comment-end-skip) nil)
+
+ ;; Commenting in reStructuredText is very special so use our own set of
+ ;; functions.
+ (set (make-local-variable 'comment-line-break-function)
+ 'rst-comment-line-break)
+ (set (make-local-variable 'comment-indent-function)
+ 'rst-comment-indent)
+ (set (make-local-variable 'comment-insert-comment-function)
+ 'rst-comment-insert-comment)
+ (set (make-local-variable 'comment-region-function)
+ 'rst-comment-region)
+ (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-function
+ '(rst-font-lock-keywords
t nil nil nil
+ (font-lock-multiline . t)
(font-lock-mark-block-function . mark-paragraph)))
- ;; `jit-lock-mode' has been the default since Emacs-21.1, so there's no
- ;; point messing around with font-lock-support-mode any more.
- ;; (when (boundp 'font-lock-support-mode)
- ;; ;; rst-mode has its own mind about font-lock-support-mode
- ;; (make-local-variable 'font-lock-support-mode)
- ;; ;; jit-lock-mode replaced lazy-lock-mode in GNU Emacs 21.
- ;; (let ((jit-or-lazy-lock-mode
- ;; (cond
- ;; ((fboundp 'lazy-lock-mode) 'lazy-lock-mode)
- ;; ((fboundp 'jit-lock-mode) 'jit-lock-mode)
- ;; ;; if neither lazy-lock nor jit-lock is supported,
- ;; ;; tell user and disable rst-mode-lazy
- ;; (t (when rst-mode-lazy
- ;; (message "Disabled lazy fontification, because no known support mode found.")
- ;; (setq rst-mode-lazy nil))))))
- ;; (cond
- ;; ((and (not rst-mode-lazy) (not font-lock-support-mode)))
- ;; ;; No support mode set and none required - leave it alone
- ;; ((or (not font-lock-support-mode) ;; No support mode set (but required)
- ;; (symbolp font-lock-support-mode)) ;; or a fixed mode for all
- ;; (setq font-lock-support-mode
- ;; (list (cons 'rst-mode (and rst-mode-lazy jit-or-lazy-lock-mode))
- ;; (cons t font-lock-support-mode))))
- ;; ((and (listp font-lock-support-mode)
- ;; (not (assoc 'rst-mode font-lock-support-mode)))
- ;; ;; A list of modes missing rst-mode
- ;; (setq font-lock-support-mode
- ;; (cons (cons 'rst-mode (and rst-mode-lazy jit-or-lazy-lock-mode))
- ;; font-lock-support-mode))))))
-
- )
+ (add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t)
+ ;; Text after a changed line may need new fontification.
+ (set (make-local-variable 'jit-lock-contextually) t))
;;;###autoload
(define-minor-mode rst-minor-mode
@@ -459,34 +885,22 @@ for modes derived from Text mode, like Mail mode."
:group 'rst)
;; FIXME: can I somehow install these too?
-;; :abbrev-table rst-mode-abbrev-table
-;; :syntax-table rst-mode-syntax-table
-
-
-
-
-
-;; Bulleted item lists.
-(defcustom rst-bullets
- '(?- ?* ?+)
- "List of all possible bullet characters for bulleted lists."
- :group 'rst)
-
-
+;; :abbrev-table rst-mode-abbrev-table
+;; :syntax-table rst-mode-syntax-table
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Section Decoration Adjustment
-;; =============================
+;; Section Adornment Adjustment
+;; ============================
;;
;; The following functions implement a smart automatic title sectioning feature.
;; The idea is that with the cursor sitting on a section title, we try to get as
;; much information from context and try to do the best thing automatically.
;; This function can be invoked many times and/or with prefix argument to rotate
-;; between the various sectioning decorations.
+;; between the various sectioning adornments.
;;
;; Definitions: the two forms of sectioning define semantically separate section
-;; levels. A sectioning DECORATION consists in:
+;; levels. A sectioning ADORNMENT consists in:
;;
;; - a CHARACTER
;;
@@ -496,10 +910,7 @@ for modes derived from Text mode, like Mail mode."
;; how many characters and over-and-under style is hanging outside of the
;; title at the beginning and ending.
;;
-;; Important note: an existing decoration must be formed by at least two
-;; characters to be recognized.
-;;
-;; Here are two examples of decorations (| represents the window border, column
+;; Here are two examples of adornments (| represents the window border, column
;; 0):
;;
;; |
@@ -516,17 +927,15 @@ for modes derived from Text mode, like Mail mode."
;; - The underlining character that is used depends on context. The file is
;; scanned to find other sections and an appropriate character is selected.
;; If the function is invoked on a section that is complete, the character is
-;; rotated among the existing section decorations.
+;; rotated among the existing section adornments.
;;
;; Note that when rotating the characters, if we come to the end of the
-;; hierarchy of decorations, the variable rst-preferred-decorations is
-;; consulted to propose a new underline decoration, and if continued, we cycle
-;; the decorations all over again. Set this variable to nil if you want to
-;; limit the underlining character propositions to the existing decorations in
+;; hierarchy of adornments, the variable rst-preferred-adornments is
+;; consulted to propose a new underline adornment, and if continued, we cycle
+;; the adornments all over again. Set this variable to nil if you want to
+;; limit the underlining character propositions to the existing adornments in
;; the file.
;;
-;; - A prefix argument can be used to alternate the style.
-;;
;; - An underline/overline that is not extended to the column at which it should
;; be hanging is dubbed INCOMPLETE. For example::
;;
@@ -547,128 +956,110 @@ for modes derived from Text mode, like Mail mode."
;;
;; In over-and-under style, when alternating the style, a variable is
;; available to select how much default indent to use (it can be zero). Note
-;; that if the current section decoration already has an indent, we don't
+;; that if the current section adornment already has an indent, we don't
;; adjust it to the default, we rather use the current indent that is already
;; there for adjustment (unless we cycle, in which case we use the indent
;; that has been found previously).
(defgroup rst-adjust nil
- "Settings for adjustment and cycling of section title decorations."
+ "Settings for adjustment and cycling of section title adornments."
:group 'rst
:version "21.1")
-(defcustom rst-preferred-decorations '( (?= over-and-under 1)
- (?= simple 0)
- (?- simple 0)
- (?~ simple 0)
- (?+ simple 0)
- (?` simple 0)
- (?# simple 0)
- (?@ simple 0) )
- "Preferred ordering of section title decorations.
-
-This sequence is consulted to offer a new decoration suggestion
+(define-obsolete-variable-alias
+ 'rst-preferred-decorations 'rst-preferred-adornments "rst 1.0.0")
+(defcustom rst-preferred-adornments '((?= over-and-under 1)
+ (?= simple 0)
+ (?- simple 0)
+ (?~ simple 0)
+ (?+ simple 0)
+ (?` simple 0)
+ (?# simple 0)
+ (?@ simple 0))
+ "Preferred hierarchy of section title adornments.
+
+A list consisting of lists of the form (CHARACTER STYLE INDENT).
+CHARACTER is the character used. STYLE is one of the symbols
+OVER-AND-UNDER or SIMPLE. INDENT is an integer giving the wanted
+indentation for STYLE OVER-AND-UNDER. CHARACTER and STYLE are
+always used when a section adornment is described. In other
+places t instead of a list stands for a transition.
+
+This sequence is consulted to offer a new adornment suggestion
when we rotate the underlines at the end of the existing
hierarchy of characters, or when there is no existing section
-title in the file."
- :group 'rst-adjust)
-
+title in the file.
+
+Set this to an empty list to use only the adornment found in the
+file."
+ :group 'rst-adjust
+ :type `(repeat
+ (group :tag "Adornment specification"
+ (choice :tag "Adornment character"
+ ,@(mapcar (lambda (char)
+ (list 'const
+ :tag (char-to-string char) char))
+ rst-adornment-chars))
+ (radio :tag "Adornment type"
+ (const :tag "Overline and underline" over-and-under)
+ (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.
-This is used for when toggling decoration styles, when switching
-from a simple decoration style to a over-and-under decoration
+This is used for when toggling adornment styles, when switching
+from a simple adornment style to a over-and-under adornment
style."
- :group 'rst-adjust)
-
-
-(defvar rst-section-text-regexp "^[ \t]*\\S-*\\w\\S-*"
- "Regular expression for valid section title text.")
-
-
-(defun rst-line-homogeneous-p (&optional accept-special)
- "Return true if the line is homogeneous.
-
-Predicate that returns the unique char if the current line is
-composed only of a single repeated non-whitespace character.
-This returns the char even if there is whitespace at the
-beginning of the line.
-
-If ACCEPT-SPECIAL is specified we do not ignore special sequences
-which normally we would ignore when doing a search on many lines.
-For example, normally we have cases to ignore commonly occurring
-patterns, such as :: or ...; with the flag do not ignore them."
- (save-excursion
- (back-to-indentation)
- (unless (looking-at "\n")
- (let ((c (thing-at-point 'char)))
- (if (and (looking-at (format "[%s]+[ \t]*$" c))
- (or accept-special
- (and
- ;; Common patterns.
- (not (looking-at "::[ \t]*$"))
- (not (looking-at "\\.\\.\\.[ \t]*$"))
- ;; Discard one char line
- (not (looking-at ".[ \t]*$"))
- )))
- (string-to-char c))
- ))
- ))
-
-(defun rst-line-homogeneous-nodent-p (&optional accept-special)
- "Return true if the line is homogeneous with no indent.
-See `rst-line-homogeneous-p' about ACCEPT-SPECIAL."
- (save-excursion
- (beginning-of-line)
- (if (looking-at "^[ \t]+")
- nil
- (rst-line-homogeneous-p accept-special)
- )))
+ :group 'rst-adjust
+ :type '(integer))
+(rst-testcover-defcustom)
-
-(defun rst-compare-decorations (deco1 deco2)
- "Compare decorations.
-Return true if both DECO1 and DECO2 decorations are equal,
+(defun rst-compare-adornments (ado1 ado2)
+ "Compare adornments.
+Return true if both ADO1 and ADO2 adornments are equal,
according to restructured text semantics (only the character and
the style are compared, the indentation does not matter)."
- (and (eq (car deco1) (car deco2))
- (eq (cadr deco1) (cadr deco2))))
+ (and (eq (car ado1) (car ado2))
+ (eq (cadr ado1) (cadr ado2))))
-(defun rst-get-decoration-match (hier deco)
- "Return the index (level) in hierarchy HIER of decoration DECO.
+(defun rst-get-adornment-match (hier ado)
+ "Return the index (level) in hierarchy HIER of adornment ADO.
This basically just searches for the item using the appropriate
comparison and returns the index. Return nil if the item is
not found."
(let ((cur hier))
- (while (and cur (not (rst-compare-decorations (car cur) deco)))
+ (while (and cur (not (rst-compare-adornments (car cur) ado)))
(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.
-(defun rst-suggest-new-decoration (alldecos &optional prev)
- "Suggest a new, different decoration from all that have been seen.
-
-ALLDECOS is the set of all decorations, including the line numbers.
-PREV is the optional previous decoration, in order to suggest a
+ALLADOS is the set of all adornments, including the line numbers.
+PREV is the optional previous adornment, in order to suggest a
better match."
- ;; For all the preferred decorations...
+ ;; For all the preferred adornments...
(let* (
;; If 'prev' is given, reorder the list to start searching after the
;; match.
(fplist
- (cdr (rst-get-decoration-match rst-preferred-decorations prev)))
+ (cdr (rst-get-adornment-match rst-preferred-adornments prev)))
;; List of candidates to search.
- (curpotential (append fplist rst-preferred-decorations)))
+ (curpotential (append fplist rst-preferred-adornments)))
(while
- ;; For all the decorations...
- (let ((cur alldecos)
+ ;; For all the adornments...
+ (let ((cur allados)
found)
(while (and cur (not found))
- (if (rst-compare-decorations (car cur) (car curpotential))
+ (if (rst-compare-adornments (car cur) (car curpotential))
;; Found it!
(setq found (car curpotential))
(setq cur (cdr cur))))
@@ -684,7 +1075,7 @@ better match."
(line-beginning-position 2)))
(defun rst-update-section (char style &optional indent)
- "Unconditionally update the style of a section decoration.
+ "Unconditionally update the style of a section adornment.
Do this using the given character CHAR, with STYLE 'simple
or 'over-and-under, and with indent INDENT. If the STYLE
@@ -692,16 +1083,14 @@ is 'simple, whitespace before the title is removed (indent
is always assumed to be 0).
If there are existing overline and/or underline from the
-existing decoration, they are removed before adding the
-requested decoration."
-
- (interactive)
- (end-of-line)
+existing adornment, they are removed before adding the
+requested adornment."
+ (end-of-line)
(let ((marker (point-marker))
len)
- ;; Fixup whitespace at the beginning and end of the line
- (if (or (null indent) (eq style 'simple))
+ ;; Fixup whitespace at the beginning and end of the line.
+ (if (or (null indent) (eq style 'simple)) ;; testcover: ok.
(setq indent 0))
(beginning-of-line)
(delete-horizontal-space)
@@ -710,250 +1099,347 @@ requested decoration."
(end-of-line)
(delete-horizontal-space)
- ;; Set the current column, we're at the end of the title line
+ ;; Set the current column, we're at the end of the title line.
(setq len (+ (current-column) indent))
- ;; Remove previous line if it consists only of a single repeated character
+ ;; Remove previous line if it is an adornment.
(save-excursion
- (forward-line -1)
- (and (rst-line-homogeneous-p 1)
- ;; Avoid removing the underline of a title right above us.
- (save-excursion (forward-line -1)
- (not (looking-at rst-section-text-regexp)))
- (rst-delete-entire-line)))
-
- ;; Remove following line if it consists only of a single repeated
- ;; character
+ (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)
+ (not (looking-at (rst-re 'ttl-beg)))))
+ (rst-delete-entire-line)))
+
+ ;; Remove following line if it is an adornment.
(save-excursion
- (forward-line +1)
- (and (rst-line-homogeneous-p 1)
- (rst-delete-entire-line))
+ (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
- ;; inserting of the underline
+ ;; inserting of the underline.
(if (= (point) (buffer-end 1))
(newline 1)))
- ;; Insert overline
+ ;; Insert overline.
(if (eq style 'over-and-under)
(save-excursion
(beginning-of-line)
(open-line 1)
(insert (make-string len char))))
- ;; Insert underline
- (forward-line +1)
+ ;; Insert underline.
+ (1value ;; Line has been inserted above.
+ (forward-line +1))
(open-line 1)
(insert (make-string len char))
- (forward-line +1)
- (goto-char marker)
- ))
-
-
-(defun rst-normalize-cursor-position ()
- "Normalize the cursor position.
-If the cursor is on a decoration line or an empty line , place it
-on the section title line (at the end). Returns the line offset
-by which the cursor was moved. This works both over or under a
-line."
- (if (save-excursion (beginning-of-line)
- (or (rst-line-homogeneous-p 1)
- (looking-at "^[ \t]*$")))
- (progn
- (beginning-of-line)
- (cond
- ((save-excursion (forward-line -1)
- (beginning-of-line)
- (and (looking-at rst-section-text-regexp)
- (not (rst-line-homogeneous-p 1))))
- (progn (forward-line -1) -1))
- ((save-excursion (forward-line +1)
- (beginning-of-line)
- (and (looking-at rst-section-text-regexp)
- (not (rst-line-homogeneous-p 1))))
- (progn (forward-line +1) +1))
- (t 0)))
- 0 ))
-
-
-(defun rst-find-all-decorations ()
- "Find all the decorations in the file.
-Return a list of (line, decoration) pairs. Each decoration
-consists in a (char, style, indent) triple.
-
-This function does not detect the hierarchy of decorations, it
-just finds all of them in a file. You can then invoke another
-function to remove redundancies and inconsistencies."
-
- (let ((positions ())
- (curline 1))
- ;; Iterate over all the section titles/decorations in the file.
- (save-excursion
- (goto-char (point-min))
- (while (< (point) (buffer-end 1))
- (if (rst-line-homogeneous-nodent-p)
- (progn
- (setq curline (+ curline (rst-normalize-cursor-position)))
-
- ;; Here we have found a potential site for a decoration,
- ;; characterize it.
- (let ((deco (rst-get-decoration)))
- (if (cadr deco) ;; Style is existing.
- ;; Found a real decoration site.
- (progn
- (push (cons curline deco) positions)
- ;; Push beyond the underline.
- (forward-line 1)
- (setq curline (+ curline 1))
- )))
- ))
- (forward-line 1)
- (setq curline (+ curline 1))
- ))
- (reverse positions)))
-
-
-(defun rst-infer-hierarchy (decorations)
- "Build a hierarchy of decorations using the list of given DECORATIONS.
-
-This function expects a list of (char, style, indent) decoration
+ (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.
+ADORNMENT is the complete adornment string as found in the buffer
+with optional trailing whitespace. END is the point after the
+last character of ADORNMENT.
+
+Return a list. The first entry is t for a transition or a
+cons (CHARACTER . STYLE). Check `rst-preferred-adornments' for
+the meaning of CHARACTER and STYLE.
+
+The remaining list forms four match groups as returned by
+`match-data'. Match group 0 matches the whole construct. Match
+group 1 matches the overline adornment if present. Match group 2
+matches the section title text or the transition. Match group 3
+matches the underline adornment.
+
+Return nil if no syntactically valid adornment is found."
+ (save-excursion
+ (save-match-data
+ (when (string-match (rst-re 'ado-beg-2-1) adornment)
+ (goto-char end)
+ (let* ((ado-ch (string-to-char (match-string 2 adornment)))
+ (ado-re (rst-re ado-ch 'adorep3-hlp))
+ (end-pnt (point))
+ (beg-pnt (progn
+ (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
+ (or (not (zerop (forward-line -1)))
+ (looking-at (rst-re 'lin-end)))))
+ (ttl-blw ; Title found below starting here.
+ (save-excursion
+ (and
+ (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.
+ (save-excursion
+ (and
+ (zerop (forward-line -1))
+ (looking-at (rst-re 'ttl-beg))
+ (point))))
+ (und-fnd ; Matching underline found starting here.
+ (save-excursion
+ (and ttl-blw
+ (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.
+ (save-excursion
+ (and ttl-abv
+ (zerop (forward-line -2))
+ (looking-at (rst-re ado-re 'lin-end))
+ (point))))
+ key beg-ovr end-ovr beg-txt end-txt beg-und end-und)
+ (cond
+ ((and nxt-emp prv-emp)
+ ;; A transition.
+ (setq key t
+ beg-txt beg-pnt
+ end-txt end-pnt))
+ ((or und-fnd ovr-fnd)
+ ;; An overline with an underline.
+ (setq key (cons ado-ch 'over-and-under))
+ (let (;; Prefer overline match over underline match.
+ (und-pnt (if ovr-fnd beg-pnt und-fnd))
+ (ovr-pnt (if ovr-fnd ovr-fnd beg-pnt))
+ (txt-pnt (if ovr-fnd ttl-abv ttl-blw)))
+ (goto-char ovr-pnt)
+ (setq beg-ovr (point)
+ end-ovr (line-end-position))
+ (goto-char txt-pnt)
+ (setq beg-txt (point)
+ end-txt (line-end-position))
+ (goto-char und-pnt)
+ (setq beg-und (point)
+ end-und (line-end-position))))
+ (ttl-abv
+ ;; An underline.
+ (setq key (cons ado-ch 'simple)
+ beg-und beg-pnt
+ end-und end-pnt)
+ (goto-char ttl-abv)
+ (setq beg-txt (point)
+ end-txt (line-end-position)))
+ (t
+ ;; Invalid adornment.
+ (setq key nil)))
+ (if key
+ (list key
+ (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 ()
+ "Find a section title line around point and return its characteristics.
+If the point is on an adornment line find the respective title
+line. If the point is on an empty line check previous or next
+line whether it is a suitable title line and use it if so. If
+point is on a suitable title line use it.
+
+If no title line is found return nil.
+
+Otherwise return as `rst-classify-adornment' does. However, if
+the title line has no syntactically valid adornment STYLE is nil
+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
+ (1value ;; No lines may be left to move.
+ (forward-line 0))
+ (let ((orig-pnt (point))
+ (orig-end (line-end-position)))
+ (cond
+ ((looking-at (rst-re 'ado-beg-2-1))
+ (let ((char (string-to-char (match-string-no-properties 2)))
+ (r (rst-classify-adornment (match-string-no-properties 0)
+ (match-end 0))))
+ (cond
+ ((not r)
+ ;; Invalid adornment - check whether this is an incomplete overline.
+ (if (and
+ (zerop (forward-line 1))
+ (looking-at (rst-re 'ttl-beg)))
+ (list (cons char nil) orig-pnt (line-end-position)
+ orig-pnt orig-end (point) (line-end-position) nil nil)))
+ ((consp (car r))
+ ;; A section title - not a transition.
+ r))))
+ ((looking-at (rst-re 'lin-end))
+ (or
+ (save-excursion
+ (if (and (zerop (forward-line -1))
+ (looking-at (rst-re 'ttl-beg)))
+ (list (cons nil nil) (point) (line-end-position)
+ nil nil (point) (line-end-position) nil nil)))
+ (save-excursion
+ (if (and (zerop (forward-line 1))
+ (looking-at (rst-re 'ttl-beg)))
+ (list (cons nil nil) (point) (line-end-position)
+ nil nil (point) (line-end-position) nil nil)))))
+ ((looking-at (rst-re 'ttl-beg))
+ ;; Try to use the underline.
+ (let ((r (rst-classify-adornment
+ (buffer-substring-no-properties
+ (line-beginning-position 2) (line-end-position 2))
+ (line-end-position 2))))
+ (if r
+ r
+ ;; No valid adornment found.
+ (list (cons nil nil) (point) (line-end-position)
+ nil nil (point) (line-end-position) nil nil))))))))
+
+;; The following function and variables are used to maintain information about
+;; current section adornment in a buffer local cache. Thus they can be used for
+;; font-locking and manipulation commands.
+
+(defvar rst-all-sections nil
+ "All section adornments in the buffer as found by `rst-find-all-adornments'.
+t when no section adornments were found.")
+(make-variable-buffer-local 'rst-all-sections)
+
+;; FIXME: If this variable is set to a different value font-locking of section
+;; headers is wrong.
+(defvar rst-section-hierarchy nil
+ "Section hierarchy in the buffer as determined by `rst-get-hierarchy'.
+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."
+ (setq rst-all-sections nil
+ rst-section-hierarchy nil))
+
+(defun rst-find-all-adornments ()
+ "Return all the section adornments in the current buffer.
+Return a list of (LINE . ADORNMENT) with ascending LINE where
+LINE is the line containing the section title. ADORNMENT consists
+of a (CHARACTER STYLE INDENT) triple as described for
+`rst-preferred-adornments'.
+
+Uses and sets `rst-all-sections'."
+ (unless rst-all-sections
+ (let (positions)
+ ;; Iterate over all the section titles/adornments in the file.
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward (rst-re 'ado-beg-2-1) nil t)
+ (let ((ado-data (rst-classify-adornment
+ (match-string-no-properties 0) (point))))
+ (when (and ado-data
+ (consp (car ado-data))) ; Ignore transitions.
+ (set-match-data (cdr ado-data))
+ (goto-char (match-beginning 2)) ; Goto the title start.
+ (push (cons (1+ (count-lines (point-min) (point)))
+ (list (caar ado-data)
+ (cdar ado-data)
+ (current-indentation)))
+ positions)
+ (goto-char (match-end 0))))) ; Go beyond the whole thing.
+ (setq positions (nreverse positions))
+ (setq rst-all-sections (or positions t)))))
+ (if (eq rst-all-sections t)
+ nil
+ rst-all-sections))
+
+(defun rst-infer-hierarchy (adornments)
+ "Build a hierarchy of adornments using the list of given ADORNMENTS.
+
+ADORNMENTS is a list of (CHARACTER STYLE INDENT) adornment
specifications, in order that they appear in a file, and will
-infer a hierarchy of section levels by removing decorations that
-have already been seen in a forward traversal of the decorations,
-comparing just the character and style.
+infer a hierarchy of section levels by removing adornments that
+have already been seen in a forward traversal of the adornments,
+comparing just CHARACTER and STYLE.
-Similarly returns a list of (char, style, indent), where each
+Similarly returns a list of (CHARACTER STYLE INDENT), where each
list element should be unique."
-
- (let ((hierarchy-alist (list)))
- (dolist (x decorations)
+ (let (hierarchy-alist)
+ (dolist (x adornments)
(let ((char (car x))
(style (cadr x)))
(unless (assoc (cons char style) hierarchy-alist)
- (push (cons (cons char style) x) hierarchy-alist))
- ))
+ (push (cons (cons char style) x) hierarchy-alist))))
+ (mapcar 'cdr (nreverse hierarchy-alist))))
- (mapcar 'cdr (nreverse hierarchy-alist))
- ))
-
-
-(defun rst-get-hierarchy (&optional alldecos ignore)
+(defun rst-get-hierarchy (&optional ignore)
"Return the hierarchy of section titles in the file.
-Return a list of decorations that represents the hierarchy of
-section titles in the file. Reuse the list of decorations
-already computed in ALLDECOS if present. If the line number in
-IGNORE is specified, the decoration found on that line (if there
-is one) is not taken into account when building the hierarchy."
- (let ((all (or alldecos (rst-find-all-decorations))))
- (setq all (assq-delete-all ignore all))
- (rst-infer-hierarchy (mapcar 'cdr all))))
-
-
-(defun rst-get-decoration (&optional point)
- "Get the decoration at POINT.
-
-Looks around point and finds the characteristics of the
-decoration that is found there. Assumes that the cursor is
-already placed on the title line (and not on the overline or
-underline).
-
-This function returns a (char, style, indent) triple. If the
-characters of overline and underline are different, return
-the underline character. The indent is always calculated.
-A decoration can be said to exist if the style is not nil.
-
-A point can be specified to go to the given location before
-extracting the decoration."
-
- (let (char style)
- (save-excursion
- (if point (goto-char point))
- (beginning-of-line)
- (if (looking-at rst-section-text-regexp)
- (let* ((over (save-excursion
- (forward-line -1)
- (rst-line-homogeneous-nodent-p)))
-
- (under (save-excursion
- (forward-line +1)
- (rst-line-homogeneous-nodent-p)))
- )
-
- ;; Check that the line above the overline is not part of a title
- ;; above it.
- (if (and over
- (save-excursion
- (and (equal (forward-line -2) 0)
- (looking-at rst-section-text-regexp))))
- (setq over nil))
-
- (cond
- ;; No decoration found, leave all return values nil.
- ((and (eq over nil) (eq under nil)))
-
- ;; Overline only, leave all return values nil.
- ;;
- ;; Note: we don't return the overline character, but it could
- ;; perhaps in some cases be used to do something.
- ((and over (eq under nil)))
-
- ;; Underline only.
- ((and under (eq over nil))
- (setq char under
- style 'simple))
-
- ;; Both overline and underline.
- (t
- (setq char under
- style 'over-and-under)))))
- ;; Return values.
- (list char style
- ;; Find indentation.
- (save-excursion (back-to-indentation) (current-column))))))
-
-
-(defun rst-get-decorations-around (&optional alldecos)
- "Return the decorations around point.
-
-Given the list of all decorations ALLDECOS (with positions),
-find the decorations before and after the given point.
-A list of the previous and next decorations is returned."
- (let* ((all (or alldecos (rst-find-all-decorations)))
+Return a list of adornments that represents the hierarchy of
+section titles in the file. Each element consists of (CHARACTER
+STYLE INDENT) as described for `rst-find-all-adornments'. If the
+line number in IGNORE is specified, a possibly adornment found on
+that line is not taken into account when building the hierarchy.
+
+Uses and sets `rst-section-hierarchy' unless IGNORE is given."
+ (if (and (not ignore) rst-section-hierarchy)
+ (if (eq rst-section-hierarchy t)
+ nil
+ rst-section-hierarchy)
+ (let ((r (rst-infer-hierarchy
+ (mapcar 'cdr
+ (assq-delete-all
+ ignore
+ (rst-find-all-adornments))))))
+ (setq rst-section-hierarchy
+ (if ignore
+ ;; Clear cache reflecting that a possible update is not
+ ;; reflected.
+ nil
+ (or r t)))
+ r)))
+
+(defun rst-get-adornments-around ()
+ "Return the adornments around point.
+Return a list of the previous and next adornments."
+ (let* ((all (rst-find-all-adornments))
(curline (line-number-at-pos))
prev next
(cur all))
- ;; Search for the decorations around the current line.
+ ;; Search for the adornments around the current line.
(while (and cur (< (caar cur) curline))
(setq prev cur
cur (cdr cur)))
- ;; 'cur' is the following decoration.
+ ;; 'cur' is the following adornment.
(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-decoration-complete-p (deco)
- "Return true if the decoration DECO around point is complete."
+(defun rst-adornment-complete-p (ado)
+ "Return true if the adornment ADO around point is complete."
;; Note: we assume that the detection of the overline as being the underline
;; of a preceding title has already been detected, and has been eliminated
- ;; from the decoration that is given to us.
+ ;; from the adornment that is given to us.
;; There is some sectioning already present, so check if the current
;; sectioning is complete and correct.
- (let* ((char (car deco))
- (style (cadr deco))
- (indent (caddr deco))
- (endcol (save-excursion (end-of-line) (current-column)))
- )
+ (let* ((char (car ado))
+ (style (cadr ado))
+ (indent (caddr ado))
+ (endcol (save-excursion (end-of-line) (current-column))))
(if char
- (let ((exps (concat "^"
- (regexp-quote (make-string (+ endcol indent) char))
- "$")))
+ (let ((exps (rst-re "^" char (format "\\{%d\\}" (+ endcol indent)) "$")))
(and
(save-excursion (forward-line +1)
(beginning-of-line)
@@ -961,62 +1447,58 @@ A list of the previous and next decorations is returned."
(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-decoration
- (curdeco hier &optional suggestion reverse-direction)
- "Get the next decoration for CURDECO, in given hierarchy HIER.
-If suggesting, suggest for new decoration SUGGESTION.
+(defun rst-get-next-adornment
+ (curado hier &optional suggestion reverse-direction)
+ "Get the next adornment for CURADO, in given hierarchy HIER.
+If suggesting, suggest for new adornment SUGGESTION.
REVERSE-DIRECTION is used to reverse the cycling order."
(let* (
- (char (car curdeco))
- (style (cadr curdeco))
+ (char (car curado))
+ (style (cadr curado))
- ;; Build a new list of decorations for the rotation.
- (rotdecos
+ ;; Build a new list of adornments for the rotation.
+ (rotados
(append hier
- ;; Suggest a new decoration.
+ ;; Suggest a new adornment.
(list suggestion
- ;; If nothing to suggest, use first decoration.
+ ;; If nothing to suggest, use first adornment.
(car hier)))) )
(or
- ;; Search for next decoration.
+ ;; Search for next adornment.
(cadr
- (let ((cur (if reverse-direction rotdecos
- (reverse rotdecos))))
+ (let ((cur (if reverse-direction rotados
+ (reverse rotados))))
(while (and cur
(not (and (eq char (caar cur))
(eq style (cadar cur)))))
(setq cur (cdr cur)))
cur))
- ;; If not found, take the first of all decorations.
- suggestion
- )))
+ ;; If not found, take the first of all adornments.
+ suggestion)))
-(defun rst-adjust ()
- "Auto-adjust the decoration around point.
+;; FIXME: A line "``/`` full" is not accepted as a section title.
+(defun rst-adjust (pfxarg)
+ "Auto-adjust the adornment around point.
-Adjust/rotate the section decoration for the section title
-around point or promote/demote the decorations inside the region,
+Adjust/rotate the section adornment for the section title around
+point or promote/demote the adornments inside the region,
depending on if the region is active. This function is meant to
be invoked possibly multiple times, and can vary its behavior
-with a positive prefix argument (toggle style), or with a
-negative prefix argument (alternate behavior).
+with a positive PFXARG (toggle style), or with a negative
+PFXARG (alternate behavior).
-This function is the main focus of this module and is a bit of a
-swiss knife. It is meant as the single most essential function
-to be bound to invoke to adjust the decorations of a section
-title in restructuredtext. It tries to deal with all the
-possible cases gracefully and to do `the right thing' in all
-cases.
+This function is a bit of a swiss knife. It is meant to adjust
+the adornments of a section title in reStructuredText. It tries
+to deal with all the possible cases gracefully and to do `the
+right thing' in all cases.
-See the documentations of `rst-adjust-decoration' and
+See the documentations of `rst-adjust-adornment-work' and
`rst-promote-region' for full details.
Prefix Arguments
@@ -1025,49 +1507,60 @@ Prefix Arguments
The method can take either (but not both) of
a. a (non-negative) prefix argument, which means to toggle the
- decoration style. Invoke with a prefix arg for example;
+ adornment style. Invoke with a prefix argument for example;
b. a negative numerical argument, which generally inverts the
direction of search in the file or hierarchy. Invoke with C--
prefix for example."
- (interactive)
+ (interactive "P")
(let* (;; Save our original position on the current line.
(origpt (point-marker))
- ;; Parse the positive and negative prefix arguments.
- (reverse-direction
- (and current-prefix-arg
- (< (prefix-numeric-value current-prefix-arg) 0)))
- (toggle-style
- (and current-prefix-arg (not reverse-direction))))
+ (reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0)))
+ (toggle-style (and pfxarg (not reverse-direction))))
- (if (rst-portable-mark-active-p)
- ;; Adjust decorations within region.
- (rst-promote-region current-prefix-arg)
- ;; Adjust decoration around point.
- (rst-adjust-decoration toggle-style reverse-direction))
+ (if (use-region-p)
+ ;; Adjust adornments within region.
+ (rst-promote-region (and pfxarg t))
+ ;; Adjust adornment around point.
+ (rst-adjust-adornment-work toggle-style reverse-direction))
;; Run the hooks to run after adjusting.
(run-hooks 'rst-adjust-hook)
;; Make sure to reset the cursor position properly after we're done.
- (goto-char origpt)
-
- ))
-
-(defvar rst-adjust-hook nil
- "Hooks to be run after running `rst-adjust'.")
+ (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."
+ :group 'rst-adjust
+ :type '(choice
+ (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.
+
+Keep this for compatibility for older bindings (are there any?).
+Argument PFXARG has the same meaning as for `rst-adjust'."
+ (interactive "P")
-(defvar rst-new-decoration-down nil
- "Non-nil if new decoration is added deeper.
-If non-nil, a new decoration being added will be initialized to
-be one level down from the previous decoration. If nil, a new
-decoration will be equal to the level of the previous
-decoration.")
+ (let* ((reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0)))
+ (toggle-style (and pfxarg (not reverse-direction))))
+ (rst-adjust-adornment-work toggle-style reverse-direction)))
-(defun rst-adjust-decoration (&optional toggle-style reverse-direction)
-"Adjust/rotate the section decoration for the section title around point.
+(defun rst-adjust-adornment-work (toggle-style reverse-direction)
+"Adjust/rotate the section adornment for the section title around point.
This function is meant to be invoked possibly multiple times, and
can vary its behavior with a true TOGGLE-STYLE argument, or with
@@ -1080,13 +1573,13 @@ The next action it takes depends on context around the point, and
it is meant to be invoked possibly more than once to rotate among
the various possibilities. Basically, this function deals with:
-- adding a decoration if the title does not have one;
+- adding a adornment if the title does not have one;
- adjusting the length of the underline characters to fit a
modified title;
-- rotating the decoration in the set of already existing
- sectioning decorations used in the file;
+- rotating the adornment in the set of already existing
+ sectioning adornments used in the file;
- switching between simple and over-and-under styles.
@@ -1095,10 +1588,10 @@ invoke the method and it will do the most obvious thing that you
would expect.
-Decoration Definitions
-======================
+Adornment Definitions
+=====================
-The decorations consist in
+The adornments consist in
1. a CHARACTER
@@ -1119,71 +1612,69 @@ Here are the gory details of the algorithm (it seems quite
complicated, but really, it does the most obvious thing in all
the particular cases):
-Before applying the decoration change, the cursor is placed on
+Before applying the adornment change, the cursor is placed on
the closest line that could contain a section title.
-Case 1: No Decoration
----------------------
+Case 1: No Adornment
+--------------------
-If the current line has no decoration around it,
+If the current line has no adornment around it,
-- search backwards for the last previous decoration, and apply
- the decoration one level lower to the current line. If there
- is no defined level below this previous decoration, we suggest
- the most appropriate of the `rst-preferred-decorations'.
+- search backwards for the last previous adornment, and apply
+ the adornment one level lower to the current line. If there
+ is no defined level below this previous adornment, we suggest
+ the most appropriate of the `rst-preferred-adornments'.
If REVERSE-DIRECTION is true, we simply use the previous
- decoration found directly.
+ adornment found directly.
-- if there is no decoration found in the given direction, we use
- the first of `rst-preferred-decorations'.
+- if there is no adornment found in the given direction, we use
+ the first of `rst-preferred-adornments'.
-The prefix argument forces a toggle of the prescribed decoration
-style.
+TOGGLE-STYLE forces a toggle of the prescribed adornment style.
-Case 2: Incomplete Decoration
------------------------------
+Case 2: Incomplete Adornment
+----------------------------
-If the current line does have an existing decoration, but the
-decoration is incomplete, that is, the underline/overline does
+If the current line does have an existing adornment, but the
+adornment is incomplete, that is, the underline/overline does
not extend to exactly the end of the title line (it is either too
short or too long), we simply extend the length of the
underlines/overlines to fit exactly the section title.
-If the prefix argument is given, we toggle the style of the
-decoration as well.
+If TOGGLE-STYLE we toggle the style of the adornment as well.
REVERSE-DIRECTION has no effect in this case.
-Case 3: Complete Existing Decoration
-------------------------------------
+Case 3: Complete Existing Adornment
+-----------------------------------
-If the decoration is complete (i.e. the underline (overline)
+If the adornment is complete (i.e. the underline (overline)
length is already adjusted to the end of the title line), we
search/parse the file to establish the hierarchy of all the
-decorations (making sure not to include the decoration around
-point), and we rotate the current title's decoration from within
+adornments (making sure not to include the adornment around
+point), and we rotate the current title's adornment from within
that list (by default, going *down* the hierarchy that is present
in the file, i.e. to a lower section level). This is meant to be
-used potentially multiple times, until the desired decoration is
+used potentially multiple times, until the desired adornment is
found around the title.
If we hit the boundary of the hierarchy, exactly one choice from
-the list of preferred decorations is suggested/chosen, the first
-of those decoration that has not been seen in the file yet (and
-not including the decoration around point), and the next
+the list of preferred adornments is suggested/chosen, the first
+of those adornment that has not been seen in the file yet (and
+not including the adornment around point), and the next
invocation rolls over to the other end of the hierarchy (i.e. it
cycles). This allows you to avoid having to set which character
to use.
If REVERSE-DIRECTION is true, the effect is to change the
-direction of rotation in the hierarchy of decorations, thus
+direction of rotation in the hierarchy of adornments, thus
instead going *up* the hierarchy.
-However, if there is a non-negative prefix argument, we do not
-rotate the decoration, but instead simply toggle the style of the
-current decoration (this should be the most common way to toggle
-the style of an existing complete decoration).
+However, if TOGGLE-STYLE, we do not rotate the adornment, but
+instead simply toggle the style of the current adornment (this
+should be the most common way to toggle the style of an existing
+complete adornment).
Point Location
@@ -1203,7 +1694,7 @@ Indented section titles such as ::
My Title
--------
-are invalid in restructuredtext and thus not recognized by the
+are invalid in reStructuredText and thus not recognized by the
parser. This code will thus not work in a way that would support
indented sections (it would be ambiguous anyway).
@@ -1213,178 +1704,114 @@ Joint Sections
Section titles that are right next to each other may not be
treated well. More work might be needed to support those, and
-special conditions on the completeness of existing decorations
+special conditions on the completeness of existing adornments
might be required to make it non-ambiguous.
-For now we assume that the decorations are disjoint, that is,
-there is at least a single line between the titles/decoration
-lines.
-
-
-Suggested Binding
-=================
-
-We suggest that you bind this function on C-=. It is close to
-C-- so a negative argument can be easily specified with a flick
-of the right hand fingers and the binding is unused in `text-mode'."
- (interactive)
-
- ;; If we were invoked directly, parse the prefix arguments into the
- ;; arguments of the function.
- (if current-prefix-arg
- (setq reverse-direction
- (and current-prefix-arg
- (< (prefix-numeric-value current-prefix-arg) 0))
-
- toggle-style
- (and current-prefix-arg (not reverse-direction))))
-
- (let* (;; Check if we're on an underline around a section title, and move the
- ;; cursor to the title if this is the case.
- (moved (rst-normalize-cursor-position))
-
- ;; Find the decoration and completeness around point.
- (curdeco (rst-get-decoration))
- (char (car curdeco))
- (style (cadr curdeco))
- (indent (caddr curdeco))
-
- ;; New values to be computed.
- char-new style-new indent-new
- )
-
- ;; We've moved the cursor... if we're not looking at some text, we have
- ;; nothing to do.
- (if (save-excursion (beginning-of-line)
- (looking-at rst-section-text-regexp))
- (progn
- (cond
- ;;-------------------------------------------------------------------
- ;; Case 1: No Decoration
- ((and (eq char nil) (eq style nil))
-
- (let* ((alldecos (rst-find-all-decorations))
-
- (around (rst-get-decorations-around alldecos))
- (prev (car around))
- cur
-
- (hier (rst-get-hierarchy alldecos))
- )
-
- ;; Advance one level down.
- (setq cur
- (if prev
- (if (not reverse-direction)
- (or (funcall (if rst-new-decoration-down 'cadr 'car)
- (rst-get-decoration-match hier prev))
- (rst-suggest-new-decoration hier prev))
- prev)
- (copy-sequence (car rst-preferred-decorations))))
-
- ;; Invert the style if requested.
- (if toggle-style
- (setcar (cdr cur) (if (eq (cadr cur) 'simple)
- 'over-and-under 'simple)) )
-
- (setq char-new (car cur)
- style-new (cadr cur)
- indent-new (caddr cur))
- ))
-
- ;;-------------------------------------------------------------------
- ;; Case 2: Incomplete Decoration
- ((not (rst-decoration-complete-p curdeco))
-
- ;; Invert the style if requested.
- (if toggle-style
- (setq style (if (eq style 'simple) 'over-and-under 'simple)))
-
- (setq char-new char
- style-new style
- indent-new indent))
-
- ;;-------------------------------------------------------------------
- ;; Case 3: Complete Existing Decoration
- (t
- (if toggle-style
-
- ;; Simply switch the style of the current decoration.
- (setq char-new char
- style-new (if (eq style 'simple) 'over-and-under 'simple)
- indent-new rst-default-indent)
-
- ;; Else, we rotate, ignoring the decoration around the current
- ;; line...
- (let* ((alldecos (rst-find-all-decorations))
-
- (hier (rst-get-hierarchy alldecos (line-number-at-pos)))
-
- ;; Suggestion, in case we need to come up with something
- ;; new
- (suggestion (rst-suggest-new-decoration
- hier
- (car (rst-get-decorations-around alldecos))))
-
- (nextdeco (rst-get-next-decoration
- curdeco hier suggestion reverse-direction))
-
- )
-
- ;; Indent, if present, always overrides the prescribed indent.
- (setq char-new (car nextdeco)
- style-new (cadr nextdeco)
- indent-new (caddr nextdeco))
-
- )))
- )
-
- ;; Override indent with present indent!
- (setq indent-new (if (> indent 0) indent indent-new))
-
- (if (and char-new style-new)
- (rst-update-section char-new style-new indent-new))
- ))
-
-
- ;; Correct the position of the cursor to more accurately reflect where it
- ;; was located when the function was invoked.
- (unless (= moved 0)
- (forward-line (- moved))
- (end-of-line))
-
- ))
+For now we assume that the adornments are disjoint, that is,
+there is at least a single line between the titles/adornment
+lines."
+ (rst-reset-section-caches)
+ (let ((ttl-fnd (rst-find-title-line))
+ (orig-pnt (point)))
+ (when ttl-fnd
+ (set-match-data (cdr ttl-fnd))
+ (goto-char (match-beginning 2))
+ (let* ((moved (- (line-number-at-pos) (line-number-at-pos orig-pnt)))
+ (char (caar ttl-fnd))
+ (style (cdar ttl-fnd))
+ (indent (current-indentation))
+ (curado (list char style indent))
+ char-new style-new indent-new)
+ (cond
+ ;;-------------------------------------------------------------------
+ ;; Case 1: No valid adornment
+ ((not style)
+ (let ((prev (car (rst-get-adornments-around)))
+ cur
+ (hier (rst-get-hierarchy)))
+ ;; Advance one level down.
+ (setq cur
+ (if prev
+ (if (or (and rst-new-adornment-down reverse-direction)
+ (and (not rst-new-adornment-down)
+ (not reverse-direction)))
+ prev
+ (or (cadr (rst-get-adornment-match hier prev))
+ (rst-suggest-new-adornment hier prev)))
+ (copy-sequence (car rst-preferred-adornments))))
+ ;; Invert the style if requested.
+ (if toggle-style
+ (setcar (cdr cur) (if (eq (cadr cur) 'simple)
+ 'over-and-under 'simple)) )
+ (setq char-new (car cur)
+ style-new (cadr cur)
+ indent-new (caddr cur))))
+ ;;-------------------------------------------------------------------
+ ;; Case 2: Incomplete Adornment
+ ((not (rst-adornment-complete-p curado))
+ ;; Invert the style if requested.
+ (if toggle-style
+ (setq style (if (eq style 'simple) 'over-and-under 'simple)))
+ (setq char-new char
+ style-new style
+ indent-new indent))
+ ;;-------------------------------------------------------------------
+ ;; Case 3: Complete Existing Adornment
+ (t
+ (if toggle-style
+ ;; Simply switch the style of the current adornment.
+ (setq char-new char
+ style-new (if (eq style 'simple) 'over-and-under 'simple)
+ indent-new rst-default-indent)
+ ;; Else, we rotate, ignoring the adornment around the current
+ ;; line...
+ (let* ((hier (rst-get-hierarchy (line-number-at-pos)))
+ ;; Suggestion, in case we need to come up with something new.
+ (suggestion (rst-suggest-new-adornment
+ hier
+ (car (rst-get-adornments-around))))
+ (nextado (rst-get-next-adornment
+ curado hier suggestion reverse-direction)))
+ ;; Indent, if present, always overrides the prescribed indent.
+ (setq char-new (car nextado)
+ style-new (cadr nextado)
+ indent-new (caddr nextado))))))
+ ;; Override indent with present indent!
+ (setq indent-new (if (> indent 0) indent indent-new))
+ (if (and char-new style-new)
+ (rst-update-section char-new style-new indent-new))
+ ;; Correct the position of the cursor to more accurately reflect where
+ ;; it was located when the function was invoked.
+ (unless (zerop moved)
+ (forward-line (- moved))
+ (end-of-line))))))
;; Maintain an alias for compatibility.
(defalias 'rst-adjust-section-title 'rst-adjust)
-(defun rst-promote-region (&optional demote)
+(defun rst-promote-region (demote)
"Promote the section titles within the region.
With argument DEMOTE or a prefix argument, demote the section
titles instead. The algorithm used at the boundaries of the
-hierarchy is similar to that used by `rst-adjust-decoration'."
- (interactive)
-
- (let* ((demote (or current-prefix-arg demote))
- (alldecos (rst-find-all-decorations))
- (cur alldecos)
-
- (hier (rst-get-hierarchy alldecos))
- (suggestion (rst-suggest-new-decoration hier))
+hierarchy is similar to that used by `rst-adjust-adornment-work'."
+ (interactive "P")
+ (rst-reset-section-caches)
+ (let* ((cur (rst-find-all-adornments))
+ (hier (rst-get-hierarchy))
+ (suggestion (rst-suggest-new-adornment hier))
(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
+ ;; Skip the markers that come before the region beginning.
(while (and cur (< (caar cur) region-begin-line))
(setq cur (cdr cur)))
- ;; Create a list of markers for all the decorations which are found within
+ ;; Create a list of markers for all the adornments which are found within
;; the region.
(save-excursion
(let (line)
@@ -1396,145 +1823,322 @@ hierarchy is similar to that used by `rst-adjust-decoration'."
;; Apply modifications.
(dolist (p marker-list)
- ;; Go to the decoration to promote.
- (goto-char (car p))
+ ;; Go to the adornment to promote.
+ (goto-char (car p))
- ;; Update the decoration.
- (apply 'rst-update-section
- ;; Rotate the next decoration.
- (rst-get-next-decoration
- (cadr p) hier suggestion demote))
+ ;; Update the adornment.
+ (apply 'rst-update-section
+ ;; Rotate the next adornment.
+ (rst-get-next-adornment
+ (cadr p) hier suggestion demote))
- ;; Clear marker to avoid slowing down the editing after we're done.
- (set-marker (car p) nil))
- (setq deactivate-mark nil)
- )))
+ ;; Clear marker to avoid slowing down the editing after we're done.
+ (set-marker (car p) nil))
+ (setq deactivate-mark nil))))
-(defun rst-display-decorations-hierarchy (&optional decorations)
- "Display the current file's section title decorations hierarchy.
-This function expects a list of (char, style, indent) triples in
-DECORATIONS."
+(defun rst-display-adornments-hierarchy (&optional adornments)
+ "Display the current file's section title adornments hierarchy.
+This function expects a list of (CHARACTER STYLE INDENT) triples
+in ADORNMENTS."
(interactive)
-
- (if (not decorations)
- (setq decorations (rst-get-hierarchy)))
+ (rst-reset-section-caches)
+ (if (not adornments)
+ (setq adornments (rst-get-hierarchy)))
(with-output-to-temp-buffer "*rest section hierarchy*"
(let ((level 1))
(with-current-buffer standard-output
- (dolist (x decorations)
+ (dolist (x adornments)
(insert (format "\nSection Level %d" level))
(apply 'rst-update-section x)
(goto-char (point-max))
(insert "\n")
- (incf level)
- ))
- )))
-
-(defun rst-position (elem list)
- "Return position of ELEM in LIST or nil."
- (let ((tail (member elem list)))
- (if tail (- (length list) (length tail)))))
-
-(defun rst-straighten-decorations ()
- "Redo all the decorations in the current buffer.
-This is done using our preferred set of decorations. This can be
+ (incf level))))))
+
+(defun rst-straighten-adornments ()
+ "Redo all the adornments in the current buffer.
+This is done using our preferred set of adornments. This can be
used, for example, when using somebody else's copy of a document,
in order to adapt it to our preferred style."
(interactive)
+ (rst-reset-section-caches)
(save-excursion
- (let* ((alldecos (rst-find-all-decorations))
- (hier (rst-get-hierarchy alldecos))
-
- ;; Get a list of pairs of (level . marker)
- (levels-and-markers (mapcar
- (lambda (deco)
- (cons (rst-position (cdr deco) hier)
- (progn
- (goto-char (point-min))
- (forward-line (1- (car deco)))
- (point-marker))))
- alldecos))
- )
+ (let (;; Get a list of pairs of (level . marker).
+ (levels-and-markers (mapcar
+ (lambda (ado)
+ (cons (rst-position (cdr ado)
+ (rst-get-hierarchy))
+ (progn
+ (goto-char (point-min))
+ (forward-line (1- (car ado)))
+ (point-marker))))
+ (rst-find-all-adornments))))
(dolist (lm levels-and-markers)
- ;; Go to the appropriate position
+ ;; Go to the appropriate position.
(goto-char (cdr lm))
- ;; Apply the new styule
- (apply 'rst-update-section (nth (car lm) rst-preferred-decorations))
-
- ;; Reset the market to avoid slowing down editing until it gets GC'ed
- (set-marker (cdr lm) nil)
- )
- )))
-
-
-
+ ;; Apply the new style.
+ (apply 'rst-update-section (nth (car lm) rst-preferred-adornments))
-(defun rst-straighten-deco-spacing ()
- "Adjust the spacing before and after decorations in the entire document.
-The spacing will be set to two blank lines before the first two
-section levels, and one blank line before any of the other
-section levels."
-;; FIXME: we need to take care of subtitle at some point.
- (interactive)
- (save-excursion
- (let* ((alldecos (rst-find-all-decorations)))
-
- ;; Work the list from the end, so that we don't have to use markers to
- ;; adjust for the changes in the document.
- (dolist (deco (nreverse alldecos))
- ;; Go to the appropriate position.
- (goto-char (point-min))
- (forward-line (1- (car deco)))
- (insert "@\n")
-;; FIXME: todo, we
- )
- )))
+ ;; Reset the marker to avoid slowing down editing until it gets GC'ed.
+ (set-marker (cdr lm) nil)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Insert list items
+;; =================
+
+
+;=================================================
+; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell <wence@gmx.li>.
+; I needed to make some tiny changes to the functions, so I put it here.
+; -- Wei-Wei Guo
+
+(defconst rst-arabic-to-roman
+ '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD")
+ (100 . "C") (90 . "XC") (50 . "L") (40 . "XL")
+ (10 . "X") (9 . "IX") (5 . "V") (4 . "IV")
+ (1 . "I"))
+ "List of maps between Arabic numbers and their Roman numeral equivalents.")
+
+(defun rst-arabic-to-roman (num &optional arg)
+ "Convert Arabic number NUM to its Roman numeral representation.
+
+Obviously, NUM must be greater than zero. Don't blame me, blame the
+Romans, I mean \"what have the Romans ever _done_ for /us/?\" (with
+apologies to Monty Python).
+If optional prefix ARG is non-nil, insert in current buffer."
+ (let ((map rst-arabic-to-roman)
+ res)
+ (while (and map (> num 0))
+ (if (or (= num (caar map))
+ (> num (caar map)))
+ (setq res (concat res (cdar map))
+ num (- num (caar map)))
+ (setq map (cdr map))))
+ res))
+
+(defun rst-roman-to-arabic (string &optional arg)
+ "Convert STRING of Roman numerals to an Arabic number.
+
+If STRING contains a letter which isn't a valid Roman numeral, the rest
+of the string from that point onwards is ignored.
+
+Hence:
+MMD == 2500
+and
+MMDFLXXVI == 2500.
+If optional ARG is non-nil, insert in current buffer."
+ (let ((res 0)
+ (map rst-arabic-to-roman))
+ (while map
+ (if (string-match (concat "^" (cdar map)) string)
+ (setq res (+ res (caar map))
+ string (replace-match "" nil t string))
+ (setq map (cdr map))))
+ res))
+;=================================================
(defun rst-find-pfx-in-region (beg end pfx-re)
"Find all the positions of prefixes in region between BEG and END.
-This is used to find bullets and enumerated list items. PFX-RE
-is a regular expression for matching the lines with items."
+This is used to find bullets and enumerated list items. PFX-RE is
+a regular expression for matching the lines after indentation
+with items. Returns a list of cons cells consisting of the point
+and the column of the point."
(let ((pfx ()))
(save-excursion
(goto-char beg)
(while (< (point) end)
(back-to-indentation)
(when (and
- (looking-at pfx-re)
+ (looking-at pfx-re) ; pfx found and...
(let ((pfx-col (current-column)))
(save-excursion
- (forward-line -1)
+ (forward-line -1) ; ...previous line is...
(back-to-indentation)
- (or (looking-at "^[ \t]*$")
- (> (current-column) pfx-col)
+ (or (looking-at (rst-re 'lin-end)) ; ...empty,
+ (> (current-column) pfx-col) ; ...deeper level, or
(and (= (current-column) pfx-col)
- (looking-at pfx-re))))))
+ (looking-at pfx-re)))))) ; ...pfx at same level.
(push (cons (point) (current-column))
pfx))
- (forward-line 1)) )
+ (forward-line 1)))
(nreverse pfx)))
-(defvar rst-re-bullets
- (format "\\([%s][ \t]\\)[^ \t]" (regexp-quote (concat rst-bullets)))
- "Regexp for finding bullets.")
+(defun rst-insert-list-pos (newitem)
+ "Arrange relative position of a newly inserted list item of style NEWITEM.
+
+Adding a new list might consider three situations:
-;; (defvar rst-re-enumerations
-;; "\\(\\(#\\|[0-9]+\\)\\.[ \t]\\)[^ \t]"
-;; "Regexp for finding bullets.")
+ (a) Current line is a blank line.
+ (b) Previous line is a blank line.
+ (c) Following line is a blank line.
-(defvar rst-re-items
- (format "\\(%s\\|%s\\)[^ \t]"
- (format "[%s][ \t]" (regexp-quote (concat rst-bullets)))
- "\\(#\\|[0-9]+\\)\\.[ \t]")
- "Regexp for finding bullets.")
+When (a) and (b), just add the new list at current line.
-(defvar rst-preferred-bullets
- '(?- ?* ?+)
- "List of favorite bullets to set for straightening bullets.")
+when (a) and not (b), a blank line is added before adding the new list.
+
+When not (a), first forward point to the end of the line, and add two
+blank lines, then add the new list.
+
+Other situations are just ignored and left to users themselves."
+ (if (save-excursion
+ (beginning-of-line)
+ (looking-at (rst-re 'lin-end)))
+ (if (save-excursion
+ (forward-line -1)
+ (looking-at (rst-re 'lin-end)))
+ (insert newitem " ")
+ (insert "\n" newitem " "))
+ (end-of-line)
+ (insert "\n\n" newitem " ")))
+
+;; FIXME: Isn't this a `defconst'?
+(defvar rst-initial-enums
+ (let (vals)
+ (dolist (fmt '("%s." "(%s)" "%s)"))
+ (dolist (c '("1" "a" "A" "I" "i"))
+ (push (format fmt c) vals)))
+ (cons "#." (nreverse vals)))
+ "List of initial enumerations.")
+
+;; FIXME: Isn't this a `defconst'?
+(defvar rst-initial-items
+ (append (mapcar 'char-to-string rst-bullets) rst-initial-enums)
+ "List of initial items. It's collection of bullets and enumerations.")
+
+(defun rst-insert-list-new-item ()
+ "Insert a new list item.
+
+User is asked to select the item style first, for example (a), i), +. Use TAB
+for completion and choices.
+
+If user selects bullets or #, it's just added with position arranged by
+`rst-insert-list-pos'.
+
+If user selects enumerations, a further prompt is given. User need to input a
+starting item, for example 'e' for 'A)' style. The position is also arranged by
+`rst-insert-list-pos'."
+ (interactive)
+ ;; FIXME: Make this comply to `interactive' standards.
+ (let* ((itemstyle (completing-read
+ "Select preferred item style [#.]: "
+ rst-initial-items nil t nil nil "#."))
+ (cnt (if (string-match (rst-re 'cntexp-tag) itemstyle)
+ (match-string 0 itemstyle)))
+ (no
+ (save-match-data
+ ;; FIXME: Make this comply to `interactive' standards.
+ (cond
+ ((equal cnt "a")
+ (let ((itemno (read-string "Give starting value [a]: "
+ nil nil "a")))
+ (downcase (substring itemno 0 1))))
+ ((equal cnt "A")
+ (let ((itemno (read-string "Give starting value [A]: "
+ nil nil "A")))
+ (upcase (substring itemno 0 1))))
+ ((equal cnt "I")
+ (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (rst-arabic-to-roman itemno)))
+ ((equal cnt "i")
+ (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (downcase (rst-arabic-to-roman itemno))))
+ ((equal cnt "1")
+ (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (number-to-string itemno)))))))
+ (if no
+ (setq itemstyle (replace-match no t t itemstyle)))
+ (rst-insert-list-pos itemstyle)))
+
+(defcustom rst-preferred-bullets
+ '(?* ?- ?+)
+ "List of favorite bullets."
+ :group 'rst
+ :type `(repeat
+ (choice ,@(mapcar (lambda (char)
+ (list 'const
+ :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.
+If PREFER-ROMAN roman numbering is preferred over using letters."
+ (end-of-line)
+ (insert
+ "\n" ; FIXME: Separating lines must be possible.
+ (cond
+ ((string-match (rst-re '(:alt enmaut-tag
+ bul-tag)) curitem)
+ curitem)
+ ((string-match (rst-re 'num-tag) curitem)
+ (replace-match (number-to-string
+ (1+ (string-to-number (match-string 0 curitem))))
+ nil nil curitem))
+ ((and (string-match (rst-re 'rom-tag) curitem)
+ (save-match-data
+ (if (string-match (rst-re 'ltr-tag) curitem) ; Also a letter tag.
+ (save-excursion
+ ;; FIXME: Assumes one line list items without separating
+ ;; empty lines.
+ (if (and (zerop (forward-line -1))
+ (looking-at (rst-re 'enmexp-beg)))
+ (string-match
+ (rst-re 'rom-tag)
+ (match-string 0)) ; Previous was a roman tag.
+ prefer-roman)) ; Don't know - use flag.
+ t))) ; Not a letter tag.
+ (replace-match
+ (let* ((old (match-string 0 curitem))
+ (new (save-match-data
+ (rst-arabic-to-roman
+ (1+ (rst-roman-to-arabic
+ (upcase old)))))))
+ (if (equal old (upcase old))
+ (upcase new)
+ (downcase new)))
+ t nil curitem))
+ ((string-match (rst-re 'ltr-tag) curitem)
+ (replace-match (char-to-string
+ (1+ (string-to-char (match-string 0 curitem))))
+ nil nil curitem)))))
+
+
+(defun rst-insert-list (&optional prefer-roman)
+ "Insert a list item at the current point.
+
+The command can insert a new list or a continuing list. When it is called at a
+non-list line, it will promote to insert new list. When it is called at a list
+line, it will insert a list with the same list style.
+
+1. When inserting a new list:
+
+User is asked to select the item style first, for example (a), i), +. Use TAB
+for completion and choices.
+
+ (a) If user selects bullets or #, it's just added.
+ (b) If user selects enumerations, a further prompt is given. User needs to
+ input a starting item, for example 'e' for 'A)' style.
+
+The position of the new list is arranged according to whether or not the
+current line and the previous line are blank lines.
+
+2. When continuing a list, one thing need to be noticed:
+
+List style alphabetical list, such as 'a.', and roman numerical list, such as
+'i.', have some overlapping items, for example 'v.' The function can deal with
+the problem elegantly in most situations. But when those overlapped list are
+preceded by a blank line, it is hard to determine which type to use
+automatically. The function uses alphabetical list by default. If you want
+roman numerical list, just use a prefix to set PREFER-ROMAN."
+ (interactive "P")
+ (beginning-of-line)
+ (if (looking-at (rst-re 'itmany-beg-1))
+ (rst-insert-list-continue (match-string 0) prefer-roman)
+ (rst-insert-list-new-item)))
(defun rst-straighten-bullets-region (beg end)
"Make all the bulleted list items in the region consistent.
@@ -1547,8 +2151,7 @@ adjust. If bullets are found on levels beyond the
`rst-preferred-bullets' list, they are not modified."
(interactive "r")
- (let ((bullets (rst-find-pfx-in-region beg end
- rst-re-bullets))
+ (let ((bullets (rst-find-pfx-in-region beg end (rst-re 'bul-sta)))
(levtable (make-hash-table :size 4)))
;; Create a map of levels to list of positions.
@@ -1573,136 +2176,117 @@ adjust. If bullets are found on levels beyond the
(insert (string (car bullets))))
(setq bullets (cdr bullets))))))))
-(defun rst-rstrip (str)
- "Strips the whitespace at the end of string STR."
- (string-match "[ \t\n]*\\'" str)
- (substring str 0 (match-beginning 0)))
-
-(defun rst-get-stripped-line ()
- "Return the line at cursor, stripped from whitespace."
- (re-search-forward "\\S-.*\\S-" (line-end-position))
- (buffer-substring-no-properties (match-beginning 0)
- (match-end 0)) )
-
-(defun rst-section-tree (alldecos)
- "Get the hierarchical tree of section titles.
-
-Returns a hierarchical tree of the sections titles in the
-document, for decorations ALLDECOS. 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."
-
- (let* ((hier (rst-get-hierarchy alldecos))
- (levels (make-hash-table :test 'equal :size 10))
- lines)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Table of contents
+;; =================
+
+;; FIXME: Return value should be a `defstruct'.
+(defun rst-section-tree ()
+ "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))
+ (ch-sty2level (make-hash-table :test 'equal :size 10))
+ lev-ttl-mrk-l)
(let ((lev 0))
- (dolist (deco hier)
+ (dolist (ado hier)
;; Compare just the character and indent in the hash table.
- (puthash (cons (car deco) (cadr deco)) 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
- ;; decoration.
+ ;; Create a list that contains (LEVEL TITLE MARKER) for each adornment.
(save-excursion
- (setq lines
- (mapcar (lambda (deco)
+ (setq lev-ttl-mrk-l
+ (mapcar (lambda (ado)
(goto-char (point-min))
- (forward-line (1- (car deco)))
- (list (gethash (cons (cadr deco) (caddr deco)) levels)
- (rst-get-stripped-line)
- (progn
- (beginning-of-line 1)
- (point-marker))))
- alldecos)))
-
- (let ((lcontnr (cons nil lines)))
- (rst-section-tree-rec lcontnr -1))))
-
-
-(defun rst-section-tree-rec (decos lev)
- "Recursive guts of the section tree construction.
-DECOS is a cons cell whose cdr is the remaining list of
-decorations, 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 DECOS
-list destructively."
-
- (let ((ndeco (cadr decos))
- node
- children)
-
- ;; If the next decoration matches our level
- (when (and ndeco (= (car ndeco) lev))
- ;; Pop the next decoration and create the current node with it
- (setcdr decos (cddr decos))
- (setq node (cdr ndeco)) )
- ;; Else we let the node title/marker be unset.
-
- ;; Build the child nodes
- (while (and (cdr decos) (> (caadr decos) lev))
- (setq children
- (cons (rst-section-tree-rec decos (1+ lev))
- children)))
+ (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))))
+ (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 sectree 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."
@@ -1713,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.
@@ -1723,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
@@ -1738,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.
@@ -1749,10 +2336,9 @@ If a numeric prefix argument PFXARG is given, insert the TOC up
to the specified level.
The TOC is inserted indented at the current column."
-
(interactive "P")
-
- (let* (;; Check maximum level override
+ (rst-reset-section-caches)
+ (let* (;; Check maximum level override.
(rst-toc-insert-max-level
(if (and (integerp pfxarg) (> (prefix-numeric-value pfxarg) 0))
(prefix-numeric-value pfxarg) rst-toc-insert-max-level))
@@ -1760,7 +2346,7 @@ The TOC is inserted indented at the current column."
;; Get the section tree for the current cursor point.
(sectree-pair
(rst-section-tree-point
- (rst-section-tree (rst-find-all-decorations))))
+ (rst-section-tree)))
;; Figure out initial indent.
(initial-indent (make-string (current-column) ? ))
@@ -1773,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.
@@ -1800,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.
@@ -1819,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))
@@ -1829,17 +2410,17 @@ level to align."
fmt)
(if do-child-numbering
(progn
- ;; Add a separating dot if there is already a prefix
- (if (> (length pfx) 0)
- (setq pfx (concat (rst-rstrip pfx) ".")))
+ ;; Add a separating dot if there is already a prefix.
+ (when (> (length pfx) 0)
+ (string-match (rst-re "[ \t\n]*\\'") pfx)
+ (setq pfx (concat (replace-match "" t t pfx) ".")))
;; Calculate the amount of space that the prefix will require
;; for the numbers.
(if (cdr node)
(setq fmt (format "%%-%dd"
(1+ (floor (log10 (length
- (cdr node))))))))
- ))
+ (cdr node))))))))))
(dolist (child (cdr node))
(rst-toc-insert-node child
@@ -1847,64 +2428,51 @@ level to align."
indent
(if do-child-numbering
(concat pfx (format fmt count)) pfx))
- (incf count)))
+ (incf count))))))
- )))
-
-
-(defun rst-toc-insert-find-delete-contents ()
- "Find and delete an existing comment after the first contents directive.
-Delete that region. Return t if found and the cursor is left after the comment."
- (goto-char (point-min))
- ;; We look for the following and the following only (in other words, if your
- ;; syntax differs, this won't work. If you would like a more flexible thing,
- ;; contact the author, I just can't imagine that this requirement is
- ;; unreasonable for now).
- ;;
- ;; .. contents:: [...anything here...]
- ;; ..
- ;; XXXXXXXX
- ;; XXXXXXXX
- ;; [more lines]
- ;;
- (let ((beg
- (re-search-forward "^\\.\\. contents[ \t]*::\\(.*\\)\n\\.\\."
- nil t))
- last-real)
- (when beg
- ;; Look for the first line that starts at the first column.
- (forward-line 1)
- (beginning-of-line)
- (while (and
- (< (point) (point-max))
- (or (and (looking-at "[ \t]+[^ \t]") (setq last-real (point)) t)
- (looking-at "[ \t]*$")))
- (forward-line 1)
- )
- (if last-real
- (progn
- (goto-char last-real)
- (end-of-line)
- (delete-region beg (point)))
- (goto-char beg))
- t
- )))
(defun rst-toc-update ()
"Automatically find the contents section of a document and update.
Updates the inserted TOC if present. You can use this in your
file-write hook to always make it up-to-date automatically."
(interactive)
- (let ((p (point)))
- (save-excursion
- (when (rst-toc-insert-find-delete-contents)
- (insert "\n ")
- (rst-toc-insert)
- ))
- ;; Somehow save-excursion does not really work well.
- (goto-char p))
+ (save-excursion
+ ;; Find and delete an existing comment after the first contents directive.
+ ;; Delete that region.
+ (goto-char (point-min))
+ ;; We look for the following and the following only (in other words, if your
+ ;; syntax differs, this won't work.).
+ ;;
+ ;; .. contents:: [...anything here...]
+ ;; [:field: value]...
+ ;; ..
+ ;; XXXXXXXX
+ ;; XXXXXXXX
+ ;; [more lines]
+ (let ((beg (re-search-forward
+ (rst-re "^" 'exm-sta "contents" 'dcl-tag ".*\n"
+ "\\(?:" 'hws-sta 'fld-tag ".*\n\\)*" 'exm-tag) nil t))
+ last-real)
+ (when beg
+ ;; Look for the first line that starts at the first column.
+ (forward-line 1)
+ (while (and
+ (< (point) (point-max))
+ (or (if (looking-at
+ (rst-re 'hws-sta "\\S ")) ; indented content.
+ (setq last-real (point)))
+ (looking-at (rst-re 'lin-end)))) ; empty line.
+ (forward-line 1))
+ (if last-real
+ (progn
+ (goto-char last-real)
+ (end-of-line)
+ (delete-region beg (point)))
+ (goto-char beg))
+ (insert "\n ")
+ (rst-toc-insert))))
;; Note: always return nil, because this may be used as a hook.
- )
+ nil)
;; Note: we cannot bind the TOC update on file write because it messes with
;; undo. If we disable undo, since it adds and removes characters, the
@@ -1916,7 +2484,7 @@ file-write hook to always make it up-to-date automatically."
;; ;; Disable undo for the write file hook.
;; (let ((buffer-undo-list t)) (rst-toc-update) ))
-(defalias 'rst-toc-insert-update 'rst-toc-update) ;; backwards compat.
+(defalias 'rst-toc-insert-update 'rst-toc-update) ; backwards compat.
;;------------------------------------------------------------------------------
@@ -1935,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))))
@@ -1962,13 +2529,13 @@ children, and t if the node has been found."
(defvar rst-toc-buffer-name "*Table of Contents*"
"Name of the Table of Contents buffer.")
-(defvar rst-toc-return-buffer nil
- "Buffer to which to return when leaving the TOC.")
+(defvar rst-toc-return-wincfg nil
+ "Window configuration to which to return when leaving the TOC.")
(defun rst-toc ()
"Display a table-of-contents.
-Finds all the section titles and their decorations in the
+Finds all the section titles and their adornments in the
file, and displays a hierarchically-organized list of the
titles, which is essentially a table-of-contents of the
document.
@@ -1976,18 +2543,15 @@ document.
The Emacs buffer can be navigated, and selecting a section
brings the cursor in that section."
(interactive)
- (let* ((curbuf (current-buffer))
-
- ;; Get the section tree
- (alldecos (rst-find-all-decorations))
- (sectree (rst-section-tree alldecos))
+ (rst-reset-section-caches)
+ (let* ((curbuf (list (current-window-configuration) (point-marker)))
+ (sectree (rst-section-tree))
(our-node (cdr (rst-section-tree-point sectree)))
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))
@@ -2000,18 +2564,16 @@ 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)
;; Save the buffer to return to.
- (set (make-local-variable 'rst-toc-return-buffer) curbuf)
+ (set (make-local-variable 'rst-toc-return-wincfg) curbuf)
;; 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 ()
@@ -2023,11 +2585,17 @@ brings the cursor in that section."
(error "Buffer for this section was killed"))
pos))
+;; FIXME: Cursor before or behind the list must be handled properly; before the
+;; list should jump to the top and behind the list to the last normal
+;; paragraph.
(defun rst-goto-section (&optional kill)
- "Go to the section the current line describes."
+ "Go to the section the current line describes.
+If KILL a toc buffer is destroyed."
(interactive)
(let ((pos (rst-toc-mode-find-section)))
(when kill
+ ;; FIXME: This should rather go to `rst-toc-mode-goto-section'.
+ (set-window-configuration (car rst-toc-return-wincfg))
(kill-buffer (get-buffer rst-toc-buffer-name)))
(pop-to-buffer (marker-buffer pos))
(goto-char pos)
@@ -2044,16 +2612,17 @@ brings the cursor in that section."
EVENT is the input event."
(interactive "e")
(let ((pos
- (with-current-buffer (window-buffer (posn-window (event-end event)))
- (save-excursion
- (goto-char (posn-point (event-end event)))
+ (with-current-buffer (window-buffer (posn-window (event-end event)))
+ (save-excursion
+ (goto-char (posn-point (event-end event)))
(rst-toc-mode-find-section)))))
(pop-to-buffer (marker-buffer pos))
(goto-char pos)
(recenter 5)))
(defun rst-toc-mode-mouse-goto-kill (event)
- "Same as `rst-toc-mode-mouse-goto', but kill TOC buffer as well."
+ "Same as `rst-toc-mode-mouse-goto', but kill TOC buffer as well.
+EVENT is the input event."
(interactive "e")
(call-interactively 'rst-toc-mode-mouse-goto event)
(kill-buffer (get-buffer rst-toc-buffer-name)))
@@ -2061,8 +2630,9 @@ EVENT is the input event."
(defun rst-toc-quit-window ()
"Leave the current TOC buffer."
(interactive)
- (quit-window)
- (pop-to-buffer rst-toc-return-buffer))
+ (let ((retbuf rst-toc-return-wincfg))
+ (set-window-configuration (car retbuf))
+ (goto-char (cadr retbuf))))
(defvar rst-toc-mode-map
(let ((map (make-sparse-keymap)))
@@ -2085,42 +2655,40 @@ EVENT is the input event."
;; Note: use occur-mode (replace.el) as a good example to complete missing
;; features.
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Section movement commands.
-;;
+;; Section movement commands
+;; =========================
(defun rst-forward-section (&optional offset)
- "Skip to the next restructured text section title.
+ "Skip to the next reStructuredText section title.
OFFSET specifies how many titles to skip. Use a negative OFFSET to move
backwards in the file (default is to use 1)."
(interactive)
+ (rst-reset-section-caches)
(let* (;; Default value for offset.
(offset (or offset 1))
- ;; Get all the decorations in the file, with their line numbers.
- (alldecos (rst-find-all-decorations))
+ ;; Get all the adornments in the file, with their line numbers.
+ (allados (rst-find-all-adornments))
;; Get the current line.
(curline (line-number-at-pos))
- (cur alldecos)
- (idx 0)
- )
+ (cur allados)
+ (idx 0))
- ;; Find the index of the "next" decoration w.r.t. to the current line.
+ ;; Find the index of the "next" adornment w.r.t. to the current line.
(while (and cur (< (caar cur) curline))
(setq cur (cdr cur))
(incf idx))
- ;; 'cur' is the decoration on or following the current line.
+ ;; 'cur' is the adornment on or following the current line.
(if (and (> offset 0) cur (= (caar cur) curline))
(incf idx))
;; Find the final index.
(setq idx (+ idx (if (> offset 0) (- offset 1) offset)))
- (setq cur (nth idx alldecos))
+ (setq cur (nth idx allados))
;; If the index is positive, goto the line, otherwise go to the buffer
;; boundaries.
@@ -2128,279 +2696,61 @@ 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."
(interactive)
(rst-forward-section -1))
-(defun rst-mark-section (&optional arg allow-extend)
- "Select the section that point is currently in."
+;; FIXME: What is `allow-extend' for?
+(defun rst-mark-section (&optional count allow-extend)
+ "Select COUNT sections around point.
+Mark following sections for positive COUNT or preceding sections
+for negative COUNT."
;; Cloned from mark-paragraph.
(interactive "p\np")
- (unless arg (setq arg 1))
- (when (zerop arg)
+ (unless count (setq count 1))
+ (when (zerop 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))
- (rst-forward-section arg)
+ (rst-forward-section count)
(point))))
(t
- (rst-forward-section arg)
+ (rst-forward-section count)
(push-mark nil t t)
- (rst-forward-section (- arg)))))
-
-
-
-
+ (rst-forward-section (- count)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions to work on item lists (e.g. indent/dedent, enumerate), which are
;; always 2 or 3 characters apart horizontally with rest.
-;; (FIXME: there is currently a bug that makes the region go away when we do that.)
-(defvar rst-shift-fill-region nil
- "If non-nil, automatically re-fill the region that is being shifted.")
-
(defun rst-find-leftmost-column (beg end)
- "Find the leftmost column in the region."
- (let ((mincol 1000))
+ "Return the leftmost column in region BEG to END."
+ (let (mincol)
(save-excursion
(goto-char beg)
(while (< (point) end)
(back-to-indentation)
- (unless (looking-at "[ \t]*$")
- (setq mincol (min mincol (current-column))))
- (forward-line 1)
- ))
+ (unless (looking-at (rst-re 'lin-end))
+ (setq mincol (if mincol
+ (min mincol (current-column))
+ (current-column))))
+ (forward-line 1)))
mincol))
-
-;; What we really need to do is compute all the possible alignment possibilities
-;; and then select one.
-;;
-;; .. line-block::
-;;
-;; a) sdjsds
-;;
-;; - sdjsd jsjds
-;;
-;; sdsdsjdsj
-;;
-;; 11. sjdss jddjs
-;;
-;; * * * * * * *
-;;
-;; Move backwards, accumulate the beginning positions, and also the second
-;; positions, in case the line matches the bullet pattern, and then sort.
-
-(defun rst-compute-bullet-tabs (&optional pt)
- "Build the list of possible horizontal alignment points.
-Search backwards from point (or point PT if specified) to
-build the list of possible horizontal alignment points that
-includes the beginning and contents of a restructuredtext
-bulleted or enumerated list item. Return a sorted list
-of (COLUMN-NUMBER . LINE) pairs."
- (save-excursion
- (when pt (goto-char pt))
-
- ;; We work our way backwards and towards the left.
- (let ((leftcol 100000) ;; Current column.
- (tablist nil) ;; List of tab positions.
- )
-
- ;; Start by skipping the current line.
- (beginning-of-line 0)
-
- ;; Search backwards for each line.
- (while (and (> (point) (point-min))
- (> leftcol 0))
-
- ;; Skip empty lines.
- (unless (looking-at "^[ \t]*$")
- ;; Inspect the current non-empty line
- (back-to-indentation)
-
- ;; Skip lines that are beyond the current column (we want to move
- ;; towards the left).
- (let ((col (current-column)))
- (when (< col leftcol)
-
- ;; Add the beginning of the line as a tabbing point.
- (unless (memq col (mapcar 'car tablist))
- (push (cons col (point)) tablist))
-
- ;; Look at the line to figure out if it is a bulleted or enumerate
- ;; list item.
- (when (looking-at
- (concat
- "\\(?:"
- "\\(\\(?:[0-9a-zA-Z#]\\{1,3\\}[.):-]\\|[*+-]\\)[ \t]+\\)[^ \t\n]"
- "\\|"
- (format "\\(%s%s+[ \t]+\\)[^ \t\n]"
- (regexp-quote (thing-at-point 'char))
- (regexp-quote (thing-at-point 'char)))
- "\\)"
- ))
- ;; Add the column of the contained item.
- (let* ((matchlen (length (or (match-string 1) (match-string 2))))
- (newcol (+ col matchlen)))
- (unless (or (>= newcol leftcol)
- (memq (+ col matchlen) (mapcar 'car tablist)))
- (push (cons (+ col matchlen) (+ (point) matchlen))
- tablist)))
- )
-
- (setq leftcol col)
- )))
-
- ;; Move backwards one line.
- (beginning-of-line 0))
-
- (sort tablist (lambda (x y) (<= (car x) (car y))))
- )))
-
-(defun rst-debug-print-tabs (tablist)
- "Insert a line and place special characters at the tab points in TABLIST."
- (beginning-of-line)
- (insert (concat "\n" (make-string 1000 ? ) "\n"))
- (beginning-of-line 0)
- (dolist (col tablist)
- (beginning-of-line)
- (forward-char (car col))
- (delete-char 1)
- (insert "@")
- ))
-
-(defun rst-debug-mark-found (tablist)
- "Insert a line and place special characters at the tab points in TABLIST."
- (dolist (col tablist)
- (when (cdr col)
- (goto-char (cdr col))
- (insert "@"))))
-
-
-(defvar rst-shift-basic-offset 2
- "Basic horizontal shift distance when there is no preceding alignment tabs.")
-
-(defun rst-shift-region-guts (find-next-fun offset-fun)
- "(See `rst-shift-region-right' for a description)."
- (let* ((mbeg (copy-marker (region-beginning)))
- (mend (copy-marker (region-end)))
- (tabs (rst-compute-bullet-tabs mbeg))
- (leftmostcol (rst-find-leftmost-column (region-beginning) (region-end)))
- )
- ;; Add basic offset tabs at the end of the list. This is a better
- ;; implementation technique than hysteresis and a basic offset because it
- ;; insures that movement in both directions is consistently using the same
- ;; column positions. This makes it more predictable.
- (setq tabs
- (append tabs
- (mapcar (lambda (x) (cons x nil))
- (let ((maxcol 120)
- (max-lisp-eval-depth 2000))
- (flet ((addnum (x)
- (if (> x maxcol)
- nil
- (cons x (addnum
- (+ x rst-shift-basic-offset))))))
- (addnum (or (caar (last tabs)) 0))))
- )))
-
- ;; (For debugging.)
- ;;; (save-excursion (goto-char mbeg) (forward-char -1) (rst-debug-print-tabs tabs))))
- ;;; (print tabs)
- ;;; (save-excursion (rst-debug-mark-found tabs))
-
- ;; Apply the indent.
- (indent-rigidly
- mbeg mend
-
- ;; Find the next tab after the leftmost column.
- (let ((tab (funcall find-next-fun tabs leftmostcol)))
-
- (if tab
- (progn
- (when (cdar tab)
- (message "Aligned on '%s'"
- (save-excursion
- (goto-char (cdar tab))
- (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position))))
- )
- (- (caar tab) leftmostcol)) ;; Num chars.
-
- ;; Otherwise use the basic offset
- (funcall offset-fun rst-shift-basic-offset)
- )))
-
- ;; Optionally reindent.
- (when rst-shift-fill-region
- (fill-region mbeg mend))
- ))
-
-(defun rst-shift-region-right (pfxarg)
- "Indent region ridigly, by a few characters to the right.
-This function first computes all possible alignment columns by
-inspecting the lines preceding the region for bulleted or
-enumerated list items. If the leftmost column is beyond the
-preceding lines, the region is moved to the right by
-`rst-shift-basic-offset'. With a prefix argument, do not
-automatically fill the region."
- (interactive "P")
- (let ((rst-shift-fill-region
- (if (not pfxarg) rst-shift-fill-region)))
- (rst-shift-region-guts (lambda (tabs leftmostcol)
- (let ((cur tabs))
- (while (and cur (<= (caar cur) leftmostcol))
- (setq cur (cdr cur)))
- cur))
- 'identity
- )))
-
-(defun rst-shift-region-left (pfxarg)
- "Like `rst-shift-region-right', except we move to the left.
-Also, if invoked with a negative prefix arg, the entire
-indentation is removed, up to the leftmost character in the
-region, and automatic filling is disabled."
- (interactive "P")
- (let ((mbeg (copy-marker (region-beginning)))
- (mend (copy-marker (region-end)))
- (leftmostcol (rst-find-leftmost-column
- (region-beginning) (region-end)))
- (rst-shift-fill-region
- (if (not pfxarg) rst-shift-fill-region)))
-
- (when (> leftmostcol 0)
- (if (and pfxarg (< (prefix-numeric-value pfxarg) 0))
- (progn
- (indent-rigidly (region-beginning) (region-end) (- leftmostcol))
- (when rst-shift-fill-region
- (fill-region mbeg mend))
- )
- (rst-shift-region-guts (lambda (tabs leftmostcol)
- (let ((cur (reverse tabs)))
- (while (and cur (>= (caar cur) leftmostcol))
- (setq cur (cdr cur)))
- cur))
- '-
- ))
- )))
-
+;; FIXME: This definition is old and deprecated. We need to move to the newer
+;; version below.
(defmacro rst-iterate-leftmost-paragraphs
(beg end first-only body-consequent body-alternative)
- "FIXME This definition is old and deprecated / we need to move
-to the newer version below:
-
-Call FUN at the beginning of each line, with an argument that
+ ;; FIXME: The following comment is pretty useless.
+ "Call FUN at the beginning of each line, with an argument that
specifies whether we are at the first line of a paragraph that
starts at the leftmost column of the given region BEG and END.
Set FIRST-ONLY to true if you want to callback on the first line
@@ -2409,7 +2759,7 @@ of each paragraph only."
(let ((leftcol (rst-find-leftmost-column ,beg ,end))
(endm (copy-marker ,end)))
- (do* (;; Iterate lines
+ (do* (;; Iterate lines.
(l (progn (goto-char ,beg) (back-to-indentation))
(progn (forward-line 1) (back-to-indentation)))
@@ -2419,21 +2769,19 @@ of each paragraph only."
(current-column))
(valid (and (= curcol leftcol)
- (not (looking-at "[ \t]*$")))
+ (not (looking-at (rst-re 'lin-end))))
(and (= curcol leftcol)
- (not (looking-at "[ \t]*$"))))
- )
+ (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.
(defmacro rst-iterate-leftmost-paragraphs-2 (spec &rest body)
"Evaluate BODY for each line in region defined by BEG END.
LEFTMOST is set to true if the line is one of the leftmost of the
@@ -2447,14 +2795,14 @@ first of a paragraph."
(let ((,leftmost (rst-find-leftmost-column ,beg ,end))
(endm (copy-marker ,end)))
- (do* (;; Iterate lines
+ (do* (;; Iterate lines.
(l (progn (goto-char ,beg) (back-to-indentation))
(progn (forward-line 1) (back-to-indentation)))
(empty-line-previous nil ,isempty)
- (,isempty (looking-at "[ \t]*$")
- (looking-at "[ \t]*$"))
+ (,isempty (looking-at (rst-re 'lin-end))
+ (looking-at (rst-re 'lin-end)))
(,parabegin (not ,isempty)
(and empty-line-previous
@@ -2463,86 +2811,381 @@ 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
+;; FIXME: At the moment only block comments with leading empty comment line are
+;; supported. Comment lines with leading comment markup should be also
+;; supported. May be a customizable option could control which style to
+;; prefer.
+
+(defgroup rst-indent nil "Settings for indentation in reStructuredText.
+
+In reStructuredText indentation points are usually determined by
+preceding lines. Sometimes the syntax allows arbitrary
+indentation points such as where to start the first line
+following a directive. These indentation widths can be customized
+here."
+ :group 'rst
+ :package-version '(rst . "1.1.0"))
+
+(define-obsolete-variable-alias
+ '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
+;; * Definition lists
+;; * Option lists
+(defun rst-line-tabs ()
+ "Return tabs of the current line or nil for no tab.
+The list is sorted so the tab where writing continues most likely
+is the first one. Each tab is of the form (COLUMN . INNER).
+COLUMN is the column of the tab. INNER is non-nil if this is an
+inner tab. I.e. a tab which does come from the basic indentation
+and not from inner alignment points."
+ (save-excursion
+ (forward-line 0)
+ (save-match-data
+ (unless (looking-at (rst-re 'lin-end))
+ (back-to-indentation)
+ ;; Current indentation is always the least likely tab.
+ (let ((tabs (list (list (point) 0 nil)))) ; (POINT OFFSET INNER)
+ ;; Push inner tabs more likely to continue writing.
+ (cond
+ ;; Item.
+ ((looking-at (rst-re '(:grp itmany-tag hws-sta) '(:grp "\\S ") "?"))
+ (when (match-string 2)
+ (push (list (match-beginning 2) 0 t) tabs)))
+ ;; Field.
+ ((looking-at (rst-re '(:grp fld-tag) '(:grp hws-tag)
+ '(:grp "\\S ") "?"))
+ (unless (zerop rst-indent-field)
+ (push (list (match-beginning 1) rst-indent-field t) tabs))
+ (if (match-string 3)
+ (push (list (match-beginning 3) 0 t) tabs)
+ (if (zerop rst-indent-field)
+ (push (list (match-end 2)
+ (if (string= (match-string 2) "") 1 0)
+ t) tabs))))
+ ;; Directive.
+ ((looking-at (rst-re 'dir-sta-3 '(:grp "\\S ") "?"))
+ (push (list (match-end 1) 0 t) tabs)
+ (unless (string= (match-string 2) "")
+ (push (list (match-end 2) 0 t) tabs))
+ (when (match-string 4)
+ (push (list (match-beginning 4) 0 t) tabs)))
+ ;; Footnote or citation definition.
+ ((looking-at (rst-re 'fnc-sta-2 '(:grp "\\S ") "?"))
+ (push (list (match-end 1) 0 t) tabs)
+ (when (match-string 3)
+ (push (list (match-beginning 3) 0 t) tabs)))
+ ;; Comment.
+ ((looking-at (rst-re 'cmt-sta-1))
+ (push (list (point) rst-indent-comment t) tabs)))
+ ;; Start of literal block.
+ (when (looking-at (rst-re 'lit-sta-2))
+ (let ((tab0 (first tabs)))
+ (push (list (first tab0)
+ (+ (second tab0)
+ (if (match-string 1)
+ rst-indent-literal-minimized
+ rst-indent-literal-normal))
+ t) tabs)))
+ (mapcar (lambda (tab)
+ (goto-char (first tab))
+ (cons (+ (current-column) (second tab)) (third tab)))
+ tabs))))))
+
+(defun rst-compute-tabs (pt)
+ "Build the list of possible tabs for all lines above.
+Search backwards from point PT to build the list of possible
+tabs. Return a list of tabs sorted by likeliness to continue
+writing like `rst-line-tabs'. Nearer lines have generally a
+higher likeliness than farther lines. Return nil if no tab is found
+in the text above."
+ (save-excursion
+ (goto-char pt)
+ (let (leftmost ; Leftmost column found so far.
+ innermost ; Leftmost column for inner tab.
+ tablist)
+ (while (and (zerop (forward-line -1))
+ (or (not leftmost)
+ (> leftmost 0)))
+ (let* ((tabs (rst-line-tabs))
+ (leftcol (if tabs (apply 'min (mapcar 'car tabs)))))
+ (when tabs
+ ;; Consider only lines indented less or same if not INNERMOST.
+ (when (or (not leftmost)
+ (< leftcol leftmost)
+ (and (not innermost) (= leftcol leftmost)))
+ (dolist (tab tabs)
+ (let ((inner (cdr tab))
+ (newcol (car tab)))
+ (when (and
+ (or
+ (and (not inner)
+ (or (not leftmost)
+ (< newcol leftmost)))
+ (and inner
+ (or (not innermost)
+ (< newcol innermost))))
+ (not (memq newcol tablist)))
+ (push newcol tablist))))
+ (setq innermost (if (rst-some (mapcar 'cdr tabs)) ; Has inner.
+ leftcol
+ innermost))
+ (setq leftmost leftcol)))))
+ (nreverse tablist))))
+
+(defun rst-indent-line (&optional dflt)
+ "Indent current line to next best reStructuredText tab.
+The next best tab is taken from the tab list returned by
+`rst-compute-tabs' which is used in a cyclic manner. If the
+current indentation does not end on a tab use the first one. If
+the current indentation is on a tab use the next tab. This allows
+a repeated use of \\[indent-for-tab-command] to cycle through all
+possible tabs. If no indentation is possible return `noindent' or
+use DFLT. Return the indentation indented to. When point is in
+indentation it ends up at its end. Otherwise the point is kept
+relative to the content."
+ (let* ((pt (point-marker))
+ (cur (current-indentation))
+ (clm (current-column))
+ (tabs (rst-compute-tabs (point)))
+ (fnd (rst-position cur tabs))
+ ind)
+ (if (and (not tabs) (not dflt))
+ 'noindent
+ (if (not tabs)
+ (setq ind dflt)
+ (if (not fnd)
+ (setq fnd 0)
+ (setq fnd (1+ fnd))
+ (if (>= fnd (length tabs))
+ (setq fnd 0)))
+ (setq ind (nth fnd tabs)))
+ (indent-line-to ind)
+ (if (> clm cur)
+ (goto-char pt))
+ (set-marker pt nil)
+ ind)))
+
+(defun rst-shift-region (beg end cnt)
+ "Shift region BEG to END by CNT tabs.
+Shift by one tab to the right (CNT > 0) or left (CNT < 0) or
+remove all indentation (CNT = 0). A tab is taken from the text
+above. If no suitable tab is found `rst-indent-width' is used."
+ (interactive "r\np")
+ (let ((tabs (sort (rst-compute-tabs beg) (lambda (x y) (<= x y))))
+ (leftmostcol (rst-find-leftmost-column beg end)))
+ (when (or (> leftmostcol 0) (> cnt 0))
+ ;; Apply the indent.
+ (indent-rigidly
+ beg end
+ (if (zerop cnt)
+ (- leftmostcol)
+ ;; Find the next tab after the leftmost column.
+ (let* ((cmp (if (> cnt 0) '> '<))
+ (tabs (if (> cnt 0) tabs (reverse tabs)))
+ (len (length tabs))
+ (dir (rst-signum cnt)) ; Direction to take.
+ (abs (abs cnt)) ; Absolute number of steps to take.
+ ;; Get the position of the first tab beyond leftmostcol.
+ (fnd (lexical-let ((cmp cmp)
+ (leftmostcol leftmostcol)) ; Create closure.
+ (rst-position-if (lambda (elt)
+ (funcall cmp elt leftmostcol))
+ tabs)))
+ ;; Virtual position of tab.
+ (pos (+ (or fnd len) (1- abs)))
+ (tab (if (< pos len)
+ ;; Tab exists - use it.
+ (nth pos tabs)
+ ;; Column needs to be computed.
+ (let ((col (+ (or (car (last tabs)) leftmostcol)
+ ;; Base on last known column.
+ (* (- pos (1- len)) ; Distance left.
+ dir ; Direction to take.
+ rst-indent-width))))
+ (if (< col 0) 0 col)))))
+ (- tab leftmostcol)))))))
+
+;; FIXME: A paragraph with an (incorrectly) indented second line is not filled
+;; correctly::
+;;
+;; Some start
+;; continued wrong
+(defun rst-adaptive-fill ()
+ "Return fill prefix found at point.
+Value for `adaptive-fill-function'."
+ (let ((fnd (if (looking-at adaptive-fill-regexp)
+ (match-string-no-properties 0))))
+ (if (save-match-data
+ (not (string-match comment-start-skip fnd)))
+ ;; An non-comment prefix is fine.
+ fnd
+ ;; Matches a comment - return whitespace instead.
+ (make-string (-
+ (save-excursion
+ (goto-char (match-end 0))
+ (current-column))
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (current-column))) ? ))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Comments
+
+(defun rst-comment-line-break (&optional soft)
+ "Break line and indent, continuing reStructuredText comment if within one.
+Value for `comment-line-break-function'. If SOFT use soft
+newlines as mandated by `comment-line-break-function'."
+ (if soft
+ (insert-and-inherit ?\n)
+ (newline 1))
+ (save-excursion
+ (forward-char -1)
+ (delete-horizontal-space))
+ (delete-horizontal-space)
+ (let ((tabs (rst-compute-tabs (point))))
+ (when tabs
+ (indent-line-to (car tabs)))))
+
+(defun rst-comment-indent ()
+ "Return indentation for current comment line."
+ (car (rst-compute-tabs (point))))
+
+(defun rst-comment-insert-comment ()
+ "Insert a comment in the current line."
+ (rst-indent-line 0)
+ (insert comment-start))
+
+(defun rst-comment-region (beg end &optional arg)
+ "Comment or uncomment the current region.
+Region is from from BEG to END. Uncomment if ARG."
+ (save-excursion
+ (if (consp arg)
+ (rst-uncomment-region beg end arg)
+ (goto-char beg)
+ (let ((ind (current-indentation))
+ bol)
+ (forward-line 0)
+ (setq bol (point))
+ (indent-rigidly bol end rst-indent-comment)
+ (goto-char bol)
+ (open-line 1)
+ (indent-line-to ind)
+ (insert (comment-string-strip comment-start t t))))))
+
+(defun rst-uncomment-region (beg end &optional arg)
+ "Uncomment the current region.
+Region is from BEG to END. ARG is ignored"
+ (save-excursion
+ (let (bol eol)
+ (goto-char beg)
+ (forward-line 0)
+ (setq bol (point))
+ (forward-line 1)
+ (setq eol (point))
+ (indent-rigidly eol end (- rst-indent-comment))
+ (delete-region bol eol))))
;;------------------------------------------------------------------------------
-;; FIXME: these next functions should become part of a larger effort to redo the
-;; bullets in bulleted lists. The enumerate would just be one of the possible
-;; outputs.
+;; FIXME: These next functions should become part of a larger effort to redo
+;; the bullets in bulleted lists. The enumerate would just be one of
+;; the possible outputs.
;;
-;; FIXME: TODO we need to do the enumeration removal as well.
+;; FIXME: We need to do the enumeration removal as well.
-(defun rst-enumerate-region (beg end)
+(defun rst-enumerate-region (beg end all)
"Add enumeration to all the leftmost paragraphs in the given region.
-The region is specified between BEG and END. With prefix argument,
+The region is specified between BEG and END. With ALL,
do all lines instead of just paragraphs."
- (interactive "r")
+ (interactive "r\nP")
(let ((count 0)
(last-insert-len nil))
(rst-iterate-leftmost-paragraphs
- beg end (not current-prefix-arg)
+ beg end (not all)
(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)
+(defun rst-bullet-list-region (beg end all)
"Add bullets to all the leftmost paragraphs in the given region.
-The region is specified between BEG and END. With prefix argument,
+The region is specified between BEG and END. With ALL,
do all lines instead of just paragraphs."
- (interactive "r")
+ (interactive "r\nP")
(rst-iterate-leftmost-paragraphs
- beg end (not current-prefix-arg)
- (insert "- ")
- (insert " ")
- ))
-
-
-;; FIXME: there are some problems left with the following function
-;; implementation:
-;;
-;; * It does not deal with a varying number of digits appropriately
-;; * It does not deal with multiple levels independently, and it should.
-;;
-;; I suppose it does 90% of the job for now.
+ beg end (not all)
+ (insert (car rst-preferred-bullets) " ")
+ (insert " ")))
+;; FIXME: Does not deal with a varying number of digits appropriately.
+;; FIXME: Does not deal with multiple levels independently.
+;; FIXME: Does not indent a multiline item correctly.
(defun rst-convert-bullets-to-enumeration (beg end)
- "Convert all the bulleted items and enumerated items in the
-region to enumerated lists, renumbering as necessary."
+ "Convert the bulleted and enumerated items in the region to enumerated lists.
+Renumber as necessary. Region is from BEG to END."
(interactive "r")
(let* (;; Find items and convert the positions to markers.
(items (mapcar
(lambda (x)
(cons (copy-marker (car x))
(cdr x)))
- (rst-find-pfx-in-region beg end rst-re-items)))
- (count 1)
- )
+ (rst-find-pfx-in-region beg end (rst-re 'itmany-sta-1))))
+ (count 1))
(save-excursion
(dolist (x items)
(goto-char (car x))
- (looking-at rst-re-items)
- (replace-match (format "%d. " count) nil nil nil 1)
- (incf count)
- ))
- ))
-
-
+ (looking-at (rst-re 'itmany-beg-1))
+ (replace-match (format "%d." count) nil nil nil 1)
+ (incf count)))))
;;------------------------------------------------------------------------------
(defun rst-line-block-region (rbeg rend &optional pfxarg)
"Toggle line block prefixes for a region.
-With prefix argument set the empty lines too."
+Region is from RBEG to REND. With PFXARG set the empty lines too."
(interactive "r\nP")
(let ((comment-start "| ")
(comment-end "")
@@ -2559,9 +3202,16 @@ With prefix argument set the empty lines too."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Font lock
+;; =========
(require 'font-lock)
+;; FIXME: The obsolete variables need to disappear.
+
+;; The following versions have been done inside Emacs and should not be
+;; replaced by `:package-version' attributes until a change.
+
(defgroup rst-faces nil "Faces used in Rst Mode."
:group 'rst
:group 'faces
@@ -2577,6 +3227,7 @@ With prefix argument 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")
@@ -2591,6 +3242,7 @@ With prefix argument 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")
@@ -2605,6 +3257,7 @@ With prefix argument 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")
@@ -2621,6 +3274,7 @@ With prefix argument 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")
@@ -2635,6 +3289,7 @@ With prefix argument 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")
@@ -2649,6 +3304,7 @@ With prefix argument 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")
@@ -2662,6 +3318,7 @@ With prefix argument 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")
@@ -2676,6 +3333,7 @@ With prefix argument 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")
@@ -2690,328 +3348,370 @@ With prefix argument 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")
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defface rst-transition '((t :inherit font-lock-keyword-face))
+ "Face used for a transition."
+ :package-version '(rst . "1.3.0")
+ :group 'rst-faces)
-(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")
+(defface rst-adornment '((t :inherit font-lock-keyword-face))
+ "Face used for the adornment of a section header."
+ :package-version '(rst . "1.3.0")
+ :group 'rst-faces)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun rst-set-level-default (sym val)
- "Set custom var SYM affecting section title text face and recompute the faces."
- (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) 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)
-(defcustom rst-level-face-base-color "grey"
- "The base name of the color to be used for creating background colors in
-section title faces for all levels."
- :group 'rst-faces-defaults
- :type '(string)
- :set 'rst-set-level-default)
-(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)
-(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
- (let ((alist '((t . font-lock-keyword-face)
- (nil . font-lock-keyword-face)))
- (i 1))
- (while (<= i rst-level-face-max)
- (nconc alist (list (cons i (intern (format "rst-level-%d-face" i)))))
- (setq i (1+ i)))
- alist)
- "Faces for the various adornment types.
-Key is a number (for the section title text of that level),
-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."
+ '((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 need levels beyond 6 you have to define faces
+of your own."
:group 'rst-faces
:type '(alist
:key-type
(choice
- (integer
- :tag
- "Section level (may not be bigger than `rst-level-face-max')")
- (boolean :tag "transitions (on) / section title adornment (off)"))
- :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 "Face for showing section title text at level %d" 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))))
- (unless (facep sym)
- (make-empty-face sym)
- (set-face-doc-string sym doc)
- (set-face-background sym col)
- (set sym sym))
- (setq i (1+ i))))))
-
-(rst-define-level-faces)
+ (integer :tag "Section level")
+ (const :tag "transitions" t)
+ (const :tag "section title adornment" nil))
+ :value-type (face)))
+(rst-testcover-defcustom)
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Font lock
-(defvar rst-use-char-classes
- (string-match "[[:alpha:]]" "b")
- "Non-nil if we can use the character classes in our regexps.")
-
-(defun rst-font-lock-keywords-function ()
- "Return keywords to highlight in Rst mode according to current settings."
+(defvar rst-font-lock-keywords
;; The reST-links in the comments below all relate to sections in
- ;; http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html
- (let* ( ;; This gets big - so let's define some abbreviations
- ;; horizontal white space
- (re-hws "[\t ]")
- ;; beginning of line with possible indentation
- (re-bol (concat "^" re-hws "*"))
- ;; Separates block lead-ins from their content
- (re-blksep1 (concat "\\(" re-hws "+\\|$\\)"))
- ;; explicit markup tag
- (re-emt "\\.\\.")
- ;; explicit markup start
- (re-ems (concat re-emt re-hws "+"))
- ;; inline markup prefix
- (re-imp1 (concat "\\(^\\|" re-hws "\\|[-'\"([{</:]\\)"))
- ;; inline markup suffix
- (re-ims1 (concat "\\(" re-hws "\\|[]-'\")}>/:.,;!?\\]\\|$\\)"))
- ;; symbol character
- (re-sym1 "\\(\\sw\\|\\s_\\)")
- ;; inline markup content begin
- (re-imbeg2 "\\(\\S \\|\\S \\([^")
-
- ;; There seems to be a bug leading to error "Stack overflow in regexp
- ;; matcher" when "|" or "\\*" are the characters searched for
- (re-imendbeg "\\]\\|\\\\.")
- ;; inline markup content end
- (re-imend (concat re-imendbeg "\\)*[^\t \\\\]\\)"))
- ;; inline markup content without asterisk
- (re-ima2 (concat re-imbeg2 "*" re-imend))
- ;; inline markup content without backquote
- (re-imb2 (concat re-imbeg2 "`" re-imend))
- ;; inline markup content without vertical bar
- (re-imv2 (concat re-imbeg2 "|" re-imend))
- ;; Supported URI schemes
- (re-uris1 "\\(acap\\|cid\\|data\\|dav\\|fax\\|file\\|ftp\\|gopher\\|http\\|https\\|imap\\|ldap\\|mailto\\|mid\\|modem\\|news\\|nfs\\|nntp\\|pop\\|prospero\\|rtsp\\|service\\|sip\\|tel\\|telnet\\|tip\\|urn\\|vemmi\\|wais\\)")
- ;; Line starting with adornment and optional whitespace; complete
- ;; adornment is in (match-string 1); there must be at least 3
- ;; characters because otherwise explicit markup start would be
- ;; recognized
- (re-ado2 (concat "^\\(\\(["
- (if rst-use-char-classes
- "^[:word:][:space:][:cntrl:]" "^\\w \t\x00-\x1F")
- "]\\)\\2\\2+\\)" re-hws "*$"))
- )
- (list
- ;; FIXME: Block markup is not recognized in blocks after explicit markup
- ;; start
-
- ;; Simple `Body Elements`_
- ;; `Bullet Lists`_
- `(,(concat re-bol "\\([-*+]" re-blksep1 "\\)")
- 1 rst-block-face)
- ;; `Enumerated Lists`_
- `(,(concat re-bol "\\((?\\(#\\|[0-9]+\\|[A-Za-z]\\|[IVXLCMivxlcm]+\\)[.)]"
- re-blksep1 "\\)")
- 1 rst-block-face)
- ;; `Definition Lists`_ FIXME: missing
- ;; `Field Lists`_
- `(,(concat re-bol "\\(:[^:\n]+:\\)" re-blksep1)
- 1 rst-external-face)
- ;; `Option Lists`_
- `(,(concat re-bol "\\(\\(\\(\\([-+/]\\|--\\)\\sw\\(-\\|\\sw\\)*"
- "\\([ =]\\S +\\)?\\)\\(,[\t ]\\)?\\)+\\)\\($\\|[\t ]\\{2\\}\\)")
- 1 rst-block-face)
-
- ;; `Tables`_ FIXME: missing
-
- ;; All the `Explicit Markup Blocks`_
- ;; `Footnotes`_ / `Citations`_
- `(,(concat re-bol "\\(" re-ems "\\[[^[\n]+\\]\\)" re-blksep1)
- 1 rst-definition-face)
- ;; `Directives`_ / `Substitution Definitions`_
- `(,(concat re-bol "\\(" re-ems "\\)\\(\\(|[^|\n]+|[\t ]+\\)?\\)\\("
- re-sym1 "+::\\)" re-blksep1)
- (1 rst-directive-face)
- (2 rst-definition-face)
- (4 rst-directive-face))
- ;; `Hyperlink Targets`_
- `(,(concat re-bol "\\(" re-ems "_\\([^:\\`\n]\\|\\\\.\\|`[^`\n]+`\\)+:\\)"
- re-blksep1)
- 1 rst-definition-face)
- `(,(concat re-bol "\\(__\\)" re-blksep1)
- 1 rst-definition-face)
-
- ;; All `Inline Markup`_
- ;; FIXME: Condition 5 preventing fontification of e.g. "*" not implemented
- ;; `Strong Emphasis`_
- `(,(concat re-imp1 "\\(\\*\\*" re-ima2 "\\*\\*\\)" re-ims1)
- 2 rst-emphasis2-face)
- ;; `Emphasis`_
- `(,(concat re-imp1 "\\(\\*" re-ima2 "\\*\\)" re-ims1)
- 2 rst-emphasis1-face)
- ;; `Inline Literals`_
- `(,(concat re-imp1 "\\(``" re-imb2 "``\\)" re-ims1)
- 2 rst-literal-face)
- ;; `Inline Internal Targets`_
- `(,(concat re-imp1 "\\(_`" re-imb2 "`\\)" re-ims1)
- 2 rst-definition-face)
- ;; `Hyperlink References`_
- ;; FIXME: `Embedded URIs`_ not considered
- `(,(concat re-imp1 "\\(\\(`" re-imb2 "`\\|\\(\\sw\\(\\sw\\|-\\)+\\sw\\)\\)__?\\)" re-ims1)
- 2 rst-reference-face)
- ;; `Interpreted Text`_
- `(,(concat re-imp1 "\\(\\(:" re-sym1 "+:\\)?\\)\\(`" re-imb2 "`\\)\\(\\(:"
- re-sym1 "+:\\)?\\)" re-ims1)
- (2 rst-directive-face)
- (5 rst-external-face)
- (8 rst-directive-face))
- ;; `Footnote References`_ / `Citation References`_
- `(,(concat re-imp1 "\\(\\[[^]]+\\]_\\)" re-ims1)
- 2 rst-reference-face)
- ;; `Substitution References`_
- `(,(concat re-imp1 "\\(|" re-imv2 "|\\)" re-ims1)
- 2 rst-reference-face)
- ;; `Standalone Hyperlinks`_
- `(;; FIXME: This takes it easy by using a whitespace as delimiter
- ,(concat re-imp1 "\\(" re-uris1 ":\\S +\\)" re-ims1)
- 2 rst-definition-face)
- `(,(concat re-imp1 "\\(" re-sym1 "+@" re-sym1 "+\\)" re-ims1)
- 2 rst-definition-face)
-
- ;; Do all block fontification as late as possible so 'append works
-
- ;; Sections_ / Transitions_
- (append
- (list
- re-ado2)
- (if (not rst-mode-lazy)
- '(1 rst-block-face)
- (list
- (list 'rst-font-lock-handle-adornment
- '(progn
- (setq rst-font-lock-adornment-point (match-end 1))
- (point-max))
- nil
- (list 1 '(cdr (assoc nil rst-adornment-faces-alist))
- 'append t)
- (list 2 '(cdr (assoc rst-font-lock-level
- rst-adornment-faces-alist))
- 'append t)
- (list 3 '(cdr (assoc nil rst-adornment-faces-alist))
- 'append t)))))
-
- ;; `Comments`_
- (append
- (list
- (concat re-bol "\\(" re-ems "\\)\[^[|_]\\([^:\n]\\|:\\([^:\n]\\|$\\)\\)*$")
-
- '(1 rst-comment-face))
- (if rst-mode-lazy
- (list
- (list 'rst-font-lock-find-unindented-line
- '(progn
- (setq rst-font-lock-indentation-point (match-end 1))
- (point-max))
- nil
- '(0 rst-comment-face append)))))
- (append
- (list
- (concat re-bol "\\(" re-emt "\\)\\(\\s *\\)$")
- '(1 rst-comment-face)
- '(2 rst-comment-face))
- (if rst-mode-lazy
- (list
- (list 'rst-font-lock-find-unindented-line
- '(progn
- (setq rst-font-lock-indentation-point 'next)
- (point-max))
- nil
- '(0 rst-comment-face append)))))
-
- ;; `Literal Blocks`_
- (append
- (list
- (concat re-bol "\\(\\([^.\n]\\|\\.[^.\n]\\).*\\)?\\(::\\)$")
- '(3 rst-block-face))
- (if rst-mode-lazy
- (list
- (list 'rst-font-lock-find-unindented-line
- '(progn
- (setq rst-font-lock-indentation-point t)
- (point-max))
- nil
- '(0 rst-literal-face append)))))
+ ;; http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html.
+ `(;; FIXME: Block markup is not recognized in blocks after explicit markup
+ ;; start.
+
+ ;; Simple `Body Elements`_
+ ;; `Bullet Lists`_
+ ;; FIXME: A bullet directly after a field name is not recognized.
+ (,(rst-re 'lin-beg '(:grp bul-sta))
+ 1 rst-block-face)
+ ;; `Enumerated Lists`_
+ (,(rst-re 'lin-beg '(:grp enmany-sta))
+ 1 rst-block-face)
+ ;; `Definition Lists`_
+ ;; FIXME: missing.
+ ;; `Field Lists`_
+ (,(rst-re 'lin-beg '(:grp fld-tag) 'bli-sfx)
+ 1 rst-external-face)
+ ;; `Option Lists`_
+ (,(rst-re 'lin-beg '(:grp opt-tag (:shy optsep-tag opt-tag) "*")
+ '(:alt "$" (:seq hws-prt "\\{2\\}")))
+ 1 rst-block-face)
+ ;; `Line Blocks`_
+ ;; Only for lines containing no more bar - to distinguish from tables.
+ (,(rst-re 'lin-beg '(:grp "|" bli-sfx) "[^|\n]*$")
+ 1 rst-block-face)
+
+ ;; `Tables`_
+ ;; FIXME: missing
+
+ ;; All the `Explicit Markup Blocks`_
+ ;; `Footnotes`_ / `Citations`_
+ (,(rst-re 'lin-beg 'fnc-sta-2)
+ (1 rst-definition-face)
+ (2 rst-definition-face))
+ ;; `Directives`_ / `Substitution Definitions`_
+ (,(rst-re 'lin-beg 'dir-sta-3)
+ (1 rst-directive-face)
+ (2 rst-definition-face)
+ (3 rst-directive-face))
+ ;; `Hyperlink Targets`_
+ (,(rst-re 'lin-beg
+ '(:grp exm-sta "_" (:alt
+ (:seq "`" ilcbkqdef-tag "`")
+ (:seq (:alt "[^:\\\n]" "\\\\.") "+")) ":")
+ 'bli-sfx)
+ 1 rst-definition-face)
+ (,(rst-re 'lin-beg '(:grp "__") 'bli-sfx)
+ 1 rst-definition-face)
+
+ ;; All `Inline Markup`_
+ ;; Most of them may be multiline though this is uninteresting.
+
+ ;; FIXME: Condition 5 preventing fontification of e.g. "*" not implemented
+ ;; `Strong Emphasis`_.
+ (,(rst-re 'ilm-pfx '(:grp "\\*\\*" ilcast-tag "\\*\\*") 'ilm-sfx)
+ 1 rst-emphasis2-face)
+ ;; `Emphasis`_
+ (,(rst-re 'ilm-pfx '(:grp "\\*" ilcast-tag "\\*") 'ilm-sfx)
+ 1 rst-emphasis1-face)
+ ;; `Inline Literals`_
+ (,(rst-re 'ilm-pfx '(:grp "``" ilcbkq-tag "``") 'ilm-sfx)
+ 1 rst-literal-face)
+ ;; `Inline Internal Targets`_
+ (,(rst-re 'ilm-pfx '(:grp "_`" ilcbkq-tag "`") 'ilm-sfx)
+ 1 rst-definition-face)
+ ;; `Hyperlink References`_
+ ;; FIXME: `Embedded URIs`_ not considered.
+ ;; FIXME: Directly adjacent marked up words are not fontified correctly
+ ;; unless they are not separated by two spaces: foo_ bar_.
+ (,(rst-re 'ilm-pfx '(:grp (:alt (:seq "`" ilcbkq-tag "`")
+ (:seq "\\sw" (:alt "\\sw" "-") "+\\sw"))
+ "__?") 'ilm-sfx)
+ 1 rst-reference-face)
+ ;; `Interpreted Text`_
+ (,(rst-re 'ilm-pfx '(:grp (:shy ":" sym-tag ":") "?")
+ '(:grp "`" ilcbkq-tag "`")
+ '(:grp (:shy ":" sym-tag ":") "?") 'ilm-sfx)
+ (1 rst-directive-face)
+ (2 rst-external-face)
+ (3 rst-directive-face))
+ ;; `Footnote References`_ / `Citation References`_
+ (,(rst-re 'ilm-pfx '(:grp fnc-tag "_") 'ilm-sfx)
+ 1 rst-reference-face)
+ ;; `Substitution References`_
+ ;; FIXME: References substitutions like |this|_ or |this|__ are not
+ ;; fontified correctly.
+ (,(rst-re 'ilm-pfx '(:grp sub-tag) 'ilm-sfx)
+ 1 rst-reference-face)
+ ;; `Standalone Hyperlinks`_
+ ;; FIXME: This takes it easy by using a whitespace as delimiter.
+ (,(rst-re 'ilm-pfx '(:grp uri-tag ":\\S +") 'ilm-sfx)
+ 1 rst-definition-face)
+ (,(rst-re 'ilm-pfx '(:grp sym-tag "@" sym-tag ) 'ilm-sfx)
+ 1 rst-definition-face)
+
+ ;; Do all block fontification as late as possible so 'append works.
+
+ ;; Sections_ / Transitions_
+ ;; For sections this is multiline.
+ (,(rst-re 'ado-beg-2-1)
+ (rst-font-lock-handle-adornment-matcher
+ (rst-font-lock-handle-adornment-pre-match-form
+ (match-string-no-properties 1) (match-end 1))
+ nil
+ (1 (cdr (assoc nil rst-adornment-faces-alist)) append t)
+ (2 (cdr (assoc rst-font-lock-adornment-level
+ rst-adornment-faces-alist)) append t)
+ (3 (cdr (assoc nil rst-adornment-faces-alist)) append t)))
+
+ ;; FIXME: FACESPEC could be used instead of ordinary faces to set
+ ;; properties on comments and literal blocks so they are *not*
+ ;; inline fontified. See (elisp)Search-based Fontification.
+
+ ;; FIXME: And / or use `syntax-propertize` functions as in `octave-mod.el`
+ ;; and other V24 modes. May make `font-lock-extend-region`
+ ;; superfluous.
+
+ ;; `Comments`_
+ ;; This is multiline.
+ (,(rst-re 'lin-beg 'cmt-sta-1)
+ (1 rst-comment-face)
+ (rst-font-lock-find-unindented-line-match
+ (rst-font-lock-find-unindented-line-limit (match-end 1))
+ nil
+ (0 rst-comment-face append)))
+ (,(rst-re 'lin-beg '(:grp exm-tag) '(:grp hws-tag) "$")
+ (1 rst-comment-face)
+ (2 rst-comment-face)
+ (rst-font-lock-find-unindented-line-match
+ (rst-font-lock-find-unindented-line-limit 'next)
+ nil
+ (0 rst-comment-face append)))
+
+ ;; FIXME: This is not rendered as comment::
+ ;; .. .. list-table::
+ ;; :stub-columns: 1
+ ;; :header-rows: 1
+
+ ;; FIXME: This is rendered wrong::
+ ;;
+ ;; xxx yyy::
+ ;;
+ ;; ----|> KKKKK <|----
+ ;; / \
+ ;; -|> AAAAAAAAAAPPPPPP <|- -|> AAAAAAAAAABBBBBBB <|-
+ ;; | | | |
+ ;; | | | |
+ ;; PPPPPP PPPPPPDDDDDDD BBBBBBB PPPPPPBBBBBBB
+ ;;
+ ;; Indentation needs to be taken from the line with the ``::`` and not from
+ ;; the first content line.
- ;; `Doctest Blocks`_
- (append
- (list
- (concat re-bol "\\(>>>\\|\\.\\.\\.\\)\\(.+\\)")
- '(1 rst-block-face)
- '(2 rst-literal-face)))
- )))
+ ;; `Indented Literal Blocks`_
+ ;; This is multiline.
+ (,(rst-re 'lin-beg 'lit-sta-2)
+ (2 rst-block-face)
+ (rst-font-lock-find-unindented-line-match
+ (rst-font-lock-find-unindented-line-limit t)
+ nil
+ (0 rst-literal-face append)))
+ ;; FIXME: `Quoted Literal Blocks`_ missing.
+ ;; This is multiline.
+ ;; `Doctest Blocks`_
+ ;; FIXME: This is wrong according to the specification:
+ ;;
+ ;; Doctest blocks are text blocks which begin with ">>> ", the Python
+ ;; interactive interpreter main prompt, and end with a blank line.
+ ;; Doctest blocks are treated as a special case of literal blocks,
+ ;; without requiring the literal block syntax. If both are present, the
+ ;; literal block syntax takes priority over Doctest block syntax:
+ ;;
+ ;; This is an ordinary paragraph.
+ ;;
+ ;; >>> print 'this is a Doctest block'
+ ;; this is a Doctest block
+ ;;
+ ;; The following is a literal block::
+ ;;
+ ;; >>> This is not recognized as a doctest block by
+ ;; reStructuredText. It *will* be recognized by the doctest
+ ;; module, though!
+ ;;
+ ;; Indentation is not required for doctest blocks.
+ (,(rst-re 'lin-beg '(:grp (:alt ">>>" ell-tag)) '(:grp ".+"))
+ (1 rst-block-face)
+ (2 rst-literal-face)))
+ "Keywords to highlight in rst mode.")
+
+(defvar font-lock-beg)
+(defvar font-lock-end)
+
+(defun rst-font-lock-extend-region ()
+ "Extend the font-lock region if it might be in a multi-line construct.
+Return non-nil if so. Font-lock region is from `font-lock-beg'
+to `font-lock-end'."
+ (let ((r (rst-font-lock-extend-region-internal font-lock-beg font-lock-end)))
+ (when r
+ (setq font-lock-beg (car r))
+ (setq font-lock-end (cdr r))
+ t)))
+
+(defun rst-font-lock-extend-region-internal (beg end)
+ "Check the region BEG / END for being in the middle of a multi-line construct.
+Return nil if not or a cons with new values for BEG / END"
+ (let ((nbeg (rst-font-lock-extend-region-extend beg -1))
+ (nend (rst-font-lock-extend-region-extend end 1)))
+ (if (or nbeg nend)
+ (cons (or nbeg beg) (or nend end)))))
+
+(defun rst-forward-line (&optional n)
+ "Like `forward-line' but always end up in column 0 and return accordingly.
+Move N lines forward just as `forward-line'."
+ (let ((moved (forward-line n)))
+ (if (bolp)
+ moved
+ (forward-line 0)
+ (- moved (rst-signum n)))))
+
+;; FIXME: If a single line is made a section header by `rst-adjust' the header
+;; is not always fontified immediately.
+(defun rst-font-lock-extend-region-extend (pt dir)
+ "Extend the region starting at point PT and extending in direction DIR.
+Return extended point or nil if not moved."
+ ;; There are many potential multiline constructs but there are two groups
+ ;; which are really relevant. The first group consists of
+ ;;
+ ;; * comment lines without leading explicit markup tag and
+ ;;
+ ;; * literal blocks following "::"
+ ;;
+ ;; which are both indented. Thus indentation is the first thing recognized
+ ;; here. The second criteria is an explicit markup tag which may be a comment
+ ;; or a double colon at the end of a line.
+ ;;
+ ;; The second group consists of the adornment cases.
+ (if (not (get-text-property pt 'font-lock-multiline))
+ ;; Move only if we don't start inside a multiline construct already.
+ (save-excursion
+ (let (;; Non-empty non-indented line, explicit markup tag or literal
+ ;; block tag.
+ (stop-re (rst-re '(:alt "[^ \t\n]"
+ (:seq hws-tag exm-tag)
+ (:seq ".*" dcl-tag lin-end)))))
+ ;; The comments below are for dir == -1 / dir == 1.
+ (goto-char pt)
+ (forward-line 0)
+ (setq pt (point))
+ (while (and (not (looking-at stop-re))
+ (zerop (rst-forward-line dir)))) ; try previous / next
+ ; line if it exists.
+ (if (looking-at (rst-re 'ado-beg-2-1)) ; may be an underline /
+ ; overline.
+ (if (zerop (rst-forward-line dir))
+ (if (looking-at (rst-re 'ttl-beg)) ; title found, i.e.
+ ; underline / overline
+ ; found.
+ (if (zerop (rst-forward-line dir))
+ (if (not
+ (looking-at (rst-re 'ado-beg-2-1))) ; no
+ ; overline /
+ ; underline.
+ (rst-forward-line (- dir)))) ; step back to title
+ ; / adornment.
+ (if (< dir 0) ; keep downward adornment.
+ (rst-forward-line (- dir))))) ; step back to adornment.
+ (if (looking-at (rst-re 'ttl-beg)) ; may be a title.
+ (if (zerop (rst-forward-line dir))
+ (if (not
+ (looking-at (rst-re 'ado-beg-2-1))) ; no overline /
+ ; underline.
+ (rst-forward-line (- dir)))))) ; step back to line.
+ (if (not (= (point) pt))
+ (point))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Indented blocks
@@ -3034,198 +3734,164 @@ point is not moved."
(forward-line 1)
(when (< (point) limit)
(setq beg (point))
- (if (looking-at "\\s *$")
- (setq cand (or cand beg)) ; An empty line is a candidate
+ (if (looking-at (rst-re 'lin-end))
+ (setq cand (or cand beg)) ; An empty line is a candidate.
(move-to-column clm)
;; FIXME: No indentation [(zerop clm)] must be handled in some
- ;; useful way - though it is not clear what this should mean at all
+ ;; useful way - though it is not clear what this should mean
+ ;; at all.
(if (string-match
- "^\\s *$" (buffer-substring-no-properties beg (point)))
- (setq cand nil) ; An indented line resets a candidate
+ (rst-re 'linemp-tag)
+ (buffer-substring-no-properties beg (point)))
+ (setq cand nil) ; An indented line resets a candidate.
(setq fnd (or cand beg)))))))
(goto-char (or fnd start))
fnd))
-;; Stores the point where the current indentation ends if a number. If `next'
-;; indicates `rst-font-lock-find-unindented-line' shall take the indentation
-;; from the next line if this is not empty. If non-nil indicates
-;; `rst-font-lock-find-unindented-line' shall take the indentation from the
-;; next non-empty line. Also used as a trigger for
-;; `rst-font-lock-find-unindented-line'.
-(defvar rst-font-lock-indentation-point nil)
-
-(defun rst-font-lock-find-unindented-line (limit)
- (let* ((ind-pnt rst-font-lock-indentation-point)
- (beg-pnt ind-pnt))
- ;; May run only once - enforce this
- (setq rst-font-lock-indentation-point nil)
- (when (and ind-pnt (not (numberp ind-pnt)))
- ;; Find indentation point in next line if any
- (setq ind-pnt
- (save-excursion
- (save-match-data
- (if (eq ind-pnt 'next)
- (when (and (zerop (forward-line 1)) (< (point) limit))
- (setq beg-pnt (point))
- (when (not (looking-at "\\s *$"))
- (looking-at "\\s *")
- (match-end 0)))
- (while (and (zerop (forward-line 1)) (< (point) limit)
- (looking-at "\\s *$")))
- (when (< (point) limit)
- (setq beg-pnt (point))
- (looking-at "\\s *")
- (match-end 0)))))))
- (when ind-pnt
- (goto-char ind-pnt)
- ;; Always succeeds because the limit set by PRE-MATCH-FORM is the
- ;; ultimate point to find
- (goto-char (or (rst-forward-indented-block nil limit) limit))
- (save-excursion
- ;; Include subsequent empty lines in the font-lock block,
- ;; in case the user subsequently changes the indentation of the next
- ;; non-empty line to move it into the indented element.
- (skip-chars-forward " \t\n")
- (put-text-property beg-pnt (point) 'font-lock-multiline t))
- (set-match-data (list beg-pnt (point)))
- t)))
+(defvar rst-font-lock-find-unindented-line-begin nil
+ "Beginning of the match if `rst-font-lock-find-unindented-line-end'.")
+
+(defvar rst-font-lock-find-unindented-line-end nil
+ "End of the match as determined by `rst-font-lock-find-unindented-line-limit'.
+Also used as a trigger for
+`rst-font-lock-find-unindented-line-match'.")
+
+(defun rst-font-lock-find-unindented-line-limit (ind-pnt)
+ "Find the next unindented line relative to indentation at IND-PNT.
+Return this point, the end of the buffer or nil if nothing found.
+If IND-PNT is `next' take the indentation from the next line if
+this is not empty and indented more than the current one. If
+IND-PNT is non-nil but not a number take the indentation from the
+next non-empty line if this is indented more than the current
+one."
+ (setq rst-font-lock-find-unindented-line-begin ind-pnt)
+ (setq rst-font-lock-find-unindented-line-end
+ (save-excursion
+ (when (not (numberp ind-pnt))
+ ;; Find indentation point in next line if any.
+ (setq ind-pnt
+ ;; FIXME: Should be refactored to two different functions
+ ;; giving their result to this function, may be
+ ;; integrated in caller.
+ (save-match-data
+ (let ((cur-ind (current-indentation)))
+ (if (eq ind-pnt 'next)
+ (when (and (zerop (forward-line 1))
+ (< (point) (point-max)))
+ ;; Not at EOF.
+ (setq rst-font-lock-find-unindented-line-begin
+ (point))
+ (when (and (not (looking-at (rst-re 'lin-end)))
+ (> (current-indentation) cur-ind))
+ ;; Use end of indentation if non-empty line.
+ (looking-at (rst-re 'hws-tag))
+ (match-end 0)))
+ ;; Skip until non-empty line or EOF.
+ (while (and (zerop (forward-line 1))
+ (< (point) (point-max))
+ (looking-at (rst-re 'lin-end))))
+ (when (< (point) (point-max))
+ ;; Not at EOF.
+ (setq rst-font-lock-find-unindented-line-begin
+ (point))
+ (when (> (current-indentation) cur-ind)
+ ;; Indentation bigger than line of departure.
+ (looking-at (rst-re 'hws-tag))
+ (match-end 0))))))))
+ (when ind-pnt
+ (goto-char ind-pnt)
+ (or (rst-forward-indented-block nil (point-max))
+ (point-max))))))
+
+(defun rst-font-lock-find-unindented-line-match (limit)
+ "Set the match found earlier if match were found.
+Match has been found by
+`rst-font-lock-find-unindented-line-limit' the first time called
+or no match is found. Return non-nil if match was found. LIMIT
+is not used but mandated by the caller."
+ (when rst-font-lock-find-unindented-line-end
+ (set-match-data
+ (list rst-font-lock-find-unindented-line-begin
+ rst-font-lock-find-unindented-line-end))
+ (put-text-property rst-font-lock-find-unindented-line-begin
+ rst-font-lock-find-unindented-line-end
+ 'font-lock-multiline t)
+ ;; Make sure this is called only once.
+ (setq rst-font-lock-find-unindented-line-end nil)
+ t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Adornments
-(defvar rst-font-lock-adornment-point nil
- "Stores the point where the current adornment ends.
-Also used as a trigger for `rst-font-lock-handle-adornment'.")
-
-;; Here `rst-font-lock-handle-adornment' stores the section level of the
-;; current adornment or t for a transition.
-(defvar rst-font-lock-level nil)
-
-;; FIXME: It would be good if this could be used to markup section titles of
-;; given level with a special key; it would be even better to be able to
-;; customize this so it can be used for a generally available personal style
-;;
-;; FIXME: There should be some way to reset and reload this variable - probably
-;; a special key
-;;
-;; FIXME: Some support for `outline-mode' would be nice which should be based
-;; on this information
-(defvar rst-adornment-level-alist nil
- "Associates adornments with section levels.
-The key is a two character string. The first character is the adornment
-character. The second character distinguishes underline section titles (`u')
-from overline/underline section titles (`o'). The value is the section level.
-
-This is made buffer local on start and adornments found during font lock are
-entered.")
-
-;; Returns section level for adornment key KEY. Adds new section level if KEY
-;; is not found and ADD. If KEY is not a string it is simply returned.
-(defun rst-adornment-level (key &optional add)
- (let ((fnd (assoc key rst-adornment-level-alist))
- (new 1))
- (cond
- ((not (stringp key))
- key)
- (fnd
- (cdr fnd))
- (add
- (while (rassoc new rst-adornment-level-alist)
- (setq new (1+ new)))
- (setq rst-adornment-level-alist
- (append rst-adornment-level-alist (list (cons key new))))
- new))))
-
-;; Classifies adornment for section titles and transitions. ADORNMENT is the
-;; complete adornment string as found in the buffer. END is the point after the
-;; last character of ADORNMENT. For overline section adornment LIMIT limits the
-;; search for the matching underline. Returns a list. The first entry is t for
-;; a transition, or a key string for `rst-adornment-level' for a section title.
-;; The following eight values forming four match groups as can be used for
-;; `set-match-data'. First match group contains the maximum points of the whole
-;; construct. Second and last match group matched pure section title adornment
-;; while third match group matched the section title text or the transition.
-;; Each group but the first may or may not exist.
-(defun rst-classify-adornment (adornment end limit)
- (save-excursion
- (save-match-data
- (goto-char end)
- (let ((ado-ch (aref adornment 0))
- (ado-re (regexp-quote adornment))
- (end-pnt (point))
- (beg-pnt (progn
- (forward-line 0)
- (point)))
- (nxt-emp
- (save-excursion
- (or (not (zerop (forward-line 1)))
- (looking-at "\\s *$"))))
- (prv-emp
- (save-excursion
- (or (not (zerop (forward-line -1)))
- (looking-at "\\s *$"))))
- key beg-ovr end-ovr beg-txt end-txt beg-und end-und)
- (cond
- ((and nxt-emp prv-emp)
- ;; A transition
- (setq key t)
- (setq beg-txt beg-pnt)
- (setq end-txt end-pnt))
- (prv-emp
- ;; An overline
- (setq key (concat (list ado-ch) "o"))
- (setq beg-ovr beg-pnt)
- (setq end-ovr end-pnt)
- (forward-line 1)
- (setq beg-txt (point))
- (while (and (< (point) limit) (not end-txt))
- (if (looking-at "\\s *$")
- ;; No underline found
- (setq end-txt (1- (point)))
- (when (looking-at (concat "\\(" ado-re "\\)\\s *$"))
- (setq end-und (match-end 1))
- (setq beg-und (point))
- (setq end-txt (1- beg-und))))
- (forward-line 1)))
- (t
- ;; An underline
- (setq key (concat (list ado-ch) "u"))
- (setq beg-und beg-pnt)
- (setq end-und end-pnt)
- (setq end-txt (1- beg-und))
- (setq beg-txt (progn
- (if (re-search-backward "^\\s *$" 1 'move)
- (forward-line 1))
- (point)))))
- (list key
- (or beg-ovr beg-txt beg-und)
- (or end-und end-txt end-und)
- beg-ovr end-ovr beg-txt end-txt beg-und end-und)))))
-
-;; Handles adornments for font-locking section titles and transitions. Returns
-;; three match groups. First and last match group matched pure overline /
-;; underline adornment while second group matched section title text. Each
-;; group may not exist.
-(defun rst-font-lock-handle-adornment (limit)
- (let ((ado-pnt rst-font-lock-adornment-point))
- ;; May run only once - enforce this
- (setq rst-font-lock-adornment-point nil)
- (if ado-pnt
- (let* ((ado (rst-classify-adornment (match-string-no-properties 1)
- ado-pnt limit))
- (key (car ado))
- (mtc (cdr ado)))
- (setq rst-font-lock-level (rst-adornment-level key t))
- (goto-char (nth 1 mtc))
- (put-text-property (nth 0 mtc) (nth 1 mtc) 'font-lock-multiline t)
- (set-match-data mtc)
- t))))
-
-
+(defvar rst-font-lock-adornment-level nil
+ "Storage for `rst-font-lock-handle-adornment-matcher'.
+Either section level of the current adornment or t for a transition.")
+
+(defun rst-adornment-level (key)
+ "Return section level for adornment KEY.
+KEY is the first element of the return list of
+`rst-classify-adornment'. If KEY is not a cons return it. If KEY is found
+in the hierarchy return its level. Otherwise return a level one
+beyond the existing hierarchy."
+ (if (not (consp key))
+ key
+ (let* ((hier (rst-get-hierarchy))
+ (char (car key))
+ (style (cdr key)))
+ (1+ (or (lexical-let ((char char)
+ (style style)
+ (hier hier)) ; Create closure.
+ (rst-position-if (lambda (elt)
+ (and (equal (car elt) char)
+ (equal (cadr elt) style))) hier))
+ (length hier))))))
+
+(defvar rst-font-lock-adornment-match nil
+ "Storage for match for current adornment.
+Set by `rst-font-lock-handle-adornment-pre-match-form'. Also used
+as a trigger for `rst-font-lock-handle-adornment-matcher'.")
+
+(defun rst-font-lock-handle-adornment-pre-match-form (ado ado-end)
+ "Determine limit for adornments.
+Determine all things necessary for font-locking section titles
+and transitions and put the result to
+`rst-font-lock-adornment-match' and
+`rst-font-lock-adornment-level'. ADO is the complete adornment
+matched. ADO-END is the point where ADO ends. Return the point
+where the whole adorned construct ends.
+
+Called as a PRE-MATCH-FORM in the sense of `font-lock-keywords'."
+ (let ((ado-data (rst-classify-adornment ado ado-end)))
+ (if (not ado-data)
+ (setq rst-font-lock-adornment-level nil
+ rst-font-lock-adornment-match nil)
+ (setq rst-font-lock-adornment-level
+ (rst-adornment-level (car ado-data)))
+ (setq rst-font-lock-adornment-match (cdr ado-data))
+ (goto-char (nth 1 ado-data)) ; Beginning of construct.
+ (nth 2 ado-data)))) ; End of construct.
+
+(defun rst-font-lock-handle-adornment-matcher (limit)
+ "Set the match found earlier if match were found.
+Match has been found by
+`rst-font-lock-handle-adornment-pre-match-form' the first time
+called or no match is found. Return non-nil if match was found.
+
+Called as a MATCHER in the sense of `font-lock-keywords'.
+LIMIT is not used but mandated by the caller."
+ (let ((match rst-font-lock-adornment-match))
+ ;; May run only once - enforce this.
+ (setq rst-font-lock-adornment-match nil)
+ (when match
+ (set-match-data match)
+ (goto-char (match-end 0))
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'font-lock-multiline t)
+ t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Support for conversion from within Emacs
+;; Compilation
(defgroup rst-compile nil
"Settings for support of conversion of reStructuredText
@@ -3250,10 +3916,14 @@ document with \\[rst-compile]."
".pdf" nil)
(s5 ,(if (executable-find "rst2s5.py") "rst2s5.py" "rst2s5")
".html" nil))
- "Table describing the command to use for each toolset.
-An association list of the toolset to a list of the (command to use,
+ "Table describing the command to use for each tool-set.
+An association list of the tool-set to a list of the (command to use,
extension of produced filename, options to the tool (nil or a
string)) to be used for converting the document."
+ ;; FIXME: These are not options but symbols which may be referenced by
+ ;; `rst-compile-*-toolset` below. The `:validate' keyword of
+ ;; `defcustom' may help to define this properly in newer Emacs
+ ;; versions (> 23.1).
:type '(alist :options (html latex newlatex pseudoxml xml pdf s5)
:key-type symbol
:value-type (list :tag "Specification"
@@ -3263,19 +3933,16 @@ string)) to be used for converting the document."
(const :tag "No options" nil)
(string :tag "Options"))))
:group 'rst
- :version "24.1")
-
-;; Note for Python programmers not familiar with association lists: you can set
-;; values in an alists like this, e.g. :
-;; (setcdr (assq 'html rst-compile-toolsets)
-;; '("rst2html.py" ".htm" "--stylesheet=/docutils.css"))
-
+ :package-version "1.2.0")
+(rst-testcover-defcustom)
+;; FIXME: Must be `defcustom`.
(defvar rst-compile-primary-toolset 'html
- "The default toolset for `rst-compile'.")
+ "The default tool-set for `rst-compile'.")
+;; FIXME: Must be `defcustom`.
(defvar rst-compile-secondary-toolset 'latex
- "The default toolset for `rst-compile' with a prefix argument.")
+ "The default tool-set for `rst-compile' with a prefix argument.")
(defun rst-compile-find-conf ()
"Look for the configuration file in the parents of the current path."
@@ -3293,23 +3960,20 @@ 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)
-(defun rst-compile (&optional pfxarg)
+(defun rst-compile (&optional use-alt)
"Compile command to convert reST document into some output file.
Attempts to find configuration file, if it can, overrides the
-options. There are two commands to choose from, with a prefix
-argument, select the alternative toolset."
+options. There are two commands to choose from, with USE-ALT,
+select the alternative tool-set."
(interactive "P")
;; Note: maybe we want to check if there is a Makefile too and not do anything
;; if that is the case. I dunno.
- (let* ((toolset (cdr (assq (if pfxarg
+ (let* ((toolset (cdr (assq (if use-alt
rst-compile-secondary-toolset
rst-compile-primary-toolset)
rst-compile-toolsets)))
@@ -3326,26 +3990,27 @@ argument, select the alternative toolset."
(list command
(or options "")
(if conffile
- (concat "--config=\"" conffile "\"")
+ (concat "--config=" (shell-quote-argument conffile))
"")
- bufname
- (concat outname extension))
+ (shell-quote-argument bufname)
+ (shell-quote-argument (concat outname extension)))
" "))
;; Invoke the compile command.
- (if (or compilation-read-command current-prefix-arg)
+ (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 toolset."
+ "Compile command with the alternative tool-set."
(interactive)
- (rst-compile 't))
+ (rst-compile t))
(defun rst-compile-pseudo-region ()
- "Show the pseudo-XML rendering of the current active region,
-or of the entire buffer, if the region is not selected."
+ "Show pseudo-XML rendering.
+Rendering is done of the current active region, or of the entire
+buffer, if the region is not selected."
+ ;; FIXME: The region should be given interactively.
(interactive)
(with-output-to-temp-buffer "*pseudoxml*"
(shell-command-on-region
@@ -3354,53 +4019,125 @@ or of the entire buffer, if the region is not selected."
(cadr (assq 'pseudoxml rst-compile-toolsets))
standard-output)))
+;; FIXME: Should be `defcustom`.
(defvar rst-pdf-program "xpdf"
"Program used to preview PDF files.")
(defun rst-compile-pdf-preview ()
"Convert the document to a PDF file and launch a preview program."
(interactive)
- (let* ((tmp-filename (make-temp-file "rst-out" nil ".pdf"))
- (command (format "%s %s %s && %s %s"
+ (let* ((tmp-filename (make-temp-file "rst_el" nil ".pdf"))
+ (command (format "%s %s %s && %s %s ; rm %s"
(cadr (assq 'pdf rst-compile-toolsets))
buffer-file-name tmp-filename
- rst-pdf-program tmp-filename)))
+ rst-pdf-program tmp-filename tmp-filename)))
(start-process-shell-command "rst-pdf-preview" nil command)
;; Note: you could also use (compile command) to view the compilation
;; output.
))
+;; FIXME: Should be `defcustom` or use something like `browse-url`.
(defvar rst-slides-program "firefox"
"Program used to preview S5 slides.")
(defun rst-compile-slides-preview ()
"Convert the document to an S5 slide presentation and launch a preview program."
(interactive)
- (let* ((tmp-filename (make-temp-file "rst-slides" nil ".html"))
- (command (format "%s %s %s && %s %s"
+ (let* ((tmp-filename (make-temp-file "rst_el" nil ".html"))
+ (command (format "%s %s %s && %s %s ; rm %s"
(cadr (assq 's5 rst-compile-toolsets))
buffer-file-name tmp-filename
- rst-slides-program tmp-filename)))
+ rst-slides-program tmp-filename tmp-filename)))
(start-process-shell-command "rst-slides-preview" nil command)
;; Note: you could also use (compile command) to view the compilation
;; output.
))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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.
-;;
+;; FIXME: Unbound command - should be bound or removed.
(defun rst-replace-lines (fromchar tochar)
- "Replace flush-left lines, consisting of multiple FROMCHAR characters,
-with equal-length lines of TOCHAR."
+ "Replace flush-left lines of FROMCHAR with equal-length lines of TOCHAR."
(interactive "\
cSearch for flush-left lines of char:
cand replace with char: ")
(save-excursion
- (let ((searchre (concat "^" (regexp-quote (string fromchar)) "+\\( *\\)$"))
+ (let ((searchre (rst-re "^" fromchar "+\\( *\\)$"))
(found 0))
(while (search-forward-regexp searchre nil t)
(setq found (1+ found))
@@ -3410,12 +4147,14 @@ cand replace with char: ")
(insert-char tochar width)))
(message (format "%d lines replaced." found)))))
+;; FIXME: Unbound command - should be bound or removed.
(defun rst-join-paragraph ()
"Join lines in current paragraph into one line, removing end-of-lines."
(interactive)
- (let ((fill-column 65000)) ; some big number
+ (let ((fill-column 65000)) ; Some big number.
(call-interactively 'fill-paragraph)))
+;; FIXME: Unbound command - should be bound or removed.
(defun rst-force-fill-paragraph ()
"Fill paragraph at point, first joining the paragraph's lines into one.
This is useful for filling list item paragraphs."
@@ -3424,62 +4163,60 @@ This is useful for filling list item paragraphs."
(fill-paragraph nil))
+;; FIXME: Unbound command - should be bound or removed.
;; Generic character repeater function.
;; For sections, better to use the specialized function above, but this can
;; be useful for creating separators.
-(defun rst-repeat-last-character (&optional tofill)
- "Fill the current line up to the length of the preceding line (if not
-empty), using the last character on the current line. If the preceding line is
-empty, we use the `fill-column'.
+(defun rst-repeat-last-character (use-next)
+ "Fill the current line using the last character on the current line.
+Fill up to the length of the preceding line or up to
+`fill-column' if preceding line is empty.
-If a prefix argument is provided, use the next line rather than the preceding
-line.
+If USE-NEXT, use the next line rather than the preceding line.
If the current line is longer than the desired length, shave the characters off
the current line to fit the desired length.
As an added convenience, if the command is repeated immediately, the alternative
column is used (fill-column vs. end of previous/next line)."
- (interactive)
+ (interactive "P")
(let* ((curcol (current-column))
(curline (+ (count-lines (point-min) (point))
- (if (eq curcol 0) 1 0)))
+ (if (zerop curcol) 1 0)))
(lbp (line-beginning-position 0))
- (prevcol (if (and (= curline 1) (not current-prefix-arg))
+ (prevcol (if (and (= curline 1) (not use-next))
fill-column
(save-excursion
- (forward-line (if current-prefix-arg 1 -1))
+ (forward-line (if use-next 1 -1))
(end-of-line)
(skip-chars-backward " \t" lbp)
(let ((cc (current-column)))
- (if (= cc 0) fill-column cc)))))
+ (if (zerop cc) fill-column cc)))))
(rightmost-column
- (cond (tofill fill-column)
- ((equal last-command 'rst-repeat-last-character)
+ (cond ((equal last-command 'rst-repeat-last-character)
(if (= curcol fill-column) prevcol fill-column))
(t (save-excursion
- (if (= prevcol 0) fill-column prevcol)))
- )) )
+ (if (zerop prevcol) fill-column prevcol))))))
(end-of-line)
(if (> (current-column) rightmost-column)
- ;; shave characters off the end
+ ;; Shave characters off the end.
(delete-region (- (point)
(- (current-column) rightmost-column))
(point))
- ;; fill with last characters
+ ;; Fill with last characters.
(insert-char (preceding-char)
- (- rightmost-column (current-column))))
- ))
+ (- rightmost-column (current-column))))))
+
-(defun rst-portable-mark-active-p ()
- "A portable function that returns non-nil if the mark is active."
- (cond
- ((fboundp 'region-active-p) (region-active-p))
- ((boundp 'transient-mark-mode) (and transient-mark-mode mark-active))
- (t mark-active)))
+;; LocalWords: docutils http sourceforge rst html wp svn svnroot txt reST regex
+;; LocalWords: regexes alist seq alt grp keymap abbrev overline overlines toc
+;; LocalWords: XML PNT propertized
+
+;; Local Variables:
+;; sentence-end-double-space: t
+;; End:
-
(provide 'rst)
;;; rst.el ends here
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index f9e3283b783..46c65b25b37 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1,6 +1,6 @@
;;; sgml-mode.el --- SGML- and HTML-editing modes -*- coding: utf-8 -*-
-;; Copyright (C) 1992, 1995-1996, 1998, 2001-2011
+;; Copyright (C) 1992, 1995-1996, 1998, 2001-2012
;; Free Software Foundation, Inc.
;; Author: James Clark <jjc@jclark.com>
@@ -34,8 +34,7 @@
(eval-when-compile
(require 'skeleton)
- (require 'outline)
- (require 'cl))
+ (require 'cl-lib))
(defgroup sgml nil
"SGML editing mode."
@@ -62,7 +61,7 @@
:group 'sgml
:type 'hook)
-;; As long as Emacs' syntax can't be complemented with predicates to context
+;; As long as Emacs's syntax can't be complemented with predicates to context
;; sensitively confirm the syntax of characters, we have to live with this
;; kludgy kind of tradeoff.
(defvar sgml-specials '(?\")
@@ -292,7 +291,7 @@ Any terminating `>' or `/' is not matched.")
;; for font-lock, but must be defvar'ed after
;; sgml-font-lock-keywords-1 and sgml-font-lock-keywords-2 above
(defvar sgml-font-lock-keywords sgml-font-lock-keywords-1
- "*Rules for highlighting SGML code. See also `sgml-tag-face-alist'.")
+ "Rules for highlighting SGML code. See also `sgml-tag-face-alist'.")
(defconst sgml-syntax-propertize-function
(syntax-propertize-rules
@@ -451,7 +450,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.
@@ -1192,7 +1191,7 @@ You might want to turn on `auto-fill-mode' to get better results."
;; Parsing
-(defstruct (sgml-tag
+(cl-defstruct (sgml-tag
(:constructor sgml-make-tag (type start end name)))
type start end name)
@@ -1272,7 +1271,7 @@ Leave point at the beginning of the tag."
(throw 'found (sgml-parse-tag-backward limit))))
(point))))
(goto-char (1+ tag-start))
- (case (char-after)
+ (pcase (char-after)
(?! (setq tag-type 'decl)) ; declaration
(?? (setq tag-type 'pi)) ; processing-instruction
(?% (setq tag-type 'jsp)) ; JSP tags
@@ -1280,7 +1279,7 @@ Leave point at the beginning of the tag."
(forward-char 1)
(setq tag-type 'close
name (sgml-parse-tag-name)))
- (t ; open or empty tag
+ (_ ; open or empty tag
(setq tag-type 'open
name (sgml-parse-tag-name))
(if (or (eq ?/ (char-before (- tag-end 1)))
@@ -1405,19 +1404,19 @@ If FULL is non-nil, parse back to the beginning of the buffer."
Depending on context, inserts a matching close-tag, or closes
the current start-tag or the current comment or the current cdata, ..."
(interactive)
- (case (car (sgml-lexical-context))
- (comment (insert " -->"))
- (cdata (insert "]]>"))
- (pi (insert " ?>"))
- (jsp (insert " %>"))
- (tag (insert " />"))
- (text
+ (pcase (car (sgml-lexical-context))
+ (`comment (insert " -->"))
+ (`cdata (insert "]]>"))
+ (`pi (insert " ?>"))
+ (`jsp (insert " %>"))
+ (`tag (insert " />"))
+ (`text
(let ((context (save-excursion (sgml-get-context))))
(if context
(progn
(insert "</" (sgml-tag-name (car (last context))) ">")
(indent-according-to-mode)))))
- (otherwise
+ (_
(error "Nothing to close"))))
(defun sgml-empty-tag-p (tag-name)
@@ -1442,9 +1441,9 @@ LCON is the lexical context, if any."
(save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
(setq lcon (cons 'comment (+ (cdr lcon) 2))))
- (case (car lcon)
+ (pcase (car lcon)
- (string
+ (`string
;; Go back to previous non-empty line.
(while (and (> (point) (cdr lcon))
(zerop (forward-line -1))
@@ -1455,7 +1454,7 @@ LCON is the lexical context, if any."
(goto-char (cdr lcon))
(1+ (current-column))))
- (comment
+ (`comment
(let ((mark (looking-at "--")))
;; Go back to previous non-empty line.
(while (and (> (point) (cdr lcon))
@@ -1474,11 +1473,11 @@ LCON is the lexical context, if any."
(current-column)))
;; We don't know how to indent it. Let's be honest about it.
- (cdata nil)
+ (`cdata nil)
;; We don't know how to indent it. Let's be honest about it.
- (pi nil)
+ (`pi nil)
- (tag
+ (`tag
(goto-char (1+ (cdr lcon)))
(skip-chars-forward "^ \t\n") ;Skip tag name.
(skip-chars-forward " \t")
@@ -1488,7 +1487,7 @@ LCON is the lexical context, if any."
(goto-char (1+ (cdr lcon)))
(+ (current-column) sgml-basic-offset)))
- (text
+ (`text
(while (looking-at "</")
(forward-sexp 1)
(skip-chars-forward " \t"))
@@ -1536,7 +1535,7 @@ LCON is the lexical context, if any."
(+ (current-column)
(* sgml-basic-offset (length context)))))))
- (otherwise
+ (_
(error "Unrecognized context %s" (car lcon)))
))
@@ -1664,7 +1663,7 @@ This takes effect when first loading the library.")
'((bold . "b")
(italic . "i")
(underline . "u")
- (modeline . "rev"))
+ (mode-line . "rev"))
"Value of `sgml-face-tag-alist' for HTML mode.")
(defvar html-tag-face-alist
@@ -1680,7 +1679,7 @@ This takes effect when first loading the library.")
("h5" . underline)
("h6" . underline)
("i" . italic)
- ("rev" . modeline)
+ ("rev" . mode-line)
("s" . underline)
("small" . default)
("strong" . bold)
@@ -1843,7 +1842,7 @@ This takes effect when first loading the library.")
("u")
("var")
("wbr" t)))
- "*Value of `sgml-tag-alist' for HTML mode.")
+ "Value of `sgml-tag-alist' for HTML mode.")
(defvar html-tag-help
`(,@sgml-tag-help
@@ -1936,7 +1935,11 @@ This takes effect when first loading the library.")
("ul" . "Unordered list")
("var" . "Math variable face")
("wbr" . "Enable <br> within <nobr>"))
- "*Value of `sgml-tag-help' for HTML mode.")
+ "Value of `sgml-tag-help' for HTML mode.")
+
+(defvar outline-regexp)
+(defvar outline-heading-end-regexp)
+(defvar outline-level)
;;;###autoload
@@ -2010,7 +2013,7 @@ To work around that, do:
(defvar html-imenu-regexp
"\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
- "*A regular expression matching a head line to be added to the menu.
+ "A regular expression matching a head line to be added to the menu.
The first `match-string' should be a number from 1-9.
The second `match-string' matches extra tags and is ignored.
The third `match-string' will be the used in the menu.")
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 6f9e592d8ed..6db15b7ec2a 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -1,6 +1,6 @@
-;;; 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-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Keywords: wp, convenience
;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com>
@@ -126,7 +126,7 @@
;; again.
;;
;; To use the package regularly place this file in the site library
-;; directory and add the next expression in your .emacs file. Make
+;; directory and add the next expression in your init file. Make
;; sure that directory is included in the `load-path'.
;;
;; (require 'table)
@@ -342,10 +342,10 @@
;; (function (lambda ()
;; (local-set-key [<key sequence>] '<function>))))
;;
-;; Above code is well known ~/.emacs idiom for customizing a mode
-;; specific keymap however it does not work for this package. This is
-;; because there is no table mode in effect. This package does not
-;; use a local map therefore you must modify `table-cell-map'
+;; Adding the above to your init file is a common way to customize a
+;; mode specific keymap. However it does not work for this package.
+;; This is because there is no table mode in effect. This package
+;; does not use a local map therefore you must modify `table-cell-map'
;; explicitly. The correct way of achieving above task is:
;;
;; (add-hook 'table-cell-map-hook
@@ -678,11 +678,9 @@ height."
:group 'table)
(defface table-cell
- '((((min-colors 88) (class color))
- (:foreground "gray90" :background "blue1"))
- (((class color))
- (:foreground "gray90" :background "blue"))
- (t (:bold t)))
+ '((((min-colors 88) (class color)) :foreground "gray90" :background "blue1")
+ (((class color)) :foreground "gray90" :background "blue")
+ (t :weight bold))
"Face used for table cell contents."
:tag "Cell Face"
:group 'table)
@@ -717,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
@@ -844,7 +820,7 @@ simply by any key input."
(defvar table-disable-menu (null (and (locate-library "easymenu")
(require 'easymenu)
(fboundp 'easy-menu-add-item)))
- "*When non-nil, use of menu by table package is disabled.
+ "When non-nil, use of menu by table package is disabled.
It must be set before loading this package `table.el' for the first
time.")
@@ -1003,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"
@@ -1243,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
@@ -1288,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)
@@ -1343,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\\>")))
@@ -1369,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)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -2583,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)
@@ -2607,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))
@@ -2834,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
@@ -2854,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
@@ -2912,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
@@ -3006,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
@@ -3095,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
@@ -3123,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
@@ -3135,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
@@ -3288,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)))
@@ -3405,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)
@@ -3898,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))
@@ -4094,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")
@@ -4293,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)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -5126,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)))
@@ -5280,7 +5210,7 @@ instead of the current buffer and returns the OBJECT."
"Update cell face according to the current mode."
(if (featurep 'xemacs)
(set-face-property 'table-cell 'underline table-fixed-width-mode)
- (set-face-inverse-video-p 'table-cell table-fixed-width-mode)))
+ (set-face-inverse-video 'table-cell table-fixed-width-mode)))
(table--update-cell-face)
@@ -5312,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.
@@ -5324,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 34bd24fba3a..062f43be57b 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1,6 +1,6 @@
;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands -*- coding: utf-8 -*-
-;; Copyright (C) 1985-1986, 1989, 1992, 1994-1999, 2001-2011
+;; Copyright (C) 1985-1986, 1989, 1992, 1994-1999, 2001-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -31,7 +31,7 @@
;; Pacify the byte-compiler
(eval-when-compile
(require 'compare-w)
- (require 'cl)
+ (require 'cl-lib)
(require 'skeleton))
(defvar font-lock-comment-face)
@@ -265,7 +265,7 @@ Deleted when the \\[tex-region] or \\[tex-buffer] is next run, or when the
tex shell terminates.")
(defvar tex-command "tex"
- "*Command to run TeX.
+ "Command to run TeX.
If this string contains an asterisk \(`*'\), that is replaced by the file name;
otherwise the value of `tex-start-options', the \(shell-quoted\)
value of `tex-start-commands', and the file name are added at the end
@@ -476,46 +476,51 @@ An alternative value is \" . \", if you use a font with a narrow period."
'("input" "include" "includeonly" "bibliography"
"epsfig" "psfig" "epsf" "nofiles" "usepackage"
"documentstyle" "documentclass" "verbatiminput"
- "includegraphics" "includegraphics*"
- "url" "nolinkurl")
+ "includegraphics" "includegraphics*")
t))
+ (verbish (regexp-opt '("url" "nolinkurl" "path") t))
;; Miscellany.
(slash "\\\\")
(opt " *\\(\\[[^]]*\\] *\\)*")
;; This would allow highlighting \newcommand\CMD but requires
;; adapting subgroup numbers below.
;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)"))
- (arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)"))
- (list
- ;; display $$ math $$
- ;; We only mark the match between $$ and $$ because the $$ delimiters
- ;; themselves have already been marked (along with $..$) by syntactic
- ;; fontification. Also this is done at the very beginning so as to
- ;; interact with the other keywords in the same way as $...$ does.
- (list "\\$\\$\\([^$]+\\)\\$\\$" 1 'tex-math-face)
- ;; Heading args.
- (list (concat slash headings "\\*?" opt arg)
- ;; If ARG ends up matching too much (if the {} don't match, e.g.)
- ;; jit-lock will do funny things: when updating the buffer
- ;; the re-highlighting is only done locally so it will just
- ;; match the local line, but defer-contextually will
- ;; match more lines at a time, so ARG will end up matching
- ;; a lot more, which might suddenly include a comment
- ;; so you get things highlighted bold when you type them
- ;; but they get turned back to normal a little while later
- ;; because "there's already a face there".
- ;; Using `keep' works around this un-intuitive behavior as well
- ;; as improves the behavior in the very rare case where you do
- ;; have a comment in ARG.
- 3 'font-lock-function-name-face 'keep)
- (list (concat slash "\\(?:provide\\|\\(?:re\\)?new\\)command\\** *\\(\\\\[A-Za-z@]+\\)")
- 1 'font-lock-function-name-face 'keep)
- ;; Variable args.
- (list (concat slash variables " *" arg) 2 'font-lock-variable-name-face)
- ;; Include args.
- (list (concat slash includes opt arg) 3 'font-lock-builtin-face)
- ;; Definitions. I think.
- '("^[ \t]*\\\\def *\\\\\\(\\(\\w\\|@\\)+\\)"
+ (inbraces-re (lambda (re)
+ (concat "\\(?:[^{}\\]\\|\\\\.\\|" re "\\)")))
+ (arg (concat "{\\(" (funcall inbraces-re "{[^}]*}") "+\\)")))
+ `( ;; Highlight $$math$$ and $math$.
+ ;; This is done at the very beginning so as to interact with the other
+ ;; keywords in the same way as comments and strings.
+ (,(concat "\\$\\$?\\(?:[^$\\{}]\\|\\\\.\\|{"
+ (funcall inbraces-re
+ (concat "{" (funcall inbraces-re "{[^}]*}") "*}"))
+ "*}\\)+\\$?\\$")
+ (0 tex-math-face))
+ ;; Heading args.
+ (,(concat slash headings "\\*?" opt arg)
+ ;; If ARG ends up matching too much (if the {} don't match, e.g.)
+ ;; jit-lock will do funny things: when updating the buffer
+ ;; the re-highlighting is only done locally so it will just
+ ;; match the local line, but defer-contextually will
+ ;; match more lines at a time, so ARG will end up matching
+ ;; a lot more, which might suddenly include a comment
+ ;; so you get things highlighted bold when you type them
+ ;; but they get turned back to normal a little while later
+ ;; because "there's already a face there".
+ ;; Using `keep' works around this un-intuitive behavior as well
+ ;; as improves the behavior in the very rare case where you do
+ ;; have a comment in ARG.
+ 3 font-lock-function-name-face keep)
+ (,(concat slash "\\(?:provide\\|\\(?:re\\)?new\\)command\\** *\\(\\\\[A-Za-z@]+\\)")
+ 1 font-lock-function-name-face keep)
+ ;; Variable args.
+ (,(concat slash variables " *" arg) 2 font-lock-variable-name-face)
+ ;; Include args.
+ (,(concat slash includes opt arg) 3 font-lock-builtin-face)
+ ;; Verbatim-like args.
+ (,(concat slash verbish opt arg) 3 'tex-verbatim)
+ ;; Definitions. I think.
+ ("^[ \t]*\\\\def *\\\\\\(\\(\\w\\|@\\)+\\)"
1 font-lock-function-name-face))))
"Subdued expressions to highlight in TeX modes.")
@@ -629,7 +634,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
(1 (tex-font-lock-suscript (match-beginning 0)) append))))
"Experimental expressions to highlight in TeX modes.")
-(defvar tex-font-lock-keywords tex-font-lock-keywords-1
+(defconst tex-font-lock-keywords tex-font-lock-keywords-1
"Default expressions to highlight in TeX modes.")
(defvar tex-verbatim-environments
@@ -855,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)
@@ -1219,7 +1220,7 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook
(set (make-local-variable 'font-lock-defaults)
'((tex-font-lock-keywords tex-font-lock-keywords-1
tex-font-lock-keywords-2 tex-font-lock-keywords-3)
- nil nil ((?$ . "\"")) nil
+ nil nil nil nil
;; Who ever uses that anyway ???
(font-lock-mark-block-function . mark-paragraph)
(font-lock-syntactic-face-function
@@ -1281,7 +1282,8 @@ inserts \" characters."
(delete-char (length tex-open-quote))
t)))
(self-insert-command (prefix-numeric-value arg))
- (insert (if (memq (char-syntax (preceding-char)) '(?\( ?> ?\s))
+ (insert (if (or (memq (char-syntax (preceding-char)) '(?\( ?> ?\s))
+ (memq (preceding-char) '(?~)))
tex-open-quote tex-close-quote))))
(defun tex-validate-buffer ()
@@ -1492,8 +1494,8 @@ Puts point on a blank line between them."
(defvar latex-complete-bibtex-cache nil)
-(defun latex-string-prefix-p (str1 str2)
- (eq t (compare-strings str1 nil nil str2 0 (length str1))))
+(define-obsolete-function-alias 'latex-string-prefix-p
+ 'string-prefix-p "24.3")
(defvar bibtex-reference-key)
(declare-function reftex-get-bibfile-list "reftex-cite.el" ())
@@ -1507,7 +1509,7 @@ Puts point on a blank line between them."
keys)
(if (and (eq (car latex-complete-bibtex-cache)
(reftex-get-bibfile-list))
- (latex-string-prefix-p (nth 1 latex-complete-bibtex-cache)
+ (string-prefix-p (nth 1 latex-complete-bibtex-cache)
key))
;; Use the cache.
(setq keys (nth 2 latex-complete-bibtex-cache))
@@ -1543,8 +1545,8 @@ Puts point on a blank line between them."
(save-excursion
(let ((pt (point)))
(skip-chars-backward "^ {}\n\t\\\\")
- (case (char-before)
- ((nil ?\s ?\n ?\t ?\}) nil)
+ (pcase (char-before)
+ ((or `nil ?\s ?\n ?\t ?\}) nil)
(?\\
;; TODO: Complete commands.
nil)
@@ -1717,9 +1719,12 @@ Mark is left at original location."
"Like `forward-sexp' but aware of multi-char elements and escaped parens."
(interactive "P")
(unless arg (setq arg 1))
- (let ((pos (point)))
+ (let ((pos (point))
+ (opoint 0))
(condition-case err
- (while (/= arg 0)
+ (while (and (/= (point) opoint)
+ (/= arg 0))
+ (setq opoint (point))
(setq arg
(if (> arg 0)
(progn (latex-forward-sexp-1) (1- arg))
@@ -1793,7 +1798,7 @@ Mark is left at original location."
(if (not (eq (char-syntax (preceding-char)) ?/))
(progn
;; Don't count single-char words.
- (unless (looking-at ".\\>") (incf count))
+ (unless (looking-at ".\\>") (cl-incf count))
(forward-char 1))
(let ((cmd
(buffer-substring-no-properties
@@ -1984,8 +1989,7 @@ If NOT-ALL is non-nil, save the `.dvi' file."
(let* ((dir (file-name-directory tex-last-temp-file))
(list (and (file-directory-p dir)
(file-name-all-completions
- (file-name-sans-extension
- (file-name-nondirectory tex-last-temp-file))
+ (file-name-base tex-last-temp-file)
dir))))
(while list
(if not-all
@@ -2051,10 +2055,7 @@ IN can be either a string (with the same % escapes in it) indicating
OUT describes the output file and is either a %-escaped string
or nil to indicate that there is no output file.")
-;; defsubst* gives better byte-code than defsubst.
-(defsubst* tex-string-prefix-p (str1 str2)
- "Return non-nil if STR1 is a prefix of STR2"
- (eq t (compare-strings str2 nil (length str1) str1 nil nil)))
+(define-obsolete-function-alias 'tex-string-prefix-p 'string-prefix-p "24.3")
(defun tex-guess-main-file (&optional all)
"Find a likely `tex-main-file'.
@@ -2069,7 +2070,7 @@ of the current buffer."
(with-current-buffer buf
(when (and (cond
((null all) (equal dir default-directory))
- ((eq all 'sub) (tex-string-prefix-p default-directory dir))
+ ((eq all 'sub) (string-prefix-p default-directory dir))
(t))
(stringp tex-main-file))
(throw 'found (expand-file-name tex-main-file)))))
@@ -2078,7 +2079,7 @@ of the current buffer."
(with-current-buffer buf
(when (and (cond
((null all) (equal dir default-directory))
- ((eq all 'sub) (tex-string-prefix-p default-directory dir))
+ ((eq all 'sub) (string-prefix-p default-directory dir))
(t))
buffer-file-name
;; (or (easy-mmode-derived-mode-p 'latex-mode)
@@ -2564,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
@@ -2689,7 +2689,9 @@ Runs the shell command defined by `tex-show-queue-command'."
"Syntax table used while computing indentation.")
(defun latex-indent (&optional arg)
- (if (and (eq (get-text-property (line-beginning-position) 'face)
+ (if (and (eq (get-text-property (if (and (eobp) (bolp))
+ (max (point-min) (1- (point)))
+ (line-beginning-position)) 'face)
'tex-verbatim))
'noindent
(with-syntax-table tex-latex-indent-syntax-table
@@ -2863,10 +2865,10 @@ There might be text before point."
(cons (append (car font-lock-defaults) '(doctex-font-lock-keywords))
(mapcar
(lambda (x)
- (case (car-safe x)
- (font-lock-syntactic-face-function
+ (pcase (car-safe x)
+ (`font-lock-syntactic-face-function
(cons (car x) 'doctex-font-lock-syntactic-face-function))
- (t x)))
+ (_ x)))
(cdr font-lock-defaults))))
(set (make-local-variable 'syntax-propertize-function)
(syntax-propertize-rules doctex-syntax-propertize-rules)))
diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el
index b186b02851d..cb87c1198f9 100644
--- a/lisp/textmodes/texinfmt.el
+++ b/lisp/textmodes/texinfmt.el
@@ -1,6 +1,6 @@
;;; texinfmt.el --- format Texinfo files into Info files
-;; Copyright (C) 1985-1986, 1988, 1990-1998, 2000-2011
+;; Copyright (C) 1985-1986, 1988, 1990-1998, 2000-2012
;; Free Software Foundation, Inc.
;; Maintainer: Robert J. Chassell <bug-texinfo@gnu.org>
@@ -93,7 +93,7 @@ If optional argument HERE is non-nil, insert info at point."
(@unnumberedsubsubsec . @unnumberedsubsec)
(@subsubheading . @subheading)
(@appendixsubsubsec . @appendixsubsec))
- "*An alist of next higher levels for chapters, sections, etc...
+ "An alist of next higher levels for chapters, sections, etc...
For example, section to chapter, subsection to section.
Used by `texinfo-raise-lower-sections'.
The keys specify types of section; the values correspond to the next
@@ -121,7 +121,7 @@ higher types.")
(@unnumberedsubsubsec . @unnumberedsubsubsec)
(@subsubheading . @subsubheading)
(@appendixsubsubsec . @appendixsubsubsec))
- "*An alist of next lower levels for chapters, sections, etc...
+ "An alist of next lower levels for chapters, sections, etc...
For example, chapter to section, section to subsection.
Used by `texinfo-raise-lower-sections'.
The keys specify types of section; the values correspond to the next
@@ -174,7 +174,7 @@ and don't split the file if large. You can use `Info-tagify' and
"done. Now save it." "done.")))))
(defvar texinfo-region-buffer-name "*Info Region*"
- "*Name of the temporary buffer used by \\[texinfo-format-region].")
+ "Name of the temporary buffer used by \\[texinfo-format-region].")
(defvar texinfo-pre-format-hook nil
"Hook called before the conversion of the Texinfo file to Info format.
@@ -1918,7 +1918,7 @@ Used by @refill indenting command to avoid indenting within lists, etc.")
;; Texinfo commands.
(defvar texinfo-extra-inter-column-width 0
- "*Number of extra spaces between entries (columns) in @multitable.")
+ "Number of extra spaces between entries (columns) in @multitable.")
(defvar texinfo-multitable-buffer-name "*multitable-temporary-buffer*")
(defvar texinfo-multitable-rectangle-name "texinfo-multitable-temp-")
@@ -2958,6 +2958,28 @@ Default is to leave paragraph indentation as is."
("ky" . texinfo-format-kindex)))
+;;; Sort and index
+
+;; Sort an index which is in the current buffer between START and END.
+(defun texinfo-sort-region (start end)
+ (require 'sort)
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (sort-subr nil 'forward-line 'end-of-line 'texinfo-sort-startkeyfun)))
+
+;; Subroutine for sorting an index.
+;; At start of a line, return a string to sort the line under.
+(defun texinfo-sort-startkeyfun ()
+ (let ((line (buffer-substring-no-properties (point) (line-end-position))))
+ ;; Canonicalize whitespace and eliminate funny chars.
+ (while (string-match "[ \t][ \t]+\\|[^a-z0-9 ]+" line)
+ (setq line (concat (substring line 0 (match-beginning 0))
+ " "
+ (substring line (match-end 0)))))
+ line))
+
+
;;; @printindex
(put 'printindex 'texinfo-format 'texinfo-format-printindex)
@@ -2974,7 +2996,7 @@ Default is to leave paragraph indentation as is."
(insert "\n* Menu:\n\n")
(setq opoint (point))
(texinfo-print-index nil indexelts)
- (shell-command-on-region opoint (point) "sort -fd" 1)))
+ (texinfo-sort-region opoint (point))))
(defun texinfo-print-index (file indexelts)
(while indexelts
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 7e9ce9aff6d..4e7715dcea9 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -1,6 +1,6 @@
;;; texinfo.el --- major mode for editing Texinfo files -*- coding: utf-8 -*-
-;; Copyright (C) 1985, 1988-1993, 1996-1997, 2000-2011
+;; Copyright (C) 1985, 1988-1993, 1996-1997, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Robert J. Chassell
@@ -32,7 +32,7 @@
;;; Code:
-(eval-when-compile (require 'tex-mode) (require 'cl))
+(eval-when-compile (require 'tex-mode))
(defvar outline-heading-alist)
(defgroup texinfo nil
diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el
index 69d68a76d4b..70aa17cea6b 100644
--- a/lisp/textmodes/texnfo-upd.el
+++ b/lisp/textmodes/texnfo-upd.el
@@ -1,6 +1,6 @@
;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files
-;; Copyright (C) 1989-1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989-1992, 2001-2012 Free Software Foundation, Inc.
;; Author: Robert J. Chassell
;; Maintainer: bug-texinfo@gnu.org
@@ -41,7 +41,7 @@
;;
;; Important note: We do NOT recommend use of these commands to update
;; the `Next', `Previous' and `Up' pointers on @node lines. Most
-;; manuals, including those whose Texinfo files adhere to the strucure
+;; manuals, including those whose Texinfo files adhere to the structure
;; described below, don't need these pointers, because makeinfo will
;; generate them automatically (see the node "makeinfo Pointer
;; Creation" in the Texinfo manual). By contrast, due to known bugs
@@ -203,7 +203,7 @@ It comes after the chapter-level menu entries.")
(3 . (concat "\\(^@\\)\\(" texinfo-section-level-regexp "\\)\\>[ \t]*"))
(4 . (concat "\\(^@\\)\\(" texinfo-subsection-level-regexp "\\)\\>[ \t]+"))
(5 . (concat "\\(^@\\)\\(" texinfo-subsubsection-level-regexp "\\)\\>[ \t]+")))
- "*Regexps for searching for same level sections in a Texinfo file.
+ "Regexps for searching for same level sections in a Texinfo file.
The keys are strings specifying the general hierarchical level in the
document; the values are regular expressions.")
@@ -231,7 +231,7 @@ document; the values are regular expressions.")
"\\|"
texinfo-chapter-level-regexp
"\\)\\>[ \t]*\\)")))
- "*Regexps for searching for higher level sections in a Texinfo file.
+ "Regexps for searching for higher level sections in a Texinfo file.
The keys are strings specifying the general hierarchical level in the
document; the values are regular expressions.")
@@ -270,7 +270,7 @@ document; the values are regular expressions.")
"\\)\\>[ \t]+\\)"))
;; There's nothing below 5, use a bogus regexp that can't match.
(5 . "a\\(^\\)"))
- "*Regexps for searching for lower level sections in a Texinfo file.
+ "Regexps for searching for lower level sections in a Texinfo file.
The keys are strings specifying the general hierarchical level in the
document; the values are regular expressions.")
@@ -682,7 +682,7 @@ node within the section."
;; try 32, but perhaps 24 is better
(defvar texinfo-column-for-description 32
- "*Column at which descriptions start in a Texinfo menu.")
+ "Column at which descriptions start in a Texinfo menu.")
(defun texinfo-insert-menu (menu-list node-name)
"Insert formatted menu at point.
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index 3f6ad1faf87..301f69f45be 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -1,6 +1,6 @@
;;; text-mode.el --- text mode, and its idiosyncratic commands
-;; Copyright (C) 1985, 1992, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1992, 1994, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: wp
@@ -63,8 +63,7 @@ You can thus get the full benefit of adaptive filling
(see the variable `adaptive-fill-mode').
\\{text-mode-map}
Turning on Text mode runs the normal hook `text-mode-hook'."
- (make-local-variable 'text-mode-variant)
- (setq text-mode-variant t)
+ (set (make-local-variable 'text-mode-variant) t)
(set (make-local-variable 'require-final-newline)
mode-require-final-newline)
(set (make-local-variable 'indent-line-function) 'indent-relative))
@@ -81,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/textmodes/tildify.el b/lisp/textmodes/tildify.el
index b5af00cc450..583e4a4d35d 100644
--- a/lisp/textmodes/tildify.el
+++ b/lisp/textmodes/tildify.el
@@ -1,6 +1,6 @@
;;; tildify.el --- adding hard spaces into texts
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Author: Milan Zamazal <pdm@zamazal.org>
;; Version: 4.5
@@ -51,7 +51,7 @@
(defgroup tildify nil
- "Adding missing hard spaces or other text fragments into texts."
+ "Add hard spaces or other text fragments to text buffers."
:version "21.1"
:group 'wp)
diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el
index de9ac10d0e9..b21e72639fd 100644
--- a/lisp/textmodes/two-column.el
+++ b/lisp/textmodes/two-column.el
@@ -1,6 +1,6 @@
;;; two-column.el --- minor mode for editing of two-column text
-;; Copyright (C) 1992-1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Adapted-By: ESR, Daniel Pfeiffer
@@ -124,15 +124,51 @@
;;; Code:
-
+(defgroup two-column nil
+ "Minor mode for editing of two-column text."
+ :prefix "2C-"
+ :group 'frames)
+
+(defcustom 2C-mode-line-format
+ '("-%*- %15b --" (-3 . "%p") "--%[(" mode-name
+ minor-mode-alist "%n" mode-line-process ")%]%-")
+ "Value of `mode-line-format' for a buffer in two-column minor mode."
+ :type 'sexp
+ :group 'two-column)
+
+(defcustom 2C-other-buffer-hook 'text-mode
+ "Hook run in new buffer when it is associated with current one."
+ :type 'function
+ :group 'two-column)
-;; Lucid patch
-(or (fboundp 'frame-width)
- (fset 'frame-width 'screen-width))
+(defcustom 2C-separator ""
+ "A string inserted between the two columns when merging.
+This gets set locally by \\[2C-split]."
+ :type 'string
+ :group 'two-column)
+(put '2C-separator 'permanent-local t)
+
+(defcustom 2C-window-width 40
+ "The width of the first column. (Must be at least `window-min-width'.)
+This value is local for every buffer that sets it."
+ :type 'integer
+ :group 'two-column)
+(make-variable-buffer-local '2C-window-width)
+(put '2C-window-width 'permanent-local t)
+(defcustom 2C-beyond-fill-column 4
+ "Base for calculating `fill-column' for a buffer in two-column minor mode.
+The value of `fill-column' becomes `2C-window-width' for this buffer
+minus this value."
+ :type 'integer
+ :group 'two-column)
-;;;;; Set up keymap ;;;;;
+(defcustom 2C-autoscroll t
+ "If non-nil, Emacs attempts to keep the two column's buffers aligned."
+ :type 'boolean
+ :group 'two-column)
+
(defvar 2C-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "2" '2C-two-columns)
@@ -142,8 +178,6 @@
map)
"Keymap for commands for setting up two-column mode.")
-
-
;;;###autoload (autoload '2C-command "two-column" () t 'keymap)
(fset '2C-command 2C-mode-map)
@@ -154,7 +188,6 @@
;;;###autoload (global-set-key [f2] '2C-command)
-
(defvar 2C-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "1" '2C-merge)
@@ -167,7 +200,6 @@
map)
"Keymap for commands for use in two-column mode.")
-
(setq minor-mode-map-alist
(cons (cons '2C-mode
(let ((map (make-sparse-keymap)))
@@ -181,15 +213,8 @@
map (current-global-map))
map))
minor-mode-map-alist))
-
-;;;;; variable declarations ;;;;;
-
-(defgroup two-column nil
- "Minor mode for editing of two-column text."
- :prefix "2C-"
- :group 'frames)
-
+
;; Markers seem to be the only buffer-id not affected by renaming a buffer.
;; This nevertheless loses when a buffer is killed. The variable-name is
;; required by `describe-mode'.
@@ -198,62 +223,8 @@
(make-variable-buffer-local '2C-mode)
(put '2C-mode 'permanent-local t)
-
-
(setq minor-mode-alist (cons '(2C-mode " 2C") minor-mode-alist))
-
-
-;; rearranged, so that the pertinent info will show in 40 columns
-(defcustom 2C-mode-line-format
- '("-%*- %15b --" (-3 . "%p") "--%[(" mode-name
- minor-mode-alist "%n" mode-line-process ")%]%-")
- "Value of `mode-line-format' for a buffer in two-column minor mode."
- :type 'sexp
- :group 'two-column)
-
-
-(defcustom 2C-other-buffer-hook 'text-mode
- "Hook run in new buffer when it is associated with current one."
- :type 'function
- :group 'two-column)
-
-
-(defcustom 2C-separator ""
- "A string inserted between the two columns when merging.
-This gets set locally by \\[2C-split]."
- :type 'string
- :group 'two-column)
-(put '2C-separator 'permanent-local t)
-
-
-
-(defcustom 2C-window-width 40
- "The width of the first column. (Must be at least `window-min-width')
-This value is local for every buffer that sets it."
- :type 'integer
- :group 'two-column)
-(make-variable-buffer-local '2C-window-width)
-(put '2C-window-width 'permanent-local t)
-
-
-
-(defcustom 2C-beyond-fill-column 4
- "Base for calculating `fill-column' for a buffer in two-column minor mode.
-The value of `fill-column' becomes `2C-window-width' for this buffer
-minus this value."
- :type 'integer
- :group 'two-column)
-
-
-
-(defcustom 2C-autoscroll t
- "If non-nil, Emacs attempts to keep the two column's buffers aligned."
- :type 'boolean
- :group 'two-column)
-
-
-
(defvar 2C-autoscroll-start nil)
(make-variable-buffer-local '2C-autoscroll-start)
@@ -276,7 +247,6 @@ minus this value."
(if req (error "You must first set two-column minor mode"))))
-
;; function for setting up two-column minor mode in a buffer associated
;; with the buffer pointed to by the marker other.
(defun 2C-mode (other)
@@ -306,8 +276,9 @@ You have the following commands at your disposal:
\\[2C-merge] Merge both buffers
\\[2C-dissociate] Dissociate the two buffers
-These keybindings can be customized in your ~/.emacs by `2C-mode-map',
-`2C-minor-mode-map' and by binding `2C-command' to some prefix.
+These keybindings can be customized in your init file by
+`2C-mode-map', `2C-minor-mode-map' and by binding `2C-command' to
+some prefix.
The appearance of the screen can be customized by the variables
`2C-window-width', `2C-beyond-fill-column', `2C-mode-line-format' and
@@ -320,7 +291,6 @@ The appearance of the screen can be customized by the variables
(run-hooks '2C-mode-hook))
-
;;;###autoload
(defun 2C-two-columns (&optional buffer)
"Split current window vertically for two-column editing.
@@ -356,7 +326,6 @@ first and the associated buffer to its right."
(other-window -1)))))
-
;;;###autoload
(defun 2C-associate-buffer ()
"Associate another buffer with this one in two-column minor mode.
@@ -368,9 +337,8 @@ accepting the proposed default buffer.
(let ((b1 (current-buffer))
(b2 (or (2C-other)
(read-buffer "Associate buffer: " (other-buffer)))))
- (save-excursion
- (setq 2C-mode nil)
- (set-buffer b2)
+ (setq 2C-mode nil)
+ (with-current-buffer b2
(and (2C-other)
(not (eq b1 (2C-other)))
(error "Buffer already associated with buffer `%s'"
@@ -382,7 +350,6 @@ accepting the proposed default buffer.
(2C-two-columns b2)))
-
;;;###autoload
(defun 2C-split (arg)
"Split a two-column text at point, into two buffers in two-column minor mode.
@@ -454,32 +421,28 @@ First column's text sSs Second column's text
(move-to-column column)))))
-
-
(defun 2C-dissociate ()
"Turn off two-column minor mode in current and associated buffer.
If the associated buffer is unmodified and empty, it is killed."
(interactive)
- (let ((buffer (current-buffer)))
- (save-excursion
- (and (2C-other)
- (set-buffer (2C-other))
- (or (not (2C-other))
- (eq buffer (2C-other)))
- (if (and (not (buffer-modified-p))
- (eobp) (bobp))
- (kill-buffer nil)
- (kill-local-variable '2C-mode)
- (kill-local-variable '2C-window-width)
- (kill-local-variable '2C-separator)
- (kill-local-variable 'mode-line-format)
- (kill-local-variable 'fill-column))))
- (kill-local-variable '2C-mode)
- (kill-local-variable '2C-window-width)
- (kill-local-variable '2C-separator)
- (kill-local-variable 'mode-line-format)
- (kill-local-variable 'fill-column)))
-
+ (let ((buffer (current-buffer))
+ (other (2C-other)))
+ (if other
+ (with-current-buffer other
+ (when (or (not (2C-other)) (eq buffer (2C-other)))
+ (if (and (not (buffer-modified-p)) (zerop (buffer-size)))
+ (kill-buffer)
+ (kill-local-variable '2C-mode)
+ (kill-local-variable '2C-window-width)
+ (kill-local-variable '2C-separator)
+ (kill-local-variable 'mode-line-format)
+ (kill-local-variable 'fill-column))))))
+ (kill-local-variable '2C-mode)
+ (kill-local-variable '2C-window-width)
+ (kill-local-variable '2C-separator)
+ (kill-local-variable 'mode-line-format)
+ (kill-local-variable 'fill-column)
+ (force-mode-line-update))
;; this doesn't use yank-rectangle, so that the first column can
@@ -578,7 +541,6 @@ on, this also realigns the two buffers."
(message "Autoscrolling is off.")))
-
(defun 2C-autoscroll ()
(if 2C-autoscroll
;; catch a mouse scroll on non-selected scrollbar
@@ -590,27 +552,25 @@ on, this also realigns the two buffers."
(select-window (car (car (cdr last-command-event)))))
;; In some cases scrolling causes an error, but post-command-hook
;; shouldn't, and should always stay in the original window
- (condition-case ()
- (and (or 2C-autoscroll-start (2C-toggle-autoscroll t) nil)
- (/= (window-start) 2C-autoscroll-start)
- (2C-other)
- (get-buffer-window (2C-other))
- (let ((lines (count-lines (window-start)
- 2C-autoscroll-start)))
- (if (< (window-start) 2C-autoscroll-start)
- (setq lines (- lines)))
- (setq 2C-autoscroll-start (window-start))
- (select-window (get-buffer-window (2C-other)))
- ;; make sure that other buffer has enough lines
- (save-excursion
- (insert-char
- ?\n (- lines (count-lines (window-start)
- (goto-char (point-max)))
- -1)))
- (scroll-up lines)
- (setq 2C-autoscroll-start (window-start))))
- (error))))))
-
+ (ignore-errors
+ (and (or 2C-autoscroll-start (2C-toggle-autoscroll t) nil)
+ (/= (window-start) 2C-autoscroll-start)
+ (2C-other)
+ (get-buffer-window (2C-other))
+ (let ((lines (count-lines (window-start)
+ 2C-autoscroll-start)))
+ (if (< (window-start) 2C-autoscroll-start)
+ (setq lines (- lines)))
+ (setq 2C-autoscroll-start (window-start))
+ (select-window (get-buffer-window (2C-other)))
+ ;; make sure that other buffer has enough lines
+ (save-excursion
+ (insert-char
+ ?\n (- lines (count-lines (window-start)
+ (goto-char (point-max)))
+ -1)))
+ (scroll-up lines)
+ (setq 2C-autoscroll-start (window-start)))))))))
(defun 2C-enlarge-window-horizontally (arg)
@@ -628,7 +588,6 @@ on, this also realigns the two buffers."
(2C-enlarge-window-horizontally (- arg)))
-
(provide 'two-column)
;;; two-column.el ends here
diff --git a/lisp/textmodes/underline.el b/lisp/textmodes/underline.el
index 2adac5a106a..f39ad03e037 100644
--- a/lisp/textmodes/underline.el
+++ b/lisp/textmodes/underline.el
@@ -1,6 +1,6 @@
;;; underline.el --- insert/remove underlining (done by overstriking) in Emacs
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: wp
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index ff63ca34035..50e3b785696 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -1,6 +1,6 @@
;;; thingatpt.el --- get the `thing' at point
-;; Copyright (C) 1991-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
;; Maintainer: FSF
@@ -133,7 +133,7 @@ positions of the thing found."
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
`filename', `url', `email', `word', `sentence', `whitespace',
-`line', and `page'.
+`line', `number', and `page'.
See the file `thingatpt.el' for documentation on how to define
a symbol as a valid THING."
@@ -457,6 +457,7 @@ backwards ARG times if negative."
With prefix argument ARG, do it ARG times if positive, or move
backwards ARG times if negative."
(interactive "p")
+ (or arg (setq arg 1))
(while (< arg 0)
(skip-syntax-backward
(char-to-string (char-syntax (char-before))))
@@ -508,6 +509,7 @@ Signal an error if the entire string was not used."
(defun number-at-point ()
"Return the number at point, or nil if none is found."
(form-at-point 'sexp 'numberp))
+(put 'number 'thing-at-point 'number-at-point)
;;;###autoload
(defun list-at-point ()
"Return the Lisp list at point, or nil if none is found."
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 6ffd256d0a0..67f940c35ec 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -1,6 +1,6 @@
;;; thumbs.el --- Thumbnails previewer for images files
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Jean-Philippe Theberge <jphiltheberge@videotron.ca>
;; Maintainer: FSF
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index fda8cd1438d..c2ac1035dfe 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -1,6 +1,6 @@
;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs
-;; Copyright (C) 1989, 1993-1995, 1997, 2000-2011
+;; Copyright (C) 1989, 1993-1995, 1997, 2000-2012
;; Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -29,7 +29,7 @@
;; static char *ts = "sdmain.c Time-stamp: <2001-08-13 10:20:51 gildea>";
;; See the top of `time-stamp.el' for another example.
-;; To use time-stamping, add this line to your .emacs file:
+;; To use time-stamping, add this line to your init file:
;; (add-hook 'before-save-hook 'time-stamp)
;; Now any time-stamp templates in your files will be updated automatically.
@@ -254,7 +254,7 @@ time-stamped file itself.")
(defun 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
diff --git a/lisp/time.el b/lisp/time.el
index 4955b177545..a3bbee0c893 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -1,6 +1,6 @@
;;; time.el --- display time, load and mail indicator in mode line of Emacs -*-coding: utf-8 -*-
-;; Copyright (C) 1985-1987, 1993-1994, 1996, 2000-2011
+;; Copyright (C) 1985-1987, 1993-1994, 1996, 2000-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -64,13 +64,14 @@ directory `display-time-mail-directory' contains nonempty files."
(defcustom display-time-default-load-average 0
"Which load average value will be shown in the mode line.
-Almost every system can provide values of load for past 1 minute, past 5 or
-past 15 minutes. The default is to display 1 minute load average.
+Almost every system can provide values of load for the past 1 minute,
+past 5 or past 15 minutes. The default is to display 1-minute load average.
The value can be one of:
0 => 1 minute load
1 => 5 minutes load
- 2 => 15 minutes load"
+ 2 => 15 minutes load
+ nil => None (do not display the load average)"
:type '(choice (const :tag "1 minute load" 0)
(const :tag "5 minutes load" 1)
(const :tag "15 minutes load" 2)
@@ -78,7 +79,10 @@ The value can be one of:
:group 'display-time)
(defvar display-time-load-average nil
- "Load average currently being shown in mode line.")
+ "Value of the system's load average currently shown on the mode line.
+See `display-time-default-load-average'.
+
+This is an internal variable; setting it has no effect.")
(defcustom display-time-load-average-threshold 0.1
"Load-average values below this value won't be shown in the mode line."
@@ -202,12 +206,6 @@ a string to display as the label of that TIMEZONE's time."
:type 'integer
:version "23.1")
-(defvar display-time-world-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "q" 'kill-this-buffer)
- map)
- "Keymap of Display Time World mode.")
-
;;;###autoload
(defun display-time ()
"Enable display of time, load level, and mail flag in mode lines.
@@ -349,6 +347,8 @@ would give mode line times like `94/12/30 21:07:48 (UTC)'."
(timer-activate timer)))))
(defun display-time-next-load-average ()
+ "Switch between different load averages in the mode line.
+Switches from the 1 to 5 to 15 minute load average, and then back to 1."
(interactive)
(if (= 3 (setq display-time-load-average (1+ display-time-load-average)))
(setq display-time-load-average 0))
@@ -459,7 +459,7 @@ update which can wait for the next redisplay."
(seconds (substring time 17 19))
(time-zone (car (cdr (current-time-zone now))))
(day (substring time 8 10))
- (year (substring time 20 24))
+ (year (format-time-string "%Y" now))
(monthname (substring time 4 7))
(month
(cdr
@@ -517,7 +517,7 @@ runs the normal hook `display-time-hook' after each update."
'display-time-event-handler)))
-(define-derived-mode display-time-world-mode nil "World clock"
+(define-derived-mode display-time-world-mode special-mode "World clock"
"Major mode for buffer that displays times in various time zones.
See `display-time-world'."
(setq show-trailing-whitespace nil))
@@ -543,8 +543,8 @@ See `display-time-world'."
(setenv "TZ" old-tz))
(setq fmt (concat "%-" (int-to-string max-width) "s %s\n"))
(dolist (timedata (nreverse result))
- (insert (format fmt (car timedata) (cdr timedata)))))
- (delete-char -1))
+ (insert (format fmt (car timedata) (cdr timedata))))
+ (delete-char -1)))
;;;###autoload
(defun display-time-world ()
@@ -556,10 +556,10 @@ To turn off the world time display, go to that window and type `q'."
(not (get-buffer display-time-world-buffer-name)))
(run-at-time t display-time-world-timer-second 'display-time-world-timer))
(with-current-buffer (get-buffer-create display-time-world-buffer-name)
- (display-time-world-display display-time-world-list))
- (pop-to-buffer display-time-world-buffer-name)
- (fit-window-to-buffer)
- (display-time-world-mode))
+ (display-time-world-display display-time-world-list)
+ (display-buffer display-time-world-buffer-name
+ (cons nil '((window-height . fit-window-to-buffer))))
+ (display-time-world-mode)))
(defun display-time-world-timer ()
(if (get-buffer display-time-world-buffer-name)
@@ -569,7 +569,8 @@ To turn off the world time display, go to that window and type `q'."
(let ((list timer-list))
(while list
(let ((elt (pop list)))
- (when (equal (symbol-name (aref elt 5)) "display-time-world-timer")
+ (when (equal (symbol-name (timer--function elt))
+ "display-time-world-timer")
(cancel-timer elt)))))))
;;;###autoload
diff --git a/lisp/timezone.el b/lisp/timezone.el
index 092d491a495..5762f019315 100644
--- a/lisp/timezone.el
+++ b/lisp/timezone.el
@@ -1,6 +1,6 @@
;;; timezone.el --- time zone package for GNU Emacs
-;; Copyright (C) 1990-1993, 1996, 1999, 2001-2011
+;; Copyright (C) 1990-1993, 1996, 1999, 2001-2012
;; Free Software Foundation, Inc.
;; Author: Masanobu Umeda
@@ -51,7 +51,7 @@
("GMT-4" . -400) ("GMT-5" . -500) ("GMT-6" . -600)
("GMT-7" . -700) ("GMT-8" . -800) ("GMT-9" . -900)
("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200))
- "*Time differentials of timezone from GMT in +-HHMM form.
+ "Time differentials of timezone from GMT in +-HHMM form.
This list is obsolescent, and is present only for backwards compatibility,
because time zone names are ambiguous in practice.
Use `current-time-zone' instead.")
diff --git a/lisp/tmm.el b/lisp/tmm.el
index 5722c2c8f79..6c2adf6837a 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -1,6 +1,6 @@
;;; tmm.el --- text mode access to menu-bar
-;; Copyright (C) 1994-1996, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2000-2012 Free Software Foundation, Inc.
;; Author: Ilya Zakharevich <ilya@math.mps.ohio-state.edu>
;; Maintainer: FSF
@@ -165,14 +165,15 @@ Its value should be an event that has a binding in MENU."
;; tmm-km-list is an alist of (STRING . MEANING).
;; It has no other elements.
;; The order of elements in tmm-km-list is the order of the menu bar.
- (mapc (lambda (elt)
- (cond
- ((stringp elt) (setq gl-str elt))
- ((listp elt) (tmm-get-keymap elt not-menu))
- ((vectorp elt)
- (dotimes (i (length elt))
- (tmm-get-keymap (cons i (aref elt i)) not-menu)))))
- menu)
+ (if (not not-menu)
+ (map-keymap (lambda (k v) (tmm-get-keymap (cons k v))) menu)
+ (dolist (elt menu)
+ (cond
+ ((stringp elt) (setq gl-str elt))
+ ((listp elt) (tmm-get-keymap elt not-menu))
+ ((vectorp elt)
+ (dotimes (i (length elt))
+ (tmm-get-keymap (cons i (aref elt i)) not-menu))))))
;; Choose an element of tmm-km-list; put it in choice.
(if (and not-menu (= 1 (length tmm-km-list)))
;; If this is the top-level of an x-popup-menu menu,
@@ -230,8 +231,7 @@ Its value should be an event that has a binding in MENU."
(- (* 2 history-len) index-of-default))))))))
(setq choice (cdr (assoc out tmm-km-list)))
(and (null choice)
- (> (length out) (length tmm-c-prompt))
- (string= (substring out 0 (length tmm-c-prompt)) tmm-c-prompt)
+ (string-prefix-p tmm-c-prompt out)
(setq out (substring out (length tmm-c-prompt))
choice (cdr (assoc out tmm-km-list))))
(and (null choice) out
@@ -313,15 +313,13 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(defun tmm-define-keys (minibuffer)
(let ((map (make-sparse-keymap)))
(suppress-keymap map t)
- (mapc
- (lambda (c)
- (if (listp tmm-shortcut-style)
- (define-key map (char-to-string c) 'tmm-shortcut)
- ;; only one kind of letters are shortcuts, so map both upcase and
- ;; downcase input to the same
- (define-key map (char-to-string (downcase c)) 'tmm-shortcut)
- (define-key map (char-to-string (upcase c)) 'tmm-shortcut)))
- tmm-short-cuts)
+ (dolist (c tmm-short-cuts)
+ (if (listp tmm-shortcut-style)
+ (define-key map (char-to-string c) 'tmm-shortcut)
+ ;; only one kind of letters are shortcuts, so map both upcase and
+ ;; downcase input to the same
+ (define-key map (char-to-string (downcase c)) 'tmm-shortcut)
+ (define-key map (char-to-string (upcase c)) 'tmm-shortcut)))
(if minibuffer
(progn
(define-key map [pageup] 'tmm-goto-completions)
@@ -333,9 +331,9 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(use-local-map (append map (current-local-map))))))
(defun tmm-completion-delete-prompt ()
- (set-buffer standard-output)
+ (with-current-buffer standard-output
(goto-char (point-min))
- (delete-region (point) (search-forward "Possible completions are:\n")))
+ (delete-region (point) (search-forward "Possible completions are:\n"))))
(defun tmm-remove-inactive-mouse-face ()
"Remove the mouse-face property from inactive menu items."
@@ -354,38 +352,24 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(set-buffer-modified-p nil)))
(defun tmm-add-prompt ()
- (add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t)
(unless tmm-c-prompt
(error "No active menu entries"))
(setq tmm-old-mb-map (tmm-define-keys t))
;; Get window and hide it for electric mode to get correct size
- (save-window-excursion
- (let ((completions
- (mapcar 'car minibuffer-completion-table)))
- (or tmm-completion-prompt
- (add-hook 'completion-setup-hook
- 'tmm-completion-delete-prompt 'append))
- (unwind-protect
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list completions))
- (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt)))
- (set-buffer "*Completions*")
+ (or tmm-completion-prompt
+ (add-hook 'completion-setup-hook
+ 'tmm-completion-delete-prompt 'append))
+ (unwind-protect
+ (minibuffer-completion-help)
+ (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt))
+ (with-current-buffer "*Completions*"
(tmm-remove-inactive-mouse-face)
(when tmm-completion-prompt
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- (insert tmm-completion-prompt))))
- (save-selected-window
- (other-window 1) ; Electric-pop-up-window does
- ; not work in minibuffer
- (Electric-pop-up-window "*Completions*"))
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (insert tmm-completion-prompt))))
(insert tmm-c-prompt))
-(defun tmm-delete-map ()
- (remove-hook 'minibuffer-exit-hook 'tmm-delete-map t)
- (if tmm-old-mb-map
- (use-local-map tmm-old-mb-map)))
-
(defun tmm-shortcut ()
"Choose the shortcut that the user typed."
(interactive)
@@ -401,14 +385,13 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(choose-completion))
;; In minibuffer
(delete-region (minibuffer-prompt-end) (point-max))
- (mapc (lambda (elt)
- (if (string=
- (substring (car elt) 0
- (min (1+ (length tmm-mid-prompt))
- (length (car elt))))
- (concat (char-to-string c) tmm-mid-prompt))
- (setq s (car elt))))
- tmm-km-list)
+ (dolist (elt tmm-km-list)
+ (if (string=
+ (substring (car elt) 0
+ (min (1+ (length tmm-mid-prompt))
+ (length (car elt))))
+ (concat (char-to-string c) tmm-mid-prompt))
+ (setq s (car elt))))
(insert s)
(exit-minibuffer)))))
@@ -451,7 +434,7 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
(or (keymapp (cdr-safe (cdr-safe elt)))
(eq (car (cdr-safe (cdr-safe elt))) 'lambda))
(and (symbolp (cdr-safe (cdr-safe elt)))
- (fboundp (cdr-safe (cdr-safe elt)))))
+ (fboundp (cdr-safe (cdr-safe elt)))))
(setq km (cddr elt))
(and (stringp (car elt)) (setq str (car elt))))
@@ -477,14 +460,15 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
(eq (car (cdr-safe (cdr-safe (cdr-safe elt)))) 'lambda))
(and (symbolp (cdr-safe (cdr-safe (cdr-safe elt))))
(fboundp (cdr-safe (cdr-safe (cdr-safe elt))))))
- ; New style of easy-menu
+ ; New style of easy-menu
(setq km (cdr (cddr elt)))
(and (stringp (car elt)) (setq str (car elt))))
((stringp event) ; x-popup or x-popup element
- (if (or in-x-menu (stringp (car-safe elt)))
- (setq str event event nil km elt)
- (setq str event event nil km (cons 'keymap elt)))))
+ (setq str event)
+ (setq event nil)
+ (setq km (if (or in-x-menu (stringp (car-safe elt)))
+ elt (cons 'keymap elt)))))
(unless (or (eq km 'ignore) (null str))
(let ((binding (where-is-internal km nil t)))
(when binding
@@ -524,6 +508,10 @@ of `menu-bar-final-items'."
(progn
;; Otherwise, it is a prefix, so make a list of the subcommands.
;; Make a list of all the bindings in all the keymaps.
+ ;; FIXME: we'd really like to just use `key-binding' now that it
+ ;; returns a keymap that contains really all the bindings under that
+ ;; prefix, but `keyseq' is always [menu-bar], so the desired order of
+ ;; the bindings is difficult to recover.
(setq minorbind (mapcar 'cdr (minor-mode-key-binding keyseq)))
(setq localbind (local-key-binding keyseq))
(setq globalbind (copy-sequence (cdr (global-key-binding keyseq))))
@@ -540,20 +528,16 @@ of `menu-bar-final-items'."
(setq allbind (cons globalbind (cons localbind minorbind)))
;; Merge all the elements of ALLBIND into one keymap.
- (mapc (lambda (in)
- (if (and (symbolp in) (keymapp in))
- (setq in (symbol-function in)))
- (and in (keymapp in)
- (if (keymapp bind)
- (setq bind (nconc bind (copy-sequence (cdr in))))
- (setq bind (copy-sequence in)))))
- allbind)
+ (dolist (in allbind)
+ (if (and (symbolp in) (keymapp in))
+ (setq in (symbol-function in)))
+ (and in (keymapp in)
+ (setq bind (if (keymapp bind)
+ (nconc bind (copy-sequence (cdr in)))
+ (copy-sequence in)))))
;; Return that keymap.
bind))))
-;; Huh? What's that about? --Stef
-(add-hook 'calendar-load-hook (lambda () (require 'cal-menu)))
-
(provide 'tmm)
;;; tmm.el ends here
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 8759e0f77fb..f04cad4463a 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -1,6 +1,6 @@
;;; tool-bar.el --- setting up the tool bar
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: mouse frames
@@ -287,6 +287,7 @@ holds a keymap."
Possible values are `top' (tool bar on top), `bottom' (tool bar at bottom),
`left' (tool bar on left) and `right' (tool bar on right).
Customize `tool-bar-mode' if you want to show or hide the tool bar."
+ :version "24.1"
:type '(choice (const top)
(const bottom)
(const left)
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 59115122c34..a57054acdd6 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -1,6 +1,6 @@
;;; tooltip.el --- show tooltip windows
-;; Copyright (C) 1997, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999-2012 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@acm.org>
;; Keywords: help c mouse tools
@@ -25,6 +25,8 @@
;;; Code:
+(require 'syntax)
+
(defvar comint-prompt-regexp)
(defgroup tooltip nil
@@ -39,18 +41,17 @@
;;; Switching tooltips on/off
(define-minor-mode tooltip-mode
- "Toggle use of graphical tooltips (Tooltip mode).
-With a prefix argument ARG, enable Tooltip mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-it if ARG is omitted or nil.
-
-When Tooltip mode is enabled, Emacs displays help text in a
-pop-up window for buttons and menu items that you put the mouse
-on. \(However, if `tooltip-use-echo-area' is non-nil, this and
-all pop-up help appears in the echo area.)
-
-When Tooltip mode is disabled, Emacs displays one line of
-the help text in the echo area, and does not make a pop-up window."
+ "Toggle Tooltip mode.
+With a prefix argument ARG, enable Tooltip mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
+
+When this global minor mode is enabled, Emacs displays help
+text (e.g. for buttons and menu items that you put the mouse on)
+in a pop-up window.
+
+When Tooltip mode is disabled, Emacs displays help text in the
+echo area, instead of making a pop-up window."
:global t
;; Even if we start on a text-only terminal, make this non-nil by
;; default because we can open a graphical frame later (multi-tty).
@@ -144,14 +145,19 @@ of the `tooltip' face are used instead."
(defcustom tooltip-use-echo-area nil
"Use the echo area instead of tooltip frames for help and GUD tooltips.
-To display multi-line help text in the echo area, set this to t
-and enable `tooltip-mode'."
+This variable is obsolete; instead of setting it to t, disable
+`tooltip-mode' (which has a similar effect)."
:type 'boolean
:group 'tooltip)
+(make-obsolete-variable 'tooltip-use-echo-area
+ "disable Tooltip mode instead" "24.1")
+
;;; Variables that are not customizable.
+(define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1")
+
(defvar tooltip-functions nil
"Functions to call to display tooltips.
Each function is called with one argument EVENT which is a copy
@@ -159,8 +165,6 @@ of the last mouse movement event that occurred. If one of these
functions displays the tooltip, it should return non-nil and the
rest are not called.")
-(define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1")
-
(defvar tooltip-timeout-id nil
"The id of the timeout started when Emacs becomes idle.")
@@ -275,8 +279,11 @@ Value is nil if no identifier exists at point. Identifier extraction
is based on the current syntax table."
(save-excursion
(goto-char point)
- (let ((start (progn (skip-syntax-backward "w_") (point))))
- (unless (looking-at "[0-9]")
+ (let* ((start (progn (skip-syntax-backward "w_") (point)))
+ (pstate (syntax-ppss)))
+ (unless (or (looking-at "[0-9]")
+ (nth 3 pstate)
+ (nth 4 pstate))
(skip-syntax-forward "w_")
(when (> (point) start)
(buffer-substring start (point)))))))
diff --git a/lisp/tree-widget.el b/lisp/tree-widget.el
index c5aa1f330af..0dd0203e098 100644
--- a/lisp/tree-widget.el
+++ b/lisp/tree-widget.el
@@ -1,6 +1,6 @@
;;; tree-widget.el --- Tree widget
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -115,7 +115,6 @@
;;
;;; Code:
-(eval-when-compile (require 'cl))
(require 'wid-edit)
;;; Customization
diff --git a/lisp/tutorial.el b/lisp/tutorial.el
index 2e651484008..6f76068ea9d 100644
--- a/lisp/tutorial.el
+++ b/lisp/tutorial.el
@@ -1,6 +1,6 @@
;;; tutorial.el --- tutorial for Emacs
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help, internal
@@ -585,7 +585,6 @@ with some explanatory links."
(not (get-text-property (match-beginning 1) 'tutorial-remark))
(let* ((desc (car changed-key))
(ck (cdr changed-key))
- (key (nth 0 ck))
(def-fun (nth 1 ck))
(where (nth 3 ck))
s1 s2 help-string)
@@ -724,7 +723,7 @@ See `tutorial--save-tutorial' for more information."
saved-file
(error-message-string err))))
;; An error is raised here?? Is this a bug?
- (condition-case err
+ (condition-case nil
(undo-only)
(error nil))
;; Restore point
@@ -766,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))
@@ -830,8 +828,11 @@ Run the Viper tutorial? "))
(if old-tut-file
(progn
(insert-file-contents (tutorial--saved-file))
- (let ((enable-local-variables :safe))
+ (let ((enable-local-variables :safe)
+ (enable-local-eval nil))
(hack-local-variables))
+ ;; FIXME? What we actually want is to ignore dir-locals (?).
+ (setq buffer-read-only nil) ; bug#11118
(goto-char (point-min))
(setq old-tut-point
(string-to-number
@@ -847,8 +848,11 @@ Run the Viper tutorial? "))
(goto-char tutorial--point-before-chkeys)
(setq tutorial--point-before-chkeys (point-marker)))
(insert-file-contents (expand-file-name filename tutorial-directory))
- (let ((enable-local-variables :safe))
+ (let ((enable-local-variables :safe)
+ (enable-local-eval nil))
(hack-local-variables))
+ ;; FIXME? What we actually want is to ignore dir-locals (?).
+ (setq buffer-read-only nil) ; bug#11118
(forward-line)
(setq tutorial--point-before-chkeys (point-marker)))
diff --git a/lisp/type-break.el b/lisp/type-break.el
index da3129ec576..949b3b720a0 100644
--- a/lisp/type-break.el
+++ b/lisp/type-break.el
@@ -1,6 +1,6 @@
-;;; 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-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Noah Friedman
;; Maintainer: Noah Friedman <friedman@splode.com>
@@ -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)
@@ -241,7 +226,7 @@ remove themselves after running.")
(""
type-break-mode-line-break-message
type-break-mode-line-warning))
- "*Format of messages in the mode line concerning typing breaks.")
+ "Format of messages in the mode line concerning typing breaks.")
(defvar type-break-mode-line-break-message
'(type-break-mode-line-break-message-p
@@ -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.
@@ -577,7 +549,6 @@ as per the function `type-break-schedule'."
(unless type-break-terse-messages
(message "Press any key to resume from typing break."))
- (random t)
(let* ((len (length type-break-demo-functions))
(idx (random len))
(fn (nth idx type-break-demo-functions)))
@@ -998,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/uniquify.el b/lisp/uniquify.el
index 3153e143ba3..2b4794c9cc2 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -1,6 +1,6 @@
;;; uniquify.el --- unique buffer names dependent on file name -*- lexical-binding: t -*-
-;; Copyright (C) 1989, 1995-1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1995-1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Dick King <king@reasoning.com>
;; Maintainer: FSF
@@ -83,7 +83,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; User-visible variables
@@ -174,7 +174,7 @@ contains the name of the directory which the buffer is visiting.")
;;; Utilities
;; uniquify-fix-list data structure
-(defstruct (uniquify-item
+(cl-defstruct (uniquify-item
(:constructor nil) (:copier nil)
(:constructor uniquify-make-item
(base dirname buffer &optional proposed)))
@@ -183,10 +183,9 @@ contains the name of the directory which the buffer is visiting.")
;; Internal variables used free
(defvar uniquify-possibly-resolvable nil)
-(defvar uniquify-managed nil
+(defvar-local uniquify-managed nil
"Non-nil if the name of this buffer is managed by uniquify.
It actually holds the list of `uniquify-item's corresponding to the conflict.")
-(make-variable-buffer-local 'uniquify-managed)
(put 'uniquify-managed 'permanent-local t)
;; Used in desktop.el to save the non-uniquified buffer name
@@ -340,7 +339,7 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
(defun uniquify-get-proposed-name (base dirname &optional depth)
(unless depth (setq depth uniquify-min-dir-content))
- (assert (equal (directory-file-name dirname) dirname)) ;No trailing slash.
+ (cl-assert (equal (directory-file-name dirname) dirname)) ;No trailing slash.
;; Distinguish directories by adding extra separator.
(if (and uniquify-trailing-separator-p
@@ -464,27 +463,34 @@ For use on `kill-buffer-hook'."
;; rename-buffer and create-file-buffer. (Setting find-file-hook isn't
;; sufficient.)
-(defadvice rename-buffer (after rename-buffer-uniquify activate)
+(advice-add 'rename-buffer :around #'uniquify--rename-buffer-advice)
+(defun uniquify--rename-buffer-advice (rb-fun newname &optional unique &rest args)
"Uniquify buffer names with parts of directory name."
+ (let ((retval (apply rb-fun newname unique args)))
(uniquify-maybe-rerationalize-w/o-cb)
- (if (null (ad-get-arg 1)) ; no UNIQUE argument.
+ (if (null unique)
;; Mark this buffer so it won't be renamed by uniquify.
(setq uniquify-managed nil)
(when uniquify-buffer-name-style
;; Rerationalize w.r.t the new name.
(uniquify-rationalize-file-buffer-names
- (ad-get-arg 0)
+ newname
(uniquify-buffer-file-name (current-buffer))
(current-buffer))
- (setq ad-return-value (buffer-name (current-buffer))))))
+ (setq retval (buffer-name (current-buffer)))))
+ retval))
-(defadvice create-file-buffer (after create-file-buffer-uniquify activate)
+
+(advice-add 'create-file-buffer :around #'uniquify--create-file-buffer-advice)
+(defun uniquify--create-file-buffer-advice (cfb-fun filename &rest args)
"Uniquify buffer names with parts of directory name."
+ (let ((retval (apply cfb-fun filename args)))
(if uniquify-buffer-name-style
- (let ((filename (expand-file-name (directory-file-name (ad-get-arg 0)))))
+ (let ((filename (expand-file-name (directory-file-name filename))))
(uniquify-rationalize-file-buffer-names
(file-name-nondirectory filename)
- (file-name-directory filename) ad-return-value))))
+ (file-name-directory filename) retval)))
+ retval))
;;; The End
@@ -496,9 +502,8 @@ For use on `kill-buffer-hook'."
(set-buffer buf)
(when uniquify-managed
(push (cons buf (uniquify-item-base (car uniquify-managed))) buffers)))
- (dolist (fun '(rename-buffer create-file-buffer))
- (ad-remove-advice fun 'after (intern (concat (symbol-name fun) "-uniquify")))
- (ad-update fun))
+ (advice-remove 'rename-buffer #'uniquify--rename-buffer-advice)
+ (advice-remove 'create-file-buffer #'uniquify--create-file-buffer-advice)
(dolist (buf buffers)
(set-buffer (car buf))
(rename-buffer (cdr buf) t))))
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index db28770ad0e..59222bcc957 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,288 @@
+2012-10-13 Liam Stitt <stittl@cuug.ab.ca> (tiny change)
+
+ * url-vars.el (url-uncompressor-alist):
+ * url-file.el (url-file-find-possibly-compressed-file, url-file):
+ Recognize .xz compression (Bug#11839).
+
+2012-10-13 Chong Yidong <cyd@gnu.org>
+
+ * url-http.el (url-http):
+ * url.el (url-retrieve-internal): Doc fix (Bug#6407).
+
+2012-10-08 Glenn Morris <rgm@gnu.org>
+
+ * url-methods.el (url-scheme-get-property): url-https.el was
+ merged into url-http.el, so load the latter for https. (Bug#12599)
+
+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
+ (bug#11981).
+
+2012-08-12 David Engster <deng@randomsample.de>
+
+ * url-util.el (url-file-directory, url-file-nondirectory): Avoid
+ file-name-directory and file-name-nondirectory internally (bug#11981).
+
+2012-08-11 Jason Rumney <jasonr@gnu.org>
+
+ * url-http.el (url-http-create-request): Use url-http-proxy to
+ look up proxy credentials (Bug#12069).
+
+2012-07-28 David Engster <deng@randomsample.de>
+
+ * url-dav.el (url-dav-supported-p): Add doc-string and remove
+ check for feature `xml' and function `xml-expand-namespace' which
+ never existed in Emacs proper.
+ (url-dav-process-response): Remove all indentation and newlines
+ from XML before parsing. Change call to `xml-parse-region' to do
+ namespace expansion with simple qualified names (Bug#11916).
+ (url-dav-request): Add autoload.
+ (url-dav-directory-files): Properly deal with empty directories.
+ Unhex URL before generating relative URLs.
+ (url-dav-file-directory-p): Fix check for 'DAV:collection.
+
+2012-07-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * url.el, url-queue.el, url-parse.el, url-http.el, url-future.el:
+ * url-dav.el, url-cookie.el: Use cl-lib.
+ * url-util.el, url-privacy.el, url-nfs.el, url-misc.el, url-methods.el:
+ * url-gw.el, url-file.el, url-expand.el: Dont use CL.
+
+2012-06-30 Glenn Morris <rgm@gnu.org>
+
+ * url-vars.el (mm-mime-mule-charset-alist, mm-coding-system-p):
+ Declare.
+
+2012-06-21 Chong Yidong <cyd@gnu.org>
+
+ * url.el (url-retrieve-internal): Fix last change (Bug#11627).
+
+2012-06-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * url-handlers.el (url-handler-regexp): Declare.
+
+2012-06-12 Chong Yidong <cyd@gnu.org>
+
+ * url-handlers.el: Re-order file to avoid recursive load.
+
+2012-06-12 Chong Yidong <cyd@gnu.org>
+
+ * url-handlers.el (url-handler-regexp):
+ * url-nfs.el (url-nfs-automounter-directory-spec):
+ * url-vars.el (url-load-hook): Convert to defcustom.
+
+2012-05-25 Leo Liu <sdl.web@gmail.com>
+
+ * url-http.el (url-http-codes): Fix mal-formed defconst.
+
+2012-05-15 Ian Eure <ian@simplegeo.com>
+
+ * url-util.el (url-build-query-string): New function (Bug#8706).
+ (url-parse-query-string): Allow that '=' is not required and split
+ URL parameters on ';', not just '&'.
+
+2012-05-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-expand.el (url-default-expander): Copy over the fullness of
+ the new URL object based on the definition URL object.
+
+2012-05-10 Chong Yidong <cyd@gnu.org>
+
+ * url-parse.el (url-path-and-query, url-port-if-non-default):
+ New functions.
+ (url-generic-parse-url): Don't set the portspec slot if it is not
+ specified; that is what `url-port' is for.
+ (url-port): Only require the scheme to be specified to call
+ url-scheme-get-property.
+
+ * url-util.el (url-encode-url): Use url-path-and-query.
+
+ * url-vars.el (url-mime-charset-string): Load mm-util lazily.
+
+2012-05-09 Chong Yidong <cyd@gnu.org>
+
+ * url-util.el (url-encode-url): New function for URL quoting.
+ (url-encoding-table, url-host-allowed-chars)
+ (url-path-allowed-chars): New constants.
+ (url--allowed-chars): New helper function. Use upper-case.
+ (url-hexify-string): Use them.
+
+ * url-parse.el: Improve RFC 3986 conformance.
+ (url-generic-parse-url): Do not populate the ATTRIBUTES slot,
+ since this is not reliable for general RFC 3986 URIs. Keep the
+ whole path and query inside the FILENAME slot. Improve docstring.
+ (url-recreate-url-attributes): Mark as obsolete.
+ (url-recreate-url): Handle missing scheme and userinfo.
+ (url-path-and-query): New function.
+
+ * url-http.el (url-http-create-request): Ignore obsolete
+ attributes slot of url-object.
+
+ * url-vars.el (url-nonrelative-link): Make the regexp stricter.
+
+ * url.el (url-retrieve-internal): Use url-encode-url (Bug#7017).
+
+2012-04-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * url.el (url-retrieve-synchronously): Replace lexical-let by
+ lexical-binding.
+
+2012-04-10 William Xu <william.xwl@gmail.com> (tiny change)
+
+ * url.el (url-retrieve-internal): Hexify multibye URL string first
+ when necessary (bug#7017).
+
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url.el (url-retrieve-internal): Mention utf-8 encoding.
+ (url-retrieve): Ditto.
+
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-domsurf.el: New file (bug#1401).
+
+ * url-cookie.el (url-cookie-two-dot-domains): Remove.
+ (url-cookie-host-can-set-p): Use `url-domsuf-cookie-allowed-p'
+ instead of the variable above.
+
+2012-03-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-queue.el (url-queue-kill-job): Check whether the buffer has
+ been killed asynchronously before selecting it.
+
+2012-03-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-queue.el (url-queue-kill-job): Make sure that the callback
+ is always called, even if we have a timeout.
+
+2012-03-11 Chong Yidong <cyd@gnu.org>
+
+ * url-http.el (url-http-end-of-document-sentinel):
+ Handle keepalive expiry by calling url-http again (Bug#10223).
+ (url-http): New arg, for the above.
+
+2012-03-11 Devon Sean McCullough <emacs-hacker2012@jovi.net>
+
+ * url-http.el (url-http-find-free-connection): Don't pass a nil
+ argument to url-http-mark-connection-as-busy (bug#10891).
+
+2012-02-20 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * url-queue.el (url-queue-kill-job): Delete the process sentinel
+ before killing the process to avoid a race condition between the
+ two processes killing off the process buffer.
+
+ * url.el (url-retrieve-internal): Warn about file errors when
+ pruning the cache instead of bugging out (bug#10831).
+
+2012-02-19 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * url-queue.el (url-queue-callback-function): Remove the job from
+ the queue so that we don't kill the current buffer, which will
+ then make the callback function kill a random buffer.
+
+2012-02-14 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * url-queue.el (url-queue-kill-job): Refactored out code.
+ (url-queue-remove-jobs-from-host): Use it to kill jobs that are in
+ flight.
+
+2012-02-14 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * url-future.el: Minor doc update.
+
+2012-02-14 Leo Liu <sdl.web@gmail.com>
+
+ * url-future.el: Fix last change.
+
+2012-02-13 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * url-future.el (url-future-test): Move to test/automated.
+
+2012-02-10 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * url-http.el (url-http-parse-headers): When redirecting, pass on
+ the `inhibit-cookie' parameter.
+
+2012-02-10 Glenn Morris <rgm@gnu.org>
+
+ * url-queue.el (url-queue-retrieve): Fic previous doc fix.
+
+2012-02-10 Andreas Schwab <schwab@linux-m68k.org>
+
+ * url-http.el (url-http-clean-headers): Return the number of
+ removed characters.
+ (url-http-wait-for-headers-change-function): Adjust end position
+ after cleaning the headers. (Bug#10768)
+
+2012-02-10 Glenn Morris <rgm@gnu.org>
+
+ * url-queue.el (url-queue-retrieve): Doc fix.
+
+2012-02-08 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * url-parse.el (url): Add the `use-cookies' slot to the URL struct
+ to be able to keep track of whether to do cookies or not on a
+ per-URL basis.
+
+ * url-queue.el (url-queue-retrieve): Take an optional
+ `inhibit-cookies' parameter.
+
+ * url.el (url-retrieve): Ditto.
+
+ * url-http.el (url-http-create-request): Don't send cookies unless
+ requested.
+ (url-http-parse-headers): Don't store cookies unless requested.
+
+2012-02-06 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * url-cache.el (url-cache-prune-cache): New function.
+ (url-cache-prune-cache): Check that the directory exists before
+ trying to delete it.
+
+ * url.el (url-retrieve-number-of-calls): New variable.
+ (url-retrieve-internal): Use it to expire the cache once in a
+ while.
+
+ * url-queue.el (url-queue-setup-runners): New function that uses
+ `run-with-idle-timer' for extra asynchronicity.
+ (url-queue-remove-jobs-from-host): New function.
+ (url-queue-callback-function): Remove jobs from the same host if
+ connection failed.
+
+2012-01-12 Glenn Morris <rgm@gnu.org>
+
+ * url-auth.el (url-basic-auth, url-digest-auth):
+ Allow reading usernames etc when the minibuffer is already in use,
+ eg in url-handler-mode. (Bug#10298)
+
2011-11-15 Juanma Barranquero <lekktu@gmail.com>
* url-dav.el (url-dav-delete-file): Fix typo.
@@ -51,8 +336,8 @@
2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * url-http.el (url-http-wait-for-headers-change-function): Remove
- pointless "HTTP/0.9 How I hate thee!" message (bug#6735).
+ * url-http.el (url-http-wait-for-headers-change-function):
+ Remove pointless "HTTP/0.9 How I hate thee!" message (bug#6735).
2011-06-04 Andreas Schwab <schwab@linux-m68k.org>
@@ -80,16 +365,15 @@
2011-05-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
* url-queue.el: New file.
- (url-queue-run-queue): Pick the first waiting job, and not the
- last.
+ (url-queue-run-queue): Pick the first waiting job, and not the last.
(url-queue-parallel-processes): Lower the concurrency level, since
Emacs doesn't seem to like too many async processes.
(url-queue-prune-old-entries): Fix up the pruning code.
2011-04-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * url-http.el (url-http-wait-for-headers-change-function): Protect
- against malformed headerless responses from servers.
+ * url-http.el (url-http-wait-for-headers-change-function):
+ Protect against malformed headerless responses from servers.
2011-04-02 Chong Yidong <cyd@stupidchicken.com>
@@ -117,9 +401,9 @@
2011-02-03 Lars Ingebrigtsen <larsi@gnus.org>
- * url-http.el (url-http-wait-for-headers-change-function): Don't
- move point if the callback function has moved changed/killed the
- process buffer.
+ * url-http.el (url-http-wait-for-headers-change-function):
+ Don't move point if the callback function has moved/changed/killed
+ the process buffer.
2010-12-16 Miles Bader <miles@gnu.org>
@@ -192,8 +476,8 @@
2010-10-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * url-cookie.el (url-cookie-handle-set-cookie): Use
- url-lazy-message for the cookie warning, which isn't very interesting.
+ * url-cookie.el (url-cookie-handle-set-cookie): Use url-lazy-message
+ for the cookie warning, which isn't very interesting.
* url-http.el (url-http-async-sentinel): Check that the buffer is
still alive before switching to it.
@@ -259,13 +543,13 @@
2010-07-01 Mark A. Hershberger <mah@everybody.org>
* url-http.el (url-http-create-request): Add a CRLF on the end so
- that POSTs with content to https urls work.
+ that POSTs with content to https URLs work.
See <https://bugs.launchpad.net/mediawiki-el/+bug/540759>
2010-06-22 Mark A. Hershberger <mah@everybody.org>
* url-parse.el (url-user-for-url, url-password-for-url):
- Convenience functions that get usernames and passwords for urls
+ Convenience functions that get usernames and passwords for URLs
from auth-source functions.
2010-06-12 Štěpán Němec <stepnem@gmail.com> (tiny change)
@@ -2500,7 +2784,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1999, 2001-2002, 2004-2011 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2001-2002, 2004-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el
index b6f54db038e..d2a750f08d7 100644
--- a/lisp/url/url-about.el
+++ b/lisp/url/url-about.el
@@ -1,6 +1,6 @@
;;; url-about.el --- Show internal URLs
-;; Copyright (C) 2001, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 5261302a15c..f7e53eafb44 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -1,6 +1,6 @@
;;; url-auth.el --- Uniform Resource Locator authorization modules
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -69,6 +69,7 @@ instead of the filename inheritance method."
(file (url-filename href))
(user (url-user href))
(pass (url-password href))
+ (enable-recursive-minibuffers t) ; for url-handler-mode (bug#10298)
byserv retval data)
(setq server (format "%s:%d" server port)
file (cond
@@ -163,6 +164,7 @@ instead of hostname:portnum."
(type (url-type href))
(port (url-port href))
(file (url-filename href))
+ (enable-recursive-minibuffers t)
user pass byserv retval data)
(setq file (cond
(realm realm)
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 80d77020456..6559de4deb7 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -1,6 +1,6 @@
;;; url-cache.el --- Uniform Resource Locator retrieval tool
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -209,6 +209,34 @@ If `url-standalone-mode' is non-nil, cached items never expire."
(seconds-to-time (or expire-time url-cache-expire-time)))
(current-time))))))
+(defun url-cache-prune-cache (&optional directory)
+ "Remove all expired files from the cache.
+`url-cache-expire-time' says how old a file has to be to be
+considered \"expired\"."
+ (let ((current-time (current-time))
+ (total-files 0)
+ (deleted-files 0))
+ (setq directory (or directory url-cache-directory))
+ (when (file-exists-p directory)
+ (dolist (file (directory-files directory t))
+ (unless (member (file-name-nondirectory file) '("." ".."))
+ (setq total-files (1+ total-files))
+ (cond
+ ((file-directory-p file)
+ (when (url-cache-prune-cache file)
+ (setq deleted-files (1+ deleted-files))))
+ ((time-less-p
+ (time-add
+ (nth 5 (file-attributes file))
+ (seconds-to-time url-cache-expire-time))
+ current-time)
+ (delete-file file)
+ (setq deleted-files (1+ deleted-files))))))
+ (if (< deleted-files total-files)
+ nil
+ (delete-directory directory)
+ t))))
+
(provide 'url-cache)
;;; url-cache.el ends here
diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el
index a5371a423e0..4909872b386 100644
--- a/lisp/url/url-cid.el
+++ b/lisp/url/url-cid.el
@@ -1,6 +1,6 @@
;;; url-cid.el --- Content-ID URL loader
-;; Copyright (C) 1998-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 746a4dc77b5..84200d1d41b 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -1,6 +1,6 @@
;;; url-cookie.el --- URL cookie support
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -25,8 +25,9 @@
(require 'url-util)
(require 'url-parse)
+(require 'url-domsuf)
-(eval-when-compile (require 'cl)) ; defstruct
+(eval-when-compile (require 'cl-lib))
(defgroup url-cookie nil
"URL cookies."
@@ -37,7 +38,7 @@
;; A cookie is stored internally as a vector of 7 slots
;; [ url-cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ]
-(defstruct (url-cookie
+(cl-defstruct (url-cookie
(:constructor url-cookie-create)
(:copier nil)
(:type vector)
@@ -211,14 +212,6 @@ telling Microsoft that."
(concat retval "\r\n")
"")))
-(defvar url-cookie-two-dot-domains
- (concat "\\.\\("
- (mapconcat 'identity (list "com" "edu" "net" "org" "gov" "mil" "int")
- "\\|")
- "\\)$")
- "A regexp of top level domains that only require two matching
-'.'s in the domain name in order to set a cookie.")
-
(defcustom url-cookie-trusted-urls nil
"A list of regular expressions matching URLs to always accept cookies from."
:type '(repeat regexp)
@@ -230,30 +223,18 @@ telling Microsoft that."
:group 'url-cookie)
(defun url-cookie-host-can-set-p (host domain)
- (let ((numdots 0)
- (last nil)
- (case-fold-search t)
- (mindots 3))
- (while (setq last (string-match "\\." domain last))
- (setq numdots (1+ numdots)
- last (1+ last)))
- (if (string-match url-cookie-two-dot-domains domain)
- (setq mindots 2))
- (cond
- ((string= host domain) ; Apparently netscape lets you do this
- t)
- ((>= numdots mindots) ; We have enough dots in domain name
- ;; Need to check and make sure the host is actually _in_ the
- ;; domain it wants to set a cookie for though.
- (string-match (concat (regexp-quote
- ;; Remove the dot from wildcard domains
- ;; before matching.
- (if (eq ?. (aref domain 0))
- (substring domain 1)
- domain))
- "$") host))
- (t
- nil))))
+ (let ((last nil)
+ (case-fold-search t))
+ (if (string= host domain) ; Apparently netscape lets you do this
+ t
+ ;; Remove the dot from wildcard domains before matching.
+ (when (eq ?. (aref domain 0))
+ (setq domain (substring domain 1)))
+ (and (url-domsuf-cookie-allowed-p domain)
+ ;; Need to check and make sure the host is actually _in_ the
+ ;; domain it wants to set a cookie for though.
+ (string-match (concat (regexp-quote domain)
+ "$") host)))))
(defun url-cookie-handle-set-cookie (str)
(setq url-cookies-changed-since-last-save t)
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index 0e3713c9fcc..4bb03369b9b 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -1,6 +1,6 @@
;;; url-dav.el --- WebDAV support
-;; Copyright (C) 2001, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2004-2012 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Maintainer: Bill Perry <wmperry@gnu.org>
@@ -27,8 +27,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'xml)
(require 'url-util)
@@ -37,6 +36,10 @@
(defvar url-dav-supported-protocols '(1 2)
"List of supported DAV versions.")
+(defvar url-http-content-type)
+(defvar url-http-response-status)
+(defvar url-http-end-of-headers)
+
(defun url-intersection (l1 l2)
"Return a list of the elements occurring in both of the lists L1 and L2."
(if (null l2)
@@ -50,10 +53,10 @@
;;;###autoload
(defun url-dav-supported-p (url)
- (and (featurep 'xml)
- (fboundp 'xml-expand-namespace)
- (url-intersection url-dav-supported-protocols
- (plist-get (url-http-options url) 'dav))))
+ "Return WebDAV protocol version supported by URL.
+Returns nil if WebDAV is not supported."
+ (url-intersection url-dav-supported-protocols
+ (plist-get (url-http-options url) 'dav)))
(defun url-dav-node-text (node)
"Return the text data from the XML node NODE."
@@ -198,25 +201,25 @@
"unknown"))
value nil)
- (case node-type
- ((dateTime.iso8601tz
- dateTime.iso8601
- dateTime.tz
- dateTime.rfc1123
- dateTime
- date) ; date is our 'special' one...
+ (pcase node-type
+ ((or `dateTime.iso8601tz
+ `dateTime.iso8601
+ `dateTime.tz
+ `dateTime.rfc1123
+ `dateTime
+ `date) ; date is our 'special' one...
;; Some type of date/time string.
(setq value (url-dav-process-date-property node)))
- (int
+ (`int
;; Integer type...
(setq value (url-dav-process-integer-property node)))
- ((number float)
+ ((or `number `float)
(setq value (url-dav-process-number-property node)))
- (boolean
+ (`boolean
(setq value (url-dav-process-boolean-property node)))
- (uri
+ (`uri
(setq value (url-dav-process-uri-property node)))
- (otherwise
+ (_
(if (not (eq node-type 'unknown))
(url-debug 'dav "Unknown data type in url-dav-process-prop: %s"
node-type))
@@ -377,15 +380,17 @@
The buffer must have been retrieved by HTTP or HTTPS and contain an
XML document."
- (declare (special url-http-content-type
- url-http-response-status
- url-http-end-of-headers))
(let ((tree nil)
(overall-status nil))
(when buffer
(unwind-protect
(with-current-buffer buffer
+ ;; First remove all indentation and line endings
(goto-char url-http-end-of-headers)
+ (indent-rigidly (point) (point-max) -1000)
+ (save-excursion
+ (while (re-search-forward "\r?\n" nil t)
+ (replace-match "")))
(setq overall-status url-http-response-status)
;; XML documents can be transferred as either text/xml or
@@ -395,7 +400,7 @@ XML document."
url-http-content-type
(string-match "\\`\\(text\\|application\\)/xml"
url-http-content-type))
- (setq tree (xml-parse-region (point) (point-max)))))
+ (setq tree (xml-parse-region (point) (point-max) nil nil 'symbol-qnames))))
;; Clean up after ourselves.
(kill-buffer buffer)))
@@ -411,6 +416,7 @@ XML document."
;; nobody but us needs to know the difference.
(list (cons url properties))))))
+;;;###autoload
(defun url-dav-request (url method tag body
&optional depth headers namespaces)
"Perform WebDAV operation METHOD on URL. Return the parsed responses.
@@ -478,7 +484,7 @@ names (ie: DAV:resourcetype)."
;;; Locking support
(defvar url-dav-lock-identifier (concat "mailto:" user-mail-address)
- "*URL used as contact information when creating locks in DAV.
+ "URL used as contact information when creating locks in DAV.
This will be used as the contents of the DAV:owner/DAV:href tag to
identify the owner of a LOCK when requesting it. This will be shown
to other users when the DAV:lockdiscovery property is requested, so
@@ -561,7 +567,6 @@ FAILURE-RESULTS is a list of (URL STATUS)."
(defun url-dav-unlock-resource (url lock-token)
"Release the lock on URL represented by LOCK-TOKEN.
Returns t if the lock was successfully released."
- (declare (special url-http-response-status))
(let* ((url-request-extra-headers (list (cons "Lock-Token"
(concat "<" lock-token ">"))))
(url-request-method "UNLOCK")
@@ -603,16 +608,16 @@ Returns t if the lock was successfully released."
(while supported-locks
(setq lock (car supported-locks)
supported-locks (cdr supported-locks))
- (case (car lock)
- (DAV:write
- (case (cdr lock)
- (DAV:shared ; group permissions (possibly world)
+ (pcase (car lock)
+ (`DAV:write
+ (pcase (cdr lock)
+ (`DAV:shared ; group permissions (possibly world)
(aset modes 5 ?w))
- (DAV:exclusive
+ (`DAV:exclusive
(aset modes 2 ?w)) ; owner permissions?
- (otherwise
+ (_
(url-debug 'dav "Unrecognized DAV:lockscope (%S)" (cdr lock)))))
- (otherwise
+ (_
(url-debug 'dav "Unrecognized DAV:locktype (%S)" (car lock)))))
modes))
@@ -674,7 +679,6 @@ Returns t if the lock was successfully released."
"Save OBJ as URL using WebDAV.
URL must be a fully qualified URL.
OBJ may be a buffer or a string."
- (declare (special url-http-response-status))
(let ((buffer nil)
(result nil)
(url-request-extra-headers nil)
@@ -770,8 +774,8 @@ files in the collection as well."
(defun url-dav-directory-files (url &optional full match nosort files-only)
"Return a list of names of files in URL.
There are three optional arguments:
-If FULL is non-nil, return absolute file names. Otherwise return names
- that are relative to the specified directory.
+If FULL is non-nil, return absolute URLs. Otherwise return names
+ that are relative to the specified URL.
If MATCH is non-nil, mention only file names that match the regexp MATCH.
If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
NOSORT is useful if you plan to sort the result yourself."
@@ -781,8 +785,9 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
(files nil)
(parsed-url (url-generic-parse-url url)))
- (if (= (length properties) 1)
- (signal 'file-error (list "Opening directory" "not a directory" url)))
+ (when (and (= (length properties) 1)
+ (not (url-dav-file-directory-p url)))
+ (signal 'file-error (list "Opening directory" "not a directory" url)))
(while properties
(setq child-props (pop properties)
@@ -796,7 +801,9 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
;; are not supposed to return fully-qualified names.
(setq child-url (url-expand-file-name child-url parsed-url))
(if (not full)
- (setq child-url (substring child-url (length url))))
+ ;; Parts of the URL might be hex'ed.
+ (setq child-url (substring (url-unhex-string child-url)
+ (length url))))
;; We don't want '/' as the last character in filenames...
(if (string-match "/$" child-url)
@@ -816,11 +823,11 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
(defun url-dav-file-directory-p (url)
"Return t if URL names an existing DAV collection."
(let ((properties (cdar (url-dav-get-properties url '(DAV:resourcetype)))))
- (eq (plist-get properties 'DAV:resourcetype) 'DAV:collection)))
+ (when (member 'DAV:collection (plist-get properties 'DAV:resourcetype))
+ t)))
(defun url-dav-make-directory (url &optional parents)
"Create the directory DIR and any nonexistent parent dirs."
- (declare (special url-http-response-status))
(let* ((url-request-extra-headers nil)
(url-request-method "MKCOL")
(url-request-data nil)
@@ -829,7 +836,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
(when buffer
(unwind-protect
(with-current-buffer buffer
- (case url-http-response-status
+ (pcase url-http-response-status
(201 ; Collection created in its entirety
(setq result t))
(403 ; Forbidden
@@ -842,7 +849,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
nil)
(507 ; Insufficient storage
nil)
- (otherwise
+ (_
nil)))
(kill-buffer buffer)))
result))
@@ -924,7 +931,7 @@ Returns nil if URL contains no name starting with FILE."
(setq failed t)))
(if failed
(setq searching nil)
- (incf n)))
+ (cl-incf n)))
(substring (car matches) 0 n))))))
(defun url-dav-register-handler (op)
diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el
index bb29fecb655..f04e7901ef7 100644
--- a/lisp/url/url-dired.el
+++ b/lisp/url/url-dired.el
@@ -1,6 +1,6 @@
;;; url-dired.el --- URL Dired minor mode
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, files
@@ -43,7 +43,10 @@
(url-dired-find-file))
(define-minor-mode url-dired-minor-mode
- "Minor mode for directory browsing."
+ "Minor mode for directory browsing.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
:lighter " URL" :keymap url-dired-minor-mode-map)
(defun url-find-file-dired (dir)
diff --git a/lisp/url/url-domsuf.el b/lisp/url/url-domsuf.el
new file mode 100644
index 00000000000..29fc166e30b
--- /dev/null
+++ b/lisp/url/url-domsuf.el
@@ -0,0 +1,98 @@
+;;; url-domsuf.el --- Say what domain names can have cookies set.
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+;; Keywords: comm, data, processes, hypermedia
+
+;; 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:
+
+;; The rules for what domains can have cookies set is defined here:
+;; http://publicsuffix.org/list/
+
+;;; Code:
+
+(defvar url-domsuf-domains nil)
+
+(defun url-domsuf-parse-file ()
+ (with-temp-buffer
+ (insert-file-contents
+ (expand-file-name "publicsuffix.txt" data-directory))
+ (let ((domains nil)
+ domain exception)
+ (while (not (eobp))
+ (when (not (looking-at "[/\n\t ]"))
+ ;; !pref.aichi.jp means that it's allowed.
+ (if (not (eq (following-char) ?!))
+ (setq exception nil)
+ (setq exception t)
+ (forward-char 1))
+ (setq domain (buffer-substring (point) (line-end-position)))
+ (cond
+ ((string-match "\\`\\*\\." domain)
+ (setq domain (substring domain 2))
+ (push (cons domain (1+ (length (split-string domain "[.]"))))
+ domains))
+ (exception
+ (push (cons domain t) domains))
+ (t
+ (push (cons domain nil) domains))))
+ (forward-line 1))
+ (setq url-domsuf-domains (nreverse domains)))))
+
+(defun url-domsuf-cookie-allowed-p (domain)
+ (unless url-domsuf-domains
+ (url-domsuf-parse-file))
+ (let* ((allowedp t)
+ (domain-bits (split-string domain "[.]"))
+ (length (length domain-bits))
+ (upper-domain (mapconcat 'identity (cdr domain-bits) "."))
+ entry modifier)
+ (dolist (elem url-domsuf-domains)
+ (setq entry (car elem)
+ modifier (cdr elem))
+ (cond
+ ;; "com"
+ ((and (null modifier)
+ (string= domain entry))
+ (setq allowedp nil))
+ ;; "!pref.hokkaido.jp"
+ ((and (eq modifier t)
+ (string= domain entry))
+ (setq allowedp t))
+ ;; "*.ar"
+ ((and (numberp modifier)
+ (= length modifier)
+ (string= entry upper-domain))
+ (setq allowedp nil))))
+ allowedp))
+
+;; Tests:
+
+;; (url-domsuf-cookie-allowed-p "com") => nil
+;; (url-domsuf-cookie-allowed-p "foo.bar.ar") => t
+;; (url-domsuf-cookie-allowed-p "bar.ar") => nil
+;; (url-domsuf-cookie-allowed-p "co.uk") => nil
+;; (url-domsuf-cookie-allowed-p "foo.bar.hokkaido.jo") => t
+;; (url-domsuf-cookie-allowed-p "bar.hokkaido.jp") => nil
+;; (url-domsuf-cookie-allowed-p "pref.hokkaido.jp") => t
+
+(provide 'url-domsuf)
+
+;;; url-domsuf.el ends here
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el
index 1781c362959..4bf13f4abe3 100644
--- a/lisp/url/url-expand.el
+++ b/lisp/url/url-expand.el
@@ -1,6 +1,6 @@
;;; url-expand.el --- expand-file-name for URLs
-;; Copyright (C) 1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -24,7 +24,6 @@
(require 'url-methods)
(require 'url-util)
(require 'url-parse)
-(eval-when-compile (require 'cl))
(defun url-expander-remove-relative-links (name)
;; Strip . and .. from pathnames
@@ -116,13 +115,17 @@ path components followed by `..' are removed, along with the `..' itself."
(setf (url-port urlobj) (or (url-port urlobj)
(and (string= (url-type urlobj)
(url-type defobj))
- (url-port defobj))))
+ (url-port defobj))))
(if (not (string= "file" (url-type urlobj)))
(setf (url-host urlobj) (or (url-host urlobj) (url-host defobj))))
(if (string= "ftp" (url-type urlobj))
(setf (url-user urlobj) (or (url-user urlobj) (url-user defobj))))
(if (string= (url-filename urlobj) "")
(setf (url-filename urlobj) "/"))
+ ;; If the object we're expanding from is full, then we are now
+ ;; full.
+ (unless (url-fullness urlobj)
+ (setf (url-fullness urlobj) (url-fullness defobj)))
(if (string-match "^/" (url-filename urlobj))
nil
(let ((query nil)
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 28fb59cd112..59aaccbe074 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -1,6 +1,6 @@
;;; url-file.el --- File retrieval code
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -23,7 +23,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'mailcap)
(require 'url-vars)
(require 'url-parse)
@@ -41,7 +40,7 @@ can do automatic decompression for them, and won't find 'foo' if
'foo.gz' exists, even though the FTP server would happily serve it up
to them."
(let ((scratch nil)
- (compressed-extensions '("" ".gz" ".z" ".Z" ".bz2"))
+ (compressed-extensions '("" ".gz" ".z" ".Z" ".bz2" ".xz"))
(found nil))
(while (and compressed-extensions (not found))
(if (file-exists-p (setq scratch (concat fname (pop compressed-extensions))))
@@ -167,18 +166,21 @@ to them."
(or filename (error "File does not exist: %s" (url-recreate-url url)))
;; Need to figure out the content-type from the real extension,
;; not the compressed one.
+ ;; FIXME should this regexp not include more extensions; basically
+ ;; everything that url-file-find-possibly-compressed-file does?
(setq uncompressed-filename (if (string-match "\\.\\(gz\\|Z\\|z\\)$" filename)
(substring filename 0 (match-beginning 0))
filename))
(setq content-type (mailcap-extension-to-mime
(url-file-extension uncompressed-filename))
- content-encoding (case (intern (url-file-extension filename))
- ((\.z \.gz) "gzip")
- (\.Z "compress")
- (\.uue "x-uuencoded")
- (\.hqx "x-hqx")
- (\.bz2 "x-bzip2")
- (otherwise nil)))
+ content-encoding (pcase (url-file-extension filename)
+ ((or ".z" ".gz") "gzip")
+ (".Z" "compress")
+ (".uue" "x-uuencoded")
+ (".hqx" "x-hqx")
+ (".bz2" "x-bzip2")
+ (".xz" "x-xz")
+ (_ nil)))
(if (file-directory-p filename)
;; A directory is done the same whether we are local or remote
diff --git a/lisp/url/url-ftp.el b/lisp/url/url-ftp.el
index 670094d80ca..824ea14c739 100644
--- a/lisp/url/url-ftp.el
+++ b/lisp/url/url-ftp.el
@@ -1,6 +1,6 @@
;;; url-ftp.el --- FTP wrapper
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el
index 8a2c112715c..db074807e1b 100644
--- a/lisp/url/url-future.el
+++ b/lisp/url/url-future.el
@@ -1,6 +1,6 @@
;;; url-future.el --- general futures facility for url.el
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: data
@@ -36,14 +36,13 @@
;; So, to get the value:
;; (when (url-future-completed-p future) (url-future-value future))
-;; See the ERT tests and the code for further details.
+;; See `url-future-tests' and the code below for further details.
;;; Code:
-(eval-when-compile (require 'cl))
-(eval-when-compile (require 'ert))
+(eval-when-compile (require 'cl-lib))
-(defstruct url-future callback errorback status value)
+(cl-defstruct url-future callback errorback status value)
(defmacro url-future-done-p (url-future)
`(url-future-status ,url-future))
@@ -95,32 +94,5 @@
(signal 'error 'url-future-already-done)
(url-future-finish url-future 'cancel)))
-(ert-deftest url-future-test ()
- (let* (saver
- (text "running future")
- (good (make-url-future :value (lambda () (format text))
- :callback (lambda (f) (set 'saver f))))
- (bad (make-url-future :value (lambda () (/ 1 0))
- :errorback (lambda (&rest d) (set 'saver d))))
- (tocancel (make-url-future :value (lambda () (/ 1 0))
- :callback (lambda (f) (set 'saver f))
- :errorback (lambda (&rest d)
- (set 'saver d)))))
- (should (equal good (url-future-call good)))
- (should (equal good saver))
- (should (equal text (url-future-value good)))
- (should (url-future-completed-p good))
- (should-error (url-future-call good))
- (setq saver nil)
- (should (equal bad (url-future-call bad)))
- (should-error (url-future-call bad))
- (should (equal saver (list bad '(arith-error))))
- (should (url-future-errored-p bad))
- (setq saver nil)
- (should (equal (url-future-cancel tocancel) tocancel))
- (should-error (url-future-call tocancel))
- (should (null saver))
- (should (url-future-cancelled-p tocancel))))
-
(provide 'url-future)
;;; url-future.el ends here
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index a3a384b7a90..c475fb05c9c 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -1,6 +1,6 @@
;;; url-gw.el --- Gateway munging for URL loading
-;; Copyright (C) 1997-1998, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2004-2012 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: comm, data, processes
@@ -22,7 +22,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'url-vars)
;; Fixme: support SSH explicitly or via a url-gateway-rlogin-program?
@@ -233,8 +232,8 @@ Might do a non-blocking connection; use `process-status' to check."
;; right coding systems in both Emacs and XEmacs.
(let ((coding-system-for-read 'binary)
(coding-system-for-write 'binary))
- (setq conn (case gw-method
- ((tls ssl native)
+ (setq conn (pcase gw-method
+ ((or `tls `ssl `native)
(if (eq gw-method 'native)
(setq gw-method 'plain))
(open-network-stream
@@ -243,13 +242,13 @@ Might do a non-blocking connection; use `process-status' to check."
;; Use non-blocking socket if we can.
:nowait (featurep 'make-network-process
'(:nowait t))))
- (socks
+ (`socks
(socks-open-network-stream name buffer host service))
- (telnet
+ (`telnet
(url-open-telnet name buffer host service))
- (rlogin
+ (`rlogin
(url-open-rlogin name buffer host service))
- (otherwise
+ (_
(error "Bad setting of url-gateway-method: %s"
url-gateway-method))))))
conn)))
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index d5f7eb7dd36..796980afbd5 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -1,6 +1,6 @@
;;; url-handlers.el --- file-name-handler stuff for URL loading
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -90,13 +90,7 @@
;; verify-visited-file-modtime
;; write-region
-(defvar url-handler-regexp
- "\\`\\(https?\\|ftp\\|file\\|nfs\\)://"
- "*A regular expression for matching URLs handled by `file-name-handler-alist'.
-Some valid URL protocols just do not make sense to visit interactively
-\(about, data, info, irc, mailto, etc\). This regular expression
-avoids conflicts with local files that look like URLs \(Gnus is
-particularly bad at this\).")
+(defvar url-handler-regexp) ; defined below to avoid recursive load (revno:108572)
;;;###autoload
(define-minor-mode url-handler-mode
@@ -105,16 +99,31 @@ With a prefix argument ARG, enable URL Handler mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil."
:global t :group 'url
- (if (not (boundp 'file-name-handler-alist))
- ;; Can't be turned ON anyway.
- (setq url-handler-mode nil)
- ;; Remove old entry, if any.
- (setq file-name-handler-alist
- (delq (rassq 'url-file-handler file-name-handler-alist)
- file-name-handler-alist))
- (if url-handler-mode
- (push (cons url-handler-regexp 'url-file-handler)
- file-name-handler-alist))))
+ ;; Remove old entry, if any.
+ (setq file-name-handler-alist
+ (delq (rassq 'url-file-handler file-name-handler-alist)
+ file-name-handler-alist))
+ (if url-handler-mode
+ (push (cons url-handler-regexp 'url-file-handler)
+ file-name-handler-alist)))
+
+(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\)://"
+ "Regular expression for URLs handled by `url-handler-mode'.
+When URL Handler mode is enabled, this regular expression is
+added to `file-name-handler-alist'.
+
+Some valid URL protocols just do not make sense to visit
+interactively \(about, data, info, irc, mailto, etc\). This
+regular expression avoids conflicts with local files that look
+like URLs \(Gnus is particularly bad at this\)."
+ :group 'url
+ :type 'regexp
+ :set (lambda (symbol value)
+ (let ((enable url-handler-mode))
+ (url-handler-mode 0)
+ (set-default symbol value)
+ (if enable
+ (url-handler-mode)))))
(defun url-run-real-handler (operation args)
(let ((inhibit-file-name-handlers (cons 'url-file-handler
@@ -128,11 +137,13 @@ the mode if ARG is omitted or nil."
"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
@@ -240,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)
@@ -249,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.
@@ -291,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-history.el b/lisp/url/url-history.el
index 3827f9a5d41..68c7d39adef 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -1,6 +1,6 @@
;;; url-history.el --- Global history tracking for URL package
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 9b9bdb6416e..73d53e08c59 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1,6 +1,6 @@
;;; url-http.el --- HTTP retrieval routines
-;; Copyright (C) 1999, 2001, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2004-2012 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: comm, data, processes
@@ -24,11 +24,32 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+
+(defvar url-callback-arguments)
+(defvar url-callback-function)
+(defvar url-current-object)
+(defvar url-http-after-change-function)
+(defvar url-http-chunked-counter)
+(defvar url-http-chunked-length)
+(defvar url-http-chunked-start)
+(defvar url-http-connection-opened)
+(defvar url-http-content-length)
+(defvar url-http-content-type)
+(defvar url-http-data)
+(defvar url-http-end-of-headers)
(defvar url-http-extra-headers)
-(defvar url-http-target-url)
+(defvar url-http-method)
+(defvar url-http-no-retry)
+(defvar url-http-process)
(defvar url-http-proxy)
-(defvar url-http-connection-opened)
+(defvar url-http-response-status)
+(defvar url-http-response-version)
+(defvar url-http-target-url)
+(defvar url-http-transfer-encoding)
+(defvar url-http-end-of-headers)
+(defvar url-show-status)
+
(require 'url-gw)
(require 'url-util)
(require 'url-parse)
@@ -109,8 +130,8 @@ request.")
(503 service-unavailable "Service unavailable")
(504 gateway-timeout "Gateway time-out")
(505 http-version-not-supported "HTTP version not supported")
- (507 insufficient-storage "Insufficient storage")
-"The HTTP return codes and their text."))
+ (507 insufficient-storage "Insufficient storage"))
+ "The HTTP return codes and their text.")
;(eval-when-compile
;; These are all macros so that they are hidden from external sight
@@ -153,38 +174,40 @@ request.")
(defun url-http-find-free-connection (host port)
(let ((conns (gethash (cons host port) url-http-open-connections))
- (found nil))
- (while (and conns (not found))
+ (connection nil))
+ (while (and conns (not connection))
(if (not (memq (process-status (car conns)) '(run open connect)))
(progn
(url-http-debug "Cleaning up dead process: %s:%d %S"
host port (car conns))
(url-http-idle-sentinel (car conns) nil))
- (setq found (car conns))
- (url-http-debug "Found existing connection: %s:%d %S" host port found))
+ (setq connection (car conns))
+ (url-http-debug "Found existing connection: %s:%d %S" host port connection))
(pop conns))
- (if found
+ (if connection
(url-http-debug "Reusing existing connection: %s:%d" host port)
(url-http-debug "Contacting host: %s:%d" host port))
(url-lazy-message "Contacting host: %s:%d" host port)
- (url-http-mark-connection-as-busy
- host port
- (or found
- (let ((buf (generate-new-buffer " *url-http-temp*")))
- ;; `url-open-stream' needs a buffer in which to do things
- ;; like authentication. But we use another buffer afterwards.
- (unwind-protect
- (let ((proc (url-open-stream host buf host port)))
- ;; url-open-stream might return nil.
- (when (processp proc)
- ;; Drop the temp buffer link before killing the buffer.
- (set-process-buffer proc nil))
- proc)
- ;; If there was an error on connect, make sure we don't
- ;; get queried.
- (when (get-buffer-process buf)
- (set-process-query-on-exit-flag (get-buffer-process buf) nil))
- (kill-buffer buf)))))))
+
+ (unless connection
+ (let ((buf (generate-new-buffer " *url-http-temp*")))
+ ;; `url-open-stream' needs a buffer in which to do things
+ ;; like authentication. But we use another buffer afterwards.
+ (unwind-protect
+ (let ((proc (url-open-stream host buf host port)))
+ ;; url-open-stream might return nil.
+ (when (processp proc)
+ ;; Drop the temp buffer link before killing the buffer.
+ (set-process-buffer proc nil)
+ (setq connection proc)))
+ ;; If there was an error on connect, make sure we don't
+ ;; get queried.
+ (when (get-buffer-process buf)
+ (set-process-query-on-exit-flag (get-buffer-process buf) nil))
+ (kill-buffer buf))))
+
+ (if connection
+ (url-http-mark-connection-as-busy host port connection))))
;; Building an HTTP request
(defun url-http-user-agent-string ()
@@ -192,23 +215,14 @@ 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."
- (declare (special proxy-info
- url-http-method url-http-data
- url-http-extra-headers))
(let* ((extra-headers)
(request nil)
(no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers)))
@@ -219,9 +233,8 @@ request.")
nil
(let ((url-basic-auth-storage
'url-http-proxy-basic-auth-storage))
- (url-get-authentication url-http-target-url nil 'any nil))))
- (real-fname (concat (url-filename url-http-target-url)
- (url-recreate-url-attributes url-http-target-url)))
+ (url-get-authentication url-http-proxy nil 'any nil))))
+ (real-fname (url-filename url-http-target-url))
(host (url-host url-http-target-url))
(auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers))
nil
@@ -320,8 +333,10 @@ request.")
;; Authorization
auth
;; Cookies
- (url-cookie-generate-header-lines host real-fname
- (equal "https" (url-type url-http-target-url)))
+ (when (url-use-cookies url-http-target-url)
+ (url-cookie-generate-header-lines
+ host real-fname
+ (equal "https" (url-type url-http-target-url))))
;; If-modified-since
(if (and (not no-cache)
(member url-http-method '("GET" nil)))
@@ -352,15 +367,18 @@ request.")
;; Parsing routines
(defun url-http-clean-headers ()
"Remove trailing \r from header lines.
-This allows us to use `mail-fetch-field', etc."
- (declare (special url-http-end-of-headers))
- (goto-char (point-min))
- (while (re-search-forward "\r$" url-http-end-of-headers t)
- (replace-match "")))
+This allows us to use `mail-fetch-field', etc.
+Return the number of characters removed."
+ (let ((end (marker-position url-http-end-of-headers)))
+ (goto-char (point-min))
+ (while (re-search-forward "\r$" url-http-end-of-headers t)
+ (replace-match ""))
+ (- end url-http-end-of-headers)))
+
+(defvar status)
+(defvar success)
(defun url-http-handle-authentication (proxy)
- (declare (special status success url-http-method url-http-data
- url-callback-function url-callback-arguments))
(url-http-debug "Handling %s authentication" (if proxy "proxy" "normal"))
(let ((auths (or (nreverse
(mail-fetch-field
@@ -420,8 +438,6 @@ This allows us to use `mail-fetch-field', etc."
(defun url-http-parse-response ()
"Parse just the response code."
- (declare (special url-http-end-of-headers url-http-response-status
- url-http-response-version))
(if (not url-http-end-of-headers)
(error "Trying to parse HTTP response code in odd buffer: %s" (buffer-name)))
(url-http-debug "url-http-parse-response called in (%s)" (buffer-name))
@@ -456,11 +472,6 @@ Return t if and only if the current buffer is still active and
should be shown to the user."
;; The comments after each status code handled are taken from RFC
;; 2616 (HTTP/1.1)
- (declare (special url-http-end-of-headers url-http-response-status
- url-http-response-version
- url-http-method url-http-data url-http-process
- url-callback-function url-callback-arguments))
-
(url-http-mark-connection-as-free (url-host url-current-object)
(url-port url-current-object)
url-http-process)
@@ -491,16 +502,14 @@ should be shown to the user."
(class nil)
(success nil)
;; other status symbols: jewelry and luxury cars
- (status-symbol (cadr (assq url-http-response-status url-http-codes)))
- ;; The filename part of a URL could be in remote file syntax,
- ;; see Bug#6717 for an example. We disable file name
- ;; handlers, therefore.
- (file-name-handler-alist nil))
+ (status-symbol (cadr (assq url-http-response-status url-http-codes))))
(setq class (/ url-http-response-status 100))
- (url-http-debug "Parsed HTTP headers: class=%d status=%d" class url-http-response-status)
- (url-http-handle-cookies)
+ (url-http-debug "Parsed HTTP headers: class=%d status=%d"
+ class url-http-response-status)
+ (when (url-use-cookies url-http-target-url)
+ (url-http-handle-cookies))
- (case class
+ (pcase class
;; Classes of response codes
;;
;; 5xx = Server Error
@@ -513,7 +522,8 @@ should be shown to the user."
;; 101 = Switching protocols
;; 102 = Processing (Added by DAV)
(url-mark-buffer-as-dead buffer)
- (error "HTTP responses in class 1xx not supported (%d)" url-http-response-status))
+ (error "HTTP responses in class 1xx not supported (%d)"
+ url-http-response-status))
(2 ; Success
;; 200 Ok
;; 201 Created
@@ -523,12 +533,12 @@ should be shown to the user."
;; 205 Reset content
;; 206 Partial content
;; 207 Multi-status (Added by DAV)
- (case status-symbol
- ((no-content reset-content)
+ (pcase status-symbol
+ ((or `no-content `reset-content)
;; No new data, just stay at the same document
(url-mark-buffer-as-dead buffer)
(setq success t))
- (otherwise
+ (_
;; Generic success for all others. Store in the cache, and
;; mark it as successful.
(widen)
@@ -545,8 +555,8 @@ should be shown to the user."
;; 307 Temporary redirect
(let ((redirect-uri (or (mail-fetch-field "Location")
(mail-fetch-field "URI"))))
- (case status-symbol
- (multiple-choices ; 300
+ (pcase status-symbol
+ (`multiple-choices ; 300
;; Quoth the spec (section 10.3.1)
;; -------------------------------
;; The requested resource corresponds to any one of a set of
@@ -563,7 +573,7 @@ should be shown to the user."
;; We do not support agent-driven negotiation, so we just
;; redirect to the preferred URI if one is provided.
nil)
- ((moved-permanently found temporary-redirect) ; 301 302 307
+ ((or `moved-permanently `found `temporary-redirect) ; 301 302 307
;; If the 301|302 status code is received in response to a
;; request other than GET or HEAD, the user agent MUST NOT
;; automatically redirect the request unless it can be
@@ -571,20 +581,20 @@ should be shown to the user."
;; conditions under which the request was issued.
(unless (member url-http-method '("HEAD" "GET"))
(setq redirect-uri nil)))
- (see-other ; 303
+ (`see-other ; 303
;; The response to the request can be found under a different
;; URI and SHOULD be retrieved using a GET method on that
;; resource.
(setq url-http-method "GET"
url-http-data nil))
- (not-modified ; 304
+ (`not-modified ; 304
;; The 304 response MUST NOT contain a message-body.
(url-http-debug "Extracting document from cache... (%s)"
(url-cache-create-filename (url-view-url t)))
(url-cache-extract (url-cache-create-filename (url-view-url t)))
(setq redirect-uri nil
success t))
- (use-proxy ; 305
+ (`use-proxy ; 305
;; The requested resource MUST be accessed through the
;; proxy given by the Location field. The Location field
;; gives the URI of the proxy. The recipient is expected
@@ -592,7 +602,7 @@ should be shown to the user."
;; responses MUST only be generated by origin servers.
(error "Redirection thru a proxy server not supported: %s"
redirect-uri))
- (otherwise
+ (_
;; Treat everything like '300'
nil))
(when redirect-uri
@@ -641,7 +651,8 @@ should be shown to the user."
(url-retrieve-internal
redirect-uri url-callback-function
url-callback-arguments
- (url-silent url-current-object)))
+ (url-silent url-current-object)
+ (not (url-use-cookies url-current-object))))
(url-mark-buffer-as-dead buffer))
;; We hit url-max-redirections, so issue an error and
;; stop redirecting.
@@ -673,51 +684,51 @@ should be shown to the user."
;; 422 Unprocessable Entity (Added by DAV)
;; 423 Locked
;; 424 Failed Dependency
- (case status-symbol
- (unauthorized ; 401
+ (pcase status-symbol
+ (`unauthorized ; 401
;; The request requires user authentication. The response
;; MUST include a WWW-Authenticate header field containing a
;; challenge applicable to the requested resource. The
;; client MAY repeat the request with a suitable
;; Authorization header field.
(url-http-handle-authentication nil))
- (payment-required ; 402
+ (`payment-required ; 402
;; This code is reserved for future use
(url-mark-buffer-as-dead buffer)
(error "Somebody wants you to give them money"))
- (forbidden ; 403
+ (`forbidden ; 403
;; The server understood the request, but is refusing to
;; fulfill it. Authorization will not help and the request
;; SHOULD NOT be repeated.
(setq success t))
- (not-found ; 404
+ (`not-found ; 404
;; Not found
(setq success t))
- (method-not-allowed ; 405
+ (`method-not-allowed ; 405
;; The method specified in the Request-Line is not allowed
;; for the resource identified by the Request-URI. The
;; response MUST include an Allow header containing a list of
;; valid methods for the requested resource.
(setq success t))
- (not-acceptable ; 406
+ (`not-acceptable ; 406
;; The resource identified by the request is only capable of
;; generating response entities which have content
;; characteristics not acceptable according to the accept
;; headers sent in the request.
(setq success t))
- (proxy-authentication-required ; 407
+ (`proxy-authentication-required ; 407
;; This code is similar to 401 (Unauthorized), but indicates
;; that the client must first authenticate itself with the
;; proxy. The proxy MUST return a Proxy-Authenticate header
;; field containing a challenge applicable to the proxy for
;; the requested resource.
(url-http-handle-authentication t))
- (request-timeout ; 408
+ (`request-timeout ; 408
;; The client did not produce a request within the time that
;; the server was prepared to wait. The client MAY repeat
;; the request without modifications at any later time.
(setq success t))
- (conflict ; 409
+ (`conflict ; 409
;; The request could not be completed due to a conflict with
;; the current state of the resource. This code is only
;; allowed in situations where it is expected that the user
@@ -726,11 +737,11 @@ should be shown to the user."
;; information for the user to recognize the source of the
;; conflict.
(setq success t))
- (gone ; 410
+ (`gone ; 410
;; The requested resource is no longer available at the
;; server and no forwarding address is known.
(setq success t))
- (length-required ; 411
+ (`length-required ; 411
;; The server refuses to accept the request without a defined
;; Content-Length. The client MAY repeat the request if it
;; adds a valid Content-Length header field containing the
@@ -740,35 +751,35 @@ should be shown to the user."
;; `url-http-create-request' automatically calculates the
;; content-length.
(setq success t))
- (precondition-failed ; 412
+ (`precondition-failed ; 412
;; The precondition given in one or more of the
;; request-header fields evaluated to false when it was
;; tested on the server.
(setq success t))
- ((request-entity-too-large request-uri-too-large) ; 413 414
+ ((or `request-entity-too-large `request-uri-too-large) ; 413 414
;; The server is refusing to process a request because the
;; request entity|URI is larger than the server is willing or
;; able to process.
(setq success t))
- (unsupported-media-type ; 415
+ (`unsupported-media-type ; 415
;; The server is refusing to service the request because the
;; entity of the request is in a format not supported by the
;; requested resource for the requested method.
(setq success t))
- (requested-range-not-satisfiable ; 416
+ (`requested-range-not-satisfiable ; 416
;; A server SHOULD return a response with this status code if
;; a request included a Range request-header field, and none
;; of the range-specifier values in this field overlap the
;; current extent of the selected resource, and the request
;; did not include an If-Range request-header field.
(setq success t))
- (expectation-failed ; 417
+ (`expectation-failed ; 417
;; The expectation given in an Expect request-header field
;; could not be met by this server, or, if the server is a
;; proxy, the server has unambiguous evidence that the
;; request could not be met by the next-hop server.
(setq success t))
- (otherwise
+ (_
;; The request could not be understood by the server due to
;; malformed syntax. The client SHOULD NOT repeat the
;; request without modifications.
@@ -788,17 +799,17 @@ should be shown to the user."
;; 505 HTTP version not supported
;; 507 Insufficient storage
(setq success t)
- (case url-http-response-status
- (not-implemented ; 501
+ (pcase url-http-response-status
+ (`not-implemented ; 501
;; The server does not support the functionality required to
;; fulfill the request.
nil)
- (bad-gateway ; 502
+ (`bad-gateway ; 502
;; The server, while acting as a gateway or proxy, received
;; an invalid response from the upstream server it accessed
;; in attempting to fulfill the request.
nil)
- (service-unavailable ; 503
+ (`service-unavailable ; 503
;; The server is currently unable to handle the request due
;; to a temporary overloading or maintenance of the server.
;; The implication is that this is a temporary condition
@@ -807,19 +818,19 @@ should be shown to the user."
;; header. If no Retry-After is given, the client SHOULD
;; handle the response as it would for a 500 response.
nil)
- (gateway-timeout ; 504
+ (`gateway-timeout ; 504
;; The server, while acting as a gateway or proxy, did not
;; receive a timely response from the upstream server
;; specified by the URI (e.g. HTTP, FTP, LDAP) or some other
;; auxiliary server (e.g. DNS) it needed to access in
;; attempting to complete the request.
nil)
- (http-version-not-supported ; 505
+ (`http-version-not-supported ; 505
;; The server does not support, or refuses to support, the
;; HTTP protocol version that was used in the request
;; message.
nil)
- (insufficient-storage ; 507 (DAV)
+ (`insufficient-storage ; 507 (DAV)
;; The method could not be performed on the resource
;; because the server is unable to store the representation
;; needed to successfully complete the request. This
@@ -834,7 +845,7 @@ should be shown to the user."
(setf (car url-callback-arguments)
(nconc (list :error (list 'error 'http url-http-response-status))
(car url-callback-arguments)))))
- (otherwise
+ (_
(error "Unknown class of HTTP response code: %d (%d)"
class url-http-response-status)))
(if (not success)
@@ -846,9 +857,6 @@ should be shown to the user."
;; Miscellaneous
(defun url-http-activate-callback ()
"Activate callback specified when this buffer was created."
- (declare (special url-http-process
- url-callback-function
- url-callback-arguments))
(url-http-mark-connection-as-free (url-host url-current-object)
(url-port url-current-object)
url-http-process)
@@ -866,24 +874,30 @@ should be shown to the user."
url-http-open-connections))
(defun url-http-end-of-document-sentinel (proc why)
- ;; Sentinel used for old HTTP/0.9 or connections we know are going
- ;; to die as the 'end of document' notifier.
+ ;; Sentinel used to handle (i) terminated old HTTP/0.9 connections,
+ ;; and (ii) closed connection due to reusing a HTTP connection which
+ ;; we believed was still alive, but which the server closed on us.
+ ;; We handle case (ii) by calling `url-http' again.
(url-http-debug "url-http-end-of-document-sentinel in buffer (%s)"
(process-buffer proc))
(url-http-idle-sentinel proc why)
(when (buffer-name (process-buffer proc))
(with-current-buffer (process-buffer proc)
(goto-char (point-min))
- (if (not (looking-at "HTTP/"))
- ;; HTTP/0.9 just gets passed back no matter what
- (url-http-activate-callback)
- (if (url-http-parse-headers)
- (url-http-activate-callback))))))
+ (cond ((not (looking-at "HTTP/"))
+ (if url-http-no-retry
+ ;; HTTP/0.9 just gets passed back no matter what
+ (url-http-activate-callback)
+ ;; Call `url-http' again if our connection expired.
+ (erase-buffer)
+ (url-http url-current-object url-callback-function
+ url-callback-arguments (current-buffer))))
+ ((url-http-parse-headers)
+ (url-http-activate-callback))))))
(defun url-http-simple-after-change-function (st nd length)
;; Function used when we do NOT know how long the document is going to be
;; Just _very_ simple 'downloaded %d' type of info.
- (declare (special url-http-end-of-headers))
(url-lazy-message "Reading %s..." (url-pretty-length nd)))
(defun url-http-content-length-after-change-function (st nd length)
@@ -891,11 +905,6 @@ should be shown to the user."
More sophisticated percentage downloaded, etc.
Also does minimal parsing of HTTP headers and will actually cause
the callback to be triggered."
- (declare (special url-current-object
- url-http-end-of-headers
- url-http-content-length
- url-http-content-type
- url-http-process))
(if url-http-content-type
(url-display-percentage
"Reading [%s]... %s of %s (%d%%)"
@@ -928,12 +937,6 @@ the callback to be triggered."
Cannot give a sophisticated percentage, but we need a different
function to look for the special 0-length chunk that signifies
the end of the document."
- (declare (special url-current-object
- url-http-end-of-headers
- url-http-content-type
- url-http-chunked-length
- url-http-chunked-counter
- url-http-process url-http-chunked-start))
(save-excursion
(goto-char st)
(let ((read-next-chunk t)
@@ -1019,17 +1022,6 @@ the end of the document."
(defun url-http-wait-for-headers-change-function (st nd length)
;; This will wait for the headers to arrive and then splice in the
;; next appropriate after-change-function, etc.
- (declare (special url-current-object
- url-http-end-of-headers
- url-http-content-type
- url-http-content-length
- url-http-transfer-encoding
- url-callback-function
- url-callback-arguments
- url-http-process
- url-http-method
- url-http-after-change-function
- url-http-response-status))
(url-http-debug "url-http-wait-for-headers-change-function (%s)"
(buffer-name))
(let ((end-of-headers nil)
@@ -1051,7 +1043,7 @@ the end of the document."
(setq url-http-end-of-headers (set-marker (make-marker)
(point))
end-of-headers t)
- (url-http-clean-headers)))
+ (setq nd (- nd (url-http-clean-headers)))))
(if (not end-of-headers)
;; Haven't seen the end of the headers yet, need to wait
@@ -1155,33 +1147,25 @@ the end of the document."
(when (eq process-buffer (current-buffer))
(goto-char (point-max)))))
-;;;###autoload
-(defun url-http (url callback cbargs)
+(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.
-When retrieval is completed, the function CALLBACK is executed with
-CBARGS as the arguments."
- (check-type url vector "Need a pre-parsed URL.")
- (declare (special url-current-object
- url-http-end-of-headers
- url-http-content-type
- url-http-content-length
- url-http-transfer-encoding
- url-http-after-change-function
- url-callback-function
- url-callback-arguments
- url-show-status
- url-http-method
- url-http-extra-headers
- url-http-data
- url-http-chunked-length
- url-http-chunked-start
- url-http-chunked-counter
- url-http-process))
+
+When retrieval is completed, execute the function CALLBACK, using
+the arguments listed in CBARGS. The first element in CBARGS
+should be a plist describing what has happened so far during the
+request, as described in the docstring of `url-retrieve' (if in
+doubt, specify nil).
+
+Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a
+previous `url-http' call, which is being re-attempted."
+ (cl-check-type url vector "Need a pre-parsed URL.")
(let* ((host (url-host (or url-using-proxy url)))
(port (url-port (or url-using-proxy url)))
(connection (url-http-find-free-connection host port))
- (buffer (generate-new-buffer (format " *http %s:%d*" host port))))
+ (buffer (or retry-buffer
+ (generate-new-buffer
+ (format " *http %s:%d*" host port)))))
(if (not connection)
;; Failed to open the connection for some reason
(progn
@@ -1211,6 +1195,7 @@ CBARGS as the arguments."
url-http-extra-headers
url-http-data
url-http-target-url
+ url-http-no-retry
url-http-connection-opened
url-http-proxy))
(set (make-local-variable var) nil))
@@ -1226,6 +1211,7 @@ CBARGS as the arguments."
url-callback-arguments cbargs
url-http-after-change-function 'url-http-wait-for-headers-change-function
url-http-target-url url-current-object
+ url-http-no-retry retry-buffer
url-http-connection-opened nil
url-http-proxy url-using-proxy)
@@ -1240,18 +1226,19 @@ CBARGS as the arguments."
;; Asynchronous connection failed
(error "Could not create connection to %s:%d" host port))
(t
- (set-process-sentinel connection 'url-http-end-of-document-sentinel)
+ (set-process-sentinel connection
+ 'url-http-end-of-document-sentinel)
(process-send-string connection (url-http-create-request)))))))
buffer))
(defun url-http-async-sentinel (proc why)
- (declare (special url-callback-arguments))
;; We are performing an asynchronous connection, and a status change
;; has occurred.
(when (buffer-name (process-buffer proc))
(with-current-buffer (process-buffer proc)
(cond
(url-http-connection-opened
+ (setq url-http-no-retry t)
(url-http-end-of-document-sentinel proc why))
((string= (substring why 0 4) "open")
(setq url-http-connection-opened t)
@@ -1279,7 +1266,6 @@ CBARGS as the arguments."
;; Sometimes we get a zero-length data chunk after the process has
;; been changed to 'free', which means it has no buffer associated
;; with it. Do nothing if there is no buffer, or 0 length data.
- (declare (special url-http-after-change-function))
(and (process-buffer proc)
(/= (length data) 0)
(with-current-buffer (process-buffer proc)
@@ -1310,7 +1296,6 @@ CBARGS as the arguments."
(url-request-data nil))
(url-retrieve-synchronously url)))
-;;;###autoload
(defun url-http-file-exists-p (url)
(let ((status nil)
(exists nil)
@@ -1324,7 +1309,6 @@ CBARGS as the arguments."
(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)
@@ -1344,13 +1328,11 @@ CBARGS as the arguments."
(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.
@@ -1428,9 +1410,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-imap.el b/lisp/url/url-imap.el
index 3f7d1ec9238..26a1f4a4fa1 100644
--- a/lisp/url/url-imap.el
+++ b/lisp/url/url-imap.el
@@ -1,6 +1,6 @@
;;; url-imap.el --- IMAP retrieval routines
-;; Copyright (C) 1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2004-2012 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index d5f2a99a914..eaf3033120d 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -1,6 +1,6 @@
;;; url-irc.el --- IRC URL interface
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
index 8a7bb76160b..0ea98cb06c9 100644
--- a/lisp/url/url-ldap.el
+++ b/lisp/url/url-ldap.el
@@ -1,6 +1,6 @@
;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code
-;; Copyright (C) 1998-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -64,7 +64,7 @@
("facsimiletelephonenumber" . "Fax")
("postaladdress" . "Mailing Address")
("description" . "Notes"))
- "*An assoc list mapping LDAP attribute names to pretty descriptions of them.")
+ "An assoc list mapping LDAP attribute names to pretty descriptions of them.")
(defvar url-ldap-attribute-formatters
'(("mail" . (lambda (x) (format "<a href='mailto:%s'>%s</a>" x x)))
@@ -76,7 +76,7 @@
("namingcontexts" . url-ldap-dn-formatter)
("defaultnamingcontext" . url-ldap-dn-formatter)
("member" . url-ldap-dn-formatter))
- "*An assoc list mapping LDAP attribute names to pretty formatters for them.")
+ "An assoc list mapping LDAP attribute names to pretty formatters for them.")
(defsubst url-ldap-attribute-pretty-name (n)
(or (cdr-safe (assoc (downcase n) url-ldap-pretty-names)) n))
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index c0472a92bb1..254219b2ab8 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -1,6 +1,6 @@
;;; url-mail.el --- Mail Uniform Resource Locator retrieval code
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
index 3b86ed45565..3168d5aab3f 100644
--- a/lisp/url/url-methods.el
+++ b/lisp/url/url-methods.el
@@ -1,6 +1,6 @@
;;; url-methods.el --- Load URL schemes as needed
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -23,9 +23,6 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
-
;; This loads up some of the small, silly URLs that I really don't
;; want to bother putting in their own separate files.
(require 'url-parse)
@@ -62,7 +59,7 @@
(defun url-scheme-default-loader (url &optional callback cbargs)
"Signal an error for an unknown URL scheme."
- (error "Unkown URL scheme: %s" (url-type url)))
+ (error "Unknown URL scheme: %s" (url-type url)))
(defvar url-scheme--registering-proxy nil)
@@ -82,7 +79,7 @@
;; Store any proxying information - this will not overwrite an old
;; entry, so that people can still set this information in their
- ;; .emacs file
+ ;; init file
(cond
(cur-proxy nil) ; Keep their old settings
((null env-proxy) nil) ; No proxy setup
@@ -121,7 +118,9 @@ it has not already been loaded."
(let* ((stub (concat "url-" scheme))
(loader (intern stub)))
(condition-case ()
- (require loader)
+ ;; url-https.el was merged into url-http because of 8+3
+ ;; filename limitations, so we have to do this dance.
+ (require (if (equal "https" scheme) 'url-http loader))
(error nil))
(if (fboundp loader)
(progn
@@ -134,17 +133,17 @@ it has not already been loaded."
(let ((symbol (intern-soft (format "%s-%s" stub (car cell))))
(type (cdr cell)))
(if symbol
- (case type
- (function
+ (pcase type
+ (`function
;; Store the symbol name of a function
(if (fboundp symbol)
(setq desc (plist-put desc (car cell) symbol))))
- (variable
+ (`variable
;; Store the VALUE of a variable
(if (boundp symbol)
(setq desc (plist-put desc (car cell)
(symbol-value symbol)))))
- (otherwise
+ (_
(error "Malformed url-scheme-methods entry: %S"
cell))))))
(puthash scheme desc url-scheme-registry)))))
diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el
index 20e623de6cd..dd521ccd690 100644
--- a/lisp/url/url-misc.el
+++ b/lisp/url/url-misc.el
@@ -1,6 +1,6 @@
;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
-;; Copyright (C) 1996-1999, 2002, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2002, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -21,7 +21,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'url-vars)
(require 'url-parse)
(autoload 'Info-goto-node "info" "" t)
@@ -47,23 +46,23 @@
(defun url-do-terminal-emulator (type server port user)
(terminal-emulator
(generate-new-buffer (format "%s%s" (if user (concat user "@") "") server))
- (case type
- (rlogin "rlogin")
- (telnet "telnet")
- (tn3270 "tn3270")
- (otherwise
+ (pcase type
+ (`rlogin "rlogin")
+ (`telnet "telnet")
+ (`tn3270 "tn3270")
+ (_
(error "Unknown terminal emulator required: %s" type)))
- (case type
- (rlogin
+ (pcase type
+ (`rlogin
(if user
(list server "-l" user)
(list server)))
- (telnet
+ (`telnet
(if user (message "Please log in as user: %s" user))
(if port
(list server port)
(list server)))
- (tn3270
+ (`tn3270
(if user (message "Please log in as user: %s" user))
(list server)))))
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index 6cd3721e498..13b4030ecf2 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -1,6 +1,6 @@
;;; url-news.el --- News Uniform Resource Locator retrieval code
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el
index 1cda75c59e7..2eed16c3ad3 100644
--- a/lisp/url/url-nfs.el
+++ b/lisp/url/url-nfs.el
@@ -1,6 +1,6 @@
;;; url-nfs.el --- NFS URL interface
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -23,13 +23,11 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'url-parse)
(require 'url-file)
-(defvar url-nfs-automounter-directory-spec
- "file:/net/%h%f"
- "*How to invoke the NFS automounter. Certain % sequences are recognized.
+(defcustom url-nfs-automounter-directory-spec "file:/net/%h%f"
+ "How to invoke the NFS automounter. Certain % sequences are recognized.
%h -- the hostname of the NFS server
%n -- the port # of the NFS server
@@ -38,7 +36,9 @@
%f -- the filename on the remote server
%% -- a literal %
-Each can be used any number of times.")
+Each can be used any number of times."
+ :group 'url
+ :type 'string)
(defun url-nfs-unescape (format host port user pass file)
(with-current-buffer (get-buffer-create " *nfs-parse*")
@@ -48,7 +48,7 @@ Each can be used any number of times.")
(while (re-search-forward "%\\(.\\)" nil t)
(let ((escape (aref (match-string 1) 0)))
(replace-match "" t t)
- (case escape
+ (pcase escape
(?% (insert "%"))
(?h (insert host))
(?n (insert (or port "")))
diff --git a/lisp/url/url-ns.el b/lisp/url/url-ns.el
index 2eaa662be55..484e0af4fa7 100644
--- a/lisp/url/url-ns.el
+++ b/lisp/url/url-ns.el
@@ -1,6 +1,6 @@
;;; url-ns.el --- Various netscape-ish functions for proxy definitions
-;; Copyright (C) 1997-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index 71c03bf1edd..2efabed5cd8 100644
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -1,6 +1,6 @@
;;; url-parse.el --- Uniform Resource Locator parser
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -25,46 +25,80 @@
(require 'url-vars)
(require 'auth-source)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(autoload 'url-scheme-get-property "url-methods")
-(defstruct (url
+(cl-defstruct (url
(:constructor nil)
(:constructor url-parse-make-urlobj
(&optional type user password host portspec filename
target attributes fullness))
(:copier nil))
- type user password host portspec filename target attributes fullness silent)
+ type user password host portspec filename target attributes fullness
+ silent (use-cookies t))
(defsubst url-port (urlobj)
+ "Return the port number for the URL specified by URLOBJ."
+ (declare (gv-setter (lambda (port) `(setf (url-portspec ,urlobj) ,port))))
(or (url-portspec urlobj)
- (if (url-fullness urlobj)
+ (if (url-type urlobj)
(url-scheme-get-property (url-type urlobj) 'default-port))))
-(defsetf url-port (urlobj) (port) `(setf (url-portspec ,urlobj) ,port))
+
+(defun url-path-and-query (urlobj)
+ "Return the path and query components of URLOBJ.
+These two components are stored together in the FILENAME slot of
+the object. The return value of this function is (PATH . QUERY),
+where each of PATH and QUERY are strings or nil."
+ (let ((name (url-filename urlobj))
+ path query)
+ (when name
+ (if (string-match "\\?" name)
+ (setq path (substring name 0 (match-beginning 0))
+ query (substring name (match-end 0)))
+ (setq path name)))
+ (if (equal path "") (setq path nil))
+ (if (equal query "") (setq query nil))
+ (cons path query)))
+
+(defun url-port-if-non-default (urlobj)
+ "Return the port number specified by URLOBJ, if it is not the default.
+If the specified port number is the default, return nil."
+ (let ((port (url-portspec urlobj))
+ type)
+ (and port
+ (or (null (setq type (url-type urlobj)))
+ (not (equal port (url-scheme-get-property type 'default-port))))
+ port)))
;;;###autoload
(defun url-recreate-url (urlobj)
"Recreate a URL string from the parsed URLOBJ."
- (concat (url-type urlobj) ":" (if (url-host urlobj) "//" "")
- (if (url-user urlobj)
- (concat (url-user urlobj)
- (if (url-password urlobj)
- (concat ":" (url-password urlobj)))
- "@"))
- (url-host urlobj)
- (if (and (url-port urlobj)
- (not (equal (url-port urlobj)
- (url-scheme-get-property (url-type urlobj) 'default-port))))
- (format ":%d" (url-port urlobj)))
- (or (url-filename urlobj) "/")
- (url-recreate-url-attributes urlobj)
- (if (url-target urlobj)
- (concat "#" (url-target urlobj)))))
+ (let* ((type (url-type urlobj))
+ (user (url-user urlobj))
+ (pass (url-password urlobj))
+ (host (url-host urlobj))
+ ;; RFC 3986: "omit the port component and its : delimiter if
+ ;; port is empty or if its value would be the same as that of
+ ;; the scheme's default."
+ (port (url-port-if-non-default urlobj))
+ (file (url-filename urlobj))
+ (frag (url-target urlobj)))
+ (concat (if type (concat type ":"))
+ (if (url-fullness urlobj) "//")
+ (if (or user pass)
+ (concat user
+ (if pass (concat ":" pass))
+ "@"))
+ host
+ (if port (format ":%d" (url-port urlobj)))
+ (or file "/")
+ (if frag (concat "#" frag)))))
(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)
@@ -77,102 +111,119 @@
(defun url-generic-parse-url (url)
"Return an URL-struct of the parts of URL.
The CL-style struct contains the following fields:
-TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS."
- ;; See RFC 3986.
- (cond
- ((null url)
- (url-parse-make-urlobj))
- ((or (not (string-match url-nonrelative-link url))
- (= ?/ (string-to-char url)))
- ;; This isn't correct, as a relative URL can be a fragment link
- ;; (e.g. "#foo") and many other things (see section 4.2).
- ;; However, let's not fix something that isn't broken, especially
- ;; when close to a release.
- (url-parse-make-urlobj nil nil nil nil nil url))
- (t
+
+TYPE is the URI scheme (string or nil).
+USER is the user name (string or nil).
+PASSWORD is the password (string [deprecated] or nil).
+HOST is the host (a registered name, IP literal in square
+ brackets, or IPv4 address in dotted-decimal form).
+PORTSPEC is the specified port (a number), or nil.
+FILENAME is the path AND the query component of the URI.
+TARGET is the fragment identifier component (used to refer to a
+ subordinate resource, e.g. a part of a webpage).
+ATTRIBUTES is nil; this slot originally stored the attribute and
+ value alists for IMAP URIs, but this feature was removed
+ since it conflicts with RFC 3986.
+FULLNESS is non-nil iff the hierarchical sequence component of
+ the URL starts with two slashes, \"//\".
+
+The parser follows RFC 3986, except that it also tries to handle
+URIs that are not fully specified (e.g. lacking TYPE), and it
+does not check for or perform %-encoding.
+
+Here is an example. The URL
+
+ foo://bob:pass@example.com:42/a/b/c.dtb?type=animal&name=narwhal#nose
+
+parses to
+
+ TYPE = \"foo\"
+ USER = \"bob\"
+ PASSWORD = \"pass\"
+ HOST = \"example.com\"
+ PORTSPEC = 42
+ FILENAME = \"/a/b/c.dtb?type=animal&name=narwhal\"
+ TARGET = \"nose\"
+ ATTRIBUTES = nil
+ FULLNESS = t"
+ (if (null url)
+ (url-parse-make-urlobj)
(with-temp-buffer
;; Don't let those temp-buffer modifications accidentally
;; deactivate the mark of the current-buffer.
(let ((deactivate-mark nil))
(set-syntax-table url-parse-syntax-table)
- (let ((save-pos nil)
- (prot nil)
- (user nil)
- (pass nil)
- (host nil)
- (port nil)
- (file nil)
- (refs nil)
- (attr nil)
- (full nil)
+ (erase-buffer)
+ (insert url)
+ (goto-char (point-min))
+ (let ((save-pos (point))
+ scheme user pass host port file fragment full
(inhibit-read-only t))
- (erase-buffer)
- (insert url)
- (goto-char (point-min))
- (setq save-pos (point))
;; 3.1. Scheme
- (unless (looking-at "//")
- (skip-chars-forward "a-zA-Z+.\\-")
- (downcase-region save-pos (point))
- (setq prot (buffer-substring save-pos (point)))
- (skip-chars-forward ":")
- (setq save-pos (point)))
+ ;; This is nil for a URI that is not fully specified.
+ (when (looking-at "\\([a-zA-Z][-a-zA-Z0-9+.]*\\):")
+ (goto-char (match-end 0))
+ (setq save-pos (point))
+ (setq scheme (downcase (match-string 1))))
;; 3.2. Authority
(when (looking-at "//")
(setq full t)
(forward-char 2)
(setq save-pos (point))
- (skip-chars-forward "^/")
+ (skip-chars-forward "^/?#")
(setq host (buffer-substring save-pos (point)))
+ ;; 3.2.1 User Information
(if (string-match "^\\([^@]+\\)@" host)
(setq user (match-string 1 host)
- host (substring host (match-end 0) nil)))
- (if (and user (string-match "\\([^:]+\\):\\(.*\\)" user))
+ host (substring host (match-end 0))))
+ (if (and user (string-match "\\`\\([^:]*\\):\\(.*\\)" user))
(setq pass (match-string 2 user)
user (match-string 1 user)))
- ;; This gives wrong results for IPv6 literal addresses.
- (if (string-match ":\\([0-9+]+\\)" host)
- (setq port (string-to-number (match-string 1 host))
- host (substring host 0 (match-beginning 0))))
- (if (string-match ":$" host)
- (setq host (substring host 0 (match-beginning 0))))
- (setq host (downcase host)
- save-pos (point)))
-
- (if (not port)
- (setq port (url-scheme-get-property prot 'default-port)))
-
- ;; 3.3. Path
- ;; Gross hack to preserve ';' in data URLs
+ (cond
+ ;; IPv6 literal address.
+ ((string-match "^\\(\\[[^]]+\\]\\)\\(?::\\([0-9]*\\)\\)?$" host)
+ (setq port (match-string 2 host)
+ host (match-string 1 host)))
+ ;; Registered name or IPv4 address.
+ ((string-match ":\\([0-9]*\\)$" host)
+ (setq port (match-string 1 host)
+ host (substring host 0 (match-beginning 0)))))
+ (cond ((equal port "")
+ (setq port nil))
+ (port
+ (setq port (string-to-number port))))
+ (setq host (downcase host)))
+
+ ;; Now point is on the / ? or # which terminates the
+ ;; authority, or at the end of the URI, or (if there is no
+ ;; authority) at the beginning of the absolute path.
+
(setq save-pos (point))
+ (if (string= "data" scheme)
+ ;; For the "data" URI scheme, all the rest is the FILE.
+ (setq file (buffer-substring save-pos (point-max)))
+ ;; For hysterical raisins, our data structure returns the
+ ;; path and query components together in one slot.
+ ;; 3.3. Path
+ (skip-chars-forward "^?#")
+ ;; 3.4. Query
+ (when (looking-at "?")
+ (skip-chars-forward "^#"))
+ (setq file (buffer-substring save-pos (point)))
+ ;; 3.5 Fragment
+ (when (looking-at "#")
+ (let ((opoint (point)))
+ (forward-char 1)
+ (unless (eobp)
+ (setq fragment (buffer-substring (point) (point-max))))
+ (delete-region opoint (point-max)))))
- ;; 3.4. Query
- (if (string= "data" prot)
- (goto-char (point-max))
- ;; Now check for references
- (skip-chars-forward "^#")
- (if (eobp)
- nil
- (delete-region
- (point)
- (progn
- (skip-chars-forward "#")
- (setq refs (buffer-substring (point) (point-max)))
- (point-max))))
- (goto-char save-pos)
- (skip-chars-forward "^;")
- (unless (eobp)
- (setq attr (url-parse-args (buffer-substring (point) (point-max))
- t)
- attr (nreverse attr))))
-
- (setq file (buffer-substring save-pos (point)))
(if (and host (string-match "%[0-9][0-9]" host))
(setq host (url-unhex-string host)))
- (url-parse-make-urlobj
- prot user pass host port file refs attr full)))))))
+ (url-parse-make-urlobj scheme user pass host port file
+ fragment nil full))))))
(defmacro url-bit-for-url (method lookfor url)
`(let* ((urlobj (url-generic-parse-url url))
diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el
index ff89b125c6d..4524cb416bf 100644
--- a/lisp/url/url-privacy.el
+++ b/lisp/url/url-privacy.el
@@ -1,6 +1,6 @@
;;; url-privacy.el --- Global history tracking for URL package
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -21,7 +21,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'url-vars)
(defun url-device-type (&optional device)
@@ -46,11 +45,11 @@
((memq (url-device-type) '(win32 w32)) "Windows; 32bit")
((eq (url-device-type) 'pm) "OS/2; 32bit")
(t
- (case (url-device-type)
- (x "X11")
- (ns "OpenStep")
- (tty "TTY")
- (otherwise nil)))))
+ (pcase (url-device-type)
+ (`x "X11")
+ (`ns "OpenStep")
+ (`tty "TTY")
+ (_ nil)))))
(setq url-personal-mail-address (or url-personal-mail-address
user-mail-address
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index 3290f7c5141..eb2155633eb 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -1,6 +1,6 @@
;;; url-proxy.el --- Proxy server support
-;; Copyright (C) 1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index c5150a93561..327ce977cfd 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -1,6 +1,6 @@
;;; url-queue.el --- Fetching web pages in parallel
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: comm
@@ -28,8 +28,9 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'browse-url)
+(require 'url-parse)
(defcustom url-queue-parallel-processes 6
"The number of concurrent processes."
@@ -47,23 +48,49 @@
(defvar url-queue nil)
-(defstruct url-queue
+(cl-defstruct url-queue
url callback cbargs silentp
- buffer start-time)
+ buffer start-time pre-triggered
+ inhibit-cookiesp)
;;;###autoload
-(defun url-queue-retrieve (url callback &optional cbargs silent)
+(defun url-queue-retrieve (url callback &optional cbargs silent inhibit-cookies)
"Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
-Like `url-retrieve' (which see for details of the arguments), but
-controls the level of parallelism via the
-`url-queue-parallel-processes' variable."
+This is like `url-retrieve' (which see for details of the arguments),
+but with limits on the degree of parallelism. The variable
+`url-queue-parallel-processes' sets the number of concurrent processes.
+The variable `url-queue-timeout' sets a timeout."
(setq url-queue
(append url-queue
(list (make-url-queue :url url
:callback callback
:cbargs cbargs
- :silentp silent))))
- (url-queue-run-queue))
+ :silentp silent
+ :inhibit-cookiesp inhibit-cookies))))
+ (url-queue-setup-runners))
+
+;; To ensure asynch behaviour, we start the required number of queue
+;; runners from `run-with-idle-timer'. So we're basically going
+;; through the queue in two ways: 1) synchronously when a program
+;; calls `url-queue-retrieve' (which will then start the required
+;; number of queue runners), and 2) at the exit of each job, which
+;; will then not start any further threads, but just reuse the
+;; previous "slot".
+
+(defun url-queue-setup-runners ()
+ (let ((running 0)
+ waiting)
+ (dolist (entry url-queue)
+ (cond
+ ((or (url-queue-start-time entry)
+ (url-queue-pre-triggered entry))
+ (cl-incf running))
+ ((not waiting)
+ (setq waiting entry))))
+ (when (and waiting
+ (< running url-queue-parallel-processes))
+ (setf (url-queue-pre-triggered waiting) t)
+ (run-with-idle-timer 0.01 nil 'url-queue-run-queue))))
(defun url-queue-run-queue ()
(url-queue-prune-old-entries)
@@ -72,7 +99,7 @@ controls the level of parallelism via the
(dolist (entry url-queue)
(cond
((url-queue-start-time entry)
- (incf running))
+ (cl-incf running))
((not waiting)
(setq waiting entry))))
(when (and waiting
@@ -82,15 +109,34 @@ controls the level of parallelism via the
(defun url-queue-callback-function (status job)
(setq url-queue (delq job url-queue))
+ (when (and (eq (car status) :error)
+ (eq (cadr (cadr status)) 'connection-failed))
+ ;; If we get a connection error, then flush all other jobs from
+ ;; the host from the queue. This particularly makes sense if the
+ ;; error really is a DNS resolver issue, which happens
+ ;; synchronously and totally halts Emacs.
+ (url-queue-remove-jobs-from-host
+ (plist-get (nthcdr 3 (cadr status)) :host)))
(url-queue-run-queue)
(apply (url-queue-callback job) (cons status (url-queue-cbargs job))))
+(defun url-queue-remove-jobs-from-host (host)
+ (let ((jobs nil))
+ (dolist (job url-queue)
+ (when (equal (url-host (url-generic-parse-url (url-queue-url job)))
+ host)
+ (push job jobs)))
+ (dolist (job jobs)
+ (url-queue-kill-job job)
+ (setq url-queue (delq job url-queue)))))
+
(defun url-queue-start-retrieve (job)
(setf (url-queue-buffer job)
(ignore-errors
(url-retrieve (url-queue-url job)
#'url-queue-callback-function (list job)
- (url-queue-silentp job)))))
+ (url-queue-silentp job)
+ (url-queue-inhibit-cookiesp job)))))
(defun url-queue-prune-old-entries ()
(let (dead-jobs)
@@ -101,14 +147,31 @@ controls the level of parallelism via the
url-queue-timeout))
(push job dead-jobs)))
(dolist (job dead-jobs)
- (when (bufferp (url-queue-buffer job))
- (while (get-buffer-process (url-queue-buffer job))
- (ignore-errors
- (delete-process (get-buffer-process (url-queue-buffer job)))))
- (ignore-errors
- (kill-buffer (url-queue-buffer job))))
+ (url-queue-kill-job job)
(setq url-queue (delq job url-queue)))))
+(defun url-queue-kill-job (job)
+ (when (bufferp (url-queue-buffer job))
+ (let (process)
+ (while (setq process (get-buffer-process (url-queue-buffer job)))
+ (set-process-sentinel process 'ignore)
+ (ignore-errors
+ (delete-process process)))))
+ ;; Call the callback with an error message to ensure that the caller
+ ;; is notified that the job has failed.
+ (with-current-buffer
+ (if (and (bufferp (url-queue-buffer job))
+ (buffer-live-p (url-queue-buffer job)))
+ ;; Use the (partially filled) process buffer it it exists.
+ (url-queue-buffer job)
+ ;; If not, just create a new buffer, which will probably be
+ ;; killed again by the caller.
+ (generate-new-buffer " *temp*"))
+ (apply (url-queue-callback job)
+ (cons (list :error (list 'error 'url-queue-timeout
+ "Queue timeout exceeded"))
+ (url-queue-cbargs job)))))
+
(provide 'url-queue)
;;; url-queue.el ends here
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 6bf3a5831ec..038b7fcf7fe 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -1,6 +1,6 @@
;;; url-util.el --- Miscellaneous helper routines for URL library
-;; Copyright (C) 1996-1999, 2001, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2001, 2004-2012 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: comm, data, processes
@@ -26,7 +26,6 @@
(require 'url-parse)
(require 'url-vars)
-(eval-when-compile (require 'cl))
(autoload 'timezone-parse-date "timezone")
(autoload 'timezone-make-date-arpa-standard "timezone")
(autoload 'mail-header-extract "mailheader")
@@ -133,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;
@@ -248,8 +247,9 @@ Will not do anything if `url-show-status' is nil."
(cond
((null file) "")
((string-match "\\?" file)
- (file-name-directory (substring file 0 (match-beginning 0))))
- (t (file-name-directory file))))
+ (url-file-directory (substring file 0 (match-beginning 0))))
+ ((string-match "\\(.*\\(/\\|%2[fF]\\)\\)" file)
+ (match-string 1 file))))
;;;###autoload
(defun url-file-nondirectory (file)
@@ -257,30 +257,73 @@ Will not do anything if `url-show-status' is nil."
(cond
((null file) "")
((string-match "\\?" file)
- (file-name-nondirectory (substring file 0 (match-beginning 0))))
- (t (file-name-nondirectory file))))
+ (url-file-nondirectory (substring file 0 (match-beginning 0))))
+ ((string-match ".*\\(?:/\\|%2[fF]\\)\\(.*\\)" file)
+ (match-string 1 file))
+ (t file)))
;;;###autoload
(defun url-parse-query-string (query &optional downcase allow-newlines)
(let (retval pairs cur key val)
- (setq pairs (split-string query "&"))
+ (setq pairs (split-string query "[;&]"))
(while pairs
(setq cur (car pairs)
pairs (cdr pairs))
- (if (not (string-match "=" cur))
- nil ; Grace
- (setq key (url-unhex-string (substring cur 0 (match-beginning 0))
- allow-newlines))
- (setq val (url-unhex-string (substring cur (match-end 0) nil)
- allow-newlines))
- (if downcase
- (setq key (downcase key)))
- (setq cur (assoc key retval))
- (if cur
- (setcdr cur (cons val (cdr cur)))
- (setq retval (cons (list key val) retval)))))
+ (unless (string-match "=" cur)
+ (setq cur (concat cur "=")))
+
+ (when (string-match "=" cur)
+ (setq key (url-unhex-string (substring cur 0 (match-beginning 0))
+ allow-newlines))
+ (setq val (url-unhex-string (substring cur (match-end 0) nil)
+ allow-newlines))
+ (if downcase
+ (setq key (downcase key)))
+ (setq cur (assoc key retval))
+ (if cur
+ (setcdr cur (cons val (cdr cur)))
+ (setq retval (cons (list key val) retval)))))
retval))
+;;;###autoload
+(defun url-build-query-string (query &optional semicolons keep-empty)
+ "Build a query-string.
+
+Given a QUERY in the form:
+'((key1 val1)
+ (key2 val2)
+ (key3 val1 val2)
+ (key4)
+ (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."
+ (mapconcat
+ (lambda (key-vals)
+ (let ((escaped
+ (mapcar (lambda (sym)
+ (url-hexify-string (format "%s" sym))) key-vals)))
+ (mapconcat (lambda (val)
+ (let ((vprint (format "%s" val))
+ (eprint (format "%s" (car escaped))))
+ (concat eprint
+ (if (or keep-empty
+ (and val (not (zerop (length vprint)))))
+ "="
+ "")
+ vprint)))
+ (or (cdr escaped) '("")) (if semicolons ";" "&"))))
+ query (if semicolons ";" "&")))
+
(defun url-unhex (x)
(if (> x ?9)
(if (>= x ?a)
@@ -330,44 +373,118 @@ forbidden in URL encoding."
" ")
(t (byte-to-string code))))
str (substring str (match-end 0)))))
- (setq tmp (concat tmp str))
- tmp))
+ (concat tmp str)))
(defconst url-unreserved-chars
- '(
- ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
+ '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
- ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
- "A list of characters that are _NOT_ reserved in the URL spec.
-This is taken from RFC 2396.")
+ ?- ?_ ?. ?~)
+ "List of characters that are unreserved in the URL spec.
+This is taken from RFC 3986 (section 2.3).")
+
+(defconst url-encoding-table
+ (let ((vec (make-vector 256 nil)))
+ (dotimes (byte 256)
+ ;; RFC 3986 (Section 2.1): For consistency, URI producers and
+ ;; normalizers should use uppercase hexadecimal digits for all
+ ;; percent-encodings.
+ (aset vec byte (format "%%%02X" byte)))
+ vec)
+ "Vector translating bytes to URI-encoded %-sequences.")
+
+(defun url--allowed-chars (char-list)
+ "Return an \"allowed character\" mask (a 256-slot vector).
+The Nth element is non-nil if character N is in CHAR-LIST. The
+result can be passed as the second arg to `url-hexify-string'."
+ (let ((vec (make-vector 256 nil)))
+ (dolist (byte char-list)
+ (ignore-errors (aset vec byte t)))
+ vec))
;;;###autoload
-(defun url-hexify-string (string)
- "Return a new string that is STRING URI-encoded.
-First, STRING is converted to utf-8, if necessary. Then, for each
-character in the utf-8 string, those found in `url-unreserved-chars'
-are left as-is, all others are represented as a three-character
-string: \"%\" followed by two lowercase hex digits."
- ;; To go faster and avoid a lot of consing, we could do:
- ;;
- ;; (defconst url-hexify-table
- ;; (let ((map (make-vector 256 nil)))
- ;; (dotimes (byte 256) (aset map byte
- ;; (if (memq byte url-unreserved-chars)
- ;; (char-to-string byte)
- ;; (format "%%%02x" byte))))
- ;; map))
- ;;
- ;; (mapconcat (curry 'aref url-hexify-table) ...)
+(defun url-hexify-string (string &optional allowed-chars)
+ "URI-encode STRING and return the result.
+If STRING is multibyte, it is first converted to a utf-8 byte
+string. Each byte corresponding to an allowed character is left
+as-is, while all other bytes are converted to a three-character
+string: \"%\" followed by two upper-case hex digits.
+
+The allowed characters are specified by ALLOWED-CHARS. If this
+argument is nil, the list `url-unreserved-chars' determines the
+allowed characters. Otherwise, ALLOWED-CHARS should be a vector
+whose Nth element is non-nil if character N is allowed."
+ (unless allowed-chars
+ (setq allowed-chars (url--allowed-chars url-unreserved-chars)))
(mapconcat (lambda (byte)
- (if (memq byte url-unreserved-chars)
- (char-to-string byte)
- (format "%%%02x" byte)))
- (if (multibyte-string-p string)
- (encode-coding-string string 'utf-8)
- string)
- ""))
+ (if (aref allowed-chars byte)
+ (char-to-string byte)
+ (aref url-encoding-table byte)))
+ (if (multibyte-string-p string)
+ (encode-coding-string string 'utf-8)
+ string)
+ ""))
+
+(defconst url-host-allowed-chars
+ ;; Allow % to avoid re-encoding %-encoded sequences.
+ (url--allowed-chars (append '(?% ?! ?$ ?& ?' ?\( ?\) ?* ?+ ?, ?\; ?=)
+ url-unreserved-chars))
+ "Allowed-character byte mask for the host segment of a URI.
+These characters are specified in RFC 3986, Appendix A.")
+
+(defconst url-path-allowed-chars
+ (let ((vec (copy-sequence url-host-allowed-chars)))
+ (aset vec ?/ t)
+ (aset vec ?: t)
+ (aset vec ?@ t)
+ vec)
+ "Allowed-character byte mask for the path segment of a URI.
+These characters are specified in RFC 3986, Appendix A.")
+
+(defconst url-query-allowed-chars
+ (let ((vec (copy-sequence url-path-allowed-chars)))
+ (aset vec ?? t)
+ vec)
+ "Allowed-character byte mask for the query segment of a URI.
+These characters are specified in RFC 3986, Appendix A.")
+
+;;;###autoload
+(defun url-encode-url (url)
+ "Return a properly URI-encoded version of URL.
+This function also performs URI normalization, e.g. converting
+the scheme to lowercase if it is uppercase. Apart from
+normalization, if URL is already URI-encoded, this function
+should return it unchanged."
+ (if (multibyte-string-p url)
+ (setq url (encode-coding-string url 'utf-8)))
+ (let* ((obj (url-generic-parse-url url))
+ (user (url-user obj))
+ (pass (url-password obj))
+ (host (url-host obj))
+ (path-and-query (url-path-and-query obj))
+ (path (car path-and-query))
+ (query (cdr path-and-query))
+ (frag (url-target obj)))
+ (if user
+ (setf (url-user obj) (url-hexify-string user)))
+ (if pass
+ (setf (url-password obj) (url-hexify-string pass)))
+ ;; No special encoding for IPv6 literals.
+ (and host
+ (not (string-match "\\`\\[.*\\]\\'" host))
+ (setf (url-host obj)
+ (url-hexify-string host url-host-allowed-chars)))
+
+ (if path
+ (setq path (url-hexify-string path url-path-allowed-chars)))
+ (if query
+ (setq query (url-hexify-string query url-query-allowed-chars)))
+ (setf (url-filename obj) (if query (concat path "?" query) path))
+
+ (if frag
+ (setf (url-target obj)
+ (url-hexify-string frag url-query-allowed-chars)))
+ (url-recreate-url obj)))
;;;###autoload
(defun url-file-extension (fname &optional x)
@@ -476,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)
@@ -497,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/url/url-vars.el b/lisp/url/url-vars.el
index 19e0b621d87..fdfd0e9868d 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -1,6 +1,6 @@
;;; url-vars.el --- Variables for Uniform Resource Locator tool
-;; Copyright (C) 1996-1999, 2001, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2001, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -21,8 +21,6 @@
;;; Code:
-(require 'mm-util)
-
(defconst url-version "Emacs"
"Version number of URL package.")
@@ -154,7 +152,8 @@ variable."
(".uue" . "x-uuencoded")
(".hqx" . "x-hqx")
(".Z" . "x-compress")
- (".bz2" . "x-bzip2"))
+ (".bz2" . "x-bzip2")
+ (".xz" . "x-xz"))
"An alist of file extensions and appropriate content-transfer-encodings."
:type '(repeat (cons :format "%v"
(string :tag "Extension")
@@ -212,7 +211,10 @@ Should be an assoc list of headers/contents.")
;; FIXME!! (RFC 2616 gives examples like `compress, gzip'.)
(defvar url-mime-encoding-string nil
- "*String to send in the Accept-encoding: field in HTTP requests.")
+ "String to send in the Accept-encoding: field in HTTP requests.")
+
+(defvar mm-mime-mule-charset-alist)
+(declare-function mm-coding-system-p "mm-util" (cs))
;; Perhaps the first few should actually be given decreasing `q's and
;; the list should be trimmed significantly.
@@ -221,6 +223,7 @@ Should be an assoc list of headers/contents.")
(defun url-mime-charset-string ()
"Generate a list of preferred MIME charsets for HTTP requests.
Generated according to current coding system priorities."
+ (require 'mm-util)
(if (fboundp 'sort-coding-systems)
(let ((ordered (sort-coding-systems
(let (accum)
@@ -233,7 +236,7 @@ Generated according to current coding system priorities."
";q=0.5"))))
(defvar url-mime-charset-string nil
- "*String to send in the Accept-charset: field in HTTP requests.
+ "String to send in the Accept-charset: field in HTTP requests.
The MIME charset corresponding to the most preferred coding system is
given priority 1 and the rest are given priority 0.5.")
@@ -304,8 +307,12 @@ undefined."
:type '(choice (const :tag "None" :value nil) string)
:group 'url)
+;; From RFC3986: Scheme names consist of a sequence of characters
+;; beginning with a letter and followed by any combination of letters,
+;; digits, plus ("+"), period ("."), or hyphen ("-").
+
(defvar url-nonrelative-link
- "\\`\\([-a-zA-Z0-9+.]+:\\)"
+ "\\`\\([a-zA-Z][-a-zA-Z0-9+.]*:\\)"
"A regular expression that will match an absolute URL.")
(defcustom url-max-redirections 30
@@ -364,7 +371,7 @@ Currently supported methods:
(defvar url-parse-syntax-table
(copy-syntax-table emacs-lisp-mode-syntax-table)
- "*A syntax table for parsing URLs.")
+ "A syntax table for parsing URLs.")
(modify-syntax-entry ?' "\"" url-parse-syntax-table)
(modify-syntax-entry ?` "\"" url-parse-syntax-table)
@@ -372,8 +379,10 @@ Currently supported methods:
(modify-syntax-entry ?> ")<" url-parse-syntax-table)
(modify-syntax-entry ?/ " " url-parse-syntax-table)
-(defvar url-load-hook nil
- "*Hooks to be run after initializing the URL library.")
+(defcustom url-load-hook nil
+ "Hook run after initializing the URL library."
+ :group 'url
+ :type 'hook)
;;; Make OS/2 happy - yeeks
;; (defvar tcp-binary-process-input-services nil
diff --git a/lisp/url/url.el b/lisp/url/url.el
index c95b61c43fb..b219151a30c 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -1,6 +1,6 @@
-;;; url.el --- Uniform Resource Locator retrieval tool
+;;; url.el --- Uniform Resource Locator retrieval tool -*- lexical-binding: t -*-
-;; Copyright (C) 1996-1999, 2001, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2001, 2004-2012 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: comm, data, processes, hypermedia
@@ -26,7 +26,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'mailcap)
@@ -119,17 +118,22 @@ Sometimes while retrieving a URL, the URL library needs to use another buffer
than the one returned initially by `url-retrieve'. In this case, it sets this
variable in the original buffer as a forwarding pointer.")
+(defvar url-retrieve-number-of-calls 0)
+(autoload 'url-cache-prune-cache "url-cache")
+
;;;###autoload
-(defun url-retrieve (url callback &optional cbargs silent)
+(defun url-retrieve (url callback &optional cbargs silent inhibit-cookies)
"Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
-URL is either a string or a parsed URL.
+URL is either a string or a parsed URL. If it is a string
+containing characters that are not valid in a URI, those
+characters are percent-encoded; see `url-encode-url'.
CALLBACK is called when the object has been completely retrieved, with
the current buffer containing the object, and any MIME headers associated
with it. It is called as (apply CALLBACK STATUS CBARGS).
-STATUS is a list with an even number of elements representing
-what happened during the request, with most recent events first,
-or an empty list if no events have occurred. Each pair is one of:
+STATUS is a plist representing what happened during the request,
+with most recent events first, or an empty list if no events have
+occurred. Each pair is one of:
\(:redirect REDIRECTED-TO) - the request was redirected to this URL
\(:error (ERROR-SYMBOL . DATA)) - an error occurred. The error can be
@@ -144,7 +148,11 @@ The variables `url-request-data', `url-request-method' and
request; dynamic binding of other variables doesn't necessarily
take effect.
-If SILENT, then don't message progress reports and the like."
+If SILENT, then don't message progress reports and the like.
+If INHIBIT-COOKIES, cookies will neither be stored nor sent to
+the server.
+If URL is a multibyte string, it will be encoded as utf-8 and
+URL-encoded before it's used."
;;; XXX: There is code in Emacs that does dynamic binding
;;; of the following variables around url-retrieve:
;;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets,
@@ -155,18 +163,27 @@ If SILENT, then don't message progress reports and the like."
;;; webmail.el; the latter should be updated. Is
;;; url-cookie-multiple-line needed anymore? The other url-cookie-*
;;; are (for now) only used in synchronous retrievals.
- (url-retrieve-internal url callback (cons nil cbargs) silent))
+ (url-retrieve-internal url callback (cons nil cbargs) silent
+ inhibit-cookies))
-(defun url-retrieve-internal (url callback cbargs &optional silent)
+(defun url-retrieve-internal (url callback cbargs &optional silent
+ inhibit-cookies)
"Internal function; external interface is `url-retrieve'.
-CBARGS is what the callback will actually receive - the first item is
-the list of events, as described in the docstring of `url-retrieve'.
-
-If SILENT, don't message progress reports and the like."
+CBARGS is the list of arguments that the callback function will
+receive; its first element should be a plist specifying what has
+happened so far during the request, as described in the docstring
+of `url-retrieve' (if in doubt, specify nil).
+
+If SILENT, don't message progress reports and the like.
+If INHIBIT-COOKIES, cookies will neither be stored nor sent to
+the server.
+If URL is a multibyte string, it will be encoded as utf-8 and
+URL-encoded before it's used."
(url-do-setup)
(url-gc-dead-buffers)
- (if (stringp url)
- (set-text-properties 0 (length url) nil url))
+ (when (stringp url)
+ (set-text-properties 0 (length url) nil url)
+ (setq url (url-encode-url url)))
(if (not (vectorp url))
(setq url (url-generic-parse-url url)))
(if (not (functionp callback))
@@ -174,6 +191,14 @@ If SILENT, don't message progress reports and the like."
(unless (url-type url)
(error "Bad url: %s" (url-recreate-url url)))
(setf (url-silent url) silent)
+ (setf (url-use-cookies url) (not inhibit-cookies))
+ ;; Once in a while, remove old entries from the URL cache.
+ (when (zerop (% url-retrieve-number-of-calls 1000))
+ (condition-case error
+ (url-cache-prune-cache)
+ (file-error
+ (message "Error when expiring the cache: %s" error))))
+ (setq url-retrieve-number-of-calls (1+ url-retrieve-number-of-calls))
(let ((loader (url-scheme-get-property (url-type url) 'loader))
(url-using-proxy (if (url-host url)
(url-find-proxy-for-url url (url-host url))))
@@ -201,8 +226,8 @@ associated with it (the case for dired, info, or mailto URLs that need
no further processing). URL is either a string or a parsed URL."
(url-do-setup)
- (lexical-let ((retrieval-done nil)
- (asynch-buffer nil))
+ (let ((retrieval-done nil)
+ (asynch-buffer nil))
(setq asynch-buffer
(url-retrieve url (lambda (&rest ignored)
(url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer))
diff --git a/lisp/userlock.el b/lisp/userlock.el
index 7a2f7f76b78..4c003e423aa 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -1,9 +1,10 @@
;;; userlock.el --- handle file access contention between multiple users
-;; Copyright (C) 1985-1986, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -107,37 +108,27 @@ You can rewrite this to use any criterion you like to choose which one to do.
The buffer in question is current when this function is called."
(discard-input)
(save-window-excursion
- (let (answer)
+ (let ((prompt
+ (format "%s changed on disk; \
+really edit the buffer? (y, n, r or C-h) "
+ (file-name-nondirectory fn)))
+ (choices '(?y ?n ?r ?? ?\C-h))
+ answer)
(while (null answer)
- (message "%s changed on disk; really edit the buffer? (y, n, r or C-h) "
- (file-name-nondirectory fn))
- (let ((tem (downcase (let ((cursor-in-echo-area t))
- (read-char-exclusive)))))
- (setq answer
- (if (= tem help-char)
- 'help
- (cdr (assoc tem '((?n . yield)
- (?\C-g . yield)
- (?y . proceed)
- (?r . revert)
- (?? . help))))))
- (cond ((null answer)
- (beep)
- (message "Please type y, n or r; or ? for help")
- (sit-for 3))
- ((eq answer 'help)
- (ask-user-about-supersession-help)
- (setq answer nil))
- ((eq answer 'revert)
- (revert-buffer nil (not (buffer-modified-p)))
- ; ask confirmation if buffer modified
- (signal 'file-supersession
- (list "File reverted" fn)))
- ((eq answer 'yield)
- (signal 'file-supersession
- (list "File changed on disk" fn))))))
+ (setq answer (read-char-choice prompt choices))
+ (cond ((memq answer '(?? ?\C-h))
+ (ask-user-about-supersession-help)
+ (setq answer nil))
+ ((eq answer ?r)
+ ;; Ask for confirmation if buffer modified
+ (revert-buffer nil (not (buffer-modified-p)))
+ (signal 'file-supersession
+ (list "File reverted" fn)))
+ ((eq answer ?n)
+ (signal 'file-supersession
+ (list "File changed on disk" fn)))))
(message
- "File on disk now will become a backup file if you save these changes.")
+ "File on disk now will become a backup file if you save these changes.")
(setq buffer-backed-up nil))))
(defun ask-user-about-supersession-help ()
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index 9170d7b9424..5a378df6513 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -1,6 +1,6 @@
;;; add-log.el --- change log maintenance commands for Emacs
-;; Copyright (C) 1985-1986, 1988, 1993-1994, 1997-1998, 2000-2011
+;; Copyright (C) 1985-1986, 1988, 1993-1994, 1997-1998, 2000-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -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.
@@ -223,13 +221,15 @@ Note: The search is conducted only within 10%, at the beginning of the file."
(define-obsolete-face-alias 'change-log-function-face
'change-log-function "22.1")
-(defface change-log-acknowledgement
+(defface change-log-acknowledgment
'((t (:inherit font-lock-comment-face)))
"Face for highlighting acknowledgments."
:version "21.1"
:group 'change-log)
+(define-obsolete-face-alias 'change-log-acknowledgement
+ 'change-log-acknowledgment "24.3")
(define-obsolete-face-alias 'change-log-acknowledgement-face
- 'change-log-acknowledgement "22.1")
+ 'change-log-acknowledgment "22.1")
(defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)")
(defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*")
@@ -271,14 +271,14 @@ Note: The search is conducted only within 10%, at the beginning of the file."
;; Function of change.
("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function))
;;
- ;; Acknowledgements.
+ ;; Acknowledgments.
;; Don't include plain "From" because that is vague;
;; we want to encourage people to say something more specific.
;; Note that the FSF does not use "Patches by"; our convention
;; is to put the name of the author of the changes at the top
;; of the change log entry.
("\\(^\\( +\\|\t\\)\\| \\)\\(Thanks to\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
- 3 'change-log-acknowledgement))
+ 3 'change-log-acknowledgment))
"Additional expressions to highlight in Change Log mode.")
(defun change-log-search-file-name (where)
@@ -804,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.
@@ -1047,6 +1045,7 @@ Runs `change-log-mode-hook'.
show-trailing-whitespace t)
(set (make-local-variable 'fill-forward-paragraph-function)
'change-log-fill-forward-paragraph)
+ (set (make-local-variable 'comment-start) nil)
;; Make sure we call `change-log-indent' when filling.
(set (make-local-variable 'fill-indent-according-to-mode) t)
;; Avoid that filling leaves behind a single "*" on a line.
@@ -1122,17 +1121,17 @@ parentheses."
;;;###autoload
(defvar add-log-lisp-like-modes
'(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode)
- "*Modes that look like Lisp to `add-log-current-defun'.")
+ "Modes that look like Lisp to `add-log-current-defun'.")
;;;###autoload
(defvar add-log-c-like-modes
'(c-mode c++-mode c++-c-mode objc-mode)
- "*Modes that look like C to `add-log-current-defun'.")
+ "Modes that look like C to `add-log-current-defun'.")
;;;###autoload
(defvar add-log-tex-like-modes
'(TeX-mode plain-TeX-mode LaTeX-mode tex-mode)
- "*Modes that look like TeX to `add-log-current-defun'.")
+ "Modes that look like TeX to `add-log-current-defun'.")
(declare-function c-cpp-define-name "cc-cmds" ())
(declare-function c-defun-name "cc-cmds" ())
diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el
index 4c63e48a3fc..14612c95b22 100644
--- a/lisp/vc/compare-w.el
+++ b/lisp/vc/compare-w.el
@@ -1,6 +1,6 @@
;;; compare-w.el --- compare text between windows for Emacs
-;; Copyright (C) 1986, 1989, 1993, 1997, 2001-2011
+;; Copyright (C) 1986, 1989, 1993, 1997, 2001-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el
index 3444b230e8d..6c6b18a605d 100644
--- a/lisp/vc/cvs-status.el
+++ b/lisp/vc/cvs-status.el
@@ -1,6 +1,6 @@
;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs cvs status tree vc tools
@@ -28,7 +28,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'pcvs-util)
;;;
@@ -165,7 +165,7 @@
;; Tagelt, tag element
;;
-(defstruct (cvs-tag
+(cl-defstruct (cvs-tag
(:constructor nil)
(:constructor cvs-tag-make
(vlist &optional name type))
@@ -235,9 +235,9 @@ The tree will be printed no closer than column COLUMN."
(save-excursion
(or (= (forward-line 1) 0) (insert "\n"))
(cvs-tree-print rest printer column))))
- (assert (>= prefix column))
+ (cl-assert (>= prefix column))
(move-to-column prefix t)
- (assert (eolp))
+ (cl-assert (eolp))
(insert (cvs-car name))
(dolist (br (cvs-cdr rev))
(let* ((column (current-column))
@@ -258,7 +258,7 @@ The tree will be printed no closer than column COLUMN."
(defun cvs-tree-merge (tree1 tree2)
"Merge tags trees TREE1 and TREE2 into one.
BEWARE: because of stability issues, this is not a symmetric operation."
- (assert (and (listp tree1) (listp tree2)))
+ (cl-assert (and (listp tree1) (listp tree2)))
(cond
((null tree1) tree2)
((null tree2) tree1)
@@ -273,10 +273,10 @@ BEWARE: because of stability issues, this is not a symmetric operation."
(l2 (length vl2)))
(cond
((= l1 l2)
- (case (cvs-tag-compare tag1 tag2)
- (more1 (list* rev2 (cvs-tree-merge tree1 (cdr tree2))))
- (more2 (list* rev1 (cvs-tree-merge (cdr tree1) tree2)))
- (equal
+ (pcase (cvs-tag-compare tag1 tag2)
+ (`more1 (cons rev2 (cvs-tree-merge tree1 (cdr tree2))))
+ (`more2 (cons rev1 (cvs-tree-merge (cdr tree1) tree2)))
+ (`equal
(cons (cons (cvs-tag-merge tag1 tag2)
(cvs-tree-merge (cvs-cdr rev1) (cvs-cdr rev2)))
(cvs-tree-merge (cdr tree1) (cdr tree2))))))
@@ -395,39 +395,39 @@ the list is a three-string list TAG, KIND, REV."
(cvs-tree-use-jisx0208 'jisx0208)
((char-displayable-p ?━) 'unicode)
((char-displayable-p (make-char 'japanese-jisx0208 40 44)) 'jisx0208))
- "*Non-nil if we should use the graphical glyphs from `japanese-jisx0208'.
+ "Non-nil if we should use the graphical glyphs from `japanese-jisx0208'.
Otherwise, default to ASCII chars like +, - and |.")
(defconst cvs-tree-char-space
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 33 33))
- (unicode " ")
- (t " ")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 33 33))
+ (`unicode " ")
+ (_ " ")))
(defconst cvs-tree-char-hbar
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 44))
- (unicode "━")
- (t "--")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 44))
+ (`unicode "━")
+ (_ "--")))
(defconst cvs-tree-char-vbar
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 45))
- (unicode "┃")
- (t "| ")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 45))
+ (`unicode "┃")
+ (_ "| ")))
(defconst cvs-tree-char-branch
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 50))
- (unicode "┣")
- (t "+-")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 50))
+ (`unicode "┣")
+ (_ "+-")))
(defconst cvs-tree-char-eob ;end of branch
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 49))
- (unicode "┗")
- (t "`-")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 49))
+ (`unicode "┗")
+ (_ "`-")))
(defconst cvs-tree-char-bob ;beginning of branch
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 51))
- (unicode "┳")
- (t "+-")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 51))
+ (`unicode "┳")
+ (_ "+-")))
(defun cvs-tag-lessp (tag1 tag2)
(eq (cvs-tag-compare tag1 tag2) 'more2))
@@ -485,9 +485,9 @@ Optional prefix ARG chooses between two representations."
(pe t) ;"prev equal"
(nas nil)) ;"next afters" to be returned
(insert " ")
- (do* ((vs vlist (cdr vs))
- (ps prev (cdr ps))
- (as after (cdr as)))
+ (cl-do* ((vs vlist (cdr vs))
+ (ps prev (cdr ps))
+ (as after (cdr as)))
((and (null as) (null vs) (null ps))
(let ((revname (cvs-status-vl-to-str vlist)))
(if (cvs-every 'identity (cvs-map 'equal prev vlist))
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 8f4b59f9e53..0c023b0f7f4 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -1,6 +1,6 @@
;;; diff-mode.el --- a mode for viewing/editing context diffs -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: convenience patch diff vc
@@ -27,7 +27,7 @@
;; to the corresponding source file.
;; Inspired by Pavel Machek's patch-mode.el (<pavel@@atrey.karlin.mff.cuni.cz>)
-;; Some efforts were spent to have it somewhat compatible with XEmacs'
+;; Some efforts were spent to have it somewhat compatible with XEmacs's
;; diff-mode as well as with compilation-minor-mode
;; Bugs:
@@ -53,7 +53,7 @@
;; - Handle `diff -b' output in context->unified.
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defvar add-log-buffer-file-name-function)
@@ -107,8 +107,7 @@ when editing big diffs)."
;;;;
(easy-mmode-defmap diff-mode-shared-map
- '(;; From Pavel Machek's patch-mode.
- ("n" . diff-hunk-next)
+ '(("n" . diff-hunk-next)
("N" . diff-file-next)
("p" . diff-hunk-prev)
("P" . diff-file-prev)
@@ -116,27 +115,17 @@ when editing big diffs)."
([backtab] . diff-hunk-prev)
("k" . diff-hunk-kill)
("K" . diff-file-kill)
- ;; From compilation-minor-mode.
- ("}" . diff-file-next)
+ ("}" . diff-file-next) ; From compilation-minor-mode.
("{" . diff-file-prev)
("\C-m" . diff-goto-source)
([mouse-2] . diff-goto-source)
- ;; From XEmacs' diff-mode.
("W" . widen)
- ;;("." . diff-goto-source) ;display-buffer
- ;;("f" . diff-goto-source) ;find-file
- ("o" . diff-goto-source) ;other-window
- ;;("w" . diff-goto-source) ;other-frame
- ;;("N" . diff-narrow)
- ;;("h" . diff-show-header)
- ;;("j" . diff-show-difference) ;jump to Nth diff
- ;;("q" . diff-quit)
- ;; Not useful if you have to metafy them.
- ;;(" " . scroll-up)
- ;;("\177" . scroll-down)
+ ("o" . diff-goto-source) ; other-window
("A" . diff-ediff-patch)
("r" . diff-restrict-view)
- ("R" . diff-reverse-direction))
+ ("R" . diff-reverse-direction)
+ ("/" . diff-undo)
+ ([remap undo] . diff-undo))
"Basic keymap for `diff-mode', bound to various prefix keys."
:inherit special-mode-map)
@@ -189,6 +178,8 @@ when editing big diffs)."
["Unified -> Context" diff-unified->context
:help "Convert unified diffs to context diffs"]
;;["Fixup Headers" diff-fixup-modifs (not buffer-read-only)]
+ ["Remove trailing whitespace" diff-delete-trailing-whitespace
+ :help "Remove trailing whitespace problems introduced by the diff"]
["Show trailing whitespace" whitespace-mode
:style toggle :selected (bound-and-true-p whitespace-mode)
:help "Show trailing whitespace in modified lines"]
@@ -237,7 +228,7 @@ from disabled to enabled, it tries to refine the current hunk, as
well."
:group 'diff-mode :init-value t :lighter nil ;; " Auto-Refine"
(when diff-auto-refine-mode
- (condition-case-no-debug nil (diff-refine-hunk) (error nil))))
+ (condition-case-unless-debug nil (diff-refine-hunk) (error nil))))
;;;;
;;;; font-lock support
@@ -248,10 +239,8 @@ well."
:background "grey80")
(((class color) (min-colors 88) (background dark))
:background "grey45")
- (((class color) (background light))
+ (((class color))
:foreground "blue1" :weight bold)
- (((class color) (background dark))
- :foreground "green" :weight bold)
(t :weight bold))
"`diff-mode' face inherited by hunk and index header faces."
:group 'diff-mode)
@@ -263,9 +252,7 @@ well."
:background "grey70" :weight bold)
(((class color) (min-colors 88) (background dark))
:background "grey60" :weight bold)
- (((class color) (background light))
- :foreground "green" :weight bold)
- (((class color) (background dark))
+ (((class color))
:foreground "cyan" :weight bold)
(t :weight bold)) ; :height 1.3
"`diff-mode' face used to highlight file header lines."
@@ -288,14 +275,28 @@ well."
(defvar diff-hunk-header-face 'diff-hunk-header)
(defface diff-removed
- '((t :inherit diff-changed))
+ '((default
+ :inherit diff-changed)
+ (((class color) (min-colors 88) (background light))
+ :background "#ffdddd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#553333")
+ (((class color))
+ :foreground "red"))
"`diff-mode' face used to highlight removed lines."
:group 'diff-mode)
(define-obsolete-face-alias 'diff-removed-face 'diff-removed "22.1")
(defvar diff-removed-face 'diff-removed)
(defface diff-added
- '((t :inherit diff-changed))
+ '((default
+ :inherit diff-changed)
+ (((class color) (min-colors 88) (background light))
+ :background "#ddffdd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#335533")
+ (((class color))
+ :foreground "green"))
"`diff-mode' face used to highlight added lines."
:group 'diff-mode)
(define-obsolete-face-alias 'diff-added-face 'diff-added "22.1")
@@ -307,10 +308,8 @@ well."
'((((class color grayscale) (min-colors 88)))
;; If the terminal lacks sufficient colors for shadowing,
;; highlight changed lines explicitly.
- (((class color) (background light))
- :foreground "magenta" :weight bold :slant italic)
- (((class color) (background dark))
- :foreground "yellow" :weight bold :slant italic))
+ (((class color))
+ :foreground "yellow"))
"`diff-mode' face used to highlight changed lines."
:group 'diff-mode)
(define-obsolete-face-alias 'diff-changed-face 'diff-changed "22.1")
@@ -385,6 +384,13 @@ well."
(defconst diff-context-mid-hunk-header-re
"--- \\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? ----$")
+(defvar diff-use-changed-face (and (face-differs-from-default-p diff-changed-face)
+ (not (face-equal diff-changed-face diff-added-face))
+ (not (face-equal diff-changed-face diff-removed-face)))
+ "If non-nil, use the face `diff-changed' for changed lines in context diffs.
+Otherwise, use the face `diff-removed' for removed lines,
+and the face `diff-added' for added lines.")
+
(defvar diff-font-lock-keywords
`((,(concat "\\(" diff-hunk-header-re-unified "\\)\\(.*\\)$")
(1 diff-hunk-header-face) (6 diff-function-face))
@@ -404,8 +410,25 @@ well."
("^\\([+>]\\)\\(.*\n\\)"
(1 diff-indicator-added-face) (2 diff-added-face))
("^\\(!\\)\\(.*\n\\)"
- (1 diff-indicator-changed-face) (2 diff-changed-face))
- ("^Index: \\(.+\\).*\n"
+ (1 (if diff-use-changed-face
+ diff-indicator-changed-face
+ ;; Otherwise, search for `diff-context-mid-hunk-header-re' and
+ ;; if the line of context diff is above, use `diff-removed-face';
+ ;; if below, use `diff-added-face'.
+ (save-match-data
+ (let ((limit (save-excursion (diff-beginning-of-hunk))))
+ (if (save-excursion (re-search-backward diff-context-mid-hunk-header-re limit t))
+ diff-indicator-added-face
+ diff-indicator-removed-face)))))
+ (2 (if diff-use-changed-face
+ diff-changed-face
+ ;; Otherwise, use the same method as above.
+ (save-match-data
+ (let ((limit (save-excursion (diff-beginning-of-hunk))))
+ (if (save-excursion (re-search-backward diff-context-mid-hunk-header-re limit t))
+ diff-added-face
+ diff-removed-face))))))
+ ("^\\(?:Index\\|revno\\): \\(.+\\).*\n"
(0 diff-header-face) (1 diff-index-face prepend))
("^Only in .*\n" . diff-nonexistent-face)
("^\\(#\\)\\(.*\\)"
@@ -445,6 +468,7 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html")
style)
(defun diff-end-of-hunk (&optional style donttrustheader)
+ "Advance to the end of the current hunk, and return its position."
(let (end)
(when (looking-at diff-hunk-header-re)
;; Especially important for unified (because headers are ambiguous).
@@ -454,11 +478,13 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html")
(let* ((nold (string-to-number (or (match-string 2) "1")))
(nnew (string-to-number (or (match-string 4) "1")))
(endold
- (save-excursion
- (re-search-forward (if diff-valid-unified-empty-line
- "^[- \n]" "^[- ]")
+ (save-excursion
+ (re-search-forward (if diff-valid-unified-empty-line
+ "^[- \n]" "^[- ]")
nil t nold)
- (line-beginning-position 2)))
+ (line-beginning-position
+ ;; Skip potential "\ No newline at end of file".
+ (if (looking-at ".*\n\\\\") 3 2))))
(endnew
;; The hunk may end with a bunch of "+" lines, so the `end' is
;; then further than computed above.
@@ -466,19 +492,22 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html")
(re-search-forward (if diff-valid-unified-empty-line
"^[+ \n]" "^[+ ]")
nil t nnew)
- (line-beginning-position 2))))
+ (line-beginning-position
+ ;; Skip potential "\ No newline at end of file".
+ (if (looking-at ".*\n\\\\") 3 2)))))
(setq end (max endold endnew)))))
;; We may have a first evaluation of `end' thanks to the hunk header.
(unless end
(setq end (and (re-search-forward
- (case style
- (unified (concat (if diff-valid-unified-empty-line
- "^[^-+# \\\n]\\|" "^[^-+# \\]\\|")
- ;; A `unified' header is ambiguous.
- diff-file-header-re))
- (context "^[^-+#! \\]")
- (normal "^[^<>#\\]")
- (t "^[^-+#!<> \\]"))
+ (pcase style
+ (`unified
+ (concat (if diff-valid-unified-empty-line
+ "^[^-+# \\\n]\\|" "^[^-+# \\]\\|")
+ ;; A `unified' header is ambiguous.
+ diff-file-header-re))
+ (`context "^[^-+#! \\]")
+ (`normal "^[^<>#\\]")
+ (_ "^[^-+#!<> \\]"))
nil t)
(match-beginning 0)))
(when diff-valid-unified-empty-line
@@ -492,19 +521,21 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html")
(goto-char (or end (point-max)))))
(defun diff-beginning-of-hunk (&optional try-harder)
- "Move back to beginning of hunk.
-If TRY-HARDER is non-nil, try to cater to the case where we're not in a hunk
-but in the file header instead, in which case move forward to the first hunk."
+ "Move back to the previous hunk beginning, and return its position.
+If point is in a file header rather than a hunk, advance to the
+next hunk if TRY-HARDER is non-nil; otherwise signal an error."
(beginning-of-line)
- (unless (looking-at diff-hunk-header-re)
+ (if (looking-at diff-hunk-header-re)
+ (point)
(forward-line 1)
(condition-case ()
(re-search-backward diff-hunk-header-re)
(error
- (if (not try-harder)
- (error "Can't find the beginning of the hunk")
- (diff-beginning-of-file-and-junk)
- (diff-hunk-next))))))
+ (unless try-harder
+ (error "Can't find the beginning of the hunk"))
+ (diff-beginning-of-file-and-junk)
+ (diff-hunk-next)
+ (point)))))
(defun diff-unified-hunk-p ()
(save-excursion
@@ -538,53 +569,97 @@ but in the file header instead, in which case move forward to the first hunk."
(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-no-debug nil (diff-refine-hunk) (error nil))))
+ (when diff-auto-refine-mode
+ (unless (prog1 diff--auto-refine-data
+ (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
+ (save-excursion
+ (goto-char point)
+ (diff-refine-hunk))))))))))))
(easy-mmode-define-navigation
- diff-file diff-file-header-re "file" diff-end-of-hunk)
+ diff-file diff-file-header-re "file" diff-end-of-file)
+
+(defun diff-bounds-of-hunk ()
+ "Return the bounds of the diff hunk at point.
+The return value is a list (BEG END), which are the hunk's start
+and end positions. Signal an error if no hunk is found. If
+point is in a file header, return the bounds of the next hunk."
+ (save-excursion
+ (let ((pos (point))
+ (beg (diff-beginning-of-hunk t))
+ (end (diff-end-of-hunk)))
+ (cond ((>= end pos)
+ (list beg end))
+ ;; If this hunk ends above POS, consider the next hunk.
+ ((re-search-forward diff-hunk-header-re nil t)
+ (list (match-beginning 0) (diff-end-of-hunk)))
+ (t (error "No hunk found"))))))
+
+(defun diff-bounds-of-file ()
+ "Return the bounds of the file segment at point.
+The return value is a list (BEG END), which are the segment's
+start and end positions."
+ (save-excursion
+ (let ((pos (point))
+ (beg (progn (diff-beginning-of-file-and-junk)
+ (point))))
+ (diff-end-of-file)
+ ;; bzr puts a newline after the last hunk.
+ (while (looking-at "^\n")
+ (forward-char 1))
+ (if (> pos (point))
+ (error "Not inside a file diff"))
+ (list beg (point)))))
(defun diff-restrict-view (&optional arg)
"Restrict the view to the current hunk.
If the prefix ARG is given, restrict the view to the current file instead."
(interactive "P")
- (save-excursion
- (if arg (diff-beginning-of-file) (diff-beginning-of-hunk 'try-harder))
- (narrow-to-region (point)
- (progn (if arg (diff-end-of-file) (diff-end-of-hunk))
- (point)))
- (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk))))
-
+ (apply 'narrow-to-region
+ (if arg (diff-bounds-of-file) (diff-bounds-of-hunk)))
+ (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk)))
(defun diff-hunk-kill ()
- "Kill current hunk."
+ "Kill the hunk at point."
(interactive)
- (diff-beginning-of-hunk)
- (let* ((start (point))
- ;; Search the second match, since we're looking at the first.
- (nexthunk (when (re-search-forward diff-hunk-header-re nil t 2)
- (match-beginning 0)))
- (firsthunk (ignore-errors
- (goto-char start)
- (diff-beginning-of-file) (diff-hunk-next) (point)))
- (nextfile (ignore-errors (diff-file-next) (point)))
+ (let* ((hunk-bounds (diff-bounds-of-hunk))
+ (file-bounds (ignore-errors (diff-bounds-of-file)))
+ ;; If the current hunk is the only one for its file, kill the
+ ;; file header too.
+ (bounds (if (and file-bounds
+ (progn (goto-char (car file-bounds))
+ (= (progn (diff-hunk-next) (point))
+ (car hunk-bounds)))
+ (progn (goto-char (cadr hunk-bounds))
+ ;; bzr puts a newline after the last hunk.
+ (while (looking-at "^\n")
+ (forward-char 1))
+ (= (point) (cadr file-bounds))))
+ file-bounds
+ hunk-bounds))
(inhibit-read-only t))
- (goto-char start)
- (if (and firsthunk (= firsthunk start)
- (or (null nexthunk)
- (and nextfile (> nexthunk nextfile))))
- ;; It's the only hunk for this file, so kill the file.
- (diff-file-kill)
- (diff-end-of-hunk)
- (kill-region start (point)))))
+ (apply 'kill-region bounds)
+ (goto-char (car bounds))))
;; "index ", "old mode", "new mode", "new file mode" and
;; "deleted file mode" are output by git-diff.
(defconst diff-file-junk-re
- "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\) mode")
+ "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\) mode\\|=== modified file")
(defun diff-beginning-of-file-and-junk ()
"Go to the beginning of file-related diff-info.
@@ -636,13 +711,8 @@ data such as \"Index: ...\" and such."
(defun diff-file-kill ()
"Kill current file's hunks."
(interactive)
- (let ((orig (point))
- (start (progn (diff-beginning-of-file-and-junk) (point)))
- (inhibit-read-only t))
- (diff-end-of-file)
- (if (looking-at "^\n") (forward-char 1)) ;`tla' generates such diffs.
- (if (> orig (point)) (error "Not inside a file diff"))
- (kill-region start (point))))
+ (let ((inhibit-read-only t))
+ (apply 'kill-region (diff-bounds-of-file))))
(defun diff-kill-junk ()
"Kill spurious empty diffs."
@@ -663,7 +733,7 @@ data such as \"Index: ...\" and such."
(save-excursion
(let ((n 0))
(goto-char start)
- (while (re-search-forward re end t) (incf n))
+ (while (re-search-forward re end t) (cl-incf n))
n)))
(defun diff-splittable-p ()
@@ -678,7 +748,7 @@ data such as \"Index: ...\" and such."
(interactive)
(beginning-of-line)
(let ((pos (point))
- (start (progn (diff-beginning-of-hunk) (point))))
+ (start (diff-beginning-of-hunk)))
(unless (looking-at diff-hunk-header-re-unified)
(error "diff-split-hunk only works on unified context diffs"))
(forward-line 1)
@@ -787,16 +857,16 @@ PREFIX is only used internally: don't use it."
;; use any previously used preference
(cdr (assoc fs diff-remembered-files-alist))
;; try to be clever and use previous choices as an inspiration
- (dolist (rf diff-remembered-files-alist)
+ (cl-dolist (rf diff-remembered-files-alist)
(let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf))))
- (if (and newfile (file-exists-p newfile)) (return newfile))))
+ (if (and newfile (file-exists-p newfile)) (cl-return newfile))))
;; look for each file in turn. If none found, try again but
;; ignoring the first level of directory, ...
- (do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
- (file nil nil))
+ (cl-do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
+ (file nil nil))
((or (null files)
- (setq file (do* ((files files (cdr files))
- (file (car files) (car files)))
+ (setq file (cl-do* ((files files (cdr files))
+ (file (car files) (car files)))
;; Use file-regular-p to avoid
;; /dev/null, directories, etc.
((or (null file) (file-regular-p file))
@@ -815,7 +885,7 @@ PREFIX is only used internally: don't use it."
(diff-find-file-name old noprompt (match-string 1)))
;; if all else fails, ask the user
(unless noprompt
- (let ((file (expand-file-name (or (first fs) ""))))
+ (let ((file (expand-file-name (or (car fs) ""))))
(setq file
(read-file-name (format "Use file %s: " file)
(file-name-directory file) file t
@@ -843,7 +913,7 @@ PREFIX is only used internally: don't use it."
"Convert unified diffs to context diffs.
START and END are either taken from the region (if a prefix arg is given) or
else cover the whole buffer."
- (interactive (if (or current-prefix-arg (and transient-mark-mode mark-active))
+ (interactive (if (or current-prefix-arg (use-region-p))
(list (region-beginning) (region-end))
(list (point-min) (point-max))))
(unless (markerp end) (setq end (copy-marker end t)))
@@ -893,21 +963,23 @@ else cover the whole buffer."
(let ((modif nil) last-pt)
(while (progn (setq last-pt (point))
(= (forward-line -1) 0))
- (case (char-after)
+ (pcase (char-after)
(?\s (insert " ") (setq modif nil) (backward-char 1))
(?+ (delete-region (point) last-pt) (setq modif t))
(?- (if (not modif)
- (progn (forward-char 1)
- (insert " "))
- (delete-char 1)
- (insert "! "))
- (backward-char 2))
+ (progn (forward-char 1)
+ (insert " "))
+ (delete-char 1)
+ (insert "! "))
+ (backward-char 2))
(?\\ (when (save-excursion (forward-line -1)
- (= (char-after) ?+))
- (delete-region (point) last-pt) (setq modif t)))
+ (= (char-after) ?+))
+ (delete-region (point) last-pt)
+ (setq modif t)))
;; diff-valid-unified-empty-line.
- (?\n (insert " ") (setq modif nil) (backward-char 2))
- (t (setq modif nil))))))
+ (?\n (insert " ") (setq modif nil)
+ (backward-char 2))
+ (_ (setq modif nil))))))
(goto-char (point-max))
(save-excursion
(insert "--- " line2 ","
@@ -920,7 +992,8 @@ else cover the whole buffer."
(if (not (save-excursion (re-search-forward "^+" nil t)))
(delete-region (point) (point-max))
(let ((modif nil) (delete nil))
- (if (save-excursion (re-search-forward "^\\+.*\n-" nil t))
+ (if (save-excursion (re-search-forward "^\\+.*\n-"
+ nil t))
;; Normally, lines in a substitution come with
;; first the removals and then the additions, and
;; the context->unified function follows this
@@ -929,22 +1002,22 @@ else cover the whole buffer."
;; context->unified as an undo command.
(setq reversible nil))
(while (not (eobp))
- (case (char-after)
+ (pcase (char-after)
(?\s (insert " ") (setq modif nil) (backward-char 1))
(?- (setq delete t) (setq modif t))
(?+ (if (not modif)
- (progn (forward-char 1)
- (insert " "))
- (delete-char 1)
- (insert "! "))
- (backward-char 2))
+ (progn (forward-char 1)
+ (insert " "))
+ (delete-char 1)
+ (insert "! "))
+ (backward-char 2))
(?\\ (when (save-excursion (forward-line 1)
- (not (eobp)))
- (setq delete t) (setq modif t)))
+ (not (eobp)))
+ (setq delete t) (setq modif t)))
;; diff-valid-unified-empty-line.
(?\n (insert " ") (setq modif nil) (backward-char 2)
(setq reversible nil))
- (t (setq modif nil)))
+ (_ (setq modif nil)))
(let ((last-pt (point)))
(forward-line 1)
(when delete
@@ -964,7 +1037,7 @@ else cover the whole buffer."
START and END are either taken from the region
\(when it is highlighted) or else cover the whole buffer.
With a prefix argument, convert unified format to context format."
- (interactive (if (and transient-mark-mode mark-active)
+ (interactive (if (use-region-p)
(list (region-beginning) (region-end) current-prefix-arg)
(list (point-min) (point-max) current-prefix-arg)))
(if to-context
@@ -974,7 +1047,7 @@ With a prefix argument, convert unified format to context format."
(inhibit-read-only t))
(save-excursion
(goto-char start)
- (while (and (re-search-forward "^\\(\\(\\*\\*\\*\\) .+\n\\(---\\) .+\\|\\*\\{15\\}.*\n\\*\\*\\* \\([0-9]+\\),\\(-?[0-9]+\\) \\*\\*\\*\\*\\)$" nil t)
+ (while (and (re-search-forward "^\\(\\(\\*\\*\\*\\) .+\n\\(---\\) .+\\|\\*\\{15\\}.*\n\\*\\*\\* \\([0-9]+\\),\\(-?[0-9]+\\) \\*\\*\\*\\*\\)\\(?: \\(.*\\)\\|$\\)" nil t)
(< (point) end))
(combine-after-change-calls
(if (match-beginning 2)
@@ -990,7 +1063,9 @@ With a prefix argument, convert unified format to context format."
;; Variables to use the special undo function.
(old-undo buffer-undo-list)
(old-end (marker-position end))
- (reversible t))
+ ;; We currently throw away the comment that can follow
+ ;; the hunk header. FIXME: Preserve it instead!
+ (reversible (not (match-end 6))))
(replace-match "")
(unless (re-search-forward
diff-context-mid-hunk-header-re nil t)
@@ -1004,17 +1079,18 @@ With a prefix argument, convert unified format to context format."
(goto-char pt1)
(forward-line 1)
(while (< (point) pt2)
- (case (char-after)
+ (pcase (char-after)
(?! (delete-char 2) (insert "-") (forward-line 1))
(?- (forward-char 1) (delete-char 1) (forward-line 1))
- (?\s ;merge with the other half of the chunk
+ (?\s ;merge with the other half of the chunk
(let* ((endline2
(save-excursion
(goto-char pt2) (forward-line 1) (point))))
- (case (char-after pt2)
- ((?! ?+)
+ (pcase (char-after pt2)
+ ((or ?! ?+)
(insert "+"
- (prog1 (buffer-substring (+ pt2 2) endline2)
+ (prog1
+ (buffer-substring (+ pt2 2) endline2)
(delete-region pt2 endline2))))
(?\s
(unless (= (- endline2 pt2)
@@ -1028,9 +1104,9 @@ With a prefix argument, convert unified format to context format."
(delete-char 1)
(forward-line 1))
(?\\ (forward-line 1))
- (t (setq reversible nil)
+ (_ (setq reversible nil)
(delete-char 1) (forward-line 1)))))
- (t (setq reversible nil) (forward-line 1))))
+ (_ (setq reversible nil) (forward-line 1))))
(while (looking-at "[+! ] ")
(if (/= (char-after) ?!) (forward-char 1)
(delete-char 1) (insert "+"))
@@ -1059,7 +1135,7 @@ With a prefix argument, convert unified format to context format."
"Reverse the direction of the diffs.
START and END are either taken from the region (if a prefix arg is given) or
else cover the whole buffer."
- (interactive (if (or current-prefix-arg (and transient-mark-mode mark-active))
+ (interactive (if (or current-prefix-arg (use-region-p))
(list (region-beginning) (region-end))
(list (point-min) (point-max))))
(unless (markerp end) (setq end (copy-marker end t)))
@@ -1108,13 +1184,13 @@ else cover the whole buffer."
(replace-match "@@ -\\8 +\\7 @@" nil)
(forward-line 1)
(let ((c (char-after)) first last)
- (while (case (setq c (char-after))
+ (while (pcase (setq c (char-after))
(?- (setq first (or first (point)))
- (delete-char 1) (insert "+") t)
+ (delete-char 1) (insert "+") t)
(?+ (setq last (or last (point)))
- (delete-char 1) (insert "-") t)
- ((?\\ ?#) t)
- (t (when (and first last (< first last))
+ (delete-char 1) (insert "-") t)
+ ((or ?\\ ?#) t)
+ (_ (when (and first last (< first last))
(insert (delete-and-extract-region first last)))
(setq first nil last nil)
(memq c (if diff-valid-unified-empty-line
@@ -1125,7 +1201,7 @@ else cover the whole buffer."
"Fixup the hunk headers (in case the buffer was modified).
START and END are either taken from the region (if a prefix arg is given) or
else cover the whole buffer."
- (interactive (if (or current-prefix-arg (and transient-mark-mode mark-active))
+ (interactive (if (or current-prefix-arg (use-region-p))
(list (region-beginning) (region-end))
(list (point-min) (point-max))))
(let ((inhibit-read-only t))
@@ -1137,13 +1213,13 @@ else cover the whole buffer."
(concat diff-hunk-header-re-unified
"\\|[-*][-*][-*] [0-9,]+ [-*][-*][-*][-*]$"
"\\|--- .+\n\\+\\+\\+ ")))
- (case (char-after)
- (?\s (incf space))
- (?+ (incf plus))
- (?- (incf minus))
- (?! (incf bang))
- ((?\\ ?#) nil)
- (t (setq space 0 plus 0 minus 0 bang 0)))
+ (pcase (char-after)
+ (?\s (cl-incf space))
+ (?+ (cl-incf plus))
+ (?- (cl-incf minus))
+ (?! (cl-incf bang))
+ ((or ?\\ ?#) nil)
+ (_ (setq space 0 plus 0 minus 0 bang 0)))
(cond
((looking-at diff-hunk-header-re-unified)
(let* ((old1 (match-string 2))
@@ -1263,6 +1339,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)
@@ -1283,11 +1362,7 @@ a diff with \\[diff-reverse-direction].
(set (make-local-variable 'end-of-defun-function)
'diff-end-of-file)
- ;; Set up `whitespace-mode' so that turning it on will show trailing
- ;; whitespace problems on the modified lines of the diff.
- (set (make-local-variable 'whitespace-style) '(face trailing))
- (set (make-local-variable 'whitespace-trailing-regexp)
- "^[-\+!<>].*?\\([\t ]+\\)$")
+ (diff-setup-whitespace)
(setq buffer-read-only diff-default-read-only)
;; setup change hooks
@@ -1332,6 +1407,24 @@ the mode if ARG is omitted or nil.
;;; Handy hook functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun diff-setup-whitespace ()
+ "Set up Whitespace mode variables for the current Diff mode buffer.
+This sets `whitespace-style' and `whitespace-trailing-regexp' so
+that Whitespace mode shows trailing whitespace problems on the
+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)))))
+ (set (make-local-variable 'whitespace-trailing-regexp)
+ (if (eq style 'context)
+ "^[-\+!] .*?\\([\t ]+\\)$"
+ "^[-\+!<>].*?\\([\t ]+\\)$"))))
+
(defun diff-delete-if-empty ()
;; An empty diff file means there's no more diffs to integrate, so we
;; can just remove the file altogether. Very handy for .rej files if we
@@ -1373,7 +1466,7 @@ Only works for unified diffs."
(cond
((and (memq (char-after) '(?\s ?! ?+ ?-))
(memq (char-after (1+ (point))) '(?\s ?\t)))
- (decf count) t)
+ (cl-decf count) t)
((or (zerop count) (= count lines)) nil)
((memq (char-after) '(?! ?+ ?-))
(if (not (and (eq (char-after (1+ (point))) ?\n)
@@ -1424,8 +1517,8 @@ Only works for unified diffs."
(after (string-to-number (or (match-string 4) "1"))))
(forward-line)
(while
- (case (char-after)
- (?\s (decf before) (decf after) t)
+ (pcase (char-after)
+ (?\s (cl-decf before) (cl-decf after) t)
(?-
(if (and (looking-at diff-file-header-re)
(zerop before) (zerop after))
@@ -1435,15 +1528,15 @@ Only works for unified diffs."
;; line so that our code which doesn't count lines
;; will not get confused.
(progn (save-excursion (insert "\n")) nil)
- (decf before) t))
- (?+ (decf after) t)
- (t
+ (cl-decf before) t))
+ (?+ (cl-decf after) t)
+ (_
(cond
((and diff-valid-unified-empty-line
;; Not just (eolp) so we don't infloop at eob.
(eq (char-after) ?\n)
(> before 0) (> after 0))
- (decf before) (decf after) t)
+ (cl-decf before) (cl-decf after) t)
((and (zerop before) (zerop after)) nil)
((or (< before 0) (< after 0))
(error (if (or (zerop before) (zerop after))
@@ -1588,8 +1681,7 @@ SWITCHED is non-nil if the patch is already applied.
NOPROMPT, if non-nil, means not to prompt the user."
(save-excursion
(let* ((other (diff-xor other-file diff-jump-to-old-file))
- (char-offset (- (point) (progn (diff-beginning-of-hunk 'try-harder)
- (point))))
+ (char-offset (- (point) (diff-beginning-of-hunk t)))
;; Check that the hunk is well-formed. Otherwise diff-mode and
;; the user may disagree on what constitutes the hunk
;; (e.g. because an empty line truncates the hunk mid-course),
@@ -1661,16 +1753,17 @@ the value of this variable when given an appropriate prefix argument).
With a prefix argument, REVERSE the hunk."
(interactive "P")
- (destructuring-bind (buf line-offset pos old new &optional switched)
- ;; Sometimes we'd like to have the following behavior: if REVERSE go
- ;; to the new file, otherwise go to the old. But that means that by
- ;; default we use the old file, which is the opposite of the default
- ;; for diff-goto-source, and is thus confusing. Also when you don't
- ;; know about it it's pretty surprising.
- ;; TODO: make it possible to ask explicitly for this behavior.
- ;;
- ;; This is duplicated in diff-test-hunk.
- (diff-find-source-location nil reverse)
+ (pcase-let ((`(,buf ,line-offset ,pos ,old ,new ,switched)
+ ;; Sometimes we'd like to have the following behavior: if
+ ;; REVERSE go to the new file, otherwise go to the old.
+ ;; But that means that by default we use the old file, which is
+ ;; the opposite of the default for diff-goto-source, and is thus
+ ;; confusing. Also when you don't know about it it's
+ ;; pretty surprising.
+ ;; TODO: make it possible to ask explicitly for this behavior.
+ ;;
+ ;; This is duplicated in diff-test-hunk.
+ (diff-find-source-location nil reverse)))
(cond
((null line-offset)
(error "Can't find the text to patch"))
@@ -1713,8 +1806,8 @@ With a prefix argument, REVERSE the hunk."
"See whether it's possible to apply the current hunk.
With a prefix argument, try to REVERSE the hunk."
(interactive "P")
- (destructuring-bind (buf line-offset pos src _dst &optional switched)
- (diff-find-source-location nil reverse)
+ (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+ (diff-find-source-location nil reverse)))
(set-window-point (display-buffer buf) (+ (car pos) (cdr src)))
(diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
@@ -1733,8 +1826,8 @@ then `diff-jump-to-old-file' is also set, for the next invocations."
;; This is a convenient detail when using smerge-diff.
(if event (posn-set-point (event-end event)))
(let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]")))))
- (destructuring-bind (buf line-offset pos src _dst &optional switched)
- (diff-find-source-location other-file rev)
+ (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+ (diff-find-source-location other-file rev)))
(pop-to-buffer buf)
(goto-char (+ (car pos) (cdr src)))
(diff-hunk-status-msg line-offset (diff-xor rev switched) t))))
@@ -1751,10 +1844,11 @@ For use in `add-log-current-defun-function'."
(when (looking-at diff-hunk-header-re)
(forward-line 1)
(re-search-forward "^[^ ]" nil t))
- (destructuring-bind (&optional buf _line-offset pos src dst switched)
- ;; Use `noprompt' since this is used in which-func-mode and such.
- (ignore-errors ;Signals errors in place of prompting.
- (diff-find-source-location nil nil 'noprompt))
+ (pcase-let ((`(,buf ,_line-offset ,pos ,src ,dst ,switched)
+ (ignore-errors ;Signals errors in place of prompting.
+ ;; Use `noprompt' since this is used in which-func-mode
+ ;; and such.
+ (diff-find-source-location nil nil 'noprompt))))
(when buf
(beginning-of-line)
(or (when (memq (char-after) '(?< ?-))
@@ -1776,9 +1870,8 @@ For use in `add-log-current-defun-function'."
(defun diff-ignore-whitespace-hunk ()
"Re-diff the current hunk, ignoring whitespace differences."
(interactive)
- (let* ((char-offset (- (point) (progn (diff-beginning-of-hunk 'try-harder)
- (point))))
- (opts (case (char-after) (?@ "-bu") (?* "-bc") (t "-b")))
+ (let* ((char-offset (- (point) (diff-beginning-of-hunk t)))
+ (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b")))
(line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)")
(error "Can't find line number"))
(string-to-number (match-string 1))))
@@ -1800,13 +1893,13 @@ For use in `add-log-current-defun-function'."
(let ((status
(call-process diff-command nil t nil
opts file1 file2)))
- (case status
- (0 nil) ;Nothing to reformat.
+ (pcase status
+ (0 nil) ;Nothing to reformat.
(1 (goto-char (point-min))
- ;; Remove the file-header.
- (when (re-search-forward diff-hunk-header-re nil t)
- (delete-region (point-min) (match-beginning 0))))
- (t (goto-char (point-max))
+ ;; Remove the file-header.
+ (when (re-search-forward diff-hunk-header-re nil t)
+ (delete-region (point-min) (match-beginning 0))))
+ (_ (goto-char (point-max))
(unless (bolp) (insert "\n"))
(insert hunk)))
(setq hunk (buffer-string))
@@ -1822,17 +1915,35 @@ For use in `add-log-current-defun-function'."
(defface diff-refine-change
'((((class color) (min-colors 88) (background light))
- :background "grey85")
+ :background "#ffff55")
(((class color) (min-colors 88) (background dark))
- :background "grey60")
- (((class color) (background light))
- :background "yellow")
- (((class color) (background dark))
- :background "green")
- (t :weight bold))
+ :background "#aaaa22")
+ (t :inverse-video t))
"Face used for char-based changes shown by `diff-refine-hunk'."
:group 'diff-mode)
+(defface diff-refine-removed
+ '((default
+ :inherit diff-refine-change)
+ (((class color) (min-colors 88) (background light))
+ :background "#ffbbbb")
+ (((class color) (min-colors 88) (background dark))
+ :background "#aa2222"))
+ "Face used for removed characters shown by `diff-refine-hunk'."
+ :group 'diff-mode
+ :version "24.3")
+
+(defface diff-refine-added
+ '((default
+ :inherit diff-refine-change)
+ (((class color) (min-colors 88) (background light))
+ :background "#aaffaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#22aa22"))
+ "Face used for added characters shown by `diff-refine-hunk'."
+ :group 'diff-mode
+ :version "24.3")
+
(defun diff-refine-preproc ()
(while (re-search-forward "^[+>]" nil t)
;; Remove spurious changes due to the fact that one side of the hunk is
@@ -1846,18 +1957,20 @@ For use in `add-log-current-defun-function'."
)
(declare-function smerge-refine-subst "smerge-mode"
- (beg1 end1 beg2 end2 props &optional preproc))
+ (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a))
(defun diff-refine-hunk ()
"Highlight changes of hunk at point at a finer granularity."
(interactive)
(require 'smerge-mode)
(save-excursion
- (diff-beginning-of-hunk 'try-harder)
+ (diff-beginning-of-hunk t)
(let* ((start (point))
(style (diff-hunk-style)) ;Skips the hunk header as well.
(beg (point))
- (props '((diff-mode . fine) (face diff-refine-change)))
+ (props-c '((diff-mode . fine) (face diff-refine-change)))
+ (props-r '((diff-mode . fine) (face diff-refine-removed)))
+ (props-a '((diff-mode . fine) (face diff-refine-added)))
;; Be careful to go back to `start' so diff-end-of-hunk gets
;; to read the hunk header's line info.
(end (progn (goto-char start) (diff-end-of-hunk) (point))))
@@ -1865,14 +1978,19 @@ For use in `add-log-current-defun-function'."
(remove-overlays beg end 'diff-mode 'fine)
(goto-char beg)
- (case style
- (unified
- (while (re-search-forward "^\\(?:-.*\n\\)+\\(\\)\\(?:\\+.*\n\\)+"
- end t)
+ (pcase style
+ (`unified
+ (while (re-search-forward
+ (eval-when-compile
+ (let ((no-LF-at-eol-re "\\(?:\\\\.*\n\\)?"))
+ (concat "^\\(?:-.*\n\\)+" no-LF-at-eol-re
+ "\\(\\)"
+ "\\(?:\\+.*\n\\)+" no-LF-at-eol-re)))
+ end t)
(smerge-refine-subst (match-beginning 0) (match-end 1)
(match-end 1) (match-end 0)
- props 'diff-refine-preproc)))
- (context
+ nil 'diff-refine-preproc props-r props-a)))
+ (`context
(let* ((middle (save-excursion (re-search-forward "^---")))
(other middle))
(while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
@@ -1883,15 +2001,23 @@ For use in `add-log-current-defun-function'."
(setq other (match-end 0))
(match-beginning 0))
other
- props 'diff-refine-preproc))))
- (t ;; Normal diffs.
+ (if diff-use-changed-face props-c)
+ 'diff-refine-preproc
+ (unless diff-use-changed-face props-r)
+ (unless diff-use-changed-face props-a)))))
+ (_ ;; Normal diffs.
(let ((beg1 (1+ (point))))
(when (re-search-forward "^---.*\n" end t)
;; It's a combined add&remove, so there's something to do.
(smerge-refine-subst beg1 (match-beginning 0)
(match-end 0) end
- props 'diff-refine-preproc))))))))
+ nil 'diff-refine-preproc props-r props-a))))))))
+(defun diff-undo (&optional arg)
+ "Perform `undo', ignoring the buffer's read-only status."
+ (interactive "P")
+ (let ((inhibit-read-only t))
+ (undo arg)))
(defun diff-add-change-log-entries-other-window ()
"Iterate through the current diff and create ChangeLog entries.
@@ -1924,6 +2050,72 @@ I.e. like `add-change-log-entry-other-window' but applied to all hunks."
;; When there's no more hunks, diff-hunk-next signals an error.
(error nil))))
+(defun diff-delete-trailing-whitespace (&optional other-file)
+ "Remove trailing whitespace from lines modified in this diff.
+This edits both the current Diff mode buffer and the patched
+source file(s). If `diff-jump-to-old-file' is non-nil, edit the
+original (unpatched) source file instead. With a prefix argument
+OTHER-FILE, flip the choice of which source file to edit.
+
+If a file referenced in the diff has no buffer and needs to be
+fixed, visit it in a buffer."
+ (interactive "P")
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((other (diff-xor other-file diff-jump-to-old-file))
+ (modified-buffers nil)
+ (style (save-excursion
+ (when (re-search-forward diff-hunk-header-re nil t)
+ (goto-char (match-beginning 0))
+ (diff-hunk-style))))
+ (regexp (concat "^[" (if other "-<" "+>") "!]"
+ (if (eq style 'context) " " "")
+ ".*?\\([ \t]+\\)$"))
+ (inhibit-read-only t)
+ (end-marker (make-marker))
+ hunk-end)
+ ;; Move to the first hunk.
+ (re-search-forward diff-hunk-header-re nil 1)
+ (while (progn (save-excursion
+ (re-search-forward diff-hunk-header-re nil 1)
+ (setq hunk-end (point)))
+ (< (point) hunk-end))
+ ;; For context diffs, search only in the appropriate half of
+ ;; the hunk. For other diffs, search within the entire hunk.
+ (if (not (eq style 'context))
+ (set-marker end-marker hunk-end)
+ (let ((mid-hunk
+ (save-excursion
+ (re-search-forward diff-context-mid-hunk-header-re hunk-end)
+ (point))))
+ (if other
+ (set-marker end-marker mid-hunk)
+ (goto-char mid-hunk)
+ (set-marker end-marker hunk-end))))
+ (while (re-search-forward regexp end-marker t)
+ (let ((match-data (match-data)))
+ (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,_switched)
+ (diff-find-source-location other-file)))
+ (when line-offset
+ ;; Remove the whitespace in the Diff mode buffer.
+ (set-match-data match-data)
+ (replace-match "" t t nil 1)
+ ;; Remove the whitespace in the source buffer.
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (+ (car pos) (cdr src)))
+ (beginning-of-line)
+ (when (re-search-forward "\\([ \t]+\\)$" (line-end-position) t)
+ (unless (memq buf modified-buffers)
+ (push buf modified-buffers))
+ (replace-match ""))))))))
+ (goto-char hunk-end))
+ (if modified-buffers
+ (message "Deleted trailing whitespace from %s."
+ (mapconcat (lambda (buf) (concat "`" (buffer-name buf) "'"))
+ modified-buffers ", "))
+ (message "No trailing whitespace to delete.")))))
+
;; provide the package
(provide 'diff-mode)
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index fd24558da6a..b1c334ddcfc 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -1,6 +1,6 @@
-;;; diff.el --- run `diff'
+;;; diff.el --- run `diff' -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 1994, 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Frank Bresz
;; (according to authors.el)
@@ -30,7 +30,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(declare-function diff-setup-whitespace "diff-mode" ())
(defgroup diff nil
"Comparing files with `diff'."
@@ -64,6 +64,8 @@ If optional args OLD-TEMP-FILE and/or NEW-TEMP-FILE are non-nil,
delete the temporary files so named."
(if old-temp-file (delete-file old-temp-file))
(if new-temp-file (delete-file new-temp-file))
+ (diff-setup-whitespace)
+ (goto-char (point-min))
(save-excursion
(goto-char (point-max))
(let ((inhibit-read-only t))
@@ -144,11 +146,8 @@ specified in `diff-switches' are passed to the diff command."
(buffer-enable-undo (current-buffer))
(diff-mode)
(set (make-local-variable 'revert-buffer-function)
- (lexical-let ((old old) (new new)
- (switches switches)
- (no-async no-async))
- (lambda (ignore-auto noconfirm)
- (diff-no-select old new switches no-async (current-buffer)))))
+ (lambda (_ignore-auto _noconfirm)
+ (diff-no-select old new switches no-async (current-buffer))))
(setq default-directory thisdir)
(let ((inhibit-read-only t))
(insert command "\n"))
@@ -156,12 +155,11 @@ specified in `diff-switches' are passed to the diff command."
(let ((proc (start-process "Diff" buf shell-file-name
shell-command-switch command)))
(set-process-filter proc 'diff-process-filter)
- (lexical-let ((old-alt old-alt) (new-alt new-alt))
- (set-process-sentinel
- proc (lambda (proc msg)
- (with-current-buffer (process-buffer proc)
- (diff-sentinel (process-exit-status proc)
- old-alt new-alt))))))
+ (set-process-sentinel
+ proc (lambda (proc _msg)
+ (with-current-buffer (process-buffer proc)
+ (diff-sentinel (process-exit-status proc)
+ old-alt new-alt)))))
;; Async processes aren't available.
(let ((inhibit-read-only t))
(diff-sentinel
@@ -199,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-diff.el b/lisp/vc/ediff-diff.el
index 85ec49885bd..5b31e625a00 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -1,6 +1,6 @@
;;; ediff-diff.el --- diff-related utilities
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -101,7 +101,7 @@ the command \\[ediff-show-diff-output]. Use the variable
:group 'ediff-diff)
(ediff-defvar-local ediff-ignore-case nil
- "*If t, skip over difference regions that differ only in letter case.
+ "If t, skip over difference regions that differ only in letter case.
This variable can be set either in .emacs or toggled interactively.
Use `setq-default' if setting it in .emacs")
@@ -165,12 +165,12 @@ This variable can be set either in .emacs or toggled interactively.
Use `setq-default' if setting it in .emacs")
(ediff-defvar-local ediff-ignore-similar-regions nil
- "*If t, skip over difference regions that differ only in the white space and line breaks.
+ "If t, skip over difference regions that differ only in the white space and line breaks.
This variable can be set either in .emacs or toggled interactively.
Use `setq-default' if setting it in .emacs")
(ediff-defvar-local ediff-auto-refine-limit 14000
- "*Auto-refine only the regions of this size \(in bytes\) or less.")
+ "Auto-refine only the regions of this size \(in bytes\) or less.")
;;; General
@@ -1288,38 +1288,38 @@ delimiter regions"))
;;; Word functions used to refine the current diff
(defvar ediff-forward-word-function 'ediff-forward-word
- "*Function to call to move to the next word.
+ "Function to call to move to the next word.
Used for splitting difference regions into individual words.")
(make-variable-buffer-local 'ediff-forward-word-function)
;; \240 is Unicode symbol for nonbreakable whitespace
(defvar ediff-whitespace " \n\t\f\r\240"
- "*Characters constituting white space.
+ "Characters constituting white space.
These characters are ignored when differing regions are split into words.")
(make-variable-buffer-local 'ediff-whitespace)
(defvar ediff-word-1
(if (featurep 'xemacs) "a-zA-Z---_" "-[:word:]_")
- "*Characters that constitute words of type 1.
+ "Characters that constitute words of type 1.
More precisely, [ediff-word-1] is a regexp that matches type 1 words.
See `ediff-forward-word' for more details.")
(make-variable-buffer-local 'ediff-word-1)
(defvar ediff-word-2 "0-9.,"
- "*Characters that constitute words of type 2.
+ "Characters that constitute words of type 2.
More precisely, [ediff-word-2] is a regexp that matches type 2 words.
See `ediff-forward-word' for more details.")
(make-variable-buffer-local 'ediff-word-2)
(defvar ediff-word-3 "`'?!:;\"{}[]()"
- "*Characters that constitute words of type 3.
+ "Characters that constitute words of type 3.
More precisely, [ediff-word-3] is a regexp that matches type 3 words.
See `ediff-forward-word' for more details.")
(make-variable-buffer-local 'ediff-word-3)
(defvar ediff-word-4
(concat "^" ediff-word-1 ediff-word-2 ediff-word-3 ediff-whitespace)
- "*Characters that constitute words of type 4.
+ "Characters that constitute words of type 4.
More precisely, [ediff-word-4] is a regexp that matches type 4 words.
See `ediff-forward-word' for more details.")
(make-variable-buffer-local 'ediff-word-4)
@@ -1406,13 +1406,27 @@ arguments to `skip-chars-forward'."
"Return t if files F1 and F2 have identical contents."
(if (and (not (file-directory-p f1))
(not (file-directory-p f2)))
- (let ((res
- (apply 'call-process ediff-cmp-program nil nil nil
- (append ediff-cmp-options (list (expand-file-name f1)
- (expand-file-name f2))))
- ))
- (and (numberp res) (eq res 0)))
- ))
+ (if (equal (file-remote-p f1) (file-remote-p f2))
+ (let ((res
+ ;; In the remote case, this works only if F1 and F2 are
+ ;; located on the same remote host.
+ (apply 'process-file ediff-cmp-program nil nil nil
+ (append ediff-cmp-options
+ (list (or (file-remote-p f1 'localname)
+ (expand-file-name f1))
+ (or (file-remote-p f2 'localname)
+ (expand-file-name f2)))))
+ ))
+ (and (numberp res) (eq res 0)))
+
+ ;; F1 and F2 are not located on the same host.
+ (let ((t1 (file-local-copy f1))
+ (t2 (file-local-copy f2)))
+ (unwind-protect
+ (ediff-same-file-contents (or t1 f1) (or t2 f2))
+ (and t1 (delete-file t1))
+ (and t2 (delete-file t2))))
+ )))
(defun ediff-same-contents (d1 d2 &optional filter-re)
diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el
index ee7837b29a3..8d0f9dd5562 100644
--- a/lisp/vc/ediff-help.el
+++ b/lisp/vc/ediff-help.el
@@ -1,6 +1,6 @@
;;; ediff-help.el --- Code related to the contents of Ediff help buffers
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
diff --git a/lisp/vc/ediff-hook.el b/lisp/vc/ediff-hook.el
index 7598cfdba51..a91c53fb115 100644
--- a/lisp/vc/ediff-hook.el
+++ b/lisp/vc/ediff-hook.el
@@ -1,6 +1,6 @@
;;; ediff-hook.el --- setup for Ediff's menus and autoloads
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index d3db66a9e2a..65776dfccad 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -1,6 +1,6 @@
;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -594,7 +594,7 @@ highlighted using ASCII flags."
(ediff-defvar-local ediff-start-narrowed t
"Non-nil means start narrowed, if doing ediff-windows-* or ediff-regions-*")
(ediff-defvar-local ediff-quit-widened t
- "*Non-nil means: when finished, Ediff widens buffers A/B.
+ "Non-nil means: when finished, Ediff widens buffers A/B.
Actually, Ediff restores the scope of visibility that existed at startup.")
(defcustom ediff-keep-variants t
@@ -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)
@@ -786,19 +784,12 @@ TYPE-OF-EMACS is either 'xemacs or 'emacs."
"")
-(if (ediff-window-display-p)
- (if (featurep 'xemacs)
- (progn
- (defalias 'ediff-display-pixel-width 'device-pixel-width)
- (defalias 'ediff-display-pixel-height 'device-pixel-height))
- (defalias 'ediff-display-pixel-width
- (if (fboundp 'display-pixel-width)
- 'display-pixel-width
- 'x-display-pixel-width))
- (defalias 'ediff-display-pixel-height
- (if (fboundp 'display-pixel-height)
- 'display-pixel-height
- 'x-display-pixel-height))))
+(if (featurep 'xemacs)
+ (progn
+ (defalias 'ediff-display-pixel-width 'device-pixel-width)
+ (defalias 'ediff-display-pixel-height 'device-pixel-height))
+ (defalias 'ediff-display-pixel-width 'display-pixel-width)
+ (defalias 'ediff-display-pixel-height 'display-pixel-height))
;; A-list of current-diff-overlay symbols associated with buf types
(defconst ediff-current-diff-overlay-alist
@@ -860,7 +851,11 @@ TYPE-OF-EMACS is either 'xemacs or 'emacs."
(defface ediff-current-diff-A
(if (featurep 'emacs)
- '((((class color) (min-colors 16))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffdddd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#553333")
+ (((class color) (min-colors 16))
(:foreground "firebrick" :background "pale green"))
(((class color))
(:foreground "blue3" :background "yellow3"))
@@ -889,7 +884,11 @@ this variable represents.")
(defface ediff-current-diff-B
(if (featurep 'emacs)
- '((((class color) (min-colors 16))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ddffdd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#335533")
+ (((class color) (min-colors 16))
(:foreground "DarkOrchid" :background "Yellow"))
(((class color))
(:foreground "magenta3" :background "yellow3"
@@ -919,7 +918,11 @@ this variable represents.")
(defface ediff-current-diff-C
(if (featurep 'emacs)
- '((((class color) (min-colors 16))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffffaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#888833")
+ (((class color) (min-colors 16))
(:foreground "Navy" :background "Pink"))
(((class color))
(:foreground "cyan3" :background "yellow3" :weight bold))
@@ -975,7 +978,11 @@ this variable represents.")
(defface ediff-fine-diff-A
(if (featurep 'emacs)
- '((((class color) (min-colors 16))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffbbbb")
+ (((class color) (min-colors 88) (background dark))
+ :background "#aa2222")
+ (((class color) (min-colors 16))
(:foreground "Navy" :background "sky blue"))
(((class color))
(:foreground "white" :background "sky blue" :weight bold))
@@ -996,7 +1003,11 @@ this variable represents.")
(defface ediff-fine-diff-B
(if (featurep 'emacs)
- '((((class color) (min-colors 16))
+ '((((class color) (min-colors 88) (background light))
+ :background "#aaffaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#22aa22")
+ (((class color) (min-colors 16))
(:foreground "Black" :background "cyan"))
(((class color))
(:foreground "magenta3" :background "cyan3"))
@@ -1017,7 +1028,11 @@ this variable represents.")
(defface ediff-fine-diff-C
(if (featurep 'emacs)
- '((((type pc))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffff55")
+ (((class color) (min-colors 88) (background dark))
+ :background "#aaaa22")
+ (((type pc))
(:foreground "white" :background "Turquoise"))
(((class color) (min-colors 16))
(:foreground "Black" :background "Turquoise"))
@@ -1743,8 +1758,10 @@ Unless optional argument INPLACE is non-nil, return a new string."
;; If ediff modified mode line, strip the modification
(defsubst ediff-strip-mode-line-format ()
- (if (member (car mode-line-format) '(" A: " " B: " " C: " " Ancestor: "))
- (setq mode-line-format (nth 2 mode-line-format))))
+ (and (consp mode-line-format)
+ (member (car mode-line-format)
+ '(" A: " " B: " " C: " " Ancestor: "))
+ (setq mode-line-format (nth 2 mode-line-format))))
;; Verify that we have a difference selected.
(defsubst ediff-valid-difference-p (&optional n)
diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el
index a584d0791ff..9b817b2fbc1 100644
--- a/lisp/vc/ediff-merg.el
+++ b/lisp/vc/ediff-merg.el
@@ -1,6 +1,6 @@
;;; ediff-merg.el --- merging utilities
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index ce7818d5ef4..5c471664fdc 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -1,6 +1,6 @@
;;; ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -217,8 +217,9 @@ This can be toggled with `ediff-toggle-filename-truncation'."
:type 'hook
:group 'ediff-mult)
-(defcustom ediff-before-session-group-setup-hooks nil
- "Hooks to run before Ediff arranges the window for group-level operations.
+(defcustom ediff-before-session-group-setup-hooks
+ nil ;FIXME: Bad name (should be -hook or -functions) and never run??
+ "Hook run before Ediff arranges the window for group-level operations.
It is used by commands such as `ediff-directories'.
This hook can be used to save the previous window config, which can be restored
on `ediff-quit', `ediff-suspend', or `ediff-quit-session-group-hook'."
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index 6563dca5ec6..def450373cf 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -1,6 +1,6 @@
;;; ediff-ptch.el --- Ediff's patch support
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index b1c6e367ef7..86293ade580 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -1,6 +1,6 @@
;;; ediff-util.el --- the core commands and utilities of ediff
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -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
@@ -3103,7 +3103,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
;; according to context.
;; If DEFAULT-FILE is set, it should be used as the default value.
;; If DEFAULT-DIR is non-nil, use it as the default directory.
-;; Otherwise, use the value of Emacs' variable `default-directory.'
+;; Otherwise, use the value of `default-directory.'
(defun ediff-read-file-name (prompt default-dir default-file &optional no-dirs)
;; hack default-dir if it is not set
(setq default-dir
diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el
index 804e62a2933..195b177bbc9 100644
--- a/lisp/vc/ediff-vers.el
+++ b/lisp/vc/ediff-vers.el
@@ -1,6 +1,6 @@
;;; ediff-vers.el --- version control interface to Ediff
-;; Copyright (C) 1995-1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2001-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 9bf75fa7f55..d7118ad7970 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -1,6 +1,6 @@
;;; ediff-wind.el --- window manipulation utilities
-;; Copyright (C) 1994-1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2000-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -63,20 +63,25 @@
;; 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))
-(defcustom ediff-window-setup-function (ediff-choose-window-setup-function-automatically)
+(defcustom ediff-window-setup-function 'ediff-setup-windows-default
"Function called to set up windows.
-Ediff provides a choice of two functions: `ediff-setup-windows-plain', for
-doing everything in one frame and `ediff-setup-windows-multiframe', which sets
-the control panel in a separate frame. By default, the appropriate function is
-chosen automatically depending on the current window system.
-However, `ediff-toggle-multiframe' can be used to toggle between the multiframe
-display and the single frame display.
-If the multiframe function detects that one of the buffers A/B is seen in some
-other frame, it will try to keep that buffer in that frame.
+Ediff provides a choice of three functions:
+ (1) `ediff-setup-windows-multiframe', which sets the control panel
+ in a separate frame.
+ (2) `ediff-setup-windows-plain', which does everything in one frame
+ (3) `ediff-setup-windows-default' (the default), which does (1)
+ on a graphical display and (2) on a text terminal.
+
+The command \\[ediff-toggle-multiframe] can be used to toggle
+between the multiframe display and the single frame display. If
+the multiframe function detects that one of the buffers A/B is
+seen in some other frame, it will try to keep that buffer in that
+frame.
If you don't like any of the two provided functions, write your own one.
The basic guidelines:
@@ -90,10 +95,12 @@ The basic guidelines:
Buffer C may not be used in jobs that compare only two buffers.
If you plan to do something fancy, take a close look at how the two
provided functions are written."
- :type '(choice (const :tag "Multi Frame" ediff-setup-windows-multiframe)
+ :type '(choice (const :tag "Choose Automatically" ediff-setup-windows-default)
+ (const :tag "Multi Frame" ediff-setup-windows-multiframe)
(const :tag "Single Frame" ediff-setup-windows-plain)
(function :tag "Other function"))
- :group 'ediff-window)
+ :group 'ediff-window
+ :version "24.3")
;; indicates if we are in a multiframe setup
(ediff-defvar-local ediff-multiframe nil "")
@@ -333,6 +340,12 @@ into icons, regardless of the window manager."
buffer-A buffer-B buffer-C control-buffer))
(run-hooks 'ediff-after-setup-windows-hook))
+(defun ediff-setup-windows-default (buffer-A buffer-B buffer-C control-buffer)
+ (funcall (if (display-graphic-p)
+ 'ediff-setup-windows-multiframe
+ 'ediff-setup-windows-plain)
+ buffer-A buffer-B buffer-C control-buffer))
+
;; Just set up 3 windows.
;; Usually used without windowing systems
;; With windowing, we want to use dedicated frames.
@@ -942,7 +955,7 @@ into icons, regardless of the window manager."
(and (eq this-command 'ediff-toggle-help)
dont-iconify-ctl-frame))
- ;; 1 more line for the modeline
+ ;; 1 more line for the mode line
(setq lines (1+ (count-lines (point-min) (point-max)))
fheight lines
fwidth (max (+ (ediff-help-message-line-length) 2)
@@ -1126,7 +1139,7 @@ It assumes that it is called from within the control buffer."
;; Revise the mode line to display which difference we have selected
-;; Also resets modelines of buffers A/B, since they may be clobbered by
+;; Also resets mode lines of buffers A/B, since they may be clobbered by
;; other invocations of Ediff.
(defun ediff-refresh-mode-lines ()
(let (buf-A-state-diff buf-B-state-diff buf-C-state-diff buf-C-state-merge)
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index 464fdc0a589..6929bfb6e0f 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -1,6 +1,6 @@
;;; ediff.el --- a comprehensive visual interface to diff & patch
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Created: February 2, 1994
@@ -101,7 +101,7 @@
;; and on any buffer.
-;;; Acknowledgements:
+;;; Acknowledgments:
;; Ediff was inspired by Dale R. Worley's <drw@math.mit.edu> emerge.el.
;; Ediff would not have been possible without the help and encouragement of
@@ -127,7 +127,7 @@
(require 'ediff-mult) ; required because of the registry stuff
(defgroup ediff nil
- "A comprehensive visual interface to diff & patch."
+ "Comprehensive visual interface to `diff' and `patch'."
:tag "Ediff"
:group 'tools)
@@ -152,7 +152,7 @@
;; Used as a startup hook to set `_orig' patch file read-only.
(defun ediff-set-read-only-in-buf-A ()
(ediff-with-current-buffer ediff-buffer-A
- (toggle-read-only 1)))
+ (setq buffer-read-only t)))
;; Return a plausible default for ediff's first file:
;; In dired, return the file number FILENO (or 0) in the list
@@ -491,12 +491,12 @@ If this file is a backup, `ediff' it with its original."
(setq buf-B-file-name (file-name-nondirectory buf-B-file-name)))
(if (stringp buf-C-file-name)
(setq buf-C-file-name (file-name-nondirectory buf-C-file-name)))
-
+
(setq file-A (ediff-make-temp-file buf-A buf-A-file-name)
file-B (ediff-make-temp-file buf-B buf-B-file-name))
(if buf-C-is-alive
(setq file-C (ediff-make-temp-file buf-C buf-C-file-name)))
-
+
(ediff-setup (get-buffer buf-A) file-A
(get-buffer buf-B) file-B
(if buf-C-is-alive (get-buffer buf-C))
@@ -542,8 +542,8 @@ expression; only file names that match the regexp are considered."
(default-regexp (eval ediff-default-filtering-regexp))
f)
(list (setq f (read-directory-name
- "Directory A to compare:" dir-A nil 'must-match))
- (read-directory-name "Directory B to compare:"
+ "Directory A to compare: " dir-A nil 'must-match))
+ (read-directory-name "Directory B to compare: "
(if ediff-use-last-dir
ediff-last-dir-B
(ediff-strip-last-dir f))
@@ -1072,7 +1072,7 @@ lines. For small regions, use `ediff-regions-wordwise'."
(ediff-with-current-buffer buffer-B
(setq beg-B (move-marker (make-marker) beg-B)
end-B (move-marker (make-marker) end-B)))
-
+
;; make file-A
(if word-mode
(ediff-wordify beg-A end-A buffer-A tmp-buffer)
@@ -1084,7 +1084,7 @@ lines. For small regions, use `ediff-regions-wordwise'."
(ediff-wordify beg-B end-B buffer-B tmp-buffer)
(ediff-copy-to-buffer beg-B end-B buffer-B tmp-buffer))
(setq file-B (ediff-make-temp-file tmp-buffer "regB"))
-
+
(setq overl-A (ediff-make-bullet-proof-overlay beg-A end-A buffer-A))
(setq overl-B (ediff-make-bullet-proof-overlay beg-B end-B buffer-B))
(ediff-setup buffer-A file-A
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index bc4b0725c4e..0a1bd044125 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -39,13 +39,13 @@
(defmacro emerge-defvar-local (var value doc)
"Defines SYMBOL as an advertised variable.
Performs a defvar, then executes `make-variable-buffer-local' on
-the variable. Also sets the `preserved' property, so that
+the variable. Also sets the `permanent-local' property, so that
`kill-all-local-variables' (called by major-mode setting commands)
won't destroy Emerge control variables."
`(progn
(defvar ,var ,value ,doc)
(make-variable-buffer-local ',var)
- (put ',var 'preserved t)))
+ (put ',var 'permanent-local t)))
;; Add entries to minor-mode-alist so that emerge modes show correctly
(defvar emerge-minor-modes-list
@@ -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
@@ -524,10 +512,10 @@ replaced by emerge-fast-keymap.")
(emerge-defvar-local emerge-old-keymap nil
"The original local keymap for the merge buffer.")
(emerge-defvar-local emerge-auto-advance nil
- "*If non-nil, emerge-select-A and emerge-select-B automatically advance to
+ "If non-nil, emerge-select-A and emerge-select-B automatically advance to
the next difference.")
(emerge-defvar-local emerge-skip-prefers nil
- "*If non-nil, differences for which there is a preference are automatically
+ "If non-nil, differences for which there is a preference are automatically
skipped.")
(emerge-defvar-local emerge-quit-hook nil
"Hooks to run in the merge buffer after the merge has been finished.
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index f57429c76c7..3c34a762a1b 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -1,6 +1,6 @@
;;; log-edit.el --- Major mode for editing CVS commit messages -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs cvs commit log vc
@@ -29,7 +29,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'add-log) ; for all the ChangeLog goodies
(require 'pcvs-util)
(require 'ring)
@@ -105,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
@@ -155,13 +148,8 @@ 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
- "*If non-nil, include full ChangeLog paragraphs in the log.
+(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.
@@ -191,11 +179,17 @@ when this variable is set to nil.")
(defvar log-edit-parent-buffer nil)
+(defvar log-edit-vc-backend nil
+ "VC fileset corresponding to the current log.")
+
;;; Originally taken from VC-Log mode
(defconst log-edit-maximum-comment-ring-size 32
"Maximum number of saved comments in the comment ring.")
+(define-obsolete-variable-alias 'vc-comment-ring 'log-edit-comment-ring "22.1")
(defvar log-edit-comment-ring (make-ring log-edit-maximum-comment-ring-size))
+(define-obsolete-variable-alias 'vc-comment-ring-index
+ 'log-edit-comment-ring-index "22.1")
(defvar log-edit-comment-ring-index nil)
(defvar log-edit-last-comment-match "")
@@ -301,8 +295,6 @@ automatically."
(insert "\n"))))
;; Compatibility with old names.
-(define-obsolete-variable-alias 'vc-comment-ring 'log-edit-comment-ring "22.1")
-(define-obsolete-variable-alias 'vc-comment-ring-index 'log-edit-comment-ring-index "22.1")
(define-obsolete-function-alias 'vc-previous-comment 'log-edit-previous-comment "22.1")
(define-obsolete-function-alias 'vc-next-comment 'log-edit-next-comment "22.1")
(define-obsolete-function-alias 'vc-comment-search-reverse 'log-edit-comment-search-backward "22.1")
@@ -349,37 +341,86 @@ automatically."
(defvar log-edit-font-lock-keywords
;; Copied/inspired by message-font-lock-keywords.
`((log-edit-match-to-eoh
- (,(concat "^\\(\\([a-z]+\\):\\)" 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.")
+(put 'log-edit-font-lock-gnu-style 'safe-local-variable 'booleanp)
+
+(defconst log-edit-font-lock-gnu-keywords
+ ;; Use
+ ;; * foo.el (bla, bli)
+ ;; (blo, blu): Toto.
+ ;; Rather than
+ ;; * foo.el (bla, bli,
+ ;; blo, blu): Toto.
+ '(("^[ \t]*\\(?:\\* .*\\)?\\(([^\n)]*,\\s-*\\)$"
+ (1 '(face font-lock-warning-face
+ help-echo "Continue function lists with \")\\n(\".") t))
+ ;; Don't leave a lone word on a single line.
+ ;;("^\\s-*\\(\\S-*[^\n:)]\\)\\s-*$" (1 font-lock-warning-face t))
+ ;; Don't cut a sentence right after the first word (better to move
+ ;; the sentence on the next line, then).
+ ;;("[.:]\\s-+\\(\\sw+\\)\\s-*$" (1 font-lock-warning-face t))
+ ;; Change Log entries should use present tense.
+ ("):[ \t\n]*[[:alpha:]]+\\(ed\\)\\>"
+ (1 '(face font-lock-warning-face help-echo "Use present tense.") t))
+ ;; Change log entries start with a capital letter.
+ ("): [a-z]" (0 '(face font-lock-warning-face help-echo "Capitalize.") t))
+ ("[^[:upper:]]\\(\\. [[:upper:]]\\)"
+ (1 '(face font-lock-warning-face
+ help-echo "Use two spaces to end a sentence") t))
+ ("^("
+ (0 (let ((beg (max (point-min) (- (match-beginning 0) 2))))
+ (put-text-property beg (match-end 0) 'font-lock-multiline t)
+ (if (eq (char-syntax (char-after beg)) ?w)
+ '(face font-lock-warning-face
+ help-echo "Punctuate previous line.")))
+ t))
+ ))
+
+(defun log-edit-font-lock-keywords ()
+ (if log-edit-font-lock-gnu-style
+ (append log-edit-font-lock-keywords
+ log-edit-font-lock-gnu-keywords)
+ log-edit-font-lock-keywords))
;;;###autoload
(defun log-edit (callback &optional setup params buffer mode &rest _ignore)
"Setup a buffer to enter a log message.
-\\<log-edit-mode-map>The buffer will be put in mode MODE or `log-edit-mode'
-if MODE is nil.
-If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run.
-Mark and point will be set around the entire contents of the buffer so
-that it is easy to kill the contents of the buffer with \\[kill-region].
-Once you're done editing the message, pressing \\[log-edit-done] will call
-`log-edit-done' which will end up calling CALLBACK to do the actual commit.
-
-PARAMS if non-nil is an alist. Possible keys and associated values:
+The buffer is put in mode MODE or `log-edit-mode' if MODE is nil.
+\\<log-edit-mode-map>
+If SETUP is non-nil, erase the buffer and run `log-edit-hook'.
+Set mark and point around the entire contents of the buffer, so
+that it is easy to kill the contents of the buffer with
+\\[kill-region]. Once the user is done editing the message,
+invoking the command \\[log-edit-done] (`log-edit-done') will
+call CALLBACK to do the actual commit.
+
+PARAMS if non-nil is an alist of variables and buffer-local
+values to give them in the Log Edit buffer. Possible keys and
+associated values:
`log-edit-listfun' -- function taking no arguments that returns the list of
files that are concerned by the current operation (using relative names);
`log-edit-diff-function' -- function taking no arguments that
displays a diff of the files concerned by the current operation.
+ `vc-log-fileset' -- the VC fileset to be committed (if any).
-If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the
-log message and go back to the current buffer when done. Otherwise, it
-uses the current buffer."
+If BUFFER is non-nil `log-edit' will jump to that buffer, use it
+to edit the log message and go back to the current buffer when
+done. Otherwise, it uses the current buffer."
(let ((parent (current-buffer)))
(if buffer (pop-to-buffer buffer))
(when (and log-edit-setup-invert (not (eq setup 'force)))
@@ -416,7 +457,7 @@ commands (under C-x v for VC, for example).
\\{log-edit-mode-map}"
(set (make-local-variable 'font-lock-defaults)
- '(log-edit-font-lock-keywords t t))
+ '(log-edit-font-lock-keywords t))
(make-local-variable 'log-edit-comment-ring-index)
(hack-dir-local-variables-non-file-buffer))
@@ -536,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))))
@@ -769,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)
@@ -859,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)
@@ -882,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/log-view.el b/lisp/vc/log-view.el
index d8c6384934e..9dda78d0314 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -1,6 +1,6 @@
;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: rcs, sccs, cvs, log, vc, tools
@@ -109,7 +109,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'pcvs-util)
(autoload 'vc-find-revision "vc")
(autoload 'vc-diff-internal "vc")
@@ -246,10 +245,10 @@ The match group number 1 should match the revision number itself.")
'(log-view-font-lock-keywords t nil nil nil))
(defvar log-view-vc-fileset nil
- "Set this to the fileset corresponding to the current log.")
+ "The VC fileset corresponding to the current log.")
(defvar log-view-vc-backend nil
- "Set this to the VC backend that created the current log.")
+ "The VC backend that created the current log.")
;;;;
;;;; Actual code
@@ -376,6 +375,8 @@ log entries."
marked-list)))
(defun log-view-toggle-entry-display ()
+ "If possible, expand the current Log View entry.
+This calls `log-view-expanded-log-entry-function' to do the work."
(interactive)
;; Don't do anything unless `log-view-expanded-log-entry-function'
;; is defined in this mode.
@@ -451,7 +452,7 @@ It assumes that a log entry starts with a line matching
(defun log-view-minor-wrap (buf f)
(let ((data (with-current-buffer buf
(let* ((beg (point))
- (end (if mark-active (mark) (point)))
+ (end (if (use-region-p) (mark) (point)))
(fr (log-view-current-tag beg))
(to (log-view-current-tag end)))
(when (string-equal fr to)
@@ -536,15 +537,17 @@ It assumes that a log entry starts with a line matching
(defun log-view-diff (beg end)
"Get the diff between two revisions.
-If the mark is not active or the mark is on the revision at point,
-get the diff between the revision at point and its previous revision.
-Otherwise, get the diff between the revisions where the region starts
-and ends.
-Contrary to `log-view-diff-changeset', it will only show the part of the
-changeset that affected the currently considered file(s)."
+If the region is inactive or the mark is on the revision at
+point, get the diff between the revision at point and its
+previous revision. Otherwise, get the diff between the revisions
+where the region starts and ends.
+
+Unlike `log-view-diff-changeset', this function only shows the
+part of the changeset which affected the currently considered
+file(s)."
(interactive
- (list (if mark-active (region-beginning) (point))
- (if mark-active (region-end) (point))))
+ (list (if (use-region-p) (region-beginning) (point))
+ (if (use-region-p) (region-end) (point))))
(let ((fr (log-view-current-tag beg))
(to (log-view-current-tag end)))
(when (string-equal fr to)
@@ -559,20 +562,19 @@ changeset that affected the currently considered file(s)."
log-view-vc-fileset))
to fr)))
-(declare-function vc-diff-internal "vc"
- (async vc-fileset rev1 rev2 &optional verbose))
-
(defun log-view-diff-changeset (beg end)
"Get the diff between two revisions.
-If the mark is not active or the mark is on the revision at point,
-get the diff between the revision at point and its previous revision.
-Otherwise, get the diff between the revisions where the region starts
-and ends.
-Contrary to `log-view-diff', it will show the whole changeset including
-the changes that affected other files than the currently considered file(s)."
+If the region is inactive or the mark is on the revision at
+point, get the diff between the revision at point and its
+previous revision. Otherwise, get the diff between the revisions
+where the region starts and ends.
+
+Unlike `log-view-diff' this function shows the whole changeset,
+including changes affecting other files than the currently
+considered file(s)."
(interactive
- (list (if mark-active (region-beginning) (point))
- (if mark-active (region-end) (point))))
+ (list (if (use-region-p) (region-beginning) (point))
+ (if (use-region-p) (region-end) (point))))
(when (eq (vc-call-backend log-view-vc-backend 'revision-granularity) 'file)
(error "The %s backend does not support changeset diffs" log-view-vc-backend))
(let ((fr (log-view-current-tag beg))
diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el
index 477cd472289..b3c1f8c1343 100644
--- a/lisp/vc/pcvs-defs.el
+++ b/lisp/vc/pcvs-defs.el
@@ -1,6 +1,6 @@
;;; pcvs-defs.el --- variable definitions for PCL-CVS
-;; Copyright (C) 1991-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs
@@ -26,14 +26,13 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'pcvs-util)
;;;; -------------------------------------------------------
;;;; START OF THINGS TO CHECK WHEN INSTALLING
(defvar cvs-program "cvs"
- "*Name or full path of the cvs executable.")
+ "Name or full path of the cvs executable.")
(defvar cvs-version
;; With the divergence of the CVSNT codebase and version numbers, this is
@@ -46,23 +45,19 @@
nil t)
(cons (string-to-number (match-string 1))
(string-to-number (match-string 2))))))
- "*Version of `cvs' installed on your system.
+ "Version of `cvs' installed on your system.
It must be in the (MAJOR . MINOR) format.")
;; FIXME: this is only used by cvs-mode-diff-backup
(defvar cvs-diff-program (or (and (boundp 'diff-command) diff-command) "diff")
- "*Name or full path of the best diff program you've got.
+ "Name or full path of the best diff program you've got.
NOTE: there are some nasty bugs in the context diff variants of some vendor
versions, such as the one in SunOS-4.")
;;;; END OF THINGS TO CHECK WHEN INSTALLING
;;;; --------------------------------------------------------
-;;;;
;;;; User configuration variables:
-;;;;
-;;;; NOTE: these should be set in your ~/.emacs (or site-lisp/default.el) file.
-;;;;
(defgroup pcl-cvs nil
"Special support for the CVS versioning system."
@@ -89,7 +84,7 @@ will select a shared-flag.")
"List of flags whose settings is shared among several commands.")
(defvar cvs-cvsroot nil
- "*Specifies where the (current) cvs master repository is.
+ "Specifies where the (current) cvs master repository is.
Overrides the environment variable $CVSROOT by sending \" -d dir\" to
all CVS commands. This switch is useful if you have multiple CVS
repositories. It can be set interactively with \\[cvs-change-cvsroot.]
@@ -138,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))
@@ -176,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
@@ -190,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)
@@ -243,7 +228,7 @@ the directory name of the cvs buffer.")
;; Was '(expand-file-name " *cvs-tmp*" dir), but that causes them to
;; become non-hidden if uniquification is done `forward'.
" *cvs-tmp*"
- "*Name of the cvs temporary buffer.
+ "Name of the cvs temporary buffer.
Output from cvs is placed here for asynchronous commands.")
(defcustom cvs-idiff-imerge-handlers
diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el
index 3fd6cd40299..e863096d587 100644
--- a/lisp/vc/pcvs-info.el
+++ b/lisp/vc/pcvs-info.el
@@ -1,6 +1,6 @@
;;; pcvs-info.el --- internal representation of a fileinfo entry
-;; Copyright (C) 1991-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs
@@ -31,7 +31,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'pcvs-util)
;;(require 'pcvs-defs)
@@ -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")
@@ -146,7 +146,7 @@ to confuse some users sometimes."
;; Constructor:
-(defstruct (cvs-fileinfo
+(cl-defstruct (cvs-fileinfo
(:constructor nil)
(:copier nil)
(:constructor -cvs-create-fileinfo (type dir file full-log
@@ -274,10 +274,10 @@ to confuse some users sometimes."
(string= file (file-name-nondirectory file)))
(setq check 'type) (symbolp type)
(setq check 'consistency)
- (case type
- (DIRCHANGE (and (null subtype) (string= "." file)))
- ((NEED-UPDATE ADDED MISSING DEAD MODIFIED MESSAGE UP-TO-DATE
- REMOVED NEED-MERGE CONFLICT UNKNOWN MESSAGE)
+ (pcase type
+ (`DIRCHANGE (and (null subtype) (string= "." file)))
+ ((or `NEED-UPDATE `ADDED `MISSING `DEAD `MODIFIED `MESSAGE
+ `UP-TO-DATE `REMOVED `NEED-MERGE `CONFLICT `UNKNOWN)
t)))
fi
(error "Invalid :%s in cvs-fileinfo %s" check fi))))
@@ -325,9 +325,9 @@ FI-OR-TYPE can either be a symbol (a fileinfo-type) or a fileinfo."
(defun cvs-add-face (str face &optional keymap &rest props)
(when keymap
(when (keymapp keymap)
- (setq props (list* 'keymap keymap props)))
- (setq props (list* 'mouse-face 'highlight props)))
- (add-text-properties 0 (length str) (list* 'font-lock-face face props) str)
+ (setq props `(keymap ,keymap ,@props)))
+ (setq props `(mouse-face highlight ,@props)))
+ (add-text-properties 0 (length str) `(font-lock-face ,face ,@props) str)
str)
(defun cvs-fileinfo-pp (fileinfo)
@@ -337,15 +337,15 @@ For use by the cookie package."
(let ((type (cvs-fileinfo->type fileinfo))
(subtype (cvs-fileinfo->subtype fileinfo)))
(insert
- (case type
- (DIRCHANGE (concat "In directory "
- (cvs-add-face (cvs-fileinfo->full-name fileinfo)
- 'cvs-header t 'cvs-goal-column t)
- ":"))
- (MESSAGE
+ (pcase type
+ (`DIRCHANGE (concat "In directory "
+ (cvs-add-face (cvs-fileinfo->full-name fileinfo)
+ 'cvs-header t 'cvs-goal-column t)
+ ":"))
+ (`MESSAGE
(cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo))
'cvs-msg))
- (t
+ (_
(let* ((status (if (cvs-fileinfo->marked fileinfo)
(cvs-add-face "*" 'cvs-marked)
" "))
@@ -354,11 +354,11 @@ For use by the cookie package."
(base (or (cvs-fileinfo->base-rev fileinfo) ""))
(head (cvs-fileinfo->head-rev fileinfo))
(type
- (let ((str (case type
+ (let ((str (pcase type
;;(MOD-CONFLICT "Not Removed")
- (DEAD "")
- (t (capitalize (symbol-name type)))))
- (face (let ((sym (intern
+ (`DEAD "")
+ (_ (capitalize (symbol-name type)))))
+ (face (let ((sym (intern-soft
(concat "cvs-fi-"
(downcase (symbol-name type))
"-face"))))
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index 43292ed14e4..dd448b9d480 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -1,6 +1,6 @@
;;; pcvs-parse.el --- the CVS output parser
-;; Copyright (C) 1991-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs
@@ -32,8 +32,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(require 'pcvs-util)
(require 'pcvs-info)
@@ -117,7 +115,7 @@ If RE matches, advance the point until the line after the match and
then assign the variables as specified in MATCHES (via `setq')."
(cons 'cvs-do-match
(cons re (mapcar (lambda (match)
- `(cons ',(first match) ,(second match)))
+ `(cons ',(car match) ,(cadr match)))
matches))))
(defun cvs-do-match (re &rest matches)
@@ -150,8 +148,8 @@ Match RE and if successful, execute MATCHES."
(cvs-or
(funcall parse-spec)
- (dolist (re cvs-parse-ignored-messages)
- (when (cvs-match re) (return t)))
+ (cl-dolist (re cvs-parse-ignored-messages)
+ (when (cvs-match re) (cl-return t)))
;; This is a parse error. Create a message-type fileinfo.
(and
@@ -221,7 +219,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
;; ?: Unknown file.
(let ((code (aref c 0)))
(cvs-parsed-fileinfo
- (case code
+ (pcase code
(?M 'MODIFIED)
(?A 'ADDED)
(?R 'REMOVED)
@@ -238,7 +236,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
(if (re-search-forward "^<<<<<<< " nil t)
'CONFLICT 'NEED-MERGE))))
(?J 'NEED-MERGE) ;not supported by standard CVS
- ((?U ?P)
+ ((or ?U ?P)
(if dont-change-disc 'NEED-UPDATE
(cons 'UP-TO-DATE (if (eq code ?U) 'UPDATED 'PATCHED)))))
path 'trust)))
@@ -423,7 +421,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
(cvs-match "restoring \\(.*\\) from backup file .*$" (path 1))))
t)
- ;; Is it a succesful merge?
+ ;; Is it a successful merge?
;; Figure out result of merging (ie, was there a conflict?)
(let ((qfile (regexp-quote path)))
(cvs-or
diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el
index ea739ea726a..fdef490d4a2 100644
--- a/lisp/vc/pcvs-util.el
+++ b/lisp/vc/pcvs-util.el
@@ -1,6 +1,6 @@
;;; pcvs-util.el --- utility functions for PCL-CVS -*- byte-compile-dynamic: t -*-
-;; Copyright (C) 1991-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs
@@ -26,7 +26,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;;;
;;;; list processing
@@ -63,7 +63,7 @@
(while (and l (> n 1))
(setcdr nl (list (pop l)))
(setq nl (cdr nl))
- (decf n))
+ (cl-decf n))
ret))))
(defun cvs-partition (p l)
@@ -130,10 +130,10 @@ If NOREUSE is non-nil, always return a new buffer."
(if noreuse (generate-new-buffer name)
(get-buffer-create name)))
(unless noreuse
- (dolist (buf (buffer-list))
+ (cl-dolist (buf (buffer-list))
(with-current-buffer buf
(when (equal name list-buffers-directory)
- (return buf)))))
+ (cl-return buf)))))
(with-current-buffer (create-file-buffer name)
(setq list-buffers-directory name)
(current-buffer))))
@@ -182,9 +182,7 @@ arguments. If ARGS is not a list, no argument will be passed."
(if oneline (line-end-position) (point-max))))
(file-error nil)))
-(defun cvs-string-prefix-p (str1 str2)
- "Tell whether STR1 is a prefix of STR2."
- (eq t (compare-strings str2 nil (length str1) str1 nil nil)))
+(define-obsolete-function-alias 'cvs-string-prefix-p 'string-prefix-p "24.3")
;;;;
;;;; file names
@@ -197,10 +195,10 @@ arguments. If ARGS is not a list, no argument will be passed."
;;;; (interactive <foo>) support function
;;;;
-(defstruct (cvs-qtypedesc
- (:constructor nil) (:copier nil)
- (:constructor cvs-qtypedesc-create
- (str2obj obj2str &optional complete hist-sym require)))
+(cl-defstruct (cvs-qtypedesc
+ (:constructor nil) (:copier nil)
+ (:constructor cvs-qtypedesc-create
+ (str2obj obj2str &optional complete hist-sym require)))
str2obj
obj2str
hist-sym
@@ -233,10 +231,10 @@ arguments. If ARGS is not a list, no argument will be passed."
;;;; Flags handling
;;;;
-(defstruct (cvs-flags
- (:constructor nil)
- (:constructor -cvs-flags-make
- (desc defaults &optional qtypedesc hist-sym)))
+(cl-defstruct (cvs-flags
+ (:constructor nil)
+ (:constructor -cvs-flags-make
+ (desc defaults &optional qtypedesc hist-sym)))
defaults persist desc qtypedesc hist-sym)
(defmacro cvs-flags-define (sym defaults
diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el
index 9a8be04fc38..4bc3eaf8c2c 100644
--- a/lisp/vc/pcvs.el
+++ b/lisp/vc/pcvs.el
@@ -1,6 +1,6 @@
;;; pcvs.el --- a front-end to CVS
-;; Copyright (C) 1991-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2012 Free Software Foundation, Inc.
;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com
;; (Per Cederqvist) ceder@lysator.liu.se
@@ -31,19 +31,19 @@
;;; Commentary:
-;; PCL-CVS is a front-end to the CVS version control system. For people
-;; familiar with VC, it is somewhat like VC-dired: it presents the status of
-;; all the files in your working area and allows you to commit/update several
-;; of them at a time. Compared to VC-dired, it is considerably better and
-;; faster (but only for CVS).
+;; PCL-CVS is a front-end to the CVS version control system.
+;; It presents the status of all the files in your working area and
+;; allows you to commit/update several of them at a time.
+;; Compare with the general Emacs utility vc-dir, which tries
+;; to be VCS-agnostic. You may find PCL-CVS better/faster for CVS.
;; PCL-CVS was originally written by Per Cederqvist many years ago. This
;; version derives from the XEmacs-21 version, itself based on the 2.0b2
;; version (last release from Per). It is a thorough rework.
-;; Contrary to what you'd expect, PCL-CVS is not a replacement for VC but only
-;; for VC-dired. As such, I've tried to make PCL-CVS and VC interoperate
-;; seamlessly (I also use VC).
+;; PCL-CVS is not a replacement for VC, but adds extra functionality.
+;; As such, I've tried to make PCL-CVS and VC interoperate seamlessly
+;; (I also use VC).
;; To use PCL-CVS just use `M-x cvs-examine RET <dir> RET'.
;; There is a TeXinfo manual, which can be helpful to get started.
@@ -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.
@@ -118,7 +116,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'ewoc) ;Ewoc was once cookie
(require 'pcvs-defs)
(require 'pcvs-util)
@@ -219,21 +217,21 @@
(autoload 'cvs-status-get-tags "cvs-status")
(defun cvs-tags-list ()
"Return a list of acceptable tags, ready for completions."
- (assert (cvs-buffer-p))
+ (cl-assert (cvs-buffer-p))
(let ((marked (cvs-get-marked)))
- (list* '("BASE") '("HEAD")
- (when marked
- (with-temp-buffer
- (process-file cvs-program
- nil ;no input
- t ;output to current-buffer
- nil ;don't update display while running
- "status"
- "-v"
- (cvs-fileinfo->full-name (car marked)))
- (goto-char (point-min))
- (let ((tags (cvs-status-get-tags)))
- (when (listp tags) tags)))))))
+ `(("BASE") ("HEAD")
+ ,@(when marked
+ (with-temp-buffer
+ (process-file cvs-program
+ nil ;no input
+ t ;output to current-buffer
+ nil ;don't update display while running
+ "status"
+ "-v"
+ (cvs-fileinfo->full-name (car marked)))
+ (goto-char (point-min))
+ (let ((tags (cvs-status-get-tags)))
+ (when (listp tags) tags)))))))
(defvar cvs-tag-history nil)
(defconst cvs-qtypedesc-tag
@@ -426,16 +424,16 @@ If non-nil, NEW means to create a new buffer no matter what."
;; look for another cvs buffer visiting the same directory
(save-excursion
(unless new
- (dolist (buffer (cons (current-buffer) (buffer-list)))
+ (cl-dolist (buffer (cons (current-buffer) (buffer-list)))
(set-buffer buffer)
(and (cvs-buffer-p)
- (case cvs-reuse-cvs-buffer
- (always t)
- (subdir
- (or (cvs-string-prefix-p default-directory dir)
- (cvs-string-prefix-p dir default-directory)))
- (samedir (string= default-directory dir)))
- (return buffer)))))
+ (pcase cvs-reuse-cvs-buffer
+ (`always t)
+ (`subdir
+ (or (string-prefix-p default-directory dir)
+ (string-prefix-p dir default-directory)))
+ (`samedir (string= default-directory dir)))
+ (cl-return buffer)))))
;; we really have to create a new buffer:
;; we temporarily bind cwd to "" to prevent
;; create-file-buffer from using directory info
@@ -478,7 +476,7 @@ If non-nil, NEW means to create a new buffer no matter what."
;;(set-buffer buf)
buffer))))))
-(defun* cvs-cmd-do (cmd dir flags fis new
+(cl-defun cvs-cmd-do (cmd dir flags fis new
&key cvsargs noexist dont-change-disc noshow)
(let* ((dir (file-name-as-directory
(abbreviate-file-name (expand-file-name dir))))
@@ -501,7 +499,7 @@ If non-nil, NEW means to create a new buffer no matter what."
;; cvsbuf))))
(defun cvs-run-process (args fis postprocess &optional single-dir)
- (assert (cvs-buffer-p cvs-buffer))
+ (cl-assert (cvs-buffer-p cvs-buffer))
(save-current-buffer
(let ((procbuf (current-buffer))
(cvsbuf cvs-buffer)
@@ -521,9 +519,9 @@ If non-nil, NEW means to create a new buffer no matter what."
(let ((inhibit-read-only t))
(insert "pcl-cvs: descending directory " dir "\n"))
;; loop to find the same-dir-elems
- (do* ((files () (cons (cvs-fileinfo->file fi) files))
- (fis fis (cdr fis))
- (fi (car fis) (car fis)))
+ (cl-do* ((files () (cons (cvs-fileinfo->file fi) files))
+ (fis fis (cdr fis))
+ (fi (car fis) (car fis)))
((not (and fis (string= dir (cvs-fileinfo->dir fi))))
(list dir files fis))))))
(dir (nth 0 dir+files+rest))
@@ -813,7 +811,7 @@ TIN specifies an optional starting point."
(while (and tin (cvs-fileinfo< fi (ewoc-data tin)))
(setq tin (ewoc-prev c tin)))
(if (null tin) (ewoc-enter-first c fi) ;empty collection
- (assert (not (cvs-fileinfo< fi (ewoc-data tin))))
+ (cl-assert (not (cvs-fileinfo< fi (ewoc-data tin))))
(let ((next-tin (ewoc-next c tin)))
(while (not (or (null next-tin)
(cvs-fileinfo< fi (ewoc-data next-tin))))
@@ -871,15 +869,18 @@ RM-MSGS if non-nil means remove messages."
(let* ((type (cvs-fileinfo->type fi))
(subtype (cvs-fileinfo->subtype fi))
(keep
- (case type
+ (pcase type
;; remove temp messages and keep the others
- (MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
+ (`MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
;; remove entries
- (DEAD nil)
+ (`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
- (t (not (run-hook-with-args-until-success
+ (_ (not (run-hook-with-args-until-success
'cvs-cleanup-functions fi))))))
;; mark dirs for removal
@@ -887,7 +888,7 @@ RM-MSGS if non-nil means remove messages."
(eq (cvs-fileinfo->type last-fi) 'DIRCHANGE)
(not (when first-dir (setq first-dir nil) t))
(or (eq rm-dirs 'all)
- (not (cvs-string-prefix-p
+ (not (string-prefix-p
(cvs-fileinfo->dir last-fi)
(cvs-fileinfo->dir fi)))
(and (eq type 'DIRCHANGE) (eq rm-dirs 'empty))
@@ -1389,7 +1390,7 @@ an empty list if it doesn't point to a file at all."
fis))))
(nreverse fis)))
-(defun* cvs-mode-marked (filter &optional cmd
+(cl-defun cvs-mode-marked (filter &optional cmd
&key read-only one file noquery)
"Get the list of marked FIS.
CMD is used to determine whether to use the marks or not.
@@ -1474,7 +1475,7 @@ The POSTPROC specified there (typically `log-edit') is then called,
(let ((msg (buffer-substring-no-properties (point-min) (point-max))))
(cvs-mode!)
;;(pop-to-buffer cvs-buffer)
- (cvs-mode-do "commit" (list* "-m" msg flags) 'commit)))
+ (cvs-mode-do "commit" `("-m" ,msg ,@flags) 'commit)))
;;;; Editing existing commit log messages.
@@ -1604,7 +1605,7 @@ With prefix argument, prompt for cvs flags."
(or current-prefix-arg (not cvs-add-default-message)))
(read-from-minibuffer "Enter description: ")
(or cvs-add-default-message "")))
- (flags (list* "-m" msg flags))
+ (flags `("-m" ,msg ,@flags))
(postproc
;; setup postprocessing for the directory entries
(when dirs
@@ -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
@@ -1758,7 +1760,7 @@ Signal an error if there is no backup file."
(set-buffer-modified-p nil)
(let ((buffer-file-name (expand-file-name file)))
(after-find-file))
- (toggle-read-only 1)
+ (setq buffer-read-only t)
(message "Retrieving revision %s... Done" rev)
(current-buffer))))))
@@ -1839,13 +1841,13 @@ Signal an error if there is no backup file."
(setq buffer-file-name (expand-file-name buffer-file-name))
(let (ret)
(dolist (fi (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))
- (when (cvs-string-prefix-p
+ (when (string-prefix-p
(expand-file-name (cvs-fileinfo->full-name fi) dir)
buffer-file-name)
(setq ret t)))
ret)))
-(defun* cvs-mode-run (cmd flags fis
+(cl-defun cvs-mode-run (cmd flags fis
&key (buf (cvs-temp-buffer))
dont-change-disc cvsargs postproc)
"Generic cvs-mode-<foo> function.
@@ -1887,7 +1889,7 @@ POSTPROC is a list of expressions to be evaluated at the very end (after
(cvs-run-process args fis postproc single-dir))))
-(defun* cvs-mode-do (cmd flags filter
+(cl-defun cvs-mode-do (cmd flags filter
&key show dont-change-disc cvsargs postproc)
"Generic cvs-mode-<foo> function.
Executes `cvs CVSARGS CMD FLAGS' on the selected files.
@@ -2261,7 +2263,7 @@ With prefix argument, prompt for cvs flags."
(defun cvs-dir-member-p (fileinfo dir)
"Return true if FILEINFO represents a file in directory DIR."
(and (not (eq (cvs-fileinfo->type fileinfo) 'DIRCHANGE))
- (cvs-string-prefix-p dir (cvs-fileinfo->dir fileinfo))))
+ (string-prefix-p dir (cvs-fileinfo->dir fileinfo))))
(defun cvs-execute-single-file (fi extractor program constant-args)
"Internal function for `cvs-execute-single-file-list'."
@@ -2392,7 +2394,7 @@ The exact behavior is determined also by `cvs-dired-use-hook'."
(set-buffer cvs-buf)
;; look for a corresponding pcl-cvs buffer
(when (and (eq major-mode 'cvs-mode)
- (cvs-string-prefix-p default-directory dir))
+ (string-prefix-p default-directory dir))
(let ((subdir (substring dir (length default-directory))))
(set-buffer buffer)
(set (make-local-variable 'cvs-buffer) cvs-buf)
@@ -2423,7 +2425,7 @@ The exact behavior is determined also by `cvs-dired-use-hook'."
(set-buffer cvs-buf)
;; look for a corresponding pcl-cvs buffer
(when (and (eq major-mode 'cvs-mode)
- (cvs-string-prefix-p default-directory file))
+ (string-prefix-p default-directory file))
(let* ((file (substring file (length default-directory)))
(fi (cvs-create-fileinfo
(if (string= "0" version)
@@ -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 64c4b04fb65..7037b606fe7 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1,6 +1,6 @@
;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: vc, tools, revision control, merge, diff3, cvs, conflict
@@ -43,7 +43,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'diff-mode) ;For diff-auto-refine-mode.
(require 'newcomment)
@@ -78,36 +78,36 @@ Used in `smerge-diff-base-mine' and related functions."
:type 'boolean)
(defface smerge-mine
- '((((min-colors 88) (background light))
- (:foreground "blue1"))
- (((background light))
- (:foreground "blue"))
- (((min-colors 88) (background dark))
- (:foreground "cyan1"))
- (((background dark))
- (:foreground "cyan")))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffdddd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#553333")
+ (((class color))
+ :foreground "red"))
"Face for your code."
:group 'smerge)
(define-obsolete-face-alias 'smerge-mine-face 'smerge-mine "22.1")
(defvar smerge-mine-face 'smerge-mine)
(defface smerge-other
- '((((background light))
- (:foreground "darkgreen"))
- (((background dark))
- (:foreground "lightgreen")))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ddffdd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#335533")
+ (((class color))
+ :foreground "green"))
"Face for the other code."
:group 'smerge)
(define-obsolete-face-alias 'smerge-other-face 'smerge-other "22.1")
(defvar smerge-other-face 'smerge-other)
(defface smerge-base
- '((((min-colors 88) (background light))
- (:foreground "red1"))
- (((background light))
- (:foreground "red"))
- (((background dark))
- (:foreground "orange")))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffffaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#888833")
+ (((class color))
+ :foreground "yellow"))
"Face for the base code."
:group 'smerge)
(define-obsolete-face-alias 'smerge-base-face 'smerge-base "22.1")
@@ -124,10 +124,34 @@ Used in `smerge-diff-base-mine' and related functions."
(defvar smerge-markers-face 'smerge-markers)
(defface smerge-refined-change
- '((t :background "yellow"))
+ '((t nil))
"Face used for char-based changes shown by `smerge-refine'."
:group 'smerge)
+(defface smerge-refined-removed
+ '((default
+ :inherit smerge-refined-change)
+ (((class color) (min-colors 88) (background light))
+ :background "#ffbbbb")
+ (((class color) (min-colors 88) (background dark))
+ :background "#aa2222")
+ (t :inverse-video t))
+ "Face used for removed characters shown by `smerge-refine'."
+ :group 'smerge
+ :version "24.3")
+
+(defface smerge-refined-added
+ '((default
+ :inherit smerge-refined-change)
+ (((class color) (min-colors 88) (background light))
+ :background "#aaffaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#22aa22")
+ (t :inverse-video t))
+ "Face used for added characters shown by `smerge-refine'."
+ :group 'smerge
+ :version "24.3")
+
(easy-mmode-defmap smerge-basic-map
`(("n" . smerge-next)
("p" . smerge-prev)
@@ -342,12 +366,11 @@ Can be nil if the style is undecided, or else:
))))
(defvar smerge-resolve-function
- (lambda () (error "Don't know how to resolve"))
+ (lambda () (user-error "Don't know how to resolve"))
"Mode-specific merge function.
The function is called with zero or one argument (non-nil if the resolution
function should only apply safe heuristics) and with the match data set
according to `smerge-match-conflict'.")
-(add-to-list 'debug-ignored-errors "Don't know how to resolve")
(defvar smerge-text-properties
`(help-echo "merge conflict: mouse-3 shows a menu"
@@ -626,7 +649,7 @@ major modes. Uses `smerge-resolve-function' to do the actual work."
(set-match-data md)
(smerge-keep-n choice))
(t
- (error "Don't know how to resolve"))))
+ (user-error "Don't know how to resolve"))))
(if (buffer-name buf) (kill-buffer buf))
(if m (delete-file m))
(if b (delete-file b))
@@ -693,7 +716,7 @@ major modes. Uses `smerge-resolve-function' to do the actual work."
(while (or (not (match-end i))
(< (point) (match-beginning i))
(>= (point) (match-end i)))
- (decf i))
+ (cl-decf i))
i))
(defun smerge-keep-current ()
@@ -756,7 +779,7 @@ An error is raised if not inside a conflict."
(filename (or (match-string 1) ""))
(_ (re-search-forward smerge-end-re))
- (_ (assert (< orig-point (match-end 0))))
+ (_ (cl-assert (< orig-point (match-end 0))))
(other-end (match-beginning 0))
(end (match-end 0))
@@ -810,9 +833,7 @@ An error is raised if not inside a conflict."
(when base-start (1- base-start)) base-start
(1- other-start) other-start))
t)
- (search-failed (error "Point not in conflict region")))))
-
-(add-to-list 'debug-ignored-errors "Point not in conflict region")
+ (search-failed (user-error "Point not in conflict region")))))
(defun smerge-conflict-overlay (pos)
"Return the conflict overlay at POS if any."
@@ -983,9 +1004,17 @@ chars to try and eliminate some spurious differences."
(dolist (x props) (overlay-put ol (car x) (cdr x)))
ol)))))
-(defun smerge-refine-subst (beg1 end1 beg2 end2 props &optional preproc)
+(defun smerge-refine-subst (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a)
"Show fine differences in the two regions BEG1..END1 and BEG2..END2.
-PROPS is an alist of properties to put (via overlays) on the changes.
+PROPS-C is an alist of properties to put (via overlays) on the changes.
+PROPS-R is an alist of properties to put on removed characters.
+PROPS-A is an alist of properties to put on added characters.
+If PROPS-R and PROPS-A are nil, put PROPS-C on all changes.
+If PROPS-C is nil, but PROPS-R and PROPS-A are non-nil,
+put PROPS-A on added characters, PROPS-R on removed characters.
+If PROPS-C, PROPS-R and PROPS-A are non-nil, put PROPS-C on changed characters,
+PROPS-A on added characters, and PROPS-R on removed characters.
+
If non-nil, PREPROC is called with no argument in a buffer that contains
a copy of a region, just before preparing it to for `diff'. It can be
used to replace chars to try and eliminate some spurious differences."
@@ -1029,19 +1058,27 @@ used to replace chars to try and eliminate some spurious differences."
(m5 (match-string 5)))
(when (memq op '(?d ?c))
(setq last1
- (smerge-refine-highlight-change buf beg1 m1 m2 props)))
+ (smerge-refine-highlight-change
+ buf beg1 m1 m2
+ ;; Try to use props-c only for changed chars,
+ ;; fallback to props-r for changed/removed chars,
+ ;; but if props-r is nil then fallback to props-c.
+ (or (and (eq op '?c) props-c) props-r props-c))))
(when (memq op '(?a ?c))
(setq last2
- (smerge-refine-highlight-change buf beg2 m4 m5 props))))
+ (smerge-refine-highlight-change
+ buf beg2 m4 m5
+ ;; Same logic as for removed chars above.
+ (or (and (eq op '?c) props-c) props-a props-c)))))
(forward-line 1) ;Skip hunk header.
(and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
(goto-char (match-beginning 0))))
- ;; (assert (or (null last1) (< (overlay-start last1) end1)))
- ;; (assert (or (null last2) (< (overlay-start last2) end2)))
+ ;; (cl-assert (or (null last1) (< (overlay-start last1) end1)))
+ ;; (cl-assert (or (null last2) (< (overlay-start last2) end2)))
(if smerge-refine-weight-hack
(progn
- ;; (assert (or (null last1) (<= (overlay-end last1) end1)))
- ;; (assert (or (null last2) (<= (overlay-end last2) end2)))
+ ;; (cl-assert (or (null last1) (<= (overlay-end last1) end1)))
+ ;; (cl-assert (or (null last2) (<= (overlay-end last2) end2)))
)
;; smerge-refine-forward-function when calling in chopup may
;; have stopped because it bumped into EOB whereas in
@@ -1084,7 +1121,11 @@ repeating the command will highlight other two parts."
((eq (match-end 3) (match-beginning 3)) 3)
(t 2)))
(let ((n1 (if (eq part 1) 2 1))
- (n2 (if (eq part 3) 2 3)))
+ (n2 (if (eq part 3) 2 3))
+ (smerge-use-changed-face
+ (and (face-differs-from-default-p 'smerge-refined-change)
+ (not (face-equal 'smerge-refined-change 'smerge-refined-added))
+ (not (face-equal 'smerge-refined-change 'smerge-refined-removed)))))
(smerge-ensure-match n1)
(smerge-ensure-match n2)
(with-silent-modifications
@@ -1093,8 +1134,13 @@ repeating the command will highlight other two parts."
(cons (buffer-chars-modified-tick) part)))
(smerge-refine-subst (match-beginning n1) (match-end n1)
(match-beginning n2) (match-end n2)
- '((smerge . refine)
- (face . smerge-refined-change)))))
+ (if smerge-use-changed-face
+ '((smerge . refine) (face . smerge-refined-change)))
+ nil
+ (unless smerge-use-changed-face
+ '((smerge . refine) (face . smerge-refined-removed)))
+ (unless smerge-use-changed-face
+ '((smerge . refine) (face . smerge-refined-added))))))
(defun smerge-diff (n1 n2)
(smerge-match-conflict)
@@ -1244,8 +1290,8 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
(progn (pop-mark) (mark))
(when current-prefix-arg (pop-mark) (mark))))
;; Start from the end so as to avoid problems with pos-changes.
- (destructuring-bind (pt1 pt2 pt3 &optional pt4)
- (sort (list* pt1 pt2 pt3 (if pt4 (list pt4))) '>=)
+ (pcase-let ((`(,pt1 ,pt2 ,pt3 ,pt4)
+ (sort `(,pt1 ,pt2 ,pt3 ,@(if pt4 (list pt4))) '>=)))
(goto-char pt1) (beginning-of-line)
(insert ">>>>>>> OTHER\n")
(goto-char pt2) (beginning-of-line)
@@ -1266,6 +1312,9 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
;;;###autoload
(define-minor-mode smerge-mode
"Minor mode to simplify editing output from the diff3 program.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
\\{smerge-mode-map}"
:group 'smerge :lighter " SMerge"
(when (and (boundp 'font-lock-mode) font-lock-mode)
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index b6ecc4c1d75..1b98194e74a 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -1,6 +1,6 @@
;;; vc-annotate.el --- VC Annotate Support
-;; Copyright (C) 1997-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Martin Lorentzson <emwson@emw.ericsson.se>
;; Maintainer: FSF
@@ -29,8 +29,7 @@
(require 'vc)
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defcustom vc-annotate-display-mode 'fullscale
"Which mode to color the output of \\[vc-annotate] with by default."
@@ -195,7 +194,7 @@ The current time is used as the offset."
(let ((bol (point))
(date (vc-call-backend vc-annotate-backend 'annotate-time))
(inhibit-read-only t))
- (assert (>= (point) bol))
+ (cl-assert (>= (point) bol))
(put-text-property bol (point) 'invisible 'vc-annotate-annotation)
date))
@@ -522,12 +521,12 @@ the file in question, search for the log entry required and move point."
(car rev-at-line) t 1)))))))
(defun vc-annotate-show-diff-revision-at-line-internal (filediff)
- (if (not (equal major-mode 'vc-annotate-mode))
+ (if (not (derived-mode-p 'vc-annotate-mode))
(message "Cannot be invoked outside of a vc annotate buffer")
(let* ((rev-at-line (vc-annotate-extract-revision-at-line))
- (prev-rev nil)
- (rev (car rev-at-line))
- (fname (cdr rev-at-line)))
+ (prev-rev nil)
+ (rev (car rev-at-line))
+ (fname (cdr rev-at-line)))
(if (not rev-at-line)
(message "Cannot extract revision number from the current line")
(setq prev-rev
@@ -535,17 +534,15 @@ the file in question, search for the log entry required and move point."
(if filediff fname nil) rev))
(if (not prev-rev)
(message "Cannot diff from any revision prior to %s" rev)
- (save-window-excursion
- (vc-diff-internal
- nil
- ;; The value passed here should follow what
- ;; `vc-deduce-fileset' returns.
- (list vc-annotate-backend
- (if filediff
- (list fname)
- nil))
- prev-rev rev))
- (switch-to-buffer "*vc-diff*"))))))
+ (vc-diff-internal
+ t
+ ;; The value passed here should follow what
+ ;; `vc-deduce-fileset' returns.
+ (list vc-annotate-backend
+ (if filediff
+ (list fname)
+ nil))
+ prev-rev rev))))))
(defun vc-annotate-show-diff-revision-at-line ()
"Visit the diff of the revision at line from its previous revision."
diff --git a/lisp/vc/vc-arch.el b/lisp/vc/vc-arch.el
index a20a49a4c39..2e20d97e21d 100644
--- a/lisp/vc/vc-arch.el
+++ b/lisp/vc/vc-arch.el
@@ -1,6 +1,6 @@
-;;; vc-arch.el --- VC backend for the Arch version-control system
+;;; vc-arch.el --- VC backend for the Arch version-control system -*- lexical-binding: t -*-
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -54,17 +54,22 @@
;;; Code:
-(eval-when-compile (require 'vc) (require 'cl))
+(eval-when-compile (require 'vc))
;;; Properties of the backend
(defun vc-arch-revision-granularity () 'repository)
-(defun vc-arch-checkout-model (files) 'implicit)
+(defun vc-arch-checkout-model (_files) 'implicit)
;;;
;;; Customization options
;;;
+(defgroup vc-arch nil
+ "VC Arch backend."
+ :version "24.1"
+ :group 'vc)
+
;; It seems Arch diff does not accept many options, so this is not
;; very useful. It exists mainly so that the VC backends are all
;; consistent with regards to their treatment of diff switches.
@@ -76,7 +81,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "23.1"
- :group 'vc)
+ :group 'vc-arch)
(define-obsolete-variable-alias 'vc-arch-command 'vc-arch-program "23.1")
@@ -87,7 +92,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(or (car candidates) "tla"))
"Name of the Arch executable."
:type 'string
- :group 'vc)
+ :group 'vc-arch)
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
@@ -222,7 +227,7 @@ Only the value `maybe' can be trusted :-(."
(vc-file-setprop
file 'arch-root root)))))
-(defun vc-arch-register (files &optional rev comment)
+(defun vc-arch-register (files &optional rev _comment)
(if rev (error "Explicit initial revision not supported for Arch"))
(dolist (file files)
(let ((tagmet (vc-arch-tagging-method file)))
@@ -253,7 +258,7 @@ Only the value `maybe' can be trusted :-(."
;; Strip the terminating newline.
(buffer-substring (point-min) (1- (point-max)))))))))
-(defun vc-arch-workfile-unchanged-p (file)
+(defun vc-arch-workfile-unchanged-p (_file)
"Stub: arch workfiles are always considered to be in a changed state,"
nil)
@@ -377,18 +382,18 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
'(("\\`.*--\\(.*--.*\\)--\\(v?\\).*-\\([0-9]+\\)\\'" . "\\2\\3[\\1]"))
"Rewrite rules to shorten Arch's revision names on the mode-line."
:type '(repeat (cons regexp string))
- :group 'vc)
+ :group 'vc-arch)
(defun vc-arch-mode-line-string (file)
- "Return string for placement in modeline by `vc-mode-line' for FILE."
+ "Return a string for `vc-mode-line' to put in the mode line for FILE."
(let ((rev (vc-working-revision file)))
(dolist (rule vc-arch-mode-line-rewrite)
(if (string-match (car rule) rev)
(setq rev (replace-match (cdr rule) t nil rev))))
(format "Arch%c%s"
- (case (vc-state file)
- ((up-to-date needs-update) ?-)
- (added ?@)
+ (pcase (vc-state file)
+ ((or `up-to-date `needs-update) ?-)
+ (`added ?@)
(t ?:))
rev)))
@@ -503,12 +508,11 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
"*"))))))
(defun vc-arch-revision-completion-table (files)
- (lexical-let ((files files))
- (lambda (string pred action)
- ;; FIXME: complete revision patches as well.
- (let* ((root (expand-file-name "{arch}" (vc-arch-root (car files))))
- (table (vc-arch--version-completion-table root string)))
- (complete-with-action action table string pred)))))
+ (lambda (string pred action)
+ ;; FIXME: complete revision patches as well.
+ (let* ((root (expand-file-name "{arch}" (vc-arch-root (car files))))
+ (table (vc-arch--version-completion-table root string)))
+ (complete-with-action action table string pred))))
;;; Trimming revision libraries.
@@ -542,13 +546,12 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
minrev))
(defun vc-arch-trim-make-sentinel (revs)
- (if (null revs) (lambda (proc msg) (message "VC-Arch trimming ... done"))
- (lexical-let ((revs revs))
- (lambda (proc msg)
- (message "VC-Arch trimming %s..." (file-name-nondirectory (car revs)))
- (rename-file (car revs) (concat (car revs) "*rm*"))
- (setq proc (start-process "vc-arch-trim" nil
- "rm" "-rf" (concat (car revs) "*rm*")))
+ (if (null revs) (lambda (_proc _msg) (message "VC-Arch trimming ... done"))
+ (lambda (_proc _msg)
+ (message "VC-Arch trimming %s..." (file-name-nondirectory (car revs)))
+ (rename-file (car revs) (concat (car revs) "*rm*"))
+ (let ((proc (start-process "vc-arch-trim" nil
+ "rm" "-rf" (concat (car revs) "*rm*"))))
(set-process-sentinel proc (vc-arch-trim-make-sentinel (cdr revs)))))))
(defun vc-arch-trim-one-revlib (dir)
@@ -567,7 +570,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
'car-less-than-car))
(subdirs nil))
(when (cddr revs)
- (dotimes (i (/ (length revs) 2))
+ (dotimes (_i (/ (length revs) 2))
(let ((minrev (vc-arch-trim-find-least-useful-rev revs)))
(setq revs (delq minrev revs))
(push minrev subdirs)))
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 508420f026a..74a61548d8b 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1,6 +1,6 @@
-;;; vc-bzr.el --- VC backend for the bzr revision control system
+;;; vc-bzr.el --- VC backend for the bzr revision control system -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Riccardo Murri <riccardo.murri@gmail.com>
@@ -37,17 +37,16 @@
;; are bzr-versioned, `vc-bzr` presently runs `bzr status` on the
;; symlink, thereby not detecting whether the actual contents
;; (that is, the target contents) are changed.
-;; See https://bugs.launchpad.net/vc-bzr/+bug/116607
;;; Properties of the backend
(defun vc-bzr-revision-granularity () 'repository)
-(defun vc-bzr-checkout-model (files) 'implicit)
+(defun vc-bzr-checkout-model (_files) 'implicit)
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'vc) ;; for vc-exec-after
(require 'vc-dir))
@@ -56,7 +55,7 @@
(put 'Bzr 'vc-functions nil)
(defgroup vc-bzr nil
- "VC bzr backend."
+ "VC Bazaar (bzr) backend."
:version "22.2"
:group 'vc)
@@ -65,14 +64,6 @@
:group 'vc-bzr
:type 'string)
-(defcustom vc-bzr-sha1-program '("sha1sum")
- "Name of program to compute SHA1.
-It must be a string \(program name\) or list of strings \(name and its args\)."
- :type '(repeat string)
- :group 'vc-bzr)
-
-(define-obsolete-variable-alias 'sha1-program 'vc-bzr-sha1-program "24.1")
-
(defcustom vc-bzr-diff-switches nil
"String or list of strings specifying switches for bzr diff under VC.
If nil, use the value of `vc-diff-switches'. If t, use no switches."
@@ -89,18 +80,40 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(repeat :tag "Argument List" :value ("") string))
:group 'vc-bzr)
+(defcustom vc-bzr-status-switches
+ (ignore-errors
+ (with-temp-buffer
+ (call-process vc-bzr-program nil t nil "help" "status")
+ (if (search-backward "--no-classify" nil t)
+ "--no-classify")))
+ "String or list of strings specifying switches for bzr status under VC.
+The option \"--no-classify\" should be present if your bzr supports it."
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :group 'vc-bzr
+ :version "24.1")
+
;; since v0.9, bzr supports removing the progress indicators
;; by setting environment variable BZR_PROGRESS_BAR to "none".
(defun vc-bzr-command (bzr-command buffer okstatus file-or-list &rest args)
"Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND.
Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
-`LC_MESSAGES=C' to the environment."
+`LC_MESSAGES=C' to the environment. If BZR-COMMAND is \"status\",
+prepends `vc-bzr-status-switches' to ARGS."
(let ((process-environment
- (list* "BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9)
- "LC_MESSAGES=C" ; Force English output
- process-environment)))
+ `("BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9)
+ "LC_MESSAGES=C" ; Force English output
+ ,@process-environment)))
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program
- file-or-list bzr-command args)))
+ file-or-list bzr-command
+ (if (and (string-equal "status" bzr-command)
+ vc-bzr-status-switches)
+ (append (if (stringp vc-bzr-status-switches)
+ (list vc-bzr-status-switches)
+ vc-bzr-status-switches)
+ args)
+ args))))
(defun vc-bzr-async-command (bzr-command &rest args)
"Wrapper round `vc-do-async-command' using `vc-bzr-program' as COMMAND.
@@ -110,8 +123,8 @@ Use the current Bzr root directory as the ROOT argument to
`vc-do-async-command', and specify an output buffer named
\"*vc-bzr : ROOT*\". Return this buffer."
(let* ((process-environment
- (list* "BZR_PROGRESS_BAR=none" "LC_MESSAGES=C"
- process-environment))
+ `("BZR_PROGRESS_BAR=none" "LC_MESSAGES=C"
+ ,@process-environment))
(root (vc-bzr-root default-directory))
(buffer (format "*vc-bzr : %s*" (expand-file-name root))))
(apply 'vc-do-async-command buffer root
@@ -137,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.
@@ -168,20 +175,15 @@ in the repository root directory of FILE."
(defun vc-bzr-sha1 (file)
(with-temp-buffer
(set-buffer-multibyte nil)
- (let ((prog vc-bzr-sha1-program)
- (args nil)
- process-file-side-effects)
- (when (consp prog)
- (setq args (cdr prog))
- (setq prog (car prog)))
- (apply 'process-file prog (file-relative-name file) t nil args)
- (buffer-substring (point-min) (+ (point-min) 40)))))
+ (insert-file-contents-literally file)
+ (sha1 (current-buffer))))
(defun vc-bzr-state-heuristic (file)
"Like `vc-bzr-state' but hopefully without running Bzr."
- ;; `bzr status' was excruciatingly slow with large histories and
- ;; pending merges, so try to avoid using it until they fix their
- ;; performance problems.
+ ;; `bzr status' could be slow with large histories and pending merges,
+ ;; so this tries to avoid calling it if possible. bzr status is
+ ;; faster now, so this is not as important as it was.
+ ;;
;; This function tries first to parse Bzr internal file
;; `checkout/dirstate', but it may fail if Bzr internal file format
;; has changed. As a safeguard, the `checkout/dirstate' file is
@@ -200,89 +202,97 @@ in the repository root directory of FILE."
;; + working ( = packed_stat )
;; parent = common ( as above ) + history ( = rev_id )
;; kinds = (r)elocated, (a)bsent, (d)irectory, (f)ile, (l)ink
- (lexical-let ((root (vc-bzr-root file)))
- (when root ; Short cut.
- (lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root)))
- (condition-case nil
- (with-temp-buffer
- (insert-file-contents dirstate)
- (goto-char (point-min))
- (if (not (looking-at "#bazaar dirstate flat format 3"))
- (vc-bzr-state file) ; Some other unknown format?
- (let* ((relfile (file-relative-name file root))
- (reldir (file-name-directory relfile)))
- (if (re-search-forward
- (concat "^\0"
- (if reldir (regexp-quote
- (directory-file-name reldir)))
- "\0"
- (regexp-quote (file-name-nondirectory relfile))
- "\0"
- "[^\0]*\0" ;id?
- "\\([^\0]*\\)\0" ;"a/f/d", a=removed?
- "\\([^\0]*\\)\0" ;sha1 (empty if conflicted)?
- "\\([^\0]*\\)\0" ;size?p
- ;; y/n. Whether or not the current copy
- ;; was executable the last time bzr checked?
- "[^\0]*\0"
- "[^\0]*\0" ;?
- ;; Parent information. Absent in a new repo.
- "\\(?:\\([^\0]*\\)\0" ;"a/f/d" a=added?
- "\\([^\0]*\\)\0" ;sha1 again?
- "\\([^\0]*\\)\0" ;size again?
- ;; y/n. Whether or not the repo thinks
- ;; the file should be executable?
- "\\([^\0]*\\)\0"
- "[^\0]*\0\\)?" ;last revid?
- ;; There are more fields when merges are pending.
- )
- nil t)
- ;; Apparently the second sha1 is the one we want: when
- ;; there's a conflict, the first sha1 is absent (and the
- ;; first size seems to correspond to the file with
- ;; conflict markers).
- (cond
- ((eq (char-after (match-beginning 1)) ?a) 'removed)
- ;; If there is no parent, this must be a new repo.
- ;; If file is in dirstate, can only be added (b#8025).
- ((or (not (match-beginning 4))
- (eq (char-after (match-beginning 4)) ?a)) 'added)
- ((or (and (eq (string-to-number (match-string 3))
- (nth 7 (file-attributes file)))
- (equal (match-string 5)
- (vc-bzr-sha1 file))
- ;; For a file, does the executable state match?
- ;; (Bug#7544)
- (or (not
- (eq (char-after (match-beginning 1)) ?f))
- (let ((exe
- (memq
- ?x
- (mapcar
- 'identity
- (nth 8 (file-attributes file))))))
- (if (eq (char-after (match-beginning 7))
- ?y)
- exe
- (not exe)))))
- (and
- ;; It looks like for lightweight
- ;; checkouts \2 is empty and we need to
- ;; look for size in \6.
- (eq (match-beginning 2) (match-end 2))
- (eq (string-to-number (match-string 6))
- (nth 7 (file-attributes file)))
- (equal (match-string 5)
- (vc-bzr-sha1 file))))
- 'up-to-date)
- (t 'edited))
- 'unregistered))))
- ;; Either the dirstate file can't be read, or the sha1
- ;; executable is missing, or ...
- ;; In either case, recent versions of Bzr aren't that slow
- ;; any more.
- (error (vc-bzr-state file)))))))
-
+ (let* ((root (vc-bzr-root file))
+ (dirstate (expand-file-name vc-bzr-admin-dirstate root)))
+ (when root ; Short cut.
+ (condition-case err
+ (with-temp-buffer
+ (insert-file-contents dirstate)
+ (goto-char (point-min))
+ (if (not (looking-at "#bazaar dirstate flat format 3"))
+ (vc-bzr-state file) ; Some other unknown format?
+ (let* ((relfile (file-relative-name file root))
+ (reldir (file-name-directory relfile)))
+ (cond
+ ((not
+ (re-search-forward
+ (concat "^\0"
+ (if reldir (regexp-quote
+ (directory-file-name reldir)))
+ "\0"
+ (regexp-quote (file-name-nondirectory relfile))
+ "\0"
+ "[^\0]*\0" ;id?
+ "\\([^\0]*\\)\0" ;"a/f/d", a=removed?
+ "\\([^\0]*\\)\0" ;sha1 (empty if conflicted)?
+ "\\([^\0]*\\)\0" ;size?p
+ ;; y/n. Whether or not the current copy
+ ;; was executable the last time bzr checked?
+ "[^\0]*\0"
+ "[^\0]*\0" ;?
+ ;; Parent information. Absent in a new repo.
+ "\\(?:\\([^\0]*\\)\0" ;"a/f/d" a=added?
+ "\\([^\0]*\\)\0" ;sha1 again?
+ "\\([^\0]*\\)\0" ;size again?
+ ;; y/n. Whether or not the repo thinks
+ ;; the file should be executable?
+ "\\([^\0]*\\)\0"
+ "[^\0]*\0\\)?" ;last revid?
+ ;; There are more fields when merges are pending.
+ )
+ nil t))
+ 'unregistered)
+ ;; Apparently the second sha1 is the one we want: when
+ ;; there's a conflict, the first sha1 is absent (and the
+ ;; first size seems to correspond to the file with
+ ;; conflict markers).
+ ((eq (char-after (match-beginning 1)) ?a) 'removed)
+ ;; If there is no parent, this must be a new repo.
+ ;; If file is in dirstate, can only be added (b#8025).
+ ((or (not (match-beginning 4))
+ (eq (char-after (match-beginning 4)) ?a)) 'added)
+ ((or (and (eq (string-to-number (match-string 3))
+ (nth 7 (file-attributes file)))
+ (equal (match-string 5)
+ (save-match-data (vc-bzr-sha1 file)))
+ ;; For a file, does the executable state match?
+ ;; (Bug#7544)
+ (or (not
+ (eq (char-after (match-beginning 1)) ?f))
+ (let ((exe
+ (memq
+ ?x
+ (mapcar
+ 'identity
+ (nth 8 (file-attributes file))))))
+ (if (eq (char-after (match-beginning 7))
+ ?y)
+ exe
+ (not exe)))))
+ (and
+ ;; It looks like for lightweight
+ ;; checkouts \2 is empty and we need to
+ ;; look for size in \6.
+ (eq (match-beginning 2) (match-end 2))
+ (eq (string-to-number (match-string 6))
+ (nth 7 (file-attributes file)))
+ (equal (match-string 5)
+ (vc-bzr-sha1 file))))
+ 'up-to-date)
+ (t 'edited)))))
+ ;; The dirstate file can't be read, or some other problem.
+ (error
+ (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."
@@ -298,13 +308,12 @@ in the repository root directory of FILE."
(defun vc-bzr-file-name-relative (filename)
"Return file name FILENAME stripped of the initial Bzr repository path."
- (lexical-let*
- ((filename* (expand-file-name filename))
- (rootdir (vc-bzr-root filename*)))
+ (let* ((filename* (expand-file-name filename))
+ (rootdir (vc-bzr-root filename*)))
(when rootdir
(file-relative-name filename* rootdir))))
-(defvar vc-bzr-error-regex-alist
+(defvar vc-bzr-error-regexp-alist
'(("^\\( M[* ]\\|+N \\|-D \\|\\| \\*\\|R[M ] \\) \\(.+\\)" 2 nil nil 1)
("^C \\(.+\\)" 2)
("^Text conflict in \\(.+\\)" 1 nil nil 2)
@@ -340,14 +349,7 @@ prompt for the Bzr command to run."
command (cadr args)
args (cddr args)))
(let ((buf (apply 'vc-bzr-async-command command args)))
- (with-current-buffer buf
- (vc-exec-after
- `(progn
- (let ((compilation-error-regexp-alist
- vc-bzr-error-regex-alist))
- (compilation-mode))
- (set (make-local-variable 'compilation-error-regexp-alist)
- vc-bzr-error-regex-alist))))
+ (with-current-buffer buf (vc-exec-after '(vc-compilation-mode 'bzr)))
(vc-set-async-update buf))))
(defun vc-bzr-merge-branch ()
@@ -378,14 +380,7 @@ default if it is available."
(command (cadr cmd))
(args (cddr cmd)))
(let ((buf (apply 'vc-bzr-async-command command args)))
- (with-current-buffer buf
- (vc-exec-after
- `(progn
- (let ((compilation-error-regexp-alist
- vc-bzr-error-regex-alist))
- (compilation-mode))
- (set (make-local-variable 'compilation-error-regexp-alist)
- vc-bzr-error-regex-alist))))
+ (with-current-buffer buf (vc-exec-after '(vc-compilation-mode 'bzr)))
(vc-set-async-update buf))))
(defun vc-bzr-status (file)
@@ -395,52 +390,58 @@ string or nil, and STATUS is one of the symbols: `added',
`ignored', `kindchanged', `modified', `removed', `renamed', `unknown',
which directly correspond to `bzr status' output, or 'unchanged
for files whose copy in the working tree is identical to the one
-in the branch repository, or nil for files that are not
-registered with Bzr.
-
-If any error occurred in running `bzr status', then return nil."
+in the branch repository (or whose status not be determined)."
+;; Doc used to also say the following, but AFAICS, it has never been true.
+;;
+;; ", or nil for files that are not registered with Bzr.
+;; If any error occurred in running `bzr status', then return nil."
+;;
+;; Rather than returning nil in case of an error, it returns
+;; (unchanged . WARNING). FIXME unchanged is not the best status to
+;; return in case of error.
(with-temp-buffer
- (let ((ret (condition-case nil
- (vc-bzr-command "status" t 0 file)
- (file-error nil))) ; vc-bzr-program not found.
- (status 'unchanged))
- ;; the only secure status indication in `bzr status' output
- ;; is a couple of lines following the pattern::
- ;; | <status>:
- ;; | <file name>
- ;; if the file is up-to-date, we get no status report from `bzr',
- ;; so if the regexp search for the above pattern fails, we consider
- ;; the file to be up-to-date.
- (goto-char (point-min))
- (when (re-search-forward
- ;; bzr prints paths relative to the repository root.
- (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
- (regexp-quote (vc-bzr-file-name-relative file))
- ;; Bzr appends a '/' to directory names and
- ;; '*' to executable files
- (if (file-directory-p file) "/?" "\\*?")
- "[ \t\n]*$")
- nil t)
- (lexical-let ((statusword (match-string 1)))
- ;; Erase the status text that matched.
- (delete-region (match-beginning 0) (match-end 0))
- (setq status
- (intern (replace-regexp-in-string " " "" statusword)))))
- (when status
- (goto-char (point-min))
- (skip-chars-forward " \n\t") ;Throw away spaces.
- (cons status
- ;; "bzr" will output warnings and informational messages to
- ;; stderr; due to Emacs' `vc-do-command' (and, it seems,
- ;; `start-process' itself) limitations, we cannot catch stderr
- ;; and stdout into different buffers. So, if there's anything
- ;; left in the buffer after removing the above status
- ;; keywords, let us just presume that any other message from
- ;; "bzr" is a user warning, and display it.
- (unless (eobp) (buffer-substring (point) (point-max))))))))
+ ;; This is with-demoted-errors without the condition-case-unless-debug
+ ;; annoyance, which makes it fail during ert testing.
+ (condition-case err (vc-bzr-command "status" t 0 file)
+ (error (message "Error: %S" err) nil))
+ (let ((status 'unchanged))
+ ;; the only secure status indication in `bzr status' output
+ ;; is a couple of lines following the pattern::
+ ;; | <status>:
+ ;; | <file name>
+ ;; if the file is up-to-date, we get no status report from `bzr',
+ ;; so if the regexp search for the above pattern fails, we consider
+ ;; the file to be up-to-date.
+ (goto-char (point-min))
+ (when (re-search-forward
+ ;; bzr prints paths relative to the repository root.
+ (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
+ (regexp-quote (vc-bzr-file-name-relative file))
+ ;; Bzr appends a '/' to directory names and
+ ;; '*' to executable files
+ (if (file-directory-p file) "/?" "\\*?")
+ "[ \t\n]*$")
+ nil t)
+ (let ((statusword (match-string 1)))
+ ;; Erase the status text that matched.
+ (delete-region (match-beginning 0) (match-end 0))
+ (setq status
+ (intern (replace-regexp-in-string " " "" statusword)))))
+ (when status
+ (goto-char (point-min))
+ (skip-chars-forward " \n\t") ;Throw away spaces.
+ (cons status
+ ;; "bzr" will output warnings and informational messages to
+ ;; stderr; due to Emacs's `vc-do-command' (and, it seems,
+ ;; `start-process' itself) limitations, we cannot catch stderr
+ ;; and stdout into different buffers. So, if there's anything
+ ;; left in the buffer after removing the above status
+ ;; keywords, let us just presume that any other message from
+ ;; "bzr" is a user warning, and display it.
+ (unless (eobp) (buffer-substring (point) (point-max))))))))
(defun vc-bzr-state (file)
- (lexical-let ((result (vc-bzr-status file)))
+ (let ((result (vc-bzr-status file)))
(when (consp result)
(let ((warnings (cdr result)))
(when warnings
@@ -492,16 +493,15 @@ If any error occurred in running `bzr status', then return nil."
(defun vc-bzr-working-revision (file)
;; Together with the code in vc-state-heuristic, this makes it possible
;; to get the initial VC state of a Bzr file even if Bzr is not installed.
- (lexical-let*
- ((rootdir (vc-bzr-root file))
- (branch-format-file (expand-file-name vc-bzr-admin-branch-format-file
- rootdir))
- (revhistory-file (expand-file-name vc-bzr-admin-revhistory rootdir))
- (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir)))
+ (let* ((rootdir (vc-bzr-root file))
+ (branch-format-file (expand-file-name vc-bzr-admin-branch-format-file
+ rootdir))
+ (revhistory-file (expand-file-name vc-bzr-admin-revhistory rootdir))
+ (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir)))
;; This looks at internal files to avoid forking a bzr process.
;; May break if they change their format.
(if (and (file-exists-p branch-format-file)
- ;; For lightweight checkouts (obtained with bzr checkout --lightweight)
+ ;; For lightweight checkouts (obtained with bzr co --lightweight)
;; the branch-format-file does not contain the revision
;; information, we need to look up the branch-format-file
;; in the place where the lightweight checkout comes
@@ -520,19 +520,25 @@ If any error occurred in running `bzr status', then return nil."
(when (re-search-forward "file://\\(.+\\)" nil t)
(let ((l-c-parent-dir (match-string 1)))
(when (and (memq system-type '(ms-dos windows-nt))
- (string-match-p "^/[[:alpha:]]:" l-c-parent-dir))
- ;;; The non-Windows code takes a shortcut by using the host/path
- ;;; separator slash as the start of the absolute path. That
- ;;; does not work on Windows, so we must remove it (bug#5345)
+ (string-match-p "^/[[:alpha:]]:"
+ l-c-parent-dir))
+ ;;; The non-Windows code takes a shortcut by using
+ ;;; the host/path separator slash as the start of
+ ;;; the absolute path. That does not work on
+ ;;; Windows, so we must remove it (bug#5345)
(setq l-c-parent-dir (substring l-c-parent-dir 1)))
(setq branch-format-file
(expand-file-name vc-bzr-admin-branch-format-file
l-c-parent-dir))
(setq lastrev-file
- (expand-file-name vc-bzr-admin-lastrev l-c-parent-dir))
- ;; FIXME: maybe it's overkill to check if both these files exist.
+ (expand-file-name vc-bzr-admin-lastrev
+ l-c-parent-dir))
+ ;; FIXME: maybe it's overkill to check if both these
+ ;; files exist.
(and (file-exists-p branch-format-file)
- (file-exists-p lastrev-file)))))
+ (file-exists-p lastrev-file)
+ (equal (emacs-bzr-version-dirstate l-c-parent-dir)
+ (emacs-bzr-version-dirstate rootdir))))))
t)))
(with-temp-buffer
(insert-file-contents branch-format-file)
@@ -551,35 +557,38 @@ If any error occurred in running `bzr status', then return nil."
(insert-file-contents lastrev-file)
(when (re-search-forward "[0-9]+" nil t)
(buffer-substring (match-beginning 0) (match-end 0))))))
- ;; fallback to calling "bzr revno"
- (lexical-let*
- ((result (vc-bzr-command-discarding-stderr
- vc-bzr-program "revno" (file-relative-name file)))
- (exitcode (car result))
- (output (cdr result)))
+ ;; Fallback to calling "bzr revno --tree".
+ ;; The "--tree" matters for lightweight checkouts not on the same
+ ;; revision as the parent.
+ (let* ((result (vc-bzr-command-discarding-stderr
+ vc-bzr-program "revno" "--tree"
+ (file-relative-name file)))
+ (exitcode (car result))
+ (output (cdr result)))
(cond
- ((eq exitcode 0) (substring output 0 -1))
+ ((and (eq exitcode 0) (not (zerop (length output))))
+ (substring output 0 -1))
(t nil))))))
(defun vc-bzr-create-repo ()
"Create a new Bzr repository."
(vc-bzr-command "init" nil 0 nil))
-(defun vc-bzr-init-revision (&optional file)
+(defun vc-bzr-init-revision (&optional _file)
"Always return nil, as Bzr cannot register explicit versions."
nil)
-(defun vc-bzr-previous-revision (file rev)
+(defun vc-bzr-previous-revision (_file rev)
(if (string-match "\\`[0-9]+\\'" rev)
(number-to-string (1- (string-to-number rev)))
(concat "before:" rev)))
-(defun vc-bzr-next-revision (file rev)
+(defun vc-bzr-next-revision (_file rev)
(if (string-match "\\`[0-9]+\\'" rev)
(number-to-string (1+ (string-to-number rev)))
(error "Don't know how to compute the next revision of %s" rev)))
-(defun vc-bzr-register (files &optional rev comment)
+(defun vc-bzr-register (files &optional rev _comment)
"Register FILES under bzr.
Signal an error unless REV is nil.
COMMENT is ignored."
@@ -628,7 +637,7 @@ REV non-nil gets an error."
(vc-bzr-command "cat" t 0 file "-r" rev)
(vc-bzr-command "cat" t 0 file))))
-(defun vc-bzr-checkout (file &optional editable rev)
+(defun vc-bzr-checkout (_file &optional _editable rev)
(if rev (error "Operation not supported")
;; Else, there's nothing to do.
nil))
@@ -779,7 +788,7 @@ Each line is tagged with the revision number, which has a `help-echo'
property containing author and date information."
(apply #'vc-bzr-command "annotate" buffer 'async file "--long" "--all"
(if revision (list "-r" revision)))
- (lexical-let ((table (make-hash-table :test 'equal)))
+ (let ((table (make-hash-table :test 'equal)))
(set-process-filter
(get-buffer-process buffer)
(lambda (proc string)
@@ -846,7 +855,7 @@ stream. Standard error output is discarded."
(apply #'process-file command nil (list (current-buffer) nil) nil args)
(buffer-substring (point-min) (point-max)))))
-(defstruct (vc-bzr-extra-fileinfo
+(cl-defstruct (vc-bzr-extra-fileinfo
(:copier nil)
(:constructor vc-bzr-create-extra-fileinfo (extra-name))
(:conc-name vc-bzr-extra-fileinfo->))
@@ -944,7 +953,7 @@ stream. Standard error output is discarded."
;; frob the results accordingly.
(file-relative-name ,dir (vc-bzr-root ,dir)))))
-(defun vc-bzr-dir-status-files (dir files default-state update-function)
+(defun vc-bzr-dir-status-files (dir files _default-state update-function)
"Return a list of conses (file . state) for DIR."
(apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files)
(vc-exec-after
@@ -1181,74 +1190,73 @@ stream. Standard error output is discarded."
"revno" "submit" "tag")))
(defun vc-bzr-revision-completion-table (files)
- (lexical-let ((files files))
- ;; What about using `files'?!? --Stef
- (lambda (string pred action)
- (cond
- ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):"
- string)
- (completion-table-with-context (substring string 0 (match-end 0))
- (apply-partially
- 'completion-table-with-predicate
- 'completion-file-name-table
- 'file-directory-p t)
- (substring string (match-end 0))
- pred
- action))
- ((string-match "\\`\\(before\\):" string)
- (completion-table-with-context (substring string 0 (match-end 0))
- (vc-bzr-revision-completion-table files)
- (substring string (match-end 0))
- pred
- action))
- ((string-match "\\`\\(tag\\):" string)
- (let ((prefix (substring string 0 (match-end 0)))
- (tag (substring string (match-end 0)))
- (table nil)
- process-file-side-effects)
- (with-temp-buffer
- ;; "bzr-1.2 tags" is much faster with --show-ids.
- (process-file vc-bzr-program nil '(t) nil "tags" "--show-ids")
- ;; The output is ambiguous, unless we assume that revids do not
- ;; contain spaces.
- (goto-char (point-min))
- (while (re-search-forward "^\\(.*[^ \n]\\) +[^ \n]*$" nil t)
- (push (match-string-no-properties 1) table)))
- (completion-table-with-context prefix table tag pred action)))
-
- ((string-match "\\`annotate:" string)
- (completion-table-with-context
- (substring string 0 (match-end 0))
- (apply-partially #'completion-table-with-terminator '(":" . "\\`a\\`")
- #'completion-file-name-table)
- (substring string (match-end 0)) pred action))
-
- ((string-match "\\`date:" string)
- (completion-table-with-context
- (substring string 0 (match-end 0))
- '("yesterday" "today" "tomorrow")
- (substring string (match-end 0)) pred action))
-
- ((string-match "\\`\\([a-z]+\\):" string)
- ;; no actual completion for the remaining keywords.
- (completion-table-with-context (substring string 0 (match-end 0))
- (if (member (match-string 1 string)
- vc-bzr-revision-keywords)
- ;; If it's a valid keyword,
- ;; use a non-empty table to
- ;; indicate it.
- '("") nil)
- (substring string (match-end 0))
- pred
- action))
- (t
- ;; Could use completion-table-with-terminator, except that it
- ;; currently doesn't work right w.r.t pcm and doesn't give
- ;; the *Completions* output we want.
- (complete-with-action action (eval-when-compile
- (mapcar (lambda (s) (concat s ":"))
- vc-bzr-revision-keywords))
- string pred))))))
+ ;; What about using `files'?!? --Stef
+ (lambda (string pred action)
+ (cond
+ ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):"
+ string)
+ (completion-table-with-context (substring string 0 (match-end 0))
+ (apply-partially
+ 'completion-table-with-predicate
+ 'completion-file-name-table
+ 'file-directory-p t)
+ (substring string (match-end 0))
+ pred
+ action))
+ ((string-match "\\`\\(before\\):" string)
+ (completion-table-with-context (substring string 0 (match-end 0))
+ (vc-bzr-revision-completion-table files)
+ (substring string (match-end 0))
+ pred
+ action))
+ ((string-match "\\`\\(tag\\):" string)
+ (let ((prefix (substring string 0 (match-end 0)))
+ (tag (substring string (match-end 0)))
+ (table nil)
+ process-file-side-effects)
+ (with-temp-buffer
+ ;; "bzr-1.2 tags" is much faster with --show-ids.
+ (process-file vc-bzr-program nil '(t) nil "tags" "--show-ids")
+ ;; The output is ambiguous, unless we assume that revids do not
+ ;; contain spaces.
+ (goto-char (point-min))
+ (while (re-search-forward "^\\(.*[^ \n]\\) +[^ \n]*$" nil t)
+ (push (match-string-no-properties 1) table)))
+ (completion-table-with-context prefix table tag pred action)))
+
+ ((string-match "\\`annotate:" string)
+ (completion-table-with-context
+ (substring string 0 (match-end 0))
+ (apply-partially #'completion-table-with-terminator '(":" . "\\`a\\`")
+ #'completion-file-name-table)
+ (substring string (match-end 0)) pred action))
+
+ ((string-match "\\`date:" string)
+ (completion-table-with-context
+ (substring string 0 (match-end 0))
+ '("yesterday" "today" "tomorrow")
+ (substring string (match-end 0)) pred action))
+
+ ((string-match "\\`\\([a-z]+\\):" string)
+ ;; no actual completion for the remaining keywords.
+ (completion-table-with-context (substring string 0 (match-end 0))
+ (if (member (match-string 1 string)
+ vc-bzr-revision-keywords)
+ ;; If it's a valid keyword,
+ ;; use a non-empty table to
+ ;; indicate it.
+ '("") nil)
+ (substring string (match-end 0))
+ pred
+ action))
+ (t
+ ;; Could use completion-table-with-terminator, except that it
+ ;; currently doesn't work right w.r.t pcm and doesn't give
+ ;; the *Completions* output we want.
+ (complete-with-action action (eval-when-compile
+ (mapcar (lambda (s) (concat s ":"))
+ vc-bzr-revision-keywords))
+ string pred)))))
(provide 'vc-bzr)
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 7d6c3caf7ff..ae1a3cf92f8 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -1,6 +1,6 @@
-;;; vc-cvs.el --- non-resident support for CVS version-control
+;;; vc-cvs.el --- non-resident support for CVS version-control -*- lexical-binding: t -*-
-;; Copyright (C) 1995, 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998-2012 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
@@ -25,7 +25,7 @@
;;; Code:
-(eval-when-compile (require 'cl) (require 'vc))
+(eval-when-compile (require 'vc))
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
@@ -59,6 +59,11 @@
;;; Customization options
;;;
+(defgroup vc-cvs nil
+ "VC CVS backend."
+ :version "24.1"
+ :group 'vc)
+
(defcustom vc-cvs-global-switches nil
"Global switches to pass to any CVS command."
:type '(choice (const :tag "None" nil)
@@ -67,7 +72,7 @@
:value ("")
string))
:version "22.1"
- :group 'vc)
+ :group 'vc-cvs)
(defcustom vc-cvs-register-switches nil
"Switches for registering a file into CVS.
@@ -79,7 +84,7 @@ If t, use no switches."
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "21.1"
- :group 'vc)
+ :group 'vc-cvs)
(defcustom vc-cvs-diff-switches nil
"String or list of strings specifying switches for CVS diff under VC.
@@ -89,13 +94,13 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "21.1"
- :group 'vc)
+ :group 'vc-cvs)
(defcustom vc-cvs-header '("\$Id\$")
"Header keywords to be inserted by `vc-insert-headers'."
:version "24.1" ; no longer consult the obsolete vc-header-alist
:type '(repeat string)
- :group 'vc)
+ :group 'vc-cvs)
(defcustom vc-cvs-use-edit t
"Non-nil means to use `cvs edit' to \"check out\" a file.
@@ -103,7 +108,7 @@ This is only meaningful if you don't use the implicit checkout model
\(i.e. if you have $CVSREAD set)."
:type 'boolean
:version "21.1"
- :group 'vc)
+ :group 'vc-cvs)
(defcustom vc-cvs-stay-local 'only-file
"Non-nil means use local operations when possible for remote repositories.
@@ -131,7 +136,7 @@ by these regular expressions."
:tag "if it matches")
(repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
:version "23.1"
- :group 'vc)
+ :group 'vc-cvs)
(defcustom vc-cvs-sticky-date-format-string "%c"
"Format string for mode-line display of sticky date.
@@ -139,7 +144,7 @@ Format is according to `format-time-string'. Only used if
`vc-cvs-sticky-tag-display' is t."
:type '(string)
:version "22.1"
- :group 'vc)
+ :group 'vc-cvs)
(defcustom vc-cvs-sticky-tag-display t
"Specify the mode-line display of sticky tags.
@@ -178,7 +183,7 @@ displayed. Date and time is displayed for sticky dates.
See also variable `vc-cvs-sticky-date-format-string'."
:type '(choice boolean function)
:version "22.1"
- :group 'vc)
+ :group 'vc-cvs)
;;;
;;; Internal variables
@@ -251,7 +256,7 @@ See also variable `vc-cvs-sticky-date-format-string'."
(vc-file-getprop file 'vc-working-revision))
(defun vc-cvs-mode-line-string (file)
- "Return string for placement into the modeline for FILE.
+ "Return a string for `vc-mode-line' to put in the mode line for FILE.
Compared to the default implementation, this function does two things:
Handle the special case of a CVS file that is added but not yet
committed and support display of sticky tags."
@@ -275,7 +280,7 @@ committed and support display of sticky tags."
;;; State-changing functions
;;;
-(defun vc-cvs-register (files &optional rev comment)
+(defun vc-cvs-register (files &optional _rev comment)
"Register FILES into the CVS version-control system.
COMMENT can be used to provide an initial description of FILES.
Passes either `vc-cvs-register-switches' or `vc-register-switches'
@@ -319,7 +324,7 @@ its parents."
(unless (or (not rev) (vc-cvs-valid-revision-number-p rev))
(if (not (vc-cvs-valid-symbolic-tag-name-p rev))
(error "%s is not a valid symbolic tag name" rev)
- ;; If the input revison is a valid symbolic tag name, we create it
+ ;; If the input revision is a valid symbolic tag name, we create it
;; as a branch, commit and switch to it.
(apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev))
(apply 'vc-cvs-command nil 0 files "update" "-r" (list rev))
@@ -389,7 +394,7 @@ REV is the revision to check out."
(if vc-cvs-use-edit
(vc-cvs-command nil 0 file "edit")
(set-file-modes file (logior (file-modes file) 128))
- (if (equal file buffer-file-name) (toggle-read-only -1))))
+ (if (equal file buffer-file-name) (read-only-mode -1))))
;; Check out a particular revision (or recreate the file).
(vc-file-setprop file 'vc-working-revision nil)
(apply 'vc-cvs-command nil 0 file
@@ -497,7 +502,7 @@ Will fail unless you have administrative privileges on the repo."
(declare-function vc-rcs-print-log-cleanup "vc-rcs" ())
-(defun vc-cvs-print-log (files buffer &optional shortlog start-revision-ignored limit)
+(defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision limit)
"Get change logs associated with FILES."
(require 'vc-rcs)
;; It's just the catenation of the individual logs.
@@ -785,7 +790,7 @@ For an empty string, nil is returned (invalid CVS root)."
((= len 3)
;; :METHOD:PATH or :METHOD:USER@HOSTNAME/PATH
(cons (cadr root-list)
- (vc-cvs-parse-uhp (caddr root-list))))
+ (vc-cvs-parse-uhp (nth 2 root-list))))
(t
;; :METHOD:[USER@]HOST:PATH
(cdr root-list)))))
@@ -1001,7 +1006,7 @@ state."
(vc-exec-after
`(vc-cvs-after-dir-status (quote ,update-function))))))
-(defun vc-cvs-dir-status-files (dir files default-state update-function)
+(defun vc-cvs-dir-status-files (dir files _default-state update-function)
"Create a list of conses (file . state) for DIR."
(apply 'vc-cvs-command (current-buffer) 'async dir "-f" "status" files)
(vc-exec-after
@@ -1016,7 +1021,7 @@ state."
(buffer-substring (point) (point-max)))
(file-error nil)))
-(defun vc-cvs-dir-extra-headers (dir)
+(defun vc-cvs-dir-extra-headers (_dir)
"Extract and represent per-directory properties of a CVS working copy."
(let ((repo
(condition-case nil
@@ -1173,7 +1178,11 @@ is non-nil."
(parse-time-string (concat time " +0000")))))
(cond ((and (not (string-match "\\+" time))
(car parsed-time)
- (equal mtime (apply 'encode-time parsed-time)))
+ ;; Compare just the seconds part of the file time,
+ ;; since CVS file time stamp resolution is just 1 second.
+ (let ((ptime (apply 'encode-time parsed-time)))
+ (and (eq (car mtime) (car ptime))
+ (eq (cadr mtime) (cadr ptime)))))
(vc-file-setprop file 'vc-checkout-time mtime)
(if set-state (vc-file-setprop file 'vc-state 'up-to-date)))
(t
@@ -1201,10 +1210,8 @@ is non-nil."
res)))
(defun vc-cvs-revision-completion-table (files)
- (lexical-let ((files files)
- table)
- (setq table (lazy-completion-table
- table (lambda () (vc-cvs-revision-table (car files)))))
+ (letrec ((table (lazy-completion-table
+ table (lambda () (vc-cvs-revision-table (car files))))))
table))
diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el
index 27db4b57dc9..6cd2b1ddf76 100644
--- a/lisp/vc/vc-dav.el
+++ b/lisp/vc/vc-dav.el
@@ -1,12 +1,14 @@
;;; vc-dav.el --- vc.el support for WebDAV
-;; Copyright (C) 2001, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2004-2012 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Maintainer: Bill Perry <wmperry@gnu.org>
;; Keywords: url, vc
;; Package: vc
+;; 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
@@ -20,7 +22,6 @@
;; 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:
;;; Todo:
@@ -170,10 +171,7 @@ It should return a status of either 0 (no differences found), or
;; Return a dav-specific mode line string for URL. Are there any
;; specific states that we want exposed?
;;
-;; vc-dav-dired-state-info(url)
-;; Translate the `vc-state' property of URL into a string that can
-;; be used in a vc-dired buffer. Are there any extra states that
-;; we want exposed?
+;; vc-dir support
;;
;; vc-dav-receive-file(url rev)
;; Let this backend `receive' a file that is already registered
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index f14b8830d43..455f48c50d3 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -1,6 +1,6 @@
-;;; vc-dir.el --- Directory status display under VC
+;;; vc-dir.el --- Directory status display under VC -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Dan Nicolaescu <dann@ics.uci.edu>
;; Keywords: vc tools
@@ -43,8 +43,7 @@
(require 'ewoc)
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defcustom vc-dir-mode-hook nil
"Normal hook run by `vc-dir-mode'.
@@ -54,7 +53,7 @@ See `run-hooks'."
;; Used to store information for the files displayed in the directory buffer.
;; Each item displayed corresponds to one of these defstructs.
-(defstruct (vc-dir-fileinfo
+(cl-defstruct (vc-dir-fileinfo
(:copier nil)
(:type list) ;So we can use `member' on lists of FIs.
(:constructor
@@ -92,13 +91,13 @@ See `run-hooks'."
(let* ;; Look for another buffer name BNAME visiting the same directory.
((buf (save-excursion
(unless create-new
- (dolist (buffer vc-dir-buffers)
+ (cl-dolist (buffer vc-dir-buffers)
(when (buffer-live-p buffer)
(set-buffer buffer)
(when (and (derived-mode-p 'vc-dir-mode)
(eq vc-dir-backend backend)
(string= default-directory dir))
- (return buffer))))))))
+ (cl-return buffer))))))))
(or buf
;; Create a new buffer named BNAME.
;; We pass a filename to create-file-buffer because it is what
@@ -529,7 +528,7 @@ If a prefix argument is given, move by that many lines."
(defun vc-dir-mark-unmark (mark-unmark-function)
(if (use-region-p)
- (let ((firstl (line-number-at-pos (region-beginning)))
+ (let (;; (firstl (line-number-at-pos (region-beginning)))
(lastl (line-number-at-pos (region-end))))
(save-excursion
(goto-char (region-beginning))
@@ -546,7 +545,7 @@ If a prefix argument is given, move by that many lines."
;; Non-nil iff a parent directory of arg is marked.
;; Return value, if non-nil is the `ewoc-data' for the marked parent.
(let* ((argdir (vc-dir-node-directory arg))
- (arglen (length argdir))
+ ;; (arglen (length argdir))
(crt arg)
(found nil))
;; Go through the predecessors, checking if any directory that is
@@ -556,7 +555,7 @@ If a prefix argument is given, move by that many lines."
(let ((data (ewoc-data crt))
(dir (vc-dir-node-directory crt)))
(and (vc-dir-fileinfo->directory data)
- (vc-string-prefix-p dir argdir)
+ (string-prefix-p dir argdir)
(vc-dir-fileinfo->marked data)
(setq found data))))
found))
@@ -814,11 +813,11 @@ child files."
;; FIXME: use vc-dir-child-files-and-states here instead of duplicating it.
(if (vc-dir-fileinfo->directory crt-data)
(let* ((dir (vc-dir-fileinfo->directory crt-data))
- (dirlen (length dir))
+ ;; (dirlen (length dir))
data)
(while
(and (setq crt (ewoc-next vc-ewoc crt))
- (vc-string-prefix-p dir
+ (string-prefix-p dir
(progn
(setq data (ewoc-data crt))
(vc-dir-node-directory crt))))
@@ -842,11 +841,11 @@ If it is a file, return the corresponding cons for the file itself."
result)
(if (vc-dir-fileinfo->directory crt-data)
(let* ((dir (vc-dir-fileinfo->directory crt-data))
- (dirlen (length dir))
+ ;; (dirlen (length dir))
data)
(while
(and (setq crt (ewoc-next vc-ewoc crt))
- (vc-string-prefix-p dir (progn
+ (string-prefix-p dir (progn
(setq data (ewoc-data crt))
(vc-dir-node-directory crt))))
(unless (vc-dir-fileinfo->directory data)
@@ -861,7 +860,7 @@ If it is a file, return the corresponding cons for the file itself."
(defun vc-dir-recompute-file-state (fname def-dir)
(let* ((file-short (file-relative-name fname def-dir))
- (remove-me-when-CVS-works
+ (_remove-me-when-CVS-works
(when (eq vc-dir-backend 'CVS)
;; FIXME: Warning: UGLY HACK. The CVS backend caches the state
;; info, this forces the backend to update it.
@@ -875,15 +874,14 @@ If it is a file, return the corresponding cons for the file itself."
;; Give a DIRNAME string return the list of all child files shown in
;; the current *vc-dir* buffer.
(let ((crt (ewoc-nth vc-ewoc 0))
- children
- dname)
+ children)
;; Find DIR
- (while (and crt (not (vc-string-prefix-p
+ (while (and crt (not (string-prefix-p
dirname (vc-dir-node-directory crt))))
(setq crt (ewoc-next vc-ewoc crt)))
- (while (and crt (vc-string-prefix-p
+ (while (and crt (string-prefix-p
dirname
- (setq dname (vc-dir-node-directory crt))))
+ (vc-dir-node-directory crt)))
(let ((data (ewoc-data crt)))
(unless (vc-dir-fileinfo->directory data)
(push (expand-file-name (vc-dir-fileinfo->name data)) children)))
@@ -915,7 +913,7 @@ If it is a file, return the corresponding cons for the file itself."
(if (not (derived-mode-p 'vc-dir-mode))
(push status-buf drop)
(let ((ddir default-directory))
- (when (vc-string-prefix-p ddir file)
+ (when (string-prefix-p ddir file)
(if (file-directory-p file)
(progn
(vc-dir-resync-directory-files file)
@@ -1014,7 +1012,7 @@ specific headers."
(unless (buffer-live-p vc-dir-process-buffer)
(setq vc-dir-process-buffer
(generate-new-buffer (format " *VC-%s* tmp status" backend))))
- (lexical-let ((buffer (current-buffer)))
+ (let ((buffer (current-buffer)))
(with-current-buffer vc-dir-process-buffer
(setq default-directory def-dir)
(erase-buffer)
@@ -1045,7 +1043,7 @@ specific headers."
(not (vc-dir-fileinfo->needs-update info))))))))))))
-(defun vc-dir-revert-buffer-function (&optional ignore-auto noconfirm)
+(defun vc-dir-revert-buffer-function (&optional _ignore-auto _noconfirm)
(vc-dir-refresh))
(defun vc-dir-refresh ()
@@ -1079,7 +1077,7 @@ Throw an error if another update process is in progress."
;; Bzr has serious locking problems, so setup the headers first (this is
;; synchronous) rather than doing it while dir-status is running.
(ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) "")
- (lexical-let ((buffer (current-buffer)))
+ (let ((buffer (current-buffer)))
(with-current-buffer vc-dir-process-buffer
(setq default-directory def-dir)
(erase-buffer)
@@ -1108,9 +1106,22 @@ outside of VC) and one wants to do some operation on it."
(interactive "fShow file: ")
(vc-dir-update (list (list (file-relative-name file) (vc-state file))) (current-buffer)))
-(defun vc-dir-hide-up-to-date ()
- "Hide up-to-date items from display."
- (interactive)
+(defun vc-dir-hide-state (&optional state)
+ "Hide items that are in STATE from display.
+See `vc-state' for valid values of STATE.
+
+If STATE is nil, default it to up-to-date.
+
+Interactively, if `current-prefix-arg' is non-nil, set STATE to
+state of item at point. Otherwise, set STATE to up-to-date."
+ (interactive (list
+ (and current-prefix-arg
+ ;; Command is prefixed. Infer STATE from point.
+ (let ((node (ewoc-locate vc-ewoc)))
+ (and node (vc-dir-fileinfo->state (ewoc-data node)))))))
+ ;; If STATE is un-specified, use up-to-date.
+ (setq state (or state 'up-to-date))
+ (message "Hiding items in state \"%s\"" state)
(let ((crt (ewoc-nth vc-ewoc -1))
(first (ewoc-nth vc-ewoc 0)))
;; Go over from the last item to the first and remove the
@@ -1122,18 +1133,21 @@ outside of VC) and one wants to do some operation on it."
(prev (ewoc-prev vc-ewoc crt))
;; ewoc-delete does not work without this...
(inhibit-read-only t))
- (when (or
- ;; Remove directories with no child files.
- (and dir
- (or
- ;; Nothing follows this directory.
- (not next)
- ;; Next item is a directory.
- (vc-dir-fileinfo->directory (ewoc-data next))))
- ;; Remove files in the up-to-date state.
- (eq (vc-dir-fileinfo->state data) 'up-to-date))
- (ewoc-delete vc-ewoc crt))
- (setq crt prev)))))
+ (when (or
+ ;; Remove directories with no child files.
+ (and dir
+ (or
+ ;; Nothing follows this directory.
+ (not next)
+ ;; Next item is a directory.
+ (vc-dir-fileinfo->directory (ewoc-data next))))
+ ;; Remove files in specified STATE. STATE can be a
+ ;; symbol or a user-name.
+ (equal (vc-dir-fileinfo->state data) state))
+ (ewoc-delete vc-ewoc crt))
+ (setq crt prev)))))
+
+(defalias 'vc-dir-hide-up-to-date 'vc-dir-hide-state)
(defun vc-dir-kill-line ()
"Remove the current line from display."
@@ -1219,7 +1233,7 @@ These are the commands available for use in the file status buffer:
(let ((use-vc-backend backend))
(vc-dir-mode))))
-(defun vc-default-dir-extra-headers (backend dir)
+(defun vc-default-dir-extra-headers (_backend _dir)
;; Be loud by default to remind people to add code to display
;; backend specific headers.
;; XXX: change this to return nil before the release.
@@ -1234,7 +1248,7 @@ These are the commands available for use in the file status buffer:
map)
"Local keymap for visiting a file.")
-(defun vc-default-dir-printer (backend fileentry)
+(defun vc-default-dir-printer (_backend fileentry)
"Pretty print FILEENTRY."
;; If you change the layout here, change vc-dir-move-to-goal-column.
;; VC backends can implement backend specific versions of this
@@ -1267,10 +1281,10 @@ These are the commands available for use in the file status buffer:
'mouse-face 'highlight
'keymap vc-dir-filename-mouse-map))))
-(defun vc-default-extra-status-menu (backend)
+(defun vc-default-extra-status-menu (_backend)
nil)
-(defun vc-default-status-fileinfo-extra (backend file)
+(defun vc-default-status-fileinfo-extra (_backend _file)
"Default absence of extra information returned for a file."
nil)
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 7fe727bd179..d8a7a296cf1 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -1,6 +1,6 @@
;;; vc-dispatcher.el -- generic command-dispatcher facility.
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Maintainer: Eric S. Raymond <esr@thyrsus.com>
@@ -386,6 +386,17 @@ Display the buffer in some window, but don't select it."
(set-window-start window new-window-start))
buffer))
+(defun vc-compilation-mode (backend)
+ "Setup `compilation-mode' after with the appropriate `compilation-error-regexp-alist'."
+ (let* ((error-regexp-alist
+ (vc-make-backend-sym backend 'error-regexp-alist))
+ (compilation-error-regexp-alist
+ (and (boundp error-regexp-alist)
+ (symbol-value error-regexp-alist))))
+ (compilation-mode)
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ compilation-error-regexp-alist)))
+
(defun vc-set-async-update (process-buffer)
"Set a `vc-exec-after' action appropriate to the current buffer.
This action will update the current buffer after the current
@@ -537,13 +548,12 @@ editing!"
(kill-buffer (current-buffer)))))
(declare-function vc-dir-resynch-file "vc-dir" (&optional fname))
-(declare-function vc-string-prefix-p "vc" (prefix string))
(defun vc-resynch-buffers-in-directory (directory &optional keep noquery reset-vc-info)
"Resync all buffers that visit files in DIRECTORY."
(dolist (buffer (buffer-list))
(let ((fname (buffer-file-name buffer)))
- (when (and fname (vc-string-prefix-p directory fname))
+ (when (and fname (string-prefix-p directory fname))
(with-current-buffer buffer
(vc-resynch-buffer fname keep noquery reset-vc-info))))))
@@ -576,10 +586,10 @@ NOT-URGENT means it is ok to continue if the user says not to save."
;; Set up key bindings for use while editing log messages
-(defun vc-log-edit (fileset mode)
+(defun vc-log-edit (fileset mode backend)
"Set up `log-edit' for use on FILE."
(setq default-directory
- (with-current-buffer vc-parent-buffer default-directory))
+ (buffer-local-value 'default-directory vc-parent-buffer))
(log-edit 'vc-finish-logentry
nil
`((log-edit-listfun . (lambda ()
@@ -587,14 +597,15 @@ NOT-URGENT means it is ok to continue if the user says not to save."
;; for directories.
(mapcar 'file-relative-name
',fileset)))
- (log-edit-diff-function . (lambda () (vc-diff nil))))
+ (log-edit-diff-function . vc-diff)
+ (log-edit-vc-backend . ,backend)
+ (vc-log-fileset . ,fileset))
nil
mode)
- (set (make-local-variable 'vc-log-fileset) fileset)
(set-buffer-modified-p nil)
(setq buffer-file-name nil))
-(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook)
+(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook backend)
"Accept a comment for an operation on FILES.
If COMMENT is nil, pop up a LOGBUF buffer, emit MSG, and set the
action on close to ACTION. If COMMENT is a string and
@@ -605,7 +616,8 @@ entered COMMENT. If COMMENT is t, also do action immediately with an
empty comment. Remember the file's buffer in `vc-parent-buffer'
\(current one if no file). Puts the log-entry buffer in major-mode
MODE, defaulting to `log-edit-mode' if MODE is nil.
-AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'."
+AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'.
+BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer."
(let ((parent
(if (vc-dispatcher-browsing)
;; If we are called from a directory browser, the parent buffer is
@@ -620,7 +632,7 @@ AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'."
(set (make-local-variable 'vc-parent-buffer) parent)
(set (make-local-variable 'vc-parent-buffer-name)
(concat " from " (buffer-name vc-parent-buffer)))
- (vc-log-edit files mode)
+ (vc-log-edit files mode backend)
(make-local-variable 'vc-log-after-operation-hook)
(when after-hook
(setq vc-log-after-operation-hook after-hook))
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index e9cbeeeb40a..5d7cb366e82 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1,6 +1,6 @@
-;;; vc-git.el --- VC backend for the git version control system
+;;; vc-git.el --- VC backend for the git version control system -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Alexandre Julliard <julliard@winehq.org>
;; Keywords: vc tools
@@ -31,7 +31,7 @@
;; To install: put this file on the load-path and add Git to the list
;; of supported backends in `vc-handled-backends'; the following line,
-;; placed in your ~/.emacs, will accomplish this:
+;; placed in your init file, will accomplish this:
;;
;; (add-to-list 'vc-handled-backends 'Git)
@@ -104,11 +104,16 @@
;; - find-file-hook () NOT NEEDED
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'vc)
(require 'vc-dir)
(require 'grep))
+(defgroup vc-git nil
+ "VC Git backend."
+ :version "24.1"
+ :group 'vc)
+
(defcustom vc-git-diff-switches t
"String or list of strings specifying switches for Git diff under VC.
If nil, use the value of `vc-diff-switches'. If t, use no switches."
@@ -117,13 +122,13 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "23.1"
- :group 'vc)
+ :group 'vc-git)
(defcustom vc-git-program "git"
"Name of the Git executable (excluding any arguments)."
:version "24.1"
:type 'string
- :group 'vc)
+ :group 'vc-git)
(defcustom vc-git-root-log-format
'("%d%h..: %an %ad %s"
@@ -143,7 +148,7 @@ format string (which is passed to \"git log\" via the argument
matching the resulting Git log output, and KEYWORDS is a list of
`font-lock-keywords' for highlighting the Log View buffer."
:type '(list string string (repeat sexp))
- :group 'vc
+ :group 'vc-git
:version "24.1")
(defvar vc-git-commits-coding-system 'utf-8
@@ -155,7 +160,7 @@ matching the resulting Git log output, and KEYWORDS is a list of
;;; BACKEND PROPERTIES
(defun vc-git-revision-granularity () 'repository)
-(defun vc-git-checkout-model (files) 'implicit)
+(defun vc-git-checkout-model (_files) 'implicit)
;;; STATE-QUERYING FUNCTIONS
@@ -171,29 +176,29 @@ matching the resulting Git log output, and KEYWORDS is a list of
(let ((dir (vc-git-root file)))
(when dir
(with-temp-buffer
- (let* (process-file-side-effects
- ;; Do not use the `file-name-directory' here: git-ls-files
- ;; sometimes fails to return the correct status for relative
- ;; path specs.
- ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
- (name (file-relative-name file dir))
- (str (ignore-errors
- (cd dir)
- (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
- ;; If result is empty, use ls-tree to check for deleted
- ;; file.
- (when (eq (point-min) (point-max))
- (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
- "--" name))
- (buffer-string))))
- (and str
- (> (length str) (length name))
- (string= (substring str 0 (1+ (length name)))
- (concat name "\0"))))))))
+ (let* (process-file-side-effects
+ ;; Do not use the `file-name-directory' here: git-ls-files
+ ;; sometimes fails to return the correct status for relative
+ ;; path specs.
+ ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
+ (name (file-relative-name file dir))
+ (str (ignore-errors
+ (cd dir)
+ (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
+ ;; If result is empty, use ls-tree to check for deleted
+ ;; file.
+ (when (eq (point-min) (point-max))
+ (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
+ "--" name))
+ (buffer-string))))
+ (and str
+ (> (length str) (length name))
+ (string= (substring str 0 (1+ (length name)))
+ (concat name "\0"))))))))
(defun vc-git--state-code (code)
"Convert from a string to a added/deleted/modified state."
- (case (string-to-char code)
+ (pcase (string-to-char code)
(?M 'edited)
(?A 'added)
(?D 'removed)
@@ -210,17 +215,26 @@ matching the resulting Git log output, and KEYWORDS is a list of
;; is direct ancestor of corresponding upstream branch, and the file
;; was modified upstream. But we can't check that without a network
;; operation.
- (if (not (vc-git-registered file))
- 'unregistered
- (vc-git--call nil "add" "--refresh" "--" (file-relative-name file))
- (let ((diff (vc-git--run-command-string
- file "diff-index" "-z" "HEAD" "--")))
- (if (and diff (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0"
- diff))
- (vc-git--state-code (match-string 1 diff))
- (if (vc-git--empty-db-p) 'added 'up-to-date)))))
-
-(defun vc-git-working-revision (file)
+ ;; This assumes that status is known to be not `unregistered' because
+ ;; we've been successfully dispatched here from `vc-state', that
+ ;; means `vc-git-registered' returned t earlier once. Bug#11757
+ (let ((diff (vc-git--run-command-string
+ file "diff-index" "-p" "--raw" "-z" "HEAD" "--")))
+ (if (and diff
+ (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0\\(.*\n.\\)?"
+ diff))
+ (let ((diff-letter (match-string 1 diff)))
+ (if (not (match-beginning 2))
+ ;; Empty diff: file contents is the same as the HEAD
+ ;; revision, but timestamps are different (eg, file
+ ;; was "touch"ed). Update timestamp in index:
+ (prog1 'up-to-date
+ (vc-git--call nil "add" "--refresh" "--"
+ (file-relative-name file)))
+ (vc-git--state-code diff-letter)))
+ (if (vc-git--empty-db-p) 'added 'up-to-date))))
+
+(defun vc-git-working-revision (_file)
"Git-specific version of `vc-working-revision'."
(let* (process-file-side-effects
(str (with-output-to-string
@@ -234,8 +248,8 @@ matching the resulting Git log output, and KEYWORDS is a list of
(eq 'up-to-date (vc-git-state file)))
(defun vc-git-mode-line-string (file)
- "Return string for placement into the modeline for FILE."
- (let* ((branch (vc-git-working-revision file))
+ "Return a string for `vc-mode-line' to put in the mode line for FILE."
+ (let* ((branch (vc-working-revision file))
(def-ml (vc-default-mode-line-string 'Git file))
(help-echo (get-text-property 0 'help-echo def-ml)))
(if (zerop (length branch))
@@ -245,7 +259,7 @@ matching the resulting Git log output, and KEYWORDS is a list of
(propertize def-ml
'help-echo (concat help-echo "\nCurrent branch: " branch)))))
-(defstruct (vc-git-extra-fileinfo
+(cl-defstruct (vc-git-extra-fileinfo
(:copier nil)
(:constructor vc-git-create-extra-fileinfo
(old-perm new-perm &optional rename-state orig-name))
@@ -259,12 +273,12 @@ matching the resulting Git log output, and KEYWORDS is a list of
(if (string-match "[\n\t\"\\]" name)
(concat "\""
(mapconcat (lambda (c)
- (case c
+ (pcase c
(?\n "\\n")
(?\t "\\t")
(?\\ "\\\\")
(?\" "\\\"")
- (t (char-to-string c))))
+ (_ (char-to-string c))))
name "")
"\"")
name))
@@ -273,28 +287,28 @@ matching the resulting Git log output, and KEYWORDS is a list of
"Return a string describing the file type based on its permissions."
(let* ((old-type (lsh (or old-perm 0) -9))
(new-type (lsh (or new-perm 0) -9))
- (str (case new-type
+ (str (pcase new-type
(?\100 ;; File.
- (case old-type
+ (pcase old-type
(?\100 nil)
(?\120 " (type change symlink -> file)")
(?\160 " (type change subproject -> file)")))
(?\120 ;; Symlink.
- (case old-type
+ (pcase old-type
(?\100 " (type change file -> symlink)")
(?\160 " (type change subproject -> symlink)")
(t " (symlink)")))
(?\160 ;; Subproject.
- (case old-type
+ (pcase old-type
(?\100 " (type change file -> subproject)")
(?\120 " (type change symlink -> subproject)")
(t " (subproject)")))
(?\110 nil) ;; Directory (internal, not a real git state).
(?\000 ;; Deleted or unknown.
- (case old-type
+ (pcase old-type
(?\120 " (symlink)")
(?\160 " (subproject)")))
- (t (format " (unknown type %o)" new-type)))))
+ (_ (format " (unknown type %o)" new-type)))))
(cond (str (propertize str 'face 'font-lock-comment-face))
((eq new-type ?\110) "/")
(t ""))))
@@ -362,18 +376,18 @@ or an empty string if none."
"Process sentinel for the various dir-status stages."
(let (next-stage result)
(goto-char (point-min))
- (case stage
- (update-index
+ (pcase stage
+ (`update-index
(setq next-stage (if (vc-git--empty-db-p) 'ls-files-added
(if files 'ls-files-up-to-date 'diff-index))))
- (ls-files-added
+ (`ls-files-added
(setq next-stage 'ls-files-unknown)
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
(let ((new-perm (string-to-number (match-string 1) 8))
(name (match-string 2)))
(push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm))
result))))
- (ls-files-up-to-date
+ (`ls-files-up-to-date
(setq next-stage 'diff-index)
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
(let ((perm (string-to-number (match-string 1) 8))
@@ -381,18 +395,18 @@ or an empty string if none."
(push (list name 'up-to-date
(vc-git-create-extra-fileinfo perm perm))
result))))
- (ls-files-unknown
+ (`ls-files-unknown
(when files (setq next-stage 'ls-files-ignored))
(while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
(push (list (match-string 1) 'unregistered
(vc-git-create-extra-fileinfo 0 0))
result)))
- (ls-files-ignored
+ (`ls-files-ignored
(while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
(push (list (match-string 1) 'ignored
(vc-git-create-extra-fileinfo 0 0))
result)))
- (diff-index
+ (`diff-index
(setq next-stage 'ls-files-unknown)
(while (re-search-forward
":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMUT]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0"
@@ -431,41 +445,41 @@ or an empty string if none."
(defun vc-git-dir-status-goto-stage (stage files update-function)
(erase-buffer)
- (case stage
- (update-index
+ (pcase stage
+ (`update-index
(if files
(vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
(vc-git-command (current-buffer) 'async nil
"update-index" "--refresh")))
- (ls-files-added
+ (`ls-files-added
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-c" "-s" "--"))
- (ls-files-up-to-date
+ (`ls-files-up-to-date
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-c" "-s" "--"))
- (ls-files-unknown
+ (`ls-files-unknown
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-o" "--directory"
"--no-empty-directory" "--exclude-standard" "--"))
- (ls-files-ignored
+ (`ls-files-ignored
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-o" "-i" "--directory"
"--no-empty-directory" "--exclude-standard" "--"))
;; --relative added in Git 1.5.5.
- (diff-index
+ (`diff-index
(vc-git-command (current-buffer) 'async files
"diff-index" "--relative" "-z" "-M" "HEAD" "--")))
(vc-exec-after
`(vc-git-after-dir-status-stage ',stage ',files ',update-function)))
-(defun vc-git-dir-status (dir update-function)
+(defun vc-git-dir-status (_dir update-function)
"Return a list of (FILE STATE EXTRA) entries for DIR."
;; Further things that would have to be fixed later:
;; - how to handle unregistered directories
;; - how to support vc-dir on a subdir of the project tree
(vc-git-dir-status-goto-stage 'update-index nil update-function))
-(defun vc-git-dir-status-files (dir files default-state update-function)
+(defun vc-git-dir-status-files (_dir files _default-state update-function)
"Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
(vc-git-dir-status-goto-stage 'update-index files update-function))
@@ -499,7 +513,7 @@ or an empty string if none."
:help "Show the contents of the current stash"))
map))
-(defun vc-git-dir-extra-headers (dir)
+(defun vc-git-dir-extra-headers (_dir)
(let ((str (with-output-to-string
(with-current-buffer standard-output
(vc-git--out-ok "symbolic-ref" "HEAD"))))
@@ -560,7 +574,7 @@ or an empty string if none."
"Return the existing branches, as a list of strings.
The car of the list is the current branch."
(with-temp-buffer
- (call-process vc-git-program nil t nil "branch")
+ (vc-git--call t "branch")
(goto-char (point-min))
(let (current-branch branches)
(while (not (eobp))
@@ -577,7 +591,7 @@ The car of the list is the current branch."
"Create a new Git repository."
(vc-git-command nil 0 nil "init"))
-(defun vc-git-register (files &optional rev comment)
+(defun vc-git-register (files &optional _rev _comment)
"Register FILES into the git version-control system."
(let (flist dlist)
(dolist (crt files)
@@ -594,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-checkin (files rev comment)
+(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
@@ -622,7 +672,7 @@ The car of the list is the current branch."
nil
"cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname))))
-(defun vc-git-checkout (file &optional editable rev)
+(defun vc-git-checkout (file &optional _editable rev)
(vc-git-command nil 0 file "checkout" (or rev "HEAD")))
(defun vc-git-revert (file &optional contents-done)
@@ -632,6 +682,10 @@ The car of the list is the current branch."
(vc-git-command nil 0 file "reset" "-q" "--")
(vc-git-command nil nil file "checkout" "-q" "--")))
+(defvar vc-git-error-regexp-alist
+ '(("^ \\(.+\\) |" 1 nil nil 0))
+ "Value of `compilation-error-regexp-alist' in *vc-git* buffers.")
+
(defun vc-git-pull (prompt)
"Pull changes into the current Git branch.
Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
@@ -652,6 +706,7 @@ for the Git command to run."
command (cadr args)
args (cddr args)))
(apply 'vc-do-async-command buffer root git-program command args)
+ (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git)))
(vc-set-async-update buffer)))
(defun vc-git-merge-branch ()
@@ -671,6 +726,7 @@ This prompts for a branch to merge from."
nil t)))
(apply 'vc-do-async-command buffer root vc-git-program "merge"
(list merge-source))
+ (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git)))
(vc-set-async-update buffer)))
;;; HISTORY FUNCTIONS
@@ -752,7 +808,7 @@ for the --graph option."
(list (cons (nth 1 vc-git-root-log-format)
(nth 2 vc-git-root-log-format)))
(append
- `((,log-view-message-re (1 'change-log-acknowledgement)))
+ `((,log-view-message-re (1 'change-log-acknowledgment)))
;; Handle the case:
;; user: foo@bar
'(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
@@ -768,8 +824,8 @@ for the --graph option."
(1 'change-log-name)
(2 'change-log-email))
("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
- (1 'change-log-acknowledgement)
- (2 'change-log-acknowledgement))
+ (1 'change-log-acknowledgment)
+ (2 'change-log-acknowledgment))
("^Date: \\(.+\\)" (1 'change-log-date))
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
@@ -808,7 +864,7 @@ or BRANCH^ (where \"^\" can be repeated)."
(append (vc-switches 'git 'diff)
(list "-p" (or rev1 "HEAD") rev2 "--")))))
-(defun vc-git-revision-table (files)
+(defun vc-git-revision-table (_files)
;; What about `files'?!? --Stef
(let (process-file-side-effects
(table (list "HEAD")))
@@ -821,10 +877,8 @@ or BRANCH^ (where \"^\" can be repeated)."
table))
(defun vc-git-revision-completion-table (files)
- (lexical-let ((files files)
- table)
- (setq table (lazy-completion-table
- table (lambda () (vc-git-revision-table files))))
+ (letrec ((table (lazy-completion-table
+ table (lambda () (vc-git-revision-table files)))))
table))
(defun vc-git-annotate-command (file buf &optional rev)
@@ -863,7 +917,7 @@ or BRANCH^ (where \"^\" can be repeated)."
(vc-git-command nil 0 nil "checkout" "-b" name)
(vc-git-command nil 0 nil "tag" name)))))
-(defun vc-git-retrieve-tag (dir name update)
+(defun vc-git-retrieve-tag (dir name _update)
(let ((default-directory dir))
(vc-git-command nil 0 nil "checkout" name)
;; FIXME: update buffers if `update' is true
@@ -948,7 +1002,8 @@ or BRANCH^ (where \"^\" can be repeated)."
(defun vc-git-extra-status-menu () vc-git-extra-menu-map)
(defun vc-git-root (file)
- (vc-find-root file ".git"))
+ (or (vc-file-getprop file 'git-root)
+ (vc-file-setprop file 'git-root (vc-find-root file ".git"))))
;; Derived from `lgrep'.
(defun vc-git-grep (regexp &optional files dir)
@@ -1103,8 +1158,11 @@ The difference to vc-do-command is that this function always invokes
(defun vc-git--call (buffer command &rest args)
;; We don't need to care the arguments. If there is a file name, it
;; is always a relative one. This works also for remote
- ;; directories.
- (apply 'process-file vc-git-program nil buffer nil command args))
+ ;; directories. We enable `inhibit-null-byte-detection', otherwise
+ ;; Tramp's eol conversion might be confused.
+ (let ((inhibit-null-byte-detection t)
+ (process-environment (cons "PAGER=" process-environment)))
+ (apply 'process-file vc-git-program nil buffer nil command args)))
(defun vc-git--out-ok (command &rest args)
(zerop (apply 'vc-git--call '(t nil) command args)))
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 7b90536a31b..727fb08e388 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1,8 +1,9 @@
-;;; vc-hg.el --- VC backend for the mercurial version control system
+;;; vc-hg.el --- VC backend for the mercurial version control system -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Ivan Kanis
+;; Maintainer: FSF
;; Keywords: vc tools
;; Package: vc
@@ -110,19 +111,24 @@
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'vc)
(require 'vc-dir))
;;; Customization options
+(defgroup vc-hg nil
+ "VC Mercurial (hg) backend."
+ :version "24.1"
+ :group 'vc)
+
(defcustom vc-hg-global-switches nil
"Global switches to pass to any Hg command."
:type '(choice (const :tag "None" nil)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "22.2"
- :group 'vc)
+ :group 'vc-hg)
(defcustom vc-hg-diff-switches t ; Hg doesn't support common args like -u
"String or list of strings specifying switches for Hg diff under VC.
@@ -132,12 +138,12 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "23.1"
- :group 'vc)
+ :group 'vc-hg)
(defcustom vc-hg-program "hg"
"Name of the Mercurial executable (excluding any arguments)."
:type 'string
- :group 'vc)
+ :group 'vc-hg)
(defcustom vc-hg-root-log-format
'("{rev}:{tags}: {author|person} {date|shortdate} {desc|firstline}\\n"
@@ -153,7 +159,7 @@ REGEXP is a regular expression matching the resulting Mercurial
output, and KEYWORDS is a list of `font-lock-keywords' for
highlighting the Log View buffer."
:type '(list string string (repeat sexp))
- :group 'vc
+ :group 'vc-hg
:version "24.1")
@@ -162,7 +168,7 @@ highlighting the Log View buffer."
(defvar vc-hg-history nil)
(defun vc-hg-revision-granularity () 'repository)
-(defun vc-hg-checkout-model (files) 'implicit)
+(defun vc-hg-checkout-model (_files) 'implicit)
;;; State querying functions
@@ -221,45 +227,14 @@ highlighting the Log View buffer."
(defun vc-hg-working-revision (file)
"Hg-specific version of `vc-working-revision'."
- (let*
- ((status nil)
- (default-directory (file-name-directory file))
- ;; Avoid localization of messages so we can parse the output.
- (avoid-local-env (append (list "TERM=dumb" "LANGUAGE=C")
- process-environment))
- (out
- (with-output-to-string
- (with-current-buffer
- standard-output
- (setq status
- (condition-case nil
- (let ((process-environment avoid-local-env))
- ;; Ignore all errors.
- (process-file
- vc-hg-program nil t nil
- "--config" "alias.parents=parents"
- "--config" "defaults.parents="
- "parents" "--template" "{rev}" (file-relative-name file)))
- ;; Some problem happened. E.g. We can't find an `hg'
- ;; executable.
- (error nil)))))))
- (if (eq 0 status)
- out
- ;; Check if the file is in the 'added state, the above hg
- ;; command does not distinguish between 'added and 'unregistered.
- (setq status
- (condition-case nil
- (let ((process-environment avoid-local-env))
- (process-file
- vc-hg-program nil nil nil
- ;; We use "log" here, if there's a faster command
- ;; that returns true for an 'added file and false
- ;; for an 'unregistered one, we could use that.
- "log" "-l1" (file-relative-name file)))
- ;; Some problem happened. E.g. We can't find an `hg'
- ;; executable.
- (error nil)))
- (when (eq 0 status) "0"))))
+ (let ((default-directory (if (file-directory-p file)
+ (file-name-as-directory file)
+ (file-name-directory file))))
+ (ignore-errors
+ (with-output-to-string
+ (process-file vc-hg-program nil standard-output nil
+ "log" "-l" "1" "--template" "{rev}"
+ (file-relative-name file))))))
;;; History functions
@@ -363,10 +338,8 @@ highlighting the Log View buffer."
;; Modeled after the similar function in vc-cvs.el
(defun vc-hg-revision-completion-table (files)
- (lexical-let ((files files)
- table)
- (setq table (lazy-completion-table
- table (lambda () (vc-hg-revision-table files))))
+ (letrec ((table (lazy-completion-table
+ table (lambda () (vc-hg-revision-table files)))))
table))
(defun vc-hg-annotate-command (file buffer &optional revision)
@@ -402,12 +375,12 @@ Optional arg REVISION is a revision to annotate from."
(expand-file-name (match-string-no-properties 4)
(vc-hg-root default-directory)))))))
-(defun vc-hg-previous-revision (file rev)
+(defun vc-hg-previous-revision (_file rev)
(let ((newrev (1- (string-to-number rev))))
(when (>= newrev 0)
(number-to-string newrev))))
-(defun vc-hg-next-revision (file rev)
+(defun vc-hg-next-revision (_file rev)
(let ((newrev (1+ (string-to-number rev)))
(tip-revision
(with-temp-buffer
@@ -433,7 +406,7 @@ Optional arg REVISION is a revision to annotate from."
"Rename file from OLD to NEW using `hg mv'."
(vc-hg-command nil 0 new "mv" old))
-(defun vc-hg-register (files &optional rev comment)
+(defun vc-hg-register (files &optional _rev _comment)
"Register FILES under hg.
REV is ignored.
COMMENT is ignored."
@@ -463,7 +436,7 @@ COMMENT is ignored."
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-hg-checkin (files rev comment)
+(defun vc-hg-checkin (files _rev comment)
"Hg-specific version of `vc-backend-checkin'.
REV is ignored."
(apply 'vc-hg-command nil 0 files
@@ -480,7 +453,7 @@ REV is ignored."
(vc-hg-command buffer 0 file "cat"))))
;; Modeled after the similar function in vc-bzr.el
-(defun vc-hg-checkout (file &optional editable rev)
+(defun vc-hg-checkout (file &optional _editable rev)
"Retrieve a revision of FILE.
EDITABLE is ignored.
REV is the revision to check out into WORKFILE."
@@ -512,7 +485,7 @@ REV is the revision to check out into WORKFILE."
(defvar log-view-vc-backend)
-(defstruct (vc-hg-extra-fileinfo
+(cl-defstruct (vc-hg-extra-fileinfo
(:copier nil)
(:constructor vc-hg-create-extra-fileinfo (rename-state extra-name))
(:conc-name vc-hg-extra-fileinfo->))
@@ -528,16 +501,15 @@ REV is the revision to check out into WORKFILE."
(when extra
(insert (propertize
(format " (%s %s)"
- (case (vc-hg-extra-fileinfo->rename-state extra)
- (copied "copied from")
- (renamed-from "renamed from")
- (renamed-to "renamed to"))
+ (pcase (vc-hg-extra-fileinfo->rename-state extra)
+ (`copied "copied from")
+ (`renamed-from "renamed from")
+ (`renamed-to "renamed to"))
(vc-hg-extra-fileinfo->extra-name extra))
'face 'font-lock-comment-face)))))
(defun vc-hg-after-dir-status (update-function)
- (let ((status-char nil)
- (file nil)
+ (let ((file nil)
(translation '((?= . up-to-date)
(?C . up-to-date)
(?A . added)
@@ -592,7 +564,7 @@ REV is the revision to check out into WORKFILE."
(vc-exec-after
`(vc-hg-after-dir-status (quote ,update-function))))
-(defun vc-hg-dir-status-files (dir files default-state update-function)
+(defun vc-hg-dir-status-files (dir files _default-state update-function)
(apply 'vc-hg-command (current-buffer) 'async dir "status" "-C" files)
(vc-exec-after
`(vc-hg-after-dir-status (quote ,update-function))))
@@ -639,6 +611,14 @@ REV is the revision to check out into WORKFILE."
(mapcar (lambda (arg) (list "-r" arg)) marked-list)))
(error "No log entries selected for push"))))
+(defvar vc-hg-error-regexp-alist nil
+ ;; 'hg pull' does not list modified files, so, for now, the only
+ ;; benefit of `vc-compilation-mode' is that one can get rid of
+ ;; *vc-hg* buffer with 'q' or 'z'.
+ ;; TODO: call 'hg incoming' before pull/merge to get the list of
+ ;; modified files
+ "Value of `compilation-error-regexp-alist' in *vc-hg* buffers.")
+
(defun vc-hg-pull (prompt)
"Issue a Mercurial pull command.
If called interactively with a set of marked Log View buffers,
@@ -679,6 +659,7 @@ then attempts to update the working directory."
args (cddr args)))
(apply 'vc-do-async-command buffer root hg-program
command args)
+ (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))))
(defun vc-hg-merge-branch ()
@@ -687,6 +668,7 @@ This runs the command \"hg merge\"."
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root))))
(apply 'vc-do-async-command buffer root vc-hg-program '("merge"))
+ (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))
;;; Internal functions
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index c9e30772318..07a292ae435 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -1,6 +1,6 @@
;;; vc-hooks.el --- resident support for version-control
-;; Copyright (C) 1992-1996, 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
@@ -30,23 +30,10 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
;; 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
@@ -102,7 +89,7 @@ visited and a warning displayed."
:group 'vc)
(defcustom vc-display-status t
- "If non-nil, display revision number and lock status in modeline.
+ "If non-nil, display revision number and lock status in mode line.
Otherwise, not displayed."
:type 'boolean
:group 'vc)
@@ -237,6 +224,8 @@ VC commands are globally reachable under the prefix `\\[vc-prefix-map]':
(defun vc-file-clearprops (file)
"Clear all VC properties of FILE."
+ (if (boundp 'vc-parent-buffer)
+ (kill-local-variable 'vc-parent-buffer))
(setplist (intern file vc-file-prop-obarray) nil))
@@ -311,7 +300,7 @@ non-nil if FILE exists and its contents were successfully inserted."
(let ((filepos 0))
(while
(and (< 0 (cadr (insert-file-contents
- file nil filepos (incf filepos blocksize))))
+ file nil filepos (cl-incf filepos blocksize))))
(progn (beginning-of-line)
(let ((pos (re-search-forward limit nil 'move)))
(when pos (delete-region (match-beginning 0)
@@ -561,7 +550,7 @@ Return non-nil if FILE is unchanged."
(if (or (not (eq (cadr err)
(indirect-function
(vc-find-backend-function backend 'diff))))
- (not (eq (caddr err) 4)))
+ (not (eq (cl-caddr err) 4)))
(signal (car err) (cdr err))
(vc-call-backend backend 'diff (list file)))))))
@@ -587,16 +576,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)
@@ -704,6 +684,8 @@ Before doing that, check if there are any old backups and get rid of them."
(let ((file buffer-file-name)
backend)
(ignore-errors ;Be careful not to prevent saving the file.
+ (unless (file-exists-p file)
+ (vc-file-clearprops file))
(and (setq backend (vc-backend file))
(vc-up-to-date-p file)
(eq (vc-checkout-model backend (list file)) 'implicit)
@@ -790,7 +772,7 @@ If BACKEND is passed use it as the VC backend when computing the result."
backend)
(defun vc-default-mode-line-string (backend file)
- "Return string for placement in modeline by `vc-mode-line' for FILE.
+ "Return a string for `vc-mode-line' to put in the mode line for FILE.
Format:
\"BACKEND-REV\" if the file is up-to-date
@@ -866,7 +848,7 @@ current, and kill the buffer that visits the link."
(let (backend)
(cond
((setq backend (with-demoted-errors (vc-backend buffer-file-name)))
- ;; Compute the state and put it in the modeline.
+ ;; Compute the state and put it in the mode line.
(vc-mode-line buffer-file-name backend)
(unless vc-make-backup-files
;; Use this variable, not make-backup-files,
@@ -941,72 +923,72 @@ current, and kill the buffer that visits the link."
(define-key map "~" 'vc-revision-other-window)
map))
(fset 'vc-prefix-map vc-prefix-map)
-(define-key global-map "\C-xv" 'vc-prefix-map)
+(define-key ctl-x-map "v" 'vc-prefix-map)
(defvar vc-menu-map
(let ((map (make-sparse-keymap "Version Control")))
;;(define-key map [show-files]
;; '("Show Files under VC" . (vc-directory t)))
- (define-key map [vc-retrieve-tag]
- `(menu-item ,(purecopy "Retrieve Tag") vc-retrieve-tag
- :help ,(purecopy "Retrieve tagged version or branch")))
- (define-key map [vc-create-tag]
- `(menu-item ,(purecopy "Create Tag") vc-create-tag
- :help ,(purecopy "Create version tag")))
- (define-key map [separator1] menu-bar-separator)
- (define-key map [vc-annotate]
- `(menu-item ,(purecopy "Annotate") vc-annotate
- :help ,(purecopy "Display the edit history of the current file using colors")))
- (define-key map [vc-rename-file]
- `(menu-item ,(purecopy "Rename File") vc-rename-file
- :help ,(purecopy "Rename file")))
- (define-key map [vc-revision-other-window]
- `(menu-item ,(purecopy "Show Other Version") vc-revision-other-window
- :help ,(purecopy "Visit another version of the current file in another window")))
- (define-key map [vc-diff]
- `(menu-item ,(purecopy "Compare with Base Version") vc-diff
- :help ,(purecopy "Compare file set with the base version")))
- (define-key map [vc-root-diff]
- `(menu-item ,(purecopy "Compare Tree with Base Version") vc-root-diff
- :help ,(purecopy "Compare current tree with the base version")))
- (define-key map [vc-update-change-log]
- `(menu-item ,(purecopy "Update ChangeLog") vc-update-change-log
- :help ,(purecopy "Find change log file and add entries from recent version control logs")))
- (define-key map [vc-log-out]
- `(menu-item ,(purecopy "Show Outgoing Log") vc-log-outgoing
- :help ,(purecopy "Show a log of changes that will be sent with a push operation")))
- (define-key map [vc-log-in]
- `(menu-item ,(purecopy "Show Incoming Log") vc-log-incoming
- :help ,(purecopy "Show a log of changes that will be received with a pull operation")))
- (define-key map [vc-print-log]
- `(menu-item ,(purecopy "Show History") vc-print-log
- :help ,(purecopy "List the change log of the current file set in a window")))
- (define-key map [vc-print-root-log]
- `(menu-item ,(purecopy "Show Top of the Tree History ") vc-print-root-log
- :help ,(purecopy "List the change log for the current tree in a window")))
- (define-key map [separator2] menu-bar-separator)
- (define-key map [vc-insert-header]
- `(menu-item ,(purecopy "Insert Header") vc-insert-headers
- :help ,(purecopy "Insert headers into a file for use with a version control system.
-")))
- (define-key map [undo]
- `(menu-item ,(purecopy "Undo Last Check-In") vc-rollback
- :help ,(purecopy "Remove the most recent changeset committed to the repository")))
- (define-key map [vc-revert]
- `(menu-item ,(purecopy "Revert to Base Version") vc-revert
- :help ,(purecopy "Revert working copies of the selected file set to their repository contents")))
- (define-key map [vc-update]
- `(menu-item ,(purecopy "Update to Latest Version") vc-update
- :help ,(purecopy "Update the current fileset's files to their tip revisions")))
- (define-key map [vc-next-action]
- `(menu-item ,(purecopy "Check In/Out") vc-next-action
- :help ,(purecopy "Do the next logical version control operation on the current fileset")))
- (define-key map [vc-register]
- `(menu-item ,(purecopy "Register") vc-register
- :help ,(purecopy "Register file set into a version control system")))
- (define-key map [vc-dir]
- `(menu-item ,(purecopy "VC Dir") vc-dir
- :help ,(purecopy "Show the VC status of files in a directory")))
+ (bindings--define-key map [vc-retrieve-tag]
+ '(menu-item "Retrieve Tag" vc-retrieve-tag
+ :help "Retrieve tagged version or branch"))
+ (bindings--define-key map [vc-create-tag]
+ '(menu-item "Create Tag" vc-create-tag
+ :help "Create version tag"))
+ (bindings--define-key map [separator1] menu-bar-separator)
+ (bindings--define-key map [vc-annotate]
+ '(menu-item "Annotate" vc-annotate
+ :help "Display the edit history of the current file using colors"))
+ (bindings--define-key map [vc-rename-file]
+ '(menu-item "Rename File" vc-rename-file
+ :help "Rename file"))
+ (bindings--define-key map [vc-revision-other-window]
+ '(menu-item "Show Other Version" vc-revision-other-window
+ :help "Visit another version of the current file in another window"))
+ (bindings--define-key map [vc-diff]
+ '(menu-item "Compare with Base Version" vc-diff
+ :help "Compare file set with the base version"))
+ (bindings--define-key map [vc-root-diff]
+ '(menu-item "Compare Tree with Base Version" vc-root-diff
+ :help "Compare current tree with the base version"))
+ (bindings--define-key map [vc-update-change-log]
+ '(menu-item "Update ChangeLog" vc-update-change-log
+ :help "Find change log file and add entries from recent version control logs"))
+ (bindings--define-key map [vc-log-out]
+ '(menu-item "Show Outgoing Log" vc-log-outgoing
+ :help "Show a log of changes that will be sent with a push operation"))
+ (bindings--define-key map [vc-log-in]
+ '(menu-item "Show Incoming Log" vc-log-incoming
+ :help "Show a log of changes that will be received with a pull operation"))
+ (bindings--define-key map [vc-print-log]
+ '(menu-item "Show History" vc-print-log
+ :help "List the change log of the current file set in a window"))
+ (bindings--define-key map [vc-print-root-log]
+ '(menu-item "Show Top of the Tree History " vc-print-root-log
+ :help "List the change log for the current tree in a window"))
+ (bindings--define-key map [separator2] menu-bar-separator)
+ (bindings--define-key map [vc-insert-header]
+ '(menu-item "Insert Header" vc-insert-headers
+ :help "Insert headers into a file for use with a version control system.
+"))
+ (bindings--define-key map [undo]
+ '(menu-item "Undo Last Check-In" vc-rollback
+ :help "Remove the most recent changeset committed to the repository"))
+ (bindings--define-key map [vc-revert]
+ '(menu-item "Revert to Base Version" vc-revert
+ :help "Revert working copies of the selected file set to their repository contents"))
+ (bindings--define-key map [vc-update]
+ '(menu-item "Update to Latest Version" vc-update
+ :help "Update the current fileset's files to their tip revisions"))
+ (bindings--define-key map [vc-next-action]
+ '(menu-item "Check In/Out" vc-next-action
+ :help "Do the next logical version control operation on the current fileset"))
+ (bindings--define-key map [vc-register]
+ '(menu-item "Register" vc-register
+ :help "Register file set into a version control system"))
+ (bindings--define-key map [vc-dir]
+ '(menu-item "VC Dir" vc-dir
+ :help "Show the VC status of files in a directory"))
map))
(defalias 'vc-menu-map vc-menu-map)
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index f49ad09b5d7..8429b2b213d 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -1,6 +1,6 @@
-;;; vc-mtn.el --- VC backend for Monotone
+;;; vc-mtn.el --- VC backend for Monotone -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: vc
@@ -32,7 +32,12 @@
;;; Code:
-(eval-when-compile (require 'cl) (require 'vc))
+(eval-when-compile (require 'vc))
+
+(defgroup vc-mtn nil
+ "VC Monotone (mtn) backend."
+ :version "24.1"
+ :group 'vc)
(defcustom vc-mtn-diff-switches t
"String or list of strings specifying switches for monotone diff under VC.
@@ -42,13 +47,13 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "23.1"
- :group 'vc)
+ :group 'vc-mtn)
(define-obsolete-variable-alias 'vc-mtn-command 'vc-mtn-program "23.1")
(defcustom vc-mtn-program "mtn"
"Name of the monotone executable."
:type 'string
- :group 'vc)
+ :group 'vc-mtn)
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
@@ -71,7 +76,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
;;;###autoload (vc-mtn-registered file))))
(defun vc-mtn-revision-granularity () 'repository)
-(defun vc-mtn-checkout-model (files) 'implicit)
+(defun vc-mtn-checkout-model (_files) 'implicit)
(defun vc-mtn-root (file)
(setq file (if (file-directory-p file)
@@ -153,22 +158,22 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
"Rewrite rules to shorten Mtn's revision names on the mode-line."
:type '(repeat (cons regexp string))
:version "22.2"
- :group 'vc)
+ :group 'vc-mtn)
(defun vc-mtn-mode-line-string (file)
- "Return string for placement in modeline by `vc-mode-line' for FILE."
+ "Return a string for `vc-mode-line' to put in the mode line for FILE."
(let ((branch (vc-mtn-workfile-branch file)))
(dolist (rule vc-mtn-mode-line-rewrite)
(if (string-match (car rule) branch)
(setq branch (replace-match (cdr rule) t nil branch))))
(format "Mtn%c%s"
- (case (vc-state file)
- ((up-to-date needs-update) ?-)
- (added ?@)
- (t ?:))
+ (pcase (vc-state file)
+ ((or `up-to-date `needs-update) ?-)
+ (`added ?@)
+ (_ ?:))
branch)))
-(defun vc-mtn-register (files &optional rev comment)
+(defun vc-mtn-register (files &optional _rev _comment)
(vc-mtn-command nil 0 files "add"))
(defun vc-mtn-responsible-p (file) (vc-mtn-root file))
@@ -176,7 +181,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-mtn-checkin (files rev comment)
+(defun vc-mtn-checkin (files _rev comment)
(apply 'vc-mtn-command nil 0 files
(nconc (list "commit" "-m")
(log-edit-extract-headers '(("Author" . "--author")
@@ -193,10 +198,10 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(unless contents-done
(vc-mtn-command nil 0 file "revert")))
-;; (defun vc-mtn-roolback (files)
+;; (defun vc-mtn-rollback (files)
;; )
-(defun vc-mtn-print-log (files buffer &optional shortlog start-revision limit)
+(defun vc-mtn-print-log (files buffer &optional _shortlog start-revision limit)
(apply 'vc-mtn-command buffer 0 files "log"
(append
(when start-revision (list "--from" (format "%s" start-revision)))
@@ -299,44 +304,48 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(push (match-string 0) ids))
ids)))
-(defun vc-mtn-revision-completion-table (files)
- ;; TODO: Implement completion for selectors
- ;; TODO: Implement completion for composite selectors.
- (lexical-let ((files files))
- ;; What about using `files'?!? --Stef
- (lambda (string pred action)
- (cond
- ;; "Tag" selectors.
- ((string-match "\\`t:" string)
+(defun vc-mtn-revision-completion-table (_files)
+ ;; What about using `files'?!? --Stef
+ (lambda (string pred action)
+ (cond
+ ;; Special chars for composite selectors.
+ ((string-match ".*[^\\]\\(\\\\\\\\\\)*[/|;(]" string)
+ (completion-table-with-context (substring string 0 (match-end 0))
+ (vc-mtn-revision-completion-table nil)
+ (substring string (match-end 0))
+ pred action))
+ ;; "Tag" selectors.
+ ((string-match "\\`t:" string)
+ (complete-with-action action
+ (mapcar (lambda (tag) (concat "t:" tag))
+ (vc-mtn-list-tags))
+ string pred))
+ ;; "Branch" or "Head" selectors.
+ ((string-match "\\`[hb]:" string)
+ (let ((prefix (match-string 0 string)))
(complete-with-action action
- (mapcar (lambda (tag) (concat "t:" tag))
- (vc-mtn-list-tags))
- string pred))
- ;; "Branch" selectors.
- ((string-match "\\`b:" string)
- (complete-with-action action
- (mapcar (lambda (tag) (concat "b:" tag))
- (vc-mtn-list-branches))
- string pred))
- ;; "Head" selectors. Not sure how they differ from "branch" selectors.
- ((string-match "\\`h:" string)
- (complete-with-action action
- (mapcar (lambda (tag) (concat "h:" tag))
+ (mapcar (lambda (tag) (concat prefix tag))
(vc-mtn-list-branches))
- string pred))
- ;; "ID" selectors.
- ((string-match "\\`i:" string)
- (complete-with-action action
- (mapcar (lambda (tag) (concat "i:" tag))
- (vc-mtn-list-revision-ids
- (substring string (match-end 0))))
- string pred))
- (t
- (complete-with-action action
- '("t:" "b:" "h:" "i:"
- ;; Completion not implemented for these.
- "a:" "c:" "d:" "e:" "l:")
- string pred))))))
+ string pred)))
+ ;; "ID" selectors.
+ ((string-match "\\`i:" string)
+ (complete-with-action action
+ (mapcar (lambda (tag) (concat "i:" tag))
+ (vc-mtn-list-revision-ids
+ (substring string (match-end 0))))
+ string pred))
+ (t
+ (complete-with-action action
+ '("t:" "b:" "h:" "i:"
+ ;; Completion not implemented for these.
+ "c:" "a:" "k:" "d:" "m:" "e:" "l:" "i:" "p:"
+ ;; These have no arg to complete.
+ "u:" "w:"
+ ;; Selector functions.
+ "difference(" "lca(" "max(" "ancestors("
+ "descendants(" "parents(" "children("
+ "pick(")
+ string pred)))))
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 39c583b8a0d..baaf0c3a926 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -1,6 +1,6 @@
;;; vc-rcs.el --- support for RCS version-control
-;; Copyright (C) 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
@@ -38,16 +38,21 @@
;;;
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'vc))
+(defgroup vc-rcs nil
+ "VC RCS backend."
+ :version "24.1"
+ :group 'vc)
+
(defcustom vc-rcs-release nil
"The release number of your RCS installation, as a string.
If nil, VC itself computes this value when it is first needed."
:type '(choice (const :tag "Auto" nil)
(string :tag "Specified")
(const :tag "Unknown" unknown))
- :group 'vc)
+ :group 'vc-rcs)
(defcustom vc-rcs-register-switches nil
"Switches for registering a file in RCS.
@@ -59,7 +64,7 @@ If t, use no switches."
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "21.1"
- :group 'vc)
+ :group 'vc-rcs)
(defcustom vc-rcs-diff-switches nil
"String or list of strings specifying switches for RCS diff under VC.
@@ -69,21 +74,24 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "21.1"
- :group 'vc)
+ :group 'vc-rcs)
(defcustom vc-rcs-header '("\$Id\$")
"Header keywords to be inserted by `vc-insert-headers'."
:type '(repeat string)
:version "24.1" ; no longer consult the obsolete vc-header-alist
- :group 'vc)
+ :group 'vc-rcs)
(defcustom vc-rcsdiff-knows-brief nil
"Indicates whether rcsdiff understands the --brief option.
The value is either `yes', `no', or nil. If it is nil, VC tries
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)
+ :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"))
@@ -95,7 +103,7 @@ For a description of possible values, see `vc-check-master-templates'."
(choice string
function)))
:version "21.1"
- :group 'vc)
+ :group 'vc-rcs)
;;; Properties of the backend
@@ -674,9 +682,9 @@ Optional arg REVISION is a revision to annotate from."
;; Apply reverse-chronological edits on the trunk, computing and
;; accumulating forward-chronological edits after some point, for
;; later.
- (flet ((r/d/a () (vector pre
- (cdr (assq 'date meta))
- (cdr (assq 'author meta)))))
+ (cl-flet ((r/d/a () (vector pre
+ (cdr (assq 'date meta))
+ (cdr (assq 'author meta)))))
(while (when (setq pre cur cur (cdr (assq 'next meta)))
(not (string= "" cur)))
(setq
@@ -700,17 +708,17 @@ Optional arg REVISION is a revision to annotate from."
(goto-char (point-min))
(forward-line (1- (pop insn)))
(setq p (point))
- (case (pop insn)
- (k (setq s (buffer-substring-no-properties
- p (progn (forward-line (car insn))
- (point))))
- (when prda
- (push `(,p . ,(propertize s :vc-rcs-r/d/a prda)) path))
- (delete-region p (point)))
- (i (setq s (car insn))
- (when prda
- (push `(,p . ,(length s)) path))
- (insert s)))))
+ (pcase (pop insn)
+ (`k (setq s (buffer-substring-no-properties
+ p (progn (forward-line (car insn))
+ (point))))
+ (when prda
+ (push `(,p . ,(propertize s :vc-rcs-r/d/a prda)) path))
+ (delete-region p (point)))
+ (`i (setq s (car insn))
+ (when prda
+ (push `(,p . ,(length s)) path))
+ (insert s)))))
;; For the initial revision, setting `:vc-rcs-r/d/a' directly is
;; equivalent to pushing an insert instruction (of the entire buffer
;; contents) onto `path' then erasing the buffer, but less wasteful.
@@ -732,14 +740,14 @@ Optional arg REVISION is a revision to annotate from."
(dolist (insn (cdr (assq :insn meta)))
(goto-char (point-min))
(forward-line (1- (pop insn)))
- (case (pop insn)
- (k (delete-region
- (point) (progn (forward-line (car insn))
- (point))))
- (i (insert (propertize
- (car insn)
- :vc-rcs-r/d/a
- (or prda (setq prda (r/d/a))))))))
+ (pcase (pop insn)
+ (`k (delete-region
+ (point) (progn (forward-line (car insn))
+ (point))))
+ (`i (insert (propertize
+ (car insn)
+ :vc-rcs-r/d/a
+ (or prda (setq prda (r/d/a))))))))
(prog1 (not (string= (if nbls (caar nbls) revision) pre))
(setq pre (cdr (assq 'next meta)))))))))
;; Lastly, for each line, insert at bol nicely-formatted history info.
@@ -764,16 +772,16 @@ Optional arg REVISION is a revision to annotate from."
ht)
(setq maxw (max w maxw))))
(let ((padding (make-string maxw 32)))
- (flet ((pad (w) (substring-no-properties padding w))
- (render (rda &rest ls)
- (propertize
- (apply 'concat
- (format-time-string "%Y-%m-%d" (aref rda 1))
- " "
- (aref rda 0)
- ls)
- :vc-annotate-prefix t
- :vc-rcs-r/d/a rda)))
+ (cl-flet ((pad (w) (substring-no-properties padding w))
+ (render (rda &rest ls)
+ (propertize
+ (apply 'concat
+ (format-time-string "%Y-%m-%d" (aref rda 1))
+ " "
+ (aref rda 0)
+ ls)
+ :vc-annotate-prefix t
+ :vc-rcs-r/d/a rda)))
(maphash
(if all-me
(lambda (rda w)
@@ -809,9 +817,9 @@ systime, or nil if there is none. Also, reposition point."
;;; Tag system
;;;
-(defun vc-rcs-create-tag (backend dir name branchp)
+(defun vc-rcs-create-tag (dir name branchp)
(when branchp
- (error "RCS backend %s does not support module branches" backend))
+ (error "RCS backend does not support module branches"))
(let ((result (vc-tag-precondition dir)))
(if (stringp result)
(error "File %s is not up-to-date" result)
@@ -863,6 +871,23 @@ and CVS."
(minor-num (string-to-number (vc-rcs-minor-part rev))))
(concat branch "." (number-to-string (1+ minor-num))))))
+;; Note that most GNU/Linux distributions seem to supply rcs2log in a
+;; standard bin directory. Eg both Red Hat and Debian include it in
+;; their cvs packages. It's not obvious why Emacs still needs to
+;; provide it as well...
+(defvar vc-rcs-rcs2log-program
+ (let (exe)
+ (cond ((file-executable-p
+ (setq exe (expand-file-name "rcs2log" exec-directory)))
+ exe)
+ ;; In the unlikely event that someone is running an
+ ;; uninstalled Emacs and wants to do something RCS-related.
+ ((file-executable-p
+ (setq exe (expand-file-name "lib-src/rcs2log" source-directory)))
+ exe)
+ (t "rcs2log")))
+ "Path to the `rcs2log' program (normally in `exec-directory').")
+
(defun vc-rcs-update-changelog (files)
"Default implementation of update-changelog.
Uses `rcs2log' which only works for RCS and CVS."
@@ -893,9 +918,7 @@ Uses `rcs2log' which only works for RCS and CVS."
(unwind-protect
(progn
(setq default-directory odefault)
- (if (eq 0 (apply 'call-process
- (expand-file-name "rcs2log"
- exec-directory)
+ (if (eq 0 (apply 'call-process vc-rcs-rcs2log-program
nil (list t tempfile) nil
"-c" changelog
"-u" (concat login-name
@@ -1286,50 +1309,51 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
;; to "de-@@-format" the printed representation as the first step
;; to translating it into some value. See internal func `gather'.
@-holes)
- (flet ((sw () (skip-chars-forward " \t\n")) ; i.e., `[:space:]'
- (at (tag) (save-excursion (eq tag (read buffer))))
- (to-eol () (buffer-substring-no-properties
- (point) (progn (forward-line 1)
- (1- (point)))))
- (to-semi () (setq b (point)
- e (progn (search-forward ";")
- (1- (point)))))
- (to-one@ () (setq @-holes nil
- b (progn (search-forward "@") (point))
- e (progn (while (and (search-forward "@")
- (= ?@ (char-after))
- (progn
- (push (point) @-holes)
- (forward-char 1)
- (push (point) @-holes))))
- (1- (point)))))
- (tok+val (set-b+e name &optional proc)
- (unless (eq name (setq tok (read buffer)))
- (error "Missing `%s' while parsing %s" name context))
- (sw)
- (funcall set-b+e)
- (cons tok (if proc
- (funcall proc)
- (buffer-substring-no-properties b e))))
- (k-semi (name &optional proc) (tok+val 'to-semi name proc))
- (gather () (let ((pairs `(,e ,@@-holes ,b))
- acc)
- (while pairs
- (push (buffer-substring-no-properties
- (cadr pairs) (car pairs))
- acc)
- (setq pairs (cddr pairs)))
- (apply 'concat acc)))
- (k-one@ (name &optional later) (tok+val 'to-one@ name
- (if later
- (lambda () t)
- 'gather))))
+ (cl-flet*
+ ((sw () (skip-chars-forward " \t\n")) ; i.e., `[:space:]'
+ (at (tag) (save-excursion (eq tag (read buffer))))
+ (to-eol () (buffer-substring-no-properties
+ (point) (progn (forward-line 1)
+ (1- (point)))))
+ (to-semi () (setq b (point)
+ e (progn (search-forward ";")
+ (1- (point)))))
+ (to-one@ () (setq @-holes nil
+ b (progn (search-forward "@") (point))
+ e (progn (while (and (search-forward "@")
+ (= ?@ (char-after))
+ (progn
+ (push (point) @-holes)
+ (forward-char 1)
+ (push (point) @-holes))))
+ (1- (point)))))
+ (tok+val (set-b+e name &optional proc)
+ (unless (eq name (setq tok (read buffer)))
+ (error "Missing `%s' while parsing %s" name context))
+ (sw)
+ (funcall set-b+e)
+ (cons tok (if proc
+ (funcall proc)
+ (buffer-substring-no-properties b e))))
+ (k-semi (name &optional proc) (tok+val #'to-semi name proc))
+ (gather () (let ((pairs `(,e ,@@-holes ,b))
+ acc)
+ (while pairs
+ (push (buffer-substring-no-properties
+ (cadr pairs) (car pairs))
+ acc)
+ (setq pairs (cddr pairs)))
+ (apply 'concat acc)))
+ (k-one@ (name &optional later) (tok+val #'to-one@ name
+ (if later
+ (lambda () t)
+ #'gather))))
(save-excursion
(goto-char (point-min))
;; headers
(setq context 'headers)
- (flet ((hpush (name &optional proc)
- (push (k-semi name proc) headers)))
+ (cl-flet ((hpush (name &optional proc)
+ (push (k-semi name proc) headers)))
(hpush 'head)
(when (at 'branch)
(hpush 'branch))
@@ -1371,7 +1395,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
(when (< (car ls) 100)
(setcar ls (+ 1900 (car ls))))
(apply 'encode-time (nreverse ls)))))
- ,@(mapcar 'k-semi '(author state))
+ ,@(mapcar #'k-semi '(author state))
,(k-semi 'branches
(lambda ()
(split-string
@@ -1401,16 +1425,17 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
;; only the former since it behaves identically to the
;; latter in the absence of "@@".)
sub)
- (flet ((incg (beg end) (let ((b beg) (e end) @-holes)
- (while (and asc (< (car asc) e))
- (push (pop asc) @-holes))
- ;; Self-deprecate when work is done.
- ;; Folding many dimensions into one.
- ;; Thanks B.Mandelbrot, for complex sum.
- ;; O beauteous math! --the Unvexed Bum
- (unless asc
- (setq sub 'buffer-substring-no-properties))
- (gather))))
+ (cl-flet ((incg (beg end)
+ (let ((b beg) (e end) @-holes)
+ (while (and asc (< (car asc) e))
+ (push (pop asc) @-holes))
+ ;; Self-deprecate when work is done.
+ ;; Folding many dimensions into one.
+ ;; Thanks B.Mandelbrot, for complex sum.
+ ;; O beauteous math! --the Unvexed Bum
+ (unless asc
+ (setq sub #'buffer-substring-no-properties))
+ (gather))))
(while (and (sw)
(not (eobp))
(setq context (to-eol)
@@ -1429,8 +1454,8 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
(setcdr (cadr rev) (gather))
(if @-holes
(setq asc (nreverse @-holes)
- sub 'incg)
- (setq sub 'buffer-substring-no-properties))
+ sub #'incg)
+ (setq sub #'buffer-substring-no-properties))
(goto-char b)
(setq acc nil)
(while (< (point) e)
@@ -1439,7 +1464,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
start (read (current-buffer))
act (read (current-buffer)))
(forward-char 1)
- (push (case cmd
+ (push (pcase cmd
(?d
;; `d' means "delete lines".
;; For Emacs spirit, we use `k' for "kill".
@@ -1453,7 +1478,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
`(,(1+ start) i
,(funcall sub (point) (progn (forward-line act)
(point)))))
- (t (error "Bad command `%c' in `text' for rev `%s'"
+ (_ (error "Bad command `%c' in `text' for rev `%s'"
cmd context)))
acc))
(goto-char (1+ e))
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index 0ee75e1c24a..c4f6fd10bdb 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -1,6 +1,6 @@
;;; vc-sccs.el --- support for SCCS version-control
-;; Copyright (C) 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
@@ -23,10 +23,6 @@
;;; Commentary:
-;; Proper function of the SCCS diff commands requires the shellscript vcdiff
-;; to be installed somewhere on Emacs's path for executables.
-;;
-
;;; Code:
(eval-when-compile
@@ -37,15 +33,18 @@
;;;
;; ;; Maybe a better solution is to not use "get" but "sccs get".
-;; (defcustom vc-sccs-path
-;; (let ((path ()))
-;; (dolist (dir '("/usr/sccs" "/usr/lib/sccs" "/usr/libexec/sccs"))
-;; (if (file-directory-p dir)
-;; (push dir path)))
-;; path)
-;; "List of extra directories to search for SCCS commands."
-;; :type '(repeat directory)
-;; :group 'vc)
+;; ;; Note for GNU CSSC, you can parse sccs -V to get the libexec path.
+;; (defcustom vc-sccs-path
+;; (prune-directory-list '("/usr/ccs/bin" "/usr/sccs" "/usr/lib/sccs"
+;; "/usr/libexec/sccs"))
+;; "List of extra directories to search for SCCS commands."
+;; :type '(repeat directory)
+;; :group 'vc)
+
+(defgroup vc-sccs nil
+ "VC SCCS backend."
+ :version "24.1"
+ :group 'vc)
(defcustom vc-sccs-register-switches nil
"Switches for registering a file in SCCS.
@@ -57,7 +56,7 @@ If t, use no switches."
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "21.1"
- :group 'vc)
+ :group 'vc-sccs)
(defcustom vc-sccs-diff-switches nil
"String or list of strings specifying switches for SCCS diff under VC.
@@ -67,14 +66,17 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "21.1"
- :group 'vc)
+ :group 'vc-sccs)
(defcustom vc-sccs-header '("%W%")
"Header keywords to be inserted by `vc-insert-headers'."
:type '(repeat string)
:version "24.1" ; no longer consult the obsolete vc-header-alist
- :group 'vc)
+ :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))
@@ -86,7 +88,7 @@ For a description of possible values, see `vc-check-master-templates'."
(choice string
function)))
:version "21.1"
- :group 'vc)
+ :group 'vc-sccs)
;;;
@@ -107,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."
@@ -181,11 +182,24 @@ For a description of possible values, see `vc-check-master-templates'."
(vc-insert-file (vc-name file) "^\001e\n\001[^s]")
(vc-parse-buffer "^\001d D \\([^ ]+\\)" 1)))
+;; Cf vc-sccs-find-revision.
+(defun vc-sccs-write-revision (file outfile &optional rev)
+ "Write the SCCS version of input file FILE to output file OUTFILE.
+Optional string REV is a revision."
+ (with-temp-buffer
+ (apply 'vc-sccs-do-command t 0 "get" (vc-name file)
+ (append '("-s" "-p" "-k") ; -k: no keyword expansion
+ (if rev (list (concat "-r" rev)))))
+ (write-region nil nil outfile nil 'silent)))
+
(defun vc-sccs-workfile-unchanged-p (file)
"SCCS-specific implementation of `vc-workfile-unchanged-p'."
- (zerop (apply 'vc-do-command "*vc*" 1 "vcdiff" (vc-name file)
- (list "--brief" "-q"
- (concat "-r" (vc-working-revision file))))))
+ (let ((tempfile (make-temp-file "vc-sccs")))
+ (unwind-protect
+ (progn
+ (vc-sccs-write-revision file tempfile (vc-working-revision file))
+ (zerop (vc-do-command "*vc*" 1 "cmp" file tempfile)))
+ (delete-file tempfile))))
;;;
@@ -341,17 +355,75 @@ revert all subfiles."
(vc-sccs-do-command buffer 0 "prs" (mapcar 'vc-name files))
(when limit 'limit-unsupported))
+;; FIXME use sccsdiff if present?
(defun vc-sccs-diff (files &optional oldvers newvers buffer)
"Get a difference report using SCCS between two filesets."
(setq files (vc-expand-dirs files))
(setq oldvers (vc-sccs-lookup-triple (car files) oldvers))
(setq newvers (vc-sccs-lookup-triple (car files) newvers))
- (apply 'vc-do-command (or buffer "*vc-diff*")
- 1 "vcdiff" (mapcar 'vc-name (vc-expand-dirs files))
- (append (list "-q"
- (and oldvers (concat "-r" oldvers))
- (and newvers (concat "-r" newvers)))
- (vc-switches 'SCCS 'diff))))
+ (or buffer (setq buffer "*vc-diff*"))
+ ;; We have to reimplement pieces of vc-do-command, because
+ ;; we want to run multiple external commands, and only do the setup
+ ;; and exit pieces once.
+ (save-current-buffer
+ (unless (or (eq buffer t)
+ (and (stringp buffer) (string= (buffer-name) buffer))
+ (eq buffer (current-buffer)))
+ (vc-setup-buffer buffer))
+ (let* ((fake-flags (append (vc-switches 'SCCS 'diff)
+ (if oldvers (list (concat " -r" oldvers)))
+ (if newvers (list (concat " -r" newvers)))))
+ (fake-command
+ (format "diff%s %s"
+ (if fake-flags
+ (concat " " (mapconcat 'identity fake-flags " "))
+ "")
+ (vc-delistify files)))
+ (status 0)
+ (oldproc (get-buffer-process (current-buffer))))
+ (when vc-command-messages
+ (message "Running %s in foreground..." fake-command))
+ (if oldproc (delete-process oldproc))
+ (dolist (file files)
+ (let ((oldfile (make-temp-file "vc-sccs"))
+ newfile)
+ (unwind-protect
+ (progn
+ (vc-sccs-write-revision file oldfile oldvers)
+ (if newvers
+ (vc-sccs-write-revision file (setq newfile
+ (make-temp-file "vc-sccs"))
+ newvers))
+ (let* ((inhibit-read-only t)
+ (buffer-undo-list t)
+ (process-environment
+ (cons "LC_MESSAGES=C" process-environment))
+ (w32-quote-process-args t)
+ (this-status
+ (apply 'process-file "diff" nil t nil
+ (append (vc-switches 'SCCS 'diff)
+ (list oldfile
+ (or newfile
+ (file-relative-name file)))))))
+ (or (integerp this-status) (setq status 'error))
+ (and (integerp status)
+ (> this-status status)
+ (setq status this-status))))
+ (delete-file oldfile)
+ (if newfile (delete-file newfile)))))
+ (when (or (not (integerp status)) (> status 1))
+ (unless (eq ?\s (aref (buffer-name (current-buffer)) 0))
+ (pop-to-buffer (current-buffer))
+ (goto-char (point-min))
+ (shrink-window-if-larger-than-buffer))
+ (error "Running %s...FAILED (%s)" fake-command
+ (if (integerp status) (format "status %d" status) status)))
+ (when vc-command-messages
+ (message "Running %s...OK = %d" fake-command status))
+ ;; Should we pretend we ran sccsdiff instead?
+ ;; This might not actually be a valid diff command.
+ (run-hook-with-args 'vc-post-command-functions "diff" files fake-flags)
+ status)))
;;;
@@ -359,9 +431,9 @@ revert all subfiles."
;;; our own set of name-to-revision mappings.
;;;
-(defun vc-sccs-create-tag (backend dir name branchp)
+(defun vc-sccs-create-tag (dir name branchp)
(when branchp
- (error "SCCS backend %s does not support module branches" backend))
+ (error "SCCS backend does not support module branches"))
(let ((result (vc-tag-precondition dir)))
(if (stringp result)
(error "File %s is not up-to-date" result)
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index d014c4da135..370cd0a9dca 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -1,6 +1,6 @@
;;; vc-svn.el --- non-resident support for Subversion version-control
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -39,11 +39,16 @@
;;; Customization options
;;;
+(defgroup vc-svn nil
+ "VC Subversion (svn) backend."
+ :version "24.1"
+ :group 'vc)
+
;; FIXME there is also svnadmin.
(defcustom vc-svn-program "svn"
"Name of the SVN executable."
:type 'string
- :group 'vc)
+ :group 'vc-svn)
(defcustom vc-svn-global-switches nil
"Global switches to pass to any SVN command."
@@ -53,7 +58,7 @@
:value ("")
string))
:version "22.1"
- :group 'vc)
+ :group 'vc-svn)
(defcustom vc-svn-register-switches nil
"Switches for registering a file into SVN.
@@ -65,7 +70,7 @@ If t, use no switches."
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "22.1"
- :group 'vc)
+ :group 'vc-svn)
(defcustom vc-svn-diff-switches
t ;`svn' doesn't support common args like -c or -b.
@@ -81,13 +86,13 @@ If you want to force an empty list of arguments, use t."
:value ("")
string))
:version "22.1"
- :group 'vc)
+ :group 'vc-svn)
(defcustom vc-svn-header '("\$Id\$")
"Header keywords to be inserted by `vc-insert-headers'."
:version "24.1" ; no longer consult the obsolete vc-header-alist
:type '(repeat string)
- :group 'vc)
+ :group 'vc-svn)
;; We want to autoload it for use by the autoloaded version of
;; vc-svn-registered, but we want the value to be compiled at startup, not
@@ -150,9 +155,24 @@ If you want to force an empty list of arguments, use t."
(vc-svn-command t 0 file "status" (if localp "-v" "-u"))
(vc-svn-parse-status file))))
+;; NB this does not handle svn properties, which can be changed
+;; without changing the file timestamp.
+;; Note that unlike vc-cvs-state-heuristic, this is not called from
+;; vc-svn-state. AFAICS, it is only called from vc-state-refresh via
+;; vc-after-save (bug#7850). Therefore the fact that it ignores
+;; properties is irrelevant. If you want to make vc-svn-state call
+;; this, it should be extended to handle svn properties.
(defun vc-svn-state-heuristic (file)
"SVN-specific state heuristic."
- (vc-svn-state file 'local))
+ ;; If the file has not changed since checkout, consider it `up-to-date'.
+ ;; Otherwise consider it `edited'. Copied from vc-cvs-state-heuristic.
+ (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
+ (lastmod (nth 5 (file-attributes file))))
+ (cond
+ ((equal checkout-time lastmod) 'up-to-date)
+ ((string= (vc-working-revision file) "0") 'added)
+ ((null checkout-time) 'unregistered)
+ (t 'edited))))
;; FIXME it would be better not to have the "remote" argument,
;; but to distinguish the two output formats based on content.
@@ -394,7 +414,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
;; We also used to match the filename in column 0 without any
;; meta-info before it, but I believe this can never happen.
(concat "^\\(\\([ACGDU]\\)\\(.[B ]\\)? \\)"
- (regexp-quote (file-name-nondirectory file)))
+ (regexp-quote (file-relative-name file)))
nil t)
(cond
;; Merge successful, we are in sync with repository now
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 87e8901e33a..a909aca5bca 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1,6 +1,6 @@
-;;; vc.el --- drive a version-control system from within Emacs
+;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1992-1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1998, 2000-2012 Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
@@ -653,10 +653,10 @@
(require 'vc-hooks)
(require 'vc-dispatcher)
-(require 'ediff)
+
+(declare-function diff-setup-whitespace "diff-mode" ())
(eval-when-compile
- (require 'cl)
(require 'dired))
(unless (assoc 'vc-parent-buffer minor-mode-alist)
@@ -667,7 +667,7 @@
;; General customization
(defgroup vc nil
- "Version-control system in Emacs."
+ "Emacs interface to version control systems."
:group 'tools)
(defcustom vc-initial-comment nil
@@ -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
@@ -847,7 +837,7 @@ been updated to their corresponding values."
(if (file-directory-p file)
(dolist (buffer (buffer-list))
(let ((fname (buffer-file-name buffer)))
- (when (and fname (vc-string-prefix-p file fname))
+ (when (and fname (string-prefix-p file fname))
(push fname flist))))
(push file flist)))
,form
@@ -900,7 +890,7 @@ use."
(lambda (arg)
(message "arg %s" arg)
(and (file-directory-p arg)
- (vc-string-prefix-p (expand-file-name arg) def-dir)))))))
+ (string-prefix-p (expand-file-name arg) def-dir)))))))
(let ((default-directory repo-dir))
(vc-call-backend bk 'create-repo))
(throw 'found bk))))
@@ -934,11 +924,13 @@ Within directories, only files already under version control are noticed."
(defvar vc-dir-backend)
(defvar log-view-vc-backend)
+(defvar log-edit-vc-backend)
(defvar diff-vc-backend)
(defun vc-deduce-backend ()
(cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend)
((derived-mode-p 'log-view-mode) log-view-vc-backend)
+ ((derived-mode-p 'log-edit-mode) log-edit-vc-backend)
((derived-mode-p 'diff-mode) diff-vc-backend)
;; Maybe we could even use comint-mode rather than shell-mode?
((derived-mode-p 'dired-mode 'shell-mode 'compilation-mode)
@@ -1073,7 +1065,7 @@ For old-style locking-based version control systems, like RCS:
(let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
(backend (car vc-fileset))
(files (nth 1 vc-fileset))
- (fileset-only-files (nth 2 vc-fileset))
+ ;; (fileset-only-files (nth 2 vc-fileset))
;; FIXME: We used to call `vc-recompute-state' here.
(state (nth 3 vc-fileset))
;; The backend should check that the checkout-model is consistent
@@ -1113,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
- (toggle-read-only -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)
@@ -1341,7 +1336,7 @@ After check-out, runs the normal hook `vc-checkout-hook'."
;; Maybe the backend is not installed ;-(
(when writable
(let ((buf (get-file-buffer file)))
- (when buf (with-current-buffer buf (toggle-read-only -1)))))
+ (when buf (with-current-buffer buf (read-only-mode -1)))))
(signal (car err) (cdr err))))
`((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit)
(not writable))
@@ -1408,34 +1403,32 @@ that the version control system supports this mode of operation.
Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(when vc-before-checkin-hook
(run-hooks 'vc-before-checkin-hook))
- (lexical-let
- ((backend backend))
- (vc-start-logentry
- files comment initial-contents
- "Enter a change comment."
- "*vc-log*"
- (lambda ()
- (vc-call-backend backend 'log-edit-mode))
- (lexical-let ((rev rev))
- (lambda (files comment)
- (message "Checking in %s..." (vc-delistify files))
- ;; "This log message intentionally left almost blank".
- ;; RCS 5.7 gripes about white-space-only comments too.
- (or (and comment (string-match "[^\t\n ]" comment))
- (setq comment "*** empty log message ***"))
- (with-vc-properties
- files
- ;; We used to change buffers to get local value of
- ;; vc-checkin-switches, but 'the' local buffer is
- ;; not a well-defined concept for filesets.
- (progn
- (vc-call-backend backend 'checkin files rev comment)
- (mapc 'vc-delete-automatic-version-backups files))
- `((vc-state . up-to-date)
- (vc-checkout-time . ,(nth 5 (file-attributes file)))
- (vc-working-revision . nil)))
- (message "Checking in %s...done" (vc-delistify files))))
- 'vc-checkin-hook)))
+ (vc-start-logentry
+ files comment initial-contents
+ "Enter a change comment."
+ "*vc-log*"
+ (lambda ()
+ (vc-call-backend backend 'log-edit-mode))
+ (lambda (files comment)
+ (message "Checking in %s..." (vc-delistify files))
+ ;; "This log message intentionally left almost blank".
+ ;; RCS 5.7 gripes about white-space-only comments too.
+ (or (and comment (string-match "[^\t\n ]" comment))
+ (setq comment "*** empty log message ***"))
+ (with-vc-properties
+ files
+ ;; We used to change buffers to get local value of
+ ;; vc-checkin-switches, but 'the' local buffer is
+ ;; not a well-defined concept for filesets.
+ (progn
+ (vc-call-backend backend 'checkin files rev comment)
+ (mapc 'vc-delete-automatic-version-backups files))
+ `((vc-state . up-to-date)
+ (vc-checkout-time . ,(nth 5 (file-attributes file)))
+ (vc-working-revision . nil)))
+ (message "Checking in %s...done" (vc-delistify files)))
+ 'vc-checkin-hook
+ backend))
;;; Additional entry points for examining version histories
@@ -1516,25 +1509,27 @@ 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
;; possibility of an empty output is for an async process.
(when (buffer-live-p buffer)
(let ((window (get-buffer-window buffer t))
- (emptyp (zerop (buffer-size buffer))))
+ (emptyp (zerop (buffer-size buffer))))
(with-current-buffer buffer
- (and messages emptyp
- (let ((inhibit-read-only t))
- (insert (cdr messages) ".\n")
- (message "%s" (cdr messages))))
- (goto-char (point-min))
- (when window
- (shrink-window-if-larger-than-buffer window)))
+ (and messages emptyp
+ (let ((inhibit-read-only t))
+ (insert (cdr messages) ".\n")
+ (message "%s" (cdr messages))))
+ (diff-setup-whitespace)
+ (goto-char (point-min))
+ (when window
+ (shrink-window-if-larger-than-buffer window)))
(when (and messages (not emptyp))
- (message "%sdone" (car messages))))))
+ (message "%sdone" (car messages))))))
(defvar vc-diff-added-files nil
"If non-nil, diff added files by comparing them to /dev/null.")
@@ -1589,21 +1584,21 @@ Return t if the buffer had changes, nil otherwise."
(let ((vc-disable-async-diff (not async)))
(vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer))
(set-buffer buffer)
+ (diff-mode)
+ (set (make-local-variable 'diff-vc-backend) (car vc-fileset))
+ (set (make-local-variable 'revert-buffer-function)
+ `(lambda (ignore-auto noconfirm)
+ (vc-diff-internal ,async ',vc-fileset ,rev1 ,rev2 ,verbose)))
+ ;; Make the *vc-diff* buffer read only, the diff-mode key
+ ;; bindings are nicer for read only buffers. pcl-cvs does the
+ ;; same thing.
+ (setq buffer-read-only t)
(if (and (zerop (buffer-size))
(not (get-buffer-process (current-buffer))))
;; Treat this case specially so as not to pop the buffer.
(progn
(message "%s" (cdr messages))
nil)
- (diff-mode)
- (set (make-local-variable 'diff-vc-backend) (car vc-fileset))
- (set (make-local-variable 'revert-buffer-function)
- `(lambda (ignore-auto noconfirm)
- (vc-diff-internal ,async ',vc-fileset ,rev1 ,rev2 ,verbose)))
- ;; Make the *vc-diff* buffer read only, the diff-mode key
- ;; bindings are nicer for read only buffers. pcl-cvs does the
- ;; same thing.
- (setq buffer-read-only t)
;; Display the buffer, but at the end because it can change point.
(pop-to-buffer (current-buffer))
;; The diff process may finish early, so call `vc-diff-finish'
@@ -1650,8 +1645,9 @@ Return t if the buffer had changes, nil otherwise."
(setq rev1-default (vc-working-revision first)))
;; if the file is not locked, use last and previous revisions as defaults
(t
- (setq rev1-default (vc-call-backend backend 'previous-revision first
- (vc-working-revision first)))
+ (setq rev1-default (ignore-errors ;If `previous-revision' doesn't work.
+ (vc-call-backend backend 'previous-revision first
+ (vc-working-revision first))))
(when (string= rev1-default "") (setq rev1-default nil))
(setq rev2-default (vc-working-revision first))))
;; construct argument list
@@ -1668,7 +1664,7 @@ Return t if the buffer had changes, nil otherwise."
(list files rev1 rev2))))
;;;###autoload
-(defun vc-version-diff (files rev1 rev2)
+(defun vc-version-diff (_files rev1 rev2)
"Report diffs between revisions of the fileset in the repository history."
(interactive (vc-diff-build-argument-list-internal))
;; All that was just so we could do argument completion!
@@ -1680,7 +1676,7 @@ Return t if the buffer had changes, nil otherwise."
(called-interactively-p 'interactive)))
;;;###autoload
-(defun vc-diff (historic &optional not-urgent)
+(defun vc-diff (&optional historic not-urgent)
"Display diffs between file revisions.
Normally this compares the currently selected fileset with their
working revisions. With a prefix argument HISTORIC, it reads two revision
@@ -1695,7 +1691,9 @@ saving the buffer."
(vc-diff-internal t (vc-deduce-fileset t) nil nil
(called-interactively-p 'interactive))))
-(declare-function ediff-vc-internal (rev1 rev2 &optional startup-hooks))
+(declare-function ediff-load-version-control "ediff" (&optional silent))
+(declare-function ediff-vc-internal "ediff-vers"
+ (rev1 rev2 &optional startup-hooks))
;;;###autoload
(defun vc-version-ediff (files rev1 rev2)
@@ -1716,7 +1714,8 @@ repository history using ediff."
;; FIXME We only support running ediff on one file for now.
;; We could spin off an ediff session per file in the file set.
((= (length files) 1)
- (ediff-load-version-control)
+ (require 'ediff)
+ (ediff-load-version-control) ; loads ediff-vers
(find-file (car files)) ;FIXME: find-file from Elisp is bad.
(ediff-vc-internal rev1 rev2 nil))
(t
@@ -1755,10 +1754,15 @@ saving the buffer."
(call-interactively 'vc-version-diff)
(when buffer-file-name (vc-buffer-sync not-urgent))
(let ((backend (vc-deduce-backend))
+ (default-directory default-directory)
rootdir working-revision)
- (unless backend
- (error "Buffer is not version controlled"))
- (setq rootdir (vc-call-backend backend 'root default-directory))
+ (if backend
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq rootdir (read-directory-name "Directory for VC root-diff: "))
+ (setq backend (vc-responsible-backend rootdir))
+ (if backend
+ (setq default-directory rootdir)
+ (error "Directory is not version controlled")))
(setq working-revision (vc-working-revision rootdir))
;; VC diff for the root directory produces output that is
;; relative to it. Bind default-directory to the root directory
@@ -1880,14 +1884,14 @@ The headers are reset to their non-expanded form."
"Enter a replacement change comment."
"*vc-log*"
(lambda () (vc-call-backend backend 'log-edit-mode))
- (lexical-let ((rev rev))
- (lambda (files comment)
- (vc-call-backend backend
- 'modify-change-comment files rev comment))))))
+ (lambda (files comment)
+ (vc-call-backend backend
+ 'modify-change-comment files rev comment)))))
;;;###autoload
(defun vc-merge ()
"Perform a version control merge operation.
+You must be visiting a version controlled file, or in a `vc-dir' buffer.
On a distributed version control system, this runs a \"merge\"
operation to incorporate changes from another branch onto the
current branch, prompting for an argument list.
@@ -1920,7 +1924,7 @@ changes from the current branch."
(setq first-revision
(vc-read-revision
(concat "Merge " file
- "from branch or revision "
+ " from branch or revision "
"(default news on current branch): ")
(list file)
backend))
@@ -1947,7 +1951,7 @@ changes from the current branch."
(error "Sorry, merging is not implemented for %s" backend)))))
-(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B)
+(defun vc-maybe-resolve-conflicts (file status &optional _name-A _name-B)
(vc-resynch-buffer file t (not (buffer-modified-p)))
(if (zerop status) (message "Merge successful")
(smerge-mode 1)
@@ -2072,22 +2076,20 @@ Not all VC backends support short logs!")
(when (and limit (not (eq 'limit-unsupported pl-return))
(not is-start-revision))
(goto-char (point-max))
- (lexical-let ((working-revision working-revision)
- (limit limit))
- (insert "\n")
- (insert-text-button "Show 2X entries"
- 'action (lambda (&rest ignore)
- (vc-print-log-internal
- log-view-vc-backend log-view-vc-fileset
- working-revision nil (* 2 limit)))
- 'help-echo "Show the log again, and double the number of log entries shown")
- (insert " ")
- (insert-text-button "Show unlimited entries"
- 'action (lambda (&rest ignore)
- (vc-print-log-internal
- log-view-vc-backend log-view-vc-fileset
- working-revision nil nil))
- 'help-echo "Show the log again, including all entries"))))
+ (insert "\n")
+ (insert-text-button "Show 2X entries"
+ 'action (lambda (&rest _ignore)
+ (vc-print-log-internal
+ log-view-vc-backend log-view-vc-fileset
+ working-revision nil (* 2 limit)))
+ 'help-echo "Show the log again, and double the number of log entries shown")
+ (insert " ")
+ (insert-text-button "Show unlimited entries"
+ 'action (lambda (&rest _ignore)
+ (vc-print-log-internal
+ log-view-vc-backend log-view-vc-fileset
+ working-revision nil nil))
+ 'help-echo "Show the log again, including all entries")))
(defun vc-print-log-internal (backend files working-revision
&optional is-start-revision limit)
@@ -2097,8 +2099,7 @@ Not all VC backends support short logs!")
(let ((dir-present nil)
(vc-short-log nil)
(buffer-name "*vc-change-log*")
- type
- pl-return)
+ type)
(dolist (file files)
(when (file-directory-p file)
(setq dir-present t)))
@@ -2107,25 +2108,20 @@ Not all VC backends support short logs!")
(memq 'directory vc-log-short-style)
(memq 'file vc-log-short-style)))))
(setq type (if vc-short-log 'short 'long))
- (lexical-let
- ((working-revision working-revision)
- (backend backend)
- (limit limit)
- (shortlog vc-short-log)
- (files files)
- (is-start-revision is-start-revision))
+ (let ((shortlog vc-short-log))
(vc-log-internal-common
backend buffer-name files type
- (lambda (bk buf type-arg files-arg)
- (vc-call-backend bk 'print-log files-arg buf
- shortlog (when is-start-revision working-revision) limit))
- (lambda (bk files-arg ret)
+ (lambda (bk buf _type-arg files-arg)
+ (vc-call-backend bk 'print-log files-arg buf shortlog
+ (when is-start-revision working-revision) limit))
+ (lambda (_bk _files-arg ret)
(vc-print-log-setup-buttons working-revision
is-start-revision limit ret))
(lambda (bk)
(vc-call-backend bk 'show-log-entry working-revision))
- (lambda (ignore-auto noconfirm)
- (vc-print-log-internal backend files working-revision is-start-revision limit))))))
+ (lambda (_ignore-auto _noconfirm)
+ (vc-print-log-internal backend files working-revision
+ is-start-revision limit))))))
(defvar vc-log-view-type nil
"Set this to differentiate the different types of logs.")
@@ -2163,20 +2159,12 @@ Not all VC backends support short logs!")
(defun vc-incoming-outgoing-internal (backend remote-location buffer-name type)
(vc-log-internal-common
backend buffer-name nil type
- (lexical-let
- ((remote-location remote-location))
- (lambda (bk buf type-arg files)
- (vc-call-backend bk type-arg buf remote-location)))
- (lambda (bk files-arg ret))
- (lambda (bk)
- (goto-char (point-min)))
- (lexical-let
- ((backend backend)
- (remote-location remote-location)
- (buffer-name buffer-name)
- (type type))
- (lambda (ignore-auto noconfirm)
- (vc-incoming-outgoing-internal backend remote-location buffer-name type)))))
+ (lambda (bk buf type-arg _files)
+ (vc-call-backend bk type-arg buf remote-location))
+ (lambda (_bk _files-arg _ret) nil)
+ (lambda (_bk) (goto-char (point-min)))
+ (lambda (_ignore-auto _noconfirm)
+ (vc-incoming-outgoing-internal backend remote-location buffer-name type))))
;;;###autoload
(defun vc-print-log (&optional working-revision limit)
@@ -2227,10 +2215,15 @@ When called interactively with a prefix argument, prompt for LIMIT."
(t
(list (when (> vc-log-show-limit 0) vc-log-show-limit)))))
(let ((backend (vc-deduce-backend))
+ (default-directory default-directory)
rootdir working-revision)
- (unless backend
- (error "Buffer is not version controlled"))
- (setq rootdir (vc-call-backend backend 'root default-directory))
+ (if backend
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq rootdir (read-directory-name "Directory for VC root-log: "))
+ (setq backend (vc-responsible-backend rootdir))
+ (if backend
+ (setq default-directory rootdir)
+ (error "Directory is not version controlled")))
(setq working-revision (vc-working-revision rootdir))
(vc-print-log-internal backend (list rootdir) working-revision nil limit)))
@@ -2241,11 +2234,11 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION.."
(interactive
(when current-prefix-arg
(list (read-string "Remote location (empty for default): "))))
- (let ((backend (vc-deduce-backend))
- rootdir working-revision)
+ (let ((backend (vc-deduce-backend)))
(unless backend
(error "Buffer is not version controlled"))
- (vc-incoming-outgoing-internal backend remote-location "*vc-incoming*" 'log-incoming)))
+ (vc-incoming-outgoing-internal backend remote-location "*vc-incoming*"
+ 'log-incoming)))
;;;###autoload
(defun vc-log-outgoing (&optional remote-location)
@@ -2254,11 +2247,11 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION."
(interactive
(when current-prefix-arg
(list (read-string "Remote location (empty for default): "))))
- (let ((backend (vc-deduce-backend))
- rootdir working-revision)
+ (let ((backend (vc-deduce-backend)))
(unless backend
(error "Buffer is not version controlled"))
- (vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*" 'log-outgoing)))
+ (vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*"
+ 'log-outgoing)))
;;;###autoload
(defun vc-revert ()
@@ -2301,7 +2294,7 @@ to the working revision (except for keyword expansion)."
(if (= nfiles 1) "" "s"))))))
(error "Revert canceled")))
(when diff-buffer
- (quit-windows-on diff-buffer t)))
+ (quit-windows-on diff-buffer)))
(dolist (file files)
(message "Reverting %s..." (vc-delistify files))
(vc-revert-file file)
@@ -2347,7 +2340,7 @@ depending on the underlying version-control system."
;; Display changes
(unless (yes-or-no-p "Discard these revisions? ")
(error "Rollback canceled"))
- (quit-windows-on "*vc-diff*" t)
+ (quit-windows-on "*vc-diff*")
;; Do the actual reversions
(message "Rolling back %s..." (vc-delistify files))
(with-vc-properties
@@ -2365,6 +2358,7 @@ depending on the underlying version-control system."
;;;###autoload
(defun vc-pull (&optional arg)
"Update the current fileset or branch.
+You must be visiting a version controlled file, or in a `vc-dir' buffer.
On a distributed version control system, this runs a \"pull\"
operation to update the current branch, prompting for an argument
list if required. Optional prefix ARG forces a prompt.
@@ -2682,23 +2676,23 @@ log entries should be gathered."
(when index
(substring rev 0 index))))
-(defun vc-default-responsible-p (backend file)
+(defun vc-default-responsible-p (_backend _file)
"Indicate whether BACKEND is responsible for FILE.
The default is to return nil always."
nil)
-(defun vc-default-could-register (backend file)
+(defun vc-default-could-register (_backend _file)
"Return non-nil if BACKEND could be used to register FILE.
The default implementation returns t for all files."
t)
-(defun vc-default-latest-on-branch-p (backend file)
+(defun vc-default-latest-on-branch-p (_backend _file)
"Return non-nil if FILE is the latest on its branch.
This default implementation always returns non-nil, which means that
editing non-current revisions is not supported by default."
t)
-(defun vc-default-init-revision (backend) vc-default-init-revision)
+(defun vc-default-init-revision (_backend) vc-default-init-revision)
(defun vc-default-find-revision (backend file rev buffer)
"Provide the new `find-revision' op based on the old `checkout' op.
@@ -2712,7 +2706,7 @@ to provide the `find-revision' operation instead."
(insert-file-contents-literally tmpfile)))
(delete-file tmpfile))))
-(defun vc-default-rename-file (backend old new)
+(defun vc-default-rename-file (_backend old new)
(condition-case nil
(add-name-to-file old new)
(error (rename-file old new)))
@@ -2724,11 +2718,11 @@ to provide the `find-revision' operation instead."
(declare-function log-edit-mode "log-edit" ())
-(defun vc-default-log-edit-mode (backend) (log-edit-mode))
+(defun vc-default-log-edit-mode (_backend) (log-edit-mode))
-(defun vc-default-log-view-mode (backend) (log-view-mode))
+(defun vc-default-log-view-mode (_backend) (log-view-mode))
-(defun vc-default-show-log-entry (backend rev)
+(defun vc-default-show-log-entry (_backend rev)
(with-no-warnings
(log-view-goto-rev rev)))
@@ -2794,7 +2788,7 @@ to provide the `find-revision' operation instead."
(defalias 'vc-default-revision-completion-table 'ignore)
(defalias 'vc-default-mark-resolved 'ignore)
-(defun vc-default-dir-status-files (backend dir files default-state update-function)
+(defun vc-default-dir-status-files (_backend _dir files default-state update-function)
(funcall update-function
(mapcar (lambda (file) (list file default-state)) files)))
@@ -2806,11 +2800,7 @@ to provide the `find-revision' operation instead."
;; These things should probably be generally available
-
-(defun vc-string-prefix-p (prefix string)
- (let ((lpref (length prefix)))
- (and (>= (length string) lpref)
- (eq t (compare-strings prefix nil nil string nil lpref)))))
+(define-obsolete-function-alias 'vc-string-prefix-p 'string-prefix-p "24.3")
(defun vc-file-tree-walk (dirname func &rest args)
"Walk recursively through DIRNAME.
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index b8673f2049f..a277abcad9b 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -1,6 +1,6 @@
;;; vcursor.el --- manipulate an alternative ("virtual") cursor
-;; Copyright (C) 1994, 1996, 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1996, 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Peter Stephenson <pws@ibmth.df.unipi.it>
;; Maintainer: FSF
@@ -656,12 +656,13 @@ another window. With LEAVE-W, use the current `vcursor-window'."
(or window-system
(display-color-p)
(overlay-put vcursor-overlay 'before-string vcursor-string))
- (overlay-put vcursor-overlay 'face 'vcursor))
+ (overlay-put vcursor-overlay 'face 'vcursor)
+ ;; 200 is purely an arbitrary "high" number. See bug#9663.
+ (overlay-put vcursor-overlay 'priority 200))
(or leave-w (vcursor-find-window nil t))
;; vcursor-window now contains the right buffer
(or (pos-visible-in-window-p pt vcursor-window)
- (set-window-point vcursor-window pt)))
- )
+ (set-window-point vcursor-window pt))))
(defun vcursor-insert (text)
"Insert TEXT, respecting `vcursor-interpret-input'."
@@ -813,6 +814,8 @@ out how much to copy."
(define-minor-mode vcursor-use-vcursor-map
"Toggle the state of the vcursor key map.
+With a prefix argument ARG, enable it if ARG is positive, and disable
+it otherwise. If called from Lisp, enable it if ARG is omitted or nil.
When on, the keys defined in it are mapped directly on top of the main
keymap, allowing you to move the vcursor with ordinary motion keys.
An indication \"!VC\" appears in the mode list. The effect is
@@ -878,6 +881,8 @@ ALL-FRAMES is also used to decide whether to split the window."
(vcursor-disable -1))))
)
+(declare-function compare-windows-skip-whitespace "compare-w" (start))
+
;; vcursor-compare-windows is copied from compare-w.el with only
;; minor modifications; these are too bound up with the function
;; to make it really useful to call compare-windows itself.
diff --git a/lisp/version.el b/lisp/version.el
index aa4e22469c5..1fb3828e15d 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -1,6 +1,6 @@
;;; version.el --- record version number of Emacs
-;; Copyright (C) 1985, 1992, 1994-1995, 1999-2011
+;; Copyright (C) 1985, 1992, 1994-1995, 1999-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -24,27 +24,32 @@
;;; Commentary:
-;; This file is loaded uncompiled when dumping Emacs.
-;; Doc-strings should adhere to the conventions of make-docfile.
-
;;; Code:
-(defconst emacs-major-version (progn (string-match "^[0-9]+" emacs-version) (string-to-number (match-string 0 emacs-version))) "\
-Major version number of this version of Emacs.
+(defconst emacs-major-version
+ (progn (string-match "^[0-9]+" emacs-version)
+ (string-to-number (match-string 0 emacs-version)))
+ "Major version number of this version of Emacs.
This variable first existed in version 19.23.")
-(defconst emacs-minor-version (progn (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version) (string-to-number (match-string 1 emacs-version))) "\
-Minor version number of this version of Emacs.
+(defconst emacs-minor-version
+ (progn (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version)
+ (string-to-number (match-string 1 emacs-version)))
+ "Minor version number of this version of Emacs.
This variable first existed in version 19.23.")
-(defconst emacs-build-time (current-time) "\
-Time at which Emacs was dumped out.")
+(defconst emacs-build-time (current-time)
+ "Time at which Emacs was dumped out.")
+
+(defconst emacs-build-system (system-name)
+ "Name of the system on which Emacs was built.")
-(defconst emacs-build-system (system-name) "\
-Name of the system on which Emacs was built.")
+(defvar motif-version-string)
+(defvar gtk-version-string)
+(defvar ns-version-string)
-(defun emacs-version (&optional here) "\
-Return string describing the version of Emacs that is running.
+(defun emacs-version (&optional here)
+ "Return string describing the version of Emacs that is running.
If optional argument HERE is non-nil, insert string at point.
Don't use this function in programs to choose actions according
to the system configuration; look at `system-configuration' instead."
@@ -79,14 +84,97 @@ to the system configuration; look at `system-configuration' instead."
;; We hope that this alias is easier for people to find.
(defalias 'version 'emacs-version)
+;; Set during dumping, this is a defvar so that it can be setq'd.
+(defvar emacs-bzr-version nil
+ "String giving the bzr revision from which this Emacs was built.
+The format is: [revno] revision_id, where revno may be absent.
+Value is nil if Emacs was not built from a bzr checkout, or if we could
+not determine the revision.")
+
+(defun emacs-bzr-version-dirstate (dir)
+ "Try to return as a string the bzr revision ID of directory DIR.
+This uses the dirstate file's parent revision entry.
+Returns nil if unable to find this information."
+ (let ((file (expand-file-name ".bzr/checkout/dirstate" dir)))
+ (when (file-readable-p file)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (and (looking-at "#bazaar dirstate flat format 3")
+ (forward-line 3)
+ (looking-at "[0-9]+\0\\([^\0\n]+\\)\0")
+ (match-string 1))))))
+
+(defun emacs-bzr-version-bzr (dir)
+ "Ask bzr itself for the version information for directory DIR."
+ ;; Comments on `bzr version-info':
+ ;; i) Unknown files also cause clean != 1.
+ ;; ii) It can be slow, contacting the upstream repo to get the
+ ;; branch nick if one is not set locally, even with a custom
+ ;; template that is not asking for the nick (as used here). You'd
+ ;; think the latter part would be trivial to fix:
+ ;; https://bugs.launchpad.net/bzr/+bug/882541/comments/3
+ ;; https://bugs.launchpad.net/bzr/+bug/629150
+ ;; You can set the nick locally with `bzr nick ...', which speeds
+ ;; things up enormously. `bzr revno' does not have this issue, but
+ ;; has no way to print the revision_id AFAICS.
+ (message "Waiting for bzr...")
+ (with-temp-buffer
+ (if (zerop
+ (call-process "bzr" nil '(t nil) nil "version-info"
+ "--custom"
+ "--template={revno} {revision_id} (clean = {clean})"
+ "dir"))
+ (buffer-string))))
+
+(defun emacs-bzr-get-version (&optional dir external)
+ "Try to return as a string the bzr revision of the Emacs sources.
+The format is: [revno] revision_id, where revno may be absent.
+Value is nil if the sources do not seem to be under bzr, or if we could
+not determine the revision. Note that this reports on the current state
+of the sources, which may not correspond to the running Emacs.
+
+Optional argument DIR is a directory to use instead of `source-directory'.
+Optional argument EXTERNAL non-nil means to maybe ask `bzr' itself,
+if the sources appear to be under bzr. If `force', always ask bzr.
+Otherwise only ask bzr if we cannot find any information ourselves."
+ (or dir (setq dir source-directory))
+ (when (file-directory-p (expand-file-name ".bzr/branch" dir))
+ (if (eq external 'force)
+ (emacs-bzr-version-bzr dir)
+ (let (file loc rev)
+ (cond ((file-readable-p
+ (setq file (expand-file-name ".bzr/branch/last-revision" dir)))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (goto-char (point-max))
+ (if (looking-back "\n")
+ (delete-char -1))
+ (buffer-string)))
+ ;; OK, no last-revision. Is it a lightweight checkout?
+ ((file-readable-p
+ (setq file (expand-file-name ".bzr/branch/location" dir)))
+ (setq rev (emacs-bzr-version-dirstate dir))
+ ;; If the parent branch is local, try looking there for the rev.
+ ;; Note: there is no guarantee that the parent branch's rev
+ ;; corresponds to this branch. This branch could have
+ ;; been made with a specific -r revno argument, or the
+ ;; parent could have been updated since this branch was created.
+ ;; To try and detect this, we check the dirstate revids
+ ;; to see if they match.
+ (if (and (setq loc (with-temp-buffer
+ (insert-file-contents file)
+ (if (looking-at "file://\\(.*\\)")
+ (match-string 1))))
+ (equal rev (emacs-bzr-version-dirstate loc)))
+ (emacs-bzr-get-version loc)
+ ;; If parent does not match, the best we can do without
+ ;; calling external commands is to use the dirstate rev.
+ rev))
+ (external
+ (emacs-bzr-version-bzr dir)))))))
+
;; We put version info into the executable in the form that `ident' uses.
-(or (eq system-type 'windows-nt)
- (purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version))
- " $\n")))
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; End:
+(purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version))
+ " $\n"))
;;; version.el ends here
diff --git a/lisp/view.el b/lisp/view.el
index 0d8ad3336f9..7ed42bf7ddc 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -1,6 +1,6 @@
;;; view.el --- peruse file or buffer without editing
-;; Copyright (C) 1985, 1989, 1994-1995, 1997, 2000-2011
+;; Copyright (C) 1985, 1989, 1994-1995, 1997, 2000-2012
;; Free Software Foundation, Inc.
;; Author: K. Shane Hartman
@@ -309,15 +309,15 @@ this argument instead of explicitly setting `view-exit-action'.
Do not set EXIT-ACTION to `kill-buffer' when BUFFER visits a
file: Users may suspend viewing in order to modify the buffer.
Exiting View mode will then discard the user's edits. Setting
-EXIT-ACTION to `kill-buffer-if-not-modified' avoids this."
+EXIT-ACTION to `kill-buffer-if-not-modified' avoids this.
+
+This function does not enable View mode if the buffer's major-mode
+has a `special' mode-class, because such modes usually have their
+own View-like bindings."
(interactive "bView buffer: ")
- (if (eq (with-current-buffer buffer
- (get major-mode 'mode-class))
- 'special)
- (progn
- (switch-to-buffer buffer)
- (message "Not using View mode because the major mode is special"))
- (switch-to-buffer buffer)
+ (switch-to-buffer buffer)
+ (if (eq (get major-mode 'mode-class) 'special)
+ (message "Not using View mode because the major mode is special")
(view-mode-enter nil exit-action)))
;;;###autoload
@@ -335,11 +335,17 @@ Optional argument NOT-RETURN is ignored.
Optional argument EXIT-ACTION is either nil or a function with buffer as
argument. This function is called when finished viewing buffer. Use
-this argument instead of explicitly setting `view-exit-action'."
+this argument instead of explicitly setting `view-exit-action'.
+
+This function does not enable View mode if the buffer's major-mode
+has a `special' mode-class, because such modes usually have their
+own View-like bindings."
(interactive "bIn other window view buffer:\nP")
(let ((pop-up-windows t))
(pop-to-buffer buffer t))
- (view-mode-enter nil exit-action))
+ (if (eq (get major-mode 'mode-class) 'special)
+ (message "Not using View mode because the major mode is special")
+ (view-mode-enter nil exit-action)))
;;;###autoload
(defun view-buffer-other-frame (buffer &optional not-return exit-action)
@@ -356,11 +362,17 @@ Optional argument NOT-RETURN is ignored.
Optional argument EXIT-ACTION is either nil or a function with buffer as
argument. This function is called when finished viewing buffer. Use
-this argument instead of explicitly setting `view-exit-action'."
+this argument instead of explicitly setting `view-exit-action'.
+
+This function does not enable View mode if the buffer's major-mode
+has a `special' mode-class, because such modes usually have their
+own View-like bindings."
(interactive "bView buffer in other frame: \nP")
(let ((pop-up-frames t))
(pop-to-buffer buffer t))
- (view-mode-enter nil exit-action))
+ (if (eq (get major-mode 'mode-class) 'special)
+ (message "Not using View mode because the major mode is special")
+ (view-mode-enter nil exit-action)))
;;;###autoload
(define-minor-mode view-mode
@@ -501,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)
@@ -523,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/vt-control.el b/lisp/vt-control.el
index 558978768bc..7a30c6b6bc9 100644
--- a/lisp/vt-control.el
+++ b/lisp/vt-control.el
@@ -1,6 +1,6 @@
;;; vt-control.el --- Common VTxxx control functions
-;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el
index 8a4b4ac288c..5f976984598 100644
--- a/lisp/vt100-led.el
+++ b/lisp/vt100-led.el
@@ -1,6 +1,6 @@
;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones
-;; Copyright (C) 1988, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2012 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: FSF
diff --git a/lisp/w32-common-fns.el b/lisp/w32-common-fns.el
new file mode 100644
index 00000000000..fc045683394
--- /dev/null
+++ b/lisp/w32-common-fns.el
@@ -0,0 +1,130 @@
+;;; w32-common-fns.el --- Lisp routines for Windows and Cygwin-w32
+
+;; Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;;
+;;; This file contains functions that are used by both native NT Emacs
+;;; and Cygwin Emacs compiled to use the native Windows widget
+;;; library.
+
+(defun w32-version ()
+ "Return the MS-Windows version numbers.
+The value is a list of three integers: the major and minor version
+numbers, and the build number."
+ (x-server-version))
+
+(defun w32-using-nt ()
+ "Return non-nil if running on a Windows NT descendant.
+That includes all Windows systems except for 9X/Me."
+ (getenv "SystemRoot"))
+
+(declare-function w32-get-clipboard-data "w32select.c")
+(declare-function w32-set-clipboard-data "w32select.c")
+(declare-function x-server-version "w32fns.c" (&optional display))
+
+;;; Fix interface to (X-specific) mouse.el
+(defun x-set-selection (type data)
+ "Make an X selection of type TYPE and value DATA.
+The argument TYPE (nil means `PRIMARY') says which selection, and
+DATA specifies the contents. TYPE must be a symbol. \(It can also
+be a string, which stands for the symbol with that name, but this
+is considered obsolete.) DATA may be a string, a symbol, an
+integer (or a cons of two integers or list of two integers).
+
+The selection may also be a cons of two markers pointing to the same buffer,
+or an overlay. In these cases, the selection is considered to be the text
+between the markers *at whatever time the selection is examined*.
+Thus, editing done in the buffer after you specify the selection
+can alter the effective value of the selection.
+
+The data may also be a vector of valid non-vector selection values.
+
+The return value is DATA.
+
+Interactively, this command sets the primary selection. Without
+prefix argument, it reads the selection in the minibuffer. With
+prefix argument, it uses the text of the region as the selection value.
+
+Note that on MS-Windows, primary and secondary selections set by Emacs
+are not available to other programs."
+ (put 'x-selections (or type 'PRIMARY) data))
+
+(defun x-get-selection (&optional type _data-type)
+ "Return the value of an X Windows selection.
+The argument TYPE (default `PRIMARY') says which selection,
+and the argument DATA-TYPE (default `STRING') says
+how to convert the data.
+
+TYPE may be any symbol \(but nil stands for `PRIMARY'). However,
+only a few symbols are commonly used. They conventionally have
+all upper-case names. The most often used ones, in addition to
+`PRIMARY', are `SECONDARY' and `CLIPBOARD'.
+
+DATA-TYPE is usually `STRING', but can also be one of the symbols
+in `selection-converter-alist', which see."
+ (get 'x-selections (or type 'PRIMARY)))
+
+;; x-selection-owner-p is used in simple.el
+(defun x-selection-owner-p (&optional type)
+ (and (memq type '(nil PRIMARY SECONDARY))
+ (get 'x-selections (or type 'PRIMARY))))
+
+;; The "Windows" keys on newer keyboards bring up the Start menu
+;; whether you want it or not - make Emacs ignore these keystrokes
+;; rather than beep.
+(global-set-key [lwindow] 'ignore)
+(global-set-key [rwindow] 'ignore)
+
+(defvar w32-charset-info-alist) ; w32font.c
+
+
+;;;; Selections
+
+;; We keep track of the last text selected here, so we can check the
+;; current selection against it, and avoid passing back our own text
+;; from x-selection-value.
+(defvar x-last-selected-text nil)
+
+(defun x-get-selection-value ()
+ "Return the value of the current selection.
+Consult the selection. Treat empty strings as if they were unset."
+ (if x-select-enable-clipboard
+ (let (text)
+ ;; Don't die if x-get-selection signals an error.
+ (condition-case c
+ (setq text (w32-get-clipboard-data))
+ (error (message "w32-get-clipboard-data:%s" c)))
+ (if (string= text "") (setq text nil))
+ (cond
+ ((not text) nil)
+ ((eq text x-last-selected-text) nil)
+ ((string= text x-last-selected-text)
+ ;; Record the newer string, so subsequent calls can use the 'eq' test.
+ (setq x-last-selected-text text)
+ nil)
+ (t
+ (setq x-last-selected-text text))))))
+
+(defalias 'x-selection-value 'x-get-selection-value)
+
+;; Arrange for the kill and yank functions to set and check the clipboard.
+(setq interprogram-cut-function 'x-select-text)
+(setq interprogram-paste-function 'x-get-selection-value)
+
+(provide 'w32-common-fns)
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 1f54b8577c3..5d9b68e9de5 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -1,6 +1,6 @@
;;; w32-fns.el --- Lisp routines for 32-bit Windows
-;; Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: Geoff Voelker <voelker@cs.washington.edu>
;; Keywords: internal
@@ -26,34 +26,20 @@
;;; Code:
(require 'w32-vars)
+(require 'w32-common-fns)
(defvar explicit-shell-file-name)
;;;; Function keys
-(declare-function set-message-beep "w32console.c")
-(declare-function w32-get-clipboard-data "w32select.c")
+(declare-function set-message-beep "w32fns.c")
(declare-function w32-get-locale-info "w32proc.c")
(declare-function w32-get-valid-locale-ids "w32proc.c")
-(declare-function w32-set-clipboard-data "w32select.c")
;; Map all versions of a filename (8.3, longname, mixed case) to the
;; same buffer.
(setq find-file-visit-truename t)
-(declare-function x-server-version "w32fns.c" (&optional display))
-
-(defun w32-version ()
- "Return the MS-Windows version numbers.
-The value is a list of three integers: the major and minor version
-numbers, and the build number."
- (x-server-version))
-
-(defun w32-using-nt ()
- "Return non-nil if running on a Windows NT descendant.
-That includes all Windows systems except for 9X/Me."
- (and (eq system-type 'windows-nt) (getenv "SystemRoot")))
-
(defun w32-shell-name ()
"Return the name of the shell being used."
(or (bound-and-true-p shell-file-name)
@@ -161,7 +147,7 @@ You should set this to t when using a non-system shell.\n\n"))))
(add-hook 'before-init-hook 'set-default-process-coding-system)
-;;; Basic support functions for managing Emacs' locale setting
+;;; Basic support functions for managing Emacs's locale setting
(defvar w32-valid-locales nil
"List of locale ids known to be supported.")
@@ -192,24 +178,6 @@ You should set this to t when using a non-system shell.\n\n"))))
(w32-get-locale-info locale)
(w32-get-locale-info locale t))))))
-;; Setup Info-default-directory-list to include the info directory
-;; near where Emacs executable was installed. We used to set INFOPATH,
-;; but when this is set Info-default-directory-list is ignored. We
-;; also cannot rely upon what is set in paths.el because they assume
-;; that configuration during build time is correct for runtime.
-(defun w32-init-info ()
- (let* ((instdir (file-name-directory invocation-directory))
- (dir1 (expand-file-name "../info/" instdir))
- (dir2 (expand-file-name "../../../info/" instdir)))
- (if (file-exists-p dir1)
- (setq Info-default-directory-list
- (append Info-default-directory-list (list dir1)))
- (if (file-exists-p dir2)
- (setq Info-default-directory-list
- (append Info-default-directory-list (list dir2)))))))
-
-(add-hook 'before-init-hook 'w32-init-info)
-
;; The variable source-directory is used to initialize Info-directory-list.
;; However, the common case is that Emacs is being used from a binary
;; distribution, and the value of source-directory is meaningless in that
@@ -258,53 +226,6 @@ requires it (see `w32-shell-dos-semantics')."
(setq start (match-end 0))))
name)))
-;;; Fix interface to (X-specific) mouse.el
-(defun x-set-selection (type data)
- "Make an X selection of type TYPE and value DATA.
-The argument TYPE (nil means `PRIMARY') says which selection, and
-DATA specifies the contents. TYPE must be a symbol. \(It can also
-be a string, which stands for the symbol with that name, but this
-is considered obsolete.) DATA may be a string, a symbol, an
-integer (or a cons of two integers or list of two integers).
-
-The selection may also be a cons of two markers pointing to the same buffer,
-or an overlay. In these cases, the selection is considered to be the text
-between the markers *at whatever time the selection is examined*.
-Thus, editing done in the buffer after you specify the selection
-can alter the effective value of the selection.
-
-The data may also be a vector of valid non-vector selection values.
-
-The return value is DATA.
-
-Interactively, this command sets the primary selection. Without
-prefix argument, it reads the selection in the minibuffer. With
-prefix argument, it uses the text of the region as the selection value.
-
-Note that on MS-Windows, primary and secondary selections set by Emacs
-are not available to other programs."
- (put 'x-selections (or type 'PRIMARY) data))
-
-(defun x-get-selection (&optional type _data-type)
- "Return the value of an X Windows selection.
-The argument TYPE (default `PRIMARY') says which selection,
-and the argument DATA-TYPE (default `STRING') says
-how to convert the data.
-
-TYPE may be any symbol \(but nil stands for `PRIMARY'). However,
-only a few symbols are commonly used. They conventionally have
-all upper-case names. The most often used ones, in addition to
-`PRIMARY', are `SECONDARY' and `CLIPBOARD'.
-
-DATA-TYPE is usually `STRING', but can also be one of the symbols
-in `selection-converter-alist', which see."
- (get 'x-selections (or type 'PRIMARY)))
-
-;; x-selection-owner-p is used in simple.el
-(defun x-selection-owner-p (&optional type)
- (and (memq type '(nil PRIMARY SECONDARY))
- (get 'x-selections (or type 'PRIMARY))))
-
(defun set-w32-system-coding-system (coding-system)
"Set the coding system used by the Windows system to CODING-SYSTEM.
This is used for things like passing font names with non-ASCII
@@ -329,14 +250,6 @@ This function is provided for backward compatibility, since
;; Set to a system sound if you want a fancy bell.
(set-message-beep nil)
-;; The "Windows" keys on newer keyboards bring up the Start menu
-;; whether you want it or not - make Emacs ignore these keystrokes
-;; rather than beep.
-(global-set-key [lwindow] 'ignore)
-(global-set-key [rwindow] 'ignore)
-
-(defvar w32-charset-info-alist) ; w32font.c
-
(defun w32-add-charset-info (xlfd-charset windows-charset codepage)
"Function to add character sets to display with Windows fonts.
Creates entries in `w32-charset-info-alist'.
@@ -398,40 +311,6 @@ bit output with no translation."
'w32-charset-info-alist "21.1")
-;;;; Selections
-
-;; We keep track of the last text selected here, so we can check the
-;; current selection against it, and avoid passing back our own text
-;; from x-selection-value.
-(defvar x-last-selected-text nil)
-
-(defun x-get-selection-value ()
- "Return the value of the current selection.
-Consult the selection. Treat empty strings as if they were unset."
- (if x-select-enable-clipboard
- (let (text)
- ;; Don't die if x-get-selection signals an error.
- (condition-case c
- (setq text (w32-get-clipboard-data))
- (error (message "w32-get-clipboard-data:%s" c)))
- (if (string= text "") (setq text nil))
- (cond
- ((not text) nil)
- ((eq text x-last-selected-text) nil)
- ((string= text x-last-selected-text)
- ;; Record the newer string, so subsequent calls can use the 'eq' test.
- (setq x-last-selected-text text)
- nil)
- (t
- (setq x-last-selected-text text))))))
-
-(defalias 'x-selection-value 'x-get-selection-value)
-
-;; Arrange for the kill and yank functions to set and check the clipboard.
-(setq interprogram-cut-function 'x-select-text)
-(setq interprogram-paste-function 'x-get-selection-value)
-
-
;;;; Support for build process
;; From autoload.el
diff --git a/lisp/w32-vars.el b/lisp/w32-vars.el
index d1e8edc40be..0e152b125bc 100644
--- a/lisp/w32-vars.el
+++ b/lisp/w32-vars.el
@@ -1,6 +1,6 @@
;;; w32-vars.el --- MS-Windows specific user options
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
;; Author: Jason Rumney <jasonr@gnu.org>
;; Keywords: internal
@@ -44,17 +44,19 @@ X does. See `w32-fixed-font-alist' for the font menu definition."
"Include proportional fonts in the default font dialog.")
(make-obsolete-variable 'w32-list-proportional-fonts "no longer used." "23.1")
-(defcustom w32-allow-system-shell nil
- "Disable startup warning when using \"system\" shells."
- :type 'boolean
- :group 'w32)
-
-(defcustom w32-system-shells '("cmd" "cmd.exe" "command" "command.com"
- "4nt" "4nt.exe" "4dos" "4dos.exe"
- "tcc" "tcc.exe" "ndos" "ndos.exe")
- "List of strings recognized as Windows system shells."
- :type '(repeat string)
- :group 'w32)
+(unless (eq system-type 'cygwin)
+ (defcustom w32-allow-system-shell nil
+ "Disable startup warning when using \"system\" shells."
+ :type 'boolean
+ :group 'w32))
+
+(unless (eq system-type 'cygwin)
+ (defcustom w32-system-shells '("cmd" "cmd.exe" "command" "command.com"
+ "4nt" "4nt.exe" "4dos" "4dos.exe"
+ "tcc" "tcc.exe" "ndos" "ndos.exe")
+ "List of strings recognized as Windows system shells."
+ :type '(repeat string)
+ :group 'w32))
;; Want "menu" custom type for this.
(defcustom w32-fixed-font-alist
diff --git a/lisp/wdired.el b/lisp/wdired.el
index b9c07d15ae8..5183b5639c3 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -1,6 +1,6 @@
;;; wdired.el --- Rename files editing their names in dired buffers
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Filename: wdired.el
;; Author: Juan Len Lahoz Garca <juanleon1@gmail.com>
@@ -75,7 +75,6 @@
(defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var
-(eval-when-compile (require 'cl))
(require 'dired)
(autoload 'dired-do-create-files-regexp "dired-aux")
@@ -141,6 +140,20 @@ program `dired-chmod-program', which must exist."
(other :tag "Bits freely editable" advanced))
:group 'wdired)
+(defcustom wdired-keep-marker-rename t
+ ;; Use t as default so that renamed files "take their markers with them".
+ "Controls marking of files renamed in WDired.
+If t, files keep their previous marks when they are renamed.
+If a character, renamed files (whether previously marked or not)
+are afterward marked with that character.
+This option affects only files renamed by `wdired-finish-edit'.
+See `dired-keep-marker-rename' if you want to do the same for files
+renamed by `dired-do-rename' and `dired-do-rename-regexp'."
+ :type '(choice (const :tag "Keep" t)
+ (character :tag "Mark" :value ?R))
+ :version "24.3"
+ :group 'wdired)
+
(defvar wdired-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-x\C-s" 'wdired-finish-edit)
@@ -181,17 +194,24 @@ program `dired-chmod-program', which must exist."
(defvar wdired-col-perm) ;; Column where the permission bits start
(defvar wdired-old-content)
(defvar wdired-old-point)
-
+(defvar wdired-old-marks)
(defun wdired-mode ()
- "\\<wdired-mode-map>File Names Editing mode.
+ "Writable Dired (WDired) mode.
+\\<wdired-mode-map>
+In WDired mode, you can edit the names of the files in the
+buffer, the target of the links, and the permission bits of the
+files.
+
+Type \\[wdired-finish-edit] to exit WDired mode, returning to
+Dired mode, and make your edits \"take effect\" by modifying the
+file and directory names, link targets, and/or file permissions
+on disk. If you delete the filename of a file, it is flagged for
+deletion in the Dired buffer.
-Press \\[wdired-finish-edit] to make the changes to take effect
-and exit. To abort the edit, use \\[wdired-abort-changes].
+Type \\[wdired-abort-changes] to abort your edits and exit WDired mode.
-In this mode you can edit the names of the files, the target of
-the links and the permission bits of the files. You can use
-\\[customize-group] RET wdired to customize WDired behavior.
+Type \\[customize-group] RET wdired to customize WDired behavior.
The only editable texts in a WDired buffer are filenames,
symbolic link targets, and filenames permission."
@@ -202,18 +222,21 @@ symbolic link targets, and filenames permission."
;;;###autoload
(defun wdired-change-to-wdired-mode ()
- "Put a dired buffer in a mode in which filenames are editable.
+ "Put a Dired buffer in Writable Dired (WDired) mode.
\\<wdired-mode-map>
-This mode allows the user to change the names of the files, and after
-typing \\[wdired-finish-edit] Emacs renames the files and directories
-in disk.
+In WDired mode, you can edit the names of the files in the
+buffer, the target of the links, and the permission bits of the
+files. After typing \\[wdired-finish-edit], Emacs modifies the files and
+directories to reflect your edits.
See `wdired-mode'."
(interactive)
- (or (eq major-mode 'dired-mode)
- (error "Not a Dired buffer"))
+ (unless (eq major-mode 'dired-mode)
+ (error "Not a Dired buffer"))
(set (make-local-variable 'wdired-old-content)
(buffer-substring (point-min) (point-max)))
+ (set (make-local-variable 'wdired-old-marks)
+ (dired-remember-marks (point-min) (point-max)))
(set (make-local-variable 'wdired-old-point) (point))
(set (make-local-variable 'query-replace-skip-read-only) t)
(set (make-local-variable 'isearch-filter-predicate)
@@ -376,6 +399,15 @@ non-nil means return old filename."
(setq changes t)
(if (not file-new) ;empty filename!
(push file-old files-deleted)
+ (when wdired-keep-marker-rename
+ (let ((mark (cond ((integerp wdired-keep-marker-rename)
+ wdired-keep-marker-rename)
+ (wdired-keep-marker-rename
+ (cdr (assoc file-old wdired-old-marks)))
+ (t nil))))
+ (when mark
+ (push (cons (substitute-in-file-name file-new) mark)
+ wdired-old-marks))))
(push (cons file-old (substitute-in-file-name file-new))
files-renamed))))
(forward-line -1)))
@@ -393,7 +425,9 @@ non-nil means return old filename."
(= (length files-renamed) 1))
(setq dired-directory (cdr (car files-renamed))))
;; Re-sort the buffer.
- (revert-buffer))
+ (revert-buffer)
+ (let ((inhibit-read-only t))
+ (dired-mark-remembered wdired-old-marks)))
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max)
'(old-name nil end-name nil old-link nil
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 57f51e21fbb..f52a8fb36ae 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -1,6 +1,6 @@
;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
@@ -165,10 +165,10 @@
;; There are also the following useful commands:
;;
;; `whitespace-newline-mode'
-;; Toggle NEWLINE minor mode visualization ("nl" on modeline).
+;; Toggle NEWLINE minor mode visualization ("nl" on mode line).
;;
;; `global-whitespace-newline-mode'
-;; Toggle NEWLINE global minor mode visualization ("NL" on modeline).
+;; Toggle NEWLINE global minor mode visualization ("NL" on mode line).
;;
;; `whitespace-report'
;; Report some blank problems in buffer.
@@ -309,8 +309,8 @@
;; buffer is visited or written.
;;
;;
-;; Acknowledgements
-;; ----------------
+;; Acknowledgments
+;; ---------------
;;
;; Thanks to felix (EmacsWiki) for keeping highlight when switching between
;; major modes on a file.
@@ -565,10 +565,10 @@ Used when `whitespace-style' includes the value `spaces'."
(defface whitespace-space
'((((class color) (background dark))
- (:background "grey20" :foreground "darkgray"))
+ :background "grey20" :foreground "darkgray")
(((class color) (background light))
- (:background "LightYellow" :foreground "lightgray"))
- (t (:inverse-video t)))
+ :background "LightYellow" :foreground "lightgray")
+ (t :inverse-video t))
"Face used to visualize SPACE."
:group 'whitespace)
@@ -583,10 +583,10 @@ Used when `whitespace-style' includes the value `spaces'."
(defface whitespace-hspace ; 'nobreak-space
'((((class color) (background dark))
- (:background "grey24" :foreground "darkgray"))
+ :background "grey24" :foreground "darkgray")
(((class color) (background light))
- (:background "LemonChiffon3" :foreground "lightgray"))
- (t (:inverse-video t)))
+ :background "LemonChiffon3" :foreground "lightgray")
+ (t :inverse-video t))
"Face used to visualize HARD SPACE."
:group 'whitespace)
@@ -601,10 +601,10 @@ Used when `whitespace-style' includes the value `tabs'."
(defface whitespace-tab
'((((class color) (background dark))
- (:background "grey22" :foreground "darkgray"))
+ :background "grey22" :foreground "darkgray")
(((class color) (background light))
- (:background "beige" :foreground "lightgray"))
- (t (:inverse-video t)))
+ :background "beige" :foreground "lightgray")
+ (t :inverse-video t))
"Face used to visualize TAB."
:group 'whitespace)
@@ -621,15 +621,13 @@ and `newline'."
(defface whitespace-newline
- '((((class color) (background dark))
- (:foreground "darkgray" :bold nil))
- (((class color) (min-colors 88) (background light))
- (:foreground "lightgray" :bold nil))
+ '((default :weight normal)
+ (((class color) (background dark)) :foreground "darkgray")
+ (((class color) (min-colors 88) (background light)) :foreground "lightgray")
;; Displays with 16 colors use lightgray as background, so using a
;; lightgray foreground makes the newline mark invisible.
- (((class color) (background light))
- (:foreground "brown" :bold nil))
- (t (:underline t :bold nil)))
+ (((class color) (background light)) :foreground "brown")
+ (t :underline t))
"Face used to visualize NEWLINE char mapping.
See `whitespace-display-mappings'."
@@ -645,8 +643,9 @@ Used when `whitespace-style' includes the value `trailing'."
(defface whitespace-trailing ; 'trailing-whitespace
- '((((class mono)) (:inverse-video t :bold t :underline t))
- (t (:background "red1" :foreground "yellow" :bold t)))
+ '((default :weight bold)
+ (((class mono)) :inverse-video t :underline t)
+ (t :background "red1" :foreground "yellow"))
"Face used to visualize trailing blanks."
:group 'whitespace)
@@ -662,8 +661,8 @@ Used when `whitespace-style' includes the value `line'."
(defface whitespace-line
- '((((class mono)) (:inverse-video t :bold t :underline t))
- (t (:background "gray20" :foreground "violet")))
+ '((((class mono)) :inverse-video t :weight bold :underline t)
+ (t :background "gray20" :foreground "violet"))
"Face used to visualize \"long\" lines.
See `whitespace-line-column'."
@@ -679,8 +678,8 @@ Used when `whitespace-style' includes the value `space-before-tab'."
(defface whitespace-space-before-tab
- '((((class mono)) (:inverse-video t :bold t :underline t))
- (t (:background "DarkOrange" :foreground "firebrick")))
+ '((((class mono)) :inverse-video t :weight bold :underline t)
+ (t :background "DarkOrange" :foreground "firebrick"))
"Face used to visualize SPACEs before TAB."
:group 'whitespace)
@@ -694,8 +693,8 @@ Used when `whitespace-style' includes the value `indentation'."
(defface whitespace-indentation
- '((((class mono)) (:inverse-video t :bold t :underline t))
- (t (:background "yellow" :foreground "firebrick")))
+ '((((class mono)) :inverse-video t :weight bold :underline t)
+ (t :background "yellow" :foreground "firebrick"))
"Face used to visualize 8 or more SPACEs at beginning of line."
:group 'whitespace)
@@ -709,8 +708,8 @@ Used when `whitespace-style' includes the value `empty'."
(defface whitespace-empty
- '((((class mono)) (:inverse-video t :bold t :underline t))
- (t (:background "yellow" :foreground "firebrick")))
+ '((((class mono)) :inverse-video t :weight bold :underline t)
+ (t :background "yellow" :foreground "firebrick"))
"Face used to visualize empty lines at beginning and/or end of buffer."
:group 'whitespace)
@@ -724,8 +723,8 @@ Used when `whitespace-style' includes the value `space-after-tab'."
(defface whitespace-space-after-tab
- '((((class mono)) (:inverse-video t :bold t :underline t))
- (t (:background "yellow" :foreground "firebrick")))
+ '((((class mono)) :inverse-video t :weight bold :underline t)
+ (t :background "yellow" :foreground "firebrick"))
"Face used to visualize 8 or more SPACEs after TAB."
:group 'whitespace)
@@ -928,17 +927,13 @@ Used when `whitespace-style' includes `lines' or `lines-tail'."
'(
(space-mark ?\ [?\u00B7] [?.]) ; space - centered dot
(space-mark ?\xA0 [?\u00A4] [?_]) ; hard space - currency
- (space-mark ?\x8A0 [?\x8A4] [?_]) ; hard space - currency
- (space-mark ?\x920 [?\x924] [?_]) ; hard space - currency
- (space-mark ?\xE20 [?\xE24] [?_]) ; hard space - currency
- (space-mark ?\xF20 [?\xF24] [?_]) ; hard space - currency
;; NEWLINE is displayed using the face `whitespace-newline'
(newline-mark ?\n [?$ ?\n]) ; eol - dollar sign
;; (newline-mark ?\n [?\u21B5 ?\n] [?$ ?\n]) ; eol - downwards arrow
;; (newline-mark ?\n [?\u00B6 ?\n] [?$ ?\n]) ; eol - pilcrow
- ;; (newline-mark ?\n [?\x8AF ?\n] [?$ ?\n]) ; eol - overscore
- ;; (newline-mark ?\n [?\x8AC ?\n] [?$ ?\n]) ; eol - negation
- ;; (newline-mark ?\n [?\x8B0 ?\n] [?$ ?\n]) ; eol - grade
+ ;; (newline-mark ?\n [?\u00AF ?\n] [?$ ?\n]) ; eol - overscore
+ ;; (newline-mark ?\n [?\u00AC ?\n] [?$ ?\n]) ; eol - negation
+ ;; (newline-mark ?\n [?\u00B0 ?\n] [?$ ?\n]) ; eol - degrees
;;
;; WARNING: the mapping below has a problem.
;; When a TAB occupies exactly one column, it will display the
@@ -1533,8 +1528,7 @@ documentation."
(when (memq 'empty whitespace-style)
(let (overwrite-mode) ; enforce no overwrite
(goto-char (point-min))
- (when (re-search-forward
- (concat "\\`" whitespace-empty-at-bob-regexp) nil t)
+ (when (looking-at whitespace-empty-at-bob-regexp)
(delete-region (match-beginning 1) (match-end 1)))
(when (re-search-forward
(concat whitespace-empty-at-eob-regexp "\\'") nil t)
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index 7ca13baeb53..ab5122d6153 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -1,6 +1,6 @@
;;; wid-browse.el --- functions for browsing widgets
;;
-;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
@@ -30,7 +30,6 @@
(require 'easymenu)
(require 'custom)
(require 'wid-edit)
-(eval-when-compile (require 'cl))
(defgroup widget-browse nil
"Customization support for browsing widgets."
@@ -270,7 +269,10 @@ VALUE is assumed to be a list of widgets."
;;;###autoload
(define-minor-mode widget-minor-mode
- "Minor mode for traversing widgets."
+ "Minor mode for traversing widgets.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
:lighter " Widget")
;;; The End:
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 07eccaff4fb..9c5c6462bcc 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,6 +1,6 @@
;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t; lexical-binding:t -*-
;;
-;; Copyright (C) 1996-1997, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2012 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
@@ -1141,12 +1141,6 @@ the field."
(kill-region (point) end)
(call-interactively 'kill-line))))
-(defcustom widget-complete-field (lookup-key global-map "\M-\t")
- "Default function to call for completion inside fields."
- :options '(ispell-complete-word complete-tag lisp-complete-symbol)
- :type 'function
- :group 'widgets)
-
(defun widget-narrow-to-field ()
"Narrow to field."
(interactive)
@@ -1169,10 +1163,6 @@ When not inside a field, signal an error."
(completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
(plist-get completion-extra-properties
:predicate))))
- ((widget-field-find (point))
- ;; This defaulting used to be performed in widget-default-complete, but
- ;; it seems more appropriate here than in widget-default-completions.
- (call-interactively 'widget-complete-field))
(t
(error "Not in an editable field")))))
;; We may want to use widget completion in buffers where the major mode
@@ -1687,7 +1677,7 @@ The value of the :type attribute should be an unconverted widget type."
(eval-minibuffer prompt))
(defun widget-docstring (widget)
- "Return the documentation string specificied by WIDGET, or nil if none.
+ "Return the documentation string specified by WIDGET, or nil if none.
If WIDGET has a `:doc' property, that specifies the documentation string.
Otherwise, try the `:documentation-property' property. If this
is a function, call it with the widget's value as an argument; if
@@ -1987,10 +1977,14 @@ the earlier input."
(when (overlayp overlay)
(delete-overlay overlay))))
-(defun widget-field-value-get (widget)
- "Return current text in editing field."
+(defun widget-field-value-get (widget &optional no-truncate)
+ "Return current text in editing field.
+Normally, trailing spaces within the editing field are truncated.
+But if NO-TRUNCATE is non-nil, include them."
(let ((from (widget-field-start widget))
- (to (widget-field-text-end widget))
+ (to (if no-truncate
+ (widget-field-end widget)
+ (widget-field-text-end widget)))
(buffer (widget-field-buffer widget))
(secret (widget-get widget :secret))
(old (current-buffer)))
@@ -2913,15 +2907,7 @@ link for that string."
(push (widget-convert-button widget-documentation-link-type
begin end :value name)
buttons)))))
- (widget-put widget :buttons buttons)))
- (let ((indent (widget-get widget :indent)))
- (when (and indent (not (zerop indent)))
- (save-excursion
- (save-restriction
- (narrow-to-region from to)
- (goto-char (point-min))
- (while (search-forward "\n" nil t)
- (insert-char ?\s indent)))))))
+ (widget-put widget :buttons buttons))))
;;; The `documentation-string' Widget.
@@ -2940,10 +2926,9 @@ link for that string."
(start (point)))
(if (string-match "\n" doc)
(let ((before (substring doc 0 (match-beginning 0)))
- (after (substring doc (match-beginning 0)))
- button)
- (when (and indent (not (zerop indent)))
- (insert-char ?\s indent))
+ (after (substring doc (match-end 0)))
+ button end)
+ (widget-documentation-string-indent-to indent)
(insert before ?\s)
(widget-documentation-link-add widget start (point))
(setq button
@@ -2956,18 +2941,35 @@ link for that string."
:action 'widget-parent-action
shown))
(when shown
+ (insert ?\n)
(setq start (point))
(when (and indent (not (zerop indent)))
(insert-char ?\s indent))
(insert after)
- (widget-documentation-link-add widget start (point)))
+ (setq end (point))
+ (widget-documentation-link-add widget start end)
+ ;; Indent the subsequent lines.
+ (when (and indent (> indent 0))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (search-forward "\n" nil t)
+ (widget-documentation-string-indent-to indent))))))
(widget-put widget :buttons (list button)))
- (when (and indent (not (zerop indent)))
- (insert-char ?\s indent))
+ (widget-documentation-string-indent-to indent)
(insert doc)
(widget-documentation-link-add widget start (point))))
(insert ?\n))
+(defun widget-documentation-string-indent-to (col)
+ (when (and (numberp col)
+ (> col 0))
+ (let ((opoint (point)))
+ (indent-to col)
+ (put-text-property opoint (point)
+ 'display `(space :align-to ,col)))))
+
(defun widget-documentation-string-action (widget &rest _ignore)
;; Toggle documentation.
(let ((parent (widget-get widget :parent)))
@@ -3407,6 +3409,7 @@ To use this type, you must define :match or :match-alternatives."
:format "%{%t%}: %v\n"
:valid-regexp "\\`.\\'"
:error "This field should contain a single character"
+ :value-get (lambda (w) (widget-field-value-get w t))
:value-to-internal (lambda (_widget value)
(if (stringp value)
value
diff --git a/lisp/widget.el b/lisp/widget.el
index 1bac2e44b3f..98085d82681 100644
--- a/lisp/widget.el
+++ b/lisp/widget.el
@@ -1,6 +1,6 @@
;;; widget.el --- a library of user interface components
;;
-;; Copyright (C) 1996-1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2012 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, extensions, faces, hypermedia
diff --git a/lisp/windmove.el b/lisp/windmove.el
index 1deaa44c7dd..1181e409dff 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -1,6 +1,6 @@
;;; windmove.el --- directional window-selection routines
;;
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;;
;; Author: Hovav Shacham (hovav@cs.stanford.edu)
;; Created: 17 October 1998
@@ -94,7 +94,7 @@
;; Installation:
;;
-;; Put the following line in your `.emacs' file:
+;; Put the following line in your init file:
;;
;; (windmove-default-keybindings) ; shifted arrow keys
;;
@@ -118,7 +118,7 @@
;; (setq windmove-window-distance-delta 2)
;;
-;; Acknowledgements:
+;; Acknowledgments:
;;
;; Special thanks to Julian Assange (proff@iq.org), whose
;; change-windows-intuitively.el predates Windmove, and provided the
@@ -417,17 +417,17 @@ supplied, if ARG is greater or smaller than zero, respectively."
(- (nth 3 edges) 1))))
(cond
((> effective-arg 0)
- top-left)
+ top-left)
((< effective-arg 0)
- bottom-right)
+ bottom-right)
((= effective-arg 0)
- (windmove-coord-add
- top-left
- (let ((col-row
- (posn-col-row
- (posn-at-point (window-point window) window))))
- (cons (- (car col-row) (window-hscroll window))
- (cdr col-row)))))))))
+ (windmove-coord-add
+ top-left
+ ;; Don't care whether window is horizontally scrolled -
+ ;; `posn-at-point' handles that already. See also:
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2012-01/msg00638.html
+ (posn-col-row
+ (posn-at-point (window-point window) window))))))))
;; This uses the reference location in the current window (calculated
;; by `windmove-reference-loc' above) to find a reference location
diff --git a/lisp/window.el b/lisp/window.el
index 0014d85a816..52909fa9e5f 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -1,6 +1,6 @@
;;; window.el --- GNU Emacs window commands aside from those written in C
-;; Copyright (C) 1985, 1989, 1992-1994, 2000-2011
+;; Copyright (C) 1985, 1989, 1992-1994, 2000-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -28,7 +28,34 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(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.
@@ -46,22 +73,129 @@ 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))
- ;; It is necessary to save all of these, because calling
- ;; select-window changes frame-selected-window for whatever
- ;; frame that window is in.
- (save-selected-window-alist
- (mapcar (lambda (frame) (cons frame (frame-selected-window frame)))
- (frame-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.
+This hook is run by `with-temp-buffer-window' with the buffer to be
+displayed current.")
+
+(defvar temp-buffer-window-show-hook nil
+ "Normal hook run by `with-temp-buffer-window' after buffer display.
+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.
+Return the buffer."
+ (let ((old-dir default-directory)
+ (buffer (get-buffer-create buffer-or-name)))
+ (with-current-buffer buffer
+ (kill-all-local-variables)
+ (setq default-directory old-dir)
+ (delete-all-overlays)
+ (setq buffer-read-only nil)
+ (setq buffer-file-name nil)
+ (setq buffer-undo-list t)
+ (let ((inhibit-read-only t)
+ (inhibit-modification-hooks t))
+ (erase-buffer)
+ (run-hooks 'temp-buffer-window-setup-hook))
+ ;; Return the buffer.
+ buffer)))
+
+(defun temp-buffer-window-show (&optional buffer action)
+ "Show temporary buffer BUFFER in a window.
+Return the window showing BUFFER. Pass ACTION as action argument
+to `display-buffer'."
+ (let (window frame)
+ (with-current-buffer buffer
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (goto-char (point-min))
+ (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))
+ (setq minibuffer-scroll-window window)
+ (set-window-hscroll window 0)
+ (with-selected-window window
+ (run-hooks 'temp-buffer-window-show-hook)
+ (when temp-buffer-resize-mode
+ (resize-temp-buffer-window window)))
+ ;; Return the window.
+ window))))
+
+;; Doc is very similar to with-output-to-temp-buffer.
+(defmacro with-temp-buffer-window (buffer-or-name action quit-function &rest body)
+ "Bind `standard-output' to BUFFER-OR-NAME, eval BODY, show the buffer.
+BUFFER-OR-NAME must specify either a live buffer, or the name of a
+buffer (if it does not exist, this macro creates it).
+
+This construct makes buffer BUFFER-OR-NAME empty before running BODY.
+It does not make the buffer current for BODY.
+Instead it binds `standard-output' to that buffer, so that output
+generated with `prin1' and similar functions in BODY goes into
+the buffer.
+
+At the end of BODY, this marks the specified buffer unmodified and
+read-only, and displays it in a window (but does not select it, or make
+the buffer current). The display happens by calling `display-buffer'
+with the ACTION argument. If `temp-buffer-resize-mode' is enabled,
+the relevant window shrinks automatically.
+
+This returns the value returned by BODY, unless QUIT-FUNCTION specifies
+a function. In that case, it runs the function with two arguments -
+the window showing the specified buffer and the value returned by
+BODY - and returns the value returned by that function.
+
+If the buffer is displayed on a new frame, the window manager may
+decide to select that frame. In that case, it's usually a good
+strategy if QUIT-FUNCTION selects the window showing the buffer
+before reading any value from the minibuffer; for example, when
+asking a `yes-or-no-p' question.
+
+This runs the hook `temp-buffer-window-setup-hook' before BODY,
+with the specified buffer temporarily current. It runs the
+hook `temp-buffer-window-show-hook' after displaying the buffer,
+with that buffer temporarily current, and the window that was used to
+display it temporarily selected.
+
+This construct is similar to `with-output-to-temp-buffer', but
+runs different hooks. In particular, it does not run
+`temp-buffer-setup-hook', which usually puts the buffer in Help mode.
+Also, it does not call `temp-buffer-show-function' (the ACTION
+argument replaces this)."
+ (declare (debug t))
+ (let ((buffer (make-symbol "buffer"))
+ (window (make-symbol "window"))
+ (value (make-symbol "value")))
+ `(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name))
+ (standard-output ,buffer)
+ ,window ,value)
+ (with-current-buffer ,buffer
+ (setq ,value (progn ,@body))
+ (setq ,window (temp-buffer-window-show ,buffer ,action)))
+
+ (if (functionp ,quit-function)
+ (funcall ,quit-function ,window ,value)
+ ,value))))
;; The following two functions are like `window-next-sibling' and
;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so
@@ -81,11 +215,13 @@ be any window."
(and window (window-parent window) (window-prev-sibling window)))
(defun window-child (window)
- "Return WINDOW's first child window."
+ "Return WINDOW's first child window.
+WINDOW can be any window."
(or (window-top-child window) (window-left-child window)))
(defun window-child-count (window)
- "Return number of WINDOW's child windows."
+ "Return number of WINDOW's child windows.
+WINDOW can be any window."
(let ((count 0))
(when (and (windowp window) (setq window (window-child window)))
(while window
@@ -94,20 +230,13 @@ be any window."
count))
(defun window-last-child (window)
- "Return last child window of WINDOW."
+ "Return last child window of WINDOW.
+WINDOW can be any window."
(when (and (windowp window) (setq window (window-child window)))
(while (window-next-sibling window)
(setq window (window-next-sibling window))))
window)
-(defun window-valid-p (object)
- "Return t if OBJECT denotes a live window or internal window.
-Otherwise, return nil; this includes the case where OBJECT is a
-deleted window."
- (and (windowp object)
- (or (window-buffer object) (window-child object))
- t))
-
(defun window-normalize-buffer (buffer-or-name)
"Return buffer specified by BUFFER-OR-NAME.
BUFFER-OR-NAME must be either a buffer or a string naming a live
@@ -133,20 +262,22 @@ FRAME must be a live frame and defaults to the selected frame."
(selected-frame)))
(defun window-normalize-window (window &optional live-only)
- "Return window specified by WINDOW.
-If WINDOW is nil, return `selected-window'.
-If WINDOW is a live window or internal window, return WINDOW;
- if LIVE-ONLY is non-nil, return WINDOW for a live window only.
+ "Return the window specified by WINDOW.
+If WINDOW is nil, return the selected window. Otherwise, if
+WINDOW is a live or an internal window, return WINDOW; if
+LIVE-ONLY is non-nil, return WINDOW for a live window only.
Otherwise, signal an error."
- (cond ((null window)
- (selected-window))
- (live-only
- (if (window-live-p window)
- window
- (error "%s is not a live window" window)))
- ((if (window-valid-p window)
- window
- (error "%s is not a window" window)))))
+ (cond
+ ((null window)
+ (selected-window))
+ (live-only
+ (if (window-live-p window)
+ window
+ (error "%s is not a live window" window)))
+ ((window-valid-p window)
+ window)
+ (t
+ (error "%s is not a valid window" window))))
(defvar ignore-window-parameters nil
"If non-nil, standard functions ignore window parameters.
@@ -197,7 +328,7 @@ narrower, explicitly specify the SIZE argument of that function."
(defun window-combined-p (&optional window horizontal)
"Return non-nil if WINDOW has siblings in a given direction.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
HORIZONTAL determines a direction for the window combination.
If HORIZONTAL is omitted or nil, return non-nil if WINDOW is part
@@ -213,7 +344,7 @@ horizontal window combination."
(defun window-combinations (window &optional horizontal)
"Return largest number of windows vertically arranged within WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
If HORIZONTAL is non-nil, return the largest number of
windows horizontally arranged within WINDOW."
(setq window (window-normalize-window window))
@@ -264,19 +395,32 @@ windows horizontally arranged within WINDOW."
(setq walk-window-tree-window
(window-right walk-window-tree-window))))))
-(defun walk-window-tree (fun &optional frame any)
+(defun walk-window-tree (fun &optional frame any minibuf)
"Run function FUN on each live window of FRAME.
FUN must be a function with one argument - a window. FRAME must
be a live frame and defaults to the selected one. ANY, if
-non-nil means to run FUN on all live and internal windows of
+non-nil, means to run FUN on all live and internal windows of
FRAME.
+Optional argument MINIBUF t means run FUN on FRAME's minibuffer
+window even if it isn't active. MINIBUF nil or omitted means run
+FUN on FRAME's minibuffer window only if it's active. In both
+cases the minibuffer window must be part of FRAME. MINIBUF
+neither nil nor t means never run FUN on the minibuffer window.
+
This function performs a pre-order, depth-first traversal of the
window tree. If FUN changes the window tree, the result is
unpredictable."
- (let ((walk-window-tree-frame (window-normalize-frame frame)))
- (walk-window-tree-1
- fun (frame-root-window walk-window-tree-frame) any)))
+ (setq frame (window-normalize-frame frame))
+ (walk-window-tree-1 fun (frame-root-window frame) any)
+ (when (memq minibuf '(nil t))
+ ;; Run FUN on FRAME's minibuffer window if requested.
+ (let ((minibuffer-window (minibuffer-window frame)))
+ (when (and (window-live-p minibuffer-window)
+ (eq (window-frame minibuffer-window) frame)
+ (or (eq minibuf t)
+ (minibuffer-window-active-p minibuffer-window)))
+ (funcall fun minibuffer-window)))))
(defun walk-window-subtree (fun &optional window any)
"Run function FUN on the subtree of windows rooted at WINDOW.
@@ -292,26 +436,32 @@ is unpredictable."
(setq window (window-normalize-window window))
(walk-window-tree-1 fun window any t))
-(defun window-with-parameter (parameter &optional value frame any)
+(defun window-with-parameter (parameter &optional value frame any minibuf)
"Return first window on FRAME with PARAMETER non-nil.
FRAME defaults to the selected frame. Optional argument VALUE
non-nil means only return a window whose window-parameter value
for PARAMETER equals VALUE (comparison is done with `equal').
Optional argument ANY non-nil means consider internal windows
-too."
- (let (this-value windows)
+too.
+
+Optional argument MINIBUF t means consider FRAME's minibuffer
+window even if it isn't active. MINIBUF nil or omitted means
+consider FRAME's minibuffer window only if it's active. In both
+cases the minibuffer window must be part of FRAME. MINIBUF
+neither nil nor t means never consider the minibuffer window."
+ (let (this-value)
(catch 'found
(walk-window-tree
(lambda (window)
(when (and (setq this-value (window-parameter window parameter))
(or (not value) (equal value this-value)))
(throw 'found window)))
- frame any))))
+ frame any minibuf))))
;;; Atomic windows.
(defun window-atom-root (&optional window)
"Return root of atomic window WINDOW is a part of.
-WINDOW can be any window and defaults to the selected one.
+WINDOW must be a valid window and defaults to the selected one.
Return nil if WINDOW is not part of an atomic window."
(setq window (window-normalize-window window))
(let (root)
@@ -331,6 +481,45 @@ WINDOW must be an internal window. Return WINDOW."
window t)
window))
+(defun display-buffer-in-atom-window (buffer alist)
+ "Display BUFFER in an atomic window.
+This function displays BUFFER in a new window that will be
+combined with an existing window to form an atomic window. If
+the existing window is already part of an atomic window, add the
+new window to that atomic window. Operations like `split-window'
+or `delete-window', when applied to a constituent of an atomic
+window, are applied atomically to the root of that atomic window.
+
+ALIST is an association list of symbols and values. The
+following symbols can be used.
+
+`window' specifies the existing window the new window shall be
+ combined with. Use `window-atom-root' to make the new window a
+ sibling of an atomic window's root. If an internal window is
+ specified here, all children of that window become part of the
+ atomic window too. If no window is specified, the new window
+ becomes a sibling of the selected window.
+
+`side' denotes the side of the existing window where the new
+ window shall be located. Valid values are `below', `right',
+ `above' and `left'. The default is `below'.
+
+The return value is the new window, nil when creating that window
+failed."
+ (let ((ignore-window-parameters t)
+ (window-combination-limit t)
+ (window (cdr (assq 'window alist)))
+ (side (cdr (assq 'side alist)))
+ new)
+ (setq window (window-normalize-window window))
+ ;; Split off new window
+ (when (setq new (split-window window nil side))
+ ;; Make sure we have a valid atomic window.
+ (window-make-atom (window-parent window))
+ ;; Display BUFFER in NEW and return NEW.
+ (window--display-buffer
+ buffer new 'window alist display-buffer-mark-dedicated))))
+
(defun window--atom-check-1 (window)
"Subroutine of `window--atom-check'."
(when window
@@ -385,6 +574,7 @@ bottom side of each frame. If an element is a number, this means
to display at most that many side windows on the corresponding
side. If an element is nil, this means there's no bound on the
number of slots on that side."
+ :version "24.1"
:risky t
:type
'(list
@@ -419,23 +609,282 @@ number of slots on that side."
(integer :tag "Number" :value 3 :size 5)))
:group 'windows)
+(defun window--major-non-side-window (&optional frame)
+ "Return the major non-side window of frame FRAME.
+The optional argument FRAME must be a live frame and defaults to
+the selected one.
+
+If FRAME has at least one side window, the major non-side window
+is either an internal non-side window such that all other
+non-side windows on FRAME descend from it, or the single live
+non-side window of FRAME. If FRAME has no side windows, return
+its root window."
+ (let ((frame (window-normalize-frame frame))
+ major sibling)
+ ;; Set major to the _last_ window found by `walk-window-tree' that
+ ;; is not a side window but has a side window as its sibling.
+ (walk-window-tree
+ (lambda (window)
+ (and (not (window-parameter window 'window-side))
+ (or (and (setq sibling (window-prev-sibling window))
+ (window-parameter sibling 'window-side))
+ (and (setq sibling (window-next-sibling window))
+ (window-parameter sibling 'window-side)))
+ (setq major window)))
+ frame t)
+ (or major (frame-root-window frame))))
+
+(defun window--major-side-window (side)
+ "Return major side window on SIDE.
+SIDE must be one of the symbols `left', `top', `right' or
+`bottom'. Return nil if no such window exists."
+ (let ((root (frame-root-window))
+ window)
+ ;; (1) If a window on the opposite side exists, return that window's
+ ;; sibling.
+ ;; (2) If the new window shall span the entire side, return the
+ ;; frame's root window.
+ ;; (3) If a window on an orthogonal side exists, return that
+ ;; window's sibling.
+ ;; (4) Otherwise return the frame's root window.
+ (cond
+ ((or (and (eq side 'left)
+ (setq window (window-with-parameter 'window-side 'right nil t)))
+ (and (eq side 'top)
+ (setq window (window-with-parameter 'window-side 'bottom nil t))))
+ (window-prev-sibling window))
+ ((or (and (eq side 'right)
+ (setq window (window-with-parameter 'window-side 'left nil t)))
+ (and (eq side 'bottom)
+ (setq window (window-with-parameter 'window-side 'top nil t))))
+ (window-next-sibling window))
+ ((memq side '(left right))
+ (cond
+ (window-sides-vertical
+ root)
+ ((setq window (window-with-parameter 'window-side 'top nil t))
+ (window-next-sibling window))
+ ((setq window (window-with-parameter 'window-side 'bottom nil t))
+ (window-prev-sibling window))
+ (t root)))
+ ((memq side '(top bottom))
+ (cond
+ ((not window-sides-vertical)
+ root)
+ ((setq window (window-with-parameter 'window-side 'left nil t))
+ (window-next-sibling window))
+ ((setq window (window-with-parameter 'window-side 'right nil t))
+ (window-prev-sibling window))
+ (t root))))))
+
+(defun display-buffer-in-major-side-window (buffer side slot &optional alist)
+ "Display BUFFER in a new window on SIDE of the selected frame.
+SIDE must be one of `left', `top', `right' or `bottom'. SLOT
+specifies the slot to use. ALIST is an association list of
+symbols and values as passed to `display-buffer-in-side-window'.
+This function may be called only if no window on SIDE exists yet.
+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)))
+ (major (window--major-side-window side))
+ (selected-window (selected-window))
+ (on-side (cond
+ ((eq side 'top) 'above)
+ ((eq side 'bottom) 'below)
+ (t side)))
+ ;; The following two bindings will tell `split-window' to take
+ ;; the space for the new window from `major' and not make a new
+ ;; parent window unless needed.
+ (window-combination-resize 'side)
+ (window-combination-limit nil)
+ (new (split-window major nil on-side))
+ fun)
+ (when new
+ ;; Initialize `window-side' parameter of new window to SIDE.
+ (set-window-parameter new 'window-side side)
+ ;; Install `window-slot' parameter of new window.
+ (set-window-parameter new 'window-slot slot)
+ ;; Install `delete-window' parameter thus making sure that when
+ ;; 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 alist 'side))))
+
+(defun delete-side-window (window)
+ "Delete side window WINDOW."
+ (let ((window-combination-resize
+ (window-parameter (window-parent window) 'window-side))
+ (ignore-window-parameters t))
+ (delete-window window)))
+
+(defun display-buffer-in-side-window (buffer alist)
+ "Display BUFFER in a window on side SIDE of the selected frame.
+ALIST is an association list of symbols and values. The
+following symbols can be used:
+
+`side' denotes the side of the existing window where the new
+ window shall be located. Valid values are `bottom', `right',
+ `top' and `left'. The default is `bottom'.
+
+`slot' if non-nil, specifies the window slot where to display
+ BUFFER. A value of zero or nil means use the middle slot on
+ the specified side. A negative value means use a slot
+ preceding (that is, above or on the left of) the middle slot.
+ A positive value means use a slot following (that is, below or
+ on the right of) the middle slot. The default is zero."
+ (let ((side (or (cdr (assq 'side alist)) 'bottom))
+ (slot (or (cdr (assq 'slot alist)) 0))
+ new)
+ (cond
+ ((not (memq side '(top bottom left right)))
+ (error "Invalid side %s specified" side))
+ ((not (numberp slot))
+ (error "Invalid slot %s specified" slot)))
+
+ (let* ((major (window-with-parameter 'window-side side nil t))
+ ;; `major' is the major window on SIDE, `windows' the list of
+ ;; life windows on SIDE.
+ (windows
+ (when major
+ (let (windows)
+ (walk-window-tree
+ (lambda (window)
+ (when (eq (window-parameter window 'window-side) side)
+ (setq windows (cons window windows)))))
+ (nreverse windows))))
+ (slots (when major (max 1 (window-child-count major))))
+ (max-slots
+ (nth (cond
+ ((eq side 'left) 0)
+ ((eq side 'top) 1)
+ ((eq side 'right) 2)
+ ((eq side 'bottom) 3))
+ window-sides-slots))
+ (selected-window (selected-window))
+ window this-window this-slot prev-window next-window
+ best-window best-slot abs-slot new-window)
+
+ (cond
+ ((and (numberp max-slots) (<= max-slots 0))
+ ;; No side-slots available on this side. Don't create an error,
+ ;; just return nil.
+ nil)
+ ((not windows)
+ ;; No major window exists on this side, make one.
+ (display-buffer-in-major-side-window buffer side slot alist))
+ (t
+ ;; Scan windows on SIDE.
+ (catch 'found
+ (dolist (window windows)
+ (setq this-slot (window-parameter window 'window-slot))
+ (cond
+ ;; The following should not happen and probably be checked
+ ;; by window--side-check.
+ ((not (numberp this-slot)))
+ ((= this-slot slot)
+ ;; A window with a matching slot has been found.
+ (setq this-window window)
+ (throw 'found t))
+ (t
+ ;; Check if this window has a better slot value wrt the
+ ;; slot of the window we want.
+ (setq abs-slot
+ (if (or (and (> this-slot 0) (> slot 0))
+ (and (< this-slot 0) (< slot 0)))
+ (abs (- slot this-slot))
+ (+ (abs slot) (abs this-slot))))
+ (unless (and best-slot (<= best-slot abs-slot))
+ (setq best-window window)
+ (setq best-slot abs-slot))
+ (cond
+ ((<= this-slot slot)
+ (setq prev-window window))
+ ((not next-window)
+ (setq next-window window)))))))
+
+ ;; `this-window' is the first window with the same SLOT.
+ ;; `prev-window' is the window with the largest slot < SLOT. A new
+ ;; window will be created after it.
+ ;; `next-window' is the window with the smallest slot > SLOT. A new
+ ;; window will be created before it.
+ ;; `best-window' is the window with the smallest absolute difference
+ ;; of its slot and SLOT.
+
+ ;; Note: We dedicate the window used softly to its buffer to
+ ;; avoid that "other" (non-side) buffer display functions steal
+ ;; it from us. This must eventually become customizable via
+ ;; ALIST (or, better, avoided in the "other" functions).
+ (or (and this-window
+ ;; Reuse `this-window'.
+ (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'.
+ (let ((next-side
+ (if (memq side '(left right)) 'above 'left))
+ (window-combination-resize 'side))
+ (setq window (split-window next-window nil next-side))
+ ;; When the new window is deleted, its space
+ ;; is returned to other side windows.
+ (set-window-parameter
+ window 'delete-window 'delete-side-window)
+ window))
+ (and prev-window
+ ;; Make new window after `prev-window'.
+ (let ((prev-side
+ (if (memq side '(left right)) 'below 'right))
+ (window-combination-resize 'side))
+ (setq window (split-window prev-window nil prev-side))
+ ;; When the new window is deleted, its space
+ ;; is returned to other side windows.
+ (set-window-parameter
+ window 'delete-window 'delete-side-window)
+ window)))
+ (set-window-parameter window 'window-slot slot)
+ (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 alist 'side)))))))))
+
(defun window--side-check (&optional frame)
- "Check the window-side parameter of all windows on FRAME.
-FRAME defaults to the selected frame. If the configuration is
-invalid, reset all window-side parameters to nil.
-
-A valid configuration has to preserve the following invariant:
-
-- If a window has a non-nil window-side parameter, it must have a
- parent window and the parent window's window-side parameter
- must be either nil or the same as for window.
-
-- If windows with non-nil window-side parameters exist, there
- must be at most one window of each side and non-side with a
- parent whose window-side parameter is nil and there must be no
- leaf window whose window-side parameter is nil."
- (let (normal none left top right bottom
- side parent parent-side code)
+ "Check the side window configuration of FRAME.
+FRAME defaults to the selected frame.
+
+A valid side window configuration preserves the following two
+invariants:
+
+- If there exists a window whose window-side parameter is
+ non-nil, there must exist at least one live window whose
+ window-side parameter is nil.
+
+- If a window W has a non-nil window-side parameter (i) it must
+ have a parent window and that parent's window-side parameter
+ must be either nil or the same as for W, and (ii) any child
+ window of W must have the same window-side parameter as W.
+
+If the configuration is invalid, reset the window-side parameters
+of all windows on FRAME to nil."
+ (let (left top right bottom none side parent parent-side)
(when (or (catch 'reset
(walk-window-tree
(lambda (window)
@@ -451,40 +900,34 @@ A valid configuration has to preserve the following invariant:
;; A parent whose window-side is non-nil must
;; have a child with the same window-side.
(throw 'reset t)))
- ;; Now check that there's more than one main window
- ;; for any of none, left, top, right and bottom.
- ((eq side 'none)
- (if none
- (throw 'reset t)
+ ((not side)
+ (when (window-buffer window)
+ ;; Record that we have at least one non-side,
+ ;; live window.
(setq none t)))
+ ((if (memq side '(left top))
+ (window-prev-sibling window)
+ (window-next-sibling window))
+ ;; Left and top major side windows must not have a
+ ;; previous sibling, right and bottom major side
+ ;; windows must not have a next sibling.
+ (throw 'reset t))
+ ;; Now check that there's no more than one major
+ ;; window for any of left, top, right and bottom.
((eq side 'left)
- (if left
- (throw 'reset t)
- (setq left t)))
+ (if left (throw 'reset t) (setq left t)))
((eq side 'top)
- (if top
- (throw 'reset t)
- (setq top t)))
+ (if top (throw 'reset t) (setq top t)))
((eq side 'right)
- (if right
- (throw 'reset t)
- (setq right t)))
+ (if right (throw 'reset t) (setq right t)))
((eq side 'bottom)
- (if bottom
- (throw 'reset t)
- (setq bottom t)))
- ((window-buffer window)
- ;; A leaf window without window-side parameter,
- ;; record its existence.
- (setq normal t))))
+ (if bottom (throw 'reset t) (setq bottom t)))
+ (t
+ (throw 'reset t))))
frame t))
- (if none
- ;; At least one non-side window exists, so there must
- ;; be at least one side-window and no normal window.
- (or (not (or left top right bottom)) normal)
- ;; No non-side window exists, so there must be no side
- ;; window either.
- (or left top right bottom)))
+ ;; If there's a side window, there must be at least one
+ ;; non-side window.
+ (and (or left top right bottom) (not none)))
(walk-window-tree
(lambda (window)
(set-window-parameter window 'window-side nil))
@@ -508,22 +951,24 @@ unless it has no other choice (like when deleting a neighboring
window).")
(make-variable-buffer-local 'window-size-fixed)
-(defun window--size-ignore (window ignore)
+(defun window--size-ignore-p (window ignore)
"Return non-nil if IGNORE says to ignore size restrictions for WINDOW."
(if (window-valid-p ignore) (eq window ignore) ignore))
(defun window-min-size (&optional window horizontal ignore)
- "Return the minimum number of lines of WINDOW.
-WINDOW can be an arbitrary window and defaults to the selected
-one. Optional argument HORIZONTAL non-nil means return the
-minimum number of columns of WINDOW.
+ "Return the minimum size of WINDOW.
+WINDOW must be a valid window and defaults to the selected one.
+Optional argument HORIZONTAL non-nil means return the minimum
+number of columns of WINDOW; otherwise return the minimum number
+of WINDOW's lines.
-Optional argument IGNORE non-nil means ignore any restrictions
+Optional argument IGNORE, if non-nil, means ignore restrictions
imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. IGNORE equal `safe' means live
+`window-min-width' settings. If IGNORE equals `safe', live
windows may get as small as `window-safe-min-height' lines and
-`window-safe-min-width' columns. IGNORE a window means ignore
-restrictions for that window only."
+`window-safe-min-width' columns. If IGNORE is a window, ignore
+restrictions for that window only. Any other non-nil value
+means ignore all of the above restrictions for all windows."
(window--min-size-1
(window-normalize-window window) horizontal ignore))
@@ -549,7 +994,7 @@ restrictions for that window only."
value)
(with-current-buffer (window-buffer window)
(cond
- ((and (not (window--size-ignore window ignore))
+ ((and (not (window--size-ignore-p window ignore))
(window-size-fixed-p window horizontal))
;; The minimum size of a fixed size window is its size.
(window-total-size window horizontal))
@@ -578,7 +1023,7 @@ restrictions for that window only."
(ceiling (or (frame-parameter frame 'scroll-bar-width) 14)
(frame-char-width)))
(t 0)))
- (if (and (not (window--size-ignore window ignore))
+ (if (and (not (window--size-ignore-p window ignore))
(numberp window-min-width))
window-min-width
0))))
@@ -588,13 +1033,14 @@ restrictions for that window only."
(max (+ window-safe-min-height
(if header-line-format 1 0)
(if mode-line-format 1 0))
- (if (and (not (window--size-ignore window ignore))
+ (if (and (not (window--size-ignore-p window ignore))
(numberp window-min-height))
window-min-height
0))))))))
(defun window-sizable (window delta &optional horizontal ignore)
"Return DELTA if DELTA lines can be added to WINDOW.
+WINDOW must be a valid window and defaults to the selected one.
Optional argument HORIZONTAL non-nil means return DELTA if DELTA
columns can be added to WINDOW. A return value of zero means
that no lines (or columns) can be added to WINDOW.
@@ -613,19 +1059,20 @@ columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
return the minimum value in the range DELTA..0 by which WINDOW
can be shrunk.
-Optional argument IGNORE non-nil means ignore any restrictions
+Optional argument IGNORE non-nil means ignore restrictions
imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. IGNORE equal `safe' means live
+`window-min-width' settings. If IGNORE equals `safe', live
windows may get as small as `window-safe-min-height' lines and
-`window-safe-min-width' columns. IGNORE any window means ignore
-restrictions for that window only."
+`window-safe-min-width' columns. If IGNORE is a window, ignore
+restrictions for that window only. Any other non-nil value means
+ignore all of the above restrictions for all windows."
(setq window (window-normalize-window window))
(cond
((< delta 0)
(max (- (window-min-size window horizontal ignore)
(window-total-size window horizontal))
delta))
- ((window--size-ignore window ignore)
+ ((window--size-ignore-p window ignore)
delta)
((> delta 0)
(if (window-size-fixed-p window horizontal)
@@ -635,6 +1082,7 @@ restrictions for that window only."
(defun window-sizable-p (window delta &optional horizontal ignore)
"Return t if WINDOW can be resized by DELTA lines.
+WINDOW must be a valid window and defaults to the selected one.
For the meaning of the arguments of this function see the
doc-string of `window-sizable'."
(setq window (window-normalize-window window))
@@ -677,9 +1125,9 @@ doc-string of `window-sizable'."
(defun window-size-fixed-p (&optional window horizontal)
"Return non-nil if WINDOW's height is fixed.
-WINDOW can be an arbitrary window and defaults to the selected
-window. Optional argument HORIZONTAL non-nil means return
-non-nil if WINDOW's width is fixed.
+WINDOW must be a valid window and defaults to the selected one.
+Optional argument HORIZONTAL non-nil means return non-nil if
+WINDOW's width is fixed.
If this function returns nil, this does not necessarily mean that
WINDOW can be resized in the desired direction. The function
@@ -706,7 +1154,7 @@ WINDOW can be resized in the desired direction. The function
((eq sub window)
(setq skip (eq trail 'before)))
(skip)
- ((and (not (window--size-ignore window ignore))
+ ((and (not (window--size-ignore-p window ignore))
(window-size-fixed-p sub horizontal)))
(t
;; We found a non-fixed-size child window.
@@ -727,26 +1175,27 @@ WINDOW can be resized in the desired direction. The function
(defun window-min-delta (&optional window horizontal ignore trail noup nodown)
"Return number of lines by which WINDOW can be shrunk.
-WINDOW can be an arbitrary window and defaults to the selected
-window. Return zero if WINDOW cannot be shrunk.
+WINDOW must be a valid window and defaults to the selected one.
+Return zero if WINDOW cannot be shrunk.
Optional argument HORIZONTAL non-nil means return number of
columns by which WINDOW can be shrunk.
-Optional argument IGNORE non-nil means ignore any restrictions
+Optional argument IGNORE non-nil means ignore restrictions
imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. IGNORE a window means ignore
-restrictions for that window only. IGNORE equal `safe' means
+`window-min-width' settings. If IGNORE is a window, ignore
+restrictions for that window only. If IGNORE equals `safe',
live windows may get as small as `window-safe-min-height' lines
-and `window-safe-min-width' columns.
+and `window-safe-min-width' columns. Any other non-nil value
+means ignore all of the above restrictions for all windows.
-Optional argument TRAIL `before' means only windows to the left
-of or above WINDOW can be enlarged. Optional argument TRAIL
-`after' means only windows to the right of or below WINDOW can be
-enlarged.
+Optional argument TRAIL restricts the windows that can be enlarged.
+If its value is `before', only windows to the left of or above WINDOW
+can be enlarged. If it is `after', only windows to the right of or
+below WINDOW can be enlarged.
Optional argument NOUP non-nil means don't go up in the window
-tree but try to enlarge windows within WINDOW's combination only.
+tree, but try to enlarge windows within WINDOW's combination only.
Optional argument NODOWN non-nil means don't check whether WINDOW
itself (and its child windows) can be shrunk; check only whether
@@ -795,7 +1244,7 @@ at least one other window can be enlarged appropriately."
;; child window is fixed-size.
(while sub
(when (and (not (eq sub window))
- (not (window--size-ignore sub ignore))
+ (not (window--size-ignore-p sub ignore))
(window-size-fixed-p sub horizontal))
(throw 'fixed delta))
(setq sub (window-right sub))))
@@ -807,24 +1256,25 @@ at least one other window can be enlarged appropriately."
(window--max-delta-1 parent delta horizontal ignore trail))))))
(defun window-max-delta (&optional window horizontal ignore trail noup nodown)
- "Return maximum number of lines WINDOW by which WINDOW can be enlarged.
-WINDOW can be an arbitrary window and defaults to the selected
-window. The return value is zero if WINDOW cannot be enlarged.
+ "Return maximum number of lines by which WINDOW can be enlarged.
+WINDOW must be a valid window and defaults to the selected one.
+The return value is zero if WINDOW cannot be enlarged.
Optional argument HORIZONTAL non-nil means return maximum number
of columns by which WINDOW can be enlarged.
-Optional argument IGNORE non-nil means ignore any restrictions
+Optional argument IGNORE non-nil means ignore restrictions
imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. IGNORE a window means ignore
-restrictions for that window only. IGNORE equal `safe' means
+`window-min-width' settings. If IGNORE is a window, ignore
+restrictions for that window only. If IGNORE equals `safe',
live windows may get as small as `window-safe-min-height' lines
-and `window-safe-min-width' columns.
+and `window-safe-min-width' columns. Any other non-nil value means
+ignore all of the above restrictions for all windows.
-Optional argument TRAIL `before' means only windows to the left
-of or below WINDOW can be shrunk. Optional argument TRAIL
-`after' means only windows to the right of or above WINDOW can be
-shrunk.
+Optional argument TRAIL restricts the windows that can be enlarged.
+If its value is `before', only windows to the left of or above WINDOW
+can be enlarged. If it is `after', only windows to the right of or
+below WINDOW can be enlarged.
Optional argument NOUP non-nil means don't go up in the window
tree but try to obtain the entire space from windows within
@@ -834,7 +1284,7 @@ Optional argument NODOWN non-nil means do not check whether
WINDOW itself (and its child windows) can be enlarged; check
only whether other windows can be shrunk appropriately."
(setq window (window-normalize-window window))
- (if (and (not (window--size-ignore window ignore))
+ (if (and (not (window--size-ignore-p window ignore))
(not nodown) (window-size-fixed-p window horizontal))
;; With IGNORE and NOWDON nil return zero if WINDOW has fixed
;; size.
@@ -845,6 +1295,7 @@ only whether other windows can be shrunk appropriately."
;; Make NOUP also inhibit the min-size check.
(defun window--resizable (window delta &optional horizontal ignore trail noup nodown)
"Return DELTA if WINDOW can be resized vertically by DELTA lines.
+WINDOW must be a valid window and defaults to the selected one.
Optional argument HORIZONTAL non-nil means return DELTA if WINDOW
can be resized horizontally by DELTA columns. A return value of
zero means that WINDOW is not resizable.
@@ -859,12 +1310,13 @@ columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
return the minimum value in the range DELTA..0 that can be used
for shrinking WINDOW.
-Optional argument IGNORE non-nil means ignore any restrictions
+Optional argument IGNORE non-nil means ignore restrictions
imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. IGNORE a window means ignore
-restrictions for that window only. IGNORE equal `safe' means
+`window-min-width' settings. If IGNORE is a window, ignore
+restrictions for that window only. If IGNORE equals `safe',
live windows may get as small as `window-safe-min-height' lines
-and `window-safe-min-width' columns.
+and `window-safe-min-width' columns. Any other non-nil value
+means ignore all of the above restrictions for all windows.
Optional argument TRAIL `before' means only windows to the left
of or below WINDOW can be shrunk. Optional argument TRAIL
@@ -890,6 +1342,7 @@ violate size restrictions of WINDOW or its child windows."
(defun window--resizable-p (window delta &optional horizontal ignore trail noup nodown)
"Return t if WINDOW can be resized vertically by DELTA lines.
+WINDOW must be a valid window and defaults to the selected one.
For the meaning of the arguments of this function see the
doc-string of `window--resizable'."
(setq window (window-normalize-window window))
@@ -901,6 +1354,7 @@ doc-string of `window--resizable'."
(defun window-resizable (window delta &optional horizontal ignore)
"Return DELTA if WINDOW can be resized vertically by DELTA lines.
+WINDOW must be a valid window and defaults to the selected one.
Optional argument HORIZONTAL non-nil means return DELTA if WINDOW
can be resized horizontally by DELTA columns. A return value of
zero means that WINDOW is not resizable.
@@ -915,18 +1369,19 @@ columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
return the minimum value in the range DELTA..0 that can be used
for shrinking WINDOW.
-Optional argument IGNORE non-nil means ignore any restrictions
+Optional argument IGNORE non-nil means ignore restrictions
imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. IGNORE a window means ignore
-restrictions for that window only. IGNORE equal `safe' means
+`window-min-width' settings. If IGNORE is a window, ignore
+restrictions for that window only. If IGNORE equals `safe',
live windows may get as small as `window-safe-min-height' lines
-and `window-safe-min-width' columns."
+and `window-safe-min-width' columns. Any other non-nil value
+means ignore all of the above restrictions for all windows."
(setq window (window-normalize-window window))
(window--resizable window delta horizontal ignore))
(defun window-total-size (&optional window horizontal)
- "Return the total height or width of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+ "Return the total height or width of WINDOW.
+WINDOW must be a valid window and defaults to the selected one.
If HORIZONTAL is omitted or nil, return the total height of
WINDOW, in lines, like `window-total-height'. Otherwise return
@@ -940,28 +1395,27 @@ the total width, in columns, like `window-total-width'."
;; See discussion in bug#4543.
(defun window-full-height-p (&optional window)
- "Return t if WINDOW is as high as the containing frame.
+ "Return t if WINDOW is as high as its containing frame.
More precisely, return t if and only if the total height of
WINDOW equals the total height of the root window of WINDOW's
-frame. WINDOW can be any window and defaults to the selected
-one."
+frame. WINDOW must be a valid window and defaults to the
+selected one."
(setq window (window-normalize-window window))
(= (window-total-size window)
(window-total-size (frame-root-window window))))
(defun window-full-width-p (&optional window)
- "Return t if WINDOW is as wide as the containing frame.
+ "Return t if WINDOW is as wide as its containing frame.
More precisely, return t if and only if the total width of WINDOW
equals the total width of the root window of WINDOW's frame.
-WINDOW can be any window and defaults to the selected one."
+WINDOW must be a valid window and defaults to the selected one."
(setq window (window-normalize-window window))
(= (window-total-size window t)
(window-total-size (frame-root-window window) t)))
(defun window-body-size (&optional window horizontal)
"Return the height or width of WINDOW's text area.
-If WINDOW is omitted or nil, it defaults to the selected window.
-Signal an error if the window is not live.
+WINDOW must be a live window and defaults to the selected one.
If HORIZONTAL is omitted or nil, return the height of the text
area, like `window-body-height'. Otherwise, return the width of
@@ -1043,37 +1497,11 @@ windows nor the buffer list."
(dolist (walk-windows-window (window-list-1 nil minibuf all-frames))
(funcall fun walk-windows-window))))
-(defun window-point-1 (&optional window)
- "Return value of WINDOW's point.
-WINDOW can be any live window and defaults to the selected one.
-
-This function is like `window-point' with one exception: If
-WINDOW is selected, it returns the value of `point' of WINDOW's
-buffer regardless of whether that buffer is current or not."
- (setq window (window-normalize-window window t))
- (if (eq window (selected-window))
- (with-current-buffer (window-buffer window)
- (point))
- (window-point window)))
-
-(defun set-window-point-1 (window pos)
- "Set value of WINDOW's point to POS.
-WINDOW can be any live window and defaults to the selected one.
-
-This function is like `set-window-point' with one exception: If
-WINDOW is selected, it moves `point' of WINDOW's buffer to POS
-regardless of whether that buffer is current or not."
- (setq window (window-normalize-window window t))
- (if (eq window (selected-window))
- (with-current-buffer (window-buffer window)
- (goto-char pos))
- (set-window-point window pos)))
-
(defun window-at-side-p (&optional window side)
"Return t if WINDOW is at SIDE of its containing frame.
-WINDOW can be any window and defaults to the selected one. SIDE
-can be any of the symbols `left', `top', `right' or `bottom'.
-The default value nil is handled like `bottom'."
+WINDOW must be a valid window and defaults to the selected one.
+SIDE can be any of the symbols `left', `top', `right' or
+`bottom'. The default value nil is handled like `bottom'."
(setq window (window-normalize-window window))
(let ((edge
(cond
@@ -1095,7 +1523,7 @@ SIDE can be any of the symbols `left', `top', `right' or
(lambda (window)
(when (window-at-side-p window side)
(setq windows (cons window windows))))
- frame)
+ frame nil 'nomini)
(nreverse windows)))
(defun window--in-direction-2 (window posn &optional horizontal)
@@ -1110,12 +1538,25 @@ SIDE can be any of the symbols `left', `top', `right' or
(- left posn)
(- posn left (window-total-width window))))))
+;; Predecessors to the below have been devised by Julian Assange in
+;; change-windows-intuitively.el and Hovav Shacham in windmove.el.
+;; Neither of these allow to selectively ignore specific windows
+;; (windows whose `no-other-window' parameter is non-nil) as targets of
+;; the movement.
(defun window-in-direction (direction &optional window ignore)
"Return window in DIRECTION as seen from WINDOW.
+More precisely, return the nearest window in direction DIRECTION
+as seen from the position of `window-point' in window WINDOW.
DIRECTION must be one of `above', `below', `left' or `right'.
WINDOW must be a live window and defaults to the selected one.
-IGNORE, when non-nil means a window can be returned even if its
-`no-other-window' parameter is non-nil."
+
+Do not return a window whose `no-other-window' parameter is
+non-nil. If the nearest window's `no-other-window' parameter is
+non-nil, try to find another window in the indicated direction.
+If, however, the optional argument IGNORE is non-nil, return that
+window even if its `no-other-window' parameter is non-nil.
+
+Return nil if no suitable window can be found."
(setq window (window-normalize-window window t))
(unless (memq direction '(above below left right))
(error "Wrong direction %s" direction))
@@ -1127,7 +1568,7 @@ IGNORE, when non-nil means a window can be returned even if its
(last (+ first (if hor
(window-total-width window)
(window-total-height window))))
- (posn-cons (nth 6 (posn-at-point (window-point-1 window) window)))
+ (posn-cons (nth 6 (posn-at-point (window-point window) window)))
;; The column / row value of `posn-at-point' can be nil for the
;; mini-window, guard against that.
(posn (if hor
@@ -1202,7 +1643,7 @@ IGNORE, when non-nil means a window can be returned even if its
(setq best-edge-2 w-top)
(setq best-diff-2 best-diff-2-new)
(setq best-2 w)))))))
- (window-frame window))
+ frame)
(or best best-2)))
(defun get-window-with-predicate (predicate &optional minibuf all-frames default)
@@ -1248,12 +1689,14 @@ and no others."
(defalias 'some-window 'get-window-with-predicate)
-(defun get-lru-window (&optional all-frames dedicated)
+(defun get-lru-window (&optional all-frames dedicated not-selected)
"Return the least recently used window on frames specified by ALL-FRAMES.
Return a full-width window if possible. A minibuffer window is
never a candidate. A dedicated window is never a candidate
unless DEDICATED is non-nil, so if all windows are dedicated, the
value is nil. Avoid returning the selected window if possible.
+Optional argument NOT-SELECTED non-nil means never return the
+selected window.
The following non-nil values of the optional argument ALL-FRAMES
have special meanings:
@@ -1272,7 +1715,8 @@ Any other value of ALL-FRAMES means consider all windows on the
selected frame and no others."
(let (best-window best-time second-best-window second-best-time time)
(dolist (window (window-list-1 nil 'nomini all-frames))
- (when (or dedicated (not (window-dedicated-p window)))
+ (when (and (or dedicated (not (window-dedicated-p window)))
+ (or (not not-selected) (not (eq window (selected-window)))))
(setq time (window-use-time window))
(if (or (eq window (selected-window))
(not (window-full-width-p window)))
@@ -1284,9 +1728,12 @@ selected frame and no others."
(setq best-window window)))))
(or best-window second-best-window)))
-(defun get-mru-window (&optional all-frames)
+(defun get-mru-window (&optional all-frames dedicated not-selected)
"Return the most recently used window on frames specified by ALL-FRAMES.
-Do not return a minibuffer window.
+A minibuffer window is never a candidate. A dedicated window is
+never a candidate unless DEDICATED is non-nil, so if all windows
+are dedicated, the value is nil. Optional argument NOT-SELECTED
+non-nil means never return the selected window.
The following non-nil values of the optional argument ALL-FRAMES
have special meanings:
@@ -1306,16 +1753,19 @@ selected frame and no others."
(let (best-window best-time time)
(dolist (window (window-list-1 nil 'nomini all-frames))
(setq time (window-use-time window))
- (when (or (not best-time) (> time best-time))
+ (when (and (or dedicated (not (window-dedicated-p window)))
+ (or (not not-selected) (not (eq window (selected-window))))
+ (or (not best-time) (> time best-time)))
(setq best-time time)
(setq best-window window)))
best-window))
-(defun get-largest-window (&optional all-frames dedicated)
+(defun get-largest-window (&optional all-frames dedicated not-selected)
"Return the largest window on frames specified by ALL-FRAMES.
A minibuffer window is never a candidate. A dedicated window is
never a candidate unless DEDICATED is non-nil, so if all windows
-are dedicated, the value is nil.
+are dedicated, the value is nil. Optional argument NOT-SELECTED
+non-nil means never return the selected window.
The following non-nil values of the optional argument ALL-FRAMES
have special meanings:
@@ -1335,7 +1785,8 @@ selected frame and no others."
(let ((best-size 0)
best-window size)
(dolist (window (window-list-1 nil 'nomini all-frames))
- (when (or dedicated (not (window-dedicated-p window)))
+ (when (and (or dedicated (not (window-dedicated-p window)))
+ (or (not not-selected) (not (eq window (selected-window)))))
(setq size (* (window-total-size window)
(window-total-size window t)))
(when (> size best-size)
@@ -1419,7 +1870,7 @@ windows."
(defun window--resize-mini-window (window delta)
"Resize minibuffer window WINDOW by DELTA lines.
If WINDOW cannot be resized by DELTA lines make it as large (or
-as small) as possible but don't signal an error."
+as small) as possible, but don't signal an error."
(when (window-minibuffer-p window)
(let* ((frame (window-frame window))
(root (frame-root-window frame))
@@ -1460,12 +1911,13 @@ horizontally by DELTA columns. In this case a positive DELTA
means enlarge WINDOW by DELTA columns. DELTA negative means
WINDOW shall be shrunk by -DELTA columns.
-Optional argument IGNORE non-nil means ignore any restrictions
+Optional argument IGNORE non-nil means ignore restrictions
imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. IGNORE any window means ignore
-restrictions for that window only. IGNORE equal `safe' means
+`window-min-width' settings. If IGNORE is a window, ignore
+restrictions for that window only. If IGNORE equals `safe',
live windows may get as small as `window-safe-min-height' lines
-and `window-safe-min-width' columns.
+and `window-safe-min-width' columns. Any other non-nil value
+means ignore all of the above restrictions for all windows.
This function resizes other windows proportionally and never
deletes any windows. If you want to move only the low (right)
@@ -1473,12 +1925,24 @@ edge of WINDOW consider using `adjust-window-trailing-edge'
instead."
(setq window (window-normalize-window window))
(let* ((frame (window-frame window))
+ (minibuffer-window (minibuffer-window frame))
sibling)
(cond
((eq window (frame-root-window frame))
(error "Cannot resize the root window of a frame"))
((window-minibuffer-p window)
- (window--resize-mini-window window delta))
+ (if horizontal
+ (error "Cannot resize minibuffer window horizontally")
+ (window--resize-mini-window window delta)))
+ ((and (not horizontal)
+ (window-full-height-p window)
+ (eq (window-frame minibuffer-window) frame)
+ (or (not resize-mini-windows)
+ (eq minibuffer-window (active-minibuffer-window))))
+ ;; If WINDOW is full height and either `resize-mini-windows' is
+ ;; nil or the minibuffer window is active, resize the minibuffer
+ ;; window.
+ (window--resize-mini-window minibuffer-window (- delta)))
((window--resizable-p window delta horizontal ignore)
(window--resize-reset frame horizontal)
(window--resize-this-window window delta horizontal ignore t)
@@ -1515,9 +1979,9 @@ HORIZONTAL non-nil means set the new normal width of these
windows. WINDOW specifies a child window of PARENT that has been
resized by THIS-DELTA lines (columns).
-Optional argument TRAIL either 'before or 'after means set values
-for windows before or after WINDOW only. Optional argument
-OTHER-DELTA a number specifies that this many lines (columns)
+Optional argument TRAIL either `before' or `after' means set values
+only for windows before or after WINDOW. Optional argument
+OTHER-DELTA, a number, specifies that this many lines (columns)
have been obtained from (or returned to) an ancestor window of
PARENT in order to resize WINDOW."
(let* ((delta-normal
@@ -1617,12 +2081,13 @@ be a horizontally combined internal window.
WINDOW, if specified, must denote a child window of PARENT that
is resized by DELTA lines.
-Optional argument IGNORE non-nil means ignore any restrictions
+Optional argument IGNORE non-nil means ignore restrictions
imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. IGNORE equal `safe' means live
+`window-min-width' settings. If IGNORE equals `safe', live
windows may get as small as `window-safe-min-height' lines and
-`window-safe-min-width' columns. IGNORE any window means ignore
-restrictions for that window only.
+`window-safe-min-width' columns. If IGNORE is a window, ignore
+restrictions for that window only. Any other non-nil value means
+ignore all of the above restrictions for all windows.
Optional arguments TRAIL and EDGE, when non-nil, restrict the set
of windows that shall be resized. If TRAIL equals `before',
@@ -1633,9 +2098,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
@@ -1679,7 +2144,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)
@@ -1708,14 +2173,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
@@ -1725,7 +2190,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)))
@@ -1742,7 +2207,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
@@ -1751,7 +2216,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)))
@@ -1763,7 +2228,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)))
@@ -1781,7 +2246,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.
@@ -1789,12 +2254,13 @@ Optional argument HORIZONTAL non-nil means resize other windows
when WINDOW is resized horizontally by DELTA columns. WINDOW
itself is not resized by this function.
-Optional argument IGNORE non-nil means ignore any restrictions
+Optional argument IGNORE non-nil means ignore restrictions
imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. IGNORE equal `safe' means live
+`window-min-width' settings. If IGNORE equals `safe', live
windows may get as small as `window-safe-min-height' lines and
-`window-safe-min-width' columns. IGNORE any window means ignore
-restrictions for that window only.
+`window-safe-min-width' columns. If IGNORE is a window, ignore
+restrictions for that window only. Any other non-nil value means
+ignore all of the above restrictions for all windows.
Optional arguments TRAIL and EDGE, when non-nil, refine the set
of windows that shall be resized. If TRAIL equals `before',
@@ -1807,8 +2273,7 @@ preferably only resize windows adjacent to EDGE."
(if (window-combined-p sub horizontal)
;; In an iso-combination try to extract DELTA from WINDOW's
;; siblings.
- (let ((first sub)
- (skip (eq trail 'after))
+ (let ((skip (eq trail 'after))
this-delta other-delta)
;; Decide which windows shall be left alone.
(while sub
@@ -1822,7 +2287,7 @@ preferably only resize windows adjacent to EDGE."
;; Make sure this sibling is left alone when
;; resizing its siblings.
(set-window-new-normal sub 'ignore))
- ((or (window--size-ignore sub ignore)
+ ((or (window--size-ignore-p sub ignore)
(not (window-size-fixed-p sub horizontal)))
;; Set this-delta to t to signal that we found a sibling
;; of WINDOW whose size is not fixed.
@@ -1891,12 +2356,13 @@ preferably only resize windows adjacent to EDGE."
Optional argument HORIZONTAL non-nil means resize WINDOW
horizontally by DELTA columns.
-Optional argument IGNORE non-nil means ignore any restrictions
+Optional argument IGNORE non-nil means ignore restrictions
imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. IGNORE equal `safe' means live
+`window-min-width' settings. If IGNORE equals `safe', live
windows may get as small as `window-safe-min-height' lines and
-`window-safe-min-width' columns. IGNORE any window means ignore
-restrictions for that window only.
+`window-safe-min-width' columns. If IGNORE is a window, ignore
+restrictions for that window only. Any other non-nil value
+means ignore all of the above restrictions for all windows.
Optional argument ADD non-nil means add DELTA to the new total
size of WINDOW.
@@ -1959,49 +2425,64 @@ 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.
Optional argument HORIZONTAL non-nil means move WINDOW's right
-edge by DELTA columns. WINDOW defaults to the selected window.
+edge by DELTA columns. WINDOW must be a valid window and
+defaults to the selected one.
-If DELTA is greater zero, then move the edge downwards or to the
+If DELTA is greater than zero, move the edge downwards or to the
right. If DELTA is less than zero, move the edge upwards or to
the left. If the edge can't be moved by DELTA lines or columns,
move it as far as possible in the desired direction."
(setq window (window-normalize-window window))
- (let ((frame (window-frame window))
- (right window)
- left this-delta min-delta max-delta failed)
+ (let* ((frame (window-frame window))
+ (minibuffer-window (minibuffer-window frame))
+ (right window)
+ left this-delta min-delta max-delta)
;; Find the edge we want to move.
(while (and (or (not (window-combined-p right horizontal))
(not (window-right right)))
(setq right (window-parent right))))
(cond
- ((and (not right) (not horizontal) (not resize-mini-windows)
- (eq (window-frame (minibuffer-window frame)) frame))
- (window--resize-mini-window (minibuffer-window frame) (- delta)))
+ ((and (not right) (not horizontal)
+ ;; Resize the minibuffer window if it's on the same frame as
+ ;; and immediately below WINDOW and it's either active or
+ ;; `resize-mini-windows' is nil.
+ (eq (window-frame minibuffer-window) frame)
+ (= (nth 1 (window-edges minibuffer-window))
+ (nth 3 (window-edges window)))
+ (or (not resize-mini-windows)
+ (eq minibuffer-window (active-minibuffer-window))))
+ (window--resize-mini-window minibuffer-window (- delta)))
((or (not (setq left right)) (not (setq right (window-right right))))
(if horizontal
(error "No window on the right of this one")
@@ -2091,51 +2572,74 @@ move it as far as possible in the desired direction."
(error "Failed adjusting window %s" window)))))))
(defun enlarge-window (delta &optional horizontal)
- "Make selected window DELTA lines taller.
+ "Make the selected window DELTA lines taller.
Interactively, if no argument is given, make the selected window
one line taller. If optional argument HORIZONTAL is non-nil,
make selected window wider by DELTA columns. If DELTA is
-negative, shrink selected window by -DELTA lines or columns.
-Return nil."
+negative, shrink selected window by -DELTA lines or columns."
(interactive "p")
- (cond
- ((zerop delta))
- ((window-size-fixed-p nil horizontal)
- (error "Selected window has fixed size"))
- ((window--resizable-p nil delta horizontal)
- (window-resize nil delta horizontal))
- (t
- (window-resize
- nil (if (> delta 0)
- (window-max-delta nil horizontal)
- (- (window-min-delta nil horizontal)))
- horizontal))))
+ (let ((minibuffer-window (minibuffer-window)))
+ (cond
+ ((zerop delta))
+ ((window-size-fixed-p nil horizontal)
+ (error "Selected window has fixed size"))
+ ((window-minibuffer-p)
+ (if horizontal
+ (error "Cannot resize minibuffer window horizontally")
+ (window--resize-mini-window (selected-window) delta)))
+ ((and (not horizontal)
+ (window-full-height-p)
+ (eq (window-frame minibuffer-window) (selected-frame))
+ (not resize-mini-windows))
+ ;; If the selected window is full height and `resize-mini-windows'
+ ;; is nil, resize the minibuffer window.
+ (window--resize-mini-window minibuffer-window (- delta)))
+ ((window--resizable-p nil delta horizontal)
+ (window-resize nil delta horizontal))
+ (t
+ (window-resize
+ nil (if (> delta 0)
+ (window-max-delta nil horizontal)
+ (- (window-min-delta nil horizontal)))
+ horizontal)))))
(defun shrink-window (delta &optional horizontal)
- "Make selected window DELTA lines smaller.
+ "Make the selected window DELTA lines smaller.
Interactively, if no argument is given, make the selected window
one line smaller. If optional argument HORIZONTAL is non-nil,
make selected window narrower by DELTA columns. If DELTA is
negative, enlarge selected window by -DELTA lines or columns.
-Return nil."
+Also see the `window-min-height' variable."
(interactive "p")
- (cond
- ((zerop delta))
- ((window-size-fixed-p nil horizontal)
- (error "Selected window has fixed size"))
- ((window--resizable-p nil (- delta) horizontal)
- (window-resize nil (- delta) horizontal))
- (t
- (window-resize
- nil (if (> delta 0)
- (- (window-min-delta nil horizontal))
- (window-max-delta nil horizontal))
- horizontal))))
+ (let ((minibuffer-window (minibuffer-window)))
+ (cond
+ ((zerop delta))
+ ((window-size-fixed-p nil horizontal)
+ (error "Selected window has fixed size"))
+ ((window-minibuffer-p)
+ (if horizontal
+ (error "Cannot resize minibuffer window horizontally")
+ (window--resize-mini-window (selected-window) (- delta))))
+ ((and (not horizontal)
+ (window-full-height-p)
+ (eq (window-frame minibuffer-window) (selected-frame))
+ (not resize-mini-windows))
+ ;; If the selected window is full height and `resize-mini-windows'
+ ;; is nil, resize the minibuffer window.
+ (window--resize-mini-window minibuffer-window delta))
+ ((window--resizable-p nil (- delta) horizontal)
+ (window-resize nil (- delta) horizontal))
+ (t
+ (window-resize
+ nil (if (> delta 0)
+ (- (window-min-delta nil horizontal))
+ (window-max-delta nil horizontal))
+ horizontal)))))
(defun maximize-window (&optional window)
"Maximize WINDOW.
Make WINDOW as large as possible without deleting any windows.
-WINDOW can be any window and defaults to the selected window."
+WINDOW must be a valid window and defaults to the selected one."
(interactive)
(setq window (window-normalize-window window))
(window-resize window (window-max-delta window))
@@ -2144,7 +2648,7 @@ WINDOW can be any window and defaults to the selected window."
(defun minimize-window (&optional window)
"Minimize WINDOW.
Make WINDOW as small as possible without deleting any windows.
-WINDOW can be any window and defaults to the selected window."
+WINDOW must be a valid window and defaults to the selected one."
(interactive)
(setq window (window-normalize-window window))
(window-resize window (- (window-min-delta window)))
@@ -2300,8 +2804,8 @@ and no others."
;;; Deleting windows.
(defun window-deletable-p (&optional window)
"Return t if WINDOW can be safely deleted from its frame.
-Return `frame' if deleting WINDOW should also delete its
-frame."
+WINDOW must be a valid window and defaults to the selected one.
+Return `frame' if deleting WINDOW should also delete its frame."
(setq window (window-normalize-window window))
(unless ignore-window-parameters
@@ -2309,20 +2813,20 @@ frame."
(when (window-parameter window 'window-atom)
(setq window (window-atom-root window))))
- (let* ((parent (window-parent window))
- (frame (window-frame window))
- (buffer (window-buffer window)))
+ (let ((frame (window-frame window)))
(cond
((frame-root-window-p window)
;; WINDOW's frame can be deleted only if there are other frames
- ;; on the same terminal.
- (unless (eq frame (next-frame frame 0))
+ ;; on the same terminal, and it does not contain the active
+ ;; minibuffer.
+ (unless (or (eq frame (next-frame frame 0))
+ (let ((minibuf (active-minibuffer-window)))
+ (and minibuf (eq frame (window-frame minibuf)))))
'frame))
((or ignore-window-parameters
- (not (eq (window-parameter window 'window-side) 'none))
- (and parent (eq (window-parameter parent 'window-side) 'none)))
- ;; WINDOW can be deleted unless it is the main window of its
- ;; frame.
+ (not (eq window (window--major-non-side-window frame))))
+ ;; WINDOW can be deleted unless it is the major non-side window of
+ ;; its frame.
t))))
(defun window--in-subtree-p (window root)
@@ -2337,8 +2841,8 @@ frame."
(defun delete-window (&optional window)
"Delete WINDOW.
-WINDOW can be an arbitrary window and defaults to the selected
-one. Return nil.
+WINDOW must be a valid window and defaults to the selected one.
+Return nil.
If the variable `ignore-window-parameters' is non-nil or the
`delete-window' parameter of WINDOW equals t, do not process any
@@ -2349,8 +2853,9 @@ function.
Otherwise, if WINDOW is part of an atomic window, call
`delete-window' with the root of the atomic window as its
-argument. If WINDOW is the only window on its frame or the last
-non-side window, signal an error."
+argument. Signal an error if WINDOW is either the only window on
+its frame, the last non-side window, or part of an atomic window
+that is its frame's root window."
(interactive)
(setq window (window-normalize-window window))
(let* ((frame (window-frame window))
@@ -2372,13 +2877,13 @@ non-side window, signal an error."
((and (window-parameter window 'window-atom)
(setq atom-root (window-atom-root window))
(not (eq atom-root window)))
- (throw 'done (delete-window atom-root)))
- ((and (eq (window-parameter window 'window-side) 'none)
- (or (not parent)
- (not (eq (window-parameter parent 'window-side) 'none))))
- (error "Attempt to delete last non-side window"))
+ (if (eq atom-root (frame-root-window frame))
+ (error "Root of atomic window is root window of its frame")
+ (throw 'done (delete-window atom-root))))
((not parent)
- (error "Attempt to delete minibuffer or sole ordinary window")))
+ (error "Attempt to delete minibuffer or sole ordinary window"))
+ ((eq window (window--major-non-side-window frame))
+ (error "Attempt to delete last non-side window")))
(let* ((horizontal (window-left-child parent))
(size (window-total-size window horizontal))
@@ -2417,7 +2922,7 @@ non-side window, signal an error."
(defun delete-other-windows (&optional window)
"Make WINDOW fill its frame.
-WINDOW may be any window and defaults to the selected one.
+WINDOW must be a valid window and defaults to the selected one.
Return nil.
If the variable `ignore-window-parameters' is non-nil or the
@@ -2452,13 +2957,19 @@ window signal an error."
((and (window-parameter window 'window-atom)
(setq atom-root (window-atom-root window))
(not (eq atom-root window)))
- (throw 'done (delete-other-windows atom-root)))
- ((eq window-side 'none)
- ;; Set side-main to the major non-side window.
- (setq side-main (window-with-parameter 'window-side 'none frame t)))
+ (if (eq atom-root (frame-root-window frame))
+ (error "Root of atomic window is root window of its frame")
+ (throw 'done (delete-other-windows atom-root))))
((memq window-side window-sides)
- (error "Cannot make side window the only window")))
- ;; If WINDOW is the main non-side window, do nothing.
+ (error "Cannot make side window the only window"))
+ ((and (window-minibuffer-p window)
+ (not (eq window (frame-root-window window))))
+ (error "Can't expand minibuffer to full frame")))
+
+ ;; If WINDOW is the major non-side window, do nothing.
+ (if (window-with-parameter 'window-side)
+ (setq side-main (window--major-non-side-window frame))
+ (setq side-main (frame-root-window frame)))
(unless (eq window side-main)
(delete-other-windows-internal window side-main)
(run-window-configuration-change-hook frame)
@@ -2477,7 +2988,7 @@ This may be a useful alternative binding for \\[delete-other-windows]
(while (not (eq (setq w (next-window w 1)) window))
(let ((e (window-edges w)))
(when (and (= (car e) (car edges))
- (= (caddr e) (caddr edges)))
+ (= (nth 2 e) (nth 2 edges)))
(push w delenda))))
(mapc 'delete-window delenda)))
@@ -2532,7 +3043,7 @@ WINDOW must be a live window and defaults to the selected one."
;; Add an entry for buffer to WINDOW's previous buffers.
(with-current-buffer buffer
(let ((start (window-start window))
- (point (window-point-1 window)))
+ (point (window-point window)))
(setq entry
(cons buffer
(if entry
@@ -2541,8 +3052,10 @@ WINDOW must be a live window and defaults to the selected one."
(set-marker (nth 2 entry) point))
;; Make new markers.
(list (copy-marker start)
- (copy-marker point)))))
-
+ (copy-marker
+ ;; Preserve window-point-insertion-type
+ ;; (Bug#12588).
+ point window-point-insertion-type)))))
(set-window-prev-buffers
window (cons entry (window-prev-buffers window))))))))
@@ -2560,11 +3073,13 @@ WINDOW."
(defun set-window-buffer-start-and-point (window buffer &optional start point)
"Set WINDOW's buffer to BUFFER.
+WINDOW must be a live window and defaults to the selected one.
Optional argument START non-nil means set WINDOW's start position
to START. Optional argument POINT non-nil means set WINDOW's
point to POINT. If WINDOW is selected this also sets BUFFER's
`point' to POINT. If WINDOW is selected and the buffer it showed
before was current this also makes BUFFER the current buffer."
+ (setq window (window-normalize-window window t))
(let ((selected (eq window (selected-window)))
(current (eq (window-buffer window) (current-buffer))))
(set-window-buffer window buffer)
@@ -2574,22 +3089,50 @@ before was current this also makes BUFFER the current buffer."
;; Don't force window-start here (even if POINT is nil).
(set-window-start window start t))
(when point
- (set-window-point-1 window point))))
+ (set-window-point window point))))
+
+(defcustom switch-to-visible-buffer t
+ "If non-nil, allow switching to an already visible buffer.
+If this variable is non-nil, `switch-to-prev-buffer' and
+`switch-to-next-buffer' may switch to an already visible buffer
+provided the buffer was shown before in the window specified as
+argument to those functions. If this variable is nil,
+`switch-to-prev-buffer' and `switch-to-next-buffer' always try to
+avoid switching to a buffer that is already visible in another
+window on the same frame."
+ :type 'boolean
+ :version "24.1"
+ :group 'windows)
(defun switch-to-prev-buffer (&optional window bury-or-kill)
"In WINDOW switch to previous buffer.
WINDOW must be a live window and defaults to the selected one.
+Return the buffer switched to, nil if no suitable buffer could be
+found.
Optional argument BURY-OR-KILL non-nil means the buffer currently
shown in WINDOW is about to be buried or killed and consequently
-shall not be switched to in future invocations of this command."
+shall not be switched to in future invocations of this command.
+
+As a special case, if BURY-OR-KILL equals `append', this means to
+move the buffer to the end of WINDOW's previous buffers list so a
+future invocation of `switch-to-prev-buffer' less likely switches
+to it."
(interactive)
(let* ((window (window-normalize-window window t))
+ (frame (window-frame window))
(old-buffer (window-buffer window))
;; Save this since it's destroyed by `set-window-buffer'.
(next-buffers (window-next-buffers window))
+ (pred (frame-parameter frame 'buffer-predicate))
entry new-buffer killed-buffers visible)
+ (when (window-minibuffer-p window)
+ ;; Don't switch in minibuffer window.
+ (unless (setq window (minibuffer-selected-window))
+ (error "Window %s is a minibuffer window" window)))
+
(when (window-dedicated-p window)
+ ;; Don't switch in dedicated window.
(error "Window %s is dedicated to buffer %s" window old-buffer))
(catch 'found
@@ -2601,11 +3144,18 @@ shall not be switched to in future invocations of this command."
(not (setq killed-buffers
(cons new-buffer killed-buffers))))
(not (eq new-buffer old-buffer))
- (or bury-or-kill
- (not (memq new-buffer next-buffers))))
- (set-window-buffer-start-and-point
- window new-buffer (nth 1 entry) (nth 2 entry))
- (throw 'found t)))
+ (or (null pred) (funcall pred new-buffer))
+ ;; When BURY-OR-KILL is nil, avoid switching to a
+ ;; buffer in WINDOW's next buffers list.
+ (or bury-or-kill (not (memq new-buffer next-buffers))))
+ (if (and (not switch-to-visible-buffer)
+ (get-buffer-window new-buffer frame))
+ ;; Try to avoid showing a buffer visible in some other
+ ;; window.
+ (setq visible new-buffer)
+ (set-window-buffer-start-and-point
+ window new-buffer (nth 1 entry) (nth 2 entry))
+ (throw 'found t))))
;; Scan reverted buffer list of WINDOW's frame next, skipping
;; entries of next buffers. Note that when we bury or kill a
;; buffer we don't reverse the global buffer list to avoid showing
@@ -2613,15 +3163,17 @@ shall not be switched to in future invocations of this command."
;; buffer list in order to make sure that switching to the
;; previous/next buffer traverse it in opposite directions.
(dolist (buffer (if bury-or-kill
- (buffer-list (window-frame window))
- (nreverse (buffer-list (window-frame window)))))
+ (buffer-list frame)
+ (nreverse (buffer-list frame))))
(when (and (buffer-live-p buffer)
(not (eq buffer old-buffer))
+ (or (null pred) (funcall pred buffer))
(not (eq (aref (buffer-name buffer) 0) ?\s))
(or bury-or-kill (not (memq buffer next-buffers))))
- (if (get-buffer-window buffer)
+ (if (get-buffer-window buffer frame)
;; Try to avoid showing a buffer visible in some other window.
- (setq visible buffer)
+ (unless visible
+ (setq visible buffer))
(setq new-buffer buffer)
(set-window-buffer-start-and-point window new-buffer)
(throw 'found t))))
@@ -2635,6 +3187,7 @@ shall not be switched to in future invocations of this command."
(not (setq killed-buffers
(cons buffer killed-buffers))))
(not (eq buffer old-buffer))
+ (or (null pred) (funcall pred buffer))
(setq entry (assq buffer (window-prev-buffers window))))
(setq new-buffer buffer)
(set-window-buffer-start-and-point
@@ -2647,12 +3200,20 @@ shall not be switched to in future invocations of this command."
(set-window-buffer-start-and-point window new-buffer)))
(if bury-or-kill
- ;; Remove `old-buffer' from WINDOW's previous and (restored list
- ;; of) next buffers.
- (progn
+ (let ((entry (and (eq bury-or-kill 'append)
+ (assq old-buffer (window-prev-buffers window)))))
+ ;; Remove `old-buffer' from WINDOW's previous and (restored list
+ ;; of) next buffers.
(set-window-prev-buffers
window (assq-delete-all old-buffer (window-prev-buffers window)))
- (set-window-next-buffers window (delq old-buffer next-buffers)))
+ (set-window-next-buffers window (delq old-buffer next-buffers))
+ (when entry
+ ;; Append old-buffer's entry to list of WINDOW's previous
+ ;; buffers so it's less likely to get switched to soon but
+ ;; `display-buffer-in-previous-window' can nevertheless find
+ ;; it.
+ (set-window-prev-buffers
+ window (append (window-prev-buffers window) (list entry)))))
;; Move `old-buffer' to head of WINDOW's restored list of next
;; buffers.
(set-window-next-buffers
@@ -2671,13 +3232,23 @@ shall not be switched to in future invocations of this command."
(defun switch-to-next-buffer (&optional window)
"In WINDOW switch to next buffer.
-WINDOW must be a live window and defaults to the selected one."
+WINDOW must be a live window and defaults to the selected one.
+Return the buffer switched to, nil if no suitable buffer could be
+found."
(interactive)
(let* ((window (window-normalize-window window t))
+ (frame (window-frame window))
(old-buffer (window-buffer window))
(next-buffers (window-next-buffers window))
+ (pred (frame-parameter frame 'buffer-predicate))
new-buffer entry killed-buffers visible)
+ (when (window-minibuffer-p window)
+ ;; Don't switch in minibuffer window.
+ (unless (setq window (minibuffer-selected-window))
+ (error "Window %s is a minibuffer window" window)))
+
(when (window-dedicated-p window)
+ ;; Don't switch in dedicated window.
(error "Window %s is dedicated to buffer %s" window old-buffer))
(catch 'found
@@ -2687,6 +3258,7 @@ WINDOW must be a live window and defaults to the selected one."
(not (setq killed-buffers
(cons buffer killed-buffers))))
(not (eq buffer old-buffer))
+ (or (null pred) (funcall pred buffer))
(setq entry (assq buffer (window-prev-buffers window))))
(setq new-buffer buffer)
(set-window-buffer-start-and-point
@@ -2694,11 +3266,13 @@ WINDOW must be a live window and defaults to the selected one."
(throw 'found t)))
;; Scan the buffer list of WINDOW's frame next, skipping previous
;; buffers entries.
- (dolist (buffer (buffer-list (window-frame window)))
- (when (and (buffer-live-p buffer) (not (eq buffer old-buffer))
+ (dolist (buffer (buffer-list frame))
+ (when (and (buffer-live-p buffer)
+ (not (eq buffer old-buffer))
+ (or (null pred) (funcall pred buffer))
(not (eq (aref (buffer-name buffer) 0) ?\s))
(not (assq buffer (window-prev-buffers window))))
- (if (get-buffer-window buffer)
+ (if (get-buffer-window buffer frame)
;; Try to avoid showing a buffer visible in some other window.
(setq visible buffer)
(setq new-buffer buffer)
@@ -2711,10 +3285,16 @@ WINDOW must be a live window and defaults to the selected one."
(or (buffer-live-p new-buffer)
(not (setq killed-buffers
(cons new-buffer killed-buffers))))
- (not (eq new-buffer old-buffer)))
- (set-window-buffer-start-and-point
- window new-buffer (nth 1 entry) (nth 2 entry))
- (throw 'found t)))
+ (not (eq new-buffer old-buffer))
+ (or (null pred) (funcall pred new-buffer)))
+ (if (and (not switch-to-visible-buffer)
+ (get-buffer-window new-buffer frame))
+ ;; Try to avoid showing a buffer visible in some other window.
+ (unless visible
+ (setq visible new-buffer))
+ (set-window-buffer-start-and-point
+ window new-buffer (nth 1 entry) (nth 2 entry))
+ (throw 'found t))))
;; Show a buffer visible in another window.
(when visible
@@ -2798,8 +3378,7 @@ means the buffer shown in window will be killed. Return non-nil
if WINDOW gets deleted or its frame is auto-hidden."
(setq window (window-normalize-window window t))
(unless (and dedicated-only (not (window-dedicated-p window)))
- (let* ((buffer (window-buffer window))
- (deletable (window-deletable-p window)))
+ (let ((deletable (window-deletable-p window)))
(cond
((eq deletable 'frame)
(let ((frame (window-frame window)))
@@ -2850,16 +3429,24 @@ displayed there."
(defun next-buffer ()
"In selected window switch to next buffer."
(interactive)
- (if (window-minibuffer-p)
- (error "Cannot switch buffers in minibuffer window"))
- (switch-to-next-buffer))
+ (cond
+ ((window-minibuffer-p)
+ (error "Cannot switch buffers in minibuffer window"))
+ ((eq (window-dedicated-p) t)
+ (error "Window is strongly dedicated to its buffer"))
+ (t
+ (switch-to-next-buffer))))
(defun previous-buffer ()
"In selected window switch to previous buffer."
(interactive)
- (if (window-minibuffer-p)
- (error "Cannot switch buffers in minibuffer window"))
- (switch-to-prev-buffer))
+ (cond
+ ((window-minibuffer-p)
+ (error "Cannot switch buffers in minibuffer window"))
+ ((eq (window-dedicated-p) t)
+ (error "Window is strongly dedicated to its buffer"))
+ (t
+ (switch-to-prev-buffer))))
(defun delete-windows-on (&optional buffer-or-name frame)
"Delete all windows showing BUFFER-OR-NAME.
@@ -2931,18 +3518,35 @@ all window-local buffer lists."
;; Unrecord BUFFER in WINDOW.
(unrecord-window-buffer window buffer)))))
-(defun quit-window (&optional kill window)
- "Quit WINDOW and bury its buffer.
+(defun quit-restore-window (&optional window bury-or-kill)
+ "Quit WINDOW and deal with its buffer.
WINDOW must be a live window and defaults to the selected one.
-With prefix argument KILL non-nil, kill the buffer instead of
-burying it.
According to information stored in WINDOW's `quit-restore' window
parameter either (1) delete WINDOW and its frame, (2) delete
WINDOW, (3) restore the buffer previously displayed in WINDOW,
or (4) make WINDOW display some other buffer than the present
-one. If non-nil, reset `quit-restore' parameter to nil."
- (interactive "P")
+one. If non-nil, reset `quit-restore' parameter to nil.
+
+Optional second argument BURY-OR-KILL tells how to proceed with
+the buffer of WINDOW. The following values are handled:
+
+`nil' means to not handle the buffer in a particular way. This
+ means that if WINDOW is not deleted by this function, invoking
+ `switch-to-prev-buffer' will usually show the buffer again.
+
+`append' means that if WINDOW is not deleted, move its buffer to
+ the end of WINDOW's previous buffers so it's less likely that a
+ future invocation of `switch-to-prev-buffer' will switch to it.
+ Also, move the buffer to the end of the frame's buffer list.
+
+`bury' means that if WINDOW is not deleted, remove its buffer
+ from WINDOW'S list of previous buffers. Also, move the buffer
+ to the end of the frame's buffer list. This value provides the
+ most reliable remedy to not have `switch-to-prev-buffer' switch
+ to this buffer again without killing the buffer.
+
+`kill' means to kill WINDOW's buffer."
(setq window (window-normalize-window window t))
(let* ((buffer (window-buffer window))
(quit-restore (window-parameter window 'quit-restore))
@@ -2954,13 +3558,18 @@ one. If non-nil, reset `quit-restore' parameter to nil."
(not (eq (setq prev-buffer (cadr prev-buffers))
buffer))))
prev-buffer)))
- quad resize)
+ quad entry)
(cond
((and (not prev-buffer)
- (memq (nth 1 quit-restore) '(window frame))
+ (or (eq (nth 1 quit-restore) 'frame)
+ (and (eq (nth 1 quit-restore) 'window)
+ ;; If the window has been created on an existing
+ ;; frame and ended up as the sole window on that
+ ;; frame, do not delete it (Bug#12764).
+ (not (eq window (frame-root-window window)))))
(eq (nth 3 quit-restore) buffer)
;; Delete WINDOW if possible.
- (window--delete window nil kill))
+ (window--delete window nil (eq bury-or-kill 'kill)))
;; If the previously selected window is still alive, select it.
(when (window-live-p (nth 2 quit-restore))
(select-window (nth 2 quit-restore))))
@@ -2968,22 +3577,32 @@ one. If non-nil, reset `quit-restore' parameter to nil."
(buffer-live-p (car quad))
(eq (nth 3 quit-restore) buffer))
;; Show another buffer stored in quit-restore parameter.
- (setq resize (with-current-buffer buffer
- (and temp-buffer-resize-mode
- (/= (nth 3 quad) (window-total-size window)))))
- (set-window-dedicated-p window nil)
- (when resize
+ (when (and (integerp (nth 3 quad))
+ (/= (nth 3 quad) (window-total-size window)))
;; Try to resize WINDOW to its old height but don't signal an
;; error.
(condition-case nil
(window-resize window (- (nth 3 quad) (window-total-size window)))
(error nil)))
+ (set-window-dedicated-p window nil)
;; Restore WINDOW's previous buffer, start and point position.
(set-window-buffer-start-and-point
window (nth 0 quad) (nth 1 quad) (nth 2 quad))
- ;; Unrecord WINDOW's buffer here (Bug#9937) to make sure it's not
- ;; re-recorded by `set-window-buffer'.
- (unrecord-window-buffer window buffer)
+ ;; Deal with the buffer we just removed from WINDOW.
+ (setq entry (and (eq bury-or-kill 'append)
+ (assq buffer (window-prev-buffers window))))
+ (when bury-or-kill
+ ;; Remove buffer from WINDOW's previous and next buffers.
+ (set-window-prev-buffers
+ window (assq-delete-all buffer (window-prev-buffers window)))
+ (set-window-next-buffers
+ window (delq buffer (window-next-buffers window))))
+ (when entry
+ ;; Append old buffer's entry to list of WINDOW's previous
+ ;; buffers so it's less likely to get switched to soon but
+ ;; `display-buffer-in-previous-window' can nevertheless find it.
+ (set-window-prev-buffers
+ window (append (window-prev-buffers window) (list entry))))
;; Reset the quit-restore parameter.
(set-window-parameter window 'quit-restore nil)
;; Select old window.
@@ -2995,12 +3614,29 @@ one. If non-nil, reset `quit-restore' parameter to nil."
(set-window-parameter window 'quit-restore nil)
;; Make sure that WINDOW is no more dedicated.
(set-window-dedicated-p window nil)
- (switch-to-prev-buffer window 'bury-or-kill)))
+ (switch-to-prev-buffer window bury-or-kill)))
+
+ ;; Deal with the buffer.
+ (cond
+ ((not (buffer-live-p buffer)))
+ ((eq bury-or-kill 'kill)
+ (kill-buffer buffer))
+ (bury-or-kill
+ (bury-buffer-internal buffer)))))
+
+(defun quit-window (&optional kill window)
+ "Quit WINDOW and bury its buffer.
+WINDOW must be a live window and defaults to the selected one.
+With prefix argument KILL non-nil, kill the buffer instead of
+burying it.
- ;; Kill WINDOW's old-buffer if requested
- (if kill
- (kill-buffer buffer)
- (bury-buffer-internal buffer))))
+According to information stored in WINDOW's `quit-restore' window
+parameter either (1) delete WINDOW and its frame, (2) delete
+WINDOW, (3) restore the buffer previously displayed in WINDOW,
+or (4) make WINDOW display some other buffer than the present
+one. If non-nil, reset `quit-restore' parameter to nil."
+ (interactive "P")
+ (quit-restore-window window (if kill 'kill 'bury)))
(defun quit-windows-on (&optional buffer-or-name kill frame)
"Quit all windows showing BUFFER-OR-NAME.
@@ -3033,7 +3669,7 @@ Optional argument HORIZONTAL non-nil means return minimum width."
(defun split-window (&optional window size side)
"Make a new window adjacent to WINDOW.
-WINDOW can be any window and defaults to the selected one.
+WINDOW must be a valid window and defaults to the selected one.
Return the new window which is always a live window.
Optional argument SIZE a positive number means make WINDOW SIZE
@@ -3080,14 +3716,15 @@ frame. The selected window is not changed by this function."
((not side) 'below)
((memq side '(below above right left)) side)
(t 'right)))
- (horizontal (not (memq side '(nil below above))))
+ (horizontal (not (memq side '(below above))))
(frame (window-frame window))
(parent (window-parent window))
(function (window-parameter window 'split-window))
(window-side (window-parameter window 'window-side))
- ;; Rebind `window-combination-limit' since in some cases we may
- ;; have to override its 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)
(window--check frame)
@@ -3105,20 +3742,32 @@ frame. The selected window is not changed by this function."
((and (window-parameter window 'window-atom)
(setq atom-root (window-atom-root window))
(not (eq atom-root window)))
- (throw 'done (split-window atom-root size side))))
-
- (when (and window-side
- (or (not parent)
- (not (window-parameter parent 'window-side))))
- ;; WINDOW is a side root window. To make sure that a new parent
- ;; window gets created set `window-combination-limit' to t.
- (setq window-combination-limit t))
-
- (when (and window-combination-resize size (> size 0))
- ;; If `window-combination-resize' is non-nil and SIZE is a
- ;; non-negative integer, we cannot reasonably resize other
- ;; windows. Rather bind `window-combination-limit' to t to make
- ;; sure that subsequent window deletions are handled correctly.
+ (throw 'done (split-window atom-root size side)))
+ ;; If WINDOW is a side window or its first or last child is a
+ ;; side window, throw an error unless `window-combination-resize'
+ ;; equals 'side.
+ ((and (not (eq window-combination-resize 'side))
+ (or (window-parameter window 'window-side)
+ (and (window-child window)
+ (or (window-parameter
+ (window-child window) 'window-side)
+ (window-parameter
+ (window-last-child window) 'window-side)))))
+ (error "Cannot split side window or parent of side window"))
+ ;; If `window-combination-resize' is 'side and window has a side
+ ;; window sibling, bind `window-combination-limit' to t.
+ ((and (not (eq window-combination-resize 'side))
+ (or (and (window-prev-sibling window)
+ (window-parameter
+ (window-prev-sibling window) 'window-side))
+ (and (window-next-sibling window)
+ (window-parameter
+ (window-next-sibling window) 'window-side))))
+ (setq window-combination-limit t)))
+
+ ;; If `window-combination-resize' is t and SIZE is non-negative,
+ ;; bind `window-combination-limit' to t.
+ (when (and (eq window-combination-resize t) size (> size 0))
(setq window-combination-limit t))
(let* ((parent-size
@@ -3128,7 +3777,10 @@ frame. The selected window is not changed by this function."
;; `resize' non-nil means we are supposed to resize other
;; windows in WINDOW's combination.
(resize
- (and window-combination-resize (not window-combination-limit)
+ (and window-combination-resize
+ (or (window-parameter window 'window-side)
+ (not (eq window-combination-resize 'side)))
+ (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.
@@ -3208,7 +3860,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.
@@ -3239,10 +3891,21 @@ frame. The selected window is not changed by this function."
new-normal)))
(let* ((new (split-window-internal window new-size side new-normal)))
- ;; Inherit window-side parameters, if any.
- (when (and window-side new-parent)
- (set-window-parameter (window-parent new) 'window-side window-side)
- (set-window-parameter new 'window-side window-side))
+ ;; Assign window-side parameters, if any.
+ (when (eq window-combination-resize 'side)
+ (let ((window-side
+ (cond
+ (window-side window-side)
+ ((eq side 'above) 'top)
+ ((eq side 'below) 'bottom)
+ (t side))))
+ ;; We made a new side window.
+ (set-window-parameter new 'window-side window-side)
+ (when (and new-parent (window-parameter window 'window-side))
+ ;; We've been splitting a side root window. Give the
+ ;; new parent the same window-side parameter.
+ (set-window-parameter
+ (window-parent new) 'window-side window-side))))
(run-window-configuration-change-hook frame)
(window--check frame)
@@ -3275,7 +3938,7 @@ Otherwise, the window starts are chosen so as to minimize the
amount of redisplay; this is convenient on slow terminals."
(interactive "P")
(let ((old-window (selected-window))
- (old-point (point))
+ (old-point (window-point))
(size (and size (prefix-numeric-value size)))
moved-by-window-height moved new-window bottom)
(when (and size (< size 0) (< (- size) window-min-height))
@@ -3284,22 +3947,27 @@ amount of redisplay; this is convenient on slow terminals."
(setq new-window (split-window nil size))
(unless split-window-keep-point
(with-current-buffer (window-buffer)
- (goto-char (window-start))
- (setq moved (vertical-motion (window-height)))
- (set-window-start new-window (point))
- (when (> (point) (window-point new-window))
- (set-window-point new-window (point)))
- (when (= moved (window-height))
- (setq moved-by-window-height t)
- (vertical-motion -1))
- (setq bottom (point)))
- (and moved-by-window-height
- (<= bottom (point))
- (set-window-point old-window (1- bottom)))
- (and moved-by-window-height
- (<= (window-start new-window) old-point)
- (set-window-point new-window old-point)
- (select-window new-window)))
+ ;; Use `save-excursion' around vertical movements below
+ ;; (Bug#10971). Note: When the selected window's buffer has a
+ ;; header line, up to two lines of the buffer may not show up
+ ;; in the resulting configuration.
+ (save-excursion
+ (goto-char (window-start))
+ (setq moved (vertical-motion (window-height)))
+ (set-window-start new-window (point))
+ (when (> (point) (window-point new-window))
+ (set-window-point new-window (point)))
+ (when (= moved (window-height))
+ (setq moved-by-window-height t)
+ (vertical-motion -1))
+ (setq bottom (point)))
+ (and moved-by-window-height
+ (<= bottom (point))
+ (set-window-point old-window (1- bottom)))
+ (and moved-by-window-height
+ (<= (window-start new-window) old-point)
+ (set-window-point new-window old-point)
+ (select-window new-window))))
;; Always copy quit-restore parameter in interactive use.
(let ((quit-restore (window-parameter old-window 'quit-restore)))
(when quit-restore
@@ -3349,13 +4017,13 @@ right, if any."
(defun balance-windows-2 (window horizontal)
"Subroutine of `balance-windows-1'.
WINDOW must be a vertical combination (horizontal if HORIZONTAL
-is non-nil."
+is non-nil)."
(let* ((first (window-child window))
(sub first)
(number-of-children 0)
(parent-size (window-new-total window))
(total-sum parent-size)
- found failed size sub-total sub-delta sub-amount rest)
+ failed size sub-total sub-delta sub-amount rest)
(while sub
(setq number-of-children (1+ number-of-children))
(when (window-size-fixed-p sub horizontal)
@@ -3372,7 +4040,6 @@ is non-nil."
(while (and sub (not failed))
;; Ignore child windows that should be ignored or are stuck.
(unless (window--resize-child-windows-skip-p sub)
- (setq found t)
(setq sub-total (window-total-size sub horizontal))
(setq sub-delta (- size sub-total))
(setq sub-amount
@@ -3568,10 +4235,7 @@ specific buffers."
))
;;; Window states, how to get them and how to put them in a window.
-(defvar window-state-ignored-parameters '(quit-restore)
- "List of window parameters ignored by `window-state-get'.")
-
-(defun window--state-get-1 (window &optional markers)
+(defun window--state-get-1 (window &optional writable)
"Helper function for `window-state-get'."
(let* ((type
(cond
@@ -3588,58 +4252,66 @@ specific buffers."
(normal-height . ,(window-normal-size window))
(normal-width . ,(window-normal-size window t))
(combination-limit . ,(window-combination-limit window))
- ,@(let (list)
- (dolist (parameter (window-parameters window))
- (unless (memq (car parameter)
- window-state-ignored-parameters)
- (setq list (cons parameter list))))
- (unless (window-parameter window 'clone-of)
- ;; Make a clone-of parameter.
- (setq list (cons (cons 'clone-of window) list)))
+ ,@(let ((parameters (window-parameters window))
+ list)
+ ;; Make copies of those window parameters whose
+ ;; persistence property is `writable' if WRITABLE is
+ ;; non-nil and non-nil if WRITABLE is nil.
+ (dolist (par parameters)
+ (let ((pers (cdr (assq (car par)
+ window-persistent-parameters))))
+ (when (and pers (or (not writable) (eq pers 'writable)))
+ (setq list (cons (cons (car par) (cdr par)) list)))))
+ ;; Add `clone-of' parameter if necessary.
+ (let ((pers (cdr (assq 'clone-of
+ window-persistent-parameters))))
+ (when (and pers (or (not writable) (eq pers 'writable))
+ (not (assq 'clone-of list)))
+ (setq list (cons (cons 'clone-of window) list))))
(when list
`((parameters . ,list))))
,@(when buffer
- ;; All buffer related things go in here - make the buffer
- ;; current when retrieving `point' and `mark'.
- (with-current-buffer (window-buffer window)
- (let ((point (window-point-1 window))
- (start (window-start window))
- (mark (mark t)))
- `((buffer
- ,(buffer-name buffer)
- (selected . ,selected)
- ,@(when window-size-fixed
- `((size-fixed . ,window-size-fixed)))
- (hscroll . ,(window-hscroll window))
- (fringes . ,(window-fringes window))
- (margins . ,(window-margins window))
- (scroll-bars . ,(window-scroll-bars window))
- (vscroll . ,(window-vscroll window))
- (dedicated . ,(window-dedicated-p window))
- (point . ,(if markers (copy-marker point) point))
- (start . ,(if markers (copy-marker start) start))
- ,@(when mark
- `((mark . ,(if markers
- (copy-marker mark) mark)))))))))))
+ ;; All buffer related things go in here.
+ (let ((point (window-point window))
+ (start (window-start window)))
+ `((buffer
+ ,(buffer-name buffer)
+ (selected . ,selected)
+ (hscroll . ,(window-hscroll window))
+ (fringes . ,(window-fringes window))
+ (margins . ,(window-margins window))
+ (scroll-bars . ,(window-scroll-bars window))
+ (vscroll . ,(window-vscroll window))
+ (dedicated . ,(window-dedicated-p window))
+ (point . ,(if writable point
+ (copy-marker point
+ (buffer-local-value
+ 'window-point-insertion-type
+ buffer))))
+ (start . ,(if writable start (copy-marker start)))))))))
(tail
(when (memq type '(vc hc))
(let (list)
(setq window (window-child window))
(while window
- (setq list (cons (window--state-get-1 window markers) list))
+ (setq list (cons (window--state-get-1 window writable) list))
(setq window (window-right window)))
(nreverse list)))))
(append head tail)))
-(defun window-state-get (&optional window markers)
+(defun window-state-get (&optional window writable)
"Return state of WINDOW as a Lisp object.
WINDOW can be any window and defaults to the root window of the
selected frame.
-Optional argument MARKERS non-nil means use markers for sampling
-positions like `window-point' or `window-start'. MARKERS should
-be non-nil only if the value is used for putting the state back
-in the same session (note that markers slow down processing).
+Optional argument WRITABLE non-nil means do not use markers for
+sampling `window-point' and `window-start'. Together, WRITABLE
+and the variable `window-persistent-parameters' specify which
+window parameters are saved by this function. WRITABLE should be
+non-nil when the return value shall be written to a file and read
+back in another session. Otherwise, an application may run into
+an `invalid-read-syntax' error while attempting to read back the
+value from file.
The return value can be used as argument for `window-state-put'
to put the state recorded here into an arbitrary window. The
@@ -3661,11 +4333,8 @@ value can be also stored on disk and read back in a new session."
(min-height-ignore . ,(window-min-size window nil t))
(min-width-ignore . ,(window-min-size window t t))
(min-height-safe . ,(window-min-size window nil 'safe))
- (min-width-safe . ,(window-min-size window t 'safe))
- ;; These are probably not needed.
- ,@(when (window-size-fixed-p window) `((fixed-height . t)))
- ,@(when (window-size-fixed-p window t) `((fixed-width . t))))
- (window--state-get-1 window markers)))
+ (min-width-safe . ,(window-min-size window t 'safe)))
+ (window--state-get-1 window writable)))
(defvar window-state-put-list nil
"Helper variable for `window-state-put'.")
@@ -3738,13 +4407,15 @@ value can be also stored on disk and read back in a new session."
"Helper function for `window-state-put'."
(dolist (item window-state-put-list)
(let ((window (car item))
- (splits (cdr (assq 'splits item)))
(combination-limit (cdr (assq 'combination-limit item)))
(parameters (cdr (assq 'parameters item)))
(state (cdr (assq 'buffer item))))
(when combination-limit
(set-window-combination-limit window combination-limit))
- ;; Process parameters.
+ ;; Reset window's parameters and assign saved ones (we might want
+ ;; a `remove-window-parameters' function here).
+ (dolist (parameter (window-parameters window))
+ (set-window-parameter window (car parameter) nil))
(when parameters
(dolist (parameter parameters)
(set-window-parameter window (car parameter) (cdr parameter))))
@@ -3797,11 +4468,7 @@ value can be also stored on disk and read back in a new session."
;; have been created and sized).
(ignore-errors
(set-window-start window (cdr (assq 'start state)))
- (set-window-point window (cdr (assq 'point state)))
- ;; I'm not sure whether we should set the mark here, but maybe
- ;; it can be used.
- (let ((mark (cdr (assq 'mark state))))
- (when mark (set-mark mark))))
+ (set-window-point window (cdr (assq 'point state))))
;; Select window if it's the selected one.
(when (cdr (assq 'selected state))
(select-window window)))))))
@@ -3829,8 +4496,7 @@ windows can get as small as `window-safe-min-height' and
(= (window-total-size window t)
(cdr (assq 'total-width state)))))
(min-height (cdr (assq 'min-height head)))
- (min-width (cdr (assq 'min-width head)))
- selected)
+ (min-width (cdr (assq 'min-width head))))
(if (and (not totals)
(or (> min-height (window-total-size window))
(> min-width (window-total-size window t)))
@@ -3894,13 +4560,17 @@ element is BUFFER."
;; If WINDOW has a quit-restore parameter, reset its car.
(setcar (window-parameter window 'quit-restore) 'same))
;; WINDOW shows another buffer.
- (set-window-parameter
- window 'quit-restore
- (list 'other
- ;; A quadruple of WINDOW's buffer, start, point and height.
- (list (window-buffer window) (window-start window)
- (window-point-1 window) (window-total-size window))
- (selected-window) buffer))))
+ (with-current-buffer (window-buffer window)
+ (set-window-parameter
+ window 'quit-restore
+ (list 'other
+ ;; A quadruple of WINDOW's buffer, start, point and height.
+ (list (current-buffer) (window-start window)
+ ;; Preserve window-point-insertion-type (Bug#12588).
+ (copy-marker
+ (window-point window) window-point-insertion-type)
+ (window-total-size window))
+ (selected-window) buffer)))))
((eq type 'window)
;; WINDOW has been created on an existing frame.
(set-window-parameter
@@ -3927,12 +4597,14 @@ of the window used."
(function :tag "function"))
:group 'windows)
+(make-obsolete-variable 'display-buffer-function
+ 'display-buffer-alist "24.3")
+
+;; Eventually, we want to turn this into a defvar; instead of
+;; customizing this, the user should use a `pop-up-frame-parameters'
+;; alist entry in `display-buffer-base-action'.
(defcustom pop-up-frame-alist nil
"Alist of parameters for automatically generated new frames.
-You can set this in your init file; for example,
-
- (setq pop-up-frame-alist '((width . 80) (height . 20)))
-
If non-nil, the value you specify here is used by the default
`pop-up-frame-function' for the creation of new frames.
@@ -4019,8 +4691,7 @@ See also `special-display-regexps'."
(repeat :tag "Arguments" (sexp)))))
:group 'windows
:group 'frames)
-
-;;;###autoload
+(make-obsolete-variable 'special-display-buffer-names 'display-buffer-alist "24.3")
(put 'special-display-buffer-names 'risky-local-variable t)
(defcustom special-display-regexps nil
@@ -4087,6 +4758,8 @@ See also `special-display-buffer-names'."
(repeat :tag "Arguments" (sexp)))))
:group 'windows
:group 'frames)
+(make-obsolete-variable 'special-display-regexps 'display-buffer-alist "24.3")
+(put 'special-display-regexps 'risky-local-variable t)
(defun special-display-p (buffer-name)
"Return non-nil if a buffer named BUFFER-NAME gets a special frame.
@@ -4098,7 +4771,6 @@ or matches BUFFER-NAME, the return value is the cdr of that
entry."
(let (tmp)
(cond
- ((not (stringp buffer-name)))
((member buffer-name special-display-buffer-names)
t)
((setq tmp (assoc buffer-name special-display-buffer-names))
@@ -4129,9 +4801,10 @@ These supersede the values given in `default-frame-alist'."
(symbol :tag "Parameter")
(sexp :tag "Value")))
:group 'frames)
+(make-obsolete-variable 'special-display-frame-alist 'display-buffer-alist "24.3")
(defun special-display-popup-frame (buffer &optional args)
- "Display BUFFER and return the window chosen.
+ "Pop up a frame displaying BUFFER and return its window.
If BUFFER is already displayed in a visible or iconified frame,
raise that frame. Otherwise, display BUFFER in a new frame.
@@ -4144,8 +4817,8 @@ the selected window. If they contain (same-frame . t), display
BUFFER in a window of the selected frame.
If ARGS is a list whose car is a symbol, use (car ARGS) as a
-function to do the work. Pass it BUFFER as first argument,
-and (cdr ARGS) as second."
+function to do the work. Pass it BUFFER as first argument, and
+pass the elements of (cdr ARGS) as the remaining arguments."
(if (and args (symbolp (car args)))
(apply (car args) buffer (cdr args))
(let ((window (get-buffer-window buffer 0)))
@@ -4174,10 +4847,9 @@ and (cdr ARGS) as second."
(make-frame (append args special-display-frame-alist))))
(window (frame-selected-window frame)))
(display-buffer-record-window 'frame window buffer)
- ;; FIXME: Use window--display-buffer-2?
- (set-window-buffer window buffer)
- ;; Reset list of WINDOW's previous buffers to nil.
- (set-window-prev-buffers window nil)
+ (unless (eq buffer (window-buffer window))
+ (set-window-buffer window buffer)
+ (set-window-prev-buffers window nil))
(set-window-dedicated-p window t)
window)))))
@@ -4199,6 +4871,7 @@ with corresponding arguments to set up the quit-restore parameter
of the window used."
:type 'function
:group 'frames)
+(make-obsolete-variable 'special-display-function 'display-buffer-alist "24.3")
(defcustom same-window-buffer-names nil
"List of names of buffers that should appear in the \"same\" window.
@@ -4247,7 +4920,7 @@ selected rather than (as usual) some other window. See
;; The elements of `same-window-regexps' can be regexps
;; or cons cells whose cars are regexps.
(when (or (and (stringp regexp)
- (string-match regexp buffer-name))
+ (string-match-p regexp buffer-name))
(and (consp regexp) (stringp (car regexp))
(string-match-p (car regexp) buffer-name)))
(throw 'found t)))))))
@@ -4272,6 +4945,11 @@ that frame."
:version "21.1"
:group 'windows)
+(make-obsolete-variable
+ 'display-buffer-reuse-frames
+ "use a `reusable-frames' alist entry in `display-buffer-alist'."
+ "24.3")
+
(defcustom pop-up-windows t
"Non-nil means `display-buffer' should make a new window."
:type 'boolean
@@ -4369,7 +5047,7 @@ hold:
;; A window can be split vertically when its height is not
;; fixed, it is at least `split-height-threshold' lines high,
;; and it is at least twice as high as `window-min-height' and 2
- ;; if it has a modeline or 1.
+ ;; if it has a mode line or 1.
(and (memq window-size-fixed '(nil width))
(numberp split-height-threshold)
(>= (window-height window)
@@ -4377,8 +5055,9 @@ hold:
(* 2 (max window-min-height
(if mode-line-format 2 1))))))))))
-(defun split-window-sensibly (window)
+(defun split-window-sensibly (&optional window)
"Split WINDOW in a way suitable for `display-buffer'.
+WINDOW defaults to the currently selected window.
If `split-height-threshold' specifies an integer, WINDOW is at
least `split-height-threshold' lines tall and can be split
vertically, split WINDOW into two windows one above the other and
@@ -4408,36 +5087,49 @@ more likely to occur.
Have a look at the function `window-splittable-p' if you want to
know how `split-window-sensibly' determines whether WINDOW can be
split."
- (or (and (window-splittable-p window)
- ;; Split window vertically.
- (with-selected-window window
- (split-window-below)))
- (and (window-splittable-p window t)
- ;; Split window horizontally.
- (with-selected-window window
- (split-window-right)))
- (and (eq window (frame-root-window (window-frame window)))
- (not (window-minibuffer-p window))
- ;; If WINDOW is the only window on its frame and is not the
- ;; minibuffer window, try to split it vertically disregarding
- ;; the value of `split-height-threshold'.
- (let ((split-height-threshold 0))
- (when (window-splittable-p window)
- (with-selected-window window
- (split-window-below)))))))
-
-(defun window--try-to-split-window (window)
+ (let ((window (or window (selected-window))))
+ (or (and (window-splittable-p window)
+ ;; Split window vertically.
+ (with-selected-window window
+ (split-window-below)))
+ (and (window-splittable-p window t)
+ ;; Split window horizontally.
+ (with-selected-window window
+ (split-window-right)))
+ (and (eq window (frame-root-window (window-frame window)))
+ (not (window-minibuffer-p window))
+ ;; If WINDOW is the only window on its frame and is not the
+ ;; minibuffer window, try to split it vertically disregarding
+ ;; the value of `split-height-threshold'.
+ (let ((split-height-threshold 0))
+ (when (window-splittable-p window)
+ (with-selected-window window
+ (split-window-below))))))))
+
+(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)
@@ -4472,48 +5164,87 @@ Do this only if these windows are vertically adjacent to each
other, `even-window-heights' is non-nil, and the selected window
is higher than WINDOW."
(when (and even-window-heights
- (not (eq window (selected-window)))
- ;; Don't resize minibuffer windows.
- (not (window-minibuffer-p (selected-window)))
- (> (window-height (selected-window)) (window-height window))
- (eq (window-frame window) (window-frame (selected-window)))
- (let ((sel-edges (window-edges (selected-window)))
- (win-edges (window-edges window)))
- (and (= (nth 0 sel-edges) (nth 0 win-edges))
- (= (nth 2 sel-edges) (nth 2 win-edges))
- (or (= (nth 1 sel-edges) (nth 3 win-edges))
- (= (nth 3 sel-edges) (nth 1 win-edges))))))
- (let ((window-min-height 1))
- ;; Don't throw an error if we can't even window heights for
- ;; whatever reason.
- (condition-case nil
- (enlarge-window (/ (- (window-height window) (window-height)) 2))
- (error nil)))))
+ ;; Even iff WINDOW forms a vertical combination with the
+ ;; selected window, and WINDOW's height exceeds that of the
+ ;; selected window, see also bug#11880.
+ (window-combined-p window)
+ (= (window-child-count (window-parent window)) 2)
+ (eq (window-parent) (window-parent window))
+ (> (window-total-height) (window-total-height window)))
+ ;; Don't throw an error if we can't even window heights for
+ ;; whatever reason.
+ (condition-case nil
+ (enlarge-window
+ (/ (- (window-total-height window) (window-total-height)) 2))
+ (error nil))))
+
+(defun window--display-buffer (buffer window type &optional alist dedicated)
+ "Display BUFFER in WINDOW.
+TYPE must be one of the symbols `reuse', `window' or `frame' and
+is passed unaltered to `display-buffer-record-window'. ALIST is
+the alist argument of `display-buffer'. Set `window-dedicated-p'
+to DEDICATED if non-nil. Return WINDOW if BUFFER and WINDOW are
+live."
+ (when (and (buffer-live-p buffer) (window-live-p window))
+ (display-buffer-record-window type window buffer)
+ (unless (eq buffer (window-buffer window))
+ (set-window-dedicated-p window nil)
+ (set-window-buffer window buffer)
+ (when dedicated
+ (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 (eq type 'window)
+ (and (eq (car parameter) 'same)
+ (eq (nth 1 parameter) 'window)))
+ ;; Adjust height of window if asked for.
+ (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))))
+ (when (and (window--resizable-p window delta nil 'safe)
+ (window-combined-p window))
+ (window-resize window delta nil 'safe))))
+ ((functionp height)
+ (ignore-errors (funcall height window))))
+ ;; Adjust width of window if asked for.
+ (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))))
+ (when (and (window--resizable-p window delta t 'safe)
+ (window-combined-p window t))
+ (window-resize window delta t 'safe))))
+ ((functionp width)
+ (ignore-errors (funcall width window))))))
-(defun window--display-buffer-1 (window)
- "Raise the frame containing WINDOW.
-Do not raise the selected frame. Return WINDOW."
- (let* ((frame (window-frame window))
- (visible (frame-visible-p frame)))
+ window))
+
+(defun window--maybe-raise-frame (frame)
+ (let ((visible (frame-visible-p frame)))
(unless (or (not visible)
;; Assume the selected frame is already visible enough.
(eq frame (selected-frame))
- ;; Assume the frame from which we invoked the minibuffer
- ;; is visible.
+ ;; Assume the frame from which we invoked the
+ ;; minibuffer is visible.
(and (minibuffer-window-active-p (selected-window))
(eq frame (window-frame (minibuffer-selected-window)))))
- (raise-frame frame))
- window))
-
-(defun window--display-buffer-2 (buffer window &optional dedicated)
- "Display BUFFER in WINDOW and make its frame visible.
-Set `window-dedicated-p' to DEDICATED if non-nil.
-Return WINDOW."
- (when (and (buffer-live-p buffer) (window-live-p window))
- (set-window-buffer window buffer)
- (when dedicated
- (set-window-dedicated-p window dedicated))
- (window--display-buffer-1 window)))
+ (raise-frame frame))))
;; FIXME: Not implemented.
;; FIXME: By the way, there could be more levels of dedication:
@@ -4530,7 +5261,7 @@ The actual non-nil value of this variable will be copied to the
'(choice :tag "Function"
(const :tag "--" ignore) ; default for insertion
(const display-buffer-reuse-window)
- (const display-buffer-use-some-window)
+ (const display-buffer-pop-up-window)
(const display-buffer-same-window)
(const display-buffer-pop-up-frame)
(const display-buffer-use-some-window)
@@ -4561,13 +5292,19 @@ See `display-buffer' for details.")
"Alist of conditional actions for `display-buffer'.
This is a list of elements (CONDITION . ACTION), where:
- CONDITION is either a regexp matching buffer names, or a function
- that takes a buffer and returns a boolean.
+ CONDITION is either a regexp matching buffer names, or a
+ function that takes two arguments - a buffer name and the
+ ACTION argument of `display-buffer' - and returns a boolean.
ACTION is a cons cell (FUNCTION . ALIST), where FUNCTION is a
function or a list of functions. Each such function should
accept two arguments: a buffer to display and an alist of the
- same form as ALIST. See `display-buffer' for details."
+ same form as ALIST. See `display-buffer' for details.
+
+`display-buffer' scans this alist until it either finds a
+matching regular expression or the function specified by a
+condition returns non-nil. In any of these cases, it adds the
+associated action to the list of actions it will try."
:type `(alist :key-type
(choice :tag "Condition"
regexp
@@ -4601,16 +5338,16 @@ specified, e.g. by the user options `display-buffer-alist' or
`display-buffer-base-action'. See `display-buffer'.")
(put 'display-buffer-fallback-action 'risky-local-variable t)
-(defun display-buffer-assq-regexp (buffer-name alist)
- "Retrieve ALIST entry corresponding to BUFFER-NAME."
+(defun display-buffer-assq-regexp (buffer-name alist action)
+ "Retrieve ALIST entry corresponding to BUFFER-NAME.
+ACTION is the action argument passed to `display-buffer'."
(catch 'match
(dolist (entry alist)
- (let ((key (car entry))
- (value (cdr entry)))
+ (let ((key (car entry)))
(when (or (and (stringp key)
(string-match-p key buffer-name))
- (and (symbolp key) (functionp key)
- (funcall key buffer-name alist)))
+ (and (functionp key)
+ (funcall key buffer-name action)))
(throw 'match (cdr entry)))))))
(defvar display-buffer--same-window-action
@@ -4633,20 +5370,35 @@ BUFFER-OR-NAME must be a buffer or the name of an existing
buffer. Return the window chosen for displaying BUFFER-OR-NAME,
or nil if no such window is found.
-Optional argument ACTION should have the form (FUNCTION . ALIST).
-FUNCTION is either a function or a list of functions. Each such
-function is called with two arguments: the buffer to display and
-an alist. It should either display the buffer and return the
-window, or return nil if unable to display the buffer.
+Optional argument ACTION, if non-nil, should specify a display
+action. Its form is described below.
+
+Optional argument FRAME, if non-nil, acts like an additional
+ALIST entry (reusable-frames . FRAME) to the action list of ACTION,
+specifying the frame(s) to search for a window that is already
+displaying the buffer. See `display-buffer-reuse-window'
+
+If ACTION is non-nil, it should have the form (FUNCTION . ALIST),
+where FUNCTION is either a function or a list of functions, and
+ALIST is an arbitrary association list (alist).
+
+Each such FUNCTION should accept two arguments: the buffer to
+display and an alist. Based on those arguments, it should either
+display the buffer and return the window, or return nil if unable
+to display the buffer.
The `display-buffer' function builds a function list and an alist
-from `display-buffer-overriding-action', `display-buffer-alist',
-the ACTION argument, `display-buffer-base-action', and
-`display-buffer-fallback-action' (in that order). Then it calls
-each function in the combined function list in turn, passing the
+by combining the functions and alists specified in
+`display-buffer-overriding-action', `display-buffer-alist', the
+ACTION argument, `display-buffer-base-action', and
+`display-buffer-fallback-action' (in order). Then it calls each
+function in the combined function list in turn, passing the
buffer as the first argument and the combined alist as the second
argument, until one of the functions returns non-nil.
+If ACTION is nil, the function list and the alist are built using
+only the other variables mentioned above.
+
Available action functions include:
`display-buffer-same-window'
`display-buffer-reuse-window'
@@ -4659,20 +5411,39 @@ Recognized alist entries include:
`inhibit-same-window' -- A non-nil value prevents the same
window from being used for display.
+ `inhibit-switch-frame' -- A non-nil value prevents any other
+ frame from being raised or selected,
+ even if the window is displayed there.
+
`reusable-frames' -- Value specifies frame(s) to search for a
window that already displays the buffer.
See `display-buffer-reuse-window'.
+ `pop-up-frame-parameters' -- Value specifies an alist of frame
+ parameters to give a new frame, if
+ one is created.
+
+ `window-height' -- Value specifies either an integer (the number
+ of lines of a new window), a floating point number (the
+ fraction of a new window with respect to the height of the
+ frame's root window) or a function to be called with one
+ argument - a new window. The function is supposed to adjust
+ the height of the window; its return value is ignored.
+ Suitable functions are `shrink-window-if-larger-than-buffer'
+ and `fit-window-to-buffer'.
+
+ `window-width' -- Value specifies either an integer (the number
+ of columns of a new window), a floating point number (the
+ fraction of a new window with respect to the width of the
+ frame's root window) or a function to be called with one
+ argument - a new window. The function is supposed to adjust
+ the width of the window; its return value is ignored.
+
The ACTION argument to `display-buffer' can also have a non-nil
and non-list value. This means to display the buffer in a window
other than the selected one, even if it is already displayed in
the selected window. If called interactively with a prefix
-argument, ACTION is t.
-
-Optional argument FRAME, if non-nil, acts like an additional
-ALIST entry (reusable-frames . FRAME), specifying the frame(s) to
-search for a window that is already displaying the buffer. See
-`display-buffer-reuse-window'."
+argument, ACTION is t."
(interactive (list (read-buffer "Display buffer: " (other-buffer))
(if current-prefix-arg t)))
(let ((buffer (if (bufferp buffer-or-name)
@@ -4686,8 +5457,8 @@ search for a window that is already displaying the buffer. See
(funcall display-buffer-function buffer inhibit-same-window)
;; Otherwise, use the defined actions.
(let* ((user-action
- (display-buffer-assq-regexp (buffer-name buffer)
- display-buffer-alist))
+ (display-buffer-assq-regexp
+ (buffer-name buffer) display-buffer-alist action))
(special-action (display-buffer--special-action buffer))
;; Extra actions from the arguments to this function:
(extra-action
@@ -4732,8 +5503,7 @@ selected window."
(unless (or (cdr (assq 'inhibit-same-window alist))
(window-minibuffer-p)
(window-dedicated-p))
- (display-buffer-record-window 'reuse (selected-window) buffer)
- (window--display-buffer-2 buffer (selected-window))))
+ (window--display-buffer buffer (selected-window) 'reuse alist)))
(defun display-buffer--maybe-same-window (buffer alist)
"Conditionally display BUFFER in the selected window.
@@ -4761,7 +5531,11 @@ which frames to search for a reusable window:
If ALIST contains no `reusable-frames' entry, search just the
selected frame if `display-buffer-reuse-frames' and
`pop-up-frames' are both nil; search all frames on the current
-terminal if either of those variables is non-nil."
+terminal if either of those variables is non-nil.
+
+If ALIST has a non-nil `inhibit-switch-frame' entry, then in the
+event that a window on another frame is chosen, avoid raising
+that frame."
(let* ((alist-entry (assq 'reusable-frames alist))
(frames (cond (alist-entry (cdr alist-entry))
((if (eq pop-up-frames 'graphic-only)
@@ -4776,9 +5550,10 @@ terminal if either of those variables is non-nil."
(car (delq (selected-window)
(get-buffer-window-list buffer 'nomini
frames))))))
- (when window
- (display-buffer-record-window 'reuse window buffer)
- (window--display-buffer-1 window))))
+ (when (window-live-p window)
+ (prog1 (window--display-buffer buffer window 'reuse alist)
+ (unless (cdr (assq 'inhibit-switch-frame alist))
+ (window--maybe-raise-frame (window-frame window)))))))
(defun display-buffer--special-action (buffer)
"Return special display action for BUFFER, if any.
@@ -4798,23 +5573,35 @@ See `display-buffer' for the format of display actions."
(defun display-buffer-pop-up-frame (buffer alist)
"Display BUFFER in a new frame.
This works by calling `pop-up-frame-function'. If successful,
-return the window used; otherwise return nil."
- (let ((fun pop-up-frame-function)
- frame window)
+return the window used; otherwise return nil.
+
+If ALIST has a non-nil `inhibit-switch-frame' entry, avoid
+raising the new frame.
+
+If ALIST has a non-nil `pop-up-frame-parameters' entry, the
+corresponding value is an alist of frame parameters to give the
+new frame."
+ (let* ((params (cdr (assq 'pop-up-frame-parameters alist)))
+ (pop-up-frame-alist (append params pop-up-frame-alist))
+ (fun pop-up-frame-function)
+ frame window)
(when (and fun
(setq frame (funcall fun))
(setq window (frame-selected-window frame)))
- (display-buffer-record-window 'frame window buffer)
- (window--display-buffer-2 buffer window display-buffer-mark-dedicated)
- ;; Reset list of WINDOW's previous buffers to nil.
- (set-window-prev-buffers window nil)
- window)))
+ (prog1 (window--display-buffer
+ buffer window 'frame alist display-buffer-mark-dedicated)
+ (unless (cdr (assq 'inhibit-switch-frame alist))
+ (window--maybe-raise-frame frame))))))
(defun display-buffer-pop-up-window (buffer alist)
"Display BUFFER by popping up a new window.
The new window is created on the selected frame, or in
`last-nonminibuffer-frame' if no windows can be created there.
-If sucessful, return the new window; otherwise return nil."
+If successful, return the new window; otherwise return nil.
+
+If ALIST has a non-nil `inhibit-switch-frame' entry, then in the
+event that the new window is created on another frame, avoid
+raising the frame."
(let ((frame (or (window--frame-usable-p (selected-frame))
(window--frame-usable-p (last-nonminibuffer-frame))))
window)
@@ -4827,14 +5614,13 @@ If sucessful, return the new window; otherwise return nil."
(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)))))
- (display-buffer-record-window 'window window buffer)
- (window--display-buffer-2 buffer window display-buffer-mark-dedicated)
- ;; Reset list of WINDOW's previous buffers to nil.
- (set-window-prev-buffers window nil)
- window)))
+ (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)))))))
(defun display-buffer--maybe-pop-up-frame-or-window (buffer alist)
"Try displaying BUFFER based on `pop-up-frames' or `pop-up-windows'.
@@ -4851,45 +5637,131 @@ 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)
+ "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) alist))
+ (window--display-buffer
+ 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 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.
+If ALIST has a non-nil `inhibit-same-window' entry, the selected
+window is not eligible for reuse.
+
+If ALIST contains a `reusable-frames' entry, its value determines
+which frames to search for a reusable window:
+ nil -- the selected frame (actually the last non-minibuffer frame)
+ A frame -- just that frame
+ `visible' -- all visible frames
+ 0 -- all frames on the current terminal
+ t -- all frames.
+
+If ALIST contains no `reusable-frames' entry, search just the
+selected frame if `display-buffer-reuse-frames' and
+`pop-up-frames' are both nil; search all frames on the current
+terminal if either of those variables is non-nil.
+
+If ALIST has a `previous-window' entry, the window specified by
+that entry will override any other window found by the methods
+above, even if that window never showed BUFFER before."
+ (let* ((alist-entry (assq 'reusable-frames alist))
+ (inhibit-same-window
+ (cdr (assq 'inhibit-same-window alist)))
+ (frames (cond
+ (alist-entry (cdr alist-entry))
+ ((if (eq pop-up-frames 'graphic-only)
+ (display-graphic-p)
+ pop-up-frames)
+ 0)
+ (display-buffer-reuse-frames 0)
+ (t (last-nonminibuffer-frame))))
+ entry best-window second-best-window window)
+ ;; Scan windows whether they have shown the buffer recently.
+ (catch 'best
+ (dolist (window (window-list-1 (frame-first-window) 'nomini frames))
+ (when (and (assq buffer (window-prev-buffers window))
+ (not (window-dedicated-p window)))
+ (if (eq window (selected-window))
+ (unless inhibit-same-window
+ (setq second-best-window window))
+ (setq best-window window)
+ (throw 'best t)))))
+ ;; When ALIST has a `previous-window' entry, that entry may override
+ ;; anything we found so far.
+ (when (and (setq window (cdr (assq 'previous-window alist)))
+ (window-live-p window)
+ (not (window-dedicated-p window)))
+ (if (eq window (selected-window))
+ (unless inhibit-same-window
+ (setq second-best-window window))
+ (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 alist))))
+
(defun display-buffer-use-some-window (buffer alist)
"Display BUFFER in an existing window.
Search for a usable window, set that window to the buffer, and
-return the window. If no suitable window is found, return nil."
+return the window. If no suitable window is found, return nil.
+
+If ALIST has a non-nil `inhibit-switch-frame' entry, then in the
+event that a window in another frame is chosen, avoid raising
+that frame."
(let* ((not-this-window (cdr (assq 'inhibit-same-window alist)))
- (window-to-undedicate
- ;; When NOT-THIS-WINDOW is non-nil, temporarily dedicate the
- ;; selected window to its buffer, to prevent any of the
- ;; `get-' routines below from choosing it. (Bug#1415)
- (and not-this-window (not (window-dedicated-p))
- (set-window-dedicated-p (selected-window) t)
- (selected-window)))
(frame (or (window--frame-usable-p (selected-frame))
(window--frame-usable-p (last-nonminibuffer-frame))))
- window)
- (unwind-protect
- (setq window
- ;; Reuse an existing window.
- (or (get-lru-window frame)
- (let ((window (get-buffer-window buffer 'visible)))
- (unless (and not-this-window
- (eq window (selected-window)))
- window))
- (get-largest-window 'visible)
- (let ((window (get-buffer-window buffer 0)))
- (unless (and not-this-window
- (eq window (selected-window)))
- window))
- (get-largest-window 0)))
- (when (window-live-p window-to-undedicate)
- ;; Restore dedicated status of selected window.
- (set-window-dedicated-p window-to-undedicate nil)))
- (when window
- (display-buffer-record-window 'reuse window buffer)
- (window--even-window-heights window)
- (window--display-buffer-2 buffer window))))
+ (window
+ ;; Reuse an existing window.
+ (or (get-lru-window frame nil not-this-window)
+ (let ((window (get-buffer-window buffer 'visible)))
+ (unless (and not-this-window
+ (eq window (selected-window)))
+ window))
+ (get-largest-window 'visible nil not-this-window)
+ (let ((window (get-buffer-window buffer 0)))
+ (unless (and not-this-window
+ (eq window (selected-window)))
+ window))
+ (get-largest-window 0 not-this-window))))
+ (when (window-live-p window)
+ (prog1
+ (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)))))))
;;; Display + selection commands:
-
(defun pop-to-buffer (buffer &optional action norecord)
"Select buffer BUFFER in some window, preferably a different one.
BUFFER may be a buffer, a string (a buffer name), or nil. If it
@@ -4913,8 +5785,7 @@ at the front of the list of recently selected ones."
(if current-prefix-arg t)))
(setq buffer (window-normalize-buffer-to-switch-to buffer))
(set-buffer buffer)
- (let* ((old-window (selected-window))
- (old-frame (selected-frame))
+ (let* ((old-frame (selected-frame))
(window (display-buffer buffer action))
(frame (window-frame window)))
;; If we chose another frame, make sure it gets input focus.
@@ -4978,28 +5849,59 @@ buffer with the name BUFFER-OR-NAME and return that buffer."
buffer))
(other-buffer)))
+(defcustom switch-to-buffer-preserve-window-point nil
+ "If non-nil, `switch-to-buffer' tries to preserve `window-point'.
+If this is nil, `switch-to-buffer' displays the buffer at that
+buffer's `point'. If this is `already-displayed', it tries to
+display the buffer at its previous position in the selected
+window, provided the buffer is currently displayed in some other
+window on any visible or iconified frame. If this is t, it
+unconditionally tries to display the buffer at its previous
+position in the selected window.
+
+This variable is ignored if the buffer is already displayed in
+the selected window or never appeared in it before, or if
+`switch-to-buffer' calls `pop-to-buffer' to display the buffer."
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "If already displayed elsewhere" already-displayed)
+ (const :tag "Always" t))
+ :group 'windows
+ :version "24.3")
+
(defun switch-to-buffer (buffer-or-name &optional norecord force-same-window)
- "Switch to buffer BUFFER-OR-NAME in the selected window.
-If called interactively, prompt for the buffer name using the
+ "Display buffer BUFFER-OR-NAME in the selected window.
+
+WARNING: This is NOT the way to work on another buffer temporarily
+within a Lisp program! Use `set-buffer' instead. That avoids
+messing with the window-buffer correspondences.
+
+If the selected window cannot display the specified
+buffer (e.g. if it is a minibuffer window or strongly dedicated
+to another buffer), call `pop-to-buffer' to select the buffer in
+another window.
+
+If called interactively, read the buffer name using the
minibuffer. The variable `confirm-nonexistent-file-or-buffer'
determines whether to request confirmation before creating a new
buffer.
-BUFFER-OR-NAME may be a buffer, a string (a buffer name), or
-nil. If BUFFER-OR-NAME is a string that does not identify an
-existing buffer, create a buffer with that name. If
-BUFFER-OR-NAME is nil, switch to the buffer returned by
-`other-buffer'.
+BUFFER-OR-NAME may be a buffer, a string (a buffer name), or nil.
+If BUFFER-OR-NAME is a string that does not identify an existing
+buffer, create a buffer with that name. If BUFFER-OR-NAME is
+nil, switch to the buffer returned by `other-buffer'.
-Optional argument NORECORD non-nil means do not put the buffer
-specified by BUFFER-OR-NAME at the front of the buffer list and
-do not make the window displaying it the most recently selected
-one.
+If optional argument NORECORD is non-nil, do not put the buffer
+at the front of the buffer list, and do not make the window
+displaying it the most recently selected one.
-If FORCE-SAME-WINDOW is non-nil, BUFFER-OR-NAME must be displayed
-in the selected window; signal an error if that is
-impossible (e.g. if the selected window is minibuffer-only). If
-nil, BUFFER-OR-NAME may be displayed in another window.
+If optional argument FORCE-SAME-WINDOW is non-nil, the buffer
+must be displayed in the selected window; if that is impossible,
+signal an error rather than calling `pop-to-buffer'.
+
+The option `switch-to-buffer-preserve-window-point' can be used
+to make the buffer appear at its last position in the selected
+window.
Return the buffer switched to."
(interactive
@@ -5011,13 +5913,25 @@ Return the buffer switched to."
((eq buffer (window-buffer)))
((window-minibuffer-p)
(if force-same-window
- (error "Cannot switch buffers in minibuffer window")
+ (user-error "Cannot switch buffers in minibuffer window")
(pop-to-buffer buffer norecord)))
((eq (window-dedicated-p) t)
(if force-same-window
- (error "Cannot switch buffers in a dedicated window")
+ (user-error "Cannot switch buffers in a dedicated window")
(pop-to-buffer buffer norecord)))
- (t (set-window-buffer nil buffer)))
+ (t
+ (let* ((entry (assq buffer (window-prev-buffers)))
+ (displayed (and (eq switch-to-buffer-preserve-window-point
+ 'already-displayed)
+ (get-buffer-window buffer 0))))
+ (set-window-buffer nil buffer)
+ (when (and entry
+ (or (eq switch-to-buffer-preserve-window-point t)
+ displayed))
+ ;; Try to restore start and point of buffer in the selected
+ ;; window (Bug#4041).
+ (set-window-start (selected-window) (nth 1 entry) t)
+ (set-window-point nil (nth 2 entry))))))
(unless norecord
(select-window (selected-window)))
@@ -5072,9 +5986,9 @@ documentation for additional customization information."
(defun set-window-text-height (window height)
"Set the height in lines of the text display area of WINDOW to HEIGHT.
-WINDOW must be a live window. HEIGHT doesn't include the mode
-line or header line, if any, or any partial-height lines in the
-text display area.
+WINDOW must be a live window and defaults to the selected one.
+HEIGHT doesn't include the mode line or header line, if any, or
+any partial-height lines in the text display area.
Note that the current implementation of this function cannot
always set the height exactly, but attempts to be conservative,
@@ -5085,9 +5999,9 @@ where some error may be present."
(unless (zerop delta)
;; Setting window-min-height to a value like 1 can lead to very
;; bizarre displays because it also allows Emacs to make *other*
- ;; windows 1-line tall, which means that there's no more space for
- ;; the modeline.
- (let ((window-min-height (min 2 height))) ; One text line plus a modeline.
+ ;; windows one line tall, which means that there's no more space
+ ;; for the mode line.
+ (let ((window-min-height (min 2 height)))
(window-resize window delta)))))
(defun enlarge-window-horizontally (delta)
@@ -5141,7 +6055,9 @@ in some window."
(1+ (vertical-motion (buffer-size) window))))))
(defun window-buffer-height (window)
- "Return the height (in screen lines) of the buffer that WINDOW is displaying."
+ "Return the height (in screen lines) of the buffer that WINDOW is displaying.
+WINDOW must be a live window and defaults to the selected one."
+ (setq window (window-normalize-window window t))
(with-current-buffer (window-buffer window)
(max 1
(count-screen-lines (point-min) (point-max)
@@ -5151,9 +6067,104 @@ in some window."
window))))
;;; Resizing buffers to fit their contents exactly.
-(defun fit-window-to-buffer (&optional window max-height min-height override)
+(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.3"
+ :group 'help)
+
+(defcustom fit-frame-to-buffer-bottom-margin 4
+ "Bottom margin for the command `fit-frame-to-buffer'.
+This is the number of lines that function leaves free at the bottom of
+the display, in order to not obscure any system task bar or panel.
+If you do not have one (or if it is vertical) you might want to
+reduce this. If it is thicker, you might want to increase this."
+ ;; If you set this too small, fit-frame-to-buffer can shift the
+ ;; frame up to avoid the panel.
+ :type 'integer
+ :version "24.3"
+ :group 'windows)
+
+(defun fit-frame-to-buffer (&optional frame max-height min-height)
+ "Adjust height of FRAME to display its buffer contents exactly.
+FRAME can be any live frame and defaults to the selected one.
+
+Optional argument MAX-HEIGHT specifies the maximum height of FRAME.
+It 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.
+The default corresponds to `window-min-height'."
+ (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 can be any live window and defaults to the selected one.
+WINDOW must be a live window and defaults to the selected one.
Optional argument MAX-HEIGHT specifies the maximum height of
WINDOW and defaults to the height of WINDOW's frame. Optional
@@ -5162,9 +6173,9 @@ defaults to `window-min-height'. Both MAX-HEIGHT and MIN-HEIGHT
are specified in lines and include the mode line and header line,
if any.
-Optional argument OVERRIDE non-nil means override restrictions
-imposed by `window-min-height' and `window-min-width' on the size
-of WINDOW.
+If WINDOW is a full height window, then if the option
+`fit-frame-to-buffer' is non-nil, this calls the function
+`fit-frame-to-buffer' to adjust the frame height.
Return the number of lines by which WINDOW was enlarged or
shrunk. If an error occurs during resizing, return nil but don't
@@ -5174,28 +6185,30 @@ Note that even if this function makes WINDOW large enough to show
_all_ lines of its buffer you might not see the first lines when
WINDOW was scrolled."
(interactive)
- ;; Do all the work in WINDOW and its buffer and restore the selected
- ;; window and the current buffer when we're done.
(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))
- ;; `with-selected-window' should orderly restore the current buffer.
+ (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
- ;; We are in WINDOW's buffer now.
- (let* (;; Adjust MIN-HEIGHT.
+ (let* ((height (window-total-size))
(min-height
- (if override
- (window-min-size window nil window)
- (max (or min-height window-min-height)
- window-safe-min-height)))
- (max-window-height
- (window-total-size (frame-root-window window)))
- ;; Adjust MAX-HEIGHT.
+ ;; Adjust MIN-HEIGHT.
+ (if (numberp min-height)
+ ;; Can't get smaller than `window-safe-min-height'.
+ (max min-height window-safe-min-height)
+ ;; Preserve header and mode line if present.
+ (window-min-size nil nil t)))
(max-height
- (if (or override (not max-height))
- max-window-height
- (min max-height max-window-height)))
+ ;; Adjust MAX-HEIGHT.
+ (if (numberp max-height)
+ ;; Can't get larger than height of frame.
+ (min max-height
+ (window-total-size (frame-root-window window)))
+ ;; 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
;; and MAX-HEIGHT.
@@ -5220,7 +6233,6 @@ WINDOW was scrolled."
(window-max-delta window nil window))
(max desired-delta
(- (window-min-delta window nil window))))))
- ;; This `condition-case' shouldn't be necessary, but who knows?
(condition-case nil
(if (zerop delta)
;; Return zero if DELTA became zero in the process.
@@ -5258,7 +6270,7 @@ WINDOW was scrolled."
(window-resize window 1 nil window)
(setq desired-height (1+ desired-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.
@@ -5272,7 +6284,7 @@ WINDOW defaults to the selected window."
"Shrink height of WINDOW if its buffer doesn't need so many lines.
More precisely, shrink WINDOW vertically to be as small as
possible, while still showing the full contents of its buffer.
-WINDOW defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
Do not shrink WINDOW to less than `window-min-height' lines. Do
nothing if the buffer contains more lines than the present window
@@ -5415,7 +6427,7 @@ A value of t means point moves to the beginning or the end of the buffer
\(depending on scrolling direction) when no more scrolling possible.
When point is already on that position, then signal an error."
:type 'boolean
- :group 'scrolling
+ :group 'windows
:version "24.1")
(defun scroll-up-command (&optional arg)
@@ -5503,7 +6515,7 @@ This is different from `scroll-down-command' that scrolls a full screen."
(put 'scroll-down-line 'scroll-command t)
-(defun scroll-other-window-down (lines)
+(defun scroll-other-window-down (&optional lines)
"Scroll the \"other window\" down.
For more details, see the documentation for `scroll-other-window'."
(interactive "P")
@@ -5688,17 +6700,18 @@ is active. This function is run by `mouse-autoselect-window-timer'."
(setq mouse-autoselect-window-state nil)
;; Run `mouse-leave-buffer-hook' when autoselecting window.
(run-hooks 'mouse-leave-buffer-hook))
+ ;; Clear echo area.
+ (message nil)
(select-window window))))
(defun truncated-partial-width-window-p (&optional window)
"Return non-nil if lines in WINDOW are specifically truncated due to its width.
-WINDOW defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
Return nil if WINDOW is not a partial-width window
(regardless of the value of `truncate-lines').
Otherwise, consult the value of `truncate-partial-width-windows'
for the buffer shown in WINDOW."
- (unless window
- (setq window (selected-window)))
+ (setq window (window-normalize-window window t))
(unless (window-full-width-p window)
(let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows
(window-buffer window))))
diff --git a/lisp/winner.el b/lisp/winner.el
index 70038362c2e..65b3d30a80c 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -1,6 +1,6 @@
;;; winner.el --- Restore old window configurations
-;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation. Inc.
+;; Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Ivar Rummelhoff <ivarru@math.uio.no>
;; Created: 27 Feb 1997
@@ -38,20 +38,17 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
-
-(defmacro winner-active-region ()
+(defun winner-active-region ()
+ (declare (gv-setter (lambda (store)
+ (if (featurep 'xemacs)
+ `(if ,store (zmacs-activate-region)
+ (zmacs-deactivate-region))
+ `(setq mark-active ,store)))))
(if (boundp 'mark-active)
- 'mark-active
- '(region-active-p)))
-
-(defsetf winner-active-region () (store)
- (if (featurep 'xemacs)
- `(if ,store (zmacs-activate-region)
- (zmacs-deactivate-region))
- `(setq mark-active ,store)))
+ mark-active
+ (region-active-p)))
(defalias 'winner-edges
(if (featurep 'xemacs) 'window-pixel-edges 'window-edges))
@@ -66,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)
@@ -88,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)
@@ -107,15 +91,15 @@ You may want to include buffer names such as *Help*, *Apropos*,
(defun winner-sorted-window-list ()
(sort (winner-window-list)
(lambda (x y)
- (loop for a in (winner-edges x)
- for b in (winner-edges y)
- while (= a b)
- finally return (< a b)))))
+ (cl-loop for a in (winner-edges x)
+ for b in (winner-edges y)
+ while (= a b)
+ finally return (< a b)))))
(defun winner-win-data ()
;; Essential properties of the windows in the selected frame.
- (loop for win in (winner-sorted-window-list)
- collect (cons (winner-edges win) (window-buffer win))))
+ (cl-loop for win in (winner-sorted-window-list)
+ collect (cons (winner-edges win) (window-buffer win))))
;; This variable is updated with the current window configuration
;; every time it changes.
@@ -138,7 +122,7 @@ You may want to include buffer names such as *Help*, *Apropos*,
;; Consult `winner-currents'.
(defun winner-configuration (&optional frame)
(or (cdr (assq (or frame (selected-frame)) winner-currents))
- (letf (((selected-frame) frame))
+ (with-selected-frame frame
(winner-conf))))
@@ -240,15 +224,15 @@ You may want to include buffer names such as *Help*, *Apropos*,
(let* ((miniwin (minibuffer-window))
(chosen (selected-window))
(minisize (window-height miniwin)))
- (letf (((window-buffer miniwin))
- ((window-point miniwin)))
+ (cl-letf (((window-buffer miniwin))
+ ((window-point miniwin)))
(set-window-configuration winconf))
(cond
((window-live-p chosen) (select-window chosen))
((window-minibuffer-p (selected-window))
(other-window 1)))
(when (/= minisize (window-height miniwin))
- (letf (((selected-window) miniwin) )
+ (with-selected-window miniwin
(setf (window-height) minisize)))))
@@ -261,17 +245,17 @@ You may want to include buffer names such as *Help*, *Apropos*,
;; Format of entries: (buffer (mark . mark-active) (window . point) ..)
(defun winner-make-point-alist ()
- (letf (((current-buffer)))
- (loop with alist
- for win in (winner-window-list)
- for entry =
- (or (assq (window-buffer win) alist)
- (car (push (list (set-buffer (window-buffer win))
- (cons (mark t) (winner-active-region)))
- alist)))
- do (push (cons win (window-point win))
- (cddr entry))
- finally return alist)))
+ (save-current-buffer
+ (cl-loop with alist
+ for win in (winner-window-list)
+ for entry =
+ (or (assq (window-buffer win) alist)
+ (car (push (list (set-buffer (window-buffer win))
+ (cons (mark t) (winner-active-region)))
+ alist)))
+ do (push (cons win (window-point win))
+ (cddr entry))
+ finally return alist)))
(defun winner-get-point (buf win)
;; Consult (and possibly extend) `winner-point-alist'.
@@ -282,10 +266,10 @@ You may want to include buffer names such as *Help*, *Apropos*,
(entry
(or (cdr (assq win (cddr entry)))
(cdr (assq nil (cddr entry)))
- (letf (((current-buffer) buf))
+ (with-current-buffer buf
(push (cons nil (point)) (cddr entry))
(point))))
- (t (letf (((current-buffer) buf))
+ (t (with-current-buffer buf
(push (list buf
(cons (mark t) (winner-active-region))
(cons nil (point)))
@@ -302,11 +286,11 @@ You may want to include buffer names such as *Help*, *Apropos*,
(let* ((buffers nil)
(alive
;; Possibly update `winner-point-alist'
- (loop for buf in (mapcar 'cdr (cdr conf))
- for pos = (winner-get-point buf nil)
- if (and pos (not (memq buf buffers)))
- do (push buf buffers)
- collect pos)))
+ (cl-loop for buf in (mapcar 'cdr (cdr conf))
+ for pos = (winner-get-point buf nil)
+ if (and pos (not (memq buf buffers)))
+ do (push buf buffers)
+ collect pos)))
(winner-set-conf (car conf))
(let (xwins) ; to be deleted
@@ -320,12 +304,12 @@ You may want to include buffer names such as *Help*, *Apropos*,
(push win xwins))) ; delete this window
;; Restore marks
- (letf (((current-buffer)))
- (loop for buf in buffers
- for entry = (cadr (assq buf winner-point-alist))
- do (progn (set-buffer buf)
- (set-mark (car entry))
- (setf (winner-active-region) (cdr entry)))))
+ (save-current-buffer
+ (cl-loop for buf in buffers
+ for entry = (cadr (assq buf winner-point-alist))
+ do (progn (set-buffer buf)
+ (set-mark (car entry))
+ (setf (winner-active-region) (cdr entry)))))
;; Delete windows, whose buffers are dead or boring.
;; Return t if this is still a possible configuration.
(or (null xwins)
@@ -340,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.")
@@ -367,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)
@@ -422,7 +394,7 @@ In other words, \"undo\" changes in window configuration."
(setq winner-pending-undo-ring (winner-ring (selected-frame)))
(setq winner-undo-counter 0)
(setq winner-undone-data (list (winner-win-data))))
- (incf winner-undo-counter) ; starting at 1
+ (cl-incf winner-undo-counter) ; starting at 1
(when (and (winner-undo-this)
(not (window-minibuffer-p (selected-window))))
(message "Winner undo (%d / %d)"
@@ -433,11 +405,11 @@ In other words, \"undo\" changes in window configuration."
(defun winner-undo-this () ; The heart of winner undo.
- (loop
+ (cl-loop
(cond
((>= winner-undo-counter (ring-length winner-pending-undo-ring))
(message "No further window configuration undo information")
- (return nil))
+ (cl-return nil))
((and ; If possible configuration
(winner-set (ring-ref winner-pending-undo-ring
@@ -446,7 +418,7 @@ In other words, \"undo\" changes in window configuration."
(let ((data (winner-win-data)))
(and (not (member data winner-undone-data))
(push data winner-undone-data))))
- (return t)) ; .. then everything is fine.
+ (cl-return t)) ; .. then everything is fine.
(t ;; Otherwise, discharge it (and try the next one).
(ring-remove winner-pending-undo-ring winner-undo-counter)))))
@@ -464,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
diff --git a/lisp/woman.el b/lisp/woman.el
index 243196a5302..c7f9b08d404 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1,6 +1,6 @@
;;; woman.el --- browse UN*X manual pages `wo (without) man'
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
;; Maintainer: FSF
@@ -115,25 +115,6 @@
;; package will over-write the WoMan binding to "w", whereas (by
;; default) WoMan will not overwrite the `dired-x' binding.)
-;; The following is based on suggestions by Guy Gascoigne-Piggford and
-;; Juanma Barranquero. If you really want to square the man-woman
-;; circle then you might care to define the following bash function in
-;; .bashrc:
-
-;; man() { gnudoit -q '(raise-frame (selected-frame)) (woman' \"$1\" ')' ; }
-
-;; If you use Microsoft COMMAND.COM then you can create a file called
-;; man.bat somewhere in your path containing the two lines:
-
-;; @echo off
-;; gnudoit -q (raise-frame (selected-frame)) (woman \"%1\")
-
-;; and then (e.g. from a command prompt or the Run... option in the
-;; Start menu) just execute
-
-;; man man_page_name
-
-
;; Using the word at point as the default topic
;; ============================================
@@ -368,8 +349,8 @@
;; http://cm.bell-labs.com/7thEdMan/
-;; Acknowledgements
-;; ================
+;; Acknowledgments
+;; ===============
;; For Heather, Kathryn and Madelyn, the women in my life
;; (although they will probably never use it)!
@@ -435,7 +416,7 @@
(eval-when-compile ; to avoid compiler warnings
(require 'dired)
- (require 'cl)
+ (require 'cl-lib)
(require 'apropos))
(defun woman-mapcan (fn x)
@@ -968,6 +949,7 @@ or different fonts."
(defun woman-default-faces ()
"Set foreground colors of italic and bold faces to their default values."
+ (declare (obsolete choose-completion-guess-base-position "23.2"))
(interactive)
(face-spec-set 'woman-italic (face-user-default-spec 'woman-italic))
(face-spec-set 'woman-bold (face-user-default-spec 'woman-bold)))
@@ -975,6 +957,7 @@ or different fonts."
(defun woman-monochrome-faces ()
"Set foreground colors of italic and bold faces to that of the default face.
This is usually either black or white."
+ (declare (obsolete choose-completion-guess-base-position "23.2"))
(interactive)
(set-face-foreground 'woman-italic 'unspecified)
(set-face-foreground 'woman-bold 'unspecified))
@@ -1322,12 +1305,12 @@ cache to be re-read."
((null (cdr files)) (car (car files))) ; only 1 file for topic.
(t
;; Multiple files for topic, so must select 1.
- ;; Unread the command event (TAB = ?\t = 9) that runs the command
- ;; `minibuffer-complete' in order to automatically complete the
- ;; minibuffer contents as far as possible.
- (setq unread-command-events '(9)) ; and delete any type-ahead!
- (completing-read "Manual file: " files nil 1
- (try-completion "" files) 'woman-file-history))))))
+ ;; Run the command `minibuffer-complete' in order to automatically
+ ;; complete the minibuffer contents as far as possible.
+ (minibuffer-with-setup-hook
+ (lambda () (let ((this-command this-command)) (minibuffer-complete)))
+ (completing-read "Manual file: " files nil 1
+ (try-completion "" files) 'woman-file-history)))))))
(defun woman-select (predicate list)
"Select unique elements for which PREDICATE is true in LIST.
@@ -1569,11 +1552,13 @@ Also make each path-info component into a list.
(woman-dired-define-keys)
(add-hook 'dired-mode-hook 'woman-dired-define-keys))
+(declare-function dired-get-filename "dired"
+ (&optional localp no-error-if-not-filep))
+
;;;###autoload
(defun woman-dired-find-file ()
"In dired, run the WoMan man-page browser on this file."
(interactive)
- ;; dired-get-filename is defined in dired.el
(woman-find-file (dired-get-filename)))
@@ -1595,14 +1580,6 @@ Also make each path-info component into a list.
(woman-process-buffer)
(goto-char (point-min)))))
-;; There is currently no `tar-mode-hook' so use ...
-(eval-after-load "tar-mode"
- '(progn
- (define-key tar-mode-map "w" 'woman-tar-extract-file)
- (define-key-after (lookup-key tar-mode-map [menu-bar immediate])
- [woman] '("Read Man Page (WoMan)" . woman-tar-extract-file) 'view)))
-
-
(defvar woman-last-file-name nil
"The full pathname of the last file formatted by WoMan.")
@@ -1853,8 +1830,6 @@ Argument EVENT is the invoking mouse event."
["Use Full Frame Width" woman-toggle-fill-frame
:active t :style toggle :selected woman-fill-frame]
["Reformat Last Man Page" woman-reformat-last-file t]
- ["Use Monochrome Main Faces" woman-monochrome-faces t]
- ["Use Default Main Faces" woman-default-faces t]
["Make Contents Menu" (woman-imenu t) (not woman-imenu-done)]
"--"
["Describe (Wo)Man Mode" describe-mode t]
@@ -1974,6 +1949,9 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated."
(message "Woman fill column set to %s."
(if woman-fill-frame "frame width" woman-fill-column)))
+(declare-function apropos-print "apropos"
+ (do-keys spacing &optional text nosubst))
+
(defun woman-mini-help ()
"Display WoMan commands and user options in an `apropos' buffer."
;; Based on apropos-command in apropos.el
@@ -1987,7 +1965,7 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated."
(lambda (symbol)
(and
(or (commandp symbol)
- (user-variable-p symbol))
+ (custom-variable-p symbol))
(not (get symbol 'apropos-inhibit))))))
;; Find documentation strings:
(let ((p apropos-accumulator)
@@ -1999,7 +1977,7 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated."
(if (setq doc (documentation symbol t))
(substring doc 0 (string-match "\n" doc))
"(not documented)"))
- (if (user-variable-p symbol) ; 3. variable doc
+ (if (custom-variable-p symbol) ; 3. variable doc
(if (setq doc (documentation-property
symbol 'variable-documentation t))
(substring doc 0 (string-match "\n" doc))))))
@@ -2141,7 +2119,7 @@ European characters."
(copy-sequence standard-display-table)
(make-display-table)))
;; Display the following internal chars correctly:
- (aset buffer-display-table woman-unpadded-space-char [?\ ])
+ (aset buffer-display-table woman-unpadded-space-char [?\s])
(aset buffer-display-table woman-escaped-escape-char [?\\]))
@@ -2218,7 +2196,7 @@ To be called on original buffer and any .so insertions."
(face-underline-p face))
(let ((face-no-ul (intern (concat face-name "-no-ul"))))
(copy-face face face-no-ul)
- (set-face-underline-p face-no-ul nil)))))))
+ (set-face-underline face-no-ul nil)))))))
;; Preprocessors
;; =============
@@ -2280,7 +2258,9 @@ Currently set only from '\" t in the first line of the source file.")
(set-face-font 'woman-symbol woman-symbol-font
(and (frame-live-p woman-frame) woman-frame)))
- ;; Set syntax and display tables:
+ (setq-local adaptive-fill-mode nil) ; No special "%" "#" etc filling.
+
+ ;; Set syntax and display tables:
(set-syntax-table woman-syntax-table)
(woman-set-buffer-display-table)
@@ -2393,18 +2373,20 @@ Currently set only from '\" t in the first line of the source file.")
(if woman-negative-vertical-space
(woman-negative-vertical-space from))
- (if woman-preserve-ascii
- ;; Re-instate escaped escapes to just `\' and unpaddable
- ;; spaces to just `space', without inheriting any text
- ;; properties. This is not necessary, UNLESS the buffer is to
- ;; be saved as ASCII.
- (progn
- (goto-char from)
- (while (search-forward woman-escaped-escape-string nil t)
- (delete-char -1) (insert ?\\))
- (goto-char from)
- (while (search-forward woman-unpadded-space-string nil t)
- (delete-char -1) (insert ?\ ))))
+ (when woman-preserve-ascii
+ ;; Re-instate escaped escapes to just `\' and unpaddable spaces
+ ;; to just `space'. This is not necessary for display since
+ ;; there are display table entries for the escaped chars, but it
+ ;; is necessary if the buffer might be saved as ASCII.
+ ;;
+ ;; `subst-char-in-region' preserves text properties on the
+ ;; characters, which is necessary for bold, underline, etc on
+ ;; \e. There's usually no face on spaces, but if there is then
+ ;; it's good to keep that too.
+ (subst-char-in-region from (point-max)
+ woman-escaped-escape-char ?\\)
+ (subst-char-in-region from (point-max)
+ woman-unpadded-space-char ?\s))
;; Must return the new end of file if used in format-alist.
(point-max)))
@@ -2445,9 +2427,9 @@ Preserves location of `point'."
;; first backwards then forwards:
(while (and
(<= (setq N (1+ N)) 0)
- (cond ((memq (preceding-char) '(?\ ?\t))
+ (cond ((memq (preceding-char) '(?\s ?\t))
(delete-char -1) t)
- ((memq (following-char) '(?\ ?\t))
+ ((memq (following-char) '(?\s ?\t))
(delete-char 1) t)
(t nil))))
(if (<= N 0)
@@ -2556,7 +2538,8 @@ REQUEST is the invoking directive without the leading dot."
(cond
;; ((looking-at "[no]") (setq c t)) ; accept n(roff) and o(dd page)
;; ((looking-at "[te]") (setq c nil)) ; reject t(roff) and e(ven page)
- ((looking-at "[ntoe]")
+ ;; Per groff ".if v" is recognized as false (it means -Tversatec).
+ ((looking-at "[ntoev]")
(setq c (memq (following-char) woman-if-conditions-true)))
;; Unrecognized letter so reject:
((looking-at "[A-Za-z]") (setq c nil)
@@ -2685,8 +2668,7 @@ If DELETE is non-nil then delete from point."
;; then use the WoMan search mechanism to find the filename ...
(setq filename
(woman-file-name
- (file-name-sans-extension
- (file-name-nondirectory name))))
+ (file-name-base name)))
;; Cannot find the file, so ...
(kill-buffer (current-buffer))
(error "File `%s' not found" name))
@@ -2872,15 +2854,18 @@ interpolated by `\*x' and `\*(xx' escapes."
(re-search-forward "[^ \t\n]+")
(let ((string (match-string 0)))
(skip-chars-forward " \t")
-; (setq string
-; (cons string
-; ;; hack (?) for CGI.man!
-; (cond ((looking-at "\"\"") "\"")
-; ((looking-at ".*") (match-string 0)))
-; ))
- ;; Above hack causes trouble in arguments!
- (looking-at ".*")
- (setq string (cons string (match-string 0)))
+ (if (= ?\" (following-char))
+ ;; Double-quote starts a string, eg.
+ ;; .ds foo "blah...
+ ;; is value blah... through to newline. There's no
+ ;; closing " (per the groff manual), but rather any
+ ;; further " is included literally in the string. Eg.
+ ;; .ds foo ""
+ ;; sets foo to a single " character.
+ (forward-char))
+ (setq string (cons string
+ (buffer-substring (point)
+ (line-end-position))))
;; This should be an update, but consing a new string
;; onto the front of the alist has the same effect:
(setq woman-string-alist (cons string woman-string-alist))
@@ -3384,7 +3369,7 @@ Ignore the default face and underline only word characters."
;; this used to be globally bound to nil, to avoid an error. Instead
;; we can use bound-and-true-p in woman-translate.
(defvar woman-translations)
-;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\ )) or nil.
+;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\s)) or nil.
(defun woman-get-next-char ()
"Return and delete next char in buffer, including special chars."
@@ -3592,7 +3577,7 @@ expression in parentheses. Leaves point after the value."
(let (n)
(forward-char)
(setq n (woman-parse-numeric-arg))
- (skip-syntax-forward " ")
+ (skip-syntax-forward " " (line-end-position))
(if (eq (following-char) ?\))
(forward-char)
(WoMan-warn "Parenthesis confusion in numeric expression!"))
@@ -3644,7 +3629,7 @@ expression in parentheses. Leaves point after the value."
(buffer-substring
(point)
(line-end-position)))
- (skip-syntax-forward "^ ")
+ (skip-syntax-forward "^ " (line-end-position))
0)
(goto-char (match-end 0))
;; Check for scale factor:
@@ -3654,7 +3639,9 @@ expression in parentheses. Leaves point after the value."
((looking-at "[mnuv]")) ; ignore for now
((looking-at "i") (setq n (* n 10))) ; inch
((looking-at "c") (setq n (* n 3.9))) ; cm
- ((looking-at "P") (setq n (* n 1.7))) ; Pica
+ ((let ((case-fold-search nil))
+ (looking-at "P"))
+ (setq n (* n 1.7))) ; Pica
((looking-at "p") (setq n (* n 0.14))) ; point
;; NB: May be immediately followed by + or -, etc.,
;; in which case do nothing and return nil.
@@ -3719,7 +3706,9 @@ expression in parentheses. Leaves point after the value."
(setq fn 'woman2-format-paragraphs))))
()
;; Find next control line:
- (set-marker to (woman-find-next-control-line))
+ (if (equal woman-request "TS")
+ (set-marker to (woman-find-next-control-line "TE"))
+ (set-marker to (woman-find-next-control-line)))
;; Call the appropriate function:
(funcall fn to)))
(if (not (eobp)) ; This should not happen, but ...
@@ -3730,12 +3719,13 @@ expression in parentheses. Leaves point after the value."
(fset 'insert-and-inherit insert-and-inherit)
(set-marker to nil))))
-(defun woman-find-next-control-line ()
- "Find and return start of next control line."
-; (let ((to (save-excursion
-; (re-search-forward "^\\." nil t))))
-; (if to (1- to) (point-max)))
- (let (to)
+(defun woman-find-next-control-line (&optional pat)
+ "Find and return start of next control line.
+PAT, if non-nil, specifies an additional component of the control
+line regexp to search for, which is appended to the default
+regexp, \"\\(\\\\c\\)?\\n[.']\"."
+ (let ((pattern (concat "\\(\\\\c\\)?\n[.']" pat))
+ to)
(save-excursion
;; Must handle
;; ...\c
@@ -3744,12 +3734,14 @@ expression in parentheses. Leaves point after the value."
;; BEWARE THAT THIS CODE MAY BE UNRELIABLE!!!!!
(while
(and
- (setq to (re-search-forward "\\(\\\\c\\)?\n[.']" nil t))
+ (setq to (re-search-forward pattern nil t))
(match-beginning 1)
(looking-at "br"))
(goto-char (match-beginning 0))
(woman-delete-line 2)))
- (if to (1- to) (point-max))))
+ (if to
+ (- to (+ 1 (length pat)))
+ (point-max))))
(defun woman2-PD (to)
".PD d -- Set the interparagraph distance to d.
@@ -3893,18 +3885,18 @@ Leave 1 blank line. Format paragraphs upto TO."
(insert (substring overlap i eol))
(setq i (or eol imax)))
)
- ((eq c ?\ ) ; skip
+ ((eq c ?\s) ; skip
(forward-char))
((eq c ?\t) ; skip
(if (eq (following-char) ?\t)
(forward-char) ; both tabs, just skip
(dotimes (i woman-tab-width)
(if (eolp)
- (insert ?\ ) ; extend line
+ (insert ?\s) ; extend line
(forward-char)) ; skip
)))
(t
- (if (or (eq (following-char) ?\ ) ; overwrite OK
+ (if (or (eq (following-char) ?\s) ; overwrite OK
overwritten) ; warning only once per ".sp -"
()
(setq overwritten t)
@@ -3923,7 +3915,7 @@ Leave 1 blank line. Format paragraphs upto TO."
(defun woman2-process-escapes (to &optional numeric)
"Process remaining escape sequences up to marker TO, preserving point.
Optional argument NUMERIC, if non-nil, means the argument is numeric."
- (assert (and (markerp to) (marker-insertion-type to)))
+ (cl-assert (and (markerp to) (marker-insertion-type to)))
;; The first two cases below could be merged (maybe)!
(let ((from (point)))
;; Discard zero width filler character used to hide leading dots
@@ -3931,7 +3923,9 @@ Optional argument NUMERIC, if non-nil, means the argument is numeric."
(while (re-search-forward "\\\\[&|^]" to t)
(woman-delete-match 0)
;; If on a line by itself, consume newline as well (Bug#3651).
- (and (eq (char-before (match-beginning 0)) ?\n)
+ ;; But not in a .nf region, preserve all newlines in that case.
+ (and (not woman-nofill)
+ (eq (char-before (match-beginning 0)) ?\n)
(eq (char-after (match-beginning 0)) ?\n)
(delete-char 1)))
@@ -4408,7 +4402,7 @@ tab stop columns or pairs (COLUMN . TYPE) where TYPE is R or C."
tab (- tab (if (eq type ?C) (/ n 2) n))) )
(setq n (- tab (current-column)))
(insert-char ?\s n))
- (insert ?\ ))))
+ (insert ?\s))))
(defun woman2-DT (to)
".DT -- Restore default tabs. Format paragraphs upto TO.
@@ -4426,7 +4420,7 @@ Needs doing properly!"
(if (eolp)
(woman-delete-whole-line) ; ignore!
(let ((delim (following-char))
- (pad ?\ ) end) ; pad defaults to space
+ (pad ?\s) end) ; pad defaults to space
(forward-char)
(skip-chars-forward " \t")
(or (eolp) (setq pad (following-char)))
@@ -4457,8 +4451,6 @@ Needs doing properly!"
(defun woman2-TS (to)
".TS -- Start of table code for the tbl processor.
Format paragraphs upto TO."
- ;; This is a preliminary hack that seems to suffice for lilo.8.
- (woman-delete-line 1) ; ignore any arguments
(when woman-emulate-tbl
;; Assumes column separator is \t and intercolumn spacing is 3.
;; The first line may optionally be a list of options terminated by
@@ -4470,6 +4462,22 @@ Format paragraphs upto TO."
(woman-delete-line 1)
;; For each column, find its width and align it:
(let ((start (point)) (col 1))
+ (WoMan-log "%s" (buffer-substring start (+ start 40)))
+ ;; change T{ T} to tabs
+ (while (search-forward "T{\n" to t)
+ (replace-match "")
+ (catch 'end
+ (while (search-forward "\n" to t)
+ (replace-match " ")
+ (if (looking-at "T}")
+ (progn
+ (delete-char 2)
+ (throw 'end t))))))
+ (goto-char start)
+ ;; strip space and headers
+ (while (re-search-forward "^\\.TH\\|\\.sp" to t)
+ (woman-delete-whole-line))
+ (goto-char start)
(while (prog1 (search-forward "\t" to t) (goto-char start))
;; Find current column width:
(while (< (point) to)
@@ -4483,8 +4491,25 @@ Format paragraphs upto TO."
(while (< (point) to)
(when (search-forward "\t" to t)
(delete-char -1)
- (insert-char ?\ (- col (current-column))))
+ (insert-char ?\s (- col (current-column))))
(forward-line))
+ (goto-char start))
+ ;; find maximum width
+ (let ((max-col 0))
+ (while (search-forward "\n" to t)
+ (backward-char)
+ (if (> (current-column) max-col)
+ (setq max-col (current-column)))
+ (forward-char))
+ (goto-char start)
+ ;; break lines if they are too long
+ (when (and (> max-col woman-fill-column)
+ (> woman-fill-column col))
+ (setq max-col woman-fill-column)
+ (woman-break-table col to start)
+ (goto-char start))
+ (while (re-search-forward "^_$" to t)
+ (replace-match (make-string max-col ?_)))
(goto-char start))))
;; Format table with no filling or adjusting (cf. woman2-nf):
(setq woman-nofill t)
@@ -4494,6 +4519,17 @@ Format paragraphs upto TO."
;; ".TE -- End of table code for the tbl processor."
;; Turn filling and adjusting back on.
+(defun woman-break-table (start-column to start)
+ (while (< (point) to)
+ (move-to-column woman-fill-column)
+ (if (eolp)
+ (forward-line)
+ (if (and (search-backward " " start t)
+ (> (current-column) start-column))
+ (progn
+ (insert-char ?\n 1)
+ (insert-char ?\s (- start-column 5)))
+ (forward-line)))))
;;; WoMan message logging:
@@ -4531,7 +4567,7 @@ IGNORED is a string appended to the log message."
(buffer-substring (point)
(line-end-position))))
(if (and (> (length tail) 0)
- (/= (string-to-char tail) ?\ ))
+ (/= (string-to-char tail) ?\s))
(setq tail (concat " " tail)))
(WoMan-log-1
(concat "** " request tail " request " ignored))))
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index fbb76da1b91..539b95a18fd 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -1,6 +1,6 @@
;;; x-dnd.el --- drag and drop support for X -*- coding: utf-8 -*-
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Jan Djärv <jan.h.d@swipnet.se>
;; Maintainer: FSF
@@ -431,7 +431,7 @@ otherwise return the frame coordinates."
(declare-function x-send-client-message "xselect.c"
(display dest from message-type format values))
(declare-function x-get-selection-internal "xselect.c"
- (selection-symbol target-type &optional time-stamp))
+ (selection-symbol target-type &optional time-stamp terminal))
(defun x-dnd-version-from-flags (flags)
"Return the version byte from the 32 bit FLAGS in an XDndEnter message"
diff --git a/lisp/xml.el b/lisp/xml.el
index 478872dd92e..d395f75ec0f 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -1,6 +1,6 @@
;;; xml.el --- XML parser
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Emmanuel Briot <briot@gnat.com>
;; Maintainer: Mark A. Hershberger <mah@everybody.org>
@@ -80,25 +80,36 @@
;; a worthwhile tradeoff especially since we're usually parsing files
;; instead of hand-crafted XML.
-;;*******************************************************************
-;;**
-;;** Macros to parse the list
-;;**
-;;*******************************************************************
+;;; Macros to parse the list
(defconst xml-undefined-entity "?"
"What to substitute for undefined entities")
+(defconst xml-default-ns '(("" . "")
+ ("xml" . "http://www.w3.org/XML/1998/namespace")
+ ("xmlns" . "http://www.w3.org/2000/xmlns/"))
+ "Alist mapping default XML namespaces to their URIs.")
+
(defvar xml-entity-alist
- '(("lt" . "<")
+ '(("lt" . "&#60;")
("gt" . ">")
("apos" . "'")
("quot" . "\"")
- ("amp" . "&"))
- "The defined entities. Entities are added to this when the DTD is parsed.")
+ ("amp" . "&#38;"))
+ "Alist mapping XML entities to their replacement text.")
+
+(defvar xml-entity-expansion-limit 20000
+ "The maximum size of entity reference expansions.
+If the size of the buffer increases by this many characters while
+expanding entity references in a segment of character data, the
+XML parser signals an error. Setting this to nil removes the
+limit (making the parser vulnerable to XML bombs).")
+
+(defvar xml-parameter-entity-alist nil
+ "Alist of defined XML parametric entities.")
(defvar xml-sub-parser nil
- "Dynamically set this to a non-nil value if you want to parse an XML fragment.")
+ "Non-nil when the XML parser is parsing an XML fragment.")
(defvar xml-validating-parser nil
"Set to non-nil to get validity checking.")
@@ -115,7 +126,10 @@ tag. For example,
would be represented by
- '(\"\" . \"foo\")."
+ '(\"\" . \"foo\").
+
+If you'd just like a plain symbol instead, use 'symbol-qnames in
+the PARSE-NS argument."
(car node))
@@ -153,191 +167,247 @@ An empty string is returned if the attribute was not found.
See also `xml-get-attribute-or-nil'."
(or (xml-get-attribute-or-nil node attribute) ""))
-;;*******************************************************************
-;;**
-;;** Creating the list
-;;**
-;;*******************************************************************
+;;; Regular expressions for XML components
-;;;###autoload
-(defun xml-parse-file (file &optional parse-dtd parse-ns)
- "Parse the well-formed XML file FILE.
-If FILE is already visited, use its buffer and don't kill it.
-Returns the top node with all its children.
-If PARSE-DTD is non-nil, the DTD is parsed rather than skipped.
-If PARSE-NS is non-nil, then QNAMES are expanded."
- (if (get-file-buffer file)
- (with-current-buffer (get-file-buffer file)
- (save-excursion
- (xml-parse-region (point-min)
- (point-max)
- (current-buffer)
- parse-dtd parse-ns)))
- (with-temp-buffer
- (insert-file-contents file)
- (xml-parse-region (point-min)
- (point-max)
- (current-buffer)
- parse-dtd parse-ns))))
-
-
-(defvar xml-name-re)
-(defvar xml-entity-value-re)
-(defvar xml-att-def-re)
-(let* ((start-chars (concat "[:alpha:]:_"))
- (name-chars (concat "-[:digit:]." start-chars))
- ;;[3] S ::= (#x20 | #x9 | #xD | #xA)+
- (whitespace "[ \t\n\r]"))
- ;;[4] NameStartChar ::= ":" | [A-Z] | "_" | [a-z] | [#xC0-#xD6]
- ;; | [#xD8-#xF6] | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF]
- ;; | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF]
- ;; | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF]
- (defvar xml-name-start-char-re (concat "[" start-chars "]"))
- ;;[4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7 | [#x0300-#x036F] | [#x203F-#x2040]
- (defvar xml-name-char-re (concat "[" name-chars "]"))
- ;;[5] Name ::= NameStartChar (NameChar)*
- (defvar xml-name-re (concat xml-name-start-char-re xml-name-char-re "*"))
- ;;[6] Names ::= Name (#x20 Name)*
- (defvar xml-names-re (concat xml-name-re "\\(?: " xml-name-re "\\)*"))
- ;;[7] Nmtoken ::= (NameChar)+
- (defvar xml-nmtoken-re (concat xml-name-char-re "+"))
- ;;[8] Nmtokens ::= Nmtoken (#x20 Nmtoken)*
- (defvar xml-nmtokens-re (concat xml-nmtoken-re "\\(?: " xml-name-re "\\)*"))
- ;;[66] CharRef ::= '&#' [0-9]+ ';' | '&#x' [0-9a-fA-F]+ ';'
- (defvar xml-char-ref-re "\\(?:&#[0-9]+;\\|&#x[0-9a-fA-F]+;\\)")
- ;;[68] EntityRef ::= '&' Name ';'
- (defvar xml-entity-ref (concat "&" xml-name-re ";"))
- ;;[69] PEReference ::= '%' Name ';'
- (defvar xml-pe-reference-re (concat "%" xml-name-re ";"))
- ;;[67] Reference ::= EntityRef | CharRef
- (defvar xml-reference-re (concat "\\(?:" xml-entity-ref "\\|" xml-char-ref-re "\\)"))
- ;;[10] AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'"
- (defvar xml-att-value-re (concat "\\(?:\"\\(?:[^&\"]\\|" xml-reference-re "\\)*\"\\|"
- "'\\(?:[^&']\\|" xml-reference-re "\\)*'\\)"))
- ;;[56] TokenizedType ::= 'ID' [VC: ID] [VC: One ID per Element Type] [VC: ID Attribute Default]
- ;; | 'IDREF' [VC: IDREF]
- ;; | 'IDREFS' [VC: IDREF]
- ;; | 'ENTITY' [VC: Entity Name]
- ;; | 'ENTITIES' [VC: Entity Name]
- ;; | 'NMTOKEN' [VC: Name Token]
- ;; | 'NMTOKENS' [VC: Name Token]
- (defvar xml-tokenized-type-re "\\(?:ID\\|IDREF\\|IDREFS\\|ENTITY\\|ENTITIES\\|NMTOKEN\\|NMTOKENS\\)")
- ;;[58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')'
- (defvar xml-notation-type-re (concat "\\(?:NOTATION" whitespace "(" whitespace "*" xml-name-re
- "\\(?:" whitespace "*|" whitespace "*" xml-name-re "\\)*" whitespace "*)\\)"))
- ;;[59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' [VC: Enumeration] [VC: No Duplicate Tokens]
- (defvar xml-enumeration-re (concat "\\(?:(" whitespace "*" xml-nmtoken-re
- "\\(?:" whitespace "*|" whitespace "*" xml-nmtoken-re "\\)*"
- whitespace ")\\)"))
- ;;[57] EnumeratedType ::= NotationType | Enumeration
- (defvar xml-enumerated-type-re (concat "\\(?:" xml-notation-type-re "\\|" xml-enumeration-re "\\)"))
- ;;[54] AttType ::= StringType | TokenizedType | EnumeratedType
- ;;[55] StringType ::= 'CDATA'
- (defvar xml-att-type-re (concat "\\(?:CDATA\\|" xml-tokenized-type-re "\\|" xml-notation-type-re"\\|" xml-enumerated-type-re "\\)"))
- ;;[60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)
- (defvar xml-default-decl-re (concat "\\(?:#REQUIRED\\|#IMPLIED\\|\\(?:#FIXED" whitespace "\\)*" xml-att-value-re "\\)"))
- ;;[53] AttDef ::= S Name S AttType S DefaultDecl
- (defvar xml-att-def-re (concat "\\(?:" whitespace "*" xml-name-re
- whitespace "*" xml-att-type-re
- whitespace "*" xml-default-decl-re "\\)"))
- ;;[9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"'
- ;; | "'" ([^%&'] | PEReference | Reference)* "'"
- (defvar xml-entity-value-re (concat "\\(?:\"\\(?:[^%&\"]\\|" xml-pe-reference-re
- "\\|" xml-reference-re "\\)*\"\\|'\\(?:[^%&']\\|"
- xml-pe-reference-re "\\|" xml-reference-re "\\)*'\\)")))
-;;[75] ExternalID ::= 'SYSTEM' S SystemLiteral
-;; | 'PUBLIC' S PubidLiteral S SystemLiteral
-;;[76] NDataDecl ::= S 'NDATA' S
-;;[73] EntityDef ::= EntityValue| (ExternalID NDataDecl?)
-;;[71] GEDecl ::= '<!ENTITY' S Name S EntityDef S? '>'
-;;[74] PEDef ::= EntityValue | ExternalID
-;;[72] PEDecl ::= '<!ENTITY' S '%' S Name S PEDef S? '>'
-;;[70] EntityDecl ::= GEDecl | PEDecl
+;; The following regexps are used as subexpressions in regexps that
+;; are `eval-when-compile'd for efficiency, so they must be defined at
+;; compile time.
+(eval-and-compile
+
+;; [4] NameStartChar
+;; See the definition of word syntax in `xml-syntax-table'.
+(defconst xml-name-start-char-re (concat "[[:word:]:_]"))
+
+;; [4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7
+;; | [#x0300-#x036F] | [#x203F-#x2040]
+(defconst xml-name-char-re (concat "[-0-9.[:word:]:_·̀-ͯ‿-⁀]"))
+
+;; [5] Name ::= NameStartChar (NameChar)*
+(defconst xml-name-re (concat xml-name-start-char-re xml-name-char-re "*"))
+
+;; [6] Names ::= Name (#x20 Name)*
+(defconst xml-names-re (concat xml-name-re "\\(?: " xml-name-re "\\)*"))
+
+;; [7] Nmtoken ::= (NameChar)+
+(defconst xml-nmtoken-re (concat xml-name-char-re "+"))
+
+;; [8] Nmtokens ::= Nmtoken (#x20 Nmtoken)*
+(defconst xml-nmtokens-re (concat xml-nmtoken-re "\\(?: " xml-name-re "\\)*"))
+
+;; [66] CharRef ::= '&#' [0-9]+ ';' | '&#x' [0-9a-fA-F]+ ';'
+(defconst xml-char-ref-re "\\(?:&#[0-9]+;\\|&#x[0-9a-fA-F]+;\\)")
+
+;; [68] EntityRef ::= '&' Name ';'
+(defconst xml-entity-ref (concat "&" xml-name-re ";"))
+
+(defconst xml-entity-or-char-ref-re (concat "&\\(?:#\\(x\\)?\\([0-9]+\\)\\|\\("
+ xml-name-re "\\)\\);"))
+
+;; [69] PEReference ::= '%' Name ';'
+(defconst xml-pe-reference-re (concat "%\\(" xml-name-re "\\);"))
+
+;; [67] Reference ::= EntityRef | CharRef
+(defconst xml-reference-re (concat "\\(?:" xml-entity-ref "\\|" xml-char-ref-re "\\)"))
+
+;; [10] AttValue ::= '"' ([^<&"] | Reference)* '"'
+;; | "'" ([^<&'] | Reference)* "'"
+(defconst xml-att-value-re (concat "\\(?:\"\\(?:[^&\"]\\|"
+ xml-reference-re "\\)*\"\\|"
+ "'\\(?:[^&']\\|" xml-reference-re
+ "\\)*'\\)"))
+
+;; [56] TokenizedType ::= 'ID'
+;; [VC: ID] [VC: One ID / Element Type] [VC: ID Attribute Default]
+;; | 'IDREF' [VC: IDREF]
+;; | 'IDREFS' [VC: IDREF]
+;; | 'ENTITY' [VC: Entity Name]
+;; | 'ENTITIES' [VC: Entity Name]
+;; | 'NMTOKEN' [VC: Name Token]
+;; | 'NMTOKENS' [VC: Name Token]
+(defconst xml-tokenized-type-re (concat "\\(?:ID\\|IDREF\\|IDREFS\\|ENTITY\\|"
+ "ENTITIES\\|NMTOKEN\\|NMTOKENS\\)"))
+
+;; [58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')'
+(defconst xml-notation-type-re
+ (concat "\\(?:NOTATION\\s-+(\\s-*" xml-name-re
+ "\\(?:\\s-*|\\s-*" xml-name-re "\\)*\\s-*)\\)"))
+
+;; [59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')'
+;; [VC: Enumeration] [VC: No Duplicate Tokens]
+(defconst xml-enumeration-re (concat "\\(?:(\\s-*" xml-nmtoken-re
+ "\\(?:\\s-*|\\s-*" xml-nmtoken-re
+ "\\)*\\s-+)\\)"))
+
+;; [57] EnumeratedType ::= NotationType | Enumeration
+(defconst xml-enumerated-type-re (concat "\\(?:" xml-notation-type-re
+ "\\|" xml-enumeration-re "\\)"))
+
+;; [54] AttType ::= StringType | TokenizedType | EnumeratedType
+;; [55] StringType ::= 'CDATA'
+(defconst xml-att-type-re (concat "\\(?:CDATA\\|" xml-tokenized-type-re
+ "\\|" xml-notation-type-re
+ "\\|" xml-enumerated-type-re "\\)"))
+
+;; [60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)
+(defconst xml-default-decl-re (concat "\\(?:#REQUIRED\\|#IMPLIED\\|"
+ "\\(?:#FIXED\\s-+\\)*"
+ xml-att-value-re "\\)"))
+
+;; [53] AttDef ::= S Name S AttType S DefaultDecl
+(defconst xml-att-def-re (concat "\\(?:\\s-*" xml-name-re
+ "\\s-*" xml-att-type-re
+ "\\s-*" xml-default-decl-re "\\)"))
+
+;; [9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"'
+;; | "'" ([^%&'] | PEReference | Reference)* "'"
+(defconst xml-entity-value-re (concat "\\(?:\"\\(?:[^%&\"]\\|"
+ xml-pe-reference-re
+ "\\|" xml-reference-re
+ "\\)*\"\\|'\\(?:[^%&']\\|"
+ xml-pe-reference-re "\\|"
+ xml-reference-re "\\)*'\\)"))
+) ; End of `eval-when-compile'
+
+
+;; [75] ExternalID ::= 'SYSTEM' S SystemLiteral
+;; | 'PUBLIC' S PubidLiteral S SystemLiteral
+;; [76] NDataDecl ::= S 'NDATA' S
+;; [73] EntityDef ::= EntityValue| (ExternalID NDataDecl?)
+;; [71] GEDecl ::= '<!ENTITY' S Name S EntityDef S? '>'
+;; [74] PEDef ::= EntityValue | ExternalID
+;; [72] PEDecl ::= '<!ENTITY' S '%' S Name S PEDef S? '>'
+;; [70] EntityDecl ::= GEDecl | PEDecl
;; Note that this is setup so that we can do whitespace-skipping with
;; `(skip-syntax-forward " ")', inter alia. Previously this was slow
-;; compared with `re-search-forward', but that has been fixed. Also
-;; note that the standard syntax table contains other characters with
-;; whitespace syntax, like NBSP, but they are invalid in contexts in
-;; which we might skip whitespace -- specifically, they're not
-;; NameChars [XML 4].
+;; compared with `re-search-forward', but that has been fixed.
(defvar xml-syntax-table
- (let ((table (make-syntax-table)))
- ;; Get space syntax correct per XML [3].
- (dotimes (c 31)
- (modify-syntax-entry c "." table)) ; all are space in standard table
- (dolist (c '(?\t ?\n ?\r)) ; these should be space
+ ;; By default, characters have symbol syntax.
+ (let ((table (make-char-table 'syntax-table '(3))))
+ ;; The XML space chars [3], and nothing else, have space syntax.
+ (dolist (c '(?\s ?\t ?\r ?\n))
(modify-syntax-entry c " " table))
- ;; For skipping attributes.
- (modify-syntax-entry ?\" "\"" table)
- (modify-syntax-entry ?' "\"" table)
- ;; Non-alnum name chars should be symbol constituents (`-' and `_'
- ;; are OK by default).
- (modify-syntax-entry ?. "_" table)
- (modify-syntax-entry ?: "_" table)
- ;; XML [89]
- (unless (featurep 'xemacs)
- (dolist (c '(#x00B7 #x02D0 #x02D1 #x0387 #x0640 #x0E46 #x0EC6 #x3005
- #x3031 #x3032 #x3033 #x3034 #x3035 #x309D #x309E #x30FC
- #x30FD #x30FE))
- (modify-syntax-entry (decode-char 'ucs c) "w" table)))
- ;; Fixme: rest of [4]
+ ;; The characters in NameStartChar [4], aside from ':' and '_',
+ ;; have word syntax. This is used by `xml-name-start-char-re'.
+ (modify-syntax-entry '(?A . ?Z) "w" table)
+ (modify-syntax-entry '(?a . ?z) "w" table)
+ (modify-syntax-entry '(#xC0 . #xD6) "w" table)
+ (modify-syntax-entry '(#xD8 . #XF6) "w" table)
+ (modify-syntax-entry '(#xF8 . #X2FF) "w" table)
+ (modify-syntax-entry '(#x370 . #X37D) "w" table)
+ (modify-syntax-entry '(#x37F . #x1FFF) "w" table)
+ (modify-syntax-entry '(#x200C . #x200D) "w" table)
+ (modify-syntax-entry '(#x2070 . #x218F) "w" table)
+ (modify-syntax-entry '(#x2C00 . #x2FEF) "w" table)
+ (modify-syntax-entry '(#x3001 . #xD7FF) "w" table)
+ (modify-syntax-entry '(#xF900 . #xFDCF) "w" table)
+ (modify-syntax-entry '(#xFDF0 . #xFFFD) "w" table)
+ (modify-syntax-entry '(#x10000 . #xEFFFF) "w" table)
table)
- "Syntax table used by `xml-parse-region'.")
+ "Syntax table used by the XML parser.
+In this syntax table, the XML space characters [ \\t\\r\\n], and
+only those characters, have whitespace syntax.")
-;; XML [5]
-;; Note that [:alpha:] matches all multibyte chars with word syntax.
-(eval-and-compile
- (defconst xml-name-regexp "[[:alpha:]_:][[:alnum:]._:-]*"))
+;;; Entry points:
-;; Fixme: This needs re-writing to deal with the XML grammar properly, i.e.
-;; document ::= prolog element Misc*
-;; prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?
+;;;###autoload
+(defun xml-parse-file (file &optional parse-dtd parse-ns)
+ "Parse the well-formed XML file FILE.
+Return the top node with all its children.
+If PARSE-DTD is non-nil, the DTD is parsed rather than skipped.
+
+If PARSE-NS is non-nil, then QNAMES are expanded. By default,
+the variable `xml-default-ns' is the mapping from namespaces to
+URIs, and expanded names will be returned as a cons
+
+ (\"namespace:\" . \"foo\").
+
+If PARSE-NS is an alist, it will be used as the mapping from
+namespace to URIs instead.
+
+If it is the symbol 'symbol-qnames, expanded names will be
+returned as a plain symbol 'namespace:foo instead of a cons.
+
+Both features can be combined by providing a cons cell
+
+ (symbol-qnames . ALIST)."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (xml--parse-buffer parse-dtd parse-ns)))
;;;###autoload
-(defun xml-parse-region (beg end &optional buffer parse-dtd parse-ns)
+(defun xml-parse-region (&optional beg end buffer parse-dtd parse-ns)
"Parse the region from BEG to END in BUFFER.
+Return the XML parse tree, or raise an error if the region does
+not contain well-formed XML.
+
+If BEG is nil, it defaults to `point-min'.
+If END is nil, it defaults to `point-max'.
If BUFFER is nil, it defaults to the current buffer.
-Returns the XML list for the region, or raises an error if the region
-is not well-formed XML.
-If PARSE-DTD is non-nil, the DTD is parsed rather than skipped,
-and returned as the first element of the list.
-If PARSE-NS is non-nil, then QNAMES are expanded."
+If PARSE-DTD is non-nil, parse the DTD and return it as the first
+element of the list.
+If PARSE-NS is non-nil, then QNAMES are expanded. By default,
+the variable `xml-default-ns' is the mapping from namespaces to
+URIs, and expanded names will be returned as a cons
+
+ (\"namespace:\" . \"foo\").
+
+If PARSE-NS is an alist, it will be used as the mapping from
+namespace to URIs instead.
+
+If it is the symbol 'symbol-qnames, expanded names will be
+returned as a plain symbol 'namespace:foo instead of a cons.
+
+Both features can be combined by providing a cons cell
+
+ (symbol-qnames . ALIST)."
;; Use fixed syntax table to ensure regexp char classes and syntax
;; specs DTRT.
- (with-syntax-table (standard-syntax-table)
+ (unless buffer
+ (setq buffer (current-buffer)))
+ (with-temp-buffer
+ (insert-buffer-substring-no-properties buffer beg end)
+ (xml--parse-buffer parse-dtd parse-ns)))
+
+;; XML [5]
+
+;; Fixme: This needs re-writing to deal with the XML grammar properly, i.e.
+;; document ::= prolog element Misc*
+;; prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?
+
+(defun xml--parse-buffer (parse-dtd parse-ns)
+ (with-syntax-table xml-syntax-table
(let ((case-fold-search nil) ; XML is case-sensitive.
+ ;; Prevent entity definitions from changing the defaults
+ (xml-entity-alist xml-entity-alist)
+ (xml-parameter-entity-alist xml-parameter-entity-alist)
xml result dtd)
- (save-excursion
- (if buffer
- (set-buffer buffer))
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (while (not (eobp))
- (if (search-forward "<" nil t)
- (progn
- (forward-char -1)
- (setq result (xml-parse-tag parse-dtd parse-ns))
- (cond
- ((null result)
- ;; Not looking at an xml start tag.
- (forward-char 1))
- ((and xml (not xml-sub-parser))
- ;; Translation of rule [1] of XML specifications
- (error "XML: (Not Well-Formed) Only one root tag allowed"))
- ((and (listp (car result))
- parse-dtd)
- (setq dtd (car result))
- (if (cdr result) ; possible leading comment
- (add-to-list 'xml (cdr result))))
- (t
- (add-to-list 'xml result))))
- (goto-char (point-max))))
- (if parse-dtd
- (cons dtd (nreverse xml))
- (nreverse xml)))))))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (search-forward "<" nil t)
+ (progn
+ (forward-char -1)
+ (setq result (xml-parse-tag-1 parse-dtd parse-ns))
+ (cond
+ ((null result)
+ ;; Not looking at an xml start tag.
+ (unless (eobp)
+ (forward-char 1)))
+ ((and xml (not xml-sub-parser))
+ ;; Translation of rule [1] of XML specifications
+ (error "XML: (Not Well-Formed) Only one root tag allowed"))
+ ((and (listp (car result))
+ parse-dtd)
+ (setq dtd (car result))
+ (if (cdr result) ; possible leading comment
+ (add-to-list 'xml (cdr result))))
+ (t
+ (add-to-list 'xml result))))
+ (goto-char (point-max))))
+ (if parse-dtd
+ (cons dtd (nreverse xml))
+ (nreverse xml)))))
(defun xml-maybe-do-ns (name default xml-ns)
"Perform any namespace expansion.
@@ -348,62 +418,72 @@ is nil.
During namespace-aware parsing, any name without a namespace is
put into the namespace identified by DEFAULT. nil is used to
-specify that the name shouldn't be given a namespace."
+specify that the name shouldn't be given a namespace.
+Expanded names will by default be returned as a cons. If you
+would like to get plain symbols instead, provide a cons cell
+
+ (symbol-qnames . ALIST)
+
+in the XML-NS argument."
(if (consp xml-ns)
- (let* ((nsp (string-match ":" name))
+ (let* ((symbol-qnames (eq (car-safe xml-ns) 'symbol-qnames))
+ (nsp (string-match ":" name))
(lname (if nsp (substring name (match-end 0)) name))
(prefix (if nsp (substring name 0 (match-beginning 0)) default))
(special (and (string-equal lname "xmlns") (not prefix)))
;; Setting default to nil will insure that there is not
;; matching cons in xml-ns. In which case we
(ns (or (cdr (assoc (if special "xmlns" prefix)
- xml-ns))
+ (if symbol-qnames (cdr xml-ns) xml-ns)))
"")))
- (cons ns (if special "" lname)))
+ (if (and symbol-qnames
+ (not (string= prefix "xmlns")))
+ (intern (concat ns lname))
+ (cons ns (if special "" lname))))
(intern name)))
-(defun xml-parse-fragment (&optional parse-dtd parse-ns)
- "Parse xml-like fragments."
- (let ((xml-sub-parser t)
- children)
- (while (not (eobp))
- (let ((bit (xml-parse-tag
- parse-dtd parse-ns)))
- (if children
- (setq children (append (list bit) children))
- (if (stringp bit)
- (setq children (list bit))
- (setq children bit)))))
- (reverse children)))
-
(defun xml-parse-tag (&optional parse-dtd parse-ns)
"Parse the tag at point.
If PARSE-DTD is non-nil, the DTD of the document, if any, is parsed and
returned as the first element in the list.
-If PARSE-NS is non-nil, then QNAMES are expanded.
-Returns one of:
+If PARSE-NS is non-nil, expand QNAMES; for further details, see
+`xml-parse-region'.
+
+Return one of:
- a list : the matching node
- nil : the point is not looking at a tag.
- a pair : the first element is the DTD, the second is the node."
- (let ((xml-validating-parser (or parse-dtd xml-validating-parser))
- (xml-ns (if (consp parse-ns)
- parse-ns
- (if parse-ns
- (list
- ;; Default for empty prefix is no namespace
- (cons "" "")
- ;; "xml" namespace
- (cons "xml" "http://www.w3.org/XML/1998/namespace")
- ;; We need to seed the xmlns namespace
- (cons "xmlns" "http://www.w3.org/2000/xmlns/"))))))
+ (let* ((case-fold-search nil)
+ ;; Prevent entity definitions from changing the defaults
+ (xml-entity-alist xml-entity-alist)
+ (xml-parameter-entity-alist xml-parameter-entity-alist)
+ (buf (current-buffer))
+ (pos (point)))
+ (with-temp-buffer
+ (with-syntax-table xml-syntax-table
+ (insert-buffer-substring-no-properties buf pos)
+ (goto-char (point-min))
+ (xml-parse-tag-1 parse-dtd parse-ns)))))
+
+(defun xml-parse-tag-1 (&optional parse-dtd parse-ns)
+ "Like `xml-parse-tag', but possibly modify the buffer while working."
+ (let* ((xml-validating-parser (or parse-dtd xml-validating-parser))
+ (xml-ns
+ (cond ((eq parse-ns 'symbol-qnames)
+ (cons 'symbol-qnames xml-default-ns))
+ ((or (consp (car-safe parse-ns))
+ (and (eq (car-safe parse-ns) 'symbol-qnames)
+ (listp (cdr parse-ns))))
+ parse-ns)
+ (parse-ns
+ xml-default-ns))))
(cond
- ;; Processing instructions (like the <?xml version="1.0"?> tag at the
- ;; beginning of a document).
+ ;; Processing instructions, like <?xml version="1.0"?>.
((looking-at "<\\?")
(search-forward "?>")
(skip-syntax-forward " ")
- (xml-parse-tag parse-dtd xml-ns))
- ;; Character data (CDATA) sections, in which no tag should be interpreted
+ (xml-parse-tag-1 parse-dtd xml-ns))
+ ;; Character data (CDATA) sections, in which no tag should be interpreted
((looking-at "<!\\[CDATA\\[")
(let ((pos (match-end 0)))
(unless (search-forward "]]>" nil t)
@@ -411,30 +491,32 @@ Returns one of:
(concat
(buffer-substring-no-properties pos (match-beginning 0))
(xml-parse-string))))
- ;; DTD for the document
- ((looking-at "<!DOCTYPE")
+ ;; DTD for the document
+ ((looking-at "<!DOCTYPE[ \t\n\r]")
(let ((dtd (xml-parse-dtd parse-ns)))
(skip-syntax-forward " ")
(if xml-validating-parser
- (cons dtd (xml-parse-tag nil xml-ns))
- (xml-parse-tag nil xml-ns))))
- ;; skip comments
+ (cons dtd (xml-parse-tag-1 nil xml-ns))
+ (xml-parse-tag-1 nil xml-ns))))
+ ;; skip comments
((looking-at "<!--")
(search-forward "-->")
- nil)
- ;; end tag
+ ;; FIXME: This loses the skipped-over spaces.
+ (skip-syntax-forward " ")
+ (unless (eobp)
+ (let ((xml-sub-parser t))
+ (xml-parse-tag-1 parse-dtd xml-ns))))
+ ;; end tag
((looking-at "</")
'())
- ;; opening tag
- ((looking-at "<\\([^/>[:space:]]+\\)")
+ ;; opening tag
+ ((looking-at (eval-when-compile (concat "<\\(" xml-name-re "\\)")))
(goto-char (match-end 1))
-
;; Parse this node
(let* ((node-name (match-string-no-properties 1))
;; Parse the attribute list.
(attrs (xml-parse-attlist xml-ns))
children)
-
;; add the xmlns:* attrs to our cache
(when (consp xml-ns)
(dolist (attr attrs)
@@ -442,71 +524,117 @@ Returns one of:
(equal "http://www.w3.org/2000/xmlns/"
(caar attr)))
(push (cons (cdar attr) (cdr attr))
- xml-ns))))
-
+ (if (symbolp (car xml-ns))
+ (cdr xml-ns)
+ xml-ns)))))
(setq children (list attrs (xml-maybe-do-ns node-name "" xml-ns)))
+ (cond
+ ;; is this an empty element ?
+ ((looking-at "/>")
+ (forward-char 2)
+ (nreverse children))
+ ;; is this a valid start tag ?
+ ((eq (char-after) ?>)
+ (forward-char 1)
+ ;; Now check that we have the right end-tag.
+ (let ((end (concat "</" node-name "\\s-*>")))
+ (while (not (looking-at end))
+ (cond
+ ((eobp)
+ (error "XML: (Not Well-Formed) End of document while reading element `%s'"
+ node-name))
+ ((looking-at "</")
+ (forward-char 2)
+ (error "XML: (Not Well-Formed) Invalid end tag `%s' (expecting `%s')"
+ (let ((pos (point)))
+ (buffer-substring pos (if (re-search-forward "\\s-*>" nil t)
+ (match-beginning 0)
+ (point-max))))
+ node-name))
+ ;; Read a sub-element and push it onto CHILDREN.
+ ((= (char-after) ?<)
+ (let ((tag (xml-parse-tag-1 nil xml-ns)))
+ (when tag
+ (push tag children))))
+ ;; Read some character data.
+ (t
+ (let ((expansion (xml-parse-string)))
+ (push (if (stringp (car children))
+ ;; If two strings were separated by a
+ ;; comment, concat them.
+ (concat (pop children) expansion)
+ expansion)
+ children)))))
+ ;; Move point past the end-tag.
+ (goto-char (match-end 0))
+ (nreverse children)))
+ ;; Otherwise this was an invalid start tag (expected ">" not found.)
+ (t
+ (error "XML: (Well-Formed) Couldn't parse tag: %s"
+ (buffer-substring-no-properties (- (point) 10) (+ (point) 1)))))))
- ;; is this an empty element ?
- (if (looking-at "/>")
- (progn
- (forward-char 2)
- (nreverse children))
-
- ;; is this a valid start tag ?
- (if (eq (char-after) ?>)
- (progn
- (forward-char 1)
- ;; Now check that we have the right end-tag. Note that this
- ;; one might contain spaces after the tag name
- (let ((end (concat "</" node-name "\\s-*>")))
- (while (not (looking-at end))
- (cond
- ((looking-at "</")
- (error "XML: (Not Well-Formed) Invalid end tag (expecting %s) at pos %d"
- node-name (point)))
- ((= (char-after) ?<)
- (let ((tag (xml-parse-tag nil xml-ns)))
- (when tag
- (push tag children))))
- (t
- (let ((expansion (xml-parse-string)))
- (setq children
- (if (stringp expansion)
- (if (stringp (car children))
- ;; The two strings were separated by a comment.
- (setq children (append (list (concat (car children) expansion))
- (cdr children)))
- (setq children (append (list expansion) children)))
- (setq children (append expansion children))))))))
-
- (goto-char (match-end 0))
- (nreverse children)))
- ;; This was an invalid start tag (Expected ">", but didn't see it.)
- (error "XML: (Well-Formed) Couldn't parse tag: %s"
- (buffer-substring-no-properties (- (point) 10) (+ (point) 1)))))))
- (t ;; (Not one of PI, CDATA, Comment, End tag, or Start tag)
- (unless xml-sub-parser ; Usually, we error out.
+ ;; (Not one of PI, CDATA, Comment, End tag, or Start tag)
+ (t
+ (unless xml-sub-parser ; Usually, we error out.
(error "XML: (Well-Formed) Invalid character"))
-
;; However, if we're parsing incrementally, then we need to deal
;; with stray CDATA.
(xml-parse-string)))))
(defun xml-parse-string ()
- "Parse the next whatever. Could be a string, or an element."
- (let* ((pos (point))
- (string (progn (skip-chars-forward "^<")
- (buffer-substring-no-properties pos (point)))))
- ;; Clean up the string. As per XML specifications, the XML
- ;; processor should always pass the whole string to the
- ;; application. But \r's should be replaced:
- ;; http://www.w3.org/TR/2000/REC-xml-20001006#sec-line-ends
- (setq pos 0)
- (while (string-match "\r\n?" string pos)
- (setq string (replace-match "\n" t t string))
- (setq pos (1+ (match-beginning 0))))
-
- (xml-substitute-special string)))
+ "Parse character data at point, and return it as a string.
+Leave point at the start of the next thing to parse. This
+function can modify the buffer by expanding entity and character
+references."
+ (let ((start (point))
+ ;; Keep track of the size of the rest of the buffer:
+ (old-remaining-size (- (buffer-size) (point)))
+ ref val)
+ (while (and (not (eobp))
+ (not (looking-at "<")))
+ ;; Find the next < or & character.
+ (skip-chars-forward "^<&")
+ (when (eq (char-after) ?&)
+ ;; If we find an entity or character reference, expand it.
+ (unless (looking-at xml-entity-or-char-ref-re)
+ (error "XML: (Not Well-Formed) Invalid entity reference"))
+ ;; For a character reference, the next entity or character
+ ;; reference must be after the replacement. [4.6] "Numerical
+ ;; character references are expanded immediately when
+ ;; recognized and MUST be treated as character data."
+ (if (setq ref (match-string 2))
+ (progn ; Numeric char reference
+ (setq val (save-match-data
+ (decode-char 'ucs (string-to-number
+ ref (if (match-string 1) 16)))))
+ (and (null val)
+ xml-validating-parser
+ (error "XML: (Validity) Invalid character reference `%s'"
+ (match-string 0)))
+ (replace-match (or (string val) xml-undefined-entity) t t))
+ ;; For an entity reference, search again from the start of
+ ;; the replaced text, since the replacement can contain
+ ;; entity or character references, or markup.
+ (setq ref (match-string 3)
+ val (assoc ref xml-entity-alist))
+ (and (null val)
+ xml-validating-parser
+ (error "XML: (Validity) Undefined entity `%s'" ref))
+ (replace-match (cdr val) t t)
+ (goto-char (match-beginning 0)))
+ ;; Check for XML bombs.
+ (and xml-entity-expansion-limit
+ (> (- (buffer-size) (point))
+ (+ old-remaining-size xml-entity-expansion-limit))
+ (error "XML: Entity reference expansion \
+surpassed `xml-entity-expansion-limit'"))))
+ ;; [2.11] Clean up line breaks.
+ (let ((end-marker (point-marker)))
+ (goto-char start)
+ (while (re-search-forward "\r\n?" end-marker t)
+ (replace-match "\n" t t))
+ (goto-char end-marker)
+ (buffer-substring start (point)))))
(defun xml-parse-attlist (&optional xml-ns)
"Return the attribute-list after point.
@@ -515,7 +643,7 @@ Leave point at the first non-blank character after the tag."
end-pos name)
(skip-syntax-forward " ")
(while (looking-at (eval-when-compile
- (concat "\\(" xml-name-regexp "\\)\\s-*=\\s-*")))
+ (concat "\\(" xml-name-re "\\)\\s-*=\\s-*")))
(setq end-pos (match-end 0))
(setq name (xml-maybe-do-ns (match-string-no-properties 1) nil xml-ns))
(goto-char end-pos)
@@ -540,8 +668,9 @@ Leave point at the first non-blank character after the tag."
(replace-regexp-in-string "\\s-\\{2,\\}" " " string)
(let ((expansion (xml-substitute-special string)))
(unless (stringp expansion)
- ; We say this is the constraint. It is actually that neither
- ; external entities nor "<" can be in an attribute value.
+ ;; We say this is the constraint. It is actually that
+ ;; neither external entities nor "<" can be in an
+ ;; attribute value.
(error "XML: (Not Well-Formed) Entities in attributes cannot expand into elements"))
(push (cons name expansion) attlist)))
@@ -549,15 +678,11 @@ Leave point at the first non-blank character after the tag."
(skip-syntax-forward " "))
(nreverse attlist)))
-;;*******************************************************************
-;;**
-;;** The DTD (document type declaration)
-;;** The following functions know how to skip or parse the DTD of
-;;** a document
-;;**
-;;*******************************************************************
+;;; DTD (document type declaration)
-;; Fixme: This fails at least if the DTD contains conditional sections.
+;; The following functions know how to skip or parse the DTD of a
+;; document. FIXME: it fails at least if the DTD contains conditional
+;; sections.
(defun xml-skip-dtd ()
"Skip the DTD at point.
@@ -574,13 +699,14 @@ This follows the rule [28] in the XML specifications."
(error "XML: (Validity) Invalid DTD (expecting name of the document)"))
;; Get the name of the document
- (looking-at xml-name-regexp)
+ (looking-at xml-name-re)
(let ((dtd (list (match-string-no-properties 0) 'dtd))
- type element end-pos)
+ (xml-parameter-entity-alist xml-parameter-entity-alist)
+ next-parameter-entity)
(goto-char (match-end 0))
-
(skip-syntax-forward " ")
- ;; XML [75]
+
+ ;; External subset (XML [75])
(cond ((looking-at "PUBLIC\\s-+")
(goto-char (match-end 0))
(unless (or (re-search-forward
@@ -603,119 +729,185 @@ This follows the rule [28] in the XML specifications."
(error "XML: Missing System ID"))
(push (list (match-string-no-properties 1) 'system) dtd)))
(skip-syntax-forward " ")
- (if (eq ?> (char-after))
- (forward-char)
- (if (not (eq (char-after) ?\[))
- (error "XML: Bad DTD")
+
+ (if (eq (char-after) ?>)
+
+ ;; No internal subset
(forward-char)
- ;; Parse the rest of the DTD
- ;; Fixme: Deal with NOTATION, PIs.
- (while (not (looking-at "\\s-*\\]"))
- (skip-syntax-forward " ")
- (cond
-
- ;; Translation of rule [45] of XML specifications
- ((looking-at
- "<!ELEMENT\\s-+\\([[:alnum:].%;]+\\)\\s-+\\([^>]+\\)>")
-
- (setq element (match-string-no-properties 1)
- type (match-string-no-properties 2))
- (setq end-pos (match-end 0))
- ;; Translation of rule [46] of XML specifications
+ ;; Internal subset (XML [28b])
+ (unless (eq (char-after) ?\[)
+ (error "XML: Bad DTD"))
+ (forward-char)
+
+ ;; [2.8]: "markup declarations may be made up in whole or in
+ ;; part of the replacement text of parameter entities."
+
+ ;; Since parameter entities are valid only within the DTD, we
+ ;; first search for the position of the next possible parameter
+ ;; entity. Then, search for the next DTD element; if it ends
+ ;; before the next parameter entity, expand the parameter entity
+ ;; and try again.
+ (setq next-parameter-entity
+ (save-excursion
+ (if (re-search-forward xml-pe-reference-re nil t)
+ (match-beginning 0))))
+
+ ;; Parse the rest of the DTD
+ ;; Fixme: Deal with NOTATION, PIs.
+ (while (not (looking-at "\\s-*\\]"))
+ (skip-syntax-forward " ")
+ (cond
+ ((eobp)
+ (error "XML: (Well-Formed) End of document while reading DTD"))
+ ;; Element declaration [45]:
+ ((and (looking-at (eval-when-compile
+ (concat "<!ELEMENT\\s-+\\(" xml-name-re
+ "\\)\\s-+\\([^>]+\\)>")))
+ (or (null next-parameter-entity)
+ (<= (match-end 0) next-parameter-entity)))
+ (let ((element (match-string-no-properties 1))
+ (type (match-string-no-properties 2))
+ (end-pos (match-end 0)))
+ ;; Translation of rule [46] of XML specifications
(cond
- ((string-match "^EMPTY[ \t\n\r]*$" type) ;; empty declaration
+ ((string-match "\\`EMPTY\\s-*\\'" type) ; empty declaration
(setq type 'empty))
- ((string-match "^ANY[ \t\n\r]*$" type) ;; any type of contents
+ ((string-match "\\`ANY\\s-*$" type) ; any type of contents
(setq type 'any))
- ((string-match "^(\\(.*\\))[ \t\n\r]*$" type) ;; children ([47])
- (setq type (xml-parse-elem-type (match-string-no-properties 1 type))))
- ((string-match "^%[^;]+;[ \t\n\r]*$" type) ;; substitution
+ ((string-match "\\`(\\(.*\\))\\s-*\\'" type) ; children ([47])
+ (setq type (xml-parse-elem-type
+ (match-string-no-properties 1 type))))
+ ((string-match "^%[^;]+;[ \t\n\r]*\\'" type) ; substitution
nil)
- (t
- (if xml-validating-parser
- (error "XML: (Validity) Invalid element type in the DTD"))))
+ (xml-validating-parser
+ (error "XML: (Validity) Invalid element type in the DTD")))
- ;; rule [45]: the element declaration must be unique
- (if (and (assoc element dtd)
- xml-validating-parser)
- (error "XML: (Validity) Element declarations must be unique in a DTD (<%s>)"
- element))
+ ;; rule [45]: the element declaration must be unique
+ (and (assoc element dtd)
+ xml-validating-parser
+ (error "XML: (Validity) DTD element declarations must be unique (<%s>)"
+ element))
;; Store the element in the DTD
(push (list element type) dtd)
- (goto-char end-pos))
-
- ;; Translation of rule [52] of XML specifications
- ((looking-at (concat "<!ATTLIST[ \t\n\r]*\\(" xml-name-re
- "\\)[ \t\n\r]*\\(" xml-att-def-re
- "\\)*[ \t\n\r]*>"))
-
- ;; We don't do anything with ATTLIST currently
- (goto-char (match-end 0)))
-
- ((looking-at "<!--")
- (search-forward "-->"))
- ((looking-at (concat "<!ENTITY[ \t\n\r]*\\(" xml-name-re
- "\\)[ \t\n\r]*\\(" xml-entity-value-re
- "\\)[ \t\n\r]*>"))
- (let ((name (match-string-no-properties 1))
- (value (substring (match-string-no-properties 2) 1
- (- (length (match-string-no-properties 2)) 1))))
- (goto-char (match-end 0))
- (setq xml-entity-alist
- (append xml-entity-alist
- (list (cons name
- (with-temp-buffer
- (insert value)
- (goto-char (point-min))
- (xml-parse-fragment
- xml-validating-parser
- parse-ns))))))))
- ((or (looking-at (concat "<!ENTITY[ \t\n\r]+\\(" xml-name-re
- "\\)[ \t\n\r]+SYSTEM[ \t\n\r]+"
- "\\(\"[^\"]*\"\\|'[^']*'\\)[ \t\n\r]*>"))
- (looking-at (concat "<!ENTITY[ \t\n\r]+\\(" xml-name-re
- "\\)[ \t\n\r]+PUBLIC[ \t\n\r]+"
- "\"[- \r\na-zA-Z0-9'()+,./:=?;!*#@$_%]*\""
- "\\|'[- \r\na-zA-Z0-9()+,./:=?;!*#@$_%]*'"
- "[ \t\n\r]+\\(\"[^\"]*\"\\|'[^']*'\\)"
- "[ \t\n\r]*>")))
- (let ((name (match-string-no-properties 1))
- (file (substring (match-string-no-properties 2) 1
- (- (length (match-string-no-properties 2)) 1))))
- (goto-char (match-end 0))
- (setq xml-entity-alist
- (append xml-entity-alist
- (list (cons name (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (xml-parse-fragment
- xml-validating-parser
- parse-ns))))))))
- ;; skip parameter entity declarations
- ((or (looking-at (concat "<!ENTITY[ \t\n\r]+%[ \t\n\r]+\\(" xml-name-re
- "\\)[ \t\n\r]+SYSTEM[ \t\n\r]+"
- "\\(\"[^\"]*\"\\|'[^']*'\\)[ \t\n\r]*>"))
- (looking-at (concat "<!ENTITY[ \t\n\r]+"
- "%[ \t\n\r]+"
- "\\(" xml-name-re "\\)[ \t\n\r]+"
- "PUBLIC[ \t\n\r]+"
- "\\(\"[- \r\na-zA-Z0-9'()+,./:=?;!*#@$_%]*\""
- "\\|'[- \r\na-zA-Z0-9()+,./:=?;!*#@$_%]*'\\)[ \t\n\r]+"
- "\\(\"[^\"]+\"\\|'[^']+'\\)"
- "[ \t\n\r]*>")))
- (goto-char (match-end 0)))
- ;; skip parameter entities
- ((looking-at (concat "%" xml-name-re ";"))
- (goto-char (match-end 0)))
- (t
- (when xml-validating-parser
- (error "XML: (Validity) Invalid DTD item"))))))
+ (goto-char end-pos)))
+
+ ;; Attribute-list declaration [52] (currently unsupported):
+ ((and (looking-at (eval-when-compile
+ (concat "<!ATTLIST[ \t\n\r]*\\(" xml-name-re
+ "\\)[ \t\n\r]*\\(" xml-att-def-re
+ "\\)*[ \t\n\r]*>")))
+ (or (null next-parameter-entity)
+ (<= (match-end 0) next-parameter-entity)))
+ (goto-char (match-end 0)))
+
+ ;; Comments (skip to end, ignoring parameter entity):
+ ((looking-at "<!--")
+ (search-forward "-->")
+ (and next-parameter-entity
+ (> (point) next-parameter-entity)
+ (setq next-parameter-entity
+ (save-excursion
+ (if (re-search-forward xml-pe-reference-re nil t)
+ (match-beginning 0))))))
+
+ ;; Internal entity declarations:
+ ((and (looking-at (eval-when-compile
+ (concat "<!ENTITY[ \t\n\r]+\\(%[ \t\n\r]+\\)?\\("
+ xml-name-re "\\)[ \t\n\r]*\\("
+ xml-entity-value-re "\\)[ \t\n\r]*>")))
+ (or (null next-parameter-entity)
+ (<= (match-end 0) next-parameter-entity)))
+ (let* ((name (prog1 (match-string-no-properties 2)
+ (goto-char (match-end 0))))
+ (alist (if (match-string 1)
+ 'xml-parameter-entity-alist
+ 'xml-entity-alist))
+ ;; Retrieve the deplacement text:
+ (value (xml--entity-replacement-text
+ ;; Entity value, sans quotation marks:
+ (substring (match-string-no-properties 3) 1 -1))))
+ ;; If the same entity is declared more than once, the
+ ;; first declaration is binding.
+ (unless (assoc name (symbol-value alist))
+ (set alist (cons (cons name value) (symbol-value alist))))))
+
+ ;; External entity declarations (currently unsupported):
+ ((and (or (looking-at (eval-when-compile
+ (concat "<!ENTITY[ \t\n\r]+\\(%[ \t\n\r]+\\)?\\("
+ xml-name-re "\\)[ \t\n\r]+SYSTEM[ \t\n\r]+"
+ "\\(\"[^\"]*\"\\|'[^']*'\\)[ \t\n\r]*>")))
+ (looking-at (eval-when-compile
+ (concat "<!ENTITY[ \t\n\r]+\\(%[ \t\n\r]+\\)?\\("
+ xml-name-re "\\)[ \t\n\r]+PUBLIC[ \t\n\r]+"
+ "\"[- \r\na-zA-Z0-9'()+,./:=?;!*#@$_%]*\""
+ "\\|'[- \r\na-zA-Z0-9()+,./:=?;!*#@$_%]*'"
+ "[ \t\n\r]+\\(\"[^\"]*\"\\|'[^']*'\\)"
+ "[ \t\n\r]*>"))))
+ (or (null next-parameter-entity)
+ (<= (match-end 0) next-parameter-entity)))
+ (goto-char (match-end 0)))
+
+ ;; If a parameter entity is in the way, expand it.
+ (next-parameter-entity
+ (save-excursion
+ (goto-char next-parameter-entity)
+ (unless (looking-at xml-pe-reference-re)
+ (error "XML: Internal error"))
+ (let* ((entity (match-string 1))
+ (beg (point-marker))
+ (elt (assoc entity xml-parameter-entity-alist)))
+ (if elt
+ (progn
+ (replace-match (cdr elt) t t)
+ ;; The replacement can itself be a parameter entity.
+ (goto-char next-parameter-entity))
+ (goto-char (match-end 0))))
+ (setq next-parameter-entity
+ (if (re-search-forward xml-pe-reference-re nil t)
+ (match-beginning 0)))))
+
+ ;; Anything else is garbage (ignored if not validating).
+ (xml-validating-parser
+ (error "XML: (Validity) Invalid DTD item"))
+ (t
+ (skip-chars-forward "^]"))))
+
(if (looking-at "\\s-*]>")
(goto-char (match-end 0))))
(nreverse dtd)))
+(defun xml--entity-replacement-text (string)
+ "Return the replacement text for the entity value STRING.
+The replacement text is obtained by replacing character
+references and parameter-entity references."
+ (let ((ref-re (eval-when-compile
+ (concat "\\(?:&#\\([0-9]+\\)\\|&#x\\([0-9a-fA-F]+\\)\\|%\\("
+ xml-name-re "\\)\\);")))
+ children)
+ (while (string-match ref-re string)
+ (push (substring string 0 (match-beginning 0)) children)
+ (let ((remainder (substring string (match-end 0)))
+ ref val)
+ (cond ((setq ref (match-string 1 string))
+ ;; Decimal character reference
+ (setq val (decode-char 'ucs (string-to-number ref)))
+ (if val (push (string val) children)))
+ ;; Hexadecimal character reference
+ ((setq ref (match-string 2 string))
+ (setq val (decode-char 'ucs (string-to-number ref 16)))
+ (if val (push (string val) children)))
+ ;; Parameter entity reference
+ ((setq ref (match-string 3 string))
+ (setq val (assoc ref xml-parameter-entity-alist))
+ (and (null val)
+ xml-validating-parser
+ (error "XML: (Validity) Undefined parameter entity `%s'" ref))
+ (push (or (cdr val) xml-undefined-entity) children)))
+ (setq string remainder)))
+ (mapconcat 'identity (nreverse (cons string children)) "")))
+
(defun xml-parse-elem-type (string)
"Convert element type STRING into a Lisp structure."
@@ -749,79 +941,43 @@ This follows the rule [28] in the XML specifications."
(t
elem))))
-;;*******************************************************************
-;;**
-;;** Substituting special XML sequences
-;;**
-;;*******************************************************************
+;;; Substituting special XML sequences
(defun xml-substitute-special (string)
- "Return STRING, after substituting entity references."
- ;; This originally made repeated passes through the string from the
- ;; beginning, which isn't correct, since then either "&amp;amp;" or
- ;; "&#38;amp;" won't DTRT.
-
- (let ((point 0)
- children end-point)
- (while (string-match "&\\([^;]*\\);" string point)
- (setq end-point (match-end 0))
- (let* ((this-part (match-string-no-properties 1 string))
- (prev-part (substring string point (match-beginning 0)))
- (entity (assoc this-part xml-entity-alist))
- (expansion
- (cond ((string-match "#\\([0-9]+\\)" this-part)
- (let ((c (decode-char
- 'ucs
- (string-to-number (match-string-no-properties 1 this-part)))))
- (if c (string c))))
- ((string-match "#x\\([[:xdigit:]]+\\)" this-part)
- (let ((c (decode-char
- 'ucs
- (string-to-number (match-string-no-properties 1 this-part) 16))))
- (if c (string c))))
- (entity
- (cdr entity))
- ((eq (length this-part) 0)
- (error "XML: (Not Well-Formed) No entity given"))
- (t
- (if xml-validating-parser
- (error "XML: (Validity) Undefined entity `%s'"
- this-part)
- xml-undefined-entity)))))
-
- (cond ((null children)
- ;; FIXME: If we have an entity that expands into XML, this won't work.
- (setq children
- (concat prev-part expansion)))
- ((stringp children)
- (if (stringp expansion)
- (setq children (concat children prev-part expansion))
- (setq children (list expansion (concat prev-part children)))))
- ((and (stringp expansion)
- (stringp (car children)))
- (setcar children (concat prev-part expansion (car children))))
- ((stringp expansion)
- (setq children (append (concat prev-part expansion)
- children)))
- ((stringp (car children))
- (setcar children (concat (car children) prev-part))
- (setq children (append expansion children)))
- (t
- (setq children (list expansion
- prev-part
- children))))
- (setq point end-point)))
- (cond ((stringp children)
- (concat children (substring string point)))
- ((stringp (car (last children)))
- (concat (car (last children)) (substring string point)))
- ((null children)
- string)
- (t
- (concat (mapconcat 'identity
- (nreverse children)
- "")
- (substring string point))))))
+ "Return STRING, after substituting entity and character references.
+STRING is assumed to occur in an XML attribute value."
+ (let ((strlen (length string))
+ children)
+ (while (string-match xml-entity-or-char-ref-re string)
+ (push (substring string 0 (match-beginning 0)) children)
+ (let* ((remainder (substring string (match-end 0)))
+ (is-hex (match-string 1 string)) ; Is it a hex numeric reference?
+ (ref (match-string 2 string))) ; Numeric part of reference
+ (if ref
+ ;; [4.6] Character references are included as
+ ;; character data.
+ (let ((val (decode-char 'ucs (string-to-number ref (if is-hex 16)))))
+ (push (cond (val (string val))
+ (xml-validating-parser
+ (error "XML: (Validity) Undefined character `x%s'" ref))
+ (t xml-undefined-entity))
+ children)
+ (setq string remainder
+ strlen (length string)))
+ ;; [4.4.5] Entity references are "included in literal".
+ ;; Note that we don't need do anything special to treat
+ ;; quotes as normal data characters.
+ (setq ref (match-string 3 string)) ; entity name
+ (let ((val (or (cdr (assoc ref xml-entity-alist))
+ (if xml-validating-parser
+ (error "XML: (Validity) Undefined entity `%s'" ref)
+ xml-undefined-entity))))
+ (setq string (concat val remainder)))
+ (and xml-entity-expansion-limit
+ (> (length string) (+ strlen xml-entity-expansion-limit))
+ (error "XML: Passed `xml-entity-expansion-limit' while expanding `&%s;'"
+ ref)))))
+ (mapconcat 'identity (nreverse (cons string children)) "")))
(defun xml-substitute-numeric-entities (string)
"Substitute SGML numeric entities by their respective utf characters.
@@ -842,12 +998,7 @@ by \"*\"."
string)
nil))
-;;*******************************************************************
-;;**
-;;** Printing a tree.
-;;** This function is intended mainly for debugging purposes.
-;;**
-;;*******************************************************************
+;;; Printing a parse tree (mainly for debugging).
(defun xml-debug-print (xml &optional indent-string)
"Outputs the XML in the current buffer.
@@ -860,16 +1011,25 @@ The first line is indented with the optional INDENT-STRING."
(defalias 'xml-print 'xml-debug-print)
(defun xml-escape-string (string)
- "Return the string with entity substitutions made from
-xml-entity-alist."
- (mapconcat (lambda (byte)
- (let ((char (char-to-string byte)))
- (if (rassoc char xml-entity-alist)
- (concat "&" (car (rassoc char xml-entity-alist)) ";")
- char)))
- ;; This differs from the non-unicode branch. Just
- ;; grabbing the string works here.
- string ""))
+ "Convert STRING into a string containing valid XML character data.
+Replace occurrences of &<>'\" in STRING with their default XML
+entity references (e.g. replace each & with &amp;).
+
+XML character data must not contain & or < characters, nor the >
+character under some circumstances. The XML spec does not impose
+restriction on \" or ', but we just substitute for these too
+\(as is permitted by the spec)."
+ (with-temp-buffer
+ (insert string)
+ (dolist (substitution '(("&" . "&amp;")
+ ("<" . "&lt;")
+ (">" . "&gt;")
+ ("'" . "&apos;")
+ ("\"" . "&quot;")))
+ (goto-char (point-min))
+ (while (search-forward (car substitution) nil t)
+ (replace-match (cdr substitution) t t nil)))
+ (buffer-string)))
(defun xml-debug-print-internal (xml indent-string)
"Outputs the XML tree in the current buffer.
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index 09b2a7b88bd..76c78b84b42 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -1,6 +1,6 @@
;;; xt-mouse.el --- support the mouse when emacs run in an xterm
-;; Copyright (C) 1994, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2000-2012 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: mouse, terminals
@@ -47,33 +47,49 @@
;; Mouse events symbols must have an 'event-kind property with
;; the value 'mouse-click.
(dolist (event-type '(mouse-1 mouse-2 mouse-3
- M-down-mouse-1 M-down-mouse-2 M-down-mouse-3))
+ M-down-mouse-1 M-down-mouse-2 M-down-mouse-3))
(put event-type 'event-kind 'mouse-click))
(defun xterm-mouse-translate (_event)
"Read a click and release event from XTerm."
+ (xterm-mouse-translate-1))
+
+(defun xterm-mouse-translate-extended (_event)
+ "Read a click and release event from XTerm.
+Similar to `xterm-mouse-translate', but using the \"1006\"
+extension, which supports coordinates >= 231 (see
+http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
+ (xterm-mouse-translate-1 1006))
+
+(defun xterm-mouse-translate-1 (&optional extension)
(save-excursion
(save-window-excursion
(deactivate-mark)
- (let* ((xterm-mouse-last)
- (down (xterm-mouse-event))
+ (let* ((xterm-mouse-last nil)
+ (down (xterm-mouse-event extension))
(down-command (nth 0 down))
- (down-data (nth 1 down))
- (down-where (nth 1 down-data))
+ (down-data (nth 1 down))
+ (down-where (nth 1 down-data))
(down-binding (key-binding (if (symbolp down-where)
(vector down-where down-command)
(vector down-command))))
(is-click (string-match "^mouse" (symbol-name (car down)))))
+ ;; Retrieve the expected preface for the up-event.
(unless is-click
- (unless (and (eq (read-char) ?\e)
- (eq (read-char) ?\[)
- (eq (read-char) ?M))
+ (unless (cond ((null extension)
+ (and (eq (read-event) ?\e)
+ (eq (read-event) ?\[)
+ (eq (read-event) ?M)))
+ ((eq extension 1006)
+ (and (eq (read-event) ?\e)
+ (eq (read-event) ?\[)
+ (eq (read-event) ?<))))
(error "Unexpected escape sequence from XTerm")))
- (let* ((click (if is-click down (xterm-mouse-event)))
- ;; (click-command (nth 0 click))
- (click-data (nth 1 click))
+ ;; Process the up-event.
+ (let* ((click (if is-click down (xterm-mouse-event extension)))
+ (click-data (nth 1 click))
(click-where (nth 1 click-data)))
(if (memq down-binding '(nil ignore))
(if (and (symbolp click-where)
@@ -81,17 +97,18 @@
(vector (list click-where click-data) click)
(vector click))
(setq unread-command-events
- (if (eq down-where click-where)
- (list click)
- (list
- ;; Cheat `mouse-drag-region' with move event.
- (list 'mouse-movement click-data)
- ;; Generate a drag event.
- (if (symbolp down-where)
- 0
- (list (intern (format "drag-mouse-%d"
- (+ 1 xterm-mouse-last)))
- down-data click-data)))))
+ (append (if (eq down-where click-where)
+ (list click)
+ (list
+ ;; Cheat `mouse-drag-region' with move event.
+ (list 'mouse-movement click-data)
+ ;; Generate a drag event.
+ (if (symbolp down-where)
+ 0
+ (list (intern (format "drag-mouse-%d"
+ (1+ xterm-mouse-last)))
+ down-data click-data))))
+ unread-command-events))
(if xterm-mouse-debug-buffer
(print unread-command-events xterm-mouse-debug-buffer))
(if (and (symbolp down-where)
@@ -118,11 +135,11 @@
(terminal-parameter nil 'xterm-mouse-y))))
pos)
-;; read xterm sequences above ascii 127 (#x7f)
+;; Read XTerm sequences above ASCII 127 (#x7f)
(defun xterm-mouse-event-read ()
;; We get the characters decoded by the keyboard coding system. Try
;; to recover the raw character.
- (let ((c (read-char)))
+ (let ((c (read-event)))
(cond ;; If meta-flag is t we get a meta character
((>= c ?\M-\^@)
(- c (- ?\M-\^@ 128)))
@@ -147,11 +164,82 @@
(fdiff (- f (* 1.0 maxwrap dbig))))
(+ (truncate fdiff) (* maxwrap dbig))))))
-(defun xterm-mouse-event ()
- "Convert XTerm mouse event to Emacs mouse event."
- (let* ((type (- (xterm-mouse-event-read) #o40))
- (x (- (xterm-mouse-event-read) #o40 1))
- (y (- (xterm-mouse-event-read) #o40 1))
+;; Normal terminal mouse click reporting: expect three bytes, of the
+;; form <BUTTON+32> <X+32> <Y+32>. Return a list (EVENT-TYPE X Y).
+(defun xterm-mouse--read-event-sequence-1000 ()
+ (list (let ((code (- (xterm-mouse-event-read) 32)))
+ (intern
+ ;; For buttons > 3, the release-event looks differently
+ ;; (see xc/programs/xterm/button.c, function EditorButton),
+ ;; and come in a release-event only, no down-event.
+ (cond ((>= code 64)
+ (format "mouse-%d" (- code 60)))
+ ((memq code '(8 9 10))
+ (setq xterm-mouse-last code)
+ (format "M-down-mouse-%d" (- code 7)))
+ ((= code 11)
+ (format "M-mouse-%d" (- xterm-mouse-last 7)))
+ ((= code 3)
+ ;; For buttons > 5 xterm only reports a
+ ;; button-release event. Avoid error by mapping
+ ;; them all to mouse-1.
+ (format "mouse-%d" (+ 1 (or xterm-mouse-last 0))))
+ (t
+ (setq xterm-mouse-last code)
+ (format "down-mouse-%d" (+ 1 code))))))
+ ;; x and y coordinates
+ (- (xterm-mouse-event-read) 33)
+ (- (xterm-mouse-event-read) 33)))
+
+;; XTerm's 1006-mode terminal mouse click reporting has the form
+;; <BUTTON> ; <X> ; <Y> <M or m>, where the button and ordinates are
+;; in encoded (decimal) form. Return a list (EVENT-TYPE X Y).
+(defun xterm-mouse--read-event-sequence-1006 ()
+ (let (button-bytes x-bytes y-bytes c)
+ (while (not (eq (setq c (xterm-mouse-event-read)) ?\;))
+ (push c button-bytes))
+ (while (not (eq (setq c (xterm-mouse-event-read)) ?\;))
+ (push c x-bytes))
+ (while (not (memq (setq c (xterm-mouse-event-read)) '(?m ?M)))
+ (push c y-bytes))
+ (list (let* ((code (string-to-number
+ (apply 'string (nreverse button-bytes))))
+ (wheel (>= code 64))
+ (down (and (not wheel)
+ (eq c ?M))))
+ (intern (format "%s%smouse-%d"
+ (cond (wheel "")
+ ((< code 4) "")
+ ((< code 8) "S-")
+ ((< code 12) "M-")
+ ((< code 16) "M-S-")
+ ((< code 20) "C-")
+ ((< code 24) "C-S-")
+ ((< code 28) "C-M-")
+ ((< code 32) "C-M-S-")
+ (t
+ (error "Unexpected escape sequence from XTerm")))
+ (if down "down-" "")
+ (if wheel
+ (- code 60)
+ (1+ (setq xterm-mouse-last (mod code 4)))))))
+ (1- (string-to-number (apply 'string (nreverse x-bytes))))
+ (1- (string-to-number (apply 'string (nreverse y-bytes)))))))
+
+(defun xterm-mouse-event (&optional extension)
+ "Convert XTerm mouse event to Emacs mouse event.
+EXTENSION, if non-nil, means to use an extension to the usual
+terminal mouse protocol; we currently support the value 1006,
+which is the \"1006\" extension implemented in Xterm >= 277."
+ (let* ((click (cond ((null extension)
+ (xterm-mouse--read-event-sequence-1000))
+ ((eq extension 1006)
+ (xterm-mouse--read-event-sequence-1006))
+ (t
+ (error "Unsupported XTerm mouse protocol"))))
+ (type (nth 0 click))
+ (x (nth 1 click))
+ (y (nth 2 click))
;; Emulate timestamp information. This is accurate enough
;; for default value of mouse-1-click-follows-link (450msec).
(timestamp (xterm-mouse-truncate-wrap
@@ -159,36 +247,15 @@
(- (float-time)
(or xt-mouse-epoch
(setq xt-mouse-epoch (float-time)))))))
- (mouse (intern
- ;; For buttons > 3, the release-event looks
- ;; differently (see xc/programs/xterm/button.c,
- ;; function EditorButton), and there seems to come in
- ;; a release-event only, no down-event.
- (cond ((>= type 64)
- (format "mouse-%d" (- type 60)))
- ((memq type '(8 9 10))
- (setq xterm-mouse-last type)
- (format "M-down-mouse-%d" (- type 7)))
- ((= type 11)
- (format "mouse-%d" (- xterm-mouse-last 7)))
- ((= type 3)
- ;; For buttons > 5 xterm only reports a
- ;; button-release event. Avoid error by mapping
- ;; them all to mouse-1.
- (format "mouse-%d" (+ 1 (or xterm-mouse-last 0))))
- (t
- (setq xterm-mouse-last type)
- (format "down-mouse-%d" (+ 1 type))))))
(w (window-at x y))
(ltrb (window-edges w))
(left (nth 0 ltrb))
(top (nth 1 ltrb)))
-
(set-terminal-parameter nil 'xterm-mouse-x x)
(set-terminal-parameter nil 'xterm-mouse-y y)
(setq
last-input-event
- (list mouse
+ (list type
(let ((event (if w
(posn-at-x-y (- x left) (- y top) w t)
(append (list nil 'menu-bar)
@@ -248,11 +315,14 @@ down the SHIFT key while pressing the mouse button."
;; FIXME: is there more elegant way to detect the initial terminal?
(not (string= (terminal-name terminal) "initial_terminal")))
(unless (terminal-parameter terminal 'xterm-mouse-mode)
- ;; Simulate selecting a terminal by selecting one of its frames ;-(
+ ;; Simulate selecting a terminal by selecting one of its frames
(with-selected-frame (car (frames-on-display-list terminal))
- (define-key input-decode-map "\e[M" 'xterm-mouse-translate))
+ (define-key input-decode-map "\e[M" 'xterm-mouse-translate)
+ (define-key input-decode-map "\e[<" 'xterm-mouse-translate-extended))
(set-terminal-parameter terminal 'xterm-mouse-mode t))
- (send-string-to-terminal "\e[?1000h" terminal)))
+ (send-string-to-terminal "\e[?1000h" terminal)
+ ;; Request extended mouse support, if available (xterm >= 277).
+ (send-string-to-terminal "\e[?1006h" terminal)))
(defun turn-off-xterm-mouse-tracking-on-terminal (terminal)
"Disable xterm mouse tracking on TERMINAL."
@@ -268,7 +338,8 @@ down the SHIFT key while pressing the mouse button."
;; command too many times (or to catch an unintended key sequence), than
;; to send it too few times (or to fail to let xterm-mouse events
;; pass by untranslated).
- (send-string-to-terminal "\e[?1000l" terminal)))
+ (send-string-to-terminal "\e[?1000l" terminal)
+ (send-string-to-terminal "\e[?1006l" terminal)))
(provide 'xt-mouse)
diff --git a/lwlib/ChangeLog b/lwlib/ChangeLog
index 3b494865f0c..80d29bc5d8a 100644
--- a/lwlib/ChangeLog
+++ b/lwlib/ChangeLog
@@ -1,3 +1,68 @@
+2012-10-06 Ulrich Müller <ulm@gentoo.org>
+
+ * Makefile.in (AR, ARFLAGS): Get values from configure.
+
+2012-08-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use ASCII tests for character types.
+ * lwlib-Xaw.c, lwlib.c, xlwmenu.c:
+ Don't include <ctype.h>; no longer needed.
+ * lwlib-Xaw.c (openFont):
+ * xlwmenu.c (openXftFont): Test just for ASCII digits.
+
+2012-08-01 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (config_h): Add conf_post.h.
+
+2012-07-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid unused variable warning if --with-x-toolkit=motif.
+ * lwlib-Xm.c (make_menu_in_widget): Remove unused variable.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use c_strcasecmp for ASCII case-insensitive comparison (Bug#11786).
+ * lwlib.c: Include c-strcase.h.
+ (lwlib_strcasecmp): Remove. All uses replaced with c_strcasecmp.
+
+2012-06-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clean out last vestiges of the old HAVE_CONFIG_H stuff.
+ * Makefile.in (ALL_CFLAGS): Remove -DHAVE_CONFIG_H.
+ * lwlib-Xaw.c, lwlib-Xlw.c, lwlib-Xm.c, lwlib-utils.c, lwlib.c:
+ * xlwmenu.c: Include <config.h> unconditionally.
+
+2012-06-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * lwlib.c (my_strcasecmp): Rename to lwlib_strcasecmp, which
+ may be defined to library function strcasecmp if available.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Switch from NO_RETURN to C11's _Noreturn (Bug#11750).
+ * xlwmenu.c (abort_gracefully):
+ Use _Noreturn rather than NO_RETURN.
+ No need for separate decl merely because of _Noreturn.
+
+2012-05-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove obsolete '#define static' cruft.
+ * xlwmenu.c [emacs]: Include "bitmaps/gray.xbm".
+ (gray_bitmap_width, gray_bitmap_height, gray_bitmap_bits) [!emacs]:
+ Remove; all uses replaced with definiens.
+
+2012-04-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ configure: new option --enable-gcc-warnings (Bug#11207)
+ * Makefile.in (C_WARNINGS_SWITCH): Remove.
+ (WARN_CFLAGS, WERROR_CFLAGS): New macros.
+ (ALL_CFLAGS): Use new macros rather than old.
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (C_SWITCH_X_SYSTEM): Remove.
+ (ALL_CFLAGS): Remove C_SWITCH_X_SYSTEM.
+
2011-10-13 Dmitry Antipov <dmantipov@yandex.ru>
* lwlib-Xaw.c (openFont, xaw_destroy_instance): Replace free with
@@ -563,7 +628,7 @@
* xlwmenuP.h (_XlwMenu_part): Add top_depth.
- * xlwmenu.h: Removed declaration of pop_up_menu
+ * xlwmenu.h: Removed declaration of pop_up_menu.
* xlwmenu.c (Start): Get correct time if time in event is CurrentTime.
(find_first_selectable, find_next_selectable)
@@ -1756,7 +1821,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1995-1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1995-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in
index 1193cee4110..85a76f7a1c2 100644
--- a/lwlib/Makefile.in
+++ b/lwlib/Makefile.in
@@ -1,5 +1,5 @@
# Copyright (C) 1992, 1993 Lucid, Inc.
-# Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+# Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
#
# This file is part of the Lucid Widget Library.
#
@@ -26,18 +26,19 @@ srcdir=@srcdir@
VPATH=@srcdir@
@SET_MAKE@
C_SWITCH_X_SITE=@C_SWITCH_X_SITE@
-C_SWITCH_X_SYSTEM=@C_SWITCH_X_SYSTEM@
C_SWITCH_SYSTEM=@C_SWITCH_SYSTEM@
C_SWITCH_MACHINE=@C_SWITCH_MACHINE@
-C_WARNINGS_SWITCH = @C_WARNINGS_SWITCH@
PROFILING_CFLAGS = @PROFILING_CFLAGS@
+WARN_CFLAGS = `echo @WARN_CFLAGS@ | sed 's/ -Wwrite-strings//'`
+WERROR_CFLAGS = @WERROR_CFLAGS@
CC=@CC@
CFLAGS=@CFLAGS@
CPPFLAGS=@CPPFLAGS@
RANLIB=@RANLIB@
-AR = ar cq
+AR = @AR@
+ARFLAGS = @ARFLAGS@
LUCID_OBJS = lwlib-Xlw.o xlwmenu.o lwlib-Xaw.o
MOTIF_OBJS = lwlib-Xm.o
@@ -53,9 +54,9 @@ OBJS = lwlib.o $(TOOLKIT_OBJS) lwlib-utils.o
## $(srcdir) is where the lwlib sources are.
## There are no generated lwlib files, hence no need for -I.
ALL_CFLAGS= $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \
- $(C_SWITCH_X_SYSTEM) $(C_SWITCH_MACHINE) \
- $(C_WARNINGS_SWITCH) $(PROFILING_CFLAGS) $(CFLAGS) \
- -DHAVE_CONFIG_H -Demacs -I../src \
+ $(C_SWITCH_MACHINE) \
+ $(WARN_CFLAGS) $(WERROR_CFLAGS) $(PROFILING_CFLAGS) $(CFLAGS) \
+ -Demacs -I../src \
-I$(srcdir) -I$(srcdir)/../src -I../lib -I$(srcdir)/../lib
.c.o:
@@ -65,11 +66,11 @@ all:: liblw.a
liblw.a: $(OBJS)
rm -f $@
- $(AR) $@ $(OBJS)
+ $(AR) $(ARFLAGS) $@ $(OBJS)
$(RANLIB) $@
## Generated files in ../src, non-generated in $(srcdir)/../src.
-config_h = ../src/config.h
+config_h = ../src/config.h $(srcdir)/../src/conf_post.h
lisp_h = $(srcdir)/../src/lisp.h
## lisp.h includes this.
globals_h = ../src/globals.h
diff --git a/lwlib/lwlib-Xaw.c b/lwlib/lwlib-Xaw.c
index 0eea0aba7b6..d37fb70fdb8 100644
--- a/lwlib/lwlib-Xaw.c
+++ b/lwlib/lwlib-Xaw.c
@@ -1,7 +1,7 @@
/* The lwlib interface to Athena widgets.
Copyright (C) 1993 Chuck Thompson <cthomp@cs.uiuc.edu>
-Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
@@ -20,13 +20,10 @@ 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. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <stdio.h>
#include <setjmp.h>
-#include <ctype.h>
#include <lisp.h>
@@ -127,7 +124,7 @@ openFont (Widget widget, char *name)
XftFont *fn;
/* Try to convert Gtk-syntax (Sans 9) to Xft syntax Sans-9. */
- while (i > 0 && isdigit (fname[i]))
+ while (i > 0 && '0' <= fname[i] && fname[i] <= '9')
--i;
if (fname[i] == ' ')
{
@@ -148,7 +145,7 @@ get_text_width_and_height (Widget widget, char *text,
{
int w = 0, h = 0;
char *bp = text;
-
+
while (bp && *bp != '\0')
{
XGlyphInfo gi;
@@ -227,16 +224,16 @@ find_xft_data (Widget widget)
Widget parent = XtParent (widget);
struct widget_xft_data *data = NULL;
int nr;
- while (parent && !inst)
+ while (parent && !inst)
{
inst = lw_get_widget_instance (parent);
parent = XtParent (parent);
}
if (!inst || !inst->xft_data || !inst->xft_data[0].xft_font) return 0;
- for (nr = 0; data == NULL && nr < inst->nr_xft_data; ++nr)
+ for (nr = 0; data == NULL && nr < inst->nr_xft_data; ++nr)
{
- if (inst->xft_data[nr].widget == widget)
+ if (inst->xft_data[nr].widget == widget)
data = &inst->xft_data[nr];
}
@@ -250,7 +247,7 @@ command_press (Widget widget,
Cardinal *num_params)
{
struct widget_xft_data *data = find_xft_data (widget);
- if (data)
+ if (data)
{
char *lbl;
/* Since this isn't used for rectangle buttons, use it to for armed. */
@@ -268,11 +265,11 @@ command_reset (Widget widget,
Cardinal *num_params)
{
struct widget_xft_data *data = find_xft_data (widget);
- if (data)
+ if (data)
{
Dimension cr;
XtVaGetValues (widget, XtNcornerRoundPercent, &cr, NULL);
- if (cr == 1)
+ if (cr == 1)
{
char *lbl;
XtVaSetValues (widget, XtNcornerRoundPercent, 0, NULL);
@@ -366,14 +363,14 @@ void
xaw_destroy_instance (widget_instance *instance)
{
#ifdef HAVE_XFT
- if (instance->xft_data)
+ if (instance->xft_data)
{
int i;
- for (i = 0; i < instance->nr_xft_data; ++i)
+ for (i = 0; i < instance->nr_xft_data; ++i)
{
if (instance->xft_data[i].xft_draw)
XftDrawDestroy (instance->xft_data[i].xft_draw);
- if (instance->xft_data[i].p != None)
+ if (instance->xft_data[i].p != None)
{
XtVaSetValues (instance->xft_data[i].widget, XtNbitmap, None,
NULL);
@@ -483,7 +480,7 @@ static XtActionsRec xaw_actions [] = {
static Boolean actions_initted = False;
#ifdef HAVE_XFT
-static XtActionsRec button_actions[] =
+static XtActionsRec button_actions[] =
{
{ "my_reset", command_reset },
{ "my_press", command_press },
@@ -563,7 +560,7 @@ make_dialog (char* name,
XtVaGetValues (dialog,
XtNnumChildren, &num,
XtNchildren, &ch, NULL);
- for (i = 0; i < num; ++i)
+ for (i = 0; i < num; ++i)
{
if (!XtIsSubclass (ch[i], commandWidgetClass)
&& XtIsSubclass (ch[i], labelWidgetClass))
@@ -574,9 +571,9 @@ make_dialog (char* name,
}
instance->xft_data = 0;
instance->nr_xft_data = 0;
- if (w)
+ if (w)
{
- XtResource rec[] =
+ XtResource rec[] =
{ { "font", "Font", XtRString, sizeof(String), 0, XtRString,
(XtPointer)"Sans-10" }};
char *fontName = NULL;
@@ -590,8 +587,8 @@ make_dialog (char* name,
else
XFreeFont (XtDisplay (dialog), xfn);
}
-
- if (xft_font)
+
+ if (xft_font)
{
instance->nr_xft_data = left_buttons + right_buttons + 1;
instance->xft_data = calloc (instance->nr_xft_data,
@@ -639,7 +636,7 @@ make_dialog (char* name,
{
ac = 0;
XtSetArg (av [ac], XtNfromHoriz, button); ac++;
- if (i == 0)
+ if (i == 0)
{
/* Separator to the other buttons. */
XtSetArg (av [ac], XtNhorizDistance, 30); ac++;
diff --git a/lwlib/lwlib-Xlw.c b/lwlib/lwlib-Xlw.c
index fe33eec29bf..e8c59905ab9 100644
--- a/lwlib/lwlib-Xlw.c
+++ b/lwlib/lwlib-Xlw.c
@@ -1,7 +1,7 @@
/* The lwlib interface to "xlwmenu" menus.
Copyright (C) 1992 Lucid, Inc.
-Copyright (C) 1994, 2000-2011 Free Software Foundation, Inc.
+Copyright (C) 1994, 2000-2012 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
@@ -20,9 +20,7 @@ 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. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <setjmp.h>
#include <lisp.h>
diff --git a/lwlib/lwlib-Xm.c b/lwlib/lwlib-Xm.c
index 058e2e779c7..eccb4db23a6 100644
--- a/lwlib/lwlib-Xm.c
+++ b/lwlib/lwlib-Xm.c
@@ -1,6 +1,6 @@
/* The lwlib interface to Motif widgets.
-Copyright (C) 1994-1997, 1999-2011 Free Software Foundation, Inc.
+Copyright (C) 1994-1997, 1999-2012 Free Software Foundation, Inc.
Copyright (C) 1992 Lucid, Inc.
This file is part of the Lucid Widget Library.
@@ -20,9 +20,7 @@ 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. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <unistd.h>
#include <stdio.h>
@@ -492,7 +490,6 @@ make_menu_in_widget (widget_instance* instance,
int child_index;
widget_value* cur;
Widget button = 0;
- Widget title = 0;
Widget menu;
Arg al [256];
int ac;
@@ -556,7 +553,7 @@ make_menu_in_widget (widget_instance* instance,
{
ac = 0;
XtSetArg (al[ac], XmNalignment, XmALIGNMENT_CENTER); ac++;
- title = button = XmCreateLabel (widget, cur->name, al, ac);
+ button = XmCreateLabel (widget, cur->name, al, ac);
}
else if (lw_separator_p (cur->name, &separator, 1))
{
diff --git a/lwlib/lwlib-int.h b/lwlib/lwlib-int.h
index b142ab42d60..d5d723334c4 100644
--- a/lwlib/lwlib-int.h
+++ b/lwlib/lwlib-int.h
@@ -1,6 +1,6 @@
/*
Copyright (C) 1992 Lucid, Inc.
-Copyright (C) 2000-2011 Free Software Foundation, Inc.
+Copyright (C) 2000-2012 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
diff --git a/lwlib/lwlib-utils.c b/lwlib/lwlib-utils.c
index fe236a210f3..65cda72fdd8 100644
--- a/lwlib/lwlib-utils.c
+++ b/lwlib/lwlib-utils.c
@@ -1,7 +1,7 @@
/* Defines some widget utility functions.
Copyright (C) 1992 Lucid, Inc.
-Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
@@ -20,9 +20,7 @@ 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. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <setjmp.h>
#include <lisp.h>
diff --git a/lwlib/lwlib.c b/lwlib/lwlib.c
index b83517ad1f9..ad3792dd59d 100644
--- a/lwlib/lwlib.c
+++ b/lwlib/lwlib.c
@@ -1,7 +1,7 @@
/* A general interface to the widgets of different toolkits.
Copyright (C) 1992, 1993 Lucid, Inc.
-Copyright (C) 1994-1996, 1999-2011 Free Software Foundation, Inc.
+Copyright (C) 1994-1996, 1999-2012 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
@@ -20,16 +20,14 @@ 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. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <setjmp.h>
#include <lisp.h>
+#include <c-strcase.h>
#include <sys/types.h>
#include <stdio.h>
-#include <ctype.h>
#include "lwlib-int.h"
#include "lwlib-utils.h"
#include <X11/StringDefs.h>
@@ -75,7 +73,6 @@ static widget_value *merge_widget_value (widget_value *,
widget_value *,
int, int *);
static void instantiate_widget_instance (widget_instance *);
-static int my_strcasecmp (const char *, const char *);
static void safe_free_str (char *);
static void free_widget_value_tree (widget_value *);
static widget_value *copy_widget_value_tree (widget_value *,
@@ -115,26 +112,6 @@ safe_strdup (const char *s)
return result;
}
-/* Like strcmp but ignore differences in case. */
-
-static int
-my_strcasecmp (const char *s1, const char *s2)
-{
- while (1)
- {
- int c1 = *s1++;
- int c2 = *s2++;
- if (isupper (c1))
- c1 = tolower (c1);
- if (isupper (c2))
- c2 = tolower (c2);
- if (c1 != c2)
- return (c1 > c2 ? 1 : -1);
- if (c1 == 0)
- return 0;
- }
-}
-
static void
safe_free_str (char *s)
{
@@ -731,7 +708,7 @@ find_in_table (const char *type, const widget_creation_entry *table)
{
const widget_creation_entry* cur;
for (cur = table; cur->type; cur++)
- if (!my_strcasecmp (type, cur->type))
+ if (!c_strcasecmp (type, cur->type))
return cur->function;
return NULL;
}
diff --git a/lwlib/lwlib.h b/lwlib/lwlib.h
index cdd1e790efe..97c61e1b074 100644
--- a/lwlib/lwlib.h
+++ b/lwlib/lwlib.h
@@ -1,6 +1,6 @@
/*
Copyright (C) 1992, 1993 Lucid, Inc.
-Copyright (C) 1994, 1999-2011 Free Software Foundation, Inc.
+Copyright (C) 1994, 1999-2012 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c
index 0128464d6e0..c76cb1a3f38 100644
--- a/lwlib/xlwmenu.c
+++ b/lwlib/xlwmenu.c
@@ -1,7 +1,7 @@
/* Implements a lightweight menubar widget.
Copyright (C) 1992 Lucid, Inc.
-Copyright (C) 1994-1995, 1997, 1999-2011 Free Software Foundation, Inc.
+Copyright (C) 1994-1995, 1997, 1999-2012 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
@@ -22,15 +22,12 @@ Boston, MA 02110-1301, USA. */
/* Created by devin@lucid.com */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <setjmp.h>
#include <lisp.h>
#include <stdio.h>
-#include <ctype.h>
#include <sys/types.h>
#if (defined __sun) && !(defined SUNOS41)
@@ -49,22 +46,12 @@ Boston, MA 02110-1301, USA. */
#ifdef emacs
-/* Defined in xfns.c. When config.h defines `static' as empty, we get
- redefinition errors when gray_bitmap is included more than once, so
- we're referring to the one include in xfns.c here. */
-
-extern int gray_bitmap_width;
-extern int gray_bitmap_height;
-extern char *gray_bitmap_bits;
-
#include <xterm.h>
+#include "bitmaps/gray.xbm"
#else /* not emacs */
#include <X11/bitmaps/gray>
-#define gray_bitmap_width gray_width
-#define gray_bitmap_height gray_height
-#define gray_bitmap_bits gray_bits
#endif /* not emacs */
@@ -200,7 +187,6 @@ static void Key(Widget w, XEvent *ev, String *params, Cardinal *num_params);
static void Nothing(Widget w, XEvent *ev, String *params, Cardinal *num_params);
static int separator_height (enum menu_separator);
static void pop_up_menu (XlwMenuWidget, XButtonPressedEvent *);
-static void abort_gracefully (Widget w) NO_RETURN;
static XtActionsRec
xlwMenuActionsList [] =
@@ -283,7 +269,7 @@ ungrab_all (Widget w, Time ungrabtime)
/* Like abort, but remove grabs from widget W before. */
-static void
+static _Noreturn void
abort_gracefully (Widget w)
{
if (XtIsShell (XtParent (w)))
@@ -1871,7 +1857,7 @@ openXftFont (XlwMenuWidget mw)
int screen = XScreenNumberOfScreen (mw->core.screen);
int len = strlen (fname), i = len-1;
/* Try to convert Gtk-syntax (Sans 9) to Xft syntax Sans-9. */
- while (i > 0 && isdigit (fname[i]))
+ while (i > 0 && '0' <= fname[i] && fname[i] <= '9')
--i;
if (fname[i] == ' ')
{
@@ -1918,8 +1904,8 @@ XlwMenuInitialize (Widget request, Widget w, ArgList args, Cardinal *num_args)
mw->menu.cursor = mw->menu.cursor_shape;
mw->menu.gray_pixmap
- = XCreatePixmapFromBitmapData (display, window, gray_bitmap_bits,
- gray_bitmap_width, gray_bitmap_height,
+ = XCreatePixmapFromBitmapData (display, window, gray_bits,
+ gray_width, gray_height,
(unsigned long)1, (unsigned long)0, 1);
#ifdef HAVE_XFT
diff --git a/lwlib/xlwmenu.h b/lwlib/xlwmenu.h
index fad2aafb3d7..ae34fe32a47 100644
--- a/lwlib/xlwmenu.h
+++ b/lwlib/xlwmenu.h
@@ -1,6 +1,6 @@
/* Interface of a lightweight menubar widget.
-Copyright (C) 2002-2011 Free Software Foundation, Inc.
+Copyright (C) 2002-2012 Free Software Foundation, Inc.
Copyright (C) 1992 Lucid, Inc.
This file is part of the Lucid Widget Library.
diff --git a/lwlib/xlwmenuP.h b/lwlib/xlwmenuP.h
index 0aca2f8ea89..5decd562eed 100644
--- a/lwlib/xlwmenuP.h
+++ b/lwlib/xlwmenuP.h
@@ -1,6 +1,6 @@
/* Internals of a lightweight menubar widget.
-Copyright (C) 2002-2011 Free Software Foundation, Inc.
+Copyright (C) 2002-2012 Free Software Foundation, Inc.
Copyright (C) 1992 Lucid, Inc.
This file is part of the Lucid Widget Library.
diff --git a/m4/00gnulib.m4 b/m4/00gnulib.m4
index 7feed466940..d978cb898cf 100644
--- a/m4/00gnulib.m4
+++ b/m4/00gnulib.m4
@@ -1,5 +1,5 @@
# 00gnulib.m4 serial 2
-dnl Copyright (C) 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/alloca.m4 b/m4/alloca.m4
index a8744a844f3..656924be889 100644
--- a/m4/alloca.m4
+++ b/m4/alloca.m4
@@ -1,5 +1,5 @@
-# alloca.m4 serial 13
-dnl Copyright (C) 2002-2004, 2006-2007, 2009-2011 Free Software Foundation,
+# alloca.m4 serial 14
+dnl Copyright (C) 2002-2004, 2006-2007, 2009-2012 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -53,8 +53,8 @@ m4_version_prereq([2.69], [] ,[
# _AC_LIBOBJ_ALLOCA
# -----------------
-# Set up the LIBOBJ replacement of `alloca'. Well, not exactly
-# AC_LIBOBJ since we actually set the output variable `ALLOCA'.
+# Set up the LIBOBJ replacement of 'alloca'. Well, not exactly
+# AC_LIBOBJ since we actually set the output variable 'ALLOCA'.
# Nevertheless, for Automake, AC_LIBSOURCES it.
m4_define([_AC_LIBOBJ_ALLOCA],
[# The SVR3 libPW and SVR4 libucb both contain incompatible functions
@@ -63,9 +63,9 @@ m4_define([_AC_LIBOBJ_ALLOCA],
# use ar to extract alloca.o from them instead of compiling alloca.c.
AC_LIBSOURCES(alloca.c)
AC_SUBST([ALLOCA], [\${LIBOBJDIR}alloca.$ac_objext])dnl
-AC_DEFINE(C_ALLOCA, 1, [Define to 1 if using `alloca.c'.])
+AC_DEFINE(C_ALLOCA, 1, [Define to 1 if using 'alloca.c'.])
-AC_CACHE_CHECK(whether `alloca.c' needs Cray hooks, ac_cv_os_cray,
+AC_CACHE_CHECK(whether 'alloca.c' needs Cray hooks, ac_cv_os_cray,
[AC_EGREP_CPP(webecray,
[#if defined CRAY && ! defined CRAY2
webecray
@@ -77,10 +77,10 @@ if test $ac_cv_os_cray = yes; then
for ac_func in _getb67 GETB67 getb67; do
AC_CHECK_FUNC($ac_func,
[AC_DEFINE_UNQUOTED(CRAY_STACKSEG_END, $ac_func,
- [Define to one of `_getb67', `GETB67',
- `getb67' for Cray-2 and Cray-YMP
+ [Define to one of '_getb67', 'GETB67',
+ 'getb67' for Cray-2 and Cray-YMP
systems. This function is required for
- `alloca.c' support on those systems.])
+ 'alloca.c' support on those systems.])
break])
done
fi
diff --git a/m4/c-strtod.m4 b/m4/c-strtod.m4
index 20c65b82584..c002e5fcead 100644
--- a/m4/c-strtod.m4
+++ b/m4/c-strtod.m4
@@ -1,6 +1,6 @@
# c-strtod.m4 serial 14
-# Copyright (C) 2004-2006, 2009-2011 Free Software Foundation, Inc.
+# Copyright (C) 2004-2006, 2009-2012 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/clock_time.m4 b/m4/clock_time.m4
new file mode 100644
index 00000000000..0bec0ef860f
--- /dev/null
+++ b/m4/clock_time.m4
@@ -0,0 +1,31 @@
+# clock_time.m4 serial 10
+dnl Copyright (C) 2002-2006, 2009-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+# Check for clock_gettime and clock_settime, and set LIB_CLOCK_GETTIME.
+# For a program named, say foo, you should add a line like the following
+# in the corresponding Makefile.am file:
+# foo_LDADD = $(LDADD) $(LIB_CLOCK_GETTIME)
+
+AC_DEFUN([gl_CLOCK_TIME],
+[
+ dnl Persuade glibc and Solaris <time.h> to declare these functions.
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+
+ # Solaris 2.5.1 needs -lposix4 to get the clock_gettime function.
+ # Solaris 7 prefers the library name -lrt to the obsolescent name -lposix4.
+
+ # Save and restore LIBS so e.g., -lrt, isn't added to it. Otherwise, *all*
+ # programs in the package would end up linked with that potentially-shared
+ # library, inducing unnecessary run-time overhead.
+ LIB_CLOCK_GETTIME=
+ AC_SUBST([LIB_CLOCK_GETTIME])
+ gl_saved_libs=$LIBS
+ AC_SEARCH_LIBS([clock_gettime], [rt posix4],
+ [test "$ac_cv_search_clock_gettime" = "none required" ||
+ LIB_CLOCK_GETTIME=$ac_cv_search_clock_gettime])
+ AC_CHECK_FUNCS([clock_gettime clock_settime])
+ LIBS=$gl_saved_libs
+])
diff --git a/m4/close-stream.m4 b/m4/close-stream.m4
new file mode 100644
index 00000000000..be0c8a22979
--- /dev/null
+++ b/m4/close-stream.m4
@@ -0,0 +1,11 @@
+#serial 4
+dnl Copyright (C) 2006-2007, 2009-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl Prerequisites of lib/close-stream.c.
+AC_DEFUN([gl_CLOSE_STREAM],
+[
+ :
+])
diff --git a/m4/dup2.m4 b/m4/dup2.m4
index cd9d254b440..fc86e8085ba 100644
--- a/m4/dup2.m4
+++ b/m4/dup2.m4
@@ -1,5 +1,5 @@
-#serial 16
-dnl Copyright (C) 2002, 2005, 2007, 2009-2011 Free Software Foundation, Inc.
+#serial 18
+dnl Copyright (C) 2002, 2005, 2007, 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -45,29 +45,34 @@ AC_DEFUN([gl_FUNC_DUP2],
[gl_cv_func_dup2_works=yes], [gl_cv_func_dup2_works=no],
[case "$host_os" in
mingw*) # on this platform, dup2 always returns 0 for success
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
linux*) # On linux between 2008-07-27 and 2009-05-11, dup2 of a
# closed fd may yield -EBADF instead of -1 / errno=EBADF.
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
freebsd*) # on FreeBSD 6.1, dup2(1,1000000) gives EMFILE, not EBADF.
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC.
- gl_cv_func_dup2_works=no;;
- *) gl_cv_func_dup2_works=yes;;
+ gl_cv_func_dup2_works="guessing no" ;;
+ *) gl_cv_func_dup2_works="guessing yes" ;;
esac])
])
- if test "$gl_cv_func_dup2_works" = no; then
- REPLACE_DUP2=1
- fi
+ case "$gl_cv_func_dup2_works" in
+ *yes) ;;
+ *)
+ REPLACE_DUP2=1
+ ;;
+ esac
fi
dnl Replace dup2() for supporting the gnulib-defined fchdir() function,
dnl to keep fchdir's bookkeeping up-to-date.
m4_ifdef([gl_FUNC_FCHDIR], [
gl_TEST_FCHDIR
if test $HAVE_FCHDIR = 0; then
- REPLACE_DUP2=1
+ if test $HAVE_DUP2 = 1; then
+ REPLACE_DUP2=1
+ fi
fi
])
])
diff --git a/m4/environ.m4 b/m4/environ.m4
new file mode 100644
index 00000000000..8eb57c9d999
--- /dev/null
+++ b/m4/environ.m4
@@ -0,0 +1,47 @@
+# environ.m4 serial 6
+dnl Copyright (C) 2001-2004, 2006-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN_ONCE([gl_ENVIRON],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ dnl Persuade glibc <unistd.h> to declare environ.
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+
+ AC_CHECK_HEADERS_ONCE([unistd.h])
+ gt_CHECK_VAR_DECL(
+ [#if HAVE_UNISTD_H
+ #include <unistd.h>
+ #endif
+ /* mingw, BeOS, Haiku declare environ in <stdlib.h>, not in <unistd.h>. */
+ #include <stdlib.h>
+ ],
+ [environ])
+ if test $gt_cv_var_environ_declaration != yes; then
+ HAVE_DECL_ENVIRON=0
+ fi
+])
+
+# Check if a variable is properly declared.
+# gt_CHECK_VAR_DECL(includes,variable)
+AC_DEFUN([gt_CHECK_VAR_DECL],
+[
+ define([gt_cv_var], [gt_cv_var_]$2[_declaration])
+ AC_MSG_CHECKING([if $2 is properly declared])
+ AC_CACHE_VAL([gt_cv_var], [
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[$1
+ extern struct { int foo; } $2;]],
+ [[$2.foo = 1;]])],
+ [gt_cv_var=no],
+ [gt_cv_var=yes])])
+ AC_MSG_RESULT([$gt_cv_var])
+ if test $gt_cv_var = yes; then
+ AC_DEFINE([HAVE_]m4_translit($2, [a-z], [A-Z])[_DECL], 1,
+ [Define if you have the declaration of $2.])
+ fi
+ undefine([gt_cv_var])
+])
diff --git a/m4/euidaccess.m4 b/m4/euidaccess.m4
new file mode 100644
index 00000000000..2de95b88ba8
--- /dev/null
+++ b/m4/euidaccess.m4
@@ -0,0 +1,52 @@
+# euidaccess.m4 serial 15
+dnl Copyright (C) 2002-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_NONREENTRANT_EUIDACCESS],
+[
+ AC_REQUIRE([gl_FUNC_EUIDACCESS])
+ AC_CHECK_DECLS([setregid])
+ AC_DEFINE([PREFER_NONREENTRANT_EUIDACCESS], [1],
+ [Define this if you prefer euidaccess to return the correct result
+ even if this would make it nonreentrant. Define this only if your
+ entire application is safe even if the uid or gid might temporarily
+ change. If your application uses signal handlers or threads it
+ is probably not safe.])
+])
+
+AC_DEFUN([gl_FUNC_EUIDACCESS],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+
+ dnl Persuade glibc <unistd.h> to declare euidaccess().
+ AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+
+ AC_CHECK_FUNCS([euidaccess])
+ if test $ac_cv_func_euidaccess = no; then
+ HAVE_EUIDACCESS=0
+ fi
+])
+
+# Prerequisites of lib/euidaccess.c.
+AC_DEFUN([gl_PREREQ_EUIDACCESS], [
+ dnl Prefer POSIX faccessat over non-standard euidaccess.
+ AC_CHECK_FUNCS_ONCE([faccessat])
+ dnl Try various other non-standard fallbacks.
+ AC_CHECK_HEADERS([libgen.h])
+ AC_FUNC_GETGROUPS
+
+ # Solaris 9 and 10 need -lgen to get the eaccess function.
+ # Save and restore LIBS so -lgen isn't added to it. Otherwise, *all*
+ # programs in the package would end up linked with that potentially-shared
+ # library, inducing unnecessary run-time overhead.
+ LIB_EACCESS=
+ AC_SUBST([LIB_EACCESS])
+ gl_saved_libs=$LIBS
+ AC_SEARCH_LIBS([eaccess], [gen],
+ [test "$ac_cv_search_eaccess" = "none required" ||
+ LIB_EACCESS=$ac_cv_search_eaccess])
+ AC_CHECK_FUNCS([eaccess])
+ LIBS=$gl_saved_libs
+])
diff --git a/m4/execinfo.m4 b/m4/execinfo.m4
new file mode 100644
index 00000000000..f1f3cd91638
--- /dev/null
+++ b/m4/execinfo.m4
@@ -0,0 +1,31 @@
+# Check for GNU-style execinfo.h.
+
+dnl Copyright 2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_EXECINFO_H],
+[
+ AC_CHECK_HEADERS_ONCE([execinfo.h])
+
+ LIB_EXECINFO=''
+ EXECINFO_H='execinfo.h'
+
+ if test $ac_cv_header_execinfo_h = yes; then
+ gl_saved_libs=$LIBS
+ AC_SEARCH_LIBS([backtrace_symbols_fd], [execinfo],
+ [test "$ac_cv_search_backtrace_symbols_fd" = "none required" ||
+ LIB_EXECINFO=$ac_cv_search_backtrace_symbols_fd])
+ LIBS=$gl_saved_libs
+ test "$ac_cv_search_backtrace_symbols_fd" = no || EXECINFO_H=''
+ fi
+
+ if test -n "$EXECINFO_H"; then
+ AC_LIBOBJ([execinfo])
+ fi
+
+ AC_SUBST([EXECINFO_H])
+ AC_SUBST([LIB_EXECINFO])
+ AM_CONDITIONAL([GL_GENERATE_EXECINFO_H], [test -n "$EXECINFO_H"])
+])
diff --git a/m4/extensions.m4 b/m4/extensions.m4
index 22156e068c6..6d17d8a748b 100644
--- a/m4/extensions.m4
+++ b/m4/extensions.m4
@@ -1,7 +1,7 @@
-# serial 10 -*- Autoconf -*-
+# serial 12 -*- Autoconf -*-
# Enable extensions on systems that normally disable them.
-# Copyright (C) 2003, 2006-2011 Free Software Foundation, Inc.
+# Copyright (C) 2003, 2006-2012 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
@@ -43,7 +43,7 @@ AC_BEFORE([$0], [AC_RUN_IFELSE])dnl
AC_CHECK_HEADER([minix/config.h], [MINIX=yes], [MINIX=])
if test "$MINIX" = yes; then
AC_DEFINE([_POSIX_SOURCE], [1],
- [Define to 1 if you need to in order for `stat' and other
+ [Define to 1 if you need to in order for 'stat' and other
things to work.])
AC_DEFINE([_POSIX_1_SOURCE], [2],
[Define to 2 if the system does not provide POSIX.1 features
@@ -67,7 +67,7 @@ AC_BEFORE([$0], [AC_RUN_IFELSE])dnl
#ifndef _ALL_SOURCE
# undef _ALL_SOURCE
#endif
-/* Enable general extensions on MacOS X. */
+/* Enable general extensions on Mac OS X. */
#ifndef _DARWIN_C_SOURCE
# undef _DARWIN_C_SOURCE
#endif
diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4
new file mode 100644
index 00000000000..600c8d3fa17
--- /dev/null
+++ b/m4/extern-inline.m4
@@ -0,0 +1,57 @@
+dnl 'extern inline' a la ISO C99.
+
+dnl Copyright 2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_EXTERN_INLINE],
+[
+ AC_REQUIRE([AC_C_INLINE])
+ AH_VERBATIM([extern_inline],
+[/* _GL_INLINE is a portable alternative to ISO C99 plain 'inline'.
+ _GL_EXTERN_INLINE is a portable alternative to 'extern inline'.
+ _GL_INLINE_HEADER_BEGIN contains useful stuff to put
+ in an include file, before uses of _GL_INLINE.
+ It suppresses GCC's bogus "no previous prototype for 'FOO'" diagnostic,
+ when FOO is an inline function in the header; see
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54113>.
+ _GL_INLINE_HEADER_END contains useful stuff to put
+ in the same include file, after uses of _GL_INLINE. */
+#if (__GNUC__ \
+ ? defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__ \
+ : 199901L <= __STDC_VERSION__)
+# define _GL_INLINE inline
+# define _GL_EXTERN_INLINE extern inline
+#elif 2 < __GNUC__ + (7 <= __GNUC_MINOR__)
+# if __GNUC_GNU_INLINE__
+ /* __gnu_inline__ suppresses a GCC 4.2 diagnostic. */
+# define _GL_INLINE extern inline __attribute__ ((__gnu_inline__))
+# else
+# define _GL_INLINE extern inline
+# endif
+# define _GL_EXTERN_INLINE extern
+#else
+# define _GL_INLINE static inline
+# define _GL_EXTERN_INLINE static inline
+#endif
+
+#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
+# if defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__
+# define _GL_INLINE_HEADER_CONST_PRAGMA
+# else
+# define _GL_INLINE_HEADER_CONST_PRAGMA \
+ _Pragma ("GCC diagnostic ignored \"-Wsuggest-attribute=const\"")
+# endif
+# define _GL_INLINE_HEADER_BEGIN \
+ _Pragma ("GCC diagnostic push") \
+ _Pragma ("GCC diagnostic ignored \"-Wmissing-prototypes\"") \
+ _Pragma ("GCC diagnostic ignored \"-Wmissing-declarations\"") \
+ _GL_INLINE_HEADER_CONST_PRAGMA
+# define _GL_INLINE_HEADER_END \
+ _Pragma ("GCC diagnostic pop")
+#else
+# define _GL_INLINE_HEADER_BEGIN
+# define _GL_INLINE_HEADER_END
+#endif])
+])
diff --git a/m4/faccessat.m4 b/m4/faccessat.m4
new file mode 100644
index 00000000000..82f3b1f8dde
--- /dev/null
+++ b/m4/faccessat.m4
@@ -0,0 +1,28 @@
+# serial 6
+# See if we need to provide faccessat replacement.
+
+dnl Copyright (C) 2009-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+# Written by Eric Blake.
+
+AC_DEFUN([gl_FUNC_FACCESSAT],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+
+ dnl Persuade glibc <unistd.h> to declare faccessat().
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+
+ AC_CHECK_FUNCS_ONCE([faccessat])
+ if test $ac_cv_func_faccessat = no; then
+ HAVE_FACCESSAT=0
+ fi
+])
+
+# Prerequisites of lib/faccessat.m4.
+AC_DEFUN([gl_PREREQ_FACCESSAT],
+[
+ AC_CHECK_FUNCS([access])
+])
diff --git a/m4/fcntl_h.m4 b/m4/fcntl_h.m4
new file mode 100644
index 00000000000..cac28aeb283
--- /dev/null
+++ b/m4/fcntl_h.m4
@@ -0,0 +1,50 @@
+# serial 15
+# Configure fcntl.h.
+dnl Copyright (C) 2006-2007, 2009-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl Written by Paul Eggert.
+
+AC_DEFUN([gl_FCNTL_H],
+[
+ AC_REQUIRE([gl_FCNTL_H_DEFAULTS])
+ AC_REQUIRE([gl_FCNTL_O_FLAGS])
+ gl_NEXT_HEADERS([fcntl.h])
+
+ dnl Ensure the type pid_t gets defined.
+ AC_REQUIRE([AC_TYPE_PID_T])
+
+ dnl Ensure the type mode_t gets defined.
+ AC_REQUIRE([AC_TYPE_MODE_T])
+
+ dnl Check for declarations of anything we want to poison if the
+ dnl corresponding gnulib module is not in use, if it is not common
+ dnl enough to be declared everywhere.
+ gl_WARN_ON_USE_PREPARE([[#include <fcntl.h>
+ ]], [fcntl openat])
+])
+
+AC_DEFUN([gl_FCNTL_MODULE_INDICATOR],
+[
+ dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+ AC_REQUIRE([gl_FCNTL_H_DEFAULTS])
+ gl_MODULE_INDICATOR_SET_VARIABLE([$1])
+ dnl Define it also as a C macro, for the benefit of the unit tests.
+ gl_MODULE_INDICATOR_FOR_TESTS([$1])
+])
+
+AC_DEFUN([gl_FCNTL_H_DEFAULTS],
+[
+ GNULIB_FCNTL=0; AC_SUBST([GNULIB_FCNTL])
+ GNULIB_NONBLOCKING=0; AC_SUBST([GNULIB_NONBLOCKING])
+ GNULIB_OPEN=0; AC_SUBST([GNULIB_OPEN])
+ GNULIB_OPENAT=0; AC_SUBST([GNULIB_OPENAT])
+ dnl Assume proper GNU behavior unless another module says otherwise.
+ HAVE_FCNTL=1; AC_SUBST([HAVE_FCNTL])
+ HAVE_OPENAT=1; AC_SUBST([HAVE_OPENAT])
+ REPLACE_FCNTL=0; AC_SUBST([REPLACE_FCNTL])
+ REPLACE_OPEN=0; AC_SUBST([REPLACE_OPEN])
+ REPLACE_OPENAT=0; AC_SUBST([REPLACE_OPENAT])
+])
diff --git a/m4/filemode.m4 b/m4/filemode.m4
index 8f6e8bc3bb0..1aa6cdd57b2 100644
--- a/m4/filemode.m4
+++ b/m4/filemode.m4
@@ -1,5 +1,5 @@
# filemode.m4 serial 8
-dnl Copyright (C) 2002, 2005-2006, 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2005-2006, 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/fpending.m4 b/m4/fpending.m4
new file mode 100644
index 00000000000..33a5c94c3a3
--- /dev/null
+++ b/m4/fpending.m4
@@ -0,0 +1,90 @@
+# serial 19
+
+# Copyright (C) 2000-2001, 2004-2012 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl From Jim Meyering
+dnl Using code from emacs, based on suggestions from Paul Eggert
+dnl and Ulrich Drepper.
+
+dnl Find out how to determine the number of pending output bytes on a stream.
+dnl glibc (2.1.93 and newer) and Solaris provide __fpending. On other systems,
+dnl we have to grub around in the FILE struct.
+
+AC_DEFUN([gl_FUNC_FPENDING],
+[
+ AC_CHECK_HEADERS_ONCE([stdio_ext.h])
+ AC_CHECK_FUNCS_ONCE([__fpending])
+ fp_headers='
+# include <stdio.h>
+# if HAVE_STDIO_EXT_H
+# include <stdio_ext.h>
+# endif
+'
+ AC_CHECK_DECLS([__fpending], , , $fp_headers)
+])
+
+AC_DEFUN([gl_PREREQ_FPENDING],
+[
+ AC_CACHE_CHECK(
+ [how to determine the number of pending output bytes on a stream],
+ ac_cv_sys_pending_output_n_bytes,
+ [
+ for ac_expr in \
+ \
+ '# glibc2' \
+ 'fp->_IO_write_ptr - fp->_IO_write_base' \
+ \
+ '# traditional Unix' \
+ 'fp->_ptr - fp->_base' \
+ \
+ '# BSD' \
+ 'fp->_p - fp->_bf._base' \
+ \
+ '# SCO, Unixware' \
+ '(fp->__ptr ? fp->__ptr - fp->__base : 0)' \
+ \
+ '# QNX' \
+ '(fp->_Mode & 0x2000 /*_MWRITE*/ ? fp->_Next - fp->_Buf : 0)' \
+ \
+ '# old glibc?' \
+ 'fp->__bufp - fp->__buffer' \
+ \
+ '# old glibc iostream?' \
+ 'fp->_pptr - fp->_pbase' \
+ \
+ '# emx+gcc' \
+ 'fp->_ptr - fp->_buffer' \
+ \
+ '# Minix' \
+ 'fp->_ptr - fp->_buf' \
+ \
+ '# Plan9' \
+ 'fp->wp - fp->buf' \
+ \
+ '# VMS' \
+ '(*fp)->_ptr - (*fp)->_base' \
+ \
+ '# e.g., DGUX R4.11; the info is not available' \
+ 1 \
+ ; do
+
+ # Skip each embedded comment.
+ case "$ac_expr" in '#'*) continue;; esac
+
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <stdio.h>]],
+ [[FILE *fp = stdin; (void) ($ac_expr);]])],
+ [fp_done=yes]
+ )
+ test "$fp_done" = yes && break
+ done
+
+ ac_cv_sys_pending_output_n_bytes=$ac_expr
+ ]
+ )
+ AC_DEFINE_UNQUOTED([PENDING_OUTPUT_N_BYTES],
+ $ac_cv_sys_pending_output_n_bytes,
+ [the number of pending output bytes on stream 'fp'])
+])
diff --git a/m4/getgroups.m4 b/m4/getgroups.m4
new file mode 100644
index 00000000000..17473af486b
--- /dev/null
+++ b/m4/getgroups.m4
@@ -0,0 +1,107 @@
+# serial 18
+
+dnl From Jim Meyering.
+dnl A wrapper around AC_FUNC_GETGROUPS.
+
+# Copyright (C) 1996-1997, 1999-2004, 2008-2012 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+m4_version_prereq([2.70], [] ,[
+
+# This is taken from the following Autoconf patch:
+# http://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=7fbb553727ed7e0e689a17594b58559ecf3ea6e9
+AC_DEFUN([AC_FUNC_GETGROUPS],
+[
+ AC_REQUIRE([AC_TYPE_GETGROUPS])dnl
+ AC_REQUIRE([AC_TYPE_SIZE_T])dnl
+ AC_REQUIRE([AC_CANONICAL_HOST])dnl for cross-compiles
+ AC_CHECK_FUNC([getgroups])
+
+ # If we don't yet have getgroups, see if it's in -lbsd.
+ # This is reported to be necessary on an ITOS 3000WS running SEIUX 3.1.
+ ac_save_LIBS=$LIBS
+ if test $ac_cv_func_getgroups = no; then
+ AC_CHECK_LIB(bsd, getgroups, [GETGROUPS_LIB=-lbsd])
+ fi
+
+ # Run the program to test the functionality of the system-supplied
+ # getgroups function only if there is such a function.
+ if test $ac_cv_func_getgroups = yes; then
+ AC_CACHE_CHECK([for working getgroups], [ac_cv_func_getgroups_works],
+ [AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM(
+ [AC_INCLUDES_DEFAULT],
+ [[/* On Ultrix 4.3, getgroups (0, 0) always fails. */
+ return getgroups (0, 0) == -1;]])
+ ],
+ [ac_cv_func_getgroups_works=yes],
+ [ac_cv_func_getgroups_works=no],
+ [case "$host_os" in # ((
+ # Guess yes on glibc systems.
+ *-gnu*) ac_cv_func_getgroups_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) ac_cv_func_getgroups_works="guessing no" ;;
+ esac
+ ])
+ ])
+ else
+ ac_cv_func_getgroups_works=no
+ fi
+ case "$ac_cv_func_getgroups_works" in
+ *yes)
+ AC_DEFINE([HAVE_GETGROUPS], [1],
+ [Define to 1 if your system has a working `getgroups' function.])
+ ;;
+ esac
+ LIBS=$ac_save_LIBS
+])# AC_FUNC_GETGROUPS
+
+])
+
+AC_DEFUN([gl_FUNC_GETGROUPS],
+[
+ AC_REQUIRE([AC_TYPE_GETGROUPS])
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+
+ AC_FUNC_GETGROUPS
+ if test $ac_cv_func_getgroups != yes; then
+ HAVE_GETGROUPS=0
+ else
+ if test "$ac_cv_type_getgroups" != gid_t \
+ || { case "$ac_cv_func_getgroups_works" in
+ *yes) false;;
+ *) true;;
+ esac
+ }; then
+ REPLACE_GETGROUPS=1
+ AC_DEFINE([GETGROUPS_ZERO_BUG], [1], [Define this to 1 if
+ getgroups(0,NULL) does not return the number of groups.])
+ else
+ dnl Detect FreeBSD bug; POSIX requires getgroups(-1,ptr) to fail.
+ AC_CACHE_CHECK([whether getgroups handles negative values],
+ [gl_cv_func_getgroups_works],
+ [AC_RUN_IFELSE([AC_LANG_PROGRAM([AC_INCLUDES_DEFAULT],
+ [[int size = getgroups (0, 0);
+ gid_t *list = malloc (size * sizeof *list);
+ return getgroups (-1, list) != -1;]])],
+ [gl_cv_func_getgroups_works=yes],
+ [gl_cv_func_getgroups_works=no],
+ [case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_getgroups_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_getgroups_works="guessing no" ;;
+ esac
+ ])])
+ case "$gl_cv_func_getgroups_works" in
+ *yes) ;;
+ *) REPLACE_GETGROUPS=1 ;;
+ esac
+ fi
+ fi
+ test -n "$GETGROUPS_LIB" && LIBS="$GETGROUPS_LIB $LIBS"
+])
diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4
index b16f40de0aa..7738d2f8669 100644
--- a/m4/getloadavg.m4
+++ b/m4/getloadavg.m4
@@ -1,13 +1,13 @@
# Check for getloadavg.
-# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2011 Free Software
+# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2012 Free Software
# Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
-#serial 5
+#serial 6
# Autoconf defines AC_FUNC_GETLOADAVG, but that is obsolescent.
# New applications should use gl_GETLOADAVG instead.
@@ -22,7 +22,7 @@ AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
gl_save_LIBS=$LIBS
-# getloadvg is present in libc on glibc >= 2.2, MacOS X, FreeBSD >= 2.0,
+# getloadvg is present in libc on glibc >= 2.2, Mac OS X, FreeBSD >= 2.0,
# NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7.
HAVE_GETLOADAVG=1
AC_CHECK_FUNC([getloadavg], [],
@@ -100,11 +100,13 @@ AC_CHECK_DECL([getloadavg], [], [HAVE_DECL_GETLOADAVG=0],
# gl_PREREQ_GETLOADAVG
# --------------------
-# Set up the AC_LIBOBJ replacement of `getloadavg'.
+# Set up the AC_LIBOBJ replacement of 'getloadavg'.
AC_DEFUN([gl_PREREQ_GETLOADAVG],
[
# Figure out what our getloadavg.c needs.
+AC_CHECK_HEADERS_ONCE([sys/param.h])
+
# On HPUX9, an unprivileged user can get load averages this way.
if test $gl_func_getloadavg_done = no; then
AC_CHECK_FUNCS([pstat_getdynamic], [gl_func_getloadavg_done=yes])
diff --git a/m4/getopt.m4 b/m4/getopt.m4
index 047a3db0221..f6902b58591 100644
--- a/m4/getopt.m4
+++ b/m4/getopt.m4
@@ -1,5 +1,5 @@
-# getopt.m4 serial 38
-dnl Copyright (C) 2002-2006, 2008-2011 Free Software Foundation, Inc.
+# getopt.m4 serial 44
+dnl Copyright (C) 2002-2006, 2008-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -9,24 +9,21 @@ AC_DEFUN([gl_FUNC_GETOPT_POSIX],
[
m4_divert_text([DEFAULTS], [gl_getopt_required=POSIX])
AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ AC_REQUIRE([gl_GETOPT_CHECK_HEADERS])
dnl Other modules can request the gnulib implementation of the getopt
dnl functions unconditionally, by defining gl_REPLACE_GETOPT_ALWAYS.
dnl argp.m4 does this.
m4_ifdef([gl_REPLACE_GETOPT_ALWAYS], [
- gl_GETOPT_IFELSE([], [])
REPLACE_GETOPT=1
], [
REPLACE_GETOPT=0
- gl_GETOPT_IFELSE([
+ if test -n "$gl_replace_getopt"; then
REPLACE_GETOPT=1
- ],
- [])
+ fi
])
if test $REPLACE_GETOPT = 1; then
dnl Arrange for getopt.h to be created.
gl_GETOPT_SUBSTITUTE_HEADER
- dnl Arrange for unistd.h to include getopt.h.
- GNULIB_UNISTD_H_GETOPT=1
fi
])
@@ -40,13 +37,6 @@ AC_DEFUN([gl_FUNC_GETOPT_GNU],
AC_REQUIRE([gl_FUNC_GETOPT_POSIX])
])
-# emacs' configure.in uses this.
-AC_DEFUN([gl_GETOPT_IFELSE],
-[
- AC_REQUIRE([gl_GETOPT_CHECK_HEADERS])
- AS_IF([test -n "$gl_replace_getopt"], [$1], [$2])
-])
-
# Determine whether to replace the entire getopt facility.
AC_DEFUN([gl_GETOPT_CHECK_HEADERS],
[
@@ -76,11 +66,6 @@ AC_DEFUN([gl_GETOPT_CHECK_HEADERS],
AC_CHECK_FUNCS([getopt_long_only], [], [gl_replace_getopt=yes])
fi
- dnl mingw's getopt (in libmingwex.a) does weird things when the options
- dnl strings starts with '+' and it's not the first call. Some internal state
- dnl is left over from earlier calls, and neither setting optind = 0 nor
- dnl setting optreset = 1 get rid of this internal state.
- dnl POSIX is silent on optind vs. optreset, so we allow either behavior.
dnl POSIX 2008 does not specify leading '+' behavior, but see
dnl http://austingroupbugs.net/view.php?id=191 for a recommendation on
dnl the next version of POSIX. For now, we only guarantee leading '+'
@@ -89,30 +74,16 @@ AC_DEFUN([gl_GETOPT_CHECK_HEADERS],
AC_CACHE_CHECK([whether getopt is POSIX compatible],
[gl_cv_func_getopt_posix],
[
- dnl BSD getopt_long uses an incompatible method to reset option
- dnl processing. Existence of the optreset variable, in and of
- dnl itself, is not a reason to replace getopt, but knowledge
- dnl of the variable is needed to determine how to reset and
- dnl whether a reset reparses the environment. Solaris
- dnl supports neither optreset nor optind=0, but keeps no state
- dnl that needs a reset beyond setting optind=1; detect Solaris
- dnl by getopt_clip.
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [[#include <unistd.h>]],
- [[int *p = &optreset; return optreset;]])],
- [gl_optind_min=1],
- [AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM(
- [[#include <getopt.h>]],
- [[return !getopt_clip;]])],
- [gl_optind_min=1],
- [gl_optind_min=0])])
-
- dnl This test fails on mingw and succeeds on many other platforms.
- gl_save_CPPFLAGS=$CPPFLAGS
- CPPFLAGS="$CPPFLAGS -DOPTIND_MIN=$gl_optind_min"
- AC_RUN_IFELSE([AC_LANG_SOURCE([[
+ dnl Merging these three different test programs into a single one
+ dnl would require a reset mechanism. On BSD systems, it can be done
+ dnl through 'optreset'; on some others (glibc), it can be done by
+ dnl setting 'optind' to 0; on others again (HP-UX, IRIX, OSF/1,
+ dnl Solaris 9, musl libc), there is no such mechanism.
+ if test $cross_compiling = no; then
+ dnl Sanity check. Succeeds everywhere (except on MSVC,
+ dnl which lacks <unistd.h> and getopt() entirely).
+ AC_RUN_IFELSE(
+ [AC_LANG_SOURCE([[
#include <unistd.h>
#include <stdlib.h>
#include <string.h>
@@ -120,89 +91,107 @@ AC_DEFUN([gl_GETOPT_CHECK_HEADERS],
int
main ()
{
- {
- static char program[] = "program";
- static char a[] = "-a";
- static char foo[] = "foo";
- static char bar[] = "bar";
- char *argv[] = { program, a, foo, bar, NULL };
- int c;
+ static char program[] = "program";
+ static char a[] = "-a";
+ static char foo[] = "foo";
+ static char bar[] = "bar";
+ char *argv[] = { program, a, foo, bar, NULL };
+ int c;
- optind = OPTIND_MIN;
- opterr = 0;
-
- c = getopt (4, argv, "ab");
- if (!(c == 'a'))
- return 1;
- c = getopt (4, argv, "ab");
- if (!(c == -1))
- return 2;
- if (!(optind == 2))
- return 3;
- }
- /* Some internal state exists at this point. */
- {
- static char program[] = "program";
- static char donald[] = "donald";
- static char p[] = "-p";
- static char billy[] = "billy";
- static char duck[] = "duck";
- static char a[] = "-a";
- static char bar[] = "bar";
- char *argv[] = { program, donald, p, billy, duck, a, bar, NULL };
- int c;
+ c = getopt (4, argv, "ab");
+ if (!(c == 'a'))
+ return 1;
+ c = getopt (4, argv, "ab");
+ if (!(c == -1))
+ return 2;
+ if (!(optind == 2))
+ return 3;
+ return 0;
+}
+]])],
+ [gl_cv_func_getopt_posix=maybe],
+ [gl_cv_func_getopt_posix=no])
+ if test $gl_cv_func_getopt_posix = maybe; then
+ dnl Sanity check with '+'. Succeeds everywhere (except on MSVC,
+ dnl which lacks <unistd.h> and getopt() entirely).
+ AC_RUN_IFELSE(
+ [AC_LANG_SOURCE([[
+#include <unistd.h>
+#include <stdlib.h>
+#include <string.h>
- optind = OPTIND_MIN;
- opterr = 0;
+int
+main ()
+{
+ static char program[] = "program";
+ static char donald[] = "donald";
+ static char p[] = "-p";
+ static char billy[] = "billy";
+ static char duck[] = "duck";
+ static char a[] = "-a";
+ static char bar[] = "bar";
+ char *argv[] = { program, donald, p, billy, duck, a, bar, NULL };
+ int c;
- c = getopt (7, argv, "+abp:q:");
- if (!(c == -1))
- return 4;
- if (!(strcmp (argv[0], "program") == 0))
- return 5;
- if (!(strcmp (argv[1], "donald") == 0))
- return 6;
- if (!(strcmp (argv[2], "-p") == 0))
- return 7;
- if (!(strcmp (argv[3], "billy") == 0))
- return 8;
- if (!(strcmp (argv[4], "duck") == 0))
- return 9;
- if (!(strcmp (argv[5], "-a") == 0))
- return 10;
- if (!(strcmp (argv[6], "bar") == 0))
- return 11;
- if (!(optind == 1))
- return 12;
- }
- /* Detect MacOS 10.5, AIX 7.1 bug. */
- {
- static char program[] = "program";
- static char ab[] = "-ab";
- char *argv[3] = { program, ab, NULL };
- optind = OPTIND_MIN;
- opterr = 0;
- if (getopt (2, argv, "ab:") != 'a')
- return 13;
- if (getopt (2, argv, "ab:") != '?')
- return 14;
- if (optopt != 'b')
- return 15;
- if (optind != 2)
- return 16;
- }
+ c = getopt (7, argv, "+abp:q:");
+ if (!(c == -1))
+ return 4;
+ if (!(strcmp (argv[0], "program") == 0))
+ return 5;
+ if (!(strcmp (argv[1], "donald") == 0))
+ return 6;
+ if (!(strcmp (argv[2], "-p") == 0))
+ return 7;
+ if (!(strcmp (argv[3], "billy") == 0))
+ return 8;
+ if (!(strcmp (argv[4], "duck") == 0))
+ return 9;
+ if (!(strcmp (argv[5], "-a") == 0))
+ return 10;
+ if (!(strcmp (argv[6], "bar") == 0))
+ return 11;
+ if (!(optind == 1))
+ return 12;
+ return 0;
+}
+]])],
+ [gl_cv_func_getopt_posix=maybe],
+ [gl_cv_func_getopt_posix=no])
+ fi
+ if test $gl_cv_func_getopt_posix = maybe; then
+ dnl Detect Mac OS X 10.5, AIX 7.1, mingw bug.
+ AC_RUN_IFELSE(
+ [AC_LANG_SOURCE([[
+#include <unistd.h>
+#include <stdlib.h>
+#include <string.h>
+int
+main ()
+{
+ static char program[] = "program";
+ static char ab[] = "-ab";
+ char *argv[3] = { program, ab, NULL };
+ if (getopt (2, argv, "ab:") != 'a')
+ return 13;
+ if (getopt (2, argv, "ab:") != '?')
+ return 14;
+ if (optopt != 'b')
+ return 15;
+ if (optind != 2)
+ return 16;
return 0;
}
]])],
- [gl_cv_func_getopt_posix=yes], [gl_cv_func_getopt_posix=no],
- [case "$host_os" in
- mingw*) gl_cv_func_getopt_posix="guessing no";;
- darwin* | aix*) gl_cv_func_getopt_posix="guessing no";;
- *) gl_cv_func_getopt_posix="guessing yes";;
- esac
- ])
- CPPFLAGS=$gl_save_CPPFLAGS
+ [gl_cv_func_getopt_posix=yes],
+ [gl_cv_func_getopt_posix=no])
+ fi
+ else
+ case "$host_os" in
+ darwin* | aix* | mingw*) gl_cv_func_getopt_posix="guessing no";;
+ *) gl_cv_func_getopt_posix="guessing yes";;
+ esac
+ fi
])
case "$gl_cv_func_getopt_posix" in
*no) gl_replace_getopt=yes ;;
@@ -238,7 +227,7 @@ dnl is ambiguous with environment values that contain newlines.
nocrash_init();
/* This code succeeds on glibc 2.8, OpenBSD 4.0, Cygwin, mingw,
- and fails on MacOS X 10.5, AIX 5.2, HP-UX 11, IRIX 6.5,
+ and fails on Mac OS X 10.5, AIX 5.2, HP-UX 11, IRIX 6.5,
OSF/1 5.1, Solaris 10. */
{
static char conftest[] = "conftest";
@@ -249,7 +238,7 @@ dnl is ambiguous with environment values that contain newlines.
result |= 1;
}
/* This code succeeds on glibc 2.8, mingw,
- and fails on MacOS X 10.5, OpenBSD 4.0, AIX 5.2, HP-UX 11,
+ and fails on Mac OS X 10.5, OpenBSD 4.0, AIX 5.2, HP-UX 11,
IRIX 6.5, OSF/1 5.1, Solaris 10, Cygwin 1.5.x. */
{
static char program[] = "program";
@@ -278,7 +267,7 @@ dnl is ambiguous with environment values that contain newlines.
if (getopt (3, argv, "-p") != 1)
result |= 16;
else if (getopt (3, argv, "-p") != 'p')
- result |= 32;
+ result |= 16;
}
/* This code fails on glibc 2.11. */
{
@@ -288,9 +277,9 @@ dnl is ambiguous with environment values that contain newlines.
char *argv[] = { program, b, a, NULL };
optind = opterr = 0;
if (getopt (3, argv, "+:a:b") != 'b')
- result |= 64;
+ result |= 32;
else if (getopt (3, argv, "+:a:b") != ':')
- result |= 64;
+ result |= 32;
}
/* This code dumps core on glibc 2.14. */
{
@@ -300,18 +289,14 @@ dnl is ambiguous with environment values that contain newlines.
char *argv[] = { program, w, dummy, NULL };
optind = opterr = 1;
if (getopt (3, argv, "W;") != 'W')
- result |= 128;
+ result |= 64;
}
return result;
]])],
[gl_cv_func_getopt_gnu=yes],
[gl_cv_func_getopt_gnu=no],
- [dnl Cross compiling. Guess based on host and declarations.
- case $host_os:$ac_cv_have_decl_optreset in
- *-gnu*:* | mingw*:*) gl_cv_func_getopt_gnu=no;;
- *:yes) gl_cv_func_getopt_gnu=no;;
- *) gl_cv_func_getopt_gnu=yes;;
- esac
+ [dnl Cross compiling. Assume the worst, even on glibc platforms.
+ gl_cv_func_getopt_gnu="guessing no"
])
case $gl_had_POSIXLY_CORRECT in
exported) ;;
@@ -319,13 +304,54 @@ dnl is ambiguous with environment values that contain newlines.
*) AS_UNSET([POSIXLY_CORRECT]) ;;
esac
])
- if test "$gl_cv_func_getopt_gnu" = "no"; then
+ if test "$gl_cv_func_getopt_gnu" != yes; then
gl_replace_getopt=yes
+ else
+ AC_CACHE_CHECK([for working GNU getopt_long function],
+ [gl_cv_func_getopt_long_gnu],
+ [AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <getopt.h>
+ #include <stddef.h>
+ #include <string.h>
+ ]],
+ [[static const struct option long_options[] =
+ {
+ { "xtremely-",no_argument, NULL, 1003 },
+ { "xtra", no_argument, NULL, 1001 },
+ { "xtreme", no_argument, NULL, 1002 },
+ { "xtremely", no_argument, NULL, 1003 },
+ { NULL, 0, NULL, 0 }
+ };
+ /* This code fails on OpenBSD 5.0. */
+ {
+ static char program[] = "program";
+ static char xtremel[] = "--xtremel";
+ char *argv[] = { program, xtremel, NULL };
+ int option_index;
+ optind = 1; opterr = 0;
+ if (getopt_long (2, argv, "", long_options, &option_index) != 1003)
+ return 1;
+ }
+ return 0;
+ ]])],
+ [gl_cv_func_getopt_long_gnu=yes],
+ [gl_cv_func_getopt_long_gnu=no],
+ [dnl Cross compiling. Guess no on OpenBSD, yes otherwise.
+ case "$host_os" in
+ openbsd*) gl_cv_func_getopt_long_gnu="guessing no";;
+ *) gl_cv_func_getopt_long_gnu="guessing yes";;
+ esac
+ ])
+ ])
+ case "$gl_cv_func_getopt_long_gnu" in
+ *yes) ;;
+ *) gl_replace_getopt=yes ;;
+ esac
fi
fi
])
-# emacs' configure.in uses this.
AC_DEFUN([gl_GETOPT_SUBSTITUTE_HEADER],
[
GETOPT_H=getopt.h
@@ -336,7 +362,6 @@ AC_DEFUN([gl_GETOPT_SUBSTITUTE_HEADER],
])
# Prerequisites of lib/getopt*.
-# emacs' configure.in uses this.
AC_DEFUN([gl_PREREQ_GETOPT],
[
AC_CHECK_DECLS_ONCE([getenv])
diff --git a/m4/gettime.m4 b/m4/gettime.m4
new file mode 100644
index 00000000000..7d03d1253bf
--- /dev/null
+++ b/m4/gettime.m4
@@ -0,0 +1,13 @@
+# gettime.m4 serial 8
+dnl Copyright (C) 2002, 2004-2006, 2009-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_GETTIME],
+[
+ dnl Prerequisites of lib/gettime.c.
+ AC_REQUIRE([gl_CLOCK_TIME])
+ AC_REQUIRE([gl_TIMESPEC])
+ AC_CHECK_FUNCS_ONCE([gettimeofday nanotime])
+])
diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4
new file mode 100644
index 00000000000..eda97027a92
--- /dev/null
+++ b/m4/gettimeofday.m4
@@ -0,0 +1,140 @@
+# serial 20
+
+# Copyright (C) 2001-2003, 2005, 2007, 2009-2012 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl From Jim Meyering.
+
+AC_DEFUN([gl_FUNC_GETTIMEOFDAY],
+[
+ AC_REQUIRE([AC_C_RESTRICT])
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H])
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H_DEFAULTS])
+ AC_CHECK_FUNCS_ONCE([gettimeofday])
+
+ gl_gettimeofday_timezone=void
+ if test $ac_cv_func_gettimeofday != yes; then
+ HAVE_GETTIMEOFDAY=0
+ else
+ gl_FUNC_GETTIMEOFDAY_CLOBBER
+ AC_CACHE_CHECK([for gettimeofday with POSIX signature],
+ [gl_cv_func_gettimeofday_posix_signature],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <sys/time.h>
+ struct timeval c;
+ int gettimeofday (struct timeval *restrict, void *restrict);
+ ]],
+ [[/* glibc uses struct timezone * rather than the POSIX void *
+ if _GNU_SOURCE is defined. However, since the only portable
+ use of gettimeofday uses NULL as the second parameter, and
+ since the glibc definition is actually more typesafe, it is
+ not worth wrapping this to get a compliant signature. */
+ int (*f) (struct timeval *restrict, void *restrict)
+ = gettimeofday;
+ int x = f (&c, 0);
+ return !(x | c.tv_sec | c.tv_usec);
+ ]])],
+ [gl_cv_func_gettimeofday_posix_signature=yes],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <sys/time.h>
+int gettimeofday (struct timeval *restrict, struct timezone *restrict);
+ ]])],
+ [gl_cv_func_gettimeofday_posix_signature=almost],
+ [gl_cv_func_gettimeofday_posix_signature=no])])])
+ if test $gl_cv_func_gettimeofday_posix_signature = almost; then
+ gl_gettimeofday_timezone='struct timezone'
+ elif test $gl_cv_func_gettimeofday_posix_signature != yes; then
+ REPLACE_GETTIMEOFDAY=1
+ fi
+ dnl If we override 'struct timeval', we also have to override gettimeofday.
+ if test $REPLACE_STRUCT_TIMEVAL = 1; then
+ REPLACE_GETTIMEOFDAY=1
+ fi
+ m4_ifdef([gl_FUNC_TZSET_CLOBBER], [
+ gl_FUNC_TZSET_CLOBBER
+ case "$gl_cv_func_tzset_clobber" in
+ *yes)
+ REPLACE_GETTIMEOFDAY=1
+ gl_GETTIMEOFDAY_REPLACE_LOCALTIME
+ AC_DEFINE([tzset], [rpl_tzset],
+ [Define to rpl_tzset if the wrapper function should be used.])
+ AC_DEFINE([TZSET_CLOBBERS_LOCALTIME], [1],
+ [Define if tzset clobbers localtime's static buffer.])
+ ;;
+ esac
+ ])
+ fi
+ AC_DEFINE_UNQUOTED([GETTIMEOFDAY_TIMEZONE], [$gl_gettimeofday_timezone],
+ [Define this to 'void' or 'struct timezone' to match the system's
+ declaration of the second argument to gettimeofday.])
+])
+
+
+dnl See if gettimeofday clobbers the static buffer that localtime uses
+dnl for its return value. The gettimeofday function from Mac OS X 10.0.4
+dnl (i.e., Darwin 1.3.7) has this problem.
+dnl
+dnl If it does, then arrange to use gettimeofday and localtime only via
+dnl the wrapper functions that work around the problem.
+
+AC_DEFUN([gl_FUNC_GETTIMEOFDAY_CLOBBER],
+[
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+
+ AC_CACHE_CHECK([whether gettimeofday clobbers localtime buffer],
+ [gl_cv_func_gettimeofday_clobber],
+ [AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <string.h>
+ #include <sys/time.h>
+ #include <time.h>
+ #include <stdlib.h>
+ ]],
+ [[
+ time_t t = 0;
+ struct tm *lt;
+ struct tm saved_lt;
+ struct timeval tv;
+ lt = localtime (&t);
+ saved_lt = *lt;
+ gettimeofday (&tv, NULL);
+ return memcmp (lt, &saved_lt, sizeof (struct tm)) != 0;
+ ]])],
+ [gl_cv_func_gettimeofday_clobber=no],
+ [gl_cv_func_gettimeofday_clobber=yes],
+ [# When cross-compiling:
+ case "$host_os" in
+ # Guess all is fine on glibc systems.
+ *-gnu*) gl_cv_func_gettimeofday_clobber="guessing no" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_gettimeofday_clobber="guessing yes" ;;
+ esac
+ ])])
+
+ case "$gl_cv_func_gettimeofday_clobber" in
+ *yes)
+ REPLACE_GETTIMEOFDAY=1
+ gl_GETTIMEOFDAY_REPLACE_LOCALTIME
+ AC_DEFINE([GETTIMEOFDAY_CLOBBERS_LOCALTIME], [1],
+ [Define if gettimeofday clobbers the localtime buffer.])
+ ;;
+ esac
+])
+
+AC_DEFUN([gl_GETTIMEOFDAY_REPLACE_LOCALTIME], [
+ AC_DEFINE([gmtime], [rpl_gmtime],
+ [Define to rpl_gmtime if the replacement function should be used.])
+ AC_DEFINE([localtime], [rpl_localtime],
+ [Define to rpl_localtime if the replacement function should be used.])
+])
+
+# Prerequisites of lib/gettimeofday.c.
+AC_DEFUN([gl_PREREQ_GETTIMEOFDAY], [
+ AC_CHECK_HEADERS([sys/timeb.h])
+ AC_CHECK_FUNCS([_ftime])
+])
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 7d832999591..15d2b2b3dea 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,5 +1,5 @@
-# gnulib-common.m4 serial 31
-dnl Copyright (C) 2007-2011 Free Software Foundation, Inc.
+# gnulib-common.m4 serial 33
+dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -13,12 +13,13 @@ AC_DEFUN([gl_COMMON], [
])
AC_DEFUN([gl_COMMON_BODY], [
AH_VERBATIM([_Noreturn],
-[/* The _Noreturn keyword of draft C1X. */
-#ifndef _Noreturn
+[/* The _Noreturn keyword of C11. */
+#if ! (defined _Noreturn \
+ || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__))
# if (3 <= __GNUC__ || (__GNUC__ == 2 && 8 <= __GNUC_MINOR__) \
|| 0x5110 <= __SUNPRO_C)
# define _Noreturn __attribute__ ((__noreturn__))
-# elif 1200 <= _MSC_VER
+# elif defined _MSC_VER && 1200 <= _MSC_VER
# define _Noreturn __declspec (noreturn)
# else
# define _Noreturn
@@ -29,7 +30,7 @@ AC_DEFUN([gl_COMMON_BODY], [
[/* Work around a bug in Apple GCC 4.0.1 build 5465: In C99 mode, it supports
the ISO C 99 semantics of 'extern inline' (unlike the GNU C semantics of
earlier versions), but does not display it by setting __GNUC_STDC_INLINE__.
- __APPLE__ && __MACH__ test for MacOS X.
+ __APPLE__ && __MACH__ test for Mac OS X.
__APPLE_CC__ tests for the Apple compiler and its version.
__STDC_VERSION__ tests for the C99 mode. */
#if defined __APPLE__ && defined __MACH__ && __APPLE_CC__ >= 5465 && !defined __cplusplus && __STDC_VERSION__ >= 199901L && !defined __GNUC_STDC_INLINE__
@@ -224,7 +225,7 @@ m4_ifndef([AS_VAR_IF],
# - When AC_PROG_CC_STDC is invoked twice, it adds the C99 enabling options
# to CC twice
# <http://lists.gnu.org/archive/html/bug-gnulib/2011-09/msg00431.html>.
-# - AC_PROG_CC_STDC is likely to change when C1X is an ISO standard.
+# - AC_PROG_CC_STDC is likely to change now that C11 is an ISO standard.
AC_DEFUN([gl_PROG_CC_C99],
[
dnl Change that version number to the minimum Autoconf version that supports
diff --git a/m4/gl-comp.m4 b/m4/gnulib-comp.m4
index 03cedf70af8..30f81b4781f 100644
--- a/m4/gl-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -1,5 +1,5 @@
# DO NOT EDIT! GENERATED AUTOMATICALLY!
-# Copyright (C) 2002-2011 Free Software Foundation, Inc.
+# Copyright (C) 2002-2012 Free Software Foundation, Inc.
#
# This file is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -28,7 +28,7 @@
# other built files.
-# This macro should be invoked from ./configure.in, in the section
+# This macro should be invoked from ./configure.ac, in the section
# "Checks for programs", right after AC_PROG_CC, and certainly before
# any checks for libraries, header files, types and library functions.
AC_DEFUN([gl_EARLY],
@@ -40,21 +40,37 @@ AC_DEFUN([gl_EARLY],
AC_REQUIRE([gl_PROG_AR_RANLIB])
# Code from module alloca-opt:
# Code from module allocator:
+ # Code from module c-ctype:
+ # Code from module c-strcase:
# Code from module careadlinkat:
+ # Code from module clock-time:
+ # Code from module close-stream:
# Code from module crypto/md5:
# Code from module crypto/sha1:
# Code from module crypto/sha256:
# Code from module crypto/sha512:
# Code from module dosname:
# Code from module dtoastr:
+ # Code from module dtotimespec:
# Code from module dup2:
+ # Code from module environ:
+ # Code from module euidaccess:
+ # Code from module execinfo:
# Code from module extensions:
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+ # Code from module extern-inline:
+ # Code from module faccessat:
+ # Code from module fcntl-h:
# Code from module filemode:
+ # Code from module fpending:
+ # Code from module getgroups:
# Code from module getloadavg:
# Code from module getopt-gnu:
# Code from module getopt-posix:
# Code from module gettext-h:
+ # Code from module gettime:
+ # Code from module gettimeofday:
+ # Code from module group-member:
# Code from module ignore-value:
# Code from module include_next:
# Code from module intprops:
@@ -62,13 +78,16 @@ AC_DEFUN([gl_EARLY],
# Code from module largefile:
AC_REQUIRE([AC_SYS_LARGEFILE])
# Code from module lstat:
+ # Code from module manywarnings:
# Code from module mktime:
# Code from module multiarch:
# Code from module nocrash:
+ # Code from module pathmax:
+ # Code from module pselect:
# Code from module pthread_sigmask:
# Code from module readlink:
+ # Code from module root-uid:
# Code from module signal-h:
- # Code from module sigprocmask:
# Code from module snippet/_Noreturn:
# Code from module snippet/arg-nonnull:
# Code from module snippet/c++defs:
@@ -76,6 +95,8 @@ AC_DEFUN([gl_EARLY],
# Code from module socklen:
# Code from module ssize_t:
# Code from module stat:
+ # Code from module stat-time:
+ # Code from module stdalign:
# Code from module stdarg:
dnl Some compilers (e.g., AIX 5.3 cc) need to be in c99 mode
dnl for the builtin va_copy to work. With Autoconf 2.60 or later,
@@ -93,15 +114,24 @@ AC_DEFUN([gl_EARLY],
# Code from module strtoull:
# Code from module strtoumax:
# Code from module symlink:
+ # Code from module sys_select:
# Code from module sys_stat:
+ # Code from module sys_time:
# Code from module time:
# Code from module time_r:
+ # Code from module timer-time:
+ # Code from module timespec:
+ # Code from module timespec-add:
+ # Code from module timespec-sub:
# Code from module u64:
# Code from module unistd:
+ # Code from module utimens:
# Code from module verify:
+ # Code from module warnings:
+ # Code from module xalloc-oversized:
])
-# This macro should be invoked from ./configure.in, in the section
+# This macro should be invoked from ./configure.ac, in the section
# "Check for header files, types and library functions".
AC_DEFUN([gl_INIT],
[
@@ -117,151 +147,255 @@ AC_DEFUN([gl_INIT],
m4_pushdef([gl_LIBSOURCES_DIR], [])
gl_COMMON
gl_source_base='lib'
-gl_FUNC_ALLOCA
-AC_CHECK_FUNCS_ONCE([readlinkat])
-gl_MD5
-gl_SHA1
-gl_SHA256
-gl_SHA512
-AC_REQUIRE([gl_C99_STRTOLD])
-gl_FUNC_DUP2
-if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
- AC_LIBOBJ([dup2])
- gl_PREREQ_DUP2
-fi
-gl_UNISTD_MODULE_INDICATOR([dup2])
-gl_FILEMODE
-gl_GETLOADAVG
-if test $HAVE_GETLOADAVG = 0; then
- AC_LIBOBJ([getloadavg])
- gl_PREREQ_GETLOADAVG
-fi
-gl_STDLIB_MODULE_INDICATOR([getloadavg])
-gl_FUNC_GETOPT_GNU
-if test $REPLACE_GETOPT = 1; then
- AC_LIBOBJ([getopt])
- AC_LIBOBJ([getopt1])
- gl_PREREQ_GETOPT
-fi
-gl_MODULE_INDICATOR_FOR_TESTS([getopt-gnu])
-gl_FUNC_GETOPT_POSIX
-if test $REPLACE_GETOPT = 1; then
- AC_LIBOBJ([getopt])
- AC_LIBOBJ([getopt1])
- gl_PREREQ_GETOPT
-fi
-AC_REQUIRE([AC_C_INLINE])
-gl_INTTYPES_INCOMPLETE
-gl_FUNC_LSTAT
-if test $REPLACE_LSTAT = 1; then
- AC_LIBOBJ([lstat])
- gl_PREREQ_LSTAT
-fi
-gl_SYS_STAT_MODULE_INDICATOR([lstat])
-gl_FUNC_MKTIME
-if test $REPLACE_MKTIME = 1; then
- AC_LIBOBJ([mktime])
- gl_PREREQ_MKTIME
-fi
-gl_TIME_MODULE_INDICATOR([mktime])
-gl_MULTIARCH
-gl_FUNC_PTHREAD_SIGMASK
-if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
- AC_LIBOBJ([pthread_sigmask])
- gl_PREREQ_PTHREAD_SIGMASK
-fi
-gl_SIGNAL_MODULE_INDICATOR([pthread_sigmask])
-gl_FUNC_READLINK
-if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
- AC_LIBOBJ([readlink])
- gl_PREREQ_READLINK
-fi
-gl_UNISTD_MODULE_INDICATOR([readlink])
-gl_SIGNAL_H
-gl_TYPE_SOCKLEN_T
-gt_TYPE_SSIZE_T
-gl_STDARG_H
-AM_STDBOOL_H
-gl_STDDEF_H
-gl_STDINT_H
-gl_STDIO_H
-gl_STDLIB_H
-gl_FUNC_GNU_STRFTIME
-gl_FUNC_STRTOIMAX
-if test $ac_cv_func_strtoimax = no; then
- AC_LIBOBJ([strtoimax])
- gl_PREREQ_STRTOIMAX
-fi
-gl_INTTYPES_MODULE_INDICATOR([strtoimax])
-gl_FUNC_STRTOUMAX
-if test $ac_cv_func_strtoumax = no; then
- AC_LIBOBJ([strtoumax])
- gl_PREREQ_STRTOUMAX
-fi
-gl_INTTYPES_MODULE_INDICATOR([strtoumax])
-gl_FUNC_SYMLINK
-if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
- AC_LIBOBJ([symlink])
-fi
-gl_UNISTD_MODULE_INDICATOR([symlink])
-gl_HEADER_SYS_STAT_H
-AC_PROG_MKDIR_P
-gl_HEADER_TIME_H
-gl_TIME_R
-if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
- AC_LIBOBJ([time_r])
- gl_PREREQ_TIME_R
-fi
-gl_TIME_MODULE_INDICATOR([time_r])
-AC_REQUIRE([AC_C_INLINE])
-gl_UNISTD_H
+ gl_FUNC_ALLOCA
+ AC_CHECK_FUNCS_ONCE([readlinkat])
+ gl_CLOCK_TIME
+ gl_CLOSE_STREAM
+ gl_MODULE_INDICATOR([close-stream])
+ gl_MD5
+ gl_SHA1
+ gl_SHA256
+ gl_SHA512
+ AC_REQUIRE([gl_C99_STRTOLD])
+ gl_FUNC_DUP2
+ if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
+ AC_LIBOBJ([dup2])
+ gl_PREREQ_DUP2
+ fi
+ gl_UNISTD_MODULE_INDICATOR([dup2])
+ gl_ENVIRON
+ gl_UNISTD_MODULE_INDICATOR([environ])
+ gl_EXECINFO_H
+ AC_REQUIRE([gl_EXTERN_INLINE])
+ gl_FUNC_FACCESSAT
+ if test $HAVE_FACCESSAT = 0; then
+ AC_LIBOBJ([faccessat])
+ gl_PREREQ_FACCESSAT
+ fi
+ gl_MODULE_INDICATOR([faccessat])
+ gl_UNISTD_MODULE_INDICATOR([faccessat])
+ gl_FCNTL_H
+ gl_FILEMODE
+ gl_FUNC_FPENDING
+ if test $ac_cv_func___fpending = no; then
+ AC_LIBOBJ([fpending])
+ gl_PREREQ_FPENDING
+ fi
+ gl_GETLOADAVG
+ if test $HAVE_GETLOADAVG = 0; then
+ AC_LIBOBJ([getloadavg])
+ gl_PREREQ_GETLOADAVG
+ fi
+ gl_STDLIB_MODULE_INDICATOR([getloadavg])
+ gl_FUNC_GETOPT_GNU
+ if test $REPLACE_GETOPT = 1; then
+ AC_LIBOBJ([getopt])
+ AC_LIBOBJ([getopt1])
+ gl_PREREQ_GETOPT
+ dnl Arrange for unistd.h to include getopt.h.
+ GNULIB_GL_UNISTD_H_GETOPT=1
+ fi
+ AC_SUBST([GNULIB_GL_UNISTD_H_GETOPT])
+ gl_MODULE_INDICATOR_FOR_TESTS([getopt-gnu])
+ gl_FUNC_GETOPT_POSIX
+ if test $REPLACE_GETOPT = 1; then
+ AC_LIBOBJ([getopt])
+ AC_LIBOBJ([getopt1])
+ gl_PREREQ_GETOPT
+ dnl Arrange for unistd.h to include getopt.h.
+ GNULIB_GL_UNISTD_H_GETOPT=1
+ fi
+ AC_SUBST([GNULIB_GL_UNISTD_H_GETOPT])
+ gl_GETTIME
+ gl_FUNC_GETTIMEOFDAY
+ if test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1; then
+ AC_LIBOBJ([gettimeofday])
+ gl_PREREQ_GETTIMEOFDAY
+ fi
+ gl_SYS_TIME_MODULE_INDICATOR([gettimeofday])
+ gl_INTTYPES_INCOMPLETE
+ AC_REQUIRE([gl_LARGEFILE])
+ gl_FUNC_LSTAT
+ if test $REPLACE_LSTAT = 1; then
+ AC_LIBOBJ([lstat])
+ gl_PREREQ_LSTAT
+ fi
+ gl_SYS_STAT_MODULE_INDICATOR([lstat])
+ gl_FUNC_MKTIME
+ if test $REPLACE_MKTIME = 1; then
+ AC_LIBOBJ([mktime])
+ gl_PREREQ_MKTIME
+ fi
+ gl_TIME_MODULE_INDICATOR([mktime])
+ gl_MULTIARCH
+ gl_FUNC_PSELECT
+ if test $HAVE_PSELECT = 0 || test $REPLACE_PSELECT = 1; then
+ AC_LIBOBJ([pselect])
+ fi
+ gl_SYS_SELECT_MODULE_INDICATOR([pselect])
+ gl_FUNC_PTHREAD_SIGMASK
+ if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
+ AC_LIBOBJ([pthread_sigmask])
+ gl_PREREQ_PTHREAD_SIGMASK
+ fi
+ gl_SIGNAL_MODULE_INDICATOR([pthread_sigmask])
+ gl_FUNC_READLINK
+ if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
+ AC_LIBOBJ([readlink])
+ gl_PREREQ_READLINK
+ fi
+ gl_UNISTD_MODULE_INDICATOR([readlink])
+ gl_SIGNAL_H
+ gl_TYPE_SOCKLEN_T
+ gt_TYPE_SSIZE_T
+ gl_STAT_TIME
+ gl_STAT_BIRTHTIME
+ gl_STDALIGN_H
+ gl_STDARG_H
+ AM_STDBOOL_H
+ gl_STDDEF_H
+ gl_STDINT_H
+ gl_STDIO_H
+ gl_STDLIB_H
+ gl_FUNC_GNU_STRFTIME
+ gl_FUNC_STRTOIMAX
+ if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
+ AC_LIBOBJ([strtoimax])
+ gl_PREREQ_STRTOIMAX
+ fi
+ gl_INTTYPES_MODULE_INDICATOR([strtoimax])
+ gl_FUNC_STRTOUMAX
+ if test $ac_cv_func_strtoumax = no; then
+ AC_LIBOBJ([strtoumax])
+ gl_PREREQ_STRTOUMAX
+ fi
+ gl_INTTYPES_MODULE_INDICATOR([strtoumax])
+ gl_FUNC_SYMLINK
+ if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
+ AC_LIBOBJ([symlink])
+ fi
+ gl_UNISTD_MODULE_INDICATOR([symlink])
+ gl_HEADER_SYS_SELECT
+ AC_PROG_MKDIR_P
+ gl_HEADER_SYS_STAT_H
+ AC_PROG_MKDIR_P
+ gl_HEADER_SYS_TIME_H
+ AC_PROG_MKDIR_P
+ gl_HEADER_TIME_H
+ gl_TIME_R
+ if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
+ AC_LIBOBJ([time_r])
+ gl_PREREQ_TIME_R
+ fi
+ gl_TIME_MODULE_INDICATOR([time_r])
+ gl_TIMER_TIME
+ gl_TIMESPEC
+ gl_UNISTD_H
+ gl_UTIMENS
gl_gnulib_enabled_dosname=false
+ gl_gnulib_enabled_euidaccess=false
+ gl_gnulib_enabled_getgroups=false
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false
- gl_gnulib_enabled_sigprocmask=false
+ gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false
+ gl_gnulib_enabled_pathmax=false
+ gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false
gl_gnulib_enabled_stat=false
gl_gnulib_enabled_strtoll=false
gl_gnulib_enabled_strtoull=false
gl_gnulib_enabled_verify=false
+ gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false
func_gl_gnulib_m4code_dosname ()
{
if ! $gl_gnulib_enabled_dosname; then
gl_gnulib_enabled_dosname=true
fi
}
+ func_gl_gnulib_m4code_euidaccess ()
+ {
+ if ! $gl_gnulib_enabled_euidaccess; then
+ gl_FUNC_EUIDACCESS
+ if test $HAVE_EUIDACCESS = 0; then
+ AC_LIBOBJ([euidaccess])
+ gl_PREREQ_EUIDACCESS
+ fi
+ gl_UNISTD_MODULE_INDICATOR([euidaccess])
+ gl_gnulib_enabled_euidaccess=true
+ if test $HAVE_EUIDACCESS = 0; then
+ func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1
+ fi
+ func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c
+ if test $HAVE_EUIDACCESS = 0; then
+ func_gl_gnulib_m4code_stat
+ fi
+ fi
+ }
+ func_gl_gnulib_m4code_getgroups ()
+ {
+ if ! $gl_gnulib_enabled_getgroups; then
+ gl_FUNC_GETGROUPS
+ if test $HAVE_GETGROUPS = 0 || test $REPLACE_GETGROUPS = 1; then
+ AC_LIBOBJ([getgroups])
+ fi
+ gl_UNISTD_MODULE_INDICATOR([getgroups])
+ gl_gnulib_enabled_getgroups=true
+ fi
+ }
func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 ()
{
if ! $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then
-AC_SUBST([LIBINTL])
-AC_SUBST([LTLIBINTL])
+ AC_SUBST([LIBINTL])
+ AC_SUBST([LTLIBINTL])
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true
fi
}
- func_gl_gnulib_m4code_sigprocmask ()
+ func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1 ()
+ {
+ if ! $gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1; then
+ gl_FUNC_GROUP_MEMBER
+ if test $HAVE_GROUP_MEMBER = 0; then
+ AC_LIBOBJ([group-member])
+ gl_PREREQ_GROUP_MEMBER
+ fi
+ gl_UNISTD_MODULE_INDICATOR([group-member])
+ gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=true
+ if test $HAVE_GROUP_MEMBER = 0; then
+ func_gl_gnulib_m4code_getgroups
+ fi
+ if test $HAVE_GROUP_MEMBER = 0; then
+ func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec
+ fi
+ fi
+ }
+ func_gl_gnulib_m4code_pathmax ()
{
- if ! $gl_gnulib_enabled_sigprocmask; then
-gl_SIGNALBLOCKING
-if test $HAVE_POSIX_SIGNALBLOCKING = 0; then
- AC_LIBOBJ([sigprocmask])
- gl_PREREQ_SIGPROCMASK
-fi
-gl_SIGNAL_MODULE_INDICATOR([sigprocmask])
- gl_gnulib_enabled_sigprocmask=true
+ if ! $gl_gnulib_enabled_pathmax; then
+ gl_PATHMAX
+ gl_gnulib_enabled_pathmax=true
+ fi
+ }
+ func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c ()
+ {
+ if ! $gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c; then
+ gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=true
fi
}
func_gl_gnulib_m4code_stat ()
{
if ! $gl_gnulib_enabled_stat; then
-gl_FUNC_STAT
-if test $REPLACE_STAT = 1; then
- AC_LIBOBJ([stat])
- gl_PREREQ_STAT
-fi
-gl_SYS_STAT_MODULE_INDICATOR([stat])
+ gl_FUNC_STAT
+ if test $REPLACE_STAT = 1; then
+ AC_LIBOBJ([stat])
+ gl_PREREQ_STAT
+ fi
+ gl_SYS_STAT_MODULE_INDICATOR([stat])
gl_gnulib_enabled_stat=true
if test $REPLACE_STAT = 1; then
func_gl_gnulib_m4code_dosname
fi
if test $REPLACE_STAT = 1; then
+ func_gl_gnulib_m4code_pathmax
+ fi
+ if test $REPLACE_STAT = 1; then
func_gl_gnulib_m4code_verify
fi
fi
@@ -269,24 +403,24 @@ gl_SYS_STAT_MODULE_INDICATOR([stat])
func_gl_gnulib_m4code_strtoll ()
{
if ! $gl_gnulib_enabled_strtoll; then
-gl_FUNC_STRTOLL
-if test $HAVE_STRTOLL = 0; then
- AC_LIBOBJ([strtoll])
- gl_PREREQ_STRTOLL
-fi
-gl_STDLIB_MODULE_INDICATOR([strtoll])
+ gl_FUNC_STRTOLL
+ if test $HAVE_STRTOLL = 0; then
+ AC_LIBOBJ([strtoll])
+ gl_PREREQ_STRTOLL
+ fi
+ gl_STDLIB_MODULE_INDICATOR([strtoll])
gl_gnulib_enabled_strtoll=true
fi
}
func_gl_gnulib_m4code_strtoull ()
{
if ! $gl_gnulib_enabled_strtoull; then
-gl_FUNC_STRTOULL
-if test $HAVE_STRTOULL = 0; then
- AC_LIBOBJ([strtoull])
- gl_PREREQ_STRTOULL
-fi
-gl_STDLIB_MODULE_INDICATOR([strtoull])
+ gl_FUNC_STRTOULL
+ if test $HAVE_STRTOULL = 0; then
+ AC_LIBOBJ([strtoull])
+ gl_PREREQ_STRTOULL
+ fi
+ gl_STDLIB_MODULE_INDICATOR([strtoull])
gl_gnulib_enabled_strtoull=true
fi
}
@@ -296,6 +430,18 @@ gl_STDLIB_MODULE_INDICATOR([strtoull])
gl_gnulib_enabled_verify=true
fi
}
+ func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec ()
+ {
+ if ! $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then
+ gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=true
+ fi
+ }
+ if test $HAVE_FACCESSAT = 0; then
+ func_gl_gnulib_m4code_dosname
+ fi
+ if test $HAVE_FACCESSAT = 0; then
+ func_gl_gnulib_m4code_euidaccess
+ fi
if test $REPLACE_GETOPT = 1; then
func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36
fi
@@ -305,32 +451,34 @@ gl_STDLIB_MODULE_INDICATOR([strtoull])
if test $REPLACE_LSTAT = 1; then
func_gl_gnulib_m4code_stat
fi
- if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
- func_gl_gnulib_m4code_sigprocmask
- fi
if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
func_gl_gnulib_m4code_stat
fi
- if test $ac_cv_func_strtoimax = no; then
- func_gl_gnulib_m4code_verify
- fi
- if test $ac_cv_func_strtoimax = no && test $ac_cv_type_long_long_int = yes; then
+ if { test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then
func_gl_gnulib_m4code_strtoll
fi
- if test $ac_cv_func_strtoumax = no; then
+ if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
func_gl_gnulib_m4code_verify
fi
if test $ac_cv_func_strtoumax = no && test $ac_cv_type_unsigned_long_long_int = yes; then
func_gl_gnulib_m4code_strtoull
fi
+ if test $ac_cv_func_strtoumax = no; then
+ func_gl_gnulib_m4code_verify
+ fi
m4_pattern_allow([^gl_GNULIB_ENABLED_])
AM_CONDITIONAL([gl_GNULIB_ENABLED_dosname], [$gl_gnulib_enabled_dosname])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_euidaccess], [$gl_gnulib_enabled_euidaccess])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_getgroups], [$gl_gnulib_enabled_getgroups])
AM_CONDITIONAL([gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36], [$gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36])
- AM_CONDITIONAL([gl_GNULIB_ENABLED_sigprocmask], [$gl_gnulib_enabled_sigprocmask])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1], [$gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_pathmax], [$gl_gnulib_enabled_pathmax])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c], [$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c])
AM_CONDITIONAL([gl_GNULIB_ENABLED_stat], [$gl_gnulib_enabled_stat])
AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll])
AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoull], [$gl_gnulib_enabled_strtoull])
AM_CONDITIONAL([gl_GNULIB_ENABLED_verify], [$gl_gnulib_enabled_verify])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec], [$gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec])
# End of code from modules
m4_ifval(gl_LIBSOURCES_LIST, [
m4_syscmd([test ! -d ]m4_defn([gl_LIBSOURCES_DIR])[ ||
@@ -479,21 +627,41 @@ AC_DEFUN([gl_FILE_LIST], [
lib/alloca.in.h
lib/allocator.c
lib/allocator.h
+ lib/at-func.c
+ lib/c-ctype.c
+ lib/c-ctype.h
+ lib/c-strcase.h
+ lib/c-strcasecmp.c
+ lib/c-strncasecmp.c
lib/careadlinkat.c
lib/careadlinkat.h
+ lib/close-stream.c
+ lib/close-stream.h
lib/dosname.h
lib/dtoastr.c
+ lib/dtotimespec.c
lib/dup2.c
+ lib/euidaccess.c
+ lib/execinfo.c
+ lib/execinfo.in.h
+ lib/faccessat.c
+ lib/fcntl.in.h
lib/filemode.c
lib/filemode.h
+ lib/fpending.c
+ lib/fpending.h
lib/ftoastr.c
lib/ftoastr.h
+ lib/getgroups.c
lib/getloadavg.c
lib/getopt.c
lib/getopt.in.h
lib/getopt1.c
lib/getopt_int.h
lib/gettext.h
+ lib/gettime.c
+ lib/gettimeofday.c
+ lib/group-member.c
lib/ignore-value.h
lib/intprops.h
lib/inttypes.in.h
@@ -502,8 +670,11 @@ AC_DEFUN([gl_FILE_LIST], [
lib/md5.h
lib/mktime-internal.h
lib/mktime.c
+ lib/pathmax.h
+ lib/pselect.c
lib/pthread_sigmask.c
lib/readlink.c
+ lib/root-uid.h
lib/sha1.c
lib/sha1.h
lib/sha256.c
@@ -511,8 +682,10 @@ AC_DEFUN([gl_FILE_LIST], [
lib/sha512.c
lib/sha512.h
lib/signal.in.h
- lib/sigprocmask.c
+ lib/stat-time.c
+ lib/stat-time.h
lib/stat.c
+ lib/stdalign.in.h
lib/stdarg.in.h
lib/stdbool.in.h
lib/stddef.in.h
@@ -528,41 +701,70 @@ AC_DEFUN([gl_FILE_LIST], [
lib/strtoull.c
lib/strtoumax.c
lib/symlink.c
+ lib/sys_select.in.h
lib/sys_stat.in.h
+ lib/sys_time.in.h
lib/time.in.h
lib/time_r.c
+ lib/timespec-add.c
+ lib/timespec-sub.c
+ lib/timespec.c
+ lib/timespec.h
+ lib/u64.c
lib/u64.h
lib/unistd.in.h
+ lib/utimens.c
+ lib/utimens.h
lib/verify.h
+ lib/xalloc-oversized.h
m4/00gnulib.m4
m4/alloca.m4
m4/c-strtod.m4
+ m4/clock_time.m4
+ m4/close-stream.m4
m4/dup2.m4
+ m4/environ.m4
+ m4/euidaccess.m4
+ m4/execinfo.m4
m4/extensions.m4
+ m4/extern-inline.m4
+ m4/faccessat.m4
+ m4/fcntl-o.m4
+ m4/fcntl_h.m4
m4/filemode.m4
+ m4/fpending.m4
+ m4/getgroups.m4
m4/getloadavg.m4
m4/getopt.m4
+ m4/gettime.m4
+ m4/gettimeofday.m4
m4/gnulib-common.m4
+ m4/group-member.m4
m4/include_next.m4
m4/inttypes.m4
m4/largefile.m4
m4/longlong.m4
m4/lstat.m4
+ m4/manywarnings.m4
m4/md5.m4
m4/mktime.m4
m4/multiarch.m4
m4/nocrash.m4
+ m4/off_t.m4
+ m4/pathmax.m4
+ m4/pselect.m4
m4/pthread_sigmask.m4
m4/readlink.m4
m4/sha1.m4
m4/sha256.m4
m4/sha512.m4
m4/signal_h.m4
- m4/signalblocking.m4
m4/socklen.m4
m4/ssize_t.m4
m4/st_dm_mode.m4
+ m4/stat-time.m4
m4/stat.m4
+ m4/stdalign.m4
m4/stdarg.m4
m4/stdbool.m4
m4/stddef_h.m4
@@ -575,11 +777,20 @@ AC_DEFUN([gl_FILE_LIST], [
m4/strtoull.m4
m4/strtoumax.m4
m4/symlink.m4
+ m4/sys_select_h.m4
+ m4/sys_socket_h.m4
m4/sys_stat_h.m4
+ m4/sys_time_h.m4
m4/time_h.m4
m4/time_r.m4
+ m4/timer_time.m4
+ m4/timespec.m4
m4/tm_gmtoff.m4
m4/unistd_h.m4
+ m4/utimbuf.m4
+ m4/utimens.m4
+ m4/utimes.m4
m4/warn-on-use.m4
+ m4/warnings.m4
m4/wchar_t.m4
])
diff --git a/m4/gnulib-tool.m4 b/m4/gnulib-tool.m4
index ed41e9d4159..a09ffc1d1a0 100644
--- a/m4/gnulib-tool.m4
+++ b/m4/gnulib-tool.m4
@@ -1,5 +1,5 @@
# gnulib-tool.m4 serial 2
-dnl Copyright (C) 2004-2005, 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2004-2005, 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/group-member.m4 b/m4/group-member.m4
new file mode 100644
index 00000000000..c393b5b1303
--- /dev/null
+++ b/m4/group-member.m4
@@ -0,0 +1,29 @@
+# serial 14
+
+# Copyright (C) 1999-2001, 2003-2007, 2009-2012 Free Software Foundation, Inc.
+
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl Written by Jim Meyering
+
+AC_DEFUN([gl_FUNC_GROUP_MEMBER],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+
+ dnl Persuade glibc <unistd.h> to declare group_member().
+ AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+
+ dnl Do this replacement check manually because I want the hyphen
+ dnl (not the underscore) in the filename.
+ AC_CHECK_FUNC([group_member], , [
+ HAVE_GROUP_MEMBER=0
+ ])
+])
+
+# Prerequisites of lib/group-member.c.
+AC_DEFUN([gl_PREREQ_GROUP_MEMBER],
+[
+ AC_REQUIRE([AC_FUNC_GETGROUPS])
+])
diff --git a/m4/include_next.m4 b/m4/include_next.m4
index d5230ced8de..a60a2614dc8 100644
--- a/m4/include_next.m4
+++ b/m4/include_next.m4
@@ -1,5 +1,5 @@
-# include_next.m4 serial 22
-dnl Copyright (C) 2006-2011 Free Software Foundation, Inc.
+# include_next.m4 serial 23
+dnl Copyright (C) 2006-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -143,7 +143,7 @@ choke me
# even if the compiler does not support include_next.
# The three "///" are to pacify Sun C 5.8, which otherwise would say
# "warning: #include of /usr/include/... may be non-portable".
-# Use `""', not `<>', so that the /// cannot be confused with a C99 comment.
+# Use '""', not '<>', so that the /// cannot be confused with a C99 comment.
# Note: This macro assumes that the header file is not empty after
# preprocessing, i.e. it does not only define preprocessor macros but also
# provides some type/enum definitions or function/variable declarations.
@@ -219,12 +219,17 @@ changequote(,)
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ dnl A sed expression that turns a string into a basic regular
+ dnl expression, for use within "/.../".
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
changequote([,])
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"']m4_defn([gl_HEADER_NAME])[|{
- s|.*"\(.*'"${gl_dirsep_regex}"']m4_defn([gl_HEADER_NAME])[\)".*|\1|
+ gl_header_literal_regex=`echo ']m4_defn([gl_HEADER_NAME])[' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
changequote(,)dnl
s|^/[^/]|//&|
changequote([,])dnl
diff --git a/m4/inttypes.m4 b/m4/inttypes.m4
index cc027a417fa..eec4f41d032 100644
--- a/m4/inttypes.m4
+++ b/m4/inttypes.m4
@@ -1,5 +1,5 @@
-# inttypes.m4 serial 24
-dnl Copyright (C) 2006-2011 Free Software Foundation, Inc.
+# inttypes.m4 serial 26
+dnl Copyright (C) 2006-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -24,22 +24,6 @@ AC_DEFUN_ONCE([gl_INTTYPES_INCOMPLETE],
AC_REQUIRE([gl_MULTIARCH])
- dnl Ensure that <stdint.h> defines the limit macros, since gnulib's
- dnl <inttypes.h> relies on them. This macro is only needed when a
- dnl C++ compiler is in use; it has no effect for a C compiler.
- dnl Also be careful to define __STDC_LIMIT_MACROS only when gnulib's
- dnl <inttypes.h> is going to be created, and to avoid redefinition warnings
- dnl if the __STDC_LIMIT_MACROS is already defined through the CPPFLAGS.
- AC_DEFINE([GL_TRIGGER_STDC_LIMIT_MACROS], [1],
- [Define to make the limit macros in <stdint.h> visible.])
- AH_VERBATIM([__STDC_LIMIT_MACROS_ZZZ],
-[/* Ensure that <stdint.h> defines the limit macros, since gnulib's
- <inttypes.h> relies on them. */
-#if defined __cplusplus && !defined __STDC_LIMIT_MACROS && GL_TRIGGER_STDC_LIMIT_MACROS
-# define __STDC_LIMIT_MACROS 1
-#endif
-])
-
dnl Check for declarations of anything we want to poison if the
dnl corresponding gnulib module is not in use.
gl_WARN_ON_USE_PREPARE([[#include <inttypes.h>
@@ -163,6 +147,7 @@ AC_DEFUN([gl_INTTYPES_H_DEFAULTS],
HAVE_DECL_IMAXDIV=1; AC_SUBST([HAVE_DECL_IMAXDIV])
HAVE_DECL_STRTOIMAX=1; AC_SUBST([HAVE_DECL_STRTOIMAX])
HAVE_DECL_STRTOUMAX=1; AC_SUBST([HAVE_DECL_STRTOUMAX])
+ REPLACE_STRTOIMAX=0; AC_SUBST([REPLACE_STRTOIMAX])
INT32_MAX_LT_INTMAX_MAX=1; AC_SUBST([INT32_MAX_LT_INTMAX_MAX])
INT64_MAX_EQ_LONG_MAX='defined _LP64'; AC_SUBST([INT64_MAX_EQ_LONG_MAX])
PRI_MACROS_BROKEN=0; AC_SUBST([PRI_MACROS_BROKEN])
diff --git a/m4/largefile.m4 b/m4/largefile.m4
index d83fea1233d..a88850afedc 100644
--- a/m4/largefile.m4
+++ b/m4/largefile.m4
@@ -1,6 +1,6 @@
# Enable large files on systems where this is not the default.
-# Copyright 1992-1996, 1998-2011 Free Software Foundation, Inc.
+# Copyright 1992-1996, 1998-2012 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
@@ -102,3 +102,48 @@ fi
])# AC_SYS_LARGEFILE
])# m4_version_prereq 2.69
+
+# Enable large files on systems where this is implemented by Gnulib, not by the
+# system headers.
+# Set the variables WINDOWS_64_BIT_OFF_T, WINDOWS_64_BIT_ST_SIZE if Gnulib
+# overrides ensure that off_t or 'struct size.st_size' are 64-bit, respectively.
+AC_DEFUN([gl_LARGEFILE],
+[
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ case "$host_os" in
+ mingw*)
+ dnl Native Windows.
+ dnl mingw64 defines off_t to a 64-bit type already, if
+ dnl _FILE_OFFSET_BITS=64, which is ensured by AC_SYS_LARGEFILE.
+ AC_CACHE_CHECK([for 64-bit off_t], [gl_cv_type_off_t_64],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <sys/types.h>
+ int verify_off_t_size[sizeof (off_t) >= 8 ? 1 : -1];
+ ]],
+ [[]])],
+ [gl_cv_type_off_t_64=yes], [gl_cv_type_off_t_64=no])
+ ])
+ if test $gl_cv_type_off_t_64 = no; then
+ WINDOWS_64_BIT_OFF_T=1
+ else
+ WINDOWS_64_BIT_OFF_T=0
+ fi
+ dnl But all native Windows platforms (including mingw64) have a 32-bit
+ dnl st_size member in 'struct stat'.
+ WINDOWS_64_BIT_ST_SIZE=1
+ ;;
+ *)
+ dnl Nothing to do on gnulib's side.
+ dnl A 64-bit off_t is
+ dnl - already the default on Mac OS X, FreeBSD, NetBSD, OpenBSD, IRIX,
+ dnl OSF/1, Cygwin,
+ dnl - enabled by _FILE_OFFSET_BITS=64 (ensured by AC_SYS_LARGEFILE) on
+ dnl glibc, HP-UX, Solaris,
+ dnl - enabled by _LARGE_FILES=1 (ensured by AC_SYS_LARGEFILE) on AIX,
+ dnl - impossible to achieve on Minix 3.1.8.
+ WINDOWS_64_BIT_OFF_T=0
+ WINDOWS_64_BIT_ST_SIZE=0
+ ;;
+ esac
+])
diff --git a/m4/longlong.m4 b/m4/longlong.m4
index aed816cfa5e..b9c65c756ee 100644
--- a/m4/longlong.m4
+++ b/m4/longlong.m4
@@ -1,5 +1,5 @@
-# longlong.m4 serial 16
-dnl Copyright (C) 1999-2007, 2009-2011 Free Software Foundation, Inc.
+# longlong.m4 serial 17
+dnl Copyright (C) 1999-2007, 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -51,7 +51,7 @@ AC_DEFUN([AC_TYPE_LONG_LONG_INT],
fi])
if test $ac_cv_type_long_long_int = yes; then
AC_DEFINE([HAVE_LONG_LONG_INT], [1],
- [Define to 1 if the system has the type `long long int'.])
+ [Define to 1 if the system has the type 'long long int'.])
fi
])
@@ -77,7 +77,7 @@ AC_DEFUN([AC_TYPE_UNSIGNED_LONG_LONG_INT],
fi])
if test $ac_cv_type_unsigned_long_long_int = yes; then
AC_DEFINE([HAVE_UNSIGNED_LONG_LONG_INT], [1],
- [Define to 1 if the system has the type `unsigned long long int'.])
+ [Define to 1 if the system has the type 'unsigned long long int'.])
fi
])
diff --git a/m4/lstat.m4 b/m4/lstat.m4
index fe161d40101..b7335bda1b2 100644
--- a/m4/lstat.m4
+++ b/m4/lstat.m4
@@ -1,6 +1,6 @@
-# serial 23
+# serial 25
-# Copyright (C) 1997-2001, 2003-2011 Free Software Foundation, Inc.
+# Copyright (C) 1997-2001, 2003-2012 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -16,9 +16,11 @@ AC_DEFUN([gl_FUNC_LSTAT],
AC_CHECK_FUNCS_ONCE([lstat])
if test $ac_cv_func_lstat = yes; then
AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK])
- if test $gl_cv_func_lstat_dereferences_slashed_symlink = no; then
- REPLACE_LSTAT=1
- fi
+ case "$gl_cv_func_lstat_dereferences_slashed_symlink" in
+ *no)
+ REPLACE_LSTAT=1
+ ;;
+ esac
else
HAVE_LSTAT=0
fi
@@ -51,20 +53,25 @@ AC_DEFUN([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK],
]])],
[gl_cv_func_lstat_dereferences_slashed_symlink=yes],
[gl_cv_func_lstat_dereferences_slashed_symlink=no],
- [# When cross-compiling, be pessimistic so we will end up using the
- # replacement version of lstat that checks for trailing slashes and
- # calls lstat a second time when necessary.
- gl_cv_func_lstat_dereferences_slashed_symlink=no
+ [case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_lstat_dereferences_slashed_symlink="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_lstat_dereferences_slashed_symlink="guessing no" ;;
+ esac
])
else
# If the 'ln -s' command failed, then we probably don't even
# have an lstat function.
- gl_cv_func_lstat_dereferences_slashed_symlink=no
+ gl_cv_func_lstat_dereferences_slashed_symlink="guessing no"
fi
rm -f conftest.sym conftest.file
])
- test $gl_cv_func_lstat_dereferences_slashed_symlink = yes &&
- AC_DEFINE_UNQUOTED([LSTAT_FOLLOWS_SLASHED_SYMLINK], [1],
- [Define to 1 if `lstat' dereferences a symlink specified
- with a trailing slash.])
+ case "$gl_cv_func_lstat_dereferences_slashed_symlink" in
+ *yes)
+ AC_DEFINE_UNQUOTED([LSTAT_FOLLOWS_SLASHED_SYMLINK], [1],
+ [Define to 1 if 'lstat' dereferences a symlink specified
+ with a trailing slash.])
+ ;;
+ esac
])
diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4
new file mode 100644
index 00000000000..f3cb23be1cd
--- /dev/null
+++ b/m4/manywarnings.m4
@@ -0,0 +1,224 @@
+# manywarnings.m4 serial 5
+dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Simon Josefsson
+
+# gl_MANYWARN_COMPLEMENT(OUTVAR, LISTVAR, REMOVEVAR)
+# --------------------------------------------------
+# Copy LISTVAR to OUTVAR except for the entries in REMOVEVAR.
+# Elements separated by whitespace. In set logic terms, the function
+# does OUTVAR = LISTVAR \ REMOVEVAR.
+AC_DEFUN([gl_MANYWARN_COMPLEMENT],
+[
+ gl_warn_set=
+ set x $2; shift
+ for gl_warn_item
+ do
+ case " $3 " in
+ *" $gl_warn_item "*)
+ ;;
+ *)
+ gl_warn_set="$gl_warn_set $gl_warn_item"
+ ;;
+ esac
+ done
+ $1=$gl_warn_set
+])
+
+# gl_MANYWARN_ALL_GCC(VARIABLE)
+# -----------------------------
+# Add all documented GCC warning parameters to variable VARIABLE.
+# Note that you need to test them using gl_WARN_ADD if you want to
+# make sure your gcc understands it.
+AC_DEFUN([gl_MANYWARN_ALL_GCC],
+[
+ dnl First, check for some issues that only occur when combining multiple
+ dnl gcc warning categories.
+ AC_REQUIRE([AC_PROG_CC])
+ if test -n "$GCC"; then
+
+ dnl Check if -W -Werror -Wno-missing-field-initializers is supported
+ dnl with the current $CC $CFLAGS $CPPFLAGS.
+ AC_MSG_CHECKING([whether -Wno-missing-field-initializers is supported])
+ AC_CACHE_VAL([gl_cv_cc_nomfi_supported], [
+ gl_save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -W -Werror -Wno-missing-field-initializers"
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[]], [[]])],
+ [gl_cv_cc_nomfi_supported=yes],
+ [gl_cv_cc_nomfi_supported=no])
+ CFLAGS="$gl_save_CFLAGS"])
+ AC_MSG_RESULT([$gl_cv_cc_nomfi_supported])
+
+ if test "$gl_cv_cc_nomfi_supported" = yes; then
+ dnl Now check whether -Wno-missing-field-initializers is needed
+ dnl for the { 0, } construct.
+ AC_MSG_CHECKING([whether -Wno-missing-field-initializers is needed])
+ AC_CACHE_VAL([gl_cv_cc_nomfi_needed], [
+ gl_save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -W -Werror"
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[void f (void)
+ {
+ typedef struct { int a; int b; } s_t;
+ s_t s1 = { 0, };
+ }
+ ]],
+ [[]])],
+ [gl_cv_cc_nomfi_needed=no],
+ [gl_cv_cc_nomfi_needed=yes])
+ CFLAGS="$gl_save_CFLAGS"
+ ])
+ AC_MSG_RESULT([$gl_cv_cc_nomfi_needed])
+ fi
+
+ dnl Next, check if -Werror -Wuninitialized is useful with the
+ dnl user's choice of $CFLAGS; some versions of gcc warn that it
+ dnl has no effect if -O is not also used
+ AC_MSG_CHECKING([whether -Wuninitialized is supported])
+ AC_CACHE_VAL([gl_cv_cc_uninitialized_supported], [
+ gl_save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -Werror -Wuninitialized"
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[]], [[]])],
+ [gl_cv_cc_uninitialized_supported=yes],
+ [gl_cv_cc_uninitialized_supported=no])
+ CFLAGS="$gl_save_CFLAGS"])
+ AC_MSG_RESULT([$gl_cv_cc_uninitialized_supported])
+
+ fi
+
+ # List all gcc warning categories.
+ gl_manywarn_set=
+ for gl_manywarn_item in \
+ -W \
+ -Wabi \
+ -Waddress \
+ -Wall \
+ -Warray-bounds \
+ -Wattributes \
+ -Wbad-function-cast \
+ -Wbuiltin-macro-redefined \
+ -Wcast-align \
+ -Wchar-subscripts \
+ -Wclobbered \
+ -Wcomment \
+ -Wcomments \
+ -Wcoverage-mismatch \
+ -Wcpp \
+ -Wdeprecated \
+ -Wdeprecated-declarations \
+ -Wdisabled-optimization \
+ -Wdiv-by-zero \
+ -Wdouble-promotion \
+ -Wempty-body \
+ -Wendif-labels \
+ -Wenum-compare \
+ -Wextra \
+ -Wformat-contains-nul \
+ -Wformat-extra-args \
+ -Wformat-nonliteral \
+ -Wformat-security \
+ -Wformat-y2k \
+ -Wformat-zero-length \
+ -Wformat=2 \
+ -Wfree-nonheap-object \
+ -Wignored-qualifiers \
+ -Wimplicit \
+ -Wimplicit-function-declaration \
+ -Wimplicit-int \
+ -Winit-self \
+ -Winline \
+ -Wint-to-pointer-cast \
+ -Winvalid-memory-model \
+ -Winvalid-pch \
+ -Wjump-misses-init \
+ -Wlogical-op \
+ -Wmain \
+ -Wmaybe-uninitialized \
+ -Wmissing-braces \
+ -Wmissing-declarations \
+ -Wmissing-field-initializers \
+ -Wmissing-format-attribute \
+ -Wmissing-include-dirs \
+ -Wmissing-noreturn \
+ -Wmissing-parameter-type \
+ -Wmissing-prototypes \
+ -Wmudflap \
+ -Wmultichar \
+ -Wnarrowing \
+ -Wnested-externs \
+ -Wnonnull \
+ -Wnormalized=nfc \
+ -Wold-style-declaration \
+ -Wold-style-definition \
+ -Woverflow \
+ -Woverlength-strings \
+ -Woverride-init \
+ -Wpacked \
+ -Wpacked-bitfield-compat \
+ -Wparentheses \
+ -Wpointer-arith \
+ -Wpointer-sign \
+ -Wpointer-to-int-cast \
+ -Wpragmas \
+ -Wreturn-type \
+ -Wsequence-point \
+ -Wshadow \
+ -Wsizeof-pointer-memaccess \
+ -Wstack-protector \
+ -Wstrict-aliasing \
+ -Wstrict-overflow \
+ -Wstrict-prototypes \
+ -Wsuggest-attribute=const \
+ -Wsuggest-attribute=format \
+ -Wsuggest-attribute=noreturn \
+ -Wsuggest-attribute=pure \
+ -Wswitch \
+ -Wswitch-default \
+ -Wsync-nand \
+ -Wsystem-headers \
+ -Wtrampolines \
+ -Wtrigraphs \
+ -Wtype-limits \
+ -Wuninitialized \
+ -Wunknown-pragmas \
+ -Wunreachable-code \
+ -Wunsafe-loop-optimizations \
+ -Wunused \
+ -Wunused-but-set-parameter \
+ -Wunused-but-set-variable \
+ -Wunused-function \
+ -Wunused-label \
+ -Wunused-local-typedefs \
+ -Wunused-macros \
+ -Wunused-parameter \
+ -Wunused-result \
+ -Wunused-value \
+ -Wunused-variable \
+ -Wvarargs \
+ -Wvariadic-macros \
+ -Wvector-operation-performance \
+ -Wvla \
+ -Wvolatile-register-var \
+ -Wwrite-strings \
+ \
+ ; do
+ gl_manywarn_set="$gl_manywarn_set $gl_manywarn_item"
+ done
+
+ # Disable specific options as needed.
+ if test "$gl_cv_cc_nomfi_needed" = yes; then
+ gl_manywarn_set="$gl_manywarn_set -Wno-missing-field-initializers"
+ fi
+
+ if test "$gl_cv_cc_uninitialized_supported" = no; then
+ gl_manywarn_set="$gl_manywarn_set -Wno-uninitialized"
+ fi
+
+ $1=$gl_manywarn_set
+])
diff --git a/m4/md5.m4 b/m4/md5.m4
index 4b41a85b354..e22f7bdb17a 100644
--- a/m4/md5.m4
+++ b/m4/md5.m4
@@ -1,5 +1,5 @@
# md5.m4 serial 12
-dnl Copyright (C) 2002-2006, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2008-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/mktime.m4 b/m4/mktime.m4
index 8ed6d5d2a30..f509bc4da07 100644
--- a/m4/mktime.m4
+++ b/m4/mktime.m4
@@ -1,5 +1,5 @@
-# serial 21
-dnl Copyright (C) 2002-2003, 2005-2007, 2009-2011 Free Software Foundation,
+# serial 24
+dnl Copyright (C) 2002-2003, 2005-2007, 2009-2012 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -17,7 +17,7 @@ AC_DEFUN([gl_FUNC_MKTIME],
AC_CHECK_FUNCS_ONCE([alarm])
AC_REQUIRE([gl_MULTIARCH])
if test $APPLE_UNIVERSAL_BUILD = 1; then
- # A universal build on Apple MacOS X platforms.
+ # A universal build on Apple Mac OS X platforms.
# The test result would be 'yes' in 32-bit mode and 'no' in 64-bit mode.
# But we need a configuration result that is valid in both modes.
gl_cv_func_working_mktime=no
@@ -192,20 +192,23 @@ main ()
if (tz_strings[i])
putenv (tz_strings[i]);
- for (t = 0; t <= time_t_max - delta; t += delta)
+ for (t = 0; t <= time_t_max - delta && (result & 1) == 0; t += delta)
if (! mktime_test (t))
result |= 1;
- if (! (mktime_test ((time_t) 1)
- && mktime_test ((time_t) (60 * 60))
- && mktime_test ((time_t) (60 * 60 * 24))))
+ if ((result & 2) == 0
+ && ! (mktime_test ((time_t) 1)
+ && mktime_test ((time_t) (60 * 60))
+ && mktime_test ((time_t) (60 * 60 * 24))))
result |= 2;
- for (j = 1; ; j <<= 1)
- if (! bigtime_test (j))
- result |= 4;
- else if (INT_MAX / 2 < j)
- break;
- if (! bigtime_test (INT_MAX))
+ for (j = 1; (result & 4) == 0; j <<= 1)
+ {
+ if (! bigtime_test (j))
+ result |= 4;
+ if (INT_MAX / 2 < j)
+ break;
+ }
+ if ((result & 8) == 0 && ! bigtime_test (INT_MAX))
result |= 8;
}
if (! irix_6_4_bug ())
@@ -244,7 +247,4 @@ AC_DEFUN([gl_FUNC_MKTIME_INTERNAL], [
])
# Prerequisites of lib/mktime.c.
-AC_DEFUN([gl_PREREQ_MKTIME],
-[
- AC_REQUIRE([AC_C_INLINE])
-])
+AC_DEFUN([gl_PREREQ_MKTIME], [:])
diff --git a/m4/multiarch.m4 b/m4/multiarch.m4
index 691d89270b6..0c288b8d2a9 100644
--- a/m4/multiarch.m4
+++ b/m4/multiarch.m4
@@ -1,12 +1,12 @@
-# multiarch.m4 serial 6
-dnl Copyright (C) 2008-2011 Free Software Foundation, Inc.
+# multiarch.m4 serial 7
+dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
# Determine whether the compiler is or may be producing universal binaries.
#
-# On MacOS X 10.5 and later systems, the user can create libraries and
+# On Mac OS X 10.5 and later systems, the user can create libraries and
# executables that work on multiple system types--known as "fat" or
# "universal" binaries--by specifying multiple '-arch' options to the
# compiler but only a single '-arch' option to the preprocessor. Like
diff --git a/m4/nocrash.m4 b/m4/nocrash.m4
index 60aad952956..c2638df626c 100644
--- a/m4/nocrash.m4
+++ b/m4/nocrash.m4
@@ -1,5 +1,5 @@
-# nocrash.m4 serial 3
-dnl Copyright (C) 2005, 2009-2011 Free Software Foundation, Inc.
+# nocrash.m4 serial 4
+dnl Copyright (C) 2005, 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -18,7 +18,7 @@ dnl int main() { nocrash_init(); ... }
AC_DEFUN([GL_NOCRASH],[[
#include <stdlib.h>
#if defined __MACH__ && defined __APPLE__
-/* Avoid a crash on MacOS X. */
+/* Avoid a crash on Mac OS X. */
#include <mach/mach.h>
#include <mach/mach_error.h>
#include <mach/thread_status.h>
diff --git a/m4/off_t.m4 b/m4/off_t.m4
new file mode 100644
index 00000000000..dfca2dfd233
--- /dev/null
+++ b/m4/off_t.m4
@@ -0,0 +1,18 @@
+# off_t.m4 serial 1
+dnl Copyright (C) 2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl Check whether to override the 'off_t' type.
+dnl Set WINDOWS_64_BIT_OFF_T.
+
+AC_DEFUN([gl_TYPE_OFF_T],
+[
+ m4_ifdef([gl_LARGEFILE], [
+ AC_REQUIRE([gl_LARGEFILE])
+ ], [
+ WINDOWS_64_BIT_OFF_T=0
+ ])
+ AC_SUBST([WINDOWS_64_BIT_OFF_T])
+])
diff --git a/m4/pathmax.m4 b/m4/pathmax.m4
new file mode 100644
index 00000000000..011786129e0
--- /dev/null
+++ b/m4/pathmax.m4
@@ -0,0 +1,42 @@
+# pathmax.m4 serial 10
+dnl Copyright (C) 2002-2003, 2005-2006, 2009-2012 Free Software Foundation,
+dnl Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_PATHMAX],
+[
+ dnl Prerequisites of lib/pathmax.h.
+ AC_CHECK_HEADERS_ONCE([sys/param.h])
+])
+
+# Expands to a piece of C program that defines PATH_MAX in the same way as
+# "pathmax.h" will do.
+AC_DEFUN([gl_PATHMAX_SNIPPET], [[
+/* Arrange to define PATH_MAX, like "pathmax.h" does. */
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+#include <limits.h>
+#if defined HAVE_SYS_PARAM_H && !defined PATH_MAX && !defined MAXPATHLEN
+# include <sys/param.h>
+#endif
+#if !defined PATH_MAX && defined MAXPATHLEN
+# define PATH_MAX MAXPATHLEN
+#endif
+#ifdef __hpux
+# undef PATH_MAX
+# define PATH_MAX 1024
+#endif
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+# undef PATH_MAX
+# define PATH_MAX 260
+#endif
+]])
+
+# Prerequisites of gl_PATHMAX_SNIPPET.
+AC_DEFUN([gl_PATHMAX_SNIPPET_PREREQ],
+[
+ AC_CHECK_HEADERS_ONCE([unistd.h sys/param.h])
+])
diff --git a/m4/pselect.m4 b/m4/pselect.m4
new file mode 100644
index 00000000000..5edacd28f85
--- /dev/null
+++ b/m4/pselect.m4
@@ -0,0 +1,69 @@
+# pselect.m4 serial 2
+dnl Copyright (C) 2011-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_PSELECT],
+[
+ AC_REQUIRE([gl_HEADER_SYS_SELECT])
+ AC_REQUIRE([AC_C_RESTRICT])
+ AC_CHECK_FUNCS_ONCE([pselect])
+
+ if test $ac_cv_func_pselect = yes; then
+ AC_CACHE_CHECK([whether signature of pselect conforms to POSIX],
+ gl_cv_sig_pselect,
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <sys/select.h>
+ ]],
+ [[int (*p) (int, fd_set *, fd_set *, fd_set *restrict,
+ struct timespec const *restrict,
+ sigset_t const *restrict) = pselect;
+ return !p;]])],
+ [gl_cv_sig_pselect=yes],
+ [gl_cv_sig_pselect=no])])
+
+ dnl On FreeBSD 8.2, pselect() doesn't always reject bad fds.
+ AC_CACHE_CHECK([whether pselect detects invalid fds],
+ [gl_cv_func_pselect_detects_ebadf],
+ [
+ AC_RUN_IFELSE([AC_LANG_PROGRAM([[
+#include <sys/types.h>
+#include <sys/time.h>
+#if HAVE_SYS_SELECT_H
+# include <sys/select.h>
+#endif
+#include <unistd.h>
+#include <errno.h>
+]],[[
+ fd_set set;
+ dup2(0, 16);
+ FD_ZERO(&set);
+ FD_SET(16, &set);
+ close(16);
+ struct timespec timeout;
+ timeout.tv_sec = 0;
+ timeout.tv_nsec = 5000;
+ return pselect (17, &set, NULL, NULL, &timeout, NULL) != -1 || errno != EBADF;
+]])], [gl_cv_func_pselect_detects_ebadf=yes],
+ [gl_cv_func_pselect_detects_ebadf=no],
+ [
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_pselect_detects_ebadf="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_pselect_detects_ebadf="guessing no" ;;
+ esac
+ ])
+ ])
+ case $gl_cv_func_pselect_detects_ebadf in
+ *yes) ;;
+ *) REPLACE_PSELECT=1 ;;
+ esac
+ fi
+
+ if test $ac_cv_func_pselect = no || test $gl_cv_sig_pselect = no; then
+ REPLACE_PSELECT=1
+ fi
+])
diff --git a/m4/pthread_sigmask.m4 b/m4/pthread_sigmask.m4
index f06bc119ff3..884edbdb5bb 100644
--- a/m4/pthread_sigmask.m4
+++ b/m4/pthread_sigmask.m4
@@ -1,11 +1,13 @@
-# pthread_sigmask.m4 serial 12
-dnl Copyright (C) 2011 Free Software Foundation, Inc.
+# pthread_sigmask.m4 serial 13
+dnl Copyright (C) 2011-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK],
[
+ AC_REQUIRE([gl_SIGNAL_H_DEFAULTS])
+
AC_CHECK_FUNCS_ONCE([pthread_sigmask])
LIB_PTHREAD_SIGMASK=
diff --git a/m4/readlink.m4 b/m4/readlink.m4
index 91d7df3c91c..ccf5141d40b 100644
--- a/m4/readlink.m4
+++ b/m4/readlink.m4
@@ -1,5 +1,5 @@
-# readlink.m4 serial 11
-dnl Copyright (C) 2003, 2007, 2009-2011 Free Software Foundation, Inc.
+# readlink.m4 serial 12
+dnl Copyright (C) 2003, 2007, 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -7,6 +7,7 @@ dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_FUNC_READLINK],
[
AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CHECK_FUNCS_ONCE([readlink])
if test $ac_cv_func_readlink = no; then
HAVE_READLINK=0
@@ -32,15 +33,26 @@ AC_DEFUN([gl_FUNC_READLINK],
]], [[char buf[20];
return readlink ("conftest.lnk2/", buf, sizeof buf) != -1;]])],
[gl_cv_func_readlink_works=yes], [gl_cv_func_readlink_works=no],
- [gl_cv_func_readlink_works="guessing no"])
+ [case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_readlink_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_readlink_works="guessing no" ;;
+ esac
+ ])
rm -f conftest.link conftest.lnk2])
- if test "$gl_cv_func_readlink_works" != yes; then
- AC_DEFINE([READLINK_TRAILING_SLASH_BUG], [1], [Define to 1 if readlink
- fails to recognize a trailing slash.])
- REPLACE_READLINK=1
- elif test "$gl_cv_decl_readlink_works" != yes; then
- REPLACE_READLINK=1
- fi
+ case "$gl_cv_func_readlink_works" in
+ *yes)
+ if test "$gl_cv_decl_readlink_works" != yes; then
+ REPLACE_READLINK=1
+ fi
+ ;;
+ *)
+ AC_DEFINE([READLINK_TRAILING_SLASH_BUG], [1], [Define to 1 if readlink
+ fails to recognize a trailing slash.])
+ REPLACE_READLINK=1
+ ;;
+ esac
fi
])
diff --git a/m4/sha1.m4 b/m4/sha1.m4
index b8f5c1dcafe..76198258b92 100644
--- a/m4/sha1.m4
+++ b/m4/sha1.m4
@@ -1,5 +1,5 @@
# sha1.m4 serial 10
-dnl Copyright (C) 2002-2006, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2008-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/sha256.m4 b/m4/sha256.m4
index a3429ed3423..78cc95ed8b6 100644
--- a/m4/sha256.m4
+++ b/m4/sha256.m4
@@ -1,5 +1,5 @@
# sha256.m4 serial 5
-dnl Copyright (C) 2005, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 2008-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/sha512.m4 b/m4/sha512.m4
index cd6a0bf302a..937ea8d5e9d 100644
--- a/m4/sha512.m4
+++ b/m4/sha512.m4
@@ -1,5 +1,5 @@
# sha512.m4 serial 6
-dnl Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2005-2006, 2008-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/signal_h.m4 b/m4/signal_h.m4
index 5cf54a062fc..ed4d7306eee 100644
--- a/m4/signal_h.m4
+++ b/m4/signal_h.m4
@@ -1,5 +1,5 @@
# signal_h.m4 serial 18
-dnl Copyright (C) 2007-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/signalblocking.m4 b/m4/signalblocking.m4
deleted file mode 100644
index eda856d04f9..00000000000
--- a/m4/signalblocking.m4
+++ /dev/null
@@ -1,27 +0,0 @@
-# signalblocking.m4 serial 13
-dnl Copyright (C) 2001-2002, 2006-2011 Free Software Foundation, Inc.
-dnl This file is free software; the Free Software Foundation
-dnl gives unlimited permission to copy and/or distribute it,
-dnl with or without modifications, as long as this notice is preserved.
-
-# Determine available signal blocking primitives. Three different APIs exist:
-# 1) POSIX: sigemptyset, sigaddset, sigprocmask
-# 2) SYSV: sighold, sigrelse
-# 3) BSD: sigblock, sigsetmask
-# For simplicity, here we check only for the POSIX signal blocking.
-AC_DEFUN([gl_SIGNALBLOCKING],
-[
- AC_REQUIRE([gl_SIGNAL_H_DEFAULTS])
- AC_REQUIRE([gl_CHECK_TYPE_SIGSET_T])
- if test $gl_cv_type_sigset_t = yes; then
- AC_CHECK_FUNC([sigprocmask], [gl_cv_func_sigprocmask=1])
- fi
- if test -z "$gl_cv_func_sigprocmask"; then
- HAVE_POSIX_SIGNALBLOCKING=0
- fi
-])
-
-# Prerequisites of lib/sigprocmask.c.
-AC_DEFUN([gl_PREREQ_SIGPROCMASK], [
- AC_REQUIRE([AC_C_INLINE])
-])
diff --git a/m4/socklen.m4 b/m4/socklen.m4
index 44751544485..a4ab43b3333 100644
--- a/m4/socklen.m4
+++ b/m4/socklen.m4
@@ -1,5 +1,5 @@
# socklen.m4 serial 10
-dnl Copyright (C) 2005-2007, 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2005-2007, 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/ssize_t.m4 b/m4/ssize_t.m4
index d7127521ebe..209d64c8235 100644
--- a/m4/ssize_t.m4
+++ b/m4/ssize_t.m4
@@ -1,5 +1,5 @@
# ssize_t.m4 serial 5 (gettext-0.18.2)
-dnl Copyright (C) 2001-2003, 2006, 2010-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2003, 2006, 2010-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/st_dm_mode.m4 b/m4/st_dm_mode.m4
index 84f74638f12..b87cec00bee 100644
--- a/m4/st_dm_mode.m4
+++ b/m4/st_dm_mode.m4
@@ -1,6 +1,6 @@
# serial 6
-# Copyright (C) 1998-1999, 2001, 2009-2011 Free Software Foundation, Inc.
+# Copyright (C) 1998-1999, 2001, 2009-2012 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/stat-time.m4 b/m4/stat-time.m4
new file mode 100644
index 00000000000..9371d7bb960
--- /dev/null
+++ b/m4/stat-time.m4
@@ -0,0 +1,83 @@
+# Checks for stat-related time functions.
+
+# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2012 Free Software
+# Foundation, Inc.
+
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl From Paul Eggert.
+
+# st_atim.tv_nsec - Linux, Solaris, Cygwin
+# st_atimespec.tv_nsec - FreeBSD, NetBSD, if ! defined _POSIX_SOURCE
+# st_atimensec - FreeBSD, NetBSD, if defined _POSIX_SOURCE
+# st_atim.st__tim.tv_nsec - UnixWare (at least 2.1.2 through 7.1)
+
+# st_birthtimespec - FreeBSD, NetBSD (hidden on OpenBSD 3.9, anyway)
+# st_birthtim - Cygwin 1.7.0+
+
+AC_DEFUN([gl_STAT_TIME],
+[
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+ AC_CHECK_HEADERS_ONCE([sys/time.h])
+
+ AC_CHECK_MEMBERS([struct stat.st_atim.tv_nsec],
+ [AC_CACHE_CHECK([whether struct stat.st_atim is of type struct timespec],
+ [ac_cv_typeof_struct_stat_st_atim_is_struct_timespec],
+ [AC_COMPILE_IFELSE([AC_LANG_PROGRAM(
+ [[
+ #include <sys/types.h>
+ #include <sys/stat.h>
+ #if HAVE_SYS_TIME_H
+ # include <sys/time.h>
+ #endif
+ #include <time.h>
+ struct timespec ts;
+ struct stat st;
+ ]],
+ [[
+ st.st_atim = ts;
+ ]])],
+ [ac_cv_typeof_struct_stat_st_atim_is_struct_timespec=yes],
+ [ac_cv_typeof_struct_stat_st_atim_is_struct_timespec=no])])
+ if test $ac_cv_typeof_struct_stat_st_atim_is_struct_timespec = yes; then
+ AC_DEFINE([TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC], [1],
+ [Define to 1 if the type of the st_atim member of a struct stat is
+ struct timespec.])
+ fi],
+ [AC_CHECK_MEMBERS([struct stat.st_atimespec.tv_nsec], [],
+ [AC_CHECK_MEMBERS([struct stat.st_atimensec], [],
+ [AC_CHECK_MEMBERS([struct stat.st_atim.st__tim.tv_nsec], [], [],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])
+])
+
+# Check for st_birthtime, a feature from UFS2 (FreeBSD, NetBSD, OpenBSD, etc.)
+# and NTFS (Cygwin).
+# There was a time when this field was named st_createtime (21 June
+# 2002 to 16 July 2002) But that window is very small and applied only
+# to development code, so systems still using that configuration are
+# not supported. See revisions 1.10 and 1.11 of FreeBSD's
+# src/sys/ufs/ufs/dinode.h.
+#
+AC_DEFUN([gl_STAT_BIRTHTIME],
+[
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+ AC_CHECK_HEADERS_ONCE([sys/time.h])
+ AC_CHECK_MEMBERS([struct stat.st_birthtimespec.tv_nsec], [],
+ [AC_CHECK_MEMBERS([struct stat.st_birthtimensec], [],
+ [AC_CHECK_MEMBERS([struct stat.st_birthtim.tv_nsec], [], [],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])
+])
diff --git a/m4/stat.m4 b/m4/stat.m4
index c63f59fd533..a8b79f5bcba 100644
--- a/m4/stat.m4
+++ b/m4/stat.m4
@@ -1,6 +1,6 @@
-# serial 8
+# serial 10
-# Copyright (C) 2009-2011 Free Software Foundation, Inc.
+# Copyright (C) 2009-2012 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -23,8 +23,9 @@ AC_DEFUN([gl_FUNC_STAT],
mingw*) gl_cv_func_stat_dir_slash="guessing no";;
*) gl_cv_func_stat_dir_slash="guessing yes";;
esac])])
- dnl AIX 7.1, Solaris 9 mistakenly succeed on stat("file/")
- dnl FreeBSD 7.2 mistakenly succeeds on stat("link-to-file/")
+ dnl AIX 7.1, Solaris 9, mingw64 mistakenly succeed on stat("file/").
+ dnl (For mingw, this is due to a broken stat() override in libmingwex.a.)
+ dnl FreeBSD 7.2 mistakenly succeeds on stat("link-to-file/").
AC_CACHE_CHECK([whether stat handles trailing slashes on files],
[gl_cv_func_stat_file_slash],
[touch conftest.tmp
@@ -46,7 +47,13 @@ AC_DEFUN([gl_FUNC_STAT],
return result;
]])],
[gl_cv_func_stat_file_slash=yes], [gl_cv_func_stat_file_slash=no],
- [gl_cv_func_stat_file_slash="guessing no"])
+ [case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_stat_file_slash="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_stat_file_slash="guessing no" ;;
+ esac
+ ])
rm -f conftest.tmp conftest.lnk])
case $gl_cv_func_stat_dir_slash in
*no) REPLACE_STAT=1
diff --git a/m4/stdalign.m4 b/m4/stdalign.m4
new file mode 100644
index 00000000000..6659c9c3ecd
--- /dev/null
+++ b/m4/stdalign.m4
@@ -0,0 +1,51 @@
+# Check for stdalign.h that conforms to C11.
+
+dnl Copyright 2011-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+# Prepare for substituting <stdalign.h> if it is not supported.
+
+AC_DEFUN([gl_STDALIGN_H],
+[
+ AC_CACHE_CHECK([for working stdalign.h],
+ [gl_cv_header_working_stdalign_h],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <stdalign.h>
+ #include <stddef.h>
+
+ /* Test that alignof yields a result consistent with offsetof.
+ This catches GCC bug 52023
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. */
+ #ifdef __cplusplus
+ template <class t> struct alignof_helper { char a; t b; };
+ # define ao(type) offsetof (alignof_helper<type>, b)
+ #else
+ # define ao(type) offsetof (struct { char a; type b; }, b)
+ #endif
+ char test_double[ao (double) % _Alignof (double) == 0 ? 1 : -1];
+ char test_long[ao (long int) % _Alignof (long int) == 0 ? 1 : -1];
+ char test_alignof[alignof (double) == _Alignof (double) ? 1 : -1];
+
+ /* Test _Alignas only on platforms where gnulib can help. */
+ #if \
+ (__GNUC__ || __IBMC__ || __IBMCPP__ \
+ || 0x5110 <= __SUNPRO_C || 1300 <= _MSC_VER)
+ int alignas (8) alignas_int = 1;
+ char test_alignas[_Alignof (alignas_int) == 8 ? 1 : -1];
+ #endif
+ ]])],
+ [gl_cv_header_working_stdalign_h=yes],
+ [gl_cv_header_working_stdalign_h=no])])
+
+ if test $gl_cv_header_working_stdalign_h = yes; then
+ STDALIGN_H=''
+ else
+ STDALIGN_H='stdalign.h'
+ fi
+
+ AC_SUBST([STDALIGN_H])
+ AM_CONDITIONAL([GL_GENERATE_STDALIGN_H], [test -n "$STDALIGN_H"])
+])
diff --git a/m4/stdarg.m4 b/m4/stdarg.m4
index 5705de9ecaa..5c313cb8c91 100644
--- a/m4/stdarg.m4
+++ b/m4/stdarg.m4
@@ -1,5 +1,5 @@
# stdarg.m4 serial 6
-dnl Copyright (C) 2006, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2006, 2008-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/stdbool.m4 b/m4/stdbool.m4
index 1ebf3e6808c..eabfa64579c 100644
--- a/m4/stdbool.m4
+++ b/m4/stdbool.m4
@@ -1,6 +1,6 @@
# Check for stdbool.h that conforms to C99.
-dnl Copyright (C) 2002-2006, 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4
index 1ae2344318e..cc116096093 100644
--- a/m4/stddef_h.m4
+++ b/m4/stddef_h.m4
@@ -1,6 +1,6 @@
dnl A placeholder for POSIX 2008 <stddef.h>, for platforms that have issues.
# stddef_h.m4 serial 4
-dnl Copyright (C) 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/stdint.m4 b/m4/stdint.m4
index 092161c9968..28d342ea233 100644
--- a/m4/stdint.m4
+++ b/m4/stdint.m4
@@ -1,5 +1,5 @@
-# stdint.m4 serial 41
-dnl Copyright (C) 2001-2011 Free Software Foundation, Inc.
+# stdint.m4 serial 43
+dnl Copyright (C) 2001-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -69,8 +69,6 @@ AC_DEFUN_ONCE([gl_STDINT_H],
[gl_cv_header_working_stdint_h=no
AC_COMPILE_IFELSE([
AC_LANG_PROGRAM([[
-#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */
-#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */
#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */
#include <stdint.h>
/* Dragonfly defines WCHAR_MIN, WCHAR_MAX only in <wchar.h>. */
@@ -219,8 +217,6 @@ struct s {
dnl This detects a bug on HP-UX 11.23/ia64.
AC_RUN_IFELSE([
AC_LANG_PROGRAM([[
-#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */
-#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */
#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */
#include <stdint.h>
]
diff --git a/m4/stdio_h.m4 b/m4/stdio_h.m4
index 39bf80e2ac9..5298dd6d9d5 100644
--- a/m4/stdio_h.m4
+++ b/m4/stdio_h.m4
@@ -1,5 +1,5 @@
-# stdio_h.m4 serial 40
-dnl Copyright (C) 2007-2011 Free Software Foundation, Inc.
+# stdio_h.m4 serial 42
+dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -13,12 +13,13 @@ AC_DEFUN([gl_STDIO_H],
dnl No need to create extra modules for these functions. Everyone who uses
dnl <stdio.h> likely needs them.
GNULIB_FSCANF=1
+ gl_MODULE_INDICATOR([fscanf])
GNULIB_SCANF=1
+ gl_MODULE_INDICATOR([scanf])
GNULIB_FGETC=1
GNULIB_GETC=1
GNULIB_GETCHAR=1
GNULIB_FGETS=1
- GNULIB_GETS=1
GNULIB_FREAD=1
dnl This ifdef is necessary to avoid an error "missing file lib/stdio-read.c"
dnl "expected source file, required through AC_LIBSOURCES, not found". It is
@@ -72,10 +73,10 @@ AC_DEFUN([gl_STDIO_H],
dnl Check for declarations of anything we want to poison if the
dnl corresponding gnulib module is not in use, and which is not
- dnl guaranteed by C89.
+ dnl guaranteed by both C89 and C11.
gl_WARN_ON_USE_PREPARE([[#include <stdio.h>
- ]], [dprintf fpurge fseeko ftello getdelim getline pclose popen renameat
- snprintf tmpfile vdprintf vsnprintf])
+ ]], [dprintf fpurge fseeko ftello getdelim getline gets pclose popen
+ renameat snprintf tmpfile vdprintf vsnprintf])
])
AC_DEFUN([gl_STDIO_MODULE_INDICATOR],
@@ -113,7 +114,6 @@ AC_DEFUN([gl_STDIO_H_DEFAULTS],
GNULIB_GETCHAR=0; AC_SUBST([GNULIB_GETCHAR])
GNULIB_GETDELIM=0; AC_SUBST([GNULIB_GETDELIM])
GNULIB_GETLINE=0; AC_SUBST([GNULIB_GETLINE])
- GNULIB_GETS=0; AC_SUBST([GNULIB_GETS])
GNULIB_OBSTACK_PRINTF=0; AC_SUBST([GNULIB_OBSTACK_PRINTF])
GNULIB_OBSTACK_PRINTF_POSIX=0; AC_SUBST([GNULIB_OBSTACK_PRINTF_POSIX])
GNULIB_PCLOSE=0; AC_SUBST([GNULIB_PCLOSE])
diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4
index 25fdada0de7..9c69f2e4d15 100644
--- a/m4/stdlib_h.m4
+++ b/m4/stdlib_h.m4
@@ -1,5 +1,5 @@
-# stdlib_h.m4 serial 37
-dnl Copyright (C) 2007-2011 Free Software Foundation, Inc.
+# stdlib_h.m4 serial 41
+dnl Copyright (C) 2007-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -19,10 +19,11 @@ AC_DEFUN([gl_STDLIB_H],
#if HAVE_RANDOM_H
# include <random.h>
#endif
- ]], [_Exit atoll canonicalize_file_name getloadavg getsubopt grantpt mkdtemp
- mkostemp mkostemps mkstemp mkstemps ptsname random_r initstat_r srandom_r
- setstate_r realpath rpmatch setenv strtod strtoll strtoull unlockpt
- unsetenv])
+ ]], [_Exit atoll canonicalize_file_name getloadavg getsubopt grantpt
+ initstate initstate_r mkdtemp mkostemp mkostemps mkstemp mkstemps
+ posix_openpt ptsname ptsname_r random random_r realpath rpmatch
+ setenv setstate setstate_r srandom srandom_r
+ strtod strtoll strtoull unlockpt unsetenv])
])
AC_DEFUN([gl_STDLIB_MODULE_INDICATOR],
@@ -50,8 +51,11 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
GNULIB_MKOSTEMPS=0; AC_SUBST([GNULIB_MKOSTEMPS])
GNULIB_MKSTEMP=0; AC_SUBST([GNULIB_MKSTEMP])
GNULIB_MKSTEMPS=0; AC_SUBST([GNULIB_MKSTEMPS])
+ GNULIB_POSIX_OPENPT=0; AC_SUBST([GNULIB_POSIX_OPENPT])
GNULIB_PTSNAME=0; AC_SUBST([GNULIB_PTSNAME])
+ GNULIB_PTSNAME_R=0; AC_SUBST([GNULIB_PTSNAME_R])
GNULIB_PUTENV=0; AC_SUBST([GNULIB_PUTENV])
+ GNULIB_RANDOM=0; AC_SUBST([GNULIB_RANDOM])
GNULIB_RANDOM_R=0; AC_SUBST([GNULIB_RANDOM_R])
GNULIB_REALLOC_POSIX=0; AC_SUBST([GNULIB_REALLOC_POSIX])
GNULIB_REALPATH=0; AC_SUBST([GNULIB_REALPATH])
@@ -76,7 +80,10 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
HAVE_MKOSTEMPS=1; AC_SUBST([HAVE_MKOSTEMPS])
HAVE_MKSTEMP=1; AC_SUBST([HAVE_MKSTEMP])
HAVE_MKSTEMPS=1; AC_SUBST([HAVE_MKSTEMPS])
+ HAVE_POSIX_OPENPT=1; AC_SUBST([HAVE_POSIX_OPENPT])
HAVE_PTSNAME=1; AC_SUBST([HAVE_PTSNAME])
+ HAVE_PTSNAME_R=1; AC_SUBST([HAVE_PTSNAME_R])
+ HAVE_RANDOM=1; AC_SUBST([HAVE_RANDOM])
HAVE_RANDOM_H=1; AC_SUBST([HAVE_RANDOM_H])
HAVE_RANDOM_R=1; AC_SUBST([HAVE_RANDOM_R])
HAVE_REALPATH=1; AC_SUBST([HAVE_REALPATH])
@@ -95,7 +102,10 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
REPLACE_MALLOC=0; AC_SUBST([REPLACE_MALLOC])
REPLACE_MBTOWC=0; AC_SUBST([REPLACE_MBTOWC])
REPLACE_MKSTEMP=0; AC_SUBST([REPLACE_MKSTEMP])
+ REPLACE_PTSNAME=0; AC_SUBST([REPLACE_PTSNAME])
+ REPLACE_PTSNAME_R=0; AC_SUBST([REPLACE_PTSNAME_R])
REPLACE_PUTENV=0; AC_SUBST([REPLACE_PUTENV])
+ REPLACE_RANDOM_R=0; AC_SUBST([REPLACE_RANDOM_R])
REPLACE_REALLOC=0; AC_SUBST([REPLACE_REALLOC])
REPLACE_REALPATH=0; AC_SUBST([REPLACE_REALPATH])
REPLACE_SETENV=0; AC_SUBST([REPLACE_SETENV])
diff --git a/m4/strftime.m4 b/m4/strftime.m4
index dd30ccfc054..42043019b4b 100644
--- a/m4/strftime.m4
+++ b/m4/strftime.m4
@@ -1,6 +1,6 @@
# serial 33
-# Copyright (C) 1996-1997, 1999-2007, 2009-2011 Free Software Foundation, Inc.
+# Copyright (C) 1996-1997, 1999-2007, 2009-2012 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/strtoimax.m4 b/m4/strtoimax.m4
index a8d0b69c205..58a31899b8b 100644
--- a/m4/strtoimax.m4
+++ b/m4/strtoimax.m4
@@ -1,5 +1,5 @@
-# strtoimax.m4 serial 11
-dnl Copyright (C) 2002-2004, 2006, 2009-2011 Free Software Foundation, Inc.
+# strtoimax.m4 serial 13
+dnl Copyright (C) 2002-2004, 2006, 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -14,6 +14,66 @@ AC_DEFUN([gl_FUNC_STRTOIMAX],
if test "$ac_cv_have_decl_strtoimax" != yes; then
HAVE_DECL_STRTOIMAX=0
fi
+
+ if test $ac_cv_func_strtoimax = yes; then
+ HAVE_STRTOIMAX=1
+ dnl On AIX 5.1, strtoimax() fails for values outside the 'int' range.
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+ AC_CACHE_CHECK([whether strtoimax works], [gl_cv_func_strtoimax],
+ [AC_RUN_IFELSE(
+ [AC_LANG_SOURCE([[
+#include <errno.h>
+#include <string.h>
+#include <inttypes.h>
+int main ()
+{
+ if (sizeof (intmax_t) > sizeof (int))
+ {
+ const char *s = "4294967295";
+ char *p;
+ intmax_t res;
+ errno = 0;
+ res = strtoimax (s, &p, 10);
+ if (p != s + strlen (s))
+ return 1;
+ if (errno != 0)
+ return 2;
+ if (res != (intmax_t) 65535 * (intmax_t) 65537)
+ return 3;
+ }
+ else
+ {
+ const char *s = "2147483647";
+ char *p;
+ intmax_t res;
+ errno = 0;
+ res = strtoimax (s, &p, 10);
+ if (p != s + strlen (s))
+ return 1;
+ if (errno != 0)
+ return 2;
+ if (res != 2147483647)
+ return 3;
+ }
+ return 0;
+}
+]])],
+ [gl_cv_func_strtoimax=yes],
+ [gl_cv_func_strtoimax=no],
+ [case "$host_os" in
+ # Guess no on AIX 5.
+ aix5*) gl_cv_func_strtoimax="guessing no" ;;
+ # Guess yes otherwise.
+ *) gl_cv_func_strtoimax="guessing yes" ;;
+ esac
+ ])
+ ])
+ case "$gl_cv_func_strtoimax" in
+ *no) REPLACE_STRTOIMAX=1 ;;
+ esac
+ else
+ HAVE_STRTOIMAX=0
+ fi
])
# Prerequisites of lib/strtoimax.c.
diff --git a/m4/strtoll.m4 b/m4/strtoll.m4
index ed6a854b58c..5854bcb5827 100644
--- a/m4/strtoll.m4
+++ b/m4/strtoll.m4
@@ -1,5 +1,5 @@
# strtoll.m4 serial 7
-dnl Copyright (C) 2002, 2004, 2006, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2004, 2006, 2008-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/strtoull.m4 b/m4/strtoull.m4
index 57ef75423df..7c659f57d4e 100644
--- a/m4/strtoull.m4
+++ b/m4/strtoull.m4
@@ -1,5 +1,5 @@
# strtoull.m4 serial 7
-dnl Copyright (C) 2002, 2004, 2006, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2004, 2006, 2008-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/strtoumax.m4 b/m4/strtoumax.m4
index 1ddf6820e3f..5b2285c6b35 100644
--- a/m4/strtoumax.m4
+++ b/m4/strtoumax.m4
@@ -1,5 +1,5 @@
# strtoumax.m4 serial 11
-dnl Copyright (C) 2002-2004, 2006, 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2004, 2006, 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/symlink.m4 b/m4/symlink.m4
index 680c14f6610..cfd90ec2b6e 100644
--- a/m4/symlink.m4
+++ b/m4/symlink.m4
@@ -1,7 +1,7 @@
-# serial 5
+# serial 6
# See if we need to provide symlink replacement.
-dnl Copyright (C) 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -11,6 +11,7 @@ dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_FUNC_SYMLINK],
[
AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CHECK_FUNCS_ONCE([symlink])
dnl The best we can do on mingw is provide a dummy that always fails, so
dnl that compilation can proceed with fewer ifdefs. On FreeBSD 7.2, AIX 7.1,
@@ -34,10 +35,19 @@ AC_DEFUN([gl_FUNC_SYMLINK],
return result;
]])],
[gl_cv_func_symlink_works=yes], [gl_cv_func_symlink_works=no],
- [gl_cv_func_symlink_works="guessing no"])
+ [case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_symlink_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_symlink_works="guessing no" ;;
+ esac
+ ])
rm -f conftest.f conftest.link conftest.lnk2])
- if test "$gl_cv_func_symlink_works" != yes; then
- REPLACE_SYMLINK=1
- fi
+ case "$gl_cv_func_symlink_works" in
+ *yes) ;;
+ *)
+ REPLACE_SYMLINK=1
+ ;;
+ esac
fi
])
diff --git a/m4/sys_select_h.m4 b/m4/sys_select_h.m4
new file mode 100644
index 00000000000..eaf056a79a2
--- /dev/null
+++ b/m4/sys_select_h.m4
@@ -0,0 +1,95 @@
+# sys_select_h.m4 serial 20
+dnl Copyright (C) 2006-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_HEADER_SYS_SELECT],
+[
+ AC_REQUIRE([AC_C_RESTRICT])
+ AC_REQUIRE([gl_SYS_SELECT_H_DEFAULTS])
+ AC_CACHE_CHECK([whether <sys/select.h> is self-contained],
+ [gl_cv_header_sys_select_h_selfcontained],
+ [
+ dnl Test against two bugs:
+ dnl 1. On many platforms, <sys/select.h> assumes prior inclusion of
+ dnl <sys/types.h>.
+ dnl 2. On OSF/1 4.0, <sys/select.h> provides only a forward declaration
+ dnl of 'struct timeval', and no definition of this type.
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/select.h>]],
+ [[struct timeval b;]])],
+ [gl_cv_header_sys_select_h_selfcontained=yes],
+ [gl_cv_header_sys_select_h_selfcontained=no])
+ dnl Test against another bug:
+ dnl 3. On Solaris 10, <sys/select.h> provides an FD_ZERO implementation
+ dnl that relies on memset(), but without including <string.h>.
+ if test $gl_cv_header_sys_select_h_selfcontained = yes; then
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[#include <sys/select.h>]],
+ [[int memset; int bzero;]])
+ ],
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM([[#include <sys/select.h>]], [[
+ #undef memset
+ #define memset nonexistent_memset
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void *memset (void *, int, unsigned long);
+ #undef bzero
+ #define bzero nonexistent_bzero
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void bzero (void *, unsigned long);
+ fd_set fds;
+ FD_ZERO (&fds);
+ ]])
+ ],
+ [],
+ [gl_cv_header_sys_select_h_selfcontained=no])
+ ])
+ fi
+ ])
+ dnl <sys/select.h> is always overridden, because of GNULIB_POSIXCHECK.
+ gl_CHECK_NEXT_HEADERS([sys/select.h])
+ if test $ac_cv_header_sys_select_h = yes; then
+ HAVE_SYS_SELECT_H=1
+ else
+ HAVE_SYS_SELECT_H=0
+ fi
+ AC_SUBST([HAVE_SYS_SELECT_H])
+ gl_PREREQ_SYS_H_WINSOCK2
+
+ dnl Check for declarations of anything we want to poison if the
+ dnl corresponding gnulib module is not in use.
+ gl_WARN_ON_USE_PREPARE([[
+/* Some systems require prerequisite headers. */
+#include <sys/types.h>
+#if !(defined __GLIBC__ && !defined __UCLIBC__) && HAVE_SYS_TIME_H
+# include <sys/time.h>
+#endif
+#include <sys/select.h>
+ ]], [pselect select])
+])
+
+AC_DEFUN([gl_SYS_SELECT_MODULE_INDICATOR],
+[
+ dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+ AC_REQUIRE([gl_SYS_SELECT_H_DEFAULTS])
+ gl_MODULE_INDICATOR_SET_VARIABLE([$1])
+ dnl Define it also as a C macro, for the benefit of the unit tests.
+ gl_MODULE_INDICATOR_FOR_TESTS([$1])
+])
+
+AC_DEFUN([gl_SYS_SELECT_H_DEFAULTS],
+[
+ GNULIB_PSELECT=0; AC_SUBST([GNULIB_PSELECT])
+ GNULIB_SELECT=0; AC_SUBST([GNULIB_SELECT])
+ dnl Assume proper GNU behavior unless another module says otherwise.
+ HAVE_PSELECT=1; AC_SUBST([HAVE_PSELECT])
+ REPLACE_PSELECT=0; AC_SUBST([REPLACE_PSELECT])
+ REPLACE_SELECT=0; AC_SUBST([REPLACE_SELECT])
+])
diff --git a/m4/sys_socket_h.m4 b/m4/sys_socket_h.m4
new file mode 100644
index 00000000000..8d4e7e1ebb4
--- /dev/null
+++ b/m4/sys_socket_h.m4
@@ -0,0 +1,177 @@
+# sys_socket_h.m4 serial 22
+dnl Copyright (C) 2005-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Simon Josefsson.
+
+AC_DEFUN([gl_HEADER_SYS_SOCKET],
+[
+ AC_REQUIRE([gl_SYS_SOCKET_H_DEFAULTS])
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ AC_REQUIRE([AC_C_INLINE])
+
+ dnl On OSF/1, the functions recv(), send(), recvfrom(), sendto() have
+ dnl old-style declarations (with return type 'int' instead of 'ssize_t')
+ dnl unless _POSIX_PII_SOCKET is defined.
+ case "$host_os" in
+ osf*)
+ AC_DEFINE([_POSIX_PII_SOCKET], [1],
+ [Define to 1 in order to get the POSIX compatible declarations
+ of socket functions.])
+ ;;
+ esac
+
+ AC_CACHE_CHECK([whether <sys/socket.h> is self-contained],
+ [gl_cv_header_sys_socket_h_selfcontained],
+ [
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/socket.h>]], [[]])],
+ [gl_cv_header_sys_socket_h_selfcontained=yes],
+ [gl_cv_header_sys_socket_h_selfcontained=no])
+ ])
+ if test $gl_cv_header_sys_socket_h_selfcontained = yes; then
+ dnl If the shutdown function exists, <sys/socket.h> should define
+ dnl SHUT_RD, SHUT_WR, SHUT_RDWR.
+ AC_CHECK_FUNCS([shutdown])
+ if test $ac_cv_func_shutdown = yes; then
+ AC_CACHE_CHECK([whether <sys/socket.h> defines the SHUT_* macros],
+ [gl_cv_header_sys_socket_h_shut],
+ [
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[#include <sys/socket.h>]],
+ [[int a[] = { SHUT_RD, SHUT_WR, SHUT_RDWR };]])],
+ [gl_cv_header_sys_socket_h_shut=yes],
+ [gl_cv_header_sys_socket_h_shut=no])
+ ])
+ if test $gl_cv_header_sys_socket_h_shut = no; then
+ SYS_SOCKET_H='sys/socket.h'
+ fi
+ fi
+ fi
+ # We need to check for ws2tcpip.h now.
+ gl_PREREQ_SYS_H_SOCKET
+ AC_CHECK_TYPES([struct sockaddr_storage, sa_family_t],,,[
+ /* sys/types.h is not needed according to POSIX, but the
+ sys/socket.h in i386-unknown-freebsd4.10 and
+ powerpc-apple-darwin5.5 required it. */
+#include <sys/types.h>
+#ifdef HAVE_SYS_SOCKET_H
+#include <sys/socket.h>
+#endif
+#ifdef HAVE_WS2TCPIP_H
+#include <ws2tcpip.h>
+#endif
+])
+ if test $ac_cv_type_struct_sockaddr_storage = no; then
+ HAVE_STRUCT_SOCKADDR_STORAGE=0
+ fi
+ if test $ac_cv_type_sa_family_t = no; then
+ HAVE_SA_FAMILY_T=0
+ fi
+ if test $ac_cv_type_struct_sockaddr_storage != no; then
+ AC_CHECK_MEMBERS([struct sockaddr_storage.ss_family],
+ [],
+ [HAVE_STRUCT_SOCKADDR_STORAGE_SS_FAMILY=0],
+ [#include <sys/types.h>
+ #ifdef HAVE_SYS_SOCKET_H
+ #include <sys/socket.h>
+ #endif
+ #ifdef HAVE_WS2TCPIP_H
+ #include <ws2tcpip.h>
+ #endif
+ ])
+ fi
+ if test $HAVE_STRUCT_SOCKADDR_STORAGE = 0 || test $HAVE_SA_FAMILY_T = 0 \
+ || test $HAVE_STRUCT_SOCKADDR_STORAGE_SS_FAMILY = 0; then
+ SYS_SOCKET_H='sys/socket.h'
+ fi
+ gl_PREREQ_SYS_H_WINSOCK2
+
+ dnl Check for declarations of anything we want to poison if the
+ dnl corresponding gnulib module is not in use.
+ gl_WARN_ON_USE_PREPARE([[
+/* Some systems require prerequisite headers. */
+#include <sys/types.h>
+#include <sys/socket.h>
+ ]], [socket connect accept bind getpeername getsockname getsockopt
+ listen recv send recvfrom sendto setsockopt shutdown accept4])
+])
+
+AC_DEFUN([gl_PREREQ_SYS_H_SOCKET],
+[
+ dnl Check prerequisites of the <sys/socket.h> replacement.
+ AC_REQUIRE([gl_CHECK_SOCKET_HEADERS])
+ gl_CHECK_NEXT_HEADERS([sys/socket.h])
+ if test $ac_cv_header_sys_socket_h = yes; then
+ HAVE_SYS_SOCKET_H=1
+ HAVE_WS2TCPIP_H=0
+ else
+ HAVE_SYS_SOCKET_H=0
+ if test $ac_cv_header_ws2tcpip_h = yes; then
+ HAVE_WS2TCPIP_H=1
+ else
+ HAVE_WS2TCPIP_H=0
+ fi
+ fi
+ AC_SUBST([HAVE_SYS_SOCKET_H])
+ AC_SUBST([HAVE_WS2TCPIP_H])
+])
+
+# Common prerequisites of the <sys/socket.h> replacement and of the
+# <sys/select.h> replacement.
+# Sets and substitutes HAVE_WINSOCK2_H.
+AC_DEFUN([gl_PREREQ_SYS_H_WINSOCK2],
+[
+ m4_ifdef([gl_UNISTD_H_DEFAULTS], [AC_REQUIRE([gl_UNISTD_H_DEFAULTS])])
+ m4_ifdef([gl_SYS_IOCTL_H_DEFAULTS], [AC_REQUIRE([gl_SYS_IOCTL_H_DEFAULTS])])
+ AC_CHECK_HEADERS_ONCE([sys/socket.h])
+ if test $ac_cv_header_sys_socket_h != yes; then
+ dnl We cannot use AC_CHECK_HEADERS_ONCE here, because that would make
+ dnl the check for those headers unconditional; yet cygwin reports
+ dnl that the headers are present but cannot be compiled (since on
+ dnl cygwin, all socket information should come from sys/socket.h).
+ AC_CHECK_HEADERS([winsock2.h])
+ fi
+ if test "$ac_cv_header_winsock2_h" = yes; then
+ HAVE_WINSOCK2_H=1
+ UNISTD_H_HAVE_WINSOCK2_H=1
+ SYS_IOCTL_H_HAVE_WINSOCK2_H=1
+ else
+ HAVE_WINSOCK2_H=0
+ fi
+ AC_SUBST([HAVE_WINSOCK2_H])
+])
+
+AC_DEFUN([gl_SYS_SOCKET_MODULE_INDICATOR],
+[
+ dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+ AC_REQUIRE([gl_SYS_SOCKET_H_DEFAULTS])
+ gl_MODULE_INDICATOR_SET_VARIABLE([$1])
+ dnl Define it also as a C macro, for the benefit of the unit tests.
+ gl_MODULE_INDICATOR_FOR_TESTS([$1])
+])
+
+AC_DEFUN([gl_SYS_SOCKET_H_DEFAULTS],
+[
+ GNULIB_SOCKET=0; AC_SUBST([GNULIB_SOCKET])
+ GNULIB_CONNECT=0; AC_SUBST([GNULIB_CONNECT])
+ GNULIB_ACCEPT=0; AC_SUBST([GNULIB_ACCEPT])
+ GNULIB_BIND=0; AC_SUBST([GNULIB_BIND])
+ GNULIB_GETPEERNAME=0; AC_SUBST([GNULIB_GETPEERNAME])
+ GNULIB_GETSOCKNAME=0; AC_SUBST([GNULIB_GETSOCKNAME])
+ GNULIB_GETSOCKOPT=0; AC_SUBST([GNULIB_GETSOCKOPT])
+ GNULIB_LISTEN=0; AC_SUBST([GNULIB_LISTEN])
+ GNULIB_RECV=0; AC_SUBST([GNULIB_RECV])
+ GNULIB_SEND=0; AC_SUBST([GNULIB_SEND])
+ GNULIB_RECVFROM=0; AC_SUBST([GNULIB_RECVFROM])
+ GNULIB_SENDTO=0; AC_SUBST([GNULIB_SENDTO])
+ GNULIB_SETSOCKOPT=0; AC_SUBST([GNULIB_SETSOCKOPT])
+ GNULIB_SHUTDOWN=0; AC_SUBST([GNULIB_SHUTDOWN])
+ GNULIB_ACCEPT4=0; AC_SUBST([GNULIB_ACCEPT4])
+ HAVE_STRUCT_SOCKADDR_STORAGE=1; AC_SUBST([HAVE_STRUCT_SOCKADDR_STORAGE])
+ HAVE_STRUCT_SOCKADDR_STORAGE_SS_FAMILY=1;
+ AC_SUBST([HAVE_STRUCT_SOCKADDR_STORAGE_SS_FAMILY])
+ HAVE_SA_FAMILY_T=1; AC_SUBST([HAVE_SA_FAMILY_T])
+ HAVE_ACCEPT4=1; AC_SUBST([HAVE_ACCEPT4])
+])
diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4
index 83ebac613b7..f45dee1dc4d 100644
--- a/m4/sys_stat_h.m4
+++ b/m4/sys_stat_h.m4
@@ -1,5 +1,5 @@
-# sys_stat_h.m4 serial 26 -*- Autoconf -*-
-dnl Copyright (C) 2006-2011 Free Software Foundation, Inc.
+# sys_stat_h.m4 serial 27 -*- Autoconf -*-
+dnl Copyright (C) 2006-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -22,6 +22,19 @@ AC_DEFUN([gl_HEADER_SYS_STAT_H],
dnl Ensure the type mode_t gets defined.
AC_REQUIRE([AC_TYPE_MODE_T])
+ dnl Whether to override 'struct stat'.
+ m4_ifdef([gl_LARGEFILE], [
+ AC_REQUIRE([gl_LARGEFILE])
+ ], [
+ WINDOWS_64_BIT_ST_SIZE=0
+ ])
+ AC_SUBST([WINDOWS_64_BIT_ST_SIZE])
+ if test $WINDOWS_64_BIT_ST_SIZE = 1; then
+ AC_DEFINE([_GL_WINDOWS_64_BIT_ST_SIZE], [1],
+ [Define to 1 if Gnulib overrides 'struct stat' on Windows so that
+ struct stat.st_size becomes 64-bit.])
+ fi
+
dnl Define types that are supposed to be defined in <sys/types.h> or
dnl <sys/stat.h>.
AC_CHECK_TYPE([nlink_t], [],
diff --git a/m4/sys_time_h.m4 b/m4/sys_time_h.m4
new file mode 100644
index 00000000000..c4a30cda777
--- /dev/null
+++ b/m4/sys_time_h.m4
@@ -0,0 +1,110 @@
+# Configure a replacement for <sys/time.h>.
+# serial 8
+
+# Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# Written by Paul Eggert and Martin Lambers.
+
+AC_DEFUN([gl_HEADER_SYS_TIME_H],
+[
+ dnl Use AC_REQUIRE here, so that the REPLACE_GETTIMEOFDAY=0 statement
+ dnl below is expanded once only, before all REPLACE_GETTIMEOFDAY=1
+ dnl statements that occur in other macros.
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H_BODY])
+])
+
+AC_DEFUN([gl_HEADER_SYS_TIME_H_BODY],
+[
+ AC_REQUIRE([AC_C_RESTRICT])
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H_DEFAULTS])
+ AC_CHECK_HEADERS_ONCE([sys/time.h])
+ gl_CHECK_NEXT_HEADERS([sys/time.h])
+
+ if test $ac_cv_header_sys_time_h != yes; then
+ HAVE_SYS_TIME_H=0
+ fi
+
+ dnl On native Windows with MSVC, 'struct timeval' is defined in <winsock2.h>
+ dnl only. So include that header in the list.
+ gl_PREREQ_SYS_H_WINSOCK2
+ AC_CACHE_CHECK([for struct timeval], [gl_cv_sys_struct_timeval],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#if HAVE_SYS_TIME_H
+ #include <sys/time.h>
+ #endif
+ #include <time.h>
+ #if HAVE_WINSOCK2_H
+ # include <winsock2.h>
+ #endif
+ ]],
+ [[static struct timeval x; x.tv_sec = x.tv_usec;]])],
+ [gl_cv_sys_struct_timeval=yes],
+ [gl_cv_sys_struct_timeval=no])
+ ])
+ if test $gl_cv_sys_struct_timeval != yes; then
+ HAVE_STRUCT_TIMEVAL=0
+ else
+ dnl On native Windows with a 64-bit 'time_t', 'struct timeval' is defined
+ dnl (in <sys/time.h> and <winsock2.h> for mingw64, in <winsock2.h> only
+ dnl for MSVC) with a tv_sec field of type 'long' (32-bit!), which is
+ dnl smaller than the 'time_t' type mandated by POSIX.
+ dnl On OpenBSD 5.1 amd64, tv_sec is 64 bits and time_t 32 bits, but
+ dnl that is good enough.
+ AC_CACHE_CHECK([for wide-enough struct timeval.tv_sec member],
+ [gl_cv_sys_struct_timeval_tv_sec],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#if HAVE_SYS_TIME_H
+ #include <sys/time.h>
+ #endif
+ #include <time.h>
+ #if HAVE_WINSOCK2_H
+ # include <winsock2.h>
+ #endif
+ ]],
+ [[static struct timeval x;
+ typedef int verify_tv_sec_type[
+ sizeof (time_t) <= sizeof x.tv_sec ? 1 : -1
+ ];
+ ]])],
+ [gl_cv_sys_struct_timeval_tv_sec=yes],
+ [gl_cv_sys_struct_timeval_tv_sec=no])
+ ])
+ if test $gl_cv_sys_struct_timeval_tv_sec != yes; then
+ REPLACE_STRUCT_TIMEVAL=1
+ fi
+ fi
+
+ dnl Check for declarations of anything we want to poison if the
+ dnl corresponding gnulib module is not in use.
+ gl_WARN_ON_USE_PREPARE([[
+#if HAVE_SYS_TIME_H
+# include <sys/time.h>
+#endif
+#include <time.h>
+ ]], [gettimeofday])
+])
+
+AC_DEFUN([gl_SYS_TIME_MODULE_INDICATOR],
+[
+ dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H_DEFAULTS])
+ gl_MODULE_INDICATOR_SET_VARIABLE([$1])
+ dnl Define it also as a C macro, for the benefit of the unit tests.
+ gl_MODULE_INDICATOR_FOR_TESTS([$1])
+])
+
+AC_DEFUN([gl_HEADER_SYS_TIME_H_DEFAULTS],
+[
+ GNULIB_GETTIMEOFDAY=0; AC_SUBST([GNULIB_GETTIMEOFDAY])
+ dnl Assume POSIX behavior unless another module says otherwise.
+ HAVE_GETTIMEOFDAY=1; AC_SUBST([HAVE_GETTIMEOFDAY])
+ HAVE_STRUCT_TIMEVAL=1; AC_SUBST([HAVE_STRUCT_TIMEVAL])
+ HAVE_SYS_TIME_H=1; AC_SUBST([HAVE_SYS_TIME_H])
+ REPLACE_GETTIMEOFDAY=0; AC_SUBST([REPLACE_GETTIMEOFDAY])
+ REPLACE_STRUCT_TIMEVAL=0; AC_SUBST([REPLACE_STRUCT_TIMEVAL])
+])
diff --git a/m4/sys_types_h.m4 b/m4/sys_types_h.m4
new file mode 100644
index 00000000000..f11eef2fe8a
--- /dev/null
+++ b/m4/sys_types_h.m4
@@ -0,0 +1,24 @@
+# sys_types_h.m4 serial 4
+dnl Copyright (C) 2011-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_SYS_TYPES_H],
+[
+ AC_REQUIRE([gl_SYS_TYPES_H_DEFAULTS])
+ gl_NEXT_HEADERS([sys/types.h])
+
+ dnl Ensure the type pid_t gets defined.
+ AC_REQUIRE([AC_TYPE_PID_T])
+
+ dnl Ensure the type mode_t gets defined.
+ AC_REQUIRE([AC_TYPE_MODE_T])
+
+ dnl Whether to override the 'off_t' type.
+ AC_REQUIRE([gl_TYPE_OFF_T])
+])
+
+AC_DEFUN([gl_SYS_TYPES_H_DEFAULTS],
+[
+])
diff --git a/m4/time_h.m4 b/m4/time_h.m4
index 3454b23fa0c..6415bfbcb74 100644
--- a/m4/time_h.m4
+++ b/m4/time_h.m4
@@ -1,8 +1,8 @@
# Configure a more-standard replacement for <time.h>.
-# Copyright (C) 2000-2001, 2003-2007, 2009-2011 Free Software Foundation, Inc.
+# Copyright (C) 2000-2001, 2003-2007, 2009-2012 Free Software Foundation, Inc.
-# serial 6
+# serial 7
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -25,7 +25,7 @@ AC_DEFUN([gl_HEADER_TIME_H_BODY],
AC_REQUIRE([gl_CHECK_TYPE_STRUCT_TIMESPEC])
])
-dnl Define HAVE_STRUCT_TIMESPEC if `struct timespec' is declared
+dnl Check whether 'struct timespec' is declared
dnl in time.h, sys/time.h, or pthread.h.
AC_DEFUN([gl_CHECK_TYPE_STRUCT_TIMESPEC],
diff --git a/m4/time_r.m4 b/m4/time_r.m4
index d646edc2d3c..9ddbd0199d5 100644
--- a/m4/time_r.m4
+++ b/m4/time_r.m4
@@ -1,6 +1,6 @@
dnl Reentrant time functions: localtime_r, gmtime_r.
-dnl Copyright (C) 2003, 2006-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2006-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -17,7 +17,7 @@ AC_DEFUN([gl_TIME_R],
dnl Some systems don't declare localtime_r() and gmtime_r() if _REENTRANT is
dnl not defined.
- AC_CHECK_DECLS_ONCE([localtime_r])
+ AC_CHECK_DECLS([localtime_r], [], [], [[#include <time.h>]])
if test $ac_cv_have_decl_localtime_r = no; then
HAVE_DECL_LOCALTIME_R=0
fi
diff --git a/m4/timer_time.m4 b/m4/timer_time.m4
new file mode 100644
index 00000000000..bc84554b789
--- /dev/null
+++ b/m4/timer_time.m4
@@ -0,0 +1,39 @@
+# timer_time.m4 serial 2
+dnl Copyright (C) 2011-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+# Check for timer_settime, and set LIB_TIMER_TIME.
+
+AC_DEFUN([gl_TIMER_TIME],
+[
+ dnl Based on clock_time.m4. See details there.
+
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+ AC_REQUIRE([gl_THREADLIB])
+
+ LIB_TIMER_TIME=
+ AC_SUBST([LIB_TIMER_TIME])
+ gl_saved_libs=$LIBS
+ AC_SEARCH_LIBS([timer_settime], [rt posix4],
+ [test "$ac_cv_search_timer_settime" = "none required" ||
+ LIB_TIMER_TIME=$ac_cv_search_timer_settime])
+ dnl GLIBC uses threads to emulate posix timers when kernel support
+ dnl is not available (like Linux < 2.6 or when used with kFreeBSD)
+ dnl Now the pthread lib is linked automatically in the normal case,
+ dnl but when linking statically, it needs to be explicitly specified.
+ AC_EGREP_CPP([Thread],
+ [
+#include <features.h>
+#ifdef __GNU_LIBRARY__
+ #if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 2) || (__GLIBC__ > 2)) \
+ && !defined __UCLIBC__
+ Thread emulation available
+ #endif
+#endif
+ ],
+ [LIB_TIMER_TIME="$LIB_TIMER_TIME $LIBMULTITHREAD"])
+ AC_CHECK_FUNCS([timer_settime])
+ LIBS=$gl_saved_libs
+])
diff --git a/m4/timespec.m4 b/m4/timespec.m4
new file mode 100644
index 00000000000..63c00e83cdf
--- /dev/null
+++ b/m4/timespec.m4
@@ -0,0 +1,11 @@
+#serial 15
+
+# Copyright (C) 2000-2001, 2003-2007, 2009-2012 Free Software Foundation, Inc.
+
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl From Jim Meyering
+
+AC_DEFUN([gl_TIMESPEC], [:])
diff --git a/m4/tm_gmtoff.m4 b/m4/tm_gmtoff.m4
index d65ddc013be..c12e6cefde2 100644
--- a/m4/tm_gmtoff.m4
+++ b/m4/tm_gmtoff.m4
@@ -1,5 +1,5 @@
# tm_gmtoff.m4 serial 3
-dnl Copyright (C) 2002, 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2009-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4
index 57c8094e42c..7e7651b9d2e 100644
--- a/m4/unistd_h.m4
+++ b/m4/unistd_h.m4
@@ -1,5 +1,5 @@
-# unistd_h.m4 serial 61
-dnl Copyright (C) 2006-2011 Free Software Foundation, Inc.
+# unistd_h.m4 serial 65
+dnl Copyright (C) 2006-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@@ -24,6 +24,9 @@ AC_DEFUN([gl_UNISTD_H],
dnl Ensure the type pid_t gets defined.
AC_REQUIRE([AC_TYPE_PID_T])
+ dnl Determine WINDOWS_64_BIT_OFF_T.
+ AC_REQUIRE([gl_TYPE_OFF_T])
+
dnl Check for declarations of anything we want to poison if the
dnl corresponding gnulib module is not in use.
gl_WARN_ON_USE_PREPARE([[
@@ -41,10 +44,11 @@ AC_DEFUN([gl_UNISTD_H],
#endif
]], [chdir chown dup dup2 dup3 environ euidaccess faccessat fchdir fchownat
fdatasync fsync ftruncate getcwd getdomainname getdtablesize getgroups
- gethostname getlogin getlogin_r getpagesize getusershell setusershell
- endusershell group_member lchown link linkat lseek pipe pipe2 pread pwrite
- readlink readlinkat rmdir sleep symlink symlinkat ttyname_r unlink unlinkat
- usleep])
+ gethostname getlogin getlogin_r getpagesize
+ getusershell setusershell endusershell
+ group_member isatty lchown link linkat lseek pipe pipe2 pread pwrite
+ readlink readlinkat rmdir sethostname sleep symlink symlinkat ttyname_r
+ unlink unlinkat usleep])
])
AC_DEFUN([gl_UNISTD_MODULE_INDICATOR],
@@ -82,6 +86,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
GNULIB_GETPAGESIZE=0; AC_SUBST([GNULIB_GETPAGESIZE])
GNULIB_GETUSERSHELL=0; AC_SUBST([GNULIB_GETUSERSHELL])
GNULIB_GROUP_MEMBER=0; AC_SUBST([GNULIB_GROUP_MEMBER])
+ GNULIB_ISATTY=0; AC_SUBST([GNULIB_ISATTY])
GNULIB_LCHOWN=0; AC_SUBST([GNULIB_LCHOWN])
GNULIB_LINK=0; AC_SUBST([GNULIB_LINK])
GNULIB_LINKAT=0; AC_SUBST([GNULIB_LINKAT])
@@ -94,11 +99,11 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
GNULIB_READLINK=0; AC_SUBST([GNULIB_READLINK])
GNULIB_READLINKAT=0; AC_SUBST([GNULIB_READLINKAT])
GNULIB_RMDIR=0; AC_SUBST([GNULIB_RMDIR])
+ GNULIB_SETHOSTNAME=0; AC_SUBST([GNULIB_SETHOSTNAME])
GNULIB_SLEEP=0; AC_SUBST([GNULIB_SLEEP])
GNULIB_SYMLINK=0; AC_SUBST([GNULIB_SYMLINK])
GNULIB_SYMLINKAT=0; AC_SUBST([GNULIB_SYMLINKAT])
GNULIB_TTYNAME_R=0; AC_SUBST([GNULIB_TTYNAME_R])
- GNULIB_UNISTD_H_GETOPT=0; AC_SUBST([GNULIB_UNISTD_H_GETOPT])
GNULIB_UNISTD_H_NONBLOCKING=0; AC_SUBST([GNULIB_UNISTD_H_NONBLOCKING])
GNULIB_UNISTD_H_SIGPIPE=0; AC_SUBST([GNULIB_UNISTD_H_SIGPIPE])
GNULIB_UNLINK=0; AC_SUBST([GNULIB_UNLINK])
@@ -131,6 +136,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
HAVE_PWRITE=1; AC_SUBST([HAVE_PWRITE])
HAVE_READLINK=1; AC_SUBST([HAVE_READLINK])
HAVE_READLINKAT=1; AC_SUBST([HAVE_READLINKAT])
+ HAVE_SETHOSTNAME=1; AC_SUBST([HAVE_SETHOSTNAME])
HAVE_SLEEP=1; AC_SUBST([HAVE_SLEEP])
HAVE_SYMLINK=1; AC_SUBST([HAVE_SYMLINK])
HAVE_SYMLINKAT=1; AC_SUBST([HAVE_SYMLINKAT])
@@ -143,6 +149,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
HAVE_DECL_GETLOGIN_R=1; AC_SUBST([HAVE_DECL_GETLOGIN_R])
HAVE_DECL_GETPAGESIZE=1; AC_SUBST([HAVE_DECL_GETPAGESIZE])
HAVE_DECL_GETUSERSHELL=1; AC_SUBST([HAVE_DECL_GETUSERSHELL])
+ HAVE_DECL_SETHOSTNAME=1; AC_SUBST([HAVE_DECL_SETHOSTNAME])
HAVE_DECL_TTYNAME_R=1; AC_SUBST([HAVE_DECL_TTYNAME_R])
HAVE_OS_H=0; AC_SUBST([HAVE_OS_H])
HAVE_SYS_PARAM_H=0; AC_SUBST([HAVE_SYS_PARAM_H])
@@ -151,11 +158,13 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
REPLACE_DUP=0; AC_SUBST([REPLACE_DUP])
REPLACE_DUP2=0; AC_SUBST([REPLACE_DUP2])
REPLACE_FCHOWNAT=0; AC_SUBST([REPLACE_FCHOWNAT])
+ REPLACE_FTRUNCATE=0; AC_SUBST([REPLACE_FTRUNCATE])
REPLACE_GETCWD=0; AC_SUBST([REPLACE_GETCWD])
REPLACE_GETDOMAINNAME=0; AC_SUBST([REPLACE_GETDOMAINNAME])
REPLACE_GETLOGIN_R=0; AC_SUBST([REPLACE_GETLOGIN_R])
REPLACE_GETGROUPS=0; AC_SUBST([REPLACE_GETGROUPS])
REPLACE_GETPAGESIZE=0; AC_SUBST([REPLACE_GETPAGESIZE])
+ REPLACE_ISATTY=0; AC_SUBST([REPLACE_ISATTY])
REPLACE_LCHOWN=0; AC_SUBST([REPLACE_LCHOWN])
REPLACE_LINK=0; AC_SUBST([REPLACE_LINK])
REPLACE_LINKAT=0; AC_SUBST([REPLACE_LINKAT])
diff --git a/m4/utimbuf.m4 b/m4/utimbuf.m4
new file mode 100644
index 00000000000..25eb85b326e
--- /dev/null
+++ b/m4/utimbuf.m4
@@ -0,0 +1,39 @@
+# serial 9
+
+# Copyright (C) 1998-2001, 2003-2004, 2007, 2009-2012 Free Software Foundation,
+# Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl From Jim Meyering
+
+dnl Define HAVE_STRUCT_UTIMBUF if 'struct utimbuf' is declared --
+dnl usually in <utime.h>.
+dnl Some systems have utime.h but don't declare the struct anywhere.
+
+AC_DEFUN([gl_CHECK_TYPE_STRUCT_UTIMBUF],
+[
+ AC_CHECK_HEADERS_ONCE([sys/time.h utime.h])
+ AC_CACHE_CHECK([for struct utimbuf], [gl_cv_sys_struct_utimbuf],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#if HAVE_SYS_TIME_H
+ #include <sys/time.h>
+ #endif
+ #include <time.h>
+ #ifdef HAVE_UTIME_H
+ #include <utime.h>
+ #endif
+ ]],
+ [[static struct utimbuf x; x.actime = x.modtime;]])],
+ [gl_cv_sys_struct_utimbuf=yes],
+ [gl_cv_sys_struct_utimbuf=no])])
+
+ if test $gl_cv_sys_struct_utimbuf = yes; then
+ AC_DEFINE([HAVE_STRUCT_UTIMBUF], [1],
+ [Define if struct utimbuf is declared -- usually in <utime.h>.
+ Some systems have utime.h but don't declare the struct anywhere. ])
+ fi
+])
diff --git a/m4/utimens.m4 b/m4/utimens.m4
new file mode 100644
index 00000000000..6a8b6ab78c0
--- /dev/null
+++ b/m4/utimens.m4
@@ -0,0 +1,50 @@
+dnl Copyright (C) 2003-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl serial 7
+
+AC_DEFUN([gl_UTIMENS],
+[
+ dnl Prerequisites of lib/utimens.c.
+ AC_REQUIRE([gl_FUNC_UTIMES])
+ AC_REQUIRE([gl_CHECK_TYPE_STRUCT_TIMESPEC])
+ AC_REQUIRE([gl_CHECK_TYPE_STRUCT_UTIMBUF])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+ AC_CHECK_FUNCS_ONCE([futimes futimesat futimens utimensat lutimes])
+
+ if test $ac_cv_func_futimens = no && test $ac_cv_func_futimesat = yes; then
+ dnl FreeBSD 8.0-rc2 mishandles futimesat(fd,NULL,time). It is not
+ dnl standardized, but Solaris implemented it first and uses it as
+ dnl its only means to set fd time.
+ AC_CACHE_CHECK([whether futimesat handles NULL file],
+ [gl_cv_func_futimesat_works],
+ [touch conftest.file
+ AC_RUN_IFELSE([AC_LANG_PROGRAM([[
+#include <stddef.h>
+#include <sys/times.h>
+#include <fcntl.h>
+]], [[ int fd = open ("conftest.file", O_RDWR);
+ if (fd < 0) return 1;
+ if (futimesat (fd, NULL, NULL)) return 2;
+ ]])],
+ [gl_cv_func_futimesat_works=yes],
+ [gl_cv_func_futimesat_works=no],
+ [case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_futimesat_works="guessing no" ;;
+ esac
+ ])
+ rm -f conftest.file])
+ case "$gl_cv_func_futimesat_works" in
+ *yes) ;;
+ *)
+ AC_DEFINE([FUTIMESAT_NULL_BUG], [1],
+ [Define to 1 if futimesat mishandles a NULL file name.])
+ ;;
+ esac
+ fi
+])
diff --git a/m4/utimes.m4 b/m4/utimes.m4
new file mode 100644
index 00000000000..417103a7b72
--- /dev/null
+++ b/m4/utimes.m4
@@ -0,0 +1,136 @@
+# Detect some bugs in glibc's implementation of utimes.
+# serial 3
+
+dnl Copyright (C) 2003-2005, 2009-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+# See if we need to work around bugs in glibc's implementation of
+# utimes from 2003-07-12 to 2003-09-17.
+# First, there was a bug that would make utimes set mtime
+# and atime to zero (1970-01-01) unconditionally.
+# Then, there was code to round rather than truncate.
+# Then, there was an implementation (sparc64, Linux-2.4.28, glibc-2.3.3)
+# that didn't honor the NULL-means-set-to-current-time semantics.
+# Finally, there was also a version of utimes that failed on read-only
+# files, while utime worked fine (linux-2.2.20, glibc-2.2.5).
+#
+# From Jim Meyering, with suggestions from Paul Eggert.
+
+AC_DEFUN([gl_FUNC_UTIMES],
+[
+ AC_CACHE_CHECK([whether the utimes function works],
+ [gl_cv_func_working_utimes],
+ [
+ AC_RUN_IFELSE([AC_LANG_SOURCE([[
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <sys/time.h>
+#include <time.h>
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <utime.h>
+
+static int
+inorder (time_t a, time_t b, time_t c)
+{
+ return a <= b && b <= c;
+}
+
+int
+main ()
+{
+ int result = 0;
+ char const *file = "conftest.utimes";
+ static struct timeval timeval[2] = {{9, 10}, {999999, 999999}};
+
+ /* Test whether utimes() essentially works. */
+ {
+ struct stat sbuf;
+ FILE *f = fopen (file, "w");
+ if (f == NULL)
+ result |= 1;
+ else if (fclose (f) != 0)
+ result |= 1;
+ else if (utimes (file, timeval) != 0)
+ result |= 2;
+ else if (lstat (file, &sbuf) != 0)
+ result |= 1;
+ else if (!(sbuf.st_atime == timeval[0].tv_sec
+ && sbuf.st_mtime == timeval[1].tv_sec))
+ result |= 4;
+ if (unlink (file) != 0)
+ result |= 1;
+ }
+
+ /* Test whether utimes() with a NULL argument sets the file's timestamp
+ to the current time. Use 'fstat' as well as 'time' to
+ determine the "current" time, to accommodate NFS file systems
+ if there is a time skew between the host and the NFS server. */
+ {
+ int fd = open (file, O_WRONLY|O_CREAT, 0644);
+ if (fd < 0)
+ result |= 1;
+ else
+ {
+ time_t t0, t2;
+ struct stat st0, st1, st2;
+ if (time (&t0) == (time_t) -1)
+ result |= 1;
+ else if (fstat (fd, &st0) != 0)
+ result |= 1;
+ else if (utimes (file, timeval) != 0)
+ result |= 2;
+ else if (utimes (file, NULL) != 0)
+ result |= 8;
+ else if (fstat (fd, &st1) != 0)
+ result |= 1;
+ else if (write (fd, "\n", 1) != 1)
+ result |= 1;
+ else if (fstat (fd, &st2) != 0)
+ result |= 1;
+ else if (time (&t2) == (time_t) -1)
+ result |= 1;
+ else
+ {
+ int m_ok_POSIX = inorder (t0, st1.st_mtime, t2);
+ int m_ok_NFS = inorder (st0.st_mtime, st1.st_mtime, st2.st_mtime);
+ if (! (st1.st_atime == st1.st_mtime))
+ result |= 16;
+ if (! (m_ok_POSIX || m_ok_NFS))
+ result |= 32;
+ }
+ if (close (fd) != 0)
+ result |= 1;
+ }
+ if (unlink (file) != 0)
+ result |= 1;
+ }
+
+ /* Test whether utimes() with a NULL argument works on read-only files. */
+ {
+ int fd = open (file, O_WRONLY|O_CREAT, 0444);
+ if (fd < 0)
+ result |= 1;
+ else if (close (fd) != 0)
+ result |= 1;
+ else if (utimes (file, NULL) != 0)
+ result |= 64;
+ if (unlink (file) != 0)
+ result |= 1;
+ }
+
+ return result;
+}
+ ]])],
+ [gl_cv_func_working_utimes=yes],
+ [gl_cv_func_working_utimes=no],
+ [gl_cv_func_working_utimes=no])])
+
+ if test $gl_cv_func_working_utimes = yes; then
+ AC_DEFINE([HAVE_WORKING_UTIMES], [1], [Define if utimes works properly. ])
+ fi
+])
diff --git a/m4/warnings.m4 b/m4/warnings.m4
new file mode 100644
index 00000000000..28b8294ef04
--- /dev/null
+++ b/m4/warnings.m4
@@ -0,0 +1,61 @@
+# warnings.m4 serial 7
+dnl Copyright (C) 2008-2012 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Simon Josefsson
+
+# gl_AS_VAR_APPEND(VAR, VALUE)
+# ----------------------------
+# Provide the functionality of AS_VAR_APPEND if Autoconf does not have it.
+m4_ifdef([AS_VAR_APPEND],
+[m4_copy([AS_VAR_APPEND], [gl_AS_VAR_APPEND])],
+[m4_define([gl_AS_VAR_APPEND],
+[AS_VAR_SET([$1], [AS_VAR_GET([$1])$2])])])
+
+
+# gl_COMPILER_OPTION_IF(OPTION, [IF-SUPPORTED], [IF-NOT-SUPPORTED],
+# [PROGRAM = AC_LANG_PROGRAM()])
+# -----------------------------------------------------------------
+# Check if the compiler supports OPTION when compiling PROGRAM.
+#
+# FIXME: gl_Warn must be used unquoted until we can assume Autoconf
+# 2.64 or newer.
+AC_DEFUN([gl_COMPILER_OPTION_IF],
+[AS_VAR_PUSHDEF([gl_Warn], [gl_cv_warn_[]_AC_LANG_ABBREV[]_$1])dnl
+AS_VAR_PUSHDEF([gl_Flags], [_AC_LANG_PREFIX[]FLAGS])dnl
+AC_CACHE_CHECK([whether _AC_LANG compiler handles $1], m4_defn([gl_Warn]), [
+ gl_save_compiler_FLAGS="$gl_Flags"
+ gl_AS_VAR_APPEND(m4_defn([gl_Flags]), [" $1"])
+ AC_COMPILE_IFELSE([m4_default([$4], [AC_LANG_PROGRAM([])])],
+ [AS_VAR_SET(gl_Warn, [yes])],
+ [AS_VAR_SET(gl_Warn, [no])])
+ gl_Flags="$gl_save_compiler_FLAGS"
+])
+AS_VAR_IF(gl_Warn, [yes], [$2], [$3])
+AS_VAR_POPDEF([gl_Flags])dnl
+AS_VAR_POPDEF([gl_Warn])dnl
+])
+
+
+# gl_WARN_ADD(OPTION, [VARIABLE = WARN_CFLAGS],
+# [PROGRAM = AC_LANG_PROGRAM()])
+# ---------------------------------------------
+# Adds parameter to WARN_CFLAGS if the compiler supports it when
+# compiling PROGRAM. For example, gl_WARN_ADD([-Wparentheses]).
+#
+# If VARIABLE is a variable name, AC_SUBST it.
+AC_DEFUN([gl_WARN_ADD],
+[gl_COMPILER_OPTION_IF([$1],
+ [gl_AS_VAR_APPEND(m4_if([$2], [], [[WARN_CFLAGS]], [[$2]]), [" $1"])],
+ [],
+ [$3])
+m4_ifval([$2],
+ [AS_LITERAL_IF([$2], [AC_SUBST([$2])])],
+ [AC_SUBST([WARN_CFLAGS])])dnl
+])
+
+# Local Variables:
+# mode: autoconf
+# End:
diff --git a/m4/wchar_t.m4 b/m4/wchar_t.m4
index d2c03c42d2b..534735d8c63 100644
--- a/m4/wchar_t.m4
+++ b/m4/wchar_t.m4
@@ -1,5 +1,5 @@
# wchar_t.m4 serial 4 (gettext-0.18.2)
-dnl Copyright (C) 2002-2003, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2003, 2008-2012 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/make-dist b/make-dist
index ebbb11e87cc..7a17fa02372 100755
--- a/make-dist
+++ b/make-dist
@@ -1,7 +1,7 @@
#!/bin/sh
### make-dist: create an Emacs distribution tar file from current srcdir
-## Copyright (C) 1995, 1997-1998, 2000-2011 Free Software Foundation, Inc.
+## Copyright (C) 1995, 1997-1998, 2000-2012 Free Software Foundation, Inc.
## This file is part of GNU Emacs.
@@ -147,7 +147,7 @@ fi
### Find out which version of Emacs this is.
version=`
- sed -n 's/^AC_INIT(emacs,[ ]*\([^ )]*\).*/\1/p' <configure.in
+ sed -n 's/^AC_INIT(emacs,[ ]*\([^ )]*\).*/\1/p' <configure.ac
` || version=
if [ ! "${version}" ]; then
echo "${progname}: can't find current Emacs version in \`./src/emacs.c'" >&2
@@ -230,35 +230,24 @@ fi
if [ $update = yes ]; then
- ## Make sure configure is newer than configure.in.
- if [ "x`ls -t configure configure.in | sed q`" != "xconfigure" ]; then
- echo "\`./configure.in' is newer than \`./configure'" >&2
- echo "Running autoconf" >&2
- autoconf || { x=$?; echo Autoconf FAILED! >&2; exit $x; }
- fi
+ ## Make sure configure is newer than configure.ac, etc.
+ ## It is better to let autoreconf do what is needed than
+ ## for us to try and duplicate all its checks.
+ echo "Running autoreconf"
+ autoreconf -i -I m4 || { x=$?; echo Autoreconf FAILED! >&2; exit $x; }
- ## Make sure src/stamp-h.in is newer than configure.in.
- if [ "x`ls -t src/stamp-h.in configure.in | sed q`" != "xsrc/stamp-h.in" ]; then
- echo "\`./configure.in' is newer than \`./src/stamp-h.in'" >&2
- echo "Running autoheader" >&2
- autoheader || { x=$?; echo Autoheader FAILED! >&2; exit $x; }
- rm -f src/stamp-h.in
- echo timestamp > src/stamp-h.in
- fi
+ ## Make sure src/stamp-h.in is newer than configure.ac.
+ rm -f src/stamp-h.in
+ echo timestamp > src/stamp-h.in
echo "Updating Info files"
- (cd doc/emacs; make info)
- (cd doc/misc; make info)
- (cd doc/lispref; make info)
- (cd doc/lispintro; make info)
+ make info-real
echo "Updating finder, custom and autoload data"
- (cd lisp; make updates EMACS="$EMACS")
+ (cd lisp && make updates EMACS="$EMACS")
- if test -f leim/leim-list.el; then
- echo "Updating leim-list.el"
- (cd leim; make leim-list.el EMACS="$EMACS")
- fi
+ echo "Updating leim-list.el"
+ (cd leim && make leim-list.el EMACS="$EMACS")
echo "Recompiling Lisp files"
$EMACS -batch -f batch-byte-recompile-directory lisp leim
@@ -284,8 +273,8 @@ mkdir ${tempdir}
### README while the rest of the tar file is still unpacking. Whoopee.
echo "Making links to top-level files"
ln INSTALL README BUGS ${tempdir}
-ln ChangeLog Makefile.in configure configure.in ${tempdir}
-ln config.bat make-dist update-subdirs vpath.sed .dir-locals.el ${tempdir}
+ln ChangeLog Makefile.in autogen.sh configure configure.ac ${tempdir}
+ln config.bat make-dist .dir-locals.el ${tempdir}
ln aclocal.m4 ${tempdir}
echo "Creating subdirectories"
@@ -293,15 +282,15 @@ for subdir in site-lisp \
leim leim/CXTERM-DIC leim/MISC-DIC \
leim/SKK-DIC leim/ja-dic leim/quail \
build-aux build-aux/snippet \
- src src/m src/s src/bitmaps lib lib-src oldXMenu lwlib \
+ src src/bitmaps lib lib-src oldXMenu lwlib \
nt nt/inc nt/inc/sys nt/inc/arpa nt/inc/netinet nt/icons \
`find etc lisp admin -type d` \
doc doc/emacs doc/misc doc/man doc/lispref doc/lispintro \
info m4 msdos \
- nextstep nextstep/Cocoa nextstep/Cocoa/Emacs.base \
+ nextstep nextstep/templates \
+ nextstep/Cocoa nextstep/Cocoa/Emacs.base \
nextstep/Cocoa/Emacs.base/Contents \
nextstep/Cocoa/Emacs.base/Contents/Resources \
- nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj \
nextstep/GNUstep \
nextstep/GNUstep/Emacs.base \
nextstep/GNUstep/Emacs.base/Resources
@@ -346,7 +335,7 @@ echo "Making links to \`leim' and its subdirectories"
echo "Making links to \`build-aux'"
(cd build-aux
ln compile config.guess config.sub depcomp ../${tempdir}/build-aux
- ln install-sh missing move-if-change ../${tempdir}/build-aux)
+ ln install-sh missing move-if-change update-subdirs ../${tempdir}/build-aux)
echo "Making links to \`build-aux/snippet'"
(cd build-aux/snippet
@@ -370,14 +359,6 @@ echo "Making links to \`src/bitmaps'"
(cd src/bitmaps
ln README *.xbm ../../${tempdir}/src/bitmaps)
-echo "Making links to \`src/m'"
-(cd src/m
- ln README [a-zA-Z0-9]*.h ../../${tempdir}/src/m)
-
-echo "Making links to \`src/s'"
-(cd src/s
- ln README [a-zA-Z0-9]*.h ../../${tempdir}/src/s)
-
echo "Making links to \`lib'"
(snippet_h=`(cd build-aux/snippet && ls *.h)`
cd lib
@@ -390,21 +371,20 @@ echo "Making links to \`lib'"
echo "Making links to \`lib-src'"
(cd lib-src
ln [a-zA-Z]*.[ch] ../${tempdir}/lib-src
- ln ChangeLog Makefile.in README testfile vcdiff ../${tempdir}/lib-src
- ln grep-changelog rcs2log rcs-checkin ../${tempdir}/lib-src
+ ln ChangeLog Makefile.in README testfile ../${tempdir}/lib-src
+ ln grep-changelog rcs2log ../${tempdir}/lib-src
ln makefile.w32-in ../${tempdir}/lib-src)
echo "Making links to \`m4'"
(cd m4
ln *.m4 ../${tempdir}/m4)
-## Exclude README.W32 because it is specific to pre-built binaries(?).
echo "Making links to \`nt'"
(cd nt
ln emacs.manifest emacs.rc emacsclient.rc config.nt ../${tempdir}/nt
ln emacs-src.tags nmake.defs gmake.defs subdirs.el ../${tempdir}/nt
ln [a-z]*.bat [a-z]*.[ch] ../${tempdir}/nt
- ln ChangeLog INSTALL README makefile.w32-in ../${tempdir}/nt)
+ ln ChangeLog INSTALL README README.W32 makefile.w32-in ../${tempdir}/nt)
echo "Making links to \`nt/inc' and its subdirectories"
for f in `find nt/inc -type f -name '[a-z]*.h'`; do
@@ -424,23 +404,23 @@ echo "Making links to \`msdos'"
echo "Making links to \`nextstep'"
(cd nextstep
- ln ChangeLog README INSTALL ../${tempdir}/nextstep)
+ ln ChangeLog README INSTALL Makefile.in ../${tempdir}/nextstep)
+
+echo "Making links to \`nextstep/templates'"
+(cd nextstep/templates
+ ln Emacs.desktop.in Info-gnustep.plist.in Info.plist.in InfoPlist.strings.in ../../${tempdir}/nextstep/templates)
echo "Making links to \`nextstep/Cocoa/Emacs.base/Contents'"
(cd nextstep/Cocoa/Emacs.base/Contents
- ln Info.plist PkgInfo ../../../../${tempdir}/nextstep/Cocoa/Emacs.base/Contents)
+ ln PkgInfo ../../../../${tempdir}/nextstep/Cocoa/Emacs.base/Contents)
echo "Making links to \`nextstep/Cocoa/Emacs.base/Contents/Resources'"
(cd nextstep/Cocoa/Emacs.base/Contents/Resources
ln Credits.html *.icns ../../../../../${tempdir}/nextstep/Cocoa/Emacs.base/Contents/Resources)
-echo "Making links to \`nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj'"
-(cd nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj
- ln InfoPlist.strings ../../../../../../${tempdir}/nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj)
-
echo "Making links to \`nextstep/GNUstep/Emacs.base/Resources'"
(cd nextstep/GNUstep/Emacs.base/Resources
- ln Emacs.desktop Info-gnustep.plist README emacs.tiff ../../../../${tempdir}/nextstep/GNUstep/Emacs.base/Resources )
+ ln README emacs.tiff ../../../../${tempdir}/nextstep/GNUstep/Emacs.base/Resources )
echo "Making links to \`oldXMenu'"
(cd oldXMenu
@@ -479,8 +459,8 @@ echo "Making links to \`doc/misc'"
echo "Making links to \`doc/lispref'"
(cd doc/lispref
ln *.texi *.in makefile.w32-in README ChangeLog* ../../${tempdir}/doc/lispref
- ln *.txt *.el spellfile tindex.pl ../../${tempdir}/doc/lispref
- ln two-volume.make ../../${tempdir}/doc/lispref)
+ ln spellfile ../../${tempdir}/doc/lispref
+ ln two-volume.make two-volume-cross-refs.txt ../../${tempdir}/doc/lispref)
echo "Making links to \`doc/lispintro'"
(cd doc/lispintro
diff --git a/msdos/ChangeLog b/msdos/ChangeLog
index eeb363e951f..753931ae097 100644
--- a/msdos/ChangeLog
+++ b/msdos/ChangeLog
@@ -1,3 +1,181 @@
+2012-11-24 Ken Brown <kbrown@cornell.edu>
+
+ * sed2v2.inp (HAVE_MOUSE): Remove.
+
+2012-11-03 Eli Zaretskii <eliz@gnu.org>
+
+ * sedlibmk.inp: Sync with changes in lib/Makefile.in.
+ (HAVE_DECL_ENVIRON, GNULIB_ENVIRON): Edit to require declaration
+ through lib/unistd.h.
+
+ * sed1v2.inp: Sync with changes in src/Makefile.in.
+
+ * sed2v2.inp: Sync with changes in src/config.in.
+
+2012-10-08 Eli Zaretskii <eliz@gnu.org>
+
+ * sed1v2.inp (W32_LIBS, W32_OBJ): Edit to empty.
+
+2012-10-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib.
+ * msdos/sedlibmk.inp (REPLACE_PTSNAME): Edit to appropriate value.
+
+2012-09-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Check more robustly for timer_settime.
+ * sed1v2.inp, sed3v2.inp (LIB_TIMER_TIME): New macro.
+
+2012-08-04 Eli Zaretskii <eliz@gnu.org>
+
+ * sedlibmk.inp (allocator.$(OBJEXT), careadlinkat.$(OBJEXT)): Fix
+ editing out.
+
+ * sed2v2.inp (IS_DEVICE_SEP): Edit to match ':'.
+ (IS_DIRECTORY_SEP, INTERNAL_TERMINAL): Fix Sed command syntax.
+ (MSDOS): Define only if undefined, as MSDOS is a built-in macro,
+ unless some std= switch to GCC is used.
+
+2012-08-01 Glenn Morris <rgm@gnu.org>
+
+ * sed2v2.inp (HAVE_WCHAR_H): Fix typo.
+
+ * sed2v2.inp (MSDOS, DOS_NT, FLOAT_CHECK_DOMAIN)
+ (HAVE_INVERSE_HYPERBOLIC, DEVICE_SEP, IS_DIRECTORY_SEP, IS_ANY_SEP)
+ (INTERNAL_TERMINAL, NULL_DEVICE, SEPCHAR, USER_FULL_NAME)
+ (_setjmp, _longjmp): Move here from src/s/msdos.h.
+ (config_opsysfile, config_machfile): Remove.
+ * sed1v2.inp (M_FILE, S_FILE): Remove.
+ * mainmake.v2 (TAGS, tags): Remove src/s/msdos.h.
+
+2012-07-31 Glenn Morris <rgm@gnu.org>
+
+ * sed1v2.inp (S_FILE): Update for format change.
+
+2012-07-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use Gnulib stdalign module (Bug#9772, Bug#9960).
+ * sed2v2.inp (HAVE_ATTRIBUTE_ALIGNED): Remove edit.
+ * sedlibmk.inp (STDALIGN_H, @GL_GENERATE_STDALIGN_H_TRUE@)
+ (GL_GENERATE_STDALIGN_H_FALSE): New edits.
+
+2012-07-14 Eli Zaretskii <eliz@gnu.org>
+
+ * sed1v2.inp: In the recipe for $(leimdir)/leim-list.el, edit the
+ prerequisites to be "temacs$(EXEEXT) $(BOOTSTRAPEMACS)", to avoid
+ the need to rebuild $(bootstrap_exe), which requires a Unixy shell
+ via lisp/Makefile.in's "update-subdirs" command.
+
+ * sedlibmk.inp (am_libgnu_a_OBJECTS): Adjust the removal of
+ careadlinkat.$(OBJEXT) to the changes in lib/Makefile.in.
+
+ * sed2v2.inp (DATA_START, GC_SETJMP_WORKS, HAVE_MENUS)
+ (HAVE_MOUSE): Edit for DJGPP, according to what was previously
+ done on src/s/msdos.h.
+
+2012-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ * mainmake.v2 (bootstrap-clean): Do a maintainer-clean in lib, not
+ bootstrap-clean (which doesn't exist).
+
+ * inttypes.h (PRIuMAX) [__DJGPP__ < 2.04]: Define to "llu".
+
+ * sedleim.inp (MKDIR_P): Edit to DOS "md" command.
+
+ * sed1v2.inp (LIB_CLOCK_GETTIME): Edit to empty.
+ Remove lines that invoke PAXCTL.
+ (clean): Fix recipe not to run Unixy shell commands.
+
+ * sed2v2.inp (GETTIMEOFDAY_TIMEZONE): Edit to 'struct timezone'.
+ (HAVE_STRNCASECMP): Edit to 1.
+
+ * sed3v2.inp (LIB_CLOCK_GETTIME): Edit to empty.
+ (C_SWITCH_SYSTEM): Add "-I../msdos".
+
+ * sedlibmk.inp (GNULIB_GETTIMEOFDAY, GNULIB_PSELECT)
+ (GNULIB_SELECT, HAVE_STRUCT_TIMEVAL, HAVE_SYS_SELECT_H)
+ (HAVE_SYS_TIME_H, NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H)
+ (NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H, NEXT_SYS_SELECT_H)
+ (NEXT_SYS_TIME_H, REPLACE_GETTIMEOFDAY, REPLACE_PSELECT)
+ (REPLACE_STRUCT_TIMEVAL): Edit to appropriate values.
+ (BUILT_SOURCES): Edit out sys/select.h and sys/time.h.
+ (mostlyclean-local, distclean-generic): Fix recipe not to run
+ Unixy shell commands.
+
+2012-06-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clean out last vestiges of the old HAVE_CONFIG_H stuff.
+ * sedlibmk.inp (DEFS): Don't add -DHAVE_CONFIG_H.
+
+2012-06-11 Glenn Morris <rgm@gnu.org>
+
+ * sed2v2.inp (SYSTEM_TYPE): Set it.
+
+2012-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ * sedlibmk.inp (GNULIB_GL_UNISTD_H_GETOPT, GNULIB_POSIX_OPENPT)
+ (GNULIB_ISATTY, GNULIB_PTSNAME_R, GNULIB_RANDOM)
+ (GNULIB_SETHOSTNAME, HAVE_POSIX_OPENPT, HAVE_PTSNAME_R)
+ (HAVE_RANDOM, HAVE_SETHOSTNAME, NEXT_SYS_TYPES_H)
+ (NEXT_AS_FIRST_DIRECTIVE_SYS_TYPES_H, REPLACE_FTRUNCATE)
+ (REPLACE_ISATTY, REPLACE_PTSNAME_R, REPLACE_RANDOM_R)
+ (REPLACE_STRTOIMAX, STDALIGN_H, WINDOWS_64_BIT_OFF_T)
+ (WINDOWS_64_BIT_ST_SIZE, GL_GENERATE_STDALIGN_H_TRUE)
+ (GL_GENERATE_STDALIGN_H_FALSE): Edit as appropriate for DJGPP.
+ (cat FOO): Edit into "sed -e '' FOO >>".
+
+2012-05-25 Eli Zaretskii <eliz@gnu.org>
+
+ * sed6.inp (INFO_EXT): Edit to .info.
+ (INFO_OPTS): Edit to --no-split.
+
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove src/m/*.
+ * mainmake.v2 (TAGS tags): Don't look at $(CURDIR)/src/m/intel386.h.
+
+2012-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sed2v2.inp (HAVE_MBLEN): Remove.
+ * sed2x.inp (HAVE_XSETWMPROTOCOLS): Remove.
+
+2012-04-21 Eli Zaretskii <eliz@gnu.org>
+
+ * sedleim.inp (RUN_EMACS): Replace BUILT_EMACS with EMACS.
+ Remove stale editing of "else make quail".
+ (.PHONY, compile-targets): Remove targets.
+ (compile-main): Edit into something that can be done without
+ requiring a Unixy shell.
+ (bootstrap-clean): Likewise: edit to not require $(setwins).
+
+ * sed1v2.inp: Edit "cd $(leimdir) && $(MAKE) ..." into the
+ equivalent "$(MAKE) $(MFLAGS) -C $(leimdir) ..." command.
+
+2012-04-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ configure: new option --enable-gcc-warnings (Bug#11207)
+ * sed1v2.inp, sed3v2.inp, sedlibmk.inp: GNULIB_WARN_CFLAGS,
+ WARN_CFLAGS, and WERROR_CFLAGS replace C_WARNINGS_SWITCH.
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * sedlibmk.inp, sed1v2.inp: GNUSTEP_CFLAGS replaces C_SWITCH_X_SYSTEM.
+
+2012-04-07 Glenn Morris <rgm@gnu.org>
+
+ * sed2v2.inp: Bump version to 24.1.50.
+
+2012-02-04 Eli Zaretskii <eliz@gnu.org>
+
+ * sed3v2.inp (insrcdir): Use $(<F) rather than $<, as
+ command.com's "if not exist" doesn't grok forward slashes in file
+ names.
+
+2012-01-14 Eli Zaretskii <eliz@gnu.org>
+
+ * sed4.inp (PATH_DUMPLOADSEARCH): Edit to "../lisp", for when the
+ default in src/epaths.in will change, maybe.
+
2011-10-31 Eli Zaretskii <eliz@gnu.org>
* sed3v2.inp (insrcdir): Comment out definition.
@@ -637,7 +815,7 @@
b-emacs.exe to 3072K.
* mainmake.v2 (emacs lispref lispintro): Chdir under doc/.
- (emacs): Renamed from `man', to reflect changes in doc directory
+ (emacs): Rename from `man', to reflect changes in doc directory
structure. All callers changed.
(clean mostlyclean distclean maintainer-clean extraclean): Chdir
into doc/ for manuals. Add misc subdirectory.
@@ -1092,7 +1270,7 @@
1996-08-04 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
- * is_exec.c: Renamed from is-exec.c.
+ * is_exec.c: Rename from is-exec.c.
1996-07-27 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -1127,7 +1305,7 @@
* mainmake.v2 (src): Create a file with sed commands instead of using
a long sed command line (some versions of Sed don't handle that).
- (gdb): Merged back into src, undoing April 13 change.
+ (gdb): Merge back into src, undoing April 13 change.
(install): Do use if statements, but not a loop.
1996-04-13 Richard Stallman <rms@mole.gnu.ai.mit.edu>
@@ -1297,7 +1475,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1994-1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1994-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/msdos/INSTALL b/msdos/INSTALL
index 3d5a2fc646a..6915b48ae9a 100644
--- a/msdos/INSTALL
+++ b/msdos/INSTALL
@@ -1,6 +1,6 @@
GNU Emacs Installation Guide for the DJGPP (a.k.a. MS-DOS) port
-Copyright (C) 1992, 1994, 1996-1997, 2000-2011 Free Software Foundation, Inc.
+Copyright (C) 1992, 1994, 1996-1997, 2000-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
The DJGPP port of GNU Emacs builds and runs on plain DOS and also on
diff --git a/msdos/README b/msdos/README
index 532d18726c6..6e7c872ff3f 100644
--- a/msdos/README
+++ b/msdos/README
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -10,7 +10,7 @@ The files emacs.ico and emacs.pif are for using the DJGPP version on
Windows 3.X. Since these are binary files, their copyright notice is
reproduced here:
-# Copyright (C) 1993, 2002-2011 Free Software Foundation, Inc.
+# Copyright (C) 1993, 2002-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/depfiles.bat b/msdos/depfiles.bat
index 901a53cbb0d..049f1c3602c 100644
--- a/msdos/depfiles.bat
+++ b/msdos/depfiles.bat
@@ -1,7 +1,7 @@
@echo off
rem ----------------------------------------------------------------------
rem Auxiliary script for MSDOS, run by ../config.bat
-rem Copyright (C) 2011 Free Software Foundation, Inc.
+rem Copyright (C) 2011-2012 Free Software Foundation, Inc.
rem This file is part of GNU Emacs.
diff --git a/msdos/inttypes.h b/msdos/inttypes.h
index 2c9b2b2cd11..dba56f83760 100644
--- a/msdos/inttypes.h
+++ b/msdos/inttypes.h
@@ -1,6 +1,6 @@
/* Replacement inntypes.h file for building GNU Emacs on MS-DOS with DJGPP.
-Copyright (C) 2011 Free Software Foundation, Inc.
+Copyright (C) 2011-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -31,6 +31,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <stdlib.h>
#define strtoumax strtoull
#define strtoimax strtoll
+#define PRIuMAX "llu"
#endif /* __DJGPP__ < 2.04 */
#endif
diff --git a/msdos/mainmake.v2 b/msdos/mainmake.v2
index 3b65fcc5ea4..3df6ca17827 100644
--- a/msdos/mainmake.v2
+++ b/msdos/mainmake.v2
@@ -1,6 +1,6 @@
# Top-level Makefile for Emacs under MS-DOS/DJGPP v2.0 or higher. -*-makefile-*-
-# Copyright (C) 1996-2011 Free Software Foundation, Inc.
+# Copyright (C) 1996-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -161,8 +161,7 @@ TAGS tags: lib-src FRC
cd src
../bin/etags --include=../lisp/TAGS \
--regex='/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/' \
- $(CURDIR)/src/*.c $(CURDIR)/src/*.h \
- $(CURDIR)/src/s/msdos.h $(CURDIR)/src/m/intel386.h
+ $(CURDIR)/src/*.c $(CURDIR)/src/*.h
cd ..
./bin/etags --include=src/TAGS
@@ -269,7 +268,7 @@ extraclean:
bootstrap-clean: FRC
cd lib
- $(MAKE) $(MFLAGS) $@
+ -$(MAKE) $(MFLAGS) maintainer-clean
cd ..
cd src
$(MAKE) $(MFLAGS) $@
@@ -299,4 +298,3 @@ bootstrap-clean: FRC
bootstrap: bootstrap-clean FRC
command.com /e:2048 /c config msdos
$(MAKE) $(MFLAGS) info all
-
diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp
index d92fd1340ab..84f24bf2c1a 100644
--- a/msdos/sed1v2.inp
+++ b/msdos/sed1v2.inp
@@ -2,7 +2,7 @@
# Configuration script for src/Makefile under DJGPP v2.x
# ----------------------------------------------------------------------
#
-# Copyright (C) 1996-1997, 1999-2011 Free Software Foundation, Inc.
+# Copyright (C) 1996-1997, 1999-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
@@ -39,9 +39,10 @@ s/\.h\.in/.h-in/
/^LIBOBJS *=/s/@[^@\n]*@//
/^C_SWITCH_MACHINE *=/s/@C_SWITCH_MACHINE@//
/^C_SWITCH_SYSTEM *=/s/@C_SWITCH_SYSTEM@//
-/^C_SWITCH_X_SYSTEM *=/s/@C_SWITCH_X_SYSTEM@//
+/^GNUSTEP_CFLAGS *=/s/@GNUSTEP_CFLAGS@//
/^C_SWITCH_X_SITE *=/s/@C_SWITCH_X_SITE@//
-/^C_WARNINGS_SWITCH *=/s/@C_WARNINGS_SWITCH@//
+/^WARN_CFLAGS *=/s/@WARN_CFLAGS@//
+/^WERROR_CFLAGS *=/s/@WERROR_CFLAGS@//
/^PROFILING_CFLAGS *=/s/@PROFILING_CFLAGS@//
#/^LD_SWITCH_X_SITE *=/s/@LD_SWITCH_X_SITE@//
/^LD_SWITCH_SYSTEM_TEMACS *=/s/@LD_SWITCH_SYSTEM_TEMACS@//
@@ -54,11 +55,11 @@ s/\.h\.in/.h-in/
/^LIB_STANDARD *=/s/@LIB_STANDARD@//
/^LIB_MATH *=/s/@LIB_MATH@/-lm/
/^LIB_PTHREAD *=/s/@LIB_PTHREAD@//
-/^LIBTIFF *=/s/@LIBTIFF@//
-/^LIBJPEG *=/s/@LIBJPEG@//
-/^LIBPNG *=/s/@LIBPNG@//
-/^LIBGIF *=/s/@LIBGIF@//
-/^LIBXPM *=/s/@LIBXPM@//
+s/ *@LIBTIFF@//
+s/ *@LIBJPEG@//
+s/ *@LIBPNG@//
+s/ *@LIBGIF@//
+s/ *@LIBXPM@//
/^XFT_LIBS *=/s/@XFT_LIBS@//
/^FONTCONFIG_CFLAGS *=/s/@FONTCONFIG_CFLAGS@//
/^FONTCONFIG_LIBS *=/s/@FONTCONFIG_LIBS@//
@@ -94,16 +95,17 @@ s/\.h\.in/.h-in/
/^LIBXML2_CFLAGS *=/s/@LIBXML2_CFLAGS@//
/^WIDGET_OBJ *=/s/@WIDGET_OBJ@//
/^CYGWIN_OBJ *=/s/@CYGWIN_OBJ@//
+/^WINDOW_SYSTEM_OBJ *=/s/@WINDOW_SYSTEM_OBJ@//
/^MSDOS_OBJ *=/s/= */= dosfns.o msdos.o w16select.o/
-/^ns_appdir *=/s/@ns_appdir@//
-/^ns_appbindir *=/s/@ns_appbindir@//
-/^ns_appsrc *=/s/@ns_appsrc@//
/^NS_OBJ *=/s/@NS_OBJ@//
/^NS_OBJC_OBJ *=/s/@NS_OBJC_OBJ@//
/^GNU_OBJC_CFLAGS*=/s/@GNU_OBJC_CFLAGS@//
/^LIBRESOLV *=/s/@LIBRESOLV@//
/^LIBSELINUX_LIBS *=/s/@LIBSELINUX_LIBS@//
/^LIB_PTHREAD_SIGMASK *=/s/@[^@\n]*@//
+/^LIB_CLOCK_GETTIME *=/s/@[^@\n]*@//g
+/^LIB_TIMER_TIME *=/s/@[^@\n]*@//g
+/^LIB_EXECINFO *=/s/@[^@\n]*@//g
/^LIBGNUTLS_LIBS *=/s/@[^@\n]*@//
/^LIBGNUTLS_CFLAGS *=/s/@[^@\n]*@//
/^GETLOADAVG_LIBS *=/s/@[^@\n]*@//
@@ -125,18 +127,22 @@ s/\.h\.in/.h-in/
/^CANNOT_DUMP *=/s/@CANNOT_DUMP@/no/
/^DEPFLAGS *=/s/@DEPFLAGS@//
/^MKDEPDIR *=/s/@MKDEPDIR@//
+/^W32_OBJ *=/s/@W32_OBJ@//
+/^W32_LIBS *=/s/@W32_LIBS@//
/^version *=/s/@[^@\n]*@//
-/^M_FILE *=/s!@M_FILE@!$(srcdir)/m/intel386.h!
-/^S_FILE *=/s!@S_FILE@!$(srcdir)/s/msdos.h!
/^@SET_MAKE@$/s/@SET_MAKE@//
/^ [ ]*\$(libsrc)\/make-docfile.*>.*\/DOC/s!make-docfile!make-docfile -o $(etc)/DOC!
/^ [ ]*\$(libsrc)\/make-docfile.*>.*gl-tmp/s!make-docfile!make-docfile -o gl-tmp!
/^.\$(libsrc)\/make-doc/s!>.*$!!
/^ [ ]*\$(libsrc)\/make-docfile /s!`[^`]*`!$(lisp); cd ../src!
/^[ ]*$/d
+/^\$(leimdir)\/leim-list.el: /s/bootstrap-emacs\$(EXEEXT)/temacs$(EXEEXT) $(BOOTSTRAPEMACS)/
/^ if test -f/,/^ fi$/c\
command.com /c if exist .gdbinit rm -f _gdbinit
+/^ *test "X\$(PAXCTL)" = X/d
+/^ *test "\$(CANNOT_DUMP)" = "yes"/d
/^ if test "\$(CANNOT_DUMP)" =/,/^ else /d
+/^ -\{0,1\} *ln /s/bootstrap-emacs\$(EXEEXT).*$/bootstrap-emacs$(EXEEXT)/
/^ fi/d
/^ *LC_ALL=C \$(RUN_TEMACS)/i\
stubedit temacs.exe minstack=1024k
@@ -151,6 +157,8 @@ s/^ [^ ]*move-if-change / update /
/^ echo[ ][ ]*timestamp/s/echo /djecho /
/^ .*djecho timestamp/a\
@rm -f gl-tmp
+/^ cd \$(leimdir) && \$(MAKE)/c\
+ $(MAKE) $(MFLAGS) -C $(leimdir) leim-list.el EMACS=$(bootstrap_exe)
/^ cd \$(lib) && \$(MAKE)/c\
$(MAKE) $(MFLAGS) -C $(lib) libgnu.a
/^RUN_TEMACS *=/s|`/bin/pwd`|.|
@@ -161,7 +169,7 @@ s/^ [^ ]*move-if-change / update /
/^ #/d
/^ cd.*make-docfile/s!$!; cd ../src!
/^ @: /d
-/^ -\{0,1\} *ln -/s/ln -f/cp -pf/
+/^ -\{0,1\} *ln /s/ln /cp /
/^[ ]touch /s/touch/djecho $@ >/
s/@YMF_PASS_LDFLAGS@/flags/
s/@lisp_frag@//
@@ -186,7 +194,7 @@ s/echo.*buildobj.lst/dj&/
/^ *THEFILE=/s|$|\; cd ../src|
/^ echo.* buildobj.h/s|echo |djecho |
# Make the GCC command line fit one screen line
-/^[ ][ ]*\$(C_SWITCH_X_SYSTEM)/d
+/^[ ][ ]*\$(GNUSTEP_CFLAGS)/d
/^[ ][ ]*\$(GCONF_CFLAGS)/d
/^[ ][ ]*\$(LIBGNUTLS_CFLAGS)/d
s/\$(LIBOTF_CFLAGS) \$(M17N_FLT_CFLAGS) \$(DEPFLAGS) //
@@ -195,3 +203,4 @@ s/ \$(DBUS_CFLAGS)//
s| -I\$(srcdir)/../lib||
# Add our local inttypes.h to prerequisites where needed
/^lread\.o:/s|lread\.c|& ../msdos/inttypes.h|
+/^ *test "X/d
diff --git a/msdos/sed1x.inp b/msdos/sed1x.inp
index d0a37807d9e..638c9450848 100644
--- a/msdos/sed1x.inp
+++ b/msdos/sed1x.inp
@@ -2,7 +2,7 @@
# Extra configuration script for src/makefile for DesqView/X
# ----------------------------------------------------------------------
#
-# Copyright (C) 1994-1997, 1999-2011 Free Software Foundation, Inc.
+# Copyright (C) 1994-1997, 1999-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp
index 6cbeadc0bba..d03d4ced9d9 100644
--- a/msdos/sed2v2.inp
+++ b/msdos/sed2v2.inp
@@ -2,7 +2,7 @@
# Configuration script for src/config.h under DJGPP v2.x
# ----------------------------------------------------------------------
#
-# Copyright (C) 1993-1997, 1999-2000, 2002-2011 Free Software Foundation, Inc.
+# Copyright (C) 1993-1997, 1999-2000, 2002-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
@@ -26,40 +26,51 @@
#define NSIG 320\
#endif
+/^#undef MSDOS *$/c\
+#ifndef MSDOS\
+#define MSDOS\
+#endif
+/^#undef COPYRIGHT *$/s/^.*$/#define COPYRIGHT "Copyright (C) 2012 Free Software Foundation, Inc."/
+/^#undef DIRECTORY_SEP *$/s!^.*$!#define DIRECTORY_SEP '/'!
+/^#undef DOS_NT *$/s/^.*$/#define DOS_NT/
+/^#undef FLOAT_CHECK_DOMAIN *$/s/^.*$/#define FLOAT_CHECK_DOMAIN/
/^#undef HAVE_ALLOCA *$/s/^.*$/#define HAVE_ALLOCA 1/
/^#undef HAVE_SETITIMER *$/s/^.*$/#define HAVE_SETITIMER 1/
/^#undef HAVE_STRUCT_UTIMBUF *$/s/^.*$/#define HAVE_STRUCT_UTIMBUF 1/
/^#undef LOCALTIME_CACHE *$/s/^.*$/#define LOCALTIME_CACHE 1/
/^#undef HAVE_TZSET *$/s/^.*$/#define HAVE_TZSET 1/
-/^#undef HAVE_LOGB *$/s/^.*$/#define HAVE_LOGB 1/
-/^#undef HAVE_FREXP *$/s/^.*$/#define HAVE_FREXP 1/
-/^#undef HAVE_FMOD *$/s/^.*$/#define HAVE_FMOD 1/
/^#undef HAVE_RINT *$/s/^.*$/#define HAVE_RINT 1/
-/^#undef HAVE_ATTRIBUTE_ALIGNED *$/s/^.*$/#define HAVE_ATTRIBUTE_ALIGNED 1/
/^#undef HAVE_C99_STRTOLD *$/s/^.*$/#define HAVE_C99_STRTOLD 1/
-/^#undef HAVE_CBRT *$/s/^.*$/#define HAVE_CBRT 1/
/^#undef HAVE_DIFFTIME *$/s/^.*$/#define HAVE_DIFFTIME 1/
/^#undef HAVE_FPATHCONF *$/s/^.*$/#define HAVE_FPATHCONF 1/
/^#undef HAVE_MEMSET *$/s/^.*$/#define HAVE_MEMSET 1/
/^#undef HAVE_MEMCMP *$/s/^.*$/#define HAVE_MEMCMP 1/
/^#undef HAVE_MEMMOVE *$/s/^.*$/#define HAVE_MEMMOVE 1/
+/^#undef HAVE_SETPGID *$/s/^.*$/#define HAVE_SETPGID 1/
/^#undef HAVE_SETRLIMIT *$/s/^.*$/#define HAVE_SETRLIMIT 1/
+/^#undef HAVE_SIGSETJMP *$/s/^.*$/#define HAVE_SIGSETJMP 1/
/^#undef HAVE_GETRUSAGE *$/s/^.*$/#define HAVE_GETRUSAGE 1/
+/^#undef GETTIMEOFDAY_TIMEZONE *$/s/^.*$/#define GETTIMEOFDAY_TIMEZONE struct timezone/
/^#undef HAVE_TM_GMTOFF *$/s/^.*$/#define HAVE_TM_GMTOFF 1/
-/^#undef HAVE_MBLEN *$/s/^.*$/#define HAVE_MBLEN 1/
/^#undef HAVE_STRUCT_TIMEZONE *$/s/^.*$/#define HAVE_STRUCT_TIMEZONE 1/
/^#undef HAVE_SIZE_T *$/s/^.*$/#define HAVE_SIZE_T 1/
/^#undef HAVE_MKSTEMP *$/s/^.*$/#define HAVE_MKSTEMP 1/
+/^#undef HAVE_STRNCASECMP *$/s/^.*$/#define HAVE_STRNCASECMP 1/
/^#undef HAVE_STRUCT_TM_TM_ZONE *$/s/^.*$/#define HAVE_STRUCT_TM_TM_ZONE 1/
/^#undef HAVE_SYNC *$/s/^.*$/#define HAVE_SYNC 1/
/^#undef HAVE___BUILTIN_UNWIND_INIT *$/s/^.*$/#define HAVE___BUILTIN_UNWIND_INIT 1/
+/^#undef HAVE_MENUS *$/s/^.*$/#define HAVE_MENUS 1/
+/^#undef DATA_START/s/^.*$/#define DATA_START (\&etext + 1)/
+/^#undef GC_SETJMP_WORKS/s/^.*$/#define GC_SETJMP_WORKS 1/
/^#undef ORDINARY_LINK/s/^.*$/#define ORDINARY_LINK 1/
/^#undef PACKAGE_BUGREPORT/s/^.*$/#define PACKAGE_BUGREPORT ""/
/^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/
/^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/
/^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/
/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION ""/
-/^#undef VERSION/s/^.*$/#define VERSION "24.0.92"/
+/^#undef PENDING_OUTPUT_COUNT/s/^.*$/#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base)/
+/^#undef VERSION/s/^.*$/#define VERSION "24.3.50"/
+/^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/
/^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/
/^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/
/^#undef HAVE_DIRENT_H/s/^.*$/#define HAVE_DIRENT_H 1/
@@ -74,7 +85,15 @@
/^#undef HAVE_SIGNED_SIG_ATOMIC_T *$/s/^.*$/#define HAVE_SIGNED_SIG_ATOMIC_T 1/
/^#undef HAVE_SIGNED_WINT_T *$/s/^.*$/#define HAVE_SIGNED_WINT_T 1/
/^#undef HAVE_UNSIGNED_LONG_LONG_INT *$/s/^.*$/#define HAVE_UNSIGNED_LONG_LONG_INT 1/
-/^#under HAVE_WCHAR_H *$/s/^.*$/#define HAVE_WCHAR_H 1/
+/^#undef HAVE_WCHAR_H *$/s/^.*$/#define HAVE_WCHAR_H 1/
+/^#undef DEVICE_SEP *$/s/^.*$/#define DEVICE_SEP ':'/
+/^#undef IS_DIRECTORY_SEP *$/s,^.*$,#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\\\'),
+/^#undef IS_DEVICE_SEP *$/s/^.*$/#define IS_DEVICE_SEP(_c_) ((_c_) == ':')/
+/^#undef IS_ANY_SEP *$/s/^.*$/#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_))/
+/^#undef INTERNAL_TERMINAL *$/s,^.*$,#define INTERNAL_TERMINAL "pc|bios|IBM PC with color display::co#80:li#25:Co#16:pa#256:km:ms:cm=<CM>:cl=<CL>:ce=<CE>::se=</SO>:so=<SO>:us=<UL>:ue=</UL>:md=<BD>:mh=<DIM>:mb=<BL>:mr=<RV>:me=<NV>::AB=<BG %d>:AF=<FG %d>:op=<DefC>:",
+/^#undef NULL_DEVICE *$/s/^.*$/#define NULL_DEVICE "nul"/
+/^#undef SEPCHAR *$/s/^.*$/#define SEPCHAR '\;'/
+/^#undef USER_FULL_NAME *$/s/^.*$/#define USER_FULL_NAME (getenv ("NAME"))/
/^#undef inline/s/^.*$/#define inline __inline__/
/^#undef my_strftime/s/^.*$/#define my_strftime nstrftime/
/^#undef restrict/s/^.*$/#define restrict __restrict/
@@ -85,8 +104,6 @@
s/^#undef STACK_DIRECTION *$/#define STACK_DIRECTION -1/
s/^#undef EMACS_CONFIGURATION *$/#define EMACS_CONFIGURATION "i386-pc-msdosdjgpp"/
s/^#undef EMACS_CONFIG_OPTIONS *$/#define EMACS_CONFIG_OPTIONS "msdos"/
-s!^#undef config_opsysfile *$!#define config_opsysfile "s/msdos.h"!
-s!^#undef config_machfile *$!#define config_machfile "m/intel386.h"!
s/^#undef PROTOTYPES *$/#define PROTOTYPES 1/
s/^#undef POINTER_TYPE *$/#define POINTER_TYPE void/
/^#undef HAVE_INTTYPES_H/c\
@@ -119,4 +136,3 @@ s/^#undef HAVE_STRTOULL *$/#define HAVE_STRTOULL 1/
# might be defined in sys/config.h we include at the top of config.h.
/^#undef BSTRING/s|#undef|# undef|
/^#undef .*$/s|^.*$|/* & */|
-
diff --git a/msdos/sed2x.inp b/msdos/sed2x.inp
index d5f96d0e6d4..fa920246c96 100644
--- a/msdos/sed2x.inp
+++ b/msdos/sed2x.inp
@@ -2,7 +2,7 @@
# Extra configuration script for src/config.h for DesqView/X
# ----------------------------------------------------------------------
#
-# Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+# Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
@@ -20,6 +20,5 @@
/^#undef HAVE_X11 *$/s/undef/define/
/^#undef HAVE_X_MENU *$/s/undef/define/
/^#undef HAVE_XSCREENNUMBEROFSCREEN *$/s/undef/define/
-/^#undef HAVE_XSETWMPROTOCOLS *$/s/undef/define/
/^#undef HAVE_SELECT *$/s/undef/define/
diff --git a/msdos/sed3v2.inp b/msdos/sed3v2.inp
index 3b2065157e0..cd58e47305c 100644
--- a/msdos/sed3v2.inp
+++ b/msdos/sed3v2.inp
@@ -2,7 +2,7 @@
# Configuration script for lib-src/makefile under DJGPP v2
# ----------------------------------------------------------------------
#
-# Copyright (C) 1996, 1998, 2000-2011 Free Software Foundation, Inc.
+# Copyright (C) 1996, 1998, 2000-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
@@ -35,10 +35,13 @@ s/-DVERSION[^ ]* //
/^LIBRESOLV *=/s/@[^@\n]*@//g
/^LIBS_MAIL *=/s/@[^@\n]*@//g
/^LIBS_SYSTEM *=/s/@[^@\n]*@//g
+/^LIB_CLOCK_GETTIME *=/s/@[^@\n]*@//g
+/^LIB_TIMER_TIME *=/s/@[^@\n]*@//g
/^CFLAGS *=/s!=.*$!=-O2 -g!
-/^C_SWITCH_SYSTEM *=/s!=.*$!=-DMSDOS!
+/^C_SWITCH_SYSTEM *=/s!=.*$!=-DMSDOS -I../msdos!
/^C_SWITCH_MACHINE *=/s/@C_SWITCH_MACHINE@//
-/^C_WARNINGS_SWITCH *=/s/@C_WARNINGS_SWITCH@//
+/^WARN_CFLAGS *=/s/@WARN_CFLAGS@//
+/^WERROR_CFLAGS *=/s/@WERROR_CFLAGS@//
/^PROFILING_CFLAGS *=/s/@PROFILING_CFLAGS@//
/^ALLOCA *=/s!@ALLOCA@!!
/^EXEEXT *=/s!@EXEEXT@!!
@@ -50,5 +53,4 @@ s!^ \./! !
s/movemail[^ ]* *//
}
/^insrcdir=/s/^.*$/\#&/
-/^ *\$(insrcdir) ||/s,\$(insrcdir) ||,command.com /c if not exist $<,
-
+/^ *\$(insrcdir) ||/s,\$(insrcdir) ||,command.com /c if not exist $(<F),
diff --git a/msdos/sed4.inp b/msdos/sed4.inp
index 50ffa655b8c..73d025463d8 100644
--- a/msdos/sed4.inp
+++ b/msdos/sed4.inp
@@ -2,7 +2,7 @@
# Configuration script for src/paths.h
# ----------------------------------------------------------------------
#
-# Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+# Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
@@ -16,6 +16,7 @@
#
# ----------------------------------------------------------------------
/^#define *PATH_LOADSEARCH/s/".*"/rootrelativepath ("lisp")/
+/^#define *PATH_DUMPLOADSEARCH/s/".*"/"..\/lisp"/
/^#define *PATH_DATA/s/".*"/rootrelativepath ("etc")/
/^#define *PATH_DOC/s/".*"/rootrelativepath ("etc")/
/^#define *PATH_INFO/s/".*"/rootrelativepath ("info")/
diff --git a/msdos/sed5x.inp b/msdos/sed5x.inp
index 9c7257e0f76..9ac6621c911 100644
--- a/msdos/sed5x.inp
+++ b/msdos/sed5x.inp
@@ -2,7 +2,7 @@
# Configuration script for oldxmenu/makefile for DesqView/X
# ----------------------------------------------------------------------
#
-# Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+# Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sed6.inp b/msdos/sed6.inp
index 888b680a6ca..22052140b82 100644
--- a/msdos/sed6.inp
+++ b/msdos/sed6.inp
@@ -3,7 +3,7 @@
# doc/lispintro/Makefile, and doc/misc/Makefile under DJGPP v2.x
# ---------------------------------------------------------------------------
#
-# Copyright (C) 1997, 2000-2011 Free Software Foundation, Inc.
+# Copyright (C) 1997, 2000-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
@@ -19,6 +19,8 @@
/^srcdir *=/s/@[^@\n]*@/./
/^VPATH *=/s/@[^@\n]*@/./
/^MAKEINFO *=/s/@[^@\n]*@/makeinfo/
+/^INFO_EXT *=/s/@[^@\n]*@/.info/
+/^INFO_OPTS *=/s/@[^@\n]*@/--no-split/
/^ENVADD/,/^$/c\
ENVADD =\
export TEXINPUTS := $(srcdir)";"$(TEXINPUTS)\
diff --git a/msdos/sedalloc.inp b/msdos/sedalloc.inp
index 1389355bf3d..b3b45b8f5de 100644
--- a/msdos/sedalloc.inp
+++ b/msdos/sedalloc.inp
@@ -2,7 +2,7 @@
# Configuration script for SYSTEM_MALLOC/REL_ALLOC in src/config.h
# ----------------------------------------------------------------------
#
-# Copyright (C) 2008-2011 Free Software Foundation, Inc.
+# Copyright (C) 2008-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sedleim.inp b/msdos/sedleim.inp
index 2d70695ebe6..461a2b7a9ec 100644
--- a/msdos/sedleim.inp
+++ b/msdos/sedleim.inp
@@ -2,7 +2,7 @@
# Configuration script for leim/Makefile under DJGPP v2.x
# ----------------------------------------------------------------------
#
-# Copyright (C) 1999-2011 Free Software Foundation, Inc.
+# Copyright (C) 1999-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
@@ -33,14 +33,13 @@ s|\([ ]\)echo|\1djecho|g
/RUN_EMACS *=/,/^$/c\
export EMACSLOADPATH=${buildlisppath}\
-RUN_EMACS = ${BUILT_EMACS} -batch --no-site-file
+RUN_EMACS = ${EMACS} -batch --no-site-file
+
+/^MKDIR_P *=/s,@MKDIR_P@,command.com /c md,
/^ cd ../c\
${MAKE} -C ../src ${MFLAGS} emacs
-/else make quail/c\
- if not exist quail\\nul make quail
-
/if \[ -f $@ \]\; then true/d
/fi$/s/; fi$//
@@ -51,9 +50,23 @@ RUN_EMACS = ${BUILT_EMACS} -batch --no-site-file
/^ --eval/,/; \\$/s|\; \\||
}
+/^setwins=/,/^$/d
+/^\.PHONY: compile-targets/d
+/^compile-targets:/d
+/^compile-main:/,/^$/c\
+compile-main: ${TIT_MISC}\
+ $(MAKE) $(MFLAGS) $(foreach f,$(wildcard ja-dic/*.el),$(basename $f).elc)\
+ $(MAKE) $(MFLAGS) $(foreach f,$(wildcard quail/*.el),$(basename $f).elc)\
+
+
/^install:/,/^$/c\
install: all\
+/^bootstrap-clean:/,/^$/c\
+bootstrap-clean: clean\
+ rm -f ja-dic/*.elc quail/*.elc\
+
+
/^ if test -f/d
/^distclean:/,/^$/ {
s|\(rm -f Makefile\)|\1 stamp-subdir|
diff --git a/msdos/sedlibcf.inp b/msdos/sedlibcf.inp
index 17584a796f7..739808c1350 100644
--- a/msdos/sedlibcf.inp
+++ b/msdos/sedlibcf.inp
@@ -5,7 +5,7 @@
# files whose names are invalid on DOS 8+3 filesystems.
# ----------------------------------------------------------------------
#
-# Copyright (C) 2011 Free Software Foundation, Inc.
+# Copyright (C) 2011-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp
index fdb8f8887db..d723c4bcc28 100644
--- a/msdos/sedlibmk.inp
+++ b/msdos/sedlibmk.inp
@@ -2,7 +2,7 @@
# Configuration script for lib/Makefile under DJGPP v2.x
# ----------------------------------------------------------------------
#
-# Copyright (C) 2011 Free Software Foundation, Inc.
+# Copyright (C) 2011-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
@@ -27,7 +27,7 @@
# otherwise edit them to zero:
#
# /^REPLACE_CALLOC *=/s/@REPLACE_CALLOC@/0/
-#
+#
# . If the module is a header or adds headers, edit the corresponding
# variable to either an empty value or to the name of the header.
# Examples:
@@ -93,6 +93,13 @@
# s/'\; \\ *$/' >> $@-t/
# }
#
+# . If the recipe for generating a header file uses 'cat', replace it with
+#
+# sed -e ''
+#
+# (if needed; there's already an edit command that should take care of
+# this).
+#
# The following Awk script is useful for editing portions of
# autogen/Makefile.in into Sed commands that define the corresponding
# variables to zero (which is what is required in the absolute
@@ -124,14 +131,17 @@ am__cd = cd
/^CYGWIN_OBJ *=/s/@[^@\n]*@//
/^C_SWITCH_MACHINE *=/s/@C_SWITCH_MACHINE@//
/^C_SWITCH_SYSTEM *=/s/@C_SWITCH_SYSTEM@//
-/^C_SWITCH_X_SYSTEM *=/s/@C_SWITCH_X_SYSTEM@//
+/^GNUSTEP_CFLAGS *=/s/@GNUSTEP_CFLAGS@//
/^C_SWITCH_X_SITE *=/s/@C_SWITCH_X_SITE@//
-/^C_WARNINGS_SWITCH *=/s/@C_WARNINGS_SWITCH@//
-/^DEFS *=/s/@[^@\n]*@/-DHAVE_CONFIG_H/
+/^GNULIB_WARN_CFLAGS *=/s/@GNULIB_WARN_CFLAGS@//
+/^WARN_CFLAGS *=/s/@WARN_CFLAGS@//
+/^WERROR_CFLAGS *=/s/@WERROR_CFLAGS@//
+/^DEFS *=/s/@[^@\n]*@//
/^DEPDIR *=/s/@[^@\n]*@/deps/
/^DEPFLAGS *=/s/@[^@\n]*@/-MMD -MF ${DEPDIR}\/$*.d/
/^ECHO_N *=/s/@[^@\n]*@/-n/
/^EXEEXT *=/s/@[^@\n]*@/.exe/
+/^EXECINFO_H *=/s/@[^@\n]*@/execinfo.h/
/^GETOPT_H *=/s/@[^@\n]*@/getopt.h/
#
# Gnulib stuff
@@ -156,7 +166,7 @@ am__cd = cd
/^GNULIB_DUP *=/s/@GNULIB_DUP@/0/
/^GNULIB_DUP2 *=/s/@GNULIB_DUP2@/0/
/^GNULIB_DUP3 *=/s/@GNULIB_DUP3@/1/
-/^GNULIB_ENVIRON *=/s/@GNULIB_ENVIRON@/0/
+/^GNULIB_ENVIRON *=/s/@GNULIB_ENVIRON@/1/
/^GNULIB_EUIDACCESS *=/s/@GNULIB_EUIDACCESS@/0/
/^GNULIB_FACCESSAT *=/s/@GNULIB_FACCESSAT@/0/
/^GNULIB_FCHDIR *=/s/@GNULIB_FCHDIR@/0/
@@ -200,11 +210,13 @@ am__cd = cd
/^GNULIB_GETLOGIN *=/s/@GNULIB_GETLOGIN@/0/
/^GNULIB_GETLOGIN_R *=/s/@GNULIB_GETLOGIN_R@/0/
/^GNULIB_GETPAGESIZE *=/s/@GNULIB_GETPAGESIZE@/0/
-/^GNULIB_GETS *=/s/@GNULIB_GETS@/0/
+/^GNULIB_GL_UNISTD_H_GETOPT *=/s/@GNULIB_GL_UNISTD_H_GETOPT@/1/
/^GNULIB_GETSUBOPT *=/s/@GNULIB_GETSUBOPT@/0/
+/^GNULIB_GETTIMEOFDAY *=/s/@GNULIB_GETTIMEOFDAY@/0/
/^GNULIB_GETUSERSHELL *=/s/@GNULIB_GETUSERSHELL@/0/
/^GNULIB_GRANTPT *=/s/@GNULIB_GRANTPT@/0/
/^GNULIB_GROUP_MEMBER *=/s/@GNULIB_GROUP_MEMBER@/0/
+/^GNULIB_ISATTY *=/s/@GNULIB_ISATTY@/0/
/^GNULIB_LCHMOD *=/s/@GNULIB_LCHMOD@/0/
/^GNULIB_LCHOWN *=/s/@GNULIB_LCHOWN@/0/
/^GNULIB_LINK *=/s/@GNULIB_LINK@/0/
@@ -232,17 +244,21 @@ am__cd = cd
/^GNULIB_PIPE *=/s/@GNULIB_PIPE@/0/
/^GNULIB_PIPE2 *=/s/@GNULIB_PIPE2@/0/
/^GNULIB_POPEN *=/s/@GNULIB_POPEN@/0/
+/^GNULIB_POSIX_OPENPT *=/s/@GNULIB_POSIX_OPENPT@/0/
/^GNULIB_PREAD *=/s/@GNULIB_PREAD@/0/
/^GNULIB_PRINTF *=/s/@GNULIB_PRINTF@/0/
/^GNULIB_PRINTF_POSIX *=/s/@GNULIB_PRINTF_POSIX@/0/
+/^GNULIB_PSELECT *=/s/@GNULIB_PSELECT@/0/
/^GNULIB_PTHREAD_SIGMASK *=/s/@GNULIB_PTHREAD_SIGMASK@/0/
/^GNULIB_PTSNAME *=/s/@GNULIB_PTSNAME@/0/
+/^GNULIB_PTSNAME_R *=/s/@GNULIB_PTSNAME_R@/0/
/^GNULIB_PUTC *=/s/@GNULIB_PUTC@/0/
/^GNULIB_PUTCHAR *=/s/@GNULIB_PUTCHAR@/0/
/^GNULIB_PUTENV *=/s/@GNULIB_PUTENV@/0/
/^GNULIB_PUTS *=/s/@GNULIB_PUTS@/0/
/^GNULIB_PWRITE *=/s/@GNULIB_PWRITE@/0/
/^GNULIB_RAISE *=/s/@GNULIB_RAISE@/0/
+/^GNULIB_RANDOM *=/s/@GNULIB_RANDOM@/0/
/^GNULIB_RANDOM_R *=/s/@GNULIB_RANDOM_R@/0/
/^GNULIB_READ *=/s/@GNULIB_READ@/0/
/^GNULIB_READLINK *=/s/@GNULIB_READLINK@/0/
@@ -255,7 +271,9 @@ am__cd = cd
/^GNULIB_RMDIR *=/s/@GNULIB_RMDIR@/0/
/^GNULIB_RPMATCH *=/s/@GNULIB_RPMATCH@/0/
/^GNULIB_SCANF *=/s/@GNULIB_SCANF@/0/
+/^GNULIB_SELECT *=/s/@GNULIB_SELECT@/0/
/^GNULIB_SETENV *=/s/@GNULIB_SETENV@/0/
+/^GNULIB_SETHOSTNAME *=/s/@GNULIB_SETHOSTNAME@/0/
/^GNULIB_SIGACTION *=/s/@GNULIB_SIGACTION@/0/
/^GNULIB_SIGNAL_H_SIGPIPE *=/s/@GNULIB_SIGNAL_H_SIGPIPE@/0/
/^GNULIB_SIGPROCMASK *=/s/@GNULIB_SIGPROCMASK@/0/
@@ -276,7 +294,6 @@ am__cd = cd
/^GNULIB_TIME_R *=/s/@GNULIB_TIME_R@/1/
/^GNULIB_TMPFILE *=/s/@GNULIB_TMPFILE@/0/
/^GNULIB_TTYNAME_R *=/s/@GNULIB_TTYNAME_R@/0/
-/^GNULIB_UNISTD_H_GETOPT *=/s/@GNULIB_UNISTD_H_GETOPT@/1/
/^GNULIB_UNISTD_H_NONBLOCKING *=/s/@GNULIB_UNISTD_H_NONBLOCKING@/0/
/^GNULIB_UNISTD_H_SIGPIPE *=/s/@GNULIB_UNISTD_H_SIGPIPE@/0/
/^GNULIB_UNLINK *=/s/@GNULIB_UNLINK@/0/
@@ -303,7 +320,7 @@ am__cd = cd
/^HAVE_ATOLL *=/s/@HAVE_ATOLL@/0/
/^HAVE_CANONICALIZE_FILE_NAME *=/s/@HAVE_CANONICALIZE_FILE_NAME@/0/
/^HAVE_CHOWN *=/s/@HAVE_CHOWN@/1/
-/^HAVE_DECL_ENVIRON *=/s/@HAVE_DECL_ENVIRON@/1/
+/^HAVE_DECL_ENVIRON *=/s/@HAVE_DECL_ENVIRON@/0/
/^HAVE_DECL_FCHDIR *=/s/@HAVE_DECL_FCHDIR@/0/
/^HAVE_DECL_FDATASYNC *=/s/@HAVE_DECL_FDATASYNC@/0/
/^HAVE_DECL_FPURGE *=/s/@HAVE_DECL_FPURGE@//
@@ -318,6 +335,7 @@ am__cd = cd
/^HAVE_DECL_GETUSERSHELL *=/s/@HAVE_DECL_GETUSERSHELL@/0/
/^HAVE_DECL_LOCALTIME_R *=/s/@HAVE_DECL_LOCALTIME_R@/0/
/^HAVE_DECL_OBSTACK_PRINTF *=/s/@HAVE_DECL_OBSTACK_PRINTF@/0/
+/^HAVE_DECL_SETHOSTNAME *=/s/@HAVE_DECL_SETHOSTNAME@/0/
/^HAVE_DECL_SETENV *=/s/@HAVE_DECL_SETENV@/1/
/^HAVE_DECL_SNPRINTF *=/s/@HAVE_DECL_SNPRINTF@/0/
/^HAVE_DECL_TTYNAME_R *=/s/@HAVE_DECL_TTYNAME_R@/0/
@@ -372,12 +390,15 @@ am__cd = cd
/^HAVE_PIPE2 *=/s/@HAVE_PIPE2@/0/
/^HAVE_POPEN *=/s/@HAVE_POPEN@/1/
/^HAVE_POSIX_SIGNALBLOCKING *=/s/@HAVE_POSIX_SIGNALBLOCKING@/1/
+/^HAVE_POSIX_OPENPT *=/s/@HAVE_POSIX_OPENPT@/0/
/^HAVE_PREAD *=/s/@HAVE_PREAD@/0/
/^HAVE_PTSNAME *=/s/@HAVE_PTSNAME@/0/
+/^HAVE_PTSNAME_R *=/s/@HAVE_PTSNAME_R@/0/
/^HAVE_PTHREAD_SIGMASK *=/s/@HAVE_PTHREAD_SIGMASK@/0/
/^HAVE_PWRITE *=/s/@HAVE_PWRITE@/0/
/^HAVE_RANDOM_H *=/s/@HAVE_RANDOM_H@/1/
/^HAVE_RAISE *=/s/@HAVE_RAISE@/1/
+/^HAVE_RANDOM *=/s/@HAVE_RANDOM@/1/
/^HAVE_RANDOM_R *=/s/@HAVE_RANDOM_R@/0/
/^HAVE_READLINK *=/s/@HAVE_READLINK@/0/
/^HAVE_READLINKAT *=/s/@HAVE_READLINKAT@/0/
@@ -385,6 +406,7 @@ am__cd = cd
/^HAVE_RENAMEAT *=/s/@HAVE_RENAMEAT@/0/
/^HAVE_RPMATCH *=/s/@HAVE_RPMATCH@/0/
/^HAVE_SETENV *=/s/@HAVE_SETENV@/1/
+/^HAVE_SETHOSTNAME *=/s/@HAVE_SETHOSTNAME@/0/
/^HAVE_SIGACTION *=/s/@HAVE_SIGACTION@/1/
/^HAVE_SIGHANDLER_T *=/s/@HAVE_SIGHANDLER_T@/0/
/^HAVE_SIGINFO_T *=/s/@HAVE_SIGINFO_T@/0/
@@ -400,12 +422,15 @@ am__cd = cd
/^HAVE_STRTOULL *=/s/@HAVE_STRTOULL@/1/
/^HAVE_STRUCT_SIGACTION_SA_SIGACTION *=/s/@HAVE_STRUCT_SIGACTION_SA_SIGACTION@/0/
/^HAVE_STRUCT_RANDOM_DATA *=/s/@HAVE_STRUCT_RANDOM_DATA@/0/
+/^HAVE_STRUCT_TIMEVAL *=/s/@HAVE_STRUCT_TIMEVAL@/1/
/^HAVE_SYMLINK *=/s/@HAVE_SYMLINK@/1/
/^HAVE_SYMLINKAT *=/s/@HAVE_SYMLINKAT@/0/
/^HAVE_SYS_BITYPES_H *=/s/@HAVE_SYS_BITYPES_H@/0/
/^HAVE_SYS_INTTYPES_H *=/s/@HAVE_SYS_INTTYPES_H@/0/
/^HAVE_SYS_LOADAVG_H *=/s/@HAVE_SYS_LOADAVG_H@/0/
/^HAVE_SYS_PARAM_H *=/s/@HAVE_SYS_PARAM_H@/1/
+/^HAVE_SYS_SELECT_H *=/s/@HAVE_SYS_SELECT_H@/0/
+/^HAVE_SYS_TIME_H *=/s/@HAVE_SYS_TIME_H@/1/
/^HAVE_SYS_TYPES_H *=/s/@HAVE_SYS_TYPES_H@/1/
/^HAVE_TIMEGM *=/s/@HAVE_TIMEGM@/0/
/^HAVE_TYPE_VOLATILE_SIG_ATOMIC_T *=/s/@HAVE_TYPE_VOLATILE_SIG_ATOMIC_T@/1/
@@ -439,7 +464,10 @@ am__cd = cd
/^NEXT_AS_FIRST_DIRECTIVE_STDINT_H *=/s/@[^@\n]*@/<stdint.h>/
/^NEXT_AS_FIRST_DIRECTIVE_STDIO_H *=/s/@[^@\n]*@/<stdio.h>/
/^NEXT_AS_FIRST_DIRECTIVE_STDLIB_H *=/s/@[^@\n]*@/<stdlib.h>/
+/^NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H *=/s/@[^@\n]*@//
/^NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H *=/s!@[^@\n]*@!<sys/stat.h>!
+/^NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H *=/s/@[^@\n]*@//
+/^NEXT_AS_FIRST_DIRECTIVE_SYS_TYPES_H *=/s!@[^@\n]*@!<sys/types.h>!
/^NEXT_AS_FIRST_DIRECTIVE_TIME_H *=/s/@[^@\n]*@/<time.h>/
/^NEXT_AS_FIRST_DIRECTIVE_UNISTD_H *=/s/@[^@\n]*@/<unistd.h>/
/^NEXT_GETOPT_H *=/s/@[^@\n]*@/<getopt.h>/
@@ -449,7 +477,10 @@ am__cd = cd
/^NEXT_STDIO_H *=/s/@[^@\n]*@/<stdio.h>/
/^NEXT_STDINT_H *=/s/@[^@\n]*@/<stdint.h>/
/^NEXT_STDLIB_H *=/s/@[^@\n]*@/<stdlib.h>/
+/^NEXT_SYS_SELECT_H *=/s/@[^@\n]*@//
/^NEXT_SYS_STAT_H *=/s!@[^@\n]*@!<sys/stat.h>!
+/^NEXT_SYS_TIME_H *=/s/@[^@\n]*@//
+/^NEXT_SYS_TYPES_H *=/s!@[^@\n]*@!<sys/types.h>!
/^NEXT_TIME_H *=/s/@[^@\n]*@/<time.h>/
/^NEXT_UNISTD_H *=/s/@[^@\n]*@/<unistd.h>/
/^OBJEXT *=/s/@[^@\n]*@/o/
@@ -479,6 +510,7 @@ am__cd = cd
/^REPLACE_FSTATAT *=/s/@REPLACE_FSTATAT@/0/
/^REPLACE_FTELL *=/s/@REPLACE_FTELL@/0/
/^REPLACE_FTELLO *=/s/@REPLACE_FTELLO@/0/
+/^REPLACE_FTRUNCATE *=/s/@REPLACE_FTRUNCATE@/0/
/^REPLACE_GETCWD *=/s/@REPLACE_GETCWD@/0/
/^REPLACE_GETDELIM *=/s/@REPLACE_GETDELIM@/0/
/^REPLACE_GETDOMAINNAME *=/s/@REPLACE_GETDOMAINNAME@/0/
@@ -486,6 +518,8 @@ am__cd = cd
/^REPLACE_GETLINE *=/s/@REPLACE_GETLINE@/0/
/^REPLACE_GETLOGIN_R *=/s/@REPLACE_GETLOGIN_R@/0/
/^REPLACE_GETPAGESIZE *=/s/@REPLACE_GETPAGESIZE@/0/
+/^REPLACE_GETTIMEOFDAY *=/s/@REPLACE_GETTIMEOFDAY@/0/
+/^REPLACE_ISATTY *=/s/@REPLACE_ISATTY@/0/
/^REPLACE_LCHOWN *=/s/@REPLACE_LCHOWN@/0/
/^REPLACE_LINK *=/s/@REPLACE_LINK@/0/
/^REPLACE_LINKAT *=/s/@REPLACE_LINKAT@/0/
@@ -507,8 +541,13 @@ am__cd = cd
/^REPLACE_PREAD *=/s/@REPLACE_PREAD@/0/
/^REPLACE_PRINTF *=/s/@REPLACE_PRINTF@/0/
/^REPLACE_PTHREAD_SIGMASK *=/s/@REPLACE_PTHREAD_SIGMASK@/0/
+/^REPLACE_PTSNAME *=/s/@REPLACE_PTSNAME@/0/
+/^REPLACE_PSELECT *=/s/@REPLACE_PSELECT@/0/
+/^REPLACE_PTSNAME *=/s/@REPLACE_PTSNAME@/0/
+/^REPLACE_PTSNAME_R *=/s/@REPLACE_PTSNAME_R@/0/
/^REPLACE_PUTENV *=/s/@REPLACE_PUTENV@/0/
/^REPLACE_PWRITE *=/s/@REPLACE_PWRITE@/0/
+/^REPLACE_RANDOM_R *=/s/@REPLACE_RANDOM_R@/0/
/^REPLACE_READ *=/s/@REPLACE_READ@/0/
/^REPLACE_RAISE *=/s/@REPLACE_RAISE@/0/
/^REPLACE_READLINK *=/s/@REPLACE_READLINK@/0/
@@ -526,6 +565,8 @@ am__cd = cd
/^REPLACE_STDIO_READ_FUNCS *=/s/@REPLACE_STDIO_READ_FUNCS@/0/
/^REPLACE_STDIO_WRITE_FUNCS *=/s/@REPLACE_STDIO_WRITE_FUNCS@/0/
/^REPLACE_STRTOD *=/s/@REPLACE_STRTOD@/0/
+/^REPLACE_STRTOIMAX *=/s/@REPLACE_STRTOIMAX@/0/
+/^REPLACE_STRUCT_TIMEVAL *=/s/@REPLACE_STRUCT_TIMEVAL@/0/
/^REPLACE_SYMLINK *=/s/@REPLACE_SYMLINK@/0/
/^REPLACE_TIMEGM *=/s/@REPLACE_TIMEGM@/0/
/^REPLACE_TMPFILE *=/s/@REPLACE_TMPFILE@/0/
@@ -547,6 +588,7 @@ am__cd = cd
/^SIZE_T_SUFFIX *=/s/@SIZE_T_SUFFIX@/u/
/^ALLOCA_H *=/s/@[^@\n]*@/alloca.h/
/^STDBOOL_H *=/s/@[^@\n]*@//
+/^STDALIGN_H *=/s/@[^@\n]*@/stdalign.h/
/^STDARG_H *=/s/@[^@\n]*@//
/^STDDEF_H *=/s/@[^@\n]*@//
/^STDINT_H *=/s/@[^@\n]*@/stdint.h/
@@ -556,12 +598,20 @@ am__cd = cd
/^UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS *=/s/@[^@\n]*@/0/
/^WCHAR_T_SUFFIX *=/s/@WCHAR_T_SUFFIX@/h/
/^WINT_T_SUFFIX *=/s/@WINT_T_SUFFIX@//
+/^WINDOWS_64_BIT_OFF_T *=/s/@WINDOWS_64_BIT_OFF_T@/0/
+/^WINDOWS_64_BIT_ST_SIZE *=/s/@WINDOWS_64_BIT_ST_SIZE@/0/
/am__append_1 *=.*gettext\.h/s/@[^@\n]*@/\#/
/am__append_2 *=.*verify\.h/s/@[^@\n]*@//
/^gl_LIBOBJS *=/s/@[^@\n]*@/getopt.o getopt1.o strftime.o time_r.o getloadavg.o pthread_sigmask.o/
/^BUILT_SOURCES *=/s/ *inttypes\.h//
-/^am_libgnu_a_OBJECTS *=/s/careadlinkat\.\$(OBJEXT)//
-/^am_libgnu_a_OBJECTS *=/s/allocator\.\$(OBJEXT)//
+/^BUILT_SOURCES *=/,/^[^ ]/{
+ s| *sys/select\.h||
+ s| *sys/time\.h||
+}
+/^am_libgnu_a_OBJECTS *=/,/^[^ ]/{
+ s/allocator\.\$(OBJEXT) //
+ s/careadlinkat\.\$(OBJEXT) //
+}
/^srcdir *=/s/@[^@\n]*@/./
/^top_srcdir *=/s/@[^@\n]*@/../
/^top_builddir *=/s/@[^@\n]*@/../
@@ -598,14 +648,20 @@ s/@echo /@djecho/
# Fix the recipes for header files
s/^@GL_GENERATE_ALLOCA_H_TRUE@//
s/^@GL_GENERATE_ALLOCA_H_FALSE@/\#/
+s/^@GL_GENERATE_EXECINFO_H_TRUE@//
+s/^@GL_GENERATE_EXECINFO_H_FALSE@/\#/
s/^@GL_GENERATE_STDBOOL_H_TRUE@/\#/
s/^@GL_GENERATE_STDBOOL_H_FALSE@//
+s/^@GL_GENERATE_STDALIGN_H_TRUE@//
+s/^@GL_GENERATE_STDALIGN_H_FALSE@/\#/
s/^@GL_GENERATE_STDARG_H_TRUE@/\#/
s/^@GL_GENERATE_STDARG_H_FALSE@/\#/
s/^@GL_GENERATE_STDDEF_H_TRUE@/\#/
s/^@GL_GENERATE_STDDEF_H_FALSE@/\#/
s/^@GL_GENERATE_STDINT_H_TRUE@//
s/^@GL_GENERATE_STDINT_H_FALSE@/\#/
+s/^@GL_GENERATE_STDALIGN_H_TRUE@//
+s/^@GL_GENERATE_STDALIGN_H_FALSE@/\#/
/^arg-nonnull\.h:/,/^[ ][ ]*mv /c\
arg-nonnull.h: $(top_srcdir)/build-aux/snippet/arg-nonnull.h\
sed -n -e '/GL_ARG_NONNULL/,$$p' < $(top_srcdir)/build-aux/snippet/arg-nonnull.h > $@
@@ -617,6 +673,7 @@ warn-on-use.h: $(top_srcdir)/build-aux/snippet/warn-on-use.h\
sed -n -e '/^.ifndef/,$$p' < $(top_srcdir)/build-aux/snippet/warn-on-use.h > $@
s/^ [ ]*{ echo \(.*\); \\/ djecho \1 > $@-t/
s/^ [ ]*{ echo \(.*\) && \\/ djecho \1 > $@-t/
+s/^ [ ]*cat \(.*\); \\/ sed -e '' \1 >> $@-t/
s/ \&\& \\ *$//
s/\.in-h\; *\\$/.in-h >> $@-t/
/^ [ ]*} /d
@@ -630,3 +687,6 @@ s/\.in-h\; *\\$/.in-h >> $@-t/
s/'\; \\ *$/' >> $@-t/
}
s!\$(MKDIR_P)[ ][ ]*sys!command.com /c "if not exist sys\\stat.h md sys"!
+/^ @for dir in/,/^[^ ]/c\
+ -rm -rf $(MOSTLYCLEANDIRS)
+/^ *-test . /d
diff --git a/msdos/sedlisp.inp b/msdos/sedlisp.inp
index a09a171cd70..2055c6edf4d 100644
--- a/msdos/sedlisp.inp
+++ b/msdos/sedlisp.inp
@@ -2,7 +2,7 @@
# Configuration script for lisp/Makefile under DJGPP v2.x
# ----------------------------------------------------------------------
#
-# Copyright (C) 2000-2011 Free Software Foundation, Inc.
+# Copyright (C) 2000-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/nextstep/ChangeLog b/nextstep/ChangeLog
index 4e8fe399970..53f42c97716 100644
--- a/nextstep/ChangeLog
+++ b/nextstep/ChangeLog
@@ -1,3 +1,37 @@
+2012-09-17 Glenn Morris <rgm@gnu.org>
+
+ * templates/Info-gnustep.plist.in, templates/InfoPlist.strings.in:
+ * templates/Info.plist.in: Let configure set copyright.
+
+2012-09-16 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: New file.
+ * templates: New directory.
+ * templates/Emacs.desktop.in, templates/Info-gnustep.plist.in:
+ * templates/Info.plist.in, templates/InfoPlist.strings.in:
+ Move here from various Cocoa/, GNUstep/ locations.
+ Let configure set the version number.
+ * Cocoa/Emacs.base/Contents/Info.plist:
+ * Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:
+ * GNUstep/Emacs.base/Resources/Info-gnustep.plist:
+ * GNUstep/Emacs.base/Resources/Emacs.desktop: Move to templates/.
+ * Cocoa/Emacs.base/Contents/Resources/English.lproj: Remove directory.
+
+2012-04-07 Glenn Morris <rgm@gnu.org>
+
+ * Cocoa/Emacs.base/Contents/Info.plist:
+ * Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:
+ * GNUstep/Emacs.base/Resources/Info-gnustep.plist:
+ * GNUstep/Emacs.base/Resources/Emacs.desktop:
+ Bump version to 24.1.50.
+
+2012-01-05 Glenn Morris <rgm@gnu.org>
+
+ * Cocoa/Emacs.base/Contents/Info.plist:
+ * Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:
+ * GNUstep/Emacs.base/Resources/Info-gnustep.plist:
+ Update short copyright year to 2012.
+
2011-10-19 Jan Djärv <jan.h.d@swipnet.se>
* INSTALL: Remove XCode part.
@@ -92,8 +126,8 @@
2009-02-01 Adrian Robert <Adrian.B.Robert@gmail.com>
- * Cocoa/Emacs.base/Contents/Resources/preferences.nib: Remove
- cursor blink slider, add confirm quit checkbox.
+ * Cocoa/Emacs.base/Contents/Resources/preferences.nib:
+ Remove cursor blink slider, add confirm quit checkbox.
2009-01-05 Glenn Morris <rgm@gnu.org>
@@ -216,7 +250,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings b/nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings
deleted file mode 100644
index 438a6103f5e..00000000000
--- a/nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings
+++ /dev/null
@@ -1,6 +0,0 @@
-/* Localized versions of Info.plist keys */
-
-CFBundleName = "Emacs";
-CFBundleShortVersionString = "Version 24.0.92";
-CFBundleGetInfoString = "Emacs version 24.0.92, NS Windowing";
-NSHumanReadableCopyright = "Copyright (C) 2011 Free Software Foundation, Inc.";
diff --git a/nextstep/INSTALL b/nextstep/INSTALL
index 2a3e1631986..634ff012782 100644
--- a/nextstep/INSTALL
+++ b/nextstep/INSTALL
@@ -1,4 +1,4 @@
-Copyright (C) 2008-2011 Free Software Foundation, Inc.
+Copyright (C) 2008-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -16,7 +16,8 @@ In order to run Emacs.app, you must run:
make install
-This will assemble the app in nextstep/Emacs.app.
+This will assemble the app in nextstep/Emacs.app (i.e., the --prefix
+argument has no effect in this case).
If you pass the --disable-ns-self-contained option to configure, the lisp
files will be installed under whatever 'prefix' is set to (defaults to
diff --git a/nextstep/Makefile.in b/nextstep/Makefile.in
new file mode 100644
index 00000000000..27ec5d1556b
--- /dev/null
+++ b/nextstep/Makefile.in
@@ -0,0 +1,67 @@
+### nextstep/Makefile for GNU Emacs
+
+## Copyright (C) 2012 Free Software Foundation, Inc.
+
+## This file is part of GNU Emacs.
+
+## GNU Emacs is free software: you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+##
+## GNU Emacs is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+### Commentary:
+
+### Code:
+SHELL = /bin/sh
+
+srcdir = @srcdir@
+EXEEXT = @EXEEXT@
+
+@SET_MAKE@
+MKDIR_P = @MKDIR_P@
+
+ns_appdir = @ns_appdir@
+ns_appbindir = @ns_appbindir@
+ns_appsrc = @ns_appsrc@
+
+${ns_appdir}: ${srcdir}/${ns_appsrc} ${ns_appsrc}
+ rm -rf ${ns_appdir}
+ ${MKDIR_P} ${ns_appdir}
+ ( cd ${srcdir}/${ns_appsrc} ; tar cfh - . ) | \
+ ( cd ${ns_appdir} ; umask 022; tar xf - )
+ [ `cd ${srcdir} && /bin/pwd` = `/bin/pwd` ] || \
+ ( cd ${ns_appsrc} ; tar cfh - . ) | \
+ ( cd ${ns_appdir} ; umask 022; tar xf - )
+
+${ns_appbindir}/Emacs: ${ns_appdir} ../src/emacs${EXEEXT}
+ ${MKDIR_P} ${ns_appbindir}
+ cp -f ../src/emacs${EXEEXT} ${ns_appbindir}/Emacs
+
+.PHONY: all
+
+all: ${ns_appdir} ${ns_appbindir}/Emacs
+
+
+.PHONY: clean distclean maintainer-clean
+
+clean:
+ rm -rf ${ns_appdir}
+
+distclean: clean
+ rm -f Makefile
+ rm -f GNUstep/Emacs.base/Resources/Info-gnustep.plist \
+ GNUstep/Emacs.base/Resources/Emacs.desktop \
+ Cocoa/Emacs.base/Contents/Info.plist \
+ Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings
+
+maintainer-clean: distclean
+
+### Makefile.in ends here
diff --git a/nextstep/README b/nextstep/README
index d333c2f8161..f138471f3e6 100644
--- a/nextstep/README
+++ b/nextstep/README
@@ -1,4 +1,4 @@
-Copyright (C) 2008-2011 Free Software Foundation, Inc.
+Copyright (C) 2008-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
This directory contains the files needed to build Emacs on
diff --git a/nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop b/nextstep/templates/Emacs.desktop.in
index 1b8926e9ef6..170f195f270 100644
--- a/nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop
+++ b/nextstep/templates/Emacs.desktop.in
@@ -1,7 +1,7 @@
[Desktop Entry]
Encoding=UTF-8
Type=Application
-Version=24.0.92
+Version=@version@
Categories=GNUstep
Name=Emacs
Comment=GNU Emacs for NeXT/Open/GNUstep and OS X
diff --git a/nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist b/nextstep/templates/Info-gnustep.plist.in
index 9747ed25a2a..4ac97e5cde6 100644
--- a/nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist
+++ b/nextstep/templates/Info-gnustep.plist.in
@@ -2,7 +2,7 @@
ApplicationDescription = "GNU Emacs for GNUstep / OS X";
ApplicationIcon = emacs.tiff;
ApplicationName = Emacs;
- ApplicationRelease = "24.0.92";
+ ApplicationRelease = "@version@";
Authors = (
"Adrian Robert (GNUstep)",
"Christophe de Dinechin (MacOS X)",
@@ -11,9 +11,9 @@
"Carl Edman (NeXTstep)",
"..see etc/NEXTSTEP"
);
- Copyright = "Copyright (C) 2011 Free Software Foundation, Inc.";
+ Copyright = "@copyright@";
CopyrightDescription = "Released under the GNU General Public License Version 3 or later";
- FullVersionID = "Emacs 24.0.92, NS Windowing";
+ FullVersionID = "Emacs @version@, NS Windowing";
NSExecutable = Emacs;
NSIcon = emacs.tiff;
NSPrincipalClass = NSApplication;
diff --git a/nextstep/Cocoa/Emacs.base/Contents/Info.plist b/nextstep/templates/Info.plist.in
index 61a8a28f3a9..25c73916e58 100644
--- a/nextstep/Cocoa/Emacs.base/Contents/Info.plist
+++ b/nextstep/templates/Info.plist.in
@@ -1,5 +1,5 @@
<!--
-Copyright (C) 2008-2011 Free Software Foundation, Inc.
+Copyright (C) 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -553,7 +553,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
<key>CFBundleExecutable</key>
<string>Emacs</string>
<key>CFBundleGetInfoString</key>
- <string>Emacs 24.0.92 Copyright (C) 2011 Free Software Foundation, Inc.</string>
+ <string>Emacs @version@ @copyright@</string>
<key>CFBundleIconFile</key>
<string>Emacs.icns</string>
<key>CFBundleIdentifier</key>
@@ -566,7 +566,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
<string>APPL</string>
<!-- This should be the emacs version number. -->
<key>CFBundleShortVersionString</key>
- <string>24.0.92</string>
+ <string>@version@</string>
<key>CFBundleSignature</key>
<string>EMAx</string>
<!-- This SHOULD be a build number. -->
diff --git a/nextstep/templates/InfoPlist.strings.in b/nextstep/templates/InfoPlist.strings.in
new file mode 100644
index 00000000000..f38d8925017
--- /dev/null
+++ b/nextstep/templates/InfoPlist.strings.in
@@ -0,0 +1,6 @@
+/* Localized versions of Info.plist keys */
+
+CFBundleName = "Emacs";
+CFBundleShortVersionString = "Version @version@";
+CFBundleGetInfoString = "Emacs version @version@, NS Windowing";
+NSHumanReadableCopyright = "@copyright@";
diff --git a/nt/ChangeLog b/nt/ChangeLog
index 859123c1a86..dd79cfc2526 100644
--- a/nt/ChangeLog
+++ b/nt/ChangeLog
@@ -1,11 +1,650 @@
+2012-11-24 Ken Brown <kbrown@cornell.edu>
+
+ * config.nt (HAVE_MOUSE): Remove.
+
+2012-11-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (BROKEN_GETWD, HAVE_CLOSEDIR, HAVE_DIRENT_H, HAVE_FCNTL_H, HAVE_GETWD):
+ Remove.
+
+2012-11-23 Eli Zaretskii <eliz@gnu.org>
+
+ * gmake.defs (SWITCHCHAR): Define to // under MSYS, / otherwise.
+ (Bug#12955)
+
+ * nmake.defs (SWITCHCHAR): Define to /.
+
+2012-11-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958).
+ * inc/dirent.h: Rename from ../src/ndir.h, with these changes:
+ (struct dirent): Rename from struct direct. All uses changed.
+ * inc/sys/dir.h: Remove.
+
+2012-11-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945).
+ * config.nt (HAVE_GETCWD): Remove.
+
+2012-11-21 Eli Zaretskii <eliz@gnu.org>
+
+ * nmake.defs: Use !if, not !ifdef. For the details, see
+ http://lists.gnu.org/archive/html/help-emacs-windows/2012-11/msg00027.html
+
+ * inc/stdint.h (INTPTR_MIN):
+ (PTRDIFF_MIN) [!__GNUC__]: Define for MSVC.
+
+2012-11-18 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/unistd.h: Don't include fcntl.h and don't define O_RDWR.
+
+2012-11-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (HAVE_FPATHCONF): Remove.
+
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881).
+ * inc/sys/socket.h (O_NONBLOCK): Rename from O_NDELAY, since the
+ POSIX name for this flag is O_NONBLOCK. All uses changed.
+ * inc/unistd.h (O_RDWR, O_NOCTTY): New macros. Like AT_FDCWD etc.
+ these really should be moved to a replacement <fcntl.h> if and
+ when that gets implemented. In the meantime, include <fcntl.h>
+ to make sure we don't override its definitions.
+
+2012-11-17 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/sys/wait.h: New file, with prototype of waitpid and
+ definitions of macros it needs.
+
+ * inc/ms-w32.h (wait): Don't define, 'wait' is not used anymore.
+ (sys_wait): Remove prototype.
+
+ * config.nt (HAVE_SYS_WAIT_H): Define to 1.
+
+2012-11-17 Dani Moncayo <dmoncayo@gmail.com>
+
+ * zipdist.bat (ZIP_CHECK): Remove unused label. When invoking 7z
+ to check if it's installed, redirect standard output and standard
+ error to the null device.
+ (ZIP_DIST): Don't build the "barebin" distribution.
+
+2012-11-15 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (GETGROUPS_T, GETGROUPS_ZERO_BUG, GNULIB_FACCESSAT, HAVE_ACCESS)
+ (HAVE_EACCESS, HAVE_FACCESSAT, HAVE_GETGROUPS, HAVE_LIBGEN_H):
+ New macros.
+
+2012-11-14 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/unistd.h (faccessat): Add prototype.
+ (AT_FDCWD, AT_EACCESS, AT_SYMLINK_NOFOLLOW): New macros; the first
+ 2 moved from ms-w32.h.
+
+ * inc/ms-w32.h (AT_FDCWD, AT_EACCESS, faccessat): Remove macros.
+
+2012-11-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use faccessat, not access, when checking file permissions (Bug#12632).
+ * inc/ms-w32.h (AT_FDCWD, AT_EACCESS): New symbols.
+ (access): Remove.
+ (faccessat): New macro.
+
+2012-11-05 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/unistd.h (tcgetpgrp, setsid): Provide prototypes.
+
+2012-11-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (DISPNEW_NEEDS_STDIO_EXT, GETPGRP_VOID, HAVE_SETPGID, HAVE_SETSID)
+ (PENDING_OUTPUT_COUNT, SETPGRP_RELEASES_CTTY): Remove.
+
+2012-11-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (GNULIB_CLOSE_STREAM, HAVE_DECL___FPENDING): New macros.
+
+2012-11-03 Eli Zaretskii <eliz@gnu.org>
+
+ * config.nt (PENDING_OUTPUT_N_BYTES): Define.
+
+2012-11-01 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/unistd.h (setpgid, getpgrp): Provide prototypes. (Bug#12776)
+
+ * config.nt (GETPGRP_VOID): Define to 1.
+
+2012-10-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+
+2012-10-17 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/pwd.h (getuid, geteuid): Add prototypes.
+
+ * inc/ms-w32.h (sys_wait, _getpid, gmtgime_r, localtime_r)
+ (signal_handler, sys_signal, sigemptyset, sigfillset, sigprocmask)
+ (pthread_sigmask, sigismember, setpgrp, sigaction, alarm)
+ (sys_kill, getpagesize): Add prototypes for emulated functions.
+
+ * inc/grp.h (getgid, getegid): Add prototypes.
+
+ * gmake.defs (DEBUG_CFLAGS) [NOOPT]: Add -std=gnu99.
+
+ * configure.bat (chkapiN): Avoid compiler warning in junk.c when
+ compiling with -std=gnu99.
+
+ * config.nt (CHECK_LISP_OBJECT_TYPE): Don't undef, so that it
+ could be used via --cflags switch to configure.bat.
+
+2012-10-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (HAVE_NTGUI): New macro.
+
+2012-10-02 Eli Zaretskii <eliz@gnu.org>
+
+ * preprep.c (RVA_TO_PTR): Cast the result to 'void *', to avoid
+ compiler warnings when using the value.
+
+2012-10-01 Eli Zaretskii <eliz@gnu.org>
+
+ * preprep.c (RVA_TO_PTR): Use 'unsigned char *' instead of
+ 'void *', for pointer arithmetics.
+ (OFFSET_TO_RVA, RVA_TO_OFFSET, RVA_TO_SECTION_OFFSET): Enclose all
+ macro arguments in parentheses.
+
+2012-09-30 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in ($(TRES)): Use $(EMACS_MANIFEST).
+
+2012-09-30 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ * inc/sys/socket.h: Don't map Winsock error codes to standard ones
+ that are already defined.
+
+ * inc/ms-w32.h (EMACS_INT, EMACS_UINT, EMACS_INT_MAX, PRIuMAX)
+ (pI, _INTPTR) [_MSC_VER]: Fix definitions for MSVC.
+ [_MSC_VER]: Add pragmas to suppress some MSVC warnings.
+
+ * preprep.c (pfnCheckSumMappedFile, rva_to_section)
+ (offset_to_section, relocate_offset, OFFSET_TO_RVA)
+ (RVA_TO_OFFSET, RVA_TO_SECTION_OFFSET, PTR_TO_RVA)
+ (OFFSET_TO_PTR, ROUND_UP, ROUND_DOWN)
+ (copy_executable_and_move_sections, ADJUST_IMPORT_RVA, main):
+ Use DWORD_PTR instead of DWORD for compatibility with x64.
+
+ * nmake.defs: Support AMD64.
+ (EMACS_HEAPSIZE, EMACS_PURESIZE, EMACS_MANIFEST): New macros.
+
+ * gmake.defs (EMACS_HEAPSIZE, EMACS_PURESIZE, EMACS_MANIFEST):
+ New macros.
+
+ * addsection.c (pfnCheckSumMappedFile, rva_to_section)
+ (offset_to_section, relocate_offset, OFFSET_TO_RVA)
+ (RVA_TO_OFFSET, RVA_TO_SECTION_OFFSET, PTR_TO_RVA)
+ (OFFSET_TO_PTR, ROUND_UP, ROUND_DOWN)
+ (copy_executable_and_add_section, main): Use DWORD_PTR instead of
+ DWORD, for compatibility with x64.
+
+ * emacs-x64.manifest: New file.
+
+ * emacs-x86.manifest: Renamed from emacs.manifest.
+
+2012-09-30 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/sys/time.h (ITIMER_REAL, ITIMER_PROF): Define.
+ (struct itimerval): Define.
+ (getitimer, setitimer): Add prototypes.
+
+ * inc/ms-w32.h <sigset_t> [_MSVC_VER]: Make the typedef consistent
+ with MinGW.
+ (SA_RESTART, SIGPROF): Define.
+
+ * config.nt (HAVE_SETITIMER): Define to 1.
+
+2012-09-30 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+
+2012-09-29 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (HAVE_TIMER_SETTIME): New macro.
+
+2012-09-23 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/ms-w32.h (emacs_raise): Redefine to invoke emacs_abort.
+
+2012-09-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify and avoid signal-handling races (Bug#12471).
+ * inc/ms-w32.h (emacs_raise): New macro.
+
+2012-09-18 Eli Zaretskii <eliz@gnu.org>
+
+ * configure.bat: Include stddef.h before gif_lib.h, to have size_t
+ defined, as needed by giflib-5.0.0. (Bug#12464)
+
+2012-09-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (BROKEN_SA_RESTART, SYNC_INPUT): Remove.
+
+2012-09-17 Glenn Morris <rgm@gnu.org>
+
+ * config.nt (COPYRIGHT): New.
+
+2012-09-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port _setjmp fix to POSIXish hosts as well as Microsoft.
+ * config.nt: Attempt to sync with autogen/config.in.
+ (HAVE_SIGSETJMP, HAVE__SETJMP): New macros.
+ (_longjmp, _setjmp): Remove.
+
+2012-09-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (BROKEN_FIONREAD, BROKEN_SIGAIO, BROKEN_SIGIO, BROKEN_SIGPOLL)
+ (BROKEN_SIGPTY, HAVE_CBRT, HAVE_LOGB, NO_TERMIO): Remove.
+ (USABLE_FIONREAD, USABLE_SIGIO): New macros.
+
+2012-09-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (FLOAT_CHECK_DOMAIN, HAVE_FMOD, HAVE_FREXP)
+ (HAVE_INVERSE_HYPERBOLIC, NO_MATHERR): Remove.
+
+2012-09-08 Eli Zaretskii <eliz@gnu.org>
+
+ * configure.bat <use_extensions>: Don't leave it set in the
+ environment when the script exits.
+
+2012-09-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (NO_ABORT, SIGNAL_H_AHB): Remove.
+
+2012-09-07 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/ms-w32.h (struct sigaction): Declare sa_handler __cdecl.
+
+2012-09-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify redefinition of 'abort' (Bug#12316).
+ * inc/ms-w32.h (w32_abort) [HAVE_NTGUI]: Remove.
+
+2012-09-02 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (HAVE_EXECINFO_H, TERM_HEADER): New macros.
+
+2012-09-01 Daniel Colascione <dancol@dancol.org>
+
+ * inc/ms-w32.h (TERM_HEADER): Add for refactoring
+
+2012-08-22 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+
+2012-08-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (HAVE_POSIX_OPENPT): New macro.
+
+2012-08-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (_GL_INLINE_HEADER_BEGIN): Update.
+
+2012-08-10 Glenn Morris <rgm@gnu.org>
+
+ * config.nt (DIRECTORY_SEP): Move here from src/lisp.h.
+
+2012-08-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (BROKEN_GETWD, DISPNEW_NEEDS_STDIO_EXT): New macros.
+ (PENDING_OUTPUT_COUNT): Move definition to inc/ms-w32.h.
+
+ * inc/ms-w32.h (PENDING_OUTPUT_COUNT): Define.
+
+2012-08-06 Glenn Morris <rgm@gnu.org>
+
+ * config.nt (GNU_LIBRARY_PENDING_OUTPUT_COUNT): Remove.
+ (PENDING_OUTPUT_COUNT): Define it as dispnew.c used to.
+
+2012-08-04 Eli Zaretskii <eliz@gnu.org>
+
+ * paths.h (PATH_LOADSEARCH, PATH_SITELOADSEARCH, PATH_EXEC)
+ (PATH_DATA, PATH_DOC): Replace dummy directory names with
+ directories relative to %emacs_dir%.
+ (PATH_EXEC): Add lib-src/oo-spd/i386 and lib-src/oo/i386, to cater
+ to the use case of running un-installed Emacs.
+
+2012-08-03 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (DOS_NT, MSDOS): New macros.
+ (WRETCODE, wait3): Remove.
+
+ * inc/ms-w32.h (DOS_NT): Remove; defined in config.nt.
+
+2012-08-03 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/sys/stat.h (S_IFLNK): Define.
+ (S_ISLNK): A non-trivial definition.
+ (lstat): Prototype instead of a macro that redirects to 'stat'.
+
+2012-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use C99-style 'extern inline' if available.
+ * config.nt: Sync with autogen/config.in.
+ (_GL_INLINE, _GL_EXTERN_INLINE, _GL_INLINE_HEADER_BEGIN)
+ (_GL_INLINE_HEADER_END): New macros.
+
+2012-08-02 Glenn Morris <rgm@gnu.org>
+
+ * inc/ms-w32.h: Move here from ../src/s.
+ * config.nt (config_opsysfile): Change to <ms-w32.h>.
+
+2012-08-01 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (DEVICE_SEP, FLOAT_CHECK_DOMAIN, HAVE_INVERSE_HYPERBOLIC)
+ (INTERNAL_TERMINAL, IS_ANY_SEP, IS_DEVICE_SEP, IS_DIRECTORY_SEP):
+ New macros.
+
+2012-08-01 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ Remove code moved to conf_post.h and include <conf_post.h>
+ (NULL_DEVICE, SEPCHAR, SIGNAL_H_AHB, TIOCSIGSEND, USER_FULL_NAME)
+ (USG5_4, WRETCODE, _longjmp, _setjmp, wait3): New macros.
+
+2012-07-29 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (HAVE_ENVIRON_DECL): New macro.
+
+2012-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/stdalign.h (_Alignas, alignas): Define.
+
+2012-07-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use Gnulib stdalign module (Bug#9772, Bug#9960).
+ * config.nt (HAVE_ATTRIBUTE_ALIGNED): Remove.
+
+2012-07-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (GC_MARK_SECONDARY_STACK, GC_MARK_STACK, GC_SETJMP_WORKS)
+ (SETUP_SLAVE_PTY): New macros.
+
+2012-07-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (BROKEN_FIONREAD, BROKEN_GET_CURRENT_DIR_NAME)
+ (BROKEN_PTY_READ_AFTER_EAGAIN, BROKEN_SIGAIO, BROKEN_SIGPOLL)
+ (BROKEN_SIGPTY, BSD4_2, BSD_SYSTEM, BSD_SYSTEM_AHB, CYGWIN, DARWIN_OS)
+ (FIRST_PTY_LETTER, GNU_LINUX, G_SLICE_ALWAYS_MALLOC, HAVE_PTYS)
+ (HAVE_SOCKETS, HPUX, INTERRUPT_INPUT, IRIX6_5, NARROWPROTO, NO_ABORT)
+ (NO_EDITRES, NSIG_MINIMUM, PREFER_VSUSP, PTY_ITERATION)
+ (PTY_NAME_SPRINTF, PTY_OPEN, PTY_TTY_NAME_SPRINTF, RUN_TIME_REMAP)
+ (SETPGRP_RELEASES_CTTY, SOLARIS2, TAB3, TABDLY, ULIMIT_BREAK_VALUE)
+ (UNIX98_PTYS, USG, USG5, XOS_NEEDS_TIME_H, _AIX): New macros.
+ (HAVE_ATTRIBUTE_ALIGNED, HAVE_C99_STRTOLD, HAVE___BUILTIN_UNWIND_INIT):
+ Set in src/s/ms-w32.h, not here.
+
+2012-07-11 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (CLASH_DETECTION, DEFAULT_SOUND_DEVICE, DONT_REOPEN_PTY)
+ (GNU_LIBRARY_PENDING_OUTPUT_COUNT, SIGNALS_VIA_CHARACTERS): New macros.
+ (HAVE_MKDIR, HAVE_RENAME, HAVE_RMDIR, HAVE_STRERROR): Remove.
+
+2012-07-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ * config.nt (ATTRIBUTE_CONST): Add, to sync with configure.ac.
+
+2012-07-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+
+2012-07-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt (HAVE_STRCASECMP, HAVE_STRNCASECMP): Remove.
+
+2012-07-06 Juanma Barranquero <lekktu@gmail.com>
+ Eli Zaretskii <eliz@gnu.org>
+
+ * config.nt: Complete rework to bring it in sync with autogen/config.in.
+ All Windows-specific code moved to src/s/ms-w32.h.
+
+2012-07-04 Juanma Barranquero <lekktu@gmail.com>
+ Eli Zaretskii <eliz@gnu.org>
+
+ * configure.bat (enablechecking): Enable checks through src/config.h,
+ not the compiler's command line.
+
+ * nmake.defs (CHECKING_CFLAGS): Remove.
+ (CFLAGS, ESC_CFLAGS): Do not include $(CHECKING_CFLAGS).
+
+ * gmake.defs (DEBUG_CFLAGS): Add -fno-crossjumping.
+ (CHECKING_CFLAGS): Remove.
+ (CFLAGS, ESC_CFLAGS): Do not include $(CHECKING_CFLAGS).
+
+2012-07-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt (LISP_FLOAT_TYPE, HAVE_XFREE386, USE_TEXT_PROPERTIES)
+ (GSSAPI, HAVE_LIBINTL, HAVE_LIBGSSAPI_KRB5, HAVE_LIBGSSAPI)
+ (HAVE_GSSAPI_H, HAVE_LIBXBD, HAVE_MEMCPY, HAVE_MEMMOVE, HAVE_MEMSET)
+ (HAVE_MEMCMP): Remove, obsolete.
+
+2012-06-30 Glenn Morris <rgm@gnu.org>
+
+ * paths.h (PATH_SITELOADSEARCH): New.
+
+2012-06-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * nmake.defs (CHECKING_CFLAGS):
+ * gmake.defs (CHECKING_CFLAGS): Remove XASSERTS.
+
+2012-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ * config.nt (_Noreturn): Don't reference __SUNPRO_C.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Switch from NO_RETURN to C11's _Noreturn (Bug#11750).
+ * config.nt (_Noreturn): New macro.
+ (NO_RETURN): Remove. All uses replaced with _Noreturn.
+ (w32_abort) [HAVE_NTGUI]: Use _Noreturn rather than NO_RETURN.
+
+2012-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/sys/time.h (struct timespec): Don't define it here, it is
+ now defined in src/s/ms-w32.h.
+
+2012-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the MS-Windows build broken by 2012-06-22T21:17:42Z!eggert@cs.ucla.edu.
+ * inc/sys/time.h (struct timespec): Define.
+
+2012-06-16 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (install-addpm): New target.
+ (dist): Depend on it.
+ (install-shortcuts): Depend on install-addpm instead of copying
+ addpm.exe as part of the recipe. See
+ http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00171.html
+ for the related problem and discussions.
+
+2012-06-11 Glenn Morris <rgm@gnu.org>
+
+ * config.nt (SYSTEM_TYPE): Define it.
+
+2012-05-31 Eli Zaretskii <eliz@gnu.org>
+
+ * configure.bat (genmakefiles): Move the redirection away from the
+ end of the command, to avoid excess whitespace at the end of Make
+ variables created at configure time, and also avoid things like
+ "FOO1>>config.settings", where "1" gets interpreted as the file
+ descriptor and eaten up. This fixes breakage introduced by the
+ last change, without reintroducing the bug fixed by that change.
+
+2012-05-31 Eli Zaretskii <eliz@gnu.org>
+
+ * nmake.defs (MWINDOWS): Define as
+ "-subsystem:windows -entry:mainCRTStartup". Suggested by Fabrice
+ Popineau <fabrice.popineau@supelec.fr>. (Bug#11405)
+
+ * gmake.defs (MWINDOWS): Define as "-mwindows".
+
+2012-05-28 Eli Zaretskii <eliz@gnu.org>
+
+ * config.nt (HAVE_SYSINFO): Remove; unused.
+
+2012-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/stdalign.h: New file.
+
+ * configure.bat: Ensure a space between %var% expansion and
+ redirection symbol '>', which breaks when %var% ends in a digit,
+ such as 1.
+
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove src/m/*.
+ * config.nt: Do not include "m/intel386.h"; file was removed.
+ (BITS_PER_CHAR, BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
+ Move to src/lisp.h.
+ (EMACS_INT_MAX): New macro.
+
+2012-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * config.nt (HAVE_GETDOMAINNAME, HAVE_XSETWMPROTOCOLS)
+ (HAVE_GETSOCKOPT, HAVE_SETSOCKOPT): Remove; not needed.
+
+ * config.nt (HAVE_FTIME): Remove undef; not needed.
+
+2012-05-01 Glenn Morris <rgm@gnu.org>
+
+ * config.nt (HAVE_LIBNCURSES): Remove undef; not needed.
+
+2012-04-14 Dani Moncayo <dmoncayo@gmail.com> (tiny change)
+
+ * makefile.w32-in: Fix typo (Bug#10261).
+
+2012-04-10 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (emacs, misc, lispref, lispintro): New targets,
+ each runs makeinfo in its own subdirectory of 'doc'.
+ (info-gmake): Depend on these new targets.
+
+2012-04-07 Glenn Morris <rgm@gnu.org>
+
+ * config.nt, makefile.w32-in, emacs.rc, emacsclient.rc:
+ Bump version to 24.1.50.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * configure.bat: Support building with libxml2.
+
+ * INSTALL:
+ * README.W32: Add information about libxml2.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in: Convert to Unix EOL format.
+ (all): Don't depend on stamp_BLD and on maybe-bootstrap.
+ (all-other-dirs-$(MAKETYPE)): Depend on maybe-bootstrap.
+ (bootstrap-gmake): Invoke the "clean" and build targets in 2
+ separate commands, so they run in that order even under "make -j".
+
+2012-03-29 Eli Zaretskii <eliz@gnu.org>
+
+ * config.nt: Discourage from defining HAVE_GETCWD.
+
+2012-03-25 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (install-bin): Don't copy addpm.exe here. Use
+ $(DIRNAME)_same-dir.tst instead of same-dir.tst, to avoid stepping
+ on other (parallel) Make job's toes.
+ (install-other-dirs-nmake, install-other-dirs-gmake): Depend on `all'.
+ (install-shortcuts): Depend on $(INSTALL_DIR)/bin. Copy addpm.exe
+ here.
+ (maybe-copy-distfiles-CMD, maybe-copy-distfiles-SH, dist): Depend
+ on create-tmp-dist-dir.
+
+ * nmake.defs (DIRNAME): New variable.
+ (IFNOTSAMEDIR): Use $(DIRNAME)_same-dir.tst instead of
+ same-dir.tst.
+
+ * gmake.defs (DIRNAME): New variable.
+ (IFNOTSAMEDIR): Use $(DIRNAME)_same-dir.tst instead of
+ same-dir.tst, to avoid conflicts between several (parallel) Make
+ jobs.
+
+2012-02-24 Eli Zaretskii <eliz@gnu.org>
+
+ Prevent endless re-spawning of cmdproxy.exe when some of its
+ parent directories have access limitations.
+
+ * cmdproxy.c (main): Bypass conversion of the file name in argv[0]
+ and our own module name to short 8+3 aliases, if the original file
+ names compare equal. If GetShortPathName fails, compare the base
+ names of the two file names, and only re-spawn the command line if
+ the base-name comparison also fails. (Bug#10674)
+
+2012-02-23 Dani Moncayo <dmoncayo@gmail.com> (tiny change)
+
+ * makefile.w32-in (maybe-copy-distfiles-SH): Fix typo.
+
+2012-02-06 Christoph Scholtes <cschol2112@googlemail.com>
+
+ * README.W32: Removed specific version information for libXpm
+ included in the binary distribution for maintenance purposes.
+
+2012-02-05 Christoph Scholtes <cschol2112@googlemail.com>
+
+ * README.W32: Clarification for inclusion in source tarball (bug#9750).
+
+ * gmake.defs (PRAGMA_SYSTEM_HEADER): Add for GCC.
+
+ * nmake.defs (PRAGMA_SYSTEM_HEADER): Add, but ignore with MSVC.
+
+ * makefile.w32-in (maybe-copy-distfiles)
+ (maybe-copy-distfiles-CMD, maybe-copy-distfiles-SH)
+ (create-tmp-dist-dir): Add to make --distfiles optional.
+ (dist): Use create-tmp-dist-dir and maybe-copy-distfiles (bug#10261).
+
+2012-02-04 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/sys/stat.h (_STAT_DEFINED): Define, to prevent redefinitions
+ by other headers.
+
2011-11-27 Fabrice Popineau <fabrice.popineau@supelec.fr> (tiny change)
* inc/stdint.h (uint32_t, uint64_t) [_WIN64]: New typedefs.
(UINT64_MAX) [_WIN64]: Fix definition.
(uintmax_t, intmax_t): Fix definitions.
- * inc/inttypes.h (strtoumax, strtoimax) [!__MINGW32__]: Provide
- correct definitions.
+ * inc/inttypes.h (strtoumax, strtoimax) [!__MINGW32__]:
+ Provide correct definitions.
* config.nt (HAVE_DECL_STRTOLL): Define.
(va_copy) [_WIN64]: Provide a better definition.
@@ -126,8 +765,8 @@
A new ESC_USER_CFLAGS variable is written to config.settings.
This variable has the same value as the escusercflags variable.
- * gmake.defs, nmake.defs: Added the variable ESC_CFLAGS. This
- variable is identical to the CFLAGS variable except that it
+ * gmake.defs, nmake.defs: Added the variable ESC_CFLAGS.
+ This variable is identical to the CFLAGS variable except that it
includes the new ESC_USER_CFLAGS variable instead of USER_CFLAGS.
These changes, along with some changes to src/makefile.w32-in,
@@ -172,8 +811,7 @@
2011-04-28 Eli Zaretskii <eliz@gnu.org>
- * gmake.defs (ARCH): Fix error message in case of unknown
- architecture.
+ * gmake.defs (ARCH): Fix error message in case of unknown architecture.
2011-04-27 Eli Zaretskii <eliz@gnu.org>
@@ -204,8 +842,8 @@
* configure.bat: Modified the code that parses the --cflags and
--ldflags options to support parameters that include the =
- character as long as they are enclosed in quotes. This
- functionality depends on command extensions. Configure.bat now
+ character as long as they are enclosed in quotes.
+ This functionality depends on command extensions. Configure.bat now
attempts to enable command extensions and displays a warning
message if they could not be enabled. If configure.bat could
not enable command extensions the old parsing code is used that
@@ -648,7 +1286,7 @@
2008-04-04 Jason Rumney <jasonr@gnu.org>
- * INSTALL: Update W32 API requirements.
+ * INSTALL: Update Windows API requirements.
2008-04-03 Jason Rumney <jasonr@gnu.org>
@@ -733,8 +1371,8 @@
Ignore return status.
* configure.bat (dontCopy): Rename admin/unidata/Makefile to keep
- it out of the way of Windows generated file. Generate
- admin/unidata/makefile.
+ it out of the way of Windows generated file.
+ Generate admin/unidata/makefile.
* makefile.w32-in (unidatagen-nmake, unidatagen-clean-nmake)
(unidatagen-CMD, unidatagen-clean-CMD, unidatagen-SH)
@@ -933,8 +1571,8 @@
* gmake.defs: Export XMFLAGS.
- * makefile.w32-in (all-other-dirs-nmake, recompile-nmake): Don't
- use $(XMFLAGS) for nmake, as it doesn't support parallelism.
+ * makefile.w32-in (all-other-dirs-nmake, recompile-nmake):
+ Don't use $(XMFLAGS) for nmake, as it doesn't support parallelism.
2006-12-22 Eli Zaretskii <eliz@gnu.org>
@@ -1104,7 +1742,7 @@
2005-06-05 Eli Zaretskii <eliz@gnu.org>
* inc/sys/socket.h: Change arg 4 of sys_setsockopt to
- `const void *', for consistency with Posix.
+ `const void *', for consistency with POSIX.
2005-06-04 Eli Zaretskii <eliz@gnu.org>
@@ -1518,8 +2156,8 @@
* README: Update info about compilers.
* makefile.w32-in: Use $(MAKETYPE) instead of $(SHELLTYPE) to
- select correct rule for invoking make in another directory. Amend
- rules accordingly.
+ select correct rule for invoking make in another directory.
+ Amend rules accordingly.
(clean): Delete $(COMPILER_TEMP_FILES) instead of *.pdb.
* nmake.defs (EMACS_ICON_PATH): Delete definition.
@@ -1762,7 +2400,7 @@
1999-01-31 Andrew Innes <andrewi@gnu.org>
- * addsection.c (ROUND_UP_DST_AND_ZERO): Renamed from
+ * addsection.c (ROUND_UP_DST_AND_ZERO): Rename from
ROUND_UP_DST. Zeroes the alignment slop.
(copy_executable_and_add_section): Update the
SizeOfHeaders field properly.
@@ -2065,7 +2703,7 @@
* makefile.def (CP_DIR): Use platform independent switches for xcopy.
* makefile.nt (install, fast_install, real_install, clean):
- Don't use switches to del not supported by Win95.
+ Don't use switches to del not supported by Windows 95.
1995-11-07 Kevin Gallo <kgallo@microsoft.com>
@@ -2104,7 +2742,7 @@
1995-06-09 Geoff Voelker <voelker@cs.washington.edu>
* emacs.bat.in: Renamed from emacs.bat.
- (emacs_dir): Renamed from emacs_path.
+ (emacs_dir): Rename from emacs_path.
Definition removed.
* addpm.c: New file.
@@ -2119,7 +2757,7 @@
1995-05-27 Geoff Voelker <voelker@cs.washington.edu>
* ebuild.bat, emacs.bat, fast-install.bat, install.bat:
- Add carriage returns; necessary for batch files on Win95.
+ Add carriage returns; necessary for batch files on Windows 95.
1995-05-25 Geoff Voelker <voelker@cs.washington.edu>
@@ -2166,7 +2804,7 @@
1995-04-09 Geoff Voelker <voelker@cs.washington.edu>
- * makefile.def (INSTALL_DIR): Changed to generic directory.
+ * makefile.def (INSTALL_DIR): Change to generic directory.
* emacs.bat: Added arguments when emacs.exe invoked.
@@ -2218,7 +2856,7 @@
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 1995-1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1995-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/INSTALL b/nt/INSTALL
index 9947cd86a34..2293610adf3 100644
--- a/nt/INSTALL
+++ b/nt/INSTALL
@@ -1,7 +1,7 @@
Building and Installing Emacs on Windows
(from 95 to 7 and beyond)
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
* For the impatient
@@ -68,13 +68,19 @@
With GNU Make, you can use the -j command-line option to have
Make execute several commands at once, like this:
+ gmake -j 2
+
+ (With versions of GNU Make before 3.82, you need also set the
+ XMFLAGS variable, like this:
+
gmake -j 2 XMFLAGS="-j 2"
- The XMFLAGS variable overrides the default behavior of GNU Make
- on Windows, whereby recursive Make invocations reset the maximum
- number of simultaneous commands to 1. The above command allows
- up to 4 simultaneous commands at once in the top-level Make, and
- up to 3 in each one of the recursive Make's.
+ The XMFLAGS variable overrides the default behavior of version
+ 3.82 and older of GNU Make on Windows, whereby recursive Make
+ invocations reset the maximum number of simultaneous commands to
+ 1. The above command allows up to 4 simultaneous commands at
+ once in the top-level Make, and up to 3 in each one of the
+ recursive Make's.)
4. Generate the Info manuals (only if you are building out of Bazaar,
and if you have makeinfo.exe installed):
@@ -115,7 +121,7 @@
To compile Emacs, you will need either Microsoft Visual C++ 2.0, or
later and nmake, or a Windows port of GCC 2.95 or later with MinGW
- and W32 API support and a port of GNU Make. You can use the Cygwin
+ and Windows API support and a port of GNU Make. You can use the Cygwin
ports of GCC, but Emacs requires the MinGW headers and libraries to
build (latest versions of the Cygwin toolkit, at least since v1.3.3,
include the MinGW headers and libraries as an integral part).
@@ -359,7 +365,41 @@
session.
You can get pre-built binaries (including any required DLL and the
- gnutls.h file) and an installer at http://josefsson.org/gnutls4win/.
+ header files) at http://sourceforge.net/projects/ezwinports/files/.
+
+* Optional libxml2 support
+
+ If configure.bat finds the libxml/HTMLparser.h file in the include path,
+ Emacs is built with libxml2 support by default; to avoid that you can
+ pass the argument --without-libxml2.
+
+ In order to support libxml2 at runtime, a libxml2-enabled Emacs must
+ be able to find the relevant DLLs during startup; failure to do so
+ is not an error, but libxml2 features won't be available to the
+ running session.
+
+ One place where you can get pre-built Windows binaries of libxml2
+ (including any required DLL and the header files) is here:
+
+ http://sourceforge.net/projects/ezwinports/files/
+
+ To compile Emacs with libxml2 from that site, you will need to pass
+ the "--cflags -I/path/to/include/libxml2" option to configure.bat,
+ because libxml2 header files are installed in the include/libxml2
+ subdirectory of the directory where you unzip the binary
+ distribution. Other binary distributions might use other
+ directories, although include/libxml2 is the canonical place where
+ libxml2 headers are installed on Posix platforms.
+
+ You will also need to install the libiconv "development" tarball,
+ because the libiconv headers need to be available to the compiler
+ when you compile with libxml2 support. A MinGW port of libiconv can
+ be found on the MinGW site:
+
+ http://sourceforge.net/projects/mingw/files/MinGW/Base/libiconv/
+
+ You need the libiconv-X.Y.Z-N-mingw32-dev.tar.lzma tarball from that
+ site.
* Experimental SVG support
@@ -396,6 +436,17 @@
maybe a problem with the way Cairo or librsvg is using it that
doesn't show up on other platforms.
+* Optional extra runtime checks
+
+ The configure.bat option --enable-checking builds Emacs with some
+ optional extra runtime checks and assertions enabled. This may be
+ useful for debugging.
+
+* Optional extra libraries
+
+ You can pass --lib LIBNAME option to configure.bat to cause Emacs to
+ link with the specified library. You can use this option more than once.
+
* Building
After running configure, simply run the appropriate `make' program for
@@ -540,7 +591,7 @@
* Trouble-shooting
The main problems that are likely to be encountered when building
- Emacs stem from using an old version of GCC, or old MinGW or W32 API
+ Emacs stem from using an old version of GCC, or old MinGW or Windows API
headers. Additionally, Cygwin ports of GNU make may require the Emacs
source tree to be mounted with text!=binary, because the makefiles
generated by configure.bat necessarily use DOS line endings. Also,
@@ -552,7 +603,7 @@
2.95 or later is needed, because that is when the Windows port gained
sufficient support for anonymous structs and unions to cope with some
definitions from winnt.h that are used by addsection.c.
- Older versions of the W32 API headers that come with Cygwin and MinGW
+ Older versions of the Windows API headers that come with Cygwin and MinGW
may be missing some definitions required by Emacs, or broken in other
ways. In particular, uniscribe APIs were added to MinGW CVS only on
2006-03-26, so releases from before then cannot be used.
diff --git a/nt/README b/nt/README
index 75a3c1cb111..483398698e4 100644
--- a/nt/README
+++ b/nt/README
@@ -1,6 +1,6 @@
Emacs for Windows NT/2000 and Windows 95/98/ME
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
This directory contains support for compiling and running GNU Emacs on
diff --git a/nt/README.W32 b/nt/README.W32
index 52582dc7ccf..e2197ba5adf 100644
--- a/nt/README.W32
+++ b/nt/README.W32
@@ -1,18 +1,23 @@
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
Emacs for Windows
- This README file describes how to set up and run a precompiled
- version of GNU Emacs for Windows. This distribution can be found on
- the ftp.gnu.org server and its mirrors:
+ This README.W32 file describes how to set up and run a precompiled
+ distribution of GNU Emacs for Windows. You can find the precompiled
+ distribution on the ftp.gnu.org server and its mirrors:
- ftp://ftp.gnu.org/gnu/emacs/windows/
+ ftp://ftp.gnu.org/gnu/emacs/windows/
This server contains other distributions, including the full Emacs
source distribution and a barebin distribution which can be installed
over it, as well as older releases of Emacs for Windows.
+ Information on how to compile Emacs from sources on Windows is in
+ the files README and INSTALL in this directory. If you received
+ this file as part of the Emacs source distribution, please read
+ those 2 files and not this one.
+
Answers to frequently asked questions, and further information about
this port of GNU Emacs and related software packages can be found via
http:
@@ -123,9 +128,7 @@ See the end of the file for license conditions.
Emacs has built in support for XBM and PPM/PGM/PBM images, and the
libXpm library is bundled, providing XPM support (required for color
toolbar icons and splash screen). Source for libXpm should be available
- on the same place as you got this binary distribution from. The version
- of libXpm bundled with this version of Emacs is 3.5.7, based on x.org's
- libXpm library from X11R7.3.
+ on the same place as you got this binary distribution from.
Emacs can also support some other image formats with appropriate
libraries. These libraries are all available as part of GTK
@@ -167,7 +170,17 @@ See the end of the file for license conditions.
but GnuTLS won't be available to the running session.
You can get pre-built binaries (including any required DLL and the
- gnutls.h file) and an installer at http://josefsson.org/gnutls4win/.
+ header files) at http://sourceforge.net/projects/ezwinports/files/.
+
+* libxml2 support
+
+ In order to support libxml2 at runtime, a libxml2-enabled Emacs must
+ be able to find the relevant DLLs during startup; failure to do so
+ is not an error, but libxml2 features won't be available to the
+ running session.
+
+ You can get pre-built binaries (including any required DLL and the
+ header files) at http://sourceforge.net/projects/ezwinports/files/.
* Uninstalling Emacs
diff --git a/nt/addpm.c b/nt/addpm.c
index c45b4aef68d..361726b10e8 100644
--- a/nt/addpm.c
+++ b/nt/addpm.c
@@ -1,5 +1,5 @@
/* Add entries to the GNU Emacs Program Manager folder.
- Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/addsection.c b/nt/addsection.c
index f189df0d6e3..d720dec428f 100644
--- a/nt/addsection.c
+++ b/nt/addsection.c
@@ -1,5 +1,5 @@
/* Add an uninitialized data section to an executable.
- Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -35,10 +35,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
in \\win32sdk\mstools\samples\image\include\imagehlp.h. */
PIMAGE_NT_HEADERS
-(__stdcall * pfnCheckSumMappedFile) (LPVOID BaseAddress,
- DWORD FileLength,
- LPDWORD HeaderSum,
- LPDWORD CheckSum);
+(__stdcall * pfnCheckSumMappedFile) (PVOID BaseAddress,
+ DWORD_PTR FileLength,
+ PDWORD_PTR HeaderSum,
+ PDWORD_PTR CheckSum);
#undef min
#undef max
@@ -164,7 +164,7 @@ find_section (const char *name, IMAGE_NT_HEADERS *nt_header)
/* Return pointer to section header for section containing the given
relative virtual address. */
IMAGE_SECTION_HEADER *
-rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header)
+rva_to_section (DWORD_PTR rva, IMAGE_NT_HEADERS * nt_header)
{
PIMAGE_SECTION_HEADER section;
int i;
@@ -179,7 +179,7 @@ rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header)
some very old exes (eg. gzip dated Dec 1993). Since
w32_executable_type relies on this function to work reliably,
we need to cope with this. */
- DWORD real_size = max (section->SizeOfRawData,
+ DWORD_PTR real_size = max (section->SizeOfRawData,
section->Misc.VirtualSize);
if (rva >= section->VirtualAddress
&& rva < section->VirtualAddress + real_size)
@@ -192,7 +192,7 @@ rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header)
/* Return pointer to section header for section containing the given
offset in its raw data area. */
IMAGE_SECTION_HEADER *
-offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header)
+offset_to_section (DWORD_PTR offset, IMAGE_NT_HEADERS * nt_header)
{
PIMAGE_SECTION_HEADER section;
int i;
@@ -212,8 +212,8 @@ offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header)
/* Return offset to an object in dst, given offset in src. We assume
there is at least one section in both src and dst images, and that
the some sections may have been added to dst (after sections in src). */
-static DWORD
-relocate_offset (DWORD offset,
+static DWORD_PTR
+relocate_offset (DWORD_PTR offset,
IMAGE_NT_HEADERS * src_nt_header,
IMAGE_NT_HEADERS * dst_nt_header)
{
@@ -247,32 +247,33 @@ relocate_offset (DWORD offset,
}
#define OFFSET_TO_RVA(offset, section) \
- (section->VirtualAddress + ((DWORD)(offset) - section->PointerToRawData))
+ (section->VirtualAddress + ((DWORD_PTR)(offset) - section->PointerToRawData))
#define RVA_TO_OFFSET(rva, section) \
- (section->PointerToRawData + ((DWORD)(rva) - section->VirtualAddress))
+ (section->PointerToRawData + ((DWORD_PTR)(rva) - section->VirtualAddress))
#define RVA_TO_SECTION_OFFSET(rva, section) \
- ((DWORD)(rva) - section->VirtualAddress)
+ ((DWORD_PTR)(rva) - section->VirtualAddress)
/* Convert address in executing image to RVA. */
-#define PTR_TO_RVA(ptr) ((DWORD)(ptr) - (DWORD) GetModuleHandle (NULL))
+#define PTR_TO_RVA(ptr) ((DWORD_PTR)(ptr) - (DWORD_PTR) GetModuleHandle (NULL))
#define PTR_TO_OFFSET(ptr, pfile_data) \
((unsigned const char *)(ptr) - (pfile_data)->file_base)
#define OFFSET_TO_PTR(offset, pfile_data) \
- ((pfile_data)->file_base + (DWORD)(offset))
+ ((pfile_data)->file_base + (DWORD_PTR)(offset))
-#define ROUND_UP(p, align) (((DWORD)(p) + (align)-1) & ~((align)-1))
-#define ROUND_DOWN(p, align) ((DWORD)(p) & ~((align)-1))
+#define ROUND_UP(p, align) \
+ (((DWORD_PTR)(p) + (align)-1) & ~((DWORD_PTR)(align)-1))
+#define ROUND_DOWN(p, align) ((DWORD_PTR)(p) & ~((DWORD_PTR)(align)-1))
static void
copy_executable_and_add_section (file_data *p_infile,
file_data *p_outfile,
const char *new_section_name,
- DWORD new_section_size)
+ DWORD_PTR new_section_size)
{
unsigned char *dst;
PIMAGE_DOS_HEADER dos_header;
@@ -280,7 +281,7 @@ copy_executable_and_add_section (file_data *p_infile,
PIMAGE_NT_HEADERS dst_nt_header;
PIMAGE_SECTION_HEADER section;
PIMAGE_SECTION_HEADER dst_section;
- DWORD offset;
+ DWORD_PTR offset;
int i;
int be_verbose = GetEnvironmentVariable ("DEBUG_DUMP", NULL, 0) > 0;
@@ -317,17 +318,17 @@ copy_executable_and_add_section (file_data *p_infile,
Note that dst is updated implicitly by each COPY_CHUNK. */
dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base;
- nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) +
+ nt_header = (PIMAGE_NT_HEADERS) (((unsigned char *) dos_header) +
dos_header->e_lfanew);
section = IMAGE_FIRST_SECTION (nt_header);
dst = (unsigned char *) p_outfile->file_base;
COPY_CHUNK ("Copying DOS header...", dos_header,
- (DWORD) nt_header - (DWORD) dos_header, be_verbose);
+ (DWORD_PTR) nt_header - (DWORD_PTR) dos_header, be_verbose);
dst_nt_header = (PIMAGE_NT_HEADERS) dst;
COPY_CHUNK ("Copying NT header...", nt_header,
- (DWORD) section - (DWORD) nt_header, be_verbose);
+ (DWORD_PTR) section - (DWORD_PTR) nt_header, be_verbose);
dst_section = (PIMAGE_SECTION_HEADER) dst;
COPY_CHUNK ("Copying section table...", section,
nt_header->FileHeader.NumberOfSections * sizeof (*section),
@@ -509,8 +510,8 @@ main (int argc, char **argv)
/* Patch up header fields; profiler is picky about this. */
{
HANDLE hImagehelp = LoadLibrary ("imagehlp.dll");
- DWORD headersum;
- DWORD checksum;
+ DWORD_PTR headersum;
+ DWORD_PTR checksum;
dos_header = (PIMAGE_DOS_HEADER) out_file.file_base;
nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew);
diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c
index 8c39694decc..7c522440072 100644
--- a/nt/cmdproxy.c
+++ b/nt/cmdproxy.c
@@ -1,5 +1,5 @@
/* Proxy shell designed for use with Emacs on Windows 95 and NT.
- Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
Accepts subset of Unix sh(1) command-line options, for compatibility
with elisp code written for Unix. When possible, executes external
@@ -512,7 +512,7 @@ main (int argc, char ** argv)
char modname[MAX_PATH];
char path[MAX_PATH];
char dir[MAX_PATH];
-
+ int status;
interactive = TRUE;
@@ -551,20 +551,73 @@ main (int argc, char ** argv)
/* Although Emacs always sets argv[0] to an absolute pathname, we
might get run in other ways as well, so convert argv[0] to an
- absolute name before comparing to the module name. Don't get
- caught out by mixed short and long names. */
- GetShortPathName (modname, modname, sizeof (modname));
+ absolute name before comparing to the module name. */
path[0] = '\0';
- if (!SearchPath (NULL, argv[0], ".exe", sizeof (path), path, &progname)
- || !GetShortPathName (path, path, sizeof (path))
- || stricmp (modname, path) != 0)
+ /* The call to SearchPath will find argv[0] in the current
+ directory, append ".exe" to it if needed, and also canonicalize
+ it, to resolve references to ".", "..", etc. */
+ status = SearchPath (NULL, argv[0], ".exe", sizeof (path), path,
+ &progname);
+ if (!(status > 0 && stricmp (modname, path) == 0))
{
- /* We are being used as a helper to run a DOS app; just pass
- command line to DOS app without change. */
- /* TODO: fill in progname. */
- if (spawn (NULL, GetCommandLine (), dir, &rc))
- return rc;
- fail ("Could not run %s\n", GetCommandLine ());
+ if (status <= 0)
+ {
+ char *s;
+
+ /* Make sure we have argv[0] in path[], as the failed
+ SearchPath might not have copied it there. */
+ strcpy (path, argv[0]);
+ /* argv[0] could include forward slashes; convert them all
+ to backslashes, for strrchr calls below to DTRT. */
+ for (s = path; *s; s++)
+ if (*s == '/')
+ *s = '\\';
+ }
+ /* Perhaps MODNAME and PATH use mixed short and long file names. */
+ if (!(GetShortPathName (modname, modname, sizeof (modname))
+ && GetShortPathName (path, path, sizeof (path))
+ && stricmp (modname, path) == 0))
+ {
+ /* Sometimes GetShortPathName fails because one or more
+ directories leading to argv[0] have issues with access
+ rights. In that case, at least we can compare the
+ basenames. Note: this disregards the improbable case of
+ invoking a program of the same name from another
+ directory, since the chances of that other executable to
+ be both our namesake and a 16-bit DOS application are nil. */
+ char *p = strrchr (path, '\\');
+ char *q = strrchr (modname, '\\');
+ char *pdot, *qdot;
+
+ if (!p)
+ p = strchr (path, ':');
+ if (!p)
+ p = path;
+ else
+ p++;
+ if (!q)
+ q = strchr (modname, ':');
+ if (!q)
+ q = modname;
+ else
+ q++;
+
+ pdot = strrchr (p, '.');
+ if (!pdot || stricmp (pdot, ".exe") != 0)
+ pdot = p + strlen (p);
+ qdot = strrchr (q, '.');
+ if (!qdot || stricmp (qdot, ".exe") != 0)
+ qdot = q + strlen (q);
+ if (pdot - p != qdot - q || strnicmp (p, q, pdot - p) != 0)
+ {
+ /* We are being used as a helper to run a DOS app; just
+ pass command line to DOS app without change. */
+ /* TODO: fill in progname. */
+ if (spawn (NULL, GetCommandLine (), dir, &rc))
+ return rc;
+ fail ("Could not run %s\n", GetCommandLine ());
+ }
+ }
}
/* Process command line. If running interactively (-c or /c not
diff --git a/nt/config.nt b/nt/config.nt
index c77faccb3b4..60223306752 100644
--- a/nt/config.nt
+++ b/nt/config.nt
@@ -1,6 +1,6 @@
-/* GNU Emacs site configuration template file. -*- C -*-
+/* GNU Emacs site configuration template file.
-Copyright (C) 1988, 1993-1994, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1988, 1993-1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -17,280 +17,277 @@ 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/>. */
+/* NOTE:
+ This file is intentionally kept in sync with autogen/config.in to
+ ease maintenance. Please do not remove non-Windows related stuff
+ unless strictly necessary. Also, before adding anything here
+ consider whether inc/ms-w32.h would be a better place; this is
+ particularly true for gcc vs. MSVC conditional defines, MinGW or
+ MSVC specific code, and macros not already defined in config.in. */
-/* No code in Emacs #includes config.h twice, but some of the code
+/* No code in Emacs #includes config.h twice, but some bits of code
intended to work with other packages as well (like gmalloc.c)
think they can include it as many times as they like. */
#ifndef EMACS_CONFIG_H
#define EMACS_CONFIG_H
-/* These are all defined in the top-level Makefile by configure.
- They're here only for reference. */
-/* Define LISP_FLOAT_TYPE if you want emacs to support floating-point
- numbers. */
-#undef LISP_FLOAT_TYPE
+/* Define if building universal (internal helper macro) */
+#undef AC_APPLE_UNIVERSAL_BUILD
-/* Define GNU_MALLOC if you want to use the GNU memory allocator. */
-#define GNU_MALLOC
+/* Define to use the convention that & in the full name stands for the login
+ id. */
+#undef AMPERSAND_FULL_NAME
-/* Define if you are using the GNU C Library. */
-#undef DOUG_LEA_MALLOC
+/* Define to the number of bits in type 'ptrdiff_t'. */
+#undef BITSIZEOF_PTRDIFF_T
-/* Define REL_ALLOC if you want to use the relocating allocator for
- buffer space. */
-#define REL_ALLOC
+/* Define to the number of bits in type 'sig_atomic_t'. */
+#undef BITSIZEOF_SIG_ATOMIC_T
-/* Enable conservative stack marking for GC. */
-#define GC_MARK_STACK 1
+/* Define to the number of bits in type 'size_t'. */
+#undef BITSIZEOF_SIZE_T
-/* MSVC ignores the "register" keyword, so test fails even though
- setjmp does work. */
-#define GC_SETJMP_WORKS 1
+/* Define to the number of bits in type 'wchar_t'. */
+#undef BITSIZEOF_WCHAR_T
-/* Define HAVE_X_WINDOWS if you want to use the X window system. */
-#undef HAVE_X_WINDOWS
+/* Define to the number of bits in type 'wint_t'. */
+#undef BITSIZEOF_WINT_T
-/* Define HAVE_X11 if you want to use version 11 of X windows.
- Otherwise, Emacs expects to use version 10. */
-#undef HAVE_X11
+/* Define if get_current_dir_name should not be used. */
+#undef BROKEN_GET_CURRENT_DIR_NAME
-/* Define if using an X toolkit. */
-#undef USE_X_TOOLKIT
+/* Define on FreeBSD to work around an issue when reading from a PTY. */
+#undef BROKEN_PTY_READ_AFTER_EAGAIN
-/* Define this if you're using XFree386. */
-#undef HAVE_XFREE386
+/* Define if the system is compatible with BSD 4.2. */
+#undef BSD4_2
-/* Define this if you have Motif 2.1 or newer. */
-#undef HAVE_MOTIF_2_1
+/* Define if the system is compatible with BSD 4.2. */
+#undef BSD_SYSTEM
-/* Define HAVE_MENUS if you have mouse menus.
- (This is automatic if you use X, but the option to specify it remains.)
- It is also defined with other window systems that support xmenu.c. */
-#undef HAVE_MENUS
+/* Define if AH_BOTTOM should change BSD_SYSTEM. */
+#undef BSD_SYSTEM_AHB
-/* Define if we have the X11R6 or newer version of Xt. */
-#undef HAVE_X11XTR6
+/* Define if Emacs cannot be dumped on your system. */
+#undef CANNOT_DUMP
-/* Define if we have the X11R6 or newer version of Xlib. */
-#undef HAVE_X11R6
+/* Define this to enable compile time checks for the Lisp_Object data type. */
+/* #undef CHECK_LISP_OBJECT_TYPE */
-/* Define if netdb.h declares h_errno. */
-#undef HAVE_H_ERRNO
+/* Define if you want lock files to be written, so that Emacs can tell
+ instantly when you try to modify a file that someone else has modified in
+ his/her Emacs. */
+#undef CLASH_DETECTION
-/* If we're using any sort of window system, define some consequences. */
-#ifdef HAVE_X_WINDOWS
-#define HAVE_WINDOW_SYSTEM
-#define HAVE_MOUSE
-#endif
+/* Short copyright string for this version of Emacs. */
+#define COPYRIGHT "Copyright (C) 2012 Free Software Foundation, Inc."
-/* Define USE_TEXT_PROPERTIES to support visual and other properties
- on text. */
-#define USE_TEXT_PROPERTIES
+/* Define to one of '_getb67', 'GETB67', 'getb67' for Cray-2 and Cray-YMP
+ systems. This function is required for 'alloca.c' support on those systems.
+ */
+#undef CRAY_STACKSEG_END
-/* Define USER_FULL_NAME to return a string
- that is the user's full name.
- It can assume that the variable `pw'
- points to the password file entry for this user.
+/* Define if the system is Cygwin. */
+#undef CYGWIN
- At some sites, the pw_gecos field contains
- the user's full name. If neither this nor any other
- field contains the right thing, use pw_name,
- giving the user's login name, since that is better than nothing. */
-#define USER_FULL_NAME pw->pw_gecos
+/* Define to 1 if using 'alloca.c'. */
+#undef C_ALLOCA
-/* Define AMPERSAND_FULL_NAME if you use the convention
- that & in the full name stands for the login id. */
-#undef AMPERSAND_FULL_NAME
+/* Define if the system is Darwin. */
+#undef DARWIN_OS
-/* Things set by --with options in the configure script. */
+/* Extra bits to be or'd in with any pointers stored in a Lisp_Object. */
+#undef DATA_SEG_BITS
-/* Define to support POP mail retrieval. */
-#undef MAIL_USE_POP
+/* Address of the start of the data segment. */
+#undef DATA_START
-/* Define to support Kerberos-authenticated POP mail retrieval. */
-#undef KERBEROS
-/* Define to use Kerberos 5 instead of Kerberos 4 */
-#undef KERBEROS5
-/* Define to support GSS-API in addition to (or instead of) Kerberos */
-#undef GSSAPI
+/* Name of the default sound device. */
+#undef DEFAULT_SOUND_DEVICE
-/* Define to support using a Hesiod database to find the POP server. */
-#undef HESIOD
+/* Character that separates a device in a file name. */
+#define DEVICE_SEP ':'
-/* Some things figured out by the configure script, grouped as they are in
- configure.in. */
-#ifndef _ALL_SOURCE /* suppress warning if this is pre-defined */
-#undef _ALL_SOURCE
-#endif
-#undef HAVE_SYS_SELECT_H
-#undef HAVE_SYS_TIMEB_H
-#undef HAVE_SYS_TIME_H
-#undef HAVE_UNISTD_H
-#undef HAVE_UTIME_H
-#undef HAVE_LINUX_VERSION_H
-#undef HAVE_SYS_SYSTEMINFO_H
-#undef HAVE_TERMIOS_H
-#undef HAVE_STRINGS_H
-#undef HAVE_PWD_H
+/* Define to 1 for DGUX with <sys/dg_sys_info.h>. */
+#undef DGUX
-#undef HAVE_LIBDNET
-#undef HAVE_LIBPTHREADS
-#undef HAVE_LIBRESOLV
-#undef HAVE_LIBXMU
-#undef HAVE_LIBNCURSES
-#undef HAVE_LIBINTL
+/* Character that separates directories in a file name. */
+#define DIRECTORY_SEP '/'
-/* movemail Kerberos support */
-/* libraries */
-#undef HAVE_LIBKRB
-#undef HAVE_LIBKRB4
-#undef HAVE_LIBDES
-#undef HAVE_LIBDES425
-#undef HAVE_LIBKRB5
-#undef HAVE_LIBCRYPTO
-#undef HAVE_LIBCOM_ERR
-/* header files */
-#undef HAVE_KRB5_H
-#undef HAVE_DES_H
-#undef HAVE_KRB_H
-#undef HAVE_KERBEROSIV_DES_H
-#undef HAVE_KERBEROSIV_KRB_H
-#undef HAVE_KERBEROS_DES_H
-#undef HAVE_KERBEROS_KRB_H
-#undef HAVE_COM_ERR_H
+/* Define if process.c does not need to close a pty to make it a controlling
+ terminal (it is already a controlling terminal of the subprocess, because
+ we did ioctl TIOCSCTTY). */
+#undef DONT_REOPEN_PTY
-/* GSS-API libraries and headers */
-#undef HAVE_LIBGSSAPI_KRB5
-#undef HAVE_LIBGSSAPI
-#undef HAVE_GSSAPI_H
+/* Define if the system is MS DOS or MS Windows. */
+#define DOS_NT
-/* Mail-file locking */
-#undef HAVE_LIBMAIL
-#undef HAVE_MAILLOCK_H
-#undef HAVE_TOUCHLOCK
+/* Define to 1 if you are using the GNU C Library. */
+#undef DOUG_LEA_MALLOC
-#undef HAVE_ALLOCA_H
+/* Define to the canonical Emacs configuration name. */
+#undef EMACS_CONFIGURATION
-#undef HAVE_GETTIMEOFDAY
-/* If we don't have gettimeofday,
- the test for GETTIMEOFDAY_ONE_ARGUMENT may succeed,
- but we should ignore it. */
-#ifdef HAVE_GETTIMEOFDAY
-#undef GETTIMEOFDAY_ONE_ARGUMENT
-#endif
-#undef HAVE_GETHOSTNAME
-#undef HAVE_GETDOMAINNAME
-#undef HAVE_DUP2
-#undef HAVE_RENAME
-#undef HAVE_CLOSEDIR
+/* Define to the options passed to configure. */
+#undef EMACS_CONFIG_OPTIONS
-#undef TM_IN_SYS_TIME
-#undef HAVE_TM_ZONE
+/* Define to 1 if expensive run-time data type and consistency checks are
+ enabled. */
+#undef ENABLE_CHECKING
-/* Define to 1 if you don't have `tm_zone' but do have the external array
- `tzname'. */
-#define HAVE_TZNAME 1
+/* Letter to use in finding device name of first PTY, if PTYs are supported.
+ */
+#define FIRST_PTY_LETTER 'a'
-/* Define to 1 if you have the declaration of `tzname', and to 0 if you don't.
+/* Enable compile-time and run-time bounds-checking, and some warnings,
+ without upsetting glibc 2.15+. */
+ #if !defined _FORTIFY_SOURCE && defined __OPTIMIZE__ && __OPTIMIZE__
+ # define _FORTIFY_SOURCE 2
+ #endif
+
+
+/* Define to 1 if futimesat mishandles a NULL file name. */
+#undef FUTIMESAT_NULL_BUG
+
+/* Define this to check for errors in cons list. */
+#undef GC_CHECK_CONS_LIST
+
+/* Define this temporarily to hunt a bug. If defined, the size of strings is
+ redundantly recorded in sdata structures so that it can be compared to the
+ sizes recorded in Lisp strings. */
+#undef GC_CHECK_STRING_BYTES
+
+/* Define this to check the string free list. */
+#undef GC_CHECK_STRING_FREE_LIST
+
+/* Define this to check for short string overrun. */
+#undef GC_CHECK_STRING_OVERRUN
+
+/* Mark a secondary stack, like the register stack on the ia64. */
+#undef GC_MARK_SECONDARY_STACK
+
+/* Define to GC_USE_GCPROS_AS_BEFORE if conservative garbage collection is not
+ known to work. */
+#define GC_MARK_STACK 1
+
+/* Define if setjmp is known to save all registers relevant for conservative
+ garbage collection in the jmp_buf.
+ MSVC ignores the "register" keyword, so test fails even though
+ setjmp does work. */
+#define GC_SETJMP_WORKS 1
+
+/* Define to the type of elements in the array set by `getgroups'. Usually
+ this is either `int' or `gid_t'. */
+#undef GETGROUPS_T
+
+/* Define this to 1 if getgroups(0,NULL) does not return the number of groups.
*/
-#define HAVE_DECL_TZNAME 1
+#undef GETGROUPS_ZERO_BUG
-#undef const
+/* Define if gettimeofday clobbers the localtime buffer. */
+#undef GETTIMEOFDAY_CLOBBERS_LOCALTIME
-#undef HAVE_LONG_FILE_NAMES
+/* Define this to 'void' or 'struct timezone' to match the system's
+ declaration of the second argument to gettimeofday. */
+#undef GETTIMEOFDAY_TIMEZONE
-#undef CRAY_STACKSEG_END
+/* Define this to enable glyphs debugging code. */
+/* #undef GLYPH_DEBUG */
-#undef HAVE_LIBXBSD
-#undef HAVE_XRMSETDATABASE
-#undef HAVE_XSCREENRESOURCESTRING
-#undef HAVE_XSCREENNUMBEROFSCREEN
-#undef HAVE_XSETWMPROTOCOLS
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module close-stream shall be considered present. */
+#undef GNULIB_CLOSE_STREAM
-#undef HAVE_MKDIR
-#undef HAVE_RMDIR
-#undef HAVE_SYSINFO
-#undef HAVE_RANDOM
-#undef HAVE_LRAND48
-#undef HAVE_MEMCPY
-#undef HAVE_MEMMOVE
-#undef HAVE_MEMSET
-#undef HAVE_MEMCMP
-#undef HAVE_LOGB
-#undef HAVE_FREXP
-#undef HAVE_FMOD
-#undef HAVE_RINT
-#undef HAVE_CBRT
-#undef HAVE_FTIME
-#undef HAVE_RES_INIT /* For -lresolv on Suns. */
-#undef HAVE_SETSID
-#undef HAVE_FPATHCONF
-#undef HAVE_SELECT
-#undef HAVE_EUIDACCESS
-#undef HAVE_GETPAGESIZE
-#undef HAVE_GET_CURRENT_DIR_NAME
-#undef HAVE_TZSET
-#undef HAVE_SETLOCALE
-#undef HAVE_UTIMES
-#undef HAVE_SETRLIMIT
-#undef HAVE_SETPGID
-#undef HAVE_GETCWD
-#undef HAVE_SHUTDOWN
-#undef HAVE_STRFTIME
-/* Standard Windows strftime does not support POSIX.2 extensions. */
-#define STRFTIME_NO_POSIX2 1
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module faccessat shall be considered present. */
+#undef GNULIB_FACCESSAT
-#define HAVE_SENDTO 1
-#define HAVE_RECVFROM 1
-#define HAVE_GETSOCKOPT 1
-#define HAVE_SETSOCKOPT 1
-#define HAVE_GETSOCKNAME 1
-#define HAVE_GETPEERNAME 1
-#define HAVE_SNPRINTF 1
-#define HAVE_LANGINFO_CODESET 1
-/* Local (unix) sockets are not supported. */
-#undef HAVE_SYS_UN_H
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module fscanf shall be considered present. */
+#undef GNULIB_FSCANF
-#define LOCALTIME_CACHE
-#undef HAVE_INET_SOCKETS
+/* enable some gnulib portability checks */
+#undef GNULIB_PORTCHECK
-#undef HAVE_AIX_SMT_EXP
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module scanf shall be considered present. */
+#undef GNULIB_SCANF
-/* Define if you have the ANSI `strerror' function.
- Otherwise you must have the variable `char *sys_errlist[]'. */
-#undef HAVE_STRERROR
+/* Define if ths system is compatible with GNU/Linux. */
+#undef GNU_LINUX
-/* Define if `sys_siglist' is declared by <signal.h>. */
-#undef SYS_SIGLIST_DECLARED
+/* Define to 1 if you want to use the GNU memory allocator. */
+#define GNU_MALLOC 1
-/* Define if `struct utimbuf' is declared by <utime.h>. */
-#undef HAVE_STRUCT_UTIMBUF
+/* Define to set the G_SLICE environment variable to "always-malloc" at
+ startup, if using GTK. */
+#undef G_SLICE_ALWAYS_MALLOC
-/* Define if `struct timeval' is declared by <sys/time.h>. */
-#undef HAVE_TIMEVAL
+/* Define to 1 if you have the `access' function. */
+#undef HAVE_ACCESS
-/* Define to 1 if you have the <getopt.h> header file. */
-#undef HAVE_GETOPT_H
+/* Define to 1 if the file /usr/lpp/X11/bin/smt.exp exists. */
+#undef HAVE_AIX_SMT_EXP
-/* Define to 1 if you have the `getopt_long_only' function. */
-#undef HAVE_GETOPT_LONG_ONLY
+/* Define to 1 if you have the `alarm' function. */
+#undef HAVE_ALARM
-/* Preprocessor macros needed for gnulib imports. */
+/* Define to 1 if you have 'alloca' after including <alloca.h>, a header that
+ may be supplied by this distribution. */
+#undef HAVE_ALLOCA
-/* Define to 1 if GCC-style __attribute__ ((__aligned__ (expr))) works. */
-#ifdef __GNUC__
-#define HAVE_ATTRIBUTE_ALIGNED 1
-#else
-#undef HAVE_ATTRIBUTE_ALIGNED
-#endif
+/* Define to 1 if you have <alloca.h> and it should be used (not on Ultrix).
+ */
+#undef HAVE_ALLOCA_H
+
+/* Define to 1 if ALSA is available. */
+#undef HAVE_ALSA
/* Define to 1 if strtold conforms to C99. */
-#ifdef __GNUC__
-#define HAVE_C99_STRTOLD 1
-#else
#undef HAVE_C99_STRTOLD
-#endif
+
+/* Define to 1 if you have the `cfmakeraw' function. */
+#undef HAVE_CFMAKERAW
+
+/* Define to 1 if you have the `cfsetspeed' function. */
+#undef HAVE_CFSETSPEED
+
+/* Define to 1 if you have the `clock_gettime' function. */
+#undef HAVE_CLOCK_GETTIME
+
+/* Define to 1 if you have the `clock_settime' function. */
+#undef HAVE_CLOCK_SETTIME
+
+/* Define to 1 if you have the <coff.h> header file. */
+#undef HAVE_COFF_H
+
+/* Define to 1 if you have the <com_err.h> header file. */
+#undef HAVE_COM_ERR_H
+
+/* Define to 1 if you have the `copysign' function. */
+#undef HAVE_COPYSIGN
+
+/* Define to 1 if using D-Bus. */
+#undef HAVE_DBUS
+
+/* Define to 1 if you have the `dbus_type_is_valid' function. */
+#undef HAVE_DBUS_TYPE_IS_VALID
+
+/* Define to 1 if you have the `dbus_validate_bus_name' function. */
+#undef HAVE_DBUS_VALIDATE_BUS_NAME
+
+/* Define to 1 if you have the `dbus_validate_interface' function. */
+#undef HAVE_DBUS_VALIDATE_INTERFACE
+
+/* Define to 1 if you have the `dbus_validate_member' function. */
+#undef HAVE_DBUS_VALIDATE_MEMBER
+
+/* Define to 1 if you have the `dbus_validate_path' function. */
+#undef HAVE_DBUS_VALIDATE_PATH
+
+/* Define to 1 if you have the `dbus_watch_get_unix_fd' function. */
+#undef HAVE_DBUS_WATCH_GET_UNIX_FD
/* Define to 1 if you have the declaration of `getenv', and to 0 if you don't.
*/
@@ -300,8 +297,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
don't. */
#undef HAVE_DECL_LOCALTIME_R
-/* Define to 1 if you have the `localtime_r' function. */
-#undef HAVE_LOCALTIME_R
+/* Define to 1 if you have the declaration of `strmode', and to 0 if you
+ don't. */
+#undef HAVE_DECL_STRMODE
+
+/* Define to 1 if you have the declaration of `strtoimax', and to 0 if you
+ don't. */
+#undef HAVE_DECL_STRTOIMAX
/* Define to 1 if you have the declaration of `strtoll', and to 0 if you
don't. */
@@ -315,237 +317,1361 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
don't. */
#define HAVE_DECL_STRTOUMAX 1
+/* Define to 1 if you have the declaration of `sys_siglist', and to 0 if you
+ don't. */
+#undef HAVE_DECL_SYS_SIGLIST
+
+/* Define to 1 if you have the declaration of `tzname', and to 0 if you don't.
+ */
+#define HAVE_DECL_TZNAME 1
+
+/* Define to 1 if you have the declaration of `__fpending', and to 0 if you
+ don't. */
+#undef HAVE_DECL___FPENDING
+
+/* Define to 1 if you have the declaration of `__sys_siglist', and to 0 if you
+ don't. */
+#undef HAVE_DECL___SYS_SIGLIST
+
+/* Define to 1 if you have the <des.h> header file. */
+#undef HAVE_DES_H
+
+/* Define to 1 if dynamic ptys are supported. */
+#undef HAVE_DEV_PTMX
+
+/* Define to 1 if you have the `difftime' function. */
+#undef HAVE_DIFFTIME
+
+/* Define to 1 if you have the 'dup2' function. */
+#define HAVE_DUP2 1
+
+/* Define to 1 if you have the `eaccess' function. */
+#undef HAVE_EACCESS
+
+/* Define to 1 if you have the `endgrent' function. */
+#undef HAVE_ENDGRENT
+
+/* Define to 1 if you have the `endpwent' function. */
+#undef HAVE_ENDPWENT
+
+/* Define if you have the declaration of environ. */
+#undef HAVE_ENVIRON_DECL
+
+/* Define to 1 if you have the `euidaccess' function. */
+#undef HAVE_EUIDACCESS
+
+/* Define to 1 if you have the <execinfo.h> header file. */
+#define HAVE_EXECINFO_H 1
+
+/* Define to 1 if you have the `faccessat' function. */
+#undef HAVE_FACCESSAT
+
+/* Define to 1 if you have the `fork' function. */
+#undef HAVE_FORK
+
+/* Define to 1 if you have the `freeifaddrs' function. */
+#undef HAVE_FREEIFADDRS
+
+/* Define to 1 if using the freetype and fontconfig libraries. */
+#undef HAVE_FREETYPE
+
+/* Define to 1 if fseeko (and presumably ftello) exists and is declared. */
+#undef HAVE_FSEEKO
+
+/* Define to 1 if you have the `fsync' function. */
+#define HAVE_FSYNC 1
+
+/* Define to 1 if you have the `futimens' function. */
+#undef HAVE_FUTIMENS
+
+/* Define to 1 if you have the `futimes' function. */
+#undef HAVE_FUTIMES
+
+/* Define to 1 if you have the `futimesat' function. */
+#undef HAVE_FUTIMESAT
+
+/* Define to 1 if you have the `gai_strerror' function. */
+#undef HAVE_GAI_STRERROR
+
+/* Define to 1 if using GConf. */
+#undef HAVE_GCONF
+
+/* Define to 1 if you have the `getaddrinfo' function. */
+#undef HAVE_GETADDRINFO
+
+/* Define to 1 if you have the `getdelim' function. */
+#undef HAVE_GETDELIM
+
+/* Define to 1 if you have the `getgrent' function. */
+#undef HAVE_GETGRENT
+
+/* Define to 1 if your system has a working `getgroups' function. */
+#undef HAVE_GETGROUPS
+
+/* Define to 1 if you have the `gethostname' function. */
+#define HAVE_GETHOSTNAME 1
+
+/* Define to 1 if you have the `getifaddrs' function. */
+#undef HAVE_GETIFADDRS
+
+/* Define to 1 if you have the `getline' function. */
+#undef HAVE_GETLINE
+
+/* Define to 1 if you have the <getopt.h> header file. */
+#undef HAVE_GETOPT_H
+
+/* Define to 1 if you have the `getopt_long_only' function. */
+#undef HAVE_GETOPT_LONG_ONLY
+
+/* Define to 1 if you have the `getpagesize' function. */
+#define HAVE_GETPAGESIZE 1
+
+/* Define to 1 if you have the `getpeername' function. */
+#define HAVE_GETPEERNAME 1
+
+/* Define to 1 if you have the `getpt' function. */
+#undef HAVE_GETPT
+
+/* Define to 1 if you have the `getpwent' function. */
+#undef HAVE_GETPWENT
+
+/* Define to 1 if you have the `getrlimit' function. */
+#undef HAVE_GETRLIMIT
+
+/* Define to 1 if you have the `getrusage' function. */
+#undef HAVE_GETRUSAGE
+
+/* Define to 1 if you have the `getsockname' function. */
+#define HAVE_GETSOCKNAME 1
+
+/* Define to 1 if you have the `gettimeofday' function. */
+#define HAVE_GETTIMEOFDAY 1
+
+/* Define to 1 if you have the `get_current_dir_name' function. */
+#undef HAVE_GET_CURRENT_DIR_NAME
+
+/* Define to 1 if you have a gif (or ungif) library. */
+#undef HAVE_GIF
+
+/* Define if using GnuTLS. */
+#undef HAVE_GNUTLS
+
+/* Define if using GnuTLS certificate verification callbacks. */
+#undef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+
+/* Define to 1 if you have the `gnutls_certificate_set_verify_function'
+ function. */
+#undef HAVE_GNUTLS_CERTIFICATE_SET_VERIFY_FUNCTION
+
+/* Define to 1 if you have the gpm library (-lgpm). */
+#undef HAVE_GPM
+
+/* Define to 1 if you have the `grantpt' function. */
+#undef HAVE_GRANTPT
+
+/* Define to 1 if using GSettings. */
+#undef HAVE_GSETTINGS
+
+/* Define to 1 if using GTK 3 or later. */
+#undef HAVE_GTK3
+
+/* Define to 1 if you have the `gtk_adjustment_get_page_size' function. */
+#undef HAVE_GTK_ADJUSTMENT_GET_PAGE_SIZE
+
+/* Define to 1 if you have the `gtk_dialog_get_action_area' function. */
+#undef HAVE_GTK_DIALOG_GET_ACTION_AREA
+
+/* Define to 1 if you have the `gtk_file_selection_new' function. */
+#undef HAVE_GTK_FILE_SELECTION_NEW
+
+/* Define to 1 if you have the `gtk_main' function. */
+#undef HAVE_GTK_MAIN
+
+/* Define to 1 if you have the `gtk_orientable_set_orientation' function. */
+#undef HAVE_GTK_ORIENTABLE_SET_ORIENTATION
+
+/* Define to 1 if you have the `gtk_widget_get_mapped' function. */
+#undef HAVE_GTK_WIDGET_GET_MAPPED
+
+/* Define to 1 if you have the `gtk_widget_get_sensitive' function. */
+#undef HAVE_GTK_WIDGET_GET_SENSITIVE
+
+/* Define to 1 if you have the `gtk_widget_get_window' function. */
+#undef HAVE_GTK_WIDGET_GET_WINDOW
+
+/* Define to 1 if you have the `gtk_widget_set_has_window' function. */
+#undef HAVE_GTK_WIDGET_SET_HAS_WINDOW
+
+/* Define to 1 if you have the `gtk_window_set_has_resize_grip' function. */
+#undef HAVE_GTK_WINDOW_SET_HAS_RESIZE_GRIP
+
+/* Define to 1 if you have the `g_type_init' function. */
+#undef HAVE_G_TYPE_INIT
+
+/* Define to 1 if netdb.h declares h_errno. */
+#define HAVE_H_ERRNO 1
+
+/* Define to 1 if you have the <ifaddrs.h> header file. */
+#undef HAVE_IFADDRS_H
+
+/* Define to 1 if using imagemagick. */
+#undef HAVE_IMAGEMAGICK
+
+/* Define to 1 if you have inet sockets. */
+#define HAVE_INET_SOCKETS 1
+
+/* Define to 1 if you have the <inttypes.h> header file. */
+#undef HAVE_INTTYPES_H
+
+/* Define to 1 if you have the jpeg library (-ljpeg). */
+#undef HAVE_JPEG
+
+/* Define to 1 if you have the <kerberosIV/des.h> header file. */
+#undef HAVE_KERBEROSIV_DES_H
+
+/* Define to 1 if you have the <kerberosIV/krb.h> header file. */
+#undef HAVE_KERBEROSIV_KRB_H
+
+/* Define to 1 if you have the <kerberos/des.h> header file. */
+#undef HAVE_KERBEROS_DES_H
+
+/* Define to 1 if you have the <kerberos/krb.h> header file. */
+#undef HAVE_KERBEROS_KRB_H
+
+/* Define to 1 if `e_text' is a member of `krb5_error'. */
+#undef HAVE_KRB5_ERROR_E_TEXT
+
+/* Define to 1 if `text' is a member of `krb5_error'. */
+#undef HAVE_KRB5_ERROR_TEXT
+
+/* Define to 1 if you have the <krb5.h> header file. */
+#undef HAVE_KRB5_H
+
+/* Define to 1 if you have the <krb.h> header file. */
+#undef HAVE_KRB_H
+
+/* Define if you have <langinfo.h> and nl_langinfo(CODESET). */
+#define HAVE_LANGINFO_CODESET 1
+
+/* Define to 1 if you have the `com_err' library (-lcom_err). */
+#undef HAVE_LIBCOM_ERR
+
+/* Define to 1 if you have the `crypto' library (-lcrypto). */
+#undef HAVE_LIBCRYPTO
+
+/* Define to 1 if you have the `des' library (-ldes). */
+#undef HAVE_LIBDES
+
+/* Define to 1 if you have the `des425' library (-ldes425). */
+#undef HAVE_LIBDES425
+
+/* Define to 1 if you have the `dgc' library (-ldgc). */
+#undef HAVE_LIBDGC
+
+/* Define to 1 if you have the `dnet' library (-ldnet). */
+#undef HAVE_LIBDNET
+
+/* Define to 1 if you have the <libgen.h> header file. */
+#undef HAVE_LIBGEN_H
+
+/* Define to 1 if you have the hesiod library (-lhesiod). */
+#undef HAVE_LIBHESIOD
+
+/* Define to 1 if you have the `k5crypto' library (-lk5crypto). */
+#undef HAVE_LIBK5CRYPTO
+
+/* Define to 1 if you have the `krb' library (-lkrb). */
+#undef HAVE_LIBKRB
+
+/* Define to 1 if you have the `krb4' library (-lkrb4). */
+#undef HAVE_LIBKRB4
+
+/* Define to 1 if you have the `krb5' library (-lkrb5). */
+#undef HAVE_LIBKRB5
+
+/* Define to 1 if you have the `kstat' library (-lkstat). */
+#undef HAVE_LIBKSTAT
+
+/* Define to 1 if you have the `lockfile' library (-llockfile). */
+#undef HAVE_LIBLOCKFILE
+
+/* Define to 1 if you have the `m' library (-lm). */
+#undef HAVE_LIBM
+
+/* Define to 1 if you have the `mail' library (-lmail). */
+#undef HAVE_LIBMAIL
+
+/* Define to 1 if using libotf. */
+#undef HAVE_LIBOTF
+
+/* Define to 1 if you have the `perfstat' library (-lperfstat). */
+#undef HAVE_LIBPERFSTAT
+
+/* Define to 1 if you have the <libpng/png.h> header file. */
+#undef HAVE_LIBPNG_PNG_H
+
+/* Define to 1 if you have the `pthreads' library (-lpthreads). */
+#undef HAVE_LIBPTHREADS
+
+/* Define to 1 if you have the resolv library (-lresolv). */
+#undef HAVE_LIBRESOLV
+
+/* Define to 1 if using SELinux. */
+#undef HAVE_LIBSELINUX
+
+/* Define to 1 if you have the `Xext' library (-lXext). */
+#undef HAVE_LIBXEXT
+
+/* Define to 1 if you have the libxml library (-lxml2). */
+#undef HAVE_LIBXML2
+
+/* Define to 1 if you have the `Xmu' library (-lXmu). */
+#undef HAVE_LIBXMU
+
+/* Define to 1 if you have the <linux/version.h> header file. */
+#undef HAVE_LINUX_VERSION_H
+
+/* Define to 1 if you have the `localtime_r' function. */
+#undef HAVE_LOCALTIME_R
+
+/* Define to 1 if you support file names longer than 14 characters. */
+#define HAVE_LONG_FILE_NAMES 1
+
+/* Define to 1 if the system has the type 'long long int'. */
+#undef HAVE_LONG_LONG_INT
+
+/* Define to 1 if you have the `lrand48' function. */
+#undef HAVE_LRAND48
+
+/* Define to 1 if you have the `lstat' function. */
+#undef HAVE_LSTAT
+
+/* Define to 1 if you have the `lutimes' function. */
+#undef HAVE_LUTIMES
+
+/* Define to 1 if using libm17n-flt. */
+#undef HAVE_M17N_FLT
+
+/* Define to 1 if you have the <machine/soundcard.h> header file. */
+#undef HAVE_MACHINE_SOUNDCARD_H
+
+/* Define to 1 if you have the <mach/mach.h> header file. */
+#undef HAVE_MACH_MACH_H
+
+/* Define to 1 if you have the `MagickExportImagePixels' function. */
+#undef HAVE_MAGICKEXPORTIMAGEPIXELS
+
+/* Define to 1 if you have the `MagickMergeImageLayers' function. */
+#undef HAVE_MAGICKMERGEIMAGELAYERS
+
+/* Define to 1 if you have the <maillock.h> header file. */
+#undef HAVE_MAILLOCK_H
+
+/* Define to 1 if you have the <malloc/malloc.h> header file. */
+#undef HAVE_MALLOC_MALLOC_H
+
+/* Define to 1 if <wchar.h> declares mbstate_t. */
+#undef HAVE_MBSTATE_T
+
+/* Define to 1 if you have the <memory.h> header file. */
+#undef HAVE_MEMORY_H
+
+/* Define to 1 if you have mouse menus. (This is automatic if you use X, but
+ the option to specify it remains.) It is also defined with other window
+ systems that support xmenu.c. */
+#undef HAVE_MENUS
+
+/* Define to 1 if you have the `mkstemp' function. */
+#undef HAVE_MKSTEMP
+
+/* Define to 1 if you have a working `mmap' system call. */
+#undef HAVE_MMAP
+
+/* Define to 1 if you have the `nanotime' function. */
+#undef HAVE_NANOTIME
+
+/* Define to 1 if you have the <net/if_dl.h> header file. */
+#undef HAVE_NET_IF_DL_H
+
+/* Define to 1 if you have the <net/if.h> header file. */
+#undef HAVE_NET_IF_H
+
+/* Define to 1 if you have the <nlist.h> header file. */
+#undef HAVE_NLIST_H
+
+/* Define to 1 if you are using the NeXTstep API, either GNUstep or Cocoa on
+ Mac OS X. */
+#undef HAVE_NS
+
+/* Define to use native MS Windows GUI. */
+#define HAVE_NTGUI 1
+
+/* Define to 1 if libotf has OTF_get_variation_glyphs. */
+#undef HAVE_OTF_GET_VARIATION_GLYPHS
+
+/* Define to 1 if personality LINUX32 can be set. */
+#undef HAVE_PERSONALITY_LINUX32
+
+/* Define to 1 if you have the png library (-lpng). */
+#undef HAVE_PNG
+
+/* Define to 1 if you have the <png.h> header file. */
+#undef HAVE_PNG_H
+
+/* Define to 1 if you have the `posix_memalign' function. */
+#undef HAVE_POSIX_MEMALIGN
+
+/* Define to 1 if you have the `posix_openpt' function. */
+#undef HAVE_POSIX_OPENPT
+
+/* Define if you have the /proc filesystem. */
+#undef HAVE_PROCFS
+
+/* Define to 1 if you have the `pselect' function. */
+#undef HAVE_PSELECT
+
+/* Define to 1 if you have the `pstat_getdynamic' function. */
+#undef HAVE_PSTAT_GETDYNAMIC
+
+/* Define to 1 if you have pthread (-lpthread). */
+#undef HAVE_PTHREAD
+
+/* Define to 1 if you have the <pthread.h> header file. */
+#undef HAVE_PTHREAD_H
+
+/* Define to 1 if the pthread_sigmask function can be used (despite bugs). */
+#undef HAVE_PTHREAD_SIGMASK
+
+/* Define if the system supports pty devices. */
+#undef HAVE_PTYS
+
+/* Define to 1 if you have the <pty.h> header file. */
+#undef HAVE_PTY_H
+
+/* Define to 1 if you have the <pwd.h> header file. */
+#define HAVE_PWD_H 1
+
+/* Define to 1 if you have the `random' function. */
+#define HAVE_RANDOM 1
+
+/* Define to 1 if you have the `readlink' function. */
+#undef HAVE_READLINK
+
+/* Define to 1 if you have the `readlinkat' function. */
+#undef HAVE_READLINKAT
+
+/* Define to 1 if you have the `recvfrom' function. */
+#define HAVE_RECVFROM 1
+
+/* Define to 1 if res_init is available. */
+#undef HAVE_RES_INIT
+
+/* Define to 1 if you have the `rint' function. */
+#undef HAVE_RINT
+
+/* Define to 1 if using librsvg. */
+#undef HAVE_RSVG
+
+/* Define to 1 if you have the `select' function. */
+#define HAVE_SELECT 1
+
+/* Define to 1 if you have the `sendto' function. */
+#define HAVE_SENDTO 1
+
+/* Define to 1 if you have the `setitimer' function. */
+#define HAVE_SETITIMER 1
+
+/* Define to 1 if you have the `setlocale' function. */
+#define HAVE_SETLOCALE 1
+
+/* Define to 1 if you have the `setrlimit' function. */
+#undef HAVE_SETRLIMIT
+
+/* Define to 1 if you have the `shutdown' function. */
+#define HAVE_SHUTDOWN 1
+
+/* Define to 1 if 'sig_atomic_t' is a signed integer type. */
+#undef HAVE_SIGNED_SIG_ATOMIC_T
+
+/* Define to 1 if 'wchar_t' is a signed integer type. */
+#undef HAVE_SIGNED_WCHAR_T
+
+/* Define to 1 if 'wint_t' is a signed integer type. */
+#undef HAVE_SIGNED_WINT_T
+
+/* Define to 1 if sigsetjmp and siglongjmp work. The value of this symbol is
+ irrelevant if HAVE__SETJMP is defined. */
+#undef HAVE_SIGSETJMP
+
+/* Define to 1 if the system has the type `sigset_t'. */
+#undef HAVE_SIGSET_T
+
+/* Define to 1 if you have the `snprintf' function. */
+#define HAVE_SNPRINTF 1
+
+/* Define if the system supports 4.2-compatible sockets.
+ NT supports Winsock which is close enough (with some hacks). */
+#define HAVE_SOCKETS 1
+
+/* Define to 1 if you have sound support. */
+#define HAVE_SOUND 1
+
+/* Define to 1 if you have the <soundcard.h> header file. */
+#undef HAVE_SOUNDCARD_H
+
+/* Define to 1 if `speed_t' is declared by <termios.h>. */
+#undef HAVE_SPEED_T
+
+/* Define to 1 if you have the <stdint.h> header file. */
+#undef HAVE_STDINT_H
+
+/* Define to 1 if you have the <stdio_ext.h> header file. */
+#undef HAVE_STDIO_EXT_H
+
+/* Define to 1 if you have the <stdlib.h> header file. */
+#undef HAVE_STDLIB_H
+
+/* Define to 1 if you have the <strings.h> header file. */
+#undef HAVE_STRINGS_H
+
+/* Define to 1 if you have the <string.h> header file. */
+#undef HAVE_STRING_H
+
+/* Define to 1 if you have the `strsignal' function. */
+#undef HAVE_STRSIGNAL
+
+/* Define to 1 if you have the `strtoimax' function. */
+#undef HAVE_STRTOIMAX
+
+/* Define to 1 if you have the `strtoll' function. */
+#undef HAVE_STRTOLL
+
/* Define to 1 if you have the `strtoull' function. */
#define HAVE_STRTOULL 1
/* Define to 1 if you have the `strtoumax' function. */
#define HAVE_STRTOUMAX 1
+/* Define to 1 if `ifr_addr' is a member of `struct ifreq'. */
+#undef HAVE_STRUCT_IFREQ_IFR_ADDR
+
+/* Define to 1 if `ifr_addr.sa_len' is a member of `struct ifreq'. */
+#undef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
+
+/* Define to 1 if `ifr_broadaddr' is a member of `struct ifreq'. */
+#undef HAVE_STRUCT_IFREQ_IFR_BROADADDR
+
+/* Define to 1 if `ifr_flags' is a member of `struct ifreq'. */
+#undef HAVE_STRUCT_IFREQ_IFR_FLAGS
+
+/* Define to 1 if `ifr_hwaddr' is a member of `struct ifreq'. */
+#undef HAVE_STRUCT_IFREQ_IFR_HWADDR
+
+/* Define to 1 if `ifr_netmask' is a member of `struct ifreq'. */
+#undef HAVE_STRUCT_IFREQ_IFR_NETMASK
+
+/* Define to 1 if `n_un.n_name' is a member of `struct nlist'. */
+#undef HAVE_STRUCT_NLIST_N_UN_N_NAME
+
+/* Define to 1 if `st_atimensec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIMENSEC
+
+/* Define to 1 if `st_atimespec.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC
+
+/* Define to 1 if `st_atim.st__tim.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC
+
+/* Define to 1 if `st_atim.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC
+
+/* Define to 1 if `st_birthtimensec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC
+
+/* Define to 1 if `st_birthtimespec.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC
+
+/* Define to 1 if `st_birthtim.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC
+
+/* Define to 1 if `tm_zone' is a member of `struct tm'. */
+#undef HAVE_STRUCT_TM_TM_ZONE
+
+/* Define if struct utimbuf is declared -- usually in <utime.h>. Some systems
+ have utime.h but don't declare the struct anywhere. */
+#undef HAVE_STRUCT_UTIMBUF
+
+/* Define if struct stat has an st_dm_mode member. */
+#undef HAVE_ST_DM_MODE
+
+/* Define to 1 if you have the `symlink' function. */
+#undef HAVE_SYMLINK
+
+/* Define to 1 if you have the `sync' function. */
+#undef HAVE_SYNC
+
+/* Define to 1 if you have the <sys/bitypes.h> header file. */
+#undef HAVE_SYS_BITYPES_H
+
+/* Define to 1 if you have the <sys/inttypes.h> header file. */
+#undef HAVE_SYS_INTTYPES_H
+
+/* Define to 1 if you have the <sys/loadavg.h> header file. */
+#undef HAVE_SYS_LOADAVG_H
+
+/* Define to 1 if you have the <sys/param.h> header file. */
+#undef HAVE_SYS_PARAM_H
+
+/* Define to 1 if you have the <sys/resource.h> header file. */
+#undef HAVE_SYS_RESOURCE_H
+
+/* Define to 1 if you have the <sys/select.h> header file. */
+#undef HAVE_SYS_SELECT_H
+
+/* Define to 1 if you have the <sys/socket.h> header file. */
+#undef HAVE_SYS_SOCKET_H
+
+/* Define to 1 if you have the <sys/soundcard.h> header file. */
+#undef HAVE_SYS_SOUNDCARD_H
+
+/* Define to 1 if you have the <sys/stat.h> header file. */
+#undef HAVE_SYS_STAT_H
+
+/* Define to 1 if you have the <sys/systeminfo.h> header file. */
+#undef HAVE_SYS_SYSTEMINFO_H
+
+/* Define to 1 if you have the <sys/timeb.h> header file. */
+#define HAVE_SYS_TIMEB_H 1
+
+/* Define to 1 if you have the <sys/time.h> header file. */
+#define HAVE_SYS_TIME_H 1
+
+/* Define to 1 if you have the <sys/types.h> header file. */
+#undef HAVE_SYS_TYPES_H
+
+/* Define to 1 if you have the <sys/un.h> header file. */
+#undef HAVE_SYS_UN_H
+
+/* Define to 1 if you have the <sys/utsname.h> header file. */
+#undef HAVE_SYS_UTSNAME_H
+
+/* Define to 1 if you have the <sys/vlimit.h> header file. */
+#undef HAVE_SYS_VLIMIT_H
+
+/* Define to 1 if you have <sys/wait.h> that is POSIX.1 compatible. */
+#define HAVE_SYS_WAIT_H 1
+
+/* Define to 1 if you have the <term.h> header file. */
+#undef HAVE_TERM_H
+
+/* Define to 1 if you have the tiff library (-ltiff). */
+#undef HAVE_TIFF
+
+/* Define to 1 if you have the `timer_settime' function. */
+#undef HAVE_TIMER_SETTIME
+
+/* Define if struct tm has the tm_gmtoff member. */
+#undef HAVE_TM_GMTOFF
+
+/* Define to 1 if your `struct tm' has `tm_zone'. Deprecated, use
+ `HAVE_STRUCT_TM_TM_ZONE' instead. */
+#undef HAVE_TM_ZONE
+
+/* Define to 1 if you have the `touchlock' function. */
+#undef HAVE_TOUCHLOCK
+
+/* Define to 1 if you don't have `tm_zone' but do have the external array
+ `tzname'. */
+#define HAVE_TZNAME 1
+
+/* Define to 1 if you have the `tzset' function. */
+#define HAVE_TZSET 1
+
+/* Define to 1 if you have the <unistd.h> header file. */
+#define HAVE_UNISTD_H 1
+
+/* Define to 1 if the system has the type 'unsigned long long int'. */
+#undef HAVE_UNSIGNED_LONG_LONG_INT
+
+/* Define to 1 if you have the <util.h> header file. */
+#undef HAVE_UTIL_H
+
+/* Define to 1 if you have the `utimensat' function. */
+#undef HAVE_UTIMENSAT
+
+/* Define to 1 if you have the `utimes' function. */
+#undef HAVE_UTIMES
+
+/* Define to 1 if you have the <utime.h> header file. */
+#undef HAVE_UTIME_H
+
+/* Define to 1 if you have the <utmp.h> header file. */
+#undef HAVE_UTMP_H
+
+/* Define to 1 if you have the `vfork' function. */
+#undef HAVE_VFORK
+
+/* Define to 1 if you have the <vfork.h> header file. */
+#undef HAVE_VFORK_H
+
+/* Define to 1 if you have the <wchar.h> header file. */
+#undef HAVE_WCHAR_H
+
/* Define if you have the 'wchar_t' type. */
#define HAVE_WCHAR_T 1
+/* Define if you have a window system. */
+#undef HAVE_WINDOW_SYSTEM
+
+/* Define to 1 if you have the <winsock2.h> header file. */
+#undef HAVE_WINSOCK2_H
+
+/* Define to 1 if `fork' works. */
+#undef HAVE_WORKING_FORK
+
+/* Define if utimes works properly. */
+#undef HAVE_WORKING_UTIMES
+
+/* Define to 1 if `vfork' works. */
+#undef HAVE_WORKING_VFORK
+
+/* Define to 1 if you have the <ws2tcpip.h> header file. */
+#undef HAVE_WS2TCPIP_H
+
+/* Define to 1 if you want to use version 11 of X windows. Otherwise, Emacs
+ expects to use version 10. */
+#undef HAVE_X11
+
+/* Define to 1 if you have the X11R6 or newer version of Xlib. */
+#undef HAVE_X11R6
+
+/* Define if you have usable X11R6-style XIM support. */
+#undef HAVE_X11R6_XIM
+
+/* Define to 1 if you have the X11R6 or newer version of Xt. */
+#undef HAVE_X11XTR6
+
+/* Define to 1 if you have the Xaw3d library (-lXaw3d). */
+#undef HAVE_XAW3D
+
+/* Define to 1 if you have the Xft library. */
+#undef HAVE_XFT
+
+/* Define to 1 if XIM is available */
+#undef HAVE_XIM
+
+/* Define to 1 if you have the XkbGetKeyboard function. */
+#undef HAVE_XKBGETKEYBOARD
+
+/* Define to 1 if you have the Xpm library (-lXpm). */
+#undef HAVE_XPM
+
+/* Define to 1 if you have the `XrmSetDatabase' function. */
+#undef HAVE_XRMSETDATABASE
+
+/* Define to 1 if you have the `XScreenNumberOfScreen' function. */
+#undef HAVE_XSCREENNUMBEROFSCREEN
+
+/* Define to 1 if you have the `XScreenResourceString' function. */
+#undef HAVE_XSCREENRESOURCESTRING
+
+/* Define if you have usable i18n support. */
+#undef HAVE_X_I18N
+
+/* Define to 1 if you have the SM library (-lSM). */
+#undef HAVE_X_SM
+
+/* Define to 1 if you want to use the X window system. */
+#undef HAVE_X_WINDOWS
+
+/* Define to 1 if the system has the type `_Bool'. */
+#undef HAVE__BOOL
+
+/* Define to 1 if you have the `_ftime' function. */
+#undef HAVE__FTIME
+
+/* Define to 1 if _setjmp and _longjmp work. */
+#define HAVE__SETJMP 1
+
+/* Define to 1 if you have the `__builtin_unwind_init' function. */
+#undef HAVE___BUILTIN_UNWIND_INIT
+
+/* Define to 1 if you have the `__executable_start' function. */
+#undef HAVE___EXECUTABLE_START
+
+/* Define to 1 if you have the `__fpending' function. */
+#undef HAVE___FPENDING
+
+/* Define to support using a Hesiod database to find the POP server. */
+#undef HESIOD
+
+/* Define if the system is HPUX. */
+#undef HPUX
+
+/* This is substituted when $TERM is "internal". */
+#undef INTERNAL_TERMINAL
+
+/* Define to read input using SIGIO. */
+#undef INTERRUPT_INPUT
+
+/* Define if the system is IRIX. */
+#undef IRIX6_5
+
+/* Returns true if character is any form of separator. */
+#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_))
+
+/* Returns true if character is a device separator. */
+#define IS_DEVICE_SEP(_c_) ((_c_) == DEVICE_SEP)
+
+/* Returns true if character is a directory separator. */
+#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\')
+
+/* Define to support Kerberos-authenticated POP mail retrieval. */
+#undef KERBEROS
+
+/* Define to use Kerberos 5 instead of Kerberos 4. */
+#undef KERBEROS5
+
+/* Define to 1 if localtime caches TZ. */
+#define LOCALTIME_CACHE 1
+
+/* Define to 1 if 'lstat' dereferences a symlink specified with a trailing
+ slash. */
+#undef LSTAT_FOLLOWS_SLASHED_SYMLINK
+
+/* String giving fallback POP mail host. */
+#undef MAILHOST
+
+/* Define to unlink, rather than empty, mail spool after reading. */
+#undef MAIL_UNLINK_SPOOL
+
+/* Define if the mailer uses flock to interlock the mail spool. */
+#undef MAIL_USE_FLOCK
+
+/* Define if the mailer uses lockf to interlock the mail spool. */
+#undef MAIL_USE_LOCKF
+
+/* Define to support MMDF mailboxes in movemail. */
+#undef MAIL_USE_MMDF
+
+/* Define to support POP mail retrieval. */
+#define MAIL_USE_POP 1
+
+/* Define if the system is MS DOS. */
+#undef MSDOS
+
+/* Define if system's imake configuration file defines `NeedWidePrototypes' as
+ `NO'. */
+#undef NARROWPROTO
+
+/* Define if XEditRes should not be used. */
+#undef NO_EDITRES
+
+/* Define to 1 if your C compiler doesn't accept -c and -o together. */
+#undef NO_MINUS_C_MINUS_O
+
+/* Minimum value of NSIG. */
+#undef NSIG_MINIMUM
+
+/* Define to 1 if `NSInteger' is defined. */
+#undef NS_HAVE_NSINTEGER
+
+/* Define to 1 if you are using NS windowing under MacOS X. */
+#undef NS_IMPL_COCOA
+
+/* Define to 1 if you are using NS windowing under GNUstep. */
+#undef NS_IMPL_GNUSTEP
+
+/* Name of the file to open to get a null file, or a data sink. */
+#define NULL_DEVICE "NUL:"
+
+/* Define to 1 if the nlist n_name member is a pointer */
+#undef N_NAME_POINTER
+
+/* Define if the C compiler is the linker. */
+#define ORDINARY_LINK 1
+
/* Name of package */
#define PACKAGE "emacs"
-/* Version number of package */
-#define VERSION "24.0.92"
+/* Define to the address where bug reports for this package should be sent. */
+#undef PACKAGE_BUGREPORT
-/* Define to `__inline__' or `__inline' if that's what the C compiler
- calls it, or to nothing if 'inline' is not supported under any name. */
-#ifdef __GNUC__
-#ifndef __cplusplus
-#undef inline
-#endif
-#else /* MSVC */
-#define inline __inline
-#endif
+/* Define to the full name of this package. */
+#undef PACKAGE_NAME
-/* Define to the equivalent of the C99 'restrict' keyword, or to
- nothing if this is not supported. Do not define if restrict is
- supported directly. */
-#ifdef __GNUC__
-# define restrict __restrict__
-#else
-# define restrict
-#endif
+/* Define to the full name and version of this package. */
+#undef PACKAGE_STRING
-/* `mode_t' is not defined for MSVC. Define. */
-#ifdef _MSC_VER
-typedef unsigned short mode_t;
-#endif
+/* Define to the one symbol short name of this package. */
+#undef PACKAGE_TARNAME
-/* A va_copy replacement for MSVC. */
-#ifdef _MSC_VER
-# ifdef _WIN64
-# ifndef va_copy /* Need to be checked (?) */
-# define va_copy(d,s) ((d) = (s))
-# endif
-# else /* not _WIN64 */
-# define va_copy(d,s) ((d) = (s))
-# endif /* not _WIN64 */
-#endif /* _MSC_VER */
+/* Define to the home page for this package. */
+#undef PACKAGE_URL
-/* Define as a marker that can be attached to declarations that might not
- be used. This helps to reduce warnings, such as from
- GCC -Wunused-parameter. */
-#if __GNUC__ >= 3 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
-# define _GL_UNUSED __attribute__ ((__unused__))
-#else
-# define _GL_UNUSED
-#endif
-/* The name _UNUSED_PARAMETER_ is an earlier spelling, although the name
- is a misnomer outside of parameter lists. */
-#define _UNUSED_PARAMETER_ _GL_UNUSED
+/* Define to the version of this package. */
+#undef PACKAGE_VERSION
-/* End of gnulib-related stuff. */
+/* the number of pending output bytes on stream 'fp' */
+#define PENDING_OUTPUT_N_BYTES (fp->_ptr - fp->_base)
-#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */
-#define NO_INLINE __attribute__((noinline))
-#else
-#define NO_INLINE
-#endif
+/* Define to empty to suppress deprecation warnings when building with
+ --enable-gcc-warnings and with libpng versions before 1.5, which lack
+ png_longjmp. */
+#undef PNG_DEPSTRUCT
-#if (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1))
-#define EXTERNALLY_VISIBLE __attribute__((externally_visible))
-#else
-#define EXTERNALLY_VISIBLE
-#endif
+/* Define if process_send_signal should use VSUSP instead of VSWTCH. */
+#undef PREFER_VSUSP
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
-# define ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
-#else
-# define ATTRIBUTE_FORMAT(spec) /* empty */
-#endif
+/* Define to 1 if pthread_sigmask(), when it fails, returns -1 and sets errno.
+ */
+#undef PTHREAD_SIGMASK_FAILS_WITH_ERRNO
-#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__gnu_printf__, formatstring_parameter, first_argument))
-#else
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument))
-#endif
+/* Define to 1 if pthread_sigmask() may returns 0 and have no effect. */
+#undef PTHREAD_SIGMASK_INEFFECTIVE
-#if (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 8))
-#define HAVE___BUILTIN_UNWIND_INIT 1
-#endif
+/* Define to 1 if pthread_sigmask() unblocks signals incorrectly. */
+#undef PTHREAD_SIGMASK_UNBLOCK_BUG
-#undef EMACS_CONFIGURATION
+/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
+ 'ptrdiff_t'. */
+#undef PTRDIFF_T_SUFFIX
-#undef EMACS_CONFIG_OPTIONS
+/* How to iterate over PTYs. */
+#undef PTY_ITERATION
-/* The configuration script defines opsysfile to be the name of the
- s/SYSTEM.h file that describes the system type you are using. The file
- is chosen based on the configuration name you give.
+/* How to get the device name of the control end of a PTY, if non-standard. */
+#undef PTY_NAME_SPRINTF
- See the file ../etc/MACHINES for a list of systems and the
- configuration names to use for them.
+/* How to open a PTY, if non-standard. */
+#undef PTY_OPEN
- See s/template.h for documentation on writing s/SYSTEM.h files. */
-#undef config_opsysfile
-#include "s/ms-w32.h"
+/* How to get device name of the tty end of a PTY, if non-standard. */
+#undef PTY_TTY_NAME_SPRINTF
-/* The configuration script defines machfile to be the name of the
- m/MACHINE.h file that describes the machine you are using. The file is
- chosen based on the configuration name you give.
+/* Define to 1 if readlink fails to recognize a trailing slash. */
+#undef READLINK_TRAILING_SLASH_BUG
- See the file ../etc/MACHINES for a list of machines and the
- configuration names to use for them.
+/* Define REL_ALLOC if you want to use the relocating allocator for buffer
+ space. */
+#define REL_ALLOC 1
- See m/template.h for documentation on writing m/MACHINE.h files. */
-#undef config_machfile
-#include "m/intel386.h"
+/* Define to 1 if stat needs help when passed a directory name with a trailing
+ slash */
+#undef REPLACE_FUNC_STAT_DIR
-/* Define `subprocesses' should be defined if you want to
- have code for asynchronous subprocesses
- (as used in M-x compile and M-x shell).
- Only MSDOS does not support this. */
+/* Define to 1 if stat needs help when passed a file name with a trailing
+ slash */
+#undef REPLACE_FUNC_STAT_FILE
-#define subprocesses
+/* Define if emacs.c needs to call run_time_remap; for HPUX. */
+#undef RUN_TIME_REMAP
+
+/* Character that separates PATH elements. */
+#define SEPCHAR ';'
+
+/* How to set up a slave PTY, if needed. */
+#undef SETUP_SLAVE_PTY
+
+/* Make process_send_signal work by "typing" a signal character on the pty. */
+#undef SIGNALS_VIA_CHARACTERS
+
+/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
+ 'sig_atomic_t'. */
+#undef SIG_ATOMIC_T_SUFFIX
+
+/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
+ 'size_t'. */
+#undef SIZE_T_SUFFIX
-/* Define STACK_DIRECTION here, but not if m/foo.h did. */
-#ifndef STACK_DIRECTION
+/* Define if the system is Solaris. */
+#undef SOLARIS2
+
+/* If using the C implementation of alloca, define if you know the
+ direction of stack growth for your system; otherwise it will be
+ automatically deduced at runtime.
+ STACK_DIRECTION > 0 => grows toward higher addresses
+ STACK_DIRECTION < 0 => grows toward lower addresses
+ STACK_DIRECTION = 0 => direction of growth unknown */
#undef STACK_DIRECTION
-#endif
-#ifdef emacs /* Don't do this for lib-src. */
-/* Tell regex.c to use a type compatible with Emacs. */
-#define RE_TRANSLATE_TYPE Lisp_Object
-#define RE_TRANSLATE(TBL, C) CHAR_TABLE_TRANSLATE (TBL, C)
-#define RE_TRANSLATE_P(TBL) (XFASTINT (TBL) != 0)
-#endif
+/* Define to 1 if the `S_IS*' macros in <sys/stat.h> do not work properly. */
+#undef STAT_MACROS_BROKEN
-#define my_strftime nstrftime /* for strftime.c */
+/* Define to 1 if you have the ANSI C header files. */
+#undef STDC_HEADERS
-/* Define to the type of st_nlink in struct stat, or a supertype. */
-#define nlink_t short
+/* Define to 1 on System V Release 4. */
+#undef SVR4
-#ifndef WINDOWSNT
-/* Some of the files of Emacs which are intended for use with other
- programs assume that if you have a config.h file, you must declare
- the type of getenv. */
-extern char *getenv ();
-#endif
+/* Define to use system malloc. */
+#undef SYSTEM_MALLOC
-#endif /* EMACS_CONFIG_H */
+/* The type of system you are compiling for; sets `system-type'. */
+#define SYSTEM_TYPE "windows-nt"
-/* These default definitions are good for almost all machines.
- The exceptions override them in m/MACHINE.h. */
+/* Undocumented. */
+#undef TAB3
-#ifndef BITS_PER_CHAR
-#define BITS_PER_CHAR 8
-#endif
+/* Undocumented. */
+#undef TABDLY
+
+/* Define to 1 if you use terminfo instead of termcap. */
+#undef TERMINFO
+
+/* Define to the header for the built-in window system. */
+#undef TERM_HEADER
+
+/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. */
+#define TIME_WITH_SYS_TIME 1
+
+/* Some platforms redefine this. */
+#undef TIOCSIGSEND
+
+/* Define to 1 if your <sys/time.h> declares `struct tm'. */
+#undef TM_IN_SYS_TIME
+
+/* Define to 1 if the type of the st_atim member of a struct stat is struct
+ timespec. */
+#undef TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC
+
+/* Undocumented. */
+#undef ULIMIT_BREAK_VALUE
+
+/* Define to 1 for Encore UMAX. */
+#undef UMAX
+
+/* Define to 1 for Encore UMAX 4.3 that has <inq_status/cpustats.h> instead of
+ <sys/cpustats.h>. */
+#undef UMAX4_3
+
+/* Define if the system has Unix98 PTYs. */
+#undef UNIX98_PTYS
+
+/* Define to 1 if FIONREAD is usable. */
+#define USABLE_FIONREAD 1
+
+/* Define to 1 if SIGIO is usable. */
+#undef USABLE_SIGIO
+
+/* How to get a user's full name. */
+#define USER_FULL_NAME pw->pw_gecos
+
+/* Define to 1 if using GTK. */
+#undef USE_GTK
+
+/* Define to 1 if using the Lucid X toolkit. */
+#undef USE_LUCID
+
+/* Define to use mmap to allocate buffer text. */
+#undef USE_MMAP_FOR_BUFFERS
+
+/* Define to 1 if using the Motif X toolkit. */
+#undef USE_MOTIF
+
+/* Define to 1 if we should use toolkit scroll bars. */
+#define USE_TOOLKIT_SCROLL_BARS 1
+
+/* Define to 1 if we should use XIM, if it is available. */
+#undef USE_XIM
-#ifndef BITS_PER_SHORT
-#define BITS_PER_SHORT 16
+/* Define to 1 if using an X toolkit. */
+#undef USE_X_TOOLKIT
+
+/* Define if the system is compatible with System III. */
+#undef USG
+
+/* Define if the system is compatible with System V. */
+#undef USG5
+
+/* Define if the system is compatible with System V Release 4. */
+#undef USG5_4
+
+/* Define for USG systems where it works to open a pty's tty in the parent
+ process, then close and reopen it in the child. */
+#undef USG_SUBTTY_WORKS
+
+/* Version number of package */
+#define VERSION "24.3.50"
+
+/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
+ 'wchar_t'. */
+#undef WCHAR_T_SUFFIX
+
+/* Use long long for EMACS_INT if available. */
+/* #undef WIDE_EMACS_INT */
+
+/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
+ 'wint_t'. */
+#undef WINT_T_SUFFIX
+
+/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most
+ significant byte first (like Motorola and SPARC, unlike Intel). */
+#if defined AC_APPLE_UNIVERSAL_BUILD
+# if defined __BIG_ENDIAN__
+# define WORDS_BIGENDIAN 1
+# endif
+#else
+# ifndef WORDS_BIGENDIAN
+# undef WORDS_BIGENDIAN
+# endif
#endif
-/* Note that lisp.h uses this in a preprocessor conditional, so it
- would not work to use sizeof. That being so, we do all of them
- without sizeof, for uniformity's sake. */
-#ifndef BITS_PER_INT
-#define BITS_PER_INT 32
+/* Define this to check for malloc buffer overrun. */
+#undef XMALLOC_OVERRUN_CHECK
+
+/* Compensate for a bug in Xos.h on some systems, where it requires time.h. */
+#undef XOS_NEEDS_TIME_H
+
+/* Define to the type of the 6th arg of XRegisterIMInstantiateCallback, either
+ XPointer or XPointer*. */
+#undef XRegisterIMInstantiateCallback_arg6
+
+/* Define if the system is AIX. */
+#undef _AIX
+
+/* Enable large inode numbers on Mac OS X. */
+#ifndef _DARWIN_USE_64_BIT_INODE
+# define _DARWIN_USE_64_BIT_INODE 1
#endif
-#ifndef BITS_PER_LONG
-#define BITS_PER_LONG 32
+/* Number of bits in a file offset, on hosts where this is settable. */
+#undef _FILE_OFFSET_BITS
+
+/* Define to 1 if Gnulib overrides 'struct stat' on Windows so that struct
+ stat.st_size becomes 64-bit. */
+#undef _GL_WINDOWS_64_BIT_ST_SIZE
+
+/* Define to 1 to make fseeko visible on some hosts (e.g. glibc 2.2). */
+#undef _LARGEFILE_SOURCE
+
+/* Define for large files, on AIX-style hosts. */
+#undef _LARGE_FILES
+
+/* Define to 1 if on MINIX. */
+#undef _MINIX
+
+/* Define if GNUstep uses ObjC exceptions. */
+#undef _NATIVE_OBJC_EXCEPTIONS
+
+/* The _Noreturn keyword of C11. */
+#if ! (defined _Noreturn \
+ || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__))
+# if (3 <= __GNUC__ || (__GNUC__ == 2 && 8 <= __GNUC_MINOR__))
+# define _Noreturn __attribute__ ((__noreturn__))
+# elif defined _MSC_VER && 1200 <= _MSC_VER
+# define _Noreturn __declspec (noreturn)
+# else
+# define _Noreturn
+# endif
#endif
-#if defined (__MINGW32__) || _MSC_VER >= 1400
-/* Define to 1 if the system has the type `long long int'. */
-# define HAVE_LONG_LONG_INT 1
+/* Define to 2 if the system does not provide POSIX.1 features except with
+ this defined. */
+#undef _POSIX_1_SOURCE
-/* Define to 1 if the system has the type `unsigned long long int'. */
-# define HAVE_UNSIGNED_LONG_LONG_INT 1
+/* Define to 1 if you need to in order for 'stat' and other things to work. */
+#undef _POSIX_SOURCE
-#elif _MSC_VER >= 1200
+/* Needed for system_process_attributes on Solaris. */
+#undef _STRUCTURED_PROC
-/* Temporarily disable wider-than-pointer integers until they're tested more.
- Build with CFLAGS='-DWIDE_EMACS_INT' to try them out. */
-/* #undef WIDE_EMACS_INT */
+/* Define to 500 only on HP-UX. */
+#undef _XOPEN_SOURCE
-# ifdef WIDE_EMACS_INT
+/* Enable extensions on AIX 3, Interix. */
+#ifndef _ALL_SOURCE
+# undef _ALL_SOURCE
+#endif
+/* Enable general extensions on Mac OS X. */
+#ifndef _DARWIN_C_SOURCE
+# undef _DARWIN_C_SOURCE
+#endif
+/* Enable GNU extensions on systems that have them. */
+#ifndef _GNU_SOURCE
+# undef _GNU_SOURCE
+#endif
+/* Enable threading extensions on Solaris. */
+#ifndef _POSIX_PTHREAD_SEMANTICS
+# undef _POSIX_PTHREAD_SEMANTICS
+#endif
+/* Enable extensions on HP NonStop. */
+#ifndef _TANDEM_SOURCE
+# undef _TANDEM_SOURCE
+#endif
+/* Enable general extensions on Solaris. */
+#ifndef __EXTENSIONS__
+# undef __EXTENSIONS__
+#endif
-/* Use pre-C99-style 64-bit integers. */
-# define EMACS_INT __int64
-# define BITS_PER_EMACS_INT 64
-# define pI "I64"
+/* Define to rpl_ if the getopt replacement functions and variables should be
+ used. */
+#undef __GETOPT_PREFIX
+
+/* Define to compiler's equivalent of C99 restrict keyword in array
+ declarations. Define as empty for no equivalent. */
+#undef __restrict_arr
+
+/* Some platforms that do not use configure define this to include extra
+ configuration information. */
+#define config_opsysfile <ms-w32.h>
+
+/* _GL_INLINE is a portable alternative to ISO C99 plain 'inline'.
+ _GL_EXTERN_INLINE is a portable alternative to 'extern inline'.
+ _GL_INLINE_HEADER_BEGIN contains useful stuff to put
+ in an include file, before uses of _GL_INLINE.
+ It suppresses GCC's bogus "no previous prototype for 'FOO'" diagnostic,
+ when FOO is an inline function in the header; see
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54113>.
+ _GL_INLINE_HEADER_END contains useful stuff to put
+ in the same include file, after uses of _GL_INLINE. */
+#if (__GNUC__ \
+ ? defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__ \
+ : 199901L <= __STDC_VERSION__)
+# define _GL_INLINE inline
+# define _GL_EXTERN_INLINE extern inline
+#elif 2 < __GNUC__ + (7 <= __GNUC_MINOR__)
+# if __GNUC_GNU_INLINE__
+ /* __gnu_inline__ suppresses a GCC 4.2 diagnostic. */
+# define _GL_INLINE extern inline __attribute__ ((__gnu_inline__))
+# else
+# define _GL_INLINE extern inline
# endif
+# define _GL_EXTERN_INLINE extern
+#else
+# define _GL_INLINE static inline
+# define _GL_EXTERN_INLINE static inline
+#endif
+#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
+# if defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__
+# define _GL_INLINE_HEADER_CONST_PRAGMA
+# else
+# define _GL_INLINE_HEADER_CONST_PRAGMA \
+ _Pragma ("GCC diagnostic ignored \"-Wsuggest-attribute=const\"")
+# endif
+# define _GL_INLINE_HEADER_BEGIN \
+ _Pragma ("GCC diagnostic push") \
+ _Pragma ("GCC diagnostic ignored \"-Wmissing-prototypes\"") \
+ _Pragma ("GCC diagnostic ignored \"-Wmissing-declarations\"") \
+ _GL_INLINE_HEADER_CONST_PRAGMA
+# define _GL_INLINE_HEADER_END \
+ _Pragma ("GCC diagnostic pop")
+#else
+# define _GL_INLINE_HEADER_BEGIN
+# define _GL_INLINE_HEADER_END
#endif
-#ifndef POINTER_TYPE
-#define POINTER_TYPE void
+/* A replacement for va_copy, if needed. */
+#define gl_va_copy(a,b) ((a) = (b))
+
+/* Define to rpl_gmtime if the replacement function should be used. */
+#undef gmtime
+
+/* Define to `__inline__' or `__inline' if that's what the C compiler
+ calls it, or to nothing if 'inline' is not supported under any name. */
+#ifndef __cplusplus
+#undef inline
#endif
-#ifndef PROTOTYPES
-#define PROTOTYPES 1
+/* Work around a bug in Apple GCC 4.0.1 build 5465: In C99 mode, it supports
+ the ISO C 99 semantics of 'extern inline' (unlike the GNU C semantics of
+ earlier versions), but does not display it by setting __GNUC_STDC_INLINE__.
+ __APPLE__ && __MACH__ test for Mac OS X.
+ __APPLE_CC__ tests for the Apple compiler and its version.
+ __STDC_VERSION__ tests for the C99 mode. */
+#if defined __APPLE__ && defined __MACH__ && __APPLE_CC__ >= 5465 && !defined __cplusplus && __STDC_VERSION__ >= 199901L && !defined __GNUC_STDC_INLINE__
+# define __GNUC_STDC_INLINE__ 1
#endif
-#include "string.h"
-#ifdef HAVE_STRINGS_H
-#include "strings.h"
+/* Define to 1 if the compiler is checking for lint. */
+#undef lint
+
+/* Define to rpl_localtime if the replacement function should be used. */
+#undef localtime
+
+/* Define to a type if <wchar.h> does not define. */
+#undef mbstate_t
+
+/* Define to `int' if <sys/types.h> does not define. */
+#undef mode_t
+
+/* Define to the name of the strftime replacement function. */
+#define my_strftime nstrftime
+
+/* Define to the type of st_nlink in struct stat, or a supertype. */
+#define nlink_t short
+
+/* Define to `int' if <sys/types.h> does not define. */
+#undef pid_t
+
+/* Define to the equivalent of the C99 'restrict' keyword, or to
+ nothing if this is not supported. Do not define if restrict is
+ supported directly. */
+#undef restrict
+/* Work around a bug in Sun C++: it does not support _Restrict or
+ __restrict__, even though the corresponding Sun C compiler ends up with
+ "#define restrict _Restrict" or "#define restrict __restrict__" in the
+ previous line. Perhaps some future version of Sun C++ will work with
+ restrict; if so, hopefully it defines __RESTRICT like Sun C does. */
+#if defined __SUNPRO_CC && !defined __RESTRICT
+# define _Restrict
+# define __restrict__
#endif
-#include <stdlib.h>
-#ifndef NO_RETURN
-#if defined __GNUC__ && (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR >= 5))
-#define NO_RETURN __attribute__ ((__noreturn__))
+/* type to use in place of socklen_t if not defined */
+#undef socklen_t
+
+/* Define as a signed type of the same size as size_t. */
+#undef ssize_t
+
+/* Define to enable asynchronous subprocesses. */
+#define subprocesses
+
+/* Define to any substitute for sys_siglist. */
+#undef sys_siglist
+
+/* Define as a marker that can be attached to declarations that might not
+ be used. This helps to reduce warnings, such as from
+ GCC -Wunused-parameter. */
+#if __GNUC__ >= 3 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
+# define _GL_UNUSED __attribute__ ((__unused__))
#else
-#define NO_RETURN /* nothing */
+# define _GL_UNUSED
#endif
+/* The name _UNUSED_PARAMETER_ is an earlier spelling, although the name
+ is a misnomer outside of parameter lists. */
+#define _UNUSED_PARAMETER_ _GL_UNUSED
+
+/* The __pure__ attribute was added in gcc 2.96. */
+#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
+# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+#else
+# define _GL_ATTRIBUTE_PURE /* empty */
#endif
-/* Redefine abort. */
-#ifdef HAVE_NTGUI
-#define abort w32_abort
-void w32_abort (void) NO_RETURN;
+/* The __const__ attribute was added in gcc 2.95. */
+#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 95)
+# define _GL_ATTRIBUTE_CONST __attribute__ ((__const__))
+#else
+# define _GL_ATTRIBUTE_CONST /* empty */
#endif
-/* Prevent accidental use of features unavailable in
- older Windows versions we still support. */
-#define _WIN32_WINNT 0x0400
-/* Make a leaner executable. */
-#define WIN32_LEAN_AND_MEAN 1
+/* Define as a macro for copying va_list variables. */
+#undef va_copy
+
+/* Define as `fork' if `vfork' does not work. */
+#undef vfork
+
+#include <conf_post.h>
+
+#endif /* EMACS_CONFIG_H */
+
+/*
+Local Variables:
+mode: c
+End:
+*/
diff --git a/nt/configure.bat b/nt/configure.bat
index c503900274e..3118bb11e5d 100755
--- a/nt/configure.bat
+++ b/nt/configure.bat
@@ -1,7 +1,7 @@
@echo off
rem ----------------------------------------------------------------------
rem Configuration script for MS Windows operating systems
-rem Copyright (C) 1999-2011 Free Software Foundation, Inc.
+rem Copyright (C) 1999-2012 Free Software Foundation, Inc.
rem This file is part of GNU Emacs.
@@ -23,7 +23,7 @@ rem YOU'LL NEED THE FOLLOWING UTILITIES TO MAKE EMACS:
rem
rem + MS Windows 95, NT or later
rem + either MSVC 2.x or later, or gcc-2.95 or later (with GNU make 3.75
-rem or later) and the Mingw32 and W32 API headers and libraries.
+rem or later) and the Mingw32 and Windows API headers and libraries.
rem + Visual Studio 2005 is not supported at this time.
rem
rem For reference, here is a list of which builds of GNU make are known to
@@ -131,6 +131,7 @@ if "%1" == "--without-jpeg" goto withoutjpeg
if "%1" == "--without-gif" goto withoutgif
if "%1" == "--without-tiff" goto withouttiff
if "%1" == "--without-gnutls" goto withoutgnutls
+if "%1" == "--without-libxml2" goto withoutlibxml2
if "%1" == "--without-xpm" goto withoutxpm
if "%1" == "--with-svg" goto withsvg
if "%1" == "--distfiles" goto distfiles
@@ -144,7 +145,7 @@ echo. --with-gcc use GCC to compile Emacs
echo. --with-msvc use MSVC to compile Emacs
echo. --no-debug exclude debug info from executables
echo. --no-opt disable optimization
-echo. --enable-checking enable checks and assertions
+echo. --enable-checking enable additional run-time checks
echo. --profile enable profiling
echo. --no-cygwin use -mno-cygwin option with GCC
echo. --cflags FLAG pass FLAG to compiler
@@ -156,6 +157,7 @@ echo. --without-gif do not use GIF library even if it is installed
echo. --without-tiff do not use TIFF library even if it is installed
echo. --without-xpm do not use XPM library even if it is installed
echo. --without-gnutls do not use GnuTLS library even if it is installed
+echo. --without-libxml2 do not use libxml2 library even if it is installed
echo. --with-svg use the RSVG library (experimental)
echo. --distfiles path to files for make dist, e.g. libXpm.dll
if "%use_extensions%" == "0" goto end
@@ -317,6 +319,14 @@ goto again
rem ----------------------------------------------------------------------
+:withoutlibxml2
+set libxml2support=N
+set HAVE_LIBXML2=
+shift
+goto again
+
+rem ----------------------------------------------------------------------
+
:withouttiff
set tiffsupport=N
set HAVE_TIFF=
@@ -416,10 +426,10 @@ rem problem). The gcc/mingw32 2.95.2 headers are okay, as are distros
rem of w32api-xxx.zip from Anders Norlander since 1999-11-18 at least.
rem Beginning with Emacs 23, we need usp10.h.
rem
-echo Checking whether W32 API headers are too old...
+echo Checking whether Windows API headers are too old...
echo #include "windows.h" >junk.c
echo #include "usp10.h" >>junk.c
-echo test(PIMAGE_NT_HEADERS pHeader) >>junk.c
+echo void test(PIMAGE_NT_HEADERS pHeader) >>junk.c
echo {PIMAGE_SECTION_HEADER pSection = IMAGE_FIRST_SECTION(pHeader);} >>junk.c
if (%nocygwin%) == (Y) goto chkapi1
set cf=%usercflags%
@@ -459,7 +469,7 @@ goto end
echo.
echo Configure failed.
echo To configure Emacs for Windows, you need to have either
-echo gcc-2.95 or later with Mingw32 and the W32 API headers,
+echo gcc-2.95 or later with Mingw32 and the Windows API headers,
echo or MSVC 2.x or later.
del junk.c
goto end
@@ -569,6 +579,28 @@ set HAVE_GNUTLS=1
:tlsDone
rm -f junk.c junk.obj
+if (%libxml2support%) == (N) goto xml2Done
+
+echo Checking for libxml2....
+echo #include "libxml/HTMLparser.h" >junk.c
+echo main(){} >>junk.c
+echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log
+%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>>config.log
+if exist junk.obj goto havelibxml2
+
+echo ...libxml/HTMLparser.h not found, building without libxml2 support
+echo The failed program was: >>config.log
+type junk.c >>config.log
+set HAVE_LIBXML2=
+goto xml2Done
+
+:havelibxml2
+echo ...libxml2 header available, building with libxml2 support
+set HAVE_LIBXML2=1
+
+:xml2Done
+rm -f junk.c junk.obj
+
if (%jpegsupport%) == (N) goto jpegDone
echo Checking for jpeg-6b...
@@ -595,7 +627,10 @@ rm -f junk.c junk.obj
if (%gifsupport%) == (N) goto gifDone
echo Checking for libgif...
-echo #include "gif_lib.h" >junk.c
+rem giflib-5.0.0 needs size_t defined before gif_lib.h is included
+rem redirection characters need to be protected from the shell
+echo #include ^<stddef.h^> >junk.c
+echo #include "gif_lib.h" >>junk.c
echo main (){} >>junk.c
rem -o option is ignored with cl, but allows result to be consistent.
echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log
@@ -721,29 +756,35 @@ if %COMPILER% == gcc set MAKECMD=gmake
if %COMPILER% == cl set MAKECMD=nmake
rem Pass on chosen settings to makefiles.
-rem NB. Be very careful to not have a space before redirection symbols
-rem except when there is a preceding digit, when a space is required.
rem
+rem The weird place we put the redirection is to make sure no extra
+rem whitespace winds up at the end of the Make variables, since some
+rem variables, e.g. INSTALL_DIR, cannot stand that. Yes, echo will
+rem write the blanks between the end of command arguments and the
+rem redirection symbol to the file. OTOH, we cannot put the
+rem redirection immediately after the last character of the command,
+rem because environment variable expansion can yield a digit there,
+rem which will then be misinterpreted as the file descriptor to
+rem redirect...
echo # Start of settings from configure.bat >config.settings
-echo COMPILER=%COMPILER%>>config.settings
-if not "(%mf%)" == "()" echo MCPU_FLAG=%mf%>>config.settings
-if not "(%dbginfo%)" == "()" echo DEBUG_INFO=%dbginfo%>>config.settings
-if (%nodebug%) == (Y) echo NODEBUG=1 >>config.settings
-if (%noopt%) == (Y) echo NOOPT=1 >>config.settings
-if (%enablechecking%) == (Y) echo ENABLECHECKS=1 >>config.settings
-if (%profile%) == (Y) echo PROFILE=1 >>config.settings
-if (%nocygwin%) == (Y) echo NOCYGWIN=1 >>config.settings
-if not "(%prefix%)" == "()" echo INSTALL_DIR=%prefix%>>config.settings
-if not "(%distfiles%)" == "()" echo DIST_FILES=%distfiles%>>config.settings
+>>config.settings echo COMPILER=%COMPILER%
+if not "(%mf%)" == "()" >>config.settings echo MCPU_FLAG=%mf%
+if not "(%dbginfo%)" == "()" >>config.settings echo DEBUG_INFO=%dbginfo%
+if (%nodebug%) == (Y) >>config.settings echo NODEBUG=1
+if (%noopt%) == (Y) >>config.settings echo NOOPT=1
+if (%profile%) == (Y) >>config.settings echo PROFILE=1
+if (%nocygwin%) == (Y) >>config.settings echo NOCYGWIN=1
+if not "(%prefix%)" == "()" >>config.settings echo INSTALL_DIR=%prefix%
+if not "(%distfiles%)" == "()" >>config.settings echo DIST_FILES=%distfiles%
rem We go thru docflags because usercflags could be "-DFOO=bar" -something
rem and the if command cannot cope with this
for %%v in (%usercflags%) do if not (%%v)==() set docflags=Y
-if (%docflags%)==(Y) echo USER_CFLAGS=%usercflags%>>config.settings
-if (%docflags%)==(Y) echo ESC_USER_CFLAGS=%escusercflags%>>config.settings
+if (%docflags%)==(Y) >>config.settings echo USER_CFLAGS=%usercflags%
+if (%docflags%)==(Y) >>config.settings echo ESC_USER_CFLAGS=%escusercflags%
for %%v in (%userldflags%) do if not (%%v)==() set doldflags=Y
-if (%doldflags%)==(Y) echo USER_LDFLAGS=%userldflags%>>config.settings
+if (%doldflags%)==(Y) >>config.settings echo USER_LDFLAGS=%userldflags%
for %%v in (%extrauserlibs%) do if not (%%v)==() set doextralibs=Y
-if (%doextralibs%)==(Y) echo USER_LIBS=%extrauserlibs%>>config.settings
+if (%doextralibs%)==(Y) >>config.settings echo USER_LIBS=%extrauserlibs%
echo # End of settings from configure.bat>>config.settings
echo. >>config.settings
@@ -752,11 +793,13 @@ echo. >>config.tmp
echo /* Start of settings from configure.bat. */ >>config.tmp
rem We write USER_CFLAGS and USER_LDFLAGS starting with a space to simplify
rem processing of compiler options in w32.c:get_emacs_configuration_options
-if (%docflags%) == (Y) echo #define USER_CFLAGS " %escusercflags%">>config.tmp
-if (%doldflags%) == (Y) echo #define USER_LDFLAGS " %escuserldflags%">>config.tmp
+if (%docflags%) == (Y) echo #define USER_CFLAGS " %escusercflags%" >>config.tmp
+if (%doldflags%) == (Y) echo #define USER_LDFLAGS " %escuserldflags%" >>config.tmp
if (%profile%) == (Y) echo #define PROFILING 1 >>config.tmp
+if (%enablechecking%) == (Y) echo #define ENABLE_CHECKING 1 >>config.tmp
if not "(%HAVE_PNG%)" == "()" echo #define HAVE_PNG 1 >>config.tmp
if not "(%HAVE_GNUTLS%)" == "()" echo #define HAVE_GNUTLS 1 >>config.tmp
+if not "(%HAVE_LIBXML2%)" == "()" echo #define HAVE_LIBXML2 1 >>config.tmp
if not "(%HAVE_JPEG%)" == "()" echo #define HAVE_JPEG 1 >>config.tmp
if not "(%HAVE_GIF%)" == "()" echo #define HAVE_GIF 1 >>config.tmp
if not "(%HAVE_TIFF%)" == "()" echo #define HAVE_TIFF 1 >>config.tmp
@@ -896,6 +939,7 @@ set HAVE_DISTFILES=
set distFilesOk=
set pngsupport=
set tlssupport=
+set libxml2support=
set jpegsupport=
set gifsupport=
set tiffsupport=
@@ -908,4 +952,6 @@ set HAVE_PNG=
set HAVE_TIFF=
set HAVE_XPM=
set dbginfo=
+endlocal
+set use_extensions=
diff --git a/nt/ddeclient.c b/nt/ddeclient.c
index fbb7d36e64a..7648667b4a0 100644
--- a/nt/ddeclient.c
+++ b/nt/ddeclient.c
@@ -1,5 +1,5 @@
/* Simple client interface to DDE servers.
- Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/emacs-x64.manifest b/nt/emacs-x64.manifest
new file mode 100644
index 00000000000..517e44f150b
--- /dev/null
+++ b/nt/emacs-x64.manifest
@@ -0,0 +1,21 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
+ <dependency>
+ <dependentAssembly>
+ <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls"
+ version="6.0.0.0" processorArchitecture="AMD64"
+ publicKeyToken="6595b64144ccf1df"
+ language="*"/>
+ </dependentAssembly>
+ </dependency>
+ <assemblyIdentity version="1.0.0.0" processorArchitecture="AMD64"
+ name="emacs" type="win32"/>
+ <description>GNU Emacs</description>
+ <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
+ <security>
+ <requestedPrivileges>
+ <requestedExecutionLevel level="asInvoker"/>
+ </requestedPrivileges>
+ </security>
+ </trustInfo>
+</assembly>
diff --git a/nt/emacs.manifest b/nt/emacs-x86.manifest
index 64c6f1edfb7..64c6f1edfb7 100644
--- a/nt/emacs.manifest
+++ b/nt/emacs-x86.manifest
diff --git a/nt/emacs.rc b/nt/emacs.rc
index 479a228bb69..72aa47212ac 100644
--- a/nt/emacs.rc
+++ b/nt/emacs.rc
@@ -1,14 +1,18 @@
Emacs ICON icons\emacs.ico
32649 CURSOR icons\hand.cur
-1 24 "emacs.manifest"
+#ifdef WIN64
+1 24 "emacs-x64.manifest"
+#else
+1 24 "emacs-x86.manifest"
+#endif
#ifndef VS_VERSION_INFO
#define VS_VERSION_INFO 1
#endif
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 24,0,92,0
- PRODUCTVERSION 24,0,92,0
+ FILEVERSION 24,3,50,0
+ PRODUCTVERSION 24,3,50,0
FILEFLAGSMASK 0x3FL
#ifdef EMACSDEBUG
FILEFLAGS 0x1L
@@ -25,12 +29,12 @@ BEGIN
BEGIN
VALUE "CompanyName", "Free Software Foundation\0"
VALUE "FileDescription", "GNU Emacs: The extensible self-documenting text editor\0"
- VALUE "FileVersion", "24, 0, 92, 0\0"
+ VALUE "FileVersion", "24, 3, 50, 0\0"
VALUE "InternalName", "Emacs\0"
- VALUE "LegalCopyright", "Copyright (C) 2001-2011\0"
+ VALUE "LegalCopyright", "Copyright (C) 2001-2012\0"
VALUE "OriginalFilename", "emacs.exe"
VALUE "ProductName", "Emacs\0"
- VALUE "ProductVersion", "24, 0, 92, 0\0"
+ VALUE "ProductVersion", "24, 3, 50, 0\0"
VALUE "OLESelfRegister", "\0"
END
END
diff --git a/nt/emacsclient.rc b/nt/emacsclient.rc
index b653e1fb952..59dd7b09f8a 100644
--- a/nt/emacsclient.rc
+++ b/nt/emacsclient.rc
@@ -5,8 +5,8 @@ Emacs ICON icons\emacs.ico
#endif
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 24,0,92,0
- PRODUCTVERSION 24,0,92,0
+ FILEVERSION 24,3,50,0
+ PRODUCTVERSION 24,3,50,0
FILEFLAGSMASK 0x3FL
#ifdef EMACSDEBUG
FILEFLAGS 0x1L
@@ -23,12 +23,12 @@ BEGIN
BEGIN
VALUE "CompanyName", "Free Software Foundation\0"
VALUE "FileDescription", "GNU EmacsClient: Client for the extensible self-documenting text editor\0"
- VALUE "FileVersion", "24, 0, 92, 0\0"
+ VALUE "FileVersion", "24, 3, 50, 0\0"
VALUE "InternalName", "EmacsClient\0"
- VALUE "LegalCopyright", "Copyright (C) 2001-2011\0"
+ VALUE "LegalCopyright", "Copyright (C) 2001-2012\0"
VALUE "OriginalFilename", "emacsclientw.exe"
VALUE "ProductName", "EmacsClient\0"
- VALUE "ProductVersion", "24, 0, 92, 0\0"
+ VALUE "ProductVersion", "24, 3, 50, 0\0"
VALUE "OLESelfRegister", "\0"
END
END
diff --git a/nt/envadd.bat b/nt/envadd.bat
index b60a85a7b61..cca44d9ea97 100644
--- a/nt/envadd.bat
+++ b/nt/envadd.bat
@@ -1,8 +1,7 @@
rem Hack to change/add environment variables in the makefiles for the
rem Windows platform.
-rem Copyright (C) 2003-2011
-rem Free Software Foundation, Inc.
+rem Copyright (C) 2003-2012 Free Software Foundation, Inc.
rem This file is part of GNU Emacs.
diff --git a/nt/gmake.defs b/nt/gmake.defs
index a1ff7af853e..3d545fab975 100644
--- a/nt/gmake.defs
+++ b/nt/gmake.defs
@@ -1,5 +1,5 @@
# -*- Makefile -*- definition file for building GNU Emacs on Windows NT.
-# Copyright (C) 2000-2011 Free Software Foundation, Inc.
+# Copyright (C) 2000-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -69,10 +69,18 @@ sh_output := $(shell echo)
ifeq "$(findstring ECHO, $(sh_output))" "ECHO"
THE_SHELL = $(COMSPEC)$(ComSpec)
SHELLTYPE=CMD
+SWITCHCHAR=/
else
USING_SH = 1
THE_SHELL = $(SHELL)
SHELLTYPE=SH
+# MSYS needs to double the slash in cmd-style switches to avoid
+# interpreting /x as a Posix style file name reference
+ifneq ($(MSYSTEM),)
+SWITCHCHAR=//
+else
+SWITCHCHAR=/
+endif
endif
MAKETYPE=gmake
@@ -139,15 +147,27 @@ OS_TYPE = windowsnt
ifeq "$(PROCESSOR_ARCHITECTURE)" "x86"
ARCH = i386
CPU = i386
+EMACS_HEAPSIZE = 27
+EMACS_PURESIZE = 5000000
+EMACS_MANIFEST = emacs-x86.manifest
else
ifeq "$(PROCESSOR_ARCHITECTURE)" "MIPS"
ARCH = mips
+EMACS_HEAPSIZE = 27
+EMACS_PURESIZE = 5000000
+EMACS_MANIFEST = emacs-mips.manifest
else
ifeq "$(PROCESSOR_ARCHITECTURE)" "ALPHA"
ARCH = alpha
+EMACS_HEAPSIZE = 27
+EMACS_PURESIZE = 5000000
+EMACS_MANIFEST = emacs-alpha.manifest
else
ifeq "$(PROCESSOR_ARCHITECTURE)" "PPC"
ARCH = ppc
+EMACS_HEAPSIZE = 27
+EMACS_PURESIZE = 5000000
+EMACS_MANIFEST = emacs-ppc.manifest
else
$(error Unknown architecture type "$(PROCESSOR_ARCHITECTURE)")
endif
@@ -199,19 +219,15 @@ OBJ1_c = $(patsubst $(BLD)%.$(O),$(CURDIR)%.c,$(OBJ1))
OBJ2_c = $(patsubst $(BLD)%.$(O),$(CURDIR)%.c,$(OBJ2))
ifdef NOOPT
-DEBUG_CFLAGS = -DEMACSDEBUG
+DEBUG_CFLAGS = -DEMACSDEBUG -fno-crossjumping -std=gnu99
else
DEBUG_CFLAGS =
endif
-ifdef ENABLECHECKS
-CHECKING_CFLAGS = -DENABLE_CHECKING -DXASSERTS -fno-crossjumping
-else
-CHECKING_CFLAGS =
-endif
+MWINDOWS = -mwindows
-CFLAGS = -I. $(ARCH_CFLAGS) $(DEBUG_CFLAGS) $(CHECKING_CFLAGS) $(PROFILE_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS)
-ESC_CFLAGS = -I. $(ARCH_CFLAGS) $(DEBUG_CFLAGS) $(CHECKING_CFLAGS) $(PROFILE_CFLAGS) $(ESC_USER_CFLAGS) $(LOCAL_FLAGS)
+CFLAGS = -I. $(ARCH_CFLAGS) $(DEBUG_CFLAGS) $(PROFILE_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS)
+ESC_CFLAGS = -I. $(ARCH_CFLAGS) $(DEBUG_CFLAGS) $(PROFILE_CFLAGS) $(ESC_USER_CFLAGS) $(LOCAL_FLAGS)
EMACS_EXTRA_C_FLAGS = -DUSE_CRT_DLL=1
ifdef PROFILE
@@ -245,9 +261,11 @@ CP_DIR = cp -rf
DEL = rm
DEL_TREE = rm -r
+DIRNAME = $(notdir $(CURDIR))
+
ifdef USING_SH
-IFNOTSAMEDIR = if [ ! -s ../same-dir.tst ] ; then
+IFNOTSAMEDIR = if [ ! -s ../$(DIRNAME)_same-dir.tst ] ; then
FOREACH = for f in
FORVAR = $${f}
FORDO = ; do
@@ -262,7 +280,7 @@ endif
else
-IFNOTSAMEDIR = if not exist ../same-dir.tst
+IFNOTSAMEDIR = if not exist ../$(DIRNAME)_same-dir.tst
FOREACH = for %%f in (
FORVAR = %%f
FORDO = ) do
@@ -289,6 +307,8 @@ ifdef USER_LIBS
USER_LIBS := $(patsubst %,-l%,$(USER_LIBS))
endif
+PRAGMA_SYSTEM_HEADER = \#pragma GCC system_header
+
ifeq "$(ARCH)" "i386"
ifdef NOOPT
ARCH_CFLAGS = -c $(DEBUG_FLAG) $(NOCYGWIN)
diff --git a/nt/icons/README b/nt/icons/README
index 5778e4bda12..a3acb66178c 100644
--- a/nt/icons/README
+++ b/nt/icons/README
@@ -2,13 +2,13 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
File: emacs.ico
Author: Kentaro Ohkouchi <nanasess@fsm.ne.jp>
-Copyright (C) 2008-2011 Free Software Foundation, Inc.
+Copyright (C) 2008-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later
File: emacs22.ico
Author: Andrew Zhilin
-Copyright (C) 2005-2011 Free Software Foundation, Inc.
+Copyright (C) 2005-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
@@ -17,7 +17,7 @@ Files: gnu2a32.ico gnu2a32t.ico gnu2b48.ico gnu2b48t.ico
gnu5w32.ico gnu5w32t.ico gnu6w48.ico gnu6w48t.ico
gnu7.ico gnu8.ico gnu9.ico
Author: Rob Davenport <rgd at bigfoot.com>
-Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
<http://users.adelphia.net/~rob.davenport/gnuicons.html>
diff --git a/src/ndir.h b/nt/inc/dirent.h
index cd7cdbe55f5..618f3beddf0 100644
--- a/src/ndir.h
+++ b/nt/inc/dirent.h
@@ -1,7 +1,5 @@
/*
- <dir.h> -- definitions for 4.2BSD-compatible directory access
-
- last edit: 09-Jul-1983 D A Gwyn
+ <dirent.h> -- definitions for POSIX-compatible directory access
* The code here is forced by the interface, and is not subject to
* copyright, constituting the only possible expression of the
@@ -16,7 +14,7 @@
#endif /* not WINDOWSNT */
/* NOTE: MAXNAMLEN must be one less than a multiple of 4 */
-struct direct /* data from readdir() */
+struct dirent /* data from readdir() */
{
long d_ino; /* inode number of entry */
unsigned short d_reclen; /* length of this record */
@@ -33,9 +31,8 @@ typedef struct
} DIR; /* stream data from opendir() */
extern DIR *opendir (char *);
-extern struct direct *readdir (DIR *);
+extern struct dirent *readdir (DIR *);
extern void seekdir (DIR *, long);
extern void closedir (DIR *);
#define rewinddir( dirp ) seekdir( dirp, 0L )
-
diff --git a/nt/inc/grp.h b/nt/inc/grp.h
index 1c439e2fb85..3d369044974 100644
--- a/nt/inc/grp.h
+++ b/nt/inc/grp.h
@@ -1,6 +1,6 @@
/* Replacement grp.h file for building GNU Emacs on Windows.
-Copyright (C) 2003-2011 Free Software Foundation, Inc.
+Copyright (C) 2003-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -28,7 +28,10 @@ struct group {
gid_t gr_gid; /* group numerical ID */
};
-struct group *getgrgid(gid_t);
+extern unsigned getgid (void);
+extern unsigned getegid (void);
+
+extern struct group *getgrgid(gid_t);
#endif /* _GRP_H */
diff --git a/nt/inc/inttypes.h b/nt/inc/inttypes.h
index ba26cc1115d..688b9bc9223 100644
--- a/nt/inc/inttypes.h
+++ b/nt/inc/inttypes.h
@@ -1,6 +1,6 @@
/* Replacement inntypes.h file for building GNU Emacs on Windows with MSVC.
-Copyright (C) 2011 Free Software Foundation, Inc.
+Copyright (C) 2011-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/inc/langinfo.h b/nt/inc/langinfo.h
index 27aa5fa306c..7ab36f0a998 100644
--- a/nt/inc/langinfo.h
+++ b/nt/inc/langinfo.h
@@ -1,6 +1,6 @@
/* Replacement langinfo.h file for building GNU Emacs on Windows.
-Copyright (C) 2006-2011 Free Software Foundation, Inc.
+Copyright (C) 2006-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/s/ms-w32.h b/nt/inc/ms-w32.h
index cc19765aba6..7b16ccab069 100644
--- a/src/s/ms-w32.h
+++ b/nt/inc/ms-w32.h
@@ -1,6 +1,6 @@
/* System description file for Windows NT.
-Copyright (C) 1993-1995, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1993-1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -23,8 +23,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef WINDOWSNT
#define WINDOWSNT
#endif
-#ifndef DOS_NT
-#define DOS_NT /* MSDOS or WINDOWSNT */
+
+/* #undef const */
+
+/* Number of chars of output in the buffer of a stdio stream. */
+#ifdef __GNU_LIBRARY__
+#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__bufp - (FILE)->__buffer)
+#else
+#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base)
#endif
/* If you are compiling with a non-C calling convention but need to
@@ -36,23 +42,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
convention must be whatever standard the libraries expect. */
#define _CALLBACK_ __cdecl
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "windows-nt"
-
-#define NO_MATHERR 1
-
-/* Letter to use in finding device name of first pty,
- if system supports pty's. 'a' means it is /dev/ptya0 */
-#define FIRST_PTY_LETTER 'a'
-
/* Define HAVE_TIMEVAL if the system supports the BSD style clock values.
Look in <sys/time.h> for a timeval structure. */
#define HAVE_TIMEVAL 1
-/* NT supports Winsock which is close enough (with some hacks). */
-#define HAVE_SOCKETS 1
-
/* But our select implementation doesn't allow us to make non-blocking
connects. So until that is fixed, this is necessary: */
#define BROKEN_NON_BLOCKING_CONNECT 1
@@ -61,14 +54,21 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
for received packets, so datagrams are broken too. */
#define BROKEN_DATAGRAM_SOCKETS 1
-#define MAIL_USE_POP 1
#define MAIL_USE_SYSTEM_LOCK 1
-/* If the character used to separate elements of the executable path
- is not ':', #define this to be the appropriate character constant. */
-#define SEPCHAR ';'
+/* Define to 1 if GCC-style __attribute__ ((__aligned__ (expr))) works. */
+#ifdef __GNUC__
+#define HAVE_ATTRIBUTE_ALIGNED 1
+#endif
+
+/* Define to 1 if strtold conforms to C99. */
+#ifdef __GNUC__
+#define HAVE_C99_STRTOLD 1
+#endif
-#define ORDINARY_LINK 1
+#if (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 8))
+#define HAVE___BUILTIN_UNWIND_INIT 1
+#endif
/* ============================================================ */
@@ -78,106 +78,52 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
your system and must be used only through an encapsulation (which
you should place, by convention, in sysdep.c). */
-/* Define this to be the separator between devices and paths. */
-#define DEVICE_SEP ':'
-
-/* We'll support either convention on NT. */
-#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\')
-#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_))
+#ifdef __GNUC__
+#ifndef __cplusplus
+#undef inline
+#endif
+#else /* MSVC */
+#define inline __inline
+#endif
-#include <sys/types.h>
+#ifdef __GNUC__
+# define restrict __restrict__
+#else
+# define restrict
+#endif
+/* `mode_t' is not defined for MSVC. Define. */
#ifdef _MSC_VER
-typedef unsigned long sigset_t;
-typedef int ssize_t;
+typedef unsigned short mode_t;
#endif
-struct sigaction {
- int sa_flags;
- void (*sa_handler)(int);
- sigset_t sa_mask;
-};
-#define SIG_BLOCK 1
-#define SIG_SETMASK 2
-#define SIG_UNBLOCK 3
+/* A va_copy replacement for MSVC. */
+#ifdef _MSC_VER
+# ifdef _WIN64
+# ifndef va_copy /* Need to be checked (?) */
+# define va_copy(d,s) ((d) = (s))
+# endif
+# else /* not _WIN64 */
+# define va_copy(d,s) ((d) = (s))
+# endif /* not _WIN64 */
+#endif /* _MSC_VER */
-/* The null device on Windows NT. */
-#define NULL_DEVICE "NUL:"
+#ifndef WINDOWSNT
+/* Some of the files of Emacs which are intended for use with other
+ programs assume that if you have a config.h file, you must declare
+ the type of getenv. */
+extern char *getenv ();
+#endif
+
+#ifdef HAVE_STRINGS_H
+#include "strings.h"
+#endif
+#include <sys/types.h>
#ifndef MAXPATHLEN
#define MAXPATHLEN _MAX_PATH
#endif
-#define HAVE_SOUND 1
-#define LISP_FLOAT_TYPE 1
-
-#define HAVE_SYS_TIMEB_H 1
-#define HAVE_SYS_TIME_H 1
-#define HAVE_UNISTD_H 1
-#undef HAVE_UTIME_H
-#undef HAVE_LINUX_VERSION_H
-#undef HAVE_SYS_SYSTEMINFO_H
-#define HAVE_PWD_H 1
-#define TIME_WITH_SYS_TIME 1
-
-#define HAVE_GETTIMEOFDAY 1
-#define HAVE_GETHOSTNAME 1
-#undef HAVE_GETDOMAINNAME
-#define HAVE_DUP2 1
-#define HAVE_RENAME 1
-#define HAVE_CLOSEDIR 1
-#define HAVE_FSYNC 1 /* fsync is called _commit in MSVC. */
-
-#undef TM_IN_SYS_TIME
-#undef HAVE_TM_ZONE
-
-#define HAVE_LONG_FILE_NAMES 1
-
-#define HAVE_MKDIR 1
-#define HAVE_RMDIR 1
-#define HAVE_RANDOM 1
-#undef HAVE_SYSINFO
-#undef HAVE_LRAND48
-#define HAVE_MEMCMP 1
-#define HAVE_MEMCPY 1
-#define HAVE_MEMMOVE 1
-#define HAVE_MEMSET 1
-#define HAVE_LOGB 1
-#define HAVE_FREXP 1
-#define HAVE_FMOD 1
-#undef HAVE_RINT
-#undef HAVE_CBRT
-#define HAVE_FTIME 1
-#undef HAVE_RES_INIT /* For -lresolv on Suns. */
-#undef HAVE_SETSID
-#undef HAVE_FPATHCONF
-#define HAVE_SELECT 1
-#undef HAVE_EUIDACCESS
-#define HAVE_GETPAGESIZE 1
-#define HAVE_TZSET 1
-#define HAVE_SETLOCALE 1
-#undef HAVE_UTIMES
-#undef HAVE_SETRLIMIT
-#undef HAVE_SETPGID
-#undef HAVE_GETCWD
-#define HAVE_SHUTDOWN 1
-
-#define LOCALTIME_CACHE
-#define HAVE_INET_SOCKETS 1
-
-#undef HAVE_AIX_SMT_EXP
-#define USE_TOOLKIT_SCROLL_BARS 1
-
-/* Define if you have the ANSI `strerror' function.
- Otherwise you must have the variable `char *sys_errlist[]'. */
-#define HAVE_STRERROR 1
-
-/* Define if `struct utimbuf' is declared by <utime.h>. */
-#undef HAVE_STRUCT_UTIMBUF
-
-#define HAVE_MOUSE 1
-#define HAVE_H_ERRNO 1
-
#ifdef HAVE_NTGUI
#define HAVE_WINDOW_SYSTEM 1
#define HAVE_MENUS 1
@@ -199,8 +145,6 @@ struct sigaction {
#endif
/* Calls that are emulated or shadowed. */
-#undef access
-#define access sys_access
#undef chdir
#define chdir sys_chdir
#undef chmod
@@ -229,6 +173,7 @@ struct sigaction {
#define rename sys_rename
#define rmdir sys_rmdir
#define select sys_select
+#define pselect sys_select
#define sleep sys_sleep
#define strerror sys_strerror
#undef unlink
@@ -238,10 +183,12 @@ struct sigaction {
/* Subprocess calls that are emulated. */
#define spawnve sys_spawnve
-#define wait sys_wait
#define kill sys_kill
#define signal sys_signal
+/* Internal signals. */
+#define emacs_raise(sig) emacs_abort()
+
/* termcap.c calls that are emulated. */
#define tputs sys_tputs
#define tgetstr sys_tgetstr
@@ -286,12 +233,34 @@ typedef int pid_t;
#define stricmp _stricmp
#define tzset _tzset
+/* We cannot include system header process.h, since there's src/process.h. */
+int _getpid (void);
+
+/* Include time.h before redirecting tzname, since MSVC's time.h
+ defines _tzname to call a function, but also declares tzname a
+ 2-element array. Having the redirection before including the
+ header thus has the effect of declaring a function that returns an
+ array, and triggers an error message. */
+#include <time.h>
#define tzname _tzname
#if !defined (_MSC_VER) || (_MSC_VER < 1400)
#undef utime
#define utime _utime
#endif
+/* 'struct timespec' is used by time-related functions in lib/ and
+ elsewhere, but we don't use lib/time.h where the structure is
+ defined. */
+struct timespec
+{
+ time_t tv_sec; /* seconds */
+ long int tv_nsec; /* nanoseconds */
+};
+
+/* Required for functions in lib/time_r.c, since we don't use lib/time.h. */
+extern struct tm *gmtime_r (time_t const * restrict, struct tm * restrict);
+extern struct tm *localtime_r (time_t const * restrict, struct tm * restrict);
+
/* This is hacky, but is necessary to avoid warnings about macro
redefinitions using the SDK compilers. */
#ifndef __STDC__
@@ -314,11 +283,43 @@ typedef int pid_t;
#define SIGPIPE 13 /* Write on pipe with no readers */
#define SIGALRM 14 /* Alarm */
#define SIGCHLD 18 /* Death of child */
+#define SIGPROF 19 /* Profiling */
#ifndef NSIG
#define NSIG 23
#endif
+#ifdef _MSC_VER
+typedef int sigset_t;
+typedef int ssize_t;
+#endif
+
+typedef void (_CALLBACK_ *signal_handler) (int);
+extern signal_handler sys_signal (int, signal_handler);
+
+struct sigaction {
+ int sa_flags;
+ void (_CALLBACK_ *sa_handler)(int);
+ sigset_t sa_mask;
+};
+#define SA_RESTART 0
+#define SIG_BLOCK 1
+#define SIG_SETMASK 2
+#define SIG_UNBLOCK 3
+
+extern int sigemptyset (sigset_t *);
+extern int sigaddset (sigset_t *, int);
+extern int sigfillset (sigset_t *);
+extern int sigprocmask (int, const sigset_t *, sigset_t *);
+extern int pthread_sigmask (int, const sigset_t *, sigset_t *);
+extern int sigismember (const sigset_t *, int);
+extern int setpgrp (int, int);
+extern int sigaction (int, const struct sigaction *, struct sigaction *);
+extern int alarm (int);
+
+extern int sys_kill (int, int);
+
+
/* For integration with MSDOS support. */
#define getdisk() (_getdrive () - 1)
#ifdef emacs
@@ -338,6 +339,13 @@ extern char *get_emacs_configuration_options (void);
#define _WINSOCKAPI_ 1
#define _WINSOCK_H
+/* Prevent accidental use of features unavailable in
+ older Windows versions we still support. */
+#define _WIN32_WINNT 0x0400
+
+/* Make a leaner executable. */
+#define WIN32_LEAN_AND_MEAN 1
+
/* Defines size_t and alloca (). */
#ifdef emacs
#define malloc e_malloc
@@ -351,6 +359,7 @@ extern char *get_emacs_configuration_options (void);
#include <malloc.h>
#endif
+#include <stdlib.h>
#include <sys/stat.h>
/* Define for those source files that do not include enough NT system files. */
@@ -363,17 +372,59 @@ extern char *get_emacs_configuration_options (void);
#endif
/* For proper declaration of environ. */
-#include <stdlib.h>
#ifndef sys_nerr
#define sys_nerr _sys_nerr
#endif
-#include <string.h>
extern int getloadavg (double *, int);
+extern int getpagesize (void);
+
+#if defined (__MINGW32__)
+
+/* Define to 1 if the system has the type `long long int'. */
+# define HAVE_LONG_LONG_INT 1
+
+/* Define to 1 if the system has the type `unsigned long long int'. */
+# define HAVE_UNSIGNED_LONG_LONG_INT 1
+
+#endif
+
+#ifdef _MSC_VER
+# if defined(_WIN64)
+typedef __int64 EMACS_INT;
+typedef unsigned __int64 EMACS_UINT;
+# define EMACS_INT_MAX LLONG_MAX
+# define PRIuMAX "llu"
+# define pI "ll"
+/* Fix a bug in MSVC headers : stdint.h */
+# define _INTPTR 2
+# elif defined(_WIN32)
+/* Temporarily disable wider-than-pointer integers until they're tested more.
+ Build with CFLAGS='-DWIDE_EMACS_INT' to try them out. */
+
+# ifdef WIDE_EMACS_INT
+
+/* Use pre-C99-style 64-bit integers. */
+typedef __int64 EMACS_INT;
+typedef unsigned __int64 EMACS_UINT;
+# define EMACS_INT_MAX LLONG_MAX
+# define PRIuMAX "llu"
+# define pI "I64"
+# else
+typedef int EMACS_INT;
+typedef unsigned int EMACS_UINT;
+# define EMACS_INT_MAX LONG_MAX
+# define PRIuMAX "lu"
+# define pI "l"
+# endif
+# endif
+#endif
/* We need a little extra space, see ../../lisp/loadup.el. */
#define SYSTEM_PURESIZE_EXTRA 50000
+#define DATA_START get_data_start ()
+
/* For unexec to work on Alpha systems, we need to put Emacs'
initialized data into a separate section from the CRT initialized
data (because the Alpha linker freely reorders data variables, even
@@ -406,5 +457,23 @@ extern void _DebPrint (const char *fmt, ...);
#define DebPrint(stuff)
#endif
+#ifdef _MSC_VER
+#if _MSC_VER >= 800 && !defined(__cplusplus)
+/* Unnamed type definition in parentheses.
+ A structure, union, or enumerated type with no name is defined in a
+ parenthetical expression. The type definition is meaningless. */
+#pragma warning(disable:4116)
+/* 'argument' : conversion from 'type1' to 'type2', possible loss of
+ data A floating point type was converted to an integer type. A
+ possible loss of data may have occurred. */
+#pragma warning(disable:4244)
+/* Negative integral constant converted to unsigned type.
+ An expression converts a negative integer constant to an unsigned type.
+ The result of the expression is probably meaningless. */
+#pragma warning(disable:4308)
+#endif
+#endif
+#define TERM_HEADER "w32term.h"
+
/* ============================================================ */
diff --git a/nt/inc/nl_types.h b/nt/inc/nl_types.h
index b95018609cc..3d3a162bada 100644
--- a/nt/inc/nl_types.h
+++ b/nt/inc/nl_types.h
@@ -1,6 +1,6 @@
/* Replacement nl_types.h file for building GNU Emacs on Windows.
-Copyright (C) 2006-2011 Free Software Foundation, Inc.
+Copyright (C) 2006-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/inc/pwd.h b/nt/inc/pwd.h
index b39309d08fa..54e477e9665 100644
--- a/nt/inc/pwd.h
+++ b/nt/inc/pwd.h
@@ -18,8 +18,11 @@ struct passwd {
typedef unsigned uid_t;
typedef uid_t gid_t;
-struct passwd * getpwnam (char *);
-struct passwd * getpwuid (unsigned);
+extern unsigned getuid (void);
+extern unsigned geteuid (void);
+
+extern struct passwd * getpwnam (char *);
+extern struct passwd * getpwuid (unsigned);
#endif /* _PWD_H_ */
diff --git a/nt/inc/stdalign.h b/nt/inc/stdalign.h
new file mode 100644
index 00000000000..7e349dc31d0
--- /dev/null
+++ b/nt/inc/stdalign.h
@@ -0,0 +1,25 @@
+#ifndef _NT_STDALIGN_H_
+#define _NT_STDALIGN_H_
+
+/* This header has the necessary stuff from lib/stdalign.in.h, but
+ avoids the need to have Sed at build time. */
+
+#include <stddef.h>
+#if defined __cplusplus
+ template <class __t> struct __alignof_helper { char __a; __t __b; };
+# define _Alignof(type) offsetof (__alignof_helper<type>, __b)
+#else
+# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b)
+#endif
+#define alignof _Alignof
+
+#if __GNUC__
+# define _Alignas(a) __attribute__ ((__aligned__ (a)))
+#elif 1300 <= _MSC_VER
+# define _Alignas(a) __declspec (align (a))
+#endif
+#ifdef _Alignas
+# define alignas _Alignas
+#endif
+
+#endif /* _NT_STDALIGN_H_ */
diff --git a/nt/inc/stdint.h b/nt/inc/stdint.h
index 4eda1c5a688..97c9bbdaee9 100644
--- a/nt/inc/stdint.h
+++ b/nt/inc/stdint.h
@@ -1,6 +1,6 @@
/* Replacement stdint.h file for building GNU Emacs on Windows.
-Copyright (C) 2011 Free Software Foundation, Inc.
+Copyright (C) 2011-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -37,6 +37,7 @@ typedef unsigned __int64 uint64_t;
#define INT64_MAX 9223372036854775807i64
#define INT64_MIN (~INT64_MAX)
#define INTPTR_MAX INT64_MAX
+#define INTPTR_MIN INT64_MIN
#define UINTMAX_MAX UINT64_MAX
#define UINTMAX_MIN UINT64_MIN
#define INTMAX_MAX INT64_MAX
@@ -51,6 +52,7 @@ typedef unsigned int uint32_t;
#define INT32_MAX 2147483647
#define INT32_MIN (~INT32_MAX)
#define INTPTR_MAX INT32_MAX
+#define INTPTR_MIN INT32_MIN
#define UINTMAX_MAX UINT32_MAX
#define UINTMAX_MIN UINT32_MIN
#define INTMAX_MAX INT32_MAX
@@ -60,6 +62,7 @@ typedef unsigned int uint32_t;
#endif
#define PTRDIFF_MAX INTPTR_MAX
+#define PTRDIFF_MIN INTPTR_MIN
#endif /* !__GNUC__ */
diff --git a/nt/inc/sys/dir.h b/nt/inc/sys/dir.h
deleted file mode 100644
index dc075cd7587..00000000000
--- a/nt/inc/sys/dir.h
+++ /dev/null
@@ -1,6 +0,0 @@
-/*
- * map sys\dir.h to ..\..\..\src\ndir.h
- */
-
-#include "..\..\..\src\ndir.h"
-
diff --git a/nt/inc/sys/socket.h b/nt/inc/sys/socket.h
index ca70f8b41f1..95fee4c4659 100644
--- a/nt/inc/sys/socket.h
+++ b/nt/inc/sys/socket.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -119,49 +119,154 @@ int sys_sendto (int s, const char * buf, int len, int flags,
an fcntl function, for setting sockets to non-blocking mode. */
int fcntl (int s, int cmd, int options);
#define F_SETFL 4
-#define O_NDELAY 04000
+#define O_NONBLOCK 04000
/* we are providing a real h_errno variable */
#undef h_errno
extern int h_errno;
/* map winsock error codes to standard names */
+#if defined(EWOULDBLOCK)
+#undef EWOULDBLOCK
+#endif
#define EWOULDBLOCK WSAEWOULDBLOCK
+#if defined(EINPROGRESS)
+#undef EINPROGRESS
+#endif
#define EINPROGRESS WSAEINPROGRESS
+#if defined(EALREADY)
+#undef EALREADY
+#endif
#define EALREADY WSAEALREADY
+#if defined(ENOTSOCK)
+#undef ENOTSOCK
+#endif
#define ENOTSOCK WSAENOTSOCK
+#if defined(EDESTADDRREQ)
+#undef EDESTADDRREQ
+#endif
#define EDESTADDRREQ WSAEDESTADDRREQ
+#if defined(EMSGSIZE)
+#undef EMSGSIZE
+#endif
#define EMSGSIZE WSAEMSGSIZE
+#if defined(EPROTOTYPE)
+#undef EPROTOTYPE
+#endif
#define EPROTOTYPE WSAEPROTOTYPE
+#if defined(ENOPROTOOPT)
+#undef ENOPROTOOPT
+#endif
#define ENOPROTOOPT WSAENOPROTOOPT
+#if defined(EPROTONOSUPPORT)
+#undef EPROTONOSUPPORT
+#endif
#define EPROTONOSUPPORT WSAEPROTONOSUPPORT
+#if defined(ESOCKTNOSUPPORT)
+#undef ESOCKTNOSUPPORT
+#endif
#define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT
+#if defined(EOPNOTSUPP)
+#undef EOPNOTSUPP
+#endif
#define EOPNOTSUPP WSAEOPNOTSUPP
+#if defined(EPFNOSUPPORT)
+#undef EPFNOSUPPORT
+#endif
#define EPFNOSUPPORT WSAEPFNOSUPPORT
+#if defined(EAFNOSUPPORT)
+#undef EAFNOSUPPORT
+#endif
#define EAFNOSUPPORT WSAEAFNOSUPPORT
+#if defined(EADDRINUSE)
+#undef EADDRINUSE
+#endif
#define EADDRINUSE WSAEADDRINUSE
+#if defined(EADDRNOTAVAIL)
+#undef EADDRNOTAVAIL
+#endif
#define EADDRNOTAVAIL WSAEADDRNOTAVAIL
+#if defined(ENETDOWN)
+#undef ENETDOWN
+#endif
#define ENETDOWN WSAENETDOWN
+#if defined(ENETUNREACH)
+#undef ENETUNREACH
+#endif
#define ENETUNREACH WSAENETUNREACH
+#if defined(ENETRESET)
+#undef ENETRESET
+#endif
#define ENETRESET WSAENETRESET
+#if defined(ECONNABORTED)
+#undef ECONNABORTED
+#endif
#define ECONNABORTED WSAECONNABORTED
+#if defined(ECONNRESET)
+#undef ECONNRESET
+#endif
#define ECONNRESET WSAECONNRESET
+#if defined(ENOBUFS)
+#undef ENOBUFS
+#endif
#define ENOBUFS WSAENOBUFS
+#if defined(EISCONN)
+#undef EISCONN
+#endif
#define EISCONN WSAEISCONN
+#if defined(ENOTCONN)
+#undef ENOTCONN
+#endif
#define ENOTCONN WSAENOTCONN
+#if defined(ESHUTDOWN)
+#undef ESHUTDOWN
+#endif
#define ESHUTDOWN WSAESHUTDOWN
+#if defined(ETOOMANYREFS)
+#undef ETOOMANYREFS
+#endif
#define ETOOMANYREFS WSAETOOMANYREFS
+#if defined(ETIMEDOUT)
+#undef ETIMEDOUT
+#endif
#define ETIMEDOUT WSAETIMEDOUT
+#if defined(ECONNREFUSED)
+#undef ECONNREFUSED
+#endif
#define ECONNREFUSED WSAECONNREFUSED
+#if defined(ELOOP)
+#undef ELOOP
+#endif
#define ELOOP WSAELOOP
/* #define ENAMETOOLONG WSAENAMETOOLONG */
+#if defined(EHOSTDOWN)
+#undef EHOSTDOWN
+#endif
#define EHOSTDOWN WSAEHOSTDOWN
+#if defined(EHOSTUNREACH)
+#undef EHOSTUNREACH
+#endif
#define EHOSTUNREACH WSAEHOSTUNREACH
/* #define ENOTEMPTY WSAENOTEMPTY */
+#if defined(EPROCLIM)
+#undef EPROCLIM
+#endif
#define EPROCLIM WSAEPROCLIM
+#if defined(EUSERS)
+#undef EUSERS
+#endif
#define EUSERS WSAEUSERS
+#if defined(EDQUOT)
+#undef EDQUOT
+#endif
#define EDQUOT WSAEDQUOT
+#if defined(ESTALE)
+#undef ESTALE
+#endif
#define ESTALE WSAESTALE
+#if defined(EREMOTE)
+#undef EREMOTE
+#endif
#define EREMOTE WSAEREMOTE
#endif /* _SOCKET_H_ */
diff --git a/nt/inc/sys/stat.h b/nt/inc/sys/stat.h
index 7f0bbeccb17..b673b80a0e3 100644
--- a/nt/inc/sys/stat.h
+++ b/nt/inc/sys/stat.h
@@ -1,7 +1,7 @@
/* sys/stat.h supplied with MSVCRT uses too narrow data types for
inode and user/group id, so we replace them with our own.
-Copyright (C) 2008-2011 Free Software Foundation, Inc.
+Copyright (C) 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -33,13 +33,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/types.h>
#include <time.h>
-#define S_IFMT 0xF000
+#define S_IFMT 0xF800
#define S_IFREG 0x8000
#define S_IFDIR 0x4000
#define S_IFBLK 0x3000
#define S_IFCHR 0x2000
#define S_IFIFO 0x1000
+#define S_IFLNK 0x0800
#define S_IREAD 0x0100
#define S_IWRITE 0x0080
@@ -55,6 +56,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK)
#define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR)
#define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
+#define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
/* These don't exist on Windows, but lib/filemode.c wants them. */
#define S_ISUID 0
@@ -68,7 +70,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define S_IXOTH (S_IXUSR >> 6)
#define S_ISSOCK(m) 0
-#define S_ISLNK(m) 0
#define S_ISCTG(p) 0
#define S_ISDOOR(m) 0
#define S_ISMPB(m) 0
@@ -97,12 +98,13 @@ struct stat {
char st_gname[260];
};
+/* Prevent redefinition by other headers, e.g. wchar.h. */
+#define _STAT_DEFINED
+
_CRTIMP int __cdecl __MINGW_NOTHROW fstat (int, struct stat*);
_CRTIMP int __cdecl __MINGW_NOTHROW chmod (const char*, int);
_CRTIMP int __cdecl __MINGW_NOTHROW stat (const char*, struct stat*);
-
-/* fileio.c and dired.c want lstat. */
-#define lstat stat
+_CRTIMP int __cdecl __MINGW_NOTHROW lstat (const char*, struct stat*);
#endif /* INC_SYS_STAT_H_ */
diff --git a/nt/inc/sys/time.h b/nt/inc/sys/time.h
index c90d1fd62f5..c12c194fd2a 100644
--- a/nt/inc/sys/time.h
+++ b/nt/inc/sys/time.h
@@ -2,22 +2,36 @@
#define SYS_TIME_H_INCLUDED
/*
- * sys/time.h doesn't exist on NT
+ * sys/time.h either doesn't exist on Windows, or doesn't necessarily
+ * have the below stuff.
*/
struct timeval
- {
- long tv_sec; /* seconds */
- long tv_usec; /* microseconds */
- };
+{
+ long tv_sec; /* seconds */
+ long tv_usec; /* microseconds */
+};
+
struct timezone
- {
- int tz_minuteswest; /* minutes west of Greenwich */
- int tz_dsttime; /* type of dst correction */
- };
+{
+ int tz_minuteswest; /* minutes west of Greenwich */
+ int tz_dsttime; /* type of dst correction */
+};
void gettimeofday (struct timeval *, struct timezone *);
+#define ITIMER_REAL 0
+#define ITIMER_PROF 1
+
+struct itimerval
+{
+ struct timeval it_interval; /* timer interval */
+ struct timeval it_value; /* current value */
+};
+
+int getitimer (int, struct itimerval *);
+int setitimer (int, struct itimerval *, struct itimerval *);
+
#endif /* SYS_TIME_H_INCLUDED */
/* end of sys/time.h */
diff --git a/src/m/sparc.h b/nt/inc/sys/wait.h
index 99668043f30..8d890c9e175 100644
--- a/src/m/sparc.h
+++ b/nt/inc/sys/wait.h
@@ -1,6 +1,6 @@
-/* machine description file for Sun 4 SPARC.
+/* A limited emulation of sys/wait.h on Posix systems.
-Copyright (C) 1987, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -17,14 +17,17 @@ 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/>. */
-/* __sparc__ is defined by the compiler by default. */
+#ifndef INC_SYS_WAIT_H_
+#define INC_SYS_WAIT_H_
-#ifdef __arch64__ /* GCC, 64-bit ABI. */
+#define WNOHANG 1
+#define WUNTRACED 2
+#define WSTOPPED 2 /* same as WUNTRACED */
+#define WEXITED 4
+#define WCONTINUED 8
-#define BITS_PER_LONG 64
+/* The various WIF* macros are defined in src/syswait.h. */
-#ifndef _LP64
-#define _LP64 /* Done on Alpha -- not sure if it should be here. -- fx */
-#endif
+extern pid_t waitpid (pid_t, int *, int);
-#endif /* __arch64__ */
+#endif /* INC_SYS_WAIT_H_ */
diff --git a/nt/inc/unistd.h b/nt/inc/unistd.h
index fb1f1c4b3bf..e751ed124d3 100644
--- a/nt/inc/unistd.h
+++ b/nt/inc/unistd.h
@@ -3,8 +3,29 @@
#ifndef _UNISTD_H
#define _UNISTD_H
+/* On Microsoft platforms, <stdlib.h> declares 'environ'; on POSIX
+ platforms, <unistd.h> does. Every file in Emacs that includes
+ <unistd.h> also includes <stdlib.h>, so there's no need to declare
+ 'environ' here. */
+
+/* Provide prototypes of library functions that are emulated on w32
+ and whose prototypes are usually found in unistd.h on POSIX
+ platforms. */
extern ssize_t readlink (const char *, char *, size_t);
extern int symlink (char const *, char const *);
+extern int setpgid (pid_t, pid_t);
+extern pid_t getpgrp (void);
+extern pid_t setsid (void);
+extern pid_t tcgetpgrp (int);
-#endif /* _UNISTD_H */
+extern int faccessat (int, char const *, int, int);
+
+/* These are normally on fcntl.h, but we don't override that header. */
+/* Use values compatible with gnulib, as there's no reason to differ. */
+#define AT_FDCWD (-3041965)
+#define AT_EACCESS 4
+#define AT_SYMLINK_NOFOLLOW 4096
+#define O_NOCTTY 0
+
+#endif /* _UNISTD_H */
diff --git a/nt/makefile.w32-in b/nt/makefile.w32-in
index a474e34eaa5..7377d7e33b9 100644
--- a/nt/makefile.w32-in
+++ b/nt/makefile.w32-in
@@ -1,452 +1,471 @@
-# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
-# Copyright (C) 2000-2011 Free Software Foundation, Inc.
-#
-# Top level makefile for building GNU Emacs on Windows NT
-#
-# 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/>.
-
-
-# FIXME: This file uses DOS EOLs. Convert to Unix after 22.1 is out
-# (and remove or replace this comment).
-
-VERSION = 24.0.92
-
-TMP_DIST_DIR = emacs-$(VERSION)
-
-TRES = $(BLD)/emacs.res
-CLIENTRES = $(BLD)/emacsclient.res
-
-XMFLAGS =
-
-ALL = addpm ddeclient runemacs cmdproxy addsection preprep
-
-.PHONY: $(ALL)
-
-
-addpm: stamp_BLD $(BLD)/addpm.exe
-$(BLD)/addpm.exe: $(BLD)/addpm.$(O)
- $(LINK) $(LINK_OUT)$@ \
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) \
- $(USER32) $(OLE32) $(UUID) $(SHELL32)
-
-ddeclient: stamp_BLD $(BLD)/ddeclient.exe
-$(BLD)/ddeclient.exe: $(BLD)/ddeclient.$(O)
- $(LINK) $(LINK_OUT)$@ \
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) $(USER32)
-
-cmdproxy: stamp_BLD $(BLD)/cmdproxy.exe
-$(BLD)/cmdproxy.exe: $(BLD)/cmdproxy.$(O)
- $(LINK) $(LINK_OUT)$@ \
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(USER32)
-
-addsection: stamp_BLD $(BLD)/addsection.exe
-$(BLD)/addsection.exe: $(BLD)/addsection.$(O)
- $(LINK) $(LINK_OUT)$@ \
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(USER32)
-
-preprep: stamp_BLD $(BLD)/preprep.exe
-$(BLD)/preprep.exe: $(BLD)/preprep.$(O)
- $(LINK) $(LINK_OUT)$@ \
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS)
-
-#
-# The resource file. NT 3.10 requires the use of cvtres; even though
-# it is not necessary on later versions, it is still ok to use it.
-#
-$(TRES): emacs.rc icons/emacs.ico emacs.manifest stamp_BLD
- $(RC) $(RC_OUT)$(TRES) emacs.rc
-
-$(CLIENTRES): emacsclient.rc stamp_BLD
- $(RC) $(RC_OUT)$(CLIENTRES) emacsclient.rc
-
-runemacs: stamp_BLD $(BLD)/runemacs.exe
-$(BLD)/runemacs.exe: $(BLD)/runemacs.$(O) $(TRES)
- $(LINK) $(LINK_OUT)$@ $(SUBSYSTEM_WINDOWS) \
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) $(USER32)
-
-which-sh:
- @echo Using $(THE_SHELL) as shell.
-
-# These depend on stamp_BLD to make sure the $(BLD) directory is created
-# before the compilation begins, even if Make runs several commands
-# in parallel under "make -j".
-#
-$(BLD)/addpm.$(O) $(BLD)/ddeclient.$(O) $(BLD)/runemacs.$(O) $(BLD)/cmdproxy.$(O) $(BLD)/addsection.$(O) $(BLD)/preprep.$(O): stamp_BLD
-
-#
-# Build emacs
-#
-all: which-sh stamp_BLD $(ALL) $(CLIENTRES) maybe-bootstrap all-other-dirs-$(MAKETYPE)
-
-all-other-dirs-nmake: addsection
- cd ..\lib
- $(MAKE) $(MFLAGS) all
- cd ..\lib-src
- $(MAKE) $(MFLAGS) all
- cd ..\src
- $(MAKE) $(MFLAGS) all
- cd ..\lisp
- $(MAKE) $(MFLAGS) all
- cd ..\leim
- $(MAKE) $(MFLAGS) all
- cd ..\nt
-
-all-other-dirs-gmake: addsection
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib all
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src all
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src all
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp all
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim all
-
-recompile: recompile-$(MAKETYPE)
-
-recompile-nmake:
- cd ..\lisp
- $(MAKE) $(MFLAGS) recompile
- cd ..\nt
-
-recompile-gmake:
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp recompile
-
-#### Bootstrapping.
-
-### This is meant for Emacs maintainers only. It first cleans the
-### lisp subdirectory, removing all compiled Lisp files. Then a
-### special emacs executable is built from Lisp sources, which is then
-### used to compile Lisp files. The last step is a "normal" make.
-
-maybe-bootstrap: maybe-bootstrap-$(SHELLTYPE)
-
-# dummy target to force other targets to be evaluated.
-doit:
-
-maybe-bootstrap-CMD: doit
- @echo .
- @if not EXIST ..\lisp\abbrev.elc echo Essential Lisp files seem to be missing. You should either
- @if not EXIST ..\lisp\abbrev.elc echo do 'make bootstrap' or create 'lisp/abbrev.elc' somehow
- @echo .
- @if not EXIST ..\lisp\abbrev.elc exit -1
-
-maybe-bootstrap-SH: doit
- @if [ ! -f ../lisp/abbrev.elc ] ; then \
- echo; \
- echo "Essential Lisp files seem to be missing. You should either"; \
- echo "do \`make bootstrap' or create \`lisp/abbrev.elc' somehow."; \
- echo; \
- exit -1; \
- fi
-
-# Bootstrap depends on cmdproxy because some Lisp functions
-# loaded during bootstrap may need to run shell commands.
-bootstrap: addsection cmdproxy bootstrap-$(MAKETYPE)
- $(MAKE) $(MFLAGS) $(XMFLAGS) all
-
-bootstrap-nmake: addsection cmdproxy
- cd ..\lisp
- $(MAKE) $(MFLAGS) bootstrap-clean
- cd ..\src
- $(MAKE) $(MFLAGS) clean
- cd ..\lib-src
- $(MAKE) $(MFLAGS) clean make-docfile
- cd ..\lib
- $(MAKE) $(MFLAGS) clean all
- cd ..\src
- $(MAKE) $(MFLAGS) bootstrap
- $(MAKE) $(MFLAGS) bootstrap-clean
- cd ..\nt
- $(CP) $(BLD)/cmdproxy.exe ../bin
- cd ..\lisp
- $(MAKE) $(MFLAGS) SHELL=$(SHELLTYPE) bootstrap
- cd ..\lib-src
- $(MAKE) $(MFLAGS) DOC
- cd ..\nt
-
-bootstrap-gmake: addsection cmdproxy
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp bootstrap-clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src clean make-docfile
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib clean all
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src bootstrap
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src bootstrap-clean
- $(CP) $(BLD)/cmdproxy.exe ../bin
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp bootstrap
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src DOC
-
-bootstrap-clean: bootstrap-clean-$(MAKETYPE)
-
-bootstrap-clean-nmake:
- cd ..\src
- $(MAKE) $(MFLAGS) bootstrap-clean
- cd ..\lib
- $(MAKE) $(MFLAGS) clean
- cd ..\lisp
- $(MAKE) $(MFLAGS) bootstrap-clean
-
-bootstrap-clean-gmake:
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src bootstrap-clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp bootstrap-clean
-
-$(INSTALL_DIR):
- - mkdir "$(INSTALL_DIR)"
-
-$(INSTALL_DIR)/bin: $(INSTALL_DIR)
- - mkdir "$(INSTALL_DIR)/bin"
-
-#
-# Build and install emacs in INSTALL_DIR
-#
-.PHONY: install-bin install-shortcuts
-
-install: install-bin install-shortcuts
-
-install-bin: all $(INSTALL_DIR)/bin install-other-dirs-$(MAKETYPE)
- - $(CP) $(BLD)/addpm.exe $(INSTALL_DIR)/bin
- - $(CP) $(BLD)/ddeclient.exe $(INSTALL_DIR)/bin
- - $(CP) $(BLD)/cmdproxy.exe $(INSTALL_DIR)/bin
- - $(CP) $(BLD)/runemacs.exe $(INSTALL_DIR)/bin
- - $(CP) README.W32 $(INSTALL_DIR)
- - $(DEL) ../same-dir.tst
- - $(DEL) $(INSTALL_DIR)/same-dir.tst
- echo SameDirTest > "$(INSTALL_DIR)/same-dir.tst"
- - mkdir "$(INSTALL_DIR)/etc"
- - mkdir "$(INSTALL_DIR)/info"
- - mkdir "$(INSTALL_DIR)/lock"
- - mkdir "$(INSTALL_DIR)/data"
- - mkdir "$(INSTALL_DIR)/site-lisp"
- - mkdir "$(INSTALL_DIR)/etc/icons"
- $(IFNOTSAMEDIR) $(CP) ../site-lisp/subdirs.el $(INSTALL_DIR)/site-lisp $(ENDIF)
- $(IFNOTSAMEDIR) $(CP_DIR) ../etc $(INSTALL_DIR) $(ENDIF)
- - $(CP_DIR) icons $(INSTALL_DIR)/etc
- $(IFNOTSAMEDIR) $(CP_DIR) ../info $(INSTALL_DIR) $(ENDIF)
- $(IFNOTSAMEDIR) $(CP) ../COPYING $(INSTALL_DIR) $(ENDIF)
- - $(CP) ../COPYING $(INSTALL_DIR)/bin
- - $(DEL) ../same-dir.tst
- - $(DEL) $(INSTALL_DIR)/same-dir.tst
-
-install-other-dirs-nmake:
- cd ..\lib-src
- $(MAKE) $(MFLAGS) install
- cd ..\src
- $(MAKE) $(MFLAGS) install
- cd ..\lisp
- $(MAKE) $(MFLAGS) install
- cd ..\leim
- $(MAKE) $(MFLAGS) install
- cd ..\nt
-
-install-other-dirs-gmake:
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src install
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src install
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp install
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim install
-
-install-shortcuts:
- "$(INSTALL_DIR)/bin/addpm" -q
-
-dist: install-bin
- mkdir $(TMP_DIST_DIR)
- $(CP) "$(INSTALL_DIR)/BUGS" $(TMP_DIST_DIR)
- $(CP) "$(INSTALL_DIR)/COPYING" $(TMP_DIST_DIR)
- $(CP) "$(INSTALL_DIR)/README" $(TMP_DIST_DIR)
- $(CP) "$(INSTALL_DIR)/README.W32" $(TMP_DIST_DIR)
- $(CP_DIR) "$(INSTALL_DIR)/bin" $(TMP_DIST_DIR)
- $(CP_DIR) "$(INSTALL_DIR)/etc" $(TMP_DIST_DIR)
- $(CP_DIR) "$(INSTALL_DIR)/info" $(TMP_DIST_DIR)
- $(CP_DIR) "$(INSTALL_DIR)/lisp" $(TMP_DIST_DIR)
- $(CP_DIR) "$(INSTALL_DIR)/leim" $(TMP_DIST_DIR)
- $(CP_DIR) "$(INSTALL_DIR)/site-lisp" $(TMP_DIST_DIR)
- $(CP_DIR) $(DIST_FILES) $(TMP_DIST_DIR)/bin
- $(COMSPEC)$(ComSpec) /c $(ARGQUOTE)zipdist.bat $(VERSION)$(ARGQUOTE)
- $(DEL_TREE) $(TMP_DIST_DIR)
-
-force-info:
-# Note that doc/emacs/makefile knows how to
-# put the info files in $(infodir),
-# so we can do ok running make in the build dir.
-info: force-info info-$(MAKETYPE)
-
-info-nmake:
- cd ..\doc\emacs
- $(MAKE) $(MFLAGS) info
- cd ..\misc
- $(MAKE) $(MFLAGS) info
- cd ..\lispref
- $(MAKE) $(MFLAGS) info
- cd ..\lispintro
- $(MAKE) $(MFLAGS) info
- cd $(MAKEDIR)
-
-info-gmake:
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs info
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc info
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref info
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro info
-#
-# Maintenance
-#
-clean: clean-other-dirs-$(MAKETYPE)
- - $(DEL) $(COMPILER_TEMP_FILES)
- - $(DEL_TREE) $(OBJDIR)
- - $(DEL) stamp_BLD
- - $(DEL) ../etc/DOC ../etc/DOC-X
-
-clean-other-dirs-nmake:
- cd ..\lib
- $(MAKE) $(MFLAGS) clean
- cd ..\lib-src
- $(MAKE) $(MFLAGS) clean
- cd ..\src
- $(MAKE) $(MFLAGS) clean
- cd ..\doc\lispintro
- $(MAKE) $(MFLAGS) clean
- cd ..\lispref
- $(MAKE) $(MFLAGS) clean
- cd ..\..\leim
- $(MAKE) $(MFLAGS) clean
- cd ..\doc\emacs
- $(MAKE) $(MFLAGS) clean
- cd ..\misc
- $(MAKE) $(MFLAGS) clean
- cd ..\..\nt
-
-clean-other-dirs-gmake:
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref clean
-
-cleanall-other-dirs-nmake:
- cd ..\lib
- $(MAKE) $(MFLAGS) cleanall
- cd ..\lib-src
- $(MAKE) $(MFLAGS) cleanall
- cd ..\src
- $(MAKE) $(MFLAGS) cleanall
- cd ..\nt
-
-cleanall-other-dirs-gmake:
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib cleanall
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src cleanall
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src cleanall
-
-# We used to delete *~ here, but that might inadvertently remove
-# precious files if it happens to match their short 8+3 aliases.
-cleanall: clean cleanall-other-dirs-$(MAKETYPE)
- - $(DEL_TREE) obj
- - $(DEL_TREE) obj-spd
- - $(DEL_TREE) oo
- - $(DEL_TREE) oo-spd
-
-top-distclean:
- - $(DEL) $(COMPILER_TEMP_FILES)
- - $(DEL_TREE) obj
- - $(DEL_TREE) obj-spd
- - $(DEL_TREE) oo
- - $(DEL_TREE) oo-spd
- - $(DEL) stamp_BLD
- - $(DEL) ../etc/DOC ../etc/DOC-X
- - $(DEL) config.log Makefile
- - $(DEL) ../README.W32
-
-distclean: distclean-other-dirs-$(MAKETYPE) top-distclean
-
-distclean-other-dirs-nmake:
- cd ..\lib
- $(MAKE) $(MFLAGS) distclean
- cd ..\lib-src
- $(MAKE) $(MFLAGS) distclean
- cd ..\src
- $(MAKE) $(MFLAGS) distclean
- cd ..\lisp
- $(MAKE) $(MFLAGS) distclean
- cd ..\leim
- $(MAKE) $(MFLAGS) distclean
- cd ..\doc\emacs
- $(MAKE) $(MFLAGS) distclean
- cd ..\misc
- $(MAKE) $(MFLAGS) distclean
- cd ..\lispintro
- $(MAKE) $(MFLAGS) distclean
- cd ..\lispref
- $(MAKE) $(MFLAGS) distclean
- cd ..\..\nt
-
-distclean-other-dirs-gmake:
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib distclean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src distclean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src distclean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp distclean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim distclean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs distclean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc distclean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro distclean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref distclean
-
-maintainer-clean: maintainer-clean-other-dirs-$(MAKETYPE) top-distclean
-
-maintainer-clean-other-dirs-nmake:
- cd ..\lib
- $(MAKE) $(MFLAGS) maintainer-clean
- cd ..\lib-src
- $(MAKE) $(MFLAGS) maintainer-clean
- cd ..\src
- $(MAKE) $(MFLAGS) maintainer-clean
- cd ..\lisp
- $(MAKE) $(MFLAGS) maintainer-clean
- cd ..\leim
- $(MAKE) $(MFLAGS) maintainer-clean
- cd ..\doc\emacs
- $(MAKE) $(MFLAGS) maintainer-clean
- cd ..\misc
- $(MAKE) $(MFLAGS) maintainer-clean
- cd ..\lispintro
- $(MAKE) $(MFLAGS) maintainer-clean
- cd ..\lispref
- $(MAKE) $(MFLAGS) maintainer-clean
- cd ..\..\nt
-
-maintainer-clean-other-dirs-gmake:
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib maintainer-clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src maintainer-clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src maintainer-clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp maintainer-clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim maintainer-clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs maintainer-clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc maintainer-clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro maintainer-clean
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref maintainer-clean
-
-realclean: cleanall
- - $(DEL_TREE) ../bin
-
-TAGS: TAGS-$(MAKETYPE)
-
-frc:
-TAGS-gmake: frc
- ../lib-src/$(BLD)/etags $(CURDIR)/*.c
- $(MAKE) $(MFLAGS) -C ../src TAGS TAGS-LISP
- $(MAKE) $(MFLAGS) -C ../lib-src TAGS
- $(MAKE) $(MFLAGS) -C ../lib TAGS
-
-TAGS-nmake:
- echo This target is not supported with NMake
-
-.PHONY: frc
+# -*- Makefile -*- for GNU Emacs on the Microsoft Windows API.
+# Copyright (C) 2000-2012 Free Software Foundation, Inc.
+#
+# Top level makefile for building GNU Emacs on Windows NT
+#
+# 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/>.
+
+
+# FIXME: This file uses DOS EOLs. Convert to Unix after 22.1 is out
+# (and remove or replace this comment).
+
+VERSION = 24.3.50
+
+TMP_DIST_DIR = emacs-$(VERSION)
+
+TRES = $(BLD)/emacs.res
+CLIENTRES = $(BLD)/emacsclient.res
+
+XMFLAGS =
+
+ALL = addpm ddeclient runemacs cmdproxy addsection preprep
+
+.PHONY: $(ALL)
+
+
+addpm: stamp_BLD $(BLD)/addpm.exe
+$(BLD)/addpm.exe: $(BLD)/addpm.$(O)
+ $(LINK) $(LINK_OUT)$@ \
+ $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) \
+ $(USER32) $(OLE32) $(UUID) $(SHELL32)
+
+ddeclient: stamp_BLD $(BLD)/ddeclient.exe
+$(BLD)/ddeclient.exe: $(BLD)/ddeclient.$(O)
+ $(LINK) $(LINK_OUT)$@ \
+ $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) $(USER32)
+
+cmdproxy: stamp_BLD $(BLD)/cmdproxy.exe
+$(BLD)/cmdproxy.exe: $(BLD)/cmdproxy.$(O)
+ $(LINK) $(LINK_OUT)$@ \
+ $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(USER32)
+
+addsection: stamp_BLD $(BLD)/addsection.exe
+$(BLD)/addsection.exe: $(BLD)/addsection.$(O)
+ $(LINK) $(LINK_OUT)$@ \
+ $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(USER32)
+
+preprep: stamp_BLD $(BLD)/preprep.exe
+$(BLD)/preprep.exe: $(BLD)/preprep.$(O)
+ $(LINK) $(LINK_OUT)$@ \
+ $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS)
+
+#
+# The resource file. NT 3.10 requires the use of cvtres; even though
+# it is not necessary on later versions, it is still ok to use it.
+#
+$(TRES): emacs.rc icons/emacs.ico $(EMACS_MANIFEST) stamp_BLD
+ $(RC) $(RC_OUT)$(TRES) emacs.rc
+
+$(CLIENTRES): emacsclient.rc stamp_BLD
+ $(RC) $(RC_OUT)$(CLIENTRES) emacsclient.rc
+
+runemacs: stamp_BLD $(BLD)/runemacs.exe
+$(BLD)/runemacs.exe: $(BLD)/runemacs.$(O) $(TRES)
+ $(LINK) $(LINK_OUT)$@ $(SUBSYSTEM_WINDOWS) \
+ $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) $(USER32)
+
+which-sh:
+ @echo Using $(THE_SHELL) as shell.
+
+# These depend on stamp_BLD to make sure the $(BLD) directory is created
+# before the compilation begins, even if Make runs several commands
+# in parallel under "make -j".
+#
+$(BLD)/addpm.$(O) $(BLD)/ddeclient.$(O) $(BLD)/runemacs.$(O) $(BLD)/cmdproxy.$(O) $(BLD)/addsection.$(O) $(BLD)/preprep.$(O): stamp_BLD
+
+#
+# Build emacs
+#
+all: which-sh $(ALL) $(CLIENTRES) all-other-dirs-$(MAKETYPE)
+
+all-other-dirs-$(MAKETYPE): maybe-bootstrap
+
+all-other-dirs-nmake: addsection
+ cd ..\lib
+ $(MAKE) $(MFLAGS) all
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) all
+ cd ..\src
+ $(MAKE) $(MFLAGS) all
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) all
+ cd ..\leim
+ $(MAKE) $(MFLAGS) all
+ cd ..\nt
+
+all-other-dirs-gmake: addsection
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib all
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src all
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src all
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp all
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim all
+
+recompile: recompile-$(MAKETYPE)
+
+recompile-nmake:
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) recompile
+ cd ..\nt
+
+recompile-gmake:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp recompile
+
+#### Bootstrapping.
+
+### This is meant for Emacs maintainers only. It first cleans the
+### lisp subdirectory, removing all compiled Lisp files. Then a
+### special emacs executable is built from Lisp sources, which is then
+### used to compile Lisp files. The last step is a "normal" make.
+
+maybe-bootstrap: maybe-bootstrap-$(SHELLTYPE)
+
+# dummy target to force other targets to be evaluated.
+doit:
+
+maybe-bootstrap-CMD: doit
+ @echo .
+ @if not EXIST ..\lisp\abbrev.elc echo Essential Lisp files seem to be missing. You should either
+ @if not EXIST ..\lisp\abbrev.elc echo do 'make bootstrap' or create 'lisp/abbrev.elc' somehow
+ @echo .
+ @if not EXIST ..\lisp\abbrev.elc exit -1
+
+maybe-bootstrap-SH: doit
+ @if [ ! -f ../lisp/abbrev.elc ] ; then \
+ echo; \
+ echo "Essential Lisp files seem to be missing. You should either"; \
+ echo "do \`make bootstrap' or create \`lisp/abbrev.elc' somehow."; \
+ echo; \
+ exit -1; \
+ fi
+
+# Bootstrap depends on cmdproxy because some Lisp functions
+# loaded during bootstrap may need to run shell commands.
+bootstrap: addsection cmdproxy bootstrap-$(MAKETYPE)
+ $(MAKE) $(MFLAGS) $(XMFLAGS) all
+
+bootstrap-nmake: addsection cmdproxy
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) bootstrap-clean
+ cd ..\src
+ $(MAKE) $(MFLAGS) clean
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) clean make-docfile
+ cd ..\lib
+ $(MAKE) $(MFLAGS) clean all
+ cd ..\src
+ $(MAKE) $(MFLAGS) bootstrap
+ $(MAKE) $(MFLAGS) bootstrap-clean
+ cd ..\nt
+ $(CP) $(BLD)/cmdproxy.exe ../bin
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) SHELL=$(SHELLTYPE) bootstrap
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) DOC
+ cd ..\nt
+
+bootstrap-gmake: addsection cmdproxy
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp bootstrap-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src make-docfile
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib all
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src bootstrap
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src bootstrap-clean
+ $(CP) $(BLD)/cmdproxy.exe ../bin
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp bootstrap
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src DOC
+
+bootstrap-clean: bootstrap-clean-$(MAKETYPE)
+
+bootstrap-clean-nmake:
+ cd ..\src
+ $(MAKE) $(MFLAGS) bootstrap-clean
+ cd ..\lib
+ $(MAKE) $(MFLAGS) clean
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) bootstrap-clean
+
+bootstrap-clean-gmake:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src bootstrap-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp bootstrap-clean
+
+$(INSTALL_DIR):
+ - mkdir "$(INSTALL_DIR)"
+
+$(INSTALL_DIR)/bin: $(INSTALL_DIR)
+ - mkdir "$(INSTALL_DIR)/bin"
+
+#
+# Build and install emacs in INSTALL_DIR
+#
+.PHONY: install-bin install-shortcuts
+
+install: install-bin install-shortcuts
+
+install-bin: all $(INSTALL_DIR)/bin install-other-dirs-$(MAKETYPE)
+ - $(CP) $(BLD)/ddeclient.exe $(INSTALL_DIR)/bin
+ - $(CP) $(BLD)/cmdproxy.exe $(INSTALL_DIR)/bin
+ - $(CP) $(BLD)/runemacs.exe $(INSTALL_DIR)/bin
+ - $(CP) README.W32 $(INSTALL_DIR)
+ - $(DEL) ../$(DIRNAME)_same-dir.tst
+ - $(DEL) $(INSTALL_DIR)/$(DIRNAME)_same-dir.tst
+ echo SameDirTest > "$(INSTALL_DIR)/$(DIRNAME)_same-dir.tst"
+ - mkdir "$(INSTALL_DIR)/etc"
+ - mkdir "$(INSTALL_DIR)/info"
+ - mkdir "$(INSTALL_DIR)/lock"
+ - mkdir "$(INSTALL_DIR)/data"
+ - mkdir "$(INSTALL_DIR)/site-lisp"
+ - mkdir "$(INSTALL_DIR)/etc/icons"
+ $(IFNOTSAMEDIR) $(CP) ../site-lisp/subdirs.el $(INSTALL_DIR)/site-lisp $(ENDIF)
+ $(IFNOTSAMEDIR) $(CP_DIR) ../etc $(INSTALL_DIR) $(ENDIF)
+ - $(CP_DIR) icons $(INSTALL_DIR)/etc
+ $(IFNOTSAMEDIR) $(CP_DIR) ../info $(INSTALL_DIR) $(ENDIF)
+ $(IFNOTSAMEDIR) $(CP) ../COPYING $(INSTALL_DIR) $(ENDIF)
+ - $(CP) ../COPYING $(INSTALL_DIR)/bin
+ - $(DEL) ../$(DIRNAME)_same-dir.tst
+ - $(DEL) $(INSTALL_DIR)/$(DIRNAME)_same-dir.tst
+
+install-other-dirs-nmake: all
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) install
+ cd ..\src
+ $(MAKE) $(MFLAGS) install
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) install
+ cd ..\leim
+ $(MAKE) $(MFLAGS) install
+ cd ..\nt
+
+install-other-dirs-gmake: all
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src install
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src install
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp install
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim install
+
+install-addpm: $(INSTALL_DIR)/bin addpm
+ - $(CP) $(BLD)/addpm.exe $(INSTALL_DIR)/bin
+
+install-shortcuts: install-addpm
+ "$(INSTALL_DIR)/bin/addpm" -q
+
+maybe-copy-distfiles: maybe-copy-distfiles-$(SHELLTYPE)
+
+maybe-copy-distfiles-CMD: create-tmp-dist-dir doit
+ @if not $(ARGQUOTE)$(DIST_FILES)$(ARGQUOTE) == "" $(CP_DIR) $(DIST_FILES) $(TMP_DIST_DIR)/bin
+
+maybe-copy-distfiles-SH: create-tmp-dist-dir doit
+ @if [ ! $(ARGQUOTE)$(DIST_FILES)$(ARGQUOTE) == "" ] ; then \
+ $(CP_DIR) $(DIST_FILES) $(TMP_DIST_DIR)/bin ; \
+ fi
+
+create-tmp-dist-dir:
+ mkdir "$(TMP_DIST_DIR)"
+# Also create bin directory for dist files.
+ mkdir "$(TMP_DIST_DIR)/bin"
+
+dist: install-bin install-addpm maybe-copy-distfiles
+ $(CP) "$(INSTALL_DIR)/BUGS" $(TMP_DIST_DIR)
+ $(CP) "$(INSTALL_DIR)/COPYING" $(TMP_DIST_DIR)
+ $(CP) "$(INSTALL_DIR)/README" $(TMP_DIST_DIR)
+ $(CP) "$(INSTALL_DIR)/README.W32" $(TMP_DIST_DIR)
+ $(CP_DIR) "$(INSTALL_DIR)/bin" $(TMP_DIST_DIR)
+ $(CP_DIR) "$(INSTALL_DIR)/etc" $(TMP_DIST_DIR)
+ $(CP_DIR) "$(INSTALL_DIR)/info" $(TMP_DIST_DIR)
+ $(CP_DIR) "$(INSTALL_DIR)/lisp" $(TMP_DIST_DIR)
+ $(CP_DIR) "$(INSTALL_DIR)/leim" $(TMP_DIST_DIR)
+ $(CP_DIR) "$(INSTALL_DIR)/site-lisp" $(TMP_DIST_DIR)
+ $(COMSPEC)$(ComSpec) /c $(ARGQUOTE)zipdist.bat $(VERSION)$(ARGQUOTE)
+ $(DEL_TREE) $(TMP_DIST_DIR)
+
+force-info:
+# Note that doc/emacs/makefile knows how to
+# put the info files in $(infodir),
+# so we can do ok running make in the build dir.
+info: force-info info-$(MAKETYPE)
+
+info-nmake:
+ cd ..\doc\emacs
+ $(MAKE) $(MFLAGS) info
+ cd ..\misc
+ $(MAKE) $(MFLAGS) info
+ cd ..\lispref
+ $(MAKE) $(MFLAGS) info
+ cd ..\lispintro
+ $(MAKE) $(MFLAGS) info
+ cd $(MAKEDIR)
+
+info-gmake: emacs misc lispref lispintro
+
+emacs misc lispref lispintro:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/$@ info
+
+#
+# Maintenance
+#
+clean: clean-other-dirs-$(MAKETYPE)
+ - $(DEL) $(COMPILER_TEMP_FILES)
+ - $(DEL_TREE) $(OBJDIR)
+ - $(DEL) stamp_BLD
+ - $(DEL) ../etc/DOC ../etc/DOC-X
+
+clean-other-dirs-nmake:
+ cd ..\lib
+ $(MAKE) $(MFLAGS) clean
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) clean
+ cd ..\src
+ $(MAKE) $(MFLAGS) clean
+ cd ..\doc\lispintro
+ $(MAKE) $(MFLAGS) clean
+ cd ..\lispref
+ $(MAKE) $(MFLAGS) clean
+ cd ..\..\leim
+ $(MAKE) $(MFLAGS) clean
+ cd ..\doc\emacs
+ $(MAKE) $(MFLAGS) clean
+ cd ..\misc
+ $(MAKE) $(MFLAGS) clean
+ cd ..\..\nt
+
+clean-other-dirs-gmake:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref clean
+
+cleanall-other-dirs-nmake:
+ cd ..\lib
+ $(MAKE) $(MFLAGS) cleanall
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) cleanall
+ cd ..\src
+ $(MAKE) $(MFLAGS) cleanall
+ cd ..\nt
+
+cleanall-other-dirs-gmake:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib cleanall
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src cleanall
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src cleanall
+
+# We used to delete *~ here, but that might inadvertently remove
+# precious files if it happens to match their short 8+3 aliases.
+cleanall: clean cleanall-other-dirs-$(MAKETYPE)
+ - $(DEL_TREE) obj
+ - $(DEL_TREE) obj-spd
+ - $(DEL_TREE) oo
+ - $(DEL_TREE) oo-spd
+
+top-distclean:
+ - $(DEL) $(COMPILER_TEMP_FILES)
+ - $(DEL_TREE) obj
+ - $(DEL_TREE) obj-spd
+ - $(DEL_TREE) oo
+ - $(DEL_TREE) oo-spd
+ - $(DEL) stamp_BLD
+ - $(DEL) ../etc/DOC ../etc/DOC-X
+ - $(DEL) config.log Makefile
+ - $(DEL) ../README.W32
+
+distclean: distclean-other-dirs-$(MAKETYPE) top-distclean
+
+distclean-other-dirs-nmake:
+ cd ..\lib
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\src
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\leim
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\doc\emacs
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\misc
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\lispintro
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\lispref
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\..\nt
+
+distclean-other-dirs-gmake:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref distclean
+
+maintainer-clean: maintainer-clean-other-dirs-$(MAKETYPE) top-distclean
+
+maintainer-clean-other-dirs-nmake:
+ cd ..\lib
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\src
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\leim
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\doc\emacs
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\misc
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\lispintro
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\lispref
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\..\nt
+
+maintainer-clean-other-dirs-gmake:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref maintainer-clean
+
+realclean: cleanall
+ - $(DEL_TREE) ../bin
+
+TAGS: TAGS-$(MAKETYPE)
+
+frc:
+TAGS-gmake: frc
+ ../lib-src/$(BLD)/etags $(CURDIR)/*.c
+ $(MAKE) $(MFLAGS) -C ../src TAGS TAGS-LISP
+ $(MAKE) $(MFLAGS) -C ../lib-src TAGS
+ $(MAKE) $(MFLAGS) -C ../lib TAGS
+
+TAGS-nmake:
+ echo This target is not supported with NMake
+
+.PHONY: frc
diff --git a/nt/multi-install-info.bat b/nt/multi-install-info.bat
index e1eef98ba1c..0fff904c60e 100644
--- a/nt/multi-install-info.bat
+++ b/nt/multi-install-info.bat
@@ -3,8 +3,7 @@
rem Hack to run install-info with multiple info files on the command
rem line on the Windows platform.
-rem Copyright (C) 2003-2011
-rem Free Software Foundation, Inc.
+rem Copyright (C) 2003-2012 Free Software Foundation, Inc.
rem This file is part of GNU Emacs.
diff --git a/nt/nmake.defs b/nt/nmake.defs
index 4a7d93d40dd..2c6bc66b673 100644
--- a/nt/nmake.defs
+++ b/nt/nmake.defs
@@ -1,5 +1,5 @@
# -*- Makefile -*- definition file for building GNU Emacs on Windows NT.
-# Copyright (C) 2000-2011 Free Software Foundation, Inc.
+# Copyright (C) 2000-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -22,11 +22,13 @@ all:
THE_SHELL = $(COMSPEC)
SHELLTYPE=CMD
+SWITCHCHAR=/
MAKETYPE=nmake
CURDIR = $(MAKEDIR:\=/)
THISDIR = $(MAKEDIR)
+DIRNAME =
ALL_DEPS = $**
@@ -86,7 +88,11 @@ ARCH = alpha
! if "$(PROCESSOR_ARCHITECTURE)" == "PPC"
ARCH = ppc
! else
-! error Unknown architecture type "$(PROCESSOR_ARCHITECTURE)"
+! if "$(PROCESSOR_ARCHITECTURE)" == "AMD64"
+ARCH = AMD64
+! else
+! error Unknown architecture type "$(PROCESSOR_ARCHITECTURE)"
+! endif
! endif
! endif
! endif
@@ -105,13 +111,13 @@ CC = cl
CC_OUT = -Fo
LINK = link
LINK_OUT = -out:
-RC = rc
+RC = rc $(ARCH_RCFLAGS)
RC_OUT = -Fo
RC_INCLUDE = -i
USE_CRT_DLL = 1
-!ifdef USE_CRT_DLL
+!if USE_CRT_DLL
libc = msvcrt$(D).lib
EMACS_EXTRA_C_FLAGS= -D_DLL -D_MT -DUSE_CRT_DLL=1
!else
@@ -144,27 +150,23 @@ DEBUG_CFLAGS = -DEMACSDEBUG
DEBUG_CFLAGS =
!endif
-!ifdef ENABLECHECKS
-CHECKING_CFLAGS = -DENABLE_CHECKING -DXASSERTS
-!else
-CHECKING_CFLAGS =
-!endif
+MWINDOWS = -subsystem:windows -entry:mainCRTStartup
-CFLAGS = -I. $(ARCH_CFLAGS) \
- $(DEBUG_CFLAGS) $(CHECKING_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS)
-ESC_CFLAGS = -I. $(ARCH_CFLAGS) \
- $(DEBUG_CFLAGS) $(CHECKING_CFLAGS) $(ESC_USER_CFLAGS) $(LOCAL_FLAGS)
+CFLAGS = -I. $(ARCH_CFLAGS) -D_CRT_SECURE_NO_WARNINGS \
+ $(DEBUG_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS)
+ESC_CFLAGS = -I. $(ARCH_CFLAGS) -D_CRT_SECURE_NO_WARNINGS \
+ $(DEBUG_CFLAGS) $(ESC_USER_CFLAGS) $(LOCAL_FLAGS)
#SYS_LDFLAGS = -nologo -release -incremental:no -version:3.10 -swaprun:cd -swaprun:net setargv.obj
-!ifdef NOOPT
-SYS_LDFLAGS = -nologo -manifest -dynamicbase:no -debug -incremental:no -version:3.10 -swaprun:cd -swaprun:net setargv.obj
-!else
-SYS_LDFLAGS = -nologo -manifest -dynamicbase:no -release -incremental:no -version:3.10 -swaprun:cd -swaprun:net setargv.obj
-!endif
+SYS_LDFLAGS = -nologo -manifest -dynamicbase:no -incremental:no -version:3.10 -swaprun:cd -swaprun:net setargv.obj
# see comments in allocate_heap in w32heap.c before changing any of the
# -stack, -heap, or -base settings.
-TEMACS_EXTRA_LINK = -stack:0x00800000 -heap:0x00100000 -base:0x01000000 -pdb:$(BLD)\temacs.pdb -machine:$(ARCH) $(SUBSYSTEM_CONSOLE) -entry:_start -map:$(BLD)\temacs.map $(EXTRA_LINK)
+!if "$(ARCH)" == "i386"
+TEMACS_EXTRA_LINK = -stack:0x00800000 -heap:0x00100000 -base:0x01000000 -pdb:$(BLD)\temacs.pdb -machine:x86 $(SUBSYSTEM_CONSOLE) -entry:_start -map:$(BLD)\temacs.map $(EXTRA_LINK)
+!elseif "$(ARCH)" == "AMD64"
+TEMACS_EXTRA_LINK = -stack:0x00800000 -heap:0x00100000 -base:0x400000000 -pdb:$(BLD)\temacs.pdb -machine:x64 $(SUBSYSTEM_CONSOLE) -entry:_start -map:$(BLD)\temacs.map $(EXTRA_LINK)
+!endif
!ifdef NOOPT
OBJDIR = obj
@@ -181,7 +183,7 @@ COMPILER_TEMP_FILES = *.pdb
CP = cp -f
CP_DIR = cp -rf
-IFNOTSAMEDIR = if not exist ..\same-dir.tst
+IFNOTSAMEDIR = if not exist ..\$(DIRNAME)_same-dir.tst
ENDIF =
FOREACH = for %%f in (
FORVAR = %%f
@@ -203,6 +205,9 @@ DEBUG_LINK = -debug
D = d
!endif
+# gcc-specific pragma (ignore for MSVC)
+PRAGMA_SYSTEM_HEADER =
+
!if "$(ARCH)" == "i386"
!ifdef NOOPT
#ARCH_CFLAGS = -nologo -c -Zel -W2 -H63 -Od -G3d -Zp8 $(DEBUG_FLAG)
@@ -212,11 +217,17 @@ ARCH_CFLAGS = -nologo -D_X86_=1 -c -Zl -Zp8 -W2 -Od -Gd $(DEBUG_FLAG)
ARCH_CFLAGS = -nologo -D_X86_=1 -c -Zl -Zp8 -W2 -Oi -Ot -Oy- -Ob2 -GF -Gy -Gd $(DEBUG_FLAG)
!endif
ARCH_LDFLAGS = $(SYS_LDFLAGS)
+EMACS_HEAPSIZE = 27
+EMACS_PURESIZE = 5000000
+EMACS_MANIFEST = emacs-x86.manifest
!else
!if "$(ARCH)" == "mips"
ARCH_CFLAGS = -D_MIPS_=1 -c -W2 -Zi -Od -Gt0
ARCH_LDFLAGS = $(SYS_LDFLAGS)
+EMACS_HEAPSIZE = 27
+EMACS_PURESIZE = 5000000
+EMACS_MANIFEST = emacs-mips.manifest
!else
!if "$(ARCH)" == "alpha"
@@ -226,12 +237,30 @@ ARCH_CFLAGS = -D_ALPHA_=1 -c -Ze -Zi -W2 -Od -D__stdcall= -D__cdecl=
ARCH_CFLAGS = -D_ALPHA_=1 -c -Ze -Zi -W2 -O1 -D__stdcall= -D__cdecl=
!endif
ARCH_LDFLAGS = $(SYS_LDFLAGS)
+EMACS_HEAPSIZE = 27
+EMACS_PURESIZE = 5000000
+EMACS_MANIFEST = emacs-alpha.manifest
!else
!if "$(ARCH)" == "ppc"
# These flags are a guess...if they don't work, please send me mail.
-ARCH_CFLAGS = -D_PPC_=1 -c -Ze -Zi -W2 -Od
ARCH_LDFLAGS = $(SYS_LDFLAGS)
+EMACS_HEAPSIZE = 27
+EMACS_PURESIZE = 5000000
+EMACS_MANIFEST = emacs-ppc.manifest
+
+!else
+!if "$(ARCH)" == "AMD64"
+!ifdef NOOPT
+ARCH_CFLAGS = -nologo -D_AMD64_=1 -DWIN64 -D_WIN64 -DWIN32 -D_WIN32 -c -Zl -Zp8 -W2 -Od -Gd -Wp64 $(DEBUG_FLAG)
+!else
+ARCH_CFLAGS = -nologo -D_AMD64_=1 -DWIN64 -D_WIN64 -DWIN32 -D_WIN32 -c -Zl -Zp8 -W2 -O2x -GF -Gy -Gd $(DEBUG_FLAG)
+!endif
+ARCH_LDFLAGS = $(SYS_LDFLAGS) -machine:x64
+ARCH_RCFLAGS = -DWIN64
+EMACS_HEAPSIZE = 42
+EMACS_PURESIZE = 10000000
+EMACS_MANIFEST = emacs-x64.manifest
!else
!ERROR Unknown architecture type "$(ARCH)".
@@ -239,6 +268,7 @@ ARCH_LDFLAGS = $(SYS_LDFLAGS)
!endif
!endif
!endif
+!endif
LINK_FLAGS = $(ARCH_LDFLAGS) $(DEBUG_LINK) $(USER_LDFLAGS)
@@ -262,4 +292,3 @@ EXTRA_LINK = -profile
.c{$(BLD)}.obj::
$(CC) $(CFLAGS) -Fo$(BLD)\ $<
!ENDIF
-
diff --git a/nt/paths.h b/nt/paths.h
index 21c039c8d0d..801d187646f 100644
--- a/nt/paths.h
+++ b/nt/paths.h
@@ -1,6 +1,6 @@
/* paths.h file for MS Windows
-Copyright (C) 1993, 1995, 1997, 1999, 2001-2011
+Copyright (C) 1993, 1995, 1997, 1999, 2001-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -18,11 +18,18 @@ 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/>. */
+/* Relative file names in this file that begin with "%emacs_dir%/" are
+ treated specially by decode_env_path: they are expanded relative to
+ the value of the emacs_dir environment variable, which points to
+ the root of the Emacs tree. */
/* The default search path for Lisp function "load".
- This sets load-path. */
+ Together with PATH_SITELOADSEARCH, this sets load-path. */
/* #define PATH_LOADSEARCH "/usr/local/lib/emacs/lisp" */
-#define PATH_LOADSEARCH "C:/emacs/lisp"
+#define PATH_LOADSEARCH "%emacs_dir%/lisp;%emacs_dir%/leim"
+
+/* Like PATH_LOADSEARCH, but contains the non-standard pieces. */
+#define PATH_SITELOADSEARCH "%emacs_dir%/site-lisp;%emacs_dir%/../site-lisp"
/* Like PATH_LOADSEARCH, but used only when Emacs is dumping. This
path is usually identical to PATH_LOADSEARCH except that the entry
@@ -36,13 +43,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
variable exec-directory. exec-directory is used for finding
executables and other architecture-dependent files. */
/* #define PATH_EXEC "/usr/local/lib/emacs/etc" */
-#define PATH_EXEC "C:/emacs/bin"
+#define PATH_EXEC "%emacs_dir%/bin;%emacs_dir%/lib-src/oo-spd/i386;%emacs_dir%/lib-src/oo/i386"
/* Where Emacs should look for its architecture-independent data
files, like the NEWS file. The lisp variable data-directory
is set to this value. */
/* #define PATH_DATA "/usr/local/lib/emacs/data" */
-#define PATH_DATA "C:/emacs/data"
+#define PATH_DATA "%emacs_dir%/etc"
/* Where Emacs should look for X bitmap files.
The lisp variable x-bitmap-file-path is set based on this value. */
@@ -50,11 +57,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Where Emacs should look for its docstring file. The lisp variable
doc-directory is set to this value. */
-#define PATH_DOC "C:/emacs/etc"
+#define PATH_DOC "%emacs_dir%/etc"
/* Where the configuration process believes the info tree lives. The
lisp variable configure-info-directory gets its value from this
macro, and is then used to set the Info-default-directory-list. */
/* #define PATH_INFO "/usr/local/info" */
#define PATH_INFO "C:/emacs/info"
-
diff --git a/nt/preprep.c b/nt/preprep.c
index 7541536714c..6976567e038 100644
--- a/nt/preprep.c
+++ b/nt/preprep.c
@@ -1,5 +1,5 @@
/* Pre-process emacs.exe for profiling by MSVC.
- Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -36,9 +36,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
PIMAGE_NT_HEADERS
(__stdcall * pfnCheckSumMappedFile) (LPVOID BaseAddress,
- DWORD FileLength,
- LPDWORD HeaderSum,
- LPDWORD CheckSum);
+ DWORD_PTR FileLength,
+ PDWORD_PTR HeaderSum,
+ PDWORD_PTR CheckSum);
#undef min
#undef max
@@ -196,7 +196,7 @@ find_section (const char *name, IMAGE_NT_HEADERS *nt_header)
/* Return pointer to section header for section containing the given
relative virtual address. */
IMAGE_SECTION_HEADER *
-rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header)
+rva_to_section (DWORD_PTR rva, IMAGE_NT_HEADERS * nt_header)
{
PIMAGE_SECTION_HEADER section;
int i;
@@ -211,7 +211,7 @@ rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header)
some very old exes (eg. gzip dated Dec 1993). Since
w32_executable_type relies on this function to work reliably,
we need to cope with this. */
- DWORD real_size = max (section->SizeOfRawData,
+ DWORD_PTR real_size = max (section->SizeOfRawData,
section->Misc.VirtualSize);
if (rva >= section->VirtualAddress
&& rva < section->VirtualAddress + real_size)
@@ -224,7 +224,7 @@ rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header)
/* Return pointer to section header for section containing the given
offset in its raw data area. */
IMAGE_SECTION_HEADER *
-offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header)
+offset_to_section (DWORD_PTR offset, IMAGE_NT_HEADERS * nt_header)
{
PIMAGE_SECTION_HEADER section;
int i;
@@ -244,8 +244,8 @@ offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header)
/* Return offset to an object in dst, given offset in src. We assume
there is at least one section in both src and dst images, and that
the some sections may have been added to dst (after sections in src). */
-static DWORD
-relocate_offset (DWORD offset,
+static DWORD_PTR
+relocate_offset (DWORD_PTR offset,
IMAGE_NT_HEADERS * src_nt_header,
IMAGE_NT_HEADERS * dst_nt_header)
{
@@ -279,28 +279,29 @@ relocate_offset (DWORD offset,
}
#define OFFSET_TO_RVA(offset, section) \
- (section->VirtualAddress + ((DWORD)(offset) - section->PointerToRawData))
+ ((section)->VirtualAddress + ((DWORD_PTR)(offset) - (section)->PointerToRawData))
#define RVA_TO_OFFSET(rva, section) \
- (section->PointerToRawData + ((DWORD)(rva) - section->VirtualAddress))
+ ((section)->PointerToRawData + ((DWORD_PTR)(rva) - (section)->VirtualAddress))
#define RVA_TO_SECTION_OFFSET(rva, section) \
- ((DWORD)(rva) - section->VirtualAddress)
+ ((DWORD_PTR)(rva) - (section)->VirtualAddress)
#define RVA_TO_PTR(var,section,filedata) \
- ((void *)(RVA_TO_OFFSET(var,section) + (filedata)->file_base))
+ ((void *)((unsigned char *)(RVA_TO_OFFSET(var,section) + (filedata)->file_base)))
/* Convert address in executing image to RVA. */
-#define PTR_TO_RVA(ptr) ((DWORD)(ptr) - (DWORD) GetModuleHandle (NULL))
+#define PTR_TO_RVA(ptr) ((DWORD_PTR)(ptr) - (DWORD_PTR) GetModuleHandle (NULL))
#define PTR_TO_OFFSET(ptr, pfile_data) \
((unsigned const char *)(ptr) - (pfile_data)->file_base)
#define OFFSET_TO_PTR(offset, pfile_data) \
- ((pfile_data)->file_base + (DWORD)(offset))
+ ((pfile_data)->file_base + (DWORD_PTR)(offset))
-#define ROUND_UP(p, align) (((DWORD)(p) + (align)-1) & ~((align)-1))
-#define ROUND_DOWN(p, align) ((DWORD)(p) & ~((align)-1))
+#define ROUND_UP(p, align) \
+ (((DWORD_PTR)(p) + (align)-1) & ~((DWORD_PTR)(align)-1))
+#define ROUND_DOWN(p, align) ((DWORD_PTR)(p) & ~((DWORD_PTR)(align)-1))
/* The MSVC prep program generates a ._xe file from .exe, where relevant
@@ -353,9 +354,9 @@ copy_executable_and_move_sections (file_data *p_infile,
PIMAGE_SECTION_HEADER reloc_section;
PIMAGE_DATA_DIRECTORY import_dir;
PIMAGE_DATA_DIRECTORY reloc_dir;
- DWORD import_delta_rva;
- DWORD reloc_delta_rva;
- DWORD offset;
+ DWORD_PTR import_delta_rva;
+ DWORD_PTR reloc_delta_rva;
+ DWORD_PTR offset;
int i;
#define COPY_CHUNK(message, src, size) \
@@ -388,7 +389,7 @@ copy_executable_and_move_sections (file_data *p_infile,
Note that dst is updated implicitly by each COPY_CHUNK. */
dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base;
- nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) +
+ nt_header = (PIMAGE_NT_HEADERS) (((unsigned char *) dos_header) +
dos_header->e_lfanew);
section = IMAGE_FIRST_SECTION (nt_header);
@@ -406,10 +407,10 @@ copy_executable_and_move_sections (file_data *p_infile,
dst = (unsigned char *) p_outfile->file_base;
COPY_CHUNK ("Copying DOS header...", dos_header,
- (DWORD) nt_header - (DWORD) dos_header);
+ (DWORD_PTR) nt_header - (DWORD_PTR) dos_header);
dst_nt_header = (PIMAGE_NT_HEADERS) dst;
COPY_CHUNK ("Copying NT header...", nt_header,
- (DWORD) section - (DWORD) nt_header);
+ (DWORD_PTR) section - (DWORD_PTR) nt_header);
dst_section = (PIMAGE_SECTION_HEADER) dst;
COPY_CHUNK ("Copying section table...", section,
nt_header->FileHeader.NumberOfSections * sizeof (*section));
@@ -537,7 +538,7 @@ copy_executable_and_move_sections (file_data *p_infile,
#define ADJUST_IMPORT_RVA(var) \
do { \
if ((var) != 0) \
- *((DWORD *)&(var)) += import_delta_rva; \
+ *((DWORD_PTR *)&(var)) += import_delta_rva; \
} while (0)
dst_nt_header->OptionalHeader.SizeOfInitializedData = 0;
@@ -627,10 +628,10 @@ copy_executable_and_move_sections (file_data *p_infile,
{
IMAGE_BASE_RELOCATION *relocs, *block, *start_block, *end_block;
- DWORD import_start = import_section->VirtualAddress + dst_nt_header->OptionalHeader.ImageBase;
- DWORD import_end = import_start + import_section->Misc.VirtualSize;
- DWORD len_import_relocs;
- DWORD len_remaining_relocs;
+ DWORD_PTR import_start = import_section->VirtualAddress + dst_nt_header->OptionalHeader.ImageBase;
+ DWORD_PTR import_end = import_start + import_section->Misc.VirtualSize;
+ DWORD_PTR len_import_relocs;
+ DWORD_PTR len_remaining_relocs;
int seen_high = 0;
WORD * high_word;
void * holder;
@@ -643,8 +644,8 @@ copy_executable_and_move_sections (file_data *p_infile,
any; the profiler needs to be able to patch RVAs in the import
section itself. */
for (block = relocs, start_block = 0;
- (DWORD) block - (DWORD) relocs < reloc_dir->Size;
- block = (void *)((DWORD) block + block->SizeOfBlock))
+ (DWORD_PTR) block - (DWORD_PTR) relocs < reloc_dir->Size;
+ block = (void *)((DWORD_PTR) block + block->SizeOfBlock))
{
if (block->VirtualAddress >= import_section->VirtualAddress + import_section->Misc.VirtualSize)
{
@@ -660,8 +661,8 @@ copy_executable_and_move_sections (file_data *p_infile,
}
if (start_block)
{
- len_import_relocs = (DWORD) end_block - (DWORD) start_block;
- len_remaining_relocs = (DWORD) relocs + reloc_dir->Size - (DWORD) end_block;
+ len_import_relocs = (DWORD_PTR) end_block - (DWORD_PTR) start_block;
+ len_remaining_relocs = (DWORD_PTR) relocs + reloc_dir->Size - (DWORD_PTR) end_block;
holder = malloc (len_import_relocs);
if (holder == 0)
abort ();
@@ -675,14 +676,14 @@ copy_executable_and_move_sections (file_data *p_infile,
to the old import section location, and patching them to
reference the new location. */
for (block = relocs;
- (DWORD) block - (DWORD) relocs < reloc_dir->Size;
- block = (void *)((DWORD) block + block->SizeOfBlock))
+ (DWORD_PTR) block - (DWORD_PTR) relocs < reloc_dir->Size;
+ block = (void *)((DWORD_PTR) block + block->SizeOfBlock))
{
- DWORD page_rva = block->VirtualAddress;
- DWORD page_offset;
+ DWORD_PTR page_rva = block->VirtualAddress;
+ DWORD_PTR page_offset;
union {
WORD word;
- DWORD dword;
+ DWORD_PTR dword;
} * ploc;
WORD *fixup;
@@ -692,7 +693,7 @@ copy_executable_and_move_sections (file_data *p_infile,
continue;
for (fixup = (WORD *) &block[1];
- (DWORD) fixup - (DWORD) block < block->SizeOfBlock;
+ (DWORD_PTR) fixup - (DWORD_PTR) block < block->SizeOfBlock;
fixup++)
{
page_offset = (*fixup) & 0xfff;
@@ -794,8 +795,8 @@ main (int argc, char **argv)
/* Patch up header fields; profiler is picky about this. */
{
HANDLE hImagehelp = LoadLibrary ("imagehlp.dll");
- DWORD headersum;
- DWORD checksum;
+ DWORD_PTR headersum;
+ DWORD_PTR checksum;
dos_header = (PIMAGE_DOS_HEADER) out_file.file_base;
nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew);
diff --git a/nt/runemacs.c b/nt/runemacs.c
index 2d2474c3592..dbb18bcd82c 100644
--- a/nt/runemacs.c
+++ b/nt/runemacs.c
@@ -1,6 +1,6 @@
/* runemacs --- Simple program to start Emacs with its console window hidden.
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/zipdist.bat b/nt/zipdist.bat
index b87353347ba..e196299b6d6 100644
--- a/nt/zipdist.bat
+++ b/nt/zipdist.bat
@@ -1,5 +1,5 @@
@echo off
-rem Copyright (C) 2001-2011 Free Software Foundation, Inc.
+rem Copyright (C) 2001-2012 Free Software Foundation, Inc.
rem Author: Christoph Scholtes cschol2112 at gmail.com
@@ -25,9 +25,8 @@ set EMACS_VER=%1
set TMP_DIST_DIR=emacs-%EMACS_VER%
rem Check, if 7zip is installed and available on path
-:ZIP_CHECK
-7z
-if %ERRORLEVEL% NEQ 0 goto :ZIP_ERROR
+7z 1>NUL 2>NUL
+if %ERRORLEVEL% NEQ 0 goto ZIP_ERROR
goto ZIP_DIST
:ZIP_ERROR
@@ -35,14 +34,10 @@ echo.
echo ERROR: Make sure 7zip is installed and available on the Windows Path!
goto EXIT
-rem Build distributions
+rem Build and verify the binary distribution
:ZIP_DIST
-rem Build and verify full distribution
7z a -bd -tZIP -mx=9 -x!.bzrignore -x!.gitignore -xr!emacs.mdp -xr!*.pdb -xr!*.opt -xr!*~ -xr!CVS -xr!.arch-inventory emacs-%EMACS_VER%-bin-i386.zip %TMP_DIST_DIR%
7z t emacs-%EMACS_VER%-bin-i386.zip
-rem Build and verify binary only distribution
-7z a -bd -tZIP -mx=9 -x!.bzrignore -x!.gitignore -xr!emacs.mdp -xr!*.pdb -xr!*.opt -xr!*~ -xr!CVS -xr!.arch-inventory emacs-%EMACS_VER%-barebin-i386.zip %TMP_DIST_DIR%/README.W32 %TMP_DIST_DIR%/bin %TMP_DIST_DIR%/etc/DOC-X %TMP_DIST_DIR%/COPYING
-7z t emacs-%EMACS_VER%-barebin-i386.zip
goto EXIT
:EXIT
diff --git a/oldXMenu/Activate.c b/oldXMenu/Activate.c
index 2f1c85aa1a2..d4683da87f2 100644
--- a/oldXMenu/Activate.c
+++ b/oldXMenu/Activate.c
@@ -3,7 +3,7 @@
#include "copyright.h"
/*
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
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
diff --git a/oldXMenu/ChangeLog b/oldXMenu/ChangeLog
index 5d04eea75d4..133b18b4e3f 100644
--- a/oldXMenu/ChangeLog
+++ b/oldXMenu/ChangeLog
@@ -1,3 +1,26 @@
+2012-10-06 Ulrich Müller <ulm@gentoo.org>
+
+ * Makefile.in (AR, ARFLAGS): Get values from configure.
+
+2012-06-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ * Makefile.in (ALL_CFLAGS): Add -I../lib -I${srcdir}/../lib.
+ This is needed for hosts that lack <alloca.h>, when Emacs is
+ configured --with-x-toolkit=no. Problem reported by Herbert
+ J. Skuhra for FreeBSD.
+
+2012-04-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ configure: new option --enable-gcc-warnings (Bug#11207)
+ * Makefile.in (C_WARNINGS_SWITCH): Remove.
+ (WARN_CFLAGS, WERROR_CFLAGS): New macros.
+ (ALL_CFLAGS): Use new macros rather than old.
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (C_SWITCH_X_SYSTEM): Remove.
+ (ALL_CFLAGS): Remove C_SWITCH_X_SYSTEM.
+
2011-04-16 Paul Eggert <eggert@cs.ucla.edu>
Static checks with GCC 4.6.0 and non-default toolkits.
@@ -593,7 +616,7 @@
* copyright.h: New file (copied from X11R4 distribution)
* All files: Replaced occurrences of #include <X11/copyright.h>
- with #include "copyright.h"
+ with #include "copyright.h".
1991-10-25 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -615,7 +638,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1993-1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/oldXMenu/Create.c b/oldXMenu/Create.c
index 25f1f1c3381..1d21e534300 100644
--- a/oldXMenu/Create.c
+++ b/oldXMenu/Create.c
@@ -3,7 +3,7 @@
#include "copyright.h"
/*
-Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
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
diff --git a/oldXMenu/FindSel.c b/oldXMenu/FindSel.c
index fbf235c463d..3c208cb3da5 100644
--- a/oldXMenu/FindSel.c
+++ b/oldXMenu/FindSel.c
@@ -3,7 +3,7 @@
#include "copyright.h"
/*
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
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
diff --git a/oldXMenu/Internal.c b/oldXMenu/Internal.c
index a779cda82f5..dc8dc0120ef 100644
--- a/oldXMenu/Internal.c
+++ b/oldXMenu/Internal.c
@@ -3,7 +3,7 @@
#include "copyright.h"
/*
-Copyright (C) 1993, 1996, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1993, 1996, 2001-2012 Free Software Foundation, Inc.
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
diff --git a/oldXMenu/Makefile.in b/oldXMenu/Makefile.in
index 51ee4cd207c..ee78325f0d7 100644
--- a/oldXMenu/Makefile.in
+++ b/oldXMenu/Makefile.in
@@ -1,4 +1,4 @@
-## Makefile for oldXMenu
+## Makefile for oldXMenu
## Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
@@ -15,7 +15,7 @@
## without express or implied warranty.
-## Copyright (C) 2001-2011 Free Software Foundation, Inc.
+## Copyright (C) 2001-2012 Free Software Foundation, Inc.
## 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
@@ -45,11 +45,11 @@
srcdir=@srcdir@
VPATH=@srcdir@
C_SWITCH_X_SITE=@C_SWITCH_X_SITE@
-C_SWITCH_X_SYSTEM=@C_SWITCH_X_SYSTEM@
C_SWITCH_SYSTEM=@C_SWITCH_SYSTEM@
C_SWITCH_MACHINE=@C_SWITCH_MACHINE@
-C_WARNINGS_SWITCH = @C_WARNINGS_SWITCH@
PROFILING_CFLAGS = @PROFILING_CFLAGS@
+WARN_CFLAGS = @WARN_CFLAGS@
+WERROR_CFLAGS = @WERROR_CFLAGS@
EXTRA=insque.o
CC=@CC@
@@ -57,8 +57,8 @@ CFLAGS=@CFLAGS@
TAGS = etags
RM = rm -f
RANLIB = @RANLIB@
-# Solaris 2.1 ar doesn't accept the 'l' option.
-AR = ar cq
+AR = @AR@
+ARFLAGS = @ARFLAGS@
OBJS = Activate.o \
AddPane.o \
@@ -88,17 +88,17 @@ OBJS = Activate.o \
all:: libXMenu11.a
ALL_CFLAGS=$(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \
- $(C_SWITCH_X_SITE) $(C_SWITCH_X_SYSTEM) \
- ${C_WARNINGS_SWITCH} ${PROFILING_CFLAGS} \
+ $(C_SWITCH_X_SITE) \
+ $(WARN_CFLAGS) $(WERROR_CFLAGS) ${PROFILING_CFLAGS} \
$(CPPFLAGS) $(CFLAGS) -DEMACS_BITMAP_FILES \
- -I../src -I${srcdir} -I${srcdir}/../src
+ -I../src -I../lib -I${srcdir} -I${srcdir}/../src -I${srcdir}/../lib
.c.o:
$(CC) -c ${ALL_CFLAGS} $<
libXMenu11.a: $(OBJS) $(EXTRA)
$(RM) $@
- $(AR) $@ $(OBJS) $(EXTRA)
+ $(AR) $(ARFLAGS) $@ $(OBJS) $(EXTRA)
$(RANLIB) $@
Activate.o: Activate.c XMenuInt.h XMenu.h X10.h
diff --git a/oldXMenu/insque.c b/oldXMenu/insque.c
index 90a8eec4e71..0e6904ea9bf 100644
--- a/oldXMenu/insque.c
+++ b/oldXMenu/insque.c
@@ -1,5 +1,5 @@
/*
-Copyright (C) 1993-1998, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1993-1998, 2001-2012 Free Software Foundation, Inc.
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
diff --git a/src/.gdbinit b/src/.gdbinit
index 2051475bea0..e1ee81e66b5 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -1,4 +1,4 @@
-# Copyright (C) 1992-1998, 2000-2011 Free Software Foundation, Inc.
+# Copyright (C) 1992-1998, 2000-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
@@ -17,10 +17,10 @@
# Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
# Boston, MA 02110-1301, USA.
-# Force loading of symbols, enough to give us gdb_valbits etc.
-set main
+# Force loading of symbols, enough to give us VALBITS etc.
+set $dummy = main + 8
# With some compilers, we need this to give us struct Lisp_Symbol etc.:
-set Fmake_symbol
+set $dummy = Fmake_symbol + 8
# Find lwlib source files too.
dir ../lwlib
@@ -43,23 +43,33 @@ handle SIGUSR2 noprint pass
# debugging.
handle SIGALRM ignore
-# $valmask and $tagmask are mask values set up by the xreload macro below.
-
# Use $bugfix so that the value isn't a constant.
# Using a constant runs into GDB bugs sometimes.
define xgetptr
- set $bugfix = $arg0
- set $ptr = (gdb_use_union ? (gdb_use_lsb ? $bugfix.u.val << gdb_gctypebits : $bugfix.u.val) : $bugfix & $valmask) | gdb_data_seg_bits
+ if (CHECK_LISP_OBJECT_TYPE)
+ set $bugfix = $arg0.i
+ else
+ set $bugfix = $arg0
+ end
+ set $ptr = ($bugfix & VALMASK) | DATA_SEG_BITS
end
define xgetint
- set $bugfix = $arg0
- set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix : $bugfix << gdb_gctypebits) >> gdb_gctypebits
+ if (CHECK_LISP_OBJECT_TYPE)
+ set $bugfix = $arg0.i
+ else
+ set $bugfix = $arg0
+ end
+ set $int = $bugfix << (USE_LSB_TAG ? 0 : INTTYPEBITS) >> INTTYPEBITS
end
define xgettype
- set $bugfix = $arg0
- set $type = gdb_use_union ? $bugfix.s.type : (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
+ if (CHECK_LISP_OBJECT_TYPE)
+ set $bugfix = $arg0.i
+ else
+ set $bugfix = $arg0
+ end
+ set $type = (enum Lisp_Type) (USE_LSB_TAG ? $bugfix & (1 << GCTYPEBITS) - 1 : $bugfix >> VALBITS)
end
# Set up something to print out s-expressions.
@@ -67,10 +77,7 @@ end
# from calling OutputDebugString, which causes GDB to display each
# character twice (yuk!).
define pr
- set $output_debug = print_output_debug_flag
- set print_output_debug_flag = 0
- set debug_print ($)
- set print_output_debug_flag = $output_debug
+ pp $
end
document pr
Print the emacs s-expression which is $.
@@ -82,7 +89,7 @@ define pp
set $tmp = $arg0
set $output_debug = print_output_debug_flag
set print_output_debug_flag = 0
- set safe_debug_print ($tmp)
+ call safe_debug_print ($tmp)
set print_output_debug_flag = $output_debug
end
document pp
@@ -90,28 +97,12 @@ Print the argument as an emacs s-expression
Works only when an inferior emacs is executing.
end
-# Print out s-expressions from tool bar
-define pp1
- set $tmp = $arg0
- set $output_debug = print_output_debug_flag
- set print_output_debug_flag = 0
- set safe_debug_print ($tmp)
- set print_output_debug_flag = $output_debug
-end
-document pp1
-Print the argument as an emacs s-expression.
-Works only when an inferior emacs is executing.
-For use on tool bar when debugging in Emacs
-where the variable name would not otherwise
-be recorded in the GUD buffer.
-end
-
# Print value of lisp variable
define pv
set $tmp = "$arg0"
set $output_debug = print_output_debug_flag
set print_output_debug_flag = 0
- set safe_debug_print ( find_symbol_value (intern ($tmp)))
+ call safe_debug_print (find_symbol_value (intern ($tmp)))
set print_output_debug_flag = $output_debug
end
document pv
@@ -119,21 +110,6 @@ Print the value of the lisp variable given as argument.
Works only when an inferior emacs is executing.
end
-# Print value of lisp variable
-define pv1
- set $tmp = "$arg0"
- set $output_debug = print_output_debug_flag
- set print_output_debug_flag = 0
- set safe_debug_print (find_symbol_value (intern ($tmp)))
- set print_output_debug_flag = $output_debug
-end
-document pv1
-Print the value of the lisp variable given as argument.
-Works only when an inferior emacs is executing.
-For use when debugging in Emacs where the variable
-name would not otherwise be recorded in the GUD buffer.
-end
-
# Print out current buffer point and boundaries
define ppt
set $b = current_buffer
@@ -288,8 +264,8 @@ define pitx
while ($i < $it->sp && $i < 4)
set $e = $it->stack[$i]
printf "stack[%d]: ", $i
- pitmethod $e->method
- printf "[%d]", $e->position.charpos
+ pitmethod $e.method
+ printf "[%d]", $e.position.charpos
printf "\n"
set $i = $i + 1
end
@@ -519,7 +495,8 @@ define pgx
end
xgettype ($g.object)
if ($type == Lisp_String)
- printf " str=%x[%d]", $g.object, $g.charpos
+ xgetptr $g.object
+ printf " str=0x%x[%d]", ((struct Lisp_String *)$ptr)->data, $g.charpos
else
printf " pos=%d", $g.charpos
end
@@ -674,15 +651,52 @@ If the first type printed is Lisp_Vector or Lisp_Misc,
a second line gives the more precise type.
end
+define pvectype
+ set $size = ((struct Lisp_Vector *) $arg0)->header.size
+ if ($size & PSEUDOVECTOR_FLAG)
+ output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
+ else
+ output PVEC_NORMAL_VECTOR
+ end
+ echo \n
+end
+document pvectype
+Print the subtype of vectorlike object.
+Takes one argument, a pointer to an object.
+end
+
define xvectype
xgetptr $
- set $size = ((struct Lisp_Vector *) $ptr)->header.size
- output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
- echo \n
+ pvectype $ptr
end
document xvectype
-Print the size or vector subtype of $.
-This command assumes that $ is a vector or pseudovector.
+Print the subtype of vectorlike object.
+This command assumes that $ is a Lisp_Object.
+end
+
+define pvecsize
+ set $size = ((struct Lisp_Vector *) $arg0)->header.size
+ if ($size & PSEUDOVECTOR_FLAG)
+ output ($size & PSEUDOVECTOR_SIZE_MASK)
+ echo \n
+ output (($size & PSEUDOVECTOR_REST_MASK) >> PSEUDOVECTOR_SIZE_BITS)
+ else
+ output ($size & ~ARRAY_MARK_FLAG)
+ end
+ echo \n
+end
+document pvecsize
+Print the size of vectorlike object.
+Takes one argument, a pointer to an object.
+end
+
+define xvecsize
+ xgetptr $
+ pvecsize $ptr
+end
+document xvecsize
+Print the size of $
+This command assumes that $ is a Lisp_Object.
end
define xmisctype
@@ -737,60 +751,6 @@ Print $ as a misc free-cell pointer.
This command assumes that $ is an Emacs Lisp Misc value.
end
-define xintfwd
- xgetptr $
- print (struct Lisp_Intfwd *) $ptr
-end
-document xintfwd
-Print $ as an integer forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xboolfwd
- xgetptr $
- print (struct Lisp_Boolfwd *) $ptr
-end
-document xboolfwd
-Print $ as a boolean forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xobjfwd
- xgetptr $
- print (struct Lisp_Objfwd *) $ptr
-end
-document xobjfwd
-Print $ as an object forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xbufobjfwd
- xgetptr $
- print (struct Lisp_Buffer_Objfwd *) $ptr
-end
-document xbufobjfwd
-Print $ as a buffer-local object forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xkbobjfwd
- xgetptr $
- print (struct Lisp_Kboard_Objfwd *) $ptr
-end
-document xkbobjfwd
-Print $ as a kboard-local object forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xbuflocal
- xgetptr $
- print (struct Lisp_Buffer_Local_Value *) $ptr
-end
-document xbuflocal
-Print $ as a buffer-local-value pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
define xsymbol
set $sym = $
xgetptr $sym
@@ -817,7 +777,7 @@ end
define xvector
xgetptr $
print (struct Lisp_Vector *) $ptr
- output ($->header.size > 50) ? 0 : ($->contents[0])@($->header.size & ~gdb_array_mark_flag)
+ output ($->header.size > 50) ? 0 : ($->contents[0])@($->header.size & ~ARRAY_MARK_FLAG)
echo \n
end
document xvector
@@ -926,7 +886,7 @@ end
define xboolvector
xgetptr $
print (struct Lisp_Bool_Vector *) $ptr
- output ($->header.size > 256) ? 0 : ($->data[0])@((($->header.size & ~gdb_array_mark_flag) + 7)/ 8)
+ output ($->size > 256) ? 0 : ($->data[0])@(($->size + BOOL_VECTOR_BITS_PER_CHAR - 1)/ BOOL_VECTOR_BITS_PER_CHAR)
echo \n
end
document xboolvector
@@ -1037,7 +997,7 @@ end
define xpr
xtype
- if $type == Lisp_Int
+ if $type == Lisp_Int0 || $type == Lisp_Int1
xint
end
if $type == Lisp_Symbol
@@ -1057,44 +1017,20 @@ define xpr
if $misc == Lisp_Misc_Free
xmiscfree
end
- if $misc == Lisp_Misc_Boolfwd
- xboolfwd
- end
if $misc == Lisp_Misc_Marker
xmarker
end
- if $misc == Lisp_Misc_Intfwd
- xintfwd
- end
- if $misc == Lisp_Misc_Boolfwd
- xboolfwd
- end
- if $misc == Lisp_Misc_Objfwd
- xobjfwd
- end
- if $misc == Lisp_Misc_Buffer_Objfwd
- xbufobjfwd
- end
- if $misc == Lisp_Misc_Buffer_Local_Value
- xbuflocal
- end
-# if $misc == Lisp_Misc_Some_Buffer_Local_Value
-# xvalue
-# end
if $misc == Lisp_Misc_Overlay
xoverlay
end
- if $misc == Lisp_Misc_Kboard_Objfwd
- xkbobjfwd
- end
# if $misc == Lisp_Misc_Save_Value
# xsavevalue
# end
end
if $type == Lisp_Vectorlike
set $size = ((struct Lisp_Vector *) $ptr)->header.size
- if ($size & PVEC_FLAG)
- set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
+ if ($size & PSEUDOVECTOR_FLAG)
+ set $vec = (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
if $vec == PVEC_NORMAL_VECTOR
xvector
end
@@ -1139,13 +1075,13 @@ end
define xprintstr
set $data = (char *) $arg0->data
- output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
+ output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~ARRAY_MARK_FLAG : $arg0->size_byte)
end
define xprintsym
xgetptr $arg0
set $sym = (struct Lisp_Symbol *) $ptr
- xgetptr $sym->xname
+ xgetptr $sym->name
set $sym_name = (struct Lisp_String *) $ptr
xprintstr $sym_name
end
@@ -1154,8 +1090,8 @@ document xprintsym
end
define xcoding
- set $tmp = (struct Lisp_Hash_Table *) ((Vcoding_system_hash_table & $valmask) | gdb_data_seg_bits)
- set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & $valmask) | gdb_data_seg_bits)
+ set $tmp = (struct Lisp_Hash_Table *) ((Vcoding_system_hash_table & VALMASK) | DATA_SEG_BITS)
+ set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & VALMASK) | DATA_SEG_BITS)
set $name = $tmp->contents[$arg0 * 2]
print $name
pr
@@ -1167,8 +1103,8 @@ document xcoding
end
define xcharset
- set $tmp = (struct Lisp_Hash_Table *) ((Vcharset_hash_table & $valmask) | gdb_data_seg_bits)
- set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & $valmask) | gdb_data_seg_bits)
+ set $tmp = (struct Lisp_Hash_Table *) ((Vcharset_hash_table & VALMASK) | DATA_SEG_BITS)
+ set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & VALMASK) | DATA_SEG_BITS)
p $tmp->contents[charset_table[$arg0].hash_index * 2]
pr
end
@@ -1219,17 +1155,21 @@ end
define xbacktrace
set $bt = backtrace_list
while $bt
- xgettype (*$bt->function)
+ xgettype ($bt->function)
if $type == Lisp_Symbol
- xprintsym (*$bt->function)
+ xprintsym ($bt->function)
printf " (0x%x)\n", $bt->args
else
- xgetptr *$bt->function
+ xgetptr $bt->function
printf "0x%x ", $ptr
if $type == Lisp_Vectorlike
- xgetptr (*$bt->function)
+ xgetptr ($bt->function)
set $size = ((struct Lisp_Vector *) $ptr)->header.size
- output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
+ if ($size & PSEUDOVECTOR_FLAG)
+ output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
+ else
+ output $size & ~ARRAY_MARK_FLAG
+ end
else
printf "Lisp type %d", $type
end
@@ -1247,7 +1187,7 @@ end
define xprintbytestr
set $data = (char *) $arg0->data
printf "Bytecode: "
- output/u ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
+ output/u ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~ARRAY_MARK_FLAG : $arg0->size_byte)
end
document xprintbytestr
Print a string of byte code.
@@ -1256,7 +1196,7 @@ end
define xwhichsymbols
set $output_debug = print_output_debug_flag
set print_output_debug_flag = 0
- set safe_debug_print (which_symbols ($arg0, $arg1))
+ call safe_debug_print (which_symbols ($arg0, $arg1))
set print_output_debug_flag = $output_debug
end
document xwhichsymbols
@@ -1291,19 +1231,6 @@ define hookpost-backtrace
end
end
-define xreload
- set $tagmask = (((long)1 << gdb_gctypebits) - 1)
- set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
-end
-document xreload
- When starting Emacs a second time in the same gdb session under
- FreeBSD 2.2.5, gdb 4.13, $valmask have lost
- their values. (The same happens on current (2000) versions of GNU/Linux
- with gdb 5.0.)
- This function reloads them.
-end
-xreload
-
# Flush display (X only)
define ff
set x_flush (0)
@@ -1314,39 +1241,15 @@ Works only when an inferior emacs is executing.
end
-define hook-run
- xreload
-end
-
-# Call xreload if a new Emacs executable is loaded.
-define hookpost-run
- xreload
-end
-
set print pretty on
set print sevenbit-strings
show environment DISPLAY
show environment TERM
-# People get bothered when they see messages about non-existent functions...
-xgetptr globals.f_Vsystem_type
-# $ptr is NULL in temacs
-if ($ptr != 0)
- set $tem = (struct Lisp_Symbol *) $ptr
- xgetptr $tem->xname
- set $tem = (struct Lisp_String *) $ptr
- set $tem = (char *) $tem->data
-
- # Don't let abort actually run, as it will make stdio stop working and
- # therefore the `pr' command above as well.
- if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
- # The windows-nt build replaces abort with its own function.
- break w32_abort
- else
- break abort
- end
-end
+# When debugging, it is handy to be able to "return" from
+# terminate_due_to_signal when an assertion failure is non-fatal.
+break terminate_due_to_signal
# x_error_quitter is defined only on X. But window-system is set up
# only at run time, during Emacs startup, so we need to defer setting
@@ -1357,7 +1260,7 @@ commands
silent
xgetptr globals.f_Vinitial_window_system
set $tem = (struct Lisp_Symbol *) $ptr
- xgetptr $tem->xname
+ xgetptr $tem->name
set $tem = (struct Lisp_String *) $ptr
set $tem = (char *) $tem->data
# If we are running in synchronous mode, we want a chance to look
diff --git a/src/.gitignore b/src/.gitignore
index 070a38fea54..ebacd571ddd 100644
--- a/src/.gitignore
+++ b/src/.gitignore
@@ -2,6 +2,7 @@ buildobj.h
config.h
epaths.h
stamp_BLD
+stamp-h.in
oo/
oo-spd/
diff --git a/src/ChangeLog b/src/ChangeLog
index 2c3644f14fa..859b3a7d254 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11241 @@
+2012-11-24 Ken Brown <kbrown@cornell.edu>
+
+ * keyboard.c (HAVE_MOUSE):
+ * frame.c (HAVE_MOUSE): Remove, and rewrite code as if HAVE_MOUSE
+ were always defined.
+
+2012-11-24 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (set_cursor_from_row): Skip step 2 only if point is not
+ between bpos_covered and bpos_max. This fixes cursor display when
+ several display strings follow each other.
+
+ * .gdbinit (pgx): If the glyph's object is a string, display the
+ pointer to string data, rather than the value of the string object
+ itself (which barfs under CHECK_LISP_OBJECT_TYPE).
+
+ * indent.c (Fvertical_motion): If the starting position is covered
+ by a display string, return to one position before that, to avoid
+ overshooting it inside move_it_to. (Bug#12930)
+
+2012-11-23 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * frame.h (struct frame): Remove display_preempted member
+ since all users are dead long ago.
+ * nsterm.h (struct x_output): Use the only dummy member.
+ * w32menu.c (pending_menu_activation): Remove since not
+ really used.
+ (set_frame_menubar): Adjust user.
+ * w32term.h (struct x_output): Drop outdated #if 0 code.
+ (struct w32_output): Use bitfields for explicit_parent,
+ asked_for_visible and menubar_active members. Drop
+ unused pending_menu_activation member.
+ * xterm.h (struct x_output): Drop outdated #if 0 code.
+ Use bitfields for explicit_parent, asked_for_visible,
+ has_been_visible and net_wm_state_hidden_seen members.
+
+2012-11-23 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (globals.h, gl-stamp): Use $(SWITCHCHAR) instead
+ of a literal "/". (Bug#12955)
+ (gl-stamp): Invoke fc.exe directly, not through cmd.
+
+2012-11-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958).
+ * dired.c: Assume HAVE_DIRENT_H.
+ (NAMLEN): Remove, replacing with ...
+ (dirent_namelen): New function. All uses changed. Use the GNU macro
+ _D_EXACT_NAMELEN if available, as it's faster than strlen.
+ (DIRENTRY): Remove, replacing all uses with 'struct dirent'.
+ (DIRENTRY_NONEMPTY): Remove. All callers now assume it's nonzero.
+ * makefile.w32-in (DIR_H): Remove. All uses replaced with
+ $(NT_INC)/dirent.h.
+ ($(BLD)/w32.$(O)): Do not depend on $(SRC)/ndir.h.
+ * ndir.h: Rename to ../nt/inc/dirent.h.
+ * sysdep.h (closedir) [!HAVE_CLOSEDIR]: Remove.
+ Do not include <dirent.h>; no longer needed.
+ * w32.c: Include <dirent.h> rather than "ndir.h".
+
+2012-11-23 Chong Yidong <cyd@gnu.org>
+
+ * xftfont.c (xftfont_open): Remove duplicate assignment.
+
+2012-11-22 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (Fgarbage_collect): Unblock input after clearing
+ gc_in_progress to avoid note_mouse_highlight glitch with GC.
+ * frame.h (FRAME_MOUSE_UPDATE): New macro.
+ * msdos.c (IT_frame_up_to_date): Use it here...
+ * w32term.c (w32_frame_up_to_date): ...here...
+ * xterm.c (XTframe_up_to_date): ...and here...
+ * nsterm.m (ns_frame_up_to_date): ...but not here.
+ * lisp.h (Mouse_HLInfo): Remove mouse_face_deferred_gc member.
+ Adjust users.
+ * xdisp.c (message2_nolog, message3_nolog, note_mouse_highlight):
+ Do not check whether GC is in progress.
+
+2012-11-22 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * xdisp.c (window_buffer_changed): New function.
+ (update_menu_bar, update_tool_bar): Use it to
+ simplify large 'if' statements.
+ (redisplay_internal): Generalize commonly used
+ 'tail' and 'frame' local variables.
+
+2012-11-22 Eli Zaretskii <eliz@gnu.org>
+
+ * w32.c (getcwd): Fix the 2nd argument type, to prevent conflicts
+ with Windows system header.
+
+2012-11-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945).
+ * alloc.c: Assume unistd.h exists.
+ * fileio.c (Fexpand_file_name) [DOS_NT]: Use getcwd, not getwd.
+ * sysdep.c (get_current_dir_name): Assume getcwd exists.
+ (getwd) [USG]: Remove; no longer needed.
+ (sys_subshell) [DOS_NT]: Use getcwd, not getwd.
+ * w32.c (getcwd): Rename from getwd, and switch to getcwd's API.
+ * w32.h (getcwd): Remove decl.
+
+2012-11-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * xdisp.c (fast_set_selected_frame): Rename from update_tool_bar_unwind.
+ Make it set selected_window as well.
+ (update_tool_bar): Use it.
+
+2012-11-21 Ken Brown <kbrown@cornell.edu>
+
+ * emacs.c (main): Set the G_SLICE environment variable for all
+ Cygwin builds, not just GTK builds. See
+ https://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00368.html.
+
+2012-11-21 Eli Zaretskii <eliz@gnu.org>
+
+ * w32.c (FILE_DEVICE_FILE_SYSTEM, METHOD_BUFFERED)
+ (FILE_ANY_ACCESS, CTL_CODE, FSCTL_GET_REPARSE_POINT) [_MSC_VER]:
+ Define for the MSVC compiler.
+
+ * w32term.h (EnumSystemLocalesW) [_MSC_VER]: Add a missing semi-colon.
+
+ * fileio.c (Fsubstitute_in_file_name, Ffile_name_directory)
+ (Fexpand_file_name) [DOS_NT]: Pass encoded file name to
+ dostounix_filename. Prevents crashes down the road, because
+ dostounix_filename assumes it gets a unibyte string. Reported by
+ Michel de Ruiter <michel@sentient.nl>, see
+ http://lists.gnu.org/archive/html/help-emacs-windows/2012-11/msg00017.html
+
+2012-11-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Conflate Qnil and Qunbound for `symbol-function'.
+ * alloc.c (Fmake_symbol): Initialize `function' to Qnil.
+ * lread.c (init_obarray): Set `function' fields to Qnil.
+ * eval.c (Fcommandp): Ignore Qunbound.
+ (Fautoload, eval_sub, Fapply, Ffuncall, Fmacroexpand):
+ * data.c (Ffset, Ffboundp, indirect_function, Findirect_function):
+ Test NILP rather than Qunbound.
+ (Ffmakunbound): Set to Qnil.
+ (Fsymbol_function): Never signal an error.
+ (Finteractive_form): Ignore Qunbound.
+
+2012-11-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ * eval.c (interactive_p): Remove no-longer-used decl.
+
+2012-11-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * xdisp.c (buffer_shared): Adjust comment.
+ (buffer_shared_and_changed): New function.
+ (prepare_menu_bars, redisplay_internal): Use it to
+ decide whether all windows or frames should be updated.
+ (window_outdated): New function.
+ (text_outside_line_unchanged_p, redisplay_window): Use it.
+ (redisplay_internal): Likewise. Fix indentation.
+
+2012-11-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Finteractive_p, Fcalled_interactively_p, interactive_p): Remove.
+ (syms_of_eval): Remove corresponding defsubr.
+ * bytecode.c (exec_byte_code): `interactive-p' is now a Lisp function.
+
+2012-11-19 Daniel Colascione <dancol@dancol.org>
+
+ * w32fns.c (Fx_file_dialog):
+ (Fx_file_dialog): Accomodate rename of cygwin_convert_path* to
+ cygwin_convert_file_name*.
+
+ * cygw32.c (Fcygwin_convert_path_to_windows, syms_of_cygw32):
+ Rename cygwin_convert_path* to cygwin_convert_file_name*.
+
+2012-11-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * nsterm.m (ns_select): Send SIGIO only to self, not to process group.
+
+2012-11-18 Eli Zaretskii <eliz@gnu.org>
+
+ * w32select.c: Include w32common.h before w32term.h, so that
+ windows.h gets included before w32term.h uses some of its
+ features, see below.
+
+ * w32term.h (LOCALE_ENUMPROCA, LOCALE_ENUMPROCW) [_MSC_VER]:
+ New typedefs.
+ (EnumSystemLocalesA, EnumSystemLocalesW) [_MSC_VER]:
+ New prototypes.
+ (EnumSystemLocales) [_MSC_VER]: Define if undefined. (Bug#12878)
+
+2012-11-18 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (hold_event): Set send_appdefined to YES (Bug#12834).
+ (ns_select): Return at once if events are held (Bug#12834).
+
+2012-11-18 enami tsugutomo <tsugutomo.enami@jp.sony.com>
+
+ * unexelf.c (ELFSIZE) [__NetBSD__ && _LP64]: Set to 64.
+ Needed following 2012-10-20 change. (Bug#12902)
+
+2012-11-18 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32proc.c (waitpid): Remove unused label get_result.
+
+2012-11-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (SYSWAIT_H): New macro.
+ ($(BLD)/callproc.$(O), $(BLD)/w32proc.$(O), $(BLD)/process.$(O))
+ ($(BLD)/sysdep.$(O)): Update dependencies.
+
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881).
+ * callproc.c (relocate_fd): Assume F_DUPFD.
+ * emacs.c, term.c (O_RDWR): Remove.
+ * keyboard.c (tty_read_avail_input): Use O_NONBLOCK rather than
+ O_NDELAY, since O_NONBLOCK is the standard name for this flag.
+ * nsterm.m: Assume <fcntl.h> exists.
+ * process.c (NON_BLOCKING_CONNECT, allocate_pty, create_process)
+ (create_pty, Fmake_network_process, server_accept_connection)
+ (wait_reading_process_output, init_process_emacs):
+ Assume O_NONBLOCK.
+ (wait_reading_process_output): Put in a special case for WINDOWSNT
+ to mimick the older behavior where it had O_NDELAY but not O_NONBLOCK.
+ It's not clear this is needed, but it's a more-conservative change.
+ (create_process): Assume FD_CLOEXEC.
+ (create_process, create_pty): Assume O_NOCTTY.
+ * sysdep.c (init_sys_modes, reset_sys_modes): Assume F_SETFL.
+ (reset_sys_modes): Use O_NONBLOCK rather than O_NDELAY.
+ Omit if not DOS_NT, since F_GETFL is not defined there.
+ (serial_open): Assume O_NONBLOCK and O_NOCTTY.
+ * term.c: Include <fcntl.h>, for flags like O_NOCTTY.
+ (O_NOCTTY): Remove.
+ (init_tty): Assume O_IGNORE_CTTY is defined to 0 on platforms that
+ lack it, since gnulib guarantees this.
+ * w32.c (fcntl): Test for O_NONBLOCK rather than O_NDELAY.
+
+2012-11-17 Eli Zaretskii <eliz@gnu.org>
+
+ * w32.c (faccessat): Pretend that directories have the execute bit
+ set. Emacs expects that, e.g., in files.el:cd-absolute.
+
+ * w32proc.c (create_child): Don't clip the PID of the child
+ process to fit into an Emacs integer, as this is no longer a
+ restriction.
+ (waitpid): Rename from sys_wait. Emulate a Posix 'waitpid' by
+ reaping only the process specified by PID argument, if that is
+ positive. Use PID instead of dead_child to know which process to
+ reap. Wait for the child to die only if WNOHANG is not in
+ OPTIONS.
+ (sys_select): Don't set dead_child.
+
+ * sysdep.c (wait_for_termination_1): Remove the WINDOWSNT portion,
+ as it is no longer needed.
+
+ * process.c (waitpid, WUNTRACED) [!WNOHANG]: Remove definitions,
+ no longer needed.
+ (record_child_status_change): Remove the setting of
+ record_at_most_one_child for the !WNOHANG case.
+
+2012-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix problems in ns port found by static checking.
+ * nsterm.m: Include <pthread.h>, for pthread_mutex_lock etc.
+ (hold_event, setPosition:portion:whole:): Send SIGIO only to self,
+ not to process group.
+ (ns_select): Use emacs_write, not write, as that's more robust
+ in the presence of signals.
+ (fd_handler:): Check for read errors.
+
+2012-11-16 Glenn Morris <rgm@gnu.org>
+
+ * editfns.c (Fmessage): Mention message-log-max. (Bug#12849)
+
+2012-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Finteractive_p): Revert lexbind-merge mishap.
+
+2012-11-16 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (timer_loop): Make sure SuspendThread and ResumeThread
+ use the same value of thread handle.
+ (start_timer_thread): If the timer thread exited (due to error),
+ clean up by closing the two handles it used. Duplicate the caller
+ thread's handle here, so it gets duplicated only once, when
+ launching the timer thread. Set priority of the timer thread, not
+ the caller thread.
+ (getitimer): Don't duplicate the caller thread's handle here.
+ (Bug#12832)
+
+2012-11-16 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (hold_event): Send SIGIO to make sure ns_read_socket is
+ called (Bug#12834).
+
+2012-11-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove no-longer-used pty_max_bytes variable.
+ * process.c (pty_max_bytes): Remove; unused.
+ (send_process): Do not set it.
+
+2012-11-15 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/dispnew.$(O), $(BLD)/emacs.$(O)):
+ Update dependencies.
+
+2012-11-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ * eval.c (mark_backtrace) [BYTE_MARK_STACK]: Remove stray '*'.
+ This follows up on the 2012-09-29 patch that removed indirection
+ for the 'function' field. Reported by Sergey Vinokurov in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00263.html>.
+
+2012-11-14 Eli Zaretskii <eliz@gnu.org>
+
+ * w32.c (faccessat): Rename from sys_faccessat. (No need to use a
+ different name, as the MS runtime does not have such a function,
+ and probably never will.) All callers changed. Ignore DIRFD
+ value if PATH is an absolute file name, to match Posix spec
+ better. If AT_SYMLINK_NOFOLLOW is set in FLAGS, don't resolve
+ symlinks.
+
+2012-11-14 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * xdisp.c (echo_area_display, redisplay_internal):
+ Omit redundant check whether frame_garbaged is set.
+
+2012-11-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use faccessat, not access, when checking file permissions (Bug#12632).
+ This fixes a bug that has been present in Emacs since its creation.
+ It was reported by Chris Torek in 1983 even before GNU Emacs existed,
+ which must set some sort of record. (Torek's bug report was against
+ a predecessor of GNU Emacs, but GNU Emacs happened to have the
+ same common flaw.) See Torek's Usenet posting
+ "setuid/setgid programs & Emacs" Article-I.D.: sri-arpa.858
+ Posted: Fri Apr 8 14:18:56 1983.
+ * Makefile.in (LIB_EACCESS): New macro.
+ (LIBES): Use it.
+ * callproc.c (init_callproc):
+ * charset.c (init_charset):
+ * fileio.c (check_existing, check_executable, check_writable)
+ (Ffile_readable_p):
+ * lread.c (openp, load_path_check):
+ * process.c (allocate_pty):
+ * xrdb.c (file_p):
+ Use effective UID when checking permissions, not real UID.
+ * callproc.c (init_callproc):
+ * charset.c (init_charset):
+ * lread.c (load_path_check, init_lread):
+ Test whether directories are accessible, not merely whether they exist.
+ * conf_post.h (GNULIB_SUPPORT_ONLY_AT_FDCWD): New macro.
+ * fileio.c (check_existing, check_executable, check_writable)
+ (Ffile_readable_p):
+ Use symbolic names instead of integers for the flags, as they're
+ portable now.
+ (check_writable): New arg AMODE. All uses changed.
+ Set errno on failure.
+ (Ffile_readable_p): Use faccessat, not stat + open + close.
+ (Ffile_writable_p): No need to call check_existing + check_writable.
+ Just call check_writable and then look at errno. This saves a syscall.
+ dir should never be nil; replace an unnecessary runtime check
+ with an eassert. When checking the parent directory of a nonexistent
+ file, check that the directory is searchable as well as writable, as
+ we can't create files in unsearchable directories.
+ (file_directory_p): New function, which uses 'stat' on most platforms
+ but faccessat with D_OK (for efficiency) if WINDOWSNT.
+ (Ffile_directory_p, Fset_file_times): Use it.
+ (file_accessible_directory_p): New function, which uses a single
+ syscall for efficiency.
+ (Ffile_accessible_directory_p): Use it.
+ * xrdb.c (file_p): Use file_directory_p.
+ * lisp.h (file_directory_p, file_accessible_directory_p): New decls.
+ * lread.c (openp): When opening a file, use fstat rather than
+ stat, as that avoids a permissions race. When not opening a file,
+ use file_directory_p rather than stat.
+ (dir_warning): First arg is now a usage string, not a format.
+ Use errno. All uses changed.
+ * nsterm.m (ns_term_init): Remove unnecessary call to file-readable
+ that merely introduced a race.
+ * process.c, sysdep.c, term.c: All uses of '#ifdef O_NONBLOCK'
+ changed to '#if O_NONBLOCK', to accommodate gnulib O_* style,
+ and similarly for the other O_* flags.
+ * w32.c (sys_faccessat): Rename from sys_access and switch to
+ faccessat's API. All uses changed.
+ * xrdb.c: Do not include <sys/stat.h>; no longer needed.
+ (magic_db): Rename from magic_file_p.
+ (magic_db, search_magic_path): Return an XrmDatabase rather than a
+ char *, so that we don't have to test for file existence
+ separately from opening the file for reading. This removes a race
+ fixes a permission-checking problem, and simplifies the code.
+ All uses changed.
+ (file_p): Remove; no longer needed.
+
+2012-11-13 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Omit glyphs initialization at startup.
+ * dispnew.c (glyphs_initialized_initially_p): Remove.
+ (adjust_frame_glyphs_initially): Likewise. Adjust users.
+ (Fredraw_frame): Move actual code from here...
+ (redraw_frame): ...to here. Add eassert. Adjust comment.
+ (Fredraw_display): Use redraw_frame.
+ * xdisp.c (clear_garbaged_frames): Likewise.
+
+2012-11-13 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (decode_mode_spec): Limit the value of WIDTH argument
+ passed to pint2str and pint2hrstr to be at most the size of the
+ frame's decode_mode_spec_buffer. This avoids crashes with very
+ large values of FIELD_WIDTH argument to decode_mode_spec.
+ (Bug#12867)
+
+2012-11-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix a race with verify-visited-file-modtime (Bug#12863).
+ Since at least 1991 Emacs has ignored an mtime difference of no
+ more than one second, but my guess is that this was to work around
+ file system bugs that were fixed long ago. Since the race is
+ causing problems now, let's remove that code.
+ * fileio.c (Fverify_visited_file_modtime): Do not accept a file
+ whose time stamp is off by no more than a second. Insist that the
+ file time stamps match exactly.
+
+2012-11-12 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * frame.h (struct frame): Convert external_tool_bar member to
+ 1-bit unsigned bitfield.
+ * termhooks.h (struct terminal): Remove mouse_moved member since
+ all users are long dead. Adjust comment on mouse_position_hook.
+
+2012-11-12 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simplify by using FOR_EACH_FRAME here and there.
+ * frame.c (next_frame, prev_frame, other_visible_frames)
+ (delete_frame, visible-frame-list): Use FOR_EACH_FRAME.
+ * w32term.c (x_window_to_scroll_bar): Likewise.
+ * window.c (window_list): Likewise.
+ * xdisp.c (x_consider_frame_title): Likewise.
+ * xfaces.c ( Fdisplay_supports_face_attributes_p): Likewise.
+ * xfns.c (x_window_to_frame, x_any_window_to_frame)
+ (x_menubar_window_to_frame, x_top_window_to_frame): Likewise.
+ * xmenu.c (menubar_id_to_frame): Likewise.
+ * xselect.c (frame_for_x_selection): Likewise.
+ * xterm.c (x_frame_of_widget, x_window_to_scroll_bar)
+ (x_window_to_menu_bar): Likewise.
+ * w32fns.c (x_window_to_frame): Likewise. Adjust comment.
+
+2012-11-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * data.c (Qdefalias_fset_function): Now static.
+
+ Another tweak to vectorlike_header change.
+ * alloc.c (struct Lisp_Vectorlike_Free, NEXT_IN_FREE_LIST):
+ Remove, and replace all uses with ...
+ (next_in_free_list, set_next_in_free_list):
+ New functions, which respect C's aliasing rules better.
+
+2012-11-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ * window.c (list4i): Rename from 'quad'. All uses changed.
+ Needed because <sys/types.h> defines 'quad' on Solaris 10.
+
+2012-11-11 Juanma Barranquero <lekktu@gmail.com>
+
+ * xdisp.c (start_hourglass) [HAVE_NTGUI]: Add block to silence
+ warning about mixing declarations and code in ISO C90.
+
+2012-11-10 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fsplit_window_internal): Set combination limit of
+ new parent window to t iff Vwindow_combination_limit is t;
+ fixing a regression introduced with the change from 2012-09-22.
+ (Fset_window_combination_limit): Fix doc-string.
+
+2012-11-10 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (try_scrolling): Fix correction of aggressive-scroll
+ amount when the scroll margins are too large. When scrolling
+ backwards in the buffer, give up if cannot reach point or the
+ scroll margin within a reasonable number of screen lines.
+ Fixes point position in window under scroll-up/down-aggressively when
+ point is positioned many lines beyond the window top/bottom.
+ (Bug#12811)
+
+ * ralloc.c (relinquish): If real_morecore fails to return memory
+ to the system, don't crash; instead, leave the last heap
+ unchanged and return. (Bug#12774)
+
+2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp.h (AUTOLOADP): New macro.
+ * eval.c (Fautoload): Don't attach to loadhist, call Fdefalias instead.
+ * data.c (Ffset): Remove special ad-advice-info handling.
+ (Fdefalias): Handle autoload definitions and new Qdefalias_fset_function.
+ (Fsubr_arity): CSE.
+ (Finteractive_form): Simplify.
+ (Fquo): Don't insist on having at least 2 arguments.
+ (Qdefalias_fset_function): New var.
+
+2012-11-09 Jan Djärv <jan.h.d@swipnet.se>
+
+ * image.c (xpm_make_color_table_h): Change to hashtest_equal.
+
+ * nsfont.m (Qcondensed, Qexpanded): New variables.
+ (ns_descriptor_to_entity): Restore Qcondensed, Qexpanded setting.
+ (syms_of_nsfont): Defsym Qcondensed, Qexpanded.
+
+2012-11-09 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix recently introduced crash on MS-Windows (Bug#12839).
+ * w32term.h (struct scroll_bar): Use convenient header.
+ (SCROLL_BAR_VEC_SIZE): Remove.
+ * w32term.c (x_scroll_bar_create): Use VECSIZE.
+
+2012-11-09 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Tweak last vectorlike_header change.
+ * alloc.c (struct Lisp_Vectorlike_Free): Special type to represent
+ vectorlike object on the free list. This is introduced to avoid
+ some (but not all) pointer casting and aliasing problems, see
+ http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00105.html.
+ * .gdbinit (pvectype, pvecsize): New commands to examine vectorlike
+ objects.
+ (xvectype, xvecsize): Use them to examine Lisp_Object values.
+
+2012-11-09 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsfont.m (ns_descriptor_to_entity): Qcondensed and Qexpanded has
+ been removed, so remove them here also.
+
+2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * doc.c (Fdocumentation): Handle new property
+ dynamic-docstring-function to replace the old ad-advice-info.
+
+2012-11-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fns.c (Qeql, hashtest_eq): Now static.
+
+2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp.h (XHASH): Redefine to be imperfect and fit in a Lisp int.
+ * fns.c (hashfn_eq, hashfn_eql, sxhash):
+ * profiler.c (hashfn_profiler): Don't use XUINT on non-integers.
+ * buffer.c (compare_overlays): Use XLI rather than XHASH.
+
+2012-11-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use same hash function for hashfn_profiler as for hash_string etc.
+ * fns.c (SXHASH_COMBINE): Remove. All uses replaced by sxhash_combine.
+ * lisp.h (sxhash_combine): New inline function, with the contents
+ of the old SXHASH_COMBINE.
+ * profiler.c (hashfn_profiler): Use it, instead of having a
+ special hash function containing a comparison that always yields 1.
+
+2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * xfaces.c (Qultra_light, Qreverse_oblique, Qreverse_italic)
+ (Qultra_condensed, Qextra_condensed, Qcondensed, Qsemi_condensed)
+ (Qsemi_expanded, Qextra_expanded, Qexpanded, Qultra_expanded):
+ Remove unused vars.
+
+2012-11-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * image.c (xpm_make_color_table_h): Fix compiler error because
+ make_hash_table changed.
+
+2012-11-08 Thomas Kappler <tkappler@gmail.com> (tiny change)
+
+ * nsfont.m (ns_findfonts): Handle empty matchingDescs (Bug#11541).
+
+2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Use ad-hoc comparison function for the profiler's hash-tables.
+ * profiler.c (Qprofiler_backtrace_equal, hashtest_profiler): New vars.
+ (make_log): Use them.
+ (handle_profiler_signal): Don't inhibit quit any longer since we don't
+ call Fequal any more.
+ (Ffunction_equal): New function.
+ (cmpfn_profiler, hashfn_profiler): New functions.
+ (syms_of_profiler): Initialize them.
+ * lisp.h (struct hash_table_test): New struct.
+ (struct Lisp_Hash_Table): Use it.
+ * alloc.c (mark_object): Mark hash_table_test fields of hash tables.
+ * fns.c (make_hash_table): Take a struct to describe the test.
+ (cmpfn_eql, cmpfn_equal, cmpfn_user_defined, hashfn_eq, hashfn_eql)
+ (hashfn_equal, hashfn_user_defined): Adjust to new calling convention.
+ (hash_lookup, hash_remove_from_table): Move assertion checking of
+ hashfn result here. Check hash-equality before calling cmpfn.
+ (Fmake_hash_table): Adjust call to make_hash_table.
+ (hashtest_eq, hashtest_eql, hashtest_equal): New structs.
+ (syms_of_fns): Initialize them.
+ * emacs.c (main): Move syms_of_fns earlier.
+ * xterm.c (syms_of_xterm):
+ * category.c (hash_get_category_set): Adjust call to make_hash_table.
+ * print.c (print_object): Adjust to new hash-table struct.
+ * composite.c (composition_gstring_put_cache): Adjust to new hashfn.
+
+2012-11-08 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c (modifier_set): Fix handling of Scroll Lock when the
+ value of w32-scroll-lock-modifier is neither nil nor one of the
+ known key modifiers. (Bug#12806)
+
+2012-11-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Shrink struct vectorlike_header to the only size field.
+ * lisp.h (enum pvec_type): Avoid explicit enum member values.
+ Adjust comment.
+ (enum More_Lisp_Bits): Change PSEUDOVECTOR_SIZE_BITS and
+ PVEC_TYPE_MASK to arrange new bitfield in the vector header.
+ (PSEUDOVECTOR_REST_BITS, PSEUDOVECTOR_REST_MASK): New members.
+ (PSEUDOVECTOR_AREA_BITS): New member used to extract subtype
+ information from the vector header. Adjust comment.
+ (XSETPVECTYPE, XSETPVECTYPESIZE, XSETTYPED_PSEUDOVECTOR)
+ (PSEUDOVECTOR_TYPEP, DEFUN): Adjust to match new vector header
+ layout.
+ (XSETSUBR, SUBRP): Adjust to match new Lisp_Subr layout.
+ (struct vectorlike_header): Remove next member. Adjust comment.
+ (struct Lisp_Subr): Add convenient header. Adjust comment.
+ (allocate_pseudovector): Adjust prototype.
+ * alloc.c (mark_glyph_matrix, mark_face_cache, allocate_string)
+ (sweep_string, lisp_malloc): Remove useless prototypes.
+ (enum mem_type): Adjust comment.
+ (NEXT_IN_FREE_LIST): New macro.
+ (SETUP_ON_FREE_LIST): Adjust XSETPVECTYPESIZE usage.
+ (Fmake_bool_vector): Likewise.
+ (struct large_vector): New type to represent allocation unit for
+ the vectors with the memory footprint more than VBLOOCK_BYTES_MAX.
+ (large_vectors): Change type to struct large_vector.
+ (allocate_vector_from_block): Simplify.
+ (PSEUDOVECTOR_NBYTES): Replace with...
+ (vector_nbytes): ...new function. Adjust users.
+ (sweep_vectors): Adjust processing of large vectors.
+ (allocate_vectorlike): Likewise.
+ (allocate_pseudovector): Change type of 3rd arg to enum pvec_type.
+ Add easserts. Adjust XSETPVECTYPESIZE usage.
+ (allocate_buffer): Use BUFFER_PVEC_INIT.
+ (live_vector_p): Adjust to match large vector.
+ * buffer.c (init_buffer_once): Use BUFFER_PVEC_INIT.
+ * buffer.h (struct buffer): Add next member.
+ (BUFFER_LISP_SIZE, BUFFER_REST_SIZE, BUFFER_PVEC_INIT):
+ New macros.
+ (FOR_EACH_BUFFER): Adjust to match struct buffer change.
+ * fns.c (internal_equal): Adjust to match enum pvec_type change.
+ (copy_hash_table): Adjust to match vector header change.
+ * lread.c (defsubr): Use XSETPVECTYPE.
+ * .gdbinit (xpr, xbacktrace): Adjust to match vector header change.
+ (xvectype): Likewise. Print PVEC_NORMAL_VECTOR for regular vectors.
+ (xvecsize): New command.
+
+2012-11-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * keyboard.c (event_to_kboard): Do not dereference
+ frame_or_window field of SELECTION_REQUEST_EVENT
+ and SELECTION_CLEAR_EVENT events (Bug#12814).
+ * xterm.h (struct selection_input_event): Adjust comment.
+
+2012-11-07 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c (modifier_set): Don't report modifiers from toggle key,
+ such as Scroll Lock, if the respective keys are treated as
+ function keys, not as modifiers. This avoids destroying non-ASCII
+ keyboard input when Scroll Lock is toggled ON. (Bug#12806)
+
+2012-11-07 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * xfns.c (Fx_wm_set_size_hint): Use check_x_frame. Adjust docstring.
+
+2012-11-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Restore some duplicate definitions (Bug#12814).
+ This undoes part of the 2012-11-03 changes. Some people build
+ with plain -g rather than with -g3, and they need the duplicate
+ definitions for .gdbinit to work; see <http://bugs.gnu.org/12814#26>.
+ * lisp.h (GCTYPEBITS, ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, VALMASK):
+ Define as macros, as well as as enums or as constants.
+
+2012-11-06 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (convert_ns_to_X_keysym, keyDown:): Add NSNumericPadKeyMask
+ to keypad keys (Bug#12816).
+
+2012-11-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor adjustments of recently-changed frame functions.
+ * buffer.c (Fbuffer_list): Omit CHECK_FRAME, since arg is already
+ known to be a frame (we're in the FRAMEP branch).
+ * lisp.h (Qframep): Remove decl. frame.h declares this.
+ * window.c (quad): Args are of type EMACS_INT, not ptrdiff_t,
+ since they're meant for Lisp fixnum values.
+
+2012-11-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.c (Fwindow_combination_limit): Revert to the only
+ required argument and adjust docstring as suggested in
+ http://lists.gnu.org/archive/html/emacs-diffs/2012-11/msg01082.html
+ by Martin Rudalics <rudalics@gmx.at>.
+
+2012-11-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Widely used frame validity and checking functions.
+ * frame.h (decode_live_frame, decode_any_frame): Add prototypes.
+ * frame.c (decode_live_frame, decode_any_frame): New functions.
+ (delete_frame, Fredirect_frame_focus, Fframe_parameters)
+ (Fframe_parameter, Fframe_char_height, Fframe_char_width)
+ (Fframe_pixel_height, Fframe_pixel_width, Ftool_bar_pixel_width)
+ (Fframe_pointer_visible_p): Use decode_any_frame.
+ (Fmake_frame_visible, Fmake_frame_invisible, Ficonify_frame)
+ (Fraise_frame, Flower_frame, Fmodify_frame_parameters)
+ (Fset_frame_height, Fset_frame_width): Use decode_live_frame.
+ (Fframe_focus): Likewise. Allow zero number of arguments.
+ Adjust docstring.
+ (frame_buffer_list, frame_buffer_predicate): Remove.
+ * lisp.h (frame_buffer_predicate): Remove prototype.
+ * buffer.c (Fother_buffer): Use decode_any_frame.
+ * xdisp.c (Ftool_bar_lines_needed): Likewise.
+ * xfaces.c (Fcolor_gray_p, Fcolor_supported_p): Likewise.
+ * font.c (Ffont_face_attributes, Ffont_family_list, Fopen_font)
+ (Fclose_font, Ffont_info): Use decode_live_frame.
+ * fontset.c (check_fontset_name): Likewise.
+ * terminal.c (Fframe_terminal): Likewise.
+ * w32fns.c (check_x_frame): Likewise.
+ * window.c (Fminibuffer_window, Fwindow_at)
+ (Fcurrent_window_configuration): Likewise.
+ (Frun_window_configuration_change_hook, Fwindow_resize_apply):
+ Likewise. Allow zero number of arguments. Adjust docstring.
+ * dispnew.c (Fredraw_frame): Likewise.
+ * xfaces.c (frame_or_selected_frame): Remove.
+ (Fx_list_fonts, Finternal_get_lisp_face_attribute, Fface_font)
+ (Finternal_lisp_face_equal_p, Finternal_lisp_face_empty_p)
+ (Fframe_face_alist): Use decode_live_frame.
+ * xfns.c (check_x_frame): Likewise.
+
+2012-11-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.c (quad): New function.
+ (Fwindow_edges, Fwindow_pixel_edges, Fwindow_inside_edges)
+ (Fwindow_absolute_pixel_edges, Fwindow_inside_absolute_pixel_edges)
+ (Fwindow_inside_pixel_edges, Fpos_visible_in_window_p)
+ (Fwindow_line_height): Use it.
+ (Fwindow_fringes): Use list3.
+ (Fwindow_scroll_bars): Use list4.
+ (Fwindow_frame, Fwindow_top_child, Fwindow_left_child)
+ (Fwindow_combination_limit): Allow zero number of arguments.
+
+2012-11-05 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in ($(BLD)/w32fns.$(O)): Depend on $(NT_INC)/unistd.h.
+
+ * w32fns.c: Include unistd.h, to avoid compiler warnings on Cygwin.
+ (emacs_abort) [CYGWIN]: Don't call _open_osfhandle; instead, use
+ file descriptor 2 for standard error. (Bug#12805)
+
+2012-11-05 Chong Yidong <cyd@gnu.org>
+
+ * process.c (wait_reading_process_output): Revert previous change.
+
+2012-11-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume at least POSIX.1-1988 for getpgrp, setpgid, setsid (Bug#12800).
+ This removes code that has been obsolete since around 1990.
+ * callproc.c (Fcall_process):
+ * emacs.c (main):
+ * process.c (create_process):
+ * term.c (dissociate_if_controlling_tty):
+ Assume setsid exists.
+ * callproc.c (child_setup): Assume setpgid exists and behaves as
+ per POSIX.1-1988 or later.
+ * conf_post.h (setpgid) [!HAVE_SETPGID]: Remove.
+ * emacs.c (shut_down_emacs):
+ * sysdep.c (sys_suspend, init_foreground_group):
+ Assume getpgrp behaves as per POSIX.1-1998 or later.
+ * msdos.c (setpgrp): Remove.
+ (tcgetpgrp, setpgid, setsid): New functions.
+ * systty.h (EMACS_GETPGRP): Remove. All callers now use getpgrp.
+ * term.c (no_controlling_tty): Remove; unused.
+ * w32proc.c (setpgrp): Remove.
+ (setsid, tcgetpgrp): New functions.
+
+ Simplify by assuming __fpending.
+ * dispnew.c: Include <fpending.h>, not <stdio_ext.h>.
+ (update_frame_1): Use __fpending, not PENDING_OUTPUT_COUNT.
+ Do not assume that __fpending's result fits in int.
+
+2012-11-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove EMACS_OUTQSIZE+sleep hack.
+ * dispnew.c (update_frame_1): Remove hack for terminals slower
+ than 2400 bps, which throttled Emacs by having it sleep.
+ This code hasn't worked since at least 2007, when the multi-tty stuff
+ was added, and anyway those old terminals are long dead.
+ * systty.h (EMACS_OUTQSIZE): Remove; unused. The macro isn't used even
+ without the dispnew.c change, as dispnew.c doesn't include systty.h.
+
+ Fix data-loss with --version (Bug#9574).
+ * emacs.c (close_output_streams): Use strerror, not emacs_strerror,
+ as we can't assume that emacs_strerror is initialized, and strerror
+ is good enough here.
+ (main): Invoke atexit earlier, to catch earlier instances of
+ sending data to stdout and exiting, e.g., "emacs --version >/dev/full".
+
+2012-11-04 Michael Marchionna <tralfaz@pacbell.net>
+
+ * nsterm.m: Add NSClearLineFunctionKey and keypad keys (Bug#8680).
+ (keyDown): Remap keypad keys to X11 virtual key codes.
+
+2012-11-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix data-loss with --batch (Bug#9574).
+ * emacs.c: Include <close-stream.h>.
+ (close_output_streams): New function.
+ (main): Pass it to atexit, so that Emacs closes stdout and stderr
+ and handles errors appropriately.
+ (Fkill_emacs): Don't worry about flushing, as close_output_stream
+ does that now.
+
+ Fix a race condition that causes Emacs to mess up glib (Bug#8855).
+ The symptom is a diagnostic "GLib-WARNING **: In call to
+ g_spawn_sync(), exit status of a child process was requested but
+ SIGCHLD action was set to SIG_IGN and ECHILD was received by
+ waitpid(), so exit status can't be returned." The diagnostic
+ is partly wrong, as the SIGCHLD action is not set to SIG_IGN.
+ The real bug is a race condition between Emacs and glib: Emacs
+ does a waitpid (-1, ...) and reaps glib's subprocess by mistake,
+ so that glib can't find it. Work around the bug by invoking
+ waitpid only on subprocesses that Emacs itself creates.
+ * process.c (create_process, record_child_status_change):
+ Don't use special value -1 in pid field, as the caller now must
+ know the pid rather than having the callee infer it.
+ The inference was sometimes incorrect anyway, due to another race.
+ (create_process): Set new 'alive' member if child is created.
+ (process_status_retrieved): New function.
+ (record_child_status_change): Use it.
+ Accept negative 1st argument, which means to wait for the
+ processes that Emacs already knows about. Move special-case code
+ for DOS_NT (which lacks WNOHANG) here, from caller. Keep track of
+ processes that have already been waited for, by testing and
+ clearing new 'alive' member.
+ (CAN_HANDLE_MULTIPLE_CHILDREN): Remove, as record_child_status_change
+ now does this internally.
+ (handle_child_signal): Let record_child_status_change do all
+ the work, since we do not want to reap all exited child processes,
+ only the child processes that Emacs itself created.
+ * process.h (Lisp_Process): New boolean member 'alive'.
+
+ Omit duplicate definitions no longer needed with gcc -g3.
+ * lisp.h (GCTYPEBITS, GCALIGNMENT, ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG)
+ (VALMASK, MOST_POSITIVE_FIXNUM, MOST_NEGATIVE_FIXNUM):
+ Define only as macros. There's no longer any need to also define
+ these symbols as enums or as constants, since we now assume
+ gcc -g3 when debugging.
+
+2012-11-03 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp.mk: Adjust comments to the fact that term/internal is now
+ loaded from loadup.el.
+
+ * msdos.c (msdos_abort): Rename from emacs_abort, and make static.
+ (msdos_fatal_signal): New function.
+ (XMenuActivate): Adjust the call to kbd_buffer_events_waiting to
+ its argument list.
+
+ * conf_post.h (_GL_EXECINFO_INLINE) [MSDOS]: Define to "inline"
+ for GCC versions before 4.
+ (emacs_raise): Define to call msdos_fatal_signal.
+
+ * xdisp.c (init_from_display_pos): Fix initialization of the bidi
+ iterator when starting in the middle of a display or overlay
+ string. (Bug#12745)
+
+2012-11-03 Chong Yidong <cyd@gnu.org>
+
+ * process.c (wait_reading_process_output): Clean up the last
+ change.
+
+2012-11-03 Jim Paris <jim@jtan.com> (tiny change)
+
+ * process.c (wait_reading_process_output): Avoid a race condition
+ with SIGIO delivery (Bug#11536).
+
+2012-11-03 Chong Yidong <cyd@gnu.org>
+
+ * buffer.c (cursor_type): Untabify docstring.
+
+2012-11-03 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * frame.h (struct frame): Drop can_have_scroll_bars member
+ which is meaningless for a long time. Adjust comments.
+ (FRAME_CAN_HAVE_SCROLL_BARS): Remove.
+ * frame.c, nsfns.m, term.c, w32fns.c, xfns.c: Adjust users.
+
+2012-11-03 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.c (decode_next_window_args): Update window arg after
+ calling decode_live_window and so fix crash reported at
+ http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00035.html
+ by Juanma Barranquero <lekktu@gmail.com>.
+ (Fwindow_body_width, Fwindow_body_height): Simplify a bit.
+ * font.c (Ffont_at): Likewise.
+
+2012-11-01 Jan Djärv <jan.h.d@swipnet.se>
+
+ * widget.c (resize_cb): New function.
+ (EmacsFrameRealize): Add resize_cb as event handler (Bug#12733).
+ (EmacsFrameResize): Check if all is up to date before changing frame
+ size.
+
+2012-11-02 Eli Zaretskii <eliz@gnu.org>
+
+ Implement backtrace output for fatal errors on MS-Windows.
+ * w32fns.c (CaptureStackBackTrace_proc): New typedef.
+ (BACKTRACE_LIMIT_MAX): New macro.
+ (w32_backtrace): New function.
+ (emacs_abort): Use w32_backtrace when the user chooses not to
+ attach a debugger. Update the text of the abort dialog.
+
+2012-11-02 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Window-related stuff cleanup here and there.
+ * dispnew.c (Finternal_show_cursor, Finternal_show_cursor_p):
+ Use decode_any_window.
+ * fringe.c (Ffringe_bitmaps_at_pos): Likewise.
+ * xdisp.c (Fformat_mode_line): Likewise.
+ * font.c (Ffont_at): Use decode_live_window.
+ * indent.c (Fcompute_motion, Fvertical_motion): Likewise.
+ * window.c (decode_next_window_args): Likewise.
+ (decode_any_window): Remove static.
+ * window.h (decode_any_window): Add prototype.
+ * lisp.h (CHECK_VALID_WINDOW, CHECK_LIVE_WINDOW): Move from here...
+ * window.h: ...to here, redefine via WINDOW_VALID_P and WINDOW_LIVE_P,
+ respectively.
+
+2012-11-02 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Remove pad from struct input_event.
+ * termhooks.h (struct input_event): Remove padding field.
+ Adjust comment.
+ * keyboard.c (event_to_kboard): Simplify because frame_or_window
+ member is never cons for a long time. Adjust comment.
+ (mark_kboards): Adjust because SELECTION_REQUEST_EVENT and
+ SELECTION_CLEAR_EVENT has no Lisp_Objects to mark. Add comment.
+ * xterm.c (handle_one_xevent): Do not initialize frame_or_window
+ field of SELECTION_REQUEST_EVENT and SELECTION_CLEAR_EVENT.
+
+2012-11-01 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (getpgrp, setpgid): New functions. (Bug#12776)
+
+2012-10-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix crash when using Emacs as commit editor for git (Bug#12697).
+ * callproc.c (setpgrp): Remove macro, as we now use setpgid
+ and it is configured in conf_post.h.
+ (Fcall_process): Don't invoke both setsid and setpgid; the former
+ is enough, if it exists.
+ * callproc.c (Fcall_process, child_setup):
+ * process.c (create_process): Use setpgid.
+ * conf_post.h (setpgid) [!HAVE_SETPGID]: New macro, which substitutes
+ for the real thing.
+ * dispnew.c (init_display): Initialize the foreground group
+ if we are running a tty display.
+ * emacs.c (main): Do not worry about setpgrp; init_display does it now.
+ * lisp.h (init_foreground_group): New decl.
+ * sysdep.c (inherited_pgroup): New static var.
+ (init_foreground_group, tcsetpgrp_without_stopping)
+ (narrow_foreground_group, widen_foreground_group): New functions.
+ (init_sys_modes): Narrow foreground group.
+ (reset_sys_modes): Widen foreground group.
+
+2012-10-31 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c: Fix cut'n'waste error. Use HAVE_DBUS_VALIDATE_INTERFACE.
+
+2012-10-31 Martin Rudalics <rudalics@gmx.at>
+
+ * minibuf.c (read_minibuf): Restore current buffer since
+ choose_minibuf_frame calling Fset_frame_selected_window may
+ change it (Bug#12766).
+
+2012-10-30 Jan Djärv <jan.h.d@swipnet.se>
+
+ * frame.c (Fframe_pixel_height): Fix documentation (Bug#12733).
+
+2012-10-30 Kenichi Handa <handa@gnu.org>
+
+ * font.c (Ffont_at): If WINDOW is specified and it is not
+ displaying the current buffer, signal an error.
+
+2012-10-29 Daniel Colascione <dancol@dancol.org>
+
+ * cygw32.h, cygw32.c (Qutf_16le, from_unicode, to_unicode):
+ In preparation for fixing bug#12739, move these functions from
+ here...
+
+ * coding.h, coding.c: ... to here, and compile them only when
+ WINDOWSNT or CYGWIN. Moving these functions out of cygw32 proper
+ lets us write cygw32-agnostic code for the HAVE_NTGUI case.
+
+2012-10-28 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (TIMER_TICKS_PER_SEC): New macro.
+ (timer_loop, getitimer, setitimer): Use it instead of
+ CLOCKS_PER_SEC, which is no longer pertinent, since we don't use
+ 'clock'.
+ (w32_get_timer_time): Use 10*TIMER_TICKS_PER_SEC instead of a
+ literal 10000.
+
+2012-10-28 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (NO_APPDEFINED_DATA): New define.
+ (last_appdefined_event_data): New variable
+ (last_appdefined_event): Remove.
+ (ns_select): Initialize t from last_appdefined_event_data instead
+ of [last_appdefined_event data1].
+ (sendEvent:): Save [theEvent data1] to last_appdefined_event_data,
+ remove last_appdefined_event (Bug#12698).
+
+2012-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * frame.c (x_set_font): Catch internal error.
+
+2012-10-27 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid overflow in w32 implementation of interval timers.
+ When possible, for ITIMER_PROF count only times the main thread
+ actually executes.
+ * w32proc.c <struct itimer_data>: 'expire' and 'reload' are now
+ 'volatile ULONGLONG' types. All the other data which was
+ previously clock_t is now ULONGLONG. 'terminate' is 'volatile int'.
+ (GetThreadTimes_Proc): New typedef.
+ (w32_get_timer_time): New function, returns a suitable time value
+ for the timer.
+ (timer_loop): Enter critical section when accessing ULONGLONG
+ values of the itimer_data struct, as these accesses are no longer
+ atomic. Call 'w32_get_timer_time' instead of 'clock'.
+ Remove unused variable.
+ (init_timers): Initialize s_pfn_Get_Thread_Times.
+ (start_timer_thread): Don't assign itimer->caller_thread here.
+ (getitimer): Assign itimer->caller_thread here.
+ (setitimer): Always call getitimer to get the value of ticks_now.
+ (sys_spawnve): Avoid compiler warning about format mismatch.
+
+2012-10-26 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c (w32_wnd_proc) <WM_MOUSEMOVE>: Don't enable tracking of
+ mouse movement events if the menu bar is active. This avoids
+ producing a busy "hour-glass" cursor by Windows if the mouse
+ pointer is positioned over a tooltip shown for some menu item.
+
+2012-10-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don't assume process IDs fit in int.
+ * emacs.c (shut_down_emacs) [!DOS_NT]:
+ * sysdep.c (sys_suspend) [SIGTSTP && !MSDOS]:
+ * term.c (dissociate_if_controlling_tty) [!DOS_NT]:
+ Use pid_t, not int, to store process IDs, as 'int'
+ is not wide enough on a few platforms (e.g., AIX and IRIX).
+
+2012-10-23 Kenichi Handa <handa@gnu.org>
+
+ The following change is to make face-font-rescale-alist work
+ correctly for non-ASCII fonts.
+
+ * font.c (font_open_entity): Don't handle Vface_font_rescale_alist.
+ (font_open_for_lface): Handle Vface_font_rescale_alist.
+
+2012-10-23 Chong Yidong <cyd@gnu.org>
+
+ * xfaces.c (Vfont_list_limit): Move unused variable to faces.el.
+
+2012-10-21 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsfont.m (nsfont_open, ns_glyph_metrics): Force integer advancement
+ for screen font.
+ (nsfont_draw): Turn off LCD-smoothing (Bug#11484).
+
+ * xterm.c (x_focus_changed): Check if daemonp when sending focus in
+ event (Bug#12681).
+
+2012-10-21 Glenn Morris <rgm@gnu.org>
+
+ * lisp.mk (lisp): Add cp51932.el and eucjp-ms.el.
+
+2012-10-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port to OpenBSD 5.1.
+ * frame.c (Fmouse_position, Fmouse_pixel_position):
+ * xdisp.c (produce_stretch_glyph):
+ Declare local vars only when they're needed.
+ This is clearer and avoids a warning on OpenBSD about unused vars.
+ * frame.h (FRAME_WINDOW_P): Always evaluate its argument.
+ This is safer, and avoids OpenBSD warnings about unused vars.
+ * keyboard.c (record_menu_key): Remove unnecessary decl.
+ (poll_timer): Define only if POLL_FOR_INPUT is defined.
+ * unexelf.c (ELFSIZE) [!ElfW]: Do not define if already defined,
+ as our definition clashes with OpenBSD's.
+ * xfaces.c (load_face_colors, check_lface_attrs)
+ (get_lface_attributes_no_remap, get_lface_attributes)
+ (lface_fully_specified_p, x_supports_face_attributes_p)
+ (tty_supports_face_attributes_p, face_fontset, realize_face)
+ (realize_x_face, realize_tty_face):
+ Declare parameters to be Lisp_Object[LFACE_VECTOR_SIZE], not
+ merely Lisp_Object *. This is more informative and avoids
+ a warning on OpenBSD about accessing beyond an object's size.
+
+2012-10-20 Chong Yidong <cyd@gnu.org>
+
+ * lread.c (Fload): Doc fix (Bug#12592).
+
+2012-10-19 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny change)
+
+ * font.c (Ffont_at): Fix previous change.
+
+2012-10-19 Eli Zaretskii <eliz@gnu.org>
+
+ * puresize.h (BASE_PURESIZE): Bump the base value to 1700000.
+ See http://lists.gnu.org/archive/html/emacs-devel/2012-10/msg00593.html
+ for the reasons.
+
+ * alloc.c (NSTATICS): Decrease to 0x800.
+
+2012-10-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * fns.c (Fnreverse): Include the problem element when signalling an
+ error (bug#12677).
+
+2012-10-18 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_select): Check writefds before call to
+ FD_ISSET (Bug#12668).
+
+2012-10-18 Daniel Colascione <dancol@dancol.org>
+
+ * alloc.c (NSTATICS): Increase from 0x650 to 0x1000
+ (staticpro): If we run out of staticpro slots, die with an
+ informative error instead of just calling emacs_abort.
+
+2012-10-18 Martin Rudalics <rudalics@gmx.at>
+
+ Fix two flaws reported by Dmitry Antipov.
+ * window.c (Ftemp_output_buffer_show): Remove.
+ (Fwindow_vscroll, Fset_window_vscroll): Use decode_live_window.
+ (syms_of_window): Remove defsubr for Stemp_output_buffer_show.
+
+2012-10-17 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in ($(BLD)/w32.$(O)):
+ ($(BLD)/vm-limit.$(O)):
+ ($(BLD)/term.$(O)):
+ ($(BLD)/unexw32.$(O)):
+ ($(BLD)/fileio.$(O)):
+ ($(BLD)/dispnew.$(O)): Update dependencies.
+
+ * w32term.h (w32_initialize_display_info, initialize_w32_display):
+ Add prototypes.
+
+ * w32proc.c: Include ctype.h.
+
+ * w32.h (init_environment, check_windows_init_file)
+ (syms_of_ntproc, syms_of_ntterm, dostounix_filename)
+ (unixtodos_filename, init_winsock, srandom, random, sys_pipe)
+ (set_process_dir, sys_spawnve, register_child, sys_sleep, getwd)
+ (sys_link): Add prototypes.
+
+ * w32.c: Include w32select.h.
+ (sys_access, e_malloc, sys_select): Add prototypes.
+ (emacs_gnutls_pull): 'timeout' is now EMACS_TIME, not struct timeval.
+
+ * vm-limit.c [WINDOWSNT]: Include w32heap.h.
+
+ * unexw32.c: Include lisp.h and w32.h.
+
+ * term.c [WINDOWSNT]: Include w32term.h.
+
+ * process.c [WINDOWSNT]: Add prototype of sys_select.
+
+ * fileio.c [WINDOWSNT]: Include w32.h.
+
+ * dispnew.c [WINDOWSNT]: Include w32.h.
+
+ * cygw32.c (Fcygwin_convert_path_to_windows)
+ (Fcygwin_convert_path_from_windows): Use EQ to compare 2
+ Lisp_Object values. (Bug#12661)
+
+ * w32fns.c (w32_msg_pump): Use XIL instead of casting an integer
+ to Lisp_Object. (Bug#12661)
+
+2012-10-17 Kenichi Handa <handa@gnu.org>
+
+ * xdisp.c (reseat_1): Make the information stored in it->cmp_it
+ invalidate.
+
+2012-10-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * buffer.c (Fkill_buffer): When unchaining the marker,
+ reset its buffer pointer to NULL (Bug#12652).
+
+2012-10-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Do not verify indirection counters of killed buffers (Bug#12579).
+ * buffer.h (BUFFER_CHECK_INDIRECTION): New macro.
+ * buffer.c (compact_buffer, set_buffer_internal_1): Use it.
+
+2012-10-16 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (Fmake_byte_code): Fix typo in comment.
+ * print.c (print_interval): Define as static to match prototype.
+ * indent.c (disptab_matches_widthtab, recompute_width_table):
+ Convert to eassert.
+
+2012-10-16 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * editfns.c (get_system_name): Remove.
+ * lisp.h (get_system_name): Remove prototype.
+ * xrdb.c (getenv, getpwuid, getpwnam): Remove prototypes.
+ (get_environ_db): Use Vsystem_name. Avoid call to strlen.
+
+2012-10-15 Daniel Colascione <dancol@dancol.org>
+
+ * dbusbind.c: Add comment explaining reason for previous change.
+
+2012-10-15 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fwindow_end): Rewrite check whether cached position
+ can be used (Bug#12600).
+ (resize_frame_windows, grow_mini_window, shrink_mini_window):
+ Set windows_or_buffers_changed.
+
+2012-10-15 Daniel Colascione <dancol@dancol.org>
+
+ * dbusbind.c: Fix cygw32 build break when compiling with dbus
+ enabled by undefining the symbol "interface", which the platform
+ headers define to something incompatible.
+
+2012-10-14 Daniel Colascione <dancol@dancol.org>
+
+ * image.c (init_tiff_functions, init_imagemagick_functions)
+ (init_svg_functions): Fix cygw32 build break by using these
+ functions only when WINDOWSNT _and_ HAVE_NTGUI.
+
+2012-10-14 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_select): Count fd:s in writefs also (Bug#12422).
+
+2012-10-13 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (xg_set_widget_bg): Divide by 65535 (Bug#12612).
+
+2012-10-13 HANATAKA, Shinya <bogytech@gmail.com> (tiny change)
+
+ * coding.c (detect_coding): Set coding->id before calling
+ this->detector.
+
+2012-10-13 Andreas Schwab <schwab@linux-m68k.org>
+
+ * fileio.c: Formatting fixes.
+
+2012-10-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix some stat-related races.
+ * fileio.c (Fwrite_region): Avoid race condition if a file is
+ removed or renamed by some other process immediately after Emacs
+ writes it but before Emacs stats it. Do not assume that stat (or
+ fstat) succeeds.
+ * image.c (slurp_file): Resolve the file name with fopen + fstat
+ rather than stat + fopen.
+ (pbm_read_file) [0]: Remove unused code with stat race.
+ * process.c (allocate_pty) [HAVE_PTYS && !PTY_ITERATION && !PTY_OPEN]:
+ Remove ineffective code with stat race.
+
+2012-10-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * doc.c (get_doc_string): Don't signal an error if the file is missing.
+
+2012-10-12 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (hold_event_q): New static variable.
+ (EV_TRAILER, sendScrollEventAtLoc:fromEvent:): Call hold_event if
+ ! q_event_ptr.
+ (hold_event): New function.
+ (ns_read_socket): If hold_event_q have events, store them and
+ return (Bug#12384).
+ (setPosition:portion:whole:): Send SIGIO to ourselves if apploopnr
+ is zero (Bug#12384).
+
+2012-10-12 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/w32select.$(O)): Update dependencies.
+
+2012-10-12 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in ($(BLD)/fileio.$(O)): Add sys/file.h.
+
+ * fileio.c (check_existing): New function.
+ (make_temp_name, Ffile_exists_p, Ffile_writable_p): Call it
+ instead of calling 'stat', when what's needed is to check whether
+ a file exists. This avoids expensive system calls on MS-Windows.
+ (Bug#12587)
+
+ * w32.c (init_environment): Call 'check_existing' instead of 'stat'.
+
+ * lread.c (openp) [WINDOWSNT]: Call 'access' instead of 'stat' to
+ determine whether a file exists and is not a directory.
+
+ * lisp.h (check_existing): Add prototype.
+
+2012-10-12 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsfont.m (nsfont_open): Remove font cache, it is not GC correct.
+
+2012-10-12 Glenn Morris <rgm@gnu.org>
+
+ * buffer.c (Fset_buffer): Doc fix. (Bug#12624)
+
+2012-10-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * buffer.c (Fkill_buffer): Null out the overlay list(s) as well.
+
+ * eval.c (Fautoload): Remember previous autoload status in load-history.
+
+2012-10-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ lread.c, macros.c, marker.c, menu.c, minibuf.c: Use bool for booleans.
+ * lread.c (load_each_byte, new_backquote_flag, readchar)
+ (read_filtered_event, lisp_file_lexically_bound_p)
+ (safe_to_load_version, Fload, complete_filename_p, openp)
+ (build_load_history, readevalloop, read_escape, read1)
+ (string_to_number, read_vector, read_list):
+ * macros.c (Fstart_kbd_macro):
+ * marker.c (CONSIDER):
+ * menu.c (parse_single_submenu, digest_single_submenu)
+ (find_and_return_menu_selection, Fx_popup_menu):
+ * minibuf.c (read_minibuf_noninteractive, read_minibuf)
+ (Ftry_completion):
+ * nsmenu.m (ns_update_menubar, runMenuAt:forFrame:keymaps:):
+ (ns_menu_show):
+ * xmenu.c (set_frame_menubar, create_and_show_popup_menu)
+ (xmenu_show, xdialog_show):
+ Use bool for booleans.
+ * lread.c (safe_to_load_version): Rename from safe_to_load_p,
+ as it's not a predicate. All uses changed. Omit unnecessary
+ buffer termination.
+
+2012-10-11 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * editfns.c (save_excursion_save): Use nil if mark points to nowhere.
+ (save_excursion_restore): Do not restore mark if it was not saved.
+
+2012-10-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ * marker.c (cached_modiff): EMACS_INT, not int.
+
+ * w32select.c (waiting_for_input): Declare by including "keyboard.h"
+ instead of having a wrong decl.
+ * nsmenu.m (waiting_for_input): Remove wrong decl.
+
+2012-10-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ keyboard.c, keymap.c: Use bool for booleans.
+ * dispnew.c (sit_for): Distinguish between 3-way display_option
+ and boolean do_display.
+ * keyboard.c (single_kboard, this_command_key_count_reset)
+ (waiting_for_input, echoing, immediate_quit, input_pending)
+ (interrupt_input, interrupts_deferred, pop_kboard)
+ (temporarily_switch_to_single_kboard, ignore_mouse_drag_p)
+ (command_loop_1, adjust_point_for_property)
+ (safe_run_hooks_error, input_polling_used, read_char):
+ (help_char_p, readable_events, kbd_buffer_events_waiting)
+ (kbd_buffer_get_event, timer_check_2, make_lispy_event)
+ (lucid_event_type_list_p, get_input_pending):
+ (gobble_input, menu_separator_name_p, menu_bar_item)
+ (parse_menu_item, parse_tool_bar_item, read_char_x_menu_prompt)
+ (read_char_minibuf_menu_prompt, access_keymap_keyremap)
+ (keyremap_step, test_undefined, read_key_sequence)
+ (detect_input_pending, detect_input_pending_ignore_squeezables)
+ (detect_input_pending_run_timers, requeued_events_pending_p)
+ (quit_throw_to_read_char, Fset_input_interrupt_mode):
+ * keymap.c (get_keymap, keymap_parent, keymap_memberp)
+ (access_keymap_1, access_keymap, map_keymap, get_keyelt)
+ (Fdefine_key, Flookup_key, struct accessible_keymaps_data)
+ (accessible_keymaps_1, Fkey_description, push_key_description):
+ (shadow_lookup, struct where_is_internal_data)
+ (where_is_internal, Fwhere_is_internal, where_is_internal_1)
+ (Fdescribe_buffer_bindings, describe_map_tree, struct describe_map_elt)
+ (describe_map, describe_vector):
+ * menu.c (single_menu_item):
+ * nsmenu.m (ns_update_menubar):
+ * process.c (wait_reading_process_output):
+ * search.c (scan_buffer, scan_newline):
+ Use bool for boolean.
+ * keyboard.c (timers_run, swallow_events)
+ (detect_input_pending_run_timers):
+ * process.c (wait_reading_process_output):
+ Use unsigned for counter where wraparound-on-overflow is desired,
+ since unsigned is guaranteed to have that behavior and signed is not.
+ (read_char): Use ptrdiff_t for string length.
+ (get_input_pending): Remove first argument, since it was always
+ the same pointer-to-int (now pointer-to-boolean) &input_pending,
+ and behave as if it had that value. Return new value of
+ input_pending. All callers changed.
+ * keyboard.h (struct kboard): Use unsigned : 1 for boolean member
+ immediate_echo. Use ptrdiff_t for echo_after_prompt, since it's
+ a string length.
+ * keymap.c (push_key_description): Omit last arg, which was always 1.
+ All callers changed.
+
+ * regex.c (immediate_quit) [emacs]: Remove duplicate decl.
+
+2012-10-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/dispnew.$(O), $(BLD)/indent.$(O))
+ ($(BLD)/term.$(O)): Update dependencies.
+
+2012-10-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (mark_object): Use meaningful PVEC_NORMAL_VECTOR.
+ * lisp.h (enum pvec_type): Adjust comments and omit explicit
+ initializer for PVEC_NORMAL_VECTOR.
+
+2012-10-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clean out old termopts cruft.
+ * termopts.h (flow_control, meta_key): Remove unused decls.
+ * dispnew.c, indent.c, nsterm.m, term.c, xsettings.c, xsmfns.c:
+ Don't include termopts.h.
+
+2012-10-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (gc_sweep): Use pointer-to-a-pointer loop for buffers.
+
+2012-10-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ * commands.h (immediate_quit): Remove duplicate decl.
+
+2012-10-09 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsfont.m (Vfonts_in_cache): Remove, not needed as font.c handles
+ caching.
+ (nsfont_open): Remove setting of Vfonts_in_cache.
+ (syms_of_nsfont): Remove initialization of Vfonts_in_cache.
+
+2012-10-09 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c (w32_last_error): Change the return value to DWORD, to
+ match what GetLastError returns. Explain why the function is
+ needed.
+
+ * frame.c (delete_frame): Rename local variable 'tooltip_frame' to
+ 'is_tooltip_frame', to avoid confusion with its global namesake.
+
+2012-10-08 Daniel Colascione <dancol@dancol.org>
+
+ * xdisp.c (start_hourglass): Call w32_note_current_window when
+ HAVE_NTGUI, not just WINDOWSNT, resolving a problem in the cygw32
+ build that caused Emacs to display the hourglass cursor forever.
+
+ * w32fns.c (Fx_display_color_cells): Instead of using NCOLORS,
+ which is broken under remote desktop, calculate the number of
+ colors available for a display based on the display's number of
+ planes and number of bits per pixel per plane. (bug#10397).
+
+2012-10-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsfont.m (Vfonts_in_cache): New variable.
+ (nsfont_open): Use unsignedLongLongValue for cache in case wide ints
+ are used. Add cached fonts to Vfonts_in_cache.
+ (syms_of_nsfont): Initialize and staticpro Vfonts_in_cache.
+
+2012-10-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (LOCAL_FLAGS): Don't define HAVE_NTGUI, it's now
+ in nt/config.nt.
+ (FONT_H): Define after FRAME_H.
+ ($(BLD)/emacs.$(O), $(BLD)/process.$(O), $(BLD)/w32heap.$(O)):
+ Update dependencies.
+
+ * w32term.c: Remove leftover declaration of keyboard_codepage.
+
+2012-10-08 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (FONT_H): Add $(FRAME_H).
+ (W32TERM_H): Add $(ATIMER_H) and $(FRAME_H).
+ ($(BLD)/emacs.$(O), $(BLD)/w32console.$(O)): Update dependencies.
+ (GLOBAL_SOURCES): Add cygw32.c.
+ ($(BLD)/unexw32.$(O)):
+ ($(BLD)/w32.$(O)):
+ ($(BLD)/w32console.$(O)):
+ ($(BLD)/w32fns.$(O)):
+ ($(BLD)/w32heap.$(O)):
+ ($(BLD)/w32menu.$(O)):
+ ($(BLD)/w32proc.$(O)): Add w32common.h.
+
+ * w32fns.c (w32_color_map_lookup, x_to_w32_color): Argument is now
+ 'const char *'.
+ (x_to_w32_color): Don't modify the argument, modify a copy instead.
+
+2012-10-08 Daniel Colascione <dancol@dancol.org>
+
+ * w32term.h (WM_EMACS_BRINGTOTOP, WM_EMACS_INPUT_READY)
+ (WM_EMACS_END): Change WM_EMACS_BRINGTOTOP from 22 to 21 to close
+ accidental message numbering hole. Change other messages to
+ match.
+
+ * w32select.h (HAVE_W32SELECT): Remove.
+
+ * w32select.c, w32proc.c, w32menu.c, w32console.c, w32.c: Include
+ w32common.h instead of w32heap.h.
+
+ * w32heap.h (ROUND_UP, ROUND_DOWN, get_page_size)
+ (get_allocation_unit, get_processor_type, get_w32_major_version)
+ (get_w32_minor_version, sysinfo_cache, osinfo_cache)
+ (w32_major_version, w32_minor_version, w32_build_number, OS_9X)
+ (OS_NT, os_subtype, cache_system_info): Move declarations to
+ w32common.
+
+ * w32heap.c: Include w32common.h.
+ (sysinfo_cache, syspage_mask, osinfo_cache, w32_major_version)
+ (w32_minor_version, w32_build_number, w32_subtype):
+ Remove duplicate definitions.
+
+ * w32fns.c: Include w32common.h; include w32heap.h only in
+ WINDOWSNT.
+
+ (Fx_file_dialog): Clarify comment on GetOpenFileName structure.
+ Use `report_file_error' instead of `error' in order to better
+ inform users of what went wrong. Increase NTGUI_UNICODE file
+ dialog box file name length to 32k, the maximum allowed by the NT
+ kernel.
+
+ * w32common.h: New file.
+ (ROUND_UP, ROUND_DOWN, get_page_size)
+ (get_allocation_unit, get_processor_type, get_w32_major_version)
+ (get_w32_minor_version, sysinfo_cache, osinfo_cache)
+ (w32_major_version, w32_minor_version, w32_build_number, OS_9X)
+ (OS_NT, os_subtype, cache_system_info): Move here.
+
+ * unexw32.c, unexcw.c: Include w32common.h.
+
+ * emacs.c (main): Use (defined (WINDOWSNT) || defined
+ HAVE_NTGUI) instead of removed HAVE_W32SELECT to decide whether
+ to call syms_of_w32select.
+
+ * cygw32.h: Remove obsolete EXFUN declarations.
+
+ * cygw32.c (Qutf_16_le): Rename to Qutf_16le.
+
+ * Makefile.in (SOME_MACHINE_OBJECTS): Reverse accidental removal
+ of w32inevt.o from SOME_MACHINE_OBJECTS.
+
+2012-10-08 Daniel Colascione <dancol@dancol.org>
+
+ * image.c: Permanent fix for JPEG compilation issue --- limit
+ jpeglib `boolean' redefinition to Cygwin builds.
+
+2012-10-08 Eli Zaretskii <eliz@gnu.org>
+
+ * image.c (CHECK_LIB_AVAILABLE): Remove, no longer used.
+
+ * emacs.c (DAEMON_MUST_EXEC) [HAVE_NTGUI]: Define this only on
+ Cygwin.
+
+2012-10-08 Daniel Colascione <dancol@dancol.org>
+
+ * xfaces.c, xdisp.c, window.c, w32xfns.c, w32term.h, w32term.c,
+ w32select.h w32select.c, w32proc.c, w32menu.c, w32inevt.c,
+ w32help.c, w32font.c, w32font.c, w32fns.c, w32console.c, w32.h,
+ w32.c, unexw32.c, termhooks.h, process.c, menu.c, keyboard.h,
+ keyboard.c, image.c, frame.h, frame.c, fontset.c, font.h, font.c,
+ emacs.c, dispextern.h, cygw32.h, cygw32.c, conf_post.h,
+ Makefile.in: use HAVE_NTGUI for W32 GUI and WINDOWSNT for the
+ operating system. defined(HAVE_NTGUI) && !defined(WINDOWSNT) is
+ now a supported configuration.
+
+ * Makefile.in: consolidate image variables into LIBIMAGE; add
+ W32_OBJ and W32_LIBS. Compile new files.
+
+ * conf_post.h:
+ (_DebPrint) declare tracing facility for W32 debugging. We need
+ to unify tracing later.
+
+ (NTGUI_UNICODE) Define when compiling for Cygwin to allow the
+ unconditional use of W32 Unicode functions. Cygwin runs only on
+ 100% Unicode operating systems.
+
+ * cygw32.c: New file. Define Cygwin-specific facilities.
+ (Fcygwin_convert_path_to_windows)
+ (Fcygwin_convert_path_from_windows): New user functions for
+ accessing Cygwin path-munging routines.
+
+ * cygw32.h: New file.
+ (WCSDATA, to_unicode, from_unicode): Define facilities for storing
+ UTF-16LE strings temporarily inside non-Lisp-visible string
+ objects.
+
+ (w32_strerror): Just what it says on the tin.
+
+ * emacs.c: Make the NS fork-then-exec code for daemon-launching
+ also run for Cygwin; both systems have the same problem with using
+ GUI facilities in a forked child. Also call syms_of_cygw32,
+ syms_of_w32select in correct places.
+
+ (DAEMON_MUST_EXEC): new macro defined to signal that a platform
+ needs fork-then-exec for daemon launching.
+
+ * font.h: Include frame.h.
+
+ * image.c: Use the image library cache machinery only when we're
+ compiling for native WINDOWSNT; Cygwin can use shared libraries
+ like any other Unixlike system.
+
+ * keyboard.c: Clarify a comment regarding the input loop.
+
+ * menu.c: When NTGUI_UNICODE is defined, use Unicode menu
+ functions directly instead of trying to detect at runtime that our
+ host operating system supports them. We make this change for two
+ reasons: Cygwin lacks support for the multibyte character
+ conversion functions used by the legacy menu code, and Cygwin
+ never needs to rely on non-Unicode APIs.
+
+ * unexw32.c (hinst): Declare extern.
+
+ * w32.c: Change header order;
+ (w32_strerror): Move to w32fns.c because we need it for
+ non-WINDOWSNT builds.
+
+ * w32.h: Add #error macro to make sure we don't include w32.h for
+ Cygwin builds. Remove w32select declarations.
+
+ * w32console.c (w32_sys_ring_bell, Fset_message_beep): Move to
+ w32fns.c. w32console.c is WINDOWSNT-only.
+
+ * w32fns.c: Include cygw32.h or w32.h depending on CYGWIN; more
+ NTGUI_UNICODE tweaks. (See above.) Change _snprintf to the more
+ POSIXy alternative.
+ (faked_key, sysinfo_cache, osinfo_cahce, syspage_mask)
+ (w32_major_version, w32_minor_version, w32_build_number)
+ (os_subtype, sound_type): Define here
+ (w32_defined_color): Make color parameter const for consistency
+ with other _defined_color functions.
+ (w32_createwindow): Unconditionally call w32_init_class instead of
+ doing so only when hprevinst is non-NULL. Plumbing hprevinst
+ through the code is complex and unnecessary because class
+ registration is practically free.
+ (w32_name_of_message): New EMACSDEBUG-only function.
+ (Fset_message_beep): Move here
+ (Fx_open_connection): Require that the display name for Windows be
+ "w32" for consistency, emacsclient disambiguation, and maybe, one
+ day, multi-window-system support.
+ (file_dialog_callback): NTGUI_UNICODE changes; encode and decode
+ Cygwin files for W32 GUI facilities, since these clearly don't
+ expect Cygwin names.
+ (_DebPrint): Define.
+ (w32_strerror, w32_console_toggle_lock_key, w32_kbd_mods_to_emacs)
+ (w32_kbd_patch_key, w32_sys_ring_bell): Move here.
+ (Ssystem_move_file_to_trash): Define only for native WINDOWSNT.
+ (w32_last_error): Remove.
+
+ * w32font.c: Define _strlwr to strlwr for non-WINDOWSNT builds.
+
+ * w32heap.c (syspage_mask): Declare here.
+ (cache_system_info): Remove.
+
+ * w32inevt.c (faked_key): Define globally, not statically.
+ (w32_kbd_mods_to_emacs, w32_kbd_patch_key, faked_key)
+ (w32_console_toggle_lock_key): Move to w32fns.c.
+
+ * w32menu.c: Include setjmp.h. NTGUI_UNICODE changes throughout.
+
+ * w32proc.c (_DebPrint): Move to w32fns.c.
+ * w32select.c: Include string.h, stdio.h for Cygwin.
+ * w32select.h: New File.
+
+ * w32term.c: Include io.h for non-CYGWIN builds; needed for
+ get_osfhandle.
+ (w32_message_fd): New variable. Under Cygwin, holds the file
+ descriptor the system used to tell us about pending thread
+ messages.
+
+ (w32_init_term): Remove incorrect calls to fcntl and init_sigio
+ that prevented compilation under non-WINDOWSNT systems.
+
+ (w32_initialize): Open /dev/windows and assign it to
+ w32_message_fd. Provide w32 feature.
+
+ * w32term.h: Include frame.h, atimer.h. Declare various frame functions.
+ (WM_EMACS_INPUT_READY): add.
+ (prepend_msg, w32_message_fd): Declare globally.
+
+ * w32xfns.c:
+ (keyboard_handle): Use only when WINDOWSNT.
+ (notify_msg_ready): New function. Posts a message to the main
+ thread's message queue under CYGWIN, which wakes up the main
+ thread from select(2) by making the /dev/windows file descriptor
+ ready. Under WINDOWSNT, it sets an event the same way the old
+ code did.
+
+ (post, prepend_msg): Actually call notify_msg_ready instead of
+ setting the input event directly.
+
+2012-10-07 Eli Zaretskii <eliz@gnu.org>
+
+ * ralloc.c (relinquish): If a heap is ready to be relinquished,
+ but it still has blocs in it, don't return it to the system,
+ instead of aborting. (Bug#12402)
+
+2012-10-07 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_dumpglyphs_image): Only draw slice of image (Bug#12506).
+
+ * nsterm.m (ns_update_auto_hide_menu_bar): Remove defintion of
+ MAC_OS_X_VERSION_10_6.
+ (syms_of_nsterm): Remove comment about Panther and above for
+ ns-antialias-text.
+ * nsterm.h (MAC_OS_X_VERSION_10_3, onTiger): Remove.
+ (EmacsApp): Remove check for >= MAC_OS_X_VERSION_10_4.
+ (struct nsfont_info): Remove check for >= MAC_OS_X_VERSION_10_3.
+
+ * nsselect.m (ns_string_from_pasteboard): Remove check for >=
+ MAC_OS_X_VERSION_10_4.
+
+ * nsmenu.m (fillWithWidgetValue:): Remove code for <
+ MAC_OS_X_VERSION_10_2.
+
+ * nsimage.m (setPixmapData, getPixelAtX, setAlphaAtX): Remove onTiger.
+
+ * nsfns.m (Fns_list_services): Remove comment and check for OSX < 10.4.
+ (ns_do_applescript): Remove check for >= MAC_OS_X_VERSION_10_4.
+
+ * nsterm.m (ns_in_resize): Remove (Bug#12479).
+ (ns_resize_handle_rect, mouseDown, mouseUp, mouseDragged): Remove.
+ (ns_clear_frame, sendEvent, windowDidResize, drawRect:):
+ Remove ns_in_resize check.
+ (ns_clear_frame_area): Remove resize handle code.
+
+ * nsfns.m (ns_in_resize): Remove.
+ (x_set_icon_name, ns_set_name, ns_set_name_as_filename):
+ Remove ns_in_resize check.
+
+2012-10-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve sys_siglist detection.
+ * sysdep.c (sys_siglist, init_signals): Use _sys_siglist if it's
+ defined as a macro, as is done in Solaris.
+ (sys_siglist_entries): New macro.
+ (save_strsignal): Use it.
+ * syssignal.h (safe_strsignal): Now ATTRIBUTE_CONST, to pacify
+ GCC 4.7.2 on Fedora 17 with the fixed sys_siglist detection.
+
+2012-10-06 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsfns.m (Fx_create_frame): Call x_default_parameter with
+ fullscreen/Fullscreen.
+
+ * nsterm.h (EmacsView): Rename tbar_height to tibar_height.
+ tobar_height is new.
+
+ * nsterm.m (x_make_frame_visible): Check for fullscreen.
+ (ns_fullscreen_hook): Activate old style fullscreen with a timer.
+ (ns_term_init): Set activateIgnoringOtherApps if old style fullscreen.
+ (windowDidResize:): Check for correct window if old style fullscreen.
+ Capitalize word in comment. Remove incorrect comment.
+ (initFrameFromEmacs:): tbar_height renamed tibar_height.
+ (windowDidEnterFullScreen:): Toggle toolbar for fullscreen to fix
+ error in drawing background.
+ (toggleFullScreen:): Remove comment. Rearrange calls.
+ Set toolbar values to zero, save old height in tobar_height.
+ Restore tool bar height when leaving fullscreen.
+ (canBecomeMainWindow): New function.
+
+2012-10-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ * keyboard.c (read_char): Remove unnecessary 'volatile's and label.
+
+2012-10-05 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (stop_timer_thread): Fix declaration of 'err'.
+
+ * w32.c (utime): Open the file with FILE_FLAG_BACKUP_SEMANTICS, so
+ that time stamps of directories could also be changed.
+ Don't request the too broad GENERIC_WRITE, only the more restrictive
+ FILE_WRITE_ATTRIBUTES access rights.
+
+ * fileio.c (Fset_file_times): Special-case ignoring errors for
+ directories only on MSDOS, not on MS-Windows.
+
+2012-10-05 Ikumi Keita <ikumi@ikumi.que.jp> (tiny change)
+
+ * minibuf.c (Fcompleting_read): Doc fix. (Bug#12555)
+
+2012-10-04 Eli Zaretskii <eliz@gnu.org>
+
+ * w32.c (utime): Test for INVALID_HANDLE_VALUE, not for NULL, to
+ see whether CreateFile failed.
+
+2012-10-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * profiler.c (handle_profiler_signal): Inhibit pending signals too,
+ to avoid similar races.
+ * keyboard.c (pending_signals): Now bool, not int.
+
+ Port timers to OpenBSD, plus check for timer failures.
+ OpenBSD problem reported by Han Boetes.
+ * profiler.c (setup_cpu_timer): Check for failure of timer_settime
+ and/or setitimer.
+ (Fprofiler_cpu_stop): Don't assume HAVE_SETITIMER.
+ * syssignal.h (HAVE_ITIMERSPEC): New macro. This is for platforms
+ like OpenBSD, which has timer_settime but does not declare it.
+ OpenBSD does not define SIGEV_SIGNAL, so use that when deciding
+ whether to use itimerspec-related primitives. All uses of
+ HAVE_TIMER_SETTIME replaced with HAVE_ITIMERSPEC.
+
+2012-10-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ * profiler.c (handle_profiler_signal): Fix a malloc race
+ that caused Emacs to hang on Fedora 17 when profiling Lisp.
+
+2012-10-02 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (windowDidEnterFullScreen): Remove fprintf.
+
+2012-10-02 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (sys_wait): Declare 'signame' 'const char *', to be
+ consistent with the change in return value of 'safe_strsignal'.
+
+2012-10-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer plain 'static' to 'static inline' (Bug#12541).
+ * bidi.c (bidi_get_type, bidi_check_type, bidi_get_category)
+ (bidi_set_sor_type, bidi_push_embedding_level)
+ (bidi_pop_embedding_level, bidi_remember_char, bidi_copy_it)
+ (bidi_cache_reset, bidi_cache_shrink, bidi_cache_fetch_state)
+ (bidi_cache_search, bidi_cache_ensure_space)
+ (bidi_cache_iterator_state, bidi_cache_find)
+ (bidi_peek_at_next_level, bidi_set_paragraph_end)
+ (bidi_count_bytes, bidi_char_at_pos, bidi_fetch_char)
+ (bidi_explicit_dir_char, bidi_resolve_neutral_1):
+ Now 'static', not 'static inline'.
+
+ Count overruns when profiling; change units to ns.
+ * profiler.c (handle_profiler_signal): Count sampling intervals, not ms.
+ Give extra weight to samples after overruns, to attempt to count
+ the time more accurately.
+ (setup_cpu_timer): Change sampling interval units from ms to ns, since
+ the underlying primitives nominally do ns.
+ (Fprofiler_cpu_start): Document the change. Mention that
+ the sampling intervals are only approximate.
+
+2012-10-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * frame.c (Fmake_terminal_frame): Prefer safer CONSP over !NILP.
+
+ * coding.h (ENCODE_FILE, DECODE_FILE, DECODE_SYSTEM): Remove special
+ case for the special 0 coding-system.
+
+ * buffer.c (Fset_buffer_multibyte): Signal an error instead of widening.
+ (Fmake_overlay): Remove redundant tests.
+ (fix_start_end_in_overlays): Remove redundant recentering.
+
+2012-10-02 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/alloc.$(O), $(BLD)/gmalloc.$(O)):
+ Update dependencies.
+
+2012-10-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix a malloc race condition involving strsignal.
+ A signal can arrive in the middle of a malloc, and Emacs's signal
+ handler can invoke strsignal, which can invoke malloc, which is
+ not portable. This race condition bug makes Emacs hang on GNU/Linux.
+ Fix it by altering the signal handler so that it does not invoke
+ strsignal.
+ * emacs.c (shut_down_emacs): Use safe_strsignal, not strsignal.
+ * process.c (status_message): Use const pointer, in case strsignal
+ is #defined to safe_strsignal.
+ * sysdep.c (sys_siglist, init_signals): Always define and
+ initialize a substitute sys_siglist if the system does not define
+ one, even if HAVE_STRSIGNAL.
+ (safe_strsignal): Rename from strsignal. Always define,
+ using sys_siglist. Return a const pointer.
+ * syssignal.h (safe_strsignal): New decl.
+ (strsignal) [!HAVE_STRSIGNAL]: Define in terms of safe_strsignal.
+
+2012-10-01 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (timer_loop): Fix code that waits for timer
+ expiration, to avoid high CPU usage.
+
+2012-10-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * fns.c (check_hash_table, get_key_arg, maybe_resize_hash_table)
+ (sweep_weak_table): Remove redundant prototypes.
+
+2012-10-01 Fabrice Popineau <fabrice.popineau@gmail.com>
+
+ * emacs.c: Move the inclusion of TERM_HEADER after including
+ windows.h on WINDOWSNT. This avoids compilation problems with
+ MSVC.
+
+2012-10-01 Eli Zaretskii <eliz@gnu.org>
+
+ * unexw32.c (OFFSET_TO_RVA, RVA_TO_OFFSET)
+ (RVA_TO_SECTION_OFFSET): Encode all macro arguments in parentheses.
+ (RVA_TO_PTR): Cast the result of RVA_TO_OFFSET to 'unsigned char *',
+ as the previous version used 'void *'.
+
+ * ralloc.c (ROUNDUP): Fix last change.
+ (MEM_ROUNDUP): Don't cast MEM_ALIGN, it is already of type
+ 'size_t'.
+
+ * w32proc.c <disable_itimers>: New static flag.
+ (init_timers): Initialize it to zero, after creating the critical
+ sections used by the timer threads.
+ (term_timers): Set to 1 before deleting the critical sections.
+ (getitimer, setitimer): If disable_itimers is non-zero, return an
+ error indication without doing anything. Reported by Fabrice
+ Popineau <fabrice.popineau@supelec.fr> as part of bug#12544.
+ (alarm) [HAVE_SETITIMER]: Be more conformant to the expected
+ return results.
+ [!HAVE_SETITIMER]: Behave as the previous version that didn't
+ support timers.
+
+ * emacs.c (shut_down_emacs) [WINDOWSNT]: Move the call to
+ term_ntproc after all the other bookkeeping, to get timers working
+ as long as possible.
+
+2012-10-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xdisp.c (syms_of_xdisp): Default message-log-max to 1000, not 100.
+ Suggested by Juri Linkov in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00821.html>.
+
+ Prefer plain 'static' to 'static inline' (Bug#12541).
+ With static functions, modern compilers inline pretty well by
+ themselves; advice from programmers often hurts as much as it helps.
+ On my host (x86-64, Fedora 17, GCC 4.7.2, default 'configure'),
+ this change shrinks the text size of the Emacs executable by 1.1%
+ without affecting CPU significantly in my benchmark.
+ * alloc.c (mem_find, live_string_p, live_cons_p, live_symbol_p)
+ (live_float_p, live_misc_p, live_vector_p, live_buffer_p)
+ (mark_maybe_object, mark_maybe_pointer, bounded_number):
+ * buffer.c (bset_abbrev_mode, bset_abbrev_table)
+ (bset_auto_fill_function, bset_auto_save_file_format)
+ (bset_auto_save_file_name, bset_backed_up, bset_begv_marker)
+ (bset_bidi_display_reordering, bset_buffer_file_coding_system)
+ (bset_cache_long_line_scans, bset_case_fold_search)
+ (bset_ctl_arrow, bset_cursor_in_non_selected_windows)
+ (bset_cursor_type, bset_display_table, bset_extra_line_spacing)
+ (bset_file_format, bset_file_truename, bset_fringe_cursor_alist)
+ (bset_fringe_indicator_alist, bset_fringes_outside_margins)
+ (bset_header_line_format, bset_indicate_buffer_boundaries)
+ (bset_indicate_empty_lines, bset_invisibility_spec)
+ (bset_left_fringe_width, bset_major_mode, bset_mark)
+ (bset_minor_modes, bset_mode_line_format, bset_mode_name)
+ (bset_name, bset_overwrite_mode, bset_pt_marker)
+ (bset_right_fringe_width, bset_save_length)
+ (bset_scroll_bar_width, bset_scroll_down_aggressively)
+ (bset_scroll_up_aggressively, bset_selective_display)
+ (bset_selective_display_ellipses, bset_vertical_scroll_bar_type)
+ (bset_word_wrap, bset_zv_marker, set_buffer_overlays_before)
+ (set_buffer_overlays_after):
+ * category.c (bset_category_table):
+ * charset.c (read_hex):
+ * coding.c (produce_composition, produce_charset)
+ (handle_composition_annotation, handle_charset_annotation)
+ (char_encodable_p):
+ * dispnew.c (swap_glyph_pointers, copy_row_except_pointers)
+ (assign_row, set_frame_matrix_frame, make_current)
+ (add_row_entry):
+ * eval.c (set_specpdl_symbol, set_specpdl_old_value):
+ * fns.c (maybe_resize_hash_table):
+ * frame.c (fset_buffer_predicate, fset_minibuffer_window):
+ * gmalloc.c (register_heapinfo):
+ * image.c (lookup_image_type):
+ * intervals.c (set_interval_object, set_interval_left)
+ (set_interval_right, copy_interval_parent, rotate_right)
+ (rotate_left, balance_possible_root_interval):
+ * keyboard.c (kset_echo_string, kset_kbd_queue)
+ (kset_keyboard_translate_table, kset_last_prefix_arg)
+ (kset_last_repeatable_command, kset_local_function_key_map)
+ (kset_overriding_terminal_local_map, kset_real_last_command)
+ (kset_system_key_syms, clear_event, set_prop):
+ * lread.c (digit_to_number):
+ * marker.c (attach_marker, live_buffer, set_marker_internal):
+ * nsterm.m (ns_compute_glyph_string_overhangs):
+ * process.c (pset_buffer, pset_command)
+ (pset_decode_coding_system, pset_decoding_buf)
+ (pset_encode_coding_system, pset_encoding_buf, pset_filter)
+ (pset_log, pset_mark, pset_name, pset_plist, pset_sentinel)
+ (pset_status, pset_tty_name, pset_type, pset_write_queue):
+ * syntax.c (bset_syntax_table, dec_bytepos):
+ * terminal.c (tset_param_alist):
+ * textprop.c (interval_has_some_properties)
+ (interval_has_some_properties_list):
+ * window.c (wset_combination_limit, wset_dedicated)
+ (wset_display_table, wset_hchild, wset_left_fringe_width)
+ (wset_left_margin_cols, wset_new_normal, wset_new_total)
+ (wset_normal_cols, wset_normal_lines, wset_parent, wset_pointm)
+ (wset_right_fringe_width, wset_right_margin_cols)
+ (wset_scroll_bar_width, wset_start, wset_temslot, wset_vchild)
+ (wset_vertical_scroll_bar_type, wset_window_parameters):
+ * xdisp.c (wset_base_line_number, wset_base_line_pos)
+ (wset_column_number_displayed, wset_region_showing)
+ (window_box_edges, run_window_scroll_functions)
+ (append_glyph_string_lists, prepend_glyph_string_lists)
+ (append_glyph_string, set_glyph_string_background_width)
+ (append_glyph, append_composite_glyph)
+ (take_vertical_position_into_account):
+ * xfaces.c (x_create_gc, x_free_gc, merge_face_vectors)
+ (face_attr_equal_p, lface_equal_p, hash_string_case_insensitive)
+ (lface_hash, lface_same_font_attributes_p, lookup_face):
+ * xml.c (libxml2_loaded_p):
+ * xterm.c (x_set_mode_line_face_gc, x_set_glyph_string_gc)
+ (x_set_glyph_string_clipping, x_clear_glyph_string_rect):
+ Now 'static', not 'static inline'.
+
+ * bidi.c: Tune.
+ (bidi_copy_it): Do the whole copy with a single memcpy.
+ (bidi_char_at_pos): Merge the two STRING_CHAR calls into one.
+
+ Revert the FOLLOW-SYMLINKS change for file-attributes.
+ Doing it right would require several changes to Tramp, and there's
+ not enough time to get that tested before the freeze today.
+ * dired.c (directory_files_internal, Ffile_attributes):
+ Undo last change.
+
+ * frame.c (x_report_frame_params): Port better to wider ints.
+ Do not assume that EMACS_UINT is the same width as uprintmax_t,
+ or that pointers can be printed in 15 decimal digits.
+ Avoid GCC warnings if EMACS_UINT is wider than a pointer.
+
+2012-09-30 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ Support x64 build on MS-Windows.
+ * w32term.h (SCROLL_BAR_PACK, SCROLL_BAR_UNPACK): Define for x64.
+ (SET_SCROLL_BAR_W32_WINDOW): Cast ID to intptr_t, for
+ compatibility with x64.
+ (x_get_focus_frame): Add prototype.
+
+ * w32term.c (w32_draw_underwave): Don't use GCC extensions for
+ defining an XRectangle structure.
+
+ * w32proc.c (RVA_TO_PTR, w32_executable_type): Fix pointer
+ arithmetics for compatibility with x64.
+
+ * w32menu.c (add_menu_item): Use UINT_PTR instead of UINT, for
+ compatibility with x64.
+
+ * w32heap.h: Adjust prototypes and declarations.
+
+ * w32heap.c (RVA_TO_PTR, allocate_heap, sbrk, init_heap)
+ (round_heap): Use DWORD_PTR, ptrdiff_t and size_t instead of
+ DWORD, long, and unsigned long, for compatibility with x64.
+ (allocate_heap) [_WIN64]: Reserve 32GB of memory.
+ (sbrk): Argument is now of type ptrdiff_t.
+
+ * w32fns.c (HMONITOR): Condition declaration on _WIN32_WINNT being
+ less than 0x0500.
+ (w32_msg_pump): Use WPARAM type for 'result'.
+
+ * w32.c (init_environment, get_emacs_configuration): Support AMD64
+ architecture.
+ (init_ntproc): Cast arguments of _open_osfhandle to intptr_t, for
+ compatibility with x64.
+
+ * vm-limit.c (lim_data): Now size_t.
+ (check_memory_limits): Adjust prototypes of real_morecore and
+ __morecore to receive argument of type ptrdiff_t. Use size_t for
+ five_percent and data_size.
+
+ * unexw32.c: Use DWORD_PTR instead of DWORD for file-scope
+ variables, for compatibility with x64.
+ (rva_to_section, offset_to_section, relocate_offset)
+ (OFFSET_TO_RVA, RVA_TO_OFFSET, RVA_TO_SECTION_OFFSET)
+ (PTR_TO_RVA, RVA_TO_PTR, OFFSET_TO_PTR, get_section_info)
+ (copy_executable_and_dump_data): Use DWORD_PTR instead of DWORD
+ for compatibility with x64.
+
+ * sysdep.c (STDERR_FILENO): Define if not already defined.
+
+ * ralloc.c (real_morecore): Argument type is now ptrdiff_t.
+ (__morecore): Argument type is now ptrdiff_t.
+ (ROUNDUP, MEM_ROUNDUP): Use size_t instead of 'unsigned long'.
+ (relinquish): Use ptrdiff_t type for 'excess'.
+ (r_alloc_sbrk): Argument type is now ptrdiff_t.
+
+ * makefile.w32-in (HEAPSIZE): Get value from EMACS_HEAPSIZE.
+ (bootstrap-temacs-CMD, bootstrap-temacs-SH): Use $(EMACS_PURESIZE)
+ instead of a literal number.
+
+ * gmalloc.c [WINDOWSNT]: Include w32heap.h.
+ (min): Define only if not already defined.
+
+ * frame.c (x_report_frame_params): Use EMACS_UINT for the return
+ value of FRAME_X_WINDOW, to fit a 64-bit pointer on 64-bit Windows
+ hosts.
+
+ * image.c (x_bitmap_pixmap): Return ptrdiff_t, not int, since
+ 'bitmaps' is a pointer.
+
+ * dispextern.h (x_bitmap_pixmap): Adjust prototype.
+
+ * alloc.c (gdb_make_enums_visible): Now conditional on __GNUC__.
+
+2012-09-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ file-attributes has a new optional arg FOLLOW-SYMLINKS.
+ * dired.c (directory_files_internal, Ffile_attributes):
+ New arg follow_symlinks. All uses changed.
+
+2012-09-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * .gdbinit (xbacktrace): Adjust to recent "struct backtrace" change.
+
+2012-09-30 Eli Zaretskii <eliz@gnu.org>
+
+ Support atimers and CPU profiler via profile.c on MS-Windows.
+ * w32proc.c (sig_mask, crit_sig): New static variables.
+ (sys_signal): Support SIGALRM and SIGPROF.
+ (sigemptyset, sigaddset, sigfillset, sigprocmask)
+ (pthread_sigmask, setpgrp): Move here from w32.c. sigaddset,
+ sigfillset, and sigprocmask are no longer no-ops.
+ (sigismember): New function.
+ (struct itimer_data): New definition.
+ (ticks_now, real_itimer, prof_itimer, clocks_min, crit_real)
+ (crit_prof): New static variables.
+ (MAX_SINGLE_SLEEP): New definition.
+ (timer_loop, stop_timer_thread, term_timers, init_timers)
+ (start_timer_thread, getitimer, setitimer): New functions.
+ (alarm): No longer a no-op, calls setitimer.
+
+ * w32.c (term_ntproc): Call term_timers.
+ (init_ntproc): Make sure all signals are unblocked at startup, to
+ erase any traces of dumping. Call init_timers.
+
+ * w32fns.c (hourglass_timer, HOURGLASS_ID): Remove.
+ Windows-specific code to display the hourglass mouse pointer is no
+ longer used.
+ (w32_wnd_proc): Remove code that handled the WM_TIMER message due
+ to hourglass timer expiration.
+ (start_hourglass, cancel_hourglass, DEFAULT_HOURGLASS_DELAY):
+ Remove, no longer used.
+ (w32_note_current_window, show_hourglass, hide_hourglass):
+ New functions, in support of hourglass cursor display similar to other
+ window systems.
+ (syms_of_w32fns): Don't initialize hourglass_timer.
+
+ * xdisp.c (start_hourglass, cancel_hourglass): Now used on
+ WINDOWSNT as well.
+ (start_hourglass) [WINDOWSNT]: Call w32_note_current_window.
+
+ * w32.h (init_timers, term_timers): Add prototypes.
+
+2012-09-30 Kenichi Handa <handa@gnu.org>
+
+ * coding.c (decode_coding_ccl, encode_coding_ccl): Pay attention
+ to the buffer relocation which may be caused by ccl_driver.
+
+2012-09-30 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xfns.c (Fx_file_dialog): Update comment.
+
+ * w32fns.c (Fx_file_dialog): Update comment.
+
+ * nsfns.m (Fns_read_file_name): Add argument DIR_ONLY_P.
+ Initialize panel name field if OSX >= 10.6.
+
+ * fileio.c (Fnext_read_file_uses_dialog_p): Add HAVE_NS.
+
+ * nsfns.m (ns_frame_parm_handlers): Add x_set_fullscreen.
+
+ * nsterm.m (NEW_STYLE_FS): New define.
+ (ns_fullscreen_hook, windowWillEnterFullScreen)
+ (windowDidEnterFullScreen, windowWillExitFullScreen)
+ (windowDidExitFullScreen, toggleFullScreen, handleFS)
+ (setFSValue): New functions.
+ (EmacsFSWindow): New implementation.
+ (canBecomeKeyWindow): New function for EmacsFSWindow.
+ (ns_create_terminal): Set fullscreen_hook to ns_fullscreen_hook.
+ (dealloc): Release nonfs_window if in fullscreen.
+ (updateFrameSize:): Call windowDidMove to update top/left.
+ (windowWillResize:toSize:): Check if frame is still maximized.
+ (initFrameFromEmacs:): Initialize fs_state, fs_before_fs,
+ next_maximized, maximized_width, maximized_height and nonfs_window.
+ Call setCollectionBehavior if NEW_STYLE_FS. Initialize bwidth and
+ tbar_height.
+ (windowWillUseStandardFrame:defaultFrame:): Update frame parameter
+ fullscreen. Set maximized_width/height. Act on next_maximized.
+
+ * nsterm.h (MAC_OS_X_VERSION_10_7, MAC_OS_X_VERSION_10_8): New.
+ (EmacsView): Add variables for fullscreen.
+ (handleFS, setFSValue, toggleFullScreen): New in EmacsView.
+ (EmacsFSWindow): New interface for fullscreen.
+
+2012-09-30 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/profiler.$(O)): Update dependencies.
+
+2012-09-30 Chong Yidong <cyd@gnu.org>
+
+ * fns.c (Frandom): Doc fix.
+
+2012-09-30 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Vwindow_combination_limit): New default value.
+ (Qwindow_size): New symbol replacing Qtemp_buffer_resize.
+
+2012-09-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ * syssignal.h (PROFILER_CPU_SUPPORT): Don't define if PROFILING.
+ Suggested by Eli Zaretskii in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00811.html>.
+
+2012-09-30 Eli Zaretskii <eliz@gnu.org>
+
+ * profiler.c (Fprofiler_cpu_stop): Use timer_settime only if
+ HAVE_TIMER_SETTIME is defined.
+
+2012-09-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Profiler improvements: more-accurate timers, overflow checks.
+ * profiler.c: Don't include stdio.h, limits.h, sys/time.h,
+ signal.h, setjmp.h. Include systime.h instead.
+ (saturated_add): New function.
+ (record_backtrace, current_sample_interval): Use EMACS_INT, not size_t.
+ (record_backtrace, handle_profiler_signal): Saturate on fixnum overflow.
+ (profiler_timer, profiler_timer_ok) [HAVE_TIMER_SETTIME]:
+ New static vars.
+ (enum profiler_cpu_running): New enum.
+ (profiler_cpu_running): Now of that enum type, not bool.
+ All uses changed to store the new value.
+ (handle_profiler_signal): Rename from sigprof_handler_1,
+ for consistency with other handlers. Do not check whether
+ cpu_log is a hash-table if garbage collecting, since it
+ doesn't matter in that case.
+ (deliver_profiler_signal): Rename from sigprof_handler,
+ for consistency with other handlers.
+ (setup_cpu_timer): New function, with much of what used to be in
+ Fprofiler_cpu_start. Check for out-of-range argument.
+ Prefer timer_settime if available, and prefer
+ thread cputime clocks, then process cputime clocks, then
+ monotonic clocks, to the old realtime clock. Use make_timeval
+ to round more-correctly when falling back to setitimer.
+ (Fprofiler_cpu_start): Use it.
+ (Fprofiler_cpu_stop): Prefer timer_settime if available.
+ Don't assume that passing NULL as the 2nd argument of setitimer
+ is the same as passing a pointer to all-zero storage.
+ Ignore SIGPROF afterwards.
+ (malloc_probe): Saturate at MOST_POSITIVE_FIXNUM.
+ * sysdep.c (emacs_sigaction_init): Also mask out SIGPROF in
+ non-fatal signal handlers. Ignore SIGPROF on startup.
+ * syssignal.h (PROFILER_CPU_SUPPORT): Define this macro here, not
+ in profiler.c, since sysdep.c now uses it.
+
+ * sysdep.c (handle_fatal_signal): Bump backtrace size to 40.
+ Suggested by Eli Zaretskii in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00796.html>.
+
+2012-09-29 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/profiler.$(O)): Update dependencies.
+
+2012-09-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp.h (struct backtrace): Remove indirection for `function' field.
+ * xdisp.c (redisplay_internal):
+ * profiler.c (record_backtrace, sigprof_handler_1):
+ * alloc.c (Fgarbage_collect):
+ * eval.c (interactive_p, Fsignal, eval_sub, Ffuncall, Fbacktrace)
+ (Fbacktrace_frame): Adjust accordingly.
+
+2012-09-28 Glenn Morris <rgm@gnu.org>
+
+ * eval.c (Frun_hook_with_args, Frun_hook_with_args_until_success)
+ (Frun_hook_with_args_until_failure): Doc fixes.
+
+2012-09-28 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (syms_of_xdisp) <Qredisplay_internal>: Rename from
+ Qautomatic_redisplay and change the symbol name. All users changed.
+
+2012-09-28 Tomohiro Matsuyama <tomo@cx4a.org>
+
+ * profiler.c (sigprof_handler): Fix race condition.
+
+2012-09-28 Glenn Morris <rgm@gnu.org>
+
+ * lread.c (lisp_file_lexically_bound_p): Handle #! lines. (Bug#12528)
+
+2012-09-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Check more robustly for timer_settime.
+ * Makefile.in (LIB_TIMER_TIME): New macro.
+ (LIBES): Add it.
+ * atimer.c (alarm_timer, alarm_timer_ok, set_alarm, init_atimer):
+ Use HAVE_TIMER_SETTIME, not SIGEV_SIGNAL, to decide whether to
+ call timer_settime.
+
+2012-09-26 Tomohiro Matsuyama <tomo@cx4a.org>
+
+ * profiler.c (Fprofiler_cpu_start): Remove unnecessary flag SA_SIGINFO.
+
+2012-09-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/profiler.$(O)): Update dependencies.
+
+2012-09-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ * character.h (MAYBE_UNIFY_CHAR): Remove.
+ * charset.c, charset.h (maybe_unify_char): Now static.
+ * charset.c (decode_char): Use maybe_unify_char, not MAYBE_UNIFY_CHAR.
+ Since this stuff is now private to charset.c, there's no need for
+ a public macro and no need to inline by hand.
+
+2012-09-26 Tomohiro Matsuyama <tomo@cx4a.org>
+ Stefan Monnier <monnier@iro.umontreal.ca>
+ Juanma Barranquero <lekktu@gmail.com>
+
+ * profiler.c: New file.
+ * Makefile.in (base_obj): Add profiler.o.
+ * makefile.w32-in (OBJ2, GLOBAL_SOURCES): Add profiler.c.
+ ($(BLD)/profiler.$(O)): New target.
+ * emacs.c (main): Call syms_of_profiler.
+ * alloc.c (Qautomatic_gc): New constant.
+ (MALLOC_PROBE): New macro.
+ (xmalloc, xzalloc, xrealloc, lisp_malloc, lisp_align_malloc): Use it.
+ (total_bytes_of_live_objects): New function.
+ (Fgarbage_collect): Use it. Record itself in backtrace_list.
+ Call malloc_probe for the memory profiler.
+ (syms_of_alloc): Define Qautomatic_gc.
+ * eval.c (eval_sub, Ffuncall): Reorder assignments to avoid
+ race condition.
+ (struct backtrace): Move definition...
+ * lisp.h (struct backtrace): ..here.
+ (Qautomatic_gc, profiler_memory_running): Declare vars.
+ (malloc_probe, syms_of_profiler): Declare functions.
+ * xdisp.c (Qautomatic_redisplay): New constant.
+ (redisplay_internal): Record itself in backtrace_list.
+ (syms_of_xdisp): Define Qautomatic_redisplay.
+
+2012-09-25 Eli Zaretskii <eliz@gnu.org>
+2012-09-25 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/callproc.$(O)): Update dependencies.
+
+2012-09-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer POSIX timers if available.
+ They avoid a race if the timer is too close to the current time.
+ * atimer.c (alarm_timer, alarm_timer_ok) [SIGEV_SIGNAL]: New static vars.
+ (set_alarm) [SIGEV_SIGNAL]: Use POSIX timers if available.
+ (init_atimer) [SIGEV_SIGNAL]: Initialize them.
+
+2012-09-25 Eli Zaretskii <eliz@gnu.org>
+
+ * coding.c (CHAR_STRING_ADVANCE_NO_UNIFY): Make it an alias of
+ CHAR_STRING_ADVANCE.
+ (STRING_CHAR_ADVANCE_NO_UNIFY): Make it an alias of
+ STRING_CHAR_ADVANCE.
+
+2012-09-25 Juanma Barranquero <lekktu@gmail.com>
+
+ Move Vlibrary_cache to emacs.c and reset before dumping.
+
+ * lisp.h (reset_image_types): Declare.
+ [WINDOWSNT] (Vlibrary_cache): Declare.
+
+ * image.c (reset_image_types): New function.
+
+ * emacs.c [WINDOWSNT] (Vlibrary_cache): Move from w32.c.
+ (syms_of_emacs) [WINDOWSNT] <Vlibrary_cache>: Initialize and staticpro.
+ (Fdump_emacs): Reset Vlibrary_cache and image_types.
+
+ * w32.c (Vlibrary_cache): Do not define; moved to emacs.c
+ (globals_of_w32) <Vlibrary_cache>: Do not initialize.
+
+ * w32.h (Vlibrary_cache): Do not declare.
+
+2012-09-25 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (sys_signal): Handle all signals defined by the
+ MS-Windows runtime, not just SIGCHLD. Actually install the signal
+ handlers for signals supported by Windows. Don't override
+ term_ntproc as the handler for SIGABRT.
+ (sigaction): Rewrite to call sys_signal instead of duplicating its
+ code.
+ (sys_kill): Improve commentary.
+
+ * w32.c (term_ntproc): Accept (and ignore) one argument, for
+ consistency with a signature of a signal handler. All callers
+ changed.
+ (init_ntproc): Accept an argument DUMPING. If dumping, don't
+ install term_ntproc as a signal handler for SIGABRT, as that
+ should be done by the dumped Emacs.
+
+ * w32.h (init_ntproc, term_ntproc): Adjust prototypes.
+
+ * w32select.c (term_w32select): Protect against repeated
+ invocation by setting clipboard_owner to NULL after calling
+ DestroyWindow.
+
+ * emacs.c (shut_down_emacs, main): Adapt the calls to init_ntproc
+ and term_ntproc to their modified signatures.
+
+ * character.c (char_string, string_char): Remove calls to
+ MAYBE_UNIFY_CHAR. See the discussion starting at
+ http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00433.html
+ for the details.
+
+2012-09-25 Chong Yidong <cyd@gnu.org>
+
+ * xdisp.c (mode_line_inverse_video): Delete obsolete variable.
+
+2012-09-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * bytecode.c (exec_byte_code): Signal an error instead of aborting,
+ when encountering an unknown bytecode.
+
+2012-09-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ image.c, indent.c: Use bool for booleans.
+ * dispextern.h (struct image_type): Members valid_p, load, init
+ now return bool, not int. All uses changed.
+ * image.c: Omit unnecessary static decls.
+ (x_create_bitmap_mask, x_build_heuristic_mask):
+ Return void, not int, since callers don't care about the return value.
+ (x_create_bitmap_mask, define_image_type, valid_image_p)
+ (struct image_keyword, parse_image_spec, image_spec_value)
+ (check_image_size, image_background)
+ (image_background_transparent, x_clear_image_1)
+ (postprocess_image, lookup_image, x_check_image_size)
+ (x_create_x_image_and_pixmap, xbm_image_p)
+ (Create_Pixmap_From_Bitmap_Data, xbm_read_bitmap_data)
+ (xbm_load_image, xbm_file_p, xbm_load, xpm_lookup_color)
+ (init_xpm_functions, xpm_valid_color_symbols_p, xpm_image_p)
+ (xpm_load, xpm_load_image, lookup_rgb_color, lookup_pixel_color)
+ (x_to_xcolors, x_build_heuristic_mask, pbm_image_p, pbm_load)
+ (png_image_p, init_png_functions, png_load_body, png_load)
+ (jpeg_image_p, init_jpeg_functions, jpeg_load_body, jpeg_load)
+ (tiff_image_p, init_tiff_functions, tiff_load, gif_image_p)
+ (init_gif_functions, gif_load, imagemagick_image_p)
+ (imagemagick_load_image, imagemagick_load, svg_image_p)
+ (init_svg_functions, svg_load, svg_load_image, gs_image_p)
+ (gs_load):
+ * nsimage.m (ns_load_image):
+ * nsterm.m (ns_defined_color):
+ * xfaces.c (tty_lookup_color, tty_defined_color, defined_color):
+ * xfns.c (x_defined_color):
+ * xterm.c (x_alloc_lighter_color_for_widget)
+ (x_alloc_nearest_color_1, x_alloc_nearest_color)
+ (x_alloc_lighter_color):
+ * indent.c (disptab_matches_widthtab, current_column)
+ (scan_for_column, string_display_width, indented_beyond_p)
+ (compute_motion, vmotion, Fvertical_motion):
+ Use bool for booleans.
+
+2012-09-24 Chong Yidong <cyd@gnu.org>
+
+ * chartab.c (Fset_char_table_default): Obsolete function removed.
+
+2012-09-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Move pid_t related decls out of lisp.h.
+ * lisp.h, syswait.h (record_child_status_change, wait_for_termination)
+ (interruptible_wait_for_termination):
+ Move these decls from lisp.h to syswait.h, since they use pid_t.
+ Needed on FreeBSD; see Herbert J. Skuhra in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00571.html>.
+ * callproc.c: Include syswait.h.
+
+ gnutls.c, gtkutil.c: Use bool for boolean.
+ * gnutls.c (gnutls_global_initialized, init_gnutls_functions)
+ (emacs_gnutls_handle_error):
+ * gtkutil.c (xg_check_special_colors, xg_prepare_tooltip)
+ (xg_hide_tooltip, xg_create_frame_widgets)
+ (create_dialog, xg_uses_old_file_dialog)
+ (xg_get_file_with_chooser, xg_get_file_with_selection)
+ (xg_get_file_name, xg_have_tear_offs, create_menus, xg_create_widget)
+ (xg_item_label_same_p, xg_update_menubar)
+ (xg_modify_menubar_widgets, xg_event_is_for_menubar)
+ (xg_ignore_gtk_scrollbar, xg_set_toolkit_scroll_bar_thumb)
+ (xg_event_is_for_scrollbar, xg_pack_tool_bar, xg_make_tool_item)
+ (is_box_type, xg_tool_item_stale_p, xg_update_tool_bar_sizes)
+ (update_frame_tool_bar, free_frame_tool_bar):
+ * gtkutil.c, w32term.c, xterm.c (x_wm_set_size_hint):
+ * nsmenu.m (ns_update_menubar):
+ * nsmenu.m, w32menu.c, xmenu.c (set_frame_menubar):
+ * xfns.c (Fx_show_tip) [USE_GTK]:
+ Use bool for boolean.
+ * gtkutil.c (xg_update_frame_menubar):
+ * xmenu.c (update_frame_menubar):
+ Return void, not int, since caller ignores return value.
+ * gtkutil.c (xg_change_toolbar_position):
+ Return void, not 1.
+
+2012-09-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (BLOCKINPUT_H): Remove.
+ (SYSSIGNAL_H): New macro.
+ ($(BLD)/alloc.$(O), $(BLD)/atimer.$(O), $(BLD)/buffer.$(O))
+ ($(BLD)/callproc.$(O), $(BLD)/data.$(O), $(BLD)/dired.$(O))
+ ($(BLD)/dispnew.$(O), $(BLD)/editfns.$(O), $(BLD)/emacs.$(O))
+ ($(BLD)/eval.$(O), $(BLD)/fileio.$(O), $(BLD)/floatfns.$(O))
+ ($(BLD)/fns.$(O), $(BLD)/fontset.$(O), $(BLD)/frame.$(O))
+ ($(BLD)/fringe.$(O), $(BLD)/image.$(O), $(BLD)/insdel.$(O))
+ ($(BLD)/keyboard.$(O), $(BLD)/keymap.$(O), $(BLD)/lread.$(O))
+ ($(BLD)/menu.$(O), $(BLD)/w32inevt.$(O), $(BLD)/w32proc.$(O))
+ ($(BLD)/print.$(O), $(BLD)/process.$(O), $(BLD)/ralloc.$(O))
+ ($(BLD)/search.$(O), $(BLD)/sound.$(O), $(BLD)/sysdep.$(O))
+ ($(BLD)/term.$(O), $(BLD)/window.$(O), $(BLD)/xdisp.$(O))
+ ($(BLD)/xfaces.$(O), $(BLD)/w32fns.$(O), $(BLD)/w32menu.$(O))
+ ($(BLD)/w32term.$(O), $(BLD)/w32select.$(O), $(BLD)/w32reg.$(O))
+ ($(BLD)/w32xfns.$(O)): Update dependencies.
+
+2012-09-23 Eli Zaretskii <eliz@gnu.org>
+
+ * .gdbinit: Set breakpoint on terminate_due_to_signal, not on
+ fatal_error_backtrace.
+
+ * w32proc.c (sys_kill): Undo last change: don't do anything when
+ invoked to deliver SIGABRT to our own process. This is now
+ handled by emacs_raise.
+
+2012-09-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32term.c (w32_read_socket): Remove leftover reference to
+ interrupt_input_pending.
+
+2012-09-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not use SA_NODEFER.
+ Problem reported by Dani Moncayo in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00557.html>.
+ * alloc.c (die):
+ * sysdep.c (emacs_abort): Do not reset signal handler.
+ * emacs.c (terminate_due_to_signal): Reset signal handler here.
+ * sysdep.c (init_signals): Do not use SA_NODEFER. It wasn't
+ wanted even on POSIXish hosts, and it doesn't work on Windows.
+
+2012-09-23 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xterm.c (x_term_init): Call fixup_locale before and after calling
+ gtk_init (Bug#12392).
+
+2012-09-23 Chong Yidong <cyd@gnu.org>
+
+ * w32.c (w32_delayed_load): Remove LIBRARIES argument; always use
+ Vdynamic_library_alist.
+
+ * gnutls.c (init_gnutls_functions): Caller changed; remove arg.
+ (Fgnutls_available_p): Caller changed.
+
+ * xml.c (init_libxml2_functions, Flibxml_parse_html_region)
+ (Flibxml_parse_xml_region): Likewise.
+
+ * dispextern.h (struct image_type): Remove arg from init function.
+
+ * image.c (Finit_image_library, lookup_image_type)
+ (define_image_type): Remove now-unneeded second arg.
+ (init_xpm_functions, init_png_functions, init_jpeg_functions)
+ (init_tiff_functions, init_gif_functions, init_svg_functions):
+ Arglist and w32_delayed_load calling convention changed.
+ (gs_type): Remove init_gs_functions; there is no such function.
+ (valid_image_p, make_image): Fix caller to lookup_image_type.
+
+2012-09-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify and avoid signal-handling races (Bug#12471).
+ * alloc.c (die):
+ * sysdep.c (emacs_abort) [HAVE_NTGUI]:
+ Avoid recursive loop if there's a fatal error in the function itself.
+ * atimer.c (pending_atimers):
+ * blockinput.h: Don't include "atimer.h"; no longer needed.
+ (interrupt_input_pending): Remove. All uses removed.
+ pending_signals now counts both atimers and ordinary interrupts.
+ This is less racy than having three separate pending-signal flags.
+ (block_input, unblock_input, totally_unblock_input, unblock_input_to)
+ (input_blocked_p):
+ Rename from their upper-case counterparts BLOCK_INPUT,
+ UNBLOCK_INPUT, TOTALLY_UNBLOCK_INPUT, UNBLOCK_INPUT_TO,
+ INPUT_BLOCKED_P, and turn into functions. All uses changed.
+ This makes it easier to access volatile variables more accurately.
+ (BLOCK_INPUT_RESIGNAL): Remove. All uses replaced by unblock_input ().
+ (input_blocked_p): Prefer this to 'interrupt_input_blocked', as
+ that's more reliable if the code is buggy and sets
+ interrupt_input_blocked to a negative value. All uses changed.
+ * atimer.c (deliver_alarm_signal):
+ Remove. No need to deliver this to the parent; any thread can
+ handle this signal now. All uses replaced by underlying handler.
+ * atimer.c (turn_on_atimers):
+ * dispnew.c (handle_window_change_signal):
+ * emacs.c (handle_danger_signal):
+ * keyboard.c (kbd_buffer_get_event):
+ Don't reestablish signal handler; not needed with sigaction.
+ * blockinput.h (UNBLOCK_INPUT_TO, TOTALLY_UNBLOCK_INPUT)
+ (UNBLOCK_INPUT_TO):
+ Rework to avoid unnecessary accesses to volatile variables.
+ (UNBLOCK_INPUT_TO): Now a function.
+ (totally_unblock_input, unblock_input): New decls.
+ * data.c (handle_arith_signal, deliver_arith_signal): Move to sysdep.c
+ (init_data): Remove. Necessary stuff now done in init_signal.
+ * emacs.c, xdisp.c: Include "atimer.h", since we invoke atimer functions.
+ * emacs.c (handle_fatal_signal, deliver_fatal_signal): Move to sysdep.c.
+ (fatal_error_code): Remove; no longer needed.
+ (terminate_due_to_signal): Rename from fatal_error_backtrace, since
+ it doesn't always backtrace. All uses changed. No need to reset
+ signal to default, since sigaction and/or die does that for us now.
+ Use emacs_raise (FOO), not kill (getpid (), FOO).
+ (main): Check more-accurately whether we're dumping.
+ Move fatal-error setup to sysdep.c
+ * floatfns.c: Do not include "syssignal.h"; no longer needed.
+ * gtkutil.c (xg_get_file_name, xg_get_font):
+ Remove no-longer-needed signal-mask manipulation.
+ * keyboard.c, process.c (POLL_FOR_INPUT):
+ Don't depend on USE_ASYNC_EVENTS, a symbol that is never defined.
+ * keyboard.c (read_avail_input): Remove.
+ All uses replaced by gobble_input.
+ (Ftop_level): Use TOTALLY_UNBLOCK_INPUT rather than open code.
+ (kbd_buffer_store_event_hold, gobble_input):
+ (record_asynch_buffer_change) [USABLE_SIGIO]:
+ (store_user_signal_events):
+ No need to mess with signal mask.
+ (gobble_input): If blocking input and there are terminals, simply
+ set pending_signals to 1 and return. All hooks changed to not
+ worry about whether input is blocked.
+ (process_pending_signals): Clear pending_signals before processing
+ them, in case a signal comes in while we're processing.
+ By convention callers now test pending_signals before calling us.
+ (UNBLOCK_INPUT_TO, unblock_input, totally_unblock_input):
+ New functions, to support changes to blockinput.h.
+ (handle_input_available_signal): Now extern.
+ (reinvoke_input_signal): Remove. All uses replaced by
+ handle_async_input.
+ (quit_count): Now volatile, since a signal handler uses it.
+ (handle_interrupt): Now takes bool IN_SIGNAL_HANDLER as arg.
+ All callers changed. Block SIGINT only if not already blocked.
+ Clear sigmask reliably, even if Fsignal returns, which it can.
+ Omit unnecessary accesses to volatile var.
+ (quit_throw_to_read_char): No need to restore sigmask.
+ * keyboard.c (gobble_input, handle_user_signal):
+ * process.c (wait_reading_process_output):
+ Call signal-handling code rather than killing ourselves.
+ * lisp.h: Include <float.h>, for...
+ (IEEE_FLOATING_POINT): New macro, moved here to avoid duplication.
+ (pending_signals): Now volatile.
+ (syms_of_data): Now const if IEEE floating point.
+ (handle_input_available_signal) [USABLE_SIGIO]:
+ (terminate_due_to_signal, record_child_status_change): New decls.
+ * process.c (create_process): Avoid disaster if memory is exhausted
+ while we're processing a vfork, by tightening the critical section
+ around the vfork.
+ (send_process_frame, process_sent_to, handle_pipe_signal)
+ (deliver_pipe_signal): Remove. No longer needed, as Emacs now
+ ignores SIGPIPE.
+ (send_process): No need for setjmp/longjmp any more, since the
+ SIGPIPE stuff is now gone. Instead, report an error if errno
+ is EPIPE.
+ (record_child_status_change): Now extern. PID and W are now args.
+ Return void, not bool. All callers changed.
+ * sysdep.c (wait_debugging) [(BSD_SYSTEM || HPUX) && !defined (__GNU__)]:
+ Remove. All uses removed. This bug should be fixed now in a
+ different way.
+ (wait_for_termination_1): Use waitpid rather than sigsuspend,
+ and record the child status change directly. This avoids the
+ need to futz with the signal mask.
+ (process_fatal_action): Move here from emacs.c.
+ (emacs_sigaction_flags): New function, containing
+ much of what used to be in emacs_sigaction_init.
+ (emacs_sigaction_init): Use it. Block nonfatal system signals that are
+ caught by emacs, to make races less likely.
+ (deliver_process_signal): Rename from handle_on_main_thread.
+ All uses changed.
+ (BACKTRACE_LIMIT_MAX): Now at top level.
+ (thread_backtrace_buffer, threadback_backtrace_pointers):
+ New static vars.
+ (deliver_thread_signal, deliver_fatal_thread_signal):
+ New functions, for more-accurate delivery of thread-specific signals.
+ (handle_fatal_signal, deliver_fatal_signal): Move here from emacs.c.
+ (deliver_arith_signal): Handle in this thread, not
+ in the main thread, since it's triggered by this thread.
+ (maybe_fatal_sig): New function.
+ (init_signals): New arg DUMPING so that we can be more accurate
+ about whether we're dumping. Caller changed.
+ Treat thread-specific signals differently from process-general signals.
+ Block all signals while handling fatal error; that's safer.
+ xsignal from SIGFPE only on non-IEEE hosts, treating it as fatal
+ on IEEE hosts.
+ When batch, ignore SIGHUP, SIGINT, SIGTERM if they were already ignored.
+ Ignore SIGPIPE unless batch.
+ (emacs_backtrace): Output backtrace for the appropriate thread,
+ which is not necessarily the main thread.
+ * syssignal.h: Include <stdbool.h>.
+ (emacs_raise): New macro.
+ * xterm.c (x_connection_signal): Remove; no longer needed
+ now that we use sigaction.
+ (x_connection_closed): No need to mess with sigmask now.
+ (x_initialize): No need to reset SIGPIPE handler here, since
+ init_signals does this for us now.
+
+2012-09-23 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_dumpglyphs_image): dr is a new rect to draw image into,
+ background rect may be larger (Bug#12245).
+
+2012-09-23 Chong Yidong <cyd@gnu.org>
+
+ * keyboard.c (timer_check): Avoid quitting during Fcopy_sequence.
+
+2012-09-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * .gdbinit: Just stop at fatal_error_backtrace.
+ See Stefan Monnier's request in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00549.html>.
+ Remove no-longer-used query of system type.
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * search.c (Freplace_match): Doc fix (Bug#12325).
+
+ * minibuf.c (Finternal_complete_buffer): Doc fix (Bug#12391).
+
+ * editfns.c (Fline_beginning_position): Doc fix (Bug#12416).
+ (Fline_end_position): Doc fix.
+
+ * cmds.c (Fforward_char, Fbackward_char): Doc fix (Bug#12414).
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * dispextern.h (struct image_type): Add new slot, storing a type
+ initialization function.
+
+ * image.c (define_image_type): Call the image initializer function
+ if it is defined. Arguments and return value changed.
+ (valid_image_p, make_image): Callers changed.
+ (xbm_type, xpm_type, pbm_type, png_type, jpeg_type, tiff_type)
+ (gif_type, imagemagick_type, svg_type, gs_type):
+ Add initialization functions.
+ (Finit_image_library): Call lookup_image_type.
+ (CHECK_LIB_AVAILABLE): Macro deleted.
+ (lookup_image_type): Call define_image_type here, rather than via
+ Finit_image_library, and without using CHECK_LIB_AVAILABLE.
+ (syms_of_image): Move define_image_type calls for xbm_type and
+ pbm_type to lookup_image_type.
+
+2012-09-22 Eli Zaretskii <eliz@gnu.org>
+
+ * keyboard.c (timer_check_2): Move calculation of 'timers' and
+ 'idle_timers' from here ...
+ (timer_check): ... to here. Use Fcopy_sequence to copy the timer
+ lists, to avoid infloops when the timer does something stupid,
+ like reinvoke itself with the same or smaller time-out.
+ (Bug#12447)
+
+2012-09-22 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fsplit_window_internal): Handle only Qt value of
+ Vwindow_combination_limit separately.
+ (Qtemp_buffer_resize): New symbol.
+ (Vwindow_combination_limit): New default value.
+ Rewrite doc-string.
+
+2012-09-22 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (next_overlay_string): Initialize it->end_charpos for
+ the new overlay string. (Bug#10159)
+
+2012-09-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * emacs.c (shut_down_emacs): Don't assume stderr is buffered,
+ or that fprintf is async-signal-safe. POSIX doesn't require
+ either assumption.
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * buffer.c (Fset_buffer_modified_p): Handle indirect buffers
+ (Bug#8207).
+
+2012-09-22 Kenichi Handa <handa@gnu.org>
+
+ * composite.c (composition_reseat_it): Handle the case that a
+ grapheme cluster is not covered by a single font (Bug#12352).
+
+2012-09-21 Chong Yidong <cyd@gnu.org>
+
+ * image.c (define_image_type): Avoid adding duplicate types to
+ image_types (Bug#12463). Suggested by Jörg Walter.
+
+2012-09-21 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * unexmacosx.c: Define LC_DATA_IN_CODE if not defined.
+ (print_load_command_name): Add case LC_DATA_IN_CODE.
+ (dump_it) [LC_DATA_IN_CODE]: Call copy_linkedit_data.
+
+2012-09-21 Glenn Morris <rgm@gnu.org>
+
+ * eval.c (Frun_hook_with_args_until_success)
+ (Frun_hook_with_args_until_failure): Doc fixes. (Bug#12393)
+
+2012-09-21 Andreas Schwab <schwab@linux-m68k.org>
+
+ * fileio.c (Ffile_selinux_context): Only call freecon when
+ lgetfilecon succeeded.
+ (Fset_file_selinux_context): Likewise. (Bug#12444)
+
+2012-09-21 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (try_window_reusing_current_matrix): Under bidi
+ reordering, locate the cursor by calling set_cursor_from_row; if
+ that fails, clear the desired glyph matrix before returning a
+ failure indication to the caller. Fixes leaving garbled display
+ when fast scrolling with a down-key. (Bug#12403)
+ (compute_stop_pos_backwards): Fix a typo that caused crashes while
+ scrolling through multibyte text.
+
+2012-09-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * alloc.c (mark_object) <PVEC_WINDOW>: Mark prev/next_buffers *after*
+ calling mark_vectorlike since that's the one that marks the window.
+ (mark_discard_killed_buffers): Mark the final cdr.
+ * window.h (struct window): Move prev/next_buffers to the
+ non-standard fields.
+ * window.c (make_window): Initialize prev/next_buffers manually.
+
+2012-09-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Omit unused arg EXPECTED from socket hooks.
+ * keyboard.c (gobble_input, read_avail_input, tty_read_avail_input):
+ * nsterm.m (ns_term_init):
+ * termhooks.h (struct terminal.read_socket_hook):
+ * w32inevt.c (w32_console_read_socket):
+ * w32term.c (w32_read_socket):
+ * xterm.c (XTread_socket):
+ Omit unused arg EXPECTED. All callers changed.
+ (store_user_signal_events): Return void, not int, since callers no
+ longer care about the return value. All uses changed.
+
+2012-09-20 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32gui.h (XParseGeometry): Do not declare.
+
+2012-09-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * w32inevt.c (w32_console_read_socket): Return -1 on failure, not 0.
+ Ignore 'expected'. See Eli Zaretskii in
+ <http://bugs.gnu.org/12471#8> (last line).
+
+ * frame.c (read_integer): Remove. All uses replaced by strtol/strtoul.
+ (XParseGeometry): Now static. Substitute extremal values for
+ values that are out of range.
+
+2012-09-19 Jan Djärv <jan.h.d@swipnet.se>
+
+ * w32xfns.c (read_integer, XParseGeometry): Move to frame.c.
+
+ * nsfns.m (XParseGeometry): Remove.
+ (Fx_create_frame): Call x_set_offset to correctly interpret
+ top_pos in geometry.
+
+ * frame.c (read_integer, XParseGeometry): Move from w32xfns.c.
+ (Fx_parse_geometry): If there is a space in string, call
+ Qns_parse_geometry, otherwise do as on other terms (Bug#12368).
+
+2012-09-17 Eli Zaretskii <eliz@gnu.org>
+
+ * search.c (scan_buffer): Use character positions in calls to
+ region_cache_forward and region_cache_backward, not byte
+ positions. (Bug#12196)
+
+ * w32term.c (w32_read_socket): Set pending_signals to 1, like
+ xterm.c does. Reported by Daniel Colascione <dancol@dancol.org>.
+
+ * ralloc.c (r_alloc_init) [!SYSTEM_MALLOC]: Initialize
+ __malloc_extra_blocks to 32 instead of 64, like alloc.c did in
+ emacs_blocked_malloc, now deleted.
+
+2012-09-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove no-longer-needed Solaris 2.4 vfork bug workaround.
+ The workaround was for improving performance on Solaris 2.4, but
+ is getting in the way now. Emacs will still work if someone is
+ still running Solaris 2.4 in a museum somewhere; Sun dropped
+ support for Solaris 2.4 in 2003.
+ * callproc.c (Fcall_process) [HAVE_WORKING_VFORK]:
+ * process.c (create_process) [HAVE_WORKING_VFORK]:
+ Omit now-unnecessary workaround for the Solaris 2.4 vfork bug,
+ since Emacs no longer uses vfork on that platform.
+
+2012-09-17 Glenn Morris <rgm@gnu.org>
+
+ * emacs.c: Use COPYRIGHT.
+
+2012-09-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove configure's --without-sync-input option (Bug#12450).
+ When auditing signal-handling in preparation for cleaning it up,
+ I found that SYNC_INPUT has race conditions and would be a real
+ pain to fix. Since it's an undocumented and deprecated
+ configure-time option, now seems like a good time to remove it.
+ Also see <http://bugs.gnu.org/11080#16>.
+ * alloc.c (_bytes_used, __malloc_extra_blocks, _malloc_internal)
+ (_free_internal) [!DOUG_LEA_MALLOC]: Remove decls.
+ (alloc_mutex) [!SYSTEM_MALLOC && !SYNC_INPUT && HAVE_PTHREAD]:
+ (malloc_hysteresis):
+ (check_depth) [XMALLOC_OVERRUN_CHECK]:
+ (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT):
+ (__malloc_hook, __realloc_hook, __free_hook, BYTES_USED)
+ (dont_register_blocks, bytes_used_when_reconsidered)
+ (bytes_used_when_full, emacs_blocked_free, emacs_blocked_malloc)
+ (emacs_blocked_realloc, reset_malloc_hooks, uninterrupt_malloc):
+ [!SYSTEM_MALLOC && !SYNC_INPUT]:
+ Remove. All uses removed.
+ (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): Use a different
+ implementation, one that depends on whether the new macro
+ XMALLOC_BLOCK_INPUT_CHECK is defined, not on whether SYNC_INPUT
+ is defined.
+ * atimer.c (run_timers, handle_alarm_signal):
+ * keyboard.c (pending_signal, poll_for_input_1, poll_for_input)
+ (handle_async_input, process_pending_signals)
+ (handle_input_available_signal, init_keyboard):
+ * nsterm.m (ns_read_socket):
+ * process.c (wait_reading_process_output):
+ * regex.c (immediate_quit, IMMEDIATE_QUIT_CHECK):
+ * sysdep.c (emacs_sigaction_init) [SA_RESTART]:
+ (emacs_write):
+ * xterm.c (XTread_socket):
+ Assume SYNC_INPUT.
+ * conf_post.h (SA_RESTART) [IRIX6_5]: Do not #undef.
+ * eval.c (handling_signal): Remove. All uses removed.
+ * lisp.h (ELSE_PENDING_SIGNALS): Remove.
+ All uses replaced with the SYNC_INPUT version.
+ (reset_malloc_hooks, uninterrupt_malloc, handling_signal):
+ Remove decls.
+ * sysdep.c, syssignal.h (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]:
+ Now static.
+
+ * font.c (Ffont_shape_gstring): Remove unused local.
+
+2012-09-16 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (clean): No longer run nextstep's clean.
+
+ * Makefile.in (ns_appdir, ns_appbindir, ns_appsrc): Remove variables.
+ (ns_frag): Remove.
+ (ns-app): Move here from ns.mk, and simplify.
+ (clean): Simplify nextstep entry.
+ * ns.mk: Remove file.
+
+2012-09-17 Kenichi Handa <handa@gnu.org>
+
+ * font.c (Ffont_shape_gstring): Fix previous change; GLYPHs may
+ not covert the last few charactes.
+
+2012-09-16 Kenichi Handa <handa@gnu.org>
+
+ * font.c (Ffont_shape_gstring): Don't adjust grapheme cluster
+ here, but just check the validity of glyphs in the glyph-string.
+
+2012-09-16 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fwindow_parameter, Fset_window_parameter):
+ Accept any window as argument (Bug#12452).
+
+2012-09-16 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsfns.m (Fx_open_connection): Move initialization of ns_*_types
+ to ns_term_init to avoid memory leak.
+
+ * nsterm.m (ns_update_begin): Initialize bp after lcokFocus, use
+ explicit retain/release.
+ (ns_term_init): Only allow one display. Initialize outerpool and
+ ns_*_types.
+
+2012-09-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port _setjmp fix to POSIXish hosts as well as Microsoft.
+ * image.c (_setjmp) [!HAVE__SETJMP]: Restore definition, as
+ it's needed on POSIXish hosts that lack _setjmp. Attempt to solve
+ the Microsoft problem in a different way, by altering ../nt/config.nt.
+
+2012-09-15 Eli Zaretskii <eliz@gnu.org>
+
+ * w32xfns.c:
+ * w32uniscribe.c:
+ * w32term.c:
+ * w32select.c:
+ * w32reg.c:
+ * w32proc.c:
+ * w32menu.c:
+ * w32inevt.c:
+ * w32heap.c:
+ * w32font.c:
+ * w32fns.c:
+ * w32console.c:
+ * w32.c:
+ * w16select.c: Remove inclusion of setjmp.h, as it is now included
+ by lisp.h. This completes removal of setjmp.h inclusion
+ erroneously announced in the previous commit. (Bug#12446)
+
+ * lisp.h [!HAVE__SETJMP, !HAVE_SIGSETJMP]: Make the commentary
+ more accurate.
+
+ * image.c (_setjmp) [!HAVE__SETJMP]: Define only if 'setjmp' is
+ not defined as a macro. The latter happens on MS-Windows.
+ (Bug#12446)
+
+2012-09-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port better to POSIX hosts lacking _setjmp (Bug#12446).
+ * lisp.h: Include <setjmp.h> here, since we use its symbols here.
+ Some instances of '#include <setjmp.h>' removed, if the
+ only reason for the instance was because "lisp.h" was included.
+ (sys_jmp_buf, sys_setjmp, sys_longjmp): New symbols.
+ Unless otherwise specified, replace all uses of jmp_buf, _setjmp,
+ and _longjmp with the new symbols. Emacs already uses _setjmp if
+ available, so this change affects only POSIXish hosts that have
+ sigsetjmp but not _setjmp, such as some versions of Solaris and
+ Unixware. (Also, POSIX-2008 marks _setjmp as obsolescent.)
+ * image.c (_setjmp, _longjmp) [HAVE_PNG && !HAVE__SETJMP]: New macros.
+ (png_load_body) [HAVE_PNG]:
+ (PNG_LONGJMP) [HAVE_PNG && PNG_LIBPNG_VER < 10500]:
+ (PNG_JMPBUF) [HAVE_PNG && PNG_LIBPNG_VER >= 10500]:
+ Use _setjmp and _longjmp rather than sys_setjmp and sys_longjmp,
+ since PNG requires jmp_buf. This is the only exception to the
+ general rule that we now use sys_setjmp and sys_longjmp.
+ This exception is OK since this code does not change the signal
+ mask or longjmp out of a signal handler.
+
+2012-09-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c [!SYSTEM_MALLOC && !SYNC_INPUT && HAVE_PTHREAD]:
+ Include "syssignal.h", for 'main_thread'.
+
+2012-09-14 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid out-of-range marker position (Bug#12426).
+ * insdel.c (replace_range, replace_range_2):
+ Adjust markers before overlays, as suggested by comments.
+ (insert_1_both, insert_from_buffer_1, adjust_after_replace):
+ Remove redundant check before calling offset_intervals.
+
+2012-09-14 Martin Rudalics <rudalics@gmx.at>
+
+ * xdisp.c (Fformat_mode_line): Unconditionally save/restore
+ current buffer (Bug#12387).
+
+2012-09-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/alloc.$(O)): Update dependencies.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use a more backwards-compatible timer format (Bug#12430).
+ * keyboard.c (decode_timer): Get PSECS from the 8th (origin-0)
+ vector element, not from the 4th, since PSECS is now at the end.
+ (Fcurrent_idle_time): Doc fix.
+
+2012-09-13 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Function to mark objects and remove killed buffers at once.
+ * alloc.c (discard_killed_buffers): Rename to ...
+ (mark_discard_killed buffers) ... new name. Add marking
+ of remaining objects. Fix comment. Adjust users.
+ (mark_object): Do not touch frame buffer lists here.
+ * frame.c (delete_frame): Reset frame buffer lists here.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better workaround for GNOME bug when --enable-gcc-warnings.
+ * emacsgtkfixed.c (G_STATIC_ASSERT): Remove, undoing last change.
+ Instead, disable -Wunused-local-typedefs. See Dmitry Antipov in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00335.html>.
+
+ Simplify SIGIO usage (Bug#12408).
+ The code that dealt with SIGIO was crufty and confusing, e.g., it
+ played tricks like "#undef SIGIO" but these tricks were not used
+ consistently. Simplify mostly by not #undeffing standard symbols,
+ e.g., use "defined USABLE_SIGIO" (our symbol, which we can define
+ or not as we please) rather than "defined SIGIO" (standard symbol
+ that we probably shouldn't #undef).
+ * conf_post.h [USG5_4]: Do not include <sys/wait.h> here.
+ Modules that need it can include it.
+ [USG5_4 && emacs]: Likewise, do not include the streams stuff here.
+ * dispextern.h (ignore_sigio): New decl.
+ * emacs.c (shut_down_emacs): Invoke unrequest_sigio
+ unconditionally, since it's now a no-op if !USABLE_SIGIO.
+ * emacs.c (shut_down_emacs):
+ * keyboard.c (kbd_buffer_store_event_hold):
+ Use ignore_sigio rather than invoking 'signal' directly.
+ * keyboard.c (USABLE_FIONREAD && USG5_4): Include <sys/filio.h>,
+ for FIONREAD.
+ (FIONREAD, SIGIO): Do not #undef.
+ (tty_read_avail_input): Use #error rather than a syntax error.
+ * process.c [USG5_4]: Include <sys/stream.h> and <sys/stropts.h>,
+ for I_PIPE, used by SETUP_SLAVE_PTY.
+ (DATAGRAM_SOCKETS): Simplify defn, based on USABLE_FIONREAD.
+ * sysdep.c (croak): Remove; no longer needed. This bit of
+ temporary code, with Fred N. Fish's comment that it's temporary,
+ has been in Emacs since at least 1992!
+ (init_sigio, reset_sigio, request_sigio, unrequest_sigio):
+ Arrange for them to be no-ops in all cases when ! USABLE_SIGIO.
+ * syssignal.h (croak): Remove decl.
+ (SIGIO, SIGPOO, SIGAIO, SIGPTY): Do not #undef; that's too fragile.
+ * systty.h [!NO_TERMIO]: Do not include <termio.h>; no longer needed
+ now that we're termios-only.
+ (FIONREAD, ASYNC) [BROKEN_FIONREAD]: Do not #undef.
+ * term.c (dissociate_if_controlling_tty): Use #error rather than
+ a run-time error.
+
+ Work around GCC and GNOME bugs when --enable-gcc-warnings.
+ * emacsgtkfixed.c (G_STATIC_ASSERT): Redefine to use 'verify',
+ to work around GNOME bug 683906.
+ * image.c (jpeg_load_body) [HAVE_JPEG && lint]: Pacify gcc -Wclobber.
+ (struct my_jpeg_error_mgr) [HAVE_JPEG && lint]: New member fp.
+ This works around GCC bug 54561.
+
+2012-09-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ More fixes for 'volatile' and setjmp/longjmp.
+ * eval.c (Fdefvar, Fcondition_case): Remove unnecessary 'volatile's.
+ * image.c (struct png_load_context) [HAVE_PNG]: New type.
+ (png_load_body) [HAVE_PNG]:
+ (jpeg_load_body) [HAVE_JPEG]:
+ New function, with most of the old parent function's body.
+ (png_load) [HAVE_PNG]:
+ (jpeg_load) [HAVE_JPEG]:
+ Invoke the new function, to avoid longjmp munging our locals.
+ (struct my_jpeg_error_mgr) [HAVE_JPEG]: New members cinfo, failure_code.
+ (my_error_exit) [HAVE_JPEG]: Don't trust 'setjmp' to return 2 when
+ longjmp is passed 2, as the C standard doesn't guarantee this.
+ Instead, store the failure code into mgr->failure_code.
+
+2012-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * keyboard.c (read_char, requeued_events_pending_p, Finput_pending_p)
+ (Fdiscard_input, quit_throw_to_read_char, init_keyboard)
+ (syms_of_keyboard): Remove support for unread-command-char.
+
+2012-09-12 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (sys_kill): If PID is our process ID and the signal is
+ SIGABRT, call emacs_abort. Avoids silently exiting upon assertion
+ violation. (Bug#12426)
+
+2012-09-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * image.c (jpeg_memory_src): Don't assume string len fits in unsigned.
+
+2012-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c: Add `inhibit-debugger'.
+ (Qinhibit_debugger): New symbol.
+ (call_debugger): Bind it instead of Qdebug_on_error.
+ (maybe_call_debugger): Test Vinhibit_debugger.
+ (syms_of_eval): Define inhibit-debugger.
+ * xdisp.c (set_message): Don't bind Qinhibit_debug_on_message.
+ (syms_of_xdisp): Remove inhibit-debug-on-message.
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid _setjmp/_longjmp problems with local nonvolatile variables.
+ If a nonvolatile local variable is written before a _longjmp to
+ the frame containing the variable, and is read after the _longjmp,
+ the value read is indeterminate. Some local variables of type
+ 'struct handler' and 'struct catchtag' are used in this way, so
+ mark each of their slots as volatile if the slot can be set before
+ _longjmp and read afterwards.
+ * lisp.h (struct handler): var and chosen_clause are now volatile.
+ (struct catchtag): val, next, and pdlcount are now volatile.
+
+ * bidi.c (bidi_push_it, bidi_pop_it):
+ * fns.c (copy_hash_table):
+ * image.c (define_image_type):
+ * keyboard.c (kbd_buffer_store_event_hold):
+ * process.c (Fprocess_send_eof):
+ * xfaces.c (x_create_gc) [HAVE_NS]:
+ * xgselect.c (xg_select):
+ Prefer assignment to memcpy when either will do.
+
+ * alloc.c (discard_killed_buffers): Tune and simplify a bit.
+ Use pointer-to-a-pointer to simplify and avoid a NILP check each
+ time an item is removed. No need to mark this function 'inline';
+ the compiler knows better than we do.
+
+2012-09-11 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_judge_scroll_bars): Pass NO to updateFrameSize.
+ (updateFrameSize:): Add delay parameter to updateFrameSize, send it
+ to change_frame_size (Bug#12388).
+ (windowDidResize:): Pass YES to updateFrameSize.
+
+ * nsterm.h: Add delay parameter to updateFrameSize.
+
+2012-09-11 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Discard killed buffers from deleted window and frame objects.
+ This reduces an amount of references to killed buffers and
+ helps GC to reclaim them faster.
+ * alloc.c (discard_killed_buffers): New function.
+ (mark_object): Use it for deleted windows and frames.
+ (mark_object): If symbol's value is set up for a killed buffer
+ or deleted frame, restore its global binding.
+ * data.c (swap_in_global_binding): Add GC notice.
+ (swap_in_symval_forwarding): Use convenient set_blv_where.
+ * window.c (wset_next_buffers, wset_prev_buffers): Move ...
+ * window.h: ... to here.
+
+2012-09-11 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Convenient macro to check whether the buffer is live.
+ * buffer.h (BUFFER_LIVE_P): New macro.
+ * alloc.c, buffer.c, editfns.c, insdel.c, lread.c, marker.c:
+ * minibuf.c, print.c, process.c, window.c, xdisp.c: Use it.
+
+2012-09-11 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * xdisp.c (right_overwritten, right_overwriting): Also handle gstring
+ composition cases (Bug#12364).
+
+ * xterm.c (x_draw_glyph_string): Avoid overwriting inverted left
+ overhang of succeeding glyphs overlapping box cursor.
+
+ * w32term.c (x_draw_glyph_string): Likewise.
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify, document, and port floating-point (Bug#12381).
+ The porting part of this patch fixes bugs on non-IEEE platforms
+ with frexp, ldexp, logb.
+ * data.c, lisp.h (Qdomain_error, Qsingularity_error, Qunderflow_error):
+ Now static.
+ * floatfns.c: Simplify discussion of functions that Emacs doesn't
+ support, by removing commented-out code and briefly listing the
+ C89 functions excluded. The commented-out stuff was confusing
+ maintenance, e.g., we thought we needed cbrt but it was commented out.
+ (logb): Remove decl; no longer needed.
+ (isfinite): New macro, if not already supplied.
+ (isnan): Don't replace any existing macro.
+ (Ffrexp, Fldexp): Define even if !HAVE_COPYSIGN, as frexp and ldexp
+ are present on all C89 platforms.
+ (Ffrexp): Do not special-case zero, as frexp does the right thing
+ for that case.
+ (Flogb): Do not use logb, as it doesn't have the desired meaning
+ on hosts that use non-base-2 floating point. Instead, stick with
+ frexp, which is C89 anyway. Do not pass an infinity or a NaN to
+ frexp, to avoid getting an unspecified result.
+
+ * xdisp.c (Qinhibit_debug_on_message): Now static.
+
+2012-09-10 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_update_begin): Set clip path to whole view by using
+ NSBezierPath (Bug#12131).
+
+2012-09-10 Chong Yidong <cyd@gnu.org>
+
+ * fns.c (Fdelq, Fdelete): Doc fix.
+
+2012-09-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h (XSETINT, XSETCONS, XSETVECTOR, XSETSTRING, XSETSYMBOL)
+ (XSETFLOAT, XSETMISC): Parenthesize macro bodies.
+
+2012-09-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp.h (make_lisp_ptr): New macro to replace XSET.
+ (XSETCONS, XSETVECTOR, XSETSTRING, XSETSYMBOL, XSETFLOAT, XSETMISC):
+ Use it.
+
+2012-09-09 Eli Zaretskii <eliz@gnu.org>
+
+ * fringe.c (draw_fringe_bitmap_1): Don't reduce the width of the
+ left fringe if the window has a left margin. This avoids leaving
+ traces of the cursor because its leftmost pixel is not drawn over.
+
+ * dispnew.c (update_window_line): When the left margin area of a
+ screen line is updated, set the redraw_fringe_bitmaps_p flag of
+ that screen line. (Bug#12277)
+
+2012-09-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume C89 or later for math functions (Bug#12381).
+ This simplifies the code, and makes it a bit smaller and faster,
+ and (most important) makes it easier to clean up signal handling
+ since we can stop worring about floating-point exceptions in
+ library code. That was a problem before C89, but the problem
+ went away many years ago on all practical Emacs targets.
+ * data.c, image.c, lread.c, print.c:
+ Don't include <math.h>; no longer needed.
+ * data.c, floatfns.c (IEEE_FLOATING_POINT): Don't worry that it
+ might be autoconfigured, as that never happens.
+ * data.c (fmod):
+ * doprnt.c (DBL_MAX_10_EXP):
+ * print.c (DBL_DIG):
+ Remove. C89 or later always defines these.
+ * floatfns.c (HAVE_MATHERR, FLOAT_CHECK_ERRNO, FLOAT_CHECK_DOMAIN)
+ (in_float, float_error_arg, float_error_arg2, float_error_fn_name)
+ (arith_error, domain_error, domain_error2):
+ Remove all this pre-C89 cruft. Do not include <errno.h> as that's
+ no longer needed -- we simply return what C returns. All uses removed.
+ (IN_FLOAT, IN_FLOAT2): Remove. All uses replaced with
+ the wrapped code.
+ (FLOAT_TO_INT, FLOAT_TO_INT2, range_error, range_error2):
+ Remove. All uses expanded, as these macros are no longer used
+ more than once and are now more trouble than they're worth.
+ (Ftan): Use tan, not sin / cos.
+ (Flogb): Assume C89 frexp.
+ (fmod_float): Assume C89 fmod.
+ (matherr) [HAVE_MATHERR]: Remove; no longer needed.
+ (init_floatfns): Remove. All uses removed.
+
+2012-09-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_draw_fringe_bitmap, ns_dumpglyphs_image): Take back
+ compositeToPoint for OSX < 10.6 (Bug#12390).
+
+2012-09-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ * floatfns.c (Ftan): Use tan (x), not (sin (x) / cos (x)).
+ This produces more-accurate results.
+
+2012-09-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (updateFrameSize): Call setFrame: on the view when size
+ changes (Bug#12088).
+
+2012-09-08 Chong Yidong <cyd@gnu.org>
+
+ * syntax.c (Fstring_to_syntax): Doc fix.
+
+2012-09-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_clip_to_row): Remove code that deals with drawing fringe
+ in the internal border.
+ (x_set_window_size): Remove static variables and their usage.
+ (ns_redraw_scroll_bars): Fix NSTRACE arg.
+ (ns_after_update_window_line, ns_draw_fringe_bitmap):
+ Remove fringe/internal border adjustment (Bug#11052).
+ (ns_draw_fringe_bitmap): Make code more like other terms (xterm.c).
+ (ns_draw_window_cursor): Remove fringe/internal border adjustment.
+ (ns_fix_rect_ibw): Remove.
+ (ns_get_glyph_string_clip_rect): Remove call to ns_fix_rect_ibw.
+ (ns_dumpglyphs_box_or_relief): Ditto.
+ (ns_maybe_dumpglyphs_background): Remove fringe/internal border
+ adjustment.
+ (ns_dumpglyphs_image): Ditto.
+ (ns_dumpglyphs_stretch): Fix coding style. Remove fringe/internal
+ border adjustment.
+ (ns_set_vertical_scroll_bar): Remove variables barOnVeryLeft/Right and
+ their usage. Add fringe_extended_p and its use as in other terms.
+ (ns_judge_scroll_bars): Code style fix. Call updateFrameSize if
+ scroll bar was removed.
+ (updateFrameSize): New function.
+ (windowDidResize): Move code to updateFrameSize and call it.
+
+ * nsterm.h (EmacsView): Add updateFrameSize.
+
+2012-09-07 Chong Yidong <cyd@gnu.org>
+
+ * textprop.c (Fget_text_property): Minor doc fix (Bug#12323).
+
+ * data.c (Flocal_variable_if_set_p): Doc fix (Bug#10713).
+
+2012-09-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ More signal-handler cleanup (Bug#12327).
+ * emacs.c (main): Convert three 'signal' calls to 'sigaction' calls.
+ Problem introduced when merging patches. Noted by Eli Zaretskii in
+ <http://bugs.gnu.org/12327#67>.
+ * floatfns.c: Comment fix.
+ * lisp.h (force_auto_save_soon): Declare regardless of SIGDANGER.
+ SIGDANGER might not be in scope so "#ifdef SIGDANGER" is not right,
+ and anyway the declaration is harmless even if SIGDANGER is not defined.
+ * syssignal.h (SIGIO): Also #undef if (! defined FIONREAD ||
+ defined BROKEN_FIONREAD). systty.h formerly did this, but other
+ source files not surprisingly expected syssignal.h to define, or
+ not define, SIGIO, and it's cleaner to do it that way, for consistency.
+ Include <sys/ioctl.h>, for FIONREAD.
+ * systty.h (SIGIO): Do not #undef here; it's now syssignal.h's job.
+ This eliminates a problem whereby other files mysteriously had
+ to include "syssignal.h" before including "systty.h" if they
+ wanted to use "#ifdef SIGIO".
+
+2012-09-07 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (sigaction): New function, emulates Posix 'sigaction'.
+
+ * w32.c (sigemptyset): Empty the set.
+ (sigsetmask, sigmask, sigblock, sigunblock): Remove unused functions.
+
+ * alloc.c [ENABLE_CHECKING]: Include signal.h, since we need SIGABRT.
+
+2012-09-07 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (mark_buffer): Revert unsafe marking optimization.
+ (mark_object): Likewise for frame objects.
+
+2012-09-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ * syssignal.h (handle_on_main_thread): Always declare,
+ even if FORWARD_SIGNAL_TO_MAIN_THREAD is not defined.
+ This ports to platforms without HAVE_PTHREAD.
+
+2012-09-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Signal-handler cleanup (Bug#12327).
+ Emacs's signal handlers were written in the old 4.2BSD style with
+ sigblock and sigmask and so forth, and this led to some
+ inefficiencies and confusion. Rewrite these to use
+ pthread_sigmask etc. without copying signal sets around. Also,
+ get rid of the confusing macros 'SIGNAL_THREAD_CHECK' and
+ 'signal', and instead use functions that do not attempt to take
+ over the system name space. This patch causes Emacs's text
+ segment to shrink by 0.7% on my platform, Fedora 17 x86-64.
+ * alloc.c, emacsgtkfixed.c, nsfns.m, widget.c, xmenu.c:
+ Do not include <signal.h> or "syssignal.h", as these
+ modules do not use signals.
+ * atimer.c, callproc.c, data.c, dispnew.c, emacs.c, floatfns.c:
+ * gtkutil.c, keyboard.c, process.c, sound.c, sysdep.c, term.c, xterm.c:
+ Do not include <signal.h>, as "syssignal.h" does that for us now.
+ * atimer.c (sigmask_atimers): New function.
+ (block_atimers, unblock_atimers): New functions,
+ replacing the old macros BLOCK_ATIMERS and UNBLOCK_ATIMERS.
+ All uses replaced.
+ * conf_post.h [SIGNAL_H_AHB]: Do not include <signal.h>;
+ no longer needed here.
+ * emacs.c (main): Inspect existing signal handler with sigaction,
+ so that there's no need to block and unblock SIGHUP.
+ * sysdep.c (struct save_signal): New member 'action', replacing
+ old member 'handler'.
+ (save_signal_handlers, restore_signal_handlers):
+ Use sigaction instead of 'signal' to save and restore.
+ (get_set_sighandler, set_sighandler) [!WINDOWSNT]:
+ New function. All users of 'signal' modified to use set_sighandler
+ if they're writeonly, and to use sys_signal if they're read+write.
+ (emacs_sigaction_init, forwarded_signal): New functions.
+ (sys_signal): Remove. All uses replaced by calls to sigaction
+ and emacs_sigaction_init, or by direct calls to 'signal'.
+ (sys_sigmask) [!__GNUC__]: Remove; no longer needed.
+ (sys_sigblock, sys_sigunblock, sys_sigsetmask): Remove;
+ all uses replaced by pthread_sigmask etc. calls.
+ * syssignal.h: Include <signal.h>.
+ (emacs_sigaction_init, forwarded_signal): New decls.
+ (SIGMASKTYPE): Remove. All uses replaced by its definiens, sigset_t.
+ (SIGEMPTYMASK): Remove; all uses replaced by its definiens, empty_mask.
+ (sigmask, sys_sigmask): Remove; no longer needed.
+ (sigpause): Remove. All uses replaced by its definiens, sigsuspend.
+ (sigblock, sigunblock, sigfree):
+ (sigsetmask) [!defined sigsetmask]:
+ Remove. All uses replaced by pthread_sigmask.
+ (signal): Remove. Its remaining uses (with SIG_DFL and SIG_IGN)
+ no longer need to be replaced, and its typical old uses
+ are now done via emacs_sigaction_init and sigaction.
+ (sys_sigblock, sys_sigunblock, sys_sigsetmask): Remove decls.
+ (sys_sigdel): Remove; unused.
+ (NSIG): Remove a FIXME; the code's fine. Remove an unnecessary ifdef.
+
+2012-09-06 Eli Zaretskii <eliz@gnu.org>
+
+ * process.c (CAN_HANDLE_MULTIPLE_CHILDREN): Fix a typo that broke
+ SIGCHLD handling on systems that don't have WNOHANG. (Bug#12327)
+
+2012-09-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Explicitly mark buffer_defaults and buffer_local_symbols.
+ * alloc.c (Fgarbage_collect): Mark buffer_defaults and
+ mark_local_symbols here.
+ (mark_object): If GC_CHECK_MARKED_OBJECTS, simplify checking
+ since special buffers aren't marked here any more.
+ (allocate_buffer): Chain new buffer with all_buffers here...
+ * buffer.c (Fget_buffer_create, Fmake_indirect_buffer): ...and
+ not here.
+ (Vbuffer_defaults, Vbuffer_local_symbols): Remove.
+ (syms_of_buffer): Remove staticpro of the above.
+ (init_buffer_once): Set names for buffer_defaults and
+ buffer_local_symbols.
+
+2012-09-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use bool for booleans in font-related modules.
+ * font.c (font_intern_prop, font_style_to_value)
+ (font_style_symbolic, font_parse_xlfd, font_parse_fcname)
+ (generate_otf_features, font_check_otf_features, font_check_otf)
+ (font_match_p, font_list_entities, font_at):
+ * fontset.c (fontset_id_valid_p, reorder_font_vector
+ (fontset_find_font, Fset_fontset_font)
+ (face_suitable_for_char_p) [0]:
+ * ftfont.c (fc_initialized, ftfont_get_open_type_spec)
+ (ftfont_open, ftfont_text_extents, ftfont_check_otf):
+ (m17n_flt_initialized, ftfont_shape_by_flt):
+ * ftxfont.c (ftxfont_draw_bitmap, ftxfont_draw):
+ * nsfont.m (nsfont_draw):
+ * w32font.c (w32font_draw):
+ * w32term.c (x_draw_glyphless_glyph_string_foreground):
+ Use bool for booleans.
+ * font.h: Adjust to above API changes.
+ (struct font, struct font_driver, struct font_driver_list):
+ Use bool for booleans.
+ (struct font): Remove useless member encoding_type.
+ All users removed.
+ * fontset.c, xftfont.c: Omit unnecessary static decls.
+
+2012-09-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (mark_object): Revert window marking code
+ since it's unsafe for the Fset_window_configuration.
+
+2012-09-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix race conditions with signal handlers and errno (Bug#12327).
+ Be more systematic about preserving errno whenever a signal
+ handler returns, even if it's not in the main thread. Do this by
+ renaming signal handlers to distinguish between signal delivery
+ and signal handling. All uses changed.
+ * atimer.c (deliver_alarm_signal): Rename from alarm_signal_handler.
+ * data.c (deliver_arith_signal): Rename from arith_error.
+ * dispnew.c (deliver_window_change_signal): Rename from
+ window_change_signal.
+ * emacs.c (deliver_error_signal): Rename from fatal_error_signal.
+ (deliver_danger_signal) [SIGDANGER]: Rename from memory_warning_signal.
+ * keyboard.c (deliver_input_available_signal): Rename from
+ input_available_signal.
+ (deliver_user_signal): Rename from handle_user_signal.
+ (deliver_interrupt_signal): Rename from interrupt_signal.
+ * process.c (deliver_pipe_signal): Rename from send_process_trap.
+ (deliver_child_signal): Rename from sigchld_handler.
+ * atimer.c (handle_alarm_signal):
+ * data.c (handle_arith_signal):
+ * dispnew.c (handle_window_change_signal):
+ * emacs.c (handle_fatal_signal, handle_danger_signal):
+ * keyboard.c (handle_input_available_signal):
+ * keyboard.c (handle_user_signal, handle_interrupt_signal):
+ * process.c (handle_pipe_signal, handle_child_signal):
+ New functions, with the actual signal-handling code taken from the
+ original respective signal handlers, sans the sporadic attempts to
+ preserve errno, since that's now done by handle_on_main_thread.
+ * atimer.c (alarm_signal_handler): Remove unnecessary decl.
+ * emacs.c, floatfns.c, lisp.h: Remove unused FLOAT_CATCH_SIGKILL cruft.
+ * emacs.c (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]:
+ Move to sysdep.c.
+ (main) [FORWARD_SIGNAL_TO_MAIN_THREAD]:
+ Move initialization of main_thread to sysdep.c's init_signals.
+ * process.c (waitpid) [!WNOHANG]: #define to wait; that's good enough for
+ our usage, and simplifies the mainline code.
+ (record_child_status_change): New static function, as a helper
+ for handle_child_signal, and with most of the old child handler's
+ contents.
+ (CAN_HANDLE_MULTIPLE_CHILDREN): New constant.
+ (handle_child_signal): Use the above.
+ * sysdep.c (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]:
+ Moved here from emacs.c.
+ (init_signals) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Initialize it;
+ code moved here from emacs.c's main function.
+ * sysdep.c, syssignal.h (handle_on_main_thread): New function,
+ replacing the old SIGNAL_THREAD_CHECK. All uses changed.
+ This lets callers save and restore errno properly.
+
+2012-09-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Remove redundant or unused things here and there.
+ * lisp.h (CYCLE_CHECK, CHAR_TABLE_TRANSLATE): Remove.
+ * conf_post.h (RE_TRANSLATE): Use char_table_translate.
+ * editfns.c (Fcompare_buffer_substrings): Likewise.
+ * frame.h (struct terminal, struct font_driver_list):
+ Remove redundant declarations.
+ * window.h (Qleft, Qright): Likewise.
+
+2012-09-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Do not mark objects from deleted buffers, windows and frames.
+ * alloc.c (mark_buffer): Mark just the buffer if it is dead.
+ (mark_object): Likewise for windows and frames.
+
+2012-09-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (valid_lisp_object_p): Treat killed buffers,
+ buffer_defaults and buffer_local_symbols as valid objects.
+ Return special value to denote them.
+
+2012-09-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fileio.c, filelock.c, floatfns.c, fns.c: Use bool for boolean.
+ * fileio.c (auto_saving, auto_save_error_occurred, make_temp_name)
+ (Fexpand_file_name, barf_or_query_if_file_exists, Fcopy_file)
+ (file_name_absolute_p, Fsubstitute_in_file_name):
+ (check_executable, check_writable, Ffile_accessible_directory_p)
+ (Fset_file_selinux_context, Fdefault_file_modes)
+ (Finsert_file_contents, choose_write_coding_system)
+ (Fwrite_region, build_annotations, a_write, e_write)
+ (Fdo_auto_save):
+ * filelock.c (boot_time_initialized, get_boot_time)
+ (get_boot_time_1, lock_file_1, within_one_second):
+ * floatfns.c (in_float):
+ * fns.c (concat, internal_equal, Frequire, base64_encode_1)
+ (base64_decode_1, cmpfn_eql, cmpfn_user_defined)
+ (sweep_weak_table, sweep_weak_hash_tables, secure_hash):
+ * lisp.h (struct Lisp_Hash_Table.cmpfn):
+ * window.c (compare_window_configurations):
+ Use bool for booleans.
+ * fileio.c (auto_saving_dir_umask, auto_saving_mode_bits)
+ (Fdefault_file_modes): Now mode_t, not int, for modes.
+ (Fdo_auto_save): Set a boolean to 1 rather than using ++.
+ (internal_delete_file): Now returns void, not a (boolean) int,
+ since nobody was looking at the return value.
+ * lisp.h, window.h: Adjust to above API changes.
+
+ * xdisp.c (set_message): Simplify and reindent last change.
+
+2012-09-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/sysdep.$(O)): Update dependencies.
+
+2012-09-04 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * eval.c (call_debugger): Make the function non-static so that we
+ can call it from set_message.
+
+ * xdisp.c (set_message): Implement the new variable `debug-on-message'.
+ (syms_of_xdisp): Defvar it and `inhibit-debug-on-message'.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Give more-useful info on a fatal error (Bug#12328).
+ * alloc.c [ENABLE_CHECKING]: Do not include <execinfo.h>.
+ (die) [ENABLE_CHECKING]: Call fatal_error_backtrace instead
+ of doing the work ourselves.
+ * emacs.c (fatal_error_signal): Let fatal_error_backtrace
+ do most of the work.
+ (fatal_error_backtrace): New function, taken from the guts
+ of the old fatal_error_signal, but with a new option to output
+ a backtrace.
+ (shut_down_emacs) [!DOS_NT]: Use strsignal to give more-useful
+ info about the signal than just its number.
+ * lisp.h (fatal_error_backtrace, emacs_backtrace): New decls.
+ * sysdep.c: Include <execinfo.h>
+ (emacs_backtrace): New function, taken partly from the previous
+ code of the 'die' function.
+ (emacs_abort): Call fatal_error_backtrace rather than abort.
+
+2012-09-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lread.c (readevalloop): Call internal-macroexpand-for-load to perform
+ eager (load-time) macro-expansion.
+ * lisp.mk (lisp): Add macroexp.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify redefinition of 'abort' (Bug#12316).
+ Do not try to redefine the 'abort' function. Instead, redo
+ the code so that it calls 'emacs_abort' rather than 'abort'.
+ This removes the need for the NO_ABORT configure-time macro
+ and makes it easier to change the abort code to do a backtrace.
+ * .gdbinit: Just stop at emacs_abort, not at w32_abort or abort.
+ * emacs.c (abort) [!DOS_NT && !NO_ABORT]:
+ Remove; sysdep.c's emacs_abort now takes its place.
+ * lisp.h (emacs_abort): New decl. All calls from Emacs code to
+ 'abort' changed to use 'emacs_abort'.
+ * msdos.c (dos_abort) [defined abort]: Remove; not used.
+ (abort) [!defined abort]: Rename to ...
+ (emacs_abort): ... new name.
+ * sysdep.c (emacs_abort) [!HAVE_NTGUI]: New function, taking
+ the place of the old 'abort' in emacs.c.
+ * w32.c, w32fns.c (abort): Do not #undef.
+ * w32.c (emacs_abort): Rename from w32_abort.
+
+2012-09-04 Eli Zaretskii <eliz@gnu.org>
+
+ * w32uniscribe.c (uniscribe_shape): Reverse the sign of
+ offsets[j].dv, since the y axis of the screen coordinates points
+ down, while the y axis of the font definition coordinates points
+ up. This fixes display of Arabic diacritics such as KASRA and
+ KASRATAN. (Bug#11860)
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Be more systematic about _setjmp vs setjmp.
+ * alloc.c (test_setjmp, mark_stack):
+ * image.c (PNG_LONGJMP) [PNG_LIBPNG_VER < 10500]:
+ (PNG_JMPBUF) [! (PNG_LIBPNG_VER < 10500)]:
+ (png_load, my_error_exit, jpeg_load):
+ * process.c (send_process_trap, send_process):
+ Uniformly prefer _setjmp and _longjmp to setjmp and longjmp.
+ The underscored versions are up to 30x faster on some hosts.
+ Formerly, the code used setjmp+longjmp sometimes and
+ _setjmp+_longjmp at other times, with no particular reason to
+ prefer setjmp+longjmp.
+
+2012-09-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor problem found by static checking.
+ * buffer.c (Fdelete_all_overlays): Return nil.
+
+2012-09-03 Martin Rudalics <rudalics@gmx.at>
+
+ * buffer.c (Fdelete_all_overlays): New function.
+
+2012-09-03 Chong Yidong <cyd@gnu.org>
+
+ * gtkutil.c: Add extern decl for Qxft.
+
+2012-09-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ * emacs.c, eval.c: Use bool for boolean.
+ * emacs.c (initialized, inhibit_window_system, running_asynch_code):
+ (malloc_using_checking) [DOUG_LEA_MALLOC]:
+ (display_arg) [HAVE_X_WINDOWS || HAVE_NS]:
+ (noninteractive, no_site_lisp, fatal_error_in_progress, argmatch)
+ (main, decode_env_path, Fdaemon_initialized):
+ * eval.c (call_debugger, Finteractive_p, interactive_p):
+ (unwind_to_catch, Fsignal, wants_debugger, skip_debugger)
+ (maybe_call_debugger, Fbacktrace):
+ * process.c (read_process_output, exec_sentinel):
+ Use bool for booleans.
+ * emacs.c (shut_down_emacs): Omit unused boolean argument NO_X.
+ All callers changed.
+ * eval.c (interactive_p): Omit always-true boolean argument
+ EXCLUDE_SUBRS_P. All callers changed.
+ * dispextern.h, lisp.h: Reflect above API changes.
+ * firstfile.c (dummy): Use the address of 'main', whose signature
+ won't change, instead of the address of 'initialize', whose
+ signature just changed from int to bool.
+ * lisp.h (fatal_error_in_progress): New decl of boolean, moved here ...
+ * msdos.c (fatal_error_in_progress): ... from here.
+ * xdisp.c (redisplaying_p): Now a boolean. Set it to 1 instead
+ of incrementing it.
+ (redisplay_internal, unwind_redisplay): Simply clear
+ REDISPLAYING_P when unwinding, instead of saving its previous,
+ always-false value and then restoring it.
+
+ Clean up some extern decls.
+ Mostly, this hoists extern decls out of .c files and into .h files.
+ That way, we're more likely to catch errors if the interfaces change.
+ * alloc.c [USE_GTK]: Include "gtkutil.h" so that we need not
+ declare xg_mark_data.
+ * dispextern.h (x_frame_parm_handlers):
+ * font.h (Qxft):
+ * lisp.h (Qlexical_binding, Qinternal_interpreter_environment)
+ (Qextra_light, Qlight, Qsemi_light, Qsemi_bold, Qbold, Qextra_bold)
+ (Qultra_bold, Qoblique, Qitalic):
+ Move extern decl here from .c file.
+ * alloc.c (xg_mark_data) [USE_GTK]:
+ * doc.c (Qclosure):
+ * eval.c (Qlexical_binding):
+ * fns.c (time) [!HAVE_UNISTD_H]:
+ * gtkutil.c (Qxft, Qnormal, Qextra_light, Qlight, Qsemi_light)
+ (Qsemi_bold, Qbold, Qextra_bold, Qultra_bold, Qoblique, Qitalic):
+ * image.c (Vlibrary_cache, QCloaded_from) [HAVE_NTGUI]:
+ * lread.c (Qinternal_interpreter_environment):
+ * minibuf.c (Qbuffer):
+ * process.c (QCfamily, QCfilter):
+ * widget.c (free_frame_faces):
+ * xfaces.c (free_frame_menubar) [USE_X_TOOLKIT]:
+ * xfont.c (x_clear_errors):
+ * xterm.c (x_frame_parm_handlers):
+ Remove now-redundant extern decls.
+ * keyboard.c, keyboard.h (ignore_mouse_drag_p) [USE_GTK || HAVE_NS]:
+ * xfaces.c (Qultra_light, Qreverse_oblique, Qreverse_italic):
+ Now static.
+ * xfaces.c: Remove unnecessary static decls.
+ * xterm.c (updating_frame): Remove decl of nonexistent object.
+
+ * Makefile.in (gl-stamp): Don't scan $(SOME_MACHINE_OBJECTS)
+ when building globals.h, as the objects that are not built on
+ this host are not needed to compile C files on this host.
+
+2012-09-02 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.h: Remove prototype for x_wm_set_size_hint.
+
+ * frame.h: Add missing prototype for x_wm_set_size_hint.
+
+2012-09-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ * doc.c, editfns.c, insdel.c, intervals.c: Use bool for boolean.
+ * doc.c (read_bytecode_char, get_doc_string, reread_doc_file)
+ (Fdocumentation, Fdocumentation_property, Fsnarf_documentation)
+ (Fsubstitute_command_keys):
+ * editfns.c (region_limit, find_field, Fconstrain_to_field)
+ (save_excursion_save, save_excursion_restore)
+ (disassemble_lisp_time, decode_time_components, emacs_nmemftime)
+ (format_time_string, general_insert_function)
+ (make_buffer_string, make_buffer_string_both)
+ (Fsubst_char_in_region, Ftranslate_region_internal, Fformat):
+ * insdel.c (check_markers, gap_left, adjust_markers_for_insert)
+ (copy_text, insert_1, insert_1_both, insert_from_string)
+ (insert_from_string_before_markers, insert_from_string_1)
+ (insert_from_buffer, insert_from_buffer_1, replace_range)
+ (replace_range_2, del_range_1, del_range_byte, del_range_both)
+ (del_range_2, modify_region):
+ * intervals.c (intervals_equal, balance_possible_root_interval)
+ (adjust_intervals_for_insertion, merge_properties_sticky)
+ (graft_intervals_into_buffer, lookup_char_property)
+ (adjust_for_invis_intang, set_point_both)
+ (get_property_and_range, compare_string_intervals)
+ (set_intervals_multibyte_1, set_intervals_multibyte):
+ * keyboard.c (decode_timer):
+ Use bool for boolean.
+ * intervals.h, lisp.h, systime.h: Reflect above API changes.
+ * editfns.c (struct info): Use 1-bit unsigned bitfields for booleans.
+
+2012-09-02 Chong Yidong <cyd@gnu.org>
+
+ * keymap.c (push_key_description): Print M-TAB as C-M-i
+ (Bug#11758).
+
+2012-09-02 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (CCL_H, W32FONT_H): New macros.
+ (ATIMER_H, FONT_H, $(BLD)/alloc.$(O), $(BLD)/callproc.$(O))
+ ($(BLD)/editfns.$(O), $(BLD)/ccl.$(O), $(BLD)/chartab.$(O))
+ ($(BLD)/coding.$(O), $(BLD)/sysdep.$(O), $(BLD)/fontset.$(O))
+ ($(BLD)/sysdep.$(O), $(BLD)/w32fns.$(O), $(BLD)/keyboard.$(O))
+ ($(BLD)/w32term.$(O), $(BLD)/w32menu.$(O), $(BLD)/process.$(O))
+ ($(BLD)/w32font.$(O), $(BLD)/w32uniscribe.$(O)): Update dependencies.
+
+2012-09-01 Eli Zaretskii <eliz@gnu.org>
+
+ * w32uniscribe.c (uniscribe_shape): Handle correctly the case of
+ more than one grapheme cluster passed to the shaper: compute the
+ offset adjustment values separately for each cluster. (Bug#11860)
+
+ * image.c: Restore mistakenly removed inclusion of w32.h. Without
+ it, GCC doesn't see prototypes of w32_delayed_load, and complains
+ about implicit conversions from integer to pointer.
+
+2012-09-01 Daniel Colascione <dancol@dancol.org>
+
+ * w32fns.c (x_display_info_for_name): Prevent crash if w32 window
+ system used too early.
+
+2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better seed support for (random).
+ * emacs.c (main): Call init_random.
+ * fns.c (Frandom): Set the seed from a string argument, if given.
+ Remove long-obsolete Gentzel cruft.
+ * lisp.h, sysdep.c (seed_random): Now takes address and size, not long.
+ (init_random): New function.
+
+2012-09-01 Daniel Colascione <dancol@dancol.org>
+
+ * xterm.h: Add header guards. Declare x_menubar_window_to_frame.
+ Remove x_set_frame_alpha, x_bitmap_icon, x_make_frame_visible,
+ x_make_frame_invisible, x_iconify_frame, x_free_frame_resources,
+ x_wm_set_size_hint, x_query_colors, x_real_positions,
+ x_set_menu_bar_lines, x_char_width, x_char_height, x_sync,
+ x_set_tool_bar_lines, x_activate_menubar, and free_frame_menubar,
+ all of which have been moved to common code.
+
+ * xfaces.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
+
+ * w32xfns.c (x_sync): Correct definition of x_sync (a no-op here)
+ to match header.
+
+ * w32term.h (FRAME_X_WINDOW): Use FRAME_W32_WINDOW instead of
+ directly accessing frame internals.
+
+ * w32font.h: Include font.h. Define syms_of_w32font and
+ globals_of_w32font.
+
+ * process.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
+
+ * nsterm.h: Remove declarations now in frame.h.
+ Define FRAME_X_SCREEN, FRAME_X_VISUAL.
+
+ * menu.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
+
+ * keyboard.h: Declare ignore_mouse_drag_p whenever we have a
+ window system.
+
+ * keyboard.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
+
+ * image.c: Include TERM_HEADER instead of listing all possible
+ window-system headers. Declare Vlibrary_cache when compiling for
+ Windows.
+
+ * gtkutil.h (xg_list_node_): Include xterm.h to pick up needed
+ window system declarations.
+
+ * frame.h: Move common functions here: set_frame_menubar,
+ x_set_window_size, x_sync, x_get_focus_frame,
+ x_set_mouse_position, x_set_mouse_pixel_position,
+ x_make_frame_visible, x_make_frame_invisible, x_iconify_frame,
+ x_char_width, x_char_height, x_pixel_width, x_pixel_height,
+ x_set_frame_alpha, x_set_menu_bar_lines, x_set_tool_bar_lines,
+ x_activate_menubar, x_real_positions, x_bitmap_icon,
+ x_set_menu_bar_lines, free_frame_menubar, x_free_frame_resources,
+ and x_query_colors.
+
+ * frame.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
+
+ * font.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
+
+ * emacs.c: Include TERM_HEADER.
+
+ * dispnew.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
+
+ * ccl.h: Include character.h.
+
+ * Makefile.in: Define WINDOW_SYSTEM_OBJ to hold objects needed for
+ the current window system; include in list of objects to link into
+ Emacs.
+
+2012-08-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Remove mark_ttys function and fix tty_display_info initialization.
+ * lisp.h (mark_ttys): Remove prototype.
+ * alloc.c (Fgarbage_collect): Remove redundant (and the only) call
+ to mark_ttys because all possible values of 'top_frame' slot are
+ the frames which are reachable from Vframe_list.
+ * term.c (mark_ttys): Remove.
+ (init_tty): Safely initialize 'top_frame' slot with Qnil.
+
+2012-08-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Change struct frame bitfields from unsigned char to unsigned.
+ * frame.h (struct frame): Change type of 'display_preempted',
+ 'visible', 'iconified', 'has_minibuffer', 'wants_modeline',
+ 'auto_raise', 'auto_lower', 'no_split', 'explicit_name',
+ 'window_sizes_changed', 'mouse_moved' and 'pointer_invisible'
+ bitfields from unsigned char to unsigned.
+
+2012-08-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Remove unused member of struct x_output and struct w32_output.
+ * xterm.h (struct x_output): Remove unused field 'needs_exposure'.
+ * w32term.h (struct w32_output): Likewise.
+
+2012-08-30 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (x_wm_set_size_hint): Use 1 col for base_width so it
+ does not become zero (Bug#12234).
+
+2012-08-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ * dispnew.c (update_frame_1): Pacify gcc -Wstrict-overflow
+ for GCC 4.7.1 x86-64.
+
+2012-08-30 Glenn Morris <rgm@gnu.org>
+
+ * lread.c (init_lread): For out-of-tree builds, only add the
+ source directory's site-lisp dir to the load-path if it exists,
+ consistent with in-tree builds. (Bug#12302)
+
+2012-08-28 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsmenu.m (initWithContentRect:styleMask:backing:defer:): Initialize
+ button_values to NULL. Call setStykeMask so dialogs get a close button.
+ (windowShouldClose:): Set window_closed.
+ (dealloc): New member, free button_values.
+ (process_dialog:): Make member function. Remove window argument,
+ replace window with self. Count buttons and allocate and store values
+ in button_values.
+ (addButton:value:row:): value is int with the name tag. Call setTag
+ with tag. Remove return self, declare return value as void.
+ (addString:row:): Remove return self, declare return value as void.
+ (addSplit): Remove return self, declare return value as void.
+ (clicked:): Remove return self, declare return value as void.
+ Set dialog_return to button_values[seltag]. Code formatting change.
+ (initFromContents:isQuestion:): Adjust call to process_dialog.
+ Code formatting change.
+ (timeout_handler:): Set timer_fired to YES.
+ (runDialogAt:): Set timer_fired to NO.
+ Handle click on close button as quit.
+
+ * nsterm.h (EmacsDialogPanel): Make timer_fired BOOL.
+ Add window_closed and button_values. Add void as return value for
+ add(Button|String|Split). addButton takes int instead of Lisp_Object.
+ Add process_dialog as new member.
+
+2012-08-28 Eli Zaretskii <eliz@gnu.org>
+
+ * ralloc.c (free_bloc): Don't dereference a 'heap' structure if it
+ is not one of the heaps we manage. (Bug#12242)
+
+2012-08-28 Glenn Morris <rgm@gnu.org>
+
+ * eval.c (Fcalled_interactively_p): Doc fix. (Bug#11747)
+
+2012-08-28 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fset_window_configuration): Remove handling of
+ auto-buffer-name window parameter. Install revision of reverted
+ fix.
+
+2012-08-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Do not allow to set major mode for a dead buffer.
+ * buffer.c (Fset_buffer_major_mode): Signal an error
+ if the buffer is dead.
+ (Fother_buffer, other_buffer_safely): Remove redundant
+ nested declaration.
+
+2012-08-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Always use set_buffer_if_live to restore original buffer at unwind.
+ * buffer.h (record_unwind_current_buffer): New function.
+ * bytecode.c, dispnew.c, editfns.c, fileio.c, fns.c, insdel.c:
+ * keyboard.c, keymap.c, minibuf.c, print.c, process.c, textprop.c:
+ * undo.c, window.c: Adjust users.
+ * buffer.c (set_buffer_if_live): Fix comment.
+
+2012-08-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix usage of set_buffer_internal.
+ * buffer.h (set_buffer_internal): Make it BUFFER_INLINE.
+ * buffer.c (set_buffer_if_live): Use set_buffer_internal.
+ * coding.c (decode_coding): Omit redundant test.
+ * fileio.c (decide_coding_unwind): Likewise.
+ * fns.c (secure_hash): Likewise.
+ * insdel.c (modify_region): Likewise.
+ * keyboard.c (command_loop_1): Likewise.
+ * print.c (PRINTFINISH): Likewise.
+ * xdisp.c (run_window_scroll_functions): Use set_buffer_internal.
+
+2012-08-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ * dispnew.c: Use bool for boolean.
+ (frame_garbaged, display_completed, delayed_size_change)
+ (fonts_changed_p, add_window_display_history)
+ (add_frame_display_history, verify_row_hash)
+ (adjust_glyph_matrix, clear_window_matrices, glyph_row_slice_p)
+ (row_equal_p, realloc_glyph_pool)
+ (allocate_matrices_for_frame_redisplay)
+ (showing_window_margins_p)
+ (adjust_frame_glyphs_for_frame_redisplay)
+ (build_frame_matrix_from_leaf_window, make_current)
+ (mirrored_line_dance, mirror_line_dance, update_frame)
+ (update_window_tree, update_single_window)
+ (check_current_matrix_flags, update_window, update_text_area)
+ (update_window_line, set_window_update_flags, scrolling_window)
+ (update_frame_1, scrolling, buffer_posn_from_coords)
+ (do_pending_window_change, change_frame_size)
+ (change_frame_size_1, sit_for):
+ Use bool for boolean.
+ (clear_glyph_matrix_rows): Rename from enable_glyph_matrix_rows,
+ and remove last int (actually boolean) argument, which was always 0.
+ All callers changed.
+ * dispextern.h, frame.h, lisp.h: Reflect above API changes.
+ * dispextern.h (struct composition_it): Use bool for boolean.
+ (struct glyph_matrix): Don't assume buffer sizes can fit in 'int'.
+ (struct bidi_it): Use unsigned:1, not int, for boolean prev_was_pdf.
+ * dired.c (file_name_completion):
+ Use bool for boolean. (This was missed in an earlier change.)
+
+2012-08-27 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fset_window_configuration): Revert first part of
+ last change.
+
+2012-08-27 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.h (NSPanel): New class variable dialog_return.
+
+ * nsmenu.m (initWithContentRect:styleMask:backing:defer:):
+ Initialize dialog_return.
+ (windowShouldClose:): Use stop instead of stopModalWithCode.
+ (clicked:): Ditto, and also set dialog_return (Bug#12258).
+ (timeout_handler:): Use stop instead of abortModal. Send a dummy
+ event.
+ (runDialogAt:): Make ret Lisp_Object. Set it from dialog_return when
+ modal loop returns.
+
+2012-08-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ * composite.c, data.c, dbusbind.c, dired.c: Use bool for booleans.
+ * composite.c (find_composition, composition_gstring_p)
+ (composition_reseat_it, find_automatic_composition):
+ * data.c (let_shadows_buffer_binding_p)
+ (let_shadows_global_binding_p, set_internal, make_blv)
+ (Fmake_variable_buffer_local, Fmake_local_variable)
+ (Fmake_variable_frame_local, arithcompare, cons_to_unsigned)
+ (cons_to_signed, arith_driver):
+ * dbusbind.c (xd_in_read_queued_messages):
+ * dired.c (directory_files_internal, file_name_completion):
+ Use bool for booleans.
+ * dired.c (file_name_completion):
+ * process.h (fd_callback):
+ Omit int (actually boolean) argument. It wasn't being used.
+ All uses changed.
+ * composite.h, lisp.h: Reflect above API changes.
+
+ * cmds.c, coding.c: Use bool for booleans.
+ * cmds.c (move_point, Fself_insert_command):
+ * coding.h (struct composition status, struct coding_system):
+ * coding.c (detect_coding_utf_8, encode_coding_utf_8)
+ (detect_coding_utf_16, encode_coding_utf_16, detect_coding_emacs_mule)
+ (emacs_mule_char, decode_coding_emacs_mule)
+ (encode_coding_emacs_mule, detect_coding_iso_2022)
+ (decode_coding_iso_2022, encode_invocation_designation)
+ (encode_designation_at_bol, encode_coding_iso_2022)
+ (detect_coding_sjis, detect_coding_big5, decode_coding_sjis)
+ (decode_coding_big5, encode_coding_sjis, encode_coding_big5)
+ (detect_coding_ccl, encode_coding_ccl, decode_coding_raw_text)
+ (encode_coding_raw_text, detect_coding_charset)
+ (decode_coding_charset, encode_coding_charset, detect_eol)
+ (detect_coding, get_translation_table, produce_chars)
+ (consume_chars, reused_workbuf_in_use)
+ (make_conversion_work_buffer, code_conversion_save)
+ (decode_coding_object, encode_coding_object)
+ (detect_coding_system, char_encodable_p)
+ (Funencodable_char_position, code_convert_region)
+ (code_convert_string, code_convert_string_norecord)
+ (Fset_coding_system_priority):
+ * fileio.c (Finsert_file_contents):
+ Use bool for booleans.
+ * coding.h, lisp.h: Reflect above API changes.
+ * coding.c: Remove unnecessary static function decls.
+ (detect_coding): Use unsigned, not signed, to copy an unsigned field.
+ (decode_coding, encode_coding, decode_coding_gap): Return 'void',
+ not a boolean 'int', since callers never look at the return value.
+ (ALLOC_CONVERSION_WORK_AREA): Assume caller returns 'void', not 'int'.
+ * coding.h (decoding_buffer_size, encoding_buffer_size)
+ (emacs_mule_string_char): Remove unused extern decls.
+ (struct iso_2022_spec, struct coding_system):
+ Use 'unsigned int : 1' for boolean fields, since there's more than one.
+ (struct emacs_mule_spec): Remove unused field 'full_support'.
+ All initializations removed.
+ * cmds.c (internal_self_insert): Don't assume EMACS_INT fits in 'int'.
+
+2012-08-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix spare memory change (Bug#12286).
+ * alloc.c (mark_maybe_pointer): Handle MEM_TYPE_SPARE.
+ (valid_lisp_object_p): Likewise.
+
+2012-08-27 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fset_window_configuration): Record any window's old
+ buffer if it's replaced (see Bug#8789). If the new current
+ buffer doesn't appear in the selected window, go to its old
+ point (Bug#12208).
+
+2012-08-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Special MEM_TYPE_SPARE to denote reserved memory.
+ * alloc.c (enum mem_type): New memory type.
+ (refill_memory_reserve): Use new type for spare memory.
+ This prevents live_cons_p and live_string_p from incorrect
+ detection of uninitialized objects from spare memory as live.
+
+2012-08-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes.
+ * Makefile.in (.PHONY): versioclean -> versionclean.
+
+ Remove unused external symbols.
+ * data.c (Qcons, Qfloat, Qmisc, Qstring, Qvector):
+ * window.c (Qwindow_valid_p, decode_valid_window):
+ Now static, not extern.
+ * data.c (Qinterval): Remove; unused.
+ (syms_of_data): Do not define 'interval'.
+ * lisp.h (Qinteger, Qstring, Qmisc, Qvector, Qfloat, Qcons):
+ * window.h (decode_valid_window):
+ Remove decls.
+
+ * character.c, charset.c, chartab.c: Use bool for booleans.
+ * character.c (lisp_string_width, string_count_byte8)
+ (string_escape_byte8):
+ * charset.c (charset_map_loaded, load_charset_map, read_hex):
+ (load_charset_map_from_file, map_charset_chars)
+ (Fdefine_charset_internal, define_charset_internal)
+ (Fdeclare_equiv_charset, find_charsets_in_text)
+ (Ffind_charset_region, char_charset, Fiso_charset):
+ * chartab.c (sub_char_table_ref, sub_char_table_ref_and_range)
+ (sub_char_table_set, sub_char_table_set_range)
+ (char_table_set_range, optimize_sub_char_table)
+ (map_sub_char_table):
+ Use bool for boolean.
+ * character.c (str_to_unibyte): Omit last boolean argument; it was
+ always 0. All callers changed.
+ * character.h, charset.h: Adjust to match previous changes.
+ * character.h (char_printable_p): Remove decl of nonexistent function.
+ * charset.h (struct charset): Members code_linear_p, iso_chars_96,
+ ascii_compatible_p, supplementary_p, compact_codes_p, unified_p
+ are all boolean, so make them single-bit bitfields.
+
+ * lisp.h (ASET): Remove attempt to detect side effects.
+ It was meant to be temporary and it often doesn't work,
+ because when IDX has side effects the behavior of IDX==IDX
+ is undefined. See Stefan Monnier in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00762.html>.
+
+2012-08-26 Barry OReilly <gundaetiapo@gmail.com> (tiny change)
+
+ * lisp.h (functionp): New function (extracted from Ffunctionp).
+ (FUNCTIONP): Use it.
+ * eval.c (Ffunctionp): Use it.
+
+2012-08-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xgselect.c (xg_select): Use auto storage for the GPollFD buffer
+ as that's faster and simpler than static storage. Don't bother
+ with the g_main_context_query overhead if g_main_context_pending
+ says no events are pending.
+ (gfds, gfds_size): Remove these static vars.
+ (xgselect_initialize): Remove; no longer needed.
+ All uses and decls removed.
+
+ * emacs.c (fatal_error_signal_hook): Remove.
+ All uses removed. This leftover from old code was always 0.
+
+ * casefiddle.c, casetab.c, category.c: Use bool for boolean.
+ * casefiddle.c (casify_object, casify_region):
+ * casetab.c (set_case_table):
+ * category.c, category.h (word_boundary_p):
+ * category.h (CHAR_HAS_CATEGORY):
+ Use bool for booleans, instead of int.
+
+2012-08-25 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in ($(BLD)/alloc.$(O)): Depend on $(GNU_LIB)/execinfo.h.
+
+2012-08-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ On assertion failure, print backtrace if available.
+ * alloc.c [ENABLE_CHECKING]: Include <execinfo.h>.
+ (die) [ENABLE_CHECKING]: Print a backtrace if available.
+ * Makefile.in (LIB_EXECINFO): New macro.
+ (LIBES): Use it.
+
+ * bytecode.c, callint.c, callproc.c: Use bool for boolean.
+ * bytecode.c (exec_byte_code):
+ * callint.c (check_mark, Fcall_interactively):
+ * callproc.c (Fcall_process, add_env, child_setup, getenv_internal_1)
+ (getenv_internal, sync_process_alive, call_process_exited):
+ * lisp.h (USE_SAFE_ALLOCA):
+ Use bool for booleans, instead of int.
+ * lisp.h, process.h: Adjust prototypes to match above changes.
+ * callint.c (Fcall_interactively): Don't assume the mark's
+ offset fits in 'int'.
+
+2012-08-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ * buffer.c, buffer.h: Use bool for boolean.
+ * buffer.c (reset_buffer_local_variables)
+ (buffer_lisp_local_variables, Fset_buffer_modified_p)
+ (Frestore_buffer_modified_p, Fset_buffer_multibyte):
+ (overlays_at, overlays_in, mouse_face_overlay_overlaps)
+ (overlay_touches_p, overlay_strings, Foverlay_put)
+ (report_overlay_modification, call_overlay_mod_hooks):
+ (mmap_enlarge, mmap_set_vars):
+ * buffer.h (buffer_has_overlays, uppercasep, lowercasep):
+ Use bool for booleans, instead of int.
+ * buffer.c (compact_buffer, mmap_free_1): Return void, not int,
+ since the 1-or-0 return value is always ignored anyway.
+ (mmap_initialized_p):
+ * buffer.h (struct buffer_text.inhibit_shrinking): Now bool, not int.
+ * buffer.h, lisp.h: Adjust prototypes to match above changes.
+
+2012-08-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * bidi.c: Use bool for boolean.
+ This is a bit more readable, and makes the text segment of bidi.o
+ 0.4% smaller on my platform (GCC 4.7.1 x86-64, Fedora 15).
+ Presumably it's faster too.
+ (bidi_initialized, bidi_ignore_explicit_marks_for_paragraph_level):
+ Now bool.
+ (bidi_cache_find_level_change, bidi_cache_iterator_state)
+ (bidi_unshelve_cache, bidi_init_it, bidi_count_bytes)
+ (bidi_char_at_pos, bidi_fetch_char, bidi_paragraph_init)
+ (bidi_explicit_dir_char, bidi_level_of_next_char)
+ (bidi_find_other_level_edge, bidi_move_to_visually_next):
+ Use bool for booleans, instead of int.
+ * dispextern.h (bidi_init_it, bidi_paragraph_init)
+ (bidi_unshelve_cache): Adjust decls to match code.
+
+2012-08-23 Martin Rudalics <rudalics@gmx.at>
+
+ * keyboard.c (Fposn_at_x_y): Do not allow internal window as
+ argument.
+
+2012-08-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * atimer.c, atimer.h (turn_on_atimers): Use bool for boolean.
+ * atimer.h: Include <stdbool.h>.
+
+2012-08-22 Dan Nicolaescu <dann@gnu.org>
+
+ * frame.h (FRAME_W32_P, FRAME_MSDOS_P, FRAME_NS_P): Change to
+ compile time tests instead of run time tests on systems that do
+ not use them.
+ (FRAME_MAC_P): Remove leftover from deleted code.
+ * frame.c (syms_of_frame): Remove leftover from deleted code.
+
+2012-08-22 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (insertText:): Don't clear modifiers if code is space.
+
+2012-08-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fontset.c (FONTSET_ADD): Return void, not Lisp_Object.
+ Otherwise, the compiler complains about (A?B:C) where B is void
+ and C is Lisp_Object. This fixes an incompatibility with Sun C 5.12.
+ (fontset_add): Return void, for FONTSET_ADD.
+
+2012-08-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c: Use bool for booleans.
+ (gc_in_progress, abort_on_gc)
+ (setjmp_tested_p) [!GC_SAVE_REGISTERS_ON_STACK && !GC_SETJMP_WORKS]:
+ (dont_register_blocks) [GC_MALLOC_CHECK]:
+ (suppress_checking) [ENABLE_CHECKING]: Now bool, not int.
+ (check_string_bytes, make_specified_string, memory_full)
+ (live_string_p, live_cons_p, live_symbol_p, live_float_p)
+ (live_misc_p, live_vector_p, live_buffer_p, mark_maybe_object)
+ (mark_stack, valid_pointer_p, make_pure_string)
+ (Fgarbage_collect, survives_gc_p, gc_sweep):
+ Use bool for booleans, instead of int.
+ (test_setjmp) [!GC_SAVE_REGISTERS_ON_STACK && !GC_SETJMP_WORKS]:
+ Remove unused local.
+ * alloc.c (PURE_POINTER_P):
+ * lisp.h (STRING_MULTIBYTE): Document that it returns a boolean.
+ * editfns.c (Fformat):
+ * fileio.c (Fexpand_file_name, Fsubstitute_in_file_name)
+ (Fdo_auto_save):
+ * fns.c (sweep_weak_table):
+ * lisp.h (suppress_checking, push_message, survives_gc_p)
+ (make_pure_string, gc_in_progress, abort_on_gc):
+ * lread.c (readchar, read1):
+ * print.c (Fprin1_to_string):
+ * xdisp.c (push_message):
+ Use bool for booleans affected directly or indirectly by
+ alloc.c's changes.
+
+ Make recently-introduced setters macros.
+ * fontset.c (set_fontset_id, set_fontset_name, set_fontset_ascii)
+ (set_fontset_base, set_fontset_frame, set_fontset_nofont_face)
+ (set_fontset_default, set_fontset_fallback): Rename from their
+ upper-case counterparts, and make them functions rather than macros.
+ This is more consistent with the other recently-introduced setters.
+ These don't need to be inline, since they're local.
+
+2012-08-21 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (fd_handler:): Alloc and release a NSAutoreleasePool in
+ the loop (Bug#12247).
+
+2012-08-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h (vcopy): Use memcpy rather than our own loop.
+ This fixes a performance regression introduced by the recent
+ addition of vcopy. This means 'vcopy' will need to be modified
+ for a copying collector, but that's OK. Also, tighten the
+ checking in the assertion.
+
+2012-08-21 Eli Zaretskii <eliz@gnu.org>
+
+ * w32uniscribe.c (uniscribe_shape): Fix producing gstring
+ components for RTL text (Bug#11860). Adjust X-OFFSET of each
+ non-base glyph for the width of the base character, according to
+ what x_draw_composite_glyph_string_foreground expects.
+ Generate WADJUST value according to composition_gstring_width's
+ expectations, to produce correct width of the composed character.
+ Reverse the sign of the DU offset produced by ScriptPlace.
+
+2012-08-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ * dbusbind.c (xd_remove_watch): Do not assume C99 comments.
+
+2012-08-21 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid direct writes to contents member of struct Lisp_Vector.
+ * lisp.h (vcopy): New function to copy data into vector.
+ * dispnew.c (Fframe_or_buffer_changed_p): Use AREF and ASET.
+ * fns.c (Ffillarray): Use ASET.
+ * keyboard.c (timer_check_2): Use AREF and ASET.
+ (append_tool_bar_item, Frecent_keys): Use vcopy.
+ * lread.c (read_vector): Use ASET.
+ * msdos.c (Frecent_doskeys): Use vcopy.
+ * xface.c (Finternal_copy_lisp_face): Use vcopy.
+ (Finternal_merge_in_global_face): Use ASET and vcopy.
+ * xfont.c (xfont_list_pattern): Likewise.
+
+2012-08-21 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fwindow_point): For the selected window always return
+ the position of its buffer's point.
+ (Fset_window_point): For the selected window always go in its
+ buffer to the specified position.
+
+2012-08-21 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Setter macros for fontsets.
+ * fontset.c (SET_FONTSET_ID, SET_FONTSET_NAME, SET_FONTSET_ASCII)
+ (SET_FONTSET_BASE, SET_FONTSET_FRAME, SET_FONTSET_NOFONT_FACE)
+ (SET_FONTSET_DEFAULT, SET_FONTSET_FALLBACK): New macros.
+ Adjust users.
+
+2012-08-20 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (emacs$(EXEEXT), bootstrap-emacs$(EXEEXT)):
+ Don't assume that `ln -f' works.
+
+2012-08-20 Eli Zaretskii <eliz@gnu.org>
+
+ * .gdbinit: Use "set $dummy = ..." to avoid warnings from GDB 7.5
+ and later about non-assignments with no effect. See discussion at
+ http://sourceware.org/ml/gdb-patches/2012-08/msg00518.html for
+ details.
+
+2012-08-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Inline setter functions for Lisp_Objects slots of struct specbinding.
+ * eval.c (set_specpdl_symbol, set_specpdl_old_value): New functions.
+ Adjust users.
+
+2012-08-20 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (select_window): Always make selected window's buffer
+ current.
+
+2012-08-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use AREF and ASET for docstrings of category tables.
+ * category.h (CATEGORY_DOCSTRING): Use AREF.
+ (SET_CATEGORY_DOCSTRING): Use ASET.
+ * category.c (Fdefine_category): Use SET_CATEGORY_DOCSTRING.
+
+2012-08-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Inline setter functions for hash table members.
+ * lisp.h (set_hash_key, set_hash_value, set_hash_next)
+ (set_hash_hash, set_hash_index): Rename with _slot suffix.
+ (set_hash_key_and_value, set_hash_index, set_hash_next)
+ (set_hash_hash): New functions.
+ * charset.c, fns.c: Adjust users.
+
+2012-08-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Inline getter and setter functions for per-buffer values.
+ * buffer.h (per_buffer_default, set_per_buffer_default)
+ (per_buffer_value, set_per_buffer_value): New functions.
+ (PER_BUFFER_VALUE, PER_BUFFER_DEFAULT): Remove.
+ * buffer.c, data.c: Adjust users.
+
+2012-08-20 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/vm-limit.$(O)): Update dependencies.
+
+2012-08-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rely on <config.h> + <unistd.h> to declare 'environ',
+ as gnulib does this if the system doesn't.
+ * callproc.c, editfns.c, process.c (environ) [!USE_CRT_DLL]:
+ Remove declaration. MS-Windows declares it on stdlib.h which is
+ included by conf_post.h.
+ * emacs.c (environ) [DOUG_LEA_MALLOC]:
+ * vm-limit.c (environ) [ORDINARY_LINK]: Remove decl.
+ * vm-limit.c: Include <unistd.h>, for 'environ'.
+
+ * unexaix.c, unexcoff.c: Include "mem-limits.h".
+ (start_of_data): Remove decl; mem-limits.h provides it.
+
+ * xdisp.c (handle_invisible_prop): Make it a bit faster
+ and avoid a gcc -Wmaybe-uninitialized diagnostic.
+
+2012-08-19 Chong Yidong <cyd@gnu.org>
+
+ * xdisp.c (handle_invisible_prop): Fix ellipses at overlay string
+ ends (Bug#3874).
+
+2012-08-19 Andreas Schwab <schwab@linux-m68k.org>
+
+ * .gdbinit: Use call instead of set when calling a function in the
+ inferior.
+
+ * data.c (set_internal): Don't use set_blv_found.
+ (Fkill_local_variable): Likewise.
+
+2012-08-18 Alp Aker <alp.tekin.aker@gmail.com>
+
+ * nsfont.m (ns_ascii_average_width): Ensure the string
+ ascii_printable is initialized with a null-terminated character
+ array. Otherwise, it can contain undesired extra characters.
+
+2012-08-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ port new setting code to Sun C 5.8 2005/10/13
+ * chartab.c, lisp.h (char_table_set, char_table_set_range):
+ Return void, not Lisp_Object. Otherwise, the compiler
+ complains about (A?B:C) where B is void and C is Lisp_Object
+ when compiling CHAR_TABLE_SET, due to the recent change to
+ the API of sub_char_table_set_contents.
+
+2012-08-18 Chong Yidong <cyd@gnu.org>
+
+ * xdisp.c (handle_invisible_prop): Obey TEXT_PROP_MEANS_INVISIBLE
+ for the string case (Bug#3874).
+
+2012-08-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * buffer.h (BSET): Remove (Bug#12215).
+ Replace all uses with calls to new setter functions.
+ (bset_bidi_paragraph_direction, bset_case_canon_table)
+ (bset_case_eqv_table, bset_directory, bset_display_count)
+ (bset_display_time, bset_downcase_table)
+ (bset_enable_multibyte_characters, bset_filename, bset_keymap)
+ (bset_last_selected_window, bset_local_var_alist)
+ (bset_mark_active, bset_point_before_scroll, bset_read_only)
+ (bset_truncate_lines, bset_undo_list, bset_upcase_table)
+ (bset_width_table):
+ * buffer.c (bset_abbrev_mode, bset_abbrev_table)
+ (bset_auto_fill_function, bset_auto_save_file_format)
+ (bset_auto_save_file_name, bset_backed_up, bset_begv_marker)
+ (bset_bidi_display_reordering, bset_buffer_file_coding_system)
+ (bset_cache_long_line_scans, bset_case_fold_search)
+ (bset_ctl_arrow, bset_cursor_in_non_selected_windows)
+ (bset_cursor_type, bset_display_table, bset_extra_line_spacing)
+ (bset_file_format, bset_file_truename, bset_fringe_cursor_alist)
+ (bset_fringe_indicator_alist, bset_fringes_outside_margins)
+ (bset_header_line_format, bset_indicate_buffer_boundaries)
+ (bset_indicate_empty_lines, bset_invisibility_spec)
+ (bset_left_fringe_width, bset_major_mode, bset_mark)
+ (bset_minor_modes, bset_mode_line_format, bset_mode_name)
+ (bset_name, bset_overwrite_mode, bset_pt_marker)
+ (bset_right_fringe_width, bset_save_length)
+ (bset_scroll_bar_width, bset_scroll_down_aggressively)
+ (bset_scroll_up_aggressively, bset_selective_display)
+ (bset_selective_display_ellipses, bset_vertical_scroll_bar_type)
+ (bset_word_wrap, bset_zv_marker):
+ * category.c (bset_category_table):
+ * syntax.c (bset_syntax_table):
+ New setter functions.
+
+ * process.h (PSET): Remove (Bug#12215).
+ Replace all uses with calls to new setter functions.
+ Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
+ (PROCESS_INLINE): New macro.
+ (pset_childp): New setter function.
+ (pset_gnutls_cred_type) [HAVE_GNUTLS]: New setter function.
+ * process.c (PROCESS_INLINE):
+ Define to EXTERN_INLINE, so that the corresponding functions
+ are compiled into code.
+ (pset_buffer, pset_command, pset_decode_coding_system)
+ (pset_decoding_buf, pset_encode_coding_system)
+ (pset_encoding_buf, pset_filter, pset_log, pset_mark, pset_name)
+ (pset_plist, pset_sentinel, pset_status, pset_tty_name)
+ (pset_type, pset_write_queue): New setter functions.
+
+ * window.h (WSET): Remove (Bug#12215).
+ Replace all uses with calls to new setter functions.
+ Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
+ (WINDOW_INLINE): New macro.
+ (wset_buffer, wset_frame, wset_left_col, wset_next, wset_prev)
+ (wset_redisplay_end_trigger, wset_top_line, wset_total_cols)
+ (wset_total_lines, wset_vertical_scroll_bar)
+ (wset_window_end_pos, wset_window_end_valid)
+ (wset_window_end_vpos): New setter functions.
+ * window.c (WINDOW_INLINE):
+ Define to EXTERN_INLINE, so that the corresponding functions
+ are compiled into code.
+ (wset_combination_limit, wset_dedicated, wset_display_table)
+ (wset_hchild, wset_left_fringe_width, wset_left_margin_cols)
+ (wset_new_normal, wset_new_total, wset_next_buffers)
+ (wset_normal_cols, wset_normal_lines, wset_parent, wset_pointm)
+ (wset_prev_buffers, wset_right_fringe_width)
+ (wset_right_margin_cols, wset_scroll_bar_width, wset_start)
+ (wset_temslot, wset_vchild, wset_vertical_scroll_bar_type)
+ (wset_window_parameters):
+ * xdisp.c (wset_base_line_number, wset_base_line_pos)
+ (wset_column_number_displayed, wset_region_showing):
+ New setter functions.
+
+ * termhooks.h (TSET): Remove (Bug#12215).
+ Replace all uses with calls to new setter functions.
+ Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
+ (TERMHOOKS_INLINE): New macro.
+ (tset_charset_list, tset_selection_alist): New setter functions.
+ * terminal.c (TERMHOOKS_INLINE):
+ Define to EXTERN_INLINE, so that the corresponding functions
+ are compiled into code.
+ (tset_param_alist): New setter function.
+
+2012-08-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * keyboard.h (KSET): Remove (Bug#12215).
+ Replace all uses with calls to new setter functions.
+ Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
+ (KEYBOARD_INLINE): New macro.
+ (kset_default_minibuffer_frame, kset_defining_kbd_macro)
+ (kset_input_decode_map, kset_last_command, kset_last_kbd_macro)
+ (kset_prefix_arg, kset_system_key_alist, kset_window_system):
+ New setter functions.
+ * keyboard.c (KEYBOARD_INLINE):
+ Define to EXTERN_INLINE, so that the corresponding functions
+ are compiled into code.
+ (kset_echo_string, kset_kbd_queue)
+ (kset_keyboard_translate_table, kset_last_prefix_arg)
+ (kset_last_repeatable_command, kset_local_function_key_map)
+ (kset_overriding_terminal_local_map, kset_real_last_command)
+ (kset_system_key_syms): New setter functions.
+
+ * frame.h (FSET): Remove (Bug#12215).
+ Replace all uses with calls to new setter functions.
+ Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
+ (FRAME_INLINE): New macro.
+ (fset_buffer_list, fset_buried_buffer_list, fset_condemned_scroll_bars)
+ (fset_current_tool_bar_string, fset_desired_tool_bar_string)
+ (fset_face_alist, fset_focus_frame, fset_icon_name, fset_menu_bar_items)
+ (fset_menu_bar_vector, fset_menu_bar_window, fset_name)
+ (fset_param_alist, fset_root_window, fset_scroll_bars)
+ (fset_selected_window, fset_title, fset_tool_bar_items)
+ (fset_tool_bar_position, fset_tool_bar_window): New functions.
+ * frame.c (FRAME_INLINE):
+ Define to EXTERN_INLINE, so that the corresponding functions
+ are compiled into code.
+ (fset_buffer_predicate, fset_minibuffer_window): New setter functions.
+
+ A few more naming-convention fixes for getters and setters.
+ * buffer.c (set_buffer_overlays_before): Move here from buffer.h,
+ and rename from buffer_overlays_set_before.
+ (set_buffer_overlays_after): Move here from buffer.h, and rename
+ from buffer_overlays_set_after.
+ * buffer.h (buffer_intervals): Rename from buffer_get_intervals.
+ All uses changed.
+ (set_buffer_intervals): Rename from buffer_set_intervals.
+ * intervals.c (set_interval_object): Move here from intervals.h,
+ and rename from interval_set_object.
+ (set_interval_left): Move here from intervals.h, and rename from
+ interval_set_left.
+ (set_interval_right): Move here from intervals.h, and rename from
+ interval_set_right.
+ (copy_interval_parent): Move here from intervals.h, and rename from
+ interval_copy_parent.
+ * intervals.h (set_interval_parent): Rename from interval_set_parent.
+ (set_interval_plist): Rename from interval_set_plist.
+ Return void, not Lisp_Object, since no caller uses the result.
+ * lisp.h (string_intervals): Rename from string_get_intervals.
+ (set_string_intervals): Rename from string_set_intervals.
+
+ * lisp.h (set_char_table_extras): Rename from char_table_set_extras.
+ (set_char_table_contents): Rename from char_table_set_contents.
+ (set_sub_char_table_contents): Rename from sub_char_table_set_contents.
+ All uses changed. See the end of
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00549.html>.
+
+ * lisp.h (CSET): Remove (Bug#12215).
+ (set_char_table_ascii, set_char_table_defalt, set_char_table_parent)
+ (set_char_table_purpose): New functions,
+ replacing CSET. All uses changed. For example, replace
+ "CSET (XCHAR_TABLE (char_table), parent, parent);" with
+ "set_char_table_parent (char_table, parent);".
+ The old version was confusing because it used the same name
+ 'parent' for two different things.
+
+2012-08-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Functions to get and set Lisp_Object fields of buffer-local variables.
+ * lisp.h (blv_found, set_blv_found, blv_value, set_blv_value)
+ (set_blv_where, set_blv_defcell, set_blv_valcell): New functions.
+ (BLV_FOUND, SET_BLV_FOUND, BLV_VALUE, SET_BLV_VALUE): Remove.
+ * data.c, eval.c, frame.c: Adjust users.
+
+2012-08-17 Chong Yidong <cyd@gnu.org>
+
+ * xfaces.c (merge_face_vectors): If the target font specfies a
+ font spec, make the font's attributes take precedence over
+ directly-specified attributes.
+ (merge_face_ref): Recognize :font.
+
+2012-08-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Do not use memcpy for copying intervals.
+ * intervals.c (reproduce_interval): New function.
+ (reproduce_tree, reproduce_tree_obj): Use it.
+ (reproduce_tree_obj): Remove prototype.
+
+2012-08-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h (duration_to_sec_usec): Remove unused decl.
+
+2012-08-17 Alp Aker <alp.tekin.aker@gmail.com>
+
+ * nsfont.m (ns_ascii_average_width): Send initWithFormat selector
+ to an allocated instance of NSString, not to the class itself.
+
+2012-08-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (C_CTYPE_H): New macro.
+ (LISP_H, $(BLD)/ccl.$(O), $(BLD)/doc.$(O), $(BLD)/w32console.$(O)):
+ ($(BLD)/fontset.$(O), $(BLD)/frame.$(O), $(BLD)/composite.$(O)):
+ ($(BLD)/sysdep.$(O), $(BLD)/w32uniscribe.$(O)): Update dependencies.
+
+2012-08-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use ASCII tests for character types.
+ * category.c, dispnew.c, doprnt.c, editfns.c, syntax.c, term.c:
+ * xfns.c, xterm.c:
+ Don't include <ctype.h>; was not needed.
+ * charset.c, doc.c, fileio.c, font.c, frame.c, gtkutil.c, image.c:
+ * sysdep.c, xfaces.c:
+ Include <c-ctype.h> instead of <ctype.h>.
+ * nsterm.m: Include <c-ctype.h>.
+ * charset.c (read_hex):
+ * doc.c (Fsnarf_documentation):
+ * fileio.c (IS_DRIVE) [WINDOWSNT]:
+ (DRIVE_LETTER) [DOS_NT]:
+ (Ffile_name_directory, Fexpand_file_name)
+ (Fsubstitute_in_file_name):
+ * font.c (font_parse_xlfd, font_parse_fcname):
+ * frame.c (x_set_font_backend):
+ * gtkutil.c (xg_get_font):
+ * image.c (xbm_scan, xpm_scan, pbm_scan_number):
+ * nsimage.m (hexchar):
+ * nsterm.m (ns_xlfd_to_fontname):
+ * sysdep.c (system_process_attributes):
+ * xfaces.c (hash_string_case_insensitive):
+ Use C-locale tests instead of locale-specific tests for character
+ types, since we want the ASCII interpretation here, not the
+ interpretation suitable for whatever happens to be the current locale.
+
+2012-08-16 Martin Rudalics <rudalics@gmx.at>
+
+ Consistently check windows for validity/liveness
+ (Bug#11984, Bug#12025, Bug#12026).
+ * lisp.h (CHECK_VALID_WINDOW): New macro.
+ * window.c (decode_window): Rename to decode_live_window.
+ (decode_valid_window, Fwindow_valid_p): New functions.
+ (Fwindow_frame, Fframe_root_window, Fwindow_minibuffer_p)
+ (Fframe_first_window, Fframe_selected_window, Fwindow_parent)
+ (Fwindow_top_child, Fwindow_left_child, Fwindow_next_sibling)
+ (Fwindow_prev_sibling, Fwindow_combination_limit)
+ (Fset_window_combination_limit, Fwindow_use_time)
+ (Fwindow_total_height, Fwindow_total_width, Fwindow_new_total)
+ (Fwindow_normal_size, Fwindow_new_normal, Fwindow_left_column)
+ (Fwindow_top_line, Fwindow_body_height, Fwindow_body_width)
+ (Fwindow_hscroll, Fset_window_hscroll)
+ (Fwindow_redisplay_end_trigger)
+ (Fset_window_redisplay_end_trigger, Fwindow_edges)
+ (Fwindow_pixel_edges, Fwindow_absolute_pixel_edges)
+ (Fwindow_inside_edges, Fwindow_inside_pixel_edges)
+ (Fcoordinates_in_window_p, Fwindow_point, Fwindow_start)
+ (Fwindow_end, Fset_window_point, Fset_window_start)
+ (Fpos_visible_in_window_p, Fwindow_line_height)
+ (Fwindow_dedicated_p, Fset_window_dedicated_p)
+ (Fwindow_prev_buffers, Fset_window_prev_buffers)
+ (Fwindow_next_buffers, Fwindow_parameters, Fwindow_parameter)
+ (Fset_window_parameter, Fwindow_display_table)
+ (Fset_window_display_table, Fdelete_other_windows_internal)
+ (Fset_window_buffer, Fset_window_new_total)
+ (Fset_window_new_normal, Fdelete_window_internal)
+ (Fwindow_text_height, Fset_window_margins, Fwindow_margins)
+ (Fset_window_fringes, Fwindow_fringes, Fset_window_scroll_bars)
+ (Fwindow_scroll_bars): Check whether argument window is a valid or
+ live window. Update doc-strings.
+ (syms_of_window): New symbol Qwindow_valid_p.
+ * keyboard.c (Fposn_at_x_y): Check whether argument
+ frame_or_window denotes a valid window.
+
+2012-08-16 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix previous char table change.
+ * lisp.h (CHAR_TABLE_SET): Use sub_char_table_set_contents.
+ * chartab.c (optimize_sub_char_table): Likewise.
+
+2012-08-16 Chong Yidong <cyd@gnu.org>
+
+ * gtkutil.c (xg_get_font): Demand an Xft font (Bug#3228).
+
+ * xfont.c (xfont_open):
+ * xftfont.c (xftfont_open): Set the font's max_width field.
+
+ * nsfont.m (nsfont_open): Similar to the Xft backend, set
+ min_width to space_width and average_width to the average over
+ printable ASCII characters.
+ (ns_char_width): Code cleanup.
+ (ns_ascii_average_width): New utility function.
+
+ * font.h (struct font): Update comments.
+
+2012-08-16 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simple interface to set Lisp_Object fields of character tables.
+ * lisp.h (CSET): New macro.
+ (char_table_set_extras, char_table_set_contents)
+ (sub_char_table_set_contents): New function.
+ * casetab.c, category.c, chartab.c, fns.c, fontset.c, search.c:
+ * syntax.c: Adjust users.
+
+2012-08-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (eval_sub): Bind lexical-binding.
+ * lread.c (Qlexical_binding): Make non-static.
+
+2012-08-15 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsmenu.m (popupSession): Remove.
+ (pop_down_menu): Remove endModalSession.
+ (timeout_handler:): New method.
+ (runDialogAt:): Get next timeout. Start a NSTimer with that timeout.
+ Call runModalForWindow. Check timer_fired when it returns.
+ If not set, cancel timer and break out of loop.
+ Otherwise loop again, with a new timeout.
+
+ * nsterm.m: Include fcntl.h if present.
+ (fd_entry, t_readfds, inNsSelect): Remove.
+ (select_writefds, select_valid, select_timeout, selfds)
+ (select_mutex, apploopnr): Add.
+ (EV_TRAILER): Call kbd_buffer_store_event_hold only if q_event_ptr.
+ Otherwise call kbd_buffer_store_event.
+ (ns_send_appdefined): Remove release of fd_entry.
+ (ns_read_socket): Always send appdefined. Remove inNsSelect check.
+ Increment and decrement apploopnr.
+ (ns_select): If no file descriptors, just do a NSTimer.
+ Otherwise copy read/write masks and start select thread (fd_handler).
+ Start main loop and wait for application defined event.
+ Inform select thread to stop selecting after main loop is exited.
+ (ns_term_init): Create selfds pipe and set non-blocking.
+ Initialize select_mutex. Start the select thread (fd_handler).
+ (fd_handler:): Loop forever, wait for info from the main thread
+ to either start or stop selecting. When select returns, send
+ and appdefined event.
+ (sendScrollEventAtLoc:fromEvent:): Check if q_event_ptr is set.
+ If not call kbd_buffer_store_event.
+
+ * nsterm.h (EmacsApp): fd_handler takes id argument.
+ (EmacsDialogPanel): Add timer_fired and timeout_handler.
+
+ * gtkutil.c (xg_mark_data): Use FRAME_X_P.
+
+2012-08-15 Eli Zaretskii <eliz@gnu.org>
+
+ * region-cache.c (move_cache_gap): Update gap_len using the actual
+ growth of the boundaries array. Do not change cache_len.
+ (Bug#12196)
+
+2012-08-15 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Generalize and cleanup font subsystem checks.
+ * font.h (FONT_DEBUG, font_assert): Remove.
+ * font.c, fontset.c, w32font.c, xfont.c, xftfont.c:
+ Change font_assert to eassert. Use eassert where appropriate.
+
+2012-08-15 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * gtkutil.c (xg_get_font): Use pango_units_to_double.
+
+2012-08-15 Chong Yidong <cyd@gnu.org>
+
+ * gtkutil.c (xg_get_font): Rename from xg_get_font_name.
+ When using the new font chooser, use gtk_font_chooser_get_font_desc to
+ extract the font descriptor instead of just the font name.
+ In that case, return a font spec instead of a string.
+ (x_last_font_name): Move to this file from xfns.c.
+
+ * xfns.c (Fx_select_font): The return value can also be a font
+ spec. Move x_last_font_name management to gtkutil.c.
+
+ * xfaces.c: Make font weight and style symbols non-static.
+
+2012-08-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuf.c (read_minibuf): Ignore caller's inhibit-read-only
+ (bug#12117).
+
+2012-08-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * alloc.c (Fgarbage_collect): Use plural form consistently.
+
+2012-08-14 Eli Zaretskii <eliz@gnu.org>
+
+ * keyboard.c (command_loop_1): Reset ignore_mouse_drag_p flag each
+ iteration through the command loop. Fixes a problem whereby mouse
+ movements are ignored until the first mouse click.
+
+2012-08-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use bool, not int, for Lisp booleans.
+ This is more natural, and on my platform (GCC 4.7.1 x86-64) it
+ makes Emacs a bit smaller and presumably a bit faster.
+ * lisp.h: Include <stdbool.h>.
+ (struct Lisp_Boolfwd, defvar_bool):
+ * lread.c (defvar_bool): Use bool, not int, for Lisp booleans.
+ * regex.c [!emacs]: Include <stdbool.h>.
+ (false, true): Remove; <stdbool.h> does this for us now.
+
+2012-08-14 Chong Yidong <cyd@gnu.org>
+
+ * character.c (Fcharacterp): Doc fix (Bug#12076).
+
+ * data.c (Findirect_variable): Doc fix (Bug#11040).
+
+ * chartab.c (Fmap_char_table): Doc fix (Bug#12061).
+
+ * editfns.c (Fformat): Doc fix (Bug#12059).
+ (Fsave_current_buffer): Doc fix (Bug#11542).
+
+2012-08-14 Barry OReilly <gundaetiapo@gmail.com> (tiny change)
+
+ * keyboard.c (access_keymap_keyremap): Accept anonymous functions
+ (bug#12022).
+
+2012-08-14 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.c (make_frame_without_minibuffer, make_minibuffer_frame)
+ (delete_frame, Fmake_frame_invisible, Ficonify_frame):
+ * minibuf.c (choose_minibuf_frame, read_minibuf):
+ * w32fns.c (x_create_tip_frame):
+ * xfns.c (x_create_tip_frame): Call set_window_buffer instead of
+ Fset_window_buffer (Bug#11984, Bug#12025, Bug#12026).
+
+2012-08-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * intervals.c (offset_intervals): Remove obsolete comment.
+
+2012-08-14 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gtkutil.c (find_rtl_image, update_frame_tool_bar): Use NILP.
+
+2012-08-14 Gergely Risko <gergely@risko.hu>
+
+ * coding.c (decode_coding): Record buffer modification before
+ disabling undo_list (Bug#11773).
+
+2012-08-14 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Revert and cleanup some recent overlay changes.
+ * buffer.h (enum overlay_type): Remove.
+ (buffer_get_overlays, buffer_set_overlays): Likewise.
+ (buffer_set_overlays_before, buffer_set_overlays_after):
+ New function. Adjust users.
+ (unchain_both): Add eassert.
+
+2012-08-14 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * gtkutil.c (update_frame_tool_bar): Use EQ where appropriate.
+
+2012-08-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * gtkutil.c (xg_mark_data): Don't assume C99.
+
+2012-08-13 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (xg_frame_tb_info): New struct.
+ (TB_INFO_KEY): New define.
+ (xg_free_frame_widgets): Free xg_frame_tb_info for frame if present.
+ (xg_mark_data): Mark Lisp_Objects in xg_frame_tb_info.
+ (xg_create_tool_bar): Allocate and initialize a xg_frame_tb_info
+ if not present.
+ (update_frame_tool_bar): Return early if data in xg_frame_tb_info
+ is up to date. Otherwise store new data.
+ (free_frame_tool_bar): Free xg_frame_tb_info if present.
+
+2012-08-13 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use KSET for write access to Lisp_Object members of struct kboard.
+ * keyboard.h (KSET): New macro.
+ * callint.c, category.c, frame.c, keyboard.c, keyboard.h, macros.c:
+ * msdos.c, nsfns.m, nsterm.m, term.c, w32fns.c, w32term.c, xfns.c:
+ * xterm.c: Adjust users.
+
+2012-08-13 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use BSET for write access to Lisp_Object members of struct buffer.
+ * buffer.h (BSET): New macro.
+ * buffer.c, casetab.c, cmds.c, coding.c, data.c, editfns.c:
+ * fileio.c, frame.c, indent.c, insdel.c, intervals.c, keymap.c:
+ * minibuf.c, print.c, process.c, syntax.c, undo.c, w32fns.c:
+ * window.c, xdisp.c, xfns.c: Adjust users.
+
+2012-08-11 BT Templeton <bpt@hcoop.net> (tiny change)
+
+ * lread.c (syms_of_lread): Initialize Vlexical_binding.
+
+2012-08-11 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (not_in_argv): New function.
+ (application:openFile, application:openTempFile:):
+ (application:openFileWithoutUI:, application:openFiles:): Open file
+ if not_in_argv returns non-zero (bug#12171).
+
+ * gtkutil.c (gtk_font_chooser_dialog_new, GTK_FONT_CHOOSER)
+ (gtk_font_chooser_set_font, gtk_font_chooser_get_font):
+ Define for Gtk+ versions less than 3.2.
+ (xg_get_font_name): Use those functions/macros here.
+ Reported by Frans Oilinki <moilinki@gmail.com>.
+
+2012-08-11 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * unexmacosx.c (copy_data_segment): Copy initialized data in
+ statically linked libraries from input file rather than memory.
+
+ * unexmacosx.c (print_load_command_name): Add cases LC_MAIN,
+ LC_SOURCE_VERSION, and LC_DYLIB_CODE_SIGN_DRS.
+ (dump_it) [LC_DYLIB_CODE_SIGN_DRS]: Call copy_linkedit_data.
+
+2012-08-10 Glenn Morris <rgm@gnu.org>
+
+ * conf_post.h (IF_LINT, lint_assume): Move here from lisp.h.
+ * lisp.h (IF_LINT, lint_assume): Move to conf_post.h.
+
+2012-08-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix last change to allow compilation with low optimization levels.
+ * intervals.c (INTERVALS_INLINE): Define to EXTERN_INLINE.
+ Reported by Jan Djärv <jan.h.d@swipnet.se>.
+
+2012-08-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use common inline syntax in intervals.h.
+ * intervals.h (INTERVALS_INLINE): New macro.
+ Change all users from LISP_INLINE.
+
+2012-08-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Define Qnone once for all platforms.
+ * frame.c (Qnone): Define here.
+ (syms_of_frame): DEFSYM it.
+ * lisp.h (Qnone): New declaration.
+ * nsfns.m, nsterm.h, nsterm.m, w32fns.c, w32font.c:
+ * xfns.c: Remove duplication. Adjust users.
+
+2012-08-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Remove unused macros from intervals.h.
+ * intervals.h (MERGE_INSERTIONS, DISPLAY_INVISIBLE_GLYPH): Remove.
+ * intervals.c: Adjust comment.
+
+2012-08-10 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c <w32_unicode_gui>: New static variable.
+ (globals_of_w32fns): Initialize it according to os_subtype.
+ (w32_init_class, w32_msg_pump, w32_wnd_proc): Use it instead of
+ testing os_subtype.
+
+2012-08-10 Joakim Hårsman <joakim.harsman@gmail.com> (tiny change)
+ Eli Zaretskii <eliz@gnu.org>
+
+ Fix bug #10299 with Unicode characters sent by customized
+ keyboards created by MSKLC.
+ * w32fns.c (INIT_WINDOW_CLASS): New macro.
+ (w32_init_class): Use it to initialize the Emacs class with either
+ ANSI or Unicode API calls.
+ (w32_msg_pump): Call GetMessageW and DispatchMessageW on NT and
+ later.
+ (w32_wnd_proc): If the character code sent by WM_CHAR or
+ WM_SYSCHAR is above 255, post a WM_UNICHAR message, not the
+ original message. Call DefWindowProcW on NT and later.
+
+2012-08-10 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (config_h): Fix conf_post.h out-of-tree build location.
+
+ * lisp.h (DIRECTORY_SEP): Let configure set it.
+
+2012-08-09 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use TSET for write access to Lisp_Object slots of struct terminal.
+ * termhooks.h (TSET): New macro.
+ * coding.c, terminal.c, xselect.c: Adjust users.
+
+2012-08-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * xdisp.c (safe_eval_handler): Remove prototype. Receive args describing
+ the failing expression, include them in the error message.
+ * eval.c (internal_condition_case_n): Pass nargs and args to hfun.
+ * lisp.h (internal_condition_case_n): Update declaration.
+
+2012-08-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Inline functions to examine and change buffer overlays.
+ * buffer.c (unchain_both): New function.
+ * buffer.h (buffer_get_overlays, buffer_set_overlays):
+ (buffer_has_overlays): New function.
+ (enum overlay_type): New enum.
+ * alloc.c, buffer.c, editfns.c, fileio.c, indent.c:
+ * insdel.c, intervals.c, print.c, xdisp.c: Adjust users.
+
+2012-08-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Inline functions to examine and change buffer intervals.
+ * alloc.c (mark_interval_tree): Remove.
+ (MARK_INTERVAL_TREE): Simplify.
+ (UNMARK_BALANCE_INTERVALS): Remove. Adjust users.
+ * intervals.c (buffer_balance_intervals): New function.
+ (graft_intervals_into_buffer): Adjust indentation.
+ (set_intervals_multibyte): Simplify.
+ * buffer.h (BUF_INTERVALS): Remove.
+ (buffer_get_intervals, buffer_set_intervals): New function.
+ * alloc.c, buffer.c, editfns.c, fileio.c, indent.c, insdel.c:
+ * intervals.c, textprop.c: Adjust users.
+
+2012-08-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Inline functions to examine and change string intervals.
+ * lisp.h (STRING_INTERVALS, STRING_SET_INTERVALS): Remove.
+ (string_get_intervals, string_set_intervals): New function.
+ * alloc.c, buffer.c, editfns.c, fns.c, insdel.c, intervals.c:
+ * lread.c, print.c, textprop.c: Adjust users.
+
+2012-08-08 Glenn Morris <rgm@gnu.org>
+
+ * lisp.mk (lisp): Remove language/persian.elc.
+
+2012-08-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup intervals.
+ * intervals.h (NULL_INTERVAL, DEFAULT_INTERVAL): Remove.
+ (NULL_INTERVAL_P): Likewise. Adjust users.
+ (FRONT_STICKY_P, END_NONSTICKY_P, FRONT_NONSTICKY_P):
+ Adjust comment. Move under #if 0.
+ * alloc.c, buffer.c, editfns.c, fns.c, insdel.c, intervals.c:
+ * print.c, syntax.c, textprop.c, xdisp.c: Adjust users.
+
+2012-08-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Check total length of intervals with eassert.
+ * intervals.h (CHECK_TOTAL_LENGTH): Remove.
+ * intervals.c: Change all users to eassert.
+
+2012-08-07 Eli Zaretskii <eliz@gnu.org>
+
+ * .gdbinit (xframe, xwindow, nextcons, xcar, xcdr, xlist):
+ Rename fields to match removal of FGET and WGET and disuse of
+ INTERNAL_FIELD in Lisp_Cons.
+
+2012-08-07 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Revert and cleanup Lisp_Cons, Lisp_Misc and Lisp_Symbol things.
+ * lisp.h (struct Lisp_Symbol): Change xname to meaningful
+ name since all xname users are fixed long time ago. Do not
+ use INTERNAL_FIELD.
+ (set_symbol_name, set_symbol_function, set_symbol_plist):
+ (set_symbol_next, set_overlay_plist): New function.
+ (struct Lisp_Cons): Do not use INTERNAL_FIELD.
+ (struct Lisp_Overlay): Likewise.
+ (CVAR, MVAR, SVAR): Remove.
+ * alloc.c, buffer.c, buffer.h, bytecode.c, cmds.c, data.c:
+ * doc.c, eval.c, fns.c, keyboard.c, lread.c, nsselect.m:
+ * xterm.c: Adjust users.
+ * .gdbinit: Change to use name field of struct Lisp_Symbol
+ where appropriate.
+
+2012-08-07 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Basic functions to set Lisp_Object and pointer slots of intervals.
+ * intervals.h (interval_set_parent, interval_set_object):
+ (interval_set_left, interval_set_right, interval_set_plist):
+ (interval_copy_parent): New function.
+ (SET_INTERVAL_OBJECT, SET_INTERVAL_PARENT, INTERVAL_PTR_SIZE): Remove.
+ (RESET_INTERVAL, COPY_INTERVAL_CACHE, MERGE_INTERVAL_CACHE):
+ Adjust indentation.
+ (INTERVAL_SIZE): Remove. Adjust users.
+ * alloc.c, intervals.c, lread.c, textprop.c: Use new functions.
+
+2012-08-07 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Drop PGET and revert read access to Lisp_Objects slots of Lisp_Process.
+ * process.h (PGET): Remove.
+ (struct Lisp_Process): Do not use INTERNAL_FIELD.
+ * gnutls.c, print.c, process.c, sysdep.c, w32.c, xdisp.c: Adjust users.
+
+2012-08-07 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Drop WGET and revert read access to Lisp_Objects slots of struct window.
+ * window.h (WGET): Remove.
+ (struct window): Do not use INTERNAL_FIELD.
+ * alloc.c, buffer.c, composite.c, dispextern.h, dispnew.c, editfns.c:
+ * fileio.c, font.c, fontset.c, frame.c, frame.h, fringe.c, indent.c:
+ * insdel.c, keyboard.c, keymap.c, lisp.h, minibuf.c, msdos.c, nsfns.m:
+ * nsmenu.m, nsterm.m, print.c, textprop.c, w32fns.c, w32menu.c:
+ * w32term.c, window.c, xdisp.c, xfaces.c, xfns.c, xmenu.c, xterm.c:
+ Adjust users.
+
+2012-08-07 Chong Yidong <cyd@gnu.org>
+
+ * window.c (Fwindow_edges, Fwindow_pixel_edges)
+ (Fwindow_absolute_pixel_edges, Fdelete_other_windows_internal)
+ (Fdelete_window_internal): Signal an error if the window is not on
+ a live frame (Bug#12025).
+
+2012-08-07 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Drop FGET and revert read access to Lisp_Objects slots of struct frame.
+ * frame.h (FGET): Remove.
+ (struct frame): Do not use INTERNAL_FIELD.
+ * buffer.c, data.c, dispnew.c, dosfns.c, eval.c, fontset.c, frame.c:
+ * fringe.c, gtkutil.c, minibuf.c, msdos.c, nsfns.m, nsmenu.m, nsterm.m:
+ * print.c, term.c, w32fns.c, w32menu.c, w32term.c, window.c, window.h:
+ * xdisp.c, xfaces.c, xfns.c, xmenu.c, xterm.c: Adjust users.
+
+2012-08-06 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32.c: Silence compiler warnings.
+ (map_w32_filename): Remove unused variable `is_fat'.
+ (chase_symlinks): Add parentheses around expression.
+
+2012-08-06 Glenn Morris <rgm@gnu.org>
+
+ * sysdep.c: Respect BROKEN_GETWD.
+
+ * dispnew.c (GNU_LIBRARY_PENDING_OUTPUT_COUNT, PENDING_OUTPUT_COUNT):
+ Let configure handle it.
+ (stdio_ext.h) [DISPNEW_NEEDS_STDIO_EXT]: Include it.
+
+2012-08-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use GCALIGNMENT where appropriate.
+ * alloc.c (XMALLOC_HEADER_ALIGNMENT, roundup_size):
+ (union aligned_Lisp_Symbol, union aligned_Lisp_Misc):
+ (mark_maybe_pointer, pure_alloc): Change to use GCALIGNMENT.
+
+2012-08-06 Eli Zaretskii <eliz@gnu.org>
+
+ * w32menu.c (set_frame_menubar, initialize_frame_menubar):
+ Don't use FRAME_MENU_BAR_ITEMS as an lvalue.
+
+2012-08-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * buffer.h (struct buffer): Revert `indirections' to a simple int;
+ that should be sufficient for everyone.
+
+2012-08-06 Jan Djärv <jan.h.d@swipnet.se>
+
+ * keyboard.c (timer_check_2): Add break so timer_check returns next
+ timeout.
+
+2012-08-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix Windows build errors introduced after converting to WGET and WSET.
+ * w32term.c (w32_set_vertical_scroll_bar): Change to use WSET.
+ Reported by Andy Moreton <andrewjmoreton@gmail.com>.
+
+2012-08-06 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_frame_rehighlight): Use FSET.
+
+ * nsmenu.m (ns_update_menubar): Use FSET.
+
+2012-08-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Separate read and write access to Lisp_Object slots of Lisp_Process.
+ * process.h (PGET, PSET): New macros similar to AREF and ASET.
+ * gnutls.c, print.c, process.c, sysdep.c, w32.c, xdisp.c: Adjust users.
+
+2012-08-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Separate read and write access to Lisp_Object slots of struct window.
+ * window.h (WGET, WSET): New macros similar to AREF and ASET.
+ * alloc.c, buffer.c, composite.c, dispextern.h, dispnew.c, editfns.c:
+ * fileio.c, font.c, fontset.c, frame.c, frame.h, fringe.c, indent.c:
+ * insdel.c, keyboard.c, keymap.c, lisp.h, minibuf.c, msdos.c, nsfns.m:
+ * nsmenu.m, nsterm.m, print.c, textprop.c, w32fns.c, w32menu.c:
+ * w32term.c, window.c, xdisp.c, xfaces.c, xfns.c, xmenu.c, xterm.c:
+ Adjust users.
+
+2012-08-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix Windows build errors introduced after converting to FGET and FSET.
+ * w32term.c (x_frame_rehighlight, x_scroll_bar_create):
+ (w32_condemn_scroll_bars, w32_redeem_scroll_bar):
+ (w32_judge_scroll_bars): Change to use FSET.
+ Reported by Andy Moreton <andrewjmoreton@gmail.com>.
+
+2012-08-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix replacement typo.
+ * window.c (replace_window): Set root_window instead of
+ selected_window. This fixes a total window subsystem
+ malfunction reported by Bastien Guerry <bzg@gnu.org>.
+
+2012-08-06 Glenn Morris <rgm@gnu.org>
+
+ * lisp.mk (lisp): Add language/persian.elc.
+
+2012-08-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Separate read and write access to Lisp_Object slots of struct frame.
+ * frame.h (FGET, FSET): New macros similar to AREF and ASET.
+ * buffer.c, data.c, dispnew.c, dosfns.c, eval.c, fontset.c, frame.c:
+ * fringe.c, gtkutil.c, minibuf.c, msdos.c, nsfns.m, nsmenu.m, nsterm.m:
+ * print.c, term.c, w32fns.c, w32menu.c, w32term.c, window.c, window.h:
+ * xdisp.c, xfaces.c, xfns.c, xmenu.c, xterm.c: Adjust users.
+
+2012-08-05 Andreas Schwab <schwab@linux-m68k.org>
+
+ * emacs.c (decode_env_path): Only use defaulted if WINDOWSNT.
+
+2012-08-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Generalize common compile-time constants.
+ * lisp.h (header_size, bool_header_size, word_size): Now here.
+ (struct Lisp_Vector): Add comment.
+ (struct Lisp_Bool_Vector): Move up to define handy constants.
+ (VECSIZE, PSEUDOVECSIZE): Simplify.
+ (SAFE_ALLOCA_LISP): Use new constant. Adjust indentation.
+ * buffer.c, buffer.h, bytecode.c, callint.c, eval.c, fns.c:
+ * font.c, fontset.c, keyboard.c, keymap.c, macros.c, menu.c:
+ * msdos.c, w32menu.c, w32term.h, window.c, xdisp.c, xfaces.c:
+ * xfont.c, xmenu.c: Use word_size where appropriate.
+
+2012-08-05 Lawrence Mitchell <wence@gmx.li>
+
+ * search.c (Freplace_match): Treat \? in the replacement text
+ literally (Bug#8161).
+
+2012-08-05 Chong Yidong <cyd@gnu.org>
+
+ * term.c (Vsuspend_tty_functions, Vresume_tty_functions):
+ * frame.c (Vdelete_frame_functions):
+ * emacs.c (Vkill_emacs_hook): Doc fix.
+
+2012-08-04 Eli Zaretskii <eliz@gnu.org>
+
+ * xfns.c (x_set_menu_bar_lines): Fix compilation error in
+ --with-x-toolkit=no builds.
+ Reported by Carsten Mattner <carstenmattner@gmail.com>.
+
+2012-08-04 Chong Yidong <cyd@gnu.org>
+
+ * syntax.c (Fmodify_syntax_entry): Doc fix.
+
+2012-08-04 Eli Zaretskii <eliz@gnu.org>
+
+ Fix startup warnings about ../site-lisp on MS-Windows. (Bug#11959)
+ * w32.c (init_environment): Change the default values of many
+ environment variables in dflt_envvars[] to NULL, to avoid pushing
+ them into environment when they were not already defined.
+ Remove the code that deletes site-lisp subdirectories from the default
+ value of EMACSLOADPATH, as it is no longer needed.
+ (check_windows_init_file): Now external, not static.
+ Use Vload_path as is, without adding anything, as this function is now
+ called when Vload_path is already set up.
+
+ * w32.h (check_windows_init_file): Add prototype.
+
+ * emacs.c (init_cmdargs) [WINDOWSNT]: When running from the build
+ directory, ignore the /*/i386/ tail in Vinvocation_directory, for
+ compatibility with Posix platforms.
+ (main): Move the call to check_windows_init_file to here from
+ w32.c.
+ (decode_env_path) [WINDOWSNT]: Expand the %emacs_dir%/ prefix, if
+ any, in the DEFALT argument into the root of the Emacs build or
+ installation tree, as appropriate.
+
+ * callproc.c (init_callproc_1): Call decode_env_path instead of
+ doing its equivalent by hand.
+ (init_callproc): Replace DOS_NT condition with MSDOS, thus letting
+ the code that sets Vexec_path run on MS-Windows.
+
+ * lread.c (init_lread): Add comments to #ifdef's.
+
+ * msdos.c (dos_set_window_size, IT_update_begin)
+ (IT_frame_up_to_date, IT_set_frame_parameters): Use FVAR and WVAR
+ instead of direct references.
+
+2012-08-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Export DEFAULT_REHASH_* to GDB.
+ * lisp.h (DEFAULT_REHASH_THRESHOLD, DEFAULT_REHASH_SIZE):
+ Now constants, not macros.
+
+2012-08-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove unnecessary casts involving pointers.
+ These casts are no longer needed now that we assume C89 or later,
+ since they involve casting to or from void *.
+ * alloc.c (make_pure_string, make_pure_c_string, pure_cons)
+ (make_pure_float, make_pure_vector):
+ * lisp.h (SAFE_ALLOCA, SAFE_ALLOCA_LISP):
+ * macros.c (Fstart_kbd_macro):
+ * menu.c (find_and_return_menu_selection):
+ * minibuf.c (read_minibuf_noninteractive):
+ * sysdep.c (closedir):
+ * xdisp.c (x_produce_glyphs):
+ * xfaces.c (compare_fonts_by_sort_order):
+ * xfns.c (x_real_positions, select_visual):
+ * xselect.c (x_stop_queuing_selection_requests)
+ (x_get_window_property, x_get_window_property_as_lisp_data):
+ * xterm.c (x_set_frame_alpha, x_find_modifier_meanings):
+ Remove unnecessary pointer casts.
+ * alloc.c (record_xmalloc): New function.
+ * lisp.h (record_xmalloc): New decl.
+ (SAFE_ALLOCA): Now takes just one arg -- the size -- and acts
+ more like a function. This is because the pointer cast is not
+ needed. All uses changed.
+ * print.c (print_string, print_error_message): Avoid length recalc.
+
+ Improve fix for macroexp crash with debugging (Bug#12118).
+ * lisp.h (ASET) [ENABLE_CHECKING]: Pay attention to
+ ARRAY_MARK_FLAG when checking subscripts, because ASET is
+ not supposed to be invoked from the garbage collector.
+ See Andreas Schwab in <http://bugs.gnu.org/12118#25>.
+ (gc_aset): New function, which is like ASET but can be
+ used in the garbage collector.
+ (set_hash_key, set_hash_value, set_hash_next, set_hash_hash)
+ (set_hash_index): Use it instead of ASET.
+
+2012-08-03 Eli Zaretskii <eliz@gnu.org>
+
+ Support symlinks on latest versions of MS-Windows.
+ * w32.c: Include winioctl.h and aclapi.h.
+ (is_symlink, chase_symlinks, enable_privilege, restore_privilege)
+ (revert_to_self): Forward declarations of static functions.
+ <static BOOL g_b_init_get_security_info>:
+ <g_b_init_create_symbolic_link>: New static flags.
+ (globals_of_w32): Initialize them to zero.
+ (GetSecurityInfo_Proc, CreateSymbolicLink_Proc): New typedefs.
+ (map_w32_filename): Improve commentary. Simplify switch.
+ (SYMBOLIC_LINK_FLAG_DIRECTORY): Define if not defined in system
+ headers (most versions of MinGW w32api don't).
+ (get_security_info, create_symbolic_link)
+ (get_file_security_desc_by_handle, is_symlink, chase_symlinks):
+ New functions.
+ (sys_access, sys_chmod): Call 'chase_symlinks' to resolve symlinks
+ in the argument file name.
+ (sys_access): Call unc_volume_file_attributes only if
+ GetFileAttributes fails with network-related error codes.
+ (sys_rename): Diagnose renaming of a symlink when the user doesn't
+ have the required privileges.
+ (get_file_security_desc_by_name): Rename from
+ get_file_security_desc.
+ (stat_worker): New function, with most of the guts of 'stat', and
+ with addition of handling of symlinks and support for 'lstat'.
+ If possible, get file's attributes and security information by
+ handle, not by name. Produce S_IFLNK bit for symlinks, when
+ called from 'lstat'.
+ (stat, lstat): New functions, call 'stat_worker'.
+ (symlink, readlink, careadlinkat): Rewritten to create and resolve
+ symlinks when the underlying filesystem supports them.
+
+2012-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix macroexp crash on Windows with debugging (Bug#12118).
+ * lisp.h (ASET) [ENABLE_CHECKING]: Ignore ARRAY_MARK_FLAG when
+ checking subscripts; problem introduced with the recent
+ "ASET (a, i, v)" rather than "AREF (a, i) = v" patch.
+ (ARRAY_MARK_FLAG): Now a macro as well as a constant,
+ since it's used in non-static inline functions now.
+
+ * xfaces.c (face_at_buffer_position, face_for_overlay_string):
+ Don't assume buffer size fits in 'int'. Remove unused local.
+
+ Use C99-style 'extern inline' if available.
+ * buffer.h (BUFFER_INLINE):
+ * category.h (CATEGORY_INLINE):
+ * character.h (CHARACTER_INLINE):
+ * charset.h (CHARSET_INLINE):
+ * composite.h (COMPOSITE_INLINE):
+ * dispextern.h (DISPEXTERN_INLINE):
+ * lisp.h (LISP_INLINE):
+ * systime.h (SYSTIME_INLINE):
+ New macro, replacing 'static inline' in this header.
+ * buffer.h, category.h, character.h, charset.h, composite.h:
+ * dispextern.h, lisp.h, systime.h:
+ Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
+ * alloc.c (LISP_INLINE):
+ * buffer.c (BUFFER_INLINE):
+ * category.c (CATEGORY_INLINE):
+ * character.c (CHARACTER_INLINE):
+ * charset.c (CHARSET_INLINE):
+ * composite.c (COMPOSITE_INLINE):
+ * dispnew.c (DISPEXTERN_INLINE):
+ * sysdep.c (SYSTIME_INLINE):
+ Define to EXTERN_INLINE, so that the corresponding functions
+ are compiled into code.
+ * conf_post.h (INLINE, EXTERN_INLINE, INLINE_HEADER_BEGIN)
+ (INLINE_HEADER_END): New macros.
+ * lisp.h (PSEUDOVECTOR_FLAG): Now a macro as well as a constant,
+ since it's used in non-static inline functions now.
+ (VALMASK) [!USE_LSB_TAG]: Likewise.
+
+2012-08-02 Glenn Morris <rgm@gnu.org>
+
+ * s/: Remove empty directory.
+
+ * s/ms-w32.h: Move to ../nt/inc.
+ * makefile.w32-in (TAGS, TAGS-gmake, MS_W32_H):
+ Update for new ms-w32.h location.
+
+2012-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port to Solaris 8.
+ * syswait.h (WRETCODE): Remove, consistently with ../configure.ac.
+
+2012-08-02 Glenn Morris <rgm@gnu.org>
+
+ * nsterm.m (ns_exec_path, ns_load_path): Use SEPCHAR rather than
+ hard-coding the path separator.
+
+2012-08-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use "ASET (a, i, v)" rather than "AREF (a, i) = v".
+ This how ASET and AREF are supposed to work, and makes
+ it easier to think about future improvements. See
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00026.html>.
+ * charset.h (set_charset_attr): New function.
+ All lvalue-style uses of CHARSET_DECODER etc. changed to use it.
+ * lisp.h (ASET): Rewrite so as not to use AREF in an lvalue style.
+ (aref_addr): New function. All uses of &AREF(...) changed.
+ (set_hash_key, set_hash_value, set_hash_next, set_hash_hash)
+ (set_hash_index): New functions. All lvalue-style uses of
+ HASH_KEY etc. changed.
+ * keyboard.c (set_prop): New function. All lvalue-style uses
+ of PROP changed.
+
+2012-08-01 Alp Aker <alp.tekin.aker@gmail.com>
+
+ * nsterm.m (ns_set_vertical_scroll_bar, ns_redeem_scroll_bar)
+ (EmacsWindow-accessibilityAttributeValue, EmacsScroller-initFrame:)
+ (EmacsScroller-dealloc): Adjust to use WVAR. (Bug#12114)
+ * nsfns.m (ns_set_name_as_filename): Likewise.
+ * nsmenu.m (ns_update_menubar): Likewise.
+ * nsselect.m (symbol_to_nsstring): Adjust to use SVAR.
+
+2012-08-01 Eli Zaretskii <eliz@gnu.org>
+
+ * .gdbinit (xcar, xcdr, xlist, xwindow, nextcons, xprintsym):
+ Adapt to latest changes in field names of the corresponding Lisp
+ objects.
+
+ * xdisp.c (try_window_id): Use WVAR in IF_DEBUG code.
+
+2012-08-01 Glenn Morris <rgm@gnu.org>
+
+ * s/msdos.h: Remove file.
+ * conf_post.h [MSDOS]: New section, moved from s/msdos.h.
+ * Makefile.in (S_FILE): Remove.
+ (config_h): Remove S_FILE.
+
+2012-08-01 Juanma Barranquero <lekktu@gmail.com>
+
+ * s/ms-w32.h (DEVICE_SEP, IS_DIRECTORY_SEP, IS_ANY_SEP):
+ Remove; moved to nt/config.nt.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use INTERNAL_FIELD for conses and overlays.
+ * lisp.h (struct Lisp_Cons): Use INTERNAL_FIELD.
+ Remove obsolete comment.
+ (MVAR): New macro.
+ (struct Lisp_Overlay): Use INTERNAL_FIELD.
+ * alloc.c, buffer.c, buffer.h, fns.c: Adjust users.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use INTERNAL_FIELD for symbols.
+ * lisp.h (SVAR): New macro. Adjust users.
+ * alloc.c, bytecode.c, cmds.c, data.c, doc.c, eval.c:
+ * fns.c, keyboard.c, lread.c, xterm.c: Users changed.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use INTERNAL_FIELD for processes.
+ * process.h (PVAR): New macro. Adjust style.
+ (struct Lisp_Process): Change Lisp_Object members to INTERNAL_FIELD.
+ * print.c, process.c, sysdep.c, w32.c, xdisp.c: Users changed.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use INTERNAL_FIELD for windows.
+ * window.h (WVAR): New macro.
+ (struct window): Change Lisp_Object members to INTERNAL_FIELD.
+ * alloc.c, buffer.c, composite.c, dispextern.h, dispnew.c, editfns.c:
+ * fileio.c, font.c, fontset.c, frame.c, frame.h, fringe.c, indent.c:
+ * insdel.c, keyboard.c, keymap.c, lisp.h, minibuf.c, nsterm.m, print.c:
+ * textprop.c, w32fns.c, w32menu.c, w32term.c, window.c, xdisp.c:
+ * xfaces.c, xfns.c, xmenu.c, xterm.c: Users changed.
+
+2012-08-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * coding.h (CODING_ATTR_FLUSHING): Remove; unused and wouldn't work.
+
+2012-08-01 Glenn Morris <rgm@gnu.org>
+
+ * lisp.h (IS_DIRECTORY_SEP, IS_DEVICE_SEP, IS_ANY_SEP):
+ Move to configure.ac.
+
+2012-08-01 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (CONFIG_H): Update dependencies.
+ (CONF_POST_H): New macro.
+
+ * s/ms-w32.h (SEPCHAR, NULL_DEVICE): Remove; moved to nt/config.nt.
+
+2012-07-31 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (S_FILE): No longer set by configure.
+
+ * conf_post.h (config_opsysfile): Move earlier, so that WINDOWSNT
+ is available.
+ (alloca.h) [WINDOWSNT]: Don't include it on MS Windows.
+
+ * process.h (NULL_DEVICE):
+ * emacs.c (SEPCHAR):
+ * editfns.c (USER_FULL_NAME): Let configure set them.
+
+ * s/README, s/template.h: Remove files.
+
+ * conf_post.h [HPUX]: Undefine HAVE_RANDOM and HAVE_RINT.
+
+ * conf_post.h (AMPERSAND_FULL_NAME, subprocesses):
+ Move to configure.ac.
+
+2012-07-31 Eli Zaretskii <eliz@gnu.org>
+
+ * .gdbinit (xframe): Adapt to introduction of FVAR and the
+ resulting renaming of 'struct frame' members.
+
+ * w32menu.c (w32_menu_show): Revert bogus introduction of FVAR.
+
+ * fontset.c (dump_fontset): Fix compilation with ENABLE_CHECKING
+ after introduction of FVAR.
+
+2012-07-31 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsmenu.m (update_frame_tool_bar): Change key from NSObject* to id.
+
+ * nsterm.m (ns_draw_fringe_bitmap, ns_dumpglyphs_image): Use drawInRect
+ instead of compositeToPoint.
+ (applicationShouldTerminate): Pass NS String literal to NSRunAlertPanel.
+
+ * nsfns.m, nsmenu.m, nsterm.m: Adopt to struct frame/FVAR changes.
+
+2012-07-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Generalize INTERNAL_FIELD between buffers, keyboards and frames.
+ * lisp.h (INTERNAL_FIELD): New macro.
+ * buffer.h (BUFFER_INTERNAL_FIELD): Remove.
+ (BVAR): Change to use INTERNAL_FIELD.
+ * keyboard.h (KBOARD_INTERNAL_FIELD): Likewise.
+ (KVAR): Change to use INTERNAL_FIELD.
+ * frame.h (FVAR): New macro.
+ (struct frame): Use INTERNAL_FIELD for all Lisp_Object fields.
+ * alloc.c, buffer.c, data.c, dispnew.c, dosfns.c, eval.c, frame.c:
+ * fringe.c, gtkutil.c, minibuf.c, nsfns.m, nsterm.m, print.c:
+ * term.c, w32fns.c, w32menu.c, w32term.c, window.c, window.h:
+ * xdisp.c, xfaces.c, xfns.c, xmenu.c, xterm.c: Users changed.
+
+2012-07-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Miscellaneous fixes for non-default X toolkits.
+ * xfns.c (Fx_file_dialog): Change to SSDATA to avoid warnings.
+ * xterm.c (x_frame_of_widget): Remove redundant prototype.
+ Move under #ifdef USE_LUCID.
+ (x_create_toolkit_scroll_bar): Adjust scroll_bar_name
+ definition and usage to avoid warnings.
+
+2012-07-31 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (openFiles): Fix previous checkin.
+
+2012-07-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ * indent.c (compute_motion): Remove unused local.
+
+2012-07-31 Glenn Morris <rgm@gnu.org>
+
+ * s/usg5-4-common.h (wait3, WRETCODE): Let configure set them.
+
+ * conf_post.h [USG5_4]:
+ Move remaining contents of s/usg5-4-common.h here.
+ * s/usg5-4-common.h: Remove file.
+
+ * conf_post.h [IRIX6_5]: Move remaining contents of s/irix6-5.h here.
+ * s/irix6-5.h: Remove file.
+
+ * conf_post.h [DARWIN_OS]: Move remaining contents of s/darwin.h here.
+ * s/darwin.h: Remove file.
+
+ * conf_post.h [HPUX]: Move random, srandom here from s/hpux10-20.h.
+ * s/hpux10-20.h: Remove file, which is now empty.
+
+2012-07-30 Glenn Morris <rgm@gnu.org>
+
+ * conf_post.h: New, split from configure.ac's AH_BOTTOM.
+ * Makefile.in (config_h): Add conf_post.h.
+ * makefile.w32-in (CONFIG_H): Add conf_post.h.
+
+2012-07-30 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_do_open_file): New variable.
+ (ns_term_init): Set ns_do_open_file to YES after run returns.
+ (openFile, openTempFile, openFileWithoutUI, openFiles):
+ Open files only if ns_do_open_file.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h (SWITCH_ENUM_CAST): Remove. All uses removed.
+ This no-op macro hasn't been needed for many years.
+ * src/regex.c (SWITCH_ENUM_CAST) [!emacs]: Likewise.
+
+ Export DIRECTORY_SEP, TYPEMASK, VALMASK to GDB.
+ * alloc.c (gdb_make_enums_visible) [USE_LSB_TAG]: Add lsb_bits.
+ * lisp.h (enum lsb_bits) [USE_LSB_TAG]: New enum, for
+ gdb_make_enums_visible.
+ (TYPEMASK, VALMASK) [USE_LSB_TAGS]: Now enum constants, not macros.
+ (DIRECTORY_SEP): Now a constant, not a macro.
+
+2012-07-30 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c (w32_wnd_proc): Pass w32_keyboard_codepage to
+ w32_kbd_patch_key as the 2nd arg. (Bug#12082)
+
+ * w32term.c <w32_keyboard_codepage>: Renamed from
+ keyboard_codepage and now external. All users changed.
+
+ * w32term.h: Add declaration of w32_keyboard_codepage.
+
+ * w32inevt.c (w32_kbd_patch_key): Accept an additional argument --
+ the codepage to translate keys to Unicode. If this argument is
+ -1, use the value returned by GetConsoleCP. All callers changed.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Update .PHONY listings in makefiles.
+ * Makefile.in (.PHONY): Add all, mostlyclean, clean,
+ bootstrap-clean, distclean, maintainer-clean, versioclean,
+ extraclean, frc.
+
+ * lisp.h (STRING_BYTES_BOUND): Cast entire result to ptrdiff_t.
+ This is a bit clearer. Fix some commentary typos.
+
+2012-07-30 Glenn Morris <rgm@gnu.org>
+
+ * s/netbsd.h: Let configure include signal.h if needed.
+ Remove file, which is now empty.
+
+ * s/usg5-4-common.h (_longjmp, _setjmp, TIOCSIGSEND):
+ Let configure set them.
+ * s/irix6-5.h (_longjmp, _setjmp, TIOCSIGSEND):
+ No more need to undefine.
+
+2012-07-30 Andreas Schwab <schwab@linux-m68k.org>
+
+ * keymap.c (Fkey_description): Don't remove 0x80 bit from
+ non-single-byte char when adding meta modifier. (Bug#12090)
+
+2012-07-30 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Convert safe_call to use variable number of arguments.
+ * xdisp.c (safe_call): Convert to use varargs. Adjust users.
+ (safe_call2): Fix comment.
+ * lisp.h (safe_call): Adjust prototype.
+ * coding.c (encode_coding_object): Change to use safe_call2.
+ * xfaces.c (merge_face_heights): Change to use safe_call1.
+
+2012-07-30 Glenn Morris <rgm@gnu.org>
+
+ * s/aix4-2.h (sigmask): No need to undefine it, since syssignal.h
+ does that unconditionally. Remove file, which is now empty.
+
+ * s/freebsd.h, s/gnu-linux.h, s/sol2-6.h, s/unixware.h:
+ Remove empty files.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Export to GDB most of lisp.h's remaining object-like macros.
+ * lisp.h (min, max): Move earlier, because they're used earlier now.
+ (INTMASK, ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, VALMASK)
+ (CHAR_TABLE_STANDARD_SLOTS, CHARTAB_SIZE_BITS_0)
+ (CHARTAB_SIZE_BITS_1, CHARTAB_SIZE_BITS_2, CHARTAB_SIZE_BITS_3)
+ (DEFAULT_HASH_SIZE, COMPILED_ARGLIST, COMPILED_BYTECODE)
+ (COMPILED_CONSTANTS, COMPILED_STACK_DEPTH, COMPILED_DOC_STRING)
+ (COMPILED_INTERACTIVE, CHAR_ALT, CHAR_SUPER, CHAR_HYPER, CHAR_SHIFT)
+ (CHAR_CTL, CHAR_META, CHAR_MODIFIER_MASK, CHARACTERBITS)
+ (MANY, UNEVALLED, FLOAT_TO_STRING_BUFSIZE, MAX_ALLOCA):
+ Now constants, for GDB. They need not be macros.
+ (MOST_POSITIVE_FIXNUM, MOST_NEGATIVE_FIXNUM, STRING_BYTES_BOUND):
+ Now constants, for GDB, as well as macros, for static initializers.
+ (CHAR_TABLE_STANDARD_SLOTS, CHAR_TABLE_EXTRA_SLOTS):
+ Move to after the definition of struct Lisp_Char_Table,
+ since the former now needs that type defined.
+ (enum CHARTAB_SIZE_BITS, enum CHAR_TABLE_STANDARD_SLOTS)
+ (enum DEFAULT_HASH_SIZE, enum Lisp_Compiled, enum char_bits)
+ (enum maxargs, enum FLOAT_TO_STRING_BUFSIZE, enum MAX_ALLOCA):
+ New enums, for gdb_make_enums_visible.
+ (GLYPH_MODE_LINE_FACE): Remove; unused.
+ * alloc.c (STRING_BYTES_MAX): Now a constant, not a macro.
+ (gdb_make_enums_visible): Add enum CHARTAB_SIZE_BITS, enum
+ CHAR_TABLE_STANDARD_SLOTS, enum char_bits, enum DEFAULT_HASH_SIZE,
+ enum FLOAT_TO_STRING_BUFSIZE, enum Lisp_Bits, enum Lisp_Compiled,
+ enum maxargs, enum MAX_ALLOCA.
+ (ARRAY_MARK_FLAG_VAL, PSEUDOVECTOR_FLAG_VAL, VALMASK_VAL): Remove.
+ (ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, VALMASK): Remove;
+ no longer needed, now that they are done in lisp.h.
+
+2012-07-30 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup string bytes checking.
+ * alloc.c (GC_STRING_BYTES, CHECK_STRING_BYTES): Remove. Convert
+ all users to STRING_BYTES or string_bytes if GC_CHECK_STRING_BYTES.
+ (check_string_bytes): Define to empty if not GC_CHECK_STRING_BYTES.
+ (check_sblock, compact_small_strings): Simplify.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h (LISP_INT_TAG, LISP_INT1_TAG, LISP_STRING_TAG): Remove.
+ These macros are confusing and no longer need to be defined, as
+ the enum values now suffice. All uses replaced with definiens.
+ (Lisp_Int1, Lisp_String): Define directly; this is clearer.
+
+2012-07-29 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (LISP_H, $(BLD)/emacs.$(O), $(BLD)/w32inevt.$(O))
+ ($(BLD)/w32console.$(O)): Update dependencies.
+
+2012-07-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Remove HIDE_LISP_IMPLEMENTATION and cleanup cons free list check.
+ * lisp.h (HIDE_LISP_IMPLEMENTATION): Remove as useless for a long
+ time. Adjust users.
+ (CHECK_CONS_LIST): Remove. Convert all users to check_cons_list.
+
+2012-07-29 Jan Djärv <jan.h.d@swipnet.se>
+
+ * lread.c (init_lread): Remove if-statement in ifdef HAVE_NS before
+ setting sitelisp (Bug#12010).
+
+2012-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ * w32heap.h (OS_9X): Rename from OS_WINDOWS_95.
+
+ * w32heap.c (cache_system_info):
+ * w32.c (sys_rename):
+ * w32proc.c (find_child_console, sys_kill): All users changed.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c (Fgarbage_collect): Indent as per usual Emacs style.
+
+2012-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (LISP_H): Add $(NT_INC)/stdalign.h.
+
+2012-07-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup statistics calculation in Fgarbage_collect.
+ * alloc.c (Fgarbage_collect): Rename t1 to meaningful start.
+ Fix zombies percentage calculation. Simplify elapsed time calculation.
+
+2012-07-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Generalize marker debugging code under MARKER_DEBUG and use eassert.
+ * insdel.c (CHECK_MARKERS, check_markers_debug_flag): Remove.
+ (gap_left, gap_right, adjust_markers_for_delete, insert_1_both)
+ (insert_from_string_1, insert_from_gap, insert_from_buffer_1)
+ (replace_range, replace_range_2, del_range_2): Change to eassert.
+ * marker.c (byte_char_debug_check): Adjust style.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don't use the abbreviation "win" to refer to Windows (Bug#10421).
+ * regex.c (MAX_BUF_SIZE): Remove some incorrect and
+ long-ago-commented-out code that talks about "WIN32".
+ * w32heap.h (OS_WINDOWS_95): Rename from OS_WIN95.
+ All uses changed.
+
+2012-07-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use Gnulib stdalign module (Bug#9772, Bug#9960).
+ * alloc.c (XMALLOC_BASE_ALIGNMENT, GC_POINTER_ALIGNMENT, pure_alloc):
+ Simplify by using alignof.
+ (pure_alloc) [! USE_LSB_TAG]: Don't over-align EMACS_INT values.
+ * lisp.h: Include <stdalign.h>.
+ (GCALIGNMENT): New macro and constant.
+ (DECL_ALIGN): Remove. All uses replaced by alignas (GCALIGNMENT).
+ (USE_LSB_TAG): ifdef on alignas, not on DECL_ALIGN.
+ (stdalign): New macro, if not already defined.
+
+2012-07-28 Eli Zaretskii <eliz@gnu.org>
+
+ Fix non-ASCII input in non-GUI frames on MS-Windows. (Bug#12055)
+ * w32inevt.c: Include w32inevt.h.
+ (w32_read_console_input): New inline function, calls either
+ ReadConsoleInputA or ReadConsoleInputW, depending on the value of
+ w32_console_unicode_input.
+ (fill_queue): Call w32_read_console_input instead of ReadConsoleInput.
+ (w32_kbd_patch_key, key_event): Use the codepage returned by
+ GetConsoleCP, rather than the ANSI codepage returned by GetLocaleInfo.
+ (key_event): use uChar.UnicodeChar only if
+ w32_console_unicode_input is non-zero.
+
+ * w32console.c: Include w32heap.h.
+ <w32_console_unicode_input>: New global variable.
+ (initialize_w32_display): Set w32_console_unicode_input to 1 on NT
+ family of Windows, zero otherwise.
+
+ * w32inevt.h: Declare w32_console_unicode_input.
+
+ * xdisp.c (init_iterator): Don't reference tip_frame in a build
+ --without-x. (Bug#11742)
+
+2012-07-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Adjust GDB to reflect pvec_type changes (Bug#12036).
+ * .gdbinit (xvectype, xpr, xbacktrace): Adjust to reflect the
+ 2012-07-04 changes to pseudovector representation.
+ Problem reported by Eli Zaretskii in <http://bugs.gnu.org/12036#30>.
+
+2012-07-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (XD_DBUS_VALIDATE_BUS_ADDRESS): Canonicalize session
+ bus address.
+ (xd_close_bus, Fdbus_init_bus): Handle reference counter properly.
+
+2012-07-27 Eli Zaretskii <eliz@gnu.org>
+
+ * alloc.c (listn): Fix the order the arguments are consed onto the
+ list.
+
+ * lisp.h (enum constype): Use CONSTYPE_HEAP and CONSTYPE_PURE for
+ enumeration constants, as PURE and HEAP are too general, and clash
+ with other headers and sources, such as gmalloc.c and the
+ MS-Windows system headers. All users changed.
+
+2012-07-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Revert last save_excursion_save and save_excursion_restore changes.
+ * alloc.c, editfns.c, marker.c, lisp.h: Revert.
+ Lots of crashes reported by Chong Yidong <cyd@gnu.org>.
+
+2012-07-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix recently-introduced typos in Windows port.
+ Reported by Martin Rudalics <rudalics@gmx.at>.
+ * w32.c (init_environment): Replace comma with semicolon.
+ * w32fns.c (syms_of_w32fns): Add missing parenthesis.
+
+2012-07-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve GDB symbol export (Bug#12036).
+ * .gdbinit (xgetptr, xgetint, xgettype): Set $bugfix in different
+ arms of an 'if', not using conditional expressions; otherwise GDB
+ complains about the types in the unevaluated arm when the argument
+ is an integer literal.
+ (xgetint): Simplify expression.
+ * alloc.c (gdb_make_enums_visible): New constant. This ports to
+ GCC 3.4.2 the export of symbols to GDB. Problem reported by Eli
+ Zaretskii in <http://bugs.gnu.org/12036#13>.
+ * lisp.h (PUBLISH_TO_GDB): Remove. All uses removed. No longer
+ needed now that we have gdb_make_enums_visible.
+ (enum CHECK_LISP_OBJECT_TYPE, enum Lisp_Bits, enum More_Lisp_Bits)
+ (enum enum_USE_LSB_TAG):
+ New enum types, packaging up enums that need to be exported to GDB.
+
+2012-07-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Utility function to make a list from specified amount of objects.
+ * lisp.h (enum constype): New datatype.
+ (listn): New prototype.
+ * alloc.c (listn): New function.
+ (Fmemory_use_count, syms_of_alloc): Use it.
+ * buffer.c (syms_of_buffer): Likewise.
+ * callint.c (syms_of_callint): Likewise.
+ * charset.c (define_charset_internal): Likewise.
+ * coding.c (syms_of_coding): Likewise.
+ * keymap.c (syms_of_keymap): Likewise.
+ * search.c (syms_of_search): Likewise.
+ * syntax.c (syms_of_syntax): Likewise.
+ * w32.c (init_environment): Likewise.
+ * w32fns.c (Fw32_battery_status, syms_of_w32fns): Likewise.
+ * xdisp.c (syms_of_xdisp): Likewise.
+ * xfns.c (syms_of_xfns): Likewise.
+
+2012-07-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fast save_excursion_save and save_excursion_restore.
+ * lisp.h (struct Lisp_Excursion): New data type.
+ (PVEC_EXCURSION): New pseudovector type.
+ (XEXCURSION, XSETEXCURSION, EXCURSIONP): Convenient macros
+ to deal with it. Adjust comments.
+ (init_marker, attach_marker): New prototype.
+ (unchain_marker): Adjust prototype.
+ * marker.c (attach_marker): Change to global.
+ (init_marker): New function.
+ * alloc.c (Fmake_marker, build_marker): Use it.
+ (build_marker): More easserts.
+ (mark_object): Handle struct Lisp_Excursion.
+ * editfns.c (save_excursion_save, save_excursion_restore):
+ Reimplement to use struct Lisp_Excursion. Add comments.
+
+2012-07-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix export of symbols to GDB (Bug#12036).
+ * alloc.c (ARRAY_MARK_FLAG_VAL, PSEUDOVECTOR_FLAG_VAL, VALMASK_VAL)
+ (ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, VALMASK): Move these here from
+ emacs.c, as this is a more-suitable home. Had this been done earlier
+ the fix for 12036 would have avoided some of the problems noted in
+ <http://bugs.gnu.org/12036#13> by Eli Zaretskii, as the scope problems
+ would have been more obvious.
+ * emacs.c: Do not include <verify.h>; no longer needed.
+ (gdb_CHECK_LISP_OBJECT_TYPE, gdb_DATA_SEG_BITS)
+ (gdb_GCTYPEBITS, gdb_USE_LSB_TAG)
+ (CHECK_LISP_OBJECT_TYPE, DATA_SEG_BITS, GCTYPEBITS, USE_LSB_TAG):
+ Remove; now done in lisp.h.
+ * lisp.h (PUBLISH_TO_GDB): New macro.
+ (GCTYPEBITS, USE_LSB_TAG, CHECK_LISP_OBJECT_TYPE, enum pvec_type)
+ (DATA_SEG_BITS): Use it.
+ (GCTYPEBITS, USE_LSB_TAG): Now also an enum, for GDB.
+ (CHECK_LISP_OBJECT_TYPE, DATA_SEG_BITS): Now just an enum, for GDB.
+ * mem-limits.h (EXCEEDS_LISP_PTR): Redo so that DATA_SEG_BITS need
+ not be usable in #if. This simplifies things.
+
+2012-07-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/emacs.$(O)): Update dependencies.
+
+2012-07-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify export of symbols to GDB (Bug#12036).
+ * .gdbinit (xgetptr, xgetint, xgettype): Don't use "set $bugfix =
+ $bugfix.i", as this doesn't work (with GDB 7.4.1, anyway).
+ (xgetptr, xgetint, xgettype, xcoding, xcharset, xprintbytestr):
+ Adjust to changes in lisp.h and emacs.c, by using
+ CHECK_LISP_OBJECT_TYPE rather than gdb_use_struct, VALMASK instead
+ of $valmask, DATA_SEG_BITS instead of gdb_data_seg_bits,
+ INTTYPEBITS instead of gdb_gctypebits - 1, USE_LSB_TAG instead of
+ gdb_use_lsb, (1 << GCTYPEBITS) - 1 instead of $tagmask, VALBITS
+ instead of gdb_valbits.
+ (xvectype, xvector, xpr, xprintstr, xbacktrace): Similarly, use
+ PSEUDOVECTOR_FLAG instead of PVEC_FLAG, and ARRAY_MARK_FLAG
+ instead of gdb_array_mark_flag.
+ (xboolvector): Get size from $->size, not $->header.size.
+ Use BOOL_VECTOR_BITS_PER_CHAR rather than mystery constants.
+ (xreload, hook-run, hookpost-run): Remove.
+ * emacs.c: Include <verify.h>.
+ (gdb_use_lsb, gdb_use_struct, gdb_valbits, gdb_gctypebits)
+ (gdb_data_seg_bits, PVEC_FLAG, gdb_array_mark_flag, gdb_pvec_type):
+ Remove.
+ (gdb_CHECK_LISP_OBJECT_TYPE, gdb_DATA_SEG_BITS, gdb_GCTYPEBITS)
+ (gdb_USE_LSB_TAG): New enum constants.
+ (CHECK_LISP_OBJECT_TYPE, DATA_SEG_BITS, GCTYPEBITS, USE_LSB_TAG):
+ Also define these as enum constants, so they're visible to GDB.
+ (ARRAY_MARK_FLAG_VAL, PSEUDOVECTOR_FLAG_VAL, VALMASK_VAL): New macros.
+ (ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, VALMASK): Also define these
+ as constants, so they're visible to GDB.
+ * lisp.h (VALBITS, INTTYPEBITS, FIXNUM_BITS, PSEUDOVECTOR_SIZE_BITS)
+ (PSEUDOVECTOR_SIZE_MASK, PVEC_TYPE_MASK, BOOL_VECTOR_BITS_PER_CHAR):
+ Now enum constants, not macros, so they're visible to GDB.
+ (CHECK_LISP_OBJECT_TYPE, DATA_SEG_BITS): Default to 0, as this is
+ more convenient now. All uses changed.
+ (VALMASK) [USE_LSB_TAG]: Also define in this case.
+ * mem-limits.h (EXCEEDS_LISP_PTR): Adjust to DATA_SEG_BITS change.
+
+2012-07-26 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Explicitly free restriction data that are not needed anymore.
+ * editfns.c (save_restriction_restore): Free restriction data.
+
+2012-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Fautoload_do_load): Rename from do_autoload, export to Lisp,
+ add argument, tune behavior, and adjust all callers.
+
+2012-07-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use typedef for EMACS_INT, EMACS_UINT.
+ * lisp.h, s/ms-w32.h (EMACS_INT, EMACS_UINT): Use typedefs rather
+ than macros. This simplifies debugging in the usual case, since
+ it lets GDB show addresses as 'EMACS_INT *' rather than 'long int *'
+ and it allows expressions involving EMACS_INT casts.
+ * .gdbinit (xreload): Simplify by using EMACS_INT cast.
+
+2012-07-25 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_read_socket): Return early if there is a modal
+ window (Bug#12043).
+
+2012-07-25 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.c (Fredirect_frame_focus): In doc-string don't mention
+ that FOCUS-FRAME can be omitted.
+
+2012-07-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Adjust buffer text indirection counters at the end of Fkill_buffer.
+ * buffer.c (Fkill_buffer): Adjust indirection counters when the
+ buffer is definitely dead. This should really fix an issue reported
+ by Christoph Scholtes again. (Bug#12007).
+ (init_buffer_once): Initialize indirection counters of
+ buffer_defaults and buffer_local_symbols (for sanity and safety).
+
+2012-07-24 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (init_iterator): Don't compute dimensions of truncation
+ and continuation glyphs on tooltip frames, leave them at zero.
+ Avoids continued lines in tooltips. (Bug#11832)
+
+2012-07-24 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simplify copy_overlay.
+ * buffer.c (copy_overlay): Simplify. Use build_marker.
+ * lisp.h (struct Lisp_Overlay): Restore comment with minor tweaks.
+
+2012-07-23 Eli Zaretskii <eliz@gnu.org>
+
+ * print.c (print_object): Don't crash when a frame's name is nil
+ or invalid. (Bug#12025)
+
+ * window.c (decode_any_window): Disable CHECK_LIVE_FRAME test, as
+ it signals an error when a tooltip frame is being created.
+
+2012-07-23 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup miscellaneous objects allocation and initialization.
+ * alloc.c (allocate_misc): Change to static. Add argument to
+ specify the subtype. Adjust comment and users.
+ (build_overlay): New function.
+ * buffer.c (copy_overlays, Fmake_overlay): Use it.
+ * lisp.h (struct Lisp_Overlay): Remove obsolete comment.
+ (allocate_misc): Remove prototype.
+ (build_overlay): Add prototype.
+
+2012-07-23 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Swap buffer text indirection counters in Fbuffer_swap_text.
+ * buffer.c (Fbuffer_swap_text): Swap indirections too.
+ This avoids crash reported by Christoph Scholtes at
+ http://lists.gnu.org/archive/html/bug-gnu-emacs/2012-07/msg00785.html.
+
+2012-07-22 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsmenu.m (Popdown_data): New struct.
+ (pop_down_menu): p->pointer is Popdown_data. Release the pool and
+ free Popdown_data.
+ (ns_popup_dialog): Use NSAutoreleasePool and pass it to pop_down_menu.
+ (initWithContentRect): Make imgView and contentView non-static
+ and autorelease them. Also autorelease img and matrix (Bug#12005).
+ (dealloc): Remove (Bug#12005).
+
+2012-07-22 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Adjust consing_since_gc when objects are explicitly freed.
+ * alloc.c (GC_DEFAULT_THRESHOLD): New macro.
+ (Fgarbage_collect): Use it. Change minimum to 1/10 of default.
+ (free_cons, free_misc): Subtract object size from consing_since_gc.
+
+2012-07-22 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simplify and cleanup markers positioning code.
+ * marker.c (attach_marker): More useful eassert.
+ (live_buffer, set_marker_internal): New function.
+ (Fset_marker, set_marker_restricted): Use set_marker_internal.
+ (set_marker_both, set_marker_restricted_both): Use live_buffer.
+
+2012-07-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * buffer.h (struct buffer.indirections): Now ptrdiff_t, not int,
+ as it's limited by the amount of memory, not by INT_MAX.
+
+2012-07-21 Eli Zaretskii <eliz@gnu.org>
+
+ * keyboard.c (keys_of_keyboard): Bind language-change to 'ignore'
+ in special-event-map. See the discussion at
+ http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00417.html
+ for the reasons.
+
+ * w32menu.c (add_menu_item): Cast to ULONG_PTR when assigning
+ info.dwItemData. Fixes crashes on 64-bit Windows.
+ Suggested by Fabrice Popineau <fabrice.popineau@supelec.fr>.
+
+2012-07-21 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (accessibilityAttributeValue): New function. (Bug#11134).
+ (conversationIdentifier): Return value is NSInteger.
+ * nsterm.m (accessibilityAttributeValue): Surround with NS_IMPL_COCOA.
+
+2012-07-21 Chong Yidong <cyd@gnu.org>
+
+ * window.c (decode_any_window): Signal an error if the window is
+ on a dead frame (Bug#11984).
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Add indirection counting to speed up Fkill_buffer.
+ * buffer.h (struct buffer): New member.
+ * buffer.c (Fget_buffer_create): Set indirection counter to 0.
+ (Fmake_indirect_buffer): Set indirection counter to -1, increment
+ base buffer indirection counter.
+ (compact_buffer): If ENABLE_CHECKING, verify indirection counters.
+ (Fkill_buffer): Adjust indirection counters as needed, don't walk
+ through buffer list if indirection counter is 0.
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Extend the value returned by Fgarbage_collect with heap statistics.
+ * alloc.c (Qheap): New symbol.
+ (syms_of_alloc): DEFSYM it.
+ (Fgarbage_collect): If DOUG_LEA_MALLOC, add mallinfo data.
+ (Fmemory_free): Remove.
+ (syms_of_alloc): Don't defsubr it.
+ * buffer.c (Fcompact_buffer): Remove.
+ (syms_of_buffer): Don't defsubr it.
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Make maybe_gc inline.
+ Verify that inlining is always possible (GCC 4.7.1, -O3 -Winline).
+ * lisp.h (consing_since_gc, gc_relative_threshold)
+ (memory_full_cons_threshold): Revert declaration.
+ (maybe_gc): Remove prototype, define as inline.
+ * alloc.c: Remove old commented-out code.
+ (consing_since_gc, gc_relative_threshold)
+ (memory_full_cons_threshold): Revert to global.
+ (maybe_gc): Remove.
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simple wrapper for make_unibyte_string, adjust font_open_by_name.
+ * lisp.h (build_unibyte_string): New function.
+ * dosfns.c, fileio.c, fns.c, ftfont.c, process.c:
+ * sysdep.c, w32fns.c, xfns.c: Use it.
+ * font.c (font_open_by_name): Change 2nd and 3rd args to the only arg
+ of type Lisp_Object to avoid redundant calls to make_unibyte_string.
+ Adjust users accordingly.
+ * font.h (font_open_by_name): Adjust prototype.
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup calls to Fgarbage_collect.
+ * lisp.h (maybe_gc): New prototype.
+ (consing_since_gc, gc_relative_threshold, memory_full_cons_threshold):
+ Remove declarations.
+ * alloc.c (maybe_gc): New function.
+ (consing_since_gc, gc_relative_threshold, memory_full_cons_threshold):
+ Make them static.
+ * bytecode.c (MAYBE_GC): Use maybe_gc.
+ * eval.c (eval_sub, Ffuncall): Likewise.
+ * keyboard.c (read_char): Likewise. Adjust call to maybe_gc
+ to avoid dependency from auto-save feature.
+
+2012-07-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * buffer.h (FOR_EACH_BUFFER): Rename from 'for_each_buffer'.
+ (FOR_EACH_PER_BUFFER_OBJECT_AT): Rename from
+ 'for_each_per_buffer_object_at'.
+ All uses changed. It's better to use upper-case for macros that
+ cannot be implemented as functions, to give the reader a clue
+ that they're special.
+
+2012-07-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * alloc.c (Fgarbage_collect): Tweak docstring.
+
+2012-07-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Tweak the value returned from Fgarbage_collect again.
+ * alloc.c (Fgarbage_collect): New return value, as confirmed in
+ http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00418.html.
+ Adjust documentation.
+ (total_vector_bytes): Rename to total_vector_slots, adjust
+ accounting.
+ (total_free_vector_bytes): Rename to total_free_vector_slots,
+ adjust accounting.
+ (Qstring_bytes, Qvector_slots): New symbols.
+ (syms_of_alloc): DEFSYM them.
+
+2012-07-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Buffer compaction primitive which may be used from Lisp.
+ * buffer.c (compact_buffer, Fcompact_buffer): New function.
+ (syms_of_buffer): Register Fcompact_buffer.
+ * alloc.c (Fgarbage_collect): Use compact_buffer.
+ * buffer.h (compact_buffer): New prototype.
+ (struct buffer_text): New member.
+
+2012-07-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ New macro to iterate over all buffers, miscellaneous cleanups.
+ * lisp.h (all_buffers): Remove declaration.
+ * buffer.h (all_buffers): Add declaration, with comment.
+ (for_each_buffer): New macro.
+ * alloc.c (Fgarbage_collect, mark_object): Use it.
+ * buffer.c (Fkill_buffer, Fbuffer_swap_text, Fset_buffer_multibyte)
+ (init_buffer): Likewise.
+ * data.c (Fset_default): Likewise.
+ * coding.c (code_conversion_restore): Remove redundant check
+ for dead buffer.
+ * buffer.c (Fkill_buffer): Likewise. Remove obsolete comment.
+
+2012-07-18 Andreas Schwab <schwab@linux-m68k.org>
+
+ Fix bug that created negative-length intervals.
+ * intervals.c (merge_interval_right, merge_interval_left):
+ Do not zero out this interval if it is absorbed by its children,
+ as this interval's total length doesn't change in that case. See
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00403.html>.
+
+2012-07-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c (Fmake_bool_vector): Fix off-by-8 bug
+ when invoking (make-bool-vector N t) and N is a positive
+ multiple of 8 -- the last 8 bits were mistakenly cleared.
+
+ Remove some struct layout assumptions in bool vectors.
+ * alloc.c (bool_header_size): New constant.
+ (header_size, word_size): Move earlier, as they're now used earlier.
+ Use 'word_size' in a few more places, where it's appropriate.
+ (Fmake_bool_vector, sweep_vectors): Don't assume that there is no
+ padding before the data member of a bool vector.
+ (sweep_vectors): Use PSEUDOVECTOR_TYPEP, in an eassert, rather
+ than doing the check by hand with an abort ().
+
+2012-07-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Fdefvar): Don't check constants since we only set the var if
+ it's not yet defined anyway (bug#11904).
+
+ * lisp.h (last_undo_boundary): Declare new var.
+ * keyboard.c (command_loop_1): Set it.
+ * cmds.c (Fself_insert_command): Use it to only remove boundaries that
+ were auto-added by the command loop (bug#11774).
+
+2012-07-18 Andreas Schwab <schwab@linux-m68k.org>
+
+ * w32font.c (Qsymbol): Remove local definition.
+ (syms_of_w32font): Don't DEFSYM it.
+
+2012-07-18 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix sweep_vectors to handle large bool vectors correctly.
+ * alloc.c (sweep_vectors): Account total_vector_bytes for
+ bool vectors larger than VBLOCK_BYTES_MAX.
+
+2012-07-18 Chong Yidong <cyd@gnu.org>
+
+ * frame.c (x_set_frame_parameters): Revert bogus change introduced
+ in 2012-05-25 commit by Paul Eggert (Bug#11738).
+
+2012-07-18 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Return more descriptive data from Fgarbage_collect.
+ Suggested by Stefan Monnier in
+ http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00369.html.
+ * alloc.c (bounded_number): New function.
+ (total_buffers, total_vectors): New variable.
+ (total_string_size): Rename to total_string_bytes, adjust users.
+ (total_vector_size): Rename to total_vector_bytes, adjust users.
+ (sweep_vectors): Account total_vectors and total_vector_bytes.
+ (Fgarbage_collect): New return value. Adjust documentation.
+ (gc_sweep): Account total_buffers.
+ (Fmemory_free, Fmemory_use_counts): Use bounded_number.
+ (VECTOR_SIZE): Remove.
+ * data.c (Qfloat, Qvector, Qsymbol, Qstring, Qcons): Make global.
+ (Qinterval, Qmisc): New symbols.
+ (syms_of_data): Initialize them.
+ * lisp.h (Qinterval, Qsymbol, Qstring, Qmisc, Qvector, Qfloat)
+ (Qcons, Qbuffer): New declarations.
+
+2012-07-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c (Fmemory_free): Account for memory-free's own storage.
+ Round up, not down. Improve doc.
+
+2012-07-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Restore old code in allocate_string_data to avoid Faset breakage.
+ Reported by Julien Danjou <julien@danjou.info> in
+ http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00371.html.
+ * alloc.c (allocate_string_data): Restore old code with minor
+ adjustments, fix comment to explain this subtle issue.
+
+2012-07-17 Eli Zaretskii <eliz@gnu.org>
+
+ Remove FILE_SYSTEM_CASE.
+ * s/msdos.h (FILE_SYSTEM_CASE): Don't define.
+
+ * fileio.c (FILE_SYSTEM_CASE): Don't define.
+ (Ffile_name_directory, Fexpand_file_name): Don't use FILE_SYSTEM_CASE.
+ Fixes problems on MS-DOS with Vtemp_file_name_pattern when
+ call-process-region passes it through expand-file-name.
+
+ * dired.c (file_name_completion): Don't use FILE_SYSTEM_CASE.
+
+2012-07-17 Andreas Schwab <schwab@linux-m68k.org>
+
+ Fix crash when creating indirect buffer (Bug#11917)
+ * buffer.c (buffer_lisp_local_variables): Add argument CLONE.
+ Don't handle unbound variables specially if non-zero.
+ (Fbuffer_local_variables): Pass zero.
+ (clone_per_buffer_values): Pass non-zero.
+
+2012-07-17 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gnutls.c (emacs_gnutls_handshake): Revert last change. Add QUIT
+ to make the loop interruptible.
+
+2012-07-17 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gnutls.c (emacs_gnutls_handshake): Only retry if
+ GNUTLS_E_INTERRUPTED.
+
+2012-07-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup and convert miscellaneous checks to eassert.
+ * alloc.c (mark_interval): Fix comment, partially rephrase
+ old comment from intervals.h (see below).
+ * intervals.c (find_interval, adjust_intervals_for_insertion)
+ (delete_interval, adjust_intervals_for_deletion)
+ (graft_intervals_into_buffer, temp_set_point_both, copy_intervals):
+ Convert to eassert.
+ (adjust_intervals_for_insertion, make_new_interval):
+ Remove obsolete and unused code.
+ * intervals.h (struct interval): Remove obsolete comment.
+ * textprotp.c (erase_properties): Remove unused code.
+ (Fadd_text_properties, set_text_properties_1, Fremove_text_properties)
+ (Fremove_list_of_text_properties): Convert to eassert.
+
+2012-07-17 Chong Yidong <cyd@gnu.org>
+
+ * editfns.c (Finsert_char): Doc fix.
+
+2012-07-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix previous change to make Fmemory_free always accurate.
+ * alloc.c (make_interval): Update total_free_intervals.
+ (make_float): Likewise for total_free_floats.
+ (free_cons, Fcons): Likewise for total_free_conses.
+ (SETUP_ON_FREE_LIST, allocate_vector_from_block):
+ Likewise for total_free_vector_bytes.
+ (Fmake_symbol): Likewise for total_free_symbols.
+ (bytes_free): Remove.
+
+2012-07-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simple free memory accounting feature.
+ * alloc.c (bytes_free, total_free_vector_bytes): New variable.
+ (sweep_vectors): Accumulate size of free vectors.
+ (Fgarbage_collect): Setup bytes_free.
+ (Fmemory_free): New function.
+ (syms_of_alloc): Register it.
+
+2012-07-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup overlays checking.
+ * buffer.h (OVERLAY_VALID): Remove as useless synonym of OVERLAYP.
+ * buffer.c (overlay_touches_p, recenter_overlay_lists): Change to
+ eassert and OVERLAYP.
+ (sort_overlays): Change to use OVERLAYP.
+
+2012-07-16 René Kyllingstad <Rene@Kyllingstad.com> (tiny change)
+
+ * editfns.c (Finsert_char): Make it interactive, and make the
+ second arg optional. Copy interactive spec and docstring from
+ ucs-insert.
+
+2012-07-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * floatfns.c (Fabs): Do not wrap fabs inside IN_FLOAT (Bug#11913).
+ Unlike the other wrapped functions, fabs has an unspecified
+ effect on errno.
+
+2012-07-16 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (keyDown): Interpret flags without left/right bits
+ as the left key (Bug#11670).
+
+2012-07-16 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Remove empty and useless init functions.
+ * lisp.h (init_character_once, init_fns, init_image)
+ (init_filelock, init_sound): Remove prototype.
+ * character.c (init_character_once): Remove.
+ * filelock.c (init_filelock): Likewise.
+ * fns.c (init_fns): Likewise.
+ * image.c (init_image): Likewise.
+ * sound.c (init_sound): Likewise.
+ * emacs.c (main): Adjust accordingly.
+
+2012-07-16 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * gtkutil.h: Tiny cleanups.
+ (use_old_gtk_file_dialog): Remove useless declaration.
+ (xg_uses_old_file_dialog): Add suggested const attribute.
+
+2012-07-15 Eli Zaretskii <eliz@gnu.org>
+
+ * bidi.c (MAX_STRONG_CHAR_SEARCH): New macro.
+ (bidi_paragraph_init): Use it to limit search forward for a strong
+ directional character in abnormally large paragraphs full of
+ neutral or weak characters. (Bug#11943)
+
+2012-07-15 Stefano Facchini <stefano.facchini@gmail.com> (tiny change)
+
+ * gtkutil.c (xg_create_tool_bar): Apply "primary-toolbar" style to
+ the toolbar (Bug#9451).
+ (xg_make_tool_item): Give the widget event box a transparent
+ background.
+
+2012-07-15 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup basic allocation variables and functions.
+ * alloc.c (ignore_warnings, init_intervals, init_float)
+ (init_cons, init_symbol, init_marker): Remove.
+ (interval_block_index): Initialize to INTERVAL_BLOCK_SIZE.
+ (float_block_index): Initialize to FLOAT_BLOCK_SIZE.
+ (cons_block_index): Initialize to CONS_BLOCK_SIZE.
+ (symbol_block_size): Initialize to SYMBOL_BLOCK_SIZE.
+ (marker_block_index): Initialize to MARKER_BLOCK_SIZE.
+ (staticidx, init_alloc_once, init_strings, free_ablock):
+ Remove redundant initialization.
+ * fns.c (init_weak_hash_tables): Remove.
+ * lisp.h (init_weak_hash_tables): Remove prototype.
+
+2012-07-15 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use zero_vector where appropriate.
+ * alloc.c (zero_vector): Define as Lisp_Object. Adjust users
+ accordingly.
+ * lisp.h (zero_vector): New declaration.
+ * font.c (null_vector): Remove.
+ (syms_of_font): Remove initialization and staticpro.
+ (font_list_entities, font_find_for_lface): Change to use zero_vector.
+ * keymap.c (Faccessible_keymaps): Likewise.
+
+2012-07-15 Leo Liu <sdl.web@gmail.com>
+
+ * fringe.c: Fix typo in comments.
+
+2012-07-14 Leo Liu <sdl.web@gmail.com>
+
+ * fringe.c: Add a new bitmap exclamation-mark.
+
+2012-07-14 Eli Zaretskii <eliz@gnu.org>
+
+ * gmalloc.c (GMALLOC_INHIBIT_VALLOC): Don't reference.
+
+ * s/msdos.h (BSD_SYSTEM, DATA_START, GC_SETJMP_WORKS, HAVE_MOUSE)
+ (HAVE_MENUS): Don't define, defined by editing config.in with
+ msdos/sed2v2.inp.
+ (GMALLOC_INHIBIT_VALLOC): Don't define.
+ (MODE_LINE_BINARY_TEXT): Remove, not used anymore.
+
+2012-07-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * s/ms-w32.h (GC_SETJMP_WORKS, GC_MARK_STACK): Set in nt/config.nt.
+
+2012-07-14 Glenn Morris <rgm@gnu.org>
+
+ * s/aix4-2.h, s/freebsd.h, s/gnu-linux.h, s/hpux10-20.h:
+ * s/irix6-5.h, s/netbsd.h, s/sol2-6.h, s/unixware.h:
+ Let configure set GC_SETJMP_WORKS, GC_MARK_STACK.
+
+2012-07-13 Glenn Morris <rgm@gnu.org>
+
+ * s/gnu-linux.h (GC_MARK_SECONDARY_STACK): Let configure set it.
+
+ * s/usg5-4-common.h (SETUP_SLAVE_PTY): Let configure set it.
+ * s/irix6-5.h (SETUP_SLAVE_PTY): No more need to unset it.
+
+2012-07-13 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (uRect): Only define if NS_IMPL_GNUSTEP.
+ (x_free_frame_resources): Pass x_free_frame_resources to NSTRACE.
+ (ns_lisp_to_color, ns_string_to_lispmod, ns_term_init)
+ (ns_term_shutdown, requestService, initFrameFromEmacs): Use SSDATA
+ where appropriate.
+ (ns_exec_path, ns_load_path, changeFont): Put () around assignment used
+ as boolean expression.
+ (x_set_window_size): Remove unused variable toolbar.
+ (ns_get_color_default, ns_mod_to_lisp): Remove.
+ (ns_mouse_position): Remove unused variables xchar and ychar.
+ (ns_compute_glyph_string_overhangs): Remove unused variable face.
+ (ns_set_vertical_scroll_bar): Remove unused variable count.
+ (ns_delete_terminal): Remove unused variable i.
+ (ns_term_init): Remove unused variables r, g and b.
+ (mouseDown): Remove unused variable window.
+ (windowDidResize): Move definition of theWindow inside NS_IMPL_GNUSTEP.
+ (initFrameFromEmacs): Remove unused variable vbextra.
+ (mouseEntered): Remove unused variables p and dpyinfo.
+ (mouseExited): Remove unused variables p and r.
+ (ns_define_frame_cursor, ns_clear_frame_area)
+ (ns_draw_window_cursor, ns_initialize_display_info): Make static.
+ (menuDown): Assign [sender tag] to variable and cast the variable.
+
+ * nsterm.h (menuDown): Add id as type to argument sender.
+ (ns_display_info_for_name): Add Lisp_Object argument.
+ (ns_term_init): Add Lisp_Object argument.
+ (ns_map_event_to_object): Add void argument.
+ (ns_string_from_pasteboard, ns_string_to_pasteboard): Add correct
+ prototype with arguments and only declare if __OBJC__.
+ (nxatoms_of_nsselect): Add void argument.
+ (ns_lisp_to_cursor_type): Add Lisp_Object argument.
+ (ns_alloc_autorelease_pool): Add void argument.
+ (ns_release_autorelease_pool): Add void* argument.
+ (ns_get_defaults_value): Add const char* argument.
+
+ * nsmenu.m (ns_update_menubar, ns_menu_show, process_dialog)
+ (initFromContents): Use SSDATA where appropriate.
+ (ns_update_menubar): Add braces to ambigous if-else.
+ (initWithTitle): Put () around assignment in if statement.
+ (ns_menu_show): Remove unused variables window and keymap.
+ (update_frame_tool_bar): Remove unused variable selected_p.
+ (initWithContentRect): Remove unused variable this_cmd_name.
+
+ * nsimage.m (ns_load_image, allocInitFromFile): Use SSDATA where
+ appropriate.
+ (setXBMColor): Remove unused variable len.
+ (setPixmapData): Put () around assignment in loop statement.
+
+ * nsfont.m (ns_get_family, ns_lang_to_script, ns_otf_to_script)
+ (ns_registry_to_script, ns_get_req_script, nsfont_open): Use SSDATA
+ where appropriate.
+ (ns_get_covering_families, ns_findfonts, nsfont_list_family): Put ()
+ around assignment in loop statement.
+ (nsfont_open): Remove unused variable i.
+ (nsfont_open): Remove unused variable len.
+ (nsfont_draw): Remove unused variable cs.
+
+ * nsfns.m (x_set_icon_name, ns_set_name_internal)
+ (ns_set_name_as_filename, ns_implicitly_set_icon_type)
+ (x_set_icon_type, ns_lisp_to_cursor_type, Fns_read_file_name)
+ (Fns_get_resource, Fns_set_resource, Fx_open_connection)
+ (Fns_font_name, Fns_perform_service)
+ (Fns_convert_utf8_nfd_to_nfc, ns_do_applescript)
+ (Fns_do_applescript, Fx_show_tip): Use SSDATA where appropriate.
+ (ns_set_name): Remove unused variable view.
+ (x_set_menu_bar_lines): Remove unused variable olines.
+ (x_set_tool_bar_lines): Remove unused variable root_window.
+ (Fns_list_colors): Put () around assignment in while statement.
+ (Fns_perform_service): Remove unused variable len.
+ (Fns_display_usable_bounds): Remove unused variable top.
+ (syms_of_nsfns): Remove unused variable i.
+
+ * nsmenu.m (ns_update_menubar): Exchange place of argument 2 and 3 to
+ memcpy (Bug#11907).
+
+2012-07-13 Kalle Kankare <kalle.kankare@iki.fi> (tiny change)
+
+ * image.c (Fimagemagick_types): Initialize ex with GetExceptionInfo
+ and free it with DestroyExceptionInfo (Bug#11558).
+
+2012-07-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * s/ms-w32.h (FIRST_PTY_LETTER, HAVE_SOCKETS): Move to nt/config.nt.
+ (HAVE_ATTRIBUTE_ALIGNED, HAVE_C99_STRTOLD, HAVE___BUILTIN_UNWIND_INIT):
+ Set here, not in nt/config.nt.
+
+2012-07-13 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (move_it_in_display_line_to): On GUI terminals, allow
+ cursor overflow into the last glyph on display line when the right
+ fringe is off. (Bug#11832)
+
+2012-07-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xdisp.c (produce_special_glyphs): Now static.
+ * dispextern.h (produce_special_glyphs): Remove decl.
+
+2012-07-13 Glenn Morris <rgm@gnu.org>
+
+ * s/bsd-common.h, s/cygwin.h: Remove empty files.
+ * s/freebsd.h, s/netbsd.h: Do not include bsd-common.h.
+
+ * s/usg5-4-common.h (USG, USG5):
+ * s/template.h (USG5, USG, HPUX, BSD4_2, BSD_SYSTEM):
+ * s/sol2-6.h (SOLARIS2):
+ * s/irix6-5.h (IRIX6_5):
+ * s/hpux10-20.h (USG, USG5, HPUX):
+ * s/gnu-linux.h (USG, GNU_LINUX):
+ * s/freebsd.h (BSD_SYSTEM):
+ * s/darwin.h (BSD4_2, BSD_SYSTEM, DARWIN_OS):
+ * s/cygwin.h (CYGWIN):
+ * s/bsd-common.h (BSD_SYSTEM, BSD4_2):
+ * s/aix4-2.h (USG, USG5, _AIX): Move "system type" macros to configure.
+
+2012-07-13 BT Templeton <bpt@hcoop.net> (tiny change)
+
+ * nsfont.m (ns_charset_covers): Don't abort if no bitmap (Bug#11853).
+
+2012-07-13 Glenn Morris <rgm@gnu.org>
+
+ * s/usg5-4-common.h (NSIG_MINIMUM): Let configure set it.
+
+ * s/gnu-linux.h, s/irix6-5.h: Let configure set ULIMIT_BREAK_VALUE.
+
+ * process.c (init_process_emacs): Replace MIN_PTY_KERNEL_VERSION.
+ * s/darwin.h (MIN_PTY_KERNEL_VERSION): Remove single-use macro.
+
+2012-07-12 Glenn Morris <rgm@gnu.org>
+
+ * s/darwin.h (SYSTEM_PURESIZE_EXTRA): Move to configure.
+
+ * process.c (init_process_emacs): Rename from init_process.
+ The old name is also the name of a Mach system call.
+ * lisp.h, emacs.c: Update for this name change.
+ * nsgui.h, sysselect.h, s/darwin.h: Remove workaround that is no
+ longer needed.
+
+2012-07-12 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (insert_left_trunc_glyphs): Fix incorrect size in
+ memmove call that removes glyphs covered by the left truncation
+ glyph. Improve commentary.
+ (display_line): Fix display of continuation glyphs on GUI frames
+ when the right fringe is turned off and variable-size fonts are
+ used in the window. Move the code that appends a stretch glyph to
+ produce_special_glyphs, so that it could be used for truncation
+ and continuation glyphs alike.
+ (produce_special_glyphs) [HAVE_WINDOW_SYSTEM]: Produce a stretch
+ glyph of a suitably computed width, to align the special glyphs at
+ the window margin. Code moved from display_line. (Bug#11832)
+
+2012-07-12 Glenn Morris <rgm@gnu.org>
+
+ * s/aix4-2.h, s/hpux10-20.h: Let configure set NO_EDITRES.
+
+ * s/gnu-linux.h, s/hpux10-20.h:
+ Do not unconditionally define HAVE_XRMSETDATABASE.
+
+ * s/gnu-linux.h (UNIX98_PTYS): Let configure set it.
+
+2012-07-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix typos that broke OS X build.
+ Reported by Randal L. Schwartz in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00225.html>.
+ * nsterm.m (ns_timeout): Add missing local decl.
+ (ns_get_color): snprintf -> sprintf, to fix typo.
+
+2012-07-12 Glenn Morris <rgm@gnu.org>
+
+ * src/s/aix4-2.h, src/s/cygwin.h, src/s/darwin.h:
+ * src/s/gnu-linux.h, src/s/hpux10-20.h, src/s/irix6-5.h:
+ * src/s/sol2-6.h, src/s/unixware.h, src/s/usg5-4-common.h:
+ Move PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF to configure.
+
+ * s/cygwin.h, s/darwin.h, s/gnu-linux.h, s/irix6-5.h:
+ Move PTY_OPEN to configure.
+
+ * s/aix4-2.h, s/bsd-common.h, s/cygwin.h, s/darwin.h:
+ * s/gnu-linux.h, s/hpux10-20.h, s/irix6-5.h, s/template.h:
+ * s/usg5-4-common.h: Move FIRST_PTY_LETTER, PTY_ITERATION to configure.
+
+2012-07-12 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use empty_unibyte_string where applicable.
+ * keyboard.c (parse_tool_bar_item): Use empty_unibyte_string.
+ * lread.c (read1): Likewise.
+ * xsettings.c (syms_of_xsettings): Likewise.
+
+2012-07-12 Glenn Morris <rgm@gnu.org>
+
+ * s/cygwin.h (G_SLICE_ALWAYS_MALLOC):
+ * s/freebsd.h (BROKEN_PTY_READ_AFTER_EAGAIN):
+ * s/irix6-5.h (SETPGRP_RELEASES_CTTY, PREFER_VSUSP):
+ * s/hpux10-20.h (RUN_TIME_REMAP):
+ * s/bsd-common.h (TABDLY): Move to configure.
+
+ * s/hpux10-20.h, s/sol2-6.h: Move XOS_NEEDS_TIME_H to configure.
+
+ * s/bsd-common.h, s/darwin.h: Move TAB3 to configure.
+
+ * s/aix4-2.h (BROKEN_FIONREAD, BROKEN_SIGAIO, BROKEN_SIGPTY)
+ (BROKEN_SIGPOLL, BROKEN_GET_CURRENT_DIR_NAME): Let configure set them.
+
+ * s/darwin.h (NO_ABORT, NO_MATHERR): Let configure set them.
+
+ * s/bsd-common.h, s/cygwin.h, s/gnu-linux.h, s/irix6-5.h:
+ * s/template.h: Move NARROWPROTO to configure.
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * s/gnu-linux.h, s/sol2-6.h: No longer define POSIX,
+ unused since 2011-01-17 change to systty.h.
+
+ * s/aix4-2.h, s/bsd-common.h, s/cygwin.h, s/darwin.h, s/gnu-linux.h:
+ * s/hpux10-20.h, s/template.h, s/usg5-4-common.h:
+ Move HAVE_PTYS and HAVE_SOCKETS to configure.
+
+2012-07-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ * s/sol2-6.h (HAVE_LIBKSTAT): Remove. (Bug#11914)
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * s/darwin.h, s/gnu-linux.h, s/template.h:
+ Move INTERRUPT_INPUT to configure.
+
+2012-07-11 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Minor adjustments to interning code.
+ * lisp.h (intern, intern_c_string): Redefine as static inline
+ wrappers for intern_1 and intern_c_string_1, respectively.
+ (intern_1, intern_c_string_1): Rename prototypes.
+ * lread.c (intern_1, intern_c_string_1, oblookup):
+ Simplify Vobarray checking.
+ * font.c (font_intern_prop): Likewise. Adjust comment.
+ * w32font.c (intern_font_name): Likewise.
+
+2012-07-11 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gnutls.c (Fgnutls_boot): Properly parse :keylist argument.
+
+ * coding.c (Fdefine_coding_system_internal): Use XCAR/XCDR instead
+ of Fcar/Fcdr if possible.
+ * font.c (check_otf_features): Likewise.
+ * fontset.c (Fnew_fontset): Likewise.
+ * gnutls.c (Fgnutls_boot): Likewise.
+ * minibuf.c (read_minibuf): Likewise.
+ * msdos.c (IT_set_frame_parameters): Likewise.
+ * xmenu.c (Fx_popup_dialog): Likewise.
+ * w32menu.c (Fx_popup_dialog): Likewise.
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * s/bsd-common.h, s/cygwin.h: No need to undefine INTERRUPT_INPUT,
+ since nothing has defined it on these platforms.
+
+ * s/aix4-2.h, s/bsd-common.h, s/cygwin.h, s/gnu-linux.h:
+ * s/irix6-5.h: Move SIGNALS_VIA_CHARACTERS to configure.
+
+ * s/aix4-2.h, s/bsd-common.h, s/cygwin.h, s/darwin.h:
+ * s/gnu-linux.h, s/hpux10-20.h, s/template.h, s/usg5-4-common.h:
+ Move CLASH_DETECTION to configure.
+
+ * s/gnu.h: Remove file, which is now empty.
+
+ * s/gnu.h, s/gnu-linux.h:
+ Move GNU_LIBRARY_PENDING_OUTPUT_COUNT to configure.
+
+2012-07-11 John Wiegley <johnw@newartisans.com>
+
+ * alloc.c (mark_memory): Guard the "no_address_safety_analysis"
+ function attribute, so we only use it if it exists in the
+ compiler.
+
+2012-07-11 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid call to strlen in fast_c_string_match_ignore_case.
+ * search.c (fast_c_string_match_ignore_case): Change to use
+ length argument. Adjust users accordingly.
+ * lisp.h (fast_c_string_match_ignore_case): Adjust prototype.
+
+2012-07-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume mkdir, rmdir.
+ * sysdep.c (mkdir) [!HAVE_MKDIR]: Remove.
+ * sysdep.c (rmdir) [!HAVE_RMDIR]: Remove.
+
+ Assume rename.
+ * sysdep.c (rename) [!HAVE_RENAME]: Remove.
+
+ Assume perror.
+ * s/hpux10-20.h (HAVE_PERROR): Remove.
+ * sysdep.c (perror) [HPUX && !HAVE_PERROR]:
+ Remove dummy definition, as this problem was obsolete long ago.
+
+ Assume strerror.
+ * sysdep.c (strerror) [!HAVE_STRERROR && !WINDOWSNT]: Remove.
+
+2012-07-11 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid calls to strlen in font processing functions.
+ * font.c (font_parse_name, font_parse_xlfd, font_parse_fcname)
+ (font_open_by_name): Change to use length argument.
+ Adjust users accordingly.
+ * font.h (font_open_by_name, font_parse_xlfd, font_unparse_xlfd):
+ Adjust prototypes.
+ * xfont.c (xfont_decode_coding_xlfd, font_unparse_xlfd):
+ Change to return ptrdiff_t.
+ (xfont_list_pattern, xfont_match): Use length returned by
+ xfont_decode_coding_xlfd.
+ * xfns.c (x_default_font_parameter): Omit useless xstrdup.
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * s/darwin.h, s/freebsd.h, s/netbsd.h:
+ Move DONT_REOPEN_PTY to configure.
+
+ * sound.c (DEFAULT_SOUND_DEVICE) [!WINDOWSNT]:
+ * s/netbsd.h (DEFAULT_SOUND_DEVICE): Let configure set it.
+
+2012-07-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove "#define unix" that is no longer needed (Bug#11905).
+ * s/aix4-2.h (unix): Remove; no longer needed.
+
+ EMACS_TIME simplification (Bug#11875).
+ This replaces macros (which typically do not work in GDB)
+ with functions, typedefs and enums, making the code easier to debug.
+ The functional style also makes code easier to read and maintain.
+ * systime.h: Include <sys/time.h> on all hosts, not just if
+ WINDOWSNT, since 'struct timeval' is needed in general.
+ (EMACS_TIME): Now a typedef, not a macro.
+ (EMACS_TIME_RESOLUTION, LOG10_EMACS_TIME_RESOLUTION): Now constants,
+ not macros.
+ (EMACS_SECS, EMACS_NSECS, EMACS_TIME_SIGN, EMACS_TIME_VALID_P)
+ (EMACS_TIME_FROM_DOUBLE, EMACS_TIME_TO_DOUBLE, EMACS_TIME_EQ)
+ (EMACS_TIME_NE, EMACS_TIME_GT, EMACS_TIME_GE, EMACS_TIME_LT)
+ (EMACS_TIME_LE): Now functions, not macros.
+ (EMACS_SET_SECS, EMACS_SET_NSECS, EMACS_SET_SECS_NSECS)
+ (EMACS_SET_USECS, EMACS_SET_SECS_USECS): Remove these macros,
+ which are not functions. All uses rewritten to use:
+ (make_emacs_time): New function.
+ (EMACS_SECS_ADDR, EMACS_SET_INVALID_TIME, EMACS_GET_TIME)
+ (EMACS_ADD_TIME, EMACS_SUB_TIME): Remove these macros, which are
+ not functions. All uses rewritten to use the following, respectively:
+ (emacs_secs_addr, invalid_emacs_time, get_emacs_time)
+ (add_emacs_time, sub_emacs_time): New functions.
+ * atimer.c: Don't include <sys/time.h>, as "systime.h" does this.
+ * fileio.c (Fcopy_file):
+ * xterm.c (XTflash): Get the current time closer to when it's used.
+ * makefile.w32-in ($(BLD)/atimer.$(O)): Update dependencies.
+
+ * bytecode.c (targets): Suppress -Woverride-init warnings.
+
+ Simplify by avoiding confusing use of strncpy etc.
+ * doc.c (Fsnarf_documentation):
+ * fileio.c (Ffile_name_directory, Fsubstitute_in_file_name):
+ * frame.c (Fmake_terminal_frame):
+ * gtkutil.c (get_utf8_string):
+ * lread.c (openp):
+ * nsmenu.m (ns_update_menubar):
+ * regex.c (regerror):
+ Prefer memcpy to strncpy and strncat when either will do.
+ * fileio.c (Fsubstitute_in_file_name):
+ * keyboard.c (MULTI_LETTER_MOD, parse_modifiers_uncached)
+ (menu_separator_name_p):
+ * nsmenu.m (ns_update_menubar):
+ Prefer memcmp to strncmp when either will do.
+ * nsterm.m: Include <ftoastr.h>.
+ (ns_get_color):
+ * s/gnu-linux.h, s/sol2-6.h, s/unixware.h (PTY_TTY_NAME_SPRINTF):
+ Prefer snprintf to strncpy.
+ * nsterm.m (ns_term_init):
+ * widget.c (set_frame_size) [0]: Prefer xstrdup to xmalloc + strncpy.
+ * nsterm.m (ns_term_init):
+ Avoid the need for strncpy, by using build_string or
+ make_unibyte_string directly. Use dtoastr, not snprintf.
+ * process.c (Fmake_network_process): Diagnose service names that
+ are too long, rather than silently truncating them or creating
+ non-null-terminated names.
+ (Fnetwork_interface_info): Likewise, for interface names.
+ * sysdep.c (system_process_attributes) [GNU_LINUX]:
+ Prefer sprintf to strncat.
+ * xdisp.c (debug_method_add) [GLYPH_DEBUG]:
+ Prefer vsnprintf to vsprintf + strncpy.
+
+2012-07-10 Glenn Morris <rgm@gnu.org>
+
+ * dispnew.c (PENDING_OUTPUT_COUNT) [!__GNU_LIBRARY__]:
+ Clarify fallback case.
+
+2012-07-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use XCAR and XCDR instead of Fcar and Fcdr where possible.
+ * callint.c, coding.c, doc.c, editfns.c, eval.c, font.c, fontset.c,
+ * frame.c, gnutls.c, minibuf.c, msdos.c, textprop.c, w32fns.c,
+ * w32menu.c, window.c, xmenu.c: Change to use XCAR and XCDR
+ where argument type is known to be a Lisp_Cons.
+
+2012-07-10 Tom Tromey <tromey@redhat.com>
+
+ * bytecode.c (BYTE_CODE_THREADED): New macro.
+ (BYTE_CODES): New macro. Replaces all old byte-code defines.
+ (enum byte_code_op): New type.
+ (CASE, NEXT, FIRST, CASE_DEFAULT, CASE_ABORT): New macros.
+ (exec_byte_code): Use them. Use token threading when applicable.
+
+2012-07-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Optimize pure C strings initialization.
+ * lisp.h (make_pure_string): Fix prototype.
+ (build_pure_c_string): New function, defined as static inline. This
+ provides a better opportunity to optimize away calls to strlen when
+ the function is called with compile-time constant argument.
+ * alloc.c (make_pure_c_string): Fix comment. Change to add nchars
+ argument, adjust users accordingly. Use build_pure_c_string where
+ appropriate.
+ * buffer.c, coding.c, data.c, dbusbind.c, fileio.c, fontset.c, frame.c,
+ * keyboard.c, keymap.c, lread.c, search.c, syntax.c, w32fns.c, xdisp.c,
+ * xfaces.c, xfns.c, xterm.c: Use build_pure_c_string where appropriate.
+
+2012-07-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid calls to strlen in miscellaneous functions.
+ * buffer.c (init_buffer): Use precalculated len, adjust if needed.
+ * font.c (Ffont_xlfd_name): Likewise. Change to call make_string.
+ * lread.c (openp): Likewise.
+
+2012-07-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid calls to strlen in path processing functions.
+ * fileio.c (file_name_as_directory): Add comment. Change to add
+ srclen argument and return the length of result. Adjust users
+ accordingly.
+ (directory_file_name): Fix comment. Change to add srclen argument,
+ swap 1st and 2nd arguments to obey the common convention.
+ Adjust users accordingly.
+ * filelock.c (fill_in_lock_file_name): Avoid calls to strlen.
+
+2012-07-10 Glenn Morris <rgm@gnu.org>
+
+ * s/cygwin.h, s/darwin.h, s/freebsd.h, s/netbsd.h, s/unixware.h:
+ Move PENDING_OUTPUT_COUNT definition to configure.
+
+ * s/irix6-5.h (DATA_START, DATA_SEG_BITS):
+ * s/hpux10-20.h (DATA_SEG_BITS, DATA_START):
+ * s/gnu.h (DATA_START): Move definitions to configure.
+
+ * s/irix6-5.h (SETUP_SLAVE_PTY, PTY_NAME_SPRINTF): Drop ifdef guards.
+ We include usg5-4-common.h, which defines them both.
+
+ * s/gnu.h: Don't include fcntl.h (every file in Emacs that uses
+ O_RDONLY already includes it).
+
+ Stop ns builds setting the EMACSLOADPATH environment variable.
+ * nsterm.m (ns_load_path): Rename from ns_init_paths.
+ Now it does not set EMACSLOADPATH, just returns the load-path string.
+ * nsterm.h: Update accordingly.
+ * lread.c [HAVE_NS]: Include nsterm.h.
+ (init_lread) [HAVE_NS]: Use ns_load_path.
+ * emacs.c (main) [HAVE_NS]: No longer call ns_init_paths.
+
+2012-07-09 Glenn Morris <rgm@gnu.org>
+
+ * s/gnu.h (SIGNALS_VIA_CHARACTERS): No need to define it here,
+ since the included bsd-common.h does so.
+
+ Stop ns builds setting the EMACSPATH environment variable.
+ * nsterm.m (ns_exec_path): New function, split from ns_init_paths.
+ (ns_init_paths): Do not set EMACSPATH.
+ * nsterm.h (ns_exec_path): Add it.
+ * callproc.c (init_callproc_1, init_callproc) [HAVE_NS]:
+ Use ns_exec_path.
+
+ * nsterm.m, nsterm.h (ns_etc_directory): Fix type, empty return.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ * process.c (wait_reading_process_output): 'waitchannels' was unset
+ when read_kbd || !NILP (wait_for_cell); fix this.
+
+ Add GCC-style 'const' attribute to functions that can use it.
+ * character.h (char_resolve_modifier_mask):
+ * keyboard.h (make_ctrl_char):
+ * lisp.h (multibyte_char_to_unibyte, multibyte_char_to_unibyte_safe)
+ (init_character_once, next_almost_prime, init_fns, init_image)
+ (flush_pending_output, init_sound):
+ * mem-limits.h (start_of_data):
+ * menu.h (finish_menu_items):
+ Add ATTRIBUTE_CONST.
+ * emacs.c (DEFINE_DUMMY_FUNCTION):
+ Declare the dummy function with ATTRIBUTE_CONST.
+ * lisp.h (Fbyteorder, Fmax_char, Fidentity):
+ Add decls with ATTRIBUTE_CONST.
+
+ Minor improvements to make_formatted_string.
+ * alloc.c (make_formatted_string): Prefer int to ptrdiff_t
+ where int is good enough, as vsprintf returns an int.
+ * lisp.h (make_formatted_string): Add ATTRIBUTE_FORMAT_PRINTF.
+
+2012-07-09 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use make_formatted_string to avoid double length calculation.
+ * lisp.h (make_formatted_string): New prototype.
+ * alloc.c (make_formatted_string): New function.
+ * buffer.c (Fgenerate_new_buffer_name): Use it.
+ * dbusbind.c (syms_of_dbusbind): Likewise.
+ * editfns.c (Fcurrent_time_zone): Likewise.
+ * filelock.c (get_boot_time): Likewise.
+ * frame.c (make_terminal_frame, set_term_frame_name)
+ (x_report_frame_params): Likewise.
+ * image.c (gs_load): Likewise.
+ * minibuf.c (get_minibuffer): Likewise.
+ * msdos.c (dos_set_window_size): Likewise.
+ * process.c (make_process): Likewise.
+ * xdisp.c (ensure_echo_area_buffers): Likewise.
+ * xsettings.c (apply_xft_settings): Likewise.
+
+2012-07-09 Glenn Morris <rgm@gnu.org>
+
+ Stop ns builds polluting the environment with EMACSDATA, EMACSDOC.
+ * nsterm.m (ns_etc_directory): New function, split from ns_init_paths.
+ (ns_init_paths): Do not set EMACSDATA, EMACSDOC.
+ * nsterm.h (ns_etc_directory): Add it.
+ * callproc.c [HAVE_NS]: Include nsterm.h.
+ (init_callproc_1, init_callproc) [HAVE_NS]: Use ns_etc_directory.
+
+2012-07-09 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Move marker debugging code under MARKER_DEBUG.
+ * marker.c (MARKER_DEBUG): Move marker debugging code under
+ #ifdef MARKER_DEBUG because byte_char_debug_check is too slow
+ for bootstrap with --enable-checking (~3x slowdown reported
+ by Juanma Barranquero <lekktu@gmail.com>).
+ (verify_bytepos): Move under #ifdef MARKER_DEBUG.
+
+2012-07-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ * systime.h (EMACS_SUB_TIME): Clarify behavior with unsigned time_t.
+ See <http://bugs.gnu.org/11825#29>.
+
+2012-07-08 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (fill_glyphless_glyph_string): If the face of the glyph
+ has no font, use the frame's font. (Bug#11813)
+ (display_line): Add commentary about displaying truncation glyphs
+ on GUI frames.
+ (produce_special_glyphs): Move here from term.c.
+
+ * term.c (produce_special_glyphs): Move to xdisp.c.
+
+ * dispextern.h (produce_special_glyphs): Move prototype to xdisp.c
+ section.
+
+2012-07-07 Andreas Schwab <schwab@linux-m68k.org>
+
+ * xdisp.c (display_line): Avoid warning about implicit declaration
+ of FRAME_FONT.
+
+ * frame.c (get_frame_param): Define only if HAVE_WINDOW_SYSTEM.
+
+ * lisp.h: Remove empty conditional.
+
+2012-07-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lread.c (load_path_check): Now static.
+
+ Fix some minor --with-ns problems found by static checking.
+ * frame.c (Ftool_bar_pixel_width) [!FRAME_TOOLBAR_WIDTH]:
+ (x_set_font) [!HAVE_X_WINDOWS]:
+ * image.c (xpm_load_image) [HAVE_NS]:
+ (x_to_xcolors) [!HAVE_X_WINDOWS && !HAVE_NTGUI]:
+ (x_disable_image) [!HAVE_NS && !HAVE_NTGUI]:
+ Remove unused local.
+ (Fx_parse_geometry) [HAVE_NS]: Don't return garbage.
+ (xpm_load_image) [HAVE_NS && !HAVE_XPM]: Remove unused label.
+ * image.c (x_create_bitmap_from_file) [HAVE_NS]:
+ (xpm_load_image, xpm_load) [HAVE_NS && !HAVE_XPM]:
+ * nsselect.m (symbol_to_nsstring, ns_string_to_pasteboard_internal):
+ * xfaces.c (Fx_load_color_file) [!HAVE_X_WINDOWS]:
+ Fix pointer signedness problem.
+ * xfaces.c (FRAME_X_FONT_TABLE):
+ * xterm.h (FRAME_X_FONT_TABLE): Remove unused, incompatible macros.
+
+2012-07-07 Glenn Morris <rgm@gnu.org>
+
+ * lread.c (load_path_check): New function, split from init_lread.
+ (init_lread): Reorganize. Motivation:
+ If EMACSLOADPATH is set, check/warn about that rather than the
+ defaults, which we are not going to use. Hence we can remove
+ the turn_off_warning and WINDOWSNT || HAVE_NS tests.
+ Don't warn if site-lisp directories are missing.
+ If not installed, start from a blank load-path, since
+ PATH_LOADSEARCH refers to the eventual installation directories.
+
+2012-07-07 Eli Zaretskii <eliz@gnu.org>
+
+ Support truncation and continuation glyphs on GUI frames, when
+ fringes are disabled. (Bug#11832)
+ * xdisp.c (init_iterator): Get dimensions of truncation and
+ continuation glyphs even if on GUI frames.
+ Adjust it->last_visible_x on GUI frames when the left or right fringes,
+ or both, are absent.
+ (start_display, move_it_in_display_line_to): Handle the case of a
+ GUI frame without a fringe to display continuation or truncation
+ glyphs.
+ (insert_left_trunc_glyphs): Support GUI frames: make sure
+ truncation glyphs overwrite enough glyphs from the current line to
+ have sufficient space in pixels.
+ (display_line): Support truncation and continuation glyphs on GUI
+ frames. If some spare pixels are left on the line after inserting
+ the truncation glyphs, fill that space with a stretch glyph of a
+ suitably computed width.
+
+ * term.c (produce_special_glyphs): Call PRODUCE_GLYPHS, not
+ produce_glyphs, to support GUI sessions.
+
+2012-07-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sysdep.c (ULLONG_MAX): Define if not already defined (Bug#11781).
+
+ * sysdep.c (list_system_processes): Port to NetBSD-current (Bug#11797).
+
+ Do not require float-time's arg to fit in time_t (Bug#11825).
+ This works better on hosts where time_t is unsigned, and where
+ float-time is applied to the (negative) difference between two times.
+ * editfns.c (decode_time_components): Last arg is now double *,
+ not int *, and means to store all the result as a double, without
+ worrying about whether the seconds part fits in time_t.
+ All callers changed.
+ (lisp_time_argument): Remove last int * arg, as it's no longer needed.
+ All callers changed.
+ (Ffloat_time): Do not fail merely because the specified time falls
+ outside of time_t range.
+
+2012-07-07 Glenn Morris <rgm@gnu.org>
+
+ * s/darwin.h (HAVE_RES_INIT, HAVE_LIBRESOLV):
+ * s/hpux10-20.h (HAVE_RINT, HAVE_RANDOM):
+ * s/unixware.h (HAVE_GETWD): Move undefs to configure (effectively).
+
+2012-07-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (DISPEXTERN_H, $(BLD)/regex.$(O)):
+ Update dependencies.
+
+ * s/ms-w32.h [_MSC_VER]: Remove strcasecmp, strncasecmp.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use c_strcasecmp for ASCII case-insensitive comparison (Bug#11786).
+ * dispextern.h, nsfns.m, nsterm.m: Include <c-strcase.h>.
+ * dispextern.h (xstrcasecmp): Rewrite using c_strcasecmp.
+ * nsfns.m (x_get_string_resource): Use c_strncasecmp, not strncasecmp.
+ * nsterm.m (ns_default): Use c_strcasecmp, not strcasecmp.
+ * xfaces.c (xstrcasecmp) [!HAVE_STRCASECMP]: Remove.
+
+ * xfont.c (compare_font_names): Redo to omit the need for casts.
+
+2012-07-06 Andreas Schwab <schwab@linux-m68k.org>
+
+ * xfns.c (Fx_change_window_property): Doc fix.
+ * w32fns.c (Fx_change_window_property): Doc fix.
+
+ * w32fns.c (Fx_window_property): Accept the same arguments as the
+ X Windows version. Doc fix.
+ * xfns.c (Fx_window_property): Doc fix. (Bug#11870)
+
+2012-07-06 Juanma Barranquero <lekktu@gmail.com>
+ Eli Zaretskii <eliz@gnu.org>
+
+ * s/ms-w32.h: Settings not specific to Windows moved to nt/config.nt.
+ Windows-specific code from nt/config.nt moved here.
+ Obsolete settings removed.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ * process.c: Avoid unnecessary calls to gettime.
+ (wait_reading_process_output): Don't get the time of day
+ when gobbling data immediately and not waiting, as there's no need
+ for it in that case. This removes a FIXME.
+
+2012-07-06 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (xg_event_is_for_scrollbar): Assign gwin when HAVE_GTK3
+ is defined (Bug#11768).
+
+2012-07-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix marker debugging code.
+ * marker.c (byte_char_debug_check): Do not perform the check
+ if buffer is not multibyte.
+ (buf_charpos_to_bytepos, buf_bytepos_to_charpos):
+ Call byte_char_debug_check with correct arguments.
+
+2012-07-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Compile marker debugging code only if ENABLE_CHECKING is defined.
+ * marker.c (byte_char_debug_check, count_markers):
+ Use only if ENABLE_CHECKING is defined.
+ (byte_debug_flag): Remove.
+ (CONSIDER, buf_charpos_to_bytepos, buf_bytepos_to_charpos):
+ Always call byte_char_debug_check if ENABLE_CHECKING is defined.
+
+2012-07-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid code repetition in marker-related functions.
+ * marker.c (attach_marker): New function.
+ (Fset_marker, set_marker_restricted, set_marker_both)
+ (set_marker_restricted_both): Use it.
+ (Fset_marker, set_marker_restricted, Fbuffer_has_markers_at):
+ Consistently rename charno to charpos.
+ (marker_position): Add eassert.
+ (marker_byte_position): Convert to eassert.
+
+2012-07-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simplify list operations in unchain_overlay and unchain_marker.
+ * buffer.c (unchain_overlay): Simplify. Add comment.
+ * marker.c (unchain_marker): Simplify. Fix comments.
+
+2012-07-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Introduce fast path for the widely used marker operation.
+ * alloc.c (build_marker): New function.
+ * lisp.h (build_marker): New prototype.
+ * buffer.c (clone_per_buffer_values, Fmake_indirect_buffer): Use it.
+ * composite.c (autocmp_chars): Likewise.
+ * editfns.c (buildmark): Remove.
+ (Fpoint_marker, Fpoint_min_marker, Fpoint_max_marker)
+ (save_restriction_save): Use build_marker.
+ * marker.c (buf_charpos_to_bytepos, buf_bytepos_to_charpos): Likewise.
+ * window.c (save_window_save): Likewise.
+
+2012-07-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Do not use Fdelete_overlay in delete_all_overlays
+ to avoid redundant calls to unchain_overlay.
+ * buffer.c (drop_overlay): New function.
+ (delete_all_overlays, Fdelete_overlay): Use it.
+ * minibuf.c (get_minibuffer): Fix comment.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port to OpenBSD 5.1 amd64.
+ * sysdep.c [BSD_SYSTEM]: Include <sys/param.h> before <sys/sysctl.h>.
+ This is needed for OpenBSD, and should be harmless on all BSD systems.
+ Also, include <sys/sysctl.h>, as it should be available on all
+ BSD_SYSTEM hosts given that we're already calling sysctl in that case.
+ (list_system_processes) [__OpenBSD__]: Use DARWIN_OS style mib, but
+ use p_pid member, not kp_proc.pid.
+
+2012-07-06 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (emacs$(EXEEXT)): Don't check for load-path shadows.
+
+2012-07-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ More xmalloc and related cleanup.
+ * alloc.c, bidi.c, buffer.c, buffer.h, bytecode.c, callint.c:
+ * callproc.c, charset.c, coding.c, composite.c, data.c, dispnew.c:
+ * doc.c, editfns.c, emacs.c, eval.c, fileio.c, filelock.c, fns.c:
+ * font.c, fontset.c, frame.c, fringe.c, ftfont.c, ftxfont.c, gmalloc.c:
+ * gtkutil.c, image.c, keyboard.c, keymap.c, lread.c, macros.c, menu.c:
+ * nsfns.m, nsfont.m, nsmenu.m, nsterm.m, print.c, process.c, ralloc.c:
+ * regex.c, region-cache.c, scroll.c, search.c, sound.c, syntax.c:
+ * sysdep.c, term.c, termcap.c, unexmacosx.c, window.c, xdisp.c:
+ * xfaces.c, xfns.c, xftfont.c, xgselect.c, xmenu.c, xrdb.c, xselect.c:
+ * xterm.c:
+ Omit needless casts involving void * pointers and allocation.
+ Prefer "P = xmalloc (sizeof *P)" to "P = xmalloc (sizeof (TYPE_OF_P))",
+ as the former is more robust if P's type is changed.
+ Prefer xzalloc to xmalloc + memset 0.
+ Simplify malloc-or-realloc to realloc.
+ Don't worry about xmalloc returning a null pointer.
+ Prefer xstrdup to xmalloc + strcpy.
+ * editfns.c (Fmessage_box): Grow message_text by at least 80 when
+ growing it.
+ * keyboard.c (apply_modifiers_uncached): Prefer local array to
+ alloca of a constant.
+
+2012-07-05 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (display_line): Fix horizontal pixel coordinates when
+ hscroll is larger than the line width. Fixes long and futile
+ looping inside extend_face_to_end_of_line (on a TTY) producing
+ glyphs that are not needed and thrown away.
+
+2012-07-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * marker.c (set_marker_restricted_both): Simplify by using
+ clip_to_bounds.
+
+2012-07-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ * editfns.c (region_limit): Simplify by using clip_to_bounds.
+
+2012-07-05 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (gtk_scrollbar_new, gtk_box_new): Define when HAVE_GTK3 is
+ not defined (Bug#11768).
+ (xg_create_frame_widgets): Use gtk_plug_new_for_display (Bug#11768).
+ (xg_create_frame_widgets, create_dialog, xg_get_file_with_chooser)
+ (make_widget_for_menu_item, xg_make_tool_item): Use gtk_box_new
+ followed by gtk_box_set_homogeneous (Bug#11768).
+ (xg_update_menu_item): Use GTK_IS_BOX (Bug#11768).
+ (update_theme_scrollbar_width, xg_create_scroll_bar):
+ Use gtk_scrollbar_new (Bug#11768).
+ (xg_event_is_for_scrollbar): Use Gdk Device functions for HAVE_GTK3.
+ (is_box_type): New function (Bug#11768).
+ (xg_tool_item_stale_p): Call is_box_type.
+ (xg_initialize): Get settings by calling gtk_settings_get_for_screen
+ with default display (Bug#11768).
+
+2012-07-05 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (window_hscroll_limited): New function.
+ (pos_visible_p, init_iterator): Use it to avoid overflow of pixel
+ coordinates when window's hscroll is set to insanely large
+ values. (Bug#11857)
+
+2012-07-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/dired.$(O), $(BLD)/fileio.$(O)): Fix typo.
+ ($(BLD)/terminal.$(O), $(BLD)/syntax.$(O)): Update dependencies.
+
+2012-07-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup xmalloc.
+ * lisp.h (xzalloc): New prototype. Omit needless casts.
+ * alloc.c (xzalloc): New function. Omit needless casts.
+ * charset.c: Omit needless casts. Convert all calls to
+ xmalloc with following memset to xzalloc.
+ * dispnew.c: Likewise.
+ * fringe.c: Likewise.
+ * image.c: Likewise.
+ * sound.c: Likewise.
+ * term.c: Likewise.
+ * w32fns.c: Likewise.
+ * w32font.c: Likewise.
+ * w32term.c: Likewise.
+ * xfaces.c: Likewise.
+ * xfns.c: Likewise.
+ * xterm.c: Likewise.
+ * atimer.c: Omit needless casts.
+ * buffer.c: Likewise.
+ * callproc.c: Likewise.
+ * ccl.c: Likewise.
+ * coding.c: Likewise.
+ * composite.c: Likewise.
+ * doc.c: Likewise.
+ * doprnt.c: Likewise.
+ * editfns.c: Likewise.
+ * emacs.c: Likewise.
+ * eval.c: Likewise.
+ * filelock.c: Likewise.
+ * fns.c: Likewise.
+ * gtkutil.c: Likewise.
+ * keyboard.c: Likewise.
+ * lisp.h: Likewise.
+ * lread.c: Likewise.
+ * minibuf.c: Likewise.
+ * msdos.c: Likewise.
+ * print.c: Likewise.
+ * process.c: Likewise.
+ * region-cache.c: Likewise.
+ * search.c: Likewise.
+ * sysdep.c: Likewise.
+ * termcap.c: Likewise.
+ * terminal.c: Likewise.
+ * tparam.c: Likewise.
+ * w16select.c: Likewise.
+ * w32.c: Likewise.
+ * w32reg.c: Likewise.
+ * w32select.c: Likewise.
+ * w32uniscribe.c: Likewise.
+ * widget.c: Likewise.
+ * xdisp.c: Likewise.
+ * xmenu.c: Likewise.
+ * xrdb.c: Likewise.
+ * xselect.c: Likewise.
+
+2012-07-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fileio.c (time_error_value): Check the right error number.
+ Problem reported by Troels Nielsen in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00095.html>.
+
+2012-07-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * window.c (set_window_hscroll): Revert the 100000 hscroll limit.
+ This should be fixed in a better way; see Eli Zaretskii in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00088.html>.
+ (HSCROLL_MAX): Remove; this is now internal to set_window_hscroll.
+
+ * fileio.c (time_error_value): Rename from special_mtime.
+ The old name's problems were noted by Eli Zaretskii in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00087.html>.
+
+ * emacs.c (gdb_pvec_type): Change it back to enum pvec_type.
+ This variable's comment says Emacs needs at least one GDB-visible
+ symbol of type enum pvec_type, to work around GDB problems.
+ The symbol's value doesn't matter.
+
+ * alloc.c (PSEUDOVECTOR_NBYTES): Remove stray ';'
+ that causes compilation to fail on pre-C99 compilers.
+
+2012-07-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * s/ms-w32.h (LISP_FLOAT_TYPE, HAVE_MEMCMP, HAVE_MEMCPY)
+ (HAVE_MEMMOVE, HAVE_MEMSET): Don't set, obsolete.
+
+2012-07-04 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * buffer.c (init_buffer_once): Fix initialization of
+ headers for buffer_defaults and buffer_local_symbols.
+ Reported by Juanma Barranquero <lekktu@gmail.com>.
+
+2012-07-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Turn VECTOR_FREE_LIST_FLAG into PVEC_FREE.
+ * lisp.h (enum pvec_type): Use fewer bits.
+ (PSEUDOVECTOR_SIZE_BITS): New constant.
+ (PSEUDOVECTOR_SIZE_MASK, PVEC_TYPE_MASK): Use it.
+ (XSETPVECTYPESIZE, XSETTYPED_PSEUDOVECTOR, DEFUN): Adapt code to
+ change in pvec_type.
+ (PSEUDOVECTOR_TYPEP): New macro.
+ (TYPED_PSEUDOVECTORP): Use it.
+ * fns.c (internal_equal): Adapt code to extract pvectype.
+ * emacs.c (gdb_pvec_type): Update type.
+ * alloc.c (PSEUDOVECTOR_NBYTES): New macro.
+ (VECTOR_FREE_LIST_SIZE_MASK): Remove (=> PSEUDOVECTOR_SIZE_MASK).
+ (VECTOR_FREE_LIST_FLAG): Remove (=> PVEC_FREE).
+ (SETUP_ON_FREE_LIST): Use XSETPVECTYPESIZE.
+ (sweep_vectors): Use it. Use local var `total_bytes' instead of
+ abusing vector->header.next.nbytes.
+ (live_vector_p): Use PVEC_TYPE.
+ (mark_object): Adapt code to extract pvectype. Use switch.
+
+2012-07-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * doprnt.c (doprnt): Don't assume string length fits in 'int'.
+ Tighten new eassert a bit.
+
+2012-07-04 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix compilation with --enable-gcc-warnings and -O1
+ optimization level.
+ * doprnt.c (doprnt): Change type of tem to int, initialize
+ to avoid compiler warning. Add eassert.
+ * search.c (simple_search): Initialize match_byte to avoid
+ compiler warning. Add eassert.
+
+2012-07-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid weird behavior with large horizontal scrolls.
+ Without this change, for example, large hscroll values would
+ mess up Emacs's display on Fedora 15 x86, presumably due to
+ overflows in int calculations in the display code.
+ Also, if buffers had long lines, Emacs would freeze.
+ * window.c (HSCROLL_MAX): Reduce to 100000, and make it visible to GDB.
+ (set_window_hscroll): New function, containing the old guts of
+ Fset_window_hscroll. Return the clipped value.
+ (Fset_window_hscroll, Fscroll_left, Fscroll_right): Use it.
+ This avoids the need to check against PTRDIFF_MAX.
+
+ * buffer.c (Fgenerate_new_buffer_name): Fix sprintf format mismatch.
+
+2012-07-04 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * buffer.c (Fgenerate_new_buffer_name): Fix type mismatch.
+
+2012-07-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * regex.c: Suppress GCC warning on RHEL 6. (Bug#11207)
+ Conditionalize the pragmas on GCC 4.5 or later, not GCC 4.3 or later,
+ since GCC 4.4.6 issues a bogus warning for them.
+
+ Fix bugs in file timestamp newness comparisons.
+ * fileio.c (Ffile_newer_than_file_p):
+ * lread.c (Fload): Use full timestamp resolution of files,
+ not just the 1-second resolution, so that files that are only
+ slightly newer still count as newer.
+ * fileio.c (Ffile_newer_than_file_p): Don't assume file
+ timestamps fit in 'int'; this fixes a Y2038 bug on most hosts.
+
+2012-07-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fileio.c: Improve handling of file time marker. (Bug#11852)
+ (special_mtime): New function.
+ (Finsert_file_contents, Fverify_visited_file_modtime):
+ Use it to set special mtime values consistently.
+
+2012-07-03 Andreas Schwab <schwab@linux-m68k.org>
+
+ * fileio.c (Finsert_file_contents): Properly handle st_mtime
+ marker for non-existing file. (Bug#11852)
+
+2012-07-03 Glenn Morris <rgm@gnu.org>
+
+ * lisp.h (Fread_file_name): Restore EXFUN (it's not a normal DEFUN
+ and did not make it into globals.h).
+
+2012-07-03 Tom Tromey <tromey@redhat.com>
+
+ * window.c (Fset_window_margins, Fset_window_fringes)
+ (Fset_window_scroll_bars, Fset_window_vscroll): No longer static.
+ * textprop.c (Fprevious_property_change): No longer static.
+ * syntax.c (Fsyntax_table_p): No longer static.
+ * process.c (Fget_process, Fprocess_datagram_address): No longer
+ static.
+ * keymap.c (Flookup_key, Fcopy_keymap): No longer static.
+ * keyboard.c (Fcommand_execute): No longer static.
+ Remove EXFUN.
+ * insdel.c (Fcombine_after_change_execute): No longer static.
+ * image.c (Finit_image_library): No longer static.
+ * fileio.c (Fmake_symbolic_link): No longer static.
+ * eval.c (Ffetch_bytecode): No longer static.
+ * editfns.c (Fuser_full_name): No longer static.
+ * doc.c (Fdocumentation_property, Fsnarf_documentation):
+ No longer static.
+ * buffer.c (Fset_buffer_major_mode, Fdelete_overlay): No longer
+ static.
+ * dired.c (Ffile_attributes): No longer static.
+ * composite.c (Fcomposition_get_gstring): No longer static.
+ * callproc.c (Fgetenv_internal): No longer static.
+
+ * ccl.h: Remove EXFUNs.
+ * buffer.h: Remove EXFUNs.
+ * dispextern.h: Remove EXFUNs.
+ * intervals.h: Remove EXFUNs.
+ * fontset.h: Remove EXFUN.
+ * font.h: Remove EXFUNs.
+ * dosfns.c (system_process_attributes): Remove EXFUN.
+ * keymap.h: Remove EXFUNs.
+ * lisp.h: Remove EXFUNs.
+ * w32term.h: Remove EXFUNs.
+ * window.h: Remove EXFUNs.
+ * xsettings.h: Remove EXFUN.
+ * xterm.h: Remove EXFUN.
+
+2012-07-03 Glenn Morris <rgm@gnu.org>
+
+ * lisp.h (Frandom): Make it visible to C.
+ * buffer.c (Fgenerate_new_buffer_name): Speed up finding a new
+ buffer for invisible buffers. (Bug#1229)
+
+2012-07-03 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix block vector allocation code to allow VECTOR_BLOCK_SIZE
+ values which aren't power of 2.
+ * alloc.c (VECTOR_FREE_LIST_SIZE_MASK): New macro.
+ Verify its value and the value of VECTOR_BLOCK_SIZE. Adjust users
+ accordingly.
+
+2012-07-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp.h (Lisp_Misc, Lisp_Fwd): Move around to group better.
+
+ * alloc.c (mark_object): Revert part of last patch to use `switch'.
+
+2012-07-03 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (allocate_vector_block): Remove redundant
+ calls to mallopt if DOUG_LEA_MALLOC is defined.
+ (allocate_vectorlike): If DOUG_LEA_MALLOC is defined,
+ avoid calls to mallopt if zero_vector is returned.
+
+2012-07-03 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (check_string_bytes): If GC_CHECK_STRING_BYTES
+ is enabled, avoid dereferencing NULL current_sblock if
+ running undumped.
+
+2012-07-03 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup basic buffer management.
+ * buffer.h (struct buffer): Change layout to use generic vector
+ marking code. Fix some comments. Change type of 'clip_changed'
+ to bitfield. Remove unused #ifndef old.
+ (FIRST_FIELD_PER_BUFFER, LAST_FIELD_PER_BUFFER): Remove.
+ (GET_OVERLAYS_AT): Fix indentation.
+ (for_each_per_buffer_object_at): New macro.
+ * buffer.c (clone_per_buffer_values, reset_buffer_local_variables)
+ (Fbuffer_local_variables): Use it.
+ (init_buffer_once, syms_of_buffer): Remove unused #ifndef old.
+ * alloc.c (allocate_buffer): Adjust to match new layout of
+ struct buffer. Fix comment.
+ (mark_overlay): New function.
+ (mark_buffer): Use it. Use mark_vectorlike to mark normal
+ Lisp area of struct buffer.
+ (mark_object): Use it. Adjust marking of misc objects
+ and related comments.
+
+2012-07-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c (mark_object): Remove "#ifdef GC_CHECK_MARKED_OBJECTS"
+ wrapper that is not needed because the wrapped code is a no-op (zero
+ machine instructions) when GC_CHECK_MARKED_OBJECTS is not defined.
+ This avoids a -Wunused-macros diagnostic with GCC 4.7.1 x86-64.
+
+2012-07-02 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (mark_buffer): Simplify. Remove prototype.
+ (mark_object): Add comment. Reorganize marking of vector-like
+ objects. Use CHECK_LIVE for all vector-like objects except buffers
+ and subroutines when GC_CHECK_MARKED_OBJECTS is defined.
+ Avoid redundant calls to mark_vectorlike for bool vectors.
+
+2012-06-30 Glenn Morris <rgm@gnu.org>
+
+ * nsterm.m (ns_init_paths): Ignore site-lisp if --no-site-lisp.
+
+ * epaths.in (PATH_SITELOADSEARCH): New.
+ * lread.c (init_lread): Use PATH_SITELOADSEARCH.
+ This is rather than relying on --enable-locallisppath elements
+ having "site-lisp" in their names. (Bug#10208#25, 11658)
+
+2012-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (sys_select): Accept and ignore one more argument.
+
+ * w32.c (emacs_gnutls_pull): Call select with one more argument.
+
+ * sysselect.h [DOS_NT]: Don't include sys/select.h.
+ (pselect) [!MS_DOS]: Redirect to sys_select.
+
+ * sysdep.c: Don't include dos.h and dosfns.h.
+
+ * process.c (sys_select):
+ * msdos.c (sys_select): Accept one more argument and ignore it.
+
+ * msdos.c (event_timestamp, sys_select): Use gnulib's gettime;
+ adapt data types and code to that.
+
+ * dosfns.c:
+ * msdos.c (gettime, settime): Define away the prototypes in dos.h,
+ which clashes with the gnulib function of the same name.
+
+2012-06-30 Andreas Schwab <schwab@linux-m68k.org>
+
+ * font.c (font_style_to_value, font_style_symbolic)
+ (font_prop_validate_style): Add type checks for values in
+ font_style_table.
+
+ * lisp.h (CHECK_RANGED_INTEGER): Make value to check the first
+ argument.
+ * character.c, charset.c, menu.c, process.c, window.c: Adjust all
+ uses.
+
+2012-06-29 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (try_window_id): Undo last change.
+
+ * w32.c (getwd): Adjust commentary about startup_dir.
+ (init_environment): Always call sys_access, even in non-MSVC
+ builds. Don't chdir to the directory of the Emacs executable.
+ This undoes code from 1997 which was justified by the need to
+ "avoid conflicts when removing and renaming directories". But its
+ downside was that every relative file name was being interpreted
+ relative to the directory of the Emacs executable, which can never
+ be TRT. In particular, it broke sys_access when called with
+ relative file names.
+ (sys_access): Map GetLastError to errno.
+
+2012-06-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.h (struct window): Change type of 'fringes_outside_margins'
+ to bitfield. Fix comment. Adjust users accordingly.
+ (struct window): Change type of 'window_end_bytepos' to ptrdiff_t.
+ Adjust comment.
+ * xdisp.c (try_window_id): Change type of 'first_vpos' and 'vpos'
+ to ptrdiff_t.
+
+2012-06-29 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gnutls.c (emacs_gnutls_handshake):
+ Add QUIT to make the loop interruptible.
+
+2012-06-29 Glenn Morris <rgm@gnu.org>
+
+ * charset.c (init_charset): Make lack of etc/charsets fatal.
+
+2012-06-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * editfns.c (region_limit): Fix type mismatch.
+
+2012-06-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * nsfns.m: Fix GLYPH_DEBUG usage assuming that it may be
+ undefined. Convert from xassert to eassert.
+ * nsmenu.m: Convert from xassert to eassert.
+ * nsterm.m: Likewise.
+
+2012-06-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * editfns.c (region_limit): Clip to narrowing (bug#11770).
+
+2012-06-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid integer overflow on scroll-left and scroll-right.
+ * window.c (HSCROLL_MAX): New macro.
+ (Fscroll_left, Fscroll_right): Avoid undefined behavior on integer
+ overflow when requested scroll falls outside ptrdiff_t range.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.h (struct window): Change type of 'hscroll',
+ 'min_hscroll' and 'last_point' from Lisp_Object to ptrdiff_t,
+ 'last_modified' and 'last_overlay_modified' to EMACS_INT.
+ Adjust users accordingly.
+ * xdisp.c (try_cursor_movement): Replace type check with eassert.
+ * window.c (Fscroll_left, Fscroll_right): Change type of 'hscroll'
+ from EMACS_INT to ptrdiff_t.
+ (make_window): Omit redundant initialization.
+
+2012-06-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/regex.$(O)): Update dependencies.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.h (struct window): Change type of 'use_time' and
+ 'sequence_number' from Lisp_Object to int.
+ * frame.c (make_frame): Adjust users accordingly.
+ * print.c (print_object): Likewise.
+ * window.c (select_window, Fwindow_use_time, make_parent_window)
+ (make_window): Likewise.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * dispextern.h (GLYPH_DEBUG): Now defined in config.h if
+ enabled with --enable-checking=[all,glyphs] configure option.
+ Fix GLYPH_DEBUG usage assuming that it may be undefined,
+ adjust comments accordingly.
+ * dispnew.c: Fix GLYPH_DEBUG usage assuming that it may be
+ undefined, adjust comments accordingly.
+ * image.c: Likewise.
+ * scroll.c: Likewise.
+ * w32fns.c: Likewise.
+ * w32term.c: Likewise.
+ * xdisp.c: Likewise.
+ * xfaces.c: Likewise.
+ * xfns.c: Likewise.
+ * xterm.c: Likewise.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Generalize run-time debugging checks.
+ * dispextern.h (XASSERTS): Remove.
+ * fontset.c (xassert): Remove.
+ Convert from xassert to eassert.
+ * alloc.c: Convert from xassert to eassert.
+ * bidi.c: Likewise.
+ * dispnew.c: Likewise.
+ * fns.c: Likewise.
+ * fringe.c: Likewise.
+ * ftfont.c: Likewise.
+ * gtkutil.c: Likewise.
+ * image.c: Likewise.
+ * keyboard.c: Likewise.
+ * menu.c: Likewise.
+ * process.c: Likewise.
+ * scroll.c: Likewise.
+ * sound.c: Likewise.
+ * term.c: Likewise.
+ * w32console.c: Likewise.
+ * w32fns.c: Likewise.
+ * w32term.c: Likewise.
+ * window.c: Likewise.
+ * xdisp.c: Likewise.
+ * xfaces.c: Likewise.
+ * xfns.c: Likewise.
+ * xselect.c: Likewise.
+ * xterm.c: Likewise.
+
+2012-06-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * fns.c (maybe_resize_hash_table): Output message when growing the
+ purify-hashtable.
+
+2012-06-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (allocate_string_data): Remove dead code.
+ * xsettings.c (XSETTINGS_FONT_NAME): Move under HAVE_XFT to
+ avoid GCC warning about unused macro.
+
+2012-06-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (allocate_string): Omit intervals initialization.
+ * alloc.c (make_uninit_multibyte_string): Initialize intervals
+ as in make_pure_string and make_pure_c_string.
+
+2012-06-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (allocate_string): Fix last change.
+
+2012-06-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (allocate_string): Remove two redundant calls
+ to memset, add explicit initialization where appropriate.
+
+2012-06-27 Glenn Morris <rgm@gnu.org>
+
+ * lisp.mk (lisp): Remove paths.elc.
+
+2012-06-27 Chong Yidong <cyd@gnu.org>
+
+ * doc.c (Fsubstitute_command_keys): Fix punctuation.
+
+2012-06-26 John Wiegley <johnw@newartisans.com>
+
+ * unexmacosx.c (copy_data_segment): Add two section names used
+ on Mac OS X Lion: __mod_init_func and __mod_term_func.
+
+ * alloc.c (mark_memory): Do not check with -faddress-sanitizer
+ when building with Clang.
+
+2012-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Fapply): Allow calling it with a single argument.
+
+2012-06-26 Eli Zaretskii <eliz@gnu.org>
+
+ * s/ms-w32.h (strcasecmp, strncasecmp) [_MSC_VER]: Redirect to
+ _stricmp and _strnicmp.
+ (HAVE_STRCASECMP, HAVE_STRNCASECMP): Define to 1.
+
+2012-06-26 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (allocate_window): Zero out non-Lisp part of newly
+ allocated window.
+ (allocate_process): Likewise for new process.
+ (allocate_terminal): Change to use offsetof.
+ (allocate_frame): Likewise.
+ * frame.c (make_frame): Omit redundant initialization.
+ * window.c (make_parent_window): Use memset.
+ (make_window): Omit redundant initialization.
+ * process.c (make_process): Omit redundant initialization.
+ * terminal.c (create_terminal): Likewise.
+
+2012-06-26 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * term.c (delete_tty): Remove redundant call to memset.
+
+2012-06-26 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c: Remove build_string.
+ * lisp.h: Define build_string as static inline. This provides
+ a better opportunity to optimize away calls to strlen when the
+ function is called with compile-time constant argument.
+ * image.c (imagemagick_error): Convert to build_string.
+ * w32proc.c (sys_spawnve): Likewise.
+ * xterm.c (x_term_init): Likewise.
+
+2012-06-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use sprintf return value instead of invoking strlen on result.
+ In the old days this wasn't portable, since some sprintf
+ implementations returned char *. But they died out years ago and
+ Emacs already assumes sprintf returns int.
+ Similarly for float_to_string.
+ This patch speeds up (number-to-string 1000) by 3% on Fedora 15 x86-64.
+ * ccl.c (ccl_driver):
+ * character.c (string_escape_byte8):
+ * data.c (Fnumber_to_string):
+ * doprnt.c (doprnt):
+ * print.c (print_object):
+ * xdisp.c (message_dolog):
+ * xfns.c (syms_of_xfns):
+ Use sprintf or float_to_string result to avoid need to call strlen.
+ * data.c (Fnumber_to_string):
+ Use make_unibyte_string, since the string must be ASCII.
+ * lisp.h, print.c (float_to_string): Now returns int length.
+ * term.c (produce_glyphless_glyph):
+ Use sprintf result rather than recomputing it.
+
+ Clean out last vestiges of the old HAVE_CONFIG_H stuff.
+ * Makefile.in (ALL_CFLAGS):
+ * makefile.w32-in (LOCAL_FLAGS): Remove -DHAVE_CONFIG_H.
+ * gmalloc.c, regex.c: Include <config.h> unconditionally.
+
+2012-06-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * dispextern.h (xstrcasecmp): Define to library function
+ strcasecmp if available.
+ * xfaces.c: Do not use xstrcasecmp if strcasecmp is available.
+
+2012-06-25 Andreas Schwab <schwab@linux-m68k.org>
+
+ * keyboard.c (menu_bar_items, menu_bar_item, read_key_sequence):
+ Avoid comma operator.
+ * menu.c (push_submenu_start, push_submenu_end)
+ (push_left_right_boundary, push_menu_pane): Likewise.
+ * msdos.c (dos_rawgetc): Likewise.
+
+2012-06-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * xfns.c (xic_create_fontsetname): Remove redundant calls
+ to memset.
+
+2012-06-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ * gtkutil.c (get_utf8_string): Remove redundant assignment.
+ sprintf already null-terminates its output.
+
+ * xfns.c (x_window): Remove redundant cast.
+
+2012-06-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * xmenu.c (xmenu_show, xdialog_show): Explicit cast from
+ `const char *' to `char *' to avoid compiler warning.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xterm.c (x_term_init): Build proper-sized _XSETTINGS_Snnn string
+ instead of truncating it to 63 (admittedly a generous limit).
+
+ * process.c: Fix spelling and caps in comments.
+
+2012-06-24 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * emacs.c (setpgrp): Remove definition, unused.
+ * sysdep.c (setpgrp): Remove definition, not used in this file.
+
+2012-06-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in: Update dependencies.
+
+2012-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (TIMESPEC_H): Remove nt/inc/sys/time.h.
+ (SYSTIME_H): Add nt/inc/sys/time.h.
+
+ * systime.h [WINDOWSNT]: Include sys/time.h.
+
+ * s/ms-w32.h (struct timespec): Definition moved from
+ nt/inc/sys/time.h. Suggested by Paul Eggert <eggert@cs.ucla.edu>.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Switch from NO_RETURN to C11's _Noreturn (Bug#11750).
+ * buffer.h (buffer_slot_type_mismatch):
+ * data.c (arith_error) [!FORWARD_SIGNAL_TO_MAIN_THREAD]:
+ * eval.c (unwind_to_catch):
+ * image.c (my_png_error, my_error_exit):
+ * keyboard.c (quit_throw_to_read_char, user_error)
+ (Fexit_recursive_edit, Fabort_recursive_edit):
+ * lisp.h (die, args_out_of_range, args_out_of_range_3)
+ (wrong_type_argument, buffer_overflow, __executable_start)
+ (memory_full, buffer_memory_full, string_overflow, Fthrow)
+ (xsignal, xsignal0, xsignal1, xsignal2, xsignal3, signal_error)
+ (error, verror, nsberror, report_file_error, Ftop_level, Fkill_emacs)
+ (fatal):
+ (child_setup) [!DOS_NT]:
+ * lread.c (end_of_file_error, invalid_syntax):
+ * process.c (send_process_trap) [!FORWARD_SIGNAL_TO_MAIN_THREAD]:
+ * puresize.h (pure_write_error):
+ * search.c (matcher_overflow):
+ * sound.c (sound_perror, alsa_sound_perror):
+ * sysdep.c, syssignal.h (croak):
+ * term.c (maybe_fatal, vfatal):
+ * textprop.c (text_read_only):
+ * undo.c (user_error):
+ * unexmacosx.c (unexec_error):
+ * xterm.c (x_ins_del_lines, x_delete_glyphs):
+ Use _Noreturn rather than NO_RETURN.
+ No need for separate decl merely because of _Noreturn.
+ * sound.c (sound_warning, parse_sound):
+ Remove unnecessary forward decls.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix bug when time_t is unsigned and as wide as intmax_t (Bug#9000).
+ * lisp.h (WAIT_READING_MAX): New macro.
+ * dispnew.c (Fsleep_for, sit_for):
+ * keyboard.c (kbd_buffer_get_event):
+ * process.c (Faccept_process_output):
+ Use it to avoid bogus compiler warnings with obsolescent GCC versions.
+ This improves on the previous patch, which introduced a bug
+ when time_t is unsigned and as wide as intmax_t.
+ See <http://bugs.gnu.org/9000#51>.
+
+2012-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ * dispnew.c (sit_for, Fsleep_for):
+ * keyboard.c (kbd_buffer_get_event):
+ * process.c (Faccept_process_output): Avoid compiler warnings when
+ comparing a 32-bit time_t with a 64-bit INTMAX_MAX.
+
+2012-06-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in: Update dependencies.
+
+ * w32.c (ltime): Add return type and declare static.
+ (w32_get_internal_run_time): Remove usused variable `time_100ns'.
+
+2012-06-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sysdep.c [__FreeBSD__]: Fix more recently-introduced typos.
+ Privately reported by Herbert J. Skuhra.
+ (make_lisp_timeval) [__FreeBSD__]: Rename from TIMELIST.
+ All uses changed.
+ (system_process_attributes) [__FreeBSD__]: Invoke make_lisp_time,
+ not make_lisp_timeval, when the argument is of type EMACS_TIME.
+
+2012-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (Fw32_get_locale_info): Fix an off-by-one error in
+ last argument of make_unibyte_string.
+
+ * keyboard.c (kbd_buffer_get_event): Include the codepage and the
+ language ID in the event parameters.
+
+ * w32term.c (w32_read_socket): Put the new keyboard codepage into
+ event.code, not the obscure "character set ID".
+
+2012-06-23 Chong Yidong <cyd@gnu.org>
+
+ * xmenu.c (x_menu_wait_for_event): Adapt GTK3 to new xg_select.
+
+2012-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the MS-Windows build broken by 2012-06-22T21:17:42Z!eggert@cs.ucla.edu.
+ * w32.c (fdutimens): New function.
+
+ * w32proc.c (sys_select): Adapt to change in the EMACS_TIME type.
+
+ * s/ms-w32.h (pselect): Redirect to sys_select.
+
+ * sysselect.h [WINDOWSNT]: Don't include sys/select.h.
+
+ * ralloc.c (r_alloc_inhibit_buffer_relocation): Fix stupid thinko
+ in the logic of incrementing and decrementing the value of
+ use_relocatable_buffers.
+
+2012-06-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sysdep.c [__FreeBSD__]: Fix recently-introduced typos.
+ Privately reported by Herbert J. Skuhra.
+ [__FreeBSD__]: Remove "*/" typo after "#include".
+ (timeval_to_EMACS_TIME) [__FreeBSD__]: New static function.
+ (TIMEVAL) [__FreeBSD__]: Now a static function rather than a macro.
+ (TIMEVAL, system_process_attributes) [__FreeBSD__]:
+ Don't assume EMACS_TIME and struct timeval are the same type.
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+ The time stamps are only nanosecond-resolution at the C level,
+ since that's the best that any real-world system supports now.
+ But they are picosecond-resolution at the Lisp level, as that's
+ easy, and leaves room for future OS improvements.
+
+ * Makefile.in (LIB_CLOCK_GETTIME): New macro.
+ (LIBES): Use it.
+
+ * alloc.c (Fgarbage_collect): Port to higher-res time stamps.
+ Don't get current time unless it's needed.
+
+ * atimer.c: Include <sys/time.h> unconditionally, since gnulib
+ now provides it if it's absent.
+ (start_atimer): Port to higher-res time stamps.
+ Check for time stamp overflow. Don't get current time more
+ often than is needed.
+
+ * buffer.h (struct buffer): Buffer modtime now has high resolution.
+ Include systime.h, not time.h.
+ (NONEXISTENT_MODTIME_NSECS, UNKNOWN_MODTIME_NSECS): New macros.
+
+ * dired.c: Include stat-time.h.
+ (Ffile-attributes): File times now have higher resolution.
+
+ * dispextern.h [HAVE_WINDOW_SYSTEM]: Include systime.h.
+ (struct image): Timestamp now has higher resolution.
+
+ * dispnew.c (PERIODIC_PREEMPTION_CHECKING): Remove, as Emacs always
+ has at least microseconds now. All uses removed.
+ (update_frame, update_single_window, update_window, update_frame_1)
+ (Fsleep_for, sit_for): Port to higher-resolution time stamps.
+ (duration_to_sec_usec): Remove; no longer needed.
+
+ * editfns.c (time_overflow): Now extern.
+ (Fcurrent_time, Fget_internal_run_time, make_time, lisp_time_argument)
+ (float-time, Fformat_time_string, Fcurrent_time_string)
+ (Fcurrent_time_zone): Accept and generate higher-resolution
+ time stamps.
+ (make_time_tail, make_lisp_time, dissassemble_lisp_time)
+ (decode_time_components, lisp_seconds_argument): New functions.
+ (make_time): Now static.
+ (lisp_time_argument): Now returns EMACS_TIME. New arg ppsec.
+ Report an error if the time is invalid, rather than having the caller
+ do that.
+
+ * fileio.c: Include <stat-time.h>
+ (Fcopy_file): Copy higher-resolution time stamps.
+ Prefer to set the time stamp via a file descriptor if that works.
+ (Fset_file_times, Finsert_file_contents, Fwrite_region)
+ (Fverify_visited_file_modtime, Fclear_visited_file_modtime)
+ (Fvisited_file_modtime, Fset_visited_file_modtime):
+ Support higher-resolution time stamps.
+
+ * fns.c (Frandom): Use nanoseconds, not microseconds, for seed.
+
+ * gtkutil.c (xg_maybe_add_timer): Port to higher-res time stamps.
+
+ * image.c (prepare_image_for_display, clear_image_cache)
+ (lookup_image): Port to higer-resolution time stamps.
+
+ * keyboard.c (start_polling, bind_polling_period):
+ Check for time stamp overflow.
+ (read_char, kbd_buffer_get_event, timer_start_idle)
+ (timer_stop_idle, timer_resume_idle, timer_check_2, timer_check)
+ (Fcurrent_idle_time, init_keyboard, set_waiting_for_input):
+ Port to higher-resolution time stamps. Do not assume time_t is signed.
+ (decode_timer): New function. Timers are now vectors of length 9,
+ not 8, to accommodate the picosecond component.
+ (timer_check_2): Use it.
+
+ * nsterm.m (select_timeout, timeval_subtract): Remove.
+ (ns_timeout): Use Emacs's facilities for time stamp arithmetic,
+ as they're a bit more accurate and handle overflow better.
+ (ns_select): Change prototype to be compatible with pselect.
+ (ns_select, ns_term_shutdown): Port to ns-resolution time stamps.
+ * nsterm.h (ns_select): Adjust prototype.
+
+ * msdos.c (EMACS_TIME_ZERO_OR_NEG_P): Remove, as it assumes
+ us-resolution time stamps.
+ (sys_select): Use the new EMACS_TIME_SIGN macro instead.
+
+ * lread.c (read_filtered_event): Port to ns-resolution time stamps.
+
+ * lisp.h (time_overflow): New decl.
+ (wait_reading_process_output): First arg is now intmax_t, not int,
+ to accommodate larger waits.
+
+ * process.h (struct Lisp_Process.read_output_delay):
+ Now counts nanoseconds, not microseconds.
+ * process.c (ADAPTIVE_READ_BUFFERING): Don't worry about
+ EMACS_HAS_USECS.
+ (READ_OUTPUT_DELAY_INCREMENT, Faccept_process_output)
+ (wait_reading_process_output):
+ Port to ns-resolution time stamps.
+ (Faccept_process_output, wait_reading_process_output):
+ Check for time stamp overflow. Do not assume time_t is signed.
+ (select_wrapper): Remove; we now use pselect.
+ (Fprocess_attributes): Now generates ns-resolution time stamps.
+
+ * sysdep.c: Include utimens.h. Don't include utime.h
+ or worry about struct utimbuf; gnulib does that for us now.
+ (gettimeofday): Remove; gnulib provides a substitute.
+ (make_timeval): New function.
+ (set_file_times): Now sets ns-resolution time stamps.
+ New arg FD; all uses changed.
+ (time_from_jiffies, ltime_from_jiffies, get_up_time)
+ (system_process_attributes):
+ Now returns ns-resolution time stamp. All uses changed.
+ Check for time stamp overflow.
+
+ * sysselect.h: Don't depend on HAVE_SYS_SELECT_H; gnulib
+ provides a substitute now.
+
+ * systime.h: Include timespec.h rather than sys/time.h and time.h,
+ since it guarantees struct timespec.
+ (EMACS_TIME): Now struct timespec, so that we can support
+ ns-resolution time stamps.
+ (EMACS_TIME_RESOLUTION, LOG10_EMACS_TIME_RESOLUTION): New macros.
+ (EMACS_HAS_USECS): Remove; Emacs always has sub-second time stamps now.
+ (EMACS_USECS): Remove.
+ (EMACS_SET_USECS): The underlying time stamp now has ns resolution,
+ so multiply the arg by 1000 before storing it.
+ (EMACS_NSECS, EMACS_SECS_ADDR, EMACS_SET_NSECS, EMACS_SET_SECS_NSECS):
+ New macros.
+ (EMACS_GET_TIME, EMACS_ADD_TIME, EMACS_SUB_TIME):
+ Port to ns-resolution time stamps.
+ (EMACS_TIME_NEG_P): Remove; replaced by....
+ (EMACS_TIME_SIGN): New macro.
+ (EMACS_SET_INVALID_TIME, EMACS_TIME_VALID_P)
+ (EMACS_TIME_FROM_DOUBLE, EMACS_TIME_TO_DOUBLE): New macros.
+ (set_file_times, make_time, lisp_time_argument): Adjust signature.
+ (make_timeval, make_lisp_time, decode_time_components): New decls.
+ (EMACS_TIME_CMP): Remove; no longer used. Plus, it was buggy, in
+ that it mishandled time_t overflow. You can't compare by subtracting!
+ (EMACS_TIME_EQ, EMACS_TIME_NE, EMACS_TIME_GT, EMACS_TIME_GE)
+ (EMACS_TIME_LT, EMACS_TIME_LE): Rewrite in terms of timespec_cmp.
+
+ * term.c: Include <sys/time.h>.
+ (timeval_to_Time): New function, for proper overflow wraparound.
+ (term_mouse_position, term_mouse_click): Use it.
+
+ * undo.c (record_first_change): Support higher-resolution time stamps
+ in the undo buffer.
+ (Fprimitive_undo): Use them when restoring time stamps.
+
+ * w32.c (ltime, U64_TO_LISP_TIME, process_times, emacs_gnutls_pull)
+ (w32_get_internal_run_time):
+ Port to higher-resolution Emacs time stamps.
+ (ltime): Now accepts single 64-bit integer, as that's more convenient
+ for callers.
+
+ * xdisp.c (start_hourglass): Port to ns-resolution time stamps.
+
+ * xgselect.c, xgselect.h (xg_select): Add sigmask argument,
+ for compatibility with pselect. Support ns-resolution time stamps.
+
+ * xmenu.c (x_menu_wait_for_event): Support ns-resolution time stamps.
+
+ * xselect.c (wait_for_property_change, x_get_foreign_selection):
+ Check for time stamp overflow, and support ns-resolution time stamps.
+
+ * xterm.c: Don't include sys/time.h; gnulib does that for us now.
+ Don't worry about whether HAVE_TIMEVAL and HAVE_SELECT are set.
+ (timeval_subtract): Remove; no longer needed.
+ (XTflash, XTring_bell, x_wait_for_event):
+ Port to ns-resolution time stamps. Don't assume time_t is signed.
+
+2012-06-22 Chong Yidong <cyd@gnu.org>
+
+ * xdisp.c (x_consider_frame_title): Revert last change.
+
+2012-06-22 Eli Zaretskii <eliz@gnu.org>
+
+ * alloc.c (NSTATICS): Enlarge to 0x650. Otherwise, Emacs compiled
+ with -DENABLE_CHECKING -DXASSERTS -DGLYPH_DEBUG=1 -DBYTE_CODE_METER
+ aborts in staticpro during startup. (Without -DBYTE_CODE_METER,
+ staticidx goes up to 1597 out of 1600 = 0x640.)
+
+2012-06-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fileio.c (Fdefault_file_modes): Block input while fiddling with umask.
+ Otherwise, the umask might be mistakenly 0 while handling input signals.
+
+2012-06-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuf.c (Fread_string): Bind minibuffer-completion-table.
+
+2012-06-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c, bytecode.c, ccl.c, coding.c, composite.c, data.c, dosfns.c:
+ * font.c, image.c, keyboard.c, lread.c, menu.c, minibuf.c, msdos.c:
+ * print.c, syntax.c, window.c, xmenu.c, xselect.c: Replace direct
+ access to `contents' member of Lisp_Vector objects with AREF and ASET
+ where appropriate.
+
+2012-06-19 Chong Yidong <cyd@gnu.org>
+
+ * frame.c (delete_frame): When selecting a frame on a different
+ text terminal, do not alter the terminal's top-frame.
+
+ * xdisp.c (format_mode_line_unwind_data): Record the target
+ frame's selected window and its terminal's top-frame.
+ (unwind_format_mode_line): Restore them.
+ (x_consider_frame_title, display_mode_line, Fformat_mode_line):
+ Callers changed.
+ (x_consider_frame_title): Do not condition on HAVE_WINDOW_SYSTEM,
+ since tty frames can be explicitly named.
+ (prepare_menu_bars): Likewise.
+
+ * term.c (Ftty_top_frame): New function.
+
+2012-06-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port byte-code-meter to modern targets.
+ * bytecode.c (METER_CODE) [BYTE_CODE_METER]: Don't assume
+ !CHECK_LISP_OBJECT_TYPE && !USE_LSB_TAG. Problem with
+ CHECK_LISP_OBJECT_TYPE reported by Dmitry Antipov in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00282.html>.
+ (METER_1, METER_2): Simplify.
+
+2012-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * data.c (Fdefalias): Return `symbol' (bug#11686).
+
+2012-06-18 Martin Rudalics <rudalics@gmx.at>
+
+ * buffer.c (Fkill_buffer): Don't throw an error when the buffer
+ gets killed during executing of this function (Bug#11665).
+ Try to always return Qt when the buffer has been actually killed.
+ (Vkill_buffer_query_functions): In doc-string say that functions
+ run by this hook should not change the current buffer.
+
+2012-06-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix recently-introduced process.c problems found by static checking.
+ * process.c (write_queue_push, write_queue_pop, send_process):
+ Use ptrdiff_t, not int or EMACS_INT, for buffer lengths and offsets.
+ (write_queue_pop): Fix pointer signedness problem.
+ (send_process): Remove unused local.
+
+2012-06-17 Chong Yidong <cyd@gnu.org>
+
+ * xdisp.c (redisplay_internal): No need to redisplay terminal
+ frames that are not on top.
+
+2012-06-17 Troels Nielsen <bn.troels@gmail.com>
+
+ * process.c (make_process): Initialize write_queue.
+ (write_queue_push, write_queue_pop): New functions.
+ (send_process): Use them to maintain correct ordering of process
+ writes (Bug#10815).
+
+2012-06-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h (eassert): Assume C89 or later.
+ This removes the need for CHECK.
+ (CHECK): Remove. Its comments about always evaluating its
+ argument were confusing, as 'eassert' typically does not evaluate
+ its argument.
+
+ * coding.c (produce_chars): Use ptrdiff_t, not int.
+
+ * xterm.c (x_draw_underwave): Check for integer overflow.
+ This pacifies gcc 4.7.0 -Wunsafe-loop-optimizations on x86-64.
+
+2012-06-17 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (x_free_frame_resources): Move xfree so freed memory isn't
+ referenced (Bug#11583).
+
+2012-06-16 Aurelien Aptel <aurelien.aptel@gmail.com>
+
+ Implement wave-style variant of underlining.
+ * dispextern.h (face_underline_type): New enum.
+ (face): Add field for underline type.
+ * nsterm.m (ns_draw_underwave): New function.
+ (ns_draw_text_decoration): Use it.
+ * w32term.c (w32_restore_glyph_string_clip, w32_draw_underwave):
+ New functions.
+ (x_draw_glyph_string): Use them.
+ * xfaces.c (Qline, Qwave): New Lisp objects.
+ (check_lface_attrs, merge_face_ref)
+ (Finternal_set_lisp_face_attribute, realize_x_face):
+ Handle wave-style underline face attributes.
+ * xterm.c (x_draw_underwave): New function.
+ (x_draw_glyph_string): Use it.
+
+2012-06-16 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/emacs.$(O), $(BLD)/fringe.$(O))
+ ($(BLD)/xml.$(O), $(BLD)/intervals.$(O), $(BLD)/macros.$(O))
+ ($(BLD)/minibuf.$(O), $(BLD)/regex.$(O), $(BLD)/region-cache.$(O))
+ ($(BLD)/textprop.$(O), $(BLD)/undo.$(O), $(BLD)/window.$(O))
+ ($(BLD)/w32select.$(O)): Update dependencies.
+
+2012-06-16 Andreas Schwab <schwab@linux-m68k.org>
+
+ * buffer.h (FETCH_MULTIBYTE_CHAR): Define as inline.
+ (BUF_FETCH_MULTIBYTE_CHAR): Likewise.
+ * character.c (_fetch_multibyte_char_p): Remove.
+ * alloc.c: Include "character.h" before "buffer.h".
+ * bidi.c: Likewise.
+ * buffer.c: Likewise.
+ * bytecode.c: Likewise.
+ * callint.c: Likewise.
+ * callproc.c: Likewise.
+ * casefiddle.c: Likewise.
+ * casetab.c: Likewise.
+ * category.c: Likewise.
+ * cmds.c: Likewise.
+ * coding.c: Likewise.
+ * composite.c: Likewise.
+ * dired.c: Likewise.
+ * dispnew.c: Likewise.
+ * doc.c: Likewise.
+ * dosfns.c: Likewise.
+ * editfns.c: Likewise.
+ * emacs.c: Likewise.
+ * fileio.c: Likewise.
+ * filelock.c: Likewise.
+ * font.c: Likewise.
+ * fontset.c: Likewise.
+ * fringe.c: Likewise.
+ * indent.c: Likewise.
+ * insdel.c: Likewise.
+ * intervals.c: Likewise.
+ * keyboard.c: Likewise.
+ * keymap.c: Likewise.
+ * lread.c: Likewise.
+ * macros.c: Likewise.
+ * marker.c: Likewise.
+ * minibuf.c: Likewise.
+ * nsfns.m: Likewise.
+ * nsmenu.m: Likewise.
+ * print.c: Likewise.
+ * process.c: Likewise.
+ * regex.c: Likewise.
+ * region-cache.c: Likewise.
+ * search.c: Likewise.
+ * syntax.c: Likewise.
+ * term.c: Likewise.
+ * textprop.c: Likewise.
+ * undo.c: Likewise.
+ * unexsol.c: Likewise.
+ * w16select.c: Likewise.
+ * w32fns.c: Likewise.
+ * w32menu.c: Likewise.
+ * window.c: Likewise.
+ * xdisp.c: Likewise.
+ * xfns.c: Likewise.
+ * xmenu.c: Likewise.
+ * xml.c: Likewise.
+ * xselect.c: Likewise.
+
+2012-06-16 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (set_cursor_from_row): Don't dereference glyphs_end.
+ If all the glyphs of the glyph row came from strings, and we have no
+ cursor positioning clues, put the cursor on the first glyph of the
+ row.
+ (handle_face_prop): Use chunk-relative overlay string index when
+ indexing into it->string_overlays array. (Bug#11653)
+ (set_cursor_from_row): Use the leftmost glyph as GLYPH_BEFORE, not
+ the rightmost. (Bug#11720)
+
+2012-06-16 Andreas Schwab <schwab@linux-m68k.org>
+
+ * category.h (CHAR_HAS_CATEGORY): Define as inline.
+ (CATEGORY_MEMBER): Enforce 1/0 value.
+ * category.c (_temp_category_set): Remove.
+
+2012-06-16 Eli Zaretskii <eliz@gnu.org>
+
+ * window.c (Fdelete_other_windows_internal)
+ (Fdelete_window_internal): Don't access frame's mouse highlight
+ info of the initial frame. (Bug#11677)
+
+2012-06-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * .gdbinit (xgetint): Fix recently-introduced paren typo.
+ Assume USE_2_TAGS_FOR_INTS.
+ (xreload): Adjust $tagmask width to match recent lisp.h change.
+
+ Simplify lisp.h in minor ways that should not affect code.
+ * lisp.h (USE_2_TAGS_FOR_INTS): Remove, as it was always defined.
+ (LISP_INT_TAG, case_Lisp_Int, LISP_STRING_TAG, LISP_INT_TAG_P)
+ (LISP_INT1_TAG, enum Lisp_Type, XINT, XUINT, make_number):
+ Simplify under the assumption that USE_2_TAGS_FOR_INTS is defined.
+ (INTTYPEBITS): New macro, for clarity.
+ (INTMASK, MOST_POSITIVE_FIXNUM): Use it.
+ (LISP_INT1_TAG, LISP_STRING_TAG, LISP_INT_TAG_P):
+ Simplify now that USE_LSB_TAG is always defined.
+ (TYPEMASK, XINT) [USE_LSB_TAG]: Remove unnecessary cast.
+ (make_number) [!USE_LSB_TAG]: Use INTMASK; that's simpler.
+
+2012-06-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/data.$(O)): Update dependencies.
+
+2012-06-13 Glenn Morris <rgm@gnu.org>
+
+ * s/bsd-common.h (BSD4_3):
+ * s/usg5-4-common.h (USG5_4): No longer define; unused.
+
+2012-06-13 Andreas Schwab <schwab@linux-m68k.org>
+
+ * lisp.h (Lisp_Object) [CHECK_LISP_OBJECT_TYPE]: Define as struct
+ instead of union.
+ (XLI, XIL): Define.
+ (XHASH, XTYPE, XINT, XUINT, make_number, XSET, XPNTR, XUNTAG):
+ Use them.
+ * emacs.c (gdb_use_struct): Rename from gdb_use_union.
+ * .gdbinit: Check gdb_use_struct instead of gdb_use_union.
+ * alloc.c (widen_to_Lisp_Object): Remove.
+ (mark_memory): Use XIL instead of widen_to_Lisp_Object.
+ * frame.c (delete_frame): Remove outdated comment.
+ * w32fns.c (Fw32_register_hot_key): Use XLI instead of checking
+ USE_LISP_UNION_TYPE.
+ (Fw32_unregister_hot_key): Likewise.
+ (Fw32_toggle_lock_key): Likewise.
+ * w32menu.c (add_menu_item): Likewise.
+ (w32_menu_display_help): Use XIL instead of checking
+ USE_LISP_UNION_TYPE.
+ * w32heap.c (allocate_heap): Don't check USE_LISP_UNION_TYPE.
+ (init_heap): Likewise.
+ * w32term.c (w32_read_socket): Update comment.
+
+2012-06-13 Glenn Morris <rgm@gnu.org>
+
+ * s/usg5-4-common.h, src/s/unixware.h:
+ Remove define/undef of HAVE_SYSV_SIGPAUSE (not used since 2010-05-04).
+
+ * s/gnu.h (POSIX_SIGNALS): Remove (not used since 2010-05-04).
+
+2012-06-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ USE_LISP_UNION_TYPE + USE_LSB_TAG cleanup (Bug#11604)
+ * alloc.c (make_number) [!defined make_number]:
+ Remove, as lisp.h always defines this now.
+ (mark_maybe_pointer): Simplify since USE_LSB_TAG is always defined now.
+ (roundup_size): Verify that it is a power of 2.
+ * data.c (Fmake_variable_buffer_local, Fmake_local_variable):
+ * ftfont.c (ftfont_driver): Use LISP_INITIALLY_ZERO.
+ * lisp.h (USE_LSB_TAG): Allow the builder to compile with
+ -DUSE_LSB_TAG=0, to override the automatically-selected default.
+ USE_LSB_TAG now is always defined to be either 0 or 1.
+ All uses changed.
+ (union Lisp_Object): Don't worry about WORDS_BIGENDIAN; the
+ code works fine either way, and efficiency is not a concern here,
+ as the union type is for debugging, not for production.
+ (LISP_MAKE_RVALUE, make_number) [USE_LISP_UNION_TYPE]:
+ Use an inline function on all platforms when using the union type,
+ since this is simpler and 'static inline' can be used portably
+ within Emacs now.
+ (LISP_INITIALLY_ZERO): New macro.
+ (XFASTINT, XSETFASTINT) [USE_LISP_UNION_TYPE]: Remove.
+ (XSET) [USE_LISP_UNION_TYPE]: Don't overparenthesize.
+
+2012-06-12 Glenn Morris <rgm@gnu.org>
+
+ * s/gnu-kfreebsd.h, s/hpux11.h, s/openbsd.h, s/sol2-10.h: Remove files.
+
+ * s/gnu-linux.h (HAVE_PROCFS): Move to configure.
+
+ * s/hpux10-20.h, s/openbsd.h, s/usg5-4-common.h:
+ Move BROKEN_SIGIO to configure.
+
+ * s/bsd-common.h, s/darwin.h, s/gnu-kfreebsd.h, s/hpux10-20.h:
+ Move NO_TERMIO to configure.
+
+2012-06-12 Chong Yidong <cyd@gnu.org>
+
+ * image.c (imagemagick_load_image): Use MagickFlattenImage if
+ MagickMergeImageLayers is undefined. Use pixel pusher loop if
+ MagickExportImagePixels is undefined.
+
+2012-06-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * image.c (imagemagick_load_image): Remove unused label.
+
+2012-06-11 Glenn Morris <rgm@gnu.org>
+
+ * s/aix4-2.h, s/bsd-common.h, s/cygwin.h, s/darwin.h:
+ * s/gnu-kfreebsd.h, s/gnu-linux.h, s/gnu.h, s/hpux10-20.h:
+ * s/irix6-5.h, s/ms-w32.h, s/msdos.h, s/template.h:
+ * s/usg5-4-common.h: Move SYSTEM_TYPE to configure.
+
+2012-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * alloc.c (make_byte_code): New function.
+ (Fmake_byte_code): Use it. Don't purify here.
+ * lread.c (read1): Use it as well to avoid extra allocation.
+
+2012-06-11 Chong Yidong <cyd@gnu.org>
+
+ * image.c (imagemagick_load_image): Implement transparency.
+
+2012-06-10 Andreas Schwab <schwab@linux-m68k.org>
+
+ * regex.c (at_begline_loc_p): Also recognize `(?N:' and correctly
+ account for preceding backslashes. (Bug#11663)
+
+2012-06-09 Chong Yidong <cyd@gnu.org>
+
+ * term.c: Support italics in capable terminals (Bug#9652).
+ (no_color_bit): Replace unused NC_BLINK with NC_ITALIC.
+ (turn_on_face): Output using TS_enter_italic_mode if available.
+ Don't handle unused blinking and alt-charset cases.
+ (turn_off_face): Handle italic case; discard unused tty_blinking_p
+ and tty_alt_charset_p cases.
+ (tty_capable_p, init_tty): Support italics.
+
+ * termchar.h (struct tty_display_info): Add field for italics.
+ Remove unused blink field.
+
+ * xfaces.c (tty_supports_face_attributes_p, realize_tty_face):
+ Handle slant.
+
+ * dispextern.h: Replace unused TTY_CAP_BLINK with TTY_CAP_ITALIC.
+ (struct face): Remove unused fields tty_dim_p, tty_blinking_p, and
+ tty_alt_charset_p. Add tty_italic_p.
+
+2012-06-09 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (XD_BASIC_DBUS_TYPE): Use dbus_type_is_valid and
+ dbus_type_is_basic if available.
+ (xd_extract_signed, xd_extract_unsigned): Rename from
+ extract_signed and extract_unsigned, respectively. Adapt callers.
+
+2012-06-09 Chong Yidong <cyd@gnu.org>
+
+ * xfaces.c (face_for_overlay_string): Handle face remapping (Bug#2066).
+
+ * fringe.c (Fset_fringe_bitmap_face): Handle the noninteractive
+ case (Bug#9752).
+
+2012-06-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xdisp.c (vmessage): Treat frame message as multibyte.
+ Without this change, (let ((§ 1)) (make-variable-buffer-local '§))
+ would generate the diagnostic "Making \302\247 buffer-local while
+ let-bound!".
+
+2012-06-08 Eli Zaretskii <eliz@gnu.org>
+
+ * dispnew.c (showing_window_margins_p): Undo last change, which
+ was done due to an inadvertent commit.
+ (adjust_frame_glyphs_for_frame_redisplay): Do call
+ showing_window_margins_p.
+
+2012-06-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Fmake_var_non_special): New primitive.
+ (syms_of_eval): Defsubr it.
+ * lread.c (syms_of_lread): Mark `values' as lexically scoped.
+
+2012-06-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * dispnew.c (showing_window_margins_p): Wrap in #if 0 to prevent unused
+ function warning (the only call is inside #if 0 since 2012-06-08T08:44:45Z!eliz@gnu.org).
+
+2012-06-08 Eli Zaretskii <eliz@gnu.org>
+
+ * alloc.c (allocate_vectorlike): Fix last change.
+
+2012-06-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Block-based vector allocation of small vectors.
+ * lisp.h (struct vectorlike_header): New field `nbytes',
+ adjust comment accordingly.
+ * alloc.c (enum mem_type): New type `MEM_TYPE_VECTOR_BLOCK'
+ to denote vector blocks. Adjust users (live_vector_p,
+ mark_maybe_pointer, valid_lisp_object_p) accordingly.
+ (COMMON_MULTIPLE): Move outside #if USE_LSB_TAG.
+ (VECTOR_BLOCK_SIZE, vroundup, VECTOR_BLOCK_BYTES),
+ (VBLOCK_BYTES_MIN, VBLOCK_BYTES_MAX, VECTOR_MAX_FREE_LIST_INDEX),
+ (VECTOR_FREE_LIST_FLAG, ADVANCE, VINDEX, SETUP_ON_FREE_LIST),
+ (VECTOR_SIZE, VECTOR_IN_BLOCK): New macros.
+ (roundup_size): New constant.
+ (struct vector_block): New data type.
+ (vector_blocks, vector_free_lists, zero_vector): New variables.
+ (all_vectors): Rename to `large_vectors'.
+ (allocate_vector_from_block, init_vectors, allocate_vector_from_block)
+ (sweep_vectors): New functions.
+ (allocate_vectorlike): Return `zero_vector' as the only vector of
+ 0 items. Allocate new vector from block if vector size is less than
+ or equal to VBLOCK_BYTES_MAX.
+ (Fgarbage_collect): Move all vector sweeping code to sweep_vectors.
+ (init_alloc_once): Add call to init_vectors.
+
+2012-06-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Fmacroexpand): Stop if the macro returns the same form.
+
+2012-06-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ * doprnt.c (doprnt): Truncate multibyte char correctly.
+ Without this change, doprnt (buf, 2, "%s", FORMAT_END, AP)
+ would mishandle a string argument "Xc" if X was a multibyte
+ character of length 2: it would truncate after X's first byte
+ rather than including all of X.
+
+2012-06-06 Chong Yidong <cyd@gnu.org>
+
+ * buffer.c (word_wrap): Doc fix.
+
+2012-06-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xdisp.c (note_mode_line_or_margin_highlight): Pacify gcc -Wall.
+
+2012-06-03 Glenn Morris <rgm@gnu.org>
+
+ * xdisp.c (tool-bar-style): Doc fix.
+
+2012-06-03 Ulrich Müller <ulm@gentoo.org>
+
+ * Makefile.in (PAXCTL): Define.
+ (temacs$(EXEEXT)): Disable memory randomization for the temacs
+ binary via PaX flags if the paxctl utility is available.
+ (emacs$(EXEEXT), bootstrap-emacs$(EXEEXT)):
+ Restore PaX flags to their default. (Bug#11398)
+
+2012-06-03 Chong Yidong <cyd@gnu.org>
+
+ * xdisp.c (decode_mode_spec_coding): Display a space for a unibyte
+ buffer (Bug#11226).
+
+2012-06-03 Chong Yidong <cyd@gnu.org>
+
+ * xdisp.c (calc_pixel_width_or_height): Use Fbuffer_local_value.
+ (note_mode_line_or_margin_highlight): If there is no help echo,
+ use mode-line-default-help-echo. Handle the case where the mouse
+ position is past the end of the mode line string.
+
+ * buffer.c (buffer_local_value_1): New function, split from
+ Fbuffer_local_value; can return Qunbound.
+ (Fbuffer_local_value): Use it.
+ (Vmode_line_format): Docstring tweaks.
+
+2012-06-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sysdep.c (system_process_attributes): Improve comment.
+
+2012-06-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * keyboard.c: Export real-this-command to Elisp.
+ (syms_of_keyboard): Rename real_this_command to Vreal_this_command
+ and DEFVAR it. Update all users.
+
+2012-06-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ * minibuf.c (Fassoc_string): Remove duplicate declaration.
+
+ * sysdep.c (system_process_attributes) [SOLARIS2 && HAVE_PROCFS]:
+ Convert pctcpu and pctmem to Lisp float properly.
+ Let the compiler fold better, as 100.0/0x8000 is exact.
+
+2012-06-02 Andreas Schwab <schwab@linux-m68k.org>
+
+ * alloc.c (CONS_BLOCK_SIZE): Account for padding at the end of
+ cons_block.
+
+2012-06-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xfns.c (x_set_tool_bar_lines) [USE_GTK]: Adjust to bitfield change.
+
+2012-06-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ For a 'struct window', replace some Lisp_Object fields to
+ bitfields where appropriate, remove unused fields.
+ * window.h (struct window): Remove unused 'last_mark_x' and
+ 'last_mark_y' fields. Rename 'mini_p' field to 'mini',
+ change its type from Lisp_Object to bitfield.
+ Change type of 'force_start', 'optional_new_start',
+ 'last_had_star', 'update_mode_line' and 'start_at_line_beg'
+ fields from Lisp_Object to bitfield. Adjust users accordingly.
+
+2012-05-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ Pacify gcc -Wdouble-precision when using Xaw.
+ * xterm.c (xaw_jump_callback, x_set_toolkit_scroll_bar_thumb)
+ [HAVE_X_WINDOWS && USE_TOOLKIT_SCROLL_BARS && !USE_MOTIF && !USE_GTK]:
+ Use 'float' consistently, rather than 'float' in most places
+ and 'double' in a couple of places.
+
+2012-05-31 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (handle_stop): Detect whether we have overlay strings
+ loaded by testing it->current.overlay_string_index to be
+ non-negative, instead of checking whether n_overlay_strings is
+ positive. (Bug#11587)
+
+2012-05-31 Chong Yidong <cyd@gnu.org>
+
+ * keymap.c (describe_map_tree): Revert 2011-07-07 change (Bug#1169).
+
+ * doc.c (Fsubstitute_command_keys): Doc fix.
+
+2012-05-31 Eli Zaretskii <eliz@gnu.org>
+
+ * search.c (search_buffer): Remove calls to
+ r_alloc_inhibit_buffer_relocation, as it is now called by
+ maybe_unify_char, which was the cause of relocation of buffer text
+ in bug#11519.
+
+2012-05-31 Eli Zaretskii <eliz@gnu.org>
+
+ * charset.c (maybe_unify_char): Inhibit relocation of buffer text
+ for the duration of call to load_charset, to avoid problems with
+ callers of maybe_unify_char that access buffer text through C
+ pointers.
+
+ * ralloc.c (r_alloc_inhibit_buffer_relocation): Increment and
+ decrement the inhibition flag, instead of just setting or
+ resetting it.
+
+2012-05-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove obsolete '#define static' cruft.
+ * s/hpux10-20.h (_FILE_OFFSET_BITS): Don't #undef.
+ This #undef was "temporary" in 2000; it is no longer needed
+ now that '#define static' has gone away.
+ * xfns.c, xterm.h (gray_bitmap_width, gray_bitmap_height)
+ (gray_bitmap_bits): Remove; no longer needed.
+ All uses replaced with definiens.
+ * xterm.c: Include "bitmaps/gray.xbm".
+
+2012-05-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clean up __executable_start, monstartup when --enable-profiling.
+ The following changes affect the code only when profiling.
+ * dispnew.c (__executable_start): Rename from safe_bcopy.
+ Define only on platforms that need it.
+ * emacs.c: Include <sys/gmon.h> when profiling.
+ (_mcleanup): Remove decl, since <sys/gmon.h> does it now.
+ (__executable_start): Remove decl, since lisp.h does it now.
+ (safe_bcopy): Remove decl; no longer has that name.
+ (main): Coalesce #if into single bit of code, for simplicity.
+ Cast pointers to uintptr_t, since standard libraries want integers
+ and not pointers.
+ * lisp.h (__executable_start): New decl.
+
+2012-05-31 Glenn Morris <rgm@gnu.org>
+
+ * image.c (Fimagemagick_types): Doc fix.
+
+2012-05-30 Jim Meyering <meyering@redhat.com>
+
+ * callproc.c (Fcall_process_region): Include directory component
+ in mkstemp error message (Bug#11586).
+
+2012-05-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c, lisp.h (make_pure_vector): Now static.
+
+2012-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Fdefun, Fdefmacro, Vmacro_declaration_function):
+ Move to byte-run.el.
+ (Fautoload): Do the hash-doc more carefully.
+ * data.c (Fdefalias): Purify definition, except for keymaps.
+ (Qdefun): Move from eval.c.
+ * lisp.h (Qdefun): Remove.
+ * lread.c (read1): Tiny simplification.
+
+2012-05-29 Troels Nielsen <bn.troels@gmail.com>
+
+ Do not create empty overlays with the evaporate property (Bug#9642).
+ * buffer.c (Fmove_overlay): Reinstate the earlier fix for
+ Bug#9642, but explicitly check that the buffer the overlay would
+ be moved to is live and rearrange lines to make sure that errors
+ will not put the overlay in an inconsistent state.
+ (Fdelete_overlay): Cosmetics.
+
+2012-05-28 Eli Zaretskii <eliz@gnu.org>
+
+ * w32term.c (my_bring_window_to_top): New function.
+ (x_raise_frame): Use handle returned by DeferWindowPos, which
+ could be different from the original one.
+ Call my_bring_window_to_top instead of my_set_foreground_window.
+ (Bug#11513)
+
+ * w32fns.c (w32_wnd_proc): Accept and process WM_EMACS_BRINGTOTOP
+ by calling BringWindowToTop.
+
+ * w32term.h (WM_EMACS_BRINGTOTOP): New message.
+ (WM_EMACS_END): Increase by one.
+
+2012-05-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ * bidi.c (bidi_mirror_char): Put eassert before conversion to int.
+ This avoids undefined behavior that might cause the eassert
+ to not catch an out-of-range value.
+
+2012-05-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/w32inevt.$(O), $(BLD)/w32console.$(O)):
+ Update dependencies.
+
+2012-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ * bidi.c (bidi_mirror_char): Fix last change.
+
+2012-05-27 Andreas Schwab <schwab@linux-m68k.org>
+
+ * unexmacosx.c (copy_data_segment): Truncate after 16 characters
+ when referring to sectname field in printf format.
+
+2012-05-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h [REL_ALLOC]: Omit duplicate prototypes.
+ Only r_alloc_inhibit_buffer_relocation needed to be added;
+ the others were already declared.
+
+ * bidi.c (bidi_mirror_char): Don't possibly truncate the integer
+ before checking whether it's out of range. Put the check inside
+ eassert. See
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-05/msg00485.html>.
+
+2012-05-27 Ken Brown <kbrown@cornell.edu>
+
+ * callproc.c (Fcall_process): Restore a line that was accidentally
+ commented out in the 2011-02-13 change (bug#11547).
+
+2012-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp.h [REL_ALLOC]: Add prototypes for external functions
+ defined on ralloc.c.
+
+ * buffer.c [REL_ALLOC]: Remove prototypes of
+ r_alloc_reset_variable, r_alloc, r_re_alloc, and r_alloc_free,
+ they are now on lisp.h.
+
+ * ralloc.c (r_alloc_inhibit_buffer_relocation): New function.
+
+ * search.c (search_buffer): Use it to inhibit relocation of buffer
+ text while re_search_2 is doing its job, because re_search_2 is
+ passed C pointers to buffer text. (Bug#11519)
+
+ * msdos.c (internal_terminal_init) <Vwindow_system_version>:
+ Update value to 24.
+
+ * xdisp.c (move_it_to): Under MOVE_TO_Y, when restoring iterator
+ state after an additional call to move_it_in_display_line_to, keep
+ the values of it->max_ascent and it->max_descent found for the
+ entire line.
+ (pos_visible_p): Revert the comparison against bottom_y to what it
+ was in revid eliz@gnu.org-20120513182235-4p6386j761ld0nwb.
+ (Bug#11464)
+
+2012-05-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix coding-related core dumps with gcc -ftrapv.
+ The code was computing A - B, where A and B are pointers, and B is
+ random garbage. This can lead to core dumps on platforms that
+ have special pointer registers, and it also leads to core dumps on
+ x86-64 when compiled with gcc -ftrapv. The fix is to compute
+ A - B only when B is initialized properly.
+ * coding.c (coding_set_source, coding_set_destination): Return void.
+ (coding_change_source, coding_change_destinations): New functions,
+ with the old behaviors of coding_set_source and coding_set_destination.
+ All callers that need an offset changed to use these new functions.
+
+2012-05-26 Glenn Morris <rgm@gnu.org>
+
+ * nsterm.m (ns_init_paths): Don't mess with INFOPATH. (Bug#2791)
+
+2012-05-26 Eli Zaretskii <eliz@gnu.org>
+
+ Extend mouse support on W32 text-mode console.
+ * xdisp.c (draw_row_with_mouse_face):
+ Call tty_draw_row_with_mouse_face for WINDOWSNT as well.
+
+ * w32console.c: Include window.h.
+ (w32con_write_glyphs_with_face, tty_draw_row_with_mouse_face):
+ New functions.
+ (initialize_w32_display): Initialize mouse-highlight data.
+
+ * w32inevt.c: Include termchar.h and window.h.
+ (do_mouse_event): Support mouse-autoselect-window. When the mouse
+ moves, call note_mouse_highlight. If help_echo changed, call
+ gen_help_event to produce help-echo message in the echo area.
+ Call clear_mouse_face if mouse_face_hidden is set in the mouse
+ highlight info.
+
+2012-05-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lread.c (read1): Simplify slightly to avoid an overflow warning
+ with GCC 4.7.0 on x86-64.
+
+2012-05-26 Eli Zaretskii <eliz@gnu.org>
+
+ * bidi.c (bidi_mirror_char): Revert last change: an int is
+ definitely wide enough here.
+
+2012-05-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix integer width and related bugs (Bug#9874).
+ * alloc.c (pure_bytes_used_lisp, pure_bytes_used_non_lisp):
+ (allocate_vectorlike, buffer_memory_full, struct sdata, SDATA_SIZE)
+ (string_bytes, check_sblock, allocate_string_data):
+ (compact_small_strings, Fmake_bool_vector, make_string)
+ (make_unibyte_string, make_multibyte_string)
+ (make_string_from_bytes, make_specified_string)
+ (allocate_vectorlike, Fmake_vector, find_string_data_in_pure)
+ (make_pure_string, make_pure_c_string, make_pure_vector, Fpurecopy)
+ (mark_vectorlike):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (allocate_pseudovector):
+ Use int, not EMACS_INT, where int is wide enough.
+ (inhibit_garbage_collection, Fgarbage_collect):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * bidi.c (bidi_mirror_char): Use EMACS_INT, not int, where
+ int might not be wide enough.
+ (bidi_cache_search, bidi_cache_find, bidi_init_it)
+ (bidi_count_bytes, bidi_char_at_pos, bidi_fetch_char)
+ (bidi_at_paragraph_end, bidi_find_paragraph_start)
+ (bidi_paragraph_init, bidi_resolve_explicit, bidi_resolve_weak)
+ (bidi_level_of_next_char, bidi_move_to_visually_next):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * buffer.c (copy_overlays, Fgenerate_new_buffer_name)
+ (Fkill_buffer, Fset_buffer_major_mode)
+ (advance_to_char_boundary, Fbuffer_swap_text)
+ (Fset_buffer_multibyte, overlays_at, overlays_in)
+ (overlay_touches_p, struct sortvec, record_overlay_string)
+ (overlay_strings, recenter_overlay_lists)
+ (adjust_overlays_for_insert, adjust_overlays_for_delete)
+ (fix_start_end_in_overlays, fix_overlays_before, modify_overlay)
+ (Fmove_overlay, Fnext_overlay_change, Fprevious_overlay_change)
+ (Foverlay_recenter, last_overlay_modification_hooks_used)
+ (report_overlay_modification, evaporate_overlays, enlarge_buffer_text):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (validate_region): Omit unnecessary test for b <= e,
+ since that's guaranteed by the previous test.
+ (adjust_overlays_for_delete): Avoid pos + length overflow.
+ (Fmove_overlay, Fdelete_overlay, add_overlay_mod_hooklist)
+ (report_overlay_modification):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Foverlays_at, Fnext_overlay_change, Fprevious_overlay_change):
+ Omit pointer cast, which isn't needed anyway, and doesn't work
+ after the EMACS_INT -> ptrdiff_t change.
+ (Fmove_overlay): Clip BEG and END to ptrdiff_t to avoid overflow.
+ * buffer.h: Adjust decls to match defn changes elsewhere.
+ (struct buffer_text, struct buffer):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ Use EMACS_INT, not int, where int might not be wide enough.
+ * bytecode.c (unmark_byte_stack, exec_byte_code): Use ptrdiff_t,
+ not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (exec_byte_code): Use tighter memory-full test, one that checks
+ for alloca overflow. Don't compute the address of the object just
+ before an array, as that's not portable. Use EMACS_INT, not
+ ptrdiff_t or int, where ptrdiff_t or int might not be wide enough.
+ * callint.c (Fcall_interactively):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * callproc.c (call_process_kill, Fcall_process):
+ Don't assume pid_t fits into an Emacs fixnum.
+ (call_process_cleanup, Fcall_process, child_setup):
+ Don't assume pid_t fits into int.
+ (call_process_cleanup, Fcall_process, delete_temp_file)
+ (Fcall_process_region):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fcall_process): Simplify handling of volatile integers.
+ Use int, not EMACS_INT, where int will do.
+ * casefiddle.c (casify_object, casify_region, operate_on_word)
+ (Fupcase_word, Fdowncase_word, Fcapitalize_word):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (casify_object): Avoid integer overflow when overallocating buffer.
+ * casetab.c (set_identity, shuffle): Prefer int to unsigned when
+ either works. Use lint_assume to convince GCC 4.6.1 that it's OK.
+ * category.c (Fchar_category_set): Don't assume fixnum fits in int.
+ * category.h (CATEGORYP): Don't assume arg is nonnegative.
+ * ccl.c (GET_CCL_INT): Remove; no longer needed, since the
+ integers are now checked earlier. All uses replaced with XINT.
+ (ccl_driver):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ For CCL_MapSingle, check that content and value are in int range.
+ (ccl_driver, Fregister_code_conversion_map):
+ Check that Vcode_version_map_vector is a vector.
+ (resolve_symbol_ccl_program): Check that vector header is in range.
+ Always copy the vector, so that we can check its contents reliably
+ now rather than having to recheck each instruction as it's being
+ executed. Check that vector words fit in 'int'.
+ (ccl_get_compiled_code, Fregister_ccl_program)
+ (Fregister_code_conversion_map): Use ptrdiff_t, not int, for
+ program indexes, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fccl_execute, Fccl_execute_on_string): Check that initial reg
+ contents are in range.
+ (Fccl_execute_on_string): Check that status is in range.
+ * ccl.h (struct ccl_program.idx): Now ptrdiff_t, not int.
+ * character.c (char_resolve_modifier_mask, Fchar_resolve_modifiers):
+ Accept and return EMACS_INT, not int, because callers can pass values
+ out of 'int' range.
+ (c_string_width, strwidth, lisp_string_width, chars_in_text)
+ (multibyte_chars_in_text, parse_str_as_multibyte)
+ (str_as_multibyte, count_size_as_multibyte, str_to_multibyte)
+ (str_as_unibyte, str_to_unibyte, string_count_byte8)
+ (string_escape_byte8, Fget_byte):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Funibyte_string): Use CHECK_RANGED_INTEGER, not CHECK_NATNUM, to
+ avoid mishandling large integers.
+ * character.h: Adjust decls to match defn changes elsewhere.
+ * charset.c (load_charset_map_from_file, find_charsets_in_text)
+ (Ffind_charset_region):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (load_charset_map_from_file): Redo idx calculation to avoid overflow.
+ (load_charset_map_from_vector, Fdefine_charset_internal):
+ Don't assume fixnum fits in int.
+ (load_charset_map_from_vector, Fmap_charset_chars):
+ Remove now-unnecessary CHECK_NATNUMs.
+ (Fdefine_charset_internal): Check ranges here, more carefully.
+ Don't rely on undefined behavior with signed left shift overflow.
+ Don't assume unsigned int fits into fixnum, or that fixnum fits
+ into unsigned int. Don't require max_code to be a valid fixnum;
+ that's not true for gb10830 4-byte on a 32-bit host. Allow
+ invalid_code to be a cons, for the same reason. Require code_offset
+ to be a character. Avoid int overflow if max_char is close
+ to INT_MAX.
+ (CODE_POINT_TO_INDEX): On 32-bit hosts, return int, not unsigned;
+ this is intended anyway and avoids some undefined behavior.
+ (load_charset_map): Pass unsigned, not int, as 2nd arg of
+ INDEX_TO_CODE_POINT, as that's what it expects.
+ (Funify_charset, encode_char): Don't stuff unsigned vals into int vars.
+ * charset.h (DECODE_CHAR): Return int, not unsigned;
+ this is what was intended anyway, and it avoids undefined behavior.
+ (CHARSET_OFFSET): Remove unused macro, instead of fixing its
+ integer-overflow issues.
+ (ENCODE_CHAR): Return unsigned on all hosts, not just on 32-bit hosts.
+ Formerly, it returned EMACS_INT on 64-bit hosts in the common case
+ where the argument is EMACS_INT, and this behavior is not intended.
+ * chartab.c (Fmake_char_table, Fset_char_table_range)
+ (uniprop_get_decoder, uniprop_get_encoder):
+ Don't assume fixnum fits in int.
+ * cmds.c (move_point): New function, that does the gist of
+ Fforward_char and Fbackward_char, but does so while checking
+ for integer overflow more accurately.
+ (Fforward_char, Fbackward_char): Use it.
+ (Fforward_line, Fend_of_line, internal_self_insert)
+ (internal_self_insert):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ Fix a FIXME, by checking for integer overflow when calculating
+ target_clm and actual_clm.
+ * coding.c (detect_coding_XXX, encode_coding_XXX, CODING_DECODE_CHAR)
+ (CODING_ENCODE_CHAR, CODING_CHAR_CHARSET, CODING_CHAR_CHARSET_P)
+ (ASSURE_DESTINATION, coding_alloc_by_realloc)
+ (coding_alloc_by_making_gap, alloc_destination)
+ (detect_coding_utf_8, encode_coding_utf_8, decode_coding_utf_16)
+ (encode_coding_utf_16, detect_coding_emacs_mule)
+ (decode_coding_emacs_mule, encode_coding_emacs_mule)
+ (detect_coding_iso_2022, decode_coding_iso_2022)
+ (encode_invocation_designation, encode_designation_at_bol)
+ (encode_coding_iso_2022, detect_coding_sjis, detect_coding_big5)
+ (decode_coding_sjis, decode_coding_big5, encode_coding_sjis)
+ (encode_coding_big5, detect_coding_ccl, decode_coding_ccl)
+ (encode_coding_ccl, encode_coding_raw_text)
+ (detect_coding_charset, decode_coding_charset)
+ (encode_coding_charset, detect_eol, decode_eol, produce_chars)
+ (produce_composition, produce_charset, produce_annotation)
+ (decode_coding, handle_composition_annotation)
+ (handle_charset_annotation, consume_chars, decode_coding_gap)
+ (decode_coding_object, encode_coding_object, detect_coding_system)
+ (Ffind_coding_systems_region_internal, Fcheck_coding_systems_region)
+ (code_convert_region, code_convert_string)
+ (Fdefine_coding_system_internal)
+ (coding_set_source, coding_set_destination):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (setup_iso_safe_charsets, consume_chars, Funencodable_char_position)
+ (Fdefine_coding_system_internal):
+ Don't assume fixnums fit in int.
+ (decode_coding_gap, decode_coding_object, encode_coding_object)
+ (Fread_coding_system, Fdetect_coding_region)
+ (Funencodable_char_position, Fcheck_coding_systems_region)
+ (get_translation, handle_composition_annotation, consume_chars):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (consume_chars): Rewrite to not calculate an address outside buffer.
+ (Ffind_operation_coding_system): NATNUMP can eval its arg twice.
+ Don't access memory outside of the args array.
+ (Fdefine_coding_system_internal): Check for charset-id overflow.
+ (ENCODE_ISO_CHARACTER): Use unsigned, not int, to store the unsigned
+ result of ENCODE_CHAR.
+ * coding.h: Adjust decls to match defn changes elsewhere.
+ (struct coding_system):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * composite.c (get_composition_id, find_composition)
+ (run_composition_function, update_compositions)
+ (compose_text, composition_gstring_put_cache)
+ (composition_gstring_p, composition_gstring_width)
+ (fill_gstring_header, fill_gstring_body, autocmp_chars)
+ (composition_compute_stop_pos, composition_reseat_it)
+ (composition_update_it, struct position_record)
+ (find_automatic_composition, composition_adjust_point)
+ (Fcomposition_get_gstring, Ffind_composition_internal):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (update_compositions):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * composite.h: Adjust decls to match defn changes elsewhere.
+ (struct composition):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * data.c (let_shadows_buffer_binding_p, let_shadows_global_binding_p):
+ Do not attempt to compute the address of the object just before a
+ buffer; this is not portable.
+ (Faref, Faset):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Faset): Use int, not EMACS_INT, where int is wide enough.
+ (Fstring_to_number): Don't assume fixnums fit in int.
+ (Frem): Don't assume arg is nonnegative.
+ * dbusbind.c (xd_append_arg): Check for integers out of range.
+ (Fdbus_call_method): Don't overflow the timeout int.
+ (extract_signed, extract_unsigned): New functions.
+ (XD_CHECK_DBUS_SERIAL): Remove; superseded by extract_unsigned.
+ (xd_get_connection_references): Return ptrdiff_t, not int.
+ All uses changed.
+ (xd_signature, xd_append_arg, xd_retrieve_arg, Fdbus_message_internal)
+ (xd_read_message_1):
+ Use int, not unsigned, where the dbus API uses int.
+ (Fdbus_message_internal): Don't overflow mtype.
+ (syms_of_dbusbind): Allocate right-sized buffer for integers.
+ * dired.c (directory_files_internal, file_name_completion, scmp)
+ (file_name_completion_stat):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (file_name_completion): Don't overflow matchcount.
+ (file_name_completion_stat): Use SAFE_ALLOCA, not alloca.
+ * dispextern.h: Adjust decls to match defn changes elsewhere.
+ (struct text_pos, struct glyph, struct bidi_saved_info)
+ (struct bidi_string_data, struct bidi_it, struct composition_it)
+ (struct it):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (struct display_pos, struct composition_it, struct it):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * dispnew.c (increment_matrix_positions)
+ (increment_row_positions, mode_line_string)
+ (marginal_area_string):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (change_frame_size_1, Fredisplay, Fframe_or_buffer_changed_p):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (duration_to_sec_usec): New function, to check for overflow better.
+ (Fsleep_for, sit_for): Use it.
+ * doc.c (get_doc_string, store_function_docstring):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (get_doc_string, Fsnarf_documentation):
+ Use int, not EMACS_INT, where int is wide enough.
+ (get_doc_string):
+ Use SAFE_ALLOCA, not alloca.
+ Check for overflow when converting EMACS_INT to off_t.
+ * doprnt.c (doprnt):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * editfns.c (init_editfns, Fuser_uid, Fuser_real_uid):
+ Don't assume uid_t fits into fixnum.
+ (buildmark, Fgoto_char, overlays_around, find_field, Fdelete_field)
+ (Ffield_string, Ffield_string_no_properties, Ffield_beginning)
+ (Ffield_end, Fconstrain_to_field, Fline_beginning_position)
+ (Fline_end_position, Fprevious_char, Fchar_after, Fchar_before)
+ (general_insert_function)
+ (Finsert_char, make_buffer_string, make_buffer_string_both)
+ (update_buffer_properties, Fbuffer_substring)
+ (Fbuffer_substring_no_properties, Fcompare_buffer_substrings)
+ (Fsubst_char_in_region, check_translation)
+ (Ftranslate_region_internal, save_restriction_restore, Fformat)
+ (transpose_markers, Ftranspose_regions):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (clip_to_bounds): Move to lisp.h as an inline function).
+ (Fconstrain_to_field): Don't assume integers are nonnegative.
+ (Fline_beginning_position, Fsave_excursion, Fsave_current_buffer):
+ (Fsubst_char_in_region, Fsave_restriction):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Femacs_pid): Don't assume pid_t fits into fixnum.
+ (lo_time): Use int, not EMACS_INT, when int suffices.
+ (lisp_time_argument): Check for usec out of range.
+ (Fencode_time): Don't assume fixnum fits in int.
+ (Fuser_login_name, Fuser_full_name): Signal an error
+ if a uid argument is out of range, rather than relying on
+ undefined behavior.
+ (Fformat_time_string): Remove now-unnecessary check.
+ lisp_time_argument checks for out-of-range usec now.
+ Use ptrdiff_t, not size_t, where ptrdiff_t will do.
+ * emacs.c (gdb_valbits, gdb_gctypebits): Now int, not EMACS_INT.
+ (gdb_data_seg_bits): Now uintptr_t, not EMACS_INT.
+ (PVEC_FLAG, gdb_array_mark_flag): Now ptrdiff_t, not EMACS_INT.
+ (init_cmdargs, Fdump_emacs):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fkill_emacs): Don't assume fixnum fits in int; instead, take just
+ the bottom (typically) 32 bits of the fixnum.
+ * eval.c (specpdl_size, call_debugger):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (when_entered_debugger, Fbacktrace_debug):
+ Don't assume fixnum can fit in int.
+ (Fdefvaralias, Fdefvar): Do not attempt to compute the address of
+ the object just before a buffer; this is not portable.
+ (FletX, Flet, Funwind_protect, do_autoload, Feval, funcall_lambda)
+ (grow_specpdl, unbind_to):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fapply, apply_lambda): Don't assume ptrdiff_t can hold fixnum.
+ (grow_specpdl): Simplify allocation by using xpalloc.
+ (Fprog1, Fprog2): Don't assume list length fits in int. Simplify.
+ * fileio.c (Ffind_file_name_handler, Fcopy_file, Frename_file)
+ (Finsert_file_contents, Fwrite_region, Fdo_auto_save):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Ffind_file_name_handler, non_regular_inserted, Finsert_file_contents)
+ (a_write, e_write):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fcopy_file, non_regular_nbytes, read_non_regular)
+ (Finsert_file_contents):
+ Use int, not EMACS_INT, where int is wide enough.
+ (READ_BUF_SIZE): Verify that it fits in int.
+ (Finsert_file_contents): Check that counts are in proper range,
+ rather than assuming fixnums fit into ptrdiff_t etc.
+ Don't assume fixnums fit into int.
+ * floatfns.c (Fexpt): Avoid undefined signed * signed overflow.
+ * fns.c (Fcompare_strings, Fstring_lessp, struct textprop_rec, concat)
+ (string_char_byte_cache_charpos, string_char_byte_cache_bytepos)
+ (string_char_to_byte, string_byte_to_char)
+ (string_make_multibyte, string_to_multibyte)
+ (string_make_unibyte, Fstring_as_unibyte, Fstring_as_multibyte)
+ (Fstring_to_unibyte, Fsubstring, Fsubstring_no_properties)
+ (substring_both, Fdelete, internal_equal, Ffillarray)
+ (Fclear_string, mapcar1)
+ (Fbase64_encode_region, Fbase64_encode_string, base64_encode_1)
+ (Fbase64_decode_region, Fbase64_decode_string, base64_decode_1)
+ (larger_vector, make_hash_table, maybe_resize_hash_table)
+ (hash_lookup, hash_remove_from_table, hash_clear, sweep_weak_table)
+ (Fmaphash, secure_hash):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (concat): Check for string index and length overflow.
+ (Fmapconcat): Don't assume fixnums fit into ptrdiff_t.
+ (Frequire):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (larger_vector): New API (vec, incr_min, size_max) replaces old
+ one (vec, new_size, init). This catches size overflow.
+ INIT was removed because it was always Qnil.
+ All callers changed.
+ (INDEX_SIZE_BOUND): New macro, which calculates more precisely
+ the upper bound on a hash table index size.
+ (make_hash_table, maybe_resize_hash_table): Use it.
+ (secure_hash): Computer start_byte and end_byte only after
+ they're known to be in ptrdiff_t range.
+ * font.c (font_intern_prop, font_at, font_range, Ffont_shape_gstring)
+ (Ffont_get_glyphs, Ffont_at):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (font_style_to_value, font_prop_validate_style, font_expand_wildcards)
+ (Flist_fonts, Fopen_font):
+ Don't assume fixnum can fit in int.
+ (check_gstring): Don't assume index can fit in int.
+ (font_match_p): Check that fixnum is a character, not a nonnegative
+ fixnum, since the later code needs to stuff it into an int.
+ (font_find_for_lface): Use SAFE_ALLOCA_LISP, not alloca.
+ (font_fill_lglyph_metrics): Use unsigned, not EMACS_INT, to avoid
+ conversion overflow issues.
+ (Fopen_font): Check for integer out of range.
+ (Ffont_get_glyphs): Don't assume index can fit in int.
+ * font.h: Adjust decls to match defn changes elsewhere.
+ * fontset.c (reorder_font_vector): Redo score calculation to avoid
+ integer overflow.
+ (num_auto_fontsets, fontset_from_font): Use ptrdiff_t, not
+ printmax_t, where ptrdiff_t is wide enough.
+ (Finternal_char_font):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * frame.c (Fset_mouse_position, Fset_mouse_pixel_position)
+ (Fset_frame_height, Fset_frame_width, Fset_frame_size)
+ (Fset_frame_position, x_set_frame_parameters)
+ (x_set_line_spacing, x_set_border_width)
+ (x_set_internal_border_width, x_set_alpha, x_figure_window_size):
+ Check that fixnums are in proper range for system types.
+ (frame_name_fnn_p, Fframe_parameter, Fmodify_frame_parameters):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fmodify_frame_parameters): Don't assume fixnum fits in int.
+ Use SAFE_ALLOCA_LISP, not alloca.
+ * frame.h (struct frame): Use intptr_t, not EMACS_INT, where
+ intptr_t is wide enough.
+ * fringe.c (lookup_fringe_bitmap, get_logical_fringe_bitmap)
+ (Fdefine_fringe_bitmap): Don't assume fixnum fits in int.
+ (Ffringe_bitmaps_at_pos): Don't assume index fits in int.
+ Check for fixnum out of range.
+ * ftfont.c (ftfont_list): Don't assume index fits in int.
+ Check that fixnums are in proper range for system types.
+ (ftfont_shape_by_flt):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * gnutls.c (emacs_gnutls_write, emacs_gnutls_read):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fgnutls_error_fatalp, Fgnutls_error_string, Fgnutls_boot):
+ Check that fixnums are in proper range for system types.
+ * gnutls.h: Adjust decls to match defn changes elsewhere.
+ * gtkutil.c (xg_dialog_run):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (update_frame_tool_bar):
+ Check that fixnums are in proper range for system types.
+ * image.c (parse_image_spec): Redo count calculation to avoid overflow.
+ (lookup_image): Check that fixnums are in range for system types.
+ * indent.c (last_known_column, last_known_column_point):
+ (current_column_bol_cache):
+ (skip_invisible, current_column, check_display_width):
+ (check_display_width, scan_for_column, current_column_1)
+ (Findent_to, Fcurrent_indentation, position_indentation)
+ (indented_beyond_p, Fmove_to_column, compute_motion):
+ (Fcompute_motion, Fvertical_motion):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (last_known_column_modified): Use EMACS_INT, not int.
+ (check_display_width):
+ (Fcompute_motion):
+ Check that fixnums and floats are in proper range for system types.
+ (compute_motion): Don't assume index or fixnum fits in int.
+ (compute_motion, Fcompute_motion):
+ Use int, not EMACS_INT, when it is wide enough.
+ (vmotion): Omit local var start_hpos that is always 0; that way
+ we don't need to worry about overflow in expressions involving it.
+ * indent.h: Adjust decls to match defn changes elsewhere.
+ (struct position):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ Use int, not EMACS_INT, where int is wide enough.
+ Remove unused members ovstring_chars_done and tab_offset;
+ all uses removed.
+ * insdel.c (move_gap, move_gap_both, gap_left, gap_right)
+ (adjust_markers_for_delete, adjust_markers_for_insert, adjust_point)
+ (adjust_markers_for_replace, make_gap_larger, make_gap_smaller)
+ (make_gap, copy_text, insert, insert_and_inherit)
+ (insert_before_markers, insert_before_markers_and_inherit)
+ (insert_1, count_combining_before, count_combining_after)
+ (insert_1_both, insert_from_string)
+ (insert_from_string_before_markers, insert_from_string_1)
+ (insert_from_gap, insert_from_buffer, insert_from_buffer_1)
+ (adjust_after_replace, adjust_after_insert, replace_range)
+ (replace_range_2, del_range, del_range_1, del_range_byte)
+ (del_range_both, del_range_2, modify_region)
+ (prepare_to_modify_buffer, signal_before_change)
+ (signal_after_change, Fcombine_after_change_execute):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * intervals.c (traverse_intervals, rotate_right, rotate_left)
+ (balance_an_interval, split_interval_right, split_interval_left)
+ (find_interval, next_interval, update_interval)
+ (adjust_intervals_for_insertion, delete_node, delete_interval)
+ (interval_deletion_adjustment, adjust_intervals_for_deletion)
+ (static_offset_intervals, offset_intervals)
+ (merge_interval_right, merge_interval_left, make_new_interval)
+ (graft_intervals_into_buffer, temp_set_point_both)
+ (temp_set_point, set_point, adjust_for_invis_intang)
+ (set_point_both, move_if_not_intangible, get_property_and_range)
+ (get_local_map, copy_intervals, copy_intervals_to_string)
+ (compare_string_intervals, set_intervals_multibyte_1):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * intervals.h: Adjust decls to match defn changes elsewhere.
+ (struct interval):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * keyboard.c (this_command_key_count, this_single_command_key_start)
+ (before_command_key_count, before_command_echo_length, echo_now)
+ (echo_length, recursive_edit_1, Frecursive_edit, Ftrack_mouse)
+ (command_loop_1, safe_run_hooks, read_char, timer_check_2)
+ (menu_item_eval_property, read_key_sequence, Fread_key_sequence)
+ (Fread_key_sequence_vector, Fexecute_extended_command, Fsuspend_emacs):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (last_non_minibuf_size, last_point_position, echo_truncate)
+ (command_loop_1, adjust_point_for_property, read_char, gen_help_event)
+ (make_lispy_position, make_lispy_event, parse_modifiers_uncached)
+ (parse_modifiers, modify_event_symbol, Fexecute_extended_command)
+ (stuff_buffered_input):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (last_auto_save, command_loop_1, read_char):
+ Use EMACS_INT, not int, to avoid integer overflow.
+ (record_char): Avoid overflow in total_keys computation.
+ (parse_modifiers_uncached): Redo index calculation to avoid overflow.
+ * keyboard.h: Adjust decls to match defn changes elsewhere.
+ * keymap.c (Fdefine_key, Fcurrent_active_maps, accessible_keymaps_1)
+ (Fkey_description, Fdescribe_vector, Flookup_key):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (click_position): New function, to check that positions are in range.
+ (Fcurrent_active_maps):
+ (describe_command):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Faccessible_keymaps, Fkey_description):
+ (preferred_sequence_p):
+ Don't assume fixnum can fit into int.
+ (Fkey_description): Use SAFE_ALLOCA_LISP, not alloca.
+ Check for integer overflow in size calculations.
+ (Ftext_char_description): Use CHECK_CHARACTER, not CHECK_NUMBER, to
+ avoid mishandling large integers.
+ * lisp.h: Adjust decls to match defn changes elsewhere.
+ (ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, struct Lisp_String)
+ (struct vectorlike_header, struct Lisp_Subr, struct Lisp_Hash_Table)
+ (struct Lisp_Marker):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (clip_to_bounds): Now an inline function, moved here from editfns.c.
+ (GLYPH_CODE_P): Check for overflow in system types, subsuming the
+ need for GLYPH_CODE_CHAR_VALID_P and doing proper checking ourselves.
+ All callers changed.
+ (GLYPH_CODE_CHAR, GLYPH_CODE_FACE):
+ Assume the arg has valid form, since it always does.
+ (TYPE_RANGED_INTEGERP): Avoid bug when checking against a wide
+ unsigned integer system type.
+ (CHECK_RANGED_INTEGER, CHECK_TYPE_RANGED_INTEGER): New macros.
+ (struct catchtag, specpdl_size, SPECPDL_INDEX, USE_SAFE_ALLOCA):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (struct catchtag): Use EMACS_INT, not int, since it may be a fixnum.
+ (duration_to_sec_usec): New decl.
+ * lread.c (read_from_string_index, read_from_string_index_byte)
+ (read_from_string_limit, readchar, unreadchar, openp)
+ (read_internal_start, read1, oblookup):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fload, readevalloop, Feval_buffer, Feval_region):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (openp): Check for out-of-range argument to 'access'.
+ (read1): Use int, not EMACS_INT, where int is wide enough.
+ Don't assume fixnum fits into int.
+ Fix off-by-one error that can read outside a buffer.
+ (read_filtered_event): Use duration_to_sec_usec
+ to do proper overflow checking on durations.
+ * macros.c (Fstart_kbd_macro): Use xpalloc to check for overflow
+ in size calculation.
+ (Fexecute_kbd_macro):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * marker.c (cached_charpos, cached_bytepos, CONSIDER)
+ (byte_char_debug_check, buf_charpos_to_bytepos, verify_bytepos)
+ (buf_bytepos_to_charpos, Fset_marker, set_marker_restricted)
+ (set_marker_both, set_marker_restricted_both, marker_position)
+ (marker_byte_position, Fbuffer_has_markers_at):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fset_marker, set_marker_restricted): Don't assume fixnum fits in int.
+ * menu.c (ensure_menu_items): Rename from grow_menu_items.
+ It now merely ensures that the menu is large enough, without
+ necessarily growing it, as this avoids some integer overflow issues.
+ All callers changed.
+ (keymap_panes, parse_single_submenu, Fx_popup_menu):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (parse_single_submenu, Fx_popup_menu): Don't assume fixnum fits in int.
+ Use SAFE_ALLOCA_LISP, not alloca.
+ (find_and_return_menu_selection): Avoid unnecessary casts of pointers
+ to EMACS_INT. Check that fixnums are in proper range for system types.
+ * minibuf.c (minibuf_prompt_width, string_to_object)
+ (Fminibuffer_contents, Fminibuffer_contents_no_properties)
+ (Fminibuffer_completion_contents, Ftry_completion, Fall_completions):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (get_minibuffer, read_minibuf_unwind):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (read_minibuf): Omit unnecessary arg BACKUP_N, which is always nil;
+ this simplifies overflow checking. All callers changed.
+ (read_minibuf, Fread_buffer, Ftry_completion, Fall_completions)
+ (Ftest_completion):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * nsfns.m (check_ns_display_info): Don't assume fixnum fits in long.
+ (x_set_menu_bar_lines, x_set_tool_bar_lines, Fx_create_frame):
+ Check that fixnums are in proper range for system types.
+ (Fx_create_frame, Fx_show_tip):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * nsfont.m (ns_findfonts, nsfont_list_family):
+ Don't assume fixnum fits in long.
+ * nsmenu.m (ns_update_menubar, ns_menu_show, ns_popup_dialog):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (ns_update_menubar): Use intptr_t, not EMACS_INT, when intptr_t is
+ wide enough.
+ * nsselect.m (ns_get_local_selection, clean_local_selection_data):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * print.c (print_buffer_size, print_buffer_pos, print_buffer_pos_byte)
+ (PRINTDECLARE, PRINTPREPARE):
+ (strout, print_string):
+ (print, print_preprocess, print_check_string_charset_prop)
+ (print_object):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (PRINTDECLARE):
+ (temp_output_buffer_setup, Fprin1_to_string, print_object):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (PRINTPREPARE): Use int, not ptrdiff_t, where int is wide enough.
+ (printchar, strout): Use xpalloc to catch size calculation overflow.
+ (Fexternal_debugging_output): Don't overflow EMACS_INT->int conversion.
+ (print_error_message): Use SAFE_ALLOCA, not alloca.
+ (print_object): Use int, not EMACS_INT, where int is wide enough.
+ (print_depth, new_backquote_output, print_number_index):
+ Use ptrdiff_t, not int, where int might not be wide enough.
+ * process.c (Fdelete_process): Don't assume pid fits into EMACS_INT.
+ (Fset_process_window_size, Fformat_network_address)
+ (get_lisp_to_sockaddr_size, set_socket_option, Fmake_network_process)
+ (sigchld_handler):
+ Check that fixnums are in proper range for system types.
+ (Fsignal_process): Simplify by avoiding a goto.
+ Check for process-ids out of pid_t range rather than relying on
+ undefined behavior.
+ (process_tick, update_tick): Use EMACS_INT, not int.
+ (Fformat_network_address, read_process_output, send_process)
+ (Fprocess_send_region, status_notify):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fformat_network_address, Fmake_serial_process, Fmake_network_process)
+ (wait_reading_process_output, read_process_output, exec_sentinel):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (conv_lisp_to_sockaddr): Don't assume fixnums fit into int.
+ (Faccept_process_output): Use duration_to_sec_usec to do proper
+ overflow checking on durations.
+ (emacs_get_tty_pgrp, Fprocess_running_child_p, process_send_signal):
+ Don't assume pid_t fits in int.
+ * process.h (struct Lisp_Process): Members tick and update_tick
+ are now of type EMACS_INT, not int.
+ * puresize.h (PURESIZE_RATIO): Shrink this to 8/6 on 32-bit hosts
+ configured --with-wide-int.
+ * scroll.c (calculate_scrolling, calculate_direct_scrolling)
+ (line_ins_del): Use int, not EMACS_INT, where int is wide enough.
+ * search.c (looking_at_1, string_match_1):
+ (fast_string_match, fast_c_string_match_ignore_case)
+ (fast_string_match_ignore_case, fast_looking_at, scan_buffer)
+ (scan_newline, find_before_next_newline, search_command)
+ (trivial_regexp_p, search_buffer, simple_search, boyer_moore)
+ (set_search_regs, wordify):
+ (Freplace_match):
+ (Fmatch_data):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (string_match_1, search_buffer, set_search_regs):
+ (Fmatch_data):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (wordify): Check for overflow in size calculation.
+ (Freplace_match): Avoid potential buffer overflow in search_regs.start.
+ (Fset_match_data): Don't assume fixnum fits in ptrdiff_t.
+ Check that fixnums are in proper range for system types.
+ * sound.c (struct sound_device)
+ (wav_play, au_play, vox_write, alsa_period_size, alsa_write):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fplay_sound_internal):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * syntax.c (struct lisp_parse_state, find_start_modiff)
+ (Finternal_describe_syntax_value, scan_lists, scan_sexps_forward):
+ (Fparse_partial_sexp):
+ Don't assume fixnums can fit in int.
+ (struct lisp_parse_state, find_start_pos, find_start_value)
+ (find_start_value_byte, find_start_begv)
+ (update_syntax_table, char_quoted, dec_bytepos)
+ (find_defun_start, prev_char_comend_first, back_comment):
+ (scan_words, skip_chars, skip_syntaxes, forw_comment, Fforward_comment)
+ (scan_lists, Fbackward_prefix_chars, scan_sexps_forward):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Finternal_describe_syntax_value): Check that match_lisp is a
+ character, not an integer, since the code stuffs it into int.
+ (scan_words, scan_sexps_forward):
+ Check that fixnums are in proper range for system types.
+ (Fforward_word):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (scan_sexps_forward):
+ Use CHARACTERP, not INTEGERP, since the value must fit into int.
+ (Fparse_partial_sexp): Fix doc; element 8 is not ignored.
+ * syntax.h: Adjust decls to match defn changes elsewhere.
+ (struct gl_state_s):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (SETUP_SYNTAX_TABLE_FOR_OBJECT): Use PTRDIFF_MAX, not
+ MOST_POSITIVE_FIXNUM.
+ * sysdep.c (wait_for_termination_1, wait_for_termination)
+ (interruptible_wait_for_termination, mkdir):
+ Don't assume pid_t fits in int; on 64-bit AIX pid_t is 64-bit.
+ (emacs_read, emacs_write):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (system_process_attributes): Don't assume uid_t, gid_t, EMACS_INT,
+ and double all fit in int.
+ * term.c (set_tty_color_mode):
+ Check that fixnums are in proper range for system types.
+ * termhooks.h (struct input_event):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * textprop.c (validate_interval_range, interval_of)
+ (Fadd_text_properties, set_text_properties_1)
+ (Fremove_text_properties, Fremove_list_of_text_properties)
+ (Ftext_property_any, Ftext_property_not_all)
+ (copy_text_properties, text_property_list, extend_property_ranges)
+ (verify_interval_modification):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fnext_single_char_property_change)
+ (Fprevious_single_char_property_change):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (copy_text_properties):
+ Check for integer overflow in index calculation.
+ * undo.c (last_boundary_position, record_point, record_insert)
+ (record_delete, record_marker_adjustment, record_change)
+ (record_property_change):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (truncate_undo_list, Fprimitive_undo): Don't assume fixnum fits in int.
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * w32fns.c (Fx_create_frame, x_create_tip_frame, Fx_show_tip)
+ (Fx_hide_tip, Fx_file_dialog):
+ * w32menu.c (set_frame_menubar):
+ Use ptrdiff_t, not int, for consistency with rest of code.
+ * window.c (window_scroll_preserve_hpos, window_scroll_preserve_vpos)
+ (select_window, Fdelete_other_windows_internal)
+ (window_scroll_pixel_based, window_scroll_line_based)
+ (Frecenter, Fset_window_configuration):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fset_window_hscroll, run_window_configuration_change_hook)
+ (set_window_buffer, temp_output_buffer_show, scroll_command)
+ (Fscroll_other_window, Frecenter):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fwindow_line_height, window_scroll, Fscroll_left, Fscroll_right):
+ Don't assume fixnum fits in int.
+ (Fset_window_scroll_bars):
+ Check that fixnums are in proper range for system types.
+ * xdisp.c (help_echo_pos, pos_visible_p, string_pos_nchars_ahead)
+ (string_pos, c_string_pos, number_of_chars, init_iterator)
+ (in_ellipses_for_invisible_text_p, init_from_display_pos)
+ (compute_stop_pos, next_overlay_change, compute_display_string_pos)
+ (compute_display_string_end, handle_face_prop)
+ (face_before_or_after_it_pos, handle_invisible_prop)
+ (handle_display_prop, handle_display_spec, handle_single_display_spec)
+ (display_prop_intangible_p, string_buffer_position_lim)
+ (string_buffer_position, handle_composition_prop, load_overlay_strings)
+ (get_overlay_strings_1, get_overlay_strings)
+ (iterate_out_of_display_property, forward_to_next_line_start)
+ (back_to_previous_visible_line_start, reseat, reseat_to_string)
+ (get_next_display_element, set_iterator_to_next)
+ (get_visually_first_element, compute_stop_pos_backwards)
+ (handle_stop_backwards, next_element_from_buffer)
+ (move_it_in_display_line_to, move_it_in_display_line)
+ (move_it_to, move_it_vertically_backward, move_it_by_lines)
+ (add_to_log, message_dolog, message_log_check_duplicate)
+ (message2, message2_nolog, message3, message3_nolog
+ (with_echo_area_buffer, display_echo_area_1, resize_mini_window_1)
+ (current_message_1, truncate_echo_area, truncate_message_1)
+ (set_message, set_message_1, store_mode_line_noprop)
+ (hscroll_window_tree, debug_delta, debug_delta_bytes, debug_end_vpos)
+ (text_outside_line_unchanged_p, check_point_in_composition)
+ (reconsider_clip_changes)
+ (redisplay_internal, set_cursor_from_row, try_scrolling)
+ (try_cursor_movement, set_vertical_scroll_bar, redisplay_window)
+ (redisplay_window, find_last_unchanged_at_beg_row)
+ (find_first_unchanged_at_end_row, row_containing_pos, try_window_id)
+ (trailing_whitespace_p, find_row_edges, display_line)
+ (RECORD_MAX_MIN_POS, Fcurrent_bidi_paragraph_direction)
+ (display_mode_element, store_mode_line_string)
+ (pint2str, pint2hrstr, decode_mode_spec)
+ (display_count_lines, display_string, draw_glyphs)
+ (x_produce_glyphs, x_insert_glyphs)
+ (rows_from_pos_range, mouse_face_from_buffer_pos)
+ (fast_find_string_pos, mouse_face_from_string_pos)
+ (note_mode_line_or_margin_highlight, note_mouse_highlight):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (safe_call, init_from_display_pos, handle_fontified_prop)
+ (handle_single_display_spec, load_overlay_strings)
+ (with_echo_area_buffer, setup_echo_area_for_printing)
+ (display_echo_area, echo_area_display)
+ (x_consider_frame_title, prepare_menu_bars, update_menu_bar)
+ (update_tool_bar, hscroll_window_tree, redisplay_internal)
+ (redisplay_window, dump_glyph_row, display_mode_line)
+ (Fformat_mode_line, decode_mode_spec, on_hot_spot_p):
+ (handle_display_spec, display_prop_string_p):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (handle_single_display_spec, build_desired_tool_bar_string)
+ (redisplay_tool_bar, scroll_window_tree, Fdump_glyph_matrix)
+ (get_specified_cursor_type):
+ Check that fixnums are in proper range for system types.
+ (struct overlay_entry, resize_mini_window, Fdump_glyph_row)
+ (Flookup_image_map):
+ Don't assume fixnums fit in int.
+ (compare_overlay_entries):
+ Avoid mishandling comparisons due to subtraction overflow.
+ (load_overlay_strings): Use SAFE_NALLOCA, not alloca.
+ (last_escape_glyph_face_id, last_glyphless_glyph_face_id):
+ (handle_tool_bar_click):
+ Use int, not unsigned, since we prefer signed and the signedness
+ doesn't matter here.
+ (get_next_display_element, next_element_from_display_vector):
+ Use int, not EMACS_INT, when int is wide enough.
+ (start_hourglass): Use duration_to_sec_usec to do proper
+ overflow checking on durations.
+ * xfaces.c (Fbitmap_spec_p):
+ Check that fixnums are in proper range for system types.
+ (compare_fonts_by_sort_order):
+ Avoid mishandling comparisons due to subtraction overflow.
+ (Fx_family_fonts, realize_basic_faces):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fx_family_fonts):
+ Don't assume fixnum fits in int.
+ Use SAFE_ALLOCA_LISP, not alloca.
+ (merge_face_heights): Remove unnecessary cast to EMACS_INT.
+ (Finternal_make_lisp_face): Don't allocate more than MAX_FACE_ID.
+ (face_at_buffer_position, face_for_overlay_string)
+ (face_at_string_position):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (merge_faces): Use int, not EMACS_INT, where int is wide enough.
+ * xfns.c (x_set_menu_bar_lines, x_set_tool_bar_lines, x_icon_verify)
+ (Fx_show_tip):
+ Check that fixnums are in proper range for system types.
+ (Fx_create_frame, x_create_tip_frame, Fx_show_tip)
+ (Fx_hide_tip, Fx_file_dialog, Fx_select_font):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fx_change_window_property): Don't assume fixnums fit in int.
+ * xfont.c (xfont_chars_supported):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * xmenu.c (Fx_popup_dialog, set_frame_menubar)
+ (create_and_show_popup_menu, create_and_show_dialog, xmenu_show):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * xml.c (parse_region):
+ * xrdb.c (magic_file_p):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * xselect.c (TRACE1): Don't assume pid_t promotes to int.
+ (x_get_local_selection, x_reply_selection_request)
+ (x_handle_selection_request, wait_for_property_change):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (selection_data_to_lisp_data): Use short, not EMACS_INT, where
+ short is wide enough.
+ (x_send_client_event): Don't assume fixnum fits in int.
+ * xterm.c (x_x_to_emacs_modifiers):
+ Don't assume EMACS_INT overflows nicely into int.
+ (x_emacs_to_x_modifiers): Use EMACS_INT, not int, because values
+ may come from Lisp.
+ (handle_one_xevent): NATNUMP can eval its arg twice.
+ (x_connection_closed):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * xterm.h: Adjust decls to match defn changes elsewhere.
+ (struct scroll_bar): Use struct vectorlike_header
+ rather than rolling our own approximation.
+ (SCROLL_BAR_VEC_SIZE): Remove; not used.
+
+2012-05-25 Glenn Morris <rgm@gnu.org>
+
+ * lisp.mk (lisp): Update for more files being compiled now.
+
+2012-05-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lread.c: Remove `read_pure' which makes no difference.
+ (read_pure): Remove var.
+ (unreadpure): Remove function.
+ (readevalloop): Don't call read_list with -1 flag.
+ (read1, read_vector): Don't test read_pure any more.
+ (read_list): Simplify.
+
+ * fileio.c, character.h: Minor style tweaks.
+
+2012-05-24 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.h (clip_changed): Remove useless declaration.
+
+2012-05-22 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in: Follow-up to 2012-05-22T16:20:27Z!eggert@cs.ucla.edu.
+ (TAGS, TAGS-gmake, CONFIG_H): Remove further references to m/intel386.h.
+
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove src/m/*.
+ This directory predates autoconf and is no longer needed nowadays.
+ Move its few remaining bits of functionality to where they're needed.
+ * m/README, m/alpha.h, m/amdx86-64.h, m/ia64.h, m/ibmrs6000.h:
+ * m/ibms390x.h, m/intel386.h, m/m68k.h, m/macppc.h, m/sparc.h:
+ * m/template.h: Remove.
+ * Makefile.in (M_FILE): Remove. All uses removed.
+ * alloc.c (POINTERS_MIGHT_HIDE_IN_OBJECTS):
+ * lisp.h (USE_LSB_TAG):
+ * mem-limits.h (EXCEEDS_LISP_PTR):
+ Use VAL_MAX, not VALBITS, in #if.
+ * lisp.h (EMACS_INT_MAX): New macro, useful in #if.
+ (EMACS_UINT): Define unconditionally now.
+ (BITS_PER_CHAR, BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG)
+ (BITS_PER_EMACS_INT): New constants, replacing
+ what used to be in config.h, but not useful in #if.
+ (GCTYPEBITS, VALBITS): Define unconditionally, since m/* files don't
+ define them any more.
+ (VAL_MAX): New macro.
+ (VALMASK): Use it.
+ * puresize.h (PURESIZE_RATIO): Use EMACS_INT_MAX, not
+ BITS_PER_EMACS_INT, in #if.
+ * s/aix4-2.h (BROKEN_FIONREAD, BROKEN_SIGAIO, BROKEN_SIGPTY)
+ (BROKEN_SIGPOLL): Move here from m/ibmrs6000.h, which was removed.
+ * s/gnu-linux.h (ULIMIT_BREAK_VALUE) [__i386__]:
+ * s/ms-w32.h (DATA_START):
+ Move here from removed file m/intel386.h.
+ * s/gnu.h (NLIST_STRUCT): Remove undef; 'configure' does this.
+ * s/irix6-5.h (_LP64): Remove; lisp.h no longer needs this.
+
+2012-05-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume C89 or later.
+ * alloc.c, buffer.c, lisp.h: Replace POINTER_TYPE with void.
+ * alloc.c (overrun_check_malloc, overrun_check_realloc, xmalloc)
+ (xrealloc):
+ * buffer.c (mmap_free_1, mmap_enlarge): Omit needless casts.
+ * editfns.c, fns.c, gmalloc.c, insdel.c, sysdep.c, termcap.c (NULL):
+ * textprop.c, tparam.c (NULL): Remove.
+ * ralloc.c, vm-limit.c (POINTER): Assume void * works.
+ * regex.c (SIGN_EXTEND_CHAR): Assume signed char works.
+ * regex.h (_RE_ARGS): Remove. All uses rewritten to use prototypes.
+ * unexelf.c (ElfBitsW): Assume c89 preprocessor or better.
+ * xterm.c (input_signal_count): Assume volatile works.
+
+2012-05-21 Ken Brown <kbrown@cornell.edu>
+
+ * xgselect.c (xg_select): Fix first argument in call to 'select'
+ (bug#11508).
+
+2012-05-20 Ken Brown <kbrown@cornell.edu>
+
+ * gmalloc.c (_free_internal_nolock, _realloc_internal_nolock)
+ [CYGWIN]: Cast ptr to (char *) before comparing to _heapbase.
+
+2012-05-19 Ken Brown <kbrown@cornell.edu>
+
+ * xfns.c (x_in_use): Remove `static' qualifier.
+ * xterm.h (x_in_use): Declare.
+ * xgselect.c: Include xterm.h.
+ (xg_select): Test `x_in_use' instead of `inhibit_window_system'
+ and `display_arg' (bug#9754).
+
+2012-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * s/ms-w32.h (HAVE_GETDOMAINNAME): Remove; not needed.
+
+ * m/vax.h: Remove; no longer needed since HAVE_FTIME is being removed.
+ * s/ms-w32.h (HAVE_FTIME): Remove; not needed.
+
+2012-05-18 Eli Zaretskii <eliz@gnu.org>
+
+ Fix compilation with -DGLYPH_DEBUG=1 on MS-Windows.
+
+ * w32term.c [GLYPH_DEBUG]: Add prototype for x_check_font.
+ (x_check_font) [GLYPH_DEBUG]: New function, copied from xterm.c.
+
+ * w32fns.c (unwind_create_frame) [GLYPH_DEBUG]: Fix broken
+ reference to image_cache->refcount.
+ (x_create_tip_frame): Fix broken use of FRAME_IMAGE_CACHE.
+
+2012-05-17 Juri Linkov <juri@jurta.org>
+
+ * search.c (Fword_search_regexp, Fword_search_backward)
+ (Fword_search_forward, Fword_search_backward_lax)
+ (Fword_search_forward_lax): Move functions to isearch.el
+ (bug#10145, bug#11381).
+
+2012-05-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xgselect.c (xg_select): Just invoke 'select' if -nw (Bug#9754).
+
+2012-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lread.c (init_obarray): Declare Qt and Qnil as special.
+
+2012-05-14 Glenn Morris <rgm@gnu.org>
+
+ * nsterm.m (ns_init_paths): Fix typo ("libexec" not "lib-exec").
+ Put "libexec" before "bin", for the sake of init_callproc_1.
+
+2012-05-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * keyboard.c (kbd_buffer_get_event) [!HAVE_DBUS]: Omit unused local.
+
+ * unexaix.c: Port to more-recent AIX compilers.
+ (report_error, report_error_1, make_hdr, copy_sym)
+ (mark_x, adjust_lnnoptrs, unrelocate_symbols):
+ Make arguments const char *, not char *, to avoid violations of C
+ standard and to fix some AIX warnings reported by Gilles Pion.
+
+2012-05-14 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (handle_stop): Don't call get_overlay_strings_1 if we
+ already have overlays loaded.
+ (handle_single_display_spec): Before returning without displaying
+ fringe bitmap, synchronize the bidi iterator with the main display
+ iterator, by calling iterate_out_of_display_property.
+ (iterate_out_of_display_property): Detect buffer iteration by
+ testing that it->string is a Lisp string.
+ (get_next_display_element): When the current object is exhausted,
+ and there's something on it->stack, call set_iterator_to_next to
+ proceed with what's on the stack, instead of returning zero.
+ (set_iterator_to_next): If called at the end of a Lisp string,
+ proceed to consider_string_end without incrementing string
+ position. Don't increment display vector index past the end of
+ the display vector. (Bug#11417)
+ (pos_visible_p): Don't report a position visible when move_it_to
+ stopped at the last line of window, which happens to be scanned
+ backwards by the bidi iteration. (Bug#11464)
+
+2012-05-14 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (handle_single_display_spec): Return 1 for left-margin
+ and right-margin display specs even if the spec is invalid or we
+ are on a TTY, and thus unable to display on the fringes.
+ That's because the text with the property will not be displayed anyway,
+ so we need to signal to the caller that this is a "replacing"
+ display spec. This fixes display when the spec is invalid or we
+ are on a TTY.
+
+2012-05-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * unexaix.c (make_hdr): Fix typo in prototype.
+ This bug broke the build on AIX. Problem reported by Gilles Pion.
+
+2012-05-14 Michael Albinus <michael.albinus@gmx.de>
+
+ * keyboard.c (kbd_buffer_get_event): Read special events also in
+ batch mode. (Bug#11415)
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * ns.mk: Update for ns_appbindir no longer having trailing "/".
+
+2012-05-12 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp.mk (lisp): Add newcomment.elc.
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MKDIR_P): New, set by configure.
+ * ns.mk (${ns_appdir}, ${ns_appbindir}Emacs): Use $MKDIR_P.
+
+2012-05-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove unused function hourglass_started.
+ * dispextern.h (hourglass_started):
+ * w32fns.c (hourglass_started):
+ * xdisp.c (hourglass_started): Remove.
+
+2012-05-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/gmalloc.$(O), $(BLD)/w32menu.$(O)):
+ Update dependencies.
+
+2012-05-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xgselect.c (xg_select): Put maxfds+1 into a var.
+ This is slightly clearer, and pacifies Ubuntu 12.04 gcc.
+
+ * sound.c (DEFAULT_ALSA_SOUND_DEVICE): Define only if HAVE_ALSA.
+
+2012-05-10 Dave Abrahams <dave@boostpro.com>
+
+ * filelock.c (syms_of_filelock): New boolean create-lockfiles.
+ (lock_file): If create_lockfiles is 0, do nothing. (Bug#11227)
+
+2012-05-09 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (xd_registered_buses): New internal Lisp object.
+ Rename all occurences of Vdbus_registered_buses to xd_registered_buses.
+ (syms_of_dbusbind): Remove declaration of Vdbus_registered_buses.
+ Initialize xd_registered_buses.
+
+2012-05-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Untag more efficiently if USE_LSB_TAG.
+ This is based on a proposal by YAMAMOTO Mitsuharu in
+ <http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01876.html>.
+ For an admittedly artificial (nth 8000 longlist) benchmark on
+ Fedora 15 x86-64, this yields a 25% CPU speedup. Also, it shrinks
+ Emacs's overall text size by 1%.
+ * lisp.h (XUNTAG): New macro.
+ (XCONS, XVECTOR, XSTRING, XSYMBOL, XFLOAT, XMISC, XPROCESS, XWINDOW)
+ (XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE, XSUB_CHAR_TABLE, XBOOL_VECTOR)
+ (XSETTYPED_PSEUDOVECTOR, XHASH_TABLE, TYPED_PSEUDOVECTORP): Use it.
+ * eval.c (Fautoload):
+ * font.h (XFONT_SPEC, XFONT_ENTITY, XFONT_OBJECT):
+ * frame.h (XFRAME): Use XUNTAG.
+
+ Port recent dbusbind.c changes to 32-bit --with-wide-int.
+ * dbusbind.c (xd_append_arg, xd_retrieve_arg, Fdbus_message_internal):
+ Remove unportable assumptions about print widths of types like
+ dbus_uint32_t.
+ (xd_get_connection_address, Fdbus_init_bus): Cast Emacs integer to
+ intptr_t when converting between pointer and integer, to avoid GCC
+ warnings about wrong width.
+
+2012-05-09 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (new_child): Force Windows to reserve only 64KB of
+ stack for each reader_thread, instead of defaulting to 8MB
+ determined by the linker. This avoids failures in creating
+ subprocesses on Windows 7, see the discussion in this thread:
+ http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00119.html.
+
+2012-05-07 Jérémy Compostella <jeremy.compostella@gmail.com>
+
+ Fix up display of the *Minibuf-0* buffer in the mini window.
+ * keyboard.c (read_char): Don't clear the echo area if there's no
+ message to clear.
+ * xdisp.c (redisplay_internal): Redisplay the mini window (with the
+ contents of *Minibuf-0*) if there's no message displayed in its stead.
+
+2012-05-07 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (XD_DEBUG_MESSAGE): Don't print message twice in
+ batch mode.
+
+2012-05-06 Chong Yidong <cyd@gnu.org>
+
+ * lisp.mk (lisp): Update.
+
+2012-05-05 Jim Meyering <meyering@redhat.com>
+
+ * w32font.c (fill_in_logfont): NUL-terminate a string (Bug#11372).
+
+2012-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * data.c (PUT_ERROR): New macro.
+ (syms_of_data): Use it. Add new error type `user-error'.
+ * undo.c (user_error): New function.
+ (Fprimitive_undo): Use it.
+ * print.c (print_error_message): Adjust print style for `user-error'.
+ * keyboard.c (user_error): New function.
+ (Fexit_recursive_edit, Fabort_recursive_edit): Use it.
+
+2012-05-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not limit current-time-string to years 1000..9999.
+ * editfns.c (TM_YEAR_IN_ASCTIME_RANGE): Remove.
+ (Fcurrent_time_string): Support any year that is supported by the
+ underlying localtime representation. Don't use asctime, as it
+ has undefined behavior for years outside the range -999..9999.
+
+2012-05-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix race conditions involving setenv, gmtime, localtime, asctime.
+ Without this fix, interrupts could mess up code that uses these
+ nonreentrant functions, since setting TZ invalidates existing
+ tm_zone or tzname values, and since most of these functions return
+ pointers to static storage.
+ * editfns.c (format_time_string, Fdecode_time, Fencode_time)
+ (Fcurrent_time_string, Fcurrent_time_zone, Fset_time_zone_rule):
+ Grow the critical sections to include not just invoking
+ localtime/gmtime, but also accessing these functions' results
+ including their tm_zone values if any, and any related TZ setting.
+ (format_time_string): Last arg is now struct tm *, not struct tm **,
+ so that the struct tm is saved in the critical section.
+ All callers changed. Simplify allocation of initial buffer, partly
+ motivated by the fact that memory allocation needs to be outside
+ the critical section.
+
+2012-05-02 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * intervals.c (adjust_intervals_for_insertion): Initialize `newi'
+ with RESET_INTERVAL.
+
+ * buffer.c (Fget_buffer_create, Fmake_indirect_buffer):
+ Remove duplicated buffer name initialization.
+
+2012-05-02 Jim Meyering <jim@meyering.net>
+
+ * xterm.c (x_term_init): Use memcpy instead of strncpy (Bug#11373).
+
+ * xfns.c (x_window): Use xstrdup (Bug#11375).
+
+2012-05-02 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (pos_visible_p): If already at a newline from the
+ display string before the 'while' loop, don't walk back the glyphs
+ from it3.glyph_row. Solves assertion violation when the display
+ string begins with a newline (egg.el). (Bug#11367)
+
+2012-05-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * keyboard.c (Fexecute_extended_command, Vsuggest_key_bindings):
+ Move to simple.el.
+
+2012-05-01 Glenn Morris <rgm@gnu.org>
+
+ * syssignal.h: Remove reference to BROKEN_SIGINFO (last used in
+ s/ptx4.h), BROKEN_SIGTSTP (last used in m/ustation.h, m/dpx2.h),
+ and BROKEN_SIGURG (was in s/gnu-linux.h prior to 2008-02-10).
+ All were removed before 23.1.
+
+ * dispnew.c: Remove HAVE_LIBNCURSES test;
+ it is always true on relevant platforms.
+
+ * Makefile.in (LD_SWITCH_X_SITE_RPATH):
+ Rename from LD_SWITCH_X_SITE_AUX_RPATH.
+
+ * Makefile.in (LD_SWITCH_X_SITE_AUX): Remove; no longer used.
+
+2012-04-30 Andreas Schwab <schwab@linux-m68k.org>
+
+ * .gdbinit (xpr): Remove checks for no longer existing misc types.
+ (xintfwd, xboolfwd, xobjfwd, xbufobjfwd, xkbobjfwd, xbuflocal):
+ Remove.
+
+2012-04-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not avoid creating empty evaporating overlays (Bug#9642).
+ * buffer.c (Fmove_overlay): Revert the change of 2012-04-23.
+ That is, do not delete an evaporating overlay if it becomes
+ empty after its bounds are adjusted to fit within its buffer.
+ This fix caused other problems, and I'm reverting it until we get
+ to the bottom of them.
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * xselect.c (x_convert_selection): Initialize a pointer (Bug#11315).
+
+2012-04-27 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (pos_visible_p): If the window start position is beyond
+ ZV, start the display from buffer beginning. Prevents assertion
+ violation in init_iterator when the minibuffer window is scrolled
+ via the scroll bar.
+
+ * window.c (window_scroll_pixel_based): Likewise.
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * keymap.c (where_is_internal): Doc fix (Bug#10872).
+
+2012-04-27 Glenn Morris <rgm@gnu.org>
+
+ * fileio.c (Fcopy_file, Fset_file_selinux_context):
+ Ignore ENOTSUP failures from setfilecon functions. (Bug#11245)
+
+2012-04-27 Eli Zaretskii <eliz@gnu.org>
+
+ * dispnew.c (swap_glyph_pointers, copy_row_except_pointers):
+ Don't overrun array limits of glyph row's used[] array. (Bug#11288)
+
+2012-04-26 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (IT_DISPLAYING_WHITESPACE): In addition to the loaded
+ display element, check also the underlying string or buffer
+ character. (Bug#11341)
+
+ * w32menu.c: Include w32heap.h.
+ (add_menu_item): If the call to AppendMenuW (via
+ unicode_append_menu) fails, disable Unicode menus only if we are
+ running on Windows 9X/Me.
+
+2012-04-24 Andreas Schwab <schwab@linux-m68k.org>
+
+ * .gdbinit (xpr): Handle USE_2_TAGS_FOR_INTS.
+ (xgetint): Add missing shift for LSB tags.
+
+2012-04-24 Martin Rudalics <rudalics@gmx.at>
+
+ * keyboard.c (read_char): Don't wipe echo area for select window
+ events: These might get delayed via `mouse-autoselect-window'
+ (Bug#11304).
+
+2012-04-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * gnutls.c (init_gnutls_functions): Protect against (unlikely)
+ manipulation of :loaded-from data.
+
+2012-04-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * gnutls.c (init_gnutls_functions): The value of :loaded-from is
+ now a cons (bug#11311).
+
+2012-04-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not create empty overlays with the evaporate property (Bug#9642).
+ * buffer.c (Fmove_overlay): Delete an evaporating overlay
+ if it becomes empty after its bounds are adjusted to fit within
+ its buffer. Without this fix, in a nonempty buffer (let ((o
+ (make-overlay 1 2))) (overlay-put o 'evaporate t) (move-overlay o 0 1))
+ yields an empty overlay that has the evaporate property, which is
+ not supposed to happen.
+
+ Fix minor GTK3 problems found by static checking.
+ * emacsgtkfixed.c (EMACS_TYPE_FIXED, EMACS_FIXED, EmacsFixed)
+ (EmacsFixedPrivate, EmacsFixedClass, struct _EmacsFixed)
+ (struct _EmacsFixedClass, emacs_fixed_get_type):
+ Move decls here from emacsgtkfixed.h, since they needn't be public.
+ (emacs_fixed_get_type): Now static.
+ (emacs_fixed_class_init): Omit unused local.
+ (emacs_fixed_child_type): Remove; unused.
+ * emacsgtkfixed.h (EMACS_TYPE_FIXED, EMACS_FIXED, EmacsFixed)
+ (EmacsFixedPrivate, EmacsFixedClass, struct _EmacsFixed)
+ (struct _EmacsFixedClass): Move to emacsgtkfixed.c.
+ (EMACS_FIXED_CLASS, EMACS_IS_FIXED, EMACS_IS_FIXED_CLASS)
+ (EMACS_FIXED_GET_CLASS): Remove; unused.
+ * gtkutil.c (xg_create_frame_widgets) [!HAVE_GTK3]: Omit unused local.
+
+ * keyboard.c (handle_async_input): Define only if SYNC_INPUT || SIGIO.
+ Problem reported by Juanma Barranquero for Windows -Wunused-function.
+
+2012-04-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Modernize and clean up gmalloc.c to assume C89 (Bug#9119).
+ * gmalloc.c (_MALLOC_INTERNAL, _MALLOC_H, _PP, __ptr_t)
+ (__malloc_size_t, __malloc_ptrdiff_t):
+ Remove. All uses removed, replaced by the definiens if needed,
+ since we can assume C89 or better now.
+ Include <stdint.h>, for PTRDIFF_MAX, uintptr_t.
+ (protect_malloc_state, align, get_contiguous_space)
+ (malloc_atfork_handler_prepare, malloc_atfork_handler_parent)
+ (malloc_atfork_handler_child, malloc_enable_thread)
+ (malloc_initialize_1, __malloc_initialize, morecore_nolock)
+ (_malloc_internal_nolock, _malloc_internal, malloc, _malloc)
+ (_free, _realloc, _free_internal_nolock, _free_internal, free, cfree)
+ (special_realloc, _realloc_internal_nolock, _realloc_internal)
+ (realloc, calloc, __default_morecore, memalign, valloc, checkhdr)
+ (freehook, mallochook, reallochook, mabort, mcheck, mprobe):
+ Define using prototypes, not old style.
+ (align, _malloc_internal_nolock, _free_internal_nolock, memalign):
+ Don't assume ptrdiff_t and uintptr_t are no wider than unsigned long.
+ (align): Don't assume that signed integer overflow wraps around.
+ Omit unused local var.
+ (malloc_initialize_1, morecore_nolock, _malloc_internal_nolock)
+ (_free_internal_nolock, memalign, mallochook, reallochook):
+ Omit no-longer-needed casts.
+ (valloc): Use getpagesize, not __getpagesize.
+ (MAGICWORD, MAGICFREE): Now randomish size_t values, not 32-bit.
+ (struct hdr): The 'magic' member is now size_t, not unsigned long.
+
+ * dbusbind.c (XD_DBUS_VALIDATE_OBJECT): Define only if needed.
+
+2012-04-22 Michael Albinus <michael.albinus@gmx.de>
+
+ Move functions from C to Lisp. Make non-blocking method calls
+ the default. Implement further D-Bus standard interfaces.
+
+ * dbusbind.c (DBUS_NUM_MESSAGE_TYPES): Declare.
+ (QCdbus_request_name_allow_replacement)
+ (QCdbus_request_name_replace_existing)
+ (QCdbus_request_name_do_not_queue)
+ (QCdbus_request_name_reply_primary_owner)
+ (QCdbus_request_name_reply_in_queue)
+ (QCdbus_request_name_reply_exists)
+ (QCdbus_request_name_reply_already_owner): Move to dbus.el.
+ (QCdbus_registered_serial, QCdbus_registered_method)
+ (QCdbus_registered_signal): New Lisp objects.
+ (XD_DEBUG_MESSAGE): Use sizeof.
+ (XD_MESSAGE_TYPE_TO_STRING, XD_OBJECT_TO_STRING)
+ (XD_DBUS_VALIDATE_BUS_ADDRESS, XD_DBUS_VALIDATE_OBJECT)
+ (XD_DBUS_VALIDATE_BUS_NAME, XD_DBUS_VALIDATE_PATH)
+ (XD_DBUS_VALIDATE_INTERFACE, XD_DBUS_VALIDATE_MEMBER): New macros.
+ (XD_CHECK_DBUS_SERIAL): Rename from CHECK_DBUS_SERIAL_GET_SERIAL.
+ (xd_signature, xd_append_arg): Allow float for integer types.
+ (xd_get_connection_references): New function.
+ (xd_get_connection_address): Rename from xd_initialize.
+ Return cached address.
+ (xd_remove_watch): Do not unset $DBUS_SESSION_BUS_ADDRESS.
+ (xd_close_bus): Rename from Fdbus_close_bus. Not needed on Lisp
+ level.
+ (Fdbus_init_bus): New optional arg PRIVATE. Cache address.
+ Return number of refcounts.
+ (Fdbus_get_unique_name): Make stronger parameter check.
+ (Fdbus_message_internal): New defun.
+ (Fdbus_call_method, Fdbus_call_method_asynchronously)
+ (Fdbus_method_return_internal, Fdbus_method_error_internal)
+ (Fdbus_send_signal, Fdbus_register_service)
+ (Fdbus_register_signal, Fdbus_register_method): Move to dbus.el.
+ (xd_read_message_1): Obey new structure of Vdbus_registered_objects.
+ (xd_read_queued_messages): Obey new structure of Vdbus_registered_buses.
+ (Vdbus_compiled_version, Vdbus_runtime_version)
+ (Vdbus_message_type_invalid, Vdbus_message_type_method_call)
+ (Vdbus_message_type_method_return, Vdbus_message_type_error)
+ (Vdbus_message_type_signal): New defvars.
+ (Vdbus_registered_buses, Vdbus_registered_objects_table):
+ Adapt docstring.
+
+2012-04-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix GC_MALLOC_CHECK debugging output on 64-bit hosts.
+ * alloc.c (emacs_blocked_malloc) [GC_MALLOC_CHECK]:
+ Do not assume ptrdiff_t is the same width as 'int'.
+
+ * alloc.c: Handle unusual debugging option combinations.
+ (GC_CHECK_MARKED_OBJECTS): Undef if ! GC_MARK_STACK,
+ since the two debugging options are incompatible.
+ (GC_MALLOC_CHECK): Similarly, undef if GC_CHECK_MARKED_OBJECTS
+ is defined.
+ (mem_init, mem_insert, mem_insert_fixup):
+ Define if GC_MARK_STACK || GC_MALLOC_CHECK.
+ (NEED_MEM_INSERT): Remove; no longer needed.
+
+2012-04-22 Leo Liu <sdl.web@gmail.com>
+
+ * sysdep.c (list_system_processes): Support Darwin (Bug#5725).
+
+2012-04-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sysdep.c [__FreeBSD__]: Minor cleanups.
+ (list_system_processes, system_process_attributes) [__FreeBSD__]:
+ Use Emacs indenting style more consistently. Avoid some casts.
+ Use 'double' consistently rather than mixing 'float' and 'double'.
+
+2012-04-21 Eduard Wiebe <usenet@pusto.de>
+
+ * sysdep.c (list_system_processes, system_process_attributes):
+ Add implementation for FreeBSD (Bug#5243).
+
+2012-04-21 Andreas Schwab <schwab@linux-m68k.org>
+
+ * lisp.mk (lisp): Update.
+
+2012-04-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ * keyboard.c (process_pending_signals): Define only if SYNC_INPUT.
+ It is never used otherwise.
+
+2012-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * print.c (print_preprocess): Only check print_depth if print-circle
+ is nil.
+ (print_object): Check for cycles even when print-circle is nil and
+ print-gensym is t, but only check print_depth if print-circle is nil.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * process.c (wait_reading_process_output): If EIO occurs on a pty,
+ set the status to "failed" and ensure that sentinel is run.
+
+2012-04-20 Glenn Morris <rgm@gnu.org>
+
+ * process.c (Fset_process_inherit_coding_system_flag)
+ (Fset_process_query_on_exit_flag): Doc fix (mention return value).
+ (Fmake_network_process, Fmake_serial_process): Doc fix.
+
+2012-04-20 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (string_buffer_position_lim): Limit starting position to
+ BEGV.
+ (set_cursor_from_row): If called for a mode-line or header-line
+ row, return zero immediately.
+ (try_cursor_movement): If inside continuation line, don't back up
+ farther than the first row after the header line, if any.
+ Don't consider the header-line row as "partially visible", even if
+ MATRIX_ROW_PARTIALLY_VISIBLE_P returns non-zero. (Bug#11261)
+
+2012-04-20 Atsuo Ohki <ohki@gssm.otsuka.tsukuba.ac.jp> (tiny change)
+
+ * lread.c (lisp_file_lexically_bound_p): Fix hang at ";-*-\n"
+ (bug#11238).
+
+2012-04-20 Teodor Zlatanov <tzz@lifelogs.com>
+2012-04-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ configure: new option --enable-gcc-warnings (Bug#11207)
+ * Makefile.in (C_WARNINGS_SWITCH): Remove.
+ (WARN_CFLAGS, WERROR_CFLAGS): New macros.
+ (ALL_CFLAGS): Use new macros rather than old.
+ * process.c: Ignore -Wstrict-overflow to work around GCC bug 52904.
+ * regex.c: Ignore -Wstrict-overflow. If !emacs, also ignore
+ -Wunused-but-set-variable, -Wunused-function, -Wunused-macros,
+ -Wunused-result, -Wunused-variable. This should go away once
+ the Emacs and Gnulib regex code is merged.
+ (xmalloc, xrealloc): Now static.
+
+2012-04-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * dired.c (Fsystem_groups): Remove unused local.
+
+2012-04-17 Glenn Morris <rgm@gnu.org>
+
+ * dired.c (Fsystem_users): Doc fix.
+
+2012-04-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * dired.c (Fsystem_users, Fsystem_groups): New functions. (Bug#7900)
+ (syms_of_dired): Add them.
+
+2012-04-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor alloc.c problems found by static checking.
+ * alloc.c (_malloc_internal, _free_internal) [!DOUG_LEA_MALLOC]:
+ New extern decls, to avoid calling undeclared functions.
+ (dont_register_blocks): Define if ((!SYSTEM_MALLOC && !SYNC_INPUT)
+ && GC_MALLOC_CHECK), not if ((GC_MARK_STACK || defined
+ GC_MALLOC_CHECK) && GC_MALLOC_CHECK), to match when it's used.
+ (NEED_MEM_INSERT): New macro.
+ (mem_insert, mem_insert_fixup) [!NEED_MEM_INSERT]: Remove; unused.
+ Remove one incorrect comment and fix another.
+
+ Fix minor ralloc.c problems found by static checking.
+ See http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00720.html
+ * ralloc.c (ALIGNED, ROUND_TO_PAGE, HEAP_PTR_SIZE)
+ (r_alloc_size_in_use, r_alloc_freeze, r_alloc_thaw): Remove; unused.
+ (r_alloc_sbrk): Now static.
+
+ Improve ralloc.c interface checking.
+ See http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00720.html
+ * buffer.c (ralloc_reset_variable, r_alloc, r_re_alloc)
+ (r_alloc_free) [REL_ALLOC]: Move decls from here ...
+ * lisp.h (r_alloc, r_alloc_free, r_re_alloc, r_alloc_reset_variable)
+ [REL_ALLOC]: ... to here, to check interface.
+ * m/ia64.h (r_alloc, r_alloc_free) [REL_ALLOC && !_MALLOC_INTERNAL]:
+ Remove decls. This fixes an "It stinks!".
+
+ * alloc.c (which_symbols): Fix alignment issue / type clash.
+
+2012-04-15 Andreas Schwab <schwab@linux-m68k.org>
+
+ * lisp.h (struct Lisp_Symbol): Remove explicit padding.
+ (struct Lisp_Misc_Any): Likewise.
+ (struct Lisp_Free): Likewise.
+ * alloc.c (union aligned_Lisp_Symbol): Define.
+ (SYMBOL_BLOCK_SIZE, struct symbol_block): Use union
+ aligned_Lisp_Symbol instead of struct Lisp_Symbol.
+ (union aligned_Lisp_Misc): Define.
+ (MARKER_BLOCK_SIZE, struct marker_block): Use union
+ aligned_Lisp_Misc instead of union Lisp_Misc.
+ (Fmake_symbol, allocate_misc, gc_sweep): Adjust.
+
+2012-04-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Make GC_MAKE_GCPROS_NOOPS the default (Bug#9926).
+ * lisp.h (GC_MARK_STACK): Default to GC_MAKE_GCPROS_NOOPS.
+ * s/cygwin.h, s/darwin.h, s/freebsd.h, s/gnu.h, s/irix6-5.h, s/msdos.h:
+ * s/netbsd.h, s/sol2-6.h:
+ Remove definition of GC_MARK_STACK, since the default now works.
+ * s/aix4-2.h, s/hpux10-20.h, s/unixware.h:
+ Define GC_MARK_STACK to GC_USE_GCPROS_AS_BEFORE, since that's
+ no longer the default.
+ * s/gnu-linux.h (GC_MARK_STACK): Adjust to change in default.
+
+2012-04-14 Atsuo Ohki <ohki@gssm.otsuka.tsukuba.ac.jp> (tiny change)
+
+ * lread.c (lisp_file_lexically_bound_p):
+ Fix hang at ";-*-\n" (bug#11238).
+
+2012-04-14 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (find_last_unchanged_at_beg_row): Don't consider a row
+ "unchanged" if its end.pos is beyond ZV. (Bug#11199)
+
+2012-04-14 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (constrainFrameRect): Always constrain when there is only
+ one screen (Bug#10962).
+
+2012-04-13 Ken Brown <kbrown@cornell.edu>
+
+ * s/cygwin.h (PTY_OPEN): Don't try to close a bogus file descriptor.
+
+2012-04-13 Reuben Thomas <rrt@sc3d.org>
+
+ * indent.c (Fmove_to_column): Change interactive spec (Bug#739).
+
+2012-04-11 Daniel Colascione <dancol@dancol.org>
+
+ * s/cygwin.h: The vfork the #define in cygwin.h was protecting
+ against is gone. It's better to use vfork now so that when Cygwin
+ gains a new, working vfork, we use it automatically (bug#10398).
+
+2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * window.c (save_window_save): Obey window-point-insertion-type.
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (GNUSTEP_CFLAGS): Rename from C_SWITCH_X_SYSTEM.
+
+2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * alloc.c (lisp_align_malloc): Remove unneeded prototype.
+
+2012-04-10 Jason S. Cornez <jcornez@ravenpack.com> (tiny change)
+
+ * keyboard.c: Override inhibit-quit after the third C-g (bug#6585).
+ (force_quit_count): New var.
+ (handle_interrupt): Use it.
+
+2012-04-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32.c (w32_delayed_load): Record the full path of the library
+ being loaded (bug#10424).
+
+2012-04-09 Glenn Morris <rgm@gnu.org>
+
+ * doc.c (Fsnarf_documentation): Check variables, functions are bound,
+ not just in the obarray, before snarfing them. (Bug#11036)
+
+ * Makefile.in ($(leimdir)/leim-list.el):
+ Pass EMACS rather than BUILT_EMACS.
+
+2012-04-09 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * process.c (make_process):
+ * process.h: Add integer `gnutls_handshakes_tried' member to
+ process struct.
+
+ * gnutls.h: Add `GNUTLS_EMACS_HANDSHAKES_LIMIT' upper limit.
+ Add convenience `GNUTLS_LOG2i' macro.
+
+ * gnutls.c (gnutls_log_function2i): Convenience log function.
+ (emacs_gnutls_read): Use new log functions,
+ `gnutls_handshakes_tried' process member, and
+ `GNUTLS_EMACS_HANDSHAKES_LIMIT' to limit the number of handshake
+ attempts per process (connection).
+
+2012-04-09 Chong Yidong <cyd@gnu.org>
+
+ * eval.c (Fuser_variable_p, user_variable_p_eh)
+ (lisp_indirect_variable): Functions deleted.
+ (Fdefvar): Caller changed.
+
+ * callint.c (Finteractive, Fcall_interactively):
+ * minibuf.c (Fread_variable): Callers changed.
+
+2012-04-09 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (set_cursor_from_row): If the display string appears in
+ the buffer at position that is closer to point than the position
+ after the display string, display the cursor on the first glyph of
+ the display string. Fixes cursor display when a 'display' text
+ property immediately follows invisible text. (Bug#11094)
+
+2012-04-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ composite.c: use 'double' consistently
+ * composite.c (get_composition_id): Use 'double' consistently
+ instead of converting 'float' to 'double' and vice versa; this is
+ easier to understand and avoids a GCC warning.
+
+2012-04-09 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: Generate leim-list with bootstrap-emacs, in
+ preparation for dumping it with emacs. (Bug#4789)
+ (leimdir): New variable.
+ ($(leimdir)/leim-list.el): New rule.
+ (emacs$(EXEEXT)): Depend on leim-list.el.
+
+ * buffer.c (Qucs_set_table_for_input): Remove. (Bug#9821)
+ (Fget_buffer_create): Don't call Qucs_set_table_for_input.
+ (init_buffer_once, syms_of_buffer): Remove Qucs_set_table_for_input.
+
+2012-04-08 Andreas Schwab <schwab@linux-m68k.org>
+
+ * lisp.h (struct Lisp_Symbol): Add explicit padding to ensure
+ proper alignment.
+
+2012-04-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * xml.c (init_libxml2_functions) [WINDOWSNT]:
+ Remove unused local variable.
+
+2012-04-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid unnecessary pointer scanning in garbage collection (Bug#10780).
+ * alloc.c (POINTERS_MIGHT_HIDE_IN_OBJECTS): New macro.
+ (mark_memory): Mark Lisp_Objects only if pointers might hide in
+ objects, as mark_maybe_pointer will catch them otherwise.
+ (GC_LISP_OBJECT_ALIGNMENT): Remove; no longer needed.
+ * s/gnu-linux.h (GC_LISP_OBJECT_ALIGNMENT) [__mc68000__]: Likewise.
+
+2012-04-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix typo that broke non-Windows builds.
+ * xml.c (libxml2_loaded_p) [!!WINDOWSNT]: 'inine' -> 'inline'.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ Support building on MS-Windows with libxml2.
+
+ * makefile.w32-in (OBJ2): Add xml.$(O).
+ (GLOBAL_SOURCES): Add xml.c.
+ ($(BLD)/xml.$(O)): New dependency list.
+
+ * xml.c (DEF_XML2_FN, LOAD_XML2_FN) [WINDOWSNT]: New macros.
+ (fn_htmlReadMemory, fn_xmlReadMemory, fn_xmlDocGetRootElement)
+ (fn_xmlFreeDoc, fn_xmlCleanupParser, fn_xmlCheckVersion)
+ [!WINDOWSNT]: New macros.
+ (init_libxml2_functions, libxml2_loaded_p): New functions.
+ (parse_region): Call fn_xmlCheckVersion instead of using the macro
+ LIBXML_TEST_VERSION. Call libxml2 functions via the fn_* macros.
+ (xml_cleanup_parser): New function, export for fn_xmlCleanupParser.
+ Calls xmlCleanupParser only if libxml2 was loaded (or statically
+ linked in).
+ (Flibxml_parse_html_region, Flibxml_parse_xml_region):
+ Call init_libxml2_functions before calling libxml2 functions.
+ (syms_of_xml) <Qlibxml2_dll>: DEFSYM it.
+
+ * emacs.c: Don't include libxml/parser.h.
+ (shut_down_emacs): Call xml_cleanup_parser, instead of calling
+ xmlCleanupParser directly.
+
+ * lisp.h [HAVE_LIBXML2]: Add prototype for xml_cleanup_parser.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * indent.c (Fvertical_motion): If there is a display string at
+ point, use it.vpos to compute how many lines to backtrack after
+ move_it_to point. (Bug#11133)
+
+2012-04-06 Eli Zaretskii <eliz@gnu.org>
+
+ * buffer.h (FETCH_CHAR, FETCH_MULTIBYTE_CHAR):
+ * character.h (STRING_CHAR, STRING_CHAR_AND_LENGTH): Add comments
+ about subtle differences between FETCH_CHAR* and STRING_CHAR*
+ macros related to unification of CJK characters. For the details,
+ see the discussion following the message here:
+ http://debbugs.gnu.org/cgi/bugreport.cgi?bug=11073#14.
+
+2012-04-04 Chong Yidong <cyd@gnu.org>
+
+ * keyboard.c (Vdelayed_warnings_list): Doc fix.
+
+2012-04-01 Eli Zaretskii <eliz@gnu.org>
+
+ * w32menu.c (simple_dialog_show, add_menu_item): Use SAFE_ALLOCA
+ instead of alloca. (Bug#11138)
+
+2012-04-01 Andreas Schwab <schwab@linux-m68k.org>
+
+ * w32menu.c (is_simple_dialog): Properly check lisp types.
+ (Bug#11141)
+
+2012-03-31 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (move_it_by_lines): When DVPOS is positive, and the
+ position we get to after a call to move_it_to fails the
+ IS_POS_VALID_AFTER_MOVE_P test, move to the next buffer position
+ only if we wind up in a string from display property. (Bug#11063)
+
+ * window.c (Fdelete_other_windows_internal): Invalidate the row
+ and column information about mouse highlight, so that redisplay
+ restores it after reallocating the glyph matrices. (Bug#7464)
+
+ * xdisp.c (set_cursor_from_row): If `cursor' property on a display
+ string comes from a `display' text property, use the buffer
+ position of that property as if we actually saw that position in
+ the row's glyphs.
+ (move_it_by_lines): Remove the assertion that
+ "it->current_x == 0 && it->hpos == 0" which can be legitimately
+ violated when there's a before-string at the beginning of a line.
+ (Bug#11063)
+
+2012-03-30 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (append_space_for_newline): If the default face was
+ remapped, use the remapped face for the appended newline.
+ (extend_face_to_end_of_line): Use the remapped default face for
+ extending the face to the end of the line.
+ (display_line): Call extend_face_to_end_of_line when the default
+ face was remapped. (Bug#11068)
+
+2012-03-29 Eli Zaretskii <eliz@gnu.org>
+
+ * s/ms-w32.h: Discourage from defining HAVE_GETCWD.
+
+2012-03-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * keyboard.c (safe_run_hooks_error): Don't unquote strings.
+
+2012-03-27 Glenn Morris <rgm@gnu.org>
+
+ * search.c (Fword_search_backward_lax, Fword_search_forward_lax):
+ Doc fixes.
+
+2012-03-26 Kenichi Handa <handa@m17n.org>
+
+ * dispextern.h (struct glyph): Fix previous change. Change the
+ bit length of glyphless.ch to 25 (Bug#11082).
+
+2012-03-26 Chong Yidong <cyd@gnu.org>
+
+ * keyboard.c (Vselection_inhibit_update_commands): New variable.
+ (command_loop_1): Use it; inhibit selection update for
+ handle-select-window too (Bug#8996).
+
+2012-03-25 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+ * w32heap.c (_heap_init, _heap_term): Remove dead MSVC-specific code.
+
+2012-03-25 Kenichi Handa <handa@m17n.org>
+
+ * dispextern.h (struct glyph): Change the bit length of
+ glyphless.ch to 22 to make the member glyphless fit in 32 bits.
+
+2012-03-24 Eli Zaretskii <eliz@gnu.org>
+
+ * s/ms-w32.h (tzname): Include time.h before redirecting to
+ _tzname. Fixes the MSVC build. (Bug#9960)
+
+2012-03-24 Andreas Schwab <schwab@linux-m68k.org>
+
+ * xdisp.c (produce_glyphless_glyph): Limit length of acronym to 6
+ characters.
+
+ * xterm.c (XTread_socket): Only modify handling_signal if
+ !SYNC_INPUT. (Bug#11080)
+
+2012-03-23 Eli Zaretskii <eliz@gnu.org>
+
+ * bidi.c (bidi_fetch_char): Use STRING_CHAR_AND_LENGTH instead of
+ FETCH_MULTIBYTE_CHAR followed by CHAR_BYTES. Prevents crashes
+ when fetching a multibyte character consumes more bytes than
+ CHAR_BYTES returns, due to unification of CJK characters in
+ string_char. (Bug#11073)
+
+2012-03-23 Troels Nielsen <bn.troels@gmail.com> (tiny change)
+
+ * process.c (wait_reading_process_output): Handle pty disconnect
+ by refraining from sending oneself a SIGCHLD (bug#10933).
+
+2012-03-22 Chong Yidong <cyd@gnu.org>
+
+ * dispextern.h (struct it): New member string_from_prefix_prop_p.
+
+ * xdisp.c (push_prefix_prop): Rename from push_display_prop.
+ Mark string as coming from a prefix property.
+ (handle_face_prop): Use default face for prefix strings (Bug#4281).
+ (pop_it, reseat_1): Save and restore string_from_prefix_prop_p.
+
+2012-03-21 Chong Yidong <cyd@gnu.org>
+
+ * xfaces.c (Vface_remapping_alist): Doc fix.
+
+2012-03-20 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (Fw32_set_console_codepage)
+ (Fw32_set_console_output_codepage, Fw32_get_codepage_charset):
+ Doc fixes.
+
+2012-03-20 Chong Yidong <cyd@gnu.org>
+
+ * dispnew.c (Fredisplay, Vredisplay_preemption_period): Update doc
+ to reflect default non-nil value of redisplay-dont-pause.
+
+2012-03-19 Kenichi Handa <handa@m17n.org>
+
+ * ftfont.c (ftfont_drive_otf): Mask bits of character code to make
+ it fit in a valid range (Bug#11003).
+
+2012-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (cursor_row_p): Even if the glyph row ends in a string
+ that is not from display property, accept the row as a "cursor
+ row" if one of the string's character has a non-nil `cursor'
+ property. Fixes cursor positioning when there are newlines in
+ overlay strings, e.g. in icomplete.el. (Bug#11035)
+
+2012-03-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * buffer.c (compare_overlays): Don't assume args differ (Bug#6830).
+
+2012-03-12 Chong Yidong <cyd@gnu.org>
+
+ * eval.c (inhibit_lisp_code): Rename from
+ inhibit_window_configuration_change_hook; move from window.c.
+
+ * xfns.c (unwind_create_frame_1, Fx_create_frame):
+ * window.c (run_window_configuration_change_hook)
+ (syms_of_window): Callers changed.
+
+2012-03-11 Chong Yidong <cyd@gnu.org>
+
+ * keymap.c (Fkey_description): Doc fix (Bug#9700).
+
+ * editfns.c (Fconstrain_to_field): Doc fix (Bug#9452).
+
+2012-03-10 Chong Yidong <cyd@gnu.org>
+
+ * frame.c (other_visible_frames): Don't assume the selected frame
+ is visible (Bug#10955).
+
+2012-03-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * buffer.c (compare_overlays): Avoid qsort's instability (bug#6830).
+
+2012-03-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (x_wm_set_size_hint): Use one row in call to
+ FRAME_TEXT_LINES_TO_PIXEL_HEIGHT so base_height is greater than
+ zero (Bug#10954).
+
+2012-03-03 Glenn Morris <rgm@gnu.org>
+
+ * alloc.c (Fgarbage_collect, misc-objects-consed): Doc fixes.
+
+2012-03-02 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (try_window_reusing_current_matrix): Don't move cursor
+ position past the first glyph_row that ends at ZV. (Bug#10902)
+ (redisplay_window, next_element_from_string): Fix typos in
+ comments.
+ (redisplay_window): Pass to move_it_vertically the margin in
+ pixels, not in screen lines.
+
+2012-03-02 Glenn Morris <rgm@gnu.org>
+
+ * buffer.c (buffer-list-update-hook): Doc fix.
+
+2012-02-29 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (get_overlay_strings_1): Under bidi redisplay, call
+ push_it before setting up the iterator for the first overlay
+ string, even if we have an empty string loaded.
+ (next_overlay_string): If there's an empty string on the iterator
+ stack, pop the stack. (Bug#10903)
+
+2012-02-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Generalize fix for crash due to non-contiguous EMACS_INT (Bug#10780).
+ Suggested by Stefan Monnier in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00692.html>.
+ * alloc.c (widen_to_Lisp_Object): New static function.
+ (mark_memory): Also mark Lisp_Objects by fetching pointer words
+ and widening them to Lisp_Objects. This would work even if
+ USE_LSB_TAG is defined and wide integers are used, which might
+ happen in a future version of Emacs.
+
+2012-02-25 Chong Yidong <cyd@gnu.org>
+
+ * fileio.c (Ffile_selinux_context, Fset_file_selinux_context):
+ Doc fix.
+
+ * xselect.c (Fx_selection_exists_p): Doc fix.
+ (x_clipboard_manager_save_all): Print an informative message
+ before saving to clipboard manager.
+
+2012-02-24 Chong Yidong <cyd@gnu.org>
+
+ * keyboard.c (process_special_events): Handle all X selection
+ requests in kbd_buffer, not just the next one (Bug#8869).
+
+2012-02-23 Chong Yidong <cyd@gnu.org>
+
+ * xfns.c (Fx_create_frame): Avoid window-configuration-change-hook
+ call when setting menu-bar-lines and tool-bar-lines parameters.
+ (unwind_create_frame_1): New helper function.
+
+ * window.c (inhibit_window_configuration_change_hook): New var.
+ (run_window_configuration_change_hook): Obey it.
+ (syms_of_window): Initialize it.
+
+2012-02-22 Chong Yidong <cyd@gnu.org>
+
+ * xterm.c (x_draw_image_relief): Add missing type check for
+ Vtool_bar_button_margin (Bug#10743).
+
+2012-02-21 Chong Yidong <cyd@gnu.org>
+
+ * fileio.c (Vfile_name_handler_alist): Doc fix.
+
+ * buffer.c (Fget_file_buffer): Protect against invalid file
+ handler return value.
+
+2012-02-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ * .gdbinit (xreload): Don't assume EMACS_INT fits in 'long'
+ when computing $valmask.
+
+ Fix crash due to non-contiguous EMACS_INT (Bug#10780).
+ * lisp.h (VALBITS): Move definition up, so that USE_LSB_TAG can use it.
+ (USE_LSB_TAG): Do not define if UINTPTR_MAX >> VALBITS == 0.
+ It's useless in that case, and it can cause problems on hosts
+ that allocate halves of EMACS_INT values separately.
+ Reported by Dan Horák. Diagnosed by Andreas Schwab in
+ <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=10780#30>.
+ * mem-limits.h (EXCEEDS_LISP_PTR): Define to 0 on hosts where
+ UINTPTR_MAX >> VALBITS == 0. This is required by the above change;
+ it avoids undefined behavior on hosts where shifting right by more
+ than the word width has undefined behavior.
+
+2012-02-19 Chong Yidong <cyd@gnu.org>
+
+ * fileio.c (Ffile_name_directory, Ffile_name_nondirectory)
+ (Funhandled_file_name_directory, Ffile_name_as_directory)
+ (Fdirectory_file_name, Fexpand_file_name)
+ (Fsubstitute_in_file_name): Protect against invalid file handler
+ return values (Bug#10845).
+
+2012-02-18 Eli Zaretskii <eliz@gnu.org>
+
+ * .gdbinit (pitx): Fix incorrect references to fields of the
+ iterator stack.
+
+2012-02-17 Chong Yidong <cyd@gnu.org>
+
+ * syntax.c (Fscan_lists): Doc fix (Bug#10833).
+
+2012-02-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ * image.c (MAX_IMAGE_SIZE): Increase from 6.0 to 10.0; see
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00540.html>.
+
+2012-02-15 Chong Yidong <cyd@gnu.org>
+
+ * eval.c (Fdefvar, Fdefconst): Doc fix; note that the variable is
+ marked as special. Also, starting docstrings with * is obsolete.
+
+2012-02-13 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gnutls.c (emacs_gnutls_write): Fix last change.
+
+2012-02-13 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnutls.c (emacs_gnutls_write): Set errno appropriately for
+ send_process.
+
+2012-02-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * keymap.c (Fsingle_key_description): Handle char ranges.
+
+2012-02-12 Chong Yidong <cyd@gnu.org>
+
+ * xdisp.c (handle_stop): Avoid assigning -1 to it->face_id here,
+ as that creates a dangerous corner case.
+
+ * window.c (Fdelete_window_internal): Invalidate the mouse
+ highlight (Bug#9904).
+
+2012-02-12 Glenn Morris <rgm@gnu.org>
+
+ * xselect.c (Fx_own_selection_internal)
+ (Fx_get_selection_internal, Fx_disown_selection_internal)
+ (Fx_selection_owner_p, Fx_selection_exists_p): Doc fixes.
+ * nsselect.m (Fx_own_selection_internal)
+ (Fx_disown_selection_internal, Fx_selection_exists_p)
+ (Fx_selection_owner_p, Fx_get_selection_internal):
+ Sync docs and argument specs with the xselect.c versions.
+
+2012-02-11 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnutls.c (emacs_gnutls_write): Don't infloop if sendto fails.
+
+2012-02-11 Eli Zaretskii <eliz@gnu.org>
+
+ * w32select.c (Fx_selection_exists_p): Sync doc string and
+ argument list with xselect.c. (Bug#10783)
+
+ * w16select.c (Fx_selection_exists_p): Sync doc string and
+ argument list with xselect.c. (Bug#10783)
+
+2012-02-10 Glenn Morris <rgm@gnu.org>
+
+ * fns.c (Fsecure_hash): Doc fix.
+
+2012-02-09 Kenichi Handa <handa@m17n.org>
+
+ * coding.c (produce_chars): Fix updating of src_end (Bug#10701).
+
+2012-02-07 Chong Yidong <cyd@gnu.org>
+
+ * buffer.c (Fbuffer_local_variables)
+ (buffer_lisp_local_variables): Handle unbound vars correctly;
+ don't let Qunbound leak into Lisp.
+
+2012-02-07 Glenn Morris <rgm@gnu.org>
+
+ * image.c (Fimagemagick_types): Doc fix.
+
+ * image.c (imagemagick-render-type): Change it from a lisp object
+ to an integer. Move the doc here from the lisp manual.
+ Treat all values not equal to 0 the same.
+
+2012-02-06 Chong Yidong <cyd@gnu.org>
+
+ * doc.c (store_function_docstring): Avoid applying docstring of
+ alias to base function (Bug#2603).
+
+2012-02-04 Andreas Schwab <schwab@linux-m68k.org>
+
+ * .gdbinit (pp1, pv1): Remove redundant defines.
+ (pr): Use pp.
+
+2012-02-04 Chong Yidong <cyd@gnu.org>
+
+ * nsterm.m: Declare a global (Bug#10694).
+
+2012-02-04 Eli Zaretskii <eliz@gnu.org>
+
+ * w32.c (get_emacs_configuration_options):
+ Include --enable-checking, if specified, in the return value.
+
+2012-02-04 Martin Rudalics <rudalics@gmx.at>
+
+ * dispnew.c (change_frame_size_1): Calculate new_frame_total_cols
+ after rounding frame sizes. (Bug#9723)
+
+2012-02-04 Eli Zaretskii <eliz@gnu.org>
+
+ * keyboard.c (adjust_point_for_property): Don't position point
+ before BEGV. (Bug#10696)
+
+2012-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Handle overflow when computing char display width (Bug#9496).
+ * character.c (char_width): Return EMACS_INT, not int.
+ (char_width, c_string_width): Check for overflow when
+ computing the width; this is possible now that individual
+ characters can have unbounded width. Problem introduced
+ by merge from Emacs 23 on 2012-01-19.
+
+2012-02-02 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (Fdbus_register_method): Mention the return value
+ :ignore in the docstring.
+
+2012-02-02 Glenn Morris <rgm@gnu.org>
+
+ * callproc.c (Fcall_process, Fcall_process_region): Doc fix.
+
+ * nsterm.m (syms_of_nsterm) <x-toolkit-scroll-bars>:
+ Unconditionally set to t. (Bug#10673)
+ * nsterm.m (syms_of_nsterm) <x-toolkit-scroll-bars>:
+ * w32term.c (syms_of_w32term) <x-toolkit-scroll-bars>:
+ * xterm.c (syms_of_xterm) <x-toolkit-scroll-bars>: Doc fix.
+
+2012-02-02 Kenichi Handa <handa@m17n.org>
+
+ (x_produce_glyphs): Cancel previous change. If cmp->glyph_len is
+ 0, do not call append_composite_glyph.
+
+2012-02-02 Kenichi Handa <handa@m17n.org>
+
+ * xdisp.c (BUILD_COMPOSITE_GLYPH_STRING): Initialize first_s to
+ NULL (Bug#6988).
+ (x_produce_glyphs): If the component of a composition is a null
+ string, set it->pixel_width to 1 to avoid zero-width glyph.
+
+2012-02-01 Eli Zaretskii <eliz@gnu.org>
+
+ * ralloc.c (resize_bloc, r_alloc_sbrk): Don't call memmove if its
+ first 2 arguments are identical. This makes inserting large
+ output from a subprocess an order of magnitude faster on
+ MS-Windows, where all sbrk'ed memory is always contiguous.
+
+2012-01-31 Glenn Morris <rgm@gnu.org>
+
+ * nsterm.m (syms_of_nsterm) <x-toolkit-scroll-bars>:
+ * w32term.c (syms_of_w32term) <x-toolkit-scroll-bars>:
+ * xterm.c (syms_of_xterm) <x-toolkit-scroll-bars>: Sync docs.
+
+2012-01-29 Glenn Morris <rgm@gnu.org>
+
+ * gnutls.c (syms_of_gnutls): More doc (from etc/NEWS).
+
+2012-01-28 Samuel Thibault <sthibault@debian.org> (tiny change)
+
+ * s/gnu.h: Define POSIX_SIGNALS (Bug#10552).
+
+2012-01-28 Chong Yidong <cyd@gnu.org>
+
+ * minibuf.c (syms_of_minibuf): Doc fix (Bug#10550).
+
+2012-01-26 Chong Yidong <cyd@gnu.org>
+
+ * keyboard.c (Vecho_keystrokes): Document zero value (Bug#10503).
+
+ * search.c (Fsearch_forward, Fsearch_backward): Document negative
+ repeat counts (Bug#10507).
+
+2012-01-26 Glenn Morris <rgm@gnu.org>
+
+ * lread.c (syms_of_lread): Doc fix.
+
+2012-01-25 HIROSHI OOTA <nil@mad.dog.cx> (tiny change)
+
+ * coding.c (encode_designation_at_bol): Change return value to
+ EMACS_INT.
+
+2012-01-25 Chong Yidong <cyd@gnu.org>
+
+ * eval.c (Fuser_variable_p): Doc fix; mention custom-variable-p.
+
+2012-01-21 Chong Yidong <cyd@gnu.org>
+
+ * floatfns.c (Fcopysign): Make the second argument non-optional,
+ since nil is not allowed anyway.
+
+2012-01-21 Andreas Schwab <schwab@linux-m68k.org>
+
+ * process.c (read_process_output): Use p instead of XPROCESS (proc).
+ (send_process): Likewise.
+
+2012-01-19 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (save_window_save, Fcurrent_window_configuration)
+ (Vwindow_persistent_parameters): Do not use Qstate.
+ Rewrite doc-strings.
+
+2012-01-19 Kenichi Handa <handa@m17n.org>
+
+ * character.c (char_width): New function.
+ (Fchar_width, c_string_width, lisp_string_width):
+ Use char_width (Bug#9496).
+
+2012-01-16 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Vwindow_persistent_parameters): New variable.
+ (Fset_window_configuration, save_window_save): Handle persistent
+ window parameters.
+
+2012-01-14 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c (signal_user_input): Don't do a QUIT, to avoid
+ thrashing the stack of the thread. (Bug#9087)
+
+2012-01-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xdisp.c (rows_from_pos_range): Add parens as per gcc -Wparentheses.
+
+2012-01-11 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (rows_from_pos_range): Handle the case where the
+ highlight ends on a newline. (Bug#10464)
+ (mouse_face_from_buffer_pos): Fix off-by-one error in calculating
+ he end column for display of highlight that ends on a newline
+ before a R2L line.
+
+2012-01-11 Glenn Morris <rgm@gnu.org>
+
+ * lread.c (init_lread): If no-site-lisp, remove site-lisp dirs
+ from load-path also when installation-directory is nil. (Bug#10208)
+
+2012-01-10 Glenn Morris <rgm@gnu.org>
+
+ * emacs.c (syms_of_emacs) <installation-directory>: Doc fix.
+
+ * epaths.in (PATH_LOADSEARCH, PATH_EXEC, PATH_DATA, PATH_DOC):
+ Update template values to be closer to their typical values these days.
+
+2012-01-09 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (rows_from_pos_range): Accept additional argument
+ DISP_STRING, and accept any glyph in a row whose object is that
+ string as eligible for mouse highlight. Fixes mouse highlight of
+ display strings from overlays. (Bug#10464)
+
+2012-01-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ emacs: fix an auto-save permissions race condition (Bug#10400)
+ * fileio.c (auto_saving_dir_umask): New static var.
+ (Fmake_directory_internal): Use it.
+ (do_auto_save_make_dir): Set it, instead of invoking chmod after
+ creating the directory. The old code temporarily assigns
+ too-generous permissions to the directory.
+ (do_auto_save_eh): Clear it.
+ (Fdo_auto_save): Catch all errors, not just file errors, so
+ that the var is always cleared.
+
+2012-01-07 Eli Zaretskii <eliz@gnu.org>
+
+ * search.c (scan_buffer): Pass character positions to
+ know_region_cache, not byte positions. (Bug#6540)
+
+2012-01-07 LynX <_LynX@bk.ru> (tiny change)
+
+ * w32.c (sys_rename): Report EXDEV when rename of a directory
+ fails because the target is on another logical disk. (Bug#10284)
+
+2012-01-07 David Benjamin <davidben@mit.edu> (tiny change)
+
+ * xterm.c (x_embed_request_focus): New function.
+
+ * xterm.h: Add prototype.
+
+ * xfns.c (Fx_focus_frame): Use it for embedded frames (Bug#9977).
+
+2012-01-05 Glenn Morris <rgm@gnu.org>
+
+ * emacs.c (emacs_copyright): Update short copyright year to 2012.
+
+2012-01-01 Eli Zaretskii <eliz@gnu.org>
+
+ * gnutls.c (init_gnutls_functions): Load gnutls_check_version.
+ Load gnutls_transport_set_lowat only if GnuTLS version is below
+ 2.11.1.
+ (emacs_gnutls_handshake): Call gnutls_transport_set_lowat only for
+ GnuTLS versions below 2.11.1.
+
+2011-12-31 Antoine Levitt <antoine.levitt@gmail.com>
+
+ * xdisp.c (syms_of_xdisp) <window-scroll-functions>: Add warning
+ to the doc string advising against its use for altering the way
+ windows are scrolled.
+
+2011-12-28 Kenichi Handa <handa@m17n.org>
+
+ * coding.c (Fdefine_coding_system_internal): Make an utf-8 base
+ coding-system ASCII compatible only when it does not produce BOM
+ on encoding (Bug#10383).
+
2011-12-26 Jan Djärv <jan.h.d@swipnet.se>
* xmenu.c (x_menu_wait_for_event): Use xg_select for Gtk3 so menus
@@ -21,8 +11259,8 @@
2011-12-21 Jan Djärv <jan.h.d@swipnet.se>
- * nsterm.m (x_free_frame_resources): Release
- f->output_data.ns->miniimage
+ * nsterm.m (x_free_frame_resources):
+ Release f->output_data.ns->miniimage.
(ns_index_color): Fix indentation. Do not retain
color_table->colors[i].
@@ -52,7 +11290,7 @@
(trackingNotification): Surround with ifdef NS_IMPL_COCOA.
(syms_of_nsmenu): Set trackingMenu to 1 if not NS_IMPL_COCOA.
-2011-12-18 David Reitter <reitter@cmu.edu>
+2011-12-18 David Reitter <reitter@cmu.edu>
* nsterm.m (ns_term_init): Subscribe for notifications
NSMenuDidBeginTrackingNotification and NSMenuDidEndTrackingNotification
@@ -68,16 +11306,16 @@
* nsselect.m (CUT_BUFFER_SUPPORT): Remove define.
(symbol_to_nsstring): Fix indentation.
(ns_symbol_to_pb): New function.
- (Fns_get_selection_internal): Renamed from Fns_get_cut_buffer_internal.
- (Fns_rotate_cut_buffers_internal): Removed.
- (Fns_store_selection_internal): Renamed from
+ (Fns_get_selection_internal): Rename from Fns_get_cut_buffer_internal.
+ (Fns_rotate_cut_buffers_internal): Remove.
+ (Fns_store_selection_internal): Rename from
Fns_store_cut_buffer_internal.
(ns_get_foreign_selection, Fx_own_selection_internal)
(Fx_disown_selection_internal, Fx_selection_exists_p)
- (Fns_get_selection_internal, Fns_store_selection_internal): Use
- ns_symbol_to_pb and check if return value is nil.
- (syms_of_nsselect): Remove ifdef CUT_BUFFER_SUPPORT. Remove
- defsubr Sns_rotate_cut_buffers_internal. Sns_get_cut_buffer_internal
+ (Fns_get_selection_internal, Fns_store_selection_internal):
+ Use ns_symbol_to_pb and check if return value is nil.
+ (syms_of_nsselect): Remove ifdef CUT_BUFFER_SUPPORT. Remove defsubr
+ Sns_rotate_cut_buffers_internal. Sns_get_cut_buffer_internal
renamed to Sns_get_selection_internal, Sns_store_cut_buffer_internal
renamed to Sns_store_selection_internal.
(ns_handle_selection_request): Move code to Fx_own_selection_internal
@@ -211,7 +11449,7 @@
(coding_set_destination): Return how many bytes
coding->destination was relocated.
(CODING_DECODE_CHAR, CODING_ENCODE_CHAR, CODING_CHAR_CHARSET)
- (CODING_CHAR_CHARSET_P): Adjusted for the avove changes.
+ (CODING_CHAR_CHARSET_P): Adjust for the avove changes.
2011-12-05 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny change)
@@ -778,7 +12016,7 @@
* xfns.c (unwind_create_frame): Fix comment.
(Fx_create_frame, x_create_tip_frame):
Move terminal->reference_count++ just before making the frame
- official. Move initialization of image_cache_refcount and
+ official. Move initialization of image_cache_refcount and
dpyinfo_refcount before calling init_frame_faces (Bug#9943).
2011-11-05 Eli Zaretskii <eliz@gnu.org>
@@ -2212,7 +13450,7 @@
Remove unreachable code.
(read_hex, load_charset_map_from_file): Check for integer overflow.
- * xterm.c: don't go over XClientMessageEvent limit
+ * xterm.c: Don't go over XClientMessageEvent limit.
(scroll_bar_windows_size): Now ptrdiff_t, as we prefer signed.
(x_send_scroll_bar_event): Likewise. Check that the size does not
exceed limits imposed by XClientMessageEvent, as well as the usual
@@ -3587,7 +14825,7 @@
(EmacsToolbar): Implements NSToolbarDelegate on OSX >= 10.6.
* nsselect.m (ns_string_from_pasteboard): Don't use deprecated methods
- cString and lossyCString on OSX >= 10.4
+ cString and lossyCString on OSX >= 10.4.
* nsmenu.m (fillWithWidgetValue): Don't use deprecated method
sizeToFit on OSX >= 10.2.
@@ -3860,7 +15098,7 @@
* Makefile.in (SETTINGS_LIBS): Fix typo.
-2011-07-01 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny patch)
+2011-07-01 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny change)
* coding.c (Fencode_coding_string): Record the last coding system
used, as the function doc string says (bug#8738).
@@ -4421,7 +15659,7 @@
2011-06-15 Paul Eggert <eggert@cs.ucla.edu>
- Integer overflow and signedness fixes (Bug#8873).
+ Integer overflow and signedness fixes (Bug#8873, Bug#8828).
* ccl.c (ASCENDING_ORDER): New macro, to work around GCC bug 43772.
(GET_CCL_RANGE, IN_INT_RANGE): Use it.
@@ -5503,7 +16741,7 @@
* ccl.c (ccl_driver): Redo slightly to avoid the need for 'unsigned'.
- ccl: add integer overflow checks
+ ccl: Add integer overflow checks.
* ccl.c (CCL_CODE_MAX, GET_CCL_RANGE, GET_CCL_CODE, GET_CCL_INT):
(IN_INT_RANGE): New macros.
(ccl_driver): Use them to check for integer overflow when
@@ -5701,7 +16939,7 @@
where the include path doesn't have X11/X.h by default. See
<http://lists.gnu.org/archive/html/emacs-devel/2011-05/msg00561.html>.
-2011-05-20 Kenichi Handa <handa@m17n.org>
+2011-05-20 Kenichi Handa <handa@m17n.org>
* composite.c (find_automatic_composition): Fix previous change.
@@ -6043,7 +17281,7 @@
* lread.c (lisp_file_lexically_bound_p): Stop scanning at end
marker. (Bug#8610)
-2011-05-05 Eli Zaretskii <eliz@gnu.org>
+2011-05-05 Eli Zaretskii <eliz@gnu.org>
* w32heap.c (allocate_heap) [USE_LISP_UNION_TYPE || USE_LSB_TAG]:
New version that can reserve upto 2GB of heap space.
@@ -6400,7 +17638,7 @@
conversion specifiers. For example, use "...%"pI"d..." rather
than "...%"pEd"...".
(pEd): Remove. All uses replaced with similar uses of pI.
- * src/m/amdx86-64.h, src/m/ia64.h, src/m/ibms390x.h: Likewise.
+ * m/amdx86-64.h, m/ia64.h, m/ibms390x.h: Likewise.
* alloc.c (check_pure_size): Don't overflow by converting size to int.
* bidi.c (bidi_dump_cached_states): Use pI to avoid cast.
* data.c (Fnumber_to_string): Use pI instead of if-then-else-abort.
@@ -6551,7 +17789,7 @@
* xfaces.c <Qunspecified>: Make extern again.
* syntax.c: Include sys/types.h before including regex.h, as
- required by Posix.
+ required by POSIX.
* doc.c (get_doc_string): Improve the format passed to `error'.
@@ -7382,8 +18620,7 @@
Without this change, on typical 64-bit hosts error ("...%d...", N)
was used to print both 32- and 64-bit integers N, which relied on
undefined behavior.
- * lisp.h, src/m/amdx86-64.h, src/m/ia64.h, src/m/ibms390x.h (pEd):
- New macro.
+ * lisp.h, m/amdx86-64.h, m/ia64.h, m/ibms390x.h (pEd): New macro.
* lisp.h (error, verror): Mark as printf-like functions.
* eval.c (verror): Use vsnprintf, not doprnt, to do the real work.
Report overflow in size calculations when allocating printf buffer.
@@ -8247,7 +19484,7 @@
are now in src/globals.h.
(syms_of_minibuf): Remove spurious & from previous change.
-2011-03-20 Leo <sdl.web@gmail.com>
+2011-03-20 Leo Liu <sdl.web@gmail.com>
* minibuf.c (completing-read-function): New variable.
(completing-read-default): Rename from completing-read.
@@ -9016,7 +20253,7 @@ See ChangeLog.11 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2011 Free Software Foundation, Inc.
+ Copyright (C) 2011-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.1 b/src/ChangeLog.1
index 7fef45f36da..5265d6fdf59 100644
--- a/src/ChangeLog.1
+++ b/src/ChangeLog.1
@@ -3521,7 +3521,7 @@
* minibuf.c: Don't allow entry to minibuffer
while minibuffer is selected.
- Copyright (C) 1985-1986, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.10 b/src/ChangeLog.10
index 53f7a016654..6eda101c815 100644
--- a/src/ChangeLog.10
+++ b/src/ChangeLog.10
@@ -15825,7 +15825,7 @@
* w32term.c (w32_draw_fringe_bitmap): Copy unadapted code from
xterm.c to handle overlaid fringe bitmaps and to use cursor color
for displaying cursor in fringe.
- (w32_define_fringe_bitmap, w32_destroy_fringe_bitmap): New W32
+ (w32_define_fringe_bitmap, w32_destroy_fringe_bitmap): New Windows
specific functions to define and destroy fringe bitmaps in fringe_bmp.
(w32_redisplay_interface): Add them to redisplay_interface.
(w32_term_init): Call w32_init_fringe instead of explicitly
@@ -20972,7 +20972,7 @@
2002-12-30 Richard Dawe <rich@phekda.freeserve.co.uk>
- * src/config.in (!HAVE_SIZE_T): Fix order of arguments in
+ * config.in (!HAVE_SIZE_T): Fix order of arguments in
type definition of size_t.
2003-01-02 Steven Tamm <steventamm@mac.com>
@@ -21476,7 +21476,7 @@
"Emacs built on Windows 9x/ME crashes at startup on Windows XP,
or Emacs builtpart of on XP crashes at startup on Windows 9x/ME."
- * w32.c: Added wrapper functions around the win32 API functions
+ * w32.c: Added wrapper functions around the Windows API functions
OpenProcessToken, GetTokenInformation, LookupAccountSid, and
GetSidIdentifierAuthority. These wrapper functions serve two
purposes:
@@ -21490,7 +21490,7 @@
the version of advapi32.dll that is found in the 9x branch of
Microsoft Windows.
- * w32.c (init_user_info): Replace the calls to the win32 API
+ * w32.c (init_user_info): Replace the calls to the Windows API
functions OpenProcessToken, GetTokenInformation, LookupAccountSid,
and GetSidIdentifierAuthority with calls to the newly added
wrapper functions.
@@ -23215,7 +23215,7 @@
* macterm.c (do_ae_open_documents) [MAC_OSX]: Call FSpMakeFSRef
and FSRefMakePath to convert FSSpec returned with Apple Event to
- Posix pathname.
+ POSIX pathname.
(mac_initialize) [TARGET_API_MAC_CARBON]:
Call init_required_apple_events and disable the `Quit' menu item
provided automatically by the Carbon Toolbox.
@@ -27912,7 +27912,7 @@ See ChangeLog.9 for earlier changes.
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.11 b/src/ChangeLog.11
index 78639ef0c2b..1f444b9292c 100644
--- a/src/ChangeLog.11
+++ b/src/ChangeLog.11
@@ -533,8 +533,8 @@
* deps.mk (getloadavg.o): Remove; gnulib now does this.
* lisp.h (getloadavg) [!defined HAVE_GETLOADAVG]: Remove; gnulib
now does this.
- * src/s/freebsd.h (HAVE_GETLOADAVG): Remove; gnulib now does this.
- * src/s/netbsd.h (HAVE_GETLOADAVG): Likewise.
+ * s/freebsd.h (HAVE_GETLOADAVG): Remove; gnulib now does this.
+ * s/netbsd.h (HAVE_GETLOADAVG): Likewise.
* config.in: Regenerate.
2011-02-15 Eli Zaretskii <eliz@gnu.org>
@@ -3538,7 +3538,6 @@
* nsmenu.m (syms_of_nsmenu):
* nsfns.m (syms_of_nsfns):
* msdos.c (syms_of_msdos):
-
* image.c (syms_of_image):
* charset.c (syms_of_charset): Use intern_c_string instead of intern.
@@ -3995,7 +3994,8 @@
2010-09-24 Juanma Barranquero <lekktu@gmail.com>
- Remove W32 API function pointer unused since 2005-02-15 (revno 2005-02-15T23:19:26Z!jasonr@gnu.org).
+ Remove Windows API function pointer unused since 2005-02-15 (revno
+ 2005-02-15T23:19:26Z!jasonr@gnu.org).
* w32fns.c (clipboard_sequence_fn): Don't declare.
(globals_of_w32fns): Don't initialize it.
@@ -4388,7 +4388,7 @@
* xml.c (Fxml_parse_string, Fxml_parse_string): Revert last change.
Don't make first argument optional. Doc fix.
-2010-09-14 Leo <sdl.web@gmail.com> (tiny change)
+2010-09-14 Leo Liu <sdl.web@gmail.com> (tiny change)
* xml.c (Fxml_parse_string, Fhtml_parse_string): Fix up the
parameters for the doc string.
@@ -5532,7 +5532,7 @@
(update_frame_tool_bar): Remove old_req, new_req. Do not get tool bar
height, call xg_update_tool_bar_sizes instead.
(free_frame_tool_bar): Remove from hbox or vbox depending on
- toolbar_in_hbox, Set all FRAME_TOOLBAR_*_(WIDTH|HEIGHT) to zero.
+ toolbar_in_hbox. Set all FRAME_TOOLBAR_*_(WIDTH|HEIGHT) to zero.
(xg_change_toolbar_position): New function.
* frame.h (struct frame): Add tool_bar_position.
@@ -9628,7 +9628,7 @@
* frame.c (Vdefault_frame_scroll_bars): Put non-GTK X scroll-bars
on left.
-2010-03-13 Andreas Politz <politza@fh-trier.de> (tiny change)
+2010-03-13 Andreas Politz <politza@fh-trier.de>
* editfns.c (Fformat): Account for string precision when computing
field width (Bug#5710).
@@ -9642,7 +9642,7 @@
2010-03-12 Eli Zaretskii <eliz@gnu.org>
- These changes remove termcap.c from the build on Posix platforms.
+ These changes remove termcap.c from the build on POSIX platforms.
* Makefile.in (termcapobj): Move termcap.o from here...
(MSDOS_OBJ): ...to here.
(termcapobj) [!LIBS_TERMCAP]: Remove specialized value, as it is
@@ -12540,7 +12540,7 @@
2009-06-23 Jim Meyering <meyering@redhat.com>
- * src/ftfont.c (setup_otf_gstring, ftfont_shape_by_flt):
+ * ftfont.c (setup_otf_gstring, ftfont_shape_by_flt):
Use xmalloc and xrealloc (not malloc and realloc), so subsequent heap
pointer dereferences are guaranteed to be valid.
@@ -29523,7 +29523,7 @@
(Fdisplay_buffer): Use it.
(syms_of_window): Export, and initialize it.
-2007-09-06 Pixel <pixel@mandriva.com> (tiny change)
+2007-09-06 Pascal Rigaux <pixel@mandriva.com> (tiny change)
* image.c (gif_load): Fix bug: Handle nonexistent colormap.
@@ -31383,7 +31383,7 @@ See ChangeLog.10 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2007-2011 Free Software Foundation, Inc.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.2 b/src/ChangeLog.2
index d3be0064610..0806106836e 100644
--- a/src/ChangeLog.2
+++ b/src/ChangeLog.2
@@ -2680,7 +2680,7 @@
1986-12-11 Richard Mlynarik (mly@prep)
- * emacs.c, dispnew.c:
+ * emacs.c, dispnew.c:
Rename inhibit_x_windows inhibit_window_system.
Understand "-nw" command-line option.
Reorganize init_display a little to make other window-system
@@ -4771,7 +4771,7 @@
See ChangeLog.1 for earlier changes.
- Copyright (C) 1986-1988, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1986-1988, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.3 b/src/ChangeLog.3
index 34906e505da..4f6e02ff8d3 100644
--- a/src/ChangeLog.3
+++ b/src/ChangeLog.3
@@ -11154,7 +11154,7 @@
(classify_object): Removed code to look up a function key in the
global and local function key keymaps, since this will be done
more generally.
- (Fexecute_mouse_event): Elided this function with a #if 0; I
+ (Fexecute_mouse_event): Elided this function with a #if 0; I
think it will go away once the more general keymap stuff is
implemented, but I'm not sure.
(syms_of_keyboard): Removed defsubr for Sexecute_mouse_event.
@@ -16507,7 +16507,7 @@ See ChangeLog.2 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.4 b/src/ChangeLog.4
index 88c9e3dbf71..d7ef7d8779a 100644
--- a/src/ChangeLog.4
+++ b/src/ChangeLog.4
@@ -6906,7 +6906,7 @@ See ChangeLog.3 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.5 b/src/ChangeLog.5
index ee79917a34d..c6dfde7496b 100644
--- a/src/ChangeLog.5
+++ b/src/ChangeLog.5
@@ -7148,7 +7148,7 @@ See ChangeLog.4 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1994-1995, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1994-1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.6 b/src/ChangeLog.6
index 74141f6813a..64f8b3a8314 100644
--- a/src/ChangeLog.6
+++ b/src/ChangeLog.6
@@ -1269,7 +1269,7 @@
"light", "extralight", and "thin" fonts.
(x_to_win32_charset, win32_to_x_charset): New functions.
(win32_to_x_font): Use new height units. Use win32_to_x_charset.
- (x_to_win32_font): Use x_to_win32_charset. Support Win32 font names
+ (x_to_win32_font): Use x_to_win32_charset. Support w32 font names
in addition to X font names.
(win32_load_font, Fx_list_fonts, Fx_display_color_cells)
@@ -3236,7 +3236,7 @@
1995-12-12 Paul Eggert <eggert@twinsun.com>
- * process.c (create_process): Use Posix signal handling to
+ * process.c (create_process): Use POSIX signal handling to
block signals, if available. If HAVE_VFORK, save and restore
signal handlers that the child might change, since in many
systems (e.g. Solaris 2.4) if the child changes the signal
@@ -3625,11 +3625,11 @@
* xdisp.c [HAVE_NTGUI] (set_menu_framebar): Declare external.
[HAVE_NTGUI] (frame_title_buf, frame_title_ptr): Include variables
- for Win32 window system.
+ for w32 window system.
[HAVE_NTGUI] (store_frame_title, x_consider_frame_title): Include
- procedures for Win32 window system.
- [HAVE_NTGUI] (x_consider_frame_title): Test for Win32 frame.
- [HAVE_NTGUI] (display_text_line): Test for Win32 frame on face change.
+ procedures for w32 window system.
+ [HAVE_NTGUI] (x_consider_frame_title): Test for w32 frame.
+ [HAVE_NTGUI] (display_text_line): Test for w32 frame on face change.
[HAVE_NTGUI] (display_menu_bar): Perform no-op for NT window system.
* window.c [HAVE_NTGUI] (Fset_window_configuration): Set menu
@@ -3659,7 +3659,7 @@
(make_lispy_event): Use FUNCTION_KEY_OFFSET to modify event codes
before applying modifiers.
- * frame.c [HAVE_NTGUI]: Test for a Win32 frame in procedures
+ * frame.c [HAVE_NTGUI]: Test for a w32 frame in procedures
that test for an X frame.
* frame.h (output_method): New method: output_win32.
@@ -3673,13 +3673,13 @@
* emacs.c [HAVE_NTGUI]: Declare Vwindow_system.
[HAVE_NTGUI] (main): Enable inhibit_window_system.
Initialize environment from registry.
- Declare syms of Win32 windowing modules.
+ Declare syms of w32 windowing modules.
* dispnew.c [HAVE_NTGUI]: Include w32term.h.
Include dispextern.h before cm.h since dispextern.h includes windows.h.
[HAVE_NTGUI] (make_frame_glyphs, free_frame_glyphs, scroll_frame_lines)
- (update_frame, update_line): Test for WIN32 frame.
- [HAVE_NTGUI] (init_display): Initialize WIN32 window system.
+ (update_frame, update_line): Test for w32 frame.
+ [HAVE_NTGUI] (init_display): Initialize w32 window system.
* dispextern.h [HAVE_NTGUI]: Include win32.h.
[HAVE_NTGUI] (struct frame_glyphs): Include pixel fields.
@@ -5354,7 +5354,7 @@
See ChangeLog.5 for earlier changes.
- Copyright (C) 1995-1996, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1995-1996, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.7 b/src/ChangeLog.7
index bb18f684242..ce240ab2928 100644
--- a/src/ChangeLog.7
+++ b/src/ChangeLog.7
@@ -331,7 +331,7 @@
1998-07-30 Paul Eggert <eggert@twinsun.com>
- * src/Makefile.in (widget.o, xfns.o, xmenu.o):
+ * Makefile.in (widget.o, xfns.o, xmenu.o):
Prepend $(srcdir)/ to rule dependencies outside this dir.
1998-07-29 Kenichi Handa <handa@etl.go.jp>
@@ -2070,7 +2070,7 @@
(sys_select): Ignore children dead children with pending input.
Delay sending SIGCHLD until all output has been read.
(sys_kill): Sleep to allow focus change events to propagate.
- Use TerminateProcess on Win95.
+ Use TerminateProcess on Windows 95.
(int_from_hex, enum_locale_fn, Fw32_get_valid_locale_ids):
New functions.
(Vw32_valid_locale_ids): New variable.
@@ -4884,14 +4884,13 @@
The new GNU C library strftime needs the underlying host's
strftime for locale dependent formats.
- * configure.in (AC_CHECK_FUNCS): Add strftime.
- * src/config.in (HAVE_STRFTIME): New undef.
- * src/editfns.c (emacs_strftime): New decl.
+ * config.in (HAVE_STRFTIME): New undef.
+ * editfns.c (emacs_strftime): New decl.
(Fformat_time_string): Doc fix: %b, %h, %B, %a, %A, and %p depend on
locale; don't use actual chars to describe %n and %t.
- * src/Makefile.in (strftime.o):
- * src/makefile.nt ($(BLD)\strftime.obj):
+ * Makefile.in (strftime.o):
+ * makefile.nt ($(BLD)\strftime.obj):
No need to compile with -Dstrftime=emacs_strftime any more.
1997-11-22 Richard Stallman <rms@gnu.org>
@@ -5720,13 +5719,13 @@
Loop over handles round robin to ensure fairness.
(sys_kill): Send ctrl-break and ctrl-c keystrokes to subprocesses
on SIGINT if not sharing consoles, otherwise generate ctrl-break event.
- On other termination signals, send WM_QUIT message to Win95 apps
+ On other termination signals, send WM_QUIT message to Windows 95 apps
and WM_CLOSE to NT apps.
(syms_of_ntproc): Intern new symbols. defsubr new functions.
DEFVAR new variables.
- * w32term.c (SIF_*): Win95 macros defined for NT.
- (struct tagSCROLLINFO): Win95 struct defined for NT.
+ * w32term.c (SIF_*): Windows 95 macros defined for NT.
+ (struct tagSCROLLINFO): Windows 95 struct defined for NT.
(vertical_scroll_bar_min_handle, vertical_scroll_bar_top_border)
(vertical_scroll_bar_bottom_border, last_scroll_bar_drag_pos)
(Vw32_gab_focus_on_raise, Vw32_capslock_is_shiftlock):
@@ -11092,7 +11091,7 @@ See ChangeLog.6 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.8 b/src/ChangeLog.8
index 6973717a7d7..e68966b16a2 100644
--- a/src/ChangeLog.8
+++ b/src/ChangeLog.8
@@ -13203,7 +13203,7 @@
* w32.c (stat): GetFileInformationByHandle can legitimately fail,
so don't rely on it succeeding.
- * w32fns.c (x_to_w32_font): Specify DEFAULT_CHARSET in the w32
+ * w32fns.c (x_to_w32_font): Specify DEFAULT_CHARSET in the Windows
LOGFONT struct if x font doesn't specify the charset.
(x_to_w32_charset): Change >= to == when testing results of
stricmp.
@@ -13979,7 +13979,7 @@
See ChangeLog.7 for earlier changes.
- Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.9 b/src/ChangeLog.9
index 6e3a8d8ab3b..d6d772c5f95 100644
--- a/src/ChangeLog.9
+++ b/src/ChangeLog.9
@@ -13294,7 +13294,7 @@ See ChangeLog.8 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/Makefile.in b/src/Makefile.in
index 3be10c388c7..d034ad04796 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -1,6 +1,6 @@
# src/Makefile for GNU Emacs.
-# Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2011
+# Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2012
# Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -40,6 +40,7 @@ version = @version@
# Substitute an assignment for the MAKE variable, because
# BSD doesn't have it as a default.
@SET_MAKE@
+MKDIR_P = @MKDIR_P@
# Don't use LIBS. configure puts stuff in it that either shouldn't be
# linked with Emacs or is duplicated by the other stuff below.
# LIBS = @LIBS@
@@ -49,14 +50,13 @@ lispsource = $(srcdir)/../lisp
lib = ../lib
libsrc = ../lib-src
etc = ../etc
+leimdir = ../leim
oldXMenudir = ../oldXMenu
lwlibdir = ../lwlib
lispdir = ../lisp
# Configuration files for .o files to depend on.
-M_FILE = @M_FILE@
-S_FILE = @S_FILE@
-config_h = config.h $(M_FILE) $(S_FILE)
+config_h = config.h $(srcdir)/conf_post.h
bootstrap_exe = $(abs_builddir)/bootstrap-emacs$(EXEEXT)
@@ -67,23 +67,21 @@ OTHER_FILES = @OTHER_FILES@
PROFILING_CFLAGS = @PROFILING_CFLAGS@
## Flags to pass to the compiler to enable build warnings
-C_WARNINGS_SWITCH = @C_WARNINGS_SWITCH@
+WARN_CFLAGS = @WARN_CFLAGS@
+WERROR_CFLAGS = @WERROR_CFLAGS@
## Machine-specific CFLAGS.
C_SWITCH_MACHINE=@C_SWITCH_MACHINE@
## System-specific CFLAGS.
C_SWITCH_SYSTEM=@C_SWITCH_SYSTEM@
-## Currently only set if NS_IMPL_GNUSTEP.
-## C_SWITCH_X_SITE may override this.
-C_SWITCH_X_SYSTEM=@C_SWITCH_X_SYSTEM@
+GNUSTEP_CFLAGS=@GNUSTEP_CFLAGS@
## Define C_SWITCH_X_SITE to contain any special flags your compiler
## may need to deal with X Windows. For instance, if you've defined
## HAVE_X_WINDOWS and your X include files aren't in a place that your
## compiler can find on its own, you might want to add "-I/..." or
## something similar. This is normally set by configure.
-## This is used before C_SWITCH_X_SYSTEM and may override it.
C_SWITCH_X_SITE=@C_SWITCH_X_SITE@
## Define LD_SWITCH_X_SITE to contain any special flags your loader
@@ -95,11 +93,9 @@ C_SWITCH_X_SITE=@C_SWITCH_X_SITE@
## substituted in this or any other Makefile. Cf C_SWITCH_X_SITE.
LD_SWITCH_X_SITE=
-## Next two must come before LD_SWITCH_SYSTEM.
-## If needed, a -R option that says where to find X windows at run time.
-LD_SWITCH_X_SITE_AUX=@LD_SWITCH_X_SITE_AUX@
-## As above, but using -rpath instead.
-LD_SWITCH_X_SITE_AUX_RPATH=@LD_SWITCH_X_SITE_AUX_RPATH@
+## This must come before LD_SWITCH_SYSTEM.
+## If needed, a -rpath option that says where to find X windows at run time.
+LD_SWITCH_X_SITE_RPATH=@LD_SWITCH_X_SITE_RPATH@
## System-specific LDFLAGS.
LD_SWITCH_SYSTEM=@LD_SWITCH_SYSTEM@
@@ -116,6 +112,12 @@ TEMACS_LDFLAGS = $(LD_SWITCH_SYSTEM) $(LD_SWITCH_SYSTEM_TEMACS)
## $LDFLAGS or empty if NS_IMPL_GNUSTEP (for some reason).
TEMACS_LDFLAGS2 = @TEMACS_LDFLAGS2@
+## If available, the full path to the paxctl program.
+## On grsecurity/PaX systems, unexec will fail due to a gap between
+## the bss section and the heap. This can be prevented by disabling
+## memory randomization in temacs with "paxctl -r". See bug#11398.
+PAXCTL = @PAXCTL@
+
## Some systems define this to request special libraries.
LIBS_SYSTEM=@LIBS_SYSTEM@
@@ -133,13 +135,10 @@ LIB_MATH=@LIB_MATH@
## -lpthreads, or empty.
LIB_PTHREAD=@LIB_PTHREAD@
-LIBTIFF=@LIBTIFF@
-LIBJPEG=@LIBJPEG@
-LIBPNG=@LIBPNG@
-LIBGIF=@LIBGIF@
-LIBXPM=@LIBXPM@
+LIBIMAGE=@LIBTIFF@ @LIBJPEG@ @LIBPNG@ @LIBGIF@ @LIBXPM@
+
XFT_LIBS=@XFT_LIBS@
-LIBX_EXTRA=$(LIBTIFF) $(LIBJPEG) $(LIBPNG) $(LIBGIF) $(LIBXPM) -lX11 $(XFT_LIBS)
+LIBX_EXTRA=-lX11 $(XFT_LIBS)
FONTCONFIG_CFLAGS = @FONTCONFIG_CFLAGS@
FONTCONFIG_LIBS = @FONTCONFIG_LIBS@
@@ -150,11 +149,17 @@ LIBOTF_LIBS = @LIBOTF_LIBS@
M17N_FLT_CFLAGS = @M17N_FLT_CFLAGS@
M17N_FLT_LIBS = @M17N_FLT_LIBS@
+LIB_CLOCK_GETTIME=@LIB_CLOCK_GETTIME@
+LIB_EACCESS=@LIB_EACCESS@
+LIB_TIMER_TIME=@LIB_TIMER_TIME@
+
DBUS_CFLAGS = @DBUS_CFLAGS@
DBUS_LIBS = @DBUS_LIBS@
## dbusbind.o if HAVE_DBUS, else empty.
DBUS_OBJ = @DBUS_OBJ@
+LIB_EXECINFO=@LIB_EXECINFO@
+
SETTINGS_CFLAGS = @SETTINGS_CFLAGS@
SETTINGS_LIBS = @SETTINGS_LIBS@
@@ -205,8 +210,8 @@ LIBXMENU=@LIBXMENU@
## xmenu.o if HAVE_X_WINDOWS, else empty.
XMENU_OBJ=@XMENU_OBJ@
-## xterm.o xfns.o xselect.o xrdb.o fontset.o xsmfns.o fringe.o image.o
-## xsettings.o xgselect.o if HAVE_X_WINDOWS, else empty.
+## xterm.o xfns.o xselect.o xrdb.o xsmfns.o xsettings.o xgselect.o if
+## HAVE_X_WINDOWS, else empty.
XOBJ=@XOBJ@
TOOLKIT_LIBW=@TOOLKIT_LIBW@
@@ -241,20 +246,26 @@ WIDGET_OBJ=@WIDGET_OBJ@
## sheap.o if CYGWIN, otherwise empty.
CYGWIN_OBJ=@CYGWIN_OBJ@
+## fontset.o fringe.o image.o if we have any window system
+WINDOW_SYSTEM_OBJ=@WINDOW_SYSTEM_OBJ@
+
## dosfns.o msdos.o w16select.o if MSDOS.
MSDOS_OBJ =
## w16select.o termcap.o if MSDOS && HAVE_X_WINDOWS.
MSDOS_X_OBJ =
-ns_appdir=@ns_appdir@
-ns_appbindir=@ns_appbindir@
-ns_appsrc=@ns_appsrc@
-## fontset.o fringe.o image.o if HAVE_NS, else empty.
NS_OBJ=@NS_OBJ@
## nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o if HAVE_NS.
NS_OBJC_OBJ=@NS_OBJC_OBJ@
## Only set if NS_IMPL_GNUSTEP.
GNU_OBJC_CFLAGS=@GNU_OBJC_CFLAGS@
+## w32fns.o w32menu.c w32reg.o fringe.o fontset.o w32font.o w32term.o
+## w32xfns.o w32select.o image.o w32uniscribe.o if HAVE_W32, else
+## empty.
+W32_OBJ=@W32_OBJ@
+## -lkernel32 -luser32 -lgdi32 -lole32 -lcomdlg32 lusp10 -lcomctl32
+## --lwinspool if HAVE_W32, else empty.
+W32_LIBS=@W32_LIBS@
## Empty if !HAVE_X_WINDOWS
## xfont.o ftfont.o xftfont.o ftxfont.o if HAVE_XFT
@@ -287,7 +298,7 @@ CANNOT_DUMP=@CANNOT_DUMP@
DEPDIR=deps
## -MMD -MF $(DEPDIR)/$*.d if AUTO_DEPEND; else empty.
DEPFLAGS=@DEPFLAGS@
-## test -d $(DEPDIR) || mkdir $(DEPDIR) (if AUTO_DEPEND); else ':'.
+## ${MKDIR_P} ${DEPDIR} (if AUTO_DEPEND); else ':'.
MKDEPDIR=@MKDEPDIR@
## DO NOT use -R. There is a special hack described in lastfile.c
@@ -298,22 +309,16 @@ MKDEPDIR=@MKDEPDIR@
## -Demacs is needed to make some files produce the correct version
## for use in Emacs.
##
-## -DHAVE_CONFIG_H is needed for some other files to take advantage of
-## the information in `config.h'.
-##
-## C_SWITCH_X_SITE must come before C_SWITCH_X_SYSTEM
-## since it may have -I options that should override those.
-##
## FIXME? MYCPPFLAGS only referenced in etc/DEBUG.
-ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(MYCPPFLAGS) -I. -I$(srcdir) \
+ALL_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \
-I$(lib) -I$(srcdir)/../lib \
$(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \
- $(C_SWITCH_X_SYSTEM) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
+ $(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
$(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \
$(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
$(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) $(PROFILING_CFLAGS) \
$(LIBGNUTLS_CFLAGS) \
- $(C_WARNINGS_SWITCH) $(CFLAGS)
+ $(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS)
ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS)
.SUFFIXES: .m
@@ -340,7 +345,9 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
process.o gnutls.o callproc.o \
region-cache.o sound.o atimer.o \
doprnt.o intervals.o textprop.o composite.o xml.o \
- $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ)
+ profiler.o \
+ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
+ $(W32_OBJ) $(WINDOW_SYSTEM_OBJ)
obj = $(base_obj) $(NS_OBJC_OBJ)
## Object files used on some machine or other.
@@ -349,7 +356,7 @@ obj = $(base_obj) $(NS_OBJC_OBJ)
## in the list, in case they ever add any such entries.
SOME_MACHINE_OBJECTS = dosfns.o msdos.o \
xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o fringe.o image.o \
- fontset.o dbusbind.o \
+ fontset.o dbusbind.o cygw32.o \
nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o \
w32.o w32console.o w32fns.o w32heap.o w32inevt.o \
w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \
@@ -383,8 +390,11 @@ otherobj= $(TERMCAP_OBJ) $(PRE_ALLOC_OBJ) $(GMALLOC_OBJ) $(RALLOC_OBJ) \
## Note that SunOS needs -lm to come before -lc; otherwise, you get
## duplicated symbols. If the standard libraries were compiled
## with GCC, we might need LIB_GCC again after them.
-LIBES = $(LIBS) $(LIBX_BASE) $(LIBX_OTHER) $(LIBSOUND) \
- $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(DBUS_LIBS) \
+LIBES = $(LIBS) $(W32_LIBS) $(LIBX_BASE) $(LIBIMAGE) \
+ $(LIBX_OTHER) $(LIBSOUND) \
+ $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_CLOCK_GETTIME) \
+ $(LIB_EACCESS) $(LIB_TIMER_TIME) $(DBUS_LIBS) \
+ $(LIB_EXECINFO) \
$(LIBXML2_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \
$(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
@@ -392,22 +402,25 @@ LIBES = $(LIBS) $(LIBX_BASE) $(LIBX_OTHER) $(LIBSOUND) \
$(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC)
all: emacs$(EXEEXT) $(OTHER_FILES)
+.PHONY: all
+
+$(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT)
+ cd $(leimdir) && $(MAKE) $(MFLAGS) leim-list.el EMACS=$(bootstrap_exe)
-## Does anyone ever pay attention to the load-path-shadows output here?
## The dumped Emacs is as functional and more efficient than
## bootstrap-emacs, so we replace the latter with the former.
## Strictly speaking, emacs does not depend directly on all of $lisp,
## since not all pieces are used on all platforms. But DOC depends
## on all of $lisp, and emacs depends on DOC, so it is ok to use $lisp here.
-emacs$(EXEEXT): temacs$(EXEEXT) $(etc)/DOC $(lisp)
+emacs$(EXEEXT): temacs$(EXEEXT) $(etc)/DOC $(lisp) $(leimdir)/leim-list.el
if test "$(CANNOT_DUMP)" = "yes"; then \
- ln -f temacs$(EXEEXT) emacs$(EXEEXT); \
- EMACSLOADPATH=$(lispsource) ./emacs -batch \
- -f list-load-path-shadows || true; \
+ rm -f emacs$(EXEEXT); \
+ ln temacs$(EXEEXT) emacs$(EXEEXT); \
else \
LC_ALL=C $(RUN_TEMACS) -batch -l loadup dump || exit 1; \
- ln -f emacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
- ./emacs -batch -f list-load-path-shadows || true; \
+ test "X$(PAXCTL)" = X || $(PAXCTL) -zex emacs$(EXEEXT); \
+ rm -f bootstrap-emacs$(EXEEXT); \
+ ln emacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
fi
## We run make-docfile twice because the command line may get too long
@@ -441,7 +454,7 @@ GLOBAL_SOURCES = $(base_obj:.o=.c) $(NS_OBJC_OBJ:.o=.m)
gl-stamp: $(libsrc)/make-docfile$(EXEEXT) $(GLOBAL_SOURCES)
@rm -f gl-tmp
- $(libsrc)/make-docfile -d $(srcdir) -g $(SOME_MACHINE_OBJECTS) $(obj) > gl-tmp
+ $(libsrc)/make-docfile -d $(srcdir) -g $(obj) > gl-tmp
$(srcdir)/../build-aux/move-if-change gl-tmp globals.h
echo timestamp > $@
@@ -453,6 +466,8 @@ $(lib)/libgnu.a: $(config_h)
temacs$(EXEEXT): $(START_FILES) stamp-oldxmenu $(obj) $(otherobj) $(lib)/libgnu.a
$(CC) $(LD_FIRSTFLAG) $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(TEMACS_LDFLAGS2) \
-o temacs $(START_FILES) $(obj) $(otherobj) $(lib)/libgnu.a $(LIBES)
+ test "$(CANNOT_DUMP)" = "yes" || \
+ test "X$(PAXCTL)" = X || $(PAXCTL) -r temacs$(EXEEXT)
## The following oldxmenu-related rules are only (possibly) used if
## HAVE_X11 && !USE_GTK, but there is no harm in always defining them
@@ -492,9 +507,12 @@ $(OLDXMENU): $(OLDXMENU_TARGET)
doc.o: buildobj.h
-## If HAVE_NS, some ns-specific rules (for OTHER_FILES) are inserted here.
-@ns_frag@
+ns-app: emacs$(EXEEXT)
+ cd ../nextstep && $(MAKE) $(MFLAGS) all
+
+.PHONY: mostlyclean clean bootstrap-clean distclean maintainer-clean
+.PHONY: versionclean extraclean frc
mostlyclean:
rm -f temacs$(EXEEXT) core *.core \#* *.o libXMenu11.a liblw.a
@@ -505,7 +523,6 @@ mostlyclean:
clean: mostlyclean
rm -f emacs-*.*.*$(EXEEXT) emacs$(EXEEXT)
-rm -rf $(DEPDIR)
- test "X$(ns_appdir)" = "X" || rm -rf $(ns_appdir)
## bootstrap-clean is used to clean up just before a bootstrap.
## It should remove all files generated during a compilation/bootstrap,
@@ -536,10 +553,10 @@ extraclean: distclean
ctagsfiles1 = [xyzXYZ]*.[hcm]
ctagsfiles2 = [a-wA-W]*.[hcm]
-TAGS: $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) $(M_FILE) $(S_FILE)
+TAGS: $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) $(S_FILE)
../lib-src/etags --include=TAGS-LISP --include=$(lwlibdir)/TAGS \
--regex='/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/' \
- $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) $(M_FILE) $(S_FILE)
+ $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) $(S_FILE)
frc:
TAGS-LISP: frc
$(MAKE) -f $(lispdir)/Makefile TAGS-LISP ETAGS=../lib-src/etags
@@ -597,9 +614,11 @@ $(lispsource)/loaddefs.el: $(BOOTSTRAPEMACS) $(VCSWITNESS)
bootstrap-emacs$(EXEEXT): temacs$(EXEEXT)
cd ../lisp; $(MAKE) $(MFLAGS) update-subdirs
if test "$(CANNOT_DUMP)" = "yes"; then \
- ln -f temacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
+ rm -f bootstrap-emacs$(EXEEXT); \
+ ln temacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
else \
$(RUN_TEMACS) --batch --load loadup bootstrap || exit 1; \
+ test "X$(PAXCTL)" = X || $(PAXCTL) -zex emacs$(EXEEXT); \
mv -f emacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
fi
@: Compile some files earlier to speed up further compilation.
diff --git a/src/README b/src/README
index f568797a1ea..558710627a7 100644
--- a/src/README
+++ b/src/README
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/src/alloc.c b/src/alloc.c
index 6f70976c345..28c9b51dab4 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1,6 +1,7 @@
/* Storage allocation and gc for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2011
- Free Software Foundation, Inc.
+
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -18,52 +19,58 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+
+#define LISP_INLINE EXTERN_INLINE
+
#include <stdio.h>
#include <limits.h> /* For CHAR_BIT. */
-#include <setjmp.h>
-#include <signal.h>
+#ifdef ENABLE_CHECKING
+#include <signal.h> /* For SIGABRT. */
+#endif
#ifdef HAVE_PTHREAD
#include <pthread.h>
#endif
-/* This file is part of the core Lisp implementation, and thus must
- deal with the real data structures. If the Lisp implementation is
- replaced, this file likely will not be used. */
-
-#undef HIDE_LISP_IMPLEMENTATION
#include "lisp.h"
#include "process.h"
#include "intervals.h"
#include "puresize.h"
+#include "character.h"
#include "buffer.h"
#include "window.h"
#include "keyboard.h"
#include "frame.h"
#include "blockinput.h"
-#include "character.h"
-#include "syssignal.h"
#include "termhooks.h" /* For struct terminal. */
-#include <setjmp.h>
+
#include <verify.h>
+/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects.
+ Doable only if GC_MARK_STACK. */
+#if ! GC_MARK_STACK
+# undef GC_CHECK_MARKED_OBJECTS
+#endif
+
/* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
- memory. Can do this only if using gmalloc.c. */
+ memory. Can do this only if using gmalloc.c and if not checking
+ marked objects. */
-#if defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC
+#if (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC \
+ || defined GC_CHECK_MARKED_OBJECTS)
#undef GC_MALLOC_CHECK
#endif
#include <unistd.h>
-#ifndef HAVE_UNISTD_H
-extern POINTER_TYPE *sbrk ();
-#endif
-
#include <fcntl.h>
+#ifdef USE_GTK
+# include "gtkutil.h"
+#endif
#ifdef WINDOWSNT
#include "w32.h"
+#include "w32heap.h" /* for sbrk */
#endif
#ifdef DOUG_LEA_MALLOC
@@ -75,64 +82,8 @@ extern POINTER_TYPE *sbrk ();
#define MMAP_MAX_AREAS 100000000
-#else /* not DOUG_LEA_MALLOC */
-
-/* The following come from gmalloc.c. */
-
-extern size_t _bytes_used;
-extern size_t __malloc_extra_blocks;
-
#endif /* not DOUG_LEA_MALLOC */
-#if ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT
-#ifdef HAVE_PTHREAD
-
-/* When GTK uses the file chooser dialog, different backends can be loaded
- dynamically. One such a backend is the Gnome VFS backend that gets loaded
- if you run Gnome. That backend creates several threads and also allocates
- memory with malloc.
-
- Also, gconf and gsettings may create several threads.
-
- If Emacs sets malloc hooks (! SYSTEM_MALLOC) and the emacs_blocked_*
- functions below are called from malloc, there is a chance that one
- of these threads preempts the Emacs main thread and the hook variables
- end up in an inconsistent state. So we have a mutex to prevent that (note
- that the backend handles concurrent access to malloc within its own threads
- but Emacs code running in the main thread is not included in that control).
-
- When UNBLOCK_INPUT is called, reinvoke_input_signal may be called. If this
- happens in one of the backend threads we will have two threads that tries
- to run Emacs code at once, and the code is not prepared for that.
- To prevent that, we only call BLOCK/UNBLOCK from the main thread. */
-
-static pthread_mutex_t alloc_mutex;
-
-#define BLOCK_INPUT_ALLOC \
- do \
- { \
- if (pthread_equal (pthread_self (), main_thread)) \
- BLOCK_INPUT; \
- pthread_mutex_lock (&alloc_mutex); \
- } \
- while (0)
-#define UNBLOCK_INPUT_ALLOC \
- do \
- { \
- pthread_mutex_unlock (&alloc_mutex); \
- if (pthread_equal (pthread_self (), main_thread)) \
- UNBLOCK_INPUT; \
- } \
- while (0)
-
-#else /* ! defined HAVE_PTHREAD */
-
-#define BLOCK_INPUT_ALLOC BLOCK_INPUT
-#define UNBLOCK_INPUT_ALLOC UNBLOCK_INPUT
-
-#endif /* ! defined HAVE_PTHREAD */
-#endif /* ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT */
-
/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer
to a struct Lisp_String. */
@@ -144,11 +95,9 @@ static pthread_mutex_t alloc_mutex;
#define VECTOR_UNMARK(V) ((V)->header.size &= ~ARRAY_MARK_FLAG)
#define VECTOR_MARKED_P(V) (((V)->header.size & ARRAY_MARK_FLAG) != 0)
-/* Value is the number of bytes of S, a pointer to a struct Lisp_String.
- Be careful during GC, because S->size contains the mark bit for
- strings. */
+/* Default value of gc_cons_threshold (see below). */
-#define GC_STRING_BYTES(S) (STRING_BYTES (S))
+#define GC_DEFAULT_THRESHOLD (100000 * word_size)
/* Global variables. */
struct emacs_globals globals;
@@ -166,19 +115,19 @@ EMACS_INT gc_relative_threshold;
EMACS_INT memory_full_cons_threshold;
-/* Nonzero during GC. */
+/* True during GC. */
-int gc_in_progress;
+bool gc_in_progress;
-/* Nonzero means abort if try to GC.
+/* True means abort if try to GC.
This is for code which is written on the assumption that
no GC will happen, so as to verify that assumption. */
-int abort_on_gc;
+bool abort_on_gc;
/* Number of live and free conses etc. */
-static EMACS_INT total_conses, total_markers, total_symbols, total_vector_size;
+static EMACS_INT total_conses, total_markers, total_symbols, total_buffers;
static EMACS_INT total_free_conses, total_free_markers, total_free_symbols;
static EMACS_INT total_free_floats, total_floats;
@@ -193,10 +142,6 @@ static char *spare_memory[7];
#define SPARE_MEMORY (1 << 14)
-/* Number of extra blocks malloc should get when it needs more core. */
-
-static int malloc_hysteresis;
-
/* Initialize it to a nonzero value to force it into data space
(rather than bss space). That way unexec will remap it into text
space (pure), on some systems. We have not implemented the
@@ -216,18 +161,18 @@ static ptrdiff_t pure_size;
static ptrdiff_t pure_bytes_used_before_overflow;
-/* Value is non-zero if P points into pure space. */
+/* True if P points into pure space. */
#define PURE_POINTER_P(P) \
((uintptr_t) (P) - (uintptr_t) purebeg <= pure_size)
-/* Index in pure at which next pure Lisp object will be allocated.. */
+/* Index in pure at which next pure Lisp object will be allocated.. */
-static EMACS_INT pure_bytes_used_lisp;
+static ptrdiff_t pure_bytes_used_lisp;
/* Number of bytes allocated for non-Lisp objects in pure storage. */
-static EMACS_INT pure_bytes_used_non_lisp;
+static ptrdiff_t pure_bytes_used_non_lisp;
/* If nonzero, this is a warning delivered by malloc and not yet
displayed. */
@@ -247,37 +192,39 @@ static char *stack_copy;
static ptrdiff_t stack_copy_size;
#endif
-/* Non-zero means ignore malloc warnings. Set during initialization.
- Currently not used. */
-
-static int ignore_warnings;
-
+static Lisp_Object Qconses;
+static Lisp_Object Qsymbols;
+static Lisp_Object Qmiscs;
+static Lisp_Object Qstrings;
+static Lisp_Object Qvectors;
+static Lisp_Object Qfloats;
+static Lisp_Object Qintervals;
+static Lisp_Object Qbuffers;
+static Lisp_Object Qstring_bytes, Qvector_slots, Qheap;
static Lisp_Object Qgc_cons_threshold;
+Lisp_Object Qautomatic_gc;
Lisp_Object Qchar_table_extra_slots;
/* Hook run after GC has finished. */
static Lisp_Object Qpost_gc_hook;
-static void mark_buffer (Lisp_Object);
static void mark_terminals (void);
static void gc_sweep (void);
-static void mark_glyph_matrix (struct glyph_matrix *);
-static void mark_face_cache (struct face_cache *);
+static Lisp_Object make_pure_vector (ptrdiff_t);
+static void mark_buffer (struct buffer *);
#if !defined REL_ALLOC || defined SYSTEM_MALLOC
static void refill_memory_reserve (void);
#endif
-static struct Lisp_String *allocate_string (void);
static void compact_small_strings (void);
static void free_large_strings (void);
-static void sweep_strings (void);
static void free_misc (Lisp_Object);
extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE;
-/* When scanning the C stack for live Lisp objects, Emacs keeps track
- of what memory allocated via lisp_malloc is intended for what
- purpose. This enumeration specifies the type of memory. */
+/* When scanning the C stack for live Lisp objects, Emacs keeps track of
+ what memory allocated via lisp_malloc and lisp_align_malloc is intended
+ for what purpose. This enumeration specifies the type of memory. */
enum mem_type
{
@@ -288,17 +235,16 @@ enum mem_type
MEM_TYPE_MISC,
MEM_TYPE_SYMBOL,
MEM_TYPE_FLOAT,
- /* We used to keep separate mem_types for subtypes of vectors such as
- process, hash_table, frame, terminal, and window, but we never made
- use of the distinction, so it only caused source-code complexity
- and runtime slowdown. Minor but pointless. */
- MEM_TYPE_VECTORLIKE
+ /* Since all non-bool pseudovectors are small enough to be
+ allocated from vector blocks, this memory type denotes
+ large regular vectors and large bool pseudovectors. */
+ MEM_TYPE_VECTORLIKE,
+ /* Special type to denote vector blocks. */
+ MEM_TYPE_VECTOR_BLOCK,
+ /* Special type to denote reserved memory. */
+ MEM_TYPE_SPARE
};
-static POINTER_TYPE *lisp_align_malloc (size_t, enum mem_type);
-static POINTER_TYPE *lisp_malloc (size_t, enum mem_type);
-
-
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
@@ -314,7 +260,6 @@ static Lisp_Object Vdead;
#ifdef GC_MALLOC_CHECK
enum mem_type allocated_mem_type;
-static int dont_register_blocks;
#endif /* GC_MALLOC_CHECK */
@@ -378,18 +323,19 @@ static void *min_heap_address, *max_heap_address;
static struct mem_node mem_z;
#define MEM_NIL &mem_z
-static struct Lisp_Vector *allocate_vectorlike (EMACS_INT);
-static void lisp_free (POINTER_TYPE *);
+static struct Lisp_Vector *allocate_vectorlike (ptrdiff_t);
+static void lisp_free (void *);
static void mark_stack (void);
-static int live_vector_p (struct mem_node *, void *);
-static int live_buffer_p (struct mem_node *, void *);
-static int live_string_p (struct mem_node *, void *);
-static int live_cons_p (struct mem_node *, void *);
-static int live_symbol_p (struct mem_node *, void *);
-static int live_float_p (struct mem_node *, void *);
-static int live_misc_p (struct mem_node *, void *);
+static bool live_vector_p (struct mem_node *, void *);
+static bool live_buffer_p (struct mem_node *, void *);
+static bool live_string_p (struct mem_node *, void *);
+static bool live_cons_p (struct mem_node *, void *);
+static bool live_symbol_p (struct mem_node *, void *);
+static bool live_float_p (struct mem_node *, void *);
+static bool live_misc_p (struct mem_node *, void *);
static void mark_maybe_object (Lisp_Object);
static void mark_memory (void *, void *);
+#if GC_MARK_STACK || defined GC_MALLOC_CHECK
static void mem_init (void);
static struct mem_node *mem_insert (void *, void *, enum mem_type);
static void mem_insert_fixup (struct mem_node *);
@@ -397,7 +343,8 @@ static void mem_rotate_left (struct mem_node *);
static void mem_rotate_right (struct mem_node *);
static void mem_delete (struct mem_node *);
static void mem_delete_fixup (struct mem_node *);
-static inline struct mem_node *mem_find (void *);
+static struct mem_node *mem_find (void *);
+#endif
#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
@@ -417,22 +364,22 @@ struct gcpro *gcprolist;
/* Addresses of staticpro'd variables. Initialize it to a nonzero
value; otherwise some compilers put it into BSS. */
-#define NSTATICS 0x640
+#define NSTATICS 0x800
static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
/* Index of next unused slot in staticvec. */
-static int staticidx = 0;
+static int staticidx;
-static POINTER_TYPE *pure_alloc (size_t, int);
+static void *pure_alloc (size_t, int);
/* Value is SZ rounded up to the next multiple of ALIGNMENT.
ALIGNMENT must be a power of 2. */
#define ALIGN(ptr, ALIGNMENT) \
- ((POINTER_TYPE *) ((((uintptr_t) (ptr)) + (ALIGNMENT) - 1) \
- & ~((ALIGNMENT) - 1)))
+ ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \
+ & ~ ((ALIGNMENT) - 1)))
@@ -464,7 +411,7 @@ display_malloc_warning (void)
/* Called if we can't allocate relocatable space for a buffer. */
void
-buffer_memory_full (EMACS_INT nbytes)
+buffer_memory_full (ptrdiff_t nbytes)
{
/* If buffers use the relocating allocator, no need to free
spare_memory, because we may have plenty of malloc space left
@@ -482,6 +429,11 @@ buffer_memory_full (EMACS_INT nbytes)
xsignal (Qnil, Vmemory_signal_data);
}
+/* A common multiple of the positive integers A and B. Ideally this
+ would be the least common multiple, but there's no way to do that
+ as a constant expression in C, so do the best that we can easily do. */
+#define COMMON_MULTIPLE(a, b) \
+ ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b))
#ifndef XMALLOC_OVERRUN_CHECK
#define XMALLOC_OVERRUN_CHECK_OVERHEAD 0
@@ -507,20 +459,11 @@ buffer_memory_full (EMACS_INT nbytes)
hold a size_t value and (2) the header size is a multiple of the
alignment that Emacs needs for C types and for USE_LSB_TAG. */
#define XMALLOC_BASE_ALIGNMENT \
- offsetof ( \
- struct { \
- union { long double d; intmax_t i; void *p; } u; \
- char c; \
- }, \
- c)
-#ifdef USE_LSB_TAG
-/* A common multiple of the positive integers A and B. Ideally this
- would be the least common multiple, but there's no way to do that
- as a constant expression in C, so do the best that we can easily do. */
-# define COMMON_MULTIPLE(a, b) \
- ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b))
+ alignof (union { long double d; intmax_t i; void *p; })
+
+#if USE_LSB_TAG
# define XMALLOC_HEADER_ALIGNMENT \
- COMMON_MULTIPLE (1 << GCTYPEBITS, XMALLOC_BASE_ALIGNMENT)
+ COMMON_MULTIPLE (GCALIGNMENT, XMALLOC_BASE_ALIGNMENT)
#else
# define XMALLOC_HEADER_ALIGNMENT XMALLOC_BASE_ALIGNMENT
#endif
@@ -570,39 +513,17 @@ xmalloc_get_size (unsigned char *ptr)
}
-/* The call depth in overrun_check functions. For example, this might happen:
- xmalloc()
- overrun_check_malloc()
- -> malloc -> (via hook)_-> emacs_blocked_malloc
- -> overrun_check_malloc
- call malloc (hooks are NULL, so real malloc is called).
- malloc returns 10000.
- add overhead, return 10016.
- <- (back in overrun_check_malloc)
- add overhead again, return 10032
- xmalloc returns 10032.
-
- (time passes).
-
- xfree(10032)
- overrun_check_free(10032)
- decrease overhead
- free(10016) <- crash, because 10000 is the original pointer. */
-
-static ptrdiff_t check_depth;
-
/* Like malloc, but wraps allocated block with header and trailer. */
-static POINTER_TYPE *
+static void *
overrun_check_malloc (size_t size)
{
register unsigned char *val;
- int overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_OVERHEAD : 0;
- if (SIZE_MAX - overhead < size)
- abort ();
+ if (SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD < size)
+ emacs_abort ();
- val = (unsigned char *) malloc (size + overhead);
- if (val && check_depth == 1)
+ val = malloc (size + XMALLOC_OVERRUN_CHECK_OVERHEAD);
+ if (val)
{
memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
@@ -610,24 +531,21 @@ overrun_check_malloc (size_t size)
memcpy (val + size, xmalloc_overrun_check_trailer,
XMALLOC_OVERRUN_CHECK_SIZE);
}
- --check_depth;
- return (POINTER_TYPE *)val;
+ return val;
}
/* Like realloc, but checks old block for overrun, and wraps new block
with header and trailer. */
-static POINTER_TYPE *
-overrun_check_realloc (POINTER_TYPE *block, size_t size)
+static void *
+overrun_check_realloc (void *block, size_t size)
{
register unsigned char *val = (unsigned char *) block;
- int overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_OVERHEAD : 0;
- if (SIZE_MAX - overhead < size)
- abort ();
+ if (SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD < size)
+ emacs_abort ();
if (val
- && check_depth == 1
&& memcmp (xmalloc_overrun_check_header,
val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
XMALLOC_OVERRUN_CHECK_SIZE) == 0)
@@ -635,15 +553,15 @@ overrun_check_realloc (POINTER_TYPE *block, size_t size)
size_t osize = xmalloc_get_size (val);
if (memcmp (xmalloc_overrun_check_trailer, val + osize,
XMALLOC_OVERRUN_CHECK_SIZE))
- abort ();
+ emacs_abort ();
memset (val + osize, 0, XMALLOC_OVERRUN_CHECK_SIZE);
val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE);
}
- val = (unsigned char *) realloc ((POINTER_TYPE *)val, size + overhead);
+ val = realloc (val, size + XMALLOC_OVERRUN_CHECK_OVERHEAD);
- if (val && check_depth == 1)
+ if (val)
{
memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
@@ -651,20 +569,17 @@ overrun_check_realloc (POINTER_TYPE *block, size_t size)
memcpy (val + size, xmalloc_overrun_check_trailer,
XMALLOC_OVERRUN_CHECK_SIZE);
}
- --check_depth;
- return (POINTER_TYPE *)val;
+ return val;
}
/* Like free, but checks block for overrun. */
static void
-overrun_check_free (POINTER_TYPE *block)
+overrun_check_free (void *block)
{
unsigned char *val = (unsigned char *) block;
- ++check_depth;
if (val
- && check_depth == 1
&& memcmp (xmalloc_overrun_check_header,
val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
XMALLOC_OVERRUN_CHECK_SIZE) == 0)
@@ -672,7 +587,7 @@ overrun_check_free (POINTER_TYPE *block)
size_t osize = xmalloc_get_size (val);
if (memcmp (xmalloc_overrun_check_trailer, val + osize,
XMALLOC_OVERRUN_CHECK_SIZE))
- abort ();
+ emacs_abort ();
#ifdef XMALLOC_CLEAR_FREE_MEMORY
val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
memset (val, 0xff, osize + XMALLOC_OVERRUN_CHECK_OVERHEAD);
@@ -684,7 +599,6 @@ overrun_check_free (POINTER_TYPE *block)
}
free (val);
- --check_depth;
}
#undef malloc
@@ -695,51 +609,96 @@ overrun_check_free (POINTER_TYPE *block)
#define free overrun_check_free
#endif
-#ifdef SYNC_INPUT
-/* When using SYNC_INPUT, we don't call malloc from a signal handler, so
- there's no need to block input around malloc. */
-#define MALLOC_BLOCK_INPUT ((void)0)
-#define MALLOC_UNBLOCK_INPUT ((void)0)
+/* If compiled with XMALLOC_BLOCK_INPUT_CHECK, define a symbol
+ BLOCK_INPUT_IN_MEMORY_ALLOCATORS that is visible to the debugger.
+ If that variable is set, block input while in one of Emacs's memory
+ allocation functions. There should be no need for this debugging
+ option, since signal handlers do not allocate memory, but Emacs
+ formerly allocated memory in signal handlers and this compile-time
+ option remains as a way to help debug the issue should it rear its
+ ugly head again. */
+#ifdef XMALLOC_BLOCK_INPUT_CHECK
+bool block_input_in_memory_allocators EXTERNALLY_VISIBLE;
+static void
+malloc_block_input (void)
+{
+ if (block_input_in_memory_allocators)
+ block_input ();
+}
+static void
+malloc_unblock_input (void)
+{
+ if (block_input_in_memory_allocators)
+ unblock_input ();
+}
+# define MALLOC_BLOCK_INPUT malloc_block_input ()
+# define MALLOC_UNBLOCK_INPUT malloc_unblock_input ()
#else
-#define MALLOC_BLOCK_INPUT BLOCK_INPUT
-#define MALLOC_UNBLOCK_INPUT UNBLOCK_INPUT
+# define MALLOC_BLOCK_INPUT ((void) 0)
+# define MALLOC_UNBLOCK_INPUT ((void) 0)
#endif
+#define MALLOC_PROBE(size) \
+ do { \
+ if (profiler_memory_running) \
+ malloc_probe (size); \
+ } while (0)
+
+
/* Like malloc but check for no memory and block interrupt input.. */
-POINTER_TYPE *
+void *
xmalloc (size_t size)
{
- register POINTER_TYPE *val;
+ void *val;
MALLOC_BLOCK_INPUT;
- val = (POINTER_TYPE *) malloc (size);
+ val = malloc (size);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
memory_full (size);
+ MALLOC_PROBE (size);
return val;
}
+/* Like the above, but zeroes out the memory just allocated. */
+
+void *
+xzalloc (size_t size)
+{
+ void *val;
+
+ MALLOC_BLOCK_INPUT;
+ val = malloc (size);
+ MALLOC_UNBLOCK_INPUT;
+
+ if (!val && size)
+ memory_full (size);
+ memset (val, 0, size);
+ MALLOC_PROBE (size);
+ return val;
+}
/* Like realloc but check for no memory and block interrupt input.. */
-POINTER_TYPE *
-xrealloc (POINTER_TYPE *block, size_t size)
+void *
+xrealloc (void *block, size_t size)
{
- register POINTER_TYPE *val;
+ void *val;
MALLOC_BLOCK_INPUT;
/* We must call malloc explicitly when BLOCK is 0, since some
reallocs don't do this. */
if (! block)
- val = (POINTER_TYPE *) malloc (size);
+ val = malloc (size);
else
- val = (POINTER_TYPE *) realloc (block, size);
+ val = realloc (block, size);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
memory_full (size);
+ MALLOC_PROBE (size);
return val;
}
@@ -747,7 +706,7 @@ xrealloc (POINTER_TYPE *block, size_t size)
/* Like free but block interrupt input. */
void
-xfree (POINTER_TYPE *block)
+xfree (void *block)
{
if (!block)
return;
@@ -755,8 +714,7 @@ xfree (POINTER_TYPE *block)
free (block);
MALLOC_UNBLOCK_INPUT;
/* We don't call refill_memory_reserve here
- because that duplicates doing so in emacs_blocked_free
- and the criterion should go there. */
+ because in practice the call in r_alloc_free seems to suffice. */
}
@@ -772,7 +730,7 @@ verify (INT_MAX <= PTRDIFF_MAX);
void *
xnmalloc (ptrdiff_t nitems, ptrdiff_t item_size)
{
- xassert (0 <= nitems && 0 < item_size);
+ eassert (0 <= nitems && 0 < item_size);
if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
memory_full (SIZE_MAX);
return xmalloc (nitems * item_size);
@@ -785,7 +743,7 @@ xnmalloc (ptrdiff_t nitems, ptrdiff_t item_size)
void *
xnrealloc (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
{
- xassert (0 <= nitems && 0 < item_size);
+ eassert (0 <= nitems && 0 < item_size);
if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
memory_full (SIZE_MAX);
return xrealloc (pa, nitems * item_size);
@@ -835,7 +793,7 @@ xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
ptrdiff_t nitems_incr_max = n_max - n;
ptrdiff_t incr = max (nitems_incr_min, min (incr_estimate, nitems_incr_max));
- xassert (0 < item_size && 0 < nitems_incr_min && 0 <= n && -1 <= nitems_max);
+ eassert (0 < item_size && 0 < nitems_incr_min && 0 <= n && -1 <= nitems_max);
if (! pa)
*nitems = 0;
if (nitems_incr_max < incr)
@@ -853,7 +811,7 @@ char *
xstrdup (const char *s)
{
size_t len = strlen (s) + 1;
- char *p = (char *) xmalloc (len);
+ char *p = xmalloc (len);
memcpy (p, s, len);
return p;
}
@@ -873,16 +831,26 @@ safe_alloca_unwind (Lisp_Object arg)
return Qnil;
}
+/* Return a newly allocated memory block of SIZE bytes, remembering
+ to free it when unwinding. */
+void *
+record_xmalloc (size_t size)
+{
+ void *p = xmalloc (size);
+ record_unwind_protect (safe_alloca_unwind, make_save_value (p, 0));
+ return p;
+}
+
/* Like malloc but used for allocating Lisp data. NBYTES is the
number of bytes to allocate, TYPE describes the intended use of the
allocated memory block (for strings, for conses, ...). */
-#ifndef USE_LSB_TAG
-static void *lisp_malloc_loser;
+#if ! USE_LSB_TAG
+void *lisp_malloc_loser EXTERNALLY_VISIBLE;
#endif
-static POINTER_TYPE *
+static void *
lisp_malloc (size_t nbytes, enum mem_type type)
{
register void *val;
@@ -893,9 +861,9 @@ lisp_malloc (size_t nbytes, enum mem_type type)
allocated_mem_type = type;
#endif
- val = (void *) malloc (nbytes);
+ val = malloc (nbytes);
-#ifndef USE_LSB_TAG
+#if ! USE_LSB_TAG
/* If the memory just allocated cannot be addressed thru a Lisp
object's pointer, and it needs to be,
that's equivalent to running out of memory. */
@@ -920,6 +888,7 @@ lisp_malloc (size_t nbytes, enum mem_type type)
MALLOC_UNBLOCK_INPUT;
if (!val && nbytes)
memory_full (nbytes);
+ MALLOC_PROBE (nbytes);
return val;
}
@@ -927,7 +896,7 @@ lisp_malloc (size_t nbytes, enum mem_type type)
call to lisp_malloc. */
static void
-lisp_free (POINTER_TYPE *block)
+lisp_free (void *block)
{
MALLOC_BLOCK_INPUT;
free (block);
@@ -937,13 +906,11 @@ lisp_free (POINTER_TYPE *block)
MALLOC_UNBLOCK_INPUT;
}
-/* Allocation of aligned blocks of memory to store Lisp data. */
-/* The entry point is lisp_align_malloc which returns blocks of at most */
-/* BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */
+/***** Allocation of aligned blocks of memory to store Lisp data. *****/
+
+/* The entry point is lisp_align_malloc which returns blocks of at most
+ BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */
-/* Use posix_memalloc if the system has it and we're using the system's
- malloc (because our gmalloc.c routines don't have posix_memalign although
- its memalloc could be used). */
#if defined (HAVE_POSIX_MEMALIGN) && defined (SYSTEM_MALLOC)
#define USE_POSIX_MEMALIGN 1
#endif
@@ -1000,7 +967,7 @@ struct ablocks
struct ablock blocks[ABLOCKS_SIZE];
};
-/* Size of the block requested from malloc or memalign. */
+/* Size of the block requested from malloc or posix_memalign. */
#define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING)
#define ABLOCK_ABASE(block) \
@@ -1025,7 +992,7 @@ static struct ablock *free_ablock;
/* Allocate an aligned block of nbytes.
Alignment is on a multiple of BLOCK_ALIGN and `nbytes' has to be
smaller or equal to BLOCK_BYTES. */
-static POINTER_TYPE *
+static void *
lisp_align_malloc (size_t nbytes, enum mem_type type)
{
void *base, *val;
@@ -1078,7 +1045,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif
-#ifndef USE_LSB_TAG
+#if ! USE_LSB_TAG
/* If the memory just allocated cannot be addressed thru a Lisp
object's pointer, and it needs to be, that's equivalent to
running out of memory. */
@@ -1098,7 +1065,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
#endif
/* Initialize the blocks and put them on the free list.
- Is `base' was not properly aligned, we can't use the last block. */
+ If `base' was not properly aligned, we can't use the last block. */
for (i = 0; i < (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1); i++)
{
abase->blocks[i].abase = abase;
@@ -1127,12 +1094,14 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
MALLOC_UNBLOCK_INPUT;
+ MALLOC_PROBE (nbytes);
+
eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN);
return val;
}
static void
-lisp_align_free (POINTER_TYPE *block)
+lisp_align_free (void *block)
{
struct ablock *ablock = block;
struct ablocks *abase = ABLOCK_ABASE (ablock);
@@ -1145,8 +1114,8 @@ lisp_align_free (POINTER_TYPE *block)
ablock->x.next_free = free_ablock;
free_ablock = ablock;
/* Update busy count. */
- ABLOCKS_BUSY (abase) =
- (struct ablocks *) (-2 + (intptr_t) ABLOCKS_BUSY (abase));
+ ABLOCKS_BUSY (abase)
+ = (struct ablocks *) (-2 + (intptr_t) ABLOCKS_BUSY (abase));
if (2 > (intptr_t) ABLOCKS_BUSY (abase))
{ /* All the blocks are free. */
@@ -1174,267 +1143,6 @@ lisp_align_free (POINTER_TYPE *block)
MALLOC_UNBLOCK_INPUT;
}
-/* Return a new buffer structure allocated from the heap with
- a call to lisp_malloc. */
-
-struct buffer *
-allocate_buffer (void)
-{
- struct buffer *b
- = (struct buffer *) lisp_malloc (sizeof (struct buffer),
- MEM_TYPE_BUFFER);
- XSETPVECTYPESIZE (b, PVEC_BUFFER,
- ((sizeof (struct buffer) + sizeof (EMACS_INT) - 1)
- / sizeof (EMACS_INT)));
- return b;
-}
-
-
-#ifndef SYSTEM_MALLOC
-
-/* Arranging to disable input signals while we're in malloc.
-
- This only works with GNU malloc. To help out systems which can't
- use GNU malloc, all the calls to malloc, realloc, and free
- elsewhere in the code should be inside a BLOCK_INPUT/UNBLOCK_INPUT
- pair; unfortunately, we have no idea what C library functions
- might call malloc, so we can't really protect them unless you're
- using GNU malloc. Fortunately, most of the major operating systems
- can use GNU malloc. */
-
-#ifndef SYNC_INPUT
-/* When using SYNC_INPUT, we don't call malloc from a signal handler, so
- there's no need to block input around malloc. */
-
-#ifndef DOUG_LEA_MALLOC
-extern void * (*__malloc_hook) (size_t, const void *);
-extern void * (*__realloc_hook) (void *, size_t, const void *);
-extern void (*__free_hook) (void *, const void *);
-/* Else declared in malloc.h, perhaps with an extra arg. */
-#endif /* DOUG_LEA_MALLOC */
-static void * (*old_malloc_hook) (size_t, const void *);
-static void * (*old_realloc_hook) (void *, size_t, const void*);
-static void (*old_free_hook) (void*, const void*);
-
-#ifdef DOUG_LEA_MALLOC
-# define BYTES_USED (mallinfo ().uordblks)
-#else
-# define BYTES_USED _bytes_used
-#endif
-
-static size_t bytes_used_when_reconsidered;
-
-/* Value of _bytes_used, when spare_memory was freed. */
-
-static size_t bytes_used_when_full;
-
-/* This function is used as the hook for free to call. */
-
-static void
-emacs_blocked_free (void *ptr, const void *ptr2)
-{
- BLOCK_INPUT_ALLOC;
-
-#ifdef GC_MALLOC_CHECK
- if (ptr)
- {
- struct mem_node *m;
-
- m = mem_find (ptr);
- if (m == MEM_NIL || m->start != ptr)
- {
- fprintf (stderr,
- "Freeing `%p' which wasn't allocated with malloc\n", ptr);
- abort ();
- }
- else
- {
- /* fprintf (stderr, "free %p...%p (%p)\n", m->start, m->end, ptr); */
- mem_delete (m);
- }
- }
-#endif /* GC_MALLOC_CHECK */
-
- __free_hook = old_free_hook;
- free (ptr);
-
- /* If we released our reserve (due to running out of memory),
- and we have a fair amount free once again,
- try to set aside another reserve in case we run out once more. */
- if (! NILP (Vmemory_full)
- /* Verify there is enough space that even with the malloc
- hysteresis this call won't run out again.
- The code here is correct as long as SPARE_MEMORY
- is substantially larger than the block size malloc uses. */
- && (bytes_used_when_full
- > ((bytes_used_when_reconsidered = BYTES_USED)
- + max (malloc_hysteresis, 4) * SPARE_MEMORY)))
- refill_memory_reserve ();
-
- __free_hook = emacs_blocked_free;
- UNBLOCK_INPUT_ALLOC;
-}
-
-
-/* This function is the malloc hook that Emacs uses. */
-
-static void *
-emacs_blocked_malloc (size_t size, const void *ptr)
-{
- void *value;
-
- BLOCK_INPUT_ALLOC;
- __malloc_hook = old_malloc_hook;
-#ifdef DOUG_LEA_MALLOC
- /* Segfaults on my system. --lorentey */
- /* mallopt (M_TOP_PAD, malloc_hysteresis * 4096); */
-#else
- __malloc_extra_blocks = malloc_hysteresis;
-#endif
-
- value = (void *) malloc (size);
-
-#ifdef GC_MALLOC_CHECK
- {
- struct mem_node *m = mem_find (value);
- if (m != MEM_NIL)
- {
- fprintf (stderr, "Malloc returned %p which is already in use\n",
- value);
- fprintf (stderr, "Region in use is %p...%p, %u bytes, type %d\n",
- m->start, m->end, (char *) m->end - (char *) m->start,
- m->type);
- abort ();
- }
-
- if (!dont_register_blocks)
- {
- mem_insert (value, (char *) value + max (1, size), allocated_mem_type);
- allocated_mem_type = MEM_TYPE_NON_LISP;
- }
- }
-#endif /* GC_MALLOC_CHECK */
-
- __malloc_hook = emacs_blocked_malloc;
- UNBLOCK_INPUT_ALLOC;
-
- /* fprintf (stderr, "%p malloc\n", value); */
- return value;
-}
-
-
-/* This function is the realloc hook that Emacs uses. */
-
-static void *
-emacs_blocked_realloc (void *ptr, size_t size, const void *ptr2)
-{
- void *value;
-
- BLOCK_INPUT_ALLOC;
- __realloc_hook = old_realloc_hook;
-
-#ifdef GC_MALLOC_CHECK
- if (ptr)
- {
- struct mem_node *m = mem_find (ptr);
- if (m == MEM_NIL || m->start != ptr)
- {
- fprintf (stderr,
- "Realloc of %p which wasn't allocated with malloc\n",
- ptr);
- abort ();
- }
-
- mem_delete (m);
- }
-
- /* fprintf (stderr, "%p -> realloc\n", ptr); */
-
- /* Prevent malloc from registering blocks. */
- dont_register_blocks = 1;
-#endif /* GC_MALLOC_CHECK */
-
- value = (void *) realloc (ptr, size);
-
-#ifdef GC_MALLOC_CHECK
- dont_register_blocks = 0;
-
- {
- struct mem_node *m = mem_find (value);
- if (m != MEM_NIL)
- {
- fprintf (stderr, "Realloc returns memory that is already in use\n");
- abort ();
- }
-
- /* Can't handle zero size regions in the red-black tree. */
- mem_insert (value, (char *) value + max (size, 1), MEM_TYPE_NON_LISP);
- }
-
- /* fprintf (stderr, "%p <- realloc\n", value); */
-#endif /* GC_MALLOC_CHECK */
-
- __realloc_hook = emacs_blocked_realloc;
- UNBLOCK_INPUT_ALLOC;
-
- return value;
-}
-
-
-#ifdef HAVE_PTHREAD
-/* Called from Fdump_emacs so that when the dumped Emacs starts, it has a
- normal malloc. Some thread implementations need this as they call
- malloc before main. The pthread_self call in BLOCK_INPUT_ALLOC then
- calls malloc because it is the first call, and we have an endless loop. */
-
-void
-reset_malloc_hooks (void)
-{
- __free_hook = old_free_hook;
- __malloc_hook = old_malloc_hook;
- __realloc_hook = old_realloc_hook;
-}
-#endif /* HAVE_PTHREAD */
-
-
-/* Called from main to set up malloc to use our hooks. */
-
-void
-uninterrupt_malloc (void)
-{
-#ifdef HAVE_PTHREAD
-#ifdef DOUG_LEA_MALLOC
- pthread_mutexattr_t attr;
-
- /* GLIBC has a faster way to do this, but let's keep it portable.
- This is according to the Single UNIX Specification. */
- pthread_mutexattr_init (&attr);
- pthread_mutexattr_settype (&attr, PTHREAD_MUTEX_RECURSIVE);
- pthread_mutex_init (&alloc_mutex, &attr);
-#else /* !DOUG_LEA_MALLOC */
- /* Some systems such as Solaris 2.6 don't have a recursive mutex,
- and the bundled gmalloc.c doesn't require it. */
- pthread_mutex_init (&alloc_mutex, NULL);
-#endif /* !DOUG_LEA_MALLOC */
-#endif /* HAVE_PTHREAD */
-
- if (__free_hook != emacs_blocked_free)
- old_free_hook = __free_hook;
- __free_hook = emacs_blocked_free;
-
- if (__malloc_hook != emacs_blocked_malloc)
- old_malloc_hook = __malloc_hook;
- __malloc_hook = emacs_blocked_malloc;
-
- if (__realloc_hook != emacs_blocked_realloc)
- old_realloc_hook = __realloc_hook;
- __realloc_hook = emacs_blocked_realloc;
-}
-
-#endif /* not SYNC_INPUT */
-#endif /* not SYSTEM_MALLOC */
-
-
/***********************************************************************
Interval Allocation
@@ -1464,7 +1172,7 @@ static struct interval_block *interval_block;
/* Index in interval_block above of the next unused interval
structure. */
-static int interval_block_index;
+static int interval_block_index = INTERVAL_BLOCK_SIZE;
/* Number of free and live intervals. */
@@ -1474,18 +1182,6 @@ static EMACS_INT total_free_intervals, total_intervals;
static INTERVAL interval_free_list;
-
-/* Initialize interval allocation. */
-
-static void
-init_intervals (void)
-{
- interval_block = NULL;
- interval_block_index = INTERVAL_BLOCK_SIZE;
- interval_free_list = 0;
-}
-
-
/* Return a new interval. */
INTERVAL
@@ -1493,8 +1189,6 @@ make_interval (void)
{
INTERVAL val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (interval_free_list)
@@ -1506,14 +1200,13 @@ make_interval (void)
{
if (interval_block_index == INTERVAL_BLOCK_SIZE)
{
- register struct interval_block *newi;
-
- newi = (struct interval_block *) lisp_malloc (sizeof *newi,
- MEM_TYPE_NON_LISP);
+ struct interval_block *newi
+ = lisp_malloc (sizeof *newi, MEM_TYPE_NON_LISP);
newi->next = interval_block;
interval_block = newi;
interval_block_index = 0;
+ total_free_intervals += INTERVAL_BLOCK_SIZE;
}
val = &interval_block->intervals[interval_block_index++];
}
@@ -1522,66 +1215,33 @@ make_interval (void)
consing_since_gc += sizeof (struct interval);
intervals_consed++;
+ total_free_intervals--;
RESET_INTERVAL (val);
val->gcmarkbit = 0;
return val;
}
-/* Mark Lisp objects in interval I. */
+/* Mark Lisp objects in interval I. */
static void
mark_interval (register INTERVAL i, Lisp_Object dummy)
{
- eassert (!i->gcmarkbit); /* Intervals are never shared. */
+ /* Intervals should never be shared. So, if extra internal checking is
+ enabled, GC aborts if it seems to have visited an interval twice. */
+ eassert (!i->gcmarkbit);
i->gcmarkbit = 1;
mark_object (i->plist);
}
-
-/* Mark the interval tree rooted in TREE. Don't call this directly;
- use the macro MARK_INTERVAL_TREE instead. */
-
-static void
-mark_interval_tree (register INTERVAL tree)
-{
- /* No need to test if this tree has been marked already; this
- function is always called through the MARK_INTERVAL_TREE macro,
- which takes care of that. */
-
- traverse_intervals_noorder (tree, mark_interval, Qnil);
-}
-
-
/* Mark the interval tree rooted in I. */
-#define MARK_INTERVAL_TREE(i) \
- do { \
- if (!NULL_INTERVAL_P (i) && !i->gcmarkbit) \
- mark_interval_tree (i); \
+#define MARK_INTERVAL_TREE(i) \
+ do { \
+ if (i && !i->gcmarkbit) \
+ traverse_intervals_noorder (i, mark_interval, Qnil); \
} while (0)
-
-#define UNMARK_BALANCE_INTERVALS(i) \
- do { \
- if (! NULL_INTERVAL_P (i)) \
- (i) = balance_intervals (i); \
- } while (0)
-
-
-/* Number support. If USE_LISP_UNION_TYPE is in effect, we
- can't create number objects in macros. */
-#ifndef make_number
-Lisp_Object
-make_number (EMACS_INT n)
-{
- Lisp_Object obj;
- obj.s.val = n;
- obj.s.type = Lisp_Int;
- return obj;
-}
-#endif
-
/***********************************************************************
String Allocation
***********************************************************************/
@@ -1634,7 +1294,7 @@ struct sdata
#ifdef GC_CHECK_STRING_BYTES
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
unsigned char data[1];
#define SDATA_NBYTES(S) (S)->nbytes
@@ -1649,7 +1309,7 @@ struct sdata
unsigned char data[1];
/* When STRING is null. */
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
} u;
#define SDATA_NBYTES(S) (S)->u.nbytes
@@ -1720,7 +1380,7 @@ static EMACS_INT total_strings, total_free_strings;
/* Number of bytes used by live strings. */
-static EMACS_INT total_string_size;
+static EMACS_INT total_string_bytes;
/* Given a pointer to a Lisp_String S which is on the free-list
string_free_list, return a pointer to its successor in the
@@ -1759,24 +1419,24 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
#define SDATA_SIZE(NBYTES) \
((SDATA_DATA_OFFSET \
+ (NBYTES) + 1 \
- + sizeof (EMACS_INT) - 1) \
- & ~(sizeof (EMACS_INT) - 1))
+ + sizeof (ptrdiff_t) - 1) \
+ & ~(sizeof (ptrdiff_t) - 1))
#else /* not GC_CHECK_STRING_BYTES */
/* The 'max' reserves space for the nbytes union member even when NBYTES + 1 is
less than the size of that member. The 'max' is not needed when
- SDATA_DATA_OFFSET is a multiple of sizeof (EMACS_INT), because then the
+ SDATA_DATA_OFFSET is a multiple of sizeof (ptrdiff_t), because then the
alignment code reserves enough space. */
#define SDATA_SIZE(NBYTES) \
((SDATA_DATA_OFFSET \
- + (SDATA_DATA_OFFSET % sizeof (EMACS_INT) == 0 \
+ + (SDATA_DATA_OFFSET % sizeof (ptrdiff_t) == 0 \
? NBYTES \
- : max (NBYTES, sizeof (EMACS_INT) - 1)) \
+ : max (NBYTES, sizeof (ptrdiff_t) - 1)) \
+ 1 \
- + sizeof (EMACS_INT) - 1) \
- & ~(sizeof (EMACS_INT) - 1))
+ + sizeof (ptrdiff_t) - 1) \
+ & ~(sizeof (ptrdiff_t) - 1))
#endif /* not GC_CHECK_STRING_BYTES */
@@ -1789,23 +1449,19 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
STRING_BYTES_BOUND, nor can it be so long that the size_t
arithmetic in allocate_string_data would overflow while it is
calculating a value to be passed to malloc. */
-#define STRING_BYTES_MAX \
- min (STRING_BYTES_BOUND, \
- ((SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD \
- - GC_STRING_EXTRA \
- - offsetof (struct sblock, first_data) \
- - SDATA_DATA_OFFSET) \
- & ~(sizeof (EMACS_INT) - 1)))
+static ptrdiff_t const STRING_BYTES_MAX =
+ min (STRING_BYTES_BOUND,
+ ((SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD
+ - GC_STRING_EXTRA
+ - offsetof (struct sblock, first_data)
+ - SDATA_DATA_OFFSET)
+ & ~(sizeof (EMACS_INT) - 1)));
/* Initialize string allocation. Called from init_alloc_once. */
static void
init_strings (void)
{
- total_strings = total_free_strings = total_string_size = 0;
- oldest_sblock = current_sblock = large_sblocks = NULL;
- string_blocks = NULL;
- string_free_list = NULL;
empty_unibyte_string = make_pure_string ("", 0, 0, 0);
empty_multibyte_string = make_pure_string ("", 0, 0, 1);
}
@@ -1815,21 +1471,19 @@ init_strings (void)
static int check_string_bytes_count;
-#define CHECK_STRING_BYTES(S) STRING_BYTES (S)
-
-
-/* Like GC_STRING_BYTES, but with debugging check. */
+/* Like STRING_BYTES, but with debugging check. Can be
+ called during GC, so pay attention to the mark bit. */
-EMACS_INT
+ptrdiff_t
string_bytes (struct Lisp_String *s)
{
- EMACS_INT nbytes =
+ ptrdiff_t nbytes =
(s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
if (!PURE_POINTER_P (s)
&& s->data
&& nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
- abort ();
+ emacs_abort ();
return nbytes;
}
@@ -1846,30 +1500,23 @@ check_sblock (struct sblock *b)
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
/* Check that the string size recorded in the string is the
- same as the one recorded in the sdata structure. */
- if (from->string)
- CHECK_STRING_BYTES (from->string);
-
- if (from->string)
- nbytes = GC_STRING_BYTES (from->string);
- else
- nbytes = SDATA_NBYTES (from);
-
- nbytes = SDATA_SIZE (nbytes);
+ same as the one recorded in the sdata structure. */
+ nbytes = SDATA_SIZE (from->string ? string_bytes (from->string)
+ : SDATA_NBYTES (from));
from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
}
}
/* Check validity of Lisp strings' string_bytes member. ALL_P
- non-zero means check all strings, otherwise check only most
+ means check all strings, otherwise check only most
recently allocated strings. Used for hunting a bug. */
static void
-check_string_bytes (int all_p)
+check_string_bytes (bool all_p)
{
if (all_p)
{
@@ -1879,16 +1526,20 @@ check_string_bytes (int all_p)
{
struct Lisp_String *s = b->first_data.string;
if (s)
- CHECK_STRING_BYTES (s);
+ string_bytes (s);
}
for (b = oldest_sblock; b; b = b->next)
check_sblock (b);
}
- else
+ else if (current_sblock)
check_sblock (current_sblock);
}
+#else /* not GC_CHECK_STRING_BYTES */
+
+#define check_string_bytes(all) ((void) 0)
+
#endif /* GC_CHECK_STRING_BYTES */
#ifdef GC_CHECK_STRING_FREE_LIST
@@ -1906,7 +1557,7 @@ check_string_free_list (void)
while (s != NULL)
{
if ((uintptr_t) s < 1024)
- abort ();
+ emacs_abort ();
s = NEXT_FREE_LISP_STRING (s);
}
}
@@ -1921,25 +1572,23 @@ allocate_string (void)
{
struct Lisp_String *s;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
/* If the free-list is empty, allocate a new string_block, and
add all the Lisp_Strings in it to the free-list. */
if (string_free_list == NULL)
{
- struct string_block *b;
+ struct string_block *b = lisp_malloc (sizeof *b, MEM_TYPE_STRING);
int i;
- b = (struct string_block *) lisp_malloc (sizeof *b, MEM_TYPE_STRING);
- memset (b, 0, sizeof *b);
b->next = string_blocks;
string_blocks = b;
for (i = STRING_BLOCK_SIZE - 1; i >= 0; --i)
{
s = b->strings + i;
+ /* Every string on a free list should have NULL data pointer. */
+ s->data = NULL;
NEXT_FREE_LISP_STRING (s) = string_free_list;
string_free_list = s;
}
@@ -1955,9 +1604,6 @@ allocate_string (void)
MALLOC_UNBLOCK_INPUT;
- /* Probably not strictly necessary, but play it safe. */
- memset (s, 0, sizeof *s);
-
--total_free_strings;
++total_strings;
++strings_consed;
@@ -1992,7 +1638,7 @@ allocate_string_data (struct Lisp_String *s,
{
struct sdata *data, *old_data;
struct sblock *b;
- EMACS_INT needed, old_nbytes;
+ ptrdiff_t needed, old_nbytes;
if (STRING_BYTES_MAX < nbytes)
string_overflow ();
@@ -2000,8 +1646,13 @@ allocate_string_data (struct Lisp_String *s,
/* Determine the number of bytes needed to store NBYTES bytes
of string data. */
needed = SDATA_SIZE (nbytes);
- old_data = s->data ? SDATA_OF_STRING (s) : NULL;
- old_nbytes = GC_STRING_BYTES (s);
+ if (s->data)
+ {
+ old_data = SDATA_OF_STRING (s);
+ old_nbytes = STRING_BYTES (s);
+ }
+ else
+ old_data = NULL;
MALLOC_BLOCK_INPUT;
@@ -2022,7 +1673,7 @@ allocate_string_data (struct Lisp_String *s,
mallopt (M_MMAP_MAX, 0);
#endif
- b = (struct sblock *) lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);
+ b = lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);
#ifdef DOUG_LEA_MALLOC
/* Back to a reasonable maximum of mmap'ed areas. */
@@ -2040,7 +1691,7 @@ allocate_string_data (struct Lisp_String *s,
< (needed + GC_STRING_EXTRA)))
{
/* Not enough room in the current sblock. */
- b = (struct sblock *) lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP);
+ b = lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP);
b->next_free = &b->first_data;
b->first_data.string = NULL;
b->next = NULL;
@@ -2072,9 +1723,9 @@ allocate_string_data (struct Lisp_String *s,
GC_STRING_OVERRUN_COOKIE_SIZE);
#endif
- /* If S had already data assigned, mark that as free by setting its
- string back-pointer to null, and recording the size of the data
- in it. */
+ /* Note that Faset may call to this function when S has already data
+ assigned. In this case, mark data as free by setting it's string
+ back-pointer to null, and record the size of the data in it. */
if (old_data)
{
SDATA_NBYTES (old_data) = old_nbytes;
@@ -2095,7 +1746,7 @@ sweep_strings (void)
string_free_list = NULL;
total_strings = total_free_strings = 0;
- total_string_size = 0;
+ total_string_bytes = 0;
/* Scan strings_blocks, free Lisp_Strings that aren't marked. */
for (b = string_blocks; b; b = next)
@@ -2117,11 +1768,11 @@ sweep_strings (void)
/* String is live; unmark it and its intervals. */
UNMARK_STRING (s);
- if (!NULL_INTERVAL_P (s->intervals))
- UNMARK_BALANCE_INTERVALS (s->intervals);
+ /* Do not use string_(set|get)_intervals here. */
+ s->intervals = balance_intervals (s->intervals);
++total_strings;
- total_string_size += STRING_BYTES (s);
+ total_string_bytes += STRING_BYTES (s);
}
else
{
@@ -2132,10 +1783,10 @@ sweep_strings (void)
how large that is. Reset the sdata's string
back-pointer so that we know it's free. */
#ifdef GC_CHECK_STRING_BYTES
- if (GC_STRING_BYTES (s) != SDATA_NBYTES (data))
- abort ();
+ if (string_bytes (s) != SDATA_NBYTES (data))
+ emacs_abort ();
#else
- data->u.nbytes = GC_STRING_BYTES (s);
+ data->u.nbytes = STRING_BYTES (s);
#endif
data->string = NULL;
@@ -2231,29 +1882,24 @@ compact_small_strings (void)
for (b = oldest_sblock; b; b = b->next)
{
end = b->next_free;
- xassert ((char *) end <= (char *) b + SBLOCK_SIZE);
+ eassert ((char *) end <= (char *) b + SBLOCK_SIZE);
for (from = &b->first_data; from < end; from = from_end)
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
+ struct Lisp_String *s = from->string;
#ifdef GC_CHECK_STRING_BYTES
/* Check that the string size recorded in the string is the
same as the one recorded in the sdata structure. */
- if (from->string
- && GC_STRING_BYTES (from->string) != SDATA_NBYTES (from))
- abort ();
+ if (s && string_bytes (s) != SDATA_NBYTES (from))
+ emacs_abort ();
#endif /* GC_CHECK_STRING_BYTES */
- if (from->string)
- nbytes = GC_STRING_BYTES (from->string);
- else
- nbytes = SDATA_NBYTES (from);
-
- if (nbytes > LARGE_STRING_BYTES)
- abort ();
+ nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from);
+ eassert (nbytes <= LARGE_STRING_BYTES);
nbytes = SDATA_SIZE (nbytes);
from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
@@ -2262,11 +1908,11 @@ compact_small_strings (void)
if (memcmp (string_overrun_cookie,
(char *) from_end - GC_STRING_OVERRUN_COOKIE_SIZE,
GC_STRING_OVERRUN_COOKIE_SIZE))
- abort ();
+ emacs_abort ();
#endif
- /* FROM->string non-null means it's alive. Copy its data. */
- if (from->string)
+ /* Non-NULL S means it's alive. Copy its data. */
+ if (s)
{
/* If TB is full, proceed with the next sblock. */
to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
@@ -2282,7 +1928,7 @@ compact_small_strings (void)
/* Copy, and update the string's `data' pointer. */
if (from != to)
{
- xassert (tb != b || to < from);
+ eassert (tb != b || to < from);
memmove (to, from, nbytes + GC_STRING_EXTRA);
to->string->data = SDATA_DATA (to);
}
@@ -2367,34 +2013,35 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
{
register Lisp_Object val;
struct Lisp_Bool_Vector *p;
- EMACS_INT length_in_chars, length_in_elts;
+ ptrdiff_t length_in_chars;
+ EMACS_INT length_in_elts;
int bits_per_value;
+ int extra_bool_elts = ((bool_header_size - header_size + word_size - 1)
+ / word_size);
CHECK_NATNUM (length);
bits_per_value = sizeof (EMACS_INT) * BOOL_VECTOR_BITS_PER_CHAR;
length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
- length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
- /* We must allocate one more elements than LENGTH_IN_ELTS for the
- slot `size' of the struct Lisp_Bool_Vector. */
- val = Fmake_vector (make_number (length_in_elts + 1), Qnil);
+ val = Fmake_vector (make_number (length_in_elts + extra_bool_elts), Qnil);
/* No Lisp_Object to trace in there. */
- XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0);
+ XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0);
p = XBOOL_VECTOR (val);
p->size = XFASTINT (length);
+ length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR);
if (length_in_chars)
{
memset (p->data, ! NILP (init) ? -1 : 0, length_in_chars);
/* Clear any extraneous bits in the last byte. */
p->data[length_in_chars - 1]
- &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
+ &= (1 << ((XFASTINT (length) - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1)) - 1;
}
return val;
@@ -2406,10 +2053,10 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
multibyte, depending on the contents. */
Lisp_Object
-make_string (const char *contents, EMACS_INT nbytes)
+make_string (const char *contents, ptrdiff_t nbytes)
{
register Lisp_Object val;
- EMACS_INT nchars, multibyte_nbytes;
+ ptrdiff_t nchars, multibyte_nbytes;
parse_str_as_multibyte ((const unsigned char *) contents, nbytes,
&nchars, &multibyte_nbytes);
@@ -2426,7 +2073,7 @@ make_string (const char *contents, EMACS_INT nbytes)
/* Make an unibyte string from LENGTH bytes at CONTENTS. */
Lisp_Object
-make_unibyte_string (const char *contents, EMACS_INT length)
+make_unibyte_string (const char *contents, ptrdiff_t length)
{
register Lisp_Object val;
val = make_uninit_string (length);
@@ -2440,7 +2087,7 @@ make_unibyte_string (const char *contents, EMACS_INT length)
Lisp_Object
make_multibyte_string (const char *contents,
- EMACS_INT nchars, EMACS_INT nbytes)
+ ptrdiff_t nchars, ptrdiff_t nbytes)
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
@@ -2454,7 +2101,7 @@ make_multibyte_string (const char *contents,
Lisp_Object
make_string_from_bytes (const char *contents,
- EMACS_INT nchars, EMACS_INT nbytes)
+ ptrdiff_t nchars, ptrdiff_t nbytes)
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
@@ -2472,9 +2119,9 @@ make_string_from_bytes (const char *contents,
Lisp_Object
make_specified_string (const char *contents,
- EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
+ ptrdiff_t nchars, ptrdiff_t nbytes, bool multibyte)
{
- register Lisp_Object val;
+ Lisp_Object val;
if (nchars < 0)
{
@@ -2492,16 +2139,6 @@ make_specified_string (const char *contents,
}
-/* Make a string from the data at STR, treating it as multibyte if the
- data warrants. */
-
-Lisp_Object
-build_string (const char *str)
-{
- return make_string (str, strlen (str));
-}
-
-
/* Return an unibyte Lisp_String set up to hold LENGTH characters
occupying LENGTH bytes. */
@@ -2528,17 +2165,32 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
struct Lisp_String *s;
if (nchars < 0)
- abort ();
+ emacs_abort ();
if (!nbytes)
return empty_multibyte_string;
s = allocate_string ();
+ s->intervals = NULL;
allocate_string_data (s, nchars, nbytes);
XSETSTRING (string, s);
string_chars_consed += nbytes;
return string;
}
+/* Print arguments to BUF according to a FORMAT, then return
+ a Lisp_String initialized with the data from BUF. */
+
+Lisp_Object
+make_formatted_string (char *buf, const char *format, ...)
+{
+ va_list ap;
+ int length;
+
+ va_start (ap, format);
+ length = vsprintf (buf, format, ap);
+ va_end (ap);
+ return make_string (buf, length);
+}
/***********************************************************************
@@ -2598,24 +2250,12 @@ static struct float_block *float_block;
/* Index of first unused Lisp_Float in the current float_block. */
-static int float_block_index;
+static int float_block_index = FLOAT_BLOCK_SIZE;
/* Free-list of Lisp_Floats. */
static struct Lisp_Float *float_free_list;
-
-/* Initialize float allocation. */
-
-static void
-init_float (void)
-{
- float_block = NULL;
- float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block. */
- float_free_list = 0;
-}
-
-
/* Return a new float object with value FLOAT_VALUE. */
Lisp_Object
@@ -2623,8 +2263,6 @@ make_float (double float_value)
{
register Lisp_Object val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (float_free_list)
@@ -2638,14 +2276,13 @@ make_float (double float_value)
{
if (float_block_index == FLOAT_BLOCK_SIZE)
{
- register struct float_block *new;
-
- new = (struct float_block *) lisp_align_malloc (sizeof *new,
- MEM_TYPE_FLOAT);
+ struct float_block *new
+ = lisp_align_malloc (sizeof *new, MEM_TYPE_FLOAT);
new->next = float_block;
memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
float_block = new;
float_block_index = 0;
+ total_free_floats += FLOAT_BLOCK_SIZE;
}
XSETFLOAT (val, &float_block->floats[float_block_index]);
float_block_index++;
@@ -2657,6 +2294,7 @@ make_float (double float_value)
eassert (!FLOAT_MARKED_P (XFLOAT (val)));
consing_since_gc += sizeof (struct Lisp_Float);
floats_consed++;
+ total_free_floats--;
return val;
}
@@ -2671,8 +2309,10 @@ make_float (double float_value)
GC are put on a free list to be reallocated before allocating
any new cons cells from the latest cons_block. */
-#define CONS_BLOCK_SIZE \
- (((BLOCK_BYTES - sizeof (struct cons_block *)) * CHAR_BIT) \
+#define CONS_BLOCK_SIZE \
+ (((BLOCK_BYTES - sizeof (struct cons_block *) \
+ /* The compiler might add padding at the end. */ \
+ - (sizeof (struct Lisp_Cons) - sizeof (int))) * CHAR_BIT) \
/ (sizeof (struct Lisp_Cons) * CHAR_BIT + 1))
#define CONS_BLOCK(fptr) \
@@ -2704,24 +2344,12 @@ static struct cons_block *cons_block;
/* Index of first unused Lisp_Cons in the current block. */
-static int cons_block_index;
+static int cons_block_index = CONS_BLOCK_SIZE;
/* Free-list of Lisp_Cons structures. */
static struct Lisp_Cons *cons_free_list;
-
-/* Initialize cons allocation. */
-
-static void
-init_cons (void)
-{
- cons_block = NULL;
- cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block. */
- cons_free_list = 0;
-}
-
-
/* Explicitly free a cons cell by putting it on the free-list. */
void
@@ -2732,6 +2360,8 @@ free_cons (struct Lisp_Cons *ptr)
ptr->car = Vdead;
#endif
cons_free_list = ptr;
+ consing_since_gc -= sizeof *ptr;
+ total_free_conses++;
}
DEFUN ("cons", Fcons, Scons, 2, 2, 0,
@@ -2740,8 +2370,6 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
{
register Lisp_Object val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (cons_free_list)
@@ -2755,13 +2383,13 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
{
if (cons_block_index == CONS_BLOCK_SIZE)
{
- register struct cons_block *new;
- new = (struct cons_block *) lisp_align_malloc (sizeof *new,
- MEM_TYPE_CONS);
+ struct cons_block *new
+ = lisp_align_malloc (sizeof *new, MEM_TYPE_CONS);
memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
new->next = cons_block;
cons_block = new;
cons_block_index = 0;
+ total_free_conses += CONS_BLOCK_SIZE;
}
XSETCONS (val, &cons_block->conses[cons_block_index]);
cons_block_index++;
@@ -2773,6 +2401,7 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
XSETCDR (val, cdr);
eassert (!CONS_MARKED_P (XCONS (val)));
consing_since_gc += sizeof (struct Lisp_Cons);
+ total_free_conses--;
cons_cells_consed++;
return val;
}
@@ -2825,6 +2454,38 @@ list5 (Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, L
Fcons (arg5, Qnil)))));
}
+/* Make a list of COUNT Lisp_Objects, where ARG is the
+ first one. Allocate conses from pure space if TYPE
+ is CONSTYPE_PURE, or allocate as usual if type is CONSTYPE_HEAP. */
+
+Lisp_Object
+listn (enum constype type, ptrdiff_t count, Lisp_Object arg, ...)
+{
+ va_list ap;
+ ptrdiff_t i;
+ Lisp_Object val, *objp;
+
+ /* Change to SAFE_ALLOCA if you hit this eassert. */
+ eassert (count <= MAX_ALLOCA / word_size);
+
+ objp = alloca (count * word_size);
+ objp[0] = arg;
+ va_start (ap, arg);
+ for (i = 1; i < count; i++)
+ objp[i] = va_arg (ap, Lisp_Object);
+ va_end (ap);
+
+ for (val = Qnil, i = count - 1; i >= 0; i--)
+ {
+ if (type == CONSTYPE_PURE)
+ val = pure_cons (objp[i], val);
+ else if (type == CONSTYPE_HEAP)
+ val = Fcons (objp[i], val);
+ else
+ emacs_abort ();
+ }
+ return val;
+}
DEFUN ("list", Flist, Slist, 0, MANY, 0,
doc: /* Return a newly created list with specified arguments as elements.
@@ -2896,51 +2557,407 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
Vector Allocation
***********************************************************************/
-/* Singly-linked list of all vectors. */
+/* This value is balanced well enough to avoid too much internal overhead
+ for the most common cases; it's not required to be a power of two, but
+ it's expected to be a mult-of-ROUNDUP_SIZE (see below). */
-static struct Lisp_Vector *all_vectors;
+#define VECTOR_BLOCK_SIZE 4096
-/* Handy constants for vectorlike objects. */
+/* Align allocation request sizes to be a multiple of ROUNDUP_SIZE. */
enum
{
- header_size = offsetof (struct Lisp_Vector, contents),
- word_size = sizeof (Lisp_Object)
+ roundup_size = COMMON_MULTIPLE (word_size, USE_LSB_TAG ? GCALIGNMENT : 1)
};
+/* ROUNDUP_SIZE must be a power of 2. */
+verify ((roundup_size & (roundup_size - 1)) == 0);
+
+/* Verify assumptions described above. */
+verify ((VECTOR_BLOCK_SIZE % roundup_size) == 0);
+verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
+
+/* Round up X to nearest mult-of-ROUNDUP_SIZE. */
+
+#define vroundup(x) (((x) + (roundup_size - 1)) & ~(roundup_size - 1))
+
+/* Rounding helps to maintain alignment constraints if USE_LSB_TAG. */
+
+#define VECTOR_BLOCK_BYTES (VECTOR_BLOCK_SIZE - vroundup (sizeof (void *)))
+
+/* Size of the minimal vector allocated from block. */
+
+#define VBLOCK_BYTES_MIN vroundup (sizeof (struct Lisp_Vector))
+
+/* Size of the largest vector allocated from block. */
+
+#define VBLOCK_BYTES_MAX \
+ vroundup ((VECTOR_BLOCK_BYTES / 2) - word_size)
+
+/* We maintain one free list for each possible block-allocated
+ vector size, and this is the number of free lists we have. */
+
+#define VECTOR_MAX_FREE_LIST_INDEX \
+ ((VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) / roundup_size + 1)
+
+/* Common shortcut to advance vector pointer over a block data. */
+
+#define ADVANCE(v, nbytes) ((struct Lisp_Vector *) ((char *) (v) + (nbytes)))
+
+/* Common shortcut to calculate NBYTES-vector index in VECTOR_FREE_LISTS. */
+
+#define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size)
+
+/* Get and set the next field in block-allocated vectorlike objects on
+ the free list. Doing it this way respects C's aliasing rules.
+ We could instead make 'contents' a union, but that would mean
+ changes everywhere that the code uses 'contents'. */
+static struct Lisp_Vector *
+next_in_free_list (struct Lisp_Vector *v)
+{
+ intptr_t i = XLI (v->contents[0]);
+ return (struct Lisp_Vector *) i;
+}
+static void
+set_next_in_free_list (struct Lisp_Vector *v, struct Lisp_Vector *next)
+{
+ v->contents[0] = XIL ((intptr_t) next);
+}
+
+/* Common shortcut to setup vector on a free list. */
+
+#define SETUP_ON_FREE_LIST(v, nbytes, tmp) \
+ do { \
+ (tmp) = ((nbytes - header_size) / word_size); \
+ XSETPVECTYPESIZE (v, PVEC_FREE, 0, (tmp)); \
+ eassert ((nbytes) % roundup_size == 0); \
+ (tmp) = VINDEX (nbytes); \
+ eassert ((tmp) < VECTOR_MAX_FREE_LIST_INDEX); \
+ set_next_in_free_list (v, vector_free_lists[tmp]); \
+ vector_free_lists[tmp] = (v); \
+ total_free_vector_slots += (nbytes) / word_size; \
+ } while (0)
+
+/* This internal type is used to maintain the list of large vectors
+ which are allocated at their own, e.g. outside of vector blocks. */
+
+struct large_vector
+{
+ union {
+ struct large_vector *vector;
+#if USE_LSB_TAG
+ /* We need to maintain ROUNDUP_SIZE alignment for the vector member. */
+ unsigned char c[vroundup (sizeof (struct large_vector *))];
+#endif
+ } next;
+ struct Lisp_Vector v;
+};
+
+/* This internal type is used to maintain an underlying storage
+ for small vectors. */
+
+struct vector_block
+{
+ char data[VECTOR_BLOCK_BYTES];
+ struct vector_block *next;
+};
+
+/* Chain of vector blocks. */
+
+static struct vector_block *vector_blocks;
+
+/* Vector free lists, where NTH item points to a chain of free
+ vectors of the same NBYTES size, so NTH == VINDEX (NBYTES). */
+
+static struct Lisp_Vector *vector_free_lists[VECTOR_MAX_FREE_LIST_INDEX];
+
+/* Singly-linked list of large vectors. */
+
+static struct large_vector *large_vectors;
+
+/* The only vector with 0 slots, allocated from pure space. */
+
+Lisp_Object zero_vector;
+
+/* Number of live vectors. */
+
+static EMACS_INT total_vectors;
+
+/* Total size of live and free vectors, in Lisp_Object units. */
+
+static EMACS_INT total_vector_slots, total_free_vector_slots;
+
+/* Get a new vector block. */
+
+static struct vector_block *
+allocate_vector_block (void)
+{
+ struct vector_block *block = xmalloc (sizeof *block);
+
+#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+ mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES,
+ MEM_TYPE_VECTOR_BLOCK);
+#endif
+
+ block->next = vector_blocks;
+ vector_blocks = block;
+ return block;
+}
+
+/* Called once to initialize vector allocation. */
+
+static void
+init_vectors (void)
+{
+ zero_vector = make_pure_vector (0);
+}
+
+/* Allocate vector from a vector block. */
+
+static struct Lisp_Vector *
+allocate_vector_from_block (size_t nbytes)
+{
+ struct Lisp_Vector *vector;
+ struct vector_block *block;
+ size_t index, restbytes;
+
+ eassert (VBLOCK_BYTES_MIN <= nbytes && nbytes <= VBLOCK_BYTES_MAX);
+ eassert (nbytes % roundup_size == 0);
+
+ /* First, try to allocate from a free list
+ containing vectors of the requested size. */
+ index = VINDEX (nbytes);
+ if (vector_free_lists[index])
+ {
+ vector = vector_free_lists[index];
+ vector_free_lists[index] = next_in_free_list (vector);
+ total_free_vector_slots -= nbytes / word_size;
+ return vector;
+ }
+
+ /* Next, check free lists containing larger vectors. Since
+ we will split the result, we should have remaining space
+ large enough to use for one-slot vector at least. */
+ for (index = VINDEX (nbytes + VBLOCK_BYTES_MIN);
+ index < VECTOR_MAX_FREE_LIST_INDEX; index++)
+ if (vector_free_lists[index])
+ {
+ /* This vector is larger than requested. */
+ vector = vector_free_lists[index];
+ vector_free_lists[index] = next_in_free_list (vector);
+ total_free_vector_slots -= nbytes / word_size;
+
+ /* Excess bytes are used for the smaller vector,
+ which should be set on an appropriate free list. */
+ restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes;
+ eassert (restbytes % roundup_size == 0);
+ SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index);
+ return vector;
+ }
+
+ /* Finally, need a new vector block. */
+ block = allocate_vector_block ();
+
+ /* New vector will be at the beginning of this block. */
+ vector = (struct Lisp_Vector *) block->data;
+
+ /* If the rest of space from this block is large enough
+ for one-slot vector at least, set up it on a free list. */
+ restbytes = VECTOR_BLOCK_BYTES - nbytes;
+ if (restbytes >= VBLOCK_BYTES_MIN)
+ {
+ eassert (restbytes % roundup_size == 0);
+ SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index);
+ }
+ return vector;
+}
+
+/* Nonzero if VECTOR pointer is valid pointer inside BLOCK. */
+
+#define VECTOR_IN_BLOCK(vector, block) \
+ ((char *) (vector) <= (block)->data \
+ + VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN)
+
+/* Return the memory footprint of V in bytes. */
+
+static ptrdiff_t
+vector_nbytes (struct Lisp_Vector *v)
+{
+ ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG;
+
+ if (size & PSEUDOVECTOR_FLAG)
+ {
+ if (PSEUDOVECTOR_TYPEP (&v->header, PVEC_BOOL_VECTOR))
+ size = (bool_header_size
+ + (((struct Lisp_Bool_Vector *) v)->size
+ + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR);
+ else
+ size = (header_size
+ + ((size & PSEUDOVECTOR_SIZE_MASK)
+ + ((size & PSEUDOVECTOR_REST_MASK)
+ >> PSEUDOVECTOR_SIZE_BITS)) * word_size);
+ }
+ else
+ size = header_size + size * word_size;
+ return vroundup (size);
+}
+
+/* Reclaim space used by unmarked vectors. */
+
+static void
+sweep_vectors (void)
+{
+ struct vector_block *block = vector_blocks, **bprev = &vector_blocks;
+ struct large_vector *lv, **lvprev = &large_vectors;
+ struct Lisp_Vector *vector, *next;
+
+ total_vectors = total_vector_slots = total_free_vector_slots = 0;
+ memset (vector_free_lists, 0, sizeof (vector_free_lists));
+
+ /* Looking through vector blocks. */
+
+ for (block = vector_blocks; block; block = *bprev)
+ {
+ bool free_this_block = 0;
+ ptrdiff_t nbytes;
+
+ for (vector = (struct Lisp_Vector *) block->data;
+ VECTOR_IN_BLOCK (vector, block); vector = next)
+ {
+ if (VECTOR_MARKED_P (vector))
+ {
+ VECTOR_UNMARK (vector);
+ total_vectors++;
+ nbytes = vector_nbytes (vector);
+ total_vector_slots += nbytes / word_size;
+ next = ADVANCE (vector, nbytes);
+ }
+ else
+ {
+ ptrdiff_t total_bytes;
+
+ nbytes = vector_nbytes (vector);
+ total_bytes = nbytes;
+ next = ADVANCE (vector, nbytes);
+
+ /* While NEXT is not marked, try to coalesce with VECTOR,
+ thus making VECTOR of the largest possible size. */
+
+ while (VECTOR_IN_BLOCK (next, block))
+ {
+ if (VECTOR_MARKED_P (next))
+ break;
+ nbytes = vector_nbytes (next);
+ total_bytes += nbytes;
+ next = ADVANCE (next, nbytes);
+ }
+
+ eassert (total_bytes % roundup_size == 0);
+
+ if (vector == (struct Lisp_Vector *) block->data
+ && !VECTOR_IN_BLOCK (next, block))
+ /* This block should be freed because all of it's
+ space was coalesced into the only free vector. */
+ free_this_block = 1;
+ else
+ {
+ int tmp;
+ SETUP_ON_FREE_LIST (vector, total_bytes, tmp);
+ }
+ }
+ }
+
+ if (free_this_block)
+ {
+ *bprev = block->next;
+#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+ mem_delete (mem_find (block->data));
+#endif
+ xfree (block);
+ }
+ else
+ bprev = &block->next;
+ }
+
+ /* Sweep large vectors. */
+
+ for (lv = large_vectors; lv; lv = *lvprev)
+ {
+ vector = &lv->v;
+ if (VECTOR_MARKED_P (vector))
+ {
+ VECTOR_UNMARK (vector);
+ total_vectors++;
+ if (vector->header.size & PSEUDOVECTOR_FLAG)
+ {
+ struct Lisp_Bool_Vector *b = (struct Lisp_Bool_Vector *) vector;
+
+ /* All non-bool pseudovectors are small enough to be allocated
+ from vector blocks. This code should be redesigned if some
+ pseudovector type grows beyond VBLOCK_BYTES_MAX. */
+ eassert (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR));
+
+ total_vector_slots
+ += (bool_header_size
+ + ((b->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR)) / word_size;
+ }
+ else
+ total_vector_slots
+ += header_size / word_size + vector->header.size;
+ lvprev = &lv->next.vector;
+ }
+ else
+ {
+ *lvprev = lv->next.vector;
+ lisp_free (lv);
+ }
+ }
+}
+
/* Value is a pointer to a newly allocated Lisp_Vector structure
with room for LEN Lisp_Objects. */
static struct Lisp_Vector *
-allocate_vectorlike (EMACS_INT len)
+allocate_vectorlike (ptrdiff_t len)
{
struct Lisp_Vector *p;
- size_t nbytes;
MALLOC_BLOCK_INPUT;
+ if (len == 0)
+ p = XVECTOR (zero_vector);
+ else
+ {
+ size_t nbytes = header_size + len * word_size;
+
#ifdef DOUG_LEA_MALLOC
- /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
- because mapped region contents are not preserved in
- a dumped Emacs. */
- mallopt (M_MMAP_MAX, 0);
+ /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
+ because mapped region contents are not preserved in
+ a dumped Emacs. */
+ mallopt (M_MMAP_MAX, 0);
#endif
- /* This gets triggered by code which I haven't bothered to fix. --Stef */
- /* eassert (!handling_signal); */
-
- nbytes = header_size + len * word_size;
- p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
+ if (nbytes <= VBLOCK_BYTES_MAX)
+ p = allocate_vector_from_block (vroundup (nbytes));
+ else
+ {
+ struct large_vector *lv
+ = lisp_malloc (sizeof (*lv) + (len - 1) * word_size,
+ MEM_TYPE_VECTORLIKE);
+ lv->next.vector = large_vectors;
+ large_vectors = lv;
+ p = &lv->v;
+ }
#ifdef DOUG_LEA_MALLOC
- /* Back to a reasonable maximum of mmap'ed areas. */
- mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
+ /* Back to a reasonable maximum of mmap'ed areas. */
+ mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif
- consing_since_gc += nbytes;
- vector_cells_consed += len;
-
- p->header.next.vector = all_vectors;
- all_vectors = p;
+ consing_since_gc += nbytes;
+ vector_cells_consed += len;
+ }
MALLOC_UNBLOCK_INPUT;
@@ -2967,63 +2984,90 @@ allocate_vector (EMACS_INT len)
/* Allocate other vector-like structures. */
struct Lisp_Vector *
-allocate_pseudovector (int memlen, int lisplen, EMACS_INT tag)
+allocate_pseudovector (int memlen, int lisplen, enum pvec_type tag)
{
struct Lisp_Vector *v = allocate_vectorlike (memlen);
int i;
+ /* Catch bogus values. */
+ eassert (tag <= PVEC_FONT);
+ eassert (memlen - lisplen <= (1 << PSEUDOVECTOR_REST_BITS) - 1);
+ eassert (lisplen <= (1 << PSEUDOVECTOR_SIZE_BITS) - 1);
+
/* Only the first lisplen slots will be traced normally by the GC. */
for (i = 0; i < lisplen; ++i)
v->contents[i] = Qnil;
- XSETPVECTYPESIZE (v, tag, lisplen);
+ XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen);
return v;
}
+struct buffer *
+allocate_buffer (void)
+{
+ struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER);
+
+ BUFFER_PVEC_INIT (b);
+ /* Put B on the chain of all buffers including killed ones. */
+ b->next = all_buffers;
+ all_buffers = b;
+ /* Note that the rest fields of B are not initialized. */
+ return b;
+}
+
struct Lisp_Hash_Table *
allocate_hash_table (void)
{
return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, count, PVEC_HASH_TABLE);
}
-
struct window *
allocate_window (void)
{
- return ALLOCATE_PSEUDOVECTOR (struct window, current_matrix, PVEC_WINDOW);
-}
+ struct window *w;
+ w = ALLOCATE_PSEUDOVECTOR (struct window, current_matrix, PVEC_WINDOW);
+ /* Users assumes that non-Lisp data is zeroed. */
+ memset (&w->current_matrix, 0,
+ sizeof (*w) - offsetof (struct window, current_matrix));
+ return w;
+}
struct terminal *
allocate_terminal (void)
{
- struct terminal *t = ALLOCATE_PSEUDOVECTOR (struct terminal,
- next_terminal, PVEC_TERMINAL);
- /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */
- memset (&t->next_terminal, 0,
- (char*) (t + 1) - (char*) &t->next_terminal);
+ struct terminal *t;
+ t = ALLOCATE_PSEUDOVECTOR (struct terminal, next_terminal, PVEC_TERMINAL);
+ /* Users assumes that non-Lisp data is zeroed. */
+ memset (&t->next_terminal, 0,
+ sizeof (*t) - offsetof (struct terminal, next_terminal));
return t;
}
struct frame *
allocate_frame (void)
{
- struct frame *f = ALLOCATE_PSEUDOVECTOR (struct frame,
- face_cache, PVEC_FRAME);
- /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */
+ struct frame *f;
+
+ f = ALLOCATE_PSEUDOVECTOR (struct frame, face_cache, PVEC_FRAME);
+ /* Users assumes that non-Lisp data is zeroed. */
memset (&f->face_cache, 0,
- (char *) (f + 1) - (char *) &f->face_cache);
+ sizeof (*f) - offsetof (struct frame, face_cache));
return f;
}
-
struct Lisp_Process *
allocate_process (void)
{
- return ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
-}
+ struct Lisp_Process *p;
+ p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
+ /* Users assumes that non-Lisp data is zeroed. */
+ memset (&p->pid, 0,
+ sizeof (*p) - offsetof (struct Lisp_Process, pid));
+ return p;
+}
DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
doc: /* Return a newly created vector of length LENGTH, with each element being INIT.
@@ -3031,14 +3075,14 @@ See also the function `vector'. */)
(register Lisp_Object length, Lisp_Object init)
{
Lisp_Object vector;
- register EMACS_INT sizei;
- register EMACS_INT i;
+ register ptrdiff_t sizei;
+ register ptrdiff_t i;
register struct Lisp_Vector *p;
CHECK_NATNUM (length);
- sizei = XFASTINT (length);
- p = allocate_vector (sizei);
+ p = allocate_vector (XFASTINT (length));
+ sizei = XFASTINT (length);
for (i = 0; i < sizei; i++)
p->contents[i] = init;
@@ -3065,6 +3109,19 @@ usage: (vector &rest OBJECTS) */)
return val;
}
+void
+make_byte_code (struct Lisp_Vector *v)
+{
+ if (v->header.size > 1 && STRINGP (v->contents[1])
+ && STRING_MULTIBYTE (v->contents[1]))
+ /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
+ earlier because they produced a raw 8-bit string for byte-code
+ and now such a byte-code string is loaded as multibyte while
+ raw 8-bit characters converted to multibyte form. Thus, now we
+ must convert them back to the original unibyte form. */
+ v->contents[1] = Fstring_as_unibyte (v->contents[1]);
+ XSETPVECTYPE (v, PVEC_COMPILED);
+}
DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
doc: /* Create a byte-code object with specified arguments as elements.
@@ -3088,28 +3145,21 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
ptrdiff_t i;
register struct Lisp_Vector *p;
- XSETFASTINT (len, nargs);
- if (!NILP (Vpurify_flag))
- val = make_pure_vector (nargs);
- else
- val = Fmake_vector (len, Qnil);
+ /* We used to purecopy everything here, if purify-flag was set. This worked
+ OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
+ dangerous, since make-byte-code is used during execution to build
+ closures, so any closure built during the preload phase would end up
+ copied into pure space, including its free variables, which is sometimes
+ just wasteful and other times plainly wrong (e.g. those free vars may want
+ to be setcar'd). */
- if (nargs > 1 && STRINGP (args[1]) && STRING_MULTIBYTE (args[1]))
- /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
- earlier because they produced a raw 8-bit string for byte-code
- and now such a byte-code string is loaded as multibyte while
- raw 8-bit characters converted to multibyte form. Thus, now we
- must convert them back to the original unibyte form. */
- args[1] = Fstring_as_unibyte (args[1]);
+ XSETFASTINT (len, nargs);
+ val = Fmake_vector (len, Qnil);
p = XVECTOR (val);
for (i = 0; i < nargs; i++)
- {
- if (!NILP (Vpurify_flag))
- args[i] = Fpurecopy (args[i]);
- p->contents[i] = args[i];
- }
- XSETPVECTYPE (p, PVEC_COMPILED);
+ p->contents[i] = args[i];
+ make_byte_code (p);
XSETCOMPILED (val, p);
return val;
}
@@ -3120,17 +3170,29 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
Symbol Allocation
***********************************************************************/
+/* Like struct Lisp_Symbol, but padded so that the size is a multiple
+ of the required alignment if LSB tags are used. */
+
+union aligned_Lisp_Symbol
+{
+ struct Lisp_Symbol s;
+#if USE_LSB_TAG
+ unsigned char c[(sizeof (struct Lisp_Symbol) + GCALIGNMENT - 1)
+ & -GCALIGNMENT];
+#endif
+};
+
/* Each symbol_block is just under 1020 bytes long, since malloc
really allocates in units of powers of two and uses 4 bytes for its
- own overhead. */
+ own overhead. */
#define SYMBOL_BLOCK_SIZE \
- ((1020 - sizeof (struct symbol_block *)) / sizeof (struct Lisp_Symbol))
+ ((1020 - sizeof (struct symbol_block *)) / sizeof (union aligned_Lisp_Symbol))
struct symbol_block
{
/* Place `symbols' first, to preserve alignment. */
- struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE];
+ union aligned_Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE];
struct symbol_block *next;
};
@@ -3138,27 +3200,15 @@ struct symbol_block
structure in it. */
static struct symbol_block *symbol_block;
-static int symbol_block_index;
+static int symbol_block_index = SYMBOL_BLOCK_SIZE;
/* List of free symbols. */
static struct Lisp_Symbol *symbol_free_list;
-
-/* Initialize symbol allocation. */
-
-static void
-init_symbol (void)
-{
- symbol_block = NULL;
- symbol_block_index = SYMBOL_BLOCK_SIZE;
- symbol_free_list = 0;
-}
-
-
DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
doc: /* Return a newly allocated uninterned symbol whose name is NAME.
-Its value and function definition are void, and its property list is nil. */)
+Its value is void, and its function definition and property list are nil. */)
(Lisp_Object name)
{
register Lisp_Object val;
@@ -3166,8 +3216,6 @@ Its value and function definition are void, and its property list is nil. */)
CHECK_STRING (name);
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (symbol_free_list)
@@ -3179,32 +3227,33 @@ Its value and function definition are void, and its property list is nil. */)
{
if (symbol_block_index == SYMBOL_BLOCK_SIZE)
{
- struct symbol_block *new;
- new = (struct symbol_block *) lisp_malloc (sizeof *new,
- MEM_TYPE_SYMBOL);
+ struct symbol_block *new
+ = lisp_malloc (sizeof *new, MEM_TYPE_SYMBOL);
new->next = symbol_block;
symbol_block = new;
symbol_block_index = 0;
+ total_free_symbols += SYMBOL_BLOCK_SIZE;
}
- XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
+ XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index].s);
symbol_block_index++;
}
MALLOC_UNBLOCK_INPUT;
p = XSYMBOL (val);
- p->xname = name;
- p->plist = Qnil;
+ set_symbol_name (val, name);
+ set_symbol_plist (val, Qnil);
p->redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (p, Qunbound);
- p->function = Qunbound;
- p->next = NULL;
+ set_symbol_function (val, Qnil);
+ set_symbol_next (val, NULL);
p->gcmarkbit = 0;
p->interned = SYMBOL_UNINTERNED;
p->constant = 0;
p->declared_special = 0;
consing_since_gc += sizeof (struct Lisp_Symbol);
symbols_consed++;
+ total_free_symbols--;
return val;
}
@@ -3214,41 +3263,43 @@ Its value and function definition are void, and its property list is nil. */)
Marker (Misc) Allocation
***********************************************************************/
+/* Like union Lisp_Misc, but padded so that its size is a multiple of
+ the required alignment when LSB tags are used. */
+
+union aligned_Lisp_Misc
+{
+ union Lisp_Misc m;
+#if USE_LSB_TAG
+ unsigned char c[(sizeof (union Lisp_Misc) + GCALIGNMENT - 1)
+ & -GCALIGNMENT];
+#endif
+};
+
/* Allocation of markers and other objects that share that structure.
Works like allocation of conses. */
#define MARKER_BLOCK_SIZE \
- ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc))
+ ((1020 - sizeof (struct marker_block *)) / sizeof (union aligned_Lisp_Misc))
struct marker_block
{
/* Place `markers' first, to preserve alignment. */
- union Lisp_Misc markers[MARKER_BLOCK_SIZE];
+ union aligned_Lisp_Misc markers[MARKER_BLOCK_SIZE];
struct marker_block *next;
};
static struct marker_block *marker_block;
-static int marker_block_index;
+static int marker_block_index = MARKER_BLOCK_SIZE;
static union Lisp_Misc *marker_free_list;
-static void
-init_marker (void)
-{
- marker_block = NULL;
- marker_block_index = MARKER_BLOCK_SIZE;
- marker_free_list = 0;
-}
+/* Return a newly allocated Lisp_Misc object of specified TYPE. */
-/* Return a newly allocated Lisp_Misc object, with no substructure. */
-
-Lisp_Object
-allocate_misc (void)
+static Lisp_Object
+allocate_misc (enum Lisp_Misc_Type type)
{
Lisp_Object val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (marker_free_list)
@@ -3260,15 +3311,13 @@ allocate_misc (void)
{
if (marker_block_index == MARKER_BLOCK_SIZE)
{
- struct marker_block *new;
- new = (struct marker_block *) lisp_malloc (sizeof *new,
- MEM_TYPE_MISC);
+ struct marker_block *new = lisp_malloc (sizeof *new, MEM_TYPE_MISC);
new->next = marker_block;
marker_block = new;
marker_block_index = 0;
total_free_markers += MARKER_BLOCK_SIZE;
}
- XSETMISC (val, &marker_block->markers[marker_block_index]);
+ XSETMISC (val, &marker_block->markers[marker_block_index].m);
marker_block_index++;
}
@@ -3277,6 +3326,7 @@ allocate_misc (void)
--total_free_markers;
consing_since_gc += sizeof (union Lisp_Misc);
misc_objects_consed++;
+ XMISCTYPE (val) = type;
XMISCANY (val)->gcmarkbit = 0;
return val;
}
@@ -3289,7 +3339,7 @@ free_misc (Lisp_Object misc)
XMISCTYPE (misc) = Lisp_Misc_Free;
XMISC (misc)->u_free.chain = marker_free_list;
marker_free_list = XMISC (misc);
-
+ consing_since_gc -= sizeof (union Lisp_Misc);
total_free_markers++;
}
@@ -3303,8 +3353,7 @@ make_save_value (void *pointer, ptrdiff_t integer)
register Lisp_Object val;
register struct Lisp_Save_Value *p;
- val = allocate_misc ();
- XMISCTYPE (val) = Lisp_Misc_Save_Value;
+ val = allocate_misc (Lisp_Misc_Save_Value);
p = XSAVE_VALUE (val);
p->pointer = pointer;
p->integer = integer;
@@ -3312,6 +3361,21 @@ make_save_value (void *pointer, ptrdiff_t integer)
return val;
}
+/* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */
+
+Lisp_Object
+build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist)
+{
+ register Lisp_Object overlay;
+
+ overlay = allocate_misc (Lisp_Misc_Overlay);
+ OVERLAY_START (overlay) = start;
+ OVERLAY_END (overlay) = end;
+ set_overlay_plist (overlay, plist);
+ XOVERLAY (overlay)->next = NULL;
+ return overlay;
+}
+
DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
doc: /* Return a newly allocated marker which does not point at any place. */)
(void)
@@ -3319,8 +3383,7 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
register Lisp_Object val;
register struct Lisp_Marker *p;
- val = allocate_misc ();
- XMISCTYPE (val) = Lisp_Misc_Marker;
+ val = allocate_misc (Lisp_Misc_Marker);
p = XMARKER (val);
p->buffer = 0;
p->bytepos = 0;
@@ -3330,6 +3393,32 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
return val;
}
+/* Return a newly allocated marker which points into BUF
+ at character position CHARPOS and byte position BYTEPOS. */
+
+Lisp_Object
+build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos)
+{
+ Lisp_Object obj;
+ struct Lisp_Marker *m;
+
+ /* No dead buffers here. */
+ eassert (BUFFER_LIVE_P (buf));
+
+ /* Every character is at least one byte. */
+ eassert (charpos <= bytepos);
+
+ obj = allocate_misc (Lisp_Misc_Marker);
+ m = XMARKER (obj);
+ m->buffer = buf;
+ m->charpos = charpos;
+ m->bytepos = bytepos;
+ m->insertion_type = 0;
+ m->next = BUF_MARKERS (buf);
+ BUF_MARKERS (buf) = m;
+ return obj;
+}
+
/* Put MARKER back on the free list after using it temporarily. */
void
@@ -3395,7 +3484,7 @@ void
memory_full (size_t nbytes)
{
/* Do not go into hysterics merely because a large request failed. */
- int enough_free_memory = 0;
+ bool enough_free_memory = 0;
if (SPARE_MEMORY < nbytes)
{
void *p;
@@ -3430,12 +3519,6 @@ memory_full (size_t nbytes)
lisp_free (spare_memory[i]);
spare_memory[i] = 0;
}
-
- /* Record the space now used. When it decreases substantially,
- we can refill the memory reserve. */
-#if !defined SYSTEM_MALLOC && !defined SYNC_INPUT
- bytes_used_when_full = BYTES_USED;
-#endif
}
/* This used to call error, but if we've run out of memory, we could
@@ -3455,25 +3538,25 @@ refill_memory_reserve (void)
{
#ifndef SYSTEM_MALLOC
if (spare_memory[0] == 0)
- spare_memory[0] = (char *) malloc (SPARE_MEMORY);
+ spare_memory[0] = malloc (SPARE_MEMORY);
if (spare_memory[1] == 0)
- spare_memory[1] = (char *) lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ spare_memory[1] = lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_SPARE);
if (spare_memory[2] == 0)
- spare_memory[2] = (char *) lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ spare_memory[2] = lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_SPARE);
if (spare_memory[3] == 0)
- spare_memory[3] = (char *) lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ spare_memory[3] = lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_SPARE);
if (spare_memory[4] == 0)
- spare_memory[4] = (char *) lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ spare_memory[4] = lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_SPARE);
if (spare_memory[5] == 0)
- spare_memory[5] = (char *) lisp_malloc (sizeof (struct string_block),
- MEM_TYPE_STRING);
+ spare_memory[5] = lisp_malloc (sizeof (struct string_block),
+ MEM_TYPE_SPARE);
if (spare_memory[6] == 0)
- spare_memory[6] = (char *) lisp_malloc (sizeof (struct string_block),
- MEM_TYPE_STRING);
+ spare_memory[6] = lisp_malloc (sizeof (struct string_block),
+ MEM_TYPE_SPARE);
if (spare_memory[0] && spare_memory[1] && spare_memory[5])
Vmemory_full = Qnil;
#endif
@@ -3512,7 +3595,7 @@ mem_init (void)
/* Value is a pointer to the mem_node containing START. Value is
MEM_NIL if there is no node in the tree containing START. */
-static inline struct mem_node *
+static struct mem_node *
mem_find (void *start)
{
struct mem_node *p;
@@ -3556,7 +3639,7 @@ mem_insert (void *start, void *end, enum mem_type type)
while (c != MEM_NIL)
{
if (start >= c->start && start < c->end)
- abort ();
+ emacs_abort ();
parent = c;
c = start < c->start ? c->left : c->right;
}
@@ -3573,11 +3656,11 @@ mem_insert (void *start, void *end, enum mem_type type)
/* Create a new node. */
#ifdef GC_MALLOC_CHECK
- x = (struct mem_node *) _malloc_internal (sizeof *x);
+ x = malloc (sizeof *x);
if (x == NULL)
- abort ();
+ emacs_abort ();
#else
- x = (struct mem_node *) xmalloc (sizeof *x);
+ x = xmalloc (sizeof *x);
#endif
x->start = start;
x->end = end;
@@ -3797,7 +3880,7 @@ mem_delete (struct mem_node *z)
mem_delete_fixup (x);
#ifdef GC_MALLOC_CHECK
- _free_internal (y);
+ free (y);
#else
xfree (y);
#endif
@@ -3888,7 +3971,7 @@ mem_delete_fixup (struct mem_node *x)
/* Value is non-zero if P is a pointer to a live Lisp string on
the heap. M is a pointer to the mem_block for P. */
-static inline int
+static bool
live_string_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_STRING)
@@ -3911,7 +3994,7 @@ live_string_p (struct mem_node *m, void *p)
/* Value is non-zero if P is a pointer to a live Lisp cons on
the heap. M is a pointer to the mem_block for P. */
-static inline int
+static bool
live_cons_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_CONS)
@@ -3937,7 +4020,7 @@ live_cons_p (struct mem_node *m, void *p)
/* Value is non-zero if P is a pointer to a live Lisp symbol on
the heap. M is a pointer to the mem_block for P. */
-static inline int
+static bool
live_symbol_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_SYMBOL)
@@ -3953,7 +4036,7 @@ live_symbol_p (struct mem_node *m, void *p)
&& offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0])
&& (b != symbol_block
|| offset / sizeof b->symbols[0] < symbol_block_index)
- && !EQ (((struct Lisp_Symbol *) p)->function, Vdead));
+ && !EQ (((struct Lisp_Symbol *)p)->function, Vdead));
}
else
return 0;
@@ -3963,7 +4046,7 @@ live_symbol_p (struct mem_node *m, void *p)
/* Value is non-zero if P is a pointer to a live Lisp float on
the heap. M is a pointer to the mem_block for P. */
-static inline int
+static bool
live_float_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_FLOAT)
@@ -3987,7 +4070,7 @@ live_float_p (struct mem_node *m, void *p)
/* Value is non-zero if P is a pointer to a live Lisp Misc on
the heap. M is a pointer to the mem_block for P. */
-static inline int
+static bool
live_misc_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_MISC)
@@ -4013,24 +4096,49 @@ live_misc_p (struct mem_node *m, void *p)
/* Value is non-zero if P is a pointer to a live vector-like object.
M is a pointer to the mem_block for P. */
-static inline int
+static bool
live_vector_p (struct mem_node *m, void *p)
{
- return (p == m->start && m->type == MEM_TYPE_VECTORLIKE);
+ if (m->type == MEM_TYPE_VECTOR_BLOCK)
+ {
+ /* This memory node corresponds to a vector block. */
+ struct vector_block *block = (struct vector_block *) m->start;
+ struct Lisp_Vector *vector = (struct Lisp_Vector *) block->data;
+
+ /* P is in the block's allocation range. Scan the block
+ up to P and see whether P points to the start of some
+ vector which is not on a free list. FIXME: check whether
+ some allocation patterns (probably a lot of short vectors)
+ may cause a substantial overhead of this loop. */
+ while (VECTOR_IN_BLOCK (vector, block)
+ && vector <= (struct Lisp_Vector *) p)
+ {
+ if (!PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) && vector == p)
+ return 1;
+ else
+ vector = ADVANCE (vector, vector_nbytes (vector));
+ }
+ }
+ else if (m->type == MEM_TYPE_VECTORLIKE
+ && (char *) p == ((char *) m->start
+ + offsetof (struct large_vector, v)))
+ /* This memory node corresponds to a large vector. */
+ return 1;
+ return 0;
}
/* Value is non-zero if P is a pointer to a live buffer. M is a
pointer to the mem_block for P. */
-static inline int
+static bool
live_buffer_p (struct mem_node *m, void *p)
{
/* P must point to the start of the block, and the buffer
must not have been killed. */
return (m->type == MEM_TYPE_BUFFER
&& p == m->start
- && !NILP (((struct buffer *) p)->BUFFER_INTERNAL_FIELD (name)));
+ && !NILP (((struct buffer *) p)->INTERNAL_FIELD (name)));
}
#endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */
@@ -4089,7 +4197,7 @@ DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "",
/* Mark OBJ if we can prove it's a Lisp_Object. */
-static inline void
+static void
mark_maybe_object (Lisp_Object obj)
{
void *po;
@@ -4103,7 +4211,7 @@ mark_maybe_object (Lisp_Object obj)
if (m != MEM_NIL)
{
- int mark_p = 0;
+ bool mark_p = 0;
switch (XTYPE (obj))
{
@@ -4158,19 +4266,15 @@ mark_maybe_object (Lisp_Object obj)
/* If P points to Lisp data, mark that as live if it isn't already
marked. */
-static inline void
+static void
mark_maybe_pointer (void *p)
{
struct mem_node *m;
- /* Quickly rule out some values which can't point to Lisp data. */
- if ((intptr_t) p %
-#ifdef USE_LSB_TAG
- 8 /* USE_LSB_TAG needs Lisp data to be aligned on multiples of 8. */
-#else
- 2 /* We assume that Lisp data is aligned on even addresses. */
-#endif
- )
+ /* Quickly rule out some values which can't point to Lisp data.
+ USE_LSB_TAG needs Lisp data to be aligned on multiples of GCALIGNMENT.
+ Otherwise, assume that Lisp data is aligned on even addresses. */
+ if ((intptr_t) p % (USE_LSB_TAG ? GCALIGNMENT : 2))
return;
m = mem_find (p);
@@ -4181,6 +4285,7 @@ mark_maybe_pointer (void *p)
switch (m->type)
{
case MEM_TYPE_NON_LISP:
+ case MEM_TYPE_SPARE:
/* Nothing to do; not a pointer to Lisp memory. */
break;
@@ -4216,6 +4321,7 @@ mark_maybe_pointer (void *p)
break;
case MEM_TYPE_VECTORLIKE:
+ case MEM_TYPE_VECTOR_BLOCK:
if (live_vector_p (m, p))
{
Lisp_Object tem;
@@ -4226,7 +4332,7 @@ mark_maybe_pointer (void *p)
break;
default:
- abort ();
+ emacs_abort ();
}
if (!NILP (obj))
@@ -4235,23 +4341,46 @@ mark_maybe_pointer (void *p)
}
-/* Alignment of Lisp_Object and pointer values. Use offsetof, as it
- sometimes returns a smaller alignment than GCC's __alignof__ and
- mark_memory might miss objects if __alignof__ were used. For
- example, on x86 with WIDE_EMACS_INT, __alignof__ (Lisp_Object) is 8
- but GC_LISP_OBJECT_ALIGNMENT should be 4. */
-#ifndef GC_LISP_OBJECT_ALIGNMENT
-# define GC_LISP_OBJECT_ALIGNMENT offsetof (struct {char a; Lisp_Object b;}, b)
+/* Alignment of pointer values. Use alignof, as it sometimes returns
+ a smaller alignment than GCC's __alignof__ and mark_memory might
+ miss objects if __alignof__ were used. */
+#define GC_POINTER_ALIGNMENT alignof (void *)
+
+/* Define POINTERS_MIGHT_HIDE_IN_OBJECTS to 1 if marking via C pointers does
+ not suffice, which is the typical case. A host where a Lisp_Object is
+ wider than a pointer might allocate a Lisp_Object in non-adjacent halves.
+ If USE_LSB_TAG, the bottom half is not a valid pointer, but it should
+ suffice to widen it to to a Lisp_Object and check it that way. */
+#if USE_LSB_TAG || VAL_MAX < UINTPTR_MAX
+# if !USE_LSB_TAG && VAL_MAX < UINTPTR_MAX >> GCTYPEBITS
+ /* If tag bits straddle pointer-word boundaries, neither mark_maybe_pointer
+ nor mark_maybe_object can follow the pointers. This should not occur on
+ any practical porting target. */
+# error "MSB type bits straddle pointer-word boundaries"
+# endif
+ /* Marking via C pointers does not suffice, because Lisp_Objects contain
+ pointer words that hold pointers ORed with type bits. */
+# define POINTERS_MIGHT_HIDE_IN_OBJECTS 1
+#else
+ /* Marking via C pointers suffices, because Lisp_Objects contain pointer
+ words that hold unmodified pointers. */
+# define POINTERS_MIGHT_HIDE_IN_OBJECTS 0
#endif
-#define GC_POINTER_ALIGNMENT offsetof (struct {char a; void *b;}, b)
/* Mark Lisp objects referenced from the address range START+OFFSET..END
or END+OFFSET..START. */
static void
mark_memory (void *start, void *end)
+#if defined (__clang__) && defined (__has_feature)
+#if __has_feature(address_sanitizer)
+ /* Do not allow -faddress-sanitizer to check this function, since it
+ crosses the function stack boundary, and thus would yield many
+ false positives. */
+ __attribute__((no_address_safety_analysis))
+#endif
+#endif
{
- Lisp_Object *p;
void **pp;
int i;
@@ -4268,11 +4397,6 @@ mark_memory (void *start, void *end)
end = tem;
}
- /* Mark Lisp_Objects. */
- for (p = start; (void *) p < end; p++)
- for (i = 0; i < sizeof *p; i += GC_LISP_OBJECT_ALIGNMENT)
- mark_maybe_object (*(Lisp_Object *) ((char *) p + i));
-
/* Mark Lisp data pointed to. This is necessary because, in some
situations, the C compiler optimizes Lisp objects away, so that
only a pointer to them remains. Example:
@@ -4293,7 +4417,12 @@ mark_memory (void *start, void *end)
for (pp = start; (void *) pp < end; pp++)
for (i = 0; i < sizeof *pp; i += GC_POINTER_ALIGNMENT)
- mark_maybe_pointer (*(void **) ((char *) pp + i));
+ {
+ void *p = *(void **) ((char *) pp + i);
+ mark_maybe_pointer (p);
+ if (POINTERS_MIGHT_HIDE_IN_OBJECTS)
+ mark_maybe_object (XIL ((intptr_t) p));
+ }
}
/* setjmp will work with GCC unless NON_SAVING_SETJMP is defined in
@@ -4303,7 +4432,8 @@ mark_memory (void *start, void *end)
#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
-static int setjmp_tested_p, longjmps_done;
+static bool setjmp_tested_p;
+static int longjmps_done;
#define SETJMP_WILL_LIKELY_WORK "\
\n\
@@ -4346,15 +4476,14 @@ test_setjmp (void)
{
char buf[10];
register int x;
- jmp_buf jbuf;
- int result = 0;
+ sys_jmp_buf jbuf;
/* Arrange for X to be put in a register. */
sprintf (buf, "1");
x = strlen (buf);
x = 2 * x - 1;
- setjmp (jbuf);
+ sys_setjmp (jbuf);
if (longjmps_done == 1)
{
/* Came here after the longjmp at the end of the function.
@@ -4379,7 +4508,7 @@ test_setjmp (void)
++longjmps_done;
x = 2;
if (longjmps_done == 1)
- longjmp (jbuf, 1);
+ sys_longjmp (jbuf, 1);
}
#endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */
@@ -4400,7 +4529,7 @@ check_gcpros (void)
if (!survives_gc_p (p->var[i]))
/* FIXME: It's not necessarily a bug. It might just be that the
GCPRO is unnecessary or should release the object sooner. */
- abort ();
+ emacs_abort ();
}
#elif GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
@@ -4485,9 +4614,9 @@ mark_stack (void)
/* jmp_buf may not be aligned enough on darwin-ppc64 */
union aligned_jmpbuf {
Lisp_Object o;
- jmp_buf j;
+ sys_jmp_buf j;
} j;
- volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
+ volatile bool stack_grows_down_p = (char *) &j > (char *) stack_base;
#endif
/* This trick flushes the register windows so that all the state of
the process is contained in the stack. */
@@ -4521,7 +4650,7 @@ mark_stack (void)
}
#endif /* GC_SETJMP_WORKS */
- setjmp (j.j);
+ sys_setjmp (j.j);
end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j;
#endif /* not GC_SAVE_REGISTERS_ON_STACK */
#endif /* not HAVE___BUILTIN_UNWIND_INIT */
@@ -4561,7 +4690,7 @@ valid_pointer_p (void *p)
if (pipe (fd) == 0)
{
- int valid = (emacs_write (fd[1], (char *) p, 16) == 16);
+ bool valid = emacs_write (fd[1], (char *) p, 16) == 16;
emacs_close (fd[1]);
emacs_close (fd[0]);
return valid;
@@ -4571,7 +4700,8 @@ valid_pointer_p (void *p)
#endif
}
-/* Return 1 if OBJ is a valid lisp object.
+/* Return 2 if OBJ is a killed or special buffer object.
+ Return 1 if OBJ is a valid lisp object.
Return 0 if OBJ is NOT a valid lisp object.
Return -1 if we cannot validate OBJ.
This function can be quite slow,
@@ -4592,6 +4722,9 @@ valid_lisp_object_p (Lisp_Object obj)
if (PURE_POINTER_P (p))
return 1;
+ if (p == &buffer_defaults || p == &buffer_local_symbols)
+ return 2;
+
#if !GC_MARK_STACK
return valid_pointer_p (p);
#else
@@ -4613,10 +4746,11 @@ valid_lisp_object_p (Lisp_Object obj)
switch (m->type)
{
case MEM_TYPE_NON_LISP:
+ case MEM_TYPE_SPARE:
return 0;
case MEM_TYPE_BUFFER:
- return live_buffer_p (m, p);
+ return live_buffer_p (m, p) ? 1 : 2;
case MEM_TYPE_CONS:
return live_cons_p (m, p);
@@ -4634,6 +4768,7 @@ valid_lisp_object_p (Lisp_Object obj)
return live_float_p (m, p);
case MEM_TYPE_VECTORLIKE:
+ case MEM_TYPE_VECTOR_BLOCK:
return live_vector_p (m, p);
default:
@@ -4655,24 +4790,18 @@ valid_lisp_object_p (Lisp_Object obj)
pointer to it. TYPE is the Lisp type for which the memory is
allocated. TYPE < 0 means it's not used for a Lisp object. */
-static POINTER_TYPE *
+static void *
pure_alloc (size_t size, int type)
{
- POINTER_TYPE *result;
-#ifdef USE_LSB_TAG
- size_t alignment = (1 << GCTYPEBITS);
+ void *result;
+#if USE_LSB_TAG
+ size_t alignment = GCALIGNMENT;
#else
- size_t alignment = sizeof (EMACS_INT);
+ size_t alignment = alignof (EMACS_INT);
/* Give Lisp_Floats an extra alignment. */
if (type == Lisp_Float)
- {
-#if defined __GNUC__ && __GNUC__ >= 2
- alignment = __alignof (struct Lisp_Float);
-#else
- alignment = sizeof (struct Lisp_Float);
-#endif
- }
+ alignment = alignof (struct Lisp_Float);
#endif
again:
@@ -4698,7 +4827,7 @@ pure_alloc (size_t size, int type)
/* Don't allocate a large amount here,
because it might get mmap'd and then its address
might not be usable. */
- purebeg = (char *) xmalloc (10000);
+ purebeg = xmalloc (10000);
pure_size = 10000;
pure_bytes_used_before_overflow += pure_bytes_used - size;
pure_bytes_used = 0;
@@ -4724,14 +4853,14 @@ check_pure_size (void)
address. Return NULL if not found. */
static char *
-find_string_data_in_pure (const char *data, EMACS_INT nbytes)
+find_string_data_in_pure (const char *data, ptrdiff_t nbytes)
{
int i;
- EMACS_INT skip, bm_skip[256], last_char_skip, infinity, start, start_max;
+ ptrdiff_t skip, bm_skip[256], last_char_skip, infinity, start, start_max;
const unsigned char *p;
char *non_lisp_beg;
- if (pure_bytes_used_non_lisp < nbytes + 1)
+ if (pure_bytes_used_non_lisp <= nbytes)
return NULL;
/* Set up the Boyer-Moore table. */
@@ -4787,7 +4916,7 @@ find_string_data_in_pure (const char *data, EMACS_INT nbytes)
/* Return a string allocated in pure space. DATA is a buffer holding
NCHARS characters, and NBYTES bytes of string data. MULTIBYTE
- non-zero means make the result string multibyte.
+ means make the result string multibyte.
Must get an error if pure storage is full, since if it cannot hold
a large string it may be able to hold conses that point to that
@@ -4795,41 +4924,36 @@ find_string_data_in_pure (const char *data, EMACS_INT nbytes)
Lisp_Object
make_pure_string (const char *data,
- EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
+ ptrdiff_t nchars, ptrdiff_t nbytes, bool multibyte)
{
Lisp_Object string;
- struct Lisp_String *s;
-
- s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
+ struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String);
s->data = (unsigned char *) find_string_data_in_pure (data, nbytes);
if (s->data == NULL)
{
- s->data = (unsigned char *) pure_alloc (nbytes + 1, -1);
+ s->data = pure_alloc (nbytes + 1, -1);
memcpy (s->data, data, nbytes);
s->data[nbytes] = '\0';
}
s->size = nchars;
s->size_byte = multibyte ? nbytes : -1;
- s->intervals = NULL_INTERVAL;
+ s->intervals = NULL;
XSETSTRING (string, s);
return string;
}
-/* Return a string a string allocated in pure space. Do not allocate
- the string data, just point to DATA. */
+/* Return a string allocated in pure space. Do not
+ allocate the string data, just point to DATA. */
Lisp_Object
-make_pure_c_string (const char *data)
+make_pure_c_string (const char *data, ptrdiff_t nchars)
{
Lisp_Object string;
- struct Lisp_String *s;
- EMACS_INT nchars = strlen (data);
-
- s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
+ struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String);
s->size = nchars;
s->size_byte = -1;
s->data = (unsigned char *) data;
- s->intervals = NULL_INTERVAL;
+ s->intervals = NULL;
XSETSTRING (string, s);
return string;
}
@@ -4840,10 +4964,8 @@ make_pure_c_string (const char *data)
Lisp_Object
pure_cons (Lisp_Object car, Lisp_Object cdr)
{
- register Lisp_Object new;
- struct Lisp_Cons *p;
-
- p = (struct Lisp_Cons *) pure_alloc (sizeof *p, Lisp_Cons);
+ Lisp_Object new;
+ struct Lisp_Cons *p = pure_alloc (sizeof *p, Lisp_Cons);
XSETCONS (new, p);
XSETCAR (new, Fpurecopy (car));
XSETCDR (new, Fpurecopy (cdr));
@@ -4856,10 +4978,8 @@ pure_cons (Lisp_Object car, Lisp_Object cdr)
static Lisp_Object
make_pure_float (double num)
{
- register Lisp_Object new;
- struct Lisp_Float *p;
-
- p = (struct Lisp_Float *) pure_alloc (sizeof *p, Lisp_Float);
+ Lisp_Object new;
+ struct Lisp_Float *p = pure_alloc (sizeof *p, Lisp_Float);
XSETFLOAT (new, p);
XFLOAT_INIT (new, num);
return new;
@@ -4869,15 +4989,12 @@ make_pure_float (double num)
/* Return a vector with room for LEN Lisp_Objects allocated from
pure space. */
-Lisp_Object
-make_pure_vector (EMACS_INT len)
+static Lisp_Object
+make_pure_vector (ptrdiff_t len)
{
Lisp_Object new;
- struct Lisp_Vector *p;
- size_t size = (offsetof (struct Lisp_Vector, contents)
- + len * sizeof (Lisp_Object));
-
- p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike);
+ size_t size = header_size + len * word_size;
+ struct Lisp_Vector *p = pure_alloc (size, Lisp_Vectorlike);
XSETVECTOR (new, p);
XVECTOR (new)->header.size = len;
return new;
@@ -4914,15 +5031,15 @@ Does not copy symbols. Copies strings without text properties. */)
else if (COMPILEDP (obj) || VECTORP (obj))
{
register struct Lisp_Vector *vec;
- register EMACS_INT i;
- EMACS_INT size;
+ register ptrdiff_t i;
+ ptrdiff_t size;
size = ASIZE (obj);
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
vec = XVECTOR (make_pure_vector (size));
for (i = 0; i < size; i++)
- vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
+ vec->contents[i] = Fpurecopy (AREF (obj, i));
if (COMPILEDP (obj))
{
XSETPVECTYPE (vec, PVEC_COMPILED);
@@ -4957,7 +5074,7 @@ staticpro (Lisp_Object *varaddress)
{
staticvec[staticidx++] = varaddress;
if (staticidx >= NSTATICS)
- abort ();
+ fatal ("NSTATICS too small; try increasing and recompiling Emacs.");
}
@@ -4967,84 +5084,96 @@ staticpro (Lisp_Object *varaddress)
/* Temporarily prevent garbage collection. */
-int
+ptrdiff_t
inhibit_garbage_collection (void)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM));
return count;
}
+/* Used to avoid possible overflows when
+ converting from C to Lisp integers. */
+
+static Lisp_Object
+bounded_number (EMACS_INT number)
+{
+ return make_number (min (MOST_POSITIVE_FIXNUM, number));
+}
+
+/* Calculate total bytes of live objects. */
+
+static size_t
+total_bytes_of_live_objects (void)
+{
+ size_t tot = 0;
+ tot += total_conses * sizeof (struct Lisp_Cons);
+ tot += total_symbols * sizeof (struct Lisp_Symbol);
+ tot += total_markers * sizeof (union Lisp_Misc);
+ tot += total_string_bytes;
+ tot += total_vector_slots * word_size;
+ tot += total_floats * sizeof (struct Lisp_Float);
+ tot += total_intervals * sizeof (struct interval);
+ tot += total_strings * sizeof (struct Lisp_String);
+ return tot;
+}
DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
doc: /* Reclaim storage for Lisp objects no longer needed.
Garbage collection happens automatically if you cons more than
`gc-cons-threshold' bytes of Lisp data since previous garbage collection.
-`garbage-collect' normally returns a list with info on amount of space in use:
- ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
- (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS
- (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS)
- (USED-STRINGS . FREE-STRINGS))
+`garbage-collect' normally returns a list with info on amount of space in use,
+where each entry has the form (NAME SIZE USED FREE), where:
+- NAME is a symbol describing the kind of objects this entry represents,
+- SIZE is the number of bytes used by each one,
+- USED is the number of those objects that were found live in the heap,
+- FREE is the number of those objects that are not live but that Emacs
+ keeps around for future allocations (maybe because it does not know how
+ to return them to the OS).
However, if there was overflow in pure space, `garbage-collect'
-returns nil, because real GC can't be done. */)
+returns nil, because real GC can't be done.
+See Info node `(elisp)Garbage Collection'. */)
(void)
{
- register struct specbinding *bind;
+ struct specbinding *bind;
+ struct buffer *nextb;
char stack_top_variable;
ptrdiff_t i;
- int message_p;
- Lisp_Object total[8];
- int count = SPECPDL_INDEX ();
- EMACS_TIME t1, t2, t3;
+ bool message_p;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ EMACS_TIME start;
+ Lisp_Object retval = Qnil;
+ size_t tot_before = 0;
+ struct backtrace backtrace;
if (abort_on_gc)
- abort ();
+ emacs_abort ();
/* Can't GC if pure storage overflowed because we can't determine
if something is a pure object or not. */
if (pure_bytes_used_before_overflow)
return Qnil;
- CHECK_CONS_LIST ();
+ /* Record this function, so it appears on the profiler's backtraces. */
+ backtrace.next = backtrace_list;
+ backtrace.function = Qautomatic_gc;
+ backtrace.args = &Qnil;
+ backtrace.nargs = 0;
+ backtrace.debug_on_exit = 0;
+ backtrace_list = &backtrace;
+
+ check_cons_list ();
/* Don't keep undo information around forever.
Do this early on, so it is no problem if the user quits. */
- {
- register struct buffer *nextb = all_buffers;
+ FOR_EACH_BUFFER (nextb)
+ compact_buffer (nextb);
- while (nextb)
- {
- /* If a buffer's undo list is Qt, that means that undo is
- turned off in that buffer. Calling truncate_undo_list on
- Qt tends to return NULL, which effectively turns undo back on.
- So don't call truncate_undo_list if undo_list is Qt. */
- if (! NILP (nextb->BUFFER_INTERNAL_FIELD (name)) && ! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
- truncate_undo_list (nextb);
-
- /* Shrink buffer gaps, but skip indirect and dead buffers. */
- if (nextb->base_buffer == 0 && !NILP (nextb->BUFFER_INTERNAL_FIELD (name))
- && ! nextb->text->inhibit_shrinking)
- {
- /* If a buffer's gap size is more than 10% of the buffer
- size, or larger than 2000 bytes, then shrink it
- accordingly. Keep a minimum size of 20 bytes. */
- int size = min (2000, max (20, (nextb->text->z_byte / 10)));
+ if (profiler_memory_running)
+ tot_before = total_bytes_of_live_objects ();
- if (nextb->text->gap_size > size)
- {
- struct buffer *save_current = current_buffer;
- current_buffer = nextb;
- make_gap (-(nextb->text->gap_size - size));
- current_buffer = save_current;
- }
- }
-
- nextb = nextb->header.next.buffer;
- }
- }
-
- EMACS_GET_TIME (t1);
+ start = current_emacs_time ();
/* In case user calls debug_print during GC,
don't let that cause a recursive GC. */
@@ -5074,7 +5203,7 @@ returns nil, because real GC can't be done. */)
{
if (stack_copy_size < stack_size)
{
- stack_copy = (char *) xrealloc (stack_copy, stack_size);
+ stack_copy = xrealloc (stack_copy, stack_size);
stack_copy_size = stack_size;
}
memcpy (stack_copy, stack, stack_size);
@@ -5085,16 +5214,17 @@ returns nil, because real GC can't be done. */)
if (garbage_collection_messages)
message1_nolog ("Garbage collecting...");
- BLOCK_INPUT;
+ block_input ();
shrink_regexp_cache ();
gc_in_progress = 1;
- /* clear_marks (); */
-
/* Mark all the special slots that serve as the roots of accessibility. */
+ mark_buffer (&buffer_defaults);
+ mark_buffer (&buffer_local_symbols);
+
for (i = 0; i < staticidx; i++)
mark_object (*staticvec[i]);
@@ -5105,13 +5235,9 @@ returns nil, because real GC can't be done. */)
}
mark_terminals ();
mark_kboards ();
- mark_ttys ();
#ifdef USE_GTK
- {
- extern void xg_mark_data (void);
- xg_mark_data ();
- }
+ xg_mark_data ();
#endif
#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
@@ -5156,48 +5282,42 @@ returns nil, because real GC can't be done. */)
Look thru every buffer's undo list
for elements that update markers that were not marked,
and delete them. */
- {
- register struct buffer *nextb = all_buffers;
-
- while (nextb)
- {
- /* If a buffer's undo list is Qt, that means that undo is
- turned off in that buffer. Calling truncate_undo_list on
- Qt tends to return NULL, which effectively turns undo back on.
- So don't call truncate_undo_list if undo_list is Qt. */
- if (! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
- {
- Lisp_Object tail, prev;
- tail = nextb->BUFFER_INTERNAL_FIELD (undo_list);
- prev = Qnil;
- while (CONSP (tail))
- {
- if (CONSP (XCAR (tail))
- && MARKERP (XCAR (XCAR (tail)))
- && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
- {
- if (NILP (prev))
- nextb->BUFFER_INTERNAL_FIELD (undo_list) = tail = XCDR (tail);
- else
- {
- tail = XCDR (tail);
- XSETCDR (prev, tail);
- }
- }
- else
- {
- prev = tail;
- tail = XCDR (tail);
- }
- }
- }
- /* Now that we have stripped the elements that need not be in the
- undo_list any more, we can finally mark the list. */
- mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list));
-
- nextb = nextb->header.next.buffer;
- }
- }
+ FOR_EACH_BUFFER (nextb)
+ {
+ /* If a buffer's undo list is Qt, that means that undo is
+ turned off in that buffer. Calling truncate_undo_list on
+ Qt tends to return NULL, which effectively turns undo back on.
+ So don't call truncate_undo_list if undo_list is Qt. */
+ if (! EQ (nextb->INTERNAL_FIELD (undo_list), Qt))
+ {
+ Lisp_Object tail, prev;
+ tail = nextb->INTERNAL_FIELD (undo_list);
+ prev = Qnil;
+ while (CONSP (tail))
+ {
+ if (CONSP (XCAR (tail))
+ && MARKERP (XCAR (XCAR (tail)))
+ && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
+ {
+ if (NILP (prev))
+ nextb->INTERNAL_FIELD (undo_list) = tail = XCDR (tail);
+ else
+ {
+ tail = XCDR (tail);
+ XSETCDR (prev, tail);
+ }
+ }
+ else
+ {
+ prev = tail;
+ tail = XCDR (tail);
+ }
+ }
+ }
+ /* Now that we have stripped the elements that need not be in the
+ undo_list any more, we can finally mark the list. */
+ mark_object (nextb->INTERNAL_FIELD (undo_list));
+ }
gc_sweep ();
@@ -5211,30 +5331,20 @@ returns nil, because real GC can't be done. */)
dump_zombies ();
#endif
- UNBLOCK_INPUT;
+ check_cons_list ();
- CHECK_CONS_LIST ();
-
- /* clear_marks (); */
gc_in_progress = 0;
+ unblock_input ();
+
consing_since_gc = 0;
- if (gc_cons_threshold < 10000)
- gc_cons_threshold = 10000;
+ if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10)
+ gc_cons_threshold = GC_DEFAULT_THRESHOLD / 10;
gc_relative_threshold = 0;
if (FLOATP (Vgc_cons_percentage))
{ /* Set gc_cons_combined_threshold. */
- double tot = 0;
-
- tot += total_conses * sizeof (struct Lisp_Cons);
- tot += total_symbols * sizeof (struct Lisp_Symbol);
- tot += total_markers * sizeof (union Lisp_Misc);
- tot += total_string_size;
- tot += total_vector_size * sizeof (Lisp_Object);
- tot += total_floats * sizeof (struct Lisp_Float);
- tot += total_intervals * sizeof (struct interval);
- tot += total_strings * sizeof (struct Lisp_String);
+ double tot = total_bytes_of_live_objects ();
tot *= XFLOAT_DATA (Vgc_cons_percentage);
if (0 < tot)
@@ -5255,56 +5365,100 @@ returns nil, because real GC can't be done. */)
}
unbind_to (count, Qnil);
+ {
+ Lisp_Object total[11];
+ int total_size = 10;
+
+ total[0] = list4 (Qconses, make_number (sizeof (struct Lisp_Cons)),
+ bounded_number (total_conses),
+ bounded_number (total_free_conses));
+
+ total[1] = list4 (Qsymbols, make_number (sizeof (struct Lisp_Symbol)),
+ bounded_number (total_symbols),
+ bounded_number (total_free_symbols));
+
+ total[2] = list4 (Qmiscs, make_number (sizeof (union Lisp_Misc)),
+ bounded_number (total_markers),
+ bounded_number (total_free_markers));
+
+ total[3] = list4 (Qstrings, make_number (sizeof (struct Lisp_String)),
+ bounded_number (total_strings),
+ bounded_number (total_free_strings));
+
+ total[4] = list3 (Qstring_bytes, make_number (1),
+ bounded_number (total_string_bytes));
- total[0] = Fcons (make_number (total_conses),
- make_number (total_free_conses));
- total[1] = Fcons (make_number (total_symbols),
- make_number (total_free_symbols));
- total[2] = Fcons (make_number (total_markers),
- make_number (total_free_markers));
- total[3] = make_number (total_string_size);
- total[4] = make_number (total_vector_size);
- total[5] = Fcons (make_number (total_floats),
- make_number (total_free_floats));
- total[6] = Fcons (make_number (total_intervals),
- make_number (total_free_intervals));
- total[7] = Fcons (make_number (total_strings),
- make_number (total_free_strings));
+ total[5] = list3 (Qvectors, make_number (sizeof (struct Lisp_Vector)),
+ bounded_number (total_vectors));
+
+ total[6] = list4 (Qvector_slots, make_number (word_size),
+ bounded_number (total_vector_slots),
+ bounded_number (total_free_vector_slots));
+
+ total[7] = list4 (Qfloats, make_number (sizeof (struct Lisp_Float)),
+ bounded_number (total_floats),
+ bounded_number (total_free_floats));
+
+ total[8] = list4 (Qintervals, make_number (sizeof (struct interval)),
+ bounded_number (total_intervals),
+ bounded_number (total_free_intervals));
+
+ total[9] = list3 (Qbuffers, make_number (sizeof (struct buffer)),
+ bounded_number (total_buffers));
+
+#ifdef DOUG_LEA_MALLOC
+ total_size++;
+ total[10] = list4 (Qheap, make_number (1024),
+ bounded_number ((mallinfo ().uordblks + 1023) >> 10),
+ bounded_number ((mallinfo ().fordblks + 1023) >> 10));
+#endif
+ retval = Flist (total_size, total);
+ }
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
{
/* Compute average percentage of zombies. */
- double nlive = 0;
-
- for (i = 0; i < 7; ++i)
- if (CONSP (total[i]))
- nlive += XFASTINT (XCAR (total[i]));
+ double nlive
+ = (total_conses + total_symbols + total_markers + total_strings
+ + total_vectors + total_floats + total_intervals + total_buffers);
avg_live = (avg_live * ngcs + nlive) / (ngcs + 1);
max_live = max (nlive, max_live);
avg_zombies = (avg_zombies * ngcs + nzombies) / (ngcs + 1);
max_zombies = max (nzombies, max_zombies);
++ngcs;
- }
+ }
#endif
if (!NILP (Vpost_gc_hook))
{
- int gc_count = inhibit_garbage_collection ();
+ ptrdiff_t gc_count = inhibit_garbage_collection ();
safe_run_hooks (Qpost_gc_hook);
unbind_to (gc_count, Qnil);
}
/* Accumulate statistics. */
- EMACS_GET_TIME (t2);
- EMACS_SUB_TIME (t3, t2, t1);
if (FLOATP (Vgc_elapsed))
- Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed) +
- EMACS_SECS (t3) +
- EMACS_USECS (t3) * 1.0e-6);
+ {
+ EMACS_TIME since_start = sub_emacs_time (current_emacs_time (), start);
+ Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed)
+ + EMACS_TIME_TO_DOUBLE (since_start));
+ }
+
gcs_done++;
- return Flist (sizeof total / sizeof *total, total);
+ /* Collect profiling data. */
+ if (profiler_memory_running)
+ {
+ size_t swept = 0;
+ size_t tot_after = total_bytes_of_live_objects ();
+ if (tot_before > tot_after)
+ swept = tot_before - tot_after;
+ malloc_probe (swept);
+ }
+
+ backtrace_list = backtrace.next;
+ return retval;
}
@@ -5375,19 +5529,19 @@ ptrdiff_t mark_object_loop_halt EXTERNALLY_VISIBLE;
static void
mark_vectorlike (struct Lisp_Vector *ptr)
{
- EMACS_INT size = ptr->header.size;
- EMACS_INT i;
+ ptrdiff_t size = ptr->header.size;
+ ptrdiff_t i;
eassert (!VECTOR_MARKED_P (ptr));
- VECTOR_MARK (ptr); /* Else mark it */
+ VECTOR_MARK (ptr); /* Else mark it. */
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
/* Note that this size is not the memory-footprint size, but only
the number of Lisp_Object fields that we should trace.
The distinction is used e.g. by Lisp_Process which places extra
- non-Lisp_Object fields at the end of the structure. */
- for (i = 0; i < size; i++) /* and then mark its elements */
+ non-Lisp_Object fields at the end of the structure... */
+ for (i = 0; i < size; i++) /* ...and then mark its elements. */
mark_object (ptr->contents[i]);
}
@@ -5419,6 +5573,73 @@ mark_char_table (struct Lisp_Vector *ptr)
}
}
+/* Mark the chain of overlays starting at PTR. */
+
+static void
+mark_overlay (struct Lisp_Overlay *ptr)
+{
+ for (; ptr && !ptr->gcmarkbit; ptr = ptr->next)
+ {
+ ptr->gcmarkbit = 1;
+ mark_object (ptr->start);
+ mark_object (ptr->end);
+ mark_object (ptr->plist);
+ }
+}
+
+/* Mark Lisp_Objects and special pointers in BUFFER. */
+
+static void
+mark_buffer (struct buffer *buffer)
+{
+ /* This is handled much like other pseudovectors... */
+ mark_vectorlike ((struct Lisp_Vector *) buffer);
+
+ /* ...but there are some buffer-specific things. */
+
+ MARK_INTERVAL_TREE (buffer_intervals (buffer));
+
+ /* For now, we just don't mark the undo_list. It's done later in
+ a special way just before the sweep phase, and after stripping
+ some of its elements that are not needed any more. */
+
+ mark_overlay (buffer->overlays_before);
+ mark_overlay (buffer->overlays_after);
+
+ /* If this is an indirect buffer, mark its base buffer. */
+ if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
+ mark_buffer (buffer->base_buffer);
+}
+
+/* Remove killed buffers or items whose car is a killed buffer from
+ LIST, and mark other items. Return changed LIST, which is marked. */
+
+static Lisp_Object
+mark_discard_killed_buffers (Lisp_Object list)
+{
+ Lisp_Object tail, *prev = &list;
+
+ for (tail = list; CONSP (tail) && !CONS_MARKED_P (XCONS (tail));
+ tail = XCDR (tail))
+ {
+ Lisp_Object tem = XCAR (tail);
+ if (CONSP (tem))
+ tem = XCAR (tem);
+ if (BUFFERP (tem) && !BUFFER_LIVE_P (XBUFFER (tem)))
+ *prev = XCDR (tail);
+ else
+ {
+ CONS_MARK (XCONS (tail));
+ mark_object (XCAR (tail));
+ prev = &XCDR_AS_LVALUE (tail);
+ }
+ }
+ mark_object (tail);
+ return list;
+}
+
+/* Determine type of generic Lisp_Object and mark it accordingly. */
+
void
mark_object (Lisp_Object arg)
{
@@ -5451,7 +5672,7 @@ mark_object (Lisp_Object arg)
do { \
m = mem_find (po); \
if (m == MEM_NIL) \
- abort (); \
+ emacs_abort (); \
} while (0)
/* Check that the object pointed to by PO is live, using predicate
@@ -5459,7 +5680,7 @@ mark_object (Lisp_Object arg)
#define CHECK_LIVE(LIVEP) \
do { \
if (!LIVEP (m, po)) \
- abort (); \
+ emacs_abort (); \
} while (0)
/* Check both of the above conditions. */
@@ -5476,7 +5697,7 @@ mark_object (Lisp_Object arg)
#endif /* not GC_CHECK_MARKED_OBJECTS */
- switch (SWITCH_ENUM_CAST (XTYPE (obj)))
+ switch (XTYPE (obj))
{
case Lisp_String:
{
@@ -5484,99 +5705,142 @@ mark_object (Lisp_Object arg)
if (STRING_MARKED_P (ptr))
break;
CHECK_ALLOCATED_AND_LIVE (live_string_p);
- MARK_INTERVAL_TREE (ptr->intervals);
MARK_STRING (ptr);
+ MARK_INTERVAL_TREE (ptr->intervals);
#ifdef GC_CHECK_STRING_BYTES
/* Check that the string size recorded in the string is the
- same as the one recorded in the sdata structure. */
- CHECK_STRING_BYTES (ptr);
+ same as the one recorded in the sdata structure. */
+ string_bytes (ptr);
#endif /* GC_CHECK_STRING_BYTES */
}
break;
case Lisp_Vectorlike:
- if (VECTOR_MARKED_P (XVECTOR (obj)))
- break;
+ {
+ register struct Lisp_Vector *ptr = XVECTOR (obj);
+ register ptrdiff_t pvectype;
+
+ if (VECTOR_MARKED_P (ptr))
+ break;
+
#ifdef GC_CHECK_MARKED_OBJECTS
- m = mem_find (po);
- if (m == MEM_NIL && !SUBRP (obj)
- && po != &buffer_defaults
- && po != &buffer_local_symbols)
- abort ();
+ m = mem_find (po);
+ if (m == MEM_NIL && !SUBRP (obj))
+ emacs_abort ();
#endif /* GC_CHECK_MARKED_OBJECTS */
- if (BUFFERP (obj))
- {
+ if (ptr->header.size & PSEUDOVECTOR_FLAG)
+ pvectype = ((ptr->header.size & PVEC_TYPE_MASK)
+ >> PSEUDOVECTOR_AREA_BITS);
+ else
+ pvectype = PVEC_NORMAL_VECTOR;
+
+ if (pvectype != PVEC_SUBR && pvectype != PVEC_BUFFER)
+ CHECK_LIVE (live_vector_p);
+
+ switch (pvectype)
+ {
+ case PVEC_BUFFER:
#ifdef GC_CHECK_MARKED_OBJECTS
- if (po != &buffer_defaults && po != &buffer_local_symbols)
{
struct buffer *b;
- for (b = all_buffers; b && b != po; b = b->header.next.buffer)
- ;
+ FOR_EACH_BUFFER (b)
+ if (b == po)
+ break;
if (b == NULL)
- abort ();
+ emacs_abort ();
}
#endif /* GC_CHECK_MARKED_OBJECTS */
- mark_buffer (obj);
- }
- else if (SUBRP (obj))
- break;
- else if (COMPILEDP (obj))
- /* We could treat this just like a vector, but it is better to
- save the COMPILED_CONSTANTS element for last and avoid
- recursion there. */
- {
- register struct Lisp_Vector *ptr = XVECTOR (obj);
- int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
- int i;
+ mark_buffer ((struct buffer *) ptr);
+ break;
- CHECK_LIVE (live_vector_p);
- VECTOR_MARK (ptr); /* Else mark it */
- for (i = 0; i < size; i++) /* and then mark its elements */
+ case PVEC_COMPILED:
+ { /* We could treat this just like a vector, but it is better
+ to save the COMPILED_CONSTANTS element for last and avoid
+ recursion there. */
+ int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
+ int i;
+
+ VECTOR_MARK (ptr);
+ for (i = 0; i < size; i++)
+ if (i != COMPILED_CONSTANTS)
+ mark_object (ptr->contents[i]);
+ if (size > COMPILED_CONSTANTS)
+ {
+ obj = ptr->contents[COMPILED_CONSTANTS];
+ goto loop;
+ }
+ }
+ break;
+
+ case PVEC_FRAME:
+ mark_vectorlike (ptr);
+ mark_face_cache (((struct frame *) ptr)->face_cache);
+ break;
+
+ case PVEC_WINDOW:
{
- if (i != COMPILED_CONSTANTS)
- mark_object (ptr->contents[i]);
+ struct window *w = (struct window *) ptr;
+ bool leaf = NILP (w->hchild) && NILP (w->vchild);
+
+ mark_vectorlike (ptr);
+
+ /* Mark glyphs for leaf windows. Marking window
+ matrices is sufficient because frame matrices
+ use the same glyph memory. */
+ if (leaf && w->current_matrix)
+ {
+ mark_glyph_matrix (w->current_matrix);
+ mark_glyph_matrix (w->desired_matrix);
+ }
+
+ /* Filter out killed buffers from both buffer lists
+ in attempt to help GC to reclaim killed buffers faster.
+ We can do it elsewhere for live windows, but this is the
+ best place to do it for dead windows. */
+ wset_prev_buffers
+ (w, mark_discard_killed_buffers (w->prev_buffers));
+ wset_next_buffers
+ (w, mark_discard_killed_buffers (w->next_buffers));
}
- obj = ptr->contents[COMPILED_CONSTANTS];
- goto loop;
- }
- else if (FRAMEP (obj))
- {
- register struct frame *ptr = XFRAME (obj);
- mark_vectorlike (XVECTOR (obj));
- mark_face_cache (ptr->face_cache);
- }
- else if (WINDOWP (obj))
- {
- register struct Lisp_Vector *ptr = XVECTOR (obj);
- struct window *w = XWINDOW (obj);
- mark_vectorlike (ptr);
- /* Mark glyphs for leaf windows. Marking window matrices is
- sufficient because frame matrices use the same glyph
- memory. */
- if (NILP (w->hchild)
- && NILP (w->vchild)
- && w->current_matrix)
+ break;
+
+ case PVEC_HASH_TABLE:
{
- mark_glyph_matrix (w->current_matrix);
- mark_glyph_matrix (w->desired_matrix);
+ struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr;
+
+ mark_vectorlike (ptr);
+ mark_object (h->test.name);
+ mark_object (h->test.user_hash_function);
+ mark_object (h->test.user_cmp_function);
+ /* If hash table is not weak, mark all keys and values.
+ For weak tables, mark only the vector. */
+ if (NILP (h->weak))
+ mark_object (h->key_and_value);
+ else
+ VECTOR_MARK (XVECTOR (h->key_and_value));
}
- }
- else if (HASH_TABLE_P (obj))
- {
- struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
- mark_vectorlike ((struct Lisp_Vector *)h);
- /* If hash table is not weak, mark all keys and values.
- For weak tables, mark only the vector. */
- if (NILP (h->weak))
- mark_object (h->key_and_value);
- else
- VECTOR_MARK (XVECTOR (h->key_and_value));
- }
- else if (CHAR_TABLE_P (obj))
- mark_char_table (XVECTOR (obj));
- else
- mark_vectorlike (XVECTOR (obj));
+ break;
+
+ case PVEC_CHAR_TABLE:
+ mark_char_table (ptr);
+ break;
+
+ case PVEC_BOOL_VECTOR:
+ /* No Lisp_Objects to mark in a bool vector. */
+ VECTOR_MARK (ptr);
+ break;
+
+ case PVEC_SUBR:
+ break;
+
+ case PVEC_FREE:
+ emacs_abort ();
+
+ default:
+ mark_vectorlike (ptr);
+ }
+ }
break;
case Lisp_Symbol:
@@ -5603,10 +5867,14 @@ mark_object (Lisp_Object arg)
case SYMBOL_LOCALIZED:
{
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr);
- /* If the value is forwarded to a buffer or keyboard field,
- these are marked when we see the corresponding object.
- And if it's forwarded to a C variable, either it's not
- a Lisp_Object var, or it's staticpro'd already. */
+ Lisp_Object where = blv->where;
+ /* If the value is set up for a killed buffer or deleted
+ frame, restore it's global binding. If the value is
+ forwarded to a C variable, either it's not a Lisp_Object
+ var, or it's staticpro'd already. */
+ if ((BUFFERP (where) && !BUFFER_LIVE_P (XBUFFER (where)))
+ || (FRAMEP (where) && !FRAME_LIVE_P (XFRAME (where))))
+ swap_in_global_binding (ptr);
mark_object (blv->where);
mark_object (blv->valcell);
mark_object (blv->defcell);
@@ -5618,16 +5886,16 @@ mark_object (Lisp_Object arg)
And if it's forwarded to a C variable, either it's not
a Lisp_Object var, or it's staticpro'd already. */
break;
- default: abort ();
+ default: emacs_abort ();
}
- if (!PURE_POINTER_P (XSTRING (ptr->xname)))
- MARK_STRING (XSTRING (ptr->xname));
- MARK_INTERVAL_TREE (STRING_INTERVALS (ptr->xname));
+ if (!PURE_POINTER_P (XSTRING (ptr->name)))
+ MARK_STRING (XSTRING (ptr->name));
+ MARK_INTERVAL_TREE (string_intervals (ptr->name));
ptr = ptr->next;
if (ptr)
{
- ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */
+ ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun. */
XSETSYMBOL (obj, ptrx);
goto loop;
}
@@ -5636,20 +5904,21 @@ mark_object (Lisp_Object arg)
case Lisp_Misc:
CHECK_ALLOCATED_AND_LIVE (live_misc_p);
+
if (XMISCANY (obj)->gcmarkbit)
break;
- XMISCANY (obj)->gcmarkbit = 1;
switch (XMISCTYPE (obj))
{
-
case Lisp_Misc_Marker:
/* DO NOT mark thru the marker's chain.
The buffer's markers chain does not preserve markers from gc;
instead, markers are removed from the chain when freed by gc. */
+ XMISCANY (obj)->gcmarkbit = 1;
break;
case Lisp_Misc_Save_Value:
+ XMISCANY (obj)->gcmarkbit = 1;
#if GC_MARK_STACK
{
register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj);
@@ -5667,21 +5936,11 @@ mark_object (Lisp_Object arg)
break;
case Lisp_Misc_Overlay:
- {
- struct Lisp_Overlay *ptr = XOVERLAY (obj);
- mark_object (ptr->start);
- mark_object (ptr->end);
- mark_object (ptr->plist);
- if (ptr->next)
- {
- XSETMISC (obj, ptr->next);
- goto loop;
- }
- }
+ mark_overlay (XOVERLAY (obj));
break;
default:
- abort ();
+ emacs_abort ();
}
break;
@@ -5703,7 +5962,7 @@ mark_object (Lisp_Object arg)
obj = ptr->u.cdr;
cdr_count++;
if (cdr_count == mark_object_loop_halt)
- abort ();
+ emacs_abort ();
goto loop;
}
@@ -5716,61 +5975,15 @@ mark_object (Lisp_Object arg)
break;
default:
- abort ();
+ emacs_abort ();
}
#undef CHECK_LIVE
#undef CHECK_ALLOCATED
#undef CHECK_ALLOCATED_AND_LIVE
}
-
-/* Mark the pointers in a buffer structure. */
-
-static void
-mark_buffer (Lisp_Object buf)
-{
- register struct buffer *buffer = XBUFFER (buf);
- register Lisp_Object *ptr, tmp;
- Lisp_Object base_buffer;
-
- eassert (!VECTOR_MARKED_P (buffer));
- VECTOR_MARK (buffer);
-
- MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));
-
- /* For now, we just don't mark the undo_list. It's done later in
- a special way just before the sweep phase, and after stripping
- some of its elements that are not needed any more. */
-
- if (buffer->overlays_before)
- {
- XSETMISC (tmp, buffer->overlays_before);
- mark_object (tmp);
- }
- if (buffer->overlays_after)
- {
- XSETMISC (tmp, buffer->overlays_after);
- mark_object (tmp);
- }
-
- /* buffer-local Lisp variables start at `undo_list',
- tho only the ones from `name' on are GC'd normally. */
- for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name);
- ptr <= &PER_BUFFER_VALUE (buffer,
- PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER));
- ptr++)
- mark_object (*ptr);
-
- /* If this is an indirect buffer, mark its base buffer. */
- if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
- {
- XSETBUFFER (base_buffer, buffer->base_buffer);
- mark_buffer (base_buffer);
- }
-}
-
/* Mark the Lisp pointers in the terminal objects.
- Called by the Fgarbage_collector. */
+ Called by Fgarbage_collect. */
static void
mark_terminals (void)
@@ -5795,10 +6008,10 @@ mark_terminals (void)
/* Value is non-zero if OBJ will survive the current GC because it's
either marked or does not need to be marked to survive. */
-int
+bool
survives_gc_p (Lisp_Object obj)
{
- int survives_p;
+ bool survives_p;
switch (XTYPE (obj))
{
@@ -5831,7 +6044,7 @@ survives_gc_p (Lisp_Object obj)
break;
default:
- abort ();
+ emacs_abort ();
}
return survives_p || PURE_POINTER_P ((void *) XPNTR (obj));
@@ -5849,10 +6062,7 @@ gc_sweep (void)
sweep_weak_hash_tables ();
sweep_strings ();
-#ifdef GC_CHECK_STRING_BYTES
- if (!noninteractive)
- check_string_bytes (1);
-#endif
+ check_string_bytes (!noninteractive);
/* Put all unmarked conses on free list */
{
@@ -5995,7 +6205,7 @@ gc_sweep (void)
{
if (!iblk->intervals[i].gcmarkbit)
{
- SET_INTERVAL_PARENT (&iblk->intervals[i], interval_free_list);
+ set_interval_parent (&iblk->intervals[i], interval_free_list);
interval_free_list = &iblk->intervals[i];
this_free++;
}
@@ -6038,22 +6248,22 @@ gc_sweep (void)
for (sblk = symbol_block; sblk; sblk = *sprev)
{
int this_free = 0;
- struct Lisp_Symbol *sym = sblk->symbols;
- struct Lisp_Symbol *end = sym + lim;
+ union aligned_Lisp_Symbol *sym = sblk->symbols;
+ union aligned_Lisp_Symbol *end = sym + lim;
for (; sym < end; ++sym)
{
/* Check if the symbol was created during loadup. In such a case
it might be pointed to by pure bytecode which we don't trace,
so we conservatively assume that it is live. */
- int pure_p = PURE_POINTER_P (XSTRING (sym->xname));
+ bool pure_p = PURE_POINTER_P (XSTRING (sym->s.name));
- if (!sym->gcmarkbit && !pure_p)
+ if (!sym->s.gcmarkbit && !pure_p)
{
- if (sym->redirect == SYMBOL_LOCALIZED)
- xfree (SYMBOL_BLV (sym));
- sym->next = symbol_free_list;
- symbol_free_list = sym;
+ if (sym->s.redirect == SYMBOL_LOCALIZED)
+ xfree (SYMBOL_BLV (&sym->s));
+ sym->s.next = symbol_free_list;
+ symbol_free_list = &sym->s;
#if GC_MARK_STACK
symbol_free_list->function = Vdead;
#endif
@@ -6063,8 +6273,8 @@ gc_sweep (void)
{
++num_used;
if (!pure_p)
- UNMARK_STRING (XSTRING (sym->xname));
- sym->gcmarkbit = 0;
+ UNMARK_STRING (XSTRING (sym->s.name));
+ sym->s.gcmarkbit = 0;
}
}
@@ -6076,7 +6286,7 @@ gc_sweep (void)
{
*sprev = sblk->next;
/* Unhook from the free list. */
- symbol_free_list = sblk->symbols[0].next;
+ symbol_free_list = sblk->symbols[0].s.next;
lisp_free (sblk);
}
else
@@ -6106,22 +6316,22 @@ gc_sweep (void)
for (i = 0; i < lim; i++)
{
- if (!mblk->markers[i].u_any.gcmarkbit)
+ if (!mblk->markers[i].m.u_any.gcmarkbit)
{
- if (mblk->markers[i].u_any.type == Lisp_Misc_Marker)
- unchain_marker (&mblk->markers[i].u_marker);
+ if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
+ unchain_marker (&mblk->markers[i].m.u_marker);
/* Set the type of the freed object to Lisp_Misc_Free.
We could leave the type alone, since nobody checks it,
but this might catch bugs faster. */
- mblk->markers[i].u_marker.type = Lisp_Misc_Free;
- mblk->markers[i].u_free.chain = marker_free_list;
- marker_free_list = &mblk->markers[i];
+ mblk->markers[i].m.u_marker.type = Lisp_Misc_Free;
+ mblk->markers[i].m.u_free.chain = marker_free_list;
+ marker_free_list = &mblk->markers[i].m;
this_free++;
}
else
{
num_used++;
- mblk->markers[i].u_any.gcmarkbit = 0;
+ mblk->markers[i].m.u_any.gcmarkbit = 0;
}
}
lim = MARKER_BLOCK_SIZE;
@@ -6132,7 +6342,7 @@ gc_sweep (void)
{
*mprev = mblk->next;
/* Unhook from the free list. */
- marker_free_list = mblk->markers[0].u_free.chain;
+ marker_free_list = mblk->markers[0].m.u_free.chain;
lisp_free (mblk);
}
else
@@ -6148,59 +6358,27 @@ gc_sweep (void)
/* Free all unmarked buffers */
{
- register struct buffer *buffer = all_buffers, *prev = 0, *next;
+ register struct buffer *buffer, **bprev = &all_buffers;
- while (buffer)
+ total_buffers = 0;
+ for (buffer = all_buffers; buffer; buffer = *bprev)
if (!VECTOR_MARKED_P (buffer))
{
- if (prev)
- prev->header.next = buffer->header.next;
- else
- all_buffers = buffer->header.next.buffer;
- next = buffer->header.next.buffer;
+ *bprev = buffer->next;
lisp_free (buffer);
- buffer = next;
}
else
{
VECTOR_UNMARK (buffer);
- UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer));
- prev = buffer, buffer = buffer->header.next.buffer;
+ /* Do not use buffer_(set|get)_intervals here. */
+ buffer->text->intervals = balance_intervals (buffer->text->intervals);
+ total_buffers++;
+ bprev = &buffer->next;
}
}
- /* Free all unmarked vectors */
- {
- register struct Lisp_Vector *vector = all_vectors, *prev = 0, *next;
- total_vector_size = 0;
-
- while (vector)
- if (!VECTOR_MARKED_P (vector))
- {
- if (prev)
- prev->header.next = vector->header.next;
- else
- all_vectors = vector->header.next.vector;
- next = vector->header.next.vector;
- lisp_free (vector);
- vector = next;
-
- }
- else
- {
- VECTOR_UNMARK (vector);
- if (vector->header.size & PSEUDOVECTOR_FLAG)
- total_vector_size += PSEUDOVECTOR_SIZE_MASK & vector->header.size;
- else
- total_vector_size += vector->header.size;
- prev = vector, vector = vector->header.next.vector;
- }
- }
-
-#ifdef GC_CHECK_STRING_BYTES
- if (!noninteractive)
- check_string_bytes (1);
-#endif
+ sweep_vectors ();
+ check_string_bytes (!noninteractive);
}
@@ -6236,18 +6414,15 @@ Frames, windows, buffers, and subprocesses count as vectors
(but the contents of a buffer's text do not count here). */)
(void)
{
- Lisp_Object consed[8];
-
- consed[0] = make_number (min (MOST_POSITIVE_FIXNUM, cons_cells_consed));
- consed[1] = make_number (min (MOST_POSITIVE_FIXNUM, floats_consed));
- consed[2] = make_number (min (MOST_POSITIVE_FIXNUM, vector_cells_consed));
- consed[3] = make_number (min (MOST_POSITIVE_FIXNUM, symbols_consed));
- consed[4] = make_number (min (MOST_POSITIVE_FIXNUM, string_chars_consed));
- consed[5] = make_number (min (MOST_POSITIVE_FIXNUM, misc_objects_consed));
- consed[6] = make_number (min (MOST_POSITIVE_FIXNUM, intervals_consed));
- consed[7] = make_number (min (MOST_POSITIVE_FIXNUM, strings_consed));
-
- return Flist (8, consed);
+ return listn (CONSTYPE_HEAP, 8,
+ bounded_number (cons_cells_consed),
+ bounded_number (floats_consed),
+ bounded_number (vector_cells_consed),
+ bounded_number (symbols_consed),
+ bounded_number (string_chars_consed),
+ bounded_number (misc_objects_consed),
+ bounded_number (intervals_consed),
+ bounded_number (strings_consed));
}
/* Find at most FIND_MAX symbols which have OBJ as their value or
@@ -6257,18 +6432,19 @@ Lisp_Object
which_symbols (Lisp_Object obj, EMACS_INT find_max)
{
struct symbol_block *sblk;
- int gc_count = inhibit_garbage_collection ();
+ ptrdiff_t gc_count = inhibit_garbage_collection ();
Lisp_Object found = Qnil;
if (! DEADP (obj))
{
for (sblk = symbol_block; sblk; sblk = sblk->next)
{
- struct Lisp_Symbol *sym = sblk->symbols;
+ union aligned_Lisp_Symbol *aligned_sym = sblk->symbols;
int bn;
- for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, sym++)
+ for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, aligned_sym++)
{
+ struct Lisp_Symbol *sym = &aligned_sym->s;
Lisp_Object val;
Lisp_Object tem;
@@ -6300,14 +6476,15 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max)
}
#ifdef ENABLE_CHECKING
-int suppress_checking;
+
+bool suppress_checking;
void
die (const char *msg, const char *file, int line)
{
fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n",
file, line, msg);
- abort ();
+ terminate_due_to_signal (SIGABRT, INT_MAX);
}
#endif
@@ -6319,48 +6496,22 @@ init_alloc_once (void)
/* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
purebeg = PUREBEG;
pure_size = PURESIZE;
- pure_bytes_used = 0;
- pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
- pure_bytes_used_before_overflow = 0;
-
- /* Initialize the list of free aligned blocks. */
- free_ablock = NULL;
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
mem_init ();
Vdead = make_pure_string ("DEAD", 4, 4, 0);
#endif
- all_vectors = 0;
- ignore_warnings = 1;
#ifdef DOUG_LEA_MALLOC
mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* max. number of mmap'ed areas */
#endif
init_strings ();
- init_cons ();
- init_symbol ();
- init_marker ();
- init_float ();
- init_intervals ();
- init_weak_hash_tables ();
-
-#ifdef REL_ALLOC
- malloc_hysteresis = 32;
-#else
- malloc_hysteresis = 0;
-#endif
+ init_vectors ();
refill_memory_reserve ();
-
- ignore_warnings = 0;
- gcprolist = 0;
- byte_stack_list = 0;
- staticidx = 0;
- consing_since_gc = 0;
- gc_cons_threshold = 100000 * sizeof (Lisp_Object);
- gc_relative_threshold = 0;
+ gc_cons_threshold = GC_DEFAULT_THRESHOLD;
}
void
@@ -6381,7 +6532,7 @@ void
syms_of_alloc (void)
{
DEFVAR_INT ("gc-cons-threshold", gc_cons_threshold,
- doc: /* *Number of bytes of consing between garbage collections.
+ doc: /* Number of bytes of consing between garbage collections.
Garbage collection can happen automatically once this many bytes have been
allocated since the last garbage collection. All data types count.
@@ -6392,7 +6543,7 @@ prevent garbage collection during a part of the program.
See also `gc-cons-percentage'. */);
DEFVAR_LISP ("gc-cons-percentage", Vgc_cons_percentage,
- doc: /* *Portion of the heap used for allocation.
+ doc: /* Portion of the heap used for allocation.
Garbage collection can happen automatically once this portion of the heap
has been allocated since the last garbage collection.
If this portion is smaller than `gc-cons-threshold', this is ignored. */);
@@ -6417,7 +6568,9 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */);
doc: /* Number of string characters that have been consed so far. */);
DEFVAR_INT ("misc-objects-consed", misc_objects_consed,
- doc: /* Number of miscellaneous objects that have been consed so far. */);
+ doc: /* Number of miscellaneous objects that have been consed so far.
+These include markers and overlays, plus certain objects not visible
+to users. */);
DEFVAR_INT ("intervals-consed", intervals_consed,
doc: /* Number of intervals that have been consed so far. */);
@@ -6445,13 +6598,26 @@ do hash-consing of the objects allocated to pure space. */);
/* We build this in advance because if we wait until we need it, we might
not be able to allocate the memory to hold it. */
Vmemory_signal_data
- = pure_cons (Qerror,
- pure_cons (make_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil));
+ = listn (CONSTYPE_PURE, 2, Qerror,
+ build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"));
DEFVAR_LISP ("memory-full", Vmemory_full,
doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);
Vmemory_full = Qnil;
+ DEFSYM (Qconses, "conses");
+ DEFSYM (Qsymbols, "symbols");
+ DEFSYM (Qmiscs, "miscs");
+ DEFSYM (Qstrings, "strings");
+ DEFSYM (Qvectors, "vectors");
+ DEFSYM (Qfloats, "floats");
+ DEFSYM (Qintervals, "intervals");
+ DEFSYM (Qbuffers, "buffers");
+ DEFSYM (Qstring_bytes, "string-bytes");
+ DEFSYM (Qvector_slots, "vector-slots");
+ DEFSYM (Qheap, "heap");
+ DEFSYM (Qautomatic_gc, "Automatic GC");
+
DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");
@@ -6480,3 +6646,29 @@ The time is in seconds as a floating point value. */);
defsubr (&Sgc_status);
#endif
}
+
+/* When compiled with GCC, GDB might say "No enum type named
+ pvec_type" if we don't have at least one symbol with that type, and
+ then xbacktrace could fail. Similarly for the other enums and
+ their values. Some non-GCC compilers don't like these constructs. */
+#ifdef __GNUC__
+union
+{
+ enum CHARTAB_SIZE_BITS CHARTAB_SIZE_BITS;
+ enum CHAR_TABLE_STANDARD_SLOTS CHAR_TABLE_STANDARD_SLOTS;
+ enum char_bits char_bits;
+ enum CHECK_LISP_OBJECT_TYPE CHECK_LISP_OBJECT_TYPE;
+ enum DEFAULT_HASH_SIZE DEFAULT_HASH_SIZE;
+ enum enum_USE_LSB_TAG enum_USE_LSB_TAG;
+ enum FLOAT_TO_STRING_BUFSIZE FLOAT_TO_STRING_BUFSIZE;
+ enum Lisp_Bits Lisp_Bits;
+ enum Lisp_Compiled Lisp_Compiled;
+ enum maxargs maxargs;
+ enum MAX_ALLOCA MAX_ALLOCA;
+ enum More_Lisp_Bits More_Lisp_Bits;
+ enum pvec_type pvec_type;
+#if USE_LSB_TAG
+ enum lsb_bits lsb_bits;
+#endif
+} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};
+#endif /* __GNUC__ */
diff --git a/src/atimer.c b/src/atimer.c
index a54b397f52e..5752192be76 100644
--- a/src/atimer.c
+++ b/src/atimer.c
@@ -1,5 +1,5 @@
/* Asynchronous timers.
- Copyright (C) 2000-2011 Free Software Foundation, Inc.
+ Copyright (C) 2000-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -17,9 +17,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/>. */
#include <config.h>
-#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "syssignal.h"
#include "systime.h"
@@ -27,10 +26,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "atimer.h"
#include <unistd.h>
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#endif
-
/* Free-list of atimer structures. */
static struct atimer *free_atimers;
@@ -45,18 +40,33 @@ static struct atimer *stopped_atimers;
static struct atimer *atimers;
-/* Non-zero means alarm_signal_handler has found ripe timers but
- interrupt_input_blocked was non-zero. In this case, timer
- functions are not called until the next UNBLOCK_INPUT because timer
- functions are expected to call X, and X cannot be assumed to be
- reentrant. */
-
-int pending_atimers;
+/* The alarm timer and whether it was properly initialized, if
+ POSIX timers are available. */
+#ifdef HAVE_ITIMERSPEC
+static timer_t alarm_timer;
+static bool alarm_timer_ok;
+#endif
/* Block/unblock SIGALRM. */
-#define BLOCK_ATIMERS sigblock (sigmask (SIGALRM))
-#define UNBLOCK_ATIMERS sigunblock (sigmask (SIGALRM))
+static void
+sigmask_atimers (int how)
+{
+ sigset_t blocked;
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGALRM);
+ pthread_sigmask (how, &blocked, 0);
+}
+static void
+block_atimers (void)
+{
+ sigmask_atimers (SIG_BLOCK);
+}
+static void
+unblock_atimers (void)
+{
+ sigmask_atimers (SIG_UNBLOCK);
+}
/* Function prototypes. */
@@ -64,8 +74,6 @@ static void set_alarm (void);
static void schedule_atimer (struct atimer *);
static struct atimer *append_atimer_lists (struct atimer *,
struct atimer *);
-static void alarm_signal_handler (int signo);
-
/* Start a new atimer of type TYPE. TIME specifies when the timer is
ripe. FN is the function to call when the timer fires.
@@ -94,11 +102,9 @@ start_atimer (enum atimer_type type, EMACS_TIME timestamp, atimer_callback fn,
/* Round TIME up to the next full second if we don't have
itimers. */
#ifndef HAVE_SETITIMER
- if (EMACS_USECS (timestamp) != 0)
- {
- EMACS_SET_USECS (timestamp, 0);
- EMACS_SET_SECS (timestamp, EMACS_SECS (timestamp) + 1);
- }
+ if (EMACS_NSECS (timestamp) != 0
+ && EMACS_SECS (timestamp) < TYPE_MAXIMUM (time_t))
+ timestamp = make_emacs_time (EMACS_SECS (timestamp) + 1, 0);
#endif /* not HAVE_SETITIMER */
/* Get an atimer structure from the free-list, or allocate
@@ -109,7 +115,7 @@ start_atimer (enum atimer_type type, EMACS_TIME timestamp, atimer_callback fn,
free_atimers = t->next;
}
else
- t = (struct atimer *) xmalloc (sizeof *t);
+ t = xmalloc (sizeof *t);
/* Fill the atimer structure. */
memset (t, 0, sizeof *t);
@@ -117,7 +123,7 @@ start_atimer (enum atimer_type type, EMACS_TIME timestamp, atimer_callback fn,
t->fn = fn;
t->client_data = client_data;
- BLOCK_ATIMERS;
+ block_atimers ();
/* Compute the timer's expiration time. */
switch (type)
@@ -127,20 +133,18 @@ start_atimer (enum atimer_type type, EMACS_TIME timestamp, atimer_callback fn,
break;
case ATIMER_RELATIVE:
- EMACS_GET_TIME (t->expiration);
- EMACS_ADD_TIME (t->expiration, t->expiration, timestamp);
+ t->expiration = add_emacs_time (current_emacs_time (), timestamp);
break;
case ATIMER_CONTINUOUS:
- EMACS_GET_TIME (t->expiration);
- EMACS_ADD_TIME (t->expiration, t->expiration, timestamp);
+ t->expiration = add_emacs_time (current_emacs_time (), timestamp);
t->interval = timestamp;
break;
}
/* Insert the timer in the list of active atimers. */
schedule_atimer (t);
- UNBLOCK_ATIMERS;
+ unblock_atimers ();
/* Arrange for a SIGALRM at the time the next atimer is ripe. */
set_alarm ();
@@ -156,7 +160,7 @@ cancel_atimer (struct atimer *timer)
{
int i;
- BLOCK_ATIMERS;
+ block_atimers ();
for (i = 0; i < 2; ++i)
{
@@ -183,7 +187,7 @@ cancel_atimer (struct atimer *timer)
}
}
- UNBLOCK_ATIMERS;
+ unblock_atimers ();
}
@@ -214,7 +218,7 @@ append_atimer_lists (struct atimer *list_1, struct atimer *list_2)
void
stop_other_atimers (struct atimer *t)
{
- BLOCK_ATIMERS;
+ block_atimers ();
if (t)
{
@@ -239,7 +243,7 @@ stop_other_atimers (struct atimer *t)
stopped_atimers = append_atimer_lists (atimers, stopped_atimers);
atimers = t;
- UNBLOCK_ATIMERS;
+ unblock_atimers ();
}
@@ -254,7 +258,7 @@ run_all_atimers (void)
struct atimer *t = atimers;
struct atimer *next;
- BLOCK_ATIMERS;
+ block_atimers ();
atimers = stopped_atimers;
stopped_atimers = NULL;
@@ -265,7 +269,7 @@ run_all_atimers (void)
t = next;
}
- UNBLOCK_ATIMERS;
+ unblock_atimers ();
}
}
@@ -287,28 +291,36 @@ set_alarm (void)
{
if (atimers)
{
- EMACS_TIME now, timestamp;
#ifdef HAVE_SETITIMER
struct itimerval it;
#endif
+ EMACS_TIME now, interval;
- /* Determine s/us till the next timer is ripe. */
- EMACS_GET_TIME (now);
- EMACS_SUB_TIME (timestamp, atimers->expiration, now);
-
-#ifdef HAVE_SETITIMER
- /* Don't set the interval to 0; this disables the timer. */
- if (EMACS_TIME_LE (atimers->expiration, now))
+#ifdef HAVE_ITIMERSPEC
+ if (alarm_timer_ok)
{
- EMACS_SET_SECS (timestamp, 0);
- EMACS_SET_USECS (timestamp, 1000);
+ struct itimerspec ispec;
+ ispec.it_value = atimers->expiration;
+ ispec.it_interval.tv_sec = ispec.it_interval.tv_nsec = 0;
+ if (timer_settime (alarm_timer, 0, &ispec, 0) == 0)
+ return;
}
+#endif
+
+ /* Determine interval till the next timer is ripe.
+ Don't set the interval to 0; this disables the timer. */
+ now = current_emacs_time ();
+ interval = (EMACS_TIME_LE (atimers->expiration, now)
+ ? make_emacs_time (0, 1000 * 1000)
+ : sub_emacs_time (atimers->expiration, now));
+
+#ifdef HAVE_SETITIMER
memset (&it, 0, sizeof it);
- it.it_value = timestamp;
+ it.it_value = make_timeval (interval);
setitimer (ITIMER_REAL, &it, 0);
#else /* not HAVE_SETITIMER */
- alarm (max (EMACS_SECS (timestamp), 1));
+ alarm (max (EMACS_SECS (interval), 1));
#endif /* not HAVE_SETITIMER */
}
}
@@ -339,23 +351,17 @@ schedule_atimer (struct atimer *t)
static void
run_timers (void)
{
- EMACS_TIME now;
-
- EMACS_GET_TIME (now);
+ EMACS_TIME now = current_emacs_time ();
- while (atimers
- && (pending_atimers = interrupt_input_blocked) == 0
- && EMACS_TIME_LE (atimers->expiration, now))
+ while (atimers && EMACS_TIME_LE (atimers->expiration, now))
{
- struct atimer *t;
-
- t = atimers;
+ struct atimer *t = atimers;
atimers = atimers->next;
t->fn (t);
if (t->type == ATIMER_CONTINUOUS)
{
- EMACS_ADD_TIME (t->expiration, now, t->interval);
+ t->expiration = add_emacs_time (now, t->interval);
schedule_atimer (t);
}
else
@@ -363,57 +369,32 @@ run_timers (void)
t->next = free_atimers;
free_atimers = t;
}
-
- EMACS_GET_TIME (now);
}
- if (! atimers)
- pending_atimers = 0;
-
-#ifdef SYNC_INPUT
- if (pending_atimers)
- pending_signals = 1;
- else
- {
- pending_signals = interrupt_input_pending;
- set_alarm ();
- }
-#else
- if (! pending_atimers)
- set_alarm ();
-#endif
+ set_alarm ();
}
/* Signal handler for SIGALRM. SIGNO is the signal number, i.e.
SIGALRM. */
-void
-alarm_signal_handler (int signo)
+static void
+handle_alarm_signal (int sig)
{
-#ifndef SYNC_INPUT
- SIGNAL_THREAD_CHECK (signo);
-#endif
-
- pending_atimers = 1;
-#ifdef SYNC_INPUT
pending_signals = 1;
-#else
- run_timers ();
-#endif
}
-/* Call alarm_signal_handler for pending timers. */
+/* Do pending timers. */
void
do_pending_atimers (void)
{
- if (pending_atimers)
+ if (atimers)
{
- BLOCK_ATIMERS;
+ block_atimers ();
run_timers ();
- UNBLOCK_ATIMERS;
+ unblock_atimers ();
}
}
@@ -422,13 +403,10 @@ do_pending_atimers (void)
some systems like HPUX (see process.c). */
void
-turn_on_atimers (int on)
+turn_on_atimers (bool on)
{
if (on)
- {
- signal (SIGALRM, alarm_signal_handler);
- set_alarm ();
- }
+ set_alarm ();
else
alarm (0);
}
@@ -437,8 +415,16 @@ turn_on_atimers (int on)
void
init_atimer (void)
{
+ struct sigaction action;
+#ifdef HAVE_ITIMERSPEC
+ struct sigevent sigev;
+ sigev.sigev_notify = SIGEV_SIGNAL;
+ sigev.sigev_signo = SIGALRM;
+ sigev.sigev_value.sival_ptr = &alarm_timer;
+ alarm_timer_ok = timer_create (CLOCK_REALTIME, &sigev, &alarm_timer) == 0;
+#endif
free_atimers = stopped_atimers = atimers = NULL;
- pending_atimers = 0;
/* pending_signals is initialized in init_keyboard.*/
- signal (SIGALRM, alarm_signal_handler);
+ emacs_sigaction_init (&action, handle_alarm_signal);
+ sigaction (SIGALRM, &action, 0);
}
diff --git a/src/atimer.h b/src/atimer.h
index 8035681b225..6d441d71641 100644
--- a/src/atimer.h
+++ b/src/atimer.h
@@ -1,5 +1,5 @@
/* Asynchronous timers.
- Copyright (C) 2000-2011 Free Software Foundation, Inc.
+ Copyright (C) 2000-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -20,6 +20,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define EMACS_ATIMER_H
#include "systime.h" /* for EMACS_TIME */
+#include <stdbool.h>
/* Forward declaration. */
@@ -74,7 +75,7 @@ struct atimer *start_atimer (enum atimer_type, EMACS_TIME,
void cancel_atimer (struct atimer *);
void do_pending_atimers (void);
void init_atimer (void);
-void turn_on_atimers (int);
+void turn_on_atimers (bool);
void stop_other_atimers (struct atimer *);
Lisp_Object unwind_stop_other_atimers (Lisp_Object);
diff --git a/src/bidi.c b/src/bidi.c
index e0337927ec5..6f3d749ef22 100644
--- a/src/bidi.c
+++ b/src/bidi.c
@@ -1,5 +1,5 @@
/* Low-level bidirectional buffer/string-scanning functions for GNU Emacs.
- Copyright (C) 2000-2001, 2004-2005, 2009-2011
+ Copyright (C) 2000-2001, 2004-2005, 2009-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -56,14 +56,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "dispextern.h"
-static int bidi_initialized = 0;
+static bool bidi_initialized = 0;
static Lisp_Object bidi_type_table, bidi_mirror_table;
@@ -82,10 +81,10 @@ typedef enum {
/* UAX#9 says to search only for L, AL, or R types of characters, and
ignore RLE, RLO, LRE, and LRO, when determining the base paragraph
level. Yudit indeed ignores them. This variable is therefore set
- by default to ignore them, but setting it to zero will take them
- into account. */
-extern int bidi_ignore_explicit_marks_for_paragraph_level EXTERNALLY_VISIBLE;
-int bidi_ignore_explicit_marks_for_paragraph_level = 1;
+ by default to ignore them, but clearing it will take them into
+ account. */
+extern bool bidi_ignore_explicit_marks_for_paragraph_level EXTERNALLY_VISIBLE;
+bool bidi_ignore_explicit_marks_for_paragraph_level = 1;
static Lisp_Object paragraph_start_re, paragraph_separate_re;
static Lisp_Object Qparagraph_start, Qparagraph_separate;
@@ -97,7 +96,7 @@ static Lisp_Object Qparagraph_start, Qparagraph_separate;
/* Return the bidi type of a character CH, subject to the current
directional OVERRIDE. */
-static inline bidi_type_t
+static bidi_type_t
bidi_get_type (int ch, bidi_dir_t override)
{
bidi_type_t default_type;
@@ -105,7 +104,7 @@ bidi_get_type (int ch, bidi_dir_t override)
if (ch == BIDI_EOB)
return NEUTRAL_B;
if (ch < 0 || ch > MAX_CHAR)
- abort ();
+ emacs_abort ();
default_type = (bidi_type_t) XINT (CHAR_TABLE_REF (bidi_type_table, ch));
/* Every valid character code, even those that are unassigned by the
@@ -113,7 +112,7 @@ bidi_get_type (int ch, bidi_dir_t override)
DerivedBidiClass.txt file. Therefore, if we ever get UNKNOWN_BT
(= zero) code from CHAR_TABLE_REF, that's a bug. */
if (default_type == UNKNOWN_BT)
- abort ();
+ emacs_abort ();
if (override == NEUTRAL_DIR)
return default_type;
@@ -141,19 +140,19 @@ bidi_get_type (int ch, bidi_dir_t override)
else if (override == R2L)
return STRONG_R;
else
- abort (); /* can't happen: handled above */
+ emacs_abort (); /* can't happen: handled above */
}
}
}
-static inline void
+static void
bidi_check_type (bidi_type_t type)
{
- xassert (UNKNOWN_BT <= type && type <= NEUTRAL_ON);
+ eassert (UNKNOWN_BT <= type && type <= NEUTRAL_ON);
}
/* Given a bidi TYPE of a character, return its category. */
-static inline bidi_category_t
+static bidi_category_t
bidi_get_category (bidi_type_t type)
{
switch (type)
@@ -183,7 +182,7 @@ bidi_get_category (bidi_type_t type)
case NEUTRAL_ON:
return NEUTRAL;
default:
- abort ();
+ emacs_abort ();
}
}
@@ -199,15 +198,23 @@ bidi_mirror_char (int c)
if (c == BIDI_EOB)
return c;
if (c < 0 || c > MAX_CHAR)
- abort ();
+ emacs_abort ();
val = CHAR_TABLE_REF (bidi_mirror_table, c);
if (INTEGERP (val))
{
- int v = XINT (val);
+ int v;
+
+ /* When debugging, check before assigning to V, so that the check
+ isn't broken by undefined behavior due to int overflow. */
+ eassert (CHAR_VALID_P (XINT (val)));
+ v = XINT (val);
+
+ /* Minimal test we must do in optimized builds, to prevent weird
+ crashes further down the road. */
if (v < 0 || v > MAX_CHAR)
- abort ();
+ emacs_abort ();
return v;
}
@@ -219,7 +226,7 @@ bidi_mirror_char (int c)
embedding levels on either side of the run boundary. Also, update
the saved info about previously seen characters, since that info is
generally valid for a single level run. */
-static inline void
+static void
bidi_set_sor_type (struct bidi_it *bidi_it, int level_before, int level_after)
{
int higher_level = (level_before > level_after ? level_before : level_after);
@@ -250,19 +257,19 @@ bidi_set_sor_type (struct bidi_it *bidi_it, int level_before, int level_after)
/* Push the current embedding level and override status; reset the
current level to LEVEL and the current override status to OVERRIDE. */
-static inline void
+static void
bidi_push_embedding_level (struct bidi_it *bidi_it,
int level, bidi_dir_t override)
{
bidi_it->stack_idx++;
- xassert (bidi_it->stack_idx < BIDI_MAXLEVEL);
+ eassert (bidi_it->stack_idx < BIDI_MAXLEVEL);
bidi_it->level_stack[bidi_it->stack_idx].level = level;
bidi_it->level_stack[bidi_it->stack_idx].override = override;
}
/* Pop the embedding level and directional override status from the
stack, and return the new level. */
-static inline int
+static int
bidi_pop_embedding_level (struct bidi_it *bidi_it)
{
/* UAX#9 says to ignore invalid PDFs. */
@@ -272,7 +279,7 @@ bidi_pop_embedding_level (struct bidi_it *bidi_it)
}
/* Record in SAVED_INFO the information about the current character. */
-static inline void
+static void
bidi_remember_char (struct bidi_saved_info *saved_info,
struct bidi_it *bidi_it)
{
@@ -288,18 +295,14 @@ bidi_remember_char (struct bidi_saved_info *saved_info,
/* Copy the bidi iterator from FROM to TO. To save cycles, this only
copies the part of the level stack that is actually in use. */
-static inline void
+static void
bidi_copy_it (struct bidi_it *to, struct bidi_it *from)
{
- int i;
-
- /* Copy everything except the level stack and beyond. */
- memcpy (to, from, offsetof (struct bidi_it, level_stack[0]));
-
- /* Copy the active part of the level stack. */
- to->level_stack[0] = from->level_stack[0]; /* level zero is always in use */
- for (i = 1; i <= from->stack_idx; i++)
- to->level_stack[i] = from->level_stack[i];
+ /* Copy everything from the start through the active part of
+ the level stack. */
+ memcpy (to, from,
+ (offsetof (struct bidi_it, level_stack[1])
+ + from->stack_idx * sizeof from->level_stack[0]));
}
@@ -337,7 +340,7 @@ enum
intact. This is called when the cached information is no more
useful for the current iteration, e.g. when we were reseated to a
new position on the same object. */
-static inline void
+static void
bidi_cache_reset (void)
{
bidi_cache_idx = bidi_cache_start;
@@ -348,25 +351,24 @@ bidi_cache_reset (void)
iterator for reordering a buffer or a string that does not come
from display properties, because that means all the previously
cached info is of no further use. */
-static inline void
+static void
bidi_cache_shrink (void)
{
if (bidi_cache_size > BIDI_CACHE_CHUNK)
{
- bidi_cache
- = (struct bidi_it *) xrealloc (bidi_cache, BIDI_CACHE_CHUNK * elsz);
+ bidi_cache = xrealloc (bidi_cache, BIDI_CACHE_CHUNK * elsz);
bidi_cache_size = BIDI_CACHE_CHUNK;
}
bidi_cache_reset ();
}
-static inline void
+static void
bidi_cache_fetch_state (ptrdiff_t idx, struct bidi_it *bidi_it)
{
int current_scan_dir = bidi_it->scan_dir;
if (idx < bidi_cache_start || idx >= bidi_cache_idx)
- abort ();
+ emacs_abort ();
bidi_copy_it (bidi_it, &bidi_cache[idx]);
bidi_it->scan_dir = current_scan_dir;
@@ -377,8 +379,8 @@ bidi_cache_fetch_state (ptrdiff_t idx, struct bidi_it *bidi_it)
level less or equal to LEVEL. if LEVEL is -1, disregard the
resolved levels in cached states. DIR, if non-zero, means search
in that direction from the last cache hit. */
-static inline ptrdiff_t
-bidi_cache_search (EMACS_INT charpos, int level, int dir)
+static ptrdiff_t
+bidi_cache_search (ptrdiff_t charpos, int level, int dir)
{
ptrdiff_t i, i_start;
@@ -431,7 +433,7 @@ bidi_cache_search (EMACS_INT charpos, int level, int dir)
that is lower than LEVEL, and return its cache slot index. DIR is
the direction to search, starting with the last used cache slot.
If DIR is zero, we search backwards from the last occupied cache
- slot. BEFORE, if non-zero, means return the index of the slot that
+ slot. BEFORE means return the index of the slot that
is ``before'' the level change in the search direction. That is,
given the cached levels like this:
@@ -441,16 +443,16 @@ bidi_cache_search (EMACS_INT charpos, int level, int dir)
and assuming we are at the position cached at the slot marked with
C, searching backwards (DIR = -1) for LEVEL = 2 will return the
index of slot B or A, depending whether BEFORE is, respectively,
- non-zero or zero. */
+ true or false. */
static ptrdiff_t
-bidi_cache_find_level_change (int level, int dir, int before)
+bidi_cache_find_level_change (int level, int dir, bool before)
{
if (bidi_cache_idx)
{
ptrdiff_t i = dir ? bidi_cache_last_idx : bidi_cache_idx - 1;
int incr = before ? 1 : 0;
- xassert (!dir || bidi_cache_last_idx >= 0);
+ eassert (!dir || bidi_cache_last_idx >= 0);
if (!dir)
dir = -1;
@@ -482,7 +484,7 @@ bidi_cache_find_level_change (int level, int dir, int before)
return -1;
}
-static inline void
+static void
bidi_cache_ensure_space (ptrdiff_t idx)
{
/* Enlarge the cache as needed. */
@@ -504,14 +506,14 @@ bidi_cache_ensure_space (ptrdiff_t idx)
}
}
-static inline void
-bidi_cache_iterator_state (struct bidi_it *bidi_it, int resolved)
+static void
+bidi_cache_iterator_state (struct bidi_it *bidi_it, bool resolved)
{
ptrdiff_t idx;
/* We should never cache on backward scans. */
if (bidi_it->scan_dir == -1)
- abort ();
+ emacs_abort ();
idx = bidi_cache_search (bidi_it->charpos, -1, 1);
if (idx < 0)
@@ -530,7 +532,7 @@ bidi_cache_iterator_state (struct bidi_it *bidi_it, int resolved)
idx = bidi_cache_start;
}
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
bidi_copy_it (&bidi_cache[idx], bidi_it);
if (!resolved)
bidi_cache[idx].resolved_level = -1;
@@ -561,8 +563,8 @@ bidi_cache_iterator_state (struct bidi_it *bidi_it, int resolved)
bidi_cache_idx = idx + 1;
}
-static inline bidi_type_t
-bidi_cache_find (EMACS_INT charpos, int level, struct bidi_it *bidi_it)
+static bidi_type_t
+bidi_cache_find (ptrdiff_t charpos, int level, struct bidi_it *bidi_it)
{
ptrdiff_t i = bidi_cache_search (charpos, level, bidi_it->scan_dir);
@@ -572,7 +574,7 @@ bidi_cache_find (EMACS_INT charpos, int level, struct bidi_it *bidi_it)
bidi_copy_it (bidi_it, &bidi_cache[i]);
bidi_cache_last_idx = i;
- /* Don't let scan direction from from the cached state override
+ /* Don't let scan direction from the cached state override
the current scan direction. */
bidi_it->scan_dir = current_scan_dir;
return bidi_it->type;
@@ -581,11 +583,11 @@ bidi_cache_find (EMACS_INT charpos, int level, struct bidi_it *bidi_it)
return UNKNOWN_BT;
}
-static inline int
+static int
bidi_peek_at_next_level (struct bidi_it *bidi_it)
{
if (bidi_cache_idx == bidi_cache_start || bidi_cache_last_idx == -1)
- abort ();
+ emacs_abort ();
return bidi_cache[bidi_cache_last_idx + bidi_it->scan_dir].resolved_level;
}
@@ -605,10 +607,10 @@ bidi_push_it (struct bidi_it *bidi_it)
/* Save the current iterator state in its entirety after the last
used cache slot. */
bidi_cache_ensure_space (bidi_cache_idx);
- memcpy (&bidi_cache[bidi_cache_idx++], bidi_it, sizeof (struct bidi_it));
+ bidi_cache[bidi_cache_idx++] = *bidi_it;
/* Push the current cache start onto the stack. */
- xassert (bidi_cache_sp < IT_STACK_SIZE);
+ eassert (bidi_cache_sp < IT_STACK_SIZE);
bidi_cache_start_stack[bidi_cache_sp++] = bidi_cache_start;
/* Start a new level of cache, and make it empty. */
@@ -622,18 +624,18 @@ void
bidi_pop_it (struct bidi_it *bidi_it)
{
if (bidi_cache_start <= 0)
- abort ();
+ emacs_abort ();
/* Reset the next free cache slot index to what it was before the
call to bidi_push_it. */
bidi_cache_idx = bidi_cache_start - 1;
/* Restore the bidi iterator state saved in the cache. */
- memcpy (bidi_it, &bidi_cache[bidi_cache_idx], sizeof (struct bidi_it));
+ *bidi_it = bidi_cache[bidi_cache_idx];
/* Pop the previous cache start from the stack. */
if (bidi_cache_sp <= 0)
- abort ();
+ emacs_abort ();
bidi_cache_start = bidi_cache_start_stack[--bidi_cache_sp];
/* Invalidate the last-used cache slot data. */
@@ -683,11 +685,11 @@ bidi_shelve_cache (void)
/* Restore the cache state from a copy stashed away by
bidi_shelve_cache, and free the buffer used to stash that copy.
- JUST_FREE non-zero means free the buffer, but don't restore the
+ JUST_FREE means free the buffer, but don't restore the
cache; used when the corresponding iterator is discarded instead of
being restored. */
void
-bidi_unshelve_cache (void *databuf, int just_free)
+bidi_unshelve_cache (void *databuf, bool just_free)
{
unsigned char *p = databuf;
@@ -755,12 +757,12 @@ bidi_initialize (void)
{
bidi_type_table = uniprop_table (intern ("bidi-class"));
if (NILP (bidi_type_table))
- abort ();
+ emacs_abort ();
staticpro (&bidi_type_table);
bidi_mirror_table = uniprop_table (intern ("mirroring"));
if (NILP (bidi_mirror_table))
- abort ();
+ emacs_abort ();
staticpro (&bidi_mirror_table);
Qparagraph_start = intern ("paragraph-start");
@@ -784,7 +786,7 @@ bidi_initialize (void)
/* Do whatever UAX#9 clause X8 says should be done at paragraph's
end. */
-static inline void
+static void
bidi_set_paragraph_end (struct bidi_it *bidi_it)
{
bidi_it->invalid_levels = 0;
@@ -795,7 +797,7 @@ bidi_set_paragraph_end (struct bidi_it *bidi_it)
/* Initialize the bidi iterator from buffer/string position CHARPOS. */
void
-bidi_init_it (EMACS_INT charpos, EMACS_INT bytepos, int frame_window_p,
+bidi_init_it (ptrdiff_t charpos, ptrdiff_t bytepos, bool frame_window_p,
struct bidi_it *bidi_it)
{
if (! bidi_initialized)
@@ -865,13 +867,12 @@ bidi_line_init (struct bidi_it *bidi_it)
/* Count bytes in string S between BEG/BEGBYTE and END. BEG and END
are zero-based character positions in S, BEGBYTE is byte position
- corresponding to BEG. UNIBYTE, if non-zero, means S is a unibyte
- string. */
-static inline EMACS_INT
-bidi_count_bytes (const unsigned char *s, const EMACS_INT beg,
- const EMACS_INT begbyte, const EMACS_INT end, int unibyte)
+ corresponding to BEG. UNIBYTE means S is a unibyte string. */
+static ptrdiff_t
+bidi_count_bytes (const unsigned char *s, const ptrdiff_t beg,
+ const ptrdiff_t begbyte, const ptrdiff_t end, bool unibyte)
{
- EMACS_INT pos = beg;
+ ptrdiff_t pos = beg;
const unsigned char *p = s + begbyte, *start = p;
if (unibyte)
@@ -879,7 +880,7 @@ bidi_count_bytes (const unsigned char *s, const EMACS_INT beg,
else
{
if (!CHAR_HEAD_P (*p))
- abort ();
+ emacs_abort ();
while (pos < end)
{
@@ -891,22 +892,22 @@ bidi_count_bytes (const unsigned char *s, const EMACS_INT beg,
return p - start;
}
-/* Fetch and returns the character at byte position BYTEPOS. If S is
+/* Fetch and return the character at byte position BYTEPOS. If S is
non-NULL, fetch the character from string S; otherwise fetch the
- character from the current buffer. UNIBYTE non-zero means S is a
+ character from the current buffer. UNIBYTE means S is a
unibyte string. */
-static inline int
-bidi_char_at_pos (EMACS_INT bytepos, const unsigned char *s, int unibyte)
+static int
+bidi_char_at_pos (ptrdiff_t bytepos, const unsigned char *s, bool unibyte)
{
if (s)
{
+ s += bytepos;
if (unibyte)
- return s[bytepos];
- else
- return STRING_CHAR (s + bytepos);
+ return *s;
}
else
- return FETCH_MULTIBYTE_CHAR (bytepos);
+ s = BYTE_POS_ADDR (bytepos);
+ return STRING_CHAR (s);
}
/* Fetch and return the character at BYTEPOS/CHARPOS. If that
@@ -916,22 +917,23 @@ bidi_char_at_pos (EMACS_INT bytepos, const unsigned char *s, int unibyte)
specifies the character position of the next display string, or -1
if not yet computed. When the next character is at or beyond that
position, the function updates DISP_POS with the position of the
- next display string. DISP_PROP non-zero means that there's really
+ next display string. *DISP_PROP non-zero means that there's really
a display string at DISP_POS, as opposed to when we searched till
- DISP_POS without finding one. If DISP_PROP is 2, it means the
+ DISP_POS without finding one. If *DISP_PROP is 2, it means the
display spec is of the form `(space ...)', which is replaced with
u+2029 to handle it as a paragraph separator. STRING->s is the C
string to iterate, or NULL if iterating over a buffer or a Lisp
string; in the latter case, STRING->lstring is the Lisp string. */
-static inline int
-bidi_fetch_char (EMACS_INT bytepos, EMACS_INT charpos, EMACS_INT *disp_pos,
+static int
+bidi_fetch_char (ptrdiff_t bytepos, ptrdiff_t charpos, ptrdiff_t *disp_pos,
int *disp_prop, struct bidi_string_data *string,
- int frame_window_p, EMACS_INT *ch_len, EMACS_INT *nchars)
+ bool frame_window_p, ptrdiff_t *ch_len, ptrdiff_t *nchars)
{
int ch;
- EMACS_INT endpos
+ ptrdiff_t endpos
= (string->s || STRINGP (string->lstring)) ? string->schars : ZV;
struct text_pos pos;
+ int len;
/* If we got past the last known position of display string, compute
the position of the next one. That position could be at CHARPOS. */
@@ -953,12 +955,12 @@ bidi_fetch_char (EMACS_INT bytepos, EMACS_INT charpos, EMACS_INT *disp_pos,
}
else if (charpos >= *disp_pos && *disp_prop)
{
- EMACS_INT disp_end_pos;
+ ptrdiff_t disp_end_pos;
/* We don't expect to find ourselves in the middle of a display
property. Hopefully, it will never be needed. */
if (charpos > *disp_pos)
- abort ();
+ emacs_abort ();
/* Text covered by `display' properties and overlays with
display properties or display strings is handled as a single
character that represents the entire run of characters
@@ -988,7 +990,7 @@ bidi_fetch_char (EMACS_INT bytepos, EMACS_INT charpos, EMACS_INT *disp_pos,
}
*nchars = disp_end_pos - *disp_pos;
if (*nchars <= 0)
- abort ();
+ emacs_abort ();
if (string->s)
*ch_len = bidi_count_bytes (string->s, *disp_pos, bytepos,
disp_end_pos, string->unibyte);
@@ -1003,7 +1005,6 @@ bidi_fetch_char (EMACS_INT bytepos, EMACS_INT charpos, EMACS_INT *disp_pos,
normal_char:
if (string->s)
{
- int len;
if (!string->unibyte)
{
@@ -1018,8 +1019,6 @@ bidi_fetch_char (EMACS_INT bytepos, EMACS_INT charpos, EMACS_INT *disp_pos,
}
else if (STRINGP (string->lstring))
{
- int len;
-
if (!string->unibyte)
{
ch = STRING_CHAR_AND_LENGTH (SDATA (string->lstring) + bytepos,
@@ -1034,8 +1033,8 @@ bidi_fetch_char (EMACS_INT bytepos, EMACS_INT charpos, EMACS_INT *disp_pos,
}
else
{
- ch = FETCH_MULTIBYTE_CHAR (bytepos);
- *ch_len = CHAR_BYTES (ch);
+ ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (bytepos), len);
+ *ch_len = len;
}
*nchars = 1;
}
@@ -1063,12 +1062,12 @@ bidi_fetch_char (EMACS_INT bytepos, EMACS_INT charpos, EMACS_INT *disp_pos,
following the buffer position, -1 if position is at the beginning
of a new paragraph, or -2 if position is neither at beginning nor
at end of a paragraph. */
-static EMACS_INT
-bidi_at_paragraph_end (EMACS_INT charpos, EMACS_INT bytepos)
+static ptrdiff_t
+bidi_at_paragraph_end (ptrdiff_t charpos, ptrdiff_t bytepos)
{
Lisp_Object sep_re;
Lisp_Object start_re;
- EMACS_INT val;
+ ptrdiff_t val;
sep_re = paragraph_separate_re;
start_re = paragraph_start_re;
@@ -1095,12 +1094,12 @@ bidi_at_paragraph_end (EMACS_INT charpos, EMACS_INT bytepos)
Value is the byte position of the paragraph's beginning, or
BEGV_BYTE if paragraph_start_re is still not found after looking
back MAX_PARAGRAPH_SEARCH lines in the buffer. */
-static EMACS_INT
-bidi_find_paragraph_start (EMACS_INT pos, EMACS_INT pos_byte)
+static ptrdiff_t
+bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte)
{
Lisp_Object re = paragraph_start_re;
- EMACS_INT limit = ZV, limit_byte = ZV_BYTE;
- EMACS_INT n = 0;
+ ptrdiff_t limit = ZV, limit_byte = ZV_BYTE;
+ ptrdiff_t n = 0;
while (pos_byte > BEGV_BYTE
&& n++ < MAX_PARAGRAPH_SEARCH
@@ -1118,12 +1117,18 @@ bidi_find_paragraph_start (EMACS_INT pos, EMACS_INT pos_byte)
return pos_byte;
}
+/* On a 3.4 GHz machine, searching forward for a strong directional
+ character in a long paragraph full of weaks or neutrals takes about
+ 1 ms for each 20K characters. The number below limits each call to
+ bidi_paragraph_init to less than 10 ms even on slow machines. */
+#define MAX_STRONG_CHAR_SEARCH 100000
+
/* Determine the base direction, a.k.a. base embedding level, of the
paragraph we are about to iterate through. If DIR is either L2R or
R2L, just use that. Otherwise, determine the paragraph direction
from the first strong directional character of the paragraph.
- NO_DEFAULT_P non-zero means don't default to L2R if the paragraph
+ NO_DEFAULT_P means don't default to L2R if the paragraph
has no strong directional characters and both DIR and
bidi_it->paragraph_dir are NEUTRAL_DIR. In that case, search back
in the buffer until a paragraph is found with a strong character,
@@ -1132,25 +1137,25 @@ bidi_find_paragraph_start (EMACS_INT pos, EMACS_INT pos_byte)
Note that this function gives the paragraph separator the same
direction as the preceding paragraph, even though Emacs generally
- views the separartor as not belonging to any paragraph. */
+ views the separator as not belonging to any paragraph. */
void
-bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, int no_default_p)
+bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, bool no_default_p)
{
- EMACS_INT bytepos = bidi_it->bytepos;
- int string_p = bidi_it->string.s != NULL || STRINGP (bidi_it->string.lstring);
- EMACS_INT pstartbyte;
+ ptrdiff_t bytepos = bidi_it->bytepos;
+ bool string_p = bidi_it->string.s || STRINGP (bidi_it->string.lstring);
+ ptrdiff_t pstartbyte;
/* Note that begbyte is a byte position, while end is a character
position. Yes, this is ugly, but we are trying to avoid costly
calls to BYTE_TO_CHAR and its ilk. */
- EMACS_INT begbyte = string_p ? 0 : BEGV_BYTE;
- EMACS_INT end = string_p ? bidi_it->string.schars : ZV;
+ ptrdiff_t begbyte = string_p ? 0 : BEGV_BYTE;
+ ptrdiff_t end = string_p ? bidi_it->string.schars : ZV;
/* Special case for an empty buffer. */
if (bytepos == begbyte && bidi_it->charpos == end)
dir = L2R;
/* We should never be called at EOB or before BEGV. */
else if (bidi_it->charpos >= end || bytepos < begbyte)
- abort ();
+ emacs_abort ();
if (dir == L2R)
{
@@ -1165,8 +1170,8 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, int no_default_p)
else if (dir == NEUTRAL_DIR) /* P2 */
{
int ch;
- EMACS_INT ch_len, nchars;
- EMACS_INT pos, disp_pos = -1;
+ ptrdiff_t ch_len, nchars;
+ ptrdiff_t pos, disp_pos = -1;
int disp_prop = 0;
bidi_type_t type;
const unsigned char *s;
@@ -1210,9 +1215,11 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, int no_default_p)
bidi_it->separator_limit = -1;
bidi_it->new_paragraph = 0;
- /* The following loop is run more than once only if NO_DEFAULT_P
- is non-zero, and only if we are iterating on a buffer. */
+ /* The following loop is run more than once only if NO_DEFAULT_P,
+ and only if we are iterating on a buffer. */
do {
+ ptrdiff_t pos1;
+
bytepos = pstartbyte;
if (!string_p)
pos = BYTE_TO_CHAR (bytepos);
@@ -1221,11 +1228,15 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, int no_default_p)
bidi_it->frame_window_p, &ch_len, &nchars);
type = bidi_get_type (ch, NEUTRAL_DIR);
+ pos1 = pos;
for (pos += nchars, bytepos += ch_len;
- (bidi_get_category (type) != STRONG)
- || (bidi_ignore_explicit_marks_for_paragraph_level
- && (type == RLE || type == RLO
- || type == LRE || type == LRO));
+ ((bidi_get_category (type) != STRONG)
+ || (bidi_ignore_explicit_marks_for_paragraph_level
+ && (type == RLE || type == RLO
+ || type == LRE || type == LRO)))
+ /* Stop when searched too far into an abnormally large
+ paragraph full of weak or neutral characters. */
+ && pos - pos1 < MAX_STRONG_CHAR_SEARCH;
type = bidi_get_type (ch, NEUTRAL_DIR))
{
if (pos >= end)
@@ -1262,8 +1273,8 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, int no_default_p)
bidi_it->paragraph_dir = L2R; /* P3 and HL1 */
else
{
- EMACS_INT prevpbyte = pstartbyte;
- EMACS_INT p = BYTE_TO_CHAR (pstartbyte), pbyte = pstartbyte;
+ ptrdiff_t prevpbyte = pstartbyte;
+ ptrdiff_t p = BYTE_TO_CHAR (pstartbyte), pbyte = pstartbyte;
/* Find the beginning of the previous paragraph, if any. */
while (pbyte > BEGV_BYTE && prevpbyte >= pstartbyte)
@@ -1282,7 +1293,7 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, int no_default_p)
&& no_default_p && bidi_it->paragraph_dir == NEUTRAL_DIR);
}
else
- abort ();
+ emacs_abort ();
/* Contrary to UAX#9 clause P3, we only default the paragraph
direction to L2R if we have no previous usable paragraph
@@ -1303,13 +1314,13 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, int no_default_p)
The rest of this file constitutes the core of the UBA implementation.
***********************************************************************/
-static inline int
+static bool
bidi_explicit_dir_char (int ch)
{
bidi_type_t ch_type;
if (!bidi_initialized)
- abort ();
+ emacs_abort ();
ch_type = (bidi_type_t) XINT (CHAR_TABLE_REF (bidi_type_table, ch));
return (ch_type == LRE || ch_type == LRO
|| ch_type == RLE || ch_type == RLO
@@ -1328,7 +1339,7 @@ bidi_resolve_explicit_1 (struct bidi_it *bidi_it)
int current_level;
int new_level;
bidi_dir_t override;
- int string_p = bidi_it->string.s != NULL || STRINGP (bidi_it->string.lstring);
+ bool string_p = bidi_it->string.s || STRINGP (bidi_it->string.lstring);
/* If reseat()'ed, don't advance, so as to start iteration from the
position where we were reseated. bidi_it->bytepos can be less
@@ -1362,10 +1373,10 @@ bidi_resolve_explicit_1 (struct bidi_it *bidi_it)
/* Advance to the next character, skipping characters covered by
display strings (nchars > 1). */
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
bidi_it->charpos += bidi_it->nchars;
if (bidi_it->ch_len == 0)
- abort ();
+ emacs_abort ();
bidi_it->bytepos += bidi_it->ch_len;
}
@@ -1527,7 +1538,7 @@ bidi_resolve_explicit (struct bidi_it *bidi_it)
{
int prev_level = bidi_it->level_stack[bidi_it->stack_idx].level;
int new_level = bidi_resolve_explicit_1 (bidi_it);
- EMACS_INT eob = bidi_it->string.s ? bidi_it->string.schars : ZV;
+ ptrdiff_t eob = bidi_it->string.s ? bidi_it->string.schars : ZV;
const unsigned char *s
= (STRINGP (bidi_it->string.lstring)
? SDATA (bidi_it->string.lstring)
@@ -1565,7 +1576,7 @@ bidi_resolve_explicit (struct bidi_it *bidi_it)
}
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
if (level == prev_level) /* empty embedding */
saved_it.ignore_bn_limit = bidi_it->charpos + bidi_it->nchars;
else /* this embedding is non-empty */
@@ -1615,7 +1626,7 @@ bidi_resolve_weak (struct bidi_it *bidi_it)
int next_char;
bidi_type_t type_of_next;
struct bidi_it saved_it;
- EMACS_INT eob
+ ptrdiff_t eob
= ((STRINGP (bidi_it->string.lstring) || bidi_it->string.s)
? bidi_it->string.schars : ZV);
@@ -1628,7 +1639,7 @@ bidi_resolve_weak (struct bidi_it *bidi_it)
|| type == RLE
|| type == RLO
|| type == PDF)
- abort ();
+ emacs_abort ();
if (new_level != prev_level
|| bidi_it->type == NEUTRAL_B)
@@ -1669,7 +1680,7 @@ bidi_resolve_weak (struct bidi_it *bidi_it)
else if (bidi_it->sor == L2R)
type = STRONG_L;
else /* shouldn't happen! */
- abort ();
+ emacs_abort ();
}
if (type == WEAK_EN /* W2 */
&& bidi_it->last_strong.type_after_w1 == STRONG_AL)
@@ -1745,13 +1756,13 @@ bidi_resolve_weak (struct bidi_it *bidi_it)
}
else if (bidi_it->next_en_pos >=0)
{
- EMACS_INT en_pos = bidi_it->charpos + bidi_it->nchars;
+ ptrdiff_t en_pos = bidi_it->charpos + bidi_it->nchars;
const unsigned char *s = (STRINGP (bidi_it->string.lstring)
? SDATA (bidi_it->string.lstring)
: bidi_it->string.s);
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
next_char
= (bidi_it->charpos + bidi_it->nchars >= eob
? BIDI_EOB
@@ -1826,7 +1837,7 @@ bidi_resolve_weak (struct bidi_it *bidi_it)
/* Resolve the type of a neutral character according to the type of
surrounding strong text and the current embedding level. */
-static inline bidi_type_t
+static bidi_type_t
bidi_resolve_neutral_1 (bidi_type_t prev_type, bidi_type_t next_type, int lev)
{
/* N1: European and Arabic numbers are treated as though they were R. */
@@ -1859,7 +1870,7 @@ bidi_resolve_neutral (struct bidi_it *bidi_it)
|| type == NEUTRAL_S
|| type == NEUTRAL_WS
|| type == NEUTRAL_ON))
- abort ();
+ emacs_abort ();
if ((type != NEUTRAL_B /* Don't risk entering the long loop below if
we are already at paragraph end. */
@@ -1914,7 +1925,7 @@ bidi_resolve_neutral (struct bidi_it *bidi_it)
bidi_type_t next_type;
if (bidi_it->scan_dir == -1)
- abort ();
+ emacs_abort ();
bidi_copy_it (&saved_it, bidi_it);
/* Scan the text forward until we find the first non-neutral
@@ -1952,7 +1963,7 @@ bidi_resolve_neutral (struct bidi_it *bidi_it)
case STRONG_AL:
/* Actually, STRONG_AL cannot happen here, because
bidi_resolve_weak converts it to STRONG_R, per W3. */
- xassert (type != STRONG_AL);
+ eassert (type != STRONG_AL);
next_type = type;
break;
case WEAK_EN:
@@ -1963,7 +1974,7 @@ bidi_resolve_neutral (struct bidi_it *bidi_it)
break;
case WEAK_BN:
if (!bidi_explicit_dir_char (bidi_it->ch))
- abort (); /* can't happen: BNs are skipped */
+ emacs_abort (); /* can't happen: BNs are skipped */
/* FALLTHROUGH */
case NEUTRAL_B:
/* Marched all the way to the end of this level run.
@@ -1982,7 +1993,7 @@ bidi_resolve_neutral (struct bidi_it *bidi_it)
}
break;
default:
- abort ();
+ emacs_abort ();
}
type = bidi_resolve_neutral_1 (saved_it.prev_for_neutral.type,
next_type, current_level);
@@ -2007,7 +2018,7 @@ bidi_type_of_next_char (struct bidi_it *bidi_it)
/* This should always be called during a forward scan. */
if (bidi_it->scan_dir != 1)
- abort ();
+ emacs_abort ();
/* Reset the limit until which to ignore BNs if we step out of the
area where we found only empty levels. */
@@ -2032,11 +2043,11 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
bidi_type_t type;
int level, prev_level = -1;
struct bidi_saved_info next_for_neutral;
- EMACS_INT next_char_pos = -2;
+ ptrdiff_t next_char_pos = -2;
if (bidi_it->scan_dir == 1)
{
- EMACS_INT eob
+ ptrdiff_t eob
= ((bidi_it->string.s || STRINGP (bidi_it->string.lstring))
? bidi_it->string.schars : ZV);
@@ -2091,7 +2102,7 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
if (bidi_it->scan_dir > 0)
{
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
next_char_pos = bidi_it->charpos + bidi_it->nchars;
}
else if (bidi_it->charpos >= bob)
@@ -2127,7 +2138,7 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
if (bidi_it->scan_dir == -1)
/* If we are going backwards, the iterator state is already cached
from previous scans, and should be fully resolved. */
- abort ();
+ emacs_abort ();
if (type == UNKNOWN_BT)
type = bidi_type_of_next_char (bidi_it);
@@ -2140,7 +2151,7 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
|| (type == WEAK_BN && prev_level == level))
{
if (bidi_it->next_for_neutral.type == UNKNOWN_BT)
- abort ();
+ emacs_abort ();
/* If the cached state shows a neutral character, it was not
resolved by bidi_resolve_neutral, so do it now. */
@@ -2154,7 +2165,7 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
|| type == WEAK_BN
|| type == WEAK_EN
|| type == WEAK_AN))
- abort ();
+ emacs_abort ();
bidi_it->type = type;
bidi_check_type (bidi_it->type);
@@ -2165,18 +2176,18 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
&& bidi_it->next_for_ws.type == UNKNOWN_BT)
{
int ch;
- EMACS_INT clen = bidi_it->ch_len;
- EMACS_INT bpos = bidi_it->bytepos;
- EMACS_INT cpos = bidi_it->charpos;
- EMACS_INT disp_pos = bidi_it->disp_pos;
- EMACS_INT nc = bidi_it->nchars;
+ ptrdiff_t clen = bidi_it->ch_len;
+ ptrdiff_t bpos = bidi_it->bytepos;
+ ptrdiff_t cpos = bidi_it->charpos;
+ ptrdiff_t disp_pos = bidi_it->disp_pos;
+ ptrdiff_t nc = bidi_it->nchars;
struct bidi_string_data bs = bidi_it->string;
bidi_type_t chtype;
- int fwp = bidi_it->frame_window_p;
+ bool fwp = bidi_it->frame_window_p;
int dpp = bidi_it->disp_prop;
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
do {
ch = bidi_fetch_char (bpos += clen, cpos += nc, &disp_pos, &dpp, &bs,
fwp, &clen, &nc);
@@ -2251,8 +2262,8 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
return level;
}
-/* Move to the other edge of a level given by LEVEL. If END_FLAG is
- non-zero, we are at the end of a level, and we need to prepare to
+/* Move to the other edge of a level given by LEVEL. If END_FLAG,
+ we are at the end of a level, and we need to prepare to
resume the scan of the lower level.
If this level's other edge is cached, we simply jump to it, filling
@@ -2272,7 +2283,7 @@ bidi_level_of_next_char (struct bidi_it *bidi_it)
function moves to point C, whereas the UAX#9 ``level 2 run'' ends
at point B. */
static void
-bidi_find_other_level_edge (struct bidi_it *bidi_it, int level, int end_flag)
+bidi_find_other_level_edge (struct bidi_it *bidi_it, int level, bool end_flag)
{
int dir = end_flag ? -bidi_it->scan_dir : bidi_it->scan_dir;
ptrdiff_t idx;
@@ -2285,8 +2296,9 @@ bidi_find_other_level_edge (struct bidi_it *bidi_it, int level, int end_flag)
{
int new_level;
+ /* If we are at end of level, its edges must be cached. */
if (end_flag)
- abort (); /* if we are at end of level, its edges must be cached */
+ emacs_abort ();
bidi_cache_iterator_state (bidi_it, 1);
do {
@@ -2304,7 +2316,7 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it)
struct gcpro gcpro1;
if (bidi_it->charpos < 0 || bidi_it->bytepos < 0)
- abort ();
+ emacs_abort ();
if (bidi_it->scan_dir == 0)
{
@@ -2346,7 +2358,7 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it)
scanning the text whenever we find a level change. */
if (new_level != old_level)
{
- int ascending = new_level > old_level;
+ bool ascending = new_level > old_level;
int level_to_search = ascending ? old_level + 1 : old_level;
int incr = ascending ? 1 : -1;
int expected_next_level = old_level + incr;
@@ -2411,11 +2423,11 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it)
bidi_it->separator_limit = bidi_it->string.schars;
else if (bidi_it->bytepos < ZV_BYTE)
{
- EMACS_INT sep_len
+ ptrdiff_t sep_len
= bidi_at_paragraph_end (bidi_it->charpos + bidi_it->nchars,
bidi_it->bytepos + bidi_it->ch_len);
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
if (sep_len >= 0)
{
bidi_it->new_paragraph = 1;
@@ -2477,6 +2489,6 @@ bidi_dump_cached_states (void)
fputs ("\n", stderr);
fputs ("pos ", stderr);
for (i = 0; i < bidi_cache_idx; i++)
- fprintf (stderr, "%*"pI"d", ndigits, bidi_cache[i].charpos);
+ fprintf (stderr, "%*"pD"d", ndigits, bidi_cache[i].charpos);
fputs ("\n", stderr);
}
diff --git a/src/blockinput.h b/src/blockinput.h
index aa46d67ee56..70822e29be7 100644
--- a/src/blockinput.h
+++ b/src/blockinput.h
@@ -1,5 +1,5 @@
/* blockinput.h - interface to blocking complicated interrupt-driven input.
- Copyright (C) 1989, 1993, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1989, 1993, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,109 +19,57 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef EMACS_BLOCKINPUT_H
#define EMACS_BLOCKINPUT_H
-#include "atimer.h"
+INLINE_HEADER_BEGIN
+#ifndef BLOCKINPUT_INLINE
+# define BLOCKINPUT_INLINE INLINE
+#endif
-/* When Emacs is using signal-driven input, the processing of those
- input signals can get pretty hairy. For example, when Emacs is
- running under X windows, handling an input signal can entail
- retrieving events from the X event queue, or making other X calls.
-
- If an input signal occurs while Emacs is in the midst of some
- non-reentrant code, and the signal processing invokes that same
- code, we lose. For example, malloc and the Xlib functions aren't
- usually re-entrant, and both are used by the X input signal handler
- - if we try to process an input signal in the midst of executing
- any of these functions, we'll lose.
+/* Emacs should avoid doing anything hairy in a signal handler, because
+ so many system functions are non-reentrant. For example, malloc
+ and the Xlib functions aren't usually re-entrant, so if they were
+ used by the SIGIO handler, we'd lose.
To avoid this, we make the following requirements:
- * Everyone must evaluate BLOCK_INPUT before entering these functions,
- and then call UNBLOCK_INPUT after performing them. Calls
- BLOCK_INPUT and UNBLOCK_INPUT may be nested.
+ * Everyone must evaluate BLOCK_INPUT before performing actions that
+ might conflict with a signal handler, and then call UNBLOCK_INPUT
+ after performing them. Calls BLOCK_INPUT and UNBLOCK_INPUT may be
+ nested.
* Any complicated interrupt handling code should test
- interrupt_input_blocked, and put off its work until later.
+ INPUT_BLOCKED_P, and put off its work until later.
* If the interrupt handling code wishes, it may set
- interrupt_input_pending to a non-zero value. If that flag is set
- when input becomes unblocked, UNBLOCK_INPUT will send a new SIGIO. */
-
-extern volatile int interrupt_input_blocked;
+ pending_signals to a non-zero value. If that flag is set
+ when input becomes unblocked, UNBLOCK_INPUT will then read
+ input and process timers.
-/* Nonzero means an input interrupt has arrived
- during the current critical section. */
-extern int interrupt_input_pending;
+ Historically, Emacs signal handlers did much more than they do now,
+ and this caused many BLOCK_INPUT calls to be sprinkled around the code.
+ FIXME: Remove calls that aren't needed now. */
+extern volatile int interrupt_input_blocked;
-/* Non-zero means asynchronous timers should be run when input is
- unblocked. */
-
-extern int pending_atimers;
+/* Begin critical section. */
+BLOCKINPUT_INLINE void
+block_input (void)
+{
+ interrupt_input_blocked++;
+}
-/* Begin critical section. */
-#define BLOCK_INPUT (interrupt_input_blocked++)
-
-/* End critical section.
-
- If doing signal-driven input, and a signal came in when input was
- blocked, reinvoke the signal handler now to deal with it.
-
- We used to have two possible definitions of this macro - one for
- when SIGIO was #defined, and one for when it wasn't; when SIGIO
- wasn't #defined, we wouldn't bother to check if we should re-invoke
- the signal handler. But that doesn't work very well; some of the
- files which use this macro don't #include the right files to get
- SIGIO.
-
- So, we always test interrupt_input_pending now; that's not too
- expensive, and it'll never get set if we don't need to resignal. */
-
-#define UNBLOCK_INPUT \
- do \
- { \
- --interrupt_input_blocked; \
- if (interrupt_input_blocked == 0) \
- { \
- if (interrupt_input_pending) \
- reinvoke_input_signal (); \
- if (pending_atimers) \
- do_pending_atimers (); \
- } \
- else if (interrupt_input_blocked < 0) \
- abort (); \
- } \
- while (0)
-
-/* Undo any number of BLOCK_INPUT calls,
- and also reinvoke any pending signal. */
-
-#define TOTALLY_UNBLOCK_INPUT \
- do if (interrupt_input_blocked != 0) \
- { \
- interrupt_input_blocked = 1; \
- UNBLOCK_INPUT; \
- } \
- while (0)
-
-/* Undo any number of BLOCK_INPUT calls down to level LEVEL,
- and also (if the level is now 0) reinvoke any pending signal. */
-
-#define UNBLOCK_INPUT_TO(LEVEL) \
- do \
- { \
- interrupt_input_blocked = (LEVEL) + 1; \
- UNBLOCK_INPUT; \
- } \
- while (0)
-
-#define UNBLOCK_INPUT_RESIGNAL UNBLOCK_INPUT
+extern void unblock_input (void);
+extern void totally_unblock_input (void);
+extern void unblock_input_to (int);
/* In critical section ? */
-#define INPUT_BLOCKED_P (interrupt_input_blocked > 0)
-/* Defined in keyboard.c */
-extern void reinvoke_input_signal (void);
+BLOCKINPUT_INLINE bool
+input_blocked_p (void)
+{
+ return 0 < interrupt_input_blocked;
+}
-#endif /* EMACS_BLOCKINPUT_H */
+INLINE_HEADER_END
+#endif /* EMACS_BLOCKINPUT_H */
diff --git a/src/buffer.c b/src/buffer.c
index a482493fac7..619a729a859 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1,6 +1,6 @@
/* Buffer manipulation primitives for GNU Emacs.
-Copyright (C) 1985-1989, 1993-1995, 1997-2011 Free Software Foundation, Inc.
+Copyright (C) 1985-1989, 1993-1995, 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,12 +19,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+#define BUFFER_INLINE EXTERN_INLINE
+
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/param.h>
#include <errno.h>
#include <stdio.h>
-#include <setjmp.h>
#include <unistd.h>
#include <verify.h>
@@ -33,8 +34,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "intervals.h"
#include "window.h"
#include "commands.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "region-cache.h"
#include "indent.h"
#include "blockinput.h"
@@ -42,7 +43,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "keymap.h"
#include "frame.h"
-struct buffer *current_buffer; /* the current buffer */
+struct buffer *current_buffer; /* The current buffer. */
/* First buffer in chain of all buffers (in reverse order of creation).
Threaded through ->header.next.buffer. */
@@ -56,11 +57,7 @@ struct buffer *all_buffers;
Setting the default value also goes through the alist of buffers
and stores into each buffer that does not say it has a local value. */
-DECL_ALIGN (struct buffer, buffer_defaults);
-
-/* A Lisp_Object pointer to the above, used for staticpro */
-
-static Lisp_Object Vbuffer_defaults;
+struct buffer alignas (GCALIGNMENT) buffer_defaults;
/* This structure marks which slots in a buffer have corresponding
default values in buffer_defaults.
@@ -76,17 +73,14 @@ static Lisp_Object Vbuffer_defaults;
and the corresponding slot in buffer_defaults is not used.
If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
- zero, that is a bug */
+ zero, that is a bug. */
struct buffer buffer_local_flags;
/* This structure holds the names of symbols whose values may be
- buffer-local. It is indexed and accessed in the same way as the above. */
-
-DECL_ALIGN (struct buffer, buffer_local_symbols);
+ buffer-local. It is indexed and accessed in the same way as the above. */
-/* A Lisp_Object pointer to the above, used for staticpro */
-static Lisp_Object Vbuffer_local_symbols;
+struct buffer alignas (GCALIGNMENT) buffer_local_symbols;
/* Return the symbol of the per-buffer variable at offset OFFSET in
the buffer structure. */
@@ -97,7 +91,7 @@ static Lisp_Object Vbuffer_local_symbols;
/* Maximum length of an overlay vector. */
#define OVERLAY_COUNT_MAX \
((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \
- min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object)))
+ min (PTRDIFF_MAX, SIZE_MAX) / word_size))
/* Flags indicating which built-in buffer-local variables
are permanent locals. */
@@ -107,15 +101,13 @@ static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
int last_per_buffer_idx;
-static Lisp_Object Fset_buffer_major_mode (Lisp_Object);
-static Lisp_Object Fdelete_overlay (Lisp_Object);
static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
- int after, Lisp_Object arg1,
+ bool after, Lisp_Object arg1,
Lisp_Object arg2, Lisp_Object arg3);
static void swap_out_buffer_local_variables (struct buffer *b);
-static void reset_buffer_local_variables (struct buffer *b, int permanent_too);
+static void reset_buffer_local_variables (struct buffer *, bool);
-/* Alist of all buffer names vs the buffers. */
+/* Alist of all buffer names vs the buffers. */
/* This used to be a variable, but is no longer,
to prevent lossage due to user rplac'ing this alist or its elements. */
Lisp_Object Vbuffer_alist;
@@ -128,14 +120,13 @@ static Lisp_Object Qchange_major_mode_hook;
Lisp_Object Qfirst_change_hook;
Lisp_Object Qbefore_change_functions;
Lisp_Object Qafter_change_functions;
-static Lisp_Object Qucs_set_table_for_input;
static Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
static Lisp_Object Qpermanent_local_hook;
static Lisp_Object Qprotected_field;
-static Lisp_Object QSFundamental; /* A string "Fundamental" */
+static Lisp_Object QSFundamental; /* A string "Fundamental". */
static Lisp_Object Qkill_buffer_hook;
static Lisp_Object Qbuffer_list_update_hook;
@@ -155,8 +146,230 @@ Lisp_Object Qinsert_behind_hooks;
static void alloc_buffer_text (struct buffer *, ptrdiff_t);
static void free_buffer_text (struct buffer *b);
static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *);
-static void modify_overlay (struct buffer *, EMACS_INT, EMACS_INT);
-static Lisp_Object buffer_lisp_local_variables (struct buffer *);
+static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
+static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
+
+/* These setters are used only in this file, so they can be private. */
+static void
+bset_abbrev_mode (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (abbrev_mode) = val;
+}
+static void
+bset_abbrev_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (abbrev_table) = val;
+}
+static void
+bset_auto_fill_function (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (auto_fill_function) = val;
+}
+static void
+bset_auto_save_file_format (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (auto_save_file_format) = val;
+}
+static void
+bset_auto_save_file_name (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (auto_save_file_name) = val;
+}
+static void
+bset_backed_up (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (backed_up) = val;
+}
+static void
+bset_begv_marker (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (begv_marker) = val;
+}
+static void
+bset_bidi_display_reordering (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (bidi_display_reordering) = val;
+}
+static void
+bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (buffer_file_coding_system) = val;
+}
+static void
+bset_cache_long_line_scans (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (cache_long_line_scans) = val;
+}
+static void
+bset_case_fold_search (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (case_fold_search) = val;
+}
+static void
+bset_ctl_arrow (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (ctl_arrow) = val;
+}
+static void
+bset_cursor_in_non_selected_windows (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (cursor_in_non_selected_windows) = val;
+}
+static void
+bset_cursor_type (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (cursor_type) = val;
+}
+static void
+bset_display_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (display_table) = val;
+}
+static void
+bset_extra_line_spacing (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (extra_line_spacing) = val;
+}
+static void
+bset_file_format (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (file_format) = val;
+}
+static void
+bset_file_truename (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (file_truename) = val;
+}
+static void
+bset_fringe_cursor_alist (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (fringe_cursor_alist) = val;
+}
+static void
+bset_fringe_indicator_alist (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (fringe_indicator_alist) = val;
+}
+static void
+bset_fringes_outside_margins (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (fringes_outside_margins) = val;
+}
+static void
+bset_header_line_format (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (header_line_format) = val;
+}
+static void
+bset_indicate_buffer_boundaries (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (indicate_buffer_boundaries) = val;
+}
+static void
+bset_indicate_empty_lines (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (indicate_empty_lines) = val;
+}
+static void
+bset_invisibility_spec (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (invisibility_spec) = val;
+}
+static void
+bset_left_fringe_width (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (left_fringe_width) = val;
+}
+static void
+bset_major_mode (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (major_mode) = val;
+}
+static void
+bset_mark (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (mark) = val;
+}
+static void
+bset_minor_modes (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (minor_modes) = val;
+}
+static void
+bset_mode_line_format (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (mode_line_format) = val;
+}
+static void
+bset_mode_name (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (mode_name) = val;
+}
+static void
+bset_name (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (name) = val;
+}
+static void
+bset_overwrite_mode (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (overwrite_mode) = val;
+}
+static void
+bset_pt_marker (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (pt_marker) = val;
+}
+static void
+bset_right_fringe_width (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (right_fringe_width) = val;
+}
+static void
+bset_save_length (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (save_length) = val;
+}
+static void
+bset_scroll_bar_width (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (scroll_bar_width) = val;
+}
+static void
+bset_scroll_down_aggressively (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (scroll_down_aggressively) = val;
+}
+static void
+bset_scroll_up_aggressively (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (scroll_up_aggressively) = val;
+}
+static void
+bset_selective_display (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (selective_display) = val;
+}
+static void
+bset_selective_display_ellipses (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (selective_display_ellipses) = val;
+}
+static void
+bset_vertical_scroll_bar_type (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (vertical_scroll_bar_type) = val;
+}
+static void
+bset_word_wrap (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (word_wrap) = val;
+}
+static void
+bset_zv_marker (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (zv_marker) = val;
+}
/* For debugging; temporary. See set_buffer_internal. */
/* Lisp_Object Qlisp_mode, Vcheck_symbol; */
@@ -174,7 +387,7 @@ DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
Value is nil if OBJECT is not a buffer or if it has been killed. */)
(Lisp_Object object)
{
- return ((BUFFERP (object) && ! NILP (BVAR (XBUFFER (object), name)))
+ return ((BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))
? Qt : Qnil);
}
@@ -193,7 +406,6 @@ followed by the rest of the buffers. */)
Lisp_Object framelist, prevlist, tail;
Lisp_Object args[3];
- CHECK_FRAME (frame);
framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
prevlist = Fnreverse (Fcopy_sequence
(XFRAME (frame)->buried_buffer_list));
@@ -272,7 +484,11 @@ See also `find-buffer-visiting'. */)
call the corresponding file handler. */
handler = Ffind_file_name_handler (filename, Qget_file_buffer);
if (!NILP (handler))
- return call2 (handler, Qget_file_buffer, filename);
+ {
+ Lisp_Object handled_buf = call2 (handler, Qget_file_buffer,
+ filename);
+ return BUFFERP (handled_buf) ? handled_buf : Qnil;
+ }
for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
{
@@ -328,14 +544,16 @@ even if it is dead. The return value is never nil. */)
/* An ordinary buffer uses its own struct buffer_text. */
b->text = &b->own_text;
- b->base_buffer = 0;
+ b->base_buffer = NULL;
+ /* No one shares the text with us now. */
+ b->indirections = 0;
BUF_GAP_SIZE (b) = 20;
- BLOCK_INPUT;
+ block_input ();
/* We allocate extra 1-byte at the tail and keep it always '\0' for
anchoring a search. */
alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
- UNBLOCK_INPUT;
+ unblock_input ();
if (! BUF_BEG_ADDR (b))
buffer_memory_full (BUF_GAP_SIZE (b) + 1);
@@ -355,7 +573,7 @@ even if it is dead. The return value is never nil. */)
BUF_CHARS_MODIFF (b) = 1;
BUF_OVERLAY_MODIFF (b) = 1;
BUF_SAVE_MODIFF (b) = 1;
- BUF_INTERVALS (b) = 0;
+ set_buffer_intervals (b, NULL);
BUF_UNCHANGED_MODIFIED (b) = 1;
BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
BUF_END_UNCHANGED (b) = 0;
@@ -365,31 +583,26 @@ even if it is dead. The return value is never nil. */)
b->newline_cache = 0;
b->width_run_cache = 0;
- BVAR (b, width_table) = Qnil;
+ bset_width_table (b, Qnil);
b->prevent_redisplay_optimizations_p = 1;
- /* Put this on the chain of all buffers including killed ones. */
- b->header.next.buffer = all_buffers;
- all_buffers = b;
-
/* An ordinary buffer normally doesn't need markers
to handle BEGV and ZV. */
- BVAR (b, pt_marker) = Qnil;
- BVAR (b, begv_marker) = Qnil;
- BVAR (b, zv_marker) = Qnil;
+ bset_pt_marker (b, Qnil);
+ bset_begv_marker (b, Qnil);
+ bset_zv_marker (b, Qnil);
name = Fcopy_sequence (buffer_or_name);
- STRING_SET_INTERVALS (name, NULL_INTERVAL);
- BVAR (b, name) = name;
+ set_string_intervals (name, NULL);
+ bset_name (b, name);
- BVAR (b, undo_list) = (SREF (name, 0) != ' ') ? Qnil : Qt;
+ bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
reset_buffer (b);
reset_buffer_local_variables (b, 1);
- BVAR (b, mark) = Fmake_marker ();
+ bset_mark (b, Fmake_marker ());
BUF_MARKERS (b) = NULL;
- BVAR (b, name) = name;
/* Put this in the alist of all live buffers. */
XSETBUFFER (buffer, b);
@@ -398,13 +611,6 @@ even if it is dead. The return value is never nil. */)
if (!NILP (Vrun_hooks))
call1 (Vrun_hooks, Qbuffer_list_update_hook);
- /* An error in calling the function here (should someone redefine it)
- can lead to infinite regress until you run out of stack. rms
- says that's not worth protecting against. */
- if (!NILP (Ffboundp (Qucs_set_table_for_input)))
- /* buffer is on buffer-alist, so no gcpro. */
- call1 (Qucs_set_table_for_input, buffer);
-
return buffer;
}
@@ -415,36 +621,24 @@ even if it is dead. The return value is never nil. */)
static struct Lisp_Overlay *
copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
{
- Lisp_Object buffer;
struct Lisp_Overlay *result = NULL, *tail = NULL;
- XSETBUFFER (buffer, b);
-
for (; list; list = list->next)
{
- Lisp_Object overlay, start, end, old_overlay;
- EMACS_INT charpos;
-
- XSETMISC (old_overlay, list);
- charpos = marker_position (OVERLAY_START (old_overlay));
- start = Fmake_marker ();
- Fset_marker (start, make_number (charpos), buffer);
- XMARKER (start)->insertion_type
- = XMARKER (OVERLAY_START (old_overlay))->insertion_type;
-
- charpos = marker_position (OVERLAY_END (old_overlay));
- end = Fmake_marker ();
- Fset_marker (end, make_number (charpos), buffer);
- XMARKER (end)->insertion_type
- = XMARKER (OVERLAY_END (old_overlay))->insertion_type;
-
- overlay = allocate_misc ();
- XMISCTYPE (overlay) = Lisp_Misc_Overlay;
- OVERLAY_START (overlay) = start;
- OVERLAY_END (overlay) = end;
- OVERLAY_PLIST (overlay) = Fcopy_sequence (OVERLAY_PLIST (old_overlay));
- XOVERLAY (overlay)->next = NULL;
+ Lisp_Object overlay, start, end;
+ struct Lisp_Marker *m;
+
+ eassert (MARKERP (list->start));
+ m = XMARKER (list->start);
+ start = build_marker (b, m->charpos, m->bytepos);
+ XMARKER (start)->insertion_type = m->insertion_type;
+
+ eassert (MARKERP (list->end));
+ m = XMARKER (list->end);
+ end = build_marker (b, m->charpos, m->bytepos);
+ XMARKER (end)->insertion_type = m->insertion_type;
+ overlay = build_overlay (start, end, Fcopy_sequence (list->plist));
if (tail)
tail = tail->next = XOVERLAY (overlay);
else
@@ -454,6 +648,19 @@ copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
return result;
}
+/* Set an appropriate overlay of B. */
+
+static void
+set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
+{
+ b->overlays_before = o;
+}
+
+static void
+set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
+{
+ b->overlays_after = o;
+}
/* Clone per-buffer values of buffer FROM.
@@ -465,16 +672,9 @@ copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
static void
clone_per_buffer_values (struct buffer *from, struct buffer *to)
{
- Lisp_Object to_buffer;
int offset;
- XSETBUFFER (to_buffer, to);
-
- /* buffer-local Lisp variables start at `undo_list',
- tho only the ones from `name' on are GC'd normally. */
- for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER);
- offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER);
- offset += sizeof (Lisp_Object))
+ FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
{
Lisp_Object obj;
@@ -482,26 +682,26 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to)
if (offset == PER_BUFFER_VAR_OFFSET (name))
continue;
- obj = PER_BUFFER_VALUE (from, offset);
+ obj = per_buffer_value (from, offset);
if (MARKERP (obj) && XMARKER (obj)->buffer == from)
{
struct Lisp_Marker *m = XMARKER (obj);
- obj = Fmake_marker ();
+
+ obj = build_marker (to, m->charpos, m->bytepos);
XMARKER (obj)->insertion_type = m->insertion_type;
- set_marker_both (obj, to_buffer, m->charpos, m->bytepos);
}
- PER_BUFFER_VALUE (to, offset) = obj;
+ set_per_buffer_value (to, offset, obj);
}
memcpy (to->local_flags, from->local_flags, sizeof to->local_flags);
- to->overlays_before = copy_overlays (to, from->overlays_before);
- to->overlays_after = copy_overlays (to, from->overlays_after);
+ set_buffer_overlays_before (to, copy_overlays (to, from->overlays_before));
+ set_buffer_overlays_after (to, copy_overlays (to, from->overlays_after));
/* Get (a copy of) the alist of Lisp-level local variables of FROM
and install that in TO. */
- BVAR (to, local_var_alist) = buffer_lisp_local_variables (from);
+ bset_local_var_alist (to, buffer_lisp_local_variables (from, 1));
}
@@ -574,7 +774,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
base_buffer = Fget_buffer (base_buffer);
if (NILP (base_buffer))
error ("No such buffer: `%s'", SDATA (tem));
- if (NILP (BVAR (XBUFFER (base_buffer), name)))
+ if (!BUFFER_LIVE_P (XBUFFER (base_buffer)))
error ("Base buffer has been killed");
if (SCHARS (name) == 0)
@@ -582,12 +782,18 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
b = allocate_buffer ();
+ /* No double indirection - if base buffer is indirect,
+ new buffer becomes an indirect to base's base. */
b->base_buffer = (XBUFFER (base_buffer)->base_buffer
? XBUFFER (base_buffer)->base_buffer
: XBUFFER (base_buffer));
/* Use the base buffer's text object. */
b->text = b->base_buffer->text;
+ /* We have no own text. */
+ b->indirections = -1;
+ /* Notify base buffer that we share the text now. */
+ b->base_buffer->indirections++;
b->pt = b->base_buffer->pt;
b->begv = b->base_buffer->begv;
@@ -598,15 +804,11 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
b->newline_cache = 0;
b->width_run_cache = 0;
- BVAR (b, width_table) = Qnil;
-
- /* Put this on the chain of all buffers including killed ones. */
- b->header.next.buffer = all_buffers;
- all_buffers = b;
+ bset_width_table (b, Qnil);
name = Fcopy_sequence (name);
- STRING_SET_INTERVALS (name, NULL_INTERVAL);
- BVAR (b, name) = name;
+ set_string_intervals (name, NULL);
+ bset_name (b, name);
reset_buffer (b);
reset_buffer_local_variables (b, 1);
@@ -615,11 +817,11 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
XSETBUFFER (buf, b);
Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
- BVAR (b, mark) = Fmake_marker ();
- BVAR (b, name) = name;
+ bset_mark (b, Fmake_marker ());
/* The multibyte status belongs to the base buffer. */
- BVAR (b, enable_multibyte_characters) = BVAR (b->base_buffer, enable_multibyte_characters);
+ bset_enable_multibyte_characters
+ (b, BVAR (b->base_buffer, enable_multibyte_characters));
/* Make sure the base buffer has markers for its narrowing. */
if (NILP (BVAR (b->base_buffer, pt_marker)))
@@ -627,32 +829,27 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
eassert (NILP (BVAR (b->base_buffer, begv_marker)));
eassert (NILP (BVAR (b->base_buffer, zv_marker)));
- BVAR (b->base_buffer, pt_marker) = Fmake_marker ();
- set_marker_both (BVAR (b->base_buffer, pt_marker), base_buffer,
- b->base_buffer->pt,
- b->base_buffer->pt_byte);
+ bset_pt_marker (b->base_buffer,
+ build_marker (b->base_buffer, b->base_buffer->pt,
+ b->base_buffer->pt_byte));
- BVAR (b->base_buffer, begv_marker) = Fmake_marker ();
- set_marker_both (BVAR (b->base_buffer, begv_marker), base_buffer,
- b->base_buffer->begv,
- b->base_buffer->begv_byte);
+ bset_begv_marker (b->base_buffer,
+ build_marker (b->base_buffer, b->base_buffer->begv,
+ b->base_buffer->begv_byte));
+
+ bset_zv_marker (b->base_buffer,
+ build_marker (b->base_buffer, b->base_buffer->zv,
+ b->base_buffer->zv_byte));
- BVAR (b->base_buffer, zv_marker) = Fmake_marker ();
- set_marker_both (BVAR (b->base_buffer, zv_marker), base_buffer,
- b->base_buffer->zv,
- b->base_buffer->zv_byte);
XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1;
}
if (NILP (clone))
{
/* Give the indirect buffer markers for its narrowing. */
- BVAR (b, pt_marker) = Fmake_marker ();
- set_marker_both (BVAR (b, pt_marker), buf, b->pt, b->pt_byte);
- BVAR (b, begv_marker) = Fmake_marker ();
- set_marker_both (BVAR (b, begv_marker), buf, b->begv, b->begv_byte);
- BVAR (b, zv_marker) = Fmake_marker ();
- set_marker_both (BVAR (b, zv_marker), buf, b->zv, b->zv_byte);
+ bset_pt_marker (b, build_marker (b, b->pt, b->pt_byte));
+ bset_begv_marker (b, build_marker (b, b->begv, b->begv_byte));
+ bset_zv_marker (b, build_marker (b, b->zv, b->zv_byte));
XMARKER (BVAR (b, zv_marker))->insertion_type = 1;
}
else
@@ -660,11 +857,11 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
struct buffer *old_b = current_buffer;
clone_per_buffer_values (b->base_buffer, b);
- BVAR (b, filename) = Qnil;
- BVAR (b, file_truename) = Qnil;
- BVAR (b, display_count) = make_number (0);
- BVAR (b, backed_up) = Qnil;
- BVAR (b, auto_save_file_name) = Qnil;
+ bset_filename (b, Qnil);
+ bset_file_truename (b, Qnil);
+ bset_display_count (b, make_number (0));
+ bset_backed_up (b, Qnil);
+ bset_auto_save_file_name (b, Qnil);
set_buffer_internal_1 (b);
Fset (intern ("buffer-save-without-query"), Qnil);
Fset (intern ("buffer-file-number"), Qnil);
@@ -679,27 +876,44 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
return buf;
}
+/* Mark OV as no longer associated with B. */
+
+static void
+drop_overlay (struct buffer *b, struct Lisp_Overlay *ov)
+{
+ eassert (b == XBUFFER (Fmarker_buffer (ov->start)));
+ modify_overlay (b, marker_position (ov->start),
+ marker_position (ov->end));
+ Fset_marker (ov->start, Qnil, Qnil);
+ Fset_marker (ov->end, Qnil, Qnil);
+
+}
+
+/* Delete all overlays of B and reset it's overlay lists. */
+
void
delete_all_overlays (struct buffer *b)
{
- Lisp_Object overlay;
+ struct Lisp_Overlay *ov, *next;
- /* `reset_buffer' blindly sets the list of overlays to NULL, so we
- have to empty the list, otherwise we end up with overlays that
- think they belong to this buffer while the buffer doesn't know about
- them any more. */
- while (b->overlays_before)
+ /* FIXME: Since each drop_overlay will scan BUF_MARKERS to unlink its
+ markers, we have an unneeded O(N^2) behavior here. */
+ for (ov = b->overlays_before; ov; ov = next)
{
- XSETMISC (overlay, b->overlays_before);
- Fdelete_overlay (overlay);
+ drop_overlay (b, ov);
+ next = ov->next;
+ ov->next = NULL;
}
- while (b->overlays_after)
+
+ for (ov = b->overlays_after; ov; ov = next)
{
- XSETMISC (overlay, b->overlays_after);
- Fdelete_overlay (overlay);
+ drop_overlay (b, ov);
+ next = ov->next;
+ ov->next = NULL;
}
- eassert (b->overlays_before == NULL);
- eassert (b->overlays_after == NULL);
+
+ set_buffer_overlays_before (b, NULL);
+ set_buffer_overlays_after (b, NULL);
}
/* Reinitialize everything about a buffer except its name and contents
@@ -712,34 +926,35 @@ delete_all_overlays (struct buffer *b)
void
reset_buffer (register struct buffer *b)
{
- BVAR (b, filename) = Qnil;
- BVAR (b, file_truename) = Qnil;
- BVAR (b, directory) = (current_buffer) ? BVAR (current_buffer, directory) : Qnil;
- b->modtime = 0;
+ bset_filename (b, Qnil);
+ bset_file_truename (b, Qnil);
+ bset_directory (b, current_buffer ? BVAR (current_buffer, directory) : Qnil);
+ b->modtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS);
b->modtime_size = -1;
XSETFASTINT (BVAR (b, save_length), 0);
b->last_window_start = 1;
/* It is more conservative to start out "changed" than "unchanged". */
b->clip_changed = 0;
b->prevent_redisplay_optimizations_p = 1;
- BVAR (b, backed_up) = Qnil;
+ bset_backed_up (b, Qnil);
BUF_AUTOSAVE_MODIFF (b) = 0;
b->auto_save_failure_time = 0;
- BVAR (b, auto_save_file_name) = Qnil;
- BVAR (b, read_only) = Qnil;
- b->overlays_before = NULL;
- b->overlays_after = NULL;
+ bset_auto_save_file_name (b, Qnil);
+ bset_read_only (b, Qnil);
+ set_buffer_overlays_before (b, NULL);
+ set_buffer_overlays_after (b, NULL);
b->overlay_center = BEG;
- BVAR (b, mark_active) = Qnil;
- BVAR (b, point_before_scroll) = Qnil;
- BVAR (b, file_format) = Qnil;
- BVAR (b, auto_save_file_format) = Qt;
- BVAR (b, last_selected_window) = Qnil;
- XSETINT (BVAR (b, display_count), 0);
- BVAR (b, display_time) = Qnil;
- BVAR (b, enable_multibyte_characters) = BVAR (&buffer_defaults, enable_multibyte_characters);
- BVAR (b, cursor_type) = BVAR (&buffer_defaults, cursor_type);
- BVAR (b, extra_line_spacing) = BVAR (&buffer_defaults, extra_line_spacing);
+ bset_mark_active (b, Qnil);
+ bset_point_before_scroll (b, Qnil);
+ bset_file_format (b, Qnil);
+ bset_auto_save_file_format (b, Qt);
+ bset_last_selected_window (b, Qnil);
+ bset_display_count (b, make_number (0));
+ bset_display_time (b, Qnil);
+ bset_enable_multibyte_characters
+ (b, BVAR (&buffer_defaults, enable_multibyte_characters));
+ bset_cursor_type (b, BVAR (&buffer_defaults, cursor_type));
+ bset_extra_line_spacing (b, BVAR (&buffer_defaults, extra_line_spacing));
b->display_error_modiff = 0;
}
@@ -749,24 +964,22 @@ reset_buffer (register struct buffer *b)
it does not treat permanent locals consistently.
Instead, use Fkill_all_local_variables.
- If PERMANENT_TOO is 1, then we reset permanent
- buffer-local variables. If PERMANENT_TOO is 0,
- we preserve those. */
+ If PERMANENT_TOO, reset permanent buffer-local variables.
+ If not, preserve those. */
static void
-reset_buffer_local_variables (register struct buffer *b, int permanent_too)
+reset_buffer_local_variables (struct buffer *b, bool permanent_too)
{
- register int offset;
- int i;
+ int offset, i;
/* Reset the major mode to Fundamental, together with all the
things that depend on the major mode.
default-major-mode is handled at a higher level.
We ignore it here. */
- BVAR (b, major_mode) = Qfundamental_mode;
- BVAR (b, keymap) = Qnil;
- BVAR (b, mode_name) = QSFundamental;
- BVAR (b, minor_modes) = Qnil;
+ bset_major_mode (b, Qfundamental_mode);
+ bset_keymap (b, Qnil);
+ bset_mode_name (b, QSFundamental);
+ bset_minor_modes (b, Qnil);
/* If the standard case table has been altered and invalidated,
fix up its insides first. */
@@ -775,15 +988,15 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too)
&& CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
Fset_standard_case_table (Vascii_downcase_table);
- BVAR (b, downcase_table) = Vascii_downcase_table;
- BVAR (b, upcase_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[0];
- BVAR (b, case_canon_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[1];
- BVAR (b, case_eqv_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[2];
- BVAR (b, invisibility_spec) = Qt;
+ bset_downcase_table (b, Vascii_downcase_table);
+ bset_upcase_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[0]);
+ bset_case_canon_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[1]);
+ bset_case_eqv_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[2]);
+ bset_invisibility_spec (b, Qt);
/* Reset all (or most) per-buffer variables to their defaults. */
if (permanent_too)
- BVAR (b, local_var_alist) = Qnil;
+ bset_local_var_alist (b, Qnil);
else
{
Lisp_Object tmp, prop, last = Qnil;
@@ -817,7 +1030,7 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too)
}
/* Delete this local variable. */
else if (NILP (last))
- BVAR (b, local_var_alist) = XCDR (tmp);
+ bset_local_var_alist (b, XCDR (tmp));
else
XSETCDR (last, XCDR (tmp));
}
@@ -826,20 +1039,14 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too)
if (permanent_too || buffer_permanent_local_flags[i] == 0)
SET_PER_BUFFER_VALUE_P (b, i, 0);
- /* For each slot that has a default value,
- copy that into the slot. */
-
- /* buffer-local Lisp variables start at `undo_list',
- tho only the ones from `name' on are GC'd normally. */
- for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER);
- offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER);
- offset += sizeof (Lisp_Object))
+ /* For each slot that has a default value, copy that into the slot. */
+ FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
{
int idx = PER_BUFFER_IDX (offset);
if ((idx > 0
&& (permanent_too
|| buffer_permanent_local_flags[idx] == 0)))
- PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
+ set_per_buffer_value (b, offset, per_buffer_default (offset));
}
}
@@ -854,12 +1061,16 @@ If there is no live buffer named NAME, then return NAME.
Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
\(starting at 2) until an unused name is found, and then return that name.
Optional second argument IGNORE specifies a name that is okay to use (if
-it is in the sequence to be tried) even if a buffer with that name exists. */)
+it is in the sequence to be tried) even if a buffer with that name exists.
+
+If NAME begins with a space (i.e., a buffer that is not normally
+visible to users), then if buffer NAME already exists a random number
+is first appended to NAME, to speed up finding a non-existent buffer. */)
(register Lisp_Object name, Lisp_Object ignore)
{
- register Lisp_Object gentemp, tem;
- EMACS_INT count;
- char number[INT_BUFSIZE_BOUND (EMACS_INT) + sizeof "<>"];
+ register Lisp_Object gentemp, tem, tem2;
+ ptrdiff_t count;
+ char number[INT_BUFSIZE_BOUND (ptrdiff_t) + sizeof "<>"];
CHECK_STRING (name);
@@ -870,11 +1081,24 @@ it is in the sequence to be tried) even if a buffer with that name exists. */)
if (NILP (tem))
return name;
+ if (!strncmp (SSDATA (name), " ", 1)) /* see bug#1229 */
+ {
+ /* Note fileio.c:make_temp_name does random differently. */
+ tem2 = concat2 (name, make_formatted_string
+ (number, "-%"pI"d",
+ XFASTINT (Frandom (make_number (999999)))));
+ tem = Fget_buffer (tem2);
+ if (NILP (tem))
+ return tem2;
+ }
+ else
+ tem2 = name;
+
count = 1;
while (1)
{
- sprintf (number, "<%"pI"d>", ++count);
- gentemp = concat2 (name, build_string (number));
+ gentemp = concat2 (tem2, make_formatted_string
+ (number, "<%"pD"d>", ++count));
tem = Fstring_equal (gentemp, ignore);
if (!NILP (tem))
return gentemp;
@@ -939,6 +1163,21 @@ If VARIABLE does not have a buffer-local binding in BUFFER, the value
is the default binding of the variable. */)
(register Lisp_Object variable, register Lisp_Object buffer)
{
+ register Lisp_Object result = buffer_local_value_1 (variable, buffer);
+
+ if (EQ (result, Qunbound))
+ xsignal1 (Qvoid_variable, variable);
+
+ return result;
+}
+
+
+/* Like Fbuffer_local_value, but return Qunbound if the variable is
+ locally unbound. */
+
+Lisp_Object
+buffer_local_value_1 (Lisp_Object variable, Lisp_Object buffer)
+{
register struct buffer *buf;
register Lisp_Object result;
struct Lisp_Symbol *sym;
@@ -983,29 +1222,28 @@ is the default binding of the variable. */)
{
union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
if (BUFFER_OBJFWDP (fwd))
- result = PER_BUFFER_VALUE (buf, XBUFFER_OBJFWD (fwd)->offset);
+ result = per_buffer_value (buf, XBUFFER_OBJFWD (fwd)->offset);
else
result = Fdefault_value (variable);
break;
}
- default: abort ();
+ default: emacs_abort ();
}
- if (!EQ (result, Qunbound))
- return result;
-
- xsignal1 (Qvoid_variable, variable);
+ return result;
}
/* Return an alist of the Lisp-level buffer-local bindings of
buffer BUF. That is, don't include the variables maintained
- in special slots in the buffer object. */
+ in special slots in the buffer object.
+ If not CLONE, replace elements of the form (VAR . unbound)
+ by VAR. */
static Lisp_Object
-buffer_lisp_local_variables (struct buffer *buf)
+buffer_lisp_local_variables (struct buffer *buf, bool clone)
{
Lisp_Object result = Qnil;
- register Lisp_Object tail;
+ Lisp_Object tail;
for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
{
Lisp_Object val, elt;
@@ -1022,7 +1260,10 @@ buffer_lisp_local_variables (struct buffer *buf)
if (buf != current_buffer)
val = XCDR (elt);
- result = Fcons (Fcons (XCAR (elt), val), result);
+ result = Fcons (!clone && EQ (val, Qunbound)
+ ? XCAR (elt)
+ : Fcons (XCAR (elt), val),
+ result);
}
return result;
@@ -1048,25 +1289,23 @@ No argument or nil as argument means use current buffer as BUFFER. */)
buf = XBUFFER (buffer);
}
- result = buffer_lisp_local_variables (buf);
+ result = buffer_lisp_local_variables (buf, 0);
/* Add on all the variables stored in special slots. */
{
int offset, idx;
- /* buffer-local Lisp variables start at `undo_list',
- tho only the ones from `name' on are GC'd normally. */
- for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER);
- offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER);
- /* sizeof EMACS_INT == sizeof Lisp_Object */
- offset += (sizeof (EMACS_INT)))
+ FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
{
idx = PER_BUFFER_IDX (offset);
if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
&& SYMBOLP (PER_BUFFER_SYMBOL (offset)))
- result = Fcons (Fcons (PER_BUFFER_SYMBOL (offset),
- PER_BUFFER_VALUE (buf, offset)),
- result);
+ {
+ Lisp_Object sym = PER_BUFFER_SYMBOL (offset);
+ Lisp_Object val = per_buffer_value (buf, offset);
+ result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val),
+ result);
+ }
}
}
@@ -1095,21 +1334,23 @@ DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
1, 1, 0,
doc: /* Mark current buffer as modified or unmodified according to FLAG.
A non-nil FLAG means mark the buffer modified. */)
- (register Lisp_Object flag)
+ (Lisp_Object flag)
{
- register int already;
- register Lisp_Object fn;
- Lisp_Object buffer, window;
+ Lisp_Object fn, buffer, window;
#ifdef CLASH_DETECTION
/* If buffer becoming modified, lock the file.
If buffer becoming unmodified, unlock the file. */
- fn = BVAR (current_buffer, file_truename);
+ struct buffer *b = current_buffer->base_buffer
+ ? current_buffer->base_buffer
+ : current_buffer;
+
+ fn = BVAR (b, file_truename);
/* Test buffer-file-name so that binding it to nil is effective. */
- if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename)))
+ if (!NILP (fn) && ! NILP (BVAR (b, filename)))
{
- already = SAVE_MODIFF < MODIFF;
+ bool already = SAVE_MODIFF < MODIFF;
if (!already && !NILP (flag))
lock_file (fn);
else if (already && NILP (flag))
@@ -1176,7 +1417,7 @@ state of the current buffer. Use with care. */)
/* Test buffer-file-name so that binding it to nil is effective. */
if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename)))
{
- int already = SAVE_MODIFF < MODIFF;
+ bool already = SAVE_MODIFF < MODIFF;
if (!already && !NILP (flag))
lock_file (fn);
else if (already && NILP (flag))
@@ -1268,7 +1509,7 @@ This does not change the name of the visited file (if any). */)
error ("Buffer name `%s' is in use", SDATA (newname));
}
- BVAR (current_buffer, name) = newname;
+ bset_name (current_buffer, newname);
/* Catch redisplay's attention. Unless we do this, the mode lines for
any windows displaying current_buffer will stay unchanged. */
@@ -1301,23 +1542,16 @@ list first, followed by the list of all buffers. If no other buffer
exists, return the buffer `*scratch*' (creating it if necessary). */)
(register Lisp_Object buffer, Lisp_Object visible_ok, Lisp_Object frame)
{
- Lisp_Object Fset_buffer_major_mode (Lisp_Object buffer);
- Lisp_Object tail, buf, pred;
- Lisp_Object notsogood = Qnil;
-
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_FRAME (frame);
+ struct frame *f = decode_any_frame (frame);
+ Lisp_Object tail = f->buffer_list, pred = f->buffer_predicate;
+ Lisp_Object buf, notsogood = Qnil;
- pred = frame_buffer_predicate (frame);
/* Consider buffers that have been seen in the frame first. */
- tail = XFRAME (frame)->buffer_list;
for (; CONSP (tail); tail = XCDR (tail))
{
buf = XCAR (tail);
if (BUFFERP (buf) && !EQ (buf, buffer)
- && !NILP (BVAR (XBUFFER (buf), name))
+ && BUFFER_LIVE_P (XBUFFER (buf))
&& (SREF (BVAR (XBUFFER (buf), name), 0) != ' ')
/* If the frame has a buffer_predicate, disregard buffers that
don't fit the predicate. */
@@ -1337,7 +1571,7 @@ exists, return the buffer `*scratch*' (creating it if necessary). */)
{
buf = Fcdr (XCAR (tail));
if (BUFFERP (buf) && !EQ (buf, buffer)
- && !NILP (BVAR (XBUFFER (buf), name))
+ && BUFFER_LIVE_P (XBUFFER (buf))
&& (SREF (BVAR (XBUFFER (buf), name), 0) != ' ')
/* If the frame has a buffer_predicate, disregard buffers that
don't fit the predicate. */
@@ -1372,7 +1606,6 @@ exists, return the buffer `*scratch*' (creating it if necessary). */)
Lisp_Object
other_buffer_safely (Lisp_Object buffer)
{
- Lisp_Object Fset_buffer_major_mode (Lisp_Object buffer);
Lisp_Object tail, buf;
tail = Vbuffer_alist;
@@ -1380,7 +1613,7 @@ other_buffer_safely (Lisp_Object buffer)
{
buf = Fcdr (XCAR (tail));
if (BUFFERP (buf) && !EQ (buf, buffer)
- && !NILP (BVAR (XBUFFER (buf), name))
+ && BUFFER_LIVE_P (XBUFFER (buf))
&& (SREF (BVAR (XBUFFER (buf), name), 0) != ' '))
return buf;
}
@@ -1413,33 +1646,67 @@ No argument or nil as argument means do this for the current buffer. */)
}
if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt))
- BVAR (XBUFFER (real_buffer), undo_list) = Qnil;
+ bset_undo_list (XBUFFER (real_buffer), Qnil);
return Qnil;
}
-/*
- DEFVAR_LISP ("kill-buffer-hook", ..., "\
-Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
-The buffer being killed will be current while the hook is running.\n\
-See `kill-buffer'."
- */
+/* Truncate undo list and shrink the gap of BUFFER. */
+
+void
+compact_buffer (struct buffer *buffer)
+{
+ BUFFER_CHECK_INDIRECTION (buffer);
+
+ /* Skip dead buffers, indirect buffers and buffers
+ which aren't changed since last compaction. */
+ if (BUFFER_LIVE_P (buffer)
+ && (buffer->base_buffer == NULL)
+ && (buffer->text->compact != buffer->text->modiff))
+ {
+ /* If a buffer's undo list is Qt, that means that undo is
+ turned off in that buffer. Calling truncate_undo_list on
+ Qt tends to return NULL, which effectively turns undo back on.
+ So don't call truncate_undo_list if undo_list is Qt. */
+ if (!EQ (buffer->INTERNAL_FIELD (undo_list), Qt))
+ truncate_undo_list (buffer);
+
+ /* Shrink buffer gaps. */
+ if (!buffer->text->inhibit_shrinking)
+ {
+ /* If a buffer's gap size is more than 10% of the buffer
+ size, or larger than 2000 bytes, then shrink it
+ accordingly. Keep a minimum size of 20 bytes. */
+ int size = min (2000, max (20, (buffer->text->z_byte / 10)));
+
+ if (buffer->text->gap_size > size)
+ {
+ struct buffer *save_current = current_buffer;
+ current_buffer = buffer;
+ make_gap (-(buffer->text->gap_size - size));
+ current_buffer = save_current;
+ }
+ }
+ buffer->text->compact = buffer->text->modiff;
+ }
+}
+
DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
- doc: /* Kill buffer BUFFER-OR-NAME.
+ doc: /* Kill the buffer specified by BUFFER-OR-NAME.
The argument may be a buffer or the name of an existing buffer.
Argument nil or omitted means kill the current buffer. Return t if the
buffer is actually killed, nil otherwise.
-This function calls `replace-buffer-in-windows' for cleaning up all
-windows currently displaying the buffer to be killed. The functions in
-`kill-buffer-query-functions' are called with the buffer to be killed as
-the current buffer. If any of them returns nil, the buffer is not
-killed. The hook `kill-buffer-hook' is run before the buffer is
-actually killed. The buffer being killed will be current while the hook
-is running.
+The functions in `kill-buffer-query-functions' are called with the
+buffer to be killed as the current buffer. If any of them returns nil,
+the buffer is not killed. The hook `kill-buffer-hook' is run before the
+buffer is actually killed. The buffer being killed will be current
+while the hook is running. Functions called by any of these hooks are
+supposed to not change the current buffer.
Any processes that have this buffer as the `process-buffer' are killed
-with SIGHUP. */)
+with SIGHUP. This function calls `replace-buffer-in-windows' for
+cleaning up all windows currently displaying the buffer to be killed. */)
(Lisp_Object buffer_or_name)
{
Lisp_Object buffer;
@@ -1458,7 +1725,7 @@ with SIGHUP. */)
b = XBUFFER (buffer);
/* Avoid trouble for buffer already dead. */
- if (NILP (BVAR (b, name)))
+ if (!BUFFER_LIVE_P (b))
return Qnil;
/* Query if the buffer is still modified. */
@@ -1475,7 +1742,7 @@ with SIGHUP. */)
/* Run hooks with the buffer to be killed the current buffer. */
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object arglist[1];
record_unwind_protect (save_excursion_restore, save_excursion_save ());
@@ -1493,6 +1760,10 @@ with SIGHUP. */)
unbind_to (count, Qnil);
}
+ /* If the hooks have killed the buffer, exit now. */
+ if (!BUFFER_LIVE_P (b))
+ return Qt;
+
/* We have no more questions to ask. Verify that it is valid
to kill the buffer. This must be done after the questions
since anything can happen within do_yes_or_no_p. */
@@ -1501,22 +1772,18 @@ with SIGHUP. */)
if (EQ (buffer, XWINDOW (minibuf_window)->buffer))
return Qnil;
- if (NILP (BVAR (b, name)))
- return Qnil;
-
- /* When we kill a base buffer, kill all its indirect buffers.
+ /* When we kill an ordinary buffer which shares it's buffer text
+ with indirect buffer(s), we must kill indirect buffer(s) too.
We do it at this stage so nothing terrible happens if they
ask questions or their hooks get errors. */
- if (! b->base_buffer)
+ if (!b->base_buffer && b->indirections > 0)
{
struct buffer *other;
GCPRO1 (buffer);
- for (other = all_buffers; other; other = other->header.next.buffer)
- /* all_buffers contains dead buffers too;
- don't re-kill them. */
- if (other->base_buffer == b && !NILP (BVAR (other, name)))
+ FOR_EACH_BUFFER (other)
+ if (other->base_buffer == b)
{
Lisp_Object buf;
XSETBUFFER (buf, other);
@@ -1524,6 +1791,10 @@ with SIGHUP. */)
}
UNGCPRO;
+
+ /* Exit if we now have killed the base buffer (Bug#11665). */
+ if (!BUFFER_LIVE_P (b))
+ return Qt;
}
/* Run replace_buffer_in_windows before making another buffer current
@@ -1532,9 +1803,12 @@ with SIGHUP. */)
buffer. (Bug#10114) */
replace_buffer_in_windows (buffer);
- /* Make this buffer not be current.
- In the process, notice if this is the sole visible buffer
- and give up if so. */
+ /* Exit if replacing the buffer in windows has killed our buffer. */
+ if (!BUFFER_LIVE_P (b))
+ return Qt;
+
+ /* Make this buffer not be current. Exit if it is the sole visible
+ buffer. */
if (b == current_buffer)
{
tem = Fother_buffer (buffer, Qnil, Qnil);
@@ -1543,15 +1817,12 @@ with SIGHUP. */)
return Qnil;
}
- /* Notice if the buffer to kill is the sole visible buffer
- when we're currently in the mini-buffer, and give up if so. */
+ /* If the buffer now current is shown in the minibuffer and our buffer
+ is the sole other buffer give up. */
XSETBUFFER (tem, current_buffer);
- if (EQ (tem, XWINDOW (minibuf_window)->buffer))
- {
- tem = Fother_buffer (buffer, Qnil, Qnil);
- if (EQ (buffer, tem))
- return Qnil;
- }
+ if (EQ (tem, XWINDOW (minibuf_window)->buffer)
+ && EQ (buffer, Fother_buffer (buffer, Qnil, Qnil)))
+ return Qnil;
/* Now there is no question: we can kill the buffer. */
@@ -1564,11 +1835,10 @@ with SIGHUP. */)
kill_buffer_processes (buffer);
UNGCPRO;
- /* Killing buffer processes may run sentinels which may
- have called kill-buffer. */
-
- if (NILP (BVAR (b, name)))
- return Qnil;
+ /* Killing buffer processes may run sentinels which may have killed
+ our buffer. */
+ if (!BUFFER_LIVE_P (b))
+ return Qt;
/* These may run Lisp code and into infinite loops (if someone
insisted on circular lists) so allow quitting here. */
@@ -1580,8 +1850,7 @@ with SIGHUP. */)
Vinhibit_quit = Qt;
/* Remove the buffer from the list of all buffers. */
Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
- /* If replace_buffer_in_windows didn't do its job correctly fix that
- now. */
+ /* If replace_buffer_in_windows didn't do its job fix that now. */
replace_buffer_in_windows_safely (buffer);
Vinhibit_quit = tem;
@@ -1599,17 +1868,25 @@ with SIGHUP. */)
internal_delete_file (BVAR (b, auto_save_file_name));
}
+ /* Deleting an auto-save file could have killed our buffer. */
+ if (!BUFFER_LIVE_P (b))
+ return Qt;
+
if (b->base_buffer)
{
/* Unchain all markers that belong to this indirect buffer.
Don't unchain the markers that belong to the base buffer
or its other indirect buffers. */
- for (m = BUF_MARKERS (b); m; )
+ struct Lisp_Marker **mp = &BUF_MARKERS (b);
+ while ((m = *mp))
{
- struct Lisp_Marker *next = m->next;
if (m->buffer == b)
- unchain_marker (m);
- m = next;
+ {
+ m->buffer = NULL;
+ *mp = m->next;
+ }
+ else
+ mp = &m->next;
}
}
else
@@ -1624,10 +1901,14 @@ with SIGHUP. */)
m = next;
}
BUF_MARKERS (b) = NULL;
- BUF_INTERVALS (b) = NULL_INTERVAL;
+ set_buffer_intervals (b, NULL);
- /* Perhaps we should explicitly free the interval tree here... */
+ /* Perhaps we should explicitly free the interval tree here... */
}
+ /* Since we've unlinked the markers, the overlays can't be here any more
+ either. */
+ b->overlays_before = NULL;
+ b->overlays_after = NULL;
/* Reset the local variables, so that this buffer's local values
won't be protected from GC. They would be protected
@@ -1636,10 +1917,18 @@ with SIGHUP. */)
swap_out_buffer_local_variables (b);
reset_buffer_local_variables (b, 1);
- BVAR (b, name) = Qnil;
+ bset_name (b, Qnil);
- BLOCK_INPUT;
- if (! b->base_buffer)
+ block_input ();
+ if (b->base_buffer)
+ {
+ /* Notify our base buffer that we don't share the text anymore. */
+ eassert (b->indirections == -1);
+ b->base_buffer->indirections--;
+ eassert (b->base_buffer->indirections >= 0);
+ }
+ else
+ /* No one shares our buffer text, can free it. */
free_buffer_text (b);
if (b->newline_cache)
@@ -1652,9 +1941,9 @@ with SIGHUP. */)
free_region_cache (b->width_run_cache);
b->width_run_cache = 0;
}
- BVAR (b, width_table) = Qnil;
- UNBLOCK_INPUT;
- BVAR (b, undo_list) = Qnil;
+ bset_width_table (b, Qnil);
+ unblock_input ();
+ bset_undo_list (b, Qnil);
/* Run buffer-list-update-hook. */
if (!NILP (Vrun_hooks))
@@ -1695,8 +1984,8 @@ record_buffer (Lisp_Object buffer)
Vinhibit_quit = tem;
/* Update buffer list of selected frame. */
- f->buffer_list = Fcons (buffer, Fdelq (buffer, f->buffer_list));
- f->buried_buffer_list = Fdelq (buffer, f->buried_buffer_list);
+ fset_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buffer_list)));
+ fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list));
/* Run buffer-list-update-hook. */
if (!NILP (Vrun_hooks))
@@ -1707,7 +1996,7 @@ record_buffer (Lisp_Object buffer)
/* Move BUFFER to the end of the buffer (a)lists. Do nothing if the
buffer is killed. For the selected frame's buffer list this moves
BUFFER to its end even if it was never shown in that frame. If
- this happens we have a feature, hence `unrecord-buffer' should be
+ this happens we have a feature, hence `bury-buffer-internal' should be
called only when BUFFER was shown in the selected frame. */
DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal,
@@ -1733,8 +2022,9 @@ DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal,
Vinhibit_quit = tem;
/* Update buffer lists of selected frame. */
- f->buffer_list = Fdelq (buffer, f->buffer_list);
- f->buried_buffer_list = Fcons (buffer, Fdelq (buffer, f->buried_buffer_list));
+ fset_buffer_list (f, Fdelq (buffer, f->buffer_list));
+ fset_buried_buffer_list
+ (f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)));
/* Run buffer-list-update-hook. */
if (!NILP (Vrun_hooks))
@@ -1751,13 +2041,15 @@ Use this function before selecting the buffer, since it may need to inspect
the current buffer's major mode. */)
(Lisp_Object buffer)
{
- int count;
+ ptrdiff_t count;
Lisp_Object function;
CHECK_BUFFER (buffer);
- if (STRINGP (BVAR (XBUFFER (buffer), name))
- && strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0)
+ if (!BUFFER_LIVE_P (XBUFFER (buffer)))
+ error ("Attempt to set major mode for a dead buffer");
+
+ if (strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0)
function = find_symbol_value (intern ("initial-major-mode"));
else
{
@@ -1791,22 +2083,6 @@ DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
XSETBUFFER (buf, current_buffer);
return buf;
}
-
-/* Set the current buffer to B.
-
- We previously set windows_or_buffers_changed here to invalidate
- global unchanged information in beg_unchanged and end_unchanged.
- This is no longer necessary because we now compute unchanged
- information on a buffer-basis. Every action affecting other
- windows than the selected one requires a select_window at some
- time, and that increments windows_or_buffers_changed. */
-
-void
-set_buffer_internal (register struct buffer *b)
-{
- if (current_buffer != b)
- set_buffer_internal_1 (b);
-}
/* Set the current buffer to B, and do not set windows_or_buffers_changed.
This is used by redisplay. */
@@ -1825,6 +2101,8 @@ set_buffer_internal_1 (register struct buffer *b)
if (current_buffer == b)
return;
+ BUFFER_CHECK_INDIRECTION (b);
+
old_buf = current_buffer;
current_buffer = b;
last_known_column_point = -1; /* invalidate indentation cache */
@@ -1834,7 +2112,7 @@ set_buffer_internal_1 (register struct buffer *b)
/* Put the undo list back in the base buffer, so that it appears
that an indirect buffer shares the undo list of its base. */
if (old_buf->base_buffer)
- BVAR (old_buf->base_buffer, undo_list) = BVAR (old_buf, undo_list);
+ bset_undo_list (old_buf->base_buffer, BVAR (old_buf, undo_list));
/* If the old current buffer has markers to record PT, BEGV and ZV
when it is not current, update them now. */
@@ -1844,7 +2122,7 @@ set_buffer_internal_1 (register struct buffer *b)
/* Get the undo list from the base buffer, so that it appears
that an indirect buffer shares the undo list of its base. */
if (b->base_buffer)
- BVAR (b, undo_list) = BVAR (b->base_buffer, undo_list);
+ bset_undo_list (b, BVAR (b->base_buffer, undo_list));
/* If the new current buffer has markers to record PT, BEGV and ZV
when it is not current, fetch them now. */
@@ -1896,7 +2174,7 @@ set_buffer_temp (struct buffer *b)
DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
doc: /* Make buffer BUFFER-OR-NAME current for editing operations.
BUFFER-OR-NAME may be a buffer or the name of an existing buffer. See
-also `save-excursion' when you want to make a buffer current
+also `with-current-buffer' when you want to make a buffer current
temporarily. This function does not display the buffer, so its effect
ends when the current command terminates. Use `switch-to-buffer' or
`pop-to-buffer' to switch buffers permanently. */)
@@ -1906,19 +2184,19 @@ ends when the current command terminates. Use `switch-to-buffer' or
buffer = Fget_buffer (buffer_or_name);
if (NILP (buffer))
nsberror (buffer_or_name);
- if (NILP (BVAR (XBUFFER (buffer), name)))
+ if (!BUFFER_LIVE_P (XBUFFER (buffer)))
error ("Selecting deleted buffer");
set_buffer_internal (XBUFFER (buffer));
return buffer;
}
-/* Set the current buffer to BUFFER provided it is alive. */
+/* Set the current buffer to BUFFER provided if it is alive. */
Lisp_Object
set_buffer_if_live (Lisp_Object buffer)
{
- if (! NILP (BVAR (XBUFFER (buffer), name)))
- Fset_buffer (buffer);
+ if (BUFFER_LIVE_P (XBUFFER (buffer)))
+ set_buffer_internal (XBUFFER (buffer));
return Qnil;
}
@@ -1963,16 +2241,15 @@ validate_region (register Lisp_Object *b, register Lisp_Object *e)
tem = *b; *b = *e; *e = tem;
}
- if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
- && XINT (*e) <= ZV))
+ if (! (BEGV <= XINT (*b) && XINT (*e) <= ZV))
args_out_of_range (*b, *e);
}
/* Advance BYTE_POS up to a character boundary
and return the adjusted position. */
-static EMACS_INT
-advance_to_char_boundary (EMACS_INT byte_pos)
+static ptrdiff_t
+advance_to_char_boundary (ptrdiff_t byte_pos)
{
int c;
@@ -1985,7 +2262,7 @@ advance_to_char_boundary (EMACS_INT byte_pos)
{
/* We should advance BYTE_POS only when C is a constituent of a
multibyte sequence. */
- EMACS_INT orig_byte_pos = byte_pos;
+ ptrdiff_t orig_byte_pos = byte_pos;
do
{
@@ -2004,10 +2281,6 @@ advance_to_char_boundary (EMACS_INT byte_pos)
return byte_pos;
}
-#ifdef REL_ALLOC
-extern void r_alloc_reset_variable (POINTER_TYPE *, POINTER_TYPE *);
-#endif /* REL_ALLOC */
-
DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
1, 1, 0,
doc: /* Swap the text between current buffer and BUFFER. */)
@@ -2017,7 +2290,7 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
CHECK_BUFFER (buffer);
other_buffer = XBUFFER (buffer);
- if (NILP (BVAR (other_buffer, name)))
+ if (!BUFFER_LIVE_P (other_buffer))
error ("Cannot swap a dead buffer's text");
/* Actually, it probably works just fine.
@@ -2032,7 +2305,7 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
{ /* This is probably harder to make work. */
struct buffer *other;
- for (other = all_buffers; other; other = other->header.next.buffer)
+ FOR_EACH_BUFFER (other)
if (other->base_buffer == other_buffer
|| other->base_buffer == current_buffer)
error ("One of the buffers to swap has indirect buffers");
@@ -2047,28 +2320,29 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
#define swapfield_(field, type) \
do { \
type tmp##field = BVAR (other_buffer, field); \
- BVAR (other_buffer, field) = BVAR (current_buffer, field); \
- BVAR (current_buffer, field) = tmp##field; \
+ bset_##field (other_buffer, BVAR (current_buffer, field)); \
+ bset_##field (current_buffer, tmp##field); \
} while (0)
swapfield (own_text, struct buffer_text);
eassert (current_buffer->text == &current_buffer->own_text);
eassert (other_buffer->text == &other_buffer->own_text);
#ifdef REL_ALLOC
- r_alloc_reset_variable ((POINTER_TYPE **) &current_buffer->own_text.beg,
- (POINTER_TYPE **) &other_buffer->own_text.beg);
- r_alloc_reset_variable ((POINTER_TYPE **) &other_buffer->own_text.beg,
- (POINTER_TYPE **) &current_buffer->own_text.beg);
+ r_alloc_reset_variable ((void **) &current_buffer->own_text.beg,
+ (void **) &other_buffer->own_text.beg);
+ r_alloc_reset_variable ((void **) &other_buffer->own_text.beg,
+ (void **) &current_buffer->own_text.beg);
#endif /* REL_ALLOC */
- swapfield (pt, EMACS_INT);
- swapfield (pt_byte, EMACS_INT);
- swapfield (begv, EMACS_INT);
- swapfield (begv_byte, EMACS_INT);
- swapfield (zv, EMACS_INT);
- swapfield (zv_byte, EMACS_INT);
+ swapfield (pt, ptrdiff_t);
+ swapfield (pt_byte, ptrdiff_t);
+ swapfield (begv, ptrdiff_t);
+ swapfield (begv_byte, ptrdiff_t);
+ swapfield (zv, ptrdiff_t);
+ swapfield (zv_byte, ptrdiff_t);
eassert (!current_buffer->base_buffer);
eassert (!other_buffer->base_buffer);
+ swapfield (indirections, ptrdiff_t);
current_buffer->clip_changed = 1; other_buffer->clip_changed = 1;
swapfield (newline_cache, struct region_cache *);
swapfield (width_run_cache, struct region_cache *);
@@ -2076,7 +2350,7 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
other_buffer->prevent_redisplay_optimizations_p = 1;
swapfield (overlays_before, struct Lisp_Overlay *);
swapfield (overlays_after, struct Lisp_Overlay *);
- swapfield (overlay_center, EMACS_INT);
+ swapfield (overlay_center, ptrdiff_t);
swapfield_ (undo_list, Lisp_Object);
swapfield_ (mark, Lisp_Object);
swapfield_ (enable_multibyte_characters, Lisp_Object);
@@ -2087,8 +2361,8 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
swapfield_ (pt_marker, Lisp_Object);
swapfield_ (begv_marker, Lisp_Object);
swapfield_ (zv_marker, Lisp_Object);
- BVAR (current_buffer, point_before_scroll) = Qnil;
- BVAR (other_buffer, point_before_scroll) = Qnil;
+ bset_point_before_scroll (current_buffer, Qnil);
+ bset_point_before_scroll (other_buffer, Qnil);
current_buffer->text->modiff++; other_buffer->text->modiff++;
current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
@@ -2128,7 +2402,8 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
&& (EQ (XWINDOW (w)->buffer, buf1)
|| EQ (XWINDOW (w)->buffer, buf2)))
Fset_marker (XWINDOW (w)->pointm,
- make_number (BUF_BEGV (XBUFFER (XWINDOW (w)->buffer))),
+ make_number
+ (BUF_BEGV (XBUFFER (XWINDOW (w)->buffer))),
XWINDOW (w)->buffer);
w = Fnext_window (w, Qt, Qt);
}
@@ -2159,9 +2434,9 @@ current buffer is cleared. */)
{
struct Lisp_Marker *tail, *markers;
struct buffer *other;
- EMACS_INT begv, zv;
- int narrowed = (BEG != BEGV || Z != ZV);
- int modified_p = !NILP (Fbuffer_modified_p (Qnil));
+ ptrdiff_t begv, zv;
+ bool narrowed = (BEG != BEGV || Z != ZV);
+ bool modified_p = !NILP (Fbuffer_modified_p (Qnil));
Lisp_Object old_undo = BVAR (current_buffer, undo_list);
struct gcpro gcpro1;
@@ -2176,7 +2451,7 @@ current buffer is cleared. */)
/* Don't record these buffer changes. We will put a special undo entry
instead. */
- BVAR (current_buffer, undo_list) = Qt;
+ bset_undo_list (current_buffer, Qt);
/* If the cached position is for this buffer, clear it out. */
clear_charpos_cache (current_buffer);
@@ -2187,18 +2462,18 @@ current buffer is cleared. */)
begv = BEGV, zv = ZV;
if (narrowed)
- Fwiden ();
+ error ("Changing multibyteness in a narrowed buffer");
if (NILP (flag))
{
- EMACS_INT pos, stop;
+ ptrdiff_t pos, stop;
unsigned char *p;
/* Do this first, so it can use CHAR_TO_BYTE
to calculate the old correspondences. */
set_intervals_multibyte (0);
- BVAR (current_buffer, enable_multibyte_characters) = Qnil;
+ bset_enable_multibyte_characters (current_buffer, Qnil);
Z = Z_BYTE;
BEGV = BEGV_BYTE;
@@ -2255,8 +2530,8 @@ current buffer is cleared. */)
}
else
{
- EMACS_INT pt = PT;
- EMACS_INT pos, stop;
+ ptrdiff_t pt = PT;
+ ptrdiff_t pos, stop;
unsigned char *p, *pend;
/* Be sure not to have a multibyte sequence striding over the GAP.
@@ -2272,7 +2547,7 @@ current buffer is cleared. */)
while (! CHAR_HEAD_P (*q) && q > BEG_ADDR) q--;
if (LEADING_CODE_P (*q))
{
- EMACS_INT new_gpt = GPT_BYTE - (GPT_ADDR - q);
+ ptrdiff_t new_gpt = GPT_BYTE - (GPT_ADDR - q);
move_gap_both (new_gpt, new_gpt);
}
@@ -2336,7 +2611,7 @@ current buffer is cleared. */)
/* Do this first, so that chars_in_text asks the right question.
set_intervals_multibyte needs it too. */
- BVAR (current_buffer, enable_multibyte_characters) = Qt;
+ bset_enable_multibyte_characters (current_buffer, Qt);
GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
@@ -2356,8 +2631,8 @@ current buffer is cleared. */)
ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
{
- EMACS_INT byte = advance_to_char_boundary (PT_BYTE);
- EMACS_INT position;
+ ptrdiff_t byte = advance_to_char_boundary (PT_BYTE);
+ ptrdiff_t position;
if (byte > GPT_BYTE)
position = chars_in_text (GAP_END_ADDR, byte - GPT_BYTE) + GPT;
@@ -2382,7 +2657,7 @@ current buffer is cleared. */)
/* Make sure no markers were put on the chain
while the chain value was incorrect. */
if (BUF_MARKERS (current_buffer))
- abort ();
+ emacs_abort ();
BUF_MARKERS (current_buffer) = markers;
@@ -2394,10 +2669,11 @@ current buffer is cleared. */)
if (!EQ (old_undo, Qt))
{
/* Represent all the above changes by a special undo entry. */
- BVAR (current_buffer, undo_list) = Fcons (list3 (Qapply,
- intern ("set-buffer-multibyte"),
- NILP (flag) ? Qt : Qnil),
- old_undo);
+ bset_undo_list (current_buffer,
+ Fcons (list3 (Qapply,
+ intern ("set-buffer-multibyte"),
+ NILP (flag) ? Qt : Qnil),
+ old_undo));
}
UNGCPRO;
@@ -2409,8 +2685,8 @@ current buffer is cleared. */)
/* Copy this buffer's new multibyte status
into all of its indirect buffers. */
- for (other = all_buffers; other; other = other->header.next.buffer)
- if (other->base_buffer == current_buffer && !NILP (BVAR (other, name)))
+ FOR_EACH_BUFFER (other)
+ if (other->base_buffer == current_buffer && BUFFER_LIVE_P (other))
{
BVAR (other, enable_multibyte_characters)
= BVAR (current_buffer, enable_multibyte_characters);
@@ -2509,32 +2785,32 @@ swap_out_buffer_local_variables (struct buffer *b)
*VEC_PTR and *LEN_PTR should contain a valid vector and size
when this function is called.
- If EXTEND is non-zero, we make the vector bigger if necessary.
- If EXTEND is zero, we never extend the vector,
- and we store only as many overlays as will fit.
- But we still return the total number of overlays.
+ If EXTEND, make the vector bigger if necessary.
+ If not, never extend the vector,
+ and store only as many overlays as will fit.
+ But still return the total number of overlays.
- If CHANGE_REQ is true, then any position written into *PREV_PTR or
+ If CHANGE_REQ, any position written into *PREV_PTR or
*NEXT_PTR is guaranteed to be not equal to POS, unless it is the
default (BEGV or ZV). */
ptrdiff_t
-overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr,
+overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr,
ptrdiff_t *len_ptr,
- EMACS_INT *next_ptr, EMACS_INT *prev_ptr, int change_req)
+ ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr, bool change_req)
{
Lisp_Object overlay, start, end;
struct Lisp_Overlay *tail;
ptrdiff_t idx = 0;
ptrdiff_t len = *len_ptr;
Lisp_Object *vec = *vec_ptr;
- EMACS_INT next = ZV;
- EMACS_INT prev = BEGV;
- int inhibit_storing = 0;
+ ptrdiff_t next = ZV;
+ ptrdiff_t prev = BEGV;
+ bool inhibit_storing = 0;
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
XSETMISC (overlay, tail);
@@ -2582,7 +2858,7 @@ overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr,
for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
XSETMISC (overlay, tail);
@@ -2647,29 +2923,29 @@ overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr,
*VEC_PTR and *LEN_PTR should contain a valid vector and size
when this function is called.
- If EXTEND is non-zero, we make the vector bigger if necessary.
- If EXTEND is zero, we never extend the vector,
- and we store only as many overlays as will fit.
- But we still return the total number of overlays. */
+ If EXTEND, make the vector bigger if necessary.
+ If not, never extend the vector,
+ and store only as many overlays as will fit.
+ But still return the total number of overlays. */
static ptrdiff_t
-overlays_in (EMACS_INT beg, EMACS_INT end, int extend,
+overlays_in (EMACS_INT beg, EMACS_INT end, bool extend,
Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
- EMACS_INT *next_ptr, EMACS_INT *prev_ptr)
+ ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr)
{
Lisp_Object overlay, ostart, oend;
struct Lisp_Overlay *tail;
ptrdiff_t idx = 0;
ptrdiff_t len = *len_ptr;
Lisp_Object *vec = *vec_ptr;
- EMACS_INT next = ZV;
- EMACS_INT prev = BEGV;
- int inhibit_storing = 0;
- int end_is_Z = end == Z;
+ ptrdiff_t next = ZV;
+ ptrdiff_t prev = BEGV;
+ bool inhibit_storing = 0;
+ bool end_is_Z = end == Z;
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
XSETMISC (overlay, tail);
@@ -2716,7 +2992,7 @@ overlays_in (EMACS_INT beg, EMACS_INT end, int extend,
for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
XSETMISC (overlay, tail);
@@ -2766,23 +3042,23 @@ overlays_in (EMACS_INT beg, EMACS_INT end, int extend,
}
-/* Return non-zero if there exists an overlay with a non-nil
+/* Return true if there exists an overlay with a non-nil
`mouse-face' property overlapping OVERLAY. */
-int
+bool
mouse_face_overlay_overlaps (Lisp_Object overlay)
{
- EMACS_INT start = OVERLAY_POSITION (OVERLAY_START (overlay));
- EMACS_INT end = OVERLAY_POSITION (OVERLAY_END (overlay));
+ ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
+ ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
ptrdiff_t n, i, size;
Lisp_Object *v, tem;
size = 10;
- v = (Lisp_Object *) alloca (size * sizeof *v);
+ v = alloca (size * sizeof *v);
n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
if (n > size)
{
- v = (Lisp_Object *) alloca (n * sizeof *v);
+ v = alloca (n * sizeof *v);
overlays_in (start, end, 0, &v, &n, NULL, NULL);
}
@@ -2798,19 +3074,18 @@ mouse_face_overlay_overlaps (Lisp_Object overlay)
/* Fast function to just test if we're at an overlay boundary. */
-int
-overlay_touches_p (EMACS_INT pos)
+bool
+overlay_touches_p (ptrdiff_t pos)
{
Lisp_Object overlay;
struct Lisp_Overlay *tail;
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
- EMACS_INT endpos;
+ ptrdiff_t endpos;
XSETMISC (overlay ,tail);
- if (!OVERLAYP (overlay))
- abort ();
+ eassert (OVERLAYP (overlay));
endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
if (endpos < pos)
@@ -2821,11 +3096,10 @@ overlay_touches_p (EMACS_INT pos)
for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
- EMACS_INT startpos;
+ ptrdiff_t startpos;
XSETMISC (overlay, tail);
- if (!OVERLAYP (overlay))
- abort ();
+ eassert (OVERLAYP (overlay));
startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
if (pos < startpos)
@@ -2839,7 +3113,7 @@ overlay_touches_p (EMACS_INT pos)
struct sortvec
{
Lisp_Object overlay;
- EMACS_INT beg, end;
+ ptrdiff_t beg, end;
EMACS_INT priority;
};
@@ -2854,6 +3128,12 @@ compare_overlays (const void *v1, const void *v2)
return s1->beg < s2->beg ? -1 : 1;
if (s1->end != s2->end)
return s2->end < s1->end ? -1 : 1;
+ /* Avoid the non-determinism of qsort by choosing an arbitrary ordering
+ between "equal" overlays. The result can still change between
+ invocations of Emacs, but it won't change in the middle of
+ `find_field' (bug#6830). */
+ if (!EQ (s1->overlay, s2->overlay))
+ return XLI (s1->overlay) < XLI (s2->overlay) ? -1 : 1;
return 0;
}
@@ -2864,8 +3144,7 @@ ptrdiff_t
sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w)
{
ptrdiff_t i, j;
- struct sortvec *sortvec;
- sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
+ struct sortvec *sortvec = alloca (noverlays * sizeof *sortvec);
/* Put the valid and relevant overlays into sortvec. */
@@ -2875,7 +3154,7 @@ sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w)
Lisp_Object overlay;
overlay = overlay_vec[i];
- if (OVERLAY_VALID (overlay)
+ if (OVERLAYP (overlay)
&& OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
&& OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
{
@@ -2956,7 +3235,7 @@ static void
record_overlay_string (struct sortstrlist *ssl, Lisp_Object str,
Lisp_Object str2, Lisp_Object pri, ptrdiff_t size)
{
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
if (ssl->used == ssl->size)
ssl->buf = xpalloc (ssl->buf, &ssl->size, 5, -1, sizeof *ssl->buf);
@@ -3006,13 +3285,13 @@ record_overlay_string (struct sortstrlist *ssl, Lisp_Object str,
PSTR, if that variable is non-null. The string may be overwritten by
subsequent calls. */
-EMACS_INT
-overlay_strings (EMACS_INT pos, struct window *w, unsigned char **pstr)
+ptrdiff_t
+overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
{
Lisp_Object overlay, window, str;
struct Lisp_Overlay *ov;
- EMACS_INT startpos, endpos;
- int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ ptrdiff_t startpos, endpos;
+ bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
overlay_heads.used = overlay_heads.bytes = 0;
overlay_tails.used = overlay_tails.bytes = 0;
@@ -3081,7 +3360,7 @@ overlay_strings (EMACS_INT pos, struct window *w, unsigned char **pstr)
if (overlay_heads.bytes || overlay_tails.bytes)
{
Lisp_Object tem;
- EMACS_INT i;
+ ptrdiff_t i;
unsigned char *p;
ptrdiff_t total;
@@ -3095,7 +3374,7 @@ overlay_strings (EMACS_INT pos, struct window *w, unsigned char **pstr)
p = overlay_str_buf;
for (i = overlay_tails.used; --i >= 0;)
{
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
tem = overlay_tails.buf[i].string;
nbytes = copy_text (SDATA (tem), p,
SBYTES (tem),
@@ -3104,7 +3383,7 @@ overlay_strings (EMACS_INT pos, struct window *w, unsigned char **pstr)
}
for (i = 0; i < overlay_heads.used; ++i)
{
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
tem = overlay_heads.buf[i].string;
nbytes = copy_text (SDATA (tem), p,
SBYTES (tem),
@@ -3120,7 +3399,7 @@ overlay_strings (EMACS_INT pos, struct window *w, unsigned char **pstr)
}
}
if (p != overlay_str_buf + total)
- abort ();
+ emacs_abort ();
if (pstr)
*pstr = overlay_str_buf;
return total;
@@ -3131,7 +3410,7 @@ overlay_strings (EMACS_INT pos, struct window *w, unsigned char **pstr)
/* Shift overlays in BUF's overlay lists, to center the lists at POS. */
void
-recenter_overlay_lists (struct buffer *buf, EMACS_INT pos)
+recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
{
Lisp_Object overlay, beg, end;
struct Lisp_Overlay *prev, *tail, *next;
@@ -3146,22 +3425,7 @@ recenter_overlay_lists (struct buffer *buf, EMACS_INT pos)
{
next = tail->next;
XSETMISC (overlay, tail);
-
- /* If the overlay is not valid, get rid of it. */
- if (!OVERLAY_VALID (overlay))
-#if 1
- abort ();
-#else
- {
- /* Splice the cons cell TAIL out of overlays_before. */
- if (!NILP (prev))
- XCDR (prev) = next;
- else
- buf->overlays_before = next;
- tail = prev;
- continue;
- }
-#endif
+ eassert (OVERLAYP (overlay));
beg = OVERLAY_START (overlay);
end = OVERLAY_END (overlay);
@@ -3169,14 +3433,14 @@ recenter_overlay_lists (struct buffer *buf, EMACS_INT pos)
if (OVERLAY_POSITION (end) > pos)
{
/* OVERLAY needs to be moved. */
- EMACS_INT where = OVERLAY_POSITION (beg);
+ ptrdiff_t where = OVERLAY_POSITION (beg);
struct Lisp_Overlay *other, *other_prev;
/* Splice the cons cell TAIL out of overlays_before. */
if (prev)
prev->next = next;
else
- buf->overlays_before = next;
+ set_buffer_overlays_before (buf, next);
/* Search thru overlays_after for where to put it. */
other_prev = NULL;
@@ -3186,7 +3450,7 @@ recenter_overlay_lists (struct buffer *buf, EMACS_INT pos)
Lisp_Object otherbeg, otheroverlay;
XSETMISC (otheroverlay, other);
- eassert (OVERLAY_VALID (otheroverlay));
+ eassert (OVERLAYP (otheroverlay));
otherbeg = OVERLAY_START (otheroverlay);
if (OVERLAY_POSITION (otherbeg) >= where)
@@ -3198,7 +3462,7 @@ recenter_overlay_lists (struct buffer *buf, EMACS_INT pos)
if (other_prev)
other_prev->next = tail;
else
- buf->overlays_after = tail;
+ set_buffer_overlays_after (buf, tail);
tail = prev;
}
else
@@ -3214,22 +3478,7 @@ recenter_overlay_lists (struct buffer *buf, EMACS_INT pos)
{
next = tail->next;
XSETMISC (overlay, tail);
-
- /* If the overlay is not valid, get rid of it. */
- if (!OVERLAY_VALID (overlay))
-#if 1
- abort ();
-#else
- {
- /* Splice the cons cell TAIL out of overlays_after. */
- if (!NILP (prev))
- XCDR (prev) = next;
- else
- buf->overlays_after = next;
- tail = prev;
- continue;
- }
-#endif
+ eassert (OVERLAYP (overlay));
beg = OVERLAY_START (overlay);
end = OVERLAY_END (overlay);
@@ -3242,14 +3491,14 @@ recenter_overlay_lists (struct buffer *buf, EMACS_INT pos)
if (OVERLAY_POSITION (end) <= pos)
{
/* OVERLAY needs to be moved. */
- EMACS_INT where = OVERLAY_POSITION (end);
+ ptrdiff_t where = OVERLAY_POSITION (end);
struct Lisp_Overlay *other, *other_prev;
/* Splice the cons cell TAIL out of overlays_after. */
if (prev)
prev->next = next;
else
- buf->overlays_after = next;
+ set_buffer_overlays_after (buf, next);
/* Search thru overlays_before for where to put it. */
other_prev = NULL;
@@ -3259,7 +3508,7 @@ recenter_overlay_lists (struct buffer *buf, EMACS_INT pos)
Lisp_Object otherend, otheroverlay;
XSETMISC (otheroverlay, other);
- eassert (OVERLAY_VALID (otheroverlay));
+ eassert (OVERLAYP (otheroverlay));
otherend = OVERLAY_END (otheroverlay);
if (OVERLAY_POSITION (otherend) <= where)
@@ -3271,7 +3520,7 @@ recenter_overlay_lists (struct buffer *buf, EMACS_INT pos)
if (other_prev)
other_prev->next = tail;
else
- buf->overlays_before = tail;
+ set_buffer_overlays_before (buf, tail);
tail = prev;
}
}
@@ -3280,7 +3529,7 @@ recenter_overlay_lists (struct buffer *buf, EMACS_INT pos)
}
void
-adjust_overlays_for_insert (EMACS_INT pos, EMACS_INT length)
+adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length)
{
/* After an insertion, the lists are still sorted properly,
but we may need to update the value of the overlay center. */
@@ -3289,13 +3538,13 @@ adjust_overlays_for_insert (EMACS_INT pos, EMACS_INT length)
}
void
-adjust_overlays_for_delete (EMACS_INT pos, EMACS_INT length)
+adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length)
{
if (current_buffer->overlay_center < pos)
/* The deletion was to our right. No change needed; the before- and
after-lists are still consistent. */
;
- else if (current_buffer->overlay_center > pos + length)
+ else if (current_buffer->overlay_center - pos > length)
/* The deletion was to our left. We need to adjust the center value
to account for the change in position, but the lists are consistent
given the new value. */
@@ -3314,7 +3563,7 @@ adjust_overlays_for_delete (EMACS_INT pos, EMACS_INT length)
Such an overlay might even have negative size at this point.
If so, we'll make the overlay empty. */
void
-fix_start_end_in_overlays (register EMACS_INT start, register EMACS_INT end)
+fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
{
Lisp_Object overlay;
struct Lisp_Overlay *before_list IF_LINT (= NULL);
@@ -3327,7 +3576,7 @@ fix_start_end_in_overlays (register EMACS_INT start, register EMACS_INT end)
current_buffer->overlays_before or overlays_after, depending
which loop we're in. */
struct Lisp_Overlay *tail, *parent;
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
/* This algorithm shifts links around instead of consing and GCing.
The loop invariant is that before_list (resp. after_list) is a
@@ -3376,7 +3625,7 @@ fix_start_end_in_overlays (register EMACS_INT start, register EMACS_INT end)
beforep = tail;
}
if (!parent)
- current_buffer->overlays_before = tail->next;
+ set_buffer_overlays_before (current_buffer, tail->next);
else
parent->next = tail->next;
tail = tail->next;
@@ -3422,7 +3671,7 @@ fix_start_end_in_overlays (register EMACS_INT start, register EMACS_INT end)
beforep = tail;
}
if (!parent)
- current_buffer->overlays_after = tail->next;
+ set_buffer_overlays_after (current_buffer, tail->next);
else
parent->next = tail->next;
tail = tail->next;
@@ -3436,14 +3685,13 @@ fix_start_end_in_overlays (register EMACS_INT start, register EMACS_INT end)
if (beforep)
{
beforep->next = current_buffer->overlays_before;
- current_buffer->overlays_before = before_list;
+ set_buffer_overlays_before (current_buffer, before_list);
}
- recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
if (afterp)
{
afterp->next = current_buffer->overlays_after;
- current_buffer->overlays_after = after_list;
+ set_buffer_overlays_after (current_buffer, after_list);
}
recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
}
@@ -3461,12 +3709,12 @@ fix_start_end_in_overlays (register EMACS_INT start, register EMACS_INT end)
was at PREV, and now is at POS. */
void
-fix_overlays_before (struct buffer *bp, EMACS_INT prev, EMACS_INT pos)
+fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
{
/* If parent is nil, replace overlays_before; otherwise, parent->next. */
struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
Lisp_Object tem;
- EMACS_INT end IF_LINT (= 0);
+ ptrdiff_t end IF_LINT (= 0);
/* After the insertion, the several overlays may be in incorrect
order. The possibility is that, in the list `overlays_before',
@@ -3520,7 +3768,7 @@ fix_overlays_before (struct buffer *bp, EMACS_INT prev, EMACS_INT pos)
if (!right_pair)
{
found->next = bp->overlays_before;
- bp->overlays_before = found;
+ set_buffer_overlays_before (bp, found);
}
else
{
@@ -3590,28 +3838,22 @@ for the rear of the overlay advance when text is inserted there
if (!NILP (rear_advance))
XMARKER (end)->insertion_type = 1;
- overlay = allocate_misc ();
- XMISCTYPE (overlay) = Lisp_Misc_Overlay;
- XOVERLAY (overlay)->start = beg;
- XOVERLAY (overlay)->end = end;
- XOVERLAY (overlay)->plist = Qnil;
- XOVERLAY (overlay)->next = NULL;
+ overlay = build_overlay (beg, end, Qnil);
/* Put the new overlay on the wrong list. */
end = OVERLAY_END (overlay);
if (OVERLAY_POSITION (end) < b->overlay_center)
{
- if (b->overlays_after)
- XOVERLAY (overlay)->next = b->overlays_after;
- b->overlays_after = XOVERLAY (overlay);
+ eassert (b->overlays_after || (XOVERLAY (overlay)->next == NULL));
+ XOVERLAY (overlay)->next = b->overlays_after;
+ set_buffer_overlays_after (b, XOVERLAY (overlay));
}
else
{
- if (b->overlays_before)
- XOVERLAY (overlay)->next = b->overlays_before;
- b->overlays_before = XOVERLAY (overlay);
+ eassert (b->overlays_before || (XOVERLAY (overlay)->next == NULL));
+ XOVERLAY (overlay)->next = b->overlays_before;
+ set_buffer_overlays_before (b, XOVERLAY (overlay));
}
-
/* This puts it in the right list, and in the right order. */
recenter_overlay_lists (b, b->overlay_center);
@@ -3624,11 +3866,11 @@ for the rear of the overlay advance when text is inserted there
/* Mark a section of BUF as needing redisplay because of overlays changes. */
static void
-modify_overlay (struct buffer *buf, EMACS_INT start, EMACS_INT end)
+modify_overlay (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
{
if (start > end)
{
- EMACS_INT temp = start;
+ ptrdiff_t temp = start;
start = end;
end = temp;
}
@@ -3650,24 +3892,35 @@ modify_overlay (struct buffer *buf, EMACS_INT start, EMACS_INT end)
++BUF_OVERLAY_MODIFF (buf);
}
-
+/* Remove OVERLAY from LIST. */
+
static struct Lisp_Overlay *
unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay)
{
- struct Lisp_Overlay *tmp, *prev;
- for (tmp = list, prev = NULL; tmp; prev = tmp, tmp = tmp->next)
- if (tmp == overlay)
+ register struct Lisp_Overlay *tail, **prev = &list;
+
+ for (tail = list; tail; prev = &tail->next, tail = *prev)
+ if (tail == overlay)
{
- if (prev)
- prev->next = tmp->next;
- else
- list = tmp->next;
+ *prev = overlay->next;
overlay->next = NULL;
break;
}
return list;
}
+/* Remove OVERLAY from both overlay lists of B. */
+
+static void
+unchain_both (struct buffer *b, Lisp_Object overlay)
+{
+ struct Lisp_Overlay *ov = XOVERLAY (overlay);
+
+ set_buffer_overlays_before (b, unchain_overlay (b->overlays_before, ov));
+ set_buffer_overlays_after (b, unchain_overlay (b->overlays_after, ov));
+ eassert (XOVERLAY (overlay)->next == NULL);
+}
+
DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
@@ -3675,9 +3928,10 @@ If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
buffer. */)
(Lisp_Object overlay, Lisp_Object beg, Lisp_Object end, Lisp_Object buffer)
{
- struct buffer *b, *ob;
+ struct buffer *b, *ob = 0;
Lisp_Object obuffer;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t n_beg, n_end, o_beg IF_LINT (= 0), o_end IF_LINT (= 0);
CHECK_OVERLAY (overlay);
if (NILP (buffer))
@@ -3686,6 +3940,9 @@ buffer. */)
XSETBUFFER (buffer, current_buffer);
CHECK_BUFFER (buffer);
+ if (NILP (Fbuffer_live_p (buffer)))
+ error ("Attempt to move overlay to a dead buffer");
+
if (MARKERP (beg)
&& ! EQ (Fmarker_buffer (beg), buffer))
error ("Marker points into wrong buffer");
@@ -3696,9 +3953,6 @@ buffer. */)
CHECK_NUMBER_COERCE_MARKER (beg);
CHECK_NUMBER_COERCE_MARKER (end);
- if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
- return Fdelete_overlay (overlay);
-
if (XINT (beg) > XINT (end))
{
Lisp_Object temp;
@@ -3709,69 +3963,61 @@ buffer. */)
obuffer = Fmarker_buffer (OVERLAY_START (overlay));
b = XBUFFER (buffer);
- ob = BUFFERP (obuffer) ? XBUFFER (obuffer) : (struct buffer *) 0;
+
+ if (!NILP (obuffer))
+ {
+ ob = XBUFFER (obuffer);
+
+ o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
+ o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
+
+ unchain_both (ob, overlay);
+ }
+
+ /* Set the overlay boundaries, which may clip them. */
+ Fset_marker (OVERLAY_START (overlay), beg, buffer);
+ Fset_marker (OVERLAY_END (overlay), end, buffer);
+
+ n_beg = marker_position (OVERLAY_START (overlay));
+ n_end = marker_position (OVERLAY_END (overlay));
/* If the overlay has changed buffers, do a thorough redisplay. */
if (!EQ (buffer, obuffer))
{
/* Redisplay where the overlay was. */
- if (!NILP (obuffer))
- {
- EMACS_INT o_beg;
- EMACS_INT o_end;
-
- o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
- o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- modify_overlay (ob, o_beg, o_end);
- }
+ if (ob)
+ modify_overlay (ob, o_beg, o_end);
/* Redisplay where the overlay is going to be. */
- modify_overlay (b, XINT (beg), XINT (end));
+ modify_overlay (b, n_beg, n_end);
}
else
/* Redisplay the area the overlay has just left, or just enclosed. */
{
- EMACS_INT o_beg, o_end;
-
- o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
- o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- if (o_beg == XINT (beg))
- modify_overlay (b, o_end, XINT (end));
- else if (o_end == XINT (end))
- modify_overlay (b, o_beg, XINT (beg));
+ if (o_beg == n_beg)
+ modify_overlay (b, o_end, n_end);
+ else if (o_end == n_end)
+ modify_overlay (b, o_beg, n_beg);
else
- {
- if (XINT (beg) < o_beg) o_beg = XINT (beg);
- if (XINT (end) > o_end) o_end = XINT (end);
- modify_overlay (b, o_beg, o_end);
- }
+ modify_overlay (b, min (o_beg, n_beg), max (o_end, n_end));
}
- if (!NILP (obuffer))
- {
- ob->overlays_before
- = unchain_overlay (ob->overlays_before, XOVERLAY (overlay));
- ob->overlays_after
- = unchain_overlay (ob->overlays_after, XOVERLAY (overlay));
- eassert (XOVERLAY (overlay)->next == NULL);
- }
+ /* Delete the overlay if it is empty after clipping and has the
+ evaporate property. */
+ if (n_beg == n_end && !NILP (Foverlay_get (overlay, Qevaporate)))
+ return unbind_to (count, Fdelete_overlay (overlay));
- Fset_marker (OVERLAY_START (overlay), beg, buffer);
- Fset_marker (OVERLAY_END (overlay), end, buffer);
-
- /* Put the overlay on the wrong list. */
- end = OVERLAY_END (overlay);
- if (OVERLAY_POSITION (end) < b->overlay_center)
+ /* Put the overlay into the new buffer's overlay lists, first on the
+ wrong list. */
+ if (n_end < b->overlay_center)
{
XOVERLAY (overlay)->next = b->overlays_after;
- b->overlays_after = XOVERLAY (overlay);
+ set_buffer_overlays_after (b, XOVERLAY (overlay));
}
else
{
XOVERLAY (overlay)->next = b->overlays_before;
- b->overlays_before = XOVERLAY (overlay);
+ set_buffer_overlays_before (b, XOVERLAY (overlay));
}
/* This puts it in the right list, and in the right order. */
@@ -3786,7 +4032,7 @@ DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
{
Lisp_Object buffer;
struct buffer *b;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
CHECK_OVERLAY (overlay);
@@ -3797,14 +4043,8 @@ DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
b = XBUFFER (buffer);
specbind (Qinhibit_quit, Qt);
- b->overlays_before = unchain_overlay (b->overlays_before,XOVERLAY (overlay));
- b->overlays_after = unchain_overlay (b->overlays_after, XOVERLAY (overlay));
- eassert (XOVERLAY (overlay)->next == NULL);
- modify_overlay (b,
- marker_position (OVERLAY_START (overlay)),
- marker_position (OVERLAY_END (overlay)));
- Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
- Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
+ unchain_both (b, overlay);
+ drop_overlay (b, XOVERLAY (overlay));
/* When deleting an overlay with before or after strings, turn off
display optimizations for the affected buffer, on the basis that
@@ -3817,6 +4057,26 @@ DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
return unbind_to (count, Qnil);
}
+
+DEFUN ("delete-all-overlays", Fdelete_all_overlays, Sdelete_all_overlays, 0, 1, 0,
+ doc: /* Delete all overlays of BUFFER.
+BUFFER omitted or nil means delete all overlays of the current
+buffer. */)
+ (Lisp_Object buffer)
+{
+ register struct buffer *buf;
+
+ if (NILP (buffer))
+ buf = current_buffer;
+ else
+ {
+ CHECK_BUFFER (buffer);
+ buf = XBUFFER (buffer);
+ }
+
+ delete_all_overlays (buf);
+ return Qnil;
+}
/* Overlay dissection functions. */
@@ -3872,12 +4132,12 @@ DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
len = 10;
/* We can't use alloca here because overlays_at can call xrealloc. */
- overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
+ overlay_vec = xmalloc (len * sizeof *overlay_vec);
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len. */
noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
- (EMACS_INT *) 0, (EMACS_INT *) 0, 0);
+ NULL, NULL, 0);
/* Make a list of them all. */
result = Flist (noverlays, overlay_vec);
@@ -3903,7 +4163,7 @@ end of the buffer. */)
CHECK_NUMBER_COERCE_MARKER (end);
len = 10;
- overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
+ overlay_vec = xmalloc (len * sizeof *overlay_vec);
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len. */
@@ -3925,26 +4185,26 @@ the value is (point-max). */)
(Lisp_Object pos)
{
ptrdiff_t i, len, noverlays;
- EMACS_INT endpos;
+ ptrdiff_t endpos;
Lisp_Object *overlay_vec;
CHECK_NUMBER_COERCE_MARKER (pos);
len = 10;
- overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
+ overlay_vec = xmalloc (len * sizeof *overlay_vec);
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len.
endpos gets the position where the next overlay starts. */
noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
- &endpos, (EMACS_INT *) 0, 1);
+ &endpos, 0, 1);
/* If any of these overlays ends before endpos,
use its ending point instead. */
for (i = 0; i < noverlays; i++)
{
Lisp_Object oend;
- EMACS_INT oendpos;
+ ptrdiff_t oendpos;
oend = OVERLAY_END (overlay_vec[i]);
oendpos = OVERLAY_POSITION (oend);
@@ -3963,7 +4223,7 @@ If there are no overlay boundaries from (point-min) to POS,
the value is (point-min). */)
(Lisp_Object pos)
{
- EMACS_INT prevpos;
+ ptrdiff_t prevpos;
Lisp_Object *overlay_vec;
ptrdiff_t len;
@@ -3975,13 +4235,13 @@ the value is (point-min). */)
return pos;
len = 10;
- overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
+ overlay_vec = xmalloc (len * sizeof *overlay_vec);
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len.
prevpos gets the position of the previous change. */
overlays_at (XINT (pos), 1, &overlay_vec, &len,
- (EMACS_INT *) 0, &prevpos, 1);
+ 0, &prevpos, 1);
xfree (overlay_vec);
return make_number (prevpos);
@@ -4000,6 +4260,7 @@ However, the overlays you get are the real objects that the buffer uses. */)
{
struct Lisp_Overlay *ol;
Lisp_Object before = Qnil, after = Qnil, tmp;
+
for (ol = current_buffer->overlays_before; ol; ol = ol->next)
{
XSETMISC (tmp, ol);
@@ -4010,6 +4271,7 @@ However, the overlays you get are the real objects that the buffer uses. */)
XSETMISC (tmp, ol);
after = Fcons (tmp, after);
}
+
return Fcons (Fnreverse (before), Fnreverse (after));
}
@@ -4019,9 +4281,11 @@ That makes overlay lookup faster for positions near POS (but perhaps slower
for positions far away from POS). */)
(Lisp_Object pos)
{
+ ptrdiff_t p;
CHECK_NUMBER_COERCE_MARKER (pos);
- recenter_overlay_lists (current_buffer, XINT (pos));
+ p = clip_to_bounds (PTRDIFF_MIN, XINT (pos), PTRDIFF_MAX);
+ recenter_overlay_lists (current_buffer, p);
return Qnil;
}
@@ -4039,7 +4303,7 @@ VALUE will be returned.*/)
(Lisp_Object overlay, Lisp_Object prop, Lisp_Object value)
{
Lisp_Object tail, buffer;
- int changed;
+ bool changed;
CHECK_OVERLAY (overlay);
@@ -4056,8 +4320,8 @@ VALUE will be returned.*/)
}
/* It wasn't in the list, so add it to the front. */
changed = !NILP (value);
- XOVERLAY (overlay)->plist
- = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
+ set_overlay_plist
+ (overlay, Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist)));
found:
if (! NILP (buffer))
{
@@ -4088,7 +4352,7 @@ VALUE will be returned.*/)
static Lisp_Object last_overlay_modification_hooks;
/* Number of elements actually used in last_overlay_modification_hooks. */
-static int last_overlay_modification_hooks_used;
+static ptrdiff_t last_overlay_modification_hooks_used;
/* Add one functionlist/overlay pair
to the end of last_overlay_modification_hooks. */
@@ -4096,11 +4360,11 @@ static int last_overlay_modification_hooks_used;
static void
add_overlay_mod_hooklist (Lisp_Object functionlist, Lisp_Object overlay)
{
- int oldsize = ASIZE (last_overlay_modification_hooks);
+ ptrdiff_t oldsize = ASIZE (last_overlay_modification_hooks);
- if (last_overlay_modification_hooks_used == oldsize)
- last_overlay_modification_hooks = larger_vector
- (last_overlay_modification_hooks, oldsize * 2, Qnil);
+ if (oldsize - 1 <= last_overlay_modification_hooks_used)
+ last_overlay_modification_hooks =
+ larger_vector (last_overlay_modification_hooks, 2, -1);
ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
functionlist); last_overlay_modification_hooks_used++;
ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
@@ -4114,7 +4378,7 @@ add_overlay_mod_hooklist (Lisp_Object functionlist, Lisp_Object overlay)
and the insert-after-hooks of overlay ending at START.
This is called both before and after the modification.
- AFTER is nonzero when we call after the modification.
+ AFTER is true when we call after the modification.
ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
When AFTER is nonzero, they are the start position,
@@ -4122,13 +4386,13 @@ add_overlay_mod_hooklist (Lisp_Object functionlist, Lisp_Object overlay)
and the length of deleted or replaced old text. */
void
-report_overlay_modification (Lisp_Object start, Lisp_Object end, int after,
+report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after,
Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
{
Lisp_Object prop, overlay;
struct Lisp_Overlay *tail;
- /* 1 if this change is an insertion. */
- int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
+ /* True if this change is an insertion. */
+ bool insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
overlay = Qnil;
@@ -4149,7 +4413,7 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, int after,
last_overlay_modification_hooks_used = 0;
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
Lisp_Object ostart, oend;
XSETMISC (overlay, tail);
@@ -4186,7 +4450,7 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, int after,
for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
Lisp_Object ostart, oend;
XSETMISC (overlay, tail);
@@ -4227,12 +4491,12 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, int after,
/* Call the functions recorded in last_overlay_modification_hooks.
First copy the vector contents, in case some of these hooks
do subsequent modification of the buffer. */
- int size = last_overlay_modification_hooks_used;
- Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
- int i;
+ ptrdiff_t size = last_overlay_modification_hooks_used;
+ Lisp_Object *copy = alloca (size * sizeof *copy);
+ ptrdiff_t i;
memcpy (copy, XVECTOR (last_overlay_modification_hooks)->contents,
- size * sizeof (Lisp_Object));
+ size * word_size);
gcpro1.var = copy;
gcpro1.nvars = size;
@@ -4248,7 +4512,7 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, int after,
}
static void
-call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, int after,
+call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, bool after,
Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
@@ -4269,7 +4533,7 @@ call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, int after,
/* Delete any zero-sized overlays at position POS, if the `evaporate'
property is set. */
void
-evaporate_overlays (EMACS_INT pos)
+evaporate_overlays (ptrdiff_t pos)
{
Lisp_Object overlay, hit_list;
struct Lisp_Overlay *tail;
@@ -4278,7 +4542,7 @@ evaporate_overlays (EMACS_INT pos)
if (pos <= current_buffer->overlay_center)
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
- EMACS_INT endpos;
+ ptrdiff_t endpos;
XSETMISC (overlay, tail);
endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
if (endpos < pos)
@@ -4290,7 +4554,7 @@ evaporate_overlays (EMACS_INT pos)
else
for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
- EMACS_INT startpos;
+ ptrdiff_t startpos;
XSETMISC (overlay, tail);
startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
if (startpos > pos)
@@ -4316,7 +4580,7 @@ buffer_slot_type_mismatch (Lisp_Object newval, int type)
case_Lisp_Int: predicate = Qintegerp; break;
case Lisp_String: predicate = Qstringp; break;
case Lisp_Symbol: predicate = Qsymbolp; break;
- default: abort ();
+ default: emacs_abort ();
}
wrong_type_argument (predicate, newval);
@@ -4381,7 +4645,7 @@ struct mmap_region
/* Pointer to the location holding the address of the memory
allocated with the mmap'd block. The variable actually points
after this structure. */
- POINTER_TYPE **var;
+ void **var;
/* Next and previous in list of all mmap'd regions. */
struct mmap_region *next, *prev;
@@ -4407,7 +4671,7 @@ static int mmap_page_size;
/* 1 means mmap has been initialized. */
-static int mmap_initialized_p;
+static bool mmap_initialized_p;
/* Value is X rounded up to the next multiple of N. */
@@ -4428,7 +4692,7 @@ static int mmap_initialized_p;
to the start of the user-visible part of the region. */
#define MMAP_USER_AREA(P) \
- ((POINTER_TYPE *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
+ ((void *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
#define MEM_ALIGN sizeof (double)
@@ -4477,7 +4741,7 @@ mmap_init (void)
is at END - 1. */
static struct mmap_region *
-mmap_find (POINTER_TYPE *start, POINTER_TYPE *end)
+mmap_find (void *start, void *end)
{
struct mmap_region *r;
char *s = (char *) start, *e = (char *) end;
@@ -4503,9 +4767,9 @@ mmap_find (POINTER_TYPE *start, POINTER_TYPE *end)
/* Unmap a region. P is a pointer to the start of the user-araa of
- the region. Value is non-zero if successful. */
+ the region. */
-static int
+static void
mmap_free_1 (struct mmap_region *r)
{
if (r->next)
@@ -4515,25 +4779,20 @@ mmap_free_1 (struct mmap_region *r)
else
mmap_regions = r->next;
- if (munmap ((POINTER_TYPE *) r, r->nbytes_mapped) == -1)
- {
- fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
- return 0;
- }
-
- return 1;
+ if (munmap (r, r->nbytes_mapped) == -1)
+ fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
}
/* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
- Value is non-zero if successful. */
+ Value is true if successful. */
-static int
+static bool
mmap_enlarge (struct mmap_region *r, int npages)
{
char *region_end = (char *) r + r->nbytes_mapped;
size_t nbytes;
- int success = 0;
+ bool success = 0;
if (npages < 0)
{
@@ -4557,13 +4816,13 @@ mmap_enlarge (struct mmap_region *r, int npages)
I'm not sure this is worth doing, let's see. */
if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
{
- POINTER_TYPE *p;
+ void *p;
p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
if (p == MAP_FAILED)
; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
- else if (p != (POINTER_TYPE *) region_end)
+ else if (p != region_end)
{
/* Kernels are free to choose a different address. In
that case, unmap what we've mapped above; we have
@@ -4583,17 +4842,16 @@ mmap_enlarge (struct mmap_region *r, int npages)
}
-/* Set or reset variables holding references to mapped regions. If
- RESTORE_P is zero, set all variables to null. If RESTORE_P is
- non-zero, set all variables to the start of the user-areas
- of mapped regions.
+/* Set or reset variables holding references to mapped regions.
+ If not RESTORE_P, set all variables to null. If RESTORE_P, set all
+ variables to the start of the user-areas of mapped regions.
This function is called from Fdump_emacs to ensure that the dumped
Emacs doesn't contain references to memory that won't be mapped
when Emacs starts. */
void
-mmap_set_vars (int restore_p)
+mmap_set_vars (bool restore_p)
{
struct mmap_region *r;
@@ -4625,8 +4883,8 @@ mmap_set_vars (int restore_p)
If we can't allocate the necessary memory, set *VAR to null, and
return null. */
-static POINTER_TYPE *
-mmap_alloc (POINTER_TYPE **var, size_t nbytes)
+static void *
+mmap_alloc (void **var, size_t nbytes)
{
void *p;
size_t map;
@@ -4667,7 +4925,7 @@ mmap_alloc (POINTER_TYPE **var, size_t nbytes)
PTR. Store 0 in *PTR to show there's no block allocated. */
static void
-mmap_free (POINTER_TYPE **var)
+mmap_free (void **var)
{
mmap_init ();
@@ -4684,10 +4942,10 @@ mmap_free (POINTER_TYPE **var)
and return this value. If more memory cannot be allocated, then
leave *VAR unchanged, and return null. */
-static POINTER_TYPE *
-mmap_realloc (POINTER_TYPE **var, size_t nbytes)
+static void *
+mmap_realloc (void **var, size_t nbytes)
{
- POINTER_TYPE *result;
+ void *result;
mmap_init ();
@@ -4706,7 +4964,7 @@ mmap_realloc (POINTER_TYPE **var, size_t nbytes)
if (room < nbytes)
{
/* Must enlarge. */
- POINTER_TYPE *old_ptr = *var;
+ void *old_ptr = *var;
/* Try to map additional pages at the end of the region.
If that fails, allocate a new region, copy data
@@ -4763,65 +5021,58 @@ mmap_realloc (POINTER_TYPE **var, size_t nbytes)
Buffer-text Allocation
***********************************************************************/
-#ifdef REL_ALLOC
-extern POINTER_TYPE *r_alloc (POINTER_TYPE **, size_t);
-extern POINTER_TYPE *r_re_alloc (POINTER_TYPE **, size_t);
-extern void r_alloc_free (POINTER_TYPE **ptr);
-#endif /* REL_ALLOC */
-
-
/* Allocate NBYTES bytes for buffer B's text buffer. */
static void
alloc_buffer_text (struct buffer *b, ptrdiff_t nbytes)
{
- POINTER_TYPE *p;
+ void *p;
- BLOCK_INPUT;
+ block_input ();
#if defined USE_MMAP_FOR_BUFFERS
- p = mmap_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
+ p = mmap_alloc ((void **) &b->text->beg, nbytes);
#elif defined REL_ALLOC
- p = r_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
+ p = r_alloc ((void **) &b->text->beg, nbytes);
#else
p = xmalloc (nbytes);
#endif
if (p == NULL)
{
- UNBLOCK_INPUT;
+ unblock_input ();
memory_full (nbytes);
}
b->text->beg = (unsigned char *) p;
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
shrink it. */
void
-enlarge_buffer_text (struct buffer *b, EMACS_INT delta)
+enlarge_buffer_text (struct buffer *b, ptrdiff_t delta)
{
- POINTER_TYPE *p;
+ void *p;
ptrdiff_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
+ delta);
- BLOCK_INPUT;
+ block_input ();
#if defined USE_MMAP_FOR_BUFFERS
- p = mmap_realloc ((POINTER_TYPE **) &b->text->beg, nbytes);
+ p = mmap_realloc ((void **) &b->text->beg, nbytes);
#elif defined REL_ALLOC
- p = r_re_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
+ p = r_re_alloc ((void **) &b->text->beg, nbytes);
#else
p = xrealloc (b->text->beg, nbytes);
#endif
if (p == NULL)
{
- UNBLOCK_INPUT;
+ unblock_input ();
memory_full (nbytes);
}
BUF_BEG_ADDR (b) = (unsigned char *) p;
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -4830,18 +5081,18 @@ enlarge_buffer_text (struct buffer *b, EMACS_INT delta)
static void
free_buffer_text (struct buffer *b)
{
- BLOCK_INPUT;
+ block_input ();
#if defined USE_MMAP_FOR_BUFFERS
- mmap_free ((POINTER_TYPE **) &b->text->beg);
+ mmap_free ((void **) &b->text->beg);
#elif defined REL_ALLOC
- r_alloc_free ((POINTER_TYPE **) &b->text->beg);
+ r_alloc_free ((void **) &b->text->beg);
#else
xfree (b->text->beg);
#endif
BUF_BEG_ADDR (b) = NULL;
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -4868,68 +5119,70 @@ init_buffer_once (void)
/* Prevent GC from getting confused. */
buffer_defaults.text = &buffer_defaults.own_text;
buffer_local_symbols.text = &buffer_local_symbols.own_text;
- BUF_INTERVALS (&buffer_defaults) = 0;
- BUF_INTERVALS (&buffer_local_symbols) = 0;
- XSETPVECTYPESIZE (&buffer_defaults, PVEC_BUFFER, 0);
- XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
- XSETPVECTYPESIZE (&buffer_local_symbols, PVEC_BUFFER, 0);
- XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
+ /* No one will share the text with these buffers, but let's play it safe. */
+ buffer_defaults.indirections = 0;
+ buffer_local_symbols.indirections = 0;
+ set_buffer_intervals (&buffer_defaults, NULL);
+ set_buffer_intervals (&buffer_local_symbols, NULL);
+ /* This is not strictly necessary, but let's make them initialized. */
+ bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*"));
+ bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*"));
+ BUFFER_PVEC_INIT (&buffer_defaults);
+ BUFFER_PVEC_INIT (&buffer_local_symbols);
/* Set up the default values of various buffer slots. */
/* Must do these before making the first buffer! */
/* real setup is done in bindings.el */
- BVAR (&buffer_defaults, mode_line_format) = make_pure_c_string ("%-");
- BVAR (&buffer_defaults, header_line_format) = Qnil;
- BVAR (&buffer_defaults, abbrev_mode) = Qnil;
- BVAR (&buffer_defaults, overwrite_mode) = Qnil;
- BVAR (&buffer_defaults, case_fold_search) = Qt;
- BVAR (&buffer_defaults, auto_fill_function) = Qnil;
- BVAR (&buffer_defaults, selective_display) = Qnil;
-#ifndef old
- BVAR (&buffer_defaults, selective_display_ellipses) = Qt;
-#endif
- BVAR (&buffer_defaults, abbrev_table) = Qnil;
- BVAR (&buffer_defaults, display_table) = Qnil;
- BVAR (&buffer_defaults, undo_list) = Qnil;
- BVAR (&buffer_defaults, mark_active) = Qnil;
- BVAR (&buffer_defaults, file_format) = Qnil;
- BVAR (&buffer_defaults, auto_save_file_format) = Qt;
- buffer_defaults.overlays_before = NULL;
- buffer_defaults.overlays_after = NULL;
+ bset_mode_line_format (&buffer_defaults, build_pure_c_string ("%-"));
+ bset_header_line_format (&buffer_defaults, Qnil);
+ bset_abbrev_mode (&buffer_defaults, Qnil);
+ bset_overwrite_mode (&buffer_defaults, Qnil);
+ bset_case_fold_search (&buffer_defaults, Qt);
+ bset_auto_fill_function (&buffer_defaults, Qnil);
+ bset_selective_display (&buffer_defaults, Qnil);
+ bset_selective_display_ellipses (&buffer_defaults, Qt);
+ bset_abbrev_table (&buffer_defaults, Qnil);
+ bset_display_table (&buffer_defaults, Qnil);
+ bset_undo_list (&buffer_defaults, Qnil);
+ bset_mark_active (&buffer_defaults, Qnil);
+ bset_file_format (&buffer_defaults, Qnil);
+ bset_auto_save_file_format (&buffer_defaults, Qt);
+ set_buffer_overlays_before (&buffer_defaults, NULL);
+ set_buffer_overlays_after (&buffer_defaults, NULL);
buffer_defaults.overlay_center = BEG;
XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8);
- BVAR (&buffer_defaults, truncate_lines) = Qnil;
- BVAR (&buffer_defaults, word_wrap) = Qnil;
- BVAR (&buffer_defaults, ctl_arrow) = Qt;
- BVAR (&buffer_defaults, bidi_display_reordering) = Qt;
- BVAR (&buffer_defaults, bidi_paragraph_direction) = Qnil;
- BVAR (&buffer_defaults, cursor_type) = Qt;
- BVAR (&buffer_defaults, extra_line_spacing) = Qnil;
- BVAR (&buffer_defaults, cursor_in_non_selected_windows) = Qt;
-
- BVAR (&buffer_defaults, enable_multibyte_characters) = Qt;
- BVAR (&buffer_defaults, buffer_file_coding_system) = Qnil;
+ bset_truncate_lines (&buffer_defaults, Qnil);
+ bset_word_wrap (&buffer_defaults, Qnil);
+ bset_ctl_arrow (&buffer_defaults, Qt);
+ bset_bidi_display_reordering (&buffer_defaults, Qt);
+ bset_bidi_paragraph_direction (&buffer_defaults, Qnil);
+ bset_cursor_type (&buffer_defaults, Qt);
+ bset_extra_line_spacing (&buffer_defaults, Qnil);
+ bset_cursor_in_non_selected_windows (&buffer_defaults, Qt);
+
+ bset_enable_multibyte_characters (&buffer_defaults, Qt);
+ bset_buffer_file_coding_system (&buffer_defaults, Qnil);
XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70);
XSETFASTINT (BVAR (&buffer_defaults, left_margin), 0);
- BVAR (&buffer_defaults, cache_long_line_scans) = Qnil;
- BVAR (&buffer_defaults, file_truename) = Qnil;
+ bset_cache_long_line_scans (&buffer_defaults, Qnil);
+ bset_file_truename (&buffer_defaults, Qnil);
XSETFASTINT (BVAR (&buffer_defaults, display_count), 0);
XSETFASTINT (BVAR (&buffer_defaults, left_margin_cols), 0);
XSETFASTINT (BVAR (&buffer_defaults, right_margin_cols), 0);
- BVAR (&buffer_defaults, left_fringe_width) = Qnil;
- BVAR (&buffer_defaults, right_fringe_width) = Qnil;
- BVAR (&buffer_defaults, fringes_outside_margins) = Qnil;
- BVAR (&buffer_defaults, scroll_bar_width) = Qnil;
- BVAR (&buffer_defaults, vertical_scroll_bar_type) = Qt;
- BVAR (&buffer_defaults, indicate_empty_lines) = Qnil;
- BVAR (&buffer_defaults, indicate_buffer_boundaries) = Qnil;
- BVAR (&buffer_defaults, fringe_indicator_alist) = Qnil;
- BVAR (&buffer_defaults, fringe_cursor_alist) = Qnil;
- BVAR (&buffer_defaults, scroll_up_aggressively) = Qnil;
- BVAR (&buffer_defaults, scroll_down_aggressively) = Qnil;
- BVAR (&buffer_defaults, display_time) = Qnil;
+ bset_left_fringe_width (&buffer_defaults, Qnil);
+ bset_right_fringe_width (&buffer_defaults, Qnil);
+ bset_fringes_outside_margins (&buffer_defaults, Qnil);
+ bset_scroll_bar_width (&buffer_defaults, Qnil);
+ bset_vertical_scroll_bar_type (&buffer_defaults, Qt);
+ bset_indicate_empty_lines (&buffer_defaults, Qnil);
+ bset_indicate_buffer_boundaries (&buffer_defaults, Qnil);
+ bset_fringe_indicator_alist (&buffer_defaults, Qnil);
+ bset_fringe_cursor_alist (&buffer_defaults, Qnil);
+ bset_scroll_up_aggressively (&buffer_defaults, Qnil);
+ bset_scroll_down_aggressively (&buffer_defaults, Qnil);
+ bset_display_time (&buffer_defaults, Qnil);
/* Assign the local-flags to the slots that have default values.
The local flag is a bit that is used in the buffer
@@ -4937,28 +5190,28 @@ init_buffer_once (void)
The local flag bits are in the local_var_flags slot of the buffer. */
/* Nothing can work if this isn't true */
- { verify (sizeof (EMACS_INT) == sizeof (Lisp_Object)); }
+ { verify (sizeof (EMACS_INT) == word_size); }
/* 0 means not a lisp var, -1 means always local, else mask */
memset (&buffer_local_flags, 0, sizeof buffer_local_flags);
- XSETINT (BVAR (&buffer_local_flags, filename), -1);
- XSETINT (BVAR (&buffer_local_flags, directory), -1);
- XSETINT (BVAR (&buffer_local_flags, backed_up), -1);
- XSETINT (BVAR (&buffer_local_flags, save_length), -1);
- XSETINT (BVAR (&buffer_local_flags, auto_save_file_name), -1);
- XSETINT (BVAR (&buffer_local_flags, read_only), -1);
- XSETINT (BVAR (&buffer_local_flags, major_mode), -1);
- XSETINT (BVAR (&buffer_local_flags, mode_name), -1);
- XSETINT (BVAR (&buffer_local_flags, undo_list), -1);
- XSETINT (BVAR (&buffer_local_flags, mark_active), -1);
- XSETINT (BVAR (&buffer_local_flags, point_before_scroll), -1);
- XSETINT (BVAR (&buffer_local_flags, file_truename), -1);
- XSETINT (BVAR (&buffer_local_flags, invisibility_spec), -1);
- XSETINT (BVAR (&buffer_local_flags, file_format), -1);
- XSETINT (BVAR (&buffer_local_flags, auto_save_file_format), -1);
- XSETINT (BVAR (&buffer_local_flags, display_count), -1);
- XSETINT (BVAR (&buffer_local_flags, display_time), -1);
- XSETINT (BVAR (&buffer_local_flags, enable_multibyte_characters), -1);
+ bset_filename (&buffer_local_flags, make_number (-1));
+ bset_directory (&buffer_local_flags, make_number (-1));
+ bset_backed_up (&buffer_local_flags, make_number (-1));
+ bset_save_length (&buffer_local_flags, make_number (-1));
+ bset_auto_save_file_name (&buffer_local_flags, make_number (-1));
+ bset_read_only (&buffer_local_flags, make_number (-1));
+ bset_major_mode (&buffer_local_flags, make_number (-1));
+ bset_mode_name (&buffer_local_flags, make_number (-1));
+ bset_undo_list (&buffer_local_flags, make_number (-1));
+ bset_mark_active (&buffer_local_flags, make_number (-1));
+ bset_point_before_scroll (&buffer_local_flags, make_number (-1));
+ bset_file_truename (&buffer_local_flags, make_number (-1));
+ bset_invisibility_spec (&buffer_local_flags, make_number (-1));
+ bset_file_format (&buffer_local_flags, make_number (-1));
+ bset_auto_save_file_format (&buffer_local_flags, make_number (-1));
+ bset_display_count (&buffer_local_flags, make_number (-1));
+ bset_display_time (&buffer_local_flags, make_number (-1));
+ bset_enable_multibyte_characters (&buffer_local_flags, make_number (-1));
idx = 1;
XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx;
@@ -4967,9 +5220,7 @@ init_buffer_once (void)
XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx;
-#ifndef old
XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx;
-#endif
XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx;
@@ -5006,17 +5257,17 @@ init_buffer_once (void)
/* Need more room? */
if (idx >= MAX_PER_BUFFER_VARS)
- abort ();
+ emacs_abort ();
last_per_buffer_idx = idx;
Vbuffer_alist = Qnil;
current_buffer = 0;
all_buffers = 0;
- QSFundamental = make_pure_c_string ("Fundamental");
+ QSFundamental = build_pure_c_string ("Fundamental");
Qfundamental_mode = intern_c_string ("fundamental-mode");
- BVAR (&buffer_defaults, major_mode) = Qfundamental_mode;
+ bset_major_mode (&buffer_defaults, Qfundamental_mode);
Qmode_class = intern_c_string ("mode-class");
@@ -5027,13 +5278,11 @@ init_buffer_once (void)
Qkill_buffer_hook = intern_c_string ("kill-buffer-hook");
Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
- Qucs_set_table_for_input = intern_c_string ("ucs-set-table-for-input");
-
/* super-magic invisible buffer */
- Vprin1_to_string_buffer = Fget_buffer_create (make_pure_c_string (" prin1"));
+ Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1"));
Vbuffer_alist = Qnil;
- Fset_buffer (Fget_buffer_create (make_pure_c_string ("*scratch*")));
+ Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*")));
inhibit_modification_hooks = 0;
}
@@ -5052,7 +5301,7 @@ init_buffer (void)
Map new memory. */
struct buffer *b;
- for (b = all_buffers; b; b = b->header.next.buffer)
+ FOR_EACH_BUFFER (b)
if (b->text->beg == NULL)
enlarge_buffer_text (b, 0);
}
@@ -5073,20 +5322,21 @@ init_buffer (void)
if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
{
/* Grow buffer to add directory separator and '\0'. */
- pwd = (char *) realloc (pwd, len + 2);
+ pwd = realloc (pwd, len + 2);
if (!pwd)
fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
pwd[len] = DIRECTORY_SEP;
pwd[len + 1] = '\0';
+ len++;
}
- BVAR (current_buffer, directory) = make_unibyte_string (pwd, strlen (pwd));
+ bset_directory (current_buffer, make_unibyte_string (pwd, len));
if (! NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
/* At this moment, we still don't know how to decode the
directory name. So, we keep the bytes in multibyte form so
that ENCODE_FILE correctly gets the original bytes. */
- BVAR (current_buffer, directory)
- = string_to_multibyte (BVAR (current_buffer, directory));
+ bset_directory
+ (current_buffer, string_to_multibyte (BVAR (current_buffer, directory)));
/* Add /: to the front of the name
if it would otherwise be treated as magic. */
@@ -5097,11 +5347,12 @@ init_buffer (void)
However, it is not necessary to turn / into /:/.
So avoid doing that. */
&& strcmp ("/", SSDATA (BVAR (current_buffer, directory))))
- BVAR (current_buffer, directory)
- = concat2 (build_string ("/:"), BVAR (current_buffer, directory));
+ bset_directory
+ (current_buffer,
+ concat2 (build_string ("/:"), BVAR (current_buffer, directory)));
temp = get_minibuffer (0);
- BVAR (XBUFFER (temp), directory) = BVAR (current_buffer, directory);
+ bset_directory (XBUFFER (temp), BVAR (current_buffer, directory));
free (pwd);
}
@@ -5147,7 +5398,7 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring,
if (PER_BUFFER_IDX (offset) == 0)
/* Did a DEFVAR_PER_BUFFER without initializing the corresponding
slot of buffer_local_flags */
- abort ();
+ emacs_abort ();
}
@@ -5159,8 +5410,6 @@ syms_of_buffer (void)
last_overlay_modification_hooks
= Fmake_vector (make_number (10), Qnil);
- staticpro (&Vbuffer_defaults);
- staticpro (&Vbuffer_local_symbols);
staticpro (&Qfundamental_mode);
staticpro (&Qmode_class);
staticpro (&QSFundamental);
@@ -5184,13 +5433,10 @@ syms_of_buffer (void)
DEFSYM (Qafter_change_functions, "after-change-functions");
DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions");
- /* The next one is initialized in init_buffer_once. */
- staticpro (&Qucs_set_table_for_input);
-
Fput (Qprotected_field, Qerror_conditions,
- pure_cons (Qprotected_field, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qprotected_field, Qerror));
Fput (Qprotected_field, Qerror_message,
- make_pure_c_string ("Attempt to modify a protected field"));
+ build_pure_c_string ("Attempt to modify a protected field"));
DEFVAR_BUFFER_DEFAULTS ("default-mode-line-format",
mode_line_format,
@@ -5228,7 +5474,7 @@ This is the same as (default-value 'ctl-arrow). */);
DEFVAR_BUFFER_DEFAULTS ("default-enable-multibyte-characters",
enable_multibyte_characters,
- doc: /* *Default value of `enable-multibyte-characters' for buffers not overriding it.
+ doc: /* Default value of `enable-multibyte-characters' for buffers not overriding it.
This is the same as (default-value 'enable-multibyte-characters). */);
DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system",
@@ -5338,31 +5584,40 @@ the mode line appears at the bottom. */);
DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format),
Qnil,
doc: /* Template for displaying mode line for current buffer.
-Each buffer has its own value of this variable.
-Value may be nil, a string, a symbol or a list or cons cell.
+
+The value may be nil, a string, a symbol or a list.
+
A value of nil means don't display a mode line.
-For a symbol, its value is used (but it is ignored if t or nil).
- A string appearing directly as the value of a symbol is processed verbatim
- in that the %-constructs below are not recognized.
- Note that unless the symbol is marked as a `risky-local-variable', all
- properties in any strings, as well as all :eval and :propertize forms
- in the value of that symbol will be ignored.
-For a list of the form `(:eval FORM)', FORM is evaluated and the result
- is used as a mode line element. Be careful--FORM should not load any files,
- because that can cause an infinite recursion.
-For a list of the form `(:propertize ELT PROPS...)', ELT is displayed
- with the specified properties PROPS applied.
-For a list whose car is a symbol, the symbol's value is taken,
- and if that is non-nil, the cadr of the list is processed recursively.
- Otherwise, the caddr of the list (if there is one) is processed.
-For a list whose car is a string or list, each element is processed
- recursively and the results are effectively concatenated.
-For a list whose car is an integer, the cdr of the list is processed
- and padded (if the number is positive) or truncated (if negative)
- to the width specified by that number.
+
+For any symbol other than t or nil, the symbol's value is processed as
+ a mode line construct. As a special exception, if that value is a
+ string, the string is processed verbatim, without handling any
+ %-constructs (see below). Also, unless the symbol has a non-nil
+ `risky-local-variable' property, all properties in any strings, as
+ well as all :eval and :propertize forms in the value, are ignored.
+
+A list whose car is a string or list is processed by processing each
+ of the list elements recursively, as separate mode line constructs,
+ and concatenating the results.
+
+A list of the form `(:eval FORM)' is processed by evaluating FORM and
+ using the result as a mode line construct. Be careful--FORM should
+ not load any files, because that can cause an infinite recursion.
+
+A list of the form `(:propertize ELT PROPS...)' is processed by
+ processing ELT as the mode line construct, and adding the text
+ properties PROPS to the result.
+
+A list whose car is a symbol is processed by examining the symbol's
+ value, and, if that value is non-nil, processing the cadr of the list
+ recursively; and if that value is nil, processing the caddr of the
+ list recursively.
+
+A list whose car is an integer is processed by processing the cadr of
+ the list, and padding (if the number is positive) or truncating (if
+ negative) to the width specified by that number.
+
A string is printed verbatim in the mode line except for %-constructs:
- (%-constructs are allowed when the string is the entire mode-line-format
- or when it is found in a cons-cell or a list)
%b -- print buffer name. %f -- print visited file name.
%F -- print frame name.
%* -- print %, * or hyphen. %+ -- print *, % or hyphen.
@@ -5390,7 +5645,7 @@ A string is printed verbatim in the mode line except for %-constructs:
Decimal digits after the % specify field width to which to pad. */);
DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode,
- doc: /* *Value of `major-mode' for new buffers. */);
+ doc: /* Value of `major-mode' for new buffers. */);
DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode),
make_number (Lisp_Symbol),
@@ -5421,25 +5676,25 @@ Use the command `abbrev-mode' to change this variable. */);
DEFVAR_PER_BUFFER ("case-fold-search", &BVAR (current_buffer, case_fold_search),
Qnil,
- doc: /* *Non-nil if searches and matches should ignore case. */);
+ doc: /* Non-nil if searches and matches should ignore case. */);
DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column),
- make_number (LISP_INT_TAG),
- doc: /* *Column beyond which automatic line-wrapping should happen.
+ make_number (Lisp_Int0),
+ doc: /* Column beyond which automatic line-wrapping should happen.
Interactively, you can set the buffer local value using \\[set-fill-column]. */);
DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin),
- make_number (LISP_INT_TAG),
- doc: /* *Column for the default `indent-line-function' to indent to.
+ make_number (Lisp_Int0),
+ doc: /* Column for the default `indent-line-function' to indent to.
Linefeed indents to this column in Fundamental mode. */);
DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width),
- make_number (LISP_INT_TAG),
- doc: /* *Distance between tab stops (for display of tab characters), in columns.
+ make_number (Lisp_Int0),
+ doc: /* Distance between tab stops (for display of tab characters), in columns.
This should be an integer greater than zero. */);
DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil,
- doc: /* *Non-nil means display control chars with uparrow.
+ doc: /* Non-nil means display control chars with uparrow.
A value of nil means use backslash and octal digits.
This variable does not apply to characters whose display is specified
in the current display table (if there is one). */);
@@ -5480,7 +5735,7 @@ This variable is never applied to a way of decoding a file while reading it. */
DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
&BVAR (current_buffer, bidi_paragraph_direction), Qnil,
- doc: /* *If non-nil, forces directionality of text paragraphs in the buffer.
+ doc: /* If non-nil, forces directionality of text paragraphs in the buffer.
If this is nil (the default), the direction of each paragraph is
determined by the first strong directional character of its text.
@@ -5491,7 +5746,7 @@ This variable has no effect unless the buffer's value of
\`bidi-display-reordering' is non-nil. */);
DEFVAR_PER_BUFFER ("truncate-lines", &BVAR (current_buffer, truncate_lines), Qnil,
- doc: /* *Non-nil means do not display continuation lines.
+ doc: /* Non-nil means do not display continuation lines.
Instead, give each line of text just one screen line.
Note that this is overridden by the variable
@@ -5501,7 +5756,7 @@ and this buffer is not full-frame width.
Minibuffers set this variable to nil. */);
DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil,
- doc: /* *Non-nil means to use word-wrapping for continuation lines.
+ doc: /* Non-nil means to use word-wrapping for continuation lines.
When word-wrapping is on, continuation lines are wrapped at the space
or tab character nearest to the right window edge.
If nil, continuation lines are wrapped at the right screen edge.
@@ -5510,7 +5765,13 @@ This variable has no effect if long lines are truncated (see
`truncate-lines' and `truncate-partial-width-windows'). If you use
word-wrapping, you might want to reduce the value of
`truncate-partial-width-windows', since wrapping can make text readable
-in narrower windows. */);
+in narrower windows.
+
+Instead of setting this variable directly, most users should use
+Visual Line mode . Visual Line mode, when enabled, sets `word-wrap'
+to t, and additionally redefines simple editing commands to act on
+visual lines rather than logical lines. See the documentation of
+`visual-line-mode'. */);
DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory),
make_number (Lisp_String),
@@ -5549,7 +5810,7 @@ If it is nil, that means don't auto-save this buffer. */);
Backing up is done before the first time the file is saved. */);
DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length),
- make_number (LISP_INT_TAG),
+ make_number (Lisp_Int0),
doc: /* Length of current buffer when last read in, saved or auto-saved.
0 initially.
-1 means auto-saving turned off until next real save.
@@ -5567,12 +5828,10 @@ A value of t means that the character ^M makes itself and
all the rest of the line invisible; also, when saving the buffer
in a file, save the ^M as a newline. */);
-#ifndef old
DEFVAR_PER_BUFFER ("selective-display-ellipses",
&BVAR (current_buffer, selective_display_ellipses),
Qnil,
doc: /* Non-nil means display ... on previous line when a line is invisible. */);
-#endif
DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode), Qnil,
doc: /* Non-nil if self-insertion should replace existing text.
@@ -5622,39 +5881,39 @@ See also the functions `display-table-slot' and `set-display-table-slot'. */);
DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols),
Qnil,
- doc: /* *Width of left marginal area for display of a buffer.
+ doc: /* Width of left marginal area for display of a buffer.
A value of nil means no marginal area. */);
DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols),
Qnil,
- doc: /* *Width of right marginal area for display of a buffer.
+ doc: /* Width of right marginal area for display of a buffer.
A value of nil means no marginal area. */);
DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width),
Qnil,
- doc: /* *Width of this buffer's left fringe (in pixels).
+ doc: /* Width of this buffer's left fringe (in pixels).
A value of 0 means no left fringe is shown in this buffer's window.
A value of nil means to use the left fringe width from the window's frame. */);
DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width),
Qnil,
- doc: /* *Width of this buffer's right fringe (in pixels).
+ doc: /* Width of this buffer's right fringe (in pixels).
A value of 0 means no right fringe is shown in this buffer's window.
A value of nil means to use the right fringe width from the window's frame. */);
DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins),
Qnil,
- doc: /* *Non-nil means to display fringes outside display margins.
+ doc: /* Non-nil means to display fringes outside display margins.
A value of nil means to display fringes between margins and buffer text. */);
DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width),
Qnil,
- doc: /* *Width of this buffer's scroll bars in pixels.
+ doc: /* Width of this buffer's scroll bars in pixels.
A value of nil means to use the scroll bar width from the window's frame. */);
DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type),
Qnil,
- doc: /* *Position of this buffer's vertical scroll bar.
+ doc: /* Position of this buffer's vertical scroll bar.
The value takes effect whenever you tell a window to display this buffer;
for instance, with `set-window-buffer' or when `display-buffer' displays it.
@@ -5664,13 +5923,13 @@ A value of t (the default) means do whatever the window's frame specifies. */);
DEFVAR_PER_BUFFER ("indicate-empty-lines",
&BVAR (current_buffer, indicate_empty_lines), Qnil,
- doc: /* *Visually indicate empty lines after the buffer end.
+ doc: /* Visually indicate empty lines after the buffer end.
If non-nil, a bitmap is displayed in the left fringe of a window on
window-systems. */);
DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
&BVAR (current_buffer, indicate_buffer_boundaries), Qnil,
- doc: /* *Visually indicate buffer boundaries and scrolling.
+ doc: /* Visually indicate buffer boundaries and scrolling.
If non-nil, the first and last line of the buffer are marked in the fringe
of a window on window-systems with angle bitmaps, or if the window can be
scrolled, the top and bottom line of the window are marked with up and down
@@ -5695,7 +5954,7 @@ fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */);
DEFVAR_PER_BUFFER ("fringe-indicator-alist",
&BVAR (current_buffer, fringe_indicator_alist), Qnil,
- doc: /* *Mapping from logical to physical fringe indicator bitmaps.
+ doc: /* Mapping from logical to physical fringe indicator bitmaps.
The value is an alist where each element (INDICATOR . BITMAPS)
specifies the fringe bitmaps used to display a specific logical
fringe indicator.
@@ -5714,7 +5973,7 @@ symbol which is used in both left and right fringes. */);
DEFVAR_PER_BUFFER ("fringe-cursor-alist",
&BVAR (current_buffer, fringe_cursor_alist), Qnil,
- doc: /* *Mapping from logical to physical fringe cursor bitmaps.
+ doc: /* Mapping from logical to physical fringe cursor bitmaps.
The value is an alist where each element (CURSOR . BITMAP)
specifies the fringe bitmaps used to display a specific logical
cursor type in the fringe.
@@ -5807,9 +6066,9 @@ An entry (TEXT . POSITION) represents the deletion of the string TEXT
from (abs POSITION). If POSITION is positive, point was at the front
of the text being deleted; if negative, point was at the end.
-An entry (t HIGH . LOW) indicates that the buffer previously had
-\"unmodified\" status. HIGH and LOW are the high and low 16-bit portions
-of the visited file's modification time, as of that time. If the
+An entry (t HIGH LOW USEC PSEC) indicates that the buffer was previously
+unmodified; (HIGH LOW USEC PSEC) is in the same style as (current-time)
+and is the visited file's modification time, as of that time. If the
modification time of the most recent save is different, this entry is
obsolete.
@@ -5878,7 +6137,7 @@ set when a file is visited. */);
DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
&BVAR (current_buffer, auto_save_file_format), Qnil,
- doc: /* *Format in which to write auto-save files.
+ doc: /* Format in which to write auto-save files.
Should be a list of symbols naming formats that are defined in `format-alist'.
If it is t, which is the default, auto-save files are written in the
same format as a regular save would use. */);
@@ -5928,7 +6187,7 @@ Lisp programs may give this variable certain special values:
Vtransient_mark_mode = Qnil;
DEFVAR_LISP ("inhibit-read-only", Vinhibit_read_only,
- doc: /* *Non-nil means disregard read-only status of buffers or characters.
+ doc: /* Non-nil means disregard read-only status of buffers or characters.
If the value is t, disregard `buffer-read-only' and all `read-only'
text properties. If the value is a list, disregard `buffer-read-only'
and disregard a `read-only' text property if the property value
@@ -5939,15 +6198,15 @@ is a member of the list. */);
doc: /* Cursor to use when this buffer is in the selected window.
Values are interpreted as follows:
- t use the cursor specified for the frame
- nil don't display a cursor
- box display a filled box cursor
- hollow display a hollow box cursor
- bar display a vertical bar cursor with default width
- (bar . WIDTH) display a vertical bar cursor with width WIDTH
- hbar display a horizontal bar cursor with default height
+ t use the cursor specified for the frame
+ nil don't display a cursor
+ box display a filled box cursor
+ hollow display a hollow box cursor
+ bar display a vertical bar cursor with default width
+ (bar . WIDTH) display a vertical bar cursor with width WIDTH
+ hbar display a horizontal bar cursor with default height
(hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
- ANYTHING ELSE display a hollow box cursor
+ ANYTHING ELSE display a hollow box cursor
When the buffer is displayed in a non-selected window, the
cursor's appearance is instead controlled by the variable
@@ -5963,7 +6222,7 @@ to the default frame line height. A value of nil means add no extra space. */)
DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
&BVAR (current_buffer, cursor_in_non_selected_windows), Qnil,
- doc: /* *Non-nil means show a cursor in non-selected windows.
+ doc: /* Non-nil means show a cursor in non-selected windows.
If nil, only shows a cursor in the selected window.
If t, displays a cursor related to the usual cursor type
\(a solid box becomes hollow, a bar becomes a narrower bar).
@@ -5973,7 +6232,9 @@ Use Custom to set this variable and update the display." */);
DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions,
doc: /* List of functions called with no args to query before killing a buffer.
The buffer being killed will be current while the functions are running.
-If any of them returns nil, the buffer is not killed. */);
+
+If any of them returns nil, the buffer is not killed. Functions run by
+this hook are supposed to not change the current buffer. */);
Vkill_buffer_query_functions = Qnil;
DEFVAR_LISP ("change-major-mode-hook", Vchange_major_mode_hook,
@@ -5986,7 +6247,7 @@ The function `kill-all-local-variables' runs this before doing anything else. *
doc: /* Hook run when the buffer list changes.
Functions running this hook are `get-buffer-create',
`make-indirect-buffer', `rename-buffer', `kill-buffer',
-`record-buffer' and `unrecord-buffer'. */);
+and `bury-buffer-internal'. */);
Vbuffer_list_update_hook = Qnil;
DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook");
@@ -5998,7 +6259,6 @@ Functions running this hook are `get-buffer-create',
defsubr (&Smake_indirect_buffer);
defsubr (&Sgenerate_new_buffer_name);
defsubr (&Sbuffer_name);
-/*defsubr (&Sbuffer_number);*/
defsubr (&Sbuffer_file_name);
defsubr (&Sbuffer_base_buffer);
defsubr (&Sbuffer_local_value);
@@ -6024,6 +6284,7 @@ Functions running this hook are `get-buffer-create',
defsubr (&Soverlayp);
defsubr (&Smake_overlay);
defsubr (&Sdelete_overlay);
+ defsubr (&Sdelete_all_overlays);
defsubr (&Smove_overlay);
defsubr (&Soverlay_start);
defsubr (&Soverlay_end);
diff --git a/src/buffer.h b/src/buffer.h
index fa65a4b81fd..fbbbf1b8434 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -1,6 +1,6 @@
/* Header file for the buffer manipulation primitives.
-Copyright (C) 1985-1986, 1993-1995, 1997-2011
+Copyright (C) 1985-1986, 1993-1995, 1997-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,6 +19,12 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/types.h> /* for off_t, time_t */
+#include "systime.h" /* for EMACS_TIME */
+
+INLINE_HEADER_BEGIN
+#ifndef BUFFER_INLINE
+# define BUFFER_INLINE INLINE
+#endif
/* Accessing the parameters of the current buffer. */
@@ -187,9 +193,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* FIXME: should we move this into ->text->auto_save_modiff? */
#define BUF_AUTOSAVE_MODIFF(buf) ((buf)->auto_save_modified)
-/* Interval tree of buffer. */
-#define BUF_INTERVALS(buf) ((buf)->text->intervals)
-
/* Marker chain of buffer. */
#define BUF_MARKERS(buf) ((buf)->text->markers)
@@ -245,12 +248,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define BUF_TEMP_SET_PT(buffer, position) \
(temp_set_point ((buffer), (position)))
-extern void set_point (EMACS_INT);
-extern void temp_set_point (struct buffer *, EMACS_INT);
-extern void set_point_both (EMACS_INT, EMACS_INT);
+extern void set_point (ptrdiff_t);
+extern void temp_set_point (struct buffer *, ptrdiff_t);
+extern void set_point_both (ptrdiff_t, ptrdiff_t);
extern void temp_set_point_both (struct buffer *,
- EMACS_INT, EMACS_INT);
-extern void enlarge_buffer_text (struct buffer *, EMACS_INT);
+ ptrdiff_t, ptrdiff_t);
+extern void enlarge_buffer_text (struct buffer *, ptrdiff_t);
/* Macros for setting the BEGV, ZV or PT of a given buffer.
@@ -343,7 +346,8 @@ while (0)
- (ptr - (current_buffer)->text->beg <= GPT_BYTE - BEG_BYTE ? 0 : GAP_SIZE) \
+ BEG_BYTE)
-/* Return character at byte position POS. */
+/* Return character at byte position POS. See the caveat WARNING for
+ FETCH_MULTIBYTE_CHAR below. */
#define FETCH_CHAR(pos) \
(!NILP (BVAR (current_buffer, enable_multibyte_characters)) \
@@ -354,18 +358,6 @@ while (0)
#define FETCH_BYTE(n) *(BYTE_POS_ADDR ((n)))
-/* Variables used locally in FETCH_MULTIBYTE_CHAR. */
-extern unsigned char *_fetch_multibyte_char_p;
-
-/* Return character code of multi-byte form at byte position POS. If POS
- doesn't point the head of valid multi-byte form, only the byte at
- POS is returned. No range checking. */
-
-#define FETCH_MULTIBYTE_CHAR(pos) \
- (_fetch_multibyte_char_p = (((pos) >= GPT_BYTE ? GAP_SIZE : 0) \
- + (pos) + BEG_ADDR - BEG_BYTE), \
- STRING_CHAR (_fetch_multibyte_char_p))
-
/* Return character at byte position POS. If the current buffer is unibyte
and the character is not ASCII, make the returning character
multibyte. */
@@ -414,16 +406,6 @@ extern unsigned char *_fetch_multibyte_char_p;
#define BUF_FETCH_BYTE(buf, n) \
*(BUF_BYTE_ADDRESS ((buf), (n)))
-
-/* Return character code of multi-byte form at byte position POS in BUF.
- If POS doesn't point the head of valid multi-byte form, only the byte at
- POS is returned. No range checking. */
-
-#define BUF_FETCH_MULTIBYTE_CHAR(buf, pos) \
- (_fetch_multibyte_char_p \
- = (((pos) >= BUF_GPT_BYTE (buf) ? BUF_GAP_SIZE (buf) : 0) \
- + (pos) + BUF_BEG_ADDR (buf) - BEG_BYTE), \
- STRING_CHAR (_fetch_multibyte_char_p))
/* Define the actual buffer data structures. */
@@ -438,38 +420,41 @@ struct buffer_text
into a buffer's text to functions that malloc. */
unsigned char *beg;
- EMACS_INT gpt; /* Char pos of gap in buffer. */
- EMACS_INT z; /* Char pos of end of buffer. */
- EMACS_INT gpt_byte; /* Byte pos of gap in buffer. */
- EMACS_INT z_byte; /* Byte pos of end of buffer. */
- EMACS_INT gap_size; /* Size of buffer's gap. */
- int modiff; /* This counts buffer-modification events
+ ptrdiff_t gpt; /* Char pos of gap in buffer. */
+ ptrdiff_t z; /* Char pos of end of buffer. */
+ ptrdiff_t gpt_byte; /* Byte pos of gap in buffer. */
+ ptrdiff_t z_byte; /* Byte pos of end of buffer. */
+ ptrdiff_t gap_size; /* Size of buffer's gap. */
+ EMACS_INT modiff; /* This counts buffer-modification events
for this buffer. It is incremented for
each such event, and never otherwise
changed. */
- int chars_modiff; /* This is modified with character change
+ EMACS_INT chars_modiff; /* This is modified with character change
events for this buffer. It is set to
modiff for each such event, and never
otherwise changed. */
- int save_modiff; /* Previous value of modiff, as of last
+ EMACS_INT save_modiff; /* Previous value of modiff, as of last
time buffer visited or saved a file. */
- int overlay_modiff; /* Counts modifications to overlays. */
+ EMACS_INT overlay_modiff; /* Counts modifications to overlays. */
+
+ EMACS_INT compact; /* Set to modiff each time when compact_buffer
+ is called for this buffer. */
/* Minimum value of GPT - BEG since last redisplay that finished. */
- EMACS_INT beg_unchanged;
+ ptrdiff_t beg_unchanged;
/* Minimum value of Z - GPT since last redisplay that finished. */
- EMACS_INT end_unchanged;
+ ptrdiff_t end_unchanged;
/* MODIFF as of last redisplay that finished; if it matches MODIFF,
beg_unchanged and end_unchanged contain no useful information. */
- int unchanged_modified;
+ EMACS_INT unchanged_modified;
/* BUF_OVERLAY_MODIFF of current buffer, as of last redisplay that
finished; if it matches BUF_OVERLAY_MODIFF, beg_unchanged and
end_unchanged contain no useful information. */
- int overlay_unchanged_modified;
+ EMACS_INT overlay_unchanged_modified;
/* Properties of this buffer's text. */
INTERVAL intervals;
@@ -486,267 +471,164 @@ struct buffer_text
/* Usually 0. Temporarily set to 1 in decode_coding_gap to
prevent Fgarbage_collect from shrinking the gap and losing
not-yet-decoded bytes. */
- int inhibit_shrinking;
+ bool inhibit_shrinking;
};
-/* Lisp fields in struct buffer are hidden from most code and accessed
- via the BVAR macro, below. Only select pieces of code, like the GC,
- are allowed to use BUFFER_INTERNAL_FIELD. */
-#define BUFFER_INTERNAL_FIELD(field) field ## _
+/* Most code should use this macro to access Lisp fields in struct buffer. */
-/* Most code should use this macro to access Lisp fields in struct
- buffer. */
-#define BVAR(buf, field) ((buf)->BUFFER_INTERNAL_FIELD (field))
+#define BVAR(buf, field) ((buf)->INTERNAL_FIELD (field))
/* This is the structure that the buffer Lisp object points to. */
struct buffer
{
- /* Everything before the `name' slot must be of a non-Lisp_Object type,
- and every slot after `name' must be a Lisp_Object.
-
- Check out mark_buffer (alloc.c) to see why. */
-
- /* HEADER.NEXT is the next buffer, in chain of all buffers,
- including killed buffers.
- This chain is used only for garbage collection, in order to
- collect killed buffers properly.
- Note that vectors and most pseudovectors are all on one chain,
- but buffers are on a separate chain of their own. */
struct vectorlike_header header;
- /* This structure holds the coordinates of the buffer contents
- in ordinary buffers. In indirect buffers, this is not used. */
- struct buffer_text own_text;
-
- /* This points to the `struct buffer_text' that used for this buffer.
- In an ordinary buffer, this is the own_text field above.
- In an indirect buffer, this is the own_text field of another buffer. */
- struct buffer_text *text;
-
- /* Char position of point in buffer. */
- EMACS_INT pt;
- /* Byte position of point in buffer. */
- EMACS_INT pt_byte;
- /* Char position of beginning of accessible range. */
- EMACS_INT begv;
- /* Byte position of beginning of accessible range. */
- EMACS_INT begv_byte;
- /* Char position of end of accessible range. */
- EMACS_INT zv;
- /* Byte position of end of accessible range. */
- EMACS_INT zv_byte;
-
- /* In an indirect buffer, this points to the base buffer.
- In an ordinary buffer, it is 0. */
- struct buffer *base_buffer;
-
- /* A non-zero value in slot IDX means that per-buffer variable
- with index IDX has a local value in this buffer. The index IDX
- for a buffer-local variable is stored in that variable's slot
- in buffer_local_flags as a Lisp integer. If the index is -1,
- this means the variable is always local in all buffers. */
-#define MAX_PER_BUFFER_VARS 50
- char local_flags[MAX_PER_BUFFER_VARS];
-
- /* Set to the modtime of the visited file when read or written.
- -1 means visited file was nonexistent.
- 0 means visited file modtime unknown; in no case complain
- about any mismatch on next save attempt. */
- time_t modtime;
- /* Size of the file when modtime was set. This is used to detect the
- case where the file grew while we were reading it, so the modtime
- is still the same (since it's rounded up to seconds) but we're actually
- not up-to-date. -1 means the size is unknown. Only meaningful if
- modtime is actually set. */
- off_t modtime_size;
- /* The value of text->modiff at the last auto-save. */
- int auto_save_modified;
- /* The value of text->modiff at the last display error.
- Redisplay of this buffer is inhibited until it changes again. */
- int display_error_modiff;
- /* The time at which we detected a failure to auto-save,
- Or 0 if we didn't have a failure. */
- time_t auto_save_failure_time;
- /* Position in buffer at which display started
- the last time this buffer was displayed. */
- EMACS_INT last_window_start;
-
- /* Set nonzero whenever the narrowing is changed in this buffer. */
- int clip_changed;
-
- /* If the long line scan cache is enabled (i.e. the buffer-local
- variable cache-long-line-scans is non-nil), newline_cache
- points to the newline cache, and width_run_cache points to the
- width run cache.
-
- The newline cache records which stretches of the buffer are
- known *not* to contain newlines, so that they can be skipped
- quickly when we search for newlines.
-
- The width run cache records which stretches of the buffer are
- known to contain characters whose widths are all the same. If
- the width run cache maps a character to a value > 0, that value is
- the character's width; if it maps a character to zero, we don't
- know what its width is. This allows compute_motion to process
- such regions very quickly, using algebra instead of inspecting
- each character. See also width_table, below. */
- struct region_cache *newline_cache;
- struct region_cache *width_run_cache;
-
- /* Non-zero means don't use redisplay optimizations for
- displaying this buffer. */
- unsigned prevent_redisplay_optimizations_p : 1;
-
- /* List of overlays that end at or before the current center,
- in order of end-position. */
- struct Lisp_Overlay *overlays_before;
+ /* The name of this buffer. */
+ Lisp_Object INTERNAL_FIELD (name);
- /* List of overlays that end after the current center,
- in order of start-position. */
- struct Lisp_Overlay *overlays_after;
+ /* The name of the file visited in this buffer, or nil. */
+ Lisp_Object INTERNAL_FIELD (filename);
- /* Position where the overlay lists are centered. */
- EMACS_INT overlay_center;
-
- /* Everything from here down must be a Lisp_Object. */
- /* buffer-local Lisp variables start at `undo_list',
- tho only the ones from `name' on are GC'd normally. */
- #define FIRST_FIELD_PER_BUFFER undo_list
-
- /* Changes in the buffer are recorded here for undo.
- t means don't record anything.
- This information belongs to the base buffer of an indirect buffer,
- But we can't store it in the struct buffer_text
- because local variables have to be right in the struct buffer.
- So we copy it around in set_buffer_internal.
- This comes before `name' because it is marked in a special way. */
- Lisp_Object BUFFER_INTERNAL_FIELD (undo_list);
+ /* Directory for expanding relative file names. */
+ Lisp_Object INTERNAL_FIELD (directory);
- /* The name of this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (name);
+ /* True if this buffer has been backed up (if you write to the visited
+ file and it hasn't been backed up, then a backup will be made). */
+ Lisp_Object INTERNAL_FIELD (backed_up);
- /* The name of the file visited in this buffer, or nil. */
- Lisp_Object BUFFER_INTERNAL_FIELD (filename);
- /* Dir for expanding relative file names. */
- Lisp_Object BUFFER_INTERNAL_FIELD (directory);
- /* True if this buffer has been backed up (if you write to the
- visited file and it hasn't been backed up, then a backup will
- be made). */
- /* This isn't really used by the C code, so could be deleted. */
- Lisp_Object BUFFER_INTERNAL_FIELD (backed_up);
/* Length of file when last read or saved.
-1 means auto saving turned off because buffer shrank a lot.
-2 means don't turn off auto saving if buffer shrinks.
(That value is used with buffer-swap-text.)
This is not in the struct buffer_text
because it's not used in indirect buffers at all. */
- Lisp_Object BUFFER_INTERNAL_FIELD (save_length);
+ Lisp_Object INTERNAL_FIELD (save_length);
+
/* File name used for auto-saving this buffer.
This is not in the struct buffer_text
because it's not used in indirect buffers at all. */
- Lisp_Object BUFFER_INTERNAL_FIELD (auto_save_file_name);
+ Lisp_Object INTERNAL_FIELD (auto_save_file_name);
/* Non-nil if buffer read-only. */
- Lisp_Object BUFFER_INTERNAL_FIELD (read_only);
+ Lisp_Object INTERNAL_FIELD (read_only);
+
/* "The mark". This is a marker which may
point into this buffer or may point nowhere. */
- Lisp_Object BUFFER_INTERNAL_FIELD (mark);
+ Lisp_Object INTERNAL_FIELD (mark);
/* Alist of elements (SYMBOL . VALUE-IN-THIS-BUFFER) for all
per-buffer variables of this buffer. For locally unbound
symbols, just the symbol appears as the element. */
- Lisp_Object BUFFER_INTERNAL_FIELD (local_var_alist);
+ Lisp_Object INTERNAL_FIELD (local_var_alist);
+
+ /* Symbol naming major mode (e.g., lisp-mode). */
+ Lisp_Object INTERNAL_FIELD (major_mode);
+
+ /* Pretty name of major mode (e.g., "Lisp"). */
+ Lisp_Object INTERNAL_FIELD (mode_name);
- /* Symbol naming major mode (eg, lisp-mode). */
- Lisp_Object BUFFER_INTERNAL_FIELD (major_mode);
- /* Pretty name of major mode (eg, "Lisp"). */
- Lisp_Object BUFFER_INTERNAL_FIELD (mode_name);
/* Mode line element that controls format of mode line. */
- Lisp_Object BUFFER_INTERNAL_FIELD (mode_line_format);
+ Lisp_Object INTERNAL_FIELD (mode_line_format);
/* Analogous to mode_line_format for the line displayed at the top
of windows. Nil means don't display that line. */
- Lisp_Object BUFFER_INTERNAL_FIELD (header_line_format);
+ Lisp_Object INTERNAL_FIELD (header_line_format);
/* Keys that are bound local to this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (keymap);
+ Lisp_Object INTERNAL_FIELD (keymap);
+
/* This buffer's local abbrev table. */
- Lisp_Object BUFFER_INTERNAL_FIELD (abbrev_table);
+ Lisp_Object INTERNAL_FIELD (abbrev_table);
+
/* This buffer's syntax table. */
- Lisp_Object BUFFER_INTERNAL_FIELD (syntax_table);
+ Lisp_Object INTERNAL_FIELD (syntax_table);
+
/* This buffer's category table. */
- Lisp_Object BUFFER_INTERNAL_FIELD (category_table);
+ Lisp_Object INTERNAL_FIELD (category_table);
/* Values of several buffer-local variables. */
/* tab-width is buffer-local so that redisplay can find it
in buffers that are not current. */
- Lisp_Object BUFFER_INTERNAL_FIELD (case_fold_search);
- Lisp_Object BUFFER_INTERNAL_FIELD (tab_width);
- Lisp_Object BUFFER_INTERNAL_FIELD (fill_column);
- Lisp_Object BUFFER_INTERNAL_FIELD (left_margin);
+ Lisp_Object INTERNAL_FIELD (case_fold_search);
+ Lisp_Object INTERNAL_FIELD (tab_width);
+ Lisp_Object INTERNAL_FIELD (fill_column);
+ Lisp_Object INTERNAL_FIELD (left_margin);
+
/* Function to call when insert space past fill column. */
- Lisp_Object BUFFER_INTERNAL_FIELD (auto_fill_function);
+ Lisp_Object INTERNAL_FIELD (auto_fill_function);
/* Case table for case-conversion in this buffer.
This char-table maps each char into its lower-case version. */
- Lisp_Object BUFFER_INTERNAL_FIELD (downcase_table);
+ Lisp_Object INTERNAL_FIELD (downcase_table);
+
/* Char-table mapping each char to its upper-case version. */
- Lisp_Object BUFFER_INTERNAL_FIELD (upcase_table);
+ Lisp_Object INTERNAL_FIELD (upcase_table);
+
/* Char-table for conversion for case-folding search. */
- Lisp_Object BUFFER_INTERNAL_FIELD (case_canon_table);
+ Lisp_Object INTERNAL_FIELD (case_canon_table);
+
/* Char-table of equivalences for case-folding search. */
- Lisp_Object BUFFER_INTERNAL_FIELD (case_eqv_table);
+ Lisp_Object INTERNAL_FIELD (case_eqv_table);
/* Non-nil means do not display continuation lines. */
- Lisp_Object BUFFER_INTERNAL_FIELD (truncate_lines);
+ Lisp_Object INTERNAL_FIELD (truncate_lines);
+
/* Non-nil means to use word wrapping when displaying continuation lines. */
- Lisp_Object BUFFER_INTERNAL_FIELD (word_wrap);
+ Lisp_Object INTERNAL_FIELD (word_wrap);
+
/* Non-nil means display ctl chars with uparrow. */
- Lisp_Object BUFFER_INTERNAL_FIELD (ctl_arrow);
+ Lisp_Object INTERNAL_FIELD (ctl_arrow);
+
/* Non-nil means reorder bidirectional text for display in the
visual order. */
- Lisp_Object BUFFER_INTERNAL_FIELD (bidi_display_reordering);
+ Lisp_Object INTERNAL_FIELD (bidi_display_reordering);
+
/* If non-nil, specifies which direction of text to force in all the
paragraphs of the buffer. Nil means determine paragraph
direction dynamically for each paragraph. */
- Lisp_Object BUFFER_INTERNAL_FIELD (bidi_paragraph_direction);
+ Lisp_Object INTERNAL_FIELD (bidi_paragraph_direction);
+
/* Non-nil means do selective display;
see doc string in syms_of_buffer (buffer.c) for details. */
- Lisp_Object BUFFER_INTERNAL_FIELD (selective_display);
-#ifndef old
+ Lisp_Object INTERNAL_FIELD (selective_display);
+
/* Non-nil means show ... at end of line followed by invisible lines. */
- Lisp_Object BUFFER_INTERNAL_FIELD (selective_display_ellipses);
-#endif
+ Lisp_Object INTERNAL_FIELD (selective_display_ellipses);
+
/* Alist of (FUNCTION . STRING) for each minor mode enabled in buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (minor_modes);
+ Lisp_Object INTERNAL_FIELD (minor_modes);
+
/* t if "self-insertion" should overwrite; `binary' if it should also
overwrite newlines and tabs - for editing executables and the like. */
- Lisp_Object BUFFER_INTERNAL_FIELD (overwrite_mode);
- /* non-nil means abbrev mode is on. Expand abbrevs automatically. */
- Lisp_Object BUFFER_INTERNAL_FIELD (abbrev_mode);
+ Lisp_Object INTERNAL_FIELD (overwrite_mode);
+
+ /* Non-nil means abbrev mode is on. Expand abbrevs automatically. */
+ Lisp_Object INTERNAL_FIELD (abbrev_mode);
+
/* Display table to use for text in this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (display_table);
+ Lisp_Object INTERNAL_FIELD (display_table);
+
/* t means the mark and region are currently active. */
- Lisp_Object BUFFER_INTERNAL_FIELD (mark_active);
+ Lisp_Object INTERNAL_FIELD (mark_active);
/* Non-nil means the buffer contents are regarded as multi-byte
form of characters, not a binary code. */
- Lisp_Object BUFFER_INTERNAL_FIELD (enable_multibyte_characters);
+ Lisp_Object INTERNAL_FIELD (enable_multibyte_characters);
/* Coding system to be used for encoding the buffer contents on
saving. */
- Lisp_Object BUFFER_INTERNAL_FIELD (buffer_file_coding_system);
+ Lisp_Object INTERNAL_FIELD (buffer_file_coding_system);
/* List of symbols naming the file format used for visited file. */
- Lisp_Object BUFFER_INTERNAL_FIELD (file_format);
+ Lisp_Object INTERNAL_FIELD (file_format);
/* List of symbols naming the file format used for auto-save file. */
- Lisp_Object BUFFER_INTERNAL_FIELD (auto_save_file_format);
+ Lisp_Object INTERNAL_FIELD (auto_save_file_format);
/* True if the newline position cache and width run cache are
enabled. See search.c and indent.c. */
- Lisp_Object BUFFER_INTERNAL_FIELD (cache_long_line_scans);
+ Lisp_Object INTERNAL_FIELD (cache_long_line_scans);
/* If the width run cache is enabled, this table contains the
character widths width_run_cache (see above) assumes. When we
@@ -754,105 +636,377 @@ struct buffer
current display table to see whether the display table has
affected the widths of any characters. If it has, we
invalidate the width run cache, and re-initialize width_table. */
- Lisp_Object BUFFER_INTERNAL_FIELD (width_table);
+ Lisp_Object INTERNAL_FIELD (width_table);
/* In an indirect buffer, or a buffer that is the base of an
indirect buffer, this holds a marker that records
PT for this buffer when the buffer is not current. */
- Lisp_Object BUFFER_INTERNAL_FIELD (pt_marker);
+ Lisp_Object INTERNAL_FIELD (pt_marker);
/* In an indirect buffer, or a buffer that is the base of an
indirect buffer, this holds a marker that records
BEGV for this buffer when the buffer is not current. */
- Lisp_Object BUFFER_INTERNAL_FIELD (begv_marker);
+ Lisp_Object INTERNAL_FIELD (begv_marker);
/* In an indirect buffer, or a buffer that is the base of an
indirect buffer, this holds a marker that records
ZV for this buffer when the buffer is not current. */
- Lisp_Object BUFFER_INTERNAL_FIELD (zv_marker);
+ Lisp_Object INTERNAL_FIELD (zv_marker);
/* This holds the point value before the last scroll operation.
Explicitly setting point sets this to nil. */
- Lisp_Object BUFFER_INTERNAL_FIELD (point_before_scroll);
+ Lisp_Object INTERNAL_FIELD (point_before_scroll);
/* Truename of the visited file, or nil. */
- Lisp_Object BUFFER_INTERNAL_FIELD (file_truename);
+ Lisp_Object INTERNAL_FIELD (file_truename);
/* Invisibility spec of this buffer.
t => any non-nil `invisible' property means invisible.
A list => `invisible' property means invisible
if it is memq in that list. */
- Lisp_Object BUFFER_INTERNAL_FIELD (invisibility_spec);
+ Lisp_Object INTERNAL_FIELD (invisibility_spec);
/* This is the last window that was selected with this buffer in it,
or nil if that window no longer displays this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (last_selected_window);
+ Lisp_Object INTERNAL_FIELD (last_selected_window);
/* Incremented each time the buffer is displayed in a window. */
- Lisp_Object BUFFER_INTERNAL_FIELD (display_count);
+ Lisp_Object INTERNAL_FIELD (display_count);
/* Widths of left and right marginal areas for windows displaying
this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (left_margin_cols), BUFFER_INTERNAL_FIELD (right_margin_cols);
+ Lisp_Object INTERNAL_FIELD (left_margin_cols);
+ Lisp_Object INTERNAL_FIELD (right_margin_cols);
/* Widths of left and right fringe areas for windows displaying
this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (left_fringe_width), BUFFER_INTERNAL_FIELD (right_fringe_width);
+ Lisp_Object INTERNAL_FIELD (left_fringe_width);
+ Lisp_Object INTERNAL_FIELD (right_fringe_width);
/* Non-nil means fringes are drawn outside display margins;
othersize draw them between margin areas and text. */
- Lisp_Object BUFFER_INTERNAL_FIELD (fringes_outside_margins);
+ Lisp_Object INTERNAL_FIELD (fringes_outside_margins);
/* Width and type of scroll bar areas for windows displaying
this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (scroll_bar_width), BUFFER_INTERNAL_FIELD (vertical_scroll_bar_type);
+ Lisp_Object INTERNAL_FIELD (scroll_bar_width);
+ Lisp_Object INTERNAL_FIELD (vertical_scroll_bar_type);
/* Non-nil means indicate lines not displaying text (in a style
like vi). */
- Lisp_Object BUFFER_INTERNAL_FIELD (indicate_empty_lines);
+ Lisp_Object INTERNAL_FIELD (indicate_empty_lines);
/* Non-nil means indicate buffer boundaries and scrolling. */
- Lisp_Object BUFFER_INTERNAL_FIELD (indicate_buffer_boundaries);
+ Lisp_Object INTERNAL_FIELD (indicate_buffer_boundaries);
/* Logical to physical fringe bitmap mappings. */
- Lisp_Object BUFFER_INTERNAL_FIELD (fringe_indicator_alist);
+ Lisp_Object INTERNAL_FIELD (fringe_indicator_alist);
/* Logical to physical cursor bitmap mappings. */
- Lisp_Object BUFFER_INTERNAL_FIELD (fringe_cursor_alist);
+ Lisp_Object INTERNAL_FIELD (fringe_cursor_alist);
/* Time stamp updated each time this buffer is displayed in a window. */
- Lisp_Object BUFFER_INTERNAL_FIELD (display_time);
+ Lisp_Object INTERNAL_FIELD (display_time);
/* If scrolling the display because point is below the bottom of a
window showing this buffer, try to choose a window start so
that point ends up this number of lines from the top of the
window. Nil means that scrolling method isn't used. */
- Lisp_Object BUFFER_INTERNAL_FIELD (scroll_up_aggressively);
+ Lisp_Object INTERNAL_FIELD (scroll_up_aggressively);
/* If scrolling the display because point is above the top of a
window showing this buffer, try to choose a window start so
that point ends up this number of lines from the bottom of the
window. Nil means that scrolling method isn't used. */
- Lisp_Object BUFFER_INTERNAL_FIELD (scroll_down_aggressively);
+ Lisp_Object INTERNAL_FIELD (scroll_down_aggressively);
/* Desired cursor type in this buffer. See the doc string of
per-buffer variable `cursor-type'. */
- Lisp_Object BUFFER_INTERNAL_FIELD (cursor_type);
+ Lisp_Object INTERNAL_FIELD (cursor_type);
/* An integer > 0 means put that number of pixels below text lines
in the display of this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (extra_line_spacing);
+ Lisp_Object INTERNAL_FIELD (extra_line_spacing);
- /* *Cursor type to display in non-selected windows.
+ /* Cursor type to display in non-selected windows.
t means to use hollow box cursor.
See `cursor-type' for other values. */
- Lisp_Object BUFFER_INTERNAL_FIELD (cursor_in_non_selected_windows);
+ Lisp_Object INTERNAL_FIELD (cursor_in_non_selected_windows);
+
+ /* No more Lisp_Object beyond this point. Except undo_list,
+ which is handled specially in Fgarbage_collect . */
+
+ /* This structure holds the coordinates of the buffer contents
+ in ordinary buffers. In indirect buffers, this is not used. */
+ struct buffer_text own_text;
+
+ /* This points to the `struct buffer_text' that used for this buffer.
+ In an ordinary buffer, this is the own_text field above.
+ In an indirect buffer, this is the own_text field of another buffer. */
+ struct buffer_text *text;
+
+ /* Next buffer, in chain of all buffers, including killed ones. */
+ struct buffer *next;
+
+ /* Char position of point in buffer. */
+ ptrdiff_t pt;
+
+ /* Byte position of point in buffer. */
+ ptrdiff_t pt_byte;
+
+ /* Char position of beginning of accessible range. */
+ ptrdiff_t begv;
+
+ /* Byte position of beginning of accessible range. */
+ ptrdiff_t begv_byte;
+
+ /* Char position of end of accessible range. */
+ ptrdiff_t zv;
+
+ /* Byte position of end of accessible range. */
+ ptrdiff_t zv_byte;
+
+ /* In an indirect buffer, this points to the base buffer.
+ In an ordinary buffer, it is 0. */
+ struct buffer *base_buffer;
+
+ /* In an indirect buffer, this is -1. In an ordinary buffer,
+ it's the number of indirect buffers that share our text;
+ zero means that we're the only owner of this text. */
+ int indirections;
+
+ /* A non-zero value in slot IDX means that per-buffer variable
+ with index IDX has a local value in this buffer. The index IDX
+ for a buffer-local variable is stored in that variable's slot
+ in buffer_local_flags as a Lisp integer. If the index is -1,
+ this means the variable is always local in all buffers. */
+#define MAX_PER_BUFFER_VARS 50
+ char local_flags[MAX_PER_BUFFER_VARS];
+
+ /* Set to the modtime of the visited file when read or written.
+ EMACS_NSECS (modtime) == NONEXISTENT_MODTIME_NSECS means
+ visited file was nonexistent. EMACS_NSECS (modtime) ==
+ UNKNOWN_MODTIME_NSECS means visited file modtime unknown;
+ in no case complain about any mismatch on next save attempt. */
+#define NONEXISTENT_MODTIME_NSECS (-1)
+#define UNKNOWN_MODTIME_NSECS (-2)
+ EMACS_TIME modtime;
+
+ /* Size of the file when modtime was set. This is used to detect the
+ case where the file grew while we were reading it, so the modtime
+ is still the same (since it's rounded up to seconds) but we're actually
+ not up-to-date. -1 means the size is unknown. Only meaningful if
+ modtime is actually set. */
+ off_t modtime_size;
+
+ /* The value of text->modiff at the last auto-save. */
+ EMACS_INT auto_save_modified;
+
+ /* The value of text->modiff at the last display error.
+ Redisplay of this buffer is inhibited until it changes again. */
+ EMACS_INT display_error_modiff;
+
+ /* The time at which we detected a failure to auto-save,
+ Or 0 if we didn't have a failure. */
+ time_t auto_save_failure_time;
+
+ /* Position in buffer at which display started
+ the last time this buffer was displayed. */
+ ptrdiff_t last_window_start;
+
+ /* If the long line scan cache is enabled (i.e. the buffer-local
+ variable cache-long-line-scans is non-nil), newline_cache
+ points to the newline cache, and width_run_cache points to the
+ width run cache.
+
+ The newline cache records which stretches of the buffer are
+ known *not* to contain newlines, so that they can be skipped
+ quickly when we search for newlines.
+
+ The width run cache records which stretches of the buffer are
+ known to contain characters whose widths are all the same. If
+ the width run cache maps a character to a value > 0, that value is
+ the character's width; if it maps a character to zero, we don't
+ know what its width is. This allows compute_motion to process
+ such regions very quickly, using algebra instead of inspecting
+ each character. See also width_table, below. */
+ struct region_cache *newline_cache;
+ struct region_cache *width_run_cache;
+
+ /* Non-zero means don't use redisplay optimizations for
+ displaying this buffer. */
+ unsigned prevent_redisplay_optimizations_p : 1;
+
+ /* Non-zero whenever the narrowing is changed in this buffer. */
+ unsigned clip_changed : 1;
+
+ /* List of overlays that end at or before the current center,
+ in order of end-position. */
+ struct Lisp_Overlay *overlays_before;
+
+ /* List of overlays that end after the current center,
+ in order of start-position. */
+ struct Lisp_Overlay *overlays_after;
- /* This must be the last field in the above list. */
- #define LAST_FIELD_PER_BUFFER cursor_in_non_selected_windows
+ /* Position where the overlay lists are centered. */
+ ptrdiff_t overlay_center;
+
+ /* Changes in the buffer are recorded here for undo, and t means
+ don't record anything. This information belongs to the base
+ buffer of an indirect buffer. But we can't store it in the
+ struct buffer_text because local variables have to be right in
+ the struct buffer. So we copy it around in set_buffer_internal. */
+ Lisp_Object INTERNAL_FIELD (undo_list);
};
-
+/* Most code should use these functions to set Lisp fields in struct
+ buffer. */
+BUFFER_INLINE void
+bset_bidi_paragraph_direction (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (bidi_paragraph_direction) = val;
+}
+BUFFER_INLINE void
+bset_case_canon_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (case_canon_table) = val;
+}
+BUFFER_INLINE void
+bset_case_eqv_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (case_eqv_table) = val;
+}
+BUFFER_INLINE void
+bset_directory (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (directory) = val;
+}
+BUFFER_INLINE void
+bset_display_count (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (display_count) = val;
+}
+BUFFER_INLINE void
+bset_display_time (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (display_time) = val;
+}
+BUFFER_INLINE void
+bset_downcase_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (downcase_table) = val;
+}
+BUFFER_INLINE void
+bset_enable_multibyte_characters (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (enable_multibyte_characters) = val;
+}
+BUFFER_INLINE void
+bset_filename (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (filename) = val;
+}
+BUFFER_INLINE void
+bset_keymap (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (keymap) = val;
+}
+BUFFER_INLINE void
+bset_last_selected_window (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (last_selected_window) = val;
+}
+BUFFER_INLINE void
+bset_local_var_alist (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (local_var_alist) = val;
+}
+BUFFER_INLINE void
+bset_mark_active (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (mark_active) = val;
+}
+BUFFER_INLINE void
+bset_point_before_scroll (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (point_before_scroll) = val;
+}
+BUFFER_INLINE void
+bset_read_only (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (read_only) = val;
+}
+BUFFER_INLINE void
+bset_truncate_lines (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (truncate_lines) = val;
+}
+BUFFER_INLINE void
+bset_undo_list (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (undo_list) = val;
+}
+BUFFER_INLINE void
+bset_upcase_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (upcase_table) = val;
+}
+BUFFER_INLINE void
+bset_width_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (width_table) = val;
+}
+
+/* Number of Lisp_Objects at the beginning of struct buffer.
+ If you add, remove, or reorder Lisp_Objects within buffer
+ structure, make sure that this is still correct. */
+
+#define BUFFER_LISP_SIZE \
+ ((offsetof (struct buffer, own_text) - header_size) / word_size)
+
+/* Size of the struct buffer part beyond leading Lisp_Objects, in word_size
+ units. Rounding is needed for --with-wide-int configuration. */
+
+#define BUFFER_REST_SIZE \
+ ((((sizeof (struct buffer) - offsetof (struct buffer, own_text)) \
+ + (word_size - 1)) & ~(word_size - 1)) / word_size)
+
+/* Initialize the pseudovector header of buffer object. BUFFER_LISP_SIZE
+ is required for GC, but BUFFER_REST_SIZE is set up just to be consistent
+ with other pseudovectors. */
+
+#define BUFFER_PVEC_INIT(b) \
+ XSETPVECTYPESIZE (b, PVEC_BUFFER, BUFFER_LISP_SIZE, BUFFER_REST_SIZE)
+
+/* Convenient check whether buffer B is live. */
+
+#define BUFFER_LIVE_P(b) (!NILP (BVAR (b, name)))
+
+/* Verify indirection counters. */
+
+#define BUFFER_CHECK_INDIRECTION(b) \
+ do { \
+ if (BUFFER_LIVE_P (b)) \
+ { \
+ if (b->base_buffer) \
+ { \
+ eassert (b->indirections == -1); \
+ eassert (b->base_buffer->indirections > 0); \
+ } \
+ else \
+ eassert (b->indirections >= 0); \
+ } \
+ } while (0)
+
+/* Chain of all buffers, including killed ones. */
+
+extern struct buffer *all_buffers;
+
+/* Used to iterate over the chain above. */
+
+#define FOR_EACH_BUFFER(b) \
+ for ((b) = all_buffers; (b); (b) = (b)->next)
+
/* This points to the current buffer. */
extern struct buffer *current_buffer;
@@ -890,21 +1044,46 @@ extern struct buffer buffer_local_symbols;
extern void delete_all_overlays (struct buffer *);
extern void reset_buffer (struct buffer *);
-extern void evaporate_overlays (EMACS_INT);
-extern ptrdiff_t overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr,
- ptrdiff_t *len_ptr, EMACS_INT *next_ptr,
- EMACS_INT *prev_ptr, int change_req);
+extern void compact_buffer (struct buffer *);
+extern void evaporate_overlays (ptrdiff_t);
+extern ptrdiff_t overlays_at (EMACS_INT, bool, Lisp_Object **,
+ ptrdiff_t *, ptrdiff_t *, ptrdiff_t *, bool);
extern ptrdiff_t sort_overlays (Lisp_Object *, ptrdiff_t, struct window *);
-extern void recenter_overlay_lists (struct buffer *, EMACS_INT);
-extern EMACS_INT overlay_strings (EMACS_INT, struct window *, unsigned char **);
+extern void recenter_overlay_lists (struct buffer *, ptrdiff_t);
+extern ptrdiff_t overlay_strings (ptrdiff_t, struct window *, unsigned char **);
extern void validate_region (Lisp_Object *, Lisp_Object *);
-extern void set_buffer_internal (struct buffer *);
extern void set_buffer_internal_1 (struct buffer *);
extern void set_buffer_temp (struct buffer *);
+extern Lisp_Object buffer_local_value_1 (Lisp_Object, Lisp_Object);
extern void record_buffer (Lisp_Object);
-extern void buffer_slot_type_mismatch (Lisp_Object, int) NO_RETURN;
-extern void fix_overlays_before (struct buffer *, EMACS_INT, EMACS_INT);
-extern void mmap_set_vars (int);
+extern _Noreturn void buffer_slot_type_mismatch (Lisp_Object, int);
+extern void fix_overlays_before (struct buffer *, ptrdiff_t, ptrdiff_t);
+extern void mmap_set_vars (bool);
+
+/* Set the current buffer to B.
+
+ We previously set windows_or_buffers_changed here to invalidate
+ global unchanged information in beg_unchanged and end_unchanged.
+ This is no longer necessary because we now compute unchanged
+ information on a buffer-basis. Every action affecting other
+ windows than the selected one requires a select_window at some
+ time, and that increments windows_or_buffers_changed. */
+
+BUFFER_INLINE void
+set_buffer_internal (struct buffer *b)
+{
+ if (current_buffer != b)
+ set_buffer_internal_1 (b);
+}
+
+/* Arrange to go back to the original buffer after the next
+ call to unbind_to if the original buffer is still alive. */
+
+BUFFER_INLINE void
+record_unwind_current_buffer (void)
+{
+ record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+}
/* Get overlays at POSN into array OVERLAYS with NOVERLAYS elements.
If NEXTP is non-NULL, return next overlay there.
@@ -912,52 +1091,103 @@ extern void mmap_set_vars (int);
#define GET_OVERLAYS_AT(posn, overlays, noverlays, nextp, chrq) \
do { \
- ptrdiff_t maxlen = 40; \
- overlays = (Lisp_Object *) alloca (maxlen * sizeof (Lisp_Object)); \
+ ptrdiff_t maxlen = 40; \
+ overlays = alloca (maxlen * sizeof *overlays); \
noverlays = overlays_at (posn, 0, &overlays, &maxlen, \
- nextp, NULL, chrq); \
+ nextp, NULL, chrq); \
if (noverlays > maxlen) \
{ \
maxlen = noverlays; \
- overlays = (Lisp_Object *) alloca (maxlen * sizeof (Lisp_Object)); \
+ overlays = alloca (maxlen * sizeof *overlays); \
noverlays = overlays_at (posn, 0, &overlays, &maxlen, \
nextp, NULL, chrq); \
} \
} while (0)
-EXFUN (Fbuffer_live_p, 1);
-EXFUN (Fbuffer_name, 1);
-EXFUN (Fnext_overlay_change, 1);
-EXFUN (Fbuffer_local_value, 2);
-
extern Lisp_Object Qbefore_change_functions;
extern Lisp_Object Qafter_change_functions;
extern Lisp_Object Qfirst_change_hook;
-
-/* Overlays */
+/* Get text properties of B. */
-/* 1 if the OV is an overlay object. */
+BUFFER_INLINE INTERVAL
+buffer_intervals (struct buffer *b)
+{
+ eassert (b->text != NULL);
+ return b->text->intervals;
+}
+
+/* Set text properties of B to I. */
+
+BUFFER_INLINE void
+set_buffer_intervals (struct buffer *b, INTERVAL i)
+{
+ eassert (b->text != NULL);
+ b->text->intervals = i;
+}
+
+/* Non-zero if current buffer has overlays. */
+
+BUFFER_INLINE bool
+buffer_has_overlays (void)
+{
+ return current_buffer->overlays_before || current_buffer->overlays_after;
+}
+
+/* Return character code of multi-byte form at byte position POS. If POS
+ doesn't point the head of valid multi-byte form, only the byte at
+ POS is returned. No range checking.
+
+ WARNING: The character returned by this macro could be "unified"
+ inside STRING_CHAR, if the original character in the buffer belongs
+ to one of the Private Use Areas (PUAs) of codepoints that Emacs
+ uses to support non-unified CJK characters. If that happens,
+ CHAR_BYTES will return a value that is different from the length of
+ the original multibyte sequence stored in the buffer. Therefore,
+ do _not_ use FETCH_MULTIBYTE_CHAR if you need to advance through
+ the buffer to the next character after fetching this one. Instead,
+ use either FETCH_CHAR_ADVANCE or STRING_CHAR_AND_LENGTH. */
+
+BUFFER_INLINE int
+FETCH_MULTIBYTE_CHAR (ptrdiff_t pos)
+{
+ unsigned char *p = ((pos >= GPT_BYTE ? GAP_SIZE : 0)
+ + pos + BEG_ADDR - BEG_BYTE);
+ return STRING_CHAR (p);
+}
-#define OVERLAY_VALID(OV) (OVERLAYP (OV))
+/* Return character code of multi-byte form at byte position POS in BUF.
+ If POS doesn't point the head of valid multi-byte form, only the byte at
+ POS is returned. No range checking. */
+
+BUFFER_INLINE int
+BUF_FETCH_MULTIBYTE_CHAR (struct buffer *buf, ptrdiff_t pos)
+{
+ unsigned char *p
+ = ((pos >= BUF_GPT_BYTE (buf) ? BUF_GAP_SIZE (buf) : 0)
+ + pos + BUF_BEG_ADDR (buf) - BEG_BYTE);
+ return STRING_CHAR (p);
+}
+
+/* Overlays */
/* Return the marker that stands for where OV starts in the buffer. */
-#define OVERLAY_START(OV) (XOVERLAY (OV)->start)
+#define OVERLAY_START(OV) XOVERLAY (OV)->start
/* Return the marker that stands for where OV ends in the buffer. */
-#define OVERLAY_END(OV) (XOVERLAY (OV)->end)
+#define OVERLAY_END(OV) XOVERLAY (OV)->end
/* Return the plist of overlay OV. */
-#define OVERLAY_PLIST(OV) XOVERLAY ((OV))->plist
+#define OVERLAY_PLIST(OV) XOVERLAY (OV)->plist
/* Return the actual buffer position for the marker P.
We assume you know which buffer it's pointing into. */
#define OVERLAY_POSITION(P) \
- (MARKERP (P) ? marker_position (P) : (abort (), 0))
+ (MARKERP (P) ? marker_position (P) : (emacs_abort (), 0))
/***********************************************************************
@@ -972,7 +1202,16 @@ extern int last_per_buffer_idx;
from the start of a buffer structure. */
#define PER_BUFFER_VAR_OFFSET(VAR) \
- offsetof (struct buffer, BUFFER_INTERNAL_FIELD (VAR))
+ offsetof (struct buffer, INTERNAL_FIELD (VAR))
+
+/* Used to iterate over normal Lisp_Object fields of struct buffer (all
+ Lisp_Objects except undo_list). If you add, remove, or reorder
+ Lisp_Objects in a struct buffer, make sure that this is still correct. */
+
+#define FOR_EACH_PER_BUFFER_OBJECT_AT(offset) \
+ for (offset = PER_BUFFER_VAR_OFFSET (name); \
+ offset <= PER_BUFFER_VAR_OFFSET (cursor_in_non_selected_windows); \
+ offset += word_size)
/* Return the index of buffer-local variable VAR. Each per-buffer
variable has an index > 0 associated with it, except when it always
@@ -988,7 +1227,7 @@ extern int last_per_buffer_idx;
#define PER_BUFFER_VALUE_P(B, IDX) \
(((IDX) < 0 || IDX >= last_per_buffer_idx) \
- ? (abort (), 0) \
+ ? (emacs_abort (), 0) \
: ((B)->local_flags[IDX] != 0))
/* Set whether per-buffer variable with index IDX has a buffer-local
@@ -997,7 +1236,7 @@ extern int last_per_buffer_idx;
#define SET_PER_BUFFER_VALUE_P(B, IDX, VAL) \
do { \
if ((IDX) < 0 || (IDX) >= last_per_buffer_idx) \
- abort (); \
+ emacs_abort (); \
(B)->local_flags[IDX] = (VAL); \
} while (0)
@@ -1025,20 +1264,38 @@ extern int last_per_buffer_idx;
#define PER_BUFFER_IDX(OFFSET) \
XINT (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_flags))
-/* Return the default value of the per-buffer variable at offset
- OFFSET in the buffer structure. */
+/* Functions to get and set default value of the per-buffer
+ variable at offset OFFSET in the buffer structure. */
+
+BUFFER_INLINE Lisp_Object
+per_buffer_default (int offset)
+{
+ return *(Lisp_Object *)(offset + (char *) &buffer_defaults);
+}
-#define PER_BUFFER_DEFAULT(OFFSET) \
- (*(Lisp_Object *)((OFFSET) + (char *) &buffer_defaults))
+BUFFER_INLINE void
+set_per_buffer_default (int offset, Lisp_Object value)
+{
+ *(Lisp_Object *)(offset + (char *) &buffer_defaults) = value;
+}
-/* Return the buffer-local value of the per-buffer variable at offset
- OFFSET in the buffer structure. */
+/* Functions to get and set buffer-local value of the per-buffer
+ variable at offset OFFSET in the buffer structure. */
+
+BUFFER_INLINE Lisp_Object
+per_buffer_value (struct buffer *b, int offset)
+{
+ return *(Lisp_Object *)(offset + (char *) b);
+}
+
+BUFFER_INLINE void
+set_per_buffer_value (struct buffer *b, int offset, Lisp_Object value)
+{
+ *(Lisp_Object *)(offset + (char *) b) = value;
+}
-#define PER_BUFFER_VALUE(BUFFER, OFFSET) \
- (*(Lisp_Object *)((OFFSET) + (char *) (BUFFER)))
-
/* Downcase a character C, or make no change if that cannot be done. */
-static inline int
+BUFFER_INLINE int
downcase (int c)
{
Lisp_Object downcase_table = BVAR (current_buffer, downcase_table);
@@ -1047,10 +1304,10 @@ downcase (int c)
}
/* 1 if C is upper case. */
-static inline int uppercasep (int c) { return downcase (c) != c; }
+BUFFER_INLINE bool uppercasep (int c) { return downcase (c) != c; }
/* Upcase a character C known to be not upper case. */
-static inline int
+BUFFER_INLINE int
upcase1 (int c)
{
Lisp_Object upcase_table = BVAR (current_buffer, upcase_table);
@@ -1059,8 +1316,13 @@ upcase1 (int c)
}
/* 1 if C is lower case. */
-static inline int lowercasep (int c)
-{ return !uppercasep (c) && upcase1 (c) != c; }
+BUFFER_INLINE bool
+lowercasep (int c)
+{
+ return !uppercasep (c) && upcase1 (c) != c;
+}
/* Upcase a character C, or make no change if that cannot be done. */
-static inline int upcase (int c) { return uppercasep (c) ? c : upcase1 (c); }
+BUFFER_INLINE int upcase (int c) { return uppercasep (c) ? c : upcase1 (c); }
+
+INLINE_HEADER_END
diff --git a/src/bytecode.c b/src/bytecode.c
index 3af0abd63cf..3267c7c8c76 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1,5 +1,5 @@
/* Execution of byte code produced by bytecomp.el.
- Copyright (C) 1985-1988, 1993, 2000-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1988, 1993, 2000-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -33,10 +33,10 @@ by Hallvard:
*/
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "syntax.h"
#include "window.h"
@@ -54,25 +54,33 @@ by Hallvard:
/* #define BYTE_CODE_SAFE */
/* #define BYTE_CODE_METER */
+/* If BYTE_CODE_THREADED is defined, then the interpreter will be
+ indirect threaded, using GCC's computed goto extension. This code,
+ as currently implemented, is incompatible with BYTE_CODE_SAFE and
+ BYTE_CODE_METER. */
+#if defined (__GNUC__) && !defined (BYTE_CODE_SAFE) && !defined (BYTE_CODE_METER)
+#define BYTE_CODE_THREADED
+#endif
+
#ifdef BYTE_CODE_METER
Lisp_Object Qbyte_code_meter;
-#define METER_2(code1, code2) \
- XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \
- ->contents[(code2)])
-
-#define METER_1(code) METER_2 (0, (code))
+#define METER_2(code1, code2) AREF (AREF (Vbyte_code_meter, code1), code2)
+#define METER_1(code) METER_2 (0, code)
#define METER_CODE(last_code, this_code) \
{ \
if (byte_metering_on) \
{ \
- if (METER_1 (this_code) < MOST_POSITIVE_FIXNUM) \
- METER_1 (this_code)++; \
+ if (XFASTINT (METER_1 (this_code)) < MOST_POSITIVE_FIXNUM) \
+ XSETFASTINT (METER_1 (this_code), \
+ XFASTINT (METER_1 (this_code)) + 1); \
if (last_code \
- && METER_2 (last_code, this_code) < MOST_POSITIVE_FIXNUM) \
- METER_2 (last_code, this_code)++; \
+ && (XFASTINT (METER_2 (last_code, this_code)) \
+ < MOST_POSITIVE_FIXNUM)) \
+ XSETFASTINT (METER_2 (last_code, this_code), \
+ XFASTINT (METER_2 (last_code, this_code)) + 1); \
} \
}
@@ -83,158 +91,204 @@ Lisp_Object Qbytecode;
/* Byte codes: */
-#define Bstack_ref 0 /* Actually, Bstack_ref+0 is not implemented: use dup. */
-#define Bvarref 010
-#define Bvarset 020
-#define Bvarbind 030
-#define Bcall 040
-#define Bunbind 050
-
-#define Bnth 070
-#define Bsymbolp 071
-#define Bconsp 072
-#define Bstringp 073
-#define Blistp 074
-#define Beq 075
-#define Bmemq 076
-#define Bnot 077
-#define Bcar 0100
-#define Bcdr 0101
-#define Bcons 0102
-#define Blist1 0103
-#define Blist2 0104
-#define Blist3 0105
-#define Blist4 0106
-#define Blength 0107
-#define Baref 0110
-#define Baset 0111
-#define Bsymbol_value 0112
-#define Bsymbol_function 0113
-#define Bset 0114
-#define Bfset 0115
-#define Bget 0116
-#define Bsubstring 0117
-#define Bconcat2 0120
-#define Bconcat3 0121
-#define Bconcat4 0122
-#define Bsub1 0123
-#define Badd1 0124
-#define Beqlsign 0125
-#define Bgtr 0126
-#define Blss 0127
-#define Bleq 0130
-#define Bgeq 0131
-#define Bdiff 0132
-#define Bnegate 0133
-#define Bplus 0134
-#define Bmax 0135
-#define Bmin 0136
-#define Bmult 0137
-
-#define Bpoint 0140
-/* Was Bmark in v17. */
-#define Bsave_current_buffer 0141 /* Obsolete. */
-#define Bgoto_char 0142
-#define Binsert 0143
-#define Bpoint_max 0144
-#define Bpoint_min 0145
-#define Bchar_after 0146
-#define Bfollowing_char 0147
-#define Bpreceding_char 0150
-#define Bcurrent_column 0151
-#define Bindent_to 0152
-#ifdef BYTE_CODE_SAFE
-#define Bscan_buffer 0153 /* No longer generated as of v18. */
-#endif
-#define Beolp 0154
-#define Beobp 0155
-#define Bbolp 0156
-#define Bbobp 0157
-#define Bcurrent_buffer 0160
-#define Bset_buffer 0161
-#define Bsave_current_buffer_1 0162 /* Replacing Bsave_current_buffer. */
-#if 0
-#define Bread_char 0162 /* No longer generated as of v19 */
-#endif
+#define BYTE_CODES \
+DEFINE (Bstack_ref, 0) /* Actually, Bstack_ref+0 is not implemented: use dup. */ \
+DEFINE (Bstack_ref1, 1) \
+DEFINE (Bstack_ref2, 2) \
+DEFINE (Bstack_ref3, 3) \
+DEFINE (Bstack_ref4, 4) \
+DEFINE (Bstack_ref5, 5) \
+DEFINE (Bstack_ref6, 6) \
+DEFINE (Bstack_ref7, 7) \
+DEFINE (Bvarref, 010) \
+DEFINE (Bvarref1, 011) \
+DEFINE (Bvarref2, 012) \
+DEFINE (Bvarref3, 013) \
+DEFINE (Bvarref4, 014) \
+DEFINE (Bvarref5, 015) \
+DEFINE (Bvarref6, 016) \
+DEFINE (Bvarref7, 017) \
+DEFINE (Bvarset, 020) \
+DEFINE (Bvarset1, 021) \
+DEFINE (Bvarset2, 022) \
+DEFINE (Bvarset3, 023) \
+DEFINE (Bvarset4, 024) \
+DEFINE (Bvarset5, 025) \
+DEFINE (Bvarset6, 026) \
+DEFINE (Bvarset7, 027) \
+DEFINE (Bvarbind, 030) \
+DEFINE (Bvarbind1, 031) \
+DEFINE (Bvarbind2, 032) \
+DEFINE (Bvarbind3, 033) \
+DEFINE (Bvarbind4, 034) \
+DEFINE (Bvarbind5, 035) \
+DEFINE (Bvarbind6, 036) \
+DEFINE (Bvarbind7, 037) \
+DEFINE (Bcall, 040) \
+DEFINE (Bcall1, 041) \
+DEFINE (Bcall2, 042) \
+DEFINE (Bcall3, 043) \
+DEFINE (Bcall4, 044) \
+DEFINE (Bcall5, 045) \
+DEFINE (Bcall6, 046) \
+DEFINE (Bcall7, 047) \
+DEFINE (Bunbind, 050) \
+DEFINE (Bunbind1, 051) \
+DEFINE (Bunbind2, 052) \
+DEFINE (Bunbind3, 053) \
+DEFINE (Bunbind4, 054) \
+DEFINE (Bunbind5, 055) \
+DEFINE (Bunbind6, 056) \
+DEFINE (Bunbind7, 057) \
+ \
+DEFINE (Bnth, 070) \
+DEFINE (Bsymbolp, 071) \
+DEFINE (Bconsp, 072) \
+DEFINE (Bstringp, 073) \
+DEFINE (Blistp, 074) \
+DEFINE (Beq, 075) \
+DEFINE (Bmemq, 076) \
+DEFINE (Bnot, 077) \
+DEFINE (Bcar, 0100) \
+DEFINE (Bcdr, 0101) \
+DEFINE (Bcons, 0102) \
+DEFINE (Blist1, 0103) \
+DEFINE (Blist2, 0104) \
+DEFINE (Blist3, 0105) \
+DEFINE (Blist4, 0106) \
+DEFINE (Blength, 0107) \
+DEFINE (Baref, 0110) \
+DEFINE (Baset, 0111) \
+DEFINE (Bsymbol_value, 0112) \
+DEFINE (Bsymbol_function, 0113) \
+DEFINE (Bset, 0114) \
+DEFINE (Bfset, 0115) \
+DEFINE (Bget, 0116) \
+DEFINE (Bsubstring, 0117) \
+DEFINE (Bconcat2, 0120) \
+DEFINE (Bconcat3, 0121) \
+DEFINE (Bconcat4, 0122) \
+DEFINE (Bsub1, 0123) \
+DEFINE (Badd1, 0124) \
+DEFINE (Beqlsign, 0125) \
+DEFINE (Bgtr, 0126) \
+DEFINE (Blss, 0127) \
+DEFINE (Bleq, 0130) \
+DEFINE (Bgeq, 0131) \
+DEFINE (Bdiff, 0132) \
+DEFINE (Bnegate, 0133) \
+DEFINE (Bplus, 0134) \
+DEFINE (Bmax, 0135) \
+DEFINE (Bmin, 0136) \
+DEFINE (Bmult, 0137) \
+ \
+DEFINE (Bpoint, 0140) \
+/* Was Bmark in v17. */ \
+DEFINE (Bsave_current_buffer, 0141) /* Obsolete. */ \
+DEFINE (Bgoto_char, 0142) \
+DEFINE (Binsert, 0143) \
+DEFINE (Bpoint_max, 0144) \
+DEFINE (Bpoint_min, 0145) \
+DEFINE (Bchar_after, 0146) \
+DEFINE (Bfollowing_char, 0147) \
+DEFINE (Bpreceding_char, 0150) \
+DEFINE (Bcurrent_column, 0151) \
+DEFINE (Bindent_to, 0152) \
+DEFINE (Beolp, 0154) \
+DEFINE (Beobp, 0155) \
+DEFINE (Bbolp, 0156) \
+DEFINE (Bbobp, 0157) \
+DEFINE (Bcurrent_buffer, 0160) \
+DEFINE (Bset_buffer, 0161) \
+DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer. */ \
+DEFINE (Binteractive_p, 0164) /* Obsolete since Emacs-24.1. */ \
+ \
+DEFINE (Bforward_char, 0165) \
+DEFINE (Bforward_word, 0166) \
+DEFINE (Bskip_chars_forward, 0167) \
+DEFINE (Bskip_chars_backward, 0170) \
+DEFINE (Bforward_line, 0171) \
+DEFINE (Bchar_syntax, 0172) \
+DEFINE (Bbuffer_substring, 0173) \
+DEFINE (Bdelete_region, 0174) \
+DEFINE (Bnarrow_to_region, 0175) \
+DEFINE (Bwiden, 0176) \
+DEFINE (Bend_of_line, 0177) \
+ \
+DEFINE (Bconstant2, 0201) \
+DEFINE (Bgoto, 0202) \
+DEFINE (Bgotoifnil, 0203) \
+DEFINE (Bgotoifnonnil, 0204) \
+DEFINE (Bgotoifnilelsepop, 0205) \
+DEFINE (Bgotoifnonnilelsepop, 0206) \
+DEFINE (Breturn, 0207) \
+DEFINE (Bdiscard, 0210) \
+DEFINE (Bdup, 0211) \
+ \
+DEFINE (Bsave_excursion, 0212) \
+DEFINE (Bsave_window_excursion, 0213) /* Obsolete since Emacs-24.1. */ \
+DEFINE (Bsave_restriction, 0214) \
+DEFINE (Bcatch, 0215) \
+ \
+DEFINE (Bunwind_protect, 0216) \
+DEFINE (Bcondition_case, 0217) \
+DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \
+DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \
+ \
+DEFINE (Bunbind_all, 0222) /* Obsolete. Never used. */ \
+ \
+DEFINE (Bset_marker, 0223) \
+DEFINE (Bmatch_beginning, 0224) \
+DEFINE (Bmatch_end, 0225) \
+DEFINE (Bupcase, 0226) \
+DEFINE (Bdowncase, 0227) \
+ \
+DEFINE (Bstringeqlsign, 0230) \
+DEFINE (Bstringlss, 0231) \
+DEFINE (Bequal, 0232) \
+DEFINE (Bnthcdr, 0233) \
+DEFINE (Belt, 0234) \
+DEFINE (Bmember, 0235) \
+DEFINE (Bassq, 0236) \
+DEFINE (Bnreverse, 0237) \
+DEFINE (Bsetcar, 0240) \
+DEFINE (Bsetcdr, 0241) \
+DEFINE (Bcar_safe, 0242) \
+DEFINE (Bcdr_safe, 0243) \
+DEFINE (Bnconc, 0244) \
+DEFINE (Bquo, 0245) \
+DEFINE (Brem, 0246) \
+DEFINE (Bnumberp, 0247) \
+DEFINE (Bintegerp, 0250) \
+ \
+DEFINE (BRgoto, 0252) \
+DEFINE (BRgotoifnil, 0253) \
+DEFINE (BRgotoifnonnil, 0254) \
+DEFINE (BRgotoifnilelsepop, 0255) \
+DEFINE (BRgotoifnonnilelsepop, 0256) \
+ \
+DEFINE (BlistN, 0257) \
+DEFINE (BconcatN, 0260) \
+DEFINE (BinsertN, 0261) \
+ \
+/* Bstack_ref is code 0. */ \
+DEFINE (Bstack_set, 0262) \
+DEFINE (Bstack_set2, 0263) \
+DEFINE (BdiscardN, 0266) \
+ \
+DEFINE (Bconstant, 0300)
+
+enum byte_code_op
+{
+#define DEFINE(name, value) name = value,
+ BYTE_CODES
+#undef DEFINE
+
#ifdef BYTE_CODE_SAFE
-#define Bset_mark 0163 /* this loser is no longer generated as of v18 */
+ Bscan_buffer = 0153, /* No longer generated as of v18. */
+ Bset_mark = 0163 /* this loser is no longer generated as of v18 */
#endif
-#define Binteractive_p 0164 /* Obsolete since Emacs-24.1. */
-
-#define Bforward_char 0165
-#define Bforward_word 0166
-#define Bskip_chars_forward 0167
-#define Bskip_chars_backward 0170
-#define Bforward_line 0171
-#define Bchar_syntax 0172
-#define Bbuffer_substring 0173
-#define Bdelete_region 0174
-#define Bnarrow_to_region 0175
-#define Bwiden 0176
-#define Bend_of_line 0177
-
-#define Bconstant2 0201
-#define Bgoto 0202
-#define Bgotoifnil 0203
-#define Bgotoifnonnil 0204
-#define Bgotoifnilelsepop 0205
-#define Bgotoifnonnilelsepop 0206
-#define Breturn 0207
-#define Bdiscard 0210
-#define Bdup 0211
-
-#define Bsave_excursion 0212
-#define Bsave_window_excursion 0213 /* Obsolete since Emacs-24.1. */
-#define Bsave_restriction 0214
-#define Bcatch 0215
-
-#define Bunwind_protect 0216
-#define Bcondition_case 0217
-#define Btemp_output_buffer_setup 0220 /* Obsolete since Emacs-24.1. */
-#define Btemp_output_buffer_show 0221 /* Obsolete since Emacs-24.1. */
-
-#define Bunbind_all 0222 /* Obsolete. Never used. */
-
-#define Bset_marker 0223
-#define Bmatch_beginning 0224
-#define Bmatch_end 0225
-#define Bupcase 0226
-#define Bdowncase 0227
-
-#define Bstringeqlsign 0230
-#define Bstringlss 0231
-#define Bequal 0232
-#define Bnthcdr 0233
-#define Belt 0234
-#define Bmember 0235
-#define Bassq 0236
-#define Bnreverse 0237
-#define Bsetcar 0240
-#define Bsetcdr 0241
-#define Bcar_safe 0242
-#define Bcdr_safe 0243
-#define Bnconc 0244
-#define Bquo 0245
-#define Brem 0246
-#define Bnumberp 0247
-#define Bintegerp 0250
-
-#define BRgoto 0252
-#define BRgotoifnil 0253
-#define BRgotoifnonnil 0254
-#define BRgotoifnilelsepop 0255
-#define BRgotoifnonnilelsepop 0256
-
-#define BlistN 0257
-#define BconcatN 0260
-#define BinsertN 0261
-
-/* Bstack_ref is code 0. */
-#define Bstack_set 0262
-#define Bstack_set2 0263
-#define BdiscardN 0266
-
-#define Bconstant 0300
+};
/* Whether to maintain a `top' and `bottom' field in the stack frame. */
#define BYTE_MAINTAIN_TOP (BYTE_CODE_SAFE || BYTE_MARK_STACK)
@@ -318,7 +372,7 @@ unmark_byte_stack (void)
{
if (stack->byte_string_start != SDATA (stack->byte_string))
{
- int offset = stack->pc - stack->byte_string_start;
+ ptrdiff_t offset = stack->pc - stack->byte_string_start;
stack->byte_string_start = SDATA (stack->byte_string);
stack->pc = stack->byte_string_start + offset;
}
@@ -369,15 +423,11 @@ unmark_byte_stack (void)
/* Garbage collect if we have consed enough since the last time.
We do this at every branch, to avoid loops that never GC. */
-#define MAYBE_GC() \
- do { \
- if (consing_since_gc > gc_cons_threshold \
- && consing_since_gc > gc_relative_threshold) \
- { \
- BEFORE_POTENTIAL_GC (); \
- Fgarbage_collect (); \
- AFTER_POTENTIAL_GC (); \
- } \
+#define MAYBE_GC() \
+ do { \
+ BEFORE_POTENTIAL_GC (); \
+ maybe_gc (); \
+ AFTER_POTENTIAL_GC (); \
} while (0)
/* Check for jumping out of range. */
@@ -385,7 +435,7 @@ unmark_byte_stack (void)
#ifdef BYTE_CODE_SAFE
#define CHECK_RANGE(ARG) \
- if (ARG >= bytestr_length) abort ()
+ if (ARG >= bytestr_length) emacs_abort ()
#else /* not BYTE_CODE_SAFE */
@@ -408,7 +458,8 @@ unmark_byte_stack (void)
Fsignal (Qquit, Qnil); \
AFTER_POTENTIAL_GC (); \
} \
- ELSE_PENDING_SIGNALS \
+ else if (pending_signals) \
+ process_pending_signals (); \
} while (0)
@@ -435,7 +486,7 @@ Lisp_Object
exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
#ifdef BYTE_CODE_METER
int this_op = 0;
int prev_op;
@@ -446,7 +497,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
#ifdef BYTE_CODE_SAFE
ptrdiff_t const_length;
Lisp_Object *stacke;
- int bytestr_length;
+ ptrdiff_t bytestr_length;
#endif
struct byte_stack stack;
Lisp_Object *top;
@@ -458,7 +509,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
if (FRAME_X_P (f)
&& FRAME_FONT (f)->direction != 0
&& FRAME_FONT (f)->direction != 1)
- abort ();
+ emacs_abort ();
}
#endif
@@ -486,15 +537,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
stack.byte_string = bytestr;
stack.pc = stack.byte_string_start = SDATA (bytestr);
stack.constants = vector;
- if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object) < XFASTINT (maxdepth))
+ if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth))
memory_full (SIZE_MAX);
- top = (Lisp_Object *) alloca (XFASTINT (maxdepth)
- * sizeof (Lisp_Object));
+ top = alloca ((XFASTINT (maxdepth) + 1) * sizeof *top);
#if BYTE_MAINTAIN_TOP
- stack.bottom = top;
+ stack.bottom = top + 1;
stack.top = NULL;
#endif
- top -= 1;
stack.next = byte_stack_list;
byte_stack_list = &stack;
@@ -505,7 +554,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
if (INTEGERP (args_template))
{
ptrdiff_t at = XINT (args_template);
- int rest = at & 128;
+ bool rest = (at & 128) != 0;
int mandatory = at & 127;
ptrdiff_t nonrest = at >> 8;
eassert (mandatory <= nonrest);
@@ -552,9 +601,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
{
#ifdef BYTE_CODE_SAFE
if (top > stacke)
- abort ();
+ emacs_abort ();
else if (top < stack.bottom - 1)
- abort ();
+ emacs_abort ();
#endif
#ifdef BYTE_CODE_METER
@@ -562,27 +611,93 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
this_op = op = FETCH;
METER_CODE (prev_op, op);
#else
+#ifndef BYTE_CODE_THREADED
op = FETCH;
#endif
+#endif
+
+ /* The interpreter can be compiled one of two ways: as an
+ ordinary switch-based interpreter, or as a threaded
+ interpreter. The threaded interpreter relies on GCC's
+ computed goto extension, so it is not available everywhere.
+ Threading provides a performance boost. These macros are how
+ we allow the code to be compiled both ways. */
+#ifdef BYTE_CODE_THREADED
+ /* The CASE macro introduces an instruction's body. It is
+ either a label or a case label. */
+#define CASE(OP) insn_ ## OP
+ /* NEXT is invoked at the end of an instruction to go to the
+ next instruction. It is either a computed goto, or a
+ plain break. */
+#define NEXT goto *(targets[op = FETCH])
+ /* FIRST is like NEXT, but is only used at the start of the
+ interpreter body. In the switch-based interpreter it is the
+ switch, so the threaded definition must include a semicolon. */
+#define FIRST NEXT;
+ /* Most cases are labeled with the CASE macro, above.
+ CASE_DEFAULT is one exception; it is used if the interpreter
+ being built requires a default case. The threaded
+ interpreter does not, because the dispatch table is
+ completely filled. */
+#define CASE_DEFAULT
+ /* This introduces an instruction that is known to call abort. */
+#define CASE_ABORT CASE (Bstack_ref): CASE (default)
+#else
+ /* See above for the meaning of the various defines. */
+#define CASE(OP) case OP
+#define NEXT break
+#define FIRST switch (op)
+#define CASE_DEFAULT case 255: default:
+#define CASE_ABORT case 0
+#endif
+
+#ifdef BYTE_CODE_THREADED
+
+ /* A convenience define that saves us a lot of typing and makes
+ the table clearer. */
+#define LABEL(OP) [OP] = &&insn_ ## OP
+
+#if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic push
+# pragma GCC diagnostic ignored "-Woverride-init"
+#endif
+
+ /* This is the dispatch table for the threaded interpreter. */
+ static const void *const targets[256] =
+ {
+ [0 ... (Bconstant - 1)] = &&insn_default,
+ [Bconstant ... 255] = &&insn_Bconstant,
+
+#define DEFINE(name, value) LABEL (name) ,
+ BYTE_CODES
+#undef DEFINE
+ };
+
+#if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic pop
+#endif
+
+#endif
- switch (op)
+
+ FIRST
{
- case Bvarref + 7:
+ CASE (Bvarref7):
op = FETCH2;
goto varref;
- case Bvarref:
- case Bvarref + 1:
- case Bvarref + 2:
- case Bvarref + 3:
- case Bvarref + 4:
- case Bvarref + 5:
+ CASE (Bvarref):
+ CASE (Bvarref1):
+ CASE (Bvarref2):
+ CASE (Bvarref3):
+ CASE (Bvarref4):
+ CASE (Bvarref5):
op = op - Bvarref;
goto varref;
/* This seems to be the most frequently executed byte-code
among the Bvarref's, so avoid a goto here. */
- case Bvarref+6:
+ CASE (Bvarref6):
op = FETCH;
varref:
{
@@ -607,10 +722,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
AFTER_POTENTIAL_GC ();
}
PUSH (v2);
- break;
+ NEXT;
}
- case Bgotoifnil:
+ CASE (Bgotoifnil):
{
Lisp_Object v1;
MAYBE_GC ();
@@ -622,10 +737,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CHECK_RANGE (op);
stack.pc = stack.byte_string_start + op;
}
- break;
+ NEXT;
}
- case Bcar:
+ CASE (Bcar):
{
Lisp_Object v1;
v1 = TOP;
@@ -639,28 +754,28 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
wrong_type_argument (Qlistp, v1);
AFTER_POTENTIAL_GC ();
}
- break;
+ NEXT;
}
- case Beq:
+ CASE (Beq):
{
Lisp_Object v1;
v1 = POP;
TOP = EQ (v1, TOP) ? Qt : Qnil;
- break;
+ NEXT;
}
- case Bmemq:
+ CASE (Bmemq):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fmemq (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bcdr:
+ CASE (Bcdr):
{
Lisp_Object v1;
v1 = TOP;
@@ -674,24 +789,23 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
wrong_type_argument (Qlistp, v1);
AFTER_POTENTIAL_GC ();
}
- break;
- break;
+ NEXT;
}
- case Bvarset:
- case Bvarset+1:
- case Bvarset+2:
- case Bvarset+3:
- case Bvarset+4:
- case Bvarset+5:
+ CASE (Bvarset):
+ CASE (Bvarset1):
+ CASE (Bvarset2):
+ CASE (Bvarset3):
+ CASE (Bvarset4):
+ CASE (Bvarset5):
op -= Bvarset;
goto varset;
- case Bvarset+7:
+ CASE (Bvarset7):
op = FETCH2;
goto varset;
- case Bvarset+6:
+ CASE (Bvarset6):
op = FETCH;
varset:
{
@@ -705,7 +819,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
&& !EQ (val, Qunbound)
&& !XSYMBOL (sym)->redirect
&& !SYMBOL_CONSTANT_P (sym))
- XSYMBOL (sym)->val.value = val;
+ SET_SYMBOL_VAL (XSYMBOL (sym), val);
else
{
BEFORE_POTENTIAL_GC ();
@@ -714,54 +828,54 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
}
}
(void) POP;
- break;
+ NEXT;
- case Bdup:
+ CASE (Bdup):
{
Lisp_Object v1;
v1 = TOP;
PUSH (v1);
- break;
+ NEXT;
}
/* ------------------ */
- case Bvarbind+6:
+ CASE (Bvarbind6):
op = FETCH;
goto varbind;
- case Bvarbind+7:
+ CASE (Bvarbind7):
op = FETCH2;
goto varbind;
- case Bvarbind:
- case Bvarbind+1:
- case Bvarbind+2:
- case Bvarbind+3:
- case Bvarbind+4:
- case Bvarbind+5:
+ CASE (Bvarbind):
+ CASE (Bvarbind1):
+ CASE (Bvarbind2):
+ CASE (Bvarbind3):
+ CASE (Bvarbind4):
+ CASE (Bvarbind5):
op -= Bvarbind;
varbind:
/* Specbind can signal and thus GC. */
BEFORE_POTENTIAL_GC ();
specbind (vectorp[op], POP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bcall+6:
+ CASE (Bcall6):
op = FETCH;
goto docall;
- case Bcall+7:
+ CASE (Bcall7):
op = FETCH2;
goto docall;
- case Bcall:
- case Bcall+1:
- case Bcall+2:
- case Bcall+3:
- case Bcall+4:
- case Bcall+5:
+ CASE (Bcall):
+ CASE (Bcall1):
+ CASE (Bcall2):
+ CASE (Bcall3):
+ CASE (Bcall4):
+ CASE (Bcall5):
op -= Bcall;
docall:
{
@@ -784,47 +898,47 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
#endif
TOP = Ffuncall (op + 1, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bunbind+6:
+ CASE (Bunbind6):
op = FETCH;
goto dounbind;
- case Bunbind+7:
+ CASE (Bunbind7):
op = FETCH2;
goto dounbind;
- case Bunbind:
- case Bunbind+1:
- case Bunbind+2:
- case Bunbind+3:
- case Bunbind+4:
- case Bunbind+5:
+ CASE (Bunbind):
+ CASE (Bunbind1):
+ CASE (Bunbind2):
+ CASE (Bunbind3):
+ CASE (Bunbind4):
+ CASE (Bunbind5):
op -= Bunbind;
dounbind:
BEFORE_POTENTIAL_GC ();
unbind_to (SPECPDL_INDEX () - op, Qnil);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bunbind_all: /* Obsolete. Never used. */
+ CASE (Bunbind_all): /* Obsolete. Never used. */
/* To unbind back to the beginning of this frame. Not used yet,
but will be needed for tail-recursion elimination. */
BEFORE_POTENTIAL_GC ();
unbind_to (count, Qnil);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bgoto:
+ CASE (Bgoto):
MAYBE_GC ();
BYTE_CODE_QUIT;
op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */
CHECK_RANGE (op);
stack.pc = stack.byte_string_start + op;
- break;
+ NEXT;
- case Bgotoifnonnil:
+ CASE (Bgotoifnonnil):
{
Lisp_Object v1;
MAYBE_GC ();
@@ -836,10 +950,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CHECK_RANGE (op);
stack.pc = stack.byte_string_start + op;
}
- break;
+ NEXT;
}
- case Bgotoifnilelsepop:
+ CASE (Bgotoifnilelsepop):
MAYBE_GC ();
op = FETCH2;
if (NILP (TOP))
@@ -849,9 +963,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
stack.pc = stack.byte_string_start + op;
}
else DISCARD (1);
- break;
+ NEXT;
- case Bgotoifnonnilelsepop:
+ CASE (Bgotoifnonnilelsepop):
MAYBE_GC ();
op = FETCH2;
if (!NILP (TOP))
@@ -861,15 +975,15 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
stack.pc = stack.byte_string_start + op;
}
else DISCARD (1);
- break;
+ NEXT;
- case BRgoto:
+ CASE (BRgoto):
MAYBE_GC ();
BYTE_CODE_QUIT;
stack.pc += (int) *stack.pc - 127;
- break;
+ NEXT;
- case BRgotoifnil:
+ CASE (BRgotoifnil):
{
Lisp_Object v1;
MAYBE_GC ();
@@ -880,10 +994,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
stack.pc += (int) *stack.pc - 128;
}
stack.pc++;
- break;
+ NEXT;
}
- case BRgotoifnonnil:
+ CASE (BRgotoifnonnil):
{
Lisp_Object v1;
MAYBE_GC ();
@@ -894,10 +1008,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
stack.pc += (int) *stack.pc - 128;
}
stack.pc++;
- break;
+ NEXT;
}
- case BRgotoifnilelsepop:
+ CASE (BRgotoifnilelsepop):
MAYBE_GC ();
op = *stack.pc++;
if (NILP (TOP))
@@ -906,9 +1020,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
stack.pc += op - 128;
}
else DISCARD (1);
- break;
+ NEXT;
- case BRgotoifnonnilelsepop:
+ CASE (BRgotoifnonnilelsepop):
MAYBE_GC ();
op = *stack.pc++;
if (!NILP (TOP))
@@ -917,62 +1031,62 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
stack.pc += op - 128;
}
else DISCARD (1);
- break;
+ NEXT;
- case Breturn:
+ CASE (Breturn):
result = POP;
goto exit;
- case Bdiscard:
+ CASE (Bdiscard):
DISCARD (1);
- break;
+ NEXT;
- case Bconstant2:
+ CASE (Bconstant2):
PUSH (vectorp[FETCH2]);
- break;
+ NEXT;
- case Bsave_excursion:
+ CASE (Bsave_excursion):
record_unwind_protect (save_excursion_restore,
save_excursion_save ());
- break;
+ NEXT;
- case Bsave_current_buffer: /* Obsolete since ??. */
- case Bsave_current_buffer_1:
- record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
- break;
+ CASE (Bsave_current_buffer): /* Obsolete since ??. */
+ CASE (Bsave_current_buffer_1):
+ record_unwind_current_buffer ();
+ NEXT;
- case Bsave_window_excursion: /* Obsolete since 24.1. */
+ CASE (Bsave_window_excursion): /* Obsolete since 24.1. */
{
- register int count1 = SPECPDL_INDEX ();
+ register ptrdiff_t count1 = SPECPDL_INDEX ();
record_unwind_protect (Fset_window_configuration,
Fcurrent_window_configuration (Qnil));
BEFORE_POTENTIAL_GC ();
TOP = Fprogn (TOP);
unbind_to (count1, TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bsave_restriction:
+ CASE (Bsave_restriction):
record_unwind_protect (save_restriction_restore,
save_restriction_save ());
- break;
+ NEXT;
- case Bcatch: /* FIXME: ill-suited for lexbind. */
+ CASE (Bcatch): /* FIXME: ill-suited for lexbind. */
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = internal_catch (TOP, eval_sub, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bunwind_protect: /* FIXME: avoid closure for lexbind. */
+ CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */
record_unwind_protect (Fprogn, POP);
- break;
+ NEXT;
- case Bcondition_case: /* FIXME: ill-suited for lexbind. */
+ CASE (Bcondition_case): /* FIXME: ill-suited for lexbind. */
{
Lisp_Object handlers, body;
handlers = POP;
@@ -980,18 +1094,18 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
BEFORE_POTENTIAL_GC ();
TOP = internal_lisp_condition_case (TOP, body, handlers);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Btemp_output_buffer_setup: /* Obsolete since 24.1. */
+ CASE (Btemp_output_buffer_setup): /* Obsolete since 24.1. */
BEFORE_POTENTIAL_GC ();
CHECK_STRING (TOP);
temp_output_buffer_setup (SSDATA (TOP));
AFTER_POTENTIAL_GC ();
TOP = Vstandard_output;
- break;
+ NEXT;
- case Btemp_output_buffer_show: /* Obsolete since 24.1. */
+ CASE (Btemp_output_buffer_show): /* Obsolete since 24.1. */
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
@@ -1001,190 +1115,191 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
/* pop binding of standard-output */
unbind_to (SPECPDL_INDEX () - 1, Qnil);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bnth:
+ CASE (Bnth):
{
Lisp_Object v1, v2;
+ EMACS_INT n;
BEFORE_POTENTIAL_GC ();
v1 = POP;
v2 = TOP;
CHECK_NUMBER (v2);
- op = XINT (v2);
+ n = XINT (v2);
immediate_quit = 1;
- while (--op >= 0 && CONSP (v1))
+ while (--n >= 0 && CONSP (v1))
v1 = XCDR (v1);
immediate_quit = 0;
TOP = CAR (v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bsymbolp:
+ CASE (Bsymbolp):
TOP = SYMBOLP (TOP) ? Qt : Qnil;
- break;
+ NEXT;
- case Bconsp:
+ CASE (Bconsp):
TOP = CONSP (TOP) ? Qt : Qnil;
- break;
+ NEXT;
- case Bstringp:
+ CASE (Bstringp):
TOP = STRINGP (TOP) ? Qt : Qnil;
- break;
+ NEXT;
- case Blistp:
+ CASE (Blistp):
TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
- break;
+ NEXT;
- case Bnot:
+ CASE (Bnot):
TOP = NILP (TOP) ? Qt : Qnil;
- break;
+ NEXT;
- case Bcons:
+ CASE (Bcons):
{
Lisp_Object v1;
v1 = POP;
TOP = Fcons (TOP, v1);
- break;
+ NEXT;
}
- case Blist1:
+ CASE (Blist1):
TOP = Fcons (TOP, Qnil);
- break;
+ NEXT;
- case Blist2:
+ CASE (Blist2):
{
Lisp_Object v1;
v1 = POP;
TOP = Fcons (TOP, Fcons (v1, Qnil));
- break;
+ NEXT;
}
- case Blist3:
+ CASE (Blist3):
DISCARD (2);
TOP = Flist (3, &TOP);
- break;
+ NEXT;
- case Blist4:
+ CASE (Blist4):
DISCARD (3);
TOP = Flist (4, &TOP);
- break;
+ NEXT;
- case BlistN:
+ CASE (BlistN):
op = FETCH;
DISCARD (op - 1);
TOP = Flist (op, &TOP);
- break;
+ NEXT;
- case Blength:
+ CASE (Blength):
BEFORE_POTENTIAL_GC ();
TOP = Flength (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Baref:
+ CASE (Baref):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Faref (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Baset:
+ CASE (Baset):
{
Lisp_Object v1, v2;
BEFORE_POTENTIAL_GC ();
v2 = POP; v1 = POP;
TOP = Faset (TOP, v1, v2);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bsymbol_value:
+ CASE (Bsymbol_value):
BEFORE_POTENTIAL_GC ();
TOP = Fsymbol_value (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bsymbol_function:
+ CASE (Bsymbol_function):
BEFORE_POTENTIAL_GC ();
TOP = Fsymbol_function (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bset:
+ CASE (Bset):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fset (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bfset:
+ CASE (Bfset):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Ffset (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bget:
+ CASE (Bget):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fget (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bsubstring:
+ CASE (Bsubstring):
{
Lisp_Object v1, v2;
BEFORE_POTENTIAL_GC ();
v2 = POP; v1 = POP;
TOP = Fsubstring (TOP, v1, v2);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bconcat2:
+ CASE (Bconcat2):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fconcat (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bconcat3:
+ CASE (Bconcat3):
BEFORE_POTENTIAL_GC ();
DISCARD (2);
TOP = Fconcat (3, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bconcat4:
+ CASE (Bconcat4):
BEFORE_POTENTIAL_GC ();
DISCARD (3);
TOP = Fconcat (4, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case BconcatN:
+ CASE (BconcatN):
op = FETCH;
BEFORE_POTENTIAL_GC ();
DISCARD (op - 1);
TOP = Fconcat (op, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bsub1:
+ CASE (Bsub1):
{
Lisp_Object v1;
v1 = TOP;
@@ -1199,10 +1314,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
TOP = Fsub1 (v1);
AFTER_POTENTIAL_GC ();
}
- break;
+ NEXT;
}
- case Badd1:
+ CASE (Badd1):
{
Lisp_Object v1;
v1 = TOP;
@@ -1217,10 +1332,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
TOP = Fadd1 (v1);
AFTER_POTENTIAL_GC ();
}
- break;
+ NEXT;
}
- case Beqlsign:
+ CASE (Beqlsign):
{
Lisp_Object v1, v2;
BEFORE_POTENTIAL_GC ();
@@ -1238,57 +1353,57 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
}
else
TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
- break;
+ NEXT;
}
- case Bgtr:
+ CASE (Bgtr):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fgtr (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Blss:
+ CASE (Blss):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Flss (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bleq:
+ CASE (Bleq):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fleq (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bgeq:
+ CASE (Bgeq):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fgeq (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bdiff:
+ CASE (Bdiff):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fminus (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bnegate:
+ CASE (Bnegate):
{
Lisp_Object v1;
v1 = TOP;
@@ -1303,209 +1418,211 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
TOP = Fminus (1, &TOP);
AFTER_POTENTIAL_GC ();
}
- break;
+ NEXT;
}
- case Bplus:
+ CASE (Bplus):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fplus (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bmax:
+ CASE (Bmax):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fmax (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bmin:
+ CASE (Bmin):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fmin (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bmult:
+ CASE (Bmult):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Ftimes (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bquo:
+ CASE (Bquo):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fquo (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Brem:
+ CASE (Brem):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Frem (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bpoint:
+ CASE (Bpoint):
{
Lisp_Object v1;
XSETFASTINT (v1, PT);
PUSH (v1);
- break;
+ NEXT;
}
- case Bgoto_char:
+ CASE (Bgoto_char):
BEFORE_POTENTIAL_GC ();
TOP = Fgoto_char (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Binsert:
+ CASE (Binsert):
BEFORE_POTENTIAL_GC ();
TOP = Finsert (1, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case BinsertN:
+ CASE (BinsertN):
op = FETCH;
BEFORE_POTENTIAL_GC ();
DISCARD (op - 1);
TOP = Finsert (op, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bpoint_max:
+ CASE (Bpoint_max):
{
Lisp_Object v1;
XSETFASTINT (v1, ZV);
PUSH (v1);
- break;
+ NEXT;
}
- case Bpoint_min:
+ CASE (Bpoint_min):
{
Lisp_Object v1;
XSETFASTINT (v1, BEGV);
PUSH (v1);
- break;
+ NEXT;
}
- case Bchar_after:
+ CASE (Bchar_after):
BEFORE_POTENTIAL_GC ();
TOP = Fchar_after (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bfollowing_char:
+ CASE (Bfollowing_char):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = Ffollowing_char ();
AFTER_POTENTIAL_GC ();
PUSH (v1);
- break;
+ NEXT;
}
- case Bpreceding_char:
+ CASE (Bpreceding_char):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = Fprevious_char ();
AFTER_POTENTIAL_GC ();
PUSH (v1);
- break;
+ NEXT;
}
- case Bcurrent_column:
+ CASE (Bcurrent_column):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
XSETFASTINT (v1, current_column ());
AFTER_POTENTIAL_GC ();
PUSH (v1);
- break;
+ NEXT;
}
- case Bindent_to:
+ CASE (Bindent_to):
BEFORE_POTENTIAL_GC ();
TOP = Findent_to (TOP, Qnil);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Beolp:
+ CASE (Beolp):
PUSH (Feolp ());
- break;
+ NEXT;
- case Beobp:
+ CASE (Beobp):
PUSH (Feobp ());
- break;
+ NEXT;
- case Bbolp:
+ CASE (Bbolp):
PUSH (Fbolp ());
- break;
+ NEXT;
- case Bbobp:
+ CASE (Bbobp):
PUSH (Fbobp ());
- break;
+ NEXT;
- case Bcurrent_buffer:
+ CASE (Bcurrent_buffer):
PUSH (Fcurrent_buffer ());
- break;
+ NEXT;
- case Bset_buffer:
+ CASE (Bset_buffer):
BEFORE_POTENTIAL_GC ();
TOP = Fset_buffer (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Binteractive_p: /* Obsolete since 24.1. */
- PUSH (Finteractive_p ());
- break;
+ CASE (Binteractive_p): /* Obsolete since 24.1. */
+ BEFORE_POTENTIAL_GC ();
+ PUSH (call0 (intern ("interactive-p")));
+ AFTER_POTENTIAL_GC ();
+ NEXT;
- case Bforward_char:
+ CASE (Bforward_char):
BEFORE_POTENTIAL_GC ();
TOP = Fforward_char (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bforward_word:
+ CASE (Bforward_word):
BEFORE_POTENTIAL_GC ();
TOP = Fforward_word (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bskip_chars_forward:
+ CASE (Bskip_chars_forward):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fskip_chars_forward (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bskip_chars_backward:
+ CASE (Bskip_chars_backward):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fskip_chars_backward (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bforward_line:
+ CASE (Bforward_line):
BEFORE_POTENTIAL_GC ();
TOP = Fforward_line (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bchar_syntax:
+ CASE (Bchar_syntax):
{
int c;
@@ -1517,51 +1634,51 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
MAKE_CHAR_MULTIBYTE (c);
XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]);
}
- break;
+ NEXT;
- case Bbuffer_substring:
+ CASE (Bbuffer_substring):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fbuffer_substring (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bdelete_region:
+ CASE (Bdelete_region):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fdelete_region (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bnarrow_to_region:
+ CASE (Bnarrow_to_region):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fnarrow_to_region (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bwiden:
+ CASE (Bwiden):
BEFORE_POTENTIAL_GC ();
PUSH (Fwiden ());
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bend_of_line:
+ CASE (Bend_of_line):
BEFORE_POTENTIAL_GC ();
TOP = Fend_of_line (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bset_marker:
+ CASE (Bset_marker):
{
Lisp_Object v1, v2;
BEFORE_POTENTIAL_GC ();
@@ -1569,85 +1686,86 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
v2 = POP;
TOP = Fset_marker (TOP, v2, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bmatch_beginning:
+ CASE (Bmatch_beginning):
BEFORE_POTENTIAL_GC ();
TOP = Fmatch_beginning (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bmatch_end:
+ CASE (Bmatch_end):
BEFORE_POTENTIAL_GC ();
TOP = Fmatch_end (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bupcase:
+ CASE (Bupcase):
BEFORE_POTENTIAL_GC ();
TOP = Fupcase (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bdowncase:
+ CASE (Bdowncase):
BEFORE_POTENTIAL_GC ();
TOP = Fdowncase (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bstringeqlsign:
+ CASE (Bstringeqlsign):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fstring_equal (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bstringlss:
+ CASE (Bstringlss):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fstring_lessp (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bequal:
+ CASE (Bequal):
{
Lisp_Object v1;
v1 = POP;
TOP = Fequal (TOP, v1);
- break;
+ NEXT;
}
- case Bnthcdr:
+ CASE (Bnthcdr):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fnthcdr (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Belt:
+ CASE (Belt):
{
Lisp_Object v1, v2;
if (CONSP (TOP))
{
/* Exchange args and then do nth. */
+ EMACS_INT n;
BEFORE_POTENTIAL_GC ();
v2 = POP;
v1 = TOP;
CHECK_NUMBER (v2);
AFTER_POTENTIAL_GC ();
- op = XINT (v2);
+ n = XINT (v2);
immediate_quit = 1;
- while (--op >= 0 && CONSP (v1))
+ while (--n >= 0 && CONSP (v1))
v1 = XCDR (v1);
immediate_quit = 0;
TOP = CAR (v1);
@@ -1659,87 +1777,91 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
TOP = Felt (TOP, v1);
AFTER_POTENTIAL_GC ();
}
- break;
+ NEXT;
}
- case Bmember:
+ CASE (Bmember):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fmember (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bassq:
+ CASE (Bassq):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fassq (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bnreverse:
+ CASE (Bnreverse):
BEFORE_POTENTIAL_GC ();
TOP = Fnreverse (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bsetcar:
+ CASE (Bsetcar):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fsetcar (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bsetcdr:
+ CASE (Bsetcdr):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fsetcdr (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bcar_safe:
+ CASE (Bcar_safe):
{
Lisp_Object v1;
v1 = TOP;
TOP = CAR_SAFE (v1);
- break;
+ NEXT;
}
- case Bcdr_safe:
+ CASE (Bcdr_safe):
{
Lisp_Object v1;
v1 = TOP;
TOP = CDR_SAFE (v1);
- break;
+ NEXT;
}
- case Bnconc:
+ CASE (Bnconc):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fnconc (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bnumberp:
+ CASE (Bnumberp):
TOP = (NUMBERP (TOP) ? Qt : Qnil);
- break;
+ NEXT;
- case Bintegerp:
+ CASE (Bintegerp):
TOP = INTEGERP (TOP) ? Qt : Qnil;
- break;
+ NEXT;
#ifdef BYTE_CODE_SAFE
+ /* These are intentionally written using 'case' syntax,
+ because they are incompatible with the threaded
+ interpreter. */
+
case Bset_mark:
BEFORE_POTENTIAL_GC ();
error ("set-mark is an obsolete bytecode");
@@ -1752,49 +1874,49 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
break;
#endif
- case 0:
+ CASE_ABORT:
/* Actually this is Bstack_ref with offset 0, but we use Bdup
for that instead. */
- /* case Bstack_ref: */
- abort ();
+ /* CASE (Bstack_ref): */
+ error ("Invalid byte opcode");
/* Handy byte-codes for lexical binding. */
- case Bstack_ref+1:
- case Bstack_ref+2:
- case Bstack_ref+3:
- case Bstack_ref+4:
- case Bstack_ref+5:
+ CASE (Bstack_ref1):
+ CASE (Bstack_ref2):
+ CASE (Bstack_ref3):
+ CASE (Bstack_ref4):
+ CASE (Bstack_ref5):
{
Lisp_Object *ptr = top - (op - Bstack_ref);
PUSH (*ptr);
- break;
+ NEXT;
}
- case Bstack_ref+6:
+ CASE (Bstack_ref6):
{
Lisp_Object *ptr = top - (FETCH);
PUSH (*ptr);
- break;
+ NEXT;
}
- case Bstack_ref+7:
+ CASE (Bstack_ref7):
{
Lisp_Object *ptr = top - (FETCH2);
PUSH (*ptr);
- break;
+ NEXT;
}
- case Bstack_set:
+ CASE (Bstack_set):
/* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
{
Lisp_Object *ptr = top - (FETCH);
*ptr = POP;
- break;
+ NEXT;
}
- case Bstack_set2:
+ CASE (Bstack_set2):
{
Lisp_Object *ptr = top - (FETCH2);
*ptr = POP;
- break;
+ NEXT;
}
- case BdiscardN:
+ CASE (BdiscardN):
op = FETCH;
if (op & 0x80)
{
@@ -1802,23 +1924,24 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
top[-op] = TOP;
}
DISCARD (op);
- break;
+ NEXT;
- case 255:
- default:
+ CASE_DEFAULT
+ CASE (Bconstant):
#ifdef BYTE_CODE_SAFE
if (op < Bconstant)
{
- abort ();
+ emacs_abort ();
}
if ((op -= Bconstant) >= const_length)
{
- abort ();
+ emacs_abort ();
}
PUSH (vectorp[op]);
#else
PUSH (vectorp[op - Bconstant]);
#endif
+ NEXT;
}
}
@@ -1831,7 +1954,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
#ifdef BYTE_CODE_SAFE
error ("binding stack not balanced (serious byte compiler bug)");
#else
- abort ();
+ emacs_abort ();
#endif
return result;
@@ -1866,8 +1989,8 @@ integer, it is incremented each time that symbol's function is called. */);
{
int i = 256;
while (i--)
- XVECTOR (Vbyte_code_meter)->contents[i] =
- Fmake_vector (make_number (256), make_number (0));
+ ASET (Vbyte_code_meter, i,
+ Fmake_vector (make_number (256), make_number (0)));
}
#endif
}
diff --git a/src/callint.c b/src/callint.c
index 25a4713e270..c4c087e83d7 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -1,5 +1,5 @@
/* Call a Lisp function interactively.
- Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2011
+ Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,15 +19,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "commands.h"
#include "keyboard.h"
#include "window.h"
#include "keymap.h"
-#include "character.h"
Lisp_Object Qminus, Qplus;
Lisp_Object Qcall_interactively;
@@ -97,7 +96,7 @@ r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
s -- Any string. Does not inherit the current input method.
S -- Any symbol.
U -- Mouse up event discarded by a previous k or K argument.
-v -- Variable name: symbol that is user-variable-p.
+v -- Variable name: symbol that is `custom-variable-p'.
x -- Lisp expression read but not evaluated.
X -- Lisp expression read and evaluated.
z -- Coding system.
@@ -150,7 +149,7 @@ static const char *callint_argfuns[]
= {"", "point", "mark", "region-beginning", "region-end"};
static void
-check_mark (int for_region)
+check_mark (bool for_region)
{
Lisp_Object tem;
tem = Fmarker_buffer (BVAR (current_buffer, mark));
@@ -205,7 +204,7 @@ fix_command (Lisp_Object input, Lisp_Object values)
if (CONSP (elt))
{
Lisp_Object presflag, carelt;
- carelt = Fcar (elt);
+ carelt = XCAR (elt);
/* If it is (if X Y), look at Y. */
if (EQ (carelt, Qif)
&& EQ (Fnthcdr (make_number (3), elt), Qnil))
@@ -257,11 +256,11 @@ invoke it. If KEYS is omitted or nil, the return value of
Lisp_Object teml;
Lisp_Object up_event;
Lisp_Object enable;
- int speccount = SPECPDL_INDEX ();
+ ptrdiff_t speccount = SPECPDL_INDEX ();
/* The index of the next element of this_command_keys to examine for
the 'e' interactive code. */
- int next_event;
+ ptrdiff_t next_event;
Lisp_Object prefix_arg;
char *string;
@@ -273,18 +272,18 @@ invoke it. If KEYS is omitted or nil, the return value of
signed char *varies;
ptrdiff_t i, nargs;
- int foo;
- int arg_from_tty = 0;
+ ptrdiff_t mark;
+ bool arg_from_tty = 0;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- int key_count;
- int record_then_fail = 0;
+ ptrdiff_t key_count;
+ bool record_then_fail = 0;
Lisp_Object save_this_command, save_last_command;
Lisp_Object save_this_original_command, save_real_this_command;
save_this_command = Vthis_command;
save_this_original_command = Vthis_original_command;
- save_real_this_command = real_this_command;
+ save_real_this_command = Vreal_this_command;
save_last_command = KVAR (current_kboard, Vlast_command);
if (NILP (keys))
@@ -295,7 +294,7 @@ invoke it. If KEYS is omitted or nil, the return value of
key_count = ASIZE (keys);
}
- /* Save this now, since use of minibuffer will clobber it. */
+ /* Save this now, since use of minibuffer will clobber it. */
prefix_arg = Vcurrent_prefix_arg;
if (SYMBOLP (function))
@@ -310,7 +309,8 @@ invoke it. If KEYS is omitted or nil, the return value of
The feature is not fully implemented. */
filter_specs = Qnil;
- /* If k or K discard an up-event, save it here so it can be retrieved with U */
+ /* If k or K discard an up-event, save it here so it can be retrieved with
+ U. */
up_event = Qnil;
/* Set SPECS to the interactive form, or barf if not interactive. */
@@ -330,7 +330,7 @@ invoke it. If KEYS is omitted or nil, the return value of
{
/* Make a copy of string so that if a GC relocates specs,
`string' will still be valid. */
- string = (char *) alloca (SBYTES (specs) + 1);
+ string = alloca (SBYTES (specs) + 1);
memcpy (string, SSDATA (specs), SBYTES (specs) + 1);
}
else
@@ -370,14 +370,14 @@ invoke it. If KEYS is omitted or nil, the return value of
Vthis_command = save_this_command;
Vthis_original_command = save_this_original_command;
- real_this_command= save_real_this_command;
- KVAR (current_kboard, Vlast_command) = save_last_command;
+ Vreal_this_command = save_real_this_command;
+ kset_last_command (current_kboard, save_last_command);
temporarily_switch_to_single_kboard (NULL);
return unbind_to (speccount, apply1 (function, specs));
}
- /* Here if function specifies a string to control parsing the defaults */
+ /* Here if function specifies a string to control parsing the defaults. */
/* Set next_event to point to the first event with parameters. */
for (next_event = 0; next_event < key_count; next_event++)
@@ -464,13 +464,13 @@ invoke it. If KEYS is omitted or nil, the return value of
}
if (min (MOST_POSITIVE_FIXNUM,
- min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object))
+ min (PTRDIFF_MAX, SIZE_MAX) / word_size)
< nargs)
memory_full (SIZE_MAX);
- args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
- visargs = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
- varies = (signed char *) alloca (nargs);
+ args = alloca (nargs * sizeof *args);
+ visargs = alloca (nargs * sizeof *visargs);
+ varies = alloca (nargs * sizeof *varies);
for (i = 0; i < nargs; i++)
{
@@ -577,7 +577,7 @@ invoke it. If KEYS is omitted or nil, the return value of
case 'k': /* Key sequence. */
{
- int speccount1 = SPECPDL_INDEX ();
+ ptrdiff_t speccount1 = SPECPDL_INDEX ();
specbind (Qcursor_in_echo_area, Qt);
/* Prompt in `minibuffer-prompt' face. */
Fput_text_property (make_number (0),
@@ -609,7 +609,7 @@ invoke it. If KEYS is omitted or nil, the return value of
case 'K': /* Key sequence to be defined. */
{
- int speccount1 = SPECPDL_INDEX ();
+ ptrdiff_t speccount1 = SPECPDL_INDEX ();
specbind (Qcursor_in_echo_area, Qt);
/* Prompt in `minibuffer-prompt' face. */
Fput_text_property (make_number (0),
@@ -684,7 +684,7 @@ invoke it. If KEYS is omitted or nil, the return value of
goto have_prefix_arg;
case 'n': /* Read number from minibuffer. */
{
- int first = 1;
+ bool first = 1;
do
{
Lisp_Object str;
@@ -725,11 +725,11 @@ invoke it. If KEYS is omitted or nil, the return value of
check_mark (1);
set_marker_both (point_marker, Qnil, PT, PT_BYTE);
/* visargs[i+1] = Qnil; */
- foo = marker_position (BVAR (current_buffer, mark));
+ mark = marker_position (BVAR (current_buffer, mark));
/* visargs[i] = Qnil; */
- args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark);
+ args[i] = PT < mark ? point_marker : BVAR (current_buffer, mark);
varies[i] = 3;
- args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark);
+ args[++i] = PT > mark ? point_marker : BVAR (current_buffer, mark);
varies[i] = 4;
break;
@@ -748,7 +748,7 @@ invoke it. If KEYS is omitted or nil, the return value of
break;
case 'v': /* Variable name: symbol that is
- user-variable-p. */
+ custom-variable-p. */
args[i] = Fread_variable (callint_message, Qnil);
visargs[i] = last_minibuf_string;
break;
@@ -841,8 +841,8 @@ invoke it. If KEYS is omitted or nil, the return value of
Vthis_command = save_this_command;
Vthis_original_command = save_this_original_command;
- real_this_command= save_real_this_command;
- KVAR (current_kboard, Vlast_command) = save_last_command;
+ Vreal_this_command = save_real_this_command;
+ kset_last_command (current_kboard, save_last_command);
{
Lisp_Object val;
@@ -887,10 +887,11 @@ syms_of_callint (void)
callint_message = Qnil;
staticpro (&callint_message);
- preserved_fns = pure_cons (intern_c_string ("region-beginning"),
- pure_cons (intern_c_string ("region-end"),
- pure_cons (intern_c_string ("point"),
- pure_cons (intern_c_string ("mark"), Qnil))));
+ preserved_fns = listn (CONSTYPE_PURE, 4,
+ intern_c_string ("region-beginning"),
+ intern_c_string ("region-end"),
+ intern_c_string ("point"),
+ intern_c_string ("mark"));
DEFSYM (Qlist, "list");
DEFSYM (Qlet, "let");
@@ -945,7 +946,7 @@ may be set by the debugger as a reminder for itself. */);
Vcommand_debug_status = Qnil;
DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
- doc: /* *Non-nil means you can use the mark even when inactive.
+ doc: /* Non-nil means you can use the mark even when inactive.
This option makes a difference in Transient Mark mode.
When the option is non-nil, deactivation of the mark
turns off region highlighting, but commands that use the mark
diff --git a/src/callproc.c b/src/callproc.c
index 01772efce30..c9a504746b3 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -1,5 +1,5 @@
/* Synchronous subprocess invocation for GNU Emacs.
- Copyright (C) 1985-1988, 1993-1995, 1999-2011
+ Copyright (C) 1985-1988, 1993-1995, 1999-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,10 +19,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <signal.h>
#include <errno.h>
#include <stdio.h>
-#include <setjmp.h>
#include <sys/types.h>
#include <unistd.h>
@@ -44,8 +42,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif /* MSDOS */
#include "commands.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "ccl.h"
#include "coding.h"
#include "composite.h"
@@ -53,6 +51,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "process.h"
#include "syssignal.h"
#include "systty.h"
+#include "syswait.h"
#include "blockinput.h"
#include "frame.h"
#include "termhooks.h"
@@ -61,15 +60,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "msdos.h"
#endif
-#ifndef USE_CRT_DLL
-extern char **environ;
-#endif
-
-#ifdef HAVE_SETPGID
-#if !defined (USG)
-#undef setpgrp
-#define setpgrp setpgid
-#endif
+#ifdef HAVE_NS
+#include "nsterm.h"
#endif
/* Pattern used by call-process-region to make temp files. */
@@ -77,7 +69,7 @@ static Lisp_Object Vtemp_file_name_pattern;
/* True if we are about to fork off a synchronous process or if we
are waiting for it. */
-int synch_process_alive;
+bool synch_process_alive;
/* Nonzero => this is a string explaining death of synchronous subprocess. */
const char *synch_process_death;
@@ -94,16 +86,18 @@ int synch_process_retcode;
On MSDOS, delete the temporary file on any kind of termination.
On Unix, kill the process and any children on termination by signal. */
-/* Nonzero if this is termination due to exit. */
-static int call_process_exited;
-
-static Lisp_Object Fgetenv_internal (Lisp_Object, Lisp_Object);
+/* True if this is termination due to exit. */
+static bool call_process_exited;
static Lisp_Object
call_process_kill (Lisp_Object fdpid)
{
- emacs_close (XFASTINT (Fcar (fdpid)));
- EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
+ int fd;
+ pid_t pid;
+ CONS_TO_INTEGER (Fcar (fdpid), int, fd);
+ CONS_TO_INTEGER (Fcdr (fdpid), pid_t, pid);
+ emacs_close (fd);
+ EMACS_KILLPG (pid, SIGKILL);
synch_process_alive = 0;
return Qnil;
}
@@ -112,18 +106,18 @@ static Lisp_Object
call_process_cleanup (Lisp_Object arg)
{
Lisp_Object fdpid = Fcdr (arg);
+ int fd;
#if defined (MSDOS)
Lisp_Object file;
- int fd;
#else
- int pid;
+ pid_t pid;
#endif
Fset_buffer (Fcar (arg));
+ CONS_TO_INTEGER (Fcar (fdpid), int, fd);
#if defined (MSDOS)
/* for MSDOS fdpid is really (fd . tempfile) */
- fd = XFASTINT (Fcar (fdpid));
file = Fcdr (fdpid);
/* FD is -1 and FILE is "" when we didn't actually create a
temporary file in call-process. */
@@ -132,17 +126,17 @@ call_process_cleanup (Lisp_Object arg)
if (!(strcmp (SDATA (file), NULL_DEVICE) == 0 || SREF (file, 0) == '\0'))
unlink (SDATA (file));
#else /* not MSDOS */
- pid = XFASTINT (Fcdr (fdpid));
+ CONS_TO_INTEGER (Fcdr (fdpid), pid_t, pid);
if (call_process_exited)
{
- emacs_close (XFASTINT (Fcar (fdpid)));
+ emacs_close (fd);
return Qnil;
}
if (EMACS_KILLPG (pid, SIGINT) == 0)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (call_process_kill, fdpid);
message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
immediate_quit = 1;
@@ -153,7 +147,7 @@ call_process_cleanup (Lisp_Object arg)
message1 ("Waiting for process to die...done");
}
synch_process_alive = 0;
- emacs_close (XFASTINT (Fcar (fdpid)));
+ emacs_close (fd);
#endif /* not MSDOS */
return Qnil;
}
@@ -164,7 +158,8 @@ The remaining arguments are optional.
The program's input comes from file INFILE (nil means `/dev/null').
Insert output in BUFFER before point; t means current buffer; nil for BUFFER
means discard it; 0 means discard and don't wait; and `(:file FILE)', where
- FILE is a file name string, means that it should be written to that file.
+ FILE is a file name string, means that it should be written to that file
+ \(if the file already exists it is overwritten).
BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
REAL-BUFFER says what to do with standard output, as above,
while STDERR-FILE says what to do with standard error in the child.
@@ -186,17 +181,16 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object infile, buffer, current_dir, path;
- volatile int display_p_volatile;
+ Lisp_Object infile, buffer, current_dir, path, cleanup_info_tail;
+ bool display_p;
int fd[2];
int filefd;
- register int pid;
#define CALLPROC_BUFFER_SIZE_MIN (16 * 1024)
#define CALLPROC_BUFFER_SIZE_MAX (4 * CALLPROC_BUFFER_SIZE_MIN)
char buf[CALLPROC_BUFFER_SIZE_MAX];
int bufsize = CALLPROC_BUFFER_SIZE_MIN;
- int count = SPECPDL_INDEX ();
- volatile USE_SAFE_ALLOCA;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ USE_SAFE_ALLOCA;
register const unsigned char **new_argv;
/* File to use for stderr in the child.
@@ -206,13 +200,16 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
char *outf, *tempfile = NULL;
int outfilefd;
+ int pid;
+#else
+ pid_t pid;
#endif
int fd_output = -1;
struct coding_system process_coding; /* coding-system of process output */
struct coding_system argument_coding; /* coding-system of arguments */
/* Set to the return value of Ffind_operation_coding_system. */
Lisp_Object coding_systems;
- int output_to_buffer = 1;
+ bool output_to_buffer = 1;
/* Qt denotes that Ffind_operation_coding_system is not yet called. */
coding_systems = Qt;
@@ -236,7 +233,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
/* If arguments are supplied, we may have to encode them. */
if (nargs >= 5)
{
- int must_encode = 0;
+ bool must_encode = 0;
Lisp_Object coding_attrs;
for (i = 4; i < nargs; i++)
@@ -370,7 +367,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
UNGCPRO;
}
- display_p_volatile = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
+ display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
filefd = emacs_open (SSDATA (infile), O_RDONLY, 0);
if (filefd < 0)
@@ -418,8 +415,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
&& SREF (path, 1) == ':')
path = Fsubstring (path, make_number (2), Qnil);
- SAFE_ALLOCA (new_argv, const unsigned char **,
- (nargs > 4 ? nargs - 2 : 2) * sizeof *new_argv);
+ new_argv = SAFE_ALLOCA ((nargs > 4 ? nargs - 2 : 2) * sizeof *new_argv);
if (nargs > 4)
{
ptrdiff_t i;
@@ -494,17 +490,9 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
register char **save_environ = environ;
register int fd1 = fd[1];
int fd_error = fd1;
-#ifdef HAVE_WORKING_VFORK
- sigset_t procmask;
- sigset_t blocked;
- struct sigaction sigpipe_action;
-#endif
if (fd_output >= 0)
fd1 = fd_output;
-#if 0 /* Some systems don't have sigblock. */
- mask = sigblock (sigmask (SIGCHLD));
-#endif
/* Record that we're about to create a synchronous process. */
synch_process_alive = 1;
@@ -588,28 +576,20 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
0, current_dir);
#else /* not WINDOWSNT */
-#ifdef HAVE_WORKING_VFORK
- /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
- this sets the parent's signal handlers as well as the child's.
- So delay all interrupts whose handlers the child might munge,
- and record the current handlers so they can be restored later. */
- sigemptyset (&blocked);
- sigaddset (&blocked, SIGPIPE);
- sigaction (SIGPIPE, 0, &sigpipe_action);
- pthread_sigmask (SIG_BLOCK, &blocked, &procmask);
-#endif
-
- BLOCK_INPUT;
+ block_input ();
/* vfork, and prevent local vars from being clobbered by the vfork. */
{
Lisp_Object volatile buffer_volatile = buffer;
Lisp_Object volatile coding_systems_volatile = coding_systems;
Lisp_Object volatile current_dir_volatile = current_dir;
+ bool volatile display_p_volatile = display_p;
+ bool volatile output_to_buffer_volatile = output_to_buffer;
+ bool volatile sa_must_free_volatile = sa_must_free;
int volatile fd1_volatile = fd1;
int volatile fd_error_volatile = fd_error;
int volatile fd_output_volatile = fd_output;
- int volatile output_to_buffer_volatile = output_to_buffer;
+ ptrdiff_t volatile sa_count_volatile = sa_count;
unsigned char const **volatile new_argv_volatile = new_argv;
pid = vfork ();
@@ -617,10 +597,13 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
buffer = buffer_volatile;
coding_systems = coding_systems_volatile;
current_dir = current_dir_volatile;
+ display_p = display_p_volatile;
fd1 = fd1_volatile;
fd_error = fd_error_volatile;
fd_output = fd_output_volatile;
output_to_buffer = output_to_buffer_volatile;
+ sa_must_free = sa_must_free_volatile;
+ sa_count = sa_count_volatile;
new_argv = new_argv_volatile;
}
@@ -628,33 +611,17 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
{
if (fd[0] >= 0)
emacs_close (fd[0]);
-#ifdef HAVE_SETSID
+
setsid ();
-#endif
-#if defined (USG)
- setpgrp ();
-#else
- setpgrp (pid, pid);
-#endif /* USG */
-
- /* GConf causes us to ignore SIGPIPE, make sure it is restored
- in the child. */
- //signal (SIGPIPE, SIG_DFL);
-#ifdef HAVE_WORKING_VFORK
- pthread_sigmask (SIG_SETMASK, &procmask, 0);
-#endif
+
+ /* Emacs ignores SIGPIPE, but the child should not. */
+ signal (SIGPIPE, SIG_DFL);
child_setup (filefd, fd1, fd_error, (char **) new_argv,
0, current_dir);
}
- UNBLOCK_INPUT;
-
-#ifdef HAVE_WORKING_VFORK
- /* Restore the signal state. */
- sigaction (SIGPIPE, &sigpipe_action, 0);
- pthread_sigmask (SIG_SETMASK, &procmask, 0);
-#endif
+ unblock_input ();
#endif /* not WINDOWSNT */
@@ -693,16 +660,14 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
#if defined (MSDOS)
/* MSDOS needs different cleanup information. */
- record_unwind_protect (call_process_cleanup,
- Fcons (Fcurrent_buffer (),
- Fcons (make_number (fd[0]),
- build_string (tempfile ? tempfile : ""))));
+ cleanup_info_tail = build_string (tempfile ? tempfile : "");
#else
+ cleanup_info_tail = INTEGER_TO_CONS (pid);
+#endif /* not MSDOS */
record_unwind_protect (call_process_cleanup,
Fcons (Fcurrent_buffer (),
- Fcons (make_number (fd[0]), make_number (pid))));
-#endif /* not MSDOS */
-
+ Fcons (INTEGER_TO_CONS (fd[0]),
+ cleanup_info_tail)));
if (BUFFERP (buffer))
Fset_buffer (buffer);
@@ -758,12 +723,11 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
if (output_to_buffer)
{
- register EMACS_INT nread;
- int first = 1;
+ int nread;
+ bool first = 1;
EMACS_INT total_read = 0;
int carryover = 0;
- int display_p = display_p_volatile;
- int display_on_the_fly = display_p;
+ bool display_on_the_fly = display_p;
struct coding_system saved_coding;
saved_coding = process_coding;
@@ -805,7 +769,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
else
{ /* We have to decode the input. */
Lisp_Object curbuf;
- int count1 = SPECPDL_INDEX ();
+ ptrdiff_t count1 = SPECPDL_INDEX ();
XSETBUFFER (curbuf, current_buffer);
/* We cannot allow after-change-functions be run
@@ -924,7 +888,7 @@ static Lisp_Object
delete_temp_file (Lisp_Object name)
{
/* Suppress jka-compr handling, etc. */
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (intern ("file-name-handler-alist"), Qnil);
internal_delete_file (name);
unbind_to (count, Qnil);
@@ -940,7 +904,7 @@ Delete the text if fourth arg DELETE is non-nil.
Insert output in BUFFER before point; t means current buffer; nil for
BUFFER means discard it; 0 means discard and don't wait; and `(:file
FILE)', where FILE is a file name string, means that it should be
- written to that file.
+ written to that file (if the file already exists it is overwritten).
BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
REAL-BUFFER says what to do with standard output, as above,
while STDERR-FILE says what to do with standard error in the child.
@@ -961,13 +925,12 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
struct gcpro gcpro1;
Lisp_Object filename_string;
register Lisp_Object start, end;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
Lisp_Object coding_systems;
Lisp_Object val, *args2;
ptrdiff_t i;
- char *tempfile;
- Lisp_Object tmpdir, pattern;
+ Lisp_Object tmpdir;
if (STRINGP (Vtemporary_file_directory))
tmpdir = Vtemporary_file_directory;
@@ -991,8 +954,8 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
{
USE_SAFE_ALLOCA;
- pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
- SAFE_ALLOCA (tempfile, char *, SBYTES (pattern) + 1);
+ Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
+ char *tempfile = SAFE_ALLOCA (SBYTES (pattern) + 1);
memcpy (tempfile, SDATA (pattern), SBYTES (pattern) + 1);
coding_systems = Qt;
@@ -1000,12 +963,12 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
{
int fd;
- BLOCK_INPUT;
+ block_input ();
fd = mkstemp (tempfile);
- UNBLOCK_INPUT;
+ unblock_input ();
if (fd == -1)
report_file_error ("Failed to open temporary file",
- Fcons (Vtemp_file_name_pattern, Qnil));
+ Fcons (build_string (tempfile), Qnil));
else
close (fd);
}
@@ -1038,7 +1001,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
val = complement_process_encoding_system (val);
{
- int count1 = SPECPDL_INDEX ();
+ ptrdiff_t count1 = SPECPDL_INDEX ();
specbind (intern ("coding-system-for-write"), val);
/* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
@@ -1080,7 +1043,7 @@ static char **
add_env (char **env, char **new_env, char *string)
{
char **ep;
- int ok = 1;
+ bool ok = 1;
if (string == NULL)
return new_env;
@@ -1120,8 +1083,7 @@ add_env (char **env, char **new_env, char *string)
Therefore, the superior process must save and restore the value
of environ around the vfork and the call to this function.
- SET_PGRP is nonzero if we should put the subprocess into a separate
- process group.
+ If SET_PGRP, put the subprocess into a separate process group.
CURRENT_DIR is an elisp string giving the path of the current
directory the subprocess should have. Since we can't really signal
@@ -1129,7 +1091,8 @@ add_env (char **env, char **new_env, char *string)
executable directory by the parent. */
int
-child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, Lisp_Object current_dir)
+child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
+ Lisp_Object current_dir)
{
char **env;
char *pwd_var;
@@ -1138,7 +1101,7 @@ child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, L
HANDLE handles[3];
#endif /* WINDOWSNT */
- int pid = getpid ();
+ pid_t pid = getpid ();
/* Close Emacs's descriptors that this process should not have. */
close_process_descs ();
@@ -1164,9 +1127,9 @@ child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, L
/* MSDOS must have all environment variables malloc'ed, because
low-level libc functions that launch subsidiary processes rely
on that. */
- pwd_var = (char *) xmalloc (i + 6);
+ pwd_var = xmalloc (i + 6);
#else
- pwd_var = (char *) alloca (i + 6);
+ pwd_var = alloca (i + 6);
#endif
temp = pwd_var + 4;
memcpy (pwd_var, "PWD=", 4);
@@ -1234,7 +1197,7 @@ child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, L
}
/* new_length + 2 to include PWD and terminating 0. */
- env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *));
+ env = new_env = alloca ((new_length + 2) * sizeof *env);
/* If we have a PWD envvar, pass one down,
but with corrected value. */
if (egetenv ("PWD"))
@@ -1242,7 +1205,7 @@ child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, L
if (STRINGP (display))
{
- char *vdata = (char *) alloca (sizeof "DISPLAY=" + SBYTES (display));
+ char *vdata = alloca (sizeof "DISPLAY=" + SBYTES (display));
strcpy (vdata, "DISPLAY=");
strcat (vdata, SSDATA (display));
new_env = add_env (env, new_env, vdata);
@@ -1319,15 +1282,7 @@ child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, L
if (err != in && err != out)
emacs_close (err);
-#if defined (USG)
-#ifndef SETPGRP_RELEASES_CTTY
- setpgrp (); /* No arguments but equivalent in this case */
-#endif
-#else /* not USG */
- setpgrp (pid, pid);
-#endif /* not USG */
-
- /* setpgrp_of_tty is incorrect here; it uses input_fd. */
+ setpgid (0, 0);
tcsetpgrp (0, pid);
/* execvp does not accept an environment arg so the only way
@@ -1362,16 +1317,7 @@ relocate_fd (int fd, int minfd)
return fd;
else
{
- int new;
-#ifdef F_DUPFD
- new = fcntl (fd, F_DUPFD, minfd);
-#else
- new = dup (fd);
- if (new != -1)
- /* Note that we hold the original FD open while we recurse,
- to guarantee we'll get a new FD if we need it. */
- new = relocate_fd (new, minfd);
-#endif
+ int new = fcntl (fd, F_DUPFD, minfd);
if (new == -1)
{
const char *message_1 = "Error while setting up child: ";
@@ -1388,7 +1334,7 @@ relocate_fd (int fd, int minfd)
}
#endif /* not WINDOWSNT */
-static int
+static bool
getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
ptrdiff_t *valuelen, Lisp_Object env)
{
@@ -1423,7 +1369,7 @@ getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
return 0;
}
-static int
+static bool
getenv_internal (const char *var, ptrdiff_t varlen, char **value,
ptrdiff_t *valuelen, Lisp_Object frame)
{
@@ -1503,20 +1449,34 @@ egetenv (const char *var)
void
init_callproc_1 (void)
{
- char *data_dir = egetenv ("EMACSDATA");
- char *doc_dir = egetenv ("EMACSDOC");
+#ifdef HAVE_NS
+ const char *etc_dir = ns_etc_directory ();
+ const char *path_exec = ns_exec_path ();
+#endif
+
+ Vdata_directory = decode_env_path ("EMACSDATA",
+#ifdef HAVE_NS
+ etc_dir ? etc_dir :
+#endif
+ PATH_DATA);
+ Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory));
- Vdata_directory
- = Ffile_name_as_directory (build_string (data_dir ? data_dir
- : PATH_DATA));
- Vdoc_directory
- = Ffile_name_as_directory (build_string (doc_dir ? doc_dir
- : PATH_DOC));
+ Vdoc_directory = decode_env_path ("EMACSDOC",
+#ifdef HAVE_NS
+ etc_dir ? etc_dir :
+#endif
+ PATH_DOC);
+ Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory));
/* Check the EMACSPATH environment variable, defaulting to the
PATH_EXEC path from epaths.h. */
- Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
+ Vexec_path = decode_env_path ("EMACSPATH",
+#ifdef HAVE_NS
+ path_exec ? path_exec :
+#endif
+ PATH_EXEC);
Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
+ /* FIXME? For ns, path_exec should go at the front? */
Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
}
@@ -1529,6 +1489,17 @@ init_callproc (void)
register char * sh;
Lisp_Object tempdir;
+#ifdef HAVE_NS
+ if (data_dir == 0)
+ {
+ const char *etc_dir = ns_etc_directory ();
+ if (etc_dir)
+ {
+ data_dir = alloca (strlen (etc_dir) + 1);
+ strcpy (data_dir, etc_dir);
+ }
+ }
+#endif
if (!NILP (Vinstallation_directory))
{
@@ -1536,17 +1507,24 @@ init_callproc (void)
Lisp_Object tem;
tem = Fexpand_file_name (build_string ("lib-src"),
Vinstallation_directory);
-#ifndef DOS_NT
+#ifndef MSDOS
/* MSDOS uses wrapped binaries, so don't do this. */
if (NILP (Fmember (tem, Vexec_path)))
{
- Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
+#ifdef HAVE_NS
+ const char *path_exec = ns_exec_path ();
+#endif
+ Vexec_path = decode_env_path ("EMACSPATH",
+#ifdef HAVE_NS
+ path_exec ? path_exec :
+#endif
+ PATH_EXEC);
Vexec_path = Fcons (tem, Vexec_path);
Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
}
Vexec_directory = Ffile_name_as_directory (tem);
-#endif /* not DOS_NT */
+#endif /* not MSDOS */
/* Maybe use ../etc as well as ../lib-src. */
if (data_dir == 0)
@@ -1589,15 +1567,13 @@ init_callproc (void)
#endif
{
tempdir = Fdirectory_file_name (Vexec_directory);
- if (access (SSDATA (tempdir), 0) < 0)
- dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
- Vexec_directory);
+ if (! file_accessible_directory_p (SSDATA (tempdir)))
+ dir_warning ("arch-dependent data dir", Vexec_directory);
}
tempdir = Fdirectory_file_name (Vdata_directory);
- if (access (SSDATA (tempdir), 0) < 0)
- dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
- Vdata_directory);
+ if (! file_accessible_directory_p (SSDATA (tempdir)))
+ dir_warning ("arch-independent data dir", Vdata_directory);
sh = (char *) getenv ("SHELL");
Vshell_file_name = build_string (sh ? sh : "/bin/sh");
@@ -1606,7 +1582,7 @@ init_callproc (void)
Vshared_game_score_directory = Qnil;
#else
Vshared_game_score_directory = build_string (PATH_GAME);
- if (NILP (Ffile_directory_p (Vshared_game_score_directory)))
+ if (NILP (Ffile_accessible_directory_p (Vshared_game_score_directory)))
Vshared_game_score_directory = Qnil;
#endif
}
@@ -1636,16 +1612,16 @@ syms_of_callproc (void)
staticpro (&Vtemp_file_name_pattern);
DEFVAR_LISP ("shell-file-name", Vshell_file_name,
- doc: /* *File name to load inferior shells from.
+ doc: /* File name to load inferior shells from.
Initialized from the SHELL environment variable, or to a system-dependent
default if SHELL is not set. */);
DEFVAR_LISP ("exec-path", Vexec_path,
- doc: /* *List of directories to search programs to run in subprocesses.
+ doc: /* List of directories to search programs to run in subprocesses.
Each element is a string (directory name) or nil (try default directory). */);
DEFVAR_LISP ("exec-suffixes", Vexec_suffixes,
- doc: /* *List of suffixes to try to find executable file names.
+ doc: /* List of suffixes to try to find executable file names.
Each element is a string. */);
Vexec_suffixes = Qnil;
diff --git a/src/casefiddle.c b/src/casefiddle.c
index 77222c9e0a3..e3654627576 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -1,6 +1,6 @@
/* GNU Emacs case conversion functions.
-Copyright (C) 1985, 1994, 1997-1999, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1994, 1997-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,10 +19,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "commands.h"
#include "syntax.h"
#include "composite.h"
@@ -35,8 +35,8 @@ Lisp_Object Qidentity;
static Lisp_Object
casify_object (enum case_action flag, Lisp_Object obj)
{
- register int c, c1;
- register int inword = flag == CASE_DOWN;
+ int c, c1;
+ bool inword = flag == CASE_DOWN;
/* If the case table is flagged as modified, rescan it. */
if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1]))
@@ -47,7 +47,8 @@ casify_object (enum case_action flag, Lisp_Object obj)
int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
| CHAR_SHIFT | CHAR_CTL | CHAR_META);
int flags = XINT (obj) & flagbits;
- int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ bool multibyte = ! NILP (BVAR (current_buffer,
+ enable_multibyte_characters));
/* If the character has higher bits set
above the flags, return it unchanged.
@@ -82,8 +83,8 @@ casify_object (enum case_action flag, Lisp_Object obj)
wrong_type_argument (Qchar_or_string_p, obj);
else if (!STRING_MULTIBYTE (obj))
{
- EMACS_INT i;
- EMACS_INT size = SCHARS (obj);
+ ptrdiff_t i;
+ ptrdiff_t size = SCHARS (obj);
obj = Fcopy_sequence (obj);
for (i = 0; i < size; i++)
@@ -111,26 +112,19 @@ casify_object (enum case_action flag, Lisp_Object obj)
}
else
{
- EMACS_INT i, i_byte, size = SCHARS (obj);
+ ptrdiff_t i, i_byte, size = SCHARS (obj);
int len;
USE_SAFE_ALLOCA;
- unsigned char *dst, *o;
- /* Over-allocate by 12%: this is a minor overhead, but should be
- sufficient in 99.999% of the cases to avoid a reallocation. */
- EMACS_INT o_size = SBYTES (obj) + SBYTES (obj) / 8 + MAX_MULTIBYTE_LENGTH;
- SAFE_ALLOCA (dst, void *, o_size);
- o = dst;
+ ptrdiff_t o_size = (size < STRING_BYTES_BOUND / MAX_MULTIBYTE_LENGTH
+ ? size * MAX_MULTIBYTE_LENGTH
+ : STRING_BYTES_BOUND);
+ unsigned char *dst = SAFE_ALLOCA (o_size);
+ unsigned char *o = dst;
for (i = i_byte = 0; i < size; i++, i_byte += len)
{
- if ((o - dst) + MAX_MULTIBYTE_LENGTH > o_size)
- { /* Not enough space for the next char: grow the destination. */
- unsigned char *old_dst = dst;
- o_size += o_size; /* Probably overkill, but extremely rare. */
- SAFE_ALLOCA (dst, void *, o_size);
- memcpy (dst, old_dst, o - old_dst);
- o = dst + (o - old_dst);
- }
+ if (o_size - (o - dst) < MAX_MULTIBYTE_LENGTH)
+ string_overflow ();
c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, len);
if (inword && flag != CASE_CAPITALIZE_UP)
c = downcase (c);
@@ -196,17 +190,17 @@ The argument object is not altered--the value is a copy. */)
static void
casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
{
- register int c;
- register int inword = flag == CASE_DOWN;
- register int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
- EMACS_INT start, end;
- EMACS_INT start_byte;
+ int c;
+ bool inword = flag == CASE_DOWN;
+ bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ ptrdiff_t start, end;
+ ptrdiff_t start_byte;
/* Position of first and last changes. */
- EMACS_INT first = -1, last IF_LINT (= 0);
+ ptrdiff_t first = -1, last IF_LINT (= 0);
- EMACS_INT opoint = PT;
- EMACS_INT opoint_byte = PT_BYTE;
+ ptrdiff_t opoint = PT;
+ ptrdiff_t opoint_byte = PT_BYTE;
if (EQ (b, e))
/* Not modifying because nothing marked */
@@ -351,10 +345,10 @@ character positions to operate on. */)
}
static Lisp_Object
-operate_on_word (Lisp_Object arg, EMACS_INT *newpoint)
+operate_on_word (Lisp_Object arg, ptrdiff_t *newpoint)
{
Lisp_Object val;
- EMACS_INT farend;
+ ptrdiff_t farend;
EMACS_INT iarg;
CHECK_NUMBER (arg);
@@ -376,7 +370,7 @@ See also `capitalize-word'. */)
(Lisp_Object arg)
{
Lisp_Object beg, end;
- EMACS_INT newpoint;
+ ptrdiff_t newpoint;
XSETFASTINT (beg, PT);
end = operate_on_word (arg, &newpoint);
casify_region (CASE_UP, beg, end);
@@ -390,7 +384,7 @@ With negative argument, convert previous words but do not move. */)
(Lisp_Object arg)
{
Lisp_Object beg, end;
- EMACS_INT newpoint;
+ ptrdiff_t newpoint;
XSETFASTINT (beg, PT);
end = operate_on_word (arg, &newpoint);
casify_region (CASE_DOWN, beg, end);
@@ -406,7 +400,7 @@ With negative argument, capitalize previous words but do not move. */)
(Lisp_Object arg)
{
Lisp_Object beg, end;
- EMACS_INT newpoint;
+ ptrdiff_t newpoint;
XSETFASTINT (beg, PT);
end = operate_on_word (arg, &newpoint);
casify_region (CASE_CAPITALIZE, beg, end);
diff --git a/src/casetab.c b/src/casetab.c
index 575a48ed146..a84bc9202d0 100644
--- a/src/casetab.c
+++ b/src/casetab.c
@@ -1,5 +1,5 @@
/* GNU Emacs routines to deal with case tables.
- Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
Author: Howard Gayle
@@ -19,10 +19,10 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
static Lisp_Object Qcase_table_p, Qcase_table;
Lisp_Object Vascii_downcase_table;
@@ -79,7 +79,7 @@ This is the one used for new buffers. */)
return Vascii_downcase_table;
}
-static Lisp_Object set_case_table (Lisp_Object table, int standard);
+static Lisp_Object set_case_table (Lisp_Object, bool);
DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0,
doc: /* Select a new case table for the current buffer.
@@ -113,7 +113,7 @@ See `set-case-table' for more info on case tables. */)
}
static Lisp_Object
-set_case_table (Lisp_Object table, int standard)
+set_case_table (Lisp_Object table, bool standard)
{
Lisp_Object up, canon, eqv;
@@ -128,13 +128,13 @@ set_case_table (Lisp_Object table, int standard)
up = Fmake_char_table (Qcase_table, Qnil);
map_char_table (set_identity, Qnil, table, up);
map_char_table (shuffle, Qnil, table, up);
- XCHAR_TABLE (table)->extras[0] = up;
+ set_char_table_extras (table, 0, up);
}
if (NILP (canon))
{
canon = Fmake_char_table (Qcase_table, Qnil);
- XCHAR_TABLE (table)->extras[1] = canon;
+ set_char_table_extras (table, 1, canon);
map_char_table (set_canon, Qnil, table, table);
}
@@ -143,11 +143,11 @@ set_case_table (Lisp_Object table, int standard)
eqv = Fmake_char_table (Qcase_table, Qnil);
map_char_table (set_identity, Qnil, canon, eqv);
map_char_table (shuffle, Qnil, canon, eqv);
- XCHAR_TABLE (table)->extras[2] = eqv;
+ set_char_table_extras (table, 2, eqv);
}
/* This is so set_image_of_range_1 in regex.c can find the EQV table. */
- XCHAR_TABLE (canon)->extras[2] = eqv;
+ set_char_table_extras (canon, 2, eqv);
if (standard)
{
@@ -158,10 +158,10 @@ set_case_table (Lisp_Object table, int standard)
}
else
{
- BVAR (current_buffer, downcase_table) = table;
- BVAR (current_buffer, upcase_table) = up;
- BVAR (current_buffer, case_canon_table) = canon;
- BVAR (current_buffer, case_eqv_table) = eqv;
+ bset_downcase_table (current_buffer, table);
+ bset_upcase_table (current_buffer, up);
+ bset_case_canon_table (current_buffer, canon);
+ bset_case_eqv_table (current_buffer, eqv);
}
return table;
@@ -194,8 +194,7 @@ set_identity (Lisp_Object table, Lisp_Object c, Lisp_Object elt)
{
if (NATNUMP (elt))
{
- int from;
- unsigned to;
+ int from, to;
if (CONSP (c))
{
@@ -204,7 +203,10 @@ set_identity (Lisp_Object table, Lisp_Object c, Lisp_Object elt)
}
else
from = to = XINT (c);
- for (to++; from < to; from++)
+
+ to++;
+ lint_assume (to <= MAX_CHAR + 1);
+ for (; from < to; from++)
CHAR_TABLE_SET (table, from, make_number (from));
}
}
@@ -219,8 +221,7 @@ shuffle (Lisp_Object table, Lisp_Object c, Lisp_Object elt)
{
if (NATNUMP (elt))
{
- int from;
- unsigned to;
+ int from, to;
if (CONSP (c))
{
@@ -230,7 +231,9 @@ shuffle (Lisp_Object table, Lisp_Object c, Lisp_Object elt)
else
from = to = XINT (c);
- for (to++; from < to; from++)
+ to++;
+ lint_assume (to <= MAX_CHAR + 1);
+ for (; from < to; from++)
{
Lisp_Object tem = Faref (table, elt);
Faset (table, elt, make_number (from));
@@ -257,7 +260,7 @@ init_casetab_once (void)
down = Fmake_char_table (Qcase_table, Qnil);
Vascii_downcase_table = down;
- XCHAR_TABLE (down)->purpose = Qcase_table;
+ set_char_table_purpose (down, Qcase_table);
for (i = 0; i < 128; i++)
{
@@ -265,10 +268,10 @@ init_casetab_once (void)
CHAR_TABLE_SET (down, i, make_number (c));
}
- XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down);
+ set_char_table_extras (down, 1, Fcopy_sequence (down));
up = Fmake_char_table (Qcase_table, Qnil);
- XCHAR_TABLE (down)->extras[0] = up;
+ set_char_table_extras (down, 0, up);
for (i = 0; i < 128; i++)
{
@@ -278,7 +281,7 @@ init_casetab_once (void)
CHAR_TABLE_SET (up, i, make_number (c));
}
- XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up);
+ set_char_table_extras (down, 2, Fcopy_sequence (up));
/* Fill in what isn't filled in. */
set_case_table (down, 1);
diff --git a/src/category.c b/src/category.c
index a822bb654b0..31cc90bca68 100644
--- a/src/category.c
+++ b/src/category.c
@@ -1,6 +1,6 @@
/* GNU Emacs routines to deal with category tables.
-Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
@@ -29,15 +29,23 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
table. Read comments in the file category.h to understand them. */
#include <config.h>
-#include <ctype.h>
-#include <setjmp.h>
+
+#define CATEGORY_INLINE EXTERN_INLINE
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "category.h"
#include "keymap.h"
+/* This setter is used only in this file, so it can be private. */
+static void
+bset_category_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (category_table) = val;
+}
+
/* The version number of the latest category table. Each category
table has a unique version number. It is assigned a new number
also when it is modified. When a regular expression is compiled
@@ -50,9 +58,6 @@ static int category_table_version;
static Lisp_Object Qcategory_table, Qcategoryp, Qcategorysetp, Qcategory_table_p;
-/* Temporary internal variable used in macro CHAR_HAS_CATEGORY. */
-Lisp_Object _temp_category_set;
-
/* Make CATEGORY_SET includes (if VAL is t) or excludes (if VAL is
nil) CATEGORY. */
#define SET_CATEGORY_SET(category_set, category, val) \
@@ -71,11 +76,12 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
EMACS_UINT hash;
if (NILP (XCHAR_TABLE (table)->extras[1]))
- XCHAR_TABLE (table)->extras[1]
- = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
- make_float (DEFAULT_REHASH_SIZE),
- make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil, Qnil, Qnil);
+ set_char_table_extras
+ (table, 1,
+ make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
+ make_float (DEFAULT_REHASH_SIZE),
+ make_float (DEFAULT_REHASH_THRESHOLD),
+ Qnil));
h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
i = hash_lookup (h, category_set, &hash);
if (i >= 0)
@@ -136,7 +142,7 @@ the current buffer's category table. */)
error ("Category `%c' is already defined", (int) XFASTINT (category));
if (!NILP (Vpurify_flag))
docstring = Fpurecopy (docstring);
- CATEGORY_DOCSTRING (table, XFASTINT (category)) = docstring;
+ SET_CATEGORY_DOCSTRING (table, XFASTINT (category), docstring);
return Qnil;
}
@@ -238,10 +244,10 @@ copy_category_table (Lisp_Object table)
table = copy_char_table (table);
if (! NILP (XCHAR_TABLE (table)->defalt))
- XCHAR_TABLE (table)->defalt
- = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
- XCHAR_TABLE (table)->extras[0]
- = Fcopy_sequence (XCHAR_TABLE (table)->extras[0]);
+ set_char_table_defalt (table,
+ Fcopy_sequence (XCHAR_TABLE (table)->defalt));
+ set_char_table_extras
+ (table, 0, Fcopy_sequence (XCHAR_TABLE (table)->extras[0]));
map_char_table (copy_category_entry, Qnil, table, table);
return table;
@@ -270,9 +276,9 @@ DEFUN ("make-category-table", Fmake_category_table, Smake_category_table,
int i;
val = Fmake_char_table (Qcategory_table, Qnil);
- XCHAR_TABLE (val)->defalt = MAKE_CATEGORY_SET;
+ set_char_table_defalt (val, MAKE_CATEGORY_SET);
for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
- XCHAR_TABLE (val)->contents[i] = MAKE_CATEGORY_SET;
+ set_char_table_contents (val, i, MAKE_CATEGORY_SET);
Fset_char_table_extra_slot (val, make_number (0),
Fmake_vector (make_number (95), Qnil));
return val;
@@ -285,7 +291,7 @@ Return TABLE. */)
{
int idx;
table = check_category_table (table);
- BVAR (current_buffer, category_table) = table;
+ bset_category_table (current_buffer, table);
/* Indicate that this buffer now has a specified category table. */
idx = PER_BUFFER_VAR_IDX (category_table);
SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1);
@@ -304,7 +310,7 @@ DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0,
usage: (char-category-set CHAR) */)
(Lisp_Object ch)
{
- CHECK_NUMBER (ch);
+ CHECK_CHARACTER (ch);
return CATEGORY_SET (XFASTINT (ch));
}
@@ -399,17 +405,17 @@ then delete CATEGORY from the category set instead of adding it. */)
return Qnil;
}
-/* Return 1 if there is a word boundary between two word-constituent
- characters C1 and C2 if they appear in this order, else return 0.
+/* Return true if there is a word boundary between two word-constituent
+ characters C1 and C2 if they appear in this order.
Use the macro WORD_BOUNDARY_P instead of calling this function
directly. */
-int
+bool
word_boundary_p (int c1, int c2)
{
Lisp_Object category_set1, category_set2;
Lisp_Object tail;
- int default_result;
+ bool default_result;
if (EQ (CHAR_TABLE_REF (Vchar_script_table, c1),
CHAR_TABLE_REF (Vchar_script_table, c2)))
@@ -466,7 +472,7 @@ init_category_once (void)
Vstandard_category_table = Fmake_char_table (Qcategory_table, Qnil);
/* Set a category set which contains nothing to the default. */
- XCHAR_TABLE (Vstandard_category_table)->defalt = MAKE_CATEGORY_SET;
+ set_char_table_defalt (Vstandard_category_table, MAKE_CATEGORY_SET);
Fset_char_table_extra_slot (Vstandard_category_table, make_number (0),
Fmake_vector (make_number (95), Qnil));
}
diff --git a/src/category.h b/src/category.h
index 737198cc964..17cd203db45 100644
--- a/src/category.h
+++ b/src/category.h
@@ -1,6 +1,6 @@
/* Declarations having to do with Emacs category tables.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008, 2009, 2010, 2011
+ 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
Copyright (C) 2003
@@ -53,8 +53,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
The second extra slot is a version number of the category table.
But, for the moment, we are not using this slot. */
-#define CATEGORYP(x) \
- (INTEGERP ((x)) && XFASTINT ((x)) >= 0x20 && XFASTINT ((x)) <= 0x7E)
+INLINE_HEADER_BEGIN
+#ifndef CATEGORY_INLINE
+# define CATEGORY_INLINE INLINE
+#endif
+
+#define CATEGORYP(x) RANGED_INTEGERP (0x20, x, 0x7E)
#define CHECK_CATEGORY(x) \
CHECK_TYPE (CATEGORYP (x), Qcategoryp, x)
@@ -70,42 +74,48 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define CHECK_CATEGORY_SET(x) \
CHECK_TYPE (CATEGORY_SET_P (x), Qcategorysetp, x)
-/* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
+/* Return the category set of character C in the current category table. */
+#define CATEGORY_SET(c) char_category_set (c)
+
+/* Return true if CATEGORY_SET contains CATEGORY.
The faster version of `!NILP (Faref (category_set, category))'. */
#define CATEGORY_MEMBER(category, category_set) \
- (XCATEGORY_SET (category_set)->data[(category) / 8] \
- & (1 << ((category) % 8)))
-
-/* Temporary internal variable used in macro CHAR_HAS_CATEGORY. */
-extern Lisp_Object _temp_category_set;
+ ((XCATEGORY_SET (category_set)->data[(category) / 8] \
+ >> ((category) % 8)) & 1)
-/* Return 1 if category set of CH contains CATEGORY, elt return 0. */
-#define CHAR_HAS_CATEGORY(ch, category) \
- (_temp_category_set = CATEGORY_SET (ch), \
- CATEGORY_MEMBER (category, _temp_category_set))
+/* Return true if category set of CH contains CATEGORY. */
+CATEGORY_INLINE bool
+CHAR_HAS_CATEGORY (int ch, int category)
+{
+ Lisp_Object category_set = CATEGORY_SET (ch);
+ return CATEGORY_MEMBER (category, category_set);
+}
/* The standard category table is stored where it will automatically
be used in all new buffers. */
#define Vstandard_category_table BVAR (&buffer_defaults, category_table)
-/* Return the category set of character C in the current category table. */
-#define CATEGORY_SET(c) char_category_set (c)
-
/* Return the doc string of CATEGORY in category table TABLE. */
-#define CATEGORY_DOCSTRING(table, category) \
- XVECTOR (Fchar_table_extra_slot (table, make_number (0)))->contents[(category) - ' ']
+#define CATEGORY_DOCSTRING(table, category) \
+ AREF (Fchar_table_extra_slot (table, make_number (0)), ((category) - ' '))
+
+/* Set the doc string of CATEGORY to VALUE in category table TABLE. */
+#define SET_CATEGORY_DOCSTRING(table, category, value) \
+ ASET (Fchar_table_extra_slot (table, make_number (0)), ((category) - ' '), value)
/* Return the version number of category table TABLE. Not used for
the moment. */
#define CATEGORY_TABLE_VERSION (table) \
Fchar_table_extra_slot (table, make_number (1))
-/* Return 1 if there is a word boundary between two word-constituent
- characters C1 and C2 if they appear in this order, else return 0.
+/* Return true if there is a word boundary between two
+ word-constituent characters C1 and C2 if they appear in this order.
There is no word boundary between two word-constituent ASCII and
Latin-1 characters. */
#define WORD_BOUNDARY_P(c1, c2) \
(!(SINGLE_BYTE_CHAR_P (c1) && SINGLE_BYTE_CHAR_P (c2)) \
&& word_boundary_p (c1, c2))
-extern int word_boundary_p (int, int);
+extern bool word_boundary_p (int, int);
+
+INLINE_HEADER_END
diff --git a/src/ccl.c b/src/ccl.c
index 65a6dcfcb85..34cc1c98eea 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -1,5 +1,5 @@
/* CCL (Code Conversion Language) interpreter.
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
@@ -26,7 +26,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include <limits.h>
#include "lisp.h"
@@ -61,7 +60,7 @@ static Lisp_Object Vccl_program_table;
/* Return a hash table of id number ID. */
#define GET_HASH_TABLE(id) \
- (XHASH_TABLE (XCDR (XVECTOR (Vtranslation_hash_table_vector)->contents[(id)])))
+ (XHASH_TABLE (XCDR (AREF (Vtranslation_hash_table_vector, (id)))))
/* CCL (Code Conversion Language) is a simple language which has
operations on one input buffer, one output buffer, and 7 registers.
@@ -762,9 +761,6 @@ while (0)
#define GET_CCL_CODE(code, ccl_prog, ic) \
GET_CCL_RANGE (code, ccl_prog, ic, CCL_CODE_MIN, CCL_CODE_MAX)
-#define GET_CCL_INT(var, ccl_prog, ic) \
- GET_CCL_RANGE (var, ccl_prog, ic, INT_MIN, INT_MAX)
-
#define IN_INT_RANGE(val) ASCENDING_ORDER (INT_MIN, val, INT_MAX)
/* Encode one character CH to multibyte form and write to the current
@@ -945,14 +941,14 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
break;
case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
- GET_CCL_INT (reg[rrr], ccl_prog, ic++);
+ reg[rrr] = XINT (ccl_prog[ic++]);
break;
case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
i = reg[RRR];
j = field1 >> 3;
if (0 <= i && i < j)
- GET_CCL_INT (reg[rrr], ccl_prog, ic + i);
+ reg[rrr] = XINT (ccl_prog[ic + i]);
ic += j;
break;
@@ -980,13 +976,13 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
break;
case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
- GET_CCL_INT (i, ccl_prog, ic);
+ i = XINT (ccl_prog[ic]);
CCL_WRITE_CHAR (i);
ic += ADDR;
break;
case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
- GET_CCL_INT (i, ccl_prog, ic);
+ i = XINT (ccl_prog[ic]);
CCL_WRITE_CHAR (i);
ic++;
CCL_READ_CHAR (reg[rrr]);
@@ -994,17 +990,17 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
break;
case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
- GET_CCL_INT (j, ccl_prog, ic++);
+ j = XINT (ccl_prog[ic++]);
CCL_WRITE_STRING (j);
ic += ADDR - 1;
break;
case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
i = reg[rrr];
- GET_CCL_INT (j, ccl_prog, ic);
+ j = XINT (ccl_prog[ic]);
if (0 <= i && i < j)
{
- GET_CCL_INT (i, ccl_prog, ic + 1 + i);
+ i = XINT (ccl_prog[ic + 1 + i]);
CCL_WRITE_CHAR (i);
}
ic += j + 2;
@@ -1022,11 +1018,8 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
/* fall through ... */
case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
{
- int incr;
- GET_CCL_INT (incr, ccl_prog,
- ic + (0 <= reg[rrr] && reg[rrr] < field1
- ? reg[rrr]
- : field1));
+ int ioff = 0 <= reg[rrr] && reg[rrr] < field1 ? reg[rrr] : field1;
+ int incr = XINT (ccl_prog[ic + ioff]);
ic += incr;
}
break;
@@ -1045,7 +1038,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
rrr = 7;
i = reg[RRR];
- GET_CCL_INT (j, ccl_prog, ic);
+ j = XINT (ccl_prog[ic]);
op = field1 >> 6;
jump_address = ic + 1;
goto ccl_set_expr;
@@ -1078,7 +1071,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
/* If FFF is nonzero, the CCL program ID is in the
following code. */
if (rrr)
- GET_CCL_INT (prog_id, ccl_prog, ic++);
+ prog_id = XINT (ccl_prog[ic++]);
else
prog_id = field1;
@@ -1121,7 +1114,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
i = reg[rrr];
if (0 <= i && i < field1)
{
- GET_CCL_INT (j, ccl_prog, ic + i);
+ j = XINT (ccl_prog[ic + i]);
CCL_WRITE_CHAR (j);
}
ic += field1;
@@ -1146,7 +1139,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
CCL_SUCCESS;
case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
- GET_CCL_INT (i, ccl_prog, ic++);
+ i = XINT (ccl_prog[ic++]);
op = field1 >> 6;
goto ccl_expr_self;
@@ -1182,7 +1175,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
i = reg[RRR];
- GET_CCL_INT (j, ccl_prog, ic++);
+ j = XINT (ccl_prog[ic++]);
op = field1 >> 6;
jump_address = ic;
goto ccl_set_expr;
@@ -1199,8 +1192,8 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
i = reg[rrr];
jump_address = ic + ADDR;
- GET_CCL_INT (op, ccl_prog, ic++);
- GET_CCL_INT (j, ccl_prog, ic++);
+ op = XINT (ccl_prog[ic++]);
+ j = XINT (ccl_prog[ic++]);
rrr = 7;
goto ccl_set_expr;
@@ -1209,7 +1202,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_JumpCondExprReg:
i = reg[rrr];
jump_address = ic + ADDR;
- GET_CCL_INT (op, ccl_prog, ic++);
+ op = XINT (ccl_prog[ic++]);
GET_CCL_RANGE (j, ccl_prog, ic++, 0, 7);
j = reg[j];
rrr = 7;
@@ -1290,7 +1283,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_TranslateCharacterConstTbl:
{
- EMACS_INT eop;
+ ptrdiff_t eop;
GET_CCL_RANGE (eop, ccl_prog, ic++, 0,
(VECTORP (Vtranslation_table_vector)
? ASIZE (Vtranslation_table_vector)
@@ -1356,10 +1349,11 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_IterateMultipleMap:
{
Lisp_Object map, content, attrib, value;
- EMACS_INT point, size;
+ EMACS_INT point;
+ ptrdiff_t size;
int fin_ic;
- GET_CCL_INT (j, ccl_prog, ic++); /* number of maps. */
+ j = XINT (ccl_prog[ic++]); /* number of maps. */
fin_ic = ic + j;
op = reg[rrr];
if ((j > reg[RRR]) && (j >= 0))
@@ -1376,7 +1370,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
for (;i < j;i++)
{
-
+ if (!VECTORP (Vcode_conversion_map_vector)) continue;
size = ASIZE (Vcode_conversion_map_vector);
point = XINT (ccl_prog[ic++]);
if (! (0 <= point && point < size)) continue;
@@ -1452,7 +1446,8 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_MapMultiple:
{
Lisp_Object map, content, attrib, value;
- int point, size, map_vector_size;
+ EMACS_INT point;
+ ptrdiff_t size, map_vector_size;
int map_set_rest_length, fin_ic;
int current_ic = this_ic;
@@ -1471,7 +1466,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
stack_idx_of_map_multiple = 0;
/* Get number of maps and separators. */
- GET_CCL_INT (map_set_rest_length, ccl_prog, ic++);
+ map_set_rest_length = XINT (ccl_prog[ic++]);
fin_ic = ic + map_set_rest_length;
op = reg[rrr];
@@ -1535,12 +1530,14 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
break;
}
}
+ if (!VECTORP (Vcode_conversion_map_vector))
+ CCL_INVALID_CMD;
map_vector_size = ASIZE (Vcode_conversion_map_vector);
do {
for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
{
- GET_CCL_INT (point, ccl_prog, ic);
+ point = XINT (ccl_prog[ic]);
if (point < 0)
{
/* +1 is for including separator. */
@@ -1657,7 +1654,8 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
int point;
j = XINT (ccl_prog[ic++]); /* map_id */
op = reg[rrr];
- if (j >= ASIZE (Vcode_conversion_map_vector))
+ if (! (VECTORP (Vcode_conversion_map_vector)
+ && j < ASIZE (Vcode_conversion_map_vector)))
{
reg[RRR] = -1;
break;
@@ -1670,6 +1668,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
}
map = XCDR (map);
if (! (VECTORP (map)
+ && 0 < ASIZE (map)
&& INTEGERP (AREF (map, 0))
&& XINT (AREF (map, 0)) <= op
&& op - XINT (AREF (map, 0)) + 1 < ASIZE (map)))
@@ -1677,20 +1676,20 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
reg[RRR] = -1;
break;
}
- point = XINT (AREF (map, 0));
- point = op - point + 1;
+ point = op - XINT (AREF (map, 0)) + 1;
reg[RRR] = 0;
content = AREF (map, point);
if (NILP (content))
reg[RRR] = -1;
- else if (INTEGERP (content))
+ else if (TYPE_RANGED_INTEGERP (int, content))
reg[rrr] = XINT (content);
else if (EQ (content, Qt));
else if (CONSP (content))
{
attrib = XCAR (content);
value = XCDR (content);
- if (!INTEGERP (attrib) || !INTEGERP (value))
+ if (!INTEGERP (attrib)
+ || !TYPE_RANGED_INTEGERP (int, value))
continue;
reg[rrr] = XINT (value);
break;
@@ -1729,14 +1728,14 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
switch (ccl->status)
{
case CCL_STAT_INVALID_CMD:
- sprintf (msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
- code & 0x1F, code, this_ic);
+ msglen = sprintf (msg,
+ "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
+ code & 0x1F, code, this_ic);
#ifdef CCL_DEBUG
{
int i = ccl_backtrace_idx - 1;
int j;
- msglen = strlen (msg);
if (dst + msglen <= (dst_bytes ? dst_end : src))
{
memcpy (dst, msg, msglen);
@@ -1748,8 +1747,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
if (ccl_backtrace_table[i] == 0)
break;
- sprintf (msg, " %d", ccl_backtrace_table[i]);
- msglen = strlen (msg);
+ msglen = sprintf (msg, " %d", ccl_backtrace_table[i]);
if (dst + msglen > (dst_bytes ? dst_end : src))
break;
memcpy (dst, msg, msglen);
@@ -1761,15 +1759,13 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
break;
case CCL_STAT_QUIT:
- if (! ccl->quit_silently)
- sprintf (msg, "\nCCL: Quitted.");
+ msglen = ccl->quit_silently ? 0 : sprintf (msg, "\nCCL: Quitted.");
break;
default:
- sprintf (msg, "\nCCL: Unknown error type (%d)", ccl->status);
+ msglen = sprintf (msg, "\nCCL: Unknown error type (%d)", ccl->status);
}
- msglen = strlen (msg);
if (msglen <= dst_end - dst)
{
for (i = 0; i < msglen; i++)
@@ -1810,8 +1806,8 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
function converts symbols of code conversion maps and character
translation tables embedded in the CCL code into their ID numbers.
- The return value is a vector (CCL itself or a new vector in which
- all symbols are resolved), Qt if resolving of some symbol failed,
+ The return value is a new vector in which all symbols are resolved,
+ Qt if resolving of some symbol failed,
or nil if CCL contains invalid data. */
static Lisp_Object
@@ -1820,13 +1816,15 @@ resolve_symbol_ccl_program (Lisp_Object ccl)
int i, veclen, unresolved = 0;
Lisp_Object result, contents, val;
- result = ccl;
+ if (! (CCL_HEADER_MAIN < ASIZE (ccl) && ASIZE (ccl) <= INT_MAX))
+ return Qnil;
+ result = Fcopy_sequence (ccl);
veclen = ASIZE (result);
for (i = 0; i < veclen; i++)
{
contents = AREF (result, i);
- if (INTEGERP (contents))
+ if (TYPE_RANGED_INTEGERP (int, contents))
continue;
else if (CONSP (contents)
&& SYMBOLP (XCAR (contents))
@@ -1835,12 +1833,8 @@ resolve_symbol_ccl_program (Lisp_Object ccl)
/* This is the new style for embedding symbols. The form is
(SYMBOL . PROPERTY). (get SYMBOL PROPERTY) should give
an index number. */
-
- if (EQ (result, ccl))
- result = Fcopy_sequence (ccl);
-
val = Fget (XCAR (contents), XCDR (contents));
- if (NATNUMP (val))
+ if (RANGED_INTEGERP (0, val, INT_MAX))
ASET (result, i, val);
else
unresolved = 1;
@@ -1851,21 +1845,18 @@ resolve_symbol_ccl_program (Lisp_Object ccl)
/* This is the old style for embedding symbols. This style
may lead to a bug if, for instance, a translation table
and a code conversion map have the same name. */
- if (EQ (result, ccl))
- result = Fcopy_sequence (ccl);
-
val = Fget (contents, Qtranslation_table_id);
- if (NATNUMP (val))
+ if (RANGED_INTEGERP (0, val, INT_MAX))
ASET (result, i, val);
else
{
val = Fget (contents, Qcode_conversion_map_id);
- if (NATNUMP (val))
+ if (RANGED_INTEGERP (0, val, INT_MAX))
ASET (result, i, val);
else
{
val = Fget (contents, Qccl_program_idx);
- if (NATNUMP (val))
+ if (RANGED_INTEGERP (0, val, INT_MAX))
ASET (result, i, val);
else
unresolved = 1;
@@ -1876,6 +1867,11 @@ resolve_symbol_ccl_program (Lisp_Object ccl)
return Qnil;
}
+ if (! (0 <= XINT (AREF (result, CCL_HEADER_BUF_MAG))
+ && ASCENDING_ORDER (0, XINT (AREF (result, CCL_HEADER_EOF)),
+ ASIZE (ccl))))
+ return Qnil;
+
return (unresolved ? Qt : result);
}
@@ -1886,7 +1882,7 @@ resolve_symbol_ccl_program (Lisp_Object ccl)
symbols, return Qnil. */
static Lisp_Object
-ccl_get_compiled_code (Lisp_Object ccl_prog, int *idx)
+ccl_get_compiled_code (Lisp_Object ccl_prog, ptrdiff_t *idx)
{
Lisp_Object val, slot;
@@ -2015,7 +2011,7 @@ programs. */)
error ("Length of vector REGISTERS is not 8");
for (i = 0; i < 8; i++)
- ccl.reg[i] = (INTEGERP (AREF (reg, i))
+ ccl.reg[i] = (TYPE_RANGED_INTEGERP (int, AREF (reg, i))
? XINT (AREF (reg, i))
: 0);
@@ -2084,7 +2080,7 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY
{
if (NILP (AREF (status, i)))
ASET (status, i, make_number (0));
- if (INTEGERP (AREF (status, i)))
+ if (TYPE_RANGED_INTEGERP (int, AREF (status, i)))
ccl.reg[i] = XINT (AREF (status, i));
}
if (INTEGERP (AREF (status, i)))
@@ -2101,7 +2097,7 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY
outbufsize = (ccl.buf_magnification
? str_bytes * ccl.buf_magnification + 256
: str_bytes + 256);
- outp = outbuf = (unsigned char *) xmalloc (outbufsize);
+ outp = outbuf = xmalloc (outbufsize);
consumed_chars = consumed_bytes = 0;
produced_chars = 0;
@@ -2187,8 +2183,8 @@ If it is nil, just reserve NAME as a CCL program name.
Return index number of the registered CCL program. */)
(Lisp_Object name, Lisp_Object ccl_prog)
{
- int len = ASIZE (Vccl_program_table);
- int idx;
+ ptrdiff_t len = ASIZE (Vccl_program_table);
+ ptrdiff_t idx;
Lisp_Object resolved;
CHECK_SYMBOL (name);
@@ -2229,7 +2225,7 @@ Return index number of the registered CCL program. */)
if (idx == len)
/* Extend the table. */
- Vccl_program_table = larger_vector (Vccl_program_table, len * 2, Qnil);
+ Vccl_program_table = larger_vector (Vccl_program_table, 1, -1);
{
Lisp_Object elt;
@@ -2262,12 +2258,16 @@ DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
Return index number of the registered map. */)
(Lisp_Object symbol, Lisp_Object map)
{
- int len = ASIZE (Vcode_conversion_map_vector);
- int i;
+ ptrdiff_t len;
+ ptrdiff_t i;
Lisp_Object idx;
CHECK_SYMBOL (symbol);
CHECK_VECTOR (map);
+ if (! VECTORP (Vcode_conversion_map_vector))
+ error ("Invalid code-conversion-map-vector");
+
+ len = ASIZE (Vcode_conversion_map_vector);
for (i = 0; i < len; i++)
{
@@ -2288,7 +2288,7 @@ Return index number of the registered map. */)
if (i == len)
Vcode_conversion_map_vector = larger_vector (Vcode_conversion_map_vector,
- len * 2, Qnil);
+ 1, -1);
idx = make_number (i);
Fput (symbol, Qcode_conversion_map, map);
diff --git a/src/ccl.h b/src/ccl.h
index e86154352a3..cc5daf11e1c 100644
--- a/src/ccl.h
+++ b/src/ccl.h
@@ -1,6 +1,6 @@
/* Header for CCL (Code Conversion Language) interpreter.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008, 2009, 2010, 2011
+ 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
Copyright (C) 2003
@@ -26,6 +26,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef EMACS_CCL_H
#define EMACS_CCL_H
+#include "character.h" /* For MAX_MULTIBYTE_LENGTH */
+
/* Macros for exit status of CCL program. */
#define CCL_STAT_SUCCESS 0 /* Terminated successfully. */
#define CCL_STAT_SUSPEND_BY_SRC 1 /* Terminated by empty input. */
@@ -37,7 +39,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Structure to hold information about running CCL code. Read
comments in the file ccl.c for the detail of each field. */
struct ccl_program {
- int idx; /* Index number of the CCL program.
+ ptrdiff_t idx; /* Index number of the CCL program.
-1 means that the program was given
by a vector, not by a program
name. */
@@ -101,8 +103,6 @@ extern void ccl_driver (struct ccl_program *, int *, int *, int, int,
extern Lisp_Object Qccl, Qcclp;
-EXFUN (Fccl_program_p, 1);
-
#define CHECK_CCL_PROGRAM(x) \
do { \
if (NILP (Fccl_program_p (x))) \
diff --git a/src/character.c b/src/character.c
index 88b1f11b96b..5808d48a235 100644
--- a/src/character.c
+++ b/src/character.c
@@ -1,6 +1,6 @@
/* Basic character support.
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
Copyright (C) 1995, 1997, 1998, 2001 Electrotechnical Laboratory, JAPAN.
Licensed to the Free Software Foundation.
Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
@@ -29,12 +29,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#endif
+#define CHARACTER_INLINE EXTERN_INLINE
+
#include <stdio.h>
#ifdef emacs
#include <sys/types.h>
-#include <setjmp.h>
#include <intprops.h>
#include "lisp.h"
#include "character.h"
@@ -57,9 +58,6 @@ static Lisp_Object Qauto_fill_chars;
Unicode character. Mainly used by the macro MAYBE_UNIFY_CHAR. */
Lisp_Object Vchar_unify_table;
-/* Variable used locally in the macro FETCH_MULTIBYTE_CHAR. */
-unsigned char *_fetch_multibyte_char_p;
-
static Lisp_Object Qchar_script_table;
@@ -67,8 +65,8 @@ static Lisp_Object Qchar_script_table;
/* If character code C has modifier masks, reflect them to the
character code if possible. Return the resulting code. */
-int
-char_resolve_modifier_mask (int c)
+EMACS_INT
+char_resolve_modifier_mask (EMACS_INT c)
{
/* A non-ASCII character can't reflect modifier bits to the code. */
if (! ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
@@ -128,8 +126,6 @@ char_string (unsigned int c, unsigned char *p)
c &= ~CHAR_MODIFIER_MASK;
}
- MAYBE_UNIFY_CHAR (c);
-
if (c <= MAX_3_BYTE_CHAR)
{
bytes = CHAR_STRING (c, p);
@@ -197,8 +193,6 @@ string_char (const unsigned char *p, const unsigned char **advanced, int *len)
p += 5;
}
- MAYBE_UNIFY_CHAR (c);
-
if (len)
*len = p - saved_p;
if (advanced)
@@ -259,6 +253,9 @@ multibyte_char_to_unibyte_safe (int c)
DEFUN ("characterp", Fcharacterp, Scharacterp, 1, 2, 0,
doc: /* Return non-nil if OBJECT is a character.
+In Emacs Lisp, characters are represented by character codes, which
+are non-negative integers. The function `max-char' returns the
+maximum character code.
usage: (characterp OBJECT) */)
(Lisp_Object object, Lisp_Object ignore)
{
@@ -308,6 +305,36 @@ If the multibyte character does not represent a byte, return -1. */)
}
}
+
+/* Return width (columns) of C considering the buffer display table DP. */
+
+static ptrdiff_t
+char_width (int c, struct Lisp_Char_Table *dp)
+{
+ ptrdiff_t width = CHAR_WIDTH (c);
+
+ if (dp)
+ {
+ Lisp_Object disp = DISP_CHAR_VECTOR (dp, c), ch;
+ int i;
+
+ if (VECTORP (disp))
+ for (i = 0, width = 0; i < ASIZE (disp); i++)
+ {
+ ch = AREF (disp, i);
+ if (CHARACTERP (ch))
+ {
+ int w = CHAR_WIDTH (XFASTINT (ch));
+ if (INT_ADD_OVERFLOW (width, w))
+ string_overflow ();
+ width += w;
+ }
+ }
+ }
+ return width;
+}
+
+
DEFUN ("char-width", Fchar_width, Schar_width, 1, 1, 0,
doc: /* Return width of CHAR when displayed in the current buffer.
The width is measured by how many columns it occupies on the screen.
@@ -315,21 +342,12 @@ Tab is taken to occupy `tab-width' columns.
usage: (char-width CHAR) */)
(Lisp_Object ch)
{
- Lisp_Object disp;
- int c, width;
- struct Lisp_Char_Table *dp = buffer_display_table ();
+ int c;
+ ptrdiff_t width;
CHECK_CHARACTER (ch);
c = XINT (ch);
-
- /* Get the way the display table would display it. */
- disp = dp ? DISP_CHAR_VECTOR (dp, c) : Qnil;
-
- if (VECTORP (disp))
- width = sanitize_char_width (ASIZE (disp));
- else
- width = CHAR_WIDTH (c);
-
+ width = char_width (c, buffer_display_table ());
return make_number (width);
}
@@ -340,35 +358,26 @@ usage: (char-width CHAR) */)
characters and bytes of the substring in *NCHARS and *NBYTES
respectively. */
-EMACS_INT
-c_string_width (const unsigned char *str, EMACS_INT len, int precision,
- EMACS_INT *nchars, EMACS_INT *nbytes)
+ptrdiff_t
+c_string_width (const unsigned char *str, ptrdiff_t len, int precision,
+ ptrdiff_t *nchars, ptrdiff_t *nbytes)
{
- EMACS_INT i = 0, i_byte = 0;
- EMACS_INT width = 0;
+ ptrdiff_t i = 0, i_byte = 0;
+ ptrdiff_t width = 0;
struct Lisp_Char_Table *dp = buffer_display_table ();
while (i_byte < len)
{
- int bytes, thiswidth;
- Lisp_Object val;
+ int bytes;
int c = STRING_CHAR_AND_LENGTH (str + i_byte, bytes);
+ ptrdiff_t thiswidth = char_width (c, dp);
- if (dp)
- {
- val = DISP_CHAR_VECTOR (dp, c);
- if (VECTORP (val))
- thiswidth = sanitize_char_width (ASIZE (val));
- else
- thiswidth = CHAR_WIDTH (c);
- }
- else
+ if (precision <= 0)
{
- thiswidth = CHAR_WIDTH (c);
+ if (INT_ADD_OVERFLOW (width, thiswidth))
+ string_overflow ();
}
-
- if (precision > 0
- && (width + thiswidth > precision))
+ else if (precision - width < thiswidth)
{
*nchars = i;
*nbytes = i_byte;
@@ -392,8 +401,8 @@ c_string_width (const unsigned char *str, EMACS_INT len, int precision,
current buffer. The width is measured by how many columns it
occupies on the screen. */
-EMACS_INT
-strwidth (const char *str, EMACS_INT len)
+ptrdiff_t
+strwidth (const char *str, ptrdiff_t len)
{
return c_string_width ((const unsigned char *) str, len, -1, NULL, NULL);
}
@@ -405,26 +414,26 @@ strwidth (const char *str, EMACS_INT len)
PRECISION, and set number of characters and bytes of the substring
in *NCHARS and *NBYTES respectively. */
-EMACS_INT
-lisp_string_width (Lisp_Object string, EMACS_INT precision,
- EMACS_INT *nchars, EMACS_INT *nbytes)
+ptrdiff_t
+lisp_string_width (Lisp_Object string, ptrdiff_t precision,
+ ptrdiff_t *nchars, ptrdiff_t *nbytes)
{
- EMACS_INT len = SCHARS (string);
+ ptrdiff_t len = SCHARS (string);
/* This set multibyte to 0 even if STRING is multibyte when it
contains only ascii and eight-bit-graphic, but that's
intentional. */
- int multibyte = len < SBYTES (string);
+ bool multibyte = len < SBYTES (string);
unsigned char *str = SDATA (string);
- EMACS_INT i = 0, i_byte = 0;
- EMACS_INT width = 0;
+ ptrdiff_t i = 0, i_byte = 0;
+ ptrdiff_t width = 0;
struct Lisp_Char_Table *dp = buffer_display_table ();
while (i < len)
{
- EMACS_INT chars, bytes, thiswidth;
+ ptrdiff_t chars, bytes, thiswidth;
Lisp_Object val;
ptrdiff_t cmp_id;
- EMACS_INT ignore, end;
+ ptrdiff_t ignore, end;
if (find_composition (i, -1, &ignore, &end, &val, string)
&& ((cmp_id = get_composition_id (i, i_byte, end - i, val, string))
@@ -447,18 +456,7 @@ lisp_string_width (Lisp_Object string, EMACS_INT precision,
else
c = str[i_byte], bytes = 1;
chars = 1;
- if (dp)
- {
- val = DISP_CHAR_VECTOR (dp, c);
- if (VECTORP (val))
- thiswidth = sanitize_char_width (ASIZE (val));
- else
- thiswidth = CHAR_WIDTH (c);
- }
- else
- {
- thiswidth = CHAR_WIDTH (c);
- }
+ thiswidth = char_width (c, dp);
}
if (precision <= 0)
@@ -511,8 +509,8 @@ usage: (string-width STRING) */)
However, if the current buffer has enable-multibyte-characters =
nil, we treat each byte as a character. */
-EMACS_INT
-chars_in_text (const unsigned char *ptr, EMACS_INT nbytes)
+ptrdiff_t
+chars_in_text (const unsigned char *ptr, ptrdiff_t nbytes)
{
/* current_buffer is null at early stages of Emacs initialization. */
if (current_buffer == 0
@@ -527,18 +525,18 @@ chars_in_text (const unsigned char *ptr, EMACS_INT nbytes)
sequences while assuming that there's no invalid sequence. It
ignores enable-multibyte-characters. */
-EMACS_INT
-multibyte_chars_in_text (const unsigned char *ptr, EMACS_INT nbytes)
+ptrdiff_t
+multibyte_chars_in_text (const unsigned char *ptr, ptrdiff_t nbytes)
{
const unsigned char *endp = ptr + nbytes;
- EMACS_INT chars = 0;
+ ptrdiff_t chars = 0;
while (ptr < endp)
{
- EMACS_INT len = MULTIBYTE_LENGTH (ptr, endp);
+ int len = MULTIBYTE_LENGTH (ptr, endp);
if (len == 0)
- abort ();
+ emacs_abort ();
ptr += len;
chars++;
}
@@ -553,11 +551,12 @@ multibyte_chars_in_text (const unsigned char *ptr, EMACS_INT nbytes)
represented by 2-byte in a multibyte text. */
void
-parse_str_as_multibyte (const unsigned char *str, EMACS_INT len,
- EMACS_INT *nchars, EMACS_INT *nbytes)
+parse_str_as_multibyte (const unsigned char *str, ptrdiff_t len,
+ ptrdiff_t *nchars, ptrdiff_t *nbytes)
{
const unsigned char *endp = str + len;
- EMACS_INT n, chars = 0, bytes = 0;
+ int n;
+ ptrdiff_t chars = 0, bytes = 0;
if (len >= MAX_MULTIBYTE_LENGTH)
{
@@ -595,13 +594,13 @@ parse_str_as_multibyte (const unsigned char *str, EMACS_INT len,
area and that is enough. Return the number of bytes of the
resulting text. */
-EMACS_INT
-str_as_multibyte (unsigned char *str, EMACS_INT len, EMACS_INT nbytes,
- EMACS_INT *nchars)
+ptrdiff_t
+str_as_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t nbytes,
+ ptrdiff_t *nchars)
{
unsigned char *p = str, *endp = str + nbytes;
unsigned char *to;
- EMACS_INT chars = 0;
+ ptrdiff_t chars = 0;
int n;
if (nbytes >= MAX_MULTIBYTE_LENGTH)
@@ -672,11 +671,11 @@ str_as_multibyte (unsigned char *str, EMACS_INT len, EMACS_INT nbytes,
bytes it may occupy when converted to multibyte string by
`str_to_multibyte'. */
-EMACS_INT
-count_size_as_multibyte (const unsigned char *str, EMACS_INT len)
+ptrdiff_t
+count_size_as_multibyte (const unsigned char *str, ptrdiff_t len)
{
const unsigned char *endp = str + len;
- EMACS_INT bytes;
+ ptrdiff_t bytes;
for (bytes = 0; str < endp; str++)
{
@@ -695,8 +694,8 @@ count_size_as_multibyte (const unsigned char *str, EMACS_INT len)
that we can use LEN bytes at STR as a work area and that is
enough. */
-EMACS_INT
-str_to_multibyte (unsigned char *str, EMACS_INT len, EMACS_INT bytes)
+ptrdiff_t
+str_to_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t bytes)
{
unsigned char *p = str, *endp = str + bytes;
unsigned char *to;
@@ -724,8 +723,8 @@ str_to_multibyte (unsigned char *str, EMACS_INT len, EMACS_INT bytes)
actually converts characters in the range 0x80..0xFF to
unibyte. */
-EMACS_INT
-str_as_unibyte (unsigned char *str, EMACS_INT bytes)
+ptrdiff_t
+str_as_unibyte (unsigned char *str, ptrdiff_t bytes)
{
const unsigned char *p = str, *endp = str + bytes;
unsigned char *to;
@@ -761,15 +760,12 @@ str_as_unibyte (unsigned char *str, EMACS_INT bytes)
corresponding byte and store in DST. CHARS is the number of
characters in SRC. The value is the number of bytes stored in DST.
Usually, the value is the same as CHARS, but is less than it if SRC
- contains a non-ASCII, non-eight-bit character. If ACCEPT_LATIN_1
- is nonzero, a Latin-1 character is accepted and converted to a byte
- of that character code.
- Note: Currently the arg ACCEPT_LATIN_1 is not used. */
+ contains a non-ASCII, non-eight-bit character. */
-EMACS_INT
-str_to_unibyte (const unsigned char *src, unsigned char *dst, EMACS_INT chars, int accept_latin_1)
+ptrdiff_t
+str_to_unibyte (const unsigned char *src, unsigned char *dst, ptrdiff_t chars)
{
- EMACS_INT i;
+ ptrdiff_t i;
for (i = 0; i < chars; i++)
{
@@ -777,8 +773,7 @@ str_to_unibyte (const unsigned char *src, unsigned char *dst, EMACS_INT chars, i
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
- else if (! ASCII_CHAR_P (c)
- && (! accept_latin_1 || c >= 0x100))
+ else if (! ASCII_CHAR_P (c))
return i;
*dst++ = c;
}
@@ -786,14 +781,14 @@ str_to_unibyte (const unsigned char *src, unsigned char *dst, EMACS_INT chars, i
}
-static EMACS_INT
+static ptrdiff_t
string_count_byte8 (Lisp_Object string)
{
- int multibyte = STRING_MULTIBYTE (string);
- EMACS_INT nbytes = SBYTES (string);
+ bool multibyte = STRING_MULTIBYTE (string);
+ ptrdiff_t nbytes = SBYTES (string);
unsigned char *p = SDATA (string);
unsigned char *pend = p + nbytes;
- EMACS_INT count = 0;
+ ptrdiff_t count = 0;
int c, len;
if (multibyte)
@@ -819,10 +814,10 @@ string_count_byte8 (Lisp_Object string)
Lisp_Object
string_escape_byte8 (Lisp_Object string)
{
- EMACS_INT nchars = SCHARS (string);
- EMACS_INT nbytes = SBYTES (string);
- int multibyte = STRING_MULTIBYTE (string);
- EMACS_INT byte8_count;
+ ptrdiff_t nchars = SCHARS (string);
+ ptrdiff_t nbytes = SBYTES (string);
+ bool multibyte = STRING_MULTIBYTE (string);
+ ptrdiff_t byte8_count;
const unsigned char *src, *src_end;
unsigned char *dst;
Lisp_Object val;
@@ -868,8 +863,7 @@ string_escape_byte8 (Lisp_Object string)
{
c = STRING_CHAR_ADVANCE (src);
c = CHAR_TO_BYTE8 (c);
- sprintf ((char *) dst, "\\%03o", c);
- dst += 4;
+ dst += sprintf ((char *) dst, "\\%03o", c);
}
else
while (len--) *dst++ = *src++;
@@ -879,10 +873,7 @@ string_escape_byte8 (Lisp_Object string)
{
c = *src++;
if (c >= 0x80)
- {
- sprintf ((char *) dst, "\\%03o", c);
- dst += 4;
- }
+ dst += sprintf ((char *) dst, "\\%03o", c);
else
*dst++ = c;
}
@@ -923,21 +914,15 @@ usage: (unibyte-string &rest BYTES) */)
(ptrdiff_t n, Lisp_Object *args)
{
ptrdiff_t i;
- int c;
- unsigned char *buf, *p;
Lisp_Object str;
USE_SAFE_ALLOCA;
-
- SAFE_ALLOCA (buf, unsigned char *, n);
- p = buf;
+ unsigned char *buf = SAFE_ALLOCA (n);
+ unsigned char *p = buf;
for (i = 0; i < n; i++)
{
- CHECK_NATNUM (args[i]);
- c = XFASTINT (args[i]);
- if (c >= 256)
- args_out_of_range_3 (args[i], make_number (0), make_number (255));
- *p++ = c;
+ CHECK_RANGED_INTEGER (args[i], 0, 255);
+ *p++ = XINT (args[i]);
}
str = make_string_from_bytes ((char *) buf, n, p - buf);
@@ -953,7 +938,7 @@ code. Unresolved modifiers are kept in the value.
usage: (char-resolve-modifiers CHAR) */)
(Lisp_Object character)
{
- int c;
+ EMACS_INT c;
CHECK_NUMBER (character);
c = XINT (character);
@@ -973,7 +958,7 @@ character is not ASCII nor 8-bit character, an error is signaled. */)
(Lisp_Object position, Lisp_Object string)
{
int c;
- EMACS_INT pos;
+ ptrdiff_t pos;
unsigned char *p;
if (NILP (string))
@@ -1019,12 +1004,6 @@ character is not ASCII nor 8-bit character, an error is signaled. */)
return make_number (c);
}
-
-void
-init_character_once (void)
-{
-}
-
#ifdef emacs
void
diff --git a/src/character.h b/src/character.h
index 5ae6cb8c49c..b2cdcb76699 100644
--- a/src/character.h
+++ b/src/character.h
@@ -25,6 +25,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <verify.h>
+INLINE_HEADER_BEGIN
+#ifndef CHARACTER_INLINE
+# define CHARACTER_INLINE INLINE
+#endif
+
/* character code 1st byte byte sequence
-------------- -------- -------------
0-7F 00..7F 0xxxxxxx
@@ -292,7 +297,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
} while (0)
/* Return the character code of character whose multibyte form is at
- P. */
+ P. Note that this macro unifies CJK characters whose codepoints
+ are in the Private Use Areas (PUAs), so it might return a different
+ codepoint from the one actually stored at P. */
#define STRING_CHAR(p) \
(!((p)[0] & 0x80) \
@@ -309,7 +316,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Like STRING_CHAR, but set ACTUAL_LEN to the length of multibyte
- form. */
+ form.
+
+ Note: This macro returns the actual length of the character's
+ multibyte sequence as it is stored in a buffer or string. The
+ character it returns might have a different codepoint that has a
+ different multibyte sequence of a different length, due to possible
+ unification of CJK characters inside string_char. Therefore do NOT
+ assume that the length returned by this macro is identical to the
+ length of the multibyte sequence of the character it returns. */
#define STRING_CHAR_AND_LENGTH(p, actual_len) \
(!((p)[0] & 0x80) \
@@ -424,7 +439,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
unsigned char *chp = BYTE_POS_ADDR (BYTEIDX); \
int chlen; \
\
- OUTPUT= STRING_CHAR_AND_LENGTH (chp, chlen); \
+ OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \
BYTEIDX += chlen; \
} \
else \
@@ -539,28 +554,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
} while (0)
-/* If C is a character to be unified with a Unicode character, return
- the unified Unicode character. */
-
-#define MAYBE_UNIFY_CHAR(c) \
- do { \
- if (c > MAX_UNICODE_CHAR && c <= MAX_5_BYTE_CHAR) \
- { \
- Lisp_Object val; \
- val = CHAR_TABLE_REF (Vchar_unify_table, c); \
- if (INTEGERP (val)) \
- c = XFASTINT (val); \
- else if (! NILP (val)) \
- c = maybe_unify_char (c, val); \
- } \
- } while (0)
-
-
/* Return a non-outlandish value for the tab width. */
#define SANE_TAB_WIDTH(buf) \
sanitize_tab_width (XFASTINT (BVAR (buf, tab_width)))
-static inline int
+CHARACTER_INLINE int
sanitize_tab_width (EMACS_INT width)
{
return 0 < width && width <= 1000 ? width : 8;
@@ -581,7 +579,7 @@ sanitize_tab_width (EMACS_INT width)
/* Return a non-outlandish value for a character width. */
-static inline int
+CHARACTER_INLINE int
sanitize_char_width (EMACS_INT width)
{
return 0 <= width && width <= 1000 ? width : 1000;
@@ -655,27 +653,26 @@ typedef enum {
UNICODE_CATEGORY_Cn
} unicode_category_t;
-extern int char_resolve_modifier_mask (int);
+extern EMACS_INT char_resolve_modifier_mask (EMACS_INT) ATTRIBUTE_CONST;
extern int char_string (unsigned, unsigned char *);
extern int string_char (const unsigned char *,
const unsigned char **, int *);
extern int translate_char (Lisp_Object, int c);
-extern int char_printable_p (int c);
extern void parse_str_as_multibyte (const unsigned char *,
- EMACS_INT, EMACS_INT *, EMACS_INT *);
-extern EMACS_INT count_size_as_multibyte (const unsigned char *, EMACS_INT);
-extern EMACS_INT str_as_multibyte (unsigned char *, EMACS_INT, EMACS_INT,
- EMACS_INT *);
-extern EMACS_INT str_to_multibyte (unsigned char *, EMACS_INT, EMACS_INT);
-extern EMACS_INT str_as_unibyte (unsigned char *, EMACS_INT);
-extern EMACS_INT str_to_unibyte (const unsigned char *, unsigned char *,
- EMACS_INT, int);
-extern EMACS_INT strwidth (const char *, EMACS_INT);
-extern EMACS_INT c_string_width (const unsigned char *, EMACS_INT, int,
- EMACS_INT *, EMACS_INT *);
-extern EMACS_INT lisp_string_width (Lisp_Object, EMACS_INT,
- EMACS_INT *, EMACS_INT *);
+ ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
+extern ptrdiff_t count_size_as_multibyte (const unsigned char *, ptrdiff_t);
+extern ptrdiff_t str_as_multibyte (unsigned char *, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t *);
+extern ptrdiff_t str_to_multibyte (unsigned char *, ptrdiff_t, ptrdiff_t);
+extern ptrdiff_t str_as_unibyte (unsigned char *, ptrdiff_t);
+extern ptrdiff_t str_to_unibyte (const unsigned char *, unsigned char *,
+ ptrdiff_t);
+extern ptrdiff_t strwidth (const char *, ptrdiff_t);
+extern ptrdiff_t c_string_width (const unsigned char *, ptrdiff_t, int,
+ ptrdiff_t *, ptrdiff_t *);
+extern ptrdiff_t lisp_string_width (Lisp_Object, ptrdiff_t,
+ ptrdiff_t *, ptrdiff_t *);
extern Lisp_Object Qcharacterp;
extern Lisp_Object Vchar_unify_table;
@@ -685,4 +682,6 @@ extern Lisp_Object string_escape_byte8 (Lisp_Object);
#define GET_TRANSLATION_TABLE(id) \
(XCDR(XVECTOR(Vtranslation_table_vector)->contents[(id)]))
+INLINE_HEADER_END
+
#endif /* EMACS_CHARACTER_H */
diff --git a/src/charset.c b/src/charset.c
index 49fc7288069..c9133c780e8 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -1,5 +1,5 @@
/* Basic character set support.
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
@@ -26,12 +26,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+#define CHARSET_INLINE EXTERN_INLINE
+
#include <stdio.h>
#include <unistd.h>
-#include <ctype.h>
#include <limits.h>
#include <sys/types.h>
-#include <setjmp.h>
+#include <c-ctype.h>
#include "lisp.h"
#include "character.h"
#include "charset.h"
@@ -118,24 +119,25 @@ int iso_charset_table[ISO_MAX_DIMENSION][ISO_MAX_CHARS][ISO_MAX_FINAL];
#define CODE_POINT_TO_INDEX(charset, code) \
((charset)->code_linear_p \
- ? (code) - (charset)->min_code \
+ ? (int) ((code) - (charset)->min_code) \
: (((charset)->code_space_mask[(code) >> 24] & 0x8) \
&& ((charset)->code_space_mask[((code) >> 16) & 0xFF] & 0x4) \
&& ((charset)->code_space_mask[((code) >> 8) & 0xFF] & 0x2) \
&& ((charset)->code_space_mask[(code) & 0xFF] & 0x1)) \
- ? (((((code) >> 24) - (charset)->code_space[12]) \
- * (charset)->code_space[11]) \
- + (((((code) >> 16) & 0xFF) - (charset)->code_space[8]) \
- * (charset)->code_space[7]) \
- + (((((code) >> 8) & 0xFF) - (charset)->code_space[4]) \
- * (charset)->code_space[3]) \
- + (((code) & 0xFF) - (charset)->code_space[0]) \
- - ((charset)->char_index_offset)) \
+ ? (int) (((((code) >> 24) - (charset)->code_space[12]) \
+ * (charset)->code_space[11]) \
+ + (((((code) >> 16) & 0xFF) - (charset)->code_space[8]) \
+ * (charset)->code_space[7]) \
+ + (((((code) >> 8) & 0xFF) - (charset)->code_space[4]) \
+ * (charset)->code_space[3]) \
+ + (((code) & 0xFF) - (charset)->code_space[0]) \
+ - ((charset)->char_index_offset)) \
: -1)
-/* Convert the character index IDX to code-point CODE for CHARSET.
- It is assumed that IDX is in a valid range. */
+/* Return the code-point for the character index IDX in CHARSET.
+ IDX should be an unsigned int variable in a valid range (which is
+ always in nonnegative int range too). IDX contains garbage afterwards. */
#define INDEX_TO_CODE_POINT(charset, idx) \
((charset)->code_linear_p \
@@ -212,7 +214,7 @@ static struct
/* Set to 1 to warn that a charset map is loaded and thus a buffer
text and a string data may be relocated. */
-int charset_map_loaded;
+bool charset_map_loaded;
struct charset_map_entries
{
@@ -253,7 +255,7 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries,
{
Lisp_Object vec IF_LINT (= Qnil), table IF_LINT (= Qnil);
unsigned max_code = CHARSET_MAX_CODE (charset);
- int ascii_compatible_p = charset->ascii_compatible_p;
+ bool ascii_compatible_p = charset->ascii_compatible_p;
int min_char, max_char, nonascii_min_char;
int i;
unsigned char *fast_map = charset->fast_map;
@@ -271,8 +273,8 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries,
{
int n = CODE_POINT_TO_INDEX (charset, max_code) + 1;
- vec = CHARSET_DECODER (charset)
- = Fmake_vector (make_number (n), make_number (-1));
+ vec = Fmake_vector (make_number (n), make_number (-1));
+ set_charset_attr (charset, charset_decoder, vec);
}
else
{
@@ -284,16 +286,16 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries,
else
{
table = Fmake_char_table (Qnil, Qnil);
- if (charset->method == CHARSET_METHOD_MAP)
- CHARSET_ENCODER (charset) = table;
- else
- CHARSET_DEUNIFIER (charset) = table;
+ set_charset_attr (charset,
+ (charset->method == CHARSET_METHOD_MAP
+ ? charset_encoder : charset_deunifier),
+ table);
}
}
else
{
if (! temp_charset_work)
- temp_charset_work = xmalloc (sizeof (*temp_charset_work));
+ temp_charset_work = xmalloc (sizeof *temp_charset_work);
if (control_flag == 1)
{
memset (temp_charset_work->table.decoder, -1,
@@ -363,7 +365,8 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries,
&& CHARSET_COMPACT_CODES_P (charset))
for (; from_index < lim_index; from_index++, from_c++)
{
- unsigned code = INDEX_TO_CODE_POINT (charset, from_index);
+ unsigned code = from_index;
+ code = INDEX_TO_CODE_POINT (charset, code);
if (NILP (CHAR_TABLE_REF (table, from_c)))
CHAR_TABLE_SET (table, from_c, make_number (code));
@@ -418,8 +421,8 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries,
/* Read a hexadecimal number (preceded by "0x") from the file FP while
paying attention to comment character '#'. */
-static inline unsigned
-read_hex (FILE *fp, int *eof, int *overflow)
+static unsigned
+read_hex (FILE *fp, bool *eof, bool *overflow)
{
int c;
unsigned n;
@@ -442,7 +445,7 @@ read_hex (FILE *fp, int *eof, int *overflow)
return 0;
}
n = 0;
- while (isxdigit (c = getc (fp)))
+ while (c_isxdigit (c = getc (fp)))
{
if (UINT_MAX >> 4 < n)
*overflow = 1;
@@ -482,7 +485,8 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co
FILE *fp;
Lisp_Object suffixes;
struct charset_map_entries *head, *entries;
- int n_entries, count;
+ int n_entries;
+ ptrdiff_t count;
USE_SAFE_ALLOCA;
suffixes = Fcons (build_string (".map"),
@@ -498,8 +502,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co
/* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
large (larger than MAX_ALLOCA). */
- SAFE_ALLOCA (head, struct charset_map_entries *,
- sizeof (struct charset_map_entries));
+ head = SAFE_ALLOCA (sizeof *head);
entries = head;
memset (entries, 0, sizeof (struct charset_map_entries));
@@ -508,7 +511,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co
{
unsigned from, to, c;
int idx;
- int eof = 0, overflow = 0;
+ bool eof = 0, overflow = 0;
from = read_hex (fp, &eof, &overflow);
if (eof)
@@ -530,12 +533,12 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co
if (n_entries > 0 && (n_entries % 0x10000) == 0)
{
- SAFE_ALLOCA (entries->next, struct charset_map_entries *,
- sizeof (struct charset_map_entries));
+ entries->next = SAFE_ALLOCA (sizeof *entries->next);
entries = entries->next;
memset (entries, 0, sizeof (struct charset_map_entries));
+ n_entries = 0;
}
- idx = n_entries % 0x10000;
+ idx = n_entries;
entries->entry[idx].from = from;
entries->entry[idx].to = to;
entries->entry[idx].c = c;
@@ -566,8 +569,7 @@ load_charset_map_from_vector (struct charset *charset, Lisp_Object vec, int cont
/* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
large (larger than MAX_ALLOCA). */
- SAFE_ALLOCA (head, struct charset_map_entries *,
- sizeof (struct charset_map_entries));
+ head = SAFE_ALLOCA (sizeof *head);
entries = head;
memset (entries, 0, sizeof (struct charset_map_entries));
@@ -576,7 +578,7 @@ load_charset_map_from_vector (struct charset *charset, Lisp_Object vec, int cont
{
Lisp_Object val, val2;
unsigned from, to;
- int c;
+ EMACS_INT c;
int idx;
val = AREF (vec, i);
@@ -584,16 +586,11 @@ load_charset_map_from_vector (struct charset *charset, Lisp_Object vec, int cont
{
val2 = XCDR (val);
val = XCAR (val);
- CHECK_NATNUM (val);
- CHECK_NATNUM (val2);
from = XFASTINT (val);
to = XFASTINT (val2);
}
else
- {
- CHECK_NATNUM (val);
- from = to = XFASTINT (val);
- }
+ from = to = XFASTINT (val);
val = AREF (vec, i + 1);
CHECK_NATNUM (val);
c = XFASTINT (val);
@@ -603,8 +600,7 @@ load_charset_map_from_vector (struct charset *charset, Lisp_Object vec, int cont
if (n_entries > 0 && (n_entries % 0x10000) == 0)
{
- SAFE_ALLOCA (entries->next, struct charset_map_entries *,
- sizeof (struct charset_map_entries));
+ entries->next = SAFE_ALLOCA (sizeof *entries->next);
entries = entries->next;
memset (entries, 0, sizeof (struct charset_map_entries));
}
@@ -639,7 +635,7 @@ load_charset (struct charset *charset, int control_flag)
else
{
if (! CHARSET_UNIFIED_P (charset))
- abort ();
+ emacs_abort ();
map = CHARSET_UNIFY_MAP (charset);
}
if (STRINGP (map))
@@ -720,10 +716,8 @@ map_charset_chars (void (*c_function)(Lisp_Object, Lisp_Object), Lisp_Object fun
Lisp_Object arg, struct charset *charset, unsigned from, unsigned to)
{
Lisp_Object range;
- int partial;
-
- partial = (from > CHARSET_MIN_CODE (charset)
- || to < CHARSET_MAX_CODE (charset));
+ bool partial = (from > CHARSET_MIN_CODE (charset)
+ || to < CHARSET_MAX_CODE (charset));
if (CHARSET_METHOD (charset) == CHARSET_METHOD_OFFSET)
{
@@ -821,7 +815,6 @@ range of code points (in CHARSET) of target characters. */)
from = CHARSET_MIN_CODE (cs);
else
{
- CHECK_NATNUM (from_code);
from = XINT (from_code);
if (from < CHARSET_MIN_CODE (cs))
from = CHARSET_MIN_CODE (cs);
@@ -830,7 +823,6 @@ range of code points (in CHARSET) of target characters. */)
to = CHARSET_MAX_CODE (cs);
else
{
- CHECK_NATNUM (to_code);
to = XINT (to_code);
if (to > CHARSET_MAX_CODE (cs))
to = CHARSET_MAX_CODE (cs);
@@ -860,7 +852,7 @@ usage: (define-charset-internal ...) */)
struct charset charset;
int id;
int dimension;
- int new_definition_p;
+ bool new_definition_p;
int nchars;
if (nargs != charset_arg_max)
@@ -876,12 +868,15 @@ usage: (define-charset-internal ...) */)
val = args[charset_arg_code_space];
for (i = 0, dimension = 0, nchars = 1; ; i++)
{
+ Lisp_Object min_byte_obj, max_byte_obj;
int min_byte, max_byte;
- min_byte = XINT (Faref (val, make_number (i * 2)));
- max_byte = XINT (Faref (val, make_number (i * 2 + 1)));
- if (min_byte < 0 || min_byte > max_byte || max_byte >= 256)
- error ("Invalid :code-space value");
+ min_byte_obj = Faref (val, make_number (i * 2));
+ max_byte_obj = Faref (val, make_number (i * 2 + 1));
+ CHECK_RANGED_INTEGER (min_byte_obj, 0, 255);
+ min_byte = XINT (min_byte_obj);
+ CHECK_RANGED_INTEGER (max_byte_obj, min_byte, 255);
+ max_byte = XINT (max_byte_obj);
charset.code_space[i * 4] = min_byte;
charset.code_space[i * 4 + 1] = max_byte;
charset.code_space[i * 4 + 2] = max_byte - min_byte + 1;
@@ -898,10 +893,8 @@ usage: (define-charset-internal ...) */)
charset.dimension = dimension;
else
{
- CHECK_NATNUM (val);
+ CHECK_RANGED_INTEGER (val, 1, 4);
charset.dimension = XINT (val);
- if (charset.dimension < 1 || charset.dimension > 4)
- args_out_of_range_3 (val, make_number (1), make_number (4));
}
charset.code_linear_p
@@ -914,8 +907,7 @@ usage: (define-charset-internal ...) */)
if (! charset.code_linear_p)
{
- charset.code_space_mask = (unsigned char *) xmalloc (256);
- memset (charset.code_space_mask, 0, 256);
+ charset.code_space_mask = xzalloc (256);
for (i = 0; i < 4; i++)
for (j = charset.code_space[i * 4]; j <= charset.code_space[i * 4 + 1];
j++)
@@ -927,11 +919,11 @@ usage: (define-charset-internal ...) */)
charset.min_code = (charset.code_space[0]
| (charset.code_space[4] << 8)
| (charset.code_space[8] << 16)
- | (charset.code_space[12] << 24));
+ | ((unsigned) charset.code_space[12] << 24));
charset.max_code = (charset.code_space[1]
| (charset.code_space[5] << 8)
| (charset.code_space[9] << 16)
- | (charset.code_space[13] << 24));
+ | ((unsigned) charset.code_space[13] << 24));
charset.char_index_offset = 0;
val = args[charset_arg_min_code];
@@ -941,8 +933,8 @@ usage: (define-charset-internal ...) */)
if (code < charset.min_code
|| code > charset.max_code)
- args_out_of_range_3 (make_number (charset.min_code),
- make_number (charset.max_code), val);
+ args_out_of_range_3 (make_fixnum_or_float (charset.min_code),
+ make_fixnum_or_float (charset.max_code), val);
charset.char_index_offset = CODE_POINT_TO_INDEX (&charset, code);
charset.min_code = code;
}
@@ -954,8 +946,8 @@ usage: (define-charset-internal ...) */)
if (code < charset.min_code
|| code > charset.max_code)
- args_out_of_range_3 (make_number (charset.min_code),
- make_number (charset.max_code), val);
+ args_out_of_range_3 (make_fixnum_or_float (charset.min_code),
+ make_fixnum_or_float (charset.max_code), val);
charset.max_code = code;
}
@@ -968,18 +960,14 @@ usage: (define-charset-internal ...) */)
charset.invalid_code = 0;
else
{
- XSETINT (val, charset.max_code + 1);
- if (XINT (val) == charset.max_code + 1)
+ if (charset.max_code < UINT_MAX)
charset.invalid_code = charset.max_code + 1;
else
error ("Attribute :invalid-code must be specified");
}
}
else
- {
- CHECK_NATNUM (val);
- charset.invalid_code = XFASTINT (val);
- }
+ charset.invalid_code = cons_to_unsigned (val, UINT_MAX);
val = args[charset_arg_iso_final];
if (NILP (val))
@@ -997,9 +985,7 @@ usage: (define-charset-internal ...) */)
charset.iso_revision = -1;
else
{
- CHECK_NUMBER (val);
- if (XINT (val) > 63)
- args_out_of_range (make_number (63), val);
+ CHECK_RANGED_INTEGER (val, -1, 63);
charset.iso_revision = XINT (val);
}
@@ -1025,17 +1011,17 @@ usage: (define-charset-internal ...) */)
if (! NILP (args[charset_arg_code_offset]))
{
val = args[charset_arg_code_offset];
- CHECK_NUMBER (val);
+ CHECK_CHARACTER (val);
charset.method = CHARSET_METHOD_OFFSET;
charset.code_offset = XINT (val);
- i = CODE_POINT_TO_INDEX (&charset, charset.min_code);
- charset.min_char = i + charset.code_offset;
i = CODE_POINT_TO_INDEX (&charset, charset.max_code);
- charset.max_char = i + charset.code_offset;
- if (charset.max_char > MAX_CHAR)
+ if (MAX_CHAR - charset.code_offset < i)
error ("Unsupported max char: %d", charset.max_char);
+ charset.max_char = i + charset.code_offset;
+ i = CODE_POINT_TO_INDEX (&charset, charset.min_code);
+ charset.min_char = i + charset.code_offset;
i = (charset.min_char >> 7) << 7;
for (; i < 0x10000 && i <= charset.max_char; i += 128)
@@ -1106,7 +1092,7 @@ usage: (define-charset-internal ...) */)
car_part = XCAR (elt);
cdr_part = XCDR (elt);
CHECK_CHARSET_GET_ID (car_part, this_id);
- CHECK_NUMBER (cdr_part);
+ CHECK_TYPE_RANGED_INTEGER (int, cdr_part);
offset = XINT (cdr_part);
}
else
@@ -1142,7 +1128,7 @@ usage: (define-charset-internal ...) */)
{
new_definition_p = 0;
id = XFASTINT (CHARSET_SYMBOL_ID (args[charset_arg_name]));
- HASH_VALUE (hash_table, charset.hash_index) = attrs;
+ set_hash_value_slot (hash_table, charset.hash_index, attrs);
}
else
{
@@ -1261,12 +1247,11 @@ define_charset_internal (Lisp_Object name,
const char *code_space_chars,
unsigned min_code, unsigned max_code,
int iso_final, int iso_revision, int emacs_mule_id,
- int ascii_compatible, int supplementary,
+ bool ascii_compatible, bool supplementary,
int code_offset)
{
const unsigned char *code_space = (const unsigned char *) code_space_chars;
Lisp_Object args[charset_arg_max];
- Lisp_Object plist[14];
Lisp_Object val;
int i;
@@ -1292,22 +1277,22 @@ define_charset_internal (Lisp_Object name,
args[charset_arg_superset] = Qnil;
args[charset_arg_unify_map] = Qnil;
- plist[0] = intern_c_string (":name");
- plist[1] = args[charset_arg_name];
- plist[2] = intern_c_string (":dimension");
- plist[3] = args[charset_arg_dimension];
- plist[4] = intern_c_string (":code-space");
- plist[5] = args[charset_arg_code_space];
- plist[6] = intern_c_string (":iso-final-char");
- plist[7] = args[charset_arg_iso_final];
- plist[8] = intern_c_string (":emacs-mule-id");
- plist[9] = args[charset_arg_emacs_mule_id];
- plist[10] = intern_c_string (":ascii-compatible-p");
- plist[11] = args[charset_arg_ascii_compatible_p];
- plist[12] = intern_c_string (":code-offset");
- plist[13] = args[charset_arg_code_offset];
-
- args[charset_arg_plist] = Flist (14, plist);
+ args[charset_arg_plist] =
+ listn (CONSTYPE_HEAP, 14,
+ intern_c_string (":name"),
+ args[charset_arg_name],
+ intern_c_string (":dimension"),
+ args[charset_arg_dimension],
+ intern_c_string (":code-space"),
+ args[charset_arg_code_space],
+ intern_c_string (":iso-final-char"),
+ args[charset_arg_iso_final],
+ intern_c_string (":emacs-mule-id"),
+ args[charset_arg_emacs_mule_id],
+ intern_c_string (":ascii-compatible-p"),
+ args[charset_arg_ascii_compatible_p],
+ intern_c_string (":code-offset"),
+ args[charset_arg_code_offset]);
Fdefine_charset_internal (charset_arg_max, args);
return XINT (CHARSET_SYMBOL_ID (name));
@@ -1346,7 +1331,7 @@ DEFUN ("set-charset-plist", Fset_charset_plist, Sset_charset_plist, 2, 2, 0,
Lisp_Object attrs;
CHECK_CHARSET_GET_ATTR (charset, attrs);
- CHARSET_ATTR_PLIST (attrs) = plist;
+ ASET (attrs, charset_plist, plist);
return plist;
}
@@ -1385,7 +1370,7 @@ Optional third argument DEUNIFY, if non-nil, means to de-unify CHARSET. */)
{
if (! STRINGP (unify_map) && ! VECTORP (unify_map))
signal_error ("Bad unify-map", unify_map);
- CHARSET_UNIFY_MAP (cs) = unify_map;
+ set_charset_attr (cs, charset_unify_map, unify_map);
}
if (NILP (Vchar_unify_table))
Vchar_unify_table = Fmake_char_table (Qnil, Qnil);
@@ -1395,8 +1380,8 @@ Optional third argument DEUNIFY, if non-nil, means to de-unify CHARSET. */)
}
else if (CHAR_TABLE_P (Vchar_unify_table))
{
- int min_code = CHARSET_MIN_CODE (cs);
- int max_code = CHARSET_MAX_CODE (cs);
+ unsigned min_code = CHARSET_MIN_CODE (cs);
+ unsigned max_code = CHARSET_MAX_CODE (cs);
int min_char = DECODE_CHAR (cs, min_code);
int max_char = DECODE_CHAR (cs, max_code);
@@ -1460,7 +1445,7 @@ if CHARSET is designated instead. */)
(Lisp_Object dimension, Lisp_Object chars, Lisp_Object final_char, Lisp_Object charset)
{
int id;
- int chars_flag;
+ bool chars_flag;
CHECK_CHARSET_GET_ID (charset, id);
check_iso_charset_parameter (dimension, chars, final_char);
@@ -1511,7 +1496,9 @@ string_xstring_p (Lisp_Object string)
It may lookup a translation table TABLE if supplied. */
static void
-find_charsets_in_text (const unsigned char *ptr, EMACS_INT nchars, EMACS_INT nbytes, Lisp_Object charsets, Lisp_Object table, int multibyte)
+find_charsets_in_text (const unsigned char *ptr, ptrdiff_t nchars,
+ ptrdiff_t nbytes, Lisp_Object charsets,
+ Lisp_Object table, bool multibyte)
{
const unsigned char *pend = ptr + nbytes;
@@ -1558,10 +1545,10 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
(Lisp_Object beg, Lisp_Object end, Lisp_Object table)
{
Lisp_Object charsets;
- EMACS_INT from, from_byte, to, stop, stop_byte;
+ ptrdiff_t from, from_byte, to, stop, stop_byte;
int i;
Lisp_Object val;
- int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
validate_region (&beg, &end);
from = XFASTINT (beg);
@@ -1630,7 +1617,7 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
/* Return a unified character code for C (>= 0x110000). VAL is a
value of Vchar_unify_table for C; i.e. it is nil, an integer, or a
charset symbol. */
-int
+static int
maybe_unify_char (int c, Lisp_Object val)
{
struct charset *charset;
@@ -1641,6 +1628,12 @@ maybe_unify_char (int c, Lisp_Object val)
return c;
CHECK_CHARSET_GET_CHARSET (val, charset);
+#ifdef REL_ALLOC
+ /* The call to load_charset below can allocate memory, which screws
+ callers of this function through STRING_CHAR_* macros that hold C
+ pointers to buffer text, if REL_ALLOC is used. */
+ r_alloc_inhibit_buffer_relocation (1);
+#endif
load_charset (charset, 1);
if (! inhibit_load_charset_map)
{
@@ -1656,6 +1649,9 @@ maybe_unify_char (int c, Lisp_Object val)
if (unified > 0)
c = unified;
}
+#ifdef REL_ALLOC
+ r_alloc_inhibit_buffer_relocation (0);
+#endif
return c;
}
@@ -1727,8 +1723,12 @@ decode_char (struct charset *charset, unsigned int code)
{
c = char_index + CHARSET_CODE_OFFSET (charset);
if (CHARSET_UNIFIED_P (charset)
- && c > MAX_UNICODE_CHAR)
- MAYBE_UNIFY_CHAR (c);
+ && MAX_UNICODE_CHAR < c && c <= MAX_5_BYTE_CHAR)
+ {
+ /* Unify C with a Unicode character if possible. */
+ Lisp_Object val = CHAR_TABLE_REF (Vchar_unify_table, c);
+ c = maybe_unify_char (c, val);
+ }
}
}
@@ -1738,7 +1738,7 @@ decode_char (struct charset *charset, unsigned int code)
/* Variable used temporarily by the macro ENCODE_CHAR. */
Lisp_Object charset_work;
-/* Return a code-point of CHAR in CHARSET. If CHAR doesn't belong to
+/* Return a code-point of C in CHARSET. If C doesn't belong to
CHARSET, return CHARSET_INVALID_CODE (CHARSET). If STRICT is true,
use CHARSET's strict_max_char instead of max_char. */
@@ -1840,7 +1840,7 @@ encode_char (struct charset *charset, int c)
}
else /* method == CHARSET_METHOD_OFFSET */
{
- int code_index = c - CHARSET_CODE_OFFSET (charset);
+ unsigned code_index = c - CHARSET_CODE_OFFSET (charset);
code = INDEX_TO_CODE_POINT (charset, code_index);
}
@@ -1981,7 +1981,7 @@ is specified. */)
struct charset *
char_charset (int c, Lisp_Object charset_list, unsigned int *code_return)
{
- int maybe_null = 0;
+ bool maybe_null = 0;
if (NILP (charset_list))
charset_list = Vcharset_ordered_list;
@@ -2028,10 +2028,10 @@ CH in the charset. */)
c = XFASTINT (ch);
charset = CHAR_CHARSET (c);
if (! charset)
- abort ();
+ emacs_abort ();
code = ENCODE_CHAR (charset, c);
if (code == CHARSET_INVALID_CODE (charset))
- abort ();
+ emacs_abort ();
dimension = CHARSET_DIMENSION (charset);
for (val = Qnil; dimension > 0; dimension--)
{
@@ -2109,7 +2109,7 @@ DIMENSION, CHARS, and FINAL-CHAR. */)
(Lisp_Object dimension, Lisp_Object chars, Lisp_Object final_char)
{
int id;
- int chars_flag;
+ bool chars_flag;
check_iso_charset_parameter (dimension, chars, final_char);
chars_flag = XFASTINT (chars) == 96;
@@ -2293,13 +2293,17 @@ init_charset (void)
{
Lisp_Object tempdir;
tempdir = Fexpand_file_name (build_string ("charsets"), Vdata_directory);
- if (access (SSDATA (tempdir), 0) < 0)
+ if (! file_accessible_directory_p (SSDATA (tempdir)))
{
- dir_warning ("Error: charsets directory (%s) does not exist.\n\
+ /* This used to be non-fatal (dir_warning), but it should not
+ happen, and if it does sooner or later it will cause some
+ obscure problem (eg bug#6401), so better abort. */
+ fprintf (stderr, "Error: charsets directory not found:\n\
+%s\n\
Emacs will not function correctly without the character map files.\n\
Please check your installation!\n",
- tempdir);
- /* TODO should this be a fatal error? (Bug#909) */
+ SDATA (tempdir));
+ exit (1);
}
Vcharset_map_path = Fcons (tempdir, Qnil);
@@ -2403,7 +2407,7 @@ syms_of_charset (void)
defsubr (&Ssort_charsets);
DEFVAR_LISP ("charset-map-path", Vcharset_map_path,
- doc: /* *List of directories to search for charset map files. */);
+ doc: /* List of directories to search for charset map files. */);
Vcharset_map_path = Qnil;
DEFVAR_BOOL ("inhibit-load-charset-map", inhibit_load_charset_map,
diff --git a/src/charset.h b/src/charset.h
index 5ca83130b77..b5fa36290c8 100644
--- a/src/charset.h
+++ b/src/charset.h
@@ -1,5 +1,5 @@
/* Header for charset handler.
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
@@ -29,6 +29,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <verify.h>
+INLINE_HEADER_BEGIN
+#ifndef CHARSET_INLINE
+# define CHARSET_INLINE INLINE
+#endif
+
/* Index to arguments of Fdefine_charset_internal. */
enum define_charset_arg_index
@@ -168,12 +173,24 @@ struct charset
check if a code-point is in a valid range. */
unsigned char *code_space_mask;
- /* 1 if there's no gap in code-points. */
- int code_linear_p;
+ /* True if there's no gap in code-points. */
+ unsigned code_linear_p : 1;
+
+ /* True if the charset is treated as 96 chars in ISO-2022
+ as opposed to 94 chars. */
+ unsigned iso_chars_96 : 1;
+
+ /* True if the charset is compatible with ASCII. */
+ unsigned ascii_compatible_p : 1;
- /* If the charset is treated as 94-chars in ISO-2022, the value is 0.
- If the charset is treated as 96-chars in ISO-2022, the value is 1. */
- int iso_chars_96;
+ /* True if the charset is supplementary. */
+ unsigned supplementary_p : 1;
+
+ /* True if all the code points are representable by Lisp_Int. */
+ unsigned compact_codes_p : 1;
+
+ /* True if the charset is unified with Unicode. */
+ unsigned unified_p : 1;
/* ISO final byte of the charset: 48..127. It may be -1 if the
charset doesn't conform to ISO-2022. */
@@ -187,15 +204,6 @@ struct charset
version. Otherwise, -1. */
int emacs_mule_id;
- /* Nonzero if the charset is compatible with ASCII. */
- int ascii_compatible_p;
-
- /* Nonzero if the charset is supplementary. */
- int supplementary_p;
-
- /* Nonzero if all the code points are representable by Lisp_Int. */
- int compact_codes_p;
-
/* The method for encoding/decoding characters of the charset. */
enum charset_method method;
@@ -234,8 +242,6 @@ struct charset
/* Offset value to calculate a character code from code-point, and
visa versa. */
int code_offset;
-
- int unified_p;
};
/* Hash table of charset symbols vs. the corresponding attribute
@@ -325,6 +331,13 @@ extern int emacs_mule_charset[256];
#define CHARSET_DEUNIFIER(charset) \
(CHARSET_ATTR_DEUNIFIER (CHARSET_ATTRIBUTES (charset)))
+CHARSET_INLINE void
+set_charset_attr (struct charset *charset, enum charset_attr_index idx,
+ Lisp_Object val)
+{
+ ASET (CHARSET_ATTRIBUTES (charset), idx, val);
+}
+
/* Nonzero if OBJ is a valid charset symbol. */
#define CHARSETP(obj) (CHARSET_SYMBOL_HASH_INDEX (obj) >= 0)
@@ -401,7 +414,7 @@ extern Lisp_Object Vchar_charset_set;
? decode_char ((charset), (code)) \
: (charset)->method == CHARSET_METHOD_OFFSET \
? ((charset)->code_linear_p \
- ? (code) - (charset)->min_code + (charset)->code_offset \
+ ? (int) ((code) - (charset)->min_code) + (charset)->code_offset \
: decode_char ((charset), (code))) \
: (charset)->method == CHARSET_METHOD_MAP \
? (((charset)->code_linear_p \
@@ -411,16 +424,6 @@ extern Lisp_Object Vchar_charset_set;
: decode_char ((charset), (code))) \
: decode_char ((charset), (code)))
-
-/* If CHARSET is a simple offset base charset, return it's offset,
- otherwise return -1. */
-#define CHARSET_OFFSET(charset) \
- (((charset)->method == CHARSET_METHOD_OFFSET \
- && (charset)->code_linear_p \
- && ! (charset)->unified_p) \
- ? (charset)->code_offset - (charset)->min_code \
- : -1)
-
extern Lisp_Object charset_work;
/* Return a code point of CHAR in CHARSET.
@@ -430,7 +433,7 @@ extern Lisp_Object charset_work;
(verify_expr \
(sizeof (c) <= sizeof (int), \
(ASCII_CHAR_P (c) && (charset)->ascii_compatible_p \
- ? (c) \
+ ? (unsigned) (c) \
: ((charset)->unified_p \
|| (charset)->method == CHARSET_METHOD_SUBSET \
|| (charset)->method == CHARSET_METHOD_SUPERSET) \
@@ -439,7 +442,7 @@ extern Lisp_Object charset_work;
? (charset)->invalid_code \
: (charset)->method == CHARSET_METHOD_OFFSET \
? ((charset)->code_linear_p \
- ? (c) - (charset)->code_offset + (charset)->min_code \
+ ? (unsigned) ((c) - (charset)->code_offset) + (charset)->min_code \
: encode_char (charset, c)) \
: (charset)->method == CHARSET_METHOD_MAP \
? (((charset)->compact_codes_p \
@@ -447,14 +450,14 @@ extern Lisp_Object charset_work;
? (charset_work = CHAR_TABLE_REF (CHARSET_ENCODER (charset), c), \
(NILP (charset_work) \
? (charset)->invalid_code \
- : XFASTINT (charset_work))) \
+ : (unsigned) XFASTINT (charset_work))) \
: encode_char (charset, c)) \
: encode_char (charset, c))))
/* Set to 1 when a charset map is loaded to warn that a buffer text
and a string data may be relocated. */
-extern int charset_map_loaded;
+extern bool charset_map_loaded;
/* Set CHARSET to the charset highest priority of C, CODE to the
@@ -472,10 +475,10 @@ extern int charset_map_loaded;
macro ISO_CHARSET_TABLE (DIMENSION, CHARS, FINAL_CHAR). */
extern int iso_charset_table[ISO_MAX_DIMENSION][ISO_MAX_CHARS][ISO_MAX_FINAL];
-/* A charset of type iso2022 who has DIMENSION, CHARS, and FINAL
+/* A charset of type iso2022 who has DIMENSION, CHARS_96, and FINAL
(final character). */
#define ISO_CHARSET_TABLE(dimension, chars_96, final) \
- iso_charset_table[(dimension) - 1][(chars_96)][(final)]
+ iso_charset_table[(dimension) - 1][chars_96][final]
/* Nonzero if the charset who has FAST_MAP may contain C. */
#define CHARSET_FAST_MAP_REF(c, fast_map) \
@@ -493,7 +496,7 @@ extern int iso_charset_table[ISO_MAX_DIMENSION][ISO_MAX_CHARS][ISO_MAX_FINAL];
-/* 1 if CHARSET may contain the character C. */
+/* True if CHARSET may contain the character C. */
#define CHAR_CHARSET_P(c, charset) \
((ASCII_CHAR_P (c) && (charset)->ascii_compatible_p) \
|| ((CHARSET_UNIFIED_P (charset) \
@@ -535,7 +538,6 @@ extern int charset_unibyte;
extern struct charset *char_charset (int, Lisp_Object, unsigned *);
extern Lisp_Object charset_attributes (int);
-extern int maybe_unify_char (int, Lisp_Object);
extern int decode_char (struct charset *, unsigned);
extern unsigned encode_char (struct charset *, int);
extern int string_xstring_p (Lisp_Object);
@@ -544,4 +546,6 @@ extern void map_charset_chars (void (*) (Lisp_Object, Lisp_Object),
Lisp_Object, Lisp_Object,
struct charset *, unsigned, unsigned);
+INLINE_HEADER_END
+
#endif /* EMACS_CHARSET_H */
diff --git a/src/chartab.c b/src/chartab.c
index 8d903749284..7430235b4af 100644
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -19,7 +19,7 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "character.h"
#include "charset.h"
@@ -107,16 +107,16 @@ the char-table has no extra slot. */)
else
{
CHECK_NATNUM (n);
- n_extras = XINT (n);
- if (n_extras > 10)
+ if (XINT (n) > 10)
args_out_of_range (n, Qnil);
+ n_extras = XINT (n);
}
size = VECSIZE (struct Lisp_Char_Table) - 1 + n_extras;
vector = Fmake_vector (make_number (size), init);
XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE);
- XCHAR_TABLE (vector)->parent = Qnil;
- XCHAR_TABLE (vector)->purpose = purpose;
+ set_char_table_parent (vector, Qnil);
+ set_char_table_purpose (vector, purpose);
XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
return vector;
}
@@ -155,21 +155,17 @@ char_table_ascii (Lisp_Object table)
static Lisp_Object
copy_sub_char_table (Lisp_Object table)
{
- Lisp_Object copy;
int depth = XINT (XSUB_CHAR_TABLE (table)->depth);
int min_char = XINT (XSUB_CHAR_TABLE (table)->min_char);
- Lisp_Object val;
+ Lisp_Object copy = make_sub_char_table (depth, min_char, Qnil);
int i;
- copy = make_sub_char_table (depth, min_char, Qnil);
/* Recursively copy any sub char-tables. */
for (i = 0; i < chartab_size[depth]; i++)
{
- val = XSUB_CHAR_TABLE (table)->contents[i];
- if (SUB_CHAR_TABLE_P (val))
- XSUB_CHAR_TABLE (copy)->contents[i] = copy_sub_char_table (val);
- else
- XSUB_CHAR_TABLE (copy)->contents[i] = val;
+ Lisp_Object val = XSUB_CHAR_TABLE (table)->contents[i];
+ set_sub_char_table_contents
+ (copy, i, SUB_CHAR_TABLE_P (val) ? copy_sub_char_table (val) : val);
}
return copy;
@@ -185,25 +181,26 @@ copy_char_table (Lisp_Object table)
copy = Fmake_vector (make_number (size), Qnil);
XSETPVECTYPE (XVECTOR (copy), PVEC_CHAR_TABLE);
- XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (table)->defalt;
- XCHAR_TABLE (copy)->parent = XCHAR_TABLE (table)->parent;
- XCHAR_TABLE (copy)->purpose = XCHAR_TABLE (table)->purpose;
+ set_char_table_defalt (copy, XCHAR_TABLE (table)->defalt);
+ set_char_table_parent (copy, XCHAR_TABLE (table)->parent);
+ set_char_table_purpose (copy, XCHAR_TABLE (table)->purpose);
for (i = 0; i < chartab_size[0]; i++)
- XCHAR_TABLE (copy)->contents[i]
- = (SUB_CHAR_TABLE_P (XCHAR_TABLE (table)->contents[i])
- ? copy_sub_char_table (XCHAR_TABLE (table)->contents[i])
- : XCHAR_TABLE (table)->contents[i]);
- XCHAR_TABLE (copy)->ascii = char_table_ascii (copy);
+ set_char_table_contents
+ (copy, i,
+ (SUB_CHAR_TABLE_P (XCHAR_TABLE (table)->contents[i])
+ ? copy_sub_char_table (XCHAR_TABLE (table)->contents[i])
+ : XCHAR_TABLE (table)->contents[i]));
+ set_char_table_ascii (copy, char_table_ascii (copy));
size -= VECSIZE (struct Lisp_Char_Table) - 1;
for (i = 0; i < size; i++)
- XCHAR_TABLE (copy)->extras[i] = XCHAR_TABLE (table)->extras[i];
+ set_char_table_extras (copy, i, XCHAR_TABLE (table)->extras[i]);
XSETCHAR_TABLE (copy, XCHAR_TABLE (copy));
return copy;
}
static Lisp_Object
-sub_char_table_ref (Lisp_Object table, int c, int is_uniprop)
+sub_char_table_ref (Lisp_Object table, int c, bool is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
@@ -248,7 +245,7 @@ char_table_ref (Lisp_Object table, int c)
static Lisp_Object
sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to,
- Lisp_Object defalt, int is_uniprop)
+ Lisp_Object defalt, bool is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
@@ -323,7 +320,7 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
int chartab_idx = CHARTAB_IDX (c, 0, 0), idx;
Lisp_Object val;
- int is_uniprop = UNIPROP_TABLE_P (table);
+ bool is_uniprop = UNIPROP_TABLE_P (table);
val = tbl->contents[chartab_idx];
if (*from < 0)
@@ -385,7 +382,7 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
static void
-sub_char_table_set (Lisp_Object table, int c, Lisp_Object val, int is_uniprop)
+sub_char_table_set (Lisp_Object table, int c, Lisp_Object val, bool is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT ((tbl)->depth);
@@ -394,7 +391,7 @@ sub_char_table_set (Lisp_Object table, int c, Lisp_Object val, int is_uniprop)
Lisp_Object sub;
if (depth == 3)
- tbl->contents[i] = val;
+ set_sub_char_table_contents (table, i, val);
else
{
sub = tbl->contents[i];
@@ -407,23 +404,21 @@ sub_char_table_set (Lisp_Object table, int c, Lisp_Object val, int is_uniprop)
sub = make_sub_char_table (depth + 1,
min_char + i * chartab_chars[depth],
sub);
- tbl->contents[i] = sub;
+ set_sub_char_table_contents (table, i, sub);
}
}
sub_char_table_set (sub, c, val, is_uniprop);
}
}
-Lisp_Object
+void
char_table_set (Lisp_Object table, int c, Lisp_Object val)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
if (ASCII_CHAR_P (c)
&& SUB_CHAR_TABLE_P (tbl->ascii))
- {
- XSUB_CHAR_TABLE (tbl->ascii)->contents[c] = val;
- }
+ set_sub_char_table_contents (tbl->ascii, c, val);
else
{
int i = CHARTAB_IDX (c, 0, 0);
@@ -433,18 +428,17 @@ char_table_set (Lisp_Object table, int c, Lisp_Object val)
if (! SUB_CHAR_TABLE_P (sub))
{
sub = make_sub_char_table (1, i * chartab_chars[0], sub);
- tbl->contents[i] = sub;
+ set_char_table_contents (table, i, sub);
}
sub_char_table_set (sub, c, val, UNIPROP_TABLE_P (table));
if (ASCII_CHAR_P (c))
- tbl->ascii = char_table_ascii (table);
+ set_char_table_ascii (table, char_table_ascii (table));
}
- return val;
}
static void
sub_char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val,
- int is_uniprop)
+ bool is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT ((tbl)->depth);
@@ -461,7 +455,7 @@ sub_char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val,
if (c > to)
break;
if (from <= c && c + chars_in_block - 1 <= to)
- tbl->contents[i] = val;
+ set_sub_char_table_contents (table, i, val);
else
{
Lisp_Object sub = tbl->contents[i];
@@ -472,7 +466,7 @@ sub_char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val,
else
{
sub = make_sub_char_table (depth + 1, c, sub);
- tbl->contents[i] = sub;
+ set_sub_char_table_contents (table, i, sub);
}
}
sub_char_table_set_range (sub, from, to, val, is_uniprop);
@@ -481,7 +475,7 @@ sub_char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val,
}
-Lisp_Object
+void
char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
@@ -490,7 +484,7 @@ char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val)
char_table_set (table, from, val);
else
{
- int is_uniprop = UNIPROP_TABLE_P (table);
+ bool is_uniprop = UNIPROP_TABLE_P (table);
int lim = CHARTAB_IDX (to, 0, 0);
int i, c;
@@ -500,22 +494,21 @@ char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val)
if (c > to)
break;
if (from <= c && c + chartab_chars[0] - 1 <= to)
- tbl->contents[i] = val;
+ set_char_table_contents (table, i, val);
else
{
Lisp_Object sub = tbl->contents[i];
if (! SUB_CHAR_TABLE_P (sub))
{
sub = make_sub_char_table (1, i * chartab_chars[0], sub);
- tbl->contents[i] = sub;
+ set_char_table_contents (table, i, sub);
}
sub_char_table_set_range (sub, from, to, val, is_uniprop);
}
}
if (ASCII_CHAR_P (from))
- tbl->ascii = char_table_ascii (table);
+ set_char_table_ascii (table, char_table_ascii (table));
}
- return val;
}
@@ -563,7 +556,7 @@ Return PARENT. PARENT must be either nil or another char-table. */)
error ("Attempt to make a chartable be its own parent");
}
- XCHAR_TABLE (char_table)->parent = parent;
+ set_char_table_parent (char_table, parent);
return parent;
}
@@ -594,7 +587,8 @@ DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
|| XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
args_out_of_range (char_table, n);
- return XCHAR_TABLE (char_table)->extras[XINT (n)] = value;
+ set_char_table_extras (char_table, XINT (n), value);
+ return value;
}
DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,
@@ -640,13 +634,13 @@ or a character code. Return VALUE. */)
{
int i;
- XCHAR_TABLE (char_table)->ascii = value;
+ set_char_table_ascii (char_table, value);
for (i = 0; i < chartab_size[0]; i++)
- XCHAR_TABLE (char_table)->contents[i] = value;
+ set_char_table_contents (char_table, i, value);
}
else if (EQ (range, Qnil))
- XCHAR_TABLE (char_table)->defalt = value;
- else if (INTEGERP (range))
+ set_char_table_defalt (char_table, value);
+ else if (CHARACTERP (range))
char_table_set (char_table, XINT (range), value);
else if (CONSP (range))
{
@@ -661,15 +655,6 @@ or a character code. Return VALUE. */)
return value;
}
-DEFUN ("set-char-table-default", Fset_char_table_default,
- Sset_char_table_default, 3, 3, 0,
- doc: /*
-This function is obsolete and has no effect. */)
- (Lisp_Object char_table, Lisp_Object ch, Lisp_Object value)
-{
- return Qnil;
-}
-
/* Look up the element in TABLE at index CH, and return it as an
integer. If the element is not a character, return CH itself. */
@@ -689,19 +674,24 @@ optimize_sub_char_table (Lisp_Object table, Lisp_Object test)
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
Lisp_Object elt, this;
- int i, optimizable;
+ int i;
+ bool optimizable;
elt = XSUB_CHAR_TABLE (table)->contents[0];
if (SUB_CHAR_TABLE_P (elt))
- elt = XSUB_CHAR_TABLE (table)->contents[0]
- = optimize_sub_char_table (elt, test);
+ {
+ elt = optimize_sub_char_table (elt, test);
+ set_sub_char_table_contents (table, 0, elt);
+ }
optimizable = SUB_CHAR_TABLE_P (elt) ? 0 : 1;
for (i = 1; i < chartab_size[depth]; i++)
{
this = XSUB_CHAR_TABLE (table)->contents[i];
if (SUB_CHAR_TABLE_P (this))
- this = XSUB_CHAR_TABLE (table)->contents[i]
- = optimize_sub_char_table (this, test);
+ {
+ this = optimize_sub_char_table (this, test);
+ set_sub_char_table_contents (table, i, this);
+ }
if (optimizable
&& (NILP (test) ? NILP (Fequal (this, elt)) /* defaults to `equal'. */
: EQ (test, Qeq) ? !EQ (this, elt) /* Optimize `eq' case. */
@@ -728,11 +718,11 @@ equivalent and can be merged. It defaults to `equal'. */)
{
elt = XCHAR_TABLE (char_table)->contents[i];
if (SUB_CHAR_TABLE_P (elt))
- XCHAR_TABLE (char_table)->contents[i]
- = optimize_sub_char_table (elt, test);
+ set_char_table_contents
+ (char_table, i, optimize_sub_char_table (elt, test));
}
/* Reset the `ascii' cache, in case it got optimized away. */
- XCHAR_TABLE (char_table)->ascii = char_table_ascii (char_table);
+ set_char_table_ascii (char_table, char_table_ascii (char_table));
return Qnil;
}
@@ -764,7 +754,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
int chars_in_block;
int from = XINT (XCAR (range)), to = XINT (XCDR (range));
int i, c;
- int is_uniprop = UNIPROP_TABLE_P (top);
+ bool is_uniprop = UNIPROP_TABLE_P (top);
uniprop_decoder_t decoder = UNIPROP_GET_DECODER (top);
if (SUB_CHAR_TABLE_P (table))
@@ -813,7 +803,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
this = XCHAR_TABLE (top)->defalt;
if (!EQ (val, this))
{
- int different_value = 1;
+ bool different_value = 1;
if (NILP (val))
{
@@ -824,9 +814,9 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
/* This is to get a value of FROM in PARENT
without checking the parent of PARENT. */
- XCHAR_TABLE (parent)->parent = Qnil;
+ set_char_table_parent (parent, Qnil);
val = CHAR_TABLE_REF (parent, from);
- XCHAR_TABLE (parent)->parent = temp;
+ set_char_table_parent (parent, temp);
XSETCDR (range, make_number (c - 1));
val = map_sub_char_table (c_function, function,
parent, arg, val, range,
@@ -906,9 +896,9 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
temp = XCHAR_TABLE (parent)->parent;
/* This is to get a value of FROM in PARENT without checking the
parent of PARENT. */
- XCHAR_TABLE (parent)->parent = Qnil;
+ set_char_table_parent (parent, Qnil);
val = CHAR_TABLE_REF (parent, from);
- XCHAR_TABLE (parent)->parent = temp;
+ set_char_table_parent (parent, temp);
val = map_sub_char_table (c_function, function, parent, arg, val, range,
parent);
table = parent;
@@ -945,11 +935,11 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
2, 2, 0,
- doc: /*
-Call FUNCTION for each character in CHAR-TABLE that has non-nil value.
-FUNCTION is called with two arguments--a key and a value.
-The key is a character code or a cons of character codes specifying a
-range of characters that have the same value. */)
+ doc: /* Call FUNCTION for each character in CHAR-TABLE that has non-nil value.
+FUNCTION is called with two arguments, KEY and VALUE.
+KEY is a character code or a cons of character codes specifying a
+range of characters that have the same value.
+VALUE is what (char-table-range CHAR-TABLE KEY) returns. */)
(Lisp_Object function, Lisp_Object char_table)
{
CHECK_CHAR_TABLE (char_table);
@@ -1143,10 +1133,9 @@ uniprop_table_uncompress (Lisp_Object table, int idx)
int min_char = (XINT (XSUB_CHAR_TABLE (table)->min_char)
+ chartab_chars[2] * idx);
Lisp_Object sub = make_sub_char_table (3, min_char, Qnil);
- struct Lisp_Sub_Char_Table *subtbl = XSUB_CHAR_TABLE (sub);
const unsigned char *p, *pend;
- XSUB_CHAR_TABLE (table)->contents[idx] = sub;
+ set_sub_char_table_contents (table, idx, sub);
p = SDATA (val), pend = p + SBYTES (val);
if (*p == 1)
{
@@ -1156,7 +1145,8 @@ uniprop_table_uncompress (Lisp_Object table, int idx)
while (p < pend && idx < chartab_chars[2])
{
int v = STRING_CHAR_ADVANCE (p);
- subtbl->contents[idx++] = v > 0 ? make_number (v) : Qnil;
+ set_sub_char_table_contents
+ (sub, idx++, v > 0 ? make_number (v) : Qnil);
}
}
else if (*p == 2)
@@ -1181,7 +1171,7 @@ uniprop_table_uncompress (Lisp_Object table, int idx)
}
}
while (count-- > 0)
- subtbl->contents[idx++] = make_number (v);
+ set_sub_char_table_contents (sub, idx++, make_number (v));
}
}
/* It seems that we don't need this function because C code won't need
@@ -1223,7 +1213,7 @@ static int uniprop_decoder_count
static uniprop_decoder_t
uniprop_get_decoder (Lisp_Object table)
{
- int i;
+ EMACS_INT i;
if (! INTEGERP (XCHAR_TABLE (table)->extras[1]))
return NULL;
@@ -1284,7 +1274,7 @@ uniprop_encode_value_numeric (Lisp_Object table, Lisp_Object value)
args[0] = XCHAR_TABLE (table)->extras[4];
args[1] = Fmake_vector (make_number (1), value);
- XCHAR_TABLE (table)->extras[4] = Fvconcat (2, args);
+ set_char_table_extras (table, 4, Fvconcat (2, args));
}
return make_number (i);
}
@@ -1303,7 +1293,7 @@ static int uniprop_encoder_count
static uniprop_decoder_t
uniprop_get_encoder (Lisp_Object table)
{
- int i;
+ EMACS_INT i;
if (! INTEGERP (XCHAR_TABLE (table)->extras[2]))
return NULL;
@@ -1346,7 +1336,7 @@ uniprop_table (Lisp_Object prop)
: ! NILP (val))
return Qnil;
/* Prepare ASCII values in advance for CHAR_TABLE_REF. */
- XCHAR_TABLE (table)->ascii = char_table_ascii (table);
+ set_char_table_ascii (table, char_table_ascii (table));
return table;
}
@@ -1416,7 +1406,6 @@ syms_of_chartab (void)
defsubr (&Sset_char_table_extra_slot);
defsubr (&Schar_table_range);
defsubr (&Sset_char_table_range);
- defsubr (&Sset_char_table_default);
defsubr (&Soptimize_char_table);
defsubr (&Smap_char_table);
defsubr (&Sunicode_property_table_internal);
diff --git a/src/cm.c b/src/cm.c
index 609632eba11..eda6430bafa 100644
--- a/src/cm.c
+++ b/src/cm.c
@@ -1,5 +1,5 @@
/* Cursor motion subroutines for GNU Emacs.
- Copyright (C) 1985, 1995, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1995, 2001-2012 Free Software Foundation, Inc.
based primarily on public domain code written by Chris Torek
This file is part of GNU Emacs.
@@ -20,7 +20,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "frame.h"
@@ -119,7 +118,7 @@ cmcheckmagic (struct tty_display_info *tty)
if (curX (tty) == FrameCols (tty))
{
if (!MagicWrap (tty) || curY (tty) >= FrameRows (tty) - 1)
- abort ();
+ emacs_abort ();
if (tty->termscript)
putc ('\r', tty->termscript);
putc ('\r', tty->output);
diff --git a/src/cm.h b/src/cm.h
index a8c7e0d7c4b..e3e2b71dba6 100644
--- a/src/cm.h
+++ b/src/cm.h
@@ -1,5 +1,5 @@
/* Cursor motion calculation definitions for GNU Emacs
- Copyright (C) 1985, 1989, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1989, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/cmds.c b/src/cmds.c
index 5a155ac77a5..453a4b67e57 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -1,6 +1,6 @@
/* Simple built-in editing commands.
-Copyright (C) 1985, 1993-1998, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1993-1998, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,11 +19,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "commands.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "syntax.h"
#include "window.h"
#include "keyboard.h"
@@ -47,61 +47,65 @@ DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
return make_number (PT + XINT (n));
}
+/* Add N to point; or subtract N if FORWARD is false. N defaults to 1.
+ Validate the new location. Return nil. */
+static Lisp_Object
+move_point (Lisp_Object n, bool forward)
+{
+ /* This used to just set point to point + XINT (n), and then check
+ to see if it was within boundaries. But now that SET_PT can
+ potentially do a lot of stuff (calling entering and exiting
+ hooks, etcetera), that's not a good approach. So we validate the
+ proposed position, then set point. */
+
+ EMACS_INT new_point;
+
+ if (NILP (n))
+ XSETFASTINT (n, 1);
+ else
+ CHECK_NUMBER (n);
+
+ new_point = PT + (forward ? XINT (n) : - XINT (n));
+
+ if (new_point < BEGV)
+ {
+ SET_PT (BEGV);
+ xsignal0 (Qbeginning_of_buffer);
+ }
+ if (new_point > ZV)
+ {
+ SET_PT (ZV);
+ xsignal0 (Qend_of_buffer);
+ }
+
+ SET_PT (new_point);
+ return Qnil;
+}
+
DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "^p",
doc: /* Move point N characters forward (backward if N is negative).
On reaching end or beginning of buffer, stop and signal error.
+Interactively, N is the numeric prefix argument.
Depending on the bidirectional context, the movement may be to the
right or to the left on the screen. This is in contrast with
\\[right-char], which see. */)
(Lisp_Object n)
{
- if (NILP (n))
- XSETFASTINT (n, 1);
- else
- CHECK_NUMBER (n);
-
- /* This used to just set point to point + XINT (n), and then check
- to see if it was within boundaries. But now that SET_PT can
- potentially do a lot of stuff (calling entering and exiting
- hooks, etcetera), that's not a good approach. So we validate the
- proposed position, then set point. */
- {
- EMACS_INT new_point = PT + XINT (n);
-
- if (new_point < BEGV)
- {
- SET_PT (BEGV);
- xsignal0 (Qbeginning_of_buffer);
- }
- if (new_point > ZV)
- {
- SET_PT (ZV);
- xsignal0 (Qend_of_buffer);
- }
-
- SET_PT (new_point);
- }
-
- return Qnil;
+ return move_point (n, 1);
}
DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "^p",
doc: /* Move point N characters backward (forward if N is negative).
On attempt to pass beginning or end of buffer, stop and signal error.
+Interactively, N is the numeric prefix argument.
Depending on the bidirectional context, the movement may be to the
right or to the left on the screen. This is in contrast with
\\[left-char], which see. */)
(Lisp_Object n)
{
- if (NILP (n))
- XSETFASTINT (n, 1);
- else
- CHECK_NUMBER (n);
-
- XSETINT (n, - XINT (n));
- return Fforward_char (n);
+ return move_point (n, 0);
}
DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "^p",
@@ -115,8 +119,8 @@ With positive N, a non-empty line at the end counts as one line
successfully moved (for the return value). */)
(Lisp_Object n)
{
- EMACS_INT opoint = PT, opoint_byte = PT_BYTE;
- EMACS_INT pos, pos_byte;
+ ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
+ ptrdiff_t pos, pos_byte;
EMACS_INT count, shortage;
if (NILP (n))
@@ -187,7 +191,7 @@ not move. To ignore field boundaries bind `inhibit-field-text-motion'
to t. */)
(Lisp_Object n)
{
- EMACS_INT newpos;
+ ptrdiff_t newpos;
if (NILP (n))
XSETFASTINT (n, 1);
@@ -275,7 +279,7 @@ After insertion, the value of `auto-fill-function' is called if the
At the end, it runs `post-self-insert-hook'. */)
(Lisp_Object n)
{
- int remove_boundary = 1;
+ bool remove_boundary = 1;
CHECK_NATNUM (n);
if (!EQ (Vthis_command, KVAR (current_kboard, Vlast_command)))
@@ -294,16 +298,19 @@ At the end, it runs `post-self-insert-hook'. */)
if (remove_boundary
&& CONSP (BVAR (current_buffer, undo_list))
- && NILP (XCAR (BVAR (current_buffer, undo_list))))
+ && NILP (XCAR (BVAR (current_buffer, undo_list)))
+ /* Only remove auto-added boundaries, not boundaries
+ added be explicit calls to undo-boundary. */
+ && EQ (BVAR (current_buffer, undo_list), last_undo_boundary))
/* Remove the undo_boundary that was just pushed. */
- BVAR (current_buffer, undo_list) = XCDR (BVAR (current_buffer, undo_list));
+ bset_undo_list (current_buffer, XCDR (BVAR (current_buffer, undo_list)));
/* Barf if the key that invoked this was not a character. */
if (!CHARACTERP (last_command_event))
bitch_at_user ();
{
int character = translate_char (Vtranslation_table_for_input,
- (int) XINT (last_command_event));
+ XINT (last_command_event));
int val = internal_self_insert (character, XFASTINT (n));
if (val == 2)
nonundocount = 0;
@@ -333,8 +340,8 @@ internal_self_insert (int c, EMACS_INT n)
int len;
/* Working buffer and pointer for multi-byte form of C. */
unsigned char str[MAX_MULTIBYTE_LENGTH];
- EMACS_INT chars_to_delete = 0;
- EMACS_INT spaces_to_insert = 0;
+ ptrdiff_t chars_to_delete = 0;
+ ptrdiff_t spaces_to_insert = 0;
overwrite = BVAR (current_buffer, overwrite_mode);
if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
@@ -371,50 +378,53 @@ internal_self_insert (int c, EMACS_INT n)
/* This is the character after point. */
int c2 = FETCH_CHAR (PT_BYTE);
+ int cwidth;
+
/* Overwriting in binary-mode always replaces C2 by C.
Overwriting in textual-mode doesn't always do that.
It inserts newlines in the usual way,
and inserts any character at end of line
or before a tab if it doesn't use the whole width of the tab. */
if (EQ (overwrite, Qoverwrite_mode_binary))
- chars_to_delete = n;
- else if (c != '\n' && c2 != '\n')
+ chars_to_delete = min (n, PTRDIFF_MAX);
+ else if (c != '\n' && c2 != '\n'
+ && (cwidth = XFASTINT (Fchar_width (make_number (c)))) != 0)
{
- EMACS_INT pos = PT;
- EMACS_INT pos_byte = PT_BYTE;
-
- /* FIXME: Check for integer overflow when calculating
- target_clm and actual_clm. */
-
- /* Column the cursor should be placed at after this insertion.
- The correct value should be calculated only when necessary. */
- EMACS_INT target_clm = (current_column ()
- + n * XINT (Fchar_width (make_number (c))));
+ ptrdiff_t pos = PT;
+ ptrdiff_t pos_byte = PT_BYTE;
+ ptrdiff_t curcol = current_column ();
- /* The actual cursor position after the trial of moving
- to column TARGET_CLM. It is greater than TARGET_CLM
- if the TARGET_CLM is middle of multi-column
- character. In that case, the new point is set after
- that character. */
- EMACS_INT actual_clm
- = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
-
- chars_to_delete = PT - pos;
-
- if (actual_clm > target_clm)
+ if (n <= (min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX) - curcol) / cwidth)
{
- /* We will delete too many columns. Let's fill columns
- by spaces so that the remaining text won't move. */
- EMACS_INT actual = PT_BYTE;
- DEC_POS (actual);
- if (FETCH_CHAR (actual) == '\t')
- /* Rather than add spaces, let's just keep the tab. */
- chars_to_delete--;
- else
- spaces_to_insert = actual_clm - target_clm;
+ /* Column the cursor should be placed at after this insertion.
+ The value should be calculated only when necessary. */
+ ptrdiff_t target_clm = curcol + n * cwidth;
+
+ /* The actual cursor position after the trial of moving
+ to column TARGET_CLM. It is greater than TARGET_CLM
+ if the TARGET_CLM is middle of multi-column
+ character. In that case, the new point is set after
+ that character. */
+ ptrdiff_t actual_clm
+ = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
+
+ chars_to_delete = PT - pos;
+
+ if (actual_clm > target_clm)
+ {
+ /* We will delete too many columns. Let's fill columns
+ by spaces so that the remaining text won't move. */
+ ptrdiff_t actual = PT_BYTE;
+ DEC_POS (actual);
+ if (FETCH_CHAR (actual) == '\t')
+ /* Rather than add spaces, let's just keep the tab. */
+ chars_to_delete--;
+ else
+ spaces_to_insert = actual_clm - target_clm;
+ }
+
+ SET_PT_BOTH (pos, pos_byte);
}
-
- SET_PT_BOTH (pos, pos_byte);
}
hairy = 2;
}
@@ -430,7 +440,7 @@ internal_self_insert (int c, EMACS_INT n)
: UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ())))
== Sword))
{
- int modiff = MODIFF;
+ EMACS_INT modiff = MODIFF;
Lisp_Object sym;
sym = call0 (Qexpand_abbrev);
@@ -438,7 +448,8 @@ internal_self_insert (int c, EMACS_INT n)
/* If we expanded an abbrev which has a hook,
and the hook has a non-nil `no-self-insert' property,
return right away--don't really self-insert. */
- if (SYMBOLP (sym) && ! NILP (sym) && ! NILP (XSYMBOL (sym)->function)
+ if (SYMBOLP (sym) && ! NILP (sym)
+ && ! NILP (XSYMBOL (sym)->function)
&& SYMBOLP (XSYMBOL (sym)->function))
{
Lisp_Object prop;
diff --git a/src/coding.c b/src/coding.c
index e15d725af3a..56202e4861d 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -1,5 +1,5 @@
/* Coding system handler (conversion, detection, etc).
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
@@ -147,19 +147,19 @@ STRUCT CODING_SYSTEM
CODING conforms to the format of XXX, and update the members of
DETECT_INFO.
- Return 1 if the byte sequence conforms to XXX, otherwise return 0.
+ Return true if the byte sequence conforms to XXX.
Below is the template of these functions. */
#if 0
-static int
+static bool
detect_coding_XXX (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
int found = 0;
...;
@@ -212,7 +212,7 @@ decode_coding_XXXX (struct coding_system *coding)
/* A buffer to produce decoded characters. */
int *charbuf = coding->charbuf + coding->charbuf_used;
int *charbuf_end = coding->charbuf + coding->charbuf_size;
- int multibytep = coding->src_multibyte;
+ bool multibytep = coding->src_multibyte;
while (1)
{
@@ -260,13 +260,13 @@ decode_coding_XXXX (struct coding_system *coding)
static void
encode_coding_XXX (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf->charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
unsigned char *adjusted_dst_end = dst_end - _MAX_BYTES_PRODUCED_IN_LOOP_;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
for (; charbuf < charbuf_end && dst < adjusted_dst_end; charbuf++)
{
@@ -285,11 +285,10 @@ encode_coding_XXX (struct coding_system *coding)
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "ccl.h"
#include "composite.h"
@@ -344,6 +343,10 @@ Lisp_Object Qcoding_system_p, Qcoding_system_error;
Lisp_Object Qemacs_mule, Qraw_text;
Lisp_Object Qutf_8_emacs;
+#if defined (WINDOWSNT) || defined (CYGWIN)
+static Lisp_Object Qutf_16le;
+#endif
+
/* Coding-systems are handed between Emacs Lisp programs and C internal
routines by the following three variables. */
/* Coding system to be used to encode text for terminal display when
@@ -416,7 +419,7 @@ enum iso_code_class_type
ISO_shift_out, /* ISO_CODE_SO (0x0E) */
ISO_shift_in, /* ISO_CODE_SI (0x0F) */
ISO_single_shift_2_7, /* ISO_CODE_SS2_7 (0x19) */
- ISO_escape, /* ISO_CODE_SO (0x1B) */
+ ISO_escape, /* ISO_CODE_ESC (0x1B) */
ISO_control_1, /* Control codes in the range
0x80..0x9F, except for the
following 3 codes. */
@@ -651,8 +654,8 @@ static struct coding_system coding_categories[coding_category_max];
/* Safely get one byte from the source text pointed by SRC which ends
at SRC_END, and set C to that byte. If there are not enough bytes
- in the source, it jumps to `no_more_source'. If multibytep is
- nonzero, and a multibyte character is found at SRC, set C to the
+ in the source, it jumps to 'no_more_source'. If MULTIBYTEP,
+ and a multibyte character is found at SRC, set C to the
negative value of the character code. The caller should declare
and set these variables appropriately in advance:
src, src_end, multibytep */
@@ -685,7 +688,7 @@ static struct coding_system coding_categories[coding_category_max];
/* Safely get two bytes from the source text pointed by SRC which ends
at SRC_END, and set C1 and C2 to those bytes while skipping the
heading multibyte characters. If there are not enough bytes in the
- source, it jumps to `no_more_source'. If multibytep is nonzero and
+ source, it jumps to 'no_more_source'. If MULTIBYTEP and
a multibyte character is found for C2, set C2 to the negative value
of the character code. The caller should declare and set these
variables appropriately in advance:
@@ -746,8 +749,8 @@ static struct coding_system coding_categories[coding_category_max];
/* Store a byte C in the place pointed by DST and increment DST to the
- next free point, and increment PRODUCED_CHARS. If MULTIBYTEP is
- nonzero, store in an appropriate multibyte from. The caller should
+ next free point, and increment PRODUCED_CHARS. If MULTIBYTEP,
+ store in an appropriate multibyte form. The caller should
declare and set the variables `dst' and `multibytep' appropriately
in advance. */
@@ -806,81 +809,6 @@ static struct coding_system coding_categories[coding_category_max];
} while (0)
-/* Prototypes for static functions. */
-static void record_conversion_result (struct coding_system *coding,
- enum coding_result_code result);
-static int detect_coding_utf_8 (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_utf_8 (struct coding_system *);
-static int encode_coding_utf_8 (struct coding_system *);
-
-static int detect_coding_utf_16 (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_utf_16 (struct coding_system *);
-static int encode_coding_utf_16 (struct coding_system *);
-
-static int detect_coding_iso_2022 (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_iso_2022 (struct coding_system *);
-static int encode_coding_iso_2022 (struct coding_system *);
-
-static int detect_coding_emacs_mule (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_emacs_mule (struct coding_system *);
-static int encode_coding_emacs_mule (struct coding_system *);
-
-static int detect_coding_sjis (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_sjis (struct coding_system *);
-static int encode_coding_sjis (struct coding_system *);
-
-static int detect_coding_big5 (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_big5 (struct coding_system *);
-static int encode_coding_big5 (struct coding_system *);
-
-static int detect_coding_ccl (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_ccl (struct coding_system *);
-static int encode_coding_ccl (struct coding_system *);
-
-static void decode_coding_raw_text (struct coding_system *);
-static int encode_coding_raw_text (struct coding_system *);
-
-static EMACS_INT coding_set_source (struct coding_system *);
-static EMACS_INT coding_set_destination (struct coding_system *);
-static void coding_alloc_by_realloc (struct coding_system *, EMACS_INT);
-static void coding_alloc_by_making_gap (struct coding_system *,
- EMACS_INT, EMACS_INT);
-static unsigned char *alloc_destination (struct coding_system *,
- EMACS_INT, unsigned char *);
-static void setup_iso_safe_charsets (Lisp_Object);
-static int encode_designation_at_bol (struct coding_system *,
- int *, int *, unsigned char *);
-static int detect_eol (const unsigned char *,
- EMACS_INT, enum coding_category);
-static Lisp_Object adjust_coding_eol_type (struct coding_system *, int);
-static void decode_eol (struct coding_system *);
-static Lisp_Object get_translation_table (Lisp_Object, int, int *);
-static Lisp_Object get_translation (Lisp_Object, int *, int *);
-static int produce_chars (struct coding_system *, Lisp_Object, int);
-static inline void produce_charset (struct coding_system *, int *,
- EMACS_INT);
-static void produce_annotation (struct coding_system *, EMACS_INT);
-static int decode_coding (struct coding_system *);
-static inline int *handle_composition_annotation (EMACS_INT, EMACS_INT,
- struct coding_system *,
- int *, EMACS_INT *);
-static inline int *handle_charset_annotation (EMACS_INT, EMACS_INT,
- struct coding_system *,
- int *, EMACS_INT *);
-static void consume_chars (struct coding_system *, Lisp_Object, int);
-static int encode_coding (struct coding_system *);
-static Lisp_Object make_conversion_work_buffer (int);
-static Lisp_Object code_conversion_restore (Lisp_Object);
-static inline int char_encodable_p (int, Lisp_Object);
-static Lisp_Object make_subsidiaries (Lisp_Object);
-
static void
record_conversion_result (struct coding_system *coding,
enum coding_result_code result)
@@ -922,12 +850,12 @@ record_conversion_result (struct coding_system *coding,
#define CODING_DECODE_CHAR(coding, src, src_base, src_end, charset, code, c) \
do { \
- EMACS_INT offset; \
+ ptrdiff_t offset; \
\
charset_map_loaded = 0; \
c = DECODE_CHAR (charset, code); \
if (charset_map_loaded \
- && (offset = coding_set_source (coding))) \
+ && (offset = coding_change_source (coding))) \
{ \
src += offset; \
src_base += offset; \
@@ -937,12 +865,12 @@ record_conversion_result (struct coding_system *coding,
#define CODING_ENCODE_CHAR(coding, dst, dst_end, charset, c, code) \
do { \
- EMACS_INT offset; \
+ ptrdiff_t offset; \
\
charset_map_loaded = 0; \
code = ENCODE_CHAR (charset, c); \
if (charset_map_loaded \
- && (offset = coding_set_destination (coding))) \
+ && (offset = coding_change_destination (coding))) \
{ \
dst += offset; \
dst_end += offset; \
@@ -951,12 +879,12 @@ record_conversion_result (struct coding_system *coding,
#define CODING_CHAR_CHARSET(coding, dst, dst_end, c, charset_list, code_return, charset) \
do { \
- EMACS_INT offset; \
+ ptrdiff_t offset; \
\
charset_map_loaded = 0; \
charset = char_charset (c, charset_list, code_return); \
if (charset_map_loaded \
- && (offset = coding_set_destination (coding))) \
+ && (offset = coding_change_destination (coding))) \
{ \
dst += offset; \
dst_end += offset; \
@@ -965,12 +893,12 @@ record_conversion_result (struct coding_system *coding,
#define CODING_CHAR_CHARSET_P(coding, dst, dst_end, c, charset, result) \
do { \
- EMACS_INT offset; \
+ ptrdiff_t offset; \
\
charset_map_loaded = 0; \
result = CHAR_CHARSET_P (c, charset); \
if (charset_map_loaded \
- && (offset = coding_set_destination (coding))) \
+ && (offset = coding_change_destination (coding))) \
{ \
dst += offset; \
dst_end += offset; \
@@ -987,7 +915,7 @@ record_conversion_result (struct coding_system *coding,
do { \
if (dst + (bytes) >= dst_end) \
{ \
- EMACS_INT more_bytes = charbuf_end - charbuf + (bytes); \
+ ptrdiff_t more_bytes = charbuf_end - charbuf + (bytes); \
\
dst = alloc_destination (coding, more_bytes, dst); \
dst_end = coding->destination + coding->dst_bytes; \
@@ -996,74 +924,24 @@ record_conversion_result (struct coding_system *coding,
/* Store multibyte form of the character C in P, and advance P to the
- end of the multibyte form. This is like CHAR_STRING_ADVANCE but it
- never calls MAYBE_UNIFY_CHAR. */
-
-#define CHAR_STRING_ADVANCE_NO_UNIFY(c, p) \
- do { \
- if ((c) <= MAX_1_BYTE_CHAR) \
- *(p)++ = (c); \
- else if ((c) <= MAX_2_BYTE_CHAR) \
- *(p)++ = (0xC0 | ((c) >> 6)), \
- *(p)++ = (0x80 | ((c) & 0x3F)); \
- else if ((c) <= MAX_3_BYTE_CHAR) \
- *(p)++ = (0xE0 | ((c) >> 12)), \
- *(p)++ = (0x80 | (((c) >> 6) & 0x3F)), \
- *(p)++ = (0x80 | ((c) & 0x3F)); \
- else if ((c) <= MAX_4_BYTE_CHAR) \
- *(p)++ = (0xF0 | (c >> 18)), \
- *(p)++ = (0x80 | ((c >> 12) & 0x3F)), \
- *(p)++ = (0x80 | ((c >> 6) & 0x3F)), \
- *(p)++ = (0x80 | (c & 0x3F)); \
- else if ((c) <= MAX_5_BYTE_CHAR) \
- *(p)++ = 0xF8, \
- *(p)++ = (0x80 | ((c >> 18) & 0x0F)), \
- *(p)++ = (0x80 | ((c >> 12) & 0x3F)), \
- *(p)++ = (0x80 | ((c >> 6) & 0x3F)), \
- *(p)++ = (0x80 | (c & 0x3F)); \
- else \
- (p) += BYTE8_STRING ((c) - 0x3FFF80, p); \
- } while (0)
+ end of the multibyte form. This used to be like CHAR_STRING_ADVANCE
+ without ever calling MAYBE_UNIFY_CHAR, but nowadays we don't call
+ MAYBE_UNIFY_CHAR in CHAR_STRING_ADVANCE. */
+#define CHAR_STRING_ADVANCE_NO_UNIFY(c, p) CHAR_STRING_ADVANCE(c, p)
/* Return the character code of character whose multibyte form is at
- P, and advance P to the end of the multibyte form. This is like
- STRING_CHAR_ADVANCE, but it never calls MAYBE_UNIFY_CHAR. */
-
-#define STRING_CHAR_ADVANCE_NO_UNIFY(p) \
- (!((p)[0] & 0x80) \
- ? *(p)++ \
- : ! ((p)[0] & 0x20) \
- ? ((p) += 2, \
- ((((p)[-2] & 0x1F) << 6) \
- | ((p)[-1] & 0x3F) \
- | ((unsigned char) ((p)[-2]) < 0xC2 ? 0x3FFF80 : 0))) \
- : ! ((p)[0] & 0x10) \
- ? ((p) += 3, \
- ((((p)[-3] & 0x0F) << 12) \
- | (((p)[-2] & 0x3F) << 6) \
- | ((p)[-1] & 0x3F))) \
- : ! ((p)[0] & 0x08) \
- ? ((p) += 4, \
- ((((p)[-4] & 0xF) << 18) \
- | (((p)[-3] & 0x3F) << 12) \
- | (((p)[-2] & 0x3F) << 6) \
- | ((p)[-1] & 0x3F))) \
- : ((p) += 5, \
- ((((p)[-4] & 0x3F) << 18) \
- | (((p)[-3] & 0x3F) << 12) \
- | (((p)[-2] & 0x3F) << 6) \
- | ((p)[-1] & 0x3F))))
-
-
-/* Update coding->source from coding->src_object, and return how many
- bytes coding->source was changed. */
+ P, and advance P to the end of the multibyte form. This used to be
+ like STRING_CHAR_ADVANCE without ever calling MAYBE_UNIFY_CHAR, but
+ nowadays STRING_CHAR_ADVANCE doesn't call MAYBE_UNIFY_CHAR. */
-static EMACS_INT
+#define STRING_CHAR_ADVANCE_NO_UNIFY(p) STRING_CHAR_ADVANCE(p)
+
+/* Set coding->source from coding->src_object. */
+
+static void
coding_set_source (struct coding_system *coding)
{
- const unsigned char *orig = coding->source;
-
if (BUFFERP (coding->src_object))
{
struct buffer *buf = XBUFFER (coding->src_object);
@@ -1082,18 +960,26 @@ coding_set_source (struct coding_system *coding)
/* Otherwise, the source is C string and is never relocated
automatically. Thus we don't have to update anything. */
}
+}
+
+
+/* Set coding->source from coding->src_object, and return how many
+ bytes coding->source was changed. */
+
+static ptrdiff_t
+coding_change_source (struct coding_system *coding)
+{
+ const unsigned char *orig = coding->source;
+ coding_set_source (coding);
return coding->source - orig;
}
-/* Update coding->destination from coding->dst_object, and return how
- many bytes coding->destination was changed. */
+/* Set coding->destination from coding->dst_object. */
-static EMACS_INT
+static void
coding_set_destination (struct coding_system *coding)
{
- const unsigned char *orig = coding->destination;
-
if (BUFFERP (coding->dst_object))
{
if (BUFFERP (coding->src_object) && coding->src_pos < 0)
@@ -1118,23 +1004,34 @@ coding_set_destination (struct coding_system *coding)
/* Otherwise, the destination is C string and is never relocated
automatically. Thus we don't have to update anything. */
}
+}
+
+
+/* Set coding->destination from coding->dst_object, and return how
+ many bytes coding->destination was changed. */
+
+static ptrdiff_t
+coding_change_destination (struct coding_system *coding)
+{
+ const unsigned char *orig = coding->destination;
+ coding_set_destination (coding);
return coding->destination - orig;
}
static void
-coding_alloc_by_realloc (struct coding_system *coding, EMACS_INT bytes)
+coding_alloc_by_realloc (struct coding_system *coding, ptrdiff_t bytes)
{
if (STRING_BYTES_BOUND - coding->dst_bytes < bytes)
string_overflow ();
- coding->destination = (unsigned char *) xrealloc (coding->destination,
- coding->dst_bytes + bytes);
+ coding->destination = xrealloc (coding->destination,
+ coding->dst_bytes + bytes);
coding->dst_bytes += bytes;
}
static void
coding_alloc_by_making_gap (struct coding_system *coding,
- EMACS_INT gap_head_used, EMACS_INT bytes)
+ ptrdiff_t gap_head_used, ptrdiff_t bytes)
{
if (EQ (coding->src_object, coding->dst_object))
{
@@ -1142,7 +1039,7 @@ coding_alloc_by_making_gap (struct coding_system *coding,
consumed data at the tail. To preserve those data, we at
first make the gap size to zero, then increase the gap
size. */
- EMACS_INT add = GAP_SIZE;
+ ptrdiff_t add = GAP_SIZE;
GPT += gap_head_used, GPT_BYTE += gap_head_used;
GAP_SIZE = 0; ZV += add; Z += add; ZV_BYTE += add; Z_BYTE += add;
@@ -1163,10 +1060,10 @@ coding_alloc_by_making_gap (struct coding_system *coding,
static unsigned char *
-alloc_destination (struct coding_system *coding, EMACS_INT nbytes,
+alloc_destination (struct coding_system *coding, ptrdiff_t nbytes,
unsigned char *dst)
{
- EMACS_INT offset = dst - coding->destination;
+ ptrdiff_t offset = dst - coding->destination;
if (BUFFERP (coding->dst_object))
{
@@ -1246,8 +1143,7 @@ alloc_destination (struct coding_system *coding, EMACS_INT nbytes,
/*** 3. UTF-8 ***/
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in UTF-8. If it is, return 1, else
- return 0. */
+ Return true if a text is encoded in UTF-8. */
#define UTF_8_1_OCTET_P(c) ((c) < 0x80)
#define UTF_8_EXTRA_OCTET_P(c) (((c) & 0xC0) == 0x80)
@@ -1260,16 +1156,16 @@ alloc_destination (struct coding_system *coding, EMACS_INT nbytes,
#define UTF_8_BOM_2 0xBB
#define UTF_8_BOM_3 0xBF
-static int
+static bool
detect_coding_utf_8 (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
- int bom_found = 0;
- int found = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
+ bool bom_found = 0;
+ bool found = 0;
detect_info->checked |= CATEGORY_MASK_UTF_8;
/* A coding system of this category is always ASCII compatible. */
@@ -1352,11 +1248,11 @@ decode_coding_utf_8 (struct coding_system *coding)
const unsigned char *src_base;
int *charbuf = coding->charbuf + coding->charbuf_used;
int *charbuf_end = coding->charbuf + coding->charbuf_size;
- EMACS_INT consumed_chars = 0, consumed_chars_base = 0;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base = 0;
+ bool multibytep = coding->src_multibyte;
enum utf_bom_type bom = CODING_UTF_8_BOM (coding);
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr = -1;
if (bom != utf_without_bom)
@@ -1495,15 +1391,15 @@ decode_coding_utf_8 (struct coding_system *coding)
}
-static int
+static bool
encode_coding_utf_8 (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
int c;
if (CODING_UTF_8_BOM (coding) == utf_with_bom)
@@ -1559,8 +1455,7 @@ encode_coding_utf_8 (struct coding_system *coding)
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in one of UTF-16 based coding systems.
- If it is, return 1, else return 0. */
+ Return true if a text is encoded in one of UTF-16 based coding systems. */
#define UTF_16_HIGH_SURROGATE_P(val) \
(((val) & 0xFC00) == 0xD800)
@@ -1569,13 +1464,13 @@ encode_coding_utf_8 (struct coding_system *coding)
(((val) & 0xFC00) == 0xDC00)
-static int
+static bool
detect_coding_utf_16 (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
+ bool multibytep = coding->src_multibyte;
int c1, c2;
detect_info->checked |= CATEGORY_MASK_UTF_16;
@@ -1661,13 +1556,13 @@ decode_coding_utf_16 (struct coding_system *coding)
int *charbuf = coding->charbuf + coding->charbuf_used;
/* We may produces at most 3 chars in one loop. */
int *charbuf_end = coding->charbuf + coding->charbuf_size - 2;
- EMACS_INT consumed_chars = 0, consumed_chars_base = 0;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base = 0;
+ bool multibytep = coding->src_multibyte;
enum utf_bom_type bom = CODING_UTF_16_BOM (coding);
enum utf_16_endian_type endian = CODING_UTF_16_ENDIAN (coding);
int surrogate = CODING_UTF_16_SURROGATE (coding);
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr1 = -1, byte_after_cr2 = -1;
if (bom == utf_with_bom)
@@ -1777,18 +1672,18 @@ decode_coding_utf_16 (struct coding_system *coding)
coding->charbuf_used = charbuf - coding->charbuf;
}
-static int
+static bool
encode_coding_utf_16 (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = 8;
enum utf_bom_type bom = CODING_UTF_16_BOM (coding);
- int big_endian = CODING_UTF_16_ENDIAN (coding) == utf_16_big_endian;
- EMACS_INT produced_chars = 0;
+ bool big_endian = CODING_UTF_16_ENDIAN (coding) == utf_16_big_endian;
+ ptrdiff_t produced_chars = 0;
int c;
if (bom != utf_without_bom)
@@ -1912,17 +1807,16 @@ char emacs_mule_bytes[256];
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in `emacs-mule'. If it is, return 1,
- else return 0. */
+ Return true if a text is encoded in 'emacs-mule'. */
-static int
+static bool
detect_coding_emacs_mule (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
int c;
int found = 0;
@@ -2011,12 +1905,12 @@ emacs_mule_char (struct coding_system *coding, const unsigned char *src,
{
const unsigned char *src_end = coding->source + coding->src_bytes;
const unsigned char *src_base = src;
- int multibytep = coding->src_multibyte;
+ bool multibytep = coding->src_multibyte;
int charset_ID;
unsigned code;
int c;
int consumed_chars = 0;
- int mseq_found = 0;
+ bool mseq_found = 0;
ONE_MORE_BYTE (c);
if (c < 0)
@@ -2113,7 +2007,7 @@ emacs_mule_char (struct coding_system *coding, const unsigned char *src,
break;
default:
- abort ();
+ emacs_abort ();
}
CODING_DECODE_CHAR (coding, src, src_base, src_end,
CHARSET_FROM_ID (charset_ID), code, c);
@@ -2392,13 +2286,13 @@ decode_coding_emacs_mule (struct coding_system *coding)
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 3)
/* We can produce up to 2 characters in a loop. */
- 1;
- EMACS_INT consumed_chars = 0, consumed_chars_base;
- int multibytep = coding->src_multibyte;
- EMACS_INT char_offset = coding->produced_char;
- EMACS_INT last_offset = char_offset;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t char_offset = coding->produced_char;
+ ptrdiff_t last_offset = char_offset;
int last_id = charset_ascii;
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr = -1;
struct composition_status *cmp_status = &coding->spec.emacs_mule.cmp_status;
@@ -2407,7 +2301,7 @@ decode_coding_emacs_mule (struct coding_system *coding)
int i;
if (charbuf_end - charbuf < cmp_status->length)
- abort ();
+ emacs_abort ();
for (i = 0; i < cmp_status->length; i++)
*charbuf++ = cmp_status->carryover[i];
coding->annotated = 1;
@@ -2467,7 +2361,7 @@ decode_coding_emacs_mule (struct coding_system *coding)
original pointer to buffer text, and fix up all related
pointers after the call. */
const unsigned char *orig = coding->source;
- EMACS_INT offset;
+ ptrdiff_t offset;
c = emacs_mule_char (coding, src_base, &nbytes, &nchars, &id,
cmp_status);
@@ -2639,16 +2533,16 @@ decode_coding_emacs_mule (struct coding_system *coding)
} while (0);
-static int
+static bool
encode_coding_emacs_mule (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = 8;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
Lisp_Object attrs, charset_list;
int c;
int preferred_charset_id = -1;
@@ -2656,8 +2550,8 @@ encode_coding_emacs_mule (struct coding_system *coding)
CODING_GET_INFO (coding, attrs, charset_list);
if (! EQ (charset_list, Vemacs_mule_charset_list))
{
- CODING_ATTR_CHARSET_LIST (attrs)
- = charset_list = Vemacs_mule_charset_list;
+ charset_list = Vemacs_mule_charset_list;
+ ASET (attrs, coding_attr_charset_list, charset_list);
}
while (charbuf < charbuf_end)
@@ -2681,7 +2575,7 @@ encode_coding_emacs_mule (struct coding_system *coding)
preferred_charset_id = -1;
break;
default:
- abort ();
+ emacs_abort ();
}
charbuf += -c - 1;
continue;
@@ -2704,7 +2598,7 @@ encode_coding_emacs_mule (struct coding_system *coding)
if (preferred_charset_id >= 0)
{
- int result;
+ bool result;
charset = CHARSET_FROM_ID (preferred_charset_id);
CODING_CHAR_CHARSET_P (coding, dst, dst_end, c, charset, result);
@@ -2941,7 +2835,7 @@ setup_iso_safe_charsets (Lisp_Object attrs)
Lisp_Object request;
Lisp_Object reg_usage;
Lisp_Object tail;
- int reg94, reg96;
+ EMACS_INT reg94, reg96;
int flags = XINT (AREF (attrs, coding_attr_iso_flags));
int max_charset_id;
@@ -2949,8 +2843,8 @@ setup_iso_safe_charsets (Lisp_Object attrs)
if ((flags & CODING_ISO_FLAG_FULL_SUPPORT)
&& ! EQ (charset_list, Viso_2022_charset_list))
{
- CODING_ATTR_CHARSET_LIST (attrs)
- = charset_list = Viso_2022_charset_list;
+ charset_list = Viso_2022_charset_list;
+ ASET (attrs, coding_attr_charset_list, charset_list);
ASET (attrs, coding_attr_safe_charsets, Qnil);
}
@@ -2999,20 +2893,20 @@ setup_iso_safe_charsets (Lisp_Object attrs)
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in one of ISO-2022 based coding systems.
- If it is, return 1, else return 0. */
+ Return true if a text is encoded in one of ISO-2022 based coding
+ systems. */
-static int
+static bool
detect_coding_iso_2022 (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base = src;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- int single_shifting = 0;
+ bool multibytep = coding->src_multibyte;
+ bool single_shifting = 0;
int id;
int c, c1;
- EMACS_INT consumed_chars = 0;
+ ptrdiff_t consumed_chars = 0;
int i;
int rejected = 0;
int found = 0;
@@ -3171,7 +3065,7 @@ detect_coding_iso_2022 (struct coding_system *coding,
break;
check_extra_latin:
if (! VECTORP (Vlatin_extra_code_table)
- || NILP (XVECTOR (Vlatin_extra_code_table)->contents[c]))
+ || NILP (AREF (Vlatin_extra_code_table, c)))
{
rejected = CATEGORY_MASK_ISO;
break;
@@ -3372,8 +3266,6 @@ detect_coding_iso_2022 (struct coding_system *coding,
/* Finish the current composition as invalid. */
-static int finish_composition (int *, struct composition_status *);
-
static int
finish_composition (int *charbuf, struct composition_status *cmp_status)
{
@@ -3522,8 +3414,8 @@ decode_coding_iso_2022 (struct coding_system *coding)
loop and one more charset annotation at the end. */
int *charbuf_end
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 3);
- EMACS_INT consumed_chars = 0, consumed_chars_base;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base;
+ bool multibytep = coding->src_multibyte;
/* Charsets invoked to graphic plane 0 and 1 respectively. */
int charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
int charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
@@ -3532,11 +3424,11 @@ decode_coding_iso_2022 (struct coding_system *coding)
int c;
struct composition_status *cmp_status = CODING_ISO_CMP_STATUS (coding);
Lisp_Object attrs = CODING_ID_ATTRS (coding->id);
- EMACS_INT char_offset = coding->produced_char;
- EMACS_INT last_offset = char_offset;
+ ptrdiff_t char_offset = coding->produced_char;
+ ptrdiff_t last_offset = char_offset;
int last_id = charset_ascii;
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr = -1;
int i;
@@ -3546,7 +3438,7 @@ decode_coding_iso_2022 (struct coding_system *coding)
if (cmp_status->state != COMPOSING_NO)
{
if (charbuf_end - charbuf < cmp_status->length)
- abort ();
+ emacs_abort ();
for (i = 0; i < cmp_status->length; i++)
*charbuf++ = cmp_status->carryover[i];
coding->annotated = 1;
@@ -3928,7 +3820,7 @@ decode_coding_iso_2022 (struct coding_system *coding)
break;
default:
- abort ();
+ emacs_abort ();
}
if (cmp_status->state == COMPOSING_NO
@@ -4245,7 +4137,7 @@ decode_coding_iso_2022 (struct coding_system *coding)
#define ENCODE_ISO_CHARACTER(charset, c) \
do { \
- int code; \
+ unsigned code; \
CODING_ENCODE_CHAR (coding, dst, dst_end, (charset), (c), code); \
\
if (CHARSET_DIMENSION (charset) == 1) \
@@ -4262,10 +4154,10 @@ decode_coding_iso_2022 (struct coding_system *coding)
static unsigned char *
encode_invocation_designation (struct charset *charset,
struct coding_system *coding,
- unsigned char *dst, EMACS_INT *p_nchars)
+ unsigned char *dst, ptrdiff_t *p_nchars)
{
- int multibytep = coding->dst_multibyte;
- EMACS_INT produced_chars = *p_nchars;
+ bool multibytep = coding->dst_multibyte;
+ ptrdiff_t produced_chars = *p_nchars;
int reg; /* graphic register number */
int id = CHARSET_ID (charset);
@@ -4351,7 +4243,7 @@ encode_invocation_designation (struct charset *charset,
If the current block ends before any end-of-line, we may fail to
find all the necessary designations. */
-static int
+static ptrdiff_t
encode_designation_at_bol (struct coding_system *coding,
int *charbuf, int *charbuf_end,
unsigned char *dst)
@@ -4361,8 +4253,8 @@ encode_designation_at_bol (struct coding_system *coding,
/* Table of charsets to be designated to each graphic register. */
int r[4];
int c, found = 0, reg;
- EMACS_INT produced_chars = 0;
- int multibytep = coding->dst_multibyte;
+ ptrdiff_t produced_chars = 0;
+ bool multibytep = coding->dst_multibyte;
Lisp_Object attrs;
Lisp_Object charset_list;
@@ -4404,21 +4296,21 @@ encode_designation_at_bol (struct coding_system *coding,
/* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions". */
-static int
+static bool
encode_coding_iso_2022 (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = 16;
- int bol_designation
+ bool bol_designation
= (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATE_AT_BOL
&& CODING_ISO_BOL (coding));
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
Lisp_Object attrs, eol_type, charset_list;
- int ascii_compatible;
+ bool ascii_compatible;
int c;
int preferred_charset_id = -1;
@@ -4446,13 +4338,13 @@ encode_coding_iso_2022 (struct coding_system *coding)
/* We have to produce designation sequences if any now. */
unsigned char desig_buf[16];
int nbytes;
- EMACS_INT offset;
+ ptrdiff_t offset;
charset_map_loaded = 0;
nbytes = encode_designation_at_bol (coding, charbuf, charbuf_end,
desig_buf);
if (charset_map_loaded
- && (offset = coding_set_destination (coding)))
+ && (offset = coding_change_destination (coding)))
{
dst += offset;
dst_end += offset;
@@ -4483,7 +4375,7 @@ encode_coding_iso_2022 (struct coding_system *coding)
preferred_charset_id = -1;
break;
default:
- abort ();
+ emacs_abort ();
}
charbuf += -c - 1;
continue;
@@ -4505,8 +4397,9 @@ encode_coding_iso_2022 (struct coding_system *coding)
CODING_ISO_DESIGNATION (coding, i)
= CODING_ISO_INITIAL (coding, i);
}
- bol_designation
- = CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATE_AT_BOL;
+ bol_designation = ((CODING_ISO_FLAGS (coding)
+ & CODING_ISO_FLAG_DESIGNATE_AT_BOL)
+ != 0);
}
else if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_CNTL)
ENCODE_RESET_PLANE_AND_REGISTER ();
@@ -4533,7 +4426,7 @@ encode_coding_iso_2022 (struct coding_system *coding)
if (preferred_charset_id >= 0)
{
- int result;
+ bool result;
charset = CHARSET_FROM_ID (preferred_charset_id);
CODING_CHAR_CHARSET_P (coding, dst, dst_end, c, charset, result);
@@ -4613,17 +4506,16 @@ encode_coding_iso_2022 (struct coding_system *coding)
*/
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in SJIS. If it is, return
- CATEGORY_MASK_SJIS, else return 0. */
+ Return true if a text is encoded in SJIS. */
-static int
+static bool
detect_coding_sjis (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
int found = 0;
int c;
Lisp_Object attrs, charset_list;
@@ -4670,17 +4562,16 @@ detect_coding_sjis (struct coding_system *coding,
}
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in BIG5. If it is, return
- CATEGORY_MASK_BIG5, else return 0. */
+ Return true if a text is encoded in BIG5. */
-static int
+static bool
detect_coding_big5 (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
int found = 0;
int c;
@@ -4717,8 +4608,7 @@ detect_coding_big5 (struct coding_system *coding,
return 1;
}
-/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions".
- If SJIS_P is 1, decode SJIS text, else decode BIG5 test. */
+/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
static void
decode_coding_sjis (struct coding_system *coding)
@@ -4731,16 +4621,16 @@ decode_coding_sjis (struct coding_system *coding)
the end. */
int *charbuf_end
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 2);
- EMACS_INT consumed_chars = 0, consumed_chars_base;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base;
+ bool multibytep = coding->src_multibyte;
struct charset *charset_roman, *charset_kanji, *charset_kana;
struct charset *charset_kanji2;
Lisp_Object attrs, charset_list, val;
- EMACS_INT char_offset = coding->produced_char;
- EMACS_INT last_offset = char_offset;
+ ptrdiff_t char_offset = coding->produced_char;
+ ptrdiff_t last_offset = char_offset;
int last_id = charset_ascii;
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr = -1;
CODING_GET_INFO (coding, attrs, charset_list);
@@ -4849,15 +4739,15 @@ decode_coding_big5 (struct coding_system *coding)
the end. */
int *charbuf_end
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 2);
- EMACS_INT consumed_chars = 0, consumed_chars_base;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base;
+ bool multibytep = coding->src_multibyte;
struct charset *charset_roman, *charset_big5;
Lisp_Object attrs, charset_list, val;
- EMACS_INT char_offset = coding->produced_char;
- EMACS_INT last_offset = char_offset;
+ ptrdiff_t char_offset = coding->produced_char;
+ ptrdiff_t last_offset = char_offset;
int last_id = charset_ascii;
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr = -1;
CODING_GET_INFO (coding, attrs, charset_list);
@@ -4939,21 +4829,20 @@ decode_coding_big5 (struct coding_system *coding)
`japanese-jisx0208', `chinese-big5-1', and `chinese-big5-2'. We
are sure that all these charsets are registered as official charset
(i.e. do not have extended leading-codes). Characters of other
- charsets are produced without any encoding. If SJIS_P is 1, encode
- SJIS text, else encode BIG5 text. */
+ charsets are produced without any encoding. */
-static int
+static bool
encode_coding_sjis (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = 4;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
Lisp_Object attrs, charset_list, val;
- int ascii_compatible;
+ bool ascii_compatible;
struct charset *charset_kanji, *charset_kana;
struct charset *charset_kanji2;
int c;
@@ -5000,7 +4889,7 @@ encode_coding_sjis (struct coding_system *coding)
}
}
if (code == CHARSET_INVALID_CODE (charset))
- abort ();
+ emacs_abort ();
if (charset == charset_kanji)
{
int c1, c2;
@@ -5036,18 +4925,18 @@ encode_coding_sjis (struct coding_system *coding)
return 0;
}
-static int
+static bool
encode_coding_big5 (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = 4;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
Lisp_Object attrs, charset_list, val;
- int ascii_compatible;
+ bool ascii_compatible;
struct charset *charset_big5;
int c;
@@ -5090,7 +4979,7 @@ encode_coding_big5 (struct coding_system *coding)
}
}
if (code == CHARSET_INVALID_CODE (charset))
- abort ();
+ emacs_abort ();
if (charset == charset_big5)
{
int c1, c2;
@@ -5112,21 +5001,20 @@ encode_coding_big5 (struct coding_system *coding)
/*** 10. CCL handlers ***/
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in a coding system of which
- encoder/decoder are written in CCL program. If it is, return
- CATEGORY_MASK_CCL, else return 0. */
+ Return true if a text is encoded in a coding system of which
+ encoder/decoder are written in CCL program. */
-static int
+static bool
detect_coding_ccl (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
int found = 0;
unsigned char *valids;
- EMACS_INT head_ascii = coding->head_ascii;
+ ptrdiff_t head_ascii = coding->head_ascii;
Lisp_Object attrs;
detect_info->checked |= CATEGORY_MASK_CCL;
@@ -5163,8 +5051,8 @@ decode_coding_ccl (struct coding_system *coding)
const unsigned char *src_end = coding->source + coding->src_bytes;
int *charbuf = coding->charbuf + coding->charbuf_used;
int *charbuf_end = coding->charbuf + coding->charbuf_size;
- EMACS_INT consumed_chars = 0;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
struct ccl_program *ccl = &coding->spec.ccl->ccl;
int source_charbuf[1024];
int source_byteidx[1025];
@@ -5175,6 +5063,7 @@ decode_coding_ccl (struct coding_system *coding)
while (1)
{
const unsigned char *p = src;
+ ptrdiff_t offset;
int i = 0;
if (multibytep)
@@ -5192,8 +5081,17 @@ decode_coding_ccl (struct coding_system *coding)
if (p == src_end && coding->mode & CODING_MODE_LAST_BLOCK)
ccl->last_block = 1;
+ /* As ccl_driver calls DECODE_CHAR, buffer may be relocated. */
+ charset_map_loaded = 0;
ccl_driver (ccl, source_charbuf, charbuf, i, charbuf_end - charbuf,
charset_list);
+ if (charset_map_loaded
+ && (offset = coding_change_source (coding)))
+ {
+ p += offset;
+ src += offset;
+ src_end += offset;
+ }
charbuf += ccl->produced;
if (multibytep)
src += source_byteidx[ccl->consumed];
@@ -5225,17 +5123,17 @@ decode_coding_ccl (struct coding_system *coding)
coding->charbuf_used = charbuf - coding->charbuf;
}
-static int
+static bool
encode_coding_ccl (struct coding_system *coding)
{
struct ccl_program *ccl = &coding->spec.ccl->ccl;
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int destination_charbuf[1024];
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
int i;
Lisp_Object attrs, charset_list;
@@ -5246,8 +5144,15 @@ encode_coding_ccl (struct coding_system *coding)
do
{
+ ptrdiff_t offset;
+
+ /* As ccl_driver calls DECODE_CHAR, buffer may be relocated. */
+ charset_map_loaded = 0;
ccl_driver (ccl, charbuf, destination_charbuf,
charbuf_end - charbuf, 1024, charset_list);
+ if (charset_map_loaded
+ && (offset = coding_change_destination (coding)))
+ dst += offset;
if (multibytep)
{
ASSURE_DESTINATION (ccl->produced * 2);
@@ -5290,7 +5195,6 @@ encode_coding_ccl (struct coding_system *coding)
return 0;
}
-
/*** 10, 11. no-conversion handlers ***/
@@ -5299,8 +5203,8 @@ encode_coding_ccl (struct coding_system *coding)
static void
decode_coding_raw_text (struct coding_system *coding)
{
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
coding->chars_at_source = 1;
coding->consumed_char = coding->src_chars;
@@ -5315,15 +5219,15 @@ decode_coding_raw_text (struct coding_system *coding)
record_conversion_result (coding, CODING_RESULT_SUCCESS);
}
-static int
+static bool
encode_coding_raw_text (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = coding->charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
int c;
if (multibytep)
@@ -5396,21 +5300,20 @@ encode_coding_raw_text (struct coding_system *coding)
}
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in a charset-based coding system. If it
- is, return 1, else return 0. */
+ Return true if a text is encoded in a charset-based coding system. */
-static int
+static bool
detect_coding_charset (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
Lisp_Object attrs, valids, name;
int found = 0;
- EMACS_INT head_ascii = coding->head_ascii;
- int check_latin_extra = 0;
+ ptrdiff_t head_ascii = coding->head_ascii;
+ bool check_latin_extra = 0;
detect_info->checked |= CATEGORY_MASK_CHARSET;
@@ -5446,7 +5349,7 @@ detect_coding_charset (struct coding_system *coding,
if (c < 0xA0
&& check_latin_extra
&& (!VECTORP (Vlatin_extra_code_table)
- || NILP (XVECTOR (Vlatin_extra_code_table)->contents[c])))
+ || NILP (AREF (Vlatin_extra_code_table, c))))
break;
found = CATEGORY_MASK_CHARSET;
}
@@ -5513,15 +5416,15 @@ decode_coding_charset (struct coding_system *coding)
the end. */
int *charbuf_end
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 2);
- EMACS_INT consumed_chars = 0, consumed_chars_base;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base;
+ bool multibytep = coding->src_multibyte;
Lisp_Object attrs = CODING_ID_ATTRS (coding->id);
Lisp_Object valids;
- EMACS_INT char_offset = coding->produced_char;
- EMACS_INT last_offset = char_offset;
+ ptrdiff_t char_offset = coding->produced_char;
+ ptrdiff_t last_offset = char_offset;
int last_id = charset_ascii;
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr = -1;
valids = AREF (attrs, coding_attr_charset_valids);
@@ -5630,18 +5533,18 @@ decode_coding_charset (struct coding_system *coding)
coding->charbuf_used = charbuf - coding->charbuf;
}
-static int
+static bool
encode_coding_charset (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = MAX_MULTIBYTE_LENGTH;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
Lisp_Object attrs, charset_list;
- int ascii_compatible;
+ bool ascii_compatible;
int c;
CODING_GET_INFO (coding, attrs, charset_list);
@@ -5847,7 +5750,6 @@ setup_coding_system (Lisp_Object coding_system, struct coding_system *coding)
coding->encoder = encode_coding_emacs_mule;
coding->common_flags
|= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
- coding->spec.emacs_mule.full_support = 1;
if (! NILP (AREF (attrs, coding_attr_emacs_mule_full))
&& ! EQ (CODING_ATTR_CHARSET_LIST (attrs), Vemacs_mule_charset_list))
{
@@ -5865,7 +5767,6 @@ setup_coding_system (Lisp_Object coding_system, struct coding_system *coding)
SSET (safe_charsets, XFASTINT (XCAR (tail)), 0);
coding->max_charset_id = max_charset_id;
coding->safe_charsets = SDATA (safe_charsets);
- coding->spec.emacs_mule.full_support = 1;
}
coding->spec.emacs_mule.cmp_status.state = COMPOSING_NO;
coding->spec.emacs_mule.cmp_status.method = COMPOSITION_NO;
@@ -6188,7 +6089,7 @@ complement_process_encoding_system (Lisp_Object coding_system)
#define MAX_EOL_CHECK_COUNT 3
static int
-detect_eol (const unsigned char *source, EMACS_INT src_bytes,
+detect_eol (const unsigned char *source, ptrdiff_t src_bytes,
enum coding_category category)
{
const unsigned char *src = source, *src_end = src + src_bytes;
@@ -6198,11 +6099,9 @@ detect_eol (const unsigned char *source, EMACS_INT src_bytes,
if ((1 << category) & CATEGORY_MASK_UTF_16)
{
- int msb, lsb;
-
- msb = category == (coding_category_utf_16_le
- | coding_category_utf_16_le_nosig);
- lsb = 1 - msb;
+ bool msb = category == (coding_category_utf_16_le
+ | coding_category_utf_16_le_nosig);
+ bool lsb = !msb;
while (src + 1 < src_end)
{
@@ -6317,7 +6216,7 @@ static void
detect_coding (struct coding_system *coding)
{
const unsigned char *src, *src_end;
- int saved_mode = coding->mode;
+ unsigned int saved_mode = coding->mode;
coding->consumed = coding->consumed_char = 0;
coding->produced = coding->produced_char = 0;
@@ -6332,7 +6231,7 @@ detect_coding (struct coding_system *coding)
{
int c, i;
struct coding_detection_info detect_info;
- int null_byte_found = 0, eight_bit_found = 0;
+ bool null_byte_found = 0, eight_bit_found = 0;
detect_info.checked = detect_info.found = detect_info.rejected = 0;
for (src = coding->source; src < src_end; src++)
@@ -6406,6 +6305,9 @@ detect_coding (struct coding_system *coding)
{
category = coding_priorities[i];
this = coding_categories + category;
+ /* Some of this->detector (e.g. detect_coding_sjis)
+ require this information. */
+ coding->id = this->id;
if (this->id < 0)
{
/* No coding system of this category is defined. */
@@ -6549,7 +6451,7 @@ decode_eol (struct coding_system *coding)
}
else if (EQ (eol_type, Qdos))
{
- EMACS_INT n = 0;
+ ptrdiff_t n = 0;
if (NILP (coding->dst_object))
{
@@ -6564,9 +6466,9 @@ decode_eol (struct coding_system *coding)
}
else
{
- EMACS_INT pos_byte = coding->dst_pos_byte;
- EMACS_INT pos = coding->dst_pos;
- EMACS_INT pos_end = pos + coding->produced_char - 1;
+ ptrdiff_t pos_byte = coding->dst_pos_byte;
+ ptrdiff_t pos = coding->dst_pos;
+ ptrdiff_t pos_end = pos + coding->produced_char - 1;
while (pos < pos_end)
{
@@ -6591,11 +6493,11 @@ decode_eol (struct coding_system *coding)
/* Return a translation table (or list of them) from coding system
- attribute vector ATTRS for encoding (ENCODEP is nonzero) or
- decoding (ENCODEP is zero). */
+ attribute vector ATTRS for encoding (if ENCODEP) or decoding (if
+ not ENCODEP). */
static Lisp_Object
-get_translation_table (Lisp_Object attrs, int encodep, int *max_lookup)
+get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup)
{
Lisp_Object standard, translation_table;
Lisp_Object val;
@@ -6706,8 +6608,8 @@ get_translation (Lisp_Object trans, int *buf, int *buf_end)
{
Lisp_Object val = XCAR (trans);
Lisp_Object from = XCAR (val);
- int len = ASIZE (from);
- int i;
+ ptrdiff_t len = ASIZE (from);
+ ptrdiff_t i;
for (i = 0; i < len; i++)
{
@@ -6725,12 +6627,12 @@ get_translation (Lisp_Object trans, int *buf, int *buf_end)
static int
produce_chars (struct coding_system *coding, Lisp_Object translation_table,
- int last_block)
+ bool last_block)
{
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
- EMACS_INT produced;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced;
+ ptrdiff_t produced_chars = 0;
int carryover = 0;
if (! coding->chars_at_source)
@@ -6747,11 +6649,12 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
while (buf < buf_end)
{
- int c = *buf, i;
+ int c = *buf;
+ ptrdiff_t i;
if (c >= 0)
{
- EMACS_INT from_nchars = 1, to_nchars = 1;
+ ptrdiff_t from_nchars = 1, to_nchars = 1;
Lisp_Object trans = Qnil;
LOOKUP_TRANSLATION_TABLE (translation_table, c, trans);
@@ -6827,8 +6730,8 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
{
if (coding->src_multibyte)
{
- int multibytep = 1;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = 1;
+ ptrdiff_t consumed_chars = 0;
while (1)
{
@@ -6842,14 +6745,14 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
dst_end = (unsigned char *) src;
if (dst == dst_end)
{
- EMACS_INT offset = src - coding->source;
+ ptrdiff_t offset = src - coding->source;
dst = alloc_destination (coding, src_end - src + 1,
dst);
dst_end = coding->destination + coding->dst_bytes;
coding_set_source (coding);
src = coding->source + offset;
- src_end = coding->source + coding->src_bytes;
+ src_end = coding->source + coding->consumed;
if (EQ (coding->src_object, coding->dst_object))
dst_end = (unsigned char *) src;
}
@@ -6863,7 +6766,7 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
else
while (src < src_end)
{
- int multibytep = 1;
+ bool multibytep = 1;
int c = *src++;
if (dst >= dst_end - 1)
@@ -6872,8 +6775,8 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
dst_end = (unsigned char *) src;
if (dst >= dst_end - 1)
{
- EMACS_INT offset = src - coding->source;
- EMACS_INT more_bytes;
+ ptrdiff_t offset = src - coding->source;
+ ptrdiff_t more_bytes;
if (EQ (coding->src_object, coding->dst_object))
more_bytes = ((src_end - src) / 2) + 2;
@@ -6883,7 +6786,7 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
dst_end = coding->destination + coding->dst_bytes;
coding_set_source (coding);
src = coding->source + offset;
- src_end = coding->source + coding->src_bytes;
+ src_end = coding->source + coding->consumed;
if (EQ (coding->src_object, coding->dst_object))
dst_end = (unsigned char *) src;
}
@@ -6895,16 +6798,16 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
{
if (!EQ (coding->src_object, coding->dst_object))
{
- EMACS_INT require = coding->src_bytes - coding->dst_bytes;
+ ptrdiff_t require = coding->src_bytes - coding->dst_bytes;
if (require > 0)
{
- EMACS_INT offset = src - coding->source;
+ ptrdiff_t offset = src - coding->source;
dst = alloc_destination (coding, require, dst);
coding_set_source (coding);
src = coding->source + offset;
- src_end = coding->source + coding->src_bytes;
+ src_end = coding->source + coding->consumed;
}
}
produced_chars = coding->consumed_char;
@@ -6926,11 +6829,11 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
[ -LENGTH ANNOTATION_MASK NCHARS NBYTES METHOD [ COMPONENTS... ] ]
*/
-static inline void
-produce_composition (struct coding_system *coding, int *charbuf, EMACS_INT pos)
+static void
+produce_composition (struct coding_system *coding, int *charbuf, ptrdiff_t pos)
{
int len;
- EMACS_INT to;
+ ptrdiff_t to;
enum composition_method method;
Lisp_Object components;
@@ -6970,10 +6873,10 @@ produce_composition (struct coding_system *coding, int *charbuf, EMACS_INT pos)
[ -LENGTH ANNOTATION_MASK NCHARS CHARSET-ID ]
*/
-static inline void
-produce_charset (struct coding_system *coding, int *charbuf, EMACS_INT pos)
+static void
+produce_charset (struct coding_system *coding, int *charbuf, ptrdiff_t pos)
{
- EMACS_INT from = pos - charbuf[2];
+ ptrdiff_t from = pos - charbuf[2];
struct charset *charset = CHARSET_FROM_ID (charbuf[3]);
Fput_text_property (make_number (from), make_number (pos),
@@ -6991,7 +6894,7 @@ produce_charset (struct coding_system *coding, int *charbuf, EMACS_INT pos)
coding->charbuf = NULL; \
while (size > 1024) \
{ \
- coding->charbuf = (int *) alloca (sizeof (int) * size); \
+ coding->charbuf = alloca (sizeof (int) * size); \
if (coding->charbuf) \
break; \
size >>= 1; \
@@ -6999,14 +6902,14 @@ produce_charset (struct coding_system *coding, int *charbuf, EMACS_INT pos)
if (! coding->charbuf) \
{ \
record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_MEM); \
- return coding->result; \
+ return; \
} \
coding->charbuf_size = size; \
} while (0)
static void
-produce_annotation (struct coding_system *coding, EMACS_INT pos)
+produce_annotation (struct coding_system *coding, ptrdiff_t pos)
{
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
@@ -7060,7 +6963,7 @@ produce_annotation (struct coding_system *coding, EMACS_INT pos)
CODING->dst_object.
*/
-static int
+static void
decode_coding (struct coding_system *coding)
{
Lisp_Object attrs;
@@ -7079,12 +6982,20 @@ decode_coding (struct coding_system *coding)
undo_list = Qt;
if (BUFFERP (coding->dst_object))
{
- if (current_buffer != XBUFFER (coding->dst_object))
- set_buffer_internal (XBUFFER (coding->dst_object));
+ set_buffer_internal (XBUFFER (coding->dst_object));
if (GPT != PT)
move_gap_both (PT, PT_BYTE);
+
+ /* We must disable undo_list in order to record the whole insert
+ transaction via record_insert at the end. But doing so also
+ disables the recording of the first change to the undo_list.
+ Therefore we check for first change here and record it via
+ record_first_change if needed. */
+ if (MODIFF <= SAVE_MODIFF)
+ record_first_change ();
+
undo_list = BVAR (current_buffer, undo_list);
- BVAR (current_buffer, undo_list) = Qt;
+ bset_undo_list (current_buffer, Qt);
}
coding->consumed = coding->consumed_char = 0;
@@ -7106,7 +7017,7 @@ decode_coding (struct coding_system *coding)
}
do
{
- EMACS_INT pos = coding->dst_pos + coding->produced_char;
+ ptrdiff_t pos = coding->dst_pos + coding->produced_char;
coding_set_source (coding);
coding->annotated = 0;
@@ -7181,10 +7092,9 @@ decode_coding (struct coding_system *coding)
decode_eol (coding);
if (BUFFERP (coding->dst_object))
{
- BVAR (current_buffer, undo_list) = undo_list;
+ bset_undo_list (current_buffer, undo_list);
record_insert (coding->dst_pos, coding->produced_char);
}
- return coding->result;
}
@@ -7198,12 +7108,12 @@ decode_coding (struct coding_system *coding)
position of a composition after POS (if any) or to LIMIT, and
return BUF. */
-static inline int *
-handle_composition_annotation (EMACS_INT pos, EMACS_INT limit,
+static int *
+handle_composition_annotation (ptrdiff_t pos, ptrdiff_t limit,
struct coding_system *coding, int *buf,
- EMACS_INT *stop)
+ ptrdiff_t *stop)
{
- EMACS_INT start, end;
+ ptrdiff_t start, end;
Lisp_Object prop;
if (! find_composition (pos, limit, &start, &end, &prop, coding->src_object)
@@ -7225,7 +7135,7 @@ handle_composition_annotation (EMACS_INT pos, EMACS_INT limit,
if (method != COMPOSITION_RELATIVE)
{
Lisp_Object components;
- int len, i, i_byte;
+ ptrdiff_t i, len, i_byte;
components = COMPOSITION_COMPONENTS (prop);
if (VECTORP (components))
@@ -7256,7 +7166,7 @@ handle_composition_annotation (EMACS_INT pos, EMACS_INT limit,
*buf++ = XINT (XCAR (components));
}
else
- abort ();
+ emacs_abort ();
*head -= len;
}
}
@@ -7281,10 +7191,10 @@ handle_composition_annotation (EMACS_INT pos, EMACS_INT limit,
If the property value is nil, set *STOP to the position where the
property value is non-nil (limiting by LIMIT), and return BUF. */
-static inline int *
-handle_charset_annotation (EMACS_INT pos, EMACS_INT limit,
+static int *
+handle_charset_annotation (ptrdiff_t pos, ptrdiff_t limit,
struct coding_system *coding, int *buf,
- EMACS_INT *stop)
+ ptrdiff_t *stop)
{
Lisp_Object val, next;
int id;
@@ -7311,12 +7221,12 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table,
int *buf_end = coding->charbuf + coding->charbuf_size;
const unsigned char *src = coding->source + coding->consumed;
const unsigned char *src_end = coding->source + coding->src_bytes;
- EMACS_INT pos = coding->src_pos + coding->consumed_char;
- EMACS_INT end_pos = coding->src_pos + coding->src_chars;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t pos = coding->src_pos + coding->consumed_char;
+ ptrdiff_t end_pos = coding->src_pos + coding->src_chars;
+ bool multibytep = coding->src_multibyte;
Lisp_Object eol_type;
int c;
- EMACS_INT stop, stop_composition, stop_charset;
+ ptrdiff_t stop, stop_composition, stop_charset;
int *lookup_buf = NULL;
if (! NILP (translation_table))
@@ -7365,7 +7275,7 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table,
if (! multibytep)
{
- EMACS_INT bytes;
+ int bytes;
if (coding->encoder == encode_coding_raw_text
|| coding->encoder == encode_coding_ccl)
@@ -7396,7 +7306,7 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table,
*buf++ = c;
else
{
- int from_nchars = 1, to_nchars = 1;
+ ptrdiff_t from_nchars = 1, to_nchars = 1;
int *lookup_buf_end;
const unsigned char *p = src;
int i;
@@ -7417,7 +7327,7 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table,
else
{
to_nchars = ASIZE (trans);
- if (buf + to_nchars > buf_end)
+ if (buf_end - buf < to_nchars)
break;
c = XINT (AREF (trans, 0));
}
@@ -7460,7 +7370,7 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table,
If CODING->dst_object is nil, the encoded data is placed at the
memory area specified by CODING->destination. */
-static int
+static void
encode_coding (struct coding_system *coding)
{
Lisp_Object attrs;
@@ -7502,8 +7412,6 @@ encode_coding (struct coding_system *coding)
if (BUFFERP (coding->dst_object) && coding->produced_char > 0)
insert_from_gap (coding->produced_char, coding->produced);
-
- return (coding->result);
}
@@ -7517,26 +7425,27 @@ static Lisp_Object Vcode_conversion_workbuf_name;
versions of Vcode_conversion_workbuf_name. */
static Lisp_Object Vcode_conversion_reused_workbuf;
-/* 1 iff Vcode_conversion_reused_workbuf is already in use. */
-static int reused_workbuf_in_use;
+/* True iff Vcode_conversion_reused_workbuf is already in use. */
+static bool reused_workbuf_in_use;
/* Return a working buffer of code conversion. MULTIBYTE specifies the
multibyteness of returning buffer. */
static Lisp_Object
-make_conversion_work_buffer (int multibyte)
+make_conversion_work_buffer (bool multibyte)
{
Lisp_Object name, workbuf;
struct buffer *current;
- if (reused_workbuf_in_use++)
+ if (reused_workbuf_in_use)
{
name = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil);
workbuf = Fget_buffer_create (name);
}
else
{
+ reused_workbuf_in_use = 1;
if (NILP (Fbuffer_live_p (Vcode_conversion_reused_workbuf)))
Vcode_conversion_reused_workbuf
= Fget_buffer_create (Vcode_conversion_workbuf_name);
@@ -7549,8 +7458,8 @@ make_conversion_work_buffer (int multibyte)
doesn't compile new regexps. */
Fset (Fmake_local_variable (Qinhibit_modification_hooks), Qt);
Ferase_buffer ();
- BVAR (current_buffer, undo_list) = Qt;
- BVAR (current_buffer, enable_multibyte_characters) = multibyte ? Qt : Qnil;
+ bset_undo_list (current_buffer, Qt);
+ bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil);
set_buffer_internal (current);
return workbuf;
}
@@ -7569,7 +7478,7 @@ code_conversion_restore (Lisp_Object arg)
{
if (EQ (workbuf, Vcode_conversion_reused_workbuf))
reused_workbuf_in_use = 0;
- else if (! NILP (Fbuffer_live_p (workbuf)))
+ else
Fkill_buffer (workbuf);
}
set_buffer_internal (XBUFFER (current));
@@ -7578,7 +7487,7 @@ code_conversion_restore (Lisp_Object arg)
}
Lisp_Object
-code_conversion_save (int with_work_buf, int multibyte)
+code_conversion_save (bool with_work_buf, bool multibyte)
{
Lisp_Object workbuf = Qnil;
@@ -7589,11 +7498,11 @@ code_conversion_save (int with_work_buf, int multibyte)
return workbuf;
}
-int
+void
decode_coding_gap (struct coding_system *coding,
- EMACS_INT chars, EMACS_INT bytes)
+ ptrdiff_t chars, ptrdiff_t bytes)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object attrs;
code_conversion_save (0, 0);
@@ -7620,7 +7529,7 @@ decode_coding_gap (struct coding_system *coding,
attrs = CODING_ID_ATTRS (coding->id);
if (! NILP (CODING_ATTR_POST_READ (attrs)))
{
- EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE;
+ ptrdiff_t prev_Z = Z, prev_Z_BYTE = Z_BYTE;
Lisp_Object val;
TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
@@ -7632,7 +7541,6 @@ decode_coding_gap (struct coding_system *coding,
}
unbind_to (count, Qnil);
- return coding->result;
}
@@ -7668,18 +7576,18 @@ decode_coding_gap (struct coding_system *coding,
void
decode_coding_object (struct coding_system *coding,
Lisp_Object src_object,
- EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte,
+ ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte,
Lisp_Object dst_object)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
unsigned char *destination IF_LINT (= NULL);
- EMACS_INT dst_bytes IF_LINT (= 0);
- EMACS_INT chars = to - from;
- EMACS_INT bytes = to_byte - from_byte;
+ ptrdiff_t dst_bytes IF_LINT (= 0);
+ ptrdiff_t chars = to - from;
+ ptrdiff_t bytes = to_byte - from_byte;
Lisp_Object attrs;
- int saved_pt = -1, saved_pt_byte IF_LINT (= 0);
- int need_marker_adjustment = 0;
+ ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0);
+ bool need_marker_adjustment = 0;
Lisp_Object old_deactivate_mark;
old_deactivate_mark = Vdeactivate_mark;
@@ -7769,7 +7677,7 @@ decode_coding_object (struct coding_system *coding,
if (! NILP (CODING_ATTR_POST_READ (attrs)))
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE;
+ ptrdiff_t prev_Z = Z, prev_Z_BYTE = Z_BYTE;
Lisp_Object val;
TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
@@ -7858,17 +7766,17 @@ decode_coding_object (struct coding_system *coding,
void
encode_coding_object (struct coding_system *coding,
Lisp_Object src_object,
- EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte,
+ ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte,
Lisp_Object dst_object)
{
- int count = SPECPDL_INDEX ();
- EMACS_INT chars = to - from;
- EMACS_INT bytes = to_byte - from_byte;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t chars = to - from;
+ ptrdiff_t bytes = to_byte - from_byte;
Lisp_Object attrs;
- int saved_pt = -1, saved_pt_byte IF_LINT (= 0);
- int need_marker_adjustment = 0;
- int kill_src_buffer = 0;
+ ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0);
+ bool need_marker_adjustment = 0;
+ bool kill_src_buffer = 0;
Lisp_Object old_deactivate_mark;
old_deactivate_mark = Vdeactivate_mark;
@@ -7912,15 +7820,12 @@ encode_coding_object (struct coding_system *coding,
}
{
- Lisp_Object args[3];
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
GCPRO5 (coding->src_object, coding->dst_object, src_object, dst_object,
old_deactivate_mark);
- args[0] = CODING_ATTR_PRE_WRITE (attrs);
- args[1] = make_number (BEG);
- args[2] = make_number (Z);
- safe_call (3, args);
+ safe_call2 (CODING_ATTR_PRE_WRITE (attrs),
+ make_number (BEG), make_number (Z));
UNGCPRO;
}
if (XBUFFER (coding->src_object) != current_buffer)
@@ -7987,7 +7892,7 @@ encode_coding_object (struct coding_system *coding,
{
ptrdiff_t dst_bytes = max (1, coding->src_chars);
coding->dst_object = Qnil;
- coding->destination = (unsigned char *) xmalloc (dst_bytes);
+ coding->destination = xmalloc (dst_bytes);
coding->dst_bytes = dst_bytes;
coding->dst_multibyte = 0;
}
@@ -8070,6 +7975,40 @@ preferred_coding_system (void)
return CODING_ID_NAME (id);
}
+#if defined (WINDOWSNT) || defined (CYGWIN)
+
+Lisp_Object
+from_unicode (Lisp_Object str)
+{
+ CHECK_STRING (str);
+ if (!STRING_MULTIBYTE (str) &&
+ SBYTES (str) & 1)
+ {
+ str = Fsubstring (str, make_number (0), make_number (-1));
+ }
+
+ return code_convert_string_norecord (str, Qutf_16le, 0);
+}
+
+wchar_t *
+to_unicode (Lisp_Object str, Lisp_Object *buf)
+{
+ *buf = code_convert_string_norecord (str, Qutf_16le, 1);
+ /* We need to make a another copy (in addition to the one made by
+ code_convert_string_norecord) to ensure that the final string is
+ _doubly_ zero terminated --- that is, that the string is
+ terminated by two zero bytes and one utf-16le null character.
+ Because strings are already terminated with a single zero byte,
+ we just add one additional zero. */
+ str = make_uninit_string (SBYTES (*buf) + 1);
+ memcpy (SDATA (str), SDATA (*buf), SBYTES (*buf));
+ SDATA (str) [SBYTES (*buf)] = '\0';
+ *buf = str;
+ return WCSDATA (*buf);
+}
+
+#endif /* WINDOWSNT || CYGWIN */
+
#ifdef emacs
/*** 8. Emacs Lisp library functions ***/
@@ -8112,7 +8051,7 @@ are lower-case). */)
(Lisp_Object prompt, Lisp_Object default_coding_system)
{
Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (SYMBOLP (default_coding_system))
default_coding_system = SYMBOL_NAME (default_coding_system);
@@ -8147,10 +8086,10 @@ function `define-coding-system'. */)
/* Detect how the bytes at SRC of length SRC_BYTES are encoded. If
- HIGHEST is nonzero, return the coding system of the highest
+ HIGHEST, return the coding system of the highest
priority among the detected coding systems. Otherwise return a
list of detected coding systems sorted by their priorities. If
- MULTIBYTEP is nonzero, it is assumed that the bytes are in correct
+ MULTIBYTEP, it is assumed that the bytes are in correct
multibyte form but contains only ASCII and eight-bit chars.
Otherwise, the bytes are raw bytes.
@@ -8164,8 +8103,8 @@ function `define-coding-system'. */)
Lisp_Object
detect_coding_system (const unsigned char *src,
- EMACS_INT src_chars, EMACS_INT src_bytes,
- int highest, int multibytep,
+ ptrdiff_t src_chars, ptrdiff_t src_bytes,
+ bool highest, bool multibytep,
Lisp_Object coding_system)
{
const unsigned char *src_end = src + src_bytes;
@@ -8175,7 +8114,7 @@ detect_coding_system (const unsigned char *src,
ptrdiff_t id;
struct coding_detection_info detect_info;
enum coding_category base_category;
- int null_byte_found = 0, eight_bit_found = 0;
+ bool null_byte_found = 0, eight_bit_found = 0;
if (NILP (coding_system))
coding_system = Qundecided;
@@ -8484,8 +8423,8 @@ If optional argument HIGHEST is non-nil, return the coding system of
highest priority. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object highest)
{
- int from, to;
- int from_byte, to_byte;
+ ptrdiff_t from, to;
+ ptrdiff_t from_byte, to_byte;
CHECK_NUMBER_COERCE_MARKER (start);
CHECK_NUMBER_COERCE_MARKER (end);
@@ -8531,7 +8470,7 @@ highest priority. */)
}
-static inline int
+static bool
char_encodable_p (int c, Lisp_Object attrs)
{
Lisp_Object tail;
@@ -8565,7 +8504,7 @@ DEFUN ("find-coding-systems-region-internal",
(Lisp_Object start, Lisp_Object end, Lisp_Object exclude)
{
Lisp_Object coding_attrs_list, safe_codings;
- EMACS_INT start_byte, end_byte;
+ ptrdiff_t start_byte, end_byte;
const unsigned char *p, *pbeg, *pend;
int c;
Lisp_Object tail, elt, work_table;
@@ -8659,7 +8598,7 @@ DEFUN ("find-coding-systems-region-internal",
}
if (charset_map_loaded)
{
- EMACS_INT p_offset = p - pbeg, pend_offset = pend - pbeg;
+ ptrdiff_t p_offset = p - pbeg, pend_offset = pend - pbeg;
if (STRINGP (start))
pbeg = SDATA (start);
@@ -8697,13 +8636,13 @@ for un-encodable characters. In that case, START and END are indexes
to the string. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object count, Lisp_Object string)
{
- int n;
+ EMACS_INT n;
struct coding_system coding;
Lisp_Object attrs, charset_list, translation_table;
Lisp_Object positions;
- int from, to;
+ ptrdiff_t from, to;
const unsigned char *p, *stop, *pend;
- int ascii_compatible;
+ bool ascii_compatible;
setup_coding_system (Fcheck_coding_system (coding_system), &coding);
attrs = CODING_ID_ATTRS (coding.id);
@@ -8734,11 +8673,10 @@ to the string. */)
CHECK_STRING (string);
CHECK_NATNUM (start);
CHECK_NATNUM (end);
+ if (! (XINT (start) <= XINT (end) && XINT (end) <= SCHARS (string)))
+ args_out_of_range_3 (string, start, end);
from = XINT (start);
to = XINT (end);
- if (from > to
- || to > SCHARS (string))
- args_out_of_range_3 (string, start, end);
if (! STRING_MULTIBYTE (string))
return Qnil;
p = SDATA (string) + string_char_to_byte (string, from);
@@ -8824,8 +8762,8 @@ is nil. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object coding_system_list)
{
Lisp_Object list;
- EMACS_INT start_byte, end_byte;
- int pos;
+ ptrdiff_t start_byte, end_byte;
+ ptrdiff_t pos;
const unsigned char *p, *pbeg, *pend;
int c;
Lisp_Object tail, elt, attrs;
@@ -8898,7 +8836,7 @@ is nil. */)
}
if (charset_map_loaded)
{
- EMACS_INT p_offset = p - pbeg, pend_offset = pend - pbeg;
+ ptrdiff_t p_offset = p - pbeg, pend_offset = pend - pbeg;
if (STRINGP (start))
pbeg = SDATA (start);
@@ -8928,10 +8866,10 @@ is nil. */)
static Lisp_Object
code_convert_region (Lisp_Object start, Lisp_Object end,
Lisp_Object coding_system, Lisp_Object dst_object,
- int encodep, int norecord)
+ bool encodep, bool norecord)
{
struct coding_system coding;
- EMACS_INT from, from_byte, to, to_byte;
+ ptrdiff_t from, from_byte, to, to_byte;
Lisp_Object src_object;
CHECK_NUMBER_COERCE_MARKER (start);
@@ -9016,10 +8954,11 @@ not fully specified.) */)
Lisp_Object
code_convert_string (Lisp_Object string, Lisp_Object coding_system,
- Lisp_Object dst_object, int encodep, int nocopy, int norecord)
+ Lisp_Object dst_object, bool encodep, bool nocopy,
+ bool norecord)
{
struct coding_system coding;
- EMACS_INT chars, bytes;
+ ptrdiff_t chars, bytes;
CHECK_STRING (string);
if (NILP (coding_system))
@@ -9064,7 +9003,7 @@ code_convert_string (Lisp_Object string, Lisp_Object coding_system,
Lisp_Object
code_convert_string_norecord (Lisp_Object string, Lisp_Object coding_system,
- int encodep)
+ bool encodep)
{
return code_convert_string (string, coding_system, Qt, encodep, 0, 1);
}
@@ -9278,10 +9217,10 @@ DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_intern
terminal_coding->common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
terminal_coding->src_multibyte = 1;
terminal_coding->dst_multibyte = 0;
- if (terminal_coding->common_flags & CODING_REQUIRE_ENCODING_MASK)
- term->charset_list = coding_charset_list (terminal_coding);
- else
- term->charset_list = Fcons (make_number (charset_ascii), Qnil);
+ tset_charset_list
+ (term, (terminal_coding->common_flags & CODING_REQUIRE_ENCODING_MASK
+ ? coding_charset_list (terminal_coding)
+ : Fcons (make_number (charset_ascii), Qnil)));
return Qnil;
}
@@ -9394,9 +9333,9 @@ usage: (find-operation-coding-system OPERATION ARGUMENTS...) */)
error ("Too few arguments");
operation = args[0];
if (!SYMBOLP (operation)
- || !NATNUMP (target_idx = Fget (operation, Qtarget_idx)))
+ || (target_idx = Fget (operation, Qtarget_idx), !NATNUMP (target_idx)))
error ("Invalid first argument");
- if (nargs < 1 + XFASTINT (target_idx))
+ if (nargs <= 1 + XFASTINT (target_idx))
error ("Too few arguments for operation `%s'",
SDATA (SYMBOL_NAME (operation)));
target = args[XFASTINT (target_idx) + 1];
@@ -9465,7 +9404,7 @@ usage: (set-coding-system-priority &rest coding-systems) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t i, j;
- int changed[coding_category_max];
+ bool changed[coding_category_max];
enum coding_category priorities[coding_category_max];
memset (changed, 0, sizeof changed);
@@ -9499,7 +9438,7 @@ usage: (set-coding-system-priority &rest coding-systems) */)
&& changed[coding_priorities[j]])
j++;
if (j == coding_category_max)
- abort ();
+ emacs_abort ();
priorities[i] = coding_priorities[j];
}
@@ -9550,7 +9489,7 @@ make_subsidiaries (Lisp_Object base)
{
Lisp_Object subsidiaries;
ptrdiff_t base_name_len = SBYTES (SYMBOL_NAME (base));
- char *buf = (char *) alloca (base_name_len + 6);
+ char *buf = alloca (base_name_len + 6);
int i;
memcpy (buf, SDATA (SYMBOL_NAME (base)), base_name_len);
@@ -9588,16 +9527,16 @@ usage: (define-coding-system-internal ...) */)
name = args[coding_arg_name];
CHECK_SYMBOL (name);
- CODING_ATTR_BASE_NAME (attrs) = name;
+ ASET (attrs, coding_attr_base_name, name);
val = args[coding_arg_mnemonic];
if (! STRINGP (val))
CHECK_CHARACTER (val);
- CODING_ATTR_MNEMONIC (attrs) = val;
+ ASET (attrs, coding_attr_mnemonic, val);
coding_type = args[coding_arg_coding_type];
CHECK_SYMBOL (coding_type);
- CODING_ATTR_TYPE (attrs) = coding_type;
+ ASET (attrs, coding_attr_type, coding_type);
charset_list = args[coding_arg_charset_list];
if (SYMBOLP (charset_list))
@@ -9615,8 +9554,12 @@ usage: (define-coding-system-internal ...) */)
charset_list = Vemacs_mule_charset_list;
}
for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
- if (max_charset_id < XFASTINT (XCAR (tail)))
- max_charset_id = XFASTINT (XCAR (tail));
+ {
+ if (! RANGED_INTEGERP (0, XCAR (tail), INT_MAX - 1))
+ error ("Invalid charset-list");
+ if (max_charset_id < XFASTINT (XCAR (tail)))
+ max_charset_id = XFASTINT (XCAR (tail));
+ }
}
else
{
@@ -9640,49 +9583,49 @@ usage: (define-coding-system-internal ...) */)
max_charset_id = charset->id;
}
}
- CODING_ATTR_CHARSET_LIST (attrs) = charset_list;
+ ASET (attrs, coding_attr_charset_list, charset_list);
safe_charsets = make_uninit_string (max_charset_id + 1);
memset (SDATA (safe_charsets), 255, max_charset_id + 1);
for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
SSET (safe_charsets, XFASTINT (XCAR (tail)), 0);
- CODING_ATTR_SAFE_CHARSETS (attrs) = safe_charsets;
+ ASET (attrs, coding_attr_safe_charsets, safe_charsets);
- CODING_ATTR_ASCII_COMPAT (attrs) = args[coding_arg_ascii_compatible_p];
+ ASET (attrs, coding_attr_ascii_compat, args[coding_arg_ascii_compatible_p]);
val = args[coding_arg_decode_translation_table];
if (! CHAR_TABLE_P (val) && ! CONSP (val))
CHECK_SYMBOL (val);
- CODING_ATTR_DECODE_TBL (attrs) = val;
+ ASET (attrs, coding_attr_decode_tbl, val);
val = args[coding_arg_encode_translation_table];
if (! CHAR_TABLE_P (val) && ! CONSP (val))
CHECK_SYMBOL (val);
- CODING_ATTR_ENCODE_TBL (attrs) = val;
+ ASET (attrs, coding_attr_encode_tbl, val);
val = args[coding_arg_post_read_conversion];
CHECK_SYMBOL (val);
- CODING_ATTR_POST_READ (attrs) = val;
+ ASET (attrs, coding_attr_post_read, val);
val = args[coding_arg_pre_write_conversion];
CHECK_SYMBOL (val);
- CODING_ATTR_PRE_WRITE (attrs) = val;
+ ASET (attrs, coding_attr_pre_write, val);
val = args[coding_arg_default_char];
if (NILP (val))
- CODING_ATTR_DEFAULT_CHAR (attrs) = make_number (' ');
+ ASET (attrs, coding_attr_default_char, make_number (' '));
else
{
CHECK_CHARACTER (val);
- CODING_ATTR_DEFAULT_CHAR (attrs) = val;
+ ASET (attrs, coding_attr_default_char, val);
}
val = args[coding_arg_for_unibyte];
- CODING_ATTR_FOR_UNIBYTE (attrs) = NILP (val) ? Qnil : Qt;
+ ASET (attrs, coding_attr_for_unibyte, NILP (val) ? Qnil : Qt);
val = args[coding_arg_plist];
CHECK_LIST (val);
- CODING_ATTR_PLIST (attrs) = val;
+ ASET (attrs, coding_attr_plist, val);
if (EQ (coding_type, Qcharset))
{
@@ -9707,7 +9650,7 @@ usage: (define-coding-system-internal ...) */)
int idx = (dim - 1) * 4;
if (CHARSET_ASCII_COMPATIBLE_P (charset))
- CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
+ ASET (attrs, coding_attr_ascii_compat, Qt);
for (i = charset->code_space[idx];
i <= charset->code_space[idx + 1]; i++)
@@ -9769,30 +9712,30 @@ usage: (define-coding-system-internal ...) */)
val = args[coding_arg_ccl_valids];
valids = Fmake_string (make_number (256), make_number (0));
- for (tail = val; !NILP (tail); tail = Fcdr (tail))
+ for (tail = val; CONSP (tail); tail = XCDR (tail))
{
int from, to;
- val = Fcar (tail);
+ val = XCAR (tail);
if (INTEGERP (val))
{
- from = to = XINT (val);
- if (from < 0 || from > 255)
+ if (! (0 <= XINT (val) && XINT (val) <= 255))
args_out_of_range_3 (val, make_number (0), make_number (255));
+ from = to = XINT (val);
}
else
{
CHECK_CONS (val);
CHECK_NATNUM_CAR (val);
- CHECK_NATNUM_CDR (val);
- from = XINT (XCAR (val));
- if (from > 255)
+ CHECK_NUMBER_CDR (val);
+ if (XINT (XCAR (val)) > 255)
args_out_of_range_3 (XCAR (val),
make_number (0), make_number (255));
- to = XINT (XCDR (val));
- if (to < from || to > 255)
+ from = XINT (XCAR (val));
+ if (! (from <= XINT (XCDR (val)) && XINT (XCDR (val)) <= 255))
args_out_of_range_3 (XCDR (val),
XCAR (val), make_number (255));
+ to = XINT (XCDR (val));
}
for (i = from; i <= to; i++)
SSET (valids, i, 1);
@@ -9805,7 +9748,7 @@ usage: (define-coding-system-internal ...) */)
{
Lisp_Object bom, endian;
- CODING_ATTR_ASCII_COMPAT (attrs) = Qnil;
+ ASET (attrs, coding_attr_ascii_compat, Qnil);
if (nargs < coding_arg_utf16_max)
goto short_args;
@@ -9858,7 +9801,7 @@ usage: (define-coding-system-internal ...) */)
CHECK_CHARSET_GET_CHARSET (val, charset);
ASET (initial, i, make_number (CHARSET_ID (charset)));
if (i == 0 && CHARSET_ASCII_COMPATIBLE_P (charset))
- CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
+ ASET (attrs, coding_attr_ascii_compat, Qt);
}
else
ASET (initial, i, make_number (-1));
@@ -9870,12 +9813,12 @@ usage: (define-coding-system-internal ...) */)
CHECK_NUMBER_CDR (reg_usage);
request = Fcopy_sequence (args[coding_arg_iso2022_request]);
- for (tail = request; ! NILP (tail); tail = Fcdr (tail))
+ for (tail = request; CONSP (tail); tail = XCDR (tail))
{
int id;
Lisp_Object tmp1;
- val = Fcar (tail);
+ val = XCAR (tail);
CHECK_CONS (val);
tmp1 = XCAR (val);
CHECK_CHARSET_GET_ID (tmp1, id);
@@ -9887,9 +9830,10 @@ usage: (define-coding-system-internal ...) */)
flags = args[coding_arg_iso2022_flags];
CHECK_NATNUM (flags);
- i = XINT (flags);
+ i = XINT (flags) & INT_MAX;
if (EQ (args[coding_arg_charset_list], Qiso_2022))
- flags = make_number (i | CODING_ISO_FLAG_FULL_SUPPORT);
+ i |= CODING_ISO_FLAG_FULL_SUPPORT;
+ flags = make_number (i);
ASET (attrs, coding_attr_iso_initial, initial);
ASET (attrs, coding_attr_iso_usage, reg_usage);
@@ -9918,13 +9862,13 @@ usage: (define-coding-system-internal ...) */)
}
if (category != coding_category_iso_8_1
&& category != coding_category_iso_8_2)
- CODING_ATTR_ASCII_COMPAT (attrs) = Qnil;
+ ASET (attrs, coding_attr_ascii_compat, Qnil);
}
else if (EQ (coding_type, Qemacs_mule))
{
if (EQ (args[coding_arg_charset_list], Qemacs_mule))
ASET (attrs, coding_attr_emacs_mule_full, Qt);
- CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
+ ASET (attrs, coding_attr_ascii_compat, Qt);
category = coding_category_emacs_mule;
}
else if (EQ (coding_type, Qshift_jis))
@@ -9941,7 +9885,7 @@ usage: (define-coding-system-internal ...) */)
error ("Dimension of charset %s is not one",
SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
if (CHARSET_ASCII_COMPATIBLE_P (charset))
- CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
+ ASET (attrs, coding_attr_ascii_compat, Qt);
charset_list = XCDR (charset_list);
charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
@@ -9979,7 +9923,7 @@ usage: (define-coding-system-internal ...) */)
error ("Dimension of charset %s is not one",
SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
if (CHARSET_ASCII_COMPATIBLE_P (charset))
- CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
+ ASET (attrs, coding_attr_ascii_compat, Qt);
charset_list = XCDR (charset_list);
charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
@@ -9993,14 +9937,12 @@ usage: (define-coding-system-internal ...) */)
else if (EQ (coding_type, Qraw_text))
{
category = coding_category_raw_text;
- CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
+ ASET (attrs, coding_attr_ascii_compat, Qt);
}
else if (EQ (coding_type, Qutf_8))
{
Lisp_Object bom;
- CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
-
if (nargs < coding_arg_utf8_max)
goto short_args;
@@ -10014,6 +9956,8 @@ usage: (define-coding-system-internal ...) */)
CHECK_CODING_SYSTEM (val);
}
ASET (attrs, coding_attr_utf_bom, bom);
+ if (NILP (bom))
+ ASET (attrs, coding_attr_ascii_compat, Qt);
category = (CONSP (bom) ? coding_category_utf_8_auto
: NILP (bom) ? coding_category_utf_8_nosig
@@ -10025,14 +9969,15 @@ usage: (define-coding-system-internal ...) */)
error ("Invalid coding system type: %s",
SDATA (SYMBOL_NAME (coding_type)));
- CODING_ATTR_CATEGORY (attrs) = make_number (category);
- CODING_ATTR_PLIST (attrs)
- = Fcons (QCcategory, Fcons (AREF (Vcoding_category_table, category),
- CODING_ATTR_PLIST (attrs)));
- CODING_ATTR_PLIST (attrs)
- = Fcons (QCascii_compatible_p,
- Fcons (CODING_ATTR_ASCII_COMPAT (attrs),
- CODING_ATTR_PLIST (attrs)));
+ ASET (attrs, coding_attr_category, make_number (category));
+ ASET (attrs, coding_attr_plist,
+ Fcons (QCcategory,
+ Fcons (AREF (Vcoding_category_table, category),
+ CODING_ATTR_PLIST (attrs))));
+ ASET (attrs, coding_attr_plist,
+ Fcons (QCascii_compatible_p,
+ Fcons (CODING_ATTR_ASCII_COMPAT (attrs),
+ CODING_ATTR_PLIST (attrs))));
eol_type = args[coding_arg_eol_type];
if (! NILP (eol_type)
@@ -10106,7 +10051,7 @@ DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put,
{
if (! STRINGP (val))
CHECK_CHARACTER (val);
- CODING_ATTR_MNEMONIC (attrs) = val;
+ ASET (attrs, coding_attr_mnemonic, val);
}
else if (EQ (prop, QCdefault_char))
{
@@ -10114,37 +10059,37 @@ DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put,
val = make_number (' ');
else
CHECK_CHARACTER (val);
- CODING_ATTR_DEFAULT_CHAR (attrs) = val;
+ ASET (attrs, coding_attr_default_char, val);
}
else if (EQ (prop, QCdecode_translation_table))
{
if (! CHAR_TABLE_P (val) && ! CONSP (val))
CHECK_SYMBOL (val);
- CODING_ATTR_DECODE_TBL (attrs) = val;
+ ASET (attrs, coding_attr_decode_tbl, val);
}
else if (EQ (prop, QCencode_translation_table))
{
if (! CHAR_TABLE_P (val) && ! CONSP (val))
CHECK_SYMBOL (val);
- CODING_ATTR_ENCODE_TBL (attrs) = val;
+ ASET (attrs, coding_attr_encode_tbl, val);
}
else if (EQ (prop, QCpost_read_conversion))
{
CHECK_SYMBOL (val);
- CODING_ATTR_POST_READ (attrs) = val;
+ ASET (attrs, coding_attr_post_read, val);
}
else if (EQ (prop, QCpre_write_conversion))
{
CHECK_SYMBOL (val);
- CODING_ATTR_PRE_WRITE (attrs) = val;
+ ASET (attrs, coding_attr_pre_write, val);
}
else if (EQ (prop, QCascii_compatible_p))
{
- CODING_ATTR_ASCII_COMPAT (attrs) = val;
+ ASET (attrs, coding_attr_ascii_compat, val);
}
- CODING_ATTR_PLIST (attrs)
- = Fplist_put (CODING_ATTR_PLIST (attrs), prop, val);
+ ASET (attrs, coding_attr_plist,
+ Fplist_put (CODING_ATTR_PLIST (attrs), prop, val));
return val;
}
@@ -10327,7 +10272,7 @@ syms_of_coding (void)
Vcode_conversion_reused_workbuf = Qnil;
staticpro (&Vcode_conversion_workbuf_name);
- Vcode_conversion_workbuf_name = make_pure_c_string (" *code-conversion-work*");
+ Vcode_conversion_workbuf_name = build_pure_c_string (" *code-conversion-work*");
reused_workbuf_in_use = 0;
@@ -10377,6 +10322,11 @@ syms_of_coding (void)
DEFSYM (Qutf_8, "utf-8");
DEFSYM (Qutf_8_emacs, "utf-8-emacs");
+#if defined (WINDOWSNT) || defined (CYGWIN)
+ /* No, not utf-16-le: that one has a BOM. */
+ DEFSYM (Qutf_16le, "utf-16le");
+#endif
+
DEFSYM (Qutf_16, "utf-16");
DEFSYM (Qbig, "big");
DEFSYM (Qlittle, "little");
@@ -10388,9 +10338,9 @@ syms_of_coding (void)
DEFSYM (Qcoding_system_error, "coding-system-error");
Fput (Qcoding_system_error, Qerror_conditions,
- pure_cons (Qcoding_system_error, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qcoding_system_error, Qerror));
Fput (Qcoding_system_error, Qerror_message,
- make_pure_c_string ("Invalid coding system"));
+ build_pure_c_string ("Invalid coding system"));
/* Intern this now in case it isn't already done.
Setting this variable twice is harmless.
@@ -10537,7 +10487,7 @@ Don't modify this variable directly, but use `set-coding-system-priority'. */);
Vcoding_category_list = Qnil;
for (i = coding_category_max - 1; i >= 0; i--)
Vcoding_category_list
- = Fcons (XVECTOR (Vcoding_category_table)->contents[i],
+ = Fcons (AREF (Vcoding_category_table, i),
Vcoding_category_list);
}
@@ -10663,22 +10613,22 @@ Also used for decoding keyboard input on X Window system. */);
DEFVAR_LISP ("eol-mnemonic-unix", eol_mnemonic_unix,
doc: /*
*String displayed in mode line for UNIX-like (LF) end-of-line format. */);
- eol_mnemonic_unix = make_pure_c_string (":");
+ eol_mnemonic_unix = build_pure_c_string (":");
DEFVAR_LISP ("eol-mnemonic-dos", eol_mnemonic_dos,
doc: /*
*String displayed in mode line for DOS-like (CRLF) end-of-line format. */);
- eol_mnemonic_dos = make_pure_c_string ("\\");
+ eol_mnemonic_dos = build_pure_c_string ("\\");
DEFVAR_LISP ("eol-mnemonic-mac", eol_mnemonic_mac,
doc: /*
*String displayed in mode line for MAC-like (CR) end-of-line format. */);
- eol_mnemonic_mac = make_pure_c_string ("/");
+ eol_mnemonic_mac = build_pure_c_string ("/");
DEFVAR_LISP ("eol-mnemonic-undecided", eol_mnemonic_undecided,
doc: /*
*String displayed in mode line when end-of-line format is not yet determined. */);
- eol_mnemonic_undecided = make_pure_c_string (":");
+ eol_mnemonic_undecided = build_pure_c_string (":");
DEFVAR_LISP ("enable-character-translation", Venable_character_translation,
doc: /*
@@ -10816,7 +10766,7 @@ internal character representation. */);
plist[10] = intern_c_string (":for-unibyte");
plist[11] = args[coding_arg_for_unibyte] = Qt;
plist[12] = intern_c_string (":docstring");
- plist[13] = make_pure_c_string ("Do no conversion.\n\
+ plist[13] = build_pure_c_string ("Do no conversion.\n\
\n\
When you visit a file with this coding, the file is read into a\n\
unibyte buffer as is, thus each byte of a file is treated as a\n\
@@ -10834,7 +10784,7 @@ character.");
plist[8] = intern_c_string (":charset-list");
plist[9] = args[coding_arg_charset_list] = Fcons (Qascii, Qnil);
plist[11] = args[coding_arg_for_unibyte] = Qnil;
- plist[13] = make_pure_c_string ("No conversion on encoding, automatic conversion on decoding.");
+ plist[13] = build_pure_c_string ("No conversion on encoding, automatic conversion on decoding.");
plist[15] = args[coding_arg_eol_type] = Qnil;
args[coding_arg_plist] = Flist (16, plist);
Fdefine_coding_system_internal (coding_arg_max, args);
diff --git a/src/coding.h b/src/coding.h
index b694e6c6b6e..192be58f083 100644
--- a/src/coding.h
+++ b/src/coding.h
@@ -1,5 +1,5 @@
/* Header for coding system handler.
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
@@ -177,7 +177,6 @@ enum coding_attr_index
#define CODING_ATTR_PRE_WRITE(attrs) AREF (attrs, coding_attr_pre_write)
#define CODING_ATTR_DEFAULT_CHAR(attrs) AREF (attrs, coding_attr_default_char)
#define CODING_ATTR_FOR_UNIBYTE(attrs) AREF (attrs, coding_attr_for_unibyte)
-#define CODING_ATTR_FLUSHING(attrs) AREF (attrs, coding_attr_flushing)
#define CODING_ATTR_PLIST(attrs) AREF (attrs, coding_attr_plist)
#define CODING_ATTR_CATEGORY(attrs) AREF (attrs, coding_attr_category)
#define CODING_ATTR_SAFE_CHARSETS(attrs)AREF (attrs, coding_attr_safe_charsets)
@@ -322,7 +321,7 @@ struct composition_status
{
enum composition_state state;
enum composition_method method;
- int old_form; /* 0:pre-21 form, 1:post-21 form */
+ bool old_form; /* true if pre-21 form */
int length; /* number of elements produced in charbuf */
int nchars; /* number of characters composed */
int ncomps; /* number of composition components */
@@ -351,18 +350,18 @@ struct iso_2022_spec
there was an invalid designation previously. */
int current_designation[4];
- /* Set to 1 temporarily only when graphic register 2 or 3 is invoked
- by single-shift while encoding. */
- int single_shifting;
-
- /* Set to 1 temporarily only when processing at beginning of line. */
- int bol;
-
/* If positive, we are now scanning CTEXT extended segment. */
int ctext_extended_segment_len;
- /* If nonzero, we are now scanning embedded UTF-8 sequence. */
- int embedded_utf_8;
+ /* True temporarily only when graphic register 2 or 3 is invoked by
+ single-shift while encoding. */
+ unsigned single_shifting : 1;
+
+ /* True temporarily only when processing at beginning of line. */
+ unsigned bol : 1;
+
+ /* If true, we are now scanning embedded UTF-8 sequence. */
+ unsigned embedded_utf_8 : 1;
/* The current composition. */
struct composition_status cmp_status;
@@ -370,7 +369,6 @@ struct iso_2022_spec
struct emacs_mule_spec
{
- int full_support;
struct composition_status cmp_status;
};
@@ -449,32 +447,28 @@ struct coding_system
-1 in setup_coding_system, and updated by detect_coding. So,
when this is equal to the byte length of the text being
converted, we can skip the actual conversion process. */
- EMACS_INT head_ascii;
+ ptrdiff_t head_ascii;
/* The following members are set by encoding/decoding routine. */
- EMACS_INT produced, produced_char, consumed, consumed_char;
+ ptrdiff_t produced, produced_char, consumed, consumed_char;
/* Number of error source data found in a decoding routine. */
int errors;
/* Store the positions of error source data. */
- EMACS_INT *error_positions;
+ ptrdiff_t *error_positions;
/* Finish status of code conversion. */
enum coding_result_code result;
- EMACS_INT src_pos, src_pos_byte, src_chars, src_bytes;
+ ptrdiff_t src_pos, src_pos_byte, src_chars, src_bytes;
Lisp_Object src_object;
const unsigned char *source;
- EMACS_INT dst_pos, dst_pos_byte, dst_bytes;
+ ptrdiff_t dst_pos, dst_pos_byte, dst_bytes;
Lisp_Object dst_object;
unsigned char *destination;
- /* Set to 1 if the source of conversion is not in the member
- `charbuf', but at `src_object'. */
- int chars_at_source;
-
/* If an element is non-negative, it is a character code.
If it is in the range -128..-1, it is a 8-bit character code
@@ -485,23 +479,26 @@ struct coding_system
element. The following elements are OFFSET, ANNOTATION-TYPE, and
a sequence of actual data for the annotation. OFFSET is a
character position offset from dst_pos or src_pos,
- ANNOTATION-TYPE specfies the meaning of the annotation and how to
+ ANNOTATION-TYPE specifies the meaning of the annotation and how to
handle the following data.. */
int *charbuf;
int charbuf_size, charbuf_used;
+ /* True if the source of conversion is not in the member
+ `charbuf', but at `src_object'. */
+ unsigned chars_at_source : 1;
+
/* Set to 1 if charbuf contains an annotation. */
- int annotated;
+ unsigned annotated : 1;
unsigned char carryover[64];
int carryover_bytes;
int default_char;
- int (*detector) (struct coding_system *,
- struct coding_detection_info *);
+ bool (*detector) (struct coding_system *, struct coding_detection_info *);
void (*decoder) (struct coding_system *);
- int (*encoder) (struct coding_system *);
+ bool (*encoder) (struct coding_system *);
};
/* Meanings of bits in the member `common_flags' of the structure
@@ -649,10 +646,8 @@ struct coding_system
for file names, if any. */
#define ENCODE_FILE(name) \
(! NILP (Vfile_name_coding_system) \
- && !EQ (Vfile_name_coding_system, make_number (0)) \
? code_convert_string_norecord (name, Vfile_name_coding_system, 1) \
: (! NILP (Vdefault_file_name_coding_system) \
- && !EQ (Vdefault_file_name_coding_system, make_number (0)) \
? code_convert_string_norecord (name, Vdefault_file_name_coding_system, 1) \
: name))
@@ -661,10 +656,8 @@ struct coding_system
for file names, if any. */
#define DECODE_FILE(name) \
(! NILP (Vfile_name_coding_system) \
- && !EQ (Vfile_name_coding_system, make_number (0)) \
? code_convert_string_norecord (name, Vfile_name_coding_system, 0) \
: (! NILP (Vdefault_file_name_coding_system) \
- && !EQ (Vdefault_file_name_coding_system, make_number (0)) \
? code_convert_string_norecord (name, Vdefault_file_name_coding_system, 0) \
: name))
@@ -673,7 +666,6 @@ struct coding_system
for system functions, if any. */
#define ENCODE_SYSTEM(str) \
(! NILP (Vlocale_coding_system) \
- && !EQ (Vlocale_coding_system, make_number (0)) \
? code_convert_string_norecord (str, Vlocale_coding_system, 1) \
: str)
@@ -681,7 +673,6 @@ struct coding_system
for system functions, if any. */
#define DECODE_SYSTEM(str) \
(! NILP (Vlocale_coding_system) \
- && !EQ (Vlocale_coding_system, make_number (0)) \
? code_convert_string_norecord (str, Vlocale_coding_system, 0) \
: str)
@@ -689,28 +680,48 @@ struct coding_system
#define ENCODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, 1)
/* Extern declarations. */
-extern Lisp_Object code_conversion_save (int, int);
-extern int decoding_buffer_size (struct coding_system *, int);
-extern int encoding_buffer_size (struct coding_system *, int);
+extern Lisp_Object code_conversion_save (bool, bool);
extern void setup_coding_system (Lisp_Object, struct coding_system *);
extern Lisp_Object coding_charset_list (struct coding_system *);
extern Lisp_Object coding_system_charset_list (Lisp_Object);
extern Lisp_Object code_convert_string (Lisp_Object, Lisp_Object,
- Lisp_Object, int, int, int);
+ Lisp_Object, bool, bool, bool);
extern Lisp_Object code_convert_string_norecord (Lisp_Object, Lisp_Object,
- int);
+ bool);
extern Lisp_Object raw_text_coding_system (Lisp_Object);
extern Lisp_Object coding_inherit_eol_type (Lisp_Object, Lisp_Object);
extern Lisp_Object complement_process_encoding_system (Lisp_Object);
-extern int decode_coding_gap (struct coding_system *,
- EMACS_INT, EMACS_INT);
+extern void decode_coding_gap (struct coding_system *,
+ ptrdiff_t, ptrdiff_t);
extern void decode_coding_object (struct coding_system *,
- Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, Lisp_Object);
+ Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, Lisp_Object);
extern void encode_coding_object (struct coding_system *,
- Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, Lisp_Object);
+ Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, Lisp_Object);
+
+#if defined (WINDOWSNT) || defined (CYGWIN)
+
+/* These functions use Lisp string objects to store the UTF-16LE
+ strings that modern versions of Windows expect. These strings are
+ not particularly useful to Lisp, and all Lisp strings should be
+ native Emacs multibyte. */
+
+/* Access the wide-character string stored in a Lisp string object. */
+#define WCSDATA(x) ((wchar_t *) SDATA (x))
+
+/* Convert the multi-byte string in STR to UTF-16LE encoded unibyte
+ string, and store it in *BUF. BUF may safely point to STR on entry. */
+extern wchar_t *to_unicode (Lisp_Object str, Lisp_Object *buf);
+
+/* Convert STR, a UTF-16LE encoded string embedded in a unibyte string
+ object, to a multi-byte Emacs string and return it. This function
+ calls code_convert_string_norecord internally and has all its
+ failure modes. STR itself is not modified. */
+extern Lisp_Object from_unicode (Lisp_Object str);
+
+#endif /* WINDOWSNT || CYGWIN */
/* Macros for backward compatibility. */
@@ -779,6 +790,5 @@ extern struct coding_system safe_terminal_coding;
extern Lisp_Object Qcoding_system_error;
extern char emacs_mule_bytes[256];
-extern int emacs_mule_string_char (unsigned char *);
#endif /* EMACS_CODING_H */
diff --git a/src/commands.h b/src/commands.h
index bcd5de44180..510fce0e182 100644
--- a/src/commands.h
+++ b/src/commands.h
@@ -1,5 +1,5 @@
/* Definitions needed by most editing commands.
- Copyright (C) 1985, 1994, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -36,9 +36,6 @@ extern Lisp_Object control_x_map;
events until a non-ASCII event is acceptable as input. */
extern Lisp_Object unread_switch_frame;
-/* Nonzero means ^G can quit instantly */
-extern int immediate_quit;
-
/* Nonzero if input is coming from the keyboard */
#define INTERACTIVE (NILP (Vexecuting_kbd_macro) && !noninteractive)
diff --git a/src/composite.c b/src/composite.c
index 885e0262673..bcde0a4c9e6 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -1,5 +1,5 @@
/* Composite sequence support.
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
@@ -23,10 +23,12 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
+#define COMPOSITE_INLINE EXTERN_INLINE
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "coding.h"
#include "intervals.h"
#include "window.h"
@@ -158,9 +160,6 @@ static Lisp_Object Qauto_composition_function;
auto-compositions. */
#define MAX_AUTO_COMPOSITION_LOOKBACK 3
-static Lisp_Object Fcomposition_get_gstring (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object);
-
/* Temporary variable used in macros COMPOSITION_XXX. */
Lisp_Object composition_temp;
@@ -173,7 +172,7 @@ Lisp_Object composition_temp;
If the composition is invalid, return -1. */
ptrdiff_t
-get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars,
+get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
Lisp_Object prop, Lisp_Object string)
{
Lisp_Object id, length, components, key, *key_contents;
@@ -183,7 +182,7 @@ get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars,
EMACS_UINT hash_code;
enum composition_method method;
struct composition *cmp;
- EMACS_INT i;
+ ptrdiff_t i;
int ch;
/* Maximum length of a string of glyphs. XftGlyphExtents limits
@@ -240,13 +239,13 @@ get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars,
for (i = 0; i < nchars; i++)
{
FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos);
- XVECTOR (key)->contents[i] = make_number (ch);
+ ASET (key, i, make_number (ch));
}
else
for (i = 0; i < nchars; i++)
{
FETCH_CHAR_ADVANCE (ch, charpos, bytepos);
- XVECTOR (key)->contents[i] = make_number (ch);
+ ASET (key, i, make_number (ch));
}
}
else
@@ -284,7 +283,7 @@ get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars,
&& VECTORP (AREF (components, 0)))
{
/* COMPONENTS is a glyph-string. */
- EMACS_INT len = ASIZE (key);
+ ptrdiff_t len = ASIZE (key);
for (i = 1; i < len; i++)
if (! VECTORP (AREF (key, i)))
@@ -292,7 +291,7 @@ get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars,
}
else if (VECTORP (components) || CONSP (components))
{
- EMACS_INT len = ASIZE (key);
+ ptrdiff_t len = ASIZE (key);
/* The number of elements should be odd. */
if ((len % 2) == 0)
@@ -329,7 +328,7 @@ get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars,
memory_full (SIZE_MAX);
/* Register the composition in composition_table. */
- cmp = (struct composition *) xmalloc (sizeof (struct composition));
+ cmp = xmalloc (sizeof *cmp);
cmp->method = method;
cmp->hash_index = hash_index;
@@ -355,7 +354,7 @@ get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars,
else
{
/* Rule-base composition. */
- float leftmost = 0.0, rightmost;
+ double leftmost = 0.0, rightmost;
ch = XINT (key_contents[0]);
rightmost = ch != '\t' ? CHAR_WIDTH (ch) : 1;
@@ -364,7 +363,7 @@ get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars,
{
int rule, gref, nref;
int this_width;
- float this_left;
+ double this_left;
rule = XINT (key_contents[i]);
ch = XINT (key_contents[i + 1]);
@@ -428,9 +427,9 @@ get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars,
This doesn't check the validity of composition. */
-int
-find_composition (EMACS_INT pos, EMACS_INT limit,
- EMACS_INT *start, EMACS_INT *end,
+bool
+find_composition (ptrdiff_t pos, ptrdiff_t limit,
+ ptrdiff_t *start, ptrdiff_t *end,
Lisp_Object *prop, Lisp_Object object)
{
Lisp_Object val;
@@ -469,10 +468,10 @@ find_composition (EMACS_INT pos, EMACS_INT limit,
FROM and TO with property PROP. */
static void
-run_composition_function (EMACS_INT from, EMACS_INT to, Lisp_Object prop)
+run_composition_function (ptrdiff_t from, ptrdiff_t to, Lisp_Object prop)
{
Lisp_Object func;
- EMACS_INT start, end;
+ ptrdiff_t start, end;
func = COMPOSITION_MODIFICATION_FUNC (prop);
/* If an invalid composition precedes or follows, try to make them
@@ -501,13 +500,13 @@ run_composition_function (EMACS_INT from, EMACS_INT to, Lisp_Object prop)
change is deletion, FROM == TO. Otherwise, FROM < TO. */
void
-update_compositions (EMACS_INT from, EMACS_INT to, int check_mask)
+update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask)
{
Lisp_Object prop;
- EMACS_INT start, end;
+ ptrdiff_t start, end;
/* The beginning and end of the region to set the property
`auto-composed' to nil. */
- EMACS_INT min_pos = from, max_pos = to;
+ ptrdiff_t min_pos = from, max_pos = to;
if (inhibit_modification_hooks)
return;
@@ -589,7 +588,7 @@ update_compositions (EMACS_INT from, EMACS_INT to, int check_mask)
}
if (min_pos < max_pos)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
@@ -632,7 +631,7 @@ make_composition_value_copy (Lisp_Object list)
indices START and END in STRING. */
void
-compose_text (EMACS_INT start, EMACS_INT end, Lisp_Object components,
+compose_text (ptrdiff_t start, ptrdiff_t end, Lisp_Object components,
Lisp_Object modification_func, Lisp_Object string)
{
Lisp_Object prop;
@@ -644,8 +643,8 @@ compose_text (EMACS_INT start, EMACS_INT end, Lisp_Object components,
}
-static Lisp_Object autocmp_chars (Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, struct window *,
+static Lisp_Object autocmp_chars (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, struct window *,
struct face *, Lisp_Object);
@@ -669,25 +668,25 @@ gstring_lookup_cache (Lisp_Object header)
}
Lisp_Object
-composition_gstring_put_cache (Lisp_Object gstring, EMACS_INT len)
+composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len)
{
struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
EMACS_UINT hash;
Lisp_Object header, copy;
- EMACS_INT i;
+ ptrdiff_t i;
header = LGSTRING_HEADER (gstring);
- hash = h->hashfn (h, header);
+ hash = h->test.hashfn (&h->test, header);
if (len < 0)
{
- EMACS_INT j, glyph_len = LGSTRING_GLYPH_LEN (gstring);
+ ptrdiff_t j, glyph_len = LGSTRING_GLYPH_LEN (gstring);
for (j = 0; j < glyph_len; j++)
if (NILP (LGSTRING_GLYPH (gstring, j)))
break;
len = j;
}
- lint_assume (len <= TYPE_MAXIMUM (EMACS_INT) - 2);
+ lint_assume (len <= TYPE_MAXIMUM (ptrdiff_t) - 2);
copy = Fmake_vector (make_number (len + 2), Qnil);
LGSTRING_SET_HEADER (copy, Fcopy_sequence (header));
for (i = 0; i < len; i++)
@@ -709,11 +708,11 @@ static Lisp_Object fill_gstring_header (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object,
Lisp_Object);
-int
+bool
composition_gstring_p (Lisp_Object gstring)
{
Lisp_Object header;
- EMACS_INT i;
+ ptrdiff_t i;
if (! VECTORP (gstring) || ASIZE (gstring) < 2)
return 0;
@@ -741,7 +740,7 @@ composition_gstring_p (Lisp_Object gstring)
}
int
-composition_gstring_width (Lisp_Object gstring, EMACS_INT from, EMACS_INT to,
+composition_gstring_width (Lisp_Object gstring, ptrdiff_t from, ptrdiff_t to,
struct font_metrics *metrics)
{
Lisp_Object *glyph;
@@ -765,7 +764,7 @@ composition_gstring_width (Lisp_Object gstring, EMACS_INT from, EMACS_INT to,
}
metrics->width = metrics->lbearing = metrics->rbearing = 0;
}
- for (glyph = &LGSTRING_GLYPH (gstring, from); from < to; from++, glyph++)
+ for (glyph = lgstring_glyph_addr (gstring, from); from < to; from++, glyph++)
{
int x;
@@ -800,8 +799,8 @@ static Lisp_Object gstring_work_headers;
static Lisp_Object
fill_gstring_header (Lisp_Object header, Lisp_Object start, Lisp_Object end, Lisp_Object font_object, Lisp_Object string)
{
- EMACS_INT from, to, from_byte;
- EMACS_INT len, i;
+ ptrdiff_t from, to, from_byte;
+ ptrdiff_t len, i;
if (NILP (string))
{
@@ -817,11 +816,11 @@ fill_gstring_header (Lisp_Object header, Lisp_Object start, Lisp_Object end, Lis
CHECK_STRING (string);
if (! STRING_MULTIBYTE (string))
error ("Attempt to shape unibyte text");
- /* FROM and TO are checked by the caller. */
+ /* The caller checks that START and END are nonnegative integers. */
+ if (! (XINT (start) <= XINT (end) && XINT (end) <= SCHARS (string)))
+ args_out_of_range_3 (string, start, end);
from = XINT (start);
to = XINT (end);
- if (from < 0 || from > to || to > SCHARS (string))
- args_out_of_range_3 (string, start, end);
from_byte = string_char_to_byte (string, from);
}
@@ -860,8 +859,8 @@ fill_gstring_body (Lisp_Object gstring)
{
Lisp_Object font_object = LGSTRING_FONT (gstring);
Lisp_Object header = AREF (gstring, 0);
- EMACS_INT len = LGSTRING_CHAR_LEN (gstring);
- EMACS_INT i;
+ ptrdiff_t len = LGSTRING_CHAR_LEN (gstring);
+ ptrdiff_t i;
for (i = 0; i < len; i++)
{
@@ -906,15 +905,15 @@ fill_gstring_body (Lisp_Object gstring)
object. Otherwise return nil. */
static Lisp_Object
-autocmp_chars (Lisp_Object rule, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT limit, struct window *win, struct face *face, Lisp_Object string)
+autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t limit, struct window *win, struct face *face, Lisp_Object string)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
FRAME_PTR f = XFRAME (win->frame);
Lisp_Object pos = make_number (charpos);
- EMACS_INT to;
- EMACS_INT pt = PT, pt_byte = PT_BYTE;
+ ptrdiff_t to;
+ ptrdiff_t pt = PT, pt_byte = PT_BYTE;
Lisp_Object re, font_object, lgstring;
- EMACS_INT len;
+ ptrdiff_t len;
record_unwind_save_match_data ();
re = AREF (rule, 0);
@@ -950,23 +949,12 @@ autocmp_chars (Lisp_Object rule, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT
string);
if (NILP (LGSTRING_ID (lgstring)))
{
- Lisp_Object args[6];
-
/* Save point as marker before calling out to lisp. */
if (NILP (string))
- {
- Lisp_Object m = Fmake_marker ();
- set_marker_both (m, Qnil, pt, pt_byte);
- record_unwind_protect (restore_point_unwind, m);
- }
-
- args[0] = Vauto_composition_function;
- args[1] = AREF (rule, 2);
- args[2] = pos;
- args[3] = make_number (to);
- args[4] = font_object;
- args[5] = string;
- lgstring = safe_call (6, args);
+ record_unwind_protect (restore_point_unwind,
+ build_marker (current_buffer, pt, pt_byte));
+ lgstring = safe_call (6, Vauto_composition_function, AREF (rule, 2),
+ pos, make_number (to), font_object, string);
}
return unbind_to (count, lgstring);
}
@@ -997,9 +985,9 @@ static Lisp_Object _work_val;
composition. */
void
-composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT endpos, Lisp_Object string)
+composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t endpos, Lisp_Object string)
{
- EMACS_INT start, end;
+ ptrdiff_t start, end;
int c;
Lisp_Object prop, val;
/* This is from forward_to_next_line_start in xdisp.c. */
@@ -1109,7 +1097,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos,
int len;
/* Limit byte position used in fast_looking_at. This is the
byte position of the character after START. */
- EMACS_INT limit;
+ ptrdiff_t limit;
if (NILP (string))
p = BYTE_POS_ADDR (bytepos);
@@ -1123,16 +1111,17 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos,
if (! NILP (val))
{
Lisp_Object elt;
- int ridx, back, blen;
+ int ridx, blen;
for (ridx = 0; CONSP (val); val = XCDR (val), ridx++)
{
elt = XCAR (val);
if (VECTORP (elt) && ASIZE (elt) == 3
&& NATNUMP (AREF (elt, 1))
- && charpos - (back = XFASTINT (AREF (elt, 1))) > endpos)
+ && charpos - XFASTINT (AREF (elt, 1)) > endpos)
{
- EMACS_INT cpos = charpos - back, bpos;
+ ptrdiff_t back = XFASTINT (AREF (elt, 1));
+ ptrdiff_t cpos = charpos - back, bpos;
if (back == 0)
bpos = bytepos;
@@ -1222,15 +1211,14 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos,
string. In that case, FACE must not be NULL.
If the character is composed, setup members of CMP_IT (id, nglyphs,
- from, to, reversed_p), and return 1. Otherwise, update
- CMP_IT->stop_pos, and return 0. */
+ from, to, reversed_p), and return true. Otherwise, update
+ CMP_IT->stop_pos, and return false. */
-int
-composition_reseat_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT endpos, struct window *w, struct face *face, Lisp_Object string)
+bool
+composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
+ ptrdiff_t bytepos, ptrdiff_t endpos, struct window *w,
+ struct face *face, Lisp_Object string)
{
- if (endpos < 0)
- endpos = NILP (string) ? BEGV : 0;
-
if (cmp_it->ch == -2)
{
composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
@@ -1239,10 +1227,13 @@ composition_reseat_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_I
return 0;
}
+ if (endpos < 0)
+ endpos = NILP (string) ? BEGV : 0;
+
if (cmp_it->ch < 0)
{
/* We are looking at a static composition. */
- EMACS_INT start, end;
+ ptrdiff_t start, end;
Lisp_Object prop;
find_composition (charpos, -1, &start, &end, &prop, string);
@@ -1257,7 +1248,7 @@ composition_reseat_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_I
{
Lisp_Object lgstring = Qnil;
Lisp_Object val, elt;
- EMACS_INT i;
+ ptrdiff_t i;
val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
for (i = 0; i < cmp_it->rule_idx; i++, val = XCDR (val));
@@ -1284,38 +1275,25 @@ composition_reseat_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_I
}
else
{
- EMACS_INT cpos = charpos, bpos = bytepos;
+ ptrdiff_t cpos = charpos, bpos = bytepos;
- while (1)
+ cmp_it->reversed_p = 1;
+ elt = XCAR (val);
+ if (cmp_it->lookback > 0)
{
- elt = XCAR (val);
- if (cmp_it->lookback > 0)
- {
- cpos = charpos - cmp_it->lookback;
- if (STRINGP (string))
- bpos = string_char_to_byte (string, cpos);
- else
- bpos = CHAR_TO_BYTE (cpos);
- }
- lgstring = autocmp_chars (elt, cpos, bpos, charpos + 1, w, face,
- string);
- if (composition_gstring_p (lgstring)
- && cpos + LGSTRING_CHAR_LEN (lgstring) - 1 == charpos)
- break;
- /* Composition failed or didn't cover the current
- character. */
- if (cmp_it->lookback == 0)
- goto no_composition;
- lgstring = Qnil;
- /* Try to find a shorter composition that starts after CPOS. */
- composition_compute_stop_pos (cmp_it, charpos, bytepos, cpos,
- string);
- if (cmp_it->ch == -2 || cmp_it->stop_pos < charpos)
- goto no_composition;
- val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
- for (i = 0; i < cmp_it->rule_idx; i++, val = XCDR (val));
+ cpos = charpos - cmp_it->lookback;
+ if (STRINGP (string))
+ bpos = string_char_to_byte (string, cpos);
+ else
+ bpos = CHAR_TO_BYTE (cpos);
}
- cmp_it->reversed_p = 1;
+ lgstring = autocmp_chars (elt, cpos, bpos, charpos + 1, w, face,
+ string);
+ if (! composition_gstring_p (lgstring)
+ || cpos + LGSTRING_CHAR_LEN (lgstring) - 1 != charpos)
+ /* Composition failed or didn't cover the current
+ character. */
+ goto no_composition;
}
if (NILP (lgstring))
goto no_composition;
@@ -1350,6 +1328,8 @@ composition_reseat_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_I
/* BYTEPOS is calculated in composition_compute_stop_pos */
bytepos = -1;
}
+ if (cmp_it->reversed_p)
+ endpos = -1;
composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
return 0;
}
@@ -1370,7 +1350,7 @@ composition_reseat_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_I
the cluster, or -1 if the composition is somehow broken. */
int
-composition_update_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_INT bytepos, Lisp_Object string)
+composition_update_it (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, Lisp_Object string)
{
int i, c IF_LINT (= 0);
@@ -1402,10 +1382,10 @@ composition_update_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_I
}
else
{
- /* automatic composition */
+ /* Automatic composition. */
Lisp_Object gstring = composition_gstring_from_id (cmp_it->id);
Lisp_Object glyph;
- EMACS_INT from;
+ ptrdiff_t from;
if (cmp_it->nglyphs == 0)
{
@@ -1457,7 +1437,7 @@ composition_update_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_I
struct position_record
{
- EMACS_INT pos, pos_byte;
+ ptrdiff_t pos, pos_byte;
unsigned char *p;
};
@@ -1492,23 +1472,23 @@ struct position_record
/* This is like find_composition, but find an automatic composition
instead. It is assured that POS is not within a static
composition. If found, set *GSTRING to the glyph-string
- representing the composition, and return 1. Otherwise, *GSTRING to
- Qnil, and return 0. */
+ representing the composition, and return true. Otherwise, *GSTRING to
+ Qnil, and return false. */
-static int
-find_automatic_composition (EMACS_INT pos, EMACS_INT limit,
- EMACS_INT *start, EMACS_INT *end,
+static bool
+find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit,
+ ptrdiff_t *start, ptrdiff_t *end,
Lisp_Object *gstring, Lisp_Object string)
{
- EMACS_INT head, tail, stop;
+ ptrdiff_t head, tail, stop;
/* Forward limit position of checking a composition taking a
looking-back count into account. */
- EMACS_INT fore_check_limit;
+ ptrdiff_t fore_check_limit;
struct position_record cur, prev;
int c;
Lisp_Object window;
struct window *w;
- int need_adjustment = 0;
+ bool need_adjustment = 0;
window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
if (NILP (window))
@@ -1688,10 +1668,10 @@ find_automatic_composition (EMACS_INT pos, EMACS_INT limit,
/* Return the adjusted point provided that point is moved from LAST_PT
to NEW_PT. */
-EMACS_INT
-composition_adjust_point (EMACS_INT last_pt, EMACS_INT new_pt)
+ptrdiff_t
+composition_adjust_point (ptrdiff_t last_pt, ptrdiff_t new_pt)
{
- EMACS_INT i, beg, end;
+ ptrdiff_t i, beg, end;
Lisp_Object val;
if (new_pt == BEGV || new_pt == ZV)
@@ -1712,7 +1692,7 @@ composition_adjust_point (EMACS_INT last_pt, EMACS_INT new_pt)
return new_pt;
/* Next check the automatic composition. */
- if (! find_automatic_composition (new_pt, (EMACS_INT) -1, &beg, &end, &val,
+ if (! find_automatic_composition (new_pt, (ptrdiff_t) -1, &beg, &end, &val,
Qnil)
|| beg == new_pt)
return new_pt;
@@ -1773,7 +1753,7 @@ should be ignored. */)
(Lisp_Object from, Lisp_Object to, Lisp_Object font_object, Lisp_Object string)
{
Lisp_Object gstring, header;
- EMACS_INT frompos, topos;
+ ptrdiff_t frompos, topos;
CHECK_NATNUM (from);
CHECK_NATNUM (to);
@@ -1857,15 +1837,14 @@ See `find-composition' for more details. */)
(Lisp_Object pos, Lisp_Object limit, Lisp_Object string, Lisp_Object detail_p)
{
Lisp_Object prop, tail, gstring;
- EMACS_INT start, end, from, to;
+ ptrdiff_t start, end, from, to;
int id;
CHECK_NUMBER_COERCE_MARKER (pos);
- from = XINT (pos);
if (!NILP (limit))
{
CHECK_NUMBER_COERCE_MARKER (limit);
- to = XINT (limit);
+ to = min (XINT (limit), ZV);
}
else
to = -1;
@@ -1881,6 +1860,7 @@ See `find-composition' for more details. */)
if (XINT (pos) < BEGV || XINT (pos) > ZV)
args_out_of_range (Fcurrent_buffer (), pos);
}
+ from = XINT (pos);
if (!find_composition (from, to, &start, &end, &prop, string))
{
@@ -1893,7 +1873,7 @@ See `find-composition' for more details. */)
}
if ((end <= XINT (pos) || start > XINT (pos)))
{
- EMACS_INT s, e;
+ ptrdiff_t s, e;
if (find_automatic_composition (from, to, &s, &e, &gstring, string)
&& (e <= XINT (pos) ? e > end : s < start))
@@ -1910,7 +1890,7 @@ See `find-composition' for more details. */)
id = COMPOSITION_ID (prop);
else
{
- EMACS_INT start_byte = (NILP (string)
+ ptrdiff_t start_byte = (NILP (string)
? CHAR_TO_BYTE (start)
: string_char_to_byte (string, start));
id = get_composition_id (start, start_byte, end - start, prop, string);
diff --git a/src/composite.h b/src/composite.h
index 60145b10bd9..9462b932c66 100644
--- a/src/composite.h
+++ b/src/composite.h
@@ -1,5 +1,5 @@
/* Header for composite sequence handler.
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
@@ -25,6 +25,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef EMACS_COMPOSITE_H
#define EMACS_COMPOSITE_H
+INLINE_HEADER_BEGIN
+#ifndef COMPOSITE_INLINE
+# define COMPOSITE_INLINE INLINE
+#endif
+
/* Methods to display a sequence of components of a composition. */
enum composition_method {
/* Compose relatively without alternate characters. */
@@ -108,7 +113,7 @@ extern Lisp_Object composition_temp;
&& (end - start) == COMPOSITION_LENGTH (prop))
/* Return the Nth glyph of composition specified by CMP. CMP is a
- pointer to `struct composition'. */
+ pointer to `struct composition'. */
#define COMPOSITION_GLYPH(cmp, n) \
XINT (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \
->key_and_value) \
@@ -186,7 +191,7 @@ struct composition {
enum composition_method method;
/* Index to the composition hash table. */
- EMACS_INT hash_index;
+ ptrdiff_t hash_index;
/* For which font we have calculated the remaining members. The
actual type is device dependent. */
@@ -216,16 +221,16 @@ extern ptrdiff_t n_compositions;
extern Lisp_Object Qcomposition;
extern Lisp_Object composition_hash_table;
-extern ptrdiff_t get_composition_id (EMACS_INT, EMACS_INT, EMACS_INT,
+extern ptrdiff_t get_composition_id (ptrdiff_t, ptrdiff_t, ptrdiff_t,
Lisp_Object, Lisp_Object);
-extern int find_composition (EMACS_INT, EMACS_INT, EMACS_INT *, EMACS_INT *,
- Lisp_Object *, Lisp_Object);
-extern void update_compositions (EMACS_INT, EMACS_INT, int);
+extern bool find_composition (ptrdiff_t, ptrdiff_t, ptrdiff_t *, ptrdiff_t *,
+ Lisp_Object *, Lisp_Object);
+extern void update_compositions (ptrdiff_t, ptrdiff_t, int);
extern void make_composition_value_copy (Lisp_Object);
extern void compose_region (int, int, Lisp_Object, Lisp_Object,
Lisp_Object);
extern void syms_of_composite (void);
-extern void compose_text (EMACS_INT, EMACS_INT, Lisp_Object, Lisp_Object,
+extern void compose_text (ptrdiff_t, ptrdiff_t, Lisp_Object, Lisp_Object,
Lisp_Object);
/* Macros for lispy glyph-string. This is completely different from
@@ -247,6 +252,11 @@ extern void compose_text (EMACS_INT, EMACS_INT, Lisp_Object, Lisp_Object,
#define LGSTRING_GLYPH_LEN(lgs) (ASIZE ((lgs)) - 2)
#define LGSTRING_GLYPH(lgs, idx) AREF ((lgs), (idx) + 2)
#define LGSTRING_SET_GLYPH(lgs, idx, val) ASET ((lgs), (idx) + 2, (val))
+COMPOSITE_INLINE Lisp_Object *
+lgstring_glyph_addr (Lisp_Object lgs, ptrdiff_t idx)
+{
+ return aref_addr (lgs, idx + 2);
+}
/* Vector size of Lispy glyph. */
enum lglyph_indices
@@ -298,22 +308,23 @@ struct composition_it;
struct face;
struct font_metrics;
-extern Lisp_Object composition_gstring_put_cache (Lisp_Object, EMACS_INT);
+extern Lisp_Object composition_gstring_put_cache (Lisp_Object, ptrdiff_t);
extern Lisp_Object composition_gstring_from_id (ptrdiff_t);
-extern int composition_gstring_p (Lisp_Object);
-extern int composition_gstring_width (Lisp_Object, EMACS_INT, EMACS_INT,
+extern bool composition_gstring_p (Lisp_Object);
+extern int composition_gstring_width (Lisp_Object, ptrdiff_t, ptrdiff_t,
struct font_metrics *);
extern void composition_compute_stop_pos (struct composition_it *,
- EMACS_INT, EMACS_INT, EMACS_INT,
+ ptrdiff_t, ptrdiff_t, ptrdiff_t,
Lisp_Object);
-extern int composition_reseat_it (struct composition_it *,
- EMACS_INT, EMACS_INT, EMACS_INT,
- struct window *, struct face *,
- Lisp_Object);
+extern bool composition_reseat_it (struct composition_it *, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, struct window *,
+ struct face *, Lisp_Object);
extern int composition_update_it (struct composition_it *,
- EMACS_INT, EMACS_INT, Lisp_Object);
+ ptrdiff_t, ptrdiff_t, Lisp_Object);
+
+extern ptrdiff_t composition_adjust_point (ptrdiff_t, ptrdiff_t);
-extern EMACS_INT composition_adjust_point (EMACS_INT, EMACS_INT);
+INLINE_HEADER_END
#endif /* not EMACS_COMPOSITE_H */
diff --git a/src/conf_post.h b/src/conf_post.h
new file mode 100644
index 00000000000..b1997e79081
--- /dev/null
+++ b/src/conf_post.h
@@ -0,0 +1,238 @@
+/* conf_post.h --- configure.ac includes this via AH_BOTTOM
+
+Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2012
+ Free Software Foundation, Inc.
+
+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:
+
+ Rather than writing this code directly in AH_BOTTOM, we include it
+ via this file. This is so that it does not get processed by
+ autoheader. Eg, any undefs here would otherwise be commented out.
+*/
+
+/* Code: */
+
+/* Include any platform specific configuration file. */
+#ifdef config_opsysfile
+# include config_opsysfile
+#endif
+
+#ifndef WINDOWSNT
+/* On AIX 3 this must be included before any other include file. */
+#include <alloca.h>
+#if ! HAVE_ALLOCA
+# error "alloca not available on this machine"
+#endif
+#endif
+
+/* This silences a few compilation warnings on FreeBSD. */
+#ifdef BSD_SYSTEM_AHB
+#undef BSD_SYSTEM_AHB
+#undef BSD_SYSTEM
+#if __FreeBSD__ == 1
+#define BSD_SYSTEM 199103
+#elif __FreeBSD__ == 2
+#define BSD_SYSTEM 199306
+#elif __FreeBSD__ >= 3
+#define BSD_SYSTEM 199506
+#endif
+#endif
+
+#ifdef DARWIN_OS
+#ifdef emacs
+#define malloc unexec_malloc
+#define realloc unexec_realloc
+#define free unexec_free
+/* Don't use posix_memalign because it is not compatible with unexmacosx.c. */
+#undef HAVE_POSIX_MEMALIGN
+#endif
+/* The following solves the problem that Emacs hangs when evaluating
+ (make-comint "test0" "/nodir/nofile" nil "") when /nodir/nofile
+ does not exist. Also, setsid is not allowed in the vfork child's
+ context as of Darwin 9/Mac OS X 10.5. */
+#undef HAVE_WORKING_VFORK
+#define vfork fork
+#endif /* DARWIN_OS */
+
+/* We have to go this route, rather than the old hpux9 approach of
+ renaming the functions via macros. The system's stdlib.h has fully
+ prototyped declarations, which yields a conflicting definition of
+ srand48; it tries to redeclare what was once srandom to be srand48.
+ So we go with HAVE_LRAND48 being defined. */
+#ifdef HPUX
+#undef srandom
+#undef random
+/* We try to avoid checking for random and rint on hpux in
+ configure.ac, but some other configure test might check for them as
+ a dependency, so to be safe we also undefine them here.
+ */
+#undef HAVE_RANDOM
+#undef HAVE_RINT
+#endif /* HPUX */
+
+#ifdef IRIX6_5
+#ifdef emacs
+char *_getpty();
+#endif
+
+#endif /* IRIX6_5 */
+
+#ifdef MSDOS
+#ifndef __DJGPP__
+You lose; /* Emacs for DOS must be compiled with DJGPP */
+#endif
+#define _NAIVE_DOS_REGS
+
+/* Start of gnulib-related stuff */
+
+/* lib/ftoastr.c wants strtold, but DJGPP only has _strtold. DJGPP >
+ 2.03 has it, but it also has _strtold as a stub that jumps to
+ strtold, so use _strtold in all versions. */
+#define strtold _strtold
+
+#if __DJGPP__ > 2 || __DJGPP_MINOR__ > 3
+# define HAVE_LSTAT 1
+#else
+# define lstat stat
+#endif
+/* The "portable" definition of _GL_INLINE on config.h does not work
+ with DJGPP GCC 3.4.4: it causes unresolved externals in sysdep.c,
+ although lib/execinfo.h is included and the inline functions there
+ are visible. */
+#if __GNUC__ < 4
+# define _GL_EXECINFO_INLINE inline
+#endif
+/* End of gnulib-related stuff. */
+
+#define emacs_raise(sig) msdos_fatal_signal (sig)
+
+/* Define one of these for easier conditionals. */
+#ifdef HAVE_X_WINDOWS
+/* We need a little extra space, see ../../lisp/loadup.el and the
+ commentary below, in the non-X branch. The 140KB number was
+ measured on GNU/Linux and on MS-Windows. */
+#define SYSTEM_PURESIZE_EXTRA (-170000+140000)
+#else
+/* We need a little extra space, see ../../lisp/loadup.el.
+ As of 20091024, DOS-specific files use up 62KB of pure space. But
+ overall, we end up wasting 130KB of pure space, because
+ BASE_PURESIZE starts at 1.47MB, while we need only 1.3MB (including
+ non-DOS specific files and load history; the latter is about 55K,
+ but depends on the depth of the top-level Emacs directory in the
+ directory tree). Given the unknown policy of different DPMI
+ hosts regarding loading of untouched pages, I'm not going to risk
+ enlarging Emacs footprint by another 100+ KBytes. */
+#define SYSTEM_PURESIZE_EXTRA (-170000+65000)
+#endif
+#endif /* MSDOS */
+
+/* Mac OS X / GNUstep need a bit more pure memory. Of the existing knobs,
+ SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems. */
+#ifdef HAVE_NS
+#if defined NS_IMPL_GNUSTEP
+# define SYSTEM_PURESIZE_EXTRA 30000
+#elif defined DARWIN_OS
+# define SYSTEM_PURESIZE_EXTRA 200000
+#endif
+#endif
+
+#if defined HAVE_NTGUI && !defined DebPrint
+# ifdef EMACSDEBUG
+extern void _DebPrint (const char *fmt, ...);
+# define DebPrint(stuff) _DebPrint stuff
+# else
+# define DebPrint(stuff)
+# endif
+#endif
+
+#if defined CYGWIN && defined HAVE_NTGUI
+# define NTGUI_UNICODE /* Cygwin runs only on UNICODE-supporting systems */
+# define _WIN32_WINNT 0x500 /* Win2k */
+#endif
+
+#ifdef emacs /* Don't do this for lib-src. */
+/* Tell regex.c to use a type compatible with Emacs. */
+#define RE_TRANSLATE_TYPE Lisp_Object
+#define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C)
+#ifdef make_number
+/* If make_number is a macro, use it. */
+#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0)))
+#else
+/* If make_number is a function, avoid it. */
+#define RE_TRANSLATE_P(TBL) (!(INTEGERP (TBL) && XINT (TBL) == 0))
+#endif
+#endif
+
+/* Tell gnulib to omit support for openat-related functions having a
+ first argument other than AT_FDCWD. */
+#define GNULIB_SUPPORT_ONLY_AT_FDCWD
+
+#include <string.h>
+#include <stdlib.h>
+
+#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */
+#define NO_INLINE __attribute__((noinline))
+#else
+#define NO_INLINE
+#endif
+
+#if (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1))
+#define EXTERNALLY_VISIBLE __attribute__((externally_visible))
+#else
+#define EXTERNALLY_VISIBLE
+#endif
+
+#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
+# define ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
+#else
+# define ATTRIBUTE_FORMAT(spec) /* empty */
+#endif
+
+#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)
+# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
+ ATTRIBUTE_FORMAT ((__gnu_printf__, formatstring_parameter, first_argument))
+#else
+# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
+ ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument))
+#endif
+
+#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
+
+/* Some versions of GNU/Linux define noinline in their headers. */
+#ifdef noinline
+#undef noinline
+#endif
+
+#define INLINE _GL_INLINE
+#define EXTERN_INLINE _GL_EXTERN_INLINE
+#define INLINE_HEADER_BEGIN _GL_INLINE_HEADER_BEGIN
+#define INLINE_HEADER_END _GL_INLINE_HEADER_END
+
+/* Use this to suppress gcc's `...may be used before initialized' warnings. */
+#ifdef lint
+/* Use CODE only if lint checking is in effect. */
+# define IF_LINT(Code) Code
+/* Assume that the expression COND is true. This differs in intent
+ from 'assert', as it is a message from the programmer to the compiler. */
+# define lint_assume(cond) ((cond) ? (void) 0 : abort ())
+#else
+# define IF_LINT(Code) /* empty */
+# define lint_assume(cond) ((void) (0 && (cond)))
+#endif
+
+/* conf_post.h ends here */
diff --git a/src/cygw32.c b/src/cygw32.c
new file mode 100644
index 00000000000..d9777d5e22e
--- /dev/null
+++ b/src/cygw32.c
@@ -0,0 +1,138 @@
+/* Cygwin support routines.
+ Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+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/>. */
+
+
+#include "cygw32.h"
+#include "character.h"
+#include "buffer.h"
+#include <unistd.h>
+#include <fcntl.h>
+
+static Lisp_Object
+fchdir_unwind (Lisp_Object dir_fd)
+{
+ (void) fchdir (XFASTINT (dir_fd));
+ (void) close (XFASTINT (dir_fd));
+ return Qnil;
+}
+
+static void
+chdir_to_default_directory ()
+{
+ Lisp_Object new_cwd;
+ int old_cwd_fd = open (".", O_RDONLY | O_DIRECTORY);
+
+ if (old_cwd_fd == -1)
+ error ("could not open current directory: %s", strerror (errno));
+
+ record_unwind_protect (fchdir_unwind, make_number (old_cwd_fd));
+
+ new_cwd = Funhandled_file_name_directory (
+ Fexpand_file_name (build_string ("."), Qnil));
+ if (!STRINGP (new_cwd))
+ new_cwd = build_string ("/");
+
+ if (chdir (SDATA (ENCODE_FILE (new_cwd))))
+ error ("could not chdir: %s", strerror (errno));
+}
+
+static Lisp_Object
+conv_filename_to_w32_unicode (Lisp_Object in, int absolute_p)
+{
+ ssize_t converted_len;
+ Lisp_Object converted;
+ unsigned flags;
+ int count = SPECPDL_INDEX ();
+
+ chdir_to_default_directory ();
+
+ flags = CCP_POSIX_TO_WIN_W;
+ if (!absolute_p) {
+ flags |= CCP_RELATIVE;
+ }
+
+ in = ENCODE_FILE (in);
+
+ converted_len = cygwin_conv_path (flags, SDATA (in), NULL, 0);
+ if (converted_len < 2)
+ error ("cygwin_conv_path: %s", strerror (errno));
+
+ converted = make_uninit_string (converted_len - 1);
+ if (cygwin_conv_path (flags, SDATA (in),
+ SDATA (converted), converted_len))
+ error ("cygwin_conv_path: %s", strerror (errno));
+
+ return unbind_to (count, converted);
+}
+
+static Lisp_Object
+conv_filename_from_w32_unicode (const wchar_t* in, int absolute_p)
+{
+ ssize_t converted_len;
+ Lisp_Object converted;
+ unsigned flags;
+ int count = SPECPDL_INDEX ();
+
+ chdir_to_default_directory ();
+
+ flags = CCP_WIN_W_TO_POSIX;
+ if (!absolute_p) {
+ flags |= CCP_RELATIVE;
+ }
+
+ converted_len = cygwin_conv_path (flags, in, NULL, 0);
+ if (converted_len < 1)
+ error ("cygwin_conv_path: %s", strerror (errno));
+
+ converted = make_uninit_string (converted_len - 1 /*subtract terminator*/);
+ if (cygwin_conv_path (flags, in, SDATA (converted), converted_len))
+ error ("cygwin_conv_path: %s", strerror (errno));
+
+ return unbind_to (count, DECODE_FILE (converted));
+}
+
+DEFUN ("cygwin-convert-file-name-to-windows",
+ Fcygwin_convert_file_name_to_windows,
+ Scygwin_convert_file_name_to_windows,
+ 1, 2, 0,
+ doc: /* Convert PATH to a Windows path. If ABSOLUTE-P is
+non-nil, return an absolute path.*/)
+ (Lisp_Object path, Lisp_Object absolute_p)
+{
+ return from_unicode (
+ conv_filename_to_w32_unicode (path, EQ (absolute_p, Qnil) ? 0 : 1));
+}
+
+DEFUN ("cygwin-convert-file-name-from-windows",
+ Fcygwin_convert_file_name_from_windows,
+ Scygwin_convert_file_name_from_windows,
+ 1, 2, 0,
+ doc: /* Convert a Windows path to a Cygwin path. If ABSOLUTE-P
+is non-nil, return an absolute path.*/)
+ (Lisp_Object path, Lisp_Object absolute_p)
+{
+ return conv_filename_from_w32_unicode (to_unicode (path, &path),
+ EQ (absolute_p, Qnil) ? 0 : 1);
+}
+
+void
+syms_of_cygw32 (void)
+{
+ defsubr (&Scygwin_convert_file_name_from_windows);
+ defsubr (&Scygwin_convert_file_name_to_windows);
+}
diff --git a/src/m/m68k.h b/src/cygw32.h
index 16e0b9f0bef..51571913fd1 100644
--- a/src/m/m68k.h
+++ b/src/cygw32.h
@@ -1,6 +1,5 @@
-/* Machine description file for generic Motorola 68k.
-
-Copyright (C) 1985, 1995, 2001-2011 Free Software Foundation, Inc.
+/* Header for Cygwin support routines.
+ Copyright (C) 2011-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -17,16 +16,24 @@ 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/>. */
-/* Now define a symbol for the cpu type, if your compiler
- does not define it automatically. */
-#ifndef m68k
-#define m68k
-#endif
+#ifndef CYGW32_H
+#define CYGW32_H
+#include <config.h>
+#include <windef.h>
+#include <sys/cygwin.h>
+#include <wchar.h>
+
+#include <signal.h>
+#include <stdio.h>
+#include <limits.h>
+#include <errno.h>
+#include <math.h>
+#include <setjmp.h>
-#ifdef GNU_LINUX
-#ifdef __ELF__
-#define DATA_SEG_BITS 0x80000000
-#endif
+#include "lisp.h"
+#include "coding.h"
-#endif
+extern void syms_of_cygw32 (void);
+extern char * w32_strerror (int error_no);
+#endif /* CYGW32_H */
diff --git a/src/data.c b/src/data.c
index 0ebb17a2e01..5fc6afaaa03 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1,5 +1,5 @@
/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2011
+ Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,9 +19,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
#include <intprops.h>
@@ -34,24 +32,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "syssignal.h"
#include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */
#include "font.h"
-
-#include <float.h>
-/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
-#ifndef IEEE_FLOATING_POINT
-#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
- && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
-#define IEEE_FLOATING_POINT 1
-#else
-#define IEEE_FLOATING_POINT 0
-#endif
-#endif
-
-#include <math.h>
+#include "keymap.h"
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
static Lisp_Object Qsubr;
Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
-Lisp_Object Qerror, Qquit, Qargs_out_of_range;
+Lisp_Object Qerror, Quser_error, Qquit, Qargs_out_of_range;
static Lisp_Object Qwrong_type_argument;
Lisp_Object Qvoid_variable, Qvoid_function;
static Lisp_Object Qcyclic_function_indirection;
@@ -76,24 +62,26 @@ Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
Lisp_Object Qcdr;
static Lisp_Object Qad_advice_info, Qad_activate_internal;
-Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
-Lisp_Object Qoverflow_error, Qunderflow_error;
+static Lisp_Object Qdomain_error, Qsingularity_error, Qunderflow_error;
+Lisp_Object Qrange_error, Qoverflow_error;
Lisp_Object Qfloatp;
Lisp_Object Qnumberp, Qnumber_or_marker_p;
-Lisp_Object Qinteger;
-static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
+Lisp_Object Qinteger, Qsymbol;
+static Lisp_Object Qcons, Qfloat, Qmisc, Qstring, Qvector;
Lisp_Object Qwindow;
-static Lisp_Object Qfloat, Qwindow_configuration;
-static Lisp_Object Qprocess;
-static Lisp_Object Qcompiled_function, Qframe, Qvector;
+static Lisp_Object Qoverlay, Qwindow_configuration;
+static Lisp_Object Qprocess, Qmarker;
+static Lisp_Object Qcompiled_function, Qframe;
Lisp_Object Qbuffer;
static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
static Lisp_Object Qsubrp, Qmany, Qunevalled;
Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
+static Lisp_Object Qdefun;
Lisp_Object Qinteractive_form;
+static Lisp_Object Qdefalias_fset_function;
static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
@@ -106,7 +94,7 @@ wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
to try and do that by checking the tagbits, but nowadays all
tagbits are potentially valid. */
/* if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit)
- * abort (); */
+ * emacs_abort (); */
xsignal2 (Qwrong_type_argument, predicate, value);
}
@@ -130,7 +118,7 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
}
-/* Data type predicates */
+/* Data type predicates. */
DEFUN ("eq", Feq, Seq, 2, 2, 0,
doc: /* Return t if the two args are the same Lisp object. */)
@@ -180,7 +168,7 @@ for example, (type-of 1) returns `integer'. */)
case Lisp_Misc_Float:
return Qfloat;
}
- abort ();
+ emacs_abort ();
case Lisp_Vectorlike:
if (WINDOW_CONFIGURATIONP (object))
@@ -215,7 +203,7 @@ for example, (type-of 1) returns `integer'. */)
return Qfloat;
default:
- abort ();
+ emacs_abort ();
}
}
@@ -457,7 +445,7 @@ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
}
-/* Extract and set components of lists */
+/* Extract and set components of lists. */
DEFUN ("car", Fcar, Scar, 1, 1, 0,
doc: /* Return the car of LIST. If arg is nil, return nil.
@@ -515,7 +503,7 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
return newcdr;
}
-/* Extract and set components of symbols */
+/* Extract and set components of symbols. */
DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
doc: /* Return t if SYMBOL's value is not void. */)
@@ -541,7 +529,7 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
else
{
swap_in_symval_forwarding (sym, blv);
- valcontents = BLV_VALUE (blv);
+ valcontents = blv_value (blv);
}
break;
}
@@ -549,18 +537,19 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
/* In set_internal, we un-forward vars when their value is
set to Qunbound. */
return Qt;
- default: abort ();
+ default: emacs_abort ();
}
return (EQ (valcontents, Qunbound) ? Qnil : Qt);
}
+/* FIXME: Make it an alias for function-symbol! */
DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
doc: /* Return t if SYMBOL's function definition is not void. */)
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- return (EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt);
+ return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt;
}
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
@@ -576,14 +565,14 @@ Return SYMBOL. */)
}
DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
- doc: /* Make SYMBOL's function definition be void.
+ doc: /* Make SYMBOL's function definition be nil.
Return SYMBOL. */)
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
if (NILP (symbol) || EQ (symbol, Qt))
xsignal1 (Qsetting_constant, symbol);
- XSYMBOL (symbol)->function = Qunbound;
+ set_symbol_function (symbol, Qnil);
return symbol;
}
@@ -592,9 +581,7 @@ DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- if (!EQ (XSYMBOL (symbol)->function, Qunbound))
return XSYMBOL (symbol)->function;
- xsignal1 (Qvoid_function, symbol);
}
DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
@@ -621,46 +608,63 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
(register Lisp_Object symbol, Lisp_Object definition)
{
register Lisp_Object function;
-
CHECK_SYMBOL (symbol);
- if (NILP (symbol) || EQ (symbol, Qt))
- xsignal1 (Qsetting_constant, symbol);
function = XSYMBOL (symbol)->function;
- if (!NILP (Vautoload_queue) && !EQ (function, Qunbound))
+ if (!NILP (Vautoload_queue) && !NILP (function))
Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
- if (CONSP (function) && EQ (XCAR (function), Qautoload))
+ if (AUTOLOADP (function))
Fput (symbol, Qautoload, XCDR (function));
- XSYMBOL (symbol)->function = definition;
- /* Handle automatic advice activation */
- if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
- {
- call2 (Qad_activate_internal, symbol, Qnil);
- definition = XSYMBOL (symbol)->function;
- }
+ set_symbol_function (symbol, definition);
+
return definition;
}
DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
- doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.
+ doc: /* Set SYMBOL's function definition to DEFINITION.
Associates the function with the current load file, if any.
The optional third argument DOCSTRING specifies the documentation string
for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
-determined by DEFINITION. */)
+determined by DEFINITION.
+The return value is undefined. */)
(register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
{
CHECK_SYMBOL (symbol);
- if (CONSP (XSYMBOL (symbol)->function)
- && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
- LOADHIST_ATTACH (Fcons (Qt, symbol));
- definition = Ffset (symbol, definition);
- LOADHIST_ATTACH (Fcons (Qdefun, symbol));
+ if (!NILP (Vpurify_flag)
+ /* If `definition' is a keymap, immutable (and copying) is wrong. */
+ && !KEYMAPP (definition))
+ definition = Fpurecopy (definition);
+
+ {
+ bool autoload = AUTOLOADP (definition);
+ if (NILP (Vpurify_flag) || !autoload)
+ { /* Only add autoload entries after dumping, because the ones before are
+ not useful and else we get loads of them from the loaddefs.el. */
+
+ if (AUTOLOADP (XSYMBOL (symbol)->function))
+ /* Remember that the function was already an autoload. */
+ LOADHIST_ATTACH (Fcons (Qt, symbol));
+ LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
+ }
+ }
+
+ { /* Handle automatic advice activation. */
+ Lisp_Object hook = Fget (symbol, Qdefalias_fset_function);
+ if (!NILP (hook))
+ call2 (hook, symbol, definition);
+ else
+ Ffset (symbol, definition);
+ }
+
if (!NILP (docstring))
Fput (symbol, Qfunction_documentation, docstring);
- return definition;
+ /* We used to return `definition', but now that `defun' and `defmacro' expand
+ to a call to `defalias', we return `symbol' for backward compatibility
+ (bug#11686). */
+ return symbol;
}
DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
@@ -668,7 +672,7 @@ DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
(register Lisp_Object symbol, Lisp_Object newplist)
{
CHECK_SYMBOL (symbol);
- XSYMBOL (symbol)->plist = newplist;
+ set_symbol_plist (symbol, newplist);
return newplist;
}
@@ -684,12 +688,10 @@ function with `&rest' args, or `unevalled' for a special form. */)
CHECK_SUBR (subr);
minargs = XSUBR (subr)->min_args;
maxargs = XSUBR (subr)->max_args;
- if (maxargs == MANY)
- return Fcons (make_number (minargs), Qmany);
- else if (maxargs == UNEVALLED)
- return Fcons (make_number (minargs), Qunevalled);
- else
- return Fcons (make_number (minargs), make_number (maxargs));
+ return Fcons (make_number (minargs),
+ maxargs == MANY ? Qmany
+ : maxargs == UNEVALLED ? Qunevalled
+ : make_number (maxargs));
}
DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
@@ -711,11 +713,11 @@ Value, if non-nil, is a list \(interactive SPEC). */)
{
Lisp_Object fun = indirect_function (cmd); /* Check cycles. */
- if (NILP (fun) || EQ (fun, Qunbound))
+ if (NILP (fun))
return Qnil;
/* Use an `interactive-form' property if present, analogous to the
- function-documentation property. */
+ function-documentation property. */
fun = cmd;
while (SYMBOLP (fun))
{
@@ -739,6 +741,8 @@ Value, if non-nil, is a list \(interactive SPEC). */)
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
}
+ else if (AUTOLOADP (fun))
+ return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
else if (CONSP (fun))
{
Lisp_Object funcar = XCAR (fun);
@@ -746,14 +750,6 @@ Value, if non-nil, is a list \(interactive SPEC). */)
return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
else if (EQ (funcar, Qlambda))
return Fassq (Qinteractive, Fcdr (XCDR (fun)));
- else if (EQ (funcar, Qautoload))
- {
- struct gcpro gcpro1;
- GCPRO1 (cmd);
- do_autoload (fun, cmd);
- UNGCPRO;
- return Finteractive_form (cmd);
- }
}
return Qnil;
}
@@ -797,10 +793,12 @@ indirect_variable (struct Lisp_Symbol *symbol)
DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0,
doc: /* Return the variable at the end of OBJECT's variable chain.
-If OBJECT is a symbol, follow all variable indirections and return the final
-variable. If OBJECT is not a symbol, just return it.
-Signal a cyclic-variable-indirection error if there is a loop in the
-variable chain of symbols. */)
+If OBJECT is a symbol, follow its variable indirections (if any), and
+return the variable at the end of the chain of aliases. See Info node
+`(elisp)Variable Aliases'.
+
+If OBJECT is not a symbol, just return it. If there is a loop in the
+chain of aliases, signal a `cyclic-variable-indirection' error. */)
(Lisp_Object object)
{
if (SYMBOLP (object))
@@ -834,7 +832,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents)
return *XOBJFWD (valcontents)->objvar;
case Lisp_Fwd_Buffer_Obj:
- return PER_BUFFER_VALUE (current_buffer,
+ return per_buffer_value (current_buffer,
XBUFFER_OBJFWD (valcontents)->offset);
case Lisp_Fwd_Kboard_Obj:
@@ -851,7 +849,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents)
don't think anything will break. --lorentey */
return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
+ (char *)FRAME_KBOARD (SELECTED_FRAME ()));
- default: abort ();
+ default: emacs_abort ();
}
}
@@ -906,7 +904,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
b = XBUFFER (lbuf);
if (! PER_BUFFER_VALUE_P (b, idx))
- PER_BUFFER_VALUE (b, offset) = newval;
+ set_per_buffer_value (b, offset, newval);
}
}
break;
@@ -917,14 +915,14 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype;
if (!(NILP (type) || NILP (newval)
- || (XINT (type) == LISP_INT_TAG
+ || (XINT (type) == Lisp_Int0
? INTEGERP (newval)
: XTYPE (newval) == XINT (type))))
buffer_slot_type_mismatch (newval, XINT (type));
if (buf == NULL)
buf = current_buffer;
- PER_BUFFER_VALUE (buf, offset) = newval;
+ set_per_buffer_value (buf, offset, newval);
}
break;
@@ -937,12 +935,14 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
break;
default:
- abort (); /* goto def; */
+ emacs_abort (); /* goto def; */
}
}
-/* Set up SYMBOL to refer to its global binding.
- This makes it safe to alter the status of other bindings. */
+/* Set up SYMBOL to refer to its global binding. This makes it safe
+ to alter the status of other bindings. BEWARE: this may be called
+ during the mark phase of GC, where we assume that Lisp_Object slots
+ of BLV are marked after this function has changed them. */
void
swap_in_global_binding (struct Lisp_Symbol *symbol)
@@ -951,16 +951,16 @@ swap_in_global_binding (struct Lisp_Symbol *symbol)
/* Unload the previously loaded binding. */
if (blv->fwd)
- SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
+ set_blv_value (blv, do_symval_forwarding (blv->fwd));
/* Select the global binding in the symbol. */
- blv->valcell = blv->defcell;
+ set_blv_valcell (blv, blv->defcell);
if (blv->fwd)
store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL);
/* Indicate that the global binding is set up now. */
- blv->where = Qnil;
- SET_BLV_FOUND (blv, 0);
+ set_blv_where (blv, Qnil);
+ set_blv_found (blv, 0);
}
/* Set up the buffer-local symbol SYMBOL for validity in the current buffer.
@@ -988,7 +988,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
/* Unload the previously loaded binding. */
tem1 = blv->valcell;
if (blv->fwd)
- SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
+ set_blv_value (blv, do_symval_forwarding (blv->fwd));
/* Choose the new binding. */
{
Lisp_Object var;
@@ -996,21 +996,21 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
if (blv->frame_local)
{
tem1 = assq_no_quit (var, XFRAME (selected_frame)->param_alist);
- blv->where = selected_frame;
+ set_blv_where (blv, selected_frame);
}
else
{
tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist));
- XSETBUFFER (blv->where, current_buffer);
+ set_blv_where (blv, Fcurrent_buffer ());
}
}
if (!(blv->found = !NILP (tem1)))
tem1 = blv->defcell;
/* Load the new binding. */
- blv->valcell = tem1;
+ set_blv_valcell (blv, tem1);
if (blv->fwd)
- store_symval_forwarding (blv->fwd, BLV_VALUE (blv), NULL);
+ store_symval_forwarding (blv->fwd, blv_value (blv), NULL);
}
}
@@ -1037,12 +1037,12 @@ find_symbol_value (Lisp_Object symbol)
{
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
swap_in_symval_forwarding (sym, blv);
- return blv->fwd ? do_symval_forwarding (blv->fwd) : BLV_VALUE (blv);
+ return blv->fwd ? do_symval_forwarding (blv->fwd) : blv_value (blv);
}
/* FALLTHROUGH */
case SYMBOL_FORWARDED:
return do_symval_forwarding (SYMBOL_FWD (sym));
- default: abort ();
+ default: emacs_abort ();
}
}
@@ -1067,52 +1067,53 @@ DEFUN ("set", Fset, Sset, 2, 2, 0,
return newval;
}
-/* Return 1 if SYMBOL currently has a let-binding
+/* Return true if SYMBOL currently has a let-binding
which was made in the buffer that is now current. */
-static int
+static bool
let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
{
struct specbinding *p;
- for (p = specpdl_ptr - 1; p >= specpdl; p--)
- if (p->func == NULL
+ for (p = specpdl_ptr; p > specpdl; )
+ if ((--p)->func == NULL
&& CONSP (p->symbol))
{
struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol));
eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
if (symbol == let_bound_symbol
&& XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
- break;
+ return 1;
}
- return p >= specpdl;
+ return 0;
}
-static int
+static bool
let_shadows_global_binding_p (Lisp_Object symbol)
{
struct specbinding *p;
- for (p = specpdl_ptr - 1; p >= specpdl; p--)
- if (p->func == NULL && EQ (p->symbol, symbol))
- break;
+ for (p = specpdl_ptr; p > specpdl; )
+ if ((--p)->func == NULL && EQ (p->symbol, symbol))
+ return 1;
- return p >= specpdl;
+ return 0;
}
/* Store the value NEWVAL into SYMBOL.
If buffer/frame-locality is an issue, WHERE specifies which context to use.
(nil stands for the current buffer/frame).
- If BINDFLAG is zero, then if this symbol is supposed to become
+ If BINDFLAG is false, then if this symbol is supposed to become
local in every buffer where it is set, then we make it local.
- If BINDFLAG is nonzero, we don't do that. */
+ If BINDFLAG is true, we don't do that. */
void
-set_internal (register Lisp_Object symbol, register Lisp_Object newval, register Lisp_Object where, int bindflag)
+set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
+ bool bindflag)
{
- int voide = EQ (newval, Qunbound);
+ bool voide = EQ (newval, Qunbound);
struct Lisp_Symbol *sym;
Lisp_Object tem1;
@@ -1154,7 +1155,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
the default binding is loaded, the loaded binding may be the
wrong one. */
if (!EQ (blv->where, where)
- /* Also unload a global binding (if the var is local_if_set). */
+ /* Also unload a global binding (if the var is local_if_set). */
|| (EQ (blv->valcell, blv->defcell)))
{
/* The currently loaded binding is not necessarily valid.
@@ -1162,7 +1163,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
/* Write out `realvalue' to the old loaded binding. */
if (blv->fwd)
- SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
+ set_blv_value (blv, do_symval_forwarding (blv->fwd));
/* Find the new binding. */
XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */
@@ -1170,7 +1171,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
(blv->frame_local
? XFRAME (where)->param_alist
: BVAR (XBUFFER (where), local_var_alist)));
- blv->where = where;
+ set_blv_where (blv, where);
blv->found = 1;
if (NILP (tem1))
@@ -1200,17 +1201,18 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
bindings, not for frame-local bindings. */
eassert (!blv->frame_local);
tem1 = Fcons (symbol, XCDR (blv->defcell));
- BVAR (XBUFFER (where), local_var_alist)
- = Fcons (tem1, BVAR (XBUFFER (where), local_var_alist));
+ bset_local_var_alist
+ (XBUFFER (where),
+ Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)));
}
}
/* Record which binding is now loaded. */
- blv->valcell = tem1;
+ set_blv_valcell (blv, tem1);
}
/* Store the new value in the cons cell. */
- SET_BLV_VALUE (blv, newval);
+ set_blv_value (blv, newval);
if (blv->fwd)
{
@@ -1250,7 +1252,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
store_symval_forwarding (/* sym, */ innercontents, newval, buf);
break;
}
- default: abort ();
+ default: emacs_abort ();
}
return;
}
@@ -1295,13 +1297,13 @@ default_value (Lisp_Object symbol)
{
int offset = XBUFFER_OBJFWD (valcontents)->offset;
if (PER_BUFFER_IDX (offset) != 0)
- return PER_BUFFER_DEFAULT (offset);
+ return per_buffer_default (offset);
}
/* For other variables, get the current value. */
return do_symval_forwarding (valcontents);
}
- default: abort ();
+ default: emacs_abort ();
}
}
@@ -1382,7 +1384,7 @@ for this variable. */)
int offset = XBUFFER_OBJFWD (valcontents)->offset;
int idx = PER_BUFFER_IDX (offset);
- PER_BUFFER_DEFAULT (offset) = value;
+ set_per_buffer_default (offset, value);
/* If this variable is not always local in all buffers,
set it in the buffers that don't nominally have a local value. */
@@ -1390,16 +1392,16 @@ for this variable. */)
{
struct buffer *b;
- for (b = all_buffers; b; b = b->header.next.buffer)
+ FOR_EACH_BUFFER (b)
if (!PER_BUFFER_VALUE_P (b, idx))
- PER_BUFFER_VALUE (b, offset) = value;
+ set_per_buffer_value (b, offset, value);
}
return value;
}
else
return Fset (symbol, value);
}
- default: abort ();
+ default: emacs_abort ();
}
}
@@ -1450,10 +1452,10 @@ union Lisp_Val_Fwd
};
static struct Lisp_Buffer_Local_Value *
-make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents)
+make_blv (struct Lisp_Symbol *sym, bool forwarded,
+ union Lisp_Val_Fwd valcontents)
{
- struct Lisp_Buffer_Local_Value *blv
- = xmalloc (sizeof (struct Lisp_Buffer_Local_Value));
+ struct Lisp_Buffer_Local_Value *blv = xmalloc (sizeof *blv);
Lisp_Object symbol;
Lisp_Object tem;
@@ -1467,12 +1469,12 @@ make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents
eassert (!(forwarded && BUFFER_OBJFWDP (valcontents.fwd)));
eassert (!(forwarded && KBOARD_OBJFWDP (valcontents.fwd)));
blv->fwd = forwarded ? valcontents.fwd : NULL;
- blv->where = Qnil;
+ set_blv_where (blv, Qnil);
blv->frame_local = 0;
blv->local_if_set = 0;
- blv->defcell = tem;
- blv->valcell = tem;
- SET_BLV_FOUND (blv, 0);
+ set_blv_defcell (blv, tem);
+ set_blv_valcell (blv, tem);
+ set_blv_found (blv, 0);
return blv;
}
@@ -1494,8 +1496,8 @@ The function `default-value' gets the default value and `set-default' sets it.
{
struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL;
- union Lisp_Val_Fwd valcontents IF_LINT (= {0});
- int forwarded IF_LINT (= 0);
+ union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
+ bool forwarded IF_LINT (= 0);
CHECK_SYMBOL (variable);
sym = XSYMBOL (variable);
@@ -1523,7 +1525,7 @@ The function `default-value' gets the default value and `set-default' sets it.
else if (BUFFER_OBJFWDP (valcontents.fwd))
return variable;
break;
- default: abort ();
+ default: emacs_abort ();
}
if (sym->constant)
@@ -1567,11 +1569,11 @@ See also `make-variable-buffer-local'.
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument. */)
- (register Lisp_Object variable)
+ (Lisp_Object variable)
{
- register Lisp_Object tem;
- int forwarded IF_LINT (= 0);
- union Lisp_Val_Fwd valcontents IF_LINT (= {0});
+ Lisp_Object tem;
+ bool forwarded IF_LINT (= 0);
+ union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL;
@@ -1596,7 +1598,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
error ("Symbol %s may not be buffer-local",
SDATA (SYMBOL_NAME (variable)));
break;
- default: abort ();
+ default: emacs_abort ();
}
if (sym->constant)
@@ -1641,17 +1643,16 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
default value. */
find_symbol_value (variable);
- BVAR (current_buffer, local_var_alist)
- = Fcons (Fcons (variable, XCDR (blv->defcell)),
- BVAR (current_buffer, local_var_alist));
+ bset_local_var_alist
+ (current_buffer,
+ Fcons (Fcons (variable, XCDR (blv->defcell)),
+ BVAR (current_buffer, local_var_alist)));
/* Make sure symbol does not think it is set up for this buffer;
force it to look once again for this buffer's value. */
if (current_buffer == XBUFFER (blv->where))
- blv->where = Qnil;
- /* blv->valcell = blv->defcell;
- * SET_BLV_FOUND (blv, 0); */
- blv->found = 0;
+ set_blv_where (blv, Qnil);
+ set_blv_found (blv, 0);
}
/* If the symbol forwards into a C variable, then load the binding
@@ -1693,8 +1694,8 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
if (idx > 0)
{
SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0);
- PER_BUFFER_VALUE (current_buffer, offset)
- = PER_BUFFER_DEFAULT (offset);
+ set_per_buffer_value (current_buffer, offset,
+ per_buffer_default (offset));
}
}
return variable;
@@ -1704,15 +1705,16 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
if (blv->frame_local)
return variable;
break;
- default: abort ();
+ default: emacs_abort ();
}
/* Get rid of this buffer's alist element, if any. */
XSETSYMBOL (variable, sym); /* Propagate variable indirection. */
tem = Fassq (variable, BVAR (current_buffer, local_var_alist));
if (!NILP (tem))
- BVAR (current_buffer, local_var_alist)
- = Fdelq (tem, BVAR (current_buffer, local_var_alist));
+ bset_local_var_alist
+ (current_buffer,
+ Fdelq (tem, BVAR (current_buffer, local_var_alist)));
/* If the symbol is set up with the current buffer's binding
loaded, recompute its value. We have to do it now, or else
@@ -1721,9 +1723,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
Lisp_Object buf; XSETBUFFER (buf, current_buffer);
if (EQ (buf, blv->where))
{
- blv->where = Qnil;
- /* blv->valcell = blv->defcell;
- * SET_BLV_FOUND (blv, 0); */
+ set_blv_where (blv, Qnil);
blv->found = 0;
find_symbol_value (variable);
}
@@ -1756,9 +1756,9 @@ is to set the VARIABLE frame parameter of that frame. See
Note that since Emacs 23.1, variables cannot be both buffer-local and
frame-local any more (buffer-local bindings used to take precedence over
frame-local bindings). */)
- (register Lisp_Object variable)
+ (Lisp_Object variable)
{
- int forwarded;
+ bool forwarded;
union Lisp_Val_Fwd valcontents;
struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL;
@@ -1787,7 +1787,7 @@ frame-local bindings). */)
error ("Symbol %s may not be frame-local",
SDATA (SYMBOL_NAME (variable)));
break;
- default: abort ();
+ default: emacs_abort ();
}
if (sym->constant)
@@ -1845,11 +1845,11 @@ BUFFER defaults to the current buffer. */)
if (EQ (variable, XCAR (elt)))
{
eassert (!blv->frame_local);
- eassert (BLV_FOUND (blv) || !EQ (blv->where, tmp));
+ eassert (blv_found (blv) || !EQ (blv->where, tmp));
return Qt;
}
}
- eassert (!BLV_FOUND (blv) || !EQ (blv->where, tmp));
+ eassert (!blv_found (blv) || !EQ (blv->where, tmp));
return Qnil;
}
case SYMBOL_FORWARDED:
@@ -1864,18 +1864,18 @@ BUFFER defaults to the current buffer. */)
}
return Qnil;
}
- default: abort ();
+ default: emacs_abort ();
}
}
DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p,
1, 2, 0,
- doc: /* Non-nil if VARIABLE will be local in buffer BUFFER when set there.
-More precisely, this means that setting the variable \(with `set' or`setq'),
-while it does not have a `let'-style binding that was made in BUFFER,
-will produce a buffer local binding. See Info node
-`(elisp)Creating Buffer-Local'.
-BUFFER defaults to the current buffer. */)
+ doc: /* Non-nil if VARIABLE is local in buffer BUFFER when set there.
+BUFFER defaults to the current buffer.
+
+More precisely, return non-nil if either VARIABLE already has a local
+value in BUFFER, or if VARIABLE is automatically buffer-local (see
+`make-variable-buffer-local'). */)
(register Lisp_Object variable, Lisp_Object buffer)
{
struct Lisp_Symbol *sym;
@@ -1899,7 +1899,7 @@ BUFFER defaults to the current buffer. */)
case SYMBOL_FORWARDED:
/* All BUFFER_OBJFWD slots become local if they are set. */
return (BUFFER_OBJFWDP (SYMBOL_FWD (sym)) ? Qt : Qnil);
- default: abort ();
+ default: emacs_abort ();
}
}
@@ -1939,11 +1939,11 @@ If the current binding is global (the default), the value is nil. */)
if (!NILP (Flocal_variable_p (variable, Qnil)))
return Fcurrent_buffer ();
else if (sym->redirect == SYMBOL_LOCALIZED
- && BLV_FOUND (SYMBOL_BLV (sym)))
+ && blv_found (SYMBOL_BLV (sym)))
return SYMBOL_BLV (sym)->where;
else
return Qnil;
- default: abort ();
+ default: emacs_abort ();
}
}
@@ -2007,10 +2007,10 @@ indirect_function (register Lisp_Object object)
for (;;)
{
- if (!SYMBOLP (hare) || EQ (hare, Qunbound))
+ if (!SYMBOLP (hare) || NILP (hare))
break;
hare = XSYMBOL (hare)->function;
- if (!SYMBOLP (hare) || EQ (hare, Qunbound))
+ if (!SYMBOLP (hare) || NILP (hare))
break;
hare = XSYMBOL (hare)->function;
@@ -2037,10 +2037,10 @@ function chain of symbols. */)
/* Optimize for no indirection. */
result = object;
- if (SYMBOLP (result) && !EQ (result, Qunbound)
+ if (SYMBOLP (result) && !NILP (result)
&& (result = XSYMBOL (result)->function, SYMBOLP (result)))
result = indirect_function (result);
- if (!EQ (result, Qunbound))
+ if (!NILP (result))
return result;
if (NILP (noerror))
@@ -2049,7 +2049,7 @@ function chain of symbols. */)
return Qnil;
}
-/* Extract and set vector and string elements */
+/* Extract and set vector and string elements. */
DEFUN ("aref", Faref, Saref, 2, 2, 0,
doc: /* Return the element of ARRAY at index IDX.
@@ -2064,7 +2064,7 @@ or a byte-code object. IDX starts at 0. */)
if (STRINGP (array))
{
int c;
- EMACS_INT idxval_byte;
+ ptrdiff_t idxval_byte;
if (idxval < 0 || idxval >= SCHARS (array))
args_out_of_range (array, idx);
@@ -2092,7 +2092,7 @@ or a byte-code object. IDX starts at 0. */)
}
else
{
- int size = 0;
+ ptrdiff_t size = 0;
if (VECTORP (array))
size = ASIZE (array);
else if (COMPILEDP (array))
@@ -2123,7 +2123,7 @@ bool-vector. IDX starts at 0. */)
{
if (idxval < 0 || idxval >= ASIZE (array))
args_out_of_range (array, idx);
- XVECTOR (array)->contents[idxval] = newelt;
+ ASET (array, idxval, newelt);
}
else if (BOOL_VECTOR_P (array))
{
@@ -2156,7 +2156,8 @@ bool-vector. IDX starts at 0. */)
if (STRING_MULTIBYTE (array))
{
- EMACS_INT idxval_byte, prev_bytes, new_bytes, nbytes;
+ ptrdiff_t idxval_byte, nbytes;
+ int prev_bytes, new_bytes;
unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
nbytes = SBYTES (array);
@@ -2167,11 +2168,10 @@ bool-vector. IDX starts at 0. */)
if (prev_bytes != new_bytes)
{
/* We must relocate the string data. */
- EMACS_INT nchars = SCHARS (array);
- unsigned char *str;
+ ptrdiff_t nchars = SCHARS (array);
USE_SAFE_ALLOCA;
+ unsigned char *str = SAFE_ALLOCA (nbytes);
- SAFE_ALLOCA (str, unsigned char *, nbytes);
memcpy (str, SDATA (array), nbytes);
allocate_string_data (XSTRING (array), nchars,
nbytes + new_bytes - prev_bytes);
@@ -2214,7 +2214,7 @@ static Lisp_Object
arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
{
double f1 = 0, f2 = 0;
- int floatp = 0;
+ bool floatp = 0;
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1);
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2);
@@ -2259,7 +2259,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
return Qnil;
default:
- abort ();
+ emacs_abort ();
}
}
@@ -2331,7 +2331,7 @@ DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
uintmax_t
cons_to_unsigned (Lisp_Object c, uintmax_t max)
{
- int valid = 0;
+ bool valid = 0;
uintmax_t val IF_LINT (= 0);
if (INTEGERP (c))
{
@@ -2384,7 +2384,7 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max)
intmax_t
cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
{
- int valid = 0;
+ bool valid = 0;
intmax_t val IF_LINT (= 0);
if (INTEGERP (c))
{
@@ -2437,20 +2437,17 @@ Uses a minus sign if negative.
NUMBER may be an integer or a floating point number. */)
(Lisp_Object number)
{
- char buffer[VALBITS];
+ char buffer[max (FLOAT_TO_STRING_BUFSIZE, INT_BUFSIZE_BOUND (EMACS_INT))];
+ int len;
CHECK_NUMBER_OR_FLOAT (number);
if (FLOATP (number))
- {
- char pigbuf[FLOAT_TO_STRING_BUFSIZE];
-
- float_to_string (pigbuf, XFLOAT_DATA (number));
- return build_string (pigbuf);
- }
+ len = float_to_string (buffer, XFLOAT_DATA (number));
+ else
+ len = sprintf (buffer, "%"pI"d", XINT (number));
- sprintf (buffer, "%"pI"d", XINT (number));
- return build_string (buffer);
+ return make_unibyte_string (buffer, len);
}
DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
@@ -2474,9 +2471,9 @@ If the base used is not 10, STRING is always parsed as integer. */)
else
{
CHECK_NUMBER (base);
- b = XINT (base);
- if (b < 2 || b > 16)
+ if (! (2 <= XINT (base) && XINT (base) <= 16))
xsignal1 (Qargs_out_of_range, base);
+ b = XINT (base);
}
p = SSDATA (string);
@@ -2505,16 +2502,13 @@ static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop,
static Lisp_Object
arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
{
- register Lisp_Object val;
- ptrdiff_t argnum;
- register EMACS_INT accum = 0;
- register EMACS_INT next;
-
- int overflow = 0;
- ptrdiff_t ok_args;
- EMACS_INT ok_accum;
+ Lisp_Object val;
+ ptrdiff_t argnum, ok_args;
+ EMACS_INT accum = 0;
+ EMACS_INT next, ok_accum;
+ bool overflow = 0;
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Alogior:
case Alogxor:
@@ -2549,7 +2543,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
nargs, args);
args[argnum] = val;
next = XINT (args[argnum]);
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Aadd:
if (INT_ADD_OVERFLOW (accum, next))
@@ -2635,7 +2629,7 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code,
args[argnum] = val; /* runs into a compiler bug. */
next = XINT (args[argnum]);
}
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Aadd:
accum += next;
@@ -2701,10 +2695,10 @@ usage: (* &rest NUMBERS-OR-MARKERS) */)
return arith_driver (Amult, nargs, args);
}
-DEFUN ("/", Fquo, Squo, 2, MANY, 0,
+DEFUN ("/", Fquo, Squo, 1, MANY, 0,
doc: /* Return first argument divided by all the remaining arguments.
The arguments must be numbers or markers.
-usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */)
+usage: (/ DIVIDEND &rest DIVISORS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t argnum;
@@ -2724,35 +2718,13 @@ Both must be integers or markers. */)
CHECK_NUMBER_COERCE_MARKER (x);
CHECK_NUMBER_COERCE_MARKER (y);
- if (XFASTINT (y) == 0)
+ if (XINT (y) == 0)
xsignal0 (Qarith_error);
XSETINT (val, XINT (x) % XINT (y));
return val;
}
-#ifndef HAVE_FMOD
-double
-fmod (double f1, double f2)
-{
- double r = f1;
-
- if (f2 < 0.0)
- f2 = -f2;
-
- /* If the magnitude of the result exceeds that of the divisor, or
- the sign of the result does not agree with that of the dividend,
- iterate with the reduced value. This does not yield a
- particularly accurate result, but at least it will be in the
- range promised by fmod. */
- do
- r -= f2 * floor (r / f2);
- while (f2 <= (r < 0 ? -r : r) || ((r < 0) != (f1 < 0) && ! isnan (r)));
-
- return r;
-}
-#endif /* ! HAVE_FMOD */
-
DEFUN ("mod", Fmod, Smod, 2, 2, 0,
doc: /* Return X modulo Y.
The result falls between zero (inclusive) and Y (exclusive).
@@ -2937,6 +2909,7 @@ syms_of_data (void)
DEFSYM (Qtop_level, "top-level");
DEFSYM (Qerror, "error");
+ DEFSYM (Quser_error, "user-error");
DEFSYM (Qquit, "quit");
DEFSYM (Qwrong_type_argument, "wrong-type-argument");
DEFSYM (Qargs_out_of_range, "args-out-of-range");
@@ -3002,104 +2975,44 @@ syms_of_data (void)
Fput (Qerror, Qerror_conditions,
error_tail);
Fput (Qerror, Qerror_message,
- make_pure_c_string ("error"));
-
- Fput (Qquit, Qerror_conditions,
- pure_cons (Qquit, Qnil));
- Fput (Qquit, Qerror_message,
- make_pure_c_string ("Quit"));
-
- Fput (Qwrong_type_argument, Qerror_conditions,
- pure_cons (Qwrong_type_argument, error_tail));
- Fput (Qwrong_type_argument, Qerror_message,
- make_pure_c_string ("Wrong type argument"));
-
- Fput (Qargs_out_of_range, Qerror_conditions,
- pure_cons (Qargs_out_of_range, error_tail));
- Fput (Qargs_out_of_range, Qerror_message,
- make_pure_c_string ("Args out of range"));
-
- Fput (Qvoid_function, Qerror_conditions,
- pure_cons (Qvoid_function, error_tail));
- Fput (Qvoid_function, Qerror_message,
- make_pure_c_string ("Symbol's function definition is void"));
-
- Fput (Qcyclic_function_indirection, Qerror_conditions,
- pure_cons (Qcyclic_function_indirection, error_tail));
- Fput (Qcyclic_function_indirection, Qerror_message,
- make_pure_c_string ("Symbol's chain of function indirections contains a loop"));
-
- Fput (Qcyclic_variable_indirection, Qerror_conditions,
- pure_cons (Qcyclic_variable_indirection, error_tail));
- Fput (Qcyclic_variable_indirection, Qerror_message,
- make_pure_c_string ("Symbol's chain of variable indirections contains a loop"));
-
+ build_pure_c_string ("error"));
+
+#define PUT_ERROR(sym, tail, msg) \
+ Fput (sym, Qerror_conditions, pure_cons (sym, tail)); \
+ Fput (sym, Qerror_message, build_pure_c_string (msg))
+
+ PUT_ERROR (Qquit, Qnil, "Quit");
+
+ PUT_ERROR (Quser_error, error_tail, "");
+ PUT_ERROR (Qwrong_type_argument, error_tail, "Wrong type argument");
+ PUT_ERROR (Qargs_out_of_range, error_tail, "Args out of range");
+ PUT_ERROR (Qvoid_function, error_tail,
+ "Symbol's function definition is void");
+ PUT_ERROR (Qcyclic_function_indirection, error_tail,
+ "Symbol's chain of function indirections contains a loop");
+ PUT_ERROR (Qcyclic_variable_indirection, error_tail,
+ "Symbol's chain of variable indirections contains a loop");
DEFSYM (Qcircular_list, "circular-list");
- Fput (Qcircular_list, Qerror_conditions,
- pure_cons (Qcircular_list, error_tail));
- Fput (Qcircular_list, Qerror_message,
- make_pure_c_string ("List contains a loop"));
-
- Fput (Qvoid_variable, Qerror_conditions,
- pure_cons (Qvoid_variable, error_tail));
- Fput (Qvoid_variable, Qerror_message,
- make_pure_c_string ("Symbol's value as variable is void"));
-
- Fput (Qsetting_constant, Qerror_conditions,
- pure_cons (Qsetting_constant, error_tail));
- Fput (Qsetting_constant, Qerror_message,
- make_pure_c_string ("Attempt to set a constant symbol"));
-
- Fput (Qinvalid_read_syntax, Qerror_conditions,
- pure_cons (Qinvalid_read_syntax, error_tail));
- Fput (Qinvalid_read_syntax, Qerror_message,
- make_pure_c_string ("Invalid read syntax"));
-
- Fput (Qinvalid_function, Qerror_conditions,
- pure_cons (Qinvalid_function, error_tail));
- Fput (Qinvalid_function, Qerror_message,
- make_pure_c_string ("Invalid function"));
-
- Fput (Qwrong_number_of_arguments, Qerror_conditions,
- pure_cons (Qwrong_number_of_arguments, error_tail));
- Fput (Qwrong_number_of_arguments, Qerror_message,
- make_pure_c_string ("Wrong number of arguments"));
-
- Fput (Qno_catch, Qerror_conditions,
- pure_cons (Qno_catch, error_tail));
- Fput (Qno_catch, Qerror_message,
- make_pure_c_string ("No catch for tag"));
-
- Fput (Qend_of_file, Qerror_conditions,
- pure_cons (Qend_of_file, error_tail));
- Fput (Qend_of_file, Qerror_message,
- make_pure_c_string ("End of file during parsing"));
+ PUT_ERROR (Qcircular_list, error_tail, "List contains a loop");
+ PUT_ERROR (Qvoid_variable, error_tail, "Symbol's value as variable is void");
+ PUT_ERROR (Qsetting_constant, error_tail,
+ "Attempt to set a constant symbol");
+ PUT_ERROR (Qinvalid_read_syntax, error_tail, "Invalid read syntax");
+ PUT_ERROR (Qinvalid_function, error_tail, "Invalid function");
+ PUT_ERROR (Qwrong_number_of_arguments, error_tail,
+ "Wrong number of arguments");
+ PUT_ERROR (Qno_catch, error_tail, "No catch for tag");
+ PUT_ERROR (Qend_of_file, error_tail, "End of file during parsing");
arith_tail = pure_cons (Qarith_error, error_tail);
- Fput (Qarith_error, Qerror_conditions,
- arith_tail);
- Fput (Qarith_error, Qerror_message,
- make_pure_c_string ("Arithmetic error"));
-
- Fput (Qbeginning_of_buffer, Qerror_conditions,
- pure_cons (Qbeginning_of_buffer, error_tail));
- Fput (Qbeginning_of_buffer, Qerror_message,
- make_pure_c_string ("Beginning of buffer"));
-
- Fput (Qend_of_buffer, Qerror_conditions,
- pure_cons (Qend_of_buffer, error_tail));
- Fput (Qend_of_buffer, Qerror_message,
- make_pure_c_string ("End of buffer"));
-
- Fput (Qbuffer_read_only, Qerror_conditions,
- pure_cons (Qbuffer_read_only, error_tail));
- Fput (Qbuffer_read_only, Qerror_message,
- make_pure_c_string ("Buffer is read-only"));
-
- Fput (Qtext_read_only, Qerror_conditions,
- pure_cons (Qtext_read_only, error_tail));
- Fput (Qtext_read_only, Qerror_message,
- make_pure_c_string ("Text is read-only"));
+ Fput (Qarith_error, Qerror_conditions, arith_tail);
+ Fput (Qarith_error, Qerror_message, build_pure_c_string ("Arithmetic error"));
+
+ PUT_ERROR (Qbeginning_of_buffer, error_tail, "Beginning of buffer");
+ PUT_ERROR (Qend_of_buffer, error_tail, "End of buffer");
+ PUT_ERROR (Qbuffer_read_only, error_tail, "Buffer is read-only");
+ PUT_ERROR (Qtext_read_only, pure_cons (Qbuffer_read_only, error_tail),
+ "Text is read-only");
DEFSYM (Qrange_error, "range-error");
DEFSYM (Qdomain_error, "domain-error");
@@ -3107,30 +3020,17 @@ syms_of_data (void)
DEFSYM (Qoverflow_error, "overflow-error");
DEFSYM (Qunderflow_error, "underflow-error");
- Fput (Qdomain_error, Qerror_conditions,
- pure_cons (Qdomain_error, arith_tail));
- Fput (Qdomain_error, Qerror_message,
- make_pure_c_string ("Arithmetic domain error"));
-
- Fput (Qrange_error, Qerror_conditions,
- pure_cons (Qrange_error, arith_tail));
- Fput (Qrange_error, Qerror_message,
- make_pure_c_string ("Arithmetic range error"));
+ PUT_ERROR (Qdomain_error, arith_tail, "Arithmetic domain error");
- Fput (Qsingularity_error, Qerror_conditions,
- pure_cons (Qsingularity_error, Fcons (Qdomain_error, arith_tail)));
- Fput (Qsingularity_error, Qerror_message,
- make_pure_c_string ("Arithmetic singularity error"));
+ PUT_ERROR (Qrange_error, arith_tail, "Arithmetic range error");
- Fput (Qoverflow_error, Qerror_conditions,
- pure_cons (Qoverflow_error, Fcons (Qdomain_error, arith_tail)));
- Fput (Qoverflow_error, Qerror_message,
- make_pure_c_string ("Arithmetic overflow error"));
+ PUT_ERROR (Qsingularity_error, Fcons (Qdomain_error, arith_tail),
+ "Arithmetic singularity error");
- Fput (Qunderflow_error, Qerror_conditions,
- pure_cons (Qunderflow_error, Fcons (Qdomain_error, arith_tail)));
- Fput (Qunderflow_error, Qerror_message,
- make_pure_c_string ("Arithmetic underflow error"));
+ PUT_ERROR (Qoverflow_error, Fcons (Qdomain_error, arith_tail),
+ "Arithmetic overflow error");
+ PUT_ERROR (Qunderflow_error, Fcons (Qdomain_error, arith_tail),
+ "Arithmetic underflow error");
staticpro (&Qnil);
staticpro (&Qt);
@@ -3147,7 +3047,6 @@ syms_of_data (void)
DEFSYM (Qwindow_configuration, "window-configuration");
DEFSYM (Qprocess, "process");
DEFSYM (Qwindow, "window");
- /* DEFSYM (Qsubr, "subr"); */
DEFSYM (Qcompiled_function, "compiled-function");
DEFSYM (Qbuffer, "buffer");
DEFSYM (Qframe, "frame");
@@ -3155,12 +3054,16 @@ syms_of_data (void)
DEFSYM (Qchar_table, "char-table");
DEFSYM (Qbool_vector, "bool-vector");
DEFSYM (Qhash_table, "hash-table");
+ DEFSYM (Qmisc, "misc");
+
+ DEFSYM (Qdefun, "defun");
DEFSYM (Qfont_spec, "font-spec");
DEFSYM (Qfont_entity, "font-entity");
DEFSYM (Qfont_object, "font-object");
DEFSYM (Qinteractive_form, "interactive-form");
+ DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
defsubr (&Sindirect_variable);
defsubr (&Sinteractive_form);
@@ -3257,7 +3160,7 @@ syms_of_data (void)
defsubr (&Ssubr_arity);
defsubr (&Ssubr_name);
- XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function;
+ set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->function);
DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum,
doc: /* The largest value that is representable in a Lisp integer. */);
@@ -3269,30 +3172,3 @@ syms_of_data (void)
Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1;
}
-
-#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD
-static void arith_error (int) NO_RETURN;
-#endif
-
-static void
-arith_error (int signo)
-{
- sigsetmask (SIGEMPTYMASK);
-
- SIGNAL_THREAD_CHECK (signo);
- xsignal0 (Qarith_error);
-}
-
-void
-init_data (void)
-{
- /* Don't do this if just dumping out.
- We don't want to call `signal' in this case
- so that we don't have trouble with dumping
- signal-delivering routines in an inconsistent state. */
-#ifndef CANNOT_DUMP
- if (!initialized)
- return;
-#endif /* CANNOT_DUMP */
- signal (SIGFPE, arith_error);
-}
diff --git a/src/dbusbind.c b/src/dbusbind.c
index c5448ee5e7a..80086946fc4 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -1,5 +1,5 @@
/* Elisp bindings for D-Bus.
- Copyright (C) 2007-2011 Free Software Foundation, Inc.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,26 +21,30 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_DBUS
#include <stdio.h>
#include <dbus/dbus.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "frame.h"
#include "termhooks.h"
#include "keyboard.h"
#include "process.h"
+#ifndef DBUS_NUM_MESSAGE_TYPES
+#define DBUS_NUM_MESSAGE_TYPES 5
+#endif
+
+
+/* Some platforms define the symbol "interface", but we want to use it
+ * as a variable name below. */
+
+#ifdef interface
+#undef interface
+#endif
+
/* Subroutines. */
static Lisp_Object Qdbus_init_bus;
-static Lisp_Object Qdbus_close_bus;
static Lisp_Object Qdbus_get_unique_name;
-static Lisp_Object Qdbus_call_method;
-static Lisp_Object Qdbus_call_method_asynchronously;
-static Lisp_Object Qdbus_method_return_internal;
-static Lisp_Object Qdbus_method_error_internal;
-static Lisp_Object Qdbus_send_signal;
-static Lisp_Object Qdbus_register_service;
-static Lisp_Object Qdbus_register_signal;
-static Lisp_Object Qdbus_register_method;
+static Lisp_Object Qdbus_message_internal;
/* D-Bus error symbol. */
static Lisp_Object Qdbus_error;
@@ -51,17 +55,6 @@ static Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
/* Lisp symbol for method call timeout. */
static Lisp_Object QCdbus_timeout;
-/* Lisp symbols for name request flags. */
-static Lisp_Object QCdbus_request_name_allow_replacement;
-static Lisp_Object QCdbus_request_name_replace_existing;
-static Lisp_Object QCdbus_request_name_do_not_queue;
-
-/* Lisp symbols for name request replies. */
-static Lisp_Object QCdbus_request_name_reply_primary_owner;
-static Lisp_Object QCdbus_request_name_reply_in_queue;
-static Lisp_Object QCdbus_request_name_reply_exists;
-static Lisp_Object QCdbus_request_name_reply_already_owner;
-
/* Lisp symbols of D-Bus types. */
static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
@@ -75,8 +68,17 @@ static Lisp_Object QCdbus_type_unix_fd;
static Lisp_Object QCdbus_type_array, QCdbus_type_variant;
static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
+/* Lisp symbols of objects in `dbus-registered-objects-table'. */
+static Lisp_Object QCdbus_registered_serial, QCdbus_registered_method;
+static Lisp_Object QCdbus_registered_signal;
+
+/* Alist of D-Bus buses we are polling for messages.
+ The key is the symbol or string of the bus, and the value is the
+ connection address. */
+static Lisp_Object xd_registered_buses;
+
/* Whether we are reading a D-Bus event. */
-static int xd_in_read_queued_messages = 0;
+static bool xd_in_read_queued_messages = 0;
/* We use "xd_" and "XD_" as prefix for all internal symbols, because
@@ -120,14 +122,15 @@ static int xd_in_read_queued_messages = 0;
} while (0)
/* Macros for debugging. In order to enable them, build with
- "MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
+ "env MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
#ifdef DBUS_DEBUG
-#define XD_DEBUG_MESSAGE(...) \
- do { \
- char s[1024]; \
- snprintf (s, sizeof s, __VA_ARGS__); \
- printf ("%s: %s\n", __func__, s); \
- message ("%s: %s", __func__, s); \
+#define XD_DEBUG_MESSAGE(...) \
+ do { \
+ char s[1024]; \
+ snprintf (s, sizeof s, __VA_ARGS__); \
+ if (!noninteractive) \
+ printf ("%s: %s\n", __func__, s); \
+ message ("%s: %s", __func__, s); \
} while (0)
#define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
do { \
@@ -144,7 +147,7 @@ static int xd_in_read_queued_messages = 0;
if (!NILP (Vdbus_debug)) \
{ \
char s[1024]; \
- snprintf (s, 1023, __VA_ARGS__); \
+ snprintf (s, sizeof s, __VA_ARGS__); \
message ("%s: %s", __func__, s); \
} \
} while (0)
@@ -152,6 +155,10 @@ static int xd_in_read_queued_messages = 0;
#endif
/* Check whether TYPE is a basic DBusType. */
+#ifdef HAVE_DBUS_TYPE_IS_VALID
+#define XD_BASIC_DBUS_TYPE(type) \
+ (dbus_type_is_valid (type) && dbus_type_is_basic (type))
+#else
#ifdef DBUS_TYPE_UNIX_FD
#define XD_BASIC_DBUS_TYPE(type) \
((type == DBUS_TYPE_BYTE) \
@@ -182,6 +189,7 @@ static int xd_in_read_queued_messages = 0;
|| (type == DBUS_TYPE_OBJECT_PATH) \
|| (type == DBUS_TYPE_SIGNATURE))
#endif
+#endif
/* This was a macro. On Solaris 2.11 it was said to compile for
hours, when optimization is enabled. So we have transferred it into
@@ -241,23 +249,104 @@ xd_symbol_to_dbus_type (Lisp_Object object)
#define XD_NEXT_VALUE(object) \
((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
-/* Check whether X is a valid dbus serial number. If valid, set
- SERIAL to its value. Otherwise, signal an error. */
-#define CHECK_DBUS_SERIAL_GET_SERIAL(x, serial) \
- do \
- { \
- dbus_uint32_t DBUS_SERIAL_MAX = -1; \
- if (NATNUMP (x) && XINT (x) <= DBUS_SERIAL_MAX) \
- serial = XINT (x); \
- else if (MOST_POSITIVE_FIXNUM < DBUS_SERIAL_MAX \
- && FLOATP (x) \
- && 0 <= XFLOAT_DATA (x) \
- && XFLOAT_DATA (x) <= DBUS_SERIAL_MAX) \
- serial = XFLOAT_DATA (x); \
- else \
- XD_SIGNAL2 (build_string ("Invalid dbus serial"), x); \
- } \
- while (0)
+/* Transform the message type to its string representation for debug
+ messages. */
+#define XD_MESSAGE_TYPE_TO_STRING(mtype) \
+ ((mtype == DBUS_MESSAGE_TYPE_INVALID) \
+ ? "DBUS_MESSAGE_TYPE_INVALID" \
+ : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) \
+ ? "DBUS_MESSAGE_TYPE_METHOD_CALL" \
+ : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) \
+ ? "DBUS_MESSAGE_TYPE_METHOD_RETURN" \
+ : (mtype == DBUS_MESSAGE_TYPE_ERROR) \
+ ? "DBUS_MESSAGE_TYPE_ERROR" \
+ : "DBUS_MESSAGE_TYPE_SIGNAL")
+
+/* Transform the object to its string representation for debug
+ messages. */
+#define XD_OBJECT_TO_STRING(object) \
+ SDATA (format2 ("%s", object, Qnil))
+
+#define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
+ do { \
+ char const *session_bus_address = getenv ("DBUS_SESSION_BUS_ADDRESS"); \
+ if (STRINGP (bus)) \
+ { \
+ DBusAddressEntry **entries; \
+ int len; \
+ DBusError derror; \
+ dbus_error_init (&derror); \
+ if (!dbus_parse_address (SSDATA (bus), &entries, &len, &derror)) \
+ XD_ERROR (derror); \
+ /* Cleanup. */ \
+ dbus_error_free (&derror); \
+ dbus_address_entries_free (entries); \
+ /* Canonicalize session bus address. */ \
+ if ((session_bus_address != NULL) \
+ && (!NILP (Fstring_equal \
+ (bus, build_string (session_bus_address))))) \
+ bus = QCdbus_session_bus; \
+ } \
+ \
+ else \
+ { \
+ CHECK_SYMBOL (bus); \
+ if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) \
+ XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
+ /* We do not want to have an autolaunch for the session bus. */ \
+ if (EQ (bus, QCdbus_session_bus) && session_bus_address == NULL) \
+ XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
+ } \
+ } while (0)
+
+#if (HAVE_DBUS_VALIDATE_BUS_NAME || HAVE_DBUS_VALIDATE_PATH \
+ || HAVE_DBUS_VALIDATE_INTERFACE || HAVE_DBUS_VALIDATE_MEMBER)
+#define XD_DBUS_VALIDATE_OBJECT(object, func) \
+ do { \
+ if (!NILP (object)) \
+ { \
+ DBusError derror; \
+ CHECK_STRING (object); \
+ dbus_error_init (&derror); \
+ if (!func (SSDATA (object), &derror)) \
+ XD_ERROR (derror); \
+ /* Cleanup. */ \
+ dbus_error_free (&derror); \
+ } \
+ } while (0)
+#endif
+
+#if HAVE_DBUS_VALIDATE_BUS_NAME
+#define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
+ XD_DBUS_VALIDATE_OBJECT(bus_name, dbus_validate_bus_name);
+#else
+#define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
+ if (!NILP (bus_name)) CHECK_STRING (bus_name);
+#endif
+
+#if HAVE_DBUS_VALIDATE_PATH
+#define XD_DBUS_VALIDATE_PATH(path) \
+ XD_DBUS_VALIDATE_OBJECT(path, dbus_validate_path);
+#else
+#define XD_DBUS_VALIDATE_PATH(path) \
+ if (!NILP (path)) CHECK_STRING (path);
+#endif
+
+#if HAVE_DBUS_VALIDATE_INTERFACE
+#define XD_DBUS_VALIDATE_INTERFACE(interface) \
+ XD_DBUS_VALIDATE_OBJECT(interface, dbus_validate_interface);
+#else
+#define XD_DBUS_VALIDATE_INTERFACE(interface) \
+ if (!NILP (interface)) CHECK_STRING (interface);
+#endif
+
+#if HAVE_DBUS_VALIDATE_MEMBER
+#define XD_DBUS_VALIDATE_MEMBER(member) \
+ XD_DBUS_VALIDATE_OBJECT(member, dbus_validate_member);
+#else
+#define XD_DBUS_VALIDATE_MEMBER(member) \
+ if (!NILP (member)) CHECK_STRING (member);
+#endif
/* Append to SIGNATURE a copy of X, making sure SIGNATURE does
not become too long. */
@@ -279,9 +368,9 @@ xd_signature_cat (char *signature, char const *x)
signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
static void
-xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lisp_Object object)
+xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
{
- unsigned int subtype;
+ int subtype;
Lisp_Object elt;
char const *subsig;
int subsiglen;
@@ -293,11 +382,6 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
{
case DBUS_TYPE_BYTE:
case DBUS_TYPE_UINT16:
- case DBUS_TYPE_UINT32:
- case DBUS_TYPE_UINT64:
-#ifdef DBUS_TYPE_UNIX_FD
- case DBUS_TYPE_UNIX_FD:
-#endif
CHECK_NATNUM (object);
sprintf (signature, "%c", dtype);
break;
@@ -309,14 +393,19 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
break;
case DBUS_TYPE_INT16:
- case DBUS_TYPE_INT32:
- case DBUS_TYPE_INT64:
CHECK_NUMBER (object);
sprintf (signature, "%c", dtype);
break;
+ case DBUS_TYPE_UINT32:
+ case DBUS_TYPE_UINT64:
+#ifdef DBUS_TYPE_UNIX_FD
+ case DBUS_TYPE_UNIX_FD:
+#endif
+ case DBUS_TYPE_INT32:
+ case DBUS_TYPE_INT64:
case DBUS_TYPE_DOUBLE:
- CHECK_FLOAT (object);
+ CHECK_NUMBER_OR_FLOAT (object);
sprintf (signature, "%c", dtype);
break;
@@ -352,8 +441,8 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
}
/* If the element type is DBUS_TYPE_SIGNATURE, and this is the
- only element, the value of this element is used as he array's
- element signature. */
+ only element, the value of this element is used as the
+ array's element signature. */
if ((subtype == DBUS_TYPE_SIGNATURE)
&& STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
&& NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
@@ -451,13 +540,67 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis
XD_DEBUG_MESSAGE ("%s", signature);
}
+/* Convert X to a signed integer with bounds LO and HI. */
+static intmax_t
+xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi)
+{
+ CHECK_NUMBER_OR_FLOAT (x);
+ if (INTEGERP (x))
+ {
+ if (lo <= XINT (x) && XINT (x) <= hi)
+ return XINT (x);
+ }
+ else
+ {
+ double d = XFLOAT_DATA (x);
+ if (lo <= d && d <= hi)
+ {
+ intmax_t n = d;
+ if (n == d)
+ return n;
+ }
+ }
+ if (xd_in_read_queued_messages)
+ Fthrow (Qdbus_error, Qnil);
+ else
+ args_out_of_range_3 (x,
+ make_fixnum_or_float (lo),
+ make_fixnum_or_float (hi));
+}
+
+/* Convert X to an unsigned integer with bounds 0 and HI. */
+static uintmax_t
+xd_extract_unsigned (Lisp_Object x, uintmax_t hi)
+{
+ CHECK_NUMBER_OR_FLOAT (x);
+ if (INTEGERP (x))
+ {
+ if (0 <= XINT (x) && XINT (x) <= hi)
+ return XINT (x);
+ }
+ else
+ {
+ double d = XFLOAT_DATA (x);
+ if (0 <= d && d <= hi)
+ {
+ uintmax_t n = d;
+ if (n == d)
+ return n;
+ }
+ }
+ if (xd_in_read_queued_messages)
+ Fthrow (Qdbus_error, Qnil);
+ else
+ args_out_of_range_3 (x, make_number (0), make_fixnum_or_float (hi));
+}
+
/* Append C value, extracted from Lisp OBJECT, to iteration ITER.
DTYPE must be a valid DBusType. It is used to convert Lisp
objects, being arguments of `dbus-call-method' or
`dbus-send-signal', into corresponding C values appended as
arguments to a D-Bus message. */
static void
-xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
+xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
{
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
DBusMessageIter subiter;
@@ -469,7 +612,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
CHECK_NATNUM (object);
{
unsigned char val = XFASTINT (object) & 0xFF;
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ XD_DEBUG_MESSAGE ("%c %u", dtype, val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
@@ -485,30 +628,38 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
}
case DBUS_TYPE_INT16:
- CHECK_NUMBER (object);
{
- dbus_int16_t val = XINT (object);
- XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+ dbus_int16_t val =
+ xd_extract_signed (object,
+ TYPE_MINIMUM (dbus_int16_t),
+ TYPE_MAXIMUM (dbus_int16_t));
+ int pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_UINT16:
- CHECK_NATNUM (object);
{
- dbus_uint16_t val = XFASTINT (object);
- XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
+ dbus_uint16_t val =
+ xd_extract_unsigned (object,
+ TYPE_MAXIMUM (dbus_uint16_t));
+ unsigned int pval = val;
+ XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_INT32:
- CHECK_NUMBER (object);
{
- dbus_int32_t val = XINT (object);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ dbus_int32_t val =
+ xd_extract_signed (object,
+ TYPE_MINIMUM (dbus_int32_t),
+ TYPE_MAXIMUM (dbus_int32_t));
+ int pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
@@ -518,39 +669,45 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
#ifdef DBUS_TYPE_UNIX_FD
case DBUS_TYPE_UNIX_FD:
#endif
- CHECK_NATNUM (object);
{
- dbus_uint32_t val = XFASTINT (object);
- XD_DEBUG_MESSAGE ("%c %u", dtype, val);
+ dbus_uint32_t val =
+ xd_extract_unsigned (object,
+ TYPE_MAXIMUM (dbus_uint32_t));
+ unsigned int pval = val;
+ XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_INT64:
- CHECK_NUMBER (object);
{
- dbus_int64_t val = XINT (object);
- XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+ dbus_int64_t val =
+ xd_extract_signed (object,
+ TYPE_MINIMUM (dbus_int64_t),
+ TYPE_MAXIMUM (dbus_int64_t));
+ printmax_t pval = val;
+ XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_UINT64:
- CHECK_NATNUM (object);
{
- dbus_uint64_t val = XFASTINT (object);
- XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, XFASTINT (object));
+ dbus_uint64_t val =
+ xd_extract_unsigned (object,
+ TYPE_MAXIMUM (dbus_uint64_t));
+ uprintmax_t pval = val;
+ XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_DOUBLE:
- CHECK_FLOAT (object);
{
- double val = XFLOAT_DATA (object);
+ double val = extract_float (object);
XD_DEBUG_MESSAGE ("%c %f", dtype, val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
@@ -614,7 +771,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
- SDATA (format2 ("%s", object, Qnil)));
+ XD_OBJECT_TO_STRING (object));
if (!dbus_message_iter_open_container (iter, dtype,
signature, &subiter))
XD_SIGNAL3 (build_string ("Cannot open container"),
@@ -627,7 +784,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
- SDATA (format2 ("%s", object, Qnil)));
+ XD_OBJECT_TO_STRING (object));
if (!dbus_message_iter_open_container (iter, dtype,
signature, &subiter))
XD_SIGNAL3 (build_string ("Cannot open container"),
@@ -637,8 +794,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
case DBUS_TYPE_STRUCT:
case DBUS_TYPE_DICT_ENTRY:
/* These containers do not require a signature. */
- XD_DEBUG_MESSAGE ("%c %s", dtype,
- SDATA (format2 ("%s", object, Qnil)));
+ XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (object));
if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
XD_SIGNAL2 (build_string ("Cannot open container"),
make_number (dtype));
@@ -668,7 +824,7 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
D-Bus message must be a valid DBusType. Compound D-Bus types
result always in a Lisp list. */
static Lisp_Object
-xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
+xd_retrieve_arg (int dtype, DBusMessageIter *iter)
{
switch (dtype)
@@ -678,7 +834,7 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
unsigned int val;
dbus_message_iter_get_basic (iter, &val);
val = val & 0xFF;
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ XD_DEBUG_MESSAGE ("%c %u", dtype, val);
return make_number (val);
}
@@ -693,24 +849,30 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
case DBUS_TYPE_INT16:
{
dbus_int16_t val;
+ int pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
return make_number (val);
}
case DBUS_TYPE_UINT16:
{
dbus_uint16_t val;
+ int pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
return make_number (val);
}
case DBUS_TYPE_INT32:
{
dbus_int32_t val;
+ int pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
return make_fixnum_or_float (val);
}
@@ -720,24 +882,30 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
#endif
{
dbus_uint32_t val;
+ unsigned int pval = val;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
return make_fixnum_or_float (val);
}
case DBUS_TYPE_INT64:
{
dbus_int64_t val;
+ printmax_t pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
return make_fixnum_or_float (val);
}
case DBUS_TYPE_UINT64:
{
dbus_uint64_t val;
+ uprintmax_t pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
return make_fixnum_or_float (val);
}
@@ -777,7 +945,7 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
dbus_message_iter_next (&subiter);
}
- XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", result, Qnil)));
+ XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
RETURN_UNGCPRO (Fnreverse (result));
}
@@ -787,85 +955,37 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
}
}
-/* Initialize D-Bus connection. BUS is either a Lisp symbol, :system
- or :session, or a string denoting the bus address. It tells which
- D-Bus to initialize. If RAISE_ERROR is non-zero, signal an error
- when the connection cannot be initialized. */
+/* Return the number of references of the shared CONNECTION. */
+static ptrdiff_t
+xd_get_connection_references (DBusConnection *connection)
+{
+ ptrdiff_t *refcount;
+
+ /* We cannot access the DBusConnection structure, it is not public.
+ But we know, that the reference counter is the first field in
+ that structure. */
+ refcount = (void *) &connection;
+ refcount = (void *) *refcount;
+ return *refcount;
+}
+
+/* Return D-Bus connection address. BUS is either a Lisp symbol,
+ :system or :session, or a string denoting the bus address. */
static DBusConnection *
-xd_initialize (Lisp_Object bus, int raise_error)
+xd_get_connection_address (Lisp_Object bus)
{
DBusConnection *connection;
- DBusError derror;
-
- /* Parameter check. */
- if (!STRINGP (bus))
- {
- CHECK_SYMBOL (bus);
- if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus)))
- {
- if (raise_error)
- XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
- else
- return NULL;
- }
-
- /* We do not want to have an autolaunch for the session bus. */
- if (EQ (bus, QCdbus_session_bus)
- && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)
- {
- if (raise_error)
- XD_SIGNAL2 (build_string ("No connection to bus"), bus);
- else
- return NULL;
- }
- }
-
- /* Open a connection to the bus. */
- dbus_error_init (&derror);
+ Lisp_Object val;
- if (STRINGP (bus))
- connection = dbus_connection_open (SSDATA (bus), &derror);
+ val = CDR_SAFE (Fassoc (bus, xd_registered_buses));
+ if (NILP (val))
+ XD_SIGNAL2 (build_string ("No connection to bus"), bus);
else
- if (EQ (bus, QCdbus_system_bus))
- connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
- else
- connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
-
- if (dbus_error_is_set (&derror))
- {
- if (raise_error)
- XD_ERROR (derror);
- else
- connection = NULL;
- }
-
- /* If it is not the system or session bus, we must register
- ourselves. Otherwise, we have called dbus_bus_get, which has
- configured us to exit if the connection closes - we undo this
- setting. */
- if (connection != NULL)
- {
- if (STRINGP (bus))
- dbus_bus_register (connection, &derror);
- else
- dbus_connection_set_exit_on_disconnect (connection, FALSE);
- }
-
- if (dbus_error_is_set (&derror))
- {
- if (raise_error)
- XD_ERROR (derror);
- else
- connection = NULL;
- }
+ connection = (DBusConnection *) (intptr_t) XFASTINT (val);
- if (connection == NULL && raise_error)
+ if (!dbus_connection_get_is_connected (connection))
XD_SIGNAL2 (build_string ("No connection to bus"), bus);
- /* Cleanup. */
- dbus_error_free (&derror);
-
- /* Return the result. */
return connection;
}
@@ -874,7 +994,7 @@ static int
xd_find_watch_fd (DBusWatch *watch)
{
#if HAVE_DBUS_WATCH_GET_UNIX_FD
- /* TODO: Reverse these on Win32, which prefers the opposite. */
+ /* TODO: Reverse these on w32, which prefers the opposite. */
int fd = dbus_watch_get_unix_fd (watch);
if (fd == -1)
fd = dbus_watch_get_socket (watch);
@@ -885,8 +1005,7 @@ xd_find_watch_fd (DBusWatch *watch)
}
/* Prototype. */
-static void
-xd_read_queued_messages (int fd, void *data, int for_read);
+static void xd_read_queued_messages (int fd, void *data);
/* Start monitoring WATCH for possible I/O. */
static dbus_bool_t
@@ -896,8 +1015,8 @@ xd_add_watch (DBusWatch *watch, void *data)
int fd = xd_find_watch_fd (watch);
XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
- fd, flags & DBUS_WATCH_WRITABLE,
- dbus_watch_get_enabled (watch));
+ fd, flags & DBUS_WATCH_WRITABLE,
+ dbus_watch_get_enabled (watch));
if (fd == -1)
return FALSE;
@@ -927,11 +1046,13 @@ xd_remove_watch (DBusWatch *watch, void *data)
return;
/* Unset session environment. */
+#if 0
if (XSYMBOL (QCdbus_session_bus) == data)
{
XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
unsetenv ("DBUS_SESSION_BUS_ADDRESS");
}
+#endif
if (flags & DBUS_WATCH_WRITABLE)
delete_write_fd (fd);
@@ -949,60 +1070,150 @@ xd_toggle_watch (DBusWatch *watch, void *data)
xd_remove_watch (watch, data);
}
-DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0,
- doc: /* Initialize connection to D-Bus BUS. */)
- (Lisp_Object bus)
+/* Close connection to D-Bus BUS. */
+static void
+xd_close_bus (Lisp_Object bus)
{
DBusConnection *connection;
- void *busp;
+ Lisp_Object val;
- /* Check parameter. */
- if (SYMBOLP (bus))
- busp = XSYMBOL (bus);
- else if (STRINGP (bus))
- busp = XSTRING (bus);
- else
- wrong_type_argument (intern ("D-Bus"), bus);
+ /* Check whether we are connected. */
+ val = Fassoc (bus, xd_registered_buses);
+ if (NILP (val))
+ return;
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
+ /* Retrieve bus address. */
+ connection = xd_get_connection_address (bus);
- /* Add the watch functions. We pass also the bus as data, in order
- to distinguish between the buses in xd_remove_watch. */
- if (!dbus_connection_set_watch_functions (connection,
- xd_add_watch,
- xd_remove_watch,
- xd_toggle_watch,
- busp, NULL))
- XD_SIGNAL1 (build_string ("Cannot add watch functions"));
+ if (xd_get_connection_references (connection) == 1)
+ {
+ /* Close connection, if there isn't another shared application. */
+ XD_DEBUG_MESSAGE ("Close connection to bus %s",
+ XD_OBJECT_TO_STRING (bus));
+ dbus_connection_close (connection);
- /* Add bus to list of registered buses. */
- Vdbus_registered_buses = Fcons (bus, Vdbus_registered_buses);
+ xd_registered_buses = Fdelete (val, xd_registered_buses);
+ }
- /* We do not want to abort. */
- putenv ((char *) "DBUS_FATAL_WARNINGS=0");
+ else
+ /* Decrement reference count. */
+ dbus_connection_unref (connection);
/* Return. */
- return Qnil;
+ return;
}
-DEFUN ("dbus-close-bus", Fdbus_close_bus, Sdbus_close_bus, 1, 1, 0,
- doc: /* Close connection to D-Bus BUS. */)
- (Lisp_Object bus)
+DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 2, 0,
+ doc: /* Establish the connection to D-Bus BUS.
+
+BUS can be either the symbol `:system' or the symbol `:session', or it
+can be a string denoting the address of the corresponding bus. For
+the system and session buses, this function is called when loading
+`dbus.el', there is no need to call it again.
+
+The function returns a number, which counts the connections this Emacs
+session has established to the BUS under the same unique name (see
+`dbus-get-unique-name'). It depends on the libraries Emacs is linked
+with, and on the environment Emacs is running. For example, if Emacs
+is linked with the gtk toolkit, and it runs in a GTK-aware environment
+like Gnome, another connection might already be established.
+
+When PRIVATE is non-nil, a new connection is established instead of
+reusing an existing one. It results in a new unique name at the bus.
+This can be used, if it is necessary to distinguish from another
+connection used in the same Emacs process, like the one established by
+GTK+. It should be used with care for at least the `:system' and
+`:session' buses, because other Emacs Lisp packages might already use
+this connection to those buses. */)
+ (Lisp_Object bus, Lisp_Object private)
{
DBusConnection *connection;
+ DBusError derror;
+ Lisp_Object val;
+ ptrdiff_t refcount;
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
+ /* Check parameter. */
+ XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
- /* Decrement reference count to the bus. */
- dbus_connection_unref (connection);
+ /* Close bus if it is already open. */
+ xd_close_bus (bus);
- /* Remove bus from list of registered buses. */
- Vdbus_registered_buses = Fdelete (bus, Vdbus_registered_buses);
+ /* Check, whether we are still connected. */
+ val = Fassoc (bus, xd_registered_buses);
+ if (!NILP (val))
+ {
+ connection = xd_get_connection_address (bus);
+ dbus_connection_ref (connection);
+ }
- /* Return. */
- return Qnil;
+ else
+ {
+ /* Initialize. */
+ dbus_error_init (&derror);
+
+ /* Open the connection. */
+ if (STRINGP (bus))
+ if (NILP (private))
+ connection = dbus_connection_open (SSDATA (bus), &derror);
+ else
+ connection = dbus_connection_open_private (SSDATA (bus), &derror);
+
+ else
+ if (NILP (private))
+ connection = dbus_bus_get (EQ (bus, QCdbus_system_bus)
+ ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
+ &derror);
+ else
+ connection = dbus_bus_get_private (EQ (bus, QCdbus_system_bus)
+ ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
+ &derror);
+
+ if (dbus_error_is_set (&derror))
+ XD_ERROR (derror);
+
+ if (connection == NULL)
+ XD_SIGNAL2 (build_string ("No connection to bus"), bus);
+
+ /* If it is not the system or session bus, we must register
+ ourselves. Otherwise, we have called dbus_bus_get, which has
+ configured us to exit if the connection closes - we undo this
+ setting. */
+ if (STRINGP (bus))
+ dbus_bus_register (connection, &derror);
+ else
+ dbus_connection_set_exit_on_disconnect (connection, FALSE);
+
+ if (dbus_error_is_set (&derror))
+ XD_ERROR (derror);
+
+ /* Add the watch functions. We pass also the bus as data, in
+ order to distinguish between the buses in xd_remove_watch. */
+ if (!dbus_connection_set_watch_functions (connection,
+ xd_add_watch,
+ xd_remove_watch,
+ xd_toggle_watch,
+ SYMBOLP (bus)
+ ? (void *) XSYMBOL (bus)
+ : (void *) XSTRING (bus),
+ NULL))
+ XD_SIGNAL1 (build_string ("Cannot add watch functions"));
+
+ /* Add bus to list of registered buses. */
+ XSETFASTINT (val, (intptr_t) connection);
+ xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses);
+
+ /* We do not want to abort. */
+ putenv ((char *) "DBUS_FATAL_WARNINGS=0");
+
+ /* Cleanup. */
+ dbus_error_free (&derror);
+ }
+
+ /* Return reference counter. */
+ refcount = xd_get_connection_references (connection);
+ XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD"d",
+ XD_OBJECT_TO_STRING (bus), refcount);
+ return make_number (refcount);
}
DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
@@ -1013,8 +1224,11 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
DBusConnection *connection;
const char *name;
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
+ /* Check parameter. */
+ XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
+
+ /* Retrieve bus address. */
+ connection = xd_get_connection_address (bus);
/* Request the name. */
name = dbus_bus_get_unique_name (connection);
@@ -1025,341 +1239,244 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
return build_string (name);
}
-DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0,
- doc: /* Call METHOD on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name to be used. PATH is the D-Bus
-object path SERVICE is registered at. INTERFACE is an interface
-offered by SERVICE. It must provide METHOD.
-
-If the parameter `:timeout' is given, the following integer TIMEOUT
-specifies the maximum number of milliseconds the method call must
-return. The default value is 25,000. If the method call doesn't
-return in time, a D-Bus error is raised.
-
-All other arguments ARGS are passed to METHOD as arguments. They are
-converted into D-Bus types via the following rules:
-
- t and nil => DBUS_TYPE_BOOLEAN
- number => DBUS_TYPE_UINT32
- integer => DBUS_TYPE_INT32
- float => DBUS_TYPE_DOUBLE
- string => DBUS_TYPE_STRING
- list => DBUS_TYPE_ARRAY
-
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
-
-`dbus-call-method' returns the resulting values of METHOD as a list of
-Lisp objects. The type conversion happens the other direction as for
-input arguments. It follows the mapping rules:
-
- DBUS_TYPE_BOOLEAN => t or nil
- DBUS_TYPE_BYTE => number
- DBUS_TYPE_UINT16 => number
- DBUS_TYPE_INT16 => integer
- DBUS_TYPE_UINT32 => number or float
- DBUS_TYPE_UNIX_FD => number or float
- DBUS_TYPE_INT32 => integer or float
- DBUS_TYPE_UINT64 => number or float
- DBUS_TYPE_INT64 => integer or float
- DBUS_TYPE_DOUBLE => float
- DBUS_TYPE_STRING => string
- DBUS_TYPE_OBJECT_PATH => string
- DBUS_TYPE_SIGNATURE => string
- DBUS_TYPE_ARRAY => list
- DBUS_TYPE_VARIANT => list
- DBUS_TYPE_STRUCT => list
- DBUS_TYPE_DICT_ENTRY => list
-
-Example:
-
-\(dbus-call-method
- :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
- "org.gnome.seahorse.Keys" "GetKeyField"
- "openpgp:657984B8C7A966DD" "simple-name")
-
- => (t ("Philip R. Zimmermann"))
-
-If the result of the METHOD call is just one value, the converted Lisp
-object is returned instead of a list containing this single Lisp object.
-
-\(dbus-call-method
- :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
- "org.freedesktop.Hal.Device" "GetPropertyString"
- "system.kernel.machine")
-
- => "i686"
-
-usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
+DEFUN ("dbus-message-internal", Fdbus_message_internal, Sdbus_message_internal,
+ 4, MANY, 0,
+ doc: /* Send a D-Bus message.
+This is an internal function, it shall not be used outside dbus.el.
+
+The following usages are expected:
+
+`dbus-call-method', `dbus-call-method-asynchronously':
+ \(dbus-message-internal
+ dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
+ &optional :timeout TIMEOUT &rest ARGS)
+
+`dbus-send-signal':
+ \(dbus-message-internal
+ dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
+
+`dbus-method-return-internal':
+ \(dbus-message-internal
+ dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
+
+`dbus-method-error-internal':
+ \(dbus-message-internal
+ dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
+
+usage: (dbus-message-internal &rest REST) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object bus, service, path, interface, method;
+ Lisp_Object message_type, bus, service, handler;
+ Lisp_Object path = Qnil;
+ Lisp_Object interface = Qnil;
+ Lisp_Object member = Qnil;
Lisp_Object result;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
DBusConnection *connection;
DBusMessage *dmessage;
- DBusMessage *reply;
DBusMessageIter iter;
- DBusError derror;
- unsigned int dtype;
+ int dtype;
+ int mtype;
+ dbus_uint32_t serial = 0;
+ unsigned int ui_serial;
int timeout = -1;
- ptrdiff_t i = 5;
+ ptrdiff_t count;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
+ /* Initialize parameters. */
+ message_type = args[0];
+ bus = args[1];
+ service = args[2];
+ handler = Qnil;
+
+ CHECK_NATNUM (message_type);
+ if (! (DBUS_MESSAGE_TYPE_INVALID < XFASTINT (message_type)
+ && XFASTINT (message_type) < DBUS_NUM_MESSAGE_TYPES))
+ XD_SIGNAL2 (build_string ("Invalid message type"), message_type);
+ mtype = XFASTINT (message_type);
+
+ if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
+ {
+ path = args[3];
+ interface = args[4];
+ member = args[5];
+ if (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ handler = args[6];
+ count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6;
+ }
+ else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ {
+ serial = xd_extract_unsigned (args[3], TYPE_MAXIMUM (dbus_uint32_t));
+ count = 4;
+ }
+
/* Check parameters. */
- bus = args[0];
- service = args[1];
- path = args[2];
- interface = args[3];
- method = args[4];
-
- CHECK_STRING (service);
- CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (method);
- GCPRO5 (bus, service, path, interface, method);
-
- XD_DEBUG_MESSAGE ("%s %s %s %s",
- SDATA (service),
- SDATA (path),
- SDATA (interface),
- SDATA (method));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new_method_call (SSDATA (service),
- SSDATA (path),
- SSDATA (interface),
- SSDATA (method));
- UNGCPRO;
- if (dmessage == NULL)
- XD_SIGNAL1 (build_string ("Unable to create a new message"));
+ XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
+ XD_DBUS_VALIDATE_BUS_NAME (service);
+ if (nargs < count)
+ xsignal2 (Qwrong_number_of_arguments,
+ Qdbus_message_internal,
+ make_number (nargs));
+
+ if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
+ {
+ XD_DBUS_VALIDATE_PATH (path);
+ XD_DBUS_VALIDATE_INTERFACE (interface);
+ XD_DBUS_VALIDATE_MEMBER (member);
+ if (!NILP (handler) && (!FUNCTIONP (handler)))
+ wrong_type_argument (Qinvalid_function, handler);
+ }
- /* Check for timeout parameter. */
- if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
+ /* Protect Lisp variables. */
+ GCPRO6 (bus, service, path, interface, member, handler);
+
+ /* Trace parameters. */
+ switch (mtype)
{
- CHECK_NATNUM (args[i+1]);
- timeout = XFASTINT (args[i+1]);
- i = i+2;
+ case DBUS_MESSAGE_TYPE_METHOD_CALL:
+ XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
+ XD_OBJECT_TO_STRING (bus),
+ XD_OBJECT_TO_STRING (service),
+ XD_OBJECT_TO_STRING (path),
+ XD_OBJECT_TO_STRING (interface),
+ XD_OBJECT_TO_STRING (member),
+ XD_OBJECT_TO_STRING (handler));
+ break;
+ case DBUS_MESSAGE_TYPE_SIGNAL:
+ XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
+ XD_OBJECT_TO_STRING (bus),
+ XD_OBJECT_TO_STRING (service),
+ XD_OBJECT_TO_STRING (path),
+ XD_OBJECT_TO_STRING (interface),
+ XD_OBJECT_TO_STRING (member));
+ break;
+ default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ ui_serial = serial;
+ XD_DEBUG_MESSAGE ("%s %s %s %u",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
+ XD_OBJECT_TO_STRING (bus),
+ XD_OBJECT_TO_STRING (service),
+ ui_serial);
}
- /* Initialize parameter list of message. */
- dbus_message_iter_init_append (dmessage, &iter);
+ /* Retrieve bus address. */
+ connection = xd_get_connection_address (bus);
- /* Append parameters to the message. */
- for (; i < nargs; ++i)
+ /* Create the D-Bus message. */
+ dmessage = dbus_message_new (mtype);
+ if (dmessage == NULL)
{
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Unable to create a new message"));
+ }
+
+ if (STRINGP (service))
+ {
+ if (mtype != DBUS_MESSAGE_TYPE_SIGNAL)
+ /* Set destination. */
{
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
+ if (!dbus_message_set_destination (dmessage, SSDATA (service)))
+ {
+ UNGCPRO;
+ XD_SIGNAL2 (build_string ("Unable to set the destination"),
+ service);
+ }
}
+
else
+ /* Set destination for unicast signals. */
{
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)));
- }
+ Lisp_Object uname;
- /* Check for valid signature. We use DBUS_TYPE_INVALID as
- indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
+ /* If it is the same unique name as we are registered at the
+ bus or an unknown name, we regard it as broadcast message
+ due to backward compatibility. */
+ if (dbus_bus_name_has_owner (connection, SSDATA (service), NULL))
+ uname = call2 (intern ("dbus-get-name-owner"), bus, service);
+ else
+ uname = Qnil;
- xd_append_arg (dtype, args[i], &iter);
+ if (STRINGP (uname)
+ && (strcmp (dbus_bus_get_unique_name (connection), SSDATA (uname))
+ != 0)
+ && (!dbus_message_set_destination (dmessage, SSDATA (service))))
+ {
+ UNGCPRO;
+ XD_SIGNAL2 (build_string ("Unable to set signal destination"),
+ service);
+ }
+ }
}
- /* Send the message. */
- dbus_error_init (&derror);
- reply = dbus_connection_send_with_reply_and_block (connection,
- dmessage,
- timeout,
- &derror);
-
- if (dbus_error_is_set (&derror))
- XD_ERROR (derror);
-
- if (reply == NULL)
- XD_SIGNAL1 (build_string ("No reply"));
-
- XD_DEBUG_MESSAGE ("Message sent");
-
- /* Collect the results. */
- result = Qnil;
- GCPRO1 (result);
-
- if (dbus_message_iter_init (reply, &iter))
+ /* Set message parameters. */
+ if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
{
- /* Loop over the parameters of the D-Bus reply message. Construct a
- Lisp list, which is returned by `dbus-call-method'. */
- while ((dtype = dbus_message_iter_get_arg_type (&iter))
- != DBUS_TYPE_INVALID)
+ if ((!dbus_message_set_path (dmessage, SSDATA (path)))
+ || (!dbus_message_set_interface (dmessage, SSDATA (interface)))
+ || (!dbus_message_set_member (dmessage, SSDATA (member))))
{
- result = Fcons (xd_retrieve_arg (dtype, &iter), result);
- dbus_message_iter_next (&iter);
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
}
}
- else
- {
- /* No arguments: just return nil. */
- }
-
- /* Cleanup. */
- dbus_error_free (&derror);
- dbus_message_unref (dmessage);
- dbus_message_unref (reply);
-
- /* Return the result. If there is only one single Lisp object,
- return it as-it-is, otherwise return the reversed list. */
- if (XFASTINT (Flength (result)) == 1)
- RETURN_UNGCPRO (CAR_SAFE (result));
- else
- RETURN_UNGCPRO (Fnreverse (result));
-}
-DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
- Sdbus_call_method_asynchronously, 6, MANY, 0,
- doc: /* Call METHOD on the D-Bus BUS asynchronously.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name to be used. PATH is the D-Bus
-object path SERVICE is registered at. INTERFACE is an interface
-offered by SERVICE. It must provide METHOD.
-
-HANDLER is a Lisp function, which is called when the corresponding
-return message has arrived. If HANDLER is nil, no return message will
-be expected.
-
-If the parameter `:timeout' is given, the following integer TIMEOUT
-specifies the maximum number of milliseconds the method call must
-return. The default value is 25,000. If the method call doesn't
-return in time, a D-Bus error is raised.
-
-All other arguments ARGS are passed to METHOD as arguments. They are
-converted into D-Bus types via the following rules:
-
- t and nil => DBUS_TYPE_BOOLEAN
- number => DBUS_TYPE_UINT32
- integer => DBUS_TYPE_INT32
- float => DBUS_TYPE_DOUBLE
- string => DBUS_TYPE_STRING
- list => DBUS_TYPE_ARRAY
-
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
-
-Unless HANDLER is nil, the function returns a key into the hash table
-`dbus-registered-objects-table'. The corresponding entry in the hash
-table is removed, when the return message has been arrived, and
-HANDLER is called.
-
-Example:
-
-\(dbus-call-method-asynchronously
- :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
- "org.freedesktop.Hal.Device" "GetPropertyString" 'message
- "system.kernel.machine")
-
- => (:system 2)
-
- -| i686
-
-usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service, path, interface, method, handler;
- Lisp_Object result;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
- DBusConnection *connection;
- DBusMessage *dmessage;
- DBusMessageIter iter;
- unsigned int dtype;
- dbus_uint32_t serial;
- int timeout = -1;
- ptrdiff_t i = 6;
- char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
+ else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ {
+ if (!dbus_message_set_reply_serial (dmessage, serial))
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Unable to create a return message"));
+ }
- /* Check parameters. */
- bus = args[0];
- service = args[1];
- path = args[2];
- interface = args[3];
- method = args[4];
- handler = args[5];
-
- CHECK_STRING (service);
- CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (method);
- if (!NILP (handler) && !FUNCTIONP (handler))
- wrong_type_argument (Qinvalid_function, handler);
- GCPRO6 (bus, service, path, interface, method, handler);
-
- XD_DEBUG_MESSAGE ("%s %s %s %s",
- SDATA (service),
- SDATA (path),
- SDATA (interface),
- SDATA (method));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new_method_call (SSDATA (service),
- SSDATA (path),
- SSDATA (interface),
- SSDATA (method));
- if (dmessage == NULL)
- XD_SIGNAL1 (build_string ("Unable to create a new message"));
+ if ((mtype == DBUS_MESSAGE_TYPE_ERROR)
+ && (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)))
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Unable to create a error message"));
+ }
+ }
/* Check for timeout parameter. */
- if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
+ if ((count+2 <= nargs) && (EQ ((args[count]), QCdbus_timeout)))
{
- CHECK_NATNUM (args[i+1]);
- timeout = XFASTINT (args[i+1]);
- i = i+2;
+ CHECK_NATNUM (args[count+1]);
+ timeout = min (XFASTINT (args[count+1]), INT_MAX);
+ count = count+2;
}
/* Initialize parameter list of message. */
dbus_message_iter_init_append (dmessage, &iter);
/* Append parameters to the message. */
- for (; i < nargs; ++i)
+ for (; count < nargs; ++count)
{
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
+ dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]);
+ if (XD_DBUS_TYPE_P (args[count]))
{
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
+ XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
+ XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]);
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4,
+ XD_OBJECT_TO_STRING (args[count]),
+ XD_OBJECT_TO_STRING (args[count+1]));
+ ++count;
}
else
{
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)));
+ XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4,
+ XD_OBJECT_TO_STRING (args[count]));
}
/* Check for valid signature. We use DBUS_TYPE_INVALID as
indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
+ xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[count]);
- xd_append_arg (dtype, args[i], &iter);
+ xd_append_arg (dtype, args[count], &iter);
}
if (!NILP (handler))
@@ -1368,11 +1485,15 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
message queue. */
if (!dbus_connection_send_with_reply (connection, dmessage,
NULL, timeout))
- XD_SIGNAL1 (build_string ("Cannot send message"));
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Cannot send message"));
+ }
/* The result is the key in Vdbus_registered_objects_table. */
serial = dbus_message_get_serial (dmessage);
- result = list2 (bus, make_fixnum_or_float (serial));
+ result = list3 (QCdbus_registered_serial,
+ bus, make_fixnum_or_float (serial));
/* Create a hash table entry. */
Fputhash (result, handler, Vdbus_registered_objects_table);
@@ -1382,12 +1503,15 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
/* Send the message. The message is just added to the outgoing
message queue. */
if (!dbus_connection_send (connection, dmessage, NULL))
- XD_SIGNAL1 (build_string ("Cannot send message"));
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Cannot send message"));
+ }
result = Qnil;
}
- XD_DEBUG_MESSAGE ("Message sent");
+ XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
/* Cleanup. */
dbus_message_unref (dmessage);
@@ -1396,300 +1520,6 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
RETURN_UNGCPRO (result);
}
-DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal,
- Sdbus_method_return_internal,
- 3, MANY, 0,
- doc: /* Return for message SERIAL on the D-Bus BUS.
-This is an internal function, it shall not be used outside dbus.el.
-
-usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service;
- struct gcpro gcpro1, gcpro2;
- DBusConnection *connection;
- DBusMessage *dmessage;
- DBusMessageIter iter;
- dbus_uint32_t serial;
- unsigned int ui_serial, dtype;
- ptrdiff_t i;
- char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
-
- /* Check parameters. */
- bus = args[0];
- service = args[2];
-
- CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
- CHECK_STRING (service);
- GCPRO2 (bus, service);
-
- ui_serial = serial;
- XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
- if ((dmessage == NULL)
- || (!dbus_message_set_reply_serial (dmessage, serial))
- || (!dbus_message_set_destination (dmessage, SSDATA (service))))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to create a return message"));
- }
-
- UNGCPRO;
-
- /* Initialize parameter list of message. */
- dbus_message_iter_init_append (dmessage, &iter);
-
- /* Append parameters to the message. */
- for (i = 3; i < nargs; ++i)
- {
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
- }
- else
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
- SDATA (format2 ("%s", args[i], Qnil)));
- }
-
- /* Check for valid signature. We use DBUS_TYPE_INVALID as
- indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
-
- xd_append_arg (dtype, args[i], &iter);
- }
-
- /* Send the message. The message is just added to the outgoing
- message queue. */
- if (!dbus_connection_send (connection, dmessage, NULL))
- XD_SIGNAL1 (build_string ("Cannot send message"));
-
- XD_DEBUG_MESSAGE ("Message sent");
-
- /* Cleanup. */
- dbus_message_unref (dmessage);
-
- /* Return. */
- return Qt;
-}
-
-DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal,
- Sdbus_method_error_internal,
- 3, MANY, 0,
- doc: /* Return error message for message SERIAL on the D-Bus BUS.
-This is an internal function, it shall not be used outside dbus.el.
-
-usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service;
- struct gcpro gcpro1, gcpro2;
- DBusConnection *connection;
- DBusMessage *dmessage;
- DBusMessageIter iter;
- dbus_uint32_t serial;
- unsigned int ui_serial, dtype;
- ptrdiff_t i;
- char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
-
- /* Check parameters. */
- bus = args[0];
- service = args[2];
-
- CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
- CHECK_STRING (service);
- GCPRO2 (bus, service);
-
- ui_serial = serial;
- XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR);
- if ((dmessage == NULL)
- || (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED))
- || (!dbus_message_set_reply_serial (dmessage, serial))
- || (!dbus_message_set_destination (dmessage, SSDATA (service))))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to create a error message"));
- }
-
- UNGCPRO;
-
- /* Initialize parameter list of message. */
- dbus_message_iter_init_append (dmessage, &iter);
-
- /* Append parameters to the message. */
- for (i = 3; i < nargs; ++i)
- {
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
- }
- else
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
- SDATA (format2 ("%s", args[i], Qnil)));
- }
-
- /* Check for valid signature. We use DBUS_TYPE_INVALID as
- indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
-
- xd_append_arg (dtype, args[i], &iter);
- }
-
- /* Send the message. The message is just added to the outgoing
- message queue. */
- if (!dbus_connection_send (connection, dmessage, NULL))
- XD_SIGNAL1 (build_string ("Cannot send message"));
-
- XD_DEBUG_MESSAGE ("Message sent");
-
- /* Cleanup. */
- dbus_message_unref (dmessage);
-
- /* Return. */
- return Qt;
-}
-
-DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0,
- doc: /* Send signal SIGNAL on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the
-D-Bus object path SERVICE is registered at. INTERFACE is an interface
-offered by SERVICE. It must provide signal SIGNAL.
-
-All other arguments ARGS are passed to SIGNAL as arguments. They are
-converted into D-Bus types via the following rules:
-
- t and nil => DBUS_TYPE_BOOLEAN
- number => DBUS_TYPE_UINT32
- integer => DBUS_TYPE_INT32
- float => DBUS_TYPE_DOUBLE
- string => DBUS_TYPE_STRING
- list => DBUS_TYPE_ARRAY
-
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
-
-Example:
-
-\(dbus-send-signal
- :session "org.gnu.Emacs" "/org/gnu/Emacs"
- "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
-
-usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service, path, interface, signal;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- DBusConnection *connection;
- DBusMessage *dmessage;
- DBusMessageIter iter;
- unsigned int dtype;
- ptrdiff_t i;
- char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
-
- /* Check parameters. */
- bus = args[0];
- service = args[1];
- path = args[2];
- interface = args[3];
- signal = args[4];
-
- CHECK_STRING (service);
- CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (signal);
- GCPRO5 (bus, service, path, interface, signal);
-
- XD_DEBUG_MESSAGE ("%s %s %s %s",
- SDATA (service),
- SDATA (path),
- SDATA (interface),
- SDATA (signal));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new_signal (SSDATA (path),
- SSDATA (interface),
- SSDATA (signal));
- UNGCPRO;
- if (dmessage == NULL)
- XD_SIGNAL1 (build_string ("Unable to create a new message"));
-
- /* Initialize parameter list of message. */
- dbus_message_iter_init_append (dmessage, &iter);
-
- /* Append parameters to the message. */
- for (i = 5; i < nargs; ++i)
- {
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
- }
- else
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)));
- }
-
- /* Check for valid signature. We use DBUS_TYPE_INVALID as
- indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
-
- xd_append_arg (dtype, args[i], &iter);
- }
-
- /* Send the message. The message is just added to the outgoing
- message queue. */
- if (!dbus_connection_send (connection, dmessage, NULL))
- XD_SIGNAL1 (build_string ("Cannot send message"));
-
- XD_DEBUG_MESSAGE ("Signal sent");
-
- /* Cleanup. */
- dbus_message_unref (dmessage);
-
- /* Return. */
- return Qt;
-}
-
/* Read one queued incoming message of the D-Bus BUS.
BUS is either a Lisp symbol, :system or :session, or a string denoting
the bus address. */
@@ -1701,7 +1531,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
struct input_event event;
DBusMessage *dmessage;
DBusMessageIter iter;
- unsigned int dtype;
+ int dtype;
int mtype;
dbus_uint32_t serial;
unsigned int ui_serial;
@@ -1744,23 +1574,19 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
member = dbus_message_get_member (dmessage);
XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
- (mtype == DBUS_MESSAGE_TYPE_INVALID)
- ? "DBUS_MESSAGE_TYPE_INVALID"
- : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
- ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
- : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
- ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
- : (mtype == DBUS_MESSAGE_TYPE_ERROR)
- ? "DBUS_MESSAGE_TYPE_ERROR"
- : "DBUS_MESSAGE_TYPE_SIGNAL",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
ui_serial, uname, path, interface, member,
- SDATA (format2 ("%s", args, Qnil)));
+ XD_OBJECT_TO_STRING (args));
- if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
- || (mtype == DBUS_MESSAGE_TYPE_ERROR))
+ if (mtype == DBUS_MESSAGE_TYPE_INVALID)
+ goto cleanup;
+
+ else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
+ || (mtype == DBUS_MESSAGE_TYPE_ERROR))
{
/* Search for a registered function of the message. */
- key = list2 (bus, make_fixnum_or_float (serial));
+ key = list3 (QCdbus_registered_serial, bus,
+ make_fixnum_or_float (serial));
value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
/* There shall be exactly one entry. Construct an event. */
@@ -1777,7 +1603,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
event.arg = Fcons (value, args);
}
- else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */
+ else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
{
/* Vdbus_registered_objects_table requires non-nil interface and
member. */
@@ -1785,7 +1611,10 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
goto cleanup;
/* Search for a registered function of the message. */
- key = list3 (bus, build_string (interface), build_string (member));
+ key = list4 ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ ? QCdbus_registered_method
+ : QCdbus_registered_signal,
+ bus, build_string (interface), build_string (member));
value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
/* Loop over the registered functions. Construct an event. */
@@ -1835,8 +1664,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
/* Store it into the input event queue. */
kbd_buffer_store_event (&event);
- XD_DEBUG_MESSAGE ("Event stored: %s",
- SDATA (format2 ("%s", event.arg, Qnil)));
+ XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg));
/* Cleanup. */
cleanup:
@@ -1851,8 +1679,8 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
static Lisp_Object
xd_read_message (Lisp_Object bus)
{
- /* Open a connection to the bus. */
- DBusConnection *connection = xd_initialize (bus, TRUE);
+ /* Retrieve bus address. */
+ DBusConnection *connection = xd_get_connection_address (bus);
/* Non blocking read of the next available message. */
dbus_connection_read_write (connection, 0);
@@ -1865,18 +1693,20 @@ xd_read_message (Lisp_Object bus)
/* Callback called when something is ready to read or write. */
static void
-xd_read_queued_messages (int fd, void *data, int for_read)
+xd_read_queued_messages (int fd, void *data)
{
- Lisp_Object busp = Vdbus_registered_buses;
+ Lisp_Object busp = xd_registered_buses;
Lisp_Object bus = Qnil;
+ Lisp_Object key;
/* Find bus related to fd. */
if (data != NULL)
while (!NILP (busp))
{
- if ((SYMBOLP (CAR_SAFE (busp)) && XSYMBOL (CAR_SAFE (busp)) == data)
- || (STRINGP (CAR_SAFE (busp)) && XSTRING (CAR_SAFE (busp)) == data))
- bus = CAR_SAFE (busp);
+ key = CAR_SAFE (CAR_SAFE (busp));
+ if ((SYMBOLP (key) && XSYMBOL (key) == data)
+ || (STRINGP (key) && XSTRING (key) == data))
+ bus = key;
busp = CDR_SAFE (busp);
}
@@ -1889,324 +1719,6 @@ xd_read_queued_messages (int fd, void *data, int for_read)
xd_in_read_queued_messages = 0;
}
-DEFUN ("dbus-register-service", Fdbus_register_service, Sdbus_register_service,
- 2, MANY, 0,
- doc: /* Register known name SERVICE on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name that should be registered. It must
-be a known name.
-
-FLAGS are keywords, which control how the service name is registered.
-The following keywords are recognized:
-
-`:allow-replacement': Allow another service to become the primary
-owner if requested.
-
-`:replace-existing': Request to replace the current primary owner.
-
-`:do-not-queue': If we can not become the primary owner do not place
-us in the queue.
-
-The function returns a keyword, indicating the result of the
-operation. One of the following keywords is returned:
-
-`:primary-owner': Service has become the primary owner of the
-requested name.
-
-`:in-queue': Service could not become the primary owner and has been
-placed in the queue.
-
-`:exists': Service is already in the queue.
-
-`:already-owner': Service is already the primary owner.
-
-Example:
-
-\(dbus-register-service :session dbus-service-emacs)
-
- => :primary-owner.
-
-\(dbus-register-service
- :session "org.freedesktop.TextEditor"
- dbus-service-allow-replacement dbus-service-replace-existing)
-
- => :already-owner.
-
-usage: (dbus-register-service BUS SERVICE &rest FLAGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service;
- DBusConnection *connection;
- ptrdiff_t i;
- unsigned int value;
- unsigned int flags = 0;
- int result;
- DBusError derror;
-
- bus = args[0];
- service = args[1];
-
- /* Check parameters. */
- CHECK_STRING (service);
-
- /* Process flags. */
- for (i = 2; i < nargs; ++i) {
- value = ((EQ (args[i], QCdbus_request_name_replace_existing))
- ? DBUS_NAME_FLAG_REPLACE_EXISTING
- : (EQ (args[i], QCdbus_request_name_allow_replacement))
- ? DBUS_NAME_FLAG_ALLOW_REPLACEMENT
- : (EQ (args[i], QCdbus_request_name_do_not_queue))
- ? DBUS_NAME_FLAG_DO_NOT_QUEUE
- : -1);
- if (value == -1)
- XD_SIGNAL2 (build_string ("Unrecognized name request flag"), args[i]);
- flags |= value;
- }
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Request the known name from the bus. */
- dbus_error_init (&derror);
- result = dbus_bus_request_name (connection, SSDATA (service), flags,
- &derror);
- if (dbus_error_is_set (&derror))
- XD_ERROR (derror);
-
- /* Cleanup. */
- dbus_error_free (&derror);
-
- /* Return object. */
- switch (result)
- {
- case DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER:
- return QCdbus_request_name_reply_primary_owner;
- case DBUS_REQUEST_NAME_REPLY_IN_QUEUE:
- return QCdbus_request_name_reply_in_queue;
- case DBUS_REQUEST_NAME_REPLY_EXISTS:
- return QCdbus_request_name_reply_exists;
- case DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER:
- return QCdbus_request_name_reply_already_owner;
- default:
- /* This should not happen. */
- XD_SIGNAL2 (build_string ("Could not register service"), service);
- }
-}
-
-DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
- 6, MANY, 0,
- doc: /* Register for signal SIGNAL on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name used by the sending D-Bus object.
-It can be either a known name or the unique name of the D-Bus object
-sending the signal. When SERVICE is nil, related signals from all
-D-Bus objects shall be accepted.
-
-PATH is the D-Bus object path SERVICE is registered. It can also be
-nil if the path name of incoming signals shall not be checked.
-
-INTERFACE is an interface offered by SERVICE. It must provide SIGNAL.
-HANDLER is a Lisp function to be called when the signal is received.
-It must accept as arguments the values SIGNAL is sending.
-
-All other arguments ARGS, if specified, must be strings. They stand
-for the respective arguments of the signal in their order, and are
-used for filtering as well. A nil argument might be used to preserve
-the order.
-
-INTERFACE, SIGNAL and HANDLER must not be nil. Example:
-
-\(defun my-signal-handler (device)
- (message "Device %s added" device))
-
-\(dbus-register-signal
- :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
- "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
-
- => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
- ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
-
-`dbus-register-signal' returns an object, which can be used in
-`dbus-unregister-object' for removing the registration.
-
-usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service, path, interface, signal, handler;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
- Lisp_Object uname, key, key1, value;
- DBusConnection *connection;
- ptrdiff_t i;
- char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
- int rulelen;
- DBusError derror;
-
- /* Check parameters. */
- bus = args[0];
- service = args[1];
- path = args[2];
- interface = args[3];
- signal = args[4];
- handler = args[5];
-
- if (!NILP (service)) CHECK_STRING (service);
- if (!NILP (path)) CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (signal);
- if (!FUNCTIONP (handler))
- wrong_type_argument (Qinvalid_function, handler);
- GCPRO6 (bus, service, path, interface, signal, handler);
-
- /* Retrieve unique name of service. If service is a known name, we
- will register for the corresponding unique name, if any. Signals
- are sent always with the unique name as sender. Note: the unique
- name of "org.freedesktop.DBus" is that string itself. */
- if ((STRINGP (service))
- && (SBYTES (service) > 0)
- && (strcmp (SSDATA (service), DBUS_SERVICE_DBUS) != 0)
- && (strncmp (SSDATA (service), ":", 1) != 0))
- uname = call2 (intern ("dbus-get-name-owner"), bus, service);
- else
- uname = service;
-
- /* Create a matching rule if the unique name exists (when no
- wildcard). */
- if (NILP (uname) || (SBYTES (uname) > 0))
- {
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create a rule to receive related signals. */
- rulelen = snprintf (rule, sizeof rule,
- "type='signal',interface='%s',member='%s'",
- SDATA (interface),
- SDATA (signal));
- if (! (0 <= rulelen && rulelen < sizeof rule))
- string_overflow ();
-
- /* Add unique name and path to the rule if they are non-nil. */
- if (!NILP (uname))
- {
- int len = snprintf (rule + rulelen, sizeof rule - rulelen,
- ",sender='%s'", SDATA (uname));
- if (! (0 <= len && len < sizeof rule - rulelen))
- string_overflow ();
- rulelen += len;
- }
-
- if (!NILP (path))
- {
- int len = snprintf (rule + rulelen, sizeof rule - rulelen,
- ",path='%s'", SDATA (path));
- if (! (0 <= len && len < sizeof rule - rulelen))
- string_overflow ();
- rulelen += len;
- }
-
- /* Add arguments to the rule if they are non-nil. */
- for (i = 6; i < nargs; ++i)
- if (!NILP (args[i]))
- {
- int len;
- CHECK_STRING (args[i]);
- len = snprintf (rule + rulelen, sizeof rule - rulelen,
- ",arg%"pD"d='%s'", i - 6, SDATA (args[i]));
- if (! (0 <= len && len < sizeof rule - rulelen))
- string_overflow ();
- rulelen += len;
- }
-
- /* Add the rule to the bus. */
- dbus_error_init (&derror);
- dbus_bus_add_match (connection, rule, &derror);
- if (dbus_error_is_set (&derror))
- {
- UNGCPRO;
- XD_ERROR (derror);
- }
-
- /* Cleanup. */
- dbus_error_free (&derror);
-
- XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
- }
-
- /* Create a hash table entry. */
- key = list3 (bus, interface, signal);
- key1 = list5 (uname, service, path, handler, build_string (rule));
- value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
-
- if (NILP (Fmember (key1, value)))
- Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
-
- /* Return object. */
- RETURN_UNGCPRO (list2 (key, list3 (service, path, handler)));
-}
-
-DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
- 6, 7, 0,
- doc: /* Register for method METHOD on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name of the D-Bus object METHOD is
-registered for. It must be a known name (See discussion of
-DONT-REGISTER-SERVICE below).
-
-PATH is the D-Bus object path SERVICE is registered (See discussion of
-DONT-REGISTER-SERVICE below). INTERFACE is the interface offered by
-SERVICE. It must provide METHOD. HANDLER is a Lisp function to be
-called when a method call is received. It must accept the input
-arguments of METHOD. The return value of HANDLER is used for
-composing the returning D-Bus message.
-
-When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
-registered. This means that other D-Bus clients have no way of
-noticing the newly registered method. When interfaces are constructed
-incrementally by adding single methods or properties at a time,
-DONT-REGISTER-SERVICE can be used to prevent other clients from
-discovering the still incomplete interface.*/)
- (Lisp_Object bus, Lisp_Object service, Lisp_Object path,
- Lisp_Object interface, Lisp_Object method, Lisp_Object handler,
- Lisp_Object dont_register_service)
-{
- Lisp_Object key, key1, value;
- Lisp_Object args[2] = { bus, service };
-
- /* Check parameters. */
- CHECK_STRING (service);
- CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (method);
- if (!FUNCTIONP (handler))
- wrong_type_argument (Qinvalid_function, handler);
- /* TODO: We must check for a valid service name, otherwise there is
- a segmentation fault. */
-
- /* Request the name. */
- if (NILP (dont_register_service))
- Fdbus_register_service (2, args);
-
- /* Create a hash table entry. We use nil for the unique name,
- because the method might be called from anybody. */
- key = list3 (bus, interface, method);
- key1 = list4 (Qnil, service, path, handler);
- value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
-
- if (NILP (Fmember (key1, value)))
- Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
-
- /* Return object. */
- return list2 (key, list3 (service, path, handler));
-}
-
void
syms_of_dbusbind (void)
@@ -2215,51 +1727,20 @@ syms_of_dbusbind (void)
DEFSYM (Qdbus_init_bus, "dbus-init-bus");
defsubr (&Sdbus_init_bus);
- DEFSYM (Qdbus_close_bus, "dbus-close-bus");
- defsubr (&Sdbus_close_bus);
-
DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
defsubr (&Sdbus_get_unique_name);
- DEFSYM (Qdbus_call_method, "dbus-call-method");
- defsubr (&Sdbus_call_method);
-
- DEFSYM (Qdbus_call_method_asynchronously, "dbus-call-method-asynchronously");
- defsubr (&Sdbus_call_method_asynchronously);
-
- DEFSYM (Qdbus_method_return_internal, "dbus-method-return-internal");
- defsubr (&Sdbus_method_return_internal);
-
- DEFSYM (Qdbus_method_error_internal, "dbus-method-error-internal");
- defsubr (&Sdbus_method_error_internal);
-
- DEFSYM (Qdbus_send_signal, "dbus-send-signal");
- defsubr (&Sdbus_send_signal);
-
- DEFSYM (Qdbus_register_service, "dbus-register-service");
- defsubr (&Sdbus_register_service);
-
- DEFSYM (Qdbus_register_signal, "dbus-register-signal");
- defsubr (&Sdbus_register_signal);
-
- DEFSYM (Qdbus_register_method, "dbus-register-method");
- defsubr (&Sdbus_register_method);
+ DEFSYM (Qdbus_message_internal, "dbus-message-internal");
+ defsubr (&Sdbus_message_internal);
DEFSYM (Qdbus_error, "dbus-error");
Fput (Qdbus_error, Qerror_conditions,
list2 (Qdbus_error, Qerror));
Fput (Qdbus_error, Qerror_message,
- make_pure_c_string ("D-Bus error"));
+ build_pure_c_string ("D-Bus error"));
DEFSYM (QCdbus_system_bus, ":system");
DEFSYM (QCdbus_session_bus, ":session");
- DEFSYM (QCdbus_request_name_allow_replacement, ":allow-replacement");
- DEFSYM (QCdbus_request_name_replace_existing, ":replace-existing");
- DEFSYM (QCdbus_request_name_do_not_queue, ":do-not-queue");
- DEFSYM (QCdbus_request_name_reply_primary_owner, ":primary-owner");
- DEFSYM (QCdbus_request_name_reply_exists, ":exists");
- DEFSYM (QCdbus_request_name_reply_in_queue, ":in-queue");
- DEFSYM (QCdbus_request_name_reply_already_owner, ":already-owner");
DEFSYM (QCdbus_timeout, ":timeout");
DEFSYM (QCdbus_type_byte, ":byte");
DEFSYM (QCdbus_type_boolean, ":boolean");
@@ -2273,20 +1754,66 @@ syms_of_dbusbind (void)
DEFSYM (QCdbus_type_string, ":string");
DEFSYM (QCdbus_type_object_path, ":object-path");
DEFSYM (QCdbus_type_signature, ":signature");
-
#ifdef DBUS_TYPE_UNIX_FD
DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
#endif
-
DEFSYM (QCdbus_type_array, ":array");
DEFSYM (QCdbus_type_variant, ":variant");
DEFSYM (QCdbus_type_struct, ":struct");
DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
+ DEFSYM (QCdbus_registered_serial, ":serial");
+ DEFSYM (QCdbus_registered_method, ":method");
+ DEFSYM (QCdbus_registered_signal, ":signal");
+
+ DEFVAR_LISP ("dbus-compiled-version",
+ Vdbus_compiled_version,
+ doc: /* The version of D-Bus Emacs is compiled against. */);
+#ifdef DBUS_VERSION_STRING
+ Vdbus_compiled_version = build_pure_c_string (DBUS_VERSION_STRING);
+#else
+ Vdbus_compiled_version = Qnil;
+#endif
+
+ DEFVAR_LISP ("dbus-runtime-version",
+ Vdbus_runtime_version,
+ doc: /* The version of D-Bus Emacs runs with. */);
+ {
+#ifdef DBUS_VERSION
+ int major, minor, micro;
+ char s[sizeof ".." + 3 * INT_STRLEN_BOUND (int)];
+ dbus_get_version (&major, &minor, &micro);
+ Vdbus_runtime_version
+ = make_formatted_string (s, "%d.%d.%d", major, minor, micro);
+#else
+ Vdbus_runtime_version = Qnil;
+#endif
+ }
+
+ DEFVAR_LISP ("dbus-message-type-invalid",
+ Vdbus_message_type_invalid,
+ doc: /* This value is never a valid message type. */);
+ Vdbus_message_type_invalid = make_number (DBUS_MESSAGE_TYPE_INVALID);
- DEFVAR_LISP ("dbus-registered-buses",
- Vdbus_registered_buses,
- doc: /* List of D-Bus buses we are polling for messages. */);
- Vdbus_registered_buses = Qnil;
+ DEFVAR_LISP ("dbus-message-type-method-call",
+ Vdbus_message_type_method_call,
+ doc: /* Message type of a method call message. */);
+ Vdbus_message_type_method_call = make_number (DBUS_MESSAGE_TYPE_METHOD_CALL);
+
+ DEFVAR_LISP ("dbus-message-type-method-return",
+ Vdbus_message_type_method_return,
+ doc: /* Message type of a method return message. */);
+ Vdbus_message_type_method_return
+ = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN);
+
+ DEFVAR_LISP ("dbus-message-type-error",
+ Vdbus_message_type_error,
+ doc: /* Message type of an error reply message. */);
+ Vdbus_message_type_error = make_number (DBUS_MESSAGE_TYPE_ERROR);
+
+ DEFVAR_LISP ("dbus-message-type-signal",
+ Vdbus_message_type_signal,
+ doc: /* Message type of a signal message. */);
+ Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL);
DEFVAR_LISP ("dbus-registered-objects-table",
Vdbus_registered_objects_table,
@@ -2296,27 +1823,28 @@ There are two different uses of the hash table: for accessing
registered interfaces properties, targeted by signals or method calls,
and for calling handlers in case of non-blocking method call returns.
-In the first case, the key in the hash table is the list (BUS
-INTERFACE MEMBER). BUS is either a Lisp symbol, `:system' or
+In the first case, the key in the hash table is the list (TYPE BUS
+INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
+`:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
`:session', or a string denoting the bus address. INTERFACE is a
string which denotes a D-Bus interface, and MEMBER, also a string, is
either a method, a signal or a property INTERFACE is offering. All
arguments but BUS must not be nil.
-The value in the hash table is a list of quadruple lists
-\((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...).
-SERVICE is the service name as registered, UNAME is the corresponding
-unique name. In case of registered methods and properties, UNAME is
-nil. PATH is the object path of the sending object. All of them can
-be nil, which means a wildcard then. OBJECT is either the handler to
-be called when a D-Bus message, which matches the key criteria,
-arrives (methods and signals), or a cons cell containing the value of
-the property.
+The value in the hash table is a list of quadruple lists \((UNAME
+SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
+registered, UNAME is the corresponding unique name. In case of
+registered methods and properties, UNAME is nil. PATH is the object
+path of the sending object. All of them can be nil, which means a
+wildcard then. OBJECT is either the handler to be called when a D-Bus
+message, which matches the key criteria, arrives (TYPE `:method' and
+`:signal'), or a cons cell containing the value of the property (TYPE
+`:property').
-For signals, there is also a fifth element RULE, which keeps the match
-string the signal is registered with.
+For entries of type `:signal', there is also a fifth element RULE,
+which keeps the match string the signal is registered with.
-In the second case, the key in the hash table is the list (BUS
+In the second case, the key in the hash table is the list (:serial BUS
SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
string denoting the bus address. SERIAL is the serial number of the
non-blocking method call, a reply is expected. Both arguments must
@@ -2340,6 +1868,10 @@ be called when the D-Bus reply message arrives. */);
Vdbus_debug = Qnil;
#endif
+ /* Initialize internal objects. */
+ xd_registered_buses = Qnil;
+ staticpro (&xd_registered_buses);
+
Fprovide (intern_c_string ("dbusbind"), Qnil);
}
diff --git a/src/deps.mk b/src/deps.mk
index c61b01a95c4..c7316a24dad 100644
--- a/src/deps.mk
+++ b/src/deps.mk
@@ -1,6 +1,6 @@
### deps.mk --- src/Makefile fragment for GNU Emacs
-## Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2011
+## Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2012
## Free Software Foundation, Inc.
## This file is part of GNU Emacs.
diff --git a/src/dired.c b/src/dired.c
index 2b5f3b40641..3530b74ecb4 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -1,5 +1,5 @@
/* Lisp functions for making directory listings.
- Copyright (C) 1985-1986, 1993-1994, 1999-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 1993-1994, 1999-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -22,7 +22,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
-#include <setjmp.h>
#ifdef HAVE_PWD_H
#include <pwd.h>
@@ -32,48 +31,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <errno.h>
#include <unistd.h>
-/* The d_nameln member of a struct dirent includes the '\0' character
- on some systems, but not on others. What's worse, you can't tell
- at compile-time which one it will be, since it really depends on
- the sort of system providing the filesystem you're reading from,
- not the system you are running on. Paul Eggert
- <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
- SunOS 4.1.2 host, reading a directory that is remote-mounted from a
- Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
-
- Since applying strlen to the name always works, we'll just do that. */
-#define NAMLEN(p) strlen (p->d_name)
-
-#ifdef HAVE_DIRENT_H
-
#include <dirent.h>
-#define DIRENTRY struct dirent
-
-#else /* not HAVE_DIRENT_H */
-
-#include <sys/dir.h>
-#include <sys/stat.h>
-
-#define DIRENTRY struct direct
-
-extern DIR *opendir (char *);
-extern struct direct *readdir (DIR *);
-
-#endif /* HAVE_DIRENT_H */
-
#include <filemode.h>
-
-#ifdef MSDOS
-#define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
-#else
-#define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
-#endif
+#include <stat-time.h>
#include "lisp.h"
#include "systime.h"
+#include "character.h"
#include "buffer.h"
#include "commands.h"
-#include "character.h"
#include "charset.h"
#include "coding.h"
#include "regex.h"
@@ -86,9 +52,19 @@ static Lisp_Object Qfile_name_all_completions;
static Lisp_Object Qfile_attributes;
static Lisp_Object Qfile_attributes_lessp;
-static int scmp (const char *, const char *, int);
-static Lisp_Object Ffile_attributes (Lisp_Object, Lisp_Object);
+static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
+/* Return the number of bytes in DP's name. */
+static ptrdiff_t
+dirent_namelen (struct dirent *dp)
+{
+#ifdef _D_EXACT_NAMLEN
+ return _D_EXACT_NAMLEN (dp);
+#else
+ return strlen (dp->d_name);
+#endif
+}
+
#ifdef WINDOWSNT
Lisp_Object
directory_files_internal_w32_unwind (Lisp_Object arg)
@@ -102,28 +78,30 @@ static Lisp_Object
directory_files_internal_unwind (Lisp_Object dh)
{
DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer;
- BLOCK_INPUT;
+ block_input ();
closedir (d);
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
/* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
- When ATTRS is zero, return a list of directory filenames; when
- non-zero, return a list of directory filenames and their attributes.
+ If not ATTRS, return a list of directory filenames;
+ if ATTRS, return a list of directory filenames and their attributes.
In the latter case, ID_FORMAT is passed to Ffile_attributes. */
Lisp_Object
-directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, int attrs, Lisp_Object id_format)
+directory_files_internal (Lisp_Object directory, Lisp_Object full,
+ Lisp_Object match, Lisp_Object nosort, bool attrs,
+ Lisp_Object id_format)
{
DIR *d;
- int directory_nbytes;
+ ptrdiff_t directory_nbytes;
Lisp_Object list, dirfilename, encoded_directory;
struct re_pattern_buffer *bufp = NULL;
- int needsep = 0;
- int count = SPECPDL_INDEX ();
+ bool needsep = 0;
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- DIRENTRY *dp;
+ struct dirent *dp;
#ifdef WINDOWSNT
Lisp_Object w32_save = Qnil;
#endif
@@ -163,9 +141,9 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object m
/* Now *bufp is the compiled form of MATCH; don't call anything
which might compile a new regexp until we're done with the loop! */
- BLOCK_INPUT;
+ block_input ();
d = opendir (SSDATA (dirfilename));
- UNBLOCK_INPUT;
+ unblock_input ();
if (d == NULL)
report_file_error ("Opening directory", Fcons (directory, Qnil));
@@ -208,6 +186,11 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object m
/* Loop reading blocks until EOF or error. */
for (;;)
{
+ ptrdiff_t len;
+ bool wanted = 0;
+ Lisp_Object name, finalname;
+ struct gcpro gcpro1, gcpro2;
+
errno = 0;
dp = readdir (d);
@@ -224,94 +207,86 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object m
if (dp == NULL)
break;
- if (DIRENTRY_NONEMPTY (dp))
+ len = dirent_namelen (dp);
+ name = finalname = make_unibyte_string (dp->d_name, len);
+ GCPRO2 (finalname, name);
+
+ /* Note: DECODE_FILE can GC; it should protect its argument,
+ though. */
+ name = DECODE_FILE (name);
+ len = SBYTES (name);
+
+ /* Now that we have unwind_protect in place, we might as well
+ allow matching to be interrupted. */
+ immediate_quit = 1;
+ QUIT;
+
+ if (NILP (match)
+ || (0 <= re_search (bufp, SSDATA (name), len, 0, len, 0)))
+ wanted = 1;
+
+ immediate_quit = 0;
+
+ if (wanted)
{
- int len;
- int wanted = 0;
- Lisp_Object name, finalname;
- struct gcpro gcpro1, gcpro2;
+ if (!NILP (full))
+ {
+ Lisp_Object fullname;
+ ptrdiff_t nbytes = len + directory_nbytes + needsep;
+ ptrdiff_t nchars;
- len = NAMLEN (dp);
- name = finalname = make_unibyte_string (dp->d_name, len);
- GCPRO2 (finalname, name);
+ fullname = make_uninit_multibyte_string (nbytes, nbytes);
+ memcpy (SDATA (fullname), SDATA (directory),
+ directory_nbytes);
- /* Note: DECODE_FILE can GC; it should protect its argument,
- though. */
- name = DECODE_FILE (name);
- len = SBYTES (name);
+ if (needsep)
+ SSET (fullname, directory_nbytes, DIRECTORY_SEP);
- /* Now that we have unwind_protect in place, we might as well
- allow matching to be interrupted. */
- immediate_quit = 1;
- QUIT;
+ memcpy (SDATA (fullname) + directory_nbytes + needsep,
+ SDATA (name), len);
- if (NILP (match)
- || (0 <= re_search (bufp, SSDATA (name), len, 0, len, 0)))
- wanted = 1;
+ nchars = chars_in_text (SDATA (fullname), nbytes);
- immediate_quit = 0;
+ /* Some bug somewhere. */
+ if (nchars > nbytes)
+ emacs_abort ();
- if (wanted)
- {
- if (!NILP (full))
- {
- Lisp_Object fullname;
- int nbytes = len + directory_nbytes + needsep;
- int nchars;
-
- fullname = make_uninit_multibyte_string (nbytes, nbytes);
- memcpy (SDATA (fullname), SDATA (directory),
- directory_nbytes);
-
- if (needsep)
- SSET (fullname, directory_nbytes, DIRECTORY_SEP);
-
- memcpy (SDATA (fullname) + directory_nbytes + needsep,
- SDATA (name), len);
-
- nchars = chars_in_text (SDATA (fullname), nbytes);
-
- /* Some bug somewhere. */
- if (nchars > nbytes)
- abort ();
-
- STRING_SET_CHARS (fullname, nchars);
- if (nchars == nbytes)
- STRING_SET_UNIBYTE (fullname);
-
- finalname = fullname;
- }
- else
- finalname = name;
-
- if (attrs)
- {
- /* Construct an expanded filename for the directory entry.
- Use the decoded names for input to Ffile_attributes. */
- Lisp_Object decoded_fullname, fileattrs;
- struct gcpro gcpro1, gcpro2;
-
- decoded_fullname = fileattrs = Qnil;
- GCPRO2 (decoded_fullname, fileattrs);
-
- /* Both Fexpand_file_name and Ffile_attributes can GC. */
- decoded_fullname = Fexpand_file_name (name, directory);
- fileattrs = Ffile_attributes (decoded_fullname, id_format);
-
- list = Fcons (Fcons (finalname, fileattrs), list);
- UNGCPRO;
- }
- else
- list = Fcons (finalname, list);
+ STRING_SET_CHARS (fullname, nchars);
+ if (nchars == nbytes)
+ STRING_SET_UNIBYTE (fullname);
+
+ finalname = fullname;
}
+ else
+ finalname = name;
- UNGCPRO;
+ if (attrs)
+ {
+ /* Construct an expanded filename for the directory entry.
+ Use the decoded names for input to Ffile_attributes. */
+ Lisp_Object decoded_fullname, fileattrs;
+ struct gcpro gcpro1, gcpro2;
+
+ decoded_fullname = fileattrs = Qnil;
+ GCPRO2 (decoded_fullname, fileattrs);
+
+ /* Both Fexpand_file_name and Ffile_attributes can GC. */
+ decoded_fullname = Fexpand_file_name (name, directory);
+ fileattrs = Ffile_attributes (decoded_fullname, id_format);
+
+ list = Fcons (Fcons (finalname, fileattrs), list);
+ UNGCPRO;
+ }
+ else
+ list = Fcons (finalname, list);
}
+
+ UNGCPRO;
}
- BLOCK_INPUT;
+ block_input ();
closedir (d);
- UNBLOCK_INPUT;
+ unblock_input ();
#ifdef WINDOWSNT
if (attrs)
Vw32_get_true_file_attributes = w32_save;
@@ -381,9 +356,8 @@ which see. */)
}
-static Lisp_Object file_name_completion
- (Lisp_Object file, Lisp_Object dirname, int all_flag, int ver_flag,
- Lisp_Object predicate);
+static Lisp_Object file_name_completion (Lisp_Object, Lisp_Object, bool,
+ Lisp_Object);
DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
2, 3, 0,
@@ -415,7 +389,7 @@ determined by the variable `completion-ignored-extensions', which see. */)
if (!NILP (handler))
return call4 (handler, Qfile_name_completion, file, directory, predicate);
- return file_name_completion (file, directory, 0, 0, predicate);
+ return file_name_completion (file, directory, 0, predicate);
}
DEFUN ("file-name-all-completions", Ffile_name_all_completions,
@@ -439,17 +413,19 @@ These are all file names in directory DIRECTORY which begin with FILE. */)
if (!NILP (handler))
return call3 (handler, Qfile_name_all_completions, file, directory);
- return file_name_completion (file, directory, 1, 0, Qnil);
+ return file_name_completion (file, directory, 1, Qnil);
}
-static int file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr);
+static int file_name_completion_stat (Lisp_Object dirname, struct dirent *dp,
+ struct stat *st_addr);
static Lisp_Object Qdefault_directory;
static Lisp_Object
-file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int ver_flag, Lisp_Object predicate)
+file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
+ Lisp_Object predicate)
{
DIR *d;
- int bestmatchsize = 0;
+ ptrdiff_t bestmatchsize = 0;
int matchcount = 0;
/* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
If ALL_FLAG is 0, BESTMATCH is either nil
@@ -458,21 +434,18 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v
Lisp_Object encoded_file;
Lisp_Object encoded_dir;
struct stat st;
- int directoryp;
- /* If includeall is zero, exclude files in completion-ignored-extensions as
+ bool directoryp;
+ /* If not INCLUDEALL, exclude files in completion-ignored-extensions as
well as "." and "..". Until shown otherwise, assume we can't exclude
anything. */
- int includeall = 1;
- int count = SPECPDL_INDEX ();
+ bool includeall = 1;
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
elt = Qnil;
CHECK_STRING (file);
-#ifdef FILE_SYSTEM_CASE
- file = FILE_SYSTEM_CASE (file);
-#endif
bestmatch = Qnil;
encoded_file = encoded_dir = Qnil;
GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
@@ -488,9 +461,9 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v
encoded_dir = ENCODE_FILE (dirname);
- BLOCK_INPUT;
+ block_input ();
d = opendir (SSDATA (Fdirectory_file_name (encoded_dir)));
- UNBLOCK_INPUT;
+ unblock_input ();
if (!d)
report_file_error ("Opening directory", Fcons (dirname, Qnil));
@@ -501,9 +474,9 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v
/* (att3b compiler bug requires do a null comparison this way) */
while (1)
{
- DIRENTRY *dp;
- int len;
- int canexclude = 0;
+ struct dirent *dp;
+ ptrdiff_t len;
+ bool canexclude = 0;
errno = 0;
dp = readdir (d);
@@ -519,11 +492,10 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v
if (!dp) break;
- len = NAMLEN (dp);
+ len = dirent_namelen (dp);
QUIT;
- if (! DIRENTRY_NONEMPTY (dp)
- || len < SCHARS (encoded_file)
+ if (len < SCHARS (encoded_file)
|| 0 <= scmp (dp->d_name, SSDATA (encoded_file),
SCHARS (encoded_file)))
continue;
@@ -531,14 +503,14 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v
if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
continue;
- directoryp = S_ISDIR (st.st_mode);
+ directoryp = S_ISDIR (st.st_mode) != 0;
tem = Qnil;
/* If all_flag is set, always include all.
It would not actually be helpful to the user to ignore any possible
completions when making a list of them. */
if (!all_flag)
{
- int skip;
+ ptrdiff_t skip;
#if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
/* If this entry matches the current bestmatch, the only
@@ -568,7 +540,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v
for (tem = Vcompletion_ignored_extensions;
CONSP (tem); tem = XCDR (tem))
{
- int elt_len;
+ ptrdiff_t elt_len;
char *p1;
elt = XCAR (tem);
@@ -685,7 +657,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v
/* Suitably record this match. */
- matchcount++;
+ matchcount += matchcount <= 1;
if (all_flag)
bestmatch = Fcons (name, bestmatch);
@@ -698,14 +670,14 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v
{
Lisp_Object zero = make_number (0);
/* FIXME: This is a copy of the code in Ftry_completion. */
- int compare = min (bestmatchsize, SCHARS (name));
+ ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
Lisp_Object cmp
= Fcompare_strings (bestmatch, zero,
make_number (compare),
name, zero,
make_number (compare),
completion_ignore_case ? Qt : Qnil);
- int matchsize
+ ptrdiff_t matchsize
= (EQ (cmp, Qt) ? compare
: XINT (cmp) < 0 ? - XINT (cmp) - 1
: XINT (cmp) - 1);
@@ -719,7 +691,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v
/* This tests that the current file is an exact match
but BESTMATCH is not (it is too long). */
if ((matchsize == SCHARS (name)
- && matchsize + !!directoryp < SCHARS (bestmatch))
+ && matchsize + directoryp < SCHARS (bestmatch))
||
/* If there is no exact match ignoring case,
prefer a match that does not change the case
@@ -731,7 +703,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v
either both or neither are exact. */
(((matchsize == SCHARS (name))
==
- (matchsize + !!directoryp == SCHARS (bestmatch)))
+ (matchsize + directoryp == SCHARS (bestmatch)))
&& (cmp = Fcompare_strings (name, zero,
make_number (SCHARS (file)),
file, zero,
@@ -784,10 +756,10 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v
Return -1 if strings match,
else number of chars that match at the beginning. */
-static int
-scmp (const char *s1, const char *s2, int len)
+static ptrdiff_t
+scmp (const char *s1, const char *s2, ptrdiff_t len)
{
- register int l = len;
+ register ptrdiff_t l = len;
if (completion_ignore_case)
{
@@ -808,12 +780,14 @@ scmp (const char *s1, const char *s2, int len)
}
static int
-file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr)
+file_name_completion_stat (Lisp_Object dirname, struct dirent *dp,
+ struct stat *st_addr)
{
- int len = NAMLEN (dp);
- int pos = SCHARS (dirname);
+ ptrdiff_t len = dirent_namelen (dp);
+ ptrdiff_t pos = SCHARS (dirname);
int value;
- char *fullname = (char *) alloca (len + pos + 2);
+ USE_SAFE_ALLOCA;
+ char *fullname = SAFE_ALLOCA (len + pos + 2);
#ifdef MSDOS
/* Some fields of struct stat are *very* expensive to compute on MS-DOS,
@@ -842,6 +816,7 @@ file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_ad
#ifdef MSDOS
_djstat_flags = save_djstat_flags;
#endif /* MSDOS */
+ SAFE_FREE ();
return value;
}
@@ -890,8 +865,8 @@ Elements of the attribute list are:
2. File uid as a string or a number. If a string value cannot be
looked up, a numeric value, either an integer or a float, is returned.
3. File gid, likewise.
- 4. Last access time, as a list of two integers.
- First integer has high-order 16 bits of time, second has low 16 bits.
+ 4. Last access time, as a list of integers (HIGH LOW USEC PSEC) in the
+ same style as (current-time).
(See a note below about access time on FAT-based filesystems.)
5. Last modification time, likewise. This is the time of the last
change to the file's contents.
@@ -962,10 +937,10 @@ so last access time will always be midnight of that day. */)
if (!(NILP (id_format) || EQ (id_format, Qinteger)))
{
- BLOCK_INPUT;
+ block_input ();
uname = stat_uname (&s);
gname = stat_gname (&s);
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (uname)
values[2] = DECODE_SYSTEM (build_string (uname));
@@ -976,9 +951,9 @@ so last access time will always be midnight of that day. */)
else
values[3] = make_fixnum_or_float (s.st_gid);
- values[4] = make_time (s.st_atime);
- values[5] = make_time (s.st_mtime);
- values[6] = make_time (s.st_ctime);
+ values[4] = make_lisp_time (get_stat_atime (&s));
+ values[5] = make_lisp_time (get_stat_mtime (&s));
+ values[6] = make_lisp_time (get_stat_ctime (&s));
/* If the file size is a 4-byte type, assume that files of sizes in
the 2-4 GiB range wrap around to negative values, as this is a
@@ -1015,6 +990,45 @@ Comparison is in lexicographic order and case is significant. */)
return Fstring_lessp (Fcar (f1), Fcar (f2));
}
+
+DEFUN ("system-users", Fsystem_users, Ssystem_users, 0, 0, 0,
+ doc: /* Return a list of user names currently registered in the system.
+If we don't know how to determine that on this platform, just
+return a list with one element, taken from `user-real-login-name'. */)
+ (void)
+{
+ Lisp_Object users = Qnil;
+#if defined HAVE_GETPWENT && defined HAVE_ENDPWENT
+ struct passwd *pw;
+
+ while ((pw = getpwent ()))
+ users = Fcons (DECODE_SYSTEM (build_string (pw->pw_name)), users);
+
+ endpwent ();
+#endif
+ if (EQ (users, Qnil))
+ /* At least current user is always known. */
+ users = Fcons (Vuser_real_login_name, Qnil);
+ return users;
+}
+
+DEFUN ("system-groups", Fsystem_groups, Ssystem_groups, 0, 0, 0,
+ doc: /* Return a list of user group names currently registered in the system.
+The value may be nil if not supported on this platform. */)
+ (void)
+{
+ Lisp_Object groups = Qnil;
+#if defined HAVE_GETGRENT && defined HAVE_ENDGRENT
+ struct group *gr;
+
+ while ((gr = getgrent ()))
+ groups = Fcons (DECODE_SYSTEM (build_string (gr->gr_name)), groups);
+
+ endgrent ();
+#endif
+ return groups;
+}
+
void
syms_of_dired (void)
{
@@ -1032,6 +1046,8 @@ syms_of_dired (void)
defsubr (&Sfile_name_all_completions);
defsubr (&Sfile_attributes);
defsubr (&Sfile_attributes_lessp);
+ defsubr (&Ssystem_users);
+ defsubr (&Ssystem_groups);
DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
doc: /* Completion ignores file names ending in any string in this list.
diff --git a/src/dispextern.h b/src/dispextern.h
index 5228a71ba3f..c5ebb808b05 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1,6 +1,6 @@
/* Interface definitions for display code.
-Copyright (C) 1985, 1993-1994, 1997-2011 Free Software Foundation, Inc.
+Copyright (C) 1985, 1993-1994, 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -46,6 +46,18 @@ typedef struct {
#include "msdos.h"
#endif
+INLINE_HEADER_BEGIN
+#ifndef DISPEXTERN_INLINE
+# define DISPEXTERN_INLINE INLINE
+#endif
+
+#include <c-strcase.h>
+DISPEXTERN_INLINE int
+xstrcasecmp (char const *a, char const *b)
+{
+ return c_strcasecmp (a, b);
+}
+
#ifdef HAVE_X_WINDOWS
typedef struct x_display_info Display_Info;
typedef XImage * XImagePtr;
@@ -68,6 +80,10 @@ typedef Pixmap XImagePtr;
typedef XImagePtr XImagePtr_or_DC;
#endif
+#ifdef HAVE_WINDOW_SYSTEM
+# include "systime.h"
+#endif
+
#ifndef HAVE_WINDOW_SYSTEM
typedef int Cursor;
#define No_Cursor (0)
@@ -117,39 +133,21 @@ enum window_part
Debugging
***********************************************************************/
-/* If GLYPH_DEBUG is non-zero, additional checks are activated. Turn
- it off by defining the macro GLYPH_DEBUG to zero. */
+/* If GLYPH_DEBUG is defined, additional checks are activated. */
-#ifndef GLYPH_DEBUG
-#define GLYPH_DEBUG 0
-#endif
-
-/* If XASSERTS is non-zero, additional consistency checks are activated.
- Turn it off by defining the macro XASSERTS to zero. */
-
-#ifndef XASSERTS
-#define XASSERTS 0
-#endif
+/* Macros to include code only if GLYPH_DEBUG is defined. */
-/* Macros to include code only if GLYPH_DEBUG != 0. */
-
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
#define IF_DEBUG(X) X
#else
#define IF_DEBUG(X) (void) 0
#endif
-#if XASSERTS
-#define xassert(X) do {if (!(X)) abort ();} while (0)
-#else
-#define xassert(X) (void) 0
-#endif
-
/* Macro for displaying traces of redisplay. If Emacs was compiled
- with GLYPH_DEBUG != 0, the variable trace_redisplay_p can be set to
+ with GLYPH_DEBUG defined, the variable trace_redisplay_p can be set to
a non-zero value in debugging sessions to activate traces. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
extern int trace_redisplay_p EXTERNALLY_VISIBLE;
#include <stdio.h>
@@ -160,11 +158,11 @@ extern int trace_redisplay_p EXTERNALLY_VISIBLE;
else \
(void) 0
-#else /* GLYPH_DEBUG == 0 */
+#else /* not GLYPH_DEBUG */
#define TRACE(X) (void) 0
-#endif /* GLYPH_DEBUG == 0 */
+#endif /* GLYPH_DEBUG */
@@ -179,10 +177,10 @@ extern int trace_redisplay_p EXTERNALLY_VISIBLE;
struct text_pos
{
/* Character position. */
- EMACS_INT charpos;
+ ptrdiff_t charpos;
/* Corresponding byte position. */
- EMACS_INT bytepos;
+ ptrdiff_t bytepos;
};
/* Access character and byte position of POS in a functional form. */
@@ -253,7 +251,7 @@ struct display_pos
is the index of that overlay string in the sequence of overlay
strings at `pos' in the order redisplay processes them. A value
< 0 means that this is not a position in an overlay string. */
- int overlay_string_index;
+ ptrdiff_t overlay_string_index;
/* If this is a position in an overlay string, string_pos is the
position within that string. */
@@ -320,7 +318,7 @@ struct glyph
buffer, this is a position in that buffer. A value of -1
together with a null object means glyph is a truncation glyph at
the start of a row. */
- EMACS_INT charpos;
+ ptrdiff_t charpos;
/* Lisp object source of this glyph. Currently either a buffer or
a string, if the glyph was produced from characters which came from
@@ -454,7 +452,7 @@ struct glyph
/* Length of acronym or hexadecimal code string (at most 8). */
unsigned len : 4;
/* Character to display. Actually we need only 22 bits. */
- unsigned ch : 26;
+ unsigned ch : 25;
} glyphless;
/* Used to compare all bit-fields above in one step. */
@@ -662,7 +660,7 @@ struct glyph_matrix
line. */
unsigned header_line_p : 1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* A string identifying the method used to display the matrix. */
char method[512];
#endif
@@ -673,14 +671,14 @@ struct glyph_matrix
/* Values of BEGV and ZV as of last redisplay. Set in
mark_window_display_accurate_1. */
- int begv, zv;
+ ptrdiff_t begv, zv;
};
/* Check that glyph pointers stored in glyph rows of MATRIX are okay.
This aborts if any pointer is found twice. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
void check_matrix_pointer_lossage (struct glyph_matrix *);
#define CHECK_MATRIX(MATRIX) check_matrix_pointer_lossage ((MATRIX))
#else
@@ -959,10 +957,10 @@ struct glyph_row
/* Get a pointer to row number ROW in matrix MATRIX. If GLYPH_DEBUG
- is defined to a non-zero value, the function matrix_row checks that
- we don't try to access rows that are out of bounds. */
+ is defined, the function matrix_row checks that we don't try to
+ access rows that are out of bounds. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
struct glyph_row *matrix_row (struct glyph_matrix *, int);
#define MATRIX_ROW(MATRIX, ROW) matrix_row ((MATRIX), (ROW))
#else
@@ -1128,11 +1126,11 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int);
((ROW)->phys_height - (ROW)->phys_ascent \
> (ROW)->height - (ROW)->ascent)
-/* Non-zero means that fonts have been loaded since the last glyph
+/* True means that fonts have been loaded since the last glyph
matrix adjustments. The function redisplay_internal adjusts glyph
- matrices when this flag is non-zero. */
+ matrices when this flag is true. */
-extern int fonts_changed_p;
+extern bool fonts_changed_p;
/* A glyph for a space. */
@@ -1151,7 +1149,7 @@ extern int updated_area;
/* Non-zero means last display completed. Zero means it was
preempted. */
-extern int display_completed;
+extern bool display_completed;
@@ -1381,7 +1379,7 @@ struct glyph_string
? current_mode_line_height \
: (MATRIX_MODE_LINE_HEIGHT ((W)->current_matrix) \
? MATRIX_MODE_LINE_HEIGHT ((W)->current_matrix) \
- : estimate_mode_line_height (XFRAME ((W)->frame), \
+ : estimate_mode_line_height (XFRAME (W->frame), \
CURRENT_MODE_LINE_FACE_ID (W))))
/* Return the current height of the header line of window W. If not
@@ -1394,7 +1392,7 @@ struct glyph_string
? current_header_line_height \
: (MATRIX_HEADER_LINE_HEIGHT ((W)->current_matrix) \
? MATRIX_HEADER_LINE_HEIGHT ((W)->current_matrix) \
- : estimate_mode_line_height (XFRAME ((W)->frame), \
+ : estimate_mode_line_height (XFRAME (W->frame),\
HEADER_LINE_FACE_ID)))
/* Return the height of the desired mode line of window W. */
@@ -1413,19 +1411,20 @@ struct glyph_string
(!MINI_WINDOW_P ((W)) \
&& !(W)->pseudo_window_p \
&& FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \
- && BUFFERP ((W)->buffer) \
- && !NILP (BVAR (XBUFFER ((W)->buffer), mode_line_format)) \
+ && BUFFERP (W->buffer) \
+ && !NILP (BVAR (XBUFFER (W->buffer), mode_line_format)) \
&& WINDOW_TOTAL_LINES (W) > 1)
-/* Value is non-zero if window W wants a header line. */
+/* Value is true if window W wants a header line. */
#define WINDOW_WANTS_HEADER_LINE_P(W) \
(!MINI_WINDOW_P ((W)) \
&& !(W)->pseudo_window_p \
&& FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \
- && BUFFERP ((W)->buffer) \
- && !NILP (BVAR (XBUFFER ((W)->buffer), header_line_format)) \
- && WINDOW_TOTAL_LINES (W) > 1 + !NILP (BVAR (XBUFFER ((W)->buffer), mode_line_format)))
+ && BUFFERP (W->buffer) \
+ && !NILP (BVAR (XBUFFER (W->buffer), header_line_format)) \
+ && WINDOW_TOTAL_LINES (W) > 1 \
+ + !NILP (BVAR (XBUFFER (W->buffer), mode_line_format)))
/* Return proper value to be used as baseline offset of font that has
@@ -1510,6 +1509,13 @@ enum face_box_type
FACE_SUNKEN_BOX
};
+/* Underline type. */
+
+enum face_underline_type
+{
+ FACE_UNDER_LINE,
+ FACE_UNDER_WAVE
+};
/* Structure describing a realized face.
@@ -1585,6 +1591,9 @@ struct face
drawing shadows. */
unsigned use_box_color_for_shadows_p : 1;
+ /* Style of underlining. */
+ enum face_underline_type underline_type;
+
/* Non-zero if text in this face should be underlined, overlined,
strike-through or have a box drawn around it. */
unsigned underline_p : 1;
@@ -1609,15 +1618,12 @@ struct face
unsigned strike_through_color_defaulted_p : 1;
unsigned box_color_defaulted_p : 1;
- /* TTY appearances. Blinking is not yet implemented. Colors are
- found in `lface' with empty color string meaning the default
- color of the TTY. */
+ /* TTY appearances. Colors are found in `lface' with empty color
+ string meaning the default color of the TTY. */
unsigned tty_bold_p : 1;
- unsigned tty_dim_p : 1;
+ unsigned tty_italic_p : 1;
unsigned tty_underline_p : 1;
- unsigned tty_alt_charset_p : 1;
unsigned tty_reverse_p : 1;
- unsigned tty_blinking_p : 1;
/* 1 means that colors of this face may not be freed because they
have been copied bitwise from a base face (see
@@ -1808,7 +1814,7 @@ typedef enum { NEUTRAL_DIR, L2R, R2L } bidi_dir_t;
/* Data type for storing information about characters we need to
remember. */
struct bidi_saved_info {
- EMACS_INT bytepos, charpos; /* character's buffer position */
+ ptrdiff_t bytepos, charpos; /* character's buffer position */
bidi_type_t type; /* character's resolved bidi type */
bidi_type_t type_after_w1; /* original type of the character, after W1 */
bidi_type_t orig_type; /* type as we found it in the buffer */
@@ -1825,9 +1831,9 @@ struct bidi_stack {
struct bidi_string_data {
Lisp_Object lstring; /* Lisp string to reorder, or nil */
const unsigned char *s; /* string data, or NULL if reordering buffer */
- EMACS_INT schars; /* the number of characters in the string,
+ ptrdiff_t schars; /* the number of characters in the string,
excluding the terminating null */
- EMACS_INT bufpos; /* buffer position of lstring, or 0 if N/A */
+ ptrdiff_t bufpos; /* buffer position of lstring, or 0 if N/A */
unsigned from_disp_str : 1; /* 1 means the string comes from a
display property */
unsigned unibyte : 1; /* 1 means the string is unibyte */
@@ -1835,14 +1841,14 @@ struct bidi_string_data {
/* Data type for reordering bidirectional text. */
struct bidi_it {
- EMACS_INT bytepos; /* iterator's position in buffer/string */
- EMACS_INT charpos;
+ ptrdiff_t bytepos; /* iterator's position in buffer/string */
+ ptrdiff_t charpos;
int ch; /* character at that position, or u+FFFC
("object replacement character") for a run
of characters covered by a display string */
- EMACS_INT nchars; /* its "length", usually 1; it's > 1 for a run
+ ptrdiff_t nchars; /* its "length", usually 1; it's > 1 for a run
of characters covered by a display string */
- EMACS_INT ch_len; /* its length in bytes */
+ ptrdiff_t ch_len; /* its length in bytes */
bidi_type_t type; /* bidi type of this character, after
resolving weak and neutral types */
bidi_type_t type_after_w1; /* original type, after overrides and W1 */
@@ -1850,18 +1856,17 @@ struct bidi_it {
int resolved_level; /* final resolved level of this character */
int invalid_levels; /* how many PDFs to ignore */
int invalid_rl_levels; /* how many PDFs from RLE/RLO to ignore */
- int prev_was_pdf; /* if non-zero, previous char was PDF */
struct bidi_saved_info prev; /* info about previous character */
struct bidi_saved_info last_strong; /* last-seen strong directional char */
struct bidi_saved_info next_for_neutral; /* surrounding characters for... */
struct bidi_saved_info prev_for_neutral; /* ...resolving neutrals */
struct bidi_saved_info next_for_ws; /* character after sequence of ws */
- EMACS_INT next_en_pos; /* pos. of next char for determining ET type */
+ ptrdiff_t next_en_pos; /* pos. of next char for determining ET type */
bidi_type_t next_en_type; /* type of char at next_en_pos */
- EMACS_INT ignore_bn_limit; /* position until which to ignore BNs */
+ ptrdiff_t ignore_bn_limit; /* position until which to ignore BNs */
bidi_dir_t sor; /* direction of start-of-run in effect */
int scan_dir; /* direction of text scan, 1: forw, -1: back */
- EMACS_INT disp_pos; /* position of display string after ch */
+ ptrdiff_t disp_pos; /* position of display string after ch */
int disp_prop; /* if non-zero, there really is a
`display' property/string at disp_pos;
if 2, the property is a `space' spec */
@@ -1872,7 +1877,8 @@ struct bidi_it {
struct bidi_stack level_stack[BIDI_MAXLEVEL]; /* stack of embedding levels */
struct bidi_string_data string; /* string to reorder */
bidi_dir_t paragraph_dir; /* current paragraph direction */
- EMACS_INT separator_limit; /* where paragraph separator should end */
+ ptrdiff_t separator_limit; /* where paragraph separator should end */
+ unsigned prev_was_pdf : 1; /* if non-zero, previous char was PDF */
unsigned first_elt : 1; /* if non-zero, examine current char first */
unsigned new_paragraph : 1; /* if non-zero, we expect a new paragraph */
unsigned frame_window_p : 1; /* non-zero if displaying on a GUI frame */
@@ -2058,7 +2064,7 @@ enum it_method {
struct composition_it
{
/* Next position at which to check the composition. */
- EMACS_INT stop_pos;
+ ptrdiff_t stop_pos;
/* ID number of the composition or glyph-string. If negative, we
are not iterating over a composition now. */
ptrdiff_t id;
@@ -2076,18 +2082,18 @@ struct composition_it
/* If this is an automatic composition, how many characters to look
back from the position where a character triggering the
composition exists. */
- int lookback;
+ ptrdiff_t lookback;
/* If non-negative, number of glyphs of the glyph-string. */
int nglyphs;
- /* Nonzero iff the composition is created while buffer is scanned in
+ /* True iff the composition is created while buffer is scanned in
reverse order, and thus the grapheme clusters must be rendered
from the last to the first. */
- int reversed_p;
+ bool reversed_p;
/** The following members contain information about the current
grapheme cluster. */
/* Position of the first character of the current grapheme cluster. */
- EMACS_INT charpos;
+ ptrdiff_t charpos;
/* Number of characters and bytes of the current grapheme cluster. */
int nchars, nbytes;
/* Indices of the glyphs for the current grapheme cluster. */
@@ -2112,19 +2118,19 @@ struct it
/* The next position at which to check for face changes, invisible
text, overlay strings, end of text etc., which see. */
- EMACS_INT stop_charpos;
+ ptrdiff_t stop_charpos;
/* Previous stop position, i.e. the last one before the current
iterator position in `current'. */
- EMACS_INT prev_stop;
+ ptrdiff_t prev_stop;
/* Last stop position iterated across whose bidi embedding level is
equal to the current paragraph's base embedding level. */
- EMACS_INT base_level_stop;
+ ptrdiff_t base_level_stop;
/* Maximum string or buffer position + 1. ZV when iterating over
current_buffer. */
- EMACS_INT end_charpos;
+ ptrdiff_t end_charpos;
/* C string to iterate over. Non-null means get characters from
this string, otherwise characters are read from current_buffer
@@ -2132,15 +2138,16 @@ struct it
const unsigned char *s;
/* Number of characters in the string (s, or it->string) we iterate
- over. */
- EMACS_INT string_nchars;
+ over. Used only in display_string and its subroutines; never
+ used for overlay strings and strings from display properties. */
+ ptrdiff_t string_nchars;
/* Start and end of a visible region; -1 if the region is not
visible in the window. */
- EMACS_INT region_beg_charpos, region_end_charpos;
+ ptrdiff_t region_beg_charpos, region_end_charpos;
/* Position at which redisplay end trigger functions should be run. */
- EMACS_INT redisplay_end_trigger_charpos;
+ ptrdiff_t redisplay_end_trigger_charpos;
/* 1 means multibyte characters are enabled. */
unsigned multibyte_p : 1;
@@ -2152,6 +2159,10 @@ struct it
Don't handle some `display' properties in these strings. */
unsigned string_from_display_prop_p : 1;
+ /* 1 means `string' comes from a `line-prefix' or `wrap-prefix'
+ property. */
+ unsigned string_from_prefix_prop_p : 1;
+
/* 1 means we are iterating an object that came from a value of a
`display' property. */
unsigned from_disp_prop_p : 1;
@@ -2204,14 +2215,18 @@ struct it
struct display_pos current;
/* Total number of overlay strings to process. This can be >
- OVERLAY_STRING_CHUNK_SIZE. */
- int n_overlay_strings;
+ OVERLAY_STRING_CHUNK_SIZE. Value is dependable only when
+ current.overlay_string_index >= 0. Use the latter to determine
+ whether an overlay string is being iterated over, because
+ n_overlay_strings can be positive even when we are not rendering
+ an overlay string. */
+ ptrdiff_t n_overlay_strings;
/* The charpos where n_overlay_strings was calculated. This should
be set at the same time as n_overlay_strings. It is needed
because we show before-strings at the start of invisible text;
see handle_invisible_prop in xdisp.c. */
- EMACS_INT overlay_strings_charpos;
+ ptrdiff_t overlay_strings_charpos;
/* Vector of overlays to process. Overlay strings are processed
OVERLAY_STRING_CHUNK_SIZE at a time. */
@@ -2223,7 +2238,8 @@ struct it
/* If non-nil, a Lisp string being processed. If
current.overlay_string_index >= 0, this is an overlay string from
- pos. */
+ pos. Use STRINGP (it.string) to test whether we are rendering a
+ string or something else; do NOT use BUFFERP (it.object). */
Lisp_Object string;
/* If non-nil, we are processing a string that came
@@ -2238,10 +2254,10 @@ struct it
{
Lisp_Object string;
int string_nchars;
- EMACS_INT end_charpos;
- EMACS_INT stop_charpos;
- EMACS_INT prev_stop;
- EMACS_INT base_level_stop;
+ ptrdiff_t end_charpos;
+ ptrdiff_t stop_charpos;
+ ptrdiff_t prev_stop;
+ ptrdiff_t base_level_stop;
struct composition_it cmp_it;
int face_id;
@@ -2272,6 +2288,7 @@ struct it
bidi_dir_t paragraph_embedding;
unsigned multibyte_p : 1;
unsigned string_from_display_prop_p : 1;
+ unsigned string_from_prefix_prop_p : 1;
unsigned display_ellipsis_p : 1;
unsigned avoid_cursor_p : 1;
unsigned bidi_p:1;
@@ -2290,7 +2307,7 @@ struct it
/* -1 means selective display hides everything between a \r and the
next newline; > 0 means hide lines indented more than that value. */
- EMACS_INT selective;
+ ptrdiff_t selective;
/* An enumeration describing what the next display element is
after a call to get_next_display_element. */
@@ -2411,6 +2428,9 @@ struct it
and continuation glyphs, or blanks that extend each line to the
edge of the window on a TTY.
+ Do NOT use !BUFFERP (it.object) as a test whether we are
+ iterating over a string; use STRINGP (it.string) instead.
+
Position is the current iterator position in object. */
Lisp_Object object;
struct text_pos position;
@@ -2737,16 +2757,20 @@ struct image_type
Lisp_Object *type;
/* Check that SPEC is a valid image specification for the given
- image type. Value is non-zero if SPEC is valid. */
- int (* valid_p) (Lisp_Object spec);
+ image type. Value is true if SPEC is valid. */
+ bool (* valid_p) (Lisp_Object spec);
/* Load IMG which is used on frame F from information contained in
- IMG->spec. Value is non-zero if successful. */
- int (* load) (struct frame *f, struct image *img);
+ IMG->spec. Value is true if successful. */
+ bool (* load) (struct frame *f, struct image *img);
/* Free resources of image IMG which is used on frame F. */
void (* free) (struct frame *f, struct image *img);
+ /* Initialization function (used for dynamic loading of image
+ libraries on Windows), or NULL if none. */
+ bool (* init) (void);
+
/* Next in list of all supported image types. */
struct image_type *next;
};
@@ -2760,7 +2784,7 @@ struct image
{
/* The time in seconds at which the image was last displayed. Set
in prepare_image_for_display. */
- time_t timestamp;
+ EMACS_TIME timestamp;
/* Pixmaps of the image. */
Pixmap pixmap, mask;
@@ -2974,8 +2998,7 @@ enum tool_bar_item_image
#define TTY_CAP_UNDERLINE 0x02
#define TTY_CAP_BOLD 0x04
#define TTY_CAP_DIM 0x08
-#define TTY_CAP_BLINK 0x10
-#define TTY_CAP_ALT_CHARSET 0x20
+#define TTY_CAP_ITALIC 0x10
/***********************************************************************
@@ -2984,22 +3007,22 @@ enum tool_bar_item_image
/* Defined in bidi.c */
-extern void bidi_init_it (EMACS_INT, EMACS_INT, int, struct bidi_it *);
+extern void bidi_init_it (ptrdiff_t, ptrdiff_t, bool, struct bidi_it *);
extern void bidi_move_to_visually_next (struct bidi_it *);
-extern void bidi_paragraph_init (bidi_dir_t, struct bidi_it *, int);
+extern void bidi_paragraph_init (bidi_dir_t, struct bidi_it *, bool);
extern int bidi_mirror_char (int);
extern void bidi_push_it (struct bidi_it *);
extern void bidi_pop_it (struct bidi_it *);
extern void *bidi_shelve_cache (void);
-extern void bidi_unshelve_cache (void *, int);
+extern void bidi_unshelve_cache (void *, bool);
/* Defined in xdisp.c */
-struct glyph_row *row_containing_pos (struct window *, EMACS_INT,
+struct glyph_row *row_containing_pos (struct window *, ptrdiff_t,
struct glyph_row *,
struct glyph_row *, int);
int line_bottom_y (struct it *);
-int display_prop_intangible_p (Lisp_Object, Lisp_Object, EMACS_INT, EMACS_INT);
+int display_prop_intangible_p (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
void resize_echo_area_exactly (void);
int resize_mini_window (struct window *, int);
#if defined USE_TOOLKIT_SCROLL_BARS && !defined USE_GTK
@@ -3021,43 +3044,42 @@ void remember_mouse_glyph (struct frame *, int, int, NativeRectangle *);
void mark_window_display_accurate (Lisp_Object, int);
void redisplay_preserve_echo_area (int);
-void init_iterator (struct it *, struct window *, EMACS_INT,
- EMACS_INT, struct glyph_row *, enum face_id);
+void init_iterator (struct it *, struct window *, ptrdiff_t,
+ ptrdiff_t, struct glyph_row *, enum face_id);
void init_iterator_to_row_start (struct it *, struct window *,
struct glyph_row *);
void start_display (struct it *, struct window *, struct text_pos);
-void move_it_to (struct it *, EMACS_INT, int, int, int, int);
+void move_it_to (struct it *, ptrdiff_t, int, int, int, int);
void move_it_vertically (struct it *, int);
void move_it_vertically_backward (struct it *, int);
-void move_it_by_lines (struct it *, int);
+void move_it_by_lines (struct it *, ptrdiff_t);
void move_it_past_eol (struct it *);
void move_it_in_display_line (struct it *it,
- EMACS_INT to_charpos, int to_x,
+ ptrdiff_t to_charpos, int to_x,
enum move_operation_enum op);
int in_display_vector_p (struct it *);
int frame_mode_line_height (struct frame *);
extern Lisp_Object Qtool_bar;
-extern int redisplaying_p;
+extern bool redisplaying_p;
extern int help_echo_showing_p;
extern int current_mode_line_height, current_header_line_height;
extern Lisp_Object help_echo_string, help_echo_window;
extern Lisp_Object help_echo_object, previous_help_echo_string;
-extern EMACS_INT help_echo_pos;
+extern ptrdiff_t help_echo_pos;
extern struct frame *last_mouse_frame;
extern int last_tool_bar_item;
extern void reseat_at_previous_visible_line_start (struct it *);
extern Lisp_Object lookup_glyphless_char_display (int, struct it *);
-extern EMACS_INT compute_display_string_pos (struct text_pos *,
+extern ptrdiff_t compute_display_string_pos (struct text_pos *,
struct bidi_string_data *,
int, int *);
-extern EMACS_INT compute_display_string_end (EMACS_INT,
+extern ptrdiff_t compute_display_string_end (ptrdiff_t,
struct bidi_string_data *);
extern void produce_stretch_glyph (struct it *);
-
#ifdef HAVE_WINDOW_SYSTEM
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
extern void dump_glyph_string (struct glyph_string *) EXTERNALLY_VISIBLE;
#endif
@@ -3096,7 +3118,7 @@ extern void get_glyph_string_clip_rect (struct glyph_string *,
extern Lisp_Object find_hot_spot (Lisp_Object, int, int);
extern void handle_tool_bar_click (struct frame *,
- int, int, int, unsigned int);
+ int, int, int, int);
extern void expose_frame (struct frame *, int, int, int, int);
extern int x_intersect_rectangles (XRectangle *, XRectangle *,
@@ -3122,7 +3144,7 @@ int draw_window_fringes (struct window *, int);
int update_window_fringes (struct window *, int);
void compute_fringe_widths (struct frame *, int);
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
void w32_init_fringe (struct redisplay_interface *);
void w32_reset_fringes (void);
#endif
@@ -3135,7 +3157,7 @@ extern unsigned row_hash (struct glyph_row *);
extern int x_bitmap_height (struct frame *, ptrdiff_t);
extern int x_bitmap_width (struct frame *, ptrdiff_t);
-extern int x_bitmap_pixmap (struct frame *, ptrdiff_t);
+extern ptrdiff_t x_bitmap_pixmap (struct frame *, ptrdiff_t);
extern void x_reference_bitmap (struct frame *, ptrdiff_t);
extern ptrdiff_t x_create_bitmap_from_data (struct frame *, char *,
unsigned int, unsigned int);
@@ -3147,7 +3169,7 @@ extern ptrdiff_t x_create_bitmap_from_xpm_data (struct frame *, const char **);
extern void x_destroy_bitmap (struct frame *, ptrdiff_t);
#endif
extern void x_destroy_all_bitmaps (Display_Info *);
-extern int x_create_bitmap_mask (struct frame *, ptrdiff_t);
+extern void x_create_bitmap_mask (struct frame *, ptrdiff_t);
extern Lisp_Object x_find_image_file (Lisp_Object);
void x_kill_gs_process (Pixmap, struct frame *);
@@ -3155,7 +3177,7 @@ struct image_cache *make_image_cache (void);
void free_image_cache (struct frame *);
void clear_image_caches (Lisp_Object);
void mark_image_cache (struct image_cache *);
-int valid_image_p (Lisp_Object);
+bool valid_image_p (Lisp_Object);
void prepare_image_for_display (struct frame *, struct image *);
ptrdiff_t lookup_image (struct frame *, Lisp_Object);
@@ -3176,6 +3198,7 @@ void unrequest_sigio (void);
int tabs_safe_p (int);
void init_baud_rate (int);
void init_sigio (int);
+void ignore_sigio (void);
/* Defined in xfaces.c */
@@ -3193,7 +3216,6 @@ void unload_color (struct frame *, unsigned long);
char *choose_face_font (struct frame *, Lisp_Object *, Lisp_Object,
int *);
void prepare_face_for_display (struct frame *, struct face *);
-int xstrcasecmp (const char *, const char *);
int lookup_named_face (struct frame *, Lisp_Object, int);
int lookup_basic_face (struct frame *, int);
int smaller_face (struct frame *, int, int);
@@ -3202,19 +3224,19 @@ int lookup_derived_face (struct frame *, Lisp_Object, int, int);
void init_frame_faces (struct frame *);
void free_frame_faces (struct frame *);
void recompute_basic_faces (struct frame *);
-int face_at_buffer_position (struct window *w, EMACS_INT pos,
- EMACS_INT region_beg, EMACS_INT region_end,
- EMACS_INT *endptr, EMACS_INT limit,
+int face_at_buffer_position (struct window *w, ptrdiff_t pos,
+ ptrdiff_t region_beg, ptrdiff_t region_end,
+ ptrdiff_t *endptr, ptrdiff_t limit,
int mouse, int base_face_id);
-int face_for_overlay_string (struct window *w, EMACS_INT pos,
- EMACS_INT region_beg, EMACS_INT region_end,
- EMACS_INT *endptr, EMACS_INT limit,
+int face_for_overlay_string (struct window *w, ptrdiff_t pos,
+ ptrdiff_t region_beg, ptrdiff_t region_end,
+ ptrdiff_t *endptr, ptrdiff_t limit,
int mouse, Lisp_Object overlay);
int face_at_string_position (struct window *w, Lisp_Object string,
- EMACS_INT pos, EMACS_INT bufpos,
- EMACS_INT region_beg, EMACS_INT region_end,
- EMACS_INT *endptr, enum face_id, int mouse);
-int merge_faces (struct frame *, Lisp_Object, EMACS_INT, int);
+ ptrdiff_t pos, ptrdiff_t bufpos,
+ ptrdiff_t region_beg, ptrdiff_t region_end,
+ ptrdiff_t *endptr, enum face_id, int mouse);
+int merge_faces (struct frame *, Lisp_Object, int, int);
int compute_char_face (struct frame *, int, Lisp_Object);
void free_all_realized_faces (Lisp_Object);
extern Lisp_Object Qforeground_color, Qbackground_color;
@@ -3225,7 +3247,7 @@ extern char unspecified_fg[], unspecified_bg[];
#ifdef HAVE_X_WINDOWS
void gamma_correct (struct frame *, XColor *);
#endif
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
void gamma_correct (struct frame *, COLORREF *);
#endif
@@ -3235,11 +3257,12 @@ void x_implicitly_set_name (struct frame *, Lisp_Object, Lisp_Object);
extern Lisp_Object tip_frame;
extern Window tip_window;
-EXFUN (Fx_hide_tip, 0);
+extern frame_parm_handler x_frame_parm_handlers[];
+
extern void start_hourglass (void);
extern void cancel_hourglass (void);
-extern int hourglass_started (void);
extern int hourglass_shown_p;
+
struct atimer; /* Defined in atimer.h. */
/* If non-null, an asynchronous timer that, when it expires, displays
an hourglass cursor on all frames. */
@@ -3280,17 +3303,17 @@ extern Lisp_Object buffer_posn_from_coords (struct window *,
Lisp_Object *,
int *, int *, int *, int *);
extern Lisp_Object mode_line_string (struct window *, enum window_part,
- int *, int *, EMACS_INT *,
+ int *, int *, ptrdiff_t *,
Lisp_Object *,
int *, int *, int *, int *);
extern Lisp_Object marginal_area_string (struct window *, enum window_part,
- int *, int *, EMACS_INT *,
+ int *, int *, ptrdiff_t *,
Lisp_Object *,
int *, int *, int *, int *);
extern void redraw_frame (struct frame *);
extern void cancel_line (int, struct frame *);
extern void init_desired_glyphs (struct frame *);
-extern int update_frame (struct frame *, int, int);
+extern bool update_frame (struct frame *, bool, bool);
extern void bitch_at_user (void);
void adjust_glyphs (struct frame *);
void free_glyphs (struct frame *);
@@ -3304,15 +3327,15 @@ void shift_glyph_matrix (struct window *, struct glyph_matrix *,
int, int, int);
void rotate_matrix (struct glyph_matrix *, int, int, int);
void increment_matrix_positions (struct glyph_matrix *,
- int, int, EMACS_INT, EMACS_INT);
+ int, int, ptrdiff_t, ptrdiff_t);
void blank_row (struct window *, struct glyph_row *, int);
-void enable_glyph_matrix_rows (struct glyph_matrix *, int, int, int);
+void clear_glyph_matrix_rows (struct glyph_matrix *, int, int);
void clear_glyph_row (struct glyph_row *);
void prepare_desired_row (struct glyph_row *);
-void set_window_update_flags (struct window *, int);
-void update_single_window (struct window *, int);
-void do_pending_window_change (int);
-void change_frame_size (struct frame *, int, int, int, int, int);
+void set_window_update_flags (struct window *, bool);
+void update_single_window (struct window *, bool);
+void do_pending_window_change (bool);
+void change_frame_size (struct frame *, int, int, bool, bool, bool);
void init_display (void);
void syms_of_display (void);
extern Lisp_Object Qredisplay_dont_pause;
@@ -3344,12 +3367,9 @@ extern int string_cost (const char *);
extern int per_line_cost (const char *);
extern void calculate_costs (struct frame *);
extern void produce_glyphs (struct it *);
-extern void produce_special_glyphs (struct it *, enum display_element_type);
extern int tty_capable_p (struct tty_display_info *, unsigned, unsigned long, unsigned long);
extern void set_tty_color_mode (struct tty_display_info *, struct frame *);
extern struct terminal *get_named_tty (const char *);
-EXFUN (Ftty_type, 1);
-EXFUN (Fcontrolling_tty_p, 1);
extern void create_tty_output (struct frame *);
extern struct terminal *init_tty (const char *, const char *, int);
extern void tty_append_glyph (struct it *);
@@ -3394,4 +3414,6 @@ extern Lisp_Object x_default_parameter (struct frame *, Lisp_Object,
#endif /* HAVE_WINDOW_SYSTEM */
+INLINE_HEADER_END
+
#endif /* not DISPEXTERN_H_INCLUDED */
diff --git a/src/dispnew.c b/src/dispnew.c
index 2c0e74d0dde..675c06c22e9 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -1,5 +1,6 @@
/* Updating of data structures for redisplay.
- Copyright (C) 1985-1988, 1993-1995, 1997-2011 Free Software Foundation, Inc.
+
+Copyright (C) 1985-1988, 1993-1995, 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -17,20 +18,19 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <signal.h>
+
+#define DISPEXTERN_INLINE EXTERN_INLINE
+
#include <stdio.h>
-#include <ctype.h>
-#include <setjmp.h>
#include <unistd.h>
#include "lisp.h"
#include "termchar.h"
-#include "termopts.h"
/* cm.h must come after dispextern.h on Windows. */
#include "dispextern.h"
#include "cm.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "keyboard.h"
#include "frame.h"
#include "termhooks.h"
@@ -44,51 +44,23 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "syssignal.h"
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#endif /* HAVE_X_WINDOWS */
-
-#ifdef HAVE_NTGUI
-#include "w32term.h"
-#endif /* HAVE_NTGUI */
-
-#ifdef HAVE_NS
-#include "nsterm.h"
-#endif
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
/* Include systime.h after xterm.h to avoid double inclusion of time.h. */
#include "systime.h"
#include <errno.h>
-/* Get number of chars of output now in the buffer of a stdio stream.
- This ought to be built in in stdio, but it isn't. Some s- files
- override this because their stdio internals differ. */
+#include <fpending.h>
-#ifdef __GNU_LIBRARY__
-
-/* The s- file might have overridden the definition with one that
- works for the system's C library. But we are using the GNU C
- library, so this is the right definition for every system. */
-
-#ifdef GNU_LIBRARY_PENDING_OUTPUT_COUNT
-#define PENDING_OUTPUT_COUNT GNU_LIBRARY_PENDING_OUTPUT_COUNT
-#else
-#undef PENDING_OUTPUT_COUNT
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__bufp - (FILE)->__buffer)
-#endif
-#else /* not __GNU_LIBRARY__ */
-#if !defined (PENDING_OUTPUT_COUNT) && HAVE_STDIO_EXT_H && HAVE___FPENDING
-#include <stdio_ext.h>
-#define PENDING_OUTPUT_COUNT(FILE) __fpending (FILE)
-#endif
-#ifndef PENDING_OUTPUT_COUNT
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base)
+#if defined (HAVE_TERM_H) && defined (GNU_LINUX)
+#include <term.h> /* for tgetent */
#endif
-#endif /* not __GNU_LIBRARY__ */
-#if defined (HAVE_TERM_H) && defined (GNU_LINUX) && defined (HAVE_LIBNCURSES)
-#include <term.h> /* for tgetent */
+#ifdef WINDOWSNT
+#include "w32.h"
#endif
/* Structure to pass dimensions around. Used for character bounding
@@ -107,8 +79,8 @@ static void update_frame_line (struct frame *, int);
static int required_matrix_height (struct window *);
static int required_matrix_width (struct window *);
static void adjust_frame_glyphs (struct frame *);
-static void change_frame_size_1 (struct frame *, int, int, int, int, int);
-static void increment_row_positions (struct glyph_row *, EMACS_INT, EMACS_INT);
+static void change_frame_size_1 (struct frame *, int, int, bool, bool, bool);
+static void increment_row_positions (struct glyph_row *, ptrdiff_t, ptrdiff_t);
static void fill_up_frame_row_with_spaces (struct glyph_row *, int);
static void build_frame_matrix_from_window_tree (struct glyph_matrix *,
struct window *);
@@ -117,51 +89,38 @@ static void build_frame_matrix_from_leaf_window (struct glyph_matrix *,
static void adjust_frame_message_buffer (struct frame *);
static void adjust_decode_mode_spec_buffer (struct frame *);
static void fill_up_glyph_row_with_spaces (struct glyph_row *);
-static void clear_window_matrices (struct window *, int);
+static void clear_window_matrices (struct window *, bool);
static void fill_up_glyph_row_area_with_spaces (struct glyph_row *, int);
-static int scrolling_window (struct window *, int);
-static int update_window_line (struct window *, int, int *);
+static int scrolling_window (struct window *, bool);
+static bool update_window_line (struct window *, int, bool *);
static void mirror_make_current (struct window *, int);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
static void check_matrix_pointers (struct glyph_matrix *,
struct glyph_matrix *);
#endif
static void mirror_line_dance (struct window *, int, int, int *, char *);
-static int update_window_tree (struct window *, int);
-static int update_window (struct window *, int);
-static int update_frame_1 (struct frame *, int, int);
-static int scrolling (struct frame *);
+static bool update_window_tree (struct window *, bool);
+static bool update_window (struct window *, bool);
+static bool update_frame_1 (struct frame *, bool, bool);
+static bool scrolling (struct frame *);
static void set_window_cursor_after_update (struct window *);
static void adjust_frame_glyphs_for_window_redisplay (struct frame *);
static void adjust_frame_glyphs_for_frame_redisplay (struct frame *);
-/* Define PERIODIC_PREEMPTION_CHECKING to 1, if micro-second timers
- are supported, so we can check for input during redisplay at
- regular intervals. */
-#ifdef EMACS_HAS_USECS
-#define PERIODIC_PREEMPTION_CHECKING 1
-#else
-#define PERIODIC_PREEMPTION_CHECKING 0
-#endif
-
-#if PERIODIC_PREEMPTION_CHECKING
-
/* Redisplay preemption timers. */
static EMACS_TIME preemption_period;
static EMACS_TIME preemption_next_check;
-#endif
-
-/* Nonzero upon entry to redisplay means do not assume anything about
+/* True upon entry to redisplay means do not assume anything about
current contents of actual terminal frame; clear and redraw it. */
-int frame_garbaged;
+bool frame_garbaged;
-/* Nonzero means last display completed. Zero means it was preempted. */
+/* True means last display completed. False means it was preempted. */
-int display_completed;
+bool display_completed;
Lisp_Object Qdisplay_table, Qredisplay_dont_pause;
@@ -178,13 +137,9 @@ Lisp_Object selected_frame;
struct frame *last_nonminibuf_frame;
-/* 1 means SIGWINCH happened when not safe. */
-
-static int delayed_size_change;
+/* True means SIGWINCH happened when not safe. */
-/* 1 means glyph initialization has been completed at startup. */
-
-static int glyphs_initialized_initially_p;
+static bool delayed_size_change;
/* Updated window if != 0. Set by update_window. */
@@ -210,20 +165,20 @@ static int glyph_pool_count;
static struct frame *frame_matrix_frame;
-/* Non-zero means that fonts have been loaded since the last glyph
+/* True means that fonts have been loaded since the last glyph
matrix adjustments. Redisplay must stop, and glyph matrices must
- be adjusted when this flag becomes non-zero during display. The
+ be adjusted when this flag becomes true during display. The
reason fonts can be loaded so late is that fonts of fontsets are
loaded on demand. Another reason is that a line contains many
characters displayed by zero width or very narrow glyphs of
variable-width fonts. */
-int fonts_changed_p;
+bool fonts_changed_p;
/* Convert vpos and hpos from frame to window and vice versa.
This may only be used for terminal frames. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
static int window_to_frame_vpos (struct window *, int);
static int window_to_frame_hpos (struct window *, int);
@@ -254,16 +209,14 @@ static int history_idx;
history. */
static uprintmax_t history_tick;
-
-static void add_frame_display_history (struct frame *, int);
/* Add to the redisplay history how window W has been displayed.
MSG is a trace containing the information how W's glyph matrix
- has been constructed. PAUSED_P non-zero means that the update
+ has been constructed. PAUSED_P means that the update
has been interrupted for pending input. */
static void
-add_window_display_history (struct window *w, const char *msg, int paused_p)
+add_window_display_history (struct window *w, const char *msg, bool paused_p)
{
char *buf;
@@ -286,11 +239,11 @@ add_window_display_history (struct window *w, const char *msg, int paused_p)
/* Add to the redisplay history that frame F has been displayed.
- PAUSED_P non-zero means that the update has been interrupted for
+ PAUSED_P means that the update has been interrupted for
pending input. */
static void
-add_frame_display_history (struct frame *f, int paused_p)
+add_frame_display_history (struct frame *f, bool paused_p)
{
char *buf;
@@ -323,21 +276,23 @@ DEFUN ("dump-redisplay-history", Fdump_redisplay_history,
}
-#else /* GLYPH_DEBUG == 0 */
+#else /* not GLYPH_DEBUG */
#define WINDOW_TO_FRAME_VPOS(W, VPOS) ((VPOS) + WINDOW_TOP_EDGE_LINE (W))
#define WINDOW_TO_FRAME_HPOS(W, HPOS) ((HPOS) + WINDOW_LEFT_EDGE_COL (W))
-#endif /* GLYPH_DEBUG == 0 */
-
+#endif /* GLYPH_DEBUG */
-#if defined PROFILING && !HAVE___EXECUTABLE_START
-/* FIXME: only used to find text start for profiling. */
+#if (defined PROFILING \
+ && (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__) \
+ && !HAVE___EXECUTABLE_START)
+/* This function comes first in the Emacs executable and is used only
+ to estimate the text start for profiling. */
void
-safe_bcopy (const char *from, char *to, int size)
+__executable_start (void)
{
- abort ();
+ emacs_abort ();
}
#endif
@@ -354,11 +309,7 @@ safe_bcopy (const char *from, char *to, int size)
static struct glyph_matrix *
new_glyph_matrix (struct glyph_pool *pool)
{
- struct glyph_matrix *result;
-
- /* Allocate and clear. */
- result = (struct glyph_matrix *) xmalloc (sizeof *result);
- memset (result, 0, sizeof *result);
+ struct glyph_matrix *result = xzalloc (sizeof *result);
/* Increment number of allocated matrices. This count is used
to detect memory leaks. */
@@ -391,7 +342,7 @@ free_glyph_matrix (struct glyph_matrix *matrix)
/* Detect the case that more matrices are freed than were
allocated. */
if (--glyph_matrix_count < 0)
- abort ();
+ emacs_abort ();
/* Free glyph memory if MATRIX owns it. */
if (matrix->pool == NULL)
@@ -429,14 +380,14 @@ margin_glyphs_to_reserve (struct window *w, int total_glyphs, Lisp_Object margin
return n;
}
-#if XASSERTS
-/* Return non-zero if ROW's hash value is correct, zero if not. */
-int
+/* Return true if ROW's hash value is correct.
+ Optimized away if ENABLE_CHECKING is not defined. */
+
+static bool
verify_row_hash (struct glyph_row *row)
{
return row->hash == row_hash (row);
}
-#endif
/* Adjust glyph matrix MATRIX on window W or on a frame to changed
window sizes.
@@ -465,9 +416,9 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
{
int i;
int new_rows;
- int marginal_areas_changed_p = 0;
- int header_line_changed_p = 0;
- int header_line_p = 0;
+ bool marginal_areas_changed_p = 0;
+ bool header_line_changed_p = 0;
+ bool header_line_p = 0;
int left = -1, right = -1;
int window_width = -1, window_height = -1;
@@ -490,7 +441,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
{
left = margin_glyphs_to_reserve (w, dim.width, w->left_margin_cols);
right = margin_glyphs_to_reserve (w, dim.width, w->right_margin_cols);
- xassert (left >= 0 && right >= 0);
+ eassert (left >= 0 && right >= 0);
marginal_areas_changed_p = (left != matrix->left_margin_glyphs
|| right != matrix->right_margin_glyphs);
@@ -523,7 +474,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
each row into the glyph pool. */
if (matrix->pool)
{
- xassert (matrix->pool->glyphs);
+ eassert (matrix->pool->glyphs);
if (w)
{
@@ -612,14 +563,14 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
}
}
- xassert (left >= 0 && right >= 0);
+ eassert (left >= 0 && right >= 0);
matrix->left_margin_glyphs = left;
matrix->right_margin_glyphs = right;
}
/* Number of rows to be used by MATRIX. */
matrix->nrows = dim.height;
- xassert (matrix->nrows >= 0);
+ eassert (matrix->nrows >= 0);
if (w)
{
@@ -655,7 +606,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
are invalidated below. */
if (INTEGERP (w->window_end_vpos)
&& XFASTINT (w->window_end_vpos) >= i)
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
while (i < matrix->nrows)
matrix->rows[i++].enabled_p = 0;
@@ -758,42 +709,40 @@ rotate_matrix (struct glyph_matrix *matrix, int first, int last, int by)
void
increment_matrix_positions (struct glyph_matrix *matrix, int start, int end,
- EMACS_INT delta, EMACS_INT delta_bytes)
+ ptrdiff_t delta, ptrdiff_t delta_bytes)
{
/* Check that START and END are reasonable values. */
- xassert (start >= 0 && start <= matrix->nrows);
- xassert (end >= 0 && end <= matrix->nrows);
- xassert (start <= end);
+ eassert (start >= 0 && start <= matrix->nrows);
+ eassert (end >= 0 && end <= matrix->nrows);
+ eassert (start <= end);
for (; start < end; ++start)
increment_row_positions (matrix->rows + start, delta, delta_bytes);
}
-/* Enable a range of rows in glyph matrix MATRIX. START and END are
- the row indices of the first and last + 1 row to enable. If
- ENABLED_P is non-zero, enabled_p flags in rows will be set to 1. */
+/* Clear the enable_p flags in a range of rows in glyph matrix MATRIX.
+ START and END are the row indices of the first and last + 1 row to clear. */
void
-enable_glyph_matrix_rows (struct glyph_matrix *matrix, int start, int end, int enabled_p)
+clear_glyph_matrix_rows (struct glyph_matrix *matrix, int start, int end)
{
- xassert (start <= end);
- xassert (start >= 0 && start < matrix->nrows);
- xassert (end >= 0 && end <= matrix->nrows);
+ eassert (start <= end);
+ eassert (start >= 0 && start < matrix->nrows);
+ eassert (end >= 0 && end <= matrix->nrows);
for (; start < end; ++start)
- matrix->rows[start].enabled_p = enabled_p != 0;
+ matrix->rows[start].enabled_p = 0;
}
/* Clear MATRIX.
- This empties all rows in MATRIX by setting the enabled_p flag for
- all rows of the matrix to zero. The function prepare_desired_row
- will eventually really clear a row when it sees one with a zero
- enabled_p flag.
+ Empty all rows in MATRIX by clearing their enabled_p flags.
+ The function prepare_desired_row will eventually really clear a row
+ when it sees one with a false enabled_p flag.
- Resets update hints to defaults value. The only update hint
+ Reset update hints to default values. The only update hint
currently present is the flag MATRIX->no_scrolling_p. */
void
@@ -801,7 +750,7 @@ clear_glyph_matrix (struct glyph_matrix *matrix)
{
if (matrix)
{
- enable_glyph_matrix_rows (matrix, 0, matrix->nrows, 0);
+ clear_glyph_matrix_rows (matrix, 0, matrix->nrows);
matrix->no_scrolling_p = 0;
}
}
@@ -816,9 +765,9 @@ shift_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int start, in
{
int min_y, max_y;
- xassert (start <= end);
- xassert (start >= 0 && start < matrix->nrows);
- xassert (end >= 0 && end <= matrix->nrows);
+ eassert (start <= end);
+ eassert (start >= 0 && start < matrix->nrows);
+ eassert (end >= 0 && end <= matrix->nrows);
min_y = WINDOW_HEADER_LINE_HEIGHT (w);
max_y = WINDOW_BOX_HEIGHT_NO_MODE_LINE (w);
@@ -862,7 +811,7 @@ clear_current_matrices (register struct frame *f)
clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
/* Clear current window matrices. */
- xassert (WINDOWP (FRAME_ROOT_WINDOW (f)));
+ eassert (WINDOWP (FRAME_ROOT_WINDOW (f)));
clear_window_matrices (XWINDOW (FRAME_ROOT_WINDOW (f)), 0);
}
@@ -882,27 +831,27 @@ clear_desired_matrices (register struct frame *f)
clear_glyph_matrix (XWINDOW (f->tool_bar_window)->desired_matrix);
/* Do it for window matrices. */
- xassert (WINDOWP (FRAME_ROOT_WINDOW (f)));
+ eassert (WINDOWP (FRAME_ROOT_WINDOW (f)));
clear_window_matrices (XWINDOW (FRAME_ROOT_WINDOW (f)), 1);
}
-/* Clear matrices in window tree rooted in W. If DESIRED_P is
- non-zero clear desired matrices, otherwise clear current matrices. */
+/* Clear matrices in window tree rooted in W. If DESIRED_P,
+ clear desired matrices, otherwise clear current matrices. */
static void
-clear_window_matrices (struct window *w, int desired_p)
+clear_window_matrices (struct window *w, bool desired_p)
{
while (w)
{
if (!NILP (w->hchild))
{
- xassert (WINDOWP (w->hchild));
+ eassert (WINDOWP (w->hchild));
clear_window_matrices (XWINDOW (w->hchild), desired_p);
}
else if (!NILP (w->vchild))
{
- xassert (WINDOWP (w->vchild));
+ eassert (WINDOWP (w->vchild));
clear_window_matrices (XWINDOW (w->vchild), desired_p);
}
else
@@ -912,7 +861,7 @@ clear_window_matrices (struct window *w, int desired_p)
else
{
clear_glyph_matrix (w->current_matrix);
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
}
}
@@ -1000,7 +949,7 @@ blank_row (struct window *w, struct glyph_row *row, int y)
static void
increment_row_positions (struct glyph_row *row,
- EMACS_INT delta, EMACS_INT delta_bytes)
+ ptrdiff_t delta, ptrdiff_t delta_bytes)
{
int area, i;
@@ -1076,7 +1025,7 @@ swap_glyphs_in_rows (struct glyph_row *a, struct glyph_row *b)
these should all go together for the row's hash value to be
correct. */
-static inline void
+static void
swap_glyph_pointers (struct glyph_row *a, struct glyph_row *b)
{
int i;
@@ -1085,12 +1034,16 @@ swap_glyph_pointers (struct glyph_row *a, struct glyph_row *b)
for (i = 0; i < LAST_AREA + 1; ++i)
{
struct glyph *temp = a->glyphs[i];
- short used_tem = a->used[i];
a->glyphs[i] = b->glyphs[i];
b->glyphs[i] = temp;
- a->used[i] = b->used[i];
- b->used[i] = used_tem;
+ if (i < LAST_AREA)
+ {
+ short used_tem = a->used[i];
+
+ a->used[i] = b->used[i];
+ b->used[i] = used_tem;
+ }
}
a->hash = b->hash;
b->hash = hash_tem;
@@ -1101,11 +1054,11 @@ swap_glyph_pointers (struct glyph_row *a, struct glyph_row *b)
that glyph pointers, the `used' counts, and the hash values in the
structures are left unchanged. */
-static inline void
+static void
copy_row_except_pointers (struct glyph_row *to, struct glyph_row *from)
{
struct glyph *pointers[1 + LAST_AREA];
- short used[1 + LAST_AREA];
+ short used[LAST_AREA];
unsigned hashval;
/* Save glyph pointers of TO. */
@@ -1128,7 +1081,7 @@ copy_row_except_pointers (struct glyph_row *to, struct glyph_row *from)
exchanged between TO and FROM. Pointers must be exchanged to avoid
a memory leak. */
-static inline void
+static void
assign_row (struct glyph_row *to, struct glyph_row *from)
{
swap_glyph_pointers (to, from);
@@ -1139,12 +1092,12 @@ assign_row (struct glyph_row *to, struct glyph_row *from)
/* Test whether the glyph memory of the glyph row WINDOW_ROW, which is
a row in a window matrix, is a slice of the glyph memory of the
glyph row FRAME_ROW which is a row in a frame glyph matrix. Value
- is non-zero if the glyph memory of WINDOW_ROW is part of the glyph
+ is true if the glyph memory of WINDOW_ROW is part of the glyph
memory of FRAME_ROW. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
-static int
+static bool
glyph_row_slice_p (struct glyph_row *window_row, struct glyph_row *frame_row)
{
struct glyph *window_glyph_start = window_row->glyphs[0];
@@ -1169,7 +1122,7 @@ find_glyph_row_slice (struct glyph_matrix *window_matrix,
{
int i;
- xassert (row >= 0 && row < frame_matrix->nrows);
+ eassert (row >= 0 && row < frame_matrix->nrows);
for (i = 0; i < window_matrix->nrows; ++i)
if (glyph_row_slice_p (window_matrix->rows + i,
@@ -1191,7 +1144,7 @@ prepare_desired_row (struct glyph_row *row)
{
if (!row->enabled_p)
{
- int rp = row->reversed_p;
+ bool rp = row->reversed_p;
clear_glyph_row (row);
row->enabled_p = 1;
@@ -1290,15 +1243,14 @@ line_draw_cost (struct glyph_matrix *matrix, int vpos)
}
-/* Test two glyph rows A and B for equality. Value is non-zero if A
- and B have equal contents. MOUSE_FACE_P non-zero means compare the
- mouse_face_p flags of A and B, too. */
+/* Return true if the glyph rows A and B have equal contents.
+ MOUSE_FACE_P means compare the mouse_face_p flags of A and B, too. */
-static inline int
-row_equal_p (struct glyph_row *a, struct glyph_row *b, int mouse_face_p)
+static bool
+row_equal_p (struct glyph_row *a, struct glyph_row *b, bool mouse_face_p)
{
- xassert (verify_row_hash (a));
- xassert (verify_row_hash (b));
+ eassert (verify_row_hash (a));
+ eassert (verify_row_hash (b));
if (a == b)
return 1;
@@ -1373,11 +1325,7 @@ row_equal_p (struct glyph_row *a, struct glyph_row *b, int mouse_face_p)
static struct glyph_pool *
new_glyph_pool (void)
{
- struct glyph_pool *result;
-
- /* Allocate a new glyph_pool and clear it. */
- result = (struct glyph_pool *) xmalloc (sizeof *result);
- memset (result, 0, sizeof *result);
+ struct glyph_pool *result = xzalloc (sizeof *result);
/* For memory leak and double deletion checking. */
++glyph_pool_count;
@@ -1400,7 +1348,7 @@ free_glyph_pool (struct glyph_pool *pool)
{
/* More freed than allocated? */
--glyph_pool_count;
- xassert (glyph_pool_count >= 0);
+ eassert (glyph_pool_count >= 0);
xfree (pool->glyphs);
xfree (pool);
@@ -1414,14 +1362,14 @@ free_glyph_pool (struct glyph_pool *pool)
is changed from a large value to a smaller one. But, if someone
does it once, we can expect that he will do it again.
- Value is non-zero if the pool changed in a way which makes
+ Return true if the pool changed in a way which makes
re-adjusting window glyph matrices necessary. */
-static int
+static bool
realloc_glyph_pool (struct glyph_pool *pool, struct dim matrix_dim)
{
ptrdiff_t needed;
- int changed_p;
+ bool changed_p;
changed_p = (pool->glyphs == 0
|| matrix_dim.height != pool->nrows
@@ -1457,7 +1405,7 @@ realloc_glyph_pool (struct glyph_pool *pool, struct dim matrix_dim)
Debug Code
***********************************************************************/
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Flush standard output. This is sometimes useful to call from the debugger.
@@ -1486,7 +1434,7 @@ check_matrix_pointer_lossage (struct glyph_matrix *matrix)
for (i = 0; i < matrix->nrows; ++i)
for (j = 0; j < matrix->nrows; ++j)
- xassert (i == j
+ eassert (i == j
|| (matrix->rows[i].glyphs[TEXT_AREA]
!= matrix->rows[j].glyphs[TEXT_AREA]));
}
@@ -1497,8 +1445,8 @@ check_matrix_pointer_lossage (struct glyph_matrix *matrix)
struct glyph_row *
matrix_row (struct glyph_matrix *matrix, int row)
{
- xassert (matrix && matrix->rows);
- xassert (row >= 0 && row < matrix->nrows);
+ eassert (matrix && matrix->rows);
+ eassert (row >= 0 && row < matrix->nrows);
/* That's really too slow for normal testing because this function
is called almost everywhere. Although---it's still astonishingly
@@ -1545,9 +1493,9 @@ check_matrix_invariants (struct window *w)
last_text_row = row;
/* Check that character and byte positions are in sync. */
- xassert (MATRIX_ROW_START_BYTEPOS (row)
+ eassert (MATRIX_ROW_START_BYTEPOS (row)
== CHAR_TO_BYTE (MATRIX_ROW_START_CHARPOS (row)));
- xassert (BYTEPOS (row->start.pos)
+ eassert (BYTEPOS (row->start.pos)
== CHAR_TO_BYTE (CHARPOS (row->start.pos)));
/* CHAR_TO_BYTE aborts when invoked for a position > Z. We can
@@ -1555,9 +1503,9 @@ check_matrix_invariants (struct window *w)
displaying something like `[Sole completion]' at its end. */
if (MATRIX_ROW_END_CHARPOS (row) < BUF_ZV (current_buffer))
{
- xassert (MATRIX_ROW_END_BYTEPOS (row)
+ eassert (MATRIX_ROW_END_BYTEPOS (row)
== CHAR_TO_BYTE (MATRIX_ROW_END_CHARPOS (row)));
- xassert (BYTEPOS (row->end.pos)
+ eassert (BYTEPOS (row->end.pos)
== CHAR_TO_BYTE (CHARPOS (row->end.pos)));
}
@@ -1565,24 +1513,24 @@ check_matrix_invariants (struct window *w)
of next row. */
if (next->enabled_p && MATRIX_ROW_DISPLAYS_TEXT_P (next))
{
- xassert (MATRIX_ROW_END_CHARPOS (row)
+ eassert (MATRIX_ROW_END_CHARPOS (row)
== MATRIX_ROW_START_CHARPOS (next));
- xassert (MATRIX_ROW_END_BYTEPOS (row)
+ eassert (MATRIX_ROW_END_BYTEPOS (row)
== MATRIX_ROW_START_BYTEPOS (next));
- xassert (CHARPOS (row->end.pos) == CHARPOS (next->start.pos));
- xassert (BYTEPOS (row->end.pos) == BYTEPOS (next->start.pos));
+ eassert (CHARPOS (row->end.pos) == CHARPOS (next->start.pos));
+ eassert (BYTEPOS (row->end.pos) == BYTEPOS (next->start.pos));
}
row = next;
}
- xassert (w->current_matrix->nrows == w->desired_matrix->nrows);
- xassert (w->desired_matrix->rows != NULL);
+ eassert (w->current_matrix->nrows == w->desired_matrix->nrows);
+ eassert (w->desired_matrix->rows != NULL);
set_buffer_temp (saved);
}
#endif /* 0 */
-#endif /* GLYPH_DEBUG != 0 */
+#endif /* GLYPH_DEBUG */
@@ -1595,7 +1543,7 @@ check_matrix_invariants (struct window *w)
X and Y are column/row within the frame glyph matrix where
sub-matrices for the window tree rooted at WINDOW must be
- allocated. DIM_ONLY_P non-zero means that the caller of this
+ allocated. DIM_ONLY_P means that the caller of this
function is only interested in the result matrix dimension, and
matrix adjustments should not be performed.
@@ -1672,7 +1620,7 @@ check_matrix_invariants (struct window *w)
static struct dim
allocate_matrices_for_frame_redisplay (Lisp_Object window, int x, int y,
- int dim_only_p, int *window_change_flags)
+ bool dim_only_p, int *window_change_flags)
{
struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
int x0 = x, y0 = y;
@@ -1680,7 +1628,7 @@ allocate_matrices_for_frame_redisplay (Lisp_Object window, int x, int y,
struct dim total;
struct dim dim;
struct window *w;
- int in_horz_combination_p;
+ bool in_horz_combination_p;
/* What combination is WINDOW part of? Compute this once since the
result is the same for all windows in the `next' chain. The
@@ -1738,7 +1686,7 @@ allocate_matrices_for_frame_redisplay (Lisp_Object window, int x, int y,
/* Actually change matrices, if allowed. Do not consider
CHANGED_LEAF_MATRIX computed above here because the pool
may have been changed which we don't now here. We trust
- that we only will be called with DIM_ONLY_P != 0 when
+ that we only will be called with DIM_ONLY_P when
necessary. */
if (!dim_only_p)
{
@@ -1883,7 +1831,7 @@ adjust_glyphs (struct frame *f)
{
/* Block input so that expose events and other events that access
glyph matrices are not processed while we are changing them. */
- BLOCK_INPUT;
+ block_input ();
if (f)
adjust_frame_glyphs (f);
@@ -1895,46 +1843,9 @@ adjust_glyphs (struct frame *f)
adjust_frame_glyphs (XFRAME (lisp_frame));
}
- UNBLOCK_INPUT;
-}
-
-
-/* Adjust frame glyphs when Emacs is initialized.
-
- To be called from init_display.
-
- We need a glyph matrix because redraw will happen soon.
- Unfortunately, window sizes on selected_frame are not yet set to
- meaningful values. I believe we can assume that there are only two
- windows on the frame---the mini-buffer and the root window. Frame
- height and width seem to be correct so far. So, set the sizes of
- windows to estimated values. */
-
-static void
-adjust_frame_glyphs_initially (void)
-{
- struct frame *sf = SELECTED_FRAME ();
- struct window *root = XWINDOW (sf->root_window);
- struct window *mini = XWINDOW (root->next);
- int frame_lines = FRAME_LINES (sf);
- int frame_cols = FRAME_COLS (sf);
- int top_margin = FRAME_TOP_MARGIN (sf);
-
- /* Do it for the root window. */
- XSETFASTINT (root->top_line, top_margin);
- XSETFASTINT (root->total_lines, frame_lines - 1 - top_margin);
- XSETFASTINT (root->total_cols, frame_cols);
-
- /* Do it for the mini-buffer window. */
- XSETFASTINT (mini->top_line, frame_lines - 1);
- XSETFASTINT (mini->total_lines, 1);
- XSETFASTINT (mini->total_cols, frame_cols);
-
- adjust_frame_glyphs (sf);
- glyphs_initialized_initially_p = 1;
+ unblock_input ();
}
-
/* Allocate/reallocate glyph matrices of a single frame F. */
static void
@@ -1953,9 +1864,9 @@ adjust_frame_glyphs (struct frame *f)
f->glyphs_initialized_p = 1;
}
-/* Return 1 if any window in the tree has nonzero window margins. See
+/* Return true if any window in the tree has nonzero window margins. See
the hack at the end of adjust_frame_glyphs_for_frame_redisplay. */
-static int
+static bool
showing_window_margins_p (struct window *w)
{
while (w)
@@ -2003,15 +1914,15 @@ fake_current_matrices (Lisp_Object window)
struct glyph_matrix *m = w->current_matrix;
struct glyph_matrix *fm = f->current_matrix;
- xassert (m->matrix_h == WINDOW_TOTAL_LINES (w));
- xassert (m->matrix_w == WINDOW_TOTAL_COLS (w));
+ eassert (m->matrix_h == WINDOW_TOTAL_LINES (w));
+ eassert (m->matrix_w == WINDOW_TOTAL_COLS (w));
for (i = 0; i < m->matrix_h; ++i)
{
struct glyph_row *r = m->rows + i;
struct glyph_row *fr = fm->rows + i + WINDOW_TOP_EDGE_LINE (w);
- xassert (r->glyphs[TEXT_AREA] >= fr->glyphs[TEXT_AREA]
+ eassert (r->glyphs[TEXT_AREA] >= fr->glyphs[TEXT_AREA]
&& r->glyphs[LAST_AREA] <= fr->glyphs[LAST_AREA]);
r->enabled_p = fr->enabled_p;
@@ -2037,21 +1948,16 @@ static struct glyph_matrix *
save_current_matrix (struct frame *f)
{
int i;
- struct glyph_matrix *saved;
-
- saved = (struct glyph_matrix *) xmalloc (sizeof *saved);
- memset (saved, 0, sizeof *saved);
+ struct glyph_matrix *saved = xzalloc (sizeof *saved);
saved->nrows = f->current_matrix->nrows;
- saved->rows = (struct glyph_row *) xmalloc (saved->nrows
- * sizeof *saved->rows);
- memset (saved->rows, 0, saved->nrows * sizeof *saved->rows);
+ saved->rows = xzalloc (saved->nrows * sizeof *saved->rows);
for (i = 0; i < saved->nrows; ++i)
{
struct glyph_row *from = f->current_matrix->rows + i;
struct glyph_row *to = saved->rows + i;
ptrdiff_t nbytes = from->used[TEXT_AREA] * sizeof (struct glyph);
- to->glyphs[TEXT_AREA] = (struct glyph *) xmalloc (nbytes);
+ to->glyphs[TEXT_AREA] = xmalloc (nbytes);
memcpy (to->glyphs[TEXT_AREA], from->glyphs[TEXT_AREA], nbytes);
to->used[TEXT_AREA] = from->used[TEXT_AREA];
}
@@ -2091,7 +1997,7 @@ static void
adjust_frame_glyphs_for_frame_redisplay (struct frame *f)
{
struct dim matrix_dim;
- int pool_changed_p;
+ bool pool_changed_p;
int window_change_flags;
int top_window_y;
@@ -2146,7 +2052,7 @@ adjust_frame_glyphs_for_frame_redisplay (struct frame *f)
/* Size of frame matrices must equal size of frame. Note
that we are called for X frames with window widths NOT equal
to the frame width (from CHANGE_FRAME_SIZE_1). */
- xassert (matrix_dim.width == FRAME_COLS (f)
+ eassert (matrix_dim.width == FRAME_COLS (f)
&& matrix_dim.height == FRAME_LINES (f));
/* Pointers to glyph memory in glyph rows are exchanged during
@@ -2190,7 +2096,7 @@ adjust_frame_glyphs_for_frame_redisplay (struct frame *f)
static void
adjust_frame_glyphs_for_window_redisplay (struct frame *f)
{
- xassert (FRAME_WINDOW_P (f) && FRAME_LIVE_P (f));
+ eassert (FRAME_WINDOW_P (f) && FRAME_LIVE_P (f));
/* Allocate/reallocate window matrices. */
allocate_matrices_for_window_redisplay (XWINDOW (FRAME_ROOT_WINDOW (f)));
@@ -2204,9 +2110,11 @@ adjust_frame_glyphs_for_window_redisplay (struct frame *f)
struct window *w;
if (NILP (f->menu_bar_window))
{
- f->menu_bar_window = make_window ();
+ Lisp_Object frame;
+ fset_menu_bar_window (f, make_window ());
w = XWINDOW (f->menu_bar_window);
- XSETFRAME (w->frame, f);
+ XSETFRAME (frame, f);
+ wset_frame (w, frame);
w->pseudo_window_p = 1;
}
else
@@ -2214,10 +2122,10 @@ adjust_frame_glyphs_for_window_redisplay (struct frame *f)
/* Set window dimensions to frame dimensions and allocate or
adjust glyph matrices of W. */
- XSETFASTINT (w->top_line, 0);
- XSETFASTINT (w->left_col, 0);
- XSETFASTINT (w->total_lines, FRAME_MENU_BAR_LINES (f));
- XSETFASTINT (w->total_cols, FRAME_TOTAL_COLS (f));
+ wset_top_line (w, make_number (0));
+ wset_left_col (w, make_number (0));
+ wset_total_lines (w, make_number (FRAME_MENU_BAR_LINES (f)));
+ wset_total_cols (w, make_number (FRAME_TOTAL_COLS (f)));
allocate_matrices_for_window_redisplay (w);
}
#endif /* not USE_X_TOOLKIT && not USE_GTK */
@@ -2230,18 +2138,20 @@ adjust_frame_glyphs_for_window_redisplay (struct frame *f)
struct window *w;
if (NILP (f->tool_bar_window))
{
- f->tool_bar_window = make_window ();
+ Lisp_Object frame;
+ fset_tool_bar_window (f, make_window ());
w = XWINDOW (f->tool_bar_window);
- XSETFRAME (w->frame, f);
+ XSETFRAME (frame, f);
+ wset_frame (w, frame);
w->pseudo_window_p = 1;
}
else
w = XWINDOW (f->tool_bar_window);
- XSETFASTINT (w->top_line, FRAME_MENU_BAR_LINES (f));
- XSETFASTINT (w->left_col, 0);
- XSETFASTINT (w->total_lines, FRAME_TOOL_BAR_LINES (f));
- XSETFASTINT (w->total_cols, FRAME_TOTAL_COLS (f));
+ wset_top_line (w, make_number (FRAME_MENU_BAR_LINES (f)));
+ wset_left_col (w, make_number (0));
+ wset_total_lines (w, make_number (FRAME_TOOL_BAR_LINES (f)));
+ wset_total_cols (w, make_number (FRAME_TOTAL_COLS (f)));
allocate_matrices_for_window_redisplay (w);
}
#endif
@@ -2260,16 +2170,8 @@ adjust_frame_glyphs_for_window_redisplay (struct frame *f)
static void
adjust_frame_message_buffer (struct frame *f)
{
- ptrdiff_t size = FRAME_MESSAGE_BUF_SIZE (f) + 1;
-
- if (FRAME_MESSAGE_BUF (f))
- {
- char *buffer = FRAME_MESSAGE_BUF (f);
- char *new_buffer = (char *) xrealloc (buffer, size);
- FRAME_MESSAGE_BUF (f) = new_buffer;
- }
- else
- FRAME_MESSAGE_BUF (f) = (char *) xmalloc (size);
+ FRAME_MESSAGE_BUF (f) = xrealloc (FRAME_MESSAGE_BUF (f),
+ FRAME_MESSAGE_BUF_SIZE (f) + 1);
}
@@ -2278,9 +2180,8 @@ adjust_frame_message_buffer (struct frame *f)
static void
adjust_decode_mode_spec_buffer (struct frame *f)
{
- f->decode_mode_spec_buffer
- = (char *) xrealloc (f->decode_mode_spec_buffer,
- FRAME_MESSAGE_BUF_SIZE (f) + 1);
+ f->decode_mode_spec_buffer = xrealloc (f->decode_mode_spec_buffer,
+ FRAME_MESSAGE_BUF_SIZE (f) + 1);
}
@@ -2301,7 +2202,7 @@ free_glyphs (struct frame *f)
{
/* Block interrupt input so that we don't get surprised by an X
event while we're in an inconsistent state. */
- BLOCK_INPUT;
+ block_input ();
f->glyphs_initialized_p = 0;
/* Release window sub-matrices. */
@@ -2316,7 +2217,7 @@ free_glyphs (struct frame *f)
free_glyph_matrix (w->desired_matrix);
free_glyph_matrix (w->current_matrix);
w->desired_matrix = w->current_matrix = NULL;
- f->menu_bar_window = Qnil;
+ fset_menu_bar_window (f, Qnil);
}
/* Free the tool bar window and its glyph matrices. */
@@ -2326,7 +2227,7 @@ free_glyphs (struct frame *f)
free_glyph_matrix (w->desired_matrix);
free_glyph_matrix (w->current_matrix);
w->desired_matrix = w->current_matrix = NULL;
- f->tool_bar_window = Qnil;
+ fset_tool_bar_window (f, Qnil);
}
/* Release frame glyph matrices. Reset fields to zero in
@@ -2346,7 +2247,7 @@ free_glyphs (struct frame *f)
f->desired_pool = f->current_pool = NULL;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -2396,9 +2297,9 @@ check_glyph_memory (void)
/* Check that nothing is left allocated. */
if (glyph_matrix_count)
- abort ();
+ emacs_abort ();
if (glyph_pool_count)
- abort ();
+ emacs_abort ();
}
@@ -2475,7 +2376,7 @@ build_frame_matrix (struct frame *f)
int i;
/* F must have a frame matrix when this function is called. */
- xassert (!FRAME_WINDOW_P (f));
+ eassert (!FRAME_WINDOW_P (f));
/* Clear all rows in the frame matrix covered by window matrices.
Menu bar lines are not covered by windows. */
@@ -2512,7 +2413,7 @@ build_frame_matrix_from_window_tree (struct glyph_matrix *matrix, struct window
desired frame matrix built. W is a leaf window whose desired or
current matrix is to be added to FRAME_MATRIX. W's flag
must_be_updated_p determines which matrix it contributes to
- FRAME_MATRIX. If must_be_updated_p is non-zero, W's desired matrix
+ FRAME_MATRIX. If W->must_be_updated_p, W's desired matrix
is added to FRAME_MATRIX, otherwise W's current matrix is added.
Adding a desired matrix means setting up used counters and such in
frame rows, while adding a current window matrix to FRAME_MATRIX
@@ -2542,8 +2443,7 @@ build_frame_matrix_from_leaf_window (struct glyph_matrix *frame_matrix, struct w
SET_GLYPH_FROM_CHAR (right_border_glyph, '|');
if (dp
- && (gc = DISP_BORDER_GLYPH (dp), GLYPH_CODE_P (gc))
- && GLYPH_CODE_CHAR_VALID_P (gc))
+ && (gc = DISP_BORDER_GLYPH (dp), GLYPH_CODE_P (gc)))
{
SET_GLYPH_FROM_GLYPH_CODE (right_border_glyph, gc);
spec_glyph_lookup_face (w, &right_border_glyph);
@@ -2564,7 +2464,7 @@ build_frame_matrix_from_leaf_window (struct glyph_matrix *frame_matrix, struct w
{
struct glyph_row *frame_row = frame_matrix->rows + frame_y;
struct glyph_row *window_row = window_matrix->rows + window_y;
- int current_row_p = window_matrix == w->current_matrix;
+ bool current_row_p = window_matrix == w->current_matrix;
/* Fill up the frame row with spaces up to the left margin of the
window row. */
@@ -2592,7 +2492,7 @@ build_frame_matrix_from_leaf_window (struct glyph_matrix *frame_matrix, struct w
}
else
{
- xassert (window_row->enabled_p);
+ eassert (window_row->enabled_p);
/* Only when a desired row has been displayed, we want
the corresponding frame row to be updated. */
@@ -2606,10 +2506,10 @@ build_frame_matrix_from_leaf_window (struct glyph_matrix *frame_matrix, struct w
SET_CHAR_GLYPH_FROM_GLYPH (*border, right_border_glyph);
}
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Window row window_y must be a slice of frame row
frame_y. */
- xassert (glyph_row_slice_p (window_row, frame_row));
+ eassert (glyph_row_slice_p (window_row, frame_row));
/* If rows are in sync, we don't have to copy glyphs because
frame and window share glyphs. */
@@ -2717,7 +2617,7 @@ fill_up_frame_row_with_spaces (struct glyph_row *row, int upto)
function must be called before updates to make explicit that we are
working on frame matrices or not. */
-static inline void
+static void
set_frame_matrix_frame (struct frame *f)
{
frame_matrix_frame = f;
@@ -2732,12 +2632,12 @@ set_frame_matrix_frame (struct frame *f)
done in frame matrices, and that we have to perform analogous
operations in window matrices of frame_matrix_frame. */
-static inline void
+static void
make_current (struct glyph_matrix *desired_matrix, struct glyph_matrix *current_matrix, int row)
{
struct glyph_row *current_row = MATRIX_ROW (current_matrix, row);
struct glyph_row *desired_row = MATRIX_ROW (desired_matrix, row);
- int mouse_face_p = current_row->mouse_face_p;
+ bool mouse_face_p = current_row->mouse_face_p;
/* Do current_row = desired_row. This exchanges glyph pointers
between both rows, and does a structure assignment otherwise. */
@@ -2828,16 +2728,16 @@ mirrored_line_dance (struct glyph_matrix *matrix, int unchanged_at_top, int nlin
int i;
/* Make a copy of the original rows. */
- old_rows = (struct glyph_row *) alloca (nlines * sizeof *old_rows);
+ old_rows = alloca (nlines * sizeof *old_rows);
memcpy (old_rows, new_rows, nlines * sizeof *old_rows);
/* Assign new rows, maybe clear lines. */
for (i = 0; i < nlines; ++i)
{
- int enabled_before_p = new_rows[i].enabled_p;
+ bool enabled_before_p = new_rows[i].enabled_p;
- xassert (i + unchanged_at_top < matrix->nrows);
- xassert (unchanged_at_top + copy_from[i] < matrix->nrows);
+ eassert (i + unchanged_at_top < matrix->nrows);
+ eassert (unchanged_at_top + copy_from[i] < matrix->nrows);
new_rows[i] = old_rows[copy_from[i]];
new_rows[i].enabled_p = enabled_before_p;
@@ -2864,8 +2764,8 @@ sync_window_with_frame_matrix_rows (struct window *w)
int left, right, x, width;
/* Preconditions: W must be a leaf window on a tty frame. */
- xassert (NILP (w->hchild) && NILP (w->vchild));
- xassert (!FRAME_WINDOW_P (f));
+ eassert (NILP (w->hchild) && NILP (w->vchild));
+ eassert (!FRAME_WINDOW_P (f));
left = margin_glyphs_to_reserve (w, 1, w->left_margin_cols);
right = margin_glyphs_to_reserve (w, 1, w->right_margin_cols);
@@ -2942,11 +2842,12 @@ mirror_line_dance (struct window *w, int unchanged_at_top, int nlines, int *copy
/* W is a leaf window, and we are working on its current
matrix m. */
struct glyph_matrix *m = w->current_matrix;
- int i, sync_p = 0;
+ int i;
+ bool sync_p = 0;
struct glyph_row *old_rows;
/* Make a copy of the original rows of matrix m. */
- old_rows = (struct glyph_row *) alloca (m->nrows * sizeof *old_rows);
+ old_rows = alloca (m->nrows * sizeof *old_rows);
memcpy (old_rows, m->rows, m->nrows * sizeof *old_rows);
for (i = 0; i < nlines; ++i)
@@ -2964,22 +2865,19 @@ mirror_line_dance (struct window *w, int unchanged_at_top, int nlines, int *copy
int window_from = frame_from - m->matrix_y;
/* Is assigned line inside window? */
- int from_inside_window_p
+ bool from_inside_window_p
= window_from >= 0 && window_from < m->matrix_h;
/* Is assigned to line inside window? */
- int to_inside_window_p
+ bool to_inside_window_p
= window_to >= 0 && window_to < m->matrix_h;
if (from_inside_window_p && to_inside_window_p)
{
- /* Enabled setting before assignment. */
- int enabled_before_p;
-
/* Do the assignment. The enabled_p flag is saved
over the assignment because the old redisplay did
that. */
- enabled_before_p = m->rows[window_to].enabled_p;
+ bool enabled_before_p = m->rows[window_to].enabled_p;
m->rows[window_to] = old_rows[window_from];
m->rows[window_to].enabled_p = enabled_before_p;
@@ -3033,7 +2931,7 @@ mirror_line_dance (struct window *w, int unchanged_at_top, int nlines, int *copy
}
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check that window and frame matrices agree about their
understanding where glyphs of the rows are to find. For each
@@ -3084,12 +2982,12 @@ check_matrix_pointers (struct glyph_matrix *window_matrix,
{
if (!glyph_row_slice_p (window_matrix->rows + i,
frame_matrix->rows + j))
- abort ();
+ emacs_abort ();
++i, ++j;
}
}
-#endif /* GLYPH_DEBUG != 0 */
+#endif /* GLYPH_DEBUG */
@@ -3097,7 +2995,7 @@ check_matrix_pointers (struct glyph_matrix *window_matrix,
VPOS and HPOS translations
**********************************************************************/
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Translate vertical position VPOS which is relative to window W to a
vertical position relative to W's frame. */
@@ -3105,10 +3003,10 @@ check_matrix_pointers (struct glyph_matrix *window_matrix,
static int
window_to_frame_vpos (struct window *w, int vpos)
{
- xassert (!FRAME_WINDOW_P (XFRAME (w->frame)));
- xassert (vpos >= 0 && vpos <= w->desired_matrix->nrows);
+ eassert (!FRAME_WINDOW_P (XFRAME (w->frame)));
+ eassert (vpos >= 0 && vpos <= w->desired_matrix->nrows);
vpos += WINDOW_TOP_EDGE_LINE (w);
- xassert (vpos >= 0 && vpos <= FRAME_LINES (XFRAME (w->frame)));
+ eassert (vpos >= 0 && vpos <= FRAME_LINES (XFRAME (w->frame)));
return vpos;
}
@@ -3119,7 +3017,7 @@ window_to_frame_vpos (struct window *w, int vpos)
static int
window_to_frame_hpos (struct window *w, int hpos)
{
- xassert (!FRAME_WINDOW_P (XFRAME (w->frame)));
+ eassert (!FRAME_WINDOW_P (XFRAME (w->frame)));
hpos += WINDOW_LEFT_EDGE_COL (w);
return hpos;
}
@@ -3132,21 +3030,13 @@ window_to_frame_hpos (struct window *w, int hpos)
Redrawing Frames
**********************************************************************/
-DEFUN ("redraw-frame", Fredraw_frame, Sredraw_frame, 1, 1, 0,
- doc: /* Clear frame FRAME and output again what is supposed to appear on it. */)
- (Lisp_Object frame)
-{
- struct frame *f;
-
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
-
- /* Ignore redraw requests, if frame has no glyphs yet.
- (Implementation note: It still has to be checked why we are
- called so early here). */
- if (!glyphs_initialized_initially_p)
- return Qnil;
+/* Redraw frame F. */
+void
+redraw_frame (struct frame *f)
+{
+ /* Error if F has no glyphs. */
+ eassert (f->glyphs_initialized_p);
update_begin (f);
#ifdef MSDOS
if (FRAME_MSDOS_P (f))
@@ -3163,22 +3053,17 @@ DEFUN ("redraw-frame", Fredraw_frame, Sredraw_frame, 1, 1, 0,
mark_window_display_accurate (FRAME_ROOT_WINDOW (f), 0);
set_window_update_flags (XWINDOW (FRAME_ROOT_WINDOW (f)), 1);
f->garbaged = 0;
- return Qnil;
}
-
-/* Redraw frame F. This is nothing more than a call to the Lisp
- function redraw-frame. */
-
-void
-redraw_frame (struct frame *f)
+DEFUN ("redraw-frame", Fredraw_frame, Sredraw_frame, 0, 1, 0,
+ doc: /* Clear frame FRAME and output again what is supposed to appear on it.
+If FRAME is omitted or nil, the selected frame is used. */)
+ (Lisp_Object frame)
{
- Lisp_Object frame;
- XSETFRAME (frame, f);
- Fredraw_frame (frame);
+ redraw_frame (decode_live_frame (frame));
+ return Qnil;
}
-
DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "",
doc: /* Clear and redisplay all visible frames. */)
(void)
@@ -3187,7 +3072,7 @@ DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "",
FOR_EACH_FRAME (tail, frame)
if (FRAME_VISIBLE_P (XFRAME (frame)))
- Fredraw_frame (frame);
+ redraw_frame (XFRAME (frame));
return Qnil;
}
@@ -3200,29 +3085,25 @@ DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "",
/* Update frame F based on the data in desired matrices.
- If FORCE_P is non-zero, don't let redisplay be stopped by detecting
- pending input. If INHIBIT_HAIRY_ID_P is non-zero, don't try
- scrolling.
+ If FORCE_P, don't let redisplay be stopped by detecting pending input.
+ If INHIBIT_HAIRY_ID_P, don't try scrolling.
- Value is non-zero if redisplay was stopped due to pending input. */
+ Value is true if redisplay was stopped due to pending input. */
-int
-update_frame (struct frame *f, int force_p, int inhibit_hairy_id_p)
+bool
+update_frame (struct frame *f, bool force_p, bool inhibit_hairy_id_p)
{
- /* 1 means display has been paused because of pending input. */
- int paused_p;
+ /* True means display has been paused because of pending input. */
+ bool paused_p;
struct window *root_window = XWINDOW (f->root_window);
if (redisplay_dont_pause)
force_p = 1;
-#if PERIODIC_PREEMPTION_CHECKING
else if (NILP (Vredisplay_preemption_period))
force_p = 1;
else if (!force_p && NUMBERP (Vredisplay_preemption_period))
{
- EMACS_TIME tm;
double p = XFLOATINT (Vredisplay_preemption_period);
- int sec, usec;
if (detect_input_pending_ignore_squeezables ())
{
@@ -3230,14 +3111,10 @@ update_frame (struct frame *f, int force_p, int inhibit_hairy_id_p)
goto do_pause;
}
- sec = (int) p;
- usec = (p - sec) * 1000000;
-
- EMACS_GET_TIME (tm);
- EMACS_SET_SECS_USECS (preemption_period, sec, usec);
- EMACS_ADD_TIME (preemption_next_check, tm, preemption_period);
+ preemption_period = EMACS_TIME_FROM_DOUBLE (p);
+ preemption_next_check = add_emacs_time (current_emacs_time (),
+ preemption_period);
}
-#endif
if (FRAME_WINDOW_P (f))
{
@@ -3272,8 +3149,8 @@ update_frame (struct frame *f, int force_p, int inhibit_hairy_id_p)
/* Swap tool-bar strings. We swap because we want to
reuse strings. */
tem = f->current_tool_bar_string;
- f->current_tool_bar_string = f->desired_tool_bar_string;
- f->desired_tool_bar_string = tem;
+ fset_current_tool_bar_string (f, f->desired_tool_bar_string);
+ fset_desired_tool_bar_string (f, tem);
}
}
@@ -3315,15 +3192,13 @@ update_frame (struct frame *f, int force_p, int inhibit_hairy_id_p)
}
/* Check window matrices for lost pointers. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
check_window_matrix_pointers (root_window);
add_frame_display_history (f, paused_p);
#endif
}
-#if PERIODIC_PREEMPTION_CHECKING
do_pause:
-#endif
/* Reset flags indicating that a window should be updated. */
set_window_update_flags (root_window, 0);
@@ -3337,13 +3212,13 @@ update_frame (struct frame *f, int force_p, int inhibit_hairy_id_p)
Window-based updates
************************************************************************/
-/* Perform updates in window tree rooted at W. FORCE_P non-zero means
- don't stop updating when input is pending. */
+/* Perform updates in window tree rooted at W.
+ If FORCE_P, don't stop updating if input is pending. */
-static int
-update_window_tree (struct window *w, int force_p)
+static bool
+update_window_tree (struct window *w, bool force_p)
{
- int paused_p = 0;
+ bool paused_p = 0;
while (w && !paused_p)
{
@@ -3361,11 +3236,11 @@ update_window_tree (struct window *w, int force_p)
}
-/* Update window W if its flag must_be_updated_p is non-zero. If
- FORCE_P is non-zero, don't stop updating if input is pending. */
+/* Update window W if its flag must_be_updated_p is set.
+ If FORCE_P, don't stop updating if input is pending. */
void
-update_single_window (struct window *w, int force_p)
+update_single_window (struct window *w, bool force_p)
{
if (w->must_be_updated_p)
{
@@ -3376,23 +3251,15 @@ update_single_window (struct window *w, int force_p)
if (redisplay_dont_pause)
force_p = 1;
-#if PERIODIC_PREEMPTION_CHECKING
else if (NILP (Vredisplay_preemption_period))
force_p = 1;
else if (!force_p && NUMBERP (Vredisplay_preemption_period))
{
- EMACS_TIME tm;
double p = XFLOATINT (Vredisplay_preemption_period);
- int sec, usec;
-
- sec = (int) p;
- usec = (p - sec) * 1000000;
-
- EMACS_GET_TIME (tm);
- EMACS_SET_SECS_USECS (preemption_period, sec, usec);
- EMACS_ADD_TIME (preemption_next_check, tm, preemption_period);
+ preemption_period = EMACS_TIME_FROM_DOUBLE (p);
+ preemption_next_check = add_emacs_time (current_emacs_time (),
+ preemption_period);
}
-#endif
/* Update W. */
update_begin (f);
@@ -3522,7 +3389,7 @@ redraw_overlapping_rows (struct window *w, int yb)
static void
check_current_matrix_flags (struct window *w)
{
- int last_seen_p = 0;
+ bool last_seen_p = 0;
int i, yb = window_text_bottom_y (w);
for (i = 0; i < w->current_matrix->nrows - 1; ++i)
@@ -3531,28 +3398,28 @@ check_current_matrix_flags (struct window *w)
if (!last_seen_p && MATRIX_ROW_BOTTOM_Y (row) >= yb)
last_seen_p = 1;
else if (last_seen_p && row->enabled_p)
- abort ();
+ emacs_abort ();
}
}
#endif /* GLYPH_DEBUG */
-/* Update display of window W. FORCE_P non-zero means that we should
- not stop when detecting pending input. */
+/* Update display of window W.
+ If FORCE_P, don't stop updating when input is pending. */
-static int
-update_window (struct window *w, int force_p)
+static bool
+update_window (struct window *w, bool force_p)
{
struct glyph_matrix *desired_matrix = w->desired_matrix;
- int paused_p;
+ bool paused_p;
#if !PERIODIC_PREEMPTION_CHECKING
int preempt_count = baud_rate / 2400 + 1;
#endif
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check that W's frame doesn't have glyph matrices. */
- xassert (FRAME_WINDOW_P (XFRAME (WINDOW_FRAME (w))));
+ eassert (FRAME_WINDOW_P (XFRAME (WINDOW_FRAME (w))));
#endif
/* Check pending input the first time so that we can quickly return. */
@@ -3568,7 +3435,8 @@ update_window (struct window *w, int force_p)
struct glyph_row *row, *end;
struct glyph_row *mode_line_row;
struct glyph_row *header_line_row;
- int yb, changed_p = 0, mouse_face_overwritten_p = 0;
+ int yb;
+ bool changed_p = 0, mouse_face_overwritten_p = 0;
#if ! PERIODIC_PREEMPTION_CHECKING
int n_updated = 0;
#endif
@@ -3638,12 +3506,11 @@ update_window (struct window *w, int force_p)
#if PERIODIC_PREEMPTION_CHECKING
if (!force_p)
{
- EMACS_TIME tm, dif;
- EMACS_GET_TIME (tm);
- EMACS_SUB_TIME (dif, preemption_next_check, tm);
- if (EMACS_TIME_NEG_P (dif))
+ EMACS_TIME tm = current_emacs_time ();
+ if (EMACS_TIME_LT (preemption_next_check, tm))
{
- EMACS_ADD_TIME (preemption_next_check, tm, preemption_period);
+ preemption_next_check = add_emacs_time (tm,
+ preemption_period);
if (detect_input_pending_ignore_squeezables ())
break;
}
@@ -3703,7 +3570,7 @@ update_window (struct window *w, int force_p)
#endif
}
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Remember the redisplay method used to display the matrix. */
strcpy (w->current_matrix->method, w->desired_matrix->method);
#endif
@@ -3721,7 +3588,7 @@ update_window (struct window *w, int force_p)
else
paused_p = 1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* check_current_matrix_flags (w); */
add_window_display_history (w, w->current_matrix->method, paused_p);
#endif
@@ -3756,15 +3623,15 @@ update_marginal_area (struct window *w, int area, int vpos)
/* Update the display of the text area of row VPOS in window W.
- Value is non-zero if display has changed. */
+ Value is true if display has changed. */
-static int
+static bool
update_text_area (struct window *w, int vpos)
{
struct glyph_row *current_row = MATRIX_ROW (w->current_matrix, vpos);
struct glyph_row *desired_row = MATRIX_ROW (w->desired_matrix, vpos);
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
- int changed_p = 0;
+ bool changed_p = 0;
/* Let functions in xterm.c know what area subsequent X positions
will be relative to. */
@@ -3814,9 +3681,9 @@ update_text_area (struct window *w, int vpos)
int stop, i, x;
struct glyph *current_glyph = current_row->glyphs[TEXT_AREA];
struct glyph *desired_glyph = desired_row->glyphs[TEXT_AREA];
- int overlapping_glyphs_p = current_row->contains_overlapping_glyphs_p;
+ bool overlapping_glyphs_p = current_row->contains_overlapping_glyphs_p;
int desired_stop_pos = desired_row->used[TEXT_AREA];
- int abort_skipping = 0;
+ bool abort_skipping = 0;
/* If the desired row extends its face to the text area end, and
unless the current row also does so at the same position,
@@ -3836,7 +3703,7 @@ update_text_area (struct window *w, int vpos)
in common. */
while (i < stop)
{
- int can_skip_p = !abort_skipping;
+ bool can_skip_p = !abort_skipping;
/* Skip over glyphs that both rows have in common. These
don't have to be written. We can't skip if the last
@@ -3883,7 +3750,8 @@ update_text_area (struct window *w, int vpos)
{
int left, right;
- rif->get_glyph_overhangs (current_glyph, XFRAME (w->frame),
+ rif->get_glyph_overhangs (current_glyph,
+ XFRAME (w->frame),
&left, &right);
while (left > 0 && i > 0)
{
@@ -3909,7 +3777,7 @@ update_text_area (struct window *w, int vpos)
int start_x = x, start_hpos = i;
struct glyph *start = desired_glyph;
int current_x = x;
- int skip_first_p = !can_skip_p;
+ bool skip_first_p = !can_skip_p;
/* Find the next glyph that's equal again. */
while (i < stop
@@ -3952,7 +3820,7 @@ update_text_area (struct window *w, int vpos)
has to be cleared, if and only if we did a write_glyphs
above. This is made sure by setting desired_stop_pos
appropriately above. */
- xassert (i < desired_row->used[TEXT_AREA]
+ eassert (i < desired_row->used[TEXT_AREA]
|| ((desired_row->used[TEXT_AREA]
== current_row->used[TEXT_AREA])
&& MATRIX_ROW_EXTENDS_FACE_P (current_row)));
@@ -4000,16 +3868,15 @@ update_text_area (struct window *w, int vpos)
}
-/* Update row VPOS in window W. Value is non-zero if display has been
- changed. */
+/* Update row VPOS in window W. Value is true if display has been changed. */
-static int
-update_window_line (struct window *w, int vpos, int *mouse_face_overwritten_p)
+static bool
+update_window_line (struct window *w, int vpos, bool *mouse_face_overwritten_p)
{
struct glyph_row *current_row = MATRIX_ROW (w->current_matrix, vpos);
struct glyph_row *desired_row = MATRIX_ROW (w->desired_matrix, vpos);
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
- int changed_p = 0;
+ bool changed_p = 0;
/* Set the row being updated. This is important to let xterm.c
know what line height values are in effect. */
@@ -4022,7 +3889,7 @@ update_window_line (struct window *w, int vpos, int *mouse_face_overwritten_p)
if (desired_row->mode_line_p
|| desired_row->visible_height > 0)
{
- xassert (desired_row->enabled_p);
+ eassert (desired_row->enabled_p);
/* Update display of the left margin area, if there is one. */
if (!desired_row->full_width_p
@@ -4030,6 +3897,11 @@ update_window_line (struct window *w, int vpos, int *mouse_face_overwritten_p)
{
changed_p = 1;
update_marginal_area (w, LEFT_MARGIN_AREA, vpos);
+ /* Setting this flag will ensure the vertical border, if
+ any, between this window and the one on its left will be
+ redrawn. This is necessary because updating the left
+ margin area can potentially draw over the border. */
+ current_row->redraw_fringe_bitmaps_p = 1;
}
/* Update the display of the text area. */
@@ -4080,7 +3952,7 @@ set_window_cursor_after_update (struct window *w)
int cx, cy, vpos, hpos;
/* Not intended for frame matrix updates. */
- xassert (FRAME_WINDOW_P (f));
+ eassert (FRAME_WINDOW_P (f));
if (cursor_in_echo_area
&& !NILP (echo_area_buffer[0])
@@ -4157,7 +4029,7 @@ set_window_cursor_after_update (struct window *w)
tree rooted at W. */
void
-set_window_update_flags (struct window *w, int on_p)
+set_window_update_flags (struct window *w, bool on_p)
{
while (w)
{
@@ -4233,14 +4105,14 @@ static struct run **runs;
/* Add glyph row ROW to the scrolling hash table. */
-static inline struct row_entry *
+static struct row_entry *
add_row_entry (struct glyph_row *row)
{
struct row_entry *entry;
ptrdiff_t i = row->hash % row_table_size;
entry = row_table[i];
- xassert (entry || verify_row_hash (row));
+ eassert (entry || verify_row_hash (row));
while (entry && !row_equal_p (entry->row, row, 1))
entry = entry->next;
@@ -4260,7 +4132,7 @@ add_row_entry (struct glyph_row *row)
/* Try to reuse part of the current display of W by scrolling lines.
- HEADER_LINE_P non-zero means W has a header line.
+ HEADER_LINE_P means W has a header line.
The algorithm is taken from Communications of the ACM, Apr78 "A
Technique for Isolating Differences Between Files." It should take
@@ -4286,7 +4158,7 @@ add_row_entry (struct glyph_row *row)
1 if we did scroll. */
static int
-scrolling_window (struct window *w, int header_line_p)
+scrolling_window (struct window *w, bool header_line_p)
{
struct glyph_matrix *desired_matrix = w->desired_matrix;
struct glyph_matrix *current_matrix = w->current_matrix;
@@ -4299,7 +4171,7 @@ scrolling_window (struct window *w, int header_line_p)
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
/* Skip over rows equal at the start. */
- for (i = header_line_p ? 1 : 0; i < current_matrix->nrows - 1; ++i)
+ for (i = header_line_p; i < current_matrix->nrows - 1; ++i)
{
struct glyph_row *d = MATRIX_ROW (desired_matrix, i);
struct glyph_row *c = MATRIX_ROW (current_matrix, i);
@@ -4454,7 +4326,7 @@ scrolling_window (struct window *w, int header_line_p)
for (i = first_new; i < last_new; ++i)
{
- xassert (MATRIX_ROW_ENABLED_P (desired_matrix, i));
+ eassert (MATRIX_ROW_ENABLED_P (desired_matrix, i));
entry = add_row_entry (MATRIX_ROW (desired_matrix, i));
++entry->new_uses;
entry->new_line_number = i;
@@ -4558,7 +4430,7 @@ scrolling_window (struct window *w, int header_line_p)
for (j = nruns - 1; j > i; --j)
{
struct run *p = runs[j];
- int truncated_p = 0;
+ bool truncated_p = 0;
if (p->nrows > 0
&& p->desired_y < r->desired_y + r->height
@@ -4621,7 +4493,7 @@ scrolling_window (struct window *w, int header_line_p)
for (j = 0; j < r->nrows; ++j)
{
struct glyph_row *from, *to;
- int to_overlapped_p;
+ bool to_overlapped_p;
to = MATRIX_ROW (current_matrix, r->desired_vpos + j);
from = MATRIX_ROW (desired_matrix, r->desired_vpos + j);
@@ -4634,7 +4506,7 @@ scrolling_window (struct window *w, int header_line_p)
row. But thanks to the truncation code in the
preceding for-loop, we no longer have such an overlap,
and thus the assigned row should always be enabled. */
- xassert (to->enabled_p);
+ eassert (to->enabled_p);
from->enabled_p = 0;
to->overlapped_p = to_overlapped_p;
}
@@ -4656,23 +4528,22 @@ scrolling_window (struct window *w, int header_line_p)
/* Update the desired frame matrix of frame F.
- FORCE_P non-zero means that the update should not be stopped by
- pending input. INHIBIT_HAIRY_ID_P non-zero means that scrolling
- should not be tried.
+ FORCE_P means that the update should not be stopped by pending input.
+ INHIBIT_HAIRY_ID_P means that scrolling should not be tried.
- Value is non-zero if update was stopped due to pending input. */
+ Value is true if update was stopped due to pending input. */
-static int
-update_frame_1 (struct frame *f, int force_p, int inhibit_id_p)
+static bool
+update_frame_1 (struct frame *f, bool force_p, bool inhibit_id_p)
{
/* Frame matrices to work on. */
struct glyph_matrix *current_matrix = f->current_matrix;
struct glyph_matrix *desired_matrix = f->desired_matrix;
int i;
- int pause_p;
+ bool pause_p;
int preempt_count = baud_rate / 2400 + 1;
- xassert (current_matrix && desired_matrix);
+ eassert (current_matrix && desired_matrix);
if (baud_rate != FRAME_COST_BAUD_RATE (f))
calculate_costs (f);
@@ -4720,36 +4591,20 @@ update_frame_1 (struct frame *f, int force_p, int inhibit_id_p)
FILE *display_output = FRAME_TTY (f)->output;
if (display_output)
{
- int outq = PENDING_OUTPUT_COUNT (display_output);
+ ptrdiff_t outq = __fpending (display_output);
if (outq > 900
|| (outq > 20 && ((i - 1) % preempt_count == 0)))
- {
- fflush (display_output);
- if (preempt_count == 1)
- {
-#ifdef EMACS_OUTQSIZE
- if (EMACS_OUTQSIZE (0, &outq) < 0)
- /* Probably not a tty. Ignore the error and reset
- the outq count. */
- outq = PENDING_OUTPUT_COUNT (FRAME_TTY (f->output));
-#endif
- outq *= 10;
- if (baud_rate <= outq && baud_rate > 0)
- sleep (outq / baud_rate);
- }
- }
+ fflush (display_output);
}
}
#if PERIODIC_PREEMPTION_CHECKING
if (!force_p)
{
- EMACS_TIME tm, dif;
- EMACS_GET_TIME (tm);
- EMACS_SUB_TIME (dif, preemption_next_check, tm);
- if (EMACS_TIME_NEG_P (dif))
+ EMACS_TIME tm = current_emacs_time ();
+ if (EMACS_TIME_LT (preemption_next_check, tm))
{
- EMACS_ADD_TIME (preemption_next_check, tm, preemption_period);
+ preemption_next_check = add_emacs_time (tm, preemption_period);
if (detect_input_pending_ignore_squeezables ())
break;
}
@@ -4763,7 +4618,8 @@ update_frame_1 (struct frame *f, int force_p, int inhibit_id_p)
}
}
- pause_p = (i < FRAME_LINES (f) - 1) ? i : 0;
+ lint_assume (0 <= FRAME_LINES (f));
+ pause_p = 0 < i && i < FRAME_LINES (f) - 1;
/* Now just clean up termcap drivers and set cursor, etc. */
if (!pause_p)
@@ -4873,23 +4729,23 @@ update_frame_1 (struct frame *f, int force_p, int inhibit_id_p)
/* Do line insertions/deletions on frame F for frame-based redisplay. */
-static int
+static bool
scrolling (struct frame *frame)
{
int unchanged_at_top, unchanged_at_bottom;
int window_size;
int changed_lines;
- int *old_hash = (int *) alloca (FRAME_LINES (frame) * sizeof (int));
- int *new_hash = (int *) alloca (FRAME_LINES (frame) * sizeof (int));
- int *draw_cost = (int *) alloca (FRAME_LINES (frame) * sizeof (int));
- int *old_draw_cost = (int *) alloca (FRAME_LINES (frame) * sizeof (int));
+ int *old_hash = alloca (FRAME_LINES (frame) * sizeof (int));
+ int *new_hash = alloca (FRAME_LINES (frame) * sizeof (int));
+ int *draw_cost = alloca (FRAME_LINES (frame) * sizeof (int));
+ int *old_draw_cost = alloca (FRAME_LINES (frame) * sizeof (int));
register int i;
int free_at_end_vpos = FRAME_LINES (frame);
struct glyph_matrix *current_matrix = frame->current_matrix;
struct glyph_matrix *desired_matrix = frame->desired_matrix;
if (!current_matrix)
- abort ();
+ emacs_abort ();
/* Compute hash codes of all the lines. Also calculate number of
changed lines, number of unchanged lines at the beginning, and
@@ -5016,10 +4872,10 @@ update_frame_line (struct frame *f, int vpos)
struct glyph_matrix *desired_matrix = f->desired_matrix;
struct glyph_row *current_row = MATRIX_ROW (current_matrix, vpos);
struct glyph_row *desired_row = MATRIX_ROW (desired_matrix, vpos);
- int must_write_whole_line_p;
- int write_spaces_p = FRAME_MUST_WRITE_SPACES (f);
- int colored_spaces_p = (FACE_FROM_ID (f, DEFAULT_FACE_ID)->background
- != FACE_TTY_DEFAULT_BG_COLOR);
+ bool must_write_whole_line_p;
+ bool write_spaces_p = FRAME_MUST_WRITE_SPACES (f);
+ bool colored_spaces_p = (FACE_FROM_ID (f, DEFAULT_FACE_ID)->background
+ != FACE_TTY_DEFAULT_BG_COLOR);
if (colored_spaces_p)
write_spaces_p = 1;
@@ -5353,7 +5209,7 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p
/* start_display takes into account the header-line row, but IT's
vpos still counts from the glyph row that includes the window's
start position. Adjust for a possible header-line row. */
- it.vpos += WINDOW_WANTS_HEADER_LINE_P (w) ? 1 : 0;
+ it.vpos += WINDOW_WANTS_HEADER_LINE_P (w);
x0 = *x;
@@ -5474,7 +5330,7 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p
Lisp_Object
mode_line_string (struct window *w, enum window_part part,
- int *x, int *y, EMACS_INT *charpos, Lisp_Object *object,
+ int *x, int *y, ptrdiff_t *charpos, Lisp_Object *object,
int *dx, int *dy, int *width, int *height)
{
struct glyph_row *row;
@@ -5543,7 +5399,7 @@ mode_line_string (struct window *w, enum window_part part,
Lisp_Object
marginal_area_string (struct window *w, enum window_part part,
- int *x, int *y, EMACS_INT *charpos, Lisp_Object *object,
+ int *x, int *y, ptrdiff_t *charpos, Lisp_Object *object,
int *dx, int *dy, int *width, int *height)
{
struct glyph_row *row = w->current_matrix->rows;
@@ -5557,7 +5413,7 @@ marginal_area_string (struct window *w, enum window_part part,
else if (part == ON_RIGHT_MARGIN)
area = RIGHT_MARGIN_AREA;
else
- abort ();
+ emacs_abort ();
for (i = 0; row->enabled_p && i < w->current_matrix->nrows; ++i, ++row)
if (wy >= row->y && wy < MATRIX_ROW_BOTTOM_Y (row))
@@ -5632,18 +5488,14 @@ marginal_area_string (struct window *w, enum window_part part,
#ifdef SIGWINCH
+static void deliver_window_change_signal (int);
+
static void
-window_change_signal (int signalnum) /* If we don't have an argument, */
- /* some compilers complain in signal calls. */
+handle_window_change_signal (int sig)
{
int width, height;
- int old_errno = errno;
-
struct tty_display_info *tty;
- signal (SIGWINCH, window_change_signal);
- SIGNAL_THREAD_CHECK (signalnum);
-
/* The frame size change obviously applies to a single
termcap-controlled terminal, but we can't decide which.
Therefore, we resize the frames corresponding to each tty.
@@ -5671,20 +5523,24 @@ window_change_signal (int signalnum) /* If we don't have an argument, */
change_frame_size (XFRAME (frame), height, width, 0, 1, 0);
}
}
+}
- errno = old_errno;
+static void
+deliver_window_change_signal (int sig)
+{
+ deliver_process_signal (sig, handle_window_change_signal);
}
#endif /* SIGWINCH */
-/* Do any change in frame size that was requested by a signal. SAFE
- non-zero means this function is called from a place where it is
- safe to change frame sizes while a redisplay is in progress. */
+/* Do any change in frame size that was requested by a signal.
+ SAFE means this function is called from a place where it is
+ safe to change frame sizes while a redisplay is in progress. */
void
-do_pending_window_change (int safe)
+do_pending_window_change (bool safe)
{
- /* If window_change_signal should have run before, run it now. */
+ /* If window change signal handler should have run before, run it now. */
if (redisplaying_p && !safe)
return;
@@ -5709,16 +5565,17 @@ do_pending_window_change (int safe)
/* Change the frame height and/or width. Values may be given as zero to
indicate no change is to take place.
- If DELAY is non-zero, then assume we're being called from a signal
- handler, and queue the change for later - perhaps the next
- redisplay. Since this tries to resize windows, we can't call it
+ If DELAY, assume we're being called from a signal handler, and
+ queue the change for later - perhaps the next redisplay.
+ Since this tries to resize windows, we can't call it
from a signal handler.
- SAFE non-zero means this function is called from a place where it's
+ SAFE means this function is called from a place where it's
safe to change frame sizes while a redisplay is in progress. */
void
-change_frame_size (register struct frame *f, int newheight, int newwidth, int pretend, int delay, int safe)
+change_frame_size (struct frame *f, int newheight, int newwidth,
+ bool pretend, bool delay, bool safe)
{
Lisp_Object tail, frame;
@@ -5737,10 +5594,11 @@ change_frame_size (register struct frame *f, int newheight, int newwidth, int pr
}
static void
-change_frame_size_1 (register struct frame *f, int newheight, int newwidth, int pretend, int delay, int safe)
+change_frame_size_1 (struct frame *f, int newheight, int newwidth,
+ bool pretend, bool delay, bool safe)
{
int new_frame_total_cols;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* If we can't deal with the change now, queue it for later. */
if (delay || (redisplaying_p && !safe))
@@ -5761,22 +5619,25 @@ change_frame_size_1 (register struct frame *f, int newheight, int newwidth, int
if (newwidth == 0)
newwidth = FRAME_COLS (f);
- /* Compute width of windows in F.
- This is the width of the frame without vertical scroll bars. */
- new_frame_total_cols = FRAME_TOTAL_COLS_ARG (f, newwidth);
-
+ /* Compute width of windows in F. */
/* Round up to the smallest acceptable size. */
check_frame_size (f, &newheight, &newwidth);
+ /* This is the width of the frame with vertical scroll bars and fringe
+ columns. Do this after rounding - see discussion of bug#9723. */
+ new_frame_total_cols = FRAME_TOTAL_COLS_ARG (f, newwidth);
+
/* If we're not changing the frame size, quit now. */
- /* Frame width may be unchanged but the text portion may change, for example,
- fullscreen and remove/add scroll bar. */
+ /* Frame width may be unchanged but the text portion may change, for
+ example, fullscreen and remove/add scroll bar. */
if (newheight == FRAME_LINES (f)
- && newwidth == FRAME_COLS (f) // text portion unchanged
- && new_frame_total_cols == FRAME_TOTAL_COLS (f)) // frame width unchanged
+ /* Text portion unchanged? */
+ && newwidth == FRAME_COLS (f)
+ /* Frame width unchanged? */
+ && new_frame_total_cols == FRAME_TOTAL_COLS (f))
return;
- BLOCK_INPUT;
+ block_input ();
#ifdef MSDOS
/* We only can set screen dimensions to certain values supported
@@ -5805,7 +5666,7 @@ change_frame_size_1 (register struct frame *f, int newheight, int newwidth, int
FrameCols (FRAME_TTY (f)) = newwidth;
if (WINDOWP (f->tool_bar_window))
- XSETFASTINT (XWINDOW (f->tool_bar_window)->total_cols, newwidth);
+ wset_total_cols (XWINDOW (f->tool_bar_window), make_number (newwidth));
}
FRAME_LINES (f) = newheight;
@@ -5828,9 +5689,9 @@ change_frame_size_1 (register struct frame *f, int newheight, int newwidth, int
SET_FRAME_GARBAGED (f);
f->resized_p = 1;
- UNBLOCK_INPUT;
+ unblock_input ();
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
run_window_configuration_change_hook (f);
@@ -5859,9 +5720,9 @@ FILE = nil means just close any termscript file currently open. */)
if (tty->termscript != 0)
{
- BLOCK_INPUT;
+ block_input ();
fclose (tty->termscript);
- UNBLOCK_INPUT;
+ unblock_input ();
}
tty->termscript = 0;
@@ -5892,7 +5753,7 @@ when TERMINAL is nil. */)
/* ??? Perhaps we should do something special for multibyte strings here. */
CHECK_STRING (string);
- BLOCK_INPUT;
+ block_input ();
if (!t)
error ("Unknown terminal device");
@@ -5917,7 +5778,7 @@ when TERMINAL is nil. */)
}
fwrite (SDATA (string), 1, SBYTES (string), out);
fflush (out);
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
@@ -5962,46 +5823,24 @@ DEFUN ("sleep-for", Fsleep_for, Ssleep_for, 1, 2, 0,
doc: /* Pause, without updating display, for SECONDS seconds.
SECONDS may be a floating-point value, meaning that you can wait for a
fraction of a second. Optional second arg MILLISECONDS specifies an
-additional wait period, in milliseconds; this may be useful if your
-Emacs was built without floating point support.
+additional wait period, in milliseconds; this is for backwards compatibility.
\(Not all operating systems support waiting for a fraction of a second.) */)
(Lisp_Object seconds, Lisp_Object milliseconds)
{
- int sec, usec;
-
- if (NILP (milliseconds))
- XSETINT (milliseconds, 0);
- else
- CHECK_NUMBER (milliseconds);
- usec = XINT (milliseconds) * 1000;
-
- {
- double duration = extract_float (seconds);
- sec = (int) duration;
- usec += (duration - sec) * 1000000;
- }
+ double duration = extract_float (seconds);
-#ifndef EMACS_HAS_USECS
- if (sec == 0 && usec != 0)
- error ("Millisecond `sleep-for' not supported on %s", SYSTEM_TYPE);
-#endif
-
- /* Assure that 0 <= usec < 1000000. */
- if (usec < 0)
+ if (!NILP (milliseconds))
{
- /* We can't rely on the rounding being correct if usec is negative. */
- if (-1000000 < usec)
- sec--, usec += 1000000;
- else
- sec -= -usec / 1000000, usec = 1000000 - (-usec % 1000000);
+ CHECK_NUMBER (milliseconds);
+ duration += XINT (milliseconds) / 1000.0;
}
- else
- sec += usec / 1000000, usec %= 1000000;
- if (sec < 0 || (sec == 0 && usec == 0))
- return Qnil;
-
- wait_reading_process_output (sec, usec, 0, 0, Qnil, NULL, 0);
+ if (0 < duration)
+ {
+ EMACS_TIME t = EMACS_TIME_FROM_DOUBLE (duration);
+ wait_reading_process_output (min (EMACS_SECS (t), WAIT_READING_MAX),
+ EMACS_NSECS (t), 0, 0, Qnil, NULL, 0);
+ }
return Qnil;
}
@@ -6012,15 +5851,17 @@ Emacs was built without floating point support.
TIMEOUT is number of seconds to wait (float or integer),
or t to wait forever.
- READING is 1 if reading input.
- If DO_DISPLAY is >0 display process output while waiting.
- If DO_DISPLAY is >1 perform an initial redisplay before waiting.
+ READING is true if reading input.
+ If DISPLAY_OPTION is >0 display process output while waiting.
+ If DISPLAY_OPTION is >1 perform an initial redisplay before waiting.
*/
Lisp_Object
-sit_for (Lisp_Object timeout, int reading, int do_display)
+sit_for (Lisp_Object timeout, bool reading, int display_option)
{
- int sec, usec;
+ intmax_t sec;
+ int nsec;
+ bool do_display = display_option > 0;
swallow_events (do_display);
@@ -6028,36 +5869,42 @@ sit_for (Lisp_Object timeout, int reading, int do_display)
|| !NILP (Vexecuting_kbd_macro))
return Qnil;
- if (do_display >= 2)
+ if (display_option > 1)
redisplay_preserve_echo_area (2);
if (INTEGERP (timeout))
{
sec = XINT (timeout);
- usec = 0;
+ if (! (0 < sec))
+ return Qt;
+ nsec = 0;
}
else if (FLOATP (timeout))
{
double seconds = XFLOAT_DATA (timeout);
- sec = (int) seconds;
- usec = (int) ((seconds - sec) * 1000000);
+ if (! (0 < seconds))
+ return Qt;
+ else
+ {
+ EMACS_TIME t = EMACS_TIME_FROM_DOUBLE (seconds);
+ sec = min (EMACS_SECS (t), WAIT_READING_MAX);
+ nsec = EMACS_NSECS (t);
+ }
}
else if (EQ (timeout, Qt))
{
sec = 0;
- usec = 0;
+ nsec = 0;
}
else
wrong_type_argument (Qnumberp, timeout);
- if (sec == 0 && usec == 0 && !EQ (timeout, Qt))
- return Qt;
-#ifdef SIGIO
- gobble_input (0);
+#ifdef USABLE_SIGIO
+ gobble_input ();
#endif
- wait_reading_process_output (sec, usec, reading ? -1 : 1, do_display,
+ wait_reading_process_output (sec, nsec, reading ? -1 : 1, do_display,
Qnil, NULL, 0);
return detect_input_pending () ? Qnil : Qt;
@@ -6065,13 +5912,17 @@ sit_for (Lisp_Object timeout, int reading, int do_display)
DEFUN ("redisplay", Fredisplay, Sredisplay, 0, 1, 0,
- doc: /* Perform redisplay if no input is available.
-If optional arg FORCE is non-nil or `redisplay-dont-pause' is non-nil,
-perform a full redisplay even if input is available.
-Return t if redisplay was performed, nil otherwise. */)
+ doc: /* Perform redisplay.
+Optional arg FORCE, if non-nil, prevents redisplay from being
+preempted by arriving input, even if `redisplay-dont-pause' is nil.
+If `redisplay-dont-pause' is non-nil (the default), redisplay is never
+preempted by arriving input, so FORCE does nothing.
+
+Return t if redisplay was performed, nil if redisplay was preempted
+immediately by pending input. */)
(Lisp_Object force)
{
- int count;
+ ptrdiff_t count;
swallow_events (1);
if ((detect_input_pending_run_timers (1)
@@ -6116,8 +5967,7 @@ pass nil for VARIABLE. */)
(Lisp_Object variable)
{
Lisp_Object state, tail, frame, buf;
- Lisp_Object *vecp, *end;
- int n;
+ ptrdiff_t n, idx;
if (! NILP (variable))
{
@@ -6129,18 +5979,16 @@ pass nil for VARIABLE. */)
else
state = frame_and_buffer_state;
- vecp = XVECTOR (state)->contents;
- end = vecp + ASIZE (state);
-
+ idx = 0;
FOR_EACH_FRAME (tail, frame)
{
- if (vecp == end)
+ if (idx == ASIZE (state))
goto changed;
- if (!EQ (*vecp++, frame))
+ if (!EQ (AREF (state, idx++), frame))
goto changed;
- if (vecp == end)
+ if (idx == ASIZE (state))
goto changed;
- if (!EQ (*vecp++, XFRAME (frame)->name))
+ if (!EQ (AREF (state, idx++), XFRAME (frame)->name))
goto changed;
}
/* Check that the buffer info matches. */
@@ -6150,23 +5998,23 @@ pass nil for VARIABLE. */)
/* Ignore buffers that aren't included in buffer lists. */
if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ')
continue;
- if (vecp == end)
+ if (idx == ASIZE (state))
goto changed;
- if (!EQ (*vecp++, buf))
+ if (!EQ (AREF (state, idx++), buf))
goto changed;
- if (vecp == end)
+ if (idx == ASIZE (state))
goto changed;
- if (!EQ (*vecp++, BVAR (XBUFFER (buf), read_only)))
+ if (!EQ (AREF (state, idx++), BVAR (XBUFFER (buf), read_only)))
goto changed;
- if (vecp == end)
+ if (idx == ASIZE (state))
goto changed;
- if (!EQ (*vecp++, Fbuffer_modified_p (buf)))
+ if (!EQ (AREF (state, idx++), Fbuffer_modified_p (buf)))
goto changed;
}
- if (vecp == end)
+ if (idx == ASIZE (state))
goto changed;
/* Detect deletion of a buffer at the end of the list. */
- if (EQ (*vecp, Qlambda))
+ if (EQ (AREF (state, idx), Qlambda))
return Qnil;
/* Come here if we decide the data has changed. */
@@ -6193,11 +6041,13 @@ pass nil for VARIABLE. */)
}
/* Record the new data in the (possibly reallocated) vector. */
- vecp = XVECTOR (state)->contents;
+ idx = 0;
FOR_EACH_FRAME (tail, frame)
{
- *vecp++ = frame;
- *vecp++ = XFRAME (frame)->name;
+ ASET (state, idx, frame);
+ idx++;
+ ASET (state, idx, XFRAME (frame)->name);
+ idx++;
}
for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
{
@@ -6205,19 +6055,23 @@ pass nil for VARIABLE. */)
/* Ignore buffers that aren't included in buffer lists. */
if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ')
continue;
- *vecp++ = buf;
- *vecp++ = BVAR (XBUFFER (buf), read_only);
- *vecp++ = Fbuffer_modified_p (buf);
+ ASET (state, idx, buf);
+ idx++;
+ ASET (state, idx, BVAR (XBUFFER (buf), read_only));
+ idx++;
+ ASET (state, idx, Fbuffer_modified_p (buf));
+ idx++;
}
/* Fill up the vector with lambdas (always at least one). */
- *vecp++ = Qlambda;
- while (vecp - XVECTOR (state)->contents
- < ASIZE (state))
- *vecp++ = Qlambda;
+ ASET (state, idx, Qlambda);
+ idx++;
+ while (idx < ASIZE (state))
+ {
+ ASET (state, idx, Qlambda);
+ idx++;
+ }
/* Make sure we didn't overflow the vector. */
- if (vecp - XVECTOR (state)->contents
- > ASIZE (state))
- abort ();
+ eassert (idx <= ASIZE (state));
return Qt;
}
@@ -6256,7 +6110,11 @@ init_display (void)
#ifndef CANNOT_DUMP
if (initialized)
#endif /* CANNOT_DUMP */
- signal (SIGWINCH, window_change_signal);
+ {
+ struct sigaction action;
+ emacs_sigaction_init (&action, deliver_window_change_signal);
+ sigaction (SIGWINCH, &action, 0);
+ }
#endif /* SIGWINCH */
/* If running as a daemon, no need to initialize any frames/terminal. */
@@ -6292,13 +6150,12 @@ init_display (void)
#ifdef HAVE_X11
Vwindow_system_version = make_number (11);
#endif
-#if defined (GNU_LINUX) && defined (HAVE_LIBNCURSES)
+#ifdef GNU_LINUX
/* In some versions of ncurses,
tputs crashes if we have not called tgetent.
So call tgetent. */
{ char b[2044]; tgetent (b, "xterm");}
#endif
- adjust_frame_glyphs_initially ();
return;
}
#endif /* HAVE_X_WINDOWS */
@@ -6308,7 +6165,6 @@ init_display (void)
{
Vinitial_window_system = Qw32;
Vwindow_system_version = make_number (1);
- adjust_frame_glyphs_initially ();
return;
}
#endif /* HAVE_NTGUI */
@@ -6322,7 +6178,6 @@ init_display (void)
{
Vinitial_window_system = Qns;
Vwindow_system_version = make_number (10);
- adjust_frame_glyphs_initially ();
return;
}
#endif
@@ -6355,12 +6210,14 @@ init_display (void)
struct terminal *t;
struct frame *f = XFRAME (selected_frame);
+ init_foreground_group ();
+
/* Open a display on the controlling tty. */
t = init_tty (0, terminal_type, 1); /* Errors are fatal. */
/* Convert the initial frame to use the new display. */
if (f->output_method != output_initial)
- abort ();
+ emacs_abort ();
f->output_method = t->type;
f->terminal = t;
@@ -6410,7 +6267,6 @@ init_display (void)
fatal ("screen size %dx%d too big", width, height);
}
- adjust_frame_glyphs_initially ();
calculate_costs (XFRAME (selected_frame));
/* Set up faces of the initial terminal frame of a dumped Emacs. */
@@ -6445,15 +6301,7 @@ don't show a cursor. */)
/* Don't change cursor state while redisplaying. This could confuse
output routines. */
if (!redisplaying_p)
- {
- if (NILP (window))
- window = selected_window;
- else
- CHECK_WINDOW (window);
-
- XWINDOW (window)->cursor_off_p = NILP (show);
- }
-
+ decode_any_window (window)->cursor_off_p = NILP (show);
return Qnil;
}
@@ -6464,15 +6312,7 @@ DEFUN ("internal-show-cursor-p", Finternal_show_cursor_p,
WINDOW nil or omitted means report on the selected window. */)
(Lisp_Object window)
{
- struct window *w;
-
- if (NILP (window))
- window = selected_window;
- else
- CHECK_WINDOW (window);
-
- w = XWINDOW (window);
- return w->cursor_off_p ? Qnil : Qt;
+ return decode_any_window (window)->cursor_off_p ? Qnil : Qt;
}
DEFUN ("last-nonminibuffer-frame", Flast_nonminibuf_frame,
@@ -6507,7 +6347,7 @@ syms_of_display (void)
defsubr (&Sinternal_show_cursor_p);
defsubr (&Slast_nonminibuf_frame);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
defsubr (&Sdump_redisplay_history);
#endif
@@ -6518,21 +6358,21 @@ syms_of_display (void)
DEFSYM (Qredisplay_dont_pause, "redisplay-dont-pause");
DEFVAR_INT ("baud-rate", baud_rate,
- doc: /* *The output baud rate of the terminal.
+ doc: /* The output baud rate of the terminal.
On most systems, changing this value will affect the amount of padding
and the other strategic decisions made during redisplay. */);
DEFVAR_BOOL ("inverse-video", inverse_video,
- doc: /* *Non-nil means invert the entire frame display.
+ doc: /* Non-nil means invert the entire frame display.
This means everything is in inverse video which otherwise would not be. */);
DEFVAR_BOOL ("visible-bell", visible_bell,
- doc: /* *Non-nil means try to flash the frame to represent a bell.
+ doc: /* Non-nil means try to flash the frame to represent a bell.
See also `ring-bell-function'. */);
DEFVAR_BOOL ("no-redraw-on-reenter", no_redraw_on_reenter,
- doc: /* *Non-nil means no need to redraw entire frame after suspending.
+ doc: /* Non-nil means no need to redraw entire frame after suspending.
A non-nil value is useful if the terminal can automatically preserve
Emacs's frame display when you reenter Emacs.
It is up to you to set this variable if your terminal can do that. */);
@@ -6587,14 +6427,15 @@ See `buffer-display-table' for more information. */);
Vstandard_display_table = Qnil;
DEFVAR_BOOL ("redisplay-dont-pause", redisplay_dont_pause,
- doc: /* *Non-nil means display update isn't paused when input is detected. */);
+ doc: /* Non-nil means display update isn't paused when input is detected. */);
redisplay_dont_pause = 1;
#if PERIODIC_PREEMPTION_CHECKING
DEFVAR_LISP ("redisplay-preemption-period", Vredisplay_preemption_period,
- doc: /* *The period in seconds between checking for input during redisplay.
-If input is detected, redisplay is pre-empted, and the input is processed.
-If nil, never pre-empt redisplay. */);
+ doc: /* Period in seconds between checking for input during redisplay.
+This has an effect only if `redisplay-dont-pause' is nil; in that
+case, arriving input preempts redisplay until the input is processed.
+If the value is nil, redisplay is never preempted. */);
Vredisplay_preemption_period = make_float (0.10);
#endif
diff --git a/src/disptab.h b/src/disptab.h
index e70079d2098..2e041707eea 100644
--- a/src/disptab.h
+++ b/src/disptab.h
@@ -1,5 +1,5 @@
/* Things for GLYPHS and glyph tables.
- Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/doc.c b/src/doc.c
index 80aaba9f7b2..1d3d1e64442 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -1,6 +1,6 @@
/* Record indices of function doc strings stored in a file.
- Copyright (C) 1985-1986, 1993-1995, 1997-2011
- Free Software Foundation, Inc.
+
+Copyright (C) 1985-1986, 1993-1995, 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,36 +21,32 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <sys/types.h>
-#include <sys/file.h> /* Must be after sys/types.h for USG*/
-#include <ctype.h>
-#include <setjmp.h>
+#include <sys/file.h> /* Must be after sys/types.h for USG. */
#include <fcntl.h>
#include <unistd.h>
+#include <c-ctype.h>
+
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "keyboard.h"
-#include "character.h"
#include "keymap.h"
#include "buildobj.h"
Lisp_Object Qfunction_documentation;
-extern Lisp_Object Qclosure;
/* Buffer used for reading from documentation file. */
static char *get_doc_string_buffer;
static ptrdiff_t get_doc_string_buffer_size;
static unsigned char *read_bytecode_pointer;
-static Lisp_Object Fdocumentation_property (Lisp_Object, Lisp_Object,
- Lisp_Object);
-static Lisp_Object Fsnarf_documentation (Lisp_Object);
-/* readchar in lread.c calls back here to fetch the next byte.
+/* `readchar' in lread.c calls back here to fetch the next byte.
If UNREADFLAG is 1, we unread a byte. */
int
-read_bytecode_char (int unreadflag)
+read_bytecode_char (bool unreadflag)
{
if (unreadflag)
{
@@ -72,23 +68,23 @@ read_bytecode_char (int unreadflag)
(e.g. because the file has been modified and the location is stale),
return nil.
- If UNIBYTE is nonzero, always make a unibyte string.
+ If UNIBYTE, always make a unibyte string.
- If DEFINITION is nonzero, assume this is for reading
+ If DEFINITION, assume this is for reading
a dynamic function definition; convert the bytestring
and the constants vector with appropriate byte handling,
and return a cons cell. */
Lisp_Object
-get_doc_string (Lisp_Object filepos, int unibyte, int definition)
+get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
{
- char *from, *to;
- register int fd;
- register char *name;
- register char *p, *p1;
- EMACS_INT minsize;
- EMACS_INT offset, position;
+ char *from, *to, *name, *p, *p1;
+ int fd;
+ ptrdiff_t minsize;
+ int offset;
+ EMACS_INT position;
Lisp_Object file, tem;
+ USE_SAFE_ALLOCA;
if (INTEGERP (filepos))
{
@@ -124,7 +120,7 @@ get_doc_string (Lisp_Object filepos, int unibyte, int definition)
/* sizeof ("../etc/") == 8 */
if (minsize < 8)
minsize = 8;
- name = (char *) alloca (minsize + SCHARS (file) + 8);
+ name = SAFE_ALLOCA (minsize + SCHARS (file) + 8);
strcpy (name, SSDATA (docdir));
strcat (name, SSDATA (file));
}
@@ -148,20 +144,24 @@ get_doc_string (Lisp_Object filepos, int unibyte, int definition)
}
#endif
if (fd < 0)
- error ("Cannot open doc string file \"%s\"", name);
+ return concat3 (build_string ("Cannot open doc string file \""),
+ file, build_string ("\"\n"));
}
/* Seek only to beginning of disk block. */
/* Make sure we read at least 1024 bytes before `position'
so we can check the leading text for consistency. */
offset = min (position, max (1024, position % (8 * 1024)));
- if (0 > lseek (fd, position - offset, 0))
+ if (TYPE_MAXIMUM (off_t) < position
+ || lseek (fd, position - offset, 0) < 0)
{
emacs_close (fd);
error ("Position %"pI"d out of range in doc string file \"%s\"",
position, name);
}
+ SAFE_FREE ();
+
/* Read the doc string into get_doc_string_buffer.
P points beyond the data just read. */
@@ -279,7 +279,7 @@ Invalid data in documentation file -- %c followed by code %03o",
else
{
/* The data determines whether the string is multibyte. */
- EMACS_INT nchars =
+ ptrdiff_t nchars =
multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
+ offset),
to - (get_doc_string_buffer + offset));
@@ -299,7 +299,7 @@ read_doc_string (Lisp_Object filepos)
return get_doc_string (filepos, 0, 1);
}
-static int
+static bool
reread_doc_file (Lisp_Object file)
{
#if 0
@@ -332,21 +332,15 @@ string is passed through `substitute-command-keys'. */)
Lisp_Object fun;
Lisp_Object funcar;
Lisp_Object doc;
- int try_reload = 1;
+ bool try_reload = 1;
documentation:
doc = Qnil;
- if (SYMBOLP (function))
- {
- Lisp_Object tem = Fget (function, Qfunction_documentation);
- if (!NILP (tem))
- return Fdocumentation_property (function, Qfunction_documentation,
- raw);
- }
-
fun = Findirect_function (function, Qnil);
+ if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
+ fun = XCDR (fun);
if (SUBRP (fun))
{
if (XSUBR (fun)->doc == 0)
@@ -379,7 +373,7 @@ string is passed through `substitute-command-keys'. */)
}
else if (CONSP (fun))
{
- funcar = Fcar (fun);
+ funcar = XCAR (fun);
if (!SYMBOLP (funcar))
xsignal1 (Qinvalid_function, fun);
else if (EQ (funcar, Qkeymap))
@@ -400,8 +394,6 @@ string is passed through `substitute-command-keys'. */)
else
return Qnil;
}
- else if (EQ (funcar, Qmacro))
- return Fdocumentation (Fcdr (fun), raw);
else
goto oops;
}
@@ -411,16 +403,19 @@ string is passed through `substitute-command-keys'. */)
xsignal1 (Qinvalid_function, fun);
}
- /* Check for an advised function. Its doc string
- has an `ad-advice-info' text property. */
+ /* Check for a dynamic docstring. These come with
+ a dynamic-docstring-function text property. */
if (STRINGP (doc))
{
- Lisp_Object innerfunc;
- innerfunc = Fget_text_property (make_number (0),
- intern ("ad-advice-info"),
+ Lisp_Object func
+ = Fget_text_property (make_number (0),
+ intern ("dynamic-docstring-function"),
doc);
- if (! NILP (innerfunc))
- doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
+ if (!NILP (func))
+ /* Pass both `doc' and `function' since `function' can be needed, and
+ finding `doc' can be annoying: calling `documentation' is not an
+ option because it would infloop. */
+ doc = call2 (func, doc, function);
}
/* If DOC is 0, it's typically because of a dumped file missing
@@ -464,7 +459,7 @@ This differs from `get' in that it can refer to strings stored in the
aren't strings. */)
(Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
{
- int try_reload = 1;
+ bool try_reload = 1;
Lisp_Object tem;
documentation_property:
@@ -502,10 +497,11 @@ aren't strings. */)
/* Scanning the DOC files and placing docstring offsets into functions. */
static void
-store_function_docstring (Lisp_Object fun, EMACS_INT offset)
-/* Use EMACS_INT because we get offset from pointer subtraction. */
+store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
{
- fun = indirect_function (fun);
+ /* Don't use indirect_function here, or defaliases will apply their
+ docstrings to the base functions (Bug#2603). */
+ Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
/* The type determines where the docstring is stored. */
@@ -527,6 +523,8 @@ store_function_docstring (Lisp_Object fun, EMACS_INT offset)
{
tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem)))
+ /* FIXME: This modifies typically pure hash-cons'd data, so its
+ correctness is quite delicate. */
XSETCAR (tem, make_number (offset));
}
else if (EQ (tem, Qmacro))
@@ -558,12 +556,11 @@ the same file name is found in the `doc-directory'. */)
{
int fd;
char buf[1024 + 1];
- register EMACS_INT filled;
- register EMACS_INT pos;
- register char *p;
+ int filled;
+ EMACS_INT pos;
Lisp_Object sym;
- char *name;
- int skip_file = 0;
+ char *p, *name;
+ bool skip_file = 0;
CHECK_STRING (filename);
@@ -574,14 +571,13 @@ the same file name is found in the `doc-directory'. */)
(0)
#endif /* CANNOT_DUMP */
{
- name = (char *) alloca (SCHARS (filename) + 14);
+ name = alloca (SCHARS (filename) + 14);
strcpy (name, "../etc/");
}
else
{
CHECK_STRING (Vdoc_directory);
- name = (char *) alloca (SCHARS (filename)
- + SCHARS (Vdoc_directory) + 1);
+ name = alloca (SCHARS (filename) + SCHARS (Vdoc_directory) + 1);
strcpy (name, SSDATA (Vdoc_directory));
}
strcat (name, SSDATA (filename)); /*** Add this line ***/
@@ -593,11 +589,11 @@ the same file name is found in the `doc-directory'. */)
for (beg = buildobj; *beg; beg = end)
{
- EMACS_INT len;
+ ptrdiff_t len;
- while (*beg && isspace (*beg)) ++beg;
+ while (*beg && c_isspace (*beg)) ++beg;
- for (end = beg; *end && ! isspace (*end); ++end)
+ for (end = beg; *end && ! c_isspace (*end); ++end)
if (*end == '/') beg = end+1; /* skip directory part */
len = end - beg;
@@ -641,9 +637,9 @@ the same file name is found in the `doc-directory'. */)
if (end - p > 4 && end[-2] == '.'
&& (end[-1] == 'o' || end[-1] == 'c'))
{
- EMACS_INT len = end - p - 2;
+ ptrdiff_t len = end - p - 2;
char *fromfile = alloca (len + 1);
- strncpy (fromfile, &p[2], len);
+ memcpy (fromfile, &p[2], len);
fromfile[len] = 0;
if (fromfile[len-1] == 'c')
fromfile[len-1] = 'o';
@@ -669,15 +665,18 @@ the same file name is found in the `doc-directory'. */)
/* Install file-position as variable-documentation property
and make it negative for a user-variable
(doc starts with a `*'). */
- Fput (sym, Qvariable_documentation,
- make_number ((pos + end + 1 - buf)
- * (end[1] == '*' ? -1 : 1)));
+ if (!NILP (Fboundp (sym)))
+ Fput (sym, Qvariable_documentation,
+ make_number ((pos + end + 1 - buf)
+ * (end[1] == '*' ? -1 : 1)));
}
/* Attach a docstring to a function? */
else if (p[1] == 'F')
- store_function_docstring (sym, pos + end + 1 - buf);
-
+ {
+ if (!NILP (Ffboundp (sym)))
+ store_function_docstring (sym, pos + end + 1 - buf);
+ }
else if (p[1] == 'S')
; /* Just a source file name boundary marker. Ignore it. */
@@ -696,24 +695,29 @@ the same file name is found in the `doc-directory'. */)
DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
Ssubstitute_command_keys, 1, 1, 0,
doc: /* Substitute key descriptions for command names in STRING.
-Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
-sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
-on any keys.
-Substrings of the form \\=\\{MAPVAR} are replaced by summaries
-\(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
-Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
+Each substring of the form \\=\\[COMMAND] is replaced by either a
+keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
+is not on any keys.
+
+Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
+the value of MAPVAR as a keymap. This summary is similar to the one
+produced by `describe-bindings'. The summary ends in two newlines
+\(used by the helper function `help-make-xrefs' to find the end of the
+summary).
+
+Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
as the keymap for future \\=\\[COMMAND] substrings.
\\=\\= quotes the following character and is discarded;
thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
-Returns original STRING if no substitutions were made. Otherwise,
-a new string, without any text properties, is returned. */)
+Return the original STRING if no substitutions are made.
+Otherwise, return a new string, without any text properties. */)
(Lisp_Object string)
{
char *buf;
- int changed = 0;
- register unsigned char *strp;
- register char *bufp;
+ bool changed = 0;
+ unsigned char *strp;
+ char *bufp;
ptrdiff_t idx;
ptrdiff_t bsize;
Lisp_Object tem;
@@ -722,7 +726,7 @@ a new string, without any text properties, is returned. */)
ptrdiff_t length, length_byte;
Lisp_Object name;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int multibyte;
+ bool multibyte;
ptrdiff_t nchars;
if (NILP (string))
@@ -746,7 +750,7 @@ a new string, without any text properties, is returned. */)
keymap = Voverriding_local_map;
bsize = SBYTES (string);
- bufp = buf = (char *) xmalloc (bsize);
+ bufp = buf = xmalloc (bsize);
strp = SDATA (string);
while (strp < SDATA (string) + SBYTES (string))
@@ -776,7 +780,7 @@ a new string, without any text properties, is returned. */)
else if (strp[0] == '\\' && strp[1] == '[')
{
ptrdiff_t start_idx;
- int follow_remap = 1;
+ bool follow_remap = 1;
changed = 1;
strp += 2; /* skip \[ */
@@ -817,7 +821,7 @@ a new string, without any text properties, is returned. */)
ptrdiff_t offset = bufp - buf;
if (STRING_BYTES_BOUND - 4 < bsize)
string_overflow ();
- buf = (char *) xrealloc (buf, bsize += 4);
+ buf = xrealloc (buf, bsize += 4);
bufp = buf + offset;
memcpy (bufp, "M-x ", 4);
bufp += 4;
@@ -883,11 +887,11 @@ a new string, without any text properties, is returned. */)
if (NILP (tem))
{
name = Fsymbol_name (name);
- insert_string ("\nUses keymap \"");
+ insert_string ("\nUses keymap `");
insert_from_string (name, 0, 0,
SCHARS (name),
SBYTES (name), 1);
- insert_string ("\", which is not currently defined.\n");
+ insert_string ("', which is not currently defined.\n");
if (start[-1] == '<') keymap = Qnil;
}
else if (start[-1] == '<')
@@ -913,7 +917,7 @@ a new string, without any text properties, is returned. */)
ptrdiff_t offset = bufp - buf;
if (STRING_BYTES_BOUND - length_byte < bsize)
string_overflow ();
- buf = (char *) xrealloc (buf, bsize += length_byte);
+ buf = xrealloc (buf, bsize += length_byte);
bufp = buf + offset;
memcpy (bufp, start, length_byte);
bufp += length_byte;
diff --git a/src/doprnt.c b/src/doprnt.c
index 35af2297ff4..caa56d6ae88 100644
--- a/src/doprnt.c
+++ b/src/doprnt.c
@@ -1,7 +1,7 @@
/* Output like sprintf to a buffer of specified size.
Also takes args differently: pass one pointer to the end
of the format string in addition to the format string itself.
- Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -102,8 +102,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <ctype.h>
-#include <setjmp.h>
#include <float.h>
#include <unistd.h>
#include <limits.h>
@@ -115,10 +113,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
another macro. */
#include "character.h"
-#ifndef DBL_MAX_10_EXP
-#define DBL_MAX_10_EXP 308 /* IEEE double */
-#endif
-
/* Generate output from a format-spec FORMAT,
terminated at position FORMAT_END.
(*FORMAT_END is not part of the format, but must exist and be readable.)
@@ -135,8 +129,8 @@ ptrdiff_t
doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
const char *format_end, va_list ap)
{
- const char *fmt = format; /* Pointer into format string */
- register char *bufptr = buffer; /* Pointer into output buffer.. */
+ const char *fmt = format; /* Pointer into format string. */
+ char *bufptr = buffer; /* Pointer into output buffer. */
/* Use this for sprintf unless we need something really big. */
char tembuf[DBL_MAX_10_EXP + 100];
@@ -150,7 +144,7 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
/* Buffer we have got with malloc. */
char *big_buffer = NULL;
- register size_t tem;
+ ptrdiff_t tem = -1;
char *string;
char fixed_buffer[20]; /* Default buffer for small formatting. */
char *fmtcpy;
@@ -161,10 +155,9 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
if (format_end == 0)
format_end = format + strlen (format);
- if (format_end - format < sizeof (fixed_buffer) - 1)
- fmtcpy = fixed_buffer;
- else
- SAFE_ALLOCA (fmtcpy, char *, format_end - format + 1);
+ fmtcpy = (format_end - format < sizeof (fixed_buffer) - 1
+ ? fixed_buffer
+ : SAFE_ALLOCA (format_end - format + 1));
bufsize--;
@@ -174,7 +167,7 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
if (*fmt == '%') /* Check for a '%' character */
{
ptrdiff_t size_bound = 0;
- EMACS_INT width; /* Columns occupied by STRING on display. */
+ ptrdiff_t width; /* Columns occupied by STRING on display. */
enum {
pDlen = sizeof pD - 1,
pIlen = sizeof pI - 1,
@@ -257,7 +250,7 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
{
if (big_buffer)
xfree (big_buffer);
- big_buffer = (char *) xmalloc (size_bound);
+ big_buffer = xmalloc (size_bound);
sprintf_buffer = big_buffer;
size_allocated = size_bound;
}
@@ -275,32 +268,32 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
case no_modifier:
{
int v = va_arg (ap, int);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case long_modifier:
{
long v = va_arg (ap, long);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pD_modifier:
signed_pD_modifier:
{
ptrdiff_t v = va_arg (ap, ptrdiff_t);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pI_modifier:
{
EMACS_INT v = va_arg (ap, EMACS_INT);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pM_modifier:
{
intmax_t v = va_arg (ap, intmax_t);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
}
@@ -315,13 +308,13 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
case no_modifier:
{
unsigned v = va_arg (ap, unsigned);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case long_modifier:
{
unsigned long v = va_arg (ap, unsigned long);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pD_modifier:
@@ -329,13 +322,13 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
case pI_modifier:
{
EMACS_UINT v = va_arg (ap, EMACS_UINT);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pM_modifier:
{
uintmax_t v = va_arg (ap, uintmax_t);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
}
@@ -348,7 +341,7 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
case 'g':
{
double d = va_arg (ap, double);
- sprintf (sprintf_buffer, fmtcpy, d);
+ tem = sprintf (sprintf_buffer, fmtcpy, d);
/* Now copy into final output, truncating as necessary. */
string = sprintf_buffer;
goto doit;
@@ -368,8 +361,8 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
/* Copy string into final output, truncating if no room. */
doit:
+ eassert (0 <= tem);
/* Coming here means STRING contains ASCII only. */
- tem = strlen (string);
if (STRING_BYTES_BOUND < tem)
error ("Format width or precision too large");
width = tem;
@@ -392,15 +385,19 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
{
/* Truncate the string at character boundary. */
tem = bufsize;
- while (!CHAR_HEAD_P (string[tem - 1])) tem--;
- /* If the multibyte sequence of this character is
- too long for the space we have left in the
- buffer, truncate before it. */
- if (tem > 0
- && BYTES_BY_CHAR_HEAD (string[tem - 1]) > bufsize)
- tem--;
- if (tem > 0)
- memcpy (bufptr, string, tem);
+ do
+ {
+ tem--;
+ if (CHAR_HEAD_P (string[tem]))
+ {
+ if (BYTES_BY_CHAR_HEAD (string[tem]) <= bufsize - tem)
+ tem = bufsize;
+ break;
+ }
+ }
+ while (tem != 0);
+
+ memcpy (bufptr, string, tem);
bufptr[tem] = 0;
/* Trigger exit from the loop, but make sure we
return to the caller a value which will indicate
@@ -409,8 +406,7 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
bufsize = 0;
continue;
}
- else
- memcpy (bufptr, string, tem);
+ memcpy (bufptr, string, tem);
bufptr += tem;
bufsize -= tem;
if (minlen < 0)
diff --git a/src/dosfns.c b/src/dosfns.c
index ab3433b7902..ce1ec4a4f93 100644
--- a/src/dosfns.c
+++ b/src/dosfns.c
@@ -1,6 +1,6 @@
/* MS-DOS specific Lisp utilities. Coded by Manabu Higashida, 1991.
Major changes May-July 1993 Morten Welinder (only 10% original code left)
- Copyright (C) 1991, 1993, 1996-1998, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1991, 1993, 1996-1998, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -23,9 +23,16 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* The entire file is within this conditional */
#include <stdio.h>
+/* gettime and settime in dos.h clash with their namesakes from
+ gnulib, so we move out of our way the prototypes in dos.h. */
+#define gettime dos_h_gettime_
+#define settime dos_h_settime_
#include <dos.h>
-#include <setjmp.h>
+#undef gettime
+#undef settime
+
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "termchar.h"
#include "frame.h"
@@ -35,7 +42,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dosfns.h"
#include "msdos.h"
#include "dispextern.h"
-#include "character.h"
#include "coding.h"
#include "process.h"
#include <dpmi.h>
@@ -65,27 +71,27 @@ REGISTERS should be a vector produced by `make-register' and
if (no < 0 || no > 0xff || ASIZE (registers) != 8)
return Qnil;
for (i = 0; i < 8; i++)
- CHECK_NUMBER (XVECTOR (registers)->contents[i]);
+ CHECK_NUMBER (AREF (registers, i));
- inregs.x.ax = (unsigned long) XFASTINT (XVECTOR (registers)->contents[0]);
- inregs.x.bx = (unsigned long) XFASTINT (XVECTOR (registers)->contents[1]);
- inregs.x.cx = (unsigned long) XFASTINT (XVECTOR (registers)->contents[2]);
- inregs.x.dx = (unsigned long) XFASTINT (XVECTOR (registers)->contents[3]);
- inregs.x.si = (unsigned long) XFASTINT (XVECTOR (registers)->contents[4]);
- inregs.x.di = (unsigned long) XFASTINT (XVECTOR (registers)->contents[5]);
- inregs.x.cflag = (unsigned long) XFASTINT (XVECTOR (registers)->contents[6]);
- inregs.x.flags = (unsigned long) XFASTINT (XVECTOR (registers)->contents[7]);
+ inregs.x.ax = (unsigned long) XFASTINT (AREF (registers, 0));
+ inregs.x.bx = (unsigned long) XFASTINT (AREF (registers, 1));
+ inregs.x.cx = (unsigned long) XFASTINT (AREF (registers, 2));
+ inregs.x.dx = (unsigned long) XFASTINT (AREF (registers, 3));
+ inregs.x.si = (unsigned long) XFASTINT (AREF (registers, 4));
+ inregs.x.di = (unsigned long) XFASTINT (AREF (registers, 5));
+ inregs.x.cflag = (unsigned long) XFASTINT (AREF (registers, 6));
+ inregs.x.flags = (unsigned long) XFASTINT (AREF (registers, 7));
int86 (no, &inregs, &outregs);
- XVECTOR (registers)->contents[0] = make_number (outregs.x.ax);
- XVECTOR (registers)->contents[1] = make_number (outregs.x.bx);
- XVECTOR (registers)->contents[2] = make_number (outregs.x.cx);
- XVECTOR (registers)->contents[3] = make_number (outregs.x.dx);
- XVECTOR (registers)->contents[4] = make_number (outregs.x.si);
- XVECTOR (registers)->contents[5] = make_number (outregs.x.di);
- XVECTOR (registers)->contents[6] = make_number (outregs.x.cflag);
- XVECTOR (registers)->contents[7] = make_number (outregs.x.flags);
+ ASET (registers, 0, make_number (outregs.x.ax));
+ ASET (registers, 1, make_number (outregs.x.bx));
+ ASET (registers, 2, make_number (outregs.x.cx));
+ ASET (registers, 3, make_number (outregs.x.dx));
+ ASET (registers, 4, make_number (outregs.x.si));
+ ASET (registers, 5, make_number (outregs.x.di));
+ ASET (registers, 6, make_number (outregs.x.cflag));
+ ASET (registers, 7, make_number (outregs.x.flags));
return registers;
}
@@ -109,7 +115,7 @@ Return the updated VECTOR. */)
dosmemget (offs, len, buf);
for (i = 0; i < len; i++)
- XVECTOR (vector)->contents[i] = make_number (buf[i]);
+ ASET (vector, i, make_number (buf[i]));
return vector;
}
@@ -132,8 +138,8 @@ DEFUN ("msdos-memput", Fdos_memput, Sdos_memput, 2, 2, 0,
for (i = 0; i < len; i++)
{
- CHECK_NUMBER (XVECTOR (vector)->contents[i]);
- buf[i] = (unsigned char) XFASTINT (XVECTOR (vector)->contents[i]) & 0xFF;
+ CHECK_NUMBER (AREF (vector, i));
+ buf[i] = (unsigned char) XFASTINT (AREF (vector, i)) & 0xFF;
}
dosmemput (buf, len, offs);
@@ -467,16 +473,16 @@ x_set_title (struct frame *f, Lisp_Object name)
update_mode_lines = 1;
- f->title = name;
+ fset_title (f, name);
if (NILP (name))
name = f->name;
if (FRAME_MSDOS_P (f))
{
- BLOCK_INPUT;
+ block_input ();
w95_set_virtual_machine_title (SDATA (name));
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
#endif /* !HAVE_X_WINDOWS */
@@ -540,7 +546,6 @@ system_process_attributes (Lisp_Object pid)
int i;
Lisp_Object cmd_str, decoded_cmd, tem;
double pmem;
- EXFUN (Fget_internal_run_time, 0);
#ifndef SYSTEM_MALLOC
extern unsigned long ret_lim_data ();
#endif
@@ -557,7 +562,7 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
strcpy (cmd, basename (__crt0_argv[0]));
/* Command name is encoded in locale-coding-system; decode it. */
- cmd_str = make_unibyte_string (cmd, strlen (cmd));
+ cmd_str = build_unibyte_string (cmd);
decoded_cmd = code_convert_string_norecord (cmd_str,
Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
@@ -625,7 +630,7 @@ system_process_attributes (Lisp_Object pid)
q[-1] = '\0';
/* Command line is encoded in locale-coding-system; decode it. */
- cmd_str = make_unibyte_string (cmdline, strlen (cmdline));
+ cmd_str = build_unibyte_string (cmdline);
decoded_cmd = code_convert_string_norecord (cmd_str,
Vlocale_coding_system, 0);
xfree (cmdline);
@@ -710,7 +715,7 @@ Implicitly modified when the TZ variable is changed. */);
#endif
DEFVAR_LISP ("dos-display-scancodes", Vdos_display_scancodes,
- doc: /* *Controls whether DOS raw keyboard events are displayed as you type.
+ doc: /* Whether DOS raw keyboard events are displayed as you type.
When non-nil, the keyboard scan-codes are displayed at the bottom right
corner of the display (typically at the end of the mode line).
The output format is: scan code:char code*modifiers. */);
@@ -718,17 +723,17 @@ The output format is: scan code:char code*modifiers. */);
Vdos_display_scancodes = Qnil;
DEFVAR_INT ("dos-hyper-key", dos_hyper_key,
- doc: /* *If set to 1, use right ALT key as hyper key.
+ doc: /* If set to 1, use right ALT key as hyper key.
If set to 2, use right CTRL key as hyper key. */);
dos_hyper_key = 0;
DEFVAR_INT ("dos-super-key", dos_super_key,
- doc: /* *If set to 1, use right ALT key as super key.
+ doc: /* If set to 1, use right ALT key as super key.
If set to 2, use right CTRL key as super key. */);
dos_super_key = 0;
DEFVAR_INT ("dos-keypad-mode", dos_keypad_mode,
- doc: /* *Controls what key code is returned by a key in the numeric keypad.
+ doc: /* Controls what key code is returned by a key in the numeric keypad.
The `numlock ON' action is only taken if no modifier keys are pressed.
The value is an integer constructed by adding the following bits together:
@@ -764,4 +769,3 @@ If zero, the decimal point key returns the country code specific value. */);
dos_decimal_point = 0;
}
#endif /* MSDOS */
-
diff --git a/src/dosfns.h b/src/dosfns.h
index 89800598d28..9747c364d71 100644
--- a/src/dosfns.h
+++ b/src/dosfns.h
@@ -2,7 +2,7 @@
Coded by Manabu Higashida, 1991.
Modified by Morten Welinder, 1993-1994.
-Copyright (C) 1991, 1994-1995, 1997, 1999, 2001-2011
+Copyright (C) 1991, 1994-1995, 1997, 1999, 2001-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/editfns.c b/src/editfns.c
index 7077f40e51c..8122ffdd0d4 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -1,6 +1,6 @@
/* Lisp functions pertaining to editing.
-Copyright (C) 1985-1987, 1989, 1993-2011 Free Software Foundation, Inc.
+Copyright (C) 1985-1987, 1989, 1993-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,7 +21,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <sys/types.h>
#include <stdio.h>
-#include <setjmp.h>
#ifdef HAVE_PWD_H
#include <pwd.h>
@@ -44,7 +43,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/resource.h>
#endif
-#include <ctype.h>
#include <float.h>
#include <limits.h>
#include <intprops.h>
@@ -52,46 +50,25 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <verify.h>
#include "intervals.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "coding.h"
#include "frame.h"
#include "window.h"
#include "blockinput.h"
-#ifndef NULL
-#define NULL 0
-#endif
-
-#ifndef USER_FULL_NAME
-#define USER_FULL_NAME pw->pw_gecos
-#endif
-
-#ifndef USE_CRT_DLL
-extern char **environ;
-#endif
-
#define TM_YEAR_BASE 1900
-/* Nonzero if TM_YEAR is a struct tm's tm_year value that causes
- asctime to have well-defined behavior. */
-#ifndef TM_YEAR_IN_ASCTIME_RANGE
-# define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \
- (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE)
-#endif
-
#ifdef WINDOWSNT
extern Lisp_Object w32_get_internal_run_time (void);
#endif
-static void time_overflow (void) NO_RETURN;
-static Lisp_Object format_time_string (char const *, ptrdiff_t, Lisp_Object,
- int, time_t *, struct tm **);
+static Lisp_Object format_time_string (char const *, ptrdiff_t, EMACS_TIME,
+ bool, struct tm *);
static int tm_diff (struct tm *, struct tm *);
-static void update_buffer_properties (EMACS_INT, EMACS_INT);
+static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
static Lisp_Object Qbuffer_access_fontify_functions;
-static Lisp_Object Fuser_full_name (Lisp_Object);
/* Symbol for the text property used to mark fields. */
@@ -148,8 +125,14 @@ init_editfns (void)
/* If the user name claimed in the environment vars differs from
the real uid, use the claimed name to find the full name. */
tem = Fstring_equal (Vuser_login_name, Vuser_real_login_name);
- Vuser_full_name = Fuser_full_name (NILP (tem)? make_number (geteuid ())
- : Vuser_login_name);
+ if (! NILP (tem))
+ tem = Vuser_login_name;
+ else
+ {
+ uid_t euid = geteuid ();
+ tem = make_fixnum_or_float (euid);
+ }
+ Vuser_full_name = Fuser_full_name (tem);
p = getenv ("NAME");
if (p)
@@ -212,15 +195,6 @@ DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0,
XSETFASTINT (val, 0);
return val;
}
-
-static Lisp_Object
-buildmark (EMACS_INT charpos, EMACS_INT bytepos)
-{
- register Lisp_Object mark;
- mark = Fmake_marker ();
- set_marker_both (mark, Qnil, charpos, bytepos);
- return mark;
-}
DEFUN ("point", Fpoint, Spoint, 0, 0, 0,
doc: /* Return value of point, as an integer.
@@ -236,18 +210,7 @@ DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
doc: /* Return value of point, as a marker object. */)
(void)
{
- return buildmark (PT, PT_BYTE);
-}
-
-EMACS_INT
-clip_to_bounds (EMACS_INT lower, EMACS_INT num, EMACS_INT upper)
-{
- if (num < lower)
- return lower;
- else if (num > upper)
- return upper;
- else
- return num;
+ return build_marker (current_buffer, PT, PT_BYTE);
}
DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
@@ -257,7 +220,7 @@ Beginning of buffer is position (point-min), end is (point-max).
The return value is POSITION. */)
(register Lisp_Object position)
{
- EMACS_INT pos;
+ ptrdiff_t pos;
if (MARKERP (position)
&& current_buffer == XMARKER (position)->buffer)
@@ -282,11 +245,11 @@ The return value is POSITION. */)
/* Return the start or end position of the region.
- BEGINNINGP non-zero means return the start.
+ BEGINNINGP means return the start.
If there is no region active, signal an error. */
static Lisp_Object
-region_limit (int beginningp)
+region_limit (bool beginningp)
{
Lisp_Object m;
@@ -299,9 +262,10 @@ region_limit (int beginningp)
if (NILP (m))
error ("The mark is not set now, so there is no region");
- if ((PT < XFASTINT (m)) == (beginningp != 0))
- m = make_number (PT);
- return m;
+ /* Clip to the current narrowing (bug#11770). */
+ return make_number ((PT < XFASTINT (m)) == beginningp
+ ? PT
+ : clip_to_bounds (BEGV, XFASTINT (m), ZV));
}
DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0,
@@ -337,7 +301,7 @@ overlays_around (EMACS_INT pos, Lisp_Object *vec, ptrdiff_t len)
{
Lisp_Object overlay, start, end;
struct Lisp_Overlay *tail;
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
ptrdiff_t idx = 0;
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
@@ -414,14 +378,14 @@ get_pos_property (Lisp_Object position, register Lisp_Object prop, Lisp_Object o
/* First try with room for 40 overlays. */
noverlays = 40;
- overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object));
+ overlay_vec = alloca (noverlays * sizeof *overlay_vec);
noverlays = overlays_around (posn, overlay_vec, noverlays);
/* If there are more than 40,
make enough space for all, and try again. */
if (noverlays > 40)
{
- overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object));
+ overlay_vec = alloca (noverlays * sizeof *overlay_vec);
noverlays = overlays_around (posn, overlay_vec, noverlays);
}
noverlays = sort_overlays (overlay_vec, noverlays, NULL);
@@ -470,12 +434,12 @@ get_pos_property (Lisp_Object position, register Lisp_Object prop, Lisp_Object o
BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
results; they do not effect boundary behavior.
- If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
+ If MERGE_AT_BOUNDARY is non-nil, then if POS is at the very first
position of a field, then the beginning of the previous field is
returned instead of the beginning of POS's field (since the end of a
field is actually also the beginning of the next input field, this
behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
- true case, if two fields are separated by a field with the special
+ non-nil case, if two fields are separated by a field with the special
value `boundary', and POS lies within it, then the two separated
fields are considered to be adjacent, and POS between them, when
finding the beginning and ending of the "merged" field.
@@ -486,14 +450,14 @@ get_pos_property (Lisp_Object position, register Lisp_Object prop, Lisp_Object o
static void
find_field (Lisp_Object pos, Lisp_Object merge_at_boundary,
Lisp_Object beg_limit,
- EMACS_INT *beg, Lisp_Object end_limit, EMACS_INT *end)
+ ptrdiff_t *beg, Lisp_Object end_limit, ptrdiff_t *end)
{
/* Fields right before and after the point. */
Lisp_Object before_field, after_field;
- /* 1 if POS counts as the start of a field. */
- int at_field_start = 0;
- /* 1 if POS counts as the end of a field. */
- int at_field_end = 0;
+ /* True if POS counts as the start of a field. */
+ bool at_field_start = 0;
+ /* True if POS counts as the end of a field. */
+ bool at_field_end = 0;
if (NILP (pos))
XSETFASTINT (pos, PT);
@@ -537,19 +501,19 @@ find_field (Lisp_Object pos, Lisp_Object merge_at_boundary,
xxxx.yyyy
- In this situation, if merge_at_boundary is true, we consider the
+ In this situation, if merge_at_boundary is non-nil, consider the
`x' and `y' fields as forming one big merged field, and so the end
of the field is the end of `y'.
However, if `x' and `y' are separated by a special `boundary' field
- (a field with a `field' char-property of 'boundary), then we ignore
+ (a field with a `field' char-property of 'boundary), then ignore
this special field when merging adjacent fields. Here's the same
situation, but with a `boundary' field between the `x' and `y' fields:
xxx.BBBByyyy
Here, if point is at the end of `x', the beginning of `y', or
- anywhere in-between (within the `boundary' field), we merge all
+ anywhere in-between (within the `boundary' field), merge all
three fields and consider the beginning as being the beginning of
the `x' field, and the end as being the end of the `y' field. */
@@ -602,7 +566,7 @@ A field is a region of text with the same `field' property.
If POS is nil, the value of point is used for POS. */)
(Lisp_Object pos)
{
- EMACS_INT beg, end;
+ ptrdiff_t beg, end;
find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
if (beg != end)
del_range (beg, end);
@@ -615,7 +579,7 @@ A field is a region of text with the same `field' property.
If POS is nil, the value of point is used for POS. */)
(Lisp_Object pos)
{
- EMACS_INT beg, end;
+ ptrdiff_t beg, end;
find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
return make_buffer_string (beg, end, 1);
}
@@ -626,7 +590,7 @@ A field is a region of text with the same `field' property.
If POS is nil, the value of point is used for POS. */)
(Lisp_Object pos)
{
- EMACS_INT beg, end;
+ ptrdiff_t beg, end;
find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
return make_buffer_string (beg, end, 0);
}
@@ -641,7 +605,7 @@ If LIMIT is non-nil, it is a buffer position; if the beginning of the field
is before LIMIT, then LIMIT will be returned instead. */)
(Lisp_Object pos, Lisp_Object escape_from_edge, Lisp_Object limit)
{
- EMACS_INT beg;
+ ptrdiff_t beg;
find_field (pos, escape_from_edge, limit, &beg, Qnil, 0);
return make_number (beg);
}
@@ -656,17 +620,18 @@ If LIMIT is non-nil, it is a buffer position; if the end of the field
is after LIMIT, then LIMIT will be returned instead. */)
(Lisp_Object pos, Lisp_Object escape_from_edge, Lisp_Object limit)
{
- EMACS_INT end;
+ ptrdiff_t end;
find_field (pos, escape_from_edge, Qnil, 0, limit, &end);
return make_number (end);
}
DEFUN ("constrain-to-field", Fconstrain_to_field, Sconstrain_to_field, 2, 5, 0,
doc: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
-
A field is a region of text with the same `field' property.
-If NEW-POS is nil, then the current point is used instead, and set to the
-constrained position if that is different.
+
+If NEW-POS is nil, then use the current point instead, and move point
+to the resulting constrained position, in addition to returning that
+position.
If OLD-POS is at the boundary of two fields, then the allowable
positions for NEW-POS depends on the value of the optional argument
@@ -691,8 +656,8 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
(Lisp_Object new_pos, Lisp_Object old_pos, Lisp_Object escape_from_edge, Lisp_Object only_in_line, Lisp_Object inhibit_capture_property)
{
/* If non-zero, then the original point, before re-positioning. */
- EMACS_INT orig_point = 0;
- int fwd;
+ ptrdiff_t orig_point = 0;
+ bool fwd;
Lisp_Object prev_old, prev_new;
if (NILP (new_pos))
@@ -705,10 +670,10 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
CHECK_NUMBER_COERCE_MARKER (new_pos);
CHECK_NUMBER_COERCE_MARKER (old_pos);
- fwd = (XFASTINT (new_pos) > XFASTINT (old_pos));
+ fwd = (XINT (new_pos) > XINT (old_pos));
- prev_old = make_number (XFASTINT (old_pos) - 1);
- prev_new = make_number (XFASTINT (new_pos) - 1);
+ prev_old = make_number (XINT (old_pos) - 1);
+ prev_new = make_number (XINT (new_pos) - 1);
if (NILP (Vinhibit_field_text_motion)
&& !EQ (new_pos, old_pos)
@@ -733,7 +698,7 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
/* It is possible that NEW_POS is not within the same field as
OLD_POS; try to move NEW_POS so that it is. */
{
- EMACS_INT shortage;
+ ptrdiff_t shortage;
Lisp_Object field_bound;
if (fwd)
@@ -773,23 +738,24 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
DEFUN ("line-beginning-position",
Fline_beginning_position, Sline_beginning_position, 0, 1, 0,
doc: /* Return the character position of the first character on the current line.
-With argument N not nil or 1, move forward N - 1 lines first.
-If scan reaches end of buffer, return that position.
+With optional argument N, scan forward N - 1 lines first.
+If the scan reaches the end of the buffer, return that position.
-The returned position is of the first character in the logical order,
-i.e. the one that has the smallest character position.
+This function ignores text display directionality; it returns the
+position of the first character in logical order, i.e. the smallest
+character position on the line.
This function constrains the returned position to the current field
-unless that would be on a different line than the original,
+unless that position would be on a different line than the original,
unconstrained result. If N is nil or 1, and a front-sticky field
starts at point, the scan stops as soon as it starts. To ignore field
-boundaries bind `inhibit-field-text-motion' to t.
+boundaries, bind `inhibit-field-text-motion' to t.
This function does not move point. */)
(Lisp_Object n)
{
- EMACS_INT orig, orig_byte, end;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t orig, orig_byte, end;
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_point_motion_hooks, Qt);
if (NILP (n))
@@ -817,8 +783,9 @@ DEFUN ("line-end-position", Fline_end_position, Sline_end_position, 0, 1, 0,
With argument N not nil or 1, move forward N - 1 lines first.
If scan reaches end of buffer, return that position.
-The returned position is of the last character in the logical order,
-i.e. the character whose buffer position is the largest one.
+This function ignores text display directionality; it returns the
+position of the last character in logical order, i.e. the largest
+character position on the line.
This function constrains the returned position to the current field
unless that would be on a different line than the original,
@@ -829,15 +796,17 @@ boundaries bind `inhibit-field-text-motion' to t.
This function does not move point. */)
(Lisp_Object n)
{
- EMACS_INT end_pos;
- EMACS_INT orig = PT;
+ ptrdiff_t clipped_n;
+ ptrdiff_t end_pos;
+ ptrdiff_t orig = PT;
if (NILP (n))
XSETFASTINT (n, 1);
else
CHECK_NUMBER (n);
- end_pos = find_before_next_newline (orig, 0, XINT (n) - (XINT (n) <= 0));
+ clipped_n = clip_to_bounds (PTRDIFF_MIN + 1, XINT (n), PTRDIFF_MAX);
+ end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0));
/* Return END_POS constrained to the current input field. */
return Fconstrain_to_field (make_number (end_pos), make_number (orig),
@@ -848,11 +817,15 @@ This function does not move point. */)
Lisp_Object
save_excursion_save (void)
{
- int visible = (XBUFFER (XWINDOW (selected_window)->buffer)
- == current_buffer);
+ bool visible = (XBUFFER (XWINDOW (selected_window)->buffer)
+ == current_buffer);
+ /* Do not copy the mark if it points to nowhere. */
+ Lisp_Object mark = (XMARKER (BVAR (current_buffer, mark))->buffer
+ ? Fcopy_marker (BVAR (current_buffer, mark), Qnil)
+ : Qnil);
return Fcons (Fpoint_marker (),
- Fcons (Fcopy_marker (BVAR (current_buffer, mark), Qnil),
+ Fcons (mark,
Fcons (visible ? Qt : Qnil,
Fcons (BVAR (current_buffer, mark_active),
selected_window))));
@@ -863,7 +836,7 @@ save_excursion_restore (Lisp_Object info)
{
Lisp_Object tem, tem1, omark, nmark;
struct gcpro gcpro1, gcpro2, gcpro3;
- int visible_p;
+ bool visible_p;
tem = Fmarker_buffer (XCAR (info));
/* If buffer being returned to is now deleted, avoid error */
@@ -887,9 +860,14 @@ save_excursion_restore (Lisp_Object info)
info = XCDR (info);
tem = XCAR (info);
omark = Fmarker_position (BVAR (current_buffer, mark));
- Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ());
- nmark = Fmarker_position (tem);
- unchain_marker (XMARKER (tem));
+ if (NILP (tem))
+ unchain_marker (XMARKER (BVAR (current_buffer, mark)));
+ else
+ {
+ Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ());
+ nmark = Fmarker_position (tem);
+ unchain_marker (XMARKER (tem));
+ }
/* visible */
info = XCDR (info);
@@ -909,7 +887,7 @@ save_excursion_restore (Lisp_Object info)
info = XCDR (info);
tem = XCAR (info);
tem1 = BVAR (current_buffer, mark_active);
- BVAR (current_buffer, mark_active) = tem;
+ bset_mark_active (current_buffer, tem);
/* If mark is active now, and either was not active
or was at a different place, run the activate hook. */
@@ -964,7 +942,7 @@ usage: (save-excursion &rest BODY) */)
(Lisp_Object args)
{
register Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (save_excursion_restore, save_excursion_save ());
@@ -973,18 +951,15 @@ usage: (save-excursion &rest BODY) */)
}
DEFUN ("save-current-buffer", Fsave_current_buffer, Ssave_current_buffer, 0, UNEVALLED, 0,
- doc: /* Save the current buffer; execute BODY; restore the current buffer.
-Executes BODY just like `progn'.
+ doc: /* Record which buffer is current; execute BODY; make that buffer current.
+BODY is executed just like `progn'.
usage: (save-current-buffer &rest BODY) */)
(Lisp_Object args)
{
- Lisp_Object val;
- int count = SPECPDL_INDEX ();
-
- record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+ ptrdiff_t count = SPECPDL_INDEX ();
- val = Fprogn (args);
- return unbind_to (count, val);
+ record_unwind_current_buffer ();
+ return unbind_to (count, Fprogn (args));
}
DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 1, 0,
@@ -1017,7 +992,7 @@ DEFUN ("point-min-marker", Fpoint_min_marker, Spoint_min_marker, 0, 0, 0,
This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
(void)
{
- return buildmark (BEGV, BEGV_BYTE);
+ return build_marker (current_buffer, BEGV, BEGV_BYTE);
}
DEFUN ("point-max", Fpoint_max, Spoint_max, 0, 0, 0,
@@ -1037,7 +1012,7 @@ This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
is in effect, in which case it is less. */)
(void)
{
- return buildmark (ZV, ZV_BYTE);
+ return build_marker (current_buffer, ZV, ZV_BYTE);
}
DEFUN ("gap-position", Fgap_position, Sgap_position, 0, 0, 0,
@@ -1105,7 +1080,7 @@ At the beginning of the buffer or accessible region, return 0. */)
XSETFASTINT (temp, 0);
else if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
- EMACS_INT pos = PT_BYTE;
+ ptrdiff_t pos = PT_BYTE;
DEC_POS (pos);
XSETFASTINT (temp, FETCH_CHAR (pos));
}
@@ -1159,7 +1134,7 @@ POS is an integer or a marker and defaults to point.
If POS is out of range, the value is nil. */)
(Lisp_Object pos)
{
- register EMACS_INT pos_byte;
+ register ptrdiff_t pos_byte;
if (NILP (pos))
{
@@ -1192,7 +1167,7 @@ If POS is out of range, the value is nil. */)
(Lisp_Object pos)
{
register Lisp_Object val;
- register EMACS_INT pos_byte;
+ register ptrdiff_t pos_byte;
if (NILP (pos))
{
@@ -1252,10 +1227,10 @@ of the user with that uid, or nil if there is no such user. */)
if (NILP (uid))
return Vuser_login_name;
- id = XFLOATINT (uid);
- BLOCK_INPUT;
+ CONS_TO_INTEGER (uid, uid_t, id);
+ block_input ();
pw = getpwuid (id);
- UNBLOCK_INPUT;
+ unblock_input ();
return (pw ? build_string (pw->pw_name) : Qnil);
}
@@ -1279,14 +1254,7 @@ DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0,
Value is an integer or a float, depending on the value. */)
(void)
{
- /* Assignment to EMACS_INT stops GCC whining about limited range of
- data type. */
- EMACS_INT euid = geteuid ();
-
- /* Make sure we don't produce a negative UID due to signed integer
- overflow. */
- if (euid < 0)
- return make_float (geteuid ());
+ uid_t euid = geteuid ();
return make_fixnum_or_float (euid);
}
@@ -1295,14 +1263,7 @@ DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0,
Value is an integer or a float, depending on the value. */)
(void)
{
- /* Assignment to EMACS_INT stops GCC whining about limited range of
- data type. */
- EMACS_INT uid = getuid ();
-
- /* Make sure we don't produce a negative UID due to signed integer
- overflow. */
- if (uid < 0)
- return make_float (getuid ());
+ uid_t uid = getuid ();
return make_fixnum_or_float (uid);
}
@@ -1325,16 +1286,17 @@ name, or nil if there is no such user. */)
return Vuser_full_name;
else if (NUMBERP (uid))
{
- uid_t u = XFLOATINT (uid);
- BLOCK_INPUT;
+ uid_t u;
+ CONS_TO_INTEGER (uid, uid_t, u);
+ block_input ();
pw = getpwuid (u);
- UNBLOCK_INPUT;
+ unblock_input ();
}
else if (STRINGP (uid))
{
- BLOCK_INPUT;
+ block_input ();
pw = getpwnam (SSDATA (uid));
- UNBLOCK_INPUT;
+ unblock_input ();
}
else
error ("Invalid UID specification");
@@ -1357,7 +1319,7 @@ name, or nil if there is no such user. */)
Lisp_Object login;
login = Fuser_login_name (make_number (pw->pw_uid));
- r = (char *) alloca (strlen (p) + SCHARS (login) + 1);
+ r = alloca (strlen (p) + SCHARS (login) + 1);
memcpy (r, p, q - p);
r[q - p] = 0;
strcat (r, SSDATA (login));
@@ -1377,20 +1339,12 @@ DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0,
return Vsystem_name;
}
-const char *
-get_system_name (void)
-{
- if (STRINGP (Vsystem_name))
- return SSDATA (Vsystem_name);
- else
- return "";
-}
-
DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0,
- doc: /* Return the process ID of Emacs, as an integer. */)
+ doc: /* Return the process ID of Emacs, as a number. */)
(void)
{
- return make_number (getpid ());
+ pid_t pid = getpid ();
+ return make_fixnum_or_float (pid);
}
@@ -1403,14 +1357,13 @@ DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0,
#endif
/* Report that a time value is out of range for Emacs. */
-static void
+void
time_overflow (void)
{
error ("Specified time is not representable");
}
-/* Return the upper part of the time T (everything but the bottom 16 bits),
- making sure that it is representable. */
+/* Return the upper part of the time T (everything but the bottom 16 bits). */
static EMACS_INT
hi_time (time_t t)
{
@@ -1430,7 +1383,7 @@ hi_time (time_t t)
}
/* Return the bottom 16 bits of the time T. */
-static EMACS_INT
+static int
lo_time (time_t t)
{
return t & ((1 << 16) - 1);
@@ -1438,34 +1391,23 @@ lo_time (time_t t)
DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0,
doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
-The time is returned as a list of three integers. The first has the
-most significant 16 bits of the seconds, while the second has the
-least significant 16 bits. The third integer gives the microsecond
-count.
-
-The microsecond count is zero on systems that do not provide
-resolution finer than a second. */)
+The time is returned as a list of integers (HIGH LOW USEC PSEC).
+HIGH has the most significant bits of the seconds, while LOW has the
+least significant 16 bits. USEC and PSEC are the microsecond and
+picosecond counts. */)
(void)
{
- EMACS_TIME t;
-
- EMACS_GET_TIME (t);
- return list3 (make_number (hi_time (EMACS_SECS (t))),
- make_number (lo_time (EMACS_SECS (t))),
- make_number (EMACS_USECS (t)));
+ return make_lisp_time (current_emacs_time ());
}
DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
0, 0, 0,
doc: /* Return the current run time used by Emacs.
-The time is returned as a list of three integers. The first has the
-most significant 16 bits of the seconds, while the second has the
-least significant 16 bits. The third integer gives the microsecond
-count.
+The time is returned as a list (HIGH LOW USEC PSEC), using the same
+style as (current-time).
On systems that can't determine the run time, `get-internal-run-time'
-does the same thing as `current-time'. The microsecond count is zero
-on systems that do not provide resolution finer than a second. */)
+does the same thing as `current-time'. */)
(void)
{
#ifdef HAVE_GETRUSAGE
@@ -1485,10 +1427,7 @@ on systems that do not provide resolution finer than a second. */)
usecs -= 1000000;
secs++;
}
-
- return list3 (make_number (hi_time (secs)),
- make_number (lo_time (secs)),
- make_number (usecs));
+ return make_lisp_time (make_emacs_time (secs, usecs * 1000));
#else /* ! HAVE_GETRUSAGE */
#ifdef WINDOWSNT
return w32_get_internal_run_time ();
@@ -1499,78 +1438,166 @@ on systems that do not provide resolution finer than a second. */)
}
-/* Make a Lisp list that represents the time T. */
-Lisp_Object
+/* Make a Lisp list that represents the time T with fraction TAIL. */
+static Lisp_Object
+make_time_tail (time_t t, Lisp_Object tail)
+{
+ return Fcons (make_number (hi_time (t)),
+ Fcons (make_number (lo_time (t)), tail));
+}
+
+/* Make a Lisp list that represents the system time T. */
+static Lisp_Object
make_time (time_t t)
{
- return list2 (make_number (hi_time (t)),
- make_number (lo_time (t)));
+ return make_time_tail (t, Qnil);
+}
+
+/* Make a Lisp list that represents the Emacs time T. T may be an
+ invalid time, with a slightly negative tv_nsec value such as
+ UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a
+ correspondingly negative picosecond count. */
+Lisp_Object
+make_lisp_time (EMACS_TIME t)
+{
+ int ns = EMACS_NSECS (t);
+ return make_time_tail (EMACS_SECS (t),
+ list2 (make_number (ns / 1000),
+ make_number (ns % 1000 * 1000)));
}
/* Decode a Lisp list SPECIFIED_TIME that represents a time.
- If SPECIFIED_TIME is nil, use the current time.
- Set *RESULT to seconds since the Epoch.
- If USEC is not null, set *USEC to the microseconds component.
- Return nonzero if successful. */
-int
-lisp_time_argument (Lisp_Object specified_time, time_t *result, int *usec)
+ Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values.
+ Return true if successful. */
+static bool
+disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh,
+ Lisp_Object *plow, Lisp_Object *pusec,
+ Lisp_Object *ppsec)
{
- if (NILP (specified_time))
+ if (CONSP (specified_time))
{
- if (usec)
- {
- EMACS_TIME t;
+ Lisp_Object low = XCDR (specified_time);
+ Lisp_Object usec = make_number (0);
+ Lisp_Object psec = make_number (0);
+ if (CONSP (low))
+ {
+ Lisp_Object low_tail = XCDR (low);
+ low = XCAR (low);
+ if (CONSP (low_tail))
+ {
+ usec = XCAR (low_tail);
+ low_tail = XCDR (low_tail);
+ if (CONSP (low_tail))
+ psec = XCAR (low_tail);
+ }
+ else if (!NILP (low_tail))
+ usec = low_tail;
+ }
- EMACS_GET_TIME (t);
- *usec = EMACS_USECS (t);
- *result = EMACS_SECS (t);
- return 1;
- }
+ *phigh = XCAR (specified_time);
+ *plow = low;
+ *pusec = usec;
+ *ppsec = psec;
+ return 1;
+ }
+
+ return 0;
+}
+
+/* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp
+ list, generate the corresponding time value.
+
+ If RESULT is not null, store into *RESULT the converted time;
+ this can fail if the converted time does not fit into EMACS_TIME.
+ If *DRESULT is not null, store into *DRESULT the number of
+ seconds since the start of the POSIX Epoch.
+
+ Return true if successful. */
+bool
+decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec,
+ Lisp_Object psec,
+ EMACS_TIME *result, double *dresult)
+{
+ EMACS_INT hi, lo, us, ps;
+ if (! (INTEGERP (high) && INTEGERP (low)
+ && INTEGERP (usec) && INTEGERP (psec)))
+ return 0;
+ hi = XINT (high);
+ lo = XINT (low);
+ us = XINT (usec);
+ ps = XINT (psec);
+
+ /* Normalize out-of-range lower-order components by carrying
+ each overflow into the next higher-order component. */
+ us += ps / 1000000 - (ps % 1000000 < 0);
+ lo += us / 1000000 - (us % 1000000 < 0);
+ hi += lo >> 16;
+ ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0);
+ us = us % 1000000 + 1000000 * (us % 1000000 < 0);
+ lo &= (1 << 16) - 1;
+
+ if (result)
+ {
+ if ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> 16 <= hi : 0 <= hi)
+ && hi <= TIME_T_MAX >> 16)
+ {
+ /* Return the greatest representable time that is not greater
+ than the requested time. */
+ time_t sec = hi;
+ *result = make_emacs_time ((sec << 16) + lo, us * 1000 + ps / 1000);
+ }
else
- return time (result) != -1;
+ {
+ /* Overflow in the highest-order component. */
+ return 0;
+ }
}
+
+ if (dresult)
+ *dresult = (us * 1e6 + ps) / 1e12 + lo + hi * 65536.0;
+
+ return 1;
+}
+
+/* Decode a Lisp list SPECIFIED_TIME that represents a time.
+ If SPECIFIED_TIME is nil, use the current time.
+
+ Round the time down to the nearest EMACS_TIME value.
+ Return seconds since the Epoch.
+ Signal an error if unsuccessful. */
+EMACS_TIME
+lisp_time_argument (Lisp_Object specified_time)
+{
+ EMACS_TIME t;
+ if (NILP (specified_time))
+ t = current_emacs_time ();
else
{
- Lisp_Object high, low;
- EMACS_INT hi;
- high = Fcar (specified_time);
- CHECK_NUMBER (high);
- low = Fcdr (specified_time);
- if (CONSP (low))
- {
- if (usec)
- {
- Lisp_Object usec_l = Fcdr (low);
- if (CONSP (usec_l))
- usec_l = Fcar (usec_l);
- if (NILP (usec_l))
- *usec = 0;
- else
- {
- CHECK_NUMBER (usec_l);
- *usec = XINT (usec_l);
- }
- }
- low = Fcar (low);
- }
- else if (usec)
- *usec = 0;
- CHECK_NUMBER (low);
- hi = XINT (high);
-
- /* Check for overflow, helping the compiler for common cases
- where no runtime check is needed, and taking care not to
- convert negative numbers to unsigned before comparing them. */
- if (! ((TYPE_SIGNED (time_t)
- ? (TIME_T_MIN >> 16 <= MOST_NEGATIVE_FIXNUM
- || TIME_T_MIN >> 16 <= hi)
- : 0 <= hi)
- && (MOST_POSITIVE_FIXNUM <= TIME_T_MAX >> 16
- || hi <= TIME_T_MAX >> 16)))
- return 0;
-
- *result = (hi << 16) + (XINT (low) & 0xffff);
- return 1;
+ Lisp_Object high, low, usec, psec;
+ if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
+ && decode_time_components (high, low, usec, psec, &t, 0)))
+ error ("Invalid time specification");
+ }
+ return t;
+}
+
+/* Like lisp_time_argument, except decode only the seconds part,
+ do not allow out-of-range time stamps, do not check the subseconds part,
+ and always round down. */
+static time_t
+lisp_seconds_argument (Lisp_Object specified_time)
+{
+ if (NILP (specified_time))
+ return time (NULL);
+ else
+ {
+ Lisp_Object high, low, usec, psec;
+ EMACS_TIME t;
+ if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
+ && decode_time_components (high, low, make_number (0),
+ make_number (0), &t, 0)))
+ error ("Invalid time specification");
+ return EMACS_SECS (t);
}
}
@@ -1578,27 +1605,35 @@ DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0,
doc: /* Return the current time, as a float number of seconds since the epoch.
If SPECIFIED-TIME is given, it is the time to convert to float
instead of the current time. The argument should have the form
-(HIGH LOW) or (HIGH LOW USEC). Thus, you can use times obtained from
-`current-time' and from `file-attributes'. SPECIFIED-TIME can also
-have the form (HIGH . LOW), but this is considered obsolete.
+(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus,
+you can use times from `current-time' and from `file-attributes'.
+SPECIFIED-TIME can also have the form (HIGH . LOW), but this is
+considered obsolete.
WARNING: Since the result is floating point, it may not be exact.
If precise time stamps are required, use either `current-time',
or (if you need time as a string) `format-time-string'. */)
(Lisp_Object specified_time)
{
- time_t sec;
- int usec;
-
- if (! lisp_time_argument (specified_time, &sec, &usec))
- error ("Invalid time specification");
-
- return make_float ((sec * 1e6 + usec) / 1e6);
+ double t;
+ if (NILP (specified_time))
+ {
+ EMACS_TIME now = current_emacs_time ();
+ t = EMACS_SECS (now) + EMACS_NSECS (now) / 1e9;
+ }
+ else
+ {
+ Lisp_Object high, low, usec, psec;
+ if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
+ && decode_time_components (high, low, usec, psec, 0, &t)))
+ error ("Invalid time specification");
+ }
+ return make_float (t);
}
/* Write information into buffer S of size MAXSIZE, according to the
FORMAT of length FORMAT_LEN, using time information taken from *TP.
- Default to Universal Time if UT is nonzero, local time otherwise.
+ Default to Universal Time if UT, local time otherwise.
Use NS as the number of nanoseconds in the %N directive.
Return the number of bytes written, not including the terminating
'\0'. If S is NULL, nothing will be written anywhere; so to
@@ -1609,7 +1644,7 @@ or (if you need time as a string) `format-time-string'. */)
bytes in FORMAT and it does not support nanoseconds. */
static size_t
emacs_nmemftime (char *s, size_t maxsize, const char *format,
- size_t format_len, const struct tm *tp, int ut, int ns)
+ size_t format_len, const struct tm *tp, bool ut, int ns)
{
size_t total = 0;
@@ -1648,7 +1683,7 @@ emacs_nmemftime (char *s, size_t maxsize, const char *format,
DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0,
doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
-TIME is specified as (HIGH LOW . IGNORED), as returned by
+TIME is specified as (HIGH LOW USEC PSEC), as returned by
`current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
is also still accepted.
The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
@@ -1702,66 +1737,62 @@ For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z".
usage: (format-time-string FORMAT-STRING &optional TIME UNIVERSAL) */)
(Lisp_Object format_string, Lisp_Object timeval, Lisp_Object universal)
{
- time_t t;
- struct tm *tm;
+ EMACS_TIME t = lisp_time_argument (timeval);
+ struct tm tm;
CHECK_STRING (format_string);
format_string = code_convert_string_norecord (format_string,
Vlocale_coding_system, 1);
return format_time_string (SSDATA (format_string), SBYTES (format_string),
- timeval, ! NILP (universal), &t, &tm);
+ t, ! NILP (universal), &tm);
}
static Lisp_Object
format_time_string (char const *format, ptrdiff_t formatlen,
- Lisp_Object timeval, int ut, time_t *tval, struct tm **tmp)
+ EMACS_TIME t, bool ut, struct tm *tmp)
{
- ptrdiff_t size;
- int usec;
- int ns;
+ char buffer[4000];
+ char *buf = buffer;
+ ptrdiff_t size = sizeof buffer;
+ size_t len;
+ Lisp_Object bufstring;
+ int ns = EMACS_NSECS (t);
struct tm *tm;
-
- if (! (lisp_time_argument (timeval, tval, &usec)
- && 0 <= usec && usec < 1000000))
- error ("Invalid time specification");
- ns = usec * 1000;
-
- /* This is probably enough. */
- size = formatlen;
- if (size <= (STRING_BYTES_BOUND - 50) / 6)
- size = size * 6 + 50;
-
- BLOCK_INPUT;
- tm = ut ? gmtime (tval) : localtime (tval);
- UNBLOCK_INPUT;
- if (! tm)
- time_overflow ();
- *tmp = tm;
-
- synchronize_system_time_locale ();
+ USE_SAFE_ALLOCA;
while (1)
{
- char *buf = (char *) alloca (size + 1);
- size_t result;
+ time_t *taddr = emacs_secs_addr (&t);
+ block_input ();
+
+ synchronize_system_time_locale ();
+
+ tm = ut ? gmtime (taddr) : localtime (taddr);
+ if (! tm)
+ {
+ unblock_input ();
+ time_overflow ();
+ }
+ *tmp = *tm;
buf[0] = '\1';
- BLOCK_INPUT;
- result = emacs_nmemftime (buf, size, format, formatlen, tm, ut, ns);
- UNBLOCK_INPUT;
- if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0'))
- return code_convert_string_norecord (make_unibyte_string (buf, result),
- Vlocale_coding_system, 0);
-
- /* If buffer was too small, make it bigger and try again. */
- BLOCK_INPUT;
- result = emacs_nmemftime (NULL, (size_t) -1, format, formatlen,
- tm, ut, ns);
- UNBLOCK_INPUT;
- if (STRING_BYTES_BOUND <= result)
+ len = emacs_nmemftime (buf, size, format, formatlen, tm, ut, ns);
+ if ((0 < len && len < size) || (len == 0 && buf[0] == '\0'))
+ break;
+
+ /* Buffer was too small, so make it bigger and try again. */
+ len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tm, ut, ns);
+ unblock_input ();
+ if (STRING_BYTES_BOUND <= len)
string_overflow ();
- size = result + 1;
+ size = len + 1;
+ buf = SAFE_ALLOCA (size);
}
+
+ unblock_input ();
+ bufstring = make_unibyte_string (buf, len);
+ SAFE_FREE ();
+ return code_convert_string_norecord (bufstring, Vlocale_coding_system, 0);
}
DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 1, 0,
@@ -1781,41 +1812,38 @@ east of Greenwich. (Note that Common Lisp has different meanings for
DOW and ZONE.) */)
(Lisp_Object specified_time)
{
- time_t time_spec;
+ time_t time_spec = lisp_seconds_argument (specified_time);
struct tm save_tm;
struct tm *decoded_time;
Lisp_Object list_args[9];
- if (! lisp_time_argument (specified_time, &time_spec, NULL))
- error ("Invalid time specification");
-
- BLOCK_INPUT;
+ block_input ();
decoded_time = localtime (&time_spec);
- UNBLOCK_INPUT;
+ if (decoded_time)
+ save_tm = *decoded_time;
+ unblock_input ();
if (! (decoded_time
- && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= decoded_time->tm_year
- && decoded_time->tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE))
+ && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= save_tm.tm_year
+ && save_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE))
time_overflow ();
- XSETFASTINT (list_args[0], decoded_time->tm_sec);
- XSETFASTINT (list_args[1], decoded_time->tm_min);
- XSETFASTINT (list_args[2], decoded_time->tm_hour);
- XSETFASTINT (list_args[3], decoded_time->tm_mday);
- XSETFASTINT (list_args[4], decoded_time->tm_mon + 1);
+ XSETFASTINT (list_args[0], save_tm.tm_sec);
+ XSETFASTINT (list_args[1], save_tm.tm_min);
+ XSETFASTINT (list_args[2], save_tm.tm_hour);
+ XSETFASTINT (list_args[3], save_tm.tm_mday);
+ XSETFASTINT (list_args[4], save_tm.tm_mon + 1);
/* On 64-bit machines an int is narrower than EMACS_INT, thus the
cast below avoids overflow in int arithmetics. */
- XSETINT (list_args[5], TM_YEAR_BASE + (EMACS_INT) decoded_time->tm_year);
- XSETFASTINT (list_args[6], decoded_time->tm_wday);
- list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
+ XSETINT (list_args[5], TM_YEAR_BASE + (EMACS_INT) save_tm.tm_year);
+ XSETFASTINT (list_args[6], save_tm.tm_wday);
+ list_args[7] = save_tm.tm_isdst ? Qt : Qnil;
- /* Make a copy, in case gmtime modifies the struct. */
- save_tm = *decoded_time;
- BLOCK_INPUT;
+ block_input ();
decoded_time = gmtime (&time_spec);
- UNBLOCK_INPUT;
if (decoded_time == 0)
list_args[8] = Qnil;
else
XSETINT (list_args[8], tm_diff (&save_tm, decoded_time));
+ unblock_input ();
return Flist (9, list_args);
}
@@ -1870,12 +1898,12 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
tm.tm_isdst = -1;
if (CONSP (zone))
- zone = Fcar (zone);
+ zone = XCAR (zone);
if (NILP (zone))
{
- BLOCK_INPUT;
+ block_input ();
value = mktime (&tm);
- UNBLOCK_INPUT;
+ unblock_input ();
}
else
{
@@ -1889,29 +1917,34 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
tzstring = SSDATA (zone);
else if (INTEGERP (zone))
{
- int abszone = eabs (XINT (zone));
- sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0),
- abszone / (60*60), (abszone/60) % 60, abszone % 60);
+ EMACS_INT abszone = eabs (XINT (zone));
+ EMACS_INT zone_hr = abszone / (60*60);
+ int zone_min = (abszone/60) % 60;
+ int zone_sec = abszone % 60;
+ sprintf (tzbuf, "XXX%s%"pI"d:%02d:%02d", "-" + (XINT (zone) < 0),
+ zone_hr, zone_min, zone_sec);
tzstring = tzbuf;
}
else
error ("Invalid time zone specification");
+ block_input ();
+
/* Set TZ before calling mktime; merely adjusting mktime's returned
value doesn't suffice, since that would mishandle leap seconds. */
set_time_zone_rule (tzstring);
- BLOCK_INPUT;
value = mktime (&tm);
- UNBLOCK_INPUT;
/* Restore TZ to previous value. */
newenv = environ;
environ = oldenv;
- xfree (newenv);
#ifdef LOCALTIME_CACHE
tzset ();
#endif
+ unblock_input ();
+
+ xfree (newenv);
}
if (value == (time_t) -1)
@@ -1936,26 +1969,36 @@ Thus, you can use times obtained from `current-time' and from
but this is considered obsolete. */)
(Lisp_Object specified_time)
{
- time_t value;
+ time_t value = lisp_seconds_argument (specified_time);
struct tm *tm;
- register char *tem;
-
- if (! lisp_time_argument (specified_time, &value, NULL))
- error ("Invalid time specification");
-
- /* Convert to a string, checking for out-of-range time stamps.
- Don't use 'ctime', as that might dump core if VALUE is out of
- range. */
- BLOCK_INPUT;
+ char buf[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1];
+ int len IF_LINT (= 0);
+
+ /* Convert to a string in ctime format, except without the trailing
+ newline, and without the 4-digit year limit. Don't use asctime
+ or ctime, as they might dump core if the year is outside the
+ range -999 .. 9999. */
+ block_input ();
tm = localtime (&value);
- UNBLOCK_INPUT;
- if (! (tm && TM_YEAR_IN_ASCTIME_RANGE (tm->tm_year) && (tem = asctime (tm))))
+ if (tm)
+ {
+ static char const wday_name[][4] =
+ { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" };
+ static char const mon_name[][4] =
+ { "Jan", "Feb", "Mar", "Apr", "May", "Jun",
+ "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" };
+ printmax_t year_base = TM_YEAR_BASE;
+
+ len = sprintf (buf, "%s %s%3d %02d:%02d:%02d %"pMd,
+ wday_name[tm->tm_wday], mon_name[tm->tm_mon], tm->tm_mday,
+ tm->tm_hour, tm->tm_min, tm->tm_sec,
+ tm->tm_year + year_base);
+ }
+ unblock_input ();
+ if (! tm)
time_overflow ();
- /* Remove the trailing newline. */
- tem[strlen (tem) - 1] = '\0';
-
- return build_string (tem);
+ return make_unibyte_string (buf, len);
}
/* Yield A - B, measured in seconds.
@@ -1998,23 +2041,23 @@ in this case, `current-time-zone' returns a list containing nil for
the data it can't find. */)
(Lisp_Object specified_time)
{
- time_t value;
+ EMACS_TIME value;
+ int offset;
struct tm *t;
struct tm localtm;
- struct tm *localt;
Lisp_Object zone_offset, zone_name;
zone_offset = Qnil;
- zone_name = format_time_string ("%Z", sizeof "%Z" - 1, specified_time,
- 0, &value, &localt);
- localtm = *localt;
- BLOCK_INPUT;
- t = gmtime (&value);
- UNBLOCK_INPUT;
+ value = make_emacs_time (lisp_seconds_argument (specified_time), 0);
+ zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value, 0, &localtm);
+ block_input ();
+ t = gmtime (emacs_secs_addr (&value));
+ if (t)
+ offset = tm_diff (&localtm, t);
+ unblock_input ();
if (t)
{
- int offset = tm_diff (&localtm, t);
zone_offset = make_number (offset);
if (SCHARS (zone_name) == 0)
{
@@ -2022,8 +2065,9 @@ the data it can't find. */)
int m = offset / 60;
int am = offset < 0 ? - m : m;
char buf[sizeof "+00" + INT_STRLEN_BOUND (int)];
- sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
- zone_name = build_string (buf);
+ zone_name = make_formatted_string (buf, "%c%02d%02d",
+ (offset < 0 ? '-' : '+'),
+ am / 60, am % 60);
}
}
@@ -2052,9 +2096,16 @@ only the former. */)
(Lisp_Object tz)
{
const char *tzstring;
+ char **old_environbuf;
+
+ if (! (NILP (tz) || EQ (tz, Qt)))
+ CHECK_STRING (tz);
+
+ block_input ();
/* When called for the first time, save the original TZ. */
- if (!environbuf)
+ old_environbuf = environbuf;
+ if (!old_environbuf)
initial_tz = (char *) getenv ("TZ");
if (NILP (tz))
@@ -2062,15 +2113,14 @@ only the former. */)
else if (EQ (tz, Qt))
tzstring = "UTC0";
else
- {
- CHECK_STRING (tz);
- tzstring = SSDATA (tz);
- }
+ tzstring = SSDATA (tz);
set_time_zone_rule (tzstring);
- xfree (environbuf);
environbuf = environ;
+ unblock_input ();
+
+ xfree (old_environbuf);
return Qnil;
}
@@ -2104,8 +2154,8 @@ set_time_zone_rule (const char *tzstring)
for (from = environ; *from; from++)
continue;
envptrs = from - environ + 2;
- newenv = to = (char **) xmalloc (envptrs * sizeof (char *)
- + (tzstring ? strlen (tzstring) + 4 : 0));
+ newenv = to = xmalloc (envptrs * sizeof *newenv
+ + (tzstring ? strlen (tzstring) + 4 : 0));
/* Add TZSTRING to the end of environ, as a value for TZ. */
if (tzstring)
@@ -2176,14 +2226,14 @@ set_time_zone_rule (const char *tzstring)
static void
general_insert_function (void (*insert_func)
- (const char *, EMACS_INT),
+ (const char *, ptrdiff_t),
void (*insert_from_string_func)
- (Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, int),
- int inherit, ptrdiff_t nargs, Lisp_Object *args)
+ (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, bool),
+ bool inherit, ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t argnum;
- register Lisp_Object val;
+ Lisp_Object val;
for (argnum = 0; argnum < nargs; argnum++)
{
@@ -2307,20 +2357,46 @@ usage: (insert-before-markers-and-inherit &rest ARGS) */)
return Qnil;
}
-DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 3, 0,
+DEFUN ("insert-char", Finsert_char, Sinsert_char, 1, 3,
+ "(list (read-char-by-name \"Insert character (Unicode name or hex): \")\
+ (prefix-numeric-value current-prefix-arg)\
+ t))",
doc: /* Insert COUNT copies of CHARACTER.
-Point, and before-insertion markers, are relocated as in the function `insert'.
-The optional third arg INHERIT, if non-nil, says to inherit text properties
-from adjoining text, if those properties are sticky. */)
+Interactively, prompt for CHARACTER. You can specify CHARACTER in one
+of these ways:
+
+ - As its Unicode character name, e.g. \"LATIN SMALL LETTER A\".
+ Completion is available; if you type a substring of the name
+ preceded by an asterisk `*', Emacs shows all names which include
+ that substring, not necessarily at the beginning of the name.
+
+ - As a hexadecimal code point, e.g. 263A. Note that code points in
+ Emacs are equivalent to Unicode up to 10FFFF (which is the limit of
+ the Unicode code space).
+
+ - As a code point with a radix specified with #, e.g. #o21430
+ (octal), #x2318 (hex), or #10r8984 (decimal).
+
+If called interactively, COUNT is given by the prefix argument. If
+omitted or nil, it defaults to 1.
+
+Inserting the character(s) relocates point and before-insertion
+markers in the same ways as the function `insert'.
+
+The optional third argument INHERIT, if non-nil, says to inherit text
+properties from adjoining text, if those properties are sticky. If
+called interactively, INHERIT is t. */)
(Lisp_Object character, Lisp_Object count, Lisp_Object inherit)
{
int i, stringlen;
- register EMACS_INT n;
+ register ptrdiff_t n;
int c, len;
unsigned char str[MAX_MULTIBYTE_LENGTH];
char string[4000];
CHECK_CHARACTER (character);
+ if (NILP (count))
+ XSETFASTINT (count, 1);
CHECK_NUMBER (count);
c = XFASTINT (character);
@@ -2380,7 +2456,7 @@ from adjoining text, if those properties are sticky. */)
/* Return a Lisp_String containing the text of the current buffer from
START to END. If text properties are in use and the current buffer
has properties in the range specified, the resulting string will also
- have them, if PROPS is nonzero.
+ have them, if PROPS is true.
We don't want to use plain old make_string here, because it calls
make_uninit_string, which can cause the buffer arena to be
@@ -2391,10 +2467,10 @@ from adjoining text, if those properties are sticky. */)
buffer substrings. */
Lisp_Object
-make_buffer_string (EMACS_INT start, EMACS_INT end, int props)
+make_buffer_string (ptrdiff_t start, ptrdiff_t end, bool props)
{
- EMACS_INT start_byte = CHAR_TO_BYTE (start);
- EMACS_INT end_byte = CHAR_TO_BYTE (end);
+ ptrdiff_t start_byte = CHAR_TO_BYTE (start);
+ ptrdiff_t end_byte = CHAR_TO_BYTE (end);
return make_buffer_string_both (start, start_byte, end, end_byte, props);
}
@@ -2404,7 +2480,7 @@ make_buffer_string (EMACS_INT start, EMACS_INT end, int props)
If text properties are in use and the current buffer
has properties in the range specified, the resulting string will also
- have them, if PROPS is nonzero.
+ have them, if PROPS is true.
We don't want to use plain old make_string here, because it calls
make_uninit_string, which can cause the buffer arena to be
@@ -2415,8 +2491,8 @@ make_buffer_string (EMACS_INT start, EMACS_INT end, int props)
buffer substrings. */
Lisp_Object
-make_buffer_string_both (EMACS_INT start, EMACS_INT start_byte,
- EMACS_INT end, EMACS_INT end_byte, int props)
+make_buffer_string_both (ptrdiff_t start, ptrdiff_t start_byte,
+ ptrdiff_t end, ptrdiff_t end_byte, bool props)
{
Lisp_Object result, tem, tem1;
@@ -2449,7 +2525,7 @@ make_buffer_string_both (EMACS_INT start, EMACS_INT start_byte,
in the current buffer, if necessary. */
static void
-update_buffer_properties (EMACS_INT start, EMACS_INT end)
+update_buffer_properties (ptrdiff_t start, ptrdiff_t end)
{
/* If this buffer has some access functions,
call them, specifying the range of the buffer being accessed. */
@@ -2488,7 +2564,7 @@ into the result string; if you don't want the text properties,
use `buffer-substring-no-properties' instead. */)
(Lisp_Object start, Lisp_Object end)
{
- register EMACS_INT b, e;
+ register ptrdiff_t b, e;
validate_region (&start, &end);
b = XINT (start);
@@ -2504,7 +2580,7 @@ The two arguments START and END are character positions;
they can be in either order. */)
(Lisp_Object start, Lisp_Object end)
{
- register EMACS_INT b, e;
+ register ptrdiff_t b, e;
validate_region (&start, &end);
b = XINT (start);
@@ -2538,7 +2614,7 @@ They default to the values of (point-min) and (point-max) in BUFFER. */)
if (NILP (buf))
nsberror (buffer);
bp = XBUFFER (buf);
- if (NILP (BVAR (bp, name)))
+ if (!BUFFER_LIVE_P (bp))
error ("Selecting deleted buffer");
if (NILP (start))
@@ -2588,8 +2664,8 @@ determines whether case is significant or ignored. */)
register Lisp_Object trt
= (!NILP (BVAR (current_buffer, case_fold_search))
? BVAR (current_buffer, case_canon_table) : Qnil);
- EMACS_INT chars = 0;
- EMACS_INT i1, i2, i1_byte, i2_byte;
+ ptrdiff_t chars = 0;
+ ptrdiff_t i1, i2, i1_byte, i2_byte;
/* Find the first buffer and its substring. */
@@ -2602,7 +2678,7 @@ determines whether case is significant or ignored. */)
if (NILP (buf1))
nsberror (buffer1);
bp1 = XBUFFER (buf1);
- if (NILP (BVAR (bp1, name)))
+ if (!BUFFER_LIVE_P (bp1))
error ("Selecting deleted buffer");
}
@@ -2640,7 +2716,7 @@ determines whether case is significant or ignored. */)
if (NILP (buf2))
nsberror (buffer2);
bp2 = XBUFFER (buf2);
- if (NILP (BVAR (bp2, name)))
+ if (!BUFFER_LIVE_P (bp2))
error ("Selecting deleted buffer");
}
@@ -2708,8 +2784,8 @@ determines whether case is significant or ignored. */)
if (!NILP (trt))
{
- c1 = CHAR_TABLE_TRANSLATE (trt, c1);
- c2 = CHAR_TABLE_TRANSLATE (trt, c2);
+ c1 = char_table_translate (trt, c1);
+ c2 = char_table_translate (trt, c2);
}
if (c1 < c2)
return make_number (- 1 - chars);
@@ -2733,13 +2809,15 @@ determines whether case is significant or ignored. */)
static Lisp_Object
subst_char_in_region_unwind (Lisp_Object arg)
{
- return BVAR (current_buffer, undo_list) = arg;
+ bset_undo_list (current_buffer, arg);
+ return arg;
}
static Lisp_Object
subst_char_in_region_unwind_1 (Lisp_Object arg)
{
- return BVAR (current_buffer, filename) = arg;
+ bset_filename (current_buffer, arg);
+ return arg;
}
DEFUN ("subst-char-in-region", Fsubst_char_in_region,
@@ -2750,22 +2828,23 @@ and don't mark the buffer as really changed.
Both characters must have the same length of multi-byte form. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object fromchar, Lisp_Object tochar, Lisp_Object noundo)
{
- register EMACS_INT pos, pos_byte, stop, i, len, end_byte;
+ register ptrdiff_t pos, pos_byte, stop, i, len, end_byte;
/* Keep track of the first change in the buffer:
if 0 we haven't found it yet.
if < 0 we've found it and we've run the before-change-function.
if > 0 we've actually performed it and the value is its position. */
- EMACS_INT changed = 0;
+ ptrdiff_t changed = 0;
unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH];
unsigned char *p;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
#define COMBINING_NO 0
#define COMBINING_BEFORE 1
#define COMBINING_AFTER 2
#define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
int maybe_byte_combining = COMBINING_NO;
- EMACS_INT last_changed = 0;
- int multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ ptrdiff_t last_changed = 0;
+ bool multibyte_p
+ = !NILP (BVAR (current_buffer, enable_multibyte_characters));
int fromc, toc;
restart:
@@ -2813,18 +2892,18 @@ Both characters must have the same length of multi-byte form. */)
{
record_unwind_protect (subst_char_in_region_unwind,
BVAR (current_buffer, undo_list));
- BVAR (current_buffer, undo_list) = Qt;
+ bset_undo_list (current_buffer, Qt);
/* Don't do file-locking. */
record_unwind_protect (subst_char_in_region_unwind_1,
BVAR (current_buffer, filename));
- BVAR (current_buffer, filename) = Qnil;
+ bset_filename (current_buffer, Qnil);
}
if (pos_byte < GPT_BYTE)
stop = min (stop, GPT_BYTE);
while (1)
{
- EMACS_INT pos_byte_next = pos_byte;
+ ptrdiff_t pos_byte_next = pos_byte;
if (pos_byte >= stop)
{
@@ -2899,7 +2978,7 @@ Both characters must have the same length of multi-byte form. */)
INC_POS (pos_byte_next);
if (! NILP (noundo))
- BVAR (current_buffer, undo_list) = tem;
+ bset_undo_list (current_buffer, tem);
UNGCPRO;
}
@@ -2927,7 +3006,7 @@ Both characters must have the same length of multi-byte form. */)
}
-static Lisp_Object check_translation (EMACS_INT, EMACS_INT, EMACS_INT,
+static Lisp_Object check_translation (ptrdiff_t, ptrdiff_t, ptrdiff_t,
Lisp_Object);
/* Helper function for Ftranslate_region_internal.
@@ -2937,7 +3016,7 @@ static Lisp_Object check_translation (EMACS_INT, EMACS_INT, EMACS_INT,
element is found, return it. Otherwise return Qnil. */
static Lisp_Object
-check_translation (EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT end,
+check_translation (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t end,
Lisp_Object val)
{
int buf_size = 16, buf_used = 0;
@@ -2946,7 +3025,7 @@ check_translation (EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT end,
for (; CONSP (val); val = XCDR (val))
{
Lisp_Object elt;
- EMACS_INT len, i;
+ ptrdiff_t len, i;
elt = XCAR (val);
if (! CONSP (elt))
@@ -2999,10 +3078,10 @@ It returns the number of characters changed. */)
register unsigned char *tt; /* Trans table. */
register int nc; /* New character. */
int cnt; /* Number of changes made. */
- EMACS_INT size; /* Size of translate table. */
- EMACS_INT pos, pos_byte, end_pos;
- int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
- int string_multibyte IF_LINT (= 0);
+ ptrdiff_t size; /* Size of translate table. */
+ ptrdiff_t pos, pos_byte, end_pos;
+ bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ bool string_multibyte IF_LINT (= 0);
validate_region (&start, &end);
if (CHAR_TABLE_P (table))
@@ -3239,8 +3318,8 @@ save_restriction_save (void)
{
Lisp_Object beg, end;
- beg = buildmark (BEGV, BEGV_BYTE);
- end = buildmark (ZV, ZV_BYTE);
+ beg = build_marker (current_buffer, BEGV, BEGV_BYTE);
+ end = build_marker (current_buffer, ZV, ZV_BYTE);
/* END must move forward if text is inserted at its exact location. */
XMARKER (end)->insertion_type = 1;
@@ -3278,7 +3357,7 @@ save_restriction_restore (Lisp_Object data)
/* The restriction has changed from the saved one, so restore
the saved restriction. */
{
- EMACS_INT pt = BUF_PT (buf);
+ ptrdiff_t pt = BUF_PT (buf);
SET_BUF_BEGV_BOTH (buf, beg->charpos, beg->bytepos);
SET_BUF_ZV_BOTH (buf, end->charpos, end->bytepos);
@@ -3292,6 +3371,10 @@ save_restriction_restore (Lisp_Object data)
buf->clip_changed = 1; /* Remember that the narrowing changed. */
}
+ /* These aren't needed anymore, so don't wait for GC. */
+ free_marker (XCAR (data));
+ free_marker (XCDR (data));
+ free_cons (XCONS (data));
}
else
/* A buffer, which means that there was no old restriction. */
@@ -3336,7 +3419,7 @@ usage: (save-restriction &rest BODY) */)
(Lisp_Object body)
{
register Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (save_restriction_restore, save_restriction_save ());
val = Fprogn (body);
@@ -3351,8 +3434,8 @@ static ptrdiff_t message_length;
DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
doc: /* Display a message at the bottom of the screen.
-The message also goes into the `*Messages*' buffer.
-\(In keyboard macros, that's all it does.)
+The message also goes into the `*Messages*' buffer, if `message-log-max'
+is non-nil. (In keyboard macros, that's all it does.)
Return the message.
The first argument is a format control string, and the rest are data
@@ -3422,15 +3505,11 @@ usage: (message-box FORMAT-STRING &rest ARGS) */)
}
#endif /* HAVE_MENUS */
/* Copy the data so that it won't move when we GC. */
- if (! message_text)
- {
- message_text = (char *)xmalloc (80);
- message_length = 80;
- }
if (SBYTES (val) > message_length)
{
- message_text = (char *) xrealloc (message_text, SBYTES (val));
- message_length = SBYTES (val);
+ ptrdiff_t new_length = SBYTES (val) + 80;
+ message_text = xrealloc (message_text, new_length);
+ message_length = new_length;
}
memcpy (message_text, SDATA (val), SBYTES (val));
message2 (message_text, SBYTES (val),
@@ -3532,9 +3611,13 @@ where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+
The + flag character inserts a + before any positive number, while a
space inserts a space before any positive number; these flags only
affect %d, %e, %f, and %g sequences, and the + flag takes precedence.
+The - and 0 flags affect the width specifier, as described below.
+
The # flag means to use an alternate display form for %o, %x, %X, %e,
-%f, and %g sequences. The - and 0 flags affect the width specifier,
-as described below.
+%f, and %g sequences: for %o, it ensures that the result begins with
+\"0\"; for %x and %X, it prefixes the result with \"0x\" or \"0X\";
+for %e, %f, and %g, it causes a decimal point to be included even if
+the precision is zero.
The width specifier supplies a lower limit for the length of the
printed representation. The padding, if any, normally goes on the
@@ -3554,24 +3637,24 @@ usage: (format STRING &rest OBJECTS) */)
ptrdiff_t n; /* The number of the next arg to substitute */
char initial_buffer[4000];
char *buf = initial_buffer;
- EMACS_INT bufsize = sizeof initial_buffer;
- EMACS_INT max_bufsize = STRING_BYTES_BOUND + 1;
+ ptrdiff_t bufsize = sizeof initial_buffer;
+ ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1;
char *p;
Lisp_Object buf_save_value IF_LINT (= {0});
- register char *format, *end, *format_start;
- EMACS_INT formatlen, nchars;
- /* Nonzero if the format is multibyte. */
- int multibyte_format = 0;
- /* Nonzero if the output should be a multibyte string,
+ char *format, *end, *format_start;
+ ptrdiff_t formatlen, nchars;
+ /* True if the format is multibyte. */
+ bool multibyte_format = 0;
+ /* True if the output should be a multibyte string,
which is true if any of the inputs is one. */
- int multibyte = 0;
+ bool multibyte = 0;
/* When we make a multibyte string, we must pay attention to the
byte combining problem, i.e., a byte may be combined with a
multibyte character of the previous string. This flag tells if we
must consider such a situation or not. */
- int maybe_combine_byte;
+ bool maybe_combine_byte;
Lisp_Object val;
- int arg_intervals = 0;
+ bool arg_intervals = 0;
USE_SAFE_ALLOCA;
/* discarded[I] is 1 if byte I of the format
@@ -3586,9 +3669,9 @@ usage: (format STRING &rest OBJECTS) */)
info[0] is unused. Unused elements have -1 for start. */
struct info
{
- EMACS_INT start, end;
- int converted_to_string;
- int intervals;
+ ptrdiff_t start, end;
+ unsigned converted_to_string : 1;
+ unsigned intervals : 1;
} *info = 0;
/* It should not be necessary to GCPRO ARGS, because
@@ -3603,7 +3686,7 @@ usage: (format STRING &rest OBJECTS) */)
ptrdiff_t i;
if ((SIZE_MAX - formatlen) / sizeof (struct info) <= nargs)
memory_full (SIZE_MAX);
- SAFE_ALLOCA (info, struct info *, (nargs + 1) * sizeof *info + formatlen);
+ info = SAFE_ALLOCA ((nargs + 1) * sizeof *info + formatlen);
discarded = (char *) &info[nargs + 1];
for (i = 0; i < nargs + 1; i++)
{
@@ -3643,7 +3726,7 @@ usage: (format STRING &rest OBJECTS) */)
char *format0 = format;
/* Bytes needed to represent the output of this conversion. */
- EMACS_INT convbytes;
+ ptrdiff_t convbytes;
if (*format == '%')
{
@@ -3665,13 +3748,13 @@ usage: (format STRING &rest OBJECTS) */)
digits to print after the '.' for floats, or the max.
number of chars to print from a string. */
- int minus_flag = 0;
- int plus_flag = 0;
- int space_flag = 0;
- int sharp_flag = 0;
- int zero_flag = 0;
- EMACS_INT field_width;
- int precision_given;
+ bool minus_flag = 0;
+ bool plus_flag = 0;
+ bool space_flag = 0;
+ bool sharp_flag = 0;
+ bool zero_flag = 0;
+ ptrdiff_t field_width;
+ bool precision_given;
uintmax_t precision = UINTMAX_MAX;
char *num_end;
char conversion;
@@ -3777,11 +3860,11 @@ usage: (format STRING &rest OBJECTS) */)
{
/* handle case (precision[n] >= 0) */
- EMACS_INT width, padding, nbytes;
- EMACS_INT nchars_string;
+ ptrdiff_t width, padding, nbytes;
+ ptrdiff_t nchars_string;
- EMACS_INT prec = -1;
- if (precision_given && precision <= TYPE_MAXIMUM (EMACS_INT))
+ ptrdiff_t prec = -1;
+ if (precision_given && precision <= TYPE_MAXIMUM (ptrdiff_t))
prec = precision;
/* lisp_string_width ignores a precision of 0, but GNU
@@ -3794,7 +3877,7 @@ usage: (format STRING &rest OBJECTS) */)
width = nchars_string = nbytes = 0;
else
{
- EMACS_INT nch, nby;
+ ptrdiff_t nch, nby;
width = lisp_string_width (args[n], prec, &nch, &nby);
if (prec < 0)
{
@@ -3850,7 +3933,7 @@ usage: (format STRING &rest OBJECTS) */)
/* If this argument has text properties, record where
in the result string it appears. */
- if (STRING_INTERVALS (args[n]))
+ if (string_intervals (args[n]))
info[n].intervals = arg_intervals = 1;
continue;
@@ -3891,7 +3974,7 @@ usage: (format STRING &rest OBJECTS) */)
verify (0 < USEFUL_PRECISION_MAX);
int prec;
- EMACS_INT padding, sprintf_bytes;
+ ptrdiff_t padding, sprintf_bytes;
uintmax_t excess_precision, numwidth;
uintmax_t leading_zeros = 0, trailing_zeros = 0;
@@ -4051,7 +4134,7 @@ usage: (format STRING &rest OBJECTS) */)
char *src = sprintf_buf;
char src0 = src[0];
int exponent_bytes = 0;
- int signedp = src0 == '-' || src0 == '+' || src0 == ' ';
+ bool signedp = src0 == '-' || src0 == '+' || src0 == ' ';
int significand_bytes;
if (zero_flag
&& ((src[signedp] >= '0' && src[signedp] <= '9')
@@ -4181,7 +4264,7 @@ usage: (format STRING &rest OBJECTS) */)
}
if (bufsize < p - buf)
- abort ();
+ emacs_abort ();
if (maybe_combine_byte)
nchars = multibyte_chars_in_text ((unsigned char *) buf, p - buf);
@@ -4194,7 +4277,7 @@ usage: (format STRING &rest OBJECTS) */)
arguments has text properties, set up text properties of the
result string. */
- if (STRING_INTERVALS (args[0]) || arg_intervals)
+ if (string_intervals (args[0]) || arg_intervals)
{
Lisp_Object len, new_len, props;
struct gcpro gcpro1;
@@ -4206,8 +4289,8 @@ usage: (format STRING &rest OBJECTS) */)
if (CONSP (props))
{
- EMACS_INT bytepos = 0, position = 0, translated = 0;
- EMACS_INT argn = 1;
+ ptrdiff_t bytepos = 0, position = 0, translated = 0;
+ ptrdiff_t argn = 1;
Lisp_Object list;
/* Adjust the bounds of each text property
@@ -4225,7 +4308,7 @@ usage: (format STRING &rest OBJECTS) */)
for (list = props; CONSP (list); list = XCDR (list))
{
Lisp_Object item;
- EMACS_INT pos;
+ ptrdiff_t pos;
item = XCAR (list);
@@ -4356,12 +4439,12 @@ Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
static void
-transpose_markers (EMACS_INT start1, EMACS_INT end1,
- EMACS_INT start2, EMACS_INT end2,
- EMACS_INT start1_byte, EMACS_INT end1_byte,
- EMACS_INT start2_byte, EMACS_INT end2_byte)
+transpose_markers (ptrdiff_t start1, ptrdiff_t end1,
+ ptrdiff_t start2, ptrdiff_t end2,
+ ptrdiff_t start1_byte, ptrdiff_t end1_byte,
+ ptrdiff_t start2_byte, ptrdiff_t end2_byte)
{
- register EMACS_INT amt1, amt1_byte, amt2, amt2_byte, diff, diff_byte, mpos;
+ register ptrdiff_t amt1, amt1_byte, amt2, amt2_byte, diff, diff_byte, mpos;
register struct Lisp_Marker *marker;
/* Update point as if it were a marker. */
@@ -4435,16 +4518,16 @@ any markers that happen to be located in the regions.
Transposing beyond buffer boundaries is an error. */)
(Lisp_Object startr1, Lisp_Object endr1, Lisp_Object startr2, Lisp_Object endr2, Lisp_Object leave_markers)
{
- register EMACS_INT start1, end1, start2, end2;
- EMACS_INT start1_byte, start2_byte, len1_byte, len2_byte;
- EMACS_INT gap, len1, len_mid, len2;
+ register ptrdiff_t start1, end1, start2, end2;
+ ptrdiff_t start1_byte, start2_byte, len1_byte, len2_byte;
+ ptrdiff_t gap, len1, len_mid, len2;
unsigned char *start1_addr, *start2_addr, *temp;
INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2, tmp_interval3;
Lisp_Object buf;
XSETBUFFER (buf, current_buffer);
- cur_intv = BUF_INTERVALS (current_buffer);
+ cur_intv = buffer_intervals (current_buffer);
validate_region (&startr1, &endr1);
validate_region (&startr2, &endr2);
@@ -4458,7 +4541,7 @@ Transposing beyond buffer boundaries is an error. */)
/* Swap the regions if they're reversed. */
if (start2 < end1)
{
- register EMACS_INT glumph = start1;
+ register ptrdiff_t glumph = start1;
start1 = start2;
start2 = glumph;
glumph = end1;
@@ -4521,7 +4604,7 @@ Transposing beyond buffer boundaries is an error. */)
len1_byte, end2, start2_byte + len2_byte)
|| count_combining_after (BYTE_POS_ADDR (start1_byte),
len1_byte, end2, start2_byte + len2_byte))
- abort ();
+ emacs_abort ();
}
else
{
@@ -4533,7 +4616,7 @@ Transposing beyond buffer boundaries is an error. */)
len2_byte, end1, start1_byte + len1_byte)
|| count_combining_after (BYTE_POS_ADDR (start1_byte),
len1_byte, end2, start2_byte + len2_byte))
- abort ();
+ emacs_abort ();
}
#endif
@@ -4554,7 +4637,7 @@ Transposing beyond buffer boundaries is an error. */)
/* Don't use Fset_text_properties: that can cause GC, which can
clobber objects stored in the tmp_intervals. */
tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0);
- if (!NULL_INTERVAL_P (tmp_interval3))
+ if (tmp_interval3)
set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3);
/* First region smaller than second. */
@@ -4562,7 +4645,7 @@ Transposing beyond buffer boundaries is an error. */)
{
USE_SAFE_ALLOCA;
- SAFE_ALLOCA (temp, unsigned char *, len2_byte);
+ temp = SAFE_ALLOCA (len2_byte);
/* Don't precompute these addresses. We have to compute them
at the last minute, because the relocating allocator might
@@ -4580,7 +4663,7 @@ Transposing beyond buffer boundaries is an error. */)
{
USE_SAFE_ALLOCA;
- SAFE_ALLOCA (temp, unsigned char *, len1_byte);
+ temp = SAFE_ALLOCA (len1_byte);
start1_addr = BYTE_POS_ADDR (start1_byte);
start2_addr = BYTE_POS_ADDR (start2_byte);
memcpy (temp, start1_addr, len1_byte);
@@ -4613,14 +4696,14 @@ Transposing beyond buffer boundaries is an error. */)
tmp_interval2 = copy_intervals (cur_intv, start2, len2);
tmp_interval3 = validate_interval_range (buf, &startr1, &endr1, 0);
- if (!NULL_INTERVAL_P (tmp_interval3))
+ if (tmp_interval3)
set_text_properties_1 (startr1, endr1, Qnil, buf, tmp_interval3);
tmp_interval3 = validate_interval_range (buf, &startr2, &endr2, 0);
- if (!NULL_INTERVAL_P (tmp_interval3))
+ if (tmp_interval3)
set_text_properties_1 (startr2, endr2, Qnil, buf, tmp_interval3);
- SAFE_ALLOCA (temp, unsigned char *, len1_byte);
+ temp = SAFE_ALLOCA (len1_byte);
start1_addr = BYTE_POS_ADDR (start1_byte);
start2_addr = BYTE_POS_ADDR (start2_byte);
memcpy (temp, start1_addr, len1_byte);
@@ -4646,11 +4729,11 @@ Transposing beyond buffer boundaries is an error. */)
tmp_interval2 = copy_intervals (cur_intv, start2, len2);
tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0);
- if (!NULL_INTERVAL_P (tmp_interval3))
+ if (tmp_interval3)
set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3);
/* holds region 2 */
- SAFE_ALLOCA (temp, unsigned char *, len2_byte);
+ temp = SAFE_ALLOCA (len2_byte);
start1_addr = BYTE_POS_ADDR (start1_byte);
start2_addr = BYTE_POS_ADDR (start2_byte);
memcpy (temp, start2_addr, len2_byte);
@@ -4679,11 +4762,11 @@ Transposing beyond buffer boundaries is an error. */)
tmp_interval2 = copy_intervals (cur_intv, start2, len2);
tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0);
- if (!NULL_INTERVAL_P (tmp_interval3))
+ if (tmp_interval3)
set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3);
/* holds region 1 */
- SAFE_ALLOCA (temp, unsigned char *, len1_byte);
+ temp = SAFE_ALLOCA (len1_byte);
start1_addr = BYTE_POS_ADDR (start1_byte);
start2_addr = BYTE_POS_ADDR (start2_byte);
memcpy (temp, start1_addr, len1_byte);
diff --git a/src/emacs-icon.h b/src/emacs-icon.h
index 292d1a023d6..590d874ca82 100644
--- a/src/emacs-icon.h
+++ b/src/emacs-icon.h
@@ -1,7 +1,7 @@
/* XPM */
/* Emacs icon
-Copyright (C) 2008-2011 Free Software Foundation, Inc.
+Copyright (C) 2008-2012 Free Software Foundation, Inc.
Author: Kentaro Ohkouchi <nanasess@fsm.ne.jp>
diff --git a/src/emacs.c b/src/emacs.c
index f4fa0eb0b9e..b2b193e3a4f 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1,6 +1,6 @@
/* Fully extensible Emacs, running on Unix, intended for GNU.
-Copyright (C) 1985-1987, 1993-1995, 1997-1999, 2001-2011
+Copyright (C) 1985-1987, 1993-1995, 1997-1999, 2001-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -20,24 +20,37 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <signal.h>
#include <errno.h>
#include <stdio.h>
#include <sys/types.h>
#include <sys/file.h>
-#include <setjmp.h>
#include <unistd.h>
+#include <close-stream.h>
+#include <ignore-value.h>
+
#include "lisp.h"
#ifdef WINDOWSNT
#include <fcntl.h>
-#include <windows.h> /* just for w32.h */
#include "w32.h"
-#include "w32heap.h" /* for prototype of sbrk */
+#include "w32heap.h"
+#endif
+
+#if defined WINDOWSNT || defined HAVE_NTGUI
+#include "w32select.h"
+#include "w32font.h"
#endif
+#if defined HAVE_NTGUI && defined CYGWIN
+#include "cygw32.h"
+#endif
+
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
+
#ifdef NS_IMPL_GNUSTEP
/* At least under Debian, GSConfig is in a subdirectory. --Stef */
#include <GNUstepBase/GSConfig.h>
@@ -45,10 +58,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "commands.h"
#include "intervals.h"
+#include "character.h"
#include "buffer.h"
#include "window.h"
#include "systty.h"
+#include "atimer.h"
#include "blockinput.h"
#include "syssignal.h"
#include "process.h"
@@ -61,12 +76,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "gnutls.h"
#endif
-#ifdef HAVE_NS
-#include "nsterm.h"
-#endif
-
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
+#if (defined PROFILING \
+ && (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__))
+# include <sys/gmon.h>
+extern void moncontrol (int mode);
#endif
#ifdef HAVE_SETLOCALE
@@ -82,56 +95,21 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/personality.h>
#endif
-#ifdef HAVE_LIBXML2
-#include <libxml/parser.h>
-#endif
-
-#ifndef O_RDWR
-#define O_RDWR 2
-#endif
-
-#ifdef HAVE_SETPGID
-#if !defined (USG)
-#undef setpgrp
-#define setpgrp setpgid
-#endif
-#endif
-
static const char emacs_version[] = VERSION;
-static const char emacs_copyright[] = "Copyright (C) 2011 Free Software Foundation, Inc.";
-
-/* Make these values available in GDB, which doesn't see macros. */
-
-#ifdef USE_LSB_TAG
-int gdb_use_lsb EXTERNALLY_VISIBLE = 1;
-#else
-int gdb_use_lsb EXTERNALLY_VISIBLE = 0;
-#endif
-#ifndef USE_LISP_UNION_TYPE
-int gdb_use_union EXTERNALLY_VISIBLE = 0;
-#else
-int gdb_use_union EXTERNALLY_VISIBLE = 1;
-#endif
-EMACS_INT gdb_valbits EXTERNALLY_VISIBLE = VALBITS;
-EMACS_INT gdb_gctypebits EXTERNALLY_VISIBLE = GCTYPEBITS;
-#if defined (DATA_SEG_BITS) && ! defined (USE_LSB_TAG)
-EMACS_INT gdb_data_seg_bits EXTERNALLY_VISIBLE = DATA_SEG_BITS;
-#else
-EMACS_INT gdb_data_seg_bits EXTERNALLY_VISIBLE = 0;
-#endif
-EMACS_INT PVEC_FLAG EXTERNALLY_VISIBLE = PSEUDOVECTOR_FLAG;
-EMACS_INT gdb_array_mark_flag EXTERNALLY_VISIBLE = ARRAY_MARK_FLAG;
-/* GDB might say "No enum type named pvec_type" if we don't have at
- least one symbol with that type, and then xbacktrace could fail. */
-enum pvec_type gdb_pvec_type EXTERNALLY_VISIBLE = PVEC_TYPE_MASK;
+static const char emacs_copyright[] = COPYRIGHT;
/* Empty lisp strings. To avoid having to build any others. */
Lisp_Object empty_unibyte_string, empty_multibyte_string;
-/* Set nonzero after Emacs has started up the first time.
- Prevents reinitialization of the Lisp world and keymaps
- on subsequent starts. */
-int initialized;
+#ifdef WINDOWSNT
+/* Cache for externally loaded libraries. */
+Lisp_Object Vlibrary_cache;
+#endif
+
+/* Set after Emacs has started up the first time.
+ Prevents reinitialization of the Lisp world and keymaps
+ on subsequent starts. */
+bool initialized;
#ifdef DARWIN_OS
extern void unexec_init_emacs_zone (void);
@@ -145,9 +123,9 @@ static void *malloc_state_ptr;
extern void *malloc_get_state (void);
/* From glibc, a routine that overwrites the malloc internal state. */
extern int malloc_set_state (void*);
-/* Non-zero if the MALLOC_CHECK_ environment variable was set while
+/* True if the MALLOC_CHECK_ environment variable was set while
dumping. Used to work around a bug in glibc's malloc. */
-static int malloc_using_checking;
+static bool malloc_using_checking;
#endif
Lisp_Object Qfile_name_handler_alist;
@@ -156,17 +134,17 @@ Lisp_Object Qrisky_local_variable;
Lisp_Object Qkill_emacs;
-/* If non-zero, Emacs should not attempt to use a window-specific code,
+/* If true, Emacs should not attempt to use a window-specific code,
but instead should use the virtual terminal under which it was started. */
-int inhibit_window_system;
+bool inhibit_window_system;
-/* If non-zero, a filter or a sentinel is running. Tested to save the match
+/* If true, a filter or a sentinel is running. Tested to save the match
data on the first attempt to change it inside asynchronous code. */
-int running_asynch_code;
+bool running_asynch_code;
#if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
-/* If non-zero, -d was specified, meaning we're using some window system. */
-int display_arg;
+/* If true, -d was specified, meaning we're using some window system. */
+bool display_arg;
#endif
/* An address near the bottom of the stack.
@@ -183,11 +161,27 @@ static void *my_heap_start;
static uprintmax_t heap_bss_diff;
#endif
-/* Nonzero means running Emacs without interactive terminal. */
-int noninteractive;
+/* To run as a daemon under Cocoa or Windows, we must do a fork+exec,
+ not a simple fork.
-/* Nonzero means remove site-lisp directories from load-path. */
-int no_site_lisp;
+ On Cocoa, CoreFoundation lib fails in forked process:
+ http://developer.apple.com/ReleaseNotes/
+ CoreFoundation/CoreFoundation.html)
+
+ On Windows, a Cygwin fork child cannot access the USER subsystem.
+
+ We mark being in the exec'd process by a daemon name argument of
+ form "--daemon=\nFD0,FD1\nNAME" where FD are the pipe file descriptors,
+ NAME is the original daemon name, if any. */
+#if defined NS_IMPL_COCOA || (defined HAVE_NTGUI && defined CYGWIN)
+# define DAEMON_MUST_EXEC
+#endif
+
+/* True means running Emacs without interactive terminal. */
+bool noninteractive;
+
+/* True means remove site-lisp directories from load-path. */
+bool no_site_lisp;
/* Name for the server started by the daemon.*/
static char *daemon_name;
@@ -302,44 +296,23 @@ Report bugs to bug-gnu-emacs@gnu.org. First, please see the Bugs\n\
section of the Emacs manual or the file BUGS.\n"
-/* Signal code for the fatal signal that was received. */
-static int fatal_error_code;
-
-/* Nonzero if handling a fatal error already. */
-int fatal_error_in_progress;
-
-/* If non-null, call this function from fatal_error_signal before
- committing suicide. */
-
-static void (*fatal_error_signal_hook) (void);
-
-#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
-/* When compiled with GTK and running under Gnome,
- multiple threads may be created. Keep track of our main
- thread to make sure signals are delivered to it (see syssignal.h). */
-
-pthread_t main_thread;
-#endif
+/* True if handling a fatal error already. */
+bool fatal_error_in_progress;
#ifdef HAVE_NS
/* NS autrelease pool, for memory management. */
static void *ns_pool;
-#endif
+#endif
-
-/* Handle bus errors, invalid instruction, etc. */
-#ifndef FLOAT_CATCH_SIGILL
-static
-#endif
-void
-fatal_error_signal (int sig)
+
+/* Report a fatal error due to signal SIG, output a backtrace of at
+ most BACKTRACE_LIMIT lines, and exit. */
+_Noreturn void
+terminate_due_to_signal (int sig, int backtrace_limit)
{
- SIGNAL_THREAD_CHECK (sig);
- fatal_error_code = sig;
signal (sig, SIG_DFL);
-
- TOTALLY_UNBLOCK_INPUT;
+ totally_unblock_input ();
/* If fatal error occurs in code below, avoid infinite recursion. */
if (! fatal_error_in_progress)
@@ -349,54 +322,46 @@ fatal_error_signal (int sig)
if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT)
Fkill_emacs (make_number (sig));
- shut_down_emacs (sig, 0, Qnil);
+ shut_down_emacs (sig, Qnil);
+ emacs_backtrace (backtrace_limit);
}
/* Signal the same code; this time it will really be fatal.
- Remember that since we're in a signal handler, the signal we're
- going to send is probably blocked, so we have to unblock it if we
- want to really receive it. */
+ Since we're in a signal handler, the signal is blocked, so we
+ have to unblock it if we want to really receive it. */
#ifndef MSDOS
- sigunblock (sigmask (fatal_error_code));
+ {
+ sigset_t unblocked;
+ sigemptyset (&unblocked);
+ sigaddset (&unblocked, sig);
+ pthread_sigmask (SIG_UNBLOCK, &unblocked, 0);
+ }
#endif
- if (fatal_error_signal_hook)
- fatal_error_signal_hook ();
+ emacs_raise (sig);
- kill (getpid (), fatal_error_code);
+ /* This shouldn't be executed, but it prevents a warning. */
+ exit (1);
}
#ifdef SIGDANGER
/* Handler for SIGDANGER. */
-void
-memory_warning_signal (int sig)
+static void
+handle_danger_signal (int sig)
{
- signal (sig, memory_warning_signal);
- SIGNAL_THREAD_CHECK (sig);
-
malloc_warning ("Operating system warns that virtual memory is running low.\n");
/* It might be unsafe to call do_auto_save now. */
force_auto_save_soon ();
}
-#endif
-
-/* We define abort, rather than using it from the library,
- so that GDB can return from a breakpoint here.
- MSDOS has its own definition in msdos.c. */
-
-#if ! defined (DOS_NT) && ! defined (NO_ABORT)
-void
-abort (void)
+static void
+deliver_danger_signal (int sig)
{
- kill (getpid (), SIGABRT);
- /* This shouldn't be executed, but it prevents a warning. */
- exit (1);
+ deliver_process_signal (sig, handle_danger_signal);
}
#endif
-
/* Code for dealing with Lisp access to the Unix command line. */
@@ -405,7 +370,7 @@ init_cmdargs (int argc, char **argv, int skip_args)
{
register int i;
Lisp_Object name, dir, handler;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object raw_name;
initial_argv = argv;
@@ -451,6 +416,16 @@ init_cmdargs (int argc, char **argv, int skip_args)
if (!NILP (Vinvocation_directory))
{
dir = Vinvocation_directory;
+#ifdef WINDOWSNT
+ /* If we are running from the build directory, set DIR to the
+ src subdirectory of the Emacs tree, like on Posix
+ platforms. */
+ if (SBYTES (dir) > sizeof ("/i386/") - 1
+ && 0 == strcmp (SSDATA (dir) + SBYTES (dir) - sizeof ("/i386/") + 1,
+ "/i386/"))
+ dir = Fexpand_file_name (build_string ("../.."), dir);
+#else /* !WINDOWSNT */
+#endif
name = Fexpand_file_name (Vinvocation_name, dir);
while (1)
{
@@ -573,7 +548,7 @@ static char dump_tz[] = "UtC0";
/* Define a dummy function F. Declare F too, to pacify gcc
-Wmissing-prototypes. */
#define DEFINE_DUMMY_FUNCTION(f) \
- void f (void) EXTERNALLY_VISIBLE; void f (void) {}
+ void f (void) ATTRIBUTE_CONST EXTERNALLY_VISIBLE; void f (void) {}
#ifndef GCC_CTORS_IN_LIBC
DEFINE_DUMMY_FUNCTION (__do_global_ctors)
@@ -599,7 +574,7 @@ DEFINE_DUMMY_FUNCTION (__main)
Too bad we can't just use getopt for all of this, but we don't have
enough information to do it right. */
-static int
+static bool
argmatch (char **argv, int argc, const char *sstr, const char *lstr,
int minlen, char **valptr, int *skipptr)
{
@@ -661,10 +636,6 @@ argmatch (char **argv, int argc, const char *sstr, const char *lstr,
static void
malloc_initialize_hook (void)
{
-#ifndef USE_CRT_DLL
- extern char **environ;
-#endif
-
if (initialized)
{
if (!malloc_using_checking)
@@ -701,6 +672,22 @@ void (*__malloc_initialize_hook) (void) EXTERNALLY_VISIBLE = malloc_initialize_h
#endif /* DOUG_LEA_MALLOC */
+/* Close standard output and standard error, reporting any write
+ errors as best we can. This is intended for use with atexit. */
+static void
+close_output_streams (void)
+{
+ if (close_stream (stdout) != 0)
+ {
+ fprintf (stderr, "Write error to standard output: %s\n",
+ strerror (errno));
+ fflush (stderr);
+ _exit (EXIT_FAILURE);
+ }
+
+ if (close_stream (stderr) != 0)
+ _exit (EXIT_FAILURE);
+}
/* ARGSUSED */
int
@@ -710,15 +697,16 @@ main (int argc, char **argv)
Lisp_Object dummy;
#endif
char stack_bottom_variable;
- int do_initial_setlocale;
+ bool do_initial_setlocale;
+ bool dumping;
int skip_args = 0;
#ifdef HAVE_SETRLIMIT
struct rlimit rlim;
#endif
- int no_loadup = 0;
+ bool no_loadup = 0;
char *junk = 0;
char *dname_arg = 0;
-#ifdef NS_IMPL_COCOA
+#ifdef DAEMON_MUST_EXEC
char dname_arg2[80];
#endif
char *ch_to_dir;
@@ -727,7 +715,7 @@ main (int argc, char **argv)
stack_base = &dummy;
#endif
-#if defined (USE_GTK) && defined (G_SLICE_ALWAYS_MALLOC)
+#ifdef G_SLICE_ALWAYS_MALLOC
/* This is used by the Cygwin build. */
setenv ("G_SLICE", "always-malloc", 1);
#endif
@@ -756,6 +744,8 @@ main (int argc, char **argv)
unexec_init_emacs_zone ();
#endif
+ atexit (close_output_streams);
+
sort_args (argc, argv);
argc = 0;
while (argv[argc]) argc++;
@@ -807,12 +797,11 @@ main (int argc, char **argv)
exit (1);
}
+ dumping = !initialized && (strcmp (argv[argc - 1], "dump") == 0
+ || strcmp (argv[argc - 1], "bootstrap") == 0);
#ifdef HAVE_PERSONALITY_LINUX32
- if (!initialized
- && (strcmp (argv[argc-1], "dump") == 0
- || strcmp (argv[argc-1], "bootstrap") == 0)
- && ! getenv ("EMACS_HEAP_EXEC"))
+ if (dumping && ! getenv ("EMACS_HEAP_EXEC"))
{
static char heapexec[] = "EMACS_HEAP_EXEC=true";
/* Set this so we only do this once. */
@@ -880,20 +869,12 @@ main (int argc, char **argv)
/* Arrange to get warning messages as memory fills up. */
memory_warnings (0, malloc_warning);
- /* Call malloc at least once, to run the initial __malloc_hook.
+ /* Call malloc at least once, to run malloc_initialize_hook.
Also call realloc and free for consistency. */
free (realloc (malloc (4), 4));
-# ifndef SYNC_INPUT
- /* Arrange to disable interrupt input inside malloc etc. */
- uninterrupt_malloc ();
-# endif /* not SYNC_INPUT */
#endif /* not SYSTEM_MALLOC */
-#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
- main_thread = pthread_self ();
-#endif /* FORWARD_SIGNAL_TO_MAIN_THREAD */
-
#if defined (MSDOS) || defined (WINDOWSNT)
/* We do all file input/output as binary files. When we need to translate
newlines, we do that manually. */
@@ -1022,25 +1003,19 @@ main (int argc, char **argv)
exit (1);
}
-#ifndef NS_IMPL_COCOA
+#ifndef DAEMON_MUST_EXEC
#ifdef USE_GTK
fprintf (stderr, "\nWarning: due to a long standing Gtk+ bug\nhttp://bugzilla.gnome.org/show_bug.cgi?id=85715\n\
Emacs might crash when run in daemon mode and the X11 connection is unexpectedly lost.\n\
Using an Emacs configured with --with-x-toolkit=lucid does not have this problem.\n");
-#endif
+#endif /* USE_GTK */
f = fork ();
-#else /* NS_IMPL_COCOA */
- /* Under Cocoa we must do fork+exec as CoreFoundation lib fails in
- forked process: http://developer.apple.com/ReleaseNotes/
- CoreFoundation/CoreFoundation.html)
- We mark being in the exec'd process by a daemon name argument of
- form "--daemon=\nFD0,FD1\nNAME" where FD are the pipe file descriptors,
- NAME is the original daemon name, if any. */
+#else /* DAEMON_MUST_EXEC */
if (!dname_arg || !strchr (dname_arg, '\n'))
f = fork (); /* in orig */
else
f = 0; /* in exec'd */
-#endif /* NS_IMPL_COCOA */
+#endif /* !DAEMON_MUST_EXEC */
if (f > 0)
{
int retval;
@@ -1076,7 +1051,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
exit (1);
}
-#ifdef NS_IMPL_COCOA
+#ifdef DAEMON_MUST_EXEC
{
/* In orig process, forked as child, OR in exec'd. */
if (!dname_arg || !strchr (dname_arg, '\n'))
@@ -1112,7 +1087,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
dname_arg2);
dname_arg = *dname_arg2 ? dname_arg2 : NULL;
}
-#endif /* NS_IMPL_COCOA */
+#endif /* DAEMON_MUST_EXEC */
if (dname_arg)
daemon_name = xstrdup (dname_arg);
@@ -1122,132 +1097,23 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
that it is not accessible to programs started from .emacs. */
fcntl (daemon_pipe[1], F_SETFD, FD_CLOEXEC);
-#ifdef HAVE_SETSID
setsid ();
-#endif
#else /* DOS_NT */
fprintf (stderr, "This platform does not support the -daemon flag.\n");
exit (1);
#endif /* DOS_NT */
}
+#if defined (HAVE_PTHREAD) && !defined (SYSTEM_MALLOC) && !defined (DOUG_LEA_MALLOC)
if (! noninteractive)
{
-#if defined (USG5) && defined (INTERRUPT_INPUT)
- setpgrp ();
-#endif
-#if defined (HAVE_PTHREAD) && !defined (SYSTEM_MALLOC) && !defined (DOUG_LEA_MALLOC)
- {
- extern void malloc_enable_thread (void);
-
- malloc_enable_thread ();
- }
-#endif
- }
+ extern void malloc_enable_thread (void);
- init_signals ();
-
- /* Don't catch SIGHUP if dumping. */
- if (1
-#ifndef CANNOT_DUMP
- && initialized
-#endif
- )
- {
- sigblock (sigmask (SIGHUP));
- /* In --batch mode, don't catch SIGHUP if already ignored.
- That makes nohup work. */
- if (! noninteractive
- || signal (SIGHUP, SIG_IGN) != SIG_IGN)
- signal (SIGHUP, fatal_error_signal);
- sigunblock (sigmask (SIGHUP));
+ malloc_enable_thread ();
}
-
- if (
-#ifndef CANNOT_DUMP
- ! noninteractive || initialized
-#else
- 1
-#endif
- )
- {
- /* Don't catch these signals in batch mode if dumping.
- On some machines, this sets static data that would make
- signal fail to work right when the dumped Emacs is run. */
- signal (SIGQUIT, fatal_error_signal);
- signal (SIGILL, fatal_error_signal);
- signal (SIGTRAP, fatal_error_signal);
-#ifdef SIGUSR1
- add_user_signal (SIGUSR1, "sigusr1");
-#endif
-#ifdef SIGUSR2
- add_user_signal (SIGUSR2, "sigusr2");
-#endif
-#ifdef SIGABRT
- signal (SIGABRT, fatal_error_signal);
-#endif
-#ifdef SIGHWE
- signal (SIGHWE, fatal_error_signal);
-#endif
-#ifdef SIGPRE
- signal (SIGPRE, fatal_error_signal);
-#endif
-#ifdef SIGORE
- signal (SIGORE, fatal_error_signal);
-#endif
-#ifdef SIGUME
- signal (SIGUME, fatal_error_signal);
-#endif
-#ifdef SIGDLK
- signal (SIGDLK, fatal_error_signal);
-#endif
-#ifdef SIGCPULIM
- signal (SIGCPULIM, fatal_error_signal);
-#endif
-#ifdef SIGIOT
- /* This is missing on some systems - OS/2, for example. */
- signal (SIGIOT, fatal_error_signal);
-#endif
-#ifdef SIGEMT
- signal (SIGEMT, fatal_error_signal);
-#endif
- signal (SIGFPE, fatal_error_signal);
-#ifdef SIGBUS
- signal (SIGBUS, fatal_error_signal);
-#endif
- signal (SIGSEGV, fatal_error_signal);
-#ifdef SIGSYS
- signal (SIGSYS, fatal_error_signal);
-#endif
- /* May need special treatment on MS-Windows. See
- http://lists.gnu.org/archive/html/emacs-devel/2010-09/msg01062.html
- Please update the doc of kill-emacs, kill-emacs-hook, and
- NEWS if you change this.
- */
- if (noninteractive) signal (SIGINT, fatal_error_signal);
- signal (SIGTERM, fatal_error_signal);
-#ifdef SIGXCPU
- signal (SIGXCPU, fatal_error_signal);
-#endif
-#ifdef SIGXFSZ
- signal (SIGXFSZ, fatal_error_signal);
-#endif /* SIGXFSZ */
-
-#ifdef SIGDANGER
- /* This just means available memory is getting low. */
- signal (SIGDANGER, memory_warning_signal);
#endif
-#ifdef AIX
-/* 20 is SIGCHLD, 21 is SIGTTIN, 22 is SIGTTOU. */
- signal (SIGXCPU, fatal_error_signal);
- signal (SIGIOINT, fatal_error_signal);
- signal (SIGGRANT, fatal_error_signal);
- signal (SIGRETRACT, fatal_error_signal);
- signal (SIGSOUND, fatal_error_signal);
- signal (SIGMSG, fatal_error_signal);
-#endif /* AIX */
- }
+ init_signals (dumping);
noninteractive1 = noninteractive;
@@ -1258,7 +1124,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
init_alloc_once ();
init_obarray ();
init_eval_once ();
- init_character_once ();
init_charset_once ();
init_coding_once ();
init_syntax_once (); /* Create standard syntax table. */
@@ -1285,6 +1150,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
/* Called before syms_of_fileio, because it sets up Qerror_condition. */
syms_of_data ();
+ syms_of_fns (); /* Before syms_of_charset which uses hashtables. */
syms_of_fileio ();
/* Before syms_of_coding to initialize Vgc_cons_threshold. */
syms_of_alloc ();
@@ -1296,7 +1162,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
init_window_once (); /* Init the window system. */
#ifdef HAVE_WINDOW_SYSTEM
- init_fringe_once (); /* Swap bitmaps if necessary. */
+ init_fringe_once (); /* Swap bitmaps if necessary. */
#endif /* HAVE_WINDOW_SYSTEM */
}
@@ -1310,12 +1176,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
}
init_eval ();
- init_data ();
-#ifdef CLASH_DETECTION
- init_filelock ();
-#endif
init_atimer ();
running_asynch_code = 0;
+ init_random ();
no_loadup
= argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args);
@@ -1427,14 +1290,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
globals_of_w32 ();
/* Initialize environment from registry settings. */
init_environment (argv);
- init_ntproc (); /* must precede init_editfns. */
-#endif
-
-#ifdef HAVE_NS
-#ifndef CANNOT_DUMP
- if (initialized)
-#endif
- ns_init_paths ();
+ init_ntproc (dumping); /* must precede init_editfns. */
#endif
/* Initialize and GC-protect Vinitial_environment and
@@ -1445,8 +1301,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
/* egetenv is a pretty low-level facility, which may get called in
many circumstances; it seems flimsy to put off initializing it
until calling init_callproc. Do not do it when dumping. */
- if (initialized || ((strcmp (argv[argc-1], "dump") != 0
- && strcmp (argv[argc-1], "bootstrap") != 0)))
+ if (! dumping)
set_initial_environment ();
/* AIX crashes are reported in system versions 3.2.3 and 3.2.4
@@ -1474,6 +1329,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
init_callproc (); /* Must follow init_cmdargs but not init_sys_modes. */
init_lread ();
+#ifdef WINDOWSNT
+ /* Check to see if Emacs has been installed correctly. */
+ check_windows_init_file ();
+#endif
/* Intern the names of all standard functions and variables;
define standard keys. */
@@ -1486,7 +1345,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
syms_of_lread ();
syms_of_print ();
syms_of_eval ();
- syms_of_fns ();
syms_of_floatfns ();
syms_of_buffer ();
@@ -1525,6 +1383,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
#ifdef WINDOWSNT
syms_of_ntproc ();
#endif /* WINDOWSNT */
+#if defined CYGWIN && defined HAVE_NTGUI
+ syms_of_cygw32 ();
+#endif
syms_of_window ();
syms_of_xdisp ();
syms_of_font ();
@@ -1555,11 +1416,14 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
#ifdef HAVE_NTGUI
syms_of_w32term ();
syms_of_w32fns ();
- syms_of_w32select ();
syms_of_w32menu ();
syms_of_fontset ();
#endif /* HAVE_NTGUI */
+#if defined WINDOWSNT || defined HAVE_NTGUI
+ syms_of_w32select ();
+#endif
+
#ifdef MSDOS
syms_of_xmenu ();
syms_of_dosfns ();
@@ -1587,6 +1451,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
syms_of_ntterm ();
#endif /* WINDOWSNT */
+ syms_of_profiler ();
+
keys_of_casefiddle ();
keys_of_cmds ();
keys_of_buffer ();
@@ -1602,28 +1468,25 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
globals_of_w32font ();
globals_of_w32fns ();
globals_of_w32menu ();
- globals_of_w32select ();
#endif /* HAVE_NTGUI */
+
+#if defined WINDOWSNT || defined HAVE_NTGUI
+ globals_of_w32select ();
+#endif
}
init_charset ();
- init_editfns (); /* init_process uses Voperating_system_release. */
- init_process (); /* init_display uses add_keyboard_wait_descriptor. */
+ init_editfns (); /* init_process_emacs uses Voperating_system_release. */
+ init_process_emacs (); /* init_display uses add_keyboard_wait_descriptor. */
init_keyboard (); /* This too must precede init_sys_modes. */
if (!noninteractive)
init_display (); /* Determine terminal type. Calls init_sys_modes. */
- init_fns ();
init_xdisp ();
#ifdef HAVE_WINDOW_SYSTEM
init_fringe ();
- init_image ();
#endif /* HAVE_WINDOW_SYSTEM */
init_macros ();
- init_floatfns ();
-#ifdef HAVE_SOUND
- init_sound ();
-#endif
init_window ();
init_font ();
@@ -1668,32 +1531,14 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
#ifdef PROFILING
if (initialized)
{
- extern void _mcleanup ();
#ifdef __MINGW32__
extern unsigned char etext asm ("etext");
#else
extern char etext;
#endif
-#ifdef HAVE___EXECUTABLE_START
- /* This symbol is defined by GNU ld to the start of the text
- segment. */
- extern char __executable_start[];
-#else
- extern void safe_bcopy ();
-#endif
atexit (_mcleanup);
-#ifdef HAVE___EXECUTABLE_START
- monstartup (__executable_start, &etext);
-#else
- /* This uses safe_bcopy because that function comes first in the
- Emacs executable. It might be better to use something that
- gives the start of the text segment, but start_of_text is not
- defined on all systems now. */
- /* FIXME: Does not work on architectures with function
- descriptors. */
- monstartup (safe_bcopy, &etext);
-#endif
+ monstartup ((uintptr_t) __executable_start, (uintptr_t) &etext);
}
else
moncontrol (0);
@@ -1842,7 +1687,7 @@ static const struct standard_args standard_args[] =
static void
sort_args (int argc, char **argv)
{
- char **new = (char **) xmalloc (sizeof (char *) * argc);
+ char **new = xmalloc (argc * sizeof *new);
/* For each element of argv,
the corresponding element of options is:
0 for an option that takes no arguments,
@@ -1956,7 +1801,7 @@ sort_args (int argc, char **argv)
}
if (best < 0)
- abort ();
+ emacs_abort ();
/* Copy the highest priority remaining option, with its args, to NEW.
Unless it is a duplicate of the previous one. */
@@ -2019,7 +1864,7 @@ all of which are called before Emacs is actually killed. */)
x_clipboard_manager_save_all ();
#endif
- shut_down_emacs (0, 0, STRINGP (arg) ? arg : Qnil);
+ shut_down_emacs (0, STRINGP (arg) ? arg : Qnil);
#ifdef HAVE_NS
ns_release_autorelease_pool (ns_pool);
@@ -2031,10 +1876,13 @@ all of which are called before Emacs is actually killed. */)
if (STRINGP (Vauto_save_list_file_name))
unlink (SSDATA (Vauto_save_list_file_name));
- exit_code = EXIT_SUCCESS;
- if (noninteractive && (fflush (stdout) || ferror (stdout)))
- exit_code = EXIT_FAILURE;
- exit (INTEGERP (arg) ? XINT (arg) : exit_code);
+ if (INTEGERP (arg))
+ exit_code = (XINT (arg) < 0
+ ? XINT (arg) | INT_MIN
+ : XINT (arg) & INT_MAX);
+ else
+ exit_code = EXIT_SUCCESS;
+ exit (exit_code);
}
@@ -2050,7 +1898,7 @@ all of which are called before Emacs is actually killed. */)
and Fkill_emacs. */
void
-shut_down_emacs (int sig, int no_x, Lisp_Object stuff)
+shut_down_emacs (int sig, Lisp_Object stuff)
{
/* Prevent running of hooks from now on. */
Vrun_hooks = Qnil;
@@ -2061,13 +1909,20 @@ shut_down_emacs (int sig, int no_x, Lisp_Object stuff)
/* If we are controlling the terminal, reset terminal modes. */
#ifndef DOS_NT
{
- int pgrp = EMACS_GETPGRP (0);
- int tpgrp = tcgetpgrp (0);
+ pid_t pgrp = getpgrp ();
+ pid_t tpgrp = tcgetpgrp (0);
if ((tpgrp != -1) && tpgrp == pgrp)
{
reset_all_sys_modes ();
if (sig && sig != SIGTERM)
- fprintf (stderr, "Fatal error (%d)", sig);
+ {
+ static char const format[] = "Fatal error %d: ";
+ char buf[sizeof format - 2 + INT_STRLEN_BOUND (int)];
+ int buflen = sprintf (buf, format, sig);
+ char const *sig_desc = safe_strsignal (sig);
+ ignore_value (write (STDERR_FILENO, buf, buflen));
+ ignore_value (write (STDERR_FILENO, sig_desc, strlen (sig_desc)));
+ }
}
}
#else
@@ -2085,27 +1940,10 @@ shut_down_emacs (int sig, int no_x, Lisp_Object stuff)
unlock_all_files ();
#endif
-#if 0 /* This triggers a bug in XCloseDisplay and is not needed. */
-#ifdef HAVE_X_WINDOWS
- /* It's not safe to call intern here. Maybe we are crashing. */
- if (!noninteractive && SYMBOLP (Vinitial_window_system)
- && SCHARS (SYMBOL_NAME (Vinitial_window_system)) == 1
- && SREF (SYMBOL_NAME (Vinitial_window_system), 0) == 'x'
- && ! no_x)
- Fx_close_current_connection ();
-#endif /* HAVE_X_WINDOWS */
-#endif
-
-#ifdef SIGIO
/* There is a tendency for a SIGIO signal to arrive within exit,
and cause a SIGHUP because the input descriptor is already closed. */
unrequest_sigio ();
- signal (SIGIO, SIG_IGN);
-#endif
-
-#ifdef WINDOWSNT
- term_ntproc ();
-#endif
+ ignore_sigio ();
/* Do this only if terminating normally, we want glyph matrices
etc. in a core dump. */
@@ -2124,7 +1962,11 @@ shut_down_emacs (int sig, int no_x, Lisp_Object stuff)
#endif
#ifdef HAVE_LIBXML2
- xmlCleanupParser ();
+ xml_cleanup_parser ();
+#endif
+
+#ifdef WINDOWSNT
+ term_ntproc (0);
#endif
}
@@ -2144,7 +1986,7 @@ You must run Emacs in batch mode in order to dump it. */)
{
Lisp_Object tem;
Lisp_Object symbol;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
check_pure_size ();
@@ -2207,12 +2049,6 @@ You must run Emacs in batch mode in order to dump it. */)
memory_warnings (my_edata, malloc_warning);
}
#endif /* not WINDOWSNT */
-#if defined (HAVE_PTHREAD) && !defined SYNC_INPUT
- /* Pthread may call malloc before main, and then we will get an endless
- loop, because pthread_self (see alloc.c) calls malloc the first time
- it is called on some systems. */
- reset_malloc_hooks ();
-#endif
#endif /* not SYSTEM_MALLOC */
#ifdef DOUG_LEA_MALLOC
malloc_state_ptr = malloc_get_state ();
@@ -2229,6 +2065,13 @@ You must run Emacs in batch mode in order to dump it. */)
free (malloc_state_ptr);
#endif
+#ifdef WINDOWSNT
+ Vlibrary_cache = Qnil;
+#endif
+#ifdef HAVE_WINDOW_SYSTEM
+ reset_image_types ();
+#endif
+
Vpurify_flag = tem;
return unbind_to (count, Qnil);
@@ -2280,15 +2123,18 @@ synchronize_system_messages_locale (void)
}
#endif /* HAVE_SETLOCALE */
-#ifndef SEPCHAR
-#define SEPCHAR ':'
-#endif
Lisp_Object
decode_env_path (const char *evarname, const char *defalt)
{
const char *path, *p;
Lisp_Object lpath, element, tem;
+#ifdef WINDOWSNT
+ bool defaulted = 0;
+ const char *emacs_dir = egetenv ("emacs_dir");
+ static const char *emacs_dir_env = "%emacs_dir%/";
+ const size_t emacs_dir_len = strlen (emacs_dir_env);
+#endif
/* It's okay to use getenv here, because this function is only used
to initialize variables when Emacs starts up, and isn't called
@@ -2298,7 +2144,12 @@ decode_env_path (const char *evarname, const char *defalt)
else
path = 0;
if (!path)
- path = defalt;
+ {
+ path = defalt;
+#ifdef WINDOWSNT
+ defaulted = 1;
+#endif
+ }
#ifdef DOS_NT
/* Ensure values from the environment use the proper directory separator. */
if (path)
@@ -2317,6 +2168,16 @@ decode_env_path (const char *evarname, const char *defalt)
p = path + strlen (path);
element = (p - path ? make_string (path, p - path)
: build_string ("."));
+#ifdef WINDOWSNT
+ /* Relative file names in the default path are interpreted as
+ being relative to $emacs_dir. */
+ if (emacs_dir && defaulted
+ && strncmp (path, emacs_dir_env, emacs_dir_len) == 0)
+ element = Fexpand_file_name (Fsubstring (element,
+ make_number (emacs_dir_len),
+ Qnil),
+ build_string (emacs_dir));
+#endif
/* Add /: to the front of the name
if it would otherwise be treated as magic. */
@@ -2365,7 +2226,7 @@ from the parent process and its tty file descriptors. */)
(void)
{
int nfd;
- int err = 0;
+ bool err = 0;
if (!IS_DAEMON)
error ("This function can only be called if emacs is run as a daemon");
@@ -2436,7 +2297,7 @@ Special values:
Anything else (in Emacs 24.1, the possibilities are: aix, berkeley-unix,
hpux, irix, usg-unix-v) indicates some sort of Unix system. */);
Vsystem_type = intern_c_string (SYSTEM_TYPE);
- /* The above values are from SYSTEM_TYPE in include files under src/s. */
+ /* See configure.ac (and config.nt) for the possible SYSTEM_TYPEs. */
DEFVAR_LISP ("system-configuration", Vsystem_configuration,
doc: /* Value is string indicating configuration Emacs was built for.
@@ -2452,7 +2313,7 @@ Emacs is running. */);
doc: /* Non-nil means Emacs is running without interactive terminal. */);
DEFVAR_LISP ("kill-emacs-hook", Vkill_emacs_hook,
- doc: /* Hook to be run when `kill-emacs' is called.
+ doc: /* Hook run when `kill-emacs' is called.
Since `kill-emacs' may be invoked when the terminal is disconnected (or
in other similar situations), functions placed on this hook should not
expect to be able to interact with the user. To ask for confirmation,
@@ -2480,9 +2341,11 @@ The value is nil if that directory's name is not known. */);
DEFVAR_LISP ("installation-directory", Vinstallation_directory,
doc: /* A directory within which to look for the `lib-src' and `etc' directories.
-This is non-nil when we can't find those directories in their standard
-installed locations, but we can find them near where the Emacs executable
-was found. */);
+In an installed Emacs, this is normally nil. It is non-nil if
+both `lib-src' (on MS-DOS, `info') and `etc' directories are found
+within the variable `invocation-directory' or its parent. For example,
+this is the case when running an uninstalled Emacs executable from its
+build directory. */);
Vinstallation_directory = Qnil;
DEFVAR_LISP ("system-messages-locale", Vsystem_messages_locale,
@@ -2541,6 +2404,11 @@ libraries; only those already known by Emacs will be loaded. */);
Vdynamic_library_alist = Qnil;
Fput (intern_c_string ("dynamic-library-alist"), Qrisky_local_variable, Qt);
+#ifdef WINDOWSNT
+ Vlibrary_cache = Qnil;
+ staticpro (&Vlibrary_cache);
+#endif
+
/* Make sure IS_DAEMON starts up as false. */
daemon_pipe[1] = 0;
}
diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c
index d9084bf9a98..d10185072cc 100644
--- a/src/emacsgtkfixed.c
+++ b/src/emacsgtkfixed.c
@@ -1,7 +1,7 @@
/* A Gtk Widget that inherits GtkFixed, but can be shrunk.
This file is only use when compiling with Gtk+ 3.
-Copyright (C) 2011 Free Software Foundation, Inc.
+Copyright (C) 2011-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,13 +21,39 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include "emacsgtkfixed.h"
-#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "frame.h"
#include "xterm.h"
+/* Silence a bogus diagnostic; see GNOME bug 683906. */
+#if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic push
+# pragma GCC diagnostic ignored "-Wunused-local-typedefs"
+#endif
+
+#define EMACS_TYPE_FIXED emacs_fixed_get_type ()
+#define EMACS_FIXED(obj) \
+ G_TYPE_CHECK_INSTANCE_CAST (obj, EMACS_TYPE_FIXED, EmacsFixed)
+
+typedef struct _EmacsFixed EmacsFixed;
+typedef struct _EmacsFixedPrivate EmacsFixedPrivate;
+typedef struct _EmacsFixedClass EmacsFixedClass;
+
+struct _EmacsFixed
+{
+ GtkFixed container;
+
+ /*< private >*/
+ EmacsFixedPrivate *priv;
+};
+
+struct _EmacsFixedClass
+{
+ GtkFixedClass parent_class;
+};
+
struct _EmacsFixedPrivate
{
struct frame *f;
@@ -40,28 +66,21 @@ static void emacs_fixed_get_preferred_width (GtkWidget *widget,
static void emacs_fixed_get_preferred_height (GtkWidget *widget,
gint *minimum,
gint *natural);
+static GType emacs_fixed_get_type (void);
G_DEFINE_TYPE (EmacsFixed, emacs_fixed, GTK_TYPE_FIXED)
static void
emacs_fixed_class_init (EmacsFixedClass *klass)
{
GtkWidgetClass *widget_class;
- GtkFixedClass *fixed_class;
widget_class = (GtkWidgetClass*) klass;
- fixed_class = (GtkFixedClass*) klass;
widget_class->get_preferred_width = emacs_fixed_get_preferred_width;
widget_class->get_preferred_height = emacs_fixed_get_preferred_height;
g_type_class_add_private (klass, sizeof (EmacsFixedPrivate));
}
-static GType
-emacs_fixed_child_type (GtkFixed *container)
-{
- return GTK_TYPE_WIDGET;
-}
-
static void
emacs_fixed_init (EmacsFixed *fixed)
{
diff --git a/src/emacsgtkfixed.h b/src/emacsgtkfixed.h
index c70e9a3efe3..3fa294aa41e 100644
--- a/src/emacsgtkfixed.h
+++ b/src/emacsgtkfixed.h
@@ -1,7 +1,7 @@
/* A Gtk Widget that inherits GtkFixed, but can be shrunk.
This file is only use when compiling with Gtk+ 3.
-Copyright (C) 2011 Free Software Foundation, Inc.
+Copyright (C) 2011-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -27,33 +27,7 @@ G_BEGIN_DECLS
struct frame;
-#define EMACS_TYPE_FIXED (emacs_fixed_get_type ())
-#define EMACS_FIXED(obj) (G_TYPE_CHECK_INSTANCE_CAST ((obj), EMACS_TYPE_FIXED, EmacsFixed))
-#define EMACS_FIXED_CLASS(klass) (G_TYPE_CHECK_CLASS_CAST ((klass), EMACS_TYPE_FIXED, EmacsFixedClass))
-#define EMACS_IS_FIXED(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), EMACS_TYPE_FIXED))
-#define EMACS_IS_FIXED_CLASS(klass) (G_TYPE_CHECK_CLASS_TYPE ((klass), EMACS_TYPE_FIXED))
-#define EMACS_FIXED_GET_CLASS(obj) (G_TYPE_INSTANCE_GET_CLASS ((obj), EMACS_TYPE_FIXED, EmacsFixedClass))
-
-typedef struct _EmacsFixed EmacsFixed;
-typedef struct _EmacsFixedPrivate EmacsFixedPrivate;
-typedef struct _EmacsFixedClass EmacsFixedClass;
-
-struct _EmacsFixed
-{
- GtkFixed container;
-
- /*< private >*/
- EmacsFixedPrivate *priv;
-};
-
-
-struct _EmacsFixedClass
-{
- GtkFixedClass parent_class;
-};
-
extern GtkWidget *emacs_fixed_new (struct frame *f);
-extern GType emacs_fixed_get_type (void);
G_END_DECLS
diff --git a/src/epaths.in b/src/epaths.in
index 54131f0e179..705fe3aab1b 100644
--- a/src/epaths.in
+++ b/src/epaths.in
@@ -1,6 +1,6 @@
/* Hey Emacs, this is -*- C -*- code! */
/*
-Copyright (C) 1993, 1995, 1997, 1999, 2001-2011
+Copyright (C) 1993, 1995, 1997, 1999, 2001-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,14 +19,31 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-/* The default search path for Lisp function "load".
- This sets load-path. */
-#define PATH_LOADSEARCH "/usr/local/lib/emacs/lisp"
+/* Together with PATH_SITELOADSEARCH, this gives the default value of
+ load-path, which is the search path for the Lisp function "load".
+ Configure (using "make epaths-force") sets this to
+ ${standardlisppath}, which typically has a value like:
+ <datadir>/emacs/VERSION/lisp:<datadir>/emacs/VERSION/leim
+ where datadir is eg /usr/local/share.
+*/
+#define PATH_LOADSEARCH "/usr/local/share/emacs/lisp"
-/* Like PATH_LOADSEARCH, but used only when Emacs is dumping. This
- path is usually identical to PATH_LOADSEARCH except that the entry
- for the directory containing the installed lisp files has been
- replaced with ../lisp. */
+
+/* Like PATH_LOADSEARCH, but contains the non-standard pieces.
+ These are the site-lisp directories, typically something like
+ <datadir>/emacs/VERSION/site-lisp:<datadir>/emacs/site-lisp
+ Configure prepends any $locallisppath, as set by the
+ --enable-locallisppath argument.
+ This is combined with PATH_LOADSEARCH to make the default load-path.
+ If the --no-site-lisp option is used, this piece is excluded.
+*/
+#define PATH_SITELOADSEARCH "/usr/local/share/emacs/site-lisp"
+
+
+/* Like PATH_LOADSEARCH, but used only during the build process
+ when Emacs is dumping. Configure (using "make epaths-force") sets
+ this to $buildlisppath, which normally has the value: <srcdir>/lisp.
+*/
#define PATH_DUMPLOADSEARCH "../lisp"
/* The extra search path for programs to invoke. This is appended to
@@ -34,12 +51,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
variable exec-path and the first file name in it sets the Lisp
variable exec-directory. exec-directory is used for finding
executables and other architecture-dependent files. */
-#define PATH_EXEC "/usr/local/lib/emacs/etc"
+#define PATH_EXEC "/usr/local/libexec/emacs"
/* Where Emacs should look for its architecture-independent data
files, like the NEWS file. The lisp variable data-directory
is set to this value. */
-#define PATH_DATA "/usr/local/lib/emacs/data"
+#define PATH_DATA "/usr/local/share/emacs/etc"
/* Where Emacs should look for X bitmap files.
The lisp variable x-bitmap-file-path is set based on this value. */
@@ -47,7 +64,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Where Emacs should look for its docstring file. The lisp variable
doc-directory is set to this value. */
-#define PATH_DOC "/usr/local/lib/emacs/data"
+#define PATH_DOC "/usr/local/share/emacs/etc"
/* Where the configuration process believes the info tree lives. The
lisp variable configure-info-directory gets its value from this
diff --git a/src/eval.c b/src/eval.c
index 079c7ecb6c2..34b20f6fc8e 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1,5 +1,5 @@
/* Evaluator for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1987, 1993-1995, 1999-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1987, 1993-1995, 1999-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,7 +19,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <limits.h>
-#include <setjmp.h>
#include <stdio.h>
#include "lisp.h"
#include "blockinput.h"
@@ -32,17 +31,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "xterm.h"
#endif
-struct backtrace
-{
- struct backtrace *next;
- Lisp_Object *function;
- Lisp_Object *args; /* Points to vector of args. */
- ptrdiff_t nargs; /* Length of vector. */
- /* Nonzero means call value of debugger when done with this operation. */
- unsigned int debug_on_exit : 1;
-};
-
-static struct backtrace *backtrace_list;
+struct backtrace *backtrace_list;
#if !BYTE_MARK_STACK
static
@@ -65,11 +54,11 @@ struct handler *handlerlist;
int gcpro_level;
#endif
-Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
+Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp;
Lisp_Object Qinhibit_quit;
Lisp_Object Qand_rest;
static Lisp_Object Qand_optional;
-static Lisp_Object Qdebug_on_error;
+static Lisp_Object Qinhibit_debugger;
static Lisp_Object Qdeclare;
Lisp_Object Qinternal_interpreter_environment, Qclosure;
@@ -90,7 +79,7 @@ Lisp_Object Vautoload_queue;
/* Current number of specbindings allocated in specpdl. */
-EMACS_INT specpdl_size;
+ptrdiff_t specpdl_size;
/* Pointer to beginning of specpdl. */
@@ -111,30 +100,41 @@ static EMACS_INT lisp_eval_depth;
signal the error instead of entering an infinite loop of debugger
invocations. */
-static int when_entered_debugger;
+static EMACS_INT when_entered_debugger;
/* The function from which the last `signal' was called. Set in
Fsignal. */
Lisp_Object Vsignaling_function;
-/* Set to non-zero while processing X events. Checked in Feval to
- make sure the Lisp interpreter isn't called from a signal handler,
- which is unsafe because the interpreter isn't reentrant. */
-
-int handling_signal;
+/* If non-nil, Lisp code must not be run since some part of Emacs is
+ in an inconsistent state. Currently, x-create-frame uses this to
+ avoid triggering window-configuration-change-hook while the new
+ frame is half-initialized. */
+Lisp_Object inhibit_lisp_code;
static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
-static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
-static int interactive_p (int);
static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
-static Lisp_Object Ffetch_bytecode (Lisp_Object);
-
+
+/* Functions to set Lisp_Object slots of struct specbinding. */
+
+static void
+set_specpdl_symbol (Lisp_Object symbol)
+{
+ specpdl_ptr->symbol = symbol;
+}
+
+static void
+set_specpdl_old_value (Lisp_Object oldval)
+{
+ specpdl_ptr->old_value = oldval;
+}
+
void
init_eval_once (void)
{
enum { size = 50 };
- specpdl = (struct specbinding *) xmalloc (size * sizeof (struct specbinding));
+ specpdl = xmalloc (size * sizeof *specpdl);
specpdl_size = size;
specpdl_ptr = specpdl;
/* Don't forget to update docs (lispref node "Local Variables"). */
@@ -173,11 +173,11 @@ restore_stack_limits (Lisp_Object data)
/* Call the Lisp debugger, giving it argument ARG. */
-static Lisp_Object
+Lisp_Object
call_debugger (Lisp_Object arg)
{
- int debug_while_redisplaying;
- int count = SPECPDL_INDEX ();
+ bool debug_while_redisplaying;
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object val;
EMACS_INT old_max = max_specpdl_size;
@@ -211,7 +211,7 @@ call_debugger (Lisp_Object arg)
specbind (intern ("debugger-may-continue"),
debug_while_redisplaying ? Qnil : Qt);
specbind (Qinhibit_redisplay, Qnil);
- specbind (Qdebug_on_error, Qnil);
+ specbind (Qinhibit_debugger, Qt);
#if 0 /* Binding this prevents execution of Lisp code during
redisplay, which necessarily leads to display problems. */
@@ -373,23 +373,14 @@ usage: (prog1 FIRST BODY...) */)
Lisp_Object val;
register Lisp_Object args_left;
struct gcpro gcpro1, gcpro2;
- register int argnum = 0;
-
- if (NILP (args))
- return Qnil;
args_left = args;
val = Qnil;
GCPRO2 (args, val);
- do
- {
- Lisp_Object tem = eval_sub (XCAR (args_left));
- if (!(argnum++))
- val = tem;
- args_left = XCDR (args_left);
- }
- while (CONSP (args_left));
+ val = eval_sub (XCAR (args_left));
+ while (CONSP (args_left = XCDR (args_left)))
+ eval_sub (XCAR (args_left));
UNGCPRO;
return val;
@@ -402,31 +393,12 @@ remaining args, whose values are discarded.
usage: (prog2 FORM1 FORM2 BODY...) */)
(Lisp_Object args)
{
- Lisp_Object val;
- register Lisp_Object args_left;
- struct gcpro gcpro1, gcpro2;
- register int argnum = -1;
-
- val = Qnil;
-
- if (NILP (args))
- return Qnil;
-
- args_left = args;
- val = Qnil;
- GCPRO2 (args, val);
-
- do
- {
- Lisp_Object tem = eval_sub (XCAR (args_left));
- if (!(argnum++))
- val = tem;
- args_left = XCDR (args_left);
- }
- while (CONSP (args_left));
+ struct gcpro gcpro1;
+ GCPRO1 (args);
+ eval_sub (XCAR (args));
UNGCPRO;
- return val;
+ return Fprog1 (XCDR (args));
}
DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
@@ -516,208 +488,6 @@ usage: (function ARG) */)
}
-DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
- doc: /* Return t if the containing function was run directly by user input.
-This means that the function was called with `call-interactively'
-\(which includes being called as the binding of a key)
-and input is currently coming from the keyboard (not a keyboard macro),
-and Emacs is not running in batch mode (`noninteractive' is nil).
-
-The only known proper use of `interactive-p' is in deciding whether to
-display a helpful message, or how to display it. If you're thinking
-of using it for any other purpose, it is quite likely that you're
-making a mistake. Think: what do you want to do when the command is
-called from a keyboard macro?
-
-To test whether your function was called with `call-interactively',
-either (i) add an extra optional argument and give it an `interactive'
-spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
-use `called-interactively-p'. */)
- (void)
-{
- return interactive_p (1) ? Qt : Qnil;
-}
-
-
-DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 1, 0,
- doc: /* Return t if the containing function was called by `call-interactively'.
-If KIND is `interactive', then only return t if the call was made
-interactively by the user, i.e. not in `noninteractive' mode nor
-when `executing-kbd-macro'.
-If KIND is `any', on the other hand, it will return t for any kind of
-interactive call, including being called as the binding of a key, or
-from a keyboard macro, or in `noninteractive' mode.
-
-The only known proper use of `interactive' for KIND is in deciding
-whether to display a helpful message, or how to display it. If you're
-thinking of using it for any other purpose, it is quite likely that
-you're making a mistake. Think: what do you want to do when the
-command is called from a keyboard macro?
-
-This function is meant for implementing advice and other
-function-modifying features. Instead of using this, it is sometimes
-cleaner to give your function an extra optional argument whose
-`interactive' spec specifies non-nil unconditionally (\"p\" is a good
-way to do this), or via (not (or executing-kbd-macro noninteractive)). */)
- (Lisp_Object kind)
-{
- return ((INTERACTIVE || !EQ (kind, intern ("interactive")))
- && interactive_p (1)) ? Qt : Qnil;
-}
-
-
-/* Return 1 if function in which this appears was called using
- call-interactively.
-
- EXCLUDE_SUBRS_P non-zero means always return 0 if the function
- called is a built-in. */
-
-static int
-interactive_p (int exclude_subrs_p)
-{
- struct backtrace *btp;
- Lisp_Object fun;
-
- btp = backtrace_list;
-
- /* If this isn't a byte-compiled function, there may be a frame at
- the top for Finteractive_p. If so, skip it. */
- fun = Findirect_function (*btp->function, Qnil);
- if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
- || XSUBR (fun) == &Scalled_interactively_p))
- btp = btp->next;
-
- /* If we're running an Emacs 18-style byte-compiled function, there
- may be a frame for Fbytecode at the top level. In any version of
- Emacs there can be Fbytecode frames for subexpressions evaluated
- inside catch and condition-case. Skip past them.
-
- If this isn't a byte-compiled function, then we may now be
- looking at several frames for special forms. Skip past them. */
- while (btp
- && (EQ (*btp->function, Qbytecode)
- || btp->nargs == UNEVALLED))
- btp = btp->next;
-
- /* `btp' now points at the frame of the innermost function that isn't
- a special form, ignoring frames for Finteractive_p and/or
- Fbytecode at the top. If this frame is for a built-in function
- (such as load or eval-region) return nil. */
- fun = Findirect_function (*btp->function, Qnil);
- if (exclude_subrs_p && SUBRP (fun))
- return 0;
-
- /* `btp' points to the frame of a Lisp function that called interactive-p.
- Return t if that function was called interactively. */
- if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
- return 1;
- return 0;
-}
-
-
-DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0,
- doc: /* Define NAME as a function.
-The definition is (lambda ARGLIST [DOCSTRING] BODY...).
-See also the function `interactive'.
-usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
- (Lisp_Object args)
-{
- register Lisp_Object fn_name;
- register Lisp_Object defn;
-
- fn_name = Fcar (args);
- CHECK_SYMBOL (fn_name);
- defn = Fcons (Qlambda, Fcdr (args));
- if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */
- defn = Ffunction (Fcons (defn, Qnil));
- if (!NILP (Vpurify_flag))
- defn = Fpurecopy (defn);
- if (CONSP (XSYMBOL (fn_name)->function)
- && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
- LOADHIST_ATTACH (Fcons (Qt, fn_name));
- Ffset (fn_name, defn);
- LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
- return fn_name;
-}
-
-DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0,
- doc: /* Define NAME as a macro.
-The actual definition looks like
- (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
-When the macro is called, as in (NAME ARGS...),
-the function (lambda ARGLIST BODY...) is applied to
-the list ARGS... as it appears in the expression,
-and the result should be a form to be evaluated instead of the original.
-
-DECL is a declaration, optional, which can specify how to indent
-calls to this macro, how Edebug should handle it, and which argument
-should be treated as documentation. It looks like this:
- (declare SPECS...)
-The elements can look like this:
- (indent INDENT)
- Set NAME's `lisp-indent-function' property to INDENT.
-
- (debug DEBUG)
- Set NAME's `edebug-form-spec' property to DEBUG. (This is
- equivalent to writing a `def-edebug-spec' for the macro.)
-
- (doc-string ELT)
- Set NAME's `doc-string-elt' property to ELT.
-
-usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
- (Lisp_Object args)
-{
- register Lisp_Object fn_name;
- register Lisp_Object defn;
- Lisp_Object lambda_list, doc, tail;
-
- fn_name = Fcar (args);
- CHECK_SYMBOL (fn_name);
- lambda_list = Fcar (Fcdr (args));
- tail = Fcdr (Fcdr (args));
-
- doc = Qnil;
- if (STRINGP (Fcar (tail)))
- {
- doc = XCAR (tail);
- tail = XCDR (tail);
- }
-
- if (CONSP (Fcar (tail))
- && EQ (Fcar (Fcar (tail)), Qdeclare))
- {
- if (!NILP (Vmacro_declaration_function))
- {
- struct gcpro gcpro1;
- GCPRO1 (args);
- call2 (Vmacro_declaration_function, fn_name, Fcar (tail));
- UNGCPRO;
- }
-
- tail = Fcdr (tail);
- }
-
- if (NILP (doc))
- tail = Fcons (lambda_list, tail);
- else
- tail = Fcons (lambda_list, Fcons (doc, tail));
-
- defn = Fcons (Qlambda, tail);
- if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */
- defn = Ffunction (Fcons (defn, Qnil));
- defn = Fcons (Qmacro, defn);
-
- if (!NILP (Vpurify_flag))
- defn = Fpurecopy (defn);
- if (CONSP (XSYMBOL (fn_name)->function)
- && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
- LOADHIST_ATTACH (Fcons (Qt, fn_name));
- Ffset (fn_name, defn);
- LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
- return fn_name;
-}
-
-
DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
Aliased variables always have the same value; setting one sets the other.
@@ -758,8 +528,8 @@ The return value is BASE-VARIABLE. */)
{
struct specbinding *p;
- for (p = specpdl_ptr - 1; p >= specpdl; p--)
- if (p->func == NULL
+ for (p = specpdl_ptr; p > specpdl; )
+ if ((--p)->func == NULL
&& (EQ (new_alias,
CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol)))
error ("Don't know how to make a let-bound variable an alias");
@@ -780,17 +550,15 @@ The return value is BASE-VARIABLE. */)
DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0,
doc: /* Define SYMBOL as a variable, and return SYMBOL.
-You are not required to define a variable in order to use it,
-but the definition can supply documentation and an initial value
-in a way that tags can recognize.
-
-INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.
-If SYMBOL is buffer-local, its default value is what is set;
- buffer-local values are not affected.
-INITVALUE and DOCSTRING are optional.
-If DOCSTRING starts with *, this variable is identified as a user option.
- This means that M-x set-variable recognizes it.
- See also `user-variable-p'.
+You are not required to define a variable in order to use it, but
+defining it lets you supply an initial value and documentation, which
+can be referred to by the Emacs help facilities and other programming
+tools. The `defvar' form also declares the variable as \"special\",
+so that it is always dynamically bound even if `lexical-binding' is t.
+
+The optional argument INITVALUE is evaluated, and used to set SYMBOL,
+only if SYMBOL's value is void. If SYMBOL is buffer-local, its
+default value is what is set; buffer-local values are not affected.
If INITVALUE is missing, SYMBOL's value is not set.
If SYMBOL has a local binding, then this form affects the local
@@ -799,6 +567,11 @@ load a file defining variables, with this form or with `defconst' or
`defcustom', you should always load that file _outside_ any bindings
for these variables. \(`defconst' and `defcustom' behave similarly in
this respect.)
+
+The optional argument DOCSTRING is a documentation string for the
+variable.
+
+To define a user option, use `defcustom' instead of `defvar'.
usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
(Lisp_Object args)
{
@@ -815,31 +588,20 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
/* Do it before evaluating the initial value, for self-references. */
XSYMBOL (sym)->declared_special = 1;
- if (SYMBOL_CONSTANT_P (sym))
- {
- /* For upward compatibility, allow (defvar :foo (quote :foo)). */
- Lisp_Object tem1 = Fcar (tail);
- if (! (CONSP (tem1)
- && EQ (XCAR (tem1), Qquote)
- && CONSP (XCDR (tem1))
- && EQ (XCAR (XCDR (tem1)), sym)))
- error ("Constant symbol `%s' specified in defvar",
- SDATA (SYMBOL_NAME (sym)));
- }
-
if (NILP (tem))
Fset_default (sym, eval_sub (Fcar (tail)));
else
{ /* Check if there is really a global binding rather than just a let
binding that shadows the global unboundness of the var. */
- volatile struct specbinding *pdl = specpdl_ptr;
- while (--pdl >= specpdl)
+ struct specbinding *pdl = specpdl_ptr;
+ while (pdl > specpdl)
{
- if (EQ (pdl->symbol, sym) && !pdl->func
+ if (EQ ((--pdl)->symbol, sym) && !pdl->func
&& EQ (pdl->old_value, Qunbound))
{
- message_with_string ("Warning: defvar ignored because %s is let-bound",
- SYMBOL_NAME (sym), 1);
+ message_with_string
+ ("Warning: defvar ignored because %s is let-bound",
+ SYMBOL_NAME (sym), 1);
break;
}
}
@@ -859,8 +621,8 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
/* A simple (defvar foo) with lexical scoping does "nothing" except
declare that var to be dynamically scoped *locally* (i.e. within
the current file or let-block). */
- Vinternal_interpreter_environment =
- Fcons (sym, Vinternal_interpreter_environment);
+ Vinternal_interpreter_environment
+ = Fcons (sym, Vinternal_interpreter_environment);
else
{
/* Simple (defvar <var>) should not count as a definition at all.
@@ -873,15 +635,19 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0,
doc: /* Define SYMBOL as a constant variable.
-The intent is that neither programs nor users should ever change this value.
-Always sets the value of SYMBOL to the result of evalling INITVALUE.
-If SYMBOL is buffer-local, its default value is what is set;
- buffer-local values are not affected.
-DOCSTRING is optional.
-
-If SYMBOL has a local binding, then this form sets the local binding's
-value. However, you should normally not make local bindings for
-variables defined with this form.
+This declares that neither programs nor users should ever change the
+value. This constancy is not actually enforced by Emacs Lisp, but
+SYMBOL is marked as a special variable so that it is never lexically
+bound.
+
+The `defconst' form always sets the value of SYMBOL to the result of
+evalling INITVALUE. If SYMBOL is buffer-local, its default value is
+what is set; buffer-local values are not affected. If SYMBOL has a
+local binding, then this form sets the local binding's value.
+However, you should normally not make local bindings for variables
+defined with this form.
+
+The optional DOCSTRING specifies the variable's documentation string.
usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
(Lisp_Object args)
{
@@ -908,70 +674,17 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
return sym;
}
-/* Error handler used in Fuser_variable_p. */
-static Lisp_Object
-user_variable_p_eh (Lisp_Object ignore)
+/* Make SYMBOL lexically scoped. */
+DEFUN ("internal-make-var-non-special", Fmake_var_non_special,
+ Smake_var_non_special, 1, 1, 0,
+ doc: /* Internal function. */)
+ (Lisp_Object symbol)
{
+ CHECK_SYMBOL (symbol);
+ XSYMBOL (symbol)->declared_special = 0;
return Qnil;
}
-static Lisp_Object
-lisp_indirect_variable (Lisp_Object sym)
-{
- struct Lisp_Symbol *s = indirect_variable (XSYMBOL (sym));
- XSETSYMBOL (sym, s);
- return sym;
-}
-
-DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0,
- doc: /* Return t if VARIABLE is intended to be set and modified by users.
-\(The alternative is a variable used internally in a Lisp program.)
-A variable is a user variable if
-\(1) the first character of its documentation is `*', or
-\(2) it is customizable (its property list contains a non-nil value
- of `standard-value' or `custom-autoload'), or
-\(3) it is an alias for another user variable.
-Return nil if VARIABLE is an alias and there is a loop in the
-chain of symbols. */)
- (Lisp_Object variable)
-{
- Lisp_Object documentation;
-
- if (!SYMBOLP (variable))
- return Qnil;
-
- /* If indirect and there's an alias loop, don't check anything else. */
- if (XSYMBOL (variable)->redirect == SYMBOL_VARALIAS
- && NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
- Qt, user_variable_p_eh)))
- return Qnil;
-
- while (1)
- {
- documentation = Fget (variable, Qvariable_documentation);
- if (INTEGERP (documentation) && XINT (documentation) < 0)
- return Qt;
- if (STRINGP (documentation)
- && ((unsigned char) SREF (documentation, 0) == '*'))
- return Qt;
- /* If it is (STRING . INTEGER), a negative integer means a user variable. */
- if (CONSP (documentation)
- && STRINGP (XCAR (documentation))
- && INTEGERP (XCDR (documentation))
- && XINT (XCDR (documentation)) < 0)
- return Qt;
- /* Customizable? See `custom-variable-p'. */
- if ((!NILP (Fget (variable, intern ("standard-value"))))
- || (!NILP (Fget (variable, intern ("custom-autoload")))))
- return Qt;
-
- if (!(XSYMBOL (variable)->redirect == SYMBOL_VARALIAS))
- return Qnil;
-
- /* An indirect variable? Let's follow the chain. */
- XSETSYMBOL (variable, SYMBOL_ALIAS (XSYMBOL (variable)));
- }
-}
DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
doc: /* Bind variables according to VARLIST then eval BODY.
@@ -983,7 +696,7 @@ usage: (let* VARLIST BODY...) */)
(Lisp_Object args)
{
Lisp_Object varlist, var, val, elt, lexenv;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
GCPRO3 (args, elt, varlist);
@@ -1046,7 +759,7 @@ usage: (let VARLIST BODY...) */)
{
Lisp_Object *temps, tem, lexenv;
register Lisp_Object elt, varlist;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t argnum;
struct gcpro gcpro1, gcpro2;
USE_SAFE_ALLOCA;
@@ -1162,7 +875,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
if (NILP (tem))
{
def = XSYMBOL (sym)->function;
- if (!EQ (def, Qunbound))
+ if (!NILP (def))
continue;
}
break;
@@ -1173,26 +886,14 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
{
/* SYM is not mentioned in ENVIRONMENT.
Look at its function definition. */
- if (EQ (def, Qunbound) || !CONSP (def))
+ struct gcpro gcpro1;
+ GCPRO1 (form);
+ def = Fautoload_do_load (def, sym, Qmacro);
+ UNGCPRO;
+ if (!CONSP (def))
/* Not defined or definition not suitable. */
break;
- if (EQ (XCAR (def), Qautoload))
- {
- /* Autoloading function: will it be a macro when loaded? */
- tem = Fnth (make_number (4), def);
- if (EQ (tem, Qt) || EQ (tem, Qmacro))
- /* Yes, load it and try again. */
- {
- struct gcpro gcpro1;
- GCPRO1 (form);
- do_autoload (def, sym);
- UNGCPRO;
- continue;
- }
- else
- break;
- }
- else if (!EQ (XCAR (def), Qmacro))
+ if (!EQ (XCAR (def), Qmacro))
break;
else expander = XCDR (def);
}
@@ -1202,7 +903,13 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
if (NILP (expander))
break;
}
- form = apply1 (expander, XCDR (form));
+ {
+ Lisp_Object newform = apply1 (expander, XCDR (form));
+ if (EQ (form, newform))
+ break;
+ else
+ form = newform;
+ }
}
return form;
}
@@ -1252,7 +959,7 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
catchlist = &c;
/* Call FUNC. */
- if (! _setjmp (c.jmp))
+ if (! sys_setjmp (c.jmp))
c.val = (*func) (arg);
/* Throw works by a longjmp that comes right here. */
@@ -1263,7 +970,7 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
/* Unwind the specbind, catch, and handler stacks back to CATCH, and
jump to that CATCH, returning VALUE as the value of that catch.
- This is the guts Fthrow and Fsignal; they differ only in the way
+ This is the guts of Fthrow and Fsignal; they differ only in the way
they choose the catch tag to throw to. A catch tag for a
condition-case form has a TAG of Qnil.
@@ -1272,22 +979,21 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
the handler stack as we go, so that the proper handlers are in
effect for each unwind-protect clause we run. At the end, restore
some static info saved in CATCH, and longjmp to the location
- specified in the
+ specified there.
This is used for correct unwinding in Fthrow and Fsignal. */
-static void
+static _Noreturn void
unwind_to_catch (struct catchtag *catch, Lisp_Object value)
{
- register int last_time;
+ bool last_time;
/* Save the value in the tag. */
catch->val = value;
/* Restore certain special C variables. */
set_poll_suppress_count (catch->poll_suppress_count);
- UNBLOCK_INPUT_TO (catch->interrupt_input_blocked);
- handling_signal = 0;
+ unblock_input_to (catch->interrupt_input_blocked);
immediate_quit = 0;
do
@@ -1302,16 +1008,6 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
}
while (! last_time);
-#if HAVE_X_WINDOWS
- /* If x_catch_errors was done, turn it off now.
- (First we give unbind_to a chance to do that.) */
-#if 0 /* This would disable x_catch_errors after x_connection_closed.
- The catch must remain in effect during that delicate
- state. --lorentey */
- x_fully_uncatch_errors ();
-#endif
-#endif
-
byte_stack_list = catch->byte_stack;
gcprolist = catch->gcpro;
#ifdef DEBUG_GCPRO
@@ -1320,7 +1016,7 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
backtrace_list = catch->backlist;
lisp_eval_depth = catch->lisp_eval_depth;
- _longjmp (catch->jmp, 1);
+ sys_longjmp (catch->jmp, 1);
}
DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
@@ -1349,7 +1045,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
(Lisp_Object args)
{
Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (Fprogn, Fcdr (args));
val = eval_sub (Fcar (args));
@@ -1384,12 +1080,9 @@ See also the function `signal' for more info.
usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
(Lisp_Object args)
{
- register Lisp_Object bodyform, handlers;
- volatile Lisp_Object var;
-
- var = Fcar (args);
- bodyform = Fcar (Fcdr (args));
- handlers = Fcdr (Fcdr (args));
+ Lisp_Object var = Fcar (args);
+ Lisp_Object bodyform = Fcar (Fcdr (args));
+ Lisp_Object handlers = Fcdr (Fcdr (args));
return internal_lisp_condition_case (var, bodyform, handlers);
}
@@ -1429,7 +1122,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
if (!NILP (h.var))
specbind (h.var, c.val);
@@ -1484,7 +1177,7 @@ internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers,
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
return (*hfun) (c.val);
}
@@ -1522,7 +1215,7 @@ internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
return (*hfun) (c.val);
}
@@ -1564,7 +1257,7 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
return (*hfun) (c.val);
}
@@ -1590,7 +1283,9 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
ptrdiff_t nargs,
Lisp_Object *args,
Lisp_Object handlers,
- Lisp_Object (*hfun) (Lisp_Object))
+ Lisp_Object (*hfun) (Lisp_Object err,
+ ptrdiff_t nargs,
+ Lisp_Object *args))
{
Lisp_Object val;
struct catchtag c;
@@ -1606,9 +1301,9 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
- return (*hfun) (c.val);
+ return (*hfun) (c.val, nargs, args);
}
c.next = catchlist;
catchlist = &c;
@@ -1626,8 +1321,8 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
-static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
- Lisp_Object data);
+static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
+ Lisp_Object data);
void
process_quit_flag (void)
@@ -1668,10 +1363,10 @@ See also the function `condition-case'. */)
struct handler *h;
struct backtrace *bp;
- immediate_quit = handling_signal = 0;
+ immediate_quit = 0;
abort_on_gc = 0;
if (gc_in_progress || waiting_for_input)
- abort ();
+ emacs_abort ();
#if 0 /* rms: I don't know why this was here,
but it is surely wrong for an error that is handled. */
@@ -1705,10 +1400,10 @@ See also the function `condition-case'. */)
if (backtrace_list && !NILP (error_symbol))
{
bp = backtrace_list->next;
- if (bp && bp->function && EQ (*bp->function, Qerror))
+ if (bp && EQ (bp->function, Qerror))
bp = bp->next;
- if (bp && bp->function)
- Vsignaling_function = *bp->function;
+ if (bp)
+ Vsignaling_function = bp->function;
}
for (h = handlerlist; h; h = h->next)
@@ -1719,7 +1414,7 @@ See also the function `condition-case'. */)
}
if (/* Don't run the debugger for a memory-full error.
- (There is no room in memory to do that!) */
+ (There is no room in memory to do that!) */
!NILP (error_symbol)
&& (!NILP (Vdebug_on_signal)
/* If no handler is present now, try to run the debugger. */
@@ -1732,7 +1427,7 @@ See also the function `condition-case'. */)
if requested". */
|| EQ (h->handler, Qerror)))
{
- int debugger_called
+ bool debugger_called
= maybe_call_debugger (conditions, error_symbol, data);
/* We can't return values to code which signaled an error, but we
can continue code which has signaled a quit. */
@@ -1768,7 +1463,7 @@ void
xsignal (Lisp_Object error_symbol, Lisp_Object data)
{
Fsignal (error_symbol, data);
- abort ();
+ emacs_abort ();
}
/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
@@ -1826,10 +1521,10 @@ signal_error (const char *s, Lisp_Object arg)
}
-/* Return nonzero if LIST is a non-nil atom or
+/* Return true if LIST is a non-nil atom or
a list containing one of CONDITIONS. */
-static int
+static bool
wants_debugger (Lisp_Object list, Lisp_Object conditions)
{
if (NILP (list))
@@ -1849,15 +1544,15 @@ wants_debugger (Lisp_Object list, Lisp_Object conditions)
return 0;
}
-/* Return 1 if an error with condition-symbols CONDITIONS,
+/* Return true if an error with condition-symbols CONDITIONS,
and described by SIGNAL-DATA, should skip the debugger
according to debugger-ignored-errors. */
-static int
+static bool
skip_debugger (Lisp_Object conditions, Lisp_Object data)
{
Lisp_Object tail;
- int first_string = 1;
+ bool first_string = 1;
Lisp_Object error_message;
error_message = Qnil;
@@ -1892,7 +1587,7 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
= SIG is the error symbol, and DATA is the rest of the data.
= SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
This is for memory-full errors only. */
-static int
+static bool
maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
{
Lisp_Object combined_data;
@@ -1902,7 +1597,8 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
if (
/* Don't try to run the debugger with interrupts blocked.
The editing loop would return anyway. */
- ! INPUT_BLOCKED_P
+ ! input_blocked_p ()
+ && NILP (Vinhibit_debugger)
/* Does user want to enter debugger for this kind of error? */
&& (EQ (sig, Qquit)
? debug_on_quit
@@ -2019,12 +1715,12 @@ then strings and vectors are not accepted. */)
fun = function;
- fun = indirect_function (fun); /* Check cycles. */
- if (NILP (fun) || EQ (fun, Qunbound))
+ fun = indirect_function (fun); /* Check cycles. */
+ if (NILP (fun))
return Qnil;
/* Check an `interactive-form' property if present, analogous to the
- function-documentation property. */
+ function-documentation property. */
fun = function;
while (SYMBOLP (fun))
{
@@ -2084,25 +1780,19 @@ this does nothing and returns nil. */)
CHECK_STRING (file);
/* If function is defined and not as an autoload, don't override. */
- if (!EQ (XSYMBOL (function)->function, Qunbound)
- && !(CONSP (XSYMBOL (function)->function)
- && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
+ if (!NILP (XSYMBOL (function)->function)
+ && !AUTOLOADP (XSYMBOL (function)->function))
return Qnil;
- if (NILP (Vpurify_flag))
- /* Only add entries after dumping, because the ones before are
- not useful and else we get loads of them from the loaddefs.el. */
- LOADHIST_ATTACH (Fcons (Qautoload, function));
- else
- /* We don't want the docstring in purespace (instead,
- Snarf-documentation should (hopefully) overwrite it).
- We used to use 0 here, but that leads to accidental sharing in
- purecopy's hash-consing, so we use a (hopefully) unique integer
- instead. */
- docstring = make_number (XPNTR (function));
- return Ffset (function,
- Fpurecopy (list5 (Qautoload, file, docstring,
- interactive, type)));
+ if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0)))
+ /* `read1' in lread.c has found the docstring starting with "\
+ and assumed the docstring will be provided by Snarf-documentation, so it
+ passed us 0 instead. But that leads to accidental sharing in purecopy's
+ hash-consing, so we use a (hopefully) unique integer instead. */
+ docstring = make_number (XHASH (function));
+ return Fdefalias (function,
+ list5 (Qautoload, file, docstring, interactive, type),
+ Qnil);
}
Lisp_Object
@@ -2132,22 +1822,35 @@ un_autoload (Lisp_Object oldqueue)
FUNNAME is the symbol which is the function's name.
FUNDEF is the autoload definition (a list). */
-void
-do_autoload (Lisp_Object fundef, Lisp_Object funname)
+DEFUN ("autoload-do-load", Fautoload_do_load, Sautoload_do_load, 1, 3, 0,
+ doc: /* Load FUNDEF which should be an autoload.
+If non-nil, FUNNAME should be the symbol whose function value is FUNDEF,
+in which case the function returns the new autoloaded function value.
+If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
+it is defines a macro. */)
+ (Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only)
{
- int count = SPECPDL_INDEX ();
- Lisp_Object fun;
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
+ if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef)))
+ return fundef;
+
+ if (EQ (macro_only, Qmacro))
+ {
+ Lisp_Object kind = Fnth (make_number (4), fundef);
+ if (! (EQ (kind, Qt) || EQ (kind, Qmacro)))
+ return fundef;
+ }
+
/* This is to make sure that loadup.el gives a clear picture
of what files are preloaded and when. */
if (! NILP (Vpurify_flag))
error ("Attempt to autoload %s while preparing to dump",
SDATA (SYMBOL_NAME (funname)));
- fun = funname;
CHECK_SYMBOL (funname);
- GCPRO3 (fun, funname, fundef);
+ GCPRO3 (funname, fundef, macro_only);
/* Preserve the match data. */
record_unwind_save_match_data ();
@@ -2162,18 +1865,28 @@ do_autoload (Lisp_Object fundef, Lisp_Object funname)
The value saved here is to be restored into Vautoload_queue. */
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
- Fload (Fcar (Fcdr (fundef)), Qnil, Qt, Qnil, Qt);
+ /* If `macro_only', assume this autoload to be a "best-effort",
+ so don't signal an error if autoloading fails. */
+ Fload (Fcar (Fcdr (fundef)), macro_only, Qt, Qnil, Qt);
/* Once loading finishes, don't undo it. */
Vautoload_queue = Qt;
unbind_to (count, Qnil);
- fun = Findirect_function (fun, Qnil);
-
- if (!NILP (Fequal (fun, fundef)))
- error ("Autoloading failed to define function %s",
- SDATA (SYMBOL_NAME (funname)));
UNGCPRO;
+
+ if (NILP (funname))
+ return Qnil;
+ else
+ {
+ Lisp_Object fun = Findirect_function (funname, Qnil);
+
+ if (!NILP (Fequal (fun, fundef)))
+ error ("Autoloading failed to define function %s",
+ SDATA (SYMBOL_NAME (funname)));
+ else
+ return fun;
+ }
}
@@ -2182,7 +1895,7 @@ DEFUN ("eval", Feval, Seval, 1, 2, 0,
If LEXICAL is t, evaluate using lexical scoping. */)
(Lisp_Object form, Lisp_Object lexical)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinternal_interpreter_environment,
NILP (lexical) ? Qnil : Fcons (Qt, Qnil));
return unbind_to (count, eval_sub (form));
@@ -2198,9 +1911,6 @@ eval_sub (Lisp_Object form)
struct backtrace backtrace;
struct gcpro gcpro1, gcpro2, gcpro3;
- if (handling_signal)
- abort ();
-
if (SYMBOLP (form))
{
/* Look up its binding in the lexical environment.
@@ -2220,15 +1930,7 @@ eval_sub (Lisp_Object form)
return form;
QUIT;
- if ((consing_since_gc > gc_cons_threshold
- && consing_since_gc > gc_relative_threshold)
- ||
- (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
- {
- GCPRO1 (form);
- Fgarbage_collect ();
- UNGCPRO;
- }
+ maybe_gc ();
if (++lisp_eval_depth > max_lisp_eval_depth)
{
@@ -2238,15 +1940,15 @@ eval_sub (Lisp_Object form)
error ("Lisp nesting exceeds `max-lisp-eval-depth'");
}
- original_fun = Fcar (form);
- original_args = Fcdr (form);
+ original_fun = XCAR (form);
+ original_args = XCDR (form);
backtrace.next = backtrace_list;
- backtrace_list = &backtrace;
- backtrace.function = &original_fun; /* This also protects them from gc. */
+ backtrace.function = original_fun; /* This also protects them from gc. */
backtrace.args = &original_args;
backtrace.nargs = UNEVALLED;
backtrace.debug_on_exit = 0;
+ backtrace_list = &backtrace;
if (debug_on_next_call)
do_debug_on_call (Qt);
@@ -2257,7 +1959,7 @@ eval_sub (Lisp_Object form)
/* Optimize for no indirection. */
fun = original_fun;
- if (SYMBOLP (fun) && !EQ (fun, Qunbound)
+ if (SYMBOLP (fun) && !NILP (fun)
&& (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
fun = indirect_function (fun);
@@ -2271,7 +1973,7 @@ eval_sub (Lisp_Object form)
args_left = original_args;
numargs = Flength (args_left);
- CHECK_CONS_LIST ();
+ check_cons_list ();
if (XINT (numargs) < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0
@@ -2371,7 +2073,7 @@ eval_sub (Lisp_Object form)
is supported by this code. We need to either rewrite the
subr to use a different argument protocol, or add more
cases to this switch. */
- abort ();
+ emacs_abort ();
}
}
}
@@ -2379,7 +2081,7 @@ eval_sub (Lisp_Object form)
val = apply_lambda (fun, original_args);
else
{
- if (EQ (fun, Qunbound))
+ if (NILP (fun))
xsignal1 (Qvoid_function, original_fun);
if (!CONSP (fun))
xsignal1 (Qinvalid_function, original_fun);
@@ -2388,18 +2090,29 @@ eval_sub (Lisp_Object form)
xsignal1 (Qinvalid_function, original_fun);
if (EQ (funcar, Qautoload))
{
- do_autoload (fun, original_fun);
+ Fautoload_do_load (fun, original_fun, Qnil);
goto retry;
}
if (EQ (funcar, Qmacro))
- val = eval_sub (apply1 (Fcdr (fun), original_args));
+ {
+ ptrdiff_t count = SPECPDL_INDEX ();
+ Lisp_Object exp;
+ /* Bind lexical-binding during expansion of the macro, so the
+ macro can know reliably if the code it outputs will be
+ interpreted using lexical-binding or not. */
+ specbind (Qlexical_binding,
+ NILP (Vinternal_interpreter_environment) ? Qnil : Qt);
+ exp = apply1 (Fcdr (fun), original_args);
+ unbind_to (count, Qnil);
+ val = eval_sub (exp);
+ }
else if (EQ (funcar, Qlambda)
|| EQ (funcar, Qclosure))
val = apply_lambda (fun, original_args);
else
xsignal1 (Qinvalid_function, original_fun);
}
- CHECK_CONS_LIST ();
+ check_cons_list ();
lisp_eval_depth--;
if (backtrace.debug_on_exit)
@@ -2409,14 +2122,15 @@ eval_sub (Lisp_Object form)
return val;
}
-DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
+DEFUN ("apply", Fapply, Sapply, 1, MANY, 0,
doc: /* Call FUNCTION with our remaining args, using our last arg as list of args.
Then return the value FUNCTION returns.
Thus, (apply '+ 1 2 '(3 4)) returns 10.
usage: (apply FUNCTION &rest ARGUMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- ptrdiff_t i, numargs;
+ ptrdiff_t i;
+ EMACS_INT numargs;
register Lisp_Object spread_arg;
register Lisp_Object *funcall_args;
Lisp_Object fun, retval;
@@ -2441,10 +2155,10 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
numargs += nargs - 2;
/* Optimize for no indirection. */
- if (SYMBOLP (fun) && !EQ (fun, Qunbound)
+ if (SYMBOLP (fun) && !NILP (fun)
&& (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
fun = indirect_function (fun);
- if (EQ (fun, Qunbound))
+ if (NILP (fun))
{
/* Let funcall get the error. */
fun = args[0];
@@ -2477,7 +2191,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
gcpro1.nvars = 1 + numargs;
}
- memcpy (funcall_args, args, nargs * sizeof (Lisp_Object));
+ memcpy (funcall_args, args, nargs * word_size);
/* Spread the last arg we got. Its first element goes in
the slot that it used to occupy, hence this value of I. */
i = nargs - 1;
@@ -2536,14 +2250,10 @@ usage: (run-hooks &rest HOOKS) */)
DEFUN ("run-hook-with-args", Frun_hook_with_args,
Srun_hook_with_args, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable. If HOOK has a non-nil
-value, that value may be a function or a list of functions to be
-called to run the hook. If the value is a function, it is called with
-the given arguments and its return value is returned. If it is a list
-of functions, those functions are called, in order,
-with the given arguments ARGS.
-It is best not to depend on the value returned by `run-hook-with-args',
-as that may change.
+HOOK should be a symbol, a hook variable. The value of HOOK
+may be nil, a function, or a list of functions. Call each
+function in order with arguments ARGS. The final return value
+is unspecified.
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2553,17 +2263,18 @@ usage: (run-hook-with-args HOOK &rest ARGS) */)
return run_hook_with_args (nargs, args, funcall_nil);
}
+/* NB this one still documents a specific non-nil return value.
+ (As did run-hook-with-args and run-hook-with-args-until-failure
+ until they were changed in 24.1.) */
DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
Srun_hook_with_args_until_success, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable. If HOOK has a non-nil
-value, that value may be a function or a list of functions to be
-called to run the hook. If the value is a function, it is called with
-the given arguments and its return value is returned.
-If it is a list of functions, those functions are called, in order,
-with the given arguments ARGS, until one of them
-returns a non-nil value. Then we return that value.
-However, if they all return nil, we return nil.
+HOOK should be a symbol, a hook variable. The value of HOOK
+may be nil, a function, or a list of functions. Call each
+function in order with arguments ARGS, stopping at the first
+one that returns non-nil, and return that value. Otherwise (if
+all functions return nil, or if there are no functions to call),
+return nil.
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2582,13 +2293,12 @@ funcall_not (ptrdiff_t nargs, Lisp_Object *args)
DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
Srun_hook_with_args_until_failure, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable. If HOOK has a non-nil
-value, that value may be a function or a list of functions to be
-called to run the hook. If the value is a function, it is called with
-the given arguments and its return value is returned.
-If it is a list of functions, those functions are called, in order,
-with the given arguments ARGS, until one of them returns nil.
-Then we return nil. However, if they all return non-nil, we return non-nil.
+HOOK should be a symbol, a hook variable. The value of HOOK
+may be nil, a function, or a list of functions. Call each
+function in order with arguments ARGS, stopping at the first
+one that returns nil, and return nil. Otherwise (if all functions
+return non-nil, or if there are no functions to call), return non-nil
+\(do not rely on the precise return value in this case).
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2870,33 +2580,9 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
doc: /* Non-nil if OBJECT is a function. */)
(Lisp_Object object)
{
- if (SYMBOLP (object) && !NILP (Ffboundp (object)))
- {
- object = Findirect_function (object, Qt);
-
- if (CONSP (object) && EQ (XCAR (object), Qautoload))
- {
- /* Autoloaded symbols are functions, except if they load
- macros or keymaps. */
- int i;
- for (i = 0; i < 4 && CONSP (object); i++)
- object = XCDR (object);
-
- return (CONSP (object) && !NILP (XCAR (object))) ? Qnil : Qt;
- }
- }
-
- if (SUBRP (object))
- return (XSUBR (object)->max_args != UNEVALLED) ? Qt : Qnil;
- else if (COMPILEDP (object))
+ if (FUNCTIONP (object))
return Qt;
- else if (CONSP (object))
- {
- Lisp_Object car = XCAR (object);
- return (EQ (car, Qlambda) || EQ (car, Qclosure)) ? Qt : Qnil;
- }
- else
- return Qnil;
+ return Qnil;
}
DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
@@ -2916,11 +2602,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
ptrdiff_t i;
QUIT;
- if ((consing_since_gc > gc_cons_threshold
- && consing_since_gc > gc_relative_threshold)
- ||
- (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
- Fgarbage_collect ();
if (++lisp_eval_depth > max_lisp_eval_depth)
{
@@ -2931,16 +2612,19 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
}
backtrace.next = backtrace_list;
- backtrace_list = &backtrace;
- backtrace.function = &args[0];
- backtrace.args = &args[1];
+ backtrace.function = args[0];
+ backtrace.args = &args[1]; /* This also GCPROs them. */
backtrace.nargs = nargs - 1;
backtrace.debug_on_exit = 0;
+ backtrace_list = &backtrace;
+
+ /* Call GC after setting up the backtrace, so the latter GCPROs the args. */
+ maybe_gc ();
if (debug_on_next_call)
do_debug_on_call (Qlambda);
- CHECK_CONS_LIST ();
+ check_cons_list ();
original_fun = args[0];
@@ -2948,7 +2632,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
/* Optimize for no indirection. */
fun = original_fun;
- if (SYMBOLP (fun) && !EQ (fun, Qunbound)
+ if (SYMBOLP (fun) && !NILP (fun)
&& (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
fun = indirect_function (fun);
@@ -2970,8 +2654,9 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
{
if (XSUBR (fun)->max_args > numargs)
{
- internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object));
- memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object));
+ internal_args = alloca (XSUBR (fun)->max_args
+ * sizeof *internal_args);
+ memcpy (internal_args, args + 1, numargs * word_size);
for (i = numargs; i < XSUBR (fun)->max_args; i++)
internal_args[i] = Qnil;
}
@@ -3027,7 +2712,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
/* If a subr takes more than 8 arguments without using MANY
or UNEVALLED, we need to extend this function to support it.
Until this is done, there is no way to call the function. */
- abort ();
+ emacs_abort ();
}
}
}
@@ -3035,7 +2720,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
val = funcall_lambda (fun, numargs, args + 1);
else
{
- if (EQ (fun, Qunbound))
+ if (NILP (fun))
xsignal1 (Qvoid_function, original_fun);
if (!CONSP (fun))
xsignal1 (Qinvalid_function, original_fun);
@@ -3047,14 +2732,14 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
val = funcall_lambda (fun, numargs, args + 1);
else if (EQ (funcar, Qautoload))
{
- do_autoload (fun, original_fun);
- CHECK_CONS_LIST ();
+ Fautoload_do_load (fun, original_fun, Qnil);
+ check_cons_list ();
goto retry;
}
else
xsignal1 (Qinvalid_function, original_fun);
}
- CHECK_CONS_LIST ();
+ check_cons_list ();
lisp_eval_depth--;
if (backtrace.debug_on_exit)
val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
@@ -3066,7 +2751,8 @@ static Lisp_Object
apply_lambda (Lisp_Object fun, Lisp_Object args)
{
Lisp_Object args_left;
- ptrdiff_t i, numargs;
+ ptrdiff_t i;
+ EMACS_INT numargs;
register Lisp_Object *arg_vector;
struct gcpro gcpro1, gcpro2, gcpro3;
register Lisp_Object tem;
@@ -3111,9 +2797,9 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
register Lisp_Object *arg_vector)
{
Lisp_Object val, syms_left, next, lexenv;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t i;
- int optional, rest;
+ bool optional, rest;
if (CONSP (fun))
{
@@ -3157,7 +2843,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
lexenv = Qnil;
}
else
- abort ();
+ emacs_abort ();
i = optional = rest = 0;
for (; CONSP (syms_left); syms_left = XCDR (syms_left))
@@ -3250,12 +2936,8 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
static void
grow_specpdl (void)
{
- register int count = SPECPDL_INDEX ();
- int max_size =
- min (max_specpdl_size,
- min (max (PTRDIFF_MAX, SIZE_MAX) / sizeof (struct specbinding),
- INT_MAX));
- int size;
+ register ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX);
if (max_size <= specpdl_size)
{
if (max_specpdl_size < 400)
@@ -3263,9 +2945,7 @@ grow_specpdl (void)
if (max_size <= specpdl_size)
signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
}
- size = specpdl_size < max_size / 2 ? 2 * specpdl_size : max_size;
- specpdl = xnrealloc (specpdl, size, sizeof *specpdl);
- specpdl_size = size;
+ specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl);
specpdl_ptr = specpdl + count;
}
@@ -3289,8 +2969,6 @@ specbind (Lisp_Object symbol, Lisp_Object value)
{
struct Lisp_Symbol *sym;
- eassert (!handling_signal);
-
CHECK_SYMBOL (symbol);
sym = XSYMBOL (symbol);
if (specpdl_ptr == specpdl + specpdl_size)
@@ -3304,8 +2982,8 @@ specbind (Lisp_Object symbol, Lisp_Object value)
case SYMBOL_PLAINVAL:
/* The most common case is that of a non-constant symbol with a
trivial value. Make that as fast as we can. */
- specpdl_ptr->symbol = symbol;
- specpdl_ptr->old_value = SYMBOL_VAL (sym);
+ set_specpdl_symbol (symbol);
+ set_specpdl_old_value (SYMBOL_VAL (sym));
specpdl_ptr->func = NULL;
++specpdl_ptr;
if (!sym->constant)
@@ -3320,7 +2998,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
{
Lisp_Object ovalue = find_symbol_value (symbol);
specpdl_ptr->func = 0;
- specpdl_ptr->old_value = ovalue;
+ set_specpdl_old_value (ovalue);
eassert (sym->redirect != SYMBOL_LOCALIZED
|| (EQ (SYMBOL_BLV (sym)->where,
@@ -3337,12 +3015,12 @@ specbind (Lisp_Object symbol, Lisp_Object value)
if (!NILP (Flocal_variable_p (symbol, Qnil)))
{
eassert (sym->redirect != SYMBOL_LOCALIZED
- || (BLV_FOUND (SYMBOL_BLV (sym))
+ || (blv_found (SYMBOL_BLV (sym))
&& EQ (cur_buf, SYMBOL_BLV (sym)->where)));
where = cur_buf;
}
else if (sym->redirect == SYMBOL_LOCALIZED
- && BLV_FOUND (SYMBOL_BLV (sym)))
+ && blv_found (SYMBOL_BLV (sym)))
where = SYMBOL_BLV (sym)->where;
else
where = Qnil;
@@ -3354,7 +3032,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
let_shadows_buffer_binding_p which is itself only used
in set_internal for local_if_set. */
eassert (NILP (where) || EQ (where, cur_buf));
- specpdl_ptr->symbol = Fcons (symbol, Fcons (where, cur_buf));
+ set_specpdl_symbol (Fcons (symbol, Fcons (where, cur_buf)));
/* If SYMBOL is a per-buffer variable which doesn't have a
buffer-local value here, make the `let' change the global
@@ -3371,31 +3049,29 @@ specbind (Lisp_Object symbol, Lisp_Object value)
}
}
else
- specpdl_ptr->symbol = symbol;
+ set_specpdl_symbol (symbol);
specpdl_ptr++;
set_internal (symbol, value, Qnil, 1);
break;
}
- default: abort ();
+ default: emacs_abort ();
}
}
void
record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
{
- eassert (!handling_signal);
-
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
specpdl_ptr->func = function;
- specpdl_ptr->symbol = Qnil;
- specpdl_ptr->old_value = arg;
+ set_specpdl_symbol (Qnil);
+ set_specpdl_old_value (arg);
specpdl_ptr++;
}
Lisp_Object
-unbind_to (int count, Lisp_Object value)
+unbind_to (ptrdiff_t count, Lisp_Object value)
{
Lisp_Object quitf = Vquit_flag;
struct gcpro gcpro1, gcpro2;
@@ -3475,7 +3151,7 @@ The debugger is entered when that frame exits, if the flag is non-nil. */)
(Lisp_Object level, Lisp_Object flag)
{
register struct backtrace *backlist = backtrace_list;
- register int i;
+ register EMACS_INT i;
CHECK_NUMBER (level);
@@ -3512,23 +3188,23 @@ Output stream used is value of `standard-output'. */)
write_string (backlist->debug_on_exit ? "* " : " ", 2);
if (backlist->nargs == UNEVALLED)
{
- Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil);
+ Fprin1 (Fcons (backlist->function, *backlist->args), Qnil);
write_string ("\n", -1);
}
else
{
- tem = *backlist->function;
+ tem = backlist->function;
Fprin1 (tem, Qnil); /* This can QUIT. */
write_string ("(", -1);
if (backlist->nargs == MANY)
{ /* FIXME: Can this happen? */
- int i;
- for (tail = *backlist->args, i = 0;
- !NILP (tail);
- tail = Fcdr (tail), i = 1)
+ bool later_arg = 0;
+ for (tail = *backlist->args; !NILP (tail); tail = Fcdr (tail))
{
- if (i) write_string (" ", -1);
+ if (later_arg)
+ write_string (" ", -1);
Fprin1 (Fcar (tail), Qnil);
+ later_arg = 1;
}
}
else
@@ -3575,7 +3251,7 @@ If NFRAMES is more than the number of frames, the value is nil. */)
if (!backlist)
return Qnil;
if (backlist->nargs == UNEVALLED)
- return Fcons (Qnil, Fcons (*backlist->function, *backlist->args));
+ return Fcons (Qnil, Fcons (backlist->function, *backlist->args));
else
{
if (backlist->nargs == MANY) /* FIXME: Can this happen? */
@@ -3583,7 +3259,7 @@ If NFRAMES is more than the number of frames, the value is nil. */)
else
tem = Flist (backlist->nargs, backlist->args);
- return Fcons (Qt, Fcons (*backlist->function, tem));
+ return Fcons (Qt, Fcons (backlist->function, tem));
}
}
@@ -3597,7 +3273,7 @@ mark_backtrace (void)
for (backlist = backtrace_list; backlist; backlist = backlist->next)
{
- mark_object (*backlist->function);
+ mark_object (backlist->function);
if (backlist->nargs == UNEVALLED
|| backlist->nargs == MANY) /* FIXME: Can this happen? */
@@ -3614,7 +3290,7 @@ void
syms_of_eval (void)
{
DEFVAR_INT ("max-specpdl-size", max_specpdl_size,
- doc: /* *Limit on number of Lisp variable bindings and `unwind-protect's.
+ doc: /* Limit on number of Lisp variable bindings and `unwind-protect's.
If Lisp code tries to increase the total number past this amount,
an error is signaled.
You can safely use a value considerably larger than the default value,
@@ -3622,7 +3298,7 @@ if that proves inconveniently small. However, if you increase it too far,
Emacs could run out of memory trying to make the stack bigger. */);
DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth,
- doc: /* *Limit on depth in `eval', `apply' and `funcall' before error.
+ doc: /* Limit on depth in `eval', `apply' and `funcall' before error.
This limit serves to catch infinite recursions for you before they cause
actual stack overflow in C, which would be fatal for Emacs.
@@ -3649,7 +3325,7 @@ before making `inhibit-quit' nil. */);
DEFSYM (Qinhibit_quit, "inhibit-quit");
DEFSYM (Qautoload, "autoload");
- DEFSYM (Qdebug_on_error, "debug-on-error");
+ DEFSYM (Qinhibit_debugger, "inhibit-debugger");
DEFSYM (Qmacro, "macro");
DEFSYM (Qdeclare, "declare");
@@ -3659,14 +3335,19 @@ before making `inhibit-quit' nil. */);
DEFSYM (Qinteractive, "interactive");
DEFSYM (Qcommandp, "commandp");
- DEFSYM (Qdefun, "defun");
DEFSYM (Qand_rest, "&rest");
DEFSYM (Qand_optional, "&optional");
DEFSYM (Qclosure, "closure");
DEFSYM (Qdebug, "debug");
+ DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger,
+ doc: /* Non-nil means never enter the debugger.
+Normally set while the debugger is already active, to avoid recursive
+invocations. */);
+ Vinhibit_debugger = Qnil;
+
DEFVAR_LISP ("debug-on-error", Vdebug_on_error,
- doc: /* *Non-nil means enter debugger if an error is signaled.
+ doc: /* Non-nil means enter debugger if an error is signaled.
Does not apply to errors handled by `condition-case' or those
matched by `debug-ignored-errors'.
If the value is a list, an error only means to enter the debugger
@@ -3674,11 +3355,11 @@ if one of its condition symbols appears in the list.
When you evaluate an expression interactively, this variable
is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
The command `toggle-debug-on-error' toggles this.
-See also the variable `debug-on-quit'. */);
+See also the variable `debug-on-quit' and `inhibit-debugger'. */);
Vdebug_on_error = Qnil;
DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors,
- doc: /* *List of errors for which the debugger should not be called.
+ doc: /* List of errors for which the debugger should not be called.
Each element may be a condition-name or a regexp that matches error messages.
If any element applies to a given error, that error skips the debugger
and just returns to top level.
@@ -3687,7 +3368,7 @@ It does not apply to errors handled by `condition-case'. */);
Vdebug_ignored_errors = Qnil;
DEFVAR_BOOL ("debug-on-quit", debug_on_quit,
- doc: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
+ doc: /* Non-nil means enter debugger if quit is signaled (C-g, for example).
Does not apply if quit is handled by a `condition-case'. */);
debug_on_quit = 0;
@@ -3716,28 +3397,21 @@ The Edebug package uses this to regain control. */);
Vsignal_hook_function = Qnil;
DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal,
- doc: /* *Non-nil means call the debugger regardless of condition handlers.
+ doc: /* Non-nil means call the debugger regardless of condition handlers.
Note that `debug-on-error', `debug-on-quit' and friends
still determine whether to handle the particular condition. */);
Vdebug_on_signal = Qnil;
- DEFVAR_LISP ("macro-declaration-function", Vmacro_declaration_function,
- doc: /* Function to process declarations in a macro definition.
-The function will be called with two args MACRO and DECL.
-MACRO is the name of the macro being defined.
-DECL is a list `(declare ...)' containing the declarations.
-The value the function returns is not used. */);
- Vmacro_declaration_function = Qnil;
-
/* When lexical binding is being used,
- vinternal_interpreter_environment is non-nil, and contains an alist
+ Vinternal_interpreter_environment is non-nil, and contains an alist
of lexically-bound variable, or (t), indicating an empty
environment. The lisp name of this variable would be
`internal-interpreter-environment' if it weren't hidden.
Every element of this list can be either a cons (VAR . VAL)
specifying a lexical binding, or a single symbol VAR indicating
that this variable should use dynamic scoping. */
- DEFSYM (Qinternal_interpreter_environment, "internal-interpreter-environment");
+ DEFSYM (Qinternal_interpreter_environment,
+ "internal-interpreter-environment");
DEFVAR_LISP ("internal-interpreter-environment",
Vinternal_interpreter_environment,
doc: /* If non-nil, the current lexical environment of the lisp interpreter.
@@ -3756,6 +3430,8 @@ alist of active lexical bindings. */);
staticpro (&Vsignaling_function);
Vsignaling_function = Qnil;
+ inhibit_lisp_code = Qnil;
+
defsubr (&Sor);
defsubr (&Sand);
defsubr (&Sif);
@@ -3766,12 +3442,10 @@ alist of active lexical bindings. */);
defsubr (&Ssetq);
defsubr (&Squote);
defsubr (&Sfunction);
- defsubr (&Sdefun);
- defsubr (&Sdefmacro);
defsubr (&Sdefvar);
defsubr (&Sdefvaralias);
defsubr (&Sdefconst);
- defsubr (&Suser_variable_p);
+ defsubr (&Smake_var_non_special);
defsubr (&Slet);
defsubr (&SletX);
defsubr (&Swhile);
@@ -3781,10 +3455,9 @@ alist of active lexical bindings. */);
defsubr (&Sunwind_protect);
defsubr (&Scondition_case);
defsubr (&Ssignal);
- defsubr (&Sinteractive_p);
- defsubr (&Scalled_interactively_p);
defsubr (&Scommandp);
defsubr (&Sautoload);
+ defsubr (&Sautoload_do_load);
defsubr (&Seval);
defsubr (&Sapply);
defsubr (&Sfuncall);
diff --git a/src/fileio.c b/src/fileio.c
index 3306085491e..442c66550d3 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1,6 +1,6 @@
/* File IO for GNU Emacs.
-Copyright (C) 1985-1988, 1993-2011 Free Software Foundation, Inc.
+Copyright (C) 1985-1988, 1993-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -23,14 +23,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
-#include <setjmp.h>
#include <unistd.h>
#ifdef HAVE_PWD_H
#include <pwd.h>
#endif
-#include <ctype.h>
#include <errno.h>
#ifdef HAVE_LIBSELINUX
@@ -38,10 +36,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <selinux/context.h>
#endif
+#include <c-ctype.h>
+
#include "lisp.h"
#include "intervals.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "coding.h"
#include "window.h"
#include "blockinput.h"
@@ -52,6 +52,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define NOMINMAX 1
#include <windows.h>
#include <fcntl.h>
+#include <sys/file.h>
+#include "w32.h"
#endif /* not WINDOWSNT */
#ifdef MSDOS
@@ -67,15 +69,16 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
#endif
#ifdef WINDOWSNT
-#define IS_DRIVE(x) isalpha ((unsigned char) (x))
+#define IS_DRIVE(x) c_isalpha (x)
#endif
/* Need to lower-case the drive letter, or else expanded
filenames will sometimes compare unequal, because
`expand-file-name' doesn't always down-case the drive letter. */
-#define DRIVE_LETTER(x) (tolower ((unsigned char) (x)))
+#define DRIVE_LETTER(x) c_tolower (x)
#endif
#include "systime.h"
+#include <stat-time.h>
#ifdef HPUX
#include <netio.h>
@@ -83,19 +86,18 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "commands.h"
-#ifndef FILE_SYSTEM_CASE
-#define FILE_SYSTEM_CASE(filename) (filename)
-#endif
+/* True during writing of auto-save files. */
+static bool auto_saving;
-/* Nonzero during writing of auto-save files */
-static int auto_saving;
+/* Nonzero umask during creation of auto-save directories. */
+static mode_t auto_saving_dir_umask;
/* Set by auto_save_1 to mode of original file so Fwrite_region will create
- a new file with the same mode as the original */
-static int auto_save_mode_bits;
+ a new file with the same mode as the original. */
+static mode_t auto_save_mode_bits;
-/* Set by auto_save_1 if an error occurred during the last auto-save. */
-static int auto_save_error_occurred;
+/* Set by auto_save_1 if an error occurred during the last auto-save. */
+static bool auto_save_error_occurred;
/* The symbol bound to coding-system-for-read when
insert-file-contents is called for recovering a file. This is not
@@ -108,7 +110,7 @@ static Lisp_Object Qauto_save_coding;
which gives a list of operations it handles.. */
static Lisp_Object Qoperations;
-/* Lisp functions for translating file formats */
+/* Lisp functions for translating file formats. */
static Lisp_Object Qformat_decode, Qformat_annotate_function;
/* Lisp function for setting buffer-file-coding-system and the
@@ -144,11 +146,10 @@ Lisp_Object Qfile_name_history;
static Lisp_Object Qcar_less_than_car;
-static Lisp_Object Fmake_symbolic_link (Lisp_Object, Lisp_Object, Lisp_Object);
-static int a_write (int, Lisp_Object, EMACS_INT, EMACS_INT,
- Lisp_Object *, struct coding_system *);
-static int e_write (int, Lisp_Object, EMACS_INT, EMACS_INT,
- struct coding_system *);
+static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
+ Lisp_Object *, struct coding_system *);
+static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
+ struct coding_system *);
void
@@ -160,8 +161,7 @@ report_file_error (const char *string, Lisp_Object data)
synchronize_system_messages_locale ();
str = strerror (errorno);
- errstring = code_convert_string_norecord (make_unibyte_string (str,
- strlen (str)),
+ errstring = code_convert_string_norecord (build_unibyte_string (str),
Vlocale_coding_system, 0);
while (1)
@@ -257,7 +257,7 @@ use the standard functions without calling themselves recursively. */)
{
/* This function must not munge the match data. */
Lisp_Object chain, inhibited_handlers, result;
- int pos = -1;
+ ptrdiff_t pos = -1;
result = Qnil;
CHECK_STRING (filename);
@@ -275,7 +275,7 @@ use the standard functions without calling themselves recursively. */)
if (CONSP (elt))
{
Lisp_Object string = XCAR (elt);
- EMACS_INT match_pos;
+ ptrdiff_t match_pos;
Lisp_Object handler = XCDR (elt);
Lisp_Object operations = Qnil;
@@ -315,6 +315,7 @@ Given a Unix syntax file name, returns a string ending in slash. */)
register const char *beg;
#else
register char *beg;
+ Lisp_Object tem_fn;
#endif
register const char *p;
Lisp_Object handler;
@@ -325,11 +326,14 @@ Given a Unix syntax file name, returns a string ending in slash. */)
call the corresponding file handler. */
handler = Ffind_file_name_handler (filename, Qfile_name_directory);
if (!NILP (handler))
- return call2 (handler, Qfile_name_directory, filename);
+ {
+ Lisp_Object handled_name = call2 (handler, Qfile_name_directory,
+ filename);
+ return STRINGP (handled_name) ? handled_name : Qnil;
+ }
- filename = FILE_SYSTEM_CASE (filename);
#ifdef DOS_NT
- beg = (char *) alloca (SBYTES (filename) + 1);
+ beg = alloca (SBYTES (filename) + 1);
memcpy (beg, SSDATA (filename), SBYTES (filename) + 1);
#else
beg = SSDATA (filename);
@@ -358,12 +362,12 @@ Given a Unix syntax file name, returns a string ending in slash. */)
if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
{
- strncpy (res, beg, 2);
+ memcpy (res, beg, 2);
beg += 2;
r += 2;
}
- if (getdefdir (toupper ((unsigned char) *beg) - 'A' + 1, r))
+ if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
{
if (!IS_DIRECTORY_SEP (res[strlen (res) - 1]))
strcat (res, "/");
@@ -371,10 +375,13 @@ Given a Unix syntax file name, returns a string ending in slash. */)
p = beg + strlen (beg);
}
}
- dostounix_filename (beg);
-#endif /* DOS_NT */
-
+ tem_fn = ENCODE_FILE (make_specified_string (beg, -1, p - beg,
+ STRING_MULTIBYTE (filename)));
+ dostounix_filename (SSDATA (tem_fn));
+ return DECODE_FILE (tem_fn);
+#else /* DOS_NT */
return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
+#endif /* DOS_NT */
}
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
@@ -394,7 +401,13 @@ or the entire name if it contains no slash. */)
call the corresponding file handler. */
handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
if (!NILP (handler))
- return call2 (handler, Qfile_name_nondirectory, filename);
+ {
+ Lisp_Object handled_name = call2 (handler, Qfile_name_nondirectory,
+ filename);
+ if (STRINGP (handled_name))
+ return handled_name;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
beg = SSDATA (filename);
end = p = beg + SBYTES (filename);
@@ -431,37 +444,42 @@ get a current directory to run processes in. */)
call the corresponding file handler. */
handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
if (!NILP (handler))
- return call2 (handler, Qunhandled_file_name_directory, filename);
+ {
+ Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory,
+ filename);
+ return STRINGP (handled_name) ? handled_name : Qnil;
+ }
return Ffile_name_directory (filename);
}
-
-static char *
-file_name_as_directory (char *out, const char *in)
-{
- ptrdiff_t len = strlen (in);
+/* Convert from file name SRC of length SRCLEN to directory name
+ in DST. On UNIX, just make sure there is a terminating /.
+ Return the length of DST. */
- if (len == 0)
+static ptrdiff_t
+file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen)
+{
+ if (srclen == 0)
{
- out[0] = '.';
- out[1] = '/';
- out[2] = 0;
- return out;
+ dst[0] = '.';
+ dst[1] = '/';
+ dst[2] = '\0';
+ return 2;
}
- strcpy (out, in);
+ strcpy (dst, src);
- /* For Unix syntax, Append a slash if necessary */
- if (!IS_DIRECTORY_SEP (out[len - 1]))
+ if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
{
- out[len] = DIRECTORY_SEP;
- out[len + 1] = '\0';
+ dst[srclen] = DIRECTORY_SEP;
+ dst[srclen + 1] = '\0';
+ srclen++;
}
#ifdef DOS_NT
- dostounix_filename (out);
+ dostounix_filename (dst);
#endif
- return out;
+ return srclen;
}
DEFUN ("file-name-as-directory", Ffile_name_as_directory,
@@ -475,6 +493,7 @@ For a Unix-syntax file name, just appends a slash. */)
(Lisp_Object file)
{
char *buf;
+ ptrdiff_t length;
Lisp_Object handler;
CHECK_STRING (file);
@@ -485,42 +504,43 @@ For a Unix-syntax file name, just appends a slash. */)
call the corresponding file handler. */
handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
if (!NILP (handler))
- return call2 (handler, Qfile_name_as_directory, file);
+ {
+ Lisp_Object handled_name = call2 (handler, Qfile_name_as_directory,
+ file);
+ if (STRINGP (handled_name))
+ return handled_name;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
- buf = (char *) alloca (SBYTES (file) + 10);
- file_name_as_directory (buf, SSDATA (file));
- return make_specified_string (buf, -1, strlen (buf),
- STRING_MULTIBYTE (file));
+ buf = alloca (SBYTES (file) + 10);
+ length = file_name_as_directory (buf, SSDATA (file), SBYTES (file));
+ return make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
}
-/*
- * Convert from directory name to filename.
- * On UNIX, it's simple: just make sure there isn't a terminating /
+/* Convert from directory name SRC of length SRCLEN to
+ file name in DST. On UNIX, just make sure there isn't
+ a terminating /. Return the length of DST. */
- * Value is nonzero if the string output is different from the input.
- */
-
-static int
-directory_file_name (char *src, char *dst)
+static ptrdiff_t
+directory_file_name (char *dst, char *src, ptrdiff_t srclen)
{
- ptrdiff_t slen;
-
- slen = strlen (src);
-
/* Process as Unix format: just remove any final slash.
But leave "/" unchanged; do not change it to "". */
strcpy (dst, src);
- if (slen > 1
- && IS_DIRECTORY_SEP (dst[slen - 1])
+ if (srclen > 1
+ && IS_DIRECTORY_SEP (dst[srclen - 1])
#ifdef DOS_NT
- && !IS_ANY_SEP (dst[slen - 2])
+ && !IS_ANY_SEP (dst[srclen - 2])
#endif
)
- dst[slen - 1] = 0;
+ {
+ dst[srclen - 1] = 0;
+ srclen--;
+ }
#ifdef DOS_NT
dostounix_filename (dst);
#endif
- return 1;
+ return srclen;
}
DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
@@ -533,6 +553,7 @@ In Unix-syntax, this function just removes the final slash. */)
(Lisp_Object directory)
{
char *buf;
+ ptrdiff_t length;
Lisp_Object handler;
CHECK_STRING (directory);
@@ -544,12 +565,17 @@ In Unix-syntax, this function just removes the final slash. */)
call the corresponding file handler. */
handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
if (!NILP (handler))
- return call2 (handler, Qdirectory_file_name, directory);
+ {
+ Lisp_Object handled_name = call2 (handler, Qdirectory_file_name,
+ directory);
+ if (STRINGP (handled_name))
+ return handled_name;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
- buf = (char *) alloca (SBYTES (directory) + 20);
- directory_file_name (SSDATA (directory), buf);
- return make_specified_string (buf, -1, strlen (buf),
- STRING_MULTIBYTE (directory));
+ buf = alloca (SBYTES (directory) + 20);
+ length = directory_file_name (buf, SSDATA (directory), SBYTES (directory));
+ return make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
}
static const char make_temp_name_tbl[64] =
@@ -574,7 +600,7 @@ static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
which has no existing file. To make this work, PREFIX should be
an absolute file name.
- BASE64_P non-zero means add the pid as 3 characters in base64
+ BASE64_P means add the pid as 3 characters in base64
encoding. In this case, 6 characters will be added to PREFIX to
form the file name. Otherwise, if Emacs is running on a system
with long file names, add the pid as a decimal number.
@@ -583,7 +609,7 @@ static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
generated. */
Lisp_Object
-make_temp_name (Lisp_Object prefix, int base64_p)
+make_temp_name (Lisp_Object prefix, bool base64_p)
{
Lisp_Object val;
int len, clen;
@@ -648,7 +674,6 @@ make_temp_name (Lisp_Object prefix, int base64_p)
while (1)
{
- struct stat ignored;
unsigned num = make_temp_name_count;
p[0] = make_temp_name_tbl[num & 63], num >>= 6;
@@ -660,7 +685,7 @@ make_temp_name (Lisp_Object prefix, int base64_p)
make_temp_name_count += 25229;
make_temp_name_count %= 225307;
- if (stat (data, &ignored) < 0)
+ if (!check_existing (data))
{
/* We want to return only if errno is ENOENT. */
if (errno == ENOENT)
@@ -740,12 +765,12 @@ filesystem tree, not (expand-file-name ".." dirname). */)
struct passwd *pw;
#ifdef DOS_NT
int drive = 0;
- int collapse_newdir = 1;
- int is_escaped = 0;
+ bool collapse_newdir = 1;
+ bool is_escaped = 0;
#endif /* DOS_NT */
ptrdiff_t length;
- Lisp_Object handler, result;
- int multibyte;
+ Lisp_Object handler, result, handled_name;
+ bool multibyte;
Lisp_Object hdir;
CHECK_STRING (name);
@@ -754,7 +779,14 @@ filesystem tree, not (expand-file-name ".." dirname). */)
call the corresponding file handler. */
handler = Ffind_file_name_handler (name, Qexpand_file_name);
if (!NILP (handler))
- return call3 (handler, Qexpand_file_name, name, default_directory);
+ {
+ handled_name = call3 (handler, Qexpand_file_name,
+ name, default_directory);
+ if (STRINGP (handled_name))
+ return handled_name;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
+
/* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
if (NILP (default_directory))
@@ -780,7 +812,13 @@ filesystem tree, not (expand-file-name ".." dirname). */)
{
handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
if (!NILP (handler))
- return call3 (handler, Qexpand_file_name, name, default_directory);
+ {
+ handled_name = call3 (handler, Qexpand_file_name,
+ name, default_directory);
+ if (STRINGP (handled_name))
+ return handled_name;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
}
{
@@ -822,7 +860,6 @@ filesystem tree, not (expand-file-name ".." dirname). */)
UNGCPRO;
}
}
- name = FILE_SYSTEM_CASE (name);
multibyte = STRING_MULTIBYTE (name);
if (multibyte != STRING_MULTIBYTE (default_directory))
{
@@ -835,8 +872,8 @@ filesystem tree, not (expand-file-name ".." dirname). */)
}
}
- /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
- nm = (char *) alloca (SBYTES (name) + 1);
+ /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
+ nm = alloca (SBYTES (name) + 1);
memcpy (nm, SSDATA (name), SBYTES (name) + 1);
#ifdef DOS_NT
@@ -863,7 +900,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
nm++;
- /* Discard any previous drive specifier if nm is now in UNC format. */
+ /* Discard any previous drive specifier if nm is now in UNC format. */
if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
{
drive = 0;
@@ -887,10 +924,9 @@ filesystem tree, not (expand-file-name ".." dirname). */)
/* If it turns out that the filename we want to return is just a
suffix of FILENAME, we don't need to go through and edit
things; we just need to construct a new string using data
- starting at the middle of FILENAME. If we set lose to a
- non-zero value, that means we've discovered that we can't do
- that cool trick. */
- int lose = 0;
+ starting at the middle of FILENAME. If we set LOSE, that
+ means we've discovered that we can't do that cool trick. */
+ bool lose = 0;
char *p = nm;
while (*p)
@@ -919,7 +955,18 @@ filesystem tree, not (expand-file-name ".." dirname). */)
#ifdef DOS_NT
/* Make sure directories are all separated with /, but
avoid allocation of a new string when not required. */
- dostounix_filename (nm);
+ if (multibyte)
+ {
+ Lisp_Object tem_name = make_specified_string (nm, -1, strlen (nm),
+ multibyte);
+
+ tem_name = ENCODE_FILE (tem_name);
+ dostounix_filename (SSDATA (tem_name));
+ tem_name = DECODE_FILE (tem_name);
+ memcpy (nm, SSDATA (tem_name), SBYTES (tem_name) + 1);
+ }
+ else
+ dostounix_filename (nm);
#ifdef WINDOWSNT
if (IS_DIRECTORY_SEP (nm[1]))
{
@@ -928,7 +975,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
}
else
#endif
- /* drive must be set, so this is okay */
+ /* Drive must be set, so this is okay. */
if (strcmp (nm - 2, SSDATA (name)) != 0)
{
char temp[] = " :";
@@ -974,7 +1021,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
if (!(newdir = egetenv ("HOME")))
newdir = "";
nm++;
- /* egetenv may return a unibyte string, which will bite us since
+ /* `egetenv' may return a unibyte string, which will bite us since
we expect the directory to be multibyte. */
tem = build_string (newdir);
if (!STRING_MULTIBYTE (tem))
@@ -994,9 +1041,9 @@ filesystem tree, not (expand-file-name ".." dirname). */)
memcpy (o, nm, p - nm);
o [p - nm] = 0;
- BLOCK_INPUT;
+ block_input ();
pw = (struct passwd *) getpwnam (o + 1);
- UNBLOCK_INPUT;
+ unblock_input ();
if (pw)
{
newdir = pw->pw_dir;
@@ -1016,17 +1063,17 @@ filesystem tree, not (expand-file-name ".." dirname). */)
use the drive's current directory as the prefix if needed. */
if (!newdir && drive)
{
- /* Get default directory if needed to make nm absolute. */
+ /* Get default directory if needed to make nm absolute. */
char *adir = NULL;
if (!IS_DIRECTORY_SEP (nm[0]))
{
adir = alloca (MAXPATHLEN + 1);
- if (!getdefdir (toupper (drive) - 'A' + 1, adir))
+ if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
adir = NULL;
}
if (!adir)
{
- /* Either nm starts with /, or drive isn't mounted. */
+ /* Either nm starts with /, or drive isn't mounted. */
adir = alloca (4);
adir[0] = DRIVE_LETTER (drive);
adir[1] = ':';
@@ -1038,11 +1085,11 @@ filesystem tree, not (expand-file-name ".." dirname). */)
#endif /* DOS_NT */
/* Finally, if no prefix has been specified and nm is not absolute,
- then it must be expanded relative to default_directory. */
+ then it must be expanded relative to default_directory. */
if (1
#ifndef DOS_NT
- /* /... alone is not absolute on DOS and Windows. */
+ /* /... alone is not absolute on DOS and Windows. */
&& !IS_DIRECTORY_SEP (nm[0])
#endif
#ifdef WINDOWSNT
@@ -1064,7 +1111,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
#ifdef DOS_NT
if (newdir)
{
- /* First ensure newdir is an absolute name. */
+ /* First ensure newdir is an absolute name. */
if (
/* Detect MSDOS file names with drive specifiers. */
! (IS_DRIVE (newdir[0])
@@ -1079,7 +1126,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
Because of the admonition against calling expand-file-name
when we have pointers into lisp strings, we accomplish this
indirectly by prepending newdir to nm if necessary, and using
- cwd (or the wd of newdir's drive) as the new newdir. */
+ cwd (or the wd of newdir's drive) as the new newdir. */
char *adir;
if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
{
@@ -1088,23 +1135,24 @@ filesystem tree, not (expand-file-name ".." dirname). */)
}
if (!IS_DIRECTORY_SEP (nm[0]))
{
- char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
- file_name_as_directory (tmp, newdir);
+ ptrdiff_t newlen = strlen (newdir);
+ char *tmp = alloca (newlen + strlen (nm) + 2);
+ file_name_as_directory (tmp, newdir, newlen);
strcat (tmp, nm);
nm = tmp;
}
adir = alloca (MAXPATHLEN + 1);
if (drive)
{
- if (!getdefdir (toupper (drive) - 'A' + 1, adir))
+ if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
newdir = "/";
}
else
- getwd (adir);
+ getcwd (adir, MAXPATHLEN + 1);
newdir = adir;
}
- /* Strip off drive name from prefix, if present. */
+ /* Strip off drive name from prefix, if present. */
if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
{
drive = newdir[0];
@@ -1138,32 +1186,36 @@ filesystem tree, not (expand-file-name ".." dirname). */)
/* Get rid of any slash at the end of newdir, unless newdir is
just / or // (an incomplete UNC name). */
length = strlen (newdir);
+ tlen = length + 1;
if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
#ifdef WINDOWSNT
&& !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
#endif
)
{
- char *temp = (char *) alloca (length);
+ char *temp = alloca (length);
memcpy (temp, newdir, length - 1);
temp[length - 1] = 0;
+ length--;
newdir = temp;
}
- tlen = length + 1;
}
else
- tlen = 0;
+ {
+ length = 0;
+ tlen = 0;
+ }
- /* Now concatenate the directory and name to new space in the stack frame */
+ /* Now concatenate the directory and name to new space in the stack frame. */
tlen += strlen (nm) + 1;
#ifdef DOS_NT
/* Reserve space for drive specifier and escape prefix, since either
or both may need to be inserted. (The Microsoft x86 compiler
produces incorrect code if the following two lines are combined.) */
- target = (char *) alloca (tlen + 4);
+ target = alloca (tlen + 4);
target += 4;
#else /* not DOS_NT */
- target = (char *) alloca (tlen);
+ target = alloca (tlen);
#endif /* not DOS_NT */
*target = 0;
@@ -1183,7 +1235,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
strcpy (target, newdir);
}
else
- file_name_as_directory (target, newdir);
+ file_name_as_directory (target, newdir, length);
}
strcat (target, nm);
@@ -1250,13 +1302,13 @@ filesystem tree, not (expand-file-name ".." dirname). */)
}
#ifdef DOS_NT
- /* At last, set drive name. */
+ /* At last, set drive name. */
#ifdef WINDOWSNT
/* Except for network file name. */
if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
#endif /* WINDOWSNT */
{
- if (!drive) abort ();
+ if (!drive) emacs_abort ();
target -= 2;
target[0] = DRIVE_LETTER (drive);
target[1] = ':';
@@ -1268,20 +1320,29 @@ filesystem tree, not (expand-file-name ".." dirname). */)
target[0] = '/';
target[1] = ':';
}
- dostounix_filename (target);
-#endif /* DOS_NT */
-
result = make_specified_string (target, -1, o - target, multibyte);
+ result = ENCODE_FILE (result);
+ dostounix_filename (SSDATA (result));
+ result = DECODE_FILE (result);
+#else /* !DOS_NT */
+ result = make_specified_string (target, -1, o - target, multibyte);
+#endif /* !DOS_NT */
}
/* Again look to see if the file name has special constructs in it
and perhaps call the corresponding file handler. This is needed
for filenames such as "/foo/../user@host:/bar/../baz". Expanding
the ".." component gives us "/user@host:/bar/../baz" which needs
- to be expanded again. */
+ to be expanded again. */
handler = Ffind_file_name_handler (result, Qexpand_file_name);
if (!NILP (handler))
- return call3 (handler, Qexpand_file_name, result, default_directory);
+ {
+ handled_name = call3 (handler, Qexpand_file_name,
+ result, default_directory);
+ if (STRINGP (handled_name))
+ return handled_name;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
return result;
}
@@ -1316,7 +1377,6 @@ See also the function `substitute-in-file-name'.")
ptrdiff_t tlen;
unsigned char *target;
struct passwd *pw;
- int lose;
CHECK_STRING (name);
nm = SDATA (name);
@@ -1325,12 +1385,11 @@ See also the function `substitute-in-file-name'.")
If no /./ or /../ we can return right away. */
if (nm[0] == '/')
{
+ bool lose = 0;
p = nm;
- lose = 0;
while (*p)
{
- if (p[0] == '/' && p[1] == '/'
- )
+ if (p[0] == '/' && p[1] == '/')
nm = p + 1;
if (p[0] == '/' && p[1] == '~')
nm = p + 1, lose = 1;
@@ -1348,7 +1407,7 @@ See also the function `substitute-in-file-name'.")
}
}
- /* Now determine directory to start with and put it in NEWDIR */
+ /* Now determine directory to start with and put it in NEWDIR. */
newdir = 0;
@@ -1361,20 +1420,20 @@ See also the function `substitute-in-file-name'.")
}
else /* ~user/filename */
{
- /* Get past ~ to user */
+ /* Get past ~ to user. */
unsigned char *user = nm + 1;
- /* Find end of name. */
+ /* Find end of name. */
unsigned char *ptr = (unsigned char *) strchr (user, '/');
ptrdiff_t len = ptr ? ptr - user : strlen (user);
- /* Copy the user name into temp storage. */
- o = (unsigned char *) alloca (len + 1);
+ /* Copy the user name into temp storage. */
+ o = alloca (len + 1);
memcpy (o, user, len);
o[len] = 0;
- /* Look up the user name. */
- BLOCK_INPUT;
+ /* Look up the user name. */
+ block_input ();
pw = (struct passwd *) getpwnam (o + 1);
- UNBLOCK_INPUT;
+ unblock_input ();
if (!pw)
error ("\"%s\" isn't a registered user", o + 1);
@@ -1392,10 +1451,10 @@ See also the function `substitute-in-file-name'.")
newdir = SDATA (defalt);
}
- /* Now concatenate the directory and name to new space in the stack frame */
+ /* Now concatenate the directory and name to new space in the stack frame. */
tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
- target = (unsigned char *) alloca (tlen);
+ target = alloca (tlen);
*target = 0;
if (newdir)
@@ -1408,7 +1467,7 @@ See also the function `substitute-in-file-name'.")
strcat (target, nm);
- /* Now canonicalize by removing /. and /foo/.. if they appear */
+ /* Now canonicalize by removing /. and /foo/.. if they appear. */
p = target;
o = target;
@@ -1450,7 +1509,7 @@ See also the function `substitute-in-file-name'.")
#endif
/* If /~ or // appears, discard everything through first slash. */
-static int
+static bool
file_name_absolute_p (const char *filename)
{
return
@@ -1469,18 +1528,17 @@ search_embedded_absfilename (char *nm, char *endp)
for (p = nm + 1; p < endp; p++)
{
- if ((0
- || IS_DIRECTORY_SEP (p[-1]))
+ if (IS_DIRECTORY_SEP (p[-1])
&& file_name_absolute_p (p)
#if defined (WINDOWSNT) || defined (CYGWIN)
/* // at start of file name is meaningful in Apollo,
WindowsNT and Cygwin systems. */
&& !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
#endif /* not (WINDOWSNT || CYGWIN) */
- )
+ )
{
- for (s = p; *s && (!IS_DIRECTORY_SEP (*s)); s++);
- if (p[0] == '~' && s > p + 1) /* we've got "/~something/" */
+ for (s = p; *s && !IS_DIRECTORY_SEP (*s); s++);
+ if (p[0] == '~' && s > p + 1) /* We've got "/~something/". */
{
char *o = alloca (s - p + 1);
struct passwd *pw;
@@ -1490,9 +1548,9 @@ search_embedded_absfilename (char *nm, char *endp)
/* If we have ~user and `user' exists, discard
everything up to ~. But if `user' does not exist, leave
~user alone, it might be a literal file name. */
- BLOCK_INPUT;
+ block_input ();
pw = getpwnam (o + 1);
- UNBLOCK_INPUT;
+ unblock_input ();
if (pw)
return p;
}
@@ -1516,13 +1574,11 @@ If `//' appears, everything up to and including the first of
those `/' is discarded. */)
(Lisp_Object filename)
{
- char *nm;
-
- register char *s, *p, *o, *x, *endp;
+ char *nm, *s, *p, *o, *x, *endp;
char *target = NULL;
int total = 0;
- int substituted = 0;
- int multibyte;
+ bool substituted = 0;
+ bool multibyte;
char *xnm;
Lisp_Object handler;
@@ -1534,17 +1590,33 @@ those `/' is discarded. */)
call the corresponding file handler. */
handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
if (!NILP (handler))
- return call2 (handler, Qsubstitute_in_file_name, filename);
+ {
+ Lisp_Object handled_name = call2 (handler, Qsubstitute_in_file_name,
+ filename);
+ if (STRINGP (handled_name))
+ return handled_name;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
/* Always work on a copy of the string, in case GC happens during
decode of environment variables, causing the original Lisp_String
data to be relocated. */
- nm = (char *) alloca (SBYTES (filename) + 1);
+ nm = alloca (SBYTES (filename) + 1);
memcpy (nm, SDATA (filename), SBYTES (filename) + 1);
#ifdef DOS_NT
- dostounix_filename (nm);
- substituted = (strcmp (nm, SDATA (filename)) != 0);
+ {
+ Lisp_Object encoded_filename = ENCODE_FILE (filename);
+ Lisp_Object tem_fn;
+
+ dostounix_filename (SDATA (encoded_filename));
+ tem_fn = DECODE_FILE (encoded_filename);
+ nm = alloca (SBYTES (tem_fn) + 1);
+ memcpy (nm, SDATA (tem_fn), SBYTES (tem_fn) + 1);
+ substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0);
+ if (substituted)
+ filename = tem_fn;
+ }
#endif
endp = nm + SBYTES (filename);
@@ -1558,7 +1630,7 @@ those `/' is discarded. */)
(make_specified_string (p, -1, endp - p, multibyte));
/* See if any variables are substituted into the string
- and find the total length of their values in `total' */
+ and find the total length of their values in `total'. */
for (p = nm; p != endp;)
if (*p != '$')
@@ -1570,7 +1642,7 @@ those `/' is discarded. */)
goto badsubst;
else if (*p == '$')
{
- /* "$$" means a single "$" */
+ /* "$$" means a single "$". */
p++;
total -= 1;
substituted = 1;
@@ -1586,19 +1658,19 @@ those `/' is discarded. */)
else
{
o = p;
- while (p != endp && (isalnum (*p) || *p == '_')) p++;
+ while (p != endp && (c_isalnum (*p) || *p == '_')) p++;
s = p;
}
- /* Copy out the variable name */
- target = (char *) alloca (s - o + 1);
- strncpy (target, o, s - o);
+ /* Copy out the variable name. */
+ target = alloca (s - o + 1);
+ memcpy (target, o, s - o);
target[s - o] = 0;
#ifdef DOS_NT
strupr (target); /* $home == $HOME etc. */
#endif /* DOS_NT */
- /* Get variable value */
+ /* Get variable value. */
o = egetenv (target);
if (o)
{
@@ -1608,7 +1680,7 @@ those `/' is discarded. */)
env variables twice should be acceptable. Note that
decoding may cause a garbage collect. */
Lisp_Object orig, decoded;
- orig = make_unibyte_string (o, strlen (o));
+ orig = build_unibyte_string (o);
decoded = DECODE_FILE (orig);
total += SBYTES (decoded);
substituted = 1;
@@ -1620,12 +1692,12 @@ those `/' is discarded. */)
if (!substituted)
return filename;
- /* If substitution required, recopy the string and do it */
- /* Make space in stack frame for the new copy */
- xnm = (char *) alloca (SBYTES (filename) + total + 1);
+ /* If substitution required, recopy the string and do it. */
+ /* Make space in stack frame for the new copy. */
+ xnm = alloca (SBYTES (filename) + total + 1);
x = xnm;
- /* Copy the rest of the name through, replacing $ constructs with values */
+ /* Copy the rest of the name through, replacing $ constructs with values. */
for (p = nm; *p;)
if (*p != '$')
*x++ = *p++;
@@ -1649,19 +1721,19 @@ those `/' is discarded. */)
else
{
o = p;
- while (p != endp && (isalnum (*p) || *p == '_')) p++;
+ while (p != endp && (c_isalnum (*p) || *p == '_')) p++;
s = p;
}
- /* Copy out the variable name */
- target = (char *) alloca (s - o + 1);
- strncpy (target, o, s - o);
+ /* Copy out the variable name. */
+ target = alloca (s - o + 1);
+ memcpy (target, o, s - o);
target[s - o] = 0;
#ifdef DOS_NT
strupr (target); /* $home == $HOME etc. */
#endif /* DOS_NT */
- /* Get variable value */
+ /* Get variable value. */
o = egetenv (target);
if (!o)
{
@@ -1676,13 +1748,13 @@ those `/' is discarded. */)
orig = make_unibyte_string (o, orig_length);
decoded = DECODE_FILE (orig);
decoded_length = SBYTES (decoded);
- strncpy (x, SSDATA (decoded), decoded_length);
+ memcpy (x, SDATA (decoded), decoded_length);
x += decoded_length;
/* If environment variable needed decoding, return value
needs to be multibyte. */
if (decoded_length != orig_length
- || strncmp (SSDATA (decoded), o, orig_length))
+ || memcmp (SDATA (decoded), o, orig_length))
multibyte = 1;
}
}
@@ -1690,7 +1762,7 @@ those `/' is discarded. */)
*x = 0;
/* If /~ or // appears, discard everything through first slash. */
- while ((p = search_embedded_absfilename (xnm, x)))
+ while ((p = search_embedded_absfilename (xnm, x)) != NULL)
/* This time we do not start over because we've already expanded envvars
and replaced $$ with $. Maybe we should start over as well, but we'd
need to quote some $ to $$ first. */
@@ -1723,14 +1795,14 @@ expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
stat behaves differently depending! */
if (SCHARS (absname) > 1
&& IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
- && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2)))
+ && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname) - 2)))
/* We cannot take shortcuts; they might be wrong for magic file names. */
absname = Fdirectory_file_name (absname);
return absname;
}
/* Signal an error if the file ABSNAME already exists.
- If INTERACTIVE is nonzero, ask the user whether to proceed,
+ If INTERACTIVE, ask the user whether to proceed,
and bypass the error if the user says to go ahead.
QUERYSTRING is a name for the action that is being considered
to alter the file.
@@ -1739,19 +1811,20 @@ expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
If the file does not exist, STATPTR->st_mode is set to 0.
If STATPTR is null, we don't store into it.
- If QUICK is nonzero, we ask for y or n, not yes or no. */
+ If QUICK, ask for y or n, not yes or no. */
static void
barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
- int interactive, struct stat *statptr, int quick)
+ bool interactive, struct stat *statptr,
+ bool quick)
{
- register Lisp_Object tem, encoded_filename;
+ Lisp_Object tem, encoded_filename;
struct stat statbuf;
struct gcpro gcpro1;
encoded_filename = ENCODE_FILE (absname);
- /* stat is a good way to tell whether the file exists,
+ /* `stat' is a good way to tell whether the file exists,
regardless of what access permissions it has. */
if (lstat (SSDATA (encoded_filename), &statbuf) >= 0)
{
@@ -1813,17 +1886,17 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
(Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists, Lisp_Object keep_time, Lisp_Object preserve_uid_gid, Lisp_Object preserve_selinux_context)
{
int ifd, ofd;
- EMACS_INT n;
+ int n;
char buf[16 * 1024];
struct stat st, out_st;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int count = SPECPDL_INDEX ();
- int input_file_statable_p;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ bool input_file_statable_p;
Lisp_Object encoded_file, encoded_newname;
#if HAVE_LIBSELINUX
security_context_t con;
- int fail, conlength = 0;
+ int conlength = 0;
#endif
encoded_file = encoded_newname = Qnil;
@@ -1871,13 +1944,13 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
DWORD attributes;
char * filename;
- EMACS_GET_TIME (now);
filename = SDATA (encoded_newname);
/* Ensure file is writable while its modified time is set. */
attributes = GetFileAttributes (filename);
SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY);
- if (set_file_times (filename, now, now))
+ now = current_emacs_time ();
+ if (set_file_times (-1, filename, now, now))
{
/* Restore original attributes. */
SetFileAttributes (filename, attributes);
@@ -1938,7 +2011,7 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
S_IREAD | S_IWRITE);
#else /* not MSDOS */
{
- int new_mask = 0666;
+ mode_t new_mask = 0666;
if (input_file_statable_p)
{
if (!NILP (preserve_uid_gid))
@@ -1968,7 +2041,7 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
owner and group. */
if (input_file_statable_p)
{
- int mode_mask = 07777;
+ mode_t mode_mask = 07777;
if (!NILP (preserve_uid_gid))
{
/* Attempt to change owner and group. If that doesn't work
@@ -1990,33 +2063,31 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
#if HAVE_LIBSELINUX
if (conlength > 0)
{
- /* Set the modified context back to the file. */
- fail = fsetfilecon (ofd, con);
- if (fail)
+ /* Set the modified context back to the file. */
+ bool fail = fsetfilecon (ofd, con) != 0;
+ /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
+ if (fail && errno != ENOTSUP)
report_file_error ("Doing fsetfilecon", Fcons (newname, Qnil));
freecon (con);
}
#endif
- /* Closing the output clobbers the file times on some systems. */
- if (emacs_close (ofd) < 0)
- report_file_error ("I/O error", Fcons (newname, Qnil));
-
if (input_file_statable_p)
{
if (!NILP (keep_time))
{
- EMACS_TIME atime, mtime;
- EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
- EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
- if (set_file_times (SSDATA (encoded_newname),
- atime, mtime))
+ EMACS_TIME atime = get_stat_atime (&st);
+ EMACS_TIME mtime = get_stat_mtime (&st);
+ if (set_file_times (ofd, SSDATA (encoded_newname), atime, mtime))
xsignal2 (Qfile_date_error,
build_string ("Cannot set file date"), newname);
}
}
+ if (emacs_close (ofd) < 0)
+ report_file_error ("I/O error", Fcons (newname, Qnil));
+
emacs_close (ifd);
#ifdef MSDOS
@@ -2062,7 +2133,7 @@ DEFUN ("make-directory-internal", Fmake_directory_internal,
#ifdef WINDOWSNT
if (mkdir (dir) != 0)
#else
- if (mkdir (dir, 0777) != 0)
+ if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
#endif
report_file_error ("Creating directory", list1 (directory));
@@ -2125,7 +2196,7 @@ With a prefix argument, TRASH is nil. */)
encoded_file = ENCODE_FILE (filename);
- if (0 > unlink (SSDATA (encoded_file)))
+ if (unlink (SSDATA (encoded_file)) < 0)
report_file_error ("Removing old name", list1 (filename));
return Qnil;
}
@@ -2136,17 +2207,14 @@ internal_delete_file_1 (Lisp_Object ignore)
return Qt;
}
-/* Delete file FILENAME, returning 1 if successful and 0 if failed.
+/* Delete file FILENAME.
This ignores `delete-by-moving-to-trash'. */
-int
+void
internal_delete_file (Lisp_Object filename)
{
- Lisp_Object tem;
-
- tem = internal_condition_case_2 (Fdelete_file, filename, Qnil,
- Qt, internal_delete_file_1);
- return NILP (tem);
+ internal_condition_case_2 (Fdelete_file, filename, Qnil,
+ Qt, internal_delete_file_1);
}
DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
@@ -2177,8 +2245,8 @@ This is what happens in interactive use with M-x. */)
#endif
)
{
- Lisp_Object fname = NILP (Ffile_directory_p (file))
- ? file : Fdirectory_file_name (file);
+ Lisp_Object fname = (NILP (Ffile_directory_p (file))
+ ? file : Fdirectory_file_name (file));
newname = Fexpand_file_name (Ffile_name_nondirectory (fname), newname);
}
else
@@ -2206,11 +2274,11 @@ This is what happens in interactive use with M-x. */)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "rename to it",
INTEGERP (ok_if_already_exists), 0, 0);
- if (0 > rename (SSDATA (encoded_file), SSDATA (encoded_newname)))
+ if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
{
if (errno == EXDEV)
{
- int count;
+ ptrdiff_t count;
symlink_target = Ffile_symlink_p (file);
if (! NILP (symlink_target))
Fmake_symbolic_link (symlink_target, newname,
@@ -2287,7 +2355,7 @@ This is what happens in interactive use with M-x. */)
INTEGERP (ok_if_already_exists), 0, 0);
unlink (SSDATA (newname));
- if (0 > link (SSDATA (encoded_file), SSDATA (encoded_newname)))
+ if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
report_file_error ("Adding new name", list2 (file, newname));
UNGCPRO;
@@ -2344,15 +2412,14 @@ This happens for interactive use with M-x. */)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (linkname, "make it a link",
INTEGERP (ok_if_already_exists), 0, 0);
- if (0 > symlink (SSDATA (encoded_filename),
- SSDATA (encoded_linkname)))
+ if (symlink (SSDATA (encoded_filename), SSDATA (encoded_linkname)) < 0)
{
/* If we didn't complain already, silently delete existing file. */
if (errno == EEXIST)
{
unlink (SSDATA (encoded_linkname));
- if (0 <= symlink (SSDATA (encoded_filename),
- SSDATA (encoded_linkname)))
+ if (symlink (SSDATA (encoded_filename), SSDATA (encoded_linkname))
+ >= 0)
{
UNGCPRO;
return Qnil;
@@ -2382,61 +2449,52 @@ On Unix, this is a name starting with a `/' or a `~'. */)
return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil;
}
-/* Return nonzero if file FILENAME exists and can be executed. */
+/* Return true if FILENAME exists. */
+bool
+check_existing (const char *filename)
+{
+ return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0;
+}
-static int
+/* Return true if file FILENAME exists and can be executed. */
+
+static bool
check_executable (char *filename)
{
-#ifdef DOS_NT
- struct stat st;
- if (stat (filename, &st) < 0)
- return 0;
- return ((st.st_mode & S_IEXEC) != 0);
-#else /* not DOS_NT */
-#ifdef HAVE_EUIDACCESS
- return (euidaccess (filename, 1) >= 0);
-#else
- /* Access isn't quite right because it uses the real uid
- and we really want to test with the effective uid.
- But Unix doesn't give us a right way to do it. */
- return (access (filename, 1) >= 0);
-#endif
-#endif /* not DOS_NT */
+ return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0;
}
-/* Return nonzero if file FILENAME exists and can be written. */
+/* Return true if file FILENAME exists and can be accessed
+ according to AMODE, which should include W_OK.
+ On failure, return false and set errno. */
-static int
-check_writable (const char *filename)
+static bool
+check_writable (const char *filename, int amode)
{
#ifdef MSDOS
+ /* FIXME: an faccessat implementation should be added to the
+ DOS/Windows ports and this #ifdef branch should be removed. */
struct stat st;
if (stat (filename, &st) < 0)
return 0;
+ errno = EPERM;
return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
#else /* not MSDOS */
-#ifdef HAVE_EUIDACCESS
- int res = (euidaccess (filename, 2) >= 0);
+ bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0;
#ifdef CYGWIN
- /* euidaccess may have returned failure because Cygwin couldn't
+ /* faccessat may have returned failure because Cygwin couldn't
determine the file's UID or GID; if so, we return success. */
if (!res)
{
+ int faccessat_errno = errno;
struct stat st;
if (stat (filename, &st) < 0)
return 0;
res = (st.st_uid == -1 || st.st_gid == -1);
+ errno = faccessat_errno;
}
#endif /* CYGWIN */
return res;
-#else /* not HAVE_EUIDACCESS */
- /* Access isn't quite right because it uses the real uid
- and we really want to test with the effective uid.
- But Unix doesn't give us a right way to do it.
- Opening with O_WRONLY could work for an ordinary file,
- but would lose for directories. */
- return (access (filename, 2) >= 0);
-#endif /* not HAVE_EUIDACCESS */
#endif /* not MSDOS */
}
@@ -2449,7 +2507,6 @@ Use `file-symlink-p' to test for such links. */)
{
Lisp_Object absname;
Lisp_Object handler;
- struct stat statbuf;
CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
@@ -2462,7 +2519,7 @@ Use `file-symlink-p' to test for such links. */)
absname = ENCODE_FILE (absname);
- return (stat (SSDATA (absname), &statbuf) >= 0) ? Qt : Qnil;
+ return (check_existing (SSDATA (absname))) ? Qt : Qnil;
}
DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
@@ -2494,9 +2551,6 @@ See also `file-exists-p' and `file-attributes'. */)
{
Lisp_Object absname;
Lisp_Object handler;
- int desc;
- int flags;
- struct stat statbuf;
CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
@@ -2508,42 +2562,16 @@ See also `file-exists-p' and `file-attributes'. */)
return call2 (handler, Qfile_readable_p, absname);
absname = ENCODE_FILE (absname);
-
-#if defined (DOS_NT) || defined (macintosh)
- /* Under MS-DOS, Windows, and Macintosh, open does not work for
- directories. */
- if (access (SDATA (absname), 0) == 0)
- return Qt;
- return Qnil;
-#else /* not DOS_NT and not macintosh */
- flags = O_RDONLY;
-#ifdef O_NONBLOCK
- /* Opening a fifo without O_NONBLOCK can wait.
- We don't want to wait. But we don't want to mess wth O_NONBLOCK
- except in the case of a fifo, on a system which handles it. */
- desc = stat (SSDATA (absname), &statbuf);
- if (desc < 0)
- return Qnil;
- if (S_ISFIFO (statbuf.st_mode))
- flags |= O_NONBLOCK;
-#endif
- desc = emacs_open (SSDATA (absname), flags, 0);
- if (desc < 0)
- return Qnil;
- emacs_close (desc);
- return Qt;
-#endif /* not DOS_NT and not macintosh */
+ return (faccessat (AT_FDCWD, SSDATA (absname), R_OK, AT_EACCESS) == 0
+ ? Qt : Qnil);
}
-/* Having this before file-symlink-p mysteriously caused it to be forgotten
- on the RT/PC. */
DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
doc: /* Return t if file FILENAME can be written or created by you. */)
(Lisp_Object filename)
{
Lisp_Object absname, dir, encoded;
Lisp_Object handler;
- struct stat statbuf;
CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
@@ -2555,14 +2583,15 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
return call2 (handler, Qfile_writable_p, absname);
encoded = ENCODE_FILE (absname);
- if (stat (SSDATA (encoded), &statbuf) >= 0)
- return (check_writable (SSDATA (encoded))
- ? Qt : Qnil);
+ if (check_writable (SSDATA (encoded), W_OK))
+ return Qt;
+ if (errno != ENOENT)
+ return Qnil;
dir = Ffile_name_directory (absname);
+ eassert (!NILP (dir));
#ifdef MSDOS
- if (!NILP (dir))
- dir = Fdirectory_file_name (dir);
+ dir = Fdirectory_file_name (dir);
#endif /* MSDOS */
dir = ENCODE_FILE (dir);
@@ -2570,12 +2599,9 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
/* The read-only attribute of the parent directory doesn't affect
whether a file or directory can be created within it. Some day we
should check ACLs though, which do affect this. */
- if (stat (SDATA (dir), &statbuf) < 0)
- return Qnil;
- return S_ISDIR (statbuf.st_mode) ? Qt : Qnil;
+ return file_directory_p (SDATA (dir)) ? Qt : Qnil;
#else
- return (check_writable (!NILP (dir) ? SSDATA (dir) : "")
- ? Qt : Qnil);
+ return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil;
#endif
}
@@ -2653,8 +2679,7 @@ Symbolic links to directories count as directories.
See `file-symlink-p' to distinguish symlinks. */)
(Lisp_Object filename)
{
- register Lisp_Object absname;
- struct stat st;
+ Lisp_Object absname;
Lisp_Object handler;
absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
@@ -2667,9 +2692,20 @@ See `file-symlink-p' to distinguish symlinks. */)
absname = ENCODE_FILE (absname);
- if (stat (SSDATA (absname), &st) < 0)
- return Qnil;
- return S_ISDIR (st.st_mode) ? Qt : Qnil;
+ return file_directory_p (SSDATA (absname)) ? Qt : Qnil;
+}
+
+/* Return true if FILE is a directory or a symlink to a directory. */
+bool
+file_directory_p (char const *file)
+{
+#ifdef WINDOWSNT
+ /* This is cheaper than 'stat'. */
+ return faccessat (AT_FDCWD, file, D_OK, AT_EACCESS) == 0;
+#else
+ struct stat st;
+ return stat (file, &st) == 0 && S_ISDIR (st.st_mode);
+#endif
}
DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p,
@@ -2683,21 +2719,65 @@ if the directory so specified exists and really is a readable and
searchable directory. */)
(Lisp_Object filename)
{
+ Lisp_Object absname;
Lisp_Object handler;
- int tem;
- struct gcpro gcpro1;
+
+ CHECK_STRING (filename);
+ absname = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
+ handler = Ffind_file_name_handler (absname, Qfile_accessible_directory_p);
if (!NILP (handler))
- return call2 (handler, Qfile_accessible_directory_p, filename);
+ return call2 (handler, Qfile_accessible_directory_p, absname);
- GCPRO1 (filename);
- tem = (NILP (Ffile_directory_p (filename))
- || NILP (Ffile_executable_p (filename)));
- UNGCPRO;
- return tem ? Qnil : Qt;
+ absname = ENCODE_FILE (absname);
+ return file_accessible_directory_p (SSDATA (absname)) ? Qt : Qnil;
+}
+
+/* If FILE is a searchable directory or a symlink to a
+ searchable directory, return true. Otherwise return
+ false and set errno to an error number. */
+bool
+file_accessible_directory_p (char const *file)
+{
+#ifdef DOS_NT
+ /* There's no need to test whether FILE is searchable, as the
+ searchable/executable bit is invented on DOS_NT platforms. */
+ return file_directory_p (file);
+#else
+ /* On POSIXish platforms, use just one system call; this avoids a
+ race and is typically faster. */
+ ptrdiff_t len = strlen (file);
+ char const *dir;
+ bool ok;
+ int saved_errno;
+ USE_SAFE_ALLOCA;
+
+ /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
+ There are three exceptions: "", "/", and "//". Leave "" alone,
+ as it's invalid. Append only "." to the other two exceptions as
+ "/" and "//" are distinct on some platforms, whereas "/", "///",
+ "////", etc. are all equivalent. */
+ if (! len)
+ dir = file;
+ else
+ {
+ /* Just check for trailing '/' when deciding whether to append '/'.
+ That's simpler than testing the two special cases "/" and "//",
+ and it's a safe optimization here. */
+ char *buf = SAFE_ALLOCA (len + 3);
+ memcpy (buf, file, len);
+ strcpy (buf + len, "/." + (file[len - 1] == '/'));
+ dir = buf;
+ }
+
+ ok = check_existing (dir);
+ saved_errno = errno;
+ SAFE_FREE ();
+ errno = saved_errno;
+ return ok;
+#endif
}
DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
@@ -2744,9 +2824,13 @@ See `file-symlink-p' to distinguish symlinks. */)
DEFUN ("file-selinux-context", Ffile_selinux_context,
Sfile_selinux_context, 1, 1, 0,
- doc: /* Return SELinux context of file named FILENAME,
-as a list ("user", "role", "type", "range"). Return (nil, nil, nil, nil)
-if file does not exist, is not accessible, or SELinux is disabled */)
+ doc: /* Return SELinux context of file named FILENAME.
+The return value is a list (USER ROLE TYPE RANGE), where the list
+elements are strings naming the user, role, type, and range of the
+file's SELinux security context.
+
+Return (nil nil nil nil) if the file is nonexistent or inaccessible,
+or if SELinux is disabled, or if Emacs lacks SELinux support. */)
(Lisp_Object filename)
{
Lisp_Object absname;
@@ -2788,9 +2872,8 @@ if file does not exist, is not accessible, or SELinux is disabled */)
if (context_range_get (context))
values[3] = build_string (context_range_get (context));
context_free (context);
+ freecon (con);
}
- if (con)
- freecon (con);
}
#endif
@@ -2799,9 +2882,12 @@ if file does not exist, is not accessible, or SELinux is disabled */)
DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
Sset_file_selinux_context, 2, 2, 0,
- doc: /* Set SELinux context of file named FILENAME to CONTEXT
-as a list ("user", "role", "type", "range"). Has no effect if SELinux
-is disabled. */)
+ doc: /* Set SELinux context of file named FILENAME to CONTEXT.
+CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
+elements are strings naming the components of a SELinux context.
+
+This function does nothing if SELinux is disabled, or if Emacs was not
+compiled with SELinux support. */)
(Lisp_Object filename, Lisp_Object context)
{
Lisp_Object absname;
@@ -2813,7 +2899,8 @@ is disabled. */)
Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context)));
Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context))));
security_context_t con;
- int fail, conlength;
+ bool fail;
+ int conlength;
context_t parsed_con;
#endif
@@ -2856,19 +2943,19 @@ is disabled. */)
error ("Doing context_range_set");
}
- /* Set the modified context back to the file. */
- fail = lsetfilecon (SSDATA (encoded_absname),
- context_str (parsed_con));
- if (fail)
+ /* Set the modified context back to the file. */
+ fail = (lsetfilecon (SSDATA (encoded_absname),
+ context_str (parsed_con))
+ != 0);
+ /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
+ if (fail && errno != ENOTSUP)
report_file_error ("Doing lsetfilecon", Fcons (absname, Qnil));
context_free (parsed_con);
+ freecon (con);
}
else
report_file_error ("Doing lgetfilecon", Fcons (absname, Qnil));
-
- if (con)
- freecon (con);
}
#endif
@@ -2948,11 +3035,13 @@ DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
The value is an integer. */)
(void)
{
- int realmask;
+ mode_t realmask;
Lisp_Object value;
+ block_input ();
realmask = umask (0);
umask (realmask);
+ unblock_input ();
XSETINT (value, (~ realmask) & 0777);
return value;
@@ -2969,11 +3058,7 @@ Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
{
Lisp_Object absname, encoded_absname;
Lisp_Object handler;
- time_t sec;
- int usec;
-
- if (! lisp_time_argument (timestamp, &sec, &usec))
- error ("Invalid time specification");
+ EMACS_TIME t = lisp_time_argument (timestamp);
absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
@@ -2986,18 +3071,11 @@ Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
encoded_absname = ENCODE_FILE (absname);
{
- EMACS_TIME t;
-
- EMACS_SET_SECS (t, sec);
- EMACS_SET_USECS (t, usec);
-
- if (set_file_times (SSDATA (encoded_absname), t, t))
+ if (set_file_times (-1, SSDATA (encoded_absname), t, t))
{
-#ifdef DOS_NT
- struct stat st;
-
+#ifdef MSDOS
/* Setting times on a directory always fails. */
- if (stat (SSDATA (encoded_absname), &st) == 0 && S_ISDIR (st.st_mode))
+ if (file_directory_p (SSDATA (encoded_absname)))
return Qnil;
#endif
report_file_error ("Setting file times", Fcons (absname, Qnil));
@@ -3026,8 +3104,7 @@ otherwise, if FILE2 does not exist, the answer is t. */)
(Lisp_Object file1, Lisp_Object file2)
{
Lisp_Object absname1, absname2;
- struct stat st;
- int mtime1;
+ struct stat st1, st2;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
@@ -3053,20 +3130,21 @@ otherwise, if FILE2 does not exist, the answer is t. */)
absname2 = ENCODE_FILE (absname2);
UNGCPRO;
- if (stat (SSDATA (absname1), &st) < 0)
+ if (stat (SSDATA (absname1), &st1) < 0)
return Qnil;
- mtime1 = st.st_mtime;
-
- if (stat (SSDATA (absname2), &st) < 0)
+ if (stat (SSDATA (absname2), &st2) < 0)
return Qt;
- return (mtime1 > st.st_mtime) ? Qt : Qnil;
+ return (EMACS_TIME_GT (get_stat_mtime (&st1), get_stat_mtime (&st2))
+ ? Qt : Qnil);
}
#ifndef READ_BUF_SIZE
#define READ_BUF_SIZE (64 << 10)
#endif
+/* Some buffer offsets are stored in 'int' variables. */
+verify (READ_BUF_SIZE <= INT_MAX);
/* This function is called after Lisp functions to decide a coding
system are called, or when they cause an error. Before they are
@@ -3093,16 +3171,15 @@ decide_coding_unwind (Lisp_Object unwind_data)
undo_list = XCAR (unwind_data);
buffer = XCDR (unwind_data);
- if (current_buffer != XBUFFER (buffer))
- set_buffer_internal (XBUFFER (buffer));
+ set_buffer_internal (XBUFFER (buffer));
adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
adjust_overlays_for_delete (BEG, Z - BEG);
- BUF_INTERVALS (current_buffer) = 0;
+ set_buffer_intervals (current_buffer, NULL);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
/* Now we are safe to change the buffer's multibyteness directly. */
- BVAR (current_buffer, enable_multibyte_characters) = multibyte;
- BVAR (current_buffer, undo_list) = undo_list;
+ bset_enable_multibyte_characters (current_buffer, multibyte);
+ bset_undo_list (current_buffer, undo_list);
return Qnil;
}
@@ -3111,8 +3188,8 @@ decide_coding_unwind (Lisp_Object unwind_data)
/* Used to pass values from insert-file-contents to read_non_regular. */
static int non_regular_fd;
-static EMACS_INT non_regular_inserted;
-static EMACS_INT non_regular_nbytes;
+static ptrdiff_t non_regular_inserted;
+static int non_regular_nbytes;
/* Read from a non-regular file.
@@ -3123,7 +3200,7 @@ static EMACS_INT non_regular_nbytes;
static Lisp_Object
read_non_regular (Lisp_Object ignore)
{
- EMACS_INT nbytes;
+ int nbytes;
immediate_quit = 1;
QUIT;
@@ -3152,7 +3229,7 @@ emacs_lseek (int fd, EMACS_INT offset, int whence)
{
/* Use "&" rather than "&&" to suppress a bogus GCC warning; see
<http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43772>. */
- if (! ((TYPE_MINIMUM (off_t) <= offset) & (offset <= TYPE_MAXIMUM (off_t))))
+ if (! ((offset >= TYPE_MINIMUM (off_t)) & (offset <= TYPE_MAXIMUM (off_t))))
{
errno = EINVAL;
return -1;
@@ -3160,6 +3237,15 @@ emacs_lseek (int fd, EMACS_INT offset, int whence)
return lseek (fd, offset, whence);
}
+/* Return a special time value indicating the error number ERRNUM. */
+static EMACS_TIME
+time_error_value (int errnum)
+{
+ int ns = (errnum == ENOENT || errnum == EACCES || errnum == ENOTDIR
+ ? NONEXISTENT_MODTIME_NSECS
+ : UNKNOWN_MODTIME_NSECS);
+ return make_emacs_time (0, ns);
+}
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
1, 5, 0,
@@ -3187,29 +3273,31 @@ variable `last-coding-system-used' to the coding system actually used. */)
(Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace)
{
struct stat st;
- register int fd;
- EMACS_INT inserted = 0;
- int nochange = 0;
- register EMACS_INT how_much;
+ int file_status;
+ EMACS_TIME mtime;
+ int fd;
+ ptrdiff_t inserted = 0;
+ bool nochange = 0;
+ ptrdiff_t how_much;
off_t beg_offset, end_offset;
- register EMACS_INT unprocessed;
- int count = SPECPDL_INDEX ();
+ int unprocessed;
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
Lisp_Object handler, val, insval, orig_filename, old_undo;
Lisp_Object p;
- EMACS_INT total = 0;
- int not_regular = 0;
+ ptrdiff_t total = 0;
+ bool not_regular = 0;
int save_errno = 0;
char read_buf[READ_BUF_SIZE];
struct coding_system coding;
char buffer[1 << 14];
- int replace_handled = 0;
- int set_coding_system = 0;
+ bool replace_handled = 0;
+ bool set_coding_system = 0;
Lisp_Object coding_system;
- int read_quit = 0;
+ bool read_quit = 0;
Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
- int we_locked_file = 0;
- int deferred_remove_unwind_protect = 0;
+ bool we_locked_file = 0;
+ bool deferred_remove_unwind_protect = 0;
if (current_buffer->base_buffer && ! NILP (visit))
error ("Cannot do file visiting in an indirect buffer");
@@ -3238,7 +3326,8 @@ variable `last-coding-system-used' to the coding system actually used. */)
{
val = call6 (handler, Qinsert_file_contents, filename,
visit, beg, end, replace);
- if (CONSP (val) && CONSP (XCDR (val)))
+ if (CONSP (val) && CONSP (XCDR (val))
+ && RANGED_INTEGERP (0, XCAR (XCDR (val)), ZV - PT))
inserted = XINT (XCAR (XCDR (val)));
goto handled;
}
@@ -3254,19 +3343,22 @@ variable `last-coding-system-used' to the coding system actually used. */)
/* Tell stat to use expensive method to get accurate info. */
Vw32_get_true_file_attributes = Qt;
- total = stat (SSDATA (filename), &st);
+ file_status = stat (SSDATA (filename), &st);
Vw32_get_true_file_attributes = tem;
}
- if (total < 0)
#else
- if (stat (SSDATA (filename), &st) < 0)
+ file_status = stat (SSDATA (filename), &st);
#endif /* WINDOWSNT */
+
+ if (file_status == 0)
+ mtime = get_stat_mtime (&st);
+ else
{
badopen:
save_errno = errno;
if (NILP (visit))
report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
- st.st_mtime = -1;
+ mtime = time_error_value (save_errno);
st.st_size = -1;
how_much = 0;
if (!NILP (Vcoding_system_for_read))
@@ -3310,7 +3402,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (!NILP (beg))
{
- if (! (RANGED_INTEGERP (0, beg, TYPE_MAXIMUM (off_t))))
+ if (! RANGED_INTEGERP (0, beg, TYPE_MAXIMUM (off_t)))
wrong_type_argument (intern ("file-offset"), beg);
beg_offset = XFASTINT (beg);
}
@@ -3319,7 +3411,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (!NILP (end))
{
- if (! (RANGED_INTEGERP (0, end, TYPE_MAXIMUM (off_t))))
+ if (! RANGED_INTEGERP (0, end, TYPE_MAXIMUM (off_t)))
wrong_type_argument (intern ("file-offset"), end);
end_offset = XFASTINT (end);
}
@@ -3355,8 +3447,8 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (beg_offset < likely_end)
{
- ptrdiff_t buf_bytes =
- Z_BYTE - (!NILP (replace) ? ZV_BYTE - BEGV_BYTE : 0);
+ ptrdiff_t buf_bytes
+ = Z_BYTE - (!NILP (replace) ? ZV_BYTE - BEGV_BYTE : 0);
ptrdiff_t buf_growth_max = BUF_BYTES_MAX - buf_bytes;
off_t likely_growth = likely_end - beg_offset;
if (buf_growth_max < likely_growth)
@@ -3392,7 +3484,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
We assume that the 1K-byte and 3K-byte for heading
and tailing respectively are sufficient for this
purpose. */
- EMACS_INT nread;
+ int nread;
if (st.st_size <= (1024 * 4))
nread = emacs_read (fd, read_buf, 1024 * 4);
@@ -3417,22 +3509,22 @@ variable `last-coding-system-used' to the coding system actually used. */)
Lisp_Object workbuf;
struct buffer *buf;
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
workbuf = Fget_buffer_create (build_string (" *code-converting-work*"));
buf = XBUFFER (workbuf);
delete_all_overlays (buf);
- BVAR (buf, directory) = BVAR (current_buffer, directory);
- BVAR (buf, read_only) = Qnil;
- BVAR (buf, filename) = Qnil;
- BVAR (buf, undo_list) = Qt;
+ bset_directory (buf, BVAR (current_buffer, directory));
+ bset_read_only (buf, Qnil);
+ bset_filename (buf, Qnil);
+ bset_undo_list (buf, Qt);
eassert (buf->overlays_before == NULL);
eassert (buf->overlays_after == NULL);
set_buffer_internal (buf);
Ferase_buffer ();
- BVAR (buf, enable_multibyte_characters) = Qnil;
+ bset_enable_multibyte_characters (buf, Qnil);
insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
@@ -3502,13 +3594,13 @@ variable `last-coding-system-used' to the coding system actually used. */)
/* same_at_start and same_at_end count bytes,
because file access counts bytes
and BEG and END count bytes. */
- EMACS_INT same_at_start = BEGV_BYTE;
- EMACS_INT same_at_end = ZV_BYTE;
- EMACS_INT overlap;
+ ptrdiff_t same_at_start = BEGV_BYTE;
+ ptrdiff_t same_at_end = ZV_BYTE;
+ ptrdiff_t overlap;
/* There is still a possibility we will find the need to do code
- conversion. If that happens, we set this variable to 1 to
+ conversion. If that happens, set this variable to
give up on handling REPLACE in the optimized way. */
- int giveup_match_end = 0;
+ bool giveup_match_end = 0;
if (beg_offset != 0)
{
@@ -3523,7 +3615,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
match the text at the beginning of the buffer. */
while (1)
{
- EMACS_INT nread, bufpos;
+ int nread, bufpos;
nread = emacs_read (fd, buffer, sizeof buffer);
if (nread < 0)
@@ -3632,7 +3724,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (! giveup_match_end)
{
- EMACS_INT temp;
+ ptrdiff_t temp;
/* We win! We can handle REPLACE the optimized way. */
@@ -3669,7 +3761,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
/* If display currently starts at beginning of line,
keep it that way. */
if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
- XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
+ XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
replace_handled = 1;
}
@@ -3686,17 +3778,18 @@ variable `last-coding-system-used' to the coding system actually used. */)
in a more optimized way. */
if (!NILP (replace) && ! replace_handled && BEGV < ZV)
{
- EMACS_INT same_at_start = BEGV_BYTE;
- EMACS_INT same_at_end = ZV_BYTE;
- EMACS_INT same_at_start_charpos;
- EMACS_INT inserted_chars;
- EMACS_INT overlap;
- EMACS_INT bufpos;
+ ptrdiff_t same_at_start = BEGV_BYTE;
+ ptrdiff_t same_at_end = ZV_BYTE;
+ ptrdiff_t same_at_start_charpos;
+ ptrdiff_t inserted_chars;
+ ptrdiff_t overlap;
+ ptrdiff_t bufpos;
unsigned char *decoded;
- EMACS_INT temp;
- EMACS_INT this = 0;
- int this_count = SPECPDL_INDEX ();
- int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ ptrdiff_t temp;
+ ptrdiff_t this = 0;
+ ptrdiff_t this_count = SPECPDL_INDEX ();
+ bool multibyte
+ = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
Lisp_Object conversion_buffer;
struct gcpro gcpro1;
@@ -3720,8 +3813,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
/* We read one bunch by one (READ_BUF_SIZE bytes) to allow
quitting while reading a huge while. */
/* `try'' is reserved in some compilers (Microsoft C). */
- EMACS_INT trytry = min (total - how_much,
- READ_BUF_SIZE - unprocessed);
+ int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
/* Allow quitting out of the actual I/O. */
immediate_quit = 1;
@@ -3827,7 +3919,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
/* If display currently starts at beginning of line,
keep it that way. */
if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
- XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
+ XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
/* Replace the chars that we need to replace,
and update INSERTED to equal the number of bytes
@@ -3912,13 +4004,13 @@ variable `last-coding-system-used' to the coding system actually used. */)
/* Here, we don't do code conversion in the loop. It is done by
decode_coding_gap after all data are read into the buffer. */
{
- EMACS_INT gap_size = GAP_SIZE;
+ ptrdiff_t gap_size = GAP_SIZE;
while (how_much < total)
{
/* try is reserved in some compilers (Microsoft C) */
- EMACS_INT trytry = min (total - how_much, READ_BUF_SIZE);
- EMACS_INT this;
+ int trytry = min (total - how_much, READ_BUF_SIZE);
+ ptrdiff_t this;
if (not_regular)
{
@@ -4037,13 +4129,13 @@ variable `last-coding-system-used' to the coding system actually used. */)
care of marker adjustment. By this way, we can run Lisp
program safely before decoding the inserted text. */
Lisp_Object unwind_data;
- int count1 = SPECPDL_INDEX ();
+ ptrdiff_t count1 = SPECPDL_INDEX ();
unwind_data = Fcons (BVAR (current_buffer, enable_multibyte_characters),
Fcons (BVAR (current_buffer, undo_list),
Fcurrent_buffer ()));
- BVAR (current_buffer, enable_multibyte_characters) = Qnil;
- BVAR (current_buffer, undo_list) = Qt;
+ bset_enable_multibyte_characters (current_buffer, Qnil);
+ bset_undo_list (current_buffer, Qt);
record_unwind_protect (decide_coding_unwind, unwind_data);
if (inserted > 0 && ! NILP (Vset_auto_coding_function))
@@ -4091,7 +4183,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
&& NILP (replace))
/* Visiting a file with these coding system makes the buffer
unibyte. */
- BVAR (current_buffer, enable_multibyte_characters) = Qnil;
+ bset_enable_multibyte_characters (current_buffer, Qnil);
}
coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
@@ -4134,13 +4226,13 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (!NILP (visit))
{
if (!EQ (BVAR (current_buffer, undo_list), Qt) && !nochange)
- BVAR (current_buffer, undo_list) = Qnil;
+ bset_undo_list (current_buffer, Qnil);
if (NILP (handler))
{
- current_buffer->modtime = st.st_mtime;
+ current_buffer->modtime = mtime;
current_buffer->modtime_size = st.st_size;
- BVAR (current_buffer, filename) = orig_filename;
+ bset_filename (current_buffer, orig_filename);
}
SAVE_MODIFF = MODIFF;
@@ -4168,7 +4260,8 @@ variable `last-coding-system-used' to the coding system actually used. */)
visit);
if (! NILP (insval))
{
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
inserted = XFASTINT (insval);
}
}
@@ -4177,20 +4270,21 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (inserted > 0)
{
/* Don't run point motion or modification hooks when decoding. */
- int count1 = SPECPDL_INDEX ();
- EMACS_INT old_inserted = inserted;
+ ptrdiff_t count1 = SPECPDL_INDEX ();
+ ptrdiff_t old_inserted = inserted;
specbind (Qinhibit_point_motion_hooks, Qt);
specbind (Qinhibit_modification_hooks, Qt);
/* Save old undo list and don't record undo for decoding. */
old_undo = BVAR (current_buffer, undo_list);
- BVAR (current_buffer, undo_list) = Qt;
+ bset_undo_list (current_buffer, Qt);
if (NILP (replace))
{
insval = call3 (Qformat_decode,
Qnil, make_number (inserted), visit);
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
inserted = XFASTINT (insval);
}
else
@@ -4204,15 +4298,16 @@ variable `last-coding-system-used' to the coding system actually used. */)
Hence we temporarily save `point' and `inserted' here and
restore `point' iff format-decode did not insert or delete
any text. Otherwise we leave `point' at point-min. */
- EMACS_INT opoint = PT;
- EMACS_INT opoint_byte = PT_BYTE;
- EMACS_INT oinserted = ZV - BEGV;
- int ochars_modiff = CHARS_MODIFF;
+ ptrdiff_t opoint = PT;
+ ptrdiff_t opoint_byte = PT_BYTE;
+ ptrdiff_t oinserted = ZV - BEGV;
+ EMACS_INT ochars_modiff = CHARS_MODIFF;
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
insval = call3 (Qformat_decode,
Qnil, make_number (oinserted), visit);
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
if (ochars_modiff == CHARS_MODIFF)
/* format_decode didn't modify buffer's characters => move
point back to position before inserted text and leave
@@ -4234,7 +4329,8 @@ variable `last-coding-system-used' to the coding system actually used. */)
insval = call1 (XCAR (p), make_number (inserted));
if (!NILP (insval))
{
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
inserted = XFASTINT (insval);
}
}
@@ -4242,16 +4338,17 @@ variable `last-coding-system-used' to the coding system actually used. */)
{
/* For the rationale of this see the comment on
format-decode above. */
- EMACS_INT opoint = PT;
- EMACS_INT opoint_byte = PT_BYTE;
- EMACS_INT oinserted = ZV - BEGV;
- int ochars_modiff = CHARS_MODIFF;
+ ptrdiff_t opoint = PT;
+ ptrdiff_t opoint_byte = PT_BYTE;
+ ptrdiff_t oinserted = ZV - BEGV;
+ EMACS_INT ochars_modiff = CHARS_MODIFF;
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
insval = call1 (XCAR (p), make_number (oinserted));
if (!NILP (insval))
{
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
if (ochars_modiff == CHARS_MODIFF)
/* after_insert_file_functions didn't modify
buffer's characters => move point back to
@@ -4272,7 +4369,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (NILP (visit))
{
- BVAR (current_buffer, undo_list) = old_undo;
+ bset_undo_list (current_buffer, old_undo);
if (CONSP (old_undo) && inserted != old_inserted)
{
/* Adjust the last undo record for the size change during
@@ -4287,13 +4384,13 @@ variable `last-coding-system-used' to the coding system actually used. */)
else
/* If undo_list was Qt before, keep it that way.
Otherwise start with an empty undo_list. */
- BVAR (current_buffer, undo_list) = EQ (old_undo, Qt) ? Qt : Qnil;
+ bset_undo_list (current_buffer, EQ (old_undo, Qt) ? Qt : Qnil);
unbind_to (count1, Qnil);
}
if (!NILP (visit)
- && current_buffer->modtime == -1)
+ && EMACS_NSECS (current_buffer->modtime) == NONEXISTENT_MODTIME_NSECS)
{
/* If visiting nonexistent file, return nil. */
errno = save_errno;
@@ -4359,8 +4456,8 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file
If it is not set locally, we anyway have to convert EOL
format if the default value of `buffer-file-coding-system'
tells that it is not Unix-like (LF only) format. */
- int using_default_coding = 0;
- int force_raw_text = 0;
+ bool using_default_coding = 0;
+ bool force_raw_text = 0;
val = BVAR (current_buffer, buffer_file_coding_system);
if (NILP (val)
@@ -4469,19 +4566,20 @@ This calls `write-region-annotate-functions' at the start, and
`write-region-post-annotation-function' at the end. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append, Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
{
- register int desc;
- int failure;
+ int desc;
+ bool ok;
int save_errno = 0;
const char *fn;
struct stat st;
- int count = SPECPDL_INDEX ();
+ EMACS_TIME modtime;
+ ptrdiff_t count = SPECPDL_INDEX ();
int count1;
Lisp_Object handler;
Lisp_Object visit_file;
Lisp_Object annotations;
Lisp_Object encoded_filename;
- int visiting = (EQ (visit, Qt) || STRINGP (visit));
- int quietly = !NILP (visit);
+ bool visiting = (EQ (visit, Qt) || STRINGP (visit));
+ bool quietly = !NILP (visit);
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
struct buffer *given_buffer;
struct coding_system coding;
@@ -4527,7 +4625,7 @@ This calls `write-region-annotate-functions' at the start, and
{
SAVE_MODIFF = MODIFF;
XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
- BVAR (current_buffer, filename) = visit_file;
+ bset_filename (current_buffer, visit_file);
}
UNGCPRO;
return val;
@@ -4645,37 +4743,27 @@ This calls `write-region-annotate-functions' at the start, and
UNGCPRO;
- failure = 0;
immediate_quit = 1;
if (STRINGP (start))
- {
- failure = 0 > a_write (desc, start, 0, SCHARS (start),
- &annotations, &coding);
- save_errno = errno;
- }
+ ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
else if (XINT (start) != XINT (end))
- {
- failure = 0 > a_write (desc, Qnil,
- XINT (start), XINT (end) - XINT (start),
- &annotations, &coding);
- save_errno = errno;
- }
+ ok = a_write (desc, Qnil, XINT (start), XINT (end) - XINT (start),
+ &annotations, &coding);
else
{
- /* If file was empty, still need to write the annotations */
+ /* If file was empty, still need to write the annotations. */
coding.mode |= CODING_MODE_LAST_BLOCK;
- failure = 0 > a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
- save_errno = errno;
+ ok = a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
}
+ save_errno = errno;
- if (CODING_REQUIRE_FLUSHING (&coding)
- && !(coding.mode & CODING_MODE_LAST_BLOCK)
- && ! failure)
+ if (ok && CODING_REQUIRE_FLUSHING (&coding)
+ && !(coding.mode & CODING_MODE_LAST_BLOCK))
{
/* We have to flush out a data. */
coding.mode |= CODING_MODE_LAST_BLOCK;
- failure = 0 > e_write (desc, Qnil, 1, 1, &coding);
+ ok = e_write (desc, Qnil, 1, 1, &coding);
save_errno = errno;
}
@@ -4692,15 +4780,22 @@ This calls `write-region-annotate-functions' at the start, and
ignore EINVAL which happens when fsync is not supported on this
file. */
if (errno != EINTR && errno != EINVAL)
- failure = 1, save_errno = errno;
+ ok = 0, save_errno = errno;
}
#endif
+ modtime = invalid_emacs_time ();
+ if (visiting)
+ {
+ if (fstat (desc, &st) == 0)
+ modtime = get_stat_mtime (&st);
+ else
+ ok = 0, save_errno = errno;
+ }
+
/* NFS can report a write failure now. */
if (emacs_close (desc) < 0)
- failure = 1, save_errno = errno;
-
- stat (fn, &st);
+ ok = 0, save_errno = errno;
/* Discard the unwind protect for close_file_unwind. */
specpdl_ptr = specpdl + count1;
@@ -4729,13 +4824,13 @@ This calls `write-region-annotate-functions' at the start, and
/* Do this before reporting IO error
to avoid a "file has changed on disk" warning on
next attempt to save. */
- if (visiting)
+ if (EMACS_TIME_VALID_P (modtime))
{
- current_buffer->modtime = st.st_mtime;
+ current_buffer->modtime = modtime;
current_buffer->modtime_size = st.st_size;
}
- if (failure)
+ if (! ok)
error ("IO error writing %s: %s", SDATA (filename),
emacs_strerror (save_errno));
@@ -4743,7 +4838,7 @@ This calls `write-region-annotate-functions' at the start, and
{
SAVE_MODIFF = MODIFF;
XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
- BVAR (current_buffer, filename) = visit_file;
+ bset_filename (current_buffer, visit_file);
update_mode_lines++;
}
else if (quietly)
@@ -4791,7 +4886,8 @@ build_annotations (Lisp_Object start, Lisp_Object end)
Lisp_Object p, res;
struct gcpro gcpro1, gcpro2;
Lisp_Object original_buffer;
- int i, used_global = 0;
+ int i;
+ bool used_global = 0;
XSETBUFFER (original_buffer, current_buffer);
@@ -4871,16 +4967,16 @@ build_annotations (Lisp_Object start, Lisp_Object end)
We modify *ANNOT by discarding elements as we use them up.
- The return value is negative in case of system call failure. */
+ Return true if successful. */
-static int
-a_write (int desc, Lisp_Object string, EMACS_INT pos,
- register EMACS_INT nchars, Lisp_Object *annot,
+static bool
+a_write (int desc, Lisp_Object string, ptrdiff_t pos,
+ ptrdiff_t nchars, Lisp_Object *annot,
struct coding_system *coding)
{
Lisp_Object tem;
- EMACS_INT nextpos;
- EMACS_INT lastpos = pos + nchars;
+ ptrdiff_t nextpos;
+ ptrdiff_t lastpos = pos + nchars;
while (NILP (*annot) || CONSP (*annot))
{
@@ -4897,30 +4993,30 @@ a_write (int desc, Lisp_Object string, EMACS_INT pos,
/* Output buffer text up to the next annotation's position. */
if (nextpos > pos)
{
- if (0 > e_write (desc, string, pos, nextpos, coding))
- return -1;
+ if (!e_write (desc, string, pos, nextpos, coding))
+ return 0;
pos = nextpos;
}
/* Output the annotation. */
tem = Fcdr (Fcar (*annot));
if (STRINGP (tem))
{
- if (0 > e_write (desc, tem, 0, SCHARS (tem), coding))
- return -1;
+ if (!e_write (desc, tem, 0, SCHARS (tem), coding))
+ return 0;
}
*annot = Fcdr (*annot);
}
- return 0;
+ return 1;
}
/* Write text in the range START and END into descriptor DESC,
encoding them with coding system CODING. If STRING is nil, START
and END are character positions of the current buffer, else they
- are indexes to the string STRING. */
+ are indexes to the string STRING. Return true if successful. */
-static int
-e_write (int desc, Lisp_Object string, EMACS_INT start, EMACS_INT end,
+static bool
+e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
struct coding_system *coding)
{
if (STRINGP (string))
@@ -4952,8 +5048,8 @@ e_write (int desc, Lisp_Object string, EMACS_INT start, EMACS_INT end,
}
else
{
- EMACS_INT start_byte = CHAR_TO_BYTE (start);
- EMACS_INT end_byte = CHAR_TO_BYTE (end);
+ ptrdiff_t start_byte = CHAR_TO_BYTE (start);
+ ptrdiff_t end_byte = CHAR_TO_BYTE (end);
coding->src_multibyte = (end - start) < (end_byte - start_byte);
if (CODING_REQUIRE_ENCODING (coding))
@@ -4980,20 +5076,20 @@ e_write (int desc, Lisp_Object string, EMACS_INT start, EMACS_INT end,
if (coding->produced > 0)
{
- coding->produced -=
- emacs_write (desc,
- STRINGP (coding->dst_object)
- ? SSDATA (coding->dst_object)
- : (char *) BYTE_POS_ADDR (coding->dst_pos_byte),
- coding->produced);
+ coding->produced
+ -= emacs_write (desc,
+ STRINGP (coding->dst_object)
+ ? SSDATA (coding->dst_object)
+ : (char *) BYTE_POS_ADDR (coding->dst_pos_byte),
+ coding->produced);
if (coding->produced)
- return -1;
+ return 0;
}
start += coding->consumed_char;
}
- return 0;
+ return 1;
}
DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
@@ -5008,6 +5104,7 @@ See Info node `(elisp)Modification Time' for more details. */)
struct stat st;
Lisp_Object handler;
Lisp_Object filename;
+ EMACS_TIME mtime;
if (NILP (buf))
b = current_buffer;
@@ -5018,7 +5115,7 @@ See Info node `(elisp)Modification Time' for more details. */)
}
if (!STRINGP (BVAR (b, filename))) return Qt;
- if (b->modtime == 0) return Qt;
+ if (EMACS_NSECS (b->modtime) == UNKNOWN_MODTIME_NSECS) return Qt;
/* If the file name has special constructs in it,
call the corresponding file handler. */
@@ -5029,20 +5126,10 @@ See Info node `(elisp)Modification Time' for more details. */)
filename = ENCODE_FILE (BVAR (b, filename));
- if (stat (SSDATA (filename), &st) < 0)
- {
- /* If the file doesn't exist now and didn't exist before,
- we say that it isn't modified, provided the error is a tame one. */
- if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
- st.st_mtime = -1;
- else
- st.st_mtime = 0;
- }
- if ((st.st_mtime == b->modtime
- /* If both are positive, accept them if they are off by one second. */
- || (st.st_mtime > 0 && b->modtime > 0
- && (st.st_mtime - 1 == b->modtime
- || st.st_mtime == b->modtime - 1)))
+ mtime = (stat (SSDATA (filename), &st) == 0
+ ? get_stat_mtime (&st)
+ : time_error_value (errno));
+ if (EMACS_TIME_EQ (mtime, b->modtime)
&& (st.st_size == b->modtime_size
|| b->modtime_size < 0))
return Qt;
@@ -5055,7 +5142,7 @@ DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime,
Next attempt to save will certainly not complain of a discrepancy. */)
(void)
{
- current_buffer->modtime = 0;
+ current_buffer->modtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS);
current_buffer->modtime_size = -1;
return Qnil;
}
@@ -5063,16 +5150,16 @@ Next attempt to save will certainly not complain of a discrepancy. */)
DEFUN ("visited-file-modtime", Fvisited_file_modtime,
Svisited_file_modtime, 0, 0, 0,
doc: /* Return the current buffer's recorded visited file modification time.
-The value is a list of the form (HIGH LOW), like the time values that
+The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
`file-attributes' returns. If the current buffer has no recorded file
modification time, this function returns 0. If the visited file
doesn't exist, HIGH will be -1.
See Info node `(elisp)Modification Time' for more details. */)
(void)
{
- if (! current_buffer->modtime)
+ if (EMACS_NSECS (current_buffer->modtime) < 0)
return make_number (0);
- return make_time (current_buffer->modtime);
+ return make_lisp_time (current_buffer->modtime);
}
DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
@@ -5082,12 +5169,12 @@ Useful if the buffer was not read from the file normally
or if the file itself has been changed for some known benign reason.
An argument specifies the modification time value to use
\(instead of that of the visited file), in the form of a list
-\(HIGH . LOW) or (HIGH LOW). */)
+\(HIGH LOW USEC PSEC) as returned by `current-time'. */)
(Lisp_Object time_list)
{
if (!NILP (time_list))
{
- CONS_TO_INTEGER (time_list, time_t, current_buffer->modtime);
+ current_buffer->modtime = lisp_time_argument (time_list);
current_buffer->modtime_size = -1;
}
else
@@ -5109,7 +5196,7 @@ An argument specifies the modification time value to use
if (stat (SSDATA (filename), &st) >= 0)
{
- current_buffer->modtime = st.st_mtime;
+ current_buffer->modtime = get_stat_mtime (&st);
current_buffer->modtime_size = st.st_size;
}
}
@@ -5136,7 +5223,7 @@ auto_save_error (Lisp_Object error_val)
msg = Fformat (3, args);
GCPRO1 (msg);
nbytes = SBYTES (msg);
- SAFE_ALLOCA (msgbuf, char *, nbytes);
+ msgbuf = SAFE_ALLOCA (nbytes);
memcpy (msgbuf, SDATA (msg), nbytes);
for (i = 0; i < 3; ++i)
@@ -5167,8 +5254,8 @@ auto_save_1 (void)
if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0)
/* But make sure we can overwrite it later! */
auto_save_mode_bits = (st.st_mode | 0600) & 0777;
- else if ((modes = Ffile_modes (BVAR (current_buffer, filename)),
- INTEGERP (modes)))
+ else if (modes = Ffile_modes (BVAR (current_buffer, filename)),
+ INTEGERP (modes))
/* Remote files don't cooperate with stat. */
auto_save_mode_bits = (XINT (modes) | 0600) & 0777;
}
@@ -5187,9 +5274,9 @@ do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */
auto_saving = 0;
if (stream != NULL)
{
- BLOCK_INPUT;
+ block_input ();
fclose (stream);
- UNBLOCK_INPUT;
+ unblock_input ();
}
return Qnil;
}
@@ -5205,16 +5292,18 @@ do_auto_save_unwind_1 (Lisp_Object value) /* used as unwind-protect function */
static Lisp_Object
do_auto_save_make_dir (Lisp_Object dir)
{
- Lisp_Object mode;
+ Lisp_Object result;
- call2 (Qmake_directory, dir, Qt);
- XSETFASTINT (mode, 0700);
- return Fset_file_modes (dir, mode);
+ auto_saving_dir_umask = 077;
+ result = call2 (Qmake_directory, dir, Qt);
+ auto_saving_dir_umask = 0;
+ return result;
}
static Lisp_Object
do_auto_save_eh (Lisp_Object ignore)
{
+ auto_saving_dir_umask = 0;
return Qnil;
}
@@ -5233,13 +5322,13 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
{
struct buffer *old = current_buffer, *b;
Lisp_Object tail, buf, hook;
- int auto_saved = 0;
+ bool auto_saved = 0;
int do_handled_files;
Lisp_Object oquit;
FILE *stream = NULL;
- int count = SPECPDL_INDEX ();
- int orig_minibuffer_auto_raise = minibuffer_auto_raise;
- int old_message_p = 0;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ bool orig_minibuffer_auto_raise = minibuffer_auto_raise;
+ bool old_message_p = 0;
struct gcpro gcpro1, gcpro2;
if (max_specpdl_size < specpdl_size + 40)
@@ -5282,7 +5371,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
dir = Ffile_name_directory (listfile);
if (NILP (Ffile_directory_p (dir)))
internal_condition_case_1 (do_auto_save_make_dir,
- dir, Fcons (Fcons (Qfile_error, Qnil), Qnil),
+ dir, Qt,
do_auto_save_eh);
UNGCPRO;
}
@@ -5318,7 +5407,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
if (STRINGP (BVAR (b, auto_save_file_name))
&& stream != NULL && do_handled_files == 0)
{
- BLOCK_INPUT;
+ block_input ();
if (!NILP (BVAR (b, filename)))
{
fwrite (SDATA (BVAR (b, filename)), 1,
@@ -5328,7 +5417,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
fwrite (SDATA (BVAR (b, auto_save_file_name)), 1,
SBYTES (BVAR (b, auto_save_file_name)), stream);
putc ('\n', stream);
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (!NILP (current_only)
@@ -5352,9 +5441,8 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
|| NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name),
Qwrite_region))))
{
- EMACS_TIME before_time, after_time;
-
- EMACS_GET_TIME (before_time);
+ EMACS_TIME before_time = current_emacs_time ();
+ EMACS_TIME after_time;
/* If we had a failure, don't try again for 20 minutes. */
if (b->auto_save_failure_time > 0
@@ -5386,12 +5474,12 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
if (!auto_saved && NILP (no_message))
message1 ("Auto-saving...");
internal_condition_case (auto_save_1, Qt, auto_save_error);
- auto_saved++;
+ auto_saved = 1;
BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b);
XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
set_buffer_internal (old);
- EMACS_GET_TIME (after_time);
+ after_time = current_emacs_time ();
/* If auto-save took more than 60 seconds,
assume it was an NFS failure that got a timeout. */
@@ -5471,7 +5559,8 @@ The return value is only relevant for a call to `read-file-name' that happens
before any other event (mouse or keypress) is handled. */)
(void)
{
-#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
+#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) \
+ || defined (HAVE_NS)
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
&& use_file_dialog
@@ -5548,7 +5637,7 @@ syms_of_fileio (void)
DEFSYM (Qexcl, "excl");
DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
- doc: /* *Coding system for encoding file names.
+ doc: /* Coding system for encoding file names.
If it is nil, `default-file-name-coding-system' (which see) is used. */);
Vfile_name_coding_system = Qnil;
@@ -5571,31 +5660,38 @@ of file names regardless of the current language environment. */);
Fput (Qfile_error, Qerror_conditions,
Fpurecopy (list2 (Qfile_error, Qerror)));
Fput (Qfile_error, Qerror_message,
- make_pure_c_string ("File error"));
+ build_pure_c_string ("File error"));
Fput (Qfile_already_exists, Qerror_conditions,
Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
Fput (Qfile_already_exists, Qerror_message,
- make_pure_c_string ("File already exists"));
+ build_pure_c_string ("File already exists"));
Fput (Qfile_date_error, Qerror_conditions,
Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
Fput (Qfile_date_error, Qerror_message,
- make_pure_c_string ("Cannot set file date"));
+ build_pure_c_string ("Cannot set file date"));
DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist,
- doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
-If a file name matches REGEXP, then all I/O on that file is done by calling
-HANDLER.
-
-The first argument given to HANDLER is the name of the I/O primitive
-to be handled; the remaining arguments are the arguments that were
-passed to that primitive. For example, if you do
- (file-exists-p FILENAME)
-and FILENAME is handled by HANDLER, then HANDLER is called like this:
- (funcall HANDLER 'file-exists-p FILENAME)
-The function `find-file-name-handler' checks this list for a handler
-for its argument. */);
+ doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
+If a file name matches REGEXP, all I/O on that file is done by calling
+HANDLER. If a file name matches more than one handler, the handler
+whose match starts last in the file name gets precedence. The
+function `find-file-name-handler' checks this list for a handler for
+its argument.
+
+HANDLER should be a function. The first argument given to it is the
+name of the I/O primitive to be handled; the remaining arguments are
+the arguments that were passed to that primitive. For example, if you
+do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
+HANDLER is called like this:
+
+ (funcall HANDLER 'file-exists-p FILENAME)
+
+Note that HANDLER must be able to handle all I/O primitives; if it has
+nothing special to do for a primitive, it should reinvoke the
+primitive to handle the operation \"the usual way\".
+See Info node `(elisp)Magic File Names' for more details. */);
Vfile_name_handler_alist = Qnil;
DEFVAR_LISP ("set-auto-coding-function",
@@ -5695,7 +5791,7 @@ file is usually more useful if it contains the deleted text. */);
#ifdef HAVE_FSYNC
DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync,
- doc: /* *Non-nil means don't call fsync in `write-region'.
+ doc: /* Non-nil means don't call fsync in `write-region'.
This variable affects calls to `write-region' as well as save commands.
A non-nil value may result in data loss! */);
write_region_inhibit_fsync = 0;
diff --git a/src/filelock.c b/src/filelock.c
index 5ee2c039b81..17f3f253249 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -1,5 +1,5 @@
/* Lock files for editing.
- Copyright (C) 1985-1987, 1993-1994, 1996, 1998-2011
+ Copyright (C) 1985-1987, 1993-1994, 1996, 1998-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -23,7 +23,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/stat.h>
#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
#ifdef HAVE_PWD_H
#include <pwd.h>
@@ -40,8 +39,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <errno.h>
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "coding.h"
#include "systime.h"
@@ -100,10 +99,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Return the time of the last system boot. */
static time_t boot_time;
-static int boot_time_initialized;
+static bool boot_time_initialized;
#ifdef BOOT_TIME
-static void get_boot_time_1 (const char *, int);
+static void get_boot_time_1 (const char *, bool);
#endif
static time_t
@@ -170,18 +169,18 @@ get_boot_time (void)
{
char cmd_string[sizeof WTMP_FILE ".19.gz"];
Lisp_Object tempname, filename;
- int delete_flag = 0;
+ bool delete_flag = 0;
filename = Qnil;
- sprintf (cmd_string, "%s.%d", WTMP_FILE, counter);
- tempname = build_string (cmd_string);
+ tempname = make_formatted_string
+ (cmd_string, "%s.%d", WTMP_FILE, counter);
if (! NILP (Ffile_exists_p (tempname)))
filename = tempname;
else
{
- sprintf (cmd_string, "%s.%d.gz", WTMP_FILE, counter);
- tempname = build_string (cmd_string);
+ tempname = make_formatted_string (cmd_string, "%s.%d.gz",
+ WTMP_FILE, counter);
if (! NILP (Ffile_exists_p (tempname)))
{
Lisp_Object args[6];
@@ -225,13 +224,13 @@ get_boot_time (void)
If FILENAME is zero, use the same file as before;
if no FILENAME has ever been specified, this is the utmp file.
- Use the newest reboot record if NEWEST is nonzero,
+ Use the newest reboot record if NEWEST,
the first reboot record otherwise.
Ignore all reboot records on or before BOOT_TIME.
Success is indicated by setting BOOT_TIME to a larger value. */
void
-get_boot_time_1 (const char *filename, int newest)
+get_boot_time_1 (const char *filename, bool newest)
{
struct utmp ut, *utp;
int desc;
@@ -294,12 +293,13 @@ typedef struct
trailing period plus one for the digit after it plus one for the
null. */
#define MAKE_LOCK_NAME(lock, file) \
- (lock = (char *) alloca (SBYTES (file) + 2 + 1 + 1 + 1), \
+ (lock = alloca (SBYTES (file) + 2 + 1 + 1 + 1), \
fill_in_lock_file_name (lock, (file)))
static void
fill_in_lock_file_name (register char *lockfile, register Lisp_Object fn)
{
+ ptrdiff_t length = SBYTES (fn);
register char *p;
struct stat st;
int count = 0;
@@ -309,14 +309,14 @@ fill_in_lock_file_name (register char *lockfile, register Lisp_Object fn)
/* Shift the nondirectory part of the file name (including the null)
right two characters. Here is one of the places where we'd have to
do something to support 14-character-max file names. */
- for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--)
+ for (p = lockfile + length; p != lockfile && *p != '/'; p--)
p[2] = *p;
/* Insert the `.#'. */
p[1] = '.';
p[2] = '#';
- p = p + strlen (p);
+ p = p + length + 2;
while (lstat (lockfile, &st) == 0 && !S_ISLNK (st.st_mode))
{
@@ -330,37 +330,28 @@ fill_in_lock_file_name (register char *lockfile, register Lisp_Object fn)
}
/* Lock the lock file named LFNAME.
- If FORCE is nonzero, we do so even if it is already locked.
- Return 1 if successful, 0 if not. */
+ If FORCE, do so even if it is already locked.
+ Return true if successful. */
-static int
-lock_file_1 (char *lfname, int force)
+static bool
+lock_file_1 (char *lfname, bool force)
{
- register int err;
- printmax_t boot, pid;
- const char *user_name;
- const char *host_name;
- char *lock_info_str;
- ptrdiff_t lock_info_size;
+ int err;
int symlink_errno;
USE_SAFE_ALLOCA;
/* Call this first because it can GC. */
- boot = get_boot_time ();
-
- if (STRINGP (Fuser_login_name (Qnil)))
- user_name = SSDATA (Fuser_login_name (Qnil));
- else
- user_name = "";
- if (STRINGP (Fsystem_name ()))
- host_name = SSDATA (Fsystem_name ());
- else
- host_name = "";
- lock_info_size = (strlen (user_name) + strlen (host_name)
- + 2 * INT_STRLEN_BOUND (printmax_t)
- + sizeof "@.:");
- SAFE_ALLOCA (lock_info_str, char *, lock_info_size);
- pid = getpid ();
+ printmax_t boot = get_boot_time ();
+
+ Lisp_Object luser_name = Fuser_login_name (Qnil);
+ char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : "";
+ Lisp_Object lhost_name = Fsystem_name ();
+ char const *host_name = STRINGP (lhost_name) ? SSDATA (lhost_name) : "";
+ ptrdiff_t lock_info_size = (strlen (user_name) + strlen (host_name)
+ + 2 * INT_STRLEN_BOUND (printmax_t)
+ + sizeof "@.:");
+ char *lock_info_str = SAFE_ALLOCA (lock_info_size);
+ printmax_t pid = getpid ();
esprintf (lock_info_str, boot ? "%s@%s.%"pMd":%"pMd : "%s@%s.%"pMd,
user_name, host_name, pid, boot);
@@ -378,9 +369,9 @@ lock_file_1 (char *lfname, int force)
return err == 0;
}
-/* Return 1 if times A and B are no more than one second apart. */
+/* Return true if times A and B are no more than one second apart. */
-static int
+static bool
within_one_second (time_t a, time_t b)
{
return (a - b >= -1 && a - b <= 1);
@@ -422,7 +413,7 @@ current_lock_owner (lock_info_type *owner, char *lfname)
return -1;
}
len = at - lfinfo;
- owner->user = (char *) xmalloc (len + 1);
+ owner->user = xmalloc (len + 1);
memcpy (owner->user, lfinfo, len);
owner->user[len] = 0;
@@ -449,7 +440,7 @@ current_lock_owner (lock_info_type *owner, char *lfname)
/* The host is everything in between. */
len = dot - at - 1;
- owner->host = (char *) xmalloc (len + 1);
+ owner->host = xmalloc (len + 1);
memcpy (owner->host, at + 1, len);
owner->host[len] = 0;
@@ -499,7 +490,7 @@ current_lock_owner (lock_info_type *owner, char *lfname)
static int
lock_if_free (lock_info_type *clasher, register char *lfname)
{
- while (lock_file_1 (lfname, 0) == 0)
+ while (! lock_file_1 (lfname, 0))
{
int locker;
@@ -550,6 +541,10 @@ lock_file (Lisp_Object fn)
struct gcpro gcpro1;
USE_SAFE_ALLOCA;
+ /* Don't do locking if the user has opted out. */
+ if (! create_lockfiles)
+ return;
+
/* Don't do locking while dumping Emacs.
Uncompressing wtmp files uses call-process, which does not work
in an uninitialized Emacs. */
@@ -588,7 +583,7 @@ lock_file (Lisp_Object fn)
locker_size = (strlen (lock_info.user) + strlen (lock_info.host)
+ INT_STRLEN_BOUND (printmax_t)
+ sizeof "@ (pid )");
- SAFE_ALLOCA (locker, char *, locker_size);
+ locker = SAFE_ALLOCA (locker_size);
pid = lock_info.pid;
esprintf (locker, "%s@%s (pid %"pMd")",
lock_info.user, lock_info.host, pid);
@@ -703,15 +698,6 @@ t if it is locked by you, else a string saying which user has locked it. */)
return ret;
}
-
-/* Initialization functions. */
-
-void
-init_filelock (void)
-{
- boot_time = 0;
- boot_time_initialized = 0;
-}
#endif /* CLASH_DETECTION */
@@ -722,6 +708,10 @@ syms_of_filelock (void)
doc: /* The directory for writing temporary files. */);
Vtemporary_file_directory = Qnil;
+ DEFVAR_BOOL ("create-lockfiles", create_lockfiles,
+ doc: /* Non-nil means use lockfiles to avoid editing collisions. */);
+ create_lockfiles = 1;
+
#ifdef CLASH_DETECTION
defsubr (&Sunlock_buffer);
defsubr (&Slock_buffer);
diff --git a/src/firstfile.c b/src/firstfile.c
index 98933b26c7e..444fb71b55d 100644
--- a/src/firstfile.c
+++ b/src/firstfile.c
@@ -1,5 +1,5 @@
/* Mark beginning of data space to dump as pure, for GNU Emacs.
- Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -27,7 +27,6 @@ static char _my_begbss[1];
char * my_begbss_static = _my_begbss;
/* Add a dummy reference to ensure emacs.obj is linked in. */
-extern int initialized;
-static int * dummy = &initialized;
+extern int main (int, char **);
+static int (*dummy) (int, char **) = main;
#endif
-
diff --git a/src/floatfns.c b/src/floatfns.c
index 2011b4d942d..645a5957609 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -1,6 +1,6 @@
/* Primitive operations on floating point for GNU Emacs Lisp interpreter.
-Copyright (C) 1988, 1993-1994, 1999, 2001-2011
+Copyright (C) 1988, 1993-1994, 1999, 2001-2012
Free Software Foundation, Inc.
Author: Wolfgang Rupprecht
@@ -22,171 +22,23 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-/* ANSI C requires only these float functions:
- acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod,
- frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh.
-
- Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh.
- Define HAVE_CBRT if you have cbrt.
- Define HAVE_RINT if you have a working rint.
- If you don't define these, then the appropriate routines will be simulated.
-
- Define HAVE_MATHERR if on a system supporting the SysV matherr callback.
- (This should happen automatically.)
-
- Define FLOAT_CHECK_ERRNO if the float library routines set errno.
- This has no effect if HAVE_MATHERR is defined.
-
- Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL.
- (What systems actually do this? Please let us know.)
-
- Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by
- either setting errno, or signaling SIGFPE/SIGILL. Otherwise, domain and
- range checking will happen before calling the float routines. This has
- no effect if HAVE_MATHERR is defined (since matherr will be called when
- a domain error occurs.)
+/* C89 requires only the following math.h functions, and Emacs omits
+ the starred functions since we haven't found a use for them:
+ acos, asin, atan, atan2, ceil, cos, *cosh, exp, fabs, floor, fmod,
+ frexp, ldexp, log, log10, *modf, pow, sin, *sinh, sqrt, tan, *tanh.
*/
#include <config.h>
-#include <signal.h>
-#include <setjmp.h>
+
#include "lisp.h"
-#include "syssignal.h"
-
-#include <float.h>
-/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
-#ifndef IEEE_FLOATING_POINT
-#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
- && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
-#define IEEE_FLOATING_POINT 1
-#else
-#define IEEE_FLOATING_POINT 0
-#endif
-#endif
#include <math.h>
-/* This declaration is omitted on some systems, like Ultrix. */
-#if !defined (HPUX) && defined (HAVE_LOGB) && !defined (logb)
-extern double logb (double);
-#endif /* not HPUX and HAVE_LOGB and no logb macro */
-
-#if defined (DOMAIN) && defined (SING) && defined (OVERFLOW)
- /* If those are defined, then this is probably a `matherr' machine. */
-# ifndef HAVE_MATHERR
-# define HAVE_MATHERR
-# endif
-#endif
-
-#ifdef NO_MATHERR
-#undef HAVE_MATHERR
-#endif
-
-#ifdef HAVE_MATHERR
-# ifdef FLOAT_CHECK_ERRNO
-# undef FLOAT_CHECK_ERRNO
-# endif
-# ifdef FLOAT_CHECK_DOMAIN
-# undef FLOAT_CHECK_DOMAIN
-# endif
+#ifndef isfinite
+# define isfinite(x) ((x) - (x) == 0)
#endif
-
-#ifndef NO_FLOAT_CHECK_ERRNO
-#define FLOAT_CHECK_ERRNO
-#endif
-
-#ifdef FLOAT_CHECK_ERRNO
-# include <errno.h>
-#endif
-
-#ifdef FLOAT_CATCH_SIGILL
-static void float_error ();
-#endif
-
-/* Nonzero while executing in floating point.
- This tells float_error what to do. */
-
-static int in_float;
-
-/* If an argument is out of range for a mathematical function,
- here is the actual argument value to use in the error message.
- These variables are used only across the floating point library call
- so there is no need to staticpro them. */
-
-static Lisp_Object float_error_arg, float_error_arg2;
-
-static const char *float_error_fn_name;
-
-/* Evaluate the floating point expression D, recording NUM
- as the original argument for error messages.
- D is normally an assignment expression.
- Handle errors which may result in signals or may set errno.
-
- Note that float_error may be declared to return void, so you can't
- just cast the zero after the colon to (void) to make the types
- check properly. */
-
-#ifdef FLOAT_CHECK_ERRNO
-#define IN_FLOAT(d, name, num) \
- do { \
- float_error_arg = num; \
- float_error_fn_name = name; \
- in_float = 1; errno = 0; (d); in_float = 0; \
- switch (errno) { \
- case 0: break; \
- case EDOM: domain_error (float_error_fn_name, float_error_arg); \
- case ERANGE: range_error (float_error_fn_name, float_error_arg); \
- default: arith_error (float_error_fn_name, float_error_arg); \
- } \
- } while (0)
-#define IN_FLOAT2(d, name, num, num2) \
- do { \
- float_error_arg = num; \
- float_error_arg2 = num2; \
- float_error_fn_name = name; \
- in_float = 1; errno = 0; (d); in_float = 0; \
- switch (errno) { \
- case 0: break; \
- case EDOM: domain_error (float_error_fn_name, float_error_arg); \
- case ERANGE: range_error (float_error_fn_name, float_error_arg); \
- default: arith_error (float_error_fn_name, float_error_arg); \
- } \
- } while (0)
-#else
-#define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0)
-#define IN_FLOAT2(d, name, num, num2) (in_float = 1, (d), in_float = 0)
-#endif
-
-/* Convert float to Lisp_Int if it fits, else signal a range error
- using the given arguments. */
-#define FLOAT_TO_INT(x, i, name, num) \
- do \
- { \
- if (FIXNUM_OVERFLOW_P (x)) \
- range_error (name, num); \
- XSETINT (i, (EMACS_INT)(x)); \
- } \
- while (0)
-#define FLOAT_TO_INT2(x, i, name, num1, num2) \
- do \
- { \
- if (FIXNUM_OVERFLOW_P (x)) \
- range_error2 (name, num1, num2); \
- XSETINT (i, (EMACS_INT)(x)); \
- } \
- while (0)
-
-#define arith_error(op,arg) \
- xsignal2 (Qarith_error, build_string ((op)), (arg))
-#define range_error(op,arg) \
- xsignal2 (Qrange_error, build_string ((op)), (arg))
-#define range_error2(op,a1,a2) \
- xsignal3 (Qrange_error, build_string ((op)), (a1), (a2))
-#define domain_error(op,arg) \
- xsignal2 (Qdomain_error, build_string ((op)), (arg))
-#ifdef FLOAT_CHECK_DOMAIN
-#define domain_error2(op,a1,a2) \
- xsignal3 (Qdomain_error, build_string ((op)), (a1), (a2))
+#ifndef isnan
+# define isnan(x) ((x) != (x))
#endif
/* Extract a Lisp number as a `double', or signal an error. */
@@ -205,27 +57,19 @@ extract_float (Lisp_Object num)
DEFUN ("acos", Facos, Sacos, 1, 1, 0,
doc: /* Return the inverse cosine of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d > 1.0 || d < -1.0)
- domain_error ("acos", arg);
-#endif
- IN_FLOAT (d = acos (d), "acos", arg);
+ d = acos (d);
return make_float (d);
}
DEFUN ("asin", Fasin, Sasin, 1, 1, 0,
doc: /* Return the inverse sine of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d > 1.0 || d < -1.0)
- domain_error ("asin", arg);
-#endif
- IN_FLOAT (d = asin (d), "asin", arg);
+ d = asin (d);
return make_float (d);
}
@@ -235,56 +79,47 @@ If only one argument Y is given, return the inverse tangent of Y.
If two arguments Y and X are given, return the inverse tangent of Y
divided by X, i.e. the angle in radians between the vector (X, Y)
and the x-axis. */)
- (register Lisp_Object y, Lisp_Object x)
+ (Lisp_Object y, Lisp_Object x)
{
double d = extract_float (y);
if (NILP (x))
- IN_FLOAT (d = atan (d), "atan", y);
+ d = atan (d);
else
{
double d2 = extract_float (x);
-
- IN_FLOAT2 (d = atan2 (d, d2), "atan", y, x);
+ d = atan2 (d, d2);
}
return make_float (d);
}
DEFUN ("cos", Fcos, Scos, 1, 1, 0,
doc: /* Return the cosine of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- IN_FLOAT (d = cos (d), "cos", arg);
+ d = cos (d);
return make_float (d);
}
DEFUN ("sin", Fsin, Ssin, 1, 1, 0,
doc: /* Return the sine of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- IN_FLOAT (d = sin (d), "sin", arg);
+ d = sin (d);
return make_float (d);
}
DEFUN ("tan", Ftan, Stan, 1, 1, 0,
doc: /* Return the tangent of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- double c = cos (d);
-#ifdef FLOAT_CHECK_DOMAIN
- if (c == 0.0)
- domain_error ("tan", arg);
-#endif
- IN_FLOAT (d = sin (d) / c, "tan", arg);
+ d = tan (d);
return make_float (d);
}
-#undef isnan
-#define isnan(x) ((x) != (x))
-
DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0,
doc: /* Return non nil iff argument X is a NaN. */)
(Lisp_Object x)
@@ -294,7 +129,7 @@ DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0,
}
#ifdef HAVE_COPYSIGN
-DEFUN ("copysign", Fcopysign, Scopysign, 1, 2, 0,
+DEFUN ("copysign", Fcopysign, Scopysign, 2, 2, 0,
doc: /* Copy sign of X2 to value of X1, and return the result.
Cause an error if X1 or X2 is not a float. */)
(Lisp_Object x1, Lisp_Object x2)
@@ -309,6 +144,7 @@ Cause an error if X1 or X2 is not a float. */)
return make_float (copysign (f1, f2));
}
+#endif
DEFUN ("frexp", Ffrexp, Sfrexp, 1, 1, 0,
doc: /* Get significand and exponent of a floating point number.
@@ -323,15 +159,9 @@ If X is zero, both parts (SGNFCAND and EXP) are zero. */)
(Lisp_Object x)
{
double f = XFLOATINT (x);
-
- if (f == 0.0)
- return Fcons (make_float (0.0), make_number (0));
- else
- {
- int exponent;
- double sgnfcand = frexp (f, &exponent);
- return Fcons (make_float (sgnfcand), make_number (exponent));
- }
+ int exponent;
+ double sgnfcand = frexp (f, &exponent);
+ return Fcons (make_float (sgnfcand), make_number (exponent));
}
DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0,
@@ -343,138 +173,19 @@ Returns the floating point value resulting from multiplying SGNFCAND
CHECK_NUMBER (exponent);
return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exponent)));
}
-#endif
-
-#if 0 /* Leave these out unless we find there's a reason for them. */
-
-DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0,
- doc: /* Return the bessel function j0 of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = j0 (d), "bessel-j0", arg);
- return make_float (d);
-}
-
-DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0,
- doc: /* Return the bessel function j1 of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = j1 (d), "bessel-j1", arg);
- return make_float (d);
-}
-
-DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0,
- doc: /* Return the order N bessel function output jn of ARG.
-The first arg (the order) is truncated to an integer. */)
- (register Lisp_Object n, Lisp_Object arg)
-{
- int i1 = extract_float (n);
- double f2 = extract_float (arg);
-
- IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", n);
- return make_float (f2);
-}
-
-DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0,
- doc: /* Return the bessel function y0 of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = y0 (d), "bessel-y0", arg);
- return make_float (d);
-}
-
-DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0,
- doc: /* Return the bessel function y1 of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = y1 (d), "bessel-y0", arg);
- return make_float (d);
-}
-
-DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0,
- doc: /* Return the order N bessel function output yn of ARG.
-The first arg (the order) is truncated to an integer. */)
- (register Lisp_Object n, Lisp_Object arg)
-{
- int i1 = extract_float (n);
- double f2 = extract_float (arg);
-
- IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", n);
- return make_float (f2);
-}
-
-#endif
-
-#if 0 /* Leave these out unless we see they are worth having. */
-
-DEFUN ("erf", Ferf, Serf, 1, 1, 0,
- doc: /* Return the mathematical error function of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = erf (d), "erf", arg);
- return make_float (d);
-}
-
-DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0,
- doc: /* Return the complementary error function of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = erfc (d), "erfc", arg);
- return make_float (d);
-}
-
-DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0,
- doc: /* Return the log gamma of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = lgamma (d), "log-gamma", arg);
- return make_float (d);
-}
-
-DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0,
- doc: /* Return the cube root of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef HAVE_CBRT
- IN_FLOAT (d = cbrt (d), "cube-root", arg);
-#else
- if (d >= 0.0)
- IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", arg);
- else
- IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", arg);
-#endif
- return make_float (d);
-}
-
-#endif
DEFUN ("exp", Fexp, Sexp, 1, 1, 0,
doc: /* Return the exponential base e of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d > 709.7827) /* Assume IEEE doubles here */
- range_error ("exp", arg);
- else if (d < -709.0)
- return make_float (0.0);
- else
-#endif
- IN_FLOAT (d = exp (d), "exp", arg);
+ d = exp (d);
return make_float (d);
}
DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
doc: /* Return the exponential ARG1 ** ARG2. */)
- (register Lisp_Object arg1, Lisp_Object arg2)
+ (Lisp_Object arg1, Lisp_Object arg2)
{
double f1, f2, f3;
@@ -484,190 +195,67 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
&& INTEGERP (arg2) /* don't promote, if both are ints, and */
&& 0 <= XINT (arg2)) /* we are sure the result is not fractional */
{ /* this can be improved by pre-calculating */
- EMACS_INT acc, x, y; /* some binary powers of x then accumulating */
+ EMACS_INT y; /* some binary powers of x then accumulating */
+ EMACS_UINT acc, x; /* Unsigned so that overflow is well defined. */
Lisp_Object val;
x = XINT (arg1);
y = XINT (arg2);
- acc = 1;
+ acc = (y & 1 ? x : 1);
- if (y < 0)
- {
- if (x == 1)
- acc = 1;
- else if (x == -1)
- acc = (y & 1) ? -1 : 1;
- else
- acc = 0;
- }
- else
+ while ((y >>= 1) != 0)
{
- while (y > 0)
- {
- if (y & 1)
- acc *= x;
- x *= x;
- y >>= 1;
- }
+ x *= x;
+ if (y & 1)
+ acc *= x;
}
XSETINT (val, acc);
return val;
}
f1 = FLOATP (arg1) ? XFLOAT_DATA (arg1) : XINT (arg1);
f2 = FLOATP (arg2) ? XFLOAT_DATA (arg2) : XINT (arg2);
- /* Really should check for overflow, too */
- if (f1 == 0.0 && f2 == 0.0)
- f1 = 1.0;
-#ifdef FLOAT_CHECK_DOMAIN
- else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor (f2)))
- domain_error2 ("expt", arg1, arg2);
-#endif
- IN_FLOAT2 (f3 = pow (f1, f2), "expt", arg1, arg2);
- /* Check for overflow in the result. */
- if (f1 != 0.0 && f3 == 0.0)
- range_error ("expt", arg1);
+ f3 = pow (f1, f2);
return make_float (f3);
}
DEFUN ("log", Flog, Slog, 1, 2, 0,
doc: /* Return the natural logarithm of ARG.
If the optional argument BASE is given, return log ARG using that base. */)
- (register Lisp_Object arg, Lisp_Object base)
+ (Lisp_Object arg, Lisp_Object base)
{
double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d <= 0.0)
- domain_error2 ("log", arg, base);
-#endif
if (NILP (base))
- IN_FLOAT (d = log (d), "log", arg);
+ d = log (d);
else
{
double b = extract_float (base);
-#ifdef FLOAT_CHECK_DOMAIN
- if (b <= 0.0 || b == 1.0)
- domain_error2 ("log", arg, base);
-#endif
if (b == 10.0)
- IN_FLOAT2 (d = log10 (d), "log", arg, base);
+ d = log10 (d);
else
- IN_FLOAT2 (d = log (d) / log (b), "log", arg, base);
+ d = log (d) / log (b);
}
return make_float (d);
}
DEFUN ("log10", Flog10, Slog10, 1, 1, 0,
doc: /* Return the logarithm base 10 of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d <= 0.0)
- domain_error ("log10", arg);
-#endif
- IN_FLOAT (d = log10 (d), "log10", arg);
+ d = log10 (d);
return make_float (d);
}
DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0,
doc: /* Return the square root of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d < 0.0)
- domain_error ("sqrt", arg);
-#endif
- IN_FLOAT (d = sqrt (d), "sqrt", arg);
- return make_float (d);
-}
-
-#if 0 /* Not clearly worth adding. */
-
-DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0,
- doc: /* Return the inverse hyperbolic cosine of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d < 1.0)
- domain_error ("acosh", arg);
-#endif
-#ifdef HAVE_INVERSE_HYPERBOLIC
- IN_FLOAT (d = acosh (d), "acosh", arg);
-#else
- IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", arg);
-#endif
- return make_float (d);
-}
-
-DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0,
- doc: /* Return the inverse hyperbolic sine of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef HAVE_INVERSE_HYPERBOLIC
- IN_FLOAT (d = asinh (d), "asinh", arg);
-#else
- IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", arg);
-#endif
- return make_float (d);
-}
-
-DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0,
- doc: /* Return the inverse hyperbolic tangent of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d >= 1.0 || d <= -1.0)
- domain_error ("atanh", arg);
-#endif
-#ifdef HAVE_INVERSE_HYPERBOLIC
- IN_FLOAT (d = atanh (d), "atanh", arg);
-#else
- IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", arg);
-#endif
- return make_float (d);
-}
-
-DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0,
- doc: /* Return the hyperbolic cosine of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d > 710.0 || d < -710.0)
- range_error ("cosh", arg);
-#endif
- IN_FLOAT (d = cosh (d), "cosh", arg);
- return make_float (d);
-}
-
-DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0,
- doc: /* Return the hyperbolic sine of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d > 710.0 || d < -710.0)
- range_error ("sinh", arg);
-#endif
- IN_FLOAT (d = sinh (d), "sinh", arg);
- return make_float (d);
-}
-
-DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0,
- doc: /* Return the hyperbolic tangent of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- IN_FLOAT (d = tanh (d), "tanh", arg);
+ d = sqrt (d);
return make_float (d);
}
-#endif
DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
doc: /* Return the absolute value of ARG. */)
@@ -676,7 +264,7 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
CHECK_NUMBER_OR_FLOAT (arg);
if (FLOATP (arg))
- IN_FLOAT (arg = make_float (fabs (XFLOAT_DATA (arg))), "abs", arg);
+ arg = make_float (fabs (XFLOAT_DATA (arg)));
else if (XINT (arg) < 0)
XSETINT (arg, - XINT (arg));
@@ -706,38 +294,15 @@ This is the same as the exponent of a float. */)
if (f == 0.0)
value = MOST_NEGATIVE_FIXNUM;
- else
+ else if (isfinite (f))
{
-#ifdef HAVE_LOGB
- IN_FLOAT (value = logb (f), "logb", arg);
-#else
-#ifdef HAVE_FREXP
int ivalue;
- IN_FLOAT (frexp (f, &ivalue), "logb", arg);
+ frexp (f, &ivalue);
value = ivalue - 1;
-#else
- int i;
- double d;
- if (f < 0.0)
- f = -f;
- value = -1;
- while (f < 0.5)
- {
- for (i = 1, d = 0.5; d * d >= f; i += i)
- d *= d;
- f /= d;
- value -= i;
- }
- while (f >= 1.0)
- {
- for (i = 1, d = 2.0; d * d <= f; i += i)
- d *= d;
- f /= d;
- value += i;
- }
-#endif
-#endif
}
+ else
+ value = MOST_POSITIVE_FIXNUM;
+
XSETINT (val, value);
return val;
}
@@ -768,8 +333,10 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
if (! IEEE_FLOATING_POINT && f2 == 0)
xsignal0 (Qarith_error);
- IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor);
- FLOAT_TO_INT2 (f1, arg, name, arg, divisor);
+ f1 = (*double_round) (f1 / f2);
+ if (FIXNUM_OVERFLOW_P (f1))
+ xsignal3 (Qrange_error, build_string (name), arg, divisor);
+ arg = make_number (f1);
return arg;
}
@@ -785,10 +352,10 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
if (FLOATP (arg))
{
- double d;
-
- IN_FLOAT (d = (*double_round) (XFLOAT_DATA (arg)), name, arg);
- FLOAT_TO_INT (d, arg, name, arg);
+ double d = (*double_round) (XFLOAT_DATA (arg));
+ if (FIXNUM_OVERFLOW_P (d))
+ xsignal2 (Qrange_error, build_string (name), arg);
+ arg = make_number (d);
}
return arg;
@@ -905,125 +472,57 @@ fmod_float (Lisp_Object x, Lisp_Object y)
f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x);
f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y);
- if (! IEEE_FLOATING_POINT && f2 == 0)
- xsignal0 (Qarith_error);
+ f1 = fmod (f1, f2);
/* If the "remainder" comes out with the wrong sign, fix it. */
- IN_FLOAT2 ((f1 = fmod (f1, f2),
- f1 = (f2 < 0 ? f1 > 0 : f1 < 0) ? f1 + f2 : f1),
- "mod", x, y);
+ if (f2 < 0 ? 0 < f1 : f1 < 0)
+ f1 += f2;
+
return make_float (f1);
}
-/* It's not clear these are worth adding. */
-
DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0,
doc: /* Return the smallest integer no less than ARG, as a float.
\(Round toward +inf.\) */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- IN_FLOAT (d = ceil (d), "fceiling", arg);
+ d = ceil (d);
return make_float (d);
}
DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0,
doc: /* Return the largest integer no greater than ARG, as a float.
\(Round towards -inf.\) */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- IN_FLOAT (d = floor (d), "ffloor", arg);
+ d = floor (d);
return make_float (d);
}
DEFUN ("fround", Ffround, Sfround, 1, 1, 0,
doc: /* Return the nearest integer to ARG, as a float. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- IN_FLOAT (d = emacs_rint (d), "fround", arg);
+ d = emacs_rint (d);
return make_float (d);
}
DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0,
doc: /* Truncate a floating point number to an integral float value.
Rounds the value toward zero. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
if (d >= 0.0)
- IN_FLOAT (d = floor (d), "ftruncate", arg);
+ d = floor (d);
else
- IN_FLOAT (d = ceil (d), "ftruncate", arg);
+ d = ceil (d);
return make_float (d);
}
-#ifdef FLOAT_CATCH_SIGILL
-static void
-float_error (int signo)
-{
- if (! in_float)
- fatal_error_signal (signo);
-
-#ifdef BSD_SYSTEM
- sigsetmask (SIGEMPTYMASK);
-#else
- /* Must reestablish handler each time it is called. */
- signal (SIGILL, float_error);
-#endif /* BSD_SYSTEM */
-
- SIGNAL_THREAD_CHECK (signo);
- in_float = 0;
-
- xsignal1 (Qarith_error, float_error_arg);
-}
-
-/* Another idea was to replace the library function `infnan'
- where SIGILL is signaled. */
-
-#endif /* FLOAT_CATCH_SIGILL */
-
-#ifdef HAVE_MATHERR
-int
-matherr (struct exception *x)
-{
- Lisp_Object args;
- const char *name = x->name;
-
- if (! in_float)
- /* Not called from emacs-lisp float routines; do the default thing. */
- return 0;
- if (!strcmp (x->name, "pow"))
- name = "expt";
-
- args
- = Fcons (build_string (name),
- Fcons (make_float (x->arg1),
- ((!strcmp (name, "log") || !strcmp (name, "pow"))
- ? Fcons (make_float (x->arg2), Qnil)
- : Qnil)));
- switch (x->type)
- {
- case DOMAIN: xsignal (Qdomain_error, args); break;
- case SING: xsignal (Qsingularity_error, args); break;
- case OVERFLOW: xsignal (Qoverflow_error, args); break;
- case UNDERFLOW: xsignal (Qunderflow_error, args); break;
- default: xsignal (Qarith_error, args); break;
- }
- return (1); /* don't set errno or print a message */
-}
-#endif /* HAVE_MATHERR */
-
-void
-init_floatfns (void)
-{
-#ifdef FLOAT_CATCH_SIGILL
- signal (SIGILL, float_error);
-#endif
- in_float = 0;
-}
-
void
syms_of_floatfns (void)
{
@@ -1036,27 +535,9 @@ syms_of_floatfns (void)
defsubr (&Sisnan);
#ifdef HAVE_COPYSIGN
defsubr (&Scopysign);
+#endif
defsubr (&Sfrexp);
defsubr (&Sldexp);
-#endif
-#if 0
- defsubr (&Sacosh);
- defsubr (&Sasinh);
- defsubr (&Satanh);
- defsubr (&Scosh);
- defsubr (&Ssinh);
- defsubr (&Stanh);
- defsubr (&Sbessel_y0);
- defsubr (&Sbessel_y1);
- defsubr (&Sbessel_yn);
- defsubr (&Sbessel_j0);
- defsubr (&Sbessel_j1);
- defsubr (&Sbessel_jn);
- defsubr (&Serf);
- defsubr (&Serfc);
- defsubr (&Slog_gamma);
- defsubr (&Scube_root);
-#endif
defsubr (&Sfceiling);
defsubr (&Sffloor);
defsubr (&Sfround);
diff --git a/src/fns.c b/src/fns.c
index 04b51d10d9b..7c2222e9805 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1,5 +1,5 @@
/* Random utility Lisp functions.
- Copyright (C) 1985-1987, 1993-1995, 1997-2011
+ Copyright (C) 1985-1987, 1993-1995, 1997-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,7 +21,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <unistd.h>
#include <time.h>
-#include <setjmp.h>
#include <intprops.h>
@@ -42,10 +41,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#endif /* HAVE_MENUS */
-#ifndef NULL
-#define NULL ((POINTER_TYPE *)0)
-#endif
-
Lisp_Object Qstring_lessp;
static Lisp_Object Qprovide, Qrequire;
static Lisp_Object Qyes_or_no_p_history;
@@ -55,11 +50,7 @@ static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512;
-static int internal_equal (Lisp_Object , Lisp_Object, int, int);
-
-#ifndef HAVE_UNISTD_H
-extern long time ();
-#endif
+static bool internal_equal (Lisp_Object, Lisp_Object, int, bool);
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
doc: /* Return the argument unchanged. */)
@@ -70,41 +61,25 @@ DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
DEFUN ("random", Frandom, Srandom, 0, 1, 0,
doc: /* Return a pseudo-random number.
-All integers representable in Lisp are equally likely.
- On most systems, this is 29 bits' worth.
+All integers representable in Lisp, i.e. between `most-negative-fixnum'
+and `most-positive-fixnum', inclusive, are equally likely.
+
With positive integer LIMIT, return random number in interval [0,LIMIT).
With argument t, set the random number seed from the current time and pid.
Other values of LIMIT are ignored. */)
(Lisp_Object limit)
{
EMACS_INT val;
- Lisp_Object lispy_val;
if (EQ (limit, Qt))
- {
- EMACS_TIME t;
- EMACS_GET_TIME (t);
- seed_random (getpid () ^ EMACS_SECS (t) ^ EMACS_USECS (t));
- }
+ init_random ();
+ else if (STRINGP (limit))
+ seed_random (SSDATA (limit), SBYTES (limit));
+ val = get_random ();
if (NATNUMP (limit) && XFASTINT (limit) != 0)
- {
- /* Try to take our random number from the higher bits of VAL,
- not the lower, since (says Gentzel) the low bits of `random'
- are less random than the higher ones. We do this by using the
- quotient rather than the remainder. At the high end of the RNG
- it's possible to get a quotient larger than n; discarding
- these values eliminates the bias that would otherwise appear
- when using a large n. */
- EMACS_INT denominator = (INTMASK + 1) / XFASTINT (limit);
- do
- val = get_random () / denominator;
- while (val >= XFASTINT (limit));
- }
- else
- val = get_random ();
- XSETINT (lispy_val, val);
- return lispy_val;
+ val %= XFASTINT (limit);
+ return make_number (val);
}
/* Heuristic on how many iterations of a tight loop can be safely done
@@ -250,8 +225,8 @@ If string STR1 is greater, the value is a positive number N;
N - 1 is the number of characters that match at the beginning. */)
(Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case)
{
- register EMACS_INT end1_char, end2_char;
- register EMACS_INT i1, i1_byte, i2, i2_byte;
+ register ptrdiff_t end1_char, end2_char;
+ register ptrdiff_t i1, i1_byte, i2, i2_byte;
CHECK_STRING (str1);
CHECK_STRING (str2);
@@ -266,19 +241,23 @@ If string STR1 is greater, the value is a positive number N;
if (! NILP (end2))
CHECK_NATNUM (end2);
- i1 = XINT (start1);
- i2 = XINT (start2);
-
- i1_byte = string_char_to_byte (str1, i1);
- i2_byte = string_char_to_byte (str2, i2);
-
end1_char = SCHARS (str1);
if (! NILP (end1) && end1_char > XINT (end1))
end1_char = XINT (end1);
+ if (end1_char < XINT (start1))
+ args_out_of_range (str1, start1);
end2_char = SCHARS (str2);
if (! NILP (end2) && end2_char > XINT (end2))
end2_char = XINT (end2);
+ if (end2_char < XINT (start2))
+ args_out_of_range (str2, start2);
+
+ i1 = XINT (start1);
+ i2 = XINT (start2);
+
+ i1_byte = string_char_to_byte (str1, i1);
+ i2_byte = string_char_to_byte (str2, i2);
while (i1 < end1_char && i2 < end2_char)
{
@@ -341,8 +320,8 @@ Case is significant.
Symbols are also allowed; their print names are used instead. */)
(register Lisp_Object s1, Lisp_Object s2)
{
- register EMACS_INT end;
- register EMACS_INT i1, i1_byte, i2, i2_byte;
+ register ptrdiff_t end;
+ register ptrdiff_t i1, i1_byte, i2, i2_byte;
if (SYMBOLP (s1))
s1 = SYMBOL_NAME (s1);
@@ -373,7 +352,7 @@ Symbols are also allowed; their print names are used instead. */)
}
static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
- enum Lisp_Type target_type, int last_special);
+ enum Lisp_Type target_type, bool last_special);
/* ARGSUSED */
Lisp_Object
@@ -465,25 +444,25 @@ with the original. */)
struct textprop_rec
{
ptrdiff_t argnum; /* refer to ARGS (arguments of `concat') */
- EMACS_INT from; /* refer to ARGS[argnum] (argument string) */
- EMACS_INT to; /* refer to VAL (the target string) */
+ ptrdiff_t from; /* refer to ARGS[argnum] (argument string) */
+ ptrdiff_t to; /* refer to VAL (the target string) */
};
static Lisp_Object
concat (ptrdiff_t nargs, Lisp_Object *args,
- enum Lisp_Type target_type, int last_special)
+ enum Lisp_Type target_type, bool last_special)
{
Lisp_Object val;
- register Lisp_Object tail;
- register Lisp_Object this;
- EMACS_INT toindex;
- EMACS_INT toindex_byte = 0;
- register EMACS_INT result_len;
- register EMACS_INT result_len_byte;
+ Lisp_Object tail;
+ Lisp_Object this;
+ ptrdiff_t toindex;
+ ptrdiff_t toindex_byte = 0;
+ EMACS_INT result_len;
+ EMACS_INT result_len_byte;
ptrdiff_t argnum;
Lisp_Object last_tail;
Lisp_Object prev;
- int some_multibyte;
+ bool some_multibyte;
/* When we make a multibyte string, we can't copy text properties
while concatenating each string because the length of resulting
string can't be decided until we finish the whole concatenation.
@@ -530,10 +509,10 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
{
/* We must count the number of bytes needed in the string
as well as the number of characters. */
- EMACS_INT i;
+ ptrdiff_t i;
Lisp_Object ch;
int c;
- EMACS_INT this_len_byte;
+ ptrdiff_t this_len_byte;
if (VECTORP (this) || COMPILEDP (this))
for (i = 0; i < len; i++)
@@ -542,6 +521,8 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
CHECK_CHARACTER (ch);
c = XFASTINT (ch);
this_len_byte = CHAR_BYTES (c);
+ if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
+ string_overflow ();
result_len_byte += this_len_byte;
if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
some_multibyte = 1;
@@ -555,6 +536,8 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
CHECK_CHARACTER (ch);
c = XFASTINT (ch);
this_len_byte = CHAR_BYTES (c);
+ if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
+ string_overflow ();
result_len_byte += this_len_byte;
if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
some_multibyte = 1;
@@ -564,17 +547,20 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
if (STRING_MULTIBYTE (this))
{
some_multibyte = 1;
- result_len_byte += SBYTES (this);
+ this_len_byte = SBYTES (this);
}
else
- result_len_byte += count_size_as_multibyte (SDATA (this),
- SCHARS (this));
+ this_len_byte = count_size_as_multibyte (SDATA (this),
+ SCHARS (this));
+ if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
+ string_overflow ();
+ result_len_byte += this_len_byte;
}
}
result_len += len;
- if (STRING_BYTES_BOUND < result_len)
- string_overflow ();
+ if (MOST_POSITIVE_FIXNUM < result_len)
+ memory_full (SIZE_MAX);
}
if (! some_multibyte)
@@ -607,9 +593,9 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
for (argnum = 0; argnum < nargs; argnum++)
{
Lisp_Object thislen;
- EMACS_INT thisleni = 0;
- register EMACS_INT thisindex = 0;
- register EMACS_INT thisindex_byte = 0;
+ ptrdiff_t thisleni = 0;
+ register ptrdiff_t thisindex = 0;
+ register ptrdiff_t thisindex_byte = 0;
this = args[argnum];
if (!CONSP (this))
@@ -619,10 +605,10 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
if (STRINGP (this) && STRINGP (val)
&& STRING_MULTIBYTE (this) == some_multibyte)
{
- EMACS_INT thislen_byte = SBYTES (this);
+ ptrdiff_t thislen_byte = SBYTES (this);
memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this));
- if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
+ if (string_intervals (this))
{
textprops[num_textprops].argnum = argnum;
textprops[num_textprops].from = 0;
@@ -634,7 +620,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
/* Copy a single-byte string to a multibyte string. */
else if (STRINGP (this) && STRINGP (val))
{
- if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
+ if (string_intervals (this))
{
textprops[num_textprops].argnum = argnum;
textprops[num_textprops].from = 0;
@@ -720,7 +706,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
if (num_textprops > 0)
{
Lisp_Object props;
- EMACS_INT last_to_end = -1;
+ ptrdiff_t last_to_end = -1;
for (argnum = 0; argnum < num_textprops; argnum++)
{
@@ -744,8 +730,8 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
}
static Lisp_Object string_char_byte_cache_string;
-static EMACS_INT string_char_byte_cache_charpos;
-static EMACS_INT string_char_byte_cache_bytepos;
+static ptrdiff_t string_char_byte_cache_charpos;
+static ptrdiff_t string_char_byte_cache_bytepos;
void
clear_string_char_byte_cache (void)
@@ -755,12 +741,12 @@ clear_string_char_byte_cache (void)
/* Return the byte index corresponding to CHAR_INDEX in STRING. */
-EMACS_INT
-string_char_to_byte (Lisp_Object string, EMACS_INT char_index)
+ptrdiff_t
+string_char_to_byte (Lisp_Object string, ptrdiff_t char_index)
{
- EMACS_INT i_byte;
- EMACS_INT best_below, best_below_byte;
- EMACS_INT best_above, best_above_byte;
+ ptrdiff_t i_byte;
+ ptrdiff_t best_below, best_below_byte;
+ ptrdiff_t best_above, best_above_byte;
best_below = best_below_byte = 0;
best_above = SCHARS (string);
@@ -815,12 +801,12 @@ string_char_to_byte (Lisp_Object string, EMACS_INT char_index)
/* Return the character index corresponding to BYTE_INDEX in STRING. */
-EMACS_INT
-string_byte_to_char (Lisp_Object string, EMACS_INT byte_index)
+ptrdiff_t
+string_byte_to_char (Lisp_Object string, ptrdiff_t byte_index)
{
- EMACS_INT i, i_byte;
- EMACS_INT best_below, best_below_byte;
- EMACS_INT best_above, best_above_byte;
+ ptrdiff_t i, i_byte;
+ ptrdiff_t best_below, best_below_byte;
+ ptrdiff_t best_above, best_above_byte;
best_below = best_below_byte = 0;
best_above = SCHARS (string);
@@ -883,7 +869,7 @@ static Lisp_Object
string_make_multibyte (Lisp_Object string)
{
unsigned char *buf;
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
Lisp_Object ret;
USE_SAFE_ALLOCA;
@@ -897,7 +883,7 @@ string_make_multibyte (Lisp_Object string)
if (nbytes == SBYTES (string))
return string;
- SAFE_ALLOCA (buf, unsigned char *, nbytes);
+ buf = SAFE_ALLOCA (nbytes);
copy_text (SDATA (string), buf, SBYTES (string),
0, 1);
@@ -916,7 +902,7 @@ Lisp_Object
string_to_multibyte (Lisp_Object string)
{
unsigned char *buf;
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
Lisp_Object ret;
USE_SAFE_ALLOCA;
@@ -929,7 +915,7 @@ string_to_multibyte (Lisp_Object string)
if (nbytes == SBYTES (string))
return make_multibyte_string (SSDATA (string), nbytes, nbytes);
- SAFE_ALLOCA (buf, unsigned char *, nbytes);
+ buf = SAFE_ALLOCA (nbytes);
memcpy (buf, SDATA (string), SBYTES (string));
str_to_multibyte (buf, nbytes, SBYTES (string));
@@ -945,7 +931,7 @@ string_to_multibyte (Lisp_Object string)
Lisp_Object
string_make_unibyte (Lisp_Object string)
{
- EMACS_INT nchars;
+ ptrdiff_t nchars;
unsigned char *buf;
Lisp_Object ret;
USE_SAFE_ALLOCA;
@@ -955,7 +941,7 @@ string_make_unibyte (Lisp_Object string)
nchars = SCHARS (string);
- SAFE_ALLOCA (buf, unsigned char *, nchars);
+ buf = SAFE_ALLOCA (nchars);
copy_text (SDATA (string), buf, SBYTES (string),
1, 0);
@@ -1010,8 +996,8 @@ If STRING is multibyte and contains a character of charset
if (STRING_MULTIBYTE (string))
{
- EMACS_INT bytes = SBYTES (string);
- unsigned char *str = (unsigned char *) xmalloc (bytes);
+ ptrdiff_t bytes = SBYTES (string);
+ unsigned char *str = xmalloc (bytes);
memcpy (str, SDATA (string), bytes);
bytes = str_as_unibyte (str, bytes);
@@ -1043,7 +1029,7 @@ If you're not sure, whether to use `string-as-multibyte' or
if (! STRING_MULTIBYTE (string))
{
Lisp_Object new_string;
- EMACS_INT nchars, nbytes;
+ ptrdiff_t nchars, nbytes;
parse_str_as_multibyte (SDATA (string),
SBYTES (string),
@@ -1054,7 +1040,7 @@ If you're not sure, whether to use `string-as-multibyte' or
str_as_multibyte (SDATA (new_string), nbytes,
SBYTES (string), NULL);
string = new_string;
- STRING_SET_INTERVALS (string, NULL_INTERVAL);
+ set_string_intervals (string, NULL);
}
return string;
}
@@ -1092,12 +1078,12 @@ an error is signaled. */)
if (STRING_MULTIBYTE (string))
{
- EMACS_INT chars = SCHARS (string);
- unsigned char *str = (unsigned char *) xmalloc (chars);
- EMACS_INT converted = str_to_unibyte (SDATA (string), str, chars, 0);
+ ptrdiff_t chars = SCHARS (string);
+ unsigned char *str = xmalloc (chars);
+ ptrdiff_t converted = str_to_unibyte (SDATA (string), str, chars);
if (converted < chars)
- error ("Can't convert the %"pI"dth character to unibyte", converted);
+ error ("Can't convert the %"pD"dth character to unibyte", converted);
string = make_unibyte_string ((char *) str, chars);
xfree (str);
}
@@ -1145,27 +1131,19 @@ value is a new vector that contains the elements between index FROM
(Lisp_Object string, register Lisp_Object from, Lisp_Object to)
{
Lisp_Object res;
- EMACS_INT size;
- EMACS_INT size_byte = 0;
+ ptrdiff_t size;
EMACS_INT from_char, to_char;
- EMACS_INT from_byte = 0, to_byte = 0;
CHECK_VECTOR_OR_STRING (string);
CHECK_NUMBER (from);
if (STRINGP (string))
- {
- size = SCHARS (string);
- size_byte = SBYTES (string);
- }
+ size = SCHARS (string);
else
size = ASIZE (string);
if (NILP (to))
- {
- to_char = size;
- to_byte = size_byte;
- }
+ to_char = size;
else
{
CHECK_NUMBER (to);
@@ -1173,23 +1151,20 @@ value is a new vector that contains the elements between index FROM
to_char = XINT (to);
if (to_char < 0)
to_char += size;
-
- if (STRINGP (string))
- to_byte = string_char_to_byte (string, to_char);
}
from_char = XINT (from);
if (from_char < 0)
from_char += size;
- if (STRINGP (string))
- from_byte = string_char_to_byte (string, from_char);
-
if (!(0 <= from_char && from_char <= to_char && to_char <= size))
args_out_of_range_3 (string, make_number (from_char),
make_number (to_char));
if (STRINGP (string))
{
+ ptrdiff_t to_byte =
+ (NILP (to) ? SBYTES (string) : string_char_to_byte (string, to_char));
+ ptrdiff_t from_byte = string_char_to_byte (string, from_char);
res = make_specified_string (SSDATA (string) + from_byte,
to_char - from_char, to_byte - from_byte,
STRING_MULTIBYTE (string));
@@ -1197,7 +1172,7 @@ value is a new vector that contains the elements between index FROM
string, make_number (0), res, Qnil);
}
else
- res = Fvector (to_char - from_char, &AREF (string, from_char));
+ res = Fvector (to_char - from_char, aref_addr (string, from_char));
return res;
}
@@ -1213,47 +1188,41 @@ If FROM or TO is negative, it counts from the end.
With one argument, just copy STRING without its properties. */)
(Lisp_Object string, register Lisp_Object from, Lisp_Object to)
{
- EMACS_INT size, size_byte;
+ ptrdiff_t size;
EMACS_INT from_char, to_char;
- EMACS_INT from_byte, to_byte;
+ ptrdiff_t from_byte, to_byte;
CHECK_STRING (string);
size = SCHARS (string);
- size_byte = SBYTES (string);
if (NILP (from))
- from_char = from_byte = 0;
+ from_char = 0;
else
{
CHECK_NUMBER (from);
from_char = XINT (from);
if (from_char < 0)
from_char += size;
-
- from_byte = string_char_to_byte (string, from_char);
}
if (NILP (to))
- {
- to_char = size;
- to_byte = size_byte;
- }
+ to_char = size;
else
{
CHECK_NUMBER (to);
-
to_char = XINT (to);
if (to_char < 0)
to_char += size;
-
- to_byte = string_char_to_byte (string, to_char);
}
if (!(0 <= from_char && from_char <= to_char && to_char <= size))
args_out_of_range_3 (string, make_number (from_char),
make_number (to_char));
+ from_byte = NILP (from) ? 0 : string_char_to_byte (string, from_char);
+ to_byte =
+ NILP (to) ? SBYTES (string) : string_char_to_byte (string, to_char);
return make_specified_string (SSDATA (string) + from_byte,
to_char - from_char, to_byte - from_byte,
STRING_MULTIBYTE (string));
@@ -1263,11 +1232,11 @@ With one argument, just copy STRING without its properties. */)
both in characters and in bytes. */
Lisp_Object
-substring_both (Lisp_Object string, EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte)
+substring_both (Lisp_Object string, ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte)
{
Lisp_Object res;
- EMACS_INT size;
+ ptrdiff_t size;
CHECK_VECTOR_OR_STRING (string);
@@ -1285,7 +1254,7 @@ substring_both (Lisp_Object string, EMACS_INT from, EMACS_INT from_byte,
string, make_number (0), res, Qnil);
}
else
- res = Fvector (to - from, &AREF (string, from));
+ res = Fvector (to - from, aref_addr (string, from));
return res;
}
@@ -1558,11 +1527,14 @@ The value is actually the first element of LIST whose cdr equals KEY. */)
}
DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
- doc: /* Delete by side effect any occurrences of ELT as a member of LIST.
-The modified LIST is returned. Comparison is done with `eq'.
-If the first member of LIST is ELT, there is no way to remove it by side effect;
-therefore, write `(setq foo (delq element foo))'
-to be sure of changing the value of `foo'. */)
+ doc: /* Delete members of LIST which are `eq' to ELT, and return the result.
+More precisely, this function skips any members `eq' to ELT at the
+front of LIST, then removes members `eq' to ELT from the remaining
+sublist by modifying its list structure, then returns the resulting
+list.
+
+Write `(setq foo (delq element foo))' to be sure of correctly changing
+the value of a list `foo'. */)
(register Lisp_Object elt, Lisp_Object list)
{
register Lisp_Object tail, prev;
@@ -1590,18 +1562,24 @@ to be sure of changing the value of `foo'. */)
}
DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
- doc: /* Delete by side effect any occurrences of ELT as a member of SEQ.
-SEQ must be a list, a vector, or a string.
-The modified SEQ is returned. Comparison is done with `equal'.
-If SEQ is not a list, or the first member of SEQ is ELT, deleting it
-is not a side effect; it is simply using a different sequence.
-Therefore, write `(setq foo (delete element foo))'
-to be sure of changing the value of `foo'. */)
+ doc: /* Delete members of SEQ which are `equal' to ELT, and return the result.
+SEQ must be a sequence (i.e. a list, a vector, or a string).
+The return value is a sequence of the same type.
+
+If SEQ is a list, this behaves like `delq', except that it compares
+with `equal' instead of `eq'. In particular, it may remove elements
+by altering the list structure.
+
+If SEQ is not a list, deletion is never performed destructively;
+instead this function creates and returns a new vector or string.
+
+Write `(setq foo (delete element foo))' to be sure of correctly
+changing the value of a sequence `foo'. */)
(Lisp_Object elt, Lisp_Object seq)
{
if (VECTORP (seq))
{
- EMACS_INT i, n;
+ ptrdiff_t i, n;
for (i = n = 0; i < ASIZE (seq); ++i)
if (NILP (Fequal (AREF (seq, i), elt)))
@@ -1620,7 +1598,7 @@ to be sure of changing the value of `foo'. */)
}
else if (STRINGP (seq))
{
- EMACS_INT i, ibyte, nchars, nbytes, cbytes;
+ ptrdiff_t i, ibyte, nchars, nbytes, cbytes;
int c;
for (i = nchars = nbytes = ibyte = 0;
@@ -1672,7 +1650,7 @@ to be sure of changing the value of `foo'. */)
{
unsigned char *from = SDATA (seq) + ibyte;
unsigned char *to = SDATA (tem) + nbytes;
- EMACS_INT n;
+ ptrdiff_t n;
++nchars;
nbytes += cbytes;
@@ -1711,7 +1689,7 @@ to be sure of changing the value of `foo'. */)
DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
doc: /* Reverse LIST by modifying cdr pointers.
-Return the reversed list. */)
+Return the reversed list. Expects a properly nil-terminated list. */)
(Lisp_Object list)
{
register Lisp_Object prev, tail, next;
@@ -1722,7 +1700,7 @@ Return the reversed list. */)
while (!NILP (tail))
{
QUIT;
- CHECK_LIST_CONS (tail, list);
+ CHECK_LIST_CONS (tail, tail);
next = XCDR (tail);
Fsetcdr (tail, prev);
prev = tail;
@@ -1861,13 +1839,6 @@ properties on the list. This function never signals an error. */)
halftail = XCDR (halftail);
if (EQ (tail, halftail))
break;
-
-#if 0 /* Unsafe version. */
- /* This function can be called asynchronously
- (setup_coding_system). Don't QUIT in that case. */
- if (!interrupt_input_blocked)
- QUIT;
-#endif
}
return Qnil;
@@ -1921,8 +1892,8 @@ It can be retrieved with `(get SYMBOL PROPNAME)'. */)
(Lisp_Object symbol, Lisp_Object propname, Lisp_Object value)
{
CHECK_SYMBOL (symbol);
- XSYMBOL (symbol)->plist
- = Fplist_put (XSYMBOL (symbol)->plist, propname, value);
+ set_symbol_plist
+ (symbol, Fplist_put (XSYMBOL (symbol)->plist, propname, value));
return value;
}
@@ -2019,10 +1990,10 @@ of strings. (`equal' ignores text properties.) */)
/* DEPTH is current depth of recursion. Signal an error if it
gets too deep.
- PROPS, if non-nil, means compare string text properties too. */
+ PROPS means compare string text properties too. */
-static int
-internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int props)
+static bool
+internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props)
{
if (depth > 200)
error ("Stack overflow in equal");
@@ -2043,7 +2014,7 @@ internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int
d1 = extract_float (o1);
d2 = extract_float (o2);
/* If d is a NaN, then d != d. Two NaNs should be `equal' even
- though they are not =. */
+ though they are not =. */
return d1 == d2 || (d1 != d1 && d2 != d2);
}
@@ -2079,7 +2050,7 @@ internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int
case Lisp_Vectorlike:
{
register int i;
- EMACS_INT size = ASIZE (o1);
+ ptrdiff_t size = ASIZE (o1);
/* Pseudovectors have the type encoded in the size field, so this test
actually checks that the objects have the same type as well as the
same size. */
@@ -2105,8 +2076,8 @@ internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int
are sensible to compare, so eliminate the others now. */
if (size & PSEUDOVECTOR_FLAG)
{
- if (!(size & (PVEC_COMPILED
- | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE | PVEC_FONT)))
+ if (((size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
+ < PVEC_COMPILED)
return 0;
size &= PSEUDOVECTOR_SIZE_MASK;
}
@@ -2146,22 +2117,18 @@ DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
ARRAY is a vector, string, char-table, or bool-vector. */)
(Lisp_Object array, Lisp_Object item)
{
- register EMACS_INT size, idx;
+ register ptrdiff_t size, idx;
if (VECTORP (array))
- {
- register Lisp_Object *p = XVECTOR (array)->contents;
- size = ASIZE (array);
- for (idx = 0; idx < size; idx++)
- p[idx] = item;
- }
+ for (idx = 0, size = ASIZE (array); idx < size; idx++)
+ ASET (array, idx, item);
else if (CHAR_TABLE_P (array))
{
int i;
for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
- XCHAR_TABLE (array)->contents[i] = item;
- XCHAR_TABLE (array)->defalt = item;
+ set_char_table_contents (array, i, item);
+ set_char_table_defalt (array, item);
}
else if (STRINGP (array))
{
@@ -2174,7 +2141,7 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len = CHAR_STRING (charval, str);
- EMACS_INT size_byte = SBYTES (array);
+ ptrdiff_t size_byte = SBYTES (array);
if (INT_MULTIPLY_OVERFLOW (SCHARS (array), len)
|| SCHARS (array) * len != size_byte)
@@ -2189,18 +2156,16 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
else if (BOOL_VECTOR_P (array))
{
register unsigned char *p = XBOOL_VECTOR (array)->data;
- EMACS_INT size_in_chars;
- size = XBOOL_VECTOR (array)->size;
- size_in_chars
- = ((size + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
+ size =
+ ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR);
- if (size_in_chars)
+ if (size)
{
- memset (p, ! NILP (item) ? -1 : 0, size_in_chars);
+ memset (p, ! NILP (item) ? -1 : 0, size);
/* Clear any extraneous bits in the last byte. */
- p[size_in_chars - 1] &= (1 << (size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
+ p[size - 1] &= (1 << (size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
}
}
else
@@ -2214,7 +2179,7 @@ DEFUN ("clear-string", Fclear_string, Sclear_string,
This makes STRING unibyte and may change its length. */)
(Lisp_Object string)
{
- EMACS_INT len;
+ ptrdiff_t len;
CHECK_STRING (string);
len = SBYTES (string);
memset (SDATA (string), 0, len);
@@ -2324,12 +2289,12 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
}
else if (STRINGP (seq))
{
- EMACS_INT i_byte;
+ ptrdiff_t i_byte;
for (i = 0, i_byte = 0; i < leni;)
{
int c;
- EMACS_INT i_before = i;
+ ptrdiff_t i_before = i;
FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte);
XSETFASTINT (dummy, c);
@@ -2362,7 +2327,8 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
{
Lisp_Object len;
register EMACS_INT leni;
- ptrdiff_t i, nargs;
+ EMACS_INT nargs;
+ ptrdiff_t i;
register Lisp_Object *args;
struct gcpro gcpro1;
Lisp_Object ret;
@@ -2624,9 +2590,9 @@ Normally the return value is FEATURE.
The normal messages at start and end of loading FILENAME are suppressed. */)
(Lisp_Object feature, Lisp_Object filename, Lisp_Object noerror)
{
- register Lisp_Object tem;
+ Lisp_Object tem;
struct gcpro gcpro1, gcpro2;
- int from_file = load_in_progress;
+ bool from_file = load_in_progress;
CHECK_SYMBOL (feature);
@@ -2649,7 +2615,7 @@ The normal messages at start and end of loading FILENAME are suppressed. */)
if (NILP (tem))
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int nesting = 0;
/* This is to make sure that loadup.el gives a clear picture
@@ -2829,7 +2795,7 @@ The data read from the system are decoded using `locale-coding-system'. */)
for (i = 0; i < 7; i++)
{
str = nl_langinfo (days[i]);
- val = make_unibyte_string (str, strlen (str));
+ val = build_unibyte_string (str);
/* Fixme: Is this coding system necessarily right, even if
it is consistent with CODESET? If not, what to do? */
Faset (v, make_number (i),
@@ -2853,7 +2819,7 @@ The data read from the system are decoded using `locale-coding-system'. */)
for (i = 0; i < 12; i++)
{
str = nl_langinfo (months[i]);
- val = make_unibyte_string (str, strlen (str));
+ val = build_unibyte_string (str);
Faset (v, make_number (i),
code_convert_string_norecord (val, Vlocale_coding_system, 0));
}
@@ -2952,9 +2918,9 @@ static const short base64_char_to_value[128] =
base64 characters. */
-static EMACS_INT base64_encode_1 (const char *, char *, EMACS_INT, int, int);
-static EMACS_INT base64_decode_1 (const char *, char *, EMACS_INT, int,
- EMACS_INT *);
+static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, bool, bool);
+static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool,
+ ptrdiff_t *);
DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
2, 3, "r",
@@ -2965,9 +2931,9 @@ into shorter lines. */)
(Lisp_Object beg, Lisp_Object end, Lisp_Object no_line_break)
{
char *encoded;
- EMACS_INT allength, length;
- EMACS_INT ibeg, iend, encoded_length;
- EMACS_INT old_pos = PT;
+ ptrdiff_t allength, length;
+ ptrdiff_t ibeg, iend, encoded_length;
+ ptrdiff_t old_pos = PT;
USE_SAFE_ALLOCA;
validate_region (&beg, &end);
@@ -2983,12 +2949,12 @@ into shorter lines. */)
allength = length + length/3 + 1;
allength += allength / MIME_LINE_LENGTH + 1 + 6;
- SAFE_ALLOCA (encoded, char *, allength);
+ encoded = SAFE_ALLOCA (allength);
encoded_length = base64_encode_1 ((char *) BYTE_POS_ADDR (ibeg),
encoded, length, NILP (no_line_break),
!NILP (BVAR (current_buffer, enable_multibyte_characters)));
if (encoded_length > allength)
- abort ();
+ emacs_abort ();
if (encoded_length < 0)
{
@@ -3023,7 +2989,7 @@ Optional second argument NO-LINE-BREAK means do not break long lines
into shorter lines. */)
(Lisp_Object string, Lisp_Object no_line_break)
{
- EMACS_INT allength, length, encoded_length;
+ ptrdiff_t allength, length, encoded_length;
char *encoded;
Lisp_Object encoded_string;
USE_SAFE_ALLOCA;
@@ -3038,13 +3004,13 @@ into shorter lines. */)
allength += allength / MIME_LINE_LENGTH + 1 + 6;
/* We need to allocate enough room for decoding the text. */
- SAFE_ALLOCA (encoded, char *, allength);
+ encoded = SAFE_ALLOCA (allength);
encoded_length = base64_encode_1 (SSDATA (string),
encoded, length, NILP (no_line_break),
STRING_MULTIBYTE (string));
if (encoded_length > allength)
- abort ();
+ emacs_abort ();
if (encoded_length < 0)
{
@@ -3059,12 +3025,12 @@ into shorter lines. */)
return encoded_string;
}
-static EMACS_INT
-base64_encode_1 (const char *from, char *to, EMACS_INT length,
- int line_break, int multibyte)
+static ptrdiff_t
+base64_encode_1 (const char *from, char *to, ptrdiff_t length,
+ bool line_break, bool multibyte)
{
int counter = 0;
- EMACS_INT i = 0;
+ ptrdiff_t i = 0;
char *e = to;
int c;
unsigned int value;
@@ -3163,12 +3129,12 @@ Return the length of the decoded text.
If the region can't be decoded, signal an error and don't modify the buffer. */)
(Lisp_Object beg, Lisp_Object end)
{
- EMACS_INT ibeg, iend, length, allength;
+ ptrdiff_t ibeg, iend, length, allength;
char *decoded;
- EMACS_INT old_pos = PT;
- EMACS_INT decoded_length;
- EMACS_INT inserted_chars;
- int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ ptrdiff_t old_pos = PT;
+ ptrdiff_t decoded_length;
+ ptrdiff_t inserted_chars;
+ bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
USE_SAFE_ALLOCA;
validate_region (&beg, &end);
@@ -3182,14 +3148,14 @@ If the region can't be decoded, signal an error and don't modify the buffer. */
working on a multibyte buffer, each decoded code may occupy at
most two bytes. */
allength = multibyte ? length * 2 : length;
- SAFE_ALLOCA (decoded, char *, allength);
+ decoded = SAFE_ALLOCA (allength);
move_gap_both (XFASTINT (beg), ibeg);
decoded_length = base64_decode_1 ((char *) BYTE_POS_ADDR (ibeg),
decoded, length,
multibyte, &inserted_chars);
if (decoded_length > allength)
- abort ();
+ emacs_abort ();
if (decoded_length < 0)
{
@@ -3225,7 +3191,7 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
(Lisp_Object string)
{
char *decoded;
- EMACS_INT length, decoded_length;
+ ptrdiff_t length, decoded_length;
Lisp_Object decoded_string;
USE_SAFE_ALLOCA;
@@ -3233,13 +3199,13 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
length = SBYTES (string);
/* We need to allocate enough room for decoding the text. */
- SAFE_ALLOCA (decoded, char *, length);
+ decoded = SAFE_ALLOCA (length);
/* The decoded result should be unibyte. */
decoded_length = base64_decode_1 (SSDATA (string), decoded, length,
0, NULL);
if (decoded_length > length)
- abort ();
+ emacs_abort ();
else if (decoded_length >= 0)
decoded_string = make_unibyte_string (decoded, decoded_length);
else
@@ -3253,19 +3219,19 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
}
/* Base64-decode the data at FROM of LENGTH bytes into TO. If
- MULTIBYTE is nonzero, the decoded result should be in multibyte
- form. If NCHARS_RETRUN is not NULL, store the number of produced
+ MULTIBYTE, the decoded result should be in multibyte
+ form. If NCHARS_RETURN is not NULL, store the number of produced
characters in *NCHARS_RETURN. */
-static EMACS_INT
-base64_decode_1 (const char *from, char *to, EMACS_INT length,
- int multibyte, EMACS_INT *nchars_return)
+static ptrdiff_t
+base64_decode_1 (const char *from, char *to, ptrdiff_t length,
+ bool multibyte, ptrdiff_t *nchars_return)
{
- EMACS_INT i = 0; /* Used inside READ_QUADRUPLET_BYTE */
+ ptrdiff_t i = 0; /* Used inside READ_QUADRUPLET_BYTE */
char *e = to;
unsigned char c;
unsigned long value;
- EMACS_INT nchars = 0;
+ ptrdiff_t nchars = 0;
while (1)
{
@@ -3365,19 +3331,11 @@ static struct Lisp_Hash_Table *weak_hash_tables;
/* Various symbols. */
-static Lisp_Object Qhash_table_p, Qkey, Qvalue;
-Lisp_Object Qeq, Qeql, Qequal;
+static Lisp_Object Qhash_table_p, Qkey, Qvalue, Qeql;
+Lisp_Object Qeq, Qequal;
Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value;
-/* Function prototypes. */
-
-static struct Lisp_Hash_Table *check_hash_table (Lisp_Object);
-static ptrdiff_t get_key_arg (Lisp_Object, ptrdiff_t, Lisp_Object *, char *);
-static void maybe_resize_hash_table (struct Lisp_Hash_Table *);
-static int sweep_weak_table (struct Lisp_Hash_Table *, int);
-
-
/***********************************************************************
Utilities
@@ -3432,23 +3390,31 @@ get_key_arg (Lisp_Object key, ptrdiff_t nargs, Lisp_Object *args, char *used)
/* Return a Lisp vector which has the same contents as VEC but has
- size NEW_SIZE, NEW_SIZE >= VEC->size. Entries in the resulting
- vector that are not copied from VEC are set to INIT. */
+ at least INCR_MIN more entries, where INCR_MIN is positive.
+ If NITEMS_MAX is not -1, do not grow the vector to be any larger
+ than NITEMS_MAX. Entries in the resulting
+ vector that are not copied from VEC are set to nil. */
Lisp_Object
-larger_vector (Lisp_Object vec, EMACS_INT new_size, Lisp_Object init)
+larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
{
struct Lisp_Vector *v;
- EMACS_INT i, old_size;
-
- xassert (VECTORP (vec));
+ ptrdiff_t i, incr, incr_max, old_size, new_size;
+ ptrdiff_t C_language_max = min (PTRDIFF_MAX, SIZE_MAX) / sizeof *v->contents;
+ ptrdiff_t n_max = (0 <= nitems_max && nitems_max < C_language_max
+ ? nitems_max : C_language_max);
+ eassert (VECTORP (vec));
+ eassert (0 < incr_min && -1 <= nitems_max);
old_size = ASIZE (vec);
- xassert (new_size >= old_size);
-
+ incr_max = n_max - old_size;
+ incr = max (incr_min, min (old_size >> 1, incr_max));
+ if (incr_max < incr)
+ memory_full (SIZE_MAX);
+ new_size = old_size + incr;
v = allocate_vector (new_size);
memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents);
for (i = old_size; i < new_size; ++i)
- v->contents[i] = init;
+ v->contents[i] = Qnil;
XSETVECTOR (vec, v);
return vec;
}
@@ -3458,14 +3424,17 @@ larger_vector (Lisp_Object vec, EMACS_INT new_size, Lisp_Object init)
Low-level Functions
***********************************************************************/
+static struct hash_table_test hashtest_eq;
+struct hash_table_test hashtest_eql, hashtest_equal;
+
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
- HASH2 in hash table H using `eql'. Value is non-zero if KEY1 and
+ HASH2 in hash table H using `eql'. Value is true if KEY1 and
KEY2 are the same. */
-static int
-cmpfn_eql (struct Lisp_Hash_Table *h,
- Lisp_Object key1, EMACS_UINT hash1,
- Lisp_Object key2, EMACS_UINT hash2)
+static bool
+cmpfn_eql (struct hash_table_test *ht,
+ Lisp_Object key1,
+ Lisp_Object key2)
{
return (FLOATP (key1)
&& FLOATP (key2)
@@ -3474,38 +3443,33 @@ cmpfn_eql (struct Lisp_Hash_Table *h,
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
- HASH2 in hash table H using `equal'. Value is non-zero if KEY1 and
+ HASH2 in hash table H using `equal'. Value is true if KEY1 and
KEY2 are the same. */
-static int
-cmpfn_equal (struct Lisp_Hash_Table *h,
- Lisp_Object key1, EMACS_UINT hash1,
- Lisp_Object key2, EMACS_UINT hash2)
+static bool
+cmpfn_equal (struct hash_table_test *ht,
+ Lisp_Object key1,
+ Lisp_Object key2)
{
- return hash1 == hash2 && !NILP (Fequal (key1, key2));
+ return !NILP (Fequal (key1, key2));
}
/* Compare KEY1 which has hash code HASH1, and KEY2 with hash code
- HASH2 in hash table H using H->user_cmp_function. Value is non-zero
+ HASH2 in hash table H using H->user_cmp_function. Value is true
if KEY1 and KEY2 are the same. */
-static int
-cmpfn_user_defined (struct Lisp_Hash_Table *h,
- Lisp_Object key1, EMACS_UINT hash1,
- Lisp_Object key2, EMACS_UINT hash2)
+static bool
+cmpfn_user_defined (struct hash_table_test *ht,
+ Lisp_Object key1,
+ Lisp_Object key2)
{
- if (hash1 == hash2)
- {
- Lisp_Object args[3];
+ Lisp_Object args[3];
- args[0] = h->user_cmp_function;
- args[1] = key1;
- args[2] = key2;
- return !NILP (Ffuncall (3, args));
- }
- else
- return 0;
+ args[0] = ht->user_cmp_function;
+ args[1] = key1;
+ args[2] = key2;
+ return !NILP (Ffuncall (3, args));
}
@@ -3514,54 +3478,48 @@ cmpfn_user_defined (struct Lisp_Hash_Table *h,
in a Lisp integer. */
static EMACS_UINT
-hashfn_eq (struct Lisp_Hash_Table *h, Lisp_Object key)
+hashfn_eq (struct hash_table_test *ht, Lisp_Object key)
{
- EMACS_UINT hash = XUINT (key) ^ XTYPE (key);
- xassert ((hash & ~INTMASK) == 0);
+ EMACS_UINT hash = XHASH (key) ^ XTYPE (key);
return hash;
}
-
/* Value is a hash code for KEY for use in hash table H which uses
`eql' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */
static EMACS_UINT
-hashfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key)
+hashfn_eql (struct hash_table_test *ht, Lisp_Object key)
{
EMACS_UINT hash;
if (FLOATP (key))
hash = sxhash (key, 0);
else
- hash = XUINT (key) ^ XTYPE (key);
- xassert ((hash & ~INTMASK) == 0);
+ hash = XHASH (key) ^ XTYPE (key);
return hash;
}
-
/* Value is a hash code for KEY for use in hash table H which uses
`equal' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */
static EMACS_UINT
-hashfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key)
+hashfn_equal (struct hash_table_test *ht, Lisp_Object key)
{
EMACS_UINT hash = sxhash (key, 0);
- xassert ((hash & ~INTMASK) == 0);
return hash;
}
-
/* Value is a hash code for KEY for use in hash table H which uses as
user-defined function to compare keys. The hash code returned is
guaranteed to fit in a Lisp integer. */
static EMACS_UINT
-hashfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key)
+hashfn_user_defined (struct hash_table_test *ht, Lisp_Object key)
{
Lisp_Object args[2], hash;
- args[0] = h->user_hash_function;
+ args[0] = ht->user_hash_function;
args[1] = key;
hash = Ffuncall (2, args);
if (!INTEGERP (hash))
@@ -3569,6 +3527,10 @@ hashfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key)
return XUINT (hash);
}
+/* An upper bound on the size of a hash table index. It must fit in
+ ptrdiff_t and be a valid Emacs fixnum. */
+#define INDEX_SIZE_BOUND \
+ ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX / word_size))
/* Create and initialize a new hash table.
@@ -3593,21 +3555,22 @@ hashfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key)
one of the symbols `key', `value', `key-or-value', or `key-and-value'. */
Lisp_Object
-make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size,
- Lisp_Object rehash_threshold, Lisp_Object weak,
- Lisp_Object user_test, Lisp_Object user_hash)
+make_hash_table (struct hash_table_test test,
+ Lisp_Object size, Lisp_Object rehash_size,
+ Lisp_Object rehash_threshold, Lisp_Object weak)
{
struct Lisp_Hash_Table *h;
Lisp_Object table;
- EMACS_INT index_size, i, sz;
+ EMACS_INT index_size, sz;
+ ptrdiff_t i;
double index_float;
/* Preconditions. */
- xassert (SYMBOLP (test));
- xassert (INTEGERP (size) && XINT (size) >= 0);
- xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
+ eassert (SYMBOLP (test.name));
+ eassert (INTEGERP (size) && XINT (size) >= 0);
+ eassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
|| (FLOATP (rehash_size) && 1 < XFLOAT_DATA (rehash_size)));
- xassert (FLOATP (rehash_threshold)
+ eassert (FLOATP (rehash_threshold)
&& 0 < XFLOAT_DATA (rehash_threshold)
&& XFLOAT_DATA (rehash_threshold) <= 1.0);
@@ -3616,10 +3579,10 @@ make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size,
sz = XFASTINT (size);
index_float = sz / XFLOAT_DATA (rehash_threshold);
- index_size = (index_float < MOST_POSITIVE_FIXNUM + 1
+ index_size = (index_float < INDEX_SIZE_BOUND + 1
? next_almost_prime (index_float)
- : MOST_POSITIVE_FIXNUM + 1);
- if (MOST_POSITIVE_FIXNUM < max (index_size, 2 * sz))
+ : INDEX_SIZE_BOUND + 1);
+ if (INDEX_SIZE_BOUND < max (index_size, 2 * sz))
error ("Hash table too large");
/* Allocate a table and initialize it. */
@@ -3627,29 +3590,6 @@ make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size,
/* Initialize hash table slots. */
h->test = test;
- if (EQ (test, Qeql))
- {
- h->cmpfn = cmpfn_eql;
- h->hashfn = hashfn_eql;
- }
- else if (EQ (test, Qeq))
- {
- h->cmpfn = NULL;
- h->hashfn = hashfn_eq;
- }
- else if (EQ (test, Qequal))
- {
- h->cmpfn = cmpfn_equal;
- h->hashfn = hashfn_equal;
- }
- else
- {
- h->user_cmp_function = user_test;
- h->user_hash_function = user_hash;
- h->cmpfn = cmpfn_user_defined;
- h->hashfn = hashfn_user_defined;
- }
-
h->weak = weak;
h->rehash_threshold = rehash_threshold;
h->rehash_size = rehash_size;
@@ -3661,12 +3601,12 @@ make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size,
/* Set up the free list. */
for (i = 0; i < sz - 1; ++i)
- HASH_NEXT (h, i) = make_number (i + 1);
+ set_hash_next_slot (h, i, make_number (i + 1));
h->next_free = make_number (0);
XSET_HASH_TABLE (table, h);
- xassert (HASH_TABLE_P (table));
- xassert (XHASH_TABLE (table) == h);
+ eassert (HASH_TABLE_P (table));
+ eassert (XHASH_TABLE (table) == h);
/* Maybe add this hash table to the list of all weak hash tables. */
if (NILP (h->weak))
@@ -3689,12 +3629,9 @@ copy_hash_table (struct Lisp_Hash_Table *h1)
{
Lisp_Object table;
struct Lisp_Hash_Table *h2;
- struct Lisp_Vector *next;
h2 = allocate_hash_table ();
- next = h2->header.next.vector;
- memcpy (h2, h1, sizeof *h2);
- h2->header.next.vector = next;
+ *h2 = *h1;
h2->key_and_value = Fcopy_sequence (h1->key_and_value);
h2->hash = Fcopy_sequence (h1->hash);
h2->next = Fcopy_sequence (h1->next);
@@ -3715,14 +3652,14 @@ copy_hash_table (struct Lisp_Hash_Table *h1)
/* Resize hash table H if it's too full. If H cannot be resized
because it's already too large, throw an error. */
-static inline void
+static void
maybe_resize_hash_table (struct Lisp_Hash_Table *h)
{
if (NILP (h->next_free))
{
- EMACS_INT old_size = HASH_TABLE_SIZE (h);
- EMACS_INT i, new_size, index_size;
- EMACS_INT nsize;
+ ptrdiff_t old_size = HASH_TABLE_SIZE (h);
+ EMACS_INT new_size, index_size, nsize;
+ ptrdiff_t i;
double index_float;
if (INTEGERP (h->rehash_size))
@@ -3730,33 +3667,45 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
else
{
double float_new_size = old_size * XFLOAT_DATA (h->rehash_size);
- if (float_new_size < MOST_POSITIVE_FIXNUM + 1)
+ if (float_new_size < INDEX_SIZE_BOUND + 1)
{
new_size = float_new_size;
if (new_size <= old_size)
new_size = old_size + 1;
}
else
- new_size = MOST_POSITIVE_FIXNUM + 1;
+ new_size = INDEX_SIZE_BOUND + 1;
}
index_float = new_size / XFLOAT_DATA (h->rehash_threshold);
- index_size = (index_float < MOST_POSITIVE_FIXNUM + 1
+ index_size = (index_float < INDEX_SIZE_BOUND + 1
? next_almost_prime (index_float)
- : MOST_POSITIVE_FIXNUM + 1);
+ : INDEX_SIZE_BOUND + 1);
nsize = max (index_size, 2 * new_size);
- if (nsize > MOST_POSITIVE_FIXNUM)
+ if (INDEX_SIZE_BOUND < nsize)
error ("Hash table too large to resize");
- h->key_and_value = larger_vector (h->key_and_value, 2 * new_size, Qnil);
- h->next = larger_vector (h->next, new_size, Qnil);
- h->hash = larger_vector (h->hash, new_size, Qnil);
- h->index = Fmake_vector (make_number (index_size), Qnil);
+#ifdef ENABLE_CHECKING
+ if (HASH_TABLE_P (Vpurify_flag)
+ && XHASH_TABLE (Vpurify_flag) == h)
+ {
+ Lisp_Object args[2];
+ args[0] = build_string ("Growing hash table to: %d");
+ args[1] = make_number (new_size);
+ Fmessage (2, args);
+ }
+#endif
+
+ set_hash_key_and_value (h, larger_vector (h->key_and_value,
+ 2 * (new_size - old_size), -1));
+ set_hash_next (h, larger_vector (h->next, new_size - old_size, -1));
+ set_hash_hash (h, larger_vector (h->hash, new_size - old_size, -1));
+ set_hash_index (h, Fmake_vector (make_number (index_size), Qnil));
/* Update the free list. Do it so that new entries are added at
the end of the free list. This makes some operations like
maphash faster. */
for (i = old_size; i < new_size - 1; ++i)
- HASH_NEXT (h, i) = make_number (i + 1);
+ set_hash_next_slot (h, i, make_number (i + 1));
if (!NILP (h->next_free))
{
@@ -3767,7 +3716,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
!NILP (next))
last = next;
- HASH_NEXT (h, XFASTINT (last)) = make_number (old_size);
+ set_hash_next_slot (h, XFASTINT (last), make_number (old_size));
}
else
XSETFASTINT (h->next_free, old_size);
@@ -3777,9 +3726,9 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
if (!NILP (HASH_HASH (h, i)))
{
EMACS_UINT hash_code = XUINT (HASH_HASH (h, i));
- EMACS_INT start_of_bucket = hash_code % ASIZE (h->index);
- HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket);
- HASH_INDEX (h, start_of_bucket) = make_number (i);
+ ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index);
+ set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
+ set_hash_index_slot (h, start_of_bucket, make_number (i));
}
}
}
@@ -3796,7 +3745,8 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash)
ptrdiff_t start_of_bucket;
Lisp_Object idx;
- hash_code = h->hashfn (h, key);
+ hash_code = h->test.hashfn (&h->test, key);
+ eassert ((hash_code & ~INTMASK) == 0);
if (hash)
*hash = hash_code;
@@ -3806,11 +3756,11 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash)
/* We need not gcpro idx since it's either an integer or nil. */
while (!NILP (idx))
{
- EMACS_INT i = XFASTINT (idx);
+ ptrdiff_t i = XFASTINT (idx);
if (EQ (key, HASH_KEY (h, i))
- || (h->cmpfn
- && h->cmpfn (h, key, hash_code,
- HASH_KEY (h, i), XUINT (HASH_HASH (h, i)))))
+ || (h->test.cmpfn
+ && hash_code == XUINT (HASH_HASH (h, i))
+ && h->test.cmpfn (&h->test, key, HASH_KEY (h, i))))
break;
idx = HASH_NEXT (h, i);
}
@@ -3829,7 +3779,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
{
ptrdiff_t start_of_bucket, i;
- xassert ((hash & ~INTMASK) == 0);
+ eassert ((hash & ~INTMASK) == 0);
/* Increment count after resizing because resizing may fail. */
maybe_resize_hash_table (h);
@@ -3838,16 +3788,16 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
/* Store key/value in the key_and_value vector. */
i = XFASTINT (h->next_free);
h->next_free = HASH_NEXT (h, i);
- HASH_KEY (h, i) = key;
- HASH_VALUE (h, i) = value;
+ set_hash_key_slot (h, i, key);
+ set_hash_value_slot (h, i, value);
/* Remember its hash code. */
- HASH_HASH (h, i) = make_number (hash);
+ set_hash_hash_slot (h, i, make_number (hash));
/* Add new entry to its collision chain. */
start_of_bucket = hash % ASIZE (h->index);
- HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket);
- HASH_INDEX (h, start_of_bucket) = make_number (i);
+ set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
+ set_hash_index_slot (h, start_of_bucket, make_number (i));
return i;
}
@@ -3858,10 +3808,11 @@ static void
hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
{
EMACS_UINT hash_code;
- EMACS_INT start_of_bucket;
+ ptrdiff_t start_of_bucket;
Lisp_Object idx, prev;
- hash_code = h->hashfn (h, key);
+ hash_code = h->test.hashfn (&h->test, key);
+ eassert ((hash_code & ~INTMASK) == 0);
start_of_bucket = hash_code % ASIZE (h->index);
idx = HASH_INDEX (h, start_of_bucket);
prev = Qnil;
@@ -3869,26 +3820,28 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
/* We need not gcpro idx, prev since they're either integers or nil. */
while (!NILP (idx))
{
- EMACS_INT i = XFASTINT (idx);
+ ptrdiff_t i = XFASTINT (idx);
if (EQ (key, HASH_KEY (h, i))
- || (h->cmpfn
- && h->cmpfn (h, key, hash_code,
- HASH_KEY (h, i), XUINT (HASH_HASH (h, i)))))
+ || (h->test.cmpfn
+ && hash_code == XUINT (HASH_HASH (h, i))
+ && h->test.cmpfn (&h->test, key, HASH_KEY (h, i))))
{
/* Take entry out of collision chain. */
if (NILP (prev))
- HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i);
+ set_hash_index_slot (h, start_of_bucket, HASH_NEXT (h, i));
else
- HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i);
+ set_hash_next_slot (h, XFASTINT (prev), HASH_NEXT (h, i));
/* Clear slots in key_and_value and add the slots to
the free list. */
- HASH_KEY (h, i) = HASH_VALUE (h, i) = HASH_HASH (h, i) = Qnil;
- HASH_NEXT (h, i) = h->next_free;
+ set_hash_key_slot (h, i, Qnil);
+ set_hash_value_slot (h, i, Qnil);
+ set_hash_hash_slot (h, i, Qnil);
+ set_hash_next_slot (h, i, h->next_free);
h->next_free = make_number (i);
h->count--;
- xassert (h->count >= 0);
+ eassert (h->count >= 0);
break;
}
else
@@ -3907,14 +3860,14 @@ hash_clear (struct Lisp_Hash_Table *h)
{
if (h->count > 0)
{
- EMACS_INT i, size = HASH_TABLE_SIZE (h);
+ ptrdiff_t i, size = HASH_TABLE_SIZE (h);
for (i = 0; i < size; ++i)
{
- HASH_NEXT (h, i) = i < size - 1 ? make_number (i + 1) : Qnil;
- HASH_KEY (h, i) = Qnil;
- HASH_VALUE (h, i) = Qnil;
- HASH_HASH (h, i) = Qnil;
+ set_hash_next_slot (h, i, i < size - 1 ? make_number (i + 1) : Qnil);
+ set_hash_key_slot (h, i, Qnil);
+ set_hash_value_slot (h, i, Qnil);
+ set_hash_hash_slot (h, i, Qnil);
}
for (i = 0; i < ASIZE (h->index); ++i)
@@ -3931,22 +3884,16 @@ hash_clear (struct Lisp_Hash_Table *h)
Weak Hash Tables
************************************************************************/
-void
-init_weak_hash_tables (void)
-{
- weak_hash_tables = NULL;
-}
-
-/* Sweep weak hash table H. REMOVE_ENTRIES_P non-zero means remove
+/* Sweep weak hash table H. REMOVE_ENTRIES_P means remove
entries from the table that don't survive the current GC.
- REMOVE_ENTRIES_P zero means mark entries that are in use. Value is
- non-zero if anything was marked. */
+ !REMOVE_ENTRIES_P means mark entries that are in use. Value is
+ true if anything was marked. */
-static int
-sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p)
+static bool
+sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
{
- EMACS_INT bucket, n;
- int marked;
+ ptrdiff_t bucket, n;
+ bool marked;
n = ASIZE (h->index) & ~ARRAY_MARK_FLAG;
marked = 0;
@@ -3960,10 +3907,10 @@ sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p)
prev = Qnil;
for (idx = HASH_INDEX (h, bucket); !NILP (idx); idx = next)
{
- EMACS_INT i = XFASTINT (idx);
- int key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
- int value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
- int remove_p;
+ ptrdiff_t i = XFASTINT (idx);
+ bool key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
+ bool value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
+ bool remove_p;
if (EQ (h->weak, Qkey))
remove_p = !key_known_to_survive_p;
@@ -3974,7 +3921,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p)
else if (EQ (h->weak, Qkey_and_value))
remove_p = !(key_known_to_survive_p && value_known_to_survive_p);
else
- abort ();
+ emacs_abort ();
next = HASH_NEXT (h, i);
@@ -3984,17 +3931,18 @@ sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p)
{
/* Take out of collision chain. */
if (NILP (prev))
- HASH_INDEX (h, bucket) = next;
+ set_hash_index_slot (h, bucket, next);
else
- HASH_NEXT (h, XFASTINT (prev)) = next;
+ set_hash_next_slot (h, XFASTINT (prev), next);
/* Add to free list. */
- HASH_NEXT (h, i) = h->next_free;
+ set_hash_next_slot (h, i, h->next_free);
h->next_free = idx;
/* Clear key, value, and hash. */
- HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil;
- HASH_HASH (h, i) = Qnil;
+ set_hash_key_slot (h, i, Qnil);
+ set_hash_value_slot (h, i, Qnil);
+ set_hash_hash_slot (h, i, Qnil);
h->count--;
}
@@ -4035,7 +3983,7 @@ void
sweep_weak_hash_tables (void)
{
struct Lisp_Hash_Table *h, *used, *next;
- int marked;
+ bool marked;
/* Mark all keys and values that are in use. Keep on marking until
there is no more change. This is necessary for cases like
@@ -4089,13 +4037,6 @@ sweep_weak_hash_tables (void)
#define SXHASH_MAX_LEN 7
-/* Combine two integers X and Y for hashing. The result might not fit
- into a Lisp integer. */
-
-#define SXHASH_COMBINE(X, Y) \
- ((((EMACS_UINT) (X) << 4) + ((EMACS_UINT) (X) >> (BITS_PER_EMACS_INT - 4))) \
- + (EMACS_UINT) (Y))
-
/* Hash X, returning a value that fits into a Lisp integer. */
#define SXHASH_REDUCE(X) \
((((X) ^ (X) >> (BITS_PER_EMACS_INT - FIXNUM_BITS))) & INTMASK)
@@ -4114,7 +4055,7 @@ hash_string (char const *ptr, ptrdiff_t len)
while (p != end)
{
c = *p++;
- hash = SXHASH_COMBINE (hash, c);
+ hash = sxhash_combine (hash, c);
}
return hash;
@@ -4148,7 +4089,7 @@ sxhash_float (double val)
u.val = val;
memset (&u.val + 1, 0, sizeof u - sizeof u.val);
for (i = 0; i < WORDS_PER_DOUBLE; i++)
- hash = SXHASH_COMBINE (hash, u.word[i]);
+ hash = sxhash_combine (hash, u.word[i]);
return SXHASH_REDUCE (hash);
}
@@ -4167,13 +4108,13 @@ sxhash_list (Lisp_Object list, int depth)
list = XCDR (list), ++i)
{
EMACS_UINT hash2 = sxhash (XCAR (list), depth + 1);
- hash = SXHASH_COMBINE (hash, hash2);
+ hash = sxhash_combine (hash, hash2);
}
if (!NILP (list))
{
EMACS_UINT hash2 = sxhash (list, depth + 1);
- hash = SXHASH_COMBINE (hash, hash2);
+ hash = sxhash_combine (hash, hash2);
}
return SXHASH_REDUCE (hash);
@@ -4193,7 +4134,7 @@ sxhash_vector (Lisp_Object vec, int depth)
for (i = 0; i < n; ++i)
{
EMACS_UINT hash2 = sxhash (AREF (vec, i), depth + 1);
- hash = SXHASH_COMBINE (hash, hash2);
+ hash = sxhash_combine (hash, hash2);
}
return SXHASH_REDUCE (hash);
@@ -4209,7 +4150,7 @@ sxhash_bool_vector (Lisp_Object vec)
n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->header.size);
for (i = 0; i < n; ++i)
- hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]);
+ hash = sxhash_combine (hash, XBOOL_VECTOR (vec)->data[i]);
return SXHASH_REDUCE (hash);
}
@@ -4233,7 +4174,7 @@ sxhash (Lisp_Object obj, int depth)
break;
case Lisp_Misc:
- hash = XUINT (obj);
+ hash = XHASH (obj);
break;
case Lisp_Symbol:
@@ -4257,7 +4198,7 @@ sxhash (Lisp_Object obj, int depth)
else
/* Others are `equal' if they are `eq', so let's take their
address as hash. */
- hash = XUINT (obj);
+ hash = XHASH (obj);
break;
case Lisp_Cons:
@@ -4269,7 +4210,7 @@ sxhash (Lisp_Object obj, int depth)
break;
default:
- abort ();
+ emacs_abort ();
}
return hash;
@@ -4326,19 +4267,25 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object test, size, rehash_size, rehash_threshold, weak;
- Lisp_Object user_test, user_hash;
+ struct hash_table_test testdesc;
char *used;
ptrdiff_t i;
/* The vector `used' is used to keep track of arguments that
have been consumed. */
- used = (char *) alloca (nargs * sizeof *used);
+ used = alloca (nargs * sizeof *used);
memset (used, 0, nargs * sizeof *used);
/* See if there's a `:test TEST' among the arguments. */
i = get_key_arg (QCtest, nargs, args, used);
test = i ? args[i] : Qeql;
- if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal))
+ if (EQ (test, Qeq))
+ testdesc = hashtest_eq;
+ else if (EQ (test, Qeql))
+ testdesc = hashtest_eql;
+ else if (EQ (test, Qequal))
+ testdesc = hashtest_equal;
+ else
{
/* See if it is a user-defined test. */
Lisp_Object prop;
@@ -4346,11 +4293,12 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
prop = Fget (test, Qhash_table_test);
if (!CONSP (prop) || !CONSP (XCDR (prop)))
signal_error ("Invalid hash table test", test);
- user_test = XCAR (prop);
- user_hash = XCAR (XCDR (prop));
+ testdesc.name = test;
+ testdesc.user_cmp_function = XCAR (prop);
+ testdesc.user_hash_function = XCAR (XCDR (prop));
+ testdesc.hashfn = hashfn_user_defined;
+ testdesc.cmpfn = cmpfn_user_defined;
}
- else
- user_test = user_hash = Qnil;
/* See if there's a `:size SIZE' argument. */
i = get_key_arg (QCsize, nargs, args, used);
@@ -4392,8 +4340,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
if (!used[i])
signal_error ("Invalid argument list", args[i]);
- return make_hash_table (test, size, rehash_size, rehash_threshold, weak,
- user_test, user_hash);
+ return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak);
}
@@ -4447,7 +4394,7 @@ DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0,
doc: /* Return the test TABLE uses. */)
(Lisp_Object table)
{
- return check_hash_table (table)->test;
+ return check_hash_table (table)->test.name;
}
@@ -4501,7 +4448,7 @@ VALUE. In any case, return VALUE. */)
i = hash_lookup (h, key, &hash);
if (i >= 0)
- HASH_VALUE (h, i) = value;
+ set_hash_value_slot (h, i, value);
else
hash_put (h, key, value, hash);
@@ -4526,7 +4473,7 @@ FUNCTION is called with two arguments, KEY and VALUE. */)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
Lisp_Object args[3];
- EMACS_INT i;
+ ptrdiff_t i;
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
if (!NILP (HASH_HASH (h, i)))
@@ -4575,10 +4522,9 @@ static Lisp_Object
secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, Lisp_Object binary)
{
int i;
- EMACS_INT size;
- EMACS_INT size_byte = 0;
+ ptrdiff_t size;
EMACS_INT start_char = 0, end_char = 0;
- EMACS_INT start_byte = 0, end_byte = 0;
+ ptrdiff_t start_byte, end_byte;
register EMACS_INT b, e;
register struct buffer *bp;
EMACS_INT temp;
@@ -4615,7 +4561,6 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_
object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
size = SCHARS (object);
- size_byte = SBYTES (object);
if (!NILP (start))
{
@@ -4625,15 +4570,10 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_
if (start_char < 0)
start_char += size;
-
- start_byte = string_char_to_byte (object, start_char);
}
if (NILP (end))
- {
- end_char = size;
- end_byte = size_byte;
- }
+ end_char = size;
else
{
CHECK_NUMBER (end);
@@ -4642,25 +4582,26 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_
if (end_char < 0)
end_char += size;
-
- end_byte = string_char_to_byte (object, end_char);
}
if (!(0 <= start_char && start_char <= end_char && end_char <= size))
args_out_of_range_3 (object, make_number (start_char),
make_number (end_char));
+
+ start_byte = NILP (start) ? 0 : string_char_to_byte (object, start_char);
+ end_byte =
+ NILP (end) ? SBYTES (object) : string_char_to_byte (object, end_char);
}
else
{
struct buffer *prev = current_buffer;
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
CHECK_BUFFER (object);
bp = XBUFFER (object);
- if (bp != current_buffer)
- set_buffer_internal (bp);
+ set_buffer_internal (bp);
if (NILP (start))
b = BEGV;
@@ -4693,7 +4634,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_
coding_system = Vcoding_system_for_write;
else
{
- int force_raw_text = 0;
+ bool force_raw_text = 0;
coding_system = BVAR (XBUFFER (object), buffer_file_coding_system);
if (NILP (coding_system)
@@ -4747,14 +4688,15 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_
}
object = make_buffer_string (b, e, 0);
- if (prev != current_buffer)
- set_buffer_internal (prev);
+ set_buffer_internal (prev);
/* Discard the unwind protect for recovering the current
buffer. */
specpdl_ptr--;
if (STRING_MULTIBYTE (object))
object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
+ start_byte = 0;
+ end_byte = SBYTES (object);
}
if (EQ (algorithm, Qmd5))
@@ -4795,7 +4737,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_
digest = make_uninit_string (digest_size * 2);
hash_func (SSDATA (object) + start_byte,
- SBYTES (object) - (size_byte - end_byte),
+ end_byte - start_byte,
SSDATA (digest));
if (NILP (binary))
@@ -4847,12 +4789,15 @@ guesswork fails. Normally, an error is signaled in such case. */)
}
DEFUN ("secure-hash", Fsecure_hash, Ssecure_hash, 2, 5, 0,
- doc: /* Return the secure hash of an OBJECT.
-ALGORITHM is a symbol: md5, sha1, sha224, sha256, sha384 or sha512.
-OBJECT is either a string or a buffer.
-Optional arguments START and END are character positions specifying
-which portion of OBJECT for computing the hash. If BINARY is non-nil,
-return a string in binary form. */)
+ doc: /* Return the secure hash of OBJECT, a buffer or string.
+ALGORITHM is a symbol specifying the hash to use:
+md5, sha1, sha224, sha256, sha384 or sha512.
+
+The two optional arguments START and END are positions specifying for
+which part of OBJECT to compute the hash. If nil or omitted, uses the
+whole OBJECT.
+
+If BINARY is non-nil, returns a string in binary form. */)
(Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary)
{
return secure_hash (algorithm, object, start, end, Qnil, Qnil, binary);
@@ -4930,7 +4875,7 @@ Used by `featurep' and `require', and altered by `provide'. */);
#endif /* HAVE_LANGINFO_CODESET */
DEFVAR_BOOL ("use-dialog-box", use_dialog_box,
- doc: /* *Non-nil means mouse commands use dialog boxes to ask questions.
+ doc: /* Non-nil means mouse commands use dialog boxes to ask questions.
This applies to `y-or-n-p' and `yes-or-no-p' questions asked by commands
invoked by mouse clicks and mouse menu items.
@@ -4939,7 +4884,7 @@ non-nil. */);
use_dialog_box = 1;
DEFVAR_BOOL ("use-file-dialog", use_file_dialog,
- doc: /* *Non-nil means mouse commands use a file dialog to ask for files.
+ doc: /* Non-nil means mouse commands use a file dialog to ask for files.
This applies to commands from menus and tool bar buttons even when
they are initiated from the keyboard. If `use-dialog-box' is nil,
that disables the use of a file dialog, regardless of the value of
@@ -5013,10 +4958,14 @@ this variable. */);
defsubr (&Smd5);
defsubr (&Ssecure_hash);
defsubr (&Slocale_info);
-}
-
-void
-init_fns (void)
-{
+ {
+ struct hash_table_test
+ eq = { Qeq, Qnil, Qnil, NULL, hashfn_eq },
+ eql = { Qeql, Qnil, Qnil, cmpfn_eql, hashfn_eql },
+ equal = { Qequal, Qnil, Qnil, cmpfn_equal, hashfn_equal };
+ hashtest_eq = eq;
+ hashtest_eql = eql;
+ hashtest_equal = equal;
+ }
}
diff --git a/src/font.c b/src/font.c
index 6ab65281a48..41dbfd7a757 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1,6 +1,6 @@
/* font.c -- "Font" primitives.
-Copyright (C) 2006-2011 Free Software Foundation, Inc.
+Copyright (C) 2006-2012 Free Software Foundation, Inc.
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
@@ -23,31 +23,23 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <float.h>
#include <stdio.h>
-#include <ctype.h>
-#include <setjmp.h>
+
+#include <c-ctype.h>
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "frame.h"
#include "window.h"
#include "dispextern.h"
#include "charset.h"
-#include "character.h"
#include "composite.h"
#include "fontset.h"
#include "font.h"
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#endif /* HAVE_X_WINDOWS */
-
-#ifdef HAVE_NTGUI
-#include "w32term.h"
-#endif /* HAVE_NTGUI */
-
-#ifdef HAVE_NS
-#include "nsterm.h"
-#endif /* HAVE_NS */
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
Lisp_Object Qopentype;
@@ -59,10 +51,6 @@ Lisp_Object Qascii_0, Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip;
/* Unicode category `Cf'. */
static Lisp_Object QCf;
-/* Special vector of zero length. This is repeatedly used by (struct
- font_driver *)->list when a specified font is not found. */
-static Lisp_Object null_vector;
-
/* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
static Lisp_Object font_style_table;
@@ -227,18 +215,17 @@ static int num_font_drivers;
/* Return a Lispy value of a font property value at STR and LEN bytes.
- If STR is "*", return nil.
- If FORCE_SYMBOL is zero and all characters in STR are digits,
- return an integer. Otherwise, return a symbol interned from
- STR. */
+ If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
+ consist entirely of one or more digits, return a symbol interned
+ from STR. Otherwise, return an integer. */
Lisp_Object
-font_intern_prop (const char *str, ptrdiff_t len, int force_symbol)
+font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
{
ptrdiff_t i;
Lisp_Object tem;
Lisp_Object obarray;
- EMACS_INT nbytes, nchars;
+ ptrdiff_t nbytes, nchars;
if (len == 1 && *str == '*')
return Qnil;
@@ -264,18 +251,12 @@ font_intern_prop (const char *str, ptrdiff_t len, int force_symbol)
}
}
- /* The following code is copied from the function intern (in
- lread.c), and modified to suit our purpose. */
- obarray = Vobarray;
- if (!VECTORP (obarray) || ASIZE (obarray) == 0)
- obarray = check_obarray (obarray);
+ /* This code is similar to intern function from lread.c. */
+ obarray = check_obarray (Vobarray);
parse_str_as_multibyte ((unsigned char *) str, len, &nchars, &nbytes);
- if (len == nchars || len != nbytes)
- /* CONTENTS contains no multibyte sequences or contains an invalid
- multibyte sequence. We'll make a unibyte string. */
- tem = oblookup (obarray, str, len, len);
- else
- tem = oblookup (obarray, str, nchars, len);
+ tem = oblookup (obarray, str,
+ (len == nchars || len != nbytes) ? len : nchars, len);
+
if (SYMBOLP (tem))
return tem;
if (len == nchars || len != nbytes)
@@ -300,7 +281,7 @@ font_pixel_size (FRAME_PTR f, Lisp_Object spec)
return XINT (size);
if (NILP (size))
return 0;
- font_assert (FLOATP (size));
+ eassert (FLOATP (size));
point_size = XFLOAT_DATA (size);
val = AREF (spec, FONT_DPI_INDEX);
if (INTEGERP (val))
@@ -323,10 +304,14 @@ font_pixel_size (FRAME_PTR f, Lisp_Object spec)
VAL is an integer. */
int
-font_style_to_value (enum font_property_index prop, Lisp_Object val, int noerror)
+font_style_to_value (enum font_property_index prop, Lisp_Object val,
+ bool noerror)
{
Lisp_Object table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX);
- int len = ASIZE (table);
+ int len;
+
+ CHECK_VECTOR (table);
+ len = ASIZE (table);
if (SYMBOLP (val))
{
@@ -336,10 +321,16 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, int noerror
/* At first try exact match. */
for (i = 0; i < len; i++)
- for (j = 1; j < ASIZE (AREF (table, i)); j++)
- if (EQ (val, AREF (AREF (table, i), j)))
- return ((XINT (AREF (AREF (table, i), 0)) << 8)
- | (i << 4) | (j - 1));
+ {
+ CHECK_VECTOR (AREF (table, i));
+ for (j = 1; j < ASIZE (AREF (table, i)); j++)
+ if (EQ (val, AREF (AREF (table, i), j)))
+ {
+ CHECK_NUMBER (AREF (AREF (table, i), 0));
+ return ((XINT (AREF (AREF (table, i), 0)) << 8)
+ | (i << 4) | (j - 1));
+ }
+ }
/* Try also with case-folding match. */
s = SSDATA (SYMBOL_NAME (val));
for (i = 0; i < len; i++)
@@ -347,13 +338,15 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, int noerror
{
elt = AREF (AREF (table, i), j);
if (xstrcasecmp (s, SSDATA (SYMBOL_NAME (elt))) == 0)
- return ((XINT (AREF (AREF (table, i), 0)) << 8)
- | (i << 4) | (j - 1));
+ {
+ CHECK_NUMBER (AREF (AREF (table, i), 0));
+ return ((XINT (AREF (AREF (table, i), 0)) << 8)
+ | (i << 4) | (j - 1));
+ }
}
if (! noerror)
return -1;
- if (len == 255)
- abort ();
+ eassert (len < 255);
elt = Fmake_vector (make_number (2), make_number (100));
ASET (elt, 1, val);
args[0] = table;
@@ -364,12 +357,15 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, int noerror
else
{
int i, last_n;
- int numeric = XINT (val);
+ EMACS_INT numeric = XINT (val);
for (i = 0, last_n = -1; i < len; i++)
{
- int n = XINT (AREF (AREF (table, i), 0));
+ int n;
+ CHECK_VECTOR (AREF (table, i));
+ CHECK_NUMBER (AREF (AREF (table, i), 0));
+ n = XINT (AREF (AREF (table, i), 0));
if (numeric == n)
return (n << 8) | (i << 4);
if (numeric < n)
@@ -388,7 +384,8 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, int noerror
}
Lisp_Object
-font_style_symbolic (Lisp_Object font, enum font_property_index prop, int for_face)
+font_style_symbolic (Lisp_Object font, enum font_property_index prop,
+ bool for_face)
{
Lisp_Object val = AREF (font, prop);
Lisp_Object table, elt;
@@ -397,11 +394,15 @@ font_style_symbolic (Lisp_Object font, enum font_property_index prop, int for_fa
if (NILP (val))
return Qnil;
table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX);
+ CHECK_VECTOR (table);
i = XINT (val) & 0xFF;
- font_assert (((i >> 4) & 0xF) < ASIZE (table));
+ eassert (((i >> 4) & 0xF) < ASIZE (table));
elt = AREF (table, ((i >> 4) & 0xF));
- font_assert ((i & 0xF) + 1 < ASIZE (elt));
- return (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));
+ CHECK_VECTOR (elt);
+ eassert ((i & 0xF) + 1 < ASIZE (elt));
+ elt = (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));
+ CHECK_SYMBOL (elt);
+ return elt;
}
/* Return ENCODING or a cons of ENCODING and REPERTORY of the font
@@ -518,7 +519,8 @@ font_prop_validate_style (Lisp_Object style, Lisp_Object val)
: FONT_WIDTH_INDEX);
if (INTEGERP (val))
{
- int n = XINT (val);
+ EMACS_INT n = XINT (val);
+ CHECK_VECTOR (AREF (font_style_table, prop - FONT_WEIGHT_INDEX));
if (((n >> 4) & 0xF)
>= ASIZE (AREF (font_style_table, prop - FONT_WEIGHT_INDEX)))
val = Qerror;
@@ -526,10 +528,15 @@ font_prop_validate_style (Lisp_Object style, Lisp_Object val)
{
Lisp_Object elt = AREF (AREF (font_style_table, prop - FONT_WEIGHT_INDEX), (n >> 4) & 0xF);
+ CHECK_VECTOR (elt);
if ((n & 0xF) + 1 >= ASIZE (elt))
val = Qerror;
- else if (XINT (AREF (elt, 0)) != (n >> 8))
- val = Qerror;
+ else
+ {
+ CHECK_NUMBER (AREF (elt, 0));
+ if (XINT (AREF (elt, 0)) != (n >> 8))
+ val = Qerror;
+ }
}
}
else if (SYMBOLP (val))
@@ -714,7 +721,7 @@ font_put_extra (Lisp_Object font, Lisp_Object prop, Lisp_Object val)
static int parse_matrix (const char *);
static int font_expand_wildcards (Lisp_Object *, int);
-static int font_parse_name (char *, Lisp_Object);
+static int font_parse_name (char *, ptrdiff_t, Lisp_Object);
/* An enumerator for each field of an XLFD font name. */
enum xlfd_field_index
@@ -848,7 +855,7 @@ font_expand_wildcards (Lisp_Object *field, int n)
if (INTEGERP (val))
{
- int numeric = XINT (val);
+ EMACS_INT numeric = XINT (val);
if (i + 1 == n)
from = to = XLFD_ENCODING_INDEX,
@@ -994,9 +1001,8 @@ font_expand_wildcards (Lisp_Object *field, int n)
a fully specified XLFD. */
int
-font_parse_xlfd (char *name, Lisp_Object font)
+font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font)
{
- ptrdiff_t len = strlen (name);
int i, j, n;
char *f[XLFD_LAST_INDEX + 1];
Lisp_Object val;
@@ -1062,11 +1068,11 @@ font_parse_xlfd (char *name, Lisp_Object font)
{
double point_size = -1;
- font_assert (FONT_SPEC_P (font));
+ eassert (FONT_SPEC_P (font));
p = f[XLFD_POINT_INDEX];
if (*p == '[')
point_size = parse_matrix (p);
- else if (isdigit (*p))
+ else if (c_isdigit (*p))
point_size = atoi (p), point_size /= 10;
if (point_size >= 0)
ASET (font, FONT_SIZE_INDEX, make_float (point_size));
@@ -1095,7 +1101,7 @@ font_parse_xlfd (char *name, Lisp_Object font)
}
else
{
- int wild_card_found = 0;
+ bool wild_card_found = 0;
Lisp_Object prop[XLFD_LAST_INDEX];
if (FONT_ENTITY_P (font))
@@ -1175,7 +1181,7 @@ font_parse_xlfd (char *name, Lisp_Object font)
length), and return the name length. If FONT_SIZE_INDEX of FONT is
0, use PIXEL_SIZE instead. */
-int
+ptrdiff_t
font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
{
char *p;
@@ -1183,7 +1189,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
Lisp_Object val;
int i, j, len;
- font_assert (FONTP (font));
+ eassert (FONTP (font));
for (i = FONT_FOUNDRY_INDEX, j = XLFD_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX;
i++, j++)
@@ -1234,7 +1240,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
}
val = AREF (font, FONT_SIZE_INDEX);
- font_assert (NUMBERP (val) || NILP (val));
+ eassert (NUMBERP (val) || NILP (val));
if (INTEGERP (val))
{
EMACS_INT v = XINT (val);
@@ -1311,12 +1317,11 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
This function tries to guess which format it is. */
static int
-font_parse_fcname (char *name, Lisp_Object font)
+font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font)
{
char *p, *q;
char *size_beg = NULL, *size_end = NULL;
char *props_beg = NULL, *family_end = NULL;
- ptrdiff_t len = strlen (name);
if (len == 0)
return -1;
@@ -1332,9 +1337,9 @@ font_parse_fcname (char *name, Lisp_Object font)
}
else if (*p == '-')
{
- int decimal = 0, size_found = 1;
+ bool decimal = 0, size_found = 1;
for (q = p + 1; *q && *q != ':'; q++)
- if (! isdigit (*q))
+ if (! c_isdigit (*q))
{
if (*q != '.' || decimal)
{
@@ -1462,7 +1467,7 @@ font_parse_fcname (char *name, Lisp_Object font)
/* Scan backwards from the end, looking for a size. */
for (p = name + len - 1; p >= name; p--)
- if (!isdigit (*p))
+ if (!c_isdigit (*p))
break;
if ((p < name + len - 1) && ((p + 1 == name) || *p == ' '))
@@ -1572,8 +1577,7 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes)
}
else
{
- if (! FLOATP (val))
- abort ();
+ eassert (FLOATP (val));
pixel_size = -1;
point_size = (int) XFLOAT_DATA (val);
}
@@ -1669,11 +1673,11 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes)
0. Otherwise return -1. */
static int
-font_parse_name (char *name, Lisp_Object font)
+font_parse_name (char *name, ptrdiff_t namelen, Lisp_Object font)
{
if (name[0] == '-' || strchr (name, '*') || strchr (name, '?'))
- return font_parse_xlfd (name, font);
- return font_parse_fcname (name, font);
+ return font_parse_xlfd (name, namelen, font);
+ return font_parse_fcname (name, namelen, font);
}
@@ -1740,7 +1744,8 @@ static int
check_gstring (Lisp_Object gstring)
{
Lisp_Object val;
- int i, j;
+ ptrdiff_t i;
+ int j;
CHECK_VECTOR (gstring);
val = AREF (gstring, 0);
@@ -1801,17 +1806,17 @@ check_otf_features (Lisp_Object otf_features)
CHECK_CONS (otf_features);
CHECK_SYMBOL (XCAR (otf_features));
otf_features = XCDR (otf_features);
- for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
+ for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
{
- CHECK_SYMBOL (Fcar (val));
+ CHECK_SYMBOL (XCAR (val));
if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
error ("Invalid OTF GSUB feature: %s",
SDATA (SYMBOL_NAME (XCAR (val))));
}
otf_features = XCDR (otf_features);
- for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
+ for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
{
- CHECK_SYMBOL (Fcar (val));
+ CHECK_SYMBOL (XCAR (val));
if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
error ("Invalid OTF GPOS feature: %s",
SDATA (SYMBOL_NAME (XCAR (val))));
@@ -1933,7 +1938,7 @@ generate_otf_features (Lisp_Object spec, char *features)
{
Lisp_Object val;
char *p;
- int asterisk;
+ bool asterisk;
p = features;
*p = '\0';
@@ -2124,7 +2129,7 @@ static Lisp_Object
font_vconcat_entity_vectors (Lisp_Object list)
{
int nargs = XINT (Flength (list));
- Lisp_Object *args = alloca (sizeof (Lisp_Object) * nargs);
+ Lisp_Object *args = alloca (word_size * nargs);
int i;
for (i = 0; i < nargs; i++, list = XCDR (list))
@@ -2213,7 +2218,7 @@ font_sort_entities (Lisp_Object list, Lisp_Object prefer, Lisp_Object frame, int
maxlen = ASIZE (vec);
}
- SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * maxlen);
+ data = SAFE_ALLOCA (maxlen * sizeof *data);
best_score = 0xFFFFFFFF;
best_entity = Qnil;
@@ -2297,11 +2302,12 @@ font_update_sort_order (int *order)
}
}
-static int
-font_check_otf_features (Lisp_Object script, Lisp_Object langsys, Lisp_Object features, Lisp_Object table)
+static bool
+font_check_otf_features (Lisp_Object script, Lisp_Object langsys,
+ Lisp_Object features, Lisp_Object table)
{
Lisp_Object val;
- int negative;
+ bool negative;
table = assq_no_quit (script, table);
if (NILP (table))
@@ -2337,7 +2343,7 @@ font_check_otf_features (Lisp_Object script, Lisp_Object langsys, Lisp_Object fe
/* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
-static int
+static bool
font_check_otf (Lisp_Object spec, Lisp_Object otf_capability)
{
Lisp_Object script, langsys = Qnil, gsub = Qnil, gpos = Qnil;
@@ -2371,7 +2377,7 @@ font_check_otf (Lisp_Object spec, Lisp_Object otf_capability)
/* Check if FONT (font-entity or font-object) matches with the font
specification SPEC. */
-int
+bool
font_match_p (Lisp_Object spec, Lisp_Object font)
{
Lisp_Object prop[FONT_SPEC_MAX], *props;
@@ -2433,7 +2439,7 @@ font_match_p (Lisp_Object spec, Lisp_Object font)
/* All characters in the list must be supported. */
for (; CONSP (val2); val2 = XCDR (val2))
{
- if (! NATNUMP (XCAR (val2)))
+ if (! CHARACTERP (XCAR (val2)))
continue;
if (font_encode_char (font, XFASTINT (XCAR (val2)))
== FONT_INVALID_CODE)
@@ -2445,7 +2451,7 @@ font_match_p (Lisp_Object spec, Lisp_Object font)
/* At most one character in the vector must be supported. */
for (i = 0; i < ASIZE (val2); i++)
{
- if (! NATNUMP (AREF (val2, i)))
+ if (! CHARACTERP (AREF (val2, i)))
continue;
if (font_encode_char (font, XFASTINT (AREF (val2, i)))
!= FONT_INVALID_CODE)
@@ -2526,7 +2532,7 @@ font_finish_cache (FRAME_PTR f, struct font_driver *driver)
val = XCDR (cache);
while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
cache = val, val = XCDR (val);
- font_assert (! NILP (val));
+ eassert (! NILP (val));
tmp = XCDR (XCAR (val));
XSETCAR (tmp, make_number (XINT (XCAR (tmp)) - 1));
if (XINT (XCAR (tmp)) == 0)
@@ -2543,9 +2549,9 @@ font_get_cache (FRAME_PTR f, struct font_driver *driver)
Lisp_Object val = driver->get_cache (f);
Lisp_Object type = driver->type;
- font_assert (CONSP (val));
+ eassert (CONSP (val));
for (val = XCDR (val); ! EQ (XCAR (XCAR (val)), type); val = XCDR (val));
- font_assert (CONSP (val));
+ eassert (CONSP (val));
/* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
val = XCDR (XCAR (val));
return val;
@@ -2582,7 +2588,7 @@ font_clear_cache (FRAME_PTR f, Lisp_Object cache, struct font_driver *driver)
if (! NILP (AREF (val, FONT_TYPE_INDEX)))
{
- font_assert (font && driver == font->driver);
+ eassert (font && driver == font->driver);
driver->close (f, font);
num_fonts--;
}
@@ -2618,15 +2624,18 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size)
if (! NILP (Vface_ignored_fonts))
{
char name[256];
+ ptrdiff_t namelen;
Lisp_Object tail, regexp;
- if (font_unparse_xlfd (entity, 0, name, 256) >= 0)
+ namelen = font_unparse_xlfd (entity, 0, name, 256);
+ if (namelen >= 0)
{
for (tail = Vface_ignored_fonts; CONSP (tail); tail = XCDR (tail))
{
regexp = XCAR (tail);
if (STRINGP (regexp)
- && fast_c_string_match_ignore_case (regexp, name) >= 0)
+ && fast_c_string_match_ignore_case (regexp, name,
+ namelen) >= 0)
break;
}
if (CONSP (tail))
@@ -2686,10 +2695,10 @@ font_list_entities (Lisp_Object frame, Lisp_Object spec)
Lisp_Object ftype, val;
Lisp_Object list = Qnil;
int size;
- int need_filtering = 0;
+ bool need_filtering = 0;
int i;
- font_assert (FONT_SPEC_P (spec));
+ eassert (FONT_SPEC_P (spec));
if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
size = XINT (AREF (spec, FONT_SIZE_INDEX));
@@ -2727,7 +2736,7 @@ font_list_entities (Lisp_Object frame, Lisp_Object spec)
val = driver_list->driver->list (frame, scratch_font_spec);
if (NILP (val))
- val = null_vector;
+ val = zero_vector;
else
val = Fvconcat (1, &val);
copy = copy_font_spec (scratch_font_spec);
@@ -2807,14 +2816,11 @@ font_open_entity (FRAME_PTR f, Lisp_Object entity, int pixel_size)
Lisp_Object objlist, size, val, font_object;
struct font *font;
int min_width, height;
- int scaled_pixel_size = pixel_size;
- font_assert (FONT_ENTITY_P (entity));
+ eassert (FONT_ENTITY_P (entity));
size = AREF (entity, FONT_SIZE_INDEX);
if (XINT (size) != 0)
- scaled_pixel_size = pixel_size = XINT (size);
- else if (CONSP (Vface_font_rescale_alist))
- scaled_pixel_size = pixel_size * font_rescale_ratio (entity);
+ pixel_size = XINT (size);
val = AREF (entity, FONT_TYPE_INDEX);
for (driver_list = f->font_driver_list;
@@ -2836,7 +2842,7 @@ font_open_entity (FRAME_PTR f, Lisp_Object entity, int pixel_size)
}
}
- font_object = driver_list->driver->open (f, entity, scaled_pixel_size);
+ font_object = driver_list->driver->open (f, entity, pixel_size);
if (!NILP (font_object))
ASET (font_object, FONT_SIZE_INDEX, make_number (pixel_size));
FONT_ADD_LOG ("open", entity, font_object);
@@ -2886,7 +2892,7 @@ font_close_object (FRAME_PTR f, Lisp_Object font_object)
FONT_ADD_LOG ("close", font_object, Qnil);
font->driver->close (f, font);
#ifdef HAVE_WINDOW_SYSTEM
- font_assert (FRAME_X_DISPLAY_INFO (f)->n_fonts);
+ eassert (FRAME_X_DISPLAY_INFO (f)->n_fonts);
FRAME_X_DISPLAY_INFO (f)->n_fonts--;
#endif
num_fonts--;
@@ -2916,7 +2922,7 @@ font_has_char (FRAME_PTR f, Lisp_Object font, int c)
return driver_list->driver->has_char (font, c);
}
- font_assert (FONT_OBJECT_P (font));
+ eassert (FONT_OBJECT_P (font));
fontp = XFONT_OBJECT (font);
if (fontp->driver->has_char)
{
@@ -2936,7 +2942,7 @@ font_encode_char (Lisp_Object font_object, int c)
{
struct font *font;
- font_assert (FONT_OBJECT_P (font_object));
+ eassert (FONT_OBJECT_P (font_object));
font = XFONT_OBJECT (font_object);
return font->driver->encode_char (font, c);
}
@@ -2947,7 +2953,7 @@ font_encode_char (Lisp_Object font_object, int c)
Lisp_Object
font_get_name (Lisp_Object font_object)
{
- font_assert (FONT_OBJECT_P (font_object));
+ eassert (FONT_OBJECT_P (font_object));
return AREF (font_object, FONT_NAME_INDEX);
}
@@ -2961,7 +2967,7 @@ font_spec_from_name (Lisp_Object font_name)
Lisp_Object spec = Ffont_spec (0, NULL);
CHECK_STRING (font_name);
- if (font_parse_name (SSDATA (font_name), spec) == -1)
+ if (font_parse_name (SSDATA (font_name), SBYTES (font_name), spec) == -1)
return Qnil;
font_put_extra (spec, QCname, font_name);
font_put_extra (spec, QCuser_spec, font_name);
@@ -3028,15 +3034,14 @@ font_select_entity (Lisp_Object frame, Lisp_Object entities, Lisp_Object *attrs,
{
Lisp_Object font_entity;
Lisp_Object prefer;
- int result, i;
+ int i;
FRAME_PTR f = XFRAME (frame);
if (NILP (XCDR (entities))
&& ASIZE (XCAR (entities)) == 1)
{
font_entity = AREF (XCAR (entities), 0);
- if (c < 0
- || (result = font_has_char (f, font_entity, c)) > 0)
+ if (c < 0 || font_has_char (f, font_entity, c) > 0)
return font_entity;
return Qnil;
}
@@ -3076,16 +3081,17 @@ font_find_for_lface (FRAME_PTR f, Lisp_Object *attrs, Lisp_Object spec, int c)
Lisp_Object foundry[3], *family, registry[3], adstyle[3];
int pixel_size;
int i, j, k, l;
+ USE_SAFE_ALLOCA;
registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
if (NILP (registry[0]))
{
registry[0] = DEFAULT_ENCODING;
registry[1] = Qascii_0;
- registry[2] = null_vector;
+ registry[2] = zero_vector;
}
else
- registry[1] = null_vector;
+ registry[1] = zero_vector;
if (c >= 0 && ! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
{
@@ -3114,20 +3120,20 @@ font_find_for_lface (FRAME_PTR f, Lisp_Object *attrs, Lisp_Object spec, int c)
ASET (work, FONT_SIZE_INDEX, Qnil);
foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
if (! NILP (foundry[0]))
- foundry[1] = null_vector;
+ foundry[1] = zero_vector;
else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
{
val = attrs[LFACE_FOUNDRY_INDEX];
foundry[0] = font_intern_prop (SSDATA (val), SBYTES (val), 1);
foundry[1] = Qnil;
- foundry[2] = null_vector;
+ foundry[2] = zero_vector;
}
else
- foundry[0] = Qnil, foundry[1] = null_vector;
+ foundry[0] = Qnil, foundry[1] = zero_vector;
adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX);
if (! NILP (adstyle[0]))
- adstyle[1] = null_vector;
+ adstyle[1] = zero_vector;
else if (FONTP (attrs[LFACE_FONT_INDEX]))
{
Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
@@ -3136,13 +3142,13 @@ font_find_for_lface (FRAME_PTR f, Lisp_Object *attrs, Lisp_Object spec, int c)
{
adstyle[0] = AREF (face_font, FONT_ADSTYLE_INDEX);
adstyle[1] = Qnil;
- adstyle[2] = null_vector;
+ adstyle[2] = zero_vector;
}
else
- adstyle[0] = Qnil, adstyle[1] = null_vector;
+ adstyle[0] = Qnil, adstyle[1] = zero_vector;
}
else
- adstyle[0] = Qnil, adstyle[1] = null_vector;
+ adstyle[0] = Qnil, adstyle[1] = zero_vector;
val = AREF (work, FONT_FAMILY_INDEX);
@@ -3155,7 +3161,7 @@ font_find_for_lface (FRAME_PTR f, Lisp_Object *attrs, Lisp_Object spec, int c)
{
family = alloca ((sizeof family[0]) * 2);
family[0] = Qnil;
- family[1] = null_vector; /* terminator. */
+ family[1] = zero_vector; /* terminator. */
}
else
{
@@ -3164,12 +3170,13 @@ font_find_for_lface (FRAME_PTR f, Lisp_Object *attrs, Lisp_Object spec, int c)
if (! NILP (alters))
{
- family = alloca ((sizeof family[0]) * (XINT (Flength (alters)) + 2));
+ EMACS_INT alterslen = XFASTINT (Flength (alters));
+ SAFE_ALLOCA_LISP (family, alterslen + 2);
for (i = 0; CONSP (alters); i++, alters = XCDR (alters))
family[i] = XCAR (alters);
if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
family[i++] = Qnil;
- family[i] = null_vector;
+ family[i] = zero_vector;
}
else
{
@@ -3178,7 +3185,7 @@ font_find_for_lface (FRAME_PTR f, Lisp_Object *attrs, Lisp_Object spec, int c)
family[i++] = val;
if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
family[i++] = Qnil;
- family[i] = null_vector;
+ family[i] = zero_vector;
}
}
@@ -3206,6 +3213,8 @@ font_find_for_lface (FRAME_PTR f, Lisp_Object *attrs, Lisp_Object spec, int c)
}
}
}
+
+ SAFE_FREE ();
return Qnil;
}
@@ -3218,33 +3227,36 @@ font_open_for_lface (FRAME_PTR f, Lisp_Object entity, Lisp_Object *attrs, Lisp_O
if (INTEGERP (AREF (entity, FONT_SIZE_INDEX))
&& XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
size = XINT (AREF (entity, FONT_SIZE_INDEX));
- else if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX)))
- size = font_pixel_size (f, spec);
else
{
- double pt;
- if (INTEGERP (attrs[LFACE_HEIGHT_INDEX]))
- pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
+ if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX)))
+ size = font_pixel_size (f, spec);
else
{
- struct face *def = FACE_FROM_ID (f, DEFAULT_FACE_ID);
- Lisp_Object height = def->lface[LFACE_HEIGHT_INDEX];
- if (INTEGERP (height))
- pt = XINT (height);
+ double pt;
+ if (INTEGERP (attrs[LFACE_HEIGHT_INDEX]))
+ pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
else
- abort (); /* We should never end up here. */
- }
+ {
+ struct face *def = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ Lisp_Object height = def->lface[LFACE_HEIGHT_INDEX];
+ eassert (INTEGERP (height));
+ pt = XINT (height);
+ }
- pt /= 10;
- size = POINT_TO_PIXEL (pt, f->resy);
+ pt /= 10;
+ size = POINT_TO_PIXEL (pt, f->resy);
#ifdef HAVE_NS
- if (size == 0)
- {
- Lisp_Object ffsize = get_frame_param (f, Qfontsize);
- size = NUMBERP (ffsize) ? POINT_TO_PIXEL (XINT (ffsize), f->resy) : 0;
- }
+ if (size == 0)
+ {
+ Lisp_Object ffsize = get_frame_param (f, Qfontsize);
+ size = NUMBERP (ffsize) ? POINT_TO_PIXEL (XINT (ffsize), f->resy) : 0;
+ }
#endif
+ }
+ size *= font_rescale_ratio (entity);
}
+
return font_open_entity (f, entity, size);
}
@@ -3329,13 +3341,13 @@ font_open_by_spec (FRAME_PTR f, Lisp_Object spec)
found, return Qnil. */
Lisp_Object
-font_open_by_name (FRAME_PTR f, const char *name)
+font_open_by_name (FRAME_PTR f, Lisp_Object name)
{
Lisp_Object args[2];
Lisp_Object spec, ret;
args[0] = QCname;
- args[1] = make_unibyte_string (name, strlen (name));
+ args[1] = name;
spec = Ffont_spec (2, args);
ret = font_open_by_spec (f, spec);
/* Do not lose name originally put in. */
@@ -3372,7 +3384,7 @@ register_font_driver (struct font_driver *driver, FRAME_PTR f)
if (EQ (list->driver->type, driver->type))
error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
- list = xmalloc (sizeof (struct font_driver_list));
+ list = xmalloc (sizeof *list);
list->on = 0;
list->driver = driver;
list->next = NULL;
@@ -3522,7 +3534,7 @@ font_put_frame_data (FRAME_PTR f, struct font_driver *driver, void *data)
if (! list)
{
- list = xmalloc (sizeof (struct font_data_list));
+ list = xmalloc (sizeof *list);
list->driver = driver;
list->next = f->font_data_list;
f->font_data_list = list;
@@ -3604,11 +3616,11 @@ font_filter_properties (Lisp_Object font,
STRING. */
static Lisp_Object
-font_at (int c, EMACS_INT pos, struct face *face, struct window *w,
+font_at (int c, ptrdiff_t pos, struct face *face, struct window *w,
Lisp_Object string)
{
FRAME_PTR f;
- int multibyte;
+ bool multibyte;
Lisp_Object font_object;
multibyte = (NILP (string)
@@ -3620,7 +3632,7 @@ font_at (int c, EMACS_INT pos, struct face *face, struct window *w,
{
if (multibyte)
{
- EMACS_INT pos_byte = CHAR_TO_BYTE (pos);
+ ptrdiff_t pos_byte = CHAR_TO_BYTE (pos);
c = FETCH_CHAR (pos_byte);
}
@@ -3634,7 +3646,7 @@ font_at (int c, EMACS_INT pos, struct face *face, struct window *w,
multibyte = STRING_MULTIBYTE (string);
if (multibyte)
{
- EMACS_INT pos_byte = string_char_to_byte (string, pos);
+ ptrdiff_t pos_byte = string_char_to_byte (string, pos);
str = SDATA (string) + pos_byte;
c = STRING_CHAR (str);
@@ -3650,7 +3662,7 @@ font_at (int c, EMACS_INT pos, struct face *face, struct window *w,
if (! face)
{
int face_id;
- EMACS_INT endptr;
+ ptrdiff_t endptr;
if (STRINGP (string))
face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr,
@@ -3687,9 +3699,9 @@ font_at (int c, EMACS_INT pos, struct face *face, struct window *w,
It is assured that the current buffer (or STRING) is multibyte. */
Lisp_Object
-font_range (EMACS_INT pos, EMACS_INT *limit, struct window *w, struct face *face, Lisp_Object string)
+font_range (ptrdiff_t pos, ptrdiff_t *limit, struct window *w, struct face *face, Lisp_Object string)
{
- EMACS_INT pos_byte, ignore;
+ ptrdiff_t pos_byte, ignore;
int c;
Lisp_Object font_object = Qnil;
@@ -3707,7 +3719,7 @@ font_range (EMACS_INT pos, EMACS_INT *limit, struct window *w, struct face *face
}
else
{
- font_assert (face);
+ eassert (face);
pos_byte = string_char_to_byte (string, pos);
}
@@ -3842,7 +3854,7 @@ usage: (font-spec ARGS...) */)
if (EQ (key, QCname))
{
CHECK_STRING (val);
- font_parse_name (SSDATA (val), spec);
+ font_parse_name (SSDATA (val), SBYTES (val), spec);
font_put_extra (spec, key, val);
}
else
@@ -3981,16 +3993,11 @@ The optional argument FRAME specifies the frame that the face attributes
are to be displayed on. If omitted, the selected frame is used. */)
(Lisp_Object font, Lisp_Object frame)
{
- struct frame *f;
+ struct frame *f = decode_live_frame (frame);
Lisp_Object plist[10];
Lisp_Object val;
int n = 0;
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
-
if (STRINGP (font))
{
int fontset = fs_query_fontset (font, 0);
@@ -4095,7 +4102,7 @@ how close they are to PREFER. */)
(Lisp_Object font_spec, Lisp_Object frame, Lisp_Object num, Lisp_Object prefer)
{
Lisp_Object vec, list;
- int n = 0;
+ EMACS_INT n = 0;
if (NILP (frame))
frame = selected_frame;
@@ -4140,18 +4147,15 @@ how close they are to PREFER. */)
DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,
doc: /* List available font families on the current frame.
-Optional argument FRAME, if non-nil, specifies the target frame. */)
+If FRAME is omitted or nil, the selected frame is used. */)
(Lisp_Object frame)
{
- FRAME_PTR f;
+ struct frame *f = decode_live_frame (frame);
struct font_driver_list *driver_list;
- Lisp_Object list;
+ Lisp_Object list = Qnil;
+
+ XSETFRAME (frame, f);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
- list = Qnil;
for (driver_list = f->font_driver_list; driver_list;
driver_list = driver_list->next)
if (driver_list->driver->list_family)
@@ -4188,7 +4192,7 @@ the consecutive wildcards are folded into one. */)
(Lisp_Object font, Lisp_Object fold_wildcards)
{
char name[256];
- int pixel_size = 0;
+ int namelen, pixel_size = 0;
CHECK_FONT (font);
@@ -4202,11 +4206,13 @@ the consecutive wildcards are folded into one. */)
if (NILP (fold_wildcards))
return font_name;
strcpy (name, SSDATA (font_name));
+ namelen = SBYTES (font_name);
goto done;
}
pixel_size = XFONT_OBJECT (font)->pixel_size;
}
- if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
+ namelen = font_unparse_xlfd (font, pixel_size, name, 256);
+ if (namelen < 0)
return Qnil;
done:
if (! NILP (fold_wildcards))
@@ -4216,11 +4222,12 @@ the consecutive wildcards are folded into one. */)
while ((p1 = strstr (p0, "-*-*")))
{
strcpy (p1, p1 + 2);
+ namelen -= 2;
p0 = p1;
}
}
- return build_string (name);
+ return make_string (name, namelen);
}
DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
@@ -4244,7 +4251,7 @@ DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
while (! NILP (val)
&& ! EQ (XCAR (XCAR (val)), driver_list->driver->type))
val = XCDR (val);
- font_assert (! NILP (val));
+ eassert (! NILP (val));
tmp = XCDR (XCAR (val));
if (XINT (XCAR (tmp)) == 0)
{
@@ -4262,13 +4269,10 @@ void
font_fill_lglyph_metrics (Lisp_Object glyph, Lisp_Object font_object)
{
struct font *font = XFONT_OBJECT (font_object);
- unsigned code;
- /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
- EMACS_INT ecode = font->driver->encode_char (font, LGLYPH_CHAR (glyph));
+ unsigned code = font->driver->encode_char (font, LGLYPH_CHAR (glyph));
struct font_metrics metrics;
- LGLYPH_SET_CODE (glyph, ecode);
- code = ecode;
+ LGLYPH_SET_CODE (glyph, code);
font->driver->text_extents (font, &code, 1, &metrics);
LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
@@ -4285,12 +4289,15 @@ to get the correct visual image of character sequences set in the
header of the glyph-string.
If the shaping was successful, the value is GSTRING itself or a newly
-created glyph-string. Otherwise, the value is nil. */)
+created glyph-string. Otherwise, the value is nil.
+
+See the documentation of `composition-get-gstring' for the format of
+GSTRING. */)
(Lisp_Object gstring)
{
struct font *font;
Lisp_Object font_object, n, glyph;
- EMACS_INT i, j, from, to;
+ ptrdiff_t i, from, to;
if (! composition_gstring_p (gstring))
signal_error ("Invalid glyph-string: ", gstring);
@@ -4309,52 +4316,49 @@ created glyph-string. Otherwise, the value is nil. */)
if (INTEGERP (n))
break;
gstring = larger_vector (gstring,
- ASIZE (gstring) + LGSTRING_GLYPH_LEN (gstring),
- Qnil);
+ LGSTRING_GLYPH_LEN (gstring), -1);
}
if (i == 3 || XINT (n) == 0)
return Qnil;
if (XINT (n) < LGSTRING_GLYPH_LEN (gstring))
LGSTRING_SET_GLYPH (gstring, XINT (n), Qnil);
+ /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
+ GLYPHS covers all characters (except for the last few ones) in
+ GSTRING. More formally, provided that NCHARS is the number of
+ characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
+ and TO_IDX of each glyph must satisfy these conditions:
+
+ GLYPHS[0].FROM_IDX == 0
+ GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
+ if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
+ ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
+ GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
+ else
+ ;; Be sure to cover all characters.
+ GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
glyph = LGSTRING_GLYPH (gstring, 0);
from = LGLYPH_FROM (glyph);
to = LGLYPH_TO (glyph);
- for (i = 1, j = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
+ if (from != 0 || to < from)
+ goto shaper_error;
+ for (i = 1; i < LGSTRING_GLYPH_LEN (gstring); i++)
{
- Lisp_Object this = LGSTRING_GLYPH (gstring, i);
-
- if (NILP (this))
+ glyph = LGSTRING_GLYPH (gstring, i);
+ if (NILP (glyph))
break;
- if (NILP (LGLYPH_ADJUSTMENT (this)))
- {
- if (j < i - 1)
- for (; j < i; j++)
- {
- glyph = LGSTRING_GLYPH (gstring, j);
- LGLYPH_SET_FROM (glyph, from);
- LGLYPH_SET_TO (glyph, to);
- }
- from = LGLYPH_FROM (this);
- to = LGLYPH_TO (this);
- j = i;
- }
- else
- {
- if (from > LGLYPH_FROM (this))
- from = LGLYPH_FROM (this);
- if (to < LGLYPH_TO (this))
- to = LGLYPH_TO (this);
- }
+ if (! (LGLYPH_FROM (glyph) <= LGLYPH_TO (glyph)
+ && (LGLYPH_FROM (glyph) == from
+ ? LGLYPH_TO (glyph) == to
+ : LGLYPH_FROM (glyph) == to + 1)))
+ goto shaper_error;
+ from = LGLYPH_FROM (glyph);
+ to = LGLYPH_TO (glyph);
}
- if (j < i - 1)
- for (; j < i; j++)
- {
- glyph = LGSTRING_GLYPH (gstring, j);
- LGLYPH_SET_FROM (glyph, from);
- LGLYPH_SET_TO (glyph, to);
- }
return composition_gstring_put_cache (gstring, XINT (n));
+
+ shaper_error:
+ return Qnil;
}
DEFUN ("font-variation-glyphs", Ffont_variation_glyphs, Sfont_variation_glyphs,
@@ -4518,12 +4522,10 @@ DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
doc: /* Open FONT-ENTITY. */)
(Lisp_Object font_entity, Lisp_Object size, Lisp_Object frame)
{
- int isize;
+ EMACS_INT isize;
+ struct frame *f = decode_live_frame (frame);
CHECK_FONT_ENTITY (font_entity);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
if (NILP (size))
isize = XINT (AREF (font_entity, FONT_SIZE_INDEX));
@@ -4531,13 +4533,15 @@ DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
{
CHECK_NUMBER_OR_FLOAT (size);
if (FLOATP (size))
- isize = POINT_TO_PIXEL (XFLOAT_DATA (size), XFRAME (frame)->resy);
+ isize = POINT_TO_PIXEL (XFLOAT_DATA (size), f->resy);
else
isize = XINT (size);
+ if (! (INT_MIN <= isize && isize <= INT_MAX))
+ args_out_of_range (font_entity, size);
if (isize == 0)
isize = 120;
}
- return font_open_entity (XFRAME (frame), font_entity, isize);
+ return font_open_entity (f, font_entity, isize);
}
DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
@@ -4545,10 +4549,7 @@ DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
(Lisp_Object font_object, Lisp_Object frame)
{
CHECK_FONT_OBJECT (font_object);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- font_close_object (XFRAME (frame), font_object);
+ font_close_object (decode_live_frame (frame), font_object);
return Qnil;
}
@@ -4637,14 +4638,14 @@ the corresponding element is nil. */)
Lisp_Object object)
{
struct font *font;
- int i, len;
+ ptrdiff_t i, len;
Lisp_Object *chars, vec;
USE_SAFE_ALLOCA;
CHECK_FONT_GET_OBJECT (font_object, font);
if (NILP (object))
{
- EMACS_INT charpos, bytepos;
+ ptrdiff_t charpos, bytepos;
validate_region (&from, &to);
if (EQ (from, to))
@@ -4700,7 +4701,7 @@ the corresponding element is nil. */)
Lisp_Object elt = AREF (object, XFASTINT (from) + i);
CHECK_CHARACTER (elt);
}
- chars = &(AREF (object, XFASTINT (from)));
+ chars = aref_addr (object, XFASTINT (from));
}
vec = Fmake_vector (make_number (len), Qnil);
@@ -4746,33 +4747,30 @@ FONT is a font-spec, font-entity, or font-object. */)
DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0,
doc: /* Return a font-object for displaying a character at POSITION.
Optional second arg WINDOW, if non-nil, is a window displaying
-the current buffer. It defaults to the currently selected window. */)
+the current buffer. It defaults to the currently selected window.
+Optional third arg STRING, if non-nil, is a string containing the target
+character at index specified by POSITION. */)
(Lisp_Object position, Lisp_Object window, Lisp_Object string)
{
- struct window *w;
- EMACS_INT pos;
+ struct window *w = decode_live_window (window);
if (NILP (string))
{
+ if (XBUFFER (w->buffer) != current_buffer)
+ error ("Specified window is not displaying the current buffer.");
CHECK_NUMBER_COERCE_MARKER (position);
- pos = XINT (position);
- if (pos < BEGV || pos >= ZV)
+ if (! (BEGV <= XINT (position) && XINT (position) < ZV))
args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
}
else
{
CHECK_NUMBER (position);
CHECK_STRING (string);
- pos = XINT (position);
- if (pos < 0 || pos >= SCHARS (string))
+ if (! (0 <= XINT (position) && XINT (position) < SCHARS (string)))
args_out_of_range (string, position);
}
- if (NILP (window))
- window = selected_window;
- CHECK_LIVE_WINDOW (window);
- w = XWINDOW (window);
- return font_at (-1, pos, NULL, w, string);
+ return font_at (-1, XINT (position), NULL, w, string);
}
#if 0
@@ -4836,7 +4834,7 @@ where
If the named font is not yet loaded, return nil. */)
(Lisp_Object name, Lisp_Object frame)
{
- FRAME_PTR f;
+ struct frame *f;
struct font *font;
Lisp_Object info;
Lisp_Object font_object;
@@ -4845,10 +4843,7 @@ If the named font is not yet loaded, return nil. */)
if (! FONTP (name))
CHECK_STRING (name);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
+ f = decode_live_frame (frame);
if (STRINGP (name))
{
@@ -4856,7 +4851,7 @@ If the named font is not yet loaded, return nil. */)
if (fontset >= 0)
name = fontset_ascii (fontset);
- font_object = font_open_by_name (f, SSDATA (name));
+ font_object = font_open_by_name (f, name);
}
else if (FONT_OBJECT_P (name))
font_object = name;
@@ -4874,13 +4869,13 @@ If the named font is not yet loaded, return nil. */)
font = XFONT_OBJECT (font_object);
info = Fmake_vector (make_number (7), Qnil);
- XVECTOR (info)->contents[0] = AREF (font_object, FONT_NAME_INDEX);
- XVECTOR (info)->contents[1] = AREF (font_object, FONT_FULLNAME_INDEX);
- XVECTOR (info)->contents[2] = make_number (font->pixel_size);
- XVECTOR (info)->contents[3] = make_number (font->height);
- XVECTOR (info)->contents[4] = make_number (font->baseline_offset);
- XVECTOR (info)->contents[5] = make_number (font->relative_compose);
- XVECTOR (info)->contents[6] = make_number (font->default_ascent);
+ ASET (info, 0, AREF (font_object, FONT_NAME_INDEX));
+ ASET (info, 1, AREF (font_object, FONT_FULLNAME_INDEX));
+ ASET (info, 2, make_number (font->pixel_size));
+ ASET (info, 3, make_number (font->height));
+ ASET (info, 4, make_number (font->baseline_offset));
+ ASET (info, 5, make_number (font->relative_compose));
+ ASET (info, 6, make_number (font->default_ascent));
#if 0
/* As font_object is still in FONT_OBJLIST of the entity, we can't
@@ -5069,9 +5064,6 @@ syms_of_font (void)
DEFSYM (QCuser_spec, "user-spec");
- staticpro (&null_vector);
- null_vector = Fmake_vector (make_number (0), Qnil);
-
staticpro (&scratch_font_spec);
scratch_font_spec = Ffont_spec (0, NULL);
staticpro (&scratch_font_prefer);
@@ -5199,9 +5191,9 @@ EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
#ifdef HAVE_BDFFONT
syms_of_bdffont ();
#endif /* HAVE_BDFFONT */
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
syms_of_w32font ();
-#endif /* WINDOWSNT */
+#endif /* HAVE_NTGUI */
#ifdef HAVE_NS
syms_of_nsfont ();
#endif /* HAVE_NS */
diff --git a/src/font.h b/src/font.h
index b6c1acf4a30..3035a909efc 100644
--- a/src/font.h
+++ b/src/font.h
@@ -1,5 +1,5 @@
/* font.h -- Interface definition for font handling.
- Copyright (C) 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 2006-2012 Free Software Foundation, Inc.
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
@@ -23,6 +23,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define EMACS_FONT_H
#include "ccl.h"
+#include "frame.h"
/* We have three types of Lisp objects related to font.
@@ -284,8 +285,11 @@ struct font
/* Beyond here, there should be no more Lisp_Object components. */
- /* Maximum bound width over all existing characters of the font. On
- X window, this is same as (font->max_bounds.width). */
+ /* Minimum and maximum glyph widths, in pixels. Some font backends,
+ such as xft, lack the information to easily compute minimum and
+ maximum widths over all characters; in that case, these values
+ are approximate. */
+ int min_width;
int max_width;
/* By which pixel size the font is opened. */
@@ -301,13 +305,10 @@ struct font
/* Average width of glyphs in the font. If the font itself doesn't
have that information but has glyphs of ASCII characters, the
- value is the average with of those glyphs. Otherwise, the value
+ value is the average width of those glyphs. Otherwise, the value
is 0. */
int average_width;
- /* Minimum glyph width (in pixels). */
- int min_width;
-
/* Ascent and descent of the font (in pixels). */
int ascent, descent;
@@ -320,19 +321,10 @@ struct font
negative if that information is not in the font. */
int underline_position;
- /* 1 if `vertical-centering-font-regexp' matches this font name.
+ /* True if `vertical-centering-font-regexp' matches this font name.
In this case, we render characters at vertical center positions
of lines. */
- int vertical_centering;
-
- /* Encoding type of the font. The value is one of
- 0, 1, 2, or 3:
- 0: code points 0x20..0x7F or 0x2020..0x7F7F are used
- 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used
- 2: code points 0x20A0..0x7FFF are used
- 3: code points 0xA020..0xFF7F are used
- If the member `font_encoder' is not NULL, this member is ignored. */
- unsigned char encoding_type;
+ bool vertical_centering;
/* The baseline position of a font is normally `ascent' value of the
font. However, there exist many fonts which don't set `ascent' to
@@ -469,11 +461,12 @@ struct font_bitmap
} while (0)
#define XFONT_SPEC(p) \
- (eassert (FONT_SPEC_P(p)), (struct font_spec *) XPNTR (p))
+ (eassert (FONT_SPEC_P (p)), (struct font_spec *) XUNTAG (p, Lisp_Vectorlike))
#define XFONT_ENTITY(p) \
- (eassert (FONT_ENTITY_P(p)), (struct font_entity *) XPNTR (p))
+ (eassert (FONT_ENTITY_P (p)), \
+ (struct font_entity *) XUNTAG (p, Lisp_Vectorlike))
#define XFONT_OBJECT(p) \
- (eassert (FONT_OBJECT_P(p)), (struct font *) XPNTR (p))
+ (eassert (FONT_OBJECT_P (p)), (struct font *) XUNTAG (p, Lisp_Vectorlike))
#define XSETFONT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FONT))
/* Number of pt per inch (from the TeXbook). */
@@ -505,9 +498,9 @@ struct font_driver
/* Symbol indicating the type of the font-driver. */
Lisp_Object type;
- /* 1 iff the font's foundry, family, and adstyle names are case
- sensitve. */
- int case_sensitive;
+ /* True iff the font's foundry, family, and adstyle names are case
+ sensitive. */
+ bool case_sensitive;
/* Return a cache of font-entities on frame F. The cache must be a
cons whose cdr part is the actual cache area. */
@@ -591,11 +584,11 @@ struct font_driver
/* Optional.
Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
- position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
- is nonzero, fill the background in advance. It is assured that
- WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars). */
+ position of frame F with S->FACE and S->GC. If WITH_BACKGROUND,
+ fill the background in advance. It is assured that WITH_BACKGROUND
+ is false when (FROM > 0 || TO < S->nchars). */
int (*draw) (struct glyph_string *s, int from, int to,
- int x, int y, int with_background);
+ int x, int y, bool with_background);
/* Optional.
Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
@@ -647,7 +640,7 @@ struct font_driver
short, return -1. */
int (*otf_drive) (struct font *font, Lisp_Object features,
Lisp_Object gstring_in, int from, int to,
- Lisp_Object gstring_out, int idx, int alternate_subst);
+ Lisp_Object gstring_out, int idx, bool alternate_subst);
/* Optional.
Make the font driver ready for frame F. Usually this function
@@ -698,9 +691,9 @@ struct font_driver
Return non-zero if FONT_OBJECT can be used as a (cached) font
for ENTITY on frame F. */
- int (*cached_font_ok) (struct frame *f,
- Lisp_Object font_object,
- Lisp_Object entity);
+ bool (*cached_font_ok) (struct frame *f,
+ Lisp_Object font_object,
+ Lisp_Object entity);
};
@@ -710,9 +703,9 @@ struct font_driver
struct font_driver_list
{
- /* 1 iff this driver is currently used. It is ignored in the global
+ /* True iff this driver is currently used. It is ignored in the global
font driver list.*/
- int on;
+ bool on;
/* Pointer to the font driver. */
struct font_driver *driver;
/* Pointer to the next element of the chain. */
@@ -733,13 +726,8 @@ struct font_data_list
struct font_data_list *next;
};
-EXFUN (Ffont_spec, MANY);
extern Lisp_Object copy_font_spec (Lisp_Object);
extern Lisp_Object merge_font_spec (Lisp_Object, Lisp_Object);
-EXFUN (Ffont_get, 2);
-EXFUN (Ffont_put, 3);
-EXFUN (Flist_fonts, 4);
-EXFUN (Ffont_xlfd_name, 2);
extern Lisp_Object font_make_entity (void);
extern Lisp_Object font_make_object (int, Lisp_Object, int);
@@ -748,12 +736,12 @@ extern Lisp_Object find_font_encoding (Lisp_Object);
extern int font_registry_charsets (Lisp_Object, struct charset **,
struct charset **);
extern int font_style_to_value (enum font_property_index prop,
- Lisp_Object name, int noerror);
+ Lisp_Object name, bool noerror);
extern Lisp_Object font_style_symbolic (Lisp_Object font,
enum font_property_index prop,
- int for_face);
+ bool for_face);
-extern int font_match_p (Lisp_Object spec, Lisp_Object font);
+extern bool font_match_p (Lisp_Object spec, Lisp_Object font);
extern Lisp_Object font_list_entities (Lisp_Object frame,
Lisp_Object spec);
@@ -775,25 +763,25 @@ extern void font_prepare_for_face (FRAME_PTR f, struct face *face);
extern void font_done_for_face (FRAME_PTR f, struct face *face);
extern Lisp_Object font_open_by_spec (FRAME_PTR f, Lisp_Object spec);
-extern Lisp_Object font_open_by_name (FRAME_PTR f, const char *name);
+extern Lisp_Object font_open_by_name (FRAME_PTR f, Lisp_Object name);
extern Lisp_Object font_intern_prop (const char *str, ptrdiff_t len,
- int force_symbol);
+ bool force_symbol);
extern void font_update_sort_order (int *order);
extern void font_parse_family_registry (Lisp_Object family,
Lisp_Object registry,
Lisp_Object spec);
-extern int font_parse_xlfd (char *name, Lisp_Object font);
-extern int font_unparse_xlfd (Lisp_Object font, int pixel_size,
- char *name, int bytes);
+extern int font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font);
+extern ptrdiff_t font_unparse_xlfd (Lisp_Object font, int pixel_size,
+ char *name, int bytes);
extern int font_unparse_fcname (Lisp_Object font, int pixel_size,
char *name, int bytes);
extern void register_font_driver (struct font_driver *driver, FRAME_PTR f);
extern void free_font_driver_list (FRAME_PTR f);
extern Lisp_Object font_update_drivers (FRAME_PTR f, Lisp_Object list);
-extern Lisp_Object font_range (EMACS_INT, EMACS_INT *,
+extern Lisp_Object font_range (ptrdiff_t, ptrdiff_t *,
struct window *, struct face *,
Lisp_Object);
extern void font_fill_lglyph_metrics (Lisp_Object, Lisp_Object);
@@ -821,6 +809,7 @@ extern struct font_driver xfont_driver;
extern void syms_of_xfont (void);
extern void syms_of_ftxfont (void);
#ifdef HAVE_XFT
+extern Lisp_Object Qxft;
extern struct font_driver xftfont_driver;
extern void syms_of_xftfont (void);
#elif defined HAVE_FREETYPE
@@ -830,11 +819,11 @@ extern struct font_driver ftxfont_driver;
extern void syms_of_bdffont (void);
#endif /* HAVE_BDFFONT */
#endif /* HAVE_X_WINDOWS */
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
extern struct font_driver w32font_driver;
extern struct font_driver uniscribe_font_driver;
extern void syms_of_w32font (void);
-#endif /* WINDOWSNT */
+#endif /* HAVE_NTGUI */
#ifdef HAVE_NS
extern Lisp_Object Qfontsize;
extern struct font_driver nsfont_driver;
@@ -862,10 +851,4 @@ extern void font_deferred_log (const char *, Lisp_Object, Lisp_Object);
font_deferred_log ((ACTION), (ARG), (RESULT)); \
} while (0)
-#ifdef FONT_DEBUG
-#define font_assert(X) do {if (!(X)) abort ();} while (0)
-#else /* not FONT_DEBUG */
-#define font_assert(X) (void) 0
-#endif /* not FONT_DEBUG */
-
#endif /* not EMACS_FONT_H */
diff --git a/src/fontset.c b/src/fontset.c
index 281ac92f82d..b76a216bac2 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1,6 +1,6 @@
/* Fontset handler.
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
@@ -24,16 +24,13 @@ 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/>. */
-/* #define FONTSET_DEBUG */
-
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "blockinput.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "ccl.h"
#include "keyboard.h"
@@ -45,7 +42,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_X_WINDOWS
#include "xterm.h"
#endif
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
#include "w32term.h"
#endif
#ifdef HAVE_NS
@@ -55,13 +52,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "font.h"
-#undef xassert
-#ifdef FONTSET_DEBUG
-#define xassert(X) do {if (!(X)) abort ();} while (0)
-#else /* not FONTSET_DEBUG */
-#define xassert(X) (void) 0
-#endif /* not FONTSET_DEBUG */
-
/* FONTSET
A fontset is a collection of font related information to give
@@ -194,30 +184,17 @@ void (*check_window_system_func) (void);
/* Prototype declarations for static functions. */
-static Lisp_Object fontset_add (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object);
-static Lisp_Object fontset_find_font (Lisp_Object, int, struct face *,
- int, int);
-static void reorder_font_vector (Lisp_Object, struct font *);
-static Lisp_Object fontset_font (Lisp_Object, int, struct face *, int);
static Lisp_Object make_fontset (Lisp_Object, Lisp_Object, Lisp_Object);
-static Lisp_Object fontset_pattern_regexp (Lisp_Object);
-static void accumulate_script_ranges (Lisp_Object, Lisp_Object,
- Lisp_Object);
-static void set_fontset_font (Lisp_Object, Lisp_Object);
-#ifdef FONTSET_DEBUG
+/* Return true if ID is a valid fontset id.
+ Optimized away if ENABLE_CHECKING is not defined. */
-/* Return 1 if ID is a valid fontset id, else return 0. */
-
-static int
+static bool
fontset_id_valid_p (int id)
{
return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
}
-#endif
-
/********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
@@ -225,27 +202,71 @@ fontset_id_valid_p (int id)
/* Return the fontset with ID. No check of ID's validness. */
#define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
-/* Macros to access special values of FONTSET. */
-#define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
+/* Access special values of FONTSET. */
+
+#define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
+static void
+set_fontset_id (Lisp_Object fontset, Lisp_Object id)
+{
+ set_char_table_extras (fontset, 0, id);
+}
+
+/* Access special values of (base) FONTSET. */
+
+#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
+static void
+set_fontset_name (Lisp_Object fontset, Lisp_Object name)
+{
+ set_char_table_extras (fontset, 1, name);
+}
+
+#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
+static void
+set_fontset_ascii (Lisp_Object fontset, Lisp_Object ascii)
+{
+ set_char_table_extras (fontset, 4, ascii);
+}
+
+/* Access special values of (realized) FONTSET. */
+
+#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
+static void
+set_fontset_base (Lisp_Object fontset, Lisp_Object base)
+{
+ set_char_table_extras (fontset, 2, base);
+}
+
+#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
+static void
+set_fontset_frame (Lisp_Object fontset, Lisp_Object frame)
+{
+ set_char_table_extras (fontset, 3, frame);
+}
-/* Macros to access special values of (base) FONTSET. */
-#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
-#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
-/* #define FONTSET_SPEC(fontset) XCHAR_TABLE (fontset)->extras[5] */
+#define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
+static void
+set_fontset_nofont_face (Lisp_Object fontset, Lisp_Object face)
+{
+ set_char_table_extras (fontset, 5, face);
+}
-/* Macros to access special values of (realized) FONTSET. */
-#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
-#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
-/* #define FONTSET_OBJLIST(fontset) XCHAR_TABLE (fontset)->extras[4] */
-#define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
-/* #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6] */
-#define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
+#define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
+static void
+set_fontset_default (Lisp_Object fontset, Lisp_Object def)
+{
+ set_char_table_extras (fontset, 7, def);
+}
/* For both base and realized fontset. */
-#define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
-#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
+#define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
+static void
+set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback)
+{
+ set_char_table_extras (fontset, 8, fallback);
+}
+#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
/* Macros for FONT-DEF and RFONT-DEF of fontset. */
#define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
@@ -277,7 +298,7 @@ fontset_id_valid_p (int id)
#define RFONT_DEF_NEW(rfont_def, font_def) \
do { \
(rfont_def) = Fmake_vector (make_number (4), Qnil); \
- ASET ((rfont_def), 1, (font_def)); \
+ ASET ((rfont_def), 1, (font_def)); \
RFONT_DEF_SET_SCORE ((rfont_def), 0); \
} while (0)
@@ -319,15 +340,17 @@ fontset_ref (Lisp_Object fontset, int c)
replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
append ELT. */
-#define FONTSET_ADD(fontset, range, elt, add) \
- (NILP (add) \
- ? (NILP (range) \
- ? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \
- : Fset_char_table_range ((fontset), (range), \
- Fmake_vector (make_number (1), (elt)))) \
+#define FONTSET_ADD(fontset, range, elt, add) \
+ (NILP (add) \
+ ? (NILP (range) \
+ ? (set_fontset_fallback \
+ (fontset, Fmake_vector (make_number (1), (elt)))) \
+ : ((void) \
+ Fset_char_table_range (fontset, range, \
+ Fmake_vector (make_number (1), elt)))) \
: fontset_add ((fontset), (range), (elt), (add)))
-static Lisp_Object
+static void
fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Object add)
{
Lisp_Object args[2];
@@ -353,10 +376,9 @@ fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Objec
else
{
args[idx] = FONTSET_FALLBACK (fontset);
- FONTSET_FALLBACK (fontset)
- = NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args);
+ set_fontset_fallback
+ (fontset, NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args));
}
- return Qnil;
}
static int
@@ -381,7 +403,7 @@ reorder_font_vector (Lisp_Object font_group, struct font *font)
Lisp_Object vec, font_object;
int size;
int i;
- int score_changed = 0;
+ bool score_changed = 0;
if (font)
XSETFONT (font_object, font);
@@ -416,9 +438,11 @@ reorder_font_vector (Lisp_Object font_group, struct font *font)
for (tail = Vcharset_ordered_list;
! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail);
- score += 0x100, tail = XCDR (tail))
+ tail = XCDR (tail))
if (EQ (encoding, XCAR (tail)))
break;
+ else if (score <= min (INT_MAX, MOST_POSITIVE_FIXNUM) - 0x100)
+ score += 0x100;
}
else
{
@@ -439,7 +463,7 @@ reorder_font_vector (Lisp_Object font_group, struct font *font)
}
if (score_changed)
- qsort (XVECTOR (vec)->contents, size, sizeof (Lisp_Object),
+ qsort (XVECTOR (vec)->contents, size, word_size,
fontset_compare_rfontdef);
XSETCAR (font_group, make_number (charset_ordered_list_tick));
}
@@ -457,7 +481,7 @@ fontset_get_font_group (Lisp_Object fontset, int c)
Lisp_Object base_fontset;
int from = 0, to = MAX_CHAR, i;
- xassert (! BASE_FONTSET_P (fontset));
+ eassert (! BASE_FONTSET_P (fontset));
if (c >= 0)
font_group = CHAR_TABLE_REF (fontset, c);
else
@@ -495,7 +519,7 @@ fontset_get_font_group (Lisp_Object fontset, int c)
if (c >= 0)
char_table_set_range (fontset, from, to, font_group);
else
- FONTSET_FALLBACK (fontset) = font_group;
+ set_fontset_fallback (fontset, font_group);
return font_group;
}
@@ -510,10 +534,11 @@ fontset_get_font_group (Lisp_Object fontset, int c)
ID is a charset-id that must be preferred, or -1 meaning no
preference.
- If FALLBACK is nonzero, search only fallback fonts. */
+ If FALLBACK, search only fallback fonts. */
static Lisp_Object
-fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id, int fallback)
+fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id,
+ bool fallback)
{
Lisp_Object vec, font_group;
int i, charset_matched = 0, found_index;
@@ -730,8 +755,9 @@ fontset_font (Lisp_Object fontset, int c, struct face *face, int id)
if (! EQ (base_fontset, Vdefault_fontset))
{
if (NILP (FONTSET_DEFAULT (fontset)))
- FONTSET_DEFAULT (fontset)
- = make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset);
+ set_fontset_default
+ (fontset,
+ make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset));
FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil);
default_rfont_def
= fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
@@ -787,20 +813,18 @@ make_fontset (Lisp_Object frame, Lisp_Object name, Lisp_Object base)
while (!NILP (AREF (Vfontset_table, id))) id++;
if (id + 1 == size)
- Vfontset_table = larger_vector (Vfontset_table, size + 32, Qnil);
+ Vfontset_table = larger_vector (Vfontset_table, 1, -1);
fontset = Fmake_char_table (Qfontset, Qnil);
- FONTSET_ID (fontset) = make_number (id);
+ set_fontset_id (fontset, make_number (id));
if (NILP (base))
- {
- FONTSET_NAME (fontset) = name;
- }
+ set_fontset_name (fontset, name);
else
{
- FONTSET_NAME (fontset) = Qnil;
- FONTSET_FRAME (fontset) = frame;
- FONTSET_BASE (fontset) = base;
+ set_fontset_name (fontset, Qnil);
+ set_fontset_frame (fontset, frame);
+ set_fontset_base (fontset, base);
}
ASET (Vfontset_table, id, fontset);
@@ -846,7 +870,7 @@ free_realized_fontset (FRAME_PTR f, Lisp_Object fontset)
if (0)
for (tail = FONTSET_OBJLIST (fontset); CONSP (tail); tail = XCDR (tail))
{
- xassert (FONT_OBJECT_P (XCAR (tail)));
+ eassert (FONT_OBJECT_P (XCAR (tail)));
font_close_object (f, XCAR (tail));
}
#endif
@@ -863,8 +887,8 @@ free_face_fontset (FRAME_PTR f, struct face *face)
fontset = FONTSET_FROM_ID (face->fontset);
if (NILP (fontset))
return;
- xassert (! BASE_FONTSET_P (fontset));
- xassert (f == XFRAME (FONTSET_FRAME (fontset)));
+ eassert (! BASE_FONTSET_P (fontset));
+ eassert (f == XFRAME (FONTSET_FRAME (fontset)));
free_realized_fontset (f, fontset);
ASET (Vfontset_table, face->fontset, Qnil);
if (face->fontset < next_fontset_id)
@@ -874,8 +898,8 @@ free_face_fontset (FRAME_PTR f, struct face *face)
int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset)));
fontset = AREF (Vfontset_table, id);
- xassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
- xassert (f == XFRAME (FONTSET_FRAME (fontset)));
+ eassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
+ eassert (f == XFRAME (FONTSET_FRAME (fontset)));
free_realized_fontset (f, fontset);
ASET (Vfontset_table, id, Qnil);
if (id < next_fontset_id)
@@ -886,11 +910,11 @@ free_face_fontset (FRAME_PTR f, struct face *face)
#if 0
-/* Return 1 if FACE is suitable for displaying character C.
- Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
+/* Return true if FACE is suitable for displaying character C.
+ Called from the macro FACE_SUITABLE_FOR_CHAR_P
when C is not an ASCII character. */
-int
+bool
face_suitable_for_char_p (struct face *face, int c)
{
Lisp_Object fontset, rfont_def;
@@ -922,9 +946,9 @@ face_for_char (FRAME_PTR f, struct face *face, int c, int pos, Lisp_Object objec
if (ASCII_CHAR_P (c) || face->fontset < 0)
return face->ascii_face->id;
- xassert (fontset_id_valid_p (face->fontset));
+ eassert (fontset_id_valid_p (face->fontset));
fontset = FONTSET_FROM_ID (face->fontset);
- xassert (!BASE_FONTSET_P (fontset));
+ eassert (!BASE_FONTSET_P (fontset));
if (pos < 0)
{
@@ -968,10 +992,10 @@ face_for_char (FRAME_PTR f, struct face *face, int c, int pos, Lisp_Object objec
else
{
face_id = face_for_font (f, Qnil, face);
- FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
+ set_fontset_nofont_face (fontset, make_number (face_id));
}
}
- xassert (face_id >= 0);
+ eassert (face_id >= 0);
return face_id;
}
@@ -990,9 +1014,9 @@ font_for_char (struct face *face, int c, int pos, Lisp_Object object)
return font_object;
}
- xassert (fontset_id_valid_p (face->fontset));
+ eassert (fontset_id_valid_p (face->fontset));
fontset = FONTSET_FROM_ID (face->fontset);
- xassert (!BASE_FONTSET_P (fontset));
+ eassert (!BASE_FONTSET_P (fontset));
if (pos < 0)
{
id = -1;
@@ -1037,8 +1061,7 @@ make_fontset_for_ascii_face (FRAME_PTR f, int base_fontset_id, struct face *face
base_fontset = FONTSET_FROM_ID (base_fontset_id);
if (!BASE_FONTSET_P (base_fontset))
base_fontset = FONTSET_BASE (base_fontset);
- if (! BASE_FONTSET_P (base_fontset))
- abort ();
+ eassert (BASE_FONTSET_P (base_fontset));
}
else
base_fontset = Vdefault_fontset;
@@ -1092,9 +1115,9 @@ fontset_pattern_regexp (Lisp_Object pattern)
we convert "*" to "[^-]*" which is much faster in regular
expression matching. */
if (ndashes < 14)
- p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 2 * nescs + 1);
+ p1 = regex = alloca (SBYTES (pattern) + 2 * nstars + 2 * nescs + 1);
else
- p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 2 * nescs + 1);
+ p1 = regex = alloca (SBYTES (pattern) + 5 * nstars + 2 * nescs + 1);
*p1++ = '^';
for (p0 = SDATA (pattern); *p0; p0++)
@@ -1252,7 +1275,7 @@ free_realized_fontsets (Lisp_Object base)
doesn't remove FACE from a cache. Until we find a solution, we
suppress this code, and simply use Fclear_face_cache even though
that is not efficient. */
- BLOCK_INPUT;
+ block_input ();
for (id = 0; id < ASIZE (Vfontset_table); id++)
{
Lisp_Object this = AREF (Vfontset_table, id);
@@ -1273,7 +1296,7 @@ free_realized_fontsets (Lisp_Object base)
}
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
#else /* not 0 */
/* But, we don't have to call Fclear_face_cache if no fontset has
been realized from BASE. */
@@ -1303,17 +1326,14 @@ static Lisp_Object
check_fontset_name (Lisp_Object name, Lisp_Object *frame)
{
int id;
+ struct frame *f = decode_live_frame (*frame);
- if (NILP (*frame))
- *frame = selected_frame;
- CHECK_LIVE_FRAME (*frame);
+ XSETFRAME (*frame, f);
if (EQ (name, Qt))
return Vdefault_fontset;
if (NILP (name))
- {
- id = FRAME_FONTSET (XFRAME (*frame));
- }
+ id = FRAME_FONTSET (f);
else
{
CHECK_STRING (name);
@@ -1438,7 +1458,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
Lisp_Object range_list;
struct charset *charset = NULL;
Lisp_Object fontname;
- int ascii_changed = 0;
+ bool ascii_changed = 0;
fontset = check_fontset_name (name, &frame);
@@ -1591,7 +1611,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
Lisp_Object tail, fr, alist;
int fontset_id = XINT (FONTSET_ID (fontset));
- FONTSET_ASCII (fontset) = fontname;
+ set_fontset_ascii (fontset, fontname);
name = FONTSET_NAME (fontset);
FOR_EACH_FRAME (tail, fr)
{
@@ -1656,7 +1676,7 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
char xlfd[256];
int len;
- if (font_parse_xlfd (SSDATA (name), font_spec) < 0)
+ if (font_parse_xlfd (SSDATA (name), SBYTES (name), font_spec) < 0)
error ("Fontset name must be in XLFD format");
short_name = AREF (font_spec, FONT_REGISTRY_INDEX);
if (strncmp (SSDATA (SYMBOL_NAME (short_name)), "fontset-", 8)
@@ -1669,7 +1689,7 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
if (len < 0)
error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
- FONTSET_ASCII (fontset) = make_unibyte_string (xlfd, len);
+ set_fontset_ascii (fontset, make_unibyte_string (xlfd, len));
}
else
{
@@ -1678,11 +1698,11 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
Fset_char_table_range (fontset, Qt, Qnil);
}
- for (; ! NILP (fontlist); fontlist = Fcdr (fontlist))
+ for (; CONSP (fontlist); fontlist = XCDR (fontlist))
{
Lisp_Object elt, script;
- elt = Fcar (fontlist);
+ elt = XCAR (fontlist);
script = Fcar (elt);
elt = Fcdr (elt);
if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
@@ -1700,7 +1720,7 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
static Lisp_Object auto_fontset_alist;
/* Number of automatically created fontsets. */
-static printmax_t num_auto_fontsets;
+static ptrdiff_t num_auto_fontsets;
/* Return a fontset synthesized from FONT-OBJECT. This is called from
x_new_font when FONT-OBJECT is used for the default ASCII font of a
@@ -1727,16 +1747,15 @@ fontset_from_font (Lisp_Object font_object)
alias = intern ("fontset-startup");
else
{
- char temp[sizeof "fontset-auto" + INT_STRLEN_BOUND (printmax_t)];
+ char temp[sizeof "fontset-auto" + INT_STRLEN_BOUND (ptrdiff_t)];
- sprintf (temp, "fontset-auto%"pMd, num_auto_fontsets - 1);
+ sprintf (temp, "fontset-auto%"pD"d", num_auto_fontsets - 1);
alias = intern (temp);
}
fontset_spec = copy_font_spec (font_spec);
ASET (fontset_spec, FONT_REGISTRY_INDEX, alias);
name = Ffont_xlfd_name (fontset_spec, Qnil);
- if (NILP (name))
- abort ();
+ eassert (!NILP (name));
fontset = make_fontset (Qnil, name, Qnil);
Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (alias)),
Vfontset_alias_alist);
@@ -1756,7 +1775,7 @@ fontset_from_font (Lisp_Object font_object)
Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
}
- FONTSET_ASCII (fontset) = font_name;
+ set_fontset_ascii (fontset, font_name);
return XINT (FONTSET_ID (fontset));
}
@@ -1816,7 +1835,7 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
doc: /* For internal use only. */)
(Lisp_Object position, Lisp_Object ch)
{
- EMACS_INT pos, pos_byte, dummy;
+ ptrdiff_t pos, pos_byte, dummy;
int face_id;
int c;
struct frame *f;
@@ -1836,9 +1855,9 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
struct window *w;
CHECK_NUMBER_COERCE_MARKER (position);
- pos = XINT (position);
- if (pos < BEGV || pos >= ZV)
+ if (! (BEGV <= XINT (position) && XINT (position) < ZV))
args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
+ pos = XINT (position);
pos_byte = CHAR_TO_BYTE (pos);
if (NILP (ch))
c = FETCH_CHAR (pos_byte);
@@ -1903,8 +1922,7 @@ format is the same as above. */)
/* Recode fontsets realized on FRAME from the base fontset FONTSET
in the table `realized'. */
- realized[0] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
- * ASIZE (Vfontset_table));
+ realized[0] = alloca (word_size * ASIZE (Vfontset_table));
for (i = j = 0; i < ASIZE (Vfontset_table); i++)
{
elt = FONTSET_FROM_ID (i);
@@ -1915,8 +1933,7 @@ format is the same as above. */)
}
realized[0][j] = Qnil;
- realized[1] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
- * ASIZE (Vfontset_table));
+ realized[1] = alloca (word_size * ASIZE (Vfontset_table));
for (i = j = 0; ! NILP (realized[0][i]); i++)
{
elt = FONTSET_DEFAULT (realized[0][i]);
@@ -1930,7 +1947,7 @@ format is the same as above. */)
if (!EQ (fontset, Vdefault_fontset))
{
tables[1] = Fmake_char_table (Qnil, Qnil);
- XCHAR_TABLE (tables[0])->extras[0] = tables[1];
+ set_char_table_extras (tables[0], 0, tables[1]);
fontsets[1] = Vdefault_fontset;
}
@@ -1993,7 +2010,7 @@ format is the same as above. */)
if (c <= MAX_5_BYTE_CHAR)
char_table_set_range (tables[k], c, to, alist);
else
- XCHAR_TABLE (tables[k])->defalt = alist;
+ set_char_table_defalt (tables[k], alist);
/* At last, change each elements to font names. */
for (; CONSP (alist); alist = XCDR (alist))
@@ -2102,7 +2119,7 @@ DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
}
-#ifdef FONTSET_DEBUG
+#ifdef ENABLE_CHECKING
Lisp_Object dump_fontset (Lisp_Object) EXTERNALLY_VISIBLE;
@@ -2129,7 +2146,8 @@ dump_fontset (Lisp_Object fontset)
if (FRAME_LIVE_P (f))
ASET (vec, 1,
- Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), f->name));
+ Fcons (FONTSET_NAME (FONTSET_BASE (fontset)),
+ f->name));
else
ASET (vec, 1,
Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
@@ -2152,7 +2170,7 @@ DEFUN ("fontset-list-all", Ffontset_list_all, Sfontset_list_all, 0, 0, 0,
val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val);
return (Fnreverse (val));
}
-#endif /* FONTSET_DEBUG */
+#endif /* ENABLE_CHECKING */
void
syms_of_fontset (void)
@@ -2174,9 +2192,10 @@ syms_of_fontset (void)
Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
staticpro (&Vdefault_fontset);
- FONTSET_ID (Vdefault_fontset) = make_number (0);
- FONTSET_NAME (Vdefault_fontset)
- = make_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
+ set_fontset_id (Vdefault_fontset, make_number (0));
+ set_fontset_name
+ (Vdefault_fontset,
+ build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"));
ASET (Vfontset_table, 0, Vdefault_fontset);
next_fontset_id = 1;
@@ -2222,12 +2241,12 @@ alternate fontnames (if any) are tried instead. */);
DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist,
doc: /* Alist of fontset names vs the aliases. */);
Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
- make_pure_c_string ("fontset-default")),
+ build_pure_c_string ("fontset-default")),
Qnil);
DEFVAR_LISP ("vertical-centering-font-regexp",
Vvertical_centering_font_regexp,
- doc: /* *Regexp matching font names that require vertical centering on display.
+ doc: /* Regexp matching font names that require vertical centering on display.
When a character is displayed with such fonts, the character is displayed
at the vertical center of lines. */);
Vvertical_centering_font_regexp = Qnil;
@@ -2243,7 +2262,7 @@ at the vertical center of lines. */);
defsubr (&Sfontset_info);
defsubr (&Sfontset_font);
defsubr (&Sfontset_list);
-#ifdef FONTSET_DEBUG
+#ifdef ENABLE_CHECKING
defsubr (&Sfontset_list_all);
#endif
}
diff --git a/src/fontset.h b/src/fontset.h
index 8831f4ce0b7..3eb8d633b6c 100644
--- a/src/fontset.h
+++ b/src/fontset.h
@@ -1,5 +1,5 @@
/* Header for fontset handler.
- Copyright (C) 1998, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
@@ -39,7 +39,6 @@ extern Lisp_Object font_for_char (struct face *, int, int, Lisp_Object);
extern int make_fontset_for_ascii_face (FRAME_PTR, int, struct face *);
extern int fontset_from_font (Lisp_Object);
extern int fs_query_fontset (Lisp_Object, int);
-EXFUN (Fquery_fontset, 2);
extern Lisp_Object list_fontsets (struct frame *, Lisp_Object, int);
extern Lisp_Object Qlatin;
diff --git a/src/frame.c b/src/frame.c
index bd97c5f18c7..3501fc36675 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -1,6 +1,6 @@
/* Generic frame functions.
-Copyright (C) 1993-1995, 1997, 1999-2011 Free Software Foundation, Inc.
+Copyright (C) 1993-1995, 1997, 1999-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,22 +19,21 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+#define FRAME_INLINE EXTERN_INLINE
+
#include <stdio.h>
-#include <ctype.h>
#include <errno.h>
#include <limits.h>
-#include <setjmp.h>
+
+#include <c-ctype.h>
+
#include "lisp.h"
#include "character.h"
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#endif
-#ifdef WINDOWSNT
-#include "w32term.h"
-#endif
-#ifdef HAVE_NS
-#include "nsterm.h"
-#endif
+
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
+
#include "buffer.h"
/* These help us bind and responding to switch-frame events. */
#include "commands.h"
@@ -54,18 +53,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dosfns.h"
#endif
-
-#ifdef HAVE_WINDOW_SYSTEM
-
-#endif
-
#ifdef HAVE_NS
Lisp_Object Qns_parse_geometry;
#endif
Lisp_Object Qframep, Qframe_live_p;
Lisp_Object Qicon, Qmodeline;
-Lisp_Object Qonly;
+Lisp_Object Qonly, Qnone;
Lisp_Object Qx, Qw32, Qmac, Qpc, Qns;
Lisp_Object Qvisible;
Lisp_Object Qdisplay_type;
@@ -125,15 +119,44 @@ static Lisp_Object Qdelete_frame_functions;
static void x_report_frame_params (struct frame *, Lisp_Object *);
#endif
-
+/* These setters are used only in this file, so they can be private. */
+static void
+fset_buffer_predicate (struct frame *f, Lisp_Object val)
+{
+ f->buffer_predicate = val;
+}
+static void
+fset_minibuffer_window (struct frame *f, Lisp_Object val)
+{
+ f->minibuffer_window = val;
+}
+
+struct frame *
+decode_live_frame (register Lisp_Object frame)
+{
+ if (NILP (frame))
+ frame = selected_frame;
+ CHECK_LIVE_FRAME (frame);
+ return XFRAME (frame);
+}
+
+struct frame *
+decode_any_frame (register Lisp_Object frame)
+{
+ if (NILP (frame))
+ frame = selected_frame;
+ CHECK_FRAME (frame);
+ return XFRAME (frame);
+}
+
static void
set_menu_bar_lines_1 (Lisp_Object window, int n)
{
struct window *w = XWINDOW (window);
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->top_line, XFASTINT (w->top_line) + n);
- XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - n);
+ w->last_modified = 0;
+ wset_top_line (w, make_number (XFASTINT (w->top_line) + n));
+ wset_total_lines (w, make_number (XFASTINT (w->total_lines) - n));
/* Handle just the top child in a vertical split. */
if (!NILP (w->vchild))
@@ -207,7 +230,7 @@ See also `frame-live-p'. */)
case output_ns:
return Qns;
default:
- abort ();
+ emacs_abort ();
}
}
@@ -267,82 +290,42 @@ make_frame (int mini_p)
f = allocate_frame ();
XSETFRAME (frame, f);
- f->desired_matrix = 0;
- f->current_matrix = 0;
- f->desired_pool = 0;
- f->current_pool = 0;
- f->glyphs_initialized_p = 0;
- f->decode_mode_spec_buffer = 0;
- f->visible = 0;
- f->async_visible = 0;
- f->output_data.nothing = 0;
- f->iconified = 0;
- f->async_iconified = 0;
+ /* Initialize Lisp data. Note that allocate_frame initializes all
+ Lisp data to nil, so do it only for slots which should not be nil. */
+ fset_tool_bar_position (f, Qtop);
+
+ /* Initialize non-Lisp data. Note that allocate_frame zeroes out all
+ non-Lisp data, so do it only for slots which should not be zero.
+ To avoid subtle bugs and for the sake of readability, it's better to
+ initialize enum members explicitly even if their values are zero. */
f->wants_modeline = 1;
- f->auto_raise = 0;
- f->auto_lower = 0;
- f->no_split = 0;
f->garbaged = 1;
f->has_minibuffer = mini_p;
- f->focus_frame = Qnil;
- f->explicit_name = 0;
- f->can_have_scroll_bars = 0;
f->vertical_scroll_bar_type = vertical_scroll_bar_none;
- f->param_alist = Qnil;
- f->scroll_bars = Qnil;
- f->condemned_scroll_bars = Qnil;
- f->face_alist = Qnil;
- f->face_cache = NULL;
- f->menu_bar_items = Qnil;
- f->menu_bar_vector = Qnil;
- f->menu_bar_items_used = 0;
- f->buffer_predicate = Qnil;
- f->buffer_list = Qnil;
- f->buried_buffer_list = Qnil;
- f->namebuf = 0;
- f->title = Qnil;
- f->menu_bar_window = Qnil;
- f->tool_bar_window = Qnil;
- f->tool_bar_items = Qnil;
- f->tool_bar_position = Qtop;
- f->desired_tool_bar_string = f->current_tool_bar_string = Qnil;
- f->n_tool_bar_items = 0;
- f->left_fringe_width = f->right_fringe_width = 0;
- f->fringe_cols = 0;
- f->menu_bar_lines = 0;
- f->tool_bar_lines = 0;
- f->scroll_bar_actual_width = 0;
- f->border_width = 0;
- f->internal_border_width = 0;
f->column_width = 1; /* !FRAME_WINDOW_P value */
f->line_height = 1; /* !FRAME_WINDOW_P value */
- f->x_pixels_diff = f->y_pixels_diff = 0;
#ifdef HAVE_WINDOW_SYSTEM
f->want_fullscreen = FULLSCREEN_NONE;
#endif
- f->size_hint_flags = 0;
- f->win_gravity = 0;
- f->font_driver_list = NULL;
- f->font_data_list = NULL;
root_window = make_window ();
if (mini_p)
{
mini_window = make_window ();
- XWINDOW (root_window)->next = mini_window;
- XWINDOW (mini_window)->prev = root_window;
- XWINDOW (mini_window)->mini_p = Qt;
- XWINDOW (mini_window)->frame = frame;
- f->minibuffer_window = mini_window;
+ wset_next (XWINDOW (root_window), mini_window);
+ wset_prev (XWINDOW (mini_window), root_window);
+ XWINDOW (mini_window)->mini = 1;
+ wset_frame (XWINDOW (mini_window), frame);
+ fset_minibuffer_window (f, mini_window);
}
else
{
mini_window = Qnil;
- XWINDOW (root_window)->next = Qnil;
- f->minibuffer_window = Qnil;
+ wset_next (XWINDOW (root_window), Qnil);
+ fset_minibuffer_window (f, Qnil);
}
- XWINDOW (root_window)->frame = frame;
+ wset_frame (XWINDOW (root_window), frame);
/* 10 is arbitrary,
just so that there is "something there."
@@ -351,21 +334,21 @@ make_frame (int mini_p)
SET_FRAME_COLS (f, 10);
FRAME_LINES (f) = 10;
- XSETFASTINT (XWINDOW (root_window)->total_cols, 10);
- XSETFASTINT (XWINDOW (root_window)->total_lines, (mini_p ? 9 : 10));
+ wset_total_cols (XWINDOW (root_window), make_number (10));
+ wset_total_lines (XWINDOW (root_window), make_number (mini_p ? 9 : 10));
if (mini_p)
{
- XSETFASTINT (XWINDOW (mini_window)->total_cols, 10);
- XSETFASTINT (XWINDOW (mini_window)->top_line, 9);
- XSETFASTINT (XWINDOW (mini_window)->total_lines, 1);
+ wset_total_cols (XWINDOW (mini_window), make_number (10));
+ wset_top_line (XWINDOW (mini_window), make_number (9));
+ wset_total_lines (XWINDOW (mini_window), make_number (1));
}
/* Choose a buffer for the frame's root window. */
{
Lisp_Object buf;
- XWINDOW (root_window)->buffer = Qt;
+ wset_buffer (XWINDOW (root_window), Qt);
buf = Fcurrent_buffer ();
/* If buf is a 'hidden' buffer (i.e. one whose name starts with
a space), try to find another one. */
@@ -379,12 +362,12 @@ make_frame (int mini_p)
etc. Running Lisp functions at this point surely ends in a
SEGV. */
set_window_buffer (root_window, buf, 0, 0);
- f->buffer_list = Fcons (buf, Qnil);
+ fset_buffer_list (f, Fcons (buf, Qnil));
}
if (mini_p)
{
- XWINDOW (mini_window)->buffer = Qt;
+ wset_buffer (XWINDOW (mini_window), Qt);
set_window_buffer (mini_window,
(NILP (Vminibuffer_list)
? get_minibuffer (0)
@@ -392,14 +375,11 @@ make_frame (int mini_p)
0, 0);
}
- f->root_window = root_window;
- f->selected_window = root_window;
+ fset_root_window (f, root_window);
+ fset_selected_window (f, root_window);
/* Make sure this window seems more recently used than
a newly-created, never-selected window. */
- ++window_select_count;
- XSETFASTINT (XWINDOW (f->selected_window)->use_time, window_select_count);
-
- f->default_face_done_p = 0;
+ XWINDOW (f->selected_window)->use_time = ++window_select_count;
return f;
}
@@ -436,23 +416,26 @@ make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lis
XSETFRAME (frame_dummy, f);
GCPRO1 (frame_dummy);
/* If there's no minibuffer frame to use, create one. */
- KVAR (kb, Vdefault_minibuffer_frame) =
- call1 (intern ("make-initial-minibuffer-frame"), display);
+ kset_default_minibuffer_frame
+ (kb, call1 (intern ("make-initial-minibuffer-frame"), display));
UNGCPRO;
}
- mini_window = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
+ mini_window
+ = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
}
- f->minibuffer_window = mini_window;
+ fset_minibuffer_window (f, mini_window);
/* Make the chosen minibuffer window display the proper minibuffer,
unless it is already showing a minibuffer. */
if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
- Fset_window_buffer (mini_window,
- (NILP (Vminibuffer_list)
- ? get_minibuffer (0)
- : Fcar (Vminibuffer_list)), Qnil);
+ /* Use set_window_buffer instead of Fset_window_buffer (see
+ discussion of bug#11984, bug#12025, bug#12026). */
+ set_window_buffer (mini_window,
+ (NILP (Vminibuffer_list)
+ ? get_minibuffer (0)
+ : Fcar (Vminibuffer_list)), 0, 0);
return f;
}
@@ -479,18 +462,21 @@ make_minibuffer_frame (void)
Avoid infinite looping on the window chain by marking next pointer
as nil. */
- mini_window = f->minibuffer_window = f->root_window;
- XWINDOW (mini_window)->mini_p = Qt;
- XWINDOW (mini_window)->next = Qnil;
- XWINDOW (mini_window)->prev = Qnil;
- XWINDOW (mini_window)->frame = frame;
+ mini_window = f->root_window;
+ fset_minibuffer_window (f, mini_window);
+ XWINDOW (mini_window)->mini = 1;
+ wset_next (XWINDOW (mini_window), Qnil);
+ wset_prev (XWINDOW (mini_window), Qnil);
+ wset_frame (XWINDOW (mini_window), frame);
/* Put the proper buffer in that window. */
- Fset_window_buffer (mini_window,
- (NILP (Vminibuffer_list)
- ? get_minibuffer (0)
- : Fcar (Vminibuffer_list)), Qnil);
+ /* Use set_window_buffer instead of Fset_window_buffer (see
+ discussion of bug#11984, bug#12025, bug#12026). */
+ set_window_buffer (mini_window,
+ (NILP (Vminibuffer_list)
+ ? get_minibuffer (0)
+ : Fcar (Vminibuffer_list)), 0, 0);
return f;
}
#endif /* HAVE_WINDOW_SYSTEM */
@@ -520,7 +506,7 @@ make_initial_frame (void)
Vframe_list = Fcons (frame, Vframe_list);
tty_frame_count = 1;
- f->name = make_pure_c_string ("F1");
+ fset_name (f, build_pure_c_string ("F1"));
f->visible = 1;
f->async_visible = 1;
@@ -533,7 +519,6 @@ make_initial_frame (void)
FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
/* The default value of menu-bar-mode is t. */
@@ -561,9 +546,7 @@ make_terminal_frame (struct terminal *terminal)
XSETFRAME (frame, f);
Vframe_list = Fcons (frame, Vframe_list);
- tty_frame_count++;
- sprintf (name, "F%"pMd, tty_frame_count);
- f->name = build_string (name);
+ fset_name (f, make_formatted_string (name, "F%"pMd, ++tty_frame_count));
f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */
f->async_visible = 1; /* Don't let visible be cleared later. */
@@ -584,7 +567,6 @@ make_terminal_frame (struct terminal *terminal)
FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
#endif /* not MSDOS */
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
FRAME_MENU_BAR_LINES(f) = NILP (Vmenu_bar_mode) ? 0 : 1;
@@ -630,8 +612,8 @@ DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
doc: /* Create an additional terminal frame, possibly on another terminal.
This function takes one argument, an alist specifying frame parameters.
-You can create multiple frames on a single text-only terminal, but
-only one of them (the selected terminal frame) is actually displayed.
+You can create multiple frames on a single text terminal, but only one
+of them (the selected terminal frame) is actually displayed.
In practice, generally you don't need to specify any parameters,
except when you want to create a new frame on another terminal.
@@ -652,7 +634,7 @@ affects all frames on the same terminal device. */)
#ifdef MSDOS
if (sf->output_method != output_msdos_raw
&& sf->output_method != output_termcap)
- abort ();
+ emacs_abort ();
#else /* not MSDOS */
#ifdef WINDOWSNT /* This should work now! */
@@ -665,7 +647,7 @@ affects all frames on the same terminal device. */)
Lisp_Object terminal;
terminal = Fassq (Qterminal, parms);
- if (!NILP (terminal))
+ if (CONSP (terminal))
{
terminal = XCDR (terminal);
t = get_terminal (terminal, 1);
@@ -690,8 +672,8 @@ affects all frames on the same terminal device. */)
: NULL));
if (!NILP (tty))
{
- name = (char *) alloca (SBYTES (tty) + 1);
- strncpy (name, SSDATA (tty), SBYTES (tty));
+ name = alloca (SBYTES (tty) + 1);
+ memcpy (name, SSDATA (tty), SBYTES (tty));
name[SBYTES (tty)] = 0;
}
@@ -701,8 +683,8 @@ affects all frames on the same terminal device. */)
: NULL));
if (!NILP (tty_type))
{
- type = (char *) alloca (SBYTES (tty_type) + 1);
- strncpy (type, SSDATA (tty_type), SBYTES (tty_type));
+ type = alloca (SBYTES (tty_type) + 1);
+ memcpy (type, SSDATA (tty_type), SBYTES (tty_type));
type[SBYTES (tty_type)] = 0;
}
@@ -733,7 +715,7 @@ affects all frames on the same terminal device. */)
/* Make the frame face alist be frame-specific, so that each
frame could change its face definitions independently. */
- f->face_alist = Fcopy_alist (sf->face_alist);
+ fset_face_alist (f, Fcopy_alist (sf->face_alist));
/* Simple Fcopy_alist isn't enough, because we need the contents of
the vectors which are the CDRs of associations in face_alist to
be copied as well. */
@@ -799,7 +781,7 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor
Lisp_Object focus;
if (!FRAMEP (XCAR (tail)))
- abort ();
+ emacs_abort ();
focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
@@ -865,8 +847,8 @@ something to select a different frame, or until the next time
this function is called. If you are using a window system, the
previously selected frame may be restored as the selected frame
when returning to the command loop, because it still may have
-the window system's input focus. On a text-only terminal, the
-next redisplay will display FRAME.
+the window system's input focus. On a text terminal, the next
+redisplay will display FRAME.
This function returns FRAME, or nil if FRAME has been deleted. */)
(Lisp_Object frame, Lisp_Object norecord)
@@ -887,7 +869,7 @@ to that frame. */)
(Lisp_Object event)
{
/* Preserve prefix arg that the command loop just cleared. */
- KVAR (current_kboard, Vprefix_arg) = Vcurrent_prefix_arg;
+ kset_prefix_arg (current_kboard, Vcurrent_prefix_arg);
Frun_hooks (1, &Qmouse_leave_buffer_hook);
return do_switch_frame (event, 0, 0, Qnil);
}
@@ -924,24 +906,20 @@ DEFUN ("frame-list", Fframe_list, Sframe_list,
static Lisp_Object
next_frame (Lisp_Object frame, Lisp_Object minibuf)
{
- Lisp_Object tail;
+ Lisp_Object f, tail;
int passed = 0;
/* There must always be at least one frame in Vframe_list. */
if (! CONSP (Vframe_list))
- abort ();
+ emacs_abort ();
/* If this frame is dead, it won't be in Vframe_list, and we'll loop
forever. Forestall that. */
CHECK_LIVE_FRAME (frame);
while (1)
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, f)
{
- Lisp_Object f;
-
- f = XCAR (tail);
-
if (passed
&& ((!FRAME_TERMCAP_P (XFRAME (f)) && !FRAME_TERMCAP_P (XFRAME (frame))
&& FRAME_KBOARD (XFRAME (f)) == FRAME_KBOARD (XFRAME (frame)))
@@ -1002,22 +980,13 @@ next_frame (Lisp_Object frame, Lisp_Object minibuf)
static Lisp_Object
prev_frame (Lisp_Object frame, Lisp_Object minibuf)
{
- Lisp_Object tail;
- Lisp_Object prev;
+ Lisp_Object f, tail, prev = Qnil;
/* There must always be at least one frame in Vframe_list. */
- if (! CONSP (Vframe_list))
- abort ();
+ eassert (CONSP (Vframe_list));
- prev = Qnil;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, f)
{
- Lisp_Object f;
-
- f = XCAR (tail);
- if (!FRAMEP (f))
- abort ();
-
if (EQ (frame, f) && !NILP (prev))
return prev;
@@ -1118,41 +1087,31 @@ Otherwise, include all frames. */)
static int
other_visible_frames (FRAME_PTR f)
{
- /* We know the selected frame is visible,
- so if F is some other frame, it can't be the sole visible one. */
- if (f == SELECTED_FRAME ())
- {
- Lisp_Object frames;
- int count = 0;
+ Lisp_Object frames, this;
- for (frames = Vframe_list;
- CONSP (frames);
- frames = XCDR (frames))
- {
- Lisp_Object this;
+ FOR_EACH_FRAME (frames, this)
+ {
+ if (f == XFRAME (this))
+ continue;
- this = XCAR (frames);
- /* Verify that the frame's window still exists
- and we can still talk to it. And note any recent change
- in visibility. */
+ /* Verify that we can still talk to the frame's X window,
+ and note any recent change in visibility. */
#ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (XFRAME (this)))
- {
- x_sync (XFRAME (this));
- FRAME_SAMPLE_VISIBILITY (XFRAME (this));
- }
+ if (FRAME_WINDOW_P (XFRAME (this)))
+ {
+ x_sync (XFRAME (this));
+ FRAME_SAMPLE_VISIBILITY (XFRAME (this));
+ }
#endif
- if (FRAME_VISIBLE_P (XFRAME (this))
- || FRAME_ICONIFIED_P (XFRAME (this))
- /* Allow deleting the terminal frame when at least
- one X frame exists! */
- || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
- count++;
- }
- return count > 1;
+ if (FRAME_VISIBLE_P (XFRAME (this))
+ || FRAME_ICONIFIED_P (XFRAME (this))
+ /* Allow deleting the terminal frame when at least one X
+ frame exists. */
+ || (FRAME_WINDOW_P (XFRAME (this)) && !FRAME_WINDOW_P (f)))
+ return 1;
}
- return 1;
+ return 0;
}
/* Delete FRAME. When FORCE equals Qnoelisp, delete FRAME
@@ -1161,27 +1120,12 @@ other_visible_frames (FRAME_PTR f)
described for Fdelete_frame. */
Lisp_Object
delete_frame (Lisp_Object frame, Lisp_Object force)
- /* If we use `register' here, gcc-4.0.2 on amd64 using
- -DUSE_LISP_UNION_TYPE complains further down that we're getting the
- address of `force'. Go figure. */
-
{
- struct frame *f;
+ struct frame *f = decode_any_frame (frame);
struct frame *sf = SELECTED_FRAME ();
struct kboard *kb;
- int minibuffer_selected, tooltip_frame;
-
- if (EQ (frame, Qnil))
- {
- f = sf;
- XSETFRAME (frame, f);
- }
- else
- {
- CHECK_FRAME (frame);
- f = XFRAME (frame);
- }
+ int minibuffer_selected, is_tooltip_frame;
if (! FRAME_LIVE_P (f))
return Qnil;
@@ -1194,19 +1138,16 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
if (NILP (XCDR (Vframe_list)) && !EQ (force, Qnoelisp))
error ("Attempt to delete the only frame");
+ XSETFRAME (frame, f);
+
/* Does this frame have a minibuffer, and is it the surrogate
minibuffer for any other frame? */
- if (FRAME_HAS_MINIBUF_P (XFRAME (frame)))
+ if (FRAME_HAS_MINIBUF_P (f))
{
- Lisp_Object frames;
+ Lisp_Object frames, this;
- for (frames = Vframe_list;
- CONSP (frames);
- frames = XCDR (frames))
+ FOR_EACH_FRAME (frames, this)
{
- Lisp_Object this;
- this = XCAR (frames);
-
if (! EQ (this, frame)
&& EQ (frame,
WINDOW_FRAME (XWINDOW
@@ -1222,13 +1163,13 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
}
}
- tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
+ is_tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
/* Run `delete-frame-functions' unless FORCE is `noelisp' or
frame is a tooltip. FORCE is set to `noelisp' when handling
a disconnect from the terminal, so we don't dare call Lisp
code. */
- if (NILP (Vrun_hooks) || tooltip_frame)
+ if (NILP (Vrun_hooks) || is_tooltip_frame)
;
else if (EQ (force, Qnoelisp))
pending_funcalls
@@ -1267,7 +1208,17 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
FOR_EACH_FRAME (tail, frame1)
{
if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
- break;
+ {
+ /* Do not change a text terminal's top-frame. */
+ struct frame *f1 = XFRAME (frame1);
+ if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1))
+ {
+ Lisp_Object top_frame = FRAME_TTY (f1)->top_frame;
+ if (!EQ (top_frame, frame))
+ frame1 = top_frame;
+ }
+ break;
+ }
}
}
#ifdef NS_IMPL_COCOA
@@ -1287,8 +1238,10 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
/* Don't allow minibuf_window to remain on a deleted frame. */
if (EQ (f->minibuffer_window, minibuf_window))
{
- Fset_window_buffer (sf->minibuffer_window,
- XWINDOW (minibuf_window)->buffer, Qnil);
+ /* Use set_window_buffer instead of Fset_window_buffer (see
+ discussion of bug#11984, bug#12025, bug#12026). */
+ set_window_buffer (sf->minibuffer_window,
+ XWINDOW (minibuf_window)->buffer, 0, 0);
minibuf_window = sf->minibuffer_window;
/* If the dying minibuffer window was selected,
@@ -1321,7 +1274,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
/* Mark all the windows that used to be on FRAME as deleted, and then
remove the reference to them. */
delete_all_child_windows (f->root_window);
- f->root_window = Qnil;
+ fset_root_window (f, Qnil);
Vframe_list = Fdelq (frame, Vframe_list);
FRAME_SET_VISIBLE (f, 0);
@@ -1330,7 +1283,12 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
garbage collection. The frame object itself may not be garbage
collected until much later, because recent_keys and other data
structures can still refer to it. */
- f->menu_bar_vector = Qnil;
+ fset_menu_bar_vector (f, Qnil);
+
+ /* If FRAME's buffer lists contains killed
+ buffers, this helps GC to reclaim them. */
+ fset_buffer_list (f, Qnil);
+ fset_buried_buffer_list (f, Qnil);
free_font_driver_list (f);
xfree (f->namebuf);
@@ -1382,15 +1340,13 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
another one. */
if (f == last_nonminibuf_frame)
{
- Lisp_Object frames;
+ Lisp_Object frames, this;
last_nonminibuf_frame = 0;
- for (frames = Vframe_list;
- CONSP (frames);
- frames = XCDR (frames))
+ FOR_EACH_FRAME (frames, this)
{
- f = XFRAME (XCAR (frames));
+ f = XFRAME (this);
if (!FRAME_MINIBUF_ONLY_P (f))
{
last_nonminibuf_frame = f;
@@ -1403,27 +1359,13 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
single-kboard state if we're in it for this kboard. */
if (kb != NULL)
{
- Lisp_Object frames;
+ Lisp_Object frames, this;
/* Some frame we found on the same kboard, or nil if there are none. */
- Lisp_Object frame_on_same_kboard;
-
- frame_on_same_kboard = Qnil;
+ Lisp_Object frame_on_same_kboard = Qnil;
- for (frames = Vframe_list;
- CONSP (frames);
- frames = XCDR (frames))
- {
- Lisp_Object this;
- struct frame *f1;
-
- this = XCAR (frames);
- if (!FRAMEP (this))
- abort ();
- f1 = XFRAME (this);
-
- if (kb == FRAME_KBOARD (f1))
- frame_on_same_kboard = this;
- }
+ FOR_EACH_FRAME (frames, this)
+ if (kb == FRAME_KBOARD (XFRAME (this)))
+ frame_on_same_kboard = this;
if (NILP (frame_on_same_kboard))
not_single_kboard_state (kb);
@@ -1435,27 +1377,16 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
frames with other windows. */
if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame)))
{
- Lisp_Object frames;
+ Lisp_Object frames, this;
/* The last frame we saw with a minibuffer, minibuffer-only or not. */
- Lisp_Object frame_with_minibuf;
+ Lisp_Object frame_with_minibuf = Qnil;
/* Some frame we found on the same kboard, or nil if there are none. */
- Lisp_Object frame_on_same_kboard;
-
- frame_on_same_kboard = Qnil;
- frame_with_minibuf = Qnil;
+ Lisp_Object frame_on_same_kboard = Qnil;
- for (frames = Vframe_list;
- CONSP (frames);
- frames = XCDR (frames))
+ FOR_EACH_FRAME (frames, this)
{
- Lisp_Object this;
- struct frame *f1;
-
- this = XCAR (frames);
- if (!FRAMEP (this))
- abort ();
- f1 = XFRAME (this);
+ struct frame *f1 = XFRAME (this);
/* Consider only frames on the same kboard
and only those with minibuffers. */
@@ -1480,17 +1411,17 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
that is prohibited at the top; you can't delete surrogate
minibuffer frames. */
if (NILP (frame_with_minibuf))
- abort ();
+ emacs_abort ();
- KVAR (kb, Vdefault_minibuffer_frame) = frame_with_minibuf;
+ kset_default_minibuffer_frame (kb, frame_with_minibuf);
}
else
/* No frames left on this kboard--say no minibuffer either. */
- KVAR (kb, Vdefault_minibuffer_frame) = Qnil;
+ kset_default_minibuffer_frame (kb, Qnil);
}
/* Cause frame titles to update--necessary if we now have just one frame. */
- if (!tooltip_frame)
+ if (!is_tooltip_frame)
update_mode_lines = 1;
return Qnil;
@@ -1530,31 +1461,31 @@ and returns whatever that function returns. */)
{
FRAME_PTR f;
Lisp_Object lispy_dummy;
- enum scroll_bar_part party_dummy;
Lisp_Object x, y, retval;
- int col, row;
- Time long_dummy;
struct gcpro gcpro1;
f = SELECTED_FRAME ();
x = y = Qnil;
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
/* It's okay for the hook to refrain from storing anything. */
if (FRAME_TERMINAL (f)->mouse_position_hook)
- (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
- &lispy_dummy, &party_dummy,
- &x, &y,
- &long_dummy);
+ {
+ enum scroll_bar_part party_dummy;
+ Time time_dummy;
+ (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
+ &lispy_dummy, &party_dummy,
+ &x, &y,
+ &time_dummy);
+ }
+
if (! NILP (x))
{
- col = XINT (x);
- row = XINT (y);
+ int col = XINT (x);
+ int row = XINT (y);
pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
XSETINT (x, col);
XSETINT (y, row);
}
-#endif
XSETFRAME (lispy_dummy, f);
retval = Fcons (lispy_dummy, Fcons (x, y));
GCPRO1 (retval);
@@ -1576,21 +1507,22 @@ and nil for X and Y. */)
{
FRAME_PTR f;
Lisp_Object lispy_dummy;
- enum scroll_bar_part party_dummy;
Lisp_Object x, y;
- Time long_dummy;
f = SELECTED_FRAME ();
x = y = Qnil;
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
/* It's okay for the hook to refrain from storing anything. */
if (FRAME_TERMINAL (f)->mouse_position_hook)
- (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
- &lispy_dummy, &party_dummy,
- &x, &y,
- &long_dummy);
-#endif
+ {
+ enum scroll_bar_part party_dummy;
+ Time time_dummy;
+ (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, -1,
+ &lispy_dummy, &party_dummy,
+ &x, &y,
+ &time_dummy);
+ }
+
XSETFRAME (lispy_dummy, f);
return Fcons (lispy_dummy, Fcons (x, y));
}
@@ -1612,8 +1544,8 @@ before calling this function on it, like this.
(Lisp_Object frame, Lisp_Object x, Lisp_Object y)
{
CHECK_LIVE_FRAME (frame);
- CHECK_NUMBER (x);
- CHECK_NUMBER (y);
+ CHECK_TYPE_RANGED_INTEGER (int, x);
+ CHECK_TYPE_RANGED_INTEGER (int, y);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
@@ -1621,7 +1553,7 @@ before calling this function on it, like this.
/* Warping the mouse will cause enternotify and focus events. */
x_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
#else
-#if defined (MSDOS) && defined (HAVE_MOUSE)
+#if defined (MSDOS)
if (FRAME_MSDOS_P (XFRAME (frame)))
{
Fselect_frame (frame, Qnil);
@@ -1653,8 +1585,8 @@ before calling this function on it, like this.
(Lisp_Object frame, Lisp_Object x, Lisp_Object y)
{
CHECK_LIVE_FRAME (frame);
- CHECK_NUMBER (x);
- CHECK_NUMBER (y);
+ CHECK_TYPE_RANGED_INTEGER (int, x);
+ CHECK_TYPE_RANGED_INTEGER (int, y);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
@@ -1662,7 +1594,7 @@ before calling this function on it, like this.
/* Warping the mouse will cause enternotify and focus events. */
x_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
#else
-#if defined (MSDOS) && defined (HAVE_MOUSE)
+#if defined (MSDOS)
if (FRAME_MSDOS_P (XFRAME (frame)))
{
Fselect_frame (frame, Qnil);
@@ -1689,25 +1621,23 @@ DEFUN ("make-frame-visible", Fmake_frame_visible, Smake_frame_visible,
If omitted, FRAME defaults to the currently selected frame. */)
(Lisp_Object frame)
{
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
+ struct frame *f = decode_live_frame (frame);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (XFRAME (frame)))
+ if (FRAME_WINDOW_P (f))
{
- FRAME_SAMPLE_VISIBILITY (XFRAME (frame));
- x_make_frame_visible (XFRAME (frame));
+ FRAME_SAMPLE_VISIBILITY (f);
+ x_make_frame_visible (f);
}
#endif
- make_frame_visible_1 (XFRAME (frame)->root_window);
+ make_frame_visible_1 (f->root_window);
/* Make menu bar update for the Buffers and Frames menus. */
windows_or_buffers_changed++;
+ XSETFRAME (frame, f);
return frame;
}
@@ -1724,7 +1654,7 @@ make_frame_visible_1 (Lisp_Object window)
w = XWINDOW (window);
if (!NILP (w->buffer))
- BVAR (XBUFFER (w->buffer), display_time) = Fcurrent_time ();
+ bset_display_time (XBUFFER (w->buffer), Fcurrent_time ());
if (!NILP (w->vchild))
make_frame_visible_1 (w->vchild);
@@ -1743,38 +1673,31 @@ usually not displayed at all, even in a window system's \"taskbar\".
Normally you may not make FRAME invisible if all other frames are invisible,
but if the second optional argument FORCE is non-nil, you may do so.
-This function has no effect on text-only terminal frames. Such frames
-are always considered visible, whether or not they are currently being
+This function has no effect on text terminal frames. Such frames are
+always considered visible, whether or not they are currently being
displayed in the terminal. */)
(Lisp_Object frame, Lisp_Object force)
{
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
+ struct frame *f = decode_live_frame (frame);
- if (NILP (force) && !other_visible_frames (XFRAME (frame)))
+ if (NILP (force) && !other_visible_frames (f))
error ("Attempt to make invisible the sole visible or iconified frame");
-#if 0 /* This isn't logically necessary, and it can do GC. */
- /* Don't let the frame remain selected. */
- if (EQ (frame, selected_frame))
- do_switch_frame (next_frame (frame, Qt), 0, 0, Qnil)
-#endif
-
/* Don't allow minibuf_window to remain on a deleted frame. */
- if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
+ if (EQ (f->minibuffer_window, minibuf_window))
{
struct frame *sf = XFRAME (selected_frame);
- Fset_window_buffer (sf->minibuffer_window,
- XWINDOW (minibuf_window)->buffer, Qnil);
+ /* Use set_window_buffer instead of Fset_window_buffer (see
+ discussion of bug#11984, bug#12025, bug#12026). */
+ set_window_buffer (sf->minibuffer_window,
+ XWINDOW (minibuf_window)->buffer, 0, 0);
minibuf_window = sf->minibuffer_window;
}
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (XFRAME (frame)))
- x_make_frame_invisible (XFRAME (frame));
+ if (FRAME_WINDOW_P (f))
+ x_make_frame_invisible (f);
#endif
/* Make menu bar update for the Buffers and Frames menus. */
@@ -1789,30 +1712,23 @@ DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
If omitted, FRAME defaults to the currently selected frame. */)
(Lisp_Object frame)
{
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
-
-#if 0 /* This isn't logically necessary, and it can do GC. */
- /* Don't let the frame remain selected. */
- if (EQ (frame, selected_frame))
- Fhandle_switch_frame (next_frame (frame, Qt));
-#endif
+ struct frame *f = decode_live_frame (frame);
- /* Don't allow minibuf_window to remain on a deleted frame. */
- if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
+ /* Don't allow minibuf_window to remain on an iconified frame. */
+ if (EQ (f->minibuffer_window, minibuf_window))
{
struct frame *sf = XFRAME (selected_frame);
- Fset_window_buffer (sf->minibuffer_window,
- XWINDOW (minibuf_window)->buffer, Qnil);
+ /* Use set_window_buffer instead of Fset_window_buffer (see
+ discussion of bug#11984, bug#12025, bug#12026). */
+ set_window_buffer (sf->minibuffer_window,
+ XWINDOW (minibuf_window)->buffer, 0, 0);
minibuf_window = sf->minibuffer_window;
}
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (XFRAME (frame)))
- x_iconify_frame (XFRAME (frame));
+ if (FRAME_WINDOW_P (f))
+ x_iconify_frame (f);
#endif
/* Make menu bar update for the Buffers and Frames menus. */
@@ -1829,7 +1745,7 @@ Return nil if FRAME was made invisible, via `make-frame-invisible'.
On graphical displays, invisible frames are not updated and are
usually not displayed at all, even in a window system's \"taskbar\".
-If FRAME is a text-only terminal frame, this always returns t.
+If FRAME is a text terminal frame, this always returns t.
Such frames are always considered visible, whether or not they are
currently being displayed on the terminal. */)
(Lisp_Object frame)
@@ -1850,20 +1766,12 @@ DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
doc: /* Return a list of all frames now \"visible\" (being updated). */)
(void)
{
- Lisp_Object tail, frame;
- struct frame *f;
- Lisp_Object value;
+ Lisp_Object tail, frame, value = Qnil;
+
+ FOR_EACH_FRAME (tail, frame)
+ if (FRAME_VISIBLE_P (XFRAME (frame)))
+ value = Fcons (frame, value);
- value = Qnil;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
- {
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
- f = XFRAME (frame);
- if (FRAME_VISIBLE_P (f))
- value = Fcons (frame, value);
- }
return value;
}
@@ -1876,16 +1784,12 @@ If Emacs is displaying on an ordinary terminal or some other device which
doesn't support multiple overlapping frames, this function selects FRAME. */)
(Lisp_Object frame)
{
- struct frame *f;
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
+ struct frame *f = decode_live_frame (frame);
- f = XFRAME (frame);
+ XSETFRAME (frame, f);
if (FRAME_TERMCAP_P (f))
- /* On a text-only terminal select FRAME. */
+ /* On a text terminal select FRAME. */
Fselect_frame (frame, Qnil);
else
/* Do like the documentation says. */
@@ -1905,14 +1809,7 @@ If Emacs is displaying on an ordinary terminal or some other device which
doesn't support multiple overlapping frames, this function does nothing. */)
(Lisp_Object frame)
{
- struct frame *f;
-
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
-
- f = XFRAME (frame);
+ struct frame *f = decode_live_frame (frame);
if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
(*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
@@ -1928,8 +1825,8 @@ In other words, switch-frame events caused by events in FRAME will
request a switch to FOCUS-FRAME, and `last-event-frame' will be
FOCUS-FRAME after reading an event typed at FRAME.
-If FOCUS-FRAME is omitted or nil, any existing redirection is
-canceled, and the frame again receives its own keystrokes.
+If FOCUS-FRAME is nil, any existing redirection is canceled, and the
+frame again receives its own keystrokes.
Focus redirection is useful for temporarily redirecting keystrokes to
a surrogate minibuffer frame when a frame doesn't have its own
@@ -1948,19 +1845,15 @@ is affected by `select-frame', while the latter is not.
The redirection lasts until `redirect-frame-focus' is called to change it. */)
(Lisp_Object frame, Lisp_Object focus_frame)
{
- struct frame *f;
-
/* Note that we don't check for a live frame here. It's reasonable
to redirect the focus of a frame you're about to delete, if you
know what other frame should receive those keystrokes. */
- CHECK_FRAME (frame);
+ struct frame *f = decode_any_frame (frame);
if (! NILP (focus_frame))
CHECK_LIVE_FRAME (focus_frame);
- f = XFRAME (frame);
-
- f->focus_frame = focus_frame;
+ fset_focus_frame (f, focus_frame);
if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
(*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
@@ -1969,21 +1862,21 @@ The redirection lasts until `redirect-frame-focus' is called to change it. */)
}
-DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 1, 1, 0,
+DEFUN ("frame-focus", Fframe_focus, Sframe_focus, 0, 1, 0,
doc: /* Return the frame to which FRAME's keystrokes are currently being sent.
-This returns nil if FRAME's focus is not redirected.
+If FRAME is omitted or nil, the selected frame is used.
+Return nil if FRAME's focus is not redirected.
See `redirect-frame-focus'. */)
(Lisp_Object frame)
{
- CHECK_LIVE_FRAME (frame);
-
- return FRAME_FOCUS_FRAME (XFRAME (frame));
+ return FRAME_FOCUS_FRAME (decode_live_frame (frame));
}
/* Return the value of frame parameter PROP in frame FRAME. */
+#ifdef HAVE_WINDOW_SYSTEM
#if !HAVE_NS
static
#endif
@@ -1997,22 +1890,7 @@ get_frame_param (register struct frame *frame, Lisp_Object prop)
return tem;
return Fcdr (tem);
}
-
-/* Return the buffer-predicate of the selected frame. */
-
-Lisp_Object
-frame_buffer_predicate (Lisp_Object frame)
-{
- return XFRAME (frame)->buffer_predicate;
-}
-
-/* Return the buffer-list of the selected frame. */
-
-static Lisp_Object
-frame_buffer_list (Lisp_Object frame)
-{
- return XFRAME (frame)->buffer_list;
-}
+#endif
/* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */
@@ -2023,10 +1901,10 @@ frames_discard_buffer (Lisp_Object buffer)
FOR_EACH_FRAME (tail, frame)
{
- XFRAME (frame)->buffer_list
- = Fdelq (buffer, XFRAME (frame)->buffer_list);
- XFRAME (frame)->buried_buffer_list
- = Fdelq (buffer, XFRAME (frame)->buried_buffer_list);
+ fset_buffer_list
+ (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buffer_list));
+ fset_buried_buffer_list
+ (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buried_buffer_list));
}
}
@@ -2046,7 +1924,7 @@ store_in_alist (Lisp_Object *alistptr, Lisp_Object prop, Lisp_Object val)
}
static int
-frame_name_fnn_p (char *str, EMACS_INT len)
+frame_name_fnn_p (char *str, ptrdiff_t len)
{
if (len > 1 && str[0] == 'F' && '0' <= str[1] && str[1] <= '9')
{
@@ -2074,13 +1952,10 @@ set_term_frame_name (struct frame *f, Lisp_Object name)
/* Check for no change needed in this very common case
before we do any consing. */
- if (frame_name_fnn_p (SSDATA (f->name),
- SBYTES (f->name)))
+ if (frame_name_fnn_p (SSDATA (f->name), SBYTES (f->name)))
return;
- tty_frame_count++;
- sprintf (namebuf, "F%"pMd, tty_frame_count);
- name = build_string (namebuf);
+ name = make_formatted_string (namebuf, "F%"pMd, ++tty_frame_count);
}
else
{
@@ -2096,7 +1971,7 @@ set_term_frame_name (struct frame *f, Lisp_Object name)
error ("Frame names of the form F<num> are usurped by Emacs");
}
- f->name = name;
+ fset_name (f, name);
update_mode_lines = 1;
}
@@ -2113,7 +1988,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
for (; CONSP (val); val = XCDR (val))
if (!NILP (Fbuffer_live_p (XCAR (val))))
list = Fcons (XCAR (val), list);
- f->buffer_list = Fnreverse (list);
+ fset_buffer_list (f, Fnreverse (list));
return;
}
if (EQ (prop, Qburied_buffer_list))
@@ -2122,7 +1997,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
for (; CONSP (val); val = XCDR (val))
if (!NILP (Fbuffer_live_p (XCAR (val))))
list = Fcons (XCAR (val), list);
- f->buried_buffer_list = Fnreverse (list);
+ fset_buried_buffer_list (f, Fnreverse (list));
return;
}
@@ -2140,11 +2015,11 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
case SYMBOL_LOCALIZED:
{ struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
- if (blv->frame_local && BLV_FOUND (blv) && XFRAME (blv->where) == f)
+ if (blv->frame_local && blv_found (blv) && XFRAME (blv->where) == f)
swap_in_global_binding (sym);
break;
}
- default: abort ();
+ default: emacs_abort ();
}
}
@@ -2159,7 +2034,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
/* Update the frame parameter alist. */
old_alist_elt = Fassq (prop, f->param_alist);
if (EQ (old_alist_elt, Qnil))
- f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
+ fset_param_alist (f, Fcons (Fcons (prop, val), f->param_alist));
else
Fsetcdr (old_alist_elt, val);
@@ -2167,7 +2042,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
in addition to the alist. */
if (EQ (prop, Qbuffer_predicate))
- f->buffer_predicate = val;
+ fset_buffer_predicate (f, val);
if (! FRAME_WINDOW_P (f))
{
@@ -2187,7 +2062,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
/* Install the chosen minibuffer window, with proper buffer. */
- f->minibuffer_window = val;
+ fset_minibuffer_window (f, val);
}
}
@@ -2195,20 +2070,14 @@ DEFUN ("frame-parameters", Fframe_parameters, Sframe_parameters, 0, 1, 0,
doc: /* Return the parameters-alist of frame FRAME.
It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
The meaningful PARMs depend on the kind of frame.
-If FRAME is omitted, return information on the currently selected frame. */)
+If FRAME is omitted or nil, return information on the currently selected frame. */)
(Lisp_Object frame)
{
Lisp_Object alist;
- FRAME_PTR f;
+ struct frame *f = decode_any_frame (frame);
int height, width;
struct gcpro gcpro1;
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_FRAME (frame);
- f = XFRAME (frame);
-
if (!FRAME_LIVE_P (f))
return Qnil;
@@ -2269,8 +2138,8 @@ If FRAME is omitted, return information on the currently selected frame. */)
: FRAME_MINIBUF_ONLY_P (f) ? Qonly
: FRAME_MINIBUF_WINDOW (f)));
store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
- store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame));
- store_in_alist (&alist, Qburied_buffer_list, XFRAME (frame)->buried_buffer_list);
+ store_in_alist (&alist, Qbuffer_list, f->buffer_list);
+ store_in_alist (&alist, Qburied_buffer_list, f->buried_buffer_list);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
@@ -2295,17 +2164,12 @@ DEFUN ("frame-parameter", Fframe_parameter, Sframe_parameter, 2, 2, 0,
If FRAME is nil, describe the currently selected frame. */)
(Lisp_Object frame, Lisp_Object parameter)
{
- struct frame *f;
- Lisp_Object value;
+ struct frame *f = decode_any_frame (frame);
+ Lisp_Object value = Qnil;
- if (NILP (frame))
- frame = selected_frame;
- else
- CHECK_FRAME (frame);
CHECK_SYMBOL (parameter);
- f = XFRAME (frame);
- value = Qnil;
+ XSETFRAME (frame, f);
if (FRAME_LIVE_P (f))
{
@@ -2330,7 +2194,7 @@ If FRAME is nil, describe the currently selected frame. */)
if (STRINGP (value) && !FRAME_WINDOW_P (f))
{
const char *color_name;
- EMACS_INT csz;
+ ptrdiff_t csz;
if (EQ (parameter, Qbackground_color))
{
@@ -2385,14 +2249,9 @@ Note that this functionality is obsolete as of Emacs 22.2, and its
use is not recommended. Explicitly check for a frame-parameter instead. */)
(Lisp_Object frame, Lisp_Object alist)
{
- FRAME_PTR f;
+ struct frame *f = decode_live_frame (frame);
register Lisp_Object tail, prop, val;
- if (EQ (frame, Qnil))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
-
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
@@ -2406,12 +2265,13 @@ use is not recommended. Explicitly check for a frame-parameter instead. */)
#endif
{
- int length = XINT (Flength (alist));
- int i;
- Lisp_Object *parms
- = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
- Lisp_Object *values
- = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
+ EMACS_INT length = XFASTINT (Flength (alist));
+ ptrdiff_t i;
+ Lisp_Object *parms;
+ Lisp_Object *values;
+ USE_SAFE_ALLOCA;
+ SAFE_ALLOCA_LISP (parms, 2 * length);
+ values = parms + length;
/* Extract parm names and values into those vectors. */
@@ -2437,6 +2297,8 @@ use is not recommended. Explicitly check for a frame-parameter instead. */)
|| EQ (prop, Qbackground_color))
update_face_from_frame_parameter (f, prop, val);
}
+
+ SAFE_FREE ();
}
return Qnil;
}
@@ -2444,18 +2306,13 @@ use is not recommended. Explicitly check for a frame-parameter instead. */)
DEFUN ("frame-char-height", Fframe_char_height, Sframe_char_height,
0, 1, 0,
doc: /* Height in pixels of a line in the font in frame FRAME.
-If FRAME is omitted, the selected frame is used.
+If FRAME is omitted or nil, the selected frame is used.
For a terminal frame, the value is always 1. */)
(Lisp_Object frame)
{
- struct frame *f;
-
- if (NILP (frame))
- frame = selected_frame;
- CHECK_FRAME (frame);
- f = XFRAME (frame);
-
#ifdef HAVE_WINDOW_SYSTEM
+ struct frame *f = decode_any_frame (frame);
+
if (FRAME_WINDOW_P (f))
return make_number (x_char_height (f));
else
@@ -2467,19 +2324,14 @@ For a terminal frame, the value is always 1. */)
DEFUN ("frame-char-width", Fframe_char_width, Sframe_char_width,
0, 1, 0,
doc: /* Width in pixels of characters in the font in frame FRAME.
-If FRAME is omitted, the selected frame is used.
+If FRAME is omitted or nil, the selected frame is used.
On a graphical screen, the width is the standard width of the default font.
For a terminal screen, the value is always 1. */)
(Lisp_Object frame)
{
- struct frame *f;
-
- if (NILP (frame))
- frame = selected_frame;
- CHECK_FRAME (frame);
- f = XFRAME (frame);
-
#ifdef HAVE_WINDOW_SYSTEM
+ struct frame *f = decode_any_frame (frame);
+
if (FRAME_WINDOW_P (f))
return make_number (x_char_width (f));
else
@@ -2490,30 +2342,22 @@ For a terminal screen, the value is always 1. */)
DEFUN ("frame-pixel-height", Fframe_pixel_height,
Sframe_pixel_height, 0, 1, 0,
doc: /* Return a FRAME's height in pixels.
-If FRAME is omitted, the selected frame is used. The exact value
+If FRAME is omitted or nil, the selected frame is used. The exact value
of the result depends on the window-system and toolkit in use:
In the Gtk+ version of Emacs, it includes only any window (including
the minibuffer or echo area), mode line, and header line. It does not
include the tool bar or menu bar.
-With the Motif or Lucid toolkits, it also includes the tool bar (but
-not the menu bar).
+With other graphical versions, it also includes the tool bar and the
+menu bar.
-In a graphical version with no toolkit, it includes both the tool bar
-and menu bar.
-
-For a text-only terminal, it includes the menu bar. In this case, the
+For a text terminal, it includes the menu bar. In this case, the
result is really in characters rather than pixels (i.e., is identical
to `frame-height'). */)
(Lisp_Object frame)
{
- struct frame *f;
-
- if (NILP (frame))
- frame = selected_frame;
- CHECK_FRAME (frame);
- f = XFRAME (frame);
+ struct frame *f = decode_any_frame (frame);
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
@@ -2527,15 +2371,10 @@ DEFUN ("frame-pixel-width", Fframe_pixel_width,
Sframe_pixel_width, 0, 1, 0,
doc: /* Return FRAME's width in pixels.
For a terminal frame, the result really gives the width in characters.
-If FRAME is omitted, the selected frame is used. */)
+If FRAME is omitted or nil, the selected frame is used. */)
(Lisp_Object frame)
{
- struct frame *f;
-
- if (NILP (frame))
- frame = selected_frame;
- CHECK_FRAME (frame);
- f = XFRAME (frame);
+ struct frame *f = decode_any_frame (frame);
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
@@ -2549,18 +2388,13 @@ DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
Stool_bar_pixel_width, 0, 1, 0,
doc: /* Return width in pixels of FRAME's tool bar.
The result is greater than zero only when the tool bar is on the left
-or right side of FRAME. If FRAME is omitted, the selected frame is
-used. */)
+or right side of FRAME. If FRAME is omitted or nil, the selected frame
+is used. */)
(Lisp_Object frame)
{
- struct frame *f;
-
- if (NILP (frame))
- frame = selected_frame;
- CHECK_FRAME (frame);
- f = XFRAME (frame);
-
#ifdef FRAME_TOOLBAR_WIDTH
+ struct frame *f = decode_any_frame (frame);
+
if (FRAME_WINDOW_P (f))
return make_number (FRAME_TOOLBAR_WIDTH (f));
#endif
@@ -2573,13 +2407,9 @@ Optional third arg non-nil means that redisplay should use LINES lines
but that the idea of the actual height of the frame should not be changed. */)
(Lisp_Object frame, Lisp_Object lines, Lisp_Object pretend)
{
- register struct frame *f;
+ register struct frame *f = decode_live_frame (frame);
- CHECK_NUMBER (lines);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
+ CHECK_TYPE_RANGED_INTEGER (int, lines);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
@@ -2601,12 +2431,9 @@ Optional third arg non-nil means that redisplay should use COLS columns
but that the idea of the actual width of the frame should not be changed. */)
(Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
{
- register struct frame *f;
- CHECK_NUMBER (cols);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
+ register struct frame *f = decode_live_frame (frame);
+
+ CHECK_TYPE_RANGED_INTEGER (int, cols);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
@@ -2629,8 +2456,8 @@ DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
register struct frame *f;
CHECK_LIVE_FRAME (frame);
- CHECK_NUMBER (cols);
- CHECK_NUMBER (rows);
+ CHECK_TYPE_RANGED_INTEGER (int, cols);
+ CHECK_TYPE_RANGED_INTEGER (int, rows);
f = XFRAME (frame);
/* I think this should be done with a hook. */
@@ -2661,8 +2488,8 @@ the rightmost or bottommost possible position (that stays within the screen). *
register struct frame *f;
CHECK_LIVE_FRAME (frame);
- CHECK_NUMBER (xoffset);
- CHECK_NUMBER (yoffset);
+ CHECK_TYPE_RANGED_INTEGER (int, xoffset);
+ CHECK_TYPE_RANGED_INTEGER (int, yoffset);
f = XFRAME (frame);
/* I think this should be done with a hook. */
@@ -2728,7 +2555,7 @@ static const struct frame_parm_table frame_parms[] =
{"tool-bar-position", &Qtool_bar_position},
};
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
/* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
wanted positions of the WM window (not Emacs window).
@@ -2772,7 +2599,7 @@ x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int
*height = newheight;
}
-#endif /* WINDOWSNT */
+#endif /* HAVE_NTGUI */
#ifdef HAVE_WINDOW_SYSTEM
@@ -2808,11 +2635,11 @@ x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
struct gcpro gcpro1, gcpro2;
i = 0;
- for (tail = alist; CONSP (tail); tail = Fcdr (tail))
+ for (tail = alist; CONSP (tail); tail = XCDR (tail))
i++;
- parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
- values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
+ parms = alloca (i * sizeof *parms);
+ values = alloca (i * sizeof *values);
/* Extract parm names and values into those vectors. */
@@ -2881,12 +2708,12 @@ x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
prop = parms[i];
val = values[i];
- if (EQ (prop, Qwidth) && NATNUMP (val))
+ if (EQ (prop, Qwidth) && RANGED_INTEGERP (0, val, INT_MAX))
{
size_changed = 1;
width = XFASTINT (val);
}
- else if (EQ (prop, Qheight) && NATNUMP (val))
+ else if (EQ (prop, Qheight) && RANGED_INTEGERP (0, val, INT_MAX))
{
size_changed = 1;
height = XFASTINT (val);
@@ -2940,14 +2767,14 @@ x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
}
/* If one of the icon positions was not set, preserve or default it. */
- if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
+ if (! TYPE_RANGED_INTEGERP (int, icon_left))
{
icon_left_no_change = 1;
icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
if (NILP (icon_left))
XSETINT (icon_left, 0);
}
- if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
+ if (! TYPE_RANGED_INTEGERP (int, icon_top))
{
icon_top_no_change = 1;
icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
@@ -3059,9 +2886,9 @@ x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
void
x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
{
- char buf[16];
Lisp_Object tem;
- unsigned long w;
+ uprintmax_t w;
+ char buf[INT_BUFSIZE_BOUND (w)];
/* Represent negative positions (off the top or left screen edge)
in a way that Fmodify_frame_parameters will understand correctly. */
@@ -3098,21 +2925,17 @@ x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
MS-Windows it returns a value whose type is HANDLE, which is
actually a pointer. Explicit casting avoids compiler
warnings. */
- w = (unsigned long) FRAME_X_WINDOW (f);
- sprintf (buf, "%lu", w);
+ w = (uintptr_t) FRAME_X_WINDOW (f);
store_in_alist (alistptr, Qwindow_id,
- build_string (buf));
+ make_formatted_string (buf, "%"pMu, w));
#ifdef HAVE_X_WINDOWS
#ifdef USE_X_TOOLKIT
/* Tooltip frame may not have this widget. */
if (FRAME_X_OUTPUT (f)->widget)
#endif
- {
- w = (unsigned long) FRAME_OUTER_WINDOW (f);
- sprintf (buf, "%lu", w);
- }
+ w = (uintptr_t) FRAME_OUTER_WINDOW (f);
store_in_alist (alistptr, Qouter_window_id,
- build_string (buf));
+ make_formatted_string (buf, "%"pMu, w));
#endif
store_in_alist (alistptr, Qicon_name, f->icon_name);
FRAME_SAMPLE_VISIBILITY (f);
@@ -3162,7 +2985,7 @@ x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu
{
if (NILP (new_value))
f->extra_line_spacing = 0;
- else if (NATNUMP (new_value))
+ else if (RANGED_INTEGERP (0, new_value, INT_MAX))
f->extra_line_spacing = XFASTINT (new_value);
else
signal_error ("Invalid line-spacing", new_value);
@@ -3207,8 +3030,11 @@ x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu
void
x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
- Lisp_Object font_object, font_param = Qnil;
+ Lisp_Object font_object;
int fontset = -1;
+#ifdef HAVE_X_WINDOWS
+ Lisp_Object font_param = arg;
+#endif
/* Set the frame parameter back to the old value because we may
fail to use ARG as the new parameter value. */
@@ -3219,20 +3045,17 @@ x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
never fail. */
if (STRINGP (arg))
{
- font_param = arg;
fontset = fs_query_fontset (arg, 0);
if (fontset < 0)
{
- font_object = font_open_by_name (f, SSDATA (arg));
+ font_object = font_open_by_name (f, arg);
if (NILP (font_object))
error ("Font `%s' is not defined", SSDATA (arg));
arg = AREF (font_object, FONT_NAME_INDEX);
}
else if (fontset > 0)
{
- Lisp_Object ascii_font = fontset_ascii (fontset);
-
- font_object = font_open_by_name (f, SSDATA (ascii_font));
+ font_object = font_open_by_name (f, fontset_ascii (fontset));
if (NILP (font_object))
error ("Font `%s' is not defined", SDATA (arg));
arg = AREF (font_object, FONT_NAME_INDEX);
@@ -3250,12 +3073,16 @@ x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
error ("Unknown fontset: %s", SDATA (XCAR (arg)));
font_object = XCDR (arg);
arg = AREF (font_object, FONT_NAME_INDEX);
+#ifdef HAVE_X_WINDOWS
font_param = Ffont_get (font_object, QCname);
+#endif
}
else if (FONT_OBJECT_P (arg))
{
font_object = arg;
+#ifdef HAVE_X_WINDOWS
font_param = Ffont_get (font_object, QCname);
+#endif
/* This is to store the XLFD font name in the frame parameter for
backward compatibility. We should store the font-object
itself in the future. */
@@ -3268,6 +3095,9 @@ x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
Lisp_Object ascii_font = fontset_ascii (fontset);
Lisp_Object spec = font_spec_from_name (ascii_font);
+ if (NILP (spec))
+ signal_error ("Invalid font name", ascii_font);
+
if (! font_match_p (spec, font_object))
fontset = -1;
}
@@ -3314,7 +3144,7 @@ x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu
new_value = Qnil;
while (*p0)
{
- while (*p1 && ! isspace (*p1) && *p1 != ',') p1++;
+ while (*p1 && ! c_isspace (*p1) && *p1 != ',') p1++;
if (p0 < p1)
new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
new_value);
@@ -3322,7 +3152,7 @@ x_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu
{
int c;
- while ((c = *++p1) && isspace (c));
+ while ((c = *++p1) && c_isspace (c));
}
p0 = p1;
}
@@ -3371,7 +3201,7 @@ x_set_fringe_width (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu
void
x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
- CHECK_NUMBER (arg);
+ CHECK_TYPE_RANGED_INTEGER (int, arg);
if (XINT (arg) == f->border_width)
return;
@@ -3387,7 +3217,7 @@ x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldva
{
int old = FRAME_INTERNAL_BORDER_WIDTH (f);
- CHECK_NUMBER (arg);
+ CHECK_TYPE_RANGED_INTEGER (int, arg);
FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
@@ -3564,9 +3394,9 @@ x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
f->alpha[i] = newval[i];
#if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
- BLOCK_INPUT;
+ block_input ();
x_set_frame_alpha (f);
- UNBLOCK_INPUT;
+ unblock_input ();
#endif
return;
@@ -3673,17 +3503,17 @@ xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Li
/* Allocate space for the components, the dots which separate them,
and the final '\0'. Make them big enough for the worst case. */
- name_key = (char *) alloca (SBYTES (Vx_resource_name)
- + (STRINGP (component)
- ? SBYTES (component) : 0)
- + SBYTES (attribute)
- + 3);
-
- class_key = (char *) alloca (SBYTES (Vx_resource_class)
- + SBYTES (class)
- + (STRINGP (subclass)
- ? SBYTES (subclass) : 0)
- + 3);
+ name_key = alloca (SBYTES (Vx_resource_name)
+ + (STRINGP (component)
+ ? SBYTES (component) : 0)
+ + SBYTES (attribute)
+ + 3);
+
+ class_key = alloca (SBYTES (Vx_resource_class)
+ + SBYTES (class)
+ + (STRINGP (subclass)
+ ? SBYTES (subclass) : 0)
+ + 3);
/* Start with emacs.FRAMENAME for the name (the specific one)
and with `Emacs' for the class key (the general one). */
@@ -3749,8 +3579,6 @@ display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute, Lisp_Objec
char *
x_get_resource_string (const char *attribute, const char *class)
{
- char *name_key;
- char *class_key;
char *result;
struct frame *sf = SELECTED_FRAME ();
ptrdiff_t invocation_namelen = SBYTES (Vinvocation_name);
@@ -3758,9 +3586,8 @@ x_get_resource_string (const char *attribute, const char *class)
/* Allocate space for the components, the dots which separate them,
and the final '\0'. */
- SAFE_ALLOCA (name_key, char *, invocation_namelen + strlen (attribute) + 2);
- class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
- + strlen (class) + 2);
+ char *name_key = SAFE_ALLOCA (invocation_namelen + strlen (attribute) + 2);
+ char *class_key = alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2);
esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
sprintf (class_key, "%s.%s", EMACS_CLASS, class);
@@ -3873,7 +3700,7 @@ x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
}
default:
- abort ();
+ emacs_abort ();
}
}
else
@@ -3931,6 +3758,95 @@ x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
}
+#if !defined (HAVE_X_WINDOWS) && defined (NoValue)
+
+/*
+ * XParseGeometry parses strings of the form
+ * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
+ * width, height, xoffset, and yoffset are unsigned integers.
+ * Example: "=80x24+300-49"
+ * The equal sign is optional.
+ * It returns a bitmask that indicates which of the four values
+ * were actually found in the string. For each value found,
+ * the corresponding argument is updated; for each value
+ * not found, the corresponding argument is left unchanged.
+ */
+
+static int
+XParseGeometry (char *string,
+ int *x, int *y,
+ unsigned int *width, unsigned int *height)
+{
+ int mask = NoValue;
+ char *strind;
+ unsigned long int tempWidth, tempHeight;
+ long int tempX, tempY;
+ char *nextCharacter;
+
+ if (string == NULL || *string == '\0')
+ return mask;
+ if (*string == '=')
+ string++; /* ignore possible '=' at beg of geometry spec */
+
+ strind = string;
+ if (*strind != '+' && *strind != '-' && *strind != 'x')
+ {
+ tempWidth = strtoul (strind, &nextCharacter, 10);
+ if (strind == nextCharacter)
+ return 0;
+ strind = nextCharacter;
+ mask |= WidthValue;
+ }
+
+ if (*strind == 'x' || *strind == 'X')
+ {
+ strind++;
+ tempHeight = strtoul (strind, &nextCharacter, 10);
+ if (strind == nextCharacter)
+ return 0;
+ strind = nextCharacter;
+ mask |= HeightValue;
+ }
+
+ if (*strind == '+' || *strind == '-')
+ {
+ if (*strind == '-')
+ mask |= XNegative;
+ tempX = strtol (strind, &nextCharacter, 10);
+ if (strind == nextCharacter)
+ return 0;
+ strind = nextCharacter;
+ mask |= XValue;
+ if (*strind == '+' || *strind == '-')
+ {
+ if (*strind == '-')
+ mask |= YNegative;
+ tempY = strtol (strind, &nextCharacter, 10);
+ if (strind == nextCharacter)
+ return 0;
+ strind = nextCharacter;
+ mask |= YValue;
+ }
+ }
+
+ /* If strind isn't at the end of the string then it's an invalid
+ geometry specification. */
+
+ if (*strind != '\0')
+ return 0;
+
+ if (mask & XValue)
+ *x = clip_to_bounds (INT_MIN, tempX, INT_MAX);
+ if (mask & YValue)
+ *y = clip_to_bounds (INT_MIN, tempY, INT_MAX);
+ if (mask & WidthValue)
+ *width = min (tempWidth, UINT_MAX);
+ if (mask & HeightValue)
+ *height = min (tempHeight, UINT_MAX);
+ return mask;
+}
+
+#endif /* !defined (HAVE_X_WINDOWS) && defined (NoValue) */
/* NS used to define x-parse-geometry in ns-win.el, but that confused
@@ -3951,15 +3867,16 @@ or a list (- N) meaning -N pixels relative to bottom/right corner.
On Nextstep, this just calls `ns-parse-geometry'. */)
(Lisp_Object string)
{
-#ifdef HAVE_NS
- call1 (Qns_parse_geometry, string);
-#else
int geometry, x, y;
unsigned int width, height;
Lisp_Object result;
CHECK_STRING (string);
+#ifdef HAVE_NS
+ if (strchr (SSDATA (string), ' ') != NULL)
+ return call1 (Qns_parse_geometry, string);
+#endif
geometry = XParseGeometry (SSDATA (string),
&x, &y, &width, &height);
result = Qnil;
@@ -3995,7 +3912,6 @@ On Nextstep, this just calls `ns-parse-geometry'. */)
result = Fcons (Fcons (Qheight, make_number (height)), result);
return result;
-#endif /* HAVE_NS */
}
@@ -4124,7 +4040,7 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
f->top_pos = 0;
else
{
- CHECK_NUMBER (tem0);
+ CHECK_TYPE_RANGED_INTEGER (int, tem0);
f->top_pos = XINT (tem0);
if (f->top_pos < 0)
window_prompting |= YNegative;
@@ -4152,7 +4068,7 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, int toolbar_p)
f->left_pos = 0;
else
{
- CHECK_NUMBER (tem1);
+ CHECK_TYPE_RANGED_INTEGER (int, tem1);
f->left_pos = XINT (tem1);
if (f->left_pos < 0)
window_prompting |= XNegative;
@@ -4234,12 +4150,7 @@ Otherwise it returns nil. FRAME omitted or nil means the
selected frame. This is useful when `make-pointer-invisible' is set. */)
(Lisp_Object frame)
{
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_FRAME (frame);
-
- return (XFRAME (frame)->pointer_invisible ? Qnil : Qt);
+ return decode_any_frame (frame)->pointer_invisible ? Qnil : Qt;
}
@@ -4258,6 +4169,7 @@ syms_of_frame (void)
DEFSYM (Qminibuffer, "minibuffer");
DEFSYM (Qmodeline, "modeline");
DEFSYM (Qonly, "only");
+ DEFSYM (Qnone, "none");
DEFSYM (Qwidth, "width");
DEFSYM (Qgeometry, "geometry");
DEFSYM (Qicon_left, "icon-left");
@@ -4275,7 +4187,6 @@ syms_of_frame (void)
DEFSYM (Qx, "x");
DEFSYM (Qw32, "w32");
DEFSYM (Qpc, "pc");
- DEFSYM (Qmac, "mac");
DEFSYM (Qns, "ns");
DEFSYM (Qvisible, "visible");
DEFSYM (Qbuffer_predicate, "buffer-predicate");
@@ -4406,7 +4317,7 @@ The pointer becomes visible again when the mouse is moved. */);
Vmake_pointer_invisible = Qt;
DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions,
- doc: /* Functions to be run before deleting a frame.
+ doc: /* Functions run before deleting a frame.
The functions are run with one arg, the frame to be deleted.
See `delete-frame'.
diff --git a/src/frame.h b/src/frame.h
index a32d1c549b5..5ebfc2f7ec3 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -1,5 +1,5 @@
/* Define frame-object for GNU Emacs.
- Copyright (C) 1993-1994, 1999-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 1999-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -25,11 +25,16 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dispextern.h"
+INLINE_HEADER_BEGIN
+#ifndef FRAME_INLINE
+# define FRAME_INLINE INLINE
+#endif
+
/* Miscellanea. */
/* Nonzero means there is at least one garbaged frame. */
-extern int frame_garbaged;
+extern bool frame_garbaged;
/* The structure representing a frame. */
@@ -76,9 +81,6 @@ enum fullscreen_type
#define FRAME_FOREGROUND_PIXEL(f) ((f)->foreground_pixel)
#define FRAME_BACKGROUND_PIXEL(f) ((f)->background_pixel)
-struct terminal;
-
-struct font_driver_list;
struct frame
{
@@ -184,7 +186,8 @@ struct frame
Lisp_Object tool_bar_position;
/* Desired and current contents displayed in tool_bar_window. */
- Lisp_Object desired_tool_bar_string, current_tool_bar_string;
+ Lisp_Object desired_tool_bar_string;
+ Lisp_Object current_tool_bar_string;
/* Beyond here, there should be no more Lisp_Object components. */
@@ -234,7 +237,7 @@ struct frame
#if defined (USE_GTK) || defined (HAVE_NS)
/* Nonzero means using a tool bar that comes from the toolkit. */
- int external_tool_bar;
+ unsigned external_tool_bar : 1;
#endif
/* Margin at the top of the frame. Used to display the tool-bar. */
@@ -322,7 +325,7 @@ struct frame
struct x_output *x; /* xterm.h */
struct w32_output *w32; /* w32term.h */
struct ns_output *ns; /* nsterm.h */
- EMACS_INT nothing;
+ intptr_t nothing;
}
output_data;
@@ -354,9 +357,6 @@ struct frame
unsigned int external_menu_bar : 1;
#endif
- /* Nonzero if last attempt at redisplay on this frame was preempted. */
- unsigned char display_preempted : 1;
-
/* visible is nonzero if the frame is currently displayed; we check
it to see if we should bother updating the frame's contents.
DON'T SET IT DIRECTLY; instead, use FRAME_SET_VISIBLE.
@@ -385,8 +385,8 @@ struct frame
These two are mutually exclusive. They might both be zero, if the
frame has been made invisible without an icon. */
- unsigned char visible : 2;
- unsigned char iconified : 1;
+ unsigned visible : 2;
+ unsigned iconified : 1;
/* Let's not use bitfields for volatile variables. */
@@ -400,43 +400,38 @@ struct frame
/* True if frame actually has a minibuffer window on it.
0 if using a minibuffer window that isn't on this frame. */
- unsigned char has_minibuffer : 1;
+ unsigned has_minibuffer : 1;
/* 0 means, if this frame has just one window,
show no modeline for that window. */
- unsigned char wants_modeline : 1;
-
- /* Non-zero if the hardware device this frame is displaying on can
- support scroll bars. */
- char can_have_scroll_bars;
+ unsigned wants_modeline : 1;
/* Non-0 means raise this frame to the top of the heap when selected. */
- unsigned char auto_raise : 1;
+ unsigned auto_raise : 1;
/* Non-0 means lower this frame to the bottom of the stack when left. */
- unsigned char auto_lower : 1;
+ unsigned auto_lower : 1;
/* True if frame's root window can't be split. */
- unsigned char no_split : 1;
+ unsigned no_split : 1;
/* If this is set, then Emacs won't change the frame name to indicate
the current buffer, etcetera. If the user explicitly sets the frame
name, this gets set. If the user sets the name to Qnil, this is
cleared. */
- unsigned char explicit_name : 1;
+ unsigned explicit_name : 1;
/* Nonzero if size of some window on this frame has changed. */
- unsigned char window_sizes_changed : 1;
+ unsigned window_sizes_changed : 1;
/* Nonzero if the mouse has moved on this display device
since the last time we checked. */
- unsigned char mouse_moved :1;
+ unsigned mouse_moved :1;
/* Nonzero means that the pointer is invisible. */
- unsigned char pointer_invisible :1;
+ unsigned pointer_invisible :1;
- /* If can_have_scroll_bars is non-zero, this is non-zero if we should
- actually display them on this frame. */
+ /* Nonzero if we should actually display the scroll bars on this frame. */
enum vertical_scroll_bar_type vertical_scroll_bar_type;
/* What kind of text cursor should we draw in the future?
@@ -494,6 +489,109 @@ struct frame
unsigned long foreground_pixel;
};
+/* Most code should use these functions to set Lisp fields in struct frame. */
+
+FRAME_INLINE void
+fset_buffer_list (struct frame *f, Lisp_Object val)
+{
+ f->buffer_list = val;
+}
+FRAME_INLINE void
+fset_buried_buffer_list (struct frame *f, Lisp_Object val)
+{
+ f->buried_buffer_list = val;
+}
+FRAME_INLINE void
+fset_condemned_scroll_bars (struct frame *f, Lisp_Object val)
+{
+ f->condemned_scroll_bars = val;
+}
+FRAME_INLINE void
+fset_current_tool_bar_string (struct frame *f, Lisp_Object val)
+{
+ f->current_tool_bar_string = val;
+}
+FRAME_INLINE void
+fset_desired_tool_bar_string (struct frame *f, Lisp_Object val)
+{
+ f->desired_tool_bar_string = val;
+}
+FRAME_INLINE void
+fset_face_alist (struct frame *f, Lisp_Object val)
+{
+ f->face_alist = val;
+}
+FRAME_INLINE void
+fset_focus_frame (struct frame *f, Lisp_Object val)
+{
+ f->focus_frame = val;
+}
+FRAME_INLINE void
+fset_icon_name (struct frame *f, Lisp_Object val)
+{
+ f->icon_name = val;
+}
+FRAME_INLINE void
+fset_menu_bar_items (struct frame *f, Lisp_Object val)
+{
+ f->menu_bar_items = val;
+}
+FRAME_INLINE void
+fset_menu_bar_vector (struct frame *f, Lisp_Object val)
+{
+ f->menu_bar_vector = val;
+}
+FRAME_INLINE void
+fset_menu_bar_window (struct frame *f, Lisp_Object val)
+{
+ f->menu_bar_window = val;
+}
+FRAME_INLINE void
+fset_name (struct frame *f, Lisp_Object val)
+{
+ f->name = val;
+}
+FRAME_INLINE void
+fset_param_alist (struct frame *f, Lisp_Object val)
+{
+ f->param_alist = val;
+}
+FRAME_INLINE void
+fset_root_window (struct frame *f, Lisp_Object val)
+{
+ f->root_window = val;
+}
+FRAME_INLINE void
+fset_scroll_bars (struct frame *f, Lisp_Object val)
+{
+ f->scroll_bars = val;
+}
+FRAME_INLINE void
+fset_selected_window (struct frame *f, Lisp_Object val)
+{
+ f->selected_window = val;
+}
+FRAME_INLINE void
+fset_title (struct frame *f, Lisp_Object val)
+{
+ f->title = val;
+}
+FRAME_INLINE void
+fset_tool_bar_items (struct frame *f, Lisp_Object val)
+{
+ f->tool_bar_items = val;
+}
+FRAME_INLINE void
+fset_tool_bar_position (struct frame *f, Lisp_Object val)
+{
+ f->tool_bar_position = val;
+}
+FRAME_INLINE void
+fset_tool_bar_window (struct frame *f, Lisp_Object val)
+{
+ f->tool_bar_window = val;
+}
+
#define FRAME_KBOARD(f) ((f)->terminal->kboard)
/* Return a pointer to the image cache of frame F. */
@@ -501,21 +599,32 @@ struct frame
typedef struct frame *FRAME_PTR;
-#define XFRAME(p) (eassert (FRAMEP(p)),(struct frame *) XPNTR (p))
+#define XFRAME(p) \
+ (eassert (FRAMEP (p)), (struct frame *) XUNTAG (p, Lisp_Vectorlike))
#define XSETFRAME(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FRAME))
/* Given a window, return its frame as a Lisp_Object. */
-#define WINDOW_FRAME(w) (w)->frame
+#define WINDOW_FRAME(w) w->frame
/* Test a frame for particular kinds of display methods. */
#define FRAME_INITIAL_P(f) ((f)->output_method == output_initial)
#define FRAME_TERMCAP_P(f) ((f)->output_method == output_termcap)
#define FRAME_X_P(f) ((f)->output_method == output_x_window)
+#ifndef HAVE_NTGUI
+#define FRAME_W32_P(f) (0)
+#else
#define FRAME_W32_P(f) ((f)->output_method == output_w32)
+#endif
+#ifndef MSDOS
+#define FRAME_MSDOS_P(f) (0)
+#else
#define FRAME_MSDOS_P(f) ((f)->output_method == output_msdos_raw)
-#define FRAME_MAC_P(f) ((f)->output_method == output_mac)
+#endif
+#ifndef HAVE_NS
+#define FRAME_NS_P(f) (0)
+#else
#define FRAME_NS_P(f) ((f)->output_method == output_ns)
-
+#endif
/* FRAME_WINDOW_P tests whether the frame is a window, and is
defined to be the predicate for the window system being used. */
@@ -529,7 +638,7 @@ typedef struct frame *FRAME_PTR;
#define FRAME_WINDOW_P(f) FRAME_NS_P(f)
#endif
#ifndef FRAME_WINDOW_P
-#define FRAME_WINDOW_P(f) (0)
+#define FRAME_WINDOW_P(f) ((void) (f), 0)
#endif
/* Return a pointer to the structure holding information about the
@@ -634,13 +743,13 @@ typedef struct frame *FRAME_PTR;
#define FRAME_WINDOW_SIZES_CHANGED(f) (f)->window_sizes_changed
/* The minibuffer window of frame F, if it has one; otherwise nil. */
-#define FRAME_MINIBUF_WINDOW(f) (f)->minibuffer_window
+#define FRAME_MINIBUF_WINDOW(f) f->minibuffer_window
/* The root window of the window tree of frame F. */
-#define FRAME_ROOT_WINDOW(f) (f)->root_window
+#define FRAME_ROOT_WINDOW(f) f->root_window
/* The currently selected window of the window tree of frame F. */
-#define FRAME_SELECTED_WINDOW(f) (f)->selected_window
+#define FRAME_SELECTED_WINDOW(f) f->selected_window
#define FRAME_INSERT_COST(f) (f)->insert_line_cost
#define FRAME_DELETE_COST(f) (f)->delete_line_cost
@@ -648,12 +757,7 @@ typedef struct frame *FRAME_PTR;
#define FRAME_DELETEN_COST(f) (f)->delete_n_lines_cost
#define FRAME_MESSAGE_BUF(f) (f)->message_buf
#define FRAME_SCROLL_BOTTOM_VPOS(f) (f)->scroll_bottom_vpos
-#define FRAME_FOCUS_FRAME(f) (f)->focus_frame
-
-/* Nonzero if frame F supports scroll bars.
- If this is zero, then it is impossible to enable scroll bars
- on frame F. */
-#define FRAME_CAN_HAVE_SCROLL_BARS(f) ((f)->can_have_scroll_bars)
+#define FRAME_FOCUS_FRAME(f) f->focus_frame
/* This frame slot says whether scroll bars are currently enabled for frame F,
and which side they are on. */
@@ -749,10 +853,10 @@ typedef struct frame *FRAME_PTR;
/* Nonzero if frame F has scroll bars. */
-#define FRAME_SCROLL_BARS(f) ((f)->scroll_bars)
+#define FRAME_SCROLL_BARS(f) (f->scroll_bars)
-#define FRAME_CONDEMNED_SCROLL_BARS(f) ((f)->condemned_scroll_bars)
-#define FRAME_MENU_BAR_ITEMS(f) ((f)->menu_bar_items)
+#define FRAME_CONDEMNED_SCROLL_BARS(f) (f->condemned_scroll_bars)
+#define FRAME_MENU_BAR_ITEMS(f) (f->menu_bar_items)
#define FRAME_COST_BAUD_RATE(f) ((f)->cost_calculation_baud_rate)
#define FRAME_DESIRED_CURSOR(f) ((f)->desired_cursor)
@@ -820,12 +924,27 @@ typedef struct frame *FRAME_PTR;
supported. An alternate definition of the macro would expand to
something which executes the statement once. */
-#define FOR_EACH_FRAME(list_var, frame_var) \
- for ((list_var) = Vframe_list; \
- (CONSP (list_var) \
- && (frame_var = XCAR (list_var), 1)); \
+#define FOR_EACH_FRAME(list_var, frame_var) \
+ for ((list_var) = Vframe_list; \
+ (CONSP (list_var) \
+ && (frame_var = XCAR (list_var), 1)); \
list_var = XCDR (list_var))
+/* Reflect mouse movement when a complete frame update is performed. */
+
+#define FRAME_MOUSE_UPDATE(frame) \
+ do { \
+ Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (frame); \
+ if (frame == hlinfo->mouse_face_mouse_frame) \
+ { \
+ block_input (); \
+ if (hlinfo->mouse_face_mouse_frame) \
+ note_mouse_highlight (hlinfo->mouse_face_mouse_frame, \
+ hlinfo->mouse_face_mouse_x, \
+ hlinfo->mouse_face_mouse_y); \
+ unblock_input (); \
+ } \
+ } while (0)
extern Lisp_Object Qframep, Qframe_live_p;
extern Lisp_Object Qtty, Qtty_type;
@@ -836,6 +955,8 @@ extern Lisp_Object Qnoelisp;
extern struct frame *last_nonminibuf_frame;
extern void set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
+extern struct frame *decode_live_frame (Lisp_Object);
+extern struct frame *decode_any_frame (Lisp_Object);
extern struct frame *make_initial_frame (void);
extern struct frame *make_frame (int);
#ifdef HAVE_WINDOW_SYSTEM
@@ -861,7 +982,7 @@ extern Lisp_Object selected_frame;
((FRAMEP (selected_frame) \
&& FRAME_LIVE_P (XFRAME (selected_frame))) \
? XFRAME (selected_frame) \
- : (abort (), (struct frame *) 0))
+ : (emacs_abort (), (struct frame *) 0))
/***********************************************************************
@@ -1086,13 +1207,14 @@ extern Lisp_Object Qrun_hook_with_args;
extern void x_set_scroll_bar_default_width (struct frame *);
extern void x_set_offset (struct frame *, int, int, int);
extern void x_wm_set_icon_position (struct frame *, int, int);
+extern void x_wm_set_size_hint (FRAME_PTR f, long flags, bool user_position);
extern Lisp_Object x_new_font (struct frame *, Lisp_Object, int);
extern Lisp_Object Qface_set_after_frame_default;
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
extern void x_fullscreen_adjust (struct frame *f, int *, int *,
int *, int *);
#endif
@@ -1131,13 +1253,43 @@ extern Lisp_Object display_x_get_resource (Display_Info *,
Lisp_Object component,
Lisp_Object subclass);
+extern void set_frame_menubar (struct frame *f, bool first_time, bool deep_p);
+extern void x_set_window_size (struct frame *f, int change_grav,
+ int cols, int rows);
+extern void x_sync (struct frame *);
+extern Lisp_Object x_get_focus_frame (struct frame *);
+extern void x_set_mouse_position (struct frame *f, int h, int v);
+extern void x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y);
+extern void x_make_frame_visible (struct frame *f);
+extern void x_make_frame_invisible (struct frame *f);
+extern void x_iconify_frame (struct frame *f);
+extern int x_char_width (struct frame *f);
+extern int x_char_height (struct frame *f);
+extern int x_pixel_width (struct frame *f);
+extern int x_pixel_height (struct frame *f);
+extern void x_set_frame_alpha (struct frame *f);
+extern void x_set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
+extern void x_set_tool_bar_lines (struct frame *f,
+ Lisp_Object value,
+ Lisp_Object oldval);
+extern void x_activate_menubar (struct frame *);
+extern void x_real_positions (struct frame *, int *, int *);
+extern int x_bitmap_icon (struct frame *, Lisp_Object);
+extern void x_set_menu_bar_lines (struct frame *,
+ Lisp_Object,
+ Lisp_Object);
+extern void free_frame_menubar (struct frame *);
+extern void x_free_frame_resources (struct frame *);
+
#if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
extern char *x_get_resource_string (const char *, const char *);
#endif
-/* In xmenu.c */
-extern void set_frame_menubar (FRAME_PTR, int, int);
+extern void x_query_colors (struct frame *f, XColor *, int);
+extern void x_query_color (struct frame *f, XColor *);
#endif /* HAVE_WINDOW_SYSTEM */
+INLINE_HEADER_END
+
#endif /* not EMACS_FRAME_H */
diff --git a/src/fringe.c b/src/fringe.c
index da896e07b76..a126292e1ff 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -1,5 +1,5 @@
/* Fringe handling (split from xdisp.c).
- Copyright (C) 1985-1988, 1993-1995, 1997-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1988, 1993-1995, 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -18,12 +18,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "frame.h"
#include "window.h"
#include "dispextern.h"
+#include "character.h"
#include "buffer.h"
#include "blockinput.h"
#include "termhooks.h"
@@ -106,6 +106,22 @@ struct fringe_bitmap
static unsigned short question_mark_bits[] = {
0x3c, 0x7e, 0x7e, 0x0c, 0x18, 0x18, 0x00, 0x18, 0x18};
+/* An exclamation mark. */
+/*
+ ...XX...
+ ...XX...
+ ...XX...
+ ...XX...
+ ...XX...
+ ...XX...
+ ...XX...
+ ........
+ ...XX...
+ ...XX...
+*/
+static unsigned short exclamation_mark_bits[] = {
+ 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x00, 0x18};
+
/* An arrow like this: `<-'. */
/*
...xx...
@@ -431,6 +447,7 @@ static struct fringe_bitmap standard_bitmaps[] =
{
{ NULL, 0, 0, 0, 0, 0 }, /* NO_FRINGE_BITMAP */
{ FRBITS (question_mark_bits), 8, 0, ALIGN_BITMAP_CENTER, 0 },
+ { FRBITS (exclamation_mark_bits), 8, 0, ALIGN_BITMAP_CENTER, 0 },
{ FRBITS (left_arrow_bits), 8, 0, ALIGN_BITMAP_CENTER, 0 },
{ FRBITS (right_arrow_bits), 8, 0, ALIGN_BITMAP_CENTER, 0 },
{ FRBITS (up_arrow_bits), 8, 0, ALIGN_BITMAP_TOP, 0 },
@@ -474,7 +491,7 @@ int max_used_fringe_bitmap = MAX_STANDARD_FRINGE_BITMAPS;
int
lookup_fringe_bitmap (Lisp_Object bitmap)
{
- int bn;
+ EMACS_INT bn;
bitmap = Fget (bitmap, Qfringe);
if (!INTEGERP (bitmap))
@@ -641,7 +658,14 @@ draw_fringe_bitmap_1 (struct window *w, struct glyph_row *row, int left_p, int o
{
/* If W has a vertical border to its left, don't draw over it. */
wd -= ((!WINDOW_LEFTMOST_P (w)
- && !WINDOW_HAS_VERTICAL_SCROLL_BAR (w))
+ && !WINDOW_HAS_VERTICAL_SCROLL_BAR (w)
+ /* But don't reduce the fringe width if the window
+ has a left margin, because that means we are not
+ in danger of drawing over the vertical border,
+ and OTOH leaving out that one pixel leaves behind
+ traces of the cursor, if it was in column zero
+ before drawing non-empty margin area. */
+ && NILP (w->left_margin_cols))
? 1 : 0);
p.bx = x - wd;
p.nx = wd;
@@ -696,7 +720,7 @@ static int
get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, int partial_p)
{
Lisp_Object cmap, bm1 = Qnil, bm2 = Qnil, bm;
- int ln1 = 0, ln2 = 0;
+ EMACS_INT ln1 = 0, ln2 = 0;
int ix1 = right_p;
int ix2 = ix1 + (partial_p ? 2 : 0);
@@ -848,7 +872,7 @@ draw_fringe_bitmap (struct window *w, struct glyph_row *row, int left_p)
void
draw_row_fringe_bitmaps (struct window *w, struct glyph_row *row)
{
- xassert (interrupt_input_blocked);
+ eassert (input_blocked_p ());
/* If row is completely invisible, because of vscrolling, we
don't have to draw anything. */
@@ -1555,7 +1579,7 @@ If BITMAP already exists, the existing definition is replaced. */)
else
{
CHECK_NUMBER (height);
- fb.height = min (XINT (height), 255);
+ fb.height = max (0, min (XINT (height), 255));
if (fb.height > h)
{
fill1 = (fb.height - h) / 2;
@@ -1568,7 +1592,7 @@ If BITMAP already exists, the existing definition is replaced. */)
else
{
CHECK_NUMBER (width);
- fb.width = min (XINT (width), 255);
+ fb.width = max (0, min (XINT (width), 255));
}
fb.period = 0;
@@ -1615,12 +1639,10 @@ If BITMAP already exists, the existing definition is replaced. */)
error ("No free fringe bitmap slots");
i = max_fringe_bitmaps;
- fringe_bitmaps
- = ((struct fringe_bitmap **)
- xrealloc (fringe_bitmaps, bitmaps * sizeof *fringe_bitmaps));
- fringe_faces
- = (Lisp_Object *) xrealloc (fringe_faces,
- bitmaps * sizeof *fringe_faces);
+ fringe_bitmaps = xrealloc (fringe_bitmaps,
+ bitmaps * sizeof *fringe_bitmaps);
+ fringe_faces = xrealloc (fringe_faces,
+ bitmaps * sizeof *fringe_faces);
for (i = max_fringe_bitmaps; i < bitmaps; i++)
{
@@ -1638,8 +1660,7 @@ If BITMAP already exists, the existing definition is replaced. */)
fb.dynamic = 1;
- xfb = (struct fringe_bitmap *) xmalloc (sizeof fb
- + fb.height * BYTES_PER_BITMAP_ROW);
+ xfb = xmalloc (sizeof fb + fb.height * BYTES_PER_BITMAP_ROW);
fb.bits = b = (unsigned short *) (xfb + 1);
memset (b, 0, fb.height);
@@ -1671,23 +1692,27 @@ If FACE is nil, reset face to default fringe face. */)
(Lisp_Object bitmap, Lisp_Object face)
{
int n;
- int face_id;
CHECK_SYMBOL (bitmap);
n = lookup_fringe_bitmap (bitmap);
if (!n)
error ("Undefined fringe bitmap");
+ /* The purpose of the following code is to signal an error if FACE
+ is not a face. This is for the caller's convenience only; the
+ redisplay code should be able to fail gracefully. Skip the check
+ if FRINGE_FACE_ID is unrealized (as in batch mode and during
+ daemon startup). */
if (!NILP (face))
{
- face_id = lookup_derived_face (SELECTED_FRAME (), face,
- FRINGE_FACE_ID, 1);
- if (face_id < 0)
+ struct frame *f = SELECTED_FRAME ();
+
+ if (FACE_FROM_ID (f, FRINGE_FACE_ID)
+ && lookup_derived_face (f, face, FRINGE_FACE_ID, 1) < 0)
error ("No such face");
}
fringe_faces[n] = face;
-
return Qnil;
}
@@ -1704,16 +1729,16 @@ Return nil if POS is not visible in WINDOW. */)
{
struct window *w;
struct glyph_row *row;
- int textpos;
+ ptrdiff_t textpos;
- if (NILP (window))
- window = selected_window;
- CHECK_WINDOW (window);
- w = XWINDOW (window);
+ w = decode_any_window (window);
+ XSETWINDOW (window, w);
if (!NILP (pos))
{
CHECK_NUMBER_COERCE_MARKER (pos);
+ if (! (BEGV <= XINT (pos) && XINT (pos) <= ZV))
+ args_out_of_range (window, pos);
textpos = XINT (pos);
}
else if (w == XWINDOW (selected_window))
@@ -1754,7 +1779,7 @@ syms_of_fringe (void)
defsubr (&Sset_fringe_bitmap_face);
DEFVAR_LISP ("overflow-newline-into-fringe", Voverflow_newline_into_fringe,
- doc: /* *Non-nil means that newline may flow into the right fringe.
+ doc: /* Non-nil means that newline may flow into the right fringe.
This means that display lines which are exactly as wide as the window
(not counting the final newline) will only occupy one screen line, by
showing (or hiding) the final newline in the right fringe; when point
@@ -1797,16 +1822,11 @@ init_fringe (void)
max_fringe_bitmaps = MAX_STANDARD_FRINGE_BITMAPS + 20;
- fringe_bitmaps
- = (struct fringe_bitmap **) xmalloc (max_fringe_bitmaps * sizeof (struct fringe_bitmap *));
- fringe_faces
- = (Lisp_Object *) xmalloc (max_fringe_bitmaps * sizeof (Lisp_Object));
+ fringe_bitmaps = xzalloc (max_fringe_bitmaps * sizeof *fringe_bitmaps);
+ fringe_faces = xmalloc (max_fringe_bitmaps * sizeof *fringe_faces);
for (i = 0; i < max_fringe_bitmaps; i++)
- {
- fringe_bitmaps[i] = NULL;
- fringe_faces[i] = Qnil;
- }
+ fringe_faces[i] = Qnil;
}
#ifdef HAVE_NTGUI
diff --git a/src/ftfont.c b/src/ftfont.c
index dbb2ce2745e..f07ad6f33c7 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -1,5 +1,5 @@
/* ftfont.c -- FreeType font driver.
- Copyright (C) 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 2006-2012 Free Software Foundation, Inc.
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
@@ -21,8 +21,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
-
#include <fontconfig/fontconfig.h>
#include <fontconfig/fcfreetype.h>
@@ -45,7 +43,7 @@ static Lisp_Object Qfreetype;
static Lisp_Object Qmonospace, Qsans_serif, Qserif, Qmono, Qsans, Qsans__serif;
/* Flag to tell if FcInit is already called or not. */
-static int fc_initialized;
+static bool fc_initialized;
/* Handle to a FreeType library instance. */
static FT_Library ft_library;
@@ -65,7 +63,7 @@ struct ftfont_info
#ifdef HAVE_LIBOTF
/* The following four members must be here in this order to be
compatible with struct xftfont_info (in xftfont.c). */
- int maybe_otf; /* Flag to tell if this may be OTF or not. */
+ bool maybe_otf; /* Flag to tell if this may be OTF or not. */
OTF *otf;
#endif /* HAVE_LIBOTF */
FT_Size ft_size;
@@ -211,7 +209,7 @@ ftfont_pattern_entity (FcPattern *p, Lisp_Object extra)
return Qnil;
file = (char *) str;
- key = Fcons (make_unibyte_string (file, strlen (file)), make_number (idx));
+ key = Fcons (build_unibyte_string (file), make_number (idx));
cache = ftfont_lookup_cache (key, FTFONT_CACHE_FOR_ENTITY);
entity = XCAR (cache);
if (! NILP (entity))
@@ -372,7 +370,7 @@ ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for)
{
entity = key;
val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX));
- xassert (CONSP (val));
+ eassert (CONSP (val));
key = XCDR (val);
}
else
@@ -392,7 +390,7 @@ ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for)
args[1] = Qequal;
ft_face_cache = Fmake_hash_table (2, args);
}
- cache_data = xmalloc (sizeof (struct ftfont_cache_data));
+ cache_data = xmalloc (sizeof *cache_data);
cache_data->ft_face = NULL;
cache_data->fc_charset = NULL;
val = make_save_value (NULL, 0);
@@ -525,7 +523,7 @@ static int ftfont_variation_glyphs (struct font *, int c,
struct font_driver ftfont_driver =
{
- 0, /* Qfreetype */
+ LISP_INITIALLY_ZERO, /* Qfreetype */
0, /* case insensitive */
ftfont_get_cache,
ftfont_list,
@@ -543,9 +541,9 @@ struct font_driver ftfont_driver =
/* We can't draw a text without device dependent functions. */
NULL, /* draw */
ftfont_get_bitmap,
- NULL, /* get_bitmap */
NULL, /* free_bitmap */
NULL, /* get_outline */
+ NULL, /* free_outline */
ftfont_anchor_point,
#ifdef HAVE_LIBOTF
ftfont_otf_capability,
@@ -598,7 +596,9 @@ ftfont_get_charset (Lisp_Object registry)
re[j] = '\0';
regexp = make_unibyte_string (re, j);
for (i = 0; fc_charset_table[i].name; i++)
- if (fast_c_string_match_ignore_case (regexp, fc_charset_table[i].name) >= 0)
+ if (fast_c_string_match_ignore_case
+ (regexp, fc_charset_table[i].name,
+ strlen (fc_charset_table[i].name)) >= 0)
break;
if (! fc_charset_table[i].name)
return -1;
@@ -657,9 +657,10 @@ struct OpenTypeSpec
static struct OpenTypeSpec *
ftfont_get_open_type_spec (Lisp_Object otf_spec)
{
- struct OpenTypeSpec *spec = malloc (sizeof (struct OpenTypeSpec));
+ struct OpenTypeSpec *spec = malloc (sizeof *spec);
Lisp_Object val;
- int i, j, negative;
+ int i, j;
+ bool negative;
if (! spec)
return NULL;
@@ -696,7 +697,7 @@ ftfont_get_open_type_spec (Lisp_Object otf_spec)
spec->features[i] =
(min (PTRDIFF_MAX, SIZE_MAX) / sizeof (int) < XINT (len)
? 0
- : malloc (sizeof (int) * XINT (len)));
+ : malloc (XINT (len) * sizeof *spec->features[i]));
if (! spec->features[i])
{
if (i > 0 && spec->features[0])
@@ -1033,13 +1034,13 @@ ftfont_list (Lisp_Object frame, Lisp_Object spec)
#endif /* HAVE_LIBOTF */
if (VECTORP (chars))
{
- int j;
+ ptrdiff_t j;
if (FcPatternGetCharSet (fontset->fonts[i], FC_CHARSET, 0, &charset)
!= FcResultMatch)
continue;
for (j = 0; j < ASIZE (chars); j++)
- if (NATNUMP (AREF (chars, j))
+ if (TYPE_RANGED_INTEGERP (FcChar32, AREF (chars, j))
&& FcCharSetHasChar (charset, XFASTINT (AREF (chars, j))))
break;
if (j == ASIZE (chars))
@@ -1183,7 +1184,7 @@ ftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
FT_Size ft_size;
FT_UInt size;
Lisp_Object val, filename, idx, cache, font_object;
- int scalable;
+ bool scalable;
int spacing;
char name[256];
int i, len;
@@ -1241,7 +1242,7 @@ ftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
ftfont_info->ft_size = ft_face->size;
ftfont_info->index = XINT (idx);
#ifdef HAVE_LIBOTF
- ftfont_info->maybe_otf = ft_face->face_flags & FT_FACE_FLAG_SFNT;
+ ftfont_info->maybe_otf = (ft_face->face_flags & FT_FACE_FLAG_SFNT) != 0;
ftfont_info->otf = NULL;
#endif /* HAVE_LIBOTF */
/* This means that there's no need of transformation. */
@@ -1325,7 +1326,7 @@ ftfont_close (FRAME_PTR f, struct font *font)
val = Fcons (font->props[FONT_FILE_INDEX], make_number (ftfont_info->index));
cache = ftfont_lookup_cache (val, FTFONT_CACHE_FOR_FACE);
- xassert (CONSP (cache));
+ eassert (CONSP (cache));
val = XCDR (cache);
(XSAVE_VALUE (val)->integer)--;
if (XSAVE_VALUE (val)->integer == 0)
@@ -1390,7 +1391,8 @@ ftfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct
struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
FT_Face ft_face = ftfont_info->ft_size->face;
int width = 0;
- int i, first;
+ int i;
+ bool first;
if (ftfont_info->ft_size != ft_face->size)
FT_Activate_Size (ftfont_info->ft_size);
@@ -1628,7 +1630,7 @@ ftfont_get_metrics (MFLTFont *font, MFLTGlyphString *gstring,
FT_Glyph_Metrics *m;
if (FT_Load_Glyph (ft_face, g->code, FT_LOAD_DEFAULT) != 0)
- abort ();
+ emacs_abort ();
m = &ft_face->glyph->metrics;
if (flt_font_ft->matrix)
{
@@ -1680,10 +1682,12 @@ ftfont_check_otf (MFLTFont *font, MFLTOtfSpec *spec)
struct MFLTFontFT *flt_font_ft = (struct MFLTFontFT *) font;
OTF *otf = flt_font_ft->otf;
OTF_Tag *tags;
- int i, n, negative;
+ int i, n;
+ bool negative;
if (FEATURE_ANY (0) && FEATURE_ANY (1))
- /* Return 1 iff any of GSUB or GPOS support the script (and language). */
+ /* Return true iff any of GSUB or GPOS support the script (and
+ language). */
return (otf
&& (OTF_check_features (otf, 0, spec->script, spec->langsys,
NULL, 0) > 0
@@ -1856,7 +1860,7 @@ ftfont_drive_otf (MFLTFont *font,
setup_otf_gstring (len);
for (i = 0; i < len; i++)
{
- otf_gstring.glyphs[i].c = in->glyphs[from + i].c;
+ otf_gstring.glyphs[i].c = in->glyphs[from + i].c & 0x11FFFF;
otf_gstring.glyphs[i].glyph_id = in->glyphs[from + i].code;
}
@@ -2388,17 +2392,17 @@ ftfont_drive_otf (MFLTFont *font, MFLTOtfSpec *spec, MFLTGlyphString *in,
static MFLTGlyphString gstring;
-static int m17n_flt_initialized;
+static bool m17n_flt_initialized;
static Lisp_Object
ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
FT_Face ft_face, OTF *otf, FT_Matrix *matrix)
{
- EMACS_INT len = LGSTRING_GLYPH_LEN (lgstring);
- EMACS_INT i;
+ ptrdiff_t len = LGSTRING_GLYPH_LEN (lgstring);
+ ptrdiff_t i;
struct MFLTFontFT flt_font_ft;
MFLT *flt = NULL;
- int with_variation_selector = 0;
+ bool with_variation_selector = 0;
if (! m17n_flt_initialized)
{
@@ -2419,11 +2423,11 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
break;
c = LGLYPH_CHAR (g);
if (CHAR_VARIATION_SELECTOR_P (c))
- with_variation_selector++;
+ with_variation_selector = 1;
}
len = i;
- lint_assume (len <= TYPE_MAXIMUM (EMACS_INT) - 2);
+ lint_assume (len <= STRING_BYTES_BOUND);
if (with_variation_selector)
{
@@ -2460,15 +2464,16 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
if (gstring.allocated == 0)
{
gstring.glyph_size = sizeof (MFLTGlyph);
- gstring.glyphs = xnmalloc (len * 2, sizeof (MFLTGlyph));
+ gstring.glyphs = xnmalloc (len * 2, sizeof *gstring.glyphs);
gstring.allocated = len * 2;
}
else if (gstring.allocated < len * 2)
{
- gstring.glyphs = xnrealloc (gstring.glyphs, len * 2, sizeof (MFLTGlyph));
+ gstring.glyphs = xnrealloc (gstring.glyphs, len * 2,
+ sizeof *gstring.glyphs);
gstring.allocated = len * 2;
}
- memset (gstring.glyphs, 0, sizeof (MFLTGlyph) * len);
+ memset (gstring.glyphs, 0, len * sizeof *gstring.glyphs);
for (i = 0; i < len; i++)
{
Lisp_Object g = LGSTRING_GLYPH (lgstring, i);
diff --git a/src/ftxfont.c b/src/ftxfont.c
index e04e802a3db..5effe6e9104 100644
--- a/src/ftxfont.c
+++ b/src/ftxfont.c
@@ -1,5 +1,5 @@
/* ftxfont.c -- FreeType font driver on X (without using XFT).
- Copyright (C) 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 2006-2012 Free Software Foundation, Inc.
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
@@ -21,7 +21,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include <X11/Xlib.h>
#include "lisp.h"
@@ -43,14 +42,6 @@ static
#endif
struct font_driver ftxfont_driver;
-/* Prototypes for helper function. */
-static GC *ftxfont_get_gcs (FRAME_PTR, unsigned long, unsigned long);
-static int ftxfont_draw_bitmap (FRAME_PTR, GC, GC *, struct font *,
- unsigned, int, int, XPoint *, int, int *,
- int);
-static void ftxfont_draw_background (FRAME_PTR, struct font *, GC,
- int, int, int);
-
struct ftxfont_frame_data
{
/* Background and foreground colors. */
@@ -90,7 +81,7 @@ ftxfont_get_gcs (FRAME_PTR f, long unsigned int foreground, long unsigned int ba
}
}
- new = malloc (sizeof (struct ftxfont_frame_data));
+ new = malloc (sizeof *new);
if (! new)
return NULL;
new->next = this;
@@ -107,7 +98,7 @@ ftxfont_get_gcs (FRAME_PTR f, long unsigned int foreground, long unsigned int ba
new->colors[0].pixel = background;
new->colors[1].pixel = foreground;
- BLOCK_INPUT;
+ block_input ();
XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), new->colors, 2);
for (i = 1; i < 7; i++)
{
@@ -124,14 +115,14 @@ ftxfont_get_gcs (FRAME_PTR f, long unsigned int foreground, long unsigned int ba
new->gcs[i - 1] = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
GCForeground, &xgcv);
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (i < 7)
{
- BLOCK_INPUT;
+ block_input ();
for (i--; i >= 0; i--)
XFreeGC (FRAME_X_DISPLAY (f), new->gcs[i]);
- UNBLOCK_INPUT;
+ unblock_input ();
if (prev)
prev->next = new->next;
else if (data)
@@ -143,7 +134,9 @@ ftxfont_get_gcs (FRAME_PTR f, long unsigned int foreground, long unsigned int ba
}
static int
-ftxfont_draw_bitmap (FRAME_PTR f, GC gc_fore, GC *gcs, struct font *font, unsigned int code, int x, int y, XPoint *p, int size, int *n, int flush)
+ftxfont_draw_bitmap (FRAME_PTR f, GC gc_fore, GC *gcs, struct font *font,
+ unsigned int code, int x, int y, XPoint *p, int size,
+ int *n, bool flush)
{
struct font_bitmap bitmap;
unsigned char *b;
@@ -232,13 +225,6 @@ ftxfont_draw_background (FRAME_PTR f, struct font *font, GC gc, int x, int y,
XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.foreground);
}
-/* Prototypes for font-driver methods. */
-static Lisp_Object ftxfont_list (Lisp_Object, Lisp_Object);
-static Lisp_Object ftxfont_match (Lisp_Object, Lisp_Object);
-static Lisp_Object ftxfont_open (FRAME_PTR, Lisp_Object, int);
-static void ftxfont_close (FRAME_PTR, struct font *);
-static int ftxfont_draw (struct glyph_string *, int, int, int, int, int);
-
static Lisp_Object
ftxfont_list (Lisp_Object frame, Lisp_Object spec)
{
@@ -280,7 +266,8 @@ ftxfont_close (FRAME_PTR f, struct font *font)
}
static int
-ftxfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_background)
+ftxfont_draw (struct glyph_string *s, int from, int to, int x, int y,
+ bool with_background)
{
FRAME_PTR f = s->f;
struct face *face = s->face;
@@ -295,7 +282,7 @@ ftxfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_b
n[0] = n[1] = n[2] = n[3] = n[4] = n[5] = n[6] = 0;
- BLOCK_INPUT;
+ block_input ();
if (with_background)
ftxfont_draw_background (f, font, s->gc, x, y, s->width);
code = alloca (sizeof (unsigned) * len);
@@ -345,7 +332,7 @@ ftxfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_b
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return len;
}
@@ -355,7 +342,7 @@ ftxfont_end_for_frame (FRAME_PTR f)
{
struct ftxfont_frame_data *data = font_get_frame_data (f, &ftxfont_driver);
- BLOCK_INPUT;
+ block_input ();
while (data)
{
struct ftxfont_frame_data *next = data->next;
@@ -366,7 +353,7 @@ ftxfont_end_for_frame (FRAME_PTR f)
free (data);
data = next;
}
- UNBLOCK_INPUT;
+ unblock_input ();
font_put_frame_data (f, &ftxfont_driver, NULL);
return 0;
}
diff --git a/src/getpagesize.h b/src/getpagesize.h
index c0c4e504f0a..545082b2e78 100644
--- a/src/getpagesize.h
+++ b/src/getpagesize.h
@@ -1,5 +1,5 @@
/* Emulate getpagesize on systems that lack it.
- Copyright (C) 1986, 1992, 1995, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1986, 1992, 1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/gmalloc.c b/src/gmalloc.c
index 7b5e6df009b..dc584955661 100644
--- a/src/gmalloc.c
+++ b/src/gmalloc.c
@@ -1,9 +1,3 @@
-/* This file is no longer automatically generated from libc. */
-
-#define _MALLOC_INTERNAL
-
-/* The malloc headers and source files from the C library follow here. */
-
/* Declarations for `malloc' and friends.
Copyright (C) 1990, 1991, 1992, 1993, 1995, 1996, 1999, 2002, 2003, 2004,
2005, 2006, 2007 Free Software Foundation, Inc.
@@ -27,35 +21,24 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_H
-
-#define _MALLOC_H 1
-
-#ifdef _MALLOC_INTERNAL
-
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#ifdef HAVE_PTHREAD
#define USE_PTHREAD
#endif
-#undef PP
-#define PP(args) args
-#undef __ptr_t
-#define __ptr_t void *
-
#include <string.h>
#include <limits.h>
+#include <stdint.h>
#include <unistd.h>
#ifdef USE_PTHREAD
#include <pthread.h>
#endif
-#endif /* _MALLOC_INTERNAL. */
-
+#ifdef WINDOWSNT
+#include <w32heap.h> /* for sbrk */
+#endif
#ifdef __cplusplus
extern "C"
@@ -63,40 +46,29 @@ extern "C"
#endif
#include <stddef.h>
-#define __malloc_size_t size_t
-#define __malloc_ptrdiff_t ptrdiff_t
/* Allocate SIZE bytes of memory. */
-extern __ptr_t malloc PP ((__malloc_size_t __size));
+extern void *malloc (size_t size);
/* Re-allocate the previously allocated block
- in __ptr_t, making the new block SIZE bytes long. */
-extern __ptr_t realloc PP ((__ptr_t __ptr, __malloc_size_t __size));
+ in ptr, making the new block SIZE bytes long. */
+extern void *realloc (void *ptr, size_t size);
/* Allocate NMEMB elements of SIZE bytes each, all initialized to 0. */
-extern __ptr_t calloc PP ((__malloc_size_t __nmemb, __malloc_size_t __size));
+extern void *calloc (size_t nmemb, size_t size);
/* Free a block allocated by `malloc', `realloc' or `calloc'. */
-extern void free PP ((__ptr_t __ptr));
+extern void free (void *ptr);
/* Allocate SIZE bytes allocated to ALIGNMENT bytes. */
-#if !defined (_MALLOC_INTERNAL) || defined (MSDOS) /* Avoid conflict. */
-extern __ptr_t memalign PP ((__malloc_size_t __alignment,
- __malloc_size_t __size));
-extern int posix_memalign PP ((__ptr_t *, __malloc_size_t,
- __malloc_size_t size));
-#endif
-
-/* Allocate SIZE bytes on a page boundary. */
-#if ! (defined (_MALLOC_INTERNAL) && defined (GMALLOC_INHIBIT_VALLOC))
-extern __ptr_t valloc PP ((__malloc_size_t __size));
+#ifdef MSDOS
+extern void *memalign (size_t, size_t);
+extern int posix_memalign (void **, size_t, size_t);
#endif
#ifdef USE_PTHREAD
/* Set up mutexes and make malloc etc. thread-safe. */
-extern void malloc_enable_thread PP ((void));
+extern void malloc_enable_thread (void);
#endif
-#ifdef _MALLOC_INTERNAL
-
/* The allocator divides the heap into blocks of fixed size; large
requests receive one or more whole blocks, and small requests
receive a fragment of a block. Fragment sizes are powers of two,
@@ -128,22 +100,22 @@ typedef union
{
struct
{
- __malloc_size_t nfree; /* Free frags in a fragmented block. */
- __malloc_size_t first; /* First free fragment of the block. */
+ size_t nfree; /* Free frags in a fragmented block. */
+ size_t first; /* First free fragment of the block. */
} frag;
/* For a large object, in its first block, this has the number
of blocks in the object. In the other blocks, this has a
negative number which says how far back the first block is. */
- __malloc_ptrdiff_t size;
+ ptrdiff_t size;
} info;
} busy;
/* Heap information for a free block
(that may be the first of a free cluster). */
struct
{
- __malloc_size_t size; /* Size (in blocks) of a free cluster. */
- __malloc_size_t next; /* Index of next free cluster. */
- __malloc_size_t prev; /* Index of previous free cluster. */
+ size_t size; /* Size (in blocks) of a free cluster. */
+ size_t next; /* Index of next free cluster. */
+ size_t prev; /* Index of previous free cluster. */
} free;
} malloc_info;
@@ -155,13 +127,13 @@ extern malloc_info *_heapinfo;
/* Address to block number and vice versa. */
#define BLOCK(A) (((char *) (A) - _heapbase) / BLOCKSIZE + 1)
-#define ADDRESS(B) ((__ptr_t) (((B) - 1) * BLOCKSIZE + _heapbase))
+#define ADDRESS(B) ((void *) (((B) - 1) * BLOCKSIZE + _heapbase))
/* Current search index for the heap table. */
-extern __malloc_size_t _heapindex;
+extern size_t _heapindex;
/* Limit of valid info table indices. */
-extern __malloc_size_t _heaplimit;
+extern size_t _heaplimit;
/* Doubly linked lists of free fragments. */
struct list
@@ -177,26 +149,26 @@ extern struct list _fraghead[];
struct alignlist
{
struct alignlist *next;
- __ptr_t aligned; /* The address that memaligned returned. */
- __ptr_t exact; /* The address that malloc returned. */
+ void *aligned; /* The address that memaligned returned. */
+ void *exact; /* The address that malloc returned. */
};
extern struct alignlist *_aligned_blocks;
/* Instrumentation. */
-extern __malloc_size_t _chunks_used;
-extern __malloc_size_t _bytes_used;
-extern __malloc_size_t _chunks_free;
-extern __malloc_size_t _bytes_free;
+extern size_t _chunks_used;
+extern size_t _bytes_used;
+extern size_t _chunks_free;
+extern size_t _bytes_free;
/* Internal versions of `malloc', `realloc', and `free'
used when these functions need to call each other.
They are the same but don't call the hooks. */
-extern __ptr_t _malloc_internal PP ((__malloc_size_t __size));
-extern __ptr_t _realloc_internal PP ((__ptr_t __ptr, __malloc_size_t __size));
-extern void _free_internal PP ((__ptr_t __ptr));
-extern __ptr_t _malloc_internal_nolock PP ((__malloc_size_t __size));
-extern __ptr_t _realloc_internal_nolock PP ((__ptr_t __ptr, __malloc_size_t __size));
-extern void _free_internal_nolock PP ((__ptr_t __ptr));
+extern void *_malloc_internal (size_t);
+extern void *_realloc_internal (void *, size_t);
+extern void _free_internal (void *);
+extern void *_malloc_internal_nolock (size_t);
+extern void *_realloc_internal_nolock (void *, size_t);
+extern void _free_internal_nolock (void *);
#ifdef USE_PTHREAD
extern pthread_mutex_t _malloc_mutex, _aligned_blocks_mutex;
@@ -228,39 +200,36 @@ extern int _malloc_thread_enabled_p;
#define UNLOCK_ALIGNED_BLOCKS()
#endif
-#endif /* _MALLOC_INTERNAL. */
-
/* Given an address in the middle of a malloc'd object,
return the address of the beginning of the object. */
-extern __ptr_t malloc_find_object_address PP ((__ptr_t __ptr));
+extern void *malloc_find_object_address (void *ptr);
/* Underlying allocation function; successive calls should
return contiguous pieces of memory. */
-extern __ptr_t (*__morecore) PP ((__malloc_ptrdiff_t __size));
+extern void *(*__morecore) (ptrdiff_t size);
/* Default value of `__morecore'. */
-extern __ptr_t __default_morecore PP ((__malloc_ptrdiff_t __size));
+extern void *__default_morecore (ptrdiff_t size);
/* If not NULL, this function is called after each time
`__morecore' is called to increase the data size. */
-extern void (*__after_morecore_hook) PP ((void));
+extern void (*__after_morecore_hook) (void);
/* Number of extra blocks to get each time we ask for more core.
This reduces the frequency of calling `(*__morecore)'. */
-extern __malloc_size_t __malloc_extra_blocks;
+extern size_t __malloc_extra_blocks;
/* Nonzero if `malloc' has been called and done its initialization. */
extern int __malloc_initialized;
/* Function called to initialize malloc data structures. */
-extern int __malloc_initialize PP ((void));
+extern int __malloc_initialize (void);
/* Hooks for debugging versions. */
-extern void (*__malloc_initialize_hook) PP ((void));
-extern void (*__free_hook) PP ((__ptr_t __ptr));
-extern __ptr_t (*__malloc_hook) PP ((__malloc_size_t __size));
-extern __ptr_t (*__realloc_hook) PP ((__ptr_t __ptr, __malloc_size_t __size));
-extern __ptr_t (*__memalign_hook) PP ((__malloc_size_t __size,
- __malloc_size_t __alignment));
+extern void (*__malloc_initialize_hook) (void);
+extern void (*__free_hook) (void *ptr);
+extern void *(*__malloc_hook) (size_t size);
+extern void *(*__realloc_hook) (void *ptr, size_t size);
+extern void *(*__memalign_hook) (size_t size, size_t alignment);
/* Return values for `mprobe': these are the kinds of inconsistencies that
`mcheck' enables detection of. */
@@ -277,52 +246,37 @@ enum mcheck_status
before `malloc' is ever called. ABORTFUNC is called with an error code
(see enum above) when an inconsistency is detected. If ABORTFUNC is
null, the standard function prints on stderr and then calls `abort'. */
-extern int mcheck PP ((void (*__abortfunc) PP ((enum mcheck_status))));
+extern int mcheck (void (*abortfunc) (enum mcheck_status));
/* Check for aberrations in a particular malloc'd block. You must have
called `mcheck' already. These are the same checks that `mcheck' does
when you free or reallocate a block. */
-extern enum mcheck_status mprobe PP ((__ptr_t __ptr));
+extern enum mcheck_status mprobe (void *ptr);
/* Activate a standard collection of tracing hooks. */
-extern void mtrace PP ((void));
-extern void muntrace PP ((void));
+extern void mtrace (void);
+extern void muntrace (void);
/* Statistics available to the user. */
struct mstats
{
- __malloc_size_t bytes_total; /* Total size of the heap. */
- __malloc_size_t chunks_used; /* Chunks allocated by the user. */
- __malloc_size_t bytes_used; /* Byte total of user-allocated chunks. */
- __malloc_size_t chunks_free; /* Chunks in the free list. */
- __malloc_size_t bytes_free; /* Byte total of chunks in the free list. */
+ size_t bytes_total; /* Total size of the heap. */
+ size_t chunks_used; /* Chunks allocated by the user. */
+ size_t bytes_used; /* Byte total of user-allocated chunks. */
+ size_t chunks_free; /* Chunks in the free list. */
+ size_t bytes_free; /* Byte total of chunks in the free list. */
};
/* Pick up the current statistics. */
-extern struct mstats mstats PP ((void));
+extern struct mstats mstats (void);
/* Call WARNFUN with a warning message when memory usage is high. */
-extern void memory_warnings PP ((__ptr_t __start,
- void (*__warnfun) PP ((const char *))));
-
-
-/* Relocating allocator. */
-
-/* Allocate SIZE bytes, and store the address in *HANDLEPTR. */
-extern __ptr_t r_alloc PP ((__ptr_t *__handleptr, __malloc_size_t __size));
-
-/* Free the storage allocated in HANDLEPTR. */
-extern void r_alloc_free PP ((__ptr_t *__handleptr));
-
-/* Adjust the block at HANDLEPTR to be SIZE bytes long. */
-extern __ptr_t r_re_alloc PP ((__ptr_t *__handleptr, __malloc_size_t __size));
-
+extern void memory_warnings (void *start, void (*warnfun) (const char *));
#ifdef __cplusplus
}
#endif
-#endif /* malloc.h */
/* Memory allocator `malloc'.
Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
Written May 1989 by Mike Haertel.
@@ -345,10 +299,6 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
#include <errno.h>
/* On Cygwin there are two heaps. temacs uses the static heap
@@ -362,15 +312,15 @@ Fifth Floor, Boston, MA 02110-1301, USA.
this is changed in the future, we'll have to similarly deal with
reinitializing ralloc. */
#ifdef CYGWIN
-extern __ptr_t bss_sbrk PP ((ptrdiff_t __size));
+extern void *bss_sbrk (ptrdiff_t size);
extern int bss_sbrk_did_unexec;
char *bss_sbrk_heapbase; /* _heapbase for static heap */
malloc_info *bss_sbrk_heapinfo; /* _heapinfo for static heap */
#endif
-__ptr_t (*__morecore) PP ((__malloc_ptrdiff_t __size)) = __default_morecore;
+void *(*__morecore) (ptrdiff_t size) = __default_morecore;
/* Debugging hook for `malloc'. */
-__ptr_t (*__malloc_hook) PP ((__malloc_size_t __size));
+void *(*__malloc_hook) (size_t size);
/* Pointer to the base of the first block. */
char *_heapbase;
@@ -379,30 +329,30 @@ char *_heapbase;
malloc_info *_heapinfo;
/* Number of info entries. */
-static __malloc_size_t heapsize;
+static size_t heapsize;
/* Search index in the info table. */
-__malloc_size_t _heapindex;
+size_t _heapindex;
/* Limit of valid info table indices. */
-__malloc_size_t _heaplimit;
+size_t _heaplimit;
/* Free lists for each fragment size. */
struct list _fraghead[BLOCKLOG];
/* Instrumentation. */
-__malloc_size_t _chunks_used;
-__malloc_size_t _bytes_used;
-__malloc_size_t _chunks_free;
-__malloc_size_t _bytes_free;
+size_t _chunks_used;
+size_t _bytes_used;
+size_t _chunks_free;
+size_t _bytes_free;
/* Are you experienced? */
int __malloc_initialized;
-__malloc_size_t __malloc_extra_blocks;
+size_t __malloc_extra_blocks;
-void (*__malloc_initialize_hook) PP ((void));
-void (*__after_morecore_hook) PP ((void));
+void (*__malloc_initialize_hook) (void);
+void (*__after_morecore_hook) (void);
#if defined GC_MALLOC_CHECK && defined GC_PROTECT_MALLOC_STATE
@@ -419,12 +369,11 @@ void (*__after_morecore_hook) PP ((void));
#include <sys/mman.h>
static int state_protected_p;
-static __malloc_size_t last_state_size;
+static size_t last_state_size;
static malloc_info *last_heapinfo;
void
-protect_malloc_state (protect_p)
- int protect_p;
+protect_malloc_state (int protect_p)
{
/* If _heapinfo has been relocated, make sure its old location
isn't left read-only; it will be reused by malloc. */
@@ -453,29 +402,25 @@ protect_malloc_state (protect_p)
/* Aligned allocation. */
-static __ptr_t align PP ((__malloc_size_t));
-static __ptr_t
-align (size)
- __malloc_size_t size;
+static void *
+align (size_t size)
{
- __ptr_t result;
- unsigned long int adj;
+ void *result;
+ ptrdiff_t adj;
/* align accepts an unsigned argument, but __morecore accepts a
- signed one. This could lead to trouble if SIZE overflows a
- signed int type accepted by __morecore. We just punt in that
+ signed one. This could lead to trouble if SIZE overflows the
+ ptrdiff_t type accepted by __morecore. We just punt in that
case, since they are requesting a ludicrous amount anyway. */
- if ((__malloc_ptrdiff_t)size < 0)
+ if (PTRDIFF_MAX < size)
result = 0;
else
result = (*__morecore) (size);
- adj = (unsigned long int) ((unsigned long int) ((char *) result -
- (char *) NULL)) % BLOCKSIZE;
+ adj = (uintptr_t) result % BLOCKSIZE;
if (adj != 0)
{
- __ptr_t new;
adj = BLOCKSIZE - adj;
- new = (*__morecore) (adj);
+ (*__morecore) (adj);
result = (char *) result + adj;
}
@@ -488,14 +433,11 @@ align (size)
/* Get SIZE bytes, if we can get them starting at END.
Return the address of the space we got.
If we cannot get space at END, fail and return 0. */
-static __ptr_t get_contiguous_space PP ((__malloc_ptrdiff_t, __ptr_t));
-static __ptr_t
-get_contiguous_space (size, position)
- __malloc_ptrdiff_t size;
- __ptr_t position;
+static void *
+get_contiguous_space (ptrdiff_t size, void *position)
{
- __ptr_t before;
- __ptr_t after;
+ void *before;
+ void *after;
before = (*__morecore) (0);
/* If we can tell in advance that the break is at the wrong place,
@@ -522,10 +464,10 @@ get_contiguous_space (size, position)
/* This is called when `_heapinfo' and `heapsize' have just
been set to describe a new info table. Set up the table
to describe itself and account for it in the statistics. */
-static inline void
+static void
register_heapinfo (void)
{
- __malloc_size_t block, blocks;
+ size_t block, blocks;
block = BLOCK (_heapinfo);
blocks = BLOCKIFY (heapsize * sizeof (malloc_info));
@@ -548,21 +490,21 @@ pthread_mutex_t _aligned_blocks_mutex = PTHREAD_MUTEX_INITIALIZER;
int _malloc_thread_enabled_p;
static void
-malloc_atfork_handler_prepare ()
+malloc_atfork_handler_prepare (void)
{
LOCK ();
LOCK_ALIGNED_BLOCKS ();
}
static void
-malloc_atfork_handler_parent ()
+malloc_atfork_handler_parent (void)
{
UNLOCK_ALIGNED_BLOCKS ();
UNLOCK ();
}
static void
-malloc_atfork_handler_child ()
+malloc_atfork_handler_child (void)
{
UNLOCK_ALIGNED_BLOCKS ();
UNLOCK ();
@@ -570,7 +512,7 @@ malloc_atfork_handler_child ()
/* Set up mutexes and make malloc etc. thread-safe. */
void
-malloc_enable_thread ()
+malloc_enable_thread (void)
{
if (_malloc_thread_enabled_p)
return;
@@ -589,7 +531,7 @@ malloc_enable_thread ()
#endif
static void
-malloc_initialize_1 ()
+malloc_initialize_1 (void)
{
#ifdef GC_MCHECK
mcheck (NULL);
@@ -609,7 +551,7 @@ malloc_initialize_1 ()
(*__malloc_initialize_hook) ();
heapsize = HEAP / BLOCKSIZE;
- _heapinfo = (malloc_info *) align (heapsize * sizeof (malloc_info));
+ _heapinfo = align (heapsize * sizeof (malloc_info));
if (_heapinfo == NULL)
return;
memset (_heapinfo, 0, heapsize * sizeof (malloc_info));
@@ -630,7 +572,7 @@ malloc_initialize_1 ()
main will call malloc which calls this function. That is before any threads
or signal handlers has been set up, so we don't need thread protection. */
int
-__malloc_initialize ()
+__malloc_initialize (void)
{
if (__malloc_initialized)
return 0;
@@ -644,14 +586,12 @@ static int morecore_recursing;
/* Get neatly aligned memory, initializing or
growing the heap info table as necessary. */
-static __ptr_t morecore_nolock PP ((__malloc_size_t));
-static __ptr_t
-morecore_nolock (size)
- __malloc_size_t size;
+static void *
+morecore_nolock (size_t size)
{
- __ptr_t result;
+ void *result;
malloc_info *newinfo, *oldinfo;
- __malloc_size_t newsize;
+ size_t newsize;
if (morecore_recursing)
/* Avoid recursion. The caller will know how to handle a null return. */
@@ -664,7 +604,7 @@ morecore_nolock (size)
PROTECT_MALLOC_STATE (0);
/* Check if we need to grow the info table. */
- if ((__malloc_size_t) BLOCK ((char *) result + size) > heapsize)
+ if ((size_t) BLOCK ((char *) result + size) > heapsize)
{
/* Calculate the new _heapinfo table size. We do not account for the
added blocks in the table itself, as we hope to place them in
@@ -673,7 +613,7 @@ morecore_nolock (size)
newsize = heapsize;
do
newsize *= 2;
- while ((__malloc_size_t) BLOCK ((char *) result + size) > newsize);
+ while ((size_t) BLOCK ((char *) result + size) > newsize);
/* We must not reuse existing core for the new info table when called
from realloc in the case of growing a large block, because the
@@ -689,8 +629,8 @@ morecore_nolock (size)
`morecore_recursing' flag and return null. */
int save = errno; /* Don't want to clobber errno with ENOMEM. */
morecore_recursing = 1;
- newinfo = (malloc_info *) _realloc_internal_nolock
- (_heapinfo, newsize * sizeof (malloc_info));
+ newinfo = _realloc_internal_nolock (_heapinfo,
+ newsize * sizeof (malloc_info));
morecore_recursing = 0;
if (newinfo == NULL)
errno = save;
@@ -710,7 +650,7 @@ morecore_nolock (size)
/* Allocate new space for the malloc info table. */
while (1)
{
- newinfo = (malloc_info *) align (newsize * sizeof (malloc_info));
+ newinfo = align (newsize * sizeof (malloc_info));
/* Did it fail? */
if (newinfo == NULL)
@@ -721,8 +661,8 @@ morecore_nolock (size)
/* Is it big enough to record status for its own space?
If so, we win. */
- if ((__malloc_size_t) BLOCK ((char *) newinfo
- + newsize * sizeof (malloc_info))
+ if ((size_t) BLOCK ((char *) newinfo
+ + newsize * sizeof (malloc_info))
< newsize)
break;
@@ -759,13 +699,12 @@ morecore_nolock (size)
}
/* Allocate memory from the heap. */
-__ptr_t
-_malloc_internal_nolock (size)
- __malloc_size_t size;
+void *
+_malloc_internal_nolock (size_t size)
{
- __ptr_t result;
- __malloc_size_t block, blocks, lastblocks, start;
- register __malloc_size_t i;
+ void *result;
+ size_t block, blocks, lastblocks, start;
+ register size_t i;
struct list *next;
/* ANSI C allows `malloc (0)' to either return NULL, or to return a
@@ -790,7 +729,7 @@ _malloc_internal_nolock (size)
{
/* Small allocation to receive a fragment of a block.
Determine the logarithm to base two of the fragment size. */
- register __malloc_size_t log = 1;
+ register size_t log = 1;
--size;
while ((size /= 2) != 0)
++log;
@@ -803,15 +742,14 @@ _malloc_internal_nolock (size)
/* There are free fragments of this size.
Pop a fragment out of the fragment list and return it.
Update the block's nfree and first counters. */
- result = (__ptr_t) next;
+ result = next;
next->prev->next = next->next;
if (next->next != NULL)
next->next->prev = next->prev;
block = BLOCK (result);
if (--_heapinfo[block].busy.info.frag.nfree != 0)
- _heapinfo[block].busy.info.frag.first = (unsigned long int)
- ((unsigned long int) ((char *) next->next - (char *) NULL)
- % BLOCKSIZE) >> log;
+ _heapinfo[block].busy.info.frag.first =
+ (uintptr_t) next->next % BLOCKSIZE >> log;
/* Update the statistics. */
++_chunks_used;
@@ -843,7 +781,7 @@ _malloc_internal_nolock (size)
next->prev = &_fraghead[log];
_fraghead[log].next = next;
- for (i = 2; i < (__malloc_size_t) (BLOCKSIZE >> log); ++i)
+ for (i = 2; i < (size_t) (BLOCKSIZE >> log); ++i)
{
next = (struct list *) ((char *) result + (i << log));
next->next = _fraghead[log].next;
@@ -877,7 +815,7 @@ _malloc_internal_nolock (size)
if (block == start)
{
/* Need to get more from the system. Get a little extra. */
- __malloc_size_t wantblocks = blocks + __malloc_extra_blocks;
+ size_t wantblocks = blocks + __malloc_extra_blocks;
block = _heapinfo[0].free.prev;
lastblocks = _heapinfo[block].free.size;
/* Check to see if the new core will be contiguous with the
@@ -959,11 +897,10 @@ _malloc_internal_nolock (size)
return result;
}
-__ptr_t
-_malloc_internal (size)
- __malloc_size_t size;
+void *
+_malloc_internal (size_t size)
{
- __ptr_t result;
+ void *result;
LOCK ();
result = _malloc_internal_nolock (size);
@@ -972,11 +909,10 @@ _malloc_internal (size)
return result;
}
-__ptr_t
-malloc (size)
- __malloc_size_t size;
+void *
+malloc (size_t size)
{
- __ptr_t (*hook) (__malloc_size_t);
+ void *(*hook) (size_t);
if (!__malloc_initialized && !__malloc_initialize ())
return NULL;
@@ -998,24 +934,24 @@ malloc (size)
/* On some ANSI C systems, some libc functions call _malloc, _free
and _realloc. Make them use the GNU functions. */
-__ptr_t
-_malloc (size)
- __malloc_size_t size;
+extern void *_malloc (size_t);
+extern void _free (void *);
+extern void *_realloc (void *, size_t);
+
+void *
+_malloc (size_t size)
{
return malloc (size);
}
void
-_free (ptr)
- __ptr_t ptr;
+_free (void *ptr)
{
free (ptr);
}
-__ptr_t
-_realloc (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+_realloc (void *ptr, size_t size)
{
return realloc (ptr, size);
}
@@ -1043,14 +979,9 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
/* Debugging hook for free. */
-void (*__free_hook) PP ((__ptr_t __ptr));
+void (*__free_hook) (void *__ptr);
/* List of blocks allocated by memalign. */
struct alignlist *_aligned_blocks = NULL;
@@ -1058,15 +989,14 @@ struct alignlist *_aligned_blocks = NULL;
/* Return memory to the heap.
Like `_free_internal' but don't lock mutex. */
void
-_free_internal_nolock (ptr)
- __ptr_t ptr;
+_free_internal_nolock (void *ptr)
{
int type;
- __malloc_size_t block, blocks;
- register __malloc_size_t i;
+ size_t block, blocks;
+ register size_t i;
struct list *prev, *next;
- __ptr_t curbrk;
- const __malloc_size_t lesscore_threshold
+ void *curbrk;
+ const size_t lesscore_threshold
/* Threshold of free space at which we will return some to the system. */
= FINAL_FREE_BLOCKS + 2 * __malloc_extra_blocks;
@@ -1076,7 +1006,7 @@ _free_internal_nolock (ptr)
return;
#ifdef CYGWIN
- if (ptr < _heapbase)
+ if ((char *) ptr < _heapbase)
/* We're being asked to free something in the static heap. */
return;
#endif
@@ -1162,12 +1092,12 @@ _free_internal_nolock (ptr)
It's possible that moving _heapinfo will allow us to
return some space to the system. */
- __malloc_size_t info_block = BLOCK (_heapinfo);
- __malloc_size_t info_blocks = _heapinfo[info_block].busy.info.size;
- __malloc_size_t prev_block = _heapinfo[block].free.prev;
- __malloc_size_t prev_blocks = _heapinfo[prev_block].free.size;
- __malloc_size_t next_block = _heapinfo[block].free.next;
- __malloc_size_t next_blocks = _heapinfo[next_block].free.size;
+ size_t info_block = BLOCK (_heapinfo);
+ size_t info_blocks = _heapinfo[info_block].busy.info.size;
+ size_t prev_block = _heapinfo[block].free.prev;
+ size_t prev_blocks = _heapinfo[prev_block].free.size;
+ size_t next_block = _heapinfo[block].free.next;
+ size_t next_blocks = _heapinfo[next_block].free.size;
if (/* Win if this block being freed is last in core, the info table
is just before it, the previous free block is just before the
@@ -1190,7 +1120,7 @@ _free_internal_nolock (ptr)
)
{
malloc_info *newinfo;
- __malloc_size_t oldlimit = _heaplimit;
+ size_t oldlimit = _heaplimit;
/* Free the old info table, clearing _heaplimit to avoid
recursion into this code. We don't want to return the
@@ -1205,8 +1135,7 @@ _free_internal_nolock (ptr)
_heapindex = 0;
/* Allocate new space for the info table and move its data. */
- newinfo = (malloc_info *) _malloc_internal_nolock (info_blocks
- * BLOCKSIZE);
+ newinfo = _malloc_internal_nolock (info_blocks * BLOCKSIZE);
PROTECT_MALLOC_STATE (0);
memmove (newinfo, _heapinfo, info_blocks * BLOCKSIZE);
_heapinfo = newinfo;
@@ -1222,7 +1151,7 @@ _free_internal_nolock (ptr)
/* Now see if we can return stuff to the system. */
if (block + blocks == _heaplimit && blocks >= lesscore_threshold)
{
- register __malloc_size_t bytes = blocks * BLOCKSIZE;
+ register size_t bytes = blocks * BLOCKSIZE;
_heaplimit -= blocks;
(*__morecore) (-bytes);
_heapinfo[_heapinfo[block].free.prev].free.next
@@ -1255,7 +1184,7 @@ _free_internal_nolock (ptr)
/* If all fragments of this block are free, remove them
from the fragment list and free the whole block. */
next = prev;
- for (i = 1; i < (__malloc_size_t) (BLOCKSIZE >> type); ++i)
+ for (i = 1; i < (size_t) (BLOCKSIZE >> type); ++i)
next = next->next;
prev->prev->next = next;
if (next != NULL)
@@ -1280,7 +1209,7 @@ _free_internal_nolock (ptr)
/* If some fragments of this block are free, link this
fragment into the fragment list after the first free
fragment of this block. */
- next = (struct list *) ptr;
+ next = ptr;
next->next = prev->next;
next->prev = prev;
prev->next = next;
@@ -1293,11 +1222,10 @@ _free_internal_nolock (ptr)
/* No fragments of this block are free, so link this
fragment into the fragment list and announce that
it is the first free fragment of this block. */
- prev = (struct list *) ptr;
+ prev = ptr;
_heapinfo[block].busy.info.frag.nfree = 1;
- _heapinfo[block].busy.info.frag.first = (unsigned long int)
- ((unsigned long int) ((char *) ptr - (char *) NULL)
- % BLOCKSIZE >> type);
+ _heapinfo[block].busy.info.frag.first =
+ (uintptr_t) ptr % BLOCKSIZE >> type;
prev->next = _fraghead[type].next;
prev->prev = &_fraghead[type];
prev->prev->next = prev;
@@ -1313,8 +1241,7 @@ _free_internal_nolock (ptr)
/* Return memory to the heap.
Like `free' but don't call a __free_hook if there is one. */
void
-_free_internal (ptr)
- __ptr_t ptr;
+_free_internal (void *ptr)
{
LOCK ();
_free_internal_nolock (ptr);
@@ -1324,10 +1251,9 @@ _free_internal (ptr)
/* Return memory to the heap. */
void
-free (ptr)
- __ptr_t ptr;
+free (void *ptr)
{
- void (*hook) (__ptr_t) = __free_hook;
+ void (*hook) (void *) = __free_hook;
if (hook != NULL)
(*hook) (ptr);
@@ -1340,8 +1266,7 @@ free (ptr)
weak_alias (free, cfree)
#else
void
-cfree (ptr)
- __ptr_t ptr;
+cfree (void *ptr)
{
free (ptr);
}
@@ -1368,32 +1293,26 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
-
+#ifndef min
#define min(A, B) ((A) < (B) ? (A) : (B))
+#endif
/* On Cygwin the dumped emacs may try to realloc storage allocated in
the static heap. We just malloc space in the new heap and copy the
data. */
#ifdef CYGWIN
-__ptr_t
-special_realloc (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+special_realloc (void *ptr, size_t size)
{
- __ptr_t result;
+ void *result;
int type;
- __malloc_size_t block, oldsize;
+ size_t block, oldsize;
block = ((char *) ptr - bss_sbrk_heapbase) / BLOCKSIZE + 1;
type = bss_sbrk_heapinfo[block].busy.type;
oldsize =
type == 0 ? bss_sbrk_heapinfo[block].busy.info.size * BLOCKSIZE
- : (__malloc_size_t) 1 << type;
+ : (size_t) 1 << type;
result = _malloc_internal_nolock (size);
if (result != NULL)
memcpy (result, ptr, min (oldsize, size));
@@ -1402,7 +1321,7 @@ special_realloc (ptr, size)
#endif
/* Debugging hook for realloc. */
-__ptr_t (*__realloc_hook) PP ((__ptr_t __ptr, __malloc_size_t __size));
+void *(*__realloc_hook) (void *ptr, size_t size);
/* Resize the given region to the new size, returning a pointer
to the (possibly moved) region. This is optimized for speed;
@@ -1410,14 +1329,12 @@ __ptr_t (*__realloc_hook) PP ((__ptr_t __ptr, __malloc_size_t __size));
achieved by unconditionally allocating and copying to a
new region. This module has incestuous knowledge of the
internals of both free and malloc. */
-__ptr_t
-_realloc_internal_nolock (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+_realloc_internal_nolock (void *ptr, size_t size)
{
- __ptr_t result;
+ void *result;
int type;
- __malloc_size_t block, blocks, oldlimit;
+ size_t block, blocks, oldlimit;
if (size == 0)
{
@@ -1428,7 +1345,7 @@ _realloc_internal_nolock (ptr, size)
return _malloc_internal_nolock (size);
#ifdef CYGWIN
- if (ptr < _heapbase)
+ if ((char *) ptr < _heapbase)
/* ptr points into the static heap */
return special_realloc (ptr, size);
#endif
@@ -1497,7 +1414,7 @@ _realloc_internal_nolock (ptr, size)
(void) _malloc_internal_nolock (blocks * BLOCKSIZE);
else
{
- __ptr_t previous
+ void *previous
= _malloc_internal_nolock ((block - _heapindex) * BLOCKSIZE);
(void) _malloc_internal_nolock (blocks * BLOCKSIZE);
_free_internal_nolock (previous);
@@ -1512,8 +1429,8 @@ _realloc_internal_nolock (ptr, size)
default:
/* Old size is a fragment; type is logarithm
to base two of the fragment size. */
- if (size > (__malloc_size_t) (1 << (type - 1)) &&
- size <= (__malloc_size_t) (1 << type))
+ if (size > (size_t) (1 << (type - 1)) &&
+ size <= (size_t) (1 << type))
/* The new size is the same kind of fragment. */
result = ptr;
else
@@ -1523,7 +1440,7 @@ _realloc_internal_nolock (ptr, size)
result = _malloc_internal_nolock (size);
if (result == NULL)
goto out;
- memcpy (result, ptr, min (size, (__malloc_size_t) 1 << type));
+ memcpy (result, ptr, min (size, (size_t) 1 << type));
_free_internal_nolock (ptr);
}
break;
@@ -1534,12 +1451,10 @@ _realloc_internal_nolock (ptr, size)
return result;
}
-__ptr_t
-_realloc_internal (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+_realloc_internal (void *ptr, size_t size)
{
- __ptr_t result;
+ void *result;
LOCK ();
result = _realloc_internal_nolock (ptr, size);
@@ -1548,12 +1463,10 @@ _realloc_internal (ptr, size)
return result;
}
-__ptr_t
-realloc (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+realloc (void *ptr, size_t size)
{
- __ptr_t (*hook) (__ptr_t, __malloc_size_t);
+ void *(*hook) (void *, size_t);
if (!__malloc_initialized && !__malloc_initialize ())
return NULL;
@@ -1581,19 +1494,12 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
/* Allocate an array of NMEMB elements each SIZE bytes long.
The entire array is initialized to zeros. */
-__ptr_t
-calloc (nmemb, size)
- register __malloc_size_t nmemb;
- register __malloc_size_t size;
+void *
+calloc (register size_t nmemb, register size_t size)
{
- register __ptr_t result = malloc (nmemb * size);
+ register void *result = malloc (nmemb * size);
if (result != NULL)
(void) memset (result, 0, nmemb * size);
@@ -1618,11 +1524,6 @@ along with the GNU C Library; see the file COPYING. If not, write to
the Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,
MA 02110-1301, USA. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
/* uClibc defines __GNU_LIBRARY__, but it is not completely
compatible. */
#if !defined (__GNU_LIBRARY__) || defined (__UCLIBC__)
@@ -1631,30 +1532,24 @@ MA 02110-1301, USA. */
/* It is best not to declare this and cast its result on foreign operating
systems with potentially hostile include files. */
-#include <stddef.h>
-extern __ptr_t __sbrk PP ((ptrdiff_t increment));
+extern void *__sbrk (ptrdiff_t increment);
#endif /* __GNU_LIBRARY__ && ! defined (__UCLIBC__) */
-#ifndef NULL
-#define NULL 0
-#endif
-
/* Allocate INCREMENT more bytes of data space,
and return the start of data space, or NULL on errors.
If INCREMENT is negative, shrink data space. */
-__ptr_t
-__default_morecore (increment)
- __malloc_ptrdiff_t increment;
+void *
+__default_morecore (ptrdiff_t increment)
{
- __ptr_t result;
+ void *result;
#if defined (CYGWIN)
if (!bss_sbrk_did_unexec)
{
return bss_sbrk (increment);
}
#endif
- result = (__ptr_t) __sbrk (increment);
- if (result == (__ptr_t) -1)
+ result = (void *) __sbrk (increment);
+ if (result == (void *) -1)
return NULL;
return result;
}
@@ -1675,22 +1570,14 @@ License along with this library; see the file COPYING. If
not, write to the Free Software Foundation, Inc., 51 Franklin Street,
Fifth Floor, Boston, MA 02110-1301, USA. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
-__ptr_t (*__memalign_hook) PP ((__malloc_size_t __size,
- __malloc_size_t __alignment));
+void *(*__memalign_hook) (size_t size, size_t alignment);
-__ptr_t
-memalign (alignment, size)
- __malloc_size_t alignment;
- __malloc_size_t size;
+void *
+memalign (size_t alignment, size_t size)
{
- __ptr_t result;
- unsigned long int adj, lastadj;
- __ptr_t (*hook) (__malloc_size_t, __malloc_size_t) = __memalign_hook;
+ void *result;
+ size_t adj, lastadj;
+ void *(*hook) (size_t, size_t) = __memalign_hook;
if (hook)
return (*hook) (alignment, size);
@@ -1703,7 +1590,7 @@ memalign (alignment, size)
/* Figure out how much we will need to pad this particular block
to achieve the required alignment. */
- adj = (unsigned long int) ((char *) result - (char *) NULL) % alignment;
+ adj = (uintptr_t) result % alignment;
do
{
@@ -1714,7 +1601,7 @@ memalign (alignment, size)
return NULL;
lastadj = adj;
- adj = (unsigned long int) ((char *) result - (char *) NULL) % alignment;
+ adj = (uintptr_t) result % alignment;
/* It's conceivable we might have been so unlucky as to get a
different block with weaker alignment. If so, this block is too
short to contain SIZE after alignment correction. So we must
@@ -1735,7 +1622,7 @@ memalign (alignment, size)
break;
if (l == NULL)
{
- l = (struct alignlist *) malloc (sizeof (struct alignlist));
+ l = malloc (sizeof *l);
if (l != NULL)
{
l->next = _aligned_blocks;
@@ -1767,15 +1654,12 @@ memalign (alignment, size)
#endif
int
-posix_memalign (memptr, alignment, size)
- __ptr_t *memptr;
- __malloc_size_t alignment;
- __malloc_size_t size;
+posix_memalign (void **memptr, size_t alignment, size_t size)
{
- __ptr_t mem;
+ void *mem;
if (alignment == 0
- || alignment % sizeof (__ptr_t) != 0
+ || alignment % sizeof (void *) != 0
|| (alignment & (alignment - 1)) != 0)
return EINVAL;
@@ -1809,49 +1693,26 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#if defined (_MALLOC_INTERNAL) && defined (GMALLOC_INHIBIT_VALLOC)
-
-/* Emacs defines GMALLOC_INHIBIT_VALLOC to avoid this definition
- on MSDOS, where it conflicts with a system header file. */
-
-#define ELIDE_VALLOC
-
-#endif
-
-#ifndef ELIDE_VALLOC
-
-#if defined (__GNU_LIBRARY__) || defined (_LIBC)
-#include <stddef.h>
-#include <sys/cdefs.h>
-#if defined (__GLIBC__) && __GLIBC__ >= 2
-/* __getpagesize is already declared in <unistd.h> with return type int */
-#else
-extern size_t __getpagesize PP ((void));
-#endif
-#else
-#include "getpagesize.h"
-#define __getpagesize() getpagesize ()
-#endif
+/* Allocate SIZE bytes on a page boundary. */
+extern void *valloc (size_t);
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
+#if defined _SC_PAGESIZE || !defined HAVE_GETPAGESIZE
+# include "getpagesize.h"
+#elif !defined getpagesize
+extern int getpagesize (void);
#endif
-static __malloc_size_t pagesize;
+static size_t pagesize;
-__ptr_t
-valloc (size)
- __malloc_size_t size;
+void *
+valloc (size_t size)
{
if (pagesize == 0)
- pagesize = __getpagesize ();
+ pagesize = getpagesize ();
return memalign (pagesize, size);
}
-#endif /* Not ELIDE_VALLOC. */
-
#ifdef GC_MCHECK
/* Standard debugging hooks for `malloc'.
@@ -1876,41 +1737,31 @@ Fifth Floor, Boston, MA 02110-1301, USA.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifdef emacs
#include <stdio.h>
-#else
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#include <stdio.h>
-#endif
-#endif
/* Old hook values. */
-static void (*old_free_hook) (__ptr_t ptr);
-static __ptr_t (*old_malloc_hook) (__malloc_size_t size);
-static __ptr_t (*old_realloc_hook) (__ptr_t ptr, __malloc_size_t size);
+static void (*old_free_hook) (void *ptr);
+static void *(*old_malloc_hook) (size_t size);
+static void *(*old_realloc_hook) (void *ptr, size_t size);
/* Function to call when something awful happens. */
static void (*abortfunc) (enum mcheck_status);
/* Arbitrary magical numbers. */
-#define MAGICWORD 0xfedabeeb
-#define MAGICFREE 0xd8675309
+#define MAGICWORD (SIZE_MAX / 11 ^ SIZE_MAX / 13 << 3)
+#define MAGICFREE (SIZE_MAX / 17 ^ SIZE_MAX / 19 << 4)
#define MAGICBYTE ((char) 0xd7)
#define MALLOCFLOOD ((char) 0x93)
#define FREEFLOOD ((char) 0x95)
struct hdr
{
- __malloc_size_t size; /* Exact size requested by user. */
- unsigned long int magic; /* Magic number to check header integrity. */
+ size_t size; /* Exact size requested by user. */
+ size_t magic; /* Magic number to check header integrity. */
};
-static enum mcheck_status checkhdr (const struct hdr *);
static enum mcheck_status
-checkhdr (hdr)
- const struct hdr *hdr;
+checkhdr (const struct hdr *hdr)
{
enum mcheck_status status;
switch (hdr->magic)
@@ -1933,10 +1784,8 @@ checkhdr (hdr)
return status;
}
-static void freehook (__ptr_t);
static void
-freehook (ptr)
- __ptr_t ptr;
+freehook (void *ptr)
{
struct hdr *hdr;
@@ -1955,15 +1804,13 @@ freehook (ptr)
__free_hook = freehook;
}
-static __ptr_t mallochook (__malloc_size_t);
-static __ptr_t
-mallochook (size)
- __malloc_size_t size;
+static void *
+mallochook (size_t size)
{
struct hdr *hdr;
__malloc_hook = old_malloc_hook;
- hdr = (struct hdr *) malloc (sizeof (struct hdr) + size + 1);
+ hdr = malloc (sizeof *hdr + size + 1);
__malloc_hook = mallochook;
if (hdr == NULL)
return NULL;
@@ -1971,18 +1818,15 @@ mallochook (size)
hdr->size = size;
hdr->magic = MAGICWORD;
((char *) &hdr[1])[size] = MAGICBYTE;
- memset ((__ptr_t) (hdr + 1), MALLOCFLOOD, size);
- return (__ptr_t) (hdr + 1);
+ memset (hdr + 1, MALLOCFLOOD, size);
+ return hdr + 1;
}
-static __ptr_t reallochook (__ptr_t, __malloc_size_t);
-static __ptr_t
-reallochook (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+static void *
+reallochook (void *ptr, size_t size)
{
struct hdr *hdr = NULL;
- __malloc_size_t osize = 0;
+ size_t osize = 0;
if (ptr)
{
@@ -1997,7 +1841,7 @@ reallochook (ptr, size)
__free_hook = old_free_hook;
__malloc_hook = old_malloc_hook;
__realloc_hook = old_realloc_hook;
- hdr = (struct hdr *) realloc ((__ptr_t) hdr, sizeof (struct hdr) + size + 1);
+ hdr = realloc (hdr, sizeof *hdr + size + 1);
__free_hook = freehook;
__malloc_hook = mallochook;
__realloc_hook = reallochook;
@@ -2009,12 +1853,11 @@ reallochook (ptr, size)
((char *) &hdr[1])[size] = MAGICBYTE;
if (size > osize)
memset ((char *) (hdr + 1) + osize, MALLOCFLOOD, size - osize);
- return (__ptr_t) (hdr + 1);
+ return hdr + 1;
}
static void
-mabort (status)
- enum mcheck_status status;
+mabort (enum mcheck_status status)
{
const char *msg;
switch (status)
@@ -2047,8 +1890,7 @@ mabort (status)
static int mcheck_used = 0;
int
-mcheck (func)
- void (*func) (enum mcheck_status);
+mcheck (void (*func) (enum mcheck_status))
{
abortfunc = (func != NULL) ? func : &mabort;
@@ -2068,7 +1910,7 @@ mcheck (func)
}
enum mcheck_status
-mprobe (__ptr_t ptr)
+mprobe (void *ptr)
{
return mcheck_used ? checkhdr (ptr) : MCHECK_DISABLED;
}
diff --git a/src/gnutls.c b/src/gnutls.c
index 500f09432b1..e3d84a0b61b 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -1,5 +1,5 @@
/* GnuTLS glue for GNU Emacs.
- Copyright (C) 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2010-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -18,7 +18,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <errno.h>
-#include <setjmp.h>
#include "lisp.h"
#include "process.h"
@@ -31,15 +30,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "w32.h"
#endif
-static int
-emacs_gnutls_handle_error (gnutls_session_t, int err);
+static bool emacs_gnutls_handle_error (gnutls_session_t, int);
static Lisp_Object Qgnutls_dll;
static Lisp_Object Qgnutls_code;
static Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
static Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-static int gnutls_global_initialized;
+static bool gnutls_global_initialized;
/* The following are for the property list of `gnutls-boot'. */
static Lisp_Object QCgnutls_bootprop_priority;
@@ -125,6 +123,7 @@ DEF_GNUTLS_FN (ssize_t, gnutls_record_send,
(gnutls_session_t, const void *, size_t));
DEF_GNUTLS_FN (const char *, gnutls_strerror, (int));
DEF_GNUTLS_FN (void, gnutls_transport_set_errno, (gnutls_session_t, int));
+DEF_GNUTLS_FN (const char *, gnutls_check_version, (const char *));
DEF_GNUTLS_FN (void, gnutls_transport_set_lowat, (gnutls_session_t, int));
DEF_GNUTLS_FN (void, gnutls_transport_set_ptr2,
(gnutls_session_t, gnutls_transport_ptr_t,
@@ -141,13 +140,13 @@ DEF_GNUTLS_FN (int, gnutls_x509_crt_import,
gnutls_x509_crt_fmt_t));
DEF_GNUTLS_FN (int, gnutls_x509_crt_init, (gnutls_x509_crt_t *));
-static int
-init_gnutls_functions (Lisp_Object libraries)
+static bool
+init_gnutls_functions (void)
{
HMODULE library;
int max_log_level = 1;
- if (!(library = w32_delayed_load (libraries, Qgnutls_dll)))
+ if (!(library = w32_delayed_load (Qgnutls_dll)))
{
GNUTLS_LOG (1, max_log_level, "GnuTLS library not found");
return 0;
@@ -184,7 +183,11 @@ init_gnutls_functions (Lisp_Object libraries)
LOAD_GNUTLS_FN (library, gnutls_record_send);
LOAD_GNUTLS_FN (library, gnutls_strerror);
LOAD_GNUTLS_FN (library, gnutls_transport_set_errno);
- LOAD_GNUTLS_FN (library, gnutls_transport_set_lowat);
+ LOAD_GNUTLS_FN (library, gnutls_check_version);
+ /* We don't need to call gnutls_transport_set_lowat in GnuTLS 2.11.1
+ and later, and the function was removed entirely in 3.0.0. */
+ if (!fn_gnutls_check_version ("2.11.1"))
+ LOAD_GNUTLS_FN (library, gnutls_transport_set_lowat);
LOAD_GNUTLS_FN (library, gnutls_transport_set_ptr2);
LOAD_GNUTLS_FN (library, gnutls_transport_set_pull_function);
LOAD_GNUTLS_FN (library, gnutls_transport_set_push_function);
@@ -195,8 +198,12 @@ init_gnutls_functions (Lisp_Object libraries)
max_log_level = global_gnutls_log_level;
- GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
- SDATA (Fget (Qgnutls_dll, QCloaded_from)));
+ {
+ Lisp_Object name = CAR_SAFE (Fget (Qgnutls_dll, QCloaded_from));
+ GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
+ STRINGP (name) ? (const char *) SDATA (name) : "unknown");
+ }
+
return 1;
}
@@ -242,18 +249,27 @@ init_gnutls_functions (Lisp_Object libraries)
#endif /* !WINDOWSNT */
+/* Function to log a simple message. */
static void
gnutls_log_function (int level, const char* string)
{
message ("gnutls.c: [%d] %s", level, string);
}
+/* Function to log a message and a string. */
static void
gnutls_log_function2 (int level, const char* string, const char* extra)
{
message ("gnutls.c: [%d] %s %s", level, string, extra);
}
+/* Function to log a message and an integer. */
+static void
+gnutls_log_function2i (int level, const char* string, int extra)
+{
+ message ("gnutls.c: [%d] %s %d", level, string, extra);
+}
+
static int
emacs_gnutls_handshake (struct Lisp_Process *proc)
{
@@ -282,7 +298,12 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
(Note: this is probably not strictly necessary as the lowat
value is only used when no custom pull/push functions are
set.) */
- fn_gnutls_transport_set_lowat (state, 0);
+ /* According to GnuTLS NEWS file, lowat level has been set to
+ zero by default in version 2.11.1, and the function
+ gnutls_transport_set_lowat was removed from the library in
+ version 2.99.0. */
+ if (!fn_gnutls_check_version ("2.11.1"))
+ fn_gnutls_transport_set_lowat (state, 0);
#else
/* This is how GnuTLS takes sockets: as file descriptors passed
in. For an Emacs process socket, infd and outfd are the
@@ -299,6 +320,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
{
ret = fn_gnutls_handshake (state);
emacs_gnutls_handle_error (state, ret);
+ QUIT;
}
while (ret < 0 && fn_gnutls_error_is_fatal (ret) == 0);
@@ -328,22 +350,23 @@ emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
fn_gnutls_transport_set_errno (state, err);
}
-EMACS_INT
-emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte)
+ptrdiff_t
+emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
{
ssize_t rtnval = 0;
- EMACS_INT bytes_written;
+ ptrdiff_t bytes_written;
gnutls_session_t state = proc->gnutls_state;
- if (proc->gnutls_initstage != GNUTLS_STAGE_READY) {
+ if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
+ {
#ifdef EWOULDBLOCK
- errno = EWOULDBLOCK;
+ errno = EWOULDBLOCK;
#endif
#ifdef EAGAIN
- errno = EAGAIN;
+ errno = EAGAIN;
#endif
- return 0;
- }
+ return 0;
+ }
bytes_written = 0;
@@ -353,10 +376,24 @@ emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte)
if (rtnval < 0)
{
- if (rtnval == GNUTLS_E_AGAIN || rtnval == GNUTLS_E_INTERRUPTED)
+ if (rtnval == GNUTLS_E_INTERRUPTED)
continue;
else
- break;
+ {
+ /* If we get GNUTLS_E_AGAIN, then set errno
+ appropriately so that send_process retries the
+ correct way instead of erroring out. */
+ if (rtnval == GNUTLS_E_AGAIN)
+ {
+#ifdef EWOULDBLOCK
+ errno = EWOULDBLOCK;
+#endif
+#ifdef EAGAIN
+ errno = EAGAIN;
+#endif
+ }
+ break;
+ }
}
buf += rtnval;
@@ -368,16 +405,31 @@ emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte)
return (bytes_written);
}
-EMACS_INT
-emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte)
+ptrdiff_t
+emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
{
ssize_t rtnval;
gnutls_session_t state = proc->gnutls_state;
+ int log_level = proc->gnutls_log_level;
+
if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
{
- emacs_gnutls_handshake (proc);
- return -1;
+ /* If the handshake count is under the limit, try the handshake
+ again and increment the handshake count. This count is kept
+ per process (connection), not globally. */
+ if (proc->gnutls_handshakes_tried < GNUTLS_EMACS_HANDSHAKES_LIMIT)
+ {
+ proc->gnutls_handshakes_tried++;
+ emacs_gnutls_handshake (proc);
+ GNUTLS_LOG2i (5, log_level, "Retried handshake",
+ proc->gnutls_handshakes_tried);
+ return -1;
+ }
+
+ GNUTLS_LOG (2, log_level, "Giving up on handshake; resetting retries");
+ proc->gnutls_handshakes_tried = 0;
+ return 0;
}
rtnval = fn_gnutls_record_recv (state, buf, nbyte);
if (rtnval >= 0)
@@ -385,7 +437,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte)
else if (rtnval == GNUTLS_E_UNEXPECTED_PACKET_LENGTH)
/* The peer closed the connection. */
return 0;
- else if (emacs_gnutls_handle_error (state, rtnval) == 0)
+ else if (emacs_gnutls_handle_error (state, rtnval))
/* non-fatal error */
return -1;
else {
@@ -394,19 +446,19 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte)
}
}
-/* report a GnuTLS error to the user.
- Returns zero if the error code was successfully handled. */
-static int
+/* Report a GnuTLS error to the user.
+ Return true if the error code was successfully handled. */
+static bool
emacs_gnutls_handle_error (gnutls_session_t session, int err)
{
int max_log_level = 0;
- int ret;
+ bool ret;
const char *str;
/* TODO: use a Lisp_Object generated by gnutls_make_error? */
if (err >= 0)
- return 0;
+ return 1;
max_log_level = global_gnutls_log_level;
@@ -418,12 +470,12 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
if (fn_gnutls_error_is_fatal (err))
{
- ret = err;
+ ret = 0;
GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
}
else
{
- ret = 0;
+ ret = 1;
GNUTLS_LOG2 (1, max_log_level, "non-fatal error:", str);
/* TODO: EAGAIN AKA Qgnutls_e_again should be level 2. */
}
@@ -546,7 +598,7 @@ usage: (gnutls-error-fatalp ERROR) */)
}
}
- if (!NUMBERP (err))
+ if (! TYPE_RANGED_INTEGERP (int, err))
error ("Not an error symbol or code");
if (0 == fn_gnutls_error_is_fatal (XINT (err)))
@@ -578,7 +630,7 @@ usage: (gnutls-error-string ERROR) */)
}
}
- if (!NUMBERP (err))
+ if (! TYPE_RANGED_INTEGERP (int, err))
return build_string ("Not an error symbol or code");
return build_string (fn_gnutls_strerror (XINT (err)));
@@ -603,7 +655,7 @@ DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
else
{
Lisp_Object status;
- status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil;
+ status = init_gnutls_functions () ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
return status;
}
@@ -751,7 +803,10 @@ one trustfile (usually a CA bundle). */)
error ("gnutls-boot: invalid :hostname parameter");
c_hostname = SSDATA (hostname);
- if (NUMBERP (loglevel))
+ state = XPROCESS (proc)->gnutls_state;
+ XPROCESS (proc)->gnutls_p = 1;
+
+ if (TYPE_RANGED_INTEGERP (int, loglevel))
{
fn_gnutls_global_set_log_function (gnutls_log_function);
fn_gnutls_global_set_log_level (XINT (loglevel));
@@ -773,7 +828,7 @@ one trustfile (usually a CA bundle). */)
XPROCESS (proc)->gnutls_state = NULL;
XPROCESS (proc)->gnutls_x509_cred = NULL;
XPROCESS (proc)->gnutls_anon_cred = NULL;
- XPROCESS (proc)->gnutls_cred_type = type;
+ pset_gnutls_cred_type (XPROCESS (proc), type);
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
GNUTLS_LOG (1, max_log_level, "allocating credentials");
@@ -814,9 +869,9 @@ one trustfile (usually a CA bundle). */)
int file_format = GNUTLS_X509_FMT_PEM;
Lisp_Object tail;
- for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail))
+ for (tail = trustfiles; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object trustfile = Fcar (tail);
+ Lisp_Object trustfile = XCAR (tail);
if (STRINGP (trustfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
@@ -836,9 +891,9 @@ one trustfile (usually a CA bundle). */)
}
}
- for (tail = crlfiles; !NILP (tail); tail = Fcdr (tail))
+ for (tail = crlfiles; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object crlfile = Fcar (tail);
+ Lisp_Object crlfile = XCAR (tail);
if (STRINGP (crlfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
@@ -856,10 +911,10 @@ one trustfile (usually a CA bundle). */)
}
}
- for (tail = keylist; !NILP (tail); tail = Fcdr (tail))
+ for (tail = keylist; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object keyfile = Fcar (Fcar (tail));
- Lisp_Object certfile = Fcar (Fcdr (tail));
+ Lisp_Object keyfile = Fcar (XCAR (tail));
+ Lisp_Object certfile = Fcar (Fcdr (XCAR (tail)));
if (STRINGP (keyfile) && STRINGP (certfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",
@@ -1108,7 +1163,10 @@ syms_of_gnutls (void)
defsubr (&Sgnutls_available_p);
DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level,
- doc: /* Logging level used by the GnuTLS functions. */);
+ doc: /* Logging level used by the GnuTLS functions.
+Set this larger than 0 to get debug output in the *Messages* buffer.
+1 is for important messages, 2 is for debug data, and higher numbers
+are as per the GnuTLS logging conventions. */);
global_gnutls_log_level = 0;
}
diff --git a/src/gnutls.h b/src/gnutls.h
index 076e9fdba9c..2b13908a748 100644
--- a/src/gnutls.h
+++ b/src/gnutls.h
@@ -1,5 +1,5 @@
/* GnuTLS glue for GNU Emacs.
- Copyright (C) 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2010-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -23,6 +23,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <gnutls/gnutls.h>
#include <gnutls/x509.h>
+/* This limits the attempts to handshake per process (connection). */
+#define GNUTLS_EMACS_HANDSHAKES_LIMIT 100
+
typedef enum
{
/* Initialization stages. */
@@ -53,10 +56,12 @@ typedef enum
#define GNUTLS_LOG2(level, max, string, extra) do { if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); } } while (0)
-extern EMACS_INT
-emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte);
-extern EMACS_INT
-emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte);
+#define GNUTLS_LOG2i(level, max, string, extra) do { if (level <= max) { gnutls_log_function2i (level, "(Emacs) " string, extra); } } while (0)
+
+extern ptrdiff_t
+emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte);
+extern ptrdiff_t
+emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte);
extern int emacs_gnutls_record_check_pending (gnutls_session_t state);
extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
diff --git a/src/gtkutil.c b/src/gtkutil.c
index bc71685819e..4367b534cb9 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -1,6 +1,6 @@
/* Functions for creating and updating GTK widgets.
-Copyright (C) 2003-2011 Free Software Foundation, Inc.
+Copyright (C) 2003-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,9 +21,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef USE_GTK
#include <float.h>
-#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
+
+#include <c-ctype.h>
+
#include "lisp.h"
#include "xterm.h"
#include "blockinput.h"
@@ -75,6 +76,18 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define remove_submenu(w) gtk_menu_item_remove_submenu ((w))
#endif
+#if GTK_MAJOR_VERSION > 3 || (GTK_MAJOR_VERSION == 3 && GTK_MINOR_VERSION >= 2)
+#define USE_NEW_GTK_FONT_CHOOSER 1
+#else
+#define USE_NEW_GTK_FONT_CHOOSER 0
+#define gtk_font_chooser_dialog_new(x, y) \
+ gtk_font_selection_dialog_new (x)
+#undef GTK_FONT_CHOOSER
+#define GTK_FONT_CHOOSER(x) GTK_FONT_SELECTION_DIALOG (x)
+#define gtk_font_chooser_set_font(x, y) \
+ gtk_font_selection_dialog_set_font_name (x, y)
+#endif
+
#ifndef HAVE_GTK3
#ifdef USE_GTK_TOOLTIP
#define gdk_window_get_screen(w) gdk_drawable_get_screen (w)
@@ -83,15 +96,31 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
gdk_window_get_geometry (w, a, b, c, d, 0)
#define gdk_x11_window_lookup_for_display(d, w) \
gdk_xid_table_lookup_for_display (d, w)
+#define gtk_box_new(ori, spacing) \
+ ((ori) == GTK_ORIENTATION_HORIZONTAL \
+ ? gtk_hbox_new (FALSE, (spacing)) : gtk_vbox_new (FALSE, (spacing)))
+#define gtk_scrollbar_new(ori, spacing) \
+ ((ori) == GTK_ORIENTATION_HORIZONTAL \
+ ? gtk_hscrollbar_new ((spacing)) : gtk_vscrollbar_new ((spacing)))
#ifndef GDK_KEY_g
#define GDK_KEY_g GDK_g
#endif
-#endif
+#endif /* HAVE_GTK3 */
#define XG_BIN_CHILD(x) gtk_bin_get_child (GTK_BIN (x))
static void update_theme_scrollbar_width (void);
+#define TB_INFO_KEY "xg_frame_tb_info"
+struct xg_frame_tb_info
+{
+ Lisp_Object last_tool_bar;
+ Lisp_Object style;
+ int n_last_items;
+ int hmargin, vmargin;
+ GtkTextDirection dir;
+};
+
/***********************************************************************
Display handling functions
@@ -209,7 +238,7 @@ malloc_widget_value (void)
}
else
{
- wv = (widget_value *) xmalloc (sizeof (widget_value));
+ wv = xmalloc (sizeof *wv);
malloc_cpt++;
}
memset (wv, 0, sizeof (widget_value));
@@ -223,7 +252,7 @@ void
free_widget_value (widget_value *wv)
{
if (wv->free_list)
- abort ();
+ emacs_abort ();
if (malloc_cpt > 25)
{
@@ -523,9 +552,8 @@ get_utf8_string (const char *str)
&bytes_written, &err))
&& err->code == G_CONVERT_ERROR_ILLEGAL_SEQUENCE)
{
- strncpy (up, (char *)p, bytes_written);
+ memcpy (up, p, bytes_written);
sprintf (up + bytes_written, "\\%03o", p[bytes_written]);
- up[bytes_written+4] = '\0';
up += bytes_written+4;
p += bytes_written+1;
g_error_free (err);
@@ -548,21 +576,21 @@ get_utf8_string (const char *str)
/* Check for special colors used in face spec for region face.
The colors are fetched from the Gtk+ theme.
- Return 1 if color was found, 0 if not. */
+ Return true if color was found, false if not. */
-int
+bool
xg_check_special_colors (struct frame *f,
const char *color_name,
XColor *color)
{
- int success_p = 0;
- int get_bg = strcmp ("gtk_selection_bg_color", color_name) == 0;
- int get_fg = !get_bg && strcmp ("gtk_selection_fg_color", color_name) == 0;
+ bool success_p = 0;
+ bool get_bg = strcmp ("gtk_selection_bg_color", color_name) == 0;
+ bool get_fg = !get_bg && strcmp ("gtk_selection_fg_color", color_name) == 0;
if (! FRAME_GTK_WIDGET (f) || ! (get_bg || get_fg))
return success_p;
- BLOCK_INPUT;
+ block_input ();
{
#ifdef HAVE_GTK3
GtkStyleContext *gsty
@@ -576,8 +604,9 @@ xg_check_special_colors (struct frame *f,
gtk_style_context_get_background_color (gsty, state, &col);
sprintf (buf, "rgbi:%lf/%lf/%lf", col.red, col.green, col.blue);
- success_p = XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
- buf, color);
+ success_p = (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
+ buf, color)
+ != 0);
#else
GtkStyle *gsty = gtk_widget_get_style (FRAME_GTK_WIDGET (f));
GdkColor *grgb = get_bg
@@ -592,7 +621,7 @@ xg_check_special_colors (struct frame *f,
#endif
}
- UNBLOCK_INPUT;
+ unblock_input ();
return success_p;
}
@@ -675,9 +704,9 @@ qttip_cb (GtkWidget *widget,
#endif /* USE_GTK_TOOLTIP */
/* Prepare a tooltip to be shown, i.e. calculate WIDTH and HEIGHT.
- Return zero if no system tooltip available, non-zero otherwise. */
+ Return true if a system tooltip is available. */
-int
+bool
xg_prepare_tooltip (FRAME_PTR f,
Lisp_Object string,
int *width,
@@ -697,7 +726,7 @@ xg_prepare_tooltip (FRAME_PTR f,
if (!x->ttip_lbl) return 0;
- BLOCK_INPUT;
+ block_input ();
encoded_string = ENCODE_UTF_8 (string);
widget = GTK_WIDGET (x->ttip_lbl);
gwin = gtk_widget_get_window (GTK_WIDGET (x->ttip_window));
@@ -725,7 +754,7 @@ xg_prepare_tooltip (FRAME_PTR f,
if (width) *width = req.width;
if (height) *height = req.height;
- UNBLOCK_INPUT;
+ unblock_input ();
return 1;
#endif /* USE_GTK_TOOLTIP */
@@ -741,27 +770,27 @@ xg_show_tooltip (FRAME_PTR f, int root_x, int root_y)
struct x_output *x = f->output_data.x;
if (x->ttip_window)
{
- BLOCK_INPUT;
+ block_input ();
gtk_window_move (x->ttip_window, root_x, root_y);
gtk_widget_show_all (GTK_WIDGET (x->ttip_window));
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif
}
/* Hide tooltip if shown. Do nothing if not shown.
- Return non-zero if tip was hidden, non-zero if not (i.e. not using
+ Return true if tip was hidden, false if not (i.e. not using
system tooltips). */
-int
+bool
xg_hide_tooltip (FRAME_PTR f)
{
- int ret = 0;
+ bool ret = 0;
#ifdef USE_GTK_TOOLTIP
if (f->output_data.x->ttip_window)
{
GtkWindow *win = f->output_data.x->ttip_window;
- BLOCK_INPUT;
+ block_input ();
gtk_widget_hide (GTK_WIDGET (win));
if (g_object_get_data (G_OBJECT (win), "restore-tt"))
@@ -771,7 +800,7 @@ xg_hide_tooltip (FRAME_PTR f)
GtkSettings *settings = gtk_settings_get_for_screen (screen);
g_object_set (settings, "gtk-enable-tooltips", TRUE, NULL);
}
- UNBLOCK_INPUT;
+ unblock_input ();
ret = 1;
}
@@ -979,7 +1008,7 @@ xg_win_to_widget (Display *dpy, Window wdesc)
gpointer gdkwin;
GtkWidget *gwdesc = 0;
- BLOCK_INPUT;
+ block_input ();
gdkwin = gdk_x11_window_lookup_for_display (gdk_x11_lookup_xdisplay (dpy),
wdesc);
@@ -991,7 +1020,7 @@ xg_win_to_widget (Display *dpy, Window wdesc)
gwdesc = gtk_get_event_widget (&event);
}
- UNBLOCK_INPUT;
+ unblock_input ();
return gwdesc;
}
@@ -1006,9 +1035,9 @@ xg_set_widget_bg (FRAME_PTR f, GtkWidget *w, long unsigned int pixel)
xbg.pixel = pixel;
if (XQueryColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), &xbg))
{
- bg.red = (double)xbg.red/65536.0;
- bg.green = (double)xbg.green/65536.0;
- bg.blue = (double)xbg.blue/65536.0;
+ bg.red = (double)xbg.red/65535.0;
+ bg.green = (double)xbg.green/65535.0;
+ bg.blue = (double)xbg.blue/65535.0;
bg.alpha = 1.0;
gtk_widget_override_background_color (w, GTK_STATE_FLAG_NORMAL, &bg);
}
@@ -1082,21 +1111,26 @@ delete_cb (GtkWidget *widget,
}
/* Create and set up the GTK widgets for frame F.
- Return 0 if creation failed, non-zero otherwise. */
+ Return true if creation succeeded. */
-int
+bool
xg_create_frame_widgets (FRAME_PTR f)
{
GtkWidget *wtop;
GtkWidget *wvbox, *whbox;
GtkWidget *wfixed;
+#ifndef HAVE_GTK3
GtkRcStyle *style;
+#endif
char *title = 0;
- BLOCK_INPUT;
+ block_input ();
if (FRAME_X_EMBEDDED_P (f))
- wtop = gtk_plug_new (f->output_data.x->parent_desc);
+ {
+ GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (FRAME_X_DISPLAY (f));
+ wtop = gtk_plug_new_for_display (gdpy, f->output_data.x->parent_desc);
+ }
else
wtop = gtk_window_new (GTK_WINDOW_TOPLEVEL);
@@ -1110,8 +1144,10 @@ xg_create_frame_widgets (FRAME_PTR f)
xg_set_screen (wtop, f);
- wvbox = gtk_vbox_new (FALSE, 0);
- whbox = gtk_hbox_new (FALSE, 0);
+ wvbox = gtk_box_new (GTK_ORIENTATION_VERTICAL, 0);
+ whbox = gtk_box_new (GTK_ORIENTATION_HORIZONTAL, 0);
+ gtk_box_set_homogeneous (GTK_BOX (wvbox), FALSE);
+ gtk_box_set_homogeneous (GTK_BOX (whbox), FALSE);
#ifdef HAVE_GTK3
wfixed = emacs_fixed_new (f);
@@ -1126,7 +1162,7 @@ xg_create_frame_widgets (FRAME_PTR f)
if (whbox) gtk_widget_destroy (whbox);
if (wfixed) gtk_widget_destroy (wfixed);
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
@@ -1136,8 +1172,10 @@ xg_create_frame_widgets (FRAME_PTR f)
gtk_widget_set_name (wfixed, SSDATA (Vx_resource_name));
/* If this frame has a title or name, set it in the title bar. */
- if (! NILP (f->title)) title = SSDATA (ENCODE_UTF_8 (f->title));
- else if (! NILP (f->name)) title = SSDATA (ENCODE_UTF_8 (f->name));
+ if (! NILP (f->title))
+ title = SSDATA (ENCODE_UTF_8 (f->title));
+ else if (! NILP (f->name))
+ title = SSDATA (ENCODE_UTF_8 (f->name));
if (title) gtk_window_set_title (GTK_WINDOW (wtop), title);
@@ -1238,7 +1276,7 @@ xg_create_frame_widgets (FRAME_PTR f)
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return 1;
}
@@ -1251,6 +1289,12 @@ xg_free_frame_widgets (FRAME_PTR f)
#ifdef USE_GTK_TOOLTIP
struct x_output *x = f->output_data.x;
#endif
+ struct xg_frame_tb_info *tbinfo
+ = g_object_get_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)),
+ TB_INFO_KEY);
+ if (tbinfo)
+ xfree (tbinfo);
+
gtk_widget_destroy (FRAME_GTK_OUTER_WIDGET (f));
FRAME_X_WINDOW (f) = 0; /* Set to avoid XDestroyWindow in xterm.c */
FRAME_GTK_OUTER_WIDGET (f) = 0;
@@ -1266,11 +1310,11 @@ xg_free_frame_widgets (FRAME_PTR f)
/* Set the normal size hints for the window manager, for frame F.
FLAGS is the flags word to use--or 0 meaning preserve the flags
that the window now has.
- If USER_POSITION is nonzero, we set the User Position
+ If USER_POSITION, set the User Position
flag (this is useful when FLAGS is 0). */
void
-x_wm_set_size_hint (FRAME_PTR f, long int flags, int user_position)
+x_wm_set_size_hint (FRAME_PTR f, long int flags, bool user_position)
{
/* Must use GTK routines here, otherwise GTK resets the size hints
to its own defaults. */
@@ -1303,11 +1347,15 @@ x_wm_set_size_hint (FRAME_PTR f, long int flags, int user_position)
size_hints.height_inc = FRAME_LINE_HEIGHT (f);
hint_flags |= GDK_HINT_BASE_SIZE;
- base_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 0) + FRAME_TOOLBAR_WIDTH (f);
- base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 0)
+ /* Use one row/col here so base_height/width does not become zero.
+ Gtk+ and/or Unity on Ubuntu 12.04 can't handle it. */
+ base_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 1) + FRAME_TOOLBAR_WIDTH (f);
+ base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 1)
+ FRAME_MENUBAR_HEIGHT (f) + FRAME_TOOLBAR_HEIGHT (f);
check_frame_size (f, &min_rows, &min_cols);
+ if (min_cols > 0) --min_cols; /* We used one col in base_width = ... 1); */
+ if (min_rows > 0) --min_rows; /* We used one row in base_height = ... 1); */
size_hints.base_width = base_width;
size_hints.base_height = base_height;
@@ -1350,12 +1398,12 @@ x_wm_set_size_hint (FRAME_PTR f, long int flags, int user_position)
&f->output_data.x->size_hints,
sizeof (size_hints)) != 0)
{
- BLOCK_INPUT;
+ block_input ();
gtk_window_set_geometry_hints (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
NULL, &size_hints, hint_flags);
f->output_data.x->size_hints = size_hints;
f->output_data.x->hint_flags = hint_flags;
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -1370,9 +1418,9 @@ xg_set_background_color (FRAME_PTR f, long unsigned int bg)
{
if (FRAME_GTK_WIDGET (f))
{
- BLOCK_INPUT;
+ block_input ();
xg_set_widget_bg (f, FRAME_GTK_WIDGET (f), FRAME_BACKGROUND_PIXEL (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -1472,7 +1520,7 @@ create_dialog (widget_value *wv,
/* If the number of buttons is greater than 4, make two rows of buttons
instead. This looks better. */
- int make_two_rows = total_buttons > 4;
+ bool make_two_rows = total_buttons > 4;
if (right_buttons == 0) right_buttons = total_buttons/2;
left_buttons = total_buttons - right_buttons;
@@ -1483,9 +1531,12 @@ create_dialog (widget_value *wv,
if (make_two_rows)
{
- GtkWidget *wvbox = gtk_vbox_new (TRUE, button_spacing);
- GtkWidget *whbox_up = gtk_hbox_new (FALSE, 0);
- whbox_down = gtk_hbox_new (FALSE, 0);
+ GtkWidget *wvbox = gtk_box_new (GTK_ORIENTATION_VERTICAL, button_spacing);
+ GtkWidget *whbox_up = gtk_box_new (GTK_ORIENTATION_HORIZONTAL, 0);
+ gtk_box_set_homogeneous (GTK_BOX (wvbox), TRUE);
+ gtk_box_set_homogeneous (GTK_BOX (whbox_up), FALSE);
+ whbox_down = gtk_box_new (GTK_ORIENTATION_HORIZONTAL, 0);
+ gtk_box_set_homogeneous (GTK_BOX (whbox_down), FALSE);
gtk_box_pack_start (cur_box, wvbox, FALSE, FALSE, 0);
gtk_box_pack_start (GTK_BOX (wvbox), whbox_up, FALSE, FALSE, 0);
@@ -1587,14 +1638,14 @@ pop_down_dialog (Lisp_Object arg)
struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
struct xg_dialog_data *dd = (struct xg_dialog_data *) p->pointer;
- BLOCK_INPUT;
+ block_input ();
if (dd->w) gtk_widget_destroy (dd->w);
if (dd->timerid != 0) g_source_remove (dd->timerid);
g_main_loop_quit (dd->loop);
g_main_loop_unref (dd->loop);
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
@@ -1607,16 +1658,16 @@ xg_maybe_add_timer (gpointer data)
{
struct xg_dialog_data *dd = (struct xg_dialog_data *) data;
EMACS_TIME next_time = timer_check ();
- long secs = EMACS_SECS (next_time);
- long usecs = EMACS_USECS (next_time);
dd->timerid = 0;
- if (secs >= 0 && usecs >= 0 && secs < ((guint)-1)/1000)
+ if (EMACS_TIME_VALID_P (next_time))
{
- dd->timerid = g_timeout_add (secs * 1000 + usecs/1000,
- xg_maybe_add_timer,
- dd);
+ time_t s = EMACS_SECS (next_time);
+ int per_ms = EMACS_TIME_RESOLUTION / 1000;
+ int ms = (EMACS_NSECS (next_time) + per_ms - 1) / per_ms;
+ if (s <= ((guint) -1 - ms) / 1000)
+ dd->timerid = g_timeout_add (s * 1000 + ms, xg_maybe_add_timer, dd);
}
return FALSE;
}
@@ -1629,7 +1680,7 @@ xg_maybe_add_timer (gpointer data)
static int
xg_dialog_run (FRAME_PTR f, GtkWidget *w)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct xg_dialog_data dd;
xg_set_screen (w, f);
@@ -1666,10 +1717,9 @@ xg_dialog_run (FRAME_PTR f, GtkWidget *w)
/***********************************************************************
File dialog functions
***********************************************************************/
-/* Return non-zero if the old file selection dialog is being used.
- Return zero if not. */
+/* Return true if the old file selection dialog is being used. */
-int
+bool
xg_uses_old_file_dialog (void)
{
#ifdef HAVE_GTK_FILE_SELECTION_NEW
@@ -1740,9 +1790,10 @@ xg_toggle_notify_cb (GObject *gobject, GParamSpec *arg1, gpointer user_data)
F is the current frame.
PROMPT is a prompt to show to the user. May not be NULL.
DEFAULT_FILENAME is a default selection to be displayed. May be NULL.
- If MUSTMATCH_P is non-zero, the returned file name must be an existing
- file. *FUNC is set to a function that can be used to retrieve the
- selected file name from the returned widget.
+ If MUSTMATCH_P, the returned file name must be an existing
+ file. (Actually, this only has cosmetic effects, the user can
+ still enter a non-existing file.) *FUNC is set to a function that
+ can be used to retrieve the selected file name from the returned widget.
Returns the created widget. */
@@ -1750,7 +1801,7 @@ static GtkWidget *
xg_get_file_with_chooser (FRAME_PTR f,
char *prompt,
char *default_filename,
- int mustmatch_p, int only_dir_p,
+ bool mustmatch_p, bool only_dir_p,
xg_get_file_func *func)
{
char msgbuf[1024];
@@ -1772,7 +1823,8 @@ xg_get_file_with_chooser (FRAME_PTR f,
NULL);
gtk_file_chooser_set_local_only (GTK_FILE_CHOOSER (filewin), TRUE);
- wbox = gtk_vbox_new (FALSE, 0);
+ wbox = gtk_box_new (GTK_ORIENTATION_VERTICAL, 0);
+ gtk_box_set_homogeneous (GTK_BOX (wbox), FALSE);
gtk_widget_show (wbox);
wtoggle = gtk_check_button_new_with_label ("Show hidden files.");
@@ -1861,7 +1913,7 @@ xg_get_file_name_from_selector (GtkWidget *w)
F is the current frame.
PROMPT is a prompt to show to the user. May not be NULL.
DEFAULT_FILENAME is a default selection to be displayed. May be NULL.
- If MUSTMATCH_P is non-zero, the returned file name must be an existing
+ If MUSTMATCH_P, the returned file name must be an existing
file. *FUNC is set to a function that can be used to retrieve the
selected file name from the returned widget.
@@ -1871,7 +1923,7 @@ static GtkWidget *
xg_get_file_with_selection (FRAME_PTR f,
char *prompt,
char *default_filename,
- int mustmatch_p, int only_dir_p,
+ bool mustmatch_p, bool only_dir_p,
xg_get_file_func *func)
{
GtkWidget *filewin;
@@ -1903,7 +1955,7 @@ xg_get_file_with_selection (FRAME_PTR f,
F is the current frame.
PROMPT is a prompt to show to the user. May not be NULL.
DEFAULT_FILENAME is a default selection to be displayed. May be NULL.
- If MUSTMATCH_P is non-zero, the returned file name must be an existing
+ If MUSTMATCH_P, the returned file name must be an existing
file.
Returns a file name or NULL if no file was selected.
@@ -1913,21 +1965,14 @@ char *
xg_get_file_name (FRAME_PTR f,
char *prompt,
char *default_filename,
- int mustmatch_p,
- int only_dir_p)
+ bool mustmatch_p,
+ bool only_dir_p)
{
GtkWidget *w = 0;
char *fn = 0;
int filesel_done = 0;
xg_get_file_func func;
-#if defined (HAVE_PTHREAD) && defined (__SIGRTMIN)
- /* I really don't know why this is needed, but without this the GLIBC add on
- library linuxthreads hangs when the Gnome file chooser backend creates
- threads. */
- sigblock (sigmask (__SIGRTMIN));
-#endif /* HAVE_PTHREAD */
-
#ifdef HAVE_GTK_FILE_SELECTION_NEW
if (xg_uses_old_file_dialog ())
@@ -1945,11 +1990,6 @@ xg_get_file_name (FRAME_PTR f,
gtk_widget_set_name (w, "emacs-filedialog");
filesel_done = xg_dialog_run (f, w);
-
-#if defined (HAVE_PTHREAD) && defined (__SIGRTMIN)
- sigunblock (sigmask (__SIGRTMIN));
-#endif
-
if (filesel_done == GTK_RESPONSE_OK)
fn = (*func) (w);
@@ -1957,7 +1997,35 @@ xg_get_file_name (FRAME_PTR f,
return fn;
}
+/***********************************************************************
+ GTK font chooser
+ ***********************************************************************/
+
#ifdef HAVE_FREETYPE
+
+#if USE_NEW_GTK_FONT_CHOOSER
+
+#define XG_WEIGHT_TO_SYMBOL(w) \
+ (w <= PANGO_WEIGHT_THIN ? Qextra_light \
+ : w <= PANGO_WEIGHT_ULTRALIGHT ? Qlight \
+ : w <= PANGO_WEIGHT_LIGHT ? Qsemi_light \
+ : w < PANGO_WEIGHT_MEDIUM ? Qnormal \
+ : w <= PANGO_WEIGHT_SEMIBOLD ? Qsemi_bold \
+ : w <= PANGO_WEIGHT_BOLD ? Qbold \
+ : w <= PANGO_WEIGHT_HEAVY ? Qextra_bold \
+ : Qultra_bold)
+
+#define XG_STYLE_TO_SYMBOL(s) \
+ (s == PANGO_STYLE_OBLIQUE ? Qoblique \
+ : s == PANGO_STYLE_ITALIC ? Qitalic \
+ : Qnormal)
+
+#endif /* USE_NEW_GTK_FONT_CHOOSER */
+
+
+static char *x_last_font_name;
+extern Lisp_Object Qxft;
+
/* Pop up a GTK font selector and return the name of the font the user
selects, as a C string. The returned font name follows GTK's own
format:
@@ -1967,37 +2035,90 @@ xg_get_file_name (FRAME_PTR f,
This can be parsed using font_parse_fcname in font.c.
DEFAULT_NAME, if non-zero, is the default font name. */
-char *
-xg_get_font_name (FRAME_PTR f, const char *default_name)
+Lisp_Object
+xg_get_font (FRAME_PTR f, const char *default_name)
{
GtkWidget *w;
- char *fontname = NULL;
int done = 0;
+ Lisp_Object font = Qnil;
-#if defined (HAVE_PTHREAD) && defined (__SIGRTMIN)
- sigblock (sigmask (__SIGRTMIN));
-#endif /* HAVE_PTHREAD */
+ w = gtk_font_chooser_dialog_new
+ ("Pick a font", GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)));
- w = gtk_font_selection_dialog_new ("Pick a font");
- if (!default_name)
- default_name = "Monospace 10";
- gtk_font_selection_dialog_set_font_name (GTK_FONT_SELECTION_DIALOG (w),
- default_name);
+ if (default_name)
+ {
+ /* Convert fontconfig names to Gtk names, i.e. remove - before
+ number */
+ char *p = strrchr (default_name, '-');
+ if (p)
+ {
+ char *ep = p+1;
+ while (c_isdigit (*ep))
+ ++ep;
+ if (*ep == '\0') *p = ' ';
+ }
+ }
+ else if (x_last_font_name)
+ default_name = x_last_font_name;
- gtk_widget_set_name (w, "emacs-fontdialog");
+ if (default_name)
+ gtk_font_chooser_set_font (GTK_FONT_CHOOSER (w), default_name);
+ gtk_widget_set_name (w, "emacs-fontdialog");
done = xg_dialog_run (f, w);
+ if (done == GTK_RESPONSE_OK)
+ {
+#if USE_NEW_GTK_FONT_CHOOSER
+ /* Use the GTK3 font chooser. */
+ PangoFontDescription *desc
+ = gtk_font_chooser_get_font_desc (GTK_FONT_CHOOSER (w));
-#if defined (HAVE_PTHREAD) && defined (__SIGRTMIN)
- sigunblock (sigmask (__SIGRTMIN));
-#endif
+ if (desc)
+ {
+ Lisp_Object args[10];
+ const char *name = pango_font_description_get_family (desc);
+ gint size = pango_font_description_get_size (desc);
+ PangoWeight weight = pango_font_description_get_weight (desc);
+ PangoStyle style = pango_font_description_get_style (desc);
- if (done == GTK_RESPONSE_OK)
- fontname = gtk_font_selection_dialog_get_font_name
- (GTK_FONT_SELECTION_DIALOG (w));
+ args[0] = QCname;
+ args[1] = build_string (name);
+
+ args[2] = QCsize;
+ args[3] = make_float (pango_units_to_double (size));
+
+ args[4] = QCweight;
+ args[5] = XG_WEIGHT_TO_SYMBOL (weight);
+
+ args[6] = QCslant;
+ args[7] = XG_STYLE_TO_SYMBOL (style);
+
+ args[8] = QCtype;
+ args[9] = Qxft;
+
+ font = Ffont_spec (8, args);
+
+ pango_font_description_free (desc);
+ xfree (x_last_font_name);
+ x_last_font_name = xstrdup (name);
+ }
+
+#else /* Use old font selector, which just returns the font name. */
+
+ char *font_name
+ = gtk_font_selection_dialog_get_font_name (GTK_FONT_CHOOSER (w));
+
+ if (font_name)
+ {
+ font = build_string (font_name);
+ g_free (x_last_font_name);
+ x_last_font_name = font_name;
+ }
+#endif /* USE_NEW_GTK_FONT_CHOOSER */
+ }
gtk_widget_destroy (w);
- return fontname;
+ return font;
}
#endif /* HAVE_FREETYPE */
@@ -2037,7 +2158,7 @@ make_cl_data (xg_menu_cb_data *cl_data, FRAME_PTR f, GCallback highlight_cb)
{
if (! cl_data)
{
- cl_data = (xg_menu_cb_data*) xmalloc (sizeof (*cl_data));
+ cl_data = xmalloc (sizeof *cl_data);
cl_data->f = f;
cl_data->menu_bar_vector = f->menu_bar_vector;
cl_data->menu_bar_items_used = f->menu_bar_items_used;
@@ -2100,6 +2221,7 @@ void
xg_mark_data (void)
{
xg_list_node *iter;
+ Lisp_Object rest, frame;
for (iter = xg_menu_cb_list.next; iter; iter = iter->next)
mark_object (((xg_menu_cb_data *) iter)->menu_bar_vector);
@@ -2111,6 +2233,23 @@ xg_mark_data (void)
if (! NILP (cb_data->help))
mark_object (cb_data->help);
}
+
+ FOR_EACH_FRAME (rest, frame)
+ {
+ FRAME_PTR f = XFRAME (frame);
+
+ if (FRAME_X_P (f) && FRAME_GTK_OUTER_WIDGET (f))
+ {
+ struct xg_frame_tb_info *tbinfo
+ = g_object_get_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)),
+ TB_INFO_KEY);
+ if (tbinfo)
+ {
+ mark_object (tbinfo->last_tool_bar);
+ mark_object (tbinfo->style);
+ }
+ }
+ }
}
@@ -2184,7 +2323,8 @@ make_widget_for_menu_item (const char *utf8_label, const char *utf8_key)
GtkWidget *wkey;
GtkWidget *wbox;
- wbox = gtk_hbox_new (FALSE, 0);
+ wbox = gtk_box_new (GTK_ORIENTATION_HORIZONTAL, 0);
+ gtk_box_set_homogeneous (GTK_BOX (wbox), FALSE);
wlbl = gtk_label_new (utf8_label);
wkey = gtk_label_new (utf8_key);
@@ -2263,9 +2403,9 @@ make_menu_item (const char *utf8_label,
static int xg_detached_menus;
-/* Returns non-zero if there are detached menus. */
+/* Return true if there are detached menus. */
-int
+bool
xg_have_tear_offs (void)
{
return xg_detached_menus > 0;
@@ -2336,7 +2476,7 @@ xg_create_one_menuitem (widget_value *item,
if (utf8_label) g_free (utf8_label);
if (utf8_key) g_free (utf8_key);
- cb_data = xmalloc (sizeof (xg_menu_item_cb_data));
+ cb_data = xmalloc (sizeof *cb_data);
xg_list_insert (&xg_menu_item_cb_list, &cb_data->ptrs);
@@ -2369,10 +2509,9 @@ xg_create_one_menuitem (widget_value *item,
SELECT_CB is the callback to use when a menu item is selected.
DEACTIVATE_CB is the callback to use when a sub menu is not shown anymore.
HIGHLIGHT_CB is the callback to call when entering/leaving menu items.
- POP_UP_P is non-zero if we shall create a popup menu.
- MENU_BAR_P is non-zero if we shall create a menu bar.
- ADD_TEAROFF_P is non-zero if we shall add a tearoff menu item. Ignored
- if MENU_BAR_P is non-zero.
+ If POP_UP_P, create a popup menu.
+ If MENU_BAR_P, create a menu bar.
+ If ADD_TEAROFF_P, add a tearoff menu item. Ignored if MENU_BAR_P.
TOPMENU is the topmost GtkWidget that others shall be placed under.
It may be NULL, in that case we create the appropriate widget
(menu bar or menu item depending on POP_UP_P and MENU_BAR_P)
@@ -2392,9 +2531,9 @@ create_menus (widget_value *data,
GCallback select_cb,
GCallback deactivate_cb,
GCallback highlight_cb,
- int pop_up_p,
- int menu_bar_p,
- int add_tearoff_p,
+ bool pop_up_p,
+ bool menu_bar_p,
+ bool add_tearoff_p,
GtkWidget *topmenu,
xg_menu_cb_data *cl_data,
const char *name)
@@ -2534,8 +2673,8 @@ xg_create_widget (const char *type, const char *name, FRAME_PTR f, widget_value
GCallback highlight_cb)
{
GtkWidget *w = 0;
- int menu_bar_p = strcmp (type, "menubar") == 0;
- int pop_up_p = strcmp (type, "popup") == 0;
+ bool menu_bar_p = strcmp (type, "menubar") == 0;
+ bool pop_up_p = strcmp (type, "popup") == 0;
if (strcmp (type, "dialog") == 0)
{
@@ -2588,12 +2727,12 @@ xg_get_menu_item_label (GtkMenuItem *witem)
return gtk_label_get_label (wlabel);
}
-/* Return non-zero if the menu item WITEM has the text LABEL. */
+/* Return true if the menu item WITEM has the text LABEL. */
-static int
+static bool
xg_item_label_same_p (GtkMenuItem *witem, const char *label)
{
- int is_same = 0;
+ bool is_same = 0;
char *utf8_label = get_utf8_string (label);
const char *old_label = witem ? xg_get_menu_item_label (witem) : 0;
@@ -2684,8 +2823,8 @@ xg_update_menubar (GtkWidget *menubar,
{
GtkMenuItem *witem = GTK_MENU_ITEM (iter->data);
GtkMenuItem *witem2 = 0;
- int val_in_menubar = 0;
- int iter_in_new_menubar = 0;
+ bool val_in_menubar = 0;
+ bool iter_in_new_menubar = 0;
GList *iter2;
widget_value *cur;
@@ -2841,7 +2980,7 @@ xg_update_menu_item (widget_value *val,
utf8_key = get_utf8_string (val->key);
/* See if W is a menu item with a key. See make_menu_item above. */
- if (GTK_IS_HBOX (wchild))
+ if (GTK_IS_BOX (wchild))
{
GList *list = gtk_container_get_children (GTK_CONTAINER (wchild));
@@ -2963,7 +3102,7 @@ xg_update_submenu (GtkWidget *submenu,
GList *list = 0;
GList *iter;
widget_value *cur;
- int has_tearoff_p = 0;
+ bool has_tearoff_p = 0;
GList *first_radio = 0;
if (submenu)
@@ -3052,7 +3191,7 @@ xg_update_submenu (GtkWidget *submenu,
}
}
- /* Remove widgets from first structual change. */
+ /* Remove widgets from first structural change. */
if (iter)
{
/* If we are adding new menu items below, we must remove from
@@ -3085,7 +3224,7 @@ xg_update_submenu (GtkWidget *submenu,
/* Update the MENUBAR.
F is the frame the menu bar belongs to.
VAL describes the contents of the menu bar.
- If DEEP_P is non-zero, rebuild all but the top level menu names in
+ If DEEP_P, rebuild all but the top level menu names in
the MENUBAR. If DEEP_P is zero, just rebuild the names in the menubar.
SELECT_CB is the callback to use when a menu item is selected.
DEACTIVATE_CB is the callback to use when a sub menu is not shown anymore.
@@ -3093,7 +3232,7 @@ xg_update_submenu (GtkWidget *submenu,
void
xg_modify_menubar_widgets (GtkWidget *menubar, FRAME_PTR f, widget_value *val,
- int deep_p,
+ bool deep_p,
GCallback select_cb, GCallback deactivate_cb,
GCallback highlight_cb)
{
@@ -3177,21 +3316,21 @@ menubar_map_cb (GtkWidget *w, gpointer user_data)
}
/* Recompute all the widgets of frame F, when the menu bar has been
- changed. Value is non-zero if widgets were updated. */
+ changed. */
-int
+void
xg_update_frame_menubar (FRAME_PTR f)
{
struct x_output *x = f->output_data.x;
GtkRequisition req;
if (!x->menubar_widget || gtk_widget_get_mapped (x->menubar_widget))
- return 0;
+ return;
if (x->menubar_widget && gtk_widget_get_parent (x->menubar_widget))
- return 0; /* Already done this, happens for frames created invisible. */
+ return; /* Already done this, happens for frames created invisible. */
- BLOCK_INPUT;
+ block_input ();
gtk_box_pack_start (GTK_BOX (x->vbox_widget), x->menubar_widget,
FALSE, FALSE, 0);
@@ -3211,9 +3350,7 @@ xg_update_frame_menubar (FRAME_PTR f)
FRAME_MENUBAR_HEIGHT (f) = req.height;
xg_height_or_width_changed (f);
}
- UNBLOCK_INPUT;
-
- return 1;
+ unblock_input ();
}
/* Get rid of the menu bar of frame F, and free its storage.
@@ -3226,7 +3363,7 @@ free_frame_menubar (FRAME_PTR f)
if (x->menubar_widget)
{
- BLOCK_INPUT;
+ block_input ();
gtk_container_remove (GTK_CONTAINER (x->vbox_widget), x->menubar_widget);
/* The menubar and its children shall be deleted when removed from
@@ -3234,11 +3371,11 @@ free_frame_menubar (FRAME_PTR f)
x->menubar_widget = 0;
FRAME_MENUBAR_HEIGHT (f) = 0;
xg_height_or_width_changed (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
-int
+bool
xg_event_is_for_menubar (FRAME_PTR f, XEvent *event)
{
struct x_output *x = f->output_data.x;
@@ -3285,7 +3422,7 @@ xg_event_is_for_menubar (FRAME_PTR f, XEvent *event)
break;
}
g_list_free (list);
- return iter == 0 ? 0 : 1;
+ return iter != 0;
}
@@ -3298,7 +3435,7 @@ xg_event_is_for_menubar (FRAME_PTR f, XEvent *event)
/* Setting scroll bar values invokes the callback. Use this variable
to indicate that callback should do nothing. */
-int xg_ignore_gtk_scrollbar;
+bool xg_ignore_gtk_scrollbar;
/* The width of the scroll bar for the current theme. */
@@ -3356,7 +3493,7 @@ xg_store_widget_in_map (GtkWidget *w)
}
/* Should never end up here */
- abort ();
+ emacs_abort ();
}
/* Remove pointer at IDX from id_to_widget.
@@ -3395,7 +3532,7 @@ update_theme_scrollbar_width (void)
int w = 0, b = 0;
vadj = gtk_adjustment_new (XG_SB_MIN, XG_SB_MIN, XG_SB_MAX, 0.1, 0.1, 0.1);
- wscroll = gtk_vscrollbar_new (GTK_ADJUSTMENT (vadj));
+ wscroll = gtk_scrollbar_new (GTK_ORIENTATION_VERTICAL, GTK_ADJUSTMENT (vadj));
g_object_ref_sink (G_OBJECT (wscroll));
gtk_widget_style_get (wscroll, "slider-width", &w, "trough-border", &b, NULL);
gtk_widget_destroy (wscroll);
@@ -3472,7 +3609,7 @@ xg_create_scroll_bar (FRAME_PTR f,
vadj = gtk_adjustment_new (XG_SB_MIN, XG_SB_MIN, XG_SB_MAX,
0.1, 0.1, 0.1);
- wscroll = gtk_vscrollbar_new (GTK_ADJUSTMENT (vadj));
+ wscroll = gtk_scrollbar_new (GTK_ORIENTATION_VERTICAL, GTK_ADJUSTMENT (vadj));
webox = gtk_event_box_new ();
gtk_widget_set_name (wscroll, scroll_bar_name);
#ifndef HAVE_GTK3
@@ -3624,7 +3761,7 @@ xg_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar,
int size, value;
int old_size;
int new_step;
- int changed = 0;
+ bool changed = 0;
adj = gtk_range_get_adjustment (GTK_RANGE (wscroll));
@@ -3671,7 +3808,7 @@ xg_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar,
if (changed || int_gtk_range_get_value (GTK_RANGE (wscroll)) != value)
{
- BLOCK_INPUT;
+ block_input ();
/* gtk_range_set_value invokes the callback. Set
ignore_gtk_scrollbar to make the callback do nothing */
@@ -3684,29 +3821,34 @@ xg_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar,
xg_ignore_gtk_scrollbar = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
}
-/* Return non-zero if EVENT is for a scroll bar in frame F.
+/* Return true if EVENT is for a scroll bar in frame F.
When the same X window is used for several Gtk+ widgets, we cannot
say for sure based on the X window alone if an event is for the
- frame. This function does additional checks.
-
- Return non-zero if the event is for a scroll bar, zero otherwise. */
+ frame. This function does additional checks. */
-int
+bool
xg_event_is_for_scrollbar (FRAME_PTR f, XEvent *event)
{
- int retval = 0;
+ bool retval = 0;
if (f && event->type == ButtonPress && event->xbutton.button < 4)
{
/* Check if press occurred outside the edit widget. */
GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (FRAME_X_DISPLAY (f));
- retval = gdk_display_get_window_at_pointer (gdpy, NULL, NULL)
- != gtk_widget_get_window (f->output_data.x->edit_widget);
+ GdkWindow *gwin;
+#ifdef HAVE_GTK3
+ GdkDevice *gdev = gdk_device_manager_get_client_pointer
+ (gdk_display_get_device_manager (gdpy));
+ gwin = gdk_device_get_window_at_position (gdev, NULL, NULL);
+#else
+ gwin = gdk_display_get_window_at_pointer (gdpy, NULL, NULL);
+#endif
+ retval = gwin != gtk_widget_get_window (f->output_data.x->edit_widget);
}
else if (f
&& ((event->type == ButtonRelease && event->xbutton.button < 4)
@@ -3917,7 +4059,7 @@ xg_tool_bar_menu_proxy (GtkToolItem *toolitem, gpointer user_data)
else
{
fprintf (stderr, "internal error: GTK_IMAGE_PIXBUF failed\n");
- abort ();
+ emacs_abort ();
}
}
else if (store_type == GTK_IMAGE_ICON_NAME)
@@ -3932,7 +4074,7 @@ xg_tool_bar_menu_proxy (GtkToolItem *toolitem, gpointer user_data)
else
{
fprintf (stderr, "internal error: store_type is %d\n", store_type);
- abort ();
+ emacs_abort ();
}
}
if (wmenuimage)
@@ -4123,7 +4265,7 @@ static void
xg_pack_tool_bar (FRAME_PTR f, Lisp_Object pos)
{
struct x_output *x = f->output_data.x;
- int into_hbox = EQ (pos, Qleft) || EQ (pos, Qright);
+ bool into_hbox = EQ (pos, Qleft) || EQ (pos, Qright);
toolbar_set_orientation (x->toolbar_widget,
into_hbox
@@ -4155,7 +4297,7 @@ xg_pack_tool_bar (FRAME_PTR f, Lisp_Object pos)
}
else
{
- int vbox_pos = x->menubar_widget ? 1 : 0;
+ bool vbox_pos = x->menubar_widget != 0;
gtk_handle_box_set_handle_position (GTK_HANDLE_BOX (x->handlebox_widget),
GTK_POS_LEFT);
gtk_box_pack_start (GTK_BOX (x->vbox_widget), x->handlebox_widget,
@@ -4175,6 +4317,24 @@ static void
xg_create_tool_bar (FRAME_PTR f)
{
struct x_output *x = f->output_data.x;
+#if GTK_CHECK_VERSION (3, 3, 6)
+ GtkStyleContext *gsty;
+#endif
+ struct xg_frame_tb_info *tbinfo
+ = g_object_get_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)),
+ TB_INFO_KEY);
+ if (! tbinfo)
+ {
+ tbinfo = xmalloc (sizeof (*tbinfo));
+ tbinfo->last_tool_bar = Qnil;
+ tbinfo->style = Qnil;
+ tbinfo->hmargin = tbinfo->vmargin = 0;
+ tbinfo->dir = GTK_TEXT_DIR_NONE;
+ tbinfo->n_last_items = 0;
+ g_object_set_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)),
+ TB_INFO_KEY,
+ tbinfo);
+ }
x->toolbar_widget = gtk_toolbar_new ();
x->toolbar_detached = 0;
@@ -4183,6 +4343,10 @@ xg_create_tool_bar (FRAME_PTR f)
gtk_toolbar_set_style (GTK_TOOLBAR (x->toolbar_widget), GTK_TOOLBAR_ICONS);
toolbar_set_orientation (x->toolbar_widget, GTK_ORIENTATION_HORIZONTAL);
+#if GTK_CHECK_VERSION (3, 3, 6)
+ gsty = gtk_widget_get_style_context (x->toolbar_widget);
+ gtk_style_context_add_class (gsty, "primary-toolbar");
+#endif
}
@@ -4208,7 +4372,7 @@ find_rtl_image (FRAME_PTR f, Lisp_Object image, Lisp_Object rtl)
{
file = call1 (intern ("file-name-sans-extension"),
Ffile_name_nondirectory (file));
- if (EQ (Fequal (file, rtl_name), Qt))
+ if (! NILP (Fequal (file, rtl_name)))
{
image = rtl_image;
break;
@@ -4224,13 +4388,34 @@ xg_make_tool_item (FRAME_PTR f,
GtkWidget *wimage,
GtkWidget **wbutton,
const char *label,
- int i, int horiz, int text_image)
+ int i, bool horiz, bool text_image)
{
GtkToolItem *ti = gtk_tool_item_new ();
- GtkWidget *vb = horiz ? gtk_hbox_new (FALSE, 0) : gtk_vbox_new (FALSE, 0);
+ GtkWidget *vb = gtk_box_new (horiz
+ ? GTK_ORIENTATION_HORIZONTAL
+ : GTK_ORIENTATION_VERTICAL,
+ 0);
GtkWidget *wb = gtk_button_new ();
/* The eventbox is here so we can have tooltips on disabled items. */
GtkWidget *weventbox = gtk_event_box_new ();
+#if GTK_CHECK_VERSION (3, 3, 6)
+ GtkCssProvider *css_prov = gtk_css_provider_new ();
+ GtkStyleContext *gsty;
+
+ gtk_css_provider_load_from_data (css_prov,
+ "GtkEventBox {"
+ " background-color: transparent;"
+ "}",
+ -1, NULL);
+
+ gsty = gtk_widget_get_style_context (weventbox);
+ gtk_style_context_add_provider (gsty,
+ GTK_STYLE_PROVIDER (css_prov),
+ GTK_STYLE_PROVIDER_PRIORITY_USER);
+ g_object_unref (css_prov);
+#endif
+
+ gtk_box_set_homogeneous (GTK_BOX (vb), FALSE);
if (wimage && !text_image)
gtk_box_pack_start (GTK_BOX (vb), wimage, TRUE, TRUE, 0);
@@ -4283,7 +4468,6 @@ xg_make_tool_item (FRAME_PTR f,
rather than the GtkButton specific signals "enter" and
"leave", so we can have only one callback. The event
will tell us what kind of event it is. */
- /* The EMACS_INT cast avoids a warning. */
g_signal_connect (G_OBJECT (weventbox),
"enter-notify-event",
G_CALLBACK (xg_tool_bar_help_callback),
@@ -4299,10 +4483,28 @@ xg_make_tool_item (FRAME_PTR f,
return ti;
}
-static int
+static bool
+is_box_type (GtkWidget *vb, bool is_horizontal)
+{
+#ifdef HAVE_GTK3
+ bool ret = 0;
+ if (GTK_IS_BOX (vb))
+ {
+ GtkOrientation ori = gtk_orientable_get_orientation (GTK_ORIENTABLE (vb));
+ ret = (ori == GTK_ORIENTATION_HORIZONTAL && is_horizontal)
+ || (ori == GTK_ORIENTATION_VERTICAL && ! is_horizontal);
+ }
+ return ret;
+#else
+ return is_horizontal ? GTK_IS_VBOX (vb) : GTK_IS_HBOX (vb);
+#endif
+}
+
+
+static bool
xg_tool_item_stale_p (GtkWidget *wbutton, const char *stock_name,
const char *icon_name, const struct image *img,
- const char *label, int horiz)
+ const char *label, bool horiz)
{
gpointer old;
GtkWidget *wimage;
@@ -4327,14 +4529,14 @@ xg_tool_item_stale_p (GtkWidget *wbutton, const char *stock_name,
else if (wimage)
{
gpointer gold_img = g_object_get_data (G_OBJECT (wimage),
- XG_TOOL_BAR_IMAGE_DATA);
+ XG_TOOL_BAR_IMAGE_DATA);
Pixmap old_img = (Pixmap) gold_img;
if (old_img != img->pixmap)
return 1;
}
/* Check button configuration and label. */
- if ((horiz ? GTK_IS_VBOX (vb) : GTK_IS_HBOX (vb))
+ if (is_box_type (vb, horiz)
|| (label ? (wlbl == NULL) : (wlbl != NULL)))
return 1;
@@ -4344,7 +4546,7 @@ xg_tool_item_stale_p (GtkWidget *wbutton, const char *stock_name,
return 0;
}
-static int
+static bool
xg_update_tool_bar_sizes (FRAME_PTR f)
{
struct x_output *x = f->output_data.x;
@@ -4400,29 +4602,27 @@ update_frame_tool_bar (FRAME_PTR f)
GtkToolbar *wtoolbar;
GtkToolItem *ti;
GtkTextDirection dir;
- int pack_tool_bar = x->handlebox_widget == NULL;
+ bool pack_tool_bar = x->handlebox_widget == NULL;
Lisp_Object style;
- int text_image, horiz;
+ bool text_image, horiz;
+ struct xg_frame_tb_info *tbinfo;
if (! FRAME_GTK_WIDGET (f))
return;
- BLOCK_INPUT;
+ block_input ();
- if (INTEGERP (Vtool_bar_button_margin)
- && XINT (Vtool_bar_button_margin) > 0)
+ if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
{
hmargin = XFASTINT (Vtool_bar_button_margin);
vmargin = XFASTINT (Vtool_bar_button_margin);
}
else if (CONSP (Vtool_bar_button_margin))
{
- if (INTEGERP (XCAR (Vtool_bar_button_margin))
- && XINT (XCAR (Vtool_bar_button_margin)) > 0)
+ if (RANGED_INTEGERP (1, XCAR (Vtool_bar_button_margin), INT_MAX))
hmargin = XFASTINT (XCAR (Vtool_bar_button_margin));
- if (INTEGERP (XCDR (Vtool_bar_button_margin))
- && XINT (XCDR (Vtool_bar_button_margin)) > 0)
+ if (RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
vmargin = XFASTINT (XCDR (Vtool_bar_button_margin));
}
@@ -4440,13 +4640,36 @@ update_frame_tool_bar (FRAME_PTR f)
dir = gtk_widget_get_direction (GTK_WIDGET (wtoolbar));
style = Ftool_bar_get_system_style ();
+
+ /* Are we up to date? */
+ tbinfo = g_object_get_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)),
+ TB_INFO_KEY);
+
+ if (! NILP (tbinfo->last_tool_bar) && ! NILP (f->tool_bar_items)
+ && tbinfo->n_last_items == f->n_tool_bar_items
+ && tbinfo->hmargin == hmargin && tbinfo->vmargin == vmargin
+ && tbinfo->dir == dir
+ && ! NILP (Fequal (tbinfo->style, style))
+ && ! NILP (Fequal (tbinfo->last_tool_bar, f->tool_bar_items)))
+ {
+ unblock_input ();
+ return;
+ }
+
+ tbinfo->last_tool_bar = f->tool_bar_items;
+ tbinfo->n_last_items = f->n_tool_bar_items;
+ tbinfo->style = style;
+ tbinfo->hmargin = hmargin;
+ tbinfo->vmargin = vmargin;
+ tbinfo->dir = dir;
+
text_image = EQ (style, Qtext_image_horiz);
horiz = EQ (style, Qboth_horiz) || text_image;
for (i = j = 0; i < f->n_tool_bar_items; ++i)
{
- int enabled_p = !NILP (PROP (TOOL_BAR_ITEM_ENABLED_P));
- int selected_p = !NILP (PROP (TOOL_BAR_ITEM_SELECTED_P));
+ bool enabled_p = !NILP (PROP (TOOL_BAR_ITEM_ENABLED_P));
+ bool selected_p = !NILP (PROP (TOOL_BAR_ITEM_SELECTED_P));
int idx;
ptrdiff_t img_id;
int icon_size = 0;
@@ -4459,7 +4682,7 @@ update_frame_tool_bar (FRAME_PTR f)
Lisp_Object rtl;
GtkWidget *wbutton = NULL;
Lisp_Object specified_file;
- int vert_only = ! NILP (PROP (TOOL_BAR_ITEM_VERT_ONLY));
+ bool vert_only = ! NILP (PROP (TOOL_BAR_ITEM_VERT_ONLY));
const char *label
= (EQ (style, Qimage) || (vert_only && horiz)) ? NULL
: STRINGP (PROP (TOOL_BAR_ITEM_LABEL))
@@ -4554,7 +4777,7 @@ update_frame_tool_bar (FRAME_PTR f)
? TOOL_BAR_IMAGE_DISABLED_SELECTED
: TOOL_BAR_IMAGE_DISABLED_DESELECTED);
- xassert (ASIZE (image) >= idx);
+ eassert (ASIZE (image) >= idx);
image = AREF (image, idx);
}
else
@@ -4640,7 +4863,7 @@ update_frame_tool_bar (FRAME_PTR f)
xg_height_or_width_changed (f);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Deallocate all resources for the tool bar on frame F.
@@ -4653,8 +4876,9 @@ free_frame_tool_bar (FRAME_PTR f)
if (x->toolbar_widget)
{
- int is_packed = x->handlebox_widget != 0;
- BLOCK_INPUT;
+ struct xg_frame_tb_info *tbinfo;
+ bool is_packed = x->handlebox_widget != 0;
+ block_input ();
/* We may have created the toolbar_widget in xg_create_tool_bar, but
not the x->handlebox_widget which is created in xg_pack_tool_bar. */
if (is_packed)
@@ -4674,21 +4898,31 @@ free_frame_tool_bar (FRAME_PTR f)
FRAME_TOOLBAR_TOP_HEIGHT (f) = FRAME_TOOLBAR_BOTTOM_HEIGHT (f) = 0;
FRAME_TOOLBAR_LEFT_WIDTH (f) = FRAME_TOOLBAR_RIGHT_WIDTH (f) = 0;
+ tbinfo = g_object_get_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)),
+ TB_INFO_KEY);
+ if (tbinfo)
+ {
+ xfree (tbinfo);
+ g_object_set_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)),
+ TB_INFO_KEY,
+ NULL);
+ }
+
xg_height_or_width_changed (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
-int
+void
xg_change_toolbar_position (FRAME_PTR f, Lisp_Object pos)
{
struct x_output *x = f->output_data.x;
if (! x->toolbar_widget || ! x->handlebox_widget)
- return 1;
+ return;
- BLOCK_INPUT;
+ block_input ();
g_object_ref (x->handlebox_widget);
if (x->toolbar_in_hbox)
gtk_container_remove (GTK_CONTAINER (x->hbox_widget),
@@ -4701,8 +4935,7 @@ xg_change_toolbar_position (FRAME_PTR f, Lisp_Object pos)
if (xg_update_tool_bar_sizes (f))
xg_height_or_width_changed (f);
- UNBLOCK_INPUT;
- return 1;
+ unblock_input ();
}
@@ -4714,6 +4947,7 @@ void
xg_initialize (void)
{
GtkBindingSet *binding_set;
+ GtkSettings *settings;
#if HAVE_XFT
/* Work around a bug with corrupted data if libXft gets unloaded. This way
@@ -4730,17 +4964,19 @@ xg_initialize (void)
id_to_widget.max_size = id_to_widget.used = 0;
id_to_widget.widgets = 0;
+ settings = gtk_settings_get_for_screen (gdk_display_get_default_screen
+ (gdk_display_get_default ()));
/* Remove F10 as a menu accelerator, it does not mix well with Emacs key
bindings. It doesn't seem to be any way to remove properties,
so we set it to VoidSymbol which in X means "no key". */
- gtk_settings_set_string_property (gtk_settings_get_default (),
+ gtk_settings_set_string_property (settings,
"gtk-menu-bar-accel",
"VoidSymbol",
EMACS_CLASS);
/* Make GTK text input widgets use Emacs style keybindings. This is
Emacs after all. */
- gtk_settings_set_string_property (gtk_settings_get_default (),
+ gtk_settings_set_string_property (settings,
"gtk-key-theme-name",
"Emacs",
EMACS_CLASS);
@@ -4757,6 +4993,8 @@ xg_initialize (void)
gtk_binding_entry_add_signal (binding_set, GDK_KEY_g, GDK_CONTROL_MASK,
"cancel", 0);
update_theme_scrollbar_width ();
+
+ x_last_font_name = NULL;
}
#endif /* USE_GTK */
diff --git a/src/gtkutil.h b/src/gtkutil.h
index 7cc2d21f9c4..43f2b237a68 100644
--- a/src/gtkutil.h
+++ b/src/gtkutil.h
@@ -1,6 +1,6 @@
/* Definitions and headers for GTK widgets.
-Copyright (C) 2003-2011 Free Software Foundation, Inc.
+Copyright (C) 2003-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -25,6 +25,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <gtk/gtk.h>
#include "frame.h"
+#include "xterm.h"
/* Minimum and maximum values used for GTK scroll bars */
@@ -73,24 +74,20 @@ typedef struct xg_menu_item_cb_data_
} xg_menu_item_cb_data;
-
-#ifdef HAVE_GTK_FILE_SELECTION_NEW
-extern int use_old_gtk_file_dialog;
-#endif
struct _widget_value;
extern struct _widget_value *malloc_widget_value (void);
extern void free_widget_value (struct _widget_value *);
-extern int xg_uses_old_file_dialog (void);
+extern bool xg_uses_old_file_dialog (void) ATTRIBUTE_CONST;
extern char *xg_get_file_name (FRAME_PTR f,
char *prompt,
char *default_filename,
- int mustmatch_p,
- int only_dir_p);
+ bool mustmatch_p,
+ bool only_dir_p);
-extern char *xg_get_font_name (FRAME_PTR f, const char *);
+extern Lisp_Object xg_get_font (FRAME_PTR f, const char *);
extern GtkWidget *xg_create_widget (const char *type,
const char *name,
@@ -103,16 +100,16 @@ extern GtkWidget *xg_create_widget (const char *type,
extern void xg_modify_menubar_widgets (GtkWidget *menubar,
FRAME_PTR f,
struct _widget_value *val,
- int deep_p,
+ bool deep_p,
GCallback select_cb,
GCallback deactivate_cb,
GCallback highlight_cb);
-extern int xg_update_frame_menubar (FRAME_PTR f);
+extern void xg_update_frame_menubar (FRAME_PTR f);
-extern int xg_event_is_for_menubar (FRAME_PTR f, XEvent *event);
+extern bool xg_event_is_for_menubar (FRAME_PTR f, XEvent *event);
-extern int xg_have_tear_offs (void);
+extern bool xg_have_tear_offs (void);
extern ptrdiff_t xg_get_scroll_id_for_window (Display *dpy, Window wid);
@@ -134,12 +131,12 @@ extern void xg_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar,
int portion,
int position,
int whole);
-extern int xg_event_is_for_scrollbar (FRAME_PTR f, XEvent *event);
+extern bool xg_event_is_for_scrollbar (FRAME_PTR f, XEvent *event);
extern int xg_get_default_scrollbar_width (void);
extern void update_frame_tool_bar (FRAME_PTR f);
extern void free_frame_tool_bar (FRAME_PTR f);
-extern int xg_change_toolbar_position (FRAME_PTR f, Lisp_Object pos);
+extern void xg_change_toolbar_position (FRAME_PTR f, Lisp_Object pos);
extern void xg_frame_resized (FRAME_PTR f,
int pixelwidth,
@@ -151,26 +148,23 @@ extern void xg_display_open (char *display_name, Display **dpy);
extern void xg_display_close (Display *dpy);
extern GdkCursor * xg_create_default_cursor (Display *dpy);
-extern int xg_create_frame_widgets (FRAME_PTR f);
+extern bool xg_create_frame_widgets (FRAME_PTR f);
extern void xg_free_frame_widgets (FRAME_PTR f);
-extern void x_wm_set_size_hint (FRAME_PTR f,
- long flags,
- int user_position);
extern void xg_set_background_color (FRAME_PTR f, unsigned long bg);
-extern int xg_check_special_colors (struct frame *f,
- const char *color_name,
- XColor *color);
+extern bool xg_check_special_colors (struct frame *f,
+ const char *color_name,
+ XColor *color);
extern void xg_set_frame_icon (FRAME_PTR f,
Pixmap icon_pixmap,
Pixmap icon_mask);
-extern int xg_prepare_tooltip (FRAME_PTR f,
- Lisp_Object string,
- int *width,
- int *height);
+extern bool xg_prepare_tooltip (FRAME_PTR f,
+ Lisp_Object string,
+ int *width,
+ int *height);
extern void xg_show_tooltip (FRAME_PTR f, int root_x, int root_y);
-extern int xg_hide_tooltip (FRAME_PTR f);
+extern bool xg_hide_tooltip (FRAME_PTR f);
/* Mark all callback data that are Lisp_object:s during GC. */
@@ -181,7 +175,7 @@ extern void xg_initialize (void);
/* Setting scrollbar values invokes the callback. Use this variable
to indicate that the callback should do nothing. */
-extern int xg_ignore_gtk_scrollbar;
+extern bool xg_ignore_gtk_scrollbar;
#endif /* USE_GTK */
#endif /* GTKUTIL_H */
diff --git a/src/image.c b/src/image.c
index 3d189a5504b..07db6cece1f 100644
--- a/src/image.c
+++ b/src/image.c
@@ -1,5 +1,6 @@
/* Functions for image support on window system.
- Copyright (C) 1989, 1992-2011 Free Software Foundation, Inc.
+
+Copyright (C) 1989, 1992-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -18,8 +19,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <math.h>
-#include <ctype.h>
#include <unistd.h>
#ifdef HAVE_PNG
@@ -32,6 +31,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <setjmp.h>
+#include <c-ctype.h>
+
/* This makes the fields of a Display accessible, in Xlib header files. */
#define XLIB_ILLEGAL_ACCESS
@@ -48,11 +49,19 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "termhooks.h"
#include "font.h"
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#include <sys/types.h>
+#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
+#endif /* HAVE_SYS_STAT_H */
+
+#ifdef HAVE_SYS_TYPES_H
+#include <sys/types.h>
+#endif /* HAVE_SYS_TYPES_H */
+
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
+#ifdef HAVE_X_WINDOWS
#define COLOR_TABLE_SUPPORT 1
typedef struct x_bitmap_record Bitmap_Record;
@@ -65,10 +74,12 @@ typedef struct x_bitmap_record Bitmap_Record;
#define PIX_MASK_DRAW 1
#endif /* HAVE_X_WINDOWS */
-
#ifdef HAVE_NTGUI
-#include "w32.h"
-#include "w32term.h"
+
+/* We need (or want) w32.h only when we're _not_ compiling for Cygwin. */
+#ifdef WINDOWSNT
+# include "w32.h"
+#endif
/* W32_TODO : Color tables on W32. */
#undef COLOR_TABLE_SUPPORT
@@ -82,15 +93,9 @@ typedef struct w32_bitmap_record Bitmap_Record;
#define PIX_MASK_RETAIN 0
#define PIX_MASK_DRAW 1
-#define FRAME_X_VISUAL(f) FRAME_X_DISPLAY_INFO (f)->visual
#define x_defined_color w32_defined_color
#define DefaultDepthOfScreen(screen) (one_w32_display_info.n_cbits)
-/* Functions from w32term.c that depend on XColor (so can't go in w32term.h
- without modifying lots of files). */
-extern void x_query_colors (struct frame *f, XColor *colors, int ncolors);
-extern void x_query_color (struct frame *f, XColor *color);
-
/* Version of libpng that we were compiled with, or -1 if no PNG
support was compiled in. This is tested by w32-win.el to correctly
set up the alist used to search for PNG libraries. */
@@ -98,10 +103,6 @@ Lisp_Object Qlibpng_version;
#endif /* HAVE_NTGUI */
#ifdef HAVE_NS
-#include "nsterm.h"
-#include <sys/types.h>
-#include <sys/stat.h>
-
#undef COLOR_TABLE_SUPPORT
typedef struct ns_bitmap_record Bitmap_Record;
@@ -115,10 +116,8 @@ typedef struct ns_bitmap_record Bitmap_Record;
#define PIX_MASK_RETAIN 0
#define PIX_MASK_DRAW 1
-#define FRAME_X_VISUAL FRAME_NS_DISPLAY_INFO (f)->visual
#define x_defined_color(f, name, color_def, alloc) \
ns_defined_color (f, name, color_def, alloc, 0)
-#define FRAME_X_SCREEN(f) 0
#define DefaultDepthOfScreen(screen) x_display_list->n_planes
#endif /* HAVE_NS */
@@ -137,7 +136,6 @@ static unsigned long lookup_rgb_color (struct frame *f, int r, int g, int b);
static void free_color_table (void);
static unsigned long *colors_in_color_table (int *n);
#endif
-static Lisp_Object Finit_image_library (Lisp_Object, Lisp_Object);
/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
id, which is just an int that this section returns. Bitmaps are
@@ -193,11 +191,11 @@ x_bitmap_width (FRAME_PTR f, ptrdiff_t id)
}
#if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI)
-int
+ptrdiff_t
x_bitmap_pixmap (FRAME_PTR f, ptrdiff_t id)
{
/* HAVE_NTGUI needs the explicit cast here. */
- return (int) FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
+ return (ptrdiff_t) FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
}
#endif
@@ -319,11 +317,11 @@ x_create_bitmap_from_file (struct frame *f, Lisp_Object file)
id = x_allocate_bitmap_record (f);
dpyinfo->bitmaps[id - 1].img = bitmap;
dpyinfo->bitmaps[id - 1].refcount = 1;
- dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (SBYTES (file) + 1);
+ dpyinfo->bitmaps[id - 1].file = xmalloc (SBYTES (file) + 1);
dpyinfo->bitmaps[id - 1].depth = 1;
dpyinfo->bitmaps[id - 1].height = ns_image_width (bitmap);
dpyinfo->bitmaps[id - 1].width = ns_image_height (bitmap);
- strcpy (dpyinfo->bitmaps[id - 1].file, SDATA (file));
+ strcpy (dpyinfo->bitmaps[id - 1].file, SSDATA (file));
return id;
#endif
@@ -365,7 +363,7 @@ x_create_bitmap_from_file (struct frame *f, Lisp_Object file)
dpyinfo->bitmaps[id - 1].pixmap = bitmap;
dpyinfo->bitmaps[id - 1].have_mask = 0;
dpyinfo->bitmaps[id - 1].refcount = 1;
- dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (SBYTES (file) + 1);
+ dpyinfo->bitmaps[id - 1].file = xmalloc (SBYTES (file) + 1);
dpyinfo->bitmaps[id - 1].depth = 1;
dpyinfo->bitmaps[id - 1].height = height;
dpyinfo->bitmaps[id - 1].width = width;
@@ -414,9 +412,9 @@ x_destroy_bitmap (FRAME_PTR f, ptrdiff_t id)
if (--bm->refcount == 0)
{
- BLOCK_INPUT;
+ block_input ();
free_bitmap_record (dpyinfo, bm);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
}
@@ -436,6 +434,9 @@ x_destroy_all_bitmaps (Display_Info *dpyinfo)
dpyinfo->bitmaps_last = 0;
}
+static bool x_create_x_image_and_pixmap (struct frame *, int, int, int,
+ XImagePtr *, Pixmap *);
+static void x_destroy_x_image (XImagePtr ximg);
#ifdef HAVE_X_WINDOWS
@@ -447,23 +448,17 @@ static unsigned long four_corners_best (XImagePtr ximg,
unsigned long width,
unsigned long height);
-static int x_create_x_image_and_pixmap (struct frame *f, int width, int height,
- int depth, XImagePtr *ximg,
- Pixmap *pixmap);
-
-static void x_destroy_x_image (XImagePtr ximg);
-
/* Create a mask of a bitmap. Note is this not a perfect mask.
It's nicer with some borders in this context */
-int
+void
x_create_bitmap_mask (struct frame *f, ptrdiff_t id)
{
Pixmap pixmap, mask;
XImagePtr ximg, mask_img;
unsigned long width, height;
- int result;
+ bool result;
unsigned long bg;
unsigned long x, y, xp, xm, yp, ym;
GC gc;
@@ -471,29 +466,29 @@ x_create_bitmap_mask (struct frame *f, ptrdiff_t id)
Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
if (!(id > 0))
- return -1;
+ return;
pixmap = x_bitmap_pixmap (f, id);
width = x_bitmap_width (f, id);
height = x_bitmap_height (f, id);
- BLOCK_INPUT;
+ block_input ();
ximg = XGetImage (FRAME_X_DISPLAY (f), pixmap, 0, 0, width, height,
~0, ZPixmap);
if (!ximg)
{
- UNBLOCK_INPUT;
- return -1;
+ unblock_input ();
+ return;
}
result = x_create_x_image_and_pixmap (f, width, height, 1, &mask_img, &mask);
- UNBLOCK_INPUT;
+ unblock_input ();
if (!result)
{
XDestroyImage (ximg);
- return -1;
+ return;
}
bg = four_corners_best (ximg, NULL, width, height);
@@ -521,7 +516,7 @@ x_create_bitmap_mask (struct frame *f, ptrdiff_t id)
}
}
- xassert (interrupt_input_blocked);
+ eassert (input_blocked_p ());
gc = XCreateGC (FRAME_X_DISPLAY (f), mask, 0, NULL);
XPutImage (FRAME_X_DISPLAY (f), mask, gc, mask_img, 0, 0, 0, 0,
width, height);
@@ -532,8 +527,6 @@ x_create_bitmap_mask (struct frame *f, ptrdiff_t id)
XDestroyImage (ximg);
x_destroy_x_image (mask_img);
-
- return 0;
}
#endif /* HAVE_X_WINDOWS */
@@ -566,16 +559,15 @@ static Lisp_Object QCcrop, QCrotation;
static Lisp_Object Qcount, Qextension_data, Qdelay;
static Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
-/* Function prototypes. */
+/* Forward function prototypes. */
-static Lisp_Object define_image_type (struct image_type *type, int loaded);
-static struct image_type *lookup_image_type (Lisp_Object symbol);
-static void image_error (const char *format, Lisp_Object, Lisp_Object);
+static struct image_type *lookup_image_type (Lisp_Object);
static void x_laplace (struct frame *, struct image *);
static void x_emboss (struct frame *, struct image *);
-static int x_build_heuristic_mask (struct frame *, struct image *,
- Lisp_Object);
-#ifdef HAVE_NTGUI
+static void x_build_heuristic_mask (struct frame *, struct image *,
+ Lisp_Object);
+#ifdef WINDOWSNT
+extern Lisp_Object Vlibrary_cache;
#define CACHE_IMAGE_TYPE(type, status) \
do { Vlibrary_cache = Fcons (Fcons (type, status), Vlibrary_cache); } while (0)
#else
@@ -588,60 +580,61 @@ static int x_build_heuristic_mask (struct frame *, struct image *,
/* Define a new image type from TYPE. This adds a copy of TYPE to
image_types and caches the loading status of TYPE. */
-static Lisp_Object
-define_image_type (struct image_type *type, int loaded)
+static struct image_type *
+define_image_type (struct image_type *type)
{
- Lisp_Object success;
+ struct image_type *p = NULL;
+ Lisp_Object target_type = *type->type;
+ bool type_valid = 1;
- if (!loaded)
- success = Qnil;
- else
+ block_input ();
+
+ for (p = image_types; p; p = p->next)
+ if (EQ (*p->type, target_type))
+ goto done;
+
+ if (type->init)
+ {
+#if defined HAVE_NTGUI && defined WINDOWSNT
+ /* If we failed to load the library before, don't try again. */
+ Lisp_Object tested = Fassq (target_type, Vlibrary_cache);
+ if (CONSP (tested) && NILP (XCDR (tested)))
+ type_valid = 0;
+ else
+#endif
+ {
+ type_valid = type->init ();
+ CACHE_IMAGE_TYPE (target_type, type_valid ? Qt : Qnil);
+ }
+ }
+
+ if (type_valid)
{
/* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
The initialized data segment is read-only. */
- struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
- memcpy (p, type, sizeof *p);
+ p = xmalloc (sizeof *p);
+ *p = *type;
p->next = image_types;
image_types = p;
- success = Qt;
}
- CACHE_IMAGE_TYPE (*type->type, success);
- return success;
-}
-
-
-/* Look up image type SYMBOL, and return a pointer to its image_type
- structure. Value is null if SYMBOL is not a known image type. */
-
-static inline struct image_type *
-lookup_image_type (Lisp_Object symbol)
-{
- struct image_type *type;
-
- /* We must initialize the image-type if it hasn't been already. */
- if (NILP (Finit_image_library (symbol, Vdynamic_library_alist)))
- return 0; /* unimplemented */
-
- for (type = image_types; type; type = type->next)
- if (EQ (symbol, *type->type))
- break;
-
- return type;
+ done:
+ unblock_input ();
+ return p;
}
-/* Value is non-zero if OBJECT is a valid Lisp image specification. A
+/* Value is true if OBJECT is a valid Lisp image specification. A
valid image specification is a list whose car is the symbol
`image', and whose rest is a property list. The property list must
contain a value for key `:type'. That value must be the name of a
supported image type. The rest of the property list depends on the
image type. */
-int
+bool
valid_image_p (Lisp_Object object)
{
- int valid_p = 0;
+ bool valid_p = 0;
if (IMAGEP (object))
{
@@ -711,8 +704,8 @@ struct image_keyword
/* The type of value allowed. */
enum image_value_type type;
- /* Non-zero means key must be present. */
- int mandatory_p;
+ /* True means key must be present. */
+ bool mandatory_p;
/* Used to recognize duplicate keywords in a property list. */
int count;
@@ -722,18 +715,13 @@ struct image_keyword
};
-static int parse_image_spec (Lisp_Object, struct image_keyword *,
- int, Lisp_Object);
-static Lisp_Object image_spec_value (Lisp_Object, Lisp_Object, int *);
-
-
/* Parse image spec SPEC according to KEYWORDS. A valid image spec
has the format (image KEYWORD VALUE ...). One of the keyword/
value pairs must be `:type TYPE'. KEYWORDS is a vector of
image_keywords structures of size NKEYWORDS describing other
- allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
+ allowed keyword/value pairs. Value is true if SPEC is valid. */
-static int
+static bool
parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
int nkeywords, Lisp_Object type)
{
@@ -771,10 +759,9 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
/* Record that we recognized the keyword. If a keywords
was found more than once, it's an error. */
keywords[i].value = value;
- ++keywords[i].count;
-
if (keywords[i].count > 1)
return 0;
+ ++keywords[i].count;
/* Check type of value against allowed type. */
switch (keywords[i].type)
@@ -848,7 +835,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
break;
default:
- abort ();
+ emacs_abort ();
break;
}
@@ -866,15 +853,15 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
/* Return the value of KEY in image specification SPEC. Value is nil
- if KEY is not present in SPEC. if FOUND is not null, set *FOUND
- to 1 if KEY was found in SPEC, set it to 0 otherwise. */
+ if KEY is not present in SPEC. Set *FOUND depending on whether KEY
+ was found in SPEC. */
static Lisp_Object
-image_spec_value (Lisp_Object spec, Lisp_Object key, int *found)
+image_spec_value (Lisp_Object spec, Lisp_Object key, bool *found)
{
Lisp_Object tail;
- xassert (valid_image_p (spec));
+ eassert (valid_image_p (spec));
for (tail = XCDR (spec);
CONSP (tail) && CONSP (XCDR (tail));
@@ -974,23 +961,20 @@ or omitted means use the selected frame. */)
Image type independent image structures
***********************************************************************/
-static void free_image (struct frame *f, struct image *img);
-
-#define MAX_IMAGE_SIZE 6.0
+#define MAX_IMAGE_SIZE 10.0
/* Allocate and return a new image structure for image specification
SPEC. SPEC has a hash value of HASH. */
static struct image *
make_image (Lisp_Object spec, EMACS_UINT hash)
{
- struct image *img = (struct image *) xmalloc (sizeof *img);
+ struct image *img = xzalloc (sizeof *img);
Lisp_Object file = image_spec_value (spec, QCfile, NULL);
- xassert (valid_image_p (spec));
- memset (img, 0, sizeof *img);
+ eassert (valid_image_p (spec));
img->dependencies = NILP (file) ? Qnil : list1 (file);
img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
- xassert (img->type != NULL);
+ eassert (img->type != NULL);
img->spec = spec;
img->lisp_data = Qnil;
img->ascent = DEFAULT_IMAGE_ASCENT;
@@ -1026,10 +1010,9 @@ free_image (struct frame *f, struct image *img)
}
}
-/* Return 1 if the given widths and heights are valid for display;
- otherwise, return 0. */
+/* Return true if the given widths and heights are valid for display. */
-static int
+static bool
check_image_size (struct frame *f, int width, int height)
{
int w, h;
@@ -1062,16 +1045,13 @@ check_image_size (struct frame *f, int width, int height)
void
prepare_image_for_display (struct frame *f, struct image *img)
{
- EMACS_TIME t;
-
/* We're about to display IMG, so set its timestamp to `now'. */
- EMACS_GET_TIME (t);
- img->timestamp = EMACS_SECS (t);
+ img->timestamp = current_emacs_time ();
/* If IMG doesn't have a pixmap yet, load it now, using the image
type dependent loader function. */
if (img->pixmap == NO_PIXMAP && !img->load_failed_p)
- img->load_failed_p = img->type->load (f, img) == 0;
+ img->load_failed_p = ! img->type->load (f, img);
}
@@ -1204,7 +1184,7 @@ image_background (struct image *img, struct frame *f, XImagePtr_or_DC ximg)
if (! img->background_valid)
/* IMG doesn't have a background yet, try to guess a reasonable value. */
{
- int free_ximg = !ximg;
+ bool free_ximg = !ximg;
#ifdef HAVE_NTGUI
HGDIOBJ prev;
#endif /* HAVE_NTGUI */
@@ -1245,7 +1225,7 @@ image_background_transparent (struct image *img, struct frame *f, XImagePtr_or_D
{
if (img->mask)
{
- int free_mask = !mask;
+ bool free_mask = !mask;
#ifdef HAVE_NTGUI
HGDIOBJ prev;
#endif /* HAVE_NTGUI */
@@ -1283,23 +1263,13 @@ image_background_transparent (struct image *img, struct frame *f, XImagePtr_or_D
Helper functions for X image types
***********************************************************************/
-static void x_clear_image_1 (struct frame *, struct image *, int,
- int, int);
-static void x_clear_image (struct frame *f, struct image *img);
-static unsigned long x_alloc_image_color (struct frame *f,
- struct image *img,
- Lisp_Object color_name,
- unsigned long dflt);
-
-
-/* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
- free the pixmap if any. MASK_P non-zero means clear the mask
- pixmap if any. COLORS_P non-zero means free colors allocated for
- the image, if any. */
+/* Clear X resources of image IMG on frame F. PIXMAP_P means free the
+ pixmap if any. MASK_P means clear the mask pixmap if any.
+ COLORS_P means free colors allocated for the image, if any. */
static void
-x_clear_image_1 (struct frame *f, struct image *img, int pixmap_p, int mask_p,
- int colors_p)
+x_clear_image_1 (struct frame *f, struct image *img, bool pixmap_p,
+ bool mask_p, bool colors_p)
{
if (pixmap_p && img->pixmap)
{
@@ -1334,9 +1304,9 @@ x_clear_image_1 (struct frame *f, struct image *img, int pixmap_p, int mask_p,
static void
x_clear_image (struct frame *f, struct image *img)
{
- BLOCK_INPUT;
+ block_input ();
x_clear_image_1 (f, img, 1, 1, 1);
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -1352,7 +1322,7 @@ x_alloc_image_color (struct frame *f, struct image *img, Lisp_Object color_name,
XColor color;
unsigned long result;
- xassert (STRINGP (color_name));
+ eassert (STRINGP (color_name));
if (x_defined_color (f, SSDATA (color_name), &color, 1)
&& img->ncolors < min (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *img->colors,
@@ -1361,9 +1331,7 @@ x_alloc_image_color (struct frame *f, struct image *img, Lisp_Object color_name,
/* This isn't called frequently so we get away with simply
reallocating the color vector to the needed size, here. */
ptrdiff_t ncolors = img->ncolors + 1;
- img->colors =
- (unsigned long *) xrealloc (img->colors,
- ncolors * sizeof *img->colors);
+ img->colors = xrealloc (img->colors, ncolors * sizeof *img->colors);
img->colors[ncolors - 1] = color.pixel;
img->ncolors = ncolors;
result = color.pixel;
@@ -1381,7 +1349,6 @@ x_alloc_image_color (struct frame *f, struct image *img, Lisp_Object color_name,
***********************************************************************/
static void cache_image (struct frame *f, struct image *img);
-static void postprocess_image (struct frame *, struct image *);
/* Return a new, initialized image cache that is allocated from the
heap. Call free_image_cache to free an image cache. */
@@ -1389,16 +1356,14 @@ static void postprocess_image (struct frame *, struct image *);
struct image_cache *
make_image_cache (void)
{
- struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
+ struct image_cache *c = xzalloc (sizeof *c);
int size;
- memset (c, 0, sizeof *c);
size = 50;
- c->images = (struct image **) xmalloc (size * sizeof *c->images);
+ c->images = xmalloc (size * sizeof *c->images);
c->size = size;
size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
- c->buckets = (struct image **) xmalloc (size);
- memset (c->buckets, 0, size);
+ c->buckets = xzalloc (size);
return c;
}
@@ -1464,7 +1429,7 @@ free_image_cache (struct frame *f)
ptrdiff_t i;
/* Cache should not be referenced by any frame when freed. */
- xassert (c->refcount == 0);
+ eassert (c->refcount == 0);
for (i = 0; i < c->used; ++i)
free_image (f, c->images[i]);
@@ -1495,7 +1460,7 @@ clear_image_cache (struct frame *f, Lisp_Object filter)
/* Block input so that we won't be interrupted by a SIGIO
while being in an inconsistent state. */
- BLOCK_INPUT;
+ block_input ();
if (!NILP (filter))
{
@@ -1514,8 +1479,8 @@ clear_image_cache (struct frame *f, Lisp_Object filter)
else if (INTEGERP (Vimage_cache_eviction_delay))
{
/* Free cache based on timestamp. */
- EMACS_TIME t;
- double old, delay;
+ EMACS_TIME old, t;
+ double delay;
ptrdiff_t nimages = 0;
for (i = 0; i < c->used; ++i)
@@ -1529,13 +1494,13 @@ clear_image_cache (struct frame *f, Lisp_Object filter)
delay = 1600 * delay / nimages / nimages;
delay = max (delay, 1);
- EMACS_GET_TIME (t);
- old = EMACS_SECS (t) - delay;
+ t = current_emacs_time ();
+ old = sub_emacs_time (t, EMACS_TIME_FROM_DOUBLE (delay));
for (i = 0; i < c->used; ++i)
{
struct image *img = c->images[i];
- if (img && img->timestamp < old)
+ if (img && EMACS_TIME_LT (img->timestamp, old))
{
free_image (f, img);
++nfreed;
@@ -1561,7 +1526,7 @@ clear_image_cache (struct frame *f, Lisp_Object filter)
++windows_or_buffers_changed;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -1656,7 +1621,7 @@ postprocess_image (struct frame *f, struct image *img)
x_build_heuristic_mask (f, img, mask);
else
{
- int found_p;
+ bool found_p;
mask = image_spec_value (spec, QCmask, &found_p);
@@ -1708,12 +1673,11 @@ lookup_image (struct frame *f, Lisp_Object spec)
{
struct image *img;
EMACS_UINT hash;
- EMACS_TIME now;
/* F must be a window-system frame, and SPEC must be a valid image
specification. */
- xassert (FRAME_WINDOW_P (f));
- xassert (valid_image_p (spec));
+ eassert (FRAME_WINDOW_P (f));
+ eassert (valid_image_p (spec));
/* Look up SPEC in the hash table of the image cache. */
hash = sxhash (spec, 0);
@@ -1727,10 +1691,10 @@ lookup_image (struct frame *f, Lisp_Object spec)
/* If not found, create a new image and cache it. */
if (img == NULL)
{
- BLOCK_INPUT;
+ block_input ();
img = make_image (spec, hash);
cache_image (f, img);
- img->load_failed_p = img->type->load (f, img) == 0;
+ img->load_failed_p = ! img->type->load (f, img);
img->frame_foreground = FRAME_FOREGROUND_PIXEL (f);
img->frame_background = FRAME_BACKGROUND_PIXEL (f);
@@ -1754,6 +1718,7 @@ lookup_image (struct frame *f, Lisp_Object spec)
`:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
`:background COLOR'. */
Lisp_Object ascent, margin, relief, bg;
+ int relief_bound;
ascent = image_spec_value (spec, QCascent, NULL);
if (INTEGERP (ascent))
@@ -1771,7 +1736,8 @@ lookup_image (struct frame *f, Lisp_Object spec)
}
relief = image_spec_value (spec, QCrelief, NULL);
- if (INTEGERP (relief))
+ relief_bound = INT_MAX - max (img->hmargin, img->vmargin);
+ if (RANGED_INTEGERP (- relief_bound, relief, relief_bound))
{
img->relief = XINT (relief);
img->hmargin += eabs (img->relief);
@@ -1796,12 +1762,11 @@ lookup_image (struct frame *f, Lisp_Object spec)
postprocess_image (f, img);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* We're using IMG, so set its timestamp to `now'. */
- EMACS_GET_TIME (now);
- img->timestamp = EMACS_SECS (now);
+ img->timestamp = current_emacs_time ();
/* Value is the image id. */
return img->id;
@@ -1875,7 +1840,7 @@ mark_image_cache (struct image_cache *c)
X / NS / W32 support code
***********************************************************************/
-#ifdef HAVE_NTGUI
+#ifdef WINDOWSNT
/* Macro for defining functions that will be loaded from image DLLs. */
#define DEF_IMGLIB_FN(rettype,func,args) static rettype (FAR CDECL *fn_##func)args
@@ -1886,18 +1851,13 @@ mark_image_cache (struct image_cache *c)
if (!fn_##func) return 0; \
}
-#endif /* HAVE_NTGUI */
+#endif /* WINDOWSNT */
-static int x_create_x_image_and_pixmap (struct frame *, int, int, int,
- XImagePtr *, Pixmap *);
-static void x_destroy_x_image (XImagePtr);
-static void x_put_x_image (struct frame *, XImagePtr, Pixmap, int, int);
-
-/* Return nonzero if XIMG's size WIDTH x HEIGHT doesn't break the
+/* Return true if XIMG's size WIDTH x HEIGHT doesn't break the
windowing system.
WIDTH and HEIGHT must both be positive.
If XIMG is null, assume it is a bitmap. */
-static int
+static bool
x_check_image_size (XImagePtr ximg, int width, int height)
{
#ifdef HAVE_X_WINDOWS
@@ -1936,12 +1896,12 @@ x_check_image_size (XImagePtr ximg, int width, int height)
frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
via xmalloc. Print error messages via image_error if an error
- occurs. Value is non-zero if successful.
+ occurs. Value is true if successful.
On W32, a DEPTH of zero signifies a 24 bit image, otherwise DEPTH
should indicate the bit depth of the image. */
-static int
+static bool
x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth,
XImagePtr *ximg, Pixmap *pixmap)
{
@@ -1950,7 +1910,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth,
Window window = FRAME_X_WINDOW (f);
Screen *screen = FRAME_X_SCREEN (f);
- xassert (interrupt_input_blocked);
+ eassert (input_blocked_p ());
if (depth <= 0)
depth = DefaultDepthOfScreen (screen);
@@ -1973,7 +1933,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth,
}
/* Allocate image raster. */
- (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
+ (*ximg)->data = xmalloc ((*ximg)->bytes_per_line * height);
/* Allocate a pixmap of the same size. */
*pixmap = XCreatePixmap (display, window, width, height, depth);
@@ -2088,7 +2048,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth,
static void
x_destroy_x_image (XImagePtr ximg)
{
- xassert (interrupt_input_blocked);
+ eassert (input_blocked_p ());
if (ximg)
{
#ifdef HAVE_X_WINDOWS
@@ -2117,7 +2077,7 @@ x_put_x_image (struct frame *f, XImagePtr ximg, Pixmap pixmap, int width, int he
#ifdef HAVE_X_WINDOWS
GC gc;
- xassert (interrupt_input_blocked);
+ eassert (input_blocked_p ());
gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
XFreeGC (FRAME_X_DISPLAY (f), gc);
@@ -2132,7 +2092,7 @@ x_put_x_image (struct frame *f, XImagePtr ximg, Pixmap pixmap, int width, int he
#endif /* HAVE_NTGUI */
#ifdef HAVE_NS
- xassert (ximg == pixmap);
+ eassert (ximg == pixmap);
ns_retain_object (ximg);
#endif
}
@@ -2180,14 +2140,13 @@ x_find_image_file (Lisp_Object file)
static unsigned char *
slurp_file (char *file, ptrdiff_t *size)
{
- FILE *fp = NULL;
+ FILE *fp = fopen (file, "rb");
unsigned char *buf = NULL;
struct stat st;
- if (stat (file, &st) == 0
- && (fp = fopen (file, "rb")) != NULL
+ if (fp && fstat (fileno (fp), &st) == 0
&& 0 <= st.st_size && st.st_size <= min (PTRDIFF_MAX, SIZE_MAX)
- && (buf = (unsigned char *) xmalloc (st.st_size),
+ && (buf = xmalloc (st.st_size),
fread (buf, 1, st.st_size, fp) == st.st_size))
{
*size = st.st_size;
@@ -2213,15 +2172,9 @@ slurp_file (char *file, ptrdiff_t *size)
XBM images
***********************************************************************/
-static int xbm_scan (unsigned char **, unsigned char *, char *, int *);
-static int xbm_load (struct frame *f, struct image *img);
-static int xbm_load_image (struct frame *f, struct image *img,
- unsigned char *, unsigned char *);
-static int xbm_image_p (Lisp_Object object);
-static int xbm_read_bitmap_data (struct frame *f,
- unsigned char *, unsigned char *,
- int *, int *, char **, int);
-static int xbm_file_p (Lisp_Object);
+static bool xbm_load (struct frame *f, struct image *img);
+static bool xbm_image_p (Lisp_Object object);
+static bool xbm_file_p (Lisp_Object);
/* Indices of image specification fields in xbm_format, below. */
@@ -2272,6 +2225,7 @@ static struct image_type xbm_type =
xbm_image_p,
xbm_load,
x_clear_image,
+ NULL,
NULL
};
@@ -2284,10 +2238,10 @@ enum xbm_token
};
-/* Return non-zero if OBJECT is a valid XBM-type image specification.
+/* Return true if OBJECT is a valid XBM-type image specification.
A valid specification is a list starting with the symbol `image'
The rest of the list is a property list which must contain an
- entry `:type xbm..
+ entry `:type xbm'.
If the specification specifies a file to load, it must contain
an entry `:file FILENAME' where FILENAME is a string.
@@ -2313,7 +2267,7 @@ enum xbm_token
foreground and background of the frame on which the image is
displayed is used. */
-static int
+static bool
xbm_image_p (Lisp_Object object)
{
struct image_keyword kw[XBM_LAST];
@@ -2322,7 +2276,7 @@ xbm_image_p (Lisp_Object object)
if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
return 0;
- xassert (EQ (kw[XBM_TYPE].value, Qxbm));
+ eassert (EQ (kw[XBM_TYPE].value, Qxbm));
if (kw[XBM_FILE].count)
{
@@ -2364,7 +2318,7 @@ xbm_image_p (Lisp_Object object)
for one line of the image. */
for (i = 0; i < height; ++i)
{
- Lisp_Object elt = XVECTOR (data)->contents[i];
+ Lisp_Object elt = AREF (data, i);
if (STRINGP (elt))
{
@@ -2414,12 +2368,12 @@ xbm_scan (unsigned char **s, unsigned char *end, char *sval, int *ival)
loop:
/* Skip white space. */
- while (*s < end && (c = *(*s)++, isspace (c)))
+ while (*s < end && (c = *(*s)++, c_isspace (c)))
;
if (*s >= end)
c = 0;
- else if (isdigit (c))
+ else if (c_isdigit (c))
{
int value = 0, digit;
@@ -2431,7 +2385,7 @@ xbm_scan (unsigned char **s, unsigned char *end, char *sval, int *ival)
while (*s < end)
{
c = *(*s)++;
- if (isdigit (c))
+ if (c_isdigit (c))
digit = c - '0';
else if (c >= 'a' && c <= 'f')
digit = c - 'a' + 10;
@@ -2442,11 +2396,11 @@ xbm_scan (unsigned char **s, unsigned char *end, char *sval, int *ival)
value = 16 * value + digit;
}
}
- else if (isdigit (c))
+ else if (c_isdigit (c))
{
value = c - '0';
while (*s < end
- && (c = *(*s)++, isdigit (c)))
+ && (c = *(*s)++, c_isdigit (c)))
value = 8 * value + c - '0';
}
}
@@ -2454,7 +2408,7 @@ xbm_scan (unsigned char **s, unsigned char *end, char *sval, int *ival)
{
value = c - '0';
while (*s < end
- && (c = *(*s)++, isdigit (c)))
+ && (c = *(*s)++, c_isdigit (c)))
value = 10 * value + c - '0';
}
@@ -2463,11 +2417,11 @@ xbm_scan (unsigned char **s, unsigned char *end, char *sval, int *ival)
*ival = value;
c = XBM_TK_NUMBER;
}
- else if (isalpha (c) || c == '_')
+ else if (c_isalpha (c) || c == '_')
{
*sval++ = c;
while (*s < end
- && (c = *(*s)++, (isalnum (c) || c == '_')))
+ && (c = *(*s)++, (c_isalnum (c) || c == '_')))
*sval++ = c;
*sval = 0;
if (*s < end)
@@ -2507,7 +2461,7 @@ w32_create_pixmap_from_bitmap_data (int width, int height, char *data)
w1 = (width + 7) / 8; /* nb of 8bits elt in X bitmap */
w2 = ((width + 15) / 16) * 2; /* nb of 16bits elt in W32 bitmap */
- bits = (unsigned char *) alloca (height * w2);
+ bits = alloca (height * w2);
memset (bits, 0, height * w2);
for (i = 0; i < height; i++)
{
@@ -2571,7 +2525,7 @@ convert_mono_to_color_image (struct frame *f, struct image *img,
static void
Create_Pixmap_From_Bitmap_Data (struct frame *f, struct image *img, char *data,
RGB_PIXEL_COLOR fg, RGB_PIXEL_COLOR bg,
- int non_default_colors)
+ bool non_default_colors)
{
#ifdef HAVE_NTGUI
img->pixmap
@@ -2603,20 +2557,20 @@ Create_Pixmap_From_Bitmap_Data (struct frame *f, struct image *img, char *data,
X versions. CONTENTS is a pointer to a buffer to parse; END is the
buffer's end. Set *WIDTH and *HEIGHT to the width and height of
the image. Return in *DATA the bitmap data allocated with xmalloc.
- Value is non-zero if successful. DATA null means just test if
- CONTENTS looks like an in-memory XBM file. If INHIBIT_IMAGE_ERROR
- is non-zero, inhibit the call to image_error when the image size is
- invalid (the bitmap remains unread). */
+ Value is true if successful. DATA null means just test if
+ CONTENTS looks like an in-memory XBM file. If INHIBIT_IMAGE_ERROR,
+ inhibit the call to image_error when the image size is invalid (the
+ bitmap remains unread). */
-static int
+static bool
xbm_read_bitmap_data (struct frame *f, unsigned char *contents, unsigned char *end,
int *width, int *height, char **data,
- int inhibit_image_error)
+ bool inhibit_image_error)
{
unsigned char *s = contents;
char buffer[BUFSIZ];
- int padding_p = 0;
- int v10 = 0;
+ bool padding_p = 0;
+ bool v10 = 0;
int bytes_per_line, i, nbytes;
char *p;
int value;
@@ -2709,7 +2663,7 @@ xbm_read_bitmap_data (struct frame *f, unsigned char *contents, unsigned char *e
}
bytes_per_line = (*width + 7) / 8 + padding_p;
nbytes = bytes_per_line * *height;
- p = *data = (char *) xmalloc (nbytes);
+ p = *data = xmalloc (nbytes);
if (v10)
{
@@ -2763,16 +2717,16 @@ xbm_read_bitmap_data (struct frame *f, unsigned char *contents, unsigned char *e
/* Load XBM image IMG which will be displayed on frame F from buffer
- CONTENTS. END is the end of the buffer. Value is non-zero if
+ CONTENTS. END is the end of the buffer. Value is true if
successful. */
-static int
+static bool
xbm_load_image (struct frame *f, struct image *img, unsigned char *contents,
unsigned char *end)
{
- int rc;
+ bool rc;
char *data;
- int success_p = 0;
+ bool success_p = 0;
rc = xbm_read_bitmap_data (f, contents, end, &img->width, &img->height,
&data, 0);
@@ -2780,10 +2734,10 @@ xbm_load_image (struct frame *f, struct image *img, unsigned char *contents,
{
unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
unsigned long background = FRAME_BACKGROUND_PIXEL (f);
- int non_default_colors = 0;
+ bool non_default_colors = 0;
Lisp_Object value;
- xassert (img->width > 0 && img->height > 0);
+ eassert (img->width > 0 && img->height > 0);
/* Get foreground and background colors, maybe allocate colors. */
value = image_spec_value (img->spec, QCforeground, NULL);
@@ -2821,9 +2775,9 @@ xbm_load_image (struct frame *f, struct image *img, unsigned char *contents,
}
-/* Value is non-zero if DATA looks like an in-memory XBM file. */
+/* Value is true if DATA looks like an in-memory XBM file. */
-static int
+static bool
xbm_file_p (Lisp_Object data)
{
int w, h;
@@ -2835,15 +2789,15 @@ xbm_file_p (Lisp_Object data)
/* Fill image IMG which is used on frame F with pixmap data. Value is
- non-zero if successful. */
+ true if successful. */
-static int
+static bool
xbm_load (struct frame *f, struct image *img)
{
- int success_p = 0;
+ bool success_p = 0;
Lisp_Object file_name;
- xassert (xbm_image_p (img->spec));
+ eassert (xbm_image_p (img->spec));
/* If IMG->spec specifies a file name, create a non-file spec from it. */
file_name = image_spec_value (img->spec, QCfile, NULL);
@@ -2876,10 +2830,10 @@ xbm_load (struct frame *f, struct image *img)
Lisp_Object data;
unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
unsigned long background = FRAME_BACKGROUND_PIXEL (f);
- int non_default_colors = 0;
+ bool non_default_colors = 0;
char *bits;
- int parsed_p;
- int in_memory_file_p = 0;
+ bool parsed_p;
+ bool in_memory_file_p = 0;
/* See if data looks like an in-memory XBM file. */
data = image_spec_value (img->spec, QCdata, NULL);
@@ -2888,15 +2842,14 @@ xbm_load (struct frame *f, struct image *img)
/* Parse the image specification. */
memcpy (fmt, xbm_format, sizeof fmt);
parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
- (void) parsed_p;
- xassert (parsed_p);
+ eassert (parsed_p);
/* Get specified width, and height. */
if (!in_memory_file_p)
{
img->width = XFASTINT (fmt[XBM_WIDTH].value);
img->height = XFASTINT (fmt[XBM_HEIGHT].value);
- xassert (img->width > 0 && img->height > 0);
+ eassert (img->width > 0 && img->height > 0);
if (!check_image_size (f, img->width, img->height))
{
image_error ("Invalid image size (see `max-image-size')",
@@ -2934,10 +2887,10 @@ xbm_load (struct frame *f, struct image *img)
char *p;
int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
- p = bits = (char *) alloca (nbytes * img->height);
+ p = bits = alloca (nbytes * img->height);
for (i = 0; i < img->height; ++i, p += nbytes)
{
- Lisp_Object line = XVECTOR (data)->contents[i];
+ Lisp_Object line = AREF (data, i);
if (STRINGP (line))
memcpy (p, SDATA (line), nbytes);
else
@@ -2949,7 +2902,7 @@ xbm_load (struct frame *f, struct image *img)
else
bits = (char *) XBOOL_VECTOR (data)->data;
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
{
char *invertedBits;
int nbytes, i;
@@ -2957,7 +2910,7 @@ xbm_load (struct frame *f, struct image *img)
invertedBits = bits;
nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR
* img->height;
- bits = (char *) alloca (nbytes);
+ bits = alloca (nbytes);
for (i = 0; i < nbytes; i++)
bits[i] = XBM_BIT_SHUFFLE (invertedBits[i]);
}
@@ -2993,9 +2946,8 @@ xbm_load (struct frame *f, struct image *img)
#if defined (HAVE_XPM) || defined (HAVE_NS)
-static int xpm_image_p (Lisp_Object object);
-static int xpm_load (struct frame *f, struct image *img);
-static int xpm_valid_color_symbols_p (Lisp_Object);
+static bool xpm_image_p (Lisp_Object object);
+static bool xpm_load (struct frame *f, struct image *img);
#endif /* HAVE_XPM || HAVE_NS */
@@ -3061,6 +3013,12 @@ static const struct image_keyword xpm_format[XPM_LAST] =
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
+#if defined HAVE_NTGUI && defined WINDOWSNT
+static bool init_xpm_functions (void);
+#else
+#define init_xpm_functions NULL
+#endif
+
/* Structure describing the image type XPM. */
static struct image_type xpm_type =
@@ -3069,6 +3027,7 @@ static struct image_type xpm_type =
xpm_image_p,
xpm_load,
x_clear_image,
+ init_xpm_functions,
NULL
};
@@ -3086,10 +3045,6 @@ static struct image_type xpm_type =
#ifdef ALLOC_XPM_COLORS
-static void xpm_init_color_cache (struct frame *, XpmAttributes *);
-static void xpm_free_color_cache (void);
-static int xpm_lookup_color (struct frame *, char *, XColor *);
-static int xpm_color_bucket (char *);
static struct xpm_cached_color *xpm_cache_color (struct frame *, char *,
XColor *, int);
@@ -3122,8 +3077,7 @@ static void
xpm_init_color_cache (struct frame *f, XpmAttributes *attrs)
{
size_t nbytes = XPM_COLOR_CACHE_BUCKETS * sizeof *xpm_color_cache;
- xpm_color_cache = (struct xpm_cached_color **) xmalloc (nbytes);
- memset (xpm_color_cache, 0, nbytes);
+ xpm_color_cache = xzalloc (nbytes);
init_color_table ();
if (attrs->valuemask & XpmColorSymbols)
@@ -3187,7 +3141,7 @@ xpm_cache_color (struct frame *f, char *color_name, XColor *color, int bucket)
bucket = xpm_color_bucket (color_name);
nbytes = offsetof (struct xpm_cached_color, name) + strlen (color_name) + 1;
- p = (struct xpm_cached_color *) xmalloc (nbytes);
+ p = xmalloc (nbytes);
strcpy (p->name, color_name);
p->color = *color;
p->next = xpm_color_cache[bucket];
@@ -3197,10 +3151,10 @@ xpm_cache_color (struct frame *f, char *color_name, XColor *color, int bucket)
/* Look up color COLOR_NAME for frame F in the color cache. If found,
return the cached definition in *COLOR. Otherwise, make a new
- entry in the cache and allocate the color. Value is zero if color
+ entry in the cache and allocate the color. Value is false if color
allocation failed. */
-static int
+static bool
xpm_lookup_color (struct frame *f, char *color_name, XColor *color)
{
struct xpm_cached_color *p;
@@ -3258,7 +3212,7 @@ xpm_free_colors (Display *dpy, Colormap cmap, Pixel *pixels, int npixels, void *
#endif /* ALLOC_XPM_COLORS */
-#ifdef HAVE_NTGUI
+#ifdef WINDOWSNT
/* XPM library details. */
@@ -3269,12 +3223,12 @@ DEF_IMGLIB_FN (int, XpmReadFileToImage, (Display *, char *, xpm_XImage **,
xpm_XImage **, XpmAttributes *));
DEF_IMGLIB_FN (void, XImageFree, (xpm_XImage *));
-static int
-init_xpm_functions (Lisp_Object libraries)
+static bool
+init_xpm_functions (void)
{
HMODULE library;
- if (!(library = w32_delayed_load (libraries, Qxpm)))
+ if (!(library = w32_delayed_load (Qxpm)))
return 0;
LOAD_IMGLIB_FN (library, XpmFreeAttributes);
@@ -3284,14 +3238,21 @@ init_xpm_functions (Lisp_Object libraries)
return 1;
}
-#endif /* HAVE_NTGUI */
+#endif /* WINDOWSNT */
+#if defined HAVE_NTGUI && !defined WINDOWSNT
+/* Glue for code below */
+#define fn_XpmReadFileToImage XpmReadFileToImage
+#define fn_XpmCreateImageFromBuffer XpmCreateImageFromBuffer
+#define fn_XImageFree XImageFree
+#define fn_XpmFreeAttributes XpmFreeAttributes
+#endif /* HAVE_NTGUI && !WINDOWSNT */
-/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
+/* Value is true if COLOR_SYMBOLS is a valid color symbols list
for XPM images. Such a list must consist of conses whose car and
cdr are strings. */
-static int
+static bool
xpm_valid_color_symbols_p (Lisp_Object color_symbols)
{
while (CONSP (color_symbols))
@@ -3308,9 +3269,9 @@ xpm_valid_color_symbols_p (Lisp_Object color_symbols)
}
-/* Value is non-zero if OBJECT is a valid XPM image specification. */
+/* Value is true if OBJECT is a valid XPM image specification. */
-static int
+static bool
xpm_image_p (Lisp_Object object)
{
struct image_keyword fmt[XPM_LAST];
@@ -3367,11 +3328,11 @@ x_create_bitmap_from_xpm_data (struct frame *f, const char **bits)
#endif /* defined (HAVE_XPM) && defined (HAVE_X_WINDOWS) */
/* Load image IMG which will be displayed on frame F. Value is
- non-zero if successful. */
+ true if successful. */
#ifdef HAVE_XPM
-static int
+static bool
xpm_load (struct frame *f, struct image *img)
{
int rc;
@@ -3430,7 +3391,7 @@ xpm_load (struct frame *f, struct image *img)
/* Allocate an XpmColorSymbol array. */
size = attrs.numsymbols * sizeof *xpm_syms;
- xpm_syms = (XpmColorSymbol *) alloca (size);
+ xpm_syms = alloca (size);
memset (xpm_syms, 0, size);
attrs.colorsymbols = xpm_syms;
@@ -3453,14 +3414,14 @@ xpm_load (struct frame *f, struct image *img)
color = XCDR (XCAR (tail));
if (STRINGP (name))
{
- xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1);
+ xpm_syms[i].name = alloca (SCHARS (name) + 1);
strcpy (xpm_syms[i].name, SSDATA (name));
}
else
xpm_syms[i].name = empty_string;
if (STRINGP (color))
{
- xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1);
+ xpm_syms[i].value = alloca (SCHARS (color) + 1);
strcpy (xpm_syms[i].value, SSDATA (color));
}
else
@@ -3583,7 +3544,7 @@ xpm_load (struct frame *f, struct image *img)
img->width = attrs.width;
img->height = attrs.height;
- xassert (img->width > 0 && img->height > 0);
+ eassert (img->width > 0 && img->height > 0);
/* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
#ifdef HAVE_NTGUI
@@ -3671,16 +3632,17 @@ xpm_scan (const unsigned char **s,
while (*s < end)
{
/* Skip white-space. */
- while (*s < end && (c = *(*s)++, isspace (c)))
+ while (*s < end && (c = *(*s)++, c_isspace (c)))
;
/* gnus-pointer.xpm uses '-' in its identifier.
sb-dir-plus.xpm uses '+' in its identifier. */
- if (isalpha (c) || c == '_' || c == '-' || c == '+')
+ if (c_isalpha (c) || c == '_' || c == '-' || c == '+')
{
*beg = *s - 1;
while (*s < end
- && (c = **s, isalnum (c) || c == '_' || c == '-' || c == '+'))
+ && (c = **s, c_isalnum (c)
+ || c == '_' || c == '-' || c == '+'))
++*s;
*len = *s - *beg;
return XPM_TK_IDENT;
@@ -3747,7 +3709,7 @@ xpm_put_color_table_v (Lisp_Object color_table,
int chars_len,
Lisp_Object color)
{
- XVECTOR (color_table)->contents[*chars_start] = color;
+ ASET (color_table, *chars_start, color);
}
static Lisp_Object
@@ -3755,7 +3717,7 @@ xpm_get_color_table_v (Lisp_Object color_table,
const unsigned char *chars_start,
int chars_len)
{
- return XVECTOR (color_table)->contents[*chars_start];
+ return AREF (color_table, *chars_start);
}
static Lisp_Object
@@ -3769,10 +3731,10 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object,
{
*put_func = xpm_put_color_table_h;
*get_func = xpm_get_color_table_h;
- return make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
+ return make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
make_float (DEFAULT_REHASH_SIZE),
make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil, Qnil, Qnil);
+ Qnil);
}
static void
@@ -3824,7 +3786,7 @@ xpm_str_to_color_key (const char *s)
return -1;
}
-static int
+static bool
xpm_load_image (struct frame *f,
struct image *img,
const unsigned char *contents,
@@ -3839,7 +3801,8 @@ xpm_load_image (struct frame *f,
void (*put_color_table) (Lisp_Object, const unsigned char *, int, Lisp_Object);
Lisp_Object (*get_color_table) (Lisp_Object, const unsigned char *, int);
Lisp_Object frame, color_symbols, color_table;
- int best_key, have_mask = 0;
+ int best_key;
+ bool have_mask = 0;
XImagePtr ximg = NULL, mask_img = NULL;
#define match() \
@@ -3974,7 +3937,7 @@ xpm_load_image (struct frame *f,
{
if (xstrcasecmp (SSDATA (XCDR (specified_color)), "None") == 0)
color_val = Qt;
- else if (x_defined_color (f, SDATA (XCDR (specified_color)),
+ else if (x_defined_color (f, SSDATA (XCDR (specified_color)),
&cdef, 0))
color_val = make_number (cdef.pixel);
}
@@ -4049,7 +4012,6 @@ xpm_load_image (struct frame *f,
failure:
image_error ("Invalid XPM file (%s)", img->spec, Qnil);
- error:
x_destroy_x_image (ximg);
x_destroy_x_image (mask_img);
x_clear_image (f, img);
@@ -4060,11 +4022,11 @@ xpm_load_image (struct frame *f,
#undef expect_ident
}
-static int
+static bool
xpm_load (struct frame *f,
struct image *img)
{
- int success_p = 0;
+ bool success_p = 0;
Lisp_Object file_name;
/* If IMG->spec specifies a file name, create a non-file spec from it. */
@@ -4082,7 +4044,7 @@ xpm_load (struct frame *f,
return 0;
}
- contents = slurp_file (SDATA (file), &size);
+ contents = slurp_file (SSDATA (file), &size);
if (contents == NULL)
{
image_error ("Error loading XPM image `%s'", img->spec, Qnil);
@@ -4158,8 +4120,7 @@ static void
init_color_table (void)
{
int size = CT_SIZE * sizeof (*ct_table);
- ct_table = (struct ct_color **) xmalloc (size);
- memset (ct_table, 0, size);
+ ct_table = xzalloc (size);
ct_colors_allocated = 0;
}
@@ -4236,7 +4197,7 @@ lookup_rgb_color (struct frame *f, int r, int g, int b)
#ifdef HAVE_X_WINDOWS
XColor color;
Colormap cmap;
- int rc;
+ bool rc;
#else
COLORREF color;
#endif
@@ -4254,7 +4215,7 @@ lookup_rgb_color (struct frame *f, int r, int g, int b)
if (rc)
{
++ct_colors_allocated;
- p = (struct ct_color *) xmalloc (sizeof *p);
+ p = xmalloc (sizeof *p);
p->r = r;
p->g = g;
p->b = b;
@@ -4272,7 +4233,7 @@ lookup_rgb_color (struct frame *f, int r, int g, int b)
color = RGB_TO_ULONG (r, g, b);
#endif /* HAVE_NTGUI */
++ct_colors_allocated;
- p = (struct ct_color *) xmalloc (sizeof *p);
+ p = xmalloc (sizeof *p);
p->r = r;
p->g = g;
p->b = b;
@@ -4304,7 +4265,7 @@ lookup_pixel_color (struct frame *f, unsigned long pixel)
{
XColor color;
Colormap cmap;
- int rc;
+ bool rc;
if (ct_colors_allocated_max <= ct_colors_allocated)
return FRAME_FOREGROUND_PIXEL (f);
@@ -4315,19 +4276,19 @@ lookup_pixel_color (struct frame *f, unsigned long pixel)
x_query_color (f, &color);
rc = x_alloc_nearest_color (f, cmap, &color);
#else
- BLOCK_INPUT;
+ block_input ();
cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
color.pixel = pixel;
XQueryColor (NULL, cmap, &color);
rc = x_alloc_nearest_color (f, cmap, &color);
- UNBLOCK_INPUT;
+ unblock_input ();
#endif /* HAVE_X_WINDOWS */
if (rc)
{
++ct_colors_allocated;
- p = (struct ct_color *) xmalloc (sizeof *p);
+ p = xmalloc (sizeof *p);
p->r = color.red;
p->g = color.green;
p->b = color.blue;
@@ -4359,8 +4320,7 @@ colors_in_color_table (int *n)
}
else
{
- colors = (unsigned long *) xmalloc (ct_colors_allocated
- * sizeof *colors);
+ colors = xmalloc (ct_colors_allocated * sizeof *colors);
*n = ct_colors_allocated;
for (i = j = 0; i < CT_SIZE; ++i)
@@ -4399,14 +4359,6 @@ init_color_table (void)
Algorithms
***********************************************************************/
-static XColor *x_to_xcolors (struct frame *, struct image *, int);
-static void x_from_xcolors (struct frame *, struct image *, XColor *);
-static void x_detect_edges (struct frame *, struct image *, int[9], int);
-
-#ifdef HAVE_NTGUI
-static void XPutPixel (XImagePtr , int, int, COLORREF);
-#endif /* HAVE_NTGUI */
-
/* Edge detection matrices for different edge-detection
strategies. */
@@ -4432,12 +4384,12 @@ static int laplace_matrix[9] = {
/* On frame F, return an array of XColor structures describing image
IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
- non-zero means also fill the red/green/blue members of the XColor
+ means also fill the red/green/blue members of the XColor
structures. Value is a pointer to the array of XColors structures,
allocated with xmalloc; it must be freed by the caller. */
static XColor *
-x_to_xcolors (struct frame *f, struct image *img, int rgb_p)
+x_to_xcolors (struct frame *f, struct image *img, bool rgb_p)
{
int x, y;
XColor *colors, *p;
@@ -4449,7 +4401,7 @@ x_to_xcolors (struct frame *f, struct image *img, int rgb_p)
if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *colors / img->width < img->height)
memory_full (SIZE_MAX);
- colors = (XColor *) xmalloc (sizeof *colors * img->width * img->height);
+ colors = xmalloc (sizeof *colors * img->width * img->height);
#ifndef HAVE_NTGUI
/* Get the X image IMG->pixmap. */
@@ -4468,9 +4420,8 @@ x_to_xcolors (struct frame *f, struct image *img, int rgb_p)
p = colors;
for (y = 0; y < img->height; ++y)
{
- XColor *row = p;
-
#if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI)
+ XColor *row = p;
for (x = 0; x < img->width; ++x, ++p)
p->pixel = GET_PIXEL (ximg, x, y);
if (rgb_p)
@@ -4603,7 +4554,7 @@ x_detect_edges (struct frame *f, struct image *img, int *matrix, int color_adjus
if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *new / img->width < img->height)
memory_full (SIZE_MAX);
- new = (XColor *) xmalloc (sizeof *new * img->width * img->height);
+ new = xmalloc (sizeof *new * img->width * img->height);
for (y = 0; y < img->height; ++y)
{
@@ -4753,14 +4704,12 @@ x_disable_image (struct frame *f, struct image *img)
if (n_planes < 2 || cross_disabled_images)
{
#ifndef HAVE_NTGUI
- Display *dpy = FRAME_X_DISPLAY (f);
- GC gc;
-
#ifndef HAVE_NS /* TODO: NS support, however this not needed for toolbars */
#define MaskForeground(f) WHITE_PIX_DEFAULT (f)
- gc = XCreateGC (dpy, img->pixmap, 0, NULL);
+ Display *dpy = FRAME_X_DISPLAY (f);
+ GC gc = XCreateGC (dpy, img->pixmap, 0, NULL);
XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
XDrawLine (dpy, img->pixmap, gc, 0, 0,
img->width - 1, img->height - 1);
@@ -4816,9 +4765,9 @@ x_disable_image (struct frame *f, struct image *img)
determine the background color of IMG. If it is a list '(R G B)',
with R, G, and B being integers >= 0, take that as the color of the
background. Otherwise, determine the background color of IMG
- heuristically. Value is non-zero if successful. */
+ heuristically. */
-static int
+static void
x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how)
{
XImagePtr_or_DC ximg;
@@ -4830,7 +4779,8 @@ x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how)
char *mask_img;
int row_width;
#endif /* HAVE_NTGUI */
- int x, y, rc, use_img_background;
+ int x, y;
+ bool rc, use_img_background;
unsigned long bg = 0;
if (img->mask)
@@ -4846,7 +4796,7 @@ x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how)
rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
&mask_img, &img->mask);
if (!rc)
- return 0;
+ return;
#endif /* !HAVE_NS */
/* Get the X image of IMG->pixmap. */
@@ -4856,8 +4806,7 @@ x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how)
#else
/* Create the bit array serving as mask. */
row_width = (img->width + 7) / 8;
- mask_img = xmalloc (row_width * img->height);
- memset (mask_img, 0, row_width * img->height);
+ mask_img = xzalloc (row_width * img->height);
/* Create a memory device context for IMG->pixmap. */
frame_dc = get_frame_dc (f);
@@ -4937,8 +4886,6 @@ x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how)
#endif /* HAVE_NTGUI */
Destroy_Image (ximg, prev);
-
- return 1;
}
@@ -4946,9 +4893,8 @@ x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how)
PBM (mono, gray, color)
***********************************************************************/
-static int pbm_image_p (Lisp_Object object);
-static int pbm_load (struct frame *f, struct image *img);
-static int pbm_scan_number (unsigned char **, unsigned char *);
+static bool pbm_image_p (Lisp_Object object);
+static bool pbm_load (struct frame *f, struct image *img);
/* The symbol `pbm' identifying images of this type. */
@@ -4998,13 +4944,14 @@ static struct image_type pbm_type =
pbm_image_p,
pbm_load,
x_clear_image,
+ NULL,
NULL
};
-/* Return non-zero if OBJECT is a valid PBM image specification. */
+/* Return true if OBJECT is a valid PBM image specification. */
-static int
+static bool
pbm_image_p (Lisp_Object object)
{
struct image_keyword fmt[PBM_LAST];
@@ -5031,7 +4978,7 @@ pbm_scan_number (unsigned char **s, unsigned char *end)
while (*s < end)
{
/* Skip white-space. */
- while (*s < end && (c = *(*s)++, isspace (c)))
+ while (*s < end && (c = *(*s)++, c_isspace (c)))
;
if (c == '#')
@@ -5040,11 +4987,11 @@ pbm_scan_number (unsigned char **s, unsigned char *end)
while (*s < end && (c = *(*s)++, c != '\n'))
;
}
- else if (isdigit (c))
+ else if (c_isdigit (c))
{
/* Read decimal number. */
val = c - '0';
- while (*s < end && (c = *(*s)++, isdigit (c)))
+ while (*s < end && (c = *(*s)++, c_isdigit (c)))
val = 10 * val + c - '0';
break;
}
@@ -5056,51 +5003,13 @@ pbm_scan_number (unsigned char **s, unsigned char *end)
}
-#ifdef HAVE_NTGUI
-#if 0 /* Unused. ++kfs */
-
-/* Read FILE into memory. Value is a pointer to a buffer allocated
- with xmalloc holding FILE's contents. Value is null if an error
- occurred. *SIZE is set to the size of the file. */
-
-static char *
-pbm_read_file (Lisp_Object file, int *size)
-{
- FILE *fp = NULL;
- char *buf = NULL;
- struct stat st;
-
- if (stat (SDATA (file), &st) == 0
- && (fp = fopen (SDATA (file), "rb")) != NULL
- && 0 <= st.st_size && st.st_size <= min (PTRDIFF_MAX, SIZE_MAX)
- && (buf = (char *) xmalloc (st.st_size),
- fread (buf, 1, st.st_size, fp) == st.st_size))
- {
- *size = st.st_size;
- fclose (fp);
- }
- else
- {
- if (fp)
- fclose (fp);
- if (buf)
- {
- xfree (buf);
- buf = NULL;
- }
- }
-
- return buf;
-}
-#endif
-#endif /* HAVE_NTGUI */
-
/* Load PBM image IMG for use on frame F. */
-static int
+static bool
pbm_load (struct frame *f, struct image *img)
{
- int raw_p, x, y;
+ bool raw_p;
+ int x, y;
int width, height, max_color_idx = 0;
XImagePtr ximg;
Lisp_Object file, specified_file;
@@ -5363,8 +5272,8 @@ pbm_load (struct frame *f, struct image *img)
/* Function prototypes. */
-static int png_image_p (Lisp_Object object);
-static int png_load (struct frame *f, struct image *img);
+static bool png_image_p (Lisp_Object object);
+static bool png_load (struct frame *f, struct image *img);
/* The symbol `png' identifying images of this type. */
@@ -5404,6 +5313,12 @@ static const struct image_keyword png_format[PNG_LAST] =
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
+#if defined HAVE_NTGUI && defined WINDOWSNT
+static bool init_png_functions (void);
+#else
+#define init_png_functions NULL
+#endif
+
/* Structure describing the image type `png'. */
static struct image_type png_type =
@@ -5412,12 +5327,13 @@ static struct image_type png_type =
png_image_p,
png_load,
x_clear_image,
+ init_png_functions,
NULL
};
-/* Return non-zero if OBJECT is a valid PNG image specification. */
+/* Return true if OBJECT is a valid PNG image specification. */
-static int
+static bool
png_image_p (Lisp_Object object)
{
struct image_keyword fmt[PNG_LAST];
@@ -5435,7 +5351,7 @@ png_image_p (Lisp_Object object)
#ifdef HAVE_PNG
-#ifdef HAVE_NTGUI
+#ifdef WINDOWSNT
/* PNG library details. */
DEF_IMGLIB_FN (png_voidp, png_get_io_ptr, (png_structp));
@@ -5469,12 +5385,12 @@ DEF_IMGLIB_FN (void, png_longjmp, (png_structp, int));
DEF_IMGLIB_FN (jmp_buf *, png_set_longjmp_fn, (png_structp, png_longjmp_ptr, size_t));
#endif /* libpng version >= 1.5 */
-static int
-init_png_functions (Lisp_Object libraries)
+static bool
+init_png_functions (void)
{
HMODULE library;
- if (!(library = w32_delayed_load (libraries, Qpng)))
+ if (!(library = w32_delayed_load (Qpng)))
return 0;
LOAD_IMGLIB_FN (library, png_get_io_ptr);
@@ -5535,27 +5451,35 @@ init_png_functions (Lisp_Object libraries)
#define fn_png_set_longjmp_fn png_set_longjmp_fn
#endif /* libpng version >= 1.5 */
-#endif /* HAVE_NTGUI */
+#endif /* WINDOWSNT */
+/* Possibly inefficient/inexact substitutes for _setjmp and _longjmp.
+ Do not use sys_setjmp, as PNG supports only jmp_buf. The _longjmp
+ substitute may munge the signal mask, but that should be OK here.
+ MinGW (MS-Windows) uses _setjmp and defines setjmp to _setjmp in
+ the system header setjmp.h; don't mess up that. */
+#ifndef HAVE__SETJMP
+# define _setjmp(j) setjmp (j)
+# define _longjmp longjmp
+#endif
#if (PNG_LIBPNG_VER < 10500)
-#define PNG_LONGJMP(ptr) (longjmp ((ptr)->jmpbuf, 1))
+#define PNG_LONGJMP(ptr) (_longjmp ((ptr)->jmpbuf, 1))
#define PNG_JMPBUF(ptr) ((ptr)->jmpbuf)
#else
/* In libpng version 1.5, the jmpbuf member is hidden. (Bug#7908) */
#define PNG_LONGJMP(ptr) (fn_png_longjmp ((ptr), 1))
#define PNG_JMPBUF(ptr) \
- (*fn_png_set_longjmp_fn ((ptr), longjmp, sizeof (jmp_buf)))
+ (*fn_png_set_longjmp_fn ((ptr), _longjmp, sizeof (jmp_buf)))
#endif
/* Error and warning handlers installed when the PNG library
is initialized. */
-static void my_png_error (png_struct *, const char *) NO_RETURN;
-static void
+static _Noreturn void
my_png_error (png_struct *png_ptr, const char *msg)
{
- xassert (png_ptr != NULL);
+ eassert (png_ptr != NULL);
/* Avoid compiler warning about deprecated direct access to
png_ptr's fields in libpng versions 1.4.x. */
image_error ("PNG error: %s", build_string (msg), Qnil);
@@ -5566,7 +5490,7 @@ my_png_error (png_struct *png_ptr, const char *msg)
static void
my_png_warning (png_struct *png_ptr, const char *msg)
{
- xassert (png_ptr != NULL);
+ eassert (png_ptr != NULL);
image_error ("PNG warning: %s", build_string (msg), Qnil);
}
@@ -5612,28 +5536,39 @@ png_read_from_file (png_structp png_ptr, png_bytep data, png_size_t length)
}
-/* Load PNG image IMG for use on frame F. Value is non-zero if
+/* Load PNG image IMG for use on frame F. Value is true if
successful. */
-static int
-png_load (struct frame *f, struct image *img)
+struct png_load_context
+{
+ /* These are members so that longjmp doesn't munge local variables. */
+ png_struct *png_ptr;
+ png_info *info_ptr;
+ png_info *end_info;
+ FILE *fp;
+ png_byte *pixels;
+ png_byte **rows;
+};
+
+static bool
+png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
{
Lisp_Object file, specified_file;
Lisp_Object specified_data;
int x, y;
ptrdiff_t i;
XImagePtr ximg, mask_img = NULL;
- png_struct *png_ptr = NULL;
+ png_struct *png_ptr;
png_info *info_ptr = NULL, *end_info = NULL;
- FILE *volatile fp = NULL;
+ FILE *fp = NULL;
png_byte sig[8];
- png_byte * volatile pixels = NULL;
- png_byte ** volatile rows = NULL;
+ png_byte *pixels = NULL;
+ png_byte **rows = NULL;
png_uint_32 width, height;
int bit_depth, color_type, interlace_type;
png_byte channels;
png_uint_32 row_bytes;
- int transparent_p;
+ bool transparent_p;
struct png_memory_storage tbr; /* Data to be read */
/* Find out what file to load. */
@@ -5695,41 +5630,47 @@ png_load (struct frame *f, struct image *img)
png_ptr = fn_png_create_read_struct (PNG_LIBPNG_VER_STRING,
NULL, my_png_error,
my_png_warning);
- if (!png_ptr)
+ if (png_ptr)
{
- if (fp) fclose (fp);
- return 0;
+ info_ptr = fn_png_create_info_struct (png_ptr);
+ end_info = fn_png_create_info_struct (png_ptr);
}
- info_ptr = fn_png_create_info_struct (png_ptr);
- if (!info_ptr)
+ c->png_ptr = png_ptr;
+ c->info_ptr = info_ptr;
+ c->end_info = end_info;
+ c->fp = fp;
+ c->pixels = pixels;
+ c->rows = rows;
+
+ if (! (info_ptr && end_info))
{
- fn_png_destroy_read_struct (&png_ptr, NULL, NULL);
- if (fp) fclose (fp);
- return 0;
+ fn_png_destroy_read_struct (&c->png_ptr, &c->info_ptr, &c->end_info);
+ png_ptr = 0;
}
-
- end_info = fn_png_create_info_struct (png_ptr);
- if (!end_info)
+ if (! png_ptr)
{
- fn_png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
if (fp) fclose (fp);
return 0;
}
/* Set error jump-back. We come back here when the PNG library
detects an error. */
- if (setjmp (PNG_JMPBUF (png_ptr)))
+ if (_setjmp (PNG_JMPBUF (png_ptr)))
{
error:
- if (png_ptr)
- fn_png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
- xfree (pixels);
- xfree (rows);
- if (fp) fclose (fp);
+ if (c->png_ptr)
+ fn_png_destroy_read_struct (&c->png_ptr, &c->info_ptr, &c->end_info);
+ xfree (c->pixels);
+ xfree (c->rows);
+ if (c->fp)
+ fclose (c->fp);
return 0;
}
+ /* Silence a bogus diagnostic; see GCC bug 54561. */
+ IF_LINT (fp = c->fp);
+
/* Read image info. */
if (!NILP (specified_data))
fn_png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
@@ -5836,7 +5777,7 @@ png_load (struct frame *f, struct image *img)
images with alpha channel, i.e. RGBA. If conversions above were
sufficient we should only have 3 or 4 channels here. */
channels = fn_png_get_channels (png_ptr, info_ptr);
- xassert (channels == 3 || channels == 4);
+ eassert (channels == 3 || channels == 4);
/* Number of bytes needed for one row of the image. */
row_bytes = fn_png_get_rowbytes (png_ptr, info_ptr);
@@ -5845,8 +5786,8 @@ png_load (struct frame *f, struct image *img)
if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *rows < height
|| min (PTRDIFF_MAX, SIZE_MAX) / sizeof *pixels / height < row_bytes)
memory_full (SIZE_MAX);
- pixels = (png_byte *) xmalloc (sizeof *pixels * row_bytes * height);
- rows = (png_byte **) xmalloc (height * sizeof *rows);
+ c->pixels = pixels = xmalloc (sizeof *pixels * row_bytes * height);
+ c->rows = rows = xmalloc (height * sizeof *rows);
for (i = 0; i < height; ++i)
rows[i] = pixels + i * row_bytes;
@@ -5856,7 +5797,7 @@ png_load (struct frame *f, struct image *img)
if (fp)
{
fclose (fp);
- fp = NULL;
+ c->fp = NULL;
}
/* Create an image and pixmap serving as mask if the PNG image
@@ -5931,7 +5872,7 @@ png_load (struct frame *f, struct image *img)
#endif /* COLOR_TABLE_SUPPORT */
/* Clean up. */
- fn_png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
+ fn_png_destroy_read_struct (&c->png_ptr, &c->info_ptr, &c->end_info);
xfree (rows);
xfree (pixels);
@@ -5960,10 +5901,17 @@ png_load (struct frame *f, struct image *img)
return 1;
}
+static bool
+png_load (struct frame *f, struct image *img)
+{
+ struct png_load_context c;
+ return png_load_body (f, img, &c);
+}
+
#else /* HAVE_PNG */
#ifdef HAVE_NS
-static int
+static bool
png_load (struct frame *f, struct image *img)
{
return ns_load_image (f, img,
@@ -5983,8 +5931,8 @@ png_load (struct frame *f, struct image *img)
#if defined (HAVE_JPEG) || defined (HAVE_NS)
-static int jpeg_image_p (Lisp_Object object);
-static int jpeg_load (struct frame *f, struct image *img);
+static bool jpeg_image_p (Lisp_Object object);
+static bool jpeg_load (struct frame *f, struct image *img);
/* The symbol `jpeg' identifying images of this type. */
@@ -6024,6 +5972,12 @@ static const struct image_keyword jpeg_format[JPEG_LAST] =
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
+#if defined HAVE_NTGUI && defined WINDOWSNT
+static bool init_jpeg_functions (void);
+#else
+#define init_jpeg_functions NULL
+#endif
+
/* Structure describing the image type `jpeg'. */
static struct image_type jpeg_type =
@@ -6032,12 +5986,13 @@ static struct image_type jpeg_type =
jpeg_image_p,
jpeg_load,
x_clear_image,
+ init_jpeg_functions,
NULL
};
-/* Return non-zero if OBJECT is a valid JPEG image specification. */
+/* Return true if OBJECT is a valid JPEG image specification. */
-static int
+static bool
jpeg_image_p (Lisp_Object object)
{
struct image_keyword fmt[JPEG_LAST];
@@ -6067,14 +6022,27 @@ jpeg_image_p (Lisp_Object object)
#define __WIN32__ 1
#endif
+/* rpcndr.h (via windows.h) and jpeglib.h both define boolean types.
+ Some versions of jpeglib try to detect whether rpcndr.h is loaded,
+ using the Windows boolean type instead of the jpeglib boolean type
+ if so. Cygwin jpeglib, however, doesn't try to detect whether its
+ headers are included along with windows.h, so under Cygwin, jpeglib
+ attempts to define a conflicting boolean type. Worse, forcing
+ Cygwin jpeglib headers to use the Windows boolean type doesn't work
+ because it created an ABI incompatibility between the
+ already-compiled jpeg library and the header interface definition.
+
+ The best we can do is to define jpeglib's boolean type to a
+ different name. This name, jpeg_boolean, remains in effect through
+ the rest of image.c.
+*/
+#if defined CYGWIN && defined HAVE_NTGUI
+#define boolean jpeg_boolean
+#endif
#include <jpeglib.h>
#include <jerror.h>
-#ifdef HAVE_STLIB_H_1
-#define HAVE_STDLIB_H 1
-#endif
-
-#ifdef HAVE_NTGUI
+#ifdef WINDOWSNT
/* JPEG library details. */
DEF_IMGLIB_FN (void, jpeg_CreateDecompress, (j_decompress_ptr, int, size_t));
@@ -6086,12 +6054,12 @@ DEF_IMGLIB_FN (JDIMENSION, jpeg_read_scanlines, (j_decompress_ptr, JSAMPARRAY, J
DEF_IMGLIB_FN (struct jpeg_error_mgr *, jpeg_std_error, (struct jpeg_error_mgr *));
DEF_IMGLIB_FN (boolean, jpeg_resync_to_restart, (j_decompress_ptr, int));
-static int
-init_jpeg_functions (Lisp_Object libraries)
+static bool
+init_jpeg_functions (void)
{
HMODULE library;
- if (!(library = w32_delayed_load (libraries, Qjpeg)))
+ if (!(library = w32_delayed_load (Qjpeg)))
return 0;
LOAD_IMGLIB_FN (library, jpeg_finish_decompress);
@@ -6124,21 +6092,34 @@ jpeg_resync_to_restart_wrapper (j_decompress_ptr cinfo, int desired)
#define fn_jpeg_std_error jpeg_std_error
#define jpeg_resync_to_restart_wrapper jpeg_resync_to_restart
-#endif /* HAVE_NTGUI */
+#endif /* WINDOWSNT */
struct my_jpeg_error_mgr
{
struct jpeg_error_mgr pub;
- jmp_buf setjmp_buffer;
+ sys_jmp_buf setjmp_buffer;
+
+ /* The remaining members are so that longjmp doesn't munge local
+ variables. */
+ struct jpeg_decompress_struct cinfo;
+ enum
+ {
+ MY_JPEG_ERROR_EXIT,
+ MY_JPEG_INVALID_IMAGE_SIZE,
+ MY_JPEG_CANNOT_CREATE_X
+ } failure_code;
+#ifdef lint
+ FILE *fp;
+#endif
};
-static void my_error_exit (j_common_ptr) NO_RETURN;
-static void
+static _Noreturn void
my_error_exit (j_common_ptr cinfo)
{
struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
- longjmp (mgr->setjmp_buffer, 1);
+ mgr->failure_code = MY_JPEG_ERROR_EXIT;
+ sys_longjmp (mgr->setjmp_buffer, 1);
}
@@ -6206,7 +6187,7 @@ our_memory_skip_input_data (j_decompress_ptr cinfo, long int num_bytes)
reading the image. */
static void
-jpeg_memory_src (j_decompress_ptr cinfo, JOCTET *data, unsigned int len)
+jpeg_memory_src (j_decompress_ptr cinfo, JOCTET *data, ptrdiff_t len)
{
struct jpeg_source_mgr *src;
@@ -6343,18 +6324,16 @@ jpeg_file_src (j_decompress_ptr cinfo, FILE *fp)
/* Load image IMG for use on frame F. Patterned after example.c
from the JPEG lib. */
-static int
-jpeg_load (struct frame *f, struct image *img)
+static bool
+jpeg_load_body (struct frame *f, struct image *img,
+ struct my_jpeg_error_mgr *mgr)
{
- struct jpeg_decompress_struct cinfo;
- struct my_jpeg_error_mgr mgr;
Lisp_Object file, specified_file;
Lisp_Object specified_data;
- FILE * volatile fp = NULL;
+ FILE *fp = NULL;
JSAMPARRAY buffer;
int row_stride, x, y;
XImagePtr ximg = NULL;
- int rc;
unsigned long *colors;
int width, height;
@@ -6384,26 +6363,37 @@ jpeg_load (struct frame *f, struct image *img)
return 0;
}
+ IF_LINT (mgr->fp = fp);
+
/* Customize libjpeg's error handling to call my_error_exit when an
error is detected. This function will perform a longjmp. */
- cinfo.err = fn_jpeg_std_error (&mgr.pub);
- mgr.pub.error_exit = my_error_exit;
-
- if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
+ mgr->cinfo.err = fn_jpeg_std_error (&mgr->pub);
+ mgr->pub.error_exit = my_error_exit;
+ if (sys_setjmp (mgr->setjmp_buffer))
{
- if (rc == 1)
+ switch (mgr->failure_code)
{
- /* Called from my_error_exit. Display a JPEG error. */
- char buf[JMSG_LENGTH_MAX];
- cinfo.err->format_message ((j_common_ptr) &cinfo, buf);
- image_error ("Error reading JPEG image `%s': %s", img->spec,
- build_string (buf));
+ case MY_JPEG_ERROR_EXIT:
+ {
+ char buf[JMSG_LENGTH_MAX];
+ mgr->cinfo.err->format_message ((j_common_ptr) &mgr->cinfo, buf);
+ image_error ("Error reading JPEG image `%s': %s", img->spec,
+ build_string (buf));
+ break;
+ }
+
+ case MY_JPEG_INVALID_IMAGE_SIZE:
+ image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil);
+ break;
+
+ case MY_JPEG_CANNOT_CREATE_X:
+ break;
}
/* Close the input file and destroy the JPEG object. */
if (fp)
- fclose ((FILE *) fp);
- fn_jpeg_destroy_decompress (&cinfo);
+ fclose (fp);
+ fn_jpeg_destroy_decompress (&mgr->cinfo);
/* If we already have an XImage, free that. */
x_destroy_x_image (ximg);
@@ -6413,46 +6403,52 @@ jpeg_load (struct frame *f, struct image *img)
return 0;
}
+ /* Silence a bogus diagnostic; see GCC bug 54561. */
+ IF_LINT (fp = mgr->fp);
+
/* Create the JPEG decompression object. Let it read from fp.
Read the JPEG image header. */
- fn_jpeg_CreateDecompress (&cinfo, JPEG_LIB_VERSION, sizeof (cinfo));
+ fn_jpeg_CreateDecompress (&mgr->cinfo, JPEG_LIB_VERSION, sizeof *&mgr->cinfo);
if (NILP (specified_data))
- jpeg_file_src (&cinfo, (FILE *) fp);
+ jpeg_file_src (&mgr->cinfo, fp);
else
- jpeg_memory_src (&cinfo, SDATA (specified_data),
+ jpeg_memory_src (&mgr->cinfo, SDATA (specified_data),
SBYTES (specified_data));
- fn_jpeg_read_header (&cinfo, 1);
+ fn_jpeg_read_header (&mgr->cinfo, 1);
/* Customize decompression so that color quantization will be used.
Start decompression. */
- cinfo.quantize_colors = 1;
- fn_jpeg_start_decompress (&cinfo);
- width = img->width = cinfo.output_width;
- height = img->height = cinfo.output_height;
+ mgr->cinfo.quantize_colors = 1;
+ fn_jpeg_start_decompress (&mgr->cinfo);
+ width = img->width = mgr->cinfo.output_width;
+ height = img->height = mgr->cinfo.output_height;
if (!check_image_size (f, width, height))
{
- image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil);
- longjmp (mgr.setjmp_buffer, 2);
+ mgr->failure_code = MY_JPEG_INVALID_IMAGE_SIZE;
+ sys_longjmp (mgr->setjmp_buffer, 1);
}
/* Create X image and pixmap. */
if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
- longjmp (mgr.setjmp_buffer, 2);
+ {
+ mgr->failure_code = MY_JPEG_CANNOT_CREATE_X;
+ sys_longjmp (mgr->setjmp_buffer, 1);
+ }
/* Allocate colors. When color quantization is used,
- cinfo.actual_number_of_colors has been set with the number of
- colors generated, and cinfo.colormap is a two-dimensional array
- of color indices in the range 0..cinfo.actual_number_of_colors.
+ mgr->cinfo.actual_number_of_colors has been set with the number of
+ colors generated, and mgr->cinfo.colormap is a two-dimensional array
+ of color indices in the range 0..mgr->cinfo.actual_number_of_colors.
No more than 255 colors will be generated. */
{
int i, ir, ig, ib;
- if (cinfo.out_color_components > 2)
+ if (mgr->cinfo.out_color_components > 2)
ir = 0, ig = 1, ib = 2;
- else if (cinfo.out_color_components > 1)
+ else if (mgr->cinfo.out_color_components > 1)
ir = 0, ig = 1, ib = 0;
else
ir = 0, ig = 0, ib = 0;
@@ -6462,16 +6458,15 @@ jpeg_load (struct frame *f, struct image *img)
a default color, and we don't have to care about which colors
can be freed safely, and which can't. */
init_color_table ();
- colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
- * sizeof *colors);
+ colors = alloca (mgr->cinfo.actual_number_of_colors * sizeof *colors);
- for (i = 0; i < cinfo.actual_number_of_colors; ++i)
+ for (i = 0; i < mgr->cinfo.actual_number_of_colors; ++i)
{
/* Multiply RGB values with 255 because X expects RGB values
in the range 0..0xffff. */
- int r = cinfo.colormap[ir][i] << 8;
- int g = cinfo.colormap[ig][i] << 8;
- int b = cinfo.colormap[ib][i] << 8;
+ int r = mgr->cinfo.colormap[ir][i] << 8;
+ int g = mgr->cinfo.colormap[ig][i] << 8;
+ int b = mgr->cinfo.colormap[ib][i] << 8;
colors[i] = lookup_rgb_color (f, r, g, b);
}
@@ -6483,21 +6478,21 @@ jpeg_load (struct frame *f, struct image *img)
}
/* Read pixels. */
- row_stride = width * cinfo.output_components;
- buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
- row_stride, 1);
+ row_stride = width * mgr->cinfo.output_components;
+ buffer = mgr->cinfo.mem->alloc_sarray ((j_common_ptr) &mgr->cinfo,
+ JPOOL_IMAGE, row_stride, 1);
for (y = 0; y < height; ++y)
{
- fn_jpeg_read_scanlines (&cinfo, buffer, 1);
- for (x = 0; x < cinfo.output_width; ++x)
+ fn_jpeg_read_scanlines (&mgr->cinfo, buffer, 1);
+ for (x = 0; x < mgr->cinfo.output_width; ++x)
XPutPixel (ximg, x, y, colors[buffer[0][x]]);
}
/* Clean up. */
- fn_jpeg_finish_decompress (&cinfo);
- fn_jpeg_destroy_decompress (&cinfo);
+ fn_jpeg_finish_decompress (&mgr->cinfo);
+ fn_jpeg_destroy_decompress (&mgr->cinfo);
if (fp)
- fclose ((FILE *) fp);
+ fclose (fp);
/* Maybe fill in the background field while we have ximg handy. */
if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
@@ -6510,10 +6505,17 @@ jpeg_load (struct frame *f, struct image *img)
return 1;
}
+static bool
+jpeg_load (struct frame *f, struct image *img)
+{
+ struct my_jpeg_error_mgr mgr;
+ return jpeg_load_body (f, img, &mgr);
+}
+
#else /* HAVE_JPEG */
#ifdef HAVE_NS
-static int
+static bool
jpeg_load (struct frame *f, struct image *img)
{
return ns_load_image (f, img,
@@ -6532,8 +6534,8 @@ jpeg_load (struct frame *f, struct image *img)
#if defined (HAVE_TIFF) || defined (HAVE_NS)
-static int tiff_image_p (Lisp_Object object);
-static int tiff_load (struct frame *f, struct image *img);
+static bool tiff_image_p (Lisp_Object object);
+static bool tiff_load (struct frame *f, struct image *img);
/* The symbol `tiff' identifying images of this type. */
@@ -6575,6 +6577,12 @@ static const struct image_keyword tiff_format[TIFF_LAST] =
{":index", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
};
+#if defined HAVE_NTGUI && defined WINDOWSNT
+static bool init_tiff_functions (void);
+#else
+#define init_tiff_functions NULL
+#endif
+
/* Structure describing the image type `tiff'. */
static struct image_type tiff_type =
@@ -6583,12 +6591,13 @@ static struct image_type tiff_type =
tiff_image_p,
tiff_load,
x_clear_image,
+ init_tiff_functions,
NULL
};
-/* Return non-zero if OBJECT is a valid TIFF image specification. */
+/* Return true if OBJECT is a valid TIFF image specification. */
-static int
+static bool
tiff_image_p (Lisp_Object object)
{
struct image_keyword fmt[TIFF_LAST];
@@ -6607,7 +6616,7 @@ tiff_image_p (Lisp_Object object)
#include <tiffio.h>
-#ifdef HAVE_NTGUI
+#ifdef WINDOWSNT
/* TIFF library details. */
DEF_IMGLIB_FN (TIFFErrorHandler, TIFFSetErrorHandler, (TIFFErrorHandler));
@@ -6622,12 +6631,12 @@ DEF_IMGLIB_FN (int, TIFFReadRGBAImage, (TIFF *, uint32, uint32, uint32 *, int));
DEF_IMGLIB_FN (void, TIFFClose, (TIFF *));
DEF_IMGLIB_FN (int, TIFFSetDirectory, (TIFF *, tdir_t));
-static int
-init_tiff_functions (Lisp_Object libraries)
+static bool
+init_tiff_functions (void)
{
HMODULE library;
- if (!(library = w32_delayed_load (libraries, Qtiff)))
+ if (!(library = w32_delayed_load (Qtiff)))
return 0;
LOAD_IMGLIB_FN (library, TIFFSetErrorHandler);
@@ -6651,7 +6660,7 @@ init_tiff_functions (Lisp_Object libraries)
#define fn_TIFFReadRGBAImage TIFFReadRGBAImage
#define fn_TIFFClose TIFFClose
#define fn_TIFFSetDirectory TIFFSetDirectory
-#endif /* HAVE_NTGUI */
+#endif /* WINDOWSNT */
/* Reading from a memory buffer for TIFF images Based on the PNG
@@ -6792,10 +6801,10 @@ tiff_warning_handler (const char *title, const char *format, va_list ap)
}
-/* Load TIFF image IMG for use on frame F. Value is non-zero if
+/* Load TIFF image IMG for use on frame F. Value is true if
successful. */
-static int
+static bool
tiff_load (struct frame *f, struct image *img)
{
Lisp_Object file, specified_file;
@@ -6896,7 +6905,7 @@ tiff_load (struct frame *f, struct image *img)
return 0;
}
- buf = (uint32 *) xmalloc (sizeof *buf * width * height);
+ buf = xmalloc (sizeof *buf * width * height);
rc = fn_TIFFReadRGBAImage (tiff, width, height, buf, 0);
@@ -6960,7 +6969,7 @@ tiff_load (struct frame *f, struct image *img)
#else /* HAVE_TIFF */
#ifdef HAVE_NS
-static int
+static bool
tiff_load (struct frame *f, struct image *img)
{
return ns_load_image (f, img,
@@ -6979,8 +6988,8 @@ tiff_load (struct frame *f, struct image *img)
#if defined (HAVE_GIF) || defined (HAVE_NS)
-static int gif_image_p (Lisp_Object object);
-static int gif_load (struct frame *f, struct image *img);
+static bool gif_image_p (Lisp_Object object);
+static bool gif_load (struct frame *f, struct image *img);
static void gif_clear_image (struct frame *f, struct image *img);
/* The symbol `gif' identifying images of this type. */
@@ -7023,6 +7032,12 @@ static const struct image_keyword gif_format[GIF_LAST] =
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
+#if defined HAVE_NTGUI && defined WINDOWSNT
+static bool init_gif_functions (void);
+#else
+#define init_gif_functions NULL
+#endif
+
/* Structure describing the image type `gif'. */
static struct image_type gif_type =
@@ -7031,6 +7046,7 @@ static struct image_type gif_type =
gif_image_p,
gif_load,
gif_clear_image,
+ init_gif_functions,
NULL
};
@@ -7043,9 +7059,9 @@ gif_clear_image (struct frame *f, struct image *img)
x_clear_image (f, img);
}
-/* Return non-zero if OBJECT is a valid GIF image specification. */
+/* Return true if OBJECT is a valid GIF image specification. */
-static int
+static bool
gif_image_p (Lisp_Object object)
{
struct image_keyword fmt[GIF_LAST];
@@ -7080,7 +7096,7 @@ gif_image_p (Lisp_Object object)
#endif /* HAVE_NTGUI */
-#ifdef HAVE_NTGUI
+#ifdef WINDOWSNT
/* GIF library details. */
DEF_IMGLIB_FN (int, DGifCloseFile, (GifFileType *));
@@ -7088,12 +7104,12 @@ DEF_IMGLIB_FN (int, DGifSlurp, (GifFileType *));
DEF_IMGLIB_FN (GifFileType *, DGifOpen, (void *, InputFunc));
DEF_IMGLIB_FN (GifFileType *, DGifOpenFileName, (const char *));
-static int
-init_gif_functions (Lisp_Object libraries)
+static bool
+init_gif_functions (void)
{
HMODULE library;
- if (!(library = w32_delayed_load (libraries, Qgif)))
+ if (!(library = w32_delayed_load (Qgif)))
return 0;
LOAD_IMGLIB_FN (library, DGifCloseFile);
@@ -7110,7 +7126,7 @@ init_gif_functions (Lisp_Object libraries)
#define fn_DGifOpen DGifOpen
#define fn_DGifOpenFileName DGifOpenFileName
-#endif /* HAVE_NTGUI */
+#endif /* WINDOWSNT */
/* Reading a GIF image from memory
Based on the PNG memory stuff to a certain extent. */
@@ -7142,7 +7158,7 @@ gif_read_from_memory (GifFileType *file, GifByteType *buf, int len)
}
-/* Load GIF image IMG for use on frame F. Value is non-zero if
+/* Load GIF image IMG for use on frame F. Value is true if
successful. */
static const int interlace_start[] = {0, 4, 2, 1};
@@ -7150,7 +7166,7 @@ static const int interlace_increment[] = {8, 8, 4, 2};
#define GIF_LOCAL_DESCRIPTOR_EXTENSION 249
-static int
+static bool
gif_load (struct frame *f, struct image *img)
{
Lisp_Object file;
@@ -7448,7 +7464,7 @@ gif_load (struct frame *f, struct image *img)
#else /* !HAVE_GIF */
#ifdef HAVE_NS
-static int
+static bool
gif_load (struct frame *f, struct image *img)
{
return ns_load_image (f, img,
@@ -7467,8 +7483,8 @@ gif_load (struct frame *f, struct image *img)
static Lisp_Object Qimagemagick;
-static int imagemagick_image_p (Lisp_Object);
-static int imagemagick_load (struct frame *, struct image *);
+static bool imagemagick_image_p (Lisp_Object);
+static bool imagemagick_load (struct frame *, struct image *);
static void imagemagick_clear_image (struct frame *, struct image *);
/* Indices of image specification fields in imagemagick_format. */
@@ -7513,6 +7529,12 @@ static struct image_keyword imagemagick_format[IMAGEMAGICK_LAST] =
{":crop", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
+#if defined HAVE_NTGUI && defined WINDOWSNT
+static bool init_imagemagick_functions (void);
+#else
+#define init_imagemagick_functions NULL
+#endif
+
/* Structure describing the image type for any image handled via
ImageMagick. */
@@ -7522,6 +7544,7 @@ static struct image_type imagemagick_type =
imagemagick_image_p,
imagemagick_load,
imagemagick_clear_image,
+ init_imagemagick_functions,
NULL
};
@@ -7534,11 +7557,11 @@ imagemagick_clear_image (struct frame *f,
x_clear_image (f, img);
}
-/* Return non-zero if OBJECT is a valid IMAGEMAGICK image specification. Do
+/* Return true if OBJECT is a valid IMAGEMAGICK image specification. Do
this by calling parse_image_spec and supplying the keywords that
identify the IMAGEMAGICK format. */
-static int
+static bool
imagemagick_image_p (Lisp_Object object)
{
struct image_keyword fmt[IMAGEMAGICK_LAST];
@@ -7575,7 +7598,7 @@ imagemagick_error (MagickWand *wand)
description = MagickGetException (wand, &severity);
image_error ("ImageMagick error: %s",
- make_string (description, strlen (description)),
+ build_string (description),
Qnil);
description = (char *) MagickRelinquishMemory (description);
}
@@ -7590,26 +7613,21 @@ imagemagick_error (MagickWand *wand)
be parsed; SIZE is the number of bytes of data; and FILENAME is
either the file name or the image data.
- Return non-zero if successful. */
+ Return true if successful. */
-static int
+static bool
imagemagick_load_image (struct frame *f, struct image *img,
unsigned char *contents, unsigned int size,
char *filename)
{
- size_t width;
- size_t height;
-
+ size_t width, height;
MagickBooleanType status;
-
XImagePtr ximg;
- int x;
- int y;
-
- MagickWand *image_wand;
- MagickWand *ping_wand;
+ int x, y;
+ MagickWand *image_wand;
+ MagickWand *ping_wand;
PixelIterator *iterator;
- PixelWand **pixels;
+ PixelWand **pixels, *bg_wand = NULL;
MagickPixelPacket pixel;
Lisp_Object image;
Lisp_Object value;
@@ -7617,12 +7635,7 @@ imagemagick_load_image (struct frame *f, struct image *img,
EMACS_INT ino;
int desired_width, desired_height;
double rotation;
- EMACS_INT imagemagick_rendermethod;
int pixelwidth;
- ImageInfo *image_info;
- ExceptionInfo *exception;
- Image * im_image;
-
/* Handle image index for image types who can contain more than one image.
Interface :index is same as for GIF. First we "ping" the image to see how
@@ -7636,14 +7649,9 @@ imagemagick_load_image (struct frame *f, struct image *img,
ping_wand = NewMagickWand ();
/* MagickSetResolution (ping_wand, 2, 2); (Bug#10112) */
- if (filename != NULL)
- {
- status = MagickPingImage (ping_wand, filename);
- }
- else
- {
- status = MagickPingImageBlob (ping_wand, contents, size);
- }
+ status = filename
+ ? MagickPingImage (ping_wand, filename)
+ : MagickPingImageBlob (ping_wand, contents, size);
if (status == MagickFalse)
{
@@ -7652,7 +7660,7 @@ imagemagick_load_image (struct frame *f, struct image *img,
return 0;
}
- if (! (0 <= ino && ino < MagickGetNumberImages (ping_wand)))
+ if (ino < 0 || ino >= MagickGetNumberImages (ping_wand))
{
image_error ("Invalid image number `%s' in image `%s'",
image, img->spec);
@@ -7669,39 +7677,46 @@ imagemagick_load_image (struct frame *f, struct image *img,
DestroyMagickWand (ping_wand);
/* Now we know how many images are inside the file. If it's not a
- bundle, the number is one. */
+ bundle, the number is one. Load the image data. */
- if (filename != NULL)
- {
- image_info = CloneImageInfo ((ImageInfo *) NULL);
- (void) strcpy (image_info->filename, filename);
- image_info->number_scenes = 1;
- image_info->scene = ino;
- exception = AcquireExceptionInfo ();
-
- im_image = ReadImage (image_info, exception);
- DestroyExceptionInfo (exception);
+ image_wand = NewMagickWand ();
- if (im_image == NULL)
- goto imagemagick_no_wand;
- image_wand = NewMagickWandFromImage (im_image);
- DestroyImage (im_image);
- }
- else
+ if ((filename
+ ? MagickReadImage (image_wand, filename)
+ : MagickReadImageBlob (image_wand, contents, size))
+ == MagickFalse)
{
- image_wand = NewMagickWand ();
- if (MagickReadImageBlob (image_wand, contents, size) == MagickFalse)
- {
- imagemagick_error (image_wand);
- goto imagemagick_error;
- }
+ imagemagick_error (image_wand);
+ goto imagemagick_error;
}
+ /* Retrieve the frame's background color, for use later. */
+ {
+ XColor bgcolor;
+ Lisp_Object specified_bg;
+
+ specified_bg = image_spec_value (img->spec, QCbackground, NULL);
+ if (!STRINGP (specified_bg)
+ || !x_defined_color (f, SSDATA (specified_bg), &bgcolor, 0))
+ {
+#ifndef HAVE_NS
+ bgcolor.pixel = FRAME_BACKGROUND_PIXEL (f);
+ x_query_color (f, &bgcolor);
+#else
+ ns_query_color (FRAME_BACKGROUND_COLOR (f), &bgcolor, 1);
+#endif
+ }
+
+ bg_wand = NewPixelWand ();
+ PixelSetRed (bg_wand, (double) bgcolor.red / 65535);
+ PixelSetGreen (bg_wand, (double) bgcolor.green / 65535);
+ PixelSetBlue (bg_wand, (double) bgcolor.blue / 65535);
+ }
+
/* If width and/or height is set in the display spec assume we want
to scale to those values. If either h or w is unspecified, the
unspecified should be calculated from the specified to preserve
aspect ratio. */
-
value = image_spec_value (img->spec, QCwidth, NULL);
desired_width = (INTEGERP (value) ? XFASTINT (value) : -1);
value = image_spec_value (img->spec, QCheight, NULL);
@@ -7767,13 +7782,8 @@ imagemagick_load_image (struct frame *f, struct image *img,
value = image_spec_value (img->spec, QCrotation, NULL);
if (FLOATP (value))
{
- PixelWand* background = NewPixelWand ();
- PixelSetColor (background, "#ffffff");/*TODO remove hardcode*/
-
rotation = extract_float (value);
-
- status = MagickRotateImage (image_wand, background, rotation);
- DestroyPixelWand (background);
+ status = MagickRotateImage (image_wand, bg_wand, rotation);
if (status == MagickFalse)
{
image_error ("Imagemagick image rotate failed", Qnil, Qnil);
@@ -7787,6 +7797,22 @@ imagemagick_load_image (struct frame *f, struct image *img,
height = MagickGetImageHeight (image_wand);
width = MagickGetImageWidth (image_wand);
+ /* Set the canvas background color to the frame or specified
+ background, and flatten the image. Note: as of ImageMagick
+ 6.6.0, SVG image transparency is not handled properly
+ (e.g. etc/images/splash.svg shows a white background always). */
+ {
+ MagickWand *new_wand;
+ MagickSetImageBackgroundColor (image_wand, bg_wand);
+#ifdef HAVE_MAGICKMERGEIMAGELAYERS
+ new_wand = MagickMergeImageLayers (image_wand, MergeLayer);
+#else
+ new_wand = MagickFlattenImages (image_wand);
+#endif
+ DestroyMagickWand (image_wand);
+ image_wand = new_wand;
+ }
+
if (! (width <= INT_MAX && height <= INT_MAX
&& check_image_size (f, width, height)))
{
@@ -7798,9 +7824,51 @@ imagemagick_load_image (struct frame *f, struct image *img,
went ok. */
init_color_table ();
- imagemagick_rendermethod = (INTEGERP (Vimagemagick_render_type)
- ? XINT (Vimagemagick_render_type) : 0);
- if (imagemagick_rendermethod == 0)
+
+#ifdef HAVE_MAGICKEXPORTIMAGEPIXELS
+ if (imagemagick_render_type != 0)
+ {
+ /* Magicexportimage is normally faster than pixelpushing. This
+ method is also well tested. Some aspects of this method are
+ ad-hoc and needs to be more researched. */
+ int imagedepth = 24; /*MagickGetImageDepth(image_wand);*/
+ const char *exportdepth = imagedepth <= 8 ? "I" : "BGRP"; /*"RGBP";*/
+ /* Try to create a x pixmap to hold the imagemagick pixmap. */
+ if (!x_create_x_image_and_pixmap (f, width, height, imagedepth,
+ &ximg, &img->pixmap))
+ {
+#ifdef COLOR_TABLE_SUPPORT
+ free_color_table ();
+#endif
+ image_error ("Imagemagick X bitmap allocation failure", Qnil, Qnil);
+ goto imagemagick_error;
+ }
+
+ /* Oddly, the below code doesn't seem to work:*/
+ /* switch(ximg->bitmap_unit){ */
+ /* case 8: */
+ /* pixelwidth=CharPixel; */
+ /* break; */
+ /* case 16: */
+ /* pixelwidth=ShortPixel; */
+ /* break; */
+ /* case 32: */
+ /* pixelwidth=LongPixel; */
+ /* break; */
+ /* } */
+ /*
+ Here im just guessing the format of the bitmap.
+ happens to work fine for:
+ - bw djvu images
+ on rgb display.
+ seems about 3 times as fast as pixel pushing(not carefully measured)
+ */
+ pixelwidth = CharPixel; /*??? TODO figure out*/
+ MagickExportImagePixels (image_wand, 0, 0, width, height,
+ exportdepth, pixelwidth, ximg->data);
+ }
+ else
+#endif /* HAVE_MAGICKEXPORTIMAGEPIXELS */
{
size_t image_height;
@@ -7851,67 +7919,12 @@ imagemagick_load_image (struct frame *f, struct image *img,
DestroyPixelIterator (iterator);
}
- if (imagemagick_rendermethod == 1)
- {
- /* Magicexportimage is normally faster than pixelpushing. This
- method is also well tested. Some aspects of this method are
- ad-hoc and needs to be more researched. */
- int imagedepth = 24;/*MagickGetImageDepth(image_wand);*/
- const char *exportdepth = imagedepth <= 8 ? "I" : "BGRP";/*"RGBP";*/
- /* Try to create a x pixmap to hold the imagemagick pixmap. */
- if (!x_create_x_image_and_pixmap (f, width, height, imagedepth,
- &ximg, &img->pixmap))
- {
-#ifdef COLOR_TABLE_SUPPORT
- free_color_table ();
-#endif
- image_error ("Imagemagick X bitmap allocation failure", Qnil, Qnil);
- goto imagemagick_error;
- }
-
-
- /* Oddly, the below code doesn't seem to work:*/
- /* switch(ximg->bitmap_unit){ */
- /* case 8: */
- /* pixelwidth=CharPixel; */
- /* break; */
- /* case 16: */
- /* pixelwidth=ShortPixel; */
- /* break; */
- /* case 32: */
- /* pixelwidth=LongPixel; */
- /* break; */
- /* } */
- /*
- Here im just guessing the format of the bitmap.
- happens to work fine for:
- - bw djvu images
- on rgb display.
- seems about 3 times as fast as pixel pushing(not carefully measured)
- */
- pixelwidth = CharPixel;/*??? TODO figure out*/
-#ifdef HAVE_MAGICKEXPORTIMAGEPIXELS
- MagickExportImagePixels (image_wand,
- 0, 0,
- width, height,
- exportdepth,
- pixelwidth,
- /*&(img->pixmap));*/
- ximg->data);
-#else
- image_error ("You don't have MagickExportImagePixels, upgrade ImageMagick!",
- Qnil, Qnil);
-#endif
- }
-
-
#ifdef COLOR_TABLE_SUPPORT
/* Remember colors allocated for this image. */
img->colors = colors_in_color_table (&img->ncolors);
free_color_table ();
#endif /* COLOR_TABLE_SUPPORT */
-
img->width = width;
img->height = height;
@@ -7920,9 +7933,10 @@ imagemagick_load_image (struct frame *f, struct image *img,
x_put_x_image (f, ximg, img->pixmap, width, height);
x_destroy_x_image (ximg);
-
/* Final cleanup. image_wand should be the only resource left. */
DestroyMagickWand (image_wand);
+ if (bg_wand) DestroyPixelWand (bg_wand);
+
/* `MagickWandTerminus' terminates the imagemagick environment. */
MagickWandTerminus ();
@@ -7930,7 +7944,8 @@ imagemagick_load_image (struct frame *f, struct image *img,
imagemagick_error:
DestroyMagickWand (image_wand);
- imagemagick_no_wand:
+ if (bg_wand) DestroyPixelWand (bg_wand);
+
MagickWandTerminus ();
/* TODO more cleanup. */
image_error ("Error parsing IMAGEMAGICK image `%s'", img->spec, Qnil);
@@ -7938,14 +7953,14 @@ imagemagick_load_image (struct frame *f, struct image *img,
}
-/* Load IMAGEMAGICK image IMG for use on frame F. Value is non-zero if
+/* Load IMAGEMAGICK image IMG for use on frame F. Value is true if
successful. this function will go into the imagemagick_type structure, and
the prototype thus needs to be compatible with that structure. */
-static int
+static bool
imagemagick_load (struct frame *f, struct image *img)
{
- int success_p = 0;
+ bool success_p = 0;
Lisp_Object file_name;
/* If IMG->spec specifies a file name, create a non-file spec from it. */
@@ -7986,17 +8001,24 @@ DEFUN ("imagemagick-types", Fimagemagick_types, Simagemagick_types, 0, 0, 0,
Each entry in this list is a symbol named after an ImageMagick format
tag. See the ImageMagick manual for a list of ImageMagick formats and
their descriptions (http://www.imagemagick.org/script/formats.php).
+You can also try the shell command: `identify -list format'.
Note that ImageMagick recognizes many file-types that Emacs does not
-recognize as images, such as C. See `imagemagick-types-inhibit'. */)
+recognize as images, such as C. See `imagemagick-types-enable'
+and `imagemagick-types-inhibit'. */)
(void)
{
Lisp_Object typelist = Qnil;
size_t numf = 0;
ExceptionInfo ex;
- char **imtypes = GetMagickList ("*", &numf, &ex);
+ char **imtypes;
size_t i;
Lisp_Object Qimagemagicktype;
+
+ GetExceptionInfo(&ex);
+ imtypes = GetMagickList ("*", &numf, &ex);
+ DestroyExceptionInfo(&ex);
+
for (i = 0; i < numf; i++)
{
Qimagemagicktype = intern (imtypes[i]);
@@ -8017,11 +8039,11 @@ recognize as images, such as C. See `imagemagick-types-inhibit'. */)
/* Function prototypes. */
-static int svg_image_p (Lisp_Object object);
-static int svg_load (struct frame *f, struct image *img);
+static bool svg_image_p (Lisp_Object object);
+static bool svg_load (struct frame *f, struct image *img);
-static int svg_load_image (struct frame *, struct image *,
- unsigned char *, ptrdiff_t);
+static bool svg_load_image (struct frame *, struct image *,
+ unsigned char *, ptrdiff_t);
/* The symbol `svg' identifying images of this type. */
@@ -8061,31 +8083,32 @@ static const struct image_keyword svg_format[SVG_LAST] =
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
+#if defined HAVE_NTGUI && defined WINDOWSNT
+static bool init_svg_functions (void);
+#else
+#define init_svg_functions NULL
+#endif
+
/* Structure describing the image type `svg'. Its the same type of
structure defined for all image formats, handled by emacs image
functions. See struct image_type in dispextern.h. */
static struct image_type svg_type =
{
- /* An identifier showing that this is an image structure for the SVG format. */
&Qsvg,
- /* Handle to a function that can be used to identify a SVG file. */
svg_image_p,
- /* Handle to function used to load a SVG file. */
svg_load,
- /* Handle to function to free sresources for SVG. */
x_clear_image,
- /* An internal field to link to the next image type in a list of
- image types, will be filled in when registering the format. */
+ init_svg_functions,
NULL
};
-/* Return non-zero if OBJECT is a valid SVG image specification. Do
+/* Return true if OBJECT is a valid SVG image specification. Do
this by calling parse_image_spec and supplying the keywords that
identify the SVG format. */
-static int
+static bool
svg_image_p (Lisp_Object object)
{
struct image_keyword fmt[SVG_LAST];
@@ -8100,7 +8123,7 @@ svg_image_p (Lisp_Object object)
#include <librsvg/rsvg.h>
-#ifdef HAVE_NTGUI
+#ifdef WINDOWSNT
/* SVG library functions. */
DEF_IMGLIB_FN (RsvgHandle *, rsvg_handle_new);
@@ -8124,15 +8147,15 @@ DEF_IMGLIB_FN (void, g_error_free);
Lisp_Object Qgdk_pixbuf, Qglib, Qgobject;
-static int
-init_svg_functions (Lisp_Object libraries)
+static bool
+init_svg_functions (void)
{
HMODULE library, gdklib, glib, gobject;
- if (!(glib = w32_delayed_load (libraries, Qglib))
- || !(gobject = w32_delayed_load (libraries, Qgobject))
- || !(gdklib = w32_delayed_load (libraries, Qgdk_pixbuf))
- || !(library = w32_delayed_load (libraries, Qsvg)))
+ if (!(glib = w32_delayed_load (Qglib))
+ || !(gobject = w32_delayed_load (Qgobject))
+ || !(gdklib = w32_delayed_load (Qgdk_pixbuf))
+ || !(library = w32_delayed_load (Qsvg)))
return 0;
LOAD_IMGLIB_FN (library, rsvg_handle_new);
@@ -8178,16 +8201,15 @@ init_svg_functions (Lisp_Object libraries)
#define fn_g_type_init g_type_init
#define fn_g_object_unref g_object_unref
#define fn_g_error_free g_error_free
-#endif /* !HAVE_NTGUI */
+#endif /* !WINDOWSNT */
-/* Load SVG image IMG for use on frame F. Value is non-zero if
- successful. this function will go into the svg_type structure, and
- the prototype thus needs to be compatible with that structure. */
+/* Load SVG image IMG for use on frame F. Value is true if
+ successful. */
-static int
+static bool
svg_load (struct frame *f, struct image *img)
{
- int success_p = 0;
+ bool success_p = 0;
Lisp_Object file_name;
/* If IMG->spec specifies a file name, create a non-file spec from it. */
@@ -8240,8 +8262,8 @@ svg_load (struct frame *f, struct image *img)
Uses librsvg to do most of the image processing.
- Returns non-zero when successful. */
-static int
+ Returns true when successful. */
+static bool
svg_load_image (struct frame *f, /* Pointer to emacs frame structure. */
struct image *img, /* Pointer to emacs image structure. */
unsigned char *contents, /* String containing the SVG XML data to be parsed. */
@@ -8408,8 +8430,8 @@ svg_load_image (struct frame *f, /* Pointer to emacs frame structure. *
#ifdef HAVE_GHOSTSCRIPT
-static int gs_image_p (Lisp_Object object);
-static int gs_load (struct frame *f, struct image *img);
+static bool gs_image_p (Lisp_Object object);
+static bool gs_load (struct frame *f, struct image *img);
static void gs_clear_image (struct frame *f, struct image *img);
/* Keyword symbols. */
@@ -8464,6 +8486,7 @@ static struct image_type gs_type =
gs_image_p,
gs_load,
gs_clear_image,
+ NULL,
NULL
};
@@ -8477,10 +8500,10 @@ gs_clear_image (struct frame *f, struct image *img)
}
-/* Return non-zero if OBJECT is a valid Ghostscript image
+/* Return true if OBJECT is a valid Ghostscript image
specification. */
-static int
+static bool
gs_image_p (Lisp_Object object)
{
struct image_keyword fmt[GS_LAST];
@@ -8507,7 +8530,7 @@ gs_image_p (Lisp_Object object)
if (ASIZE (tem) != 4)
return 0;
for (i = 0; i < 4; ++i)
- if (!INTEGERP (XVECTOR (tem)->contents[i]))
+ if (!INTEGERP (AREF (tem, i)))
return 0;
}
else
@@ -8517,10 +8540,10 @@ gs_image_p (Lisp_Object object)
}
-/* Load Ghostscript image IMG for use on frame F. Value is non-zero
+/* Load Ghostscript image IMG for use on frame F. Value is true
if successful. */
-static int
+static bool
gs_load (struct frame *f, struct image *img)
{
uprintmax_t printnum1, printnum2;
@@ -8551,16 +8574,16 @@ gs_load (struct frame *f, struct image *img)
img->height = in_height;
/* Create the pixmap. */
- xassert (img->pixmap == NO_PIXMAP);
+ eassert (img->pixmap == NO_PIXMAP);
if (x_check_image_size (0, img->width, img->height))
{
/* Only W32 version did BLOCK_INPUT here. ++kfs */
- BLOCK_INPUT;
+ block_input ();
img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
img->width, img->height,
DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (!img->pixmap)
@@ -8575,13 +8598,13 @@ gs_load (struct frame *f, struct image *img)
don't either. Let the Lisp loader use `unwind-protect' instead. */
printnum1 = FRAME_X_WINDOW (f);
printnum2 = img->pixmap;
- sprintf (buffer, "%"pMu" %"pMu, printnum1, printnum2);
- window_and_pixmap_id = build_string (buffer);
+ window_and_pixmap_id
+ = make_formatted_string (buffer, "%"pMu" %"pMu, printnum1, printnum2);
printnum1 = FRAME_FOREGROUND_PIXEL (f);
printnum2 = FRAME_BACKGROUND_PIXEL (f);
- sprintf (buffer, "%"pMu" %"pMu, printnum1, printnum2);
- pixel_colors = build_string (buffer);
+ pixel_colors
+ = make_formatted_string (buffer, "%"pMu" %"pMu, printnum1, printnum2);
XSETFRAME (frame, f);
loader = image_spec_value (img->spec, QCloader, NULL);
@@ -8622,7 +8645,7 @@ x_kill_gs_process (Pixmap pixmap, struct frame *f)
/* Kill the GS process. We should have found PIXMAP in the image
cache and its image should contain a process object. */
img = c->images[i];
- xassert (PROCESSP (img->lisp_data));
+ eassert (PROCESSP (img->lisp_data));
Fkill_process (img->lisp_data, Qnil);
img->lisp_data = Qnil;
@@ -8636,7 +8659,7 @@ x_kill_gs_process (Pixmap pixmap, struct frame *f)
{
XImagePtr ximg;
- BLOCK_INPUT;
+ block_input ();
/* Try to get an XImage for img->pixmep. */
ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
@@ -8679,15 +8702,15 @@ x_kill_gs_process (Pixmap pixmap, struct frame *f)
image_error ("Cannot get X image of `%s'; colors will not be freed",
img->spec, Qnil);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* HAVE_X_WINDOWS */
/* Now that we have the pixmap, compute mask and transform the
image if requested. */
- BLOCK_INPUT;
+ block_input ();
postprocess_image (f, img);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* HAVE_GHOSTSCRIPT */
@@ -8697,7 +8720,7 @@ x_kill_gs_process (Pixmap pixmap, struct frame *f)
Tests
***********************************************************************/
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
DEFUN ("imagep", Fimagep, Simagep, 1, 1, 0,
doc: /* Value is non-nil if SPEC is a valid image specification. */)
@@ -8719,95 +8742,99 @@ DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, "")
return make_number (id);
}
-#endif /* GLYPH_DEBUG != 0 */
+#endif /* GLYPH_DEBUG */
/***********************************************************************
Initialization
***********************************************************************/
-#ifdef HAVE_NTGUI
-/* Image types that rely on external libraries are loaded dynamically
- if the library is available. */
-#define CHECK_LIB_AVAILABLE(image_type, init_lib_fn, libraries) \
- define_image_type (image_type, init_lib_fn (libraries))
-#else
-#define CHECK_LIB_AVAILABLE(image_type, init_lib_fn, libraries) \
- define_image_type (image_type, 1)
-#endif /* HAVE_NTGUI */
-
-DEFUN ("init-image-library", Finit_image_library, Sinit_image_library, 2, 2, 0,
+DEFUN ("init-image-library", Finit_image_library, Sinit_image_library, 1, 1, 0,
doc: /* Initialize image library implementing image type TYPE.
Return non-nil if TYPE is a supported image type.
-Image types pbm and xbm are prebuilt; other types are loaded here.
-Libraries to load are specified in alist LIBRARIES (usually, the value
-of `dynamic-library-alist', which see). */)
- (Lisp_Object type, Lisp_Object libraries)
+If image libraries are loaded dynamically (currently only the case on
+MS-Windows), load the library for TYPE if it is not yet loaded, using
+the library file(s) specified by `dynamic-library-alist'. */)
+ (Lisp_Object type)
{
-#ifdef HAVE_NTGUI
- /* Don't try to reload the library. */
- Lisp_Object tested = Fassq (type, Vlibrary_cache);
- if (CONSP (tested))
- return XCDR (tested);
-#endif
+ return lookup_image_type (type) ? Qt : Qnil;
+}
+
+/* Look up image type TYPE, and return a pointer to its image_type
+ structure. Return 0 if TYPE is not a known image type. */
+static struct image_type *
+lookup_image_type (Lisp_Object type)
+{
/* Types pbm and xbm are built-in and always available. */
- if (EQ (type, Qpbm) || EQ (type, Qxbm))
- return Qt;
+ if (EQ (type, Qpbm))
+ return define_image_type (&pbm_type);
+
+ if (EQ (type, Qxbm))
+ return define_image_type (&xbm_type);
#if defined (HAVE_XPM) || defined (HAVE_NS)
if (EQ (type, Qxpm))
- return CHECK_LIB_AVAILABLE (&xpm_type, init_xpm_functions, libraries);
+ return define_image_type (&xpm_type);
#endif
#if defined (HAVE_JPEG) || defined (HAVE_NS)
if (EQ (type, Qjpeg))
- return CHECK_LIB_AVAILABLE (&jpeg_type, init_jpeg_functions, libraries);
+ return define_image_type (&jpeg_type);
#endif
#if defined (HAVE_TIFF) || defined (HAVE_NS)
if (EQ (type, Qtiff))
- return CHECK_LIB_AVAILABLE (&tiff_type, init_tiff_functions, libraries);
+ return define_image_type (&tiff_type);
#endif
#if defined (HAVE_GIF) || defined (HAVE_NS)
if (EQ (type, Qgif))
- return CHECK_LIB_AVAILABLE (&gif_type, init_gif_functions, libraries);
+ return define_image_type (&gif_type);
#endif
#if defined (HAVE_PNG) || defined (HAVE_NS)
if (EQ (type, Qpng))
- return CHECK_LIB_AVAILABLE (&png_type, init_png_functions, libraries);
+ return define_image_type (&png_type);
#endif
#if defined (HAVE_RSVG)
if (EQ (type, Qsvg))
- return CHECK_LIB_AVAILABLE (&svg_type, init_svg_functions, libraries);
+ return define_image_type (&svg_type);
#endif
#if defined (HAVE_IMAGEMAGICK)
if (EQ (type, Qimagemagick))
- return CHECK_LIB_AVAILABLE (&imagemagick_type, init_imagemagick_functions,
- libraries);
+ return define_image_type (&imagemagick_type);
#endif
#ifdef HAVE_GHOSTSCRIPT
if (EQ (type, Qpostscript))
- return CHECK_LIB_AVAILABLE (&gs_type, init_gs_functions, libraries);
+ return define_image_type (&gs_type);
#endif
- /* If the type is not recognized, avoid testing it ever again. */
- CACHE_IMAGE_TYPE (type, Qnil);
- return Qnil;
+ return NULL;
+}
+
+/* Reset image_types before dumping.
+ Called from Fdump_emacs. */
+
+void
+reset_image_types (void)
+{
+ while (image_types)
+ {
+ struct image_type *next = image_types->next;
+ xfree (image_types);
+ image_types = next;
+ }
}
void
syms_of_image (void)
{
- /* Initialize this only once, since that's what we do with Vimage_types
- and they are supposed to be in sync. Initializing here gives correct
- operation on GNU/Linux of calling dump-emacs after loading some images. */
+ /* Initialize this only once; it will be reset before dumping. */
image_types = NULL;
/* Must be defined now because we're going to update it below, while
@@ -8830,15 +8857,6 @@ as a ratio to the frame height and width. If the value is
non-numeric, there is no explicit limit on the size of images. */);
Vmax_image_size = make_float (MAX_IMAGE_SIZE);
- DEFSYM (Qpbm, "pbm");
- ADD_IMAGE_TYPE (Qpbm);
-
- DEFSYM (Qxbm, "xbm");
- ADD_IMAGE_TYPE (Qxbm);
-
- define_image_type (&xbm_type, 1);
- define_image_type (&pbm_type, 1);
-
DEFSYM (Qcount, "count");
DEFSYM (Qextension_data, "extension-data");
DEFSYM (Qdelay, "delay");
@@ -8882,6 +8900,12 @@ non-numeric, there is no explicit limit on the size of images. */);
);
#endif
+ DEFSYM (Qpbm, "pbm");
+ ADD_IMAGE_TYPE (Qpbm);
+
+ DEFSYM (Qxbm, "xbm");
+ ADD_IMAGE_TYPE (Qxbm);
+
#if defined (HAVE_XPM) || defined (HAVE_NS)
DEFSYM (Qxpm, "xpm");
ADD_IMAGE_TYPE (Qxpm);
@@ -8933,7 +8957,7 @@ non-numeric, there is no explicit limit on the size of images. */);
defsubr (&Simage_mask_p);
defsubr (&Simage_metadata);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
defsubr (&Simagep);
defsubr (&Slookup_image);
#endif
@@ -8958,13 +8982,17 @@ The value can also be nil, meaning the cache is never cleared.
The function `clear-image-cache' disregards this variable. */);
Vimage_cache_eviction_delay = make_number (300);
#ifdef HAVE_IMAGEMAGICK
- DEFVAR_LISP ("imagemagick-render-type", Vimagemagick_render_type,
- doc: /* Choose between ImageMagick render methods. */);
+ DEFVAR_INT ("imagemagick-render-type", imagemagick_render_type,
+ doc: /* Integer indicating which ImageMagick rendering method to use.
+The options are:
+ 0 -- the default method (pixel pushing)
+ 1 -- a newer method ("MagickExportImagePixels") that may perform
+ better (speed etc) in some cases, but has not been as thoroughly
+ tested with Emacs as the default method. This method requires
+ ImageMagick version 6.4.6 (approximately) or later.
+*/);
+ /* MagickExportImagePixels is in 6.4.6-9, but not 6.4.4-10. */
+ imagemagick_render_type = 0;
#endif
}
-
-void
-init_image (void)
-{
-}
diff --git a/src/indent.c b/src/indent.c
index 07a54c0c1b7..a3abf88feeb 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1,5 +1,5 @@
/* Indentation functions.
- Copyright (C) 1985-1988, 1993-1995, 1998, 2000-2011
+ Copyright (C) 1985-1988, 1993-1995, 1998, 2000-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,11 +19,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "category.h"
#include "composite.h"
#include "indent.h"
@@ -31,7 +30,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "frame.h"
#include "window.h"
#include "termchar.h"
-#include "termopts.h"
#include "disptab.h"
#include "intervals.h"
#include "dispextern.h"
@@ -45,23 +43,23 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
Some things in set last_known_column_point to -1
to mark the memorized value as invalid. */
-static EMACS_INT last_known_column;
+static ptrdiff_t last_known_column;
/* Value of point when current_column was called. */
-EMACS_INT last_known_column_point;
+ptrdiff_t last_known_column_point;
/* Value of MODIFF when current_column was called. */
-static int last_known_column_modified;
+static EMACS_INT last_known_column_modified;
-static EMACS_INT current_column_1 (void);
-static EMACS_INT position_indentation (ptrdiff_t);
+static ptrdiff_t current_column_1 (void);
+static ptrdiff_t position_indentation (ptrdiff_t);
/* Cache of beginning of line found by the last call of
current_column. */
-static EMACS_INT current_column_bol_cache;
+static ptrdiff_t current_column_bol_cache;
/* Get the display table to use for the current buffer. */
@@ -116,13 +114,12 @@ character_width (int c, struct Lisp_Char_Table *dp)
for characters as WIDTHTAB. We use this to decide when to
invalidate the buffer's width_run_cache. */
-int
+bool
disptab_matches_widthtab (struct Lisp_Char_Table *disptab, struct Lisp_Vector *widthtab)
{
int i;
- if (widthtab->header.size != 256)
- abort ();
+ eassert (widthtab->header.size == 256);
for (i = 0; i < 256; i++)
if (character_width (i, disptab)
@@ -141,10 +138,9 @@ recompute_width_table (struct buffer *buf, struct Lisp_Char_Table *disptab)
struct Lisp_Vector *widthtab;
if (!VECTORP (BVAR (buf, width_table)))
- BVAR (buf, width_table) = Fmake_vector (make_number (256), make_number (0));
+ bset_width_table (buf, Fmake_vector (make_number (256), make_number (0)));
widthtab = XVECTOR (BVAR (buf, width_table));
- if (widthtab->header.size != 256)
- abort ();
+ eassert (widthtab->header.size == 256);
for (i = 0; i < 256; i++)
XSETFASTINT (widthtab->contents[i], character_width (i, disptab));
@@ -166,7 +162,7 @@ width_run_cache_on_off (void)
{
free_region_cache (current_buffer->width_run_cache);
current_buffer->width_run_cache = 0;
- BVAR (current_buffer, width_table) = Qnil;
+ bset_width_table (current_buffer, Qnil);
}
}
else
@@ -204,12 +200,12 @@ width_run_cache_on_off (void)
characters immediately following, then *NEXT_BOUNDARY_P
will equal the return value. */
-EMACS_INT
-skip_invisible (EMACS_INT pos, EMACS_INT *next_boundary_p, EMACS_INT to, Lisp_Object window)
+ptrdiff_t
+skip_invisible (ptrdiff_t pos, ptrdiff_t *next_boundary_p, ptrdiff_t to, Lisp_Object window)
{
Lisp_Object prop, position, overlay_limit, proplimit;
Lisp_Object buffer, tmp;
- EMACS_INT end;
+ ptrdiff_t end;
int inv_p;
XSETFASTINT (position, pos);
@@ -318,17 +314,17 @@ invalidate_current_column (void)
last_known_column_point = 0;
}
-EMACS_INT
+ptrdiff_t
current_column (void)
{
- register EMACS_INT col;
- register unsigned char *ptr, *stop;
- register int tab_seen;
- EMACS_INT post_tab;
- register int c;
+ ptrdiff_t col;
+ unsigned char *ptr, *stop;
+ bool tab_seen;
+ ptrdiff_t post_tab;
+ int c;
int tab_width = SANE_TAB_WIDTH (current_buffer);
- int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
- register struct Lisp_Char_Table *dp = buffer_display_table ();
+ bool ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
+ struct Lisp_Char_Table *dp = buffer_display_table ();
if (PT == last_known_column_point
&& MODIFF == last_known_column_modified)
@@ -336,9 +332,8 @@ current_column (void)
/* If the buffer has overlays, text properties,
or multibyte characters, use a more general algorithm. */
- if (BUF_INTERVALS (current_buffer)
- || current_buffer->overlays_before
- || current_buffer->overlays_after
+ if (buffer_intervals (current_buffer)
+ || buffer_has_overlays ()
|| Z != Z_BYTE)
return current_column_1 ();
@@ -360,7 +355,7 @@ current_column (void)
while (1)
{
- EMACS_INT i, n;
+ ptrdiff_t i, n;
Lisp_Object charvec;
if (ptr == stop)
@@ -400,8 +395,7 @@ current_column (void)
next_element_from_display_vector does it. */
Lisp_Object entry = AREF (charvec, i);
- if (GLYPH_CODE_P (entry)
- && GLYPH_CODE_CHAR_VALID_P (entry))
+ if (GLYPH_CODE_P (entry))
c = GLYPH_CODE_CHAR (entry);
else
c = ' ';
@@ -464,7 +458,7 @@ current_column (void)
in ENDPOS.
Otherwise just return -1. */
static int
-check_display_width (EMACS_INT pos, EMACS_INT col, EMACS_INT *endpos)
+check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos)
{
Lisp_Object val, overlay;
@@ -474,19 +468,27 @@ check_display_width (EMACS_INT pos, EMACS_INT col, EMACS_INT *endpos)
{ /* FIXME: Use calc_pixel_width_or_height. */
Lisp_Object plist = XCDR (val), prop;
int width = -1;
+ EMACS_INT align_to_max =
+ (col < MOST_POSITIVE_FIXNUM - INT_MAX
+ ? (EMACS_INT) INT_MAX + col
+ : MOST_POSITIVE_FIXNUM);
- if ((prop = Fplist_get (plist, QCwidth), NATNUMP (prop)))
+ if ((prop = Fplist_get (plist, QCwidth),
+ RANGED_INTEGERP (0, prop, INT_MAX)))
width = XINT (prop);
- else if (FLOATP (prop))
+ else if (FLOATP (prop) && 0 <= XFLOAT_DATA (prop)
+ && XFLOAT_DATA (prop) <= INT_MAX)
width = (int)(XFLOAT_DATA (prop) + 0.5);
- else if ((prop = Fplist_get (plist, QCalign_to), NATNUMP (prop)))
+ else if ((prop = Fplist_get (plist, QCalign_to),
+ RANGED_INTEGERP (col, prop, align_to_max)))
width = XINT (prop) - col;
- else if (FLOATP (prop))
+ else if (FLOATP (prop) && col <= XFLOAT_DATA (prop)
+ && (XFLOAT_DATA (prop) <= align_to_max))
width = (int)(XFLOAT_DATA (prop) + 0.5) - col;
if (width >= 0)
{
- EMACS_INT start;
+ ptrdiff_t start;
if (OVERLAYP (overlay))
*endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
else
@@ -504,24 +506,24 @@ check_display_width (EMACS_INT pos, EMACS_INT col, EMACS_INT *endpos)
PREVCOL gets set to the column of the previous position (it's always
strictly smaller than the goal column). */
static void
-scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol)
+scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, ptrdiff_t *prevcol)
{
int tab_width = SANE_TAB_WIDTH (current_buffer);
- register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
- register struct Lisp_Char_Table *dp = buffer_display_table ();
- int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ bool ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
+ struct Lisp_Char_Table *dp = buffer_display_table ();
+ bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
struct composition_it cmp_it;
Lisp_Object window;
struct window *w;
/* Start the scan at the beginning of this line with column number 0. */
- register EMACS_INT col = 0, prev_col = 0;
+ register ptrdiff_t col = 0, prev_col = 0;
EMACS_INT goal = goalcol ? *goalcol : MOST_POSITIVE_FIXNUM;
- EMACS_INT end = endpos ? *endpos : PT;
- EMACS_INT scan, scan_byte;
- EMACS_INT next_boundary;
+ ptrdiff_t end = endpos ? *endpos : PT;
+ ptrdiff_t scan, scan_byte;
+ ptrdiff_t next_boundary;
{
- EMACS_INT opoint = PT, opoint_byte = PT_BYTE;
+ ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, 1);
current_column_bol_cache = PT;
scan = PT, scan_byte = PT_BYTE;
@@ -544,7 +546,7 @@ scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol)
/* Occasionally we may need to skip invisible text. */
while (scan == next_boundary)
{
- EMACS_INT old_scan = scan;
+ ptrdiff_t old_scan = scan;
/* This updates NEXT_BOUNDARY to the next place
where we might need to skip more invisible text. */
scan = skip_invisible (scan, &next_boundary, end, Qnil);
@@ -562,7 +564,7 @@ scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol)
prev_col = col;
{ /* Check display property. */
- EMACS_INT endp;
+ ptrdiff_t endp;
int width = check_display_width (scan, col, &endp);
if (width >= 0)
{
@@ -608,7 +610,7 @@ scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol)
&& VECTORP (DISP_CHAR_VECTOR (dp, c)))
{
Lisp_Object charvec;
- EMACS_INT i, n;
+ ptrdiff_t i, n;
/* This character is displayed using a vector of glyphs.
Update the column/position based on those glyphs. */
@@ -622,8 +624,7 @@ scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol)
next_element_from_display_vector does it. */
Lisp_Object entry = AREF (charvec, i);
- if (GLYPH_CODE_P (entry)
- && GLYPH_CODE_CHAR_VALID_P (entry))
+ if (GLYPH_CODE_P (entry))
c = GLYPH_CODE_CHAR (entry);
else
c = ' ';
@@ -698,11 +699,11 @@ scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol)
This function handles characters that are invisible
due to text properties or overlays. */
-static EMACS_INT
+static ptrdiff_t
current_column_1 (void)
{
EMACS_INT col = MOST_POSITIVE_FIXNUM;
- EMACS_INT opoint = PT;
+ ptrdiff_t opoint = PT;
scan_for_column (&opoint, &col, NULL);
return col;
@@ -718,14 +719,14 @@ current_column_1 (void)
static double
string_display_width (Lisp_Object string, Lisp_Object beg, Lisp_Object end)
{
- register int col;
- register unsigned char *ptr, *stop;
- register int tab_seen;
+ int col;
+ unsigned char *ptr, *stop;
+ bool tab_seen;
int post_tab;
- register int c;
+ int c;
int tab_width = SANE_TAB_WIDTH (current_buffer);
- int ctl_arrow = !NILP (current_buffer->ctl_arrow);
- register struct Lisp_Char_Table *dp = buffer_display_table ();
+ bool ctl_arrow = !NILP (current_buffer->ctl_arrow);
+ struct Lisp_Char_Table *dp = buffer_display_table ();
int b, e;
if (NILP (end))
@@ -798,7 +799,7 @@ The return value is COLUMN. */)
(Lisp_Object column, Lisp_Object minimum)
{
EMACS_INT mincol;
- register EMACS_INT fromcol;
+ register ptrdiff_t fromcol;
int tab_width = SANE_TAB_WIDTH (current_buffer);
CHECK_NUMBER (column);
@@ -845,7 +846,7 @@ following any initial whitespace. */)
(void)
{
Lisp_Object val;
- EMACS_INT opoint = PT, opoint_byte = PT_BYTE;
+ ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, 1);
@@ -854,16 +855,16 @@ following any initial whitespace. */)
return val;
}
-static EMACS_INT
+static ptrdiff_t
position_indentation (ptrdiff_t pos_byte)
{
- register EMACS_INT column = 0;
+ register ptrdiff_t column = 0;
int tab_width = SANE_TAB_WIDTH (current_buffer);
register unsigned char *p;
register unsigned char *stop;
unsigned char *start;
- EMACS_INT next_boundary_byte = pos_byte;
- EMACS_INT ceiling = next_boundary_byte;
+ ptrdiff_t next_boundary_byte = pos_byte;
+ ptrdiff_t ceiling = next_boundary_byte;
p = BYTE_POS_ADDR (pos_byte);
/* STOP records the value of P at which we will need
@@ -876,7 +877,7 @@ position_indentation (ptrdiff_t pos_byte)
{
while (p == stop)
{
- EMACS_INT stop_pos_byte;
+ ptrdiff_t stop_pos_byte;
/* If we have updated P, set POS_BYTE to match.
The first time we enter the loop, POS_BYTE is already right. */
@@ -887,8 +888,8 @@ position_indentation (ptrdiff_t pos_byte)
return column;
if (pos_byte == next_boundary_byte)
{
- EMACS_INT next_boundary;
- EMACS_INT pos = BYTE_TO_CHAR (pos_byte);
+ ptrdiff_t next_boundary;
+ ptrdiff_t pos = BYTE_TO_CHAR (pos_byte);
pos = skip_invisible (pos, &next_boundary, ZV, Qnil);
pos_byte = CHAR_TO_BYTE (pos);
next_boundary_byte = CHAR_TO_BYTE (next_boundary);
@@ -941,11 +942,11 @@ position_indentation (ptrdiff_t pos_byte)
Blank lines are treated as if they had the same indentation as the
preceding line. */
-int
-indented_beyond_p (EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT column)
+bool
+indented_beyond_p (ptrdiff_t pos, ptrdiff_t pos_byte, EMACS_INT column)
{
- EMACS_INT val;
- EMACS_INT opoint = PT, opoint_byte = PT_BYTE;
+ ptrdiff_t val;
+ ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
SET_PT_BOTH (pos, pos_byte);
while (PT > BEGV && FETCH_BYTE (PT_BYTE) == '\n')
@@ -956,7 +957,8 @@ indented_beyond_p (EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT column)
return val >= column;
}
-DEFUN ("move-to-column", Fmove_to_column, Smove_to_column, 1, 2, "p",
+DEFUN ("move-to-column", Fmove_to_column, Smove_to_column, 1, 2,
+ "NMove to column: ",
doc: /* Move point to column COLUMN in the current line.
Interactively, COLUMN is the value of prefix numeric argument.
The column of a character is calculated by adding together the widths
@@ -976,8 +978,8 @@ COLUMN, add spaces/tabs to get there.
The return value is the current column. */)
(Lisp_Object column, Lisp_Object force)
{
- EMACS_INT pos;
- EMACS_INT col, prev_col;
+ ptrdiff_t pos, prev_col;
+ EMACS_INT col;
EMACS_INT goal;
CHECK_NATNUM (column);
@@ -994,13 +996,13 @@ The return value is the current column. */)
if (!NILP (force) && col > goal)
{
int c;
- EMACS_INT pos_byte = PT_BYTE;
+ ptrdiff_t pos_byte = PT_BYTE;
DEC_POS (pos_byte);
c = FETCH_CHAR (pos_byte);
if (c == '\t' && prev_col < goal)
{
- EMACS_INT goal_pt, goal_pt_byte;
+ ptrdiff_t goal_pt, goal_pt_byte;
/* Insert spaces in front of the tab to reach GOAL. Do this
first so that a marker at the end of the tab gets
@@ -1042,11 +1044,11 @@ static struct position val_compute_motion;
can't hit the requested column exactly (because of a tab or other
multi-column character), overshoot.
- DID_MOTION is 1 if FROMHPOS has already accounted for overlay strings
+ DID_MOTION is true if FROMHPOS has already accounted for overlay strings
at FROM. This is the case if FROMVPOS and FROMVPOS came from an
earlier call to compute_motion. The other common case is that FROMHPOS
is zero and FROM is a position that "belongs" at column zero, but might
- be shifted by overlay strings; in this case DID_MOTION should be 0.
+ be shifted by overlay strings; in this case DID_MOTION should be false.
WIDTH is the number of columns available to display text;
compute_motion uses this to handle continuation lines and such.
@@ -1099,57 +1101,58 @@ static struct position val_compute_motion;
the scroll bars if they are turned on. */
struct position *
-compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_motion, EMACS_INT to, EMACS_INT tovpos, EMACS_INT tohpos, EMACS_INT width, EMACS_INT hscroll, EMACS_INT tab_offset, struct window *win)
+compute_motion (ptrdiff_t from, EMACS_INT fromvpos, EMACS_INT fromhpos,
+ bool did_motion, ptrdiff_t to,
+ EMACS_INT tovpos, EMACS_INT tohpos, EMACS_INT width,
+ ptrdiff_t hscroll, int tab_offset, struct window *win)
{
- register EMACS_INT hpos = fromhpos;
- register EMACS_INT vpos = fromvpos;
+ EMACS_INT hpos = fromhpos;
+ EMACS_INT vpos = fromvpos;
- register EMACS_INT pos;
- EMACS_INT pos_byte;
- register int c = 0;
+ ptrdiff_t pos;
+ ptrdiff_t pos_byte;
+ int c = 0;
int tab_width = SANE_TAB_WIDTH (current_buffer);
- register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
- register struct Lisp_Char_Table *dp = window_display_table (win);
+ bool ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
+ struct Lisp_Char_Table *dp = window_display_table (win);
EMACS_INT selective
= (INTEGERP (BVAR (current_buffer, selective_display))
? XINT (BVAR (current_buffer, selective_display))
: !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0);
- int selective_rlen
+ ptrdiff_t selective_rlen
= (selective && dp && VECTORP (DISP_INVIS_VECTOR (dp))
? ASIZE (DISP_INVIS_VECTOR (dp)) : 0);
/* The next location where the `invisible' property changes, or an
overlay starts or ends. */
- EMACS_INT next_boundary = from;
+ ptrdiff_t next_boundary = from;
/* For computing runs of characters with similar widths.
Invariant: width_run_width is zero, or all the characters
from width_run_start to width_run_end have a fixed width of
width_run_width. */
- EMACS_INT width_run_start = from;
- EMACS_INT width_run_end = from;
- EMACS_INT width_run_width = 0;
+ ptrdiff_t width_run_start = from;
+ ptrdiff_t width_run_end = from;
+ ptrdiff_t width_run_width = 0;
Lisp_Object *width_table;
- Lisp_Object buffer;
/* The next buffer pos where we should consult the width run cache. */
- EMACS_INT next_width_run = from;
+ ptrdiff_t next_width_run = from;
Lisp_Object window;
- int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
/* If previous char scanned was a wide character,
this is the column where it ended. Otherwise, this is 0. */
EMACS_INT wide_column_end_hpos = 0;
- EMACS_INT prev_pos; /* Previous buffer position. */
- EMACS_INT prev_pos_byte; /* Previous buffer position. */
+ ptrdiff_t prev_pos; /* Previous buffer position. */
+ ptrdiff_t prev_pos_byte; /* Previous buffer position. */
EMACS_INT prev_hpos = 0;
EMACS_INT prev_vpos = 0;
EMACS_INT contin_hpos; /* HPOS of last column of continued line. */
- EMACS_INT prev_tab_offset; /* Previous tab offset. */
- EMACS_INT continuation_glyph_width;
+ int prev_tab_offset; /* Previous tab offset. */
+ int continuation_glyph_width;
struct composition_it cmp_it;
- XSETBUFFER (buffer, current_buffer);
XSETWINDOW (window, win);
width_run_cache_on_off ();
@@ -1194,8 +1197,8 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_
{
while (pos == next_boundary)
{
- EMACS_INT pos_here = pos;
- EMACS_INT newpos;
+ ptrdiff_t pos_here = pos;
+ ptrdiff_t newpos;
/* Don't skip invisible if we are already at the margin. */
if (vpos > tovpos || (vpos == tovpos && hpos >= tohpos))
@@ -1229,7 +1232,7 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_
to be changed here. */
{
unsigned char *ovstr;
- EMACS_INT ovlen = overlay_strings (pos, win, &ovstr);
+ ptrdiff_t ovlen = overlay_strings (pos, win, &ovstr);
hpos += ((multibyte && ovlen > 0)
? strwidth ((char *) ovstr, ovlen) : ovlen);
}
@@ -1304,8 +1307,8 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_
if (hpos > width)
{
- int total_width = width + continuation_glyph_width;
- int truncate = 0;
+ EMACS_INT total_width = width + continuation_glyph_width;
+ bool truncate = 0;
if (!NILP (Vtruncate_partial_width_windows)
&& (total_width < FRAME_COLS (XFRAME (WINDOW_FRAME (win)))))
@@ -1434,7 +1437,7 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_
want to skip over it for some other reason. */
if (common_width != 0)
{
- EMACS_INT run_end_hpos;
+ ptrdiff_t run_end_hpos;
/* Don't go past the final buffer posn the user
requested. */
@@ -1474,7 +1477,7 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_
/* We have to scan the text character-by-character. */
else
{
- EMACS_INT i, n;
+ ptrdiff_t i, n;
Lisp_Object charvec;
/* Check composition sequence. */
@@ -1551,8 +1554,7 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_
next_element_from_display_vector does it. */
Lisp_Object entry = AREF (charvec, i);
- if (GLYPH_CODE_P (entry)
- && GLYPH_CODE_CHAR_VALID_P (entry))
+ if (GLYPH_CODE_P (entry))
c = GLYPH_CODE_CHAR (entry);
else
c = ' ';
@@ -1675,8 +1677,6 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_
val_compute_motion.prevhpos = contin_hpos;
else
val_compute_motion.prevhpos = prev_hpos;
- /* We always handle all of them here; none of them remain to do. */
- val_compute_motion.ovstring_chars_done = 0;
/* Nonzero if have just continued a line */
val_compute_motion.contin = (contin_hpos && prev_hpos == 0);
@@ -1733,7 +1733,8 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */)
struct window *w;
Lisp_Object bufpos, hpos, vpos, prevhpos;
struct position *pos;
- EMACS_INT hscroll, tab_offset;
+ ptrdiff_t hscroll;
+ int tab_offset;
CHECK_NUMBER_COERCE_MARKER (from);
CHECK_CONS (frompos);
@@ -1754,17 +1755,16 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */)
CHECK_CONS (offsets);
CHECK_NUMBER_CAR (offsets);
CHECK_NUMBER_CDR (offsets);
+ if (! (0 <= XINT (XCAR (offsets)) && XINT (XCAR (offsets)) <= PTRDIFF_MAX
+ && 0 <= XINT (XCDR (offsets)) && XINT (XCDR (offsets)) <= INT_MAX))
+ args_out_of_range (XCAR (offsets), XCDR (offsets));
hscroll = XINT (XCAR (offsets));
tab_offset = XINT (XCDR (offsets));
}
else
hscroll = tab_offset = 0;
- if (NILP (window))
- window = Fselected_window ();
- else
- CHECK_LIVE_WINDOW (window);
- w = XWINDOW (window);
+ w = decode_live_window (window);
if (XINT (from) < BEGV || XINT (from) > ZV)
args_out_of_range_3 (from, make_number (BEGV), make_number (ZV));
@@ -1786,8 +1786,7 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */)
1))
: XINT (XCAR (topos))),
(NILP (width) ? -1 : XINT (width)),
- hscroll, tab_offset,
- XWINDOW (window));
+ hscroll, tab_offset, w);
XSETFASTINT (bufpos, pos->bufpos);
XSETINT (hpos, pos->hpos);
@@ -1807,23 +1806,23 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */)
static struct position val_vmotion;
struct position *
-vmotion (register EMACS_INT from, register EMACS_INT vtarget, struct window *w)
+vmotion (register ptrdiff_t from, register EMACS_INT vtarget, struct window *w)
{
- EMACS_INT hscroll = XINT (w->hscroll);
+ ptrdiff_t hscroll = w->hscroll;
struct position pos;
/* vpos is cumulative vertical position, changed as from is changed */
- register int vpos = 0;
- EMACS_INT prevline;
- register EMACS_INT first;
- EMACS_INT from_byte;
- EMACS_INT lmargin = hscroll > 0 ? 1 - hscroll : 0;
- EMACS_INT selective
+ register EMACS_INT vpos = 0;
+ ptrdiff_t prevline;
+ register ptrdiff_t first;
+ ptrdiff_t from_byte;
+ ptrdiff_t lmargin = hscroll > 0 ? 1 - hscroll : 0;
+ ptrdiff_t selective
= (INTEGERP (BVAR (current_buffer, selective_display))
- ? XINT (BVAR (current_buffer, selective_display))
+ ? clip_to_bounds (-1, XINT (BVAR (current_buffer, selective_display)),
+ PTRDIFF_MAX)
: !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0);
Lisp_Object window;
- EMACS_INT start_hpos = 0;
- int did_motion;
+ bool did_motion;
/* This is the object we use for fetching character properties. */
Lisp_Object text_prop_object;
@@ -1861,7 +1860,7 @@ vmotion (register EMACS_INT from, register EMACS_INT vtarget, struct window *w)
TEXT_PROP_MEANS_INVISIBLE (propval))))
prevline = find_next_newline_no_quit (prevline - 1, -1);
pos = *compute_motion (prevline, 0,
- lmargin + (prevline == BEG ? start_hpos : 0),
+ lmargin,
0,
from,
/* Don't care for VPOS... */
@@ -1869,10 +1868,7 @@ vmotion (register EMACS_INT from, register EMACS_INT vtarget, struct window *w)
/* ... nor HPOS. */
1 << (BITS_PER_SHORT - 1),
-1, hscroll,
- /* This compensates for start_hpos
- so that a tab as first character
- still occupies 8 columns. */
- (prevline == BEG ? -start_hpos : 0),
+ 0,
w);
vpos -= pos.vpos;
first = 0;
@@ -1890,8 +1886,6 @@ vmotion (register EMACS_INT from, register EMACS_INT vtarget, struct window *w)
val_vmotion.hpos = lmargin;
val_vmotion.contin = 0;
val_vmotion.prevhpos = 0;
- val_vmotion.ovstring_chars_done = 0;
- val_vmotion.tab_offset = 0; /* For accumulating tab offset. */
return &val_vmotion;
}
@@ -1918,8 +1912,7 @@ vmotion (register EMACS_INT from, register EMACS_INT vtarget, struct window *w)
TEXT_PROP_MEANS_INVISIBLE (propval))))
prevline = find_next_newline_no_quit (prevline - 1, -1);
pos = *compute_motion (prevline, 0,
- lmargin + (prevline == BEG
- ? start_hpos : 0),
+ lmargin,
0,
from,
/* Don't care for VPOS... */
@@ -1927,21 +1920,20 @@ vmotion (register EMACS_INT from, register EMACS_INT vtarget, struct window *w)
/* ... nor HPOS. */
1 << (BITS_PER_SHORT - 1),
-1, hscroll,
- (prevline == BEG ? -start_hpos : 0),
+ 0,
w);
did_motion = 1;
}
else
{
- pos.hpos = lmargin + (from == BEG ? start_hpos : 0);
+ pos.hpos = lmargin;
pos.vpos = 0;
- pos.tab_offset = 0;
did_motion = 0;
}
return compute_motion (from, vpos, pos.hpos, did_motion,
ZV, vtarget, - (1 << (BITS_PER_SHORT - 1)),
-1, hscroll,
- pos.tab_offset - (from == BEG ? start_hpos : 0),
+ 0,
w);
}
@@ -1991,11 +1983,7 @@ whether or not it is currently displayed in some window. */)
}
CHECK_NUMBER (lines);
- if (! NILP (window))
- CHECK_WINDOW (window);
- else
- window = selected_window;
- w = XWINDOW (window);
+ w = decode_live_window (window);
old_buffer = Qnil;
GCPRO3 (old_buffer, old_charpos, old_bytepos);
@@ -2005,9 +1993,9 @@ whether or not it is currently displayed in some window. */)
old_buffer = w->buffer;
old_charpos = XMARKER (w->pointm)->charpos;
old_bytepos = XMARKER (w->pointm)->bytepos;
- XSETBUFFER (w->buffer, current_buffer);
- set_marker_both
- (w->pointm, w->buffer, BUF_PT (current_buffer), BUF_PT_BYTE (current_buffer));
+ wset_buffer (w, Fcurrent_buffer ());
+ set_marker_both (w->pointm, w->buffer,
+ BUF_PT (current_buffer), BUF_PT_BYTE (current_buffer));
}
if (noninteractive)
@@ -2018,9 +2006,10 @@ whether or not it is currently displayed in some window. */)
}
else
{
- EMACS_INT it_start;
- int first_x, it_overshoot_count = 0;
- int overshoot_handled = 0;
+ ptrdiff_t it_start, it_overshoot_count = 0;
+ int first_x;
+ bool overshoot_handled = 0;
+ bool disp_string_at_start_p = 0;
itdata = bidi_shelve_cache ();
SET_TEXT_POS (pt, PT, PT_BYTE);
@@ -2035,6 +2024,8 @@ whether or not it is currently displayed in some window. */)
{
const char *s = SSDATA (it.string);
const char *e = s + SBYTES (it.string);
+
+ disp_string_at_start_p = it.string_from_display_prop_p;
while (s < e)
{
if (*s++ == '\n')
@@ -2057,12 +2048,19 @@ whether or not it is currently displayed in some window. */)
comment said this is "so we don't move too far" (2005-01-19
checkin by kfs). But this does nothing useful that I can
tell, and it causes Bug#2694 . -- cyd */
- move_it_to (&it, PT, -1, -1, -1, MOVE_TO_POS);
+ /* When the position we started from is covered by a display
+ string, move_it_to will overshoot it, while vertical-motion
+ wants to put the cursor _before_ the display string. So in
+ that case, we move to buffer position before the display
+ string, and avoid overshooting. */
+ move_it_to (&it, disp_string_at_start_p ? PT - 1 : PT,
+ -1, -1, -1, MOVE_TO_POS);
/* IT may move too far if truncate-lines is on and PT lies
beyond the right margin. IT may also move too far if the
starting point is on a Lisp string that has embedded
- newlines. In these cases, backtrack. */
+ newlines, or spans several screen lines. In these cases,
+ backtrack. */
if (IT_CHARPOS (it) > it_start)
{
/* We need to backtrack also if the Lisp string contains no
@@ -2073,6 +2071,14 @@ whether or not it is currently displayed in some window. */)
&& it.method == GET_FROM_BUFFER
&& it.c == '\n')
it_overshoot_count = 1;
+ else if (disp_string_at_start_p && it.vpos > 0)
+ {
+ /* This is the case of a display string that spans
+ several screen lines. In that case, we end up at the
+ end of the string, and it.vpos tells us how many
+ screen lines we need to backtrack. */
+ it_overshoot_count = it.vpos;
+ }
if (it_overshoot_count > 0)
move_it_by_lines (&it, -it_overshoot_count);
@@ -2084,12 +2090,12 @@ whether or not it is currently displayed in some window. */)
/* Do this even if LINES is 0, so that we move back to the
beginning of the current line as we ought. */
if (XINT (lines) == 0 || IT_CHARPOS (it) > 0)
- move_it_by_lines (&it, max (INT_MIN, XINT (lines)));
+ move_it_by_lines (&it, max (PTRDIFF_MIN, XINT (lines)));
}
else if (overshoot_handled)
{
it.vpos = 0;
- move_it_by_lines (&it, min (INT_MAX, XINT (lines)));
+ move_it_by_lines (&it, min (PTRDIFF_MAX, XINT (lines)));
}
else
{
@@ -2105,12 +2111,12 @@ whether or not it is currently displayed in some window. */)
move_it_by_lines (&it, 1);
}
if (XINT (lines) > 1)
- move_it_by_lines (&it, min (INT_MAX, XINT (lines) - 1));
+ move_it_by_lines (&it, min (PTRDIFF_MAX, XINT (lines) - 1));
}
else
{
it.vpos = 0;
- move_it_by_lines (&it, min (INT_MAX, XINT (lines)));
+ move_it_by_lines (&it, min (PTRDIFF_MAX, XINT (lines)));
}
}
@@ -2136,8 +2142,9 @@ whether or not it is currently displayed in some window. */)
if (BUFFERP (old_buffer))
{
- w->buffer = old_buffer;
- set_marker_both (w->pointm, w->buffer, old_charpos, old_bytepos);
+ wset_buffer (w, old_buffer);
+ set_marker_both (w->pointm, w->buffer,
+ old_charpos, old_bytepos);
}
RETURN_UNGCPRO (make_number (it.vpos));
@@ -2151,7 +2158,7 @@ void
syms_of_indent (void)
{
DEFVAR_BOOL ("indent-tabs-mode", indent_tabs_mode,
- doc: /* *Indentation can insert tabs if this is non-nil. */);
+ doc: /* Indentation can insert tabs if this is non-nil. */);
indent_tabs_mode = 1;
defsubr (&Scurrent_indentation);
diff --git a/src/indent.h b/src/indent.h
index 55ee934f574..abcd06036d1 100644
--- a/src/indent.h
+++ b/src/indent.h
@@ -1,5 +1,5 @@
/* Definitions for interface to indent.c
- Copyright (C) 1985-1986, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -16,59 +16,37 @@ 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/>. */
-/* We introduce new member `tab_offset'. We need it because of the
- existence of wide-column characters. There is a case that the
- line-break occurs at a wide-column character and the number of
- columns of the line gets less than width.
-
- Example (where W_ stands for a wide-column character):
- ----------
- abcdefgh\\
- W_
- ----------
-
- To handle this case, we should not calculate the tab offset by
- tab_offset += width;
-
- Instead, we must remember tab_offset of the line.
-
- */
-
struct position
{
- EMACS_INT bufpos;
- EMACS_INT bytepos;
+ ptrdiff_t bufpos;
+ ptrdiff_t bytepos;
EMACS_INT hpos;
EMACS_INT vpos;
EMACS_INT prevhpos;
- EMACS_INT contin;
- /* Number of characters we have already handled
- from the before and after strings at this position. */
- EMACS_INT ovstring_chars_done;
- EMACS_INT tab_offset;
+ int contin;
};
-struct position *compute_motion (EMACS_INT from, EMACS_INT fromvpos,
- EMACS_INT fromhpos, int did_motion,
- EMACS_INT to, EMACS_INT tovpos,
+struct position *compute_motion (ptrdiff_t from, EMACS_INT fromvpos,
+ EMACS_INT fromhpos, bool did_motion,
+ ptrdiff_t to, EMACS_INT tovpos,
EMACS_INT tohpos,
- EMACS_INT width, EMACS_INT hscroll,
- EMACS_INT tab_offset, struct window *);
-struct position *vmotion (EMACS_INT from, EMACS_INT vtarget,
+ EMACS_INT width, ptrdiff_t hscroll,
+ int tab_offset, struct window *);
+struct position *vmotion (ptrdiff_t from, EMACS_INT vtarget,
struct window *);
-EMACS_INT skip_invisible (EMACS_INT pos, EMACS_INT *next_boundary_p,
- EMACS_INT to, Lisp_Object window);
+ptrdiff_t skip_invisible (ptrdiff_t pos, ptrdiff_t *next_boundary_p,
+ ptrdiff_t to, Lisp_Object window);
/* Value of point when current_column was called */
-extern EMACS_INT last_known_column_point;
+extern ptrdiff_t last_known_column_point;
/* Functions for dealing with the column cache. */
/* Return true if the display table DISPTAB specifies the same widths
for characters as WIDTHTAB. We use this to decide when to
invalidate the buffer's column_cache. */
-int disptab_matches_widthtab (struct Lisp_Char_Table *disptab,
- struct Lisp_Vector *widthtab);
+bool disptab_matches_widthtab (struct Lisp_Char_Table *disptab,
+ struct Lisp_Vector *widthtab);
/* Recompute BUF's width table, using the display table DISPTAB. */
void recompute_width_table (struct buffer *buf,
diff --git a/src/insdel.c b/src/insdel.c
index e39a362eac7..87010cd8251 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1,5 +1,5 @@
/* Buffer insertion/deletion and gap motion for GNU Emacs.
- Copyright (C) 1985-1986, 1993-1995, 1997-2011
+ Copyright (C) 1985-1986, 1993-1995, 1997-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,37 +19,26 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
#include <intprops.h>
#include "lisp.h"
#include "intervals.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "window.h"
#include "blockinput.h"
#include "region-cache.h"
-#ifndef NULL
-#define NULL 0
-#endif
-
-static void insert_from_string_1 (Lisp_Object string,
- EMACS_INT pos, EMACS_INT pos_byte,
- EMACS_INT nchars, EMACS_INT nbytes,
- int inherit, int before_markers);
-static void insert_from_buffer_1 (struct buffer *buf,
- EMACS_INT from, EMACS_INT nchars,
- int inherit);
-static void gap_left (EMACS_INT charpos, EMACS_INT bytepos, int newgap);
-static void gap_right (EMACS_INT charpos, EMACS_INT bytepos);
-
-static Lisp_Object Fcombine_after_change_execute (void);
+static void insert_from_string_1 (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, bool, bool);
+static void insert_from_buffer_1 (struct buffer *, ptrdiff_t, ptrdiff_t, bool);
+static void gap_left (ptrdiff_t, ptrdiff_t, bool);
+static void gap_right (ptrdiff_t, ptrdiff_t);
/* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT)
describing changes which happened while combine_after_change_calls
- was nonzero. We use this to decide how to call them
+ was non-nil. We use this to decide how to call them
once the deferral ends.
In each element.
@@ -64,40 +53,42 @@ static Lisp_Object combine_after_change_buffer;
Lisp_Object Qinhibit_modification_hooks;
-static void signal_before_change (EMACS_INT, EMACS_INT, EMACS_INT *);
-
-#define CHECK_MARKERS() \
- do \
- { \
- if (check_markers_debug_flag) \
- check_markers (); \
- } \
- while (0)
+static void signal_before_change (ptrdiff_t, ptrdiff_t, ptrdiff_t *);
+
+/* Also used in marker.c to enable expensive marker checks. */
+
+#ifdef MARKER_DEBUG
static void
check_markers (void)
{
- register struct Lisp_Marker *tail;
- int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ struct Lisp_Marker *tail;
+ bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
{
if (tail->buffer->text != current_buffer->text)
- abort ();
+ emacs_abort ();
if (tail->charpos > Z)
- abort ();
+ emacs_abort ();
if (tail->bytepos > Z_BYTE)
- abort ();
+ emacs_abort ();
if (multibyte && ! CHAR_HEAD_P (FETCH_BYTE (tail->bytepos)))
- abort ();
+ emacs_abort ();
}
}
-
+
+#else /* not MARKER_DEBUG */
+
+#define check_markers() do { } while (0)
+
+#endif /* MARKER_DEBUG */
+
/* Move gap to position CHARPOS.
Note that this can quit! */
void
-move_gap (EMACS_INT charpos)
+move_gap (ptrdiff_t charpos)
{
move_gap_both (charpos, charpos_to_bytepos (charpos));
}
@@ -106,7 +97,7 @@ move_gap (EMACS_INT charpos)
Note that this can quit! */
void
-move_gap_both (EMACS_INT charpos, EMACS_INT bytepos)
+move_gap_both (ptrdiff_t charpos, ptrdiff_t bytepos)
{
if (bytepos < GPT_BYTE)
gap_left (charpos, bytepos, 0);
@@ -117,14 +108,14 @@ move_gap_both (EMACS_INT charpos, EMACS_INT bytepos)
/* Move the gap to a position less than the current GPT.
BYTEPOS describes the new position as a byte position,
and CHARPOS is the corresponding char position.
- If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
+ If NEWGAP, then don't update beg_unchanged and end_unchanged. */
static void
-gap_left (EMACS_INT charpos, EMACS_INT bytepos, int newgap)
+gap_left (ptrdiff_t charpos, ptrdiff_t bytepos, bool newgap)
{
- register unsigned char *to, *from;
- register EMACS_INT i;
- EMACS_INT new_s1;
+ unsigned char *to, *from;
+ ptrdiff_t i;
+ ptrdiff_t new_s1;
if (!newgap)
BUF_COMPUTE_UNCHANGED (current_buffer, charpos, GPT);
@@ -164,8 +155,7 @@ gap_left (EMACS_INT charpos, EMACS_INT bytepos, int newgap)
was specified or may be where a quit was detected. */
GPT_BYTE = bytepos;
GPT = charpos;
- if (bytepos < charpos)
- abort ();
+ eassert (charpos <= bytepos);
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
QUIT;
}
@@ -175,11 +165,11 @@ gap_left (EMACS_INT charpos, EMACS_INT bytepos, int newgap)
and CHARPOS is the corresponding char position. */
static void
-gap_right (EMACS_INT charpos, EMACS_INT bytepos)
+gap_right (ptrdiff_t charpos, ptrdiff_t bytepos)
{
register unsigned char *to, *from;
- register EMACS_INT i;
- EMACS_INT new_s1;
+ register ptrdiff_t i;
+ ptrdiff_t new_s1;
BUF_COMPUTE_UNCHANGED (current_buffer, charpos, GPT);
@@ -215,8 +205,7 @@ gap_right (EMACS_INT charpos, EMACS_INT bytepos)
GPT = charpos;
GPT_BYTE = bytepos;
- if (bytepos < charpos)
- abort ();
+ eassert (charpos <= bytepos);
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
QUIT;
}
@@ -229,19 +218,17 @@ gap_right (EMACS_INT charpos, EMACS_INT bytepos)
or inside of the range being deleted. */
void
-adjust_markers_for_delete (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte)
+adjust_markers_for_delete (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte)
{
Lisp_Object marker;
register struct Lisp_Marker *m;
- register EMACS_INT charpos;
+ register ptrdiff_t charpos;
for (m = BUF_MARKERS (current_buffer); m; m = m->next)
{
charpos = m->charpos;
-
- if (charpos > Z)
- abort ();
+ eassert (charpos <= Z);
/* If the marker is after the deletion,
relocate by number of chars / bytes deleted. */
@@ -294,13 +281,13 @@ adjust_markers_for_delete (EMACS_INT from, EMACS_INT from_byte,
or BEFORE_MARKERS is true. */
static void
-adjust_markers_for_insert (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte, int before_markers)
+adjust_markers_for_insert (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte, bool before_markers)
{
struct Lisp_Marker *m;
- int adjusted = 0;
- EMACS_INT nchars = to - from;
- EMACS_INT nbytes = to_byte - from_byte;
+ bool adjusted = 0;
+ ptrdiff_t nchars = to - from;
+ ptrdiff_t nbytes = to_byte - from_byte;
for (m = BUF_MARKERS (current_buffer); m; m = m->next)
{
@@ -345,7 +332,7 @@ adjust_markers_for_insert (EMACS_INT from, EMACS_INT from_byte,
intervals. */
static void
-adjust_point (EMACS_INT nchars, EMACS_INT nbytes)
+adjust_point (ptrdiff_t nchars, ptrdiff_t nbytes)
{
SET_BUF_PT_BOTH (current_buffer, PT + nchars, PT_BYTE + nbytes);
/* In a single-byte buffer, the two positions must be equal. */
@@ -358,14 +345,14 @@ adjust_point (EMACS_INT nchars, EMACS_INT nbytes)
an insertion. */
static void
-adjust_markers_for_replace (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT old_chars, EMACS_INT old_bytes,
- EMACS_INT new_chars, EMACS_INT new_bytes)
+adjust_markers_for_replace (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t old_chars, ptrdiff_t old_bytes,
+ ptrdiff_t new_chars, ptrdiff_t new_bytes)
{
register struct Lisp_Marker *m;
- EMACS_INT prev_to_byte = from_byte + old_bytes;
- EMACS_INT diff_chars = new_chars - old_chars;
- EMACS_INT diff_bytes = new_bytes - old_bytes;
+ ptrdiff_t prev_to_byte = from_byte + old_bytes;
+ ptrdiff_t diff_chars = new_chars - old_chars;
+ ptrdiff_t diff_bytes = new_bytes - old_bytes;
for (m = BUF_MARKERS (current_buffer); m; m = m->next)
{
@@ -381,7 +368,7 @@ adjust_markers_for_replace (EMACS_INT from, EMACS_INT from_byte,
}
}
- CHECK_MARKERS ();
+ check_markers ();
}
@@ -394,13 +381,13 @@ buffer_overflow (void)
/* Make the gap NBYTES_ADDED bytes longer. */
static void
-make_gap_larger (EMACS_INT nbytes_added)
+make_gap_larger (ptrdiff_t nbytes_added)
{
Lisp_Object tem;
- EMACS_INT real_gap_loc;
- EMACS_INT real_gap_loc_byte;
- EMACS_INT old_gap_size;
- EMACS_INT current_size = Z_BYTE - BEG_BYTE + GAP_SIZE;
+ ptrdiff_t real_gap_loc;
+ ptrdiff_t real_gap_loc_byte;
+ ptrdiff_t old_gap_size;
+ ptrdiff_t current_size = Z_BYTE - BEG_BYTE + GAP_SIZE;
enum { enough_for_a_while = 2000 };
if (BUF_BYTES_MAX - current_size < nbytes_added)
@@ -446,15 +433,15 @@ make_gap_larger (EMACS_INT nbytes_added)
/* Make the gap NBYTES_REMOVED bytes shorter. */
static void
-make_gap_smaller (EMACS_INT nbytes_removed)
+make_gap_smaller (ptrdiff_t nbytes_removed)
{
Lisp_Object tem;
- EMACS_INT real_gap_loc;
- EMACS_INT real_gap_loc_byte;
- EMACS_INT real_Z;
- EMACS_INT real_Z_byte;
- EMACS_INT real_beg_unchanged;
- EMACS_INT new_gap_size;
+ ptrdiff_t real_gap_loc;
+ ptrdiff_t real_gap_loc_byte;
+ ptrdiff_t real_Z;
+ ptrdiff_t real_Z_byte;
+ ptrdiff_t real_beg_unchanged;
+ ptrdiff_t new_gap_size;
/* Make sure the gap is at least 20 bytes. */
if (GAP_SIZE - nbytes_removed < 20)
@@ -504,7 +491,7 @@ make_gap_smaller (EMACS_INT nbytes_removed)
#endif /* USE_MMAP_FOR_BUFFERS || REL_ALLOC || DOUG_LEA_MALLOC */
void
-make_gap (EMACS_INT nbytes_added)
+make_gap (ptrdiff_t nbytes_added)
{
if (nbytes_added >= 0)
make_gap_larger (nbytes_added);
@@ -521,9 +508,9 @@ make_gap (EMACS_INT nbytes_added)
Return the number of bytes stored at TO_ADDR. */
-EMACS_INT
+ptrdiff_t
copy_text (const unsigned char *from_addr, unsigned char *to_addr,
- EMACS_INT nbytes, int from_multibyte, int to_multibyte)
+ ptrdiff_t nbytes, bool from_multibyte, bool to_multibyte)
{
if (from_multibyte == to_multibyte)
{
@@ -532,8 +519,8 @@ copy_text (const unsigned char *from_addr, unsigned char *to_addr,
}
else if (from_multibyte)
{
- EMACS_INT nchars = 0;
- EMACS_INT bytes_left = nbytes;
+ ptrdiff_t nchars = 0;
+ ptrdiff_t bytes_left = nbytes;
while (bytes_left > 0)
{
@@ -580,11 +567,11 @@ copy_text (const unsigned char *from_addr, unsigned char *to_addr,
prepare_to_modify_buffer could relocate the text. */
void
-insert (const char *string, EMACS_INT nbytes)
+insert (const char *string, ptrdiff_t nbytes)
{
if (nbytes > 0)
{
- EMACS_INT len = chars_in_text ((unsigned char *) string, nbytes), opoint;
+ ptrdiff_t len = chars_in_text ((unsigned char *) string, nbytes), opoint;
insert_1_both (string, len, nbytes, 0, 1, 0);
opoint = PT - len;
signal_after_change (opoint, 0, len);
@@ -595,11 +582,11 @@ insert (const char *string, EMACS_INT nbytes)
/* Likewise, but inherit text properties from neighboring characters. */
void
-insert_and_inherit (const char *string, EMACS_INT nbytes)
+insert_and_inherit (const char *string, ptrdiff_t nbytes)
{
if (nbytes > 0)
{
- EMACS_INT len = chars_in_text ((unsigned char *) string, nbytes), opoint;
+ ptrdiff_t len = chars_in_text ((unsigned char *) string, nbytes), opoint;
insert_1_both (string, len, nbytes, 1, 1, 0);
opoint = PT - len;
signal_after_change (opoint, 0, len);
@@ -640,11 +627,11 @@ insert_string (const char *s)
since gc could happen and relocate it. */
void
-insert_before_markers (const char *string, EMACS_INT nbytes)
+insert_before_markers (const char *string, ptrdiff_t nbytes)
{
if (nbytes > 0)
{
- EMACS_INT len = chars_in_text ((unsigned char *) string, nbytes), opoint;
+ ptrdiff_t len = chars_in_text ((unsigned char *) string, nbytes), opoint;
insert_1_both (string, len, nbytes, 0, 1, 1);
opoint = PT - len;
signal_after_change (opoint, 0, len);
@@ -656,11 +643,11 @@ insert_before_markers (const char *string, EMACS_INT nbytes)
void
insert_before_markers_and_inherit (const char *string,
- EMACS_INT nbytes)
+ ptrdiff_t nbytes)
{
if (nbytes > 0)
{
- EMACS_INT len = chars_in_text ((unsigned char *) string, nbytes), opoint;
+ ptrdiff_t len = chars_in_text ((unsigned char *) string, nbytes), opoint;
insert_1_both (string, len, nbytes, 1, 1, 1);
opoint = PT - len;
signal_after_change (opoint, 0, len);
@@ -671,8 +658,8 @@ insert_before_markers_and_inherit (const char *string,
/* Subroutine used by the insert functions above. */
void
-insert_1 (const char *string, EMACS_INT nbytes,
- int inherit, int prepare, int before_markers)
+insert_1 (const char *string, ptrdiff_t nbytes,
+ bool inherit, bool prepare, bool before_markers)
{
insert_1_both (string, chars_in_text ((unsigned char *) string, nbytes),
nbytes, inherit, prepare, before_markers);
@@ -687,8 +674,8 @@ insert_1 (const char *string, EMACS_INT nbytes,
which combine in this way. Otherwise, return 0. */
int
-count_combining_before (const unsigned char *string, EMACS_INT length,
- EMACS_INT pos, EMACS_INT pos_byte)
+count_combining_before (const unsigned char *string, ptrdiff_t length,
+ ptrdiff_t pos, ptrdiff_t pos_byte)
{
int len, combining_bytes;
const unsigned char *p;
@@ -733,11 +720,11 @@ count_combining_before (const unsigned char *string, EMACS_INT length,
int
count_combining_after (const unsigned char *string,
- EMACS_INT length, EMACS_INT pos, EMACS_INT pos_byte)
+ ptrdiff_t length, ptrdiff_t pos, ptrdiff_t pos_byte)
{
- EMACS_INT opos_byte = pos_byte;
- EMACS_INT i;
- EMACS_INT bytes;
+ ptrdiff_t opos_byte = pos_byte;
+ ptrdiff_t i;
+ ptrdiff_t bytes;
unsigned char *bufp;
if (NILP (current_buffer->enable_multibyte_characters))
@@ -797,8 +784,8 @@ count_combining_after (const unsigned char *string,
void
insert_1_both (const char *string,
- EMACS_INT nchars, EMACS_INT nbytes,
- int inherit, int prepare, int before_markers)
+ ptrdiff_t nchars, ptrdiff_t nbytes,
+ bool inherit, bool prepare, bool before_markers)
{
if (nchars == 0)
return;
@@ -820,7 +807,7 @@ insert_1_both (const char *string,
#ifdef BYTE_COMBINING_DEBUG
if (count_combining_before (string, nbytes, PT, PT_BYTE)
|| count_combining_after (string, nbytes, PT, PT_BYTE))
- abort ();
+ emacs_abort ();
#endif
/* Record deletion of the surrounding text that combines with
@@ -841,8 +828,7 @@ insert_1_both (const char *string,
Z_BYTE += nbytes;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
/* The insert may have been in the unchanged region, so check again. */
if (Z - GPT < END_UNCHANGED)
@@ -853,16 +839,15 @@ insert_1_both (const char *string,
PT + nchars, PT_BYTE + nbytes,
before_markers);
- if (BUF_INTERVALS (current_buffer) != 0)
- offset_intervals (current_buffer, PT, nchars);
+ offset_intervals (current_buffer, PT, nchars);
- if (!inherit && BUF_INTERVALS (current_buffer) != 0)
+ if (!inherit && buffer_intervals (current_buffer))
set_text_properties (make_number (PT), make_number (PT + nchars),
Qnil, Qnil, Qnil);
adjust_point (nchars, nbytes);
- CHECK_MARKERS ();
+ check_markers ();
}
/* Insert the part of the text of STRING, a Lisp object assumed to be
@@ -875,10 +860,10 @@ insert_1_both (const char *string,
without insert noticing. */
void
-insert_from_string (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
- EMACS_INT length, EMACS_INT length_byte, int inherit)
+insert_from_string (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
+ ptrdiff_t length, ptrdiff_t length_byte, bool inherit)
{
- EMACS_INT opoint = PT;
+ ptrdiff_t opoint = PT;
if (SCHARS (string) == 0)
return;
@@ -894,11 +879,11 @@ insert_from_string (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
void
insert_from_string_before_markers (Lisp_Object string,
- EMACS_INT pos, EMACS_INT pos_byte,
- EMACS_INT length, EMACS_INT length_byte,
- int inherit)
+ ptrdiff_t pos, ptrdiff_t pos_byte,
+ ptrdiff_t length, ptrdiff_t length_byte,
+ bool inherit)
{
- EMACS_INT opoint = PT;
+ ptrdiff_t opoint = PT;
if (SCHARS (string) == 0)
return;
@@ -912,12 +897,12 @@ insert_from_string_before_markers (Lisp_Object string,
/* Subroutine of the insertion functions above. */
static void
-insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
- EMACS_INT nchars, EMACS_INT nbytes,
- int inherit, int before_markers)
+insert_from_string_1 (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
+ ptrdiff_t nchars, ptrdiff_t nbytes,
+ bool inherit, bool before_markers)
{
struct gcpro gcpro1;
- EMACS_INT outgoing_nbytes = nbytes;
+ ptrdiff_t outgoing_nbytes = nbytes;
INTERVAL intervals;
/* Make OUTGOING_NBYTES describe the text
@@ -956,7 +941,7 @@ insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
the text that has been stored by copy_text. */
if (count_combining_before (GPT_ADDR, outgoing_nbytes, PT, PT_BYTE)
|| count_combining_after (GPT_ADDR, outgoing_nbytes, PT, PT_BYTE))
- abort ();
+ emacs_abort ();
#endif
record_insert (PT, nchars);
@@ -972,8 +957,7 @@ insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
Z_BYTE += outgoing_nbytes;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
/* The insert may have been in the unchanged region, so check again. */
if (Z - GPT < END_UNCHANGED)
@@ -986,7 +970,7 @@ insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
offset_intervals (current_buffer, PT, nchars);
- intervals = STRING_INTERVALS (string);
+ intervals = string_intervals (string);
/* Get the intervals for the part of the string we are inserting. */
if (nbytes < SBYTES (string))
intervals = copy_intervals (intervals, pos, nchars);
@@ -997,14 +981,14 @@ insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
adjust_point (nchars, outgoing_nbytes);
- CHECK_MARKERS ();
+ check_markers ();
}
/* Insert a sequence of NCHARS chars which occupy NBYTES bytes
starting at GPT_ADDR. */
void
-insert_from_gap (EMACS_INT nchars, EMACS_INT nbytes)
+insert_from_gap (ptrdiff_t nchars, ptrdiff_t nbytes)
{
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
nchars = nbytes;
@@ -1021,24 +1005,23 @@ insert_from_gap (EMACS_INT nchars, EMACS_INT nbytes)
Z_BYTE += nbytes;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
adjust_overlays_for_insert (GPT - nchars, nchars);
adjust_markers_for_insert (GPT - nchars, GPT_BYTE - nbytes,
GPT, GPT_BYTE, 0);
- if (BUF_INTERVALS (current_buffer) != 0)
+ if (buffer_intervals (current_buffer))
{
offset_intervals (current_buffer, GPT - nchars, nchars);
- graft_intervals_into_buffer (NULL_INTERVAL, GPT - nchars, nchars,
+ graft_intervals_into_buffer (NULL, GPT - nchars, nchars,
current_buffer, 0);
}
if (GPT - nchars < PT)
adjust_point (nchars, nbytes);
- CHECK_MARKERS ();
+ check_markers ();
}
/* Insert text from BUF, NCHARS characters starting at CHARPOS, into the
@@ -1050,9 +1033,9 @@ insert_from_gap (EMACS_INT nchars, EMACS_INT nbytes)
void
insert_from_buffer (struct buffer *buf,
- EMACS_INT charpos, EMACS_INT nchars, int inherit)
+ ptrdiff_t charpos, ptrdiff_t nchars, bool inherit)
{
- EMACS_INT opoint = PT;
+ ptrdiff_t opoint = PT;
insert_from_buffer_1 (buf, charpos, nchars, inherit);
signal_after_change (opoint, 0, PT - opoint);
@@ -1061,13 +1044,13 @@ insert_from_buffer (struct buffer *buf,
static void
insert_from_buffer_1 (struct buffer *buf,
- EMACS_INT from, EMACS_INT nchars, int inherit)
+ ptrdiff_t from, ptrdiff_t nchars, bool inherit)
{
- EMACS_INT chunk, chunk_expanded;
- EMACS_INT from_byte = buf_charpos_to_bytepos (buf, from);
- EMACS_INT to_byte = buf_charpos_to_bytepos (buf, from + nchars);
- EMACS_INT incoming_nbytes = to_byte - from_byte;
- EMACS_INT outgoing_nbytes = incoming_nbytes;
+ ptrdiff_t chunk, chunk_expanded;
+ ptrdiff_t from_byte = buf_charpos_to_bytepos (buf, from);
+ ptrdiff_t to_byte = buf_charpos_to_bytepos (buf, from + nchars);
+ ptrdiff_t incoming_nbytes = to_byte - from_byte;
+ ptrdiff_t outgoing_nbytes = incoming_nbytes;
INTERVAL intervals;
/* Make OUTGOING_NBYTES describe the text
@@ -1077,8 +1060,8 @@ insert_from_buffer_1 (struct buffer *buf,
outgoing_nbytes = nchars;
else if (NILP (BVAR (buf, enable_multibyte_characters)))
{
- EMACS_INT outgoing_before_gap = 0;
- EMACS_INT outgoing_after_gap = 0;
+ ptrdiff_t outgoing_before_gap = 0;
+ ptrdiff_t outgoing_after_gap = 0;
if (from < BUF_GPT (buf))
{
@@ -1141,7 +1124,7 @@ insert_from_buffer_1 (struct buffer *buf,
the text that has been stored by copy_text. */
if (count_combining_before (GPT_ADDR, outgoing_nbytes, PT, PT_BYTE)
|| count_combining_after (GPT_ADDR, outgoing_nbytes, PT, PT_BYTE))
- abort ();
+ emacs_abort ();
#endif
record_insert (PT, nchars);
@@ -1157,8 +1140,7 @@ insert_from_buffer_1 (struct buffer *buf,
Z_BYTE += outgoing_nbytes;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
/* The insert may have been in the unchanged region, so check again. */
if (Z - GPT < END_UNCHANGED)
@@ -1169,11 +1151,10 @@ insert_from_buffer_1 (struct buffer *buf,
PT_BYTE + outgoing_nbytes,
0);
- if (BUF_INTERVALS (current_buffer) != 0)
- offset_intervals (current_buffer, PT, nchars);
+ offset_intervals (current_buffer, PT, nchars);
/* Get the intervals for the part of the string we are inserting. */
- intervals = BUF_INTERVALS (buf);
+ intervals = buffer_intervals (buf);
if (nchars < BUF_Z (buf) - BUF_BEG (buf))
{
if (buf == current_buffer && PT <= from)
@@ -1195,15 +1176,15 @@ insert_from_buffer_1 (struct buffer *buf,
PREV_TEXT nil means the new text was just inserted. */
static void
-adjust_after_replace (EMACS_INT from, EMACS_INT from_byte,
- Lisp_Object prev_text, EMACS_INT len, EMACS_INT len_byte)
+adjust_after_replace (ptrdiff_t from, ptrdiff_t from_byte,
+ Lisp_Object prev_text, ptrdiff_t len, ptrdiff_t len_byte)
{
- EMACS_INT nchars_del = 0, nbytes_del = 0;
+ ptrdiff_t nchars_del = 0, nbytes_del = 0;
#ifdef BYTE_COMBINING_DEBUG
if (count_combining_before (GPT_ADDR, len_byte, from, from_byte)
|| count_combining_after (GPT_ADDR, len_byte, from, from_byte))
- abort ();
+ emacs_abort ();
#endif
if (STRINGP (prev_text))
@@ -1237,10 +1218,8 @@ adjust_after_replace (EMACS_INT from, EMACS_INT from_byte,
adjust_overlays_for_insert (from, len - nchars_del);
else if (len < nchars_del)
adjust_overlays_for_delete (from, nchars_del - len);
- if (BUF_INTERVALS (current_buffer) != 0)
- {
- offset_intervals (current_buffer, from, len - nchars_del);
- }
+
+ offset_intervals (current_buffer, from, len - nchars_del);
if (from < PT)
adjust_point (len - nchars_del, len_byte - nbytes_del);
@@ -1249,7 +1228,7 @@ adjust_after_replace (EMACS_INT from, EMACS_INT from_byte,
if (Z - GPT < END_UNCHANGED)
END_UNCHANGED = Z - GPT;
- CHECK_MARKERS ();
+ check_markers ();
if (len == 0)
evaporate_overlays (from);
@@ -1263,10 +1242,10 @@ adjust_after_replace (EMACS_INT from, EMACS_INT from_byte,
- FROM) may be incorrect, the correct length is NEWLEN. */
void
-adjust_after_insert (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte, EMACS_INT newlen)
+adjust_after_insert (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte, ptrdiff_t newlen)
{
- EMACS_INT len = to - from, len_byte = to_byte - from_byte;
+ ptrdiff_t len = to - from, len_byte = to_byte - from_byte;
if (GPT != to)
move_gap_both (to, to_byte);
@@ -1278,7 +1257,7 @@ adjust_after_insert (EMACS_INT from, EMACS_INT from_byte,
}
/* Replace the text from character positions FROM to TO with NEW,
- If PREPARE is nonzero, call prepare_to_modify_buffer.
+ If PREPARE, call prepare_to_modify_buffer.
If INHERIT, the newly inserted text should inherit text properties
from the surrounding non-deleted text. */
@@ -1290,26 +1269,26 @@ adjust_after_insert (EMACS_INT from, EMACS_INT from_byte,
But if MARKERS is 0, don't relocate markers. */
void
-replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new,
- int prepare, int inherit, int markers)
+replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
+ bool prepare, bool inherit, bool markers)
{
- EMACS_INT inschars = SCHARS (new);
- EMACS_INT insbytes = SBYTES (new);
- EMACS_INT from_byte, to_byte;
- EMACS_INT nbytes_del, nchars_del;
+ ptrdiff_t inschars = SCHARS (new);
+ ptrdiff_t insbytes = SBYTES (new);
+ ptrdiff_t from_byte, to_byte;
+ ptrdiff_t nbytes_del, nchars_del;
struct gcpro gcpro1;
INTERVAL intervals;
- EMACS_INT outgoing_insbytes = insbytes;
+ ptrdiff_t outgoing_insbytes = insbytes;
Lisp_Object deletion;
- CHECK_MARKERS ();
+ check_markers ();
GCPRO1 (new);
deletion = Qnil;
if (prepare)
{
- EMACS_INT range_length = to - from;
+ ptrdiff_t range_length = to - from;
prepare_to_modify_buffer (from, to, &from);
to = from + range_length;
}
@@ -1363,8 +1342,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new,
GPT_BYTE = from_byte;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
if (GPT - BEG < BEG_UNCHANGED)
BEG_UNCHANGED = GPT - BEG;
@@ -1388,7 +1366,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new,
the text that has been stored by copy_text. */
if (count_combining_before (GPT_ADDR, outgoing_insbytes, from, from_byte)
|| count_combining_after (GPT_ADDR, outgoing_insbytes, from, from_byte))
- abort ();
+ emacs_abort ();
#endif
if (! EQ (BVAR (current_buffer, undo_list), Qt))
@@ -1410,24 +1388,23 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new,
Z_BYTE += outgoing_insbytes;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
-
- /* Adjust the overlay center as needed. This must be done after
- adjusting the markers that bound the overlays. */
- adjust_overlays_for_delete (from, nchars_del);
- adjust_overlays_for_insert (from, inschars);
+ eassert (GPT <= GPT_BYTE);
/* Adjust markers for the deletion and the insertion. */
if (markers)
adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
inschars, outgoing_insbytes);
+ /* Adjust the overlay center as needed. This must be done after
+ adjusting the markers that bound the overlays. */
+ adjust_overlays_for_delete (from, nchars_del);
+ adjust_overlays_for_insert (from, inschars);
+
offset_intervals (current_buffer, from, inschars - nchars_del);
/* Get the intervals for the part of the string we are inserting--
not including the combined-before bytes. */
- intervals = STRING_INTERVALS (new);
+ intervals = string_intervals (new);
/* Insert those intervals. */
graft_intervals_into_buffer (intervals, from, inschars,
current_buffer, inherit);
@@ -1441,7 +1418,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new,
if (outgoing_insbytes == 0)
evaporate_overlays (from);
- CHECK_MARKERS ();
+ check_markers ();
MODIFF++;
CHARS_MODIFF = MODIFF;
@@ -1458,20 +1435,20 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new,
Note that this does not yet handle markers quite right.
- If MARKERS is nonzero, relocate markers.
+ If MARKERS, relocate markers.
Unlike most functions at this level, never call
prepare_to_modify_buffer and never call signal_after_change. */
void
-replace_range_2 (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte,
- const char *ins, EMACS_INT inschars, EMACS_INT insbytes,
- int markers)
+replace_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte,
+ const char *ins, ptrdiff_t inschars, ptrdiff_t insbytes,
+ bool markers)
{
- EMACS_INT nbytes_del, nchars_del;
+ ptrdiff_t nbytes_del, nchars_del;
- CHECK_MARKERS ();
+ check_markers ();
nchars_del = to - from;
nbytes_del = to_byte - from_byte;
@@ -1494,8 +1471,7 @@ replace_range_2 (EMACS_INT from, EMACS_INT from_byte,
GPT_BYTE = from_byte;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
if (GPT - BEG < BEG_UNCHANGED)
BEG_UNCHANGED = GPT - BEG;
@@ -1516,7 +1492,7 @@ replace_range_2 (EMACS_INT from, EMACS_INT from_byte,
the text that has been stored by copy_text. */
if (count_combining_before (GPT_ADDR, insbytes, from, from_byte)
|| count_combining_after (GPT_ADDR, insbytes, from, from_byte))
- abort ();
+ emacs_abort ();
#endif
GAP_SIZE -= insbytes;
@@ -1528,8 +1504,13 @@ replace_range_2 (EMACS_INT from, EMACS_INT from_byte,
Z_BYTE += insbytes;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
+
+ /* Adjust markers for the deletion and the insertion. */
+ if (markers
+ && ! (nchars_del == 1 && inschars == 1 && nbytes_del == insbytes))
+ adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
+ inschars, insbytes);
/* Adjust the overlay center as needed. This must be done after
adjusting the markers that bound the overlays. */
@@ -1539,12 +1520,6 @@ replace_range_2 (EMACS_INT from, EMACS_INT from_byte,
adjust_overlays_for_delete (from + inschars, nchars_del);
}
- /* Adjust markers for the deletion and the insertion. */
- if (markers
- && ! (nchars_del == 1 && inschars == 1 && nbytes_del == insbytes))
- adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
- inschars, insbytes);
-
offset_intervals (current_buffer, from, inschars - nchars_del);
/* Relocate point as if it were a marker. */
@@ -1560,7 +1535,7 @@ replace_range_2 (EMACS_INT from, EMACS_INT from_byte,
if (insbytes == 0)
evaporate_overlays (from);
- CHECK_MARKERS ();
+ check_markers ();
MODIFF++;
CHARS_MODIFF = MODIFF;
@@ -1571,7 +1546,7 @@ replace_range_2 (EMACS_INT from, EMACS_INT from_byte,
If TO comes before FROM, we delete nothing. */
void
-del_range (EMACS_INT from, EMACS_INT to)
+del_range (ptrdiff_t from, ptrdiff_t to)
{
del_range_1 (from, to, 1, 0);
}
@@ -1580,9 +1555,9 @@ del_range (EMACS_INT from, EMACS_INT to)
RET_STRING says to return the deleted text. */
Lisp_Object
-del_range_1 (EMACS_INT from, EMACS_INT to, int prepare, int ret_string)
+del_range_1 (ptrdiff_t from, ptrdiff_t to, bool prepare, bool ret_string)
{
- EMACS_INT from_byte, to_byte;
+ ptrdiff_t from_byte, to_byte;
Lisp_Object deletion;
struct gcpro gcpro1;
@@ -1597,7 +1572,7 @@ del_range_1 (EMACS_INT from, EMACS_INT to, int prepare, int ret_string)
if (prepare)
{
- EMACS_INT range_length = to - from;
+ ptrdiff_t range_length = to - from;
prepare_to_modify_buffer (from, to, &from);
to = min (ZV, from + range_length);
}
@@ -1616,9 +1591,9 @@ del_range_1 (EMACS_INT from, EMACS_INT to, int prepare, int ret_string)
/* Like del_range_1 but args are byte positions, not char positions. */
void
-del_range_byte (EMACS_INT from_byte, EMACS_INT to_byte, int prepare)
+del_range_byte (ptrdiff_t from_byte, ptrdiff_t to_byte, bool prepare)
{
- EMACS_INT from, to;
+ ptrdiff_t from, to;
/* Make args be valid */
if (from_byte < BEGV_BYTE)
@@ -1634,8 +1609,8 @@ del_range_byte (EMACS_INT from_byte, EMACS_INT to_byte, int prepare)
if (prepare)
{
- EMACS_INT old_from = from, old_to = Z - to;
- EMACS_INT range_length = to - from;
+ ptrdiff_t old_from = from, old_to = Z - to;
+ ptrdiff_t range_length = to - from;
prepare_to_modify_buffer (from, to, &from);
to = from + range_length;
@@ -1659,8 +1634,8 @@ del_range_byte (EMACS_INT from_byte, EMACS_INT to_byte, int prepare)
and bytepos. */
void
-del_range_both (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte, int prepare)
+del_range_both (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte, bool prepare)
{
/* Make args be valid */
if (from_byte < BEGV_BYTE)
@@ -1678,8 +1653,8 @@ del_range_both (EMACS_INT from, EMACS_INT from_byte,
if (prepare)
{
- EMACS_INT old_from = from, old_to = Z - to;
- EMACS_INT range_length = to - from;
+ ptrdiff_t old_from = from, old_to = Z - to;
+ ptrdiff_t range_length = to - from;
prepare_to_modify_buffer (from, to, &from);
to = from + range_length;
@@ -1702,16 +1677,16 @@ del_range_both (EMACS_INT from, EMACS_INT from_byte,
/* Delete a range of text, specified both as character positions
and byte positions. FROM and TO are character positions,
while FROM_BYTE and TO_BYTE are byte positions.
- If RET_STRING is true, the deleted area is returned as a string. */
+ If RET_STRING, the deleted area is returned as a string. */
Lisp_Object
-del_range_2 (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte, int ret_string)
+del_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte, bool ret_string)
{
- register EMACS_INT nbytes_del, nchars_del;
+ ptrdiff_t nbytes_del, nchars_del;
Lisp_Object deletion;
- CHECK_MARKERS ();
+ check_markers ();
nchars_del = to - from;
nbytes_del = to_byte - from_byte;
@@ -1725,7 +1700,7 @@ del_range_2 (EMACS_INT from, EMACS_INT from_byte,
#ifdef BYTE_COMBINING_DEBUG
if (count_combining_before (BUF_BYTE_ADDRESS (current_buffer, to_byte),
Z_BYTE - to_byte, from, from_byte))
- abort ();
+ emacs_abort ();
#endif
if (ret_string || ! EQ (BVAR (current_buffer, undo_list), Qt))
@@ -1767,15 +1742,14 @@ del_range_2 (EMACS_INT from, EMACS_INT from_byte,
needs to access the previous gap contents. */
*(GPT_ADDR) = 0;
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
if (GPT - BEG < BEG_UNCHANGED)
BEG_UNCHANGED = GPT - BEG;
if (Z - GPT < END_UNCHANGED)
END_UNCHANGED = Z - GPT;
- CHECK_MARKERS ();
+ check_markers ();
evaporate_overlays (from);
@@ -1788,17 +1762,16 @@ del_range_2 (EMACS_INT from, EMACS_INT from_byte,
and warns the next redisplay that it should pay attention to that
area.
- If PRESERVE_CHARS_MODIFF is non-zero, do not update CHARS_MODIFF.
+ If PRESERVE_CHARS_MODIFF, do not update CHARS_MODIFF.
Otherwise set CHARS_MODIFF to the new value of MODIFF. */
void
-modify_region (struct buffer *buffer, EMACS_INT start, EMACS_INT end,
- int preserve_chars_modiff)
+modify_region (struct buffer *buffer, ptrdiff_t start, ptrdiff_t end,
+ bool preserve_chars_modiff)
{
struct buffer *old_buffer = current_buffer;
- if (buffer != old_buffer)
- set_buffer_internal (buffer);
+ set_buffer_internal (buffer);
prepare_to_modify_buffer (start, end, NULL);
@@ -1810,10 +1783,9 @@ modify_region (struct buffer *buffer, EMACS_INT start, EMACS_INT end,
if (! preserve_chars_modiff)
CHARS_MODIFF = MODIFF;
- BVAR (buffer, point_before_scroll) = Qnil;
+ bset_point_before_scroll (buffer, Qnil);
- if (buffer != old_buffer)
- set_buffer_internal (old_buffer);
+ set_buffer_internal (old_buffer);
}
/* Check that it is okay to modify the buffer between START and END,
@@ -1827,8 +1799,8 @@ modify_region (struct buffer *buffer, EMACS_INT start, EMACS_INT end,
by holding its value temporarily in a marker. */
void
-prepare_to_modify_buffer (EMACS_INT start, EMACS_INT end,
- EMACS_INT *preserve_ptr)
+prepare_to_modify_buffer (ptrdiff_t start, ptrdiff_t end,
+ ptrdiff_t *preserve_ptr)
{
struct buffer *base_buffer;
@@ -1840,7 +1812,7 @@ prepare_to_modify_buffer (EMACS_INT start, EMACS_INT end,
if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
++windows_or_buffers_changed;
- if (BUF_INTERVALS (current_buffer) != 0)
+ if (buffer_intervals (current_buffer))
{
if (preserve_ptr)
{
@@ -1889,8 +1861,8 @@ prepare_to_modify_buffer (EMACS_INT start, EMACS_INT end,
: (!NILP (Vselect_active_regions)
&& !NILP (Vtransient_mark_mode))))
{
- EMACS_INT b = XMARKER (BVAR (current_buffer, mark))->charpos;
- EMACS_INT e = PT;
+ ptrdiff_t b = XMARKER (BVAR (current_buffer, mark))->charpos;
+ ptrdiff_t e = PT;
if (b < e)
Vsaved_region_selection = make_buffer_string (b, e, 0);
else if (b > e)
@@ -1958,14 +1930,14 @@ reset_var_on_error (Lisp_Object val)
by holding its value temporarily in a marker. */
static void
-signal_before_change (EMACS_INT start_int, EMACS_INT end_int,
- EMACS_INT *preserve_ptr)
+signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int,
+ ptrdiff_t *preserve_ptr)
{
Lisp_Object start, end;
Lisp_Object start_marker, end_marker;
Lisp_Object preserve_marker;
struct gcpro gcpro1, gcpro2, gcpro3;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (inhibit_modification_hooks)
return;
@@ -2011,7 +1983,7 @@ signal_before_change (EMACS_INT start_int, EMACS_INT end_int,
XSETCDR (rvoe_arg, Qt);
}
- if (current_buffer->overlays_before || current_buffer->overlays_after)
+ if (buffer_has_overlays ())
{
PRESERVE_VALUE;
report_overlay_modification (FETCH_START, FETCH_END, 0,
@@ -2036,9 +2008,9 @@ signal_before_change (EMACS_INT start_int, EMACS_INT end_int,
after the change. */
void
-signal_after_change (EMACS_INT charpos, EMACS_INT lendel, EMACS_INT lenins)
+signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (inhibit_modification_hooks)
return;
@@ -2047,8 +2019,7 @@ signal_after_change (EMACS_INT charpos, EMACS_INT lendel, EMACS_INT lenins)
just record the args that we were going to use. */
if (! NILP (Vcombine_after_change_calls)
&& NILP (Vbefore_change_functions)
- && !current_buffer->overlays_before
- && !current_buffer->overlays_after)
+ && !buffer_has_overlays ())
{
Lisp_Object elt;
@@ -2090,7 +2061,7 @@ signal_after_change (EMACS_INT charpos, EMACS_INT lendel, EMACS_INT lenins)
XSETCDR (rvoe_arg, Qt);
}
- if (current_buffer->overlays_before || current_buffer->overlays_after)
+ if (buffer_has_overlays ())
report_overlay_modification (make_number (charpos),
make_number (charpos + lenins),
1,
@@ -2119,9 +2090,9 @@ DEFUN ("combine-after-change-execute", Fcombine_after_change_execute,
doc: /* This function is for use internally in `combine-after-change-calls'. */)
(void)
{
- int count = SPECPDL_INDEX ();
- EMACS_INT beg, end, change;
- EMACS_INT begpos, endpos;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t beg, end, change;
+ ptrdiff_t begpos, endpos;
Lisp_Object tail;
if (NILP (combine_after_change_list))
@@ -2132,13 +2103,13 @@ DEFUN ("combine-after-change-execute", Fcombine_after_change_execute,
non-nil, and insertion calls a file handler (e.g. through
lock_file) which scribbles into a temp file -- cyd */
if (!BUFFERP (combine_after_change_buffer)
- || NILP (BVAR (XBUFFER (combine_after_change_buffer), name)))
+ || !BUFFER_LIVE_P (XBUFFER (combine_after_change_buffer)))
{
combine_after_change_list = Qnil;
return Qnil;
}
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (combine_after_change_buffer);
@@ -2155,7 +2126,7 @@ DEFUN ("combine-after-change-execute", Fcombine_after_change_execute,
tail = XCDR (tail))
{
Lisp_Object elt;
- EMACS_INT thisbeg, thisend, thischange;
+ ptrdiff_t thisbeg, thisend, thischange;
/* Extract the info from the next element. */
elt = XCAR (tail);
@@ -2207,9 +2178,6 @@ syms_of_insdel (void)
combine_after_change_list = Qnil;
combine_after_change_buffer = Qnil;
- DEFVAR_BOOL ("check-markers-debug-flag", check_markers_debug_flag,
- doc: /* Non-nil means enable debugging checks for invalid marker positions. */);
- check_markers_debug_flag = 0;
DEFVAR_LISP ("combine-after-change-calls", Vcombine_after_change_calls,
doc: /* Used internally by the `combine-after-change-calls' macro. */);
Vcombine_after_change_calls = Qnil;
diff --git a/src/intervals.c b/src/intervals.c
index 05b7175ac3f..1ed93e1302d 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -1,5 +1,5 @@
/* Code for doing intervals.
- Copyright (C) 1993-1995, 1997-1998, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1995, 1997-1998, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -38,10 +38,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
+#define INTERVALS_INLINE EXTERN_INLINE
+
#include <intprops.h>
#include "lisp.h"
#include "intervals.h"
+#include "character.h"
#include "buffer.h"
#include "puresize.h"
#include "keyboard.h"
@@ -55,10 +58,41 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
static Lisp_Object merge_properties_sticky (Lisp_Object, Lisp_Object);
static INTERVAL merge_interval_right (INTERVAL);
static INTERVAL reproduce_tree (INTERVAL, INTERVAL);
-static INTERVAL reproduce_tree_obj (INTERVAL, Lisp_Object);
/* Utility functions for intervals. */
+/* Use these functions to set Lisp_Object
+ or pointer slots of struct interval. */
+
+static void
+set_interval_object (INTERVAL i, Lisp_Object obj)
+{
+ eassert (BUFFERP (obj) || STRINGP (obj));
+ i->up_obj = 1;
+ i->up.obj = obj;
+}
+
+static void
+set_interval_left (INTERVAL i, INTERVAL left)
+{
+ i->left = left;
+}
+
+static void
+set_interval_right (INTERVAL i, INTERVAL right)
+{
+ i->right = right;
+}
+
+/* Make the parent of D be whatever the parent of S is, regardless
+ of the type. This is used when balancing an interval tree. */
+
+static void
+copy_interval_parent (INTERVAL d, INTERVAL s)
+{
+ d->up = s->up;
+ d->up_obj = s->up_obj;
+}
/* Create the root interval of some object, a buffer or string. */
@@ -75,19 +109,19 @@ create_root_interval (Lisp_Object parent)
{
new->total_length = (BUF_Z (XBUFFER (parent))
- BUF_BEG (XBUFFER (parent)));
- CHECK_TOTAL_LENGTH (new);
- BUF_INTERVALS (XBUFFER (parent)) = new;
+ eassert (0 <= TOTAL_LENGTH (new));
+ set_buffer_intervals (XBUFFER (parent), new);
new->position = BEG;
}
else if (STRINGP (parent))
{
new->total_length = SCHARS (parent);
- CHECK_TOTAL_LENGTH (new);
- STRING_SET_INTERVALS (parent, new);
+ eassert (0 <= TOTAL_LENGTH (new));
+ set_string_intervals (parent, new);
new->position = 0;
}
- SET_INTERVAL_OBJECT (new, parent);
+ set_interval_object (new, parent);
return new;
}
@@ -101,7 +135,7 @@ copy_properties (register INTERVAL source, register INTERVAL target)
return;
COPY_INTERVAL_CACHE (source, target);
- target->plist = Fcopy_sequence (source->plist);
+ set_interval_plist (target, Fcopy_sequence (source->plist));
}
/* Merge the properties of interval SOURCE into the properties
@@ -137,20 +171,19 @@ merge_properties (register INTERVAL source, register INTERVAL target)
if (NILP (val))
{
val = XCAR (o);
- target->plist = Fcons (sym, Fcons (val, target->plist));
+ set_interval_plist (target, Fcons (sym, Fcons (val, target->plist)));
}
o = XCDR (o);
}
}
-/* Return 1 if the two intervals have the same properties,
- 0 otherwise. */
+/* Return true if the two intervals have the same properties. */
-int
+bool
intervals_equal (INTERVAL i0, INTERVAL i1)
{
- register Lisp_Object i0_cdr, i0_sym;
- register Lisp_Object i1_cdr, i1_val;
+ Lisp_Object i0_cdr, i0_sym;
+ Lisp_Object i1_cdr, i1_val;
if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
return 1;
@@ -165,13 +198,13 @@ intervals_equal (INTERVAL i0, INTERVAL i1)
i0_sym = XCAR (i0_cdr);
i0_cdr = XCDR (i0_cdr);
if (!CONSP (i0_cdr))
- return 0; /* abort (); */
+ return 0;
i1_val = i1->plist;
while (CONSP (i1_val) && !EQ (XCAR (i1_val), i0_sym))
{
i1_val = XCDR (i1_val);
if (!CONSP (i1_val))
- return 0; /* abort (); */
+ return 0;
i1_val = XCDR (i1_val);
}
@@ -189,7 +222,7 @@ intervals_equal (INTERVAL i0, INTERVAL i1)
i1_cdr = XCDR (i1_cdr);
if (!CONSP (i1_cdr))
- return 0; /* abort (); */
+ return 0;
i1_cdr = XCDR (i1_cdr);
}
@@ -206,10 +239,10 @@ void
traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
{
/* Minimize stack usage. */
- while (!NULL_INTERVAL_P (tree))
+ while (tree)
{
(*function) (tree, arg);
- if (NULL_INTERVAL_P (tree->right))
+ if (!tree->right)
tree = tree->left;
else
{
@@ -223,10 +256,10 @@ traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Obje
Pass FUNCTION two args: an interval, and ARG. */
void
-traverse_intervals (INTERVAL tree, EMACS_INT position,
+traverse_intervals (INTERVAL tree, ptrdiff_t position,
void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
{
- while (!NULL_INTERVAL_P (tree))
+ while (tree)
{
traverse_intervals (tree->left, position, function, arg);
position += LEFT_TOTAL_LENGTH (tree);
@@ -261,7 +294,7 @@ search_for_interval (INTERVAL i, INTERVAL tree)
{
icount = 0;
search_interval = i;
- found_interval = NULL_INTERVAL;
+ found_interval = NULL;
traverse_intervals_noorder (tree, &check_for_interval, Qnil);
return found_interval;
}
@@ -308,40 +341,40 @@ root_interval (INTERVAL interval)
c c
*/
-static inline INTERVAL
+static INTERVAL
rotate_right (INTERVAL interval)
{
INTERVAL i;
INTERVAL B = interval->left;
- EMACS_INT old_total = interval->total_length;
+ ptrdiff_t old_total = interval->total_length;
/* Deal with any Parent of A; make it point to B. */
if (! ROOT_INTERVAL_P (interval))
{
if (AM_LEFT_CHILD (interval))
- INTERVAL_PARENT (interval)->left = B;
+ set_interval_left (INTERVAL_PARENT (interval), B);
else
- INTERVAL_PARENT (interval)->right = B;
+ set_interval_right (INTERVAL_PARENT (interval), B);
}
- COPY_INTERVAL_PARENT (B, interval);
+ copy_interval_parent (B, interval);
/* Make B the parent of A */
i = B->right;
- B->right = interval;
- SET_INTERVAL_PARENT (interval, B);
+ set_interval_right (B, interval);
+ set_interval_parent (interval, B);
/* Make A point to c */
- interval->left = i;
- if (! NULL_INTERVAL_P (i))
- SET_INTERVAL_PARENT (i, interval);
+ set_interval_left (interval, i);
+ if (i)
+ set_interval_parent (i, interval);
/* A's total length is decreased by the length of B and its left child. */
interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
- CHECK_TOTAL_LENGTH (interval);
+ eassert (0 <= TOTAL_LENGTH (interval));
/* B must have the same total length of A. */
B->total_length = old_total;
- CHECK_TOTAL_LENGTH (B);
+ eassert (0 <= TOTAL_LENGTH (B));
return B;
}
@@ -355,40 +388,40 @@ rotate_right (INTERVAL interval)
c c
*/
-static inline INTERVAL
+static INTERVAL
rotate_left (INTERVAL interval)
{
INTERVAL i;
INTERVAL B = interval->right;
- EMACS_INT old_total = interval->total_length;
+ ptrdiff_t old_total = interval->total_length;
/* Deal with any parent of A; make it point to B. */
if (! ROOT_INTERVAL_P (interval))
{
if (AM_LEFT_CHILD (interval))
- INTERVAL_PARENT (interval)->left = B;
+ set_interval_left (INTERVAL_PARENT (interval), B);
else
- INTERVAL_PARENT (interval)->right = B;
+ set_interval_right (INTERVAL_PARENT (interval), B);
}
- COPY_INTERVAL_PARENT (B, interval);
+ copy_interval_parent (B, interval);
/* Make B the parent of A */
i = B->left;
- B->left = interval;
- SET_INTERVAL_PARENT (interval, B);
+ set_interval_left (B, interval);
+ set_interval_parent (interval, B);
/* Make A point to c */
- interval->right = i;
- if (! NULL_INTERVAL_P (i))
- SET_INTERVAL_PARENT (i, interval);
+ set_interval_right (interval, i);
+ if (i)
+ set_interval_parent (i, interval);
/* A's total length is decreased by the length of B and its right child. */
interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);
- CHECK_TOTAL_LENGTH (interval);
+ eassert (0 <= TOTAL_LENGTH (interval));
/* B must have the same total length of A. */
B->total_length = old_total;
- CHECK_TOTAL_LENGTH (B);
+ eassert (0 <= TOTAL_LENGTH (B));
return B;
}
@@ -399,7 +432,7 @@ rotate_left (INTERVAL interval)
static INTERVAL
balance_an_interval (INTERVAL i)
{
- register EMACS_INT old_diff, new_diff;
+ register ptrdiff_t old_diff, new_diff;
while (1)
{
@@ -433,11 +466,11 @@ balance_an_interval (INTERVAL i)
/* Balance INTERVAL, potentially stuffing it back into its parent
Lisp Object. */
-static inline INTERVAL
-balance_possible_root_interval (register INTERVAL interval)
+static INTERVAL
+balance_possible_root_interval (INTERVAL interval)
{
Lisp_Object parent;
- int have_parent = 0;
+ bool have_parent = 0;
if (!INTERVAL_HAS_OBJECT (interval) && !INTERVAL_HAS_PARENT (interval))
return interval;
@@ -452,9 +485,9 @@ balance_possible_root_interval (register INTERVAL interval)
if (have_parent)
{
if (BUFFERP (parent))
- BUF_INTERVALS (XBUFFER (parent)) = interval;
+ set_buffer_intervals (XBUFFER (parent), interval);
else if (STRINGP (parent))
- STRING_SET_INTERVALS (parent, interval);
+ set_string_intervals (parent, interval);
}
return interval;
@@ -479,12 +512,22 @@ balance_intervals_internal (register INTERVAL tree)
INTERVAL
balance_intervals (INTERVAL tree)
{
- if (tree == NULL_INTERVAL)
- return NULL_INTERVAL;
+ return tree ? balance_intervals_internal (tree) : NULL;
+}
+
+/* Rebalance text properties of B. */
+
+static void
+buffer_balance_intervals (struct buffer *b)
+{
+ INTERVAL i;
- return balance_intervals_internal (tree);
+ eassert (b != NULL);
+ i = buffer_intervals (b);
+ if (i)
+ set_buffer_intervals (b, balance_an_interval (i));
}
-
+
/* Split INTERVAL into two pieces, starting the second piece at
character position OFFSET (counting from 0), relative to INTERVAL.
INTERVAL becomes the left-hand piece, and the right-hand piece
@@ -499,29 +542,29 @@ balance_intervals (INTERVAL tree)
it is still a root after this operation. */
INTERVAL
-split_interval_right (INTERVAL interval, EMACS_INT offset)
+split_interval_right (INTERVAL interval, ptrdiff_t offset)
{
INTERVAL new = make_interval ();
- EMACS_INT position = interval->position;
- EMACS_INT new_length = LENGTH (interval) - offset;
+ ptrdiff_t position = interval->position;
+ ptrdiff_t new_length = LENGTH (interval) - offset;
new->position = position + offset;
- SET_INTERVAL_PARENT (new, interval);
+ set_interval_parent (new, interval);
if (NULL_RIGHT_CHILD (interval))
{
- interval->right = new;
+ set_interval_right (interval, new);
new->total_length = new_length;
- CHECK_TOTAL_LENGTH (new);
+ eassert (0 <= TOTAL_LENGTH (new));
}
else
{
/* Insert the new node between INTERVAL and its right child. */
- new->right = interval->right;
- SET_INTERVAL_PARENT (interval->right, new);
- interval->right = new;
+ set_interval_right (new, interval->right);
+ set_interval_parent (interval->right, new);
+ set_interval_right (interval, new);
new->total_length = new_length + new->right->total_length;
- CHECK_TOTAL_LENGTH (new);
+ eassert (0 <= TOTAL_LENGTH (new));
balance_an_interval (new);
}
@@ -544,29 +587,29 @@ split_interval_right (INTERVAL interval, EMACS_INT offset)
it is still a root after this operation. */
INTERVAL
-split_interval_left (INTERVAL interval, EMACS_INT offset)
+split_interval_left (INTERVAL interval, ptrdiff_t offset)
{
INTERVAL new = make_interval ();
- EMACS_INT new_length = offset;
+ ptrdiff_t new_length = offset;
new->position = interval->position;
interval->position = interval->position + offset;
- SET_INTERVAL_PARENT (new, interval);
+ set_interval_parent (new, interval);
if (NULL_LEFT_CHILD (interval))
{
- interval->left = new;
+ set_interval_left (interval, new);
new->total_length = new_length;
- CHECK_TOTAL_LENGTH (new);
+ eassert (0 <= TOTAL_LENGTH (new));
}
else
{
/* Insert the new node between INTERVAL and its left child. */
- new->left = interval->left;
- SET_INTERVAL_PARENT (new->left, new);
- interval->left = new;
+ set_interval_left (new, interval->left);
+ set_interval_parent (new->left, new);
+ set_interval_left (interval, new);
new->total_length = new_length + new->left->total_length;
- CHECK_TOTAL_LENGTH (new);
+ eassert (0 <= TOTAL_LENGTH (new));
balance_an_interval (new);
}
@@ -588,7 +631,7 @@ interval_start_pos (INTERVAL source)
{
Lisp_Object parent;
- if (NULL_INTERVAL_P (source))
+ if (!source)
return 0;
if (! INTERVAL_HAS_OBJECT (source))
@@ -610,14 +653,14 @@ interval_start_pos (INTERVAL source)
will update this cache based on the result of find_interval. */
INTERVAL
-find_interval (register INTERVAL tree, register EMACS_INT position)
+find_interval (register INTERVAL tree, register ptrdiff_t position)
{
/* The distance from the left edge of the subtree at TREE
to POSITION. */
- register EMACS_INT relative_position;
+ register ptrdiff_t relative_position;
- if (NULL_INTERVAL_P (tree))
- return NULL_INTERVAL;
+ if (!tree)
+ return NULL;
relative_position = position;
if (INTERVAL_HAS_OBJECT (tree))
@@ -628,11 +671,9 @@ find_interval (register INTERVAL tree, register EMACS_INT position)
relative_position -= BUF_BEG (XBUFFER (parent));
}
- if (relative_position > TOTAL_LENGTH (tree))
- abort (); /* Paranoia */
+ eassert (relative_position <= TOTAL_LENGTH (tree));
- if (!handling_signal)
- tree = balance_possible_root_interval (tree);
+ tree = balance_possible_root_interval (tree);
while (1)
{
@@ -667,10 +708,10 @@ INTERVAL
next_interval (register INTERVAL interval)
{
register INTERVAL i = interval;
- register EMACS_INT next_position;
+ register ptrdiff_t next_position;
- if (NULL_INTERVAL_P (i))
- return NULL_INTERVAL;
+ if (!i)
+ return NULL;
next_position = interval->position + LENGTH (interval);
if (! NULL_RIGHT_CHILD (i))
@@ -695,7 +736,7 @@ next_interval (register INTERVAL interval)
i = INTERVAL_PARENT (i);
}
- return NULL_INTERVAL;
+ return NULL;
}
/* Find the preceding interval (lexicographically) to INTERVAL.
@@ -707,8 +748,8 @@ previous_interval (register INTERVAL interval)
{
register INTERVAL i;
- if (NULL_INTERVAL_P (interval))
- return NULL_INTERVAL;
+ if (!interval)
+ return NULL;
if (! NULL_LEFT_CHILD (interval))
{
@@ -733,7 +774,7 @@ previous_interval (register INTERVAL interval)
i = INTERVAL_PARENT (i);
}
- return NULL_INTERVAL;
+ return NULL;
}
/* Find the interval containing POS given some non-NULL INTERVAL
@@ -742,10 +783,10 @@ previous_interval (register INTERVAL interval)
To speed up the process, we assume that the ->position of
I and all its parents is already uptodate. */
INTERVAL
-update_interval (register INTERVAL i, EMACS_INT pos)
+update_interval (register INTERVAL i, ptrdiff_t pos)
{
- if (NULL_INTERVAL_P (i))
- return NULL_INTERVAL;
+ if (!i)
+ return NULL;
while (1)
{
@@ -774,7 +815,7 @@ update_interval (register INTERVAL i, EMACS_INT pos)
i = i->right; /* Move to the right child */
}
else if (NULL_PARENT (i))
- error ("Point %"pI"d after end of properties", pos);
+ error ("Point %"pD"d after end of properties", pos);
else
i = INTERVAL_PARENT (i);
continue;
@@ -784,68 +825,6 @@ update_interval (register INTERVAL i, EMACS_INT pos)
}
}
-
-#if 0
-/* Traverse a path down the interval tree TREE to the interval
- containing POSITION, adjusting all nodes on the path for
- an addition of LENGTH characters. Insertion between two intervals
- (i.e., point == i->position, where i is second interval) means
- text goes into second interval.
-
- Modifications are needed to handle the hungry bits -- after simply
- finding the interval at position (don't add length going down),
- if it's the beginning of the interval, get the previous interval
- and check the hungry bits of both. Then add the length going back up
- to the root. */
-
-static INTERVAL
-adjust_intervals_for_insertion (INTERVAL tree, EMACS_INT position,
- EMACS_INT length)
-{
- register EMACS_INT relative_position;
- register INTERVAL this;
-
- if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
- abort ();
-
- /* If inserting at point-max of a buffer, that position
- will be out of range */
- if (position > TOTAL_LENGTH (tree))
- position = TOTAL_LENGTH (tree);
- relative_position = position;
- this = tree;
-
- while (1)
- {
- if (relative_position <= LEFT_TOTAL_LENGTH (this))
- {
- this->total_length += length;
- CHECK_TOTAL_LENGTH (this);
- this = this->left;
- }
- else if (relative_position > (TOTAL_LENGTH (this)
- - RIGHT_TOTAL_LENGTH (this)))
- {
- relative_position -= (TOTAL_LENGTH (this)
- - RIGHT_TOTAL_LENGTH (this));
- this->total_length += length;
- CHECK_TOTAL_LENGTH (this);
- this = this->right;
- }
- else
- {
- /* If we are to use zero-length intervals as buffer pointers,
- then this code will have to change. */
- this->total_length += length;
- CHECK_TOTAL_LENGTH (this);
- this->position = LEFT_TOTAL_LENGTH (this)
- + position - relative_position + 1;
- return tree;
- }
- }
-}
-#endif
-
/* Effect an adjustment corresponding to the addition of LENGTH characters
of text. Do this by finding the interval containing POSITION in the
interval tree TREE, and then adjusting all of its ancestors by adding
@@ -861,16 +840,15 @@ adjust_intervals_for_insertion (INTERVAL tree, EMACS_INT position,
static INTERVAL
adjust_intervals_for_insertion (INTERVAL tree,
- EMACS_INT position, EMACS_INT length)
+ ptrdiff_t position, ptrdiff_t length)
{
- register INTERVAL i;
- register INTERVAL temp;
- int eobp = 0;
+ INTERVAL i;
+ INTERVAL temp;
+ bool eobp = 0;
Lisp_Object parent;
- EMACS_INT offset;
+ ptrdiff_t offset;
- if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
- abort ();
+ eassert (TOTAL_LENGTH (tree) > 0);
GET_INTERVAL_OBJECT (parent, tree);
offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
@@ -981,7 +959,7 @@ adjust_intervals_for_insertion (INTERVAL tree,
for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
{
temp->total_length += length;
- CHECK_TOTAL_LENGTH (temp);
+ eassert (0 <= TOTAL_LENGTH (temp));
temp = balance_possible_root_interval (temp);
}
@@ -1000,25 +978,24 @@ adjust_intervals_for_insertion (INTERVAL tree,
Lisp_Object pleft, pright;
struct interval newi;
- pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
- pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
- newi.plist = merge_properties_sticky (pleft, pright);
+ RESET_INTERVAL (&newi);
+ pleft = prev ? prev->plist : Qnil;
+ pright = i ? i->plist : Qnil;
+ set_interval_plist (&newi, merge_properties_sticky (pleft, pright));
if (! prev) /* i.e. position == BEG */
{
if (! intervals_equal (i, &newi))
{
i = split_interval_left (i, length);
- i->plist = newi.plist;
+ set_interval_plist (i, newi.plist);
}
}
else if (! intervals_equal (prev, &newi))
{
- prev = split_interval_right (prev,
- position - prev->position);
- prev->plist = newi.plist;
- if (! NULL_INTERVAL_P (i)
- && intervals_equal (prev, i))
+ prev = split_interval_right (prev, position - prev->position);
+ set_interval_plist (prev, newi.plist);
+ if (i && intervals_equal (prev, i))
merge_interval_right (prev);
}
@@ -1038,7 +1015,7 @@ adjust_intervals_for_insertion (INTERVAL tree,
for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
{
temp->total_length += length;
- CHECK_TOTAL_LENGTH (temp);
+ eassert (0 <= TOTAL_LENGTH (temp));
temp = balance_possible_root_interval (temp);
}
}
@@ -1088,11 +1065,10 @@ FR 8 9 A B
static Lisp_Object
merge_properties_sticky (Lisp_Object pleft, Lisp_Object pright)
{
- register Lisp_Object props, front, rear;
+ Lisp_Object props, front, rear;
Lisp_Object lfront, lrear, rfront, rrear;
- register Lisp_Object tail1, tail2, sym, lval, rval, cat;
- int use_left, use_right;
- int lpresent;
+ Lisp_Object tail1, tail2, sym, lval, rval, cat;
+ bool use_left, use_right, lpresent;
props = Qnil;
front = Qnil;
@@ -1225,25 +1201,25 @@ static INTERVAL
delete_node (register INTERVAL i)
{
register INTERVAL migrate, this;
- register EMACS_INT migrate_amt;
+ register ptrdiff_t migrate_amt;
- if (NULL_INTERVAL_P (i->left))
+ if (!i->left)
return i->right;
- if (NULL_INTERVAL_P (i->right))
+ if (!i->right)
return i->left;
migrate = i->left;
migrate_amt = i->left->total_length;
this = i->right;
this->total_length += migrate_amt;
- while (! NULL_INTERVAL_P (this->left))
+ while (this->left)
{
this = this->left;
this->total_length += migrate_amt;
}
- CHECK_TOTAL_LENGTH (this);
- this->left = migrate;
- SET_INTERVAL_PARENT (migrate, this);
+ eassert (0 <= TOTAL_LENGTH (this));
+ set_interval_left (this, migrate);
+ set_interval_parent (migrate, this);
return i->right;
}
@@ -1258,25 +1234,24 @@ static void
delete_interval (register INTERVAL i)
{
register INTERVAL parent;
- EMACS_INT amt = LENGTH (i);
+ ptrdiff_t amt = LENGTH (i);
- if (amt > 0) /* Only used on zero-length intervals now. */
- abort ();
+ eassert (amt == 0); /* Only used on zero-length intervals now. */
if (ROOT_INTERVAL_P (i))
{
Lisp_Object owner;
GET_INTERVAL_OBJECT (owner, i);
parent = delete_node (i);
- if (! NULL_INTERVAL_P (parent))
- SET_INTERVAL_OBJECT (parent, owner);
+ if (parent)
+ set_interval_object (parent, owner);
if (BUFFERP (owner))
- BUF_INTERVALS (XBUFFER (owner)) = parent;
+ set_buffer_intervals (XBUFFER (owner), parent);
else if (STRINGP (owner))
- STRING_SET_INTERVALS (owner, parent);
+ set_string_intervals (owner, parent);
else
- abort ();
+ emacs_abort ();
return;
}
@@ -1284,15 +1259,15 @@ delete_interval (register INTERVAL i)
parent = INTERVAL_PARENT (i);
if (AM_LEFT_CHILD (i))
{
- parent->left = delete_node (i);
- if (! NULL_INTERVAL_P (parent->left))
- SET_INTERVAL_PARENT (parent->left, parent);
+ set_interval_left (parent, delete_node (i));
+ if (parent->left)
+ set_interval_parent (parent->left, parent);
}
else
{
- parent->right = delete_node (i);
- if (! NULL_INTERVAL_P (parent->right))
- SET_INTERVAL_PARENT (parent->right, parent);
+ set_interval_right (parent, delete_node (i));
+ if (parent->right)
+ set_interval_parent (parent->right, parent);
}
}
@@ -1308,30 +1283,30 @@ delete_interval (register INTERVAL i)
Do this by recursing down TREE to the interval in question, and
deleting the appropriate amount of text. */
-static EMACS_INT
-interval_deletion_adjustment (register INTERVAL tree, register EMACS_INT from,
- register EMACS_INT amount)
+static ptrdiff_t
+interval_deletion_adjustment (register INTERVAL tree, register ptrdiff_t from,
+ register ptrdiff_t amount)
{
- register EMACS_INT relative_position = from;
+ register ptrdiff_t relative_position = from;
- if (NULL_INTERVAL_P (tree))
+ if (!tree)
return 0;
/* Left branch. */
if (relative_position < LEFT_TOTAL_LENGTH (tree))
{
- EMACS_INT subtract = interval_deletion_adjustment (tree->left,
+ ptrdiff_t subtract = interval_deletion_adjustment (tree->left,
relative_position,
amount);
tree->total_length -= subtract;
- CHECK_TOTAL_LENGTH (tree);
+ eassert (0 <= TOTAL_LENGTH (tree));
return subtract;
}
/* Right branch. */
else if (relative_position >= (TOTAL_LENGTH (tree)
- RIGHT_TOTAL_LENGTH (tree)))
{
- EMACS_INT subtract;
+ ptrdiff_t subtract;
relative_position -= (tree->total_length
- RIGHT_TOTAL_LENGTH (tree));
@@ -1339,14 +1314,14 @@ interval_deletion_adjustment (register INTERVAL tree, register EMACS_INT from,
relative_position,
amount);
tree->total_length -= subtract;
- CHECK_TOTAL_LENGTH (tree);
+ eassert (0 <= TOTAL_LENGTH (tree));
return subtract;
}
/* Here -- this node. */
else
{
/* How much can we delete from this interval? */
- EMACS_INT my_amount = ((tree->total_length
+ ptrdiff_t my_amount = ((tree->total_length
- RIGHT_TOTAL_LENGTH (tree))
- relative_position);
@@ -1354,7 +1329,7 @@ interval_deletion_adjustment (register INTERVAL tree, register EMACS_INT from,
amount = my_amount;
tree->total_length -= amount;
- CHECK_TOTAL_LENGTH (tree);
+ eassert (0 <= TOTAL_LENGTH (tree));
if (LENGTH (tree) == 0)
delete_interval (tree);
@@ -1371,33 +1346,32 @@ interval_deletion_adjustment (register INTERVAL tree, register EMACS_INT from,
static void
adjust_intervals_for_deletion (struct buffer *buffer,
- EMACS_INT start, EMACS_INT length)
+ ptrdiff_t start, ptrdiff_t length)
{
- register EMACS_INT left_to_delete = length;
- register INTERVAL tree = BUF_INTERVALS (buffer);
+ ptrdiff_t left_to_delete = length;
+ INTERVAL tree = buffer_intervals (buffer);
Lisp_Object parent;
- EMACS_INT offset;
+ ptrdiff_t offset;
GET_INTERVAL_OBJECT (parent, tree);
offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
- if (NULL_INTERVAL_P (tree))
+ if (!tree)
return;
- if (start > offset + TOTAL_LENGTH (tree)
- || start + length > offset + TOTAL_LENGTH (tree))
- abort ();
+ eassert (start <= offset + TOTAL_LENGTH (tree)
+ && start + length <= offset + TOTAL_LENGTH (tree));
if (length == TOTAL_LENGTH (tree))
{
- BUF_INTERVALS (buffer) = NULL_INTERVAL;
+ set_buffer_intervals (buffer, NULL);
return;
}
if (ONLY_INTERVAL_P (tree))
{
tree->total_length -= length;
- CHECK_TOTAL_LENGTH (tree);
+ eassert (0 <= TOTAL_LENGTH (tree));
return;
}
@@ -1407,10 +1381,10 @@ adjust_intervals_for_deletion (struct buffer *buffer,
{
left_to_delete -= interval_deletion_adjustment (tree, start - offset,
left_to_delete);
- tree = BUF_INTERVALS (buffer);
+ tree = buffer_intervals (buffer);
if (left_to_delete == tree->total_length)
{
- BUF_INTERVALS (buffer) = NULL_INTERVAL;
+ set_buffer_intervals (buffer, NULL);
return;
}
}
@@ -1419,23 +1393,20 @@ adjust_intervals_for_deletion (struct buffer *buffer,
/* Make the adjustments necessary to the interval tree of BUFFER to
represent an addition or deletion of LENGTH characters starting
at position START. Addition or deletion is indicated by the sign
- of LENGTH.
-
- The two inline functions (one static) pacify Sun C 5.8, a pre-C99
- compiler that does not allow calling a static function (here,
- adjust_intervals_for_deletion) from a non-static inline function. */
+ of LENGTH. */
void
-offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT length)
+offset_intervals (struct buffer *buffer, ptrdiff_t start, ptrdiff_t length)
{
- if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
+ if (!buffer_intervals (buffer) || length == 0)
return;
if (length > 0)
- adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
+ adjust_intervals_for_insertion (buffer_intervals (buffer),
+ start, length);
else
{
- IF_LINT (if (length < - TYPE_MAXIMUM (EMACS_INT)) abort ();)
+ lint_assume (- TYPE_MAXIMUM (ptrdiff_t) <= length);
adjust_intervals_for_deletion (buffer, start, -length);
}
}
@@ -1452,13 +1423,9 @@ offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT length)
static INTERVAL
merge_interval_right (register INTERVAL i)
{
- register EMACS_INT absorb = LENGTH (i);
+ register ptrdiff_t absorb = LENGTH (i);
register INTERVAL successor;
- /* Zero out this interval. */
- i->total_length -= absorb;
- CHECK_TOTAL_LENGTH (i);
-
/* Find the succeeding interval. */
if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
as we descend. */
@@ -1467,16 +1434,20 @@ merge_interval_right (register INTERVAL i)
while (! NULL_LEFT_CHILD (successor))
{
successor->total_length += absorb;
- CHECK_TOTAL_LENGTH (successor);
+ eassert (0 <= TOTAL_LENGTH (successor));
successor = successor->left;
}
successor->total_length += absorb;
- CHECK_TOTAL_LENGTH (successor);
+ eassert (0 <= TOTAL_LENGTH (successor));
delete_interval (i);
return successor;
}
+ /* Zero out this interval. */
+ i->total_length -= absorb;
+ eassert (0 <= TOTAL_LENGTH (i));
+
successor = i;
while (! NULL_PARENT (successor)) /* It's above us. Subtract as
we ascend. */
@@ -1490,12 +1461,12 @@ merge_interval_right (register INTERVAL i)
successor = INTERVAL_PARENT (successor);
successor->total_length -= absorb;
- CHECK_TOTAL_LENGTH (successor);
+ eassert (0 <= TOTAL_LENGTH (successor));
}
/* This must be the rightmost or last interval and cannot
be merged right. The caller should have known. */
- abort ();
+ emacs_abort ();
}
/* Merge interval I with its lexicographic predecessor. The resulting
@@ -1508,13 +1479,9 @@ merge_interval_right (register INTERVAL i)
INTERVAL
merge_interval_left (register INTERVAL i)
{
- register EMACS_INT absorb = LENGTH (i);
+ register ptrdiff_t absorb = LENGTH (i);
register INTERVAL predecessor;
- /* Zero out this interval. */
- i->total_length -= absorb;
- CHECK_TOTAL_LENGTH (i);
-
/* Find the preceding interval. */
if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
adding ABSORB as we go. */
@@ -1523,19 +1490,23 @@ merge_interval_left (register INTERVAL i)
while (! NULL_RIGHT_CHILD (predecessor))
{
predecessor->total_length += absorb;
- CHECK_TOTAL_LENGTH (predecessor);
+ eassert (0 <= TOTAL_LENGTH (predecessor));
predecessor = predecessor->right;
}
predecessor->total_length += absorb;
- CHECK_TOTAL_LENGTH (predecessor);
+ eassert (0 <= TOTAL_LENGTH (predecessor));
delete_interval (i);
return predecessor;
}
+ /* Zero out this interval. */
+ i->total_length -= absorb;
+ eassert (0 <= TOTAL_LENGTH (i));
+
predecessor = i;
while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
- subtracting ABSORB. */
+ subtracting ABSORB. */
{
if (AM_RIGHT_CHILD (predecessor))
{
@@ -1546,93 +1517,54 @@ merge_interval_left (register INTERVAL i)
predecessor = INTERVAL_PARENT (predecessor);
predecessor->total_length -= absorb;
- CHECK_TOTAL_LENGTH (predecessor);
+ eassert (0 <= TOTAL_LENGTH (predecessor));
}
/* This must be the leftmost or first interval and cannot
be merged left. The caller should have known. */
- abort ();
+ emacs_abort ();
}
-/* Make an exact copy of interval tree SOURCE which descends from
- PARENT. This is done by recursing through SOURCE, copying
- the current interval and its properties, and then adjusting
- the pointers of the copy. */
+/* Create a copy of SOURCE but with the default value of UP. */
static INTERVAL
-reproduce_tree (INTERVAL source, INTERVAL parent)
+reproduce_interval (INTERVAL source)
{
- register INTERVAL t = make_interval ();
+ register INTERVAL target = make_interval ();
- memcpy (t, source, INTERVAL_SIZE);
- copy_properties (source, t);
- SET_INTERVAL_PARENT (t, parent);
- if (! NULL_LEFT_CHILD (source))
- t->left = reproduce_tree (source->left, t);
- if (! NULL_RIGHT_CHILD (source))
- t->right = reproduce_tree (source->right, t);
-
- return t;
-}
+ target->total_length = source->total_length;
+ target->position = source->position;
-static INTERVAL
-reproduce_tree_obj (INTERVAL source, Lisp_Object parent)
-{
- register INTERVAL t = make_interval ();
+ copy_properties (source, target);
- memcpy (t, source, INTERVAL_SIZE);
- copy_properties (source, t);
- SET_INTERVAL_OBJECT (t, parent);
if (! NULL_LEFT_CHILD (source))
- t->left = reproduce_tree (source->left, t);
+ set_interval_left (target, reproduce_tree (source->left, target));
if (! NULL_RIGHT_CHILD (source))
- t->right = reproduce_tree (source->right, t);
+ set_interval_right (target, reproduce_tree (source->right, target));
- return t;
+ return target;
}
-#if 0
-/* Nobody calls this. Perhaps it's a vestige of an earlier design. */
-
-/* Make a new interval of length LENGTH starting at START in the
- group of intervals INTERVALS, which is actually an interval tree.
- Returns the new interval.
-
- Generate an error if the new positions would overlap an existing
- interval. */
+/* Make an exact copy of interval tree SOURCE which descends from
+ PARENT. This is done by recursing through SOURCE, copying
+ the current interval and its properties, and then adjusting
+ the pointers of the copy. */
static INTERVAL
-make_new_interval (INTERVAL intervals, EMACS_INT start, EMACS_INT length)
+reproduce_tree (INTERVAL source, INTERVAL parent)
{
- INTERVAL slot;
-
- slot = find_interval (intervals, start);
- if (start + length > slot->position + LENGTH (slot))
- error ("Interval would overlap");
-
- if (start == slot->position && length == LENGTH (slot))
- return slot;
-
- if (slot->position == start)
- {
- /* New right node. */
- split_interval_right (slot, length);
- return slot;
- }
-
- if (slot->position + LENGTH (slot) == start + length)
- {
- /* New left node. */
- split_interval_left (slot, LENGTH (slot) - length);
- return slot;
- }
+ INTERVAL target = reproduce_interval (source);
+ set_interval_parent (target, parent);
+ return target;
+}
- /* Convert interval SLOT into three intervals. */
- split_interval_left (slot, start - slot->position);
- split_interval_right (slot, length);
- return slot;
+static INTERVAL
+reproduce_tree_obj (INTERVAL source, Lisp_Object parent)
+{
+ INTERVAL target = reproduce_interval (source);
+ set_interval_object (target, parent);
+ return target;
}
-#endif
/* Insert the intervals of SOURCE into BUFFER at POSITION.
LENGTH is the length of the text in SOURCE.
@@ -1657,11 +1589,9 @@ make_new_interval (INTERVAL intervals, EMACS_INT start, EMACS_INT length)
cases -- either insertion happened in the middle of some interval,
or between two intervals.
- If the text goes into the middle of an interval, then new
- intervals are created in the middle with only the properties of
- the new text, *unless* the macro MERGE_INSERTIONS is true, in
- which case the new text has the union of its properties and those
- of the text into which it was inserted.
+ If the text goes into the middle of an interval, then new intervals
+ are created in the middle, and new text has the union of its properties
+ and those of the text into which it was inserted.
If the text goes between two intervals, then if neither interval
had its appropriate sticky property set (front_sticky, rear_sticky),
@@ -1674,63 +1604,62 @@ make_new_interval (INTERVAL intervals, EMACS_INT start, EMACS_INT length)
text... */
void
-graft_intervals_into_buffer (INTERVAL source, EMACS_INT position,
- EMACS_INT length, struct buffer *buffer,
- int inherit)
+graft_intervals_into_buffer (INTERVAL source, ptrdiff_t position,
+ ptrdiff_t length, struct buffer *buffer,
+ bool inherit)
{
- register INTERVAL under, over, this;
- register INTERVAL tree;
- EMACS_INT over_used;
-
- tree = BUF_INTERVALS (buffer);
+ INTERVAL tree = buffer_intervals (buffer);
+ INTERVAL under, over, this;
+ ptrdiff_t over_used;
/* If the new text has no properties, then with inheritance it
becomes part of whatever interval it was inserted into.
To prevent inheritance, we must clear out the properties
of the newly inserted text. */
- if (NULL_INTERVAL_P (source))
+ if (!source)
{
Lisp_Object buf;
- if (!inherit && !NULL_INTERVAL_P (tree) && length > 0)
+ if (!inherit && tree && length > 0)
{
XSETBUFFER (buf, buffer);
set_text_properties_1 (make_number (position),
make_number (position + length),
Qnil, buf, 0);
}
- if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
- /* Shouldn't be necessary. --Stef */
- BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
+ /* Shouldn't be necessary. --Stef */
+ buffer_balance_intervals (buffer);
return;
}
eassert (length == TOTAL_LENGTH (source));
if ((BUF_Z (buffer) - BUF_BEG (buffer)) == length)
- { /* The inserted text constitutes the whole buffer, so
+ {
+ /* The inserted text constitutes the whole buffer, so
simply copy over the interval structure. */
- Lisp_Object buf;
- XSETBUFFER (buf, buffer);
- BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf);
- BUF_INTERVALS (buffer)->position = BUF_BEG (buffer);
- eassert (BUF_INTERVALS (buffer)->up_obj == 1);
- return;
- }
- else if (NULL_INTERVAL_P (tree))
- { /* Create an interval tree in which to place a copy
+ Lisp_Object buf;
+
+ XSETBUFFER (buf, buffer);
+ set_buffer_intervals (buffer, reproduce_tree_obj (source, buf));
+ buffer_intervals (buffer)->position = BUF_BEG (buffer);
+ eassert (buffer_intervals (buffer)->up_obj == 1);
+ return;
+ }
+ else if (!tree)
+ {
+ /* Create an interval tree in which to place a copy
of the intervals of the inserted string. */
Lisp_Object buf;
+
XSETBUFFER (buf, buffer);
tree = create_root_interval (buf);
- }
- /* Paranoia -- the text has already been added, so this buffer
- should be of non-zero length. */
- else if (TOTAL_LENGTH (tree) == 0)
- abort ();
+ }
+ /* Paranoia -- the text has already been added, so
+ this buffer should be of non-zero length. */
+ eassert (TOTAL_LENGTH (tree) > 0);
this = under = find_interval (tree, position);
- if (NULL_INTERVAL_P (under)) /* Paranoia. */
- abort ();
+ eassert (under);
over = find_interval (source, interval_start_pos (source));
/* Here for insertion in the middle of an interval.
@@ -1772,7 +1701,7 @@ graft_intervals_into_buffer (INTERVAL source, EMACS_INT position,
have already been copied into target intervals.
UNDER is the next interval in the target. */
over_used = 0;
- while (! NULL_INTERVAL_P (over))
+ while (over)
{
/* If UNDER is longer than OVER, split it. */
if (LENGTH (over) - over_used < LENGTH (under))
@@ -1805,9 +1734,7 @@ graft_intervals_into_buffer (INTERVAL source, EMACS_INT position,
under = next_interval (this);
}
- if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
- BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
- return;
+ buffer_balance_intervals (buffer);
}
/* Get the value of property PROP from PLIST,
@@ -1822,9 +1749,9 @@ textget (Lisp_Object plist, register Lisp_Object prop)
}
Lisp_Object
-lookup_char_property (Lisp_Object plist, register Lisp_Object prop, int textprop)
+lookup_char_property (Lisp_Object plist, Lisp_Object prop, bool textprop)
{
- register Lisp_Object tail, fallback = Qnil;
+ Lisp_Object tail, fallback = Qnil;
for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
{
@@ -1862,18 +1789,14 @@ lookup_char_property (Lisp_Object plist, register Lisp_Object prop, int textprop
void
temp_set_point_both (struct buffer *buffer,
- EMACS_INT charpos, EMACS_INT bytepos)
+ ptrdiff_t charpos, ptrdiff_t bytepos)
{
/* In a single-byte buffer, the two positions must be equal. */
- if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
- && charpos != bytepos)
- abort ();
-
- if (charpos > bytepos)
- abort ();
+ if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer))
+ eassert (charpos == bytepos);
- if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
- abort ();
+ eassert (charpos <= bytepos);
+ eassert (charpos <= BUF_ZV (buffer) || BUF_BEGV (buffer) <= charpos);
SET_BUF_PT_BOTH (buffer, charpos, bytepos);
}
@@ -1881,7 +1804,7 @@ temp_set_point_both (struct buffer *buffer,
/* Set point "temporarily", without checking any text properties. */
void
-temp_set_point (struct buffer *buffer, EMACS_INT charpos)
+temp_set_point (struct buffer *buffer, ptrdiff_t charpos)
{
temp_set_point_both (buffer, charpos,
buf_charpos_to_bytepos (buffer, charpos));
@@ -1891,7 +1814,7 @@ temp_set_point (struct buffer *buffer, EMACS_INT charpos)
before an intangible character, move to an ok place. */
void
-set_point (EMACS_INT charpos)
+set_point (ptrdiff_t charpos)
{
set_point_both (charpos, buf_charpos_to_bytepos (current_buffer, charpos));
}
@@ -1899,17 +1822,17 @@ set_point (EMACS_INT charpos)
/* If there's an invisible character at position POS + TEST_OFFS in the
current buffer, and the invisible property has a `stickiness' such that
inserting a character at position POS would inherit the property it,
- return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
- then intangibility is required as well as invisibility.
+ return POS + ADJ, otherwise return POS. If TEST_INTANG, intangibility
+ is required as well as invisibility.
TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
Note that `stickiness' is determined by overlay marker insertion types,
if the invisible property comes from an overlay. */
-static EMACS_INT
-adjust_for_invis_intang (EMACS_INT pos, EMACS_INT test_offs, EMACS_INT adj,
- int test_intang)
+static ptrdiff_t
+adjust_for_invis_intang (ptrdiff_t pos, ptrdiff_t test_offs, ptrdiff_t adj,
+ bool test_intang)
{
Lisp_Object invis_propval, invis_overlay;
Lisp_Object test_pos;
@@ -1947,20 +1870,20 @@ adjust_for_invis_intang (EMACS_INT pos, EMACS_INT test_offs, EMACS_INT adj,
before an intangible character, move to an ok place. */
void
-set_point_both (EMACS_INT charpos, EMACS_INT bytepos)
+set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos)
{
register INTERVAL to, from, toprev, fromprev;
- EMACS_INT buffer_point;
- EMACS_INT old_position = PT;
+ ptrdiff_t buffer_point;
+ ptrdiff_t old_position = PT;
/* This ensures that we move forward past intangible text when the
initial position is the same as the destination, in the rare
instances where this is important, e.g. in line-move-finish
(simple.el). */
- int backwards = (charpos < old_position ? 1 : 0);
- int have_overlays;
- EMACS_INT original_position;
+ bool backwards = charpos < old_position;
+ bool have_overlays;
+ ptrdiff_t original_position;
- BVAR (current_buffer, point_before_scroll) = Qnil;
+ bset_point_before_scroll (current_buffer, Qnil);
if (charpos == PT)
return;
@@ -1973,12 +1896,11 @@ set_point_both (EMACS_INT charpos, EMACS_INT bytepos)
whether or not there are intervals in the buffer. */
eassert (charpos <= ZV && charpos >= BEGV);
- have_overlays = (current_buffer->overlays_before
- || current_buffer->overlays_after);
+ have_overlays = buffer_has_overlays ();
/* If we have no text properties and overlays,
then we can do it quickly. */
- if (NULL_INTERVAL_P (BUF_INTERVALS (current_buffer)) && ! have_overlays)
+ if (!buffer_intervals (current_buffer) && ! have_overlays)
{
temp_set_point_both (current_buffer, charpos, bytepos);
return;
@@ -1987,7 +1909,7 @@ set_point_both (EMACS_INT charpos, EMACS_INT bytepos)
/* Set TO to the interval containing the char after CHARPOS,
and TOPREV to the interval containing the char before CHARPOS.
Either one may be null. They may be equal. */
- to = find_interval (BUF_INTERVALS (current_buffer), charpos);
+ to = find_interval (buffer_intervals (current_buffer), charpos);
if (charpos == BEGV)
toprev = 0;
else if (to && to->position == charpos)
@@ -2001,7 +1923,7 @@ set_point_both (EMACS_INT charpos, EMACS_INT bytepos)
and FROMPREV to the interval containing the char before PT.
Either one may be null. They may be equal. */
/* We could cache this and save time. */
- from = find_interval (BUF_INTERVALS (current_buffer), buffer_point);
+ from = find_interval (buffer_intervals (current_buffer), buffer_point);
if (buffer_point == BEGV)
fromprev = 0;
else if (from && from->position == PT)
@@ -2025,7 +1947,7 @@ set_point_both (EMACS_INT charpos, EMACS_INT bytepos)
with the same intangible property value,
move forward or backward until a change in that property. */
if (NILP (Vinhibit_point_motion_hooks)
- && ((! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev))
+ && ((to && toprev)
|| have_overlays)
/* Intangibility never stops us from positioning at the beginning
or end of the buffer, so don't bother checking in that case. */
@@ -2107,7 +2029,7 @@ set_point_both (EMACS_INT charpos, EMACS_INT bytepos)
/* Set TO to the interval containing the char after CHARPOS,
and TOPREV to the interval containing the char before CHARPOS.
Either one may be null. They may be equal. */
- to = find_interval (BUF_INTERVALS (current_buffer), charpos);
+ to = find_interval (buffer_intervals (current_buffer), charpos);
if (charpos == BEGV)
toprev = 0;
else if (to && to->position == charpos)
@@ -2171,7 +2093,7 @@ set_point_both (EMACS_INT charpos, EMACS_INT bytepos)
segment that reaches all the way to point. */
void
-move_if_not_intangible (EMACS_INT position)
+move_if_not_intangible (ptrdiff_t position)
{
Lisp_Object pos;
Lisp_Object intangible_propval;
@@ -2228,27 +2150,27 @@ move_if_not_intangible (EMACS_INT position)
/* If text at position POS has property PROP, set *VAL to the property
value, *START and *END to the beginning and end of a region that
- has the same property, and return 1. Otherwise return 0.
+ has the same property, and return true. Otherwise return false.
OBJECT is the string or buffer to look for the property in;
nil means the current buffer. */
-int
-get_property_and_range (EMACS_INT pos, Lisp_Object prop, Lisp_Object *val,
- EMACS_INT *start, EMACS_INT *end, Lisp_Object object)
+bool
+get_property_and_range (ptrdiff_t pos, Lisp_Object prop, Lisp_Object *val,
+ ptrdiff_t *start, ptrdiff_t *end, Lisp_Object object)
{
INTERVAL i, prev, next;
if (NILP (object))
- i = find_interval (BUF_INTERVALS (current_buffer), pos);
+ i = find_interval (buffer_intervals (current_buffer), pos);
else if (BUFFERP (object))
- i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
+ i = find_interval (buffer_intervals (XBUFFER (object)), pos);
else if (STRINGP (object))
- i = find_interval (STRING_INTERVALS (object), pos);
+ i = find_interval (string_intervals (object), pos);
else
- abort ();
+ emacs_abort ();
- if (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos))
+ if (!i || (i->position + LENGTH (i) <= pos))
return 0;
*val = textget (i->plist, prop);
if (NILP (*val))
@@ -2256,14 +2178,13 @@ get_property_and_range (EMACS_INT pos, Lisp_Object prop, Lisp_Object *val,
next = i; /* remember it in advance */
prev = previous_interval (i);
- while (! NULL_INTERVAL_P (prev)
+ while (prev
&& EQ (*val, textget (prev->plist, prop)))
i = prev, prev = previous_interval (prev);
*start = i->position;
next = next_interval (i);
- while (! NULL_INTERVAL_P (next)
- && EQ (*val, textget (next->plist, prop)))
+ while (next && EQ (*val, textget (next->plist, prop)))
i = next, next = next_interval (next);
*end = i->position + LENGTH (i);
@@ -2278,15 +2199,15 @@ get_property_and_range (EMACS_INT pos, Lisp_Object prop, Lisp_Object *val,
POSITION must be in the accessible part of BUFFER. */
Lisp_Object
-get_local_map (register EMACS_INT position, register struct buffer *buffer,
+get_local_map (register ptrdiff_t position, register struct buffer *buffer,
Lisp_Object type)
{
Lisp_Object prop, lispy_position, lispy_buffer;
- EMACS_INT old_begv, old_zv, old_begv_byte, old_zv_byte;
+ ptrdiff_t old_begv, old_zv, old_begv_byte, old_zv_byte;
/* Perhaps we should just change `position' to the limit. */
if (position > BUF_ZV (buffer) || position < BUF_BEGV (buffer))
- abort ();
+ emacs_abort ();
/* Ignore narrowing, so that a local map continues to be valid even if
the visible region contains no characters and hence no properties. */
@@ -2329,28 +2250,27 @@ get_local_map (register EMACS_INT position, register struct buffer *buffer,
The new interval tree has no parent and has a starting-position of 0. */
INTERVAL
-copy_intervals (INTERVAL tree, EMACS_INT start, EMACS_INT length)
+copy_intervals (INTERVAL tree, ptrdiff_t start, ptrdiff_t length)
{
register INTERVAL i, new, t;
- register EMACS_INT got, prevlen;
+ register ptrdiff_t got, prevlen;
- if (NULL_INTERVAL_P (tree) || length <= 0)
- return NULL_INTERVAL;
+ if (!tree || length <= 0)
+ return NULL;
i = find_interval (tree, start);
- if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
- abort ();
+ eassert (i && LENGTH (i) > 0);
/* If there is only one interval and it's the default, return nil. */
if ((start - i->position + 1 + length) < LENGTH (i)
&& DEFAULT_INTERVAL_P (i))
- return NULL_INTERVAL;
+ return NULL;
new = make_interval ();
new->position = 0;
got = (LENGTH (i) - (start - i->position));
new->total_length = length;
- CHECK_TOTAL_LENGTH (new);
+ eassert (0 <= TOTAL_LENGTH (new));
copy_properties (i, new);
t = new;
@@ -2371,36 +2291,36 @@ copy_intervals (INTERVAL tree, EMACS_INT start, EMACS_INT length)
void
copy_intervals_to_string (Lisp_Object string, struct buffer *buffer,
- EMACS_INT position, EMACS_INT length)
+ ptrdiff_t position, ptrdiff_t length)
{
- INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
+ INTERVAL interval_copy = copy_intervals (buffer_intervals (buffer),
position, length);
- if (NULL_INTERVAL_P (interval_copy))
+ if (!interval_copy)
return;
- SET_INTERVAL_OBJECT (interval_copy, string);
- STRING_SET_INTERVALS (string, interval_copy);
+ set_interval_object (interval_copy, string);
+ set_string_intervals (string, interval_copy);
}
-/* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
+/* Return true if strings S1 and S2 have identical properties.
Assume they have identical characters. */
-int
+bool
compare_string_intervals (Lisp_Object s1, Lisp_Object s2)
{
INTERVAL i1, i2;
- EMACS_INT pos = 0;
- EMACS_INT end = SCHARS (s1);
+ ptrdiff_t pos = 0;
+ ptrdiff_t end = SCHARS (s1);
- i1 = find_interval (STRING_INTERVALS (s1), 0);
- i2 = find_interval (STRING_INTERVALS (s2), 0);
+ i1 = find_interval (string_intervals (s1), 0);
+ i2 = find_interval (string_intervals (s2), 0);
while (pos < end)
{
/* Determine how far we can go before we reach the end of I1 or I2. */
- EMACS_INT len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
- EMACS_INT len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
- EMACS_INT distance = min (len1, len2);
+ ptrdiff_t len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
+ ptrdiff_t len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
+ ptrdiff_t distance = min (len1, len2);
/* If we ever find a mismatch between the strings,
they differ. */
@@ -2424,16 +2344,16 @@ compare_string_intervals (Lisp_Object s1, Lisp_Object s2)
START_BYTE ... END_BYTE in bytes. */
static void
-set_intervals_multibyte_1 (INTERVAL i, int multi_flag,
- EMACS_INT start, EMACS_INT start_byte,
- EMACS_INT end, EMACS_INT end_byte)
+set_intervals_multibyte_1 (INTERVAL i, bool multi_flag,
+ ptrdiff_t start, ptrdiff_t start_byte,
+ ptrdiff_t end, ptrdiff_t end_byte)
{
/* Fix the length of this interval. */
if (multi_flag)
i->total_length = end - start;
else
i->total_length = end_byte - start_byte;
- CHECK_TOTAL_LENGTH (i);
+ eassert (0 <= TOTAL_LENGTH (i));
if (TOTAL_LENGTH (i) == 0)
{
@@ -2444,11 +2364,11 @@ set_intervals_multibyte_1 (INTERVAL i, int multi_flag,
/* Recursively fix the length of the subintervals. */
if (i->left)
{
- EMACS_INT left_end, left_end_byte;
+ ptrdiff_t left_end, left_end_byte;
if (multi_flag)
{
- EMACS_INT temp;
+ ptrdiff_t temp;
left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
left_end = BYTE_TO_CHAR (left_end_byte);
@@ -2477,11 +2397,11 @@ set_intervals_multibyte_1 (INTERVAL i, int multi_flag,
}
if (i->right)
{
- EMACS_INT right_start_byte, right_start;
+ ptrdiff_t right_start_byte, right_start;
if (multi_flag)
{
- EMACS_INT temp;
+ ptrdiff_t temp;
right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
right_start = BYTE_TO_CHAR (right_start_byte);
@@ -2518,13 +2438,13 @@ set_intervals_multibyte_1 (INTERVAL i, int multi_flag,
{
if ((i)->left)
{
- (i)->plist = (i)->left->plist;
+ set_interval_plist (i, i->left->plist);
(i)->left->total_length = 0;
delete_interval ((i)->left);
}
else
{
- (i)->plist = (i)->right->plist;
+ set_interval_plist (i, i->right->plist);
(i)->right->total_length = 0;
delete_interval ((i)->right);
}
@@ -2532,13 +2452,14 @@ set_intervals_multibyte_1 (INTERVAL i, int multi_flag,
}
/* Update the intervals of the current buffer
- to fit the contents as multibyte (if MULTI_FLAG is 1)
- or to fit them as non-multibyte (if MULTI_FLAG is 0). */
+ to fit the contents as multibyte (if MULTI_FLAG)
+ or to fit them as non-multibyte (if not MULTI_FLAG). */
void
-set_intervals_multibyte (int multi_flag)
+set_intervals_multibyte (bool multi_flag)
{
- if (BUF_INTERVALS (current_buffer))
- set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag,
- BEG, BEG_BYTE, Z, Z_BYTE);
+ INTERVAL i = buffer_intervals (current_buffer);
+
+ if (i)
+ set_intervals_multibyte_1 (i, multi_flag, BEG, BEG_BYTE, Z, Z_BYTE);
}
diff --git a/src/intervals.h b/src/intervals.h
index 977f3d965a4..2b30101d0fa 100644
--- a/src/intervals.h
+++ b/src/intervals.h
@@ -1,5 +1,5 @@
/* Definitions and global variables for intervals.
- Copyright (C) 1993-1994, 2000-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -18,8 +18,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dispextern.h"
-#define NULL_INTERVAL ((INTERVAL)0)
-#define INTERVAL_DEFAULT NULL_INTERVAL
+INLINE_HEADER_BEGIN
+#ifndef INTERVALS_INLINE
+# define INTERVALS_INLINE INLINE
+#endif
/* Basic data type for use of intervals. */
@@ -27,8 +29,8 @@ struct interval
{
/* The first group of entries deal with the tree structure. */
- EMACS_INT total_length; /* Length of myself and both children. */
- EMACS_INT position; /* Cache of interval's character position. */
+ ptrdiff_t total_length; /* Length of myself and both children. */
+ ptrdiff_t position; /* Cache of interval's character position. */
/* This field is usually updated
simultaneously with an interval
traversal, there is no guarantee
@@ -56,44 +58,30 @@ struct interval
unsigned int front_sticky : 1; /* Non-zero means text inserted just
before this interval goes into it. */
unsigned int rear_sticky : 1; /* Likewise for just after it. */
-
- /* Properties of this interval.
- The mark bit on this field says whether this particular interval
- tree node has been visited. Since intervals should never be
- shared, GC aborts if it seems to have visited an interval twice. */
- Lisp_Object plist;
+ Lisp_Object plist; /* Other properties. */
};
/* These are macros for dealing with the interval tree. */
-/* Size of the structure used to represent an interval. */
-#define INTERVAL_SIZE (sizeof (struct interval))
-
-/* Size of a pointer to an interval structure. */
-#define INTERVAL_PTR_SIZE (sizeof (struct interval *))
-
-#define NULL_INTERVAL_P(i) ((i) == NULL_INTERVAL)
-
/* True if this interval has no right child. */
-#define NULL_RIGHT_CHILD(i) ((i)->right == NULL_INTERVAL)
+#define NULL_RIGHT_CHILD(i) ((i)->right == NULL)
/* True if this interval has no left child. */
-#define NULL_LEFT_CHILD(i) ((i)->left == NULL_INTERVAL)
+#define NULL_LEFT_CHILD(i) ((i)->left == NULL)
/* True if this interval has no parent. */
#define NULL_PARENT(i) ((i)->up_obj || (i)->up.interval == 0)
/* True if this interval is the left child of some other interval. */
-#define AM_LEFT_CHILD(i) (! NULL_PARENT (i) \
- && INTERVAL_PARENT (i)->left == (i))
+#define AM_LEFT_CHILD(i) \
+ (! NULL_PARENT (i) && INTERVAL_PARENT (i)->left == (i))
/* True if this interval is the right child of some other interval. */
-#define AM_RIGHT_CHILD(i) (! NULL_PARENT (i) \
- && INTERVAL_PARENT (i)->right == (i))
+#define AM_RIGHT_CHILD(i) \
+ (! NULL_PARENT (i) && INTERVAL_PARENT (i)->right == (i))
/* True if this interval has no children. */
-#define LEAF_INTERVAL_P(i) ((i)->left == NULL_INTERVAL \
- && (i)->right == NULL_INTERVAL)
+#define LEAF_INTERVAL_P(i) ((i)->left == NULL && (i)->right == NULL)
/* True if this interval has no parent and is therefore the root. */
#define ROOT_INTERVAL_P(i) (NULL_PARENT (i))
@@ -102,17 +90,16 @@ struct interval
#define ONLY_INTERVAL_P(i) (ROOT_INTERVAL_P ((i)) && LEAF_INTERVAL_P ((i)))
/* True if this interval has both left and right children. */
-#define BOTH_KIDS_P(i) ((i)->left != NULL_INTERVAL \
- && (i)->right != NULL_INTERVAL)
+#define BOTH_KIDS_P(i) ((i)->left != NULL && (i)->right != NULL)
/* The total size of all text represented by this interval and all its
children in the tree. This is zero if the interval is null. */
-#define TOTAL_LENGTH(i) ((i) == NULL_INTERVAL ? 0 : (i)->total_length)
+#define TOTAL_LENGTH(i) ((i) == NULL ? 0 : (i)->total_length)
/* The size of text represented by this interval alone. */
-#define LENGTH(i) ((i) == NULL_INTERVAL ? 0 : (TOTAL_LENGTH ((i)) \
- - TOTAL_LENGTH ((i)->right) \
- - TOTAL_LENGTH ((i)->left)))
+#define LENGTH(i) ((i) == NULL ? 0 : (TOTAL_LENGTH ((i)) \
+ - TOTAL_LENGTH ((i)->right) \
+ - TOTAL_LENGTH ((i)->left)))
/* The position of the character just past the end of I. Note that
the position cache i->position must be valid for this to work. */
@@ -124,125 +111,112 @@ struct interval
/* The total size of the right subtree of this interval. */
#define RIGHT_TOTAL_LENGTH(i) ((i)->right ? (i)->right->total_length : 0)
-
/* These macros are for dealing with the interval properties. */
/* True if this is a default interval, which is the same as being null
or having no properties. */
-#define DEFAULT_INTERVAL_P(i) (NULL_INTERVAL_P (i) || EQ ((i)->plist, Qnil))
+#define DEFAULT_INTERVAL_P(i) (!i || EQ ((i)->plist, Qnil))
/* Test what type of parent we have. Three possibilities: another
- interval, a buffer or string object, or NULL_INTERVAL. */
+ interval, a buffer or string object, or NULL. */
#define INTERVAL_HAS_PARENT(i) ((i)->up_obj == 0 && (i)->up.interval != 0)
#define INTERVAL_HAS_OBJECT(i) ((i)->up_obj)
-/* Set/get parent of an interval.
+/* Use these macros to get parent of an interval.
The choice of macros is dependent on the type needed. Don't add
casts to get around this, it will break some development work in
progress. */
-#define SET_INTERVAL_PARENT(i,p) \
- ((i)->up_obj = 0, (i)->up.interval = (p))
-#define SET_INTERVAL_OBJECT(i,o) \
- (eassert (BUFFERP (o) || STRINGP (o)), (i)->up_obj = 1, (i)->up.obj = (o))
-#define INTERVAL_PARENT(i) \
- (eassert ((i) != 0 && (i)->up_obj == 0),(i)->up.interval)
-#define GET_INTERVAL_OBJECT(d,s) (eassert((s)->up_obj == 1), (d) = (s)->up.obj)
-
-/* Make the parent of D be whatever the parent of S is, regardless of
- type. This is used when balancing an interval tree. */
-#define COPY_INTERVAL_PARENT(d,s) \
- ((d)->up = (s)->up, (d)->up_obj = (s)->up_obj)
+
+#define INTERVAL_PARENT(i) \
+ (eassert ((i) != 0 && (i)->up_obj == 0), (i)->up.interval)
+
+#define GET_INTERVAL_OBJECT(d,s) (eassert ((s)->up_obj == 1), (d) = (s)->up.obj)
+
+/* Use these functions to set Lisp_Object
+ or pointer slots of struct interval. */
+
+INTERVALS_INLINE void
+set_interval_parent (INTERVAL i, INTERVAL parent)
+{
+ i->up_obj = 0;
+ i->up.interval = parent;
+}
+
+INTERVALS_INLINE void
+set_interval_plist (INTERVAL i, Lisp_Object plist)
+{
+ i->plist = plist;
+}
/* Get the parent interval, if any, otherwise a null pointer. Useful
for walking up to the root in a "for" loop; use this to get the
- "next" value, and test the result to see if it's NULL_INTERVAL. */
+ "next" value, and test the result to see if it's NULL. */
#define INTERVAL_PARENT_OR_NULL(i) \
(INTERVAL_HAS_PARENT (i) ? INTERVAL_PARENT (i) : 0)
-/* Abort if interval I's size is negative. */
-#define CHECK_TOTAL_LENGTH(i) \
- do \
- { \
- if ((i)->total_length < 0) \
- abort (); \
- } \
- while (0)
-
/* Reset this interval to its vanilla, or no-property state. */
-#define RESET_INTERVAL(i) \
-{ \
- (i)->total_length = (i)->position = 0; \
- (i)->left = (i)->right = NULL_INTERVAL; \
- SET_INTERVAL_PARENT (i, NULL_INTERVAL); \
- (i)->write_protect = 0; \
- (i)->visible = 0; \
- (i)->front_sticky = (i)->rear_sticky = 0; \
- (i)->plist = Qnil; \
+#define RESET_INTERVAL(i) \
+{ \
+ (i)->total_length = (i)->position = 0; \
+ (i)->left = (i)->right = NULL; \
+ set_interval_parent (i, NULL); \
+ (i)->write_protect = 0; \
+ (i)->visible = 0; \
+ (i)->front_sticky = (i)->rear_sticky = 0; \
+ set_interval_plist (i, Qnil); \
}
/* Copy the cached property values of interval FROM to interval TO. */
-#define COPY_INTERVAL_CACHE(from,to) \
-{ \
- (to)->write_protect = (from)->write_protect; \
- (to)->visible = (from)->visible; \
- (to)->front_sticky = (from)->front_sticky; \
- (to)->rear_sticky = (from)->rear_sticky; \
+#define COPY_INTERVAL_CACHE(from,to) \
+{ \
+ (to)->write_protect = (from)->write_protect; \
+ (to)->visible = (from)->visible; \
+ (to)->front_sticky = (from)->front_sticky; \
+ (to)->rear_sticky = (from)->rear_sticky; \
}
/* Copy only the set bits of FROM's cache. */
-#define MERGE_INTERVAL_CACHE(from,to) \
-{ \
+#define MERGE_INTERVAL_CACHE(from,to) \
+{ \
if ((from)->write_protect) (to)->write_protect = 1; \
- if ((from)->visible) (to)->visible = 1; \
+ if ((from)->visible) (to)->visible = 1; \
if ((from)->front_sticky) (to)->front_sticky = 1; \
if ((from)->rear_sticky) (to)->rear_sticky = 1; \
}
-/* Macro determining whether the properties of an interval being
- inserted should be merged with the properties of the text where
- they are being inserted. */
-#define MERGE_INSERTIONS(i) 1
-
-/* Macro determining if an invisible interval should be displayed
- as a special glyph, or not at all. */
-#define DISPLAY_INVISIBLE_GLYPH(i) 0
-
/* Is this interval visible? Replace later with cache access. */
#define INTERVAL_VISIBLE_P(i) \
- (! NULL_INTERVAL_P (i) && NILP (textget ((i)->plist, Qinvisible)))
+ (i && NILP (textget ((i)->plist, Qinvisible)))
/* Is this interval writable? Replace later with cache access. */
#define INTERVAL_WRITABLE_P(i) \
- (! NULL_INTERVAL_P (i) \
- && (NILP (textget ((i)->plist, Qread_only)) \
- || ((CONSP (Vinhibit_read_only) \
- ? !NILP (Fmemq (textget ((i)->plist, Qread_only), \
- Vinhibit_read_only)) \
- : !NILP (Vinhibit_read_only))))) \
+ (i && (NILP (textget ((i)->plist, Qread_only)) \
+ || ((CONSP (Vinhibit_read_only) \
+ ? !NILP (Fmemq (textget ((i)->plist, Qread_only), \
+ Vinhibit_read_only)) \
+ : !NILP (Vinhibit_read_only))))) \
/* Macros to tell whether insertions before or after this interval
- should stick to it. */
-/* Replace later with cache access */
-/*#define FRONT_STICKY_P(i) ((i)->front_sticky != 0)
- #define END_STICKY_P(i) ((i)->rear_sticky != 0)*/
-/* As we now have Vtext_property_default_nonsticky, these macros are
- unreliable now. Currently, they are never used. */
-#define FRONT_STICKY_P(i) \
- (! NULL_INTERVAL_P (i) && ! NILP (textget ((i)->plist, Qfront_sticky)))
-#define END_NONSTICKY_P(i) \
- (! NULL_INTERVAL_P (i) && ! NILP (textget ((i)->plist, Qrear_nonsticky)))
-#define FRONT_NONSTICKY_P(i) \
- (! NULL_INTERVAL_P (i) && ! EQ (Qt, textget ((i)->plist, Qfront_sticky)))
-
+ should stick to it. Now we have Vtext_property_default_nonsticky,
+ so these macros are unreliable now and never used. */
+
+#if 0
+#define FRONT_STICKY_P(i) \
+ (i && ! NILP (textget ((i)->plist, Qfront_sticky)))
+#define END_NONSTICKY_P(i) \
+ (i && ! NILP (textget ((i)->plist, Qrear_nonsticky)))
+#define FRONT_NONSTICKY_P(i) \
+ (i && ! EQ (Qt, textget ((i)->plist, Qfront_sticky)))
+#endif
/* If PROP is the `invisible' property of a character,
this is 1 if the character should be treated as invisible,
and 2 if it is invisible but with an ellipsis. */
-#define TEXT_PROP_MEANS_INVISIBLE(prop) \
+#define TEXT_PROP_MEANS_INVISIBLE(prop) \
(EQ (BVAR (current_buffer, invisibility_spec), Qt) \
- ? !NILP (prop) \
+ ? !NILP (prop) \
: invisible_p (prop, BVAR (current_buffer, invisibility_spec)))
/* Declared in alloc.c. */
@@ -253,40 +227,40 @@ extern INTERVAL make_interval (void);
extern INTERVAL create_root_interval (Lisp_Object);
extern void copy_properties (INTERVAL, INTERVAL);
-extern int intervals_equal (INTERVAL, INTERVAL);
-extern void traverse_intervals (INTERVAL, EMACS_INT,
+extern bool intervals_equal (INTERVAL, INTERVAL);
+extern void traverse_intervals (INTERVAL, ptrdiff_t,
void (*) (INTERVAL, Lisp_Object),
Lisp_Object);
extern void traverse_intervals_noorder (INTERVAL,
void (*) (INTERVAL, Lisp_Object),
Lisp_Object);
-extern INTERVAL split_interval_right (INTERVAL, EMACS_INT);
-extern INTERVAL split_interval_left (INTERVAL, EMACS_INT);
-extern INTERVAL find_interval (INTERVAL, EMACS_INT);
+extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t);
+extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t);
+extern INTERVAL find_interval (INTERVAL, ptrdiff_t);
extern INTERVAL next_interval (INTERVAL);
extern INTERVAL previous_interval (INTERVAL);
extern INTERVAL merge_interval_left (INTERVAL);
-extern void offset_intervals (struct buffer *, EMACS_INT, EMACS_INT);
-extern void graft_intervals_into_buffer (INTERVAL, EMACS_INT, EMACS_INT,
- struct buffer *, int);
+extern void offset_intervals (struct buffer *, ptrdiff_t, ptrdiff_t);
+extern void graft_intervals_into_buffer (INTERVAL, ptrdiff_t, ptrdiff_t,
+ struct buffer *, bool);
extern void verify_interval_modification (struct buffer *,
- EMACS_INT, EMACS_INT);
+ ptrdiff_t, ptrdiff_t);
extern INTERVAL balance_intervals (INTERVAL);
extern void copy_intervals_to_string (Lisp_Object, struct buffer *,
- EMACS_INT, EMACS_INT);
-extern INTERVAL copy_intervals (INTERVAL, EMACS_INT, EMACS_INT);
-extern int compare_string_intervals (Lisp_Object, Lisp_Object);
+ ptrdiff_t, ptrdiff_t);
+extern INTERVAL copy_intervals (INTERVAL, ptrdiff_t, ptrdiff_t);
+extern bool compare_string_intervals (Lisp_Object, Lisp_Object);
extern Lisp_Object textget (Lisp_Object, Lisp_Object);
-extern Lisp_Object lookup_char_property (Lisp_Object, Lisp_Object, int);
-extern void move_if_not_intangible (EMACS_INT);
-extern int get_property_and_range (EMACS_INT, Lisp_Object, Lisp_Object *,
- EMACS_INT *, EMACS_INT *, Lisp_Object);
-extern Lisp_Object get_local_map (EMACS_INT, struct buffer *, Lisp_Object);
-extern INTERVAL update_interval (INTERVAL, EMACS_INT);
-extern void set_intervals_multibyte (int);
+extern Lisp_Object lookup_char_property (Lisp_Object, Lisp_Object, bool);
+extern void move_if_not_intangible (ptrdiff_t);
+extern bool get_property_and_range (ptrdiff_t, Lisp_Object, Lisp_Object *,
+ ptrdiff_t *, ptrdiff_t *, Lisp_Object);
+extern Lisp_Object get_local_map (ptrdiff_t, struct buffer *, Lisp_Object);
+extern INTERVAL update_interval (INTERVAL, ptrdiff_t);
+extern void set_intervals_multibyte (bool);
extern INTERVAL validate_interval_range (Lisp_Object, Lisp_Object *,
Lisp_Object *, int);
-extern INTERVAL interval_of (EMACS_INT, Lisp_Object);
+extern INTERVAL interval_of (ptrdiff_t, Lisp_Object);
/* Defined in xdisp.c. */
extern int invisible_p (Lisp_Object, Lisp_Object);
@@ -308,16 +282,6 @@ extern Lisp_Object Qinvisible, Qintangible;
/* Sticky properties. */
extern Lisp_Object Qfront_sticky, Qrear_nonsticky;
-EXFUN (Fget_char_property, 3);
-EXFUN (Fget_text_property, 3);
-EXFUN (Ftext_properties_at, 2);
-EXFUN (Fnext_property_change, 3);
-EXFUN (Fadd_text_properties, 4);
-EXFUN (Fset_text_properties, 4);
-EXFUN (Fremove_text_properties, 4);
-EXFUN (Fremove_list_of_text_properties, 4);
-EXFUN (Ftext_property_any, 5);
-EXFUN (Fprevious_single_char_property_change, 4);
extern Lisp_Object copy_text_properties (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
@@ -341,3 +305,5 @@ extern Lisp_Object get_pos_property (Lisp_Object pos, Lisp_Object prop,
extern void syms_of_textprop (void);
#include "composite.h"
+
+INLINE_HEADER_END
diff --git a/src/keyboard.c b/src/keyboard.c
index 2df1ba742ba..0ad6d18c044 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1,6 +1,6 @@
/* Keyboard and mouse input; editor command loop.
-Copyright (C) 1985-1989, 1993-1997, 1999-2011 Free Software Foundation, Inc.
+Copyright (C) 1985-1989, 1993-1997, 1999-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -18,9 +18,12 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <signal.h>
+
+#define BLOCKINPUT_INLINE EXTERN_INLINE
+#define KEYBOARD_INLINE EXTERN_INLINE
+
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "termchar.h"
#include "termopts.h"
@@ -30,8 +33,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "keyboard.h"
#include "window.h"
#include "commands.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "disptab.h"
#include "dispextern.h"
#include "syntax.h"
@@ -54,42 +57,28 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/ioctl.h>
#endif /* not MSDOS */
+#if defined USABLE_FIONREAD && defined USG5_4
+# include <sys/filio.h>
+#endif
+
#include "syssignal.h"
#include <sys/types.h>
#include <unistd.h>
#include <fcntl.h>
-/* This is to get the definitions of the XK_ symbols. */
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#endif
-
-#ifdef HAVE_NTGUI
-#include "w32term.h"
-#endif /* HAVE_NTGUI */
-
-#ifdef HAVE_NS
-#include "nsterm.h"
-#endif
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
-/* Variables for blockinput.h: */
+/* Variables for blockinput.h: */
-/* Non-zero if interrupt input is blocked right now. */
+/* Positive if interrupt input is blocked right now. */
volatile int interrupt_input_blocked;
-/* Nonzero means an input interrupt has arrived
- during the current critical section. */
-int interrupt_input_pending;
-
-/* This var should be (interrupt_input_pending || pending_atimers).
- The QUIT macro checks this instead of interrupt_input_pending and
- pending_atimers separately, to reduce code size. So, any code that
- changes interrupt_input_pending or pending_atimers should update
- this too. */
-#ifdef SYNC_INPUT
-int pending_signals;
-#endif
+/* True means an input interrupt or alarm signal has arrived.
+ The QUIT macro checks this. */
+volatile bool pending_signals;
#define KBD_BUFFER_SIZE 4096
@@ -97,8 +86,8 @@ KBOARD *initial_kboard;
KBOARD *current_kboard;
KBOARD *all_kboards;
-/* Nonzero in the single-kboard state, 0 in the any-kboard state. */
-static int single_kboard;
+/* True in the single-kboard state, false in the any-kboard state. */
+static bool single_kboard;
/* Non-nil disable property on a command means
do not execute it; call disabled-command-function's value instead. */
@@ -122,11 +111,11 @@ static Lisp_Object recent_keys;
actually mean something.
It's easier to staticpro a single Lisp_Object than an array. */
Lisp_Object this_command_keys;
-int this_command_key_count;
+ptrdiff_t this_command_key_count;
-/* 1 after calling Freset_this_command_lengths.
- Usually it is 0. */
-static int this_command_key_count_reset;
+/* True after calling Freset_this_command_lengths.
+ Usually it is false. */
+static bool this_command_key_count_reset;
/* This vector is used as a buffer to record the events that were actually read
by read_key_sequence. */
@@ -135,27 +124,27 @@ static int raw_keybuf_count;
#define GROW_RAW_KEYBUF \
if (raw_keybuf_count == ASIZE (raw_keybuf)) \
- raw_keybuf = larger_vector (raw_keybuf, raw_keybuf_count * 2, Qnil) \
+ raw_keybuf = larger_vector (raw_keybuf, 1, -1)
/* Number of elements of this_command_keys
that precede this key sequence. */
-static int this_single_command_key_start;
+static ptrdiff_t this_single_command_key_start;
/* Record values of this_command_key_count and echo_length ()
before this command was read. */
-static int before_command_key_count;
-static int before_command_echo_length;
+static ptrdiff_t before_command_key_count;
+static ptrdiff_t before_command_echo_length;
/* For longjmp to where kbd input is being done. */
-static jmp_buf getcjmp;
+static sys_jmp_buf getcjmp;
/* True while doing kbd input. */
-int waiting_for_input;
+bool waiting_for_input;
/* True while displaying for echoing. Delays C-g throwing. */
-static int echoing;
+static bool echoing;
/* Non-null means we can start echoing at the next input pause even
though there is something in the echo area. */
@@ -174,8 +163,8 @@ struct kboard *echo_kboard;
Lisp_Object echo_message_buffer;
-/* Nonzero means C-g should cause immediate error-signal. */
-int immediate_quit;
+/* True means C-g should cause immediate error-signal. */
+bool immediate_quit;
/* Character that causes a quit. Normally C-g.
@@ -208,20 +197,17 @@ EMACS_INT command_loop_level;
Lisp_Object unread_switch_frame;
/* Last size recorded for a current buffer which is not a minibuffer. */
-static EMACS_INT last_non_minibuf_size;
+static ptrdiff_t last_non_minibuf_size;
/* Total number of times read_char has returned, modulo UINTMAX_MAX + 1. */
uintmax_t num_input_events;
/* Value of num_nonmacro_input_events as of last auto save. */
-static int last_auto_save;
-
-/* This is like Vthis_command, except that commands never set it. */
-Lisp_Object real_this_command;
+static EMACS_INT last_auto_save;
/* The value of point when the last command was started. */
-static EMACS_INT last_point_position;
+static ptrdiff_t last_point_position;
/* The buffer that was current when the last command was started. */
static Lisp_Object last_point_position_buffer;
@@ -233,7 +219,11 @@ static Lisp_Object last_point_position_window;
last event came from a macro. We use this to determine when to
generate switch-frame events. This may be cleared by functions
like Fselect_frame, to make sure that a switch-frame event is
- generated by the next character. */
+ generated by the next character.
+
+ FIXME: This is modified by a signal handler so it should be volatile.
+ It's exported to Lisp, though, so it can't simply be marked
+ 'volatile' here. */
Lisp_Object internal_last_event_frame;
/* The timestamp of the last input event we received from the X server.
@@ -241,6 +231,7 @@ Lisp_Object internal_last_event_frame;
Time last_event_timestamp;
static Lisp_Object Qx_set_selection, Qhandle_switch_frame;
+static Lisp_Object Qhandle_select_window;
Lisp_Object QPRIMARY;
static Lisp_Object Qself_insert_command;
@@ -279,7 +270,7 @@ static Lisp_Object Qhelp_form_show;
static FILE *dribble;
/* Nonzero if input is available. */
-int input_pending;
+bool input_pending;
/* Circular buffer for pre-read keyboard input. */
@@ -315,14 +306,12 @@ static Lisp_Object Qmake_frame_visible;
static Lisp_Object Qselect_window;
Lisp_Object Qhelp_echo;
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
static Lisp_Object Qmouse_fixup_help_message;
-#endif
/* Symbols to denote kinds of events. */
static Lisp_Object Qfunction_key;
Lisp_Object Qmouse_click;
-#if defined (WINDOWSNT)
+#ifdef HAVE_NTGUI
Lisp_Object Qlanguage_change;
#endif
static Lisp_Object Qdrag_n_drop;
@@ -374,42 +363,28 @@ static Lisp_Object command_loop (void);
static Lisp_Object Qextended_command_history;
EMACS_TIME timer_check (void);
-static void record_menu_key (Lisp_Object c);
static void echo_now (void);
-static int echo_length (void);
+static ptrdiff_t echo_length (void);
static Lisp_Object Qpolling_period;
/* Incremented whenever a timer is run. */
-int timers_run;
+unsigned timers_run;
/* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
happens. */
EMACS_TIME *input_available_clear_time;
-/* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
- Default is 1 if INTERRUPT_INPUT is defined. */
-int interrupt_input;
+/* True means use SIGIO interrupts; false means use CBREAK mode.
+ Default is true if INTERRUPT_INPUT is defined. */
+bool interrupt_input;
/* Nonzero while interrupts are temporarily deferred during redisplay. */
-int interrupts_deferred;
-
-/* Allow m- file to inhibit use of FIONREAD. */
-#ifdef BROKEN_FIONREAD
-#undef FIONREAD
-#endif
-
-/* We are unable to use interrupts if FIONREAD is not available,
- so flush SIGIO so we won't try. */
-#if !defined (FIONREAD)
-#ifdef SIGIO
-#undef SIGIO
-#endif
-#endif
+bool interrupts_deferred;
/* If we support a window system, turn on the code to poll periodically
to detect C-g. It isn't actually used when doing interrupt input. */
-#if defined (HAVE_WINDOW_SYSTEM) && !defined (USE_ASYNC_EVENTS)
+#ifdef HAVE_WINDOW_SYSTEM
#define POLL_FOR_INPUT
#endif
@@ -433,45 +408,86 @@ static EMACS_TIME timer_last_idleness_start_time;
/* Function for init_keyboard to call with no args (if nonzero). */
static void (*keyboard_init_hook) (void);
-static int read_avail_input (int);
-static void get_input_pending (int *, int);
-static int readable_events (int);
+static bool get_input_pending (int);
+static bool readable_events (int);
static Lisp_Object read_char_x_menu_prompt (ptrdiff_t, Lisp_Object *,
- Lisp_Object, int *);
+ Lisp_Object, bool *);
static Lisp_Object read_char_minibuf_menu_prompt (int, ptrdiff_t,
Lisp_Object *);
static Lisp_Object make_lispy_event (struct input_event *);
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
static Lisp_Object make_lispy_movement (struct frame *, Lisp_Object,
enum scroll_bar_part,
Lisp_Object, Lisp_Object,
Time);
-#endif
-static Lisp_Object modify_event_symbol (EMACS_INT, unsigned, Lisp_Object,
+static Lisp_Object modify_event_symbol (ptrdiff_t, int, Lisp_Object,
Lisp_Object, const char *const *,
- Lisp_Object *, EMACS_INT);
+ Lisp_Object *, ptrdiff_t);
static Lisp_Object make_lispy_switch_frame (Lisp_Object);
-static int help_char_p (Lisp_Object);
-static void save_getcjmp (jmp_buf);
-static void restore_getcjmp (jmp_buf);
+static bool help_char_p (Lisp_Object);
+static void save_getcjmp (sys_jmp_buf);
+static void restore_getcjmp (sys_jmp_buf);
static Lisp_Object apply_modifiers (int, Lisp_Object);
static void clear_event (struct input_event *);
static Lisp_Object restore_kboard_configuration (Lisp_Object);
-static void interrupt_signal (int signalnum);
-#ifdef SIGIO
-static void input_available_signal (int signo);
+#ifdef USABLE_SIGIO
+static void deliver_input_available_signal (int signo);
#endif
-static Lisp_Object (Fcommand_execute) (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object);
-static void handle_interrupt (void);
-static void quit_throw_to_read_char (int) NO_RETURN;
+static void handle_interrupt (bool);
+static _Noreturn void quit_throw_to_read_char (bool);
static void process_special_events (void);
static void timer_start_idle (void);
static void timer_stop_idle (void);
static void timer_resume_idle (void);
-static void handle_user_signal (int);
+static void deliver_user_signal (int);
static char *find_user_signal_name (int);
-static int store_user_signal_events (void);
+static void store_user_signal_events (void);
+
+/* These setters are used only in this file, so they can be private. */
+static void
+kset_echo_string (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (echo_string) = val;
+}
+static void
+kset_kbd_queue (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (kbd_queue) = val;
+}
+static void
+kset_keyboard_translate_table (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vkeyboard_translate_table) = val;
+}
+static void
+kset_last_prefix_arg (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vlast_prefix_arg) = val;
+}
+static void
+kset_last_repeatable_command (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vlast_repeatable_command) = val;
+}
+static void
+kset_local_function_key_map (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vlocal_function_key_map) = val;
+}
+static void
+kset_overriding_terminal_local_map (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Voverriding_terminal_local_map) = val;
+}
+static void
+kset_real_last_command (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vreal_last_command) = val;
+}
+static void
+kset_system_key_syms (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (system_key_syms) = val;
+}
/* Add C to the echo string, if echoing is going on.
@@ -484,7 +500,7 @@ echo_char (Lisp_Object c)
if (current_kboard->immediate_echo)
{
int size = KEY_DESCRIPTION_SIZE + 100;
- char *buffer = (char *) alloca (size);
+ char *buffer = alloca (size);
char *ptr = buffer;
Lisp_Object echo_string;
@@ -495,7 +511,7 @@ echo_char (Lisp_Object c)
if (INTEGERP (c))
{
- ptr = push_key_description (XINT (c), ptr, 1);
+ ptr = push_key_description (XINT (c), ptr);
}
else if (SYMBOLP (c))
{
@@ -506,7 +522,7 @@ echo_char (Lisp_Object c)
{
int offset = ptr - buffer;
size = max (2 * size, size + nbytes);
- buffer = (char *) alloca (size);
+ buffer = alloca (size);
ptr = buffer + offset;
}
@@ -524,7 +540,7 @@ echo_char (Lisp_Object c)
{
int offset = ptr - buffer;
size += len;
- buffer = (char *) alloca (size);
+ buffer = alloca (size);
ptr = buffer + offset;
}
@@ -555,8 +571,9 @@ echo_char (Lisp_Object c)
else if (STRINGP (echo_string))
echo_string = concat2 (echo_string, build_string (" "));
- KVAR (current_kboard, echo_string)
- = concat2 (echo_string, make_string (buffer, ptr - buffer));
+ kset_echo_string
+ (current_kboard,
+ concat2 (echo_string, make_string (buffer, ptr - buffer)));
echo_now ();
}
@@ -601,8 +618,9 @@ echo_dash (void)
/* Put a dash at the end of the buffer temporarily,
but make it go away when the next character is added. */
- KVAR (current_kboard, echo_string) = concat2 (KVAR (current_kboard, echo_string),
- build_string ("-"));
+ kset_echo_string
+ (current_kboard,
+ concat2 (KVAR (current_kboard, echo_string), build_string ("-")));
echo_now ();
}
@@ -614,7 +632,7 @@ echo_now (void)
{
if (!current_kboard->immediate_echo)
{
- int i;
+ ptrdiff_t i;
current_kboard->immediate_echo = 1;
for (i = 0; i < this_command_key_count; i++)
@@ -627,7 +645,7 @@ echo_now (void)
if (i == this_single_command_key_start)
before_command_echo_length = echo_length ();
- c = XVECTOR (this_command_keys)->contents[i];
+ c = AREF (this_command_keys, i);
if (! (EVENT_HAS_PARAMETERS (c)
&& EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
echo_char (c);
@@ -664,7 +682,7 @@ cancel_echoing (void)
{
current_kboard->immediate_echo = 0;
current_kboard->echo_after_prompt = -1;
- KVAR (current_kboard, echo_string) = Qnil;
+ kset_echo_string (current_kboard, Qnil);
ok_to_echo_at_next_pause = NULL;
echo_kboard = NULL;
echo_message_buffer = Qnil;
@@ -672,7 +690,7 @@ cancel_echoing (void)
/* Return the length of the current echo string. */
-static int
+static ptrdiff_t
echo_length (void)
{
return (STRINGP (KVAR (current_kboard, echo_string))
@@ -685,12 +703,12 @@ echo_length (void)
switches frames while entering a key sequence. */
static void
-echo_truncate (EMACS_INT nchars)
+echo_truncate (ptrdiff_t nchars)
{
if (STRINGP (KVAR (current_kboard, echo_string)))
- KVAR (current_kboard, echo_string)
- = Fsubstring (KVAR (current_kboard, echo_string),
- make_number (0), make_number (nchars));
+ kset_echo_string (current_kboard,
+ Fsubstring (KVAR (current_kboard, echo_string),
+ make_number (0), make_number (nchars)));
truncate_echo_area (nchars);
}
@@ -714,9 +732,7 @@ add_command_key (Lisp_Object key)
#endif
if (this_command_key_count >= ASIZE (this_command_keys))
- this_command_keys = larger_vector (this_command_keys,
- 2 * ASIZE (this_command_keys),
- Qnil);
+ this_command_keys = larger_vector (this_command_keys, 1, -1);
ASET (this_command_keys, this_command_key_count, key);
++this_command_key_count;
@@ -726,7 +742,7 @@ add_command_key (Lisp_Object key)
Lisp_Object
recursive_edit_1 (void)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object val;
if (command_loop_level > 0)
@@ -794,12 +810,12 @@ Alternatively, `(throw 'exit t)' makes this function signal an error.
This function is called by the editor initialization to begin editing. */)
(void)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object buffer;
/* If we enter while input is blocked, don't lock up here.
This may happen through the debugger during redisplay. */
- if (INPUT_BLOCKED_P)
+ if (input_blocked_p ())
return Qnil;
command_loop_level++;
@@ -890,8 +906,7 @@ static struct kboard_stack *kboard_stack;
void
push_kboard (struct kboard *k)
{
- struct kboard_stack *p
- = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
+ struct kboard_stack *p = xmalloc (sizeof *p);
p->next = kboard_stack;
p->kboard = current_kboard;
@@ -905,7 +920,7 @@ pop_kboard (void)
{
struct terminal *t;
struct kboard_stack *p = kboard_stack;
- int found = 0;
+ bool found = 0;
for (t = terminal_list; t; t = t->next_terminal)
{
if (t->kboard == p->kboard)
@@ -938,7 +953,7 @@ pop_kboard (void)
void
temporarily_switch_to_single_kboard (struct frame *f)
{
- int was_locked = single_kboard;
+ bool was_locked = single_kboard;
if (was_locked)
{
if (f != NULL && FRAME_KBOARD (f) != current_kboard)
@@ -987,7 +1002,7 @@ restore_kboard_configuration (Lisp_Object was_locked)
pop_kboard ();
/* The pop should not change the kboard. */
if (single_kboard && current_kboard != prev)
- abort ();
+ emacs_abort ();
}
return Qnil;
}
@@ -1023,8 +1038,8 @@ cmd_error (Lisp_Object data)
Vstandard_input = Qt;
Vexecuting_kbd_macro = Qnil;
executing_kbd_macro = Qnil;
- KVAR (current_kboard, Vprefix_arg) = Qnil;
- KVAR (current_kboard, Vlast_prefix_arg) = Qnil;
+ kset_prefix_arg (current_kboard, Qnil);
+ kset_last_prefix_arg (current_kboard, Qnil);
cancel_echoing ();
/* Avoid unquittable loop if data contains a circular list. */
@@ -1037,12 +1052,7 @@ cmd_error (Lisp_Object data)
Vprint_length = old_length;
Vquit_flag = Qnil;
-
Vinhibit_quit = Qnil;
-#if 0 /* This shouldn't be necessary anymore. --lorentey */
- if (command_loop_level == 0 && minibuf_level == 0)
- any_kboard_state ();
-#endif
return make_number (0);
}
@@ -1129,12 +1139,6 @@ command_loop (void)
while (1)
{
internal_catch (Qtop_level, top_level_1, Qnil);
-#if 0 /* This shouldn't be necessary anymore. --lorentey */
- /* Reset single_kboard in case top-level set it while
- evaluating an -f option, or we are stuck there for some
- other reason. */
- any_kboard_state ();
-#endif
internal_catch (Qtop_level, command_loop_2, Qnil);
executing_kbd_macro = Qnil;
@@ -1193,13 +1197,18 @@ This also exits all active minibuffers. */)
/* Unblock input if we enter with input blocked. This may happen if
redisplay traps e.g. during tool-bar update with input blocked. */
- while (INPUT_BLOCKED_P)
- UNBLOCK_INPUT;
+ totally_unblock_input ();
Fthrow (Qtop_level, Qnil);
}
-static Lisp_Object Fexit_recursive_edit (void) NO_RETURN;
+static _Noreturn void
+user_error (const char *msg)
+{
+ xsignal1 (Quser_error, build_string (msg));
+}
+
+_Noreturn
DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
doc: /* Exit from the innermost recursive edit or minibuffer. */)
(void)
@@ -1207,10 +1216,10 @@ DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0,
if (command_loop_level > 0 || minibuf_level > 0)
Fthrow (Qexit, Qnil);
- error ("No recursive edit is in progress");
+ user_error ("No recursive edit is in progress");
}
-static Lisp_Object Fabort_recursive_edit (void) NO_RETURN;
+_Noreturn
DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
doc: /* Abort the command that requested this recursive edit or minibuffer input. */)
(void)
@@ -1218,11 +1227,9 @@ DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0,
if (command_loop_level > 0 || minibuf_level > 0)
Fthrow (Qexit, Qt);
- error ("No recursive edit is in progress");
+ user_error ("No recursive edit is in progress");
}
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
-
/* Restore mouse tracking enablement. See Ftrack_mouse for the only use
of this function. */
@@ -1240,8 +1247,7 @@ tracking_off (Lisp_Object old_value)
if (!readable_events (READABLE_EVENTS_DO_TIMERS_NOW))
{
redisplay_preserve_echo_area (6);
- get_input_pending (&input_pending,
- READABLE_EVENTS_DO_TIMERS_NOW);
+ get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
}
}
return Qnil;
@@ -1255,7 +1261,7 @@ Normally, mouse motion is ignored.
usage: (track-mouse BODY...) */)
(Lisp_Object args)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object val;
record_unwind_protect (tracking_off, do_mouse_tracking);
@@ -1276,7 +1282,7 @@ usage: (track-mouse BODY...) */)
#if !defined HAVE_WINDOW_SYSTEM || defined USE_GTK || defined HAVE_NS
static
#endif
-int ignore_mouse_drag_p;
+bool ignore_mouse_drag_p;
static FRAME_PTR
some_mouse_moved (void)
@@ -1298,15 +1304,14 @@ some_mouse_moved (void)
return 0;
}
-#endif /* HAVE_MOUSE || HAVE_GPM */
/* This is the actual command reading loop,
sans error-handling encapsulation. */
static int read_key_sequence (Lisp_Object *, int, Lisp_Object,
- int, int, int);
+ bool, bool, bool);
void safe_run_hooks (Lisp_Object);
-static void adjust_point_for_property (EMACS_INT, int);
+static void adjust_point_for_property (ptrdiff_t, bool);
/* Cancel hourglass from protect_unwind.
ARG is not used. */
@@ -1319,10 +1324,12 @@ cancel_hourglass_unwind (Lisp_Object arg)
}
#endif
+/* The last boundary auto-added to buffer-undo-list. */
+Lisp_Object last_undo_boundary;
+
/* FIXME: This is wrong rather than test window-system, we should call
a new set-selection, which will then dispatch to x-set-selection, or
tty-set-selection, or w32-set-selection, ... */
-EXFUN (Fwindow_system, 1);
Lisp_Object
command_loop_1 (void)
@@ -1330,15 +1337,12 @@ command_loop_1 (void)
Lisp_Object cmd;
Lisp_Object keybuf[30];
int i;
- int prev_modiff = 0;
+ EMACS_INT prev_modiff = 0;
struct buffer *prev_buffer = NULL;
-#if 0 /* This shouldn't be necessary anymore. --lorentey */
- int was_locked = single_kboard;
-#endif
- int already_adjusted = 0;
+ bool already_adjusted = 0;
- KVAR (current_kboard, Vprefix_arg) = Qnil;
- KVAR (current_kboard, Vlast_prefix_arg) = Qnil;
+ kset_prefix_arg (current_kboard, Qnil);
+ kset_last_prefix_arg (current_kboard, Qnil);
Vdeactivate_mark = Qnil;
waiting_for_input = 0;
cancel_echoing ();
@@ -1370,10 +1374,10 @@ command_loop_1 (void)
}
/* Do this after running Vpost_command_hook, for consistency. */
- KVAR (current_kboard, Vlast_command) = Vthis_command;
- KVAR (current_kboard, Vreal_last_command) = real_this_command;
+ kset_last_command (current_kboard, Vthis_command);
+ kset_real_last_command (current_kboard, Vreal_this_command);
if (!CONSP (last_command_event))
- KVAR (current_kboard, Vlast_repeatable_command) = real_this_command;
+ kset_last_repeatable_command (current_kboard, Vreal_this_command);
while (1)
{
@@ -1381,8 +1385,7 @@ command_loop_1 (void)
Fkill_emacs (Qnil);
/* Make sure the current window's buffer is selected. */
- if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
- set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
+ set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
/* Display any malloc warning that just came out. Use while because
displaying one warning can cause another. */
@@ -1392,6 +1395,12 @@ command_loop_1 (void)
Vdeactivate_mark = Qnil;
+ /* Don't ignore mouse movements for more than a single command
+ loop. (This flag is set in xdisp.c whenever the tool bar is
+ resized, because the resize moves text up or down, and would
+ generate false mouse drag events if we don't ignore them.) */
+ ignore_mouse_drag_p = 0;
+
/* If minibuffer on and echo area in use,
wait a short time and redraw minibuffer. */
@@ -1402,7 +1411,7 @@ command_loop_1 (void)
{
/* Bind inhibit-quit to t so that C-g gets read in
rather than quitting back to the minibuffer. */
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
sit_for (Vminibuffer_message_timeout, 0, 2);
@@ -1421,15 +1430,6 @@ command_loop_1 (void)
}
}
-#if 0
- /* Select the frame that the last event came from. Usually,
- switch-frame events will take care of this, but if some lisp
- code swallows a switch-frame event, we'll fix things up here.
- Is this a good idea? */
- if (FRAMEP (internal_last_event_frame)
- && !EQ (internal_last_event_frame, selected_frame))
- Fselect_frame (internal_last_event_frame, Qnil);
-#endif
/* If it has changed current-menubar from previous value,
really recompute the menubar from the value. */
if (! NILP (Vlucid_menu_bar_dirty_flag)
@@ -1440,7 +1440,7 @@ command_loop_1 (void)
before_command_echo_length = echo_length ();
Vthis_command = Qnil;
- real_this_command = Qnil;
+ Vreal_this_command = Qnil;
Vthis_original_command = Qnil;
Vthis_command_keys_shift_translated = Qnil;
@@ -1451,8 +1451,7 @@ command_loop_1 (void)
/* A filter may have run while we were reading the input. */
if (! FRAME_LIVE_P (XFRAME (selected_frame)))
Fkill_emacs (Qnil);
- if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
- set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
+ set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
++num_input_keys;
@@ -1479,10 +1478,10 @@ command_loop_1 (void)
from that position. But also throw away beg_unchanged and
end_unchanged information in that case, so that redisplay will
update the whole window properly. */
- if (!NILP (XWINDOW (selected_window)->force_start))
+ if (XWINDOW (selected_window)->force_start)
{
struct buffer *b;
- XWINDOW (selected_window)->force_start = Qnil;
+ XWINDOW (selected_window)->force_start = 0;
b = XBUFFER (XWINDOW (selected_window)->buffer);
BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
}
@@ -1524,7 +1523,7 @@ command_loop_1 (void)
/* Execute the command. */
Vthis_command = cmd;
- real_this_command = cmd;
+ Vreal_this_command = cmd;
safe_run_hooks (Qpre_command_hook);
already_adjusted = 0;
@@ -1536,7 +1535,7 @@ command_loop_1 (void)
keys = Fkey_description (keys, Qnil);
bitch_at_user ();
message_with_string ("%s is undefined", keys, 0);
- KVAR (current_kboard, defining_kbd_macro) = Qnil;
+ kset_defining_kbd_macro (current_kboard, Qnil);
update_mode_lines = 1;
/* If this is a down-mouse event, don't reset prefix-arg;
pass it to the command run by the up event. */
@@ -1546,17 +1545,17 @@ command_loop_1 (void)
= parse_modifiers (EVENT_HEAD (last_command_event));
int modifiers = XINT (XCAR (XCDR (breakdown)));
if (!(modifiers & down_modifier))
- KVAR (current_kboard, Vprefix_arg) = Qnil;
+ kset_prefix_arg (current_kboard, Qnil);
}
else
- KVAR (current_kboard, Vprefix_arg) = Qnil;
+ kset_prefix_arg (current_kboard, Qnil);
}
else
{
/* Here for a command that isn't executed directly. */
#ifdef HAVE_WINDOW_SYSTEM
- int scount = SPECPDL_INDEX ();
+ ptrdiff_t scount = SPECPDL_INDEX ();
if (display_hourglass_p
&& NILP (Vexecuting_kbd_macro))
@@ -1567,7 +1566,13 @@ command_loop_1 (void)
#endif
if (NILP (KVAR (current_kboard, Vprefix_arg))) /* FIXME: Why? --Stef */
- Fundo_boundary ();
+ {
+ Lisp_Object undo = BVAR (current_buffer, undo_list);
+ Fundo_boundary ();
+ last_undo_boundary
+ = (EQ (undo, BVAR (current_buffer, undo_list))
+ ? Qnil : BVAR (current_buffer, undo_list));
+ }
Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
#ifdef HAVE_WINDOW_SYSTEM
@@ -1580,7 +1585,7 @@ command_loop_1 (void)
unbind_to (scount, Qnil);
#endif
}
- KVAR (current_kboard, Vlast_prefix_arg) = Vcurrent_prefix_arg;
+ kset_last_prefix_arg (current_kboard, Vcurrent_prefix_arg);
safe_run_hooks (Qpost_command_hook);
@@ -1608,12 +1613,13 @@ command_loop_1 (void)
If the command didn't actually create a prefix arg,
but is merely a frame event that is transparent to prefix args,
then the above doesn't apply. */
- if (NILP (KVAR (current_kboard, Vprefix_arg)) || CONSP (last_command_event))
+ if (NILP (KVAR (current_kboard, Vprefix_arg))
+ || CONSP (last_command_event))
{
- KVAR (current_kboard, Vlast_command) = Vthis_command;
- KVAR (current_kboard, Vreal_last_command) = real_this_command;
+ kset_last_command (current_kboard, Vthis_command);
+ kset_real_last_command (current_kboard, Vreal_this_command);
if (!CONSP (last_command_event))
- KVAR (current_kboard, Vlast_repeatable_command) = real_this_command;
+ kset_last_repeatable_command (current_kboard, Vreal_this_command);
cancel_echoing ();
this_command_key_count = 0;
this_command_key_count_reset = 0;
@@ -1647,11 +1653,12 @@ command_loop_1 (void)
? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly)
: (!NILP (Vselect_active_regions)
&& !NILP (Vtransient_mark_mode)))
- && !EQ (Vthis_command, Qhandle_switch_frame))
+ && NILP (Fmemq (Vthis_command,
+ Vselection_inhibit_update_commands)))
{
- EMACS_INT beg =
+ ptrdiff_t beg =
XINT (Fmarker_position (BVAR (current_buffer, mark)));
- EMACS_INT end = PT;
+ ptrdiff_t end = PT;
if (beg < end)
call2 (Qx_set_selection, QPRIMARY,
make_buffer_string (beg, end, 0));
@@ -1698,10 +1705,6 @@ command_loop_1 (void)
if (!NILP (KVAR (current_kboard, defining_kbd_macro))
&& NILP (KVAR (current_kboard, Vprefix_arg)))
finalize_kbd_macro_chars ();
-#if 0 /* This shouldn't be necessary anymore. --lorentey */
- if (!was_locked)
- any_kboard_state ();
-#endif
}
}
@@ -1711,16 +1714,16 @@ command_loop_1 (void)
LAST_PT is the last position of point. */
static void
-adjust_point_for_property (EMACS_INT last_pt, int modified)
+adjust_point_for_property (ptrdiff_t last_pt, bool modified)
{
- EMACS_INT beg, end;
+ ptrdiff_t beg, end;
Lisp_Object val, overlay, tmp;
/* When called after buffer modification, we should temporarily
suppress the point adjustment for automatic composition so that a
user can keep inserting another character at point or keep
deleting characters around point. */
- int check_composition = ! modified, check_display = 1, check_invisible = 1;
- EMACS_INT orig_pt = PT;
+ bool check_composition = ! modified, check_display = 1, check_invisible = 1;
+ ptrdiff_t orig_pt = PT;
/* FIXME: cycling is probably not necessary because these properties
can't be usefully combined anyway. */
@@ -1747,16 +1750,19 @@ adjust_point_for_property (EMACS_INT last_pt, int modified)
&& (beg < PT /* && end > PT <- It's always the case. */
|| (beg <= PT && STRINGP (val) && SCHARS (val) == 0)))
{
- xassert (end > PT);
+ eassert (end > PT);
SET_PT (PT < last_pt
- ? (STRINGP (val) && SCHARS (val) == 0 ? beg - 1 : beg)
+ ? (STRINGP (val) && SCHARS (val) == 0
+ ? max (beg - 1, BEGV)
+ : beg)
: end);
check_composition = check_invisible = 1;
}
check_display = 0;
if (check_invisible && PT > BEGV && PT < ZV)
{
- int inv, ellipsis = 0;
+ int inv;
+ bool ellipsis = 0;
beg = end = PT;
/* Find boundaries `beg' and `end' of the invisible area, if any. */
@@ -1827,7 +1833,7 @@ adjust_point_for_property (EMACS_INT last_pt, int modified)
#if 0 /* This assertion isn't correct, because SET_PT may end up setting
the point to something other than its argument, due to
point-motion hooks, intangibility, etc. */
- xassert (PT == beg || PT == end);
+ eassert (PT == beg || PT == end);
#endif
/* Pretend the area doesn't exist if the buffer is not
@@ -1877,7 +1883,7 @@ safe_run_hooks_error (Lisp_Object error_data)
= CONSP (Vinhibit_quit) ? XCAR (Vinhibit_quit) : Vinhibit_quit;
Lisp_Object fun = CONSP (Vinhibit_quit) ? XCDR (Vinhibit_quit) : Qnil;
Lisp_Object args[4];
- args[0] = build_string ("Error in %s (%s): %s");
+ args[0] = build_string ("Error in %s (%s): %S");
args[1] = hook;
args[2] = fun;
args[3] = error_data;
@@ -1885,7 +1891,7 @@ safe_run_hooks_error (Lisp_Object error_data)
if (SYMBOLP (hook))
{
Lisp_Object val;
- int found = 0;
+ bool found = 0;
Lisp_Object newval = Qnil;
for (val = find_symbol_value (hook); CONSP (val); val = XCDR (val))
if (EQ (fun, XCAR (val)))
@@ -1933,7 +1939,7 @@ safe_run_hooks (Lisp_Object hook)
/* FIXME: our `internal_condition_case' does not provide any way to pass data
to its body or to its handlers other than via globals such as
dynamically-bound variables ;-) */
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, hook);
run_hook_with_args (1, &hook, safe_run_hook_funcall);
@@ -1946,12 +1952,12 @@ safe_run_hooks (Lisp_Object hook)
int poll_suppress_count;
-/* Asynchronous timer for polling. */
-static struct atimer *poll_timer;
+#ifdef POLL_FOR_INPUT
+/* Asynchronous timer for polling. */
-#ifdef POLL_FOR_INPUT
+static struct atimer *poll_timer;
/* Poll for input, so that we catch a C-g if it comes in. This
function is called from x_make_frame_visible, see comment
@@ -1960,17 +1966,9 @@ static struct atimer *poll_timer;
void
poll_for_input_1 (void)
{
-/* Tell ns_read_socket() it is being called asynchronously so it can avoid
- doing anything dangerous. */
-#ifdef HAVE_NS
- ++handling_signal;
-#endif
- if (interrupt_input_blocked == 0
+ if (! input_blocked_p ()
&& !waiting_for_input)
- read_avail_input (0);
-#ifdef HAVE_NS
- --handling_signal;
-#endif
+ gobble_input ();
}
/* Timer callback function for poll_timer. TIMER is equal to
@@ -1980,14 +1978,7 @@ static void
poll_for_input (struct atimer *timer)
{
if (poll_suppress_count == 0)
- {
-#ifdef SYNC_INPUT
- interrupt_input_pending = 1;
- pending_signals = 1;
-#else
- poll_for_input_1 ();
-#endif
- }
+ pending_signals = 1;
}
#endif /* POLL_FOR_INPUT */
@@ -2013,12 +2004,12 @@ start_polling (void)
if (poll_timer == NULL
|| EMACS_SECS (poll_timer->interval) != polling_period)
{
- EMACS_TIME interval;
+ time_t period = max (1, min (polling_period, TYPE_MAXIMUM (time_t)));
+ EMACS_TIME interval = make_emacs_time (period, 0);
if (poll_timer)
cancel_atimer (poll_timer);
- EMACS_SET_SECS_USECS (interval, polling_period, 0);
poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
poll_for_input, NULL);
}
@@ -2030,9 +2021,9 @@ start_polling (void)
#endif
}
-/* Nonzero if we are using polling to handle input asynchronously. */
+/* True if we are using polling to handle input asynchronously. */
-int
+bool
input_polling_used (void)
{
#ifdef POLL_FOR_INPUT
@@ -2086,7 +2077,7 @@ void
bind_polling_period (int n)
{
#ifdef POLL_FOR_INPUT
- int new = polling_period;
+ EMACS_INT new = polling_period;
if (n > new)
new = n;
@@ -2173,14 +2164,7 @@ show_help_echo (Lisp_Object help, Lisp_Object window, Lisp_Object object,
if (!NILP (help) && !STRINGP (help))
{
if (FUNCTIONP (help))
- {
- Lisp_Object args[4];
- args[0] = help;
- args[1] = window;
- args[2] = object;
- args[3] = pos;
- help = safe_call (4, args);
- }
+ help = safe_call (4, help, window, object, pos);
else
help = safe_eval (help);
@@ -2188,7 +2172,6 @@ show_help_echo (Lisp_Object help, Lisp_Object window, Lisp_Object object,
return;
}
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
if (!noninteractive && STRINGP (help))
{
/* The mouse-fixup-help-message Lisp function can call
@@ -2201,7 +2184,6 @@ show_help_echo (Lisp_Object help, Lisp_Object window, Lisp_Object object,
if (f)
f->mouse_moved = 1;
}
-#endif
if (STRINGP (help) || NILP (help))
{
@@ -2215,8 +2197,8 @@ show_help_echo (Lisp_Object help, Lisp_Object window, Lisp_Object object,
/* Input of single characters from keyboard */
-static Lisp_Object kbd_buffer_get_event (KBOARD **kbp, int *used_mouse_menu,
- struct timeval *end_time);
+static Lisp_Object kbd_buffer_get_event (KBOARD **kbp, bool *used_mouse_menu,
+ EMACS_TIME *end_time);
static void record_char (Lisp_Object c);
static Lisp_Object help_form_saved_window_configs;
@@ -2239,8 +2221,8 @@ do { if (polling_stopped_here) start_polling (); \
polling_stopped_here = 0; } while (0)
/* read a character from the keyboard; call the redisplay if needed */
-/* commandflag 0 means do not do auto-saving, but do do redisplay.
- -1 means do not do redisplay, but do do autosaving.
+/* commandflag 0 means do not autosave, but do redisplay.
+ -1 means do not redisplay, but do autosave.
1 means do both. */
/* The arguments MAPS and NMAPS are for menu prompting.
@@ -2252,9 +2234,9 @@ do { if (polling_stopped_here) start_polling (); \
not to run input methods, but in other respects to act as if
not reading a key sequence.
- If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
- if we used a mouse menu to read the input, or zero otherwise. If
- USED_MOUSE_MENU is null, we don't dereference it.
+ If USED_MOUSE_MENU is non-null, then set *USED_MOUSE_MENU to true
+ if we used a mouse menu to read the input, or false otherwise. If
+ USED_MOUSE_MENU is null, don't dereference it.
Value is -2 when we find input on another keyboard. A second call
to read_char will read it.
@@ -2268,19 +2250,18 @@ do { if (polling_stopped_here) start_polling (); \
Lisp_Object
read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
Lisp_Object prev_event,
- int *used_mouse_menu, struct timeval *end_time)
+ bool *used_mouse_menu, EMACS_TIME *end_time)
{
- volatile Lisp_Object c;
- int jmpcount;
- jmp_buf local_getcjmp;
- jmp_buf save_jump;
- volatile int key_already_recorded = 0;
+ Lisp_Object c;
+ ptrdiff_t jmpcount;
+ sys_jmp_buf local_getcjmp;
+ sys_jmp_buf save_jump;
Lisp_Object tem, save;
volatile Lisp_Object previous_echo_area_message;
volatile Lisp_Object also_record;
- volatile int reread;
+ volatile bool reread;
struct gcpro gcpro1, gcpro2;
- int volatile polling_stopped_here = 0;
+ bool volatile polling_stopped_here = 0;
struct kboard *orig_kboard = current_kboard;
also_record = Qnil;
@@ -2314,18 +2295,9 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
goto reread_first;
}
- if (unread_command_char != -1)
- {
- XSETINT (c, unread_command_char);
- unread_command_char = -1;
-
- reread = 1;
- goto reread_first;
- }
-
if (CONSP (Vunread_command_events))
{
- int was_disabled = 0;
+ bool was_disabled = 0;
c = XCAR (Vunread_command_events);
Vunread_command_events = XCDR (Vunread_command_events);
@@ -2427,7 +2399,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
/* if redisplay was requested */
if (commandflag >= 0)
{
- int echo_current = EQ (echo_message_buffer, echo_area_buffer[0]);
+ bool echo_current = EQ (echo_message_buffer, echo_area_buffer[0]);
/* If there is pending input, process any events which are not
user-visible, such as X selection_request events. */
@@ -2507,7 +2479,6 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
&& !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
/* Don't bring up a menu if we already have another event. */
&& NILP (Vunread_command_events)
- && unread_command_char < 0
&& !detect_input_pending_run_timers (0))
{
c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
@@ -2516,10 +2487,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
return c; /* wrong_kboard_jmpbuf */
if (! NILP (c))
- {
- key_already_recorded = 1;
- goto non_reread_1;
- }
+ goto exit;
}
/* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
@@ -2529,7 +2497,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
it *must not* be in effect when we call redisplay. */
jmpcount = SPECPDL_INDEX ();
- if (_setjmp (local_getcjmp))
+ if (sys_setjmp (local_getcjmp))
{
/* Handle quits while reading the keyboard. */
/* We must have saved the outer value of getcjmp here,
@@ -2551,16 +2519,16 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
Lisp_Object last = KVAR (kb, kbd_queue);
/* We shouldn't get here if we were in single-kboard mode! */
if (single_kboard)
- abort ();
+ emacs_abort ();
if (CONSP (last))
{
while (CONSP (XCDR (last)))
last = XCDR (last);
if (!NILP (XCDR (last)))
- abort ();
+ emacs_abort ();
}
if (!CONSP (last))
- KVAR (kb, kbd_queue) = Fcons (c, Qnil);
+ kset_kbd_queue (kb, Fcons (c, Qnil));
else
XSETCDR (last, Fcons (c, Qnil));
kb->kbd_queue_has_data = 1;
@@ -2643,8 +2611,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
&& !EQ (XCAR (prev_event), Qmenu_bar)
&& !EQ (XCAR (prev_event), Qtool_bar)
/* Don't bring up a menu if we already have another event. */
- && NILP (Vunread_command_events)
- && unread_command_char < 0)
+ && NILP (Vunread_command_events))
{
c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
@@ -2660,7 +2627,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
if (INTERACTIVE && NILP (c))
{
int delay_level;
- EMACS_INT buffer_size;
+ ptrdiff_t buffer_size;
/* Slow down auto saves logarithmically in size of current buffer,
and garbage collect while we're at it. */
@@ -2681,8 +2648,9 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
&& XINT (Vauto_save_timeout) > 0)
{
Lisp_Object tem0;
- int timeout = delay_level * XFASTINT (Vauto_save_timeout) / 4;
-
+ EMACS_INT timeout = (delay_level
+ * min (XFASTINT (Vauto_save_timeout) / 4,
+ MOST_POSITIVE_FIXNUM / delay_level));
save_getcjmp (save_jump);
restore_getcjmp (local_getcjmp);
tem0 = sit_for (make_number (timeout), 1, 1);
@@ -2692,17 +2660,13 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
&& ! CONSP (Vunread_command_events))
{
Fdo_auto_save (Qnil, Qnil);
-
- /* If we have auto-saved and there is still no input
- available, garbage collect if there has been enough
- consing going on to make it worthwhile. */
- if (!detect_input_pending_run_timers (0)
- && consing_since_gc > gc_cons_threshold / 2)
- Fgarbage_collect ();
-
redisplay ();
}
}
+
+ /* If there is still no input available, ask for GC. */
+ if (!detect_input_pending_run_timers (0))
+ maybe_gc ();
}
/* Notify the caller if an autosave hook, or a timer, sentinel or
@@ -2733,10 +2697,10 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
if (current_kboard->kbd_queue_has_data)
{
if (!CONSP (KVAR (current_kboard, kbd_queue)))
- abort ();
+ emacs_abort ();
c = XCAR (KVAR (current_kboard, kbd_queue));
- KVAR (current_kboard, kbd_queue)
- = XCDR (KVAR (current_kboard, kbd_queue));
+ kset_kbd_queue (current_kboard,
+ XCDR (KVAR (current_kboard, kbd_queue)));
if (NILP (KVAR (current_kboard, kbd_queue)))
current_kboard->kbd_queue_has_data = 0;
input_pending = readable_events (0);
@@ -2781,13 +2745,8 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
{
KBOARD *kb IF_LINT (= NULL);
- if (end_time)
- {
- EMACS_TIME now;
- EMACS_GET_TIME (now);
- if (EMACS_TIME_GE (now, *end_time))
- goto exit;
- }
+ if (end_time && EMACS_TIME_LE (*end_time, current_emacs_time ()))
+ goto exit;
/* Actually read a character, waiting if necessary. */
save_getcjmp (save_jump);
@@ -2805,10 +2764,10 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
while (CONSP (XCDR (last)))
last = XCDR (last);
if (!NILP (XCDR (last)))
- abort ();
+ emacs_abort ();
}
if (!CONSP (last))
- KVAR (kb, kbd_queue) = Fcons (c, Qnil);
+ kset_kbd_queue (kb, Fcons (c, Qnil));
else
XSETCDR (last, Fcons (c, Qnil));
kb->kbd_queue_has_data = 1;
@@ -2856,12 +2815,10 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
goto wrong_kboard;
}
- non_reread_1:
-
/* Buffer switch events are only for internal wakeups
so don't show them to the user.
Also, don't record a key if we already did. */
- if (BUFFERP (c) || key_already_recorded)
+ if (BUFFERP (c))
goto exit;
/* Process special events within read_char
@@ -2874,12 +2831,6 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
if (!NILP (tem))
{
struct buffer *prev_buffer = current_buffer;
-#if 0 /* This shouldn't be necessary anymore. --lorentey */
- int was_locked = single_kboard;
- int count = SPECPDL_INDEX ();
- record_single_kboard_state ();
-#endif
-
last_input_event = c;
Fcommand_execute (tem, Qnil, Fvector (1, &last_input_event), Qt);
@@ -2890,13 +2841,6 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
example banishing the mouse under mouse-avoidance-mode. */
timer_resume_idle ();
-#if 0 /* This shouldn't be necessary anymore. --lorentey */
- /* Resume allowing input from any kboard, if that was true before. */
- if (!was_locked)
- any_kboard_state ();
- unbind_to (count, Qnil);
-#endif
-
if (current_buffer != prev_buffer)
{
/* The command may have changed the keymaps. Pretend there
@@ -2980,11 +2924,16 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
own stuff with the echo area. */
if (!CONSP (c)
|| (!(EQ (Qhelp_echo, XCAR (c)))
- && !(EQ (Qswitch_frame, XCAR (c)))))
+ && !(EQ (Qswitch_frame, XCAR (c)))
+ /* Don't wipe echo area for select window events: These might
+ get delayed via `mouse-autoselect-window' (Bug#11304). */
+ && !(EQ (Qselect_window, XCAR (c)))))
{
if (!NILP (echo_area_buffer[0]))
- safe_run_hooks (Qecho_area_clear_hook);
- clear_message (1, 0);
+ {
+ safe_run_hooks (Qecho_area_clear_hook);
+ clear_message (1, 0);
+ }
}
reread_for_input_method:
@@ -2998,15 +2947,16 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
&& ' ' <= XINT (c) && XINT (c) < 256 && XINT (c) != 127)
{
Lisp_Object keys;
- int key_count, key_count_reset;
+ ptrdiff_t key_count;
+ bool key_count_reset;
struct gcpro gcpro1;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* Save the echo status. */
- int saved_immediate_echo = current_kboard->immediate_echo;
+ bool saved_immediate_echo = current_kboard->immediate_echo;
struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
Lisp_Object saved_echo_string = KVAR (current_kboard, echo_string);
- int saved_echo_after_prompt = current_kboard->echo_after_prompt;
+ ptrdiff_t saved_echo_after_prompt = current_kboard->echo_after_prompt;
#if 0
if (before_command_restore_flag)
@@ -3060,7 +3010,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
cancel_echoing ();
ok_to_echo_at_next_pause = saved_ok_to_echo;
- KVAR (current_kboard, echo_string) = saved_echo_string;
+ kset_echo_string (current_kboard, saved_echo_string);
current_kboard->echo_after_prompt = saved_echo_after_prompt;
if (saved_immediate_echo)
echo_now ();
@@ -3137,7 +3087,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
/* Process the help character specially if enabled */
if (!NILP (Vhelp_form) && help_char_p (c))
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
help_form_saved_window_configs
= Fcons (Fcurrent_window_configuration (Qnil),
@@ -3207,9 +3157,9 @@ record_menu_key (Lisp_Object c)
num_input_events++;
}
-/* Return 1 if should recognize C as "the help character". */
+/* Return true if should recognize C as "the help character". */
-static int
+static bool
help_char_p (Lisp_Object c)
{
Lisp_Object tail;
@@ -3297,7 +3247,7 @@ record_char (Lisp_Object c)
if (!recorded)
{
- total_keys++;
+ total_keys += total_keys < NUM_RECENT_KEYS;
ASET (recent_keys, recent_keys_index, c);
if (++recent_keys_index >= NUM_RECENT_KEYS)
recent_keys_index = 0;
@@ -3328,7 +3278,7 @@ record_char (Lisp_Object c)
If you, dear reader, have a better idea, you've got the source. :-) */
if (dribble)
{
- BLOCK_INPUT;
+ block_input ();
if (INTEGERP (c))
{
if (XUINT (c) < 0x100)
@@ -3354,7 +3304,7 @@ record_char (Lisp_Object c)
}
fflush (dribble);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -3364,13 +3314,13 @@ record_char (Lisp_Object c)
See read_process_output. */
static void
-save_getcjmp (jmp_buf temp)
+save_getcjmp (sys_jmp_buf temp)
{
memcpy (temp, getcjmp, sizeof getcjmp);
}
static void
-restore_getcjmp (jmp_buf temp)
+restore_getcjmp (sys_jmp_buf temp)
{
memcpy (getcjmp, temp, sizeof getcjmp);
}
@@ -3381,7 +3331,7 @@ restore_getcjmp (jmp_buf temp)
/* Return true if there are any events in the queue that read-char
would return. If this returns false, a read-char would block. */
-static int
+static bool
readable_events (int flags)
{
if (flags & READABLE_EVENTS_DO_TIMERS_NOW)
@@ -3428,11 +3378,9 @@ readable_events (int flags)
return 1;
}
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
if (!(flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
&& !NILP (do_mouse_tracking) && some_mouse_moved ())
return 1;
-#endif
if (single_kboard)
{
if (current_kboard->kbd_queue_has_data)
@@ -3454,20 +3402,20 @@ int stop_character EXTERNALLY_VISIBLE;
static KBOARD *
event_to_kboard (struct input_event *event)
{
- Lisp_Object frame;
- frame = event->frame_or_window;
- if (CONSP (frame))
- frame = XCAR (frame);
- else if (WINDOWP (frame))
- frame = WINDOW_FRAME (XWINDOW (frame));
-
- /* There are still some events that don't set this field.
- For now, just ignore the problem.
- Also ignore dead frames here. */
- if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
- return 0;
+ /* Not applicable for these special events. */
+ if (event->kind == SELECTION_REQUEST_EVENT
+ || event->kind == SELECTION_CLEAR_EVENT)
+ return NULL;
else
- return FRAME_KBOARD (XFRAME (frame));
+ {
+ Lisp_Object obj = event->frame_or_window;
+ /* There are some events that set this field to nil or string. */
+ if (WINDOWP (obj))
+ obj = WINDOW_FRAME (XWINDOW (obj));
+ /* Also ignore dead frames here. */
+ return ((FRAMEP (obj) && FRAME_LIVE_P (XFRAME (obj)))
+ ? FRAME_KBOARD (XFRAME (obj)) : NULL);
+ }
}
#ifdef subprocesses
@@ -3498,17 +3446,15 @@ kbd_buffer_store_event (register struct input_event *event)
Else, if EVENT is a quit event, store the quit event
in HOLD_QUIT, and return (thus ignoring further events).
- This is used in read_avail_input to postpone the processing
- of the quit event until all subsequent input events have been
- parsed (and discarded).
- */
+ This is used to postpone the processing of the quit event until all
+ subsequent input events have been parsed (and discarded). */
void
kbd_buffer_store_event_hold (register struct input_event *event,
struct input_event *hold_quit)
{
if (event->kind == NO_EVENT)
- abort ();
+ emacs_abort ();
if (hold_quit && hold_quit->kind != NO_EVENT)
return;
@@ -3531,9 +3477,9 @@ kbd_buffer_store_event_hold (register struct input_event *event,
if (single_kboard && kb != current_kboard)
{
- KVAR (kb, kbd_queue)
- = Fcons (make_lispy_switch_frame (event->frame_or_window),
- Fcons (make_number (c), Qnil));
+ kset_kbd_queue
+ (kb, Fcons (make_lispy_switch_frame (event->frame_or_window),
+ Fcons (make_number (c), Qnil)));
kb->kbd_queue_has_data = 1;
for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
{
@@ -3552,7 +3498,7 @@ kbd_buffer_store_event_hold (register struct input_event *event,
if (hold_quit)
{
- memcpy (hold_quit, event, sizeof (*event));
+ *hold_quit = *event;
return;
}
@@ -3571,7 +3517,8 @@ kbd_buffer_store_event_hold (register struct input_event *event,
}
last_event_timestamp = event->timestamp;
- handle_interrupt ();
+
+ handle_interrupt (0);
return;
}
@@ -3607,10 +3554,8 @@ kbd_buffer_store_event_hold (register struct input_event *event,
/* Don't read keyboard input until we have processed kbd_buffer.
This happens when pasting text longer than KBD_BUFFER_SIZE/2. */
hold_keyboard_input ();
-#ifdef SIGIO
if (!noninteractive)
- signal (SIGIO, SIG_IGN);
-#endif
+ ignore_sigio ();
stop_polling ();
}
#endif /* subprocesses */
@@ -3629,7 +3574,6 @@ kbd_buffer_store_event_hold (register struct input_event *event,
if (immediate_quit && NILP (Vinhibit_quit))
{
immediate_quit = 0;
- sigfree ();
QUIT;
}
}
@@ -3666,7 +3610,7 @@ kbd_buffer_unget_event (register struct input_event *event)
void
gen_help_event (Lisp_Object help, Lisp_Object frame, Lisp_Object window,
- Lisp_Object object, EMACS_INT pos)
+ Lisp_Object object, ptrdiff_t pos)
{
struct input_event event;
@@ -3724,15 +3668,14 @@ discard_mouse_events (void)
}
-/* Return non-zero if there are any real events waiting in the event
+/* Return true if there are any real events waiting in the event
buffer, not counting `NO_EVENT's.
- If DISCARD is non-zero, discard NO_EVENT events at the front of
- the input queue, possibly leaving the input queue empty if there
- are no real input events. */
+ Discard NO_EVENT events at the front of the input queue, possibly
+ leaving the input queue empty if there are no real input events. */
-int
-kbd_buffer_events_waiting (int discard)
+bool
+kbd_buffer_events_waiting (void)
{
struct input_event *sp;
@@ -3744,16 +3687,14 @@ kbd_buffer_events_waiting (int discard)
sp = kbd_buffer;
}
- if (discard)
- kbd_fetch_ptr = sp;
-
+ kbd_fetch_ptr = sp;
return sp != kbd_store_ptr && sp->kind != NO_EVENT;
}
/* Clear input event EVENT. */
-static inline void
+static void
clear_event (struct input_event *event)
{
event->kind = NO_EVENT;
@@ -3768,36 +3709,33 @@ clear_event (struct input_event *event)
static Lisp_Object
kbd_buffer_get_event (KBOARD **kbp,
- int *used_mouse_menu,
- struct timeval *end_time)
+ bool *used_mouse_menu,
+ EMACS_TIME *end_time)
{
- register int c;
Lisp_Object obj;
#ifdef subprocesses
if (kbd_on_hold_p () && kbd_buffer_nr_stored () < KBD_BUFFER_SIZE/4)
{
- /* Start reading input again, we have processed enough so we can
- accept new events again. */
+ /* Start reading input again because we have processed enough to
+ be able to accept new events again. */
unhold_keyboard_input ();
-#ifdef SIGIO
- if (!noninteractive)
- signal (SIGIO, input_available_signal);
-#endif /* SIGIO */
start_polling ();
}
#endif /* subprocesses */
+#ifndef HAVE_DBUS /* We want to read D-Bus events in batch mode. */
if (noninteractive
/* In case we are running as a daemon, only do this before
detaching from the terminal. */
|| (IS_DAEMON && daemon_pipe[1] >= 0))
{
- c = getchar ();
+ int c = getchar ();
XSETINT (obj, c);
*kbp = current_kboard;
return obj;
}
+#endif /* ! HAVE_DBUS */
/* Wait until there is input available. */
for (;;)
@@ -3810,10 +3748,8 @@ kbd_buffer_get_event (KBOARD **kbp,
if (kbd_fetch_ptr != kbd_store_ptr)
break;
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
if (!NILP (do_mouse_tracking) && some_mouse_moved ())
break;
-#endif
/* If the quit flag is set, then read_char will return
quit_char, so that counts as "available input." */
@@ -3823,27 +3759,24 @@ kbd_buffer_get_event (KBOARD **kbp,
/* One way or another, wait until input is available; then, if
interrupt handlers have not read it, read it now. */
-/* Note SIGIO has been undef'd if FIONREAD is missing. */
-#ifdef SIGIO
- gobble_input (0);
-#endif /* SIGIO */
+#ifdef USABLE_SIGIO
+ gobble_input ();
+#endif
if (kbd_fetch_ptr != kbd_store_ptr)
break;
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
if (!NILP (do_mouse_tracking) && some_mouse_moved ())
break;
-#endif
if (end_time)
{
- EMACS_TIME duration;
- EMACS_GET_TIME (duration);
- if (EMACS_TIME_GE (duration, *end_time))
- return Qnil; /* finished waiting */
+ EMACS_TIME now = current_emacs_time ();
+ if (EMACS_TIME_LE (*end_time, now))
+ return Qnil; /* Finished waiting. */
else
{
- EMACS_SUB_TIME (duration, *end_time, duration);
- wait_reading_process_output (EMACS_SECS (duration),
- EMACS_USECS (duration),
+ EMACS_TIME duration = sub_emacs_time (*end_time, now);
+ wait_reading_process_output (min (EMACS_SECS (duration),
+ WAIT_READING_MAX),
+ EMACS_NSECS (duration),
-1, 1, Qnil, NULL, 0);
}
}
@@ -3851,8 +3784,7 @@ kbd_buffer_get_event (KBOARD **kbp,
wait_reading_process_output (0, 0, -1, 1, Qnil, NULL, 0);
if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
- /* Pass 1 for EXPECT since we just waited to have input. */
- read_avail_input (1);
+ gobble_input ();
}
if (CONSP (Vunread_command_events))
@@ -3902,7 +3834,7 @@ kbd_buffer_get_event (KBOARD **kbp,
#else
/* We're getting selection request events, but we don't have
a window system. */
- abort ();
+ emacs_abort ();
#endif
}
@@ -3962,12 +3894,14 @@ kbd_buffer_get_event (KBOARD **kbp,
x_activate_menubar (XFRAME (event->frame_or_window));
}
#endif
-#if defined (WINDOWSNT)
+#ifdef HAVE_NTGUI
else if (event->kind == LANGUAGE_CHANGE_EVENT)
{
- /* Make an event (language-change (FRAME CHARSET LCID)). */
- obj = Fcons (event->frame_or_window, Qnil);
- obj = Fcons (Qlanguage_change, Fcons (obj, Qnil));
+ /* Make an event (language-change (FRAME CODEPAGE LANGUAGE-ID)). */
+ obj = Fcons (Qlanguage_change,
+ list3 (event->frame_or_window,
+ make_number (event->code),
+ make_number (event->modifiers)));
kbd_fetch_ptr = event + 1;
}
#endif
@@ -4076,7 +4010,7 @@ kbd_buffer_get_event (KBOARD **kbp,
*used_mouse_menu = 1;
#endif
#ifdef HAVE_NS
- /* certain system events are non-key events */
+ /* Certain system events are non-key events. */
if (used_mouse_menu
&& event->kind == NS_NONKEY_EVENT)
*used_mouse_menu = 1;
@@ -4088,7 +4022,6 @@ kbd_buffer_get_event (KBOARD **kbp,
}
}
}
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
/* Try generating a mouse motion event. */
else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
{
@@ -4104,7 +4037,7 @@ kbd_buffer_get_event (KBOARD **kbp,
so x remains nil. */
x = Qnil;
- /* XXX Can f or mouse_position_hook be NULL here? */
+ /* XXX Can f or mouse_position_hook be NULL here? */
if (f && FRAME_TERMINAL (f)->mouse_position_hook)
(*FRAME_TERMINAL (f)->mouse_position_hook) (&f, 0, &bar_window,
&part, &x, &y, &t);
@@ -4133,11 +4066,10 @@ kbd_buffer_get_event (KBOARD **kbp,
if (!NILP (x) && NILP (obj))
obj = make_lispy_movement (f, bar_window, part, x, y, t);
}
-#endif /* HAVE_MOUSE || HAVE GPM */
else
/* We were promised by the above while loop that there was
something for us to read! */
- abort ();
+ emacs_abort ();
input_pending = readable_events (0);
@@ -4152,39 +4084,63 @@ kbd_buffer_get_event (KBOARD **kbp,
static void
process_special_events (void)
{
- while (kbd_fetch_ptr != kbd_store_ptr)
- {
- struct input_event *event;
+ struct input_event *event;
- event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
- ? kbd_fetch_ptr
- : kbd_buffer);
-
- last_event_timestamp = event->timestamp;
+ for (event = kbd_fetch_ptr; event != kbd_store_ptr; ++event)
+ {
+ if (event == kbd_buffer + KBD_BUFFER_SIZE)
+ {
+ event = kbd_buffer;
+ if (event == kbd_store_ptr)
+ break;
+ }
- /* These two kinds of events get special handling
- and don't actually appear to the command loop. */
+ /* If we find a stored X selection request, handle it now. */
if (event->kind == SELECTION_REQUEST_EVENT
|| event->kind == SELECTION_CLEAR_EVENT)
{
#ifdef HAVE_X11
- struct input_event copy;
- /* Remove it from the buffer before processing it,
- since otherwise swallow_events called recursively could see it
- and process it again. */
- copy = *event;
- kbd_fetch_ptr = event + 1;
+ /* Remove the event from the fifo buffer before processing;
+ otherwise swallow_events called recursively could see it
+ and process it again. To do this, we move the events
+ between kbd_fetch_ptr and EVENT one slot to the right,
+ cyclically. */
+
+ struct input_event copy = *event;
+ struct input_event *beg
+ = (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
+ ? kbd_buffer : kbd_fetch_ptr;
+
+ if (event > beg)
+ memmove (beg + 1, beg, (event - beg) * sizeof (struct input_event));
+ else if (event < beg)
+ {
+ if (event > kbd_buffer)
+ memmove (kbd_buffer + 1, kbd_buffer,
+ (event - kbd_buffer) * sizeof (struct input_event));
+ *kbd_buffer = *(kbd_buffer + KBD_BUFFER_SIZE - 1);
+ if (beg < kbd_buffer + KBD_BUFFER_SIZE - 1)
+ memmove (beg + 1, beg,
+ (kbd_buffer + KBD_BUFFER_SIZE - 1 - beg)
+ * sizeof (struct input_event));
+ }
+
+ if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
+ kbd_fetch_ptr = kbd_buffer + 1;
+ else
+ kbd_fetch_ptr++;
+
+ /* X wants last_event_timestamp for selection ownership. */
+ last_event_timestamp = copy.timestamp;
input_pending = readable_events (0);
x_handle_selection_event (&copy);
#else
/* We're getting selection request events, but we don't have
a window system. */
- abort ();
+ emacs_abort ();
#endif
}
- else
- break;
}
}
@@ -4192,14 +4148,14 @@ process_special_events (void)
are ripe, and return, without reading any user-visible events. */
void
-swallow_events (int do_display)
+swallow_events (bool do_display)
{
- int old_timers_run;
+ unsigned old_timers_run;
process_special_events ();
old_timers_run = timers_run;
- get_input_pending (&input_pending, READABLE_EVENTS_DO_TIMERS_NOW);
+ get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
if (timers_run != old_timers_run && do_display)
redisplay_preserve_echo_area (7);
@@ -4214,11 +4170,10 @@ timer_start_idle (void)
Lisp_Object timers;
/* If we are already in the idle state, do nothing. */
- if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
+ if (EMACS_TIME_VALID_P (timer_idleness_start_time))
return;
- EMACS_GET_TIME (timer_idleness_start_time);
-
+ timer_idleness_start_time = current_emacs_time ();
timer_last_idleness_start_time = timer_idleness_start_time;
/* Mark all idle-time timers as once again candidates for running. */
@@ -4228,9 +4183,9 @@ timer_start_idle (void)
timer = XCAR (timers);
- if (!VECTORP (timer) || ASIZE (timer) != 8)
+ if (!VECTORP (timer) || ASIZE (timer) != 9)
continue;
- XVECTOR (timer)->contents[0] = Qnil;
+ ASET (timer, 0, Qnil);
}
}
@@ -4239,7 +4194,7 @@ timer_start_idle (void)
static void
timer_stop_idle (void)
{
- EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
+ timer_idleness_start_time = invalid_emacs_time ();
}
/* Resume idle timer from last idle start time. */
@@ -4247,7 +4202,7 @@ timer_stop_idle (void)
static void
timer_resume_idle (void)
{
- if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
+ if (EMACS_TIME_VALID_P (timer_idleness_start_time))
return;
timer_idleness_start_time = timer_last_idleness_start_time;
@@ -4261,6 +4216,23 @@ struct input_event last_timer_event EXTERNALLY_VISIBLE;
...). Each element has the form (FUN . ARGS). */
Lisp_Object pending_funcalls;
+/* Return true if TIMER is a valid timer, placing its value into *RESULT. */
+static bool
+decode_timer (Lisp_Object timer, EMACS_TIME *result)
+{
+ Lisp_Object *vector;
+
+ if (! (VECTORP (timer) && ASIZE (timer) == 9))
+ return 0;
+ vector = XVECTOR (timer)->contents;
+ if (! NILP (vector[0]))
+ return 0;
+
+ return decode_time_components (vector[1], vector[2], vector[3], vector[8],
+ result, 0);
+}
+
+
/* Check whether a timer has fired. To prevent larger problems we simply
disregard elements that are not proper timers. Do not make a circular
timer list for the time being.
@@ -4274,26 +4246,18 @@ Lisp_Object pending_funcalls;
should be done. */
static EMACS_TIME
-timer_check_2 (void)
+timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
{
EMACS_TIME nexttime;
EMACS_TIME now;
- EMACS_TIME idleness_now IF_LINT (= {0});
- Lisp_Object timers, idle_timers, chosen_timer;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ EMACS_TIME idleness_now;
+ Lisp_Object chosen_timer;
+ struct gcpro gcpro1;
- EMACS_SET_SECS (nexttime, -1);
- EMACS_SET_USECS (nexttime, -1);
+ nexttime = invalid_emacs_time ();
- /* Always consider the ordinary timers. */
- timers = Vtimer_list;
- /* Consider the idle timers only if Emacs is idle. */
- if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
- idle_timers = Vtimer_idle_list;
- else
- idle_timers = Qnil;
chosen_timer = Qnil;
- GCPRO3 (timers, idle_timers, chosen_timer);
+ GCPRO1 (chosen_timer);
/* First run the code that was delayed. */
while (CONSP (pending_funcalls))
@@ -4305,132 +4269,97 @@ timer_check_2 (void)
if (CONSP (timers) || CONSP (idle_timers))
{
- EMACS_GET_TIME (now);
- if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
- EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
+ now = current_emacs_time ();
+ idleness_now = (EMACS_TIME_VALID_P (timer_idleness_start_time)
+ ? sub_emacs_time (now, timer_idleness_start_time)
+ : make_emacs_time (0, 0));
}
while (CONSP (timers) || CONSP (idle_timers))
{
- Lisp_Object *vector;
Lisp_Object timer = Qnil, idle_timer = Qnil;
EMACS_TIME timer_time, idle_timer_time;
EMACS_TIME difference;
- EMACS_TIME timer_difference IF_LINT (= {0});
- EMACS_TIME idle_timer_difference IF_LINT (= {0});
+ EMACS_TIME timer_difference = invalid_emacs_time ();
+ EMACS_TIME idle_timer_difference = invalid_emacs_time ();
+ bool ripe, timer_ripe = 0, idle_timer_ripe = 0;
- /* Skip past invalid timers and timers already handled. */
+ /* Set TIMER and TIMER_DIFFERENCE
+ based on the next ordinary timer.
+ TIMER_DIFFERENCE is the distance in time from NOW to when
+ this timer becomes ripe (negative if it's already ripe).
+ Skip past invalid timers and timers already handled. */
if (CONSP (timers))
{
timer = XCAR (timers);
- if (!VECTORP (timer) || ASIZE (timer) != 8)
+ if (! decode_timer (timer, &timer_time))
{
timers = XCDR (timers);
continue;
}
- vector = XVECTOR (timer)->contents;
- if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
- || !INTEGERP (vector[3])
- || ! NILP (vector[0]))
- {
- timers = XCDR (timers);
- continue;
- }
+ timer_ripe = EMACS_TIME_LE (timer_time, now);
+ timer_difference = (timer_ripe
+ ? sub_emacs_time (now, timer_time)
+ : sub_emacs_time (timer_time, now));
}
+
+ /* Likewise for IDLE_TIMER and IDLE_TIMER_DIFFERENCE
+ based on the next idle timer. */
if (CONSP (idle_timers))
{
- timer = XCAR (idle_timers);
- if (!VECTORP (timer) || ASIZE (timer) != 8)
+ idle_timer = XCAR (idle_timers);
+ if (! decode_timer (idle_timer, &idle_timer_time))
{
idle_timers = XCDR (idle_timers);
continue;
}
- vector = XVECTOR (timer)->contents;
- if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
- || !INTEGERP (vector[3])
- || ! NILP (vector[0]))
- {
- idle_timers = XCDR (idle_timers);
- continue;
- }
- }
-
- /* Set TIMER, TIMER_TIME and TIMER_DIFFERENCE
- based on the next ordinary timer.
- TIMER_DIFFERENCE is the distance in time from NOW to when
- this timer becomes ripe (negative if it's already ripe). */
- if (CONSP (timers))
- {
- timer = XCAR (timers);
- vector = XVECTOR (timer)->contents;
- EMACS_SET_SECS (timer_time,
- (XINT (vector[1]) << 16) | (XINT (vector[2])));
- EMACS_SET_USECS (timer_time, XINT (vector[3]));
- EMACS_SUB_TIME (timer_difference, timer_time, now);
- }
-
- /* Set IDLE_TIMER, IDLE_TIMER_TIME and IDLE_TIMER_DIFFERENCE
- based on the next idle timer. */
- if (CONSP (idle_timers))
- {
- idle_timer = XCAR (idle_timers);
- vector = XVECTOR (idle_timer)->contents;
- EMACS_SET_SECS (idle_timer_time,
- (XINT (vector[1]) << 16) | (XINT (vector[2])));
- EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
- EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
+ idle_timer_ripe = EMACS_TIME_LE (idle_timer_time, idleness_now);
+ idle_timer_difference =
+ (idle_timer_ripe
+ ? sub_emacs_time (idleness_now, idle_timer_time)
+ : sub_emacs_time (idle_timer_time, idleness_now));
}
/* Decide which timer is the next timer,
- and set CHOSEN_TIMER, VECTOR and DIFFERENCE accordingly.
+ and set CHOSEN_TIMER, DIFFERENCE, and RIPE accordingly.
Also step down the list where we found that timer. */
- if (CONSP (timers) && CONSP (idle_timers))
- {
- EMACS_TIME temp;
- EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
- if (EMACS_TIME_NEG_P (temp))
- {
- chosen_timer = timer;
- timers = XCDR (timers);
- difference = timer_difference;
- }
- else
- {
- chosen_timer = idle_timer;
- idle_timers = XCDR (idle_timers);
- difference = idle_timer_difference;
- }
- }
- else if (CONSP (timers))
+ if (EMACS_TIME_VALID_P (timer_difference)
+ && (! EMACS_TIME_VALID_P (idle_timer_difference)
+ || idle_timer_ripe < timer_ripe
+ || (idle_timer_ripe == timer_ripe
+ && (timer_ripe
+ ? EMACS_TIME_LT (idle_timer_difference,
+ timer_difference)
+ : EMACS_TIME_LT (timer_difference,
+ idle_timer_difference)))))
{
chosen_timer = timer;
timers = XCDR (timers);
difference = timer_difference;
+ ripe = timer_ripe;
}
else
{
chosen_timer = idle_timer;
idle_timers = XCDR (idle_timers);
difference = idle_timer_difference;
+ ripe = idle_timer_ripe;
}
- vector = XVECTOR (chosen_timer)->contents;
/* If timer is ripe, run it if it hasn't been run. */
- if (EMACS_TIME_NEG_P (difference)
- || (EMACS_SECS (difference) == 0
- && EMACS_USECS (difference) == 0))
+ if (ripe)
{
- if (NILP (vector[0]))
+ if (NILP (AREF (chosen_timer, 0)))
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object old_deactivate_mark = Vdeactivate_mark;
/* Mark the timer as triggered to prevent problems if the lisp
code fails to reschedule it right. */
- vector[0] = Qt;
+ ASET (chosen_timer, 0, Qt);
specbind (Qinhibit_quit, Qt);
@@ -4445,8 +4374,8 @@ timer_check_2 (void)
return 0 to indicate that. */
}
- EMACS_SET_SECS (nexttime, 0);
- EMACS_SET_USECS (nexttime, 0);
+ nexttime = make_emacs_time (0, 0);
+ break;
}
else
/* When we encounter a timer that is still waiting,
@@ -4469,7 +4398,7 @@ timer_check_2 (void)
timer list for the time being.
Returns the time to wait until the next timer fires.
- If no timer is active, return -1.
+ If no timer is active, return an invalid value.
As long as any timer is ripe, we run it. */
@@ -4477,39 +4406,51 @@ EMACS_TIME
timer_check (void)
{
EMACS_TIME nexttime;
+ Lisp_Object timers, idle_timers;
+ struct gcpro gcpro1, gcpro2;
+
+ Lisp_Object tem = Vinhibit_quit;
+ Vinhibit_quit = Qt;
+
+ /* We use copies of the timers' lists to allow a timer to add itself
+ again, without locking up Emacs if the newly added timer is
+ already ripe when added. */
+
+ /* Always consider the ordinary timers. */
+ timers = Fcopy_sequence (Vtimer_list);
+ /* Consider the idle timers only if Emacs is idle. */
+ if (EMACS_TIME_VALID_P (timer_idleness_start_time))
+ idle_timers = Fcopy_sequence (Vtimer_idle_list);
+ else
+ idle_timers = Qnil;
+
+ Vinhibit_quit = tem;
+
+ GCPRO2 (timers, idle_timers);
do
{
- nexttime = timer_check_2 ();
+ nexttime = timer_check_2 (timers, idle_timers);
}
- while (EMACS_SECS (nexttime) == 0 && EMACS_USECS (nexttime) == 0);
+ while (EMACS_SECS (nexttime) == 0 && EMACS_NSECS (nexttime) == 0);
+ UNGCPRO;
return nexttime;
}
DEFUN ("current-idle-time", Fcurrent_idle_time, Scurrent_idle_time, 0, 0, 0,
doc: /* Return the current length of Emacs idleness, or nil.
-The value when Emacs is idle is a list of three integers. The first has
-the most significant 16 bits of the seconds, while the second has the least
-significant 16 bits. The third integer gives the microsecond count.
+The value when Emacs is idle is a list of four integers (HIGH LOW USEC PSEC)
+in the same style as (current-time).
The value when Emacs is not idle is nil.
-The microsecond count is zero on systems that do not provide
-resolution finer than a second. */)
+PSEC is a multiple of the system clock resolution. */)
(void)
{
- if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
- {
- EMACS_TIME now, idleness_now;
-
- EMACS_GET_TIME (now);
- EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
-
- return list3 (make_number ((EMACS_SECS (idleness_now) >> 16) & 0xffff),
- make_number ((EMACS_SECS (idleness_now) >> 0) & 0xffff),
- make_number (EMACS_USECS (idleness_now)));
- }
+ if (EMACS_TIME_VALID_P (timer_idleness_start_time))
+ return make_lisp_time (sub_emacs_time (current_emacs_time (),
+ timer_idleness_start_time));
return Qnil;
}
@@ -5133,10 +5074,10 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
if (WINDOWP (window))
{
- /* It's a click in window window at frame coordinates (x,y) */
+ /* It's a click in window WINDOW at frame coordinates (X,Y) */
struct window *w = XWINDOW (window);
Lisp_Object string_info = Qnil;
- EMACS_INT textpos = -1;
+ ptrdiff_t textpos = -1;
int col = -1, row = -1;
int dx = -1, dy = -1;
int width = -1, height = -1;
@@ -5160,7 +5101,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
else if (part == ON_MODE_LINE || part == ON_HEADER_LINE)
{
Lisp_Object string;
- EMACS_INT charpos;
+ ptrdiff_t charpos;
posn = (part == ON_MODE_LINE) ? Qmode_line : Qheader_line;
/* Note that mode_line_string takes COL, ROW as pixels and
@@ -5183,7 +5124,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
{
Lisp_Object string;
- EMACS_INT charpos;
+ ptrdiff_t charpos;
posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin;
col = wx;
@@ -5317,7 +5258,7 @@ make_lispy_event (struct input_event *event)
{
int i;
- switch (SWITCH_ENUM_CAST (event->kind))
+ switch (event->kind)
{
/* A simple keystroke. */
case ASCII_KEYSTROKE_EVENT:
@@ -5405,13 +5346,13 @@ make_lispy_event (struct input_event *event)
/* We need to use an alist rather than a vector as the cache
since we can't make a vector long enough. */
if (NILP (KVAR (current_kboard, system_key_syms)))
- KVAR (current_kboard, system_key_syms) = Fcons (Qnil, Qnil);
+ kset_system_key_syms (current_kboard, Fcons (Qnil, Qnil));
return modify_event_symbol (event->code,
event->modifiers,
Qfunction_key,
KVAR (current_kboard, Vsystem_key_alist),
0, &KVAR (current_kboard, system_key_syms),
- TYPE_MAXIMUM (EMACS_INT));
+ PTRDIFF_MAX);
}
return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
@@ -5421,7 +5362,7 @@ make_lispy_event (struct input_event *event)
(sizeof (lispy_function_keys)
/ sizeof (lispy_function_keys[0])));
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
case MULTIMEDIA_KEY_EVENT:
if (event->code < (sizeof (lispy_multimedia_keys)
/ sizeof (lispy_multimedia_keys[0]))
@@ -5436,7 +5377,6 @@ make_lispy_event (struct input_event *event)
return Qnil;
#endif
-#ifdef HAVE_MOUSE
/* A mouse click. Figure out where it is, decide whether it's
a press, click or drag, and build the appropriate structure. */
case MOUSE_CLICK_EVENT:
@@ -5445,7 +5385,7 @@ make_lispy_event (struct input_event *event)
#endif
{
int button = event->code;
- int is_double;
+ bool is_double;
Lisp_Object position;
Lisp_Object *start_pos_ptr;
Lisp_Object start_pos;
@@ -5543,12 +5483,13 @@ make_lispy_event (struct input_event *event)
if (button >= ASIZE (button_down_location))
{
+ ptrdiff_t incr = button - ASIZE (button_down_location) + 1;
button_down_location = larger_vector (button_down_location,
- button + 1, Qnil);
- mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
+ incr, -1);
+ mouse_syms = larger_vector (mouse_syms, incr, -1);
}
- start_pos_ptr = &AREF (button_down_location, button);
+ start_pos_ptr = aref_addr (button_down_location, button);
start_pos = *start_pos_ptr;
*start_pos_ptr = Qnil;
@@ -5564,7 +5505,7 @@ make_lispy_event (struct input_event *event)
else if (FRAMEP (event->frame_or_window))
f = XFRAME (event->frame_or_window);
else
- abort ();
+ emacs_abort ();
if (FRAME_WINDOW_P (f))
fuzz = double_click_fuzz;
@@ -5671,7 +5612,7 @@ make_lispy_event (struct input_event *event)
else
/* Every mouse event should either have the down_modifier or
the up_modifier set. */
- abort ();
+ emacs_abort ();
{
/* Get the symbol we should use for the mouse click. */
@@ -5725,14 +5666,14 @@ make_lispy_event (struct input_event *event)
struct frame *fr;
int fuzz;
int symbol_num;
- int is_double;
+ bool is_double;
if (WINDOWP (event->frame_or_window))
fr = XFRAME (XWINDOW (event->frame_or_window)->frame);
else if (FRAMEP (event->frame_or_window))
fr = XFRAME (event->frame_or_window);
else
- abort ();
+ emacs_abort ();
fuzz = FRAME_WINDOW_P (fr)
? double_click_fuzz : double_click_fuzz / 8;
@@ -5752,7 +5693,7 @@ make_lispy_event (struct input_event *event)
else
/* Every wheel event should either have the down_modifier or
the up_modifier set. */
- abort ();
+ emacs_abort ();
if (event->kind == HORIZ_WHEEL_EVENT)
symbol_num += 2;
@@ -5845,7 +5786,9 @@ make_lispy_event (struct input_event *event)
event->modifiers &= ~up_modifier;
if (event->code >= ASIZE (mouse_syms))
- mouse_syms = larger_vector (mouse_syms, event->code + 1, Qnil);
+ mouse_syms = larger_vector (mouse_syms,
+ event->code - ASIZE (mouse_syms) + 1,
+ -1);
/* Get the symbol we should use for the mouse click. */
head = modify_event_symbol (event->code,
@@ -5885,7 +5828,6 @@ make_lispy_event (struct input_event *event)
Fcons (files,
Qnil)));
}
-#endif /* HAVE_MOUSE */
#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
|| defined (HAVE_NS) || defined (USE_GTK)
@@ -5919,7 +5861,7 @@ make_lispy_event (struct input_event *event)
{
char *name = find_user_signal_name (event->code);
if (!name)
- abort ();
+ emacs_abort ();
return intern (name);
}
@@ -5948,12 +5890,13 @@ make_lispy_event (struct input_event *event)
if (button >= ASIZE (button_down_location))
{
+ ptrdiff_t incr = button - ASIZE (button_down_location) + 1;
button_down_location = larger_vector (button_down_location,
- button + 1, Qnil);
- mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
+ incr, -1);
+ mouse_syms = larger_vector (mouse_syms, incr, -1);
}
- start_pos_ptr = &AREF (button_down_location, button);
+ start_pos_ptr = aref_addr (button_down_location, button);
start_pos = *start_pos_ptr;
position = make_lispy_position (f, event->x, event->y,
@@ -5999,12 +5942,10 @@ make_lispy_event (struct input_event *event)
/* The 'kind' field of the event is something we don't recognize. */
default:
- abort ();
+ emacs_abort ();
}
}
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
-
static Lisp_Object
make_lispy_movement (FRAME_PTR frame, Lisp_Object bar_window, enum scroll_bar_part part,
Lisp_Object x, Lisp_Object y, Time t)
@@ -6032,8 +5973,6 @@ make_lispy_movement (FRAME_PTR frame, Lisp_Object bar_window, enum scroll_bar_pa
}
}
-#endif /* HAVE_MOUSE || HAVE GPM */
-
/* Construct a switch frame event. */
static Lisp_Object
make_lispy_switch_frame (Lisp_Object frame)
@@ -6052,10 +5991,10 @@ make_lispy_switch_frame (Lisp_Object frame)
This doesn't use any caches. */
static int
-parse_modifiers_uncached (Lisp_Object symbol, EMACS_INT *modifier_end)
+parse_modifiers_uncached (Lisp_Object symbol, ptrdiff_t *modifier_end)
{
Lisp_Object name;
- EMACS_INT i;
+ ptrdiff_t i;
int modifiers;
CHECK_SYMBOL (symbol);
@@ -6063,9 +6002,9 @@ parse_modifiers_uncached (Lisp_Object symbol, EMACS_INT *modifier_end)
modifiers = 0;
name = SYMBOL_NAME (symbol);
- for (i = 0; i+2 <= SBYTES (name); )
+ for (i = 0; i < SBYTES (name) - 1; )
{
- EMACS_INT this_mod_end = 0;
+ ptrdiff_t this_mod_end = 0;
int this_mod = 0;
/* See if the name continues with a modifier word.
@@ -6105,7 +6044,7 @@ parse_modifiers_uncached (Lisp_Object symbol, EMACS_INT *modifier_end)
#define MULTI_LETTER_MOD(BIT, NAME, LEN) \
if (i + LEN + 1 <= SBYTES (name) \
- && ! strncmp (SSDATA (name) + i, NAME, LEN)) \
+ && ! memcmp (SDATA (name) + i, NAME, LEN)) \
{ \
this_mod_end = i + LEN; \
this_mod = BIT; \
@@ -6143,13 +6082,13 @@ parse_modifiers_uncached (Lisp_Object symbol, EMACS_INT *modifier_end)
if (! (modifiers & (down_modifier | drag_modifier
| double_modifier | triple_modifier))
&& i + 7 == SBYTES (name)
- && strncmp (SSDATA (name) + i, "mouse-", 6) == 0
+ && memcmp (SDATA (name) + i, "mouse-", 6) == 0
&& ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9'))
modifiers |= click_modifier;
if (! (modifiers & (double_modifier | triple_modifier))
&& i + 6 < SBYTES (name)
- && strncmp (SSDATA (name) + i, "wheel-", 6) == 0)
+ && memcmp (SDATA (name) + i, "wheel-", 6) == 0)
modifiers |= click_modifier;
if (modifier_end)
@@ -6167,8 +6106,7 @@ apply_modifiers_uncached (int modifiers, char *base, int base_len, int base_len_
/* Since BASE could contain nulls, we can't use intern here; we have
to use Fintern, which expects a genuine Lisp_String, and keeps a
reference to it. */
- char *new_mods
- = (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
+ char new_mods[sizeof "A-C-H-M-S-s-down-drag-double-triple-"];
int mod_len;
{
@@ -6177,7 +6115,7 @@ apply_modifiers_uncached (int modifiers, char *base, int base_len, int base_len_
/* Only the event queue may use the `up' modifier; it should always
be turned into a click or drag event before presented to lisp code. */
if (modifiers & up_modifier)
- abort ();
+ emacs_abort ();
if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
@@ -6229,7 +6167,7 @@ lispy_modifier_list (int modifiers)
modifier_list = Qnil;
for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
if (modifiers & (1<<i))
- modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
+ modifier_list = Fcons (AREF (modifier_symbols, i),
modifier_list);
return modifier_list;
@@ -6262,7 +6200,7 @@ parse_modifiers (Lisp_Object symbol)
return elements;
else
{
- EMACS_INT end;
+ ptrdiff_t end;
int modifiers = parse_modifiers_uncached (symbol, &end);
Lisp_Object unmodified;
Lisp_Object mask;
@@ -6272,7 +6210,7 @@ parse_modifiers (Lisp_Object symbol)
Qnil);
if (modifiers & ~INTMASK)
- abort ();
+ emacs_abort ();
XSETFASTINT (mask, modifiers);
elements = Fcons (unmodified, Fcons (mask, Qnil));
@@ -6428,9 +6366,9 @@ reorder_modifiers (Lisp_Object symbol)
in the symbol's name. */
static Lisp_Object
-modify_event_symbol (EMACS_INT symbol_num, unsigned int modifiers, Lisp_Object symbol_kind,
+modify_event_symbol (ptrdiff_t symbol_num, int modifiers, Lisp_Object symbol_kind,
Lisp_Object name_alist_or_stem, const char *const *name_table,
- Lisp_Object *symbol_table, EMACS_INT table_size)
+ Lisp_Object *symbol_table, ptrdiff_t table_size)
{
Lisp_Object value;
Lisp_Object symbol_int;
@@ -6460,7 +6398,7 @@ modify_event_symbol (EMACS_INT symbol_num, unsigned int modifiers, Lisp_Object s
*symbol_table = Fmake_vector (size, Qnil);
}
- value = XVECTOR (*symbol_table)->contents[symbol_num];
+ value = AREF (*symbol_table, symbol_num);
}
/* Have we already used this symbol before? */
@@ -6475,7 +6413,7 @@ modify_event_symbol (EMACS_INT symbol_num, unsigned int modifiers, Lisp_Object s
ptrdiff_t len = (SBYTES (name_alist_or_stem)
+ sizeof "-" + INT_STRLEN_BOUND (EMACS_INT));
USE_SAFE_ALLOCA;
- SAFE_ALLOCA (buf, char *, len);
+ buf = SAFE_ALLOCA (len);
esprintf (buf, "%s-%"pI"d", SDATA (name_alist_or_stem),
XINT (symbol_int) + 1);
value = intern (buf);
@@ -6496,14 +6434,14 @@ modify_event_symbol (EMACS_INT symbol_num, unsigned int modifiers, Lisp_Object s
if (NILP (value))
{
char buf[sizeof "key-" + INT_STRLEN_BOUND (EMACS_INT)];
- sprintf (buf, "key-%"pI"d", symbol_num);
+ sprintf (buf, "key-%"pD"d", symbol_num);
value = intern (buf);
}
if (CONSP (*symbol_table))
*symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
else
- XVECTOR (*symbol_table)->contents[symbol_num] = value;
+ ASET (*symbol_table, symbol_num, value);
/* Fill in the cache entries for this symbol; this also
builds the Qevent_symbol_elements property, which the user
@@ -6602,7 +6540,7 @@ parse_solitary_modifier (Lisp_Object symbol)
#define MULTI_LETTER_MOD(BIT, NAME, LEN) \
if (LEN == SBYTES (name) \
- && ! strncmp (SSDATA (name), NAME, LEN)) \
+ && ! memcmp (SDATA (name), NAME, LEN)) \
return BIT;
case 'A':
@@ -6665,11 +6603,11 @@ parse_solitary_modifier (Lisp_Object symbol)
return 0;
}
-/* Return 1 if EVENT is a list whose elements are all integers or symbols.
+/* Return true if EVENT is a list whose elements are all integers or symbols.
Such a list is not valid as an event,
but it can be a Lucid-style event type list. */
-int
+bool
lucid_event_type_list_p (Lisp_Object object)
{
Lisp_Object tail;
@@ -6694,8 +6632,10 @@ lucid_event_type_list_p (Lisp_Object object)
return NILP (tail);
}
-/* Store into *addr a value nonzero if terminal input chars are available.
- Serves the purpose of ioctl (0, FIONREAD, addr)
+/* Return true if terminal input chars are available.
+ Also, store the return value into INPUT_PENDING.
+
+ Serves the purpose of ioctl (0, FIONREAD, ...)
but works even if FIONREAD does not exist.
(In fact, this may actually read some input.)
@@ -6706,50 +6646,21 @@ lucid_event_type_list_p (Lisp_Object object)
If READABLE_EVENTS_IGNORE_SQUEEZABLES is set in FLAGS, ignore mouse
movements and toolkit scroll bar thumb drags. */
-static void
-get_input_pending (int *addr, int flags)
+static bool
+get_input_pending (int flags)
{
/* First of all, have we already counted some input? */
- *addr = (!NILP (Vquit_flag) || readable_events (flags));
+ input_pending = (!NILP (Vquit_flag) || readable_events (flags));
/* If input is being read as it arrives, and we have none, there is none. */
- if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
- return;
-
- /* Try to read some input and see how much we get. */
- gobble_input (0);
- *addr = (!NILP (Vquit_flag) || readable_events (flags));
-}
-
-/* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
-
-void
-gobble_input (int expected)
-{
-#ifdef SIGIO
- if (interrupt_input)
+ if (!input_pending && (!interrupt_input || interrupts_deferred))
{
- SIGMASKTYPE mask;
- mask = sigblock (sigmask (SIGIO));
- read_avail_input (expected);
- sigsetmask (mask);
+ /* Try to read some input and see how much we get. */
+ gobble_input ();
+ input_pending = (!NILP (Vquit_flag) || readable_events (flags));
}
- else
-#ifdef POLL_FOR_INPUT
- /* XXX This condition was (read_socket_hook && !interrupt_input),
- but read_socket_hook is not global anymore. Let's pretend that
- it's always set. */
- if (!interrupt_input && poll_suppress_count == 0)
- {
- SIGMASKTYPE mask;
- mask = sigblock (sigmask (SIGALRM));
- read_avail_input (expected);
- sigsetmask (mask);
- }
- else
-#endif
-#endif
- read_avail_input (expected);
+
+ return input_pending;
}
/* Put a BUFFER_SWITCH_EVENT in the buffer
@@ -6777,14 +6688,9 @@ record_asynch_buffer_change (void)
return;
/* Make sure no interrupt happens while storing the event. */
-#ifdef SIGIO
+#ifdef USABLE_SIGIO
if (interrupt_input)
- {
- SIGMASKTYPE mask;
- mask = sigblock (sigmask (SIGIO));
- kbd_buffer_store_event (&event);
- sigsetmask (mask);
- }
+ kbd_buffer_store_event (&event);
else
#endif
{
@@ -6797,21 +6703,18 @@ record_asynch_buffer_change (void)
/* Read any terminal input already buffered up by the system
into the kbd_buffer, but do not wait.
- EXPECTED should be nonzero if the caller knows there is some input.
-
- Returns the number of keyboard chars read, or -1 meaning
+ Return the number of keyboard chars read, or -1 meaning
this is a bad time to try to read input. */
-static int
-read_avail_input (int expected)
+int
+gobble_input (void)
{
int nread = 0;
- int err = 0;
+ bool err = 0;
struct terminal *t;
/* Store pending user signal events, if any. */
- if (store_user_signal_events ())
- expected = 0;
+ store_user_signal_events ();
/* Loop through the available terminals, and call their input hooks. */
t = terminal_list;
@@ -6824,15 +6727,18 @@ read_avail_input (int expected)
int nr;
struct input_event hold_quit;
+ if (input_blocked_p ())
+ {
+ pending_signals = 1;
+ break;
+ }
+
EVENT_INIT (hold_quit);
hold_quit.kind = NO_EVENT;
/* No need for FIONREAD or fcntl; just say don't wait. */
- while (nr = (*t->read_socket_hook) (t, expected, &hold_quit), nr > 0)
- {
- nread += nr;
- expected = 0;
- }
+ while (0 < (nr = (*t->read_socket_hook) (t, &hold_quit)))
+ nread += nr;
if (nr == -1) /* Not OK to read input now. */
{
@@ -6852,7 +6758,7 @@ read_avail_input (int expected)
this process rather than to the whole process
group? Perhaps on systems with FIONREAD Emacs is
alone in its group. */
- kill (getpid (), SIGHUP);
+ terminate_due_to_signal (SIGHUP, 10);
/* XXX Is calling delete_terminal safe here? It calls delete_frame. */
{
@@ -6927,7 +6833,6 @@ decode_keyboard_code (struct tty_display_info *tty,
int
tty_read_avail_input (struct terminal *terminal,
- int expected,
struct input_event *hold_quit)
{
/* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
@@ -6949,7 +6854,7 @@ tty_read_avail_input (struct terminal *terminal,
if (terminal->type != output_termcap
&& terminal->type != output_msdos_raw)
- abort ();
+ emacs_abort ();
/* XXX I think the following code should be moved to separate hook
functions in system-dependent files. */
@@ -7001,7 +6906,7 @@ tty_read_avail_input (struct terminal *terminal,
#endif /* HAVE_GPM */
/* Determine how many characters we should *try* to read. */
-#ifdef FIONREAD
+#ifdef USABLE_FIONREAD
/* Find out how much input is available. */
if (ioctl (fileno (tty->input), FIONREAD, &n_to_read) < 0)
{
@@ -7014,14 +6919,12 @@ tty_read_avail_input (struct terminal *terminal,
return 0;
if (n_to_read > sizeof cbuf)
n_to_read = sizeof cbuf;
-#else /* no FIONREAD */
-#if defined (USG) || defined (CYGWIN)
+#elif defined USG || defined CYGWIN
/* Read some input if available, but don't wait. */
n_to_read = sizeof cbuf;
- fcntl (fileno (tty->input), F_SETFL, O_NDELAY);
+ fcntl (fileno (tty->input), F_SETFL, O_NONBLOCK);
#else
- you lose;
-#endif
+# error "Cannot read without possibly delaying"
#endif
#ifdef subprocesses
@@ -7053,7 +6956,7 @@ tty_read_avail_input (struct terminal *terminal,
}
while (
/* We used to retry the read if it was interrupted.
- But this does the wrong thing when O_NDELAY causes
+ But this does the wrong thing when O_NONBLOCK causes
an EAGAIN error. Does anybody know of a situation
where a retry is actually needed? */
#if 0
@@ -7070,7 +6973,7 @@ tty_read_avail_input (struct terminal *terminal,
#endif
);
-#ifndef FIONREAD
+#ifndef USABLE_FIONREAD
#if defined (USG) || defined (CYGWIN)
fcntl (fileno (tty->input), F_SETFL, 0);
#endif /* USG or CYGWIN */
@@ -7144,78 +7047,80 @@ tty_read_avail_input (struct terminal *terminal,
static void
handle_async_input (void)
{
- interrupt_input_pending = 0;
-#ifdef SYNC_INPUT
- pending_signals = pending_atimers;
-#endif
-/* Tell ns_read_socket() it is being called asynchronously so it can avoid
- doing anything dangerous. */
-#ifdef HAVE_NS
- ++handling_signal;
-#endif
+#ifdef USABLE_SIGIO
while (1)
{
- int nread;
- nread = read_avail_input (1);
+ int nread = gobble_input ();
/* -1 means it's not ok to read the input now.
UNBLOCK_INPUT will read it later; now, avoid infinite loop.
0 means there was no keyboard input available. */
if (nread <= 0)
break;
}
-#ifdef HAVE_NS
- --handling_signal;
#endif
}
void
process_pending_signals (void)
{
- if (interrupt_input_pending)
- handle_async_input ();
+ pending_signals = 0;
+ handle_async_input ();
do_pending_atimers ();
}
-#ifdef SIGIO /* for entire page */
-/* Note SIGIO has been undef'd if FIONREAD is missing. */
+/* Undo any number of BLOCK_INPUT calls down to level LEVEL,
+ and also (if the level is now 0) reinvoke any pending signal. */
-static void
-input_available_signal (int signo)
+void
+unblock_input_to (int level)
{
- /* Must preserve main program's value of errno. */
- int old_errno = errno;
- SIGNAL_THREAD_CHECK (signo);
+ interrupt_input_blocked = level;
+ if (level == 0)
+ {
+ if (pending_signals)
+ process_pending_signals ();
+ }
+ else if (level < 0)
+ emacs_abort ();
+}
-#ifdef SYNC_INPUT
- interrupt_input_pending = 1;
- pending_signals = 1;
-#endif
+/* End critical section.
- if (input_available_clear_time)
- EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
+ If doing signal-driven input, and a signal came in when input was
+ blocked, reinvoke the signal handler now to deal with it. */
-#ifndef SYNC_INPUT
- handle_async_input ();
-#endif
+void
+unblock_input (void)
+{
+ unblock_input_to (interrupt_input_blocked - 1);
+}
+
+/* Undo any number of BLOCK_INPUT calls,
+ and also reinvoke any pending signal. */
- errno = old_errno;
+void
+totally_unblock_input (void)
+{
+ unblock_input_to (0);
}
-#endif /* SIGIO */
-/* Send ourselves a SIGIO.
+#ifdef USABLE_SIGIO
- This function exists so that the UNBLOCK_INPUT macro in
- blockinput.h can have some way to take care of input we put off
- dealing with, without assuming that every file which uses
- UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
void
-reinvoke_input_signal (void)
+handle_input_available_signal (int sig)
{
-#ifdef SIGIO
- handle_async_input ();
-#endif
+ pending_signals = 1;
+
+ if (input_available_clear_time)
+ *input_available_clear_time = make_emacs_time (0, 0);
}
+static void
+deliver_input_available_signal (int sig)
+{
+ deliver_process_signal (sig, handle_input_available_signal);
+}
+#endif /* USABLE_SIGIO */
/* User signal events. */
@@ -7240,6 +7145,7 @@ static struct user_signal_info *user_signals = NULL;
void
add_user_signal (int sig, const char *name)
{
+ struct sigaction action;
struct user_signal_info *p;
for (p = user_signals; p; p = p->next)
@@ -7247,33 +7153,31 @@ add_user_signal (int sig, const char *name)
/* Already added. */
return;
- p = xmalloc (sizeof (struct user_signal_info));
+ p = xmalloc (sizeof *p);
p->sig = sig;
p->name = xstrdup (name);
p->npending = 0;
p->next = user_signals;
user_signals = p;
- signal (sig, handle_user_signal);
+ emacs_sigaction_init (&action, deliver_user_signal);
+ sigaction (sig, &action, 0);
}
static void
handle_user_signal (int sig)
{
- int old_errno = errno;
struct user_signal_info *p;
const char *special_event_name = NULL;
- SIGNAL_THREAD_CHECK (sig);
-
if (SYMBOLP (Vdebug_on_event))
special_event_name = SSDATA (SYMBOL_NAME (Vdebug_on_event));
for (p = user_signals; p; p = p->next)
if (p->sig == sig)
{
- if (special_event_name &&
- strcmp (special_event_name, p->name) == 0)
+ if (special_event_name
+ && strcmp (special_event_name, p->name) == 0)
{
/* Enter the debugger in many ways. */
debug_on_next_call = 1;
@@ -7286,21 +7190,25 @@ handle_user_signal (int sig)
}
p->npending++;
-#ifdef SIGIO
+#ifdef USABLE_SIGIO
if (interrupt_input)
- kill (getpid (), SIGIO);
+ handle_input_available_signal (sig);
else
#endif
{
/* Tell wait_reading_process_output that it needs to wake
up and look around. */
if (input_available_clear_time)
- EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
+ *input_available_clear_time = make_emacs_time (0, 0);
}
break;
}
+}
- errno = old_errno;
+static void
+deliver_user_signal (int sig)
+{
+ deliver_process_signal (sig, handle_user_signal);
}
static char *
@@ -7315,27 +7223,24 @@ find_user_signal_name (int sig)
return NULL;
}
-static int
+static void
store_user_signal_events (void)
{
struct user_signal_info *p;
struct input_event buf;
- int nstored = 0;
+ bool buf_initialized = 0;
for (p = user_signals; p; p = p->next)
if (p->npending > 0)
{
- SIGMASKTYPE mask;
-
- if (nstored == 0)
+ if (! buf_initialized)
{
memset (&buf, 0, sizeof buf);
buf.kind = USER_SIGNAL_EVENT;
buf.frame_or_window = selected_frame;
+ buf_initialized = 1;
}
- nstored += p->npending;
- mask = sigblock (sigmask (p->sig));
do
{
buf.code = p->sig;
@@ -7343,10 +7248,7 @@ store_user_signal_events (void)
p->npending--;
}
while (p->npending > 0);
- sigsetmask (mask);
}
-
- return nstored;
}
@@ -7378,15 +7280,15 @@ static const char* separator_names[] = {
0,
};
-/* Return non-zero if LABEL specifies a separator. */
+/* Return true if LABEL specifies a separator. */
-int
+bool
menu_separator_name_p (const char *label)
{
if (!label)
return 0;
else if (strlen (label) > 3
- && strncmp (label, "--", 2) == 0
+ && memcmp (label, "--", 2) == 0
&& label[2] != '-')
{
int i;
@@ -7456,7 +7358,7 @@ menu_bar_items (Lisp_Object old)
if (!NILP (Voverriding_local_map_menu_flag))
{
/* Yes, use them (if non-nil) as well as the global map. */
- maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
+ maps = alloca (3 * sizeof (maps[0]));
nmaps = 0;
if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
@@ -7473,7 +7375,7 @@ menu_bar_items (Lisp_Object old)
Lisp_Object tem;
ptrdiff_t nminor;
nminor = current_minor_maps (NULL, &tmaps);
- maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
+ maps = alloca ((nminor + 3) * sizeof *maps);
nmaps = 0;
if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
maps[nmaps++] = tem;
@@ -7506,23 +7408,23 @@ menu_bar_items (Lisp_Object old)
int end = menu_bar_items_index;
for (i = 0; i < end; i += 4)
- if (EQ (XCAR (tail), XVECTOR (menu_bar_items_vector)->contents[i]))
+ if (EQ (XCAR (tail), AREF (menu_bar_items_vector, i)))
{
Lisp_Object tem0, tem1, tem2, tem3;
/* Move the item at index I to the end,
shifting all the others forward. */
- tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
- tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
- tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
- tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
+ tem0 = AREF (menu_bar_items_vector, i + 0);
+ tem1 = AREF (menu_bar_items_vector, i + 1);
+ tem2 = AREF (menu_bar_items_vector, i + 2);
+ tem3 = AREF (menu_bar_items_vector, i + 3);
if (end > i + 4)
- memmove (&XVECTOR (menu_bar_items_vector)->contents[i],
- &XVECTOR (menu_bar_items_vector)->contents[i + 4],
- (end - i - 4) * sizeof (Lisp_Object));
- XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
- XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
- XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
- XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
+ memmove (aref_addr (menu_bar_items_vector, i),
+ aref_addr (menu_bar_items_vector, i + 4),
+ (end - i - 4) * word_size);
+ ASET (menu_bar_items_vector, end - 4, tem0);
+ ASET (menu_bar_items_vector, end - 3, tem1);
+ ASET (menu_bar_items_vector, end - 2, tem2);
+ ASET (menu_bar_items_vector, end - 1, tem3);
break;
}
}
@@ -7532,12 +7434,12 @@ menu_bar_items (Lisp_Object old)
int i = menu_bar_items_index;
if (i + 4 > ASIZE (menu_bar_items_vector))
menu_bar_items_vector =
- larger_vector (menu_bar_items_vector, 2 * i, Qnil);
+ larger_vector (menu_bar_items_vector, 4, -1);
/* Add this item. */
- XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
- XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
- XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
- XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
+ ASET (menu_bar_items_vector, i, Qnil); i++;
+ ASET (menu_bar_items_vector, i, Qnil); i++;
+ ASET (menu_bar_items_vector, i, Qnil); i++;
+ ASET (menu_bar_items_vector, i, Qnil); i++;
menu_bar_items_index = i;
}
@@ -7555,6 +7457,7 @@ menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dumm
{
struct gcpro gcpro1;
int i;
+ bool parsed;
Lisp_Object tem;
if (EQ (item, Qundefined))
@@ -7563,12 +7466,12 @@ menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dumm
discard any previously made menu bar item. */
for (i = 0; i < menu_bar_items_index; i += 4)
- if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
+ if (EQ (key, AREF (menu_bar_items_vector, i)))
{
if (menu_bar_items_index > i + 4)
- memmove (&XVECTOR (menu_bar_items_vector)->contents[i],
- &XVECTOR (menu_bar_items_vector)->contents[i + 4],
- (menu_bar_items_index - i - 4) * sizeof (Lisp_Object));
+ memmove (aref_addr (menu_bar_items_vector, i),
+ aref_addr (menu_bar_items_vector, i + 4),
+ (menu_bar_items_index - i - 4) * word_size);
menu_bar_items_index -= 4;
}
}
@@ -7586,16 +7489,16 @@ menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dumm
parse_menu_item, so that if it turns out it wasn't a menu item,
it still correctly hides any further menu item. */
GCPRO1 (key);
- i = parse_menu_item (item, 1);
+ parsed = parse_menu_item (item, 1);
UNGCPRO;
- if (!i)
+ if (!parsed)
return;
- item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
+ item = AREF (item_properties, ITEM_PROPERTY_DEF);
/* Find any existing item for this KEY. */
for (i = 0; i < menu_bar_items_index; i += 4)
- if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
+ if (EQ (key, AREF (menu_bar_items_vector, i)))
break;
/* If we did not find this KEY, add it at the end. */
@@ -7603,24 +7506,24 @@ menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dumm
{
/* If vector is too small, get a bigger one. */
if (i + 4 > ASIZE (menu_bar_items_vector))
- menu_bar_items_vector = larger_vector (menu_bar_items_vector, 2 * i, Qnil);
+ menu_bar_items_vector = larger_vector (menu_bar_items_vector, 4, -1);
/* Add this item. */
- XVECTOR (menu_bar_items_vector)->contents[i++] = key;
- XVECTOR (menu_bar_items_vector)->contents[i++]
- = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
- XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
- XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
+ ASET (menu_bar_items_vector, i, key); i++;
+ ASET (menu_bar_items_vector, i,
+ AREF (item_properties, ITEM_PROPERTY_NAME)); i++;
+ ASET (menu_bar_items_vector, i, Fcons (item, Qnil)); i++;
+ ASET (menu_bar_items_vector, i, make_number (0)); i++;
menu_bar_items_index = i;
}
/* We did find an item for this KEY. Add ITEM to its list of maps. */
else
{
Lisp_Object old;
- old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
+ old = AREF (menu_bar_items_vector, i + 2);
/* If the new and the old items are not both keymaps,
the lookup will only find `item'. */
item = Fcons (item, KEYMAPP (item) && KEYMAPP (XCAR (old)) ? old : Qnil);
- XVECTOR (menu_bar_items_vector)->contents[i + 2] = item;
+ ASET (menu_bar_items_vector, i + 2, item);
}
}
@@ -7647,7 +7550,7 @@ eval_dyn (Lisp_Object form)
Lisp_Object
menu_item_eval_property (Lisp_Object sexpr)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object val;
specbind (Qinhibit_redisplay, Qt);
val = internal_condition_case_1 (eval_dyn, sexpr, Qerror,
@@ -7664,7 +7567,7 @@ menu_item_eval_property (Lisp_Object sexpr)
parse_menu_item returns true if the item is a menu item and false
otherwise. */
-int
+bool
parse_menu_item (Lisp_Object item, int inmenubar)
{
Lisp_Object def, tem, item_string, start;
@@ -7885,7 +7788,8 @@ parse_menu_item (Lisp_Object item, int inmenubar)
/* If the command is an alias for another
(such as lmenu.el set it up), check if the
original command matches the cached command. */
- && !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function))))
+ && !(SYMBOLP (def)
+ && EQ (tem, XSYMBOL (def)->function))))
keys = Qnil;
}
@@ -7963,7 +7867,7 @@ static Lisp_Object QCrtl;
static void init_tool_bar_items (Lisp_Object);
static void process_tool_bar_item (Lisp_Object, Lisp_Object, Lisp_Object, void*);
-static int parse_tool_bar_item (Lisp_Object, Lisp_Object);
+static bool parse_tool_bar_item (Lisp_Object, Lisp_Object);
static void append_tool_bar_item (void);
@@ -8000,7 +7904,7 @@ tool_bar_items (Lisp_Object reuse, int *nitems)
if (!NILP (Voverriding_local_map_menu_flag))
{
/* Yes, use them (if non-nil) as well as the global map. */
- maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
+ maps = alloca (3 * sizeof *maps);
nmaps = 0;
if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
@@ -8017,7 +7921,7 @@ tool_bar_items (Lisp_Object reuse, int *nitems)
Lisp_Object tem;
ptrdiff_t nminor;
nminor = current_minor_maps (NULL, &tmaps);
- maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
+ maps = alloca ((nminor + 3) * sizeof *maps);
nmaps = 0;
if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
maps[nmaps++] = tem;
@@ -8072,7 +7976,7 @@ process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void
if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
memmove (v, v + TOOL_BAR_ITEM_NSLOTS,
((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
- * sizeof (Lisp_Object)));
+ * word_size));
ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
break;
}
@@ -8086,9 +7990,17 @@ process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void
UNGCPRO;
}
+/* Access slot with index IDX of vector tool_bar_item_properties. */
+#define PROP(IDX) AREF (tool_bar_item_properties, (IDX))
+static void
+set_prop (ptrdiff_t idx, Lisp_Object val)
+{
+ ASET (tool_bar_item_properties, idx, val);
+}
+
/* Parse a tool bar item specification ITEM for key KEY and return the
- result in tool_bar_item_properties. Value is zero if ITEM is
+ result in tool_bar_item_properties. Value is false if ITEM is
invalid.
ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
@@ -8133,15 +8045,13 @@ process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void
A text label to show with the tool bar button if labels are enabled. */
-static int
+static bool
parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
{
- /* Access slot with index IDX of vector tool_bar_item_properties. */
-#define PROP(IDX) XVECTOR (tool_bar_item_properties)->contents[IDX]
-
Lisp_Object filter = Qnil;
Lisp_Object caption;
- int i, have_label = 0;
+ int i;
+ bool have_label = 0;
/* Definition looks like `(menu-item CAPTION BINDING PROPS...)'.
Rule out items that aren't lists, don't start with
@@ -8162,15 +8072,15 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
if (VECTORP (tool_bar_item_properties))
{
for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
- PROP (i) = Qnil;
+ set_prop (i, Qnil);
}
else
tool_bar_item_properties
= Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
/* Set defaults. */
- PROP (TOOL_BAR_ITEM_KEY) = key;
- PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
+ set_prop (TOOL_BAR_ITEM_KEY, key);
+ set_prop (TOOL_BAR_ITEM_ENABLED_P, Qt);
/* Get the caption of the item. If the caption is not a string,
evaluate it to get a string. If we don't get a string, skip this
@@ -8182,7 +8092,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
if (!STRINGP (caption))
return 0;
}
- PROP (TOOL_BAR_ITEM_CAPTION) = caption;
+ set_prop (TOOL_BAR_ITEM_CAPTION, caption);
/* If the rest following the caption is not a list, the menu item is
either a separator, or invalid. */
@@ -8191,7 +8101,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
{
if (menu_separator_name_p (SSDATA (caption)))
{
- PROP (TOOL_BAR_ITEM_TYPE) = Qt;
+ set_prop (TOOL_BAR_ITEM_TYPE, Qt);
#if !defined (USE_GTK) && !defined (HAVE_NS)
/* If we use build_desired_tool_bar_string to render the
tool bar, the separator is rendered as an image. */
@@ -8207,7 +8117,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
}
/* Store the binding. */
- PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item);
+ set_prop (TOOL_BAR_ITEM_BINDING, XCAR (item));
item = XCDR (item);
/* Ignore cached key binding, if any. */
@@ -8226,9 +8136,9 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
{
/* `:enable FORM'. */
if (!NILP (Venable_disabled_menus_and_buttons))
- PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
+ set_prop (TOOL_BAR_ITEM_ENABLED_P, Qt);
else
- PROP (TOOL_BAR_ITEM_ENABLED_P) = value;
+ set_prop (TOOL_BAR_ITEM_ENABLED_P, value);
}
else if (EQ (ikey, QCvisible))
{
@@ -8239,17 +8149,16 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
}
else if (EQ (ikey, QChelp))
/* `:help HELP-STRING'. */
- PROP (TOOL_BAR_ITEM_HELP) = value;
+ set_prop (TOOL_BAR_ITEM_HELP, value);
else if (EQ (ikey, QCvert_only))
/* `:vert-only t/nil'. */
- PROP (TOOL_BAR_ITEM_VERT_ONLY) = value;
+ set_prop (TOOL_BAR_ITEM_VERT_ONLY, value);
else if (EQ (ikey, QClabel))
{
const char *bad_label = "!!?GARBLED ITEM?!!";
/* `:label LABEL-STRING'. */
- PROP (TOOL_BAR_ITEM_LABEL) = STRINGP (value)
- ? value
- : build_string (bad_label);
+ set_prop (TOOL_BAR_ITEM_LABEL,
+ STRINGP (value) ? value : build_string (bad_label));
have_label = 1;
}
else if (EQ (ikey, QCfilter))
@@ -8264,8 +8173,8 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
selected = XCDR (value);
if (EQ (type, QCtoggle) || EQ (type, QCradio))
{
- PROP (TOOL_BAR_ITEM_SELECTED_P) = selected;
- PROP (TOOL_BAR_ITEM_TYPE) = type;
+ set_prop (TOOL_BAR_ITEM_SELECTED_P, selected);
+ set_prop (TOOL_BAR_ITEM_TYPE, type);
}
}
else if (EQ (ikey, QCimage)
@@ -8273,10 +8182,10 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
|| (VECTORP (value) && ASIZE (value) == 4)))
/* Value is either a single image specification or a vector
of 4 such specifications for the different button states. */
- PROP (TOOL_BAR_ITEM_IMAGES) = value;
+ set_prop (TOOL_BAR_ITEM_IMAGES, value);
else if (EQ (ikey, QCrtl))
/* ':rtl STRING' */
- PROP (TOOL_BAR_ITEM_RTL_IMAGE) = value;
+ set_prop (TOOL_BAR_ITEM_RTL_IMAGE, value);
}
@@ -8289,7 +8198,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
const char *capt = STRINGP (tcapt) ? SSDATA (tcapt) : "";
ptrdiff_t max_lbl =
2 * max (0, min (tool_bar_max_label_size, STRING_BYTES_BOUND / 2));
- char *buf = (char *) xmalloc (max_lbl + 1);
+ char *buf = xmalloc (max_lbl + 1);
Lisp_Object new_lbl;
ptrdiff_t caption_len = strlen (capt);
@@ -8318,18 +8227,19 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
new_lbl = Fupcase_initials (build_string (label));
if (SCHARS (new_lbl) <= tool_bar_max_label_size)
- PROP (TOOL_BAR_ITEM_LABEL) = new_lbl;
+ set_prop (TOOL_BAR_ITEM_LABEL, new_lbl);
else
- PROP (TOOL_BAR_ITEM_LABEL) = make_string ("", 0);
+ set_prop (TOOL_BAR_ITEM_LABEL, empty_unibyte_string);
xfree (buf);
}
/* If got a filter apply it on binding. */
if (!NILP (filter))
- PROP (TOOL_BAR_ITEM_BINDING)
- = menu_item_eval_property (list2 (filter,
- list2 (Qquote,
- PROP (TOOL_BAR_ITEM_BINDING))));
+ set_prop (TOOL_BAR_ITEM_BINDING,
+ (menu_item_eval_property
+ (list2 (filter,
+ list2 (Qquote,
+ PROP (TOOL_BAR_ITEM_BINDING))))));
/* See if the binding is a keymap. Give up if it is. */
if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
@@ -8337,13 +8247,13 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
/* Enable or disable selection of item. */
if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
- PROP (TOOL_BAR_ITEM_ENABLED_P)
- = menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P));
+ set_prop (TOOL_BAR_ITEM_ENABLED_P,
+ menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P)));
/* Handle radio buttons or toggle boxes. */
if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
- PROP (TOOL_BAR_ITEM_SELECTED_P)
- = menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P));
+ set_prop (TOOL_BAR_ITEM_SELECTED_P,
+ menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P)));
return 1;
@@ -8371,20 +8281,19 @@ init_tool_bar_items (Lisp_Object reuse)
static void
append_tool_bar_item (void)
{
- Lisp_Object *to, *from;
+ ptrdiff_t incr =
+ (ntool_bar_items
+ - (ASIZE (tool_bar_items_vector) - TOOL_BAR_ITEM_NSLOTS));
/* Enlarge tool_bar_items_vector if necessary. */
- if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS
- >= ASIZE (tool_bar_items_vector))
+ if (0 < incr)
tool_bar_items_vector
- = larger_vector (tool_bar_items_vector,
- 2 * ASIZE (tool_bar_items_vector), Qnil);
+ = larger_vector (tool_bar_items_vector, incr, -1);
/* Append entries from tool_bar_item_properties to the end of
tool_bar_items_vector. */
- to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items;
- from = XVECTOR (tool_bar_item_properties)->contents;
- memcpy (to, from, TOOL_BAR_ITEM_NSLOTS * sizeof *to);
+ vcopy (tool_bar_items_vector, ntool_bar_items,
+ XVECTOR (tool_bar_item_properties)->contents, TOOL_BAR_ITEM_NSLOTS);
ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
}
@@ -8399,9 +8308,9 @@ append_tool_bar_item (void)
PREV_EVENT is the previous input event, or nil if we are reading
the first event of a key sequence.
- If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
- if we used a mouse menu to read the input, or zero otherwise. If
- USED_MOUSE_MENU is null, we don't dereference it.
+ If USED_MOUSE_MENU is non-null, set *USED_MOUSE_MENU to true
+ if we used a mouse menu to read the input, or false otherwise. If
+ USED_MOUSE_MENU is null, don't dereference it.
The prompting is done based on the prompt-string of the map
and the strings associated with various map elements.
@@ -8414,9 +8323,11 @@ append_tool_bar_item (void)
static Lisp_Object
read_char_x_menu_prompt (ptrdiff_t nmaps, Lisp_Object *maps,
- Lisp_Object prev_event, int *used_mouse_menu)
+ Lisp_Object prev_event, bool *used_mouse_menu)
{
+#ifdef HAVE_MENUS
ptrdiff_t mapno;
+#endif
if (used_mouse_menu)
*used_mouse_menu = 0;
@@ -8441,8 +8352,7 @@ read_char_x_menu_prompt (ptrdiff_t nmaps, Lisp_Object *maps,
&& !EQ (XCAR (prev_event), Qtool_bar))
{
/* Display the menu and get the selection. */
- Lisp_Object *realmaps
- = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
+ Lisp_Object *realmaps = alloca (nmaps * sizeof *realmaps);
Lisp_Object value;
ptrdiff_t nmaps1 = 0;
@@ -8507,7 +8417,7 @@ read_char_minibuf_menu_prompt (int commandflag,
/* FIXME: Use the minibuffer's frame width. */
ptrdiff_t width = FRAME_COLS (SELECTED_FRAME ()) - 4;
ptrdiff_t idx = -1;
- int nobindings = 1;
+ bool nobindings = 1;
Lisp_Object rest, vector;
char *menu;
@@ -8536,7 +8446,7 @@ read_char_minibuf_menu_prompt (int commandflag,
if (width + 4 > read_char_minibuf_menu_width)
{
read_char_minibuf_menu_text
- = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
+ = xrealloc (read_char_minibuf_menu_text, width + 4);
read_char_minibuf_menu_width = width + 4;
}
menu = read_char_minibuf_menu_text;
@@ -8555,7 +8465,7 @@ read_char_minibuf_menu_prompt (int commandflag,
/* Present the documented bindings, a line at a time. */
while (1)
{
- int notfirst = 0;
+ bool notfirst = 0;
ptrdiff_t i = nlength;
Lisp_Object obj;
Lisp_Object orig_defn_macro;
@@ -8581,7 +8491,7 @@ read_char_minibuf_menu_prompt (int commandflag,
/* Look at the next element of the map. */
if (idx >= 0)
- elt = XVECTOR (vector)->contents[idx];
+ elt = AREF (vector, idx);
else
elt = Fcar_safe (rest);
@@ -8611,12 +8521,12 @@ read_char_minibuf_menu_prompt (int commandflag,
/* Ignore the element if it has no prompt string. */
if (INTEGERP (event) && parse_menu_item (elt, -1))
{
- /* 1 if the char to type matches the string. */
- int char_matches;
+ /* True if the char to type matches the string. */
+ bool char_matches;
Lisp_Object upcased_event, downcased_event;
Lisp_Object desc = Qnil;
Lisp_Object s
- = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
+ = AREF (item_properties, ITEM_PROPERTY_NAME);
upcased_event = Fupcase (event);
downcased_event = Fdowncase (event);
@@ -8634,12 +8544,12 @@ read_char_minibuf_menu_prompt (int commandflag,
s = concat2 (s, tem);
#endif
tem
- = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
+ = AREF (item_properties, ITEM_PROPERTY_TYPE);
if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
{
/* Insert button prefix. */
Lisp_Object selected
- = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
+ = AREF (item_properties, ITEM_PROPERTY_SELECTED);
if (EQ (tem, QCradio))
tem = build_string (NILP (selected) ? "(*) " : "( ) ");
else
@@ -8664,7 +8574,7 @@ read_char_minibuf_menu_prompt (int commandflag,
i += 2;
}
notfirst = 1;
- nobindings = 0 ;
+ nobindings = 0;
/* If the char to type doesn't match the string's
first char, explicitly show what char to type. */
@@ -8713,11 +8623,11 @@ read_char_minibuf_menu_prompt (int commandflag,
is not used on replay.
*/
orig_defn_macro = KVAR (current_kboard, defining_kbd_macro);
- KVAR (current_kboard, defining_kbd_macro) = Qnil;
+ kset_defining_kbd_macro (current_kboard, Qnil);
do
obj = read_char (commandflag, 0, 0, Qt, 0, NULL);
while (BUFFERP (obj));
- KVAR (current_kboard, defining_kbd_macro) = orig_defn_macro;
+ kset_defining_kbd_macro (current_kboard, orig_defn_macro);
if (!INTEGERP (obj))
return obj;
@@ -8798,36 +8708,30 @@ typedef struct keyremap
/* Lookup KEY in MAP.
MAP is a keymap mapping keys to key vectors or functions.
- If the mapping is a function and DO_FUNCTION is non-zero, then
+ If the mapping is a function and DO_FUNCALL is true,
the function is called with PROMPT as parameter and its return
value is used as the return value of this function (after checking
that it is indeed a vector). */
static Lisp_Object
access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
- int do_funcall)
+ bool do_funcall)
{
Lisp_Object next;
next = access_keymap (map, key, 1, 0, 1);
- /* Handle symbol with autoload definition. */
- if (SYMBOLP (next) && !NILP (Ffboundp (next))
- && CONSP (XSYMBOL (next)->function)
- && EQ (XCAR (XSYMBOL (next)->function), Qautoload))
- do_autoload (XSYMBOL (next)->function, next);
-
/* Handle a symbol whose function definition is a keymap
or an array. */
if (SYMBOLP (next) && !NILP (Ffboundp (next))
&& (ARRAYP (XSYMBOL (next)->function)
|| KEYMAPP (XSYMBOL (next)->function)))
- next = XSYMBOL (next)->function;
+ next = Fautoload_do_load (XSYMBOL (next)->function, next, Qnil);
/* If the keymap gives a function, not an
array, then call the function with one arg and use
its value instead. */
- if (SYMBOLP (next) && !NILP (Ffboundp (next)) && do_funcall)
+ if (do_funcall && FUNCTIONP (next))
{
Lisp_Object tem;
tem = next;
@@ -8850,15 +8754,15 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
BUFSIZE is its maximum size.
FKEY is a pointer to the keyremap structure to use.
INPUT is the index of the last element in KEYBUF.
- DOIT if non-zero says that the remapping can actually take place.
+ DOIT if true says that the remapping can actually take place.
DIFF is used to return the number of keys added/removed by the remapping.
PARENT is the root of the keymap.
PROMPT is the prompt to use if the remapping happens through a function.
- The return value is non-zero if the remapping actually took place. */
+ Return true if the remapping actually took place. */
-static int
+static bool
keyremap_step (Lisp_Object *keybuf, int bufsize, volatile keyremap *fkey,
- int input, int doit, int *diff, Lisp_Object prompt)
+ int input, bool doit, int *diff, Lisp_Object prompt)
{
Lisp_Object next, key;
@@ -8912,7 +8816,7 @@ keyremap_step (Lisp_Object *keybuf, int bufsize, volatile keyremap *fkey,
return 0;
}
-static int
+static bool
test_undefined (Lisp_Object binding)
{
return (EQ (binding, Qundefined)
@@ -8954,24 +8858,24 @@ test_undefined (Lisp_Object binding)
off the switch-frame event until later; the next call to
read_char will return it.
- If FIX_CURRENT_BUFFER is nonzero, we restore current_buffer
+ If FIX_CURRENT_BUFFER, we restore current_buffer
from the selected window's buffer. */
static int
read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
- int dont_downcase_last, int can_return_switch_frame,
- int fix_current_buffer)
+ bool dont_downcase_last, bool can_return_switch_frame,
+ bool fix_current_buffer)
{
Lisp_Object from_string;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* How many keys there are in the current key sequence. */
int t;
/* The length of the echo buffer when we started reading, and
the length of this_command_keys when we started reading. */
- int echo_start IF_LINT (= 0);
- int keys_start;
+ ptrdiff_t echo_start IF_LINT (= 0);
+ ptrdiff_t keys_start;
/* The number of keymaps we're scanning right now, and the number of
keymaps we have allocated space for. */
@@ -8993,7 +8897,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
key sequence. */
Lisp_Object orig_keymap;
- /* 1 if we have already considered switching to the local-map property
+ /* Positive if we have already considered switching to the local-map property
of the place where a mouse click occurred. */
int localized_local_map = 0;
@@ -9033,10 +8937,10 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
/* Likewise, for key_translation_map and input-decode-map. */
keyremap keytran, indec;
- /* Non-zero if we are trying to map a key by changing an upper-case
+ /* True if we are trying to map a key by changing an upper-case
letter to lower case, or a shifted function key to an unshifted
one. */
- int shift_translated = 0;
+ bool shift_translated = 0;
/* If we receive a `switch-frame' or `select-window' event in the middle of
a key sequence, we put it off for later.
@@ -9052,7 +8956,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
int original_uppercase_position = -1;
/* Gets around Microsoft compiler limitations. */
- int dummyflag = 0;
+ bool dummyflag = 0;
struct buffer *starting_buffer;
@@ -9079,7 +8983,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
/* Install the string STR as the beginning of the string of
echoing, so that it serves as a prompt for the next
character. */
- KVAR (current_kboard, echo_string) = prompt;
+ kset_echo_string (current_kboard, prompt);
current_kboard->echo_after_prompt = SCHARS (prompt);
echo_now ();
}
@@ -9143,8 +9047,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
{
if (2 > nmaps_allocated)
{
- submaps = (Lisp_Object *) alloca (2 * sizeof (submaps[0]));
- defs = (Lisp_Object *) alloca (2 * sizeof (defs[0]));
+ submaps = alloca (2 * sizeof *submaps);
+ defs = alloca (2 * sizeof *defs);
nmaps_allocated = 2;
}
submaps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
@@ -9153,8 +9057,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
{
if (2 > nmaps_allocated)
{
- submaps = (Lisp_Object *) alloca (2 * sizeof (submaps[0]));
- defs = (Lisp_Object *) alloca (2 * sizeof (defs[0]));
+ submaps = alloca (2 * sizeof *submaps);
+ defs = alloca (2 * sizeof *defs);
nmaps_allocated = 2;
}
submaps[nmaps++] = Voverriding_local_map;
@@ -9170,8 +9074,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
if (total > nmaps_allocated)
{
- submaps = (Lisp_Object *) alloca (total * sizeof (submaps[0]));
- defs = (Lisp_Object *) alloca (total * sizeof (defs[0]));
+ submaps = alloca (total * sizeof *submaps);
+ defs = alloca (total * sizeof *defs);
nmaps_allocated = total;
}
@@ -9214,7 +9118,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
: (/* indec.start < t || fkey.start < t || */ keytran.start < t))
{
Lisp_Object key;
- int used_mouse_menu = 0;
+ bool used_mouse_menu = 0;
/* Where the last real key started. If we need to throw away a
key that has expanded into more than one element of keybuf
@@ -9227,7 +9131,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
while those allow us to restart the entire key sequence,
echo_local_start and keys_local_start allow us to throw away
just one key. */
- int echo_local_start IF_LINT (= 0);
+ ptrdiff_t echo_local_start IF_LINT (= 0);
int keys_local_start;
ptrdiff_t local_first_binding;
@@ -9308,7 +9212,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
return. Any better way to fix this? -- cyd */
|| (interrupted_kboard != current_kboard))
{
- int found = 0;
+ bool found = 0;
struct kboard *k;
for (k = all_kboards; k; k = k->next_kboard)
@@ -9325,15 +9229,17 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
if (!NILP (delayed_switch_frame))
{
- KVAR (interrupted_kboard, kbd_queue)
- = Fcons (delayed_switch_frame,
- KVAR (interrupted_kboard, kbd_queue));
+ kset_kbd_queue
+ (interrupted_kboard,
+ Fcons (delayed_switch_frame,
+ KVAR (interrupted_kboard, kbd_queue)));
delayed_switch_frame = Qnil;
}
while (t > 0)
- KVAR (interrupted_kboard, kbd_queue)
- = Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue));
+ kset_kbd_queue
+ (interrupted_kboard,
+ Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue)));
/* If the side queue is non-empty, ensure it begins with a
switch-frame, so we'll replay it in the right context. */
@@ -9345,9 +9251,10 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
{
Lisp_Object frame;
XSETFRAME (frame, interrupted_frame);
- KVAR (interrupted_kboard, kbd_queue)
- = Fcons (make_lispy_switch_frame (frame),
- KVAR (interrupted_kboard, kbd_queue));
+ kset_kbd_queue
+ (interrupted_kboard,
+ Fcons (make_lispy_switch_frame (frame),
+ KVAR (interrupted_kboard, kbd_queue)));
}
mock_input = 0;
orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
@@ -9409,7 +9316,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
&& current_buffer != starting_buffer)
{
GROW_RAW_KEYBUF;
- XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
+ ASET (raw_keybuf, raw_keybuf_count, key);
+ raw_keybuf_count++;
keybuf[t++] = key;
mock_input = t;
Vquit_flag = Qnil;
@@ -9487,7 +9395,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
&& BUFFERP (XWINDOW (window)->buffer)
&& XBUFFER (XWINDOW (window)->buffer) != current_buffer)
{
- XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
+ ASET (raw_keybuf, raw_keybuf_count, key);
+ raw_keybuf_count++;
keybuf[t] = key;
mock_input = t + 1;
@@ -9501,7 +9410,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
because we may get input from a subprocess which
wants to change the selected window and stuff (say,
emacsclient). */
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
if (! FRAME_LIVE_P (XFRAME (selected_frame)))
Fkill_emacs (Qnil);
@@ -9857,7 +9766,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
while (indec.end < t)
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int done, diff;
+ bool done;
+ int diff;
GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
done = keyremap_step (keybuf, bufsize, &indec, max (t, mock_input),
@@ -9891,7 +9801,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
while (fkey.end < indec.start)
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int done, diff;
+ bool done;
+ int diff;
GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
done = keyremap_step (keybuf, bufsize, &fkey,
@@ -9920,7 +9831,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
while (keytran.end < fkey.start)
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int done, diff;
+ bool done;
+ int diff;
GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
done = keyremap_step (keybuf, bufsize, &keytran, max (t, mock_input),
@@ -10115,7 +10027,7 @@ will read just one key sequence. */)
Lisp_Object keybuf[30];
register int i;
struct gcpro gcpro1;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (!NILP (prompt))
CHECK_STRING (prompt);
@@ -10172,7 +10084,7 @@ DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
Lisp_Object keybuf[30];
register int i;
struct gcpro gcpro1;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (!NILP (prompt))
CHECK_STRING (prompt);
@@ -10185,7 +10097,7 @@ DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
memset (keybuf, 0, sizeof keybuf);
GCPRO1 (keybuf[0]);
- gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
+ gcpro1.nvars = (sizeof keybuf / sizeof (keybuf[0]));
if (NILP (continue_echo))
{
@@ -10199,7 +10111,7 @@ DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
cancel_hourglass ();
#endif
- i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
+ i = read_key_sequence (keybuf, (sizeof keybuf / sizeof (keybuf[0])),
prompt, ! NILP (dont_downcase_last),
! NILP (can_return_switch_frame), 0);
@@ -10239,7 +10151,7 @@ a special event, so ignore the prefix argument and don't clear it. */)
{
prefixarg = KVAR (current_kboard, Vprefix_arg);
Vcurrent_prefix_arg = prefixarg;
- KVAR (current_kboard, Vprefix_arg) = Qnil;
+ kset_prefix_arg (current_kboard, Qnil);
}
else
prefixarg = Qnil;
@@ -10264,7 +10176,7 @@ a special event, so ignore the prefix argument and don't clear it. */)
struct gcpro gcpro1, gcpro2;
GCPRO2 (cmd, prefixarg);
- do_autoload (final, cmd);
+ Fautoload_do_load (final, cmd, Qnil);
UNGCPRO;
}
else
@@ -10306,178 +10218,32 @@ a special event, so ignore the prefix argument and don't clear it. */)
-DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
- 1, 1, "P",
- doc: /* Read function name, then read its arguments and call it.
-
-To pass a numeric argument to the command you are invoking with, specify
-the numeric argument to this command.
-
-Noninteractively, the argument PREFIXARG is the prefix argument to
-give to the command you invoke, if it asks for an argument. */)
- (Lisp_Object prefixarg)
-{
- Lisp_Object function;
- EMACS_INT saved_last_point_position;
- Lisp_Object saved_keys, saved_last_point_position_buffer;
- Lisp_Object bindings, value;
- struct gcpro gcpro1, gcpro2, gcpro3;
-#ifdef HAVE_WINDOW_SYSTEM
- /* The call to Fcompleting_read will start and cancel the hourglass,
- but if the hourglass was already scheduled, this means that no
- hourglass will be shown for the actual M-x command itself.
- So we restart it if it is already scheduled. Note that checking
- hourglass_shown_p is not enough, normally the hourglass is not shown,
- just scheduled to be shown. */
- int hstarted = hourglass_started ();
-#endif
-
- saved_keys = Fvector (this_command_key_count,
- XVECTOR (this_command_keys)->contents);
- saved_last_point_position_buffer = last_point_position_buffer;
- saved_last_point_position = last_point_position;
- GCPRO3 (saved_keys, prefixarg, saved_last_point_position_buffer);
-
- function = call0 (intern ("read-extended-command"));
-
-#ifdef HAVE_WINDOW_SYSTEM
- if (hstarted) start_hourglass ();
-#endif
-
- if (STRINGP (function) && SCHARS (function) == 0)
- error ("No command name given");
-
- /* Set this_command_keys to the concatenation of saved_keys and
- function, followed by a RET. */
- {
- Lisp_Object *keys;
- int i;
-
- this_command_key_count = 0;
- this_command_key_count_reset = 0;
- this_single_command_key_start = 0;
-
- keys = XVECTOR (saved_keys)->contents;
- for (i = 0; i < ASIZE (saved_keys); i++)
- add_command_key (keys[i]);
-
- for (i = 0; i < SCHARS (function); i++)
- add_command_key (Faref (function, make_number (i)));
-
- add_command_key (make_number ('\015'));
- }
-
- last_point_position = saved_last_point_position;
- last_point_position_buffer = saved_last_point_position_buffer;
-
- UNGCPRO;
-
- function = Fintern (function, Qnil);
- KVAR (current_kboard, Vprefix_arg) = prefixarg;
- Vthis_command = function;
- real_this_command = function;
-
- /* If enabled, show which key runs this command. */
- if (!NILP (Vsuggest_key_bindings)
- && NILP (Vexecuting_kbd_macro)
- && SYMBOLP (function))
- bindings = Fwhere_is_internal (function, Voverriding_local_map,
- Qt, Qnil, Qnil);
- else
- bindings = Qnil;
-
- value = Qnil;
- GCPRO3 (bindings, value, function);
- value = Fcommand_execute (function, Qt, Qnil, Qnil);
-
- /* If the command has a key binding, print it now. */
- if (!NILP (bindings)
- && ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)),
- Qmouse_movement)))
- {
- /* But first wait, and skip the message if there is input. */
- Lisp_Object waited;
-
- /* If this command displayed something in the echo area;
- wait a few seconds, then display our suggestion message. */
- if (NILP (echo_area_buffer[0]))
- waited = sit_for (make_number (0), 0, 2);
- else if (NUMBERP (Vsuggest_key_bindings))
- waited = sit_for (Vsuggest_key_bindings, 0, 2);
- else
- waited = sit_for (make_number (2), 0, 2);
-
- if (!NILP (waited) && ! CONSP (Vunread_command_events))
- {
- Lisp_Object binding;
- char *newmessage;
- int message_p = push_message ();
- int count = SPECPDL_INDEX ();
- ptrdiff_t newmessage_len, newmessage_alloc;
- USE_SAFE_ALLOCA;
-
- record_unwind_protect (pop_message_unwind, Qnil);
- binding = Fkey_description (bindings, Qnil);
- newmessage_alloc =
- (sizeof "You can run the command `' with "
- + SBYTES (SYMBOL_NAME (function)) + SBYTES (binding));
- SAFE_ALLOCA (newmessage, char *, newmessage_alloc);
- newmessage_len =
- esprintf (newmessage, "You can run the command `%s' with %s",
- SDATA (SYMBOL_NAME (function)),
- SDATA (binding));
- message2 (newmessage,
- newmessage_len,
- STRING_MULTIBYTE (binding));
- if (NUMBERP (Vsuggest_key_bindings))
- waited = sit_for (Vsuggest_key_bindings, 0, 2);
- else
- waited = sit_for (make_number (2), 0, 2);
-
- if (!NILP (waited) && message_p)
- restore_message ();
-
- SAFE_FREE ();
- unbind_to (count, Qnil);
- }
- }
-
- RETURN_UNGCPRO (value);
-}
-
-
-/* Return nonzero if input events are pending. */
+/* Return true if input events are pending. */
-int
+bool
detect_input_pending (void)
{
- if (!input_pending)
- get_input_pending (&input_pending, 0);
-
- return input_pending;
+ return input_pending || get_input_pending (0);
}
-/* Return nonzero if input events other than mouse movements are
+/* Return true if input events other than mouse movements are
pending. */
-int
+bool
detect_input_pending_ignore_squeezables (void)
{
- if (!input_pending)
- get_input_pending (&input_pending, READABLE_EVENTS_IGNORE_SQUEEZABLES);
-
- return input_pending;
+ return input_pending || get_input_pending (READABLE_EVENTS_IGNORE_SQUEEZABLES);
}
-/* Return nonzero if input events are pending, and run any pending timers. */
+/* Return true if input events are pending, and run any pending timers. */
-int
-detect_input_pending_run_timers (int do_display)
+bool
+detect_input_pending_run_timers (bool do_display)
{
- int old_timers_run = timers_run;
+ unsigned old_timers_run = timers_run;
if (!input_pending)
- get_input_pending (&input_pending, READABLE_EVENTS_DO_TIMERS_NOW);
+ get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
if (old_timers_run != timers_run && do_display)
{
@@ -10508,16 +10274,16 @@ clear_input_pending (void)
input_pending = 0;
}
-/* Return nonzero if there are pending requeued events.
+/* Return true if there are pending requeued events.
This isn't used yet. The hope is to make wait_reading_process_output
call it, and return if it runs Lisp code that unreads something.
The problem is, kbd_buffer_get_event needs to be fixed to know what
to do in that case. It isn't trivial. */
-int
+bool
requeued_events_pending_p (void)
{
- return (!NILP (Vunread_command_events) || unread_command_char != -1);
+ return (!NILP (Vunread_command_events));
}
@@ -10527,7 +10293,7 @@ Actually, the value is nil only if we can be sure that no input is available;
if there is a doubt, the value is t. */)
(void)
{
- if (!NILP (Vunread_command_events) || unread_command_char != -1
+ if (!NILP (Vunread_command_events)
|| !NILP (Vunread_post_input_method_events)
|| !NILP (Vunread_input_method_events))
return (Qt);
@@ -10535,10 +10301,9 @@ if there is a doubt, the value is t. */)
/* Process non-user-visible events (Bug#10195). */
process_special_events ();
- get_input_pending (&input_pending,
- READABLE_EVENTS_DO_TIMERS_NOW
- | READABLE_EVENTS_FILTER_EVENTS);
- return input_pending > 0 ? Qt : Qnil;
+ return (get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW
+ | READABLE_EVENTS_FILTER_EVENTS)
+ ? Qt : Qnil);
}
DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
@@ -10553,10 +10318,10 @@ DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
else
{
val = Fvector (NUM_RECENT_KEYS, keys);
- memcpy (XVECTOR (val)->contents, keys + recent_keys_index,
- (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
- memcpy (XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
- keys, recent_keys_index * sizeof (Lisp_Object));
+ vcopy (val, 0, keys + recent_keys_index,
+ NUM_RECENT_KEYS - recent_keys_index);
+ vcopy (val, NUM_RECENT_KEYS - recent_keys_index,
+ keys, recent_keys_index);
return val;
}
}
@@ -10658,7 +10423,7 @@ KEEP-RECORD is non-nil. */)
if (NILP (keep_record))
{
for (i = 0; i < ASIZE (recent_keys); ++i)
- XVECTOR (recent_keys)->contents[i] = Qnil;
+ ASET (recent_keys, i, Qnil);
total_keys = 0;
recent_keys_index = 0;
}
@@ -10685,9 +10450,9 @@ The file will be closed when Emacs exits. */)
{
if (dribble)
{
- BLOCK_INPUT;
+ block_input ();
fclose (dribble);
- UNBLOCK_INPUT;
+ unblock_input ();
dribble = 0;
}
if (!NILP (file))
@@ -10715,7 +10480,6 @@ Also end any kbd macro being defined. */)
update_mode_lines++;
Vunread_command_events = Qnil;
- unread_command_char = -1;
discard_tty_input ();
@@ -10740,7 +10504,7 @@ Some operating systems cannot stop the Emacs process and resume it later.
On such systems, Emacs starts a subshell instead of suspending. */)
(Lisp_Object stuffstring)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int old_height, old_width;
int width, height;
struct gcpro gcpro1;
@@ -10796,7 +10560,7 @@ stuff_buffered_input (Lisp_Object stuffstring)
if (STRINGP (stuffstring))
{
- register EMACS_INT count;
+ register ptrdiff_t count;
p = SDATA (stuffstring);
count = SBYTES (stuffstring);
@@ -10827,7 +10591,7 @@ stuff_buffered_input (Lisp_Object stuffstring)
}
void
-set_waiting_for_input (struct timeval *time_to_clear)
+set_waiting_for_input (EMACS_TIME *time_to_clear)
{
input_available_clear_time = time_to_clear;
@@ -10855,17 +10619,10 @@ clear_waiting_for_input (void)
Otherwise, tell QUIT to kill Emacs. */
static void
-interrupt_signal (int signalnum) /* If we don't have an argument, some */
- /* compilers complain in signal calls. */
+handle_interrupt_signal (int sig)
{
- /* Must preserve main program's value of errno. */
- int old_errno = errno;
- struct terminal *terminal;
-
- SIGNAL_THREAD_CHECK (signalnum);
-
/* See if we have an active terminal on our controlling tty. */
- terminal = get_named_tty ("/dev/tty");
+ struct terminal *terminal = get_named_tty ("/dev/tty");
if (!terminal)
{
/* If there are no frames there, let's pretend that we are a
@@ -10884,12 +10641,22 @@ interrupt_signal (int signalnum) /* If we don't have an argument, some */
from the controlling tty. */
internal_last_event_frame = terminal->display_info.tty->top_frame;
- handle_interrupt ();
+ handle_interrupt (1);
}
+}
- errno = old_errno;
+static void
+deliver_interrupt_signal (int sig)
+{
+ deliver_process_signal (sig, handle_interrupt_signal);
}
+
+/* If Emacs is stuck because `inhibit-quit' is true, then keep track
+ of the number of times C-g has been requested. If C-g is pressed
+ enough times, then quit anyway. See bug#6585. */
+static int volatile force_quit_count;
+
/* This routine is called at interrupt level in response to C-g.
It is called from the SIGINT handler or kbd_buffer_store_event.
@@ -10902,7 +10669,7 @@ interrupt_signal (int signalnum) /* If we don't have an argument, some */
non-nil, it stops the job right away. */
static void
-handle_interrupt (void)
+handle_interrupt (bool in_signal_handler)
{
char c;
@@ -10911,10 +10678,16 @@ handle_interrupt (void)
/* XXX This code needs to be revised for multi-tty support. */
if (!NILP (Vquit_flag) && get_named_tty ("/dev/tty"))
{
- /* If SIGINT isn't blocked, don't let us be interrupted by
- another SIGINT, it might be harmful due to non-reentrancy
- in I/O functions. */
- sigblock (sigmask (SIGINT));
+ if (! in_signal_handler)
+ {
+ /* If SIGINT isn't blocked, don't let us be interrupted by
+ a SIGINT. It might be harmful due to non-reentrancy
+ in I/O functions. */
+ sigset_t blocked;
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGINT);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
+ }
fflush (stdout);
reset_all_sys_modes ();
@@ -10976,7 +10749,7 @@ handle_interrupt (void)
#endif /* not MSDOS */
fflush (stdout);
if (((c = getchar ()) & ~040) == 'Y')
- abort ();
+ emacs_abort ();
while (c != '\n') c = getchar ();
#ifdef MSDOS
printf ("\r\nContinuing...\r\n");
@@ -10985,7 +10758,6 @@ handle_interrupt (void)
#endif /* not MSDOS */
fflush (stdout);
init_all_sys_modes ();
- sigfree ();
}
else
{
@@ -10998,20 +10770,29 @@ handle_interrupt (void)
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
immediate_quit = 0;
- sigfree ();
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
saved = gl_state;
GCPRO4 (saved.object, saved.global_code,
saved.current_syntax_table, saved.old_prop);
Fsignal (Qquit, Qnil);
- /* FIXME: AFAIK, `quit' can never return, so this code is dead! */
gl_state = saved;
UNGCPRO;
}
else
- /* Else request quit when it's safe */
- Vquit_flag = Qt;
+ { /* Else request quit when it's safe. */
+ int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
+ force_quit_count = count;
+ if (count == 3)
+ {
+ immediate_quit = 1;
+ Vinhibit_quit = Qnil;
+ }
+ Vquit_flag = Qt;
+ }
}
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
+
/* TODO: The longjmp in this call throws the NS event loop integration off,
and it seems to do fine without this. Probably some attention
needs to be paid to the setting of waiting_for_input in
@@ -11021,43 +10802,32 @@ handle_interrupt (void)
separate event loop thread like W32. */
#ifndef HAVE_NS
if (waiting_for_input && !echoing)
- quit_throw_to_read_char (1);
+ quit_throw_to_read_char (in_signal_handler);
#endif
}
/* Handle a C-g by making read_char return C-g. */
static void
-quit_throw_to_read_char (int from_signal)
+quit_throw_to_read_char (bool from_signal)
{
/* When not called from a signal handler it is safe to call
Lisp. */
if (!from_signal && EQ (Vquit_flag, Qkill_emacs))
Fkill_emacs (Qnil);
- sigfree ();
/* Prevent another signal from doing this before we finish. */
clear_waiting_for_input ();
input_pending = 0;
Vunread_command_events = Qnil;
- unread_command_char = -1;
-#if 0 /* Currently, sit_for is called from read_char without turning
- off polling. And that can call set_waiting_for_input.
- It seems to be harmless. */
-#ifdef POLL_FOR_INPUT
- /* May be > 1 if in recursive minibuffer. */
- if (poll_suppress_count == 0)
- abort ();
-#endif
-#endif
if (FRAMEP (internal_last_event_frame)
&& !EQ (internal_last_event_frame, selected_frame))
do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
0, 0, Qnil);
- _longjmp (getcjmp, 1);
+ sys_longjmp (getcjmp, 1);
}
DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,
@@ -11069,9 +10839,8 @@ otherwise Emacs uses CBREAK mode.
See also `current-input-mode'. */)
(Lisp_Object interrupt)
{
- int new_interrupt_input;
-#ifdef SIGIO
-/* Note SIGIO has been undef'd if FIONREAD is missing. */
+ bool new_interrupt_input;
+#ifdef USABLE_SIGIO
#ifdef HAVE_X_WINDOWS
if (x_display_list != NULL)
{
@@ -11082,9 +10851,9 @@ See also `current-input-mode'. */)
else
#endif /* HAVE_X_WINDOWS */
new_interrupt_input = !NILP (interrupt);
-#else /* not SIGIO */
+#else /* not USABLE_SIGIO */
new_interrupt_input = 0;
-#endif /* not SIGIO */
+#endif /* not USABLE_SIGIO */
if (new_interrupt_input != interrupt_input)
{
@@ -11305,11 +11074,8 @@ The `posn-' functions access elements of such lists. */)
if (WINDOWP (frame_or_window))
{
- struct window *w;
+ struct window *w = decode_live_window (frame_or_window);
- CHECK_LIVE_WINDOW (frame_or_window);
-
- w = XWINDOW (frame_or_window);
XSETINT (x, (XINT (x)
+ WINDOW_LEFT_EDGE_X (w)
+ (NILP (whole)
@@ -11364,30 +11130,30 @@ The `posn-' functions access elements of such lists. */)
void
init_kboard (KBOARD *kb)
{
- KVAR (kb, Voverriding_terminal_local_map) = Qnil;
- KVAR (kb, Vlast_command) = Qnil;
- KVAR (kb, Vreal_last_command) = Qnil;
- KVAR (kb, Vkeyboard_translate_table) = Qnil;
- KVAR (kb, Vlast_repeatable_command) = Qnil;
- KVAR (kb, Vprefix_arg) = Qnil;
- KVAR (kb, Vlast_prefix_arg) = Qnil;
- KVAR (kb, kbd_queue) = Qnil;
+ kset_overriding_terminal_local_map (kb, Qnil);
+ kset_last_command (kb, Qnil);
+ kset_real_last_command (kb, Qnil);
+ kset_keyboard_translate_table (kb, Qnil);
+ kset_last_repeatable_command (kb, Qnil);
+ kset_prefix_arg (kb, Qnil);
+ kset_last_prefix_arg (kb, Qnil);
+ kset_kbd_queue (kb, Qnil);
kb->kbd_queue_has_data = 0;
kb->immediate_echo = 0;
- KVAR (kb, echo_string) = Qnil;
+ kset_echo_string (kb, Qnil);
kb->echo_after_prompt = -1;
kb->kbd_macro_buffer = 0;
kb->kbd_macro_bufsize = 0;
- KVAR (kb, defining_kbd_macro) = Qnil;
- KVAR (kb, Vlast_kbd_macro) = Qnil;
+ kset_defining_kbd_macro (kb, Qnil);
+ kset_last_kbd_macro (kb, Qnil);
kb->reference_count = 0;
- KVAR (kb, Vsystem_key_alist) = Qnil;
- KVAR (kb, system_key_syms) = Qnil;
- KVAR (kb, Vwindow_system) = Qt; /* Unset. */
- KVAR (kb, Vinput_decode_map) = Fmake_sparse_keymap (Qnil);
- KVAR (kb, Vlocal_function_key_map) = Fmake_sparse_keymap (Qnil);
+ kset_system_key_alist (kb, Qnil);
+ kset_system_key_syms (kb, Qnil);
+ kset_window_system (kb, Qt); /* Unset. */
+ kset_input_decode_map (kb, Fmake_sparse_keymap (Qnil));
+ kset_local_function_key_map (kb, Fmake_sparse_keymap (Qnil));
Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map);
- KVAR (kb, Vdefault_minibuffer_frame) = Qnil;
+ kset_default_minibuffer_frame (kb, Qnil);
}
/*
@@ -11410,7 +11176,7 @@ delete_kboard (KBOARD *kb)
for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
if (*kbp == NULL)
- abort ();
+ emacs_abort ();
*kbp = kb->next_kboard;
/* Prevent a dangling reference to KB. */
@@ -11421,7 +11187,7 @@ delete_kboard (KBOARD *kb)
current_kboard = FRAME_KBOARD (XFRAME (selected_frame));
single_kboard = 0;
if (current_kboard == kb)
- abort ();
+ emacs_abort ();
}
wipe_kboard (kb);
@@ -11431,26 +11197,20 @@ delete_kboard (KBOARD *kb)
void
init_keyboard (void)
{
- /* This is correct before outermost invocation of the editor loop */
+ /* This is correct before outermost invocation of the editor loop. */
command_loop_level = -1;
immediate_quit = 0;
quit_char = Ctl ('g');
Vunread_command_events = Qnil;
- unread_command_char = -1;
- EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
+ timer_idleness_start_time = invalid_emacs_time ();
total_keys = 0;
recent_keys_index = 0;
kbd_fetch_ptr = kbd_buffer;
kbd_store_ptr = kbd_buffer;
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
do_mouse_tracking = Qnil;
-#endif
input_pending = 0;
interrupt_input_blocked = 0;
- interrupt_input_pending = 0;
-#ifdef SYNC_INPUT
pending_signals = 0;
-#endif
/* This means that command_loop_1 won't try to select anything the first
time through. */
@@ -11463,28 +11223,33 @@ init_keyboard (void)
init_kboard (current_kboard);
/* A value of nil for Vwindow_system normally means a tty, but we also use
it for the initial terminal since there is no window system there. */
- KVAR (current_kboard, Vwindow_system) = Qnil;
+ kset_window_system (current_kboard, Qnil);
if (!noninteractive)
{
/* Before multi-tty support, these handlers used to be installed
only if the current session was a tty session. Now an Emacs
session may have multiple display types, so we always handle
- SIGINT. There is special code in interrupt_signal to exit
+ SIGINT. There is special code in handle_interrupt_signal to exit
Emacs on SIGINT when there are no termcap frames on the
controlling terminal. */
- signal (SIGINT, interrupt_signal);
+ struct sigaction action;
+ emacs_sigaction_init (&action, deliver_interrupt_signal);
+ sigaction (SIGINT, &action, 0);
#ifndef DOS_NT
/* For systems with SysV TERMIO, C-g is set up for both SIGINT and
SIGQUIT and we can't tell which one it will give us. */
- signal (SIGQUIT, interrupt_signal);
+ sigaction (SIGQUIT, &action, 0);
#endif /* not DOS_NT */
}
-/* Note SIGIO has been undef'd if FIONREAD is missing. */
-#ifdef SIGIO
+#ifdef USABLE_SIGIO
if (!noninteractive)
- signal (SIGIO, input_available_signal);
-#endif /* SIGIO */
+ {
+ struct sigaction action;
+ emacs_sigaction_init (&action, deliver_input_available_signal);
+ sigaction (SIGIO, &action, 0);
+ }
+#endif
/* Use interrupt input by default, if it works and noninterrupt input
has deficiencies. */
@@ -11495,7 +11260,7 @@ init_keyboard (void)
interrupt_input = 0;
#endif
- sigfree ();
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
dribble = 0;
if (keyboard_init_hook)
@@ -11534,7 +11299,7 @@ syms_of_keyboard (void)
pending_funcalls = Qnil;
staticpro (&pending_funcalls);
- Vlispy_mouse_stem = make_pure_c_string ("mouse");
+ Vlispy_mouse_stem = build_pure_c_string ("mouse");
staticpro (&Vlispy_mouse_stem);
/* Tool-bars. */
@@ -11550,9 +11315,6 @@ syms_of_keyboard (void)
staticpro (&tool_bar_items_vector);
tool_bar_items_vector = Qnil;
- staticpro (&real_this_command);
- real_this_command = Qnil;
-
DEFSYM (Qtimer_event_handler, "timer-event-handler");
DEFSYM (Qdisabled_command_function, "disabled-command-function");
DEFSYM (Qself_insert_command, "self-insert-command");
@@ -11571,7 +11333,7 @@ syms_of_keyboard (void)
DEFSYM (Qconfig_changed_event, "config-changed-event");
DEFSYM (Qmenu_enable, "menu-enable");
-#if defined (WINDOWSNT)
+#ifdef HAVE_NTGUI
DEFSYM (Qlanguage_change, "language-change");
#endif
@@ -11596,9 +11358,7 @@ syms_of_keyboard (void)
DEFSYM (Qvertical_scroll_bar, "vertical-scroll-bar");
DEFSYM (Qmenu_bar, "menu-bar");
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
DEFSYM (Qmouse_fixup_help_message, "mouse-fixup-help-message");
-#endif
DEFSYM (Qabove_handle, "above-handle");
DEFSYM (Qhandle, "handle");
@@ -11623,6 +11383,7 @@ syms_of_keyboard (void)
DEFSYM (Qx_set_selection, "x-set-selection");
DEFSYM (QPRIMARY, "PRIMARY");
DEFSYM (Qhandle_switch_frame, "handle-switch-frame");
+ DEFSYM (Qhandle_select_window, "handle-select-window");
DEFSYM (Qinput_method_function, "input-method-function");
DEFSYM (Qinput_method_exit_on_first_char, "input-method-exit-on-first-char");
@@ -11666,7 +11427,7 @@ syms_of_keyboard (void)
modifier_symbols = Fmake_vector (make_number (len), Qnil);
for (i = 0; i < len; i++)
if (modifier_names[i])
- XVECTOR (modifier_symbols)->contents[i] = intern_c_string (modifier_names[i]);
+ ASET (modifier_symbols, i, intern_c_string (modifier_names[i]));
staticpro (&modifier_symbols);
}
@@ -11717,9 +11478,7 @@ syms_of_keyboard (void)
defsubr (&Sread_key_sequence);
defsubr (&Sread_key_sequence_vector);
defsubr (&Srecursive_edit);
-#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
defsubr (&Strack_mouse);
-#endif
defsubr (&Sinput_pending_p);
defsubr (&Scommand_execute);
defsubr (&Srecent_keys);
@@ -11742,7 +11501,6 @@ syms_of_keyboard (void)
defsubr (&Sset_quit_char);
defsubr (&Sset_input_mode);
defsubr (&Scurrent_input_mode);
- defsubr (&Sexecute_extended_command);
defsubr (&Sposn_at_point);
defsubr (&Sposn_at_x_y);
@@ -11766,9 +11524,6 @@ as they will already have been added once as they were read for the first time.
An element of the form (t . EVENT) forces EVENT to be added to that list. */);
Vunread_command_events = Qnil;
- DEFVAR_INT ("unread-command-char", unread_command_char,
- doc: /* If not -1, an object to be read as next command input event. */);
-
DEFVAR_LISP ("unread-post-input-method-events", Vunread_post_input_method_events,
doc: /* List of events to be processed as input by input methods.
These events are processed before `unread-command-events'
@@ -11806,12 +11561,14 @@ was a kill command.
See Info node `(elisp)Multiple Terminals'. */);
DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
- doc: /* Same as `last-command', but never altered by Lisp code. */);
+ doc: /* Same as `last-command', but never altered by Lisp code.
+Taken from the previous value of `real-this-command'. */);
DEFVAR_KBOARD ("last-repeatable-command", Vlast_repeatable_command,
doc: /* Last command that may be repeated.
The last command executed that was not bound to an input event.
-This is the command `repeat' will try to repeat. */);
+This is the command `repeat' will try to repeat.
+Taken from a previous value of `real-this-command'. */);
DEFVAR_LISP ("this-command", Vthis_command,
doc: /* The command now being executed.
@@ -11819,6 +11576,10 @@ The command can set this variable; whatever is put here
will be in `last-command' during the following command. */);
Vthis_command = Qnil;
+ DEFVAR_LISP ("real-this-command", Vreal_this_command,
+ doc: /* This is like `this-command', except that commands should never modify it. */);
+ Vreal_this_command = Qnil;
+
DEFVAR_LISP ("this-command-keys-shift-translated",
Vthis_command_keys_shift_translated,
doc: /* Non-nil if the key sequence activating this command was shift-translated.
@@ -11835,38 +11596,39 @@ result of looking up the original command in the active keymaps. */);
Vthis_original_command = Qnil;
DEFVAR_INT ("auto-save-interval", auto_save_interval,
- doc: /* *Number of input events between auto-saves.
+ doc: /* Number of input events between auto-saves.
Zero means disable autosaving due to number of characters typed. */);
auto_save_interval = 300;
DEFVAR_LISP ("auto-save-timeout", Vauto_save_timeout,
- doc: /* *Number of seconds idle time before auto-save.
+ doc: /* Number of seconds idle time before auto-save.
Zero or nil means disable auto-saving due to idleness.
After auto-saving due to this many seconds of idle time,
Emacs also does a garbage collection if that seems to be warranted. */);
XSETFASTINT (Vauto_save_timeout, 30);
DEFVAR_LISP ("echo-keystrokes", Vecho_keystrokes,
- doc: /* *Nonzero means echo unfinished commands after this many seconds of pause.
-The value may be integer or floating point. */);
+ doc: /* Nonzero means echo unfinished commands after this many seconds of pause.
+The value may be integer or floating point.
+If the value is zero, don't echo at all. */);
Vecho_keystrokes = make_number (1);
DEFVAR_INT ("polling-period", polling_period,
- doc: /* *Interval between polling for input during Lisp execution.
+ doc: /* Interval between polling for input during Lisp execution.
The reason for polling is to make C-g work to stop a running program.
Polling is needed only when using X windows and SIGIO does not work.
Polling is automatically disabled in all other cases. */);
polling_period = 2;
DEFVAR_LISP ("double-click-time", Vdouble_click_time,
- doc: /* *Maximum time between mouse clicks to make a double-click.
+ doc: /* Maximum time between mouse clicks to make a double-click.
Measured in milliseconds. The value nil means disable double-click
recognition; t means double-clicks have no time limit and are detected
by position only. */);
Vdouble_click_time = make_number (500);
DEFVAR_INT ("double-click-fuzz", double_click_fuzz,
- doc: /* *Maximum mouse movement between clicks to make a double-click.
+ doc: /* Maximum mouse movement between clicks to make a double-click.
On window-system frames, value is the number of pixels the mouse may have
moved horizontally or vertically between two clicks to make a double-click.
On non window-system frames, value is interpreted in units of 1/8 characters
@@ -11877,7 +11639,7 @@ to count as a drag. */);
double_click_fuzz = 3;
DEFVAR_BOOL ("inhibit-local-menu-bar-menus", inhibit_local_menu_bar_menus,
- doc: /* *Non-nil means inhibit local map menu bar menus. */);
+ doc: /* Non-nil means inhibit local map menu bar menus. */);
inhibit_local_menu_bar_menus = 0;
DEFVAR_INT ("num-input-keys", num_input_keys,
@@ -12052,7 +11814,7 @@ and the minor mode maps regardless of `overriding-local-map'. */);
Vspecial_event_map = Fcons (intern_c_string ("keymap"), Qnil);
DEFVAR_LISP ("track-mouse", do_mouse_tracking,
- doc: /* *Non-nil means generate motion events for mouse motion. */);
+ doc: /* Non-nil means generate motion events for mouse motion. */);
DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
doc: /* Alist of system-specific X windows key symbols.
@@ -12138,19 +11900,13 @@ whenever `deferred-action-list' is non-nil. */);
Vdeferred_action_function = Qnil;
DEFVAR_LISP ("delayed-warnings-list", Vdelayed_warnings_list,
- doc: /* List of warnings to be displayed as soon as possible.
+ doc: /* List of warnings to be displayed after this command.
Each element must be a list (TYPE MESSAGE [LEVEL [BUFFER-NAME]]),
as per the args of `display-warning' (which see).
If this variable is non-nil, `delayed-warnings-hook' will be run
immediately after running `post-command-hook'. */);
Vdelayed_warnings_list = Qnil;
- DEFVAR_LISP ("suggest-key-bindings", Vsuggest_key_bindings,
- doc: /* *Non-nil means show the equivalent key-binding when M-x command has one.
-The value can be a length of time to show the message for.
-If the value is non-nil and not a number, we wait 2 seconds. */);
- Vsuggest_key_bindings = Qt;
-
DEFVAR_LISP ("timer-list", Vtimer_list,
doc: /* List of active absolute time timers in order of increasing time. */);
Vtimer_list = Qnil;
@@ -12206,7 +11962,7 @@ just after executing the command. */);
DEFVAR_LISP ("global-disable-point-adjustment",
Vglobal_disable_point_adjustment,
- doc: /* *If non-nil, always suppress point adjustment.
+ doc: /* If non-nil, always suppress point adjustment.
The default value is nil, in which case, point adjustment are
suppressed only after special commands that set
@@ -12214,7 +11970,7 @@ suppressed only after special commands that set
Vglobal_disable_point_adjustment = Qnil;
DEFVAR_LISP ("minibuffer-message-timeout", Vminibuffer_message_timeout,
- doc: /* *How long to display an echo-area message when the minibuffer is active.
+ doc: /* How long to display an echo-area message when the minibuffer is active.
If the value is not a number, such messages don't time out. */);
Vminibuffer_message_timeout = make_number (2);
@@ -12258,6 +12014,16 @@ text in the region before modifying the buffer. The next
`deactivate-mark' call uses this to set the window selection. */);
Vsaved_region_selection = Qnil;
+ DEFVAR_LISP ("selection-inhibit-update-commands",
+ Vselection_inhibit_update_commands,
+ doc: /* List of commands which should not update the selection.
+Normally, if `select-active-regions' is non-nil and the mark remains
+active after a command (i.e. the mark was not deactivated), the Emacs
+command loop sets the selection to the text in the region. However,
+if the command is in this list, the selection is not updated. */);
+ Vselection_inhibit_update_commands
+ = list2 (Qhandle_switch_frame, Qhandle_select_window);
+
DEFVAR_LISP ("debug-on-event",
Vdebug_on_event,
doc: /* Enter debugger on this event. When Emacs
@@ -12270,7 +12036,7 @@ variable are `sigusr1' and `sigusr2'. */);
Vdebug_on_event = intern_c_string ("sigusr2");
/* Create the initial keyboard. */
- initial_kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
+ initial_kboard = xmalloc (sizeof *initial_kboard);
init_kboard (initial_kboard);
/* Vwindow_system is left at t for now. */
initial_kboard->next_kboard = all_kboards;
@@ -12333,10 +12099,14 @@ keys_of_keyboard (void)
initial_define_lispy_key (Vspecial_event_map, "config-changed-event",
"ignore");
+#if defined (WINDOWSNT)
+ initial_define_lispy_key (Vspecial_event_map, "language-change",
+ "ignore");
+#endif
}
/* Mark the pointers in the kboard objects.
- Called by the Fgarbage_collector. */
+ Called by Fgarbage_collect. */
void
mark_kboards (void)
{
@@ -12371,14 +12141,15 @@ mark_kboards (void)
{
if (event == kbd_buffer + KBD_BUFFER_SIZE)
event = kbd_buffer;
+ /* These two special event types has no Lisp_Objects to mark. */
if (event->kind != SELECTION_REQUEST_EVENT
&& event->kind != SELECTION_CLEAR_EVENT)
{
mark_object (event->x);
mark_object (event->y);
+ mark_object (event->frame_or_window);
+ mark_object (event->arg);
}
- mark_object (event->frame_or_window);
- mark_object (event->arg);
}
}
}
diff --git a/src/keyboard.h b/src/keyboard.h
index d4339d0529b..e57c8cc7193 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -1,5 +1,5 @@
/* Declarations useful when processing input.
- Copyright (C) 1985-1987, 1993, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1987, 1993, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,14 +19,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "systime.h" /* for EMACS_TIME, Time */
#include "coding.h" /* for ENCODE_UTF_8 and ENCODE_SYSTEM */
-/* Lisp fields in struct keyboard are hidden from most code and accessed
- via the KVAR macro, below. Only select pieces of code, like the GC,
- are allowed to use KBOARD_INTERNAL_FIELD. */
-#define KBOARD_INTERNAL_FIELD(field) field ## _
+INLINE_HEADER_BEGIN
+#ifndef KEYBOARD_INLINE
+# define KEYBOARD_INLINE INLINE
+#endif
+
+/* Most code should use this macro to access Lisp fields in struct kboard. */
-/* Most code should use this macro to access Lisp fields in struct
- kboard. */
-#define KVAR(kboard, field) ((kboard)->KBOARD_INTERNAL_FIELD (field))
+#define KVAR(kboard, field) ((kboard)->INTERNAL_FIELD (field))
/* Each KBOARD represents one logical input stream from which Emacs
gets input. If we are using ordinary terminals, it has one KBOARD
@@ -79,32 +79,32 @@ struct kboard
can effectively wait for input in the any-kboard state, and hence
avoid blocking out the other KBOARDs. See universal-argument in
lisp/simple.el for an example. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Voverriding_terminal_local_map);
+ Lisp_Object INTERNAL_FIELD (Voverriding_terminal_local_map);
/* Last command executed by the editor command loop, not counting
commands that set the prefix argument. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_command);
+ Lisp_Object INTERNAL_FIELD (Vlast_command);
/* Normally same as last-command, but never modified by other commands. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vreal_last_command);
+ Lisp_Object INTERNAL_FIELD (Vreal_last_command);
/* User-supplied table to translate input characters through. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vkeyboard_translate_table);
+ Lisp_Object INTERNAL_FIELD (Vkeyboard_translate_table);
/* Last command that may be repeated by `repeat'. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_repeatable_command);
+ Lisp_Object INTERNAL_FIELD (Vlast_repeatable_command);
/* The prefix argument for the next command, in raw form. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vprefix_arg);
+ Lisp_Object INTERNAL_FIELD (Vprefix_arg);
/* Saved prefix argument for the last command, in raw form. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_prefix_arg);
+ Lisp_Object INTERNAL_FIELD (Vlast_prefix_arg);
/* Unread events specific to this kboard. */
- Lisp_Object KBOARD_INTERNAL_FIELD (kbd_queue);
+ Lisp_Object INTERNAL_FIELD (kbd_queue);
/* Non-nil while a kbd macro is being defined. */
- Lisp_Object KBOARD_INTERNAL_FIELD (defining_kbd_macro);
+ Lisp_Object INTERNAL_FIELD (defining_kbd_macro);
/* The start of storage for the current keyboard macro. */
Lisp_Object *kbd_macro_buffer;
@@ -126,28 +126,28 @@ struct kboard
ptrdiff_t kbd_macro_bufsize;
/* Last anonymous kbd macro defined. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_kbd_macro);
+ Lisp_Object INTERNAL_FIELD (Vlast_kbd_macro);
/* Alist of system-specific X windows key symbols. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vsystem_key_alist);
+ Lisp_Object INTERNAL_FIELD (Vsystem_key_alist);
/* Cache for modify_event_symbol. */
- Lisp_Object KBOARD_INTERNAL_FIELD (system_key_syms);
+ Lisp_Object INTERNAL_FIELD (system_key_syms);
/* The kind of display: x, w32, ... */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vwindow_system);
+ Lisp_Object INTERNAL_FIELD (Vwindow_system);
/* Keymap mapping keys to alternative preferred forms.
See the DEFVAR for more documentation. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vlocal_function_key_map);
+ Lisp_Object INTERNAL_FIELD (Vlocal_function_key_map);
/* Keymap mapping ASCII function key sequences onto their preferred
forms. Initialized by the terminal-specific lisp files. See the
DEFVAR for more documentation. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vinput_decode_map);
+ Lisp_Object INTERNAL_FIELD (Vinput_decode_map);
/* Minibufferless frames on this display use this frame's minibuffer. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vdefault_minibuffer_frame);
+ Lisp_Object INTERNAL_FIELD (Vdefault_minibuffer_frame);
/* Number of displays using this KBOARD. Normally 1, but can be
larger when you have multiple screens on a single X display. */
@@ -155,7 +155,7 @@ struct kboard
/* The text we're echoing in the modeline - partial key sequences,
usually. This is nil when not echoing. */
- Lisp_Object KBOARD_INTERNAL_FIELD (echo_string);
+ Lisp_Object INTERNAL_FIELD (echo_string);
/* This flag indicates that events were put into kbd_queue
while Emacs was running for some other KBOARD.
@@ -169,14 +169,55 @@ struct kboard
reading from this KBOARD again until more input arrives. */
char kbd_queue_has_data;
- /* Nonzero means echo each character as typed. */
- char immediate_echo;
+ /* True means echo each character as typed. */
+ unsigned immediate_echo : 1;
/* If we have echoed a prompt string specified by the user,
this is its length in characters. Otherwise this is -1. */
- char echo_after_prompt;
+ ptrdiff_t echo_after_prompt;
};
+KEYBOARD_INLINE void
+kset_default_minibuffer_frame (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vdefault_minibuffer_frame) = val;
+}
+KEYBOARD_INLINE void
+kset_defining_kbd_macro (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (defining_kbd_macro) = val;
+}
+KEYBOARD_INLINE void
+kset_input_decode_map (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vinput_decode_map) = val;
+}
+KEYBOARD_INLINE void
+kset_last_command (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vlast_command) = val;
+}
+KEYBOARD_INLINE void
+kset_last_kbd_macro (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vlast_kbd_macro) = val;
+}
+KEYBOARD_INLINE void
+kset_prefix_arg (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vprefix_arg) = val;
+}
+KEYBOARD_INLINE void
+kset_system_key_alist (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vsystem_key_alist) = val;
+}
+KEYBOARD_INLINE void
+kset_window_system (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vwindow_system) = val;
+}
+
/* Temporarily used before a frame has been opened. */
extern KBOARD *initial_kboard;
@@ -202,7 +243,7 @@ extern int poll_suppress_count;
sequence; this_command_key_count indicates how many elements
actually mean something. */
extern Lisp_Object this_command_keys;
-extern int this_command_key_count;
+extern ptrdiff_t this_command_key_count;
/* The frame in which the last input event occurred, or Qmacro if the
last event came from a macro. We use this to determine when to
@@ -422,14 +463,14 @@ extern Lisp_Object Qhelp_echo;
extern Lisp_Object Qmode_line, Qvertical_line, Qheader_line;
/* True while doing kbd input. */
-extern int waiting_for_input;
+extern bool waiting_for_input;
/* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
happens. */
extern EMACS_TIME *input_available_clear_time;
#if defined HAVE_WINDOW_SYSTEM && !defined USE_GTK && !defined HAVE_NS
-extern int ignore_mouse_drag_p;
+extern bool ignore_mouse_drag_p;
#endif
/* The primary selection. */
@@ -441,7 +482,7 @@ struct input_event;
extern Lisp_Object parse_modifiers (Lisp_Object);
extern Lisp_Object reorder_modifiers (Lisp_Object);
extern Lisp_Object read_char (int, ptrdiff_t, Lisp_Object *, Lisp_Object,
- int *, EMACS_TIME *);
+ bool *, EMACS_TIME *);
extern int parse_solitary_modifier (Lisp_Object symbol);
@@ -465,10 +506,10 @@ extern Time last_event_timestamp;
extern int quit_char;
-extern int timers_run;
+extern unsigned int timers_run;
-extern int menu_separator_name_p (const char *);
-extern int parse_menu_item (Lisp_Object, int);
+extern bool menu_separator_name_p (const char *);
+extern bool parse_menu_item (Lisp_Object, int);
extern void init_kboard (KBOARD *);
extern void delete_kboard (KBOARD *);
@@ -482,16 +523,16 @@ extern void input_poll_signal (int);
extern void start_polling (void);
extern void stop_polling (void);
extern void set_poll_suppress_count (int);
-extern void gobble_input (int);
-extern int input_polling_used (void);
+extern int gobble_input (void);
+extern bool input_polling_used (void);
extern void clear_input_pending (void);
-extern int requeued_events_pending_p (void);
+extern bool requeued_events_pending_p (void);
extern void bind_polling_period (int);
-extern int make_ctrl_char (int);
+extern int make_ctrl_char (int) ATTRIBUTE_CONST;
extern void stuff_buffered_input (Lisp_Object);
extern void clear_waiting_for_input (void);
-extern void swallow_events (int);
-extern int lucid_event_type_list_p (Lisp_Object);
+extern void swallow_events (bool);
+extern bool lucid_event_type_list_p (Lisp_Object);
extern void kbd_buffer_store_event (struct input_event *);
extern void kbd_buffer_store_event_hold (struct input_event *,
struct input_event *);
@@ -500,17 +541,18 @@ extern void poll_for_input_1 (void);
extern void show_help_echo (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object);
extern void gen_help_event (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object, EMACS_INT);
+ Lisp_Object, ptrdiff_t);
extern void kbd_buffer_store_help_event (Lisp_Object, Lisp_Object);
extern Lisp_Object menu_item_eval_property (Lisp_Object);
-extern int kbd_buffer_events_waiting (int);
+extern bool kbd_buffer_events_waiting (void);
extern void add_user_signal (int, const char *);
-extern int tty_read_avail_input (struct terminal *, int,
- struct input_event *);
+extern int tty_read_avail_input (struct terminal *, struct input_event *);
extern EMACS_TIME timer_check (void);
extern void mark_kboards (void);
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
extern const char *const lispy_function_keys[];
#endif
+
+INLINE_HEADER_END
diff --git a/src/keymap.c b/src/keymap.c
index b429ca968d7..fbdd31e0de3 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1,5 +1,5 @@
/* Manipulation of keymaps
- Copyright (C) 1985-1988, 1993-1995, 1998-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1988, 1993-1995, 1998-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -40,11 +40,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "commands.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "keyboard.h"
#include "frame.h"
@@ -92,7 +92,6 @@ static Lisp_Object where_is_cache;
/* Which keymaps are reverse-stored in the cache. */
static Lisp_Object where_is_cache_keymaps;
-static Lisp_Object Flookup_key (Lisp_Object, Lisp_Object, Lisp_Object);
static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object);
static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
@@ -100,12 +99,12 @@ static void describe_command (Lisp_Object, Lisp_Object);
static void describe_translation (Lisp_Object, Lisp_Object);
static void describe_map (Lisp_Object, Lisp_Object,
void (*) (Lisp_Object, Lisp_Object),
- int, Lisp_Object, Lisp_Object*, int, int);
+ bool, Lisp_Object, Lisp_Object*, bool, bool);
static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object,
- void (*) (Lisp_Object, Lisp_Object), int,
- Lisp_Object, Lisp_Object, int, int);
+ void (*) (Lisp_Object, Lisp_Object), bool,
+ Lisp_Object, Lisp_Object, bool, bool);
static void silly_event_symbol_error (Lisp_Object);
-static Lisp_Object get_keyelt (Lisp_Object, int);
+static Lisp_Object get_keyelt (Lisp_Object, bool);
/* Keymap object support - constructors and predicates. */
@@ -208,15 +207,12 @@ when reading a key-sequence to be looked-up in this keymap. */)
/* Check that OBJECT is a keymap (after dereferencing through any
symbols). If it is, return it.
- If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
+ If AUTOLOAD and if OBJECT is a symbol whose function value
is an autoload form, do the autoload and try again.
- If AUTOLOAD is nonzero, callers must assume GC is possible.
-
- If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
- is zero as well), return Qt.
+ If AUTOLOAD, callers must assume GC is possible.
ERROR_IF_NOT_KEYMAP controls how we respond if OBJECT isn't a keymap.
- If ERROR_IF_NOT_KEYMAP is non-zero, signal an error; otherwise,
+ If ERROR_IF_NOT_KEYMAP, signal an error; otherwise,
just return Qnil.
Note that most of the time, we don't want to pursue autoloads.
@@ -225,11 +221,11 @@ when reading a key-sequence to be looked-up in this keymap. */)
but it seems to me that only read_key_sequence, Flookup_key, and
Fdefine_key should cause keymaps to be autoloaded.
- This function can GC when AUTOLOAD is non-zero, because it calls
- do_autoload which can GC. */
+ This function can GC when AUTOLOAD is true, because it calls
+ Fautoload_do_load which can GC. */
Lisp_Object
-get_keymap (Lisp_Object object, int error_if_not_keymap, int autoload)
+get_keymap (Lisp_Object object, bool error_if_not_keymap, bool autoload)
{
Lisp_Object tem;
@@ -260,7 +256,7 @@ get_keymap (Lisp_Object object, int error_if_not_keymap, int autoload)
struct gcpro gcpro1, gcpro2;
GCPRO2 (tem, object);
- do_autoload (tem, object);
+ Fautoload_do_load (tem, object, Qnil);
UNGCPRO;
goto autoload_retry;
@@ -281,7 +277,7 @@ get_keymap (Lisp_Object object, int error_if_not_keymap, int autoload)
We assume that KEYMAP is a valid keymap. */
static Lisp_Object
-keymap_parent (Lisp_Object keymap, int autoload)
+keymap_parent (Lisp_Object keymap, bool autoload)
{
Lisp_Object list;
@@ -308,7 +304,7 @@ If KEYMAP has no parent, return nil. */)
}
/* Check whether MAP is one of MAPS parents. */
-static int
+static bool
keymap_memberp (Lisp_Object map, Lisp_Object maps)
{
if (NILP (map)) return 0;
@@ -366,19 +362,20 @@ Return PARENT. PARENT should be nil or another keymap. */)
MAP must be a keymap or a list of keymaps.
- If T_OK is non-zero, bindings for Qt are treated as default
+ If T_OK, bindings for Qt are treated as default
bindings; any key left unmentioned by other tables and bindings is
given the binding of Qt.
- If T_OK is zero, bindings for Qt are not treated specially.
+ If not T_OK, bindings for Qt are not treated specially.
If NOINHERIT, don't accept a subkeymap found in an inherited keymap.
- Returns Qunbound if no binding was found (and returns Qnil if a nil
+ Return Qunbound if no binding was found (and return Qnil if a nil
binding was found). */
static Lisp_Object
-access_keymap_1 (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int autoload)
+access_keymap_1 (Lisp_Object map, Lisp_Object idx,
+ bool t_ok, bool noinherit, bool autoload)
{
/* If idx is a list (some sort of mouse click, perhaps?),
the index we want to use is the car of the list, which
@@ -548,7 +545,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int
Lisp_Object
access_keymap (Lisp_Object map, Lisp_Object idx,
- int t_ok, int noinherit, int autoload)
+ bool t_ok, bool noinherit, bool autoload)
{
Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload);
return EQ (val, Qunbound) ? Qnil : val;
@@ -631,9 +628,10 @@ map_keymap_call (Lisp_Object key, Lisp_Object val, Lisp_Object fun, void *dummy)
}
/* Same as map_keymap_internal, but traverses parent keymaps as well.
- A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded. */
+ AUTOLOAD indicates that autoloaded keymaps should be loaded. */
void
-map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data, int autoload)
+map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args,
+ void *data, bool autoload)
{
struct gcpro gcpro1;
GCPRO1 (args);
@@ -712,13 +710,13 @@ usage: (map-keymap FUNCTION KEYMAP) */)
Also if OBJECT has a menu string as the first element,
remove that. Also remove a menu help string as second element.
- If AUTOLOAD is nonzero, load autoloadable keymaps
+ If AUTOLOAD, load autoloadable keymaps
that are referred to with indirection.
This can GC because menu_item_eval_property calls Feval. */
static Lisp_Object
-get_keyelt (Lisp_Object object, int autoload)
+get_keyelt (Lisp_Object object, bool autoload)
{
while (1)
{
@@ -956,8 +954,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
return def;
}
-static Lisp_Object Fcopy_keymap (Lisp_Object);
-
static Lisp_Object
copy_keymap_item (Lisp_Object elt)
{
@@ -1117,12 +1113,12 @@ binding is altered. If there is no binding for KEY, the new pair
binding KEY to DEF is added at the front of KEYMAP. */)
(Lisp_Object keymap, Lisp_Object key, Lisp_Object def)
{
- register int idx;
- register Lisp_Object c;
- register Lisp_Object cmd;
- int metized = 0;
+ ptrdiff_t idx;
+ Lisp_Object c;
+ Lisp_Object cmd;
+ bool metized = 0;
int meta_bit;
- int length;
+ ptrdiff_t length;
struct gcpro gcpro1, gcpro2, gcpro3;
GCPRO3 (keymap, key, def);
@@ -1143,7 +1139,7 @@ binding KEY to DEF is added at the front of KEYMAP. */)
if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
{ /* DEF is apparently an XEmacs-style keyboard macro. */
Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
- int i = ASIZE (def);
+ ptrdiff_t i = ASIZE (def);
while (--i >= 0)
{
Lisp_Object defi = AREF (def, i);
@@ -1274,11 +1270,11 @@ third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
recognize the default bindings, just as `read-key-sequence' does. */)
(Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default)
{
- register int idx;
- register Lisp_Object cmd;
- register Lisp_Object c;
- int length;
- int t_ok = !NILP (accept_default);
+ ptrdiff_t idx;
+ Lisp_Object cmd;
+ Lisp_Object c;
+ ptrdiff_t length;
+ bool t_ok = !NILP (accept_default);
struct gcpro gcpro1, gcpro2;
GCPRO2 (keymap, key);
@@ -1480,8 +1476,8 @@ current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr)
/* Use malloc here. See the comment above this function.
Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
- BLOCK_INPUT;
- newmodes = (Lisp_Object *) malloc (allocsize);
+ block_input ();
+ newmodes = malloc (allocsize);
if (newmodes)
{
if (cmm_modes)
@@ -1493,7 +1489,7 @@ current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr)
cmm_modes = newmodes;
}
- newmaps = (Lisp_Object *) malloc (allocsize);
+ newmaps = malloc (allocsize);
if (newmaps)
{
if (cmm_maps)
@@ -1504,7 +1500,7 @@ current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr)
}
cmm_maps = newmaps;
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (newmodes == NULL || newmaps == NULL)
break;
@@ -1527,6 +1523,19 @@ current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr)
return i;
}
+/* Return the offset of POSITION, a click position, in the style of
+ the respective argument of Fkey_binding. */
+static ptrdiff_t
+click_position (Lisp_Object position)
+{
+ EMACS_INT pos = (INTEGERP (position) ? XINT (position)
+ : MARKERP (position) ? marker_position (position)
+ : PT);
+ if (! (BEGV <= pos && pos <= ZV))
+ args_out_of_range (Fcurrent_buffer (), position);
+ return pos;
+}
+
DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
0, 2, 0,
doc: /* Return a list of the currently active keymaps.
@@ -1535,7 +1544,7 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and
like in the respective argument of `key-binding'. */)
(Lisp_Object olp, Lisp_Object position)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object keymaps = Fcons (current_global_map, Qnil);
@@ -1560,9 +1569,7 @@ like in the respective argument of `key-binding'. */)
would not be a problem here, but it is easier to keep
things the same.
*/
-
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
-
+ record_unwind_current_buffer ();
set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
}
}
@@ -1582,10 +1589,7 @@ like in the respective argument of `key-binding'. */)
{
Lisp_Object *maps;
int nmaps, i;
- EMACS_INT pt
- = INTEGERP (position) ? XINT (position)
- : MARKERP (position) ? marker_position (position)
- : PT;
+ ptrdiff_t pt = click_position (position);
/* This usually returns the buffer's local map,
but that can be overridden by a `local-map' property. */
Lisp_Object local_map = get_local_map (pt, current_buffer, Qlocal_map);
@@ -1847,7 +1851,7 @@ If KEYMAP is nil, that means no local keymap. */)
if (!NILP (keymap))
keymap = get_keymap (keymap, 1, 1);
- BVAR (current_buffer, keymap) = keymap;
+ bset_keymap (current_buffer, keymap);
return Qnil;
}
@@ -1882,7 +1886,7 @@ DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_
struct accessible_keymaps_data {
Lisp_Object maps, tail, thisseq;
/* Does the current sequence end in the meta-prefix-char? */
- int is_metized;
+ bool is_metized;
};
static void
@@ -1893,7 +1897,7 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *
Lisp_Object maps = d->maps;
Lisp_Object tail = d->tail;
Lisp_Object thisseq = d->thisseq;
- int is_metized = d->is_metized && INTEGERP (key);
+ bool is_metized = d->is_metized && INTEGERP (key);
Lisp_Object tem;
cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
@@ -1904,10 +1908,10 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *
while (!NILP (tem = Frassq (cmd, maps)))
{
Lisp_Object prefix = XCAR (tem);
- int lim = XINT (Flength (XCAR (tem)));
+ ptrdiff_t lim = XINT (Flength (XCAR (tem)));
if (lim <= XINT (Flength (thisseq)))
{ /* This keymap was already seen with a smaller prefix. */
- int i = 0;
+ ptrdiff_t i = 0;
while (i < lim && EQ (Faref (prefix, make_number (i)),
Faref (thisseq, make_number (i))))
i++;
@@ -1960,7 +1964,7 @@ then the value includes only maps for prefixes that start with PREFIX. */)
(Lisp_Object keymap, Lisp_Object prefix)
{
Lisp_Object maps, tail;
- int prefixlen = XINT (Flength (prefix));
+ EMACS_INT prefixlen = XFASTINT (Flength (prefix));
/* no need for gcpro because we don't autoload any keymaps. */
@@ -2003,9 +2007,7 @@ then the value includes only maps for prefixes that start with PREFIX. */)
return Qnil;
}
else
- maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
- get_keymap (keymap, 1, 0)),
- Qnil);
+ maps = Fcons (Fcons (zero_vector, get_keymap (keymap, 1, 0)), Qnil);
/* For each map in the list maps,
look at any other maps it points to,
@@ -2043,24 +2045,30 @@ static Lisp_Object Qsingle_key_description, Qkey_description;
DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
doc: /* Return a pretty description of key-sequence KEYS.
Optional arg PREFIX is the sequence of keys leading up to KEYS.
-Control characters turn into "C-foo" sequences, meta into "M-foo",
-spaces are put between sequence elements, etc. */)
+For example, [?\C-x ?l] is converted into the string \"C-x l\".
+
+The `kbd' macro is an approximate inverse of this. */)
(Lisp_Object keys, Lisp_Object prefix)
{
- int len = 0;
- int i, i_byte;
+ ptrdiff_t len = 0;
+ EMACS_INT i;
+ ptrdiff_t i_byte;
Lisp_Object *args;
- int size = XINT (Flength (keys));
+ EMACS_INT size = XINT (Flength (keys));
Lisp_Object list;
Lisp_Object sep = build_string (" ");
Lisp_Object key;
- int add_meta = 0;
+ Lisp_Object result;
+ bool add_meta = 0;
+ USE_SAFE_ALLOCA;
if (!NILP (prefix))
size += XINT (Flength (prefix));
/* This has one extra element at the end that we don't pass to Fconcat. */
- args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
+ if (min (PTRDIFF_MAX, SIZE_MAX) / word_size / 4 < size)
+ memory_full (SIZE_MAX);
+ SAFE_ALLOCA_LISP (args, size * 4);
/* In effect, this computes
(mapconcat 'single-key-description keys " ")
@@ -2076,11 +2084,14 @@ spaces are put between sequence elements, etc. */)
if (add_meta)
{
args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
- len += 2;
+ result = Fconcat (len + 1, args);
}
else if (len == 0)
- return empty_unibyte_string;
- return Fconcat (len - 1, args);
+ result = empty_unibyte_string;
+ else
+ result = Fconcat (len - 1, args);
+ SAFE_FREE ();
+ return result;
}
if (STRINGP (list))
@@ -2127,7 +2138,7 @@ spaces are put between sequence elements, etc. */)
continue;
}
else
- XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
+ XSETINT (key, XINT (key) | meta_modifier);
add_meta = 0;
}
else if (EQ (key, meta_prefix_char))
@@ -2143,9 +2154,10 @@ spaces are put between sequence elements, etc. */)
char *
-push_key_description (EMACS_INT ch, char *p, int force_multibyte)
+push_key_description (EMACS_INT ch, char *p)
{
int c, c2;
+ bool tab_as_ci;
/* Clear all the meaningless bits above the meta bit. */
c = ch & (meta_modifier | ~ - meta_modifier);
@@ -2159,6 +2171,8 @@ push_key_description (EMACS_INT ch, char *p, int force_multibyte)
return p;
}
+ tab_as_ci = (c2 == '\t' && (c & meta_modifier));
+
if (c & alt_modifier)
{
*p++ = 'A';
@@ -2166,7 +2180,8 @@ push_key_description (EMACS_INT ch, char *p, int force_multibyte)
c -= alt_modifier;
}
if ((c & ctrl_modifier) != 0
- || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
+ || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M'))
+ || tab_as_ci)
{
*p++ = 'C';
*p++ = '-';
@@ -2204,6 +2219,10 @@ push_key_description (EMACS_INT ch, char *p, int force_multibyte)
*p++ = 'S';
*p++ = 'C';
}
+ else if (tab_as_ci)
+ {
+ *p++ = 'i';
+ }
else if (c == '\t')
{
*p++ = 'T';
@@ -2237,21 +2256,12 @@ push_key_description (EMACS_INT ch, char *p, int force_multibyte)
*p++ = 'P';
*p++ = 'C';
}
- else if (c < 128
- || (NILP (BVAR (current_buffer, enable_multibyte_characters))
- && SINGLE_BYTE_CHAR_P (c)
- && !force_multibyte))
- {
- *p++ = c;
- }
+ else if (c < 128)
+ *p++ = c;
else
{
/* Now we are sure that C is a valid character code. */
- if (NILP (BVAR (current_buffer, enable_multibyte_characters))
- && ! force_multibyte)
- *p++ = multibyte_char_to_unibyte (c);
- else
- p += CHAR_STRING (c, (unsigned char *) p);
+ p += CHAR_STRING (c, (unsigned char *) p);
}
return p;
@@ -2270,25 +2280,29 @@ around function keys and event symbols. */)
if (CONSP (key) && lucid_event_type_list_p (key))
key = Fevent_convert_list (key);
+ if (CONSP (key) && INTEGERP (XCAR (key)) && INTEGERP (XCDR (key)))
+ /* An interval from a map-char-table. */
+ return concat3 (Fsingle_key_description (XCAR (key), no_angles),
+ build_string (".."),
+ Fsingle_key_description (XCDR (key), no_angles));
+
key = EVENT_HEAD (key);
- if (INTEGERP (key)) /* Normal character */
+ if (INTEGERP (key)) /* Normal character. */
{
- char tem[KEY_DESCRIPTION_SIZE], *p;
-
- p = push_key_description (XINT (key), tem, 1);
+ char tem[KEY_DESCRIPTION_SIZE];
+ char *p = push_key_description (XINT (key), tem);
*p = 0;
return make_specified_string (tem, -1, p - tem, 1);
}
- else if (SYMBOLP (key)) /* Function key or event-symbol */
+ else if (SYMBOLP (key)) /* Function key or event-symbol. */
{
if (NILP (no_angles))
{
- char *buffer;
Lisp_Object result;
USE_SAFE_ALLOCA;
- SAFE_ALLOCA (buffer, char *,
- sizeof "<>" + SBYTES (SYMBOL_NAME (key)));
+ char *buffer = SAFE_ALLOCA (sizeof "<>"
+ + SBYTES (SYMBOL_NAME (key)));
esprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
result = build_string (buffer);
SAFE_FREE ();
@@ -2343,7 +2357,7 @@ See Info node `(elisp)Describing Characters' for examples. */)
char str[6];
int c;
- CHECK_NUMBER (character);
+ CHECK_CHARACTER (character);
c = XINT (character);
if (!ASCII_CHAR_P (c))
@@ -2366,8 +2380,8 @@ static int where_is_preferred_modifier;
static int
preferred_sequence_p (Lisp_Object seq)
{
- int i;
- int len = XINT (Flength (seq));
+ EMACS_INT i;
+ EMACS_INT len = XFASTINT (Flength (seq));
int result = 1;
for (i = 0; i < len; i++)
@@ -2405,7 +2419,7 @@ static void where_is_internal_1 (Lisp_Object key, Lisp_Object binding,
static Lisp_Object
shadow_lookup (Lisp_Object shadow, Lisp_Object key, Lisp_Object flag,
- int remap)
+ bool remap)
{
Lisp_Object tail, value;
@@ -2437,7 +2451,7 @@ static Lisp_Object Vmouse_events;
struct where_is_internal_data {
Lisp_Object definition, this, last;
- int last_is_meta, noindirect;
+ bool last_is_meta, noindirect;
Lisp_Object sequences;
};
@@ -2450,7 +2464,7 @@ struct where_is_internal_data {
static Lisp_Object
where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
- int noindirect, int nomenus)
+ bool noindirect, bool nomenus)
{
Lisp_Object maps = Qnil;
Lisp_Object found;
@@ -2499,7 +2513,7 @@ where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
[M-CHAR] sequences, check if last character of the sequence
is the meta-prefix char. */
Lisp_Object last;
- int last_is_meta;
+ bool last_is_meta;
this = Fcar (XCAR (maps));
map = Fcdr (XCAR (maps));
@@ -2546,7 +2560,8 @@ where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
doc: /* Return list of keys that invoke DEFINITION.
If KEYMAP is a keymap, search only KEYMAP and the global keymap.
-If KEYMAP is nil, search all the currently active keymaps.
+If KEYMAP is nil, search all the currently active keymaps, except
+ for `overriding-local-map' (which is ignored).
If KEYMAP is a list of keymaps, search only those keymaps.
If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
@@ -2561,9 +2576,17 @@ If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
to other keymaps or slots. This makes it possible to search for an
indirect definition itself.
-If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
-that invoke a command which is remapped to DEFINITION, but include the
-remapped command in the returned list. */)
+The optional 5th arg NO-REMAP alters how command remapping is handled:
+
+- If another command OTHER-COMMAND is remapped to DEFINITION, normally
+ search for the bindings of OTHER-COMMAND and include them in the
+ returned list. But if NO-REMAP is non-nil, include the vector
+ [remap OTHER-COMMAND] in the returned list instead, without
+ searching for those other bindings.
+
+- If DEFINITION is remapped to OTHER-COMMAND, normally return the
+ bindings for OTHER-COMMAND. But if NO-REMAP is non-nil, return the
+ bindings for DEFINITION instead, ignoring its remapping. */)
(Lisp_Object definition, Lisp_Object keymap, Lisp_Object firstonly, Lisp_Object noindirect, Lisp_Object no_remap)
{
/* The keymaps in which to search. */
@@ -2573,7 +2596,7 @@ remapped command in the returned list. */)
/* Actually relevant bindings. */
Lisp_Object found = Qnil;
/* 1 means ignore all menu bindings entirely. */
- int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
+ bool nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
/* List of sequences found via remapping. Keep them in a separate
variable, so as to push them later, since we prefer
@@ -2582,7 +2605,7 @@ remapped command in the returned list. */)
/* Whether or not we're handling remapped sequences. This is needed
because remapping is not done recursively by Fcommand_remapping: you
can't remap a remapped command. */
- int remapped = 0;
+ bool remapped = 0;
Lisp_Object tem = Qnil;
/* Refresh the C version of the modifier preference. */
@@ -2734,10 +2757,10 @@ where_is_internal_1 (Lisp_Object key, Lisp_Object binding, Lisp_Object args, voi
{
struct where_is_internal_data *d = data; /* Cast! */
Lisp_Object definition = d->definition;
- int noindirect = d->noindirect;
+ bool noindirect = d->noindirect;
Lisp_Object this = d->this;
Lisp_Object last = d->last;
- int last_is_meta = d->last_is_meta;
+ bool last_is_meta = d->last_is_meta;
Lisp_Object sequence;
/* Search through indirections unless that's not wanted. */
@@ -2788,8 +2811,8 @@ The optional argument MENUS, if non-nil, says to mention menu bindings.
(Lisp_Object buffer, Lisp_Object prefix, Lisp_Object menus)
{
Lisp_Object outbuf, shadow;
- int nomenu = NILP (menus);
- register Lisp_Object start1;
+ bool nomenu = NILP (menus);
+ Lisp_Object start1;
struct gcpro gcpro1;
const char *alternate_heading
@@ -2824,10 +2847,10 @@ You type Translation\n\
alternate_heading = 0;
}
- bufend = push_key_description (translate[c], buf, 1);
+ bufend = push_key_description (translate[c], buf);
insert (buf, bufend - buf);
Findent_to (make_number (16), make_number (1));
- bufend = push_key_description (c, buf, 1);
+ bufend = push_key_description (c, buf);
insert (buf, bufend - buf);
insert ("\n", 1);
@@ -2890,9 +2913,9 @@ You type Translation\n\
char *title, *p;
if (!SYMBOLP (modes[i]))
- abort ();
+ emacs_abort ();
- p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
+ p = title = alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
*p++ = '\f';
*p++ = '\n';
*p++ = '`';
@@ -2944,34 +2967,34 @@ You type Translation\n\
/* Insert a description of the key bindings in STARTMAP,
followed by those of all maps reachable through STARTMAP.
- If PARTIAL is nonzero, omit certain "uninteresting" commands
+ If PARTIAL, omit certain "uninteresting" commands
(such as `undefined').
If SHADOW is non-nil, it is a list of maps;
don't mention keys which would be shadowed by any of them.
PREFIX, if non-nil, says mention only keys that start with PREFIX.
TITLE, if not 0, is a string to insert at the beginning.
TITLE should not end with a colon or a newline; we supply that.
- If NOMENU is not 0, then omit menu-bar commands.
+ If NOMENU, then omit menu-bar commands.
- If TRANSL is nonzero, the definitions are actually key translations
+ If TRANSL, the definitions are actually key translations
so print strings and vectors differently.
- If ALWAYS_TITLE is nonzero, print the title even if there are no maps
+ If ALWAYS_TITLE, print the title even if there are no maps
to look through.
- If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
+ If MENTION_SHADOW, then when something is shadowed by SHADOW,
don't omit it; instead, mention it but say it is shadowed.
- Return whether something was inserted or not. */
+ Any inserted text ends in two newlines (used by `help-make-xrefs'). */
-int
-describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
- Lisp_Object prefix, const char *title, int nomenu, int transl,
- int always_title, int mention_shadow)
+void
+describe_map_tree (Lisp_Object startmap, bool partial, Lisp_Object shadow,
+ Lisp_Object prefix, const char *title, bool nomenu,
+ bool transl, bool always_title, bool mention_shadow)
{
Lisp_Object maps, orig_maps, seen, sub_shadows;
struct gcpro gcpro1, gcpro2, gcpro3;
- int something = 0;
+ bool something = 0;
const char *key_heading
= "\
key binding\n\
@@ -3074,8 +3097,10 @@ key binding\n\
skip: ;
}
+ if (something)
+ insert_string ("\n");
+
UNGCPRO;
- return something;
}
static int previous_description_column;
@@ -3084,7 +3109,7 @@ static void
describe_command (Lisp_Object definition, Lisp_Object args)
{
register Lisp_Object tem1;
- EMACS_INT column = current_column ();
+ ptrdiff_t column = current_column ();
int description_column;
/* If column 16 is no good, go to col 32;
@@ -3144,7 +3169,12 @@ describe_translation (Lisp_Object definition, Lisp_Object args)
into an array of `struct describe_map_elt',
then sorts them by the events. */
-struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
+struct describe_map_elt
+{
+ Lisp_Object event;
+ Lisp_Object definition;
+ bool shadowed;
+};
/* qsort comparison function for sorting `struct describe_map_elt' by
the event field. */
@@ -3174,14 +3204,14 @@ describe_map_compare (const void *aa, const void *bb)
static void
describe_map (Lisp_Object map, Lisp_Object prefix,
void (*elt_describer) (Lisp_Object, Lisp_Object),
- int partial, Lisp_Object shadow,
- Lisp_Object *seen, int nomenu, int mention_shadow)
+ bool partial, Lisp_Object shadow,
+ Lisp_Object *seen, bool nomenu, bool mention_shadow)
{
Lisp_Object tail, definition, event;
Lisp_Object tem;
Lisp_Object suppress;
Lisp_Object kludge;
- int first = 1;
+ bool first = 1;
struct gcpro gcpro1, gcpro2, gcpro3;
/* These accumulate the values from sparse keymap bindings,
@@ -3223,7 +3253,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix,
1, mention_shadow);
else if (CONSP (XCAR (tail)))
{
- int this_shadowed = 0;
+ bool this_shadowed = 0;
event = XCAR (XCAR (tail));
@@ -3367,7 +3397,7 @@ This is text showing the elements of vector matched against indices.
DESCRIBER is the output function used; nil means use `princ'. */)
(Lisp_Object vector, Lisp_Object describer)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (NILP (describer))
describer = intern ("princ");
specbind (Qstandard_output, Fcurrent_buffer ());
@@ -3393,7 +3423,7 @@ DESCRIBER is the output function used; nil means use `princ'. */)
of bytes that lead to the character set or portion of a character
set described by this chartable.
- If PARTIAL is nonzero, it means do not mention suppressed commands
+ If PARTIAL, it means do not mention suppressed commands
(that assumes the vector is in a keymap).
SHADOW is a list of keymaps that shadow this map.
@@ -3413,8 +3443,8 @@ DESCRIBER is the output function used; nil means use `princ'. */)
static void
describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
void (*elt_describer) (Lisp_Object, Lisp_Object),
- int partial, Lisp_Object shadow, Lisp_Object entire_map,
- int keymap_p, int mention_shadow)
+ bool partial, Lisp_Object shadow, Lisp_Object entire_map,
+ bool keymap_p, bool mention_shadow)
{
Lisp_Object definition;
Lisp_Object tem2;
@@ -3422,7 +3452,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
int i;
Lisp_Object suppress;
Lisp_Object kludge;
- int first = 1;
+ bool first = 1;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
/* Range of elements to be handled. */
int from, to, stop;
@@ -3462,7 +3492,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
for (i = from; ; i++)
{
- int this_shadowed = 0;
+ bool this_shadowed = 0;
int range_beg, range_end;
Lisp_Object val;
@@ -3671,13 +3701,12 @@ syms_of_keymap (void)
Fset (intern_c_string ("ctl-x-map"), control_x_map);
Ffset (intern_c_string ("Control-X-prefix"), control_x_map);
- exclude_keys
- = pure_cons (pure_cons (make_pure_c_string ("DEL"), make_pure_c_string ("\\d")),
- pure_cons (pure_cons (make_pure_c_string ("TAB"), make_pure_c_string ("\\t")),
- pure_cons (pure_cons (make_pure_c_string ("RET"), make_pure_c_string ("\\r")),
- pure_cons (pure_cons (make_pure_c_string ("ESC"), make_pure_c_string ("\\e")),
- pure_cons (pure_cons (make_pure_c_string ("SPC"), make_pure_c_string (" ")),
- Qnil)))));
+ exclude_keys = listn (CONSTYPE_PURE, 5,
+ pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")),
+ pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")),
+ pure_cons (build_pure_c_string ("RET"), build_pure_c_string ("\\r")),
+ pure_cons (build_pure_c_string ("ESC"), build_pure_c_string ("\\e")),
+ pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" ")));
staticpro (&exclude_keys);
DEFVAR_LISP ("define-key-rebound-commands", Vdefine_key_rebound_commands,
@@ -3730,16 +3759,16 @@ be preferred. */);
where_is_preferred_modifier = 0;
staticpro (&Vmouse_events);
- Vmouse_events = pure_cons (intern_c_string ("menu-bar"),
- pure_cons (intern_c_string ("tool-bar"),
- pure_cons (intern_c_string ("header-line"),
- pure_cons (intern_c_string ("mode-line"),
- pure_cons (intern_c_string ("mouse-1"),
- pure_cons (intern_c_string ("mouse-2"),
- pure_cons (intern_c_string ("mouse-3"),
- pure_cons (intern_c_string ("mouse-4"),
- pure_cons (intern_c_string ("mouse-5"),
- Qnil)))))))));
+ Vmouse_events = listn (CONSTYPE_PURE, 9,
+ intern_c_string ("menu-bar"),
+ intern_c_string ("tool-bar"),
+ intern_c_string ("header-line"),
+ intern_c_string ("mode-line"),
+ intern_c_string ("mouse-1"),
+ intern_c_string ("mouse-2"),
+ intern_c_string ("mouse-3"),
+ intern_c_string ("mouse-4"),
+ intern_c_string ("mouse-5"));
DEFSYM (Qsingle_key_description, "single-key-description");
DEFSYM (Qkey_description, "key-description");
diff --git a/src/keymap.h b/src/keymap.h
index a989f124b14..c704ee0b050 100644
--- a/src/keymap.h
+++ b/src/keymap.h
@@ -1,5 +1,5 @@
/* Functions to manipulate keymaps.
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -34,21 +34,11 @@ extern Lisp_Object Qkeymap, Qmenu_bar;
extern Lisp_Object Qremap;
extern Lisp_Object Qmenu_item;
extern Lisp_Object current_global_map;
-EXFUN (Fmake_sparse_keymap, 1);
-EXFUN (Fkeymap_prompt, 1);
-EXFUN (Fdefine_key, 3);
-EXFUN (Fcommand_remapping, 3);
-EXFUN (Fkey_binding, 4);
-EXFUN (Fkey_description, 2);
-extern char *push_key_description (EMACS_INT, char *, int);
-EXFUN (Fsingle_key_description, 2);
-EXFUN (Fwhere_is_internal, 5);
-EXFUN (Fcurrent_active_maps, 2);
-extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, int, int, int);
-extern Lisp_Object get_keymap (Lisp_Object, int, int);
-EXFUN (Fset_keymap_parent, 2);
-extern int describe_map_tree (Lisp_Object, int, Lisp_Object, Lisp_Object,
- const char *, int, int, int, int);
+extern char *push_key_description (EMACS_INT, char *);
+extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool);
+extern Lisp_Object get_keymap (Lisp_Object, bool, bool);
+extern void describe_map_tree (Lisp_Object, bool, Lisp_Object, Lisp_Object,
+ const char *, bool, bool, bool, bool);
extern ptrdiff_t current_minor_maps (Lisp_Object **, Lisp_Object **);
extern void initial_define_key (Lisp_Object, int, const char *);
extern void initial_define_lispy_key (Lisp_Object, const char *, const char *);
@@ -57,7 +47,8 @@ extern void keys_of_keymap (void);
typedef void (*map_keymap_function_t)
(Lisp_Object key, Lisp_Object val, Lisp_Object args, void* data);
-extern void map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object largs, void* cargs, int autoload);
+extern void map_keymap (Lisp_Object, map_keymap_function_t, Lisp_Object,
+ void *, bool);
extern void map_keymap_canonical (Lisp_Object map,
map_keymap_function_t fun,
Lisp_Object args, void *data);
diff --git a/src/lastfile.c b/src/lastfile.c
index ab07e748930..f8a64797362 100644
--- a/src/lastfile.c
+++ b/src/lastfile.c
@@ -1,5 +1,5 @@
/* Mark end of data space to dump as pure, for GNU Emacs.
- Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/lisp.h b/src/lisp.h
index a80d39765e0..419176d06c8 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1,6 +1,6 @@
/* Fundamental definitions for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1987, 1993-1995, 1997-2011
- Free Software Foundation, Inc.
+
+Copyright (C) 1985-1987, 1993-1995, 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -20,46 +20,60 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef EMACS_LISP_H
#define EMACS_LISP_H
+#include <setjmp.h>
+#include <stdalign.h>
#include <stdarg.h>
+#include <stdbool.h>
#include <stddef.h>
+#include <float.h>
#include <inttypes.h>
#include <limits.h>
#include <intprops.h>
-/* Use the configure flag --enable-checking[=LIST] to enable various
- types of run time checks for Lisp objects. */
-
-#ifdef GC_CHECK_CONS_LIST
-extern void check_cons_list (void);
-#define CHECK_CONS_LIST() check_cons_list ()
-#else
-#define CHECK_CONS_LIST() ((void) 0)
+INLINE_HEADER_BEGIN
+#ifndef LISP_INLINE
+# define LISP_INLINE INLINE
#endif
-/* Temporarily disable wider-than-pointer integers until they're tested more.
- Build with CFLAGS='-DWIDE_EMACS_INT' to try them out. */
-/* #undef WIDE_EMACS_INT */
-
-/* These are default choices for the types to use. */
-#ifndef EMACS_INT
-# if BITS_PER_LONG < BITS_PER_LONG_LONG && defined WIDE_EMACS_INT
-# define EMACS_INT long long
-# define BITS_PER_EMACS_INT BITS_PER_LONG_LONG
+/* The ubiquitous max and min macros. */
+#undef min
+#undef max
+#define max(a, b) ((a) > (b) ? (a) : (b))
+#define min(a, b) ((a) < (b) ? (a) : (b))
+
+/* EMACS_INT - signed integer wide enough to hold an Emacs value
+ EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if
+ pI - printf length modifier for EMACS_INT
+ EMACS_UINT - unsigned variant of EMACS_INT */
+#ifndef EMACS_INT_MAX
+# if LONG_MAX < LLONG_MAX && defined WIDE_EMACS_INT
+typedef long long int EMACS_INT;
+typedef unsigned long long int EMACS_UINT;
+# define EMACS_INT_MAX LLONG_MAX
# define pI "ll"
-# elif BITS_PER_INT < BITS_PER_LONG
-# define EMACS_INT long
-# define BITS_PER_EMACS_INT BITS_PER_LONG
+# elif INT_MAX < LONG_MAX
+typedef long int EMACS_INT;
+typedef unsigned long int EMACS_UINT;
+# define EMACS_INT_MAX LONG_MAX
# define pI "l"
# else
-# define EMACS_INT int
-# define BITS_PER_EMACS_INT BITS_PER_INT
+typedef int EMACS_INT;
+typedef unsigned int EMACS_UINT;
+# define EMACS_INT_MAX INT_MAX
# define pI ""
# endif
#endif
-#ifndef EMACS_UINT
-# define EMACS_UINT unsigned EMACS_INT
-#endif
+
+/* Number of bits in some machine integer types. */
+enum
+ {
+ BITS_PER_CHAR = CHAR_BIT,
+ BITS_PER_SHORT = CHAR_BIT * sizeof (short),
+ BITS_PER_INT = CHAR_BIT * sizeof (int),
+ BITS_PER_LONG = CHAR_BIT * sizeof (long int),
+ BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT)
+ };
/* printmax_t and uprintmax_t are types for printing large integers.
These are the widest integers that are supported for printing.
@@ -95,147 +109,126 @@ typedef EMACS_UINT uprintmax_t;
/* Extra internal type checking? */
-#ifdef ENABLE_CHECKING
+/* Define an Emacs version of 'assert (COND)', since some
+ system-defined 'assert's are flaky. COND should be free of side
+ effects; it may or may not be evaluated. */
+#ifndef ENABLE_CHECKING
+# define eassert(X) ((void) (0 && (X))) /* Check that X compiles. */
+#else /* ENABLE_CHECKING */
-extern void die (const char *, const char *, int) NO_RETURN;
+extern _Noreturn void die (const char *, const char *, int);
/* The suppress_checking variable is initialized to 0 in alloc.c. Set
it to 1 using a debugger to temporarily disable aborting on
detected internal inconsistencies or error conditions.
- Testing suppress_checking after the supplied condition ensures that
- the side effects produced by CHECK will be consistent, independent
- of whether ENABLE_CHECKING is defined, or whether the checks are
- suppressed at run time.
-
In some cases, a good compiler may be able to optimize away the
- CHECK macro altogether, e.g., if XSTRING (x) uses CHECK to test
+ eassert macro altogether, e.g., if XSTRING (x) uses eassert to test
STRINGP (x), but a particular use of XSTRING is invoked only after
testing that STRINGP (x) is true, making the test redundant. */
+extern bool suppress_checking EXTERNALLY_VISIBLE;
-extern int suppress_checking EXTERNALLY_VISIBLE;
-
-#define CHECK(check,msg) (((check) || suppress_checking \
- ? (void) 0 \
- : die ((msg), __FILE__, __LINE__)), \
- 0)
-#else
-
-/* Produce same side effects and result, but don't complain. */
-#define CHECK(check,msg) ((check),0)
-
-#endif
-
-/* Define an Emacs version of "assert", since some system ones are
- flaky. */
-#ifndef ENABLE_CHECKING
-#define eassert(X) ((void) (0 && (X))) /* Check that X compiles. */
-#else /* ENABLE_CHECKING */
-#if defined (__GNUC__) && __GNUC__ >= 2 && defined (__STDC__)
-#define eassert(cond) CHECK (cond, "assertion failed: " #cond)
-#else
-#define eassert(cond) CHECK (cond, "assertion failed")
-#endif
+# define eassert(cond) \
+ ((cond) || suppress_checking \
+ ? (void) 0 \
+ : die ("assertion failed: " # cond, __FILE__, __LINE__))
#endif /* ENABLE_CHECKING */
-/* Use the configure flag --enable-use-lisp-union-type to make
- Lisp_Object use a union type instead of the default int. The flag
- causes USE_LISP_UNION_TYPE to be defined. */
+/* Use the configure flag --enable-check-lisp-object-type to make
+ Lisp_Object use a struct type instead of the default int. The flag
+ causes CHECK_LISP_OBJECT_TYPE to be defined. */
/***** Select the tagging scheme. *****/
-/* There are basically two options that control the tagging scheme:
- - USE_LISP_UNION_TYPE says that Lisp_Object should be a union instead
- of an integer.
+/* The following option controls the tagging scheme:
- USE_LSB_TAG means that we can assume the least 3 bits of pointers are
always 0, and we can thus use them to hold tag bits, without
restricting our addressing space.
- If USE_LSB_TAG is not set, then we use the top 3 bits for tagging, thus
- restricting our possible address range. Currently USE_LSB_TAG is not
- allowed together with a union. This is not due to any fundamental
- technical (or political ;-) problem: nobody wrote the code to do it yet.
+ If ! USE_LSB_TAG, then use the top 3 bits for tagging, thus
+ restricting our possible address range.
USE_LSB_TAG not only requires the least 3 bits of pointers returned by
malloc to be 0 but also needs to be able to impose a mult-of-8 alignment
on the few static Lisp_Objects used: all the defsubr as well
as the two special buffers buffer_defaults and buffer_local_symbols. */
-/* First, try and define DECL_ALIGN(type,var) which declares a static
- variable VAR of type TYPE with the added requirement that it be
- TYPEBITS-aligned. */
-
-#ifndef GCTYPEBITS
+enum Lisp_Bits
+ {
+ /* Number of bits in a Lisp_Object tag. This can be used in #if,
+ and for GDB's sake also as a regular symbol. */
+ GCTYPEBITS =
#define GCTYPEBITS 3
+ GCTYPEBITS,
+
+ /* 2**GCTYPEBITS. This must be a macro that expands to a literal
+ integer constant, for MSVC. */
+#define GCALIGNMENT 8
+
+ /* Number of bits in a Lisp_Object value, not counting the tag. */
+ VALBITS = BITS_PER_EMACS_INT - GCTYPEBITS,
+
+ /* Number of bits in a Lisp fixnum tag. */
+ INTTYPEBITS = GCTYPEBITS - 1,
+
+ /* Number of bits in a Lisp fixnum value, not counting the tag. */
+ FIXNUM_BITS = VALBITS + 1
+ };
+
+#if GCALIGNMENT != 1 << GCTYPEBITS
+# error "GCALIGNMENT and GCTYPEBITS are inconsistent"
#endif
-#ifndef NO_DECL_ALIGN
-# ifndef DECL_ALIGN
-# if HAVE_ATTRIBUTE_ALIGNED
-# define DECL_ALIGN(type, var) \
- type __attribute__ ((__aligned__ (1 << GCTYPEBITS))) var
-# elif defined(_MSC_VER)
-# define ALIGN_GCTYPEBITS 8
-# if (1 << GCTYPEBITS) != ALIGN_GCTYPEBITS
-# error ALIGN_GCTYPEBITS is wrong!
+/* The maximum value that can be stored in a EMACS_INT, assuming all
+ bits other than the type bits contribute to a nonnegative signed value.
+ This can be used in #if, e.g., '#if VAL_MAX < UINTPTR_MAX' below. */
+#define VAL_MAX (EMACS_INT_MAX >> (GCTYPEBITS - 1))
+
+/* Unless otherwise specified, use USE_LSB_TAG on systems where: */
+#ifndef USE_LSB_TAG
+/* 1. We know malloc returns a multiple of 8. */
+# if (defined GNU_MALLOC || defined DOUG_LEA_MALLOC || defined __GLIBC__ \
+ || defined DARWIN_OS || defined __sun)
+/* 2. We can specify multiple-of-8 alignment on static variables. */
+# ifdef alignas
+/* 3. Pointers-as-ints exceed VAL_MAX.
+ On hosts where pointers-as-ints do not exceed VAL_MAX, USE_LSB_TAG is:
+ a. unnecessary, because the top bits of an EMACS_INT are unused, and
+ b. slower, because it typically requires extra masking.
+ So, default USE_LSB_TAG to 1 only on hosts where it might be useful. */
+# if VAL_MAX < UINTPTR_MAX
+# define USE_LSB_TAG 1
# endif
-# define DECL_ALIGN(type, var) \
- type __declspec(align(ALIGN_GCTYPEBITS)) var
-# else
- /* What directives do other compilers use? */
# endif
# endif
#endif
-
-/* Let's USE_LSB_TAG on systems where we know malloc returns mult-of-8. */
-#if (defined GNU_MALLOC || defined DOUG_LEA_MALLOC || defined __GLIBC__ \
- || defined DARWIN_OS || defined __sun)
-/* We also need to be able to specify mult-of-8 alignment on static vars. */
-# if defined DECL_ALIGN
-# define USE_LSB_TAG
-# endif
+#ifdef USE_LSB_TAG
+# undef USE_LSB_TAG
+enum enum_USE_LSB_TAG { USE_LSB_TAG = 1 };
+# define USE_LSB_TAG 1
+#else
+enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 };
+# define USE_LSB_TAG 0
#endif
-/* If we cannot use 8-byte alignment, make DECL_ALIGN a no-op. */
-#ifndef DECL_ALIGN
-# ifdef USE_LSB_TAG
-# error "USE_LSB_TAG used without defining DECL_ALIGN"
+#ifndef alignas
+# define alignas(alignment) /* empty */
+# if USE_LSB_TAG
+# error "USE_LSB_TAG requires alignas"
# endif
-# define DECL_ALIGN(type, var) type var
#endif
/* Define the fundamental Lisp data structures. */
-/* If USE_2_TAGBITS_FOR_INTS is defined, then Lisp integers use
- 2 tags, to give them one extra bit, thus extending their range from
- e.g -2^28..2^28-1 to -2^29..2^29-1. */
-#define USE_2_TAGS_FOR_INTS
-
-/* Making it work for the union case is too much trouble. */
-#ifdef USE_LISP_UNION_TYPE
-# undef USE_2_TAGS_FOR_INTS
-#endif
+/* This is the set of Lisp data types. If you want to define a new
+ data type, read the comments after Lisp_Fwd_Type definition
+ below. */
-/* This is the set of Lisp data types. */
-
-#if !defined USE_2_TAGS_FOR_INTS
-# define LISP_INT_TAG Lisp_Int
-# define case_Lisp_Int case Lisp_Int
-# define LISP_STRING_TAG 4
-# define LISP_INT_TAG_P(x) ((x) == Lisp_Int)
-#else
-# define LISP_INT_TAG Lisp_Int0
-# define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
-# ifdef USE_LSB_TAG
-# define LISP_INT1_TAG 4
-# define LISP_STRING_TAG 1
-# define LISP_INT_TAG_P(x) (((x) & 3) == 0)
-# else
-# define LISP_INT1_TAG 1
-# define LISP_STRING_TAG 4
-# define LISP_INT_TAG_P(x) (((x) & 6) == 0)
-# endif
-#endif
+/* Lisp integers use 2 tags, to give them one extra bit, thus
+ extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1. */
+static EMACS_INT const INTMASK = EMACS_INT_MAX >> (INTTYPEBITS - 1);
+#define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
+#define LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0)
/* Stolen from GDB. The only known compiler that doesn't support
enums in bitfields is MSVC. */
@@ -249,12 +242,8 @@ extern int suppress_checking EXTERNALLY_VISIBLE;
enum Lisp_Type
{
/* Integer. XINT (obj) is the integer value. */
-#ifdef USE_2_TAGS_FOR_INTS
Lisp_Int0 = 0,
- Lisp_Int1 = LISP_INT1_TAG,
-#else
- Lisp_Int = 0,
-#endif
+ Lisp_Int1 = USE_LSB_TAG ? 1 << INTTYPEBITS : 1,
/* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
Lisp_Symbol = 2,
@@ -265,7 +254,7 @@ enum Lisp_Type
/* String. XSTRING (object) points to a struct Lisp_String.
The length of the string, and its contents, are stored therein. */
- Lisp_String = LISP_STRING_TAG,
+ Lisp_String = USE_LSB_TAG ? 1 : 1 << INTTYPEBITS,
/* Vector of Lisp objects, or something resembling it.
XVECTOR (object) points to a struct Lisp_Vector, which contains
@@ -309,263 +298,218 @@ enum Lisp_Fwd_Type
Lisp_Fwd_Kboard_Obj, /* Fwd to a Lisp_Object field of kboards. */
};
-/* These values are overridden by the m- file on some machines. */
-#ifndef VALBITS
-#define VALBITS (BITS_PER_EMACS_INT - GCTYPEBITS)
-#endif
-
-#ifdef USE_LISP_UNION_TYPE
-
-#ifndef WORDS_BIGENDIAN
-
-/* Definition of Lisp_Object for little-endian machines. */
-
-typedef
-union Lisp_Object
- {
- /* Used for comparing two Lisp_Objects;
- also, positive integers can be accessed fast this way. */
- EMACS_INT i;
-
- struct
- {
- /* Use explicit signed, the signedness of a bit-field of type
- int is implementation defined. */
- signed EMACS_INT val : VALBITS;
- ENUM_BF (Lisp_Type) type : GCTYPEBITS;
- } s;
- struct
- {
- EMACS_UINT val : VALBITS;
- ENUM_BF (Lisp_Type) type : GCTYPEBITS;
- } u;
- }
-Lisp_Object;
-
-#else /* If WORDS_BIGENDIAN */
-
-typedef
-union Lisp_Object
- {
- /* Used for comparing two Lisp_Objects;
- also, positive integers can be accessed fast this way. */
- EMACS_INT i;
-
- struct
- {
- ENUM_BF (Lisp_Type) type : GCTYPEBITS;
- /* Use explicit signed, the signedness of a bit-field of type
- int is implementation defined. */
- signed EMACS_INT val : VALBITS;
- } s;
- struct
- {
- ENUM_BF (Lisp_Type) type : GCTYPEBITS;
- EMACS_UINT val : VALBITS;
- } u;
- }
-Lisp_Object;
-
-#endif /* WORDS_BIGENDIAN */
+/* If you want to define a new Lisp data type, here are some
+ instructions. See the thread at
+ http://lists.gnu.org/archive/html/emacs-devel/2012-10/msg00561.html
+ for more info.
+
+ First, there are already a couple of Lisp types that can be used if
+ your new type does not need to be exposed to Lisp programs nor
+ displayed to users. These are Lisp_Save_Value, a Lisp_Misc
+ subtype; and PVEC_OTHER, a kind of vectorlike object. The former
+ is suitable for temporarily stashing away pointers and integers in
+ a Lisp object (see the existing uses of make_save_value and
+ XSAVE_VALUE). The latter is useful for vector-like Lisp objects
+ that need to be used as part of other objects, but which are never
+ shown to users or Lisp code (search for PVEC_OTHER in xterm.c for
+ an example).
+
+ These two types don't look pretty when printed, so they are
+ unsuitable for Lisp objects that can be exposed to users.
+
+ To define a new data type, add one more Lisp_Misc subtype or one
+ more pseudovector subtype. Pseudovectors are more suitable for
+ objects with several slots that need to support fast random access,
+ while Lisp_Misc types are for everything else. A pseudovector object
+ provides one or more slots for Lisp objects, followed by struct
+ members that are accessible only from C. A Lisp_Misc object is a
+ wrapper for a C struct that can contain anything you like.
+
+ To add a new pseudovector type, extend the pvec_type enumeration;
+ to add a new Lisp_Misc, extend the Lisp_Misc_Type enumeration.
+
+ For a Lisp_Misc, you will also need to add your entry to union
+ Lisp_Misc (but make sure the first word has the same structure as
+ the others, starting with a 16-bit member of the Lisp_Misc_Type
+ enumeration and a 1-bit GC markbit) and make sure the overall size
+ of the union is not increased by your addition.
+
+ Then you will need to add switch branches in print.c (in
+ print_object, to print your object, and possibly also in
+ print_preprocess) and to alloc.c, to mark your object (in
+ mark_object) and to free it (in gc_sweep). The latter is also the
+ right place to call any code specific to your data type that needs
+ to run when the object is recycled -- e.g., free any additional
+ resources allocated for it that are not Lisp objects. You can even
+ make a pointer to the function that frees the resources a slot in
+ your object -- this way, the same object could be used to represent
+ several disparate C structures. */
+
+#ifdef CHECK_LISP_OBJECT_TYPE
+
+typedef struct { EMACS_INT i; } Lisp_Object;
+
+#define XLI(o) (o).i
+LISP_INLINE Lisp_Object
+XIL (EMACS_INT i)
+{
+ Lisp_Object o = { i };
+ return o;
+}
-#ifdef __GNUC__
-static inline Lisp_Object
+LISP_INLINE Lisp_Object
LISP_MAKE_RVALUE (Lisp_Object o)
{
return o;
}
-#else
-/* This is more portable to pre-C99 non-GCC compilers, but for
- backwards compatibility GCC still accepts an old GNU extension
- which caused this to only generate a warning. */
-#define LISP_MAKE_RVALUE(o) (0 ? (o) : (o))
-#endif
-#else /* USE_LISP_UNION_TYPE */
+#define LISP_INITIALLY_ZERO {0}
-/* If union type is not wanted, define Lisp_Object as just a number. */
+#undef CHECK_LISP_OBJECT_TYPE
+enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 1 };
+#else /* CHECK_LISP_OBJECT_TYPE */
+
+/* If a struct type is not wanted, define Lisp_Object as just a number. */
typedef EMACS_INT Lisp_Object;
-#define LISP_MAKE_RVALUE(o) (0+(o))
-#endif /* USE_LISP_UNION_TYPE */
+#define XLI(o) (o)
+#define XIL(i) (i)
+#define LISP_MAKE_RVALUE(o) (0 + (o))
+#define LISP_INITIALLY_ZERO 0
+enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 };
+#endif /* CHECK_LISP_OBJECT_TYPE */
-/* In the size word of a vector, this bit means the vector has been marked.
- (Shift -1 left, not 1, to avoid provoking overflow diagnostics.) */
+/* In the size word of a vector, this bit means the vector has been marked. */
-#define ARRAY_MARK_FLAG ((EMACS_INT) -1 << (BITS_PER_EMACS_INT - 1))
+static ptrdiff_t const ARRAY_MARK_FLAG
+#define ARRAY_MARK_FLAG PTRDIFF_MIN
+ = ARRAY_MARK_FLAG;
/* In the size word of a struct Lisp_Vector, this bit means it's really
some other vector-like object. */
-#define PSEUDOVECTOR_FLAG ((EMACS_INT) 1 << (BITS_PER_EMACS_INT - 2))
+static ptrdiff_t const PSEUDOVECTOR_FLAG
+#define PSEUDOVECTOR_FLAG (PTRDIFF_MAX - PTRDIFF_MAX / 2)
+ = PSEUDOVECTOR_FLAG;
/* In a pseudovector, the size field actually contains a word with one
- PSEUDOVECTOR_FLAG bit set, and exactly one of the following bits to
- indicate the actual type.
- We use a bitset, even tho only one of the bits can be set at any
- particular time just so as to be able to use micro-optimizations such as
- testing membership of a particular subset of pseudovectors in Fequal.
- It is not crucial, but there are plenty of bits here, so why not do it? */
+ PSEUDOVECTOR_FLAG bit set, and one of the following values extracted
+ with PVEC_TYPE_MASK to indicate the actual type. */
enum pvec_type
{
- PVEC_NORMAL_VECTOR = 0,
- PVEC_PROCESS = 0x200,
- PVEC_FRAME = 0x400,
- PVEC_COMPILED = 0x800,
- PVEC_WINDOW = 0x1000,
- PVEC_WINDOW_CONFIGURATION = 0x2000,
- PVEC_SUBR = 0x4000,
- PVEC_CHAR_TABLE = 0x8000,
- PVEC_BOOL_VECTOR = 0x10000,
- PVEC_BUFFER = 0x20000,
- PVEC_HASH_TABLE = 0x40000,
- PVEC_TERMINAL = 0x80000,
- PVEC_SUB_CHAR_TABLE = 0x100000,
- PVEC_FONT = 0x200000,
- PVEC_OTHER = 0x400000,
- PVEC_TYPE_MASK = 0x7ffe00
-
-#if 0 /* This is used to make the value of PSEUDOVECTOR_FLAG available to
- GDB. It doesn't work on OS Alpha. Moved to a variable in
- emacs.c. */
- PVEC_FLAG = PSEUDOVECTOR_FLAG
-#endif
+ PVEC_NORMAL_VECTOR,
+ PVEC_FREE,
+ PVEC_PROCESS,
+ PVEC_FRAME,
+ PVEC_WINDOW,
+ PVEC_BOOL_VECTOR,
+ PVEC_BUFFER,
+ PVEC_HASH_TABLE,
+ PVEC_TERMINAL,
+ PVEC_WINDOW_CONFIGURATION,
+ PVEC_SUBR,
+ PVEC_OTHER,
+ /* These should be last, check internal_equal to see why. */
+ PVEC_COMPILED,
+ PVEC_CHAR_TABLE,
+ PVEC_SUB_CHAR_TABLE,
+ PVEC_FONT /* Should be last because it's used for range checking. */
};
-/* For convenience, we also store the number of elements in these bits.
- Note that this size is not necessarily the memory-footprint size, but
- only the number of Lisp_Object fields (that need to be traced by the GC).
- The distinction is used e.g. by Lisp_Process which places extra
- non-Lisp_Object fields at the end of the structure. */
-#define PSEUDOVECTOR_SIZE_MASK 0x1ff
+/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
+ which were stored in a Lisp_Object. */
+#ifndef DATA_SEG_BITS
+# define DATA_SEG_BITS 0
+#endif
+enum { gdb_DATA_SEG_BITS = DATA_SEG_BITS };
+#undef DATA_SEG_BITS
-/* Number of bits to put in each character in the internal representation
- of bool vectors. This should not vary across implementations. */
-#define BOOL_VECTOR_BITS_PER_CHAR 8
+enum More_Lisp_Bits
+ {
+ DATA_SEG_BITS = gdb_DATA_SEG_BITS,
+
+ /* For convenience, we also store the number of elements in these bits.
+ Note that this size is not necessarily the memory-footprint size, but
+ only the number of Lisp_Object fields (that need to be traced by GC).
+ The distinction is used, e.g., by Lisp_Process, which places extra
+ non-Lisp_Object fields at the end of the structure. */
+ PSEUDOVECTOR_SIZE_BITS = 12,
+ PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1,
+
+ /* To calculate the memory footprint of the pseudovector, it's useful
+ to store the size of non-Lisp area in word_size units here. */
+ PSEUDOVECTOR_REST_BITS = 12,
+ PSEUDOVECTOR_REST_MASK = (((1 << PSEUDOVECTOR_REST_BITS) - 1)
+ << PSEUDOVECTOR_SIZE_BITS),
+
+ /* Used to extract pseudovector subtype information. */
+ PSEUDOVECTOR_AREA_BITS = PSEUDOVECTOR_SIZE_BITS + PSEUDOVECTOR_REST_BITS,
+ PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS,
+
+ /* Number of bits to put in each character in the internal representation
+ of bool vectors. This should not vary across implementations. */
+ BOOL_VECTOR_BITS_PER_CHAR = 8
+ };
/* These macros extract various sorts of values from a Lisp_Object.
For example, if tem is a Lisp_Object whose type is Lisp_Cons,
XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */
-#ifndef USE_LISP_UNION_TYPE
+#if USE_LSB_TAG
-/* Return a perfect hash of the Lisp_Object representation. */
-#define XHASH(a) (a)
-
-#ifdef USE_LSB_TAG
-
-#define TYPEMASK ((((EMACS_INT) 1) << GCTYPEBITS) - 1)
-#define XTYPE(a) ((enum Lisp_Type) ((a) & TYPEMASK))
-#ifdef USE_2_TAGS_FOR_INTS
-# define XINT(a) (((EMACS_INT) (a)) >> (GCTYPEBITS - 1))
-# define XUINT(a) (((EMACS_UINT) (a)) >> (GCTYPEBITS - 1))
-# define make_number(N) (((EMACS_INT) (N)) << (GCTYPEBITS - 1))
-#else
-# define XINT(a) (((EMACS_INT) (a)) >> GCTYPEBITS)
-# define XUINT(a) (((EMACS_UINT) (a)) >> GCTYPEBITS)
-# define make_number(N) (((EMACS_INT) (N)) << GCTYPEBITS)
-#endif
-#define XSET(var, type, ptr) \
- (eassert (XTYPE ((intptr_t) (ptr)) == 0), /* Check alignment. */ \
- (var) = (type) | (intptr_t) (ptr))
+enum lsb_bits
+ {
+ TYPEMASK = (1 << GCTYPEBITS) - 1,
+ VALMASK = ~ TYPEMASK
+ };
+#define XTYPE(a) ((enum Lisp_Type) (XLI (a) & TYPEMASK))
+#define XINT(a) (XLI (a) >> INTTYPEBITS)
+#define XUINT(a) ((EMACS_UINT) XLI (a) >> INTTYPEBITS)
+#define make_number(N) XIL ((EMACS_INT) (N) << INTTYPEBITS)
+#define make_lisp_ptr(ptr, type) \
+ (eassert (XTYPE (XIL ((intptr_t) (ptr))) == 0), /* Check alignment. */ \
+ XIL ((type) | (intptr_t) (ptr)))
-#define XPNTR(a) ((intptr_t) ((a) & ~TYPEMASK))
+#define XPNTR(a) ((intptr_t) (XLI (a) & ~TYPEMASK))
+#define XUNTAG(a, type) ((intptr_t) (XLI (a) - (type)))
#else /* not USE_LSB_TAG */
-#define VALMASK ((((EMACS_INT) 1) << VALBITS) - 1)
+static EMACS_INT const VALMASK
+#define VALMASK VAL_MAX
+ = VALMASK;
-/* One need to override this if there must be high bits set in data space
- (doing the result of the below & ((1 << (GCTYPE + 1)) - 1) would work
- on all machines, but would penalize machines which don't need it)
- */
-#define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT) (a)) >> VALBITS))
+#define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS))
/* For integers known to be positive, XFASTINT provides fast retrieval
and XSETFASTINT provides fast storage. This takes advantage of the
- fact that Lisp_Int is 0. */
-#define XFASTINT(a) ((a) + 0)
-#define XSETFASTINT(a, b) ((a) = (b))
+ fact that Lisp integers have zero-bits in their tags. */
+#define XFASTINT(a) (XLI (a) + 0)
+#define XSETFASTINT(a, b) ((a) = XIL (b))
/* Extract the value of a Lisp_Object as a (un)signed integer. */
-#ifdef USE_2_TAGS_FOR_INTS
-# define XINT(a) ((((EMACS_INT) (a)) << (GCTYPEBITS - 1)) >> (GCTYPEBITS - 1))
-# define XUINT(a) ((EMACS_UINT) ((a) & (1 + (VALMASK << 1))))
-# define make_number(N) ((((EMACS_INT) (N)) & (1 + (VALMASK << 1))))
-#else
-# define XINT(a) ((((EMACS_INT) (a)) << (BITS_PER_EMACS_INT - VALBITS)) \
- >> (BITS_PER_EMACS_INT - VALBITS))
-# define XUINT(a) ((EMACS_UINT) ((a) & VALMASK))
-# define make_number(N) \
- ((((EMACS_INT) (N)) & VALMASK) | ((EMACS_INT) Lisp_Int) << VALBITS)
-#endif
+#define XINT(a) (XLI (a) << INTTYPEBITS >> INTTYPEBITS)
+#define XUINT(a) ((EMACS_UINT) (XLI (a) & INTMASK))
+#define make_number(N) XIL ((EMACS_INT) (N) & INTMASK)
-#define XSET(var, type, ptr) \
- ((var) = ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \
- + ((intptr_t) (ptr) & VALMASK)))
+#define make_lisp_ptr(ptr, type) \
+ (XIL ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \
+ + ((intptr_t) (ptr) & VALMASK)))
-#ifdef DATA_SEG_BITS
+#if DATA_SEG_BITS
/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
- which were stored in a Lisp_Object */
-#define XPNTR(a) ((uintptr_t) (((a) & VALMASK)) | DATA_SEG_BITS))
+ which were stored in a Lisp_Object. */
+#define XPNTR(a) ((uintptr_t) ((XLI (a) & VALMASK)) | DATA_SEG_BITS))
#else
-#define XPNTR(a) ((uintptr_t) ((a) & VALMASK))
+#define XPNTR(a) ((uintptr_t) (XLI (a) & VALMASK))
#endif
#endif /* not USE_LSB_TAG */
-#else /* USE_LISP_UNION_TYPE */
-
-#ifdef USE_2_TAGS_FOR_INTS
-# error "USE_2_TAGS_FOR_INTS is not supported with USE_LISP_UNION_TYPE"
-#endif
-
-#define XHASH(a) ((a).i)
-#define XTYPE(a) ((enum Lisp_Type) (a).u.type)
-#define XINT(a) ((EMACS_INT) (a).s.val)
-#define XUINT(a) ((EMACS_UINT) (a).u.val)
-
-#ifdef USE_LSB_TAG
-
-# define XSET(var, vartype, ptr) \
- (eassert ((((uintptr_t) (ptr)) & ((1 << GCTYPEBITS) - 1)) == 0), \
- (var).u.val = ((uintptr_t) (ptr)) >> GCTYPEBITS, \
- (var).u.type = ((char) (vartype)))
-
-/* Some versions of gcc seem to consider the bitfield width when issuing
- the "cast to pointer from integer of different size" warning, so the
- cast is here to widen the value back to its natural size. */
-# define XPNTR(v) ((intptr_t) (v).s.val << GCTYPEBITS)
-
-#else /* !USE_LSB_TAG */
-
-/* For integers known to be positive, XFASTINT provides fast retrieval
- and XSETFASTINT provides fast storage. This takes advantage of the
- fact that Lisp_Int is 0. */
-# define XFASTINT(a) ((a).i + 0)
-# define XSETFASTINT(a, b) ((a).i = (b))
-
-# define XSET(var, vartype, ptr) \
- (((var).s.val = ((intptr_t) (ptr))), ((var).s.type = ((char) (vartype))))
-
-#ifdef DATA_SEG_BITS
-/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
- which were stored in a Lisp_Object */
-#define XPNTR(a) ((intptr_t) (XUINT (a) | DATA_SEG_BITS))
-#else
-#define XPNTR(a) ((intptr_t) XUINT (a))
-#endif
-
-#endif /* !USE_LSB_TAG */
-
-#if __GNUC__ >= 2 && defined (__OPTIMIZE__)
-#define make_number(N) \
- (__extension__ ({ Lisp_Object _l; _l.s.val = (N); _l.s.type = Lisp_Int; _l; }))
-#else
-extern Lisp_Object make_number (EMACS_INT);
-#endif
-
-#endif /* USE_LISP_UNION_TYPE */
+/* Return a (Lisp-integer sized) hash of the Lisp_Object value. Happens to be
+ like XUINT right now, but XUINT should only be applied to objects we know
+ are integers. */
+#define XHASH(a) XUINT (a)
/* For integers known to be positive, XFASTINT sometimes provides
faster retrieval and XSETFASTINT provides faster storage.
@@ -575,21 +519,18 @@ extern Lisp_Object make_number (EMACS_INT);
# define XSETFASTINT(a, b) (XSETINT (a, b))
#endif
-#define EQ(x, y) (XHASH (x) == XHASH (y))
-
-/* Number of bits in a fixnum, including the sign bit. */
-#ifdef USE_2_TAGS_FOR_INTS
-# define FIXNUM_BITS (VALBITS + 1)
-#else
-# define FIXNUM_BITS VALBITS
+/* Extract the pointer value of the Lisp object A, under the
+ assumption that A's type is TYPE. This is a fallback
+ implementation if nothing faster is available. */
+#ifndef XUNTAG
+# define XUNTAG(a, type) XPNTR (a)
#endif
-/* Mask indicating the significant bits of a fixnum. */
-#define INTMASK (((EMACS_INT) 1 << FIXNUM_BITS) - 1)
+#define EQ(x, y) (XLI (x) == XLI (y))
/* Largest and smallest representable fixnum values. These are the C
- values. */
-#define MOST_POSITIVE_FIXNUM (INTMASK / 2)
+ values. They are macros for use in static initializers. */
+#define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
/* Value is non-zero if I doesn't fit into a Lisp fixnum. It is
@@ -599,17 +540,28 @@ extern Lisp_Object make_number (EMACS_INT);
#define FIXNUM_OVERFLOW_P(i) \
(! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM))
+LISP_INLINE ptrdiff_t
+clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
+{
+ return num < lower ? lower : num <= upper ? num : upper;
+}
+
/* Extract a value or address from a Lisp_Object. */
-#define XCONS(a) (eassert (CONSP (a)), (struct Lisp_Cons *) XPNTR (a))
-#define XVECTOR(a) (eassert (VECTORLIKEP (a)), (struct Lisp_Vector *) XPNTR (a))
-#define XSTRING(a) (eassert (STRINGP (a)), (struct Lisp_String *) XPNTR (a))
-#define XSYMBOL(a) (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XPNTR (a))
-#define XFLOAT(a) (eassert (FLOATP (a)), (struct Lisp_Float *) XPNTR (a))
+#define XCONS(a) (eassert (CONSP (a)), \
+ (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
+#define XVECTOR(a) (eassert (VECTORLIKEP (a)), \
+ (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike))
+#define XSTRING(a) (eassert (STRINGP (a)), \
+ (struct Lisp_String *) XUNTAG (a, Lisp_String))
+#define XSYMBOL(a) (eassert (SYMBOLP (a)), \
+ (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol))
+#define XFLOAT(a) (eassert (FLOATP (a)), \
+ (struct Lisp_Float *) XUNTAG (a, Lisp_Float))
/* Misc types. */
-#define XMISC(a) ((union Lisp_Misc *) XPNTR (a))
+#define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc))
#define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any))
#define XMISCTYPE(a) (XMISCANY (a)->type)
#define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker))
@@ -629,55 +581,67 @@ extern Lisp_Object make_number (EMACS_INT);
/* Pseudovector types. */
-#define XPROCESS(a) (eassert (PROCESSP (a)), (struct Lisp_Process *) XPNTR (a))
-#define XWINDOW(a) (eassert (WINDOWP (a)), (struct window *) XPNTR (a))
-#define XTERMINAL(a) (eassert (TERMINALP (a)), (struct terminal *) XPNTR (a))
-#define XSUBR(a) (eassert (SUBRP (a)), (struct Lisp_Subr *) XPNTR (a))
-#define XBUFFER(a) (eassert (BUFFERP (a)), (struct buffer *) XPNTR (a))
-#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), (struct Lisp_Char_Table *) XPNTR (a))
-#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), (struct Lisp_Sub_Char_Table *) XPNTR (a))
-#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), (struct Lisp_Bool_Vector *) XPNTR (a))
+#define XPROCESS(a) (eassert (PROCESSP (a)), \
+ (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike))
+#define XWINDOW(a) (eassert (WINDOWP (a)), \
+ (struct window *) XUNTAG (a, Lisp_Vectorlike))
+#define XTERMINAL(a) (eassert (TERMINALP (a)), \
+ (struct terminal *) XUNTAG (a, Lisp_Vectorlike))
+#define XSUBR(a) (eassert (SUBRP (a)), \
+ (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike))
+#define XBUFFER(a) (eassert (BUFFERP (a)), \
+ (struct buffer *) XUNTAG (a, Lisp_Vectorlike))
+#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \
+ (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike))
+#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \
+ ((struct Lisp_Sub_Char_Table *) \
+ XUNTAG (a, Lisp_Vectorlike)))
+#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \
+ ((struct Lisp_Bool_Vector *) \
+ XUNTAG (a, Lisp_Vectorlike)))
/* Construct a Lisp_Object from a value or address. */
-#define XSETINT(a, b) (a) = make_number (b)
-#define XSETCONS(a, b) XSET (a, Lisp_Cons, b)
-#define XSETVECTOR(a, b) XSET (a, Lisp_Vectorlike, b)
-#define XSETSTRING(a, b) XSET (a, Lisp_String, b)
-#define XSETSYMBOL(a, b) XSET (a, Lisp_Symbol, b)
-#define XSETFLOAT(a, b) XSET (a, Lisp_Float, b)
+#define XSETINT(a, b) ((a) = make_number (b))
+#define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons))
+#define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike))
+#define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String))
+#define XSETSYMBOL(a, b) ((a) = make_lisp_ptr (b, Lisp_Symbol))
+#define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float))
/* Misc types. */
-#define XSETMISC(a, b) XSET (a, Lisp_Misc, b)
+#define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc))
#define XSETMARKER(a, b) (XSETMISC (a, b), XMISCTYPE (a) = Lisp_Misc_Marker)
/* Pseudovector types. */
-#define XSETPVECTYPE(v, code) XSETTYPED_PVECTYPE (v, header.size, code)
-#define XSETTYPED_PVECTYPE(v, size_member, code) \
- ((v)->size_member |= PSEUDOVECTOR_FLAG | (code))
-#define XSETPVECTYPESIZE(v, code, sizeval) \
- ((v)->header.size = PSEUDOVECTOR_FLAG | (code) | (sizeval))
+#define XSETPVECTYPE(v, code) \
+ ((v)->header.size |= PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))
+#define XSETPVECTYPESIZE(v, code, lispsize, restsize) \
+ ((v)->header.size = (PSEUDOVECTOR_FLAG \
+ | ((code) << PSEUDOVECTOR_AREA_BITS) \
+ | ((restsize) << PSEUDOVECTOR_SIZE_BITS) \
+ | (lispsize)))
/* The cast to struct vectorlike_header * avoids aliasing issues. */
#define XSETPSEUDOVECTOR(a, b, code) \
- XSETTYPED_PSEUDOVECTOR(a, b, \
- ((struct vectorlike_header *) XPNTR (a))->size, \
- code)
+ XSETTYPED_PSEUDOVECTOR (a, b, \
+ (((struct vectorlike_header *) \
+ XUNTAG (a, Lisp_Vectorlike)) \
+ ->size), \
+ code)
#define XSETTYPED_PSEUDOVECTOR(a, b, size, code) \
(XSETVECTOR (a, b), \
eassert ((size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
- == (PSEUDOVECTOR_FLAG | (code))))
+ == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))))
#define XSETWINDOW_CONFIGURATION(a, b) \
(XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION))
#define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
#define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
#define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
-/* XSETSUBR is special since Lisp_Subr lacks struct vectorlike_header. */
-#define XSETSUBR(a, b) \
- XSETTYPED_PSEUDOVECTOR (a, b, XSUBR (a)->size, PVEC_SUBR)
+#define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
#define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
#define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
#define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
@@ -688,11 +652,9 @@ extern Lisp_Object make_number (EMACS_INT);
#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX]
#define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size
-/* The IDX==IDX tries to detect when the macro argument is side-effecting. */
#define ASET(ARRAY, IDX, VAL) \
- (eassert ((IDX) == (IDX)), \
- eassert ((IDX) >= 0 && (IDX) < ASIZE (ARRAY)), \
- AREF ((ARRAY), (IDX)) = (VAL))
+ (eassert (0 <= (IDX) && (IDX) < ASIZE (ARRAY)), \
+ XVECTOR (ARRAY)->contents[IDX] = (VAL))
/* Convenience macros for dealing with Lisp strings. */
@@ -716,38 +678,31 @@ extern Lisp_Object make_number (EMACS_INT);
#define CHECK_TYPE(ok, Qxxxp, x) \
do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0)
+/* Deprecated and will be removed soon. */
+
+#define INTERNAL_FIELD(field) field ## _
-
/* See the macros in intervals.h. */
typedef struct interval *INTERVAL;
-/* Complain if object is not string or buffer type */
+/* Complain if object is not string or buffer type. */
#define CHECK_STRING_OR_BUFFER(x) \
CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x)
-
-/* In a cons, the markbit of the car is the gc mark bit */
-
struct Lisp_Cons
{
- /* Please do not use the names of these elements in code other
- than the core lisp implementation. Use XCAR and XCDR below. */
-#ifdef HIDE_LISP_IMPLEMENTATION
- Lisp_Object car_;
- union
- {
- Lisp_Object cdr_;
- struct Lisp_Cons *chain;
- } u;
-#else
+ /* Car of this cons cell. */
Lisp_Object car;
+
union
{
+ /* Cdr of this cons cell. */
Lisp_Object cdr;
+
+ /* Used to chain conses on a free list. */
struct Lisp_Cons *chain;
} u;
-#endif
};
/* Take the car or cdr of something known to be a cons cell. */
@@ -757,13 +712,8 @@ struct Lisp_Cons
fields are not accessible as lvalues. (What if we want to switch to
a copying collector someday? Cached cons cell field addresses may be
invalidated at arbitrary points.) */
-#ifdef HIDE_LISP_IMPLEMENTATION
-#define XCAR_AS_LVALUE(c) (XCONS ((c))->car_)
-#define XCDR_AS_LVALUE(c) (XCONS ((c))->u.cdr_)
-#else
-#define XCAR_AS_LVALUE(c) (XCONS ((c))->car)
-#define XCDR_AS_LVALUE(c) (XCONS ((c))->u.cdr)
-#endif
+#define XCAR_AS_LVALUE(c) (XCONS (c)->car)
+#define XCDR_AS_LVALUE(c) (XCONS (c)->u.cdr)
/* Use these from normal code. */
#define XCAR(c) LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c))
@@ -796,7 +746,7 @@ struct Lisp_Cons
#define CDR_SAFE(c) \
(CONSP ((c)) ? XCDR ((c)) : Qnil)
-/* Nonzero if STR is a multibyte string. */
+/* True if STR is a multibyte string. */
#define STRING_MULTIBYTE(STR) \
(XSTRING (STR)->size_byte >= 0)
@@ -805,7 +755,7 @@ struct Lisp_Cons
#ifdef GC_CHECK_STRING_BYTES
struct Lisp_String;
-extern EMACS_INT string_bytes (struct Lisp_String *);
+extern ptrdiff_t string_bytes (struct Lisp_String *);
#define STRING_BYTES(S) string_bytes ((S))
#else /* not GC_CHECK_STRING_BYTES */
@@ -824,10 +774,15 @@ extern EMACS_INT string_bytes (struct Lisp_String *);
Although the actual size limit (see STRING_BYTES_MAX in alloc.c)
may be a bit smaller than STRING_BYTES_BOUND, calculating it here
would expose alloc.c internal details that we'd rather keep
- private. The cast to ptrdiff_t ensures that STRING_BYTES_BOUND is
- signed. */
+ private.
+
+ This is a macro for use in static initializers, and a constant for
+ visibility to GDB. The cast to ptrdiff_t ensures that
+ the macro is signed. */
+static ptrdiff_t const STRING_BYTES_BOUND =
#define STRING_BYTES_BOUND \
- min (MOST_POSITIVE_FIXNUM, (ptrdiff_t) min (SIZE_MAX, PTRDIFF_MAX) - 1)
+ ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, min (SIZE_MAX, PTRDIFF_MAX) - 1))
+ STRING_BYTES_BOUND;
/* Mark STR as a unibyte string. */
#define STRING_SET_UNIBYTE(STR) \
@@ -842,24 +797,18 @@ extern EMACS_INT string_bytes (struct Lisp_String *);
(STR) = empty_multibyte_string; \
else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0)
-/* Get text properties. */
-#define STRING_INTERVALS(STR) (XSTRING (STR)->intervals + 0)
-
-/* Set text properties. */
-#define STRING_SET_INTERVALS(STR, INT) (XSTRING (STR)->intervals = (INT))
-
-/* In a string or vector, the sign bit of the `size' is the gc mark bit */
+/* In a string or vector, the sign bit of the `size' is the gc mark bit. */
struct Lisp_String
{
- EMACS_INT size;
- EMACS_INT size_byte;
- INTERVAL intervals; /* text properties in this string */
+ ptrdiff_t size;
+ ptrdiff_t size_byte;
+ INTERVAL intervals; /* Text properties in this string. */
unsigned char *data;
};
/* Header of vector-like objects. This documents the layout constraints on
- vectors and pseudovectors other than struct Lisp_Subr. It also prevents
+ vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents
compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR
and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *,
because when two such pointers potentially alias, a compiler won't
@@ -867,37 +816,71 @@ struct Lisp_String
<http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */
struct vectorlike_header
{
- EMACS_INT size;
-
- /* Pointer to the next vector-like object. It is generally a buffer or a
- Lisp_Vector alias, so for convenience it is a union instead of a
- pointer: this way, one can write P->next.vector instead of ((struct
- Lisp_Vector *) P->next). */
- union {
- struct buffer *buffer;
- struct Lisp_Vector *vector;
- } next;
+ /* The only field contains various pieces of information:
+ - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit.
+ - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain
+ vector (0) or a pseudovector (1).
+ - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number
+ of slots) of the vector.
+ - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into three fields:
+ - a) pseudovector subtype held in PVEC_TYPE_MASK field;
+ - b) number of Lisp_Objects slots at the beginning of the object
+ held in PSEUDOVECTOR_SIZE_MASK field. These objects are always
+ traced by the GC;
+ - c) size of the rest fields held in PSEUDOVECTOR_REST_MASK and
+ measured in word_size units. Rest fields may also include
+ Lisp_Objects, but these objects usually needs some special treatment
+ during GC.
+ There are some exceptions. For PVEC_FREE, b) is always zero. For
+ PVEC_BOOL_VECTOR and PVEC_SUBR, both b) and c) are always zero.
+ Current layout limits the pseudovectors to 63 PVEC_xxx subtypes,
+ 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */
+ ptrdiff_t size;
};
+/* Regular vector is just a header plus array of Lisp_Objects. */
+
struct Lisp_Vector
{
struct vectorlike_header header;
Lisp_Object contents[1];
};
+/* A boolvector is a kind of vectorlike, with contents are like a string. */
+
+struct Lisp_Bool_Vector
+ {
+ /* HEADER.SIZE is the vector's size field. It doesn't have the real size,
+ just the subtype information. */
+ struct vectorlike_header header;
+ /* This is the size in bits. */
+ EMACS_INT size;
+ /* This contains the actual bits, packed into bytes. */
+ unsigned char data[1];
+ };
+
+/* Some handy constants for calculating sizes
+ and offsets, mostly of vectorlike objects. */
+
+enum
+ {
+ header_size = offsetof (struct Lisp_Vector, contents),
+ bool_header_size = offsetof (struct Lisp_Bool_Vector, data),
+ word_size = sizeof (Lisp_Object)
+ };
+
/* If a struct is made to look like a vector, this macro returns the length
of the shortest vector that would hold that struct. */
-#define VECSIZE(type) ((sizeof (type) \
- - offsetof (struct Lisp_Vector, contents[0]) \
- + sizeof (Lisp_Object) - 1) /* round up */ \
- / sizeof (Lisp_Object))
+
+#define VECSIZE(type) \
+ ((sizeof (type) - header_size + word_size - 1) / word_size)
/* Like VECSIZE, but used when the pseudo-vector has non-Lisp_Object fields
at the end and we need to compute the number of Lisp_Object fields (the
ones that the GC needs to trace). */
-#define PSEUDOVECSIZE(type, nonlispfield) \
- ((offsetof (type, nonlispfield) - offsetof (struct Lisp_Vector, contents[0])) \
- / sizeof (Lisp_Object))
+
+#define PSEUDOVECSIZE(type, nonlispfield) \
+ ((offsetof (type, nonlispfield) - header_size) / word_size)
/* A char-table is a kind of vectorlike, with contents are like a
vector but with a few other slots. For some purposes, it makes
@@ -909,16 +892,6 @@ struct Lisp_Vector
of a char-table, and there's no way to access it directly from
Emacs Lisp program. */
-/* This is the number of slots that every char table must have. This
- counts the ordinary slots and the top, defalt, parent, and purpose
- slots. */
-#define CHAR_TABLE_STANDARD_SLOTS (VECSIZE (struct Lisp_Char_Table) - 1)
-
-/* Return the number of "extra" slots in the char table CT. */
-
-#define CHAR_TABLE_EXTRA_SLOTS(CT) \
- (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS)
-
#ifdef __GNUC__
#define CHAR_TABLE_REF_ASCII(CT, IDX) \
@@ -965,30 +938,23 @@ struct Lisp_Vector
(ASCII_CHAR_P (IDX) ? CHAR_TABLE_REF_ASCII ((CT), (IDX)) \
: char_table_ref ((CT), (IDX)))
-/* Almost equivalent to Faref (CT, IDX). However, if the result is
- not a character, return IDX.
-
- For these characters, do not check validity of CT
- and do not follow parent. */
-#define CHAR_TABLE_TRANSLATE(CT, IDX) \
- char_table_translate (CT, IDX)
-
/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and
8-bit European characters. Do not check validity of CT. */
#define CHAR_TABLE_SET(CT, IDX, VAL) \
(ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \
- ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] = VAL \
+ ? set_sub_char_table_contents (XCHAR_TABLE (CT)->ascii, IDX, VAL) \
: char_table_set (CT, IDX, VAL))
-#define CHARTAB_SIZE_BITS_0 6
-#define CHARTAB_SIZE_BITS_1 4
-#define CHARTAB_SIZE_BITS_2 5
-#define CHARTAB_SIZE_BITS_3 7
+enum CHARTAB_SIZE_BITS
+ {
+ CHARTAB_SIZE_BITS_0 = 6,
+ CHARTAB_SIZE_BITS_1 = 4,
+ CHARTAB_SIZE_BITS_2 = 5,
+ CHARTAB_SIZE_BITS_3 = 7
+ };
extern const int chartab_size[4];
-struct Lisp_Sub_Char_Table;
-
struct Lisp_Char_Table
{
/* HEADER.SIZE is the vector's size field, which also holds the
@@ -1037,32 +1003,17 @@ struct Lisp_Sub_Char_Table
/* Minimum character covered by the sub char-table. */
Lisp_Object min_char;
+ /* Use set_sub_char_table_contents to set this. */
Lisp_Object contents[1];
};
-/* A boolvector is a kind of vectorlike, with contents are like a string. */
-struct Lisp_Bool_Vector
- {
- /* HEADER.SIZE is the vector's size field. It doesn't have the real size,
- just the subtype information. */
- struct vectorlike_header header;
- /* This is the size in bits. */
- EMACS_INT size;
- /* This contains the actual bits, packed into bytes. */
- unsigned char data[1];
- };
-
/* This structure describes a built-in function.
It is generated by the DEFUN macro only.
- defsubr makes it into a Lisp object.
-
- This type is treated in most respects as a pseudovector,
- but since we never dynamically allocate or free them,
- we don't need a struct vectorlike_header and its 'next' field. */
+ defsubr makes it into a Lisp object. */
struct Lisp_Subr
{
- EMACS_INT size;
+ struct vectorlike_header header;
union {
Lisp_Object (*a0) (void);
Lisp_Object (*a1) (Lisp_Object);
@@ -1082,6 +1033,19 @@ struct Lisp_Subr
const char *doc;
};
+/* This is the number of slots that every char table must have. This
+ counts the ordinary slots and the top, defalt, parent, and purpose
+ slots. */
+enum CHAR_TABLE_STANDARD_SLOTS
+ {
+ CHAR_TABLE_STANDARD_SLOTS = VECSIZE (struct Lisp_Char_Table) - 1
+ };
+
+/* Return the number of "extra" slots in the char table CT. */
+
+#define CHAR_TABLE_EXTRA_SLOTS(CT) \
+ (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS)
+
/***********************************************************************
Symbols
@@ -1128,10 +1092,8 @@ struct Lisp_Symbol
special (with `defvar' etc), and shouldn't be lexically bound. */
unsigned declared_special : 1;
- /* The symbol's name, as a Lisp string.
- The name "xname" is used to intentionally break code referring to
- the old field "name" of type pointer to struct Lisp_String. */
- Lisp_Object xname;
+ /* The symbol's name, as a Lisp string. */
+ Lisp_Object name;
/* Value of the symbol or Qunbound if unbound. Which alternative of the
union is used depends on the `redirect' field above. */
@@ -1142,7 +1104,7 @@ struct Lisp_Symbol
union Lisp_Fwd *fwd;
} val;
- /* Function value of the symbol or Qunbound if not fboundp. */
+ /* Function value of the symbol or Qnil if not fboundp. */
Lisp_Object function;
/* The symbol's property list. */
@@ -1154,43 +1116,42 @@ struct Lisp_Symbol
/* Value is name of symbol. */
-#define SYMBOL_VAL(sym) \
- (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
-#define SYMBOL_ALIAS(sym) \
+#define SYMBOL_VAL(sym) \
+ (eassert ((sym)->redirect == SYMBOL_PLAINVAL), sym->val.value)
+#define SYMBOL_ALIAS(sym) \
(eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias)
-#define SYMBOL_BLV(sym) \
+#define SYMBOL_BLV(sym) \
(eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv)
-#define SYMBOL_FWD(sym) \
+#define SYMBOL_FWD(sym) \
(eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd)
-#define SET_SYMBOL_VAL(sym, v) \
+#define SET_SYMBOL_VAL(sym, v) \
(eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
-#define SET_SYMBOL_ALIAS(sym, v) \
+#define SET_SYMBOL_ALIAS(sym, v) \
(eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v))
-#define SET_SYMBOL_BLV(sym, v) \
+#define SET_SYMBOL_BLV(sym, v) \
(eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v))
-#define SET_SYMBOL_FWD(sym, v) \
+#define SET_SYMBOL_FWD(sym, v) \
(eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v))
-#define SYMBOL_NAME(sym) \
- LISP_MAKE_RVALUE (XSYMBOL (sym)->xname)
+#define SYMBOL_NAME(sym) XSYMBOL (sym)->name
/* Value is non-zero if SYM is an interned symbol. */
-#define SYMBOL_INTERNED_P(sym) \
- (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED)
+#define SYMBOL_INTERNED_P(sym) \
+ (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED)
/* Value is non-zero if SYM is interned in initial_obarray. */
-#define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \
- (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY)
+#define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \
+ (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY)
/* Value is non-zero if symbol is considered a constant, i.e. its
value cannot be changed (there is an exception for keyword symbols,
whose value can be set to the keyword symbol itself). */
-#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant
+#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant
-#define DEFSYM(sym, name) \
+#define DEFSYM(sym, name) \
do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0)
@@ -1200,14 +1161,29 @@ struct Lisp_Symbol
/* The structure of a Lisp hash table. */
+struct hash_table_test
+{
+ /* Name of the function used to compare keys. */
+ Lisp_Object name;
+
+ /* User-supplied hash function, or nil. */
+ Lisp_Object user_hash_function;
+
+ /* User-supplied key comparison function, or nil. */
+ Lisp_Object user_cmp_function;
+
+ /* C function to compare two keys. */
+ bool (*cmpfn) (struct hash_table_test *t, Lisp_Object, Lisp_Object);
+
+ /* C function to compute hash code. */
+ EMACS_UINT (*hashfn) (struct hash_table_test *t, Lisp_Object);
+};
+
struct Lisp_Hash_Table
{
/* This is for Lisp; the hash table code does not refer to it. */
struct vectorlike_header header;
- /* Function used to compare keys. */
- Lisp_Object test;
-
/* Nil if table is non-weak. Otherwise a symbol describing the
weakness of the table. */
Lisp_Object weak;
@@ -1238,40 +1214,29 @@ struct Lisp_Hash_Table
hash table size to reduce collisions. */
Lisp_Object index;
- /* User-supplied hash function, or nil. */
- Lisp_Object user_hash_function;
-
- /* User-supplied key comparison function, or nil. */
- Lisp_Object user_cmp_function;
-
/* Only the fields above are traced normally by the GC. The ones below
`count' are special and are either ignored by the GC or traced in
a special way (e.g. because of weakness). */
/* Number of key/value entries in the table. */
- EMACS_INT count;
+ ptrdiff_t count;
/* Vector of keys and values. The key of item I is found at index
2 * I, the value is found at index 2 * I + 1.
This is gc_marked specially if the table is weak. */
Lisp_Object key_and_value;
+ /* The comparison and hash functions. */
+ struct hash_table_test test;
+
/* Next weak hash table if this is a weak hash table. The head
of the list is in weak_hash_tables. */
struct Lisp_Hash_Table *next_weak;
-
- /* C function to compare two keys. */
- int (*cmpfn) (struct Lisp_Hash_Table *,
- Lisp_Object, EMACS_UINT,
- Lisp_Object, EMACS_UINT);
-
- /* C function to compute hash code. */
- EMACS_UINT (*hashfn) (struct Lisp_Hash_Table *, Lisp_Object);
};
#define XHASH_TABLE(OBJ) \
- ((struct Lisp_Hash_Table *) XPNTR (OBJ))
+ ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike))
#define XSET_HASH_TABLE(VAR, PTR) \
(XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
@@ -1309,19 +1274,27 @@ struct Lisp_Hash_Table
/* Default size for hash tables if not specified. */
-#define DEFAULT_HASH_SIZE 65
+enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 };
/* Default threshold specifying when to resize a hash table. The
value gives the ratio of current entries in the hash table and the
size of the hash table. */
-#define DEFAULT_REHASH_THRESHOLD 0.8
+static double const DEFAULT_REHASH_THRESHOLD = 0.8;
/* Default factor by which to increase the size of a hash table. */
-#define DEFAULT_REHASH_SIZE 1.5
+static double const DEFAULT_REHASH_SIZE = 1.5;
+
+/* Combine two integers X and Y for hashing. The result might not fit
+ into a Lisp integer. */
+
+LISP_INLINE EMACS_UINT
+sxhash_combine (EMACS_UINT x, EMACS_UINT y)
+{
+ return (x << 4) + (x >> (BITS_PER_EMACS_INT - 4)) + y;
+}
-
/* These structures are used for various misc types. */
struct Lisp_Misc_Any /* Supertype of all Misc types. */
@@ -1329,8 +1302,6 @@ struct Lisp_Misc_Any /* Supertype of all Misc types. */
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_??? */
unsigned gcmarkbit : 1;
int spacer : 15;
- /* Make it as long as "Lisp_Free without padding". */
- void *fill;
};
struct Lisp_Marker
@@ -1366,14 +1337,74 @@ struct Lisp_Marker
That would also allow to preserve it ordered. */
struct Lisp_Marker *next;
/* This is the char position where the marker points. */
- EMACS_INT charpos;
+ ptrdiff_t charpos;
/* This is the byte position.
It's mostly used as a charpos<->bytepos cache (i.e. it's not directly
used to implement the functionality of markers, but rather to (ab)use
markers as a cache for char<->byte mappings). */
- EMACS_INT bytepos;
+ ptrdiff_t bytepos;
};
+/* START and END are markers in the overlay's buffer, and
+ PLIST is the overlay's property list. */
+struct Lisp_Overlay
+/* An overlay's real data content is:
+ - plist
+ - buffer (really there are two buffer pointers, one per marker,
+ and both points to the same buffer)
+ - insertion type of both ends (per-marker fields)
+ - start & start byte (of start marker)
+ - end & end byte (of end marker)
+ - next (singly linked list of overlays)
+ - next fields of start and end markers (singly linked list of markers).
+ I.e. 9words plus 2 bits, 3words of which are for external linked lists.
+*/
+ {
+ ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */
+ unsigned gcmarkbit : 1;
+ int spacer : 15;
+ struct Lisp_Overlay *next;
+ Lisp_Object start;
+ Lisp_Object end;
+ Lisp_Object plist;
+ };
+
+/* Hold a C pointer for later use.
+ This type of object is used in the arg to record_unwind_protect. */
+struct Lisp_Save_Value
+ {
+ ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */
+ unsigned gcmarkbit : 1;
+ int spacer : 14;
+ /* If DOGC is set, POINTER is the address of a memory
+ area containing INTEGER potential Lisp_Objects. */
+ unsigned int dogc : 1;
+ void *pointer;
+ ptrdiff_t integer;
+ };
+
+
+/* A miscellaneous object, when it's on the free list. */
+struct Lisp_Free
+ {
+ ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */
+ unsigned gcmarkbit : 1;
+ int spacer : 15;
+ union Lisp_Misc *chain;
+ };
+
+/* To get the type field of a union Lisp_Misc, use XMISCTYPE.
+ It uses one of these struct subtypes to get the type field. */
+
+union Lisp_Misc
+ {
+ struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */
+ struct Lisp_Free u_free;
+ struct Lisp_Marker u_marker;
+ struct Lisp_Overlay u_overlay;
+ struct Lisp_Save_Value u_save_value;
+ };
+
/* Forwarding pointer to an int variable.
This is allowed only in the value cell of a symbol,
and it means that the symbol's value really lives in the
@@ -1391,7 +1422,7 @@ struct Lisp_Intfwd
struct Lisp_Boolfwd
{
enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Bool */
- int *boolvar;
+ bool *boolvar;
};
/* Forwarding pointer to a Lisp_Object variable.
@@ -1440,13 +1471,13 @@ struct Lisp_Buffer_Objfwd
struct Lisp_Buffer_Local_Value
{
/* 1 means that merely setting the variable creates a local
- binding for the current buffer */
+ binding for the current buffer. */
unsigned int local_if_set : 1;
/* 1 means this variable can have frame-local bindings, otherwise, it is
can have buffer-local bindings. The two cannot be combined. */
unsigned int frame_local : 1;
/* 1 means that the binding now loaded was found.
- Presumably equivalent to (defcell!=valcell) */
+ Presumably equivalent to (defcell!=valcell). */
unsigned int found : 1;
/* If non-NULL, a forwarding to the C var where it should also be set. */
union Lisp_Fwd *fwd; /* Should never be (Buffer|Kboard)_Objfwd. */
@@ -1463,35 +1494,6 @@ struct Lisp_Buffer_Local_Value
Lisp_Object valcell;
};
-#define BLV_FOUND(blv) \
- (eassert ((blv)->found == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found)
-#define SET_BLV_FOUND(blv, v) \
- (eassert ((v) == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found = (v))
-
-#define BLV_VALUE(blv) (XCDR ((blv)->valcell))
-#define SET_BLV_VALUE(blv, v) (XSETCDR ((blv)->valcell, v))
-
-/* START and END are markers in the overlay's buffer, and
- PLIST is the overlay's property list. */
-struct Lisp_Overlay
-/* An overlay's real data content is:
- - plist
- - buffer
- - insertion type of both ends
- - start & start_byte
- - end & end_byte
- - next (singly linked list of overlays).
- - start_next and end_next (singly linked list of markers).
- I.e. 9words plus 2 bits, 3words of which are for external linked lists.
-*/
- {
- ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */
- unsigned gcmarkbit : 1;
- int spacer : 15;
- struct Lisp_Overlay *next;
- Lisp_Object start, end, plist;
- };
-
/* Like Lisp_Objfwd except that value lives in a slot in the
current kboard. */
struct Lisp_Kboard_Objfwd
@@ -1500,80 +1502,37 @@ struct Lisp_Kboard_Objfwd
int offset;
};
-/* Hold a C pointer for later use.
- This type of object is used in the arg to record_unwind_protect. */
-struct Lisp_Save_Value
- {
- ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */
- unsigned gcmarkbit : 1;
- int spacer : 14;
- /* If DOGC is set, POINTER is the address of a memory
- area containing INTEGER potential Lisp_Objects. */
- unsigned int dogc : 1;
- void *pointer;
- ptrdiff_t integer;
- };
-
-
-/* A miscellaneous object, when it's on the free list. */
-struct Lisp_Free
- {
- ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */
- unsigned gcmarkbit : 1;
- int spacer : 15;
- union Lisp_Misc *chain;
-#ifdef USE_LSB_TAG
- /* Try to make sure that sizeof(Lisp_Misc) preserves TYPEBITS-alignment.
- This assumes that Lisp_Marker is the largest of the alternatives and
- that Lisp_Misc_Any has the same size as "Lisp_Free w/o padding". */
- char padding[((((sizeof (struct Lisp_Marker) - 1) >> GCTYPEBITS) + 1)
- << GCTYPEBITS) - sizeof (struct Lisp_Misc_Any)];
-#endif
- };
-
-/* To get the type field of a union Lisp_Misc, use XMISCTYPE.
- It uses one of these struct subtypes to get the type field. */
-
-union Lisp_Misc
- {
- struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */
- struct Lisp_Free u_free; /* Includes padding to force alignment. */
- struct Lisp_Marker u_marker; /* 5 */
- struct Lisp_Overlay u_overlay; /* 5 */
- struct Lisp_Save_Value u_save_value; /* 3 */
- };
-
union Lisp_Fwd
{
- struct Lisp_Intfwd u_intfwd; /* 2 */
- struct Lisp_Boolfwd u_boolfwd; /* 2 */
- struct Lisp_Objfwd u_objfwd; /* 2 */
- struct Lisp_Buffer_Objfwd u_buffer_objfwd; /* 2 */
- struct Lisp_Kboard_Objfwd u_kboard_objfwd; /* 2 */
+ struct Lisp_Intfwd u_intfwd;
+ struct Lisp_Boolfwd u_boolfwd;
+ struct Lisp_Objfwd u_objfwd;
+ struct Lisp_Buffer_Objfwd u_buffer_objfwd;
+ struct Lisp_Kboard_Objfwd u_kboard_objfwd;
};
-/* Lisp floating point type */
+/* Lisp floating point type. */
struct Lisp_Float
{
union
{
-#ifdef HIDE_LISP_IMPLEMENTATION
- double data_;
-#else
double data;
-#endif
struct Lisp_Float *chain;
} u;
};
-#ifdef HIDE_LISP_IMPLEMENTATION
-#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data_ : XFLOAT (f)->u.data_)
-#else
-#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data)
-/* This should be used only in alloc.c, which always disables
- HIDE_LISP_IMPLEMENTATION. */
-#define XFLOAT_INIT(f,n) (XFLOAT (f)->u.data = (n))
-#endif
+#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data)
+#define XFLOAT_INIT(f, n) (XFLOAT (f)->u.data = (n))
+
+/* Most hosts nowadays use IEEE floating point, so they use IEC 60559
+ representations, have infinities and NaNs, and do not trap on
+ exceptions. Define IEEE_FLOATING_POINT if this host is one of the
+ typical ones. The C11 macro __STDC_IEC_559__ is close to what is
+ wanted here, but is not quite right because Emacs does not require
+ all the features of C11 Annex F (and does not require C11 at all,
+ for that matter). */
+#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
+ && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
/* A character, declared with the following typedef, is a member
of some character set associated with the current buffer. */
@@ -1584,31 +1543,38 @@ typedef unsigned char UCHAR;
/* Meanings of slots in a Lisp_Compiled: */
-#define COMPILED_ARGLIST 0
-#define COMPILED_BYTECODE 1
-#define COMPILED_CONSTANTS 2
-#define COMPILED_STACK_DEPTH 3
-#define COMPILED_DOC_STRING 4
-#define COMPILED_INTERACTIVE 5
+enum Lisp_Compiled
+ {
+ COMPILED_ARGLIST = 0,
+ COMPILED_BYTECODE = 1,
+ COMPILED_CONSTANTS = 2,
+ COMPILED_STACK_DEPTH = 3,
+ COMPILED_DOC_STRING = 4,
+ COMPILED_INTERACTIVE = 5
+ };
/* Flag bits in a character. These also get used in termhooks.h.
Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE
(MUlti-Lingual Emacs) might need 22 bits for the character value
itself, so we probably shouldn't use any bits lower than 0x0400000. */
-#define CHAR_ALT (0x0400000)
-#define CHAR_SUPER (0x0800000)
-#define CHAR_HYPER (0x1000000)
-#define CHAR_SHIFT (0x2000000)
-#define CHAR_CTL (0x4000000)
-#define CHAR_META (0x8000000)
-
-#define CHAR_MODIFIER_MASK \
- (CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META)
+enum char_bits
+ {
+ CHAR_ALT = 0x0400000,
+ CHAR_SUPER = 0x0800000,
+ CHAR_HYPER = 0x1000000,
+ CHAR_SHIFT = 0x2000000,
+ CHAR_CTL = 0x4000000,
+ CHAR_META = 0x8000000,
+
+ CHAR_MODIFIER_MASK =
+ CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META,
+
+ /* Actually, the current Emacs uses 22 bits for the character value
+ itself. */
+ CHARACTERBITS = 22
+ };
-/* Actually, the current Emacs uses 22 bits for the character value
- itself. */
-#define CHARACTERBITS 22
/* The glyph datatype, used to represent characters on the display.
@@ -1637,18 +1603,24 @@ typedef struct {
encodes a char code in the lower CHARACTERBITS bits and a (very small)
face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */
-#define GLYPH_CODE_CHAR(gc) \
- (CONSP (gc) ? XINT (XCAR (gc)) : INTEGERP (gc) ? (XINT (gc) & ((1 << CHARACTERBITS)-1)) : 0)
+#define GLYPH_CODE_P(gc) \
+ (CONSP (gc) \
+ ? (CHARACTERP (XCAR (gc)) \
+ && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) \
+ : (RANGED_INTEGERP \
+ (0, gc, \
+ (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS \
+ ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR \
+ : TYPE_MAXIMUM (EMACS_INT)))))
-#define GLYPH_CODE_FACE(gc) \
- (CONSP (gc) ? XINT (XCDR (gc)) : INTEGERP (gc) ? (XINT (gc) >> CHARACTERBITS) : DEFAULT_FACE_ID)
+/* The following are valid only if GLYPH_CODE_P (gc). */
-/* Return 1 if glyph code from display vector contains valid character code. */
-#define GLYPH_CODE_CHAR_VALID_P(gc) CHAR_VALID_P (GLYPH_CODE_CHAR (gc))
+#define GLYPH_CODE_CHAR(gc) \
+ (CONSP (gc) ? XINT (XCAR (gc)) : XINT (gc) & ((1 << CHARACTERBITS) - 1))
-#define GLYPH_CODE_P(gc) ((CONSP (gc) && INTEGERP (XCAR (gc)) && INTEGERP (XCDR (gc))) || INTEGERP (gc))
+#define GLYPH_CODE_FACE(gc) \
+ (CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS)
-/* Only called when GLYPH_CODE_P (gc) is true. */
#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \
do \
{ \
@@ -1659,9 +1631,6 @@ typedef struct {
(XINT (gc) >> CHARACTERBITS)); \
} \
while (0)
-
-/* The ID of the mode line highlighting face. */
-#define GLYPH_MODE_LINE_FACE 1
/* Structure to hold mouse highlight data. This is here because other
header files need it for defining struct x_output etc. */
@@ -1680,10 +1649,6 @@ typedef struct {
int mouse_face_face_id;
Lisp_Object mouse_face_overlay;
- /* 1 if a mouse motion event came and we didn't handle it right away because
- gc was in progress. */
- int mouse_face_deferred_gc;
-
/* FRAME and X, Y position of mouse when last checked for
highlighting. X and Y can be negative or out of range for the frame. */
struct frame *mouse_face_mouse_frame;
@@ -1698,7 +1663,7 @@ typedef struct {
int mouse_face_image_state;
} Mouse_HLInfo;
-/* Data type checking */
+/* Data type checking. */
#define NILP(x) EQ (x, Qnil)
@@ -1708,7 +1673,9 @@ typedef struct {
#define RANGED_INTEGERP(lo, x, hi) \
(INTEGERP (x) && (lo) <= XINT (x) && XINT (x) <= (hi))
#define TYPE_RANGED_INTEGERP(type, x) \
- RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type))
+ (TYPE_SIGNED (type) \
+ ? RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type)) \
+ : RANGED_INTEGERP (0, x, TYPE_MAXIMUM (type)))
#define INTEGERP(x) (LISP_INT_TAG_P (XTYPE ((x))))
#define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol)
@@ -1723,6 +1690,8 @@ typedef struct {
#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
#define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value)
+#define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x)))
+
#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int)
#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool)
#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj)
@@ -1732,23 +1701,24 @@ typedef struct {
/* True if object X is a pseudovector whose code is CODE. The cast to struct
vectorlike_header * avoids aliasing issues. */
#define PSEUDOVECTORP(x, code) \
- TYPED_PSEUDOVECTORP(x, vectorlike_header, code)
+ TYPED_PSEUDOVECTORP (x, vectorlike_header, code)
+
+#define PSEUDOVECTOR_TYPEP(v, code) \
+ (((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
+ == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS)))
/* True if object X, with internal type struct T *, is a pseudovector whose
code is CODE. */
#define TYPED_PSEUDOVECTORP(x, t, code) \
(VECTORLIKEP (x) \
- && (((((struct t *) XPNTR (x))->size \
- & (PSEUDOVECTOR_FLAG | (code)))) \
- == (PSEUDOVECTOR_FLAG | (code))))
+ && PSEUDOVECTOR_TYPEP ((struct t *) XUNTAG (x, Lisp_Vectorlike), code))
/* Test for specific pseudovector types. */
#define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION)
#define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS)
#define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW)
#define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL)
-/* SUBRP is special since Lisp_Subr lacks struct vectorlike_header. */
-#define SUBRP(x) TYPED_PSEUDOVECTORP (x, Lisp_Subr, PVEC_SUBR)
+#define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
@@ -1809,16 +1779,6 @@ typedef struct {
#define CHECK_WINDOW_CONFIGURATION(x) \
CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x)
-/* This macro rejects windows on the interior of the window tree as
- "dead", which is what we want; this is an argument-checking macro, and
- the user should never get access to interior windows.
-
- A window of any sort, leaf or interior, is dead if the buffer,
- vchild, and hchild members are all nil. */
-
-#define CHECK_LIVE_WINDOW(x) \
- CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), Qwindow_live_p, x)
-
#define CHECK_PROCESS(x) \
CHECK_TYPE (PROCESSP (x), Qprocessp, x)
@@ -1831,6 +1791,25 @@ typedef struct {
#define CHECK_NATNUM(x) \
CHECK_TYPE (NATNUMP (x), Qwholenump, x)
+#define CHECK_RANGED_INTEGER(x, lo, hi) \
+ do { \
+ CHECK_NUMBER (x); \
+ if (! ((lo) <= XINT (x) && XINT (x) <= (hi))) \
+ args_out_of_range_3 \
+ (x, \
+ make_number ((lo) < 0 && (lo) < MOST_NEGATIVE_FIXNUM \
+ ? MOST_NEGATIVE_FIXNUM \
+ : (lo)), \
+ make_number (min (hi, MOST_POSITIVE_FIXNUM))); \
+ } while (0)
+#define CHECK_TYPE_RANGED_INTEGER(type, x) \
+ do { \
+ if (TYPE_SIGNED (type)) \
+ CHECK_RANGED_INTEGER (x, TYPE_MINIMUM (type), TYPE_MAXIMUM (type)); \
+ else \
+ CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \
+ } while (0)
+
#define CHECK_MARKER(x) \
CHECK_TYPE (MARKERP (x), Qmarkerp, x)
@@ -1913,17 +1892,18 @@ typedef struct {
#ifdef _MSC_VER
#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
- static DECL_ALIGN (struct Lisp_Subr, sname) = \
- { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
+ static struct Lisp_Subr alignas (GCALIGNMENT) sname = \
+ { { (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) \
+ | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) }, \
{ (Lisp_Object (__cdecl *)(void))fnname }, \
minargs, maxargs, lname, intspec, 0}; \
Lisp_Object fnname
#else /* not _MSC_VER */
#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
- static DECL_ALIGN (struct Lisp_Subr, sname) = \
- { PVEC_SUBR, \
- { .a ## maxargs = fnname }, \
+ static struct Lisp_Subr alignas (GCALIGNMENT) sname = \
+ { { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \
+ { .a ## maxargs = fnname }, \
minargs, maxargs, lname, intspec, 0}; \
Lisp_Object fnname
#endif
@@ -1947,22 +1927,21 @@ typedef struct {
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
/* Non-zero if OBJ is a Lisp function. */
-#define FUNCTIONP(OBJ) \
- ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \
- || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \
- || COMPILEDP (OBJ) \
- || SUBRP (OBJ))
+#define FUNCTIONP(OBJ) functionp(OBJ)
/* defsubr (Sname);
is how we define the symbol for function `name' at start-up time. */
extern void defsubr (struct Lisp_Subr *);
-#define MANY -2
-#define UNEVALLED -1
+enum maxargs
+ {
+ MANY = -2,
+ UNEVALLED = -1
+ };
extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *);
extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object *);
-extern void defvar_bool (struct Lisp_Boolfwd *, const char *, int *);
+extern void defvar_bool (struct Lisp_Boolfwd *, const char *, bool *);
extern void defvar_int (struct Lisp_Intfwd *, const char *, EMACS_INT *);
extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
@@ -2015,7 +1994,25 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
static struct Lisp_Kboard_Objfwd ko_fwd; \
defvar_kboard (&ko_fwd, lname, offsetof (KBOARD, vname ## _)); \
} while (0)
-
+
+/* Save and restore the instruction and environment pointers,
+ without affecting the signal mask. */
+
+#ifdef HAVE__SETJMP
+typedef jmp_buf sys_jmp_buf;
+# define sys_setjmp(j) _setjmp (j)
+# define sys_longjmp(j, v) _longjmp (j, v)
+#elif defined HAVE_SIGSETJMP
+typedef sigjmp_buf sys_jmp_buf;
+# define sys_setjmp(j) sigsetjmp (j, 0)
+# define sys_longjmp(j, v) siglongjmp (j, v)
+#else
+/* A platform that uses neither _longjmp nor siglongjmp; assume
+ longjmp does not affect the sigmask. */
+typedef jmp_buf sys_jmp_buf;
+# define sys_setjmp(j) setjmp (j)
+# define sys_longjmp(j, v) longjmp (j, v)
+#endif
/* Structure for recording Lisp call stack for backtrace purposes. */
@@ -2044,16 +2041,31 @@ struct specbinding
{
Lisp_Object symbol, old_value;
specbinding_func func;
- Lisp_Object unused; /* Dividing by 16 is faster than by 12 */
+ Lisp_Object unused; /* Dividing by 16 is faster than by 12. */
};
extern struct specbinding *specpdl;
extern struct specbinding *specpdl_ptr;
-extern EMACS_INT specpdl_size;
+extern ptrdiff_t specpdl_size;
+
+#define SPECPDL_INDEX() (specpdl_ptr - specpdl)
+
+struct backtrace
+{
+ struct backtrace *next;
+ Lisp_Object function;
+ Lisp_Object *args; /* Points to vector of args. */
+ ptrdiff_t nargs; /* Length of vector. */
+ /* Nonzero means call value of debugger when done with this operation. */
+ unsigned int debug_on_exit : 1;
+};
-#define SPECPDL_INDEX() ((int) (specpdl_ptr - specpdl))
+extern struct backtrace *backtrace_list;
-/* Everything needed to describe an active condition case. */
+/* Everything needed to describe an active condition case.
+
+ Members are volatile if their values need to survive _longjmp when
+ a 'struct handler' is a local variable. */
struct handler
{
/* The handler clauses and variable from the condition-case form. */
@@ -2064,10 +2076,12 @@ struct handler
error: handle all conditions, and errors can run the debugger
or display a backtrace. */
Lisp_Object handler;
- Lisp_Object var;
+
+ Lisp_Object volatile var;
+
/* Fsignal stores here the condition-case clause that applies,
and Fcondition_case thus knows which clause to run. */
- Lisp_Object chosen_clause;
+ Lisp_Object volatile chosen_clause;
/* Used to effect the longjump out to the handler. */
struct catchtag *tag;
@@ -2093,19 +2107,21 @@ struct handler
of the catch form.
All the other members are concerned with restoring the interpreter
- state. */
+ state.
+ Members are volatile if their values need to survive _longjmp when
+ a 'struct catchtag' is a local variable. */
struct catchtag
{
Lisp_Object tag;
- Lisp_Object val;
- struct catchtag *next;
+ Lisp_Object volatile val;
+ struct catchtag *volatile next;
struct gcpro *gcpro;
- jmp_buf jmp;
+ sys_jmp_buf jmp;
struct backtrace *backlist;
struct handler *handlerlist;
- int lisp_eval_depth;
- int pdlcount;
+ EMACS_INT lisp_eval_depth;
+ ptrdiff_t volatile pdlcount;
int poll_suppress_count;
int interrupt_input_blocked;
struct byte_stack *byte_stack;
@@ -2133,22 +2149,16 @@ extern char *stack_bottom;
If quit-flag is set to `kill-emacs' the SIGINT handler has received
a request to exit Emacs when it is safe to do. */
-#ifdef SYNC_INPUT
extern void process_pending_signals (void);
-extern int pending_signals;
-#define ELSE_PENDING_SIGNALS \
- else if (pending_signals) \
- process_pending_signals ();
-#else /* not SYNC_INPUT */
-#define ELSE_PENDING_SIGNALS
-#endif /* not SYNC_INPUT */
+extern bool volatile pending_signals;
extern void process_quit_flag (void);
#define QUIT \
do { \
if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
process_quit_flag (); \
- ELSE_PENDING_SIGNALS \
+ else if (pending_signals) \
+ process_pending_signals (); \
} while (0)
@@ -2159,14 +2169,6 @@ extern void process_quit_flag (void);
extern Lisp_Object Vascii_downcase_table;
extern Lisp_Object Vascii_canon_table;
-/* Number of bytes of structure consed since last GC. */
-
-extern EMACS_INT consing_since_gc;
-
-extern EMACS_INT gc_relative_threshold;
-
-extern EMACS_INT memory_full_cons_threshold;
-
/* Structure for recording stack slots that need marking. */
/* This is a chain of structures, each of which points at a Lisp_Object
@@ -2213,7 +2215,7 @@ struct gcpro
#define GC_USE_GCPROS_CHECK_ZOMBIES 3
#ifndef GC_MARK_STACK
-#define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE
+#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
#endif
/* Whether we do the stack marking manually. */
@@ -2340,7 +2342,7 @@ extern int gcpro_level;
#define UNGCPRO \
((--gcpro_level != gcpro1.level) \
- ? (abort (), 0) \
+ ? (emacs_abort (), 0) \
: ((gcprolist = gcpro1.next), 0))
#endif /* DEBUG_GCPRO */
@@ -2373,6 +2375,231 @@ void staticpro (Lisp_Object *);
struct window;
struct frame;
+/* Simple access functions. */
+
+LISP_INLINE Lisp_Object *
+aref_addr (Lisp_Object array, ptrdiff_t idx)
+{
+ return & XVECTOR (array)->contents[idx];
+}
+
+LISP_INLINE void
+gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
+{
+ /* Like ASET, but also can be used in the garbage collector:
+ sweep_weak_table calls set_hash_key etc. while the table is marked. */
+ eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG));
+ XVECTOR (array)->contents[idx] = val;
+}
+
+/* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */
+
+LISP_INLINE void
+vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object *args, ptrdiff_t count)
+{
+ eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v));
+ memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args);
+}
+
+/* Functions to modify hash tables. */
+
+LISP_INLINE void
+set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value)
+{
+ h->key_and_value = key_and_value;
+}
+
+LISP_INLINE void
+set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+ gc_aset (h->key_and_value, 2 * idx, val);
+}
+
+LISP_INLINE void
+set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+ gc_aset (h->key_and_value, 2 * idx + 1, val);
+}
+
+LISP_INLINE void
+set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next)
+{
+ h->next = next;
+}
+
+LISP_INLINE void
+set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+ gc_aset (h->next, idx, val);
+}
+
+LISP_INLINE void
+set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash)
+{
+ h->hash = hash;
+}
+
+LISP_INLINE void
+set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+ gc_aset (h->hash, idx, val);
+}
+
+LISP_INLINE void
+set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index)
+{
+ h->index = index;
+}
+
+LISP_INLINE void
+set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+ gc_aset (h->index, idx, val);
+}
+
+/* Use these functions to set Lisp_Object
+ or pointer slots of struct Lisp_Symbol. */
+
+LISP_INLINE void
+set_symbol_name (Lisp_Object sym, Lisp_Object name)
+{
+ XSYMBOL (sym)->name = name;
+}
+
+LISP_INLINE void
+set_symbol_function (Lisp_Object sym, Lisp_Object function)
+{
+ XSYMBOL (sym)->function = function;
+}
+
+LISP_INLINE void
+set_symbol_plist (Lisp_Object sym, Lisp_Object plist)
+{
+ XSYMBOL (sym)->plist = plist;
+}
+
+LISP_INLINE void
+set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next)
+{
+ XSYMBOL (sym)->next = next;
+}
+
+/* Buffer-local (also frame-local) variable access functions. */
+
+LISP_INLINE int
+blv_found (struct Lisp_Buffer_Local_Value *blv)
+{
+ eassert (blv->found == !EQ (blv->defcell, blv->valcell));
+ return blv->found;
+}
+
+LISP_INLINE void
+set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found)
+{
+ eassert (found == !EQ (blv->defcell, blv->valcell));
+ blv->found = found;
+}
+
+LISP_INLINE Lisp_Object
+blv_value (struct Lisp_Buffer_Local_Value *blv)
+{
+ return XCDR (blv->valcell);
+}
+
+LISP_INLINE void
+set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ XSETCDR (blv->valcell, val);
+}
+
+LISP_INLINE void
+set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ blv->where = val;
+}
+
+LISP_INLINE void
+set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ blv->defcell = val;
+}
+
+LISP_INLINE void
+set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ blv->valcell = val;
+}
+
+/* Set overlay's property list. */
+
+LISP_INLINE void
+set_overlay_plist (Lisp_Object overlay, Lisp_Object plist)
+{
+ XOVERLAY (overlay)->plist = plist;
+}
+
+/* Get text properties of S. */
+
+LISP_INLINE INTERVAL
+string_intervals (Lisp_Object s)
+{
+ return XSTRING (s)->intervals;
+}
+
+/* Set text properties of S to I. */
+
+LISP_INLINE void
+set_string_intervals (Lisp_Object s, INTERVAL i)
+{
+ XSTRING (s)->intervals = i;
+}
+
+/* Set a Lisp slot in TABLE to VAL. Most code should use this instead
+ of setting slots directly. */
+
+LISP_INLINE void
+set_char_table_ascii (Lisp_Object table, Lisp_Object val)
+{
+ XCHAR_TABLE (table)->ascii = val;
+}
+LISP_INLINE void
+set_char_table_defalt (Lisp_Object table, Lisp_Object val)
+{
+ XCHAR_TABLE (table)->defalt = val;
+}
+LISP_INLINE void
+set_char_table_parent (Lisp_Object table, Lisp_Object val)
+{
+ XCHAR_TABLE (table)->parent = val;
+}
+LISP_INLINE void
+set_char_table_purpose (Lisp_Object table, Lisp_Object val)
+{
+ XCHAR_TABLE (table)->purpose = val;
+}
+
+/* Set different slots in (sub)character tables. */
+
+LISP_INLINE void
+set_char_table_extras (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
+{
+ eassert (0 <= idx && idx < CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (table)));
+ XCHAR_TABLE (table)->extras[idx] = val;
+}
+
+LISP_INLINE void
+set_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
+{
+ eassert (0 <= idx && idx < (1 << CHARTAB_SIZE_BITS_0));
+ XCHAR_TABLE (table)->contents[idx] = val;
+}
+
+LISP_INLINE void
+set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
+{
+ XSUB_CHAR_TABLE (table)->contents[idx] = val;
+}
+
/* Defined in data.c. */
extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
@@ -2380,7 +2607,7 @@ extern Lisp_Object Qerror, Qquit, Qargs_out_of_range;
extern Lisp_Object Qvoid_variable, Qvoid_function;
extern Lisp_Object Qinvalid_read_syntax;
extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
-extern Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
+extern Lisp_Object Quser_error, Qend_of_file, Qarith_error, Qmark_inactive;
extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
extern Lisp_Object Qtext_read_only;
extern Lisp_Object Qinteractive_form;
@@ -2394,66 +2621,20 @@ extern Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
extern Lisp_Object Qcdr;
-extern Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
-extern Lisp_Object Qoverflow_error, Qunderflow_error;
+extern Lisp_Object Qrange_error, Qoverflow_error;
extern Lisp_Object Qfloatp;
extern Lisp_Object Qnumberp, Qnumber_or_marker_p;
-extern Lisp_Object Qinteger;
+extern Lisp_Object Qbuffer, Qinteger, Qsymbol;
extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
-EXFUN (Finteractive_form, 1);
-EXFUN (Fbyteorder, 0);
-
-/* Defined in frame.c */
-extern Lisp_Object Qframep;
-
-/* Defined in data.c */
-EXFUN (Fcar, 1);
-EXFUN (Fcar_safe, 1);
-EXFUN (Fcdr, 1);
-EXFUN (Fcdr_safe, 1);
-EXFUN (Fsetcar, 2);
-EXFUN (Fsetcdr, 2);
-EXFUN (Fboundp, 1);
-EXFUN (Ffboundp, 1);
-EXFUN (Fsymbol_function, 1);
-EXFUN (Fsymbol_name, 1);
+EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST;
+
+/* Defined in data.c. */
extern Lisp_Object indirect_function (Lisp_Object);
-EXFUN (Findirect_function, 2);
-EXFUN (Ffset, 2);
-EXFUN (Fsymbol_value, 1);
extern Lisp_Object find_symbol_value (Lisp_Object);
-EXFUN (Fset, 2);
-EXFUN (Fdefault_value, 1);
-EXFUN (Fset_default, 2);
-EXFUN (Fdefault_boundp, 1);
-EXFUN (Fmake_local_variable, 1);
-EXFUN (Flocal_variable_p, 2);
-
-EXFUN (Faref, 2);
-EXFUN (Faset, 3);
-
-EXFUN (Fstring_to_number, 2);
-EXFUN (Fnumber_to_string, 1);
-EXFUN (Fgtr, 2);
-EXFUN (Flss, 2);
-EXFUN (Fgeq, 2);
-EXFUN (Fleq, 2);
-EXFUN (Fzerop, 1);
-EXFUN (Fplus, MANY);
-EXFUN (Fminus, MANY);
-EXFUN (Ftimes, MANY);
-EXFUN (Fquo, MANY);
-EXFUN (Frem, 2);
-EXFUN (Fmax, MANY);
-EXFUN (Fmin, MANY);
-
-EXFUN (Fadd1, 1);
-EXFUN (Fsub1, 1);
-EXFUN (Fmake_variable_buffer_local, 1);
/* Convert the integer I to an Emacs representation, either the integer
itself, or a cons of two or three integers, or if all else fails a float.
@@ -2484,154 +2665,89 @@ extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t);
extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t);
extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
-extern void args_out_of_range (Lisp_Object, Lisp_Object) NO_RETURN;
-extern void args_out_of_range_3 (Lisp_Object, Lisp_Object,
- Lisp_Object) NO_RETURN;
-extern Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object) NO_RETURN;
+extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object);
+extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object,
+ Lisp_Object);
+extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
-extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, int);
+extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool);
extern void syms_of_data (void);
-extern void init_data (void);
extern void swap_in_global_binding (struct Lisp_Symbol *);
/* Defined in cmds.c */
-EXFUN (Fend_of_line, 1);
-EXFUN (Fforward_char, 1);
-EXFUN (Fforward_line, 1);
extern void syms_of_cmds (void);
extern void keys_of_cmds (void);
-/* Defined in coding.c */
+/* Defined in coding.c. */
extern Lisp_Object Qcharset;
-EXFUN (Fcoding_system_p, 1);
-EXFUN (Fcoding_system_base, 1);
-EXFUN (Fcoding_system_eol_type, 1);
-EXFUN (Fcheck_coding_system, 1);
-EXFUN (Fread_coding_system, 2);
-EXFUN (Fread_non_nil_coding_system, 1);
-EXFUN (Ffind_operation_coding_system, MANY);
-EXFUN (Fdecode_coding_string, 4);
-extern Lisp_Object detect_coding_system (const unsigned char *, EMACS_INT,
- EMACS_INT, int, int, Lisp_Object);
+extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t,
+ ptrdiff_t, bool, bool, Lisp_Object);
extern void init_coding (void);
extern void init_coding_once (void);
extern void syms_of_coding (void);
-/* Defined in character.c */
-EXFUN (Fchar_width, 1);
-EXFUN (Fstring, MANY);
-extern EMACS_INT chars_in_text (const unsigned char *, EMACS_INT);
-extern EMACS_INT multibyte_chars_in_text (const unsigned char *, EMACS_INT);
-extern int multibyte_char_to_unibyte (int);
-extern int multibyte_char_to_unibyte_safe (int);
-extern void init_character_once (void);
+/* Defined in character.c. */
+EXFUN (Fmax_char, 0) ATTRIBUTE_CONST;
+extern ptrdiff_t chars_in_text (const unsigned char *, ptrdiff_t);
+extern ptrdiff_t multibyte_chars_in_text (const unsigned char *, ptrdiff_t);
+extern int multibyte_char_to_unibyte (int) ATTRIBUTE_CONST;
+extern int multibyte_char_to_unibyte_safe (int) ATTRIBUTE_CONST;
extern void syms_of_character (void);
-/* Defined in charset.c */
+/* Defined in charset.c. */
extern void init_charset (void);
extern void init_charset_once (void);
extern void syms_of_charset (void);
/* Structure forward declarations. */
struct charset;
-/* Defined in composite.c */
+/* Defined in composite.c. */
extern void syms_of_composite (void);
-/* Defined in syntax.c */
-EXFUN (Fforward_word, 1);
-EXFUN (Fskip_chars_forward, 2);
-EXFUN (Fskip_chars_backward, 2);
+/* Defined in syntax.c. */
extern void init_syntax_once (void);
extern void syms_of_syntax (void);
-/* Defined in fns.c */
+/* Defined in fns.c. */
extern Lisp_Object QCrehash_size, QCrehash_threshold;
enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
-extern EMACS_INT next_almost_prime (EMACS_INT);
-extern Lisp_Object larger_vector (Lisp_Object, EMACS_INT, Lisp_Object);
+EXFUN (Fidentity, 1) ATTRIBUTE_CONST;
+extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
+extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
extern void sweep_weak_hash_tables (void);
extern Lisp_Object Qcursor_in_echo_area;
extern Lisp_Object Qstring_lessp;
-extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq, Qeql;
+extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq;
EMACS_UINT hash_string (char const *, ptrdiff_t);
EMACS_UINT sxhash (Lisp_Object, int);
-Lisp_Object make_hash_table (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object);
+Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object);
ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
EMACS_UINT);
-void init_weak_hash_tables (void);
-extern void init_fns (void);
-EXFUN (Fmake_hash_table, MANY);
-EXFUN (Fgethash, 3);
-EXFUN (Fputhash, 3);
-EXFUN (Fremhash, 2);
-
-EXFUN (Fidentity, 1);
-EXFUN (Flength, 1);
-EXFUN (Fappend, MANY);
-EXFUN (Fconcat, MANY);
-EXFUN (Fvconcat, MANY);
-EXFUN (Fcopy_sequence, 1);
-EXFUN (Fstring_make_multibyte, 1);
-EXFUN (Fstring_make_unibyte, 1);
-EXFUN (Fstring_as_multibyte, 1);
-EXFUN (Fstring_as_unibyte, 1);
-EXFUN (Fstring_to_multibyte, 1);
-EXFUN (Fsubstring, 3);
-extern Lisp_Object substring_both (Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT);
-EXFUN (Fnth, 2);
-EXFUN (Fnthcdr, 2);
-EXFUN (Fmemq, 2);
-EXFUN (Fassq, 2);
-EXFUN (Fassoc, 2);
-EXFUN (Felt, 2);
-EXFUN (Fmember, 2);
-EXFUN (Frassq, 2);
-EXFUN (Fdelq, 2);
-EXFUN (Fdelete, 2);
-EXFUN (Fsort, 2);
-EXFUN (Freverse, 1);
-EXFUN (Fnreverse, 1);
-EXFUN (Fget, 2);
-EXFUN (Fput, 3);
-EXFUN (Fequal, 2);
-EXFUN (Fnconc, MANY);
-EXFUN (Fmapcar, 2);
-EXFUN (Fmapconcat, 3);
+extern struct hash_table_test hashtest_eql, hashtest_equal;
+
+extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t);
extern Lisp_Object do_yes_or_no_p (Lisp_Object);
-EXFUN (Fprovide, 2);
extern Lisp_Object concat2 (Lisp_Object, Lisp_Object);
extern Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object);
extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object);
extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object);
extern void clear_string_char_byte_cache (void);
-extern EMACS_INT string_char_to_byte (Lisp_Object, EMACS_INT);
-extern EMACS_INT string_byte_to_char (Lisp_Object, EMACS_INT);
+extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t);
+extern ptrdiff_t string_byte_to_char (Lisp_Object, ptrdiff_t);
extern Lisp_Object string_to_multibyte (Lisp_Object);
extern Lisp_Object string_make_unibyte (Lisp_Object);
-EXFUN (Fcopy_alist, 1);
-EXFUN (Fplist_get, 2);
-EXFUN (Fplist_put, 3);
-EXFUN (Fplist_member, 2);
-EXFUN (Frassoc, 2);
-EXFUN (Fstring_equal, 2);
-EXFUN (Fcompare_strings, 7);
-EXFUN (Fstring_lessp, 2);
extern void syms_of_fns (void);
-/* Defined in floatfns.c */
+/* Defined in floatfns.c. */
extern double extract_float (Lisp_Object);
-EXFUN (Ffloat, 1);
-EXFUN (Ftruncate, 2);
-extern void init_floatfns (void);
extern void syms_of_floatfns (void);
extern Lisp_Object fmod_float (Lisp_Object x, Lisp_Object y);
-/* Defined in fringe.c */
+/* Defined in fringe.c. */
extern void syms_of_fringe (void);
extern void init_fringe (void);
#ifdef HAVE_WINDOW_SYSTEM
@@ -2639,71 +2755,71 @@ extern void mark_fringe_data (void);
extern void init_fringe_once (void);
#endif /* HAVE_WINDOW_SYSTEM */
-/* Defined in image.c */
+/* Defined in image.c. */
extern Lisp_Object QCascent, QCmargin, QCrelief;
extern Lisp_Object QCconversion;
extern int x_bitmap_mask (struct frame *, ptrdiff_t);
+extern void reset_image_types (void);
extern void syms_of_image (void);
-extern void init_image (void);
-/* Defined in insdel.c */
+/* Defined in insdel.c. */
extern Lisp_Object Qinhibit_modification_hooks;
-extern void move_gap (EMACS_INT);
-extern void move_gap_both (EMACS_INT, EMACS_INT);
-extern void buffer_overflow (void) NO_RETURN;
-extern void make_gap (EMACS_INT);
-extern EMACS_INT copy_text (const unsigned char *, unsigned char *,
- EMACS_INT, int, int);
+extern void move_gap (ptrdiff_t);
+extern void move_gap_both (ptrdiff_t, ptrdiff_t);
+extern _Noreturn void buffer_overflow (void);
+extern void make_gap (ptrdiff_t);
+extern ptrdiff_t copy_text (const unsigned char *, unsigned char *,
+ ptrdiff_t, bool, bool);
extern int count_combining_before (const unsigned char *,
- EMACS_INT, EMACS_INT, EMACS_INT);
+ ptrdiff_t, ptrdiff_t, ptrdiff_t);
extern int count_combining_after (const unsigned char *,
- EMACS_INT, EMACS_INT, EMACS_INT);
-extern void insert (const char *, EMACS_INT);
-extern void insert_and_inherit (const char *, EMACS_INT);
-extern void insert_1 (const char *, EMACS_INT, int, int, int);
-extern void insert_1_both (const char *, EMACS_INT, EMACS_INT,
- int, int, int);
-extern void insert_from_gap (EMACS_INT, EMACS_INT);
-extern void insert_from_string (Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, int);
-extern void insert_from_buffer (struct buffer *, EMACS_INT, EMACS_INT, int);
+ ptrdiff_t, ptrdiff_t, ptrdiff_t);
+extern void insert (const char *, ptrdiff_t);
+extern void insert_and_inherit (const char *, ptrdiff_t);
+extern void insert_1 (const char *, ptrdiff_t, bool, bool, bool);
+extern void insert_1_both (const char *, ptrdiff_t, ptrdiff_t,
+ bool, bool, bool);
+extern void insert_from_gap (ptrdiff_t, ptrdiff_t);
+extern void insert_from_string (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, bool);
+extern void insert_from_buffer (struct buffer *, ptrdiff_t, ptrdiff_t, bool);
extern void insert_char (int);
extern void insert_string (const char *);
-extern void insert_before_markers (const char *, EMACS_INT);
-extern void insert_before_markers_and_inherit (const char *, EMACS_INT);
-extern void insert_from_string_before_markers (Lisp_Object, EMACS_INT,
- EMACS_INT, EMACS_INT,
- EMACS_INT, int);
-extern void del_range (EMACS_INT, EMACS_INT);
-extern Lisp_Object del_range_1 (EMACS_INT, EMACS_INT, int, int);
-extern void del_range_byte (EMACS_INT, EMACS_INT, int);
-extern void del_range_both (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT, int);
-extern Lisp_Object del_range_2 (EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, int);
-extern void modify_region (struct buffer *, EMACS_INT, EMACS_INT, int);
-extern void prepare_to_modify_buffer (EMACS_INT, EMACS_INT, EMACS_INT *);
-extern void signal_after_change (EMACS_INT, EMACS_INT, EMACS_INT);
-extern void adjust_after_insert (EMACS_INT, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT);
-extern void adjust_markers_for_delete (EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT);
-extern void replace_range (EMACS_INT, EMACS_INT, Lisp_Object, int, int, int);
-extern void replace_range_2 (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT,
- const char *, EMACS_INT, EMACS_INT, int);
+extern void insert_before_markers (const char *, ptrdiff_t);
+extern void insert_before_markers_and_inherit (const char *, ptrdiff_t);
+extern void insert_from_string_before_markers (Lisp_Object, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, bool);
+extern void del_range (ptrdiff_t, ptrdiff_t);
+extern Lisp_Object del_range_1 (ptrdiff_t, ptrdiff_t, bool, bool);
+extern void del_range_byte (ptrdiff_t, ptrdiff_t, bool);
+extern void del_range_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool);
+extern Lisp_Object del_range_2 (ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, bool);
+extern void modify_region (struct buffer *, ptrdiff_t, ptrdiff_t, bool);
+extern void prepare_to_modify_buffer (ptrdiff_t, ptrdiff_t, ptrdiff_t *);
+extern void signal_after_change (ptrdiff_t, ptrdiff_t, ptrdiff_t);
+extern void adjust_after_insert (ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t);
+extern void adjust_markers_for_delete (ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t);
+extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool, bool);
+extern void replace_range_2 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ const char *, ptrdiff_t, ptrdiff_t, bool);
extern void syms_of_insdel (void);
-/* Defined in dispnew.c */
+/* Defined in dispnew.c. */
+#if (defined PROFILING \
+ && (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__))
+_Noreturn void __executable_start (void);
+#endif
extern Lisp_Object selected_frame;
extern Lisp_Object Vwindow_system;
-EXFUN (Fding, 1);
-EXFUN (Fredraw_frame, 1);
-EXFUN (Fsleep_for, 2);
-EXFUN (Fredisplay, 1);
-extern Lisp_Object sit_for (Lisp_Object, int, int);
+extern Lisp_Object sit_for (Lisp_Object, bool, int);
extern void init_display (void);
extern void syms_of_display (void);
-/* Defined in xdisp.c */
+/* Defined in xdisp.c. */
extern Lisp_Object Qinhibit_point_motion_hooks;
extern Lisp_Object Qinhibit_redisplay, Qdisplay;
extern Lisp_Object Qmenu_bar_update_hook;
@@ -2718,14 +2834,14 @@ extern Lisp_Object QCdata, QCfile;
extern Lisp_Object QCmap;
extern Lisp_Object Qrisky_local_variable;
extern struct frame *last_glyphless_glyph_frame;
-extern unsigned last_glyphless_glyph_face_id;
+extern int last_glyphless_glyph_face_id;
extern int last_glyphless_glyph_merged_face_id;
extern int noninteractive_need_newline;
extern Lisp_Object echo_area_buffer[2];
extern void add_to_log (const char *, Lisp_Object, Lisp_Object);
extern void check_message_stack (void);
extern void setup_echo_area_for_printing (int);
-extern int push_message (void);
+extern bool push_message (void);
extern Lisp_Object pop_message_unwind (Lisp_Object);
extern Lisp_Object restore_message_unwind (Lisp_Object);
extern void restore_message (void);
@@ -2734,15 +2850,15 @@ extern void clear_message (int, int);
extern void message (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
extern void message1 (const char *);
extern void message1_nolog (const char *);
-extern void message2 (const char *, EMACS_INT, int);
-extern void message2_nolog (const char *, EMACS_INT, int);
-extern void message3 (Lisp_Object, EMACS_INT, int);
-extern void message3_nolog (Lisp_Object, EMACS_INT, int);
-extern void message_dolog (const char *, EMACS_INT, int, int);
+extern void message2 (const char *, ptrdiff_t, int);
+extern void message2_nolog (const char *, ptrdiff_t, int);
+extern void message3 (Lisp_Object, ptrdiff_t, int);
+extern void message3_nolog (Lisp_Object, ptrdiff_t, int);
+extern void message_dolog (const char *, ptrdiff_t, int, int);
extern void message_with_string (const char *, Lisp_Object, int);
extern void message_log_maybe_newline (void);
extern void update_echo_area (void);
-extern void truncate_echo_area (EMACS_INT);
+extern void truncate_echo_area (ptrdiff_t);
extern void redisplay (void);
extern void redisplay_preserve_echo_area (int);
extern void prepare_menu_bars (void);
@@ -2751,67 +2867,87 @@ void set_frame_cursor_types (struct frame *, Lisp_Object);
extern void syms_of_xdisp (void);
extern void init_xdisp (void);
extern Lisp_Object safe_eval (Lisp_Object);
-extern int pos_visible_p (struct window *, EMACS_INT, int *,
+extern int pos_visible_p (struct window *, ptrdiff_t, int *,
int *, int *, int *, int *, int *);
-/* Defined in xsettings.c */
+/* Defined in xsettings.c. */
extern void syms_of_xsettings (void);
/* Defined in vm-limit.c. */
-extern void memory_warnings (POINTER_TYPE *, void (*warnfun) (const char *));
+extern void memory_warnings (void *, void (*warnfun) (const char *));
-/* Defined in alloc.c */
+/* Defined in alloc.c. */
extern void check_pure_size (void);
extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT);
-extern void reset_malloc_hooks (void);
-extern void uninterrupt_malloc (void);
extern void malloc_warning (const char *);
-extern void memory_full (size_t) NO_RETURN;
-extern void buffer_memory_full (EMACS_INT) NO_RETURN;
-extern int survives_gc_p (Lisp_Object);
+extern _Noreturn void memory_full (size_t);
+extern _Noreturn void buffer_memory_full (ptrdiff_t);
+extern bool survives_gc_p (Lisp_Object);
extern void mark_object (Lisp_Object);
#if defined REL_ALLOC && !defined SYSTEM_MALLOC
extern void refill_memory_reserve (void);
#endif
extern const char *pending_malloc_warning;
+extern Lisp_Object zero_vector;
extern Lisp_Object *stack_base;
-EXFUN (Fcons, 2);
+extern EMACS_INT consing_since_gc;
+extern EMACS_INT gc_relative_threshold;
+extern EMACS_INT memory_full_cons_threshold;
extern Lisp_Object list1 (Lisp_Object);
extern Lisp_Object list2 (Lisp_Object, Lisp_Object);
extern Lisp_Object list3 (Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object list4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object);
-EXFUN (Flist, MANY);
-EXFUN (Fmake_list, 2);
-extern Lisp_Object allocate_misc (void);
-EXFUN (Fmake_vector, 2);
-EXFUN (Fvector, MANY);
-EXFUN (Fmake_symbol, 1);
-EXFUN (Fmake_marker, 0);
-extern void string_overflow (void) NO_RETURN;
-EXFUN (Fmake_string, 2);
-extern Lisp_Object build_string (const char *);
-extern Lisp_Object make_string (const char *, EMACS_INT);
-extern Lisp_Object make_unibyte_string (const char *, EMACS_INT);
-extern Lisp_Object make_multibyte_string (const char *, EMACS_INT, EMACS_INT);
+enum constype {CONSTYPE_HEAP, CONSTYPE_PURE};
+extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...);
+extern _Noreturn void string_overflow (void);
+extern Lisp_Object make_string (const char *, ptrdiff_t);
+extern Lisp_Object make_formatted_string (char *, const char *, ...)
+ ATTRIBUTE_FORMAT_PRINTF (2, 3);
+extern Lisp_Object make_unibyte_string (const char *, ptrdiff_t);
+
+/* Make unibyte string from C string when the length isn't known. */
+
+LISP_INLINE Lisp_Object
+build_unibyte_string (const char *str)
+{
+ return make_unibyte_string (str, strlen (str));
+}
+
+extern Lisp_Object make_multibyte_string (const char *, ptrdiff_t, ptrdiff_t);
extern Lisp_Object make_event_array (int, Lisp_Object *);
extern Lisp_Object make_uninit_string (EMACS_INT);
extern Lisp_Object make_uninit_multibyte_string (EMACS_INT, EMACS_INT);
-extern Lisp_Object make_string_from_bytes (const char *, EMACS_INT, EMACS_INT);
+extern Lisp_Object make_string_from_bytes (const char *, ptrdiff_t, ptrdiff_t);
extern Lisp_Object make_specified_string (const char *,
- EMACS_INT, EMACS_INT, int);
-EXFUN (Fpurecopy, 1);
-extern Lisp_Object make_pure_string (const char *, EMACS_INT, EMACS_INT, int);
-extern Lisp_Object make_pure_c_string (const char *data);
+ ptrdiff_t, ptrdiff_t, bool);
+extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool);
+extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t);
+
+/* Make a string allocated in pure space, use STR as string data. */
+
+LISP_INLINE Lisp_Object
+build_pure_c_string (const char *str)
+{
+ return make_pure_c_string (str, strlen (str));
+}
+
+/* Make a string from the data at STR, treating it as multibyte if the
+ data warrants. */
+
+LISP_INLINE Lisp_Object
+build_string (const char *str)
+{
+ return make_string (str, strlen (str));
+}
+
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
-extern Lisp_Object make_pure_vector (EMACS_INT);
-EXFUN (Fgarbage_collect, 0);
-EXFUN (Fmake_byte_code, MANY);
-EXFUN (Fmake_bool_vector, 2);
+extern void make_byte_code (struct Lisp_Vector *);
+extern Lisp_Object Qautomatic_gc;
extern Lisp_Object Qchar_table_extra_slots;
extern struct Lisp_Vector *allocate_vector (EMACS_INT);
-extern struct Lisp_Vector *allocate_pseudovector (int memlen, int lisplen, EMACS_INT tag);
+extern struct Lisp_Vector *allocate_pseudovector (int, int, enum pvec_type);
#define ALLOCATE_PSEUDOVECTOR(typ,field,tag) \
((typ*) \
allocate_pseudovector \
@@ -2821,12 +2957,13 @@ extern struct window *allocate_window (void);
extern struct frame *allocate_frame (void);
extern struct Lisp_Process *allocate_process (void);
extern struct terminal *allocate_terminal (void);
-extern int gc_in_progress;
-extern int abort_on_gc;
+extern bool gc_in_progress;
+extern bool abort_on_gc;
extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
-extern int inhibit_garbage_collection (void);
+extern ptrdiff_t inhibit_garbage_collection (void);
extern Lisp_Object make_save_value (void *, ptrdiff_t);
+extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
extern void free_marker (Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
extern void init_alloc_once (void);
@@ -2834,21 +2971,28 @@ extern void init_alloc (void);
extern void syms_of_alloc (void);
extern struct buffer * allocate_buffer (void);
extern int valid_lisp_object_p (Lisp_Object);
+#ifdef GC_CHECK_CONS_LIST
+extern void check_cons_list (void);
+#else
+#define check_cons_list() ((void) 0)
+#endif
-/* Defined in chartab.c */
-EXFUN (Fmake_char_table, 2);
-EXFUN (Fset_char_table_parent, 2);
-EXFUN (Fchar_table_extra_slot, 2);
-EXFUN (Fset_char_table_extra_slot, 3);
-EXFUN (Fset_char_table_range, 3);
-EXFUN (Foptimize_char_table, 2);
+#ifdef REL_ALLOC
+/* Defined in ralloc.c. */
+extern void *r_alloc (void **, size_t);
+extern void r_alloc_free (void **);
+extern void *r_re_alloc (void **, size_t);
+extern void r_alloc_reset_variable (void **, void **);
+extern void r_alloc_inhibit_buffer_relocation (int);
+#endif
+
+/* Defined in chartab.c. */
extern Lisp_Object copy_char_table (Lisp_Object);
extern Lisp_Object char_table_ref (Lisp_Object, int);
extern Lisp_Object char_table_ref_and_range (Lisp_Object, int,
int *, int *);
-extern Lisp_Object char_table_set (Lisp_Object, int, Lisp_Object);
-extern Lisp_Object char_table_set_range (Lisp_Object, int, int,
- Lisp_Object);
+extern void char_table_set (Lisp_Object, int, Lisp_Object);
+extern void char_table_set_range (Lisp_Object, int, int, Lisp_Object);
extern int char_table_translate (Lisp_Object, int);
extern void map_char_table (void (*) (Lisp_Object, Lisp_Object,
Lisp_Object),
@@ -2860,14 +3004,9 @@ extern void map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Ob
extern Lisp_Object uniprop_table (Lisp_Object);
extern void syms_of_chartab (void);
-/* Defined in print.c */
+/* Defined in print.c. */
extern Lisp_Object Vprin1_to_string_buffer;
extern void debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
-EXFUN (Fprin1, 2);
-EXFUN (Fprin1_to_string, 2);
-EXFUN (Fterpri, 1);
-EXFUN (Fprint, 2);
-EXFUN (Ferror_message_string, 1);
extern Lisp_Object Qstandard_output;
extern Lisp_Object Qexternal_debugging_output;
extern void temp_output_buffer_setup (const char *);
@@ -2878,11 +3017,11 @@ extern void print_error_message (Lisp_Object, Lisp_Object, const char *,
Lisp_Object);
extern Lisp_Object internal_with_output_to_temp_buffer
(const char *, Lisp_Object (*) (Lisp_Object), Lisp_Object);
-#define FLOAT_TO_STRING_BUFSIZE 350
-extern void float_to_string (char *, double);
+enum FLOAT_TO_STRING_BUFSIZE { FLOAT_TO_STRING_BUFSIZE = 350 };
+extern int float_to_string (char *, double);
extern void syms_of_print (void);
-/* Defined in doprnt.c */
+/* Defined in doprnt.c. */
extern ptrdiff_t doprnt (char *, ptrdiff_t, const char *, const char *,
va_list);
extern ptrdiff_t esprintf (char *, char const *, ...)
@@ -2897,26 +3036,18 @@ extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char const *, ptrdiff_t,
/* Defined in lread.c. */
extern Lisp_Object Qvariable_documentation, Qstandard_input;
extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
-EXFUN (Fread, 1);
-EXFUN (Fread_from_string, 3);
-EXFUN (Fintern, 2);
-EXFUN (Fintern_soft, 2);
-EXFUN (Funintern, 2);
-EXFUN (Fload, 5);
-EXFUN (Fget_load_suffixes, 0);
-EXFUN (Fread_char, 3);
-EXFUN (Fread_event, 3);
+extern Lisp_Object Qlexical_binding;
extern Lisp_Object check_obarray (Lisp_Object);
-extern Lisp_Object intern (const char *);
-extern Lisp_Object intern_c_string (const char *);
-extern Lisp_Object oblookup (Lisp_Object, const char *, EMACS_INT, EMACS_INT);
+extern Lisp_Object intern_1 (const char *, ptrdiff_t);
+extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
+extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
#define LOADHIST_ATTACH(x) \
do { \
if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); \
} while (0)
extern int openp (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object *, Lisp_Object);
-Lisp_Object string_to_number (char const *, int, int);
+extern Lisp_Object string_to_number (char const *, int, bool);
extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object),
Lisp_Object);
extern void dir_warning (const char *, Lisp_Object);
@@ -2925,13 +3056,25 @@ extern void init_obarray (void);
extern void init_lread (void);
extern void syms_of_lread (void);
+LISP_INLINE Lisp_Object
+intern (const char *str)
+{
+ return intern_1 (str, strlen (str));
+}
+
+LISP_INLINE Lisp_Object
+intern_c_string (const char *str)
+{
+ return intern_c_string_1 (str, strlen (str));
+}
+
/* Defined in eval.c. */
-extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro;
-extern Lisp_Object Qinhibit_quit, Qclosure;
+extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qmacro;
+extern Lisp_Object Qinhibit_quit, Qinternal_interpreter_environment, Qclosure;
extern Lisp_Object Qand_rest;
extern Lisp_Object Vautoload_queue;
extern Lisp_Object Vsignaling_function;
-extern int handling_signal;
+extern Lisp_Object inhibit_lisp_code;
#if BYTE_MARK_STACK
extern struct catchtag *catchlist;
extern struct handler *handlerlist;
@@ -2944,29 +3087,18 @@ extern struct handler *handlerlist;
should no longer be used. */
extern Lisp_Object Vrun_hooks;
-EXFUN (Frun_hooks, MANY);
-EXFUN (Frun_hook_with_args, MANY);
-EXFUN (Frun_hook_with_args_until_failure, MANY);
extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
Lisp_Object (*funcall)
(ptrdiff_t nargs, Lisp_Object *args));
-EXFUN (Fprogn, UNEVALLED);
-EXFUN (Finteractive_p, 0);
-EXFUN (Fthrow, 2) NO_RETURN;
-EXFUN (Fsignal, 2);
-extern void xsignal (Lisp_Object, Lisp_Object) NO_RETURN;
-extern void xsignal0 (Lisp_Object) NO_RETURN;
-extern void xsignal1 (Lisp_Object, Lisp_Object) NO_RETURN;
-extern void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN;
-extern void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN;
-extern void signal_error (const char *, Lisp_Object) NO_RETURN;
-EXFUN (Fcommandp, 2);
-EXFUN (Ffunctionp, 1);
-EXFUN (Feval, 2);
+extern _Noreturn void xsignal (Lisp_Object, Lisp_Object);
+extern _Noreturn void xsignal0 (Lisp_Object);
+extern _Noreturn void xsignal1 (Lisp_Object, Lisp_Object);
+extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object);
+extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object);
+extern _Noreturn void signal_error (const char *, Lisp_Object);
extern Lisp_Object eval_sub (Lisp_Object form);
-EXFUN (Fapply, MANY);
-EXFUN (Ffuncall, MANY);
extern Lisp_Object apply1 (Lisp_Object, Lisp_Object);
extern Lisp_Object call0 (Lisp_Object);
extern Lisp_Object call1 (Lisp_Object, Lisp_Object);
@@ -2976,23 +3108,24 @@ extern Lisp_Object call4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Li
extern Lisp_Object call5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object call6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object call7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-EXFUN (Fdo_auto_save, 2);
extern Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object);
extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object));
extern Lisp_Object internal_condition_case_1 (Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
-extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object));
+extern Lisp_Object internal_condition_case_n
+ (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
+ Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
extern void specbind (Lisp_Object, Lisp_Object);
extern void record_unwind_protect (Lisp_Object (*) (Lisp_Object), Lisp_Object);
-extern Lisp_Object unbind_to (int, Lisp_Object);
-extern void error (const char *, ...) NO_RETURN ATTRIBUTE_FORMAT_PRINTF (1, 2);
-extern void verror (const char *, va_list)
- NO_RETURN ATTRIBUTE_FORMAT_PRINTF (1, 0);
-extern void do_autoload (Lisp_Object, Lisp_Object);
+extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
+extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
+extern _Noreturn void verror (const char *, va_list)
+ ATTRIBUTE_FORMAT_PRINTF (1, 0);
extern Lisp_Object un_autoload (Lisp_Object);
+extern Lisp_Object call_debugger (Lisp_Object arg);
extern void init_eval_once (void);
-extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object *);
+extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
extern void init_eval (void);
@@ -3001,216 +3134,129 @@ extern void mark_backtrace (void);
#endif
extern void syms_of_eval (void);
-/* Defined in editfns.c */
+/* Defined in editfns.c. */
extern Lisp_Object Qfield;
-EXFUN (Fcurrent_message, 0);
-EXFUN (Fgoto_char, 1);
-EXFUN (Fpoint_max_marker, 0);
-EXFUN (Fpoint, 0);
-EXFUN (Fpoint_marker, 0);
-EXFUN (Fline_beginning_position, 1);
-EXFUN (Fline_end_position, 1);
-EXFUN (Ffollowing_char, 0);
-EXFUN (Fprevious_char, 0);
-EXFUN (Fchar_after, 1);
-EXFUN (Finsert, MANY);
-EXFUN (Finsert_char, 3);
extern void insert1 (Lisp_Object);
-EXFUN (Feolp, 0);
-EXFUN (Feobp, 0);
-EXFUN (Fbolp, 0);
-EXFUN (Fbobp, 0);
-EXFUN (Fformat, MANY);
-EXFUN (Fmessage, MANY);
extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object);
-EXFUN (Fbuffer_substring, 2);
-EXFUN (Fbuffer_string, 0);
extern Lisp_Object save_excursion_save (void);
extern Lisp_Object save_restriction_save (void);
extern Lisp_Object save_excursion_restore (Lisp_Object);
extern Lisp_Object save_restriction_restore (Lisp_Object);
-EXFUN (Fchar_to_string, 1);
-EXFUN (Fdelete_region, 2);
-EXFUN (Fnarrow_to_region, 2);
-EXFUN (Fwiden, 0);
-EXFUN (Fuser_login_name, 1);
-EXFUN (Fsystem_name, 0);
-EXFUN (Fcurrent_time, 0);
-EXFUN (Fget_internal_run_time, 0);
-extern EMACS_INT clip_to_bounds (EMACS_INT, EMACS_INT, EMACS_INT);
-extern Lisp_Object make_buffer_string (EMACS_INT, EMACS_INT, int);
-extern Lisp_Object make_buffer_string_both (EMACS_INT, EMACS_INT, EMACS_INT,
- EMACS_INT, int);
+extern _Noreturn void time_overflow (void);
+extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
+extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, bool);
extern void init_editfns (void);
-const char *get_system_name (void);
extern void syms_of_editfns (void);
-EXFUN (Fconstrain_to_field, 5);
-EXFUN (Ffield_end, 3);
extern void set_time_zone_rule (const char *);
-/* Defined in buffer.c */
-extern int mouse_face_overlay_overlaps (Lisp_Object);
-extern void nsberror (Lisp_Object) NO_RETURN;
-EXFUN (Fset_buffer_multibyte, 1);
-EXFUN (Foverlay_start, 1);
-EXFUN (Foverlay_end, 1);
-extern void adjust_overlays_for_insert (EMACS_INT, EMACS_INT);
-extern void adjust_overlays_for_delete (EMACS_INT, EMACS_INT);
-extern void fix_start_end_in_overlays (EMACS_INT, EMACS_INT);
-extern void report_overlay_modification (Lisp_Object, Lisp_Object, int,
+/* Defined in buffer.c. */
+extern bool mouse_face_overlay_overlaps (Lisp_Object);
+extern _Noreturn void nsberror (Lisp_Object);
+extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t);
+extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t);
+extern void fix_start_end_in_overlays (ptrdiff_t, ptrdiff_t);
+extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool,
Lisp_Object, Lisp_Object, Lisp_Object);
-extern int overlay_touches_p (EMACS_INT);
+extern bool overlay_touches_p (ptrdiff_t);
extern Lisp_Object Vbuffer_alist;
-EXFUN (Fget_buffer, 1);
-EXFUN (Fget_buffer_create, 1);
-EXFUN (Fgenerate_new_buffer_name, 2);
-EXFUN (Fset_buffer, 1);
extern Lisp_Object set_buffer_if_live (Lisp_Object);
-EXFUN (Fbarf_if_buffer_read_only, 0);
-EXFUN (Fcurrent_buffer, 0);
-EXFUN (Fother_buffer, 3);
extern Lisp_Object other_buffer_safely (Lisp_Object);
-EXFUN (Foverlay_get, 2);
-EXFUN (Fbuffer_modified_p, 1);
-EXFUN (Fset_buffer_modified_p, 1);
-EXFUN (Fkill_buffer, 1);
-EXFUN (Fkill_all_local_variables, 0);
-EXFUN (Fbuffer_enable_undo, 1);
-EXFUN (Ferase_buffer, 0);
extern Lisp_Object Qpriority, Qwindow, Qbefore_string, Qafter_string;
extern Lisp_Object get_truename_buffer (Lisp_Object);
-extern struct buffer *all_buffers;
-EXFUN (Fprevious_overlay_change, 1);
-EXFUN (Fbuffer_file_name, 1);
extern void init_buffer_once (void);
extern void init_buffer (void);
extern void syms_of_buffer (void);
extern void keys_of_buffer (void);
-/* Defined in marker.c */
+/* Defined in marker.c. */
-EXFUN (Fmarker_position, 1);
-EXFUN (Fmarker_buffer, 1);
-EXFUN (Fcopy_marker, 2);
-EXFUN (Fset_marker, 3);
-extern EMACS_INT marker_position (Lisp_Object);
-extern EMACS_INT marker_byte_position (Lisp_Object);
+extern ptrdiff_t marker_position (Lisp_Object);
+extern ptrdiff_t marker_byte_position (Lisp_Object);
extern void clear_charpos_cache (struct buffer *);
-extern EMACS_INT charpos_to_bytepos (EMACS_INT);
-extern EMACS_INT buf_charpos_to_bytepos (struct buffer *, EMACS_INT);
-extern EMACS_INT buf_bytepos_to_charpos (struct buffer *, EMACS_INT);
+extern ptrdiff_t charpos_to_bytepos (ptrdiff_t);
+extern ptrdiff_t buf_charpos_to_bytepos (struct buffer *, ptrdiff_t);
+extern ptrdiff_t buf_bytepos_to_charpos (struct buffer *, ptrdiff_t);
extern void unchain_marker (struct Lisp_Marker *marker);
extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
-extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, EMACS_INT, EMACS_INT);
+extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,
- EMACS_INT, EMACS_INT);
+ ptrdiff_t, ptrdiff_t);
+extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t);
extern void syms_of_marker (void);
-/* Defined in fileio.c */
+/* Defined in fileio.c. */
extern Lisp_Object Qfile_error;
extern Lisp_Object Qfile_exists_p;
extern Lisp_Object Qfile_directory_p;
extern Lisp_Object Qinsert_file_contents;
extern Lisp_Object Qfile_name_history;
-EXFUN (Ffind_file_name_handler, 2);
-EXFUN (Ffile_name_as_directory, 1);
-EXFUN (Fexpand_file_name, 2);
-EXFUN (Ffile_name_nondirectory, 1);
-EXFUN (Fsubstitute_in_file_name, 1);
-EXFUN (Ffile_symlink_p, 1);
-EXFUN (Fverify_visited_file_modtime, 1);
-EXFUN (Ffile_exists_p, 1);
-EXFUN (Ffile_name_absolute_p, 1);
-EXFUN (Fdirectory_file_name, 1);
-EXFUN (Ffile_name_directory, 1);
extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object);
-EXFUN (Ffile_accessible_directory_p, 1);
-EXFUN (Funhandled_file_name_directory, 1);
-EXFUN (Ffile_directory_p, 1);
-EXFUN (Fwrite_region, 7);
-EXFUN (Ffile_readable_p, 1);
-EXFUN (Fread_file_name, 6);
+EXFUN (Fread_file_name, 6); /* Not a normal DEFUN. */
extern Lisp_Object close_file_unwind (Lisp_Object);
extern Lisp_Object restore_point_unwind (Lisp_Object);
-extern void report_file_error (const char *, Lisp_Object) NO_RETURN;
-extern int internal_delete_file (Lisp_Object);
+extern _Noreturn void report_file_error (const char *, Lisp_Object);
+extern void internal_delete_file (Lisp_Object);
+extern bool file_directory_p (const char *);
+extern bool file_accessible_directory_p (const char *);
extern void syms_of_fileio (void);
-extern Lisp_Object make_temp_name (Lisp_Object, int);
+extern Lisp_Object make_temp_name (Lisp_Object, bool);
extern Lisp_Object Qdelete_file;
+extern bool check_existing (const char *);
-/* Defined in search.c */
+/* Defined in search.c. */
extern void shrink_regexp_cache (void);
-EXFUN (Fstring_match, 3);
extern void restore_search_regs (void);
-EXFUN (Fmatch_data, 3);
-EXFUN (Fset_match_data, 2);
-EXFUN (Fmatch_beginning, 1);
-EXFUN (Fmatch_end, 1);
extern void record_unwind_save_match_data (void);
struct re_registers;
extern struct re_pattern_buffer *compile_pattern (Lisp_Object,
struct re_registers *,
Lisp_Object, int, int);
-extern EMACS_INT fast_string_match (Lisp_Object, Lisp_Object);
-extern EMACS_INT fast_c_string_match_ignore_case (Lisp_Object, const char *);
-extern EMACS_INT fast_string_match_ignore_case (Lisp_Object, Lisp_Object);
-extern EMACS_INT fast_looking_at (Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, Lisp_Object);
-extern EMACS_INT scan_buffer (int, EMACS_INT, EMACS_INT, EMACS_INT,
- EMACS_INT *, int);
-extern EMACS_INT scan_newline (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT,
- EMACS_INT, int);
-extern EMACS_INT find_next_newline (EMACS_INT, int);
-extern EMACS_INT find_next_newline_no_quit (EMACS_INT, EMACS_INT);
-extern EMACS_INT find_before_next_newline (EMACS_INT, EMACS_INT, EMACS_INT);
+extern ptrdiff_t fast_string_match (Lisp_Object, Lisp_Object);
+extern ptrdiff_t fast_c_string_match_ignore_case (Lisp_Object, const char *,
+ ptrdiff_t);
+extern ptrdiff_t fast_string_match_ignore_case (Lisp_Object, Lisp_Object);
+extern ptrdiff_t fast_looking_at (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, Lisp_Object);
+extern ptrdiff_t scan_buffer (int, ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t *, bool);
+extern EMACS_INT scan_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ EMACS_INT, bool);
+extern ptrdiff_t find_next_newline (ptrdiff_t, int);
+extern ptrdiff_t find_next_newline_no_quit (ptrdiff_t, ptrdiff_t);
+extern ptrdiff_t find_before_next_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t);
extern void syms_of_search (void);
extern void clear_regexp_cache (void);
-/* Defined in minibuf.c */
+/* Defined in minibuf.c. */
extern Lisp_Object Qcompletion_ignore_case;
extern Lisp_Object Vminibuffer_list;
extern Lisp_Object last_minibuf_string;
-EXFUN (Fcompleting_read, 8);
-EXFUN (Fread_from_minibuffer, 7);
-EXFUN (Fread_variable, 2);
-EXFUN (Fread_buffer, 3);
-EXFUN (Fread_minibuffer, 2);
-EXFUN (Feval_minibuffer, 2);
-EXFUN (Fread_string, 5);
-EXFUN (Fassoc_string, 3);
extern Lisp_Object get_minibuffer (EMACS_INT);
extern void init_minibuf_once (void);
extern void syms_of_minibuf (void);
-/* Defined in callint.c */
+/* Defined in callint.c. */
extern Lisp_Object Qminus, Qplus;
extern Lisp_Object Qwhen;
extern Lisp_Object Qcall_interactively, Qmouse_leave_buffer_hook;
-EXFUN (Fprefix_numeric_value, 1);
extern void syms_of_callint (void);
-/* Defined in casefiddle.c */
+/* Defined in casefiddle.c. */
extern Lisp_Object Qidentity;
-EXFUN (Fdowncase, 1);
-EXFUN (Fupcase, 1);
-EXFUN (Fupcase_region, 2);
-EXFUN (Fupcase_initials, 1);
-EXFUN (Fupcase_initials_region, 2);
extern void syms_of_casefiddle (void);
extern void keys_of_casefiddle (void);
-/* Defined in casetab.c */
+/* Defined in casetab.c. */
-EXFUN (Fset_case_table, 1);
-EXFUN (Fset_standard_case_table, 1);
extern void init_casetab_once (void);
extern void syms_of_casetab (void);
-/* Defined in keyboard.c */
+/* Defined in keyboard.c. */
extern Lisp_Object echo_message_buffer;
extern struct kboard *echo_kboard;
@@ -3218,46 +3264,36 @@ extern void cancel_echoing (void);
extern Lisp_Object Qdisabled, QCfilter;
extern Lisp_Object Qup, Qdown, Qbottom;
extern Lisp_Object Qtop;
-extern int input_pending;
-EXFUN (Fdiscard_input, 0);
-EXFUN (Frecursive_edit, 0);
-EXFUN (Ftop_level, 0) NO_RETURN;
+extern Lisp_Object last_undo_boundary;
+extern bool input_pending;
extern Lisp_Object menu_bar_items (Lisp_Object);
extern Lisp_Object tool_bar_items (Lisp_Object, int *);
extern void discard_mouse_events (void);
-EXFUN (Fevent_convert_list, 1);
-EXFUN (Fread_key_sequence, 5);
-EXFUN (Fset_input_interrupt_mode, 1);
-EXFUN (Fset_input_mode, 4);
+#ifdef USABLE_SIGIO
+void handle_input_available_signal (int);
+#endif
extern Lisp_Object pending_funcalls;
-extern int detect_input_pending (void);
-extern int detect_input_pending_ignore_squeezables (void);
-extern int detect_input_pending_run_timers (int);
+extern bool detect_input_pending (void);
+extern bool detect_input_pending_ignore_squeezables (void);
+extern bool detect_input_pending_run_timers (bool);
extern void safe_run_hooks (Lisp_Object);
extern void cmd_error_internal (Lisp_Object, const char *);
extern Lisp_Object command_loop_1 (void);
extern Lisp_Object recursive_edit_1 (void);
extern void record_auto_save (void);
-#ifdef SIGDANGER
extern void force_auto_save_soon (void);
-#endif
extern void init_keyboard (void);
extern void syms_of_keyboard (void);
extern void keys_of_keyboard (void);
-/* Defined in indent.c */
-EXFUN (Fvertical_motion, 2);
-EXFUN (Findent_to, 2);
-EXFUN (Fmove_to_column, 2);
-extern EMACS_INT current_column (void);
+/* Defined in indent.c. */
+extern ptrdiff_t current_column (void);
extern void invalidate_current_column (void);
-extern int indented_beyond_p (EMACS_INT, EMACS_INT, EMACS_INT);
+extern bool indented_beyond_p (ptrdiff_t, ptrdiff_t, EMACS_INT);
extern void syms_of_indent (void);
-/* Defined in frame.c */
-#ifdef HAVE_WINDOW_SYSTEM
-#endif /* HAVE_WINDOW_SYSTEM */
-extern Lisp_Object Qonly;
+/* Defined in frame.c. */
+extern Lisp_Object Qonly, Qnone;
extern Lisp_Object Qvisible;
extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object);
extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object);
@@ -3265,32 +3301,23 @@ extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object);
#if HAVE_NS
extern Lisp_Object get_frame_param (struct frame *, Lisp_Object);
#endif
-extern Lisp_Object frame_buffer_predicate (Lisp_Object);
-EXFUN (Fselect_frame, 2);
-EXFUN (Fselected_frame, 0);
-EXFUN (Fmake_frame_visible, 1);
-EXFUN (Ficonify_frame, 1);
-EXFUN (Fframe_parameter, 2);
-EXFUN (Fmodify_frame_parameters, 2);
-EXFUN (Fraise_frame, 1);
-EXFUN (Fredirect_frame_focus, 2);
extern void frames_discard_buffer (Lisp_Object);
extern void syms_of_frame (void);
-/* Defined in emacs.c */
+/* Defined in emacs.c. */
extern char **initial_argv;
extern int initial_argc;
#if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
-extern int display_arg;
+extern bool display_arg;
#endif
extern Lisp_Object decode_env_path (const char *, const char *);
extern Lisp_Object empty_unibyte_string, empty_multibyte_string;
extern Lisp_Object Qfile_name_handler_alist;
-#ifdef FLOAT_CATCH_SIGILL
-extern void fatal_error_signal (int);
-#endif
+extern _Noreturn void terminate_due_to_signal (int, int);
extern Lisp_Object Qkill_emacs;
-EXFUN (Fkill_emacs, 1) NO_RETURN;
+#ifdef WINDOWSNT
+extern Lisp_Object Vlibrary_cache;
+#endif
#if HAVE_SETLOCALE
void fixup_locale (void);
void synchronize_system_messages_locale (void);
@@ -3301,35 +3328,43 @@ void synchronize_system_time_locale (void);
#define synchronize_system_messages_locale()
#define synchronize_system_time_locale()
#endif
-void shut_down_emacs (int, int, Lisp_Object);
-/* Nonzero means don't do interactive redisplay and don't change tty modes. */
-extern int noninteractive;
+extern void shut_down_emacs (int, Lisp_Object);
+
+/* True means don't do interactive redisplay and don't change tty modes. */
+extern bool noninteractive;
-/* Nonzero means remove site-lisp directories from load-path. */
-extern int no_site_lisp;
+/* True means remove site-lisp directories from load-path. */
+extern bool no_site_lisp;
/* Pipe used to send exit notification to the daemon parent at
startup. */
extern int daemon_pipe[2];
#define IS_DAEMON (daemon_pipe[1] != 0)
-/* Nonzero means don't do use window-system-specific display code. */
-extern int inhibit_window_system;
-/* Nonzero means that a filter or a sentinel is running. */
-extern int running_asynch_code;
+/* True if handling a fatal error already. */
+extern bool fatal_error_in_progress;
+
+/* True means don't do use window-system-specific display code. */
+extern bool inhibit_window_system;
+/* True means that a filter or a sentinel is running. */
+extern bool running_asynch_code;
/* Defined in process.c. */
extern Lisp_Object QCtype, Qlocal;
-EXFUN (Fget_buffer_process, 1);
-EXFUN (Fprocess_status, 1);
-EXFUN (Fkill_process, 2);
-EXFUN (Fwaiting_for_user_input_p, 0);
extern Lisp_Object Qprocessp;
extern void kill_buffer_processes (Lisp_Object);
-extern int wait_reading_process_output (int, int, int, int,
+extern int wait_reading_process_output (intmax_t, int, int, bool,
Lisp_Object,
struct Lisp_Process *,
int);
+/* Max value for the first argument of wait_reading_process_output. */
+#if __GNUC__ == 3 || (__GNUC__ == 4 && __GNUC_MINOR__ <= 5)
+/* Work around a bug in GCC 3.4.2, known to be fixed in GCC 4.6.3.
+ The bug merely causes a bogus warning, but the warning is annoying. */
+# define WAIT_READING_MAX min (TYPE_MAXIMUM (time_t), INTMAX_MAX)
+#else
+# define WAIT_READING_MAX INTMAX_MAX
+#endif
extern void add_keyboard_wait_descriptor (int);
extern void delete_keyboard_wait_descriptor (int);
#ifdef HAVE_GPM
@@ -3337,30 +3372,27 @@ extern void add_gpm_wait_descriptor (int);
extern void delete_gpm_wait_descriptor (int);
#endif
extern void close_process_descs (void);
-extern void init_process (void);
+extern void init_process_emacs (void);
extern void syms_of_process (void);
extern void setup_process_coding_systems (Lisp_Object);
-EXFUN (Fcall_process, MANY);
-extern int child_setup (int, int, int, char **, int, Lisp_Object)
#ifndef DOS_NT
- NO_RETURN
+ _Noreturn
#endif
- ;
+extern int child_setup (int, int, int, char **, bool, Lisp_Object);
extern void init_callproc_1 (void);
extern void init_callproc (void);
extern void set_initial_environment (void);
extern void syms_of_callproc (void);
-/* Defined in doc.c */
+/* Defined in doc.c. */
extern Lisp_Object Qfunction_documentation;
-EXFUN (Fsubstitute_command_keys, 1);
extern Lisp_Object read_doc_string (Lisp_Object);
-extern Lisp_Object get_doc_string (Lisp_Object, int, int);
+extern Lisp_Object get_doc_string (Lisp_Object, bool, bool);
extern void syms_of_doc (void);
-extern int read_bytecode_char (int);
+extern int read_bytecode_char (bool);
-/* Defined in bytecode.c */
+/* Defined in bytecode.c. */
extern Lisp_Object Qbytecode;
extern void syms_of_bytecode (void);
extern struct byte_stack *byte_stack_list;
@@ -3371,61 +3403,50 @@ extern void unmark_byte_stack (void);
extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, ptrdiff_t, Lisp_Object *);
-/* Defined in macros.c */
+/* Defined in macros.c. */
extern Lisp_Object Qexecute_kbd_macro;
-EXFUN (Fexecute_kbd_macro, 3);
-EXFUN (Fcancel_kbd_macro_events, 0);
extern void init_macros (void);
extern void syms_of_macros (void);
-/* Defined in undo.c */
+/* Defined in undo.c. */
extern Lisp_Object Qapply;
extern Lisp_Object Qinhibit_read_only;
-EXFUN (Fundo_boundary, 0);
extern void truncate_undo_list (struct buffer *);
-extern void record_marker_adjustment (Lisp_Object, EMACS_INT);
-extern void record_insert (EMACS_INT, EMACS_INT);
-extern void record_delete (EMACS_INT, Lisp_Object);
+extern void record_marker_adjustment (Lisp_Object, ptrdiff_t);
+extern void record_insert (ptrdiff_t, ptrdiff_t);
+extern void record_delete (ptrdiff_t, Lisp_Object);
extern void record_first_change (void);
-extern void record_change (EMACS_INT, EMACS_INT);
-extern void record_property_change (EMACS_INT, EMACS_INT,
+extern void record_change (ptrdiff_t, ptrdiff_t);
+extern void record_property_change (ptrdiff_t, ptrdiff_t,
Lisp_Object, Lisp_Object,
Lisp_Object);
extern void syms_of_undo (void);
-/* Defined in textprop.c */
+/* Defined in textprop.c. */
extern Lisp_Object Qfont, Qmouse_face;
extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks;
extern Lisp_Object Qfront_sticky, Qrear_nonsticky;
extern Lisp_Object Qminibuffer_prompt;
-EXFUN (Fnext_single_property_change, 4);
-EXFUN (Fnext_single_char_property_change, 4);
-EXFUN (Fprevious_single_property_change, 4);
-EXFUN (Fget_text_property, 3);
-EXFUN (Fput_text_property, 5);
-EXFUN (Fprevious_char_property_change, 2);
-EXFUN (Fnext_char_property_change, 2);
extern void report_interval_modification (Lisp_Object, Lisp_Object);
-/* Defined in menu.c */
+/* Defined in menu.c. */
extern void syms_of_menu (void);
-/* Defined in xmenu.c */
-EXFUN (Fx_popup_menu, 2);
-EXFUN (Fx_popup_dialog, 3);
+/* Defined in xmenu.c. */
extern void syms_of_xmenu (void);
-/* Defined in termchar.h */
+/* Defined in termchar.h. */
struct tty_display_info;
-/* Defined in termhooks.h */
+/* Defined in termhooks.h. */
struct terminal;
-/* Defined in sysdep.c */
+/* Defined in sysdep.c. */
#ifndef HAVE_GET_CURRENT_DIR_NAME
extern char *get_current_dir_name (void);
#endif
extern void stuff_char (char c);
+extern void init_foreground_group (void);
extern void init_sigio (int);
extern void sys_subshell (void);
extern void sys_suspend (void);
@@ -3434,74 +3455,67 @@ extern void init_sys_modes (struct tty_display_info *);
extern void reset_sys_modes (struct tty_display_info *);
extern void init_all_sys_modes (void);
extern void reset_all_sys_modes (void);
-extern void wait_for_termination (int);
-extern void interruptible_wait_for_termination (int);
-extern void flush_pending_output (int);
+extern void flush_pending_output (int) ATTRIBUTE_CONST;
extern void child_setup_tty (int);
extern void setup_pty (int);
extern int set_window_size (int, int, int);
extern EMACS_INT get_random (void);
-extern void seed_random (long);
+extern void seed_random (void *, ptrdiff_t);
+extern void init_random (void);
+extern void emacs_backtrace (int);
+extern _Noreturn void emacs_abort (void) NO_INLINE;
extern int emacs_open (const char *, int, int);
extern int emacs_close (int);
-extern EMACS_INT emacs_read (int, char *, EMACS_INT);
-extern EMACS_INT emacs_write (int, const char *, EMACS_INT);
+extern ptrdiff_t emacs_read (int, char *, ptrdiff_t);
+extern ptrdiff_t emacs_write (int, const char *, ptrdiff_t);
enum { READLINK_BUFSIZE = 1024 };
extern char *emacs_readlink (const char *, char [READLINK_BUFSIZE]);
-EXFUN (Funlock_buffer, 0);
extern void unlock_all_files (void);
extern void lock_file (Lisp_Object);
extern void unlock_file (Lisp_Object);
extern void unlock_buffer (struct buffer *);
extern void syms_of_filelock (void);
-extern void init_filelock (void);
-/* Defined in sound.c */
+/* Defined in sound.c. */
extern void syms_of_sound (void);
-extern void init_sound (void);
-/* Defined in category.c */
+/* Defined in category.c. */
extern void init_category_once (void);
extern Lisp_Object char_category_set (int);
extern void syms_of_category (void);
-/* Defined in ccl.c */
+/* Defined in ccl.c. */
extern void syms_of_ccl (void);
-/* Defined in dired.c */
+/* Defined in dired.c. */
extern void syms_of_dired (void);
extern Lisp_Object directory_files_internal (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object,
- int, Lisp_Object);
+ bool, Lisp_Object);
-/* Defined in term.c */
+/* Defined in term.c. */
extern int *char_ins_del_vector;
-extern void mark_ttys (void);
extern void syms_of_term (void);
-extern void fatal (const char *msgid, ...)
- NO_RETURN ATTRIBUTE_FORMAT_PRINTF (1, 2);
+extern _Noreturn void fatal (const char *msgid, ...)
+ ATTRIBUTE_FORMAT_PRINTF (1, 2);
-/* Defined in terminal.c */
-EXFUN (Fframe_terminal, 1);
-EXFUN (Fdelete_terminal, 2);
+/* Defined in terminal.c. */
extern void syms_of_terminal (void);
-/* Defined in font.c */
+/* Defined in font.c. */
extern void syms_of_font (void);
extern void init_font (void);
#ifdef HAVE_WINDOW_SYSTEM
-/* Defined in fontset.c */
+/* Defined in fontset.c. */
extern void syms_of_fontset (void);
-/* Defined in xfns.c, w32fns.c, or macfns.c */
+/* Defined in xfns.c, w32fns.c, or macfns.c. */
extern Lisp_Object Qfont_param;
-EXFUN (Fxw_display_color_p, 1);
-EXFUN (Fx_focus_frame, 1);
#endif
-/* Defined in xfaces.c */
+/* Defined in xfaces.c. */
extern Lisp_Object Qdefault, Qtool_bar, Qfringe;
extern Lisp_Object Qheader_line, Qscroll_bar, Qcursor;
extern Lisp_Object Qmode_line_inactive;
@@ -3509,39 +3523,36 @@ extern Lisp_Object Qface;
extern Lisp_Object Qnormal;
extern Lisp_Object QCfamily, QCweight, QCslant;
extern Lisp_Object QCheight, QCname, QCwidth, QCforeground, QCbackground;
+extern Lisp_Object Qextra_light, Qlight, Qsemi_light, Qsemi_bold;
+extern Lisp_Object Qbold, Qextra_bold, Qultra_bold;
+extern Lisp_Object Qoblique, Qitalic;
extern Lisp_Object Vface_alternative_font_family_alist;
extern Lisp_Object Vface_alternative_font_registry_alist;
-EXFUN (Fclear_face_cache, 1);
-EXFUN (Fx_load_color_file, 1);
extern void syms_of_xfaces (void);
#ifdef HAVE_X_WINDOWS
-/* Defined in xfns.c */
+/* Defined in xfns.c. */
extern void syms_of_xfns (void);
-/* Defined in xsmfns.c */
+/* Defined in xsmfns.c. */
extern void syms_of_xsmfns (void);
-/* Defined in xselect.c */
+/* Defined in xselect.c. */
extern void syms_of_xselect (void);
-/* Defined in xterm.c */
+/* Defined in xterm.c. */
extern void syms_of_xterm (void);
#endif /* HAVE_X_WINDOWS */
#ifdef HAVE_WINDOW_SYSTEM
-/* Defined in xterm.c, nsterm.m, w32term.c */
+/* Defined in xterm.c, nsterm.m, w32term.c. */
extern char *x_get_keysym_name (int);
#endif /* HAVE_WINDOW_SYSTEM */
-#ifdef MSDOS
-/* Defined in msdos.c */
-EXFUN (Fmsdos_downcase_filename, 1);
-#endif
-
#ifdef HAVE_LIBXML2
-/* Defined in xml.c */
+/* Defined in xml.c. */
extern void syms_of_xml (void);
+extern void xml_cleanup_parser (void);
#endif
#ifdef HAVE_MENUS
@@ -3550,24 +3561,33 @@ extern int have_menus_p (void);
#endif
#ifdef HAVE_DBUS
-/* Defined in dbusbind.c */
+/* Defined in dbusbind.c. */
void syms_of_dbusbind (void);
#endif
+
+/* Defined in profiler.c. */
+extern bool profiler_memory_running;
+extern void malloc_probe (size_t);
+extern void syms_of_profiler (void);
+
+
#ifdef DOS_NT
-/* Defined in msdos.c, w32.c */
+/* Defined in msdos.c, w32.c. */
extern char *emacs_root_dir (void);
#endif /* DOS_NT */
-/* Nonzero means Emacs has already been initialized.
+/* True means Emacs has already been initialized.
Used during startup to detect startup of dumped Emacs. */
-extern int initialized;
+extern bool initialized;
-extern int immediate_quit; /* Nonzero means ^G can quit instantly */
+/* True means ^G can quit instantly. */
+extern bool immediate_quit;
-extern POINTER_TYPE *xmalloc (size_t);
-extern POINTER_TYPE *xrealloc (POINTER_TYPE *, size_t);
-extern void xfree (POINTER_TYPE *);
+extern void *xmalloc (size_t);
+extern void *xzalloc (size_t);
+extern void *xrealloc (void *, size_t);
+extern void xfree (void *);
extern void *xnmalloc (ptrdiff_t, ptrdiff_t);
extern void *xnrealloc (void *, ptrdiff_t, ptrdiff_t);
extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t);
@@ -3579,51 +3599,6 @@ extern char *egetenv (const char *);
/* Set up the name of the machine we're running on. */
extern void init_system_name (void);
-/* Some systems (e.g., NT) use a different path separator than Unix,
- in addition to a device separator. Set the path separator
- to '/', and don't test for a device separator in IS_ANY_SEP. */
-
-#define DIRECTORY_SEP '/'
-#ifndef IS_DIRECTORY_SEP
-#define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP)
-#endif
-#ifndef IS_DEVICE_SEP
-#ifndef DEVICE_SEP
-#define IS_DEVICE_SEP(_c_) 0
-#else
-#define IS_DEVICE_SEP(_c_) ((_c_) == DEVICE_SEP)
-#endif
-#endif
-#ifndef IS_ANY_SEP
-#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_))
-#endif
-
-#define SWITCH_ENUM_CAST(x) (x)
-
-/* Use this to suppress gcc's warnings. */
-#ifdef lint
-
-/* Use CODE only if lint checking is in effect. */
-# define IF_LINT(Code) Code
-
-/* Assume that the expression COND is true. This differs in intent
- from 'assert', as it is a message from the programmer to the compiler. */
-# define lint_assume(cond) ((cond) ? (void) 0 : abort ())
-
-#else
-# define IF_LINT(Code) /* empty */
-# define lint_assume(cond) ((void) (0 && (cond)))
-#endif
-
-/* The ubiquitous min and max macros. */
-
-#ifdef max
-#undef max
-#undef min
-#endif
-#define min(a, b) ((a) < (b) ? (a) : (b))
-#define max(a, b) ((a) > (b) ? (a) : (b))
-
/* We used to use `abs', but that clashes with system headers on some
platforms, and using a name reserved by Standard C is a bad idea
anyway. */
@@ -3637,56 +3612,22 @@ extern void init_system_name (void);
#define make_fixnum_or_float(val) \
(FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_number (val))
-
-/* Checks the `cycle check' variable CHECK to see if it indicates that
- EL is part of a cycle; CHECK must be either Qnil or a value returned
- by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
- elements after which a cycle might be suspected; after that many
- elements, this macro begins consing in order to keep more precise
- track of elements.
-
- Returns nil if a cycle was detected, otherwise a new value for CHECK
- that includes EL.
-
- CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
- the caller should make sure that's ok. */
-
-#define CYCLE_CHECK(check, el, suspicious) \
- (NILP (check) \
- ? make_number (0) \
- : (INTEGERP (check) \
- ? (XFASTINT (check) < (suspicious) \
- ? make_number (XFASTINT (check) + 1) \
- : Fcons (el, Qnil)) \
- : (!NILP (Fmemq ((el), (check))) \
- ? Qnil \
- : Fcons ((el), (check)))))
-
-
/* SAFE_ALLOCA normally allocates memory on the stack, but if size is
larger than MAX_ALLOCA, use xmalloc to avoid overflowing the stack. */
-#define MAX_ALLOCA 16*1024
+enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 };
extern Lisp_Object safe_alloca_unwind (Lisp_Object);
+extern void *record_xmalloc (size_t);
#define USE_SAFE_ALLOCA \
- int sa_count = (int) SPECPDL_INDEX (), sa_must_free = 0
+ ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = 0
/* SAFE_ALLOCA allocates a simple buffer. */
-#define SAFE_ALLOCA(buf, type, size) \
- do { \
- if ((size) < MAX_ALLOCA) \
- buf = (type) alloca (size); \
- else \
- { \
- buf = (type) xmalloc (size); \
- sa_must_free = 1; \
- record_unwind_protect (safe_alloca_unwind, \
- make_save_value (buf, 0)); \
- } \
- } while (0)
+#define SAFE_ALLOCA(size) ((size) < MAX_ALLOCA \
+ ? alloca (size) \
+ : (sa_must_free = 1, record_xmalloc (size)))
/* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER *
NITEMS items, each of the same type as *BUF. MULTIPLIER must
@@ -3718,24 +3659,70 @@ extern Lisp_Object safe_alloca_unwind (Lisp_Object);
/* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */
-#define SAFE_ALLOCA_LISP(buf, nelt) \
- do { \
- if ((nelt) < MAX_ALLOCA / sizeof (Lisp_Object)) \
- buf = (Lisp_Object *) alloca ((nelt) * sizeof (Lisp_Object)); \
- else if ((nelt) < min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object)) \
- { \
- Lisp_Object arg_; \
- buf = (Lisp_Object *) xmalloc ((nelt) * sizeof (Lisp_Object)); \
- arg_ = make_save_value (buf, nelt); \
- XSAVE_VALUE (arg_)->dogc = 1; \
- sa_must_free = 1; \
- record_unwind_protect (safe_alloca_unwind, arg_); \
- } \
- else \
- memory_full (SIZE_MAX); \
+#define SAFE_ALLOCA_LISP(buf, nelt) \
+ do { \
+ if ((nelt) < MAX_ALLOCA / word_size) \
+ buf = alloca ((nelt) * word_size); \
+ else if ((nelt) < min (PTRDIFF_MAX, SIZE_MAX) / word_size) \
+ { \
+ Lisp_Object arg_; \
+ buf = xmalloc ((nelt) * word_size); \
+ arg_ = make_save_value (buf, nelt); \
+ XSAVE_VALUE (arg_)->dogc = 1; \
+ sa_must_free = 1; \
+ record_unwind_protect (safe_alloca_unwind, arg_); \
+ } \
+ else \
+ memory_full (SIZE_MAX); \
} while (0)
#include "globals.h"
+/* Check whether it's time for GC, and run it if so. */
+
+LISP_INLINE void
+maybe_gc (void)
+{
+ if ((consing_since_gc > gc_cons_threshold
+ && consing_since_gc > gc_relative_threshold)
+ || (!NILP (Vmemory_full)
+ && consing_since_gc > memory_full_cons_threshold))
+ Fgarbage_collect ();
+}
+
+LISP_INLINE int
+functionp (Lisp_Object object)
+{
+ if (SYMBOLP (object) && !NILP (Ffboundp (object)))
+ {
+ object = Findirect_function (object, Qt);
+
+ if (CONSP (object) && EQ (XCAR (object), Qautoload))
+ {
+ /* Autoloaded symbols are functions, except if they load
+ macros or keymaps. */
+ int i;
+ for (i = 0; i < 4 && CONSP (object); i++)
+ object = XCDR (object);
+
+ return ! (CONSP (object) && !NILP (XCAR (object)));
+ }
+ }
+
+ if (SUBRP (object))
+ return XSUBR (object)->max_args != UNEVALLED;
+ else if (COMPILEDP (object))
+ return 1;
+ else if (CONSP (object))
+ {
+ Lisp_Object car = XCAR (object);
+ return EQ (car, Qlambda) || EQ (car, Qclosure);
+ }
+ else
+ return 0;
+}
+
+INLINE_HEADER_END
+
#endif /* EMACS_LISP_H */
diff --git a/src/lisp.mk b/src/lisp.mk
index 68748b27f28..8c2710110e3 100644
--- a/src/lisp.mk
+++ b/src/lisp.mk
@@ -1,6 +1,6 @@
### lisp.mk --- src/Makefile fragment for GNU Emacs
-## Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2011
+## Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2012
## Free Software Foundation, Inc.
## This file is part of GNU Emacs.
@@ -30,11 +30,13 @@
## sed -e 's/"[ )].*//' -n -e '/(load "/ s/.*load "//p' loadup.el | \
## grep -vE 'site-|ldefs-boot'
## minus any duplicates.
-## Note that you cannot just add a ".elc" extension to every file,
-## since some of them are no-byte-compile (eg some language/ ones).
+## Note that you can generally just add a ".elc" extension to every file
+## that does not have an explicit .el extension, but beware of any
+## no-byte-compile ones.
-## Confusingly, term/internal is not in loadup, but is unconditionally
-## loaded by pc-win, which is.
+## Confusingly, international/cp51932 and international/eucjp-ms are
+## unconditionally loaded from language/japanese, instead of being
+## loaded directly from loadup.el; FIXME.
## Note that this list should not include lisp files which might not
## be present, like site-load.el and site-init.el; this makefile
@@ -53,7 +55,7 @@ lisp = \
$(lispsource)/emacs-lisp/byte-run.elc \
$(lispsource)/emacs-lisp/backquote.elc \
$(lispsource)/subr.elc \
- $(lispsource)/version.el \
+ $(lispsource)/version.elc \
$(lispsource)/widget.elc \
$(lispsource)/custom.elc \
$(lispsource)/emacs-lisp/map-ynp.elc \
@@ -64,6 +66,7 @@ lisp = \
$(lispsource)/format.elc \
$(lispsource)/bindings.elc \
$(lispsource)/files.elc \
+ $(lispsource)/emacs-lisp/macroexp.elc \
$(lispsource)/cus-face.elc \
$(lispsource)/faces.elc \
$(lispsource)/button.elc \
@@ -82,28 +85,30 @@ lisp = \
$(lispsource)/language/chinese.elc \
$(lispsource)/language/cyrillic.elc \
$(lispsource)/language/indian.elc \
- $(lispsource)/language/sinhala.el \
- $(lispsource)/language/english.el \
+ $(lispsource)/language/sinhala.elc \
+ $(lispsource)/language/english.elc \
$(lispsource)/language/ethiopic.elc \
$(lispsource)/language/european.elc \
- $(lispsource)/language/czech.el \
- $(lispsource)/language/slovak.el \
- $(lispsource)/language/romanian.el \
- $(lispsource)/language/greek.el \
+ $(lispsource)/language/czech.elc \
+ $(lispsource)/language/slovak.elc \
+ $(lispsource)/language/romanian.elc \
+ $(lispsource)/language/greek.elc \
$(lispsource)/language/hebrew.elc \
- $(lispsource)/language/japanese.el \
- $(lispsource)/language/korean.el \
- $(lispsource)/language/lao.el \
- $(lispsource)/language/tai-viet.el \
- $(lispsource)/language/thai.el \
+ $(lispsource)/language/japanese.elc \
+ $(lispsource)/international/cp51932.el \
+ $(lispsource)/international/eucjp-ms.el \
+ $(lispsource)/language/korean.elc \
+ $(lispsource)/language/lao.elc \
+ $(lispsource)/language/tai-viet.elc \
+ $(lispsource)/language/thai.elc \
$(lispsource)/language/tibetan.elc \
$(lispsource)/language/vietnamese.elc \
- $(lispsource)/language/misc-lang.el \
- $(lispsource)/language/utf-8-lang.el \
- $(lispsource)/language/georgian.el \
- $(lispsource)/language/khmer.el \
- $(lispsource)/language/burmese.el \
- $(lispsource)/language/cham.el \
+ $(lispsource)/language/misc-lang.elc \
+ $(lispsource)/language/utf-8-lang.elc \
+ $(lispsource)/language/georgian.elc \
+ $(lispsource)/language/khmer.elc \
+ $(lispsource)/language/burmese.elc \
+ $(lispsource)/language/cham.elc \
$(lispsource)/indent.elc \
$(lispsource)/window.elc \
$(lispsource)/frame.elc \
@@ -120,7 +125,6 @@ lisp = \
$(lispsource)/isearch.elc \
$(lispsource)/rfn-eshadow.elc \
$(lispsource)/menu-bar.elc \
- $(lispsource)/paths.el \
$(lispsource)/emacs-lisp/lisp.elc \
$(lispsource)/textmodes/page.elc \
$(lispsource)/register.elc \
@@ -128,9 +132,12 @@ lisp = \
$(lispsource)/emacs-lisp/lisp-mode.elc \
$(lispsource)/textmodes/text-mode.elc \
$(lispsource)/textmodes/fill.elc \
+ $(lispsource)/newcomment.elc \
$(lispsource)/replace.elc \
+ $(lispsource)/emacs-lisp/tabulated-list.elc \
$(lispsource)/buff-menu.elc \
$(lispsource)/fringe.elc \
+ $(lispsource)/emacs-lisp/regexp-opt.elc \
$(lispsource)/image.elc \
$(lispsource)/international/fontset.elc \
$(lispsource)/dnd.elc \
diff --git a/src/lread.c b/src/lread.c
index 7c0b0475786..6d0ff9f780e 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1,6 +1,6 @@
/* Lisp parsing and input streams.
-Copyright (C) 1985-1989, 1993-1995, 1997-2011 Free Software Foundation, Inc.
+Copyright (C) 1985-1989, 1993-1995, 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -24,12 +24,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/stat.h>
#include <sys/file.h>
#include <errno.h>
-#include <limits.h> /* for CHAR_BIT */
-#include <setjmp.h>
+#include <limits.h> /* For CHAR_BIT. */
+#include <stat-time.h>
#include "lisp.h"
#include "intervals.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "coding.h"
#include <epaths.h>
@@ -44,8 +44,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "msdos.h"
#endif
+#ifdef HAVE_NS
+#include "nsterm.h"
+#endif
+
#include <unistd.h>
-#include <math.h>
#ifdef HAVE_SETLOCALE
#include <locale.h>
@@ -61,7 +64,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define file_tell ftell
#endif
-/* hash table read constants */
+/* Hash table read constants. */
static Lisp_Object Qhash_table, Qdata;
static Lisp_Object Qtest, Qsize;
static Lisp_Object Qweakness;
@@ -75,7 +78,7 @@ static Lisp_Object Qascii_character, Qload, Qload_file_name;
Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
static Lisp_Object Qinhibit_file_name_operation;
static Lisp_Object Qeval_buffer_list;
-static Lisp_Object Qlexical_binding;
+Lisp_Object Qlexical_binding;
static Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
/* Used instead of Qget_file_char while loading *.elc files compiled
@@ -84,8 +87,6 @@ static Lisp_Object Qget_emacs_mule_file_char;
static Lisp_Object Qload_force_doc_strings;
-extern Lisp_Object Qinternal_interpreter_environment;
-
static Lisp_Object Qload_in_progress;
/* The association list of objects read with the #n=object form.
@@ -94,10 +95,10 @@ static Lisp_Object Qload_in_progress;
It must be set to nil before all top-level calls to read0. */
static Lisp_Object read_objects;
-/* Nonzero means READCHAR should read bytes one by one (not character)
+/* True means READCHAR should read bytes one by one (not character)
when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
- This is set to 1 by read1 temporarily while handling #@NUMBER. */
-static int load_each_byte;
+ This is set by read1 temporarily while handling #@NUMBER. */
+static bool load_each_byte;
/* List of descriptors now open for Fload. */
static Lisp_Object load_descriptor_list;
@@ -105,16 +106,13 @@ static Lisp_Object load_descriptor_list;
/* File for get_file_char to read from. Use by load. */
static FILE *instream;
-/* When nonzero, read conses in pure space */
-static int read_pure;
-
/* For use within read-from-string (this reader is non-reentrant!!) */
-static EMACS_INT read_from_string_index;
-static EMACS_INT read_from_string_index_byte;
-static EMACS_INT read_from_string_limit;
+static ptrdiff_t read_from_string_index;
+static ptrdiff_t read_from_string_index_byte;
+static ptrdiff_t read_from_string_limit;
/* Number of characters read in the current call to Fread or
- Fread_from_string. */
+ Fread_from_string. */
static EMACS_INT readchar_count;
/* This contains the last string skipped with #@. */
@@ -137,11 +135,11 @@ static ptrdiff_t prev_saved_doc_string_length;
/* This is the file position that string came from. */
static file_offset prev_saved_doc_string_position;
-/* Nonzero means inside a new-style backquote
+/* True means inside a new-style backquote
with no surrounding parentheses.
- Fread initializes this to zero, so we need not specbind it
+ Fread initializes this to false, so we need not specbind it
or worry about what happens to it when there is an error. */
-static int new_backquote_flag;
+static bool new_backquote_flag;
static Lisp_Object Qold_style_backquotes;
/* A list of file names for files being loaded in Fload. Used to
@@ -152,15 +150,11 @@ static Lisp_Object Vloads_in_progress;
static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
Lisp_Object);
-static void readevalloop (Lisp_Object, FILE*, Lisp_Object, int,
+static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
static Lisp_Object load_unwind (Lisp_Object);
static Lisp_Object load_descriptor_unwind (Lisp_Object);
-
-static void invalid_syntax (const char *) NO_RETURN;
-static void end_of_file_error (void) NO_RETURN;
-
/* Functions that read one byte from the current source READCHARFUN
or unreads one byte. If the integer argument C is -1, it returns
@@ -187,18 +181,18 @@ static int readbyte_from_string (int, Lisp_Object);
/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
Qlambda, or a cons, we use this to keep an unread character because
a file stream can't handle multibyte-char unreading. The value -1
- means that there's no unread character. */
+ means that there's no unread character. */
static int unread_char;
static int
-readchar (Lisp_Object readcharfun, int *multibyte)
+readchar (Lisp_Object readcharfun, bool *multibyte)
{
Lisp_Object tem;
register int c;
int (*readbyte) (int, Lisp_Object);
unsigned char buf[MAX_MULTIBYTE_LENGTH];
int i, len;
- int emacs_mule_encoding = 0;
+ bool emacs_mule_encoding = 0;
if (multibyte)
*multibyte = 0;
@@ -209,7 +203,7 @@ readchar (Lisp_Object readcharfun, int *multibyte)
{
register struct buffer *inbuffer = XBUFFER (readcharfun);
- EMACS_INT pt_byte = BUF_PT_BYTE (inbuffer);
+ ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
if (pt_byte >= BUF_ZV_BYTE (inbuffer))
return -1;
@@ -238,7 +232,7 @@ readchar (Lisp_Object readcharfun, int *multibyte)
{
register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
- EMACS_INT bytepos = marker_byte_position (readcharfun);
+ ptrdiff_t bytepos = marker_byte_position (readcharfun);
if (bytepos >= BUF_ZV_BYTE (inbuffer))
return -1;
@@ -372,8 +366,8 @@ unreadchar (Lisp_Object readcharfun, int c)
else if (BUFFERP (readcharfun))
{
struct buffer *b = XBUFFER (readcharfun);
- EMACS_INT charpos = BUF_PT (b);
- EMACS_INT bytepos = BUF_PT_BYTE (b);
+ ptrdiff_t charpos = BUF_PT (b);
+ ptrdiff_t bytepos = BUF_PT_BYTE (b);
if (! NILP (BVAR (b, enable_multibyte_characters)))
BUF_DEC_POS (b, bytepos);
@@ -385,7 +379,7 @@ unreadchar (Lisp_Object readcharfun, int c)
else if (MARKERP (readcharfun))
{
struct buffer *b = XMARKER (readcharfun)->buffer;
- EMACS_INT bytepos = XMARKER (readcharfun)->bytepos;
+ ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
XMARKER (readcharfun)->charpos--;
if (! NILP (BVAR (b, enable_multibyte_characters)))
@@ -414,9 +408,9 @@ unreadchar (Lisp_Object readcharfun, int c)
{
if (load_each_byte)
{
- BLOCK_INPUT;
+ block_input ();
ungetc (c, instream);
- UNBLOCK_INPUT;
+ unblock_input ();
}
else
unread_char = c;
@@ -437,28 +431,28 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
{
if (c >= 0)
{
- BLOCK_INPUT;
+ block_input ();
ungetc (c, instream);
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
- BLOCK_INPUT;
+ block_input ();
c = getc (instream);
#ifdef EINTR
- /* Interrupted reads have been observed while reading over the network */
+ /* Interrupted reads have been observed while reading over the network. */
while (c == EOF && ferror (instream) && errno == EINTR)
{
- UNBLOCK_INPUT;
+ unblock_input ();
QUIT;
- BLOCK_INPUT;
+ block_input ();
clearerr (instream);
c = getc (instream);
}
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
return (c == EOF ? -1 : c);
}
@@ -552,10 +546,10 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea
static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
Lisp_Object);
static Lisp_Object read0 (Lisp_Object);
-static Lisp_Object read1 (Lisp_Object, int *, int);
+static Lisp_Object read1 (Lisp_Object, int *, bool);
-static Lisp_Object read_list (int, Lisp_Object);
-static Lisp_Object read_vector (Lisp_Object, int);
+static Lisp_Object read_list (bool, Lisp_Object);
+static Lisp_Object read_vector (Lisp_Object, bool);
static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object,
Lisp_Object);
@@ -568,28 +562,28 @@ static void substitute_in_interval (INTERVAL, Lisp_Object);
/* Read input events until we get one that's acceptable for our purposes.
- If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
+ If NO_SWITCH_FRAME, switch-frame events are stashed
until we get a character we like, and then stuffed into
unread_switch_frame.
- If ASCII_REQUIRED is non-zero, we check function key events to see
+ If ASCII_REQUIRED, check function key events to see
if the unmodified version of the symbol has a Qascii_character
property, and use that character, if present.
- If ERROR_NONASCII is non-zero, we signal an error if the input we
- get isn't an ASCII character with modifiers. If it's zero but
- ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
+ If ERROR_NONASCII, signal an error if the input we
+ get isn't an ASCII character with modifiers. If it's false but
+ ASCII_REQUIRED is true, just re-read until we get an ASCII
character.
- If INPUT_METHOD is nonzero, we invoke the current input method
+ If INPUT_METHOD, invoke the current input method
if the character warrants that.
- If SECONDS is a number, we wait that many seconds for input, and
+ If SECONDS is a number, wait that many seconds for input, and
return Qnil if no input arrives within that time. */
static Lisp_Object
-read_filtered_event (int no_switch_frame, int ascii_required,
- int error_nonascii, int input_method, Lisp_Object seconds)
+read_filtered_event (bool no_switch_frame, bool ascii_required,
+ bool error_nonascii, bool input_method, Lisp_Object seconds)
{
Lisp_Object val, delayed_switch_frame;
EMACS_TIME end_time;
@@ -604,15 +598,9 @@ read_filtered_event (int no_switch_frame, int ascii_required,
/* Compute timeout. */
if (NUMBERP (seconds))
{
- EMACS_TIME wait_time;
- int sec, usec;
double duration = extract_float (seconds);
-
- sec = (int) duration;
- usec = (duration - sec) * 1000000;
- EMACS_GET_TIME (end_time);
- EMACS_SET_SECS_USECS (wait_time, sec, usec);
- EMACS_ADD_TIME (end_time, end_time, wait_time);
+ EMACS_TIME wait_time = EMACS_TIME_FROM_DOUBLE (duration);
+ end_time = add_emacs_time (current_emacs_time (), wait_time);
}
/* Read until we get an acceptable event. */
@@ -765,9 +753,9 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
(void)
{
register Lisp_Object val;
- BLOCK_INPUT;
+ block_input ();
XSETINT (val, getc (instream));
- UNBLOCK_INPUT;
+ unblock_input ();
return val;
}
@@ -776,13 +764,30 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
/* Return true if the lisp code read using READCHARFUN defines a non-nil
`lexical-binding' file variable. After returning, the stream is
- positioned following the first line, if it is a comment, otherwise
- nothing is read. */
+ positioned following the first line, if it is a comment or #! line,
+ otherwise nothing is read. */
-static int
+static bool
lisp_file_lexically_bound_p (Lisp_Object readcharfun)
{
int ch = READCHAR;
+
+ if (ch == '#')
+ {
+ ch = READCHAR;
+ if (ch != '!')
+ {
+ UNREAD (ch);
+ UNREAD ('#');
+ return 0;
+ }
+ while (ch != '\n' && ch != EOF)
+ ch = READCHAR;
+ if (ch == '\n') ch = READCHAR;
+ /* It is OK to leave the position after a #! line, since
+ that is what read1 does. */
+ }
+
if (ch != ';')
/* The first line isn't a comment, just give up. */
{
@@ -792,11 +797,11 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
else
/* Look for an appropriate file-variable in the first line. */
{
- int rv = 0;
+ bool rv = 0;
enum {
NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX,
} beg_end_state = NOMINAL;
- int in_file_vars = 0;
+ bool in_file_vars = 0;
#define UPDATE_BEG_END_STATE(ch) \
if (beg_end_state == NOMINAL) \
@@ -839,7 +844,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
}
/* Stop scanning if no colon was found before end marker. */
- if (!in_file_vars)
+ if (!in_file_vars || ch == '\n' || ch == EOF)
break;
while (i > 0 && (var[i - 1] == ' ' || var[i - 1] == '\t'))
@@ -863,8 +868,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
ch = READCHAR;
}
if (! in_file_vars)
- /* The value was terminated by an end-marker, which
- remove. */
+ /* The value was terminated by an end-marker, which remove. */
i -= 3;
while (i > 0 && (val[i - 1] == ' ' || val[i - 1] == '\t'))
i--;
@@ -893,20 +897,17 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
because of an incompatible change in the byte compiler. */
static int
-safe_to_load_p (int fd)
+safe_to_load_version (int fd)
{
char buf[512];
int nbytes, i;
- int safe_p = 1;
int version = 1;
/* Read the first few bytes from the file, and look for a line
specifying the byte compiler version used. */
- nbytes = emacs_read (fd, buf, sizeof buf - 1);
+ nbytes = emacs_read (fd, buf, sizeof buf);
if (nbytes > 0)
{
- buf[nbytes] = '\0';
-
/* Skip to the next newline, skipping over the initial `ELC'
with NUL bytes following it, but note the version. */
for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
@@ -915,14 +916,12 @@ safe_to_load_p (int fd)
if (i >= nbytes
|| fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
- buf + i) < 0)
- safe_p = 0;
+ buf + i, nbytes - i) < 0)
+ version = 0;
}
- if (safe_p)
- safe_p = version;
lseek (fd, 0, SEEK_SET);
- return safe_p;
+ return version;
}
@@ -997,18 +996,17 @@ If optional fifth arg MUST-SUFFIX is non-nil, insist on
the suffix `.elc' or `.el'; don't accept just FILE unless
it ends in one of those suffixes or includes a directory name.
-If this function fails to find a file, it may look for different
-representations of that file before trying another file.
-It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
-to the file name. Emacs uses this feature mainly to find compressed
-versions of files when Auto Compression mode is enabled.
+If NOSUFFIX is nil, then if a file could not be found, try looking for
+a different representation of the file by adding non-empty suffixes to
+its name, before trying another file. Emacs uses this feature to find
+compressed versions of files when Auto Compression mode is enabled.
+If NOSUFFIX is non-nil, disable this feature.
-The exact suffixes that this function tries out, in the exact order,
-are given by the value of the variable `load-file-rep-suffixes' if
-NOSUFFIX is non-nil and by the return value of the function
-`get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
-MUST-SUFFIX are nil, this function first tries out the latter suffixes
-and then the former.
+The suffixes that this function tries out, when NOSUFFIX is nil, are
+given by the return value of `get-load-suffixes' and the values listed
+in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
+return value of `get-load-suffixes' is used, i.e. the file name is
+required to have a non-empty suffix.
Loading a file records its definitions, and its `provide' and
`require' calls, in an element of `load-history' whose
@@ -1023,15 +1021,15 @@ Return t if the file exists and loads successfully. */)
{
register FILE *stream;
register int fd = -1;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object found, efound, hist_file_name;
- /* 1 means we printed the ".el is newer" message. */
- int newer = 0;
- /* 1 means we are loading a compiled file. */
- int compiled = 0;
+ /* True means we printed the ".el is newer" message. */
+ bool newer = 0;
+ /* True means we are loading a compiled file. */
+ bool compiled = 0;
Lisp_Object handler;
- int safe_p = 1;
+ bool safe_p = 1;
const char *fmode = "r";
Lisp_Object tmp[2];
int version;
@@ -1068,7 +1066,7 @@ Return t if the file exists and loads successfully. */)
/* Avoid weird lossage with null string as arg,
- since it would try to load a directory as a Lisp file */
+ since it would try to load a directory as a Lisp file. */
if (SBYTES (file) > 0)
{
ptrdiff_t size = SBYTES (file);
@@ -1172,7 +1170,7 @@ Return t if the file exists and loads successfully. */)
Vload_source_file_function. */
specbind (Qlexical_binding, Qnil);
- /* Get the name for load-history. */
+ /* Get the name for load-history. */
hist_file_name = (! NILP (Vpurify_flag)
? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
tmp[1] = Ffile_name_nondirectory (found),
@@ -1186,7 +1184,7 @@ Return t if the file exists and loads successfully. */)
record_unwind_protect (load_warn_old_style_backquotes, file);
if (!memcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4)
- || (fd >= 0 && (version = safe_to_load_p (fd)) > 0))
+ || (fd >= 0 && (version = safe_to_load_version (fd)) > 0))
/* Load .elc files directly, but not when they are
remote and have no handler! */
{
@@ -1198,7 +1196,7 @@ Return t if the file exists and loads successfully. */)
GCPRO3 (file, found, hist_file_name);
if (version < 0
- && ! (version = safe_to_load_p (fd)))
+ && ! (version = safe_to_load_version (fd)))
{
safe_p = 0;
if (!load_dangerous_libraries)
@@ -1227,7 +1225,8 @@ Return t if the file exists and loads successfully. */)
SSET (efound, SBYTES (efound) - 1, 'c');
}
- if (result == 0 && s1.st_mtime < s2.st_mtime)
+ if (result == 0
+ && EMACS_TIME_LT (get_stat_mtime (&s1), get_stat_mtime (&s2)))
{
/* Make the progress messages mention that source is newer. */
newer = 1;
@@ -1325,7 +1324,7 @@ Return t if the file exists and loads successfully. */)
}
unbind_to (count, Qnil);
- /* Run any eval-after-load forms for this file */
+ /* Run any eval-after-load forms for this file. */
if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
call1 (Qdo_after_load_evaluation, hist_file_name) ;
@@ -1357,14 +1356,14 @@ Return t if the file exists and loads successfully. */)
}
static Lisp_Object
-load_unwind (Lisp_Object arg) /* used as unwind-protect function in load */
+load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */
{
FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
if (stream != NULL)
{
- BLOCK_INPUT;
+ block_input ();
fclose (stream);
- UNBLOCK_INPUT;
+ unblock_input ();
}
return Qnil;
}
@@ -1389,10 +1388,10 @@ close_load_descs (void)
#endif
}
-static int
+static bool
complete_filename_p (Lisp_Object pathname)
{
- register const unsigned char *s = SDATA (pathname);
+ const unsigned char *s = SDATA (pathname);
return (IS_DIRECTORY_SEP (s[0])
|| (SCHARS (pathname) > 2
&& IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])));
@@ -1404,7 +1403,7 @@ Returns the file's name in absolute form, or nil if not found.
If SUFFIXES is non-nil, it should be a list of suffixes to append to
file name when searching.
If non-nil, PREDICATE is used instead of `file-readable-p'.
-PREDICATE can also be an integer to pass to the access(2) function,
+PREDICATE can also be an integer to pass to the faccessat(2) function,
in which case file-name-handlers are ignored.
This function will normally skip directories, so if you want it to find
directories, make sure the PREDICATE function returns `dir-ok' for them. */)
@@ -1442,17 +1441,15 @@ static Lisp_Object Qdir_ok;
int
openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate)
{
- register int fd;
- EMACS_INT fn_size = 100;
+ ptrdiff_t fn_size = 100;
char buf[100];
- register char *fn = buf;
- int absolute = 0;
- EMACS_INT want_length;
+ char *fn = buf;
+ bool absolute = 0;
+ ptrdiff_t want_length;
Lisp_Object filename;
- struct stat st;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
Lisp_Object string, tail, encoded_fn;
- EMACS_INT max_suffix_len = 0;
+ ptrdiff_t max_suffix_len = 0;
CHECK_STRING (str);
@@ -1476,13 +1473,13 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
{
filename = Fexpand_file_name (str, XCAR (path));
if (!complete_filename_p (filename))
- /* If there are non-absolute elts in PATH (eg ".") */
+ /* If there are non-absolute elts in PATH (eg "."). */
/* Of course, this could conceivably lose if luser sets
- default-directory to be something non-absolute... */
+ default-directory to be something non-absolute... */
{
filename = Fexpand_file_name (filename, BVAR (current_buffer, directory));
if (!complete_filename_p (filename))
- /* Give up on this path element! */
+ /* Give up on this path element! */
continue;
}
@@ -1490,36 +1487,25 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
this path element/specified file name and any possible suffix. */
want_length = max_suffix_len + SBYTES (filename);
if (fn_size <= want_length)
- fn = (char *) alloca (fn_size = 100 + want_length);
+ fn = alloca (fn_size = 100 + want_length);
/* Loop over suffixes. */
for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
CONSP (tail); tail = XCDR (tail))
{
- ptrdiff_t lsuffix = SBYTES (XCAR (tail));
+ ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail));
Lisp_Object handler;
- int exists;
/* Concatenate path element/specified name with the suffix.
If the directory starts with /:, remove that. */
- if (SCHARS (filename) > 2
- && SREF (filename, 0) == '/'
- && SREF (filename, 1) == ':')
- {
- strncpy (fn, SSDATA (filename) + 2,
- SBYTES (filename) - 2);
- fn[SBYTES (filename) - 2] = 0;
- }
- else
- {
- strncpy (fn, SSDATA (filename),
- SBYTES (filename));
- fn[SBYTES (filename)] = 0;
- }
-
- if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
- strncat (fn, SSDATA (XCAR (tail)), lsuffix);
-
+ int prefixlen = ((SCHARS (filename) > 2
+ && SREF (filename, 0) == '/'
+ && SREF (filename, 1) == ':')
+ ? 2 : 0);
+ fnlen = SBYTES (filename) - prefixlen;
+ memcpy (fn, SDATA (filename) + prefixlen, fnlen);
+ memcpy (fn + fnlen, SDATA (XCAR (tail)), lsuffix + 1);
+ fnlen += lsuffix;
/* Check that the file exists and is not a directory. */
/* We used to only check for handlers on non-absolute file names:
if (absolute)
@@ -1528,10 +1514,11 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
handler = Ffind_file_name_handler (filename, Qfile_exists_p);
It's not clear why that was the case and it breaks things like
(load "/bar.el") where the file is actually "/bar.el.gz". */
- string = build_string (fn);
+ string = make_string (fn, fnlen);
handler = Ffind_file_name_handler (string, Qfile_exists_p);
if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
{
+ bool exists;
if (NILP (predicate))
exists = !NILP (Ffile_readable_p (string));
else
@@ -1553,28 +1540,40 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
}
else
{
+ int fd;
const char *pfn;
encoded_fn = ENCODE_FILE (string);
pfn = SSDATA (encoded_fn);
- exists = (stat (pfn, &st) == 0 && ! S_ISDIR (st.st_mode));
- if (exists)
- {
- /* Check that we can access or open it. */
- if (NATNUMP (predicate))
- fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
- else
- fd = emacs_open (pfn, O_RDONLY, 0);
- if (fd >= 0)
+ /* Check that we can access or open it. */
+ if (NATNUMP (predicate))
+ fd = (((XFASTINT (predicate) & ~INT_MAX) == 0
+ && (faccessat (AT_FDCWD, pfn, XFASTINT (predicate),
+ AT_EACCESS)
+ == 0)
+ && ! file_directory_p (pfn))
+ ? 1 : -1);
+ else
+ {
+ struct stat st;
+ fd = emacs_open (pfn, O_RDONLY, 0);
+ if (0 <= fd
+ && (fstat (fd, &st) != 0 || S_ISDIR (st.st_mode)))
{
- /* We succeeded; return this descriptor and filename. */
- if (storeptr)
- *storeptr = string;
- UNGCPRO;
- return fd;
+ emacs_close (fd);
+ fd = -1;
}
}
+
+ if (fd >= 0)
+ {
+ /* We succeeded; return this descriptor and filename. */
+ if (storeptr)
+ *storeptr = string;
+ UNGCPRO;
+ return fd;
+ }
}
}
if (absolute)
@@ -1591,14 +1590,16 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
the source has an associated file name or not.
FILENAME is the file name that we are loading from.
- ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
+
+ ENTIRE is true if loading that entire file, false if evaluating
+ part of it. */
static void
-build_load_history (Lisp_Object filename, int entire)
+build_load_history (Lisp_Object filename, bool entire)
{
- register Lisp_Object tail, prev, newelt;
- register Lisp_Object tem, tem2;
- register int foundit = 0;
+ Lisp_Object tail, prev, newelt;
+ Lisp_Object tem, tem2;
+ bool foundit = 0;
tail = Vload_history;
prev = Qnil;
@@ -1607,12 +1608,12 @@ build_load_history (Lisp_Object filename, int entire)
{
tem = XCAR (tail);
- /* Find the feature's previous assoc list... */
+ /* Find the feature's previous assoc list... */
if (!NILP (Fequal (filename, Fcar (tem))))
{
foundit = 1;
- /* If we're loading the entire file, remove old data. */
+ /* If we're loading the entire file, remove old data. */
if (entire)
{
if (NILP (prev))
@@ -1654,13 +1655,6 @@ build_load_history (Lisp_Object filename, int entire)
}
static Lisp_Object
-unreadpure (Lisp_Object junk) /* Used as unwind-protect function in readevalloop */
-{
- read_pure = 0;
- return Qnil;
-}
-
-static Lisp_Object
readevalloop_1 (Lisp_Object old)
{
load_convert_to_unibyte = ! NILP (old);
@@ -1670,7 +1664,7 @@ readevalloop_1 (Lisp_Object old)
/* Signal an `end-of-file' error, if possible with file name
information. */
-static void
+static _Noreturn void
end_of_file_error (void)
{
if (STRINGP (Vload_file_name))
@@ -1690,21 +1684,32 @@ static void
readevalloop (Lisp_Object readcharfun,
FILE *stream,
Lisp_Object sourcename,
- int printflag,
+ bool printflag,
Lisp_Object unibyte, Lisp_Object readfun,
Lisp_Object start, Lisp_Object end)
{
register int c;
register Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
struct buffer *b = 0;
- int continue_reading_p;
+ bool continue_reading_p;
Lisp_Object lex_bound;
- /* Nonzero if reading an entire buffer. */
- int whole_buffer = 0;
- /* 1 on the first time around. */
- int first_sexp = 1;
+ /* True if reading an entire buffer. */
+ bool whole_buffer = 0;
+ /* True on the first time around. */
+ bool first_sexp = 1;
+ Lisp_Object macroexpand = intern ("internal-macroexpand-for-load");
+
+ if (NILP (Ffboundp (macroexpand))
+ /* Don't macroexpand in .elc files, since it should have been done
+ already. We actually don't know whether we're in a .elc file or not,
+ so we use circumstantial evidence: .el files normally go through
+ Vload_source_file_function -> load-with-code-conversion
+ -> eval-buffer. */
+ || EQ (readcharfun, Qget_file_char)
+ || EQ (readcharfun, Qget_emacs_mule_file_char))
+ macroexpand = Qnil;
if (MARKERP (readcharfun))
{
@@ -1719,7 +1724,7 @@ readevalloop (Lisp_Object readcharfun,
/* We assume START is nil when input is not from a buffer. */
if (! NILP (start) && !b)
- abort ();
+ emacs_abort ();
specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
specbind (Qcurrent_load_list, Qnil);
@@ -1736,7 +1741,7 @@ readevalloop (Lisp_Object readcharfun,
GCPRO4 (sourcename, readfun, start, end);
- /* Try to ensure sourcename is a truename, except whilst preloading. */
+ /* Try to ensure sourcename is a truename, except whilst preloading. */
if (NILP (Vpurify_flag)
&& !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
&& !NILP (Ffboundp (Qfile_truename)))
@@ -1747,9 +1752,9 @@ readevalloop (Lisp_Object readcharfun,
continue_reading_p = 1;
while (continue_reading_p)
{
- int count1 = SPECPDL_INDEX ();
+ ptrdiff_t count1 = SPECPDL_INDEX ();
- if (b != 0 && NILP (BVAR (b, name)))
+ if (b != 0 && !BUFFER_LIVE_P (b))
error ("Reading from killed buffer");
if (!NILP (start))
@@ -1801,8 +1806,7 @@ readevalloop (Lisp_Object readcharfun,
if (!NILP (Vpurify_flag) && c == '(')
{
- record_unwind_protect (unreadpure, Qnil);
- val = read_list (-1, readcharfun);
+ val = read_list (0, readcharfun);
}
else
{
@@ -1835,6 +1839,8 @@ readevalloop (Lisp_Object readcharfun,
unbind_to (count1, Qnil);
/* Now eval what we just read. */
+ if (!NILP (macroexpand))
+ val = call1 (macroexpand, val);
val = eval_sub (val);
if (printflag)
@@ -1873,7 +1879,7 @@ DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
This function preserves the position of point. */)
(Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object tem, buf;
if (NILP (buffer))
@@ -1918,7 +1924,7 @@ This function does not move point. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function)
{
/* FIXME: Do the eval-sexp-add-defvars dance! */
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object tem, cbuf;
cbuf = Fcurrent_buffer ();
@@ -1930,7 +1936,7 @@ This function does not move point. */)
specbind (Qstandard_output, tem);
specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
- /* readevalloop calls functions which check the type of start and end. */
+ /* `readevalloop' calls functions which check the type of start and end. */
readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename),
!NILP (printflag), Qnil, read_function,
start, end);
@@ -1973,16 +1979,16 @@ START and END optionally delimit a substring of STRING from which to read;
{
Lisp_Object ret;
CHECK_STRING (string);
- /* read_internal_start sets read_from_string_index. */
+ /* `read_internal_start' sets `read_from_string_index'. */
ret = read_internal_start (string, start, end);
return Fcons (ret, make_number (read_from_string_index));
}
/* Function to set up the global context we need in toplevel read
- calls. */
+ calls. */
static Lisp_Object
read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
-/* start, end only used when stream is a string. */
+/* `start', `end' only used when stream is a string. */
{
Lisp_Object retval;
@@ -1996,7 +2002,7 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
if (STRINGP (stream)
|| ((CONSP (stream) && STRINGP (XCAR (stream)))))
{
- EMACS_INT startval, endval;
+ ptrdiff_t startval, endval;
Lisp_Object string;
if (STRINGP (stream))
@@ -2009,9 +2015,9 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
else
{
CHECK_NUMBER (end);
- endval = XINT (end);
- if (endval < 0 || endval > SCHARS (string))
+ if (! (0 <= XINT (end) && XINT (end) <= SCHARS (string)))
args_out_of_range (string, end);
+ endval = XINT (end);
}
if (NILP (start))
@@ -2019,9 +2025,9 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
else
{
CHECK_NUMBER (start);
- startval = XINT (start);
- if (startval < 0 || startval > endval)
+ if (! (0 <= XINT (start) && XINT (start) <= endval))
args_out_of_range (string, start);
+ startval = XINT (start);
}
read_from_string_index = startval;
read_from_string_index_byte = string_char_to_byte (string, startval);
@@ -2039,7 +2045,7 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
/* Signal Qinvalid_read_syntax error.
S is error string of length N (if > 0) */
-static void
+static _Noreturn void
invalid_syntax (const char *s)
{
xsignal1 (Qinvalid_read_syntax, build_string (s));
@@ -2047,7 +2053,7 @@ invalid_syntax (const char *s)
/* Use this for recursive reads, in contexts where internal tokens
- are not allowed. */
+ are not allowed. */
static Lisp_Object
read0 (Lisp_Object readcharfun)
@@ -2070,11 +2076,11 @@ static char *read_buffer;
If the escape sequence forces unibyte, return eight-bit char. */
static int
-read_escape (Lisp_Object readcharfun, int stringp)
+read_escape (Lisp_Object readcharfun, bool stringp)
{
- register int c = READCHAR;
+ int c = READCHAR;
/* \u allows up to four hex digits, \U up to eight. Default to the
- behavior for \u, and change this value in the case that \U is seen. */
+ behavior for \u, and change this value in the case that \U is seen. */
int unicode_hex_count = 4;
switch (c)
@@ -2260,8 +2266,8 @@ read_escape (Lisp_Object readcharfun, int stringp)
while (++count <= unicode_hex_count)
{
c = READCHAR;
- /* isdigit and isalpha may be locale-specific, which we don't
- want. */
+ /* `isdigit' and `isalpha' may be locale-specific, which we don't
+ want. */
if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
@@ -2281,7 +2287,7 @@ read_escape (Lisp_Object readcharfun, int stringp)
/* Return the digit that CHARACTER stands for in the given BASE.
Return -1 if CHARACTER is out of range for BASE,
and -2 if CHARACTER is not valid for any supported BASE. */
-static inline int
+static int
digit_to_number (int character, int base)
{
int digit;
@@ -2373,14 +2379,14 @@ read_integer (Lisp_Object readcharfun, EMACS_INT radix)
in *PCH and the return value is not interesting. Else, we store
zero in *PCH and we read and return one lisp object.
- FIRST_IN_LIST is nonzero if this is the first element of a list. */
+ FIRST_IN_LIST is true if this is the first element of a list. */
static Lisp_Object
-read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
+read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
{
- register int c;
- unsigned uninterned_symbol = 0;
- int multibyte;
+ int c;
+ bool uninterned_symbol = 0;
+ bool multibyte;
*pch = 0;
load_each_byte = 0;
@@ -2415,13 +2421,13 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
{
/* Accept extended format for hashtables (extensible to
other types), e.g.
- #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
+ #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
Lisp_Object tmp = read_list (0, readcharfun);
Lisp_Object head = CAR_SAFE (tmp);
Lisp_Object data = Qnil;
Lisp_Object val = Qnil;
/* The size is 2 * number of allowed keywords to
- make-hash-table. */
+ make-hash-table. */
Lisp_Object params[10];
Lisp_Object ht;
Lisp_Object key = Qnil;
@@ -2433,36 +2439,36 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
tmp = CDR_SAFE (tmp);
- /* This is repetitive but fast and simple. */
+ /* This is repetitive but fast and simple. */
params[param_count] = QCsize;
- params[param_count+1] = Fplist_get (tmp, Qsize);
+ params[param_count + 1] = Fplist_get (tmp, Qsize);
if (!NILP (params[param_count + 1]))
param_count += 2;
params[param_count] = QCtest;
- params[param_count+1] = Fplist_get (tmp, Qtest);
+ params[param_count + 1] = Fplist_get (tmp, Qtest);
if (!NILP (params[param_count + 1]))
param_count += 2;
params[param_count] = QCweakness;
- params[param_count+1] = Fplist_get (tmp, Qweakness);
+ params[param_count + 1] = Fplist_get (tmp, Qweakness);
if (!NILP (params[param_count + 1]))
param_count += 2;
params[param_count] = QCrehash_size;
- params[param_count+1] = Fplist_get (tmp, Qrehash_size);
+ params[param_count + 1] = Fplist_get (tmp, Qrehash_size);
if (!NILP (params[param_count + 1]))
param_count += 2;
params[param_count] = QCrehash_threshold;
- params[param_count+1] = Fplist_get (tmp, Qrehash_threshold);
+ params[param_count + 1] = Fplist_get (tmp, Qrehash_threshold);
if (!NILP (params[param_count + 1]))
param_count += 2;
- /* This is the hashtable data. */
+ /* This is the hashtable data. */
data = Fplist_get (tmp, Qdata);
- /* Now use params to make a new hashtable and fill it. */
+ /* Now use params to make a new hashtable and fill it. */
ht = Fmake_hash_table (param_count, params);
while (CONSP (data))
@@ -2499,16 +2505,17 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
if (c == '[')
{
Lisp_Object tmp;
- EMACS_INT depth, size;
+ int depth;
+ ptrdiff_t size;
tmp = read_vector (readcharfun, 0);
- if (!INTEGERP (AREF (tmp, 0)))
+ size = ASIZE (tmp);
+ if (size == 0)
+ error ("Invalid size char-table");
+ if (! RANGED_INTEGERP (1, AREF (tmp, 0), 3))
error ("Invalid depth in char-table");
depth = XINT (AREF (tmp, 0));
- if (depth < 1 || depth > 3)
- error ("Invalid depth in char-table");
- size = ASIZE (tmp) - 2;
- if (chartab_size [depth] != size)
+ if (chartab_size[depth] != size - 2)
error ("Invalid size char-table");
XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
return tmp;
@@ -2557,8 +2564,8 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
build them using function calls. */
Lisp_Object tmp;
tmp = read_vector (readcharfun, 1);
- return Fmake_byte_code (ASIZE (tmp),
- XVECTOR (tmp)->contents);
+ make_byte_code (XVECTOR (tmp));
+ return tmp;
}
if (c == '(')
{
@@ -2641,13 +2648,12 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
if (saved_doc_string_size == 0)
{
- saved_doc_string = (char *) xmalloc (nskip + extra);
+ saved_doc_string = xmalloc (nskip + extra);
saved_doc_string_size = nskip + extra;
}
if (nskip > saved_doc_string_size)
{
- saved_doc_string = (char *) xrealloc (saved_doc_string,
- nskip + extra);
+ saved_doc_string = xrealloc (saved_doc_string, nskip + extra);
saved_doc_string_size = nskip + extra;
}
@@ -2694,13 +2700,13 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
/* No symbol character follows, this is the empty
symbol. */
UNREAD (c);
- return Fmake_symbol (build_string (""));
+ return Fmake_symbol (empty_unibyte_string);
}
goto read_symbol;
}
/* ## is the empty symbol. */
if (c == '#')
- return Fintern (build_string (""), Qnil);
+ return Fintern (empty_unibyte_string, Qnil);
/* Reader forms that can reuse previously read objects. */
if (c >= '0' && c <= '9')
{
@@ -2729,7 +2735,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
n for #n#. */
if (c == '=')
{
- /* Make a placeholder for #n# to use temporarily */
+ /* Make a placeholder for #n# to use temporarily. */
Lisp_Object placeholder;
Lisp_Object cell;
@@ -2737,10 +2743,10 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
cell = Fcons (make_number (n), placeholder);
read_objects = Fcons (cell, read_objects);
- /* Read the object itself. */
+ /* Read the object itself. */
tem = read0 (readcharfun);
- /* Now put it everywhere the placeholder was... */
+ /* Now put it everywhere the placeholder was... */
substitute_object_in_subtree (tem, placeholder);
/* ...and #n# will use the real value from now on. */
@@ -2801,10 +2807,11 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
else
{
Lisp_Object value;
+ bool saved_new_backquote_flag = new_backquote_flag;
- new_backquote_flag++;
+ new_backquote_flag = 1;
value = read0 (readcharfun);
- new_backquote_flag--;
+ new_backquote_flag = saved_new_backquote_flag;
return Fcons (Qbackquote, Fcons (value, Qnil));
}
@@ -2856,7 +2863,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
{
int modifiers;
int next_char;
- int ok;
+ bool ok;
c = READCHAR;
if (c < 0)
@@ -2892,14 +2899,14 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
{
char *p = read_buffer;
char *end = read_buffer + read_buffer_size;
- register int ch;
- /* Nonzero if we saw an escape sequence specifying
+ int ch;
+ /* True if we saw an escape sequence specifying
a multibyte character. */
- int force_multibyte = 0;
- /* Nonzero if we saw an escape sequence specifying
+ bool force_multibyte = 0;
+ /* True if we saw an escape sequence specifying
a single-byte character. */
- int force_singlebyte = 0;
- int cancel = 0;
+ bool force_singlebyte = 0;
+ bool cancel = 0;
ptrdiff_t nchars = 0;
while ((ch = READCHAR) >= 0
@@ -2910,8 +2917,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
ptrdiff_t offset = p - read_buffer;
if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
memory_full (SIZE_MAX);
- read_buffer = (char *) xrealloc (read_buffer,
- read_buffer_size * 2);
+ read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
read_buffer_size *= 2;
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
@@ -2923,7 +2929,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
ch = read_escape (readcharfun, 1);
- /* CH is -1 if \ newline has just been seen */
+ /* CH is -1 if \ newline has just been seen. */
if (ch == -1)
{
if (p == read_buffer)
@@ -2938,7 +2944,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
force_singlebyte = 1;
else if (! ASCII_CHAR_P (ch))
force_multibyte = 1;
- else /* i.e. ASCII_CHAR_P (ch) */
+ else /* I.e. ASCII_CHAR_P (ch). */
{
/* Allow `\C- ' and `\C-?'. */
if (modifiers == CHAR_CTL)
@@ -2988,28 +2994,19 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
/* If purifying, and string starts with \ newline,
return zero instead. This is for doc strings
- that we are really going to find in etc/DOC.nn.nn */
+ that we are really going to find in etc/DOC.nn.nn. */
if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
return make_number (0);
- if (force_multibyte)
- /* READ_BUFFER already contains valid multibyte forms. */
- ;
- else if (force_singlebyte)
+ if (! force_multibyte && force_singlebyte)
{
+ /* READ_BUFFER contains raw 8-bit bytes and no multibyte
+ forms. Convert it to unibyte. */
nchars = str_as_unibyte ((unsigned char *) read_buffer,
p - read_buffer);
p = read_buffer + nchars;
}
- else
- {
- /* Otherwise, READ_BUFFER contains only ASCII. */
- }
- if (read_pure)
- return make_pure_string (read_buffer, nchars, p - read_buffer,
- (force_multibyte
- || (p - read_buffer != nchars)));
return make_specified_string (read_buffer, nchars, p - read_buffer,
(force_multibyte
|| (p - read_buffer != nchars)));
@@ -3041,7 +3038,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
read_symbol:
{
char *p = read_buffer;
- int quoted = 0;
+ bool quoted = 0;
EMACS_INT start_position = readchar_count - 1;
{
@@ -3054,8 +3051,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
ptrdiff_t offset = p - read_buffer;
if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
memory_full (SIZE_MAX);
- read_buffer = (char *) xrealloc (read_buffer,
- read_buffer_size * 2);
+ read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
read_buffer_size *= 2;
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
@@ -3085,8 +3081,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
ptrdiff_t offset = p - read_buffer;
if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
memory_full (SIZE_MAX);
- read_buffer = (char *) xrealloc (read_buffer,
- read_buffer_size * 2);
+ read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
read_buffer_size *= 2;
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
@@ -3103,25 +3098,24 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
}
{
Lisp_Object name, result;
- EMACS_INT nbytes = p - read_buffer;
- EMACS_INT nchars
+ ptrdiff_t nbytes = p - read_buffer;
+ ptrdiff_t nchars
= (multibyte
? multibyte_chars_in_text ((unsigned char *) read_buffer,
nbytes)
: nbytes);
- if (uninterned_symbol && ! NILP (Vpurify_flag))
- name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
- else
- name = make_specified_string (read_buffer, nchars, nbytes,multibyte);
+ name = ((uninterned_symbol && ! NILP (Vpurify_flag)
+ ? make_pure_string : make_specified_string)
+ (read_buffer, nchars, nbytes, multibyte));
result = (uninterned_symbol ? Fmake_symbol (name)
: Fintern (name, Qnil));
if (EQ (Vread_with_symbol_positions, Qt)
|| EQ (Vread_with_symbol_positions, readcharfun))
- Vread_symbol_positions_list =
- Fcons (Fcons (result, make_number (start_position)),
- Vread_symbol_positions_list);
+ Vread_symbol_positions_list
+ = Fcons (Fcons (result, make_number (start_position)),
+ Vread_symbol_positions_list);
return result;
}
}
@@ -3129,7 +3123,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
}
-/* List of nodes we've seen during substitute_object_in_subtree. */
+/* List of nodes we've seen during substitute_object_in_subtree. */
static Lisp_Object seen_list;
static void
@@ -3137,23 +3131,23 @@ substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder)
{
Lisp_Object check_object;
- /* We haven't seen any objects when we start. */
+ /* We haven't seen any objects when we start. */
seen_list = Qnil;
- /* Make all the substitutions. */
+ /* Make all the substitutions. */
check_object
= substitute_object_recurse (object, placeholder, object);
- /* Clear seen_list because we're done with it. */
+ /* Clear seen_list because we're done with it. */
seen_list = Qnil;
/* The returned object here is expected to always eq the
- original. */
+ original. */
if (!EQ (check_object, object))
error ("Unexpected mutation error in reader");
}
-/* Feval doesn't get called from here, so no gc protection is needed. */
+/* Feval doesn't get called from here, so no gc protection is needed. */
#define SUBSTITUTE(get_val, set_val) \
do { \
Lisp_Object old_value = get_val; \
@@ -3170,11 +3164,11 @@ substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder)
static Lisp_Object
substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree)
{
- /* If we find the placeholder, return the target object. */
+ /* If we find the placeholder, return the target object. */
if (EQ (placeholder, subtree))
return object;
- /* If we've been to this node before, don't explore it again. */
+ /* If we've been to this node before, don't explore it again. */
if (!EQ (Qnil, Fmemq (subtree, seen_list)))
return subtree;
@@ -3224,10 +3218,10 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
case Lisp_String:
{
/* Check for text properties in each interval.
- substitute_in_interval contains part of the logic. */
+ substitute_in_interval contains part of the logic. */
- INTERVAL root_interval = STRING_INTERVALS (subtree);
- Lisp_Object arg = Fcons (object, placeholder);
+ INTERVAL root_interval = string_intervals (subtree);
+ Lisp_Object arg = Fcons (object, placeholder);
traverse_intervals_noorder (root_interval,
&substitute_in_interval, arg);
@@ -3235,7 +3229,7 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
return subtree;
}
- /* Other types don't recurse any further. */
+ /* Other types don't recurse any further. */
default:
return subtree;
}
@@ -3248,7 +3242,7 @@ substitute_in_interval (INTERVAL interval, Lisp_Object arg)
Lisp_Object object = Fcar (arg);
Lisp_Object placeholder = Fcdr (arg);
- SUBSTITUTE (interval->plist, interval->plist = true_value);
+ SUBSTITUTE (interval->plist, set_interval_plist (interval, true_value));
}
@@ -3261,17 +3255,17 @@ substitute_in_interval (INTERVAL interval, Lisp_Object arg)
/* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
integer syntax and fits in a fixnum, else return the nearest float if CP has
either floating point or integer syntax and BASE is 10, else return nil. If
- IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
+ IGNORE_TRAILING, consider just the longest prefix of CP that has
valid floating point syntax. Signal an overflow if BASE is not 10 and the
number has integer syntax but does not fit. */
Lisp_Object
-string_to_number (char const *string, int base, int ignore_trailing)
+string_to_number (char const *string, int base, bool ignore_trailing)
{
int state;
char const *cp = string;
int leading_digit;
- int float_syntax = 0;
+ bool float_syntax = 0;
double value = 0;
/* Compute NaN and infinities using a variable, to cope with compilers that
@@ -3281,9 +3275,9 @@ string_to_number (char const *string, int base, int ignore_trailing)
/* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
IEEE floating point hosts, and works around a formerly-common bug where
atof ("-0.0") drops the sign. */
- int negative = *cp == '-';
+ bool negative = *cp == '-';
- int signedp = negative || *cp == '+';
+ bool signedp = negative || *cp == '+';
cp += signedp;
state = 0;
@@ -3376,7 +3370,7 @@ string_to_number (char const *string, int base, int ignore_trailing)
uintmax_t n;
/* Fast special case for single-digit integers. This also avoids a
- glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
+ glitch when BASE is 16 and IGNORE_TRAILING, because in that
case some versions of strtoumax accept numbers like "0x1" that Emacs
does not allow. */
if (digit_to_number (string[signedp + 1], base) < 0)
@@ -3412,17 +3406,17 @@ string_to_number (char const *string, int base, int ignore_trailing)
static Lisp_Object
-read_vector (Lisp_Object readcharfun, int bytecodeflag)
+read_vector (Lisp_Object readcharfun, bool bytecodeflag)
{
ptrdiff_t i, size;
- register Lisp_Object *ptr;
- register Lisp_Object tem, item, vector;
- register struct Lisp_Cons *otem;
+ Lisp_Object *ptr;
+ Lisp_Object tem, item, vector;
+ struct Lisp_Cons *otem;
Lisp_Object len;
tem = read_list (1, readcharfun);
len = Flength (tem);
- vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
+ vector = Fmake_vector (len, Qnil);
size = ASIZE (vector);
ptr = XVECTOR (vector)->contents;
@@ -3443,7 +3437,7 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
/* Delay handling the bytecode slot until we know whether
it is lazily-loaded (we can tell by whether the
constants slot is nil). */
- ptr[COMPILED_CONSTANTS] = item;
+ ASET (vector, COMPILED_CONSTANTS, item);
item = Qnil;
}
else if (i == COMPILED_CONSTANTS)
@@ -3469,7 +3463,7 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
}
/* Now handle the bytecode slot. */
- ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
+ ASET (vector, COMPILED_BYTECODE, bytestr);
}
else if (i == COMPILED_DOC_STRING
&& STRINGP (item)
@@ -3481,7 +3475,7 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
item = Fstring_as_multibyte (item);
}
}
- ptr[i] = read_pure ? Fpurecopy (item) : item;
+ ASET (vector, i, item);
otem = XCONS (tem);
tem = Fcdr (tem);
free_cons (otem);
@@ -3489,19 +3483,13 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
return vector;
}
-/* FLAG = 1 means check for ] to terminate rather than ) and .
- FLAG = -1 means check for starting with defun
- and make structure pure. */
+/* FLAG means check for ] to terminate rather than ) and . */
static Lisp_Object
-read_list (int flag, register Lisp_Object readcharfun)
+read_list (bool flag, Lisp_Object readcharfun)
{
- /* -1 means check next element for defun,
- 0 means don't check,
- 1 means already checked and found defun. */
- int defunflag = flag < 0 ? -1 : 0;
Lisp_Object val, tail;
- register Lisp_Object elt, tem;
+ Lisp_Object elt, tem;
struct gcpro gcpro1, gcpro2;
/* 0 is the normal case.
1 means this list is a doc reference; replace it with the number 0.
@@ -3509,7 +3497,7 @@ read_list (int flag, register Lisp_Object readcharfun)
int doc_reference = 0;
/* Initialize this to 1 if we are reading a list. */
- int first_in_list = flag <= 0;
+ bool first_in_list = flag <= 0;
val = Qnil;
tail = Qnil;
@@ -3541,7 +3529,7 @@ read_list (int flag, register Lisp_Object readcharfun)
We don't use Fexpand_file_name because that would make
the directory absolute now. */
elt = concat2 (build_string ("../lisp/"),
- Ffile_name_nondirectory (elt));
+ Ffile_name_nondirectory (elt));
}
else if (EQ (elt, Vload_file_name)
&& ! NILP (elt)
@@ -3661,24 +3649,18 @@ read_list (int flag, register Lisp_Object readcharfun)
}
invalid_syntax ("] in a list");
}
- tem = (read_pure && flag <= 0
- ? pure_cons (elt, Qnil)
- : Fcons (elt, Qnil));
+ tem = Fcons (elt, Qnil);
if (!NILP (tail))
XSETCDR (tail, tem);
else
val = tem;
tail = tem;
- if (defunflag < 0)
- defunflag = EQ (elt, Qdefun);
- else if (defunflag > 0)
- read_pure = 1;
}
}
static Lisp_Object initial_obarray;
-/* oblookup stores the bucket number here, for the sake of Funintern. */
+/* `oblookup' stores the bucket number here, for the sake of Funintern. */
static size_t oblookup_last_bucket_number;
@@ -3701,32 +3683,20 @@ check_obarray (Lisp_Object obarray)
interned in the current obarray. */
Lisp_Object
-intern (const char *str)
+intern_1 (const char *str, ptrdiff_t len)
{
- Lisp_Object tem;
- ptrdiff_t len = strlen (str);
- Lisp_Object obarray;
+ Lisp_Object obarray = check_obarray (Vobarray);
+ Lisp_Object tem = oblookup (obarray, str, len, len);
- obarray = Vobarray;
- if (!VECTORP (obarray) || ASIZE (obarray) == 0)
- obarray = check_obarray (obarray);
- tem = oblookup (obarray, str, len, len);
- if (SYMBOLP (tem))
- return tem;
- return Fintern (make_string (str, len), obarray);
+ return SYMBOLP (tem) ? tem : Fintern (make_string (str, len), obarray);
}
Lisp_Object
-intern_c_string (const char *str)
+intern_c_string_1 (const char *str, ptrdiff_t len)
{
- Lisp_Object tem;
- ptrdiff_t len = strlen (str);
- Lisp_Object obarray;
+ Lisp_Object obarray = check_obarray (Vobarray);
+ Lisp_Object tem = oblookup (obarray, str, len, len);
- obarray = Vobarray;
- if (!VECTORP (obarray) || ASIZE (obarray) == 0)
- obarray = check_obarray (obarray);
- tem = oblookup (obarray, str, len, len);
if (SYMBOLP (tem))
return tem;
@@ -3734,9 +3704,9 @@ intern_c_string (const char *str)
/* Creating a non-pure string from a string literal not
implemented yet. We could just use make_string here and live
with the extra copy. */
- abort ();
+ emacs_abort ();
- return Fintern (make_pure_c_string (str), obarray);
+ return Fintern (make_pure_c_string (str, len), obarray);
}
DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
@@ -3776,11 +3746,11 @@ it defaults to the value of `obarray'. */)
SET_SYMBOL_VAL (XSYMBOL (sym), sym);
}
- ptr = &XVECTOR (obarray)->contents[XINT (tem)];
+ ptr = aref_addr (obarray, XINT(tem));
if (SYMBOLP (*ptr))
- XSYMBOL (sym)->next = XSYMBOL (*ptr);
+ set_symbol_next (sym, XSYMBOL (*ptr));
else
- XSYMBOL (sym)->next = 0;
+ set_symbol_next (sym, NULL);
*ptr = sym;
return sym;
}
@@ -3855,25 +3825,29 @@ OBARRAY defaults to the value of the variable `obarray'. */)
hash = oblookup_last_bucket_number;
- if (EQ (XVECTOR (obarray)->contents[hash], tem))
+ if (EQ (AREF (obarray, hash), tem))
{
if (XSYMBOL (tem)->next)
- XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next);
+ {
+ Lisp_Object sym;
+ XSETSYMBOL (sym, XSYMBOL (tem)->next);
+ ASET (obarray, hash, sym);
+ }
else
- XSETINT (XVECTOR (obarray)->contents[hash], 0);
+ ASET (obarray, hash, make_number (0));
}
else
{
Lisp_Object tail, following;
- for (tail = XVECTOR (obarray)->contents[hash];
+ for (tail = AREF (obarray, hash);
XSYMBOL (tail)->next;
tail = following)
{
XSETSYMBOL (following, XSYMBOL (tail)->next);
if (EQ (following, tem))
{
- XSYMBOL (tail)->next = XSYMBOL (following)->next;
+ set_symbol_next (tail, XSYMBOL (following)->next);
break;
}
}
@@ -3889,28 +3863,25 @@ OBARRAY defaults to the value of the variable `obarray'. */)
Also store the bucket number in oblookup_last_bucket_number. */
Lisp_Object
-oblookup (Lisp_Object obarray, register const char *ptr, EMACS_INT size, EMACS_INT size_byte)
+oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte)
{
size_t hash;
size_t obsize;
register Lisp_Object tail;
Lisp_Object bucket, tem;
- if (!VECTORP (obarray)
- || (obsize = ASIZE (obarray)) == 0)
- {
- obarray = check_obarray (obarray);
- obsize = ASIZE (obarray);
- }
+ obarray = check_obarray (obarray);
+ obsize = ASIZE (obarray);
+
/* This is sometimes needed in the middle of GC. */
obsize &= ~ARRAY_MARK_FLAG;
hash = hash_string (ptr, size_byte) % obsize;
- bucket = XVECTOR (obarray)->contents[hash];
+ bucket = AREF (obarray, hash);
oblookup_last_bucket_number = hash;
if (EQ (bucket, make_number (0)))
;
else if (!SYMBOLP (bucket))
- error ("Bad data in guts of obarray"); /* Like CADR error message */
+ error ("Bad data in guts of obarray"); /* Like CADR error message. */
else
for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
{
@@ -3933,7 +3904,7 @@ map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Ob
CHECK_VECTOR (obarray);
for (i = ASIZE (obarray) - 1; i >= 0; i--)
{
- tail = XVECTOR (obarray)->contents[i];
+ tail = AREF (obarray, i);
if (SYMBOLP (tail))
while (1)
{
@@ -3977,7 +3948,7 @@ init_obarray (void)
initial_obarray = Vobarray;
staticpro (&initial_obarray);
- Qunbound = Fmake_symbol (make_pure_c_string ("unbound"));
+ Qunbound = Fmake_symbol (build_pure_c_string ("unbound"));
/* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
NILP (Vpurify_flag) check in intern_c_string. */
Qnil = make_number (-1); Vpurify_flag = make_number (1);
@@ -3986,15 +3957,17 @@ init_obarray (void)
/* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
so those two need to be fixed manually. */
SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
- XSYMBOL (Qunbound)->function = Qunbound;
- XSYMBOL (Qunbound)->plist = Qnil;
- /* XSYMBOL (Qnil)->function = Qunbound; */
+ set_symbol_function (Qunbound, Qnil);
+ set_symbol_plist (Qunbound, Qnil);
SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
XSYMBOL (Qnil)->constant = 1;
- XSYMBOL (Qnil)->plist = Qnil;
+ XSYMBOL (Qnil)->declared_special = 1;
+ set_symbol_plist (Qnil, Qnil);
+ set_symbol_function (Qnil, Qnil);
Qt = intern_c_string ("t");
SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
+ XSYMBOL (Qnil)->declared_special = 1;
XSYMBOL (Qt)->constant = 1;
/* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
@@ -4002,20 +3975,21 @@ init_obarray (void)
DEFSYM (Qvariable_documentation, "variable-documentation");
- read_buffer = (char *) xmalloc (size);
+ read_buffer = xmalloc (size);
read_buffer_size = size;
}
void
defsubr (struct Lisp_Subr *sname)
{
- Lisp_Object sym;
+ Lisp_Object sym, tem;
sym = intern_c_string (sname->symbol_name);
- XSETTYPED_PVECTYPE (sname, size, PVEC_SUBR);
- XSETSUBR (XSYMBOL (sym)->function, sname);
+ XSETPVECTYPE (sname, PVEC_SUBR);
+ XSETSUBR (tem, sname);
+ set_symbol_function (sym, tem);
}
-#ifdef NOTDEF /* use fset in subr.el now */
+#ifdef NOTDEF /* Use fset in subr.el now! */
void
defalias (struct Lisp_Subr *sname, char *string)
{
@@ -4045,7 +4019,7 @@ defvar_int (struct Lisp_Intfwd *i_fwd,
nil if address contains 0. */
void
defvar_bool (struct Lisp_Boolfwd *b_fwd,
- const char *namestring, int *address)
+ const char *namestring, bool *address)
{
Lisp_Object sym;
sym = intern_c_string (namestring);
@@ -4099,194 +4073,261 @@ defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
}
+/* Check that the elements of Vload_path exist. */
+
+static void
+load_path_check (void)
+{
+ Lisp_Object path_tail;
+
+ /* The only elements that might not exist are those from
+ PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
+ it exists. */
+ for (path_tail = Vload_path; !NILP (path_tail); path_tail = XCDR (path_tail))
+ {
+ Lisp_Object dirfile;
+ dirfile = Fcar (path_tail);
+ if (STRINGP (dirfile))
+ {
+ dirfile = Fdirectory_file_name (dirfile);
+ if (! file_accessible_directory_p (SSDATA (dirfile)))
+ dir_warning ("Lisp directory", XCAR (path_tail));
+ }
+ }
+}
+
/* Record the value of load-path used at the start of dumping
so we can see if the site changed it later during dumping. */
static Lisp_Object dump_path;
+/* Compute the default Vload_path, with the following logic:
+ If CANNOT_DUMP:
+ use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
+ prepending PATH_SITELOADSEARCH unless --no-site-lisp.
+ The remainder is what happens when dumping works:
+ If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
+ Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
+
+ If !initialized, then just set both Vload_path and dump_path.
+ If initialized, then if Vload_path != dump_path, do nothing.
+ (Presumably the load-path has already been changed by something.
+ This can only be from a site-load file during dumping,
+ or because EMACSLOADPATH is set.)
+ If Vinstallation_directory is not nil (ie, running uninstalled):
+ If installation-dir/lisp exists and not already a member,
+ we must be running uninstalled. Reset the load-path
+ to just installation-dir/lisp. (The default PATH_LOADSEARCH
+ refers to the eventual installation directories. Since we
+ are not yet installed, we should not use them, even if they exist.)
+ If installation-dir/lisp does not exist, just add dump_path at the
+ end instead.
+ Add installation-dir/leim (if exists and not already a member) at the front.
+ Add installation-dir/site-lisp (if !no_site_lisp, and exists
+ and not already a member) at the front.
+ If installation-dir != source-dir (ie running an uninstalled,
+ out-of-tree build) AND install-dir/src/Makefile exists BUT
+ install-dir/src/Makefile.in does NOT exist (this is a sanity
+ check), then repeat the above steps for source-dir/lisp,
+ leim and site-lisp.
+ Finally, add the site-lisp directories at the front (if !no_site_lisp).
+*/
+
void
init_lread (void)
{
const char *normal;
- int turn_off_warning = 0;
- /* Compute the default load-path. */
#ifdef CANNOT_DUMP
+#ifdef HAVE_NS
+ const char *loadpath = ns_load_path ();
+#endif
+
normal = PATH_LOADSEARCH;
- Vload_path = decode_env_path (0, normal);
+#ifdef HAVE_NS
+ Vload_path = decode_env_path ("EMACSLOADPATH", loadpath ? loadpath : normal);
#else
+ Vload_path = decode_env_path ("EMACSLOADPATH", normal);
+#endif
+
+ load_path_check ();
+
+ /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
+ to their load-path too, AFAICS. I don't think we can tell the
+ difference between initialized and !initialized in this case,
+ so we'll have to do it unconditionally when Vinstallation_directory
+ is non-nil. */
+ if (!no_site_lisp && !egetenv ("EMACSLOADPATH"))
+ {
+ Lisp_Object sitelisp;
+ sitelisp = decode_env_path (0, PATH_SITELOADSEARCH);
+ if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path);
+ }
+#else /* !CANNOT_DUMP */
if (NILP (Vpurify_flag))
- normal = PATH_LOADSEARCH;
+ {
+ normal = PATH_LOADSEARCH;
+ /* If the EMACSLOADPATH environment variable is set, use its value.
+ This doesn't apply if we're dumping. */
+ if (egetenv ("EMACSLOADPATH"))
+ Vload_path = decode_env_path ("EMACSLOADPATH", normal);
+ }
else
normal = PATH_DUMPLOADSEARCH;
- /* In a dumped Emacs, we normally have to reset the value of
- Vload_path from PATH_LOADSEARCH, since the value that was dumped
- uses ../lisp, instead of the path of the installed elisp
- libraries. However, if it appears that Vload_path was changed
- from the default before dumping, don't override that value. */
+ /* In a dumped Emacs, we normally reset the value of Vload_path using
+ PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
+ the source directory, instead of the path of the installed elisp
+ libraries. However, if it appears that Vload_path has already been
+ changed from the default that was saved before dumping, don't
+ change it further. Changes can only be due to EMACSLOADPATH, or
+ site-lisp files that were processed during dumping. */
if (initialized)
{
- if (! NILP (Fequal (dump_path, Vload_path)))
+ if (NILP (Fequal (dump_path, Vload_path)))
+ {
+ /* Do not make any changes, just check the elements exist. */
+ /* Note: --no-site-lisp is ignored.
+ I don't know what to do about this. */
+ load_path_check ();
+ }
+ else
{
+#ifdef HAVE_NS
+ const char *loadpath = ns_load_path ();
+ Vload_path = decode_env_path (0, loadpath ? loadpath : normal);
+#else
Vload_path = decode_env_path (0, normal);
+#endif
if (!NILP (Vinstallation_directory))
{
- Lisp_Object tem, tem1, sitelisp;
-
- /* Remove site-lisp dirs from path temporarily and store
- them in sitelisp, then conc them on at the end so
- they're always first in path. */
- sitelisp = Qnil;
- while (1)
- {
- tem = Fcar (Vload_path);
- tem1 = Fstring_match (build_string ("site-lisp"),
- tem, Qnil);
- if (!NILP (tem1))
- {
- Vload_path = Fcdr (Vload_path);
- sitelisp = Fcons (tem, sitelisp);
- }
- else
- break;
- }
-
- /* Add to the path the lisp subdir of the
- installation dir, if it exists. */
- tem = Fexpand_file_name (build_string ("lisp"),
- Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
- if (!NILP (tem1))
- {
- if (NILP (Fmember (tem, Vload_path)))
- {
- turn_off_warning = 1;
- Vload_path = Fcons (tem, Vload_path);
- }
- }
- else
- /* That dir doesn't exist, so add the build-time
- Lisp dirs instead. */
- Vload_path = nconc2 (Vload_path, dump_path);
-
- /* Add leim under the installation dir, if it exists. */
- tem = Fexpand_file_name (build_string ("leim"),
- Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
- if (!NILP (tem1))
- {
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
- }
-
- /* Add site-lisp under the installation dir, if it exists. */
- if (!no_site_lisp)
- {
- tem = Fexpand_file_name (build_string ("site-lisp"),
- Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
- if (!NILP (tem1))
- {
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
- }
- }
-
- /* If Emacs was not built in the source directory,
- and it is run from where it was built, add to load-path
- the lisp, leim and site-lisp dirs under that directory. */
-
- if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
- {
- Lisp_Object tem2;
-
- tem = Fexpand_file_name (build_string ("src/Makefile"),
- Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
-
- /* Don't be fooled if they moved the entire source tree
- AFTER dumping Emacs. If the build directory is indeed
- different from the source dir, src/Makefile.in and
- src/Makefile will not be found together. */
- tem = Fexpand_file_name (build_string ("src/Makefile.in"),
- Vinstallation_directory);
- tem2 = Ffile_exists_p (tem);
- if (!NILP (tem1) && NILP (tem2))
- {
- tem = Fexpand_file_name (build_string ("lisp"),
- Vsource_directory);
-
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
-
- tem = Fexpand_file_name (build_string ("leim"),
- Vsource_directory);
-
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
-
- if (!no_site_lisp)
- {
- tem = Fexpand_file_name (build_string ("site-lisp"),
- Vsource_directory);
-
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
- }
- }
- }
- if (!NILP (sitelisp) && !no_site_lisp)
- Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path);
- }
- }
+ Lisp_Object tem, tem1;
+
+ /* Add to the path the lisp subdir of the installation
+ dir, if it is accessible. Note: in out-of-tree builds,
+ this directory is empty save for Makefile. */
+ tem = Fexpand_file_name (build_string ("lisp"),
+ Vinstallation_directory);
+ tem1 = Ffile_accessible_directory_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, Vload_path)))
+ {
+ /* We are running uninstalled. The default load-path
+ points to the eventual installed lisp, leim
+ directories. We should not use those now, even
+ if they exist, so start over from a clean slate. */
+ Vload_path = Fcons (tem, Qnil);
+ }
+ }
+ else
+ /* That dir doesn't exist, so add the build-time
+ Lisp dirs instead. */
+ Vload_path = nconc2 (Vload_path, dump_path);
+
+ /* Add leim under the installation dir, if it is accessible. */
+ tem = Fexpand_file_name (build_string ("leim"),
+ Vinstallation_directory);
+ tem1 = Ffile_accessible_directory_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+ }
+
+ /* Add site-lisp under the installation dir, if it exists. */
+ if (!no_site_lisp)
+ {
+ tem = Fexpand_file_name (build_string ("site-lisp"),
+ Vinstallation_directory);
+ tem1 = Ffile_accessible_directory_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+ }
+ }
+
+ /* If Emacs was not built in the source directory,
+ and it is run from where it was built, add to load-path
+ the lisp, leim and site-lisp dirs under that directory. */
+
+ if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
+ {
+ Lisp_Object tem2;
+
+ tem = Fexpand_file_name (build_string ("src/Makefile"),
+ Vinstallation_directory);
+ tem1 = Ffile_exists_p (tem);
+
+ /* Don't be fooled if they moved the entire source tree
+ AFTER dumping Emacs. If the build directory is indeed
+ different from the source dir, src/Makefile.in and
+ src/Makefile will not be found together. */
+ tem = Fexpand_file_name (build_string ("src/Makefile.in"),
+ Vinstallation_directory);
+ tem2 = Ffile_exists_p (tem);
+ if (!NILP (tem1) && NILP (tem2))
+ {
+ tem = Fexpand_file_name (build_string ("lisp"),
+ Vsource_directory);
+
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+
+ tem = Fexpand_file_name (build_string ("leim"),
+ Vsource_directory);
+
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+
+ if (!no_site_lisp)
+ {
+ tem = Fexpand_file_name (build_string ("site-lisp"),
+ Vsource_directory);
+ tem1 = Ffile_accessible_directory_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+ }
+ }
+ }
+ } /* Vinstallation_directory != Vsource_directory */
+
+ } /* if Vinstallation_directory */
+
+ /* Check before adding the site-lisp directories.
+ The install should have created them, but they are not
+ required, so no need to warn if they are absent.
+ Or we might be running before installation. */
+ load_path_check ();
+
+ /* Add the site-lisp directories at the front. */
+ if (!no_site_lisp)
+ {
+ Lisp_Object sitelisp;
+ sitelisp = decode_env_path (0, PATH_SITELOADSEARCH);
+ if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path);
+ }
+ } /* if dump_path == Vload_path */
}
- else
+ else /* !initialized */
{
- /* NORMAL refers to the lisp dir in the source directory. */
- /* We used to add ../lisp at the front here, but
- that caused trouble because it was copied from dump_path
- into Vload_path, above, when Vinstallation_directory was non-nil.
- It should be unnecessary. */
+ /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
+ source directory. We used to add ../lisp (ie the lisp dir in
+ the build directory) at the front here, but that caused trouble
+ because it was copied from dump_path into Vload_path, above,
+ when Vinstallation_directory was non-nil. It should not be
+ necessary, since in out of tree builds lisp/ is empty, save
+ for Makefile. */
Vload_path = decode_env_path (0, normal);
dump_path = Vload_path;
+ /* No point calling load_path_check; load-path only contains essential
+ elements from the source directory at this point. They cannot
+ be missing unless something went extremely (and improbably)
+ wrong, in which case the build will fail in obvious ways. */
}
-#endif
-
-#if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
- /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
- almost never correct, thereby causing a warning to be printed out that
- confuses users. Since PATH_LOADSEARCH is always overridden by the
- EMACSLOADPATH environment variable below, disable the warning on NT. */
-
- /* Warn if dirs in the *standard* path don't exist. */
- if (!turn_off_warning)
- {
- Lisp_Object path_tail;
-
- for (path_tail = Vload_path;
- !NILP (path_tail);
- path_tail = XCDR (path_tail))
- {
- Lisp_Object dirfile;
- dirfile = Fcar (path_tail);
- if (STRINGP (dirfile))
- {
- dirfile = Fdirectory_file_name (dirfile);
- if (access (SSDATA (dirfile), 0) < 0)
- dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
- XCAR (path_tail));
- }
- }
- }
-#endif /* !(WINDOWSNT || HAVE_NS) */
-
- /* If the EMACSLOADPATH environment variable is set, use its value.
- This doesn't apply if we're dumping. */
-#ifndef CANNOT_DUMP
- if (NILP (Vpurify_flag)
- && egetenv ("EMACSLOADPATH"))
-#endif
- Vload_path = decode_env_path ("EMACSLOADPATH", normal);
+#endif /* !CANNOT_DUMP */
Vvalues = Qnil;
@@ -4299,23 +4340,28 @@ init_lread (void)
Vloads_in_progress = Qnil;
}
-/* Print a warning, using format string FORMAT, that directory DIRNAME
- does not exist. Print it on stderr and put it in *Messages*. */
+/* Print a warning that directory intended for use USE and with name
+ DIRNAME cannot be accessed. On entry, errno should correspond to
+ the access failure. Print the warning on stderr and put it in
+ *Messages*. */
void
-dir_warning (const char *format, Lisp_Object dirname)
+dir_warning (char const *use, Lisp_Object dirname)
{
- fprintf (stderr, format, SDATA (dirname));
+ static char const format[] = "Warning: %s `%s': %s\n";
+ int access_errno = errno;
+ fprintf (stderr, format, use, SSDATA (dirname), strerror (access_errno));
- /* Don't log the warning before we've initialized!! */
+ /* Don't log the warning before we've initialized!! */
if (initialized)
{
- char *buffer;
- ptrdiff_t message_len;
+ char const *diagnostic = emacs_strerror (access_errno);
USE_SAFE_ALLOCA;
- SAFE_ALLOCA (buffer, char *,
- SBYTES (dirname) + strlen (format) - (sizeof "%s" - 1) + 1);
- message_len = esprintf (buffer, format, SDATA (dirname));
+ char *buffer = SAFE_ALLOCA (sizeof format - 3 * (sizeof "%s" - 1)
+ + strlen (use) + SBYTES (dirname)
+ + strlen (diagnostic));
+ ptrdiff_t message_len = esprintf (buffer, format, use, SSDATA (dirname),
+ diagnostic);
message_dolog (buffer, message_len, 0, STRING_MULTIBYTE (dirname));
SAFE_FREE ();
}
@@ -4348,7 +4394,8 @@ to find all the symbols in an obarray, use `mapatoms'. */);
DEFVAR_LISP ("values", Vvalues,
doc: /* List of values of all expressions which were read, evaluated and printed.
-Order is reverse chronological. */);
+ Order is reverse chronological. */);
+ XSYMBOL (intern ("values"))->declared_special = 0;
DEFVAR_LISP ("standard-input", Vstandard_input,
doc: /* Stream for read to get input from.
@@ -4366,7 +4413,7 @@ defined, although they may be in the future.
The positions are relative to the last call to `read' or
`read-from-string'. It is probably a bad idea to set this variable at
-the toplevel; bind it instead. */);
+the toplevel; bind it instead. */);
Vread_with_symbol_positions = Qnil;
DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list,
@@ -4381,7 +4428,7 @@ symbol from the position where `read' or `read-from-string' started.
Note that a symbol will appear multiple times in this list, if it was
read multiple times. The list is in the same order as the symbols
-were read in. */);
+were read in. */);
Vread_symbol_positions_list = Qnil;
DEFVAR_LISP ("read-circle", Vread_circle,
@@ -4389,7 +4436,7 @@ were read in. */);
Vread_circle = Qt;
DEFVAR_LISP ("load-path", Vload_path,
- doc: /* *List of directories to search for files to load.
+ doc: /* List of directories to search for files to load.
Each element is a string (directory name) or nil (try default directory).
Initialized based on EMACSLOADPATH environment variable, if any,
otherwise to default specified by file `epaths.h' when Emacs was built. */);
@@ -4399,8 +4446,8 @@ otherwise to default specified by file `epaths.h' when Emacs was built. */);
This list should not include the empty string.
`load' and related functions try to append these suffixes, in order,
to the specified file name if a Lisp suffix is allowed or required. */);
- Vload_suffixes = Fcons (make_pure_c_string (".elc"),
- Fcons (make_pure_c_string (".el"), Qnil));
+ Vload_suffixes = Fcons (build_pure_c_string (".elc"),
+ Fcons (build_pure_c_string (".el"), Qnil));
DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
doc: /* List of suffixes that indicate representations of \
the same file.
@@ -4533,16 +4580,17 @@ from the file, and matches them against this regular expression.
When the regular expression matches, the file is considered to be safe
to load. See also `load-dangerous-libraries'. */);
Vbytecomp_version_regexp
- = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
+ = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
- Qlexical_binding = intern ("lexical-binding");
- staticpro (&Qlexical_binding);
+ DEFSYM (Qlexical_binding, "lexical-binding");
DEFVAR_LISP ("lexical-binding", Vlexical_binding,
doc: /* Whether to use lexical binding when evaluating code.
Non-nil means that the code in the current buffer should be evaluated
with lexical binding.
This variable is automatically set from the file variables of an
-interpreted Lisp file read using `load'. */);
+interpreted Lisp file read using `load'. Unlike other file local
+variables, this must be set in the first line of a file. */);
+ Vlexical_binding = Qnil;
Fmake_variable_buffer_local (Qlexical_binding);
DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list,
diff --git a/src/m/README b/src/m/README
deleted file mode 100644
index ad91167648e..00000000000
--- a/src/m/README
+++ /dev/null
@@ -1,7 +0,0 @@
-This directory contains C header files containing machine-specific
-definitions. Each file describes a particular machine. The emacs
-configuration script edits ../config.h to include the appropriate one of
-these files, and then each emacs source file includes config.h.
-
-template.h is a generic template for machine descriptions; it
-describes the parameters a machine file can specify.
diff --git a/src/m/alpha.h b/src/m/alpha.h
deleted file mode 100644
index 713598fa8b6..00000000000
--- a/src/m/alpha.h
+++ /dev/null
@@ -1,53 +0,0 @@
-/* Machine description file for the alpha chip.
-
-Copyright (C) 1994, 1997, 1999, 2001-2011 Free Software Foundation, Inc.
-
-Author: Rainer Schoepf
-(according to authors.el)
-
-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/>. */
-
-#ifndef _LP64
-#define _LP64 /* This doesn't appear to be necessary on OSF 4/5 -- fx. */
-#endif
-
-/* Now define a symbol for the cpu type, if your compiler
- does not define it automatically. */
-/* __alpha defined automatically */
-
-
-#ifdef __ELF__
-
-#if !defined (GNU_LINUX) && !defined (__NetBSD__)
-#define DATA_START 0x140000000
-#endif
-
-#else /* not __ELF__ */
-
-/* Describe layout of the address space in an executing process. */
-#define DATA_START 0x140000000
-
-#endif /* __ELF__ */
-
-/* On the Alpha it's best to avoid including TERMIO since struct
- termio and struct termios are mutually incompatible. */
-#define NO_TERMIO
-
-/* Many Alpha implementations (e.g. gas 2.8) can't handle DBL_MIN:
- they generate code that uses a signaling NaN instead of DBL_MIN.
- Define DBL_MIN_REPLACEMENT to be the next value larger than DBL_MIN:
- this avoids the assembler bug. */
-#define DBL_MIN_REPLACEMENT 2.2250738585072019e-308
diff --git a/src/m/amdx86-64.h b/src/m/amdx86-64.h
deleted file mode 100644
index 50fcf8e7872..00000000000
--- a/src/m/amdx86-64.h
+++ /dev/null
@@ -1,35 +0,0 @@
-/* machine description file for AMD x86-64.
-
-Copyright (C) 2002-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-#define BITS_PER_LONG 64
-#define BITS_PER_EMACS_INT 64
-
-/* Now define a symbol for the cpu type, if your compiler
- does not define it automatically:
- Ones defined so far include vax, m68000, ns16000, pyramid,
- orion, tahoe, APOLLO and many others */
-/* __x86_64 defined automatically. */
-
-/* Define the type to use. */
-#define EMACS_INT long
-#define pI "l"
-#define EMACS_UINT unsigned long
-
-/* Define XPNTR to avoid or'ing with DATA_SEG_BITS */
-#undef DATA_SEG_BITS
diff --git a/src/m/ia64.h b/src/m/ia64.h
deleted file mode 100644
index 7a8866a9503..00000000000
--- a/src/m/ia64.h
+++ /dev/null
@@ -1,42 +0,0 @@
-/* machine description file for the IA-64 architecture.
-
-Copyright (C) 2000-2011 Free Software Foundation, Inc.
-
- Contributed by David Mosberger <davidm@hpl.hp.com>
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software: you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-
-#define BITS_PER_LONG 64
-#define BITS_PER_EMACS_INT 64
-
-/* Now define a symbol for the cpu type, if your compiler
- does not define it automatically. */
-/* __ia64__ defined automatically */
-
-/* Define the type to use. */
-#define EMACS_INT long
-#define pI "l"
-#define EMACS_UINT unsigned long
-
-#ifdef REL_ALLOC
-#ifndef _MALLOC_INTERNAL
-/* "char *" because ralloc.c defines it that way. gmalloc.c thinks it
- is allowed to prototype these as "void *" so we don't prototype in
- that case. You're right: it stinks! */
-extern char *r_alloc (), *r_re_alloc ();
-extern void r_alloc_free ();
-#endif /* not _MALLOC_INTERNAL */
-#endif /* REL_ALLOC */
diff --git a/src/m/ibmrs6000.h b/src/m/ibmrs6000.h
deleted file mode 100644
index ca2188bc068..00000000000
--- a/src/m/ibmrs6000.h
+++ /dev/null
@@ -1,46 +0,0 @@
-/* R2 AIX machine/system dependent defines
-
-Copyright (C) 1988, 2001-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-
-/* The data segment in this machine always starts at address 0x20000000.
- An address of data cannot be stored correctly in a Lisp object;
- we always lose the high bits. We must tell XPNTR to add them back. */
-#define DATA_START 0x20000000
-#define DATA_SEG_BITS 0x20000000
-
-#ifndef NLIST_STRUCT
-/* AIX supposedly doesn't use this interface, but on the RS/6000
- it apparently does. */
-#define NLIST_STRUCT
-#endif
-
-#undef ADDR_CORRECT
-#define ADDR_CORRECT(x) ((int)(x))
-
-/*** BUILD 9008 - FIONREAD problem still exists in X-Windows. ***/
-#define BROKEN_FIONREAD
-/* As we define BROKEN_FIONREAD, SIGIO will be undefined in systty.h.
- But, on AIX, SIGAIO, SIGPTY, and SIGPOLL are defined as SIGIO,
- which causes compilation error at init_signals in sysdep.c. So, we
- define these macros so that syssignal.h detects them and undefine
- SIGAIO, SIGPTY and SIGPOLL. */
-#define BROKEN_SIGAIO
-#define BROKEN_SIGPTY
-#define BROKEN_SIGPOLL
-
diff --git a/src/m/ibms390x.h b/src/m/ibms390x.h
deleted file mode 100644
index 5ea7974b052..00000000000
--- a/src/m/ibms390x.h
+++ /dev/null
@@ -1,32 +0,0 @@
-/* Machine description file for IBM S390 in 64-bit mode
-
-Copyright (C) 2002-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-#define BITS_PER_LONG 64
-#define BITS_PER_EMACS_INT 64
-
-/* Define the type to use. */
-#define EMACS_INT long
-#define pI "l"
-#define EMACS_UINT unsigned long
-
-/* On the 64 bit architecture, we can use 60 bits for addresses */
-#define VALBITS 60
-
-/* Define XPNTR to avoid or'ing with DATA_SEG_BITS */
-#define XPNTR(a) XUINT (a)
diff --git a/src/m/intel386.h b/src/m/intel386.h
deleted file mode 100644
index 114b7fef963..00000000000
--- a/src/m/intel386.h
+++ /dev/null
@@ -1,29 +0,0 @@
-/* Machine description file for intel 386.
-
-Copyright (C) 1987, 2001-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-
-#ifdef WINDOWSNT
-#define DATA_START get_data_start ()
-#endif
-
-#ifdef GNU_LINUX
-/* libc-linux/sysdeps/linux/i386/ulimit.c says that due to shared library, */
-/* we cannot get the maximum address for brk */
-#define ULIMIT_BREAK_VALUE (32*1024*1024)
-#endif
diff --git a/src/m/template.h b/src/m/template.h
deleted file mode 100644
index 38649e8ac6d..00000000000
--- a/src/m/template.h
+++ /dev/null
@@ -1,34 +0,0 @@
-/* machine description file template.
-
-Copyright (C) 1985-1986, 2001-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-/* Now define a symbol for the cpu type, if your compiler
- does not define it automatically.
- Ones defined so far include m68k and many others */
-
-/* After adding support for a new machine, modify the large case
- statement in configure.in to recognize reasonable
- configuration names, and add a description of the system to
- `etc/MACHINES'.
-
- Check for any tests of $machine in configure.in, and add an entry
- for the new machine if needed.
-
- If you've just fixed a problem in an existing configuration file,
- you should also check `etc/MACHINES' to make sure its descriptions
- of known problems in that configuration should be updated. */
diff --git a/src/m/vax.h b/src/m/vax.h
deleted file mode 100644
index a375600cead..00000000000
--- a/src/m/vax.h
+++ /dev/null
@@ -1,23 +0,0 @@
-/* machine description file for vax.
-
-Copyright (C) 1985-1986, 2001-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-
-/* #define vax -- appears to be done automatically */
-
-#define HAVE_FTIME
diff --git a/src/macros.c b/src/macros.c
index 4ecf49834a1..632c851ee8c 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -1,6 +1,6 @@
/* Keyboard macros.
-Copyright (C) 1985-1986, 1993, 2000-2011 Free Software Foundation, Inc.
+Copyright (C) 1985-1986, 1993, 2000-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,10 +19,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "macros.h"
#include "commands.h"
+#include "character.h"
#include "buffer.h"
#include "window.h"
#include "keyboard.h"
@@ -62,8 +63,7 @@ macro before appending to it. */)
if (!current_kboard->kbd_macro_buffer)
{
- current_kboard->kbd_macro_buffer
- = (Lisp_Object *)xmalloc (30 * sizeof (Lisp_Object));
+ current_kboard->kbd_macro_buffer = xmalloc (30 * word_size);
current_kboard->kbd_macro_bufsize = 30;
}
update_mode_lines++;
@@ -72,8 +72,8 @@ macro before appending to it. */)
if (current_kboard->kbd_macro_bufsize > 200)
{
current_kboard->kbd_macro_buffer
- = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer,
- 30 * sizeof (Lisp_Object));
+ = xrealloc (current_kboard->kbd_macro_buffer,
+ 30 * word_size);
current_kboard->kbd_macro_bufsize = 30;
}
current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_buffer;
@@ -84,7 +84,7 @@ macro before appending to it. */)
{
ptrdiff_t i;
EMACS_INT len;
- int cvt;
+ bool cvt;
/* Check the type of last-kbd-macro in case Lisp code changed it. */
CHECK_VECTOR_OR_STRING (KVAR (current_kboard, Vlast_kbd_macro));
@@ -95,13 +95,14 @@ macro before appending to it. */)
has put another macro there. */
if (current_kboard->kbd_macro_bufsize < len + 30)
{
- if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object) - 30
- < current_kboard->kbd_macro_bufsize)
+ if (PTRDIFF_MAX < MOST_POSITIVE_FIXNUM + 30
+ && PTRDIFF_MAX < len + 30)
memory_full (SIZE_MAX);
- current_kboard->kbd_macro_buffer
- = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer,
- (len + 30) * sizeof (Lisp_Object));
- current_kboard->kbd_macro_bufsize = len + 30;
+ current_kboard->kbd_macro_buffer =
+ xpalloc (current_kboard->kbd_macro_buffer,
+ &current_kboard->kbd_macro_bufsize,
+ len + 30 - current_kboard->kbd_macro_bufsize, -1,
+ sizeof *current_kboard->kbd_macro_buffer);
}
/* Must convert meta modifier when copying string to vector. */
@@ -126,7 +127,7 @@ macro before appending to it. */)
message ("Appending to kbd macro...");
}
- KVAR (current_kboard, defining_kbd_macro) = Qt;
+ kset_defining_kbd_macro (current_kboard, Qt);
return Qnil;
}
@@ -136,12 +137,13 @@ macro before appending to it. */)
void
end_kbd_macro (void)
{
- KVAR (current_kboard, defining_kbd_macro) = Qnil;
+ kset_defining_kbd_macro (current_kboard, Qnil);
update_mode_lines++;
- KVAR (current_kboard, Vlast_kbd_macro)
- = make_event_array ((current_kboard->kbd_macro_end
- - current_kboard->kbd_macro_buffer),
- current_kboard->kbd_macro_buffer);
+ kset_last_kbd_macro
+ (current_kboard,
+ make_event_array ((current_kboard->kbd_macro_end
+ - current_kboard->kbd_macro_buffer),
+ current_kboard->kbd_macro_buffer));
}
DEFUN ("end-kbd-macro", Fend_kbd_macro, Send_kbd_macro, 0, 2, "p",
@@ -203,8 +205,7 @@ store_kbd_macro_char (Lisp_Object c)
< kb->kbd_macro_bufsize)
memory_full (SIZE_MAX);
nbytes = kb->kbd_macro_bufsize * (2 * sizeof *kb->kbd_macro_buffer);
- kb->kbd_macro_buffer
- = (Lisp_Object *) xrealloc (kb->kbd_macro_buffer, nbytes);
+ kb->kbd_macro_buffer = xrealloc (kb->kbd_macro_buffer, nbytes);
kb->kbd_macro_bufsize *= 2;
kb->kbd_macro_ptr = kb->kbd_macro_buffer + ptr_offset;
kb->kbd_macro_end = kb->kbd_macro_buffer + end_offset;
@@ -258,7 +259,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
from before this macro started. */
Vthis_command = KVAR (current_kboard, Vlast_command);
/* C-x z after the macro should repeat the macro. */
- real_this_command = KVAR (current_kboard, Vlast_kbd_macro);
+ Vreal_this_command = KVAR (current_kboard, Vlast_kbd_macro);
if (! NILP (KVAR (current_kboard, defining_kbd_macro)))
error ("Can't execute anonymous macro while defining one");
@@ -285,7 +286,7 @@ pop_kbd_macro (Lisp_Object info)
Vexecuting_kbd_macro = XCAR (info);
tem = XCDR (info);
executing_kbd_macro_index = XINT (XCAR (tem));
- real_this_command = XCDR (tem);
+ Vreal_this_command = XCDR (tem);
Frun_hooks (1, &Qkbd_macro_termination_hook);
return Qnil;
}
@@ -301,7 +302,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
{
Lisp_Object final;
Lisp_Object tem;
- int pdlcount = SPECPDL_INDEX ();
+ ptrdiff_t pdlcount = SPECPDL_INDEX ();
EMACS_INT repeat = 1;
struct gcpro gcpro1, gcpro2;
EMACS_INT success_count = 0;
@@ -320,7 +321,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
tem = Fcons (Vexecuting_kbd_macro,
Fcons (make_number (executing_kbd_macro_index),
- real_this_command));
+ Vreal_this_command));
record_unwind_protect (pop_kbd_macro, tem);
GCPRO2 (final, loopfunc);
@@ -330,7 +331,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
executing_kbd_macro = final;
executing_kbd_macro_index = 0;
- KVAR (current_kboard, Vprefix_arg) = Qnil;
+ kset_prefix_arg (current_kboard, Qnil);
if (!NILP (loopfunc))
{
@@ -351,7 +352,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
executing_kbd_macro = Qnil;
- real_this_command = Vexecuting_kbd_macro;
+ Vreal_this_command = Vexecuting_kbd_macro;
UNGCPRO;
return unbind_to (pdlcount, Qnil);
diff --git a/src/macros.h b/src/macros.h
index 7a5d532fbb7..d66784a0246 100644
--- a/src/macros.h
+++ b/src/macros.h
@@ -1,5 +1,5 @@
/* Definitions for keyboard macro interpretation in GNU Emacs.
- Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/makefile.w32-in b/src/makefile.w32-in
index 36e4511d845..a296f6eb393 100644
--- a/src/makefile.w32-in
+++ b/src/makefile.w32-in
@@ -1,5 +1,5 @@
-# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
-# Copyright (C) 2000-2011 Free Software Foundation, Inc.
+# -*- Makefile -*- for GNU Emacs on the Microsoft Windows API.
+# Copyright (C) 2000-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -25,13 +25,9 @@ ALL = emacs
EMACSLOADPATH=$(CURDIR)/../lisp
# Size in MBs of the static heap in temacs.exe.
-HEAPSIZE = 27
+HEAPSIZE = $(EMACS_HEAPSIZE)
-#
-# HAVE_CONFIG_H is required by some generic gnu sources stuck into
-# the emacs source tree.
-#
-LOCAL_FLAGS = -Demacs=1 -DHAVE_CONFIG_H -I../lib -I../nt/inc -DHAVE_NTGUI=1 $(EMACS_EXTRA_C_FLAGS)
+LOCAL_FLAGS = -Demacs=1 -I../lib -I../nt/inc $(EMACS_EXTRA_C_FLAGS)
SRC = .
EMACS = $(BLD)/emacs.exe
@@ -128,6 +124,8 @@ OBJ2 = $(BLD)/sysdep.$(O) \
$(BLD)/image.$(O) \
$(BLD)/terminal.$(O) \
$(BLD)/menu.$(O) \
+ $(BLD)/xml.$(O) \
+ $(BLD)/profiler.$(O) \
$(BLD)/w32term.$(O) \
$(BLD)/w32xfns.$(O) \
$(BLD)/w32fns.$(O) \
@@ -209,7 +207,7 @@ make-buildobj-SH:
GLOBAL_SOURCES = dosfns.c msdos.c \
xterm.c xfns.c xmenu.c xselect.c xrdb.c xsmfns.c fringe.c image.c \
fontset.c menu.c dbusbind.c \
- w32.c w32console.c w32fns.c w32heap.c w32inevt.c \
+ w32.c w32console.c w32fns.c w32heap.c w32inevt.c cygw32.c \
w32menu.c w32proc.c w32reg.c w32select.c w32term.c w32xfns.c \
font.c w32font.c w32uniscribe.c \
dispnew.c frame.c scroll.c xdisp.c window.c bidi.c \
@@ -225,18 +223,18 @@ GLOBAL_SOURCES = dosfns.c msdos.c \
process.c callproc.c unexw32.c \
region-cache.c sound.c atimer.c \
doprnt.c intervals.c textprop.c composite.c \
- gnutls.c
+ gnutls.c xml.c profiler.c
SOME_MACHINE_OBJECTS = dosfns.o msdos.o \
xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o dbusbind.o
obj = $(GLOBAL_SOURCES:.c=.o)
globals.h: gl-stamp
- @cmd /c rem true
+ @cmd $(SWITCHCHAR)c rem true
gl-stamp: ../lib-src/$(BLD)/make-docfile.exe $(GLOBAL_SOURCES)
- $(DEL) gl-tmp
"$(THISDIR)/../lib-src/$(BLD)/make-docfile" -d . -g $(SOME_MACHINE_OBJECTS) $(obj) > gl-tmp
- cmd /c "fc /b gl-tmp globals.h >nul 2>&1 || $(CP) gl-tmp globals.h"
+ fc.exe $(SWITCHCHAR)b gl-tmp globals.h >nul 2>&1 || $(CP) gl-tmp globals.h
- $(DEL) gl-tmp
echo timestamp > $@
@@ -249,10 +247,10 @@ bootstrap: bootstrap-emacs
# WARNING: Do NOT split the part inside $(ARGQUOTE)s into multiple lines as
# this can break with GNU Make 3.81 and later if sh.exe is used.
bootstrap-temacs-CMD:
- $(MAKE) $(MFLAGS) $(XMFLAGS) temacs CFLAGS=$(ARGQUOTE)$(ESC_CFLAGS) -DPURESIZE=5000000$(ARGQUOTE)
+ $(MAKE) $(MFLAGS) $(XMFLAGS) temacs CFLAGS=$(ARGQUOTE)$(ESC_CFLAGS) -DPURESIZE=$(EMACS_PURESIZE)$(ARGQUOTE)
bootstrap-temacs-SH:
- $(MAKE) $(MFLAGS) $(XMFLAGS) temacs CFLAGS=$(ARGQUOTE)$(CFLAGS) -DPURESIZE=5000000$(ARGQUOTE)
+ $(MAKE) $(MFLAGS) $(XMFLAGS) temacs CFLAGS=$(ARGQUOTE)$(CFLAGS) -DPURESIZE=$(EMACS_PURESIZE)$(ARGQUOTE)
bootstrap-temacs:
$(MAKE) $(MFLAGS) bootstrap-temacs-$(SHELLTYPE)
@@ -342,7 +340,7 @@ cleanall: clean
##
## This works only with GNU Make.
-TAGS: $(OBJ0) $(OBJ1) $(OBJ2) $(CURDIR)/m/intel386.h $(CURDIR)/s/ms-w32.h
+TAGS: $(OBJ0) $(OBJ1) $(OBJ2) $(CURDIR)/../nt/inc/ms-w32.h
$(MAKE) $(MFLAGS) TAGS-$(MAKETYPE)
TAGS-LISP: $(OBJ0) $(OBJ1) $(OBJ2)
@@ -356,7 +354,7 @@ TAGS-gmake:
$(OBJ1_c)
../lib-src/$(BLD)/etags.exe -a --regex=@../nt/emacs-src.tags \
$(OBJ2_c) \
- $(CURDIR)/*.h $(CURDIR)/m/intel386.h $(CURDIR)/s/ms-w32.h
+ $(CURDIR)/*.h $(CURDIR)/../nt/inc/ms-w32.h
TAGS-nmake:
echo This target is not supported with NMake
@@ -390,36 +388,44 @@ GNU_LIB = $(EMACS_ROOT)/lib
NT_INC = $(EMACS_ROOT)/nt/inc
SYSTIME_H = $(SRC)/systime.h \
- $(NT_INC)/sys/time.h
+ $(NT_INC)/sys/time.h \
+ $(GNU_LIB)/timespec.h
ATIMER_H = $(SRC)/atimer.h \
+ $(NT_INC)/stdbool.h \
+ $(SYSTIME_H)
+BUFFER_H = $(SRC)/buffer.h \
$(SYSTIME_H)
-BLOCKINPUT_H = $(SRC)/blockinput.h \
- $(ATIMER_H)
+C_CTYPE_H = $(GNU_LIB)/c-ctype.h \
+ $(NT_INC)/stdbool.h
CAREADLINKAT_H = $(GNU_LIB)/careadlinkat.h \
$(NT_INC)/unistd.h
CHARACTER_H = $(SRC)/character.h \
$(GNU_LIB)/verify.h
+CCL_H = $(SRC)/ccl.h \
+ $(CHARACTER_H)
CHARSET_H = $(SRC)/charset.h \
$(GNU_LIB)/verify.h
CODING_H = $(SRC)/coding.h \
$(SRC)/composite.h
-MS_W32_H = $(SRC)/s/ms-w32.h \
+MS_W32_H = $(NT_INC)/ms-w32.h \
$(NT_INC)/sys/stat.h
-CONFIG_H = $(SRC)/config.h \
- $(SRC)/m/intel386.h \
+CONF_POST_H = $(SRC)/conf_post.h \
$(MS_W32_H)
-DIR_H = $(NT_INC)/sys/dir.h \
- $(SRC)/ndir.h
+CONFIG_H = $(SRC)/config.h \
+ $(CONF_POST_H)
W32GUI_H = $(SRC)/w32gui.h \
$(SYSTIME_H)
DISPEXTERN_H = $(SRC)/dispextern.h \
+ $(GNU_LIB)/c-strcase.h \
+ $(SYSTIME_H) \
$(W32GUI_H)
FILEMODE_H = $(GNU_LIB)/filemode.h \
$(NT_INC)/sys/stat.h
-FONT_H = $(SRC)/font.h \
- $(SRC)/ccl.h
FRAME_H = $(SRC)/frame.h \
$(DISPEXTERN_H)
+FONT_H = $(SRC)/font.h \
+ $(CCL_H) \
+ $(FRAME_H)
FTOASTR_H = $(GNU_LIB)/ftoastr.h \
$(GNU_LIB)/intprops.h
GRP_H = $(NT_INC)/grp.h \
@@ -437,7 +443,9 @@ LANGINFO_H = $(NT_INC)/langinfo.h \
LISP_H = $(SRC)/lisp.h \
$(SRC)/globals.h \
$(GNU_LIB)/intprops.h \
- $(INTTYPES_H)
+ $(INTTYPES_H) \
+ $(NT_INC)/stdalign.h \
+ $(NT_INC)/stdbool.h
MD5_H = $(GNU_LIB)/md5.h \
$(NT_INC)/stdint.h
MENU_H = $(SRC)/menu.h \
@@ -455,25 +463,35 @@ SHA512_H = $(GNU_LIB)/sha512.h \
$(U64_H)
SOCKET_H = $(NT_INC)/sys/socket.h \
$(SRC)/w32.h
+STAT_TIME_H = $(GNU_LIB)/stat-time.h \
+ $(NT_INC)/sys/stat.h
+SYSSIGNAL_H = $(SRC)/syssignal.h \
+ $(NT_INC)/stdbool.h
SYSTTY_H = $(SRC)/systty.h \
$(NT_INC)/sys/ioctl.h \
$(NT_INC)/unistd.h
+SYSWAIT_H = $(SRC)/syswait.h \
+ $(NT_INC)/sys/wait.h
TERMHOOKS_H = $(SRC)/termhooks.h \
$(SYSTIME_H)
+W32FONT_H = $(SRC)/w32font.h \
+ $(FONT_H)
W32TERM_H = $(SRC)/w32term.h \
+ $(ATIMER_H) \
+ $(FRAME_H) \
$(W32GUI_H)
WINDOW_H = $(SRC)/window.h \
$(DISPEXTERN_H)
$(BLD)/alloc.$(O) : \
$(SRC)/alloc.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/puresize.h \
- $(SRC)/syssignal.h \
$(SRC)/w32.h \
+ $(SRC)/w32heap.h \
$(NT_INC)/unistd.h \
$(GNU_LIB)/verify.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(FRAME_H) \
@@ -486,18 +504,17 @@ $(BLD)/alloc.$(O) : \
$(BLD)/atimer.$(O) : \
$(SRC)/atimer.c \
- $(SRC)/syssignal.h \
- $(NT_INC)/sys/time.h \
+ $(SRC)/blockinput.h \
$(NT_INC)/unistd.h \
$(ATIMER_H) \
- $(BLOCKINPUT_H) \
$(CONFIG_H) \
$(LISP_H) \
+ $(SYSSIGNAL_H) \
$(SYSTIME_H)
$(BLD)/bidi.$(O) : \
$(SRC)/bidi.c \
- $(SRC)/buffer.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
@@ -505,7 +522,7 @@ $(BLD)/bidi.$(O) : \
$(BLD)/buffer.$(O) : \
$(SRC)/buffer.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/indent.h \
$(SRC)/keymap.h \
@@ -514,7 +531,7 @@ $(BLD)/buffer.$(O) : \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
$(GNU_LIB)/verify.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(FRAME_H) \
@@ -525,8 +542,8 @@ $(BLD)/buffer.$(O) : \
$(BLD)/bytecode.$(O) : \
$(SRC)/bytecode.c \
- $(SRC)/buffer.h \
$(SRC)/syntax.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H) \
@@ -534,9 +551,9 @@ $(BLD)/bytecode.$(O) : \
$(BLD)/callint.$(O) : \
$(SRC)/callint.c \
- $(SRC)/buffer.h \
$(SRC)/commands.h \
$(SRC)/keymap.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(KEYBOARD_H) \
@@ -545,48 +562,49 @@ $(BLD)/callint.$(O) : \
$(BLD)/callproc.$(O) : \
$(SRC)/callproc.c \
- $(SRC)/buffer.h \
- $(SRC)/ccl.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(SRC)/epaths.h \
- $(SRC)/syssignal.h \
$(SRC)/w32.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
$(FRAME_H) \
$(LISP_H) \
$(PROCESS_H) \
+ $(SYSSIGNAL_H) \
$(SYSTTY_H) \
+ $(SYSWAIT_H) \
$(TERMHOOKS_H)
$(BLD)/casefiddle.$(O) : \
$(SRC)/casefiddle.c \
- $(SRC)/buffer.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(SRC)/keymap.h \
$(SRC)/syntax.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/casetab.$(O) : \
$(SRC)/casetab.c \
- $(SRC)/buffer.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/category.$(O) : \
$(SRC)/category.c \
- $(SRC)/buffer.h \
$(SRC)/category.h \
$(SRC)/keymap.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
@@ -594,7 +612,7 @@ $(BLD)/category.$(O) : \
$(BLD)/ccl.$(O) : \
$(SRC)/ccl.c \
- $(SRC)/ccl.h \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
@@ -603,10 +621,10 @@ $(BLD)/ccl.$(O) : \
$(BLD)/character.$(O) : \
$(SRC)/character.c \
- $(SRC)/buffer.h \
$(SRC)/composite.h \
$(SRC)/disptab.h \
$(GNU_LIB)/intprops.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
@@ -614,18 +632,19 @@ $(BLD)/character.$(O) : \
$(BLD)/charset.$(O) : \
$(SRC)/charset.c \
- $(SRC)/buffer.h \
$(SRC)/disptab.h \
$(NT_INC)/unistd.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(LISP_H)
$(BLD)/chartab.$(O) : \
$(SRC)/chartab.c \
- $(SRC)/ccl.h \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
@@ -633,10 +652,10 @@ $(BLD)/chartab.$(O) : \
$(BLD)/cmds.$(O) : \
$(SRC)/cmds.c \
- $(SRC)/buffer.h \
$(SRC)/commands.h \
$(SRC)/keymap.h \
$(SRC)/syntax.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
@@ -647,9 +666,9 @@ $(BLD)/cmds.$(O) : \
$(BLD)/coding.$(O) : \
$(SRC)/coding.c \
- $(SRC)/buffer.h \
- $(SRC)/ccl.h \
$(SRC)/composite.h \
+ $(BUFFER_H) \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
@@ -661,7 +680,7 @@ $(BLD)/coding.$(O) : \
$(BLD)/composite.$(O) : \
$(SRC)/composite.c \
- $(SRC)/buffer.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
@@ -675,49 +694,51 @@ $(BLD)/composite.$(O) : \
$(BLD)/data.$(O) : \
$(SRC)/data.c \
- $(SRC)/buffer.h \
+ $(SRC)/keymap.h \
$(SRC)/puresize.h \
- $(SRC)/syssignal.h \
$(GNU_LIB)/intprops.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(FONT_H) \
$(FRAME_H) \
$(KEYBOARD_H) \
$(LISP_H) \
+ $(SYSSIGNAL_H) \
$(TERMHOOKS_H)
$(BLD)/dired.$(O) : \
$(SRC)/dired.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/regex.h \
+ $(NT_INC)/dirent.h \
$(NT_INC)/pwd.h \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(CONFIG_H) \
- $(DIR_H) \
$(FILEMODE_H) \
$(GRP_H) \
$(LISP_H) \
+ $(STAT_TIME_H) \
$(SYSTIME_H)
$(BLD)/dispnew.$(O) : \
$(SRC)/dispnew.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/cm.h \
$(SRC)/commands.h \
$(SRC)/disptab.h \
$(SRC)/indent.h \
- $(SRC)/syssignal.h \
$(SRC)/termchar.h \
- $(SRC)/termopts.h \
+ $(SRC)/w32.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(GNU_LIB)/fpending.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
@@ -726,6 +747,7 @@ $(BLD)/dispnew.$(O) : \
$(KEYBOARD_H) \
$(LISP_H) \
$(PROCESS_H) \
+ $(SYSSIGNAL_H) \
$(SYSTIME_H) \
$(TERMHOOKS_H) \
$(W32TERM_H) \
@@ -733,13 +755,14 @@ $(BLD)/dispnew.$(O) : \
$(BLD)/doc.$(O) : \
$(SRC)/doc.c \
- $(SRC)/buffer.h \
$(SRC)/buildobj.h \
$(SRC)/keymap.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/unistd.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(KEYBOARD_H) \
$(LISP_H)
@@ -752,13 +775,13 @@ $(BLD)/doprnt.$(O) : \
$(BLD)/editfns.$(O) : \
$(SRC)/editfns.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(NT_INC)/pwd.h \
$(NT_INC)/unistd.h \
$(GNU_LIB)/intprops.h \
$(GNU_LIB)/strftime.h \
$(GNU_LIB)/verify.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
@@ -770,31 +793,38 @@ $(BLD)/editfns.$(O) : \
$(BLD)/emacs.$(O) : \
$(SRC)/emacs.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/gnutls.h \
$(SRC)/keymap.h \
- $(SRC)/syssignal.h \
$(SRC)/unexec.h \
$(SRC)/w32.h \
$(SRC)/w32heap.h \
+ $(SRC)/w32select.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(GNU_LIB)/close-stream.h \
+ $(GNU_LIB)/ignore-value.h \
+ $(ATIMER_H) \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(FRAME_H) \
$(INTERVALS_H) \
$(KEYBOARD_H) \
$(LISP_H) \
$(PROCESS_H) \
+ $(SYSSIGNAL_H) \
$(SYSTTY_H) \
$(TERMHOOKS_H) \
+ $(W32FONT_H) \
+ $(W32TERM_H) \
$(WINDOW_H)
$(BLD)/eval.$(O) : \
$(SRC)/eval.c \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
- $(BLOCKINPUT_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
@@ -803,29 +833,33 @@ $(BLD)/eval.$(O) : \
$(BLD)/fileio.$(O) : \
$(SRC)/fileio.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
+ $(SRC)/w32.h \
$(NT_INC)/pwd.h \
+ $(NT_INC)/sys/file.h \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
$(INTERVALS_H) \
$(LISP_H) \
+ $(STAT_TIME_H) \
$(SYSTIME_H) \
$(WINDOW_H)
$(BLD)/filelock.$(O) : \
$(SRC)/filelock.c \
- $(SRC)/buffer.h \
$(NT_INC)/pwd.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
@@ -838,18 +872,17 @@ $(BLD)/firstfile.$(O) : \
$(BLD)/floatfns.$(O) : \
$(SRC)/floatfns.c \
- $(SRC)/syssignal.h \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/fns.$(O) : \
$(SRC)/fns.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/keymap.h \
$(NT_INC)/unistd.h \
$(GNU_LIB)/intprops.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
@@ -866,12 +899,13 @@ $(BLD)/fns.$(O) : \
$(BLD)/font.$(O) : \
$(SRC)/font.c \
- $(SRC)/buffer.h \
$(SRC)/composite.h \
$(SRC)/fontset.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(DISPEXTERN_H) \
$(FONT_H) \
$(FRAME_H) \
@@ -881,10 +915,10 @@ $(BLD)/font.$(O) : \
$(BLD)/fontset.$(O) : \
$(SRC)/fontset.c \
- $(SRC)/buffer.h \
- $(SRC)/ccl.h \
+ $(SRC)/blockinput.h \
$(SRC)/fontset.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
@@ -900,13 +934,14 @@ $(BLD)/fontset.$(O) : \
$(BLD)/frame.$(O) : \
$(SRC)/frame.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/fontset.h \
$(SRC)/termchar.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(DISPEXTERN_H) \
$(FONT_H) \
$(FRAME_H) \
@@ -918,8 +953,9 @@ $(BLD)/frame.$(O) : \
$(BLD)/fringe.$(O) : \
$(SRC)/fringe.c \
- $(SRC)/buffer.h \
- $(BLOCKINPUT_H) \
+ $(SRC)/blockinput.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
@@ -929,7 +965,8 @@ $(BLD)/fringe.$(O) : \
$(BLD)/gmalloc.$(O) : \
$(SRC)/gmalloc.c \
- $(SRC)/getpagesize.h \
+ $(SRC)/w32heap.h \
+ $(NT_INC)/stdint.h \
$(NT_INC)/unistd.h \
$(CONFIG_H)
@@ -940,15 +977,31 @@ $(BLD)/gnutls.$(O) : \
$(LISP_H) \
$(PROCESS_H)
+$(BLD)/xml.$(O) : \
+ $(SRC)/xml.c \
+ $(SRC)/w32.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(LISP_H)
+
+$(BLD)/profiler.$(O) : \
+ $(SRC)/profiler.c \
+ $(CONFIG_H) \
+ $(LISP_H) \
+ $(SYSSIGNAL_H) \
+ $(SYSTIME_H)
+
$(BLD)/image.$(O) : \
$(SRC)/image.c \
+ $(SRC)/blockinput.h \
$(SRC)/epaths.h \
$(SRC)/w32.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(DISPEXTERN_H) \
$(FONT_H) \
$(FRAME_H) \
@@ -960,14 +1013,13 @@ $(BLD)/image.$(O) : \
$(BLD)/indent.$(O) : \
$(SRC)/indent.c \
- $(SRC)/buffer.h \
$(SRC)/category.h \
$(SRC)/composite.h \
$(SRC)/disptab.h \
$(SRC)/indent.h \
$(SRC)/region-cache.h \
$(SRC)/termchar.h \
- $(SRC)/termopts.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
@@ -979,10 +1031,10 @@ $(BLD)/indent.$(O) : \
$(BLD)/insdel.$(O) : \
$(SRC)/insdel.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/region-cache.h \
$(GNU_LIB)/intprops.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(INTERVALS_H) \
@@ -991,10 +1043,11 @@ $(BLD)/insdel.$(O) : \
$(BLD)/intervals.$(O) : \
$(SRC)/intervals.c \
- $(SRC)/buffer.h \
$(SRC)/keymap.h \
$(SRC)/puresize.h \
$(GNU_LIB)/intprops.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(INTERVALS_H) \
$(KEYBOARD_H) \
@@ -1002,20 +1055,19 @@ $(BLD)/intervals.$(O) : \
$(BLD)/keyboard.$(O) : \
$(SRC)/keyboard.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/disptab.h \
$(SRC)/keymap.h \
$(SRC)/macros.h \
$(SRC)/puresize.h \
$(SRC)/syntax.h \
- $(SRC)/syssignal.h \
$(SRC)/termchar.h \
$(SRC)/termopts.h \
$(NT_INC)/sys/ioctl.h \
$(NT_INC)/unistd.h \
$(ATIMER_H) \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
@@ -1024,6 +1076,7 @@ $(BLD)/keyboard.$(O) : \
$(KEYBOARD_H) \
$(LISP_H) \
$(PROCESS_H) \
+ $(SYSSIGNAL_H) \
$(SYSTIME_H) \
$(TERMHOOKS_H) \
$(W32TERM_H) \
@@ -1031,11 +1084,11 @@ $(BLD)/keyboard.$(O) : \
$(BLD)/keymap.$(O) : \
$(SRC)/keymap.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/keymap.h \
$(SRC)/puresize.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
@@ -1052,13 +1105,13 @@ $(BLD)/lastfile.$(O) : \
$(BLD)/lread.$(O) : \
$(SRC)/lread.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/epaths.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
@@ -1067,13 +1120,15 @@ $(BLD)/lread.$(O) : \
$(INTERVALS_H) \
$(KEYBOARD_H) \
$(LISP_H) \
+ $(STAT_TIME_H) \
$(TERMHOOKS_H)
$(BLD)/macros.$(O) : \
$(SRC)/macros.c \
- $(SRC)/buffer.h \
$(SRC)/commands.h \
$(SRC)/macros.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(KEYBOARD_H) \
$(LISP_H) \
@@ -1081,15 +1136,15 @@ $(BLD)/macros.$(O) : \
$(BLD)/marker.$(O) : \
$(SRC)/marker.c \
- $(SRC)/buffer.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/menu.$(O) : \
$(SRC)/menu.c \
+ $(SRC)/blockinput.h \
$(SRC)/keymap.h \
- $(BLOCKINPUT_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
@@ -1102,10 +1157,11 @@ $(BLD)/menu.$(O) : \
$(BLD)/minibuf.$(O) : \
$(SRC)/minibuf.c \
- $(SRC)/buffer.h \
$(SRC)/commands.h \
$(SRC)/keymap.h \
$(SRC)/syntax.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
@@ -1117,9 +1173,11 @@ $(BLD)/minibuf.$(O) : \
$(BLD)/w32.$(O) : \
$(SRC)/w32.c \
- $(SRC)/ndir.h \
$(SRC)/w32.h \
+ $(SRC)/w32common.h \
$(SRC)/w32heap.h \
+ $(SRC)/w32select.h \
+ $(NT_INC)/dirent.h \
$(NT_INC)/pwd.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/sys/time.h \
@@ -1136,27 +1194,30 @@ $(BLD)/w32.$(O) : \
$(BLD)/w32heap.$(O) : \
$(SRC)/w32heap.c \
+ $(SRC)/w32common.h \
$(SRC)/w32heap.h \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/w32inevt.$(O) : \
$(SRC)/w32inevt.c \
+ $(SRC)/blockinput.h \
+ $(SRC)/termchar.h \
$(SRC)/w32heap.h \
- $(BLOCKINPUT_H) \
+ $(SRC)/w32inevt.h \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
$(KEYBOARD_H) \
$(LISP_H) \
$(TERMHOOKS_H) \
- $(W32TERM_H)
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/w32proc.$(O) : \
$(SRC)/w32proc.c \
- $(SRC)/syssignal.h \
- $(SRC)/syswait.h \
$(SRC)/w32.h \
+ $(SRC)/w32common.h \
$(SRC)/w32heap.h \
$(NT_INC)/nl_types.h \
$(NT_INC)/sys/file.h \
@@ -1166,13 +1227,16 @@ $(BLD)/w32proc.$(O) : \
$(LANGINFO_H) \
$(LISP_H) \
$(PROCESS_H) \
+ $(SYSSIGNAL_H) \
$(SYSTIME_H) \
+ $(SYSWAIT_H) \
$(W32TERM_H)
$(BLD)/w32console.$(O) : \
$(SRC)/w32console.c \
$(SRC)/disptab.h \
$(SRC)/termchar.h \
+ $(SRC)/w32common.h \
$(SRC)/w32inevt.h \
$(CHARACTER_H) \
$(CODING_H) \
@@ -1180,13 +1244,15 @@ $(BLD)/w32console.$(O) : \
$(DISPEXTERN_H) \
$(FRAME_H) \
$(LISP_H) \
- $(TERMHOOKS_H)
+ $(TERMHOOKS_H) \
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/print.$(O) : \
$(SRC)/print.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/termchar.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
@@ -1203,13 +1269,11 @@ $(BLD)/print.$(O) : \
$(BLD)/process.$(O) : \
$(SRC)/process.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(SRC)/gnutls.h \
$(SRC)/sysselect.h \
- $(SRC)/syssignal.h \
- $(SRC)/syswait.h \
$(SRC)/termopts.h \
$(NT_INC)/arpa/inet.h \
$(NT_INC)/netdb.h \
@@ -1219,7 +1283,7 @@ $(BLD)/process.$(O) : \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
$(ATIMER_H) \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
@@ -1229,34 +1293,37 @@ $(BLD)/process.$(O) : \
$(LISP_H) \
$(PROCESS_H) \
$(SOCKET_H) \
+ $(SYSSIGNAL_H) \
$(SYSTIME_H) \
$(SYSTTY_H) \
+ $(SYSWAIT_H) \
$(TERMHOOKS_H) \
+ $(W32TERM_H) \
$(WINDOW_H)
$(BLD)/ralloc.$(O) : \
$(SRC)/ralloc.c \
+ $(SRC)/blockinput.h \
$(SRC)/getpagesize.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/regex.$(O) : \
$(SRC)/regex.c \
- $(SRC)/buffer.h \
$(SRC)/category.h \
$(SRC)/regex.h \
$(SRC)/syntax.h \
- $(NT_INC)/unistd.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/region-cache.$(O) : \
$(SRC)/region-cache.c \
- $(SRC)/buffer.h \
$(SRC)/region-cache.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H)
@@ -1273,13 +1340,13 @@ $(BLD)/scroll.$(O) : \
$(BLD)/search.$(O) : \
$(SRC)/search.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/category.h \
$(SRC)/commands.h \
$(SRC)/regex.h \
$(SRC)/region-cache.h \
$(SRC)/syntax.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
@@ -1288,21 +1355,21 @@ $(BLD)/search.$(O) : \
$(BLD)/sound.$(O) : \
$(SRC)/sound.c \
- $(SRC)/syssignal.h \
$(NT_INC)/unistd.h \
$(ATIMER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
- $(LISP_H)
+ $(LISP_H) \
+ $(SYSSIGNAL_H)
$(BLD)/syntax.$(O) : \
$(SRC)/syntax.c \
- $(SRC)/buffer.h \
$(SRC)/category.h \
$(SRC)/commands.h \
$(SRC)/keymap.h \
$(SRC)/regex.h \
$(SRC)/syntax.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(INTERVALS_H) \
@@ -1310,10 +1377,9 @@ $(BLD)/syntax.$(O) : \
$(BLD)/sysdep.$(O) : \
$(SRC)/sysdep.c \
+ $(SRC)/blockinput.h \
$(SRC)/cm.h \
$(SRC)/sysselect.h \
- $(SRC)/syssignal.h \
- $(SRC)/syswait.h \
$(SRC)/termchar.h \
$(SRC)/termopts.h \
$(NT_INC)/netdb.h \
@@ -1322,10 +1388,12 @@ $(BLD)/sysdep.$(O) : \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
$(GNU_LIB)/allocator.h \
+ $(GNU_LIB)/execinfo.h \
$(GNU_LIB)/ignore-value.h \
- $(BLOCKINPUT_H) \
+ $(GNU_LIB)/utimens.h \
$(CAREADLINKAT_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
$(GRP_H) \
@@ -1333,25 +1401,26 @@ $(BLD)/sysdep.$(O) : \
$(LISP_H) \
$(PROCESS_H) \
$(SOCKET_H) \
+ $(SYSSIGNAL_H) \
$(SYSTIME_H) \
$(SYSTTY_H) \
+ $(SYSWAIT_H) \
$(TERMHOOKS_H) \
$(WINDOW_H)
$(BLD)/term.$(O) : \
$(SRC)/term.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/cm.h \
$(SRC)/composite.h \
$(SRC)/disptab.h \
$(SRC)/keymap.h \
- $(SRC)/syssignal.h \
$(SRC)/termchar.h \
- $(SRC)/termopts.h \
$(SRC)/tparam.h \
$(NT_INC)/sys/file.h \
+ $(NT_INC)/sys/time.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
@@ -1361,8 +1430,10 @@ $(BLD)/term.$(O) : \
$(INTERVALS_H) \
$(KEYBOARD_H) \
$(LISP_H) \
+ $(SYSSIGNAL_H) \
$(SYSTTY_H) \
$(TERMHOOKS_H) \
+ $(W32TERM_H) \
$(WINDOW_H)
$(BLD)/terminal.$(O) : \
@@ -1378,7 +1449,8 @@ $(BLD)/terminal.$(O) : \
$(BLD)/textprop.$(O) : \
$(SRC)/textprop.c \
- $(SRC)/buffer.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(INTERVALS_H) \
$(LISP_H) \
@@ -1392,8 +1464,9 @@ $(BLD)/tparam.$(O) : \
$(BLD)/undo.$(O) : \
$(SRC)/undo.c \
- $(SRC)/buffer.h \
$(SRC)/commands.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H) \
$(WINDOW_H)
@@ -1401,24 +1474,30 @@ $(BLD)/undo.$(O) : \
$(BLD)/unexw32.$(O) : \
$(SRC)/unexw32.c \
$(SRC)/unexec.h \
+ $(SRC)/w32.h \
+ $(SRC)/w32common.h \
$(SRC)/w32heap.h \
- $(CONFIG_H)
+ $(CONFIG_H) \
+ $(LISP_H)
$(BLD)/vm-limit.$(O) : \
$(SRC)/vm-limit.c \
$(SRC)/mem-limits.h \
+ $(SRC)/w32heap.h \
+ $(NT_INC)/unistd.h \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/window.$(O) : \
$(SRC)/window.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/disptab.h \
$(SRC)/indent.h \
$(SRC)/keymap.h \
$(SRC)/termchar.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
@@ -1431,7 +1510,7 @@ $(BLD)/window.$(O) : \
$(BLD)/xdisp.$(O) : \
$(SRC)/xdisp.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/disptab.h \
$(SRC)/fontset.h \
@@ -1441,7 +1520,8 @@ $(BLD)/xdisp.$(O) : \
$(SRC)/region-cache.h \
$(SRC)/termchar.h \
$(SRC)/termopts.h \
- $(BLOCKINPUT_H) \
+ $(ATIMER_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
@@ -1459,14 +1539,15 @@ $(BLD)/xdisp.$(O) : \
$(BLD)/xfaces.$(O) : \
$(SRC)/xfaces.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/fontset.h \
$(SRC)/termchar.h \
$(NT_INC)/sys/stat.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(DISPEXTERN_H) \
$(FONT_H) \
$(FRAME_H) \
@@ -1479,14 +1560,15 @@ $(BLD)/xfaces.$(O) : \
$(BLD)/w32fns.$(O) : \
$(SRC)/w32fns.c \
- $(SRC)/buffer.h \
- $(SRC)/ccl.h \
+ $(SRC)/blockinput.h \
$(SRC)/epaths.h \
$(SRC)/fontset.h \
$(SRC)/w32.h \
- $(SRC)/w32font.h \
+ $(SRC)/w32common.h \
$(SRC)/w32heap.h \
- $(BLOCKINPUT_H) \
+ $(NT_INC)/unistd.h \
+ $(BUFFER_H) \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
@@ -1499,14 +1581,17 @@ $(BLD)/w32fns.$(O) : \
$(LISP_H) \
$(SYSTIME_H) \
$(TERMHOOKS_H) \
+ $(W32FONT_H) \
$(W32TERM_H) \
$(WINDOW_H)
$(BLD)/w32menu.$(O) : \
$(SRC)/w32menu.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/keymap.h \
- $(BLOCKINPUT_H) \
+ $(SRC)/w32common.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(CONFIG_H) \
@@ -1521,18 +1606,17 @@ $(BLD)/w32menu.$(O) : \
$(BLD)/w32term.$(O) : \
$(SRC)/w32term.c \
- $(SRC)/buffer.h \
- $(SRC)/ccl.h \
+ $(SRC)/blockinput.h \
$(SRC)/disptab.h \
$(SRC)/fontset.h \
$(SRC)/keymap.h \
$(SRC)/termchar.h \
$(SRC)/termopts.h \
- $(SRC)/w32font.h \
$(SRC)/w32heap.h \
$(NT_INC)/sys/stat.h \
$(ATIMER_H) \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
@@ -1547,31 +1631,33 @@ $(BLD)/w32term.$(O) : \
$(SYSTIME_H) \
$(SYSTTY_H) \
$(TERMHOOKS_H) \
+ $(W32FONT_H) \
$(W32TERM_H) \
$(WINDOW_H)
$(BLD)/w32select.$(O) : \
$(SRC)/w32select.c \
+ $(SRC)/blockinput.h \
$(SRC)/composite.h \
- $(SRC)/w32heap.h \
- $(BLOCKINPUT_H) \
+ $(SRC)/w32common.h \
$(CHARSET_H) \
$(CODING_H) \
$(CONFIG_H) \
+ $(KEYBOARD_H) \
$(LISP_H) \
$(W32TERM_H)
$(BLD)/w32reg.$(O) : \
$(SRC)/w32reg.c \
- $(BLOCKINPUT_H) \
+ $(SRC)/blockinput.h \
$(CONFIG_H) \
$(LISP_H) \
$(W32TERM_H)
$(BLD)/w32xfns.$(O) : \
$(SRC)/w32xfns.c \
+ $(SRC)/blockinput.h \
$(SRC)/fontset.h \
- $(BLOCKINPUT_H) \
$(CHARSET_H) \
$(CONFIG_H) \
$(FRAME_H) \
@@ -1582,7 +1668,6 @@ $(BLD)/w32xfns.$(O) : \
$(BLD)/w32font.$(O) : \
$(SRC)/w32font.c \
$(SRC)/fontset.h \
- $(SRC)/w32font.h \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
@@ -1591,13 +1676,13 @@ $(BLD)/w32font.$(O) : \
$(FONT_H) \
$(FRAME_H) \
$(LISP_H) \
+ $(W32FONT_H) \
$(W32TERM_H)
$(BLD)/w32uniscribe.$(O) : \
$(SRC)/w32uniscribe.c \
$(SRC)/composite.h \
$(SRC)/fontset.h \
- $(SRC)/w32font.h \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
@@ -1605,6 +1690,7 @@ $(BLD)/w32uniscribe.$(O) : \
$(FONT_H) \
$(FRAME_H) \
$(LISP_H) \
+ $(W32FONT_H) \
$(W32TERM_H)
# Each object file depends on stamp_BLD, because in parallel builds we must
diff --git a/src/marker.c b/src/marker.c
index 675bbc5ad73..69be4faec3a 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -1,5 +1,5 @@
/* Markers: examining, setting and deleting.
- Copyright (C) 1985, 1997-1998, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1997-1998, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -18,20 +18,55 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
/* Record one cached position found recently by
buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
-static EMACS_INT cached_charpos;
-static EMACS_INT cached_bytepos;
+static ptrdiff_t cached_charpos;
+static ptrdiff_t cached_bytepos;
static struct buffer *cached_buffer;
-static int cached_modiff;
+static EMACS_INT cached_modiff;
+
+/* Juanma Barranquero <lekktu@gmail.com> reported ~3x increased
+ bootstrap time when byte_char_debug_check is enabled; so this
+ is never turned on by --enable-checking configure option. */
+
+#ifdef MARKER_DEBUG
+
+extern int count_markers (struct buffer *) EXTERNALLY_VISIBLE;
+extern ptrdiff_t verify_bytepos (ptrdiff_t charpos) EXTERNALLY_VISIBLE;
+
+static void
+byte_char_debug_check (struct buffer *b, ptrdiff_t charpos, ptrdiff_t bytepos)
+{
+ ptrdiff_t nchars;
+
+ if (NILP (BVAR (b, enable_multibyte_characters)))
+ return;
+
+ if (bytepos > BUF_GPT_BYTE (b))
+ nchars
+ = multibyte_chars_in_text (BUF_BEG_ADDR (b),
+ BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b))
+ + multibyte_chars_in_text (BUF_GAP_END_ADDR (b),
+ bytepos - BUF_GPT_BYTE (b));
+ else
+ nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
+ bytepos - BUF_BEG_BYTE (b));
+
+ if (charpos - 1 != nchars)
+ emacs_abort ();
+}
-static void byte_char_debug_check (struct buffer *, EMACS_INT, EMACS_INT);
+#else /* not MARKER_DEBUG */
+
+#define byte_char_debug_check(b, charpos, bytepos) do { } while (0)
+
+#endif /* MARKER_DEBUG */
void
clear_charpos_cache (struct buffer *b)
@@ -55,14 +90,14 @@ clear_charpos_cache (struct buffer *b)
#define CONSIDER(CHARPOS, BYTEPOS) \
{ \
- EMACS_INT this_charpos = (CHARPOS); \
- int changed = 0; \
+ ptrdiff_t this_charpos = (CHARPOS); \
+ bool changed = 0; \
\
if (this_charpos == charpos) \
{ \
- EMACS_INT value = (BYTEPOS); \
- if (byte_debug_flag) \
- byte_char_debug_check (b, charpos, value); \
+ ptrdiff_t value = (BYTEPOS); \
+ \
+ byte_char_debug_check (b, charpos, value); \
return value; \
} \
else if (this_charpos > charpos) \
@@ -85,49 +120,29 @@ clear_charpos_cache (struct buffer *b)
{ \
if (best_above - best_below == best_above_byte - best_below_byte) \
{ \
- EMACS_INT value = best_below_byte + (charpos - best_below); \
- if (byte_debug_flag) \
- byte_char_debug_check (b, charpos, value); \
+ ptrdiff_t value = best_below_byte + (charpos - best_below); \
+ \
+ byte_char_debug_check (b, charpos, value); \
return value; \
} \
} \
}
-static void
-byte_char_debug_check (struct buffer *b, EMACS_INT charpos, EMACS_INT bytepos)
-{
- EMACS_INT nchars = 0;
-
- if (bytepos > BUF_GPT_BYTE (b))
- {
- nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
- BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b));
- nchars += multibyte_chars_in_text (BUF_GAP_END_ADDR (b),
- bytepos - BUF_GPT_BYTE (b));
- }
- else
- nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
- bytepos - BUF_BEG_BYTE (b));
-
- if (charpos - 1 != nchars)
- abort ();
-}
-
-EMACS_INT
-charpos_to_bytepos (EMACS_INT charpos)
+ptrdiff_t
+charpos_to_bytepos (ptrdiff_t charpos)
{
return buf_charpos_to_bytepos (current_buffer, charpos);
}
-EMACS_INT
-buf_charpos_to_bytepos (struct buffer *b, EMACS_INT charpos)
+ptrdiff_t
+buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
{
struct Lisp_Marker *tail;
- EMACS_INT best_above, best_above_byte;
- EMACS_INT best_below, best_below_byte;
+ ptrdiff_t best_above, best_above_byte;
+ ptrdiff_t best_below, best_below_byte;
if (charpos < BUF_BEG (b) || charpos > BUF_Z (b))
- abort ();
+ emacs_abort ();
best_above = BUF_Z (b);
best_above_byte = BUF_Z_BYTE (b);
@@ -175,7 +190,7 @@ buf_charpos_to_bytepos (struct buffer *b, EMACS_INT charpos)
if (charpos - best_below < best_above - charpos)
{
- int record = charpos - best_below > 5000;
+ bool record = charpos - best_below > 5000;
while (best_below != charpos)
{
@@ -187,15 +202,9 @@ buf_charpos_to_bytepos (struct buffer *b, EMACS_INT charpos)
cache the correspondence by creating a marker here.
It will last until the next GC. */
if (record)
- {
- Lisp_Object marker, buffer;
- marker = Fmake_marker ();
- XSETBUFFER (buffer, b);
- set_marker_both (marker, buffer, best_below, best_below_byte);
- }
+ build_marker (b, best_below, best_below_byte);
- if (byte_debug_flag)
- byte_char_debug_check (b, charpos, best_below_byte);
+ byte_char_debug_check (b, best_below, best_below_byte);
cached_buffer = b;
cached_modiff = BUF_MODIFF (b);
@@ -206,7 +215,7 @@ buf_charpos_to_bytepos (struct buffer *b, EMACS_INT charpos)
}
else
{
- int record = best_above - charpos > 5000;
+ bool record = best_above - charpos > 5000;
while (best_above != charpos)
{
@@ -218,15 +227,9 @@ buf_charpos_to_bytepos (struct buffer *b, EMACS_INT charpos)
cache the correspondence by creating a marker here.
It will last until the next GC. */
if (record)
- {
- Lisp_Object marker, buffer;
- marker = Fmake_marker ();
- XSETBUFFER (buffer, b);
- set_marker_both (marker, buffer, best_above, best_above_byte);
- }
+ build_marker (b, best_above, best_above_byte);
- if (byte_debug_flag)
- byte_char_debug_check (b, charpos, best_above_byte);
+ byte_char_debug_check (b, best_above, best_above_byte);
cached_buffer = b;
cached_modiff = BUF_MODIFF (b);
@@ -239,25 +242,6 @@ buf_charpos_to_bytepos (struct buffer *b, EMACS_INT charpos)
#undef CONSIDER
-/* Used for debugging: recompute the bytepos corresponding to CHARPOS
- in the simplest, most reliable way. */
-
-extern EMACS_INT verify_bytepos (EMACS_INT charpos) EXTERNALLY_VISIBLE;
-EMACS_INT
-verify_bytepos (EMACS_INT charpos)
-{
- EMACS_INT below = 1;
- EMACS_INT below_byte = 1;
-
- while (below != charpos)
- {
- below++;
- BUF_INC_POS (current_buffer, below_byte);
- }
-
- return below_byte;
-}
-
/* buf_bytepos_to_charpos returns the char position corresponding to
BYTEPOS. */
@@ -266,14 +250,14 @@ verify_bytepos (EMACS_INT charpos)
#define CONSIDER(BYTEPOS, CHARPOS) \
{ \
- EMACS_INT this_bytepos = (BYTEPOS); \
+ ptrdiff_t this_bytepos = (BYTEPOS); \
int changed = 0; \
\
if (this_bytepos == bytepos) \
{ \
- EMACS_INT value = (CHARPOS); \
- if (byte_debug_flag) \
- byte_char_debug_check (b, value, bytepos); \
+ ptrdiff_t value = (CHARPOS); \
+ \
+ byte_char_debug_check (b, value, bytepos); \
return value; \
} \
else if (this_bytepos > bytepos) \
@@ -296,23 +280,23 @@ verify_bytepos (EMACS_INT charpos)
{ \
if (best_above - best_below == best_above_byte - best_below_byte) \
{ \
- EMACS_INT value = best_below + (bytepos - best_below_byte); \
- if (byte_debug_flag) \
- byte_char_debug_check (b, value, bytepos); \
+ ptrdiff_t value = best_below + (bytepos - best_below_byte); \
+ \
+ byte_char_debug_check (b, value, bytepos); \
return value; \
} \
} \
}
-EMACS_INT
-buf_bytepos_to_charpos (struct buffer *b, EMACS_INT bytepos)
+ptrdiff_t
+buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
{
struct Lisp_Marker *tail;
- EMACS_INT best_above, best_above_byte;
- EMACS_INT best_below, best_below_byte;
+ ptrdiff_t best_above, best_above_byte;
+ ptrdiff_t best_below, best_below_byte;
if (bytepos < BUF_BEG_BYTE (b) || bytepos > BUF_Z_BYTE (b))
- abort ();
+ emacs_abort ();
best_above = BUF_Z (b);
best_above_byte = BUF_Z_BYTE (b);
@@ -351,7 +335,7 @@ buf_bytepos_to_charpos (struct buffer *b, EMACS_INT bytepos)
if (bytepos - best_below_byte < best_above_byte - bytepos)
{
- int record = bytepos - best_below_byte > 5000;
+ bool record = bytepos - best_below_byte > 5000;
while (best_below_byte < bytepos)
{
@@ -365,15 +349,9 @@ buf_bytepos_to_charpos (struct buffer *b, EMACS_INT bytepos)
But don't do it if BUF_MARKERS is nil;
that is a signal from Fset_buffer_multibyte. */
if (record && BUF_MARKERS (b))
- {
- Lisp_Object marker, buffer;
- marker = Fmake_marker ();
- XSETBUFFER (buffer, b);
- set_marker_both (marker, buffer, best_below, best_below_byte);
- }
+ build_marker (b, best_below, best_below_byte);
- if (byte_debug_flag)
- byte_char_debug_check (b, best_below, bytepos);
+ byte_char_debug_check (b, best_below, best_below_byte);
cached_buffer = b;
cached_modiff = BUF_MODIFF (b);
@@ -384,7 +362,7 @@ buf_bytepos_to_charpos (struct buffer *b, EMACS_INT bytepos)
}
else
{
- int record = best_above_byte - bytepos > 5000;
+ bool record = best_above_byte - bytepos > 5000;
while (best_above_byte > bytepos)
{
@@ -398,15 +376,9 @@ buf_bytepos_to_charpos (struct buffer *b, EMACS_INT bytepos)
But don't do it if BUF_MARKERS is nil;
that is a signal from Fset_buffer_multibyte. */
if (record && BUF_MARKERS (b))
- {
- Lisp_Object marker, buffer;
- marker = Fmake_marker ();
- XSETBUFFER (buffer, b);
- set_marker_both (marker, buffer, best_above, best_above_byte);
- }
+ build_marker (b, best_above, best_above_byte);
- if (byte_debug_flag)
- byte_char_debug_check (b, best_above, bytepos);
+ byte_char_debug_check (b, best_above, best_above_byte);
cached_buffer = b;
cached_modiff = BUF_MODIFF (b);
@@ -435,7 +407,7 @@ Returns nil if MARKER points into a dead buffer. */)
does not preserve the buffer from being GC'd (it's weak), so
markers have to be unlinked from their buffer as soon as the buffer
is killed. */
- eassert (!NILP (BVAR (XBUFFER (buf), name)));
+ eassert (BUFFER_LIVE_P (XBUFFER (buf)));
return buf;
}
return Qnil;
@@ -452,72 +424,22 @@ Returns nil if MARKER points nowhere. */)
return Qnil;
}
-
-DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
- doc: /* Position MARKER before character number POSITION in BUFFER.
-BUFFER defaults to the current buffer.
-If POSITION is nil, makes marker point nowhere.
-Then it no longer slows down editing in any buffer.
-Returns MARKER. */)
- (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
-{
- register EMACS_INT charno, bytepos;
- register struct buffer *b;
- register struct Lisp_Marker *m;
- CHECK_MARKER (marker);
- m = XMARKER (marker);
-
- /* If position is nil or a marker that points nowhere,
- make this marker point nowhere. */
- if (NILP (position)
- || (MARKERP (position) && !XMARKER (position)->buffer))
- {
- unchain_marker (m);
- return marker;
- }
+/* Change M so it points to B at CHARPOS and BYTEPOS. */
- if (NILP (buffer))
- b = current_buffer;
+static void
+attach_marker (struct Lisp_Marker *m, struct buffer *b,
+ ptrdiff_t charpos, ptrdiff_t bytepos)
+{
+ /* In a single-byte buffer, two positions must be equal.
+ Otherwise, every character is at least one byte. */
+ if (BUF_Z (b) == BUF_Z_BYTE (b))
+ eassert (charpos == bytepos);
else
- {
- CHECK_BUFFER (buffer);
- b = XBUFFER (buffer);
- /* If buffer is dead, set marker to point nowhere. */
- if (EQ (BVAR (b, name), Qnil))
- {
- unchain_marker (m);
- return marker;
- }
- }
-
- /* Optimize the special case where we are copying the position
- of an existing marker, and MARKER is already in the same buffer. */
- if (MARKERP (position) && b == XMARKER (position)->buffer
- && b == m->buffer)
- {
- m->bytepos = XMARKER (position)->bytepos;
- m->charpos = XMARKER (position)->charpos;
- return marker;
- }
-
- CHECK_NUMBER_COERCE_MARKER (position);
-
- charno = XINT (position);
-
- if (charno < BUF_BEG (b))
- charno = BUF_BEG (b);
- if (charno > BUF_Z (b))
- charno = BUF_Z (b);
-
- bytepos = buf_charpos_to_bytepos (b, charno);
-
- /* Every character is at least one byte. */
- if (charno > bytepos)
- abort ();
+ eassert (charpos <= bytepos);
+ m->charpos = charpos;
m->bytepos = bytepos;
- m->charpos = charno;
if (m->buffer != b)
{
@@ -526,248 +448,184 @@ Returns MARKER. */)
m->next = BUF_MARKERS (b);
BUF_MARKERS (b) = m;
}
-
- return marker;
}
-/* This version of Fset_marker won't let the position
- be outside the visible part. */
+/* If BUFFER is nil, return current buffer pointer. Next, check
+ whether BUFFER is a buffer object and return buffer pointer
+ corresponding to BUFFER if BUFFER is live, or NULL otherwise. */
-Lisp_Object
-set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer)
+static struct buffer *
+live_buffer (Lisp_Object buffer)
{
- register EMACS_INT charno, bytepos;
- register struct buffer *b;
- register struct Lisp_Marker *m;
-
- CHECK_MARKER (marker);
- m = XMARKER (marker);
+ struct buffer *b;
- /* If position is nil or a marker that points nowhere,
- make this marker point nowhere. */
- if (NILP (pos)
- || (MARKERP (pos) && !XMARKER (pos)->buffer))
+ if (NILP (buffer))
{
- unchain_marker (m);
- return marker;
+ b = current_buffer;
+ eassert (BUFFER_LIVE_P (b));
}
-
- if (NILP (buffer))
- b = current_buffer;
else
{
CHECK_BUFFER (buffer);
b = XBUFFER (buffer);
- /* If buffer is dead, set marker to point nowhere. */
- if (EQ (BVAR (b, name), Qnil))
- {
- unchain_marker (m);
- return marker;
- }
+ if (!BUFFER_LIVE_P (b))
+ b = NULL;
}
+ return b;
+}
- /* Optimize the special case where we are copying the position
- of an existing marker, and MARKER is already in the same buffer. */
- if (MARKERP (pos) && b == XMARKER (pos)->buffer
- && b == m->buffer)
- {
- m->bytepos = XMARKER (pos)->bytepos;
- m->charpos = XMARKER (pos)->charpos;
- return marker;
- }
-
- CHECK_NUMBER_COERCE_MARKER (pos);
-
- charno = XINT (pos);
-
- if (charno < BUF_BEGV (b))
- charno = BUF_BEGV (b);
- if (charno > BUF_ZV (b))
- charno = BUF_ZV (b);
-
- bytepos = buf_charpos_to_bytepos (b, charno);
+/* Internal function to set MARKER in BUFFER at POSITION. Non-zero
+ RESTRICTED means limit the POSITION by the visible part of BUFFER. */
- /* Every character is at least one byte. */
- if (charno > bytepos)
- abort ();
+static Lisp_Object
+set_marker_internal (Lisp_Object marker, Lisp_Object position,
+ Lisp_Object buffer, bool restricted)
+{
+ struct Lisp_Marker *m;
+ struct buffer *b = live_buffer (buffer);
- m->bytepos = bytepos;
- m->charpos = charno;
+ CHECK_MARKER (marker);
+ m = XMARKER (marker);
- if (m->buffer != b)
+ /* Set MARKER to point nowhere if BUFFER is dead, or
+ POSITION is nil or a marker points to nowhere. */
+ if (NILP (position)
+ || (MARKERP (position) && !XMARKER (position)->buffer)
+ || !b)
+ unchain_marker (m);
+
+ /* Optimize the special case where we are copying the position of
+ an existing marker, and MARKER is already in the same buffer. */
+ else if (MARKERP (position) && b == XMARKER (position)->buffer
+ && b == m->buffer)
{
- unchain_marker (m);
- m->buffer = b;
- m->next = BUF_MARKERS (b);
- BUF_MARKERS (b) = m;
+ m->bytepos = XMARKER (position)->bytepos;
+ m->charpos = XMARKER (position)->charpos;
}
+ else
+ {
+ register ptrdiff_t charpos, bytepos;
+
+ CHECK_NUMBER_COERCE_MARKER (position);
+ charpos = clip_to_bounds (restricted ? BUF_BEGV (b) : BUF_BEG (b),
+ XINT (position),
+ restricted ? BUF_ZV (b) : BUF_Z (b));
+ bytepos = buf_charpos_to_bytepos (b, charpos);
+ attach_marker (m, b, charpos, bytepos);
+ }
return marker;
}
-
+
+DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
+ doc: /* Position MARKER before character number POSITION in BUFFER,
+which defaults to the current buffer. If POSITION is nil,
+makes marker point nowhere so it no longer slows down
+editing in any buffer. Returns MARKER. */)
+ (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
+{
+ return set_marker_internal (marker, position, buffer, 0);
+}
+
+/* Like the above, but won't let the position be outside the visible part. */
+
+Lisp_Object
+set_marker_restricted (Lisp_Object marker, Lisp_Object position,
+ Lisp_Object buffer)
+{
+ return set_marker_internal (marker, position, buffer, 1);
+}
+
/* Set the position of MARKER, specifying both the
character position and the corresponding byte position. */
Lisp_Object
-set_marker_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMACS_INT bytepos)
+set_marker_both (Lisp_Object marker, Lisp_Object buffer,
+ ptrdiff_t charpos, ptrdiff_t bytepos)
{
- register struct buffer *b;
register struct Lisp_Marker *m;
+ register struct buffer *b = live_buffer (buffer);
CHECK_MARKER (marker);
m = XMARKER (marker);
- if (NILP (buffer))
- b = current_buffer;
+ if (b)
+ attach_marker (m, b, charpos, bytepos);
else
- {
- CHECK_BUFFER (buffer);
- b = XBUFFER (buffer);
- /* If buffer is dead, set marker to point nowhere. */
- if (EQ (BVAR (b, name), Qnil))
- {
- unchain_marker (m);
- return marker;
- }
- }
-
- /* In a single-byte buffer, the two positions must be equal. */
- if (BUF_Z (b) == BUF_Z_BYTE (b)
- && charpos != bytepos)
- abort ();
- /* Every character is at least one byte. */
- if (charpos > bytepos)
- abort ();
-
- m->bytepos = bytepos;
- m->charpos = charpos;
-
- if (m->buffer != b)
- {
- unchain_marker (m);
- m->buffer = b;
- m->next = BUF_MARKERS (b);
- BUF_MARKERS (b) = m;
- }
-
+ unchain_marker (m);
return marker;
}
-/* This version of set_marker_both won't let the position
- be outside the visible part. */
+/* Like the above, but won't let the position be outside the visible part. */
Lisp_Object
-set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMACS_INT bytepos)
+set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer,
+ ptrdiff_t charpos, ptrdiff_t bytepos)
{
- register struct buffer *b;
register struct Lisp_Marker *m;
+ register struct buffer *b = live_buffer (buffer);
CHECK_MARKER (marker);
m = XMARKER (marker);
- if (NILP (buffer))
- b = current_buffer;
- else
- {
- CHECK_BUFFER (buffer);
- b = XBUFFER (buffer);
- /* If buffer is dead, set marker to point nowhere. */
- if (EQ (BVAR (b, name), Qnil))
- {
- unchain_marker (m);
- return marker;
- }
- }
-
- if (charpos < BUF_BEGV (b))
- charpos = BUF_BEGV (b);
- if (charpos > BUF_ZV (b))
- charpos = BUF_ZV (b);
- if (bytepos < BUF_BEGV_BYTE (b))
- bytepos = BUF_BEGV_BYTE (b);
- if (bytepos > BUF_ZV_BYTE (b))
- bytepos = BUF_ZV_BYTE (b);
-
- /* In a single-byte buffer, the two positions must be equal. */
- if (BUF_Z (b) == BUF_Z_BYTE (b)
- && charpos != bytepos)
- abort ();
- /* Every character is at least one byte. */
- if (charpos > bytepos)
- abort ();
-
- m->bytepos = bytepos;
- m->charpos = charpos;
-
- if (m->buffer != b)
+ if (b)
{
- unchain_marker (m);
- m->buffer = b;
- m->next = BUF_MARKERS (b);
- BUF_MARKERS (b) = m;
+ attach_marker
+ (m, b,
+ clip_to_bounds (BUF_BEGV (b), charpos, BUF_ZV (b)),
+ clip_to_bounds (BUF_BEGV_BYTE (b), bytepos, BUF_ZV_BYTE (b)));
}
-
+ else
+ unchain_marker (m);
return marker;
}
-
-/* Remove MARKER from the chain of whatever buffer it is in.
- Leave it "in no buffer".
- This is called during garbage collection,
- so we must be careful to ignore and preserve mark bits,
- including those in chain fields of markers. */
+/* Remove MARKER from the chain of whatever buffer it is in,
+ leaving it points to nowhere. This is called during garbage
+ collection, so we must be careful to ignore and preserve
+ mark bits, including those in chain fields of markers. */
void
unchain_marker (register struct Lisp_Marker *marker)
{
- register struct Lisp_Marker *tail, *prev, *next;
- register struct buffer *b;
+ register struct buffer *b = marker->buffer;
- b = marker->buffer;
- if (b == 0)
- return;
-
- if (EQ (BVAR (b, name), Qnil))
- abort ();
-
- marker->buffer = 0;
-
- tail = BUF_MARKERS (b);
- prev = NULL;
- while (tail)
+ if (b)
{
- next = tail->next;
-
- if (marker == tail)
- {
- if (!prev)
- {
- BUF_MARKERS (b) = next;
- /* Deleting first marker from the buffer's chain. Crash
- if new first marker in chain does not say it belongs
- to the same buffer, or at least that they have the same
- base buffer. */
- if (next && b->text != next->buffer->text)
- abort ();
- }
- else
- prev->next = next;
- /* We have removed the marker from the chain;
- no need to scan the rest of the chain. */
- return;
- }
- else
- prev = tail;
- tail = next;
+ register struct Lisp_Marker *tail, **prev;
+
+ /* No dead buffers here. */
+ eassert (BUFFER_LIVE_P (b));
+
+ marker->buffer = NULL;
+ prev = &BUF_MARKERS (b);
+
+ for (tail = BUF_MARKERS (b); tail; prev = &tail->next, tail = *prev)
+ if (marker == tail)
+ {
+ if (*prev == BUF_MARKERS (b))
+ {
+ /* Deleting first marker from the buffer's chain. Crash
+ if new first marker in chain does not say it belongs
+ to the same buffer, or at least that they have the same
+ base buffer. */
+ if (tail->next && b->text != tail->next->buffer->text)
+ emacs_abort ();
+ }
+ *prev = tail->next;
+ /* We have removed the marker from the chain;
+ no need to scan the rest of the chain. */
+ break;
+ }
+
+ /* Error if marker was not in it's chain. */
+ eassert (tail != NULL);
}
-
- /* Marker was not in its chain. */
- abort ();
}
/* Return the char position of marker MARKER, as a C integer. */
-EMACS_INT
+ptrdiff_t
marker_position (Lisp_Object marker)
{
register struct Lisp_Marker *m = XMARKER (marker);
@@ -776,25 +634,25 @@ marker_position (Lisp_Object marker)
if (!buf)
error ("Marker does not point anywhere");
+ eassert (BUF_BEG (buf) <= m->charpos && m->charpos <= BUF_Z (buf));
+
return m->charpos;
}
/* Return the byte position of marker MARKER, as a C integer. */
-EMACS_INT
+ptrdiff_t
marker_byte_position (Lisp_Object marker)
{
register struct Lisp_Marker *m = XMARKER (marker);
register struct buffer *buf = m->buffer;
- register EMACS_INT i = m->bytepos;
if (!buf)
error ("Marker does not point anywhere");
- if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
- abort ();
+ eassert (BUF_BEG_BYTE (buf) <= m->bytepos && m->bytepos <= BUF_Z_BYTE (buf));
- return i;
+ return m->bytepos;
}
DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0,
@@ -847,25 +705,21 @@ DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
(Lisp_Object position)
{
register struct Lisp_Marker *tail;
- register EMACS_INT charno;
-
- charno = XINT (position);
+ register ptrdiff_t charpos;
- if (charno < BEG)
- charno = BEG;
- if (charno > Z)
- charno = Z;
+ charpos = clip_to_bounds (BEG, XINT (position), Z);
for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
- if (tail->charpos == charno)
+ if (tail->charpos == charpos)
return Qt;
return Qnil;
}
+#ifdef MARKER_DEBUG
+
/* For debugging -- count the markers in buffer BUF. */
-extern int count_markers (struct buffer *) EXTERNALLY_VISIBLE;
int
count_markers (struct buffer *buf)
{
@@ -877,6 +731,26 @@ count_markers (struct buffer *buf)
return total;
}
+
+/* For debugging -- recompute the bytepos corresponding
+ to CHARPOS in the simplest, most reliable way. */
+
+ptrdiff_t
+verify_bytepos (ptrdiff_t charpos)
+{
+ ptrdiff_t below = 1;
+ ptrdiff_t below_byte = 1;
+
+ while (below != charpos)
+ {
+ below++;
+ BUF_INC_POS (current_buffer, below_byte);
+ }
+
+ return below_byte;
+}
+
+#endif /* MARKER_DEBUG */
void
syms_of_marker (void)
@@ -888,8 +762,4 @@ syms_of_marker (void)
defsubr (&Smarker_insertion_type);
defsubr (&Sset_marker_insertion_type);
defsubr (&Sbuffer_has_markers_at);
-
- DEFVAR_BOOL ("byte-debug-flag", byte_debug_flag,
- doc: /* Non-nil enables debugging checks in byte/char position conversions. */);
- byte_debug_flag = 0;
}
diff --git a/src/mem-limits.h b/src/mem-limits.h
index 86b2f44846d..57a0ca6fefd 100644
--- a/src/mem-limits.h
+++ b/src/mem-limits.h
@@ -1,5 +1,5 @@
/* Includes for memory limit warnings.
- Copyright (C) 1990, 1993-1996, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1990, 1993-1996, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -33,12 +33,10 @@ extern int etext;
# endif
#endif
-extern char *start_of_data (void);
-#if defined USE_LSB_TAG
+extern char *start_of_data (void) ATTRIBUTE_CONST;
+#if USE_LSB_TAG || UINTPTR_MAX <= VAL_MAX
#define EXCEEDS_LISP_PTR(ptr) 0
-#elif defined DATA_SEG_BITS
+#else
#define EXCEEDS_LISP_PTR(ptr) \
(((uintptr_t) (ptr) & ~DATA_SEG_BITS) >> VALBITS)
-#else
-#define EXCEEDS_LISP_PTR(ptr) ((uintptr_t) (ptr) >> VALBITS)
#endif
diff --git a/src/menu.c b/src/menu.c
index 587f55e14db..7cc110ce7e2 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -1,6 +1,6 @@
/* Platform-independent code for terminal communications.
-Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2011
+Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -20,7 +20,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include <limits.h> /* for INT_MAX */
#include "lisp.h"
@@ -36,24 +35,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "../lwlib/lwlib.h"
#endif
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#endif
-
-#ifdef HAVE_NS
-#include "nsterm.h"
-#endif
-
-#ifdef USE_GTK
-#include "gtkutil.h"
-#endif
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
#ifdef HAVE_NTGUI
-#include "w32term.h"
-
+# ifdef NTGUI_UNICODE
+# define unicode_append_menu AppendMenuW
+# else /* !NTGUI_UNICODE */
extern AppendMenuW_Proc unicode_append_menu;
+# endif /* NTGUI_UNICODE */
extern HMENU current_popup_menu;
-
#endif /* HAVE_NTGUI */
#include "menu.h"
@@ -129,7 +121,7 @@ discard_menu_items (void)
menu_items = Qnil;
menu_items_allocated = 0;
}
- xassert (NILP (menu_items_inuse));
+ eassert (NILP (menu_items_inuse));
}
#ifdef HAVE_NS
@@ -175,15 +167,17 @@ save_menu_items (void)
}
-/* Make the menu_items vector twice as large. */
+/* Ensure that there is room for ITEMS items in the menu_items vector. */
static void
-grow_menu_items (void)
+ensure_menu_items (int items)
{
- if ((INT_MAX - MENU_ITEMS_PANE_LENGTH) / 2 < menu_items_allocated)
- memory_full (SIZE_MAX);
- menu_items_allocated *= 2;
- menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
+ int incr = items - (menu_items_allocated - menu_items_used);
+ if (0 < incr)
+ {
+ menu_items = larger_vector (menu_items, incr, INT_MAX);
+ menu_items_allocated = ASIZE (menu_items);
+ }
}
#if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
@@ -194,10 +188,9 @@ grow_menu_items (void)
static void
push_submenu_start (void)
{
- if (menu_items_used + 1 > menu_items_allocated)
- grow_menu_items ();
-
- XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
+ ensure_menu_items (1);
+ ASET (menu_items, menu_items_used, Qnil);
+ menu_items_used++;
menu_items_submenu_depth++;
}
@@ -206,10 +199,9 @@ push_submenu_start (void)
static void
push_submenu_end (void)
{
- if (menu_items_used + 1 > menu_items_allocated)
- grow_menu_items ();
-
- XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
+ ensure_menu_items (1);
+ ASET (menu_items, menu_items_used, Qlambda);
+ menu_items_used++;
menu_items_submenu_depth--;
}
@@ -220,10 +212,9 @@ push_submenu_end (void)
static void
push_left_right_boundary (void)
{
- if (menu_items_used + 1 > menu_items_allocated)
- grow_menu_items ();
-
- XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
+ ensure_menu_items (1);
+ ASET (menu_items, menu_items_used, Qquote);
+ menu_items_used++;
}
/* Start a new menu pane in menu_items.
@@ -232,14 +223,15 @@ push_left_right_boundary (void)
static void
push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
{
- if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
- grow_menu_items ();
-
+ ensure_menu_items (MENU_ITEMS_PANE_LENGTH);
if (menu_items_submenu_depth == 0)
menu_items_n_panes++;
- XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
- XVECTOR (menu_items)->contents[menu_items_used++] = name;
- XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
+ ASET (menu_items, menu_items_used, Qt);
+ menu_items_used++;
+ ASET (menu_items, menu_items_used, name);
+ menu_items_used++;
+ ASET (menu_items, menu_items_used, prefix_vec);
+ menu_items_used++;
}
/* Push one menu item into the current pane. NAME is the string to
@@ -253,8 +245,7 @@ push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
static void
push_menu_item (Lisp_Object name, Lisp_Object enable, Lisp_Object key, Lisp_Object def, Lisp_Object equiv, Lisp_Object type, Lisp_Object selected, Lisp_Object help)
{
- if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
- grow_menu_items ();
+ ensure_menu_items (MENU_ITEMS_ITEM_LENGTH);
ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
@@ -340,7 +331,7 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk
{
Lisp_Object map, item_string, enabled;
struct gcpro gcpro1, gcpro2;
- int res;
+ bool res;
struct skp *skp = skp_v;
/* Parse the menu item and leave the result in item_properties. */
@@ -350,10 +341,10 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk
if (!res)
return; /* Not a menu item. */
- map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
+ map = AREF (item_properties, ITEM_PROPERTY_MAP);
- enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
- item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
+ enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
+ item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
if (!NILP (map) && SREF (item_string, 0) == '@')
{
@@ -370,11 +361,11 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk
front of them. */
{
Lisp_Object prefix = Qnil;
- Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
+ Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE);
if (!NILP (type))
{
Lisp_Object selected
- = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
+ = AREF (item_properties, ITEM_PROPERTY_SELECTED);
if (skp->notbuttons)
/* The first button. Line up previous items in this menu. */
@@ -385,7 +376,7 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk
while (idx < menu_items_used)
{
tem
- = XVECTOR (menu_items)->contents[idx + MENU_ITEMS_ITEM_NAME];
+ = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME);
if (NILP (tem))
{
idx++;
@@ -404,8 +395,8 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk
{
if (!submenu && SREF (tem, 0) != '\0'
&& SREF (tem, 0) != '-')
- XVECTOR (menu_items)->contents[idx + MENU_ITEMS_ITEM_NAME]
- = concat2 (build_string (" "), tem);
+ ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME,
+ concat2 (build_string (" "), tem));
idx += MENU_ITEMS_ITEM_LENGTH;
}
}
@@ -437,11 +428,11 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk
#endif /* HAVE_X_WINDOWS || MSDOS */
push_menu_item (item_string, enabled, key,
- XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
- XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
- XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
- XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
- XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
+ AREF (item_properties, ITEM_PROPERTY_DEF),
+ AREF (item_properties, ITEM_PROPERTY_KEYEQ),
+ AREF (item_properties, ITEM_PROPERTY_TYPE),
+ AREF (item_properties, ITEM_PROPERTY_SELECTED),
+ AREF (item_properties, ITEM_PROPERTY_HELP));
#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
/* Display a submenu using the toolkit. */
@@ -458,9 +449,9 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk
and generate menu panes for them in menu_items. */
static void
-keymap_panes (Lisp_Object *keymaps, int nmaps)
+keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
{
- int mapno;
+ ptrdiff_t mapno;
init_menu_items ();
@@ -528,20 +519,22 @@ list_of_panes (Lisp_Object menu)
/* Set up data in menu_items for a menu bar item
whose event type is ITEM_KEY (with string ITEM_NAME)
and whose contents come from the list of keymaps MAPS. */
-int
-parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps)
+bool
+parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name,
+ Lisp_Object maps)
{
Lisp_Object length;
- int len;
+ EMACS_INT len;
Lisp_Object *mapvec;
- int i;
- int top_level_items = 0;
+ ptrdiff_t i;
+ bool top_level_items = 0;
+ USE_SAFE_ALLOCA;
length = Flength (maps);
len = XINT (length);
/* Convert the list MAPS into a vector MAPVEC. */
- mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
+ SAFE_ALLOCA_LISP (mapvec, len);
for (i = 0; i < len; i++)
{
mapvec[i] = Fcar (maps);
@@ -571,6 +564,7 @@ parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object m
}
}
+ SAFE_FREE ();
return top_level_items;
}
@@ -584,9 +578,9 @@ xmalloc_widget_value (void)
{
widget_value *value;
- BLOCK_INPUT;
+ block_input ();
value = malloc_widget_value ();
- UNBLOCK_INPUT;
+ unblock_input ();
return value;
}
@@ -613,9 +607,9 @@ free_menubar_widget_value_tree (widget_value *wv)
free_menubar_widget_value_tree (wv->next);
wv->next = (widget_value *) 0xDEADBEEF;
}
- BLOCK_INPUT;
+ block_input ();
free_widget_value (wv);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Create a tree of widget_value objects
@@ -623,16 +617,15 @@ free_menubar_widget_value_tree (widget_value *wv)
in menu_items starting at index START, up to index END. */
widget_value *
-digest_single_submenu (int start, int end, int top_level_items)
+digest_single_submenu (int start, int end, bool top_level_items)
{
widget_value *wv, *prev_wv, *save_wv, *first_wv;
int i;
int submenu_depth = 0;
widget_value **submenu_stack;
- int panes_seen = 0;
+ bool panes_seen = 0;
- submenu_stack
- = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
+ submenu_stack = alloca (menu_items_used * sizeof *submenu_stack);
wv = xmalloc_widget_value ();
wv->name = "menu";
wv->value = 0;
@@ -650,35 +643,35 @@ digest_single_submenu (int start, int end, int top_level_items)
i = start;
while (i < end)
{
- if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
+ if (EQ (AREF (menu_items, i), Qnil))
{
submenu_stack[submenu_depth++] = save_wv;
save_wv = prev_wv;
prev_wv = 0;
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
+ else if (EQ (AREF (menu_items, i), Qlambda))
{
prev_wv = save_wv;
save_wv = submenu_stack[--submenu_depth];
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
+ else if (EQ (AREF (menu_items, i), Qt)
&& submenu_depth != 0)
i += MENU_ITEMS_PANE_LENGTH;
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
- else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ else if (EQ (AREF (menu_items, i), Qquote))
i += 1;
- else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ else if (EQ (AREF (menu_items, i), Qt))
{
/* Create a new pane. */
Lisp_Object pane_name;
const char *pane_string;
- panes_seen++;
+ panes_seen = 1;
- pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
+ pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
#ifdef HAVE_NTGUI
if (STRINGP (pane_name))
@@ -743,8 +736,8 @@ digest_single_submenu (int start, int end, int top_level_items)
Lisp_Object help;
/* All items should be contained in panes. */
- if (panes_seen == 0)
- abort ();
+ if (! panes_seen)
+ emacs_abort ();
item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
@@ -818,7 +811,7 @@ digest_single_submenu (int start, int end, int top_level_items)
else if (EQ (type, QCtoggle))
wv->button_type = BUTTON_TYPE_TOGGLE;
else
- abort ();
+ emacs_abort ();
wv->selected = !NILP (selected);
if (! STRINGP (help))
@@ -892,31 +885,31 @@ find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object
int i;
entry = Qnil;
- subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
+ subprefix_stack = alloca (menu_bar_items_used * sizeof *subprefix_stack);
prefix = Qnil;
i = 0;
while (i < menu_bar_items_used)
{
- if (EQ (XVECTOR (vector)->contents[i], Qnil))
+ if (EQ (AREF (vector, i), Qnil))
{
subprefix_stack[submenu_depth++] = prefix;
prefix = entry;
i++;
}
- else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
+ else if (EQ (AREF (vector, i), Qlambda))
{
prefix = subprefix_stack[--submenu_depth];
i++;
}
- else if (EQ (XVECTOR (vector)->contents[i], Qt))
+ else if (EQ (AREF (vector, i), Qt))
{
- prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
i += MENU_ITEMS_PANE_LENGTH;
}
else
{
- entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
+ entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
/* Treat the pointer as an integer. There's no problem
as long as pointers have enough bits to hold small integers. */
if ((intptr_t) client_data == i)
@@ -965,9 +958,9 @@ find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object
#ifdef HAVE_NS
/* As above, but return the menu selection instead of storing in kb buffer.
- If keymaps==1, return full prefixes to selection. */
+ If KEYMAPS, return full prefixes to selection. */
Lisp_Object
-find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
+find_and_return_menu_selection (FRAME_PTR f, bool keymaps, void *client_data)
{
Lisp_Object prefix, entry;
int i;
@@ -976,39 +969,38 @@ find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
prefix = entry = Qnil;
i = 0;
- subprefix_stack =
- (Lisp_Object *)alloca (menu_items_used * sizeof (Lisp_Object));
+ subprefix_stack = alloca (menu_items_used * word_size);
while (i < menu_items_used)
{
- if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
+ if (EQ (AREF (menu_items, i), Qnil))
{
subprefix_stack[submenu_depth++] = prefix;
prefix = entry;
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
+ else if (EQ (AREF (menu_items, i), Qlambda))
{
prefix = subprefix_stack[--submenu_depth];
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ else if (EQ (AREF (menu_items, i), Qt))
{
prefix
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
i += MENU_ITEMS_PANE_LENGTH;
}
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
- else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ else if (EQ (AREF (menu_items, i), Qquote))
i += 1;
else
{
entry
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
- if ((EMACS_INT)client_data == (EMACS_INT)(&XVECTOR (menu_items)->contents[i]))
+ = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
+ if (aref_addr (menu_items, i) == client_data)
{
- if (keymaps != 0)
+ if (keymaps)
{
int j;
@@ -1080,9 +1072,9 @@ no quit occurs and `x-popup-menu' returns nil. */)
Lisp_Object selection = Qnil;
FRAME_PTR f = NULL;
Lisp_Object x, y, window;
- int keymaps = 0;
- int for_click = 0;
- int specpdl_count = SPECPDL_INDEX ();
+ bool keymaps = 0;
+ bool for_click = 0;
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
struct gcpro gcpro1;
if (NILP (position))
@@ -1092,7 +1084,7 @@ no quit occurs and `x-popup-menu' returns nil. */)
#ifdef HAVE_MENUS
{
- int get_current_pos_p = 0;
+ bool get_current_pos_p = 0;
/* FIXME!! check_w32 (); or check_x (); or check_ns (); */
/* Decode the first argument: find the window and the coordinates. */
@@ -1175,9 +1167,6 @@ no quit occurs and `x-popup-menu' returns nil. */)
}
}
- CHECK_NUMBER (x);
- CHECK_NUMBER (y);
-
/* Decode where to put the menu. */
if (FRAMEP (window))
@@ -1200,6 +1189,16 @@ no quit occurs and `x-popup-menu' returns nil. */)
but I don't want to make one now. */
CHECK_WINDOW (window);
+ CHECK_RANGED_INTEGER (x,
+ (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
+ ? (EMACS_INT) INT_MIN - xpos
+ : MOST_NEGATIVE_FIXNUM),
+ INT_MAX - xpos);
+ CHECK_RANGED_INTEGER (y,
+ (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
+ ? (EMACS_INT) INT_MIN - ypos
+ : MOST_NEGATIVE_FIXNUM),
+ INT_MAX - ypos);
xpos += XINT (x);
ypos += XINT (y);
@@ -1248,11 +1247,12 @@ no quit occurs and `x-popup-menu' returns nil. */)
else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
{
/* We were given a list of keymaps. */
- int nmaps = XFASTINT (Flength (menu));
- Lisp_Object *maps
- = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
- int i;
+ EMACS_INT nmaps = XFASTINT (Flength (menu));
+ Lisp_Object *maps;
+ ptrdiff_t i;
+ USE_SAFE_ALLOCA;
+ SAFE_ALLOCA_LISP (maps, nmaps);
title = Qnil;
/* The first keymap that has a prompt string
@@ -1276,6 +1276,8 @@ no quit occurs and `x-popup-menu' returns nil. */)
ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
keymaps = 1;
+
+ SAFE_FREE ();
}
else
{
@@ -1316,7 +1318,7 @@ no quit occurs and `x-popup-menu' returns nil. */)
#endif
/* Display them in a menu. */
- BLOCK_INPUT;
+ block_input ();
/* FIXME: Use a terminal hook! */
#if defined HAVE_NTGUI
@@ -1335,7 +1337,7 @@ no quit occurs and `x-popup-menu' returns nil. */)
last_event_timestamp);
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
#ifdef HAVE_NS
unbind_to (specpdl_count, Qnil);
diff --git a/src/menu.h b/src/menu.h
index 451401b42d5..67934c42d76 100644
--- a/src/menu.h
+++ b/src/menu.h
@@ -1,5 +1,5 @@
/* Functions to manipulate menus.
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -26,10 +26,10 @@ extern void x_set_menu_bar_lines (struct frame *f,
Lisp_Object oldval);
extern void init_menu_items (void);
-extern void finish_menu_items (void);
+extern void finish_menu_items (void) ATTRIBUTE_CONST;
extern void discard_menu_items (void);
extern void save_menu_items (void);
-extern int parse_single_submenu (Lisp_Object, Lisp_Object, Lisp_Object);
+extern bool parse_single_submenu (Lisp_Object, Lisp_Object, Lisp_Object);
extern void list_of_panes (Lisp_Object);
#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) \
|| defined (HAVE_NS)
@@ -38,7 +38,7 @@ extern void update_submenu_strings (widget_value *);
extern void find_and_call_menu_selection (FRAME_PTR, int,
Lisp_Object, void *);
extern widget_value *xmalloc_widget_value (void);
-extern widget_value *digest_single_submenu (int, int, int);
+extern widget_value *digest_single_submenu (int, int, bool);
#endif
#ifdef HAVE_X_WINDOWS
@@ -47,8 +47,8 @@ extern void mouse_position_for_popup (FRAME_PTR f, int *x, int *y);
extern Lisp_Object w32_menu_show (FRAME_PTR, int, int, int, int,
Lisp_Object, const char **);
-extern Lisp_Object ns_menu_show (FRAME_PTR, int, int, int, int,
+extern Lisp_Object ns_menu_show (FRAME_PTR, int, int, bool, bool,
Lisp_Object, const char **);
-extern Lisp_Object xmenu_show (FRAME_PTR, int, int, int, int,
+extern Lisp_Object xmenu_show (FRAME_PTR, int, int, bool, bool,
Lisp_Object, const char **, Time);
#endif /* MENU_H */
diff --git a/src/minibuf.c b/src/minibuf.c
index ad5625e9ee9..dcc4af37c13 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1,6 +1,6 @@
/* Minibuffer input and completion.
-Copyright (C) 1985-1986, 1993-2011 Free Software Foundation, Inc.
+Copyright (C) 1985-1986, 1993-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,10 +21,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <errno.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "commands.h"
+#include "character.h"
#include "buffer.h"
#include "dispextern.h"
#include "keyboard.h"
@@ -72,7 +72,7 @@ Lisp_Object Qcompletion_ignore_case;
static Lisp_Object Qminibuffer_completion_table;
static Lisp_Object Qminibuffer_completion_predicate;
static Lisp_Object Qminibuffer_completion_confirm;
-static Lisp_Object Quser_variable_p;
+static Lisp_Object Qcustom_variable_p;
static Lisp_Object Qminibuffer_default;
@@ -89,7 +89,7 @@ static Lisp_Object minibuf_prompt;
/* Width of current mini-buffer prompt. Only set after display_line
of the line that contains the prompt. */
-static EMACS_INT minibuf_prompt_width;
+static ptrdiff_t minibuf_prompt_width;
/* Put minibuf on currently selected frame's minibuffer.
@@ -109,14 +109,16 @@ choose_minibuf_frame (void)
/* I don't think that any frames may validly have a null minibuffer
window anymore. */
if (NILP (sf->minibuffer_window))
- abort ();
+ emacs_abort ();
/* Under X, we come here with minibuf_window being the
minibuffer window of the unused termcap window created in
init_window_once. That window doesn't have a buffer. */
buffer = XWINDOW (minibuf_window)->buffer;
if (BUFFERP (buffer))
- Fset_window_buffer (sf->minibuffer_window, buffer, Qnil);
+ /* Use set_window_buffer instead of Fset_window_buffer (see
+ discussion of bug#11984, bug#12025, bug#12026). */
+ set_window_buffer (sf->minibuffer_window, buffer, 0, 0);
minibuf_window = sf->minibuffer_window;
}
@@ -171,17 +173,6 @@ without invoking the usual minibuffer commands. */)
static Lisp_Object read_minibuf_unwind (Lisp_Object);
static Lisp_Object run_exit_minibuf_hook (Lisp_Object);
-static Lisp_Object read_minibuf (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object,
- int, Lisp_Object,
- Lisp_Object, Lisp_Object,
- int, int);
-static Lisp_Object read_minibuf_noninteractive (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object,
- int, Lisp_Object,
- Lisp_Object, Lisp_Object,
- int, int);
-static Lisp_Object string_to_object (Lisp_Object, Lisp_Object);
/* Read a Lisp object from VAL and return it. If VAL is an empty
@@ -192,7 +183,7 @@ string_to_object (Lisp_Object val, Lisp_Object defalt)
{
struct gcpro gcpro1, gcpro2;
Lisp_Object expr_and_pos;
- EMACS_INT pos;
+ ptrdiff_t pos;
GCPRO2 (val, defalt);
@@ -210,7 +201,7 @@ string_to_object (Lisp_Object val, Lisp_Object defalt)
{
/* Ignore trailing whitespace; any other trailing junk
is an error. */
- EMACS_INT i;
+ ptrdiff_t i;
pos = string_char_to_byte (val, pos);
for (i = pos; i < SBYTES (val); i++)
{
@@ -231,10 +222,10 @@ string_to_object (Lisp_Object val, Lisp_Object defalt)
static Lisp_Object
read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt, Lisp_Object backup_n,
- int expflag,
+ bool expflag,
Lisp_Object histvar, Lisp_Object histpos,
Lisp_Object defalt,
- int allow_props, int inherit_input_method)
+ bool allow_props, bool inherit_input_method)
{
ptrdiff_t size, len;
char *line;
@@ -247,7 +238,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
val = Qnil;
size = 100;
len = 0;
- line = (char *) xmalloc (size);
+ line = xmalloc (size);
while ((c = getchar ()) != '\n')
{
@@ -263,7 +254,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
if (STRING_BYTES_BOUND / 2 < size)
memory_full (SIZE_MAX);
size *= 2;
- line = (char *) xrealloc (line, size);
+ line = xrealloc (line, size);
}
line[len++] = c;
}
@@ -335,7 +326,7 @@ DEFUN ("minibuffer-contents", Fminibuffer_contents,
If the current buffer is not a minibuffer, return its entire contents. */)
(void)
{
- EMACS_INT prompt_end = XINT (Fminibuffer_prompt_end ());
+ ptrdiff_t prompt_end = XINT (Fminibuffer_prompt_end ());
return make_buffer_string (prompt_end, ZV, 1);
}
@@ -345,7 +336,7 @@ DEFUN ("minibuffer-contents-no-properties", Fminibuffer_contents_no_properties,
If the current buffer is not a minibuffer, return its entire contents. */)
(void)
{
- EMACS_INT prompt_end = XINT (Fminibuffer_prompt_end ());
+ ptrdiff_t prompt_end = XINT (Fminibuffer_prompt_end ());
return make_buffer_string (prompt_end, ZV, 0);
}
@@ -356,7 +347,7 @@ That is what completion commands operate on.
If the current buffer is not a minibuffer, return its entire contents. */)
(void)
{
- EMACS_INT prompt_end = XINT (Fminibuffer_prompt_end ());
+ ptrdiff_t prompt_end = XINT (Fminibuffer_prompt_end ());
if (PT < prompt_end)
error ("Cannot do completion in the prompt");
return make_buffer_string (prompt_end, PT, 1);
@@ -374,30 +365,30 @@ If the current buffer is not a minibuffer, return its entire contents. */)
beginning of INITIAL if N <= 0.
Normally return the result as a string (the text that was read),
- but if EXPFLAG is nonzero, read it and return the object read.
+ but if EXPFLAG, read it and return the object read.
If HISTVAR is given, save the value read on that history only if it doesn't
match the front of that history list exactly. The value is pushed onto
the list as the string that was read.
DEFALT specifies the default value for the sake of history commands.
- If ALLOW_PROPS is nonzero, we do not throw away text properties.
+ If ALLOW_PROPS, do not throw away text properties.
- if INHERIT_INPUT_METHOD is nonzero, the minibuffer inherits the
+ if INHERIT_INPUT_METHOD, the minibuffer inherits the
current input method. */
static Lisp_Object
read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
- Lisp_Object backup_n, int expflag,
+ bool expflag,
Lisp_Object histvar, Lisp_Object histpos, Lisp_Object defalt,
- int allow_props, int inherit_input_method)
+ bool allow_props, bool inherit_input_method)
{
Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
Lisp_Object enable_multibyte;
- int pos = INTEGERP (backup_n) ? XINT (backup_n) : 0;
+ EMACS_INT pos = 0;
/* String to add to the history. */
Lisp_Object histstring;
@@ -405,6 +396,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
Lisp_Object dummy, frame;
specbind (Qminibuffer_default, defalt);
+ specbind (intern ("inhibit-read-only"), Qnil);
/* If Vminibuffer_completing_file_name is `lambda' on entry, it was t
in previous recursive minibuffer, but was not set explicitly
@@ -423,8 +415,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
{
if (CONSP (initial))
{
- backup_n = Fcdr (initial);
- initial = Fcar (initial);
+ Lisp_Object backup_n = XCDR (initial);
+ initial = XCAR (initial);
CHECK_STRING (initial);
if (!NILP (backup_n))
{
@@ -480,6 +472,10 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
/* Choose the minibuffer window and frame, and take action on them. */
+ /* Prepare for restoring the current buffer since choose_minibuf_frame
+ calling Fset_frame_selected_window may change it (Bug#12766). */
+ record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+
choose_minibuf_frame ();
record_unwind_protect (choose_minibuf_frame_1, Qnil);
@@ -561,11 +557,11 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
/* Defeat (setq-default truncate-lines t), since truncated lines do
not work correctly in minibuffers. (Bug#5715, etc) */
- BVAR (current_buffer, truncate_lines) = Qnil;
+ bset_truncate_lines (current_buffer, Qnil);
/* If appropriate, copy enable-multibyte-characters into the minibuffer. */
if (inherit_input_method)
- BVAR (current_buffer, enable_multibyte_characters) = enable_multibyte;
+ bset_enable_multibyte_characters (current_buffer, enable_multibyte);
/* The current buffer's default directory is usually the right thing
for our minibuffer here. However, if you're typing a command at
@@ -576,7 +572,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
you think of something better to do? Find another buffer with a
better directory, and use that one instead. */
if (STRINGP (ambient_dir))
- BVAR (current_buffer, directory) = ambient_dir;
+ bset_directory (current_buffer, ambient_dir);
else
{
Lisp_Object buf_list;
@@ -590,7 +586,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
other_buf = XCDR (XCAR (buf_list));
if (STRINGP (BVAR (XBUFFER (other_buf), directory)))
{
- BVAR (current_buffer, directory) = BVAR (XBUFFER (other_buf), directory);
+ bset_directory (current_buffer,
+ BVAR (XBUFFER (other_buf), directory));
break;
}
}
@@ -615,20 +612,24 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
if (! NILP (mini_window) && ! EQ (mini_window, minibuf_window)
&& !NILP (Fwindow_minibuffer_p (mini_window)))
- Fset_window_buffer (mini_window, empty_minibuf, Qnil);
+ /* Use set_window_buffer instead of Fset_window_buffer (see
+ discussion of bug#11984, bug#12025, bug#12026). */
+ set_window_buffer (mini_window, empty_minibuf, 0, 0);
}
/* Display this minibuffer in the proper window. */
- Fset_window_buffer (minibuf_window, Fcurrent_buffer (), Qnil);
+ /* Use set_window_buffer instead of Fset_window_buffer (see
+ discussion of bug#11984, bug#12025, bug#12026). */
+ set_window_buffer (minibuf_window, Fcurrent_buffer (), 0, 0);
Fselect_window (minibuf_window, Qnil);
- XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0);
+ XWINDOW (minibuf_window)->hscroll = 0;
Fmake_local_variable (Qprint_escape_newlines);
print_escape_newlines = 1;
/* Erase the buffer. */
{
- int count1 = SPECPDL_INDEX ();
+ ptrdiff_t count1 = SPECPDL_INDEX ();
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Ferase_buffer ();
@@ -663,7 +664,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
}
clear_message (1, 1);
- BVAR (current_buffer, keymap) = map;
+ bset_keymap (current_buffer, map);
/* Turn on an input method stored in INPUT_METHOD if any. */
if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method)))
@@ -672,7 +673,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
Frun_hooks (1, &Qminibuffer_setup_hook);
/* Don't allow the user to undo past this point. */
- BVAR (current_buffer, undo_list) = Qnil;
+ bset_undo_list (current_buffer, Qnil);
recursive_edit_1 ();
@@ -789,10 +790,10 @@ get_minibuffer (EMACS_INT depth)
Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
}
buf = Fcar (tail);
- if (NILP (buf) || NILP (BVAR (XBUFFER (buf), name)))
+ if (NILP (buf) || !BUFFER_LIVE_P (XBUFFER (buf)))
{
- sprintf (name, " *Minibuf-%"pI"d*", depth);
- buf = Fget_buffer_create (build_string (name));
+ buf = Fget_buffer_create
+ (make_formatted_string (name, " *Minibuf-%"pI"d*", depth));
/* Although the buffer's name starts with a space, undo should be
enabled in it. */
@@ -802,14 +803,13 @@ get_minibuffer (EMACS_INT depth)
}
else
{
- int count = SPECPDL_INDEX ();
- /* `reset_buffer' blindly sets the list of overlays to NULL, so we
- have to empty the list, otherwise we end up with overlays that
- think they belong to this buffer while the buffer doesn't know about
- them any more. */
+ ptrdiff_t count = SPECPDL_INDEX ();
+ /* We have to empty both overlay lists. Otherwise we end
+ up with overlays that think they belong to this buffer
+ while the buffer doesn't know about them any more. */
delete_all_overlays (XBUFFER (buf));
reset_buffer (XBUFFER (buf));
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (buf);
if (!NILP (Ffboundp (intern ("minibuffer-inactive-mode"))))
call0 (intern ("minibuffer-inactive-mode"));
@@ -870,7 +870,7 @@ read_minibuf_unwind (Lisp_Object data)
/* Erase the minibuffer we were using at this level. */
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* Prevent error in erase-buffer. */
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
@@ -887,8 +887,8 @@ read_minibuf_unwind (Lisp_Object data)
/* Make sure minibuffer window is erased, not ignored. */
windows_or_buffers_changed++;
- XSETFASTINT (XWINDOW (window)->last_modified, 0);
- XSETFASTINT (XWINDOW (window)->last_overlay_modified, 0);
+ XWINDOW (window)->last_modified = 0;
+ XWINDOW (window)->last_overlay_modified = 0;
/* In case the previous minibuffer displayed in this miniwindow is
dead, we may keep displaying this buffer (tho it's inactive), so reset it,
@@ -978,7 +978,7 @@ and some related functions, which use zero-indexing for POSITION. */)
GCPRO1 (default_value);
val = read_minibuf (keymap, initial_contents, prompt,
- Qnil, !NILP (read),
+ !NILP (read),
histvar, histpos, default_value,
minibuffer_allow_text_properties,
!NILP (inherit_input_method));
@@ -996,7 +996,7 @@ Such arguments are used as in `read-from-minibuffer'.) */)
{
CHECK_STRING (prompt);
return read_minibuf (Vminibuffer_local_map, initial_contents,
- prompt, Qnil, 1, Qminibuffer_history,
+ prompt, 1, Qminibuffer_history,
make_number (0), Qnil, 0, 0);
}
@@ -1009,7 +1009,7 @@ Such arguments are used as in `read-from-minibuffer'.) */)
(Lisp_Object prompt, Lisp_Object initial_contents)
{
return Feval (read_minibuf (Vread_expression_map, initial_contents,
- prompt, Qnil, 1, Qread_expression_history,
+ prompt, 1, Qread_expression_history,
make_number (0), Qnil, 0, 0),
Qnil);
}
@@ -1034,12 +1034,20 @@ Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
(Lisp_Object prompt, Lisp_Object initial_input, Lisp_Object history, Lisp_Object default_value, Lisp_Object inherit_input_method)
{
Lisp_Object val;
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ /* Just in case we're in a recursive minibuffer, make it clear that the
+ previous minibuffer's completion table does not apply to the new
+ minibuffer.
+ FIXME: `minibuffer-completion-table' should be buffer-local instead. */
+ specbind (Qminibuffer_completion_table, Qnil);
+
val = Fread_from_minibuffer (prompt, initial_input, Qnil,
Qnil, history, default_value,
inherit_input_method);
if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (default_value))
val = CONSP (default_value) ? XCAR (default_value) : default_value;
- return val;
+ return unbind_to (count, val);
}
DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 3, 0,
@@ -1055,7 +1063,7 @@ the current input method and the setting of`enable-multibyte-characters'. */)
(Lisp_Object prompt, Lisp_Object initial, Lisp_Object inherit_input_method)
{
CHECK_STRING (prompt);
- return read_minibuf (Vminibuffer_local_ns_map, initial, prompt, Qnil,
+ return read_minibuf (Vminibuffer_local_ns_map, initial, prompt,
0, Qminibuffer_history, make_number (0), Qnil, 0,
!NILP (inherit_input_method));
}
@@ -1094,10 +1102,11 @@ Prompt with PROMPT. */)
#endif /* NOTDEF */
DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 2, 0,
- doc: /* Read the name of a user variable and return it as a symbol.
+ doc: /* Read the name of a user option and return it as a symbol.
Prompt with PROMPT. By default, return DEFAULT-VALUE or its first element
if it is a list.
-A user variable is one for which `user-variable-p' returns non-nil. */)
+A user option, or customizable variable, is one for which
+`custom-variable-p' returns non-nil. */)
(Lisp_Object prompt, Lisp_Object default_value)
{
Lisp_Object name, default_string;
@@ -1110,7 +1119,7 @@ A user variable is one for which `user-variable-p' returns non-nil. */)
default_string = default_value;
name = Fcompleting_read (prompt, Vobarray,
- Quser_variable_p, Qt,
+ Qcustom_variable_p, Qt,
Qnil, Qnil, default_string, Qnil);
if (NILP (name))
return name;
@@ -1135,7 +1144,7 @@ function, instead of the usual behavior. */)
Lisp_Object args[4], result;
char *s;
ptrdiff_t len;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (BUFFERP (def))
def = BVAR (XBUFFER (def), name);
@@ -1234,9 +1243,9 @@ is used to further constrain the set of candidates. */)
{
Lisp_Object bestmatch, tail, elt, eltstring;
/* Size in bytes of BESTMATCH. */
- int bestmatchsize = 0;
+ ptrdiff_t bestmatchsize = 0;
/* These are in bytes, too. */
- int compare, matchsize;
+ ptrdiff_t compare, matchsize;
enum { function_table, list_table, obarray_table, hash_table}
type = (HASH_TABLE_P (collection) ? hash_table
: VECTORP (collection) ? obarray_table
@@ -1245,9 +1254,9 @@ is used to further constrain the set of candidates. */)
&& (!SYMBOLP (XCAR (collection))
|| NILP (XCAR (collection)))))
? list_table : function_table));
- EMACS_INT idx = 0, obsize = 0;
+ ptrdiff_t idx = 0, obsize = 0;
int matchcount = 0;
- int bindcount = -1;
+ ptrdiff_t bindcount = -1;
Lisp_Object bucket, zero, end, tem;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
@@ -1264,7 +1273,7 @@ is used to further constrain the set of candidates. */)
{
collection = check_obarray (collection);
obsize = ASIZE (collection);
- bucket = XVECTOR (collection)->contents[idx];
+ bucket = AREF (collection, idx);
}
while (1)
@@ -1299,7 +1308,7 @@ is used to further constrain the set of candidates. */)
break;
else
{
- bucket = XVECTOR (collection)->contents[idx];
+ bucket = AREF (collection, idx);
continue;
}
}
@@ -1431,7 +1440,7 @@ is used to further constrain the set of candidates. */)
if (bestmatchsize != SCHARS (eltstring)
|| bestmatchsize != matchsize)
/* Don't count the same string multiple times. */
- matchcount++;
+ matchcount += matchcount <= 1;
bestmatchsize = matchsize;
if (matchsize <= SCHARS (string)
/* If completion-ignore-case is non-nil, don't
@@ -1510,8 +1519,8 @@ with a space are ignored unless STRING itself starts with a space. */)
: NILP (collection) || (CONSP (collection)
&& (!SYMBOLP (XCAR (collection))
|| NILP (XCAR (collection))));
- EMACS_INT idx = 0, obsize = 0;
- int bindcount = -1;
+ ptrdiff_t idx = 0, obsize = 0;
+ ptrdiff_t bindcount = -1;
Lisp_Object bucket, tem, zero;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
@@ -1527,7 +1536,7 @@ with a space are ignored unless STRING itself starts with a space. */)
{
collection = check_obarray (collection);
obsize = ASIZE (collection);
- bucket = XVECTOR (collection)->contents[idx];
+ bucket = AREF (collection, idx);
}
while (1)
@@ -1562,7 +1571,7 @@ with a space are ignored unless STRING itself starts with a space. */)
break;
else
{
- bucket = XVECTOR (collection)->contents[idx];
+ bucket = AREF (collection, idx);
continue;
}
}
@@ -1687,7 +1696,7 @@ If INITIAL-INPUT is non-nil, insert it in the minibuffer initially,
functions, which use one-indexing for POSITION.) This feature is
deprecated--it is best to pass nil for INITIAL-INPUT and supply the
default value DEF instead. The user can yank the default value into
- the minibuffer easily using \\[next-history-element].
+ the minibuffer easily using \\<minibuffer-local-map>\\[next-history-element].
HIST, if non-nil, specifies a history list and optionally the initial
position in the list. It can be a symbol, which is the history list
@@ -1725,8 +1734,6 @@ See also `completing-read-function'. */)
return Ffuncall (9, args);
}
-Lisp_Object Fassoc_string (register Lisp_Object key, Lisp_Object list, Lisp_Object case_fold);
-
/* Test whether TXT is an exact completion. */
DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
doc: /* Return non-nil if STRING is a valid completion.
@@ -1772,7 +1779,7 @@ the values STRING, PREDICATE and `lambda'. */)
{
for (i = ASIZE (collection) - 1; i >= 0; i--)
{
- tail = XVECTOR (collection)->contents[i];
+ tail = AREF (collection, i);
if (SYMBOLP (tail))
while (1)
{
@@ -1820,7 +1827,7 @@ the values STRING, PREDICATE and `lambda'. */)
/* Reject this element if it fails to match all the regexps. */
if (CONSP (Vcompletion_regexp_list))
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
for (regexps = Vcompletion_regexp_list; CONSP (regexps);
regexps = XCDR (regexps))
@@ -1845,15 +1852,14 @@ the values STRING, PREDICATE and `lambda'. */)
}
static Lisp_Object Qmetadata;
-extern Lisp_Object Qbuffer;
DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0,
doc: /* Perform completion on buffer names.
-If the argument FLAG is nil, invoke `try-completion', if it's t, invoke
-`all-completions', otherwise invoke `test-completion'.
+STRING and PREDICATE have the same meanings as in `try-completion',
+`all-completions', and `test-completion'.
-The arguments STRING and PREDICATE are as in `try-completion',
-`all-completions', and `test-completion'. */)
+If FLAG is nil, invoke `try-completion'; if it is t, invoke
+`all-completions'; otherwise invoke `test-completion'. */)
(Lisp_Object string, Lisp_Object predicate, Lisp_Object flag)
{
if (NILP (flag))
@@ -1975,11 +1981,11 @@ syms_of_minibuf (void)
staticpro (&last_minibuf_string);
last_minibuf_string = Qnil;
- DEFSYM (Quser_variable_p, "user-variable-p");
DEFSYM (Qminibuffer_history, "minibuffer-history");
DEFSYM (Qbuffer_name_history, "buffer-name-history");
Fset (Qbuffer_name_history, Qnil);
+ DEFSYM (Qcustom_variable_p, "custom-variable-p");
DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook");
DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook");
DEFSYM (Qhistory_length, "history-length");
@@ -2002,7 +2008,7 @@ The function is called with the arguments passed to `read-buffer'. */);
DEFVAR_BOOL ("read-buffer-completion-ignore-case",
read_buffer_completion_ignore_case,
- doc: /* *Non-nil means completion ignores case when reading a buffer name. */);
+ doc: /* Non-nil means completion ignores case when reading a buffer name. */);
read_buffer_completion_ignore_case = 0;
DEFVAR_LISP ("minibuffer-setup-hook", Vminibuffer_setup_hook,
@@ -2014,20 +2020,24 @@ The function is called with the arguments passed to `read-buffer'. */);
Vminibuffer_exit_hook = Qnil;
DEFVAR_LISP ("history-length", Vhistory_length,
- doc: /* *Maximum length for history lists before truncation takes place.
-A number means that length; t means infinite. Truncation takes place
-just after a new element is inserted. Setting the `history-length'
-property of a history variable overrides this default. */);
+ doc: /* Maximum length of history lists before truncation takes place.
+A number means truncate to that length; truncation deletes old
+elements, and is done just after inserting a new element.
+A value of t means no truncation.
+
+This variable only affects history lists that don't specify their own
+maximum lengths. Setting the `history-length' property of a history
+variable overrides this default. */);
XSETFASTINT (Vhistory_length, 30);
DEFVAR_BOOL ("history-delete-duplicates", history_delete_duplicates,
- doc: /* *Non-nil means to delete duplicates in history.
+ doc: /* Non-nil means to delete duplicates in history.
If set to t when adding a new history element, all previous identical
elements are deleted from the history list. */);
history_delete_duplicates = 0;
DEFVAR_LISP ("history-add-new-input", Vhistory_add_new_input,
- doc: /* *Non-nil means to add new elements in history.
+ doc: /* Non-nil means to add new elements in history.
If set to nil, minibuffer reading functions don't add new elements to the
history list, so it is possible to do this afterwards by calling
`add-to-history' explicitly. */);
@@ -2042,7 +2052,7 @@ controls the behavior, rather than this variable. */);
completion_ignore_case = 0;
DEFVAR_BOOL ("enable-recursive-minibuffers", enable_recursive_minibuffers,
- doc: /* *Non-nil means to allow minibuffer commands while in the minibuffer.
+ doc: /* Non-nil means to allow minibuffer commands while in the minibuffer.
This variable makes a difference whenever the minibuffer window is active. */);
enable_recursive_minibuffers = 0;
@@ -2098,7 +2108,7 @@ is added with
Vminibuffer_history_position = Qnil;
DEFVAR_BOOL ("minibuffer-auto-raise", minibuffer_auto_raise,
- doc: /* *Non-nil means entering the minibuffer raises the minibuffer's frame.
+ doc: /* Non-nil means entering the minibuffer raises the minibuffer's frame.
Some uses of the echo area also raise that frame (since they use it too). */);
minibuffer_auto_raise = 0;
diff --git a/src/msdos.c b/src/msdos.c
index 64e9d72c784..433bf1074d8 100644
--- a/src/msdos.c
+++ b/src/msdos.c
@@ -1,6 +1,6 @@
/* MS-DOS specific C utilities. -*- coding: raw-text -*-
-Copyright (C) 1993-1997, 1999-2011 Free Software Foundation, Inc.
+Copyright (C) 1993-1997, 1999-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -31,7 +31,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <time.h>
#include <sys/param.h>
#include <sys/time.h>
+/* gettime and settime in dos.h clash with their namesakes from
+ gnulib, so we move out of our way the prototypes in dos.h. */
+#define gettime dos_h_gettime_
+#define settime dos_h_settime_
#include <dos.h>
+#undef gettime
+#undef settime
#include <errno.h>
#include <sys/stat.h> /* for _fixpath */
#include <unistd.h> /* for chdir, dup, dup2, etc. */
@@ -103,18 +109,18 @@ int _crt0_startup_flags = (_CRT0_FLAG_UNIX_SBRK | _CRT0_FLAG_FILL_SBRK_MEMORY);
#endif /* not SYSTEM_MALLOC */
+/* Return the current timestamp in milliseconds since midnight. */
static unsigned long
event_timestamp (void)
{
- struct time t;
+ struct timespec t;
unsigned long s;
gettime (&t);
- s = t.ti_min;
- s *= 60;
- s += t.ti_sec;
+ s = t.tv_sec;
+ s %= 86400;
s *= 1000;
- s += t.ti_hund * 10;
+ s += t.tv_nsec * 1000000;
return s;
}
@@ -514,8 +520,10 @@ dos_set_window_size (int *rows, int *cols)
/* If the user specified a special video mode for these dimensions,
use that mode. */
- sprintf (video_name, "screen-dimensions-%dx%d", *rows, *cols);
- video_mode = Fsymbol_value (Fintern_soft (build_string (video_name), Qnil));
+ video_mode
+ = Fsymbol_value (Fintern_soft (make_formatted_string
+ (video_name, "screen-dimensions-%dx%d",
+ *rows, *cols), Qnil));
if (INTEGERP (video_mode)
&& (video_mode_value = XINT (video_mode)) > 0)
@@ -788,7 +796,7 @@ IT_set_face (int face)
/* The default face for the frame should always be realized and
cached. */
if (!fp)
- abort ();
+ emacs_abort ();
}
screen_face = face;
fg = fp->foreground;
@@ -1021,7 +1029,6 @@ IT_clear_end_of_line (struct frame *f, int first_unused)
{
char *spaces, *sp;
int i, j, offset = 2 * (new_pos_X + screen_size_X * new_pos_Y);
- extern int fatal_error_in_progress;
struct tty_display_info *tty = FRAME_TTY (f);
if (new_pos_X >= first_unused || fatal_error_in_progress)
@@ -1222,7 +1229,7 @@ IT_update_begin (struct frame *f)
if (display_info->termscript)
fprintf (display_info->termscript, "\n\n<UPDATE_BEGIN");
- BLOCK_INPUT;
+ block_input ();
if (f && f == mouse_face_frame)
{
@@ -1268,11 +1275,10 @@ IT_update_begin (struct frame *f)
hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1;
hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1;
hlinfo->mouse_face_window = Qnil;
- hlinfo->mouse_face_deferred_gc = 0;
hlinfo->mouse_face_mouse_frame = NULL;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
static void
@@ -1288,21 +1294,10 @@ IT_update_end (struct frame *f)
static void
IT_frame_up_to_date (struct frame *f)
{
- Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
Lisp_Object new_cursor, frame_desired_cursor;
struct window *sw;
- if (hlinfo->mouse_face_deferred_gc
- || (f && f == hlinfo->mouse_face_mouse_frame))
- {
- BLOCK_INPUT;
- if (hlinfo->mouse_face_mouse_frame)
- note_mouse_highlight (hlinfo->mouse_face_mouse_frame,
- hlinfo->mouse_face_mouse_x,
- hlinfo->mouse_face_mouse_y);
- hlinfo->mouse_face_deferred_gc = 0;
- UNBLOCK_INPUT;
- }
+ FRAME_MOUSE_UPDATE (f);
/* Set the cursor type to whatever they wanted. In a minibuffer
window, we want the cursor to appear only if we are reading input
@@ -1386,7 +1381,7 @@ IT_insert_glyphs (struct frame *f, struct glyph *start, int len)
static void
IT_delete_glyphs (struct frame *f, int n)
{
- abort ();
+ emacs_abort ();
}
/* set-window-configuration on window.c needs this. */
@@ -1586,9 +1581,9 @@ IT_set_frame_parameters (struct frame *f, Lisp_Object alist)
Lisp_Object tail;
int i, j, length = XINT (Flength (alist));
Lisp_Object *parms
- = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
+ = (Lisp_Object *) alloca (length * word_size);
Lisp_Object *values
- = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
+ = (Lisp_Object *) alloca (length * word_size);
/* Do we have to reverse the foreground and background colors? */
int reverse = EQ (Fcdr (Fassq (Qreverse, f->param_alist)), Qt);
int redraw = 0, fg_set = 0, bg_set = 0;
@@ -1610,11 +1605,9 @@ IT_set_frame_parameters (struct frame *f, Lisp_Object alist)
/* Extract parm names and values into those vectors. */
i = 0;
- for (tail = alist; CONSP (tail); tail = Fcdr (tail))
+ for (tail = alist; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object elt;
-
- elt = Fcar (tail);
+ Lisp_Object elt = XCAR (tail);
parms[i] = Fcar (elt);
CHECK_SYMBOL (parms[i]);
values[i] = Fcdr (elt);
@@ -1795,7 +1788,7 @@ internal_terminal_init (void)
}
tty = FRAME_TTY (sf);
- KVAR (current_kboard, Vwindow_system) = Qpc;
+ kset_window_system (current_kboard, Qpc);
sf->output_method = output_msdos_raw;
if (init_needed)
{
@@ -1813,7 +1806,7 @@ internal_terminal_init (void)
}
Vinitial_window_system = Qpc;
- Vwindow_system_version = make_number (23); /* RE Emacs version */
+ Vwindow_system_version = make_number (24); /* RE Emacs version */
tty->terminal->type = output_msdos_raw;
/* If Emacs was dumped on DOS/V machine, forget the stale VRAM
@@ -1844,7 +1837,6 @@ internal_terminal_init (void)
FRAME_BACKGROUND_PIXEL (SELECTED_FRAME ()) = colors[1];
}
the_only_display_info.mouse_highlight.mouse_face_mouse_frame = NULL;
- the_only_display_info.mouse_highlight.mouse_face_deferred_gc = 0;
the_only_display_info.mouse_highlight.mouse_face_beg_row =
the_only_display_info.mouse_highlight.mouse_face_beg_col = -1;
the_only_display_info.mouse_highlight.mouse_face_end_row =
@@ -2428,10 +2420,10 @@ and then the scan code. */)
else
{
val = Fvector (NUM_RECENT_DOSKEYS, keys);
- memcpy (XVECTOR (val)->contents, keys + recent_doskeys_index,
- (NUM_RECENT_DOSKEYS - recent_doskeys_index) * sizeof (Lisp_Object));
- memcpy (XVECTOR (val)->contents + NUM_RECENT_DOSKEYS - recent_doskeys_index,
- keys, recent_doskeys_index * sizeof (Lisp_Object));
+ vcopy (val, 0, keys + recent_doskeys_index,
+ NUM_RECENT_DOSKEYS - recent_doskeys_index);
+ vcopy (val, NUM_RECENT_DOSKEYS - recent_doskeys_index,
+ keys, recent_doskeys_index);
return val;
}
}
@@ -2466,12 +2458,12 @@ dos_rawgetc (void)
sc = regs.h.ah;
total_doskeys += 2;
- XVECTOR (recent_doskeys)->contents[recent_doskeys_index++]
- = make_number (c);
+ ASET (recent_doskeys, recent_doskeys_index, make_number (c));
+ recent_doskeys_index++;
if (recent_doskeys_index == NUM_RECENT_DOSKEYS)
recent_doskeys_index = 0;
- XVECTOR (recent_doskeys)->contents[recent_doskeys_index++]
- = make_number (sc);
+ ASET (recent_doskeys, recent_doskeys_index, make_number (sc));
+ recent_doskeys_index++;
if (recent_doskeys_index == NUM_RECENT_DOSKEYS)
recent_doskeys_index = 0;
@@ -2822,7 +2814,7 @@ IT_menu_create (void)
{
XMenu *menu;
- menu = (XMenu *) xmalloc (sizeof (XMenu));
+ menu = xmalloc (sizeof (XMenu));
menu->allocated = menu->count = menu->panecount = menu->width = 0;
return menu;
}
@@ -2836,10 +2828,10 @@ IT_menu_make_room (XMenu *menu)
if (menu->allocated == 0)
{
int count = menu->allocated = 10;
- menu->text = (char **) xmalloc (count * sizeof (char *));
- menu->submenu = (XMenu **) xmalloc (count * sizeof (XMenu *));
- menu->panenumber = (int *) xmalloc (count * sizeof (int));
- menu->help_text = (const char **) xmalloc (count * sizeof (char *));
+ menu->text = xmalloc (count * sizeof (char *));
+ menu->submenu = xmalloc (count * sizeof (XMenu *));
+ menu->panenumber = xmalloc (count * sizeof (int));
+ menu->help_text = xmalloc (count * sizeof (char *));
}
else if (menu->allocated == menu->count)
{
@@ -2920,7 +2912,7 @@ IT_menu_display (XMenu *menu, int y, int x, int pn, int *faces, int disp_help)
width = menu->width;
/* We multiply width by 2 to account for possible control characters.
FIXME: cater to non-ASCII characters in menus. */
- text = (struct glyph *) xmalloc ((width * 2 + 2) * sizeof (struct glyph));
+ text = xmalloc ((width * 2 + 2) * sizeof (struct glyph));
ScreenGetCursor (&row, &col);
mouse_get_xy (&mx, &my);
IT_update_begin (sf);
@@ -3008,7 +3000,7 @@ XMenuAddPane (Display *foo, XMenu *menu, const char *txt, int enable)
const char *p;
if (!enable)
- abort ();
+ emacs_abort ();
IT_menu_make_room (menu);
menu->submenu[menu->count] = IT_menu_create ();
@@ -3300,7 +3292,7 @@ XMenuActivate (Display *foo, XMenu *menu, int *pane, int *selidx,
Emacs will process them after we return and surprise the user. */
discard_mouse_events ();
mouse_clear_clicks ();
- if (!kbd_buffer_events_waiting (1))
+ if (!kbd_buffer_events_waiting ())
clear_input_pending ();
/* Allow mouse events generation by dos_rawgetc. */
mouse_preempted--;
@@ -3922,8 +3914,10 @@ croak (char *badfunc)
/*
* A few unimplemented functions that we silently ignore.
*/
-int setpgrp (void) {return 0; }
+pid_t tcgetpgrp (int fd) { return 0; }
+int setpgid (int pid, int pgid) { return 0; }
int setpriority (int x, int y, int z) { return 0; }
+pid_t setsid (void) { return 0; }
#if __DJGPP__ == 2 && __DJGPP_MINOR__ < 4
ssize_t
@@ -4072,13 +4066,6 @@ sigprocmask (int how, const sigset_t *new_set, sigset_t *old_set)
#ifndef HAVE_SELECT
#include "sysselect.h"
-#ifndef EMACS_TIME_ZERO_OR_NEG_P
-#define EMACS_TIME_ZERO_OR_NEG_P(time) \
- ((long)(time).tv_sec < 0 \
- || ((time).tv_sec == 0 \
- && (long)(time).tv_usec <= 0))
-#endif
-
/* This yields the rest of the current time slice to the task manager.
It should be called by any code which knows that it has nothing
useful to do except idle.
@@ -4104,10 +4091,10 @@ dos_yield_time_slice (void)
because wait_reading_process_output takes care of that. */
int
sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
- EMACS_TIME *timeout)
+ EMACS_TIME *timeout, void *ignored)
{
int check_input;
- struct time t;
+ struct timespec t;
check_input = 0;
if (rfds)
@@ -4121,7 +4108,7 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
FD_ZERO (efds);
if (nfds != 1)
- abort ();
+ emacs_abort ();
/* If we are looking only for the terminal, with no timeout,
just read it and wait -- that's more efficient. */
@@ -4137,22 +4124,17 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
EMACS_TIME clnow, cllast, cldiff;
gettime (&t);
- EMACS_SET_SECS_USECS (cllast, t.ti_sec, t.ti_hund * 10000L);
+ cllast = make_emacs_time (t.tv_sec, t.tv_nsec);
while (!check_input || !detect_input_pending ())
{
gettime (&t);
- EMACS_SET_SECS_USECS (clnow, t.ti_sec, t.ti_hund * 10000L);
- EMACS_SUB_TIME (cldiff, clnow, cllast);
-
- /* When seconds wrap around, we assume that no more than
- 1 minute passed since last `gettime'. */
- if (EMACS_TIME_NEG_P (cldiff))
- EMACS_SET_SECS (cldiff, EMACS_SECS (cldiff) + 60);
- EMACS_SUB_TIME (*timeout, *timeout, cldiff);
+ clnow = make_emacs_time (t.tv_sec, t.tv_nsec);
+ cldiff = sub_emacs_time (clnow, cllast);
+ *timeout = sub_emacs_time (*timeout, cldiff);
/* Stop when timeout value crosses zero. */
- if (EMACS_TIME_ZERO_OR_NEG_P (*timeout))
+ if (EMACS_TIME_SIGN (*timeout) <= 0)
return 0;
cllast = clnow;
dos_yield_time_slice ();
@@ -4221,26 +4203,8 @@ init_gettimeofday (void)
}
#endif
-#ifdef abort
-#undef abort
-void
-dos_abort (char *file, int line)
-{
- char buffer1[200], buffer2[400];
- int i, j;
-
- sprintf (buffer1, "<EMACS FATAL ERROR IN %s LINE %d>", file, line);
- for (i = j = 0; buffer1[i]; i++) {
- buffer2[j++] = buffer1[i];
- buffer2[j++] = 0x70;
- }
- dosmemput (buffer2, j, (int)ScreenPrimary);
- ScreenSetCursor (2, 0);
- abort ();
-}
-#else
-void
-abort (void)
+static void
+msdos_abort (void)
{
dos_ttcooked ();
ScreenSetCursor (10, 0);
@@ -4256,7 +4220,15 @@ abort (void)
#endif /* __DJGPP_MINOR__ >= 2 */
exit (2);
}
-#endif
+
+void
+msdos_fatal_signal (int sig)
+{
+ if (sig == SIGABRT)
+ msdos_abort ();
+ else
+ raise (sig);
+}
void
syms_of_msdos (void)
@@ -4270,7 +4242,7 @@ syms_of_msdos (void)
DEFSYM (Qreverse, "reverse");
DEFVAR_LISP ("dos-unsupported-char-glyph", Vdos_unsupported_char_glyph,
- doc: /* *Glyph to display instead of chars not supported by current codepage.
+ doc: /* Glyph to display instead of chars not supported by current codepage.
This variable is used only by MS-DOS terminals. */);
Vdos_unsupported_char_glyph = make_number ('\177');
diff --git a/src/msdos.h b/src/msdos.h
index 3048b5f7e35..a73c1f2901f 100644
--- a/src/msdos.h
+++ b/src/msdos.h
@@ -1,5 +1,5 @@
/* MS-DOS specific C utilities, interface.
- Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ns.mk b/src/ns.mk
deleted file mode 100644
index c364dae7086..00000000000
--- a/src/ns.mk
+++ /dev/null
@@ -1,39 +0,0 @@
-### autodeps.mk --- src/Makefile fragment for GNU Emacs
-
-## Copyright (C) 2008-2011 Free Software Foundation, Inc.
-
-## This file is part of GNU Emacs.
-
-## GNU Emacs is free software: you can redistribute it and/or modify
-## it under the terms of the GNU General Public License as published by
-## the Free Software Foundation, either version 3 of the License, or
-## (at your option) any later version.
-##
-## GNU Emacs is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-### Commentary:
-
-## This is inserted in src/Makefile if HAVE_NS.
-
-## The only reason this is in a separate file is because $ns_appdir,
-## which appears as a target, is empty on non-NS builds. Some makes
-## do not like empty targets, even if they are never used.
-
-${ns_appdir}: ${ns_appsrc}
- rm -fr ${ns_appdir}
- mkdir -p ${ns_appdir}
- ( cd ${ns_appsrc} ; tar cfh - . ) | ( cd ${ns_appdir} ; umask 022; tar xf - )
-
-${ns_appbindir}Emacs: emacs${EXEEXT}
- mkdir -p ${ns_appbindir}
- cp -f emacs${EXEEXT} ${ns_appbindir}Emacs
-
-ns-app: ${ns_appdir} ${ns_appbindir}Emacs
-
-### ns.mk ends here
diff --git a/src/nsfns.m b/src/nsfns.m
index e41b77e242a..e8bf696e7f5 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -1,6 +1,6 @@
/* Functions for the NeXT/Open/GNUstep and MacOSX window system.
-Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2011
+Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -30,19 +30,18 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
interpretation of even the system includes. */
#include <config.h>
-#include <signal.h>
#include <math.h>
-#include <setjmp.h>
+#include <c-strcase.h>
#include "lisp.h"
#include "blockinput.h"
#include "nsterm.h"
#include "window.h"
+#include "character.h"
#include "buffer.h"
#include "keyboard.h"
#include "termhooks.h"
#include "fontset.h"
-#include "character.h"
#include "font.h"
#if 0
@@ -81,7 +80,6 @@ extern Lisp_Object Qface_set_after_frame_default;
extern Lisp_Object Qunderline, Qundefined;
extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
-extern Lisp_Object Qnone;
Lisp_Object Qbuffered;
@@ -95,13 +93,11 @@ EmacsTooltip *ns_tooltip;
/* Need forward declaration here to preserve organizational integrity of file */
Lisp_Object Fx_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
-extern BOOL ns_in_resize;
-
/* Static variables to handle applescript execution. */
static Lisp_Object as_script, *as_result;
static int as_status;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
static ptrdiff_t image_cache_refcount;
#endif
@@ -169,7 +165,7 @@ check_ns_display_info (Lisp_Object frame)
struct terminal *t = get_terminal (frame, 1);
if (t->type != output_ns)
- error ("Terminal %ld is not a Nextstep display", (long) XINT (frame));
+ error ("Terminal %"pI"d is not a Nextstep display", XINT (frame));
return t->display_info.ns;
}
@@ -435,9 +431,6 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
NSView *view = FRAME_NS_VIEW (f);
NSTRACE (x_set_icon_name);
- if (ns_in_resize)
- return;
-
/* see if it's changed */
if (STRINGP (arg))
{
@@ -447,7 +440,7 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
return;
- f->icon_name = arg;
+ fset_icon_name (f, arg);
if (NILP (arg))
{
@@ -470,11 +463,11 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
if ([[view window] miniwindowTitle] &&
([[[view window] miniwindowTitle]
isEqualToString: [NSString stringWithUTF8String:
- SDATA (arg)]]))
+ SSDATA (arg)]]))
return;
[[view window] setMiniwindowTitle:
- [NSString stringWithUTF8String: SDATA (arg)]];
+ [NSString stringWithUTF8String: SSDATA (arg)]];
}
static void
@@ -489,7 +482,7 @@ ns_set_name_internal (FRAME_PTR f, Lisp_Object name)
encoded_name = ENCODE_UTF_8 (name);
UNGCPRO;
- str = [NSString stringWithUTF8String: SDATA (encoded_name)];
+ str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
/* Don't change the name if it's already NAME. */
if (! [[[view window] title] isEqualToString: str])
@@ -500,7 +493,7 @@ ns_set_name_internal (FRAME_PTR f, Lisp_Object name)
else
encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
- str = [NSString stringWithUTF8String: SDATA (encoded_icon_name)];
+ str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
if ([[view window] miniwindowTitle] &&
! [[[view window] miniwindowTitle] isEqualToString: str])
@@ -511,12 +504,8 @@ ns_set_name_internal (FRAME_PTR f, Lisp_Object name)
static void
ns_set_name (struct frame *f, Lisp_Object name, int explicit)
{
- NSView *view;
NSTRACE (ns_set_name);
- if (ns_in_resize)
- return;
-
/* Make sure that requests from lisp code override requests from
Emacs redisplay code. */
if (explicit)
@@ -540,7 +529,7 @@ ns_set_name (struct frame *f, Lisp_Object name, int explicit)
if (! NILP (Fstring_equal (name, f->name)))
return;
- f->name = name;
+ fset_name (f, name);
/* title overrides explicit name */
if (! NILP (f->title))
@@ -591,7 +580,7 @@ x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
update_mode_lines = 1;
- f->title = name;
+ fset_title (f, name);
if (NILP (name))
name = f->name;
@@ -615,10 +604,10 @@ ns_set_name_as_filename (struct frame *f)
NSString *str;
NSTRACE (ns_set_name_as_filename);
- if (f->explicit_name || ! NILP (f->title) || ns_in_resize)
+ if (f->explicit_name || ! NILP (f->title))
return;
- BLOCK_INPUT;
+ block_input ();
pool = [[NSAutoreleasePool alloc] init];
filename = BVAR (XBUFFER (buf), filename);
name = BVAR (XBUFFER (buf), name);
@@ -640,14 +629,14 @@ ns_set_name_as_filename (struct frame *f)
title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
: [[[view window] title] UTF8String];
- if (title && (! strcmp (title, SDATA (encoded_name))))
+ if (title && (! strcmp (title, SSDATA (encoded_name))))
{
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
- str = [NSString stringWithUTF8String: SDATA (encoded_name)];
+ str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
if (str == nil) str = @"Bad coding";
if (FRAME_ICONIFIED_P (f))
@@ -662,7 +651,7 @@ ns_set_name_as_filename (struct frame *f)
encoded_filename = ENCODE_UTF_8 (filename);
UNGCPRO;
- fstr = [NSString stringWithUTF8String: SDATA (encoded_filename)];
+ fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
if (fstr == nil) fstr = @"";
#ifdef NS_IMPL_COCOA
/* work around a bug observed on 10.3 and later where
@@ -677,11 +666,11 @@ ns_set_name_as_filename (struct frame *f)
[[view window] setRepresentedFilename: fstr];
[[view window] setTitle: str];
- f->name = name;
+ fset_name (f, name);
}
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -692,11 +681,11 @@ ns_set_doc_edited (struct frame *f, Lisp_Object arg)
NSAutoreleasePool *pool;
if (!MINI_WINDOW_P (XWINDOW (f->selected_window)))
{
- BLOCK_INPUT;
+ block_input ();
pool = [[NSAutoreleasePool alloc] init];
[[view window] setDocumentEdited: !NILP (arg)];
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -705,11 +694,10 @@ void
x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
int nlines;
- int olines = FRAME_MENU_BAR_LINES (f);
if (FRAME_MINIBUF_ONLY_P (f))
return;
- if (INTEGERP (value))
+ if (TYPE_RANGED_INTEGERP (int, value))
nlines = XINT (value);
else
nlines = 0;
@@ -736,12 +724,11 @@ void
x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
int nlines;
- Lisp_Object root_window;
if (FRAME_MINIBUF_ONLY_P (f))
return;
- if (INTEGERP (value) && XINT (value) >= 0)
+ if (RANGED_INTEGERP (0, value, INT_MAX))
nlines = XFASTINT (value);
else
nlines = 0;
@@ -776,14 +763,14 @@ ns_implicitly_set_icon_type (struct frame *f)
NSTRACE (ns_implicitly_set_icon_type);
- BLOCK_INPUT;
+ block_input ();
pool = [[NSAutoreleasePool alloc] init];
if (f->output_data.ns->miniimage
- && [[NSString stringWithUTF8String: SDATA (f->name)]
+ && [[NSString stringWithUTF8String: SSDATA (f->name)]
isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
{
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
@@ -791,7 +778,7 @@ ns_implicitly_set_icon_type (struct frame *f)
if (CONSP (tem) && ! NILP (XCDR (tem)))
{
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
@@ -801,10 +788,10 @@ ns_implicitly_set_icon_type (struct frame *f)
{
elt = XCAR (chain);
/* special case: 't' means go by file type */
- if (SYMBOLP (elt) && EQ (elt, Qt) && SDATA (f->name)[0] == '/')
+ if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/')
{
NSString *str
- = [NSString stringWithUTF8String: SDATA (f->name)];
+ = [NSString stringWithUTF8String: SSDATA (f->name)];
if ([[NSFileManager defaultManager] fileExistsAtPath: str])
image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
}
@@ -817,7 +804,7 @@ ns_implicitly_set_icon_type (struct frame *f)
if (image == nil)
image = [[NSImage imageNamed:
[NSString stringWithUTF8String:
- SDATA (XCDR (elt))]] retain];
+ SSDATA (XCDR (elt))]] retain];
}
}
@@ -831,7 +818,7 @@ ns_implicitly_set_icon_type (struct frame *f)
f->output_data.ns->miniimage = image;
[view setMiniwindowImage: setMini];
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -846,7 +833,7 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
if (!NILP (arg) && SYMBOLP (arg))
{
- arg =build_string (SDATA (SYMBOL_NAME (arg)));
+ arg =build_string (SSDATA (SYMBOL_NAME (arg)));
store_frame_param (f, Qicon_type, arg);
}
@@ -862,7 +849,7 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
image = [EmacsImage allocInitFromFile: arg];
if (image == nil)
image =[NSImage imageNamed: [NSString stringWithUTF8String:
- SDATA (arg)]];
+ SSDATA (arg)]];
if (image == nil)
{
@@ -875,25 +862,15 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
}
-/* Xism; we stub out (we do implement this in ns-win.el) */
-int
-XParseGeometry (char *string, int *x, int *y,
- unsigned int *width, unsigned int *height)
-{
- message1 ("Warning: XParseGeometry not supported under NS.\n");
- return 0;
-}
-
-
/* TODO: move to nsterm? */
int
ns_lisp_to_cursor_type (Lisp_Object arg)
{
char *str;
if (XTYPE (arg) == Lisp_String)
- str = SDATA (arg);
+ str = SSDATA (arg);
else if (XTYPE (arg) == Lisp_Symbol)
- str = SDATA (SYMBOL_NAME (arg));
+ str = SSDATA (SYMBOL_NAME (arg));
else return -1;
if (!strcmp (str, "box")) return FILLED_BOX_CURSOR;
if (!strcmp (str, "hollow")) return HOLLOW_BOX_CURSOR;
@@ -1033,7 +1010,7 @@ frame_parm_handler ns_frame_parm_handlers[] =
x_set_fringe_width, /* generic OK */
x_set_fringe_width, /* generic OK */
0, /* x_set_wait_for_wm, will ignore */
- 0, /* x_set_fullscreen will ignore */
+ x_set_fullscreen, /* generic OK */
x_set_font_backend, /* generic OK */
x_set_alpha,
0, /* x_set_sticky */
@@ -1058,16 +1035,16 @@ unwind_create_frame (Lisp_Object frame)
/* If frame is ``official'', nothing to do. */
if (NILP (Fmemq (frame, Vframe_list)))
{
-#if GLYPH_DEBUG && XASSERTS
+#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
struct ns_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
#endif
x_free_frame_resources (f);
free_glyphs (f);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check that reference counts are indeed correct. */
- xassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
+ eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
#endif
return Qt;
}
@@ -1136,7 +1113,7 @@ This function is an internal primitive--use `make-frame' instead. */)
int minibuffer_only = 0;
int window_prompting = 0;
int width, height;
- int count = specpdl_ptr - specpdl;
+ ptrdiff_t count = specpdl_ptr - specpdl;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object display;
struct ns_display_info *dpyinfo = NULL;
@@ -1198,20 +1175,19 @@ This function is an internal primitive--use `make-frame' instead. */)
f = make_frame (1);
XSETFRAME (frame, f);
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
f->terminal = dpyinfo->terminal;
f->output_method = output_ns;
- f->output_data.ns = (struct ns_output *)xmalloc (sizeof *(f->output_data.ns));
- memset (f->output_data.ns, 0, sizeof *(f->output_data.ns));
+ f->output_data.ns = xzalloc (sizeof *f->output_data.ns);
FRAME_FONTSET (f) = -1;
- f->icon_name = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
- RES_TYPE_STRING);
+ fset_icon_name (f, x_get_arg (dpyinfo, parms, Qicon_name,
+ "iconName", "Title",
+ RES_TYPE_STRING));
if (! STRINGP (f->icon_name))
- f->icon_name = Qnil;
+ fset_icon_name (f, Qnil);
FRAME_NS_DISPLAY_INFO (f) = dpyinfo;
@@ -1219,9 +1195,9 @@ This function is an internal primitive--use `make-frame' instead. */)
record_unwind_protect (unwind_create_frame, frame);
f->output_data.ns->window_desc = desc_ctr++;
- if (!NILP (parent))
+ if (TYPE_RANGED_INTEGERP (Window, parent))
{
- f->output_data.ns->parent_desc = (Window) XFASTINT (parent);
+ f->output_data.ns->parent_desc = XFASTINT (parent);
f->output_data.ns->explicit_parent = 1;
}
else
@@ -1234,12 +1210,12 @@ This function is an internal primitive--use `make-frame' instead. */)
be set. */
if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
{
- f->name = build_string ([ns_app_name UTF8String]);
+ fset_name (f, build_string ([ns_app_name UTF8String]));
f->explicit_name = 0;
}
else
{
- f->name = name;
+ fset_name (f, name);
f->explicit_name = 1;
specbind (Qx_resource_name, name);
}
@@ -1247,7 +1223,7 @@ This function is an internal primitive--use `make-frame' instead. */)
f->resx = dpyinfo->resx;
f->resy = dpyinfo->resy;
- BLOCK_INPUT;
+ block_input ();
register_font_driver (&nsfont_driver, f);
x_default_parameter (f, parms, Qfont_backend, Qnil,
"fontBackend", "FontBackend", RES_TYPE_STRING);
@@ -1262,7 +1238,7 @@ This function is an internal primitive--use `make-frame' instead. */)
build_string ([[font fontName] UTF8String]),
"font", "Font", RES_TYPE_STRING);
}
- UNBLOCK_INPUT;
+ unblock_input ();
x_default_parameter (f, parms, Qborder_width, make_number (0),
"borderwidth", "BorderWidth", RES_TYPE_NUMBER);
@@ -1286,7 +1262,7 @@ This function is an internal primitive--use `make-frame' instead. */)
"foreground", "Foreground", RES_TYPE_STRING);
x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
"background", "Background", RES_TYPE_STRING);
- /* FIXME: not suppported yet in Nextstep */
+ /* FIXME: not supported yet in Nextstep */
x_default_parameter (f, parms, Qline_spacing, Qnil,
"lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qleft_fringe, Qnil,
@@ -1294,7 +1270,7 @@ This function is an internal primitive--use `make-frame' instead. */)
x_default_parameter (f, parms, Qright_fringe, Qnil,
"rightFringe", "RightFringe", RES_TYPE_NUMBER);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
image_cache_refcount =
FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
#endif
@@ -1361,6 +1337,8 @@ This function is an internal primitive--use `make-frame' instead. */)
RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qalpha, Qnil,
"alpha", "Alpha", RES_TYPE_NUMBER);
+ x_default_parameter (f, parms, Qfullscreen, Qnil,
+ "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
width = FRAME_COLS (f);
height = FRAME_LINES (f);
@@ -1394,16 +1372,19 @@ This function is an internal primitive--use `make-frame' instead. */)
if (FRAME_HAS_MINIBUF_P (f)
&& (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
|| !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
- KVAR (kb, Vdefault_minibuffer_frame) = frame;
+ kset_default_minibuffer_frame (kb, frame);
/* All remaining specified parameters, which have not been "used"
by x_get_arg and friends, now go in the misc. alist of the frame. */
for (tem = parms; CONSP (tem); tem = XCDR (tem))
if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
- f->param_alist = Fcons (XCAR (tem), f->param_alist);
+ fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
UNGCPRO;
+ if (window_prompting & USPosition)
+ x_set_offset (f, f->left_pos, f->top_pos, 1);
+
/* Make sure windows on this frame appear in calls to next-window
and similar functions. */
Vwindow_list = Qnil;
@@ -1423,10 +1404,10 @@ FRAME nil means use the selected frame. */)
if (dpyinfo->x_focus_frame != f)
{
EmacsView *view = FRAME_NS_VIEW (f);
- BLOCK_INPUT;
+ block_input ();
[NSApp activateIgnoringOtherApps: YES];
[[view window] makeKeyAndOrderFront: view];
- UNBLOCK_INPUT;
+ unblock_input ();
}
return Qnil;
@@ -1479,13 +1460,15 @@ DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
}
-DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 4, 0,
+DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 5, 0,
doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
Optional arg DIR, if non-nil, supplies a default directory.
Optional arg MUSTMATCH, if non-nil, means the returned file or
directory must exist.
-Optional arg INIT, if non-nil, provides a default file name to use. */)
- (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch, Lisp_Object init)
+Optional arg INIT, if non-nil, provides a default file name to use.
+Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */)
+ (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch,
+ Lisp_Object init, Lisp_Object dir_only_p)
{
static id fileDelegate = nil;
int ret;
@@ -1493,12 +1476,12 @@ Optional arg INIT, if non-nil, provides a default file name to use. */)
Lisp_Object fname;
NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
- [NSString stringWithUTF8String: SDATA (prompt)];
+ [NSString stringWithUTF8String: SSDATA (prompt)];
NSString *dirS = NILP (dir) || !STRINGP (dir) ?
- [NSString stringWithUTF8String: SDATA (BVAR (current_buffer, directory))] :
- [NSString stringWithUTF8String: SDATA (dir)];
+ [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
+ [NSString stringWithUTF8String: SSDATA (dir)];
NSString *initS = NILP (init) || !STRINGP (init) ? nil :
- [NSString stringWithUTF8String: SDATA (init)];
+ [NSString stringWithUTF8String: SSDATA (init)];
check_ns ();
@@ -1510,21 +1493,36 @@ Optional arg INIT, if non-nil, provides a default file name to use. */)
if ([dirS characterAtIndex: 0] == '~')
dirS = [dirS stringByExpandingTildeInPath];
- panel = NILP (mustmatch) ?
+ panel = NILP (mustmatch) && NILP (dir_only_p) ?
(id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
[panel setTitle: promptS];
- /* Puma (10.1) does not have */
- if ([panel respondsToSelector: @selector (setAllowsOtherFileTypes:)])
- [panel setAllowsOtherFileTypes: YES];
-
+ [panel setAllowsOtherFileTypes: YES];
[panel setTreatsFilePackagesAsDirectories: YES];
[panel setDelegate: fileDelegate];
panelOK = 0;
- BLOCK_INPUT;
- if (NILP (mustmatch))
+ if (! NILP (dir_only_p))
+ {
+ [panel setCanChooseDirectories: YES];
+ [panel setCanChooseFiles: NO];
+ }
+
+ block_input ();
+#if defined (NS_IMPL_COCOA) && \
+ MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
+ if (! NILP (mustmatch) || ! NILP (dir_only_p))
+ [panel setAllowedFileTypes: nil];
+ if (dirS) [panel setDirectoryURL: [NSURL fileURLWithPath: dirS]];
+ if (initS && NILP (Ffile_directory_p (init)))
+ [panel setNameFieldStringValue: [initS lastPathComponent]];
+ else
+ [panel setNameFieldStringValue: @""];
+
+ ret = [panel runModal];
+#else
+ if (NILP (mustmatch) && NILP (dir_only_p))
{
ret = [panel runModalForDirectory: dirS file: initS];
}
@@ -1533,6 +1531,7 @@ Optional arg INIT, if non-nil, provides a default file name to use. */)
[panel setCanChooseDirectories: YES];
ret = [panel runModalForDirectory: dirS file: initS types: nil];
}
+#endif
ret = (ret == NSOKButton) || panelOK;
@@ -1540,7 +1539,7 @@ Optional arg INIT, if non-nil, provides a default file name to use. */)
fname = build_string ([[panel filename] UTF8String]);
[[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
- UNBLOCK_INPUT;
+ unblock_input ();
return ret ? fname : Qnil;
}
@@ -1568,9 +1567,9 @@ If OWNER is nil, Emacs is assumed. */)
if (NILP (owner))
owner = build_string([ns_app_name UTF8String]);
CHECK_STRING (name);
-/*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SDATA (name)); */
+/*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SSDATA (name)); */
- value = ns_get_defaults_value (SDATA (name));
+ value = ns_get_defaults_value (SSDATA (name));
if (value)
return build_string (value);
@@ -1591,15 +1590,15 @@ If VALUE is nil, the default is removed. */)
if (NILP (value))
{
[[NSUserDefaults standardUserDefaults] removeObjectForKey:
- [NSString stringWithUTF8String: SDATA (name)]];
+ [NSString stringWithUTF8String: SSDATA (name)]];
}
else
{
CHECK_STRING (value);
[[NSUserDefaults standardUserDefaults] setObject:
- [NSString stringWithUTF8String: SDATA (value)]
+ [NSString stringWithUTF8String: SSDATA (value)]
forKey: [NSString stringWithUTF8String:
- SDATA (name)]];
+ SSDATA (name)]];
}
return Qnil;
@@ -1795,25 +1794,12 @@ terminate Emacs if we can't open the connection.
{
if (!NILP (must_succeed))
fatal ("OpenStep on %s not responding.\n",
- SDATA (display));
+ SSDATA (display));
else
error ("OpenStep on %s not responding.\n",
- SDATA (display));
+ SSDATA (display));
}
- /* Register our external input/output types, used for determining
- applicable services and also drag/drop eligibility. */
- ns_send_types = [[NSArray arrayWithObjects: NSStringPboardType, nil] retain];
- ns_return_types = [[NSArray arrayWithObjects: NSStringPboardType, nil]
- retain];
- ns_drag_types = [[NSArray arrayWithObjects:
- NSStringPboardType,
- NSTabularTextPboardType,
- NSFilenamesPboardType,
- NSURLPboardType,
- NSColorPboardType,
- NSFontPboardType, nil] retain];
-
return Qnil;
}
@@ -1897,14 +1883,14 @@ font descriptor. If string contains `fontset' and not
{
char *nm;
CHECK_STRING (name);
- nm = SDATA (name);
+ nm = SSDATA (name);
if (nm[0] != '-')
return name;
if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
return name;
- return build_string (ns_xlfd_to_fontname (SDATA (name)));
+ return build_string (ns_xlfd_to_fontname (SSDATA (name)));
}
@@ -1924,17 +1910,17 @@ The optional argument FRAME is currently ignored. */)
error ("non-Nextstep frame used in `ns-list-colors'");
}
- BLOCK_INPUT;
+ block_input ();
colorlists = [[NSColorList availableColorLists] objectEnumerator];
- while (clist = [colorlists nextObject])
+ while ((clist = [colorlists nextObject]))
{
if ([[clist name] length] < 7 ||
[[clist name] rangeOfString: @"PANTONE"].location == 0)
{
NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
NSString *cname;
- while (cname = [cnames nextObject])
+ while ((cname = [cnames nextObject]))
list = Fcons (build_string ([cname UTF8String]), list);
/* for (i = [[clist allKeys] count] - 1; i >= 0; i--)
list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
@@ -1942,7 +1928,7 @@ The optional argument FRAME is currently ignored. */)
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return list;
}
@@ -1962,32 +1948,29 @@ DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
check_ns ();
svcs = [[NSMenu alloc] initWithTitle: @"Services"];
- [NSApp setServicesMenu: svcs]; /* this and next rebuild on <10.4 */
+ [NSApp setServicesMenu: svcs];
[NSApp registerServicesMenuSendTypes: ns_send_types
returnTypes: ns_return_types];
/* On Tiger, services menu updating was made lazier (waits for user to
actually click on the menu), so we have to force things along: */
#ifdef NS_IMPL_COCOA
- if (NSAppKitVersionNumber >= 744.0)
+ delegate = [svcs delegate];
+ if (delegate != nil)
{
- delegate = [svcs delegate];
- if (delegate != nil)
+ if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
+ [delegate menuNeedsUpdate: svcs];
+ if ([delegate respondsToSelector:
+ @selector (menu:updateItem:atIndex:shouldCancel:)])
{
- if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
- [delegate menuNeedsUpdate: svcs];
- if ([delegate respondsToSelector:
- @selector (menu:updateItem:atIndex:shouldCancel:)])
- {
- int i, len = [delegate numberOfItemsInMenu: svcs];
- for (i =0; i<len; i++)
- [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
- for (i =0; i<len; i++)
- if (![delegate menu: svcs
- updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
- atIndex: i shouldCancel: NO])
- break;
- }
+ int i, len = [delegate numberOfItemsInMenu: svcs];
+ for (i =0; i<len; i++)
+ [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
+ for (i =0; i<len; i++)
+ if (![delegate menu: svcs
+ updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
+ atIndex: i shouldCancel: NO])
+ break;
}
}
#endif
@@ -2014,12 +1997,11 @@ there was no result. */)
id pb;
NSString *svcName;
char *utfStr;
- int len;
CHECK_STRING (service);
check_ns ();
- utfStr = SDATA (service);
+ utfStr = SSDATA (service);
svcName = [NSString stringWithUTF8String: utfStr];
pb =[NSPasteboard pasteboardWithUniqueName];
@@ -2044,7 +2026,7 @@ DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
NSString *utfStr;
CHECK_STRING (str);
- utfStr = [NSString stringWithUTF8String: SDATA (str)];
+ utfStr = [NSString stringWithUTF8String: SSDATA (str)];
if (![utfStr respondsToSelector:
@selector (precomposedStringWithCanonicalMapping)])
{
@@ -2074,7 +2056,7 @@ ns_do_applescript (Lisp_Object script, Lisp_Object *result)
NSAppleScript* scriptObject =
[[NSAppleScript alloc] initWithSource:
- [NSString stringWithUTF8String: SDATA (script)]];
+ [NSString stringWithUTF8String: SSDATA (script)]];
returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
[scriptObject release];
@@ -2089,7 +2071,7 @@ ns_do_applescript (Lisp_Object script, Lisp_Object *result)
*result = Qt;
// script returned an AppleScript result
if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_4
+#if defined (NS_IMPL_COCOA)
(typeUTF16ExternalRepresentation
== [returnDescriptor descriptorType]) ||
#endif
@@ -2141,7 +2123,7 @@ In case the execution fails, an error is signaled. */)
CHECK_STRING (script);
check_ns ();
- BLOCK_INPUT;
+ block_input ();
as_script = script;
as_result = &result;
@@ -2167,13 +2149,13 @@ In case the execution fails, an error is signaled. */)
as_status = 0;
as_script = Qnil;
as_result = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
if (status == 0)
return result;
else if (!STRINGP (result))
error ("AppleScript error %d", status);
else
- error ("%s", SDATA (result));
+ error ("%s", SSDATA (result));
}
#endif
@@ -2227,8 +2209,8 @@ x_get_string_resource (XrmDatabase rdb, char *name, char *class)
res = ns_get_defaults_value (toCheck);
return !res ? NULL :
- (!strncasecmp (res, "YES", 3) ? "true" :
- (!strncasecmp (res, "NO", 2) ? "false" : res));
+ (!c_strncasecmp (res, "YES", 3) ? "true" :
+ (!c_strncasecmp (res, "NO", 2) ? "false" : res));
}
@@ -2400,7 +2382,6 @@ frame, a display name (a string), or terminal ID. If omitted or nil,
that stands for the selected frame's display. */)
(Lisp_Object display)
{
- int top;
NSScreen *screen;
NSRect vScreen;
@@ -2548,7 +2529,7 @@ Text larger than the specified size is clipped. */)
{
int root_x, root_y;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct frame *f;
char *str;
NSSize size;
@@ -2558,7 +2539,7 @@ Text larger than the specified size is clipped. */)
GCPRO4 (string, parms, frame, timeout);
CHECK_STRING (string);
- str = SDATA (string);
+ str = SSDATA (string);
f = check_x_frame (frame);
if (NILP (timeout))
timeout = make_number (5);
@@ -2575,7 +2556,7 @@ Text larger than the specified size is clipped. */)
else
CHECK_NUMBER (dy);
- BLOCK_INPUT;
+ block_input ();
if (ns_tooltip == nil)
ns_tooltip = [[EmacsTooltip alloc] init];
else
@@ -2590,7 +2571,7 @@ Text larger than the specified size is clipped. */)
&root_x, &root_y);
[ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
- UNBLOCK_INPUT;
+ unblock_input ();
UNGCPRO;
return unbind_to (count, Qnil);
@@ -2692,8 +2673,6 @@ Value is t if tooltip was open, nil otherwise. */)
void
syms_of_nsfns (void)
{
- int i;
-
Qfontsize = intern_c_string ("fontsize");
staticpro (&Qfontsize);
diff --git a/src/nsfont.m b/src/nsfont.m
index eb57f5e5953..2ba38b7570e 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -1,6 +1,6 @@
/* Font back-end driver for the NeXT/Open/GNUstep and MacOSX window system.
See font.h
- Copyright (C) 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 2006-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -23,7 +23,6 @@ Author: Adrian Robert (arobert@cogsci.ucsd.edu)
/* This should be the first include, as it may set up #defines affecting
interpretation of even the system includes. */
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
#include "dispextern.h"
@@ -47,13 +46,15 @@ Author: Adrian Robert (arobert@cogsci.ucsd.edu)
#define NSFONT_TRACE 0
extern Lisp_Object Qns;
-extern Lisp_Object Qnormal, Qbold, Qitalic, Qcondensed, Qexpanded;
+extern Lisp_Object Qnormal, Qbold, Qitalic;
static Lisp_Object Qapple, Qroman, Qmedium;
+static Lisp_Object Qcondensed, Qexpanded;
extern Lisp_Object Qappend;
extern float ns_antialias_threshold;
extern int ns_tmp_flags;
extern struct nsfont_info *ns_tmp_font;
+
/* font glyph and metrics caching functions, implemented at end */
static void ns_uni_to_glyphs (struct nsfont_info *font_info,
unsigned char block);
@@ -100,7 +101,7 @@ ns_get_family (Lisp_Object font_spec)
return nil;
else
{
- char *tmp = xstrdup (SDATA (SYMBOL_NAME (tem)));
+ char *tmp = xstrdup (SSDATA (SYMBOL_NAME (tem)));
NSString *family;
ns_unescape_name (tmp);
family = [NSString stringWithUTF8String: tmp];
@@ -152,7 +153,7 @@ ns_spec_to_descriptor (Lisp_Object font_spec)
[fdAttrs setObject: tdict forKey: NSFontTraitsAttribute];
fdesc = [NSFontDescriptor fontDescriptorWithFontAttributes: fdAttrs];
- if (family != nil)
+ if (family != nil)
{
fdesc = [fdesc fontDescriptorWithFamily: family];
}
@@ -201,8 +202,8 @@ ns_descriptor_to_entity (NSFontDescriptor *desc,
make_number (100 + 100
* ns_attribute_fvalue (desc, NSFontSlantTrait)));*/
FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX,
- traits & NSFontCondensedTrait ? Qcondensed :
- traits & NSFontExpandedTrait ? Qexpanded : Qnormal);
+ traits & NSFontCondensedTrait ? Qcondensed :
+ traits & NSFontExpandedTrait ? Qexpanded : Qnormal);
/* FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX,
make_number (100 + 100
* ns_attribute_fvalue (desc, NSFontWidthTrait)));*/
@@ -236,27 +237,63 @@ ns_fallback_entity (void)
}
-/* Utility: get width of a char c in screen font sfont */
+/* Utility: get width of a char c in screen font SFONT */
static float
ns_char_width (NSFont *sfont, int c)
{
- float w;
- NSString *cstr = [NSString stringWithFormat: @"%c", c];
+ float w = -1.0;
+ NSString *cstr = [NSString stringWithFormat: @"%c", c];
+
#ifdef NS_IMPL_COCOA
- NSGlyph glyph = [sfont glyphWithName: cstr];
- if (glyph)
- {
- float w = [sfont advancementForGlyph: glyph].width;
- if (w >= 1.5)
- return w;
- }
+ NSGlyph glyph = [sfont glyphWithName: cstr];
+ if (glyph)
+ w = [sfont advancementForGlyph: glyph].width;
#endif
+
+ if (w < 0.0)
{
NSDictionary *attrsDictionary =
[NSDictionary dictionaryWithObject: sfont forKey: NSFontAttributeName];
w = [cstr sizeWithAttributes: attrsDictionary].width;
}
- return max (w, 2.0);
+
+ return max (w, 1.0);
+}
+
+/* Return average width over ASCII printable characters for SFONT. */
+
+static NSString *ascii_printable;
+
+static int
+ns_ascii_average_width (NSFont *sfont)
+{
+ float w = -1.0;
+
+ if (!ascii_printable)
+ {
+ char chars[96];
+ int ch;
+ for (ch = 0; ch < 95; ch++)
+ chars[ch] = ' ' + ch;
+ chars[95] = '\0';
+
+ ascii_printable = [[NSString alloc] initWithFormat: @"%s", chars];
+ }
+
+#ifdef NS_IMPL_COCOA
+ NSGlyph glyph = [sfont glyphWithName: ascii_printable];
+ if (glyph)
+ w = [sfont advancementForGlyph: glyph].width;
+#endif
+
+ if (w < 0.0)
+ {
+ NSDictionary *attrsDictionary =
+ [NSDictionary dictionaryWithObject: sfont forKey: NSFontAttributeName];
+ w = [ascii_printable sizeWithAttributes: attrsDictionary].width;
+ }
+
+ return lrint (w / 95.0);
}
@@ -271,6 +308,11 @@ ns_charset_covers(NSCharacterSet *set1, NSCharacterSet *set2, float pct)
const unsigned short *bytes2 = [[set2 bitmapRepresentation] bytes];
int i, off = 0, tot = 0;
+ /* Work around what appears to be a GNUstep bug.
+ See <http://bugs.gnu.org/11853>. */
+ if (! (bytes1 && bytes2))
+ return NO;
+
for (i=0; i<4096; i++, bytes1++, bytes2++)
if (*bytes2)
{
@@ -288,13 +330,13 @@ ns_charset_covers(NSCharacterSet *set1, NSCharacterSet *set2, float pct)
static NSString
*ns_lang_to_script (Lisp_Object lang)
{
- if (!strcmp (SDATA (SYMBOL_NAME (lang)), "ja"))
+ if (!strcmp (SSDATA (SYMBOL_NAME (lang)), "ja"))
return @"han";
/* NOTE: ja given for any hanzi that's also a kanji, but Chinese fonts
have more characters. */
- else if (!strcmp (SDATA (SYMBOL_NAME (lang)), "zh"))
+ else if (!strcmp (SSDATA (SYMBOL_NAME (lang)), "zh"))
return @"han";
- else if (!strcmp (SDATA (SYMBOL_NAME (lang)), "ko"))
+ else if (!strcmp (SSDATA (SYMBOL_NAME (lang)), "ko"))
return @"hangul";
else
return @"";
@@ -308,7 +350,7 @@ static NSString
{
Lisp_Object script = assq_no_quit (XCAR (otf), Votf_script_alist);
return CONSP (script)
- ? [NSString stringWithUTF8String: SDATA (SYMBOL_NAME (XCDR ((script))))]
+ ? [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (XCDR ((script))))]
: @"";
}
@@ -321,10 +363,10 @@ static NSString
while CONSP (rts)
{
r = XCAR (XCAR (rts));
- if (!strncmp(SDATA(r), reg, strlen(SDATA(r))))
+ if (!strncmp(SSDATA(r), reg, strlen(SSDATA(r))))
{
script = XCDR (XCAR (rts));
- return [NSString stringWithUTF8String: SDATA (SYMBOL_NAME (script))];
+ return [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (script))];
}
rts = XCDR (rts);
}
@@ -350,7 +392,7 @@ static NSString
Lisp_Object key = XCAR (tmp), val = XCDR (tmp);
if (EQ (key, QCscript) && SYMBOLP (val))
return [NSString stringWithUTF8String:
- SDATA (SYMBOL_NAME (val))];
+ SSDATA (SYMBOL_NAME (val))];
if (EQ (key, QClang) && SYMBOLP (val))
return ns_lang_to_script (val);
if (EQ (key, QCotf) && CONSP (val) && SYMBOLP (XCAR (val)))
@@ -368,7 +410,7 @@ static NSString
if (EQ (reg, Qiso10646_1))
reg = Qiso8859_1;
#endif
- return ns_registry_to_script (SDATA (SYMBOL_NAME (reg)));
+ return ns_registry_to_script (SSDATA (SYMBOL_NAME (reg)));
}
return @"";
@@ -459,7 +501,7 @@ static NSSet
while (1)
{
NSEnumerator *allFamiliesEnum = [allFamilies objectEnumerator];
- while (family = [allFamiliesEnum nextObject])
+ while ((family = [allFamiliesEnum nextObject]))
{
NSCharacterSet *fset = [[fontMgr fontWithFamily: family
traits: 0 weight: 5 size: 12.0] coveredCharacterSet];
@@ -518,12 +560,16 @@ ns_findfonts (Lisp_Object font_spec, BOOL isMatch)
if (isMatch)
[fkeys removeObject: NSFontFamilyAttribute];
- matchingDescs = [fdesc matchingFontDescriptorsWithMandatoryKeys: fkeys];
+ if ([fkeys count] > 0)
+ matchingDescs = [fdesc matchingFontDescriptorsWithMandatoryKeys: fkeys];
+ else
+ matchingDescs = [NSMutableArray array];
+
if (NSFONT_TRACE)
NSLog(@"Got desc %@ and found %d matching fonts from it: ", fdesc,
[matchingDescs count]);
- for (dEnum = [matchingDescs objectEnumerator]; desc = [dEnum nextObject]; )
+ for (dEnum = [matchingDescs objectEnumerator]; (desc = [dEnum nextObject]);)
{
if (![cFamilies containsObject:
[desc objectForKey: NSFontFamilyAttribute]])
@@ -557,8 +603,8 @@ ns_findfonts (Lisp_Object font_spec, BOOL isMatch)
return ns_fallback_entity ();
if (NSFONT_TRACE)
- fprintf (stderr, " Returning %ld entities.\n",
- (long) XINT (Flength (list)));
+ fprintf (stderr, " Returning %"pI"d entities.\n",
+ XINT (Flength (list)));
return list;
}
@@ -584,7 +630,7 @@ static unsigned int nsfont_encode_char (struct font *font, int c);
static int nsfont_text_extents (struct font *font, unsigned int *code,
int nglyphs, struct font_metrics *metrics);
static int nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
- int with_background);
+ bool with_background);
struct font_driver nsfont_driver =
{
@@ -659,13 +705,13 @@ nsfont_list_family (Lisp_Object frame)
[[[NSFontManager sharedFontManager] availableFontFamilies]
objectEnumerator];
NSString *family;
- while (family = [families nextObject])
+ while ((family = [families nextObject]))
list = Fcons (intern ([family UTF8String]), list);
/* FIXME: escape the name? */
if (NSFONT_TRACE)
- fprintf (stderr, "nsfont: list families returning %ld entries\n",
- (long) XINT (Flength (list)));
+ fprintf (stderr, "nsfont: list families returning %"pI"d entries\n",
+ XINT (Flength (list)));
return list;
}
@@ -687,18 +733,7 @@ nsfont_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size)
Lisp_Object tem;
NSRect brect;
Lisp_Object font_object;
- int i;
int fixLeopardBug;
- static NSMutableDictionary *fontCache = nil;
- NSNumber *cached;
-
- /* 2008/03/08: The same font may end up being requested for different
- entities, due to small differences in numeric values or other issues,
- or for different copies of the same entity. Therefore we cache to
- avoid creating multiple struct font objects (with metrics cache, etc.)
- for the same NSFont object. */
- if (fontCache == nil)
- fontCache = [[NSMutableDictionary alloc] init];
if (NSFONT_TRACE)
{
@@ -714,7 +749,7 @@ nsfont_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size)
}
tem = AREF (font_entity, FONT_ADSTYLE_INDEX);
- synthItal = !NILP (tem) && !strncmp ("synthItal", SDATA (SYMBOL_NAME (tem)),
+ synthItal = !NILP (tem) && !strncmp ("synthItal", SSDATA (SYMBOL_NAME (tem)),
9);
family = ns_get_family (font_entity);
if (family == nil)
@@ -754,44 +789,26 @@ nsfont_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size)
if (NSFONT_TRACE)
NSLog (@"%@\n", nsfont);
- /* Check the cache */
- cached = [fontCache objectForKey: nsfont];
- if (cached != nil && !synthItal)
- {
- if (NSFONT_TRACE)
- fprintf(stderr, "*** nsfont_open CACHE HIT!\n");
- /* FIXME: Cast from (unsigned long) to Lisp_Object. */
- XHASH (font_object) = [cached unsignedLongValue];
- return font_object;
- }
- else
- {
- font_object = font_make_object (VECSIZE (struct nsfont_info),
- font_entity, pixel_size);
- if (!synthItal)
- [fontCache setObject: [NSNumber numberWithUnsignedLong:
- (unsigned long) XHASH (font_object)]
- forKey: nsfont];
- }
-
+ font_object = font_make_object (VECSIZE (struct nsfont_info),
+ font_entity, pixel_size);
font_info = (struct nsfont_info *) XFONT_OBJECT (font_object);
font = (struct font *) font_info;
if (!font)
return Qnil; /* FIXME: other terms do, but return Qnil causes segfault */
- font_info->glyphs = (unsigned short **)
- xmalloc (0x100 * sizeof (unsigned short *));
- font_info->metrics = (struct font_metrics **)
- xmalloc (0x100 * sizeof (struct font_metrics *));
- if (!font_info->glyphs || !font_info->metrics)
- return Qnil;
- memset (font_info->glyphs, 0, 0x100 * sizeof (unsigned short *));
- memset (font_info->metrics, 0, 0x100 * sizeof (struct font_metrics *));
+ font_info->glyphs = xzalloc (0x100 * sizeof *font_info->glyphs);
+ font_info->metrics = xzalloc (0x100 * sizeof *font_info->metrics);
- BLOCK_INPUT;
+ block_input ();
/* for metrics */
+#ifdef NS_IMPL_COCOA
+ sfont = [nsfont screenFontWithRenderingMode:
+ NSFontAntialiasedIntegerAdvancementsRenderingMode];
+#else
sfont = [nsfont screenFont];
+#endif
+
if (sfont == nil)
sfont = nsfont;
@@ -799,7 +816,6 @@ nsfont_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size)
font = (struct font *) font_info;
font->pixel_size = [sfont pointSize];
font->driver = &nsfont_driver;
- font->encoding_type = FONT_ENCODING_NOT_DECIDED;
font->encoding_charset = -1;
font->repertory_charset = -1;
font->default_ascent = 0;
@@ -813,7 +829,6 @@ nsfont_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size)
{
const char *fontName = [[nsfont fontName] UTF8String];
- int len = strlen (fontName);
/* The values specified by fonts are not always exact. For
* example, a 6x8 font could specify that the descender is
@@ -831,8 +846,7 @@ nsfont_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size)
[font_info->nsfont retain];
/* set up ns_font (defined in nsgui.h) */
- font_info->name = (char *)xmalloc (strlen (fontName)+1);
- strcpy (font_info->name, fontName);
+ font_info->name = xstrdup (fontName);
font_info->bold = [fontMgr traitsOfFont: nsfont] & NSBoldFontMask;
font_info->ital =
synthItal || ([fontMgr traitsOfFont: nsfont] & NSItalicFontMask);
@@ -889,10 +903,11 @@ nsfont_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size)
/* set up metrics portion of font struct */
font->ascent = lrint([sfont ascender]);
font->descent = -lrint(floor(adjusted_descender));
- font->min_width = ns_char_width(sfont, '|');
font->space_width = lrint (ns_char_width (sfont, ' '));
- font->average_width = lrint (font_info->width);
font->max_width = lrint (font_info->max_bounds.width);
+ font->min_width = font->space_width; /* Approximate. */
+ font->average_width = ns_ascii_average_width (sfont);
+
font->height = lrint (font_info->height);
font->underline_position = lrint (font_info->underpos);
font->underline_thickness = lrint (font_info->underwidth);
@@ -901,7 +916,7 @@ nsfont_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size)
font->props[FONT_FULLNAME_INDEX] =
make_unibyte_string (font_info->name, strlen (font_info->name));
}
- UNBLOCK_INPUT;
+ unblock_input ();
return font_object;
}
@@ -1009,12 +1024,12 @@ nsfont_text_extents (struct font *font, unsigned int *code, int nglyphs,
/* Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
- position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
- is nonzero, fill the background in advance. It is assured that
- WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars). */
+ position of frame F with S->FACE and S->GC. If WITH_BACKGROUND,
+ fill the background in advance. It is assured that WITH_BACKGROUND
+ is false when (FROM > 0 || TO < S->nchars). */
static int
nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
- int with_background)
+ bool with_background)
/* NOTE: focus and clip must be set
also, currently assumed (true in nsterm.m call) from ==0, to ==nchars */
{
@@ -1062,7 +1077,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
NS to render the string, it will come out differently from the individual
character widths added up because of layout processing. */
{
- XCharStruct *cs;
int cwidth, twidth = 0;
int hi, lo;
/* FIXME: composition: no vertical displacement is considered. */
@@ -1226,6 +1240,7 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
else
CGContextSetShouldAntialias (gcontext, 1);
+ CGContextSetShouldSmoothFonts (gcontext, NO);
CGContextSetTextMatrix (gcontext, fliptf);
if (bgCol != nil)
@@ -1286,7 +1301,7 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block)
fprintf (stderr, "%p\tFinding glyphs for glyphs in block %d\n",
font_info, block);
- BLOCK_INPUT;
+ block_input ();
#ifdef NS_IMPL_COCOA
if (firstTime)
@@ -1298,7 +1313,7 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block)
font_info->glyphs[block] = xmalloc (0x100 * sizeof (unsigned short));
if (!unichars || !(font_info->glyphs[block]))
- abort ();
+ emacs_abort ();
/* create a string containing all Unicode characters in this block */
for (idx = block<<8, i = 0; i < 0x100; idx++, i++)
@@ -1343,7 +1358,7 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block)
#endif
}
- UNBLOCK_INPUT;
+ unblock_input ();
xfree (unichars);
}
@@ -1368,13 +1383,17 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block)
numGlyphs = 0x10000;
#endif
- BLOCK_INPUT;
- sfont = [font_info->nsfont screenFont];
+ block_input ();
+#ifdef NS_IMPL_COCOA
+ sfont = [font_info->nsfont screenFontWithRenderingMode:
+ NSFontAntialiasedIntegerAdvancementsRenderingMode];
+#else
+ sfont = [font_info->nsfont screenFont];
+#endif
- font_info->metrics[block] = xmalloc (0x100 * sizeof (struct font_metrics));
- memset (font_info->metrics[block], 0, 0x100 * sizeof (struct font_metrics));
+ font_info->metrics[block] = xzalloc (0x100 * sizeof (struct font_metrics));
if (!(font_info->metrics[block]))
- abort ();
+ emacs_abort ();
metrics = font_info->metrics[block];
for (g = block<<8, i =0; i<0x100 && g < numGlyphs; g++, i++, metrics++)
@@ -1398,7 +1417,7 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block)
metrics->ascent = r.size.height - metrics->descent;
/*-lrint (hshrink* [sfont descender] - expand * hd/2); */
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -1417,7 +1436,7 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block)
maxChar = 0;
maxGlyph = 0;
dict = [NSMutableDictionary new];
- cglyphs = (CGGlyph *)xmalloc (c * sizeof (CGGlyph));
+ cglyphs = xmalloc (c * sizeof (CGGlyph));
return self;
}
@@ -1493,9 +1512,13 @@ syms_of_nsfont (void)
{
nsfont_driver.type = Qns;
register_font_driver (&nsfont_driver, NULL);
+ DEFSYM (Qcondensed, "condensed");
+ DEFSYM (Qexpanded, "expanded");
DEFSYM (Qapple, "apple");
DEFSYM (Qroman, "roman");
DEFSYM (Qmedium, "medium");
DEFVAR_LISP ("ns-reg-to-script", Vns_reg_to_script,
doc: /* Internal use: maps font registry to Unicode script. */);
+
+ ascii_printable = NULL;
}
diff --git a/src/nsgui.h b/src/nsgui.h
index 99c64cd4cde..60c38b221fb 100644
--- a/src/nsgui.h
+++ b/src/nsgui.h
@@ -1,5 +1,5 @@
/* Definitions and headers for communication on the NeXT/Open/GNUstep API.
- Copyright (C) 1995, 2005, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2005, 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -27,7 +27,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#warning "Z is defined. If you get a later parse error in a header, check that buffer.h or other files #define-ing Z are not included."
#endif /* Z */
#define Cursor FooFoo
-#undef init_process
#endif /* NS_IMPL_COCOA */
#undef verify
@@ -36,7 +35,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef NS_IMPL_COCOA
#undef Cursor
-#define init_process emacs_init_process
#endif /* NS_IMPL_COCOA */
#import <Foundation/NSDistantObject.h>
diff --git a/src/nsimage.m b/src/nsimage.m
index 2cb0c3bff76..884c0763fd4 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -1,5 +1,5 @@
/* Image support for the NeXT/Open/GNUstep and MacOSX window system.
- Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2011
+ Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -28,7 +28,6 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
/* This should be the first include, as it may set up #defines affecting
interpretation of even the system includes. */
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
#include "dispextern.h"
@@ -79,7 +78,7 @@ ns_image_from_file (Lisp_Object file)
return [EmacsImage allocInitFromFile: file];
}
-int
+bool
ns_load_image (struct frame *f, struct image *img,
Lisp_Object spec_file, Lisp_Object spec_data)
{
@@ -96,7 +95,7 @@ ns_load_image (struct frame *f, struct image *img,
{
NSData *data;
- data = [NSData dataWithBytes: SDATA (spec_data)
+ data = [NSData dataWithBytes: SSDATA (spec_data)
length: SBYTES (spec_data)];
eImg = [[EmacsImage alloc] initWithData: data];
[eImg setPixmapData];
@@ -171,7 +170,7 @@ static EmacsImage *ImageList = nil;
/* look for an existing image of the same name */
while (image != nil &&
- [[image name] compare: [NSString stringWithUTF8String: SDATA (file)]]
+ [[image name] compare: [NSString stringWithUTF8String: SSDATA (file)]]
!= NSOrderedSame)
image = [image imageListNext];
@@ -187,7 +186,7 @@ static EmacsImage *ImageList = nil;
return nil;
image = [[EmacsImage alloc] initByReferencingFile:
- [NSString stringWithUTF8String: SDATA (found)]];
+ [NSString stringWithUTF8String: SSDATA (found)]];
#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
imgRep = [NSBitmapImageRep imageRepWithData:[image TIFFRepresentation]];
@@ -205,7 +204,7 @@ static EmacsImage *ImageList = nil;
[image setScalesWhenResized: YES];
[image setSize: NSMakeSize([imgRep pixelsWide], [imgRep pixelsHigh])];
- [image setName: [NSString stringWithUTF8String: SDATA (file)]];
+ [image setName: [NSString stringWithUTF8String: SSDATA (file)]];
[image reference];
ImageList = [image imageListSetNext: ImageList];
@@ -302,7 +301,7 @@ static EmacsImage *ImageList = nil;
[bmRep release];
return nil;
}
-#define hexchar(x) (isdigit (x) ? x - '0' : x - 'a' + 10)
+#define hexchar(x) ('0' <= (x) && (x) <= '9' ? (x) - '0' : (x) - 'a' + 10)
s1 = *s++;
s2 = *s++;
c = hexchar (s1) * 0x10 + hexchar (s2);
@@ -334,7 +333,6 @@ static EmacsImage *ImageList = nil;
- setXBMColor: (NSColor *)color
{
NSSize s = [self size];
- int len = (int) s.width * s.height;
unsigned char *planes[5];
CGFloat r, g, b, a;
NSColor *rgbColor;
@@ -400,12 +398,11 @@ static EmacsImage *ImageList = nil;
NSImageRep *rep;
reps = [[self representations] objectEnumerator];
- while (rep = (NSImageRep *) [reps nextObject])
+ while ((rep = (NSImageRep *) [reps nextObject]))
{
if ([rep respondsToSelector: @selector (getBitmapDataPlanes:)])
{
bmRep = (NSBitmapImageRep *) rep;
- onTiger = [bmRep respondsToSelector: @selector (colorAtX:y:)];
if ([bmRep numberOfPlanes] >= 3)
[bmRep getBitmapDataPlanes: pixmapData];
@@ -437,7 +434,7 @@ static EmacsImage *ImageList = nil;
| (pixmapData[0][loc] << 16) | (pixmapData[1][loc] << 8)
| (pixmapData[2][loc]);
}
- else if (onTiger)
+ else
{
NSColor *color = [bmRep colorAtX: x y: y];
CGFloat r, g, b, a;
@@ -447,7 +444,6 @@ static EmacsImage *ImageList = nil;
| ((int)(b * 255.0));
}
- return 0;
}
- (void) setPixelAtX: (int)x Y: (int)y toRed: (unsigned char)r
@@ -465,7 +461,7 @@ static EmacsImage *ImageList = nil;
pixmapData[2][loc] = b;
pixmapData[3][loc] = a;
}
- else if (onTiger)
+ else
{
[bmRep setColor:
[NSColor colorWithCalibratedRed: (r/255.0) green: (g/255.0)
@@ -485,7 +481,7 @@ static EmacsImage *ImageList = nil;
pixmapData[3][loc] = a;
}
- else if (onTiger)
+ else
{
NSColor *color = [bmRep colorAtX: x y: y];
color = [color colorWithAlphaComponent: (a / 255.0)];
@@ -502,4 +498,3 @@ static EmacsImage *ImageList = nil;
}
@end
-
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 94c6b6a6198..d0ea8f5a47a 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -1,5 +1,5 @@
/* NeXT/Open/GNUstep and MacOSX Cocoa menu and toolbar module.
- Copyright (C) 2007-2011 Free Software Foundation, Inc.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -24,10 +24,10 @@ Carbon version by Yamamoto Mitsuharu. */
/* This should be the first include, as it may set up #defines affecting
interpretation of even the system includes. */
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
#include "window.h"
+#include "character.h"
#include "buffer.h"
#include "keymap.h"
#include "coding.h"
@@ -72,7 +72,6 @@ EmacsMenu *mainMenu, *svcsMenu, *dockMenu;
/* Nonzero means a menu is currently active. */
static int popup_activated_flag;
-static NSModalSession popupSession;
/* Nonzero means we are tracking and updating menus. */
static int trackingMenu;
@@ -116,21 +115,20 @@ popup_activated (void)
/* --------------------------------------------------------------------------
Update menubar. Three cases:
- 1) deep_p = 0, submenu = nil: Fresh switch onto a frame -- either set up
+ 1) ! deep_p, submenu = nil: Fresh switch onto a frame -- either set up
just top-level menu strings (OS X), or goto case (2) (GNUstep).
- 2) deep_p = 1, submenu = nil: Recompute all submenus.
- 3) deep_p = 1, submenu = non-nil: Update contents of a single submenu.
+ 2) deep_p, submenu = nil: Recompute all submenus.
+ 3) deep_p, submenu = non-nil: Update contents of a single submenu.
-------------------------------------------------------------------------- */
void
-ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
+ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
{
NSAutoreleasePool *pool;
id menu = [NSApp mainMenu];
static EmacsMenu *last_submenu = nil;
BOOL needsSet = NO;
const char *submenuTitle = [[submenu title] UTF8String];
- extern int waiting_for_input;
- int owfi;
+ bool owfi;
Lisp_Object items;
widget_value *wv, *first_wv, *prev_wv = 0;
int i;
@@ -147,7 +145,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
XSETFRAME (Vmenu_updating_frame, f);
/*fprintf (stderr, "ns_update_menubar: frame: %p\tdeep: %d\tsub: %p\n", f, deep_p, submenu); */
- BLOCK_INPUT;
+ block_input ();
pool = [[NSAutoreleasePool alloc] init];
/* Menu may have been created automatically; if so, discard it. */
@@ -183,14 +181,14 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
/* Fully parse one or more of the submenus. */
int n = 0;
int *submenu_start, *submenu_end;
- int *submenu_top_level_items, *submenu_n_panes;
+ bool *submenu_top_level_items;
+ int *submenu_n_panes;
struct buffer *prev = current_buffer;
Lisp_Object buffer;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
int previous_menu_items_used = f->menu_bar_items_used;
Lisp_Object *previous_items
- = (Lisp_Object *) alloca (previous_menu_items_used
- * sizeof (Lisp_Object));
+ = alloca (previous_menu_items_used * sizeof *previous_items);
/* lisp preliminaries */
buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
@@ -215,14 +213,14 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
if (! NILP (Vlucid_menu_bar_dirty_flag))
call0 (Qrecompute_lucid_menubar);
safe_run_hooks (Qmenu_bar_update_hook);
- FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
+ fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
/* Now ready to go */
items = FRAME_MENU_BAR_ITEMS (f);
/* Save the frame's previous menu bar contents data */
if (previous_menu_items_used)
- memcpy (previous_items, &AREF (f->menu_bar_vector, 0),
+ memcpy (previous_items, aref_addr (f->menu_bar_vector, 0),
previous_menu_items_used * sizeof (Lisp_Object));
/* parse stage 1: extract from lisp */
@@ -230,11 +228,11 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
menu_items = f->menu_bar_vector;
menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
- submenu_start = (int *) alloca (ASIZE (items) * sizeof (int *));
- submenu_end = (int *) alloca (ASIZE (items) * sizeof (int *));
- submenu_n_panes = (int *) alloca (ASIZE (items) * sizeof (int));
- submenu_top_level_items
- = (int *) alloca (ASIZE (items) * sizeof (int *));
+ submenu_start = alloca (ASIZE (items) * sizeof *submenu_start);
+ submenu_end = alloca (ASIZE (items) * sizeof *submenu_end);
+ submenu_n_panes = alloca (ASIZE (items) * sizeof *submenu_n_panes);
+ submenu_top_level_items = alloca (ASIZE (items)
+ * sizeof *submenu_top_level_items);
init_menu_items ();
for (i = 0; i < ASIZE (items); i += 4)
{
@@ -249,7 +247,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
/* FIXME: we'd like to only parse the needed submenu, but this
was causing crashes in the _common parsing code.. need to make
sure proper initialization done.. */
-/* if (submenu && strcmp (submenuTitle, SDATA (string)))
+/* if (submenu && strcmp (submenuTitle, SSDATA (string)))
continue; */
submenu_start[i] = menu_items_used;
@@ -273,7 +271,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
discard_menu_items ();
unbind_to (specpdl_count, Qnil);
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
@@ -318,8 +316,8 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
if (!EQ (previous_items[i], AREF (menu_items, i)))
if (!(STRINGP (previous_items[i])
&& STRINGP (AREF (menu_items, i))
- && !strcmp (SDATA (previous_items[i]),
- SDATA (AREF (menu_items, i)))))
+ && !strcmp (SSDATA (previous_items[i]),
+ SSDATA (AREF (menu_items, i)))))
break;
if (i == previous_menu_items_used)
{
@@ -335,13 +333,13 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
discard_menu_items ();
unbind_to (specpdl_count, Qnil);
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
}
/* The menu items are different, so store them in the frame */
/* FIXME: this is not correct for single-submenu case */
- f->menu_bar_vector = menu_items;
+ fset_menu_bar_vector (f, menu_items);
f->menu_bar_items_used = menu_items_used;
/* Calls restore_menu_items, etc., as they were outside */
@@ -356,7 +354,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
string = AREF (items, i + 1);
if (NILP (string))
break;
-/* if (submenu && strcmp (submenuTitle, SDATA (string)))
+/* if (submenu && strcmp (submenuTitle, SSDATA (string)))
continue; */
wv->name = SSDATA (string);
@@ -406,7 +404,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
{
free_menubar_widget_value_tree (first_wv);
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
@@ -422,11 +420,14 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
if (EQ (string, make_number (0))) // FIXME: Why??? --Stef
continue;
if (NILP (string))
- if (previous_strings[i][0])
- break;
- else
- continue;
- if (strncmp (previous_strings[i], SDATA (string), 10))
+ {
+ if (previous_strings[i][0])
+ break;
+ else
+ continue;
+ }
+ else if (memcmp (previous_strings[i], SDATA (string),
+ min (10, SBYTES (string) + 1)))
break;
}
@@ -434,7 +435,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
{
free_menubar_widget_value_tree (first_wv);
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
}
@@ -447,7 +448,8 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
break;
if (n < 100)
- strncpy (previous_strings[i/4], SDATA (string), 10);
+ memcpy (previous_strings[i/4], SDATA (string),
+ min (10, SBYTES (string) + 1));
wv = xmalloc_widget_value ();
wv->name = SSDATA (string);
@@ -455,7 +457,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
wv->enabled = 1;
wv->button_type = BUTTON_TYPE_NONE;
wv->help = Qnil;
- wv->call_data = (void *) (EMACS_INT) (-1);
+ wv->call_data = (void *) (intptr_t) (-1);
#ifdef NS_IMPL_COCOA
/* we'll update the real copy under app menu when time comes */
@@ -496,7 +498,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
[NSApp setMainMenu: menu];
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -505,7 +507,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
frame's menus have changed, and the *step representation should be updated
from Lisp. */
void
-set_frame_menubar (struct frame *f, int first_time, int deep_p)
+set_frame_menubar (struct frame *f, bool first_time, bool deep_p)
{
ns_update_menubar (f, deep_p, nil);
}
@@ -526,7 +528,7 @@ set_frame_menubar (struct frame *f, int first_time, int deep_p)
/* override designated initializer */
- initWithTitle: (NSString *)title
{
- if (self = [super initWithTitle: title])
+ if ((self = [super initWithTitle: title]))
[self setAutoenablesItems: NO];
return self;
}
@@ -586,10 +588,7 @@ extern NSString *NSMenuDidBeginTrackingNotification;
From 10.6 on, we could also use -[NSMenu propertiesToUpdate]: In the
key press case, NSMenuPropertyItemImage (e.g.) won't be set.
*/
- if (trackingMenu == 0
- /* Also, don't try this if from an event picked up asynchronously,
- as lots of lisp evaluation happens in ns_update_menubar. */
- || handling_signal != 0)
+ if (trackingMenu == 0)
return;
/*fprintf (stderr, "Updating menu '%s'\n", [[self title] UTF8String]); NSLog (@"%@\n", event); */
ns_update_menubar (frame, 1, self);
@@ -723,11 +722,6 @@ extern NSString *NSMenuDidBeginTrackingNotification;
#ifdef NS_IMPL_GNUSTEP
if ([[self window] isVisible])
[self sizeToFit];
-#else
-#if MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_2
- if ([self supermenu] == nil)
- [self sizeToFit];
-#endif
#endif
}
@@ -747,7 +741,7 @@ extern NSString *NSMenuDidBeginTrackingNotification;
/* run a menu in popup mode */
- (Lisp_Object)runMenuAt: (NSPoint)p forFrame: (struct frame *)f
- keymaps: (int)keymaps
+ keymaps: (bool)keymaps
{
EmacsView *view = FRAME_NS_VIEW (f);
NSEvent *e, *event;
@@ -786,13 +780,13 @@ extern NSString *NSMenuDidBeginTrackingNotification;
========================================================================== */
Lisp_Object
-ns_menu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
+ns_menu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps,
Lisp_Object title, const char **error)
{
EmacsMenu *pmenu;
NSPoint p;
- Lisp_Object window, tem, keymap;
- int specpdl_count = SPECPDL_INDEX ();
+ Lisp_Object tem;
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
widget_value *wv, *first_wv = 0;
p.x = x; p.y = y;
@@ -808,14 +802,14 @@ ns_menu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
#if 0
/* FIXME: a couple of one-line differences prevent reuse */
- wv = digest_single_submenu (0, menu_items_used, Qnil);
+ wv = digest_single_submenu (0, menu_items_used, 0);
#else
{
widget_value *save_wv = 0, *prev_wv = 0;
widget_value **submenu_stack
- = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
+ = alloca (menu_items_used * sizeof *submenu_stack);
/* Lisp_Object *subprefix_stack
- = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object)); */
+ = alloca (menu_items_used * sizeof *subprefix_stack); */
int submenu_depth = 0;
int first_pane = 1;
int i;
@@ -935,8 +929,7 @@ ns_menu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
/* If this item has a null value,
make the call_data null so that it won't display a box
when the mouse is on it. */
- wv->call_data
- = !NILP (def) ? (void *) &AREF (menu_items, i) : 0;
+ wv->call_data = !NILP (def) ? aref_addr (menu_items, i) : 0;
wv->enabled = !NILP (enable);
if (NILP (type))
@@ -946,7 +939,7 @@ ns_menu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
else if (EQ (type, QCradio))
wv->button_type = BUTTON_TYPE_RADIO;
else
- abort ();
+ emacs_abort ();
wv->selected = !NILP (selected);
@@ -988,7 +981,7 @@ ns_menu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
}
pmenu = [[EmacsMenu alloc] initWithTitle:
- [NSString stringWithUTF8String: SDATA (title)]];
+ [NSString stringWithUTF8String: SSDATA (title)]];
[pmenu fillWithWidgetValue: first_wv->contents];
free_menubar_widget_value_tree (first_wv);
unbind_to (specpdl_count, Qnil);
@@ -1014,10 +1007,10 @@ free_frame_tool_bar (FRAME_PTR f)
Under NS we just hide the toolbar until it might be needed again.
-------------------------------------------------------------------------- */
{
- BLOCK_INPUT;
+ block_input ();
[[FRAME_NS_VIEW (f) toolbar] setVisible: NO];
FRAME_TOOLBAR_HEIGHT (f) = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
void
@@ -1031,7 +1024,7 @@ update_frame_tool_bar (FRAME_PTR f)
NSWindow *window = [view window];
EmacsToolbar *toolbar = [view toolbar];
- BLOCK_INPUT;
+ block_input ();
[toolbar clearActive];
/* update EmacsToolbar as in GtkUtils, build items list */
@@ -1041,7 +1034,6 @@ update_frame_tool_bar (FRAME_PTR f)
i * TOOL_BAR_ITEM_NSLOTS + (IDX))
BOOL enabled_p = !NILP (TOOLPROP (TOOL_BAR_ITEM_ENABLED_P));
- BOOL selected_p = !NILP (TOOLPROP (TOOL_BAR_ITEM_SELECTED_P));
int idx;
ptrdiff_t img_id;
struct image *img;
@@ -1056,7 +1048,7 @@ update_frame_tool_bar (FRAME_PTR f)
{
/* NS toolbar auto-computes disabled and selected images */
idx = TOOL_BAR_IMAGE_ENABLED_SELECTED;
- xassert (ASIZE (image) >= idx);
+ eassert (ASIZE (image) >= idx);
image = AREF (image, idx);
}
else
@@ -1099,7 +1091,7 @@ update_frame_tool_bar (FRAME_PTR f)
NSDictionary *dict = [toolbar configurationDictionary];
NSMutableDictionary *newDict = [dict mutableCopy];
NSEnumerator *keys = [[dict allKeys] objectEnumerator];
- NSObject *key;
+ id key;
while ((key = [keys nextObject]) != nil)
{
NSObject *val = [dict objectForKey: key];
@@ -1118,7 +1110,7 @@ update_frame_tool_bar (FRAME_PTR f)
FRAME_TOOLBAR_HEIGHT (f) =
NSHeight ([window frameRectForContentRect: NSMakeRect (0, 0, 0, 0)])
- FRAME_NS_TITLEBAR_HEIGHT (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -1346,20 +1338,31 @@ update_frame_tool_bar (FRAME_PTR f)
========================================================================== */
+struct Popdown_data
+{
+ NSAutoreleasePool *pool;
+ EmacsDialogPanel *dialog;
+};
static Lisp_Object
pop_down_menu (Lisp_Object arg)
{
struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
+ struct Popdown_data *unwind_data = (struct Popdown_data *) p->pointer;
+
+ block_input ();
if (popup_activated_flag)
{
+ EmacsDialogPanel *panel = unwind_data->dialog;
popup_activated_flag = 0;
- BLOCK_INPUT;
- [NSApp endModalSession: popupSession];
- [((EmacsDialogPanel *) (p->pointer)) close];
+ [panel close];
+ [unwind_data->pool release];
[[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
- UNBLOCK_INPUT;
}
+
+ xfree (unwind_data);
+ unblock_input ();
+
return Qnil;
}
@@ -1372,6 +1375,7 @@ ns_popup_dialog (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
struct frame *f;
NSPoint p;
BOOL isQ;
+ NSAutoreleasePool *pool;
NSTRACE (x-popup-dialog);
@@ -1425,17 +1429,25 @@ ns_popup_dialog (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
the dialog. */
contents = Fcons (title, Fcons (Fcons (build_string ("Ok"), Qt), Qnil));
- BLOCK_INPUT;
+ block_input ();
+ pool = [[NSAutoreleasePool alloc] init];
dialog = [[EmacsDialogPanel alloc] initFromContents: contents
isQuestion: isQ];
+
{
- int specpdl_count = SPECPDL_INDEX ();
- record_unwind_protect (pop_down_menu, make_save_value (dialog, 0));
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
+ struct Popdown_data *unwind_data = xmalloc (sizeof (*unwind_data));
+
+ unwind_data->pool = pool;
+ unwind_data->dialog = dialog;
+
+ record_unwind_protect (pop_down_menu, make_save_value (unwind_data, 0));
popup_activated_flag = 1;
tem = [dialog runDialogAt: p];
unbind_to (specpdl_count, Qnil); /* calls pop_down_menu */
}
- UNBLOCK_INPUT;
+
+ unblock_input ();
return tem;
}
@@ -1471,26 +1483,25 @@ ns_popup_dialog (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
{
NSSize spacing = {SPACER, SPACER};
NSRect area;
- char this_cmd_name[80];
id cell;
- static NSImageView *imgView;
- static FlippedView *contentView;
-
- if (imgView == nil)
- {
- NSImage *img;
- area.origin.x = 3*SPACER;
- area.origin.y = 2*SPACER;
- area.size.width = ICONSIZE;
- area.size.height= ICONSIZE;
- img = [[NSImage imageNamed: @"NSApplicationIcon"] copy];
- [img setScalesWhenResized: YES];
- [img setSize: NSMakeSize (ICONSIZE, ICONSIZE)];
- imgView = [[NSImageView alloc] initWithFrame: area];
- [imgView setImage: img];
- [imgView setEditable: NO];
- [img release];
- }
+ NSImageView *imgView;
+ FlippedView *contentView;
+ NSImage *img;
+
+ dialog_return = Qundefined;
+ button_values = NULL;
+ area.origin.x = 3*SPACER;
+ area.origin.y = 2*SPACER;
+ area.size.width = ICONSIZE;
+ area.size.height= ICONSIZE;
+ img = [[NSImage imageNamed: @"NSApplicationIcon"] copy];
+ [img setScalesWhenResized: YES];
+ [img setSize: NSMakeSize (ICONSIZE, ICONSIZE)];
+ imgView = [[NSImageView alloc] initWithFrame: area];
+ [imgView setImage: img];
+ [imgView setEditable: NO];
+ [img autorelease];
+ [imgView autorelease];
aStyle = NSTitledWindowMask;
flag = YES;
@@ -1499,6 +1510,8 @@ ns_popup_dialog (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
[super initWithContentRect: contentRect styleMask: aStyle
backing: backingType defer: flag];
contentView = [[FlippedView alloc] initWithFrame: [[self contentView] frame]];
+ [contentView autorelease];
+
[self setContentView: contentView];
[[self contentView] setAutoresizesSubviews: YES];
@@ -1549,53 +1562,74 @@ ns_popup_dialog (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
prototype: cell
numberOfRows: 0
numberOfColumns: 1];
- [[self contentView] addSubview: matrix];
- [matrix release];
[matrix setFrameOrigin: NSMakePoint (area.origin.x,
area.origin.y + (TEXTHEIGHT+3*SPACER))];
[matrix setIntercellSpacing: spacing];
+ [matrix autorelease];
+ [[self contentView] addSubview: matrix];
[self setOneShot: YES];
[self setReleasedWhenClosed: YES];
[self setHidesOnDeactivate: YES];
+ [self setStyleMask:
+ NSTitledWindowMask|NSClosableWindowMask|NSUtilityWindowMask];
+
return self;
}
- (BOOL)windowShouldClose: (id)sender
{
- [NSApp stopModalWithCode: XHASH (Qnil)]; // FIXME: BIG UGLY HACK!!
+ window_closed = YES;
+ [NSApp stop:self];
return NO;
}
+- (void)dealloc
+{
+ xfree (button_values);
+ [super dealloc];
+}
-void process_dialog (id window, Lisp_Object list)
+- (void)process_dialog: (Lisp_Object) list
{
- Lisp_Object item;
+ Lisp_Object item, lst = list;
int row = 0;
+ int buttons = 0, btnnr = 0;
+
+ for (; XTYPE (lst) == Lisp_Cons; lst = XCDR (lst))
+ {
+ item = XCAR (list);
+ if (XTYPE (item) == Lisp_Cons)
+ ++buttons;
+ }
+
+ if (buttons > 0)
+ button_values = (Lisp_Object *) xmalloc (buttons * sizeof (*button_values));
for (; XTYPE (list) == Lisp_Cons; list = XCDR (list))
{
item = XCAR (list);
if (XTYPE (item) == Lisp_String)
{
- [window addString: SDATA (item) row: row++];
+ [self addString: SSDATA (item) row: row++];
}
else if (XTYPE (item) == Lisp_Cons)
{
- [window addButton: SDATA (XCAR (item))
- value: XCDR (item) row: row++];
+ button_values[btnnr] = XCDR (item);
+ [self addButton: SSDATA (XCAR (item)) value: btnnr row: row++];
+ ++btnnr;
}
else if (NILP (item))
{
- [window addSplit];
+ [self addSplit];
row = 0;
}
}
}
-- addButton: (char *)str value: (Lisp_Object)val row: (int)row
+- (void)addButton: (char *)str value: (int)tag row: (int)row
{
id cell;
@@ -1608,15 +1642,13 @@ void process_dialog (id window, Lisp_Object list)
[cell setTarget: self];
[cell setAction: @selector (clicked: )];
[cell setTitle: [NSString stringWithUTF8String: str]];
- [cell setTag: XHASH (val)]; // FIXME: BIG UGLY HACK!!
+ [cell setTag: tag];
[cell setBordered: YES];
[cell setEnabled: YES];
-
- return self;
}
-- addString: (char *)str row: (int)row
+- (void)addString: (char *)str row: (int)row
{
id cell;
@@ -1629,32 +1661,28 @@ void process_dialog (id window, Lisp_Object list)
[cell setTitle: [NSString stringWithUTF8String: str]];
[cell setBordered: YES];
[cell setEnabled: NO];
-
- return self;
}
-- addSplit
+- (void)addSplit
{
[matrix addColumn];
cols++;
- return self;
}
-- clicked: sender
+- (void)clicked: sender
{
NSArray *sellist = nil;
EMACS_INT seltag;
sellist = [sender selectedCells];
- if ([sellist count]<1)
- return self;
+ if ([sellist count] < 1)
+ return;
seltag = [[sellist objectAtIndex: 0] tag];
- if (seltag != XHASH (Qundefined)) // FIXME: BIG UGLY HACK!!
- [NSApp stopModalWithCode: seltag];
- return self;
+ dialog_return = button_values[seltag];
+ [NSApp stop:self];
}
@@ -1666,14 +1694,14 @@ void process_dialog (id window, Lisp_Object list)
if (XTYPE (contents) == Lisp_Cons)
{
head = Fcar (contents);
- process_dialog (self, Fcdr (contents));
+ [self process_dialog: Fcdr (contents)];
}
else
head = contents;
if (XTYPE (head) == Lisp_String)
[title setStringValue:
- [NSString stringWithUTF8String: SDATA (head)]];
+ [NSString stringWithUTF8String: SSDATA (head)]];
else if (isQ == YES)
[title setStringValue: @"Question"];
else
@@ -1686,7 +1714,7 @@ void process_dialog (id window, Lisp_Object list)
if (cols == 1 && rows > 1) /* Never told where to split */
{
[matrix addColumn];
- for (i = 0; i<rows/2; i++)
+ for (i = 0; i < rows/2; i++)
{
[matrix putCell: [matrix cellAtRow: (rows+1)/2 column: 0]
atRow: i column: 1];
@@ -1733,33 +1761,63 @@ void process_dialog (id window, Lisp_Object list)
}
-- (void)dealloc
+
+- (void)timeout_handler: (NSTimer *)timedEntry
{
- { [super dealloc]; return; };
+ NSEvent *nxev = [NSEvent otherEventWithType: NSApplicationDefined
+ location: NSMakePoint (0, 0)
+ modifierFlags: 0
+ timestamp: 0
+ windowNumber: [[NSApp mainWindow] windowNumber]
+ context: [NSApp context]
+ subtype: 0
+ data1: 0
+ data2: 0];
+
+ timer_fired = YES;
+ /* We use sto because stopModal/abortModal out of the main loop does not
+ seem to work in 10.6. But as we use stop we must send a real event so
+ the stop is seen and acted upon. */
+ [NSApp stop:self];
+ [NSApp postEvent: nxev atStart: NO];
}
-
- (Lisp_Object)runDialogAt: (NSPoint)p
{
- NSInteger ret;
+ Lisp_Object ret = Qundefined;
- /* initiate a session that will be ended by pop_down_menu */
- popupSession = [NSApp beginModalSessionForWindow: self];
- while (popup_activated_flag
- && (ret = [NSApp runModalSession: popupSession])
- == NSRunContinuesResponse)
+ while (popup_activated_flag)
{
- /* Run this for timers.el, indep of atimers; might not return.
- TODO: use return value to avoid calling every iteration. */
- timer_check ();
- [NSThread sleepUntilDate: [NSDate dateWithTimeIntervalSinceNow: 0.1]];
+ NSTimer *tmo = nil;
+ EMACS_TIME next_time = timer_check ();
+
+ if (EMACS_TIME_VALID_P (next_time))
+ {
+ double time = EMACS_TIME_TO_DOUBLE (next_time);
+ tmo = [NSTimer timerWithTimeInterval: time
+ target: self
+ selector: @selector (timeout_handler:)
+ userInfo: 0
+ repeats: NO];
+ [[NSRunLoop currentRunLoop] addTimer: tmo
+ forMode: NSModalPanelRunLoopMode];
+ }
+ timer_fired = NO;
+ dialog_return = Qundefined;
+ [NSApp runModalForWindow: self];
+ ret = dialog_return;
+ if (! timer_fired)
+ {
+ if (tmo != nil) [tmo invalidate]; /* Cancels timer */
+ break;
+ }
}
- { /* FIXME: BIG UGLY HACK!!! */
- Lisp_Object tmp;
- *(EMACS_INT*)(&tmp) = ret;
- return tmp;
- }
+ if (EQ (ret, Qundefined) && window_closed)
+ /* Make close button pressed equivalent to C-g. */
+ Fsignal (Qquit, Qnil);
+
+ return ret;
}
@end
diff --git a/src/nsselect.m b/src/nsselect.m
index 928eb8652dc..c0c412c6fb2 100644
--- a/src/nsselect.m
+++ b/src/nsselect.m
@@ -1,5 +1,5 @@
/* NeXT/Open/GNUstep / MacOSX Cocoa selection processing for emacs.
- Copyright (C) 1993-1994, 2005-2006, 2008-2011
+ Copyright (C) 1993-1994, 2005-2006, 2008-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -28,7 +28,6 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
/* This should be the first include, as it may set up #defines affecting
interpretation of even the system includes. */
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
#include "nsterm.h"
@@ -62,7 +61,7 @@ symbol_to_nsstring (Lisp_Object sym)
if (EQ (sym, QPRIMARY)) return NXPrimaryPboard;
if (EQ (sym, QSECONDARY)) return NXSecondaryPboard;
if (EQ (sym, QTEXT)) return NSStringPboardType;
- return [NSString stringWithUTF8String: SDATA (XSYMBOL (sym)->xname)];
+ return [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (sym))];
}
static NSPasteboard *
@@ -112,8 +111,8 @@ clean_local_selection_data (Lisp_Object obj)
if (VECTORP (obj))
{
- int i;
- int size = ASIZE (obj);
+ ptrdiff_t i;
+ ptrdiff_t size = ASIZE (obj);
Lisp_Object copy;
if (size == 1)
@@ -157,7 +156,7 @@ ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype)
CHECK_STRING (str);
- utfStr = SDATA (str);
+ utfStr = SSDATA (str);
nsStr = [[NSString alloc] initWithBytesNoCopy: utfStr
length: SBYTES (str)
encoding: NSUTF8StringEncoding
@@ -184,7 +183,7 @@ ns_get_local_selection (Lisp_Object selection_name,
{
Lisp_Object local_value;
Lisp_Object handler_fn, value, type, check;
- int count;
+ ptrdiff_t count;
local_value = assq_no_quit (selection_name, Vselection_alist);
@@ -296,8 +295,8 @@ ns_string_from_pasteboard (id pb)
utfStr = [mstr UTF8String];
length = [mstr lengthOfBytesUsingEncoding: NSUTF8StringEncoding];
-#if ! defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_4
- if (!utfStr)
+#if ! defined (NS_IMPL_COCOA)
+ if (!utfStr)
{
utfStr = [mstr cString];
length = strlen (utfStr);
@@ -307,7 +306,7 @@ ns_string_from_pasteboard (id pb)
NS_HANDLER
{
message1 ("ns_string_from_pasteboard: UTF8String failed\n");
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_4
+#if defined (NS_IMPL_COCOA)
utfStr = "Conversion failed";
#else
utfStr = [str lossyCString];
@@ -336,12 +335,18 @@ ns_string_to_pasteboard (id pb, Lisp_Object str)
DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
- Sx_own_selection_internal, 2, 2, 0,
- doc: /* Assert a selection.
-SELECTION-NAME is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+ Sx_own_selection_internal, 2, 3, 0,
+ doc: /* Assert an X selection of type SELECTION and value VALUE.
+SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+\(Those are literal upper-case symbol names, since that's what X expects.)
VALUE is typically a string, or a cons of two markers, but may be
-anything that the functions on `selection-converter-alist' know about. */)
- (Lisp_Object selection_name, Lisp_Object selection_value)
+anything that the functions on `selection-converter-alist' know about.
+
+FRAME should be a frame that should own the selection. If omitted or
+nil, it defaults to the selected frame.
+
+On Nextstep, FRAME is unused. */)
+ (Lisp_Object selection, Lisp_Object value, Lisp_Object frame)
{
id pb;
Lisp_Object old_value, new_value;
@@ -351,15 +356,15 @@ anything that the functions on `selection-converter-alist' know about. */)
check_ns ();
- CHECK_SYMBOL (selection_name);
- if (NILP (selection_value))
- error ("selection-value may not be nil.");
- pb = ns_symbol_to_pb (selection_name);
+ CHECK_SYMBOL (selection);
+ if (NILP (value))
+ error ("selection value may not be nil.");
+ pb = ns_symbol_to_pb (selection);
if (pb == nil) return Qnil;
ns_declare_pasteboard (pb);
- old_value = assq_no_quit (selection_name, Vselection_alist);
- new_value = Fcons (selection_name, Fcons (selection_value, Qnil));
+ old_value = assq_no_quit (selection, Vselection_alist);
+ new_value = Fcons (selection, Fcons (value, Qnil));
if (NILP (old_value))
Vselection_alist = Fcons (new_value, Vselection_alist);
@@ -369,7 +374,7 @@ anything that the functions on `selection-converter-alist' know about. */)
/* We only support copy of text. */
type = NSStringPboardType;
target_symbol = ns_string_to_symbol (type);
- data = ns_get_local_selection (selection_name, target_symbol);
+ data = ns_get_local_selection (selection, target_symbol);
if (!NILP (data))
{
if (STRINGP (data))
@@ -380,37 +385,53 @@ anything that the functions on `selection-converter-alist' know about. */)
if (!EQ (Vns_sent_selection_hooks, Qunbound))
{
for (rest = Vns_sent_selection_hooks; CONSP (rest); rest = Fcdr (rest))
- call3 (Fcar (rest), selection_name, target_symbol, successful_p);
+ call3 (Fcar (rest), selection, target_symbol, successful_p);
}
-
- return selection_value;
+
+ return value;
}
DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
- Sx_disown_selection_internal, 1, 2, 0,
- doc: /* If we own the selection SELECTION, disown it. */)
- (Lisp_Object selection_name, Lisp_Object time)
+ Sx_disown_selection_internal, 1, 3, 0,
+ doc: /* If we own the selection SELECTION, disown it.
+Disowning it means there is no such selection.
+
+Sets the last-change time for the selection to TIME-OBJECT (by default
+the time of the last event).
+
+TERMINAL should be a terminal object or a frame specifying the X
+server to query. If omitted or nil, that stands for the selected
+frame's display, or the first available X display.
+
+On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
+On MS-DOS, all this does is return non-nil if we own the selection. */)
+ (Lisp_Object selection, Lisp_Object time_object, Lisp_Object terminal)
{
id pb;
check_ns ();
- CHECK_SYMBOL (selection_name);
- if (NILP (assq_no_quit (selection_name, Vselection_alist))) return Qnil;
+ CHECK_SYMBOL (selection);
+ if (NILP (assq_no_quit (selection, Vselection_alist))) return Qnil;
- pb = ns_symbol_to_pb (selection_name);
+ pb = ns_symbol_to_pb (selection);
if (pb != nil) ns_undeclare_pasteboard (pb);
return Qt;
}
DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
- 0, 1, 0, doc: /* Whether there is an owner for the given selection.
-The arg should be the name of the selection in question, typically one of
-the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-\(Those are literal upper-case symbol names.)
-For convenience, the symbol nil is the same as `PRIMARY',
-and t is the same as `SECONDARY'.) */)
- (Lisp_Object selection)
+ 0, 2, 0, doc: /* Whether there is an owner for the given X selection.
+SELECTION should be the name of the selection in question, typically
+one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
+these literal upper-case names.) The symbol nil is the same as
+`PRIMARY', and t is the same as `SECONDARY'.
+
+TERMINAL should be a terminal object or a frame specifying the X
+server to query. If omitted or nil, that stands for the selected
+frame's display, or the first available X display.
+
+On Nextstep, TERMINAL is unused. */)
+ (Lisp_Object selection, Lisp_Object terminal)
{
id pb;
NSArray *types;
@@ -421,21 +442,27 @@ and t is the same as `SECONDARY'.) */)
if (EQ (selection, Qt)) selection = QSECONDARY;
pb = ns_symbol_to_pb (selection);
if (pb == nil) return Qnil;
-
+
types = [pb types];
return ([types count] == 0) ? Qnil : Qt;
}
DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
- 0, 1, 0,
- doc: /* Whether the current Emacs process owns the given selection.
+ 0, 2, 0,
+ doc: /* Whether the current Emacs process owns the given X Selection.
The arg should be the name of the selection in question, typically one of
the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-\(Those are literal upper-case symbol names.)
+\(Those are literal upper-case symbol names, since that's what X expects.)
For convenience, the symbol nil is the same as `PRIMARY',
-and t is the same as `SECONDARY'.) */)
- (Lisp_Object selection)
+and t is the same as `SECONDARY'.
+
+TERMINAL should be a terminal object or a frame specifying the X
+server to query. If omitted or nil, that stands for the selected
+frame's display, or the first available X display.
+
+On Nextstep, TERMINAL is unused. */)
+ (Lisp_Object selection, Lisp_Object terminal)
{
check_ns ();
CHECK_SYMBOL (selection);
@@ -446,12 +473,22 @@ and t is the same as `SECONDARY'.) */)
DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
- Sx_get_selection_internal, 2, 2, 0,
- doc: /* Return text selected from some pasteboard.
-SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-\(Those are literal upper-case symbol names.)
-TYPE is the type of data desired, typically `STRING'. */)
- (Lisp_Object selection_name, Lisp_Object target_type)
+ Sx_get_selection_internal, 2, 4, 0,
+ doc: /* Return text selected from some X window.
+SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+\(Those are literal upper-case symbol names, since that's what X expects.)
+TARGET-TYPE is the type of data desired, typically `STRING'.
+
+TIME-STAMP is the time to use in the XConvertSelection call for foreign
+selections. If omitted, defaults to the time for the last event.
+
+TERMINAL should be a terminal object or a frame specifying the X
+server to query. If omitted or nil, that stands for the selected
+frame's display, or the first available X display.
+
+On Nextstep, TIME-STAMP and TERMINAL are unused. */)
+ (Lisp_Object selection_name, Lisp_Object target_type,
+ Lisp_Object time_stamp, Lisp_Object terminal)
{
Lisp_Object val;
@@ -565,4 +602,3 @@ The functions are called with one argument, the selection type\n\
Qforeign_selection = intern_c_string ("foreign-selection");
staticpro (&Qforeign_selection);
}
-
diff --git a/src/nsterm.h b/src/nsterm.h
index 14918cca90d..005701ed415 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -1,5 +1,5 @@
/* Definitions and headers for communication with NeXT/Open/GNUstep API.
- Copyright (C) 1989, 1993, 2005, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 1989, 1993, 2005, 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -26,9 +26,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_NS
#ifdef NS_IMPL_COCOA
-#ifndef MAC_OS_X_VERSION_10_3
-#define MAC_OS_X_VERSION_10_3 1030
-#endif
#ifndef MAC_OS_X_VERSION_10_4
#define MAC_OS_X_VERSION_10_4 1040
#endif
@@ -38,6 +35,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef MAC_OS_X_VERSION_10_6
#define MAC_OS_X_VERSION_10_6 1060
#endif
+#ifndef MAC_OS_X_VERSION_10_7
+#define MAC_OS_X_VERSION_10_7 1070
+#endif
+#ifndef MAC_OS_X_VERSION_10_8
+#define MAC_OS_X_VERSION_10_8 1080
+#endif
#endif /* NS_IMPL_COCOA */
#ifdef __OBJC__
@@ -56,7 +59,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
- (void)sendEvent: (NSEvent *)theEvent;
- (void)showPreferencesWindow: (id)sender;
- (BOOL) openFile: (NSString *)fileName;
-- (void)fd_handler: (NSTimer *) fdEntry;
+- (void)fd_handler: (id)unused;
- (void)timeout_handler: (NSTimer *)timedEntry;
- (BOOL)fulfillService: (NSString *)name withArg: (NSString *)arg;
@end
@@ -80,6 +83,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
BOOL windowClosing;
NSString *workingText;
BOOL processingCompose;
+ int fs_state, fs_before_fs, next_maximized;
+ int tibar_height, tobar_height, bwidth;
+ int maximized_width, maximized_height;
+ NSWindow *nonfs_window;
@public
struct frame *emacsframe;
int rows, cols;
@@ -89,7 +96,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
}
/* AppKit-side interface */
-- menuDown: sender;
+- menuDown: (id)sender;
- toolbarClicked: (id)item;
- toggleToolbar: (id)sender;
- (void)keyDown: (NSEvent *)theEvent;
@@ -103,6 +110,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
- (void) setWindowClosing: (BOOL)closing;
- (EmacsToolbar *) toolbar;
- (void) deleteWorkingText;
+- (void) updateFrameSize: (BOOL) delay;
+- (void) handleFS;
+- (void) setFSValue: (int)value;
+- (void) toggleFullScreen: (id) sender;
#ifdef NS_IMPL_GNUSTEP
/* Not declared, but useful. */
@@ -119,6 +130,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
@end
+/* Fullscreen version of the above. */
+@interface EmacsFSWindow : EmacsWindow
+{
+}
+@end
+
/* ==========================================================================
The main menu implementation
@@ -144,7 +161,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
- (EmacsMenu *)addSubmenuWithTitle: (const char *)title forFrame: (struct frame *)f;
- (void) clear;
- (Lisp_Object)runMenuAt: (NSPoint)p forFrame: (struct frame *)f
- keymaps: (int)keymaps;
+ keymaps: (bool)keymaps;
@end
@@ -195,12 +212,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
NSTextField *title;
NSMatrix *matrix;
int rows, cols;
+ BOOL timer_fired, window_closed;
+ Lisp_Object dialog_return;
+ Lisp_Object *button_values;
}
- initFromContents: (Lisp_Object)menu isQuestion: (BOOL)isQ;
-- addButton: (char *)str value: (Lisp_Object)val row: (int)row;
-- addString: (char *)str row: (int)row;
-- addSplit;
+- (void)process_dialog: (Lisp_Object)list;
+- (void)addButton: (char *)str value: (int)tag row: (int)row;
+- (void)addString: (char *)str row: (int)row;
+- (void)addSplit;
- (Lisp_Object)runDialogAt: (NSPoint)p;
+- (void)timeout_handler: (NSTimer *)timedEntry;
@end
#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
@@ -261,7 +283,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
int refCount;
NSBitmapImageRep *bmRep; /* used for accessing pixel data */
unsigned char *pixmapData[5]; /* shortcut to access pixel data */
- BOOL onTiger;
NSColor *stippleMask;
}
+ allocInitFromFile: (Lisp_Object)file;
@@ -330,7 +351,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* ==========================================================================
- Rendering on Panther and above
+ Rendering
========================================================================== */
@@ -355,7 +376,7 @@ extern NSString *ns_app_name;
extern EmacsMenu *mainMenu, *svcsMenu, *dockMenu;
/* Apple removed the declaration, but kept the implementation */
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_4
+#if defined (NS_IMPL_COCOA)
@interface NSApplication (EmacsApp)
- (void)setAppleMenu: (NSMenu *)menu;
@end
@@ -448,17 +469,19 @@ struct nsfont_info
struct font font;
char *name; /* PostScript name, uniquely identifies on NS systems */
- float width; /* this and following metrics stored as float rather than int */
+
+ /* The following metrics are stored as float rather than int. */
+
+ float width; /* Maximum advance for the font. */
float height;
float underpos;
float underwidth;
float size;
#ifdef __OBJC__
NSFont *nsfont;
- /* cgfont and synthItal are used only on OS X 10.3+ */
-#if defined (NS_IMPL_COCOA) && (MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_3)
+#if defined (NS_IMPL_COCOA)
CGFontRef cgfont;
-#else /* GNUstep or OS X < 10.3 */
+#else /* GNUstep */
void *cgfont;
#endif
#else /* ! OBJC */
@@ -535,7 +558,7 @@ struct ns_display_info
extern struct ns_display_info *x_display_list;
extern Lisp_Object ns_display_name_list;
-extern struct ns_display_info *ns_display_info_for_name ();
+extern struct ns_display_info *ns_display_info_for_name (Lisp_Object name);
struct ns_display_info *check_x_display_info (Lisp_Object frame);
FRAME_PTR check_x_frame (Lisp_Object frame);
@@ -607,8 +630,7 @@ struct ns_output
/* this dummy decl needed to support TTYs */
struct x_output
{
- unsigned long background_pixel;
- unsigned long foreground_pixel;
+ int unused;
};
@@ -623,6 +645,8 @@ struct x_output
/* This is the `Display *' which frame F is on. */
#define FRAME_NS_DISPLAY(f) (0)
#define FRAME_X_DISPLAY(f) (0)
+#define FRAME_X_SCREEN(f) (0)
+#define FRAME_X_VISUAL(f) FRAME_NS_DISPLAY_INFO(f)->visual
#define FRAME_FOREGROUND_COLOR(f) ((f)->output_data.ns->foreground_color)
#define FRAME_BACKGROUND_COLOR(f) ((f)->output_data.ns->background_color)
@@ -697,7 +721,7 @@ struct x_output
(! (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f)) ? 0 \
: FRAME_SCROLL_BAR_COLS (f))
-extern struct ns_display_info *ns_term_init ();
+extern struct ns_display_info *ns_term_init (Lisp_Object display_name);
extern void ns_term_shutdown (int sig);
/* constants for text rendering */
@@ -707,8 +731,6 @@ extern void ns_term_shutdown (int sig);
#define NS_DUMPGLYPH_MOUSEFACE 3
-EXFUN (Fx_display_grayscale_p, 1);
-EXFUN (Fx_display_planes, 1);
/* In nsfont, called from fontset.c */
extern void nsfont_make_fontset_for_font (Lisp_Object name,
@@ -727,23 +749,24 @@ extern void ns_clear_frame (struct frame *f);
extern const char *ns_xlfd_to_fontname (const char *xlfd);
extern void check_ns (void);
-extern Lisp_Object ns_map_event_to_object ();
-extern Lisp_Object ns_string_from_pasteboard ();
-extern void ns_string_to_pasteboard ();
+extern Lisp_Object ns_map_event_to_object (void);
+#ifdef __OBJC__
+extern Lisp_Object ns_string_from_pasteboard (id pb);
+extern void ns_string_to_pasteboard (id pb, Lisp_Object str);
+#endif
extern Lisp_Object ns_get_local_selection (Lisp_Object selection_name,
Lisp_Object target_type);
-extern void nxatoms_of_nsselect ();
-extern int ns_lisp_to_cursor_type ();
+extern void nxatoms_of_nsselect (void);
+extern int ns_lisp_to_cursor_type (Lisp_Object arg);
extern Lisp_Object ns_cursor_type_to_lisp (int arg);
-extern Lisp_Object Qnone;
extern void ns_set_name_as_filename (struct frame *f);
extern void ns_set_doc_edited (struct frame *f, Lisp_Object arg);
-extern int
+extern bool
ns_defined_color (struct frame *f,
const char *name,
- XColor *color_def, int alloc,
- char makeIndex);
+ XColor *color_def, bool alloc,
+ bool makeIndex);
extern void
ns_query_color (void *col, XColor *color_def, int setPixel);
@@ -758,9 +781,9 @@ extern void ns_free_indexed_color (unsigned long idx, struct frame *f);
/* C access to ObjC functionality */
extern void ns_release_object (void *obj);
extern void ns_retain_object (void *obj);
-extern void *ns_alloc_autorelease_pool ();
-extern void ns_release_autorelease_pool ();
-extern const char *ns_get_defaults_value ();
+extern void *ns_alloc_autorelease_pool (void);
+extern void ns_release_autorelease_pool (void *);
+extern const char *ns_get_defaults_value (const char *key);
/* in nsmenu */
extern void update_frame_tool_bar (FRAME_PTR f);
@@ -768,39 +791,17 @@ extern void free_frame_tool_bar (FRAME_PTR f);
extern void find_and_call_menu_selection (FRAME_PTR f,
int menu_bar_items_used, Lisp_Object vector, void *client_data);
extern Lisp_Object find_and_return_menu_selection (FRAME_PTR f,
- int keymaps,
+ bool keymaps,
void *client_data);
extern Lisp_Object ns_popup_dialog (Lisp_Object position, Lisp_Object contents,
Lisp_Object header);
-/* More prototypes that should be moved to a more general include file */
-extern void set_frame_menubar (struct frame *f, int first_time, int deep_p);
-extern void x_set_window_size (struct frame *f, int change_grav,
- int cols, int rows);
-extern void x_sync (struct frame *);
-extern Lisp_Object x_get_focus_frame (struct frame *);
-extern void x_set_mouse_position (struct frame *f, int h, int v);
-extern void x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y);
-extern void x_make_frame_visible (struct frame *f);
-extern void x_make_frame_invisible (struct frame *f);
-extern void x_iconify_frame (struct frame *f);
-extern int x_char_width (struct frame *f);
-extern int x_char_height (struct frame *f);
-extern int x_pixel_width (struct frame *f);
-extern int x_pixel_height (struct frame *f);
-extern void x_set_frame_alpha (struct frame *f);
-extern void x_set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
-extern void x_set_tool_bar_lines (struct frame *f,
- Lisp_Object value,
- Lisp_Object oldval);
-extern void x_activate_menubar (struct frame *);
-extern void free_frame_menubar (struct frame *);
-extern void x_free_frame_resources (struct frame *);
-
#define NSAPP_DATA2_RUNASSCRIPT 10
extern void ns_run_ascript (void);
-extern void ns_init_paths (void);
+extern const char *ns_etc_directory (void);
+extern const char *ns_exec_path (void);
+extern const char *ns_load_path (void);
extern void syms_of_nsterm (void);
extern void syms_of_nsfns (void);
extern void syms_of_nsmenu (void);
@@ -811,8 +812,8 @@ struct image;
extern void *ns_image_from_XBM (unsigned char *bits, int width, int height);
extern void *ns_image_for_XPM (int width, int height, int depth);
extern void *ns_image_from_file (Lisp_Object file);
-extern int ns_load_image (struct frame *f, struct image *img,
- Lisp_Object spec_file, Lisp_Object spec_data);
+extern bool ns_load_image (struct frame *f, struct image *img,
+ Lisp_Object spec_file, Lisp_Object spec_data);
extern int ns_image_width (void *img);
extern int ns_image_height (void *img);
extern unsigned long ns_get_pixel (void *img, int x, int y);
@@ -824,7 +825,8 @@ extern int x_display_pixel_width (struct ns_display_info *);
/* This in nsterm.m */
extern int ns_select (int nfds, fd_set *readfds, fd_set *writefds,
- fd_set *exceptfds, struct timeval *timeout);
+ fd_set *exceptfds, EMACS_TIME *timeout,
+ sigset_t *sigmask);
extern unsigned long ns_get_rgb_color (struct frame *f,
float r, float g, float b, float a);
extern NSPoint last_mouse_motion_position;
diff --git a/src/nsterm.m b/src/nsterm.m
index f8e69f98942..25eb7ebc495 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -1,6 +1,7 @@
/* NeXT/Open/GNUstep / MacOSX communication module.
- Copyright (C) 1989, 1993-1994, 2005-2006, 2008-2011
- Free Software Foundation, Inc.
+
+Copyright (C) 1989, 1993-1994, 2005-2006, 2008-2012
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -29,12 +30,17 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
interpretation of even the system includes. */
#include <config.h>
+#include <fcntl.h>
#include <math.h>
+#include <pthread.h>
#include <sys/types.h>
#include <time.h>
#include <signal.h>
#include <unistd.h>
-#include <setjmp.h>
+
+#include <c-ctype.h>
+#include <c-strcase.h>
+#include <ftoastr.h>
#include "lisp.h"
#include "blockinput.h"
@@ -47,12 +53,11 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
#include "ccl.h"
#include "termhooks.h"
-#include "termopts.h"
#include "termchar.h"
#include "window.h"
#include "keyboard.h"
-
+#include "buffer.h"
#include "font.h"
/* call tracing */
@@ -64,6 +69,12 @@ int term_trace_num = 0;
#define NSTRACE(x)
#endif
+#if defined (NS_IMPL_COCOA) && \
+ MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7
+#define NEW_STYLE_FS
+#endif
+
+extern NSString *NSMenuDidBeginTrackingNotification;
/* ==========================================================================
@@ -87,6 +98,7 @@ static unsigned convert_ns_to_X_keysym[] =
NSBeginFunctionKey, 0x58,
NSSelectFunctionKey, 0x60,
NSPrintFunctionKey, 0x61,
+ NSClearLineFunctionKey, 0x0B,
NSExecuteFunctionKey, 0x62,
NSInsertFunctionKey, 0x63,
NSUndoFunctionKey, 0x65,
@@ -131,11 +143,28 @@ static unsigned convert_ns_to_X_keysym[] =
NSNewlineCharacter, 0x0D,
NSEnterCharacter, 0x8D,
+ 0x41|NSNumericPadKeyMask, 0xAE, /* KP_Decimal */
+ 0x43|NSNumericPadKeyMask, 0xAA, /* KP_Multiply */
+ 0x45|NSNumericPadKeyMask, 0xAB, /* KP_Add */
+ 0x4B|NSNumericPadKeyMask, 0xAF, /* KP_Divide */
+ 0x4E|NSNumericPadKeyMask, 0xAD, /* KP_Subtract */
+ 0x51|NSNumericPadKeyMask, 0xBD, /* KP_Equal */
+ 0x52|NSNumericPadKeyMask, 0xB0, /* KP_0 */
+ 0x53|NSNumericPadKeyMask, 0xB1, /* KP_1 */
+ 0x54|NSNumericPadKeyMask, 0xB2, /* KP_2 */
+ 0x55|NSNumericPadKeyMask, 0xB3, /* KP_3 */
+ 0x56|NSNumericPadKeyMask, 0xB4, /* KP_4 */
+ 0x57|NSNumericPadKeyMask, 0xB5, /* KP_5 */
+ 0x58|NSNumericPadKeyMask, 0xB6, /* KP_6 */
+ 0x59|NSNumericPadKeyMask, 0xB7, /* KP_7 */
+ 0x5B|NSNumericPadKeyMask, 0xB8, /* KP_8 */
+ 0x5C|NSNumericPadKeyMask, 0xB9, /* KP_9 */
+
0x1B, 0x1B /* escape */
};
static Lisp_Object Qmodifier_value;
-Lisp_Object Qalt, Qcontrol, Qhyper, Qmeta, Qsuper, Qnone;
+Lisp_Object Qalt, Qcontrol, Qhyper, Qmeta, Qsuper;
extern Lisp_Object Qcursor_color, Qcursor_type, Qns, Qleft;
static Lisp_Object QUTF8_STRING;
@@ -165,9 +194,10 @@ static EmacsScroller *last_mouse_scroll_bar = nil;
static struct frame *ns_updating_frame;
static NSView *focus_view = NULL;
static int ns_window_num = 0;
+#ifdef NS_IMPL_GNUSTEP
static NSRect uRect;
+#endif
static BOOL gsaved = NO;
-BOOL ns_in_resize = NO;
static BOOL ns_fake_keydown = NO;
int ns_tmp_flags; /* FIXME */
struct nsfont_info *ns_tmp_font; /* FIXME */
@@ -176,20 +206,31 @@ static BOOL ns_menu_bar_is_hidden = NO;
/* event loop */
static BOOL send_appdefined = YES;
-static NSEvent *last_appdefined_event = 0;
+#define NO_APPDEFINED_DATA (-8)
+static int last_appdefined_event_data = NO_APPDEFINED_DATA;
static NSTimer *timed_entry = 0;
-static NSTimer *fd_entry = nil;
static NSTimer *scroll_repeat_entry = nil;
-static fd_set select_readfds, t_readfds;
-static struct timeval select_timeout;
-static int select_nfds;
+static fd_set select_readfds, select_writefds;
+enum { SELECT_HAVE_READ = 1, SELECT_HAVE_WRITE = 2, SELECT_HAVE_TMO = 4 };
+static int select_nfds = 0, select_valid = 0;
+static EMACS_TIME select_timeout = { 0, 0 };
+static int selfds[2] = { -1, -1 };
+static pthread_mutex_t select_mutex;
+static int apploopnr = 0;
static NSAutoreleasePool *outerpool;
static struct input_event *emacs_event = NULL;
static struct input_event *q_event_ptr = NULL;
static int n_emacs_events_pending = 0;
static NSMutableArray *ns_pending_files, *ns_pending_service_names,
*ns_pending_service_args;
-static BOOL inNsSelect = 0;
+static BOOL ns_do_open_file = NO;
+
+static struct {
+ struct input_event *q;
+ int nr, cap;
+} hold_event_q = {
+ NULL, 0, 0
+};
/* Convert modifiers in a NeXTstep event to emacs style modifiers. */
#define NS_FUNCTION_KEY_MASK 0x800000
@@ -246,15 +287,20 @@ static BOOL inNsSelect = 0;
/* This is a piece of code which is common to all the event handling
methods. Maybe it should even be a function. */
-#define EV_TRAILER(e) \
- { \
- XSETFRAME (emacs_event->frame_or_window, emacsframe); \
- if (e) emacs_event->timestamp = EV_TIMESTAMP (e); \
- n_emacs_events_pending++; \
- kbd_buffer_store_event_hold (emacs_event, q_event_ptr); \
- EVENT_INIT (*emacs_event); \
- ns_send_appdefined (-1); \
- }
+#define EV_TRAILER(e) \
+ { \
+ XSETFRAME (emacs_event->frame_or_window, emacsframe); \
+ if (e) emacs_event->timestamp = EV_TIMESTAMP (e); \
+ if (q_event_ptr) \
+ { \
+ n_emacs_events_pending++; \
+ kbd_buffer_store_event_hold (emacs_event, q_event_ptr); \
+ } \
+ else \
+ hold_event (emacs_event); \
+ EVENT_INIT (*emacs_event); \
+ ns_send_appdefined (-1); \
+ }
void x_set_cursor_type (struct frame *, Lisp_Object, Lisp_Object);
@@ -270,6 +316,22 @@ void x_set_frame_alpha (struct frame *f);
========================================================================== */
+static void
+hold_event (struct input_event *event)
+{
+ if (hold_event_q.nr == hold_event_q.cap)
+ {
+ if (hold_event_q.cap == 0) hold_event_q.cap = 10;
+ else hold_event_q.cap *= 2;
+ hold_event_q.q = (struct input_event *)
+ xrealloc (hold_event_q.q, hold_event_q.cap * sizeof (*hold_event_q.q));
+ }
+
+ hold_event_q.q[hold_event_q.nr++] = *event;
+ /* Make sure ns_read_socket is called, i.e. we have input. */
+ raise (SIGIO);
+ send_appdefined = YES;
+}
static Lisp_Object
append2 (Lisp_Object list, Lisp_Object item)
@@ -284,24 +346,51 @@ append2 (Lisp_Object list, Lisp_Object item)
}
-void
-ns_init_paths (void)
-/* --------------------------------------------------------------------------
- Used to allow emacs to find its resources under Emacs.app
- Called from emacs.c at startup.
- -------------------------------------------------------------------------- */
+const char *
+ns_etc_directory (void)
+/* If running as a self-contained app bundle, return as a string the
+ filename of the etc directory, if present; else nil. */
+{
+ NSBundle *bundle = [NSBundle mainBundle];
+ NSString *resourceDir = [bundle resourcePath];
+ NSString *resourcePath;
+ NSFileManager *fileManager = [NSFileManager defaultManager];
+ BOOL isDir;
+
+ resourcePath = [resourceDir stringByAppendingPathComponent: @"etc"];
+ if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
+ {
+ if (isDir) return [resourcePath UTF8String];
+ }
+ return NULL;
+}
+
+
+const char *
+ns_exec_path (void)
+/* If running as a self-contained app bundle, return as a path string
+ the filenames of the libexec and bin directories, ie libexec:bin.
+ Otherwise, return nil.
+ Normally, Emacs does not add its own bin/ directory to the PATH.
+ However, a self-contained NS build has a different layout, with
+ bin/ and libexec/ subdirectories in the directory that contains
+ Emacs.app itself.
+ We put libexec first, because init_callproc_1 uses the first
+ element to initialize exec-directory. An alternative would be
+ for init_callproc to check for invocation-directory/libexec.
+*/
{
NSBundle *bundle = [NSBundle mainBundle];
- NSString *binDir = [bundle bundlePath], *resourceDir = [bundle resourcePath];
+ NSString *resourceDir = [bundle resourcePath];
+ NSString *binDir = [bundle bundlePath];
NSString *resourcePath, *resourcePaths;
NSRange range;
- BOOL onWindows = NO; /* how do I determine this? */
- NSString *pathSeparator = onWindows ? @";" : @":";
+ NSString *pathSeparator = [NSString stringWithFormat: @"%c", SEPCHAR];
NSFileManager *fileManager = [NSFileManager defaultManager];
+ NSArray *paths;
+ NSEnumerator *pathEnum;
BOOL isDir;
-/*NSLog (@"ns_init_paths: '%@'\n%@\n", [[NSBundle mainBundle] bundlePath], [[NSBundle mainBundle] resourcePath]); */
- /* get bindir from base */
range = [resourceDir rangeOfString: @"Contents"];
if (range.location != NSNotFound)
{
@@ -311,107 +400,65 @@ ns_init_paths (void)
#endif
}
- /* the following based on Andrew Choi's init_mac_osx_environment () */
- if (!getenv ("EMACSLOADPATH"))
- {
- NSArray *paths = [resourceDir stringsByAppendingPaths:
- [NSArray arrayWithObjects:
- @"site-lisp", @"lisp", @"leim", nil]];
- NSEnumerator *pathEnum = [paths objectEnumerator];
- resourcePaths = @"";
- while (resourcePath = [pathEnum nextObject])
- {
- if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
- if (isDir)
- {
- if ([resourcePaths length] > 0)
- resourcePaths
- = [resourcePaths stringByAppendingString: pathSeparator];
- resourcePaths
- = [resourcePaths stringByAppendingString: resourcePath];
- }
- }
- if ([resourcePaths length] > 0)
- setenv ("EMACSLOADPATH", [resourcePaths UTF8String], 1);
-/*NSLog (@"loadPath: '%@'\n", resourcePaths); */
- }
-
- if (!getenv ("EMACSPATH"))
- {
- NSArray *paths = [binDir stringsByAppendingPaths:
- [NSArray arrayWithObjects: @"bin",
- @"lib-exec", nil]];
- NSEnumerator *pathEnum = [paths objectEnumerator];
- resourcePaths = @"";
- while (resourcePath = [pathEnum nextObject])
- {
- if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
- if (isDir)
- {
- if ([resourcePaths length] > 0)
- resourcePaths
- = [resourcePaths stringByAppendingString: pathSeparator];
- resourcePaths
- = [resourcePaths stringByAppendingString: resourcePath];
- }
- }
- if ([resourcePaths length] > 0)
- setenv ("EMACSPATH", [resourcePaths UTF8String], 1);
- }
-
- resourcePath = [resourceDir stringByAppendingPathComponent: @"etc"];
- if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
- {
- if (isDir)
- {
- if (!getenv ("EMACSDATA"))
- setenv ("EMACSDATA", [resourcePath UTF8String], 1);
- if (!getenv ("EMACSDOC"))
- setenv ("EMACSDOC", [resourcePath UTF8String], 1);
- }
- }
+ paths = [binDir stringsByAppendingPaths:
+ [NSArray arrayWithObjects: @"libexec", @"bin", nil]];
+ pathEnum = [paths objectEnumerator];
+ resourcePaths = @"";
- if (!getenv ("INFOPATH"))
+ while ((resourcePath = [pathEnum nextObject]))
{
- resourcePath = [resourceDir stringByAppendingPathComponent: @"info"];
if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
if (isDir)
- setenv ("INFOPATH", [[resourcePath stringByAppendingString: @":"]
- UTF8String], 1);
- /* Note, extra colon needed to cause merge w/later user additions. */
+ {
+ if ([resourcePaths length] > 0)
+ resourcePaths
+ = [resourcePaths stringByAppendingString: pathSeparator];
+ resourcePaths
+ = [resourcePaths stringByAppendingString: resourcePath];
+ }
}
+ if ([resourcePaths length] > 0) return [resourcePaths UTF8String];
+
+ return NULL;
}
-static int
-timeval_subtract (struct timeval *result, struct timeval x, struct timeval y)
-/* --------------------------------------------------------------------------
- Subtract the `struct timeval' values X and Y, storing the result in RESULT.
- Return 1 if the difference is negative, otherwise 0.
- -------------------------------------------------------------------------- */
+const char *
+ns_load_path (void)
+/* If running as a self-contained app bundle, return as a path string
+ the filenames of the site-lisp, lisp and leim directories.
+ Ie, site-lisp:lisp:leim. Otherwise, return nil. */
{
- /* Perform the carry for the later subtraction by updating y.
- This is safer because on some systems
- the tv_sec member is unsigned. */
- if (x.tv_usec < y.tv_usec)
- {
- int nsec = (y.tv_usec - x.tv_usec) / 1000000 + 1;
- y.tv_usec -= 1000000 * nsec;
- y.tv_sec += nsec;
- }
- if (x.tv_usec - y.tv_usec > 1000000)
+ NSBundle *bundle = [NSBundle mainBundle];
+ NSString *resourceDir = [bundle resourcePath];
+ NSString *resourcePath, *resourcePaths;
+ NSString *pathSeparator = [NSString stringWithFormat: @"%c", SEPCHAR];
+ NSFileManager *fileManager = [NSFileManager defaultManager];
+ BOOL isDir;
+ NSArray *paths = [resourceDir stringsByAppendingPaths:
+ [NSArray arrayWithObjects:
+ @"site-lisp", @"lisp", @"leim", nil]];
+ NSEnumerator *pathEnum = [paths objectEnumerator];
+ resourcePaths = @"";
+
+ /* Hack to skip site-lisp. */
+ if (no_site_lisp) resourcePath = [pathEnum nextObject];
+
+ while ((resourcePath = [pathEnum nextObject]))
{
- int nsec = (y.tv_usec - x.tv_usec) / 1000000;
- y.tv_usec += 1000000 * nsec;
- y.tv_sec -= nsec;
+ if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
+ if (isDir)
+ {
+ if ([resourcePaths length] > 0)
+ resourcePaths
+ = [resourcePaths stringByAppendingString: pathSeparator];
+ resourcePaths
+ = [resourcePaths stringByAppendingString: resourcePath];
+ }
}
+ if ([resourcePaths length] > 0) return [resourcePaths UTF8String];
- /* Compute the time remaining to wait. tv_usec is certainly positive. */
- result->tv_sec = x.tv_sec - y.tv_sec;
- result->tv_usec = x.tv_usec - y.tv_usec;
-
- /* Return indication of whether the result should be considered negative. */
- return x.tv_sec < y.tv_sec;
+ return NULL;
}
static void
@@ -420,29 +467,19 @@ ns_timeout (int usecs)
Blocking timer utility used by ns_ring_bell
-------------------------------------------------------------------------- */
{
- struct timeval wakeup;
-
- EMACS_GET_TIME (wakeup);
-
- /* Compute time to wait until, propagating carry from usecs. */
- wakeup.tv_usec += usecs;
- wakeup.tv_sec += (wakeup.tv_usec / 1000000);
- wakeup.tv_usec %= 1000000;
+ EMACS_TIME wakeup = add_emacs_time (current_emacs_time (),
+ make_emacs_time (0, usecs * 1000));
/* Keep waiting until past the time wakeup. */
while (1)
{
- struct timeval timeout;
-
- EMACS_GET_TIME (timeout);
-
- /* In effect, timeout = wakeup - timeout.
- Break if result would be negative. */
- if (timeval_subtract (&timeout, wakeup, timeout))
+ EMACS_TIME timeout, now = current_emacs_time ();
+ if (EMACS_TIME_LE (wakeup, now))
break;
+ timeout = sub_emacs_time (wakeup, now);
/* Try to wait that long--but we might wake up sooner. */
- select (0, NULL, NULL, NULL, &timeout);
+ pselect (0, NULL, NULL, NULL, &timeout, NULL);
}
}
@@ -494,17 +531,6 @@ ns_release_autorelease_pool (void *pool)
========================================================================== */
-static NSRect
-ns_resize_handle_rect (NSWindow *window)
-{
- NSRect r = [window frame];
- r.origin.x = r.size.width - RESIZE_HANDLE_SIZE;
- r.origin.y = 0;
- r.size.width = r.size.height = RESIZE_HANDLE_SIZE;
- return r;
-}
-
-
//
// Window constraining
// -------------------
@@ -582,12 +608,9 @@ ns_menu_bar_should_be_hidden (void)
static void
ns_update_auto_hide_menu_bar (void)
{
-#ifndef MAC_OS_X_VERSION_10_6
-#define MAC_OS_X_VERSION_10_6 1060
-#endif
#ifdef NS_IMPL_COCOA
#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
- BLOCK_INPUT;
+ block_input ();
NSTRACE (ns_update_auto_hide_menu_bar);
@@ -618,7 +641,7 @@ ns_update_auto_hide_menu_bar (void)
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
#endif
#endif
}
@@ -632,6 +655,8 @@ ns_update_begin (struct frame *f)
-------------------------------------------------------------------------- */
{
NSView *view = FRAME_NS_VIEW (f);
+ NSRect r = [view frame];
+ NSBezierPath *bp;
NSTRACE (ns_update_begin);
ns_update_auto_hide_menu_bar ();
@@ -639,6 +664,14 @@ ns_update_begin (struct frame *f)
ns_updating_frame = f;
[view lockFocus];
+ /* drawRect may have been called for say the minibuffer, and then clip path
+ is for the minibuffer. But the display engine may draw more because
+ we have set the frame as garbaged. So reset clip path to the whole
+ view. */
+ bp = [[NSBezierPath bezierPathWithRect: r] retain];
+ [bp setClip];
+ [bp release];
+
#ifdef NS_IMPL_GNUSTEP
uRect = NSMakeRect (0, 0, 0, 0);
#endif
@@ -655,11 +688,10 @@ ns_update_window_begin (struct window *w)
struct frame *f = XFRAME (WINDOW_FRAME (w));
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
NSTRACE (ns_update_window_begin);
-
updated_window = w;
set_output_cursor (&w->cursor);
- BLOCK_INPUT;
+ block_input ();
if (f == hlinfo->mouse_face_mouse_frame)
{
@@ -674,7 +706,7 @@ ns_update_window_begin (struct window *w)
/* (further code for mouse faces ifdef'd out in other terms elided) */
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -691,7 +723,7 @@ ns_update_window_end (struct window *w, int cursor_on_p,
/* note: this fn is nearly identical in all terms */
if (!w->pseudo_window_p)
{
- BLOCK_INPUT;
+ block_input ();
if (cursor_on_p)
display_and_set_cursor (w, 1,
@@ -701,7 +733,7 @@ ns_update_window_end (struct window *w, int cursor_on_p,
if (draw_window_fringes (w, 1))
x_draw_vertical_border (w);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* If a row with mouse-face was overwritten, arrange for
@@ -730,7 +762,7 @@ ns_update_end (struct frame *f)
/* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */
MOUSE_HL_INFO (f)->mouse_face_defer = 0;
- BLOCK_INPUT;
+ block_input ();
#ifdef NS_IMPL_GNUSTEP
/* trigger flush only in the rectangle we tracked as being drawn */
@@ -742,7 +774,7 @@ ns_update_end (struct frame *f)
[view unlockFocus];
[[view window] flushWindow];
- UNBLOCK_INPUT;
+ unblock_input ();
ns_updating_frame = NULL;
NSTRACE (ns_update_end);
}
@@ -876,25 +908,12 @@ ns_clip_to_row (struct window *w, struct glyph_row *row, int area, BOOL gc)
window_box (w, area, &window_x, &window_y, &window_width, 0);
- clip_rect.origin.x = window_x - FRAME_INTERNAL_BORDER_WIDTH (f);
+ clip_rect.origin.x = window_x;
clip_rect.origin.y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, row->y));
clip_rect.origin.y = max (clip_rect.origin.y, window_y);
- clip_rect.size.width = window_width + 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
+ clip_rect.size.width = window_width;
clip_rect.size.height = row->visible_height;
- /* allow a full-height row at the top when requested
- (used to draw fringe all the way through internal border area) */
- if (gc && clip_rect.origin.y < 5)
- {
- clip_rect.origin.y -= FRAME_INTERNAL_BORDER_WIDTH (f);
- clip_rect.size.height += FRAME_INTERNAL_BORDER_WIDTH (f);
- }
-
- /* likewise at bottom */
- if (gc &&
- FRAME_PIXEL_HEIGHT (f) - (clip_rect.origin.y + clip_rect.size.height) < 5)
- clip_rect.size.height += FRAME_INTERNAL_BORDER_WIDTH (f);
-
ns_focus (f, &clip_rect, 1);
}
@@ -912,7 +931,7 @@ ns_ring_bell (struct frame *f)
struct frame *frame = SELECTED_FRAME ();
NSView *view;
- BLOCK_INPUT;
+ block_input ();
pool = [[NSAutoreleasePool alloc] init];
view = FRAME_NS_VIEW (frame);
@@ -939,7 +958,7 @@ ns_ring_bell (struct frame *f)
ns_unfocus (frame);
}
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
}
else
{
@@ -980,13 +999,13 @@ ns_raise_frame (struct frame *f)
{
NSView *view = FRAME_NS_VIEW (f);
check_ns ();
- BLOCK_INPUT;
+ block_input ();
FRAME_SAMPLE_VISIBILITY (f);
if (FRAME_VISIBLE_P (f))
{
[[view window] makeKeyAndOrderFront: NSApp];
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -998,9 +1017,9 @@ ns_lower_frame (struct frame *f)
{
NSView *view = FRAME_NS_VIEW (f);
check_ns ();
- BLOCK_INPUT;
+ block_input ();
[[view window] orderBack: NSApp];
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -1037,7 +1056,7 @@ ns_frame_rehighlight (struct frame *frame)
: dpyinfo->x_focus_frame);
if (!FRAME_LIVE_P (dpyinfo->x_highlight_frame))
{
- FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame) = Qnil;
+ fset_focus_frame (dpyinfo->x_focus_frame, Qnil);
dpyinfo->x_highlight_frame = dpyinfo->x_focus_frame;
}
}
@@ -1073,8 +1092,23 @@ x_make_frame_visible (struct frame *f)
if this ends up the case again, comment this out again. */
if (!FRAME_VISIBLE_P (f))
{
+ EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
f->async_visible = 1;
ns_raise_frame (f);
+
+#ifdef NEW_STYLE_FS
+ /* Making a new frame from a fullscreen frame will make the new frame
+ fullscreen also. So skip handleFS as this will print an error. */
+ if (f->want_fullscreen == FULLSCREEN_BOTH
+ && ([[view window] styleMask] & NSFullScreenWindowMask) != 0)
+ return;
+#endif
+ if (f->want_fullscreen != FULLSCREEN_NONE)
+ {
+ block_input ();
+ [view handleFS];
+ unblock_input ();
+ }
}
}
@@ -1131,12 +1165,12 @@ x_free_frame_resources (struct frame *f)
NSView *view = FRAME_NS_VIEW (f);
struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f);
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
- NSTRACE (x_destroy_window);
+ NSTRACE (x_free_frame_resources);
check_ns ();
[(EmacsView *)view setWindowClosing: YES]; /* may not have been informed */
- BLOCK_INPUT;
+ block_input ();
free_frame_menubar (f);
@@ -1152,19 +1186,18 @@ x_free_frame_resources (struct frame *f)
hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1;
hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1;
hlinfo->mouse_face_window = Qnil;
- hlinfo->mouse_face_deferred_gc = 0;
hlinfo->mouse_face_mouse_frame = 0;
}
- xfree (f->output_data.ns);
-
if (f->output_data.ns->miniimage != nil)
[f->output_data.ns->miniimage release];
[[view window] close];
[view release];
- UNBLOCK_INPUT;
+ xfree (f->output_data.ns);
+
+ unblock_input ();
}
void
@@ -1193,7 +1226,7 @@ x_set_offset (struct frame *f, int xoff, int yoff, int change_grav)
NSTRACE (x_set_offset);
- BLOCK_INPUT;
+ block_input ();
f->left_pos = xoff;
f->top_pos = yoff;
@@ -1225,7 +1258,7 @@ x_set_offset (struct frame *f, int xoff, int yoff, int change_grav)
f->size_hint_flags &= ~(XNegative|YNegative);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -1238,36 +1271,21 @@ x_set_window_size (struct frame *f, int change_grav, int cols, int rows)
-------------------------------------------------------------------------- */
{
EmacsView *view = FRAME_NS_VIEW (f);
- EmacsToolbar *toolbar = [view toolbar];
NSWindow *window = [view window];
NSRect wr = [window frame];
int tb = FRAME_EXTERNAL_TOOL_BAR (f);
int pixelwidth, pixelheight;
- static int oldRows, oldCols, oldFontWidth, oldFontHeight;
- static int oldTB;
- static struct frame *oldF;
NSTRACE (x_set_window_size);
- if (view == nil ||
- (f == oldF
- && rows == oldRows && cols == oldCols
- && oldFontWidth == FRAME_COLUMN_WIDTH (f)
- && oldFontHeight == FRAME_LINE_HEIGHT (f)
- && oldTB == tb))
+ if (view == nil)
return;
/*fprintf (stderr, "\tsetWindowSize: %d x %d, font size %d x %d\n", cols, rows, FRAME_COLUMN_WIDTH (f), FRAME_LINE_HEIGHT (f)); */
- BLOCK_INPUT;
+ block_input ();
check_frame_size (f, &rows, &cols);
- oldF = f;
- oldRows = rows;
- oldCols = cols;
- oldFontWidth = FRAME_COLUMN_WIDTH (f);
- oldFontHeight = FRAME_LINE_HEIGHT (f);
- oldTB = tb;
f->scroll_bar_actual_width = NS_SCROLL_BAR_WIDTH (f);
compute_fringe_widths (f, 0);
@@ -1327,10 +1345,33 @@ x_set_window_size (struct frame *f, int change_grav, int cols, int rows)
mark_window_cursors_off (XWINDOW (f->root_window));
cancel_mouse_face (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
+static void
+ns_fullscreen_hook (FRAME_PTR f)
+{
+ EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
+
+ if (! f->async_visible) return;
+#ifndef NEW_STYLE_FS
+ if (f->want_fullscreen == FULLSCREEN_BOTH)
+ {
+ /* Old style fs don't initiate correctly if created from
+ init/default-frame alist, so use a timer (not nice...).
+ */
+ [NSTimer scheduledTimerWithTimeInterval: 0.5 target: view
+ selector: @selector (handleFS)
+ userInfo: nil repeats: NO];
+ return;
+ }
+#endif
+
+ block_input ();
+ [view handleFS];
+ unblock_input ();
+}
/* ==========================================================================
@@ -1360,8 +1401,7 @@ ns_index_color (NSColor *color, struct frame *f)
{
color_table->size = NS_COLOR_CAPACITY;
color_table->avail = 1; /* skip idx=0 as marker */
- color_table->colors
- = (NSColor **)xmalloc (color_table->size * sizeof (NSColor *));
+ color_table->colors = xmalloc (color_table->size * sizeof (NSColor *));
color_table->colors[0] = nil;
color_table->empty_indices = [[NSMutableSet alloc] init];
}
@@ -1440,7 +1480,7 @@ ns_get_color (const char *name, NSColor **col)
NSString *nsname = [NSString stringWithUTF8String: name];
/*fprintf (stderr, "ns_get_color: '%s'\n", name); */
- BLOCK_INPUT;
+ block_input ();
if ([nsname isEqualToString: @"ns_selection_color"])
{
@@ -1459,21 +1499,16 @@ ns_get_color (const char *name, NSColor **col)
[scanner scanFloat: &b];
}
else if (!strncmp(name, "rgb:", 4)) /* A newer X11 format -- rgb:r/g/b */
- {
- strncpy (hex, name + 4, 19);
- hex[19] = '\0';
- scaling = (strlen(hex) - 2) / 3;
- }
+ scaling = (snprintf (hex, sizeof hex, "%s", name + 4) - 2) / 3;
else if (name[0] == '#') /* An old X11 format; convert to newer */
{
int len = (strlen(name) - 1);
int start = (len % 3 == 0) ? 1 : len / 4 + 1;
int i;
scaling = strlen(name+start) / 3;
- for (i=0; i<3; i++) {
- strncpy(hex + i * (scaling + 1), name + start + i * scaling, scaling);
- hex[(i+1) * (scaling + 1) - 1] = '/';
- }
+ for (i = 0; i < 3; i++)
+ sprintf (hex + i * (scaling + 1), "%.*s/", scaling,
+ name + start + i * scaling);
hex[3 * (scaling + 1) - 1] = '\0';
}
@@ -1492,7 +1527,7 @@ ns_get_color (const char *name, NSColor **col)
if (r >= 0.0)
{
*col = [NSColor colorWithCalibratedRed: r green: g blue: b alpha: 1.0];
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
@@ -1524,26 +1559,11 @@ ns_get_color (const char *name, NSColor **col)
if (new)
*col = [new colorUsingColorSpaceName: NSCalibratedRGBColorSpace];
- UNBLOCK_INPUT;
+ unblock_input ();
return new ? 0 : 1;
}
-static NSColor *
-ns_get_color_default (const char *name, NSColor *dflt)
-/* --------------------------------------------------------------------------
- Parse a color or use a default value
- -------------------------------------------------------------------------- */
-{
- NSColor * col;
-
- if (ns_get_color (name, &col))
- return dflt;
- else
- return col;
-}
-
-
int
ns_lisp_to_color (Lisp_Object color, NSColor **col)
/* --------------------------------------------------------------------------
@@ -1552,9 +1572,9 @@ ns_lisp_to_color (Lisp_Object color, NSColor **col)
{
NSTRACE (ns_lisp_to_color);
if (STRINGP (color))
- return ns_get_color (SDATA (color), col);
+ return ns_get_color (SSDATA (color), col);
else if (SYMBOLP (color))
- return ns_get_color (SDATA (SYMBOL_NAME (color)), col);
+ return ns_get_color (SSDATA (SYMBOL_NAME (color)), col);
return 1;
}
@@ -1570,12 +1590,12 @@ ns_color_to_lisp (NSColor *col)
const char *str;
NSTRACE (ns_color_to_lisp);
- BLOCK_INPUT;
+ block_input ();
if ([[col colorSpaceName] isEqualToString: NSNamedColorSpace])
if ((str =[[col colorNameComponent] UTF8String]))
{
- UNBLOCK_INPUT;
+ unblock_input ();
return build_string ((char *)str);
}
@@ -1587,14 +1607,14 @@ ns_color_to_lisp (NSColor *col)
getWhite: &gray alpha: &alpha];
snprintf (buf, sizeof (buf), "#%2.2lx%2.2lx%2.2lx",
lrint (gray * 0xff), lrint (gray * 0xff), lrint (gray * 0xff));
- UNBLOCK_INPUT;
+ unblock_input ();
return build_string (buf);
}
snprintf (buf, sizeof (buf), "#%2.2lx%2.2lx%2.2lx",
lrint (red*0xff), lrint (green*0xff), lrint (blue*0xff));
- UNBLOCK_INPUT;
+ unblock_input ();
return build_string (buf);
}
@@ -1621,33 +1641,33 @@ ns_query_color(void *col, XColor *color_def, int setPixel)
}
-int
+bool
ns_defined_color (struct frame *f,
const char *name,
XColor *color_def,
- int alloc,
- char makeIndex)
+ bool alloc,
+ bool makeIndex)
/* --------------------------------------------------------------------------
- Return 1 if named color found, and set color_def rgb accordingly.
+ Return true if named color found, and set color_def rgb accordingly.
If makeIndex and alloc are nonzero put the color in the color_table,
and set color_def pixel to the resulting index.
If makeIndex is zero, set color_def pixel to ARGB.
- Return 0 if not found
+ Return false if not found
-------------------------------------------------------------------------- */
{
NSColor *col;
NSTRACE (ns_defined_color);
- BLOCK_INPUT;
+ block_input ();
if (ns_get_color (name, &col) != 0) /* Color not found */
{
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
if (makeIndex && alloc)
color_def->pixel = ns_index_color (col, f);
ns_query_color (col, color_def, !makeIndex);
- UNBLOCK_INPUT;
+ unblock_input ();
return 1;
}
@@ -1799,7 +1819,6 @@ ns_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window,
{
id view;
NSPoint position;
- int xchar, ychar;
Lisp_Object frame, tail;
struct frame *f;
struct ns_display_info *dpyinfo;
@@ -1814,7 +1833,7 @@ ns_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window,
dpyinfo = FRAME_NS_DISPLAY_INFO (*fp);
- BLOCK_INPUT;
+ block_input ();
if (last_mouse_scroll_bar != nil && insist == 0)
{
@@ -1859,7 +1878,7 @@ ns_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window,
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -1867,8 +1886,7 @@ static void
ns_frame_up_to_date (struct frame *f)
/* --------------------------------------------------------------------------
External (hook): Fix up mouse highlighting right after a full update.
- Some highlighting was deferred if GC was happening during
- note_mouse_highlight (), while other highlighting was deferred for update.
+ Can't use FRAME_MOUSE_UPDATE due to ns_frame_begin and ns_frame_end calls.
-------------------------------------------------------------------------- */
{
NSTRACE (ns_frame_up_to_date);
@@ -1876,24 +1894,22 @@ ns_frame_up_to_date (struct frame *f)
if (FRAME_NS_P (f))
{
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
- if ((hlinfo->mouse_face_deferred_gc || f ==hlinfo->mouse_face_mouse_frame)
- /*&& hlinfo->mouse_face_mouse_frame*/)
- {
- BLOCK_INPUT;
+ if (f == hlinfo->mouse_face_mouse_frame)
+ {
+ block_input ();
ns_update_begin(f);
- if (hlinfo->mouse_face_mouse_frame)
- note_mouse_highlight (hlinfo->mouse_face_mouse_frame,
- hlinfo->mouse_face_mouse_x,
- hlinfo->mouse_face_mouse_y);
- hlinfo->mouse_face_deferred_gc = 0;
+ if (hlinfo->mouse_face_mouse_frame)
+ note_mouse_highlight (hlinfo->mouse_face_mouse_frame,
+ hlinfo->mouse_face_mouse_x,
+ hlinfo->mouse_face_mouse_y);
ns_update_end(f);
- UNBLOCK_INPUT;
- }
+ unblock_input ();
+ }
}
}
-void
+static void
ns_define_frame_cursor (struct frame *f, Cursor cursor)
/* --------------------------------------------------------------------------
External (RIF): set frame mouse pointer type.
@@ -1967,7 +1983,7 @@ ns_redraw_scroll_bars (struct frame *f)
int i;
id view;
NSArray *subviews = [[FRAME_NS_VIEW (f) superview] subviews];
- NSTRACE (ns_judge_scroll_bars);
+ NSTRACE (ns_redraw_scroll_bars);
for (i =[subviews count]-1; i >= 0; i--)
{
view = [subviews objectAtIndex: i];
@@ -1987,8 +2003,6 @@ ns_clear_frame (struct frame *f)
NSRect r;
NSTRACE (ns_clear_frame);
- if (ns_in_resize)
- return;
/* comes on initial frame because we have
after-make-frame-functions = select-frame */
@@ -2002,23 +2016,19 @@ ns_clear_frame (struct frame *f)
r = [view bounds];
- BLOCK_INPUT;
+ block_input ();
ns_focus (f, &r, 1);
[ns_lookup_indexed_color (NS_FACE_BACKGROUND (FRAME_DEFAULT_FACE (f)), f) set];
NSRectFill (r);
ns_unfocus (f);
-#ifdef NS_IMPL_COCOA
- [[view window] display]; /* redraw resize handle */
-#endif
-
/* as of 2006/11 or so this is now needed */
ns_redraw_scroll_bars (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
-void
+static void
ns_clear_frame_area (struct frame *f, int x, int y, int width, int height)
/* --------------------------------------------------------------------------
External (RIF): Clear section of frame
@@ -2037,35 +2047,8 @@ ns_clear_frame_area (struct frame *f, int x, int y, int width, int height)
ns_focus (f, &r, 1);
[ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set];
-#ifdef NS_IMPL_COCOA
- {
- /* clip out the resize handle */
- NSWindow *window = [FRAME_NS_VIEW (f) window];
- NSRect ir
- = [view convertRect: ns_resize_handle_rect (window) fromView: nil];
-
- ir = NSIntersectionRect (r, ir);
- if (NSIsEmptyRect (ir))
- {
-#endif
-
NSRectFill (r);
-#ifdef NS_IMPL_COCOA
- }
- else
- {
- NSRect r1 = r, r2 = r; /* upper and lower non-intersecting */
- r1.size.height -= ir.size.height;
- r2.origin.y += r1.size.height;
- r2.size.width -= ir.size.width;
- r2.size.height = ir.size.height;
- NSRectFill (r1);
- NSRectFill (r2);
- }
- }
-#endif
-
ns_unfocus (f);
return;
}
@@ -2115,7 +2098,7 @@ ns_scroll_run (struct window *w, struct run *run)
if (height == 0)
return;
- BLOCK_INPUT;
+ block_input ();
updated_window = w;
x_clear_cursor (w);
@@ -2130,7 +2113,7 @@ ns_scroll_run (struct window *w, struct run *run)
ns_unfocus (f);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -2147,15 +2130,15 @@ ns_after_update_window_line (struct glyph_row *desired_row)
NSTRACE (ns_after_update_window_line);
/* begin copy from other terms */
- xassert (w);
+ eassert (w);
if (!desired_row->mode_line_p && !w->pseudo_window_p)
desired_row->redraw_fringe_bitmaps_p = 1;
/* When a window has disappeared, make sure that no rest of
- full-width rows stays visible in the internal border.
- Under NS this is drawn inside the fringes. */
+ full-width rows stays visible in the internal border. */
if (windows_or_buffers_changed
+ && desired_row->full_width_p
&& (f = XFRAME (w->frame),
width = FRAME_INTERNAL_BORDER_WIDTH (f),
width != 0)
@@ -2164,25 +2147,12 @@ ns_after_update_window_line (struct glyph_row *desired_row)
{
int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y));
- /* Internal border is drawn below the tool bar. */
- if (WINDOWP (f->tool_bar_window)
- && w == XWINDOW (f->tool_bar_window))
- y -= width;
- /* end copy from other terms */
-
- BLOCK_INPUT;
- if (!desired_row->full_width_p)
- {
- int x1 = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (w)
- + WINDOW_LEFT_FRINGE_WIDTH (w);
- int x2 = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (w)
- + FRAME_PIXEL_WIDTH (f) - NS_SCROLL_BAR_WIDTH (f)
- - WINDOW_RIGHT_FRINGE_WIDTH (w)
- - FRAME_INTERNAL_BORDER_WIDTH (f);
- ns_clear_frame_area (f, x1, y, width, height);
- ns_clear_frame_area (f, x2, y, width, height);
- }
- UNBLOCK_INPUT;
+ block_input ();
+ ns_clear_frame_area (f, 0, y, width, height);
+ ns_clear_frame_area (f,
+ FRAME_PIXEL_WIDTH (f) - width,
+ y, width, height);
+ unblock_input ();
}
}
@@ -2215,14 +2185,13 @@ ns_shift_glyphs_for_insert (struct frame *f,
========================================================================== */
-static inline void
+static void
ns_compute_glyph_string_overhangs (struct glyph_string *s)
/* --------------------------------------------------------------------------
External (RIF); compute left/right overhang of whole string and set in s
-------------------------------------------------------------------------- */
{
- struct face *face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
- struct font *font = s->font; /*face->font; */
+ struct font *font = s->font;
if (s->char2b)
{
@@ -2267,32 +2236,13 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
int rowY;
static EmacsImage **bimgs = NULL;
static int nBimgs = 0;
- /* NS-specific: move internal border inside fringe */
- int x = p->bx < 0 ? p->x : p->bx;
- int wd = p->bx < 0 ? p->wd : p->nx;
- BOOL fringeOnVeryLeft
- = x - WINDOW_LEFT_SCROLL_BAR_COLS (w) * WINDOW_FRAME_COLUMN_WIDTH (w)
- - FRAME_INTERNAL_BORDER_WIDTH (f) < 10;
- BOOL fringeOnVeryRight
- = FRAME_PIXEL_WIDTH (f) - x - wd - FRAME_INTERNAL_BORDER_WIDTH (f)
- - WINDOW_RIGHT_SCROLL_BAR_COLS (w) * WINDOW_FRAME_COLUMN_WIDTH (w) < 10;
- int xAdjust = FRAME_INTERNAL_BORDER_WIDTH (f) *
- (fringeOnVeryLeft ? -1 : (fringeOnVeryRight ? 1 : 0));
/* grow bimgs if needed */
if (nBimgs < max_used_fringe_bitmap)
{
- EmacsImage **newBimgs
- = xmalloc (max_used_fringe_bitmap * sizeof (EmacsImage *));
- memset (newBimgs, 0, max_used_fringe_bitmap * sizeof (EmacsImage *));
-
- if (nBimgs)
- {
- memcpy (newBimgs, bimgs, nBimgs * sizeof (EmacsImage *));
- xfree (bimgs);
- }
-
- bimgs = newBimgs;
+ bimgs = xrealloc (bimgs, max_used_fringe_bitmap * sizeof *bimgs);
+ memset (bimgs + nBimgs, 0,
+ (max_used_fringe_bitmap - nBimgs) * sizeof *bimgs);
nBimgs = max_used_fringe_bitmap;
}
@@ -2300,23 +2250,68 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
rowY = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
ns_clip_to_row (w, row, -1, YES);
- if (p->bx >= 0 && !p->overlay_p)
+ if (!p->overlay_p)
{
- int yAdjust = rowY - FRAME_INTERNAL_BORDER_WIDTH (f) < 5 ?
- -FRAME_INTERNAL_BORDER_WIDTH (f) : 0;
- int yIncr = FRAME_PIXEL_HEIGHT (f) - (p->by+yAdjust + p->ny) < 5 ?
- FRAME_INTERNAL_BORDER_WIDTH (f) : 0
- + (yAdjust ? FRAME_INTERNAL_BORDER_WIDTH (f) : 0);
- NSRect r = NSMakeRect (p->bx+xAdjust, p->by+yAdjust, p->nx, p->ny+yIncr);
- NSRectClip (r);
- [ns_lookup_indexed_color(face->background, f) set];
- NSRectFill (r);
+ int bx = p->bx, by = p->by, nx = p->nx, ny = p->ny;
+
+ /* If the fringe is adjacent to the left (right) scroll bar of a
+ leftmost (rightmost, respectively) window, then extend its
+ background to the gap between the fringe and the bar. */
+ if ((WINDOW_LEFTMOST_P (w)
+ && WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w))
+ || (WINDOW_RIGHTMOST_P (w)
+ && WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w)))
+ {
+ int sb_width = WINDOW_CONFIG_SCROLL_BAR_WIDTH (w);
+
+ if (sb_width > 0)
+ {
+ int bar_area_x = WINDOW_SCROLL_BAR_AREA_X (w);
+ int bar_area_width = (WINDOW_CONFIG_SCROLL_BAR_COLS (w)
+ * FRAME_COLUMN_WIDTH (f));
+
+ if (bx < 0)
+ {
+ /* Bitmap fills the fringe. */
+ if (bar_area_x + bar_area_width == p->x)
+ bx = bar_area_x + sb_width;
+ else if (p->x + p->wd == bar_area_x)
+ bx = bar_area_x;
+ if (bx >= 0)
+ {
+ int header_line_height = WINDOW_HEADER_LINE_HEIGHT (w);
+
+ nx = bar_area_width - sb_width;
+ by = WINDOW_TO_FRAME_PIXEL_Y (w, max (header_line_height,
+ row->y));
+ ny = row->visible_height;
+ }
+ }
+ else
+ {
+ if (bar_area_x + bar_area_width == bx)
+ {
+ bx = bar_area_x + sb_width;
+ nx += bar_area_width - sb_width;
+ }
+ else if (bx + nx == bar_area_x)
+ nx += bar_area_width - sb_width;
+ }
+ }
+ }
+
+ if (bx >= 0 && nx > 0)
+ {
+ NSRect r = NSMakeRect (bx, by, nx, ny);
+ NSRectClip (r);
+ [ns_lookup_indexed_color (face->background, f) set];
+ NSRectFill (r);
+ }
}
if (p->which)
{
- NSRect r = NSMakeRect (p->x+xAdjust, p->y, p->wd, p->h);
- NSPoint pt = r.origin;
+ NSRect r = NSMakeRect (p->x, p->y, p->wd, p->h);
EmacsImage *img = bimgs[p->which - 1];
if (!img)
@@ -2326,7 +2321,7 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
int i;
unsigned char *cbits = xmalloc (len);
- for (i =0; i<len; i++)
+ for (i = 0; i < len; i++)
cbits[i] = ~(bits[i] & 0xff);
img = [[EmacsImage alloc] initFromXBM: cbits width: 8 height: p->h
flip: NO];
@@ -2339,15 +2334,27 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
to erase the whole background. */
[ns_lookup_indexed_color(face->background, f) set];
NSRectFill (r);
- pt.y += p->h;
[img setXBMColor: ns_lookup_indexed_color(face->foreground, f)];
- [img compositeToPoint: pt operation: NSCompositeSourceOver];
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
+ [img drawInRect: r
+ fromRect: NSZeroRect
+ operation: NSCompositeSourceOver
+ fraction: 1.0
+ respectFlipped: YES
+ hints: nil];
+#else
+ {
+ NSPoint pt = r.origin;
+ pt.y += p->h;
+ [img compositeToPoint: pt operation: NSCompositeSourceOver];
+ }
+#endif
}
ns_unfocus (f);
}
-void
+static void
ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
int x, int y, int cursor_type, int cursor_width,
int on_p, int active_p)
@@ -2420,14 +2427,6 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
r.size.height = h;
r.size.width = w->phys_cursor_width;
- /* FIXME: if we overwrite the internal border area, it does not get erased;
- fix by truncating cursor, but better would be to erase properly */
- overspill = r.origin.x + r.size.width -
- WINDOW_TEXT_TO_FRAME_PIXEL_X (w, WINDOW_BOX_RIGHT_EDGE_X (w)
- - WINDOW_TOTAL_FRINGE_WIDTH (w) - FRAME_INTERNAL_BORDER_WIDTH (f));
- if (overspill > 0)
- r.size.width -= overspill;
-
/* TODO: only needed in rare cases with last-resort font in HELLO..
should we do this more efficiently? */
ns_clip_to_row (w, glyph_row, -1, NO); /* do ns_focus(f, &r, 1); if remove */
@@ -2520,12 +2519,12 @@ show_hourglass (struct atimer *timer)
if (hourglass_shown_p)
return;
- BLOCK_INPUT;
+ block_input ();
/* TODO: add NSProgressIndicator to selected frame (see macfns.c) */
hourglass_shown_p = 1;
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -2535,12 +2534,12 @@ hide_hourglass (void)
if (!hourglass_shown_p)
return;
- BLOCK_INPUT;
+ block_input ();
/* TODO: remove NSProgressIndicator from all frames */
hourglass_shown_p = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -2551,31 +2550,6 @@ hide_hourglass (void)
========================================================================== */
-
-static inline NSRect
-ns_fix_rect_ibw (NSRect r, int fibw, int frame_pixel_width)
-/* --------------------------------------------------------------------------
- Under NS we draw internal borders inside fringes, and want full-width
- rendering to go all the way to edge. This function makes that correction.
- -------------------------------------------------------------------------- */
-{
- if (r.origin.y <= fibw+1)
- {
- r.size.height += r.origin.y;
- r.origin.y = 0;
- }
- if (r.origin.x <= fibw+1)
- {
- r.size.width += r.origin.x;
- r.origin.x = 0;
- }
- if (frame_pixel_width - (r.origin.x+r.size.width) <= fibw+1)
- r.size.width += fibw;
-
- return r;
-}
-
-
static int
ns_get_glyph_string_clip_rect (struct glyph_string *s, NativeRectangle *nr)
/* --------------------------------------------------------------------------
@@ -2585,17 +2559,63 @@ ns_get_glyph_string_clip_rect (struct glyph_string *s, NativeRectangle *nr)
-------------------------------------------------------------------------- */
{
int n = get_glyph_string_clip_rects (s, nr, 2);
- if (s->row->full_width_p)
+ return n;
+}
+
+/* --------------------------------------------------------------------
+ Draw a wavy line under glyph string s. The wave fills wave_height
+ pixels from y.
+
+ x wave_length = 3
+ --
+ y * * * * *
+ |* * * * * * * * *
+ wave_height = 3 | * * * *
+ --------------------------------------------------------------------- */
+
+static void
+ns_draw_underwave (struct glyph_string *s, CGFloat width, CGFloat x)
+{
+ int wave_height = 3, wave_length = 3;
+ int y, dx, dy, odd, xmax;
+ NSPoint a, b;
+ NSRect waveClip;
+
+ dx = wave_length;
+ dy = wave_height - 1;
+ y = s->ybase + 1;
+ xmax = x + width;
+
+ /* Find and set clipping rectangle */
+ waveClip = NSMakeRect (x, y, width, wave_height);
+ [[NSGraphicsContext currentContext] saveGraphicsState];
+ NSRectClip (waveClip);
+
+ /* Draw the waves */
+ a.x = x - ((int)(x) % dx);
+ b.x = a.x + dx;
+ odd = (int)(a.x/dx) % 2;
+ a.y = b.y = y;
+
+ if (odd)
+ a.y += dy;
+ else
+ b.y += dy;
+
+ while (a.x <= xmax)
{
- *nr = ns_fix_rect_ibw (*nr, FRAME_INTERNAL_BORDER_WIDTH (s->f),
- FRAME_PIXEL_WIDTH (s->f));
- if (n == 2)
- *nr = ns_fix_rect_ibw (*(nr+1), FRAME_INTERNAL_BORDER_WIDTH (s->f),
- FRAME_PIXEL_WIDTH (s->f));
+ [NSBezierPath strokeLineFromPoint:a toPoint:b];
+ a.x = b.x, a.y = b.y;
+ b.x += dx, b.y = y + odd*dy;
+ odd = !odd;
}
- return n;
+
+ /* Restore previous clipping rectangle(s) */
+ [[NSGraphicsContext currentContext] restoreGraphicsState];
}
+
+
void
ns_draw_text_decoration (struct glyph_string *s, struct face *face,
NSColor *defaultCol, CGFloat width, CGFloat x)
@@ -2609,63 +2629,75 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face,
/* Do underline. */
if (face->underline_p)
{
- NSRect r;
- unsigned long thickness, position;
-
- /* If the prev was underlined, match its appearance. */
- if (s->prev && s->prev->face->underline_p
- && s->prev->underline_thickness > 0)
+ if (s->face->underline_type == FACE_UNDER_WAVE)
{
- thickness = s->prev->underline_thickness;
- position = s->prev->underline_position;
+ if (face->underline_defaulted_p)
+ [defaultCol set];
+ else
+ [ns_lookup_indexed_color (face->underline_color, s->f) set];
+
+ ns_draw_underwave (s, width, x);
}
- else
+ else if (s->face->underline_type == FACE_UNDER_LINE)
{
- struct font *font;
- unsigned long descent;
-
- font=s->font;
- descent = s->y + s->height - s->ybase;
-
- /* Use underline thickness of font, defaulting to 1. */
- thickness = (font && font->underline_thickness > 0)
- ? font->underline_thickness : 1;
-
- /* Determine the offset of underlining from the baseline. */
- if (x_underline_at_descent_line)
- position = descent - thickness;
- else if (x_use_underline_position_properties
- && font && font->underline_position >= 0)
- position = font->underline_position;
- else if (font)
- position = lround (font->descent / 2);
- else
- position = underline_minimum_offset;
- position = max (position, underline_minimum_offset);
+ NSRect r;
+ unsigned long thickness, position;
- /* Ensure underlining is not cropped. */
- if (descent <= position)
+ /* If the prev was underlined, match its appearance. */
+ if (s->prev && s->prev->face->underline_p
+ && s->prev->underline_thickness > 0)
{
- position = descent - 1;
- thickness = 1;
+ thickness = s->prev->underline_thickness;
+ position = s->prev->underline_position;
+ }
+ else
+ {
+ struct font *font;
+ unsigned long descent;
+
+ font=s->font;
+ descent = s->y + s->height - s->ybase;
+
+ /* Use underline thickness of font, defaulting to 1. */
+ thickness = (font && font->underline_thickness > 0)
+ ? font->underline_thickness : 1;
+
+ /* Determine the offset of underlining from the baseline. */
+ if (x_underline_at_descent_line)
+ position = descent - thickness;
+ else if (x_use_underline_position_properties
+ && font && font->underline_position >= 0)
+ position = font->underline_position;
+ else if (font)
+ position = lround (font->descent / 2);
+ else
+ position = underline_minimum_offset;
+
+ position = max (position, underline_minimum_offset);
+
+ /* Ensure underlining is not cropped. */
+ if (descent <= position)
+ {
+ position = descent - 1;
+ thickness = 1;
+ }
+ else if (descent < position + thickness)
+ thickness = 1;
}
- else if (descent < position + thickness)
- thickness = 1;
- }
- s->underline_thickness = thickness;
- s->underline_position = position;
+ s->underline_thickness = thickness;
+ s->underline_position = position;
- r = NSMakeRect (x, s->ybase + position, width, thickness);
+ r = NSMakeRect (x, s->ybase + position, width, thickness);
- if (face->underline_defaulted_p)
- [defaultCol set];
- else
- [ns_lookup_indexed_color (face->underline_color, s->f) set];
- NSRectFill (r);
+ if (face->underline_defaulted_p)
+ [defaultCol set];
+ else
+ [ns_lookup_indexed_color (face->underline_color, s->f) set];
+ NSRectFill (r);
+ }
}
-
/* Do overline. We follow other terms in using a thickness of 1
and ignoring overline_margin. */
if (face->overline_p)
@@ -2851,11 +2883,6 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s)
r = NSMakeRect (s->x, s->y, right_x - s->x + 1, s->height);
- /* expand full-width row over internal borders */
- if (s->row->full_width_p)
- r = ns_fix_rect_ibw (r, FRAME_INTERNAL_BORDER_WIDTH (s->f),
- FRAME_PIXEL_WIDTH (s->f));
-
/* TODO: Sometimes box_color is 0 and this seems wrong; should investigate. */
if (s->face->box == FACE_SIMPLE_BOX && s->face->box_color)
{
@@ -2911,26 +2938,6 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p)
NSRect r = NSMakeRect (s->x, s->y + box_line_width,
s->background_width,
s->height-2*box_line_width);
-
- /* expand full-width row over internal borders */
- if (s->row->full_width_p)
- {
- int fibw = FRAME_INTERNAL_BORDER_WIDTH (s->f);
- if (r.origin.y <= fibw+1 + box_line_width)
- {
- r.size.height += r.origin.y;
- r.origin.y = 0;
- }
- if (r.origin.x <= fibw+1)
- {
- r.size.width += 2*r.origin.x;
- r.origin.x = 0;
- }
- if (FRAME_PIXEL_WIDTH (s->f) - (r.origin.x + r.size.width)
- <= fibw+1)
- r.size.width += fibw;
- }
-
NSRectFill (r);
}
@@ -2996,30 +3003,26 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
br = NSMakeRect (x, y, s->slice.width, s->slice.height);
}
- /* expand full-width row over internal borders */
- if (s->row->full_width_p)
- {
- int fibw = FRAME_INTERNAL_BORDER_WIDTH (s->f);
- if (br.origin.y <= fibw+1 + box_line_vwidth)
- {
- br.size.height += br.origin.y;
- br.origin.y = 0;
- }
- if (br.origin.x <= fibw+1 + box_line_vwidth)
- {
- br.size.width += br.origin.x;
- br.origin.x = 0;
- }
- if (FRAME_PIXEL_WIDTH (s->f) - (br.origin.x + br.size.width) <= fibw+1)
- br.size.width += fibw;
- }
-
NSRectFill (br);
/* Draw the image.. do we need to draw placeholder if img ==nil? */
if (img != nil)
- [img compositeToPoint: NSMakePoint (x, y + s->slice.height)
- operation: NSCompositeSourceOver];
+ {
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
+ NSRect dr = NSMakeRect (x, y, s->slice.width, s->slice.height);
+ NSRect ir = NSMakeRect (s->slice.x, s->slice.y,
+ s->slice.width, s->slice.height);
+ [img drawInRect: dr
+ fromRect: ir
+ operation: NSCompositeSourceOver
+ fraction: 1.0
+ respectFlipped: YES
+ hints: nil];
+#else
+ [img compositeToPoint: NSMakePoint (x, y + s->slice.height)
+ operation: NSCompositeSourceOver];
+#endif
+ }
if (s->hl == DRAW_CURSOR)
{
@@ -3107,7 +3110,7 @@ ns_dumpglyphs_stretch (struct glyph_string *s)
bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f);
fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f);
- for (i=0; i<n; i++)
+ for (i = 0; i < n; ++i)
{
if (!s->row->full_width_p)
{
@@ -3137,13 +3140,6 @@ ns_dumpglyphs_stretch (struct glyph_string *s)
r[i].size.height = min (s->height, s->row->visible_height);
}
- /* expand full-width rows over internal borders */
- else
- {
- r[i] = ns_fix_rect_ibw (r[i], FRAME_INTERNAL_BORDER_WIDTH (s->f),
- FRAME_PIXEL_WIDTH (s->f));
- }
-
[bgCol set];
/* NOTE: under NS this is NOT used to draw cursors, but we must avoid
@@ -3304,7 +3300,7 @@ ns_draw_glyph_string (struct glyph_string *s)
break;
default:
- abort ();
+ emacs_abort ();
}
/* Draw box if not done already. */
@@ -3355,14 +3351,6 @@ ns_send_appdefined (int value)
timed_entry = nil;
}
- /* Ditto for file descriptor poller */
- if (fd_entry)
- {
- [fd_entry invalidate];
- [fd_entry release];
- fd_entry = nil;
- }
-
nxev = [NSEvent otherEventWithType: NSApplicationDefined
location: NSMakePoint (0, 0)
modifierFlags: 0
@@ -3380,10 +3368,8 @@ ns_send_appdefined (int value)
}
}
-
static int
-ns_read_socket (struct terminal *terminal, int expected,
- struct input_event *hold_quit)
+ns_read_socket (struct terminal *terminal, struct input_event *hold_quit)
/* --------------------------------------------------------------------------
External (hook): Post an event to ourself and keep reading events until
we read it back again. In effect process all events which were waiting.
@@ -3395,21 +3381,19 @@ ns_read_socket (struct terminal *terminal, int expected,
/* NSTRACE (ns_read_socket); */
- if (interrupt_input_blocked)
+ if ([NSApp modalWindow] != nil)
+ return -1;
+
+ if (hold_event_q.nr > 0)
{
- interrupt_input_pending = 1;
-#ifdef SYNC_INPUT
- pending_signals = 1;
-#endif
- return -1;
+ int i;
+ for (i = 0; i < hold_event_q.nr; ++i)
+ kbd_buffer_store_event_hold (&hold_event_q.q[i], hold_quit);
+ hold_event_q.nr = 0;
+ return i;
}
- interrupt_input_pending = 0;
-#ifdef SYNC_INPUT
- pending_signals = pending_atimers;
-#endif
-
- BLOCK_INPUT;
+ block_input ();
n_emacs_events_pending = 0;
EVENT_INIT (ev);
emacs_event = &ev;
@@ -3441,30 +3425,20 @@ ns_read_socket (struct terminal *terminal, int expected,
/* Run and wait for events. We must always send one NX_APPDEFINED event
to ourself, otherwise [NXApp run] will never exit. */
send_appdefined = YES;
+ ns_send_appdefined (-1);
- /* If called via ns_select, this is called once with expected=1,
- because we expect either the timeout or file descriptor activity.
- In this case the first event through will either be real input or
- one of these. read_avail_input() then calls once more with expected=0
- and in that case we need to return quickly if there is nothing.
- If we're being called outside of that, it's also OK to return quickly
- after one iteration through the event loop, since other terms do
- this and emacs expects it. */
- if (!(inNsSelect && expected))
+ if (++apploopnr != 1)
{
- /* Post an application defined event on the event queue. When this is
- received the [NXApp run] will return, thus having processed all
- events which are currently queued, if any. */
- ns_send_appdefined (-1);
+ emacs_abort ();
}
-
[NSApp run];
+ --apploopnr;
}
nevents = n_emacs_events_pending;
n_emacs_events_pending = 0;
emacs_event = q_event_ptr = NULL;
- UNBLOCK_INPUT;
+ unblock_input ();
return nevents;
}
@@ -3472,100 +3446,135 @@ ns_read_socket (struct terminal *terminal, int expected,
int
ns_select (int nfds, fd_set *readfds, fd_set *writefds,
- fd_set *exceptfds, struct timeval *timeout)
+ fd_set *exceptfds, EMACS_TIME *timeout, sigset_t *sigmask)
/* --------------------------------------------------------------------------
Replacement for select, checking for events
-------------------------------------------------------------------------- */
{
int result;
- double time;
- NSEvent *ev;
+ int t, k, nr = 0;
+ struct input_event event;
+ char c;
+
/* NSTRACE (ns_select); */
- if (NSApp == nil || inNsSelect == 1 /* || ([NSApp isActive] == NO &&
- [NSApp nextEventMatchingMask:NSAnyEventMask untilDate:nil
- inMode:NSDefaultRunLoopMode dequeue:NO] == nil) */)
- return select (nfds, readfds, writefds, exceptfds, timeout);
+ if (hold_event_q.nr > 0)
+ {
+ /* We already have events pending. */
+ raise (SIGIO);
+ errno = EINTR;
+ return -1;
+ }
+
+ for (k = 0; k < nfds+1; k++)
+ {
+ if (readfds && FD_ISSET(k, readfds)) ++nr;
+ if (writefds && FD_ISSET(k, writefds)) ++nr;
+ }
+
+ if (NSApp == nil
+ || (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0))
+ return pselect (nfds, readfds, writefds, exceptfds, timeout, sigmask);
+
+ [outerpool release];
+ outerpool = [[NSAutoreleasePool alloc] init];
+
- /* Save file descriptor set, which gets overwritten in calls to select ()
- Note, this is called from process.c, and only readfds is ever set */
- if (readfds)
+ send_appdefined = YES;
+ if (nr > 0)
{
- memcpy (&select_readfds, readfds, sizeof (fd_set));
+ pthread_mutex_lock (&select_mutex);
select_nfds = nfds;
+ select_valid = 0;
+ if (readfds)
+ {
+ select_readfds = *readfds;
+ select_valid += SELECT_HAVE_READ;
+ }
+ if (writefds)
+ {
+ select_writefds = *writefds;
+ select_valid += SELECT_HAVE_WRITE;
+ }
+
+ if (timeout)
+ {
+ select_timeout = *timeout;
+ select_valid += SELECT_HAVE_TMO;
+ }
+
+ pthread_mutex_unlock (&select_mutex);
+
+ /* Inform fd_handler that select should be called */
+ c = 'g';
+ emacs_write (selfds[1], &c, 1);
+ }
+ else if (nr == 0 && timeout)
+ {
+ /* No file descriptor, just a timeout, no need to wake fd_handler */
+ double time = EMACS_TIME_TO_DOUBLE (*timeout);
+ timed_entry = [[NSTimer scheduledTimerWithTimeInterval: time
+ target: NSApp
+ selector:
+ @selector (timeout_handler:)
+ userInfo: 0
+ repeats: NO]
+ retain];
+ }
+ else /* No timeout and no file descriptors, can this happen? */
+ {
+ /* Send appdefined so we exit from the loop */
+ ns_send_appdefined (-1);
}
- else
- select_nfds = 0;
-
- /* Try an initial select for pending data on input files */
- select_timeout.tv_sec = select_timeout.tv_usec = 0;
- result = select (nfds, readfds, writefds, exceptfds, &select_timeout);
- if (result)
- return result;
-
- /* if (!timeout || timed_entry || fd_entry)
- fprintf (stderr, "assertion failed: timeout null or timed_entry/fd_entry non-null in ns_select\n"); */
-
- /* set a timeout and run the main AppKit event loop while continuing
- to monitor the files */
- time = ((double) timeout->tv_sec) + ((double) timeout->tv_usec)/1000000.0;
- timed_entry = [[NSTimer scheduledTimerWithTimeInterval: time
- target: NSApp
- selector: @selector (timeout_handler:)
- userInfo: 0
- repeats: YES] /* for safe removal */
- retain];
-
- /* set a periodic task to try the select () again */
- fd_entry = [[NSTimer scheduledTimerWithTimeInterval: 0.1
- target: NSApp
- selector: @selector (fd_handler:)
- userInfo: 0
- repeats: YES]
- retain];
-
- /* Let Application dispatch events until it receives an event of the type
- NX_APPDEFINED, which should only be sent by timeout_handler.
- We tell read_avail_input() that input is "expected" because we do expect
- either the timeout or fd handler to fire, and if they don't, the original
- call from process.c that got us here expects us to wait until some input
- comes. */
- inNsSelect = 1;
- gobble_input (1);
- ev = last_appdefined_event;
- inNsSelect = 0;
-
- if (ev)
- {
- int t;
- if ([ev type] != NSApplicationDefined)
- abort ();
-
- t = [ev data1];
- last_appdefined_event = 0;
+
+ EVENT_INIT (event);
+ block_input ();
+ emacs_event = &event;
+ if (++apploopnr != 1)
+ {
+ emacs_abort ();
+ }
+ [NSApp run];
+ --apploopnr;
+ emacs_event = NULL;
+ if (nr > 0 && readfds)
+ {
+ c = 's';
+ emacs_write (selfds[1], &c, 1);
+ }
+ unblock_input ();
+
+ t = last_appdefined_event_data;
+
+ if (t != NO_APPDEFINED_DATA)
+ {
+ last_appdefined_event_data = NO_APPDEFINED_DATA;
if (t == -2)
{
/* The NX_APPDEFINED event we received was a timeout. */
- return 0;
+ result = 0;
}
else if (t == -1)
{
/* The NX_APPDEFINED event we received was the result of
at least one real input event arriving. */
errno = EINTR;
- return -1;
+ result = -1;
}
else
{
/* Received back from select () in fd_handler; copy the results */
- if (readfds)
- memcpy (readfds, &select_readfds, sizeof (fd_set));
- return t;
+ pthread_mutex_lock (&select_mutex);
+ if (readfds) *readfds = select_readfds;
+ if (writefds) *writefds = select_writefds;
+ if (timeout) *timeout = select_timeout;
+ pthread_mutex_unlock (&select_mutex);
+ result = t;
}
}
- /* never reached, shut compiler up */
- return 0;
+
+ return result;
}
@@ -3589,10 +3598,9 @@ ns_set_vertical_scroll_bar (struct window *window,
struct frame *f = XFRAME (WINDOW_FRAME (window));
EmacsView *view = FRAME_NS_VIEW (f);
int window_y, window_height;
- BOOL barOnVeryLeft, barOnVeryRight;
int top, left, height, width, sb_width, sb_left;
EmacsScroller *bar;
-static int count = 0;
+ BOOL fringe_extended_p;
/* optimization; display engine sends WAY too many of these.. */
if (!NILP (window->vertical_scroll_bar))
@@ -3619,28 +3627,29 @@ static int count = 0;
width = WINDOW_CONFIG_SCROLL_BAR_COLS (window) * FRAME_COLUMN_WIDTH (f);
left = WINDOW_SCROLL_BAR_AREA_X (window);
- if (top < 5) /* top scrollbar adjustment */
- {
- top -= FRAME_INTERNAL_BORDER_WIDTH (f);
- height += FRAME_INTERNAL_BORDER_WIDTH (f);
- }
-
/* allow for displaying a skinnier scrollbar than char area allotted */
sb_width = (WINDOW_CONFIG_SCROLL_BAR_WIDTH (window) > 0) ?
WINDOW_CONFIG_SCROLL_BAR_WIDTH (window) : width;
-
- barOnVeryLeft = left < 5;
- barOnVeryRight = FRAME_PIXEL_WIDTH (f) - left - width < 5;
- sb_left = left + FRAME_INTERNAL_BORDER_WIDTH (f)
- * (barOnVeryLeft ? -1 : (barOnVeryRight ? 1 : 0));
+ sb_left = left;
r = NSMakeRect (sb_left, top, sb_width, height);
/* the parent view is flipped, so we need to flip y value */
v = [view frame];
r.origin.y = (v.size.height - r.size.height - r.origin.y);
+ if (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (window))
+ fringe_extended_p = (WINDOW_LEFTMOST_P (window)
+ && WINDOW_LEFT_FRINGE_WIDTH (window)
+ && (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (window)
+ || WINDOW_LEFT_MARGIN_COLS (window) == 0));
+ else
+ fringe_extended_p = (WINDOW_RIGHTMOST_P (window)
+ && WINDOW_RIGHT_FRINGE_WIDTH (window)
+ && (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (window)
+ || WINDOW_RIGHT_MARGIN_COLS (window) == 0));
+
XSETWINDOW (win, window);
- BLOCK_INPUT;
+ block_input ();
/* we want at least 5 lines to display a scrollbar */
if (WINDOW_TOTAL_LINES (window) < 5)
@@ -3649,18 +3658,25 @@ static int count = 0;
{
bar = XNS_SCROLL_BAR (window->vertical_scroll_bar);
[bar removeFromSuperview];
- window->vertical_scroll_bar = Qnil;
+ wset_vertical_scroll_bar (window, Qnil);
}
ns_clear_frame_area (f, sb_left, top, width, height);
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
if (NILP (window->vertical_scroll_bar))
{
- ns_clear_frame_area (f, sb_left, top, width, height);
+ if (width > 0 && height > 0)
+ {
+ if (fringe_extended_p)
+ ns_clear_frame_area (f, sb_left, top, sb_width, height);
+ else
+ ns_clear_frame_area (f, left, top, width, height);
+ }
+
bar = [[EmacsScroller alloc] initFrame: r window: win];
- window->vertical_scroll_bar = make_save_value (bar, 0);
+ wset_vertical_scroll_bar (window, make_save_value (bar, 0));
}
else
{
@@ -3677,7 +3693,7 @@ static int count = 0;
}
[bar setPosition: position portion: portion whole: whole];
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -3714,7 +3730,7 @@ ns_redeem_scroll_bar (struct window *window)
NSTRACE (ns_redeem_scroll_bar);
if (!NILP (window->vertical_scroll_bar))
{
- bar =XNS_SCROLL_BAR (window->vertical_scroll_bar);
+ bar = XNS_SCROLL_BAR (window->vertical_scroll_bar);
[bar reprieve];
}
}
@@ -3729,14 +3745,21 @@ ns_judge_scroll_bars (struct frame *f)
{
int i;
id view;
- NSArray *subviews = [[FRAME_NS_VIEW (f) superview] subviews];
+ EmacsView *eview = FRAME_NS_VIEW (f);
+ NSArray *subviews = [[eview superview] subviews];
+ BOOL removed = NO;
+
NSTRACE (ns_judge_scroll_bars);
- for (i =[subviews count]-1; i >= 0; i--)
+ for (i = [subviews count]-1; i >= 0; --i)
{
view = [subviews objectAtIndex: i];
if (![view isKindOfClass: [EmacsScroller class]]) continue;
[view judge];
+ removed = YES;
}
+
+ if (removed)
+ [eview updateFrameSize: NO];
}
@@ -3774,43 +3797,23 @@ static Lisp_Object ns_string_to_lispmod (const char *s)
Convert modifier name to lisp symbol
-------------------------------------------------------------------------- */
{
- if (!strncmp (SDATA (SYMBOL_NAME (Qmeta)), s, 10))
+ if (!strncmp (SSDATA (SYMBOL_NAME (Qmeta)), s, 10))
return Qmeta;
- else if (!strncmp (SDATA (SYMBOL_NAME (Qsuper)), s, 10))
+ else if (!strncmp (SSDATA (SYMBOL_NAME (Qsuper)), s, 10))
return Qsuper;
- else if (!strncmp (SDATA (SYMBOL_NAME (Qcontrol)), s, 10))
+ else if (!strncmp (SSDATA (SYMBOL_NAME (Qcontrol)), s, 10))
return Qcontrol;
- else if (!strncmp (SDATA (SYMBOL_NAME (Qalt)), s, 10))
+ else if (!strncmp (SSDATA (SYMBOL_NAME (Qalt)), s, 10))
return Qalt;
- else if (!strncmp (SDATA (SYMBOL_NAME (Qhyper)), s, 10))
+ else if (!strncmp (SSDATA (SYMBOL_NAME (Qhyper)), s, 10))
return Qhyper;
- else if (!strncmp (SDATA (SYMBOL_NAME (Qnone)), s, 10))
+ else if (!strncmp (SSDATA (SYMBOL_NAME (Qnone)), s, 10))
return Qnone;
else
return Qnil;
}
-static Lisp_Object ns_mod_to_lisp (int m)
-/* --------------------------------------------------------------------------
- Convert modifier code (see lisp.h) to lisp symbol
- -------------------------------------------------------------------------- */
-{
- if (m == CHAR_META)
- return Qmeta;
- else if (m == CHAR_SUPER)
- return Qsuper;
- else if (m == CHAR_CTL)
- return Qcontrol;
- else if (m == CHAR_ALT)
- return Qalt;
- else if (m == CHAR_HYPER)
- return Qhyper;
- else /* if (m == 0) */
- return Qnone;
-}
-
-
static void
ns_default (const char *parameter, Lisp_Object *result,
Lisp_Object yesval, Lisp_Object noval,
@@ -3825,9 +3828,9 @@ ns_default (const char *parameter, Lisp_Object *result,
{
double f;
char *pos;
- if (strcasecmp (value, "YES") == 0)
+ if (c_strcasecmp (value, "YES") == 0)
*result = yesval;
- else if (strcasecmp (value, "NO") == 0)
+ else if (c_strcasecmp (value, "NO") == 0)
*result = noval;
else if (is_float && (f = strtod (value, &pos), pos != value))
*result = make_float (f);
@@ -3839,7 +3842,7 @@ ns_default (const char *parameter, Lisp_Object *result,
}
-void
+static void
ns_initialize_display_info (struct ns_display_info *dpyinfo)
/* --------------------------------------------------------------------------
Initialize global info and storage for display.
@@ -3857,13 +3860,11 @@ ns_initialize_display_info (struct ns_display_info *dpyinfo)
NSColorSpaceFromDepth (depth)];
dpyinfo->n_planes = NSBitsPerPixelFromDepth (depth);
dpyinfo->image_cache = make_image_cache ();
- dpyinfo->color_table
- = (struct ns_color_table *)xmalloc (sizeof (struct ns_color_table));
+ dpyinfo->color_table = xmalloc (sizeof *dpyinfo->color_table);
dpyinfo->color_table->colors = NULL;
dpyinfo->root_window = 42; /* a placeholder.. */
hlinfo->mouse_face_mouse_frame = NULL;
- hlinfo->mouse_face_deferred_gc = 0;
hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1;
hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1;
hlinfo->mouse_face_face_id = DEFAULT_FACE_ID;
@@ -3929,18 +3930,17 @@ static void
ns_delete_terminal (struct terminal *terminal)
{
struct ns_display_info *dpyinfo = terminal->display_info.ns;
- int i;
/* Protect against recursive calls. delete_frame in
delete_terminal calls us back when it deletes our last frame. */
if (!terminal->name)
return;
- BLOCK_INPUT;
+ block_input ();
x_destroy_all_bitmaps (dpyinfo);
ns_delete_display (dpyinfo);
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -3977,7 +3977,7 @@ ns_create_terminal (struct ns_display_info *dpyinfo)
terminal->frame_rehighlight_hook = ns_frame_rehighlight;
terminal->frame_raise_lower_hook = ns_frame_raise_lower;
- terminal->fullscreen_hook = 0; /* see XTfullscreen_hook */
+ terminal->fullscreen_hook = ns_fullscreen_hook;
terminal->set_vertical_scroll_bar_hook = ns_set_vertical_scroll_bar;
terminal->condemn_scroll_bars_hook = ns_condemn_scroll_bars;
@@ -4008,25 +4008,41 @@ ns_term_init (Lisp_Object display_name)
static int ns_initialized = 0;
Lisp_Object tmp;
+ if (ns_initialized) return x_display_list;
+ ns_initialized = 1;
+
NSTRACE (ns_term_init);
+ [outerpool release];
+ outerpool = [[NSAutoreleasePool alloc] init];
+
/* count object allocs (About, click icon); on OS X use ObjectAlloc tool */
/*GSDebugAllocationActive (YES); */
- BLOCK_INPUT;
- handling_signal = 0;
+ block_input ();
+
+ baud_rate = 38400;
+ Fset_input_interrupt_mode (Qnil);
- if (!ns_initialized)
+ if (selfds[0] == -1)
{
- baud_rate = 38400;
- Fset_input_interrupt_mode (Qnil);
- ns_initialized = 1;
+ if (pipe (selfds) == -1)
+ {
+ fprintf (stderr, "Failed to create pipe: %s\n",
+ emacs_strerror (errno));
+ emacs_abort ();
+ }
+
+ fcntl (selfds[0], F_SETFL, O_NONBLOCK|fcntl (selfds[0], F_GETFL));
+ FD_ZERO (&select_readfds);
+ FD_ZERO (&select_writefds);
+ pthread_mutex_init (&select_mutex, NULL);
}
ns_pending_files = [[NSMutableArray alloc] init];
ns_pending_service_names = [[NSMutableArray alloc] init];
ns_pending_service_args = [[NSMutableArray alloc] init];
- /* Start app and create the main menu, window, view.
+/* Start app and create the main menu, window, view.
Needs to be here because ns_initialize_display_info () uses AppKit classes.
The view will then ask the NSApp to stop and return to Emacs. */
[EmacsApp sharedApplication];
@@ -4034,20 +4050,24 @@ ns_term_init (Lisp_Object display_name)
return NULL;
[NSApp setDelegate: NSApp];
+ /* Start the select thread. */
+ [NSThread detachNewThreadSelector:@selector (fd_handler:)
+ toTarget:NSApp
+ withObject:nil];
+
/* debugging: log all notifications */
/* [[NSNotificationCenter defaultCenter] addObserver: NSApp
selector: @selector (logNotification:)
name: nil object: nil]; */
- dpyinfo = (struct ns_display_info *)xmalloc (sizeof (struct ns_display_info));
- memset (dpyinfo, 0, sizeof (struct ns_display_info));
+ dpyinfo = xzalloc (sizeof *dpyinfo);
ns_initialize_display_info (dpyinfo);
terminal = ns_create_terminal (dpyinfo);
- terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
+ terminal->kboard = xmalloc (sizeof *terminal->kboard);
init_kboard (terminal->kboard);
- KVAR (terminal->kboard, Vwindow_system) = Qns;
+ kset_window_system (terminal->kboard, Qns);
terminal->kboard->next_kboard = all_kboards;
all_kboards = terminal->kboard;
/* Don't let the initial kboard remain current longer than necessary.
@@ -4065,12 +4085,9 @@ ns_term_init (Lisp_Object display_name)
ns_display_name_list);
dpyinfo->name_list_element = XCAR (ns_display_name_list);
- /* Set the name of the terminal. */
- terminal->name = (char *) xmalloc (SBYTES (display_name) + 1);
- strncpy (terminal->name, SDATA (display_name), SBYTES (display_name));
- terminal->name[SBYTES (display_name)] = 0;
+ terminal->name = xstrdup (SSDATA (display_name));
- UNBLOCK_INPUT;
+ unblock_input ();
if (!inhibit_x_resources)
{
@@ -4094,14 +4111,11 @@ ns_term_init (Lisp_Object display_name)
if ( cl == nil )
{
Lisp_Object color_file, color_map, color;
- int r,g,b;
unsigned long c;
char *name;
color_file = Fexpand_file_name (build_string ("rgb.txt"),
Fsymbol_value (intern ("data-directory")));
- if (NILP (Ffile_readable_p (color_file)))
- fatal ("Could not find %s.\n", SDATA (color_file));
color_map = Fx_load_color_file (color_file);
if (NILP (color_map))
@@ -4111,7 +4125,7 @@ ns_term_init (Lisp_Object display_name)
for ( ; CONSP (color_map); color_map = XCDR (color_map))
{
color = XCAR (color_map);
- name = SDATA (XCAR (color));
+ name = SSDATA (XCAR (color));
c = XINT (XCDR (color));
[cl setColor:
[NSColor colorWithCalibratedRed: RED_FROM_ULONG (c) / 255.0
@@ -4125,14 +4139,14 @@ ns_term_init (Lisp_Object display_name)
}
{
- char c[128];
#ifdef NS_IMPL_GNUSTEP
- strncpy (c, gnustep_base_version, sizeof (c));
+ Vwindow_system_version = build_string (gnustep_base_version);
#else
/*PSnextrelease (128, c); */
- snprintf (c, sizeof (c), "%g", NSAppKitVersionNumber);
+ char c[DBL_BUFSIZE_BOUND];
+ int len = dtoastr (c, sizeof c, 0, 0, NSAppKitVersionNumber);
+ Vwindow_system_version = make_unibyte_string (c, len);
#endif
- Vwindow_system_version = build_string (c);
}
delete_keyboard_wait_descriptor (0);
@@ -4210,8 +4224,27 @@ ns_term_init (Lisp_Object display_name)
}
#endif /* MAC OS X menu setup */
- [NSApp run];
+ /* Register our external input/output types, used for determining
+ applicable services and also drag/drop eligibility. */
+ ns_send_types = [[NSArray arrayWithObjects: NSStringPboardType, nil] retain];
+ ns_return_types = [[NSArray arrayWithObjects: NSStringPboardType, nil]
+ retain];
+ ns_drag_types = [[NSArray arrayWithObjects:
+ NSStringPboardType,
+ NSTabularTextPboardType,
+ NSFilenamesPboardType,
+ NSURLPboardType,
+ NSColorPboardType,
+ NSFontPboardType, nil] retain];
+
+#ifndef NEW_STYLE_FS
+ /* If fullscreen is in init/default-frame-alist, focus isn't set
+ right for fullscreen windows, so set this. */
+ [NSApp activateIgnoringOtherApps:YES];
+#endif
+ [NSApp run];
+ ns_do_open_file = YES;
return dpyinfo;
}
@@ -4223,7 +4256,7 @@ ns_term_shutdown (int sig)
/* code not reached in emacs.c after this is called by shut_down_emacs: */
if (STRINGP (Vauto_save_list_file_name))
- unlink (SDATA (Vauto_save_list_file_name));
+ unlink (SSDATA (Vauto_save_list_file_name));
if (sig == 0 || sig == SIGTERM)
{
@@ -4231,7 +4264,7 @@ ns_term_shutdown (int sig)
}
else // force a stack trace to happen
{
- abort();
+ emacs_abort ();
}
}
@@ -4281,34 +4314,6 @@ ns_term_shutdown (int sig)
return;
}
-#ifdef NS_IMPL_COCOA
- /* pass mouse down in resize handle and subsequent drags directly to
- EmacsWindow so we can generate continuous redisplays */
- if (ns_in_resize)
- {
- if (type == NSLeftMouseDragged)
- {
- [window mouseDragged: theEvent];
- return;
- }
- else if (type == NSLeftMouseUp)
- {
- [window mouseUp: theEvent];
- return;
- }
- }
- else if (type == NSLeftMouseDown)
- {
- NSRect r = ns_resize_handle_rect (window);
- if (NSPointInRect ([theEvent locationInWindow], r))
- {
- ns_in_resize = YES;
- [window mouseDown: theEvent];
- return;
- }
- }
-#endif
-
if (type == NSApplicationDefined)
{
/* Events posted by ns_send_appdefined interrupt the run loop here.
@@ -4317,7 +4322,7 @@ ns_term_shutdown (int sig)
modal loop. Just defer it until later. */
if ([NSApp modalWindow] == nil)
{
- last_appdefined_event = theEvent;
+ last_appdefined_event_data = [theEvent data1];
[self stop: self];
}
else
@@ -4438,7 +4443,7 @@ ns_term_shutdown (int sig)
return NSTerminateNow;
ret = NSRunAlertPanel(ns_app_name,
- [NSString stringWithUTF8String:"Exit requested. Would you like to Save Buffers and Exit, or Cancel the request?"],
+ @"Exit requested. Would you like to Save Buffers and Exit, or Cancel the request?",
@"Save Buffers and Exit", @"Cancel", nil);
if (ret == NSAlertDefaultReturn)
@@ -4448,11 +4453,21 @@ ns_term_shutdown (int sig)
return NSTerminateNow; /* just in case */
}
+static int
+not_in_argv (NSString *arg)
+{
+ int k;
+ const char *a = [arg UTF8String];
+ for (k = 1; k < initial_argc; ++k)
+ if (strcmp (a, initial_argv[k]) == 0) return 0;
+ return 1;
+}
/* Notification from the Workspace to open a file */
- (BOOL)application: sender openFile: (NSString *)file
{
- [ns_pending_files addObject: file];
+ if (ns_do_open_file || not_in_argv (file))
+ [ns_pending_files addObject: file];
return YES;
}
@@ -4460,7 +4475,8 @@ ns_term_shutdown (int sig)
/* Open a file as a temporary file */
- (BOOL)application: sender openTempFile: (NSString *)file
{
- [ns_pending_files addObject: file];
+ if (ns_do_open_file || not_in_argv (file))
+ [ns_pending_files addObject: file];
return YES;
}
@@ -4468,18 +4484,22 @@ ns_term_shutdown (int sig)
/* Notification from the Workspace to open a file noninteractively (?) */
- (BOOL)application: sender openFileWithoutUI: (NSString *)file
{
- [ns_pending_files addObject: file];
+ if (ns_do_open_file || not_in_argv (file))
+ [ns_pending_files addObject: file];
return YES;
}
-
/* Notification from the Workspace to open multiple files */
- (void)application: sender openFiles: (NSArray *)fileList
{
NSEnumerator *files = [fileList objectEnumerator];
NSString *file;
+ /* Don't open files from the command line unconditionally,
+ Cocoa parses the command line wrong, --option value tries to open value
+ if --option is the last option. */
while ((file = [files nextObject]) != nil)
- [ns_pending_files addObject: file];
+ if (ns_do_open_file || not_in_argv (file))
+ [ns_pending_files addObject: file];
[self replyToOpenOrPrint: NSApplicationDelegateReplySuccess];
@@ -4532,26 +4552,92 @@ ns_term_shutdown (int sig)
ns_send_appdefined (-2);
}
-- (void)fd_handler: (NSTimer *) fdEntry
+- (void)fd_handler:(id)unused
/* --------------------------------------------------------------------------
Check data waiting on file descriptors and terminate if so
-------------------------------------------------------------------------- */
{
int result;
- /* NSTRACE (fd_handler); */
+ int waiting = 1, nfds;
+ char c;
- if (select_nfds == 0)
- return;
+ SELECT_TYPE readfds, writefds, *wfds;
+ EMACS_TIME timeout, *tmo;
+ NSAutoreleasePool *pool = nil;
- memcpy (&t_readfds, &select_readfds, sizeof (fd_set));
+ /* NSTRACE (fd_handler); */
- select_timeout.tv_sec = select_timeout.tv_usec = 0;
- result = select (select_nfds, &t_readfds, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
- &select_timeout);
- if (result)
+ for (;;)
{
- memcpy (&select_readfds, &t_readfds, sizeof (fd_set));
- ns_send_appdefined (result);
+ [pool release];
+ pool = [[NSAutoreleasePool alloc] init];
+
+ if (waiting)
+ {
+ SELECT_TYPE fds;
+
+ FD_SET (selfds[0], &fds);
+ result = select (selfds[0]+1, &fds, NULL, NULL, NULL);
+ if (result > 0 && read (selfds[0], &c, 1) == 1 && c == 'g')
+ waiting = 0;
+ }
+ else
+ {
+ pthread_mutex_lock (&select_mutex);
+ nfds = select_nfds;
+
+ if (select_valid & SELECT_HAVE_READ)
+ readfds = select_readfds;
+ else
+ FD_ZERO (&readfds);
+
+ if (select_valid & SELECT_HAVE_WRITE)
+ {
+ writefds = select_writefds;
+ wfds = &writefds;
+ }
+ else
+ wfds = NULL;
+ if (select_valid & SELECT_HAVE_TMO)
+ {
+ timeout = select_timeout;
+ tmo = &timeout;
+ }
+ else
+ tmo = NULL;
+
+ pthread_mutex_unlock (&select_mutex);
+
+ FD_SET (selfds[0], &readfds);
+ if (selfds[0] >= nfds) nfds = selfds[0]+1;
+
+ result = pselect (nfds, &readfds, wfds, NULL, tmo, NULL);
+
+ if (result == 0)
+ ns_send_appdefined (-2);
+ else if (result > 0)
+ {
+ if (FD_ISSET (selfds[0], &readfds))
+ {
+ if (read (selfds[0], &c, 1) == 1 && c == 's')
+ waiting = 1;
+ }
+ else
+ {
+ pthread_mutex_lock (&select_mutex);
+ if (select_valid & SELECT_HAVE_READ)
+ select_readfds = readfds;
+ if (select_valid & SELECT_HAVE_WRITE)
+ select_writefds = writefds;
+ if (select_valid & SELECT_HAVE_TMO)
+ select_timeout = timeout;
+ pthread_mutex_unlock (&select_mutex);
+
+ ns_send_appdefined (result);
+ }
+ }
+ waiting = 1;
+ }
}
}
@@ -4570,7 +4656,7 @@ ns_term_shutdown (int sig)
{
[ns_pending_service_names addObject: userData];
[ns_pending_service_args addObject: [NSString stringWithUTF8String:
- SDATA (ns_string_from_pasteboard (pboard))]];
+ SSDATA (ns_string_from_pasteboard (pboard))]];
}
@@ -4618,6 +4704,8 @@ ns_term_shutdown (int sig)
{
NSTRACE (EmacsView_dealloc);
[toolbar release];
+ if (fs_state == FULLSCREEN_BOTH)
+ [nonfs_window release];
[super dealloc];
}
@@ -4634,8 +4722,8 @@ ns_term_shutdown (int sig)
if (!emacs_event)
return;
- if (newFont = [sender convertFont:
- ((struct nsfont_info *)face->font)->nsfont])
+ if ((newFont = [sender convertFont:
+ ((struct nsfont_info *)face->font)->nsfont]))
{
SET_FRAME_GARBAGED (emacsframe); /* now needed as of 2008/10 */
@@ -4683,12 +4771,12 @@ ns_term_shutdown (int sig)
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (emacsframe);
int code;
unsigned fnKeysym = 0;
- int flags;
static NSMutableArray *nsEvArray;
#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_6
static BOOL firstTime = YES;
#endif
int left_is_none;
+ unsigned int flags = [theEvent modifierFlags];
NSTRACE (keyDown);
@@ -4729,12 +4817,20 @@ ns_term_shutdown (int sig)
if (!processingCompose)
{
+ /* When using screen sharing, no left or right information is sent,
+ so use Left key in those cases. */
+ int is_left_key, is_right_key;
+
code = ([[theEvent charactersIgnoringModifiers] length] == 0) ?
0 : [[theEvent charactersIgnoringModifiers] characterAtIndex: 0];
+
/* (Carbon way: [theEvent keyCode]) */
/* is it a "function key"? */
- fnKeysym = ns_convert_key (code);
+ fnKeysym = (code < 0x00ff && (flags&NSNumericPadKeyMask))
+ ? ns_convert_key ([theEvent keyCode] | NSNumericPadKeyMask)
+ : ns_convert_key (code);
+
if (fnKeysym)
{
/* COUNTERHACK: map 'Delete' on upper-right main KB to 'Backspace',
@@ -4747,7 +4843,6 @@ ns_term_shutdown (int sig)
/* are there modifiers? */
emacs_event->modifiers = 0;
- flags = [theEvent modifierFlags];
if (flags & NSHelpKeyMask)
emacs_event->modifiers |= hyper_modifier;
@@ -4755,13 +4850,17 @@ ns_term_shutdown (int sig)
if (flags & NSShiftKeyMask)
emacs_event->modifiers |= shift_modifier;
- if ((flags & NSRightCommandKeyMask) == NSRightCommandKeyMask)
+ is_right_key = (flags & NSRightCommandKeyMask) == NSRightCommandKeyMask;
+ is_left_key = (flags & NSLeftCommandKeyMask) == NSLeftCommandKeyMask
+ || (! is_right_key && (flags & NSCommandKeyMask) == NSCommandKeyMask);
+
+ if (is_right_key)
emacs_event->modifiers |= parse_solitary_modifier
(EQ (ns_right_command_modifier, Qleft)
? ns_command_modifier
: ns_right_command_modifier);
- if ((flags & NSLeftCommandKeyMask) == NSLeftCommandKeyMask)
+ if (is_left_key)
{
emacs_event->modifiers |= parse_solitary_modifier
(ns_command_modifier);
@@ -4798,13 +4897,17 @@ ns_term_shutdown (int sig)
}
}
- if ((flags & NSRightControlKeyMask) == NSRightControlKeyMask)
+ is_right_key = (flags & NSRightControlKeyMask) == NSRightControlKeyMask;
+ is_left_key = (flags & NSLeftControlKeyMask) == NSLeftControlKeyMask
+ || (! is_right_key && (flags & NSControlKeyMask) == NSControlKeyMask);
+
+ if (is_right_key)
emacs_event->modifiers |= parse_solitary_modifier
(EQ (ns_right_control_modifier, Qleft)
? ns_control_modifier
: ns_right_control_modifier);
- if ((flags & NSLeftControlKeyMask) == NSLeftControlKeyMask)
+ if (is_left_key)
emacs_event->modifiers |= parse_solitary_modifier
(ns_control_modifier);
@@ -4815,7 +4918,13 @@ ns_term_shutdown (int sig)
left_is_none = NILP (ns_alternate_modifier)
|| EQ (ns_alternate_modifier, Qnone);
- if ((flags & NSRightAlternateKeyMask) == NSRightAlternateKeyMask)
+ is_right_key = (flags & NSRightAlternateKeyMask)
+ == NSRightAlternateKeyMask;
+ is_left_key = (flags & NSLeftAlternateKeyMask) == NSLeftAlternateKeyMask
+ || (! is_right_key
+ && (flags & NSAlternateKeyMask) == NSAlternateKeyMask);
+
+ if (is_right_key)
{
if ((NILP (ns_right_alternate_modifier)
|| EQ (ns_right_alternate_modifier, Qnone)
@@ -4835,7 +4944,7 @@ ns_term_shutdown (int sig)
: ns_right_alternate_modifier);
}
- if ((flags & NSLeftAlternateKeyMask) == NSLeftAlternateKeyMask) /* default = meta */
+ if (is_left_key) /* default = meta */
{
if (left_is_none && !fnKeysym)
{ /* accept pre-interp alt comb */
@@ -4946,7 +5055,8 @@ ns_term_shutdown (int sig)
/* TODO: still need this? */
if (code == 0x2DC)
code = '~'; /* 0x7E */
- emacs_event->modifiers = 0;
+ if (code != 32) /* Space */
+ emacs_event->modifiers = 0;
emacs_event->kind
= code > 0xFF ? MULTIBYTE_CHAR_KEYSTROKE_EVENT : ASCII_KEYSTROKE_EVENT;
emacs_event->code = code;
@@ -5049,9 +5159,9 @@ ns_term_shutdown (int sig)
}
-- (long)conversationIdentifier
+- (NSInteger)conversationIdentifier
{
- return (long)self;
+ return (NSInteger)self;
}
@@ -5111,7 +5221,6 @@ ns_term_shutdown (int sig)
- (void)mouseDown: (NSEvent *)theEvent
{
NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil];
- Lisp_Object window;
NSTRACE (mouseDown);
@@ -5275,6 +5384,51 @@ ns_term_shutdown (int sig)
return NO;
}
+- (void) updateFrameSize: (BOOL) delay;
+{
+ NSWindow *window = [self window];
+ NSRect wr = [window frame];
+#ifdef NS_IMPL_GNUSTEP
+ int extra = 3;
+#else
+ int extra = 0;
+#endif
+
+ int oldc = cols, oldr = rows;
+ int oldw = FRAME_PIXEL_WIDTH (emacsframe),
+ oldh = FRAME_PIXEL_HEIGHT (emacsframe);
+ int neww, newh;
+
+ cols = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (emacsframe, wr.size.width + extra);
+
+ if (cols < MINWIDTH)
+ cols = MINWIDTH;
+
+ rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES
+ (emacsframe, wr.size.height
+ - FRAME_NS_TITLEBAR_HEIGHT (emacsframe) + extra
+ - FRAME_TOOLBAR_HEIGHT (emacsframe));
+
+ if (rows < MINHEIGHT)
+ rows = MINHEIGHT;
+
+ neww = (int)wr.size.width - emacsframe->border_width;
+ newh = ((int)wr.size.height
+ - FRAME_NS_TITLEBAR_HEIGHT (emacsframe)
+ - FRAME_TOOLBAR_HEIGHT (emacsframe));
+
+ if (oldr != rows || oldc != cols || neww != oldw || newh != oldh)
+ {
+ NSView *view = FRAME_NS_VIEW (emacsframe);
+ FRAME_PIXEL_WIDTH (emacsframe) = neww;
+ FRAME_PIXEL_HEIGHT (emacsframe) = newh;
+ change_frame_size (emacsframe, rows, cols, 0, delay, 0);
+ SET_FRAME_GARBAGED (emacsframe);
+ cancel_mouse_face (emacsframe);
+ [view setFrame: NSMakeRect (0, 0, neww, newh)];
+ [self windowDidMove:nil]; // Update top/left.
+ }
+}
- (NSSize)windowWillResize: (NSWindow *)sender toSize: (NSSize)frameSize
/* normalize frame to gridded text size */
@@ -5282,6 +5436,19 @@ ns_term_shutdown (int sig)
NSTRACE (windowWillResize);
/*fprintf (stderr,"Window will resize: %.0f x %.0f\n",frameSize.width,frameSize.height); */
+ if (fs_state == FULLSCREEN_MAXIMIZED
+ && (maximized_width != (int)frameSize.width
+ || maximized_height != (int)frameSize.height))
+ [self setFSValue: FULLSCREEN_NONE];
+ else if (fs_state == FULLSCREEN_WIDTH
+ && maximized_width != (int)frameSize.width)
+ [self setFSValue: FULLSCREEN_NONE];
+ else if (fs_state == FULLSCREEN_HEIGHT
+ && maximized_height != (int)frameSize.height)
+ [self setFSValue: FULLSCREEN_NONE];
+ if (fs_state == FULLSCREEN_NONE)
+ maximized_width = maximized_height = -1;
+
cols = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (emacsframe,
#ifdef NS_IMPL_GNUSTEP
frameSize.width + 3);
@@ -5323,8 +5490,7 @@ ns_term_shutdown (int sig)
char *pos = strstr (t, " — ");
if (pos)
*pos = '\0';
- old_title = (char *) xmalloc (strlen (t) + 1);
- strcpy (old_title, t);
+ old_title = xstrdup (t);
}
size_title = xmalloc (strlen (old_title) + 40);
esprintf (size_title, "%s — (%d x %d)", old_title, cols, rows);
@@ -5342,10 +5508,17 @@ ns_term_shutdown (int sig)
- (void)windowDidResize: (NSNotification *)notification
{
+
+#if !defined (NEW_STYLE_FS) && ! defined (NS_IMPL_GNUSTEP)
NSWindow *theWindow = [notification object];
+ /* We can get notification on the non-FS window when in fullscreen mode. */
+ if ([self window] != theWindow) return;
+#endif
#ifdef NS_IMPL_GNUSTEP
- /* in GNUstep, at least currently, it's possible to get a didResize
+ NSWindow *theWindow = [notification object];
+
+ /* In GNUstep, at least currently, it's possible to get a didResize
without getting a willResize.. therefore we need to act as if we got
the willResize now */
NSSize sz = [theWindow frame].size;
@@ -5363,29 +5536,10 @@ ns_term_shutdown (int sig)
}
#endif /* NS_IMPL_COCOA */
- /* Avoid loop under GNUstep due to call at beginning of this function.
- (x_set_window_size causes a resize which causes
- a "windowDidResize" which calls x_set_window_size). */
-#ifndef NS_IMPL_GNUSTEP
if (cols > 0 && rows > 0)
{
- if (ns_in_resize)
- x_set_window_size (emacsframe, 0, cols, rows);
- else
- {
- NSWindow *window = [self window];
- NSRect wr = [window frame];
- FRAME_PIXEL_WIDTH (emacsframe) = (int)wr.size.width
- - emacsframe->border_width;
- FRAME_PIXEL_HEIGHT (emacsframe) = (int)wr.size.height
- - FRAME_NS_TITLEBAR_HEIGHT (emacsframe)
- - FRAME_TOOLBAR_HEIGHT (emacsframe);
- change_frame_size (emacsframe, rows, cols, 0, 0, 1);
- SET_FRAME_GARBAGED (emacsframe);
- cancel_mouse_face (emacsframe);
- }
+ [self updateFrameSize: YES];
}
-#endif
ns_send_appdefined (-1);
}
@@ -5464,7 +5618,6 @@ ns_term_shutdown (int sig)
Lisp_Object tem;
NSWindow *win;
NSButton *toggleButton;
- int vbextra = NS_SCROLL_BAR_WIDTH (f);
NSSize sz;
NSColor *col;
NSString *name;
@@ -5474,6 +5627,10 @@ ns_term_shutdown (int sig)
windowClosing = NO;
processingCompose = NO;
scrollbarsNeedingUpdate = 0;
+ fs_state = FULLSCREEN_NONE;
+ fs_before_fs = next_maximized = -1;
+ maximized_width = maximized_height = -1;
+ nonfs_window = nil;
/*fprintf (stderr,"init with %d, %d\n",f->text_cols, f->text_lines); */
@@ -5498,9 +5655,13 @@ ns_term_shutdown (int sig)
backing: NSBackingStoreBuffered
defer: YES];
+#ifdef NEW_STYLE_FS
+ [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary];
+#endif
+
wr = [win frame];
- f->border_width = wr.size.width - r.size.width;
- FRAME_NS_TITLEBAR_HEIGHT (f) = wr.size.height - r.size.height;
+ bwidth = f->border_width = wr.size.width - r.size.width;
+ tibar_height = FRAME_NS_TITLEBAR_HEIGHT (f) = wr.size.height - r.size.height;
[win setAcceptsMouseMovedEvents: YES];
[win setDelegate: self];
@@ -5517,7 +5678,7 @@ ns_term_shutdown (int sig)
tem = f->name;
name = [NSString stringWithUTF8String:
- NILP (tem) ? (unsigned char *)"Emacs" : SDATA (tem)];
+ NILP (tem) ? "Emacs" : SSDATA (tem)];
[win setTitle: name];
/* toolbar support */
@@ -5536,7 +5697,7 @@ ns_term_shutdown (int sig)
tem = f->icon_name;
if (!NILP (tem))
[win setMiniwindowTitle:
- [NSString stringWithUTF8String: SDATA (tem)]];
+ [NSString stringWithUTF8String: SSDATA (tem)]];
{
NSScreen *screen = [win screen];
@@ -5606,27 +5767,50 @@ ns_term_shutdown (int sig)
NSTRACE (windowWillUseStandardFrame);
- if (abs (defaultFrame.size.height - result.size.height)
- > FRAME_LINE_HEIGHT (emacsframe))
+ if (fs_before_fs != -1) /* Entering fullscreen */
+ {
+ result = defaultFrame;
+ }
+ else if (next_maximized == FULLSCREEN_HEIGHT
+ || (next_maximized == -1
+ && abs (defaultFrame.size.height - result.size.height)
+ > FRAME_LINE_HEIGHT (emacsframe)))
{
/* first click */
ns_userRect = result;
- result.size.height = defaultFrame.size.height;
+ maximized_height = result.size.height = defaultFrame.size.height;
+ maximized_width = -1;
result.origin.y = defaultFrame.origin.y;
+ [self setFSValue: FULLSCREEN_HEIGHT];
+ }
+ else if (next_maximized == FULLSCREEN_WIDTH)
+ {
+ ns_userRect = result;
+ maximized_width = result.size.width = defaultFrame.size.width;
+ maximized_height = -1;
+ result.origin.x = defaultFrame.origin.x;
+ [self setFSValue: FULLSCREEN_WIDTH];
+ }
+ else if (next_maximized == FULLSCREEN_MAXIMIZED
+ || (next_maximized == -1
+ && abs (defaultFrame.size.width - result.size.width)
+ > FRAME_COLUMN_WIDTH (emacsframe)))
+ {
+ result = defaultFrame; /* second click */
+ maximized_width = result.size.width;
+ maximized_height = result.size.height;
+ [self setFSValue: FULLSCREEN_MAXIMIZED];
}
else
{
- if (abs (defaultFrame.size.width - result.size.width)
- > FRAME_COLUMN_WIDTH (emacsframe))
- result = defaultFrame; /* second click */
- else
- {
- /* restore */
- result = ns_userRect.size.height ? ns_userRect : result;
- ns_userRect = NSMakeRect (0, 0, 0, 0);
- }
+ /* restore */
+ result = ns_userRect.size.height ? ns_userRect : result;
+ ns_userRect = NSMakeRect (0, 0, 0, 0);
+ [self setFSValue: FULLSCREEN_NONE];
+ maximized_width = maximized_width = -1;
}
+ if (fs_before_fs == -1) next_maximized = -1;
[self windowWillResize: sender toSize: result.size];
return result;
}
@@ -5678,21 +5862,221 @@ ns_term_shutdown (int sig)
}
}
+- (void)windowWillEnterFullScreen:(NSNotification *)notification
+{
+ fs_before_fs = fs_state;
+}
+
+- (void)windowDidEnterFullScreen:(NSNotification *)notification
+{
+ [self setFSValue: FULLSCREEN_BOTH];
+#ifdef NEW_STYLE_FS
+ // Fix bad background.
+ if ([toolbar isVisible])
+ {
+ [toolbar setVisible:NO];
+ [toolbar setVisible:YES];
+ }
+#else
+ [self windowDidBecomeKey:notification];
+ [nonfs_window orderOut:self];
+#endif
+}
+
+- (void)windowWillExitFullScreen:(NSNotification *)notification
+{
+ if (next_maximized != -1)
+ fs_before_fs = next_maximized;
+}
+
+- (void)windowDidExitFullScreen:(NSNotification *)notification
+{
+ [self setFSValue: fs_before_fs];
+ fs_before_fs = -1;
+ if (next_maximized != -1)
+ [[self window] performZoom:self];
+}
+
+- (void)toggleFullScreen: (id)sender
+{
+#ifdef NEW_STYLE_FS
+ [[self window] toggleFullScreen:sender];
+#else
+ NSWindow *w = [self window], *fw;
+ BOOL onFirstScreen = [[w screen]
+ isEqual:[[NSScreen screens] objectAtIndex:0]];
+ struct frame *f = emacsframe;
+ NSSize sz;
+ NSRect r, wr = [w frame];
+ NSColor *col = ns_lookup_indexed_color (NS_FACE_BACKGROUND
+ (FRAME_DEFAULT_FACE (f)),
+ f);
+
+ sz.width = FRAME_COLUMN_WIDTH (f);
+ sz.height = FRAME_LINE_HEIGHT (f);
+
+ if (fs_state != FULLSCREEN_BOTH)
+ {
+ /* Hide dock and menubar if we are on the primary screen. */
+ if (onFirstScreen)
+ {
+#if defined (NS_IMPL_COCOA) && \
+ MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
+ NSApplicationPresentationOptions options
+ = NSApplicationPresentationAutoHideDock
+ | NSApplicationPresentationAutoHideMenuBar;
+
+ [NSApp setPresentationOptions: options];
+#else
+ [NSMenu setMenuBarVisible:NO];
+#endif
+ }
+
+ fw = [[EmacsFSWindow alloc]
+ initWithContentRect:[w contentRectForFrameRect:wr]
+ styleMask:NSBorderlessWindowMask
+ backing:NSBackingStoreBuffered
+ defer:YES
+ screen:[w screen]];
+
+ [fw setContentView:[w contentView]];
+ [fw setTitle:[w title]];
+ [fw setDelegate:self];
+ [fw setAcceptsMouseMovedEvents: YES];
+ [fw useOptimizedDrawing: YES];
+ [fw setResizeIncrements: sz];
+ [fw setBackgroundColor: col];
+ if ([col alphaComponent] != 1.0)
+ [fw setOpaque: NO];
+
+ f->border_width = 0;
+ FRAME_NS_TITLEBAR_HEIGHT (f) = 0;
+ tobar_height = FRAME_TOOLBAR_HEIGHT (f);
+ FRAME_TOOLBAR_HEIGHT (f) = 0;
+ FRAME_EXTERNAL_TOOL_BAR (f) = 0;
+
+ nonfs_window = w;
+
+ [self windowWillEnterFullScreen:nil];
+ [fw makeKeyAndOrderFront:NSApp];
+ [fw makeFirstResponder:self];
+ [w orderOut:self];
+ r = [fw frameRectForContentRect:[[fw screen] frame]];
+ [fw setFrame: r display:YES animate:YES];
+ [self windowDidEnterFullScreen:nil];
+ [fw display];
+ }
+ else
+ {
+ fw = w;
+ w = nonfs_window;
+ nonfs_window = nil;
+
+ if (onFirstScreen)
+ {
+#if defined (NS_IMPL_COCOA) && \
+ MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
+ [NSApp setPresentationOptions: NSApplicationPresentationDefault];
+#else
+ [NSMenu setMenuBarVisible:YES];
+#endif
+ }
+
+ [w setContentView:[fw contentView]];
+ [w setResizeIncrements: sz];
+ [w setBackgroundColor: col];
+ if ([col alphaComponent] != 1.0)
+ [w setOpaque: NO];
+
+ f->border_width = bwidth;
+ FRAME_NS_TITLEBAR_HEIGHT (f) = tibar_height;
+ FRAME_TOOLBAR_HEIGHT (f) = tobar_height;
+ if (tobar_height)
+ FRAME_EXTERNAL_TOOL_BAR (f) = 1;
+
+ [self windowWillExitFullScreen:nil];
+ [fw setFrame: [w frame] display:YES animate:YES];
+ [fw close];
+ [w makeKeyAndOrderFront:NSApp];
+ [self windowDidExitFullScreen:nil];
+ }
+#endif
+}
+
+- (void)handleFS
+{
+ if (fs_state != emacsframe->want_fullscreen)
+ {
+ if (fs_state == FULLSCREEN_BOTH)
+ {
+ [self toggleFullScreen:self];
+ }
+
+ switch (emacsframe->want_fullscreen)
+ {
+ case FULLSCREEN_BOTH:
+ [self toggleFullScreen:self];
+ break;
+ case FULLSCREEN_WIDTH:
+ next_maximized = FULLSCREEN_WIDTH;
+ if (fs_state != FULLSCREEN_BOTH)
+ [[self window] performZoom:self];
+ break;
+ case FULLSCREEN_HEIGHT:
+ next_maximized = FULLSCREEN_HEIGHT;
+ if (fs_state != FULLSCREEN_BOTH)
+ [[self window] performZoom:self];
+ break;
+ case FULLSCREEN_MAXIMIZED:
+ next_maximized = FULLSCREEN_MAXIMIZED;
+ if (fs_state != FULLSCREEN_BOTH)
+ [[self window] performZoom:self];
+ break;
+ case FULLSCREEN_NONE:
+ if (fs_state != FULLSCREEN_BOTH)
+ {
+ next_maximized = FULLSCREEN_NONE;
+ [[self window] performZoom:self];
+ }
+ break;
+ }
+
+ emacsframe->want_fullscreen = FULLSCREEN_NONE;
+ }
+
+}
+
+- (void) setFSValue: (int)value
+{
+ Lisp_Object lval = Qnil;
+ switch (value)
+ {
+ case FULLSCREEN_BOTH:
+ lval = Qfullboth;
+ break;
+ case FULLSCREEN_WIDTH:
+ lval = Qfullwidth;
+ break;
+ case FULLSCREEN_HEIGHT:
+ lval = Qfullheight;
+ break;
+ case FULLSCREEN_MAXIMIZED:
+ lval = Qmaximized;
+ break;
+ }
+ store_frame_param (emacsframe, Qfullscreen, lval);
+ fs_state = value;
+}
- (void)mouseEntered: (NSEvent *)theEvent
{
- NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil];
- struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (emacsframe);
NSTRACE (mouseEntered);
-
last_mouse_movement_time = EV_TIMESTAMP (theEvent);
}
- (void)mouseExited: (NSEvent *)theEvent
{
- NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil];
- NSRect r;
Mouse_HLInfo *hlinfo = emacsframe ? MOUSE_HL_INFO (emacsframe) : NULL;
NSTRACE (mouseExited);
@@ -5716,9 +6100,13 @@ ns_term_shutdown (int sig)
if (context_menu_value == -1)
context_menu_value = [sender tag];
else
- find_and_call_menu_selection (emacsframe, emacsframe->menu_bar_items_used,
- emacsframe->menu_bar_vector,
- (void *)[sender tag]);
+ {
+ NSInteger tag = [sender tag];
+ find_and_call_menu_selection (emacsframe, emacsframe->menu_bar_items_used,
+ emacsframe->menu_bar_vector,
+ (void *)tag);
+ }
+
ns_send_appdefined (-1);
return self;
}
@@ -5750,7 +6138,7 @@ ns_term_shutdown (int sig)
emacs_event->kind = TOOL_BAR_EVENT;
/* XSETINT (emacs_event->code, 0); */
emacs_event->arg = AREF (emacsframe->tool_bar_items,
- idx + TOOL_BAR_ITEM_KEY);
+ idx + TOOL_BAR_ITEM_KEY);
emacs_event->modifiers = EV_MODIFIERS (theEvent);
EV_TRAILER (theEvent);
return self;
@@ -5776,7 +6164,7 @@ ns_term_shutdown (int sig)
NSTRACE (drawRect);
- if (!emacsframe || !emacsframe->output_data.ns || ns_in_resize)
+ if (!emacsframe || !emacsframe->output_data.ns)
return;
ns_clear_frame_area (emacsframe, x, y, width, height);
@@ -6032,15 +6420,79 @@ ns_term_shutdown (int sig)
@implementation EmacsWindow
+#ifdef NS_IMPL_COCOA
+- (id)accessibilityAttributeValue:(NSString *)attribute
+{
+ Lisp_Object str = Qnil;
+ struct frame *f = SELECTED_FRAME ();
+ struct buffer *curbuf = XBUFFER (XWINDOW (f->selected_window)->buffer);
+
+ if ([attribute isEqualToString:NSAccessibilityRoleAttribute])
+ return NSAccessibilityTextFieldRole;
+
+ if ([attribute isEqualToString:NSAccessibilitySelectedTextAttribute]
+ && curbuf && ! NILP (BVAR (curbuf, mark_active)))
+ {
+ str = ns_get_local_selection (QPRIMARY, QUTF8_STRING);
+ }
+ else if (curbuf && [attribute isEqualToString:NSAccessibilityValueAttribute])
+ {
+ if (! NILP (BVAR (curbuf, mark_active)))
+ str = ns_get_local_selection (QPRIMARY, QUTF8_STRING);
+
+ if (NILP (str))
+ {
+ ptrdiff_t start_byte = BUF_BEGV_BYTE (curbuf);
+ ptrdiff_t byte_range = BUF_ZV_BYTE (curbuf) - start_byte;
+ ptrdiff_t range = BUF_ZV (curbuf) - BUF_BEGV (curbuf);
+
+ if (! NILP (BVAR (curbuf, enable_multibyte_characters)))
+ str = make_uninit_multibyte_string (range, byte_range);
+ else
+ str = make_uninit_string (range);
+ /* To check: This returns emacs-utf-8, which is a superset of utf-8.
+ Is this a problem? */
+ memcpy (SDATA (str), BYTE_POS_ADDR (start_byte), byte_range);
+ }
+ }
+
+
+ if (! NILP (str))
+ {
+ if (CONSP (str) && SYMBOLP (XCAR (str)))
+ {
+ str = XCDR (str);
+ if (CONSP (str) && NILP (XCDR (str)))
+ str = XCAR (str);
+ }
+ if (STRINGP (str))
+ {
+ const char *utfStr = SSDATA (str);
+ NSString *nsStr = [NSString stringWithUTF8String: utfStr];
+ return nsStr;
+ }
+ }
+
+ return [super accessibilityAttributeValue:attribute];
+}
+#endif /* NS_IMPL_COCOA */
+
/* If we have multiple monitors, one above the other, we don't want to
restrict the height to just one monitor. So we override this. */
- (NSRect)constrainFrameRect:(NSRect)frameRect toScreen:(NSScreen *)screen
{
- /* When making the frame visible for the first time, we want to
- constrain. Other times not. */
+ /* When making the frame visible for the first time or if there is just
+ one screen, we want to constrain. Other times not. */
+ NSUInteger nr_screens = [[NSScreen screens] count];
struct frame *f = ((EmacsView *)[self delegate])->emacsframe;
NSTRACE (constrainFrameRect);
+ if (nr_screens == 1)
+ {
+ NSRect r = [super constrainFrameRect:frameRect toScreen:screen];
+ return r;
+ }
+
if (f->output_data.ns->dont_constrain
|| ns_menu_bar_should_be_hidden ())
return frameRect;
@@ -6049,62 +6501,22 @@ ns_term_shutdown (int sig)
return [super constrainFrameRect:frameRect toScreen:screen];
}
+@end /* EmacsWindow */
-/* called only on resize clicks by special case in EmacsApp-sendEvent */
-- (void)mouseDown: (NSEvent *)theEvent
-{
- if (ns_in_resize)
- {
- NSSize size = [[theEvent window] frame].size;
- grabOffset = [theEvent locationInWindow];
- grabOffset.x = size.width - grabOffset.x;
- }
- else
- [super mouseDown: theEvent];
-}
+@implementation EmacsFSWindow
-/* stop resizing */
-- (void)mouseUp: (NSEvent *)theEvent
+- (BOOL)canBecomeKeyWindow
{
- if (ns_in_resize)
- {
- struct frame *f = ((EmacsView *)[self delegate])->emacsframe;
- ns_in_resize = NO;
- ns_set_name_as_filename (f);
- [self display];
- ns_send_appdefined (-1);
- }
- else
- [super mouseUp: theEvent];
+ return YES;
}
-
-/* send resize events */
-- (void)mouseDragged: (NSEvent *)theEvent
+- (BOOL)canBecomeMainWindow
{
- if (ns_in_resize)
- {
- NSPoint p = [theEvent locationInWindow];
- NSSize size, vettedSize, origSize = [self frame].size;
-
- size.width = p.x + grabOffset.x;
- size.height = origSize.height - p.y + grabOffset.y;
-
- if (size.width == origSize.width && size.height == origSize.height)
- return;
-
- vettedSize = [[self delegate] windowWillResize: self toSize: size];
- [[NSNotificationCenter defaultCenter]
- postNotificationName: NSWindowDidResizeNotification
- object: self];
- }
- else
- [super mouseDragged: theEvent];
+ return YES;
}
-@end /* EmacsWindow */
-
+@end
/* ==========================================================================
@@ -6176,13 +6588,13 @@ ns_term_shutdown (int sig)
- (void)setFrame: (NSRect)newRect
{
NSTRACE (EmacsScroller_setFrame);
-/* BLOCK_INPUT; */
+/* block_input (); */
pixel_height = NSHeight (newRect);
if (pixel_height == 0) pixel_height = 1;
min_portion = 20 / pixel_height;
[super setFrame: newRect];
[self display];
-/* UNBLOCK_INPUT; */
+/* unblock_input (); */
}
@@ -6190,7 +6602,7 @@ ns_term_shutdown (int sig)
{
NSTRACE (EmacsScroller_dealloc);
if (!NILP (win))
- XWINDOW (win)->vertical_scroll_bar = Qnil;
+ wset_vertical_scroll_bar (XWINDOW (win), Qnil);
[super dealloc];
}
@@ -6217,14 +6629,14 @@ ns_term_shutdown (int sig)
if (condemned)
{
EmacsView *view;
- BLOCK_INPUT;
+ block_input ();
/* ensure other scrollbar updates after deletion */
view = (EmacsView *)FRAME_NS_VIEW (frame);
if (view != nil)
view->scrollbarsNeedingUpdate++;
[self removeFromSuperview];
[self release];
- UNBLOCK_INPUT;
+ unblock_input ();
}
return self;
}
@@ -6279,6 +6691,12 @@ ns_term_shutdown (int sig)
[self setFloatValue: pos knobProportion: por];
#endif
}
+
+ /* Events may come here even if the event loop is not running.
+ If we don't enter the event loop, the scroll bar will not update.
+ So send SIGIO to ourselves. */
+ if (apploopnr == 0) raise (SIGIO);
+
return self;
}
@@ -6313,8 +6731,13 @@ ns_term_shutdown (int sig)
XSETINT (emacs_event->x, loc * pixel_height);
XSETINT (emacs_event->y, pixel_height-20);
- n_emacs_events_pending++;
- kbd_buffer_store_event_hold (emacs_event, q_event_ptr);
+ if (q_event_ptr)
+ {
+ n_emacs_events_pending++;
+ kbd_buffer_store_event_hold (emacs_event, q_event_ptr);
+ }
+ else
+ hold_event (emacs_event);
EVENT_INIT (*emacs_event);
ns_send_appdefined (-1);
}
@@ -6584,20 +7007,20 @@ ns_xlfd_to_fontname (const char *xlfd)
/* undo hack in ns_fontname_to_xlfd, converting '$' to '-', '_' to ' '
also uppercase after '-' or ' ' */
- name[0] = toupper (name[0]);
+ name[0] = c_toupper (name[0]);
for (len =strlen (name), i =0; i<len; i++)
{
if (name[i] == '$')
{
name[i] = '-';
if (i+1<len)
- name[i+1] = toupper (name[i+1]);
+ name[i+1] = c_toupper (name[i+1]);
}
else if (name[i] == '_')
{
name[i] = ' ';
if (i+1<len)
- name[i+1] = toupper (name[i+1]);
+ name[i+1] = c_toupper (name[i+1]);
}
}
/*fprintf (stderr, "converted '%s' to '%s'\n",xlfd,name); */
@@ -6621,7 +7044,6 @@ syms_of_nsterm (void)
DEFSYM (Qmeta, "meta");
DEFSYM (Qsuper, "super");
DEFSYM (Qcontrol, "control");
- DEFSYM (Qnone, "none");
DEFSYM (QUTF8_STRING, "UTF8_STRING");
Fput (Qalt, Qmodifier_value, make_number (alt_modifier));
@@ -6715,7 +7137,7 @@ allowing it to be used at a lower level for accented character entry.");
ns_function_modifier = Qnone;
DEFVAR_LISP ("ns-antialias-text", ns_antialias_text,
- "Non-nil (the default) means to render text antialiased. Only has an effect on OS X Panther and above.");
+ "Non-nil (the default) means to render text antialiased.");
ns_antialias_text = Qt;
DEFVAR_LISP ("ns-confirm-quit", ns_confirm_quit,
@@ -6735,12 +7157,12 @@ Only works on OSX 10.6 or later. */);
/* TODO: move to common code */
DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars,
- doc: /* If not nil, Emacs uses toolkit scroll bars. */);
-#ifdef USE_TOOLKIT_SCROLL_BARS
+ doc: /* Which toolkit scroll bars Emacs uses, if any.
+A value of nil means Emacs doesn't use toolkit scroll bars.
+With the X Window system, the value is a symbol describing the
+X toolkit. Possible values are: gtk, motif, xaw, or xaw3d.
+With MS Windows or Nextstep, the value is t. */);
Vx_toolkit_scroll_bars = Qt;
-#else
- Vx_toolkit_scroll_bars = Qnil;
-#endif
DEFVAR_BOOL ("x-use-underline-position-properties",
x_use_underline_position_properties,
diff --git a/src/print.c b/src/print.c
index 8e4a38c4ae9..bf86be5622e 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1,6 +1,6 @@
/* Lisp object printing and output streams.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2011
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,10 +21,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "keyboard.h"
#include "frame.h"
@@ -45,20 +45,14 @@ static Lisp_Object Qtemp_buffer_setup_hook;
static Lisp_Object Qfloat_output_format;
-#include <math.h>
#include <float.h>
#include <ftoastr.h>
-/* Default to values appropriate for IEEE floating point. */
-#ifndef DBL_DIG
-#define DBL_DIG 15
-#endif
-
/* Avoid actual stack overflow in print. */
-static int print_depth;
+static ptrdiff_t print_depth;
/* Level of nesting inside outputting backquote in new style. */
-static int new_backquote_output;
+static ptrdiff_t new_backquote_output;
/* Detect most circularities to print finite output. */
#define PRINT_CIRCLE 200
@@ -69,11 +63,11 @@ static Lisp_Object being_printed[PRINT_CIRCLE];
static char *print_buffer;
/* Size allocated in print_buffer. */
-static EMACS_INT print_buffer_size;
+static ptrdiff_t print_buffer_size;
/* Chars stored in print_buffer. */
-static EMACS_INT print_buffer_pos;
+static ptrdiff_t print_buffer_pos;
/* Bytes stored in print_buffer. */
-static EMACS_INT print_buffer_pos_byte;
+static ptrdiff_t print_buffer_pos_byte;
Lisp_Object Qprint_escape_newlines;
static Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii;
@@ -86,27 +80,27 @@ static Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii;
N the object has been printed so we can refer to it as #N#.
print_number_index holds the largest N already used.
N has to be striclty larger than 0 since we need to distinguish -N. */
-static int print_number_index;
+static ptrdiff_t print_number_index;
static void print_interval (INTERVAL interval, Lisp_Object printcharfun);
/* GDB resets this to zero on W32 to disable OutputDebugString calls. */
int print_output_debug_flag EXTERNALLY_VISIBLE = 1;
-/* Low level output routines for characters and strings */
+/* Low level output routines for characters and strings. */
/* Lisp functions to do output using a stream
must have the stream in a variable called printcharfun
and must start with PRINTPREPARE, end with PRINTFINISH,
and use PRINTDECLARE to declare common variables.
Use PRINTCHAR to output one character,
- or call strout to output a block of characters. */
+ or call strout to output a block of characters. */
#define PRINTDECLARE \
struct buffer *old = current_buffer; \
- EMACS_INT old_point = -1, start_point = -1; \
- EMACS_INT old_point_byte = -1, start_point_byte = -1; \
- int specpdl_count = SPECPDL_INDEX (); \
+ ptrdiff_t old_point = -1, start_point = -1; \
+ ptrdiff_t old_point_byte = -1, start_point_byte = -1; \
+ ptrdiff_t specpdl_count = SPECPDL_INDEX (); \
int free_print_buffer = 0; \
int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \
Lisp_Object original
@@ -122,7 +116,7 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1;
} \
if (MARKERP (printcharfun)) \
{ \
- EMACS_INT marker_pos; \
+ ptrdiff_t marker_pos; \
if (! XMARKER (printcharfun)->buffer) \
error ("Marker does not point anywhere"); \
if (XMARKER (printcharfun)->buffer != current_buffer) \
@@ -156,8 +150,8 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1;
} \
else \
{ \
- ptrdiff_t new_size = 1000; \
- print_buffer = (char *) xmalloc (new_size); \
+ int new_size = 1000; \
+ print_buffer = xmalloc (new_size); \
print_buffer_size = new_size; \
free_print_buffer = 1; \
} \
@@ -173,8 +167,7 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1;
if (print_buffer_pos != print_buffer_pos_byte \
&& NILP (BVAR (current_buffer, enable_multibyte_characters))) \
{ \
- unsigned char *temp \
- = (unsigned char *) alloca (print_buffer_pos + 1); \
+ unsigned char *temp = alloca (print_buffer_pos + 1); \
copy_text ((unsigned char *) print_buffer, temp, \
print_buffer_pos_byte, 1, 0); \
insert_1_both ((char *) temp, print_buffer_pos, \
@@ -198,8 +191,7 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1;
? PT - start_point : 0), \
old_point_byte + (old_point_byte >= start_point_byte \
? PT_BYTE - start_point_byte : 0)); \
- if (old != current_buffer) \
- set_buffer_internal (old);
+ set_buffer_internal (old);
#define PRINTCHAR(ch) printchar (ch, printcharfun)
@@ -233,15 +225,10 @@ printchar (unsigned int ch, Lisp_Object fun)
if (NILP (fun))
{
- if (print_buffer_size - len <= print_buffer_pos_byte)
- {
- ptrdiff_t new_size;
- if (STRING_BYTES_BOUND / 2 < print_buffer_size)
- string_overflow ();
- new_size = print_buffer_size * 2;
- print_buffer = (char *) xrealloc (print_buffer, new_size);
- print_buffer_size = new_size;
- }
+ ptrdiff_t incr = len - (print_buffer_size - print_buffer_pos_byte);
+ if (0 < incr)
+ print_buffer =
+ xpalloc (print_buffer, &print_buffer_size, incr, -1, 1);
memcpy (print_buffer + print_buffer_pos_byte, str, len);
print_buffer_pos += 1;
print_buffer_pos_byte += len;
@@ -276,7 +263,7 @@ printchar (unsigned int ch, Lisp_Object fun)
to data in a Lisp string. Otherwise that is not safe. */
static void
-strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte,
+strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
Lisp_Object printcharfun)
{
if (size < 0)
@@ -284,15 +271,9 @@ strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte,
if (NILP (printcharfun))
{
- if (print_buffer_size - size_byte < print_buffer_pos_byte)
- {
- ptrdiff_t new_size;
- if (STRING_BYTES_BOUND / 2 - size_byte < print_buffer_size)
- string_overflow ();
- new_size = print_buffer_size * 2 + size_byte;
- print_buffer = (char *) xrealloc (print_buffer, new_size);
- print_buffer_size = new_size;
- }
+ ptrdiff_t incr = size_byte - (print_buffer_size - print_buffer_pos_byte);
+ if (0 < incr)
+ print_buffer = xpalloc (print_buffer, &print_buffer_size, incr, -1, 1);
memcpy (print_buffer + print_buffer_pos_byte, ptr, size_byte);
print_buffer_pos += size;
print_buffer_pos_byte += size_byte;
@@ -333,7 +314,7 @@ strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte,
else
{
/* PRINTCHARFUN is a Lisp function. */
- EMACS_INT i = 0;
+ ptrdiff_t i = 0;
if (size == size_byte)
{
@@ -369,7 +350,7 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
{
if (EQ (printcharfun, Qt) || NILP (printcharfun))
{
- EMACS_INT chars;
+ ptrdiff_t chars;
if (print_escape_nonascii)
string = string_escape_byte8 (string);
@@ -385,7 +366,7 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
convert STRING to a multibyte string containing the same
character codes. */
Lisp_Object newstr;
- EMACS_INT bytes;
+ ptrdiff_t bytes;
chars = SBYTES (string);
bytes = count_size_as_multibyte (SDATA (string), chars);
@@ -403,17 +384,15 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
if (EQ (printcharfun, Qt))
{
/* Output to echo area. */
- EMACS_INT nbytes = SBYTES (string);
- char *buffer;
+ ptrdiff_t nbytes = SBYTES (string);
/* Copy the string contents so that relocation of STRING by
GC does not cause trouble. */
USE_SAFE_ALLOCA;
-
- SAFE_ALLOCA (buffer, char *, nbytes);
+ char *buffer = SAFE_ALLOCA (nbytes);
memcpy (buffer, SDATA (string), nbytes);
- strout (buffer, chars, SBYTES (string), printcharfun);
+ strout (buffer, chars, nbytes, printcharfun);
SAFE_FREE ();
}
@@ -425,9 +404,9 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
{
/* Otherwise, string may be relocated by printing one char.
So re-fetch the string address for each character. */
- EMACS_INT i;
- EMACS_INT size = SCHARS (string);
- EMACS_INT size_byte = SBYTES (string);
+ ptrdiff_t i;
+ ptrdiff_t size = SCHARS (string);
+ ptrdiff_t size_byte = SBYTES (string);
struct gcpro gcpro1;
GCPRO1 (string);
if (size == size_byte)
@@ -498,24 +477,24 @@ write_string_1 (const char *data, int size, Lisp_Object printcharfun)
void
temp_output_buffer_setup (const char *bufname)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
register struct buffer *old = current_buffer;
register Lisp_Object buf;
- record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (Fget_buffer_create (build_string (bufname)));
Fkill_all_local_variables ();
delete_all_overlays (current_buffer);
- BVAR (current_buffer, directory) = BVAR (old, directory);
- BVAR (current_buffer, read_only) = Qnil;
- BVAR (current_buffer, filename) = Qnil;
- BVAR (current_buffer, undo_list) = Qt;
+ bset_directory (current_buffer, BVAR (old, directory));
+ bset_read_only (current_buffer, Qnil);
+ bset_filename (current_buffer, Qnil);
+ bset_undo_list (current_buffer, Qt);
eassert (current_buffer->overlays_before == NULL);
eassert (current_buffer->overlays_after == NULL);
- BVAR (current_buffer, enable_multibyte_characters)
- = BVAR (&buffer_defaults, enable_multibyte_characters);
+ bset_enable_multibyte_characters
+ (current_buffer, BVAR (&buffer_defaults, enable_multibyte_characters));
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Ferase_buffer ();
@@ -600,9 +579,10 @@ A printed representation of an object is text which describes that object. */)
(Lisp_Object object, Lisp_Object noescape)
{
Lisp_Object printcharfun;
+ bool prev_abort_on_gc;
/* struct gcpro gcpro1, gcpro2; */
Lisp_Object save_deactivate_mark;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct buffer *previous;
specbind (Qinhibit_modification_hooks, Qt);
@@ -615,7 +595,8 @@ A printed representation of an object is text which describes that object. */)
No need for specbind, since errors deactivate the mark. */
save_deactivate_mark = Vdeactivate_mark;
/* GCPRO2 (object, save_deactivate_mark); */
- abort_on_gc++;
+ prev_abort_on_gc = abort_on_gc;
+ abort_on_gc = 1;
printcharfun = Vprin1_to_string_buffer;
PRINTPREPARE;
@@ -639,7 +620,7 @@ A printed representation of an object is text which describes that object. */)
Vdeactivate_mark = save_deactivate_mark;
/* UNGCPRO; */
- abort_on_gc--;
+ abort_on_gc = prev_abort_on_gc;
return unbind_to (count, object);
}
@@ -728,7 +709,7 @@ to make it write to the debugging output. */)
(Lisp_Object character)
{
CHECK_NUMBER (character);
- putc ((int) XINT (character), stderr);
+ putc (XINT (character) & 0xFF, stderr);
#ifdef WINDOWSNT
/* Send the output to a debugger (nothing happens if there isn't one). */
@@ -772,9 +753,9 @@ append to existing target file. */)
{
if (initial_stderr_stream != NULL)
{
- BLOCK_INPUT;
+ block_input ();
fclose (stderr);
- UNBLOCK_INPUT;
+ unblock_input ();
}
stderr = initial_stderr_stream;
initial_stderr_stream = NULL;
@@ -817,7 +798,7 @@ safe_debug_print (Lisp_Object arg)
else
fprintf (stderr, "#<%s_LISP_OBJECT 0x%08"pI"x>\r\n",
!valid ? "INVALID" : "SOME",
- XHASH (arg));
+ XLI (arg));
}
@@ -865,7 +846,6 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
{
Lisp_Object errname, errmsg, file_error, tail;
struct gcpro gcpro1;
- int i;
if (context != 0)
write_string_1 (context, -1, stream);
@@ -875,10 +855,13 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
if (!NILP (caller) && SYMBOLP (caller))
{
Lisp_Object cname = SYMBOL_NAME (caller);
- char *name = alloca (SBYTES (cname));
- memcpy (name, SDATA (cname), SBYTES (cname));
- message_dolog (name, SBYTES (cname), 0, 0);
+ ptrdiff_t cnamelen = SBYTES (cname);
+ USE_SAFE_ALLOCA;
+ char *name = SAFE_ALLOCA (cnamelen);
+ memcpy (name, SDATA (cname), cnamelen);
+ message_dolog (name, cnamelen, 0, 0);
message_dolog (": ", 2, 0, 0);
+ SAFE_FREE ();
}
errname = Fcar (data);
@@ -893,9 +876,8 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
}
else
{
- Lisp_Object error_conditions;
+ Lisp_Object error_conditions = Fget (errname, Qerror_conditions);
errmsg = Fget (errname, Qerror_message);
- error_conditions = Fget (errname, Qerror_conditions);
file_error = Fmemq (Qfile_error, error_conditions);
}
@@ -909,22 +891,30 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
if (!NILP (file_error) && CONSP (tail))
errmsg = XCAR (tail), tail = XCDR (tail);
- if (STRINGP (errmsg))
- Fprinc (errmsg, stream);
- else
- write_string_1 ("peculiar error", -1, stream);
+ {
+ const char *sep = ": ";
- for (i = 0; CONSP (tail); tail = XCDR (tail), i = 1)
- {
- Lisp_Object obj;
+ if (!STRINGP (errmsg))
+ write_string_1 ("peculiar error", -1, stream);
+ else if (SCHARS (errmsg))
+ Fprinc (errmsg, stream);
+ else
+ sep = NULL;
- write_string_1 (i ? ", " : ": ", 2, stream);
- obj = XCAR (tail);
- if (!NILP (file_error) || EQ (errname, Qend_of_file))
- Fprinc (obj, stream);
- else
- Fprin1 (obj, stream);
- }
+ for (; CONSP (tail); tail = XCDR (tail), sep = ", ")
+ {
+ Lisp_Object obj;
+
+ if (sep)
+ write_string_1 (sep, 2, stream);
+ obj = XCAR (tail);
+ if (!NILP (file_error)
+ || EQ (errname, Qend_of_file) || EQ (errname, Quser_error))
+ Fprinc (obj, stream);
+ else
+ Fprin1 (obj, stream);
+ }
+ }
UNGCPRO;
}
@@ -946,43 +936,49 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
* Given the above, the buffer must be least FLOAT_TO_STRING_BUFSIZE bytes.
*/
-void
+int
float_to_string (char *buf, double data)
{
char *cp;
int width;
+ int len;
/* Check for plus infinity in a way that won't lose
if there is no plus infinity. */
if (data == data / 2 && data > 1.0)
{
- strcpy (buf, "1.0e+INF");
- return;
+ static char const infinity_string[] = "1.0e+INF";
+ strcpy (buf, infinity_string);
+ return sizeof infinity_string - 1;
}
/* Likewise for minus infinity. */
if (data == data / 2 && data < -1.0)
{
- strcpy (buf, "-1.0e+INF");
- return;
+ static char const minus_infinity_string[] = "-1.0e+INF";
+ strcpy (buf, minus_infinity_string);
+ return sizeof minus_infinity_string - 1;
}
/* Check for NaN in a way that won't fail if there are no NaNs. */
if (! (data * 0.0 >= 0.0))
{
/* Prepend "-" if the NaN's sign bit is negative.
The sign bit of a double is the bit that is 1 in -0.0. */
+ static char const NaN_string[] = "0.0e+NaN";
int i;
union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
+ int negative = 0;
u_data.d = data;
u_minus_zero.d = - 0.0;
for (i = 0; i < sizeof (double); i++)
if (u_data.c[i] & u_minus_zero.c[i])
{
- *buf++ = '-';
+ *buf = '-';
+ negative = 1;
break;
}
- strcpy (buf, "0.0e+NaN");
- return;
+ strcpy (buf + negative, NaN_string);
+ return negative + sizeof NaN_string - 1;
}
if (NILP (Vfloat_output_format)
@@ -991,7 +987,7 @@ float_to_string (char *buf, double data)
{
/* Generate the fewest number of digits that represent the
floating point value without losing information. */
- dtoastr (buf, FLOAT_TO_STRING_BUFSIZE - 2, 0, 0, data);
+ len = dtoastr (buf, FLOAT_TO_STRING_BUFSIZE - 2, 0, 0, data);
/* The decimal point must be printed, or the byte compiler can
get confused (Bug#8033). */
width = 1;
@@ -1034,7 +1030,7 @@ float_to_string (char *buf, double data)
if (cp[1] != 0)
goto lose;
- sprintf (buf, SSDATA (Vfloat_output_format), data);
+ len = sprintf (buf, SSDATA (Vfloat_output_format), data);
}
/* Make sure there is a decimal point with digit after, or an
@@ -1051,14 +1047,18 @@ float_to_string (char *buf, double data)
{
cp[1] = '0';
cp[2] = 0;
+ len++;
}
else if (*cp == 0)
{
*cp++ = '.';
*cp++ = '0';
*cp++ = 0;
+ len += 2;
}
}
+
+ return len;
}
@@ -1088,11 +1088,9 @@ print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
if (HASH_TABLE_P (Vprint_number_table))
{ /* Remove unnecessary objects, which appear only once in OBJ;
- that is, whose status is Qt.
- Maybe a better way to do that is to copy elements to
- a new hash table. */
+ that is, whose status is Qt. */
struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table);
- EMACS_INT i;
+ ptrdiff_t i;
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
if (!NILP (HASH_HASH (h, i))
@@ -1126,19 +1124,19 @@ static void
print_preprocess (Lisp_Object obj)
{
int i;
- EMACS_INT size;
+ ptrdiff_t size;
int loop_count = 0;
Lisp_Object halftail;
- /* Give up if we go so deep that print_object will get an error. */
- /* See similar code in print_object. */
- if (print_depth >= PRINT_CIRCLE)
- error ("Apparently circular structure being printed");
-
/* Avoid infinite recursion for circular nested structure
in the case where Vprint_circle is nil. */
if (NILP (Vprint_circle))
{
+ /* Give up if we go so deep that print_object will get an error. */
+ /* See similar code in print_object. */
+ if (print_depth >= PRINT_CIRCLE)
+ error ("Apparently circular structure being printed");
+
for (i = 0; i < print_depth; i++)
if (EQ (obj, being_printed[i]))
return;
@@ -1191,7 +1189,7 @@ print_preprocess (Lisp_Object obj)
{
case Lisp_String:
/* A string may have text properties, which can be circular. */
- traverse_intervals_noorder (STRING_INTERVALS (obj),
+ traverse_intervals_noorder (string_intervals (obj),
print_preprocess_string, Qnil);
break;
@@ -1212,7 +1210,7 @@ print_preprocess (Lisp_Object obj)
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
for (i = 0; i < size; i++)
- print_preprocess (XVECTOR (obj)->contents[i]);
+ print_preprocess (AREF (obj, i));
if (HASH_TABLE_P (obj))
{ /* For hash tables, the key_and_value slot is past
`size' because it needs to be marked specially in case
@@ -1240,7 +1238,7 @@ static void print_check_string_charset_prop (INTERVAL interval, Lisp_Object stri
#define PRINT_STRING_NON_CHARSET_FOUND 1
#define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
-/* Bitwise or of the above macros. */
+/* Bitwise or of the above macros. */
static int print_check_string_result;
static void
@@ -1269,8 +1267,8 @@ print_check_string_charset_prop (INTERVAL interval, Lisp_Object string)
|| ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
{
int i, c;
- EMACS_INT charpos = interval->position;
- EMACS_INT bytepos = string_char_to_byte (string, charpos);
+ ptrdiff_t charpos = interval->position;
+ ptrdiff_t bytepos = string_char_to_byte (string, charpos);
Lisp_Object charset;
charset = XCAR (XCDR (val));
@@ -1294,7 +1292,7 @@ static Lisp_Object
print_prune_string_charset (Lisp_Object string)
{
print_check_string_result = 0;
- traverse_intervals (STRING_INTERVALS (string), 0,
+ traverse_intervals (string_intervals (string), 0,
print_check_string_charset_prop, string);
if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
{
@@ -1323,48 +1321,46 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
QUIT;
- /* See similar code in print_preprocess. */
- if (print_depth >= PRINT_CIRCLE)
- error ("Apparently circular structure being printed");
-
/* Detect circularities and truncate them. */
- if (PRINT_CIRCLE_CANDIDATE_P (obj))
+ if (NILP (Vprint_circle))
{
- if (NILP (Vprint_circle) && NILP (Vprint_gensym))
- {
- /* Simple but incomplete way. */
- int i;
- for (i = 0; i < print_depth; i++)
- if (EQ (obj, being_printed[i]))
- {
- sprintf (buf, "#%d", i);
- strout (buf, -1, -1, printcharfun);
- return;
- }
- being_printed[print_depth] = obj;
- }
- else
+ /* Simple but incomplete way. */
+ int i;
+
+ /* See similar code in print_preprocess. */
+ if (print_depth >= PRINT_CIRCLE)
+ error ("Apparently circular structure being printed");
+
+ for (i = 0; i < print_depth; i++)
+ if (EQ (obj, being_printed[i]))
+ {
+ int len = sprintf (buf, "#%d", i);
+ strout (buf, len, len, printcharfun);
+ return;
+ }
+ being_printed[print_depth] = obj;
+ }
+ else if (PRINT_CIRCLE_CANDIDATE_P (obj))
+ {
+ /* With the print-circle feature. */
+ Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
+ if (INTEGERP (num))
{
- /* With the print-circle feature. */
- Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
- if (INTEGERP (num))
+ EMACS_INT n = XINT (num);
+ if (n < 0)
+ { /* Add a prefix #n= if OBJ has not yet been printed;
+ that is, its status field is nil. */
+ int len = sprintf (buf, "#%"pI"d=", -n);
+ strout (buf, len, len, printcharfun);
+ /* OBJ is going to be printed. Remember that fact. */
+ Fputhash (obj, make_number (- n), Vprint_number_table);
+ }
+ else
{
- EMACS_INT n = XINT (num);
- if (n < 0)
- { /* Add a prefix #n= if OBJ has not yet been printed;
- that is, its status field is nil. */
- sprintf (buf, "#%"pI"d=", -n);
- strout (buf, -1, -1, printcharfun);
- /* OBJ is going to be printed. Remember that fact. */
- Fputhash (obj, make_number (- n), Vprint_number_table);
- }
- else
- {
- /* Just print #n# if OBJ has already been printed. */
- sprintf (buf, "#%"pI"d#", n);
- strout (buf, -1, -1, printcharfun);
- return;
- }
+ /* Just print #n# if OBJ has already been printed. */
+ int len = sprintf (buf, "#%"pI"d#", n);
+ strout (buf, len, len, printcharfun);
+ return;
}
}
}
@@ -1374,16 +1370,17 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
switch (XTYPE (obj))
{
case_Lisp_Int:
- sprintf (buf, "%"pI"d", XINT (obj));
- strout (buf, -1, -1, printcharfun);
+ {
+ int len = sprintf (buf, "%"pI"d", XINT (obj));
+ strout (buf, len, len, printcharfun);
+ }
break;
case Lisp_Float:
{
char pigbuf[FLOAT_TO_STRING_BUFSIZE];
-
- float_to_string (pigbuf, XFLOAT_DATA (obj));
- strout (pigbuf, -1, -1, printcharfun);
+ int len = float_to_string (pigbuf, XFLOAT_DATA (obj));
+ strout (pigbuf, len, len, printcharfun);
}
break;
@@ -1392,10 +1389,10 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
print_string (obj, printcharfun);
else
{
- register EMACS_INT i_byte;
+ register ptrdiff_t i_byte;
struct gcpro gcpro1;
unsigned char *str;
- EMACS_INT size_byte;
+ ptrdiff_t size_byte;
/* 1 means we must ensure that the next character we output
cannot be taken as part of a hex character escape. */
int need_nonhex = 0;
@@ -1406,7 +1403,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
if (! EQ (Vprint_charset_text_property, Qt))
obj = print_prune_string_charset (obj);
- if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
+ if (string_intervals (obj))
{
PRINTCHAR ('#');
PRINTCHAR ('(');
@@ -1453,15 +1450,16 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
when found in a multibyte string, always use a hex escape
so it reads back as multibyte. */
char outbuf[50];
+ int len;
if (CHAR_BYTE8_P (c))
- sprintf (outbuf, "\\%03o", CHAR_TO_BYTE8 (c));
+ len = sprintf (outbuf, "\\%03o", CHAR_TO_BYTE8 (c));
else
{
- sprintf (outbuf, "\\x%04x", c);
+ len = sprintf (outbuf, "\\x%04x", c);
need_nonhex = 1;
}
- strout (outbuf, -1, -1, printcharfun);
+ strout (outbuf, len, len, printcharfun);
}
else if (! multibyte
&& SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
@@ -1472,8 +1470,8 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
print single-byte non-ASCII string chars
using octal escapes. */
char outbuf[5];
- sprintf (outbuf, "\\%03o", c);
- strout (outbuf, -1, -1, printcharfun);
+ int len = sprintf (outbuf, "\\%03o", c);
+ strout (outbuf, len, len, printcharfun);
}
else
{
@@ -1496,9 +1494,9 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
}
PRINTCHAR ('\"');
- if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
+ if (string_intervals (obj))
{
- traverse_intervals (STRING_INTERVALS (obj),
+ traverse_intervals (string_intervals (obj),
0, print_interval, printcharfun);
PRINTCHAR (')');
}
@@ -1513,8 +1511,8 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
register unsigned char *p = SDATA (SYMBOL_NAME (obj));
register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
register int c;
- int i, i_byte;
- EMACS_INT size_byte;
+ ptrdiff_t i, i_byte;
+ ptrdiff_t size_byte;
Lisp_Object name;
name = SYMBOL_NAME (obj);
@@ -1638,8 +1636,8 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
/* Simple but incomplete way. */
if (i != 0 && EQ (obj, halftail))
{
- sprintf (buf, " . #%"pMd, i / 2);
- strout (buf, -1, -1, printcharfun);
+ int len = sprintf (buf, " . #%"pMd, i / 2);
+ strout (buf, len, len, printcharfun);
goto end_of_list;
}
}
@@ -1703,9 +1701,10 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
else if (BOOL_VECTOR_P (obj))
{
ptrdiff_t i;
- register unsigned char c;
+ int len;
+ unsigned char c;
struct gcpro gcpro1;
- EMACS_INT size_in_chars
+ ptrdiff_t size_in_chars
= ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
/ BOOL_VECTOR_BITS_PER_CHAR);
@@ -1713,8 +1712,8 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
PRINTCHAR ('#');
PRINTCHAR ('&');
- sprintf (buf, "%"pI"d", XBOOL_VECTOR (obj)->size);
- strout (buf, -1, -1, printcharfun);
+ len = sprintf (buf, "%"pI"d", XBOOL_VECTOR (obj)->size);
+ strout (buf, len, len, printcharfun);
PRINTCHAR ('\"');
/* Don't print more characters than the specified maximum.
@@ -1765,22 +1764,25 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
}
else if (WINDOWP (obj))
{
+ int len;
strout ("#<window ", -1, -1, printcharfun);
- sprintf (buf, "%"pI"d", XFASTINT (XWINDOW (obj)->sequence_number));
- strout (buf, -1, -1, printcharfun);
+ len = sprintf (buf, "%d", XWINDOW (obj)->sequence_number);
+ strout (buf, len, len, printcharfun);
if (!NILP (XWINDOW (obj)->buffer))
{
strout (" on ", -1, -1, printcharfun);
- print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun);
+ print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name),
+ printcharfun);
}
PRINTCHAR ('>');
}
else if (TERMINALP (obj))
{
+ int len;
struct terminal *t = XTERMINAL (obj);
strout ("#<terminal ", -1, -1, printcharfun);
- sprintf (buf, "%d", t->id);
- strout (buf, -1, -1, printcharfun);
+ len = sprintf (buf, "%d", t->id);
+ strout (buf, len, len, printcharfun);
if (t->name)
{
strout (" on ", -1, -1, printcharfun);
@@ -1791,8 +1793,9 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
else if (HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
- int i;
- EMACS_INT real_size, size;
+ ptrdiff_t i;
+ ptrdiff_t real_size, size;
+ int len;
#if 0
strout ("#<hash-table", -1, -1, printcharfun);
if (SYMBOLP (h->test))
@@ -1803,23 +1806,23 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
PRINTCHAR (' ');
strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun);
PRINTCHAR (' ');
- sprintf (buf, "%"pI"d/%"pI"d", h->count, ASIZE (h->next));
- strout (buf, -1, -1, printcharfun);
+ len = sprintf (buf, "%"pD"d/%"pD"d", h->count, ASIZE (h->next));
+ strout (buf, len, len, printcharfun);
}
- sprintf (buf, " %p", h);
- strout (buf, -1, -1, printcharfun);
+ len = sprintf (buf, " %p", h);
+ strout (buf, len, len, printcharfun);
PRINTCHAR ('>');
#endif
/* Implement a readable output, e.g.:
#s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
- /* Always print the size. */
- sprintf (buf, "#s(hash-table size %"pI"d", ASIZE (h->next));
- strout (buf, -1, -1, printcharfun);
+ /* Always print the size. */
+ len = sprintf (buf, "#s(hash-table size %"pD"d", ASIZE (h->next));
+ strout (buf, len, len, printcharfun);
- if (!NILP (h->test))
+ if (!NILP (h->test.name))
{
strout (" test ", -1, -1, printcharfun);
- print_object (h->test, printcharfun, escapeflag);
+ print_object (h->test.name, printcharfun, escapeflag);
}
if (!NILP (h->weak))
@@ -1870,7 +1873,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
}
else if (BUFFERP (obj))
{
- if (NILP (BVAR (XBUFFER (obj), name)))
+ if (!BUFFER_LIVE_P (XBUFFER (obj)))
strout ("#<killed buffer>", -1, -1, printcharfun);
else if (escapeflag)
{
@@ -1887,17 +1890,29 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
}
else if (FRAMEP (obj))
{
+ int len;
+ Lisp_Object frame_name = XFRAME (obj)->name;
+
strout ((FRAME_LIVE_P (XFRAME (obj))
? "#<frame " : "#<dead frame "),
-1, -1, printcharfun);
- print_string (XFRAME (obj)->name, printcharfun);
- sprintf (buf, " %p", XFRAME (obj));
- strout (buf, -1, -1, printcharfun);
+ if (!STRINGP (frame_name))
+ {
+ /* A frame could be too young and have no name yet;
+ don't crash. */
+ if (SYMBOLP (frame_name))
+ frame_name = Fsymbol_name (frame_name);
+ else /* can't happen: name should be either nil or string */
+ frame_name = build_string ("*INVALID*FRAME*NAME*");
+ }
+ print_string (frame_name, printcharfun);
+ len = sprintf (buf, " %p", XFRAME (obj));
+ strout (buf, len, len, printcharfun);
PRINTCHAR ('>');
}
else if (FONTP (obj))
{
- EMACS_INT i;
+ int i;
if (! FONT_OBJECT_P (obj))
{
@@ -1925,7 +1940,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
}
else
{
- EMACS_INT size = ASIZE (obj);
+ ptrdiff_t size = ASIZE (obj);
if (COMPILEDP (obj))
{
PRINTCHAR ('#');
@@ -1956,7 +1971,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
{
register int i;
register Lisp_Object tem;
- EMACS_INT real_size = size;
+ ptrdiff_t real_size = size;
/* Don't print more elements than the specified maximum. */
if (NATNUMP (Vprint_length)
@@ -1966,7 +1981,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
for (i = 0; i < size; i++)
{
if (i) PRINTCHAR (' ');
- tem = XVECTOR (obj)->contents[i];
+ tem = AREF (obj, i);
print_object (tem, printcharfun, escapeflag);
}
if (size < real_size)
@@ -1988,8 +2003,8 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
strout ("in no buffer", -1, -1, printcharfun);
else
{
- sprintf (buf, "at %"pI"d", marker_position (obj));
- strout (buf, -1, -1, printcharfun);
+ int len = sprintf (buf, "at %"pD"d", marker_position (obj));
+ strout (buf, len, len, printcharfun);
strout (" in ", -1, -1, printcharfun);
print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun);
}
@@ -2002,10 +2017,10 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
strout ("in no buffer", -1, -1, printcharfun);
else
{
- sprintf (buf, "from %"pI"d to %"pI"d in ",
- marker_position (OVERLAY_START (obj)),
- marker_position (OVERLAY_END (obj)));
- strout (buf, -1, -1, printcharfun);
+ int len = sprintf (buf, "from %"pD"d to %"pD"d in ",
+ marker_position (OVERLAY_START (obj)),
+ marker_position (OVERLAY_END (obj)));
+ strout (buf, len, len, printcharfun);
print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name),
printcharfun);
}
@@ -2020,10 +2035,12 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
case Lisp_Misc_Save_Value:
strout ("#<save_value ", -1, -1, printcharfun);
- sprintf (buf, "ptr=%p int=%"pD"d",
- XSAVE_VALUE (obj)->pointer,
- XSAVE_VALUE (obj)->integer);
- strout (buf, -1, -1, printcharfun);
+ {
+ int len = sprintf (buf, "ptr=%p int=%"pD"d",
+ XSAVE_VALUE (obj)->pointer,
+ XSAVE_VALUE (obj)->integer);
+ strout (buf, len, len, printcharfun);
+ }
PRINTCHAR ('>');
break;
@@ -2035,16 +2052,17 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
default:
badtype:
{
+ int len;
/* We're in trouble if this happens!
- Probably should just abort () */
+ Probably should just emacs_abort (). */
strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun);
if (MISCP (obj))
- sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
+ len = sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
else if (VECTORLIKEP (obj))
- sprintf (buf, "(PVEC 0x%08"pI"x)", ASIZE (obj));
+ len = sprintf (buf, "(PVEC 0x%08"pD"x)", ASIZE (obj));
else
- sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
- strout (buf, -1, -1, printcharfun);
+ len = sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
+ strout (buf, len, len, printcharfun);
strout (" Save your buffers immediately and please report this bug>",
-1, -1, printcharfun);
}
@@ -2057,7 +2075,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
/* Print a description of INTERVAL using PRINTCHARFUN.
This is part of printing a string that has text properties. */
-void
+static void
print_interval (INTERVAL interval, Lisp_Object printcharfun)
{
if (NILP (interval->plist))
@@ -2149,7 +2167,7 @@ shared once again when the text is read back. */);
Vprint_gensym = Qnil;
DEFVAR_LISP ("print-circle", Vprint_circle,
- doc: /* *Non-nil means print recursive structures using #N= and #N# syntax.
+ doc: /* Non-nil means print recursive structures using #N= and #N# syntax.
If nil, printing proceeds recursively and may lead to
`max-lisp-eval-depth' being exceeded or an error may occur:
\"Apparently circular structure being printed.\" Also see
@@ -2161,7 +2179,7 @@ where N is a positive decimal integer. */);
Vprint_circle = Qnil;
DEFVAR_LISP ("print-continuous-numbering", Vprint_continuous_numbering,
- doc: /* *Non-nil means number continuously across print calls.
+ doc: /* Non-nil means number continuously across print calls.
This affects the numbers printed for #N= labels and #M# references.
See also `print-circle', `print-gensym', and `print-number-table'.
This variable should not be set with `setq'; bind it with a `let' instead. */);
diff --git a/src/process.c b/src/process.c
index 4b0f90b58af..0036ce595f5 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1,6 +1,6 @@
/* Asynchronous subprocess control for GNU Emacs.
-Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2011
+Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -20,15 +20,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <signal.h>
+
+#define PROCESS_INLINE EXTERN_INLINE
+
#include <stdio.h>
#include <errno.h>
-#include <setjmp.h>
#include <sys/types.h> /* Some typedefs are used in sys/file.h. */
#include <sys/file.h>
#include <sys/stat.h>
-#include <setjmp.h>
-
#include <unistd.h>
#include <fcntl.h>
@@ -73,6 +72,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <bsdtty.h>
#endif
+#ifdef USG5_4
+# include <sys/stream.h>
+# include <sys/stropts.h>
+#endif
+
#ifdef HAVE_RES_INIT
#include <netinet/in.h>
#include <arpa/nameser.h>
@@ -93,8 +97,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "systty.h"
#include "window.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "coding.h"
#include "process.h"
#include "frame.h"
@@ -113,11 +117,24 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "gnutls.h"
#endif
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
+
#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
#include "xgselect.h"
#endif
-#ifdef HAVE_NS
-#include "nsterm.h"
+
+#ifdef WINDOWSNT
+extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
+ EMACS_TIME *, void *);
+#endif
+
+/* Work around GCC 4.7.0 bug with strict overflow checking; see
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
+ These lines can be removed once the GCC bug is fixed. */
+#if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic ignored "-Wstrict-overflow"
#endif
Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid;
@@ -154,30 +171,20 @@ static Lisp_Object QClocal, QCremote, QCcoding;
static Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
static Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
static Lisp_Object Qlast_nonmenu_event;
-/* QCfamily is declared and initialized in xfaces.c,
- QCfilter in keyboard.c. */
-extern Lisp_Object QCfamily, QCfilter;
-
-/* Qexit is declared and initialized in eval.c. */
-
-/* QCfamily is defined in xfaces.c. */
-extern Lisp_Object QCfamily;
-/* QCfilter is defined in keyboard.c. */
-extern Lisp_Object QCfilter;
#define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
-#define NETCONN1_P(p) (EQ ((p)->type, Qnetwork))
+#define NETCONN1_P(p) (EQ (p->type, Qnetwork))
#define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
-#define SERIALCONN1_P(p) (EQ ((p)->type, Qserial))
+#define SERIALCONN1_P(p) (EQ (p->type, Qserial))
#ifndef HAVE_H_ERRNO
extern int h_errno;
#endif
/* Number of events of change of status of a process. */
-static int process_tick;
+static EMACS_INT process_tick;
/* Number of events for which the user or sentinel has been notified. */
-static int update_tick;
+static EMACS_INT update_tick;
/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
@@ -189,11 +196,9 @@ static int update_tick;
#ifndef NON_BLOCKING_CONNECT
#ifdef HAVE_SELECT
#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
-#if defined (O_NONBLOCK) || defined (O_NDELAY)
#if defined (EWOULDBLOCK) || defined (EINPROGRESS)
#define NON_BLOCKING_CONNECT
#endif /* EWOULDBLOCK || EINPROGRESS */
-#endif /* O_NONBLOCK || O_NDELAY */
#endif /* HAVE_GETPEERNAME || GNU_LINUX */
#endif /* HAVE_SELECT */
#endif /* NON_BLOCKING_CONNECT */
@@ -204,30 +209,24 @@ static int update_tick;
"non-destructive" select. So we require either native select,
or emulation of select using FIONREAD. */
-#ifdef BROKEN_DATAGRAM_SOCKETS
-#undef DATAGRAM_SOCKETS
-#else
-#ifndef DATAGRAM_SOCKETS
-#if defined (HAVE_SELECT) || defined (FIONREAD)
-#if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
-#define DATAGRAM_SOCKETS
-#endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
-#endif /* HAVE_SELECT || FIONREAD */
-#endif /* DATAGRAM_SOCKETS */
-#endif /* BROKEN_DATAGRAM_SOCKETS */
+#ifndef BROKEN_DATAGRAM_SOCKETS
+# if defined HAVE_SELECT || defined USABLE_FIONREAD
+# if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
+# define DATAGRAM_SOCKETS
+# endif
+# endif
+#endif
#if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
# define HAVE_SEQPACKET
#endif
#if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
-#ifdef EMACS_HAS_USECS
#define ADAPTIVE_READ_BUFFERING
#endif
-#endif
#ifdef ADAPTIVE_READ_BUFFERING
-#define READ_OUTPUT_DELAY_INCREMENT 10000
+#define READ_OUTPUT_DELAY_INCREMENT (EMACS_TIME_RESOLUTION / 100)
#define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
#define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
@@ -244,19 +243,19 @@ static int process_output_skip;
#define process_output_delay_count 0
#endif
-static Lisp_Object Fget_process (Lisp_Object);
static void create_process (Lisp_Object, char **, Lisp_Object);
-#ifdef SIGIO
+#ifdef USABLE_SIGIO
static int keyboard_bit_set (SELECT_TYPE *);
#endif
static void deactivate_process (Lisp_Object);
static void status_notify (struct Lisp_Process *);
static int read_process_output (Lisp_Object, int);
+static void handle_child_signal (int);
static void create_pty (Lisp_Object);
/* If we support a window system, turn on the code to poll periodically
to detect C-g. It isn't actually used when doing interrupt input. */
-#if defined (HAVE_WINDOW_SYSTEM) && !defined (USE_ASYNC_EVENTS)
+#ifdef HAVE_WINDOW_SYSTEM
#define POLL_FOR_INPUT
#endif
@@ -327,8 +326,87 @@ static struct sockaddr_and_len {
#define DATAGRAM_CONN_P(proc) (0)
#endif
-/* Maximum number of bytes to send to a pty without an eof. */
-static int pty_max_bytes;
+/* These setters are used only in this file, so they can be private. */
+static void
+pset_buffer (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->buffer = val;
+}
+static void
+pset_command (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->command = val;
+}
+static void
+pset_decode_coding_system (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->decode_coding_system = val;
+}
+static void
+pset_decoding_buf (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->decoding_buf = val;
+}
+static void
+pset_encode_coding_system (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->encode_coding_system = val;
+}
+static void
+pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->encoding_buf = val;
+}
+static void
+pset_filter (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->filter = val;
+}
+static void
+pset_log (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->log = val;
+}
+static void
+pset_mark (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->mark = val;
+}
+static void
+pset_name (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->name = val;
+}
+static void
+pset_plist (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->plist = val;
+}
+static void
+pset_sentinel (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->sentinel = val;
+}
+static void
+pset_status (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->status = val;
+}
+static void
+pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->tty_name = val;
+}
+static void
+pset_type (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->type = val;
+}
+static void
+pset_write_queue (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->write_queue = val;
+}
@@ -348,7 +426,7 @@ static struct fd_callback_data
void
add_read_fd (int fd, fd_callback func, void *data)
{
- xassert (fd < MAXDESC);
+ eassert (fd < MAXDESC);
add_keyboard_wait_descriptor (fd);
fd_callback_info[fd].func = func;
@@ -361,7 +439,7 @@ add_read_fd (int fd, fd_callback func, void *data)
void
delete_read_fd (int fd)
{
- xassert (fd < MAXDESC);
+ eassert (fd < MAXDESC);
delete_keyboard_wait_descriptor (fd);
fd_callback_info[fd].condition &= ~FOR_READ;
@@ -378,7 +456,7 @@ delete_read_fd (int fd)
void
add_write_fd (int fd, fd_callback func, void *data)
{
- xassert (fd < MAXDESC);
+ eassert (fd < MAXDESC);
FD_SET (fd, &write_mask);
if (fd > max_input_desc)
max_input_desc = fd;
@@ -395,7 +473,7 @@ delete_write_fd (int fd)
{
int lim = max_input_desc;
- xassert (fd < MAXDESC);
+ eassert (fd < MAXDESC);
FD_CLR (fd, &write_mask);
fd_callback_info[fd].condition &= ~FOR_WRITE;
if (fd_callback_info[fd].condition == 0)
@@ -424,7 +502,7 @@ static void
update_status (struct Lisp_Process *p)
{
eassert (p->raw_status_new);
- p->status = status_convert (p->raw_status);
+ pset_status (p, status_convert (p->raw_status));
p->raw_status_new = 0;
}
@@ -437,7 +515,7 @@ status_convert (int w)
if (WIFSTOPPED (w))
return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
else if (WIFEXITED (w))
- return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
+ return Fcons (Qexit, Fcons (make_number (WEXITSTATUS (w)),
WCOREDUMP (w) ? Qt : Qnil));
else if (WIFSIGNALED (w))
return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
@@ -484,7 +562,7 @@ status_message (struct Lisp_Process *p)
if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
{
- char *signame;
+ char const *signame;
synchronize_system_messages_locale ();
signame = strsignal (code);
if (signame == 0)
@@ -493,7 +571,7 @@ status_message (struct Lisp_Process *p)
{
int c1, c2;
- string = make_unibyte_string (signame, strlen (signame));
+ string = build_unibyte_string (signame);
if (! NILP (Vlocale_coding_system))
string = (code_convert_string_norecord
(string, Vlocale_coding_system, 0));
@@ -559,30 +637,7 @@ allocate_pty (void)
#ifdef PTY_OPEN
PTY_OPEN;
#else /* no PTY_OPEN */
- {
- { /* Some systems name their pseudoterminals so that there are gaps in
- the usual sequence - for example, on HP9000/S700 systems, there
- are no pseudoterminals with names ending in 'f'. So we wait for
- three failures in a row before deciding that we've reached the
- end of the ptys. */
- int failed_count = 0;
- struct stat stb;
-
- if (stat (pty_name, &stb) < 0)
- {
- failed_count++;
- if (failed_count >= 3)
- return -1;
- }
- else
- failed_count = 0;
- }
-# ifdef O_NONBLOCK
- fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
-# else
- fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
-# endif
- }
+ fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
#endif /* no PTY_OPEN */
if (fd >= 0)
@@ -594,7 +649,7 @@ allocate_pty (void)
#else
sprintf (pty_name, "/dev/tty%c%x", c, i);
#endif /* no PTY_TTY_NAME_SPRINTF */
- if (access (pty_name, 6) != 0)
+ if (faccessat (AT_FDCWD, pty_name, R_OK | W_OK, AT_EACCESS) != 0)
{
emacs_close (fd);
# ifndef __sgi
@@ -620,31 +675,18 @@ make_process (Lisp_Object name)
printmax_t i;
p = allocate_process ();
+ /* Initialize Lisp data. Note that allocate_process initializes all
+ Lisp data to nil, so do it only for slots which should not be nil. */
+ pset_status (p, Qrun);
+ pset_mark (p, Fmake_marker ());
+ /* Initialize non-Lisp data. Note that allocate_process zeroes out all
+ non-Lisp data, so do it only for slots which should not be zero. */
p->infd = -1;
p->outfd = -1;
- p->tick = 0;
- p->update_tick = 0;
- p->pid = 0;
- p->pty_flag = 0;
- p->raw_status_new = 0;
- p->status = Qrun;
- p->mark = Fmake_marker ();
- p->kill_without_query = 0;
-
-#ifdef ADAPTIVE_READ_BUFFERING
- p->adaptive_read_buffering = 0;
- p->read_output_delay = 0;
- p->read_output_skip = 0;
-#endif
#ifdef HAVE_GNUTLS
p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
- p->gnutls_log_level = 0;
- p->gnutls_p = 0;
- p->gnutls_state = NULL;
- p->gnutls_x509_cred = NULL;
- p->gnutls_anon_cred = NULL;
#endif
/* If name is already in use, modify it until it is unused. */
@@ -654,11 +696,10 @@ make_process (Lisp_Object name)
{
tem = Fget_process (name1);
if (NILP (tem)) break;
- sprintf (suffix, "<%"pMd">", i);
- name1 = concat2 (name, build_string (suffix));
+ name1 = concat2 (name, make_formatted_string (suffix, "<%"pMd">", i));
}
name = name1;
- p->name = name;
+ pset_name (p, name);
XSETPROCESS (val, p);
Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
return val;
@@ -735,9 +776,8 @@ get_process (register Lisp_Object name)
#ifdef SIGCHLD
/* Fdelete_process promises to immediately forget about the process, but in
reality, Emacs needs to remember those processes until they have been
- treated by sigchld_handler; otherwise this handler would consider the
- process as being synchronous and say that the synchronous process is
- dead. */
+ treated by the SIGCHLD handler and waitpid has been invoked on them;
+ otherwise they might fill up the kernel's process table. */
static Lisp_Object deleted_pid_list;
#endif
@@ -755,7 +795,7 @@ nil, indicating the current buffer's process. */)
p->raw_status_new = 0;
if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
- p->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
+ pset_status (p, Fcons (Qexit, Fcons (make_number (0), Qnil)));
p->tick = ++process_tick;
status_notify (p);
redisplay_preserve_echo_area (13);
@@ -764,9 +804,7 @@ nil, indicating the current buffer's process. */)
{
#ifdef SIGCHLD
Lisp_Object symbol;
- /* Assignment to EMACS_INT stops GCC whining about limited range
- of data type. */
- EMACS_INT pid = p->pid;
+ pid_t pid = p->pid;
/* No problem storing the pid here, as it is still in Vprocess_alist. */
deleted_pid_list = Fcons (make_fixnum_or_float (pid),
@@ -785,9 +823,9 @@ nil, indicating the current buffer's process. */)
#endif
{
Fkill_process (process, Qnil);
- /* Do this now, since remove_process will make sigchld_handler do nothing. */
- p->status
- = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
+ /* Do this now, since remove_process will make the
+ SIGCHLD handler do nothing. */
+ pset_status (p, Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil)));
p->tick = ++process_tick;
status_notify (p);
redisplay_preserve_echo_area (13);
@@ -863,9 +901,7 @@ This is the pid of the external process which PROCESS uses or talks to.
For a network connection, this value is nil. */)
(register Lisp_Object process)
{
- /* Assignment to EMACS_INT stops GCC whining about limited range of
- data type. */
- EMACS_INT pid;
+ pid_t pid;
CHECK_PROCESS (process);
pid = XPROCESS (process)->pid;
@@ -916,9 +952,9 @@ Return BUFFER. */)
if (!NILP (buffer))
CHECK_BUFFER (buffer);
p = XPROCESS (process);
- p->buffer = buffer;
+ pset_buffer (p, buffer);
if (NETCONN1_P (p) || SERIALCONN1_P (p))
- p->childp = Fplist_put (p->childp, QCbuffer, buffer);
+ pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer));
setup_process_coding_systems (process);
return buffer;
}
@@ -989,9 +1025,9 @@ The string argument is normally a multibyte string, except:
}
}
- p->filter = filter;
+ pset_filter (p, filter);
if (NETCONN1_P (p) || SERIALCONN1_P (p))
- p->childp = Fplist_put (p->childp, QCfilter, filter);
+ pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
setup_process_coding_systems (process);
return filter;
}
@@ -1018,9 +1054,9 @@ It gets two arguments: the process, and a string describing the change. */)
CHECK_PROCESS (process);
p = XPROCESS (process);
- p->sentinel = sentinel;
+ pset_sentinel (p, sentinel);
if (NETCONN1_P (p) || SERIALCONN1_P (p))
- p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
+ pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel));
return sentinel;
}
@@ -1040,8 +1076,8 @@ DEFUN ("set-process-window-size", Fset_process_window_size,
(register Lisp_Object process, Lisp_Object height, Lisp_Object width)
{
CHECK_PROCESS (process);
- CHECK_NATNUM (height);
- CHECK_NATNUM (width);
+ CHECK_RANGED_INTEGER (height, 0, INT_MAX);
+ CHECK_RANGED_INTEGER (width, 0, INT_MAX);
if (XPROCESS (process)->infd < 0
|| set_window_size (XPROCESS (process)->infd,
@@ -1067,7 +1103,9 @@ is more appropriate for saving the process buffer.
Binding the variable `inherit-process-coding-system' to non-nil before
starting the process is an alternative way of setting the inherit flag
-for the process which will run. */)
+for the process which will run.
+
+This function returns FLAG. */)
(register Lisp_Object process, Lisp_Object flag)
{
CHECK_PROCESS (process);
@@ -1080,7 +1118,8 @@ DEFUN ("set-process-query-on-exit-flag",
2, 2, 0,
doc: /* Specify if query is needed for PROCESS when Emacs is exited.
If the second argument FLAG is non-nil, Emacs will query the user before
-exiting or killing a buffer if PROCESS is running. */)
+exiting or killing a buffer if PROCESS is running. This function
+returns FLAG. */)
(register Lisp_Object process, Lisp_Object flag)
{
CHECK_PROCESS (process);
@@ -1098,10 +1137,6 @@ DEFUN ("process-query-on-exit-flag",
return (XPROCESS (process)->kill_without_query ? Qnil : Qt);
}
-#ifdef DATAGRAM_SOCKETS
-static Lisp_Object Fprocess_datagram_address (Lisp_Object);
-#endif
-
DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1, 2, 0,
doc: /* Return the contact info of PROCESS; t for a real child.
@@ -1154,7 +1189,7 @@ DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
CHECK_PROCESS (process);
CHECK_LIST (plist);
- XPROCESS (process)->plist = plist;
+ pset_plist (XPROCESS (process), plist);
return plist;
}
@@ -1201,7 +1236,7 @@ Returns nil if format of ADDRESS is invalid. */)
if (VECTORP (address)) /* AF_INET or AF_INET6 */
{
register struct Lisp_Vector *p = XVECTOR (address);
- EMACS_INT size = p->header.size;
+ ptrdiff_t size = p->header.size;
Lisp_Object args[10];
int nargs, i;
@@ -1230,14 +1265,12 @@ Returns nil if format of ADDRESS is invalid. */)
for (i = 0; i < nargs; i++)
{
- EMACS_INT element = XINT (p->contents[i]);
-
- if (element < 0 || element > 65535)
+ if (! RANGED_INTEGERP (0, p->contents[i], 65535))
return Qnil;
if (nargs <= 5 /* IPv4 */
&& i < 4 /* host, not port */
- && element > 255)
+ && XINT (p->contents[i]) > 255)
return Qnil;
args[i+1] = p->contents[i];
@@ -1292,7 +1325,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
Lisp_Object buffer, name, program, proc, current_dir, tem;
register unsigned char **new_argv;
ptrdiff_t i;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
buffer = args[1];
if (!NILP (buffer))
@@ -1342,18 +1375,18 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
itself; it's all taken care of here. */
record_unwind_protect (start_process_unwind, proc);
- XPROCESS (proc)->childp = Qt;
- XPROCESS (proc)->plist = Qnil;
- XPROCESS (proc)->type = Qreal;
- XPROCESS (proc)->buffer = buffer;
- XPROCESS (proc)->sentinel = Qnil;
- XPROCESS (proc)->filter = Qnil;
- XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
+ pset_childp (XPROCESS (proc), Qt);
+ pset_plist (XPROCESS (proc), Qnil);
+ pset_type (XPROCESS (proc), Qreal);
+ pset_buffer (XPROCESS (proc), buffer);
+ pset_sentinel (XPROCESS (proc), Qnil);
+ pset_filter (XPROCESS (proc), Qnil);
+ pset_command (XPROCESS (proc), Flist (nargs - 2, args + 2));
#ifdef HAVE_GNUTLS
/* AKA GNUTLS_INITSTAGE(proc). */
XPROCESS (proc)->gnutls_initstage = GNUTLS_STAGE_EMPTY;
- XPROCESS (proc)->gnutls_cred_type = Qnil;
+ pset_gnutls_cred_type (XPROCESS (proc), Qnil);
#endif
#ifdef ADAPTIVE_READ_BUFFERING
@@ -1381,7 +1414,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
val = Vcoding_system_for_read;
if (NILP (val))
{
- args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
+ args2 = alloca ((nargs + 1) * sizeof *args2);
args2[0] = Qstart_process;
for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
GCPRO2 (proc, current_dir);
@@ -1393,14 +1426,14 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
else if (CONSP (Vdefault_process_coding_system))
val = XCAR (Vdefault_process_coding_system);
}
- XPROCESS (proc)->decode_coding_system = val;
+ pset_decode_coding_system (XPROCESS (proc), val);
val = Vcoding_system_for_write;
if (NILP (val))
{
if (EQ (coding_systems, Qt))
{
- args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
+ args2 = alloca ((nargs + 1) * sizeof *args2);
args2[0] = Qstart_process;
for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
GCPRO2 (proc, current_dir);
@@ -1413,7 +1446,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
else if (CONSP (Vdefault_process_coding_system))
val = XCDR (Vdefault_process_coding_system);
}
- XPROCESS (proc)->encode_coding_system = val;
+ pset_encode_coding_system (XPROCESS (proc), val);
/* Note: At this moment, the above coding system may leave
text-conversion or eol-conversion unspecified. They will be
decided after we read output from the process and decode it by
@@ -1422,9 +1455,9 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
}
- XPROCESS (proc)->decoding_buf = empty_unibyte_string;
+ pset_decoding_buf (XPROCESS (proc), empty_unibyte_string);
XPROCESS (proc)->decoding_carryover = 0;
- XPROCESS (proc)->encoding_buf = empty_unibyte_string;
+ pset_encoding_buf (XPROCESS (proc), empty_unibyte_string);
XPROCESS (proc)->inherit_coding_system_flag
= !(NILP (buffer) || !inherit_process_coding_system);
@@ -1494,7 +1527,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
/* Now that everything is encoded we can collect the strings into
NEW_ARGV. */
- new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
+ new_argv = alloca ((nargs - 1) * sizeof *new_argv);
new_argv[nargs - 2] = 0;
for (i = nargs - 2; i-- != 0; )
@@ -1519,7 +1552,7 @@ static Lisp_Object
start_process_unwind (Lisp_Object proc)
{
if (!PROCESSP (proc))
- abort ();
+ emacs_abort ();
/* Was PROC started successfully?
-2 is used for a pty with no process, eg for gdb. */
@@ -1542,22 +1575,19 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
int inchannel, outchannel;
pid_t pid;
int sv[2];
-#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
+#ifndef WINDOWSNT
int wait_child_setup[2];
#endif
- sigset_t procmask;
+#ifdef SIGCHLD
sigset_t blocked;
- struct sigaction sigint_action;
- struct sigaction sigquit_action;
- struct sigaction sigpipe_action;
-#ifdef AIX
- struct sigaction sighup_action;
#endif
- /* Use volatile to protect variables from being clobbered by longjmp. */
+ /* Use volatile to protect variables from being clobbered by vfork. */
volatile int forkin, forkout;
volatile int pty_flag = 0;
-#ifndef USE_CRT_DLL
- extern char **environ;
+ volatile Lisp_Object lisp_pty_name = Qnil;
+ volatile Lisp_Object encoded_current_dir;
+#if HAVE_WORKING_VFORK
+ char **volatile save_environ;
#endif
inchannel = outchannel = -1;
@@ -1571,19 +1601,16 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
/* On most USG systems it does not work to open the pty's tty here,
then close it and reopen it in the child. */
-#ifdef O_NOCTTY
/* Don't let this terminal become our controlling terminal
(in case we don't have one). */
forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
-#else
- forkout = forkin = emacs_open (pty_name, O_RDWR, 0);
-#endif
if (forkin < 0)
report_file_error ("Opening pty", Qnil);
#else
forkin = forkout = -1;
#endif /* not USG, or USG_SUBTTY_WORKS */
pty_flag = 1;
+ lisp_pty_name = build_string (pty_name);
}
else
#endif /* HAVE_PTYS */
@@ -1605,7 +1632,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
forkin = sv[0];
}
-#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
+#ifndef WINDOWSNT
{
int tem;
@@ -1624,15 +1651,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
}
#endif
-#ifdef O_NONBLOCK
fcntl (inchannel, F_SETFL, O_NONBLOCK);
fcntl (outchannel, F_SETFL, O_NONBLOCK);
-#else
-#ifdef O_NDELAY
- fcntl (inchannel, F_SETFL, O_NDELAY);
- fcntl (outchannel, F_SETFL, O_NDELAY);
-#endif
-#endif
/* Record this as an active process, with its channels.
As a result, child_setup will close Emacs's side of the pipes. */
@@ -1646,207 +1666,173 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
more portable (see USG_SUBTTY_WORKS above). */
XPROCESS (process)->pty_flag = pty_flag;
- XPROCESS (process)->status = Qrun;
-
- /* Delay interrupts until we have a chance to store
- the new fork's pid in its process structure */
- sigemptyset (&blocked);
-#ifdef SIGCHLD
- sigaddset (&blocked, SIGCHLD);
-#endif
-#ifdef HAVE_WORKING_VFORK
- /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
- this sets the parent's signal handlers as well as the child's.
- So delay all interrupts whose handlers the child might munge,
- and record the current handlers so they can be restored later. */
- sigaddset (&blocked, SIGINT ); sigaction (SIGINT , 0, &sigint_action );
- sigaddset (&blocked, SIGQUIT); sigaction (SIGQUIT, 0, &sigquit_action);
- sigaddset (&blocked, SIGPIPE); sigaction (SIGPIPE, 0, &sigpipe_action);
-#ifdef AIX
- sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action );
-#endif
-#endif /* HAVE_WORKING_VFORK */
- pthread_sigmask (SIG_BLOCK, &blocked, &procmask);
+ pset_status (XPROCESS (process), Qrun);
FD_SET (inchannel, &input_wait_mask);
FD_SET (inchannel, &non_keyboard_wait_mask);
if (inchannel > max_process_desc)
max_process_desc = inchannel;
- /* Until we store the proper pid, enable sigchld_handler
- to recognize an unknown pid as standing for this process.
- It is very important not to let this `marker' value stay
- in the table after this function has returned; if it does
- it might cause call-process to hang and subsequent asynchronous
- processes to get their return values scrambled. */
- XPROCESS (process)->pid = -1;
-
- /* This must be called after the above line because it may signal an
- error. */
+ /* This may signal an error. */
setup_process_coding_systems (process);
- BLOCK_INPUT;
+ encoded_current_dir = ENCODE_FILE (current_dir);
- {
- /* child_setup must clobber environ on systems with true vfork.
- Protect it from permanent change. */
- char **save_environ = environ;
- volatile Lisp_Object encoded_current_dir = ENCODE_FILE (current_dir);
+ block_input ();
-#ifndef WINDOWSNT
- pid = vfork ();
- if (pid == 0)
-#endif /* not WINDOWSNT */
- {
- int xforkin = forkin;
- int xforkout = forkout;
+#ifdef SIGCHLD
+ /* Block SIGCHLD until we have a chance to store the new fork's
+ pid in its process structure. */
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGCHLD);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
+#endif
-#if 0 /* This was probably a mistake--it duplicates code later on,
- but fails to handle all the cases. */
- /* Make sure SIGCHLD is not blocked in the child. */
- sigsetmask (SIGEMPTYMASK);
+#if HAVE_WORKING_VFORK
+ /* child_setup must clobber environ on systems with true vfork.
+ Protect it from permanent change. */
+ save_environ = environ;
#endif
- /* Make the pty be the controlling terminal of the process. */
+#ifndef WINDOWSNT
+ pid = vfork ();
+ if (pid == 0)
+#endif /* not WINDOWSNT */
+ {
+ int xforkin = forkin;
+ int xforkout = forkout;
+
+ /* Make the pty be the controlling terminal of the process. */
#ifdef HAVE_PTYS
- /* First, disconnect its current controlling terminal. */
-#ifdef HAVE_SETSID
- /* We tried doing setsid only if pty_flag, but it caused
- process_set_signal to fail on SGI when using a pipe. */
- setsid ();
- /* Make the pty's terminal the controlling terminal. */
- if (pty_flag && xforkin >= 0)
- {
+ /* First, disconnect its current controlling terminal. */
+ /* We tried doing setsid only if pty_flag, but it caused
+ process_set_signal to fail on SGI when using a pipe. */
+ setsid ();
+ /* Make the pty's terminal the controlling terminal. */
+ if (pty_flag && xforkin >= 0)
+ {
#ifdef TIOCSCTTY
- /* We ignore the return value
- because faith@cs.unc.edu says that is necessary on Linux. */
- ioctl (xforkin, TIOCSCTTY, 0);
+ /* We ignore the return value
+ because faith@cs.unc.edu says that is necessary on Linux. */
+ ioctl (xforkin, TIOCSCTTY, 0);
#endif
- }
-#else /* not HAVE_SETSID */
-#ifdef USG
- /* It's very important to call setpgrp here and no time
- afterwards. Otherwise, we lose our controlling tty which
- is set when we open the pty. */
- setpgrp ();
-#endif /* USG */
-#endif /* not HAVE_SETSID */
+ }
#if defined (LDISC1)
- if (pty_flag && xforkin >= 0)
- {
- struct termios t;
- tcgetattr (xforkin, &t);
- t.c_lflag = LDISC1;
- if (tcsetattr (xforkin, TCSANOW, &t) < 0)
- emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
- }
+ if (pty_flag && xforkin >= 0)
+ {
+ struct termios t;
+ tcgetattr (xforkin, &t);
+ t.c_lflag = LDISC1;
+ if (tcsetattr (xforkin, TCSANOW, &t) < 0)
+ emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
+ }
#else
#if defined (NTTYDISC) && defined (TIOCSETD)
- if (pty_flag && xforkin >= 0)
- {
- /* Use new line discipline. */
- int ldisc = NTTYDISC;
- ioctl (xforkin, TIOCSETD, &ldisc);
- }
+ if (pty_flag && xforkin >= 0)
+ {
+ /* Use new line discipline. */
+ int ldisc = NTTYDISC;
+ ioctl (xforkin, TIOCSETD, &ldisc);
+ }
#endif
#endif
#ifdef TIOCNOTTY
- /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
- can do TIOCSPGRP only to the process's controlling tty. */
- if (pty_flag)
- {
- /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
- I can't test it since I don't have 4.3. */
- int j = emacs_open ("/dev/tty", O_RDWR, 0);
- if (j >= 0)
- {
- ioctl (j, TIOCNOTTY, 0);
- emacs_close (j);
- }
-#ifndef USG
- /* In order to get a controlling terminal on some versions
- of BSD, it is necessary to put the process in pgrp 0
- before it opens the terminal. */
-#ifdef HAVE_SETPGID
- setpgid (0, 0);
-#else
- setpgrp (0, 0);
-#endif
-#endif
- }
+ /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
+ can do TIOCSPGRP only to the process's controlling tty. */
+ if (pty_flag)
+ {
+ /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
+ I can't test it since I don't have 4.3. */
+ int j = emacs_open ("/dev/tty", O_RDWR, 0);
+ if (j >= 0)
+ {
+ ioctl (j, TIOCNOTTY, 0);
+ emacs_close (j);
+ }
+ }
#endif /* TIOCNOTTY */
#if !defined (DONT_REOPEN_PTY)
/*** There is a suggestion that this ought to be a
- conditional on TIOCSPGRP,
- or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
+ conditional on TIOCSPGRP, or !defined TIOCSCTTY.
Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
that system does seem to need this code, even though
- both HAVE_SETSID and TIOCSCTTY are defined. */
+ both TIOCSCTTY is defined. */
/* Now close the pty (if we had it open) and reopen it.
This makes the pty the controlling terminal of the subprocess. */
- if (pty_flag)
- {
+ if (pty_flag)
+ {
- /* I wonder if emacs_close (emacs_open (pty_name, ...))
- would work? */
- if (xforkin >= 0)
- emacs_close (xforkin);
- xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0);
+ /* I wonder if emacs_close (emacs_open (pty_name, ...))
+ would work? */
+ if (xforkin >= 0)
+ emacs_close (xforkin);
+ xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0);
- if (xforkin < 0)
- {
- emacs_write (1, "Couldn't open the pty terminal ", 31);
- emacs_write (1, pty_name, strlen (pty_name));
- emacs_write (1, "\n", 1);
- _exit (1);
- }
+ if (xforkin < 0)
+ {
+ emacs_write (1, "Couldn't open the pty terminal ", 31);
+ emacs_write (1, pty_name, strlen (pty_name));
+ emacs_write (1, "\n", 1);
+ _exit (1);
+ }
- }
+ }
#endif /* not DONT_REOPEN_PTY */
#ifdef SETUP_SLAVE_PTY
- if (pty_flag)
- {
- SETUP_SLAVE_PTY;
- }
+ if (pty_flag)
+ {
+ SETUP_SLAVE_PTY;
+ }
#endif /* SETUP_SLAVE_PTY */
#ifdef AIX
- /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
- Now reenable it in the child, so it will die when we want it to. */
- if (pty_flag)
- signal (SIGHUP, SIG_DFL);
+ /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
+ Now reenable it in the child, so it will die when we want it to. */
+ if (pty_flag)
+ signal (SIGHUP, SIG_DFL);
#endif
#endif /* HAVE_PTYS */
- signal (SIGINT, SIG_DFL);
- signal (SIGQUIT, SIG_DFL);
- /* GConf causes us to ignore SIGPIPE, make sure it is restored
- in the child. */
- signal (SIGPIPE, SIG_DFL);
+ signal (SIGINT, SIG_DFL);
+ signal (SIGQUIT, SIG_DFL);
+
+ /* Emacs ignores SIGPIPE, but the child should not. */
+ signal (SIGPIPE, SIG_DFL);
+#ifdef SIGCHLD
/* Stop blocking signals in the child. */
- pthread_sigmask (SIG_SETMASK, &procmask, 0);
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
+#endif
- if (pty_flag)
- child_setup_tty (xforkout);
+ if (pty_flag)
+ child_setup_tty (xforkout);
#ifdef WINDOWSNT
- pid = child_setup (xforkin, xforkout, xforkout,
- new_argv, 1, encoded_current_dir);
+ pid = child_setup (xforkin, xforkout, xforkout,
+ new_argv, 1, encoded_current_dir);
#else /* not WINDOWSNT */
-#ifdef FD_CLOEXEC
- emacs_close (wait_child_setup[0]);
-#endif
- child_setup (xforkin, xforkout, xforkout,
- new_argv, 1, encoded_current_dir);
+ emacs_close (wait_child_setup[0]);
+ child_setup (xforkin, xforkout, xforkout,
+ new_argv, 1, encoded_current_dir);
#endif /* not WINDOWSNT */
- }
- environ = save_environ;
- }
+ }
+
+ /* Back in the parent process. */
+
+#if HAVE_WORKING_VFORK
+ environ = save_environ;
+#endif
- UNBLOCK_INPUT;
+ XPROCESS (process)->pid = pid;
+ if (0 <= pid)
+ XPROCESS (process)->alive = 1;
+
+ /* Stop blocking signals in the parent. */
+#ifdef SIGCHLD
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
+#endif
+ unblock_input ();
- /* This runs in the Emacs process. */
if (pid < 0)
{
if (forkin >= 0)
@@ -1857,7 +1843,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
else
{
/* vfork succeeded. */
- XPROCESS (process)->pid = pid;
#ifdef WINDOWSNT
register_child (pid, inchannel);
@@ -1868,10 +1853,9 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
So have an interrupt jar it loose. */
{
struct atimer *timer;
- EMACS_TIME offset;
+ EMACS_TIME offset = make_emacs_time (1, 0);
stop_polling ();
- EMACS_SET_SECS_USECS (offset, 1, 0);
timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
if (forkin >= 0)
@@ -1884,14 +1868,9 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
if (forkin != forkout && forkout >= 0)
emacs_close (forkout);
-#ifdef HAVE_PTYS
- if (pty_flag)
- XPROCESS (process)->tty_name = build_string (pty_name);
- else
-#endif
- XPROCESS (process)->tty_name = Qnil;
+ pset_tty_name (XPROCESS (process), lisp_pty_name);
-#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
+#ifndef WINDOWSNT
/* Wait for child_setup to complete in case that vfork is
actually defined as fork. The descriptor wait_child_setup[1]
of a pipe is closed at the child side either by close-on-exec
@@ -1906,20 +1885,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
#endif
}
- /* Restore the signal state whether vfork succeeded or not.
- (We will signal an error, below, if it failed.) */
-#ifdef HAVE_WORKING_VFORK
- /* Restore the parent's signal handlers. */
- sigaction (SIGINT, &sigint_action, 0);
- sigaction (SIGQUIT, &sigquit_action, 0);
- sigaction (SIGPIPE, &sigpipe_action, 0);
-#ifdef AIX
- sigaction (SIGHUP, &sighup_action, 0);
-#endif
-#endif /* HAVE_WORKING_VFORK */
- /* Stop blocking signals in the parent. */
- pthread_sigmask (SIG_SETMASK, &procmask, 0);
-
/* Now generate the error if vfork failed. */
if (pid < 0)
report_file_error ("Doing vfork", Qnil);
@@ -1942,13 +1907,9 @@ create_pty (Lisp_Object process)
#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
/* On most USG systems it does not work to open the pty's tty here,
then close it and reopen it in the child. */
-#ifdef O_NOCTTY
/* Don't let this terminal become our controlling terminal
(in case we don't have one). */
int forkout = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
-#else
- int forkout = emacs_open (pty_name, O_RDWR, 0);
-#endif
if (forkout < 0)
report_file_error ("Opening pty", Qnil);
#if defined (DONT_REOPEN_PTY)
@@ -1962,15 +1923,8 @@ create_pty (Lisp_Object process)
}
#endif /* HAVE_PTYS */
-#ifdef O_NONBLOCK
fcntl (inchannel, F_SETFL, O_NONBLOCK);
fcntl (outchannel, F_SETFL, O_NONBLOCK);
-#else
-#ifdef O_NDELAY
- fcntl (inchannel, F_SETFL, O_NDELAY);
- fcntl (outchannel, F_SETFL, O_NDELAY);
-#endif
-#endif
/* Record this as an active process, with its channels.
As a result, child_setup will close Emacs's side of the pipes. */
@@ -1984,7 +1938,7 @@ create_pty (Lisp_Object process)
more portable (see USG_SUBTTY_WORKS above). */
XPROCESS (process)->pty_flag = pty_flag;
- XPROCESS (process)->status = Qrun;
+ pset_status (XPROCESS (process), Qrun);
setup_process_coding_systems (process);
FD_SET (inchannel, &input_wait_mask);
@@ -1995,10 +1949,10 @@ create_pty (Lisp_Object process)
XPROCESS (process)->pid = -2;
#ifdef HAVE_PTYS
if (pty_flag)
- XPROCESS (process)->tty_name = build_string (pty_name);
+ pset_tty_name (XPROCESS (process), build_string (pty_name));
else
#endif
- XPROCESS (process)->tty_name = Qnil;
+ pset_tty_name (XPROCESS (process), Qnil);
}
@@ -2102,7 +2056,8 @@ get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
return sizeof (struct sockaddr_un);
}
#endif
- else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address)))
+ else if (CONSP (address) && TYPE_RANGED_INTEGERP (int, XCAR (address))
+ && VECTORP (XCDR (address)))
{
struct sockaddr *sa;
*familyp = XINT (XCAR (address));
@@ -2125,6 +2080,7 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int
register struct Lisp_Vector *p;
register unsigned char *cp = NULL;
register int i;
+ EMACS_INT hostport;
memset (sa, 0, len);
@@ -2135,8 +2091,8 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int
{
struct sockaddr_in *sin = (struct sockaddr_in *) sa;
len = sizeof (sin->sin_addr) + 1;
- i = XINT (p->contents[--len]);
- sin->sin_port = htons (i);
+ hostport = XINT (p->contents[--len]);
+ sin->sin_port = htons (hostport);
cp = (unsigned char *)&sin->sin_addr;
sa->sa_family = family;
}
@@ -2146,8 +2102,8 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int
struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr;
len = sizeof (sin6->sin6_addr) + 1;
- i = XINT (p->contents[--len]);
- sin6->sin6_port = htons (i);
+ hostport = XINT (p->contents[--len]);
+ sin6->sin6_port = htons (hostport);
for (i = 0; i < len; i++)
if (INTEGERP (p->contents[i]))
{
@@ -2302,7 +2258,7 @@ set_socket_option (int s, Lisp_Object opt, Lisp_Object val)
case SOPT_INT:
{
int optval;
- if (INTEGERP (val))
+ if (TYPE_RANGED_INTEGERP (int, val))
optval = XINT (val);
else
error ("Bad option value for %s", name);
@@ -2341,7 +2297,7 @@ set_socket_option (int s, Lisp_Object opt, Lisp_Object val)
linger.l_onoff = 1;
linger.l_linger = 0;
- if (INTEGERP (val))
+ if (TYPE_RANGED_INTEGERP (int, val))
linger.l_linger = XINT (val);
else
linger.l_onoff = NILP (val) ? 0 : 1;
@@ -2385,7 +2341,7 @@ OPTION is not a supported option, return nil instead; otherwise return t. */)
if (set_socket_option (s, option, value))
{
- p->childp = Fplist_put (p->childp, option, value);
+ pset_childp (p, Fplist_put (p->childp, option, value));
return Qt;
}
@@ -2494,7 +2450,7 @@ static Lisp_Object
make_serial_process_unwind (Lisp_Object proc)
{
if (!PROCESSP (proc))
- abort ();
+ emacs_abort ();
remove_process (proc);
return Qnil;
}
@@ -2522,7 +2478,7 @@ could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
the backslashes in strings).
:speed SPEED -- (mandatory) is handled by `serial-process-configure',
-which is called by `make-serial-process'.
+which this function calls.
:name NAME -- NAME is the name of the process. If NAME is not given,
the value of PORT is used.
@@ -2551,13 +2507,12 @@ but you can send outgoing data. The stopped state is cleared by
:plist PLIST -- Install PLIST as the initial plist of the process.
-:speed
:bytesize
:parity
:stopbits
:flowcontrol
--- These arguments are handled by `serial-process-configure', which is
-called by `make-serial-process'.
+-- This function calls `serial-process-configure' to handle these
+arguments.
The original argument list, possibly modified by later configuration,
is available via the function `process-contact'.
@@ -2581,7 +2536,7 @@ usage: (make-serial-process &rest ARGS) */)
struct gcpro gcpro1;
Lisp_Object name, buffer;
Lisp_Object tem, val;
- int specpdl_count = -1;
+ ptrdiff_t specpdl_count = -1;
if (nargs == 0)
return Qnil;
@@ -2619,18 +2574,18 @@ usage: (make-serial-process &rest ARGS) */)
if (NILP (buffer))
buffer = name;
buffer = Fget_buffer_create (buffer);
- p->buffer = buffer;
-
- p->childp = contact;
- p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
- p->type = Qserial;
- p->sentinel = Fplist_get (contact, QCsentinel);
- p->filter = Fplist_get (contact, QCfilter);
- p->log = Qnil;
+ pset_buffer (p, buffer);
+
+ pset_childp (p, contact);
+ pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
+ pset_type (p, Qserial);
+ pset_sentinel (p, Fplist_get (contact, QCsentinel));
+ pset_filter (p, Fplist_get (contact, QCfilter));
+ pset_log (p, Qnil);
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = 1;
if (tem = Fplist_get (contact, QCstop), !NILP (tem))
- p->command = Qt;
+ pset_command (p, Qt);
p->pty_flag = 0;
if (!EQ (p->command, Qt))
@@ -2662,7 +2617,7 @@ usage: (make-serial-process &rest ARGS) */)
else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
|| (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
val = Qnil;
- p->decode_coding_system = val;
+ pset_decode_coding_system (p, val);
val = Qnil;
if (!NILP (tem))
@@ -2676,12 +2631,12 @@ usage: (make-serial-process &rest ARGS) */)
else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
|| (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
val = Qnil;
- p->encode_coding_system = val;
+ pset_encode_coding_system (p, val);
setup_process_coding_systems (proc);
- p->decoding_buf = empty_unibyte_string;
+ pset_decoding_buf (p, empty_unibyte_string);
p->decoding_carryover = 0;
- p->encoding_buf = empty_unibyte_string;
+ pset_encoding_buf (p, empty_unibyte_string);
p->inherit_coding_system_flag
= !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
@@ -2791,7 +2746,7 @@ The stopped state is cleared by `continue-process' and set by
:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
process filter are multibyte, otherwise they are unibyte.
If this keyword is not specified, the strings are multibyte if
-`default-enable-multibyte-characters' is non-nil.
+the default value of `enable-multibyte-characters' is non-nil.
:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
@@ -2881,8 +2836,8 @@ usage: (make-network-process &rest ARGS) */)
int xerrno = 0;
int s = -1, outch, inch;
struct gcpro gcpro1;
- int count = SPECPDL_INDEX ();
- int count1;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t count1;
Lisp_Object QCaddress; /* one of QClocal or QCremote */
Lisp_Object tem;
Lisp_Object name, buffer, host, service, address;
@@ -2925,13 +2880,9 @@ usage: (make-network-process &rest ARGS) */)
{
/* Don't support network sockets when non-blocking mode is
not available, since a blocked Emacs is not useful. */
-#if !defined (O_NONBLOCK) && !defined (O_NDELAY)
- error ("Network servers not supported");
-#else
is_server = 1;
- if (INTEGERP (tem))
+ if (TYPE_RANGED_INTEGERP (int, tem))
backlog = XINT (tem);
-#endif
}
/* Make QCaddress an alias for :local (server) or :remote (client). */
@@ -2995,7 +2946,7 @@ usage: (make-network-process &rest ARGS) */)
#endif
else if (EQ (tem, Qipv4))
family = AF_INET;
- else if (INTEGERP (tem))
+ else if (TYPE_RANGED_INTEGERP (int, tem))
family = XINT (tem);
else
error ("Unknown address family");
@@ -3029,7 +2980,9 @@ usage: (make-network-process &rest ARGS) */)
CHECK_STRING (service);
memset (&address_un, 0, sizeof address_un);
address_un.sun_family = AF_LOCAL;
- strncpy (address_un.sun_path, SSDATA (service), sizeof address_un.sun_path);
+ if (sizeof address_un.sun_path <= SBYTES (service))
+ error ("Service name too long");
+ strcpy (address_un.sun_path, SSDATA (service));
ai.ai_addr = (struct sockaddr *) &address_un;
ai.ai_addrlen = sizeof address_un;
goto open_socket;
@@ -3189,11 +3142,7 @@ usage: (make-network-process &rest ARGS) */)
#ifdef NON_BLOCKING_CONNECT
if (is_non_blocking_client)
{
-#ifdef O_NONBLOCK
ret = fcntl (s, F_SETFL, O_NONBLOCK);
-#else
- ret = fcntl (s, F_SETFL, O_NDELAY);
-#endif
if (ret < 0)
{
xerrno = errno;
@@ -3282,7 +3231,7 @@ usage: (make-network-process &rest ARGS) */)
{
/* Unlike most other syscalls connect() cannot be called
again. (That would return EALREADY.) The proper way to
- wait for completion is select(). */
+ wait for completion is pselect(). */
int sc;
socklen_t len;
SELECT_TYPE fdset;
@@ -3290,8 +3239,7 @@ usage: (make-network-process &rest ARGS) */)
FD_ZERO (&fdset);
FD_SET (s, &fdset);
QUIT;
- sc = select (s + 1, (SELECT_TYPE *)0, &fdset, (SELECT_TYPE *)0,
- (EMACS_TIME *)0);
+ sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
if (sc == -1)
{
if (errno == EINTR)
@@ -3331,8 +3279,8 @@ usage: (make-network-process &rest ARGS) */)
if (socktype == SOCK_DGRAM)
{
if (datagram_address[s].sa)
- abort ();
- datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen);
+ emacs_abort ();
+ datagram_address[s].sa = xmalloc (lres->ai_addrlen);
datagram_address[s].len = lres->ai_addrlen;
if (is_server)
{
@@ -3370,9 +3318,9 @@ usage: (make-network-process &rest ARGS) */)
#ifdef HAVE_GETADDRINFO
if (res != &ai)
{
- BLOCK_INPUT;
+ block_input ();
freeaddrinfo (res);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif
@@ -3407,33 +3355,27 @@ usage: (make-network-process &rest ARGS) */)
chan_process[inch] = proc;
-#ifdef O_NONBLOCK
fcntl (inch, F_SETFL, O_NONBLOCK);
-#else
-#ifdef O_NDELAY
- fcntl (inch, F_SETFL, O_NDELAY);
-#endif
-#endif
p = XPROCESS (proc);
- p->childp = contact;
- p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
- p->type = Qnetwork;
+ pset_childp (p, contact);
+ pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
+ pset_type (p, Qnetwork);
- p->buffer = buffer;
- p->sentinel = sentinel;
- p->filter = filter;
- p->log = Fplist_get (contact, QClog);
+ pset_buffer (p, buffer);
+ pset_sentinel (p, sentinel);
+ pset_filter (p, filter);
+ pset_log (p, Fplist_get (contact, QClog));
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = 1;
if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
- p->command = Qt;
+ pset_command (p, Qt);
p->pid = 0;
p->infd = inch;
p->outfd = outch;
if (is_server && socktype != SOCK_DGRAM)
- p->status = Qlisten;
+ pset_status (p, Qlisten);
/* Make the process marker point into the process buffer (if any). */
if (BUFFERP (buffer))
@@ -3447,7 +3389,7 @@ usage: (make-network-process &rest ARGS) */)
/* We may get here if connect did succeed immediately. However,
in that case, we still need to signal this like a non-blocking
connection. */
- p->status = Qconnect;
+ pset_status (p, Qconnect);
if (!FD_ISSET (inch, &connect_wait_mask))
{
FD_SET (inch, &connect_wait_mask);
@@ -3492,7 +3434,7 @@ usage: (make-network-process &rest ARGS) */)
|| (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
/* We dare not decode end-of-line format by setting VAL to
Qraw_text, because the existing Emacs Lisp libraries
- assume that they receive bare code including a sequene of
+ assume that they receive bare code including a sequence of
CR LF. */
val = Qnil;
else
@@ -3514,7 +3456,7 @@ usage: (make-network-process &rest ARGS) */)
else
val = Qnil;
}
- p->decode_coding_system = val;
+ pset_decode_coding_system (p, val);
if (!NILP (tem))
{
@@ -3548,13 +3490,13 @@ usage: (make-network-process &rest ARGS) */)
else
val = Qnil;
}
- p->encode_coding_system = val;
+ pset_encode_coding_system (p, val);
}
setup_process_coding_systems (proc);
- p->decoding_buf = empty_unibyte_string;
+ pset_decoding_buf (p, empty_unibyte_string);
p->decoding_carryover = 0;
- p->encoding_buf = empty_unibyte_string;
+ pset_encoding_buf (p, empty_unibyte_string);
p->inherit_coding_system_flag
= !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
@@ -3734,8 +3676,9 @@ FLAGS is the current flags of the interface. */)
CHECK_STRING (ifname);
- memset (rq.ifr_name, 0, sizeof rq.ifr_name);
- strncpy (rq.ifr_name, SSDATA (ifname), sizeof (rq.ifr_name));
+ if (sizeof rq.ifr_name <= SBYTES (ifname))
+ error ("interface name too long");
+ strcpy (rq.ifr_name, SSDATA (ifname));
s = socket (AF_INET, SOCK_STREAM, 0);
if (s < 0)
@@ -3916,7 +3859,7 @@ deactivate_process (Lisp_Object proc)
FD_CLR (inchannel, &connect_wait_mask);
FD_CLR (inchannel, &write_mask);
if (--num_pending_connects < 0)
- abort ();
+ emacs_abort ();
}
#endif
if (inchannel == max_process_desc)
@@ -3952,7 +3895,8 @@ If JUST-THIS-ONE is an integer, don't run any timers either.
Return non-nil if we received any output before the timeout expired. */)
(register Lisp_Object process, Lisp_Object seconds, Lisp_Object millisec, Lisp_Object just_this_one)
{
- int secs, usecs = 0;
+ intmax_t secs;
+ int nsecs;
if (! NILP (process))
CHECK_PROCESS (process);
@@ -3971,27 +3915,36 @@ Return non-nil if we received any output before the timeout expired. */)
}
}
+ secs = 0;
+ nsecs = -1;
+
if (!NILP (seconds))
{
if (INTEGERP (seconds))
- secs = XINT (seconds);
+ {
+ if (0 < XINT (seconds))
+ {
+ secs = XINT (seconds);
+ nsecs = 0;
+ }
+ }
else if (FLOATP (seconds))
{
- double timeout = XFLOAT_DATA (seconds);
- secs = (int) timeout;
- usecs = (int) ((timeout - (double) secs) * 1000000);
+ if (0 < XFLOAT_DATA (seconds))
+ {
+ EMACS_TIME t = EMACS_TIME_FROM_DOUBLE (XFLOAT_DATA (seconds));
+ secs = min (EMACS_SECS (t), WAIT_READING_MAX);
+ nsecs = EMACS_NSECS (t);
+ }
}
else
wrong_type_argument (Qnumberp, seconds);
-
- if (secs < 0 || (secs == 0 && usecs == 0))
- secs = -1, usecs = 0;
}
- else
- secs = NILP (process) ? -1 : 0;
+ else if (! NILP (process))
+ nsecs = 0;
return
- (wait_reading_process_output (secs, usecs, 0, 0,
+ (wait_reading_process_output (secs, nsecs, 0, 0,
Qnil,
!NILP (process) ? XPROCESS (process) : NULL,
NILP (just_this_one) ? 0 :
@@ -4131,13 +4084,7 @@ server_accept_connection (Lisp_Object server, int channel)
chan_process[s] = proc;
-#ifdef O_NONBLOCK
fcntl (s, F_SETFL, O_NONBLOCK);
-#else
-#ifdef O_NDELAY
- fcntl (s, F_SETFL, O_NDELAY);
-#endif
-#endif
p = XPROCESS (proc);
@@ -4156,18 +4103,18 @@ server_accept_connection (Lisp_Object server, int channel)
conv_sockaddr_to_lisp (&saddr.sa, len));
#endif
- p->childp = contact;
- p->plist = Fcopy_sequence (ps->plist);
- p->type = Qnetwork;
+ pset_childp (p, contact);
+ pset_plist (p, Fcopy_sequence (ps->plist));
+ pset_type (p, Qnetwork);
- p->buffer = buffer;
- p->sentinel = ps->sentinel;
- p->filter = ps->filter;
- p->command = Qnil;
+ pset_buffer (p, buffer);
+ pset_sentinel (p, ps->sentinel);
+ pset_filter (p, ps->filter);
+ pset_command (p, Qnil);
p->pid = 0;
p->infd = s;
p->outfd = s;
- p->status = Qrun;
+ pset_status (p, Qrun);
/* Client processes for accepted connections are not stopped initially. */
if (!EQ (p->filter, Qt))
@@ -4184,13 +4131,13 @@ server_accept_connection (Lisp_Object server, int channel)
of the new process should reflect the settings at the time the
server socket was opened; not the current settings. */
- p->decode_coding_system = ps->decode_coding_system;
- p->encode_coding_system = ps->encode_coding_system;
+ pset_decode_coding_system (p, ps->decode_coding_system);
+ pset_encode_coding_system (p, ps->encode_coding_system);
setup_process_coding_systems (proc);
- p->decoding_buf = empty_unibyte_string;
+ pset_decoding_buf (p, empty_unibyte_string);
p->decoding_carryover = 0;
- p->encoding_buf = empty_unibyte_string;
+ pset_encoding_buf (p, empty_unibyte_string);
p->inherit_coding_system_flag
= (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
@@ -4232,42 +4179,27 @@ wait_reading_process_output_1 (void)
{
}
-/* Use a wrapper around select to work around a bug in gdb 5.3.
- Normally, the wrapper is optimized away by inlining.
-
- If emacs is stopped inside select, the gdb backtrace doesn't
- show the function which called select, so it is practically
- impossible to step through wait_reading_process_output. */
-
-#ifndef select
-static inline int
-select_wrapper (int n, fd_set *rfd, fd_set *wfd, fd_set *xfd, struct timeval *tmo)
-{
- return select (n, rfd, wfd, xfd, tmo);
-}
-#define select select_wrapper
-#endif
-
/* Read and dispose of subprocess output while waiting for timeout to
elapse and/or keyboard input to be available.
TIME_LIMIT is:
- timeout in seconds, or
- zero for no limit, or
- -1 means gobble data immediately available but don't wait for any.
+ timeout in seconds
+ If negative, gobble data immediately available but don't wait for any.
- MICROSECS is:
- an additional duration to wait, measured in microseconds.
- If this is nonzero and time_limit is 0, then the timeout
- consists of MICROSECS only.
+ NSECS is:
+ an additional duration to wait, measured in nanoseconds
+ If TIME_LIMIT is zero, then:
+ If NSECS == 0, there is no limit.
+ If NSECS > 0, the timeout consists of NSECS only.
+ If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
- READ_KBD is a lisp value:
+ READ_KBD is:
0 to ignore keyboard input, or
1 to return when input is available, or
-1 meaning caller will actually read the input, so don't throw to
the quit handler, or
- DO_DISPLAY != 0 means redisplay should be done to show subprocess
+ DO_DISPLAY means redisplay should be done to show subprocess
output that arrives.
If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
@@ -4286,8 +4218,8 @@ select_wrapper (int n, fd_set *rfd, fd_set *wfd, fd_set *xfd, struct timeval *tm
Otherwise, return true if we received input from any process. */
int
-wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
- int do_display,
+wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
+ bool do_display,
Lisp_Object wait_for_cell,
struct Lisp_Process *wait_proc, int just_wait_proc)
{
@@ -4301,13 +4233,14 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
EMACS_TIME timeout, end_time;
int wait_channel = -1;
int got_some_input = 0;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
FD_ZERO (&Available);
FD_ZERO (&Writeok);
- if (time_limit == 0 && microsecs == 0 && wait_proc && !NILP (Vinhibit_quit)
- && !(CONSP (wait_proc->status) && EQ (XCAR (wait_proc->status), Qexit)))
+ if (time_limit == 0 && nsecs == 0 && wait_proc && !NILP (Vinhibit_quit)
+ && !(CONSP (wait_proc->status)
+ && EQ (XCAR (wait_proc->status), Qexit)))
message ("Blocking call to accept-process-output with quit inhibited!!");
/* If wait_proc is a process to watch, set wait_channel accordingly. */
@@ -4318,13 +4251,20 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
make_number (waiting_for_user_input_p));
waiting_for_user_input_p = read_kbd;
+ if (time_limit < 0)
+ {
+ time_limit = 0;
+ nsecs = -1;
+ }
+ else if (TYPE_MAXIMUM (time_t) < time_limit)
+ time_limit = TYPE_MAXIMUM (time_t);
+
/* Since we may need to wait several times,
compute the absolute time to return at. */
- if (time_limit || microsecs)
+ if (time_limit || 0 < nsecs)
{
- EMACS_GET_TIME (end_time);
- EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
- EMACS_ADD_TIME (end_time, end_time, timeout);
+ timeout = make_emacs_time (time_limit, nsecs);
+ end_time = add_emacs_time (current_emacs_time (), timeout);
}
while (1)
@@ -4336,10 +4276,8 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
Otherwise, do pending quit if requested. */
if (read_kbd >= 0)
QUIT;
-#ifdef SYNC_INPUT
- else
+ else if (pending_signals)
process_pending_signals ();
-#endif
/* Exit now if the cell we're waiting for became non-nil. */
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
@@ -4347,24 +4285,24 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
/* Compute time from now till when time limit is up */
/* Exit if already run out */
- if (time_limit == -1)
+ if (nsecs < 0)
{
- /* -1 specified for timeout means
+ /* A negative timeout means
gobble output available now
but don't wait at all. */
- EMACS_SET_SECS_USECS (timeout, 0, 0);
+ timeout = make_emacs_time (0, 0);
}
- else if (time_limit || microsecs)
+ else if (time_limit || 0 < nsecs)
{
- EMACS_GET_TIME (timeout);
- EMACS_SUB_TIME (timeout, end_time, timeout);
- if (EMACS_TIME_NEG_P (timeout))
+ EMACS_TIME now = current_emacs_time ();
+ if (EMACS_TIME_LE (end_time, now))
break;
+ timeout = sub_emacs_time (end_time, now);
}
else
{
- EMACS_SET_SECS_USECS (timeout, 100000, 0);
+ timeout = make_emacs_time (100000, 0);
}
/* Normally we run timers here.
@@ -4378,7 +4316,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
do
{
- int old_timers_run = timers_run;
+ unsigned old_timers_run = timers_run;
struct buffer *old_buffer = current_buffer;
Lisp_Object old_window = selected_window;
@@ -4406,21 +4344,22 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
&& requeued_events_pending_p ())
break;
- if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
+ /* A negative timeout means do not wait at all. */
+ if (0 <= nsecs)
{
- EMACS_TIME difference;
- EMACS_SUB_TIME (difference, timer_delay, timeout);
- if (EMACS_TIME_NEG_P (difference))
+ if (EMACS_TIME_VALID_P (timer_delay))
{
- timeout = timer_delay;
- timeout_reduced_for_timers = 1;
+ if (EMACS_TIME_LT (timer_delay, timeout))
+ {
+ timeout = timer_delay;
+ timeout_reduced_for_timers = 1;
+ }
+ }
+ else
+ {
+ /* This is so a breakpoint can be put here. */
+ wait_reading_process_output_1 ();
}
- }
- /* If time_limit is -1, we are not going to wait at all. */
- else if (time_limit != -1)
- {
- /* This is so a breakpoint can be put here. */
- wait_reading_process_output_1 ();
}
}
@@ -4448,15 +4387,15 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
Atemp = input_wait_mask;
Ctemp = write_mask;
- EMACS_SET_SECS_USECS (timeout, 0, 0);
- if ((select (max (max_process_desc, max_input_desc) + 1,
- &Atemp,
+ timeout = make_emacs_time (0, 0);
+ if ((pselect (max (max_process_desc, max_input_desc) + 1,
+ &Atemp,
#ifdef NON_BLOCKING_CONNECT
- (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
+ (num_pending_connects > 0 ? &Ctemp : NULL),
#else
- (SELECT_TYPE *)0,
+ NULL,
#endif
- (SELECT_TYPE *)0, &timeout)
+ NULL, &timeout, NULL)
<= 0))
{
/* It's okay for us to do this and then continue with
@@ -4579,9 +4518,9 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
Vprocess_adaptive_read_buffering is nil. */
if (process_output_skip && check_delay > 0)
{
- int usecs = EMACS_USECS (timeout);
- if (EMACS_SECS (timeout) > 0 || usecs > READ_OUTPUT_DELAY_MAX)
- usecs = READ_OUTPUT_DELAY_MAX;
+ int nsecs = EMACS_NSECS (timeout);
+ if (EMACS_SECS (timeout) > 0 || nsecs > READ_OUTPUT_DELAY_MAX)
+ nsecs = READ_OUTPUT_DELAY_MAX;
for (channel = 0; check_delay > 0 && channel <= max_process_desc; channel++)
{
proc = chan_process[channel];
@@ -4596,25 +4535,26 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
continue;
FD_CLR (channel, &Available);
XPROCESS (proc)->read_output_skip = 0;
- if (XPROCESS (proc)->read_output_delay < usecs)
- usecs = XPROCESS (proc)->read_output_delay;
+ if (XPROCESS (proc)->read_output_delay < nsecs)
+ nsecs = XPROCESS (proc)->read_output_delay;
}
}
- EMACS_SET_SECS_USECS (timeout, 0, usecs);
+ timeout = make_emacs_time (0, nsecs);
process_output_skip = 0;
}
#endif
+
#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
nfds = xg_select
#elif defined (HAVE_NS)
nfds = ns_select
#else
- nfds = select
+ nfds = pselect
#endif
(max (max_process_desc, max_input_desc) + 1,
&Available,
(check_write ? &Writeok : (SELECT_TYPE *)0),
- (SELECT_TYPE *)0, &timeout);
+ NULL, &timeout, NULL);
#ifdef HAVE_GNUTLS
/* GnuTLS buffers data internally. In lowat mode it leaves
@@ -4672,8 +4612,8 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
/* If we woke up due to SIGWINCH, actually change size now. */
do_pending_window_change (0);
- if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
- /* We wanted the full specified time, so return now. */
+ if ((time_limit || nsecs) && nfds == 0 && ! timeout_reduced_for_timers)
+ /* We waited the full specified time, so return now. */
break;
if (nfds < 0)
{
@@ -4691,7 +4631,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
Cleanup occurs c/o status_notify after SIGCLD. */
no_avail = 1; /* Cannot depend on values returned */
#else
- abort ();
+ emacs_abort ();
#endif
}
else
@@ -4704,28 +4644,13 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
check_write = 0;
}
-#if 0 /* When polling is used, interrupt_input is 0,
- so get_input_pending should read the input.
- So this should not be needed. */
- /* If we are using polling for input,
- and we see input available, make it get read now.
- Otherwise it might not actually get read for a second.
- And on hpux, since we turn off polling in wait_reading_process_output,
- it might never get read at all if we don't spend much time
- outside of wait_reading_process_output. */
- if (read_kbd && interrupt_input
- && keyboard_bit_set (&Available)
- && input_polling_used ())
- kill (getpid (), SIGALRM);
-#endif
-
/* Check for keyboard input */
/* If there is any, return immediately
to give it higher priority than subprocesses */
if (read_kbd != 0)
{
- int old_timers_run = timers_run;
+ unsigned old_timers_run = timers_run;
struct buffer *old_buffer = current_buffer;
Lisp_Object old_window = selected_window;
int leave = 0;
@@ -4774,7 +4699,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
-#ifdef SIGIO
+#ifdef USABLE_SIGIO
/* If we think we have keyboard input waiting, but didn't get SIGIO,
go read it. This can happen with X on BSD after logging out.
In that case, there really is no input and no SIGIO,
@@ -4782,7 +4707,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
if (read_kbd && interrupt_input
&& keyboard_bit_set (&Available) && ! noninteractive)
- kill (getpid (), SIGIO);
+ handle_input_available_signal (SIGIO);
#endif
if (! wait_proc)
@@ -4800,15 +4725,13 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
for (channel = 0; channel <= max_input_desc; ++channel)
{
struct fd_callback_data *d = &fd_callback_info[channel];
- if (FD_ISSET (channel, &Available)
- && d->func != 0
- && (d->condition & FOR_READ) != 0)
- d->func (channel, d->data, 1);
- if (FD_ISSET (channel, &write_mask)
- && d->func != 0
- && (d->condition & FOR_WRITE) != 0)
- d->func (channel, d->data, 0);
- }
+ if (d->func
+ && ((d->condition & FOR_READ
+ && FD_ISSET (channel, &Available))
+ || (d->condition & FOR_WRITE
+ && FD_ISSET (channel, &write_mask))))
+ d->func (channel, d->data);
+ }
for (channel = 0; channel <= max_process_desc; channel++)
{
@@ -4824,7 +4747,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
if (wait_channel == channel)
{
wait_channel = -1;
- time_limit = -1;
+ nsecs = -1;
got_some_input = 1;
}
proc = chan_process[channel];
@@ -4857,23 +4780,17 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
else if (nread == -1 && errno == EWOULDBLOCK)
;
#endif
- /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
- and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
-#ifdef O_NONBLOCK
- else if (nread == -1 && errno == EAGAIN)
- ;
-#else
-#ifdef O_NDELAY
else if (nread == -1 && errno == EAGAIN)
;
+#ifdef WINDOWSNT
+ /* FIXME: Is this special case still needed? */
/* Note that we cannot distinguish between no input
available now and a closed pipe.
With luck, a closed pipe will be accompanied by
subprocess termination and SIGCHLD. */
else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
;
-#endif /* O_NDELAY */
-#endif /* O_NONBLOCK */
+#endif
#ifdef HAVE_PTYS
/* On some OSs with ptys, when the process on one end of
a pty exits, the other end gets an error reading with
@@ -4888,15 +4805,27 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
It can't hurt. */
else if (nread == -1 && errno == EIO)
{
- /* Clear the descriptor now, so we only raise the signal once. */
+ struct Lisp_Process *p = XPROCESS (proc);
+
+ /* Clear the descriptor now, so we only raise the
+ signal once. */
FD_CLR (channel, &input_wait_mask);
FD_CLR (channel, &non_keyboard_wait_mask);
- kill (getpid (), SIGCHLD);
+ if (p->pid == -2)
+ {
+ /* If the EIO occurs on a pty, the SIGCHLD handler's
+ waitpid call will not find the process object to
+ delete. Do it here. */
+ p->tick = ++process_tick;
+ pset_status (p, Qfailed);
+ }
+ else
+ handle_child_signal (SIGCHLD);
}
#endif /* HAVE_PTYS */
- /* If we can detect process termination, don't consider the process
- gone just because its pipe is closed. */
+ /* If we can detect process termination, don't consider the
+ process gone just because its pipe is closed. */
#ifdef SIGCHLD
else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
;
@@ -4909,8 +4838,8 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
if (XPROCESS (proc)->raw_status_new)
update_status (XPROCESS (proc));
if (EQ (XPROCESS (proc)->status, Qrun))
- XPROCESS (proc)->status
- = Fcons (Qexit, Fcons (make_number (256), Qnil));
+ pset_status (XPROCESS (proc),
+ list2 (Qexit, make_number (256)));
}
}
#ifdef NON_BLOCKING_CONNECT
@@ -4922,7 +4851,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
FD_CLR (channel, &connect_wait_mask);
FD_CLR (channel, &write_mask);
if (--num_pending_connects < 0)
- abort ();
+ emacs_abort ();
proc = chan_process[channel];
if (NILP (proc))
@@ -4958,12 +4887,12 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
if (xerrno)
{
p->tick = ++process_tick;
- p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil));
+ pset_status (p, list2 (Qfailed, make_number (xerrno)));
deactivate_process (proc);
}
else
{
- p->status = Qrun;
+ pset_status (p, Qrun);
/* Execute the sentinel here. If we had relied on
status_notify to do it later, it will read input
from the process before calling the sentinel. */
@@ -5030,14 +4959,14 @@ read_process_output (Lisp_Object proc, register int channel)
char *chars;
register Lisp_Object outstream;
register struct Lisp_Process *p = XPROCESS (proc);
- register EMACS_INT opoint;
+ register ptrdiff_t opoint;
struct coding_system *coding = proc_decode_coding_system[channel];
int carryover = p->decoding_carryover;
int readmax = 4096;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object odeactivate;
- chars = (char *) alloca (carryover + readmax);
+ chars = alloca (carryover + readmax);
if (carryover)
/* See the comment above. */
memcpy (chars, SDATA (p->decoding_buf), carryover);
@@ -5060,9 +4989,8 @@ read_process_output (Lisp_Object proc, register int channel)
proc_buffered_char[channel] = -1;
}
#ifdef HAVE_GNUTLS
- if (XPROCESS (proc)->gnutls_p)
- nbytes = emacs_gnutls_read (XPROCESS (proc),
- chars + carryover + buffered,
+ if (p->gnutls_p)
+ nbytes = emacs_gnutls_read (p, chars + carryover + buffered,
readmax - buffered);
else
#endif
@@ -5117,14 +5045,14 @@ read_process_output (Lisp_Object proc, register int channel)
/* There's no good reason to let process filters change the current
buffer, and many callers of accept-process-output, sit-for, and
friends don't expect current-buffer to be changed from under them. */
- record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
/* Read and dispose of the process output. */
outstream = p->filter;
if (!NILP (outstream))
{
Lisp_Object text;
- int outer_running_asynch_code = running_asynch_code;
+ bool outer_running_asynch_code = running_asynch_code;
int waiting = waiting_for_user_input_p;
/* No need to gcpro these, because all we do with them later
@@ -5164,7 +5092,7 @@ read_process_output (Lisp_Object proc, register int channel)
/* A new coding system might be found. */
if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
{
- p->decode_coding_system = Vlast_coding_system_used;
+ pset_decode_coding_system (p, Vlast_coding_system_used);
/* Don't call setup_coding_system for
proc_decode_coding_system[channel] here. It is done in
@@ -5180,8 +5108,8 @@ read_process_output (Lisp_Object proc, register int channel)
if (NILP (p->encode_coding_system)
&& proc_encode_coding_system[p->outfd])
{
- p->encode_coding_system
- = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
+ pset_encode_coding_system
+ (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
setup_coding_system (p->encode_coding_system,
proc_encode_coding_system[p->outfd]);
}
@@ -5190,7 +5118,7 @@ read_process_output (Lisp_Object proc, register int channel)
if (coding->carryover_bytes > 0)
{
if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
- p->decoding_buf = make_uninit_string (coding->carryover_bytes);
+ pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
memcpy (SDATA (p->decoding_buf), coding->carryover,
coding->carryover_bytes);
p->decoding_carryover = coding->carryover_bytes;
@@ -5227,13 +5155,13 @@ read_process_output (Lisp_Object proc, register int channel)
}
/* If no filter, write into buffer if it isn't dead. */
- else if (!NILP (p->buffer) && !NILP (BVAR (XBUFFER (p->buffer), name)))
+ else if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
{
Lisp_Object old_read_only;
- EMACS_INT old_begv, old_zv;
- EMACS_INT old_begv_byte, old_zv_byte;
- EMACS_INT before, before_byte;
- EMACS_INT opoint_byte;
+ ptrdiff_t old_begv, old_zv;
+ ptrdiff_t old_begv_byte, old_zv_byte;
+ ptrdiff_t before, before_byte;
+ ptrdiff_t opoint_byte;
Lisp_Object text;
struct buffer *b;
@@ -5246,14 +5174,16 @@ read_process_output (Lisp_Object proc, register int channel)
old_begv_byte = BEGV_BYTE;
old_zv_byte = ZV_BYTE;
- BVAR (current_buffer, read_only) = Qnil;
+ bset_read_only (current_buffer, Qnil);
/* Insert new output into buffer
at the current end-of-output marker,
thus preserving logical ordering of input and output. */
if (XMARKER (p->mark)->buffer)
- SET_PT_BOTH (clip_to_bounds (BEGV, marker_position (p->mark), ZV),
- clip_to_bounds (BEGV_BYTE, marker_byte_position (p->mark),
+ SET_PT_BOTH (clip_to_bounds (BEGV,
+ marker_position (p->mark), ZV),
+ clip_to_bounds (BEGV_BYTE,
+ marker_byte_position (p->mark),
ZV_BYTE));
else
SET_PT_BOTH (ZV, ZV_BYTE);
@@ -5272,12 +5202,12 @@ read_process_output (Lisp_Object proc, register int channel)
similar code in the previous `if' block. */
if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
{
- p->decode_coding_system = Vlast_coding_system_used;
+ pset_decode_coding_system (p, Vlast_coding_system_used);
if (NILP (p->encode_coding_system)
&& proc_encode_coding_system[p->outfd])
{
- p->encode_coding_system
- = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
+ pset_encode_coding_system
+ (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
setup_coding_system (p->encode_coding_system,
proc_encode_coding_system[p->outfd]);
}
@@ -5285,7 +5215,7 @@ read_process_output (Lisp_Object proc, register int channel)
if (coding->carryover_bytes > 0)
{
if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
- p->decoding_buf = make_uninit_string (coding->carryover_bytes);
+ pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
memcpy (SDATA (p->decoding_buf), coding->carryover,
coding->carryover_bytes);
p->decoding_carryover = coding->carryover_bytes;
@@ -5335,7 +5265,7 @@ read_process_output (Lisp_Object proc, register int channel)
Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
- BVAR (current_buffer, read_only) = old_read_only;
+ bset_read_only (current_buffer, old_read_only);
SET_PT_BOTH (opoint, opoint_byte);
}
/* Handling the process output should not deactivate the mark. */
@@ -5347,19 +5277,76 @@ read_process_output (Lisp_Object proc, register int channel)
/* Sending data to subprocess */
-static jmp_buf send_process_frame;
-static Lisp_Object process_sent_to;
+/* In send_process, when a write fails temporarily,
+ wait_reading_process_output is called. It may execute user code,
+ e.g. timers, that attempts to write new data to the same process.
+ We must ensure that data is sent in the right order, and not
+ interspersed half-completed with other writes (Bug#10815). This is
+ handled by the write_queue element of struct process. It is a list
+ with each entry having the form
-#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD
-static void send_process_trap (int) NO_RETURN;
-#endif
+ (string . (offset . length))
+
+ where STRING is a lisp string, OFFSET is the offset into the
+ string's byte sequence from which we should begin to send, and
+ LENGTH is the number of bytes left to send. */
+
+/* Create a new entry in write_queue.
+ INPUT_OBJ should be a buffer, string Qt, or Qnil.
+ BUF is a pointer to the string sequence of the input_obj or a C
+ string in case of Qt or Qnil. */
static void
-send_process_trap (int ignore)
+write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
+ const char *buf, ptrdiff_t len, int front)
{
- SIGNAL_THREAD_CHECK (SIGPIPE);
- sigunblock (sigmask (SIGPIPE));
- longjmp (send_process_frame, 1);
+ ptrdiff_t offset;
+ Lisp_Object entry, obj;
+
+ if (STRINGP (input_obj))
+ {
+ offset = buf - SSDATA (input_obj);
+ obj = input_obj;
+ }
+ else
+ {
+ offset = 0;
+ obj = make_unibyte_string (buf, len);
+ }
+
+ entry = Fcons (obj, Fcons (make_number (offset), make_number (len)));
+
+ if (front)
+ pset_write_queue (p, Fcons (entry, p->write_queue));
+ else
+ pset_write_queue (p, nconc2 (p->write_queue, Fcons (entry, Qnil)));
+}
+
+/* Remove the first element in the write_queue of process P, put its
+ contents in OBJ, BUF and LEN, and return non-zero. If the
+ write_queue is empty, return zero. */
+
+static int
+write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj,
+ const char **buf, ptrdiff_t *len)
+{
+ Lisp_Object entry, offset_length;
+ ptrdiff_t offset;
+
+ if (NILP (p->write_queue))
+ return 0;
+
+ entry = XCAR (p->write_queue);
+ pset_write_queue (p, XCDR (p->write_queue));
+
+ *obj = XCAR (entry);
+ offset_length = XCDR (entry);
+
+ *len = XINT (XCDR (offset_length));
+ offset = XINT (XCAR (offset_length));
+ *buf = SSDATA (*obj) + offset;
+
+ return 1;
}
/* Send some data to process PROC.
@@ -5373,17 +5360,12 @@ send_process_trap (int ignore)
This function can evaluate Lisp code and can garbage collect. */
static void
-send_process (volatile Lisp_Object proc, const char *volatile buf,
- volatile EMACS_INT len, volatile Lisp_Object object)
+send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
+ Lisp_Object object)
{
- /* Use volatile to protect variables from being clobbered by longjmp. */
struct Lisp_Process *p = XPROCESS (proc);
ssize_t rv;
struct coding_system *coding;
- struct gcpro gcpro1;
- void (*volatile old_sigpipe) (int);
-
- GCPRO1 (object);
if (p->raw_status_new)
update_status (p);
@@ -5400,8 +5382,8 @@ send_process (volatile Lisp_Object proc, const char *volatile buf,
&& !NILP (BVAR (XBUFFER (object), enable_multibyte_characters)))
|| EQ (object, Qt))
{
- p->encode_coding_system
- = complement_process_encoding_system (p->encode_coding_system);
+ pset_encode_coding_system
+ (p, complement_process_encoding_system (p->encode_coding_system));
if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
{
/* The coding system for encoding was changed to raw-text
@@ -5445,8 +5427,8 @@ send_process (volatile Lisp_Object proc, const char *volatile buf,
coding->dst_object = Qt;
if (BUFFERP (object))
{
- EMACS_INT from_byte, from, to;
- EMACS_INT save_pt, save_pt_byte;
+ ptrdiff_t from_byte, from, to;
+ ptrdiff_t save_pt, save_pt_byte;
struct buffer *cur = current_buffer;
set_buffer_internal (XBUFFER (object));
@@ -5477,159 +5459,126 @@ send_process (volatile Lisp_Object proc, const char *volatile buf,
buf = SSDATA (object);
}
- if (pty_max_bytes == 0)
- {
-#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
- pty_max_bytes = fpathconf (p->outfd, _PC_MAX_CANON);
- if (pty_max_bytes < 0)
- pty_max_bytes = 250;
-#else
- pty_max_bytes = 250;
-#endif
- /* Deduct one, to leave space for the eof. */
- pty_max_bytes--;
- }
+ /* If there is already data in the write_queue, put the new data
+ in the back of queue. Otherwise, ignore it. */
+ if (!NILP (p->write_queue))
+ write_queue_push (p, object, buf, len, 0);
- /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
- CFLAGS="-g -O": The value of the parameter `proc' is clobbered
- when returning with longjmp despite being declared volatile. */
- if (!setjmp (send_process_frame))
+ do /* while !NILP (p->write_queue) */
{
- p = XPROCESS (proc); /* Repair any setjmp clobbering. */
+ ptrdiff_t cur_len = -1;
+ const char *cur_buf;
+ Lisp_Object cur_object;
- process_sent_to = proc;
- while (len > 0)
+ /* If write_queue is empty, ignore it. */
+ if (!write_queue_pop (p, &cur_object, &cur_buf, &cur_len))
{
- EMACS_INT this = len;
+ cur_len = len;
+ cur_buf = buf;
+ cur_object = object;
+ }
+ while (cur_len > 0)
+ {
/* Send this batch, using one or more write calls. */
- while (this > 0)
- {
- EMACS_INT written = 0;
- int outfd = p->outfd;
- old_sigpipe = (void (*) (int)) signal (SIGPIPE, send_process_trap);
+ ptrdiff_t written = 0;
+ int outfd = p->outfd;
#ifdef DATAGRAM_SOCKETS
- if (DATAGRAM_CHAN_P (outfd))
- {
- rv = sendto (outfd, buf, this,
- 0, datagram_address[outfd].sa,
- datagram_address[outfd].len);
- if (0 <= rv)
- written = rv;
- else if (errno == EMSGSIZE)
- {
- signal (SIGPIPE, old_sigpipe);
- report_file_error ("sending datagram",
- Fcons (proc, Qnil));
- }
- }
- else
+ if (DATAGRAM_CHAN_P (outfd))
+ {
+ rv = sendto (outfd, cur_buf, cur_len,
+ 0, datagram_address[outfd].sa,
+ datagram_address[outfd].len);
+ if (0 <= rv)
+ written = rv;
+ else if (errno == EMSGSIZE)
+ report_file_error ("sending datagram", Fcons (proc, Qnil));
+ }
+ else
#endif
- {
+ {
#ifdef HAVE_GNUTLS
- if (XPROCESS (proc)->gnutls_p)
- written = emacs_gnutls_write (XPROCESS (proc),
- buf, this);
- else
+ if (p->gnutls_p)
+ written = emacs_gnutls_write (p, cur_buf, cur_len);
+ else
#endif
- written = emacs_write (outfd, buf, this);
- rv = (written ? 0 : -1);
+ written = emacs_write (outfd, cur_buf, cur_len);
+ rv = (written ? 0 : -1);
#ifdef ADAPTIVE_READ_BUFFERING
- if (p->read_output_delay > 0
- && p->adaptive_read_buffering == 1)
- {
- p->read_output_delay = 0;
- process_output_delay_count--;
- p->read_output_skip = 0;
- }
-#endif
+ if (p->read_output_delay > 0
+ && p->adaptive_read_buffering == 1)
+ {
+ p->read_output_delay = 0;
+ process_output_delay_count--;
+ p->read_output_skip = 0;
}
- signal (SIGPIPE, old_sigpipe);
+#endif
+ }
- if (rv < 0)
- {
- if (0
+ if (rv < 0)
+ {
+ if (0
#ifdef EWOULDBLOCK
- || errno == EWOULDBLOCK
+ || errno == EWOULDBLOCK
#endif
#ifdef EAGAIN
- || errno == EAGAIN
+ || errno == EAGAIN
#endif
- )
- /* Buffer is full. Wait, accepting input;
- that may allow the program
- to finish doing output and read more. */
- {
- EMACS_INT offset = 0;
-
+ )
+ /* Buffer is full. Wait, accepting input;
+ that may allow the program
+ to finish doing output and read more. */
+ {
#ifdef BROKEN_PTY_READ_AFTER_EAGAIN
- /* A gross hack to work around a bug in FreeBSD.
- In the following sequence, read(2) returns
- bogus data:
-
- write(2) 1022 bytes
- write(2) 954 bytes, get EAGAIN
- read(2) 1024 bytes in process_read_output
- read(2) 11 bytes in process_read_output
-
- That is, read(2) returns more bytes than have
- ever been written successfully. The 1033 bytes
- read are the 1022 bytes written successfully
- after processing (for example with CRs added if
- the terminal is set up that way which it is
- here). The same bytes will be seen again in a
- later read(2), without the CRs. */
-
- if (errno == EAGAIN)
- {
- int flags = FWRITE;
- ioctl (p->outfd, TIOCFLUSH, &flags);
- }
+ /* A gross hack to work around a bug in FreeBSD.
+ In the following sequence, read(2) returns
+ bogus data:
+
+ write(2) 1022 bytes
+ write(2) 954 bytes, get EAGAIN
+ read(2) 1024 bytes in process_read_output
+ read(2) 11 bytes in process_read_output
+
+ That is, read(2) returns more bytes than have
+ ever been written successfully. The 1033 bytes
+ read are the 1022 bytes written successfully
+ after processing (for example with CRs added if
+ the terminal is set up that way which it is
+ here). The same bytes will be seen again in a
+ later read(2), without the CRs. */
+
+ if (errno == EAGAIN)
+ {
+ int flags = FWRITE;
+ ioctl (p->outfd, TIOCFLUSH, &flags);
+ }
#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
- /* Running filters might relocate buffers or strings.
- Arrange to relocate BUF. */
- if (BUFFERP (object))
- offset = BUF_PTR_BYTE_POS (XBUFFER (object),
- (unsigned char *) buf);
- else if (STRINGP (object))
- offset = buf - SSDATA (object);
-
-#ifdef EMACS_HAS_USECS
- wait_reading_process_output (0, 20000, 0, 0, Qnil, NULL, 0);
-#else
- wait_reading_process_output (1, 0, 0, 0, Qnil, NULL, 0);
-#endif
-
- if (BUFFERP (object))
- buf = (char *) BUF_BYTE_ADDRESS (XBUFFER (object),
- offset);
- else if (STRINGP (object))
- buf = offset + SSDATA (object);
- }
- else
- /* This is a real error. */
- report_file_error ("writing to process", Fcons (proc, Qnil));
+ /* Put what we should have written in wait_queue. */
+ write_queue_push (p, cur_object, cur_buf, cur_len, 1);
+ wait_reading_process_output (0, 20 * 1000 * 1000,
+ 0, 0, Qnil, NULL, 0);
+ /* Reread queue, to see what is left. */
+ break;
+ }
+ else if (errno == EPIPE)
+ {
+ p->raw_status_new = 0;
+ pset_status (p, list2 (Qexit, make_number (256)));
+ p->tick = ++process_tick;
+ deactivate_process (proc);
+ error ("process %s no longer connected to pipe; closed it",
+ SDATA (p->name));
}
- buf += written;
- len -= written;
- this -= written;
+ else
+ /* This is a real error. */
+ report_file_error ("writing to process", Fcons (proc, Qnil));
}
+ cur_buf += written;
+ cur_len -= written;
}
}
- else
- {
- signal (SIGPIPE, old_sigpipe);
- proc = process_sent_to;
- p = XPROCESS (proc);
- p->raw_status_new = 0;
- p->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
- p->tick = ++process_tick;
- deactivate_process (proc);
- error ("SIGPIPE raised on process %s; closed it", SDATA (p->name));
- }
-
- UNGCPRO;
+ while (!NILP (p->write_queue));
}
DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
@@ -5644,7 +5593,7 @@ Output from processes can arrive in between bunches. */)
(Lisp_Object process, Lisp_Object start, Lisp_Object end)
{
Lisp_Object proc;
- EMACS_INT start1, end1;
+ ptrdiff_t start1, end1;
proc = get_process (process);
validate_region (&start, &end);
@@ -5680,10 +5629,10 @@ Output from processes can arrive in between bunches. */)
/* Return the foreground process group for the tty/pty that
the process P uses. */
-static int
+static pid_t
emacs_get_tty_pgrp (struct Lisp_Process *p)
{
- int gid = -1;
+ pid_t gid = -1;
#ifdef TIOCGPGRP
if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
@@ -5713,7 +5662,7 @@ return t unconditionally. */)
{
/* Initialize in case ioctl doesn't exist or gives an error,
in a way that will cause returning t. */
- int gid;
+ pid_t gid;
Lisp_Object proc;
struct Lisp_Process *p;
@@ -5754,7 +5703,7 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
{
Lisp_Object proc;
register struct Lisp_Process *p;
- int gid;
+ pid_t gid;
int no_pgrp = 0;
proc = get_process (process);
@@ -5854,7 +5803,7 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
#ifdef SIGCONT
case SIGCONT:
p->raw_status_new = 0;
- p->status = Qrun;
+ pset_status (p, Qrun);
p->tick = ++process_tick;
if (!nomsg)
{
@@ -5950,7 +5899,7 @@ traffic. */)
FD_CLR (p->infd, &input_wait_mask);
FD_CLR (p->infd, &non_keyboard_wait_mask);
}
- p->command = Qt;
+ pset_command (p, Qt);
return process;
}
#ifndef SIGTSTP
@@ -5986,7 +5935,7 @@ traffic. */)
tcflush (p->infd, TCIFLUSH);
#endif /* not WINDOWSNT */
}
- p->command = Qnil;
+ pset_command (p, Qnil);
return process;
}
#ifdef SIGCONT
@@ -6008,48 +5957,40 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */)
{
pid_t pid;
- if (INTEGERP (process))
- {
- pid = XINT (process);
- goto got_it;
- }
-
- if (FLOATP (process))
- {
- pid = (pid_t) XFLOAT_DATA (process);
- goto got_it;
- }
-
if (STRINGP (process))
{
- Lisp_Object tem;
- if (tem = Fget_process (process), NILP (tem))
+ Lisp_Object tem = Fget_process (process);
+ if (NILP (tem))
{
- pid = XINT (Fstring_to_number (process, make_number (10)));
- if (pid > 0)
- goto got_it;
+ Lisp_Object process_number =
+ string_to_number (SSDATA (process), 10, 1);
+ if (INTEGERP (process_number) || FLOATP (process_number))
+ tem = process_number;
}
process = tem;
}
- else
+ else if (!NUMBERP (process))
process = get_process (process);
if (NILP (process))
return process;
- CHECK_PROCESS (process);
- pid = XPROCESS (process)->pid;
- if (pid <= 0)
- error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
-
- got_it:
+ if (NUMBERP (process))
+ CONS_TO_INTEGER (process, pid_t, pid);
+ else
+ {
+ CHECK_PROCESS (process);
+ pid = XPROCESS (process)->pid;
+ if (pid <= 0)
+ error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
+ }
#define parse_signal(NAME, VALUE) \
else if (!xstrcasecmp (name, NAME)) \
XSETINT (sigcode, VALUE)
if (INTEGERP (sigcode))
- ;
+ CHECK_TYPE_RANGED_INTEGER (int, sigcode);
else
{
char *name;
@@ -6068,39 +6009,27 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */)
#ifdef SIGUSR2
parse_signal ("usr2", SIGUSR2);
#endif
-#ifdef SIGTERM
parse_signal ("term", SIGTERM);
-#endif
#ifdef SIGHUP
parse_signal ("hup", SIGHUP);
#endif
-#ifdef SIGINT
parse_signal ("int", SIGINT);
-#endif
#ifdef SIGQUIT
parse_signal ("quit", SIGQUIT);
#endif
-#ifdef SIGILL
parse_signal ("ill", SIGILL);
-#endif
-#ifdef SIGABRT
parse_signal ("abrt", SIGABRT);
-#endif
#ifdef SIGEMT
parse_signal ("emt", SIGEMT);
#endif
#ifdef SIGKILL
parse_signal ("kill", SIGKILL);
#endif
-#ifdef SIGFPE
parse_signal ("fpe", SIGFPE);
-#endif
#ifdef SIGBUS
parse_signal ("bus", SIGBUS);
#endif
-#ifdef SIGSEGV
parse_signal ("segv", SIGSEGV);
-#endif
#ifdef SIGSYS
parse_signal ("sys", SIGSYS);
#endif
@@ -6224,15 +6153,14 @@ process has been transmitted to the serial port. */)
#endif /* not HAVE_SHUTDOWN */
new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
if (new_outfd < 0)
- abort ();
+ emacs_abort ();
old_outfd = XPROCESS (proc)->outfd;
if (!proc_encode_coding_system[new_outfd])
proc_encode_coding_system[new_outfd]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- memcpy (proc_encode_coding_system[new_outfd],
- proc_encode_coding_system[old_outfd],
- sizeof (struct coding_system));
+ = xmalloc (sizeof (struct coding_system));
+ *proc_encode_coding_system[new_outfd]
+ = *proc_encode_coding_system[old_outfd];
memset (proc_encode_coding_system[old_outfd], 0,
sizeof (struct coding_system));
@@ -6241,9 +6169,35 @@ process has been transmitted to the serial port. */)
return process;
}
-/* On receipt of a signal that a child status has changed, loop asking
- about children with changed statuses until the system says there
- are no more.
+/* If the status of the process DESIRED has changed, return true and
+ set *STATUS to its exit status; otherwise, return false.
+ If HAVE is nonnegative, assume that HAVE = waitpid (HAVE, STATUS, ...)
+ has already been invoked, and do not invoke waitpid again. */
+
+static bool
+process_status_retrieved (pid_t desired, pid_t have, int *status)
+{
+ if (have < 0)
+ {
+ /* Invoke waitpid only with a known process ID; do not invoke
+ waitpid with a nonpositive argument. Otherwise, Emacs might
+ reap an unwanted process by mistake. For example, invoking
+ waitpid (-1, ...) can mess up glib by reaping glib's subprocesses,
+ so that another thread running glib won't find them. */
+ do
+ have = waitpid (desired, status, WNOHANG | WUNTRACED);
+ while (have < 0 && errno == EINTR);
+ }
+
+ return have == desired;
+}
+
+/* If PID is nonnegative, the child process PID with wait status W has
+ changed its status; record this and return true.
+
+ If PID is negative, ignore W, and look for known child processes
+ of Emacs whose status have changed. For each one found, record its new
+ status.
All we do is change the status; we do not run sentinels or print
notifications. That is saved for the next time keyboard input is
@@ -6266,151 +6220,122 @@ process has been transmitted to the serial port. */)
** Malloc WARNING: This should never call malloc either directly or
indirectly; if it does, that is a bug */
-#ifdef SIGCHLD
-static void
-sigchld_handler (int signo)
+void
+record_child_status_change (pid_t pid, int w)
{
- int old_errno = errno;
- Lisp_Object proc;
- struct Lisp_Process *p;
-
- SIGNAL_THREAD_CHECK (signo);
-
- while (1)
- {
- pid_t pid;
- int w;
- Lisp_Object tail;
-
-#ifdef WNOHANG
-#ifndef WUNTRACED
-#define WUNTRACED 0
-#endif /* no WUNTRACED */
- /* Keep trying to get a status until we get a definitive result. */
- do
- {
- errno = 0;
- pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
- }
- while (pid < 0 && errno == EINTR);
+#ifdef SIGCHLD
- if (pid <= 0)
- {
- /* PID == 0 means no processes found, PID == -1 means a real
- failure. We have done all our job, so return. */
+ /* Record at most one child only if we already know one child that
+ has exited. */
+ bool record_at_most_one_child = 0 <= pid;
- errno = old_errno;
- return;
- }
-#else
- pid = wait (&w);
-#endif /* no WNOHANG */
+ Lisp_Object tail;
- /* Find the process that signaled us, and record its status. */
+ /* Find the process that signaled us, and record its status. */
- /* The process can have been deleted by Fdelete_process. */
- for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
+ /* The process can have been deleted by Fdelete_process. */
+ for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
+ {
+ bool all_pids_are_fixnums
+ = (MOST_NEGATIVE_FIXNUM <= TYPE_MINIMUM (pid_t)
+ && TYPE_MAXIMUM (pid_t) <= MOST_POSITIVE_FIXNUM);
+ Lisp_Object xpid = XCAR (tail);
+ if (all_pids_are_fixnums ? INTEGERP (xpid) : NUMBERP (xpid))
{
- Lisp_Object xpid = XCAR (tail);
- if ((INTEGERP (xpid) && pid == (pid_t) XINT (xpid))
- || (FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid)))
+ pid_t deleted_pid;
+ if (INTEGERP (xpid))
+ deleted_pid = XINT (xpid);
+ else
+ deleted_pid = XFLOAT_DATA (xpid);
+ if (process_status_retrieved (deleted_pid, pid, &w))
{
XSETCAR (tail, Qnil);
- goto sigchld_end_of_loop;
+ if (record_at_most_one_child)
+ return;
}
}
+ }
- /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
- p = 0;
- for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
- {
- proc = XCDR (XCAR (tail));
- p = XPROCESS (proc);
- if (EQ (p->type, Qreal) && p->pid == pid)
- break;
- p = 0;
- }
-
- /* Look for an asynchronous process whose pid hasn't been filled
- in yet. */
- if (p == 0)
- for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
- {
- proc = XCDR (XCAR (tail));
- p = XPROCESS (proc);
- if (p->pid == -1)
- break;
- p = 0;
- }
-
- /* Change the status of the process that was found. */
- if (p != 0)
+ /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
+ for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
+ {
+ Lisp_Object proc = XCDR (XCAR (tail));
+ struct Lisp_Process *p = XPROCESS (proc);
+ if (p->alive && process_status_retrieved (p->pid, pid, &w))
{
- int clear_desc_flag = 0;
-
+ /* Change the status of the process that was found. */
p->tick = ++process_tick;
p->raw_status = w;
p->raw_status_new = 1;
/* If process has terminated, stop waiting for its output. */
- if ((WIFSIGNALED (w) || WIFEXITED (w))
- && p->infd >= 0)
- clear_desc_flag = 1;
-
- /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
- if (clear_desc_flag)
+ if (WIFSIGNALED (w) || WIFEXITED (w))
{
- FD_CLR (p->infd, &input_wait_mask);
- FD_CLR (p->infd, &non_keyboard_wait_mask);
+ int clear_desc_flag = 0;
+ p->alive = 0;
+ if (p->infd >= 0)
+ clear_desc_flag = 1;
+
+ /* clear_desc_flag avoids a compiler bug in Microsoft C. */
+ if (clear_desc_flag)
+ {
+ FD_CLR (p->infd, &input_wait_mask);
+ FD_CLR (p->infd, &non_keyboard_wait_mask);
+ }
}
/* Tell wait_reading_process_output that it needs to wake up and
look around. */
if (input_available_clear_time)
- EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
+ *input_available_clear_time = make_emacs_time (0, 0);
+
+ if (record_at_most_one_child)
+ return;
}
+ }
- /* There was no asynchronous process found for that pid: we have
- a synchronous process. */
- else
- {
- synch_process_alive = 0;
+ if (0 <= pid)
+ {
+ /* The caller successfully waited for a pid but no asynchronous
+ process was found for it, so this is a synchronous process. */
- /* Report the status of the synchronous process. */
- if (WIFEXITED (w))
- synch_process_retcode = WRETCODE (w);
- else if (WIFSIGNALED (w))
- synch_process_termsig = WTERMSIG (w);
+ synch_process_alive = 0;
- /* Tell wait_reading_process_output that it needs to wake up and
- look around. */
- if (input_available_clear_time)
- EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
- }
+ /* Report the status of the synchronous process. */
+ if (WIFEXITED (w))
+ synch_process_retcode = WEXITSTATUS (w);
+ else if (WIFSIGNALED (w))
+ synch_process_termsig = WTERMSIG (w);
- sigchld_end_of_loop:
- ;
-
- /* On some systems, we must return right away.
- If any more processes want to signal us, we will
- get another signal.
- Otherwise (on systems that have WNOHANG), loop around
- to use up all the processes that have something to tell us. */
-#if (defined WINDOWSNT \
- || (defined USG && !defined GNU_LINUX \
- && !(defined HPUX && defined WNOHANG)))
- errno = old_errno;
- return;
-#endif /* USG, but not HPUX with WNOHANG */
+ /* Tell wait_reading_process_output that it needs to wake up and
+ look around. */
+ if (input_available_clear_time)
+ *input_available_clear_time = make_emacs_time (0, 0);
}
+#endif
}
+
+#ifdef SIGCHLD
+
+static void
+handle_child_signal (int sig)
+{
+ record_child_status_change (-1, 0);
+}
+
+static void
+deliver_child_signal (int sig)
+{
+ deliver_process_signal (sig, handle_child_signal);
+}
+
#endif /* SIGCHLD */
static Lisp_Object
exec_sentinel_unwind (Lisp_Object data)
{
- XPROCESS (XCAR (data))->sentinel = XCDR (data);
+ pset_sentinel (XPROCESS (XCAR (data)), XCDR (data));
return Qnil;
}
@@ -6428,9 +6353,9 @@ static void
exec_sentinel (Lisp_Object proc, Lisp_Object reason)
{
Lisp_Object sentinel, odeactivate;
- register struct Lisp_Process *p = XPROCESS (proc);
- int count = SPECPDL_INDEX ();
- int outer_running_asynch_code = running_asynch_code;
+ struct Lisp_Process *p = XPROCESS (proc);
+ ptrdiff_t count = SPECPDL_INDEX ();
+ bool outer_running_asynch_code = running_asynch_code;
int waiting = waiting_for_user_input_p;
if (inhibit_sentinels)
@@ -6448,7 +6373,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason)
/* There's no good reason to let sentinels change the current
buffer, and many callers of accept-process-output, sit-for, and
friends don't expect current-buffer to be changed from under them. */
- record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
sentinel = p->sentinel;
if (NILP (sentinel))
@@ -6456,7 +6381,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason)
/* Zilch the sentinel while it's running, to avoid recursive invocations;
assure that it gets restored no matter how the sentinel exits. */
- p->sentinel = Qnil;
+ pset_sentinel (p, Qnil);
record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
/* Inhibit quit so that random quits don't screw up a running filter. */
specbind (Qinhibit_quit, Qt);
@@ -6588,12 +6513,12 @@ status_notify (struct Lisp_Process *deleting_process)
{
Lisp_Object tem;
struct buffer *old = current_buffer;
- EMACS_INT opoint, opoint_byte;
- EMACS_INT before, before_byte;
+ ptrdiff_t opoint, opoint_byte;
+ ptrdiff_t before, before_byte;
/* Avoid error if buffer is deleted
(probably that's why the process is dead, too) */
- if (NILP (BVAR (XBUFFER (buffer), name)))
+ if (!BUFFER_LIVE_P (XBUFFER (buffer)))
continue;
Fset_buffer (buffer);
@@ -6611,12 +6536,13 @@ status_notify (struct Lisp_Process *deleting_process)
before_byte = PT_BYTE;
tem = BVAR (current_buffer, read_only);
- BVAR (current_buffer, read_only) = Qnil;
+ bset_read_only (current_buffer, Qnil);
insert_string ("\nProcess ");
- Finsert (1, &p->name);
+ { /* FIXME: temporary kludge */
+ Lisp_Object tem2 = p->name; Finsert (1, &tem2); }
insert_string (" ");
Finsert (1, &msg);
- BVAR (current_buffer, read_only) = tem;
+ bset_read_only (current_buffer, tem);
set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
if (opoint >= before)
@@ -6653,8 +6579,8 @@ encode subprocess input. */)
Fcheck_coding_system (decoding);
Fcheck_coding_system (encoding);
encoding = coding_inherit_eol_type (encoding, Qnil);
- p->decode_coding_system = decoding;
- p->encode_coding_system = encoding;
+ pset_decode_coding_system (p, decoding);
+ pset_encode_coding_system (p, encoding);
setup_process_coding_systems (process);
return Qnil;
@@ -6684,7 +6610,8 @@ suppressed. */)
CHECK_PROCESS (process);
p = XPROCESS (process);
if (NILP (flag))
- p->decode_coding_system = raw_text_coding_system (p->decode_coding_system);
+ pset_decode_coding_system
+ (p, raw_text_coding_system (p->decode_coding_system));
setup_process_coding_systems (process);
return Qnil;
@@ -6723,7 +6650,7 @@ delete_gpm_wait_descriptor (int desc)
# endif
-# ifdef SIGIO
+# ifdef USABLE_SIGIO
/* Return nonzero if *MASK has a bit set
that corresponds to one of the keyboard input descriptors. */
@@ -6746,19 +6673,25 @@ keyboard_bit_set (fd_set *mask)
/* Defined on msdos.c. */
extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
- EMACS_TIME *);
+ EMACS_TIME *, void *);
/* Implementation of wait_reading_process_output, assuming that there
are no subprocesses. Used only by the MS-DOS build.
Wait for timeout to elapse and/or keyboard input to be available.
- time_limit is:
- timeout in seconds, or
- zero for no limit, or
- -1 means gobble data immediately available but don't wait for any.
+ TIME_LIMIT is:
+ timeout in seconds
+ If negative, gobble data immediately available but don't wait for any.
+
+ NSECS is:
+ an additional duration to wait, measured in nanoseconds
+ If TIME_LIMIT is zero, then:
+ If NSECS == 0, there is no limit.
+ If NSECS > 0, the timeout consists of NSECS only.
+ If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
- read_kbd is a Lisp_Object:
+ READ_KBD is:
0 to ignore keyboard input, or
1 to return when input is available, or
-1 means caller will actually read the input, so don't throw to
@@ -6767,28 +6700,33 @@ extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
see full version for other parameters. We know that wait_proc will
always be NULL, since `subprocesses' isn't defined.
- do_display != 0 means redisplay should be done to show subprocess
+ DO_DISPLAY means redisplay should be done to show subprocess
output that arrives.
Return true if we received input from any process. */
int
-wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
- int do_display,
+wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
+ bool do_display,
Lisp_Object wait_for_cell,
struct Lisp_Process *wait_proc, int just_wait_proc)
{
register int nfds;
EMACS_TIME end_time, timeout;
- SELECT_TYPE waitchannels;
- int xerrno;
+
+ if (time_limit < 0)
+ {
+ time_limit = 0;
+ nsecs = -1;
+ }
+ else if (TYPE_MAXIMUM (time_t) < time_limit)
+ time_limit = TYPE_MAXIMUM (time_t);
/* What does time_limit really mean? */
- if (time_limit || microsecs)
+ if (time_limit || 0 < nsecs)
{
- EMACS_GET_TIME (end_time);
- EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
- EMACS_ADD_TIME (end_time, end_time, timeout);
+ timeout = make_emacs_time (time_limit, nsecs);
+ end_time = add_emacs_time (current_emacs_time (), timeout);
}
/* Turn off periodic alarms (in case they are in use)
@@ -6800,6 +6738,8 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
while (1)
{
int timeout_reduced_for_timers = 0;
+ SELECT_TYPE waitchannels;
+ int xerrno;
/* If calling from keyboard input, do not quit
since we want to return C-g as an input character.
@@ -6813,24 +6753,24 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
/* Compute time from now till when time limit is up */
/* Exit if already run out */
- if (time_limit == -1)
+ if (nsecs < 0)
{
- /* -1 specified for timeout means
+ /* A negative timeout means
gobble output available now
but don't wait at all. */
- EMACS_SET_SECS_USECS (timeout, 0, 0);
+ timeout = make_emacs_time (0, 0);
}
- else if (time_limit || microsecs)
+ else if (time_limit || 0 < nsecs)
{
- EMACS_GET_TIME (timeout);
- EMACS_SUB_TIME (timeout, end_time, timeout);
- if (EMACS_TIME_NEG_P (timeout))
+ EMACS_TIME now = current_emacs_time ();
+ if (EMACS_TIME_LE (end_time, now))
break;
+ timeout = sub_emacs_time (end_time, now);
}
else
{
- EMACS_SET_SECS_USECS (timeout, 100000, 0);
+ timeout = make_emacs_time (100000, 0);
}
/* If our caller will not immediately handle keyboard events,
@@ -6843,7 +6783,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
do
{
- int old_timers_run = timers_run;
+ unsigned old_timers_run = timers_run;
timer_delay = timer_check ();
if (timers_run != old_timers_run && do_display)
/* We must retry, since a timer may have requeued itself
@@ -6859,11 +6799,9 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
&& requeued_events_pending_p ())
break;
- if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
+ if (EMACS_TIME_VALID_P (timer_delay) && 0 <= nsecs)
{
- EMACS_TIME difference;
- EMACS_SUB_TIME (difference, timer_delay, timeout);
- if (EMACS_TIME_NEG_P (difference))
+ if (EMACS_TIME_LT (timer_delay, timeout))
{
timeout = timer_delay;
timeout_reduced_for_timers = 1;
@@ -6876,13 +6814,6 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
if (read_kbd < 0)
set_waiting_for_input (&timeout);
- /* Wait till there is something to do. */
-
- if (! read_kbd && NILP (wait_for_cell))
- FD_ZERO (&waitchannels);
- else
- FD_SET (0, &waitchannels);
-
/* If a frame has been newly mapped and needs updating,
reprocess its display stuff. */
if (frame_garbaged && do_display)
@@ -6893,14 +6824,16 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
set_waiting_for_input (&timeout);
}
+ /* Wait till there is something to do. */
+ FD_ZERO (&waitchannels);
if (read_kbd && detect_input_pending ())
+ nfds = 0;
+ else
{
- nfds = 0;
- FD_ZERO (&waitchannels);
+ if (read_kbd || !NILP (wait_for_cell))
+ FD_SET (0, &waitchannels);
+ nfds = pselect (1, &waitchannels, NULL, NULL, &timeout, NULL);
}
- else
- nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
- &timeout);
xerrno = errno;
@@ -6910,7 +6843,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
/* If we woke up due to SIGWINCH, actually change size now. */
do_pending_window_change (0);
- if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
+ if ((time_limit || nsecs) && nfds == 0 && ! timeout_reduced_for_timers)
/* We waited the full specified time, so return now. */
break;
@@ -7015,8 +6948,7 @@ setup_process_coding_systems (Lisp_Object process)
return;
if (!proc_decode_coding_system[inch])
- proc_decode_coding_system[inch]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system));
coding_system = p->decode_coding_system;
if (! NILP (p->filter))
;
@@ -7028,8 +6960,7 @@ setup_process_coding_systems (Lisp_Object process)
setup_coding_system (coding_system, proc_decode_coding_system[inch]);
if (!proc_encode_coding_system[outch])
- proc_encode_coding_system[outch]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ proc_encode_coding_system[outch] = xmalloc (sizeof (struct coding_system));
setup_coding_system (p->encode_coding_system,
proc_encode_coding_system[outch]);
#endif
@@ -7213,19 +7144,20 @@ integer or floating point values.
majflt -- number of major page faults (number)
cminflt -- cumulative number of minor page faults (number)
cmajflt -- cumulative number of major page faults (number)
- utime -- user time used by the process, in the (HIGH LOW USEC) format
- stime -- system time used by the process, in the (HIGH LOW USEC) format
- time -- sum of utime and stime, in the (HIGH LOW USEC) format
- cutime -- user time used by the process and its children, (HIGH LOW USEC)
- cstime -- system time used by the process and its children, (HIGH LOW USEC)
- ctime -- sum of cutime and cstime, in the (HIGH LOW USEC) format
+ utime -- user time used by the process, in (current-time) format,
+ which is a list of integers (HIGH LOW USEC PSEC)
+ stime -- system time used by the process (current-time)
+ time -- sum of utime and stime (current-time)
+ cutime -- user time used by the process and its children (current-time)
+ cstime -- system time used by the process and its children (current-time)
+ ctime -- sum of cutime and cstime (current-time)
pri -- priority of the process (number)
nice -- nice value of the process (number)
thcount -- process thread count (number)
- start -- time the process started, in the (HIGH LOW USEC) format
+ start -- time the process started (current-time)
vsize -- virtual memory size of the process in KB's (number)
rss -- resident set size of the process in KB's (number)
- etime -- elapsed time the process is running, in (HIGH LOW USEC) format
+ etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
pcpu -- percents of CPU time used by the process (floating-point number)
pmem -- percents of total physical memory used by process's resident set
(floating-point number)
@@ -7236,8 +7168,10 @@ integer or floating point values.
}
+/* This is not called "init_process" because that is the name of a
+ Mach system call, so it would cause problems on Darwin systems. */
void
-init_process (void)
+init_process_emacs (void)
{
#ifdef subprocesses
register int i;
@@ -7248,7 +7182,11 @@ init_process (void)
#ifndef CANNOT_DUMP
if (! noninteractive || initialized)
#endif
- signal (SIGCHLD, sigchld_handler);
+ {
+ struct sigaction action;
+ emacs_sigaction_init (&action, deliver_child_signal);
+ sigaction (SIGCHLD, &action, 0);
+ }
#endif
FD_ZERO (&input_wait_mask);
@@ -7316,9 +7254,7 @@ init_process (void)
#ifdef HAVE_GETSOCKNAME
ADD_SUBFEATURE (QCservice, Qt);
#endif
-#if defined (O_NONBLOCK) || defined (O_NDELAY)
ADD_SUBFEATURE (QCserver, Qt);
-#endif
for (sopt = socket_options; sopt->name; sopt++)
subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
@@ -7334,8 +7270,7 @@ init_process (void)
char const *release = (STRINGP (Voperating_system_release)
? SSDATA (Voperating_system_release)
: 0);
- if (!release || !release[0] || (release[0] < MIN_PTY_KERNEL_VERSION
- && release[1] == '.')) {
+ if (!release || !release[0] || (release[0] < '7' && release[1] == '.')) {
Vprocess_connection_type = Qnil;
}
}
@@ -7450,7 +7385,7 @@ syms_of_process (void)
DEFSYM (Qargs, "args");
DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
- doc: /* *Non-nil means delete processes immediately when they exit.
+ doc: /* Non-nil means delete processes immediately when they exit.
A value of nil means don't delete them until `list-processes' is run. */);
delete_exited_processes = 1;
diff --git a/src/process.h b/src/process.h
index aff9e970f63..74d1a124060 100644
--- a/src/process.h
+++ b/src/process.h
@@ -1,5 +1,5 @@
/* Definitions for asynchronous process control in GNU Emacs.
- Copyright (C) 1985, 1994, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -26,11 +26,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "gnutls.h"
#endif
-/* This structure records information about a subprocess
- or network connection.
+INLINE_HEADER_BEGIN
+#ifndef PROCESS_INLINE
+# define PROCESS_INLINE INLINE
+#endif
- Every field in this structure except for the header
- must be a Lisp_Object, for GC's sake. */
+/* This structure records information about a subprocess
+ or network connection. */
struct Lisp_Process
{
@@ -38,46 +40,65 @@ struct Lisp_Process
/* Name of subprocess terminal. */
Lisp_Object tty_name;
+
/* Name of this process */
Lisp_Object name;
+
/* List of command arguments that this process was run with.
Is set to t for a stopped network process; nil otherwise. */
Lisp_Object command;
+
/* (funcall FILTER PROC STRING) (if FILTER is non-nil)
to dispose of a bunch of chars from the process all at once */
Lisp_Object filter;
+
/* (funcall SENTINEL PROCESS) when process state changes */
Lisp_Object sentinel;
+
/* (funcall LOG SERVER CLIENT MESSAGE) when a server process
accepts a connection from a client. */
Lisp_Object log;
+
/* Buffer that output is going to */
Lisp_Object buffer;
+
/* t if this is a real child process. For a network or serial
connection, it is a plist based on the arguments to
make-network-process or make-serial-process. */
+
Lisp_Object childp;
+
/* Plist for programs to keep per-process state information, parameters, etc. */
Lisp_Object plist;
+
/* Symbol indicating the type of process: real, network, serial */
Lisp_Object type;
+
/* Marker set to end of last buffer-inserted output from this process */
Lisp_Object mark;
+
/* Symbol indicating status of process.
This may be a symbol: run, open, or closed.
Or it may be a list, whose car is stop, exit or signal
and whose cdr is a pair (EXIT_CODE . COREDUMP_FLAG)
or (SIGNAL_NUMBER . COREDUMP_FLAG). */
Lisp_Object status;
+
/* Coding-system for decoding the input from this process. */
Lisp_Object decode_coding_system;
+
/* Working buffer for decoding. */
Lisp_Object decoding_buf;
+
/* Coding-system for encoding the output to this process. */
Lisp_Object encode_coding_system;
+
/* Working buffer for encoding. */
Lisp_Object encoding_buf;
+ /* Queue for storing waiting writes */
+ Lisp_Object write_queue;
+
#ifdef HAVE_GNUTLS
Lisp_Object gnutls_cred_type;
#endif
@@ -95,17 +116,17 @@ struct Lisp_Process
/* Descriptor by which we write to this process */
int outfd;
/* Event-count of last event in which this process changed status. */
- int tick;
+ EMACS_INT tick;
/* Event-count of last such event reported. */
- int update_tick;
+ EMACS_INT update_tick;
/* Size of carryover in decoding. */
int decoding_carryover;
/* Hysteresis to try to read process output in larger blocks.
On some systems, e.g. GNU/Linux, Emacs is seen as
an interactive app also when reading process output, meaning
that process output can be read in as little as 1 byte at a
- time. Value is micro-seconds to delay reading output from
- this process. Range is 0 .. 50000. */
+ time. Value is nanoseconds to delay reading output from
+ this process. Range is 0 .. 50 * 1000 * 1000. */
int read_output_delay;
/* Should we delay reading output from this process.
Initialized from `Vprocess_adaptive_read_buffering'.
@@ -121,6 +142,9 @@ struct Lisp_Process
/* Flag to set coding-system of the process buffer from the
coding_system used to decode process output. */
unsigned int inherit_coding_system_flag : 1;
+ /* Whether the process is alive, i.e., can be waited for. Running
+ processes can be waited for, but exited and fake processes cannot. */
+ unsigned int alive : 1;
/* Record the process status in the raw form in which it comes from `wait'.
This is to avoid consing in a signal handler. The `raw_status_new'
flag indicates that `raw_status' contains a new status that still
@@ -134,6 +158,7 @@ struct Lisp_Process
gnutls_certificate_client_credentials gnutls_x509_cred;
gnutls_anon_client_credentials_t gnutls_anon_cred;
int gnutls_log_level;
+ int gnutls_handshakes_tried;
int gnutls_p;
#endif
};
@@ -143,9 +168,26 @@ struct Lisp_Process
#define ChannelMask(n) (1 << (n))
+/* Most code should use these functions to set Lisp fields in struct
+ process. */
+
+PROCESS_INLINE void
+pset_childp (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->childp = val;
+}
+
+#ifdef HAVE_GNUTLS
+PROCESS_INLINE void
+pset_gnutls_cred_type (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->gnutls_cred_type = val;
+}
+#endif
+
/* True if we are about to fork off a synchronous process or if we
are waiting for it. */
-extern int synch_process_alive;
+extern bool synch_process_alive;
/* Communicate exit status of sync process to from sigchld_handler
to Fcall_process. */
@@ -160,12 +202,6 @@ extern int synch_process_termsig;
this is exit code of synchronous subprocess. */
extern int synch_process_retcode;
-/* The name of the file open to get a null file, or a data sink.
- MS-DOS, and OS/2 redefine this. */
-#ifndef NULL_DEVICE
-#define NULL_DEVICE "/dev/null"
-#endif
-
/* Nonzero means don't run process sentinels. This is used
when exiting. */
extern int inhibit_sentinels;
@@ -186,9 +222,11 @@ extern void hold_keyboard_input (void);
extern void unhold_keyboard_input (void);
extern int kbd_on_hold_p (void);
-typedef void (*fd_callback)(int fd, void *data, int for_read);
+typedef void (*fd_callback) (int fd, void *data);
extern void add_read_fd (int fd, fd_callback func, void *data);
extern void delete_read_fd (int fd);
extern void add_write_fd (int fd, fd_callback func, void *data);
extern void delete_write_fd (int fd);
+
+INLINE_HEADER_END
diff --git a/src/profiler.c b/src/profiler.c
new file mode 100644
index 00000000000..3d8f7243d2f
--- /dev/null
+++ b/src/profiler.c
@@ -0,0 +1,607 @@
+/* Profiler implementation.
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+
+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/>. */
+
+#include <config.h>
+#include "lisp.h"
+#include "syssignal.h"
+#include "systime.h"
+
+/* Return A + B, but return the maximum fixnum if the result would overflow.
+ Assume A and B are nonnegative and in fixnum range. */
+
+static EMACS_INT
+saturated_add (EMACS_INT a, EMACS_INT b)
+{
+ return min (a + b, MOST_POSITIVE_FIXNUM);
+}
+
+/* Logs. */
+
+typedef struct Lisp_Hash_Table log_t;
+
+static Lisp_Object Qprofiler_backtrace_equal;
+static struct hash_table_test hashtest_profiler;
+
+static Lisp_Object
+make_log (int heap_size, int max_stack_depth)
+{
+ /* We use a standard Elisp hash-table object, but we use it in
+ a special way. This is OK as long as the object is not exposed
+ to Elisp, i.e. until it is returned by *-profiler-log, after which
+ it can't be used any more. */
+ Lisp_Object log = make_hash_table (hashtest_profiler,
+ make_number (heap_size),
+ make_float (DEFAULT_REHASH_SIZE),
+ make_float (DEFAULT_REHASH_THRESHOLD),
+ Qnil);
+ struct Lisp_Hash_Table *h = XHASH_TABLE (log);
+
+ /* What is special about our hash-tables is that the keys are pre-filled
+ with the vectors we'll put in them. */
+ int i = ASIZE (h->key_and_value) / 2;
+ while (0 < i)
+ set_hash_key_slot (h, --i,
+ Fmake_vector (make_number (max_stack_depth), Qnil));
+ return log;
+}
+
+/* Evict the least used half of the hash_table.
+
+ When the table is full, we have to evict someone.
+ The easiest and most efficient is to evict the value we're about to add
+ (i.e. once the table is full, stop sampling).
+
+ We could also pick the element with the lowest count and evict it,
+ but finding it is O(N) and for that amount of work we get very
+ little in return: for the next sample, this latest sample will have
+ count==1 and will hence be a prime candidate for eviction :-(
+
+ So instead, we take O(N) time to eliminate more or less half of the
+ entries (the half with the lowest counts). So we get an amortized
+ cost of O(1) and we get O(N) time for a new entry to grow larger
+ than the other least counts before a new round of eviction. */
+
+static EMACS_INT approximate_median (log_t *log,
+ ptrdiff_t start, ptrdiff_t size)
+{
+ eassert (size > 0);
+ if (size < 2)
+ return XINT (HASH_VALUE (log, start));
+ if (size < 3)
+ /* Not an actual median, but better for our application than
+ choosing either of the two numbers. */
+ return ((XINT (HASH_VALUE (log, start))
+ + XINT (HASH_VALUE (log, start + 1)))
+ / 2);
+ else
+ {
+ ptrdiff_t newsize = size / 3;
+ ptrdiff_t start2 = start + newsize;
+ EMACS_INT i1 = approximate_median (log, start, newsize);
+ EMACS_INT i2 = approximate_median (log, start2, newsize);
+ EMACS_INT i3 = approximate_median (log, start2 + newsize,
+ size - 2 * newsize);
+ return (i1 < i2
+ ? (i2 < i3 ? i2 : (i1 < i3 ? i3 : i1))
+ : (i1 < i3 ? i1 : (i2 < i3 ? i3 : i2)));
+ }
+}
+
+static void evict_lower_half (log_t *log)
+{
+ ptrdiff_t size = ASIZE (log->key_and_value) / 2;
+ EMACS_INT median = approximate_median (log, 0, size);
+ ptrdiff_t i;
+
+ for (i = 0; i < size; i++)
+ /* Evict not only values smaller but also values equal to the median,
+ so as to make sure we evict something no matter what. */
+ if (XINT (HASH_VALUE (log, i)) <= median)
+ {
+ Lisp_Object key = HASH_KEY (log, i);
+ { /* FIXME: we could make this more efficient. */
+ Lisp_Object tmp;
+ XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */
+ Fremhash (key, tmp);
+ }
+ eassert (EQ (log->next_free, make_number (i)));
+ {
+ int j;
+ eassert (VECTORP (key));
+ for (j = 0; j < ASIZE (key); j++)
+ ASET (key, j, Qnil);
+ }
+ set_hash_key_slot (log, i, key);
+ }
+}
+
+/* Record the current backtrace in LOG. COUNT is the weight of this
+ current backtrace: interrupt counts for CPU, and the allocation
+ size for memory. */
+
+static void
+record_backtrace (log_t *log, EMACS_INT count)
+{
+ struct backtrace *backlist = backtrace_list;
+ Lisp_Object backtrace;
+ ptrdiff_t index, i = 0;
+ ptrdiff_t asize;
+
+ if (!INTEGERP (log->next_free))
+ /* FIXME: transfer the evicted counts to a special entry rather
+ than dropping them on the floor. */
+ evict_lower_half (log);
+ index = XINT (log->next_free);
+
+ /* Get a "working memory" vector. */
+ backtrace = HASH_KEY (log, index);
+ asize = ASIZE (backtrace);
+
+ /* Copy the backtrace contents into working memory. */
+ for (; i < asize && backlist; i++, backlist = backlist->next)
+ /* FIXME: For closures we should ignore the environment. */
+ ASET (backtrace, i, backlist->function);
+
+ /* Make sure that unused space of working memory is filled with nil. */
+ for (; i < asize; i++)
+ ASET (backtrace, i, Qnil);
+
+ { /* We basically do a `gethash+puthash' here, except that we have to be
+ careful to avoid memory allocation since we're in a signal
+ handler, and we optimize the code to try and avoid computing the
+ hash+lookup twice. See fns.c:Fputhash for reference. */
+ EMACS_UINT hash;
+ ptrdiff_t j = hash_lookup (log, backtrace, &hash);
+ if (j >= 0)
+ {
+ EMACS_INT old_val = XINT (HASH_VALUE (log, j));
+ EMACS_INT new_val = saturated_add (old_val, count);
+ set_hash_value_slot (log, j, make_number (new_val));
+ }
+ else
+ { /* BEWARE! hash_put in general can allocate memory.
+ But currently it only does that if log->next_free is nil. */
+ int j;
+ eassert (!NILP (log->next_free));
+ j = hash_put (log, backtrace, make_number (count), hash);
+ /* Let's make sure we've put `backtrace' right where it
+ already was to start with. */
+ eassert (index == j);
+
+ /* FIXME: If the hash-table is almost full, we should set
+ some global flag so that some Elisp code can offload its
+ data elsewhere, so as to avoid the eviction code.
+ There are 2 ways to do that, AFAICT:
+ - Set a flag checked in QUIT, such that QUIT can then call
+ Fprofiler_cpu_log and stash the full log for later use.
+ - Set a flag check in post-gc-hook, so that Elisp code can call
+ profiler-cpu-log. That gives us more flexibility since that
+ Elisp code can then do all kinds of fun stuff like write
+ the log to disk. Or turn it right away into a call tree.
+ Of course, using Elisp is generally preferable, but it may
+ take longer until we get a chance to run the Elisp code, so
+ there's more risk that the table will get full before we
+ get there. */
+ }
+ }
+}
+
+/* Sampling profiler. */
+
+#ifdef PROFILER_CPU_SUPPORT
+
+/* The profiler timer and whether it was properly initialized, if
+ POSIX timers are available. */
+#ifdef HAVE_ITIMERSPEC
+static timer_t profiler_timer;
+static bool profiler_timer_ok;
+#endif
+
+/* Status of sampling profiler. */
+static enum profiler_cpu_running
+ { NOT_RUNNING, TIMER_SETTIME_RUNNING, SETITIMER_RUNNING }
+ profiler_cpu_running;
+
+/* Hash-table log of CPU profiler. */
+static Lisp_Object cpu_log;
+
+/* Separate counter for the time spent in the GC. */
+static EMACS_INT cpu_gc_count;
+
+/* The current sampling interval in nanoseconds. */
+static EMACS_INT current_sampling_interval;
+
+/* Signal handler for sampling profiler. */
+
+static void
+handle_profiler_signal (int signal)
+{
+ if (backtrace_list && EQ (backtrace_list->function, Qautomatic_gc))
+ /* Special case the time-count inside GC because the hash-table
+ code is not prepared to be used while the GC is running.
+ More specifically it uses ASIZE at many places where it does
+ not expect the ARRAY_MARK_FLAG to be set. We could try and
+ harden the hash-table code, but it doesn't seem worth the
+ effort. */
+ cpu_gc_count = saturated_add (cpu_gc_count, 1);
+ else
+ {
+ EMACS_INT count = 1;
+#ifdef HAVE_ITIMERSPEC
+ if (profiler_timer_ok)
+ {
+ int overruns = timer_getoverrun (profiler_timer);
+ eassert (0 <= overruns);
+ count += overruns;
+ }
+#endif
+ eassert (HASH_TABLE_P (cpu_log));
+ record_backtrace (XHASH_TABLE (cpu_log), count);
+ }
+}
+
+static void
+deliver_profiler_signal (int signal)
+{
+ deliver_process_signal (signal, handle_profiler_signal);
+}
+
+static enum profiler_cpu_running
+setup_cpu_timer (Lisp_Object sampling_interval)
+{
+ struct sigaction action;
+ struct itimerval timer;
+ struct timespec interval;
+ int billion = 1000000000;
+
+ if (! RANGED_INTEGERP (1, sampling_interval,
+ (TYPE_MAXIMUM (time_t) < EMACS_INT_MAX / billion
+ ? ((EMACS_INT) TYPE_MAXIMUM (time_t) * billion
+ + (billion - 1))
+ : EMACS_INT_MAX)))
+ return NOT_RUNNING;
+
+ current_sampling_interval = XINT (sampling_interval);
+ interval = make_emacs_time (current_sampling_interval / billion,
+ current_sampling_interval % billion);
+ emacs_sigaction_init (&action, deliver_profiler_signal);
+ sigaction (SIGPROF, &action, 0);
+
+#ifdef HAVE_ITIMERSPEC
+ if (! profiler_timer_ok)
+ {
+ /* System clocks to try, in decreasing order of desirability. */
+ static clockid_t const system_clock[] = {
+#ifdef CLOCK_THREAD_CPUTIME_ID
+ CLOCK_THREAD_CPUTIME_ID,
+#endif
+#ifdef CLOCK_PROCESS_CPUTIME_ID
+ CLOCK_PROCESS_CPUTIME_ID,
+#endif
+#ifdef CLOCK_MONOTONIC
+ CLOCK_MONOTONIC,
+#endif
+ CLOCK_REALTIME
+ };
+ int i;
+ struct sigevent sigev;
+ sigev.sigev_value.sival_ptr = &profiler_timer;
+ sigev.sigev_signo = SIGPROF;
+ sigev.sigev_notify = SIGEV_SIGNAL;
+
+ for (i = 0; i < sizeof system_clock / sizeof *system_clock; i++)
+ if (timer_create (system_clock[i], &sigev, &profiler_timer) == 0)
+ {
+ profiler_timer_ok = 1;
+ break;
+ }
+ }
+
+ if (profiler_timer_ok)
+ {
+ struct itimerspec ispec;
+ ispec.it_value = ispec.it_interval = interval;
+ if (timer_settime (profiler_timer, 0, &ispec, 0) == 0)
+ return TIMER_SETTIME_RUNNING;
+ }
+#endif
+
+#ifdef HAVE_SETITIMER
+ timer.it_value = timer.it_interval = make_timeval (interval);
+ if (setitimer (ITIMER_PROF, &timer, 0) == 0)
+ return SETITIMER_RUNNING;
+#endif
+
+ return NOT_RUNNING;
+}
+
+DEFUN ("profiler-cpu-start", Fprofiler_cpu_start, Sprofiler_cpu_start,
+ 1, 1, 0,
+ doc: /* Start or restart the cpu profiler.
+It takes call-stack samples each SAMPLING-INTERVAL nanoseconds, approximately.
+See also `profiler-log-size' and `profiler-max-stack-depth'. */)
+ (Lisp_Object sampling_interval)
+{
+ if (profiler_cpu_running)
+ error ("CPU profiler is already running");
+
+ if (NILP (cpu_log))
+ {
+ cpu_gc_count = 0;
+ cpu_log = make_log (profiler_log_size,
+ profiler_max_stack_depth);
+ }
+
+ profiler_cpu_running = setup_cpu_timer (sampling_interval);
+ if (! profiler_cpu_running)
+ error ("Invalid sampling interval");
+
+ return Qt;
+}
+
+DEFUN ("profiler-cpu-stop", Fprofiler_cpu_stop, Sprofiler_cpu_stop,
+ 0, 0, 0,
+ doc: /* Stop the cpu profiler. The profiler log is not affected.
+Return non-nil if the profiler was running. */)
+ (void)
+{
+ switch (profiler_cpu_running)
+ {
+ case NOT_RUNNING:
+ return Qnil;
+
+#ifdef HAVE_ITIMERSPEC
+ case TIMER_SETTIME_RUNNING:
+ {
+ struct itimerspec disable;
+ memset (&disable, 0, sizeof disable);
+ timer_settime (profiler_timer, 0, &disable, 0);
+ }
+ break;
+#endif
+
+#ifdef HAVE_SETITIMER
+ case SETITIMER_RUNNING:
+ {
+ struct itimerval disable;
+ memset (&disable, 0, sizeof disable);
+ setitimer (ITIMER_PROF, &disable, 0);
+ }
+ break;
+#endif
+ }
+
+ signal (SIGPROF, SIG_IGN);
+ profiler_cpu_running = NOT_RUNNING;
+ return Qt;
+}
+
+DEFUN ("profiler-cpu-running-p",
+ Fprofiler_cpu_running_p, Sprofiler_cpu_running_p,
+ 0, 0, 0,
+ doc: /* Return non-nil iff cpu profiler is running. */)
+ (void)
+{
+ return profiler_cpu_running ? Qt : Qnil;
+}
+
+DEFUN ("profiler-cpu-log", Fprofiler_cpu_log, Sprofiler_cpu_log,
+ 0, 0, 0,
+ doc: /* Return the current cpu profiler log.
+The log is a hash-table mapping backtraces to counters which represent
+the amount of time spent at those points. Every backtrace is a vector
+of functions, where the last few elements may be nil.
+Before returning, a new log is allocated for future samples. */)
+ (void)
+{
+ Lisp_Object result = cpu_log;
+ /* Here we're making the log visible to Elisp, so it's not safe any
+ more for our use afterwards since we can't rely on its special
+ pre-allocated keys anymore. So we have to allocate a new one. */
+ cpu_log = (profiler_cpu_running
+ ? make_log (profiler_log_size, profiler_max_stack_depth)
+ : Qnil);
+ Fputhash (Fmake_vector (make_number (1), Qautomatic_gc),
+ make_number (cpu_gc_count),
+ result);
+ cpu_gc_count = 0;
+ return result;
+}
+#endif /* PROFILER_CPU_SUPPORT */
+
+/* Memory profiler. */
+
+/* True if memory profiler is running. */
+bool profiler_memory_running;
+
+static Lisp_Object memory_log;
+
+DEFUN ("profiler-memory-start", Fprofiler_memory_start, Sprofiler_memory_start,
+ 0, 0, 0,
+ doc: /* Start/restart the memory profiler.
+The memory profiler will take samples of the call-stack whenever a new
+allocation takes place. Note that most small allocations only trigger
+the profiler occasionally.
+See also `profiler-log-size' and `profiler-max-stack-depth'. */)
+ (void)
+{
+ if (profiler_memory_running)
+ error ("Memory profiler is already running");
+
+ if (NILP (memory_log))
+ memory_log = make_log (profiler_log_size,
+ profiler_max_stack_depth);
+
+ profiler_memory_running = true;
+
+ return Qt;
+}
+
+DEFUN ("profiler-memory-stop",
+ Fprofiler_memory_stop, Sprofiler_memory_stop,
+ 0, 0, 0,
+ doc: /* Stop the memory profiler. The profiler log is not affected.
+Return non-nil if the profiler was running. */)
+ (void)
+{
+ if (!profiler_memory_running)
+ return Qnil;
+ profiler_memory_running = false;
+ return Qt;
+}
+
+DEFUN ("profiler-memory-running-p",
+ Fprofiler_memory_running_p, Sprofiler_memory_running_p,
+ 0, 0, 0,
+ doc: /* Return non-nil if memory profiler is running. */)
+ (void)
+{
+ return profiler_memory_running ? Qt : Qnil;
+}
+
+DEFUN ("profiler-memory-log",
+ Fprofiler_memory_log, Sprofiler_memory_log,
+ 0, 0, 0,
+ doc: /* Return the current memory profiler log.
+The log is a hash-table mapping backtraces to counters which represent
+the amount of memory allocated at those points. Every backtrace is a vector
+of functions, where the last few elements may be nil.
+Before returning, a new log is allocated for future samples. */)
+ (void)
+{
+ Lisp_Object result = memory_log;
+ /* Here we're making the log visible to Elisp , so it's not safe any
+ more for our use afterwards since we can't rely on its special
+ pre-allocated keys anymore. So we have to allocate a new one. */
+ memory_log = (profiler_memory_running
+ ? make_log (profiler_log_size, profiler_max_stack_depth)
+ : Qnil);
+ return result;
+}
+
+
+/* Signals and probes. */
+
+/* Record that the current backtrace allocated SIZE bytes. */
+void
+malloc_probe (size_t size)
+{
+ eassert (HASH_TABLE_P (memory_log));
+ record_backtrace (XHASH_TABLE (memory_log), min (size, MOST_POSITIVE_FIXNUM));
+}
+
+DEFUN ("function-equal", Ffunction_equal, Sfunction_equal, 2, 2, 0,
+ doc: /* Return non-nil if F1 and F2 come from the same source.
+Used to determine if different closures are just different instances of
+the same lambda expression, or are really unrelated function. */)
+ (Lisp_Object f1, Lisp_Object f2)
+{
+ bool res;
+ if (EQ (f1, f2))
+ res = true;
+ else if (COMPILEDP (f1) && COMPILEDP (f2))
+ res = EQ (AREF (f1, COMPILED_BYTECODE), AREF (f2, COMPILED_BYTECODE));
+ else if (CONSP (f1) && CONSP (f2) && CONSP (XCDR (f1)) && CONSP (XCDR (f2))
+ && EQ (Qclosure, XCAR (f1))
+ && EQ (Qclosure, XCAR (f2)))
+ res = EQ (XCDR (XCDR (f1)), XCDR (XCDR (f2)));
+ else
+ res = false;
+ return res ? Qt : Qnil;
+}
+
+static bool
+cmpfn_profiler (struct hash_table_test *t,
+ Lisp_Object bt1, Lisp_Object bt2)
+{
+ if (VECTORP (bt1) && VECTORP (bt2))
+ {
+ ptrdiff_t i, l = ASIZE (bt1);
+ if (l != ASIZE (bt2))
+ return false;
+ for (i = 0; i < l; i++)
+ if (NILP (Ffunction_equal (AREF (bt1, i), AREF (bt2, i))))
+ return false;
+ return true;
+ }
+ else
+ return EQ (bt1, bt2);
+}
+
+static EMACS_UINT
+hashfn_profiler (struct hash_table_test *ht, Lisp_Object bt)
+{
+ if (VECTORP (bt))
+ {
+ EMACS_UINT hash = 0;
+ ptrdiff_t i, l = ASIZE (bt);
+ for (i = 0; i < l; i++)
+ {
+ Lisp_Object f = AREF (bt, i);
+ EMACS_UINT hash1
+ = (COMPILEDP (f) ? XHASH (AREF (f, COMPILED_BYTECODE))
+ : (CONSP (f) && CONSP (XCDR (f)) && EQ (Qclosure, XCAR (f)))
+ ? XHASH (XCDR (XCDR (f))) : XHASH (f));
+ hash = sxhash_combine (hash, hash1);
+ }
+ return (hash & INTMASK);
+ }
+ else
+ return XHASH (bt);
+}
+
+void
+syms_of_profiler (void)
+{
+ DEFVAR_INT ("profiler-max-stack-depth", profiler_max_stack_depth,
+ doc: /* Number of elements from the call-stack recorded in the log. */);
+ profiler_max_stack_depth = 16;
+ DEFVAR_INT ("profiler-log-size", profiler_log_size,
+ doc: /* Number of distinct call-stacks that can be recorded in a profiler log.
+If the log gets full, some of the least-seen call-stacks will be evicted
+to make room for new entries. */);
+ profiler_log_size = 10000;
+
+ DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal");
+ {
+ struct hash_table_test test
+ = { Qprofiler_backtrace_equal, Qnil, Qnil,
+ cmpfn_profiler, hashfn_profiler };
+ hashtest_profiler = test;
+ }
+
+ defsubr (&Sfunction_equal);
+
+#ifdef PROFILER_CPU_SUPPORT
+ profiler_cpu_running = NOT_RUNNING;
+ cpu_log = Qnil;
+ staticpro (&cpu_log);
+ defsubr (&Sprofiler_cpu_start);
+ defsubr (&Sprofiler_cpu_stop);
+ defsubr (&Sprofiler_cpu_running_p);
+ defsubr (&Sprofiler_cpu_log);
+#endif
+ profiler_memory_running = false;
+ memory_log = Qnil;
+ staticpro (&memory_log);
+ defsubr (&Sprofiler_memory_start);
+ defsubr (&Sprofiler_memory_stop);
+ defsubr (&Sprofiler_memory_running_p);
+ defsubr (&Sprofiler_memory_log);
+}
diff --git a/src/puresize.h b/src/puresize.h
index 4290c30c68d..26395a5729d 100644
--- a/src/puresize.h
+++ b/src/puresize.h
@@ -1,5 +1,5 @@
/* How much read-only Lisp storage a dumped Emacs needs.
- Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -40,13 +40,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#ifndef BASE_PURESIZE
-#define BASE_PURESIZE (1620000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA)
+#define BASE_PURESIZE (1700000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA)
#endif
/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */
#ifndef PURESIZE_RATIO
-#if BITS_PER_EMACS_INT > 32
-#define PURESIZE_RATIO 10/6 /* Don't surround with `()'. */
+#if EMACS_INT_MAX >> 31 != 0
+#if PTRDIFF_MAX >> 31 != 0
+#define PURESIZE_RATIO 10 / 6 /* Don't surround with `()'. */
+#else
+#define PURESIZE_RATIO 8 / 6 /* Don't surround with `()'. */
+#endif
#else
#define PURESIZE_RATIO 1
#endif
@@ -56,7 +60,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* ENABLE_CHECKING somehow increases the purespace used, probably because
it tends to cause some macro arguments to be evaluated twice. This is
a bug, but it's difficult to track it down. */
-#define PURESIZE_CHECKING_RATIO 12/10 /* Don't surround with `()'. */
+#define PURESIZE_CHECKING_RATIO 12 / 10 /* Don't surround with `()'. */
#else
#define PURESIZE_CHECKING_RATIO 1
#endif
@@ -71,7 +75,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
{ if (PURE_P (obj)) \
pure_write_error (); }
-extern void pure_write_error (void) NO_RETURN;
+extern _Noreturn void pure_write_error (void);
/* Define PURE_P. */
diff --git a/src/ralloc.c b/src/ralloc.c
index 62189ad8fc7..e5bf76b0e6d 100644
--- a/src/ralloc.c
+++ b/src/ralloc.c
@@ -1,5 +1,5 @@
/* Block-relocating memory allocator.
- Copyright (C) 1993, 1995, 2000-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993, 1995, 2000-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -25,15 +25,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef emacs
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h" /* Needed for VALBITS. */
#include "blockinput.h"
#include <unistd.h>
-typedef POINTER_TYPE *POINTER;
-typedef size_t SIZE;
-
#ifdef DOUG_LEA_MALLOC
#define M_TOP_PAD -2
extern int mallopt (int, int);
@@ -47,9 +44,6 @@ extern size_t __malloc_extra_blocks;
#include <stddef.h>
-typedef size_t SIZE;
-typedef void *POINTER;
-
#include <unistd.h>
#include <malloc.h>
@@ -58,6 +52,8 @@ typedef void *POINTER;
#include "getpagesize.h"
+typedef size_t SIZE;
+typedef void *POINTER;
#define NIL ((POINTER) 0)
/* A flag to indicate whether we have initialized ralloc yet. For
@@ -76,7 +72,7 @@ static void r_alloc_init (void);
/* Declarations for working with the malloc, ralloc, and system breaks. */
/* Function to set the real break value. */
-POINTER (*real_morecore) (long int);
+POINTER (*real_morecore) (ptrdiff_t);
/* The break value, as seen by malloc. */
static POINTER virtual_break_value;
@@ -95,20 +91,18 @@ static int extra_bytes;
/* Macros for rounding. Note that rounding to any value is possible
by changing the definition of PAGE. */
#define PAGE (getpagesize ())
-#define ALIGNED(addr) (((unsigned long int) (addr) & (page_size - 1)) == 0)
-#define ROUNDUP(size) (((unsigned long int) (size) + page_size - 1) \
- & ~(page_size - 1))
-#define ROUND_TO_PAGE(addr) (addr & (~(page_size - 1)))
+#define ROUNDUP(size) (((size_t) (size) + page_size - 1) \
+ & ~((size_t)(page_size - 1)))
#define MEM_ALIGN sizeof (double)
-#define MEM_ROUNDUP(addr) (((unsigned long int)(addr) + MEM_ALIGN - 1) \
- & ~(MEM_ALIGN - 1))
+#define MEM_ROUNDUP(addr) (((size_t)(addr) + MEM_ALIGN - 1) \
+ & ~(MEM_ALIGN - 1))
/* The hook `malloc' uses for the function which gets more space
from the system. */
#ifndef SYSTEM_MALLOC
-extern POINTER (*__morecore) (long int);
+extern POINTER (*__morecore) (ptrdiff_t);
#endif
@@ -151,7 +145,6 @@ typedef struct heap
} *heap_ptr;
#define NIL_HEAP ((heap_ptr) 0)
-#define HEAP_PTR_SIZE (sizeof (struct heap))
/* This is the first heap object.
If we need additional heap objects, each one resides at the beginning of
@@ -244,7 +237,7 @@ obtain (POINTER address, SIZE size)
}
if (! heap)
- abort ();
+ emacs_abort ();
/* If we can't fit SIZE bytes in that heap,
try successive later heaps. */
@@ -315,7 +308,7 @@ static void
relinquish (void)
{
register heap_ptr h;
- long excess = 0;
+ ptrdiff_t excess = 0;
/* Add the amount of space beyond break_value
in all heaps which have extend beyond break_value at all. */
@@ -334,47 +327,39 @@ relinquish (void)
if ((char *)last_heap->end - (char *)last_heap->bloc_start <= excess)
{
- /* This heap should have no blocs in it. */
+ heap_ptr lh_prev;
+
+ /* This heap should have no blocs in it. If it does, we
+ cannot return it to the system. */
if (last_heap->first_bloc != NIL_BLOC
|| last_heap->last_bloc != NIL_BLOC)
- abort ();
+ return;
/* Return the last heap, with its header, to the system. */
excess = (char *)last_heap->end - (char *)last_heap->start;
- last_heap = last_heap->prev;
- last_heap->next = NIL_HEAP;
+ lh_prev = last_heap->prev;
+ /* If the system doesn't want that much memory back, leave
+ last_heap unaltered to reflect that. This can occur if
+ break_value is still within the original data segment. */
+ if ((*real_morecore) (- excess) != 0)
+ {
+ last_heap = lh_prev;
+ last_heap->next = NIL_HEAP;
+ }
}
else
{
excess = (char *) last_heap->end
- (char *) ROUNDUP ((char *)last_heap->end - excess);
- last_heap->end = (char *) last_heap->end - excess;
- }
-
- if ((*real_morecore) (- excess) == 0)
- {
- /* If the system didn't want that much memory back, adjust
- the end of the last heap to reflect that. This can occur
- if break_value is still within the original data segment. */
- last_heap->end = (char *) last_heap->end + excess;
- /* Make sure that the result of the adjustment is accurate.
- It should be, for the else clause above; the other case,
- which returns the entire last heap to the system, seems
- unlikely to trigger this mode of failure. */
- if (last_heap->end != (*real_morecore) (0))
- abort ();
+ /* If the system doesn't want that much memory back, leave
+ the end of the last heap unchanged to reflect that. This
+ can occur if break_value is still within the original
+ data segment. */
+ if ((*real_morecore) (- excess) != 0)
+ last_heap->end = (char *) last_heap->end - excess;
}
}
}
-
-/* Return the total size in use by relocating allocator,
- above where malloc gets space. */
-
-long
-r_alloc_size_in_use (void)
-{
- return (char *) break_value - (char *) virtual_break_value;
-}
/* The meat - allocating, freeing, and relocating blocs. */
@@ -412,7 +397,7 @@ get_bloc (SIZE size)
register bloc_ptr new_bloc;
register heap_ptr heap;
- if (! (new_bloc = (bloc_ptr) malloc (BLOC_PTR_SIZE))
+ if (! (new_bloc = malloc (BLOC_PTR_SIZE))
|| ! (new_bloc->data = obtain (break_value, size)))
{
free (new_bloc);
@@ -468,7 +453,7 @@ relocate_blocs (bloc_ptr bloc, heap_ptr heap, POINTER address)
/* No need to ever call this if arena is frozen, bug somewhere! */
if (r_alloc_freeze_level)
- abort ();
+ emacs_abort ();
while (b)
{
@@ -592,7 +577,7 @@ resize_bloc (bloc_ptr bloc, SIZE size)
/* No need to ever call this if arena is frozen, bug somewhere! */
if (r_alloc_freeze_level)
- abort ();
+ emacs_abort ();
if (bloc == NIL_BLOC || size == bloc->size)
return 1;
@@ -604,7 +589,7 @@ resize_bloc (bloc_ptr bloc, SIZE size)
}
if (heap == NIL_HEAP)
- abort ();
+ emacs_abort ();
old_size = bloc->size;
bloc->size = size;
@@ -636,7 +621,8 @@ resize_bloc (bloc_ptr bloc, SIZE size)
}
else
{
- memmove (b->new_data, b->data, b->size);
+ if (b->new_data != b->data)
+ memmove (b->new_data, b->data, b->size);
*b->variable = b->data = b->new_data;
}
}
@@ -647,7 +633,8 @@ resize_bloc (bloc_ptr bloc, SIZE size)
}
else
{
- memmove (bloc->new_data, bloc->data, old_size);
+ if (bloc->new_data != bloc->data)
+ memmove (bloc->new_data, bloc->data, old_size);
memset ((char *) bloc->new_data + old_size, 0, size - old_size);
*bloc->variable = bloc->data = bloc->new_data;
}
@@ -663,7 +650,8 @@ resize_bloc (bloc_ptr bloc, SIZE size)
}
else
{
- memmove (b->new_data, b->data, b->size);
+ if (b->new_data != b->data)
+ memmove (b->new_data, b->data, b->size);
*b->variable = b->data = b->new_data;
}
}
@@ -683,6 +671,7 @@ static void
free_bloc (bloc_ptr bloc)
{
heap_ptr heap = bloc->heap;
+ heap_ptr h;
if (r_alloc_freeze_level)
{
@@ -712,20 +701,38 @@ free_bloc (bloc_ptr bloc)
bloc->prev->next = bloc->next;
}
- /* Update the records of which blocs are in HEAP. */
- if (heap->first_bloc == bloc)
- {
- if (bloc->next != 0 && bloc->next->heap == heap)
- heap->first_bloc = bloc->next;
- else
- heap->first_bloc = heap->last_bloc = NIL_BLOC;
- }
- if (heap->last_bloc == bloc)
+ /* Sometimes, 'heap' obtained from bloc->heap above is not really a
+ 'heap' structure. It can even be beyond the current break point,
+ which will cause crashes when we dereference it below (see
+ bug#12242). Evidently, the reason is bloc allocations done while
+ use_relocatable_buffers was non-positive, because additional
+ memory we get then is not recorded in the heaps we manage. If
+ bloc->heap records such a "heap", we cannot (and don't need to)
+ update its records. So we validate the 'heap' value by making
+ sure it is one of the heaps we manage via the heaps linked list,
+ and don't touch a 'heap' that isn't found there. This avoids
+ accessing memory we know nothing about. */
+ for (h = first_heap; h != NIL_HEAP; h = h->next)
+ if (heap == h)
+ break;
+
+ if (h)
{
- if (bloc->prev != 0 && bloc->prev->heap == heap)
- heap->last_bloc = bloc->prev;
- else
- heap->first_bloc = heap->last_bloc = NIL_BLOC;
+ /* Update the records of which blocs are in HEAP. */
+ if (heap->first_bloc == bloc)
+ {
+ if (bloc->next != 0 && bloc->next->heap == heap)
+ heap->first_bloc = bloc->next;
+ else
+ heap->first_bloc = heap->last_bloc = NIL_BLOC;
+ }
+ if (heap->last_bloc == bloc)
+ {
+ if (bloc->prev != 0 && bloc->prev->heap == heap)
+ heap->last_bloc = bloc->prev;
+ else
+ heap->first_bloc = heap->last_bloc = NIL_BLOC;
+ }
}
relinquish ();
@@ -745,8 +752,8 @@ free_bloc (bloc_ptr bloc)
__morecore hook values - in particular, __default_morecore in the
GNU malloc package. */
-POINTER
-r_alloc_sbrk (long int size)
+static POINTER
+r_alloc_sbrk (ptrdiff_t size)
{
register bloc_ptr b;
POINTER address;
@@ -754,7 +761,7 @@ r_alloc_sbrk (long int size)
if (! r_alloc_initialized)
r_alloc_init ();
- if (! use_relocatable_buffers)
+ if (use_relocatable_buffers <= 0)
return (*real_morecore) (size);
if (size == 0)
@@ -816,7 +823,8 @@ r_alloc_sbrk (long int size)
header. */
for (b = last_bloc; b != NIL_BLOC; b = b->prev)
{
- memmove (b->new_data, b->data, b->size);
+ if (b->new_data != b->data)
+ memmove (b->new_data, b->data, b->size);
*b->variable = b->data = b->new_data;
}
@@ -862,7 +870,8 @@ r_alloc_sbrk (long int size)
for (b = first_bloc; b != NIL_BLOC; b = b->next)
{
- memmove (b->new_data, b->data, b->size);
+ if (b->new_data != b->data)
+ memmove (b->new_data, b->data, b->size);
*b->variable = b->data = b->new_data;
}
}
@@ -929,7 +938,7 @@ r_alloc_free (register POINTER *ptr)
dead_bloc = find_bloc (ptr);
if (dead_bloc == NIL_BLOC)
- abort (); /* Double free? PTR not originally used to allocate? */
+ emacs_abort (); /* Double free? PTR not originally used to allocate? */
free_bloc (dead_bloc);
*ptr = 0;
@@ -971,7 +980,7 @@ r_re_alloc (POINTER *ptr, SIZE size)
bloc = find_bloc (ptr);
if (bloc == NIL_BLOC)
- abort (); /* Already freed? PTR not originally used to allocate? */
+ emacs_abort (); /* Already freed? PTR not originally used to allocate? */
if (size < bloc->size)
{
@@ -1009,52 +1018,6 @@ r_re_alloc (POINTER *ptr, SIZE size)
return *ptr;
}
-/* Disable relocations, after making room for at least SIZE bytes
- of non-relocatable heap if possible. The relocatable blocs are
- guaranteed to hold still until thawed, even if this means that
- malloc must return a null pointer. */
-
-void
-r_alloc_freeze (long int size)
-{
- if (! r_alloc_initialized)
- r_alloc_init ();
-
- /* If already frozen, we can't make any more room, so don't try. */
- if (r_alloc_freeze_level > 0)
- size = 0;
- /* If we can't get the amount requested, half is better than nothing. */
- while (size > 0 && r_alloc_sbrk (size) == 0)
- size /= 2;
- ++r_alloc_freeze_level;
- if (size > 0)
- r_alloc_sbrk (-size);
-}
-
-void
-r_alloc_thaw (void)
-{
-
- if (! r_alloc_initialized)
- r_alloc_init ();
-
- if (--r_alloc_freeze_level < 0)
- abort ();
-
- /* This frees all unused blocs. It is not too inefficient, as the resize
- and memcpy is done only once. Afterwards, all unreferenced blocs are
- already shrunk to zero size. */
- if (!r_alloc_freeze_level)
- {
- bloc_ptr *b = &first_bloc;
- while (*b)
- if (!(*b)->variable)
- free_bloc (*b);
- else
- b = &(*b)->next;
- }
-}
-
#if defined (emacs) && defined (DOUG_LEA_MALLOC)
@@ -1190,12 +1153,23 @@ r_alloc_reset_variable (POINTER *old, POINTER *new)
}
if (bloc == NIL_BLOC || bloc->variable != old)
- abort (); /* Already freed? OLD not originally used to allocate? */
+ emacs_abort (); /* Already freed? OLD not originally used to allocate? */
/* Update variable to point to the new location. */
bloc->variable = new;
}
+void
+r_alloc_inhibit_buffer_relocation (int inhibit)
+{
+ if (use_relocatable_buffers > 1)
+ use_relocatable_buffers = 1;
+ if (inhibit)
+ use_relocatable_buffers--;
+ else if (use_relocatable_buffers < 1)
+ use_relocatable_buffers++;
+}
+
/***********************************************************************
Initialization
@@ -1220,20 +1194,26 @@ r_alloc_init (void)
first_heap->start = first_heap->bloc_start
= virtual_break_value = break_value = (*real_morecore) (0);
if (break_value == NIL)
- abort ();
+ emacs_abort ();
extra_bytes = ROUNDUP (50000);
#endif
#ifdef DOUG_LEA_MALLOC
- BLOCK_INPUT;
+ block_input ();
mallopt (M_TOP_PAD, 64 * 4096);
- UNBLOCK_INPUT;
+ unblock_input ();
#else
#ifndef SYSTEM_MALLOC
- /* Give GNU malloc's morecore some hysteresis
- so that we move all the relocatable blocks much less often. */
- __malloc_extra_blocks = 64;
+ /* Give GNU malloc's morecore some hysteresis so that we move all
+ the relocatable blocks much less often. The number used to be
+ 64, but alloc.c would override that with 32 in code that was
+ removed when SYNC_INPUT became the only input handling mode.
+ That code was conditioned on !DOUG_LEA_MALLOC, so the call to
+ mallopt above is left unchanged. (Actually, I think there's no
+ system nowadays that uses DOUG_LEA_MALLOC and also uses
+ REL_ALLOC.) */
+ __malloc_extra_blocks = 32;
#endif
#endif
diff --git a/src/regex.c b/src/regex.c
index 0ba05a95fdb..1473551e6cc 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -2,7 +2,7 @@
0.12. (Implements POSIX draft P1003.2/D11.2, except for some of the
internationalization features.)
- Copyright (C) 1993-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-2012 Free Software Foundation, Inc.
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
@@ -28,15 +28,26 @@
rather than at run-time, so that re_match can be reentrant.
*/
-/* AIX requires this to be the first thing in the file. */
+/* AIX requires this to be the first thing in the file. */
#if defined _AIX && !defined REGEX_MALLOC
#pragma alloca
#endif
-#ifdef HAVE_CONFIG_H
-# include <config.h>
+/* Ignore some GCC warnings for now. This section should go away
+ once the Emacs and Gnulib regex code is merged. */
+#if (__GNUC__ == 4 && 5 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic ignored "-Wstrict-overflow"
+# ifndef emacs
+# pragma GCC diagnostic ignored "-Wunused-but-set-variable"
+# pragma GCC diagnostic ignored "-Wunused-function"
+# pragma GCC diagnostic ignored "-Wunused-macros"
+# pragma GCC diagnostic ignored "-Wunused-result"
+# pragma GCC diagnostic ignored "-Wunused-variable"
+# endif
#endif
+#include <config.h>
+
#include <stddef.h>
#ifdef emacs
@@ -115,15 +126,14 @@
that make sense only in Emacs. */
#ifdef emacs
-# include <setjmp.h>
# include "lisp.h"
+# include "character.h"
# include "buffer.h"
/* Make syntax table lookup grant data in gl_state. */
# define SYNTAX_ENTRY_VIA_PROPERTY
# include "syntax.h"
-# include "character.h"
# include "category.h"
# ifdef malloc
@@ -198,11 +208,10 @@
/* When used in Emacs's lib-src, we need xmalloc and xrealloc. */
-void *
+static void *
xmalloc (size_t size)
{
- register void *val;
- val = (void *) malloc (size);
+ void *val = malloc (size);
if (!val && size)
{
write (2, "virtual memory exhausted\n", 25);
@@ -211,16 +220,16 @@ xmalloc (size_t size)
return val;
}
-void *
+static void *
xrealloc (void *block, size_t size)
{
- register void *val;
+ void *val;
/* We must call malloc explicitly when BLOCK is 0, since some
reallocs don't do this. */
if (! block)
- val = (void *) malloc (size);
+ val = malloc (size);
else
- val = (void *) realloc (block, size);
+ val = realloc (block, size);
if (!val && size)
{
write (2, "virtual memory exhausted\n", 25);
@@ -238,6 +247,7 @@ xrealloc (void *block, size_t size)
# endif
# define realloc xrealloc
+# include <stdbool.h>
# include <string.h>
/* Define the syntax stuff for \<, \>, etc. */
@@ -245,8 +255,6 @@ xrealloc (void *block, size_t size)
/* Sword must be nonzero for the wordchar pattern commands in re_match_2. */
enum syntaxcode { Swhitespace = 0, Sword = 1, Ssymbol = 2 };
-# define SWITCH_ENUM_CAST(x) (x)
-
/* Dummy macros for non-Emacs environments. */
# define CHAR_CHARSET(c) 0
# define CHARSET_LEADING_CODE_BASE(c) 0
@@ -421,17 +429,7 @@ init_syntax_once (void)
#endif /* not emacs */
-/* We remove any previous definition of `SIGN_EXTEND_CHAR',
- since ours (we hope) works properly with all combinations of
- machines, compilers, `char' and `unsigned char' argument types.
- (Per Bothner suggested the basic approach.) */
-#undef SIGN_EXTEND_CHAR
-#if __STDC__
-# define SIGN_EXTEND_CHAR(c) ((signed char) (c))
-#else /* not __STDC__ */
-/* As in Harbison and Steele. */
-# define SIGN_EXTEND_CHAR(c) ((((unsigned char) (c)) ^ 128) - 128)
-#endif
+#define SIGN_EXTEND_CHAR(c) ((signed char) (c))
/* Should we use malloc or alloca? If REGEX_MALLOC is not defined, we
use `alloca' instead of `malloc'. This is because using malloc in
@@ -537,15 +535,13 @@ typedef const unsigned char re_char;
#endif
typedef char boolean;
-#define false 0
-#define true 1
-
-static regoff_t re_match_2_internal _RE_ARGS ((struct re_pattern_buffer *bufp,
- re_char *string1, size_t size1,
- re_char *string2, size_t size2,
- ssize_t pos,
- struct re_registers *regs,
- ssize_t stop));
+
+static regoff_t re_match_2_internal (struct re_pattern_buffer *bufp,
+ re_char *string1, size_t size1,
+ re_char *string2, size_t size2,
+ ssize_t pos,
+ struct re_registers *regs,
+ ssize_t stop);
/* These are the command codes that appear in compiled regular
expressions. Some opcodes are followed by argument bytes. A
@@ -722,11 +718,8 @@ typedef enum
} while (0)
#ifdef DEBUG
-static void extract_number _RE_ARGS ((int *dest, re_char *source));
static void
-extract_number (dest, source)
- int *dest;
- re_char *source;
+extract_number (int *dest, re_char *source)
{
int temp = SIGN_EXTEND_CHAR (*(source + 1));
*dest = *source & 0377;
@@ -750,12 +743,8 @@ extract_number (dest, source)
} while (0)
#ifdef DEBUG
-static void extract_number_and_incr _RE_ARGS ((int *destination,
- re_char **source));
static void
-extract_number_and_incr (destination, source)
- int *destination;
- re_char **source;
+extract_number_and_incr (int *destination, re_char **source)
{
extract_number (destination, *source);
*source += 2;
@@ -1392,7 +1381,7 @@ typedef struct
#ifdef MATCH_MAY_ALLOCATE
# define INIT_FAIL_STACK() \
do { \
- fail_stack.stack = (fail_stack_elt_t *) \
+ fail_stack.stack = \
REGEX_ALLOCATE_STACK (INIT_FAILURE_ALLOC * TYPICAL_FAILURE_SIZE \
* sizeof (fail_stack_elt_t)); \
\
@@ -1435,8 +1424,7 @@ typedef struct
>= re_max_failures * TYPICAL_FAILURE_SIZE) \
? 0 \
: ((fail_stack).stack \
- = (fail_stack_elt_t *) \
- REGEX_REALLOCATE_STACK ((fail_stack).stack, \
+ = REGEX_REALLOCATE_STACK ((fail_stack).stack, \
(fail_stack).size * sizeof (fail_stack_elt_t), \
MIN (re_max_failures * TYPICAL_FAILURE_SIZE, \
((fail_stack).size * sizeof (fail_stack_elt_t) \
@@ -1659,25 +1647,22 @@ do { \
/* Subroutine declarations and macros for regex_compile. */
-static reg_errcode_t regex_compile _RE_ARGS ((re_char *pattern, size_t size,
- reg_syntax_t syntax,
- struct re_pattern_buffer *bufp));
-static void store_op1 _RE_ARGS ((re_opcode_t op, unsigned char *loc, int arg));
-static void store_op2 _RE_ARGS ((re_opcode_t op, unsigned char *loc,
- int arg1, int arg2));
-static void insert_op1 _RE_ARGS ((re_opcode_t op, unsigned char *loc,
- int arg, unsigned char *end));
-static void insert_op2 _RE_ARGS ((re_opcode_t op, unsigned char *loc,
- int arg1, int arg2, unsigned char *end));
-static boolean at_begline_loc_p _RE_ARGS ((re_char *pattern,
- re_char *p,
- reg_syntax_t syntax));
-static boolean at_endline_loc_p _RE_ARGS ((re_char *p,
- re_char *pend,
- reg_syntax_t syntax));
-static re_char *skip_one_char _RE_ARGS ((re_char *p));
-static int analyse_first _RE_ARGS ((re_char *p, re_char *pend,
- char *fastmap, const int multibyte));
+static reg_errcode_t regex_compile (re_char *pattern, size_t size,
+ reg_syntax_t syntax,
+ struct re_pattern_buffer *bufp);
+static void store_op1 (re_opcode_t op, unsigned char *loc, int arg);
+static void store_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2);
+static void insert_op1 (re_opcode_t op, unsigned char *loc,
+ int arg, unsigned char *end);
+static void insert_op2 (re_opcode_t op, unsigned char *loc,
+ int arg1, int arg2, unsigned char *end);
+static boolean at_begline_loc_p (re_char *pattern, re_char *p,
+ reg_syntax_t syntax);
+static boolean at_endline_loc_p (re_char *p, re_char *pend,
+ reg_syntax_t syntax);
+static re_char *skip_one_char (re_char *p);
+static int analyse_first (re_char *p, re_char *pend,
+ char *fastmap, const int multibyte);
/* Fetch the next character in the uncompiled pattern, with no
translation. */
@@ -1750,20 +1735,6 @@ static int analyse_first _RE_ARGS ((re_char *p, re_char *pend,
be too small, many things would have to change. */
# define MAX_BUF_SIZE (1L << 15)
-#if 0 /* This is when we thought it could be 2^16 bytes. */
-/* Any other compiler which, like MSC, has allocation limit below 2^16
- bytes will have to use approach similar to what was done below for
- MSC and drop MAX_BUF_SIZE a bit. Otherwise you may end up
- reallocating to 0 bytes. Such thing is not going to work too well.
- You have been warned!! */
-#if defined _MSC_VER && !defined WIN32
-/* Microsoft C 16-bit versions limit malloc to approx 65512 bytes. */
-# define MAX_BUF_SIZE 65500L
-#else
-# define MAX_BUF_SIZE (1L << 16)
-#endif
-#endif /* 0 */
-
/* Extend the buffer by twice its current size via realloc and
reset the pointers that pointed into the old block to point to the
correct places in the new one. If extending the buffer results in it
@@ -1860,10 +1831,9 @@ typedef struct
/* The next available element. */
#define COMPILE_STACK_TOP (compile_stack.stack[compile_stack.avail])
-/* Explicit quit checking is only used on NTemacs and whenever we
- use polling to process input events. */
-#if defined emacs && (defined WINDOWSNT || defined SYNC_INPUT) && defined QUIT
-extern int immediate_quit;
+/* Explicit quit checking is needed for Emacs, which uses polling to
+ process input events. */
+#ifdef emacs
# define IMMEDIATE_QUIT_CHECK \
do { \
if (immediate_quit) QUIT; \
@@ -2150,12 +2120,7 @@ static void
extend_range_table_work_area (struct range_table_work_area *work_area)
{
work_area->allocated += 16 * sizeof (int);
- if (work_area->table)
- work_area->table
- = (int *) realloc (work_area->table, work_area->allocated);
- else
- work_area->table
- = (int *) malloc (work_area->allocated);
+ work_area->table = realloc (work_area->table, work_area->allocated);
}
#if 0
@@ -2429,9 +2394,8 @@ regex_grow_registers (int num_regs)
#endif /* not MATCH_MAY_ALLOCATE */
-static boolean group_in_compile_stack _RE_ARGS ((compile_stack_type
- compile_stack,
- regnum_t regnum));
+static boolean group_in_compile_stack (compile_stack_type compile_stack,
+ regnum_t regnum);
/* `regex_compile' compiles PATTERN (of length SIZE) according to SYNTAX.
Returns one of error codes defined in `regex.h', or zero for success.
@@ -3751,16 +3715,8 @@ regex_compile (const re_char *pattern, size_t size, reg_syntax_t syntax, struct
if (fail_stack.size < re_max_failures * TYPICAL_FAILURE_SIZE)
{
fail_stack.size = re_max_failures * TYPICAL_FAILURE_SIZE;
-
- if (! fail_stack.stack)
- fail_stack.stack
- = (fail_stack_elt_t *) malloc (fail_stack.size
- * sizeof (fail_stack_elt_t));
- else
- fail_stack.stack
- = (fail_stack_elt_t *) realloc (fail_stack.stack,
- (fail_stack.size
- * sizeof (fail_stack_elt_t)));
+ falk_stack.stack = realloc (fail_stack.stack,
+ fail_stack.size * sizeof *falk_stack.stack);
}
regex_grow_registers (num_regs);
@@ -3832,18 +3788,37 @@ static boolean
at_begline_loc_p (const re_char *pattern, const re_char *p, reg_syntax_t syntax)
{
re_char *prev = p - 2;
- boolean prev_prev_backslash = prev > pattern && prev[-1] == '\\';
+ boolean odd_backslashes;
- return
- /* After a subexpression? */
- (*prev == '(' && (syntax & RE_NO_BK_PARENS || prev_prev_backslash))
- /* After an alternative? */
- || (*prev == '|' && (syntax & RE_NO_BK_VBAR || prev_prev_backslash))
- /* After a shy subexpression? */
- || ((syntax & RE_SHY_GROUPS) && prev - 2 >= pattern
- && prev[-1] == '?' && prev[-2] == '('
- && (syntax & RE_NO_BK_PARENS
- || (prev - 3 >= pattern && prev[-3] == '\\')));
+ /* After a subexpression? */
+ if (*prev == '(')
+ odd_backslashes = (syntax & RE_NO_BK_PARENS) == 0;
+
+ /* After an alternative? */
+ else if (*prev == '|')
+ odd_backslashes = (syntax & RE_NO_BK_VBAR) == 0;
+
+ /* After a shy subexpression? */
+ else if (*prev == ':' && (syntax & RE_SHY_GROUPS))
+ {
+ /* Skip over optional regnum. */
+ while (prev - 1 >= pattern && prev[-1] >= '0' && prev[-1] <= '9')
+ --prev;
+
+ if (!(prev - 2 >= pattern
+ && prev[-1] == '?' && prev[-2] == '('))
+ return false;
+ prev -= 2;
+ odd_backslashes = (syntax & RE_NO_BK_PARENS) == 0;
+ }
+ else
+ return false;
+
+ /* Count the number of preceding backslashes. */
+ p = prev;
+ while (prev - 1 >= pattern && prev[-1] == '\\')
+ --prev;
+ return (p - prev) & odd_backslashes;
}
@@ -3933,7 +3908,7 @@ analyse_first (const re_char *p, const re_char *pend, char *fastmap, const int m
as used for the *? operator. */
re_char *p1 = p;
- switch (SWITCH_ENUM_CAST ((re_opcode_t) *p++))
+ switch (*p++)
{
case succeed:
return 1;
@@ -4108,7 +4083,7 @@ analyse_first (const re_char *p, const re_char *pend, char *fastmap, const int m
visited. `re_compile' should make sure this is true. */
break;
p += j;
- switch (SWITCH_ENUM_CAST ((re_opcode_t) *p))
+ switch (*p)
{
case on_failure_jump:
case on_failure_keep_string_jump:
@@ -4541,10 +4516,10 @@ WEAK_ALIAS (__re_search_2, re_search_2)
/* Declarations and macros for re_match_2. */
-static int bcmp_translate _RE_ARGS ((re_char *s1, re_char *s2,
- register ssize_t len,
- RE_TRANSLATE_TYPE translate,
- const int multibyte));
+static int bcmp_translate (re_char *s1, re_char *s2,
+ register ssize_t len,
+ RE_TRANSLATE_TYPE translate,
+ const int multibyte);
/* This converts PTR, a pointer into one of the search strings `string1'
and `string2' into an offset from the beginning of that string. */
@@ -4641,7 +4616,7 @@ static int bcmp_translate _RE_ARGS ((re_char *s1, re_char *s2,
static re_char *
skip_one_char (const re_char *p)
{
- switch (SWITCH_ENUM_CAST (*p++))
+ switch (*p++)
{
case anychar:
break;
@@ -4686,7 +4661,7 @@ skip_noops (const re_char *p, const re_char *pend)
int mcnt;
while (p < pend)
{
- switch (SWITCH_ENUM_CAST ((re_opcode_t) *p))
+ switch (*p)
{
case start_memory:
case stop_memory:
@@ -4731,7 +4706,7 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, const re_char *p1, const r
op2 = p2 == pend ? succeed : *p2;
- switch (SWITCH_ENUM_CAST (op2))
+ switch (op2)
{
case succeed:
case endbuf:
@@ -4855,7 +4830,7 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, const re_char *p1, const r
break;
case charset_not:
- switch (SWITCH_ENUM_CAST (*p1))
+ switch (*p1)
{
case exactn:
case charset:
@@ -5333,7 +5308,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const re_char *string1,
}
/* Otherwise match next pattern command. */
- switch (SWITCH_ENUM_CAST ((re_opcode_t) *p++))
+ switch (*p++)
{
/* Ignore these. Used to ignore the n of succeed_n's which
currently have n == 0. */
@@ -6255,7 +6230,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const re_char *string1,
/* A restart point is known. Restore to that state. */
DEBUG_PRINT1 ("\nFAIL:\n");
POP_FAILURE_POINT (str, pat);
- switch (SWITCH_ENUM_CAST ((re_opcode_t) *pat++))
+ switch (*pat++)
{
case on_failure_keep_string_jump:
assert (str == NULL);
@@ -6399,13 +6374,13 @@ re_comp (const char *s)
if (!re_comp_buf.buffer)
{
- re_comp_buf.buffer = (unsigned char *) malloc (200);
+ re_comp_buf.buffer = malloc (200);
if (re_comp_buf.buffer == NULL)
/* Yes, we're discarding `const' here if !HAVE_LIBINTL. */
return (char *) gettext (re_error_msgid[(int) REG_ESPACE]);
re_comp_buf.allocated = 200;
- re_comp_buf.fastmap = (char *) malloc (1 << BYTEWIDTH);
+ re_comp_buf.fastmap = malloc (1 << BYTEWIDTH);
if (re_comp_buf.fastmap == NULL)
/* Yes, we're discarding `const' here if !HAVE_LIBINTL. */
return (char *) gettext (re_error_msgid[(int) REG_ESPACE]);
@@ -6489,15 +6464,13 @@ regcomp (regex_t *__restrict preg, const char *__restrict pattern,
preg->used = 0;
/* Try to allocate space for the fastmap. */
- preg->fastmap = (char *) malloc (1 << BYTEWIDTH);
+ preg->fastmap = malloc (1 << BYTEWIDTH);
if (cflags & REG_ICASE)
{
unsigned i;
- preg->translate
- = (RE_TRANSLATE_TYPE) malloc (CHAR_SET_SIZE
- * sizeof (*(RE_TRANSLATE_TYPE)0));
+ preg->translate = malloc (CHAR_SET_SIZE * sizeof *preg->translate);
if (preg->translate == NULL)
return (int) REG_ESPACE;
@@ -6652,7 +6625,7 @@ regerror (int err_code, const regex_t *preg, char *errbuf, size_t errbuf_size)
{
if (msg_size > errbuf_size)
{
- strncpy (errbuf, msg, errbuf_size - 1);
+ memcpy (errbuf, msg, errbuf_size - 1);
errbuf[errbuf_size - 1] = 0;
}
else
diff --git a/src/regex.h b/src/regex.h
index 32ccfb7ddef..e0ede012b20 100644
--- a/src/regex.h
+++ b/src/regex.h
@@ -1,7 +1,7 @@
/* Definitions for data structures and routines for the regular
expression library, version 0.12.
- Copyright (C) 1985, 1989-1993, 1995, 2000-2011
+ Copyright (C) 1985, 1989-1993, 1995, 2000-2012
Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
@@ -451,38 +451,21 @@ typedef struct
/* Declarations for routines. */
-/* To avoid duplicating every routine declaration -- once with a
- prototype (if we are ANSI), and once without (if we aren't) -- we
- use the following macro to declare argument types. This
- unfortunately clutters up the declarations a bit, but I think it's
- worth it. */
-
-#if defined __STDC__ || defined PROTOTYPES
-
-# define _RE_ARGS(args) args
-
-#else /* not __STDC__ || PROTOTYPES */
-
-# define _RE_ARGS(args) ()
-
-#endif /* not __STDC__ || PROTOTYPES */
-
/* Sets the current default syntax to SYNTAX, and return the old syntax.
You can also simply assign to the `re_syntax_options' variable. */
-extern reg_syntax_t re_set_syntax _RE_ARGS ((reg_syntax_t syntax));
+extern reg_syntax_t re_set_syntax (reg_syntax_t __syntax);
/* Compile the regular expression PATTERN, with length LENGTH
and syntax given by the global `re_syntax_options', into the buffer
BUFFER. Return NULL if successful, and an error string if not. */
-extern const char *re_compile_pattern
- _RE_ARGS ((const char *pattern, size_t length,
- struct re_pattern_buffer *buffer));
+extern const char *re_compile_pattern (const char *__pattern, size_t __length,
+ struct re_pattern_buffer *__buffer);
/* Compile a fastmap for the compiled pattern in BUFFER; used to
accelerate searches. Return 0 if successful and -2 if was an
internal error. */
-extern int re_compile_fastmap _RE_ARGS ((struct re_pattern_buffer *buffer));
+extern int re_compile_fastmap (struct re_pattern_buffer *__buffer);
/* Search in the string STRING (with length LENGTH) for the pattern
@@ -490,33 +473,35 @@ extern int re_compile_fastmap _RE_ARGS ((struct re_pattern_buffer *buffer));
characters. Return the starting position of the match, -1 for no
match, or -2 for an internal error. Also return register
information in REGS (if REGS and BUFFER->no_sub are nonzero). */
-extern regoff_t re_search
- _RE_ARGS ((struct re_pattern_buffer *buffer, const char *string,
- size_t length, ssize_t start, ssize_t range,
- struct re_registers *regs));
+extern regoff_t re_search (struct re_pattern_buffer *__buffer,
+ const char *__string, size_t __length,
+ ssize_t __start, ssize_t __range,
+ struct re_registers *__regs);
/* Like `re_search', but search in the concatenation of STRING1 and
STRING2. Also, stop searching at index START + STOP. */
-extern regoff_t re_search_2
- _RE_ARGS ((struct re_pattern_buffer *buffer, const char *string1,
- size_t length1, const char *string2, size_t length2,
- ssize_t start, ssize_t range, struct re_registers *regs,
- ssize_t stop));
+extern regoff_t re_search_2 (struct re_pattern_buffer *__buffer,
+ const char *__string1, size_t __length1,
+ const char *__string2, size_t __length2,
+ ssize_t __start, ssize_t __range,
+ struct re_registers *__regs,
+ ssize_t __stop);
/* Like `re_search', but return how many characters in STRING the regexp
in BUFFER matched, starting at position START. */
-extern regoff_t re_match
- _RE_ARGS ((struct re_pattern_buffer *buffer, const char *string,
- size_t length, ssize_t start, struct re_registers *regs));
+extern regoff_t re_match (struct re_pattern_buffer *__buffer,
+ const char *__string, size_t __length,
+ ssize_t __start, struct re_registers *__regs);
/* Relates to `re_match' as `re_search_2' relates to `re_search'. */
-extern regoff_t re_match_2
- _RE_ARGS ((struct re_pattern_buffer *buffer, const char *string1,
- size_t length1, const char *string2, size_t length2,
- ssize_t start, struct re_registers *regs, ssize_t stop));
+extern regoff_t re_match_2 (struct re_pattern_buffer *__buffer,
+ const char *__string1, size_t __length1,
+ const char *__string2, size_t __length2,
+ ssize_t __start, struct re_registers *__regs,
+ ssize_t __stop);
/* Set REGS to hold NUM_REGS registers, storing them in STARTS and
@@ -531,15 +516,16 @@ extern regoff_t re_match_2
Unless this function is called, the first search or match using
PATTERN_BUFFER will allocate its own register data, without
freeing the old data. */
-extern void re_set_registers
- _RE_ARGS ((struct re_pattern_buffer *buffer, struct re_registers *regs,
- unsigned num_regs, regoff_t *starts, regoff_t *ends));
+extern void re_set_registers (struct re_pattern_buffer *__buffer,
+ struct re_registers *__regs,
+ unsigned __num_regs,
+ regoff_t *__starts, regoff_t *__ends);
#if defined _REGEX_RE_COMP || defined _LIBC
# ifndef _CRAY
/* 4.2 bsd compatibility. */
-extern char *re_comp _RE_ARGS ((const char *));
-extern int re_exec _RE_ARGS ((const char *));
+extern char *re_comp (const char *);
+extern int re_exec (const char *);
# endif
#endif
@@ -562,20 +548,19 @@ extern int re_exec _RE_ARGS ((const char *));
#endif
/* POSIX compatibility. */
-extern reg_errcode_t regcomp _RE_ARGS ((regex_t *__restrict __preg,
- const char *__restrict __pattern,
- int __cflags));
+extern reg_errcode_t regcomp (regex_t *__restrict __preg,
+ const char *__restrict __pattern,
+ int __cflags);
-extern reg_errcode_t regexec _RE_ARGS ((const regex_t *__restrict __preg,
- const char *__restrict __string,
- size_t __nmatch,
- regmatch_t __pmatch[__restrict_arr],
- int __eflags));
+extern reg_errcode_t regexec (const regex_t *__restrict __preg,
+ const char *__restrict __string, size_t __nmatch,
+ regmatch_t __pmatch[__restrict_arr],
+ int __eflags);
-extern size_t regerror _RE_ARGS ((int __errcode, const regex_t *__preg,
- char *__errbuf, size_t __errbuf_size));
+extern size_t regerror (int __errcode, const regex_t * __preg,
+ char *__errbuf, size_t __errbuf_size);
-extern void regfree _RE_ARGS ((regex_t *__preg));
+extern void regfree (regex_t *__preg);
#ifdef __cplusplus
diff --git a/src/region-cache.c b/src/region-cache.c
index 054374eb688..832f4bfd214 100644
--- a/src/region-cache.c
+++ b/src/region-cache.c
@@ -1,6 +1,6 @@
/* Caching facts about regions of the buffer, for optimization.
-Copyright (C) 1985-1989, 1993, 1995, 2001-2011
+Copyright (C) 1985-1989, 1993, 1995, 2001-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,9 +21,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "region-cache.h"
@@ -131,15 +131,13 @@ static void revalidate_region_cache (struct buffer *buf, struct region_cache *c)
struct region_cache *
new_region_cache (void)
{
- struct region_cache *c
- = (struct region_cache *) xmalloc (sizeof (struct region_cache));
+ struct region_cache *c = xmalloc (sizeof *c);
c->gap_start = 0;
c->gap_len = NEW_CACHE_GAP;
c->cache_len = 0;
- c->boundaries =
- (struct boundary *) xmalloc ((c->gap_len + c->cache_len)
- * sizeof (*c->boundaries));
+ c->boundaries = xmalloc ((c->gap_len + c->cache_len)
+ * sizeof (*c->boundaries));
c->beg_unchanged = 0;
c->end_unchanged = 0;
@@ -195,7 +193,7 @@ find_cache_boundary (struct region_cache *c, ptrdiff_t pos)
if (BOUNDARY_POS (c, low) > pos
|| (low + 1 < c->cache_len
&& BOUNDARY_POS (c, low + 1) <= pos))
- abort ();
+ emacs_abort ();
return low;
}
@@ -218,12 +216,12 @@ move_cache_gap (struct region_cache *c, ptrdiff_t pos, ptrdiff_t min_size)
if (pos < 0
|| pos > c->cache_len)
- abort ();
+ emacs_abort ();
/* We mustn't ever try to put the gap before the dummy start
boundary. That must always be start-relative. */
if (pos == 0)
- abort ();
+ emacs_abort ();
/* Need we move the gap right? */
while (gap_start < pos)
@@ -246,16 +244,16 @@ move_cache_gap (struct region_cache *c, ptrdiff_t pos, ptrdiff_t min_size)
when the portion after the gap is smallest. */
if (gap_len < min_size)
{
- ptrdiff_t i;
+ ptrdiff_t i, nboundaries = c->cache_len;
c->boundaries =
- xpalloc (c->boundaries, &c->cache_len, min_size, -1,
+ xpalloc (c->boundaries, &nboundaries, min_size - gap_len, -1,
sizeof *c->boundaries);
/* Some systems don't provide a version of the copy routine that
can be trusted to shift memory upward into an overlapping
region. memmove isn't widely available. */
- min_size -= gap_len;
+ min_size = nboundaries - c->cache_len - gap_len;
for (i = c->cache_len - 1; i >= gap_start; i--)
{
c->boundaries[i + min_size].pos = c->boundaries[i + gap_len].pos;
@@ -292,24 +290,24 @@ insert_cache_boundary (struct region_cache *c, ptrdiff_t i, ptrdiff_t pos,
{
/* i must be a valid cache index. */
if (i < 0 || i > c->cache_len)
- abort ();
+ emacs_abort ();
/* We must never want to insert something before the dummy first
boundary. */
if (i == 0)
- abort ();
+ emacs_abort ();
/* We must only be inserting things in order. */
if (! (BOUNDARY_POS (c, i - 1) < pos
&& (i == c->cache_len
|| pos < BOUNDARY_POS (c, i))))
- abort ();
+ emacs_abort ();
/* The value must be different from the ones around it. However, we
temporarily create boundaries that establish the same value as
the subsequent boundary, so we're not going to flag that case. */
if (BOUNDARY_VALUE (c, i - 1) == value)
- abort ();
+ emacs_abort ();
move_cache_gap (c, i, 1);
@@ -332,16 +330,16 @@ delete_cache_boundaries (struct region_cache *c,
/* Gotta be in range. */
if (start < 0
|| end > c->cache_len)
- abort ();
+ emacs_abort ();
/* Gotta be in order. */
if (start > end)
- abort ();
+ emacs_abort ();
/* Can't delete the dummy entry. */
if (start == 0
&& end >= 1)
- abort ();
+ emacs_abort ();
/* Minimize gap motion. If we're deleting nothing, do nothing. */
if (len == 0)
@@ -381,10 +379,10 @@ set_cache_region (struct region_cache *c,
ptrdiff_t start, ptrdiff_t end, int value)
{
if (start > end)
- abort ();
+ emacs_abort ();
if (start < c->buffer_beg
|| end > c->buffer_end)
- abort ();
+ emacs_abort ();
/* Eliminate this case; then we can assume that start and end-1 are
both the locations of real characters in the buffer. */
diff --git a/src/region-cache.h b/src/region-cache.h
index 6758f8bcd08..7aebdbec262 100644
--- a/src/region-cache.h
+++ b/src/region-cache.h
@@ -1,6 +1,6 @@
/* Header file: Caching facts about regions of the buffer, for optimization.
-Copyright (C) 1985-1986, 1993, 1995, 2001-2011
+Copyright (C) 1985-1986, 1993, 1995, 2001-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/s/README b/src/s/README
deleted file mode 100644
index c02097e257d..00000000000
--- a/src/s/README
+++ /dev/null
@@ -1,8 +0,0 @@
-This directory contains C header files containing
-operating-system-specific definitions. Each file describes a
-particular operating system. The emacs configuration script edits
-../config.h to include the appropriate one of these files, and then
-each emacs source file includes config.h.
-
-template.h is a generic template for system descriptions; it describes
-the parameters a system file can specify.
diff --git a/src/s/aix4-2.h b/src/s/aix4-2.h
deleted file mode 100644
index b44bd0308a3..00000000000
--- a/src/s/aix4-2.h
+++ /dev/null
@@ -1,77 +0,0 @@
-/*
-Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-/* Define symbols to identify the version of Unix this is.
- Define all the symbols that apply correctly. */
-#define USG /* System III, System V, etc */
-#define USG5
-
-/* This symbol should be defined on AIX Version 3 ??????? */
-#ifndef _AIX
-#define _AIX
-#endif
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "aix"
-
-/* In AIX, you allocate a pty by opening /dev/ptc to get the master side.
- To get the name of the slave side, you just ttyname() the master side. */
-#define PTY_ITERATION int c; for (c = 0; !c ; c++)
-#define PTY_NAME_SPRINTF strcpy (pty_name, "/dev/ptc");
-#define PTY_TTY_NAME_SPRINTF strcpy (pty_name, ttyname (fd));
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-
-/* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */
-#define HAVE_SOCKETS
-
-/* Special items needed to make Emacs run on this system. */
-
-/* AIX doesn't define this. */
-#define unix 1
-
-/* Perry Smith <pedz@ddivt1.austin.ibm.com> says these are correct. */
-#define SIGNALS_VIA_CHARACTERS
-#define CLASH_DETECTION
-
-/* Perry Smith <pedz@ddivt1.austin.ibm.com> says these are correct. */
-#undef sigmask
-
-#ifndef HAVE_LIBXMU
-/* Unfortunately without libXmu we cannot support EditRes. */
-#define NO_EDITRES
-#endif
-
-/* On AIX Emacs uses the gmalloc.c malloc implementation. But given
- the way this system works, libc functions that return malloced
- memory use the libc malloc implementation. Calling xfree or
- xrealloc on the results of such functions results in a crash.
-
- One solution for this could be to define SYSTEM_MALLOC in configure,
- but that does not currently work on this system.
-
- It is possible to completely override the malloc implementation on
- AIX, but that involves putting the malloc functions in a shared
- library and setting the MALLOCTYPE environment variable to point to
- that shared library.
-
- Emacs currently calls xrealloc on the results of get_current_dir name,
- to avoid a crash just use the Emacs implementation for that function. */
-#define BROKEN_GET_CURRENT_DIR_NAME 1
diff --git a/src/s/bsd-common.h b/src/s/bsd-common.h
deleted file mode 100644
index 0cca005b423..00000000000
--- a/src/s/bsd-common.h
+++ /dev/null
@@ -1,72 +0,0 @@
-/* Definitions file for GNU Emacs running on bsd 4.3
-
-Copyright (C) 1985-1986, 2001-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-
-/* Define symbols to identify the version of Unix this is.
- Define all the symbols that apply correctly. */
-
-/* We give these symbols the numeric values found in <sys/param.h> to
- avoid warnings about redefined macros. */
-#ifndef BSD4_3
-#define BSD4_3 1
-#endif /* BSD4_3 */
-
-#ifndef BSD_SYSTEM
-#define BSD_SYSTEM 43
-#endif /* BSD_SYSTEM */
-
-/* For mem-limits.h. */
-#define BSD4_2
-
-#define TABDLY OXTABS
-#define TAB3 OXTABS
-
-#define NO_TERMIO
-
-/* If the system's imake configuration file defines `NeedWidePrototypes'
- as `NO', we must define NARROWPROTO manually. Such a define is
- generated in the Makefile generated by `xmkmf'. If we don't
- define NARROWPROTO, we will see the wrong function prototypes
- for X functions taking float or double parameters. */
-#define NARROWPROTO 1
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "berkeley-unix"
-
-/* Do not use interrupt_input = 1 by default, because in 4.3
- we can make noninterrupt input work properly. */
-#undef INTERRUPT_INPUT
-
-/* First pty name is /dev/ptyp0. */
-#define FIRST_PTY_LETTER 'p'
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-
-/* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */
-#define HAVE_SOCKETS
-
-/* Define CLASH_DETECTION if you want lock files to be written
- so that Emacs can tell instantly when you try to modify
- a file that someone else has modified in his Emacs. */
-#define CLASH_DETECTION
-
-/* Send signals to subprocesses by "typing" special chars at them. */
-#define SIGNALS_VIA_CHARACTERS
diff --git a/src/s/cygwin.h b/src/s/cygwin.h
deleted file mode 100644
index 8f5a0ab1fc7..00000000000
--- a/src/s/cygwin.h
+++ /dev/null
@@ -1,101 +0,0 @@
-/* System description header file for Cygwin.
-
-Copyright (C) 1985-1986, 1992, 1999, 2002-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "cygwin"
-
-/* Emacs can read input using SIGIO and buffering characters itself,
- or using CBREAK mode and making C-g cause SIGINT.
- The choice is controlled by the variable interrupt_input.
-
- Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO)
-
- Emacs uses the presence or absence of the SIGIO and BROKEN_SIGIO macros
- to indicate whether or not signal-driven I/O is possible. It uses
- INTERRUPT_INPUT to decide whether to use it by default.
-
- SIGIO can be used only on systems that implement it (4.2 and 4.3).
- CBREAK mode has two disadvantages
- 1) At least in 4.2, it is impossible to handle the Meta key properly.
- I hear that in system V this problem does not exist.
- 2) Control-G causes output to be discarded.
- I do not know whether this can be fixed in system V.
-
- Another method of doing input is planned but not implemented.
- It would have Emacs fork off a separate process
- to read the input and send it to the true Emacs process
- through a pipe. */
-#undef INTERRUPT_INPUT
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-#define PTY_ITERATION int i; for (i = 0; i < 1; i++) /* ick */
-#define PTY_NAME_SPRINTF /* none */
-#define PTY_TTY_NAME_SPRINTF /* none */
-#define PTY_OPEN \
- do \
- { \
- int dummy; \
- SIGMASKTYPE mask; \
- mask = sigblock (sigmask (SIGCHLD)); \
- if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) \
- fd = -1; \
- sigsetmask (mask); \
- emacs_close (dummy); \
- } \
- while (0)
-
-/* Define CLASH_DETECTION if you want lock files to be written
- so that Emacs can tell instantly when you try to modify
- a file that someone else has modified in his Emacs. */
-#define CLASH_DETECTION
-
-/* If the system's imake configuration file defines `NeedWidePrototypes'
- as `NO', we must define NARROWPROTO manually. Such a define is
- generated in the Makefile generated by `xmkmf'. If we don't
- define NARROWPROTO, we will see the wrong function prototypes
- for X functions taking float or double parameters. */
-#define NARROWPROTO 1
-
-/* Used in various places to enable cygwin-specific code changes. */
-#define CYGWIN 1
-
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)
-
-#define HAVE_SOCKETS
-
-/* vfork() interacts badly with setsid(), causing ptys to fail to
- change their controlling terminal */
-#define vfork fork
-
-/* This should work (at least when compiling with gcc). But I have no way
- or intention to verify or even test it. If you encounter a problem with
- it, feel free to change this setting, but please add a comment here about
- why it needed to be changed. */
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
-
-/* Emacs supplies its own malloc, but glib (part of Gtk+) calls
- memalign and on Cygwin, that becomes the Cygwin-supplied memalign.
- As malloc is not the Cygwin malloc, the Cygwin memalign always
- returns ENOSYS. A workaround is to set G_SLICE=always-malloc. */
-#define G_SLICE_ALWAYS_MALLOC
-
-/* Send signals to subprocesses by "typing" special chars at them. */
-#define SIGNALS_VIA_CHARACTERS
diff --git a/src/s/darwin.h b/src/s/darwin.h
deleted file mode 100644
index dd0d0c34021..00000000000
--- a/src/s/darwin.h
+++ /dev/null
@@ -1,150 +0,0 @@
-/* System description header file for Darwin (Mac OS X).
-
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-
-/* Define symbols to identify the version of Unix this is.
- Define all the symbols that apply correctly. */
-#define BSD4_2
-/* BSD4_3 and BSD4_4 are already defined in sys/param.h */
-#define BSD_SYSTEM
-
-/* More specific than the above two. We cannot use __APPLE__ as this
- may not be defined on non-OSX Darwin, and we cannot define DARWIN
- here because Panther and lower CoreFoundation.h uses DARWIN to
- distinguish OS X from pure Darwin. */
-#define DARWIN_OS
-
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "darwin"
-
-/* Emacs can read input using SIGIO and buffering characters itself,
- or using CBREAK mode and making C-g cause SIGINT.
- The choice is controlled by the variable interrupt_input.
-
- Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO)
-
- Emacs uses the presence or absence of the SIGIO and BROKEN_SIGIO macros
- to indicate whether or not signal-driven I/O is possible. It uses
- INTERRUPT_INPUT to decide whether to use it by default.
-
- SIGIO can be used only on systems that implement it (4.2 and 4.3).
- CBREAK mode has two disadvantages
- 1) At least in 4.2, it is impossible to handle the Meta key properly.
- I hear that in system V this problem does not exist.
- 2) Control-G causes output to be discarded.
- I do not know whether this can be fixed in system V.
-
- Another method of doing input is planned but not implemented.
- It would have Emacs fork off a separate process
- to read the input and send it to the true Emacs process
- through a pipe. */
-#define INTERRUPT_INPUT
-
-/* Letter to use in finding device name of first pty,
- if system supports pty's. 'a' means it is /dev/ptya0 */
-#define FIRST_PTY_LETTER 'p'
-
-#define NO_TERMIO
-
-/* Define HAVE_PTYS if the system supports pty devices.
- Note: PTYs are broken on darwin <6. Use at your own risk. */
-#define HAVE_PTYS
-/* Run only once. We need a `for'-loop because the code uses `continue'. */
-#define PTY_ITERATION int i; for (i = 0; i < 1; i++)
-#define PTY_NAME_SPRINTF /* none */
-#define PTY_TTY_NAME_SPRINTF /* none */
-/* Note that openpty may fork via grantpt on Mac OS X 10.4/Darwin 8.
- But we don't have to block SIGCHLD because it is blocked in the
- implementation of grantpt. */
-#define PTY_OPEN \
- do \
- { \
- int slave; \
- if (openpty (&fd, &slave, pty_name, NULL, NULL) == -1) \
- fd = -1; \
- else \
- emacs_close (slave); \
- } \
- while (0)
-
-/* PTYs only work correctly on Darwin 7 or higher. So make the default
- for process-connection-type dependent on the kernel version. */
-#define MIN_PTY_KERNEL_VERSION '7'
-
-/* Define CLASH_DETECTION if you want lock files to be written
- so that Emacs can tell instantly when you try to modify
- a file that someone else has modified in his Emacs. */
-#define CLASH_DETECTION
-
-/* Avoid the use of the name init_process (process.c) because it is
- also the name of a Mach system call. */
-#define init_process emacs_init_process
-
-/* Used in dispnew.c. Copied from freebsd.h. */
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)
-
-/* System uses OXTABS instead of the expected TAB3. (Copied from bsd386.h.) */
-#define TAB3 OXTABS
-
-/* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */
-#define HAVE_SOCKETS
-
-/* Definitions for how to compile & link. */
-#ifdef HAVE_NS
-#define SYSTEM_PURESIZE_EXTRA 200000
-#endif
-
-/* On Darwin, res_init appears not to be useful: see bug#562 and
- http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01467.html */
-#undef HAVE_RES_INIT
-#undef HAVE_LIBRESOLV
-
-#ifdef emacs
-#define malloc unexec_malloc
-#define realloc unexec_realloc
-#define free unexec_free
-/* Don't use posix_memalign because it is not compatible with unexmacosx.c. */
-#undef HAVE_POSIX_MEMALIGN
-#endif
-
-/* Define the following so emacs symbols will not conflict with those
- in the System framework. Otherwise -prebind will not work. */
-
-/* Do not define abort in emacs.c. */
-#define NO_ABORT
-
-/* Do not define matherr in floatfns.c. */
-#define NO_MATHERR
-
-/* The following solves the problem that Emacs hangs when evaluating
- (make-comint "test0" "/nodir/nofile" nil "") when /nodir/nofile
- does not exist. Also, setsid is not allowed in the vfork child's
- context as of Darwin 9/Mac OS X 10.5. */
-#undef HAVE_WORKING_VFORK
-#define vfork fork
-
-/* Don't close pty in process.c to make it as controlling terminal.
- It is already a controlling terminal of subprocess, because we did
- ioctl TIOCSCTTY. */
-#define DONT_REOPEN_PTY
-
-/* Use the GC_MAKE_GCPROS_NOOPS (see lisp.h) method for marking the stack. */
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
diff --git a/src/s/freebsd.h b/src/s/freebsd.h
deleted file mode 100644
index 24b34e02f69..00000000000
--- a/src/s/freebsd.h
+++ /dev/null
@@ -1,63 +0,0 @@
-/* System description header for FreeBSD systems.
-
-Copyright (C) 1994-2011 Free Software Foundation, Inc.
-
-Author: Shawn M. Carey
-(according to authors.el)
-
-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/>. */
-
-/* Get most of the stuff from bsd-common */
-#include "bsd-common.h"
-
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)
-
-/* This silences a few compilation warnings. */
-#undef BSD_SYSTEM
-#if __FreeBSD__ == 1
-#define BSD_SYSTEM 199103
-#elif __FreeBSD__ == 2
-#define BSD_SYSTEM 199306
-#elif __FreeBSD__ >= 3
-#define BSD_SYSTEM 199506
-#endif
-
-/* Don't close pty in process.c to make it as controlling terminal.
- It is already a controlling terminal of subprocess, because we did
- ioctl TIOCSCTTY. */
-#define DONT_REOPEN_PTY
-
-/* Circumvent a bug in FreeBSD. In the following sequence of
- writes/reads on a PTY, read(2) returns bogus data:
-
- write(2) 1022 bytes
- write(2) 954 bytes, get EAGAIN
- read(2) 1024 bytes in process_read_output
- read(2) 11 bytes in process_read_output
-
- That is, read(2) returns more bytes than have ever been written
- successfully. The 1033 bytes read are the 1022 bytes written
- successfully after processing (for example with CRs added if the
- terminal is set up that way which it is here). The same bytes will
- be seen again in a later read(2), without the CRs. */
-#define BROKEN_PTY_READ_AFTER_EAGAIN 1
-
-/* Tell that garbage collector that setjmp is known to save all
- registers relevant for conservative garbage collection in the jmp_buf. */
-#define GC_SETJMP_WORKS 1
-
-/* Use the GC_MAKE_GCPROS_NOOPS (see lisp.h) method for marking the stack. */
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
diff --git a/src/s/gnu-kfreebsd.h b/src/s/gnu-kfreebsd.h
deleted file mode 100644
index a85571915df..00000000000
--- a/src/s/gnu-kfreebsd.h
+++ /dev/null
@@ -1,9 +0,0 @@
-#include "gnu-linux.h"
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#undef SYSTEM_TYPE
-#define SYSTEM_TYPE "gnu/kfreebsd" /* All the best software is free */
-
-#define NO_TERMIO /* use only <termios.h> */
-
diff --git a/src/s/gnu-linux.h b/src/s/gnu-linux.h
deleted file mode 100644
index d89b14cc080..00000000000
--- a/src/s/gnu-linux.h
+++ /dev/null
@@ -1,161 +0,0 @@
-/* This file is the configuration file for Linux-based GNU systems
-
-Copyright (C) 1985-1986, 1992, 1994, 1996, 1999, 2001-2011
- Free Software Foundation, Inc.
-
-This file was put together by Michael K. Johnson and Rik Faith.
-
-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/>. */
-
-/* Define symbols to identify the version of Unix this is.
- Define all the symbols that apply correctly. */
-#define USG
-#define GNU_LINUX
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "gnu/linux" /* All the best software is free. */
-
-#ifdef emacs
-#ifdef HAVE_LINUX_VERSION_H
-#include <linux/version.h>
-
-#if LINUX_VERSION_CODE >= 0x20400
-/* 21 Jun 06: Eric Hanchrow <offby1@blarg.net> says this works. */
-#define SIGNALS_VIA_CHARACTERS
-#endif /* LINUX_VERSION_CODE >= 0x20400 */
-#endif /* HAVE_LINUX_VERSION_H */
-#endif /* emacs */
-
-#if defined HAVE_GRANTPT
-#define UNIX98_PTYS
-
-/* Run only once. We need a `for'-loop because the code uses `continue'. */
-#define PTY_ITERATION int i; for (i = 0; i < 1; i++)
-
-#ifdef HAVE_GETPT
-#define PTY_NAME_SPRINTF
-#define PTY_OPEN fd = getpt ()
-#else /* not HAVE_GETPT */
-#define PTY_NAME_SPRINTF strcpy (pty_name, "/dev/ptmx");
-#endif /* not HAVE_GETPT */
-
-/* Note that grantpt and unlockpt may fork. We must block SIGCHLD to
- prevent sigchld_handler from intercepting the child's death. */
-#define PTY_TTY_NAME_SPRINTF \
- { \
- char *ptyname; \
- \
- sigblock (sigmask (SIGCHLD)); \
- if (grantpt (fd) == -1 || unlockpt (fd) == -1 \
- || !(ptyname = ptsname(fd))) \
- { \
- sigunblock (sigmask (SIGCHLD)); \
- close (fd); \
- return -1; \
- } \
- strncpy (pty_name, ptyname, sizeof (pty_name)); \
- pty_name[sizeof (pty_name) - 1] = 0; \
- sigunblock (sigmask (SIGCHLD)); \
- }
-
-#else /* not HAVE_GRANTPT */
-
-/* Letter to use in finding device name of first pty,
- if system supports pty's. 'p' means it is /dev/ptyp0 */
-#define FIRST_PTY_LETTER 'p'
-
-#endif /* not HAVE_GRANTPT */
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-
-#define HAVE_SOCKETS
-
-/* This is used in list_system_processes. */
-#define HAVE_PROCFS 1
-
-/* Define CLASH_DETECTION if you want lock files to be written
- so that Emacs can tell instantly when you try to modify
- a file that someone else has modified in his Emacs. */
-#define CLASH_DETECTION
-
-/* Here, on a separate page, add any special hacks needed
- to make Emacs work on this system. For example,
- you might define certain system call names that don't
- exist on your system, or that do different things on
- your system and must be used only through an encapsulation
- (Which you should place, by convention, in sysdep.c). */
-
-/* This is needed for dispnew.c:update_frame. */
-#ifdef emacs
-#include <stdio.h> /* Get the definition of _IO_STDIO_H. */
-#if defined (_IO_STDIO_H) || defined (_STDIO_USES_IOSTREAM)
-/* New C libio names. */
-#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \
- ((FILE)->_IO_write_ptr - (FILE)->_IO_write_base)
-#elif defined (__UCLIBC__)
-/* Using the uClibc library. */
-#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \
- ((FILE)->__bufpos - (FILE)->__bufstart)
-#else /* !_IO_STDIO_H && ! __UCLIBC__ */
-/* Old C++ iostream names. */
-#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \
- ((FILE)->_pptr - (FILE)->_pbase)
-#endif /* !_IO_STDIO_H && ! __UCLIBC__ */
-
-#define INTERRUPT_INPUT
-#endif /* emacs */
-
-#define POSIX /* affects getpagesize.h and systty.h */
-
-/* This is to work around mysterious gcc failures in some system versions.
- It is unlikely that Emacs changes will work around this problem;
- therefore, this should remain permanently. */
-#ifndef HAVE_XRMSETDATABASE
-#define HAVE_XRMSETDATABASE
-#endif
-
-#define NARROWPROTO 1
-
-/* Tell that garbage collector that setjmp is known to save all
- registers relevant for conservative garbage collection in the jmp_buf. */
-/* Not all the architectures are tested, but there are Debian packages
- for SCM and/or Guile on them, so the technique must work. See also
- comments in alloc.c concerning setjmp and gcc. Fixme: it's
- probably safe to make this conditional just on GCC, except for ia64
- register window-flushing. */
-/* Don't use #cpu here since in newest development versions of GCC,
- we must call cpp with -traditional, and that disables #cpu. */
-#if defined __i386__ || defined __sparc__ || defined __mc68000__ \
- || defined __alpha__ || defined __mips__ || defined __s390__ \
- || defined __arm__ || defined __powerpc__ || defined __amd64__ \
- || defined __ia64__ || defined __sh__
-#define GC_SETJMP_WORKS 1
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
-#ifdef __mc68000__
-#define GC_LISP_OBJECT_ALIGNMENT 2
-#endif
-#ifdef __ia64__
-#define GC_MARK_SECONDARY_STACK() \
- do { \
- extern void *__libc_ia64_register_backing_store_base; \
- __builtin_ia64_flushrs (); \
- mark_memory (__libc_ia64_register_backing_store_base, \
- __builtin_ia64_bsp ()); \
- } while (0)
-#endif
-#endif
diff --git a/src/s/gnu.h b/src/s/gnu.h
deleted file mode 100644
index b40f7b0a95b..00000000000
--- a/src/s/gnu.h
+++ /dev/null
@@ -1,48 +0,0 @@
-/* Definitions file for GNU Emacs running on the GNU Hurd.
-
-Copyright (C) 1994-1996, 2001-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-
-/* Get most of the stuff from bsd-common */
-#include "bsd-common.h"
-
-#undef SYSTEM_TYPE
-#define SYSTEM_TYPE "gnu"
-
-#undef NLIST_STRUCT
-
-#define SIGNALS_VIA_CHARACTERS
-
-/* libc defines data_start. */
-#define DATA_START ({ extern int data_start; (char *) &data_start; })
-
-/* Some losing code fails to include this and then assumes
- that because it is braindead that O_RDONLY==0. */
-#include <fcntl.h>
-
-#ifdef emacs
-#include <stdio.h> /* Get the definition of _IO_STDIO_H. */
-#if defined (_IO_STDIO_H) || defined (_STDIO_USES_IOSTREAM)
-/* new C libio names */
-#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \
- ((FILE)->_IO_write_ptr - (FILE)->_IO_write_base)
-#endif /* !_IO_STDIO_H */
-#endif /* emacs */
-
-/* Use the GC_MAKE_GCPROS_NOOPS (see lisp.h) method for marking the stack. */
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
diff --git a/src/s/hpux10-20.h b/src/s/hpux10-20.h
deleted file mode 100644
index be457498add..00000000000
--- a/src/s/hpux10-20.h
+++ /dev/null
@@ -1,107 +0,0 @@
-/* System description file for hpux version 10.20.
-
-Copyright (C) 1999, 2001-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-
-#define RUN_TIME_REMAP
-
-/* Define symbols to identify the version of Unix this is.
- Define all the symbols that apply correctly. */
-#define USG /* System III, System V, etc */
-#define USG5
-#define HPUX
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "hpux"
-
-/* Letter to use in finding device name of first pty,
- if system supports pty's. 'p' means it is /dev/ptym/ptyp0 */
-#define FIRST_PTY_LETTER 'p'
-
-#define NO_TERMIO
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-
-/* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */
-#define HAVE_SOCKETS
-
-/* Define CLASH_DETECTION if you want lock files to be written
- so that Emacs can tell instantly when you try to modify
- a file that someone else has modified in his Emacs. */
-#define CLASH_DETECTION
-
-/* Special hacks needed to make Emacs run on this system. */
-
-/* In hpux, the symbol SIGIO is defined, but the feature
- doesn't work in the way Emacs needs it to. */
-#define BROKEN_SIGIO
-
-/* Some additional system facilities exist. */
-#define HAVE_PERROR /* Delete this line for version 6. */
-
-/* This is how to get the device name of the tty end of a pty. */
-#define PTY_TTY_NAME_SPRINTF \
- sprintf (pty_name, "/dev/pty/tty%c%x", c, i);
-
-/* This is how to get the device name of the control end of a pty. */
-#define PTY_NAME_SPRINTF \
- sprintf (pty_name, "/dev/ptym/pty%c%x", c, i);
-
-/* This triggers a conditional in xfaces.c. */
-#define XOS_NEEDS_TIME_H
-
-/* Assar Westerlund <assar@sics.se> says this is necessary for
- HP-UX 10.20, and that it works for HP-UX 0 as well. */
-#define NO_EDITRES
-
-/* Eric Backus <ericb@lsid.hp.com> says, HP-UX 9.x on HP 700 machines
- has a broken `rint' in some library versions including math library
- version number A.09.05.
-
- You can fix the math library by installing patch number PHSS_4630.
- But we can fix it more reliably for Emacs like this. */
-#undef HAVE_RINT
-
-/* We have to go this route, rather than hpux9's approach of renaming the
- functions via macros. The system's stdlib.h has fully prototyped
- declarations, which yields a conflicting definition of srand48; it
- tries to redeclare what was once srandom to be srand48. So we go
- with HAVE_LRAND48 being defined. */
-#undef srandom
-#undef random
-#undef HAVE_RANDOM
-
-
-/* Rainer Malzbender <rainer@displaytech.com> says defining
- HAVE_XRMSETDATABASE allows Emacs to compile on HP-UX 10.20 using GCC. */
-#ifndef HAVE_XRMSETDATABASE
-#define HAVE_XRMSETDATABASE
-#endif
-
-/* 2000-11-21: Temporarily disable Unix 98 large file support found by
- configure. It fails on HPUX 11, at least, because it enables
- header sections which lose when `static' is defined away, as it is
- on HP-UX. (You get duplicate symbol errors on linking). */
-#undef _FILE_OFFSET_BITS
-
-/* The data segment on this machine always starts at address 0x40000000. */
-#define DATA_SEG_BITS 0x40000000
-
-#define DATA_START 0x40000000
diff --git a/src/s/hpux11.h b/src/s/hpux11.h
deleted file mode 100644
index 40bcc987973..00000000000
--- a/src/s/hpux11.h
+++ /dev/null
@@ -1,9 +0,0 @@
-#include "hpux10-20.h"
-
-/* SA_RESTART resets the timeout of `select', so don't use it. */
-#define BROKEN_SA_RESTART
-
-/* It does work on HPUX to open the pty's tty in the parent (Emacs),
- then close and reopen it in the child. */
-#define USG_SUBTTY_WORKS
-
diff --git a/src/s/irix6-5.h b/src/s/irix6-5.h
deleted file mode 100644
index 26eb7dcde77..00000000000
--- a/src/s/irix6-5.h
+++ /dev/null
@@ -1,105 +0,0 @@
-/* Definitions file for GNU Emacs running on Silicon Graphics Irix system 6.5.
-
-Copyright (C) 1999-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-
-#define IRIX6_5 /* used in m/iris4d */
-#include "usg5-4-common.h"
-
-#undef _longjmp /* use system versions, not conservative aliases */
-#undef _setjmp
-
-#define SETPGRP_RELEASES_CTTY
-
-#ifdef SYSTEM_TYPE
-#undef SYSTEM_TYPE
-#endif
-#define SYSTEM_TYPE "irix"
-
-#ifdef SETUP_SLAVE_PTY
-#undef SETUP_SLAVE_PTY
-#endif
-
-/* thomas@mathematik.uni-bremen.de says this is needed. */
-/* Make process_send_signal work by "typing" a signal character on the pty. */
-#define SIGNALS_VIA_CHARACTERS
-
-/* Letter to use in finding device name of first pty,
- if system supports pty's. 'a' means it is /dev/ptya0 */
-#undef FIRST_PTY_LETTER
-#define FIRST_PTY_LETTER 'q'
-
-/* No need to use sprintf to get the tty name--we get that from _getpty. */
-#define PTY_TTY_NAME_SPRINTF
-/* No need to get the pty name at all. */
-#ifdef PTY_NAME_SPRINTF
-#undef PTY_NAME_SPRINTF
-#endif
-#define PTY_NAME_SPRINTF
-#ifdef emacs
-char *_getpty();
-#endif
-/* We need only try once to open a pty. */
-#define PTY_ITERATION
-/* Here is how to do it. */
-#define PTY_OPEN \
-{ \
- struct sigaction ocstat, cstat; \
- struct stat stb; \
- char * name; \
- sigemptyset(&cstat.sa_mask); \
- cstat.sa_handler = SIG_DFL; \
- cstat.sa_flags = 0; \
- sigaction(SIGCLD, &cstat, &ocstat); \
- name = _getpty (&fd, O_RDWR | O_NDELAY, 0600, 0); \
- sigaction(SIGCLD, &ocstat, (struct sigaction *)0); \
- if (name == 0) \
- return -1; \
- if (fd < 0) \
- return -1; \
- if (fstat (fd, &stb) < 0) \
- return -1; \
- strcpy (pty_name, name); \
-}
-
-/* Ulimit(UL_GMEMLIM) is busted... */
-#define ULIMIT_BREAK_VALUE 0x14000000
-
-/* Tell process_send_signal to use VSUSP instead of VSWTCH. */
-#define PREFER_VSUSP
-
-#define NARROWPROTO 1
-
-#if _MIPS_SZLONG == 64 /* -mabi=64 (gcc) or -64 (MIPSpro) */
-#define _LP64 /* lisp.h takes care of the rest */
-#endif /* _MIPS_SZLONG */
-
-#undef SA_RESTART
-
-#undef TIOCSIGSEND /* defined in usg5-4-common.h */
-
-/* Tested on Irix 6.5. SCM worked on earlier versions. */
-#define GC_SETJMP_WORKS 1
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
-
-
-/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers which
- were stored in a Lisp_Object (as Emacs uses fewer than 32 bits for
- the value field of a LISP_OBJECT). */
-#define DATA_START 0x10000000
-#define DATA_SEG_BITS 0x10000000
diff --git a/src/s/msdos.h b/src/s/msdos.h
deleted file mode 100644
index 9ee13d12867..00000000000
--- a/src/s/msdos.h
+++ /dev/null
@@ -1,140 +0,0 @@
-/* System description file for MS-DOS
-
-Copyright (C) 1993, 1996-1997, 2001-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-/* Note: lots of stuff here was taken from s-msdos.h in demacs. */
-
-
-/* Define symbols to identify the version of Unix this is.
- Define all the symbols that apply correctly. */
-#ifndef MSDOS
-#define MSDOS
-#endif
-
-#ifndef __DJGPP__
-You lose; /* Emacs for DOS must be compiled with DJGPP */
-#endif
-
-#define DOS_NT /* MSDOS or WINDOWSNT */
-#undef BSD_SYSTEM
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "ms-dos"
-
-/* subprocesses should be defined if you want to have code for
- asynchronous subprocesses (as used in M-x compile and M-x shell).
- This is the only system that needs this. */
-#undef subprocesses
-
-/* Here, on a separate page, add any special hacks needed to make
- Emacs work on this system. For example, you might define certain
- system call names that don't exist on your system, or that do
- different things on your system and must be used only through an
- encapsulation (which you should place, by convention, in sysdep.c). */
-
-/* Avoid incompatibilities between gmalloc.c and system header files
- in how to declare valloc. */
-#define GMALLOC_INHIBIT_VALLOC
-
-/* This overrides the default value on editfns.c, since DJGPP
- does not have pw->pw_gecos. */
-#define USER_FULL_NAME (getenv ("NAME"))
-
-/* setjmp and longjmp can safely replace _setjmp and _longjmp,
- but they will run slower. */
-#define _setjmp setjmp
-#define _longjmp longjmp
-
-#define DATA_START (&etext + 1)
-
-#define _NAIVE_DOS_REGS
-
-/* command.com does not understand `...` so we define this. */
-#define SEPCHAR ';'
-
-#define NULL_DEVICE "nul"
-
-#define HAVE_INVERSE_HYPERBOLIC
-#define FLOAT_CHECK_DOMAIN
-
-/* Start of gnulib-related stuff */
-
-/* lib/ftoastr.c wants strtold, but DJGPP only has _strtold. DJGPP >
- 2.03 has it, but it also has _strtold as a stub that jumps to
- strtold, so use _strtold in all versions. */
-#define strtold _strtold
-
-#if __DJGPP__ > 2 || __DJGPP_MINOR__ > 3
-# define HAVE_LSTAT 1
-#else
-# define lstat stat
-#endif
-
-/* End of gnulib-related stuff. */
-
-/* When $TERM is "internal" then this is substituted: */
-#define INTERNAL_TERMINAL "pc|bios|IBM PC with color display:\
-:co#80:li#25:Co#16:pa#256:km:ms:cm=<CM>:cl=<CL>:ce=<CE>:\
-:se=</SO>:so=<SO>:us=<UL>:ue=</UL>:md=<BD>:mh=<DIM>:mb=<BL>:mr=<RV>:me=<NV>:\
-:AB=<BG %d>:AF=<FG %d>:op=<DefC>:"
-
-/* Define this to a function (Fdowncase, Fupcase) if your file system
- likes that. */
-#define FILE_SYSTEM_CASE Fmsdos_downcase_filename
-
-/* Define this to be the separator between devices and paths. */
-#define DEVICE_SEP ':'
-
-/* We'll support either convention on MSDOG. */
-#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\')
-#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_))
-
-
-/* Mode line description of a buffer's type. */
-#define MODE_LINE_BINARY_TEXT(buf) (NILP(B_(buf,buffer_file_type)) ? "T" : "B")
-
-/* We have (the code to control) a mouse. */
-#define HAVE_MOUSE
-
-/* We can use mouse menus. */
-#define HAVE_MENUS
-
-/* Define one of these for easier conditionals. */
-#ifdef HAVE_X_WINDOWS
-/* We need a little extra space, see ../../lisp/loadup.el and the
- commentary below, in the non-X branch. The 140KB number was
- measured on GNU/Linux and on MS-Windows. */
-#define SYSTEM_PURESIZE_EXTRA (-170000+140000)
-#else
-/* We need a little extra space, see ../../lisp/loadup.el.
- As of 20091024, DOS-specific files use up 62KB of pure space. But
- overall, we end up wasting 130KB of pure space, because
- BASE_PURESIZE starts at 1.47MB, while we need only 1.3MB (including
- non-DOS specific files and load history; the latter is about 55K,
- but depends on the depth of the top-level Emacs directory in the
- directory tree). Given the unknown policy of different DPMI
- hosts regarding loading of untouched pages, I'm not going to risk
- enlarging Emacs footprint by another 100+ KBytes. */
-#define SYSTEM_PURESIZE_EXTRA (-170000+65000)
-#endif
-
-/* Tell the garbage collector that setjmp is known to save all
- registers relevant for conservative garbage collection in the jmp_buf. */
-#define GC_SETJMP_WORKS 1
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
diff --git a/src/s/netbsd.h b/src/s/netbsd.h
deleted file mode 100644
index 52cda717a2d..00000000000
--- a/src/s/netbsd.h
+++ /dev/null
@@ -1,43 +0,0 @@
-/* s/ file for netbsd system.
-
-Copyright (C) 2001-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-
-/* Get most of the stuff from bsd-common. */
-#include "bsd-common.h"
-
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)
-
-#define DEFAULT_SOUND_DEVICE "/dev/audio"
-
-/* Greg A. Woods <woods@weird.com> says we must include signal.h
- before syssignal.h is included, to work around interface conflicts
- that are handled with CPP __RENAME() macro in signal.h. */
-#include <signal.h>
-
-/* Don't close pty in process.c to make it as controlling terminal.
- It is already a controlling terminal of subprocess, because we did
- ioctl TIOCSCTTY. */
-#define DONT_REOPEN_PTY
-
-/* Tell that garbage collector that setjmp is known to save all
- registers relevant for conservative garbage collection in the jmp_buf. */
-#define GC_SETJMP_WORKS 1
-
-/* Use the GC_MAKE_GCPROS_NOOPS (see lisp.h) method. */
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
diff --git a/src/s/openbsd.h b/src/s/openbsd.h
deleted file mode 100644
index 0a8bab2290f..00000000000
--- a/src/s/openbsd.h
+++ /dev/null
@@ -1,9 +0,0 @@
-/* System file for openbsd. */
-
-/* Nearly the same as NetBSD. Note there are differences in configure. */
-#include "netbsd.h"
-
-/* The symbol SIGIO is defined, but the feature doesn't work in the
- way Emacs needs it to. See
- <http://article.gmane.org/gmane.os.openbsd.ports/46831>. */
-#define BROKEN_SIGIO
diff --git a/src/s/sol2-10.h b/src/s/sol2-10.h
deleted file mode 100644
index b20476e7fba..00000000000
--- a/src/s/sol2-10.h
+++ /dev/null
@@ -1,10 +0,0 @@
-/* Handle Solaris 2.10. */
-
-#include "sol2-6.h"
-
-/* This is used in list_system_processes. */
-#define HAVE_PROCFS 1
-
-/* This is needed for the system_process_attributes implementation. */
-#define _STRUCTURED_PROC 1
-
diff --git a/src/s/sol2-6.h b/src/s/sol2-6.h
deleted file mode 100644
index 3d9bd6ddafc..00000000000
--- a/src/s/sol2-6.h
+++ /dev/null
@@ -1,62 +0,0 @@
-/* Definitions file for GNU Emacs running on Solaris 2.6.
-
-Copyright (C) 1999-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-#include "usg5-4-common.h"
-
-#define SOLARIS2
-
-/* This triggers a conditional in xfaces.c. */
-#define XOS_NEEDS_TIME_H
-
-#define POSIX
-
-/* Prefer kstat over kvm in getloadavg.c, kstat doesn't require root.
- ghazi@caip.rutgers.edu, 7/21/97. Don't redefine if already defined
- (e.g., by config.h). */
-#ifndef HAVE_LIBKSTAT
-#define HAVE_LIBKSTAT
-#endif
-
-/* This is the same definition as in usg5-4-common.h, but with sigblock/sigunblock
- rather than sighold/sigrelse, which appear to be BSD4.1 specific.
- It may also be appropriate for SVR4.x
- (x<2) but I'm not sure. fnf@cygnus.com */
-/* This sets the name of the slave side of the PTY. On SysVr4,
- grantpt(3) forks a subprocess, so keep sigchld_handler() from
- intercepting that death. If any child but grantpt's should die
- within, it should be caught after sigrelse(2). */
-
-#define PTY_TTY_NAME_SPRINTF \
- { \
- char *ptsname (int), *ptyname; \
- \
- sigblock (sigmask (SIGCLD)); \
- if (grantpt (fd) == -1) \
- { emacs_close (fd); return -1; } \
- sigunblock (sigmask (SIGCLD)); \
- if (unlockpt (fd) == -1) \
- { emacs_close (fd); return -1; } \
- if (!(ptyname = ptsname (fd))) \
- { emacs_close (fd); return -1; } \
- strncpy (pty_name, ptyname, sizeof (pty_name)); \
- pty_name[sizeof (pty_name) - 1] = 0; \
- }
-
-#define GC_SETJMP_WORKS 1
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
diff --git a/src/s/template.h b/src/s/template.h
deleted file mode 100644
index 4e0400e99e3..00000000000
--- a/src/s/template.h
+++ /dev/null
@@ -1,113 +0,0 @@
-/* Template for system description header files.
- This file describes the parameters that system description files
- should define or not.
-
-Copyright (C) 1985-1986, 1992, 1999, 2001-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-
-/* Define symbols to identify the version of Unix this is.
- Define all the symbols that apply correctly. */
-
-/* #define USG5 */
-/* #define USG */
-/* #define HPUX */
-/* #define BSD4_2 */
-/* #define BSD4_3 */
-/* #define BSD_SYSTEM */
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-
-#define SYSTEM_TYPE "berkeley-unix"
-
-/* Emacs can read input using SIGIO and buffering characters itself,
- or using CBREAK mode and making C-g cause SIGINT.
- The choice is controlled by the variable interrupt_input.
-
- Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO)
-
- Emacs uses the presence or absence of the SIGIO and BROKEN_SIGIO macros
- to indicate whether or not signal-driven I/O is possible. It uses
- INTERRUPT_INPUT to decide whether to use it by default.
-
- SIGIO can be used only on systems that implement it (4.2 and 4.3).
- CBREAK mode has two disadvantages
- 1) At least in 4.2, it is impossible to handle the Meta key properly.
- I hear that in system V this problem does not exist.
- 2) Control-G causes output to be discarded.
- I do not know whether this can be fixed in system V.
-
- Another method of doing input is planned but not implemented.
- It would have Emacs fork off a separate process
- to read the input and send it to the true Emacs process
- through a pipe. */
-#define INTERRUPT_INPUT
-
-/* Letter to use in finding device name of first pty,
- if system supports pty's. 'a' means it is /dev/ptya0. */
-#define FIRST_PTY_LETTER 'a'
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-
-/* subprocesses should be undefined if you do NOT want to
- have code for asynchronous subprocesses
- (as used in M-x compile and M-x shell).
- Currently only MSDOS does not support this. */
-
-/* #undef subprocesses */
-
-/* Define CLASH_DETECTION if you want lock files to be written
- so that Emacs can tell instantly when you try to modify
- a file that someone else has modified in his Emacs. */
-#define CLASH_DETECTION
-
-/* If the character used to separate elements of the executable path
- is not ':', #define this to be the appropriate character constant. */
-/* #define SEPCHAR ':' */
-
-/* ============================================================ */
-
-/* Here, add any special hacks needed to make Emacs work on this
- system. For example, you might define certain system call names
- that don't exist on your system, or that do different things on
- your system and must be used only through an encapsulation (which
- you should place, by convention, in sysdep.c). */
-
-/* If the system's imake configuration file defines `NeedWidePrototypes'
- as `NO', we must define NARROWPROTO manually. Such a define is
- generated in the Makefile generated by `xmkmf'. If we don't
- define NARROWPROTO, we will see the wrong function prototypes
- for X functions taking float or double parameters. */
-
-/* #define NARROWPROTO 1 */
-
-/* ============================================================ */
-
-/* After adding support for a new system, modify the large case
- statement in configure.in to recognize reasonable
- configuration names, and add a description of the system to
- `etc/MACHINES'.
-
- Check for any tests of $opsys in configure.in, and add an entry
- for the new system if needed.
-
- If you've just fixed a problem in an existing configuration file,
- you should also check `etc/MACHINES' to make sure its descriptions
- of known problems in that configuration should be updated. */
-
diff --git a/src/s/unixware.h b/src/s/unixware.h
deleted file mode 100644
index 8fe28625dd4..00000000000
--- a/src/s/unixware.h
+++ /dev/null
@@ -1,52 +0,0 @@
-/* s/ file for Unixware.
-
-Copyright (C) 1999-2011 Free Software Foundation, Inc.
-
-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/>. */
-
-
-#include "usg5-4-common.h"
-
-/* #define HAVE_GETWD (appears to be buggy on SVR4.2) */
-#undef HAVE_GETWD
-
-#undef HAVE_SYSV_SIGPAUSE
-
-/* This is the same definition as in usg5-4-common.h, but with sigblock/sigunblock
- rather than sighold/sigrelse, which appear to be BSD4.1 specific.
- It may also be appropriate for SVR4.x
- (x<2) but I'm not sure. fnf@cygnus.com */
-/* This sets the name of the slave side of the PTY. On SysVr4,
- grantpt(3) forks a subprocess, so keep sigchld_handler() from
- intercepting that death. If any child but grantpt's should die
- within, it should be caught after sigrelse(2). */
-#define PTY_TTY_NAME_SPRINTF \
- { \
- char *ptsname (int), *ptyname; \
- \
- sigblock(sigmask(SIGCLD)); \
- if (grantpt(fd) == -1) \
- fatal("could not grant slave pty"); \
- sigunblock(sigmask(SIGCLD)); \
- if (unlockpt(fd) == -1) \
- fatal("could not unlock slave pty"); \
- if (!(ptyname = ptsname(fd))) \
- fatal ("could not enable slave pty"); \
- strncpy(pty_name, ptyname, sizeof(pty_name)); \
- pty_name[sizeof(pty_name) - 1] = 0; \
- }
-
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__ptr - (FILE)->__base)
diff --git a/src/s/usg5-4-common.h b/src/s/usg5-4-common.h
deleted file mode 100644
index e6d992d8f9c..00000000000
--- a/src/s/usg5-4-common.h
+++ /dev/null
@@ -1,98 +0,0 @@
-/* Definitions file for GNU Emacs running on AT&T's System V Release 4
-
-Copyright (C) 1987, 1990, 1999-2011 Free Software Foundation, Inc.
-
-Written by James Van Artsdalen of Dell Computer Corp. james@bigtex.cactus.org.
-Subsequently improved for Dell 2.2 by Eric S. Raymond <esr@snark.thyrsus.com>.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software: you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-
-/* Use the SysVr3 file for at least base configuration. */
-#define USG /* System III, System V, etc */
-
-#define USG5
-#define USG5_4
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "usg-unix-v"
-
-/* setjmp and longjmp can safely replace _setjmp and _longjmp,
- but they will run slower. */
-#define _setjmp setjmp
-#define _longjmp longjmp
-
-/* The docs for system V/386 suggest v.3 has sigpause, so let's try it. */
-#define HAVE_SYSV_SIGPAUSE
-
-/* Get FIONREAD from <sys/filio.h>. Get <sys/ttold.h> to get struct tchars.
- But get <termio.h> first to make sure ttold.h doesn't interfere.
- And don't try to use SIGIO yet. */
-#include <sys/wait.h>
-
-#ifdef emacs
-#include <sys/filio.h>
-#include <termio.h>
-#include <sys/ttold.h>
-#include <signal.h>
-#include <sys/stream.h>
-#include <sys/stropts.h>
-#include <sys/termios.h>
-#define BROKEN_SIGIO
-#endif
-
-/* Some SVr4s don't define NSIG in sys/signal.h for ANSI environments;
- instead, there's a system variable _sys_nsig. Unfortunately, we need the
- constant to dimension an array. So wire in the appropriate value here. */
-#define NSIG_MINIMUM 32
-
-/* We can support this. */
-#define CLASH_DETECTION
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-
-/* It is possible to receive SIGCHLD when there are no children
- waiting, because a previous waitsys(2) cleaned up the carcass of child
- without clearing the SIGCHLD pending info. So, use a non-blocking
- wait3 instead, which maps to waitpid(2) in SysVr4. */
-#define wait3(status, options, rusage) \
- waitpid ((pid_t) -1, (status), (options))
-#define WRETCODE(w) (w >> 8)
-
-/* TIOCGPGRP is broken in SysVr4, so we can't send signals to PTY
- subprocesses the usual way. But TIOCSIGNAL does work for PTYs, and
- this is all we need. */
-#define TIOCSIGSEND TIOCSIGNAL
-
-/* This change means that we don't loop through allocate_pty too many
- times in the (rare) event of a failure. */
-#define FIRST_PTY_LETTER 'z'
-
-/* This sets the name of the master side of the PTY. */
-#define PTY_NAME_SPRINTF strcpy (pty_name, "/dev/ptmx");
-
-/* Push various streams modules onto a PTY channel. */
-#define SETUP_SLAVE_PTY \
- if (ioctl (xforkin, I_PUSH, "ptem") == -1) \
- fatal ("ioctl I_PUSH ptem"); \
- if (ioctl (xforkin, I_PUSH, "ldterm") == -1) \
- fatal ("ioctl I_PUSH ldterm"); \
- if (ioctl (xforkin, I_PUSH, "ttcompat") == -1) \
- fatal ("ioctl I_PUSH ttcompat");
-
-/* This definition was suggested for next release. So give it a try. */
-#define HAVE_SOCKETS
diff --git a/src/scroll.c b/src/scroll.c
index 05f6fdf85f0..71ce43b2e48 100644
--- a/src/scroll.c
+++ b/src/scroll.c
@@ -1,6 +1,6 @@
/* Calculate what line insertion or deletion to do, and do it
-Copyright (C) 1985-1986, 1990, 1993-1994, 2001-2011
+Copyright (C) 1985-1986, 1990, 1993-1994, 2001-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,7 +21,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "termchar.h"
#include "dispextern.h"
@@ -94,7 +94,7 @@ calculate_scrolling (FRAME_PTR frame,
int free_at_end)
{
register int i, j;
- EMACS_INT frame_lines = FRAME_LINES (frame);
+ int frame_lines = FRAME_LINES (frame);
register struct matrix_elt *p, *p1;
register int cost, cost1;
@@ -195,13 +195,13 @@ calculate_scrolling (FRAME_PTR frame,
{
cost = p1->writecost + first_insert_cost[i];
if ((int) p1->insertcount > i)
- abort ();
+ emacs_abort ();
cost1 = p1->insertcost + next_insert_cost[i - p1->insertcount];
}
p->insertcost = min (cost, cost1) + draw_cost[i] + extra_cost;
p->insertcount = (cost < cost1) ? 1 : p1->insertcount + 1;
if ((int) p->insertcount > i)
- abort ();
+ emacs_abort ();
/* Calculate the cost if we do a delete line after
outputting this line.
@@ -253,24 +253,24 @@ do_scrolling (struct frame *frame, struct glyph_matrix *current_matrix,
/* A queue for line insertions to be done. */
struct queue { int count, pos; };
struct queue *queue_start
- = (struct queue *) alloca (current_matrix->nrows * sizeof (struct queue));
+ = alloca (current_matrix->nrows * sizeof *queue_start);
struct queue *queue = queue_start;
- char *retained_p = (char *) alloca (window_size * sizeof (char));
- int *copy_from = (int *) alloca (window_size * sizeof (int));
+ char *retained_p = alloca (window_size * sizeof *retained_p);
+ int *copy_from = alloca (window_size * sizeof *copy_from);
/* Zero means line is empty. */
memset (retained_p, 0, window_size * sizeof (char));
for (k = 0; k < window_size; ++k)
copy_from[k] = -1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
# define CHECK_BOUNDS \
do \
{ \
int ck; \
for (ck = 0; ck < window_size; ++ck) \
- xassert (copy_from[ck] == -1 \
+ eassert (copy_from[ck] == -1 \
|| (copy_from[ck] >= 0 && copy_from[ck] < window_size)); \
} \
while (0);
@@ -317,12 +317,12 @@ do_scrolling (struct frame *frame, struct glyph_matrix *current_matrix,
{
/* Best thing done here is no insert or delete, i.e. a write. */
--i, --j;
- xassert (i >= 0 && i < window_size);
- xassert (j >= 0 && j < window_size);
+ eassert (i >= 0 && i < window_size);
+ eassert (j >= 0 && j < window_size);
copy_from[i] = j;
retained_p[j] = 1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
CHECK_BOUNDS;
#endif
}
@@ -368,13 +368,13 @@ do_scrolling (struct frame *frame, struct glyph_matrix *current_matrix,
}
for (k = 0; k < window_size; ++k)
- xassert (copy_from[k] >= 0 && copy_from[k] < window_size);
+ eassert (copy_from[k] >= 0 && copy_from[k] < window_size);
/* Perform the row swizzling. */
mirrored_line_dance (current_matrix, unchanged_at_top, window_size,
copy_from, retained_p);
- /* Some sanity checks if GLYPH_DEBUG != 0. */
+ /* Some sanity checks if GLYPH_DEBUG is defined. */
CHECK_MATRIX (current_matrix);
if (terminal_window_p)
@@ -432,7 +432,7 @@ calculate_direct_scrolling (FRAME_PTR frame,
int free_at_end)
{
register int i, j;
- EMACS_INT frame_lines = FRAME_LINES (frame);
+ int frame_lines = FRAME_LINES (frame);
register struct matrix_elt *p, *p1;
register int cost, cost1, delta;
@@ -671,11 +671,11 @@ do_direct_scrolling (struct frame *frame, struct glyph_matrix *current_matrix,
int write_follows_p = 1;
/* For each row in the new matrix what row of the old matrix it is. */
- int *copy_from = (int *) alloca (window_size * sizeof (int));
+ int *copy_from = alloca (window_size * sizeof *copy_from);
/* Non-zero for each row in the new matrix that is retained from the
old matrix. Lines not retained are empty. */
- char *retained_p = (char *) alloca (window_size * sizeof (char));
+ char *retained_p = alloca (window_size * sizeof *retained_p);
memset (retained_p, 0, window_size * sizeof (char));
@@ -728,7 +728,7 @@ do_direct_scrolling (struct frame *frame, struct glyph_matrix *current_matrix,
place they belong. */
int n_to_write = p->writecount;
write_follows_p = 1;
- xassert (n_to_write > 0);
+ eassert (n_to_write > 0);
if (i > j)
{
@@ -889,8 +889,8 @@ static void
line_ins_del (FRAME_PTR frame, int ov1, int pf1, int ovn, int pfn,
register int *ov, register int *mf)
{
- register EMACS_INT i;
- register EMACS_INT frame_lines = FRAME_LINES (frame);
+ register int i;
+ register int frame_lines = FRAME_LINES (frame);
register int insert_overhead = ov1 * 10;
register int next_insert_cost = ovn * 10;
diff --git a/src/search.c b/src/search.c
index 811ac74e194..aacdbe33eef 100644
--- a/src/search.c
+++ b/src/search.c
@@ -1,6 +1,7 @@
/* String search routines for GNU Emacs.
- Copyright (C) 1985-1987, 1993-1994, 1997-1999, 2001-2011
- Free Software Foundation, Inc.
+
+Copyright (C) 1985-1987, 1993-1994, 1997-1999, 2001-2012
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,12 +20,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "syntax.h"
#include "category.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "region-cache.h"
#include "commands.h"
@@ -89,20 +90,19 @@ static Lisp_Object Qinvalid_regexp;
/* Error condition used for failing searches. */
static Lisp_Object Qsearch_failed;
-static void set_search_regs (EMACS_INT, EMACS_INT);
+static void set_search_regs (ptrdiff_t, ptrdiff_t);
static void save_search_regs (void);
-static EMACS_INT simple_search (EMACS_INT, unsigned char *, EMACS_INT,
- EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT);
-static EMACS_INT boyer_moore (EMACS_INT, unsigned char *, EMACS_INT,
- Lisp_Object, Lisp_Object, EMACS_INT,
- EMACS_INT, int);
-static EMACS_INT search_buffer (Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, EMACS_INT, int,
+static EMACS_INT simple_search (EMACS_INT, unsigned char *, ptrdiff_t,
+ ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t);
+static EMACS_INT boyer_moore (EMACS_INT, unsigned char *, ptrdiff_t,
+ Lisp_Object, Lisp_Object, ptrdiff_t,
+ ptrdiff_t, int);
+static EMACS_INT search_buffer (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, EMACS_INT, int,
Lisp_Object, Lisp_Object, int);
-static void matcher_overflow (void) NO_RETURN;
-static void
+static _Noreturn void
matcher_overflow (void)
{
error ("Stack overflow in regexp matcher");
@@ -156,7 +156,7 @@ compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern, Lisp_Object tra
re_set_whitespace_regexp (NULL);
re_set_syntax (old);
- /* UNBLOCK_INPUT; */
+ /* unblock_input (); */
if (val)
xsignal1 (Qinvalid_regexp, build_string (val));
@@ -175,8 +175,7 @@ shrink_regexp_cache (void)
for (cp = searchbuf_head; cp != 0; cp = cp->next)
{
cp->buf.allocated = cp->buf.used;
- cp->buf.buffer
- = (unsigned char *) xrealloc (cp->buf.buffer, cp->buf.used);
+ cp->buf.buffer = xrealloc (cp->buf.buffer, cp->buf.used);
}
}
@@ -271,16 +270,16 @@ looking_at_1 (Lisp_Object string, int posix)
{
Lisp_Object val;
unsigned char *p1, *p2;
- EMACS_INT s1, s2;
- register EMACS_INT i;
+ ptrdiff_t s1, s2;
+ register ptrdiff_t i;
struct re_pattern_buffer *bufp;
if (running_asynch_code)
save_search_regs ();
/* This is so set_image_of_range_1 in regex.c can find the EQV table. */
- XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2]
- = BVAR (current_buffer, case_eqv_table);
+ set_char_table_extras (BVAR (current_buffer, case_canon_table), 2,
+ BVAR (current_buffer, case_eqv_table));
CHECK_STRING (string);
bufp = compile_pattern (string,
@@ -367,10 +366,10 @@ data if you want to preserve them. */)
static Lisp_Object
string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, int posix)
{
- EMACS_INT val;
+ ptrdiff_t val;
struct re_pattern_buffer *bufp;
- EMACS_INT pos, pos_byte;
- int i;
+ EMACS_INT pos;
+ ptrdiff_t pos_byte, i;
if (running_asynch_code)
save_search_regs ();
@@ -382,7 +381,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, int p
pos = 0, pos_byte = 0;
else
{
- EMACS_INT len = SCHARS (string);
+ ptrdiff_t len = SCHARS (string);
CHECK_NUMBER (start);
pos = XINT (start);
@@ -394,8 +393,8 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, int p
}
/* This is so set_image_of_range_1 in regex.c can find the EQV table. */
- XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2]
- = BVAR (current_buffer, case_eqv_table);
+ set_char_table_extras (BVAR (current_buffer, case_canon_table), 2,
+ BVAR (current_buffer, case_eqv_table));
bufp = compile_pattern (regexp,
(NILP (Vinhibit_changing_match_data)
@@ -467,10 +466,10 @@ matched by parenthesis constructs in the pattern. */)
and return the index of the match, or negative on failure.
This does not clobber the match data. */
-EMACS_INT
+ptrdiff_t
fast_string_match (Lisp_Object regexp, Lisp_Object string)
{
- EMACS_INT val;
+ ptrdiff_t val;
struct re_pattern_buffer *bufp;
bufp = compile_pattern (regexp, 0, Qnil,
@@ -490,12 +489,12 @@ fast_string_match (Lisp_Object regexp, Lisp_Object string)
This does not clobber the match data.
We assume that STRING contains single-byte characters. */
-EMACS_INT
-fast_c_string_match_ignore_case (Lisp_Object regexp, const char *string)
+ptrdiff_t
+fast_c_string_match_ignore_case (Lisp_Object regexp,
+ const char *string, ptrdiff_t len)
{
- EMACS_INT val;
+ ptrdiff_t val;
struct re_pattern_buffer *bufp;
- size_t len = strlen (string);
regexp = string_make_unibyte (regexp);
re_match_object = Qt;
@@ -510,10 +509,10 @@ fast_c_string_match_ignore_case (Lisp_Object regexp, const char *string)
/* Like fast_string_match but ignore case. */
-EMACS_INT
+ptrdiff_t
fast_string_match_ignore_case (Lisp_Object regexp, Lisp_Object string)
{
- EMACS_INT val;
+ ptrdiff_t val;
struct re_pattern_buffer *bufp;
bufp = compile_pattern (regexp, 0, Vascii_canon_table,
@@ -534,14 +533,14 @@ fast_string_match_ignore_case (Lisp_Object regexp, Lisp_Object string)
indices into the string. This function doesn't modify the match
data. */
-EMACS_INT
-fast_looking_at (Lisp_Object regexp, EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT limit, EMACS_INT limit_byte, Lisp_Object string)
+ptrdiff_t
+fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t limit, ptrdiff_t limit_byte, Lisp_Object string)
{
int multibyte;
struct re_pattern_buffer *buf;
unsigned char *p1, *p2;
- EMACS_INT s1, s2;
- EMACS_INT len;
+ ptrdiff_t s1, s2;
+ ptrdiff_t len;
if (STRINGP (string))
{
@@ -637,12 +636,12 @@ newline_cache_on_off (struct buffer *buf)
If we don't find COUNT instances before reaching END, set *SHORTAGE
to the number of TARGETs left unfound, and return END.
- If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do
+ If ALLOW_QUIT, set immediate_quit. That's good to do
except when inside redisplay. */
-EMACS_INT
-scan_buffer (register int target, EMACS_INT start, EMACS_INT end,
- EMACS_INT count, EMACS_INT *shortage, int allow_quit)
+ptrdiff_t
+scan_buffer (int target, ptrdiff_t start, ptrdiff_t end,
+ ptrdiff_t count, ptrdiff_t *shortage, bool allow_quit)
{
struct region_cache *newline_cache;
int direction;
@@ -674,9 +673,9 @@ scan_buffer (register int target, EMACS_INT start, EMACS_INT end,
the position of the last character before the next such
obstacle --- the last character the dumb search loop should
examine. */
- EMACS_INT ceiling_byte = CHAR_TO_BYTE (end) - 1;
- EMACS_INT start_byte = CHAR_TO_BYTE (start);
- EMACS_INT tem;
+ ptrdiff_t ceiling_byte = CHAR_TO_BYTE (end) - 1;
+ ptrdiff_t start_byte;
+ ptrdiff_t tem;
/* If we're looking for a newline, consult the newline cache
to see where we can avoid some scanning. */
@@ -685,18 +684,22 @@ scan_buffer (register int target, EMACS_INT start, EMACS_INT end,
ptrdiff_t next_change;
immediate_quit = 0;
while (region_cache_forward
- (current_buffer, newline_cache, start_byte, &next_change))
- start_byte = next_change;
+ (current_buffer, newline_cache, start, &next_change))
+ start = next_change;
immediate_quit = allow_quit;
+ start_byte = CHAR_TO_BYTE (start);
+
/* START should never be after END. */
if (start_byte > ceiling_byte)
start_byte = ceiling_byte;
/* Now the text after start is an unknown region, and
next_change is the position of the next known region. */
- ceiling_byte = min (next_change - 1, ceiling_byte);
+ ceiling_byte = min (CHAR_TO_BYTE (next_change) - 1, ceiling_byte);
}
+ else
+ start_byte = CHAR_TO_BYTE (start);
/* The dumb loop can only scan text stored in contiguous
bytes. BUFFER_CEILING_OF returns the last character
@@ -725,8 +728,8 @@ scan_buffer (register int target, EMACS_INT start, EMACS_INT end,
the region from start to cursor is free of them. */
if (target == '\n' && newline_cache)
know_region_cache (current_buffer, newline_cache,
- start_byte + scan_start - base,
- start_byte + cursor - base);
+ BYTE_TO_CHAR (start_byte + scan_start - base),
+ BYTE_TO_CHAR (start_byte + cursor - base));
/* Did we find the target character? */
if (cursor < ceiling_addr)
@@ -747,9 +750,9 @@ scan_buffer (register int target, EMACS_INT start, EMACS_INT end,
while (start > end)
{
/* The last character to check before the next obstacle. */
- EMACS_INT ceiling_byte = CHAR_TO_BYTE (end);
- EMACS_INT start_byte = CHAR_TO_BYTE (start);
- EMACS_INT tem;
+ ptrdiff_t ceiling_byte = CHAR_TO_BYTE (end);
+ ptrdiff_t start_byte;
+ ptrdiff_t tem;
/* Consult the newline cache, if appropriate. */
if (target == '\n' && newline_cache)
@@ -757,18 +760,22 @@ scan_buffer (register int target, EMACS_INT start, EMACS_INT end,
ptrdiff_t next_change;
immediate_quit = 0;
while (region_cache_backward
- (current_buffer, newline_cache, start_byte, &next_change))
- start_byte = next_change;
+ (current_buffer, newline_cache, start, &next_change))
+ start = next_change;
immediate_quit = allow_quit;
+ start_byte = CHAR_TO_BYTE (start);
+
/* Start should never be at or before end. */
if (start_byte <= ceiling_byte)
start_byte = ceiling_byte + 1;
/* Now the text before start is an unknown region, and
next_change is the position of the next known region. */
- ceiling_byte = max (next_change, ceiling_byte);
+ ceiling_byte = max (CHAR_TO_BYTE (next_change), ceiling_byte);
}
+ else
+ start_byte = CHAR_TO_BYTE (start);
/* Stop scanning before the gap. */
tem = BUFFER_FLOOR_OF (start_byte - 1);
@@ -791,8 +798,8 @@ scan_buffer (register int target, EMACS_INT start, EMACS_INT end,
the region from after the cursor to start is free of them. */
if (target == '\n' && newline_cache)
know_region_cache (current_buffer, newline_cache,
- start_byte + cursor - base,
- start_byte + scan_start - base);
+ BYTE_TO_CHAR (start_byte + cursor - base),
+ BYTE_TO_CHAR (start_byte + scan_start - base));
/* Did we find the target character? */
if (cursor >= ceiling_addr)
@@ -830,23 +837,23 @@ scan_buffer (register int target, EMACS_INT start, EMACS_INT end,
the number of line boundaries left unfound, and position at
the limit we bumped up against.
- If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do
+ If ALLOW_QUIT, set immediate_quit. That's good to do
except in special cases. */
EMACS_INT
-scan_newline (EMACS_INT start, EMACS_INT start_byte,
- EMACS_INT limit, EMACS_INT limit_byte,
- register EMACS_INT count, int allow_quit)
+scan_newline (ptrdiff_t start, ptrdiff_t start_byte,
+ ptrdiff_t limit, ptrdiff_t limit_byte,
+ EMACS_INT count, bool allow_quit)
{
int direction = ((count > 0) ? 1 : -1);
- register unsigned char *cursor;
+ unsigned char *cursor;
unsigned char *base;
- EMACS_INT ceiling;
- register unsigned char *ceiling_addr;
+ ptrdiff_t ceiling;
+ unsigned char *ceiling_addr;
- int old_immediate_quit = immediate_quit;
+ bool old_immediate_quit = immediate_quit;
/* The code that follows is like scan_buffer
but checks for either newline or carriage return. */
@@ -929,21 +936,21 @@ scan_newline (EMACS_INT start, EMACS_INT start_byte,
return count * direction;
}
-EMACS_INT
-find_next_newline_no_quit (EMACS_INT from, EMACS_INT cnt)
+ptrdiff_t
+find_next_newline_no_quit (ptrdiff_t from, ptrdiff_t cnt)
{
- return scan_buffer ('\n', from, 0, cnt, (EMACS_INT *) 0, 0);
+ return scan_buffer ('\n', from, 0, cnt, (ptrdiff_t *) 0, 0);
}
/* Like find_next_newline, but returns position before the newline,
not after, and only search up to TO. This isn't just
find_next_newline (...)-1, because you might hit TO. */
-EMACS_INT
-find_before_next_newline (EMACS_INT from, EMACS_INT to, EMACS_INT cnt)
+ptrdiff_t
+find_before_next_newline (ptrdiff_t from, ptrdiff_t to, ptrdiff_t cnt)
{
- EMACS_INT shortage;
- EMACS_INT pos = scan_buffer ('\n', from, to, cnt, &shortage, 1);
+ ptrdiff_t shortage;
+ ptrdiff_t pos = scan_buffer ('\n', from, to, cnt, &shortage, 1);
if (shortage == 0)
pos--;
@@ -958,7 +965,8 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror,
Lisp_Object count, int direction, int RE, int posix)
{
register EMACS_INT np;
- EMACS_INT lim, lim_byte;
+ EMACS_INT lim;
+ ptrdiff_t lim_byte;
EMACS_INT n = direction;
if (!NILP (count))
@@ -990,8 +998,8 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror,
}
/* This is so set_image_of_range_1 in regex.c can find the EQV table. */
- XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2]
- = BVAR (current_buffer, case_eqv_table);
+ set_char_table_extras (BVAR (current_buffer, case_canon_table), 2,
+ BVAR (current_buffer, case_eqv_table));
np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE,
(!NILP (BVAR (current_buffer, case_fold_search))
@@ -1009,7 +1017,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror,
if (!EQ (noerror, Qt))
{
if (lim < BEGV || lim > ZV)
- abort ();
+ emacs_abort ();
SET_PT_BOTH (lim, lim_byte);
return Qnil;
#if 0 /* This would be clean, but maybe programs depend on
@@ -1022,7 +1030,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror,
}
if (np < BEGV || np > ZV)
- abort ();
+ emacs_abort ();
SET_PT (np);
@@ -1034,7 +1042,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror,
static int
trivial_regexp_p (Lisp_Object regexp)
{
- EMACS_INT len = SBYTES (regexp);
+ ptrdiff_t len = SBYTES (regexp);
unsigned char *s = SDATA (regexp);
while (--len >= 0)
{
@@ -1098,13 +1106,13 @@ while (0)
static struct re_registers search_regs_1;
static EMACS_INT
-search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
- EMACS_INT lim, EMACS_INT lim_byte, EMACS_INT n,
+search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
+ ptrdiff_t lim, ptrdiff_t lim_byte, EMACS_INT n,
int RE, Lisp_Object trt, Lisp_Object inverse_trt, int posix)
{
- EMACS_INT len = SCHARS (string);
- EMACS_INT len_byte = SBYTES (string);
- register int i;
+ ptrdiff_t len = SCHARS (string);
+ ptrdiff_t len_byte = SBYTES (string);
+ register ptrdiff_t i;
if (running_asynch_code)
save_search_regs ();
@@ -1120,7 +1128,7 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
if (RE && !(trivial_regexp_p (string) && NILP (Vsearch_spaces_regexp)))
{
unsigned char *p1, *p2;
- EMACS_INT s1, s2;
+ ptrdiff_t s1, s2;
struct re_pattern_buffer *bufp;
bufp = compile_pattern (string,
@@ -1156,7 +1164,8 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
while (n < 0)
{
- EMACS_INT val;
+ ptrdiff_t val;
+
val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
pos_byte - BEGV_BYTE, lim_byte - pos_byte,
(NILP (Vinhibit_changing_match_data)
@@ -1200,7 +1209,8 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
}
while (n > 0)
{
- EMACS_INT val;
+ ptrdiff_t val;
+
val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
pos_byte - BEGV_BYTE, lim_byte - pos_byte,
(NILP (Vinhibit_changing_match_data)
@@ -1245,8 +1255,8 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
else /* non-RE case */
{
unsigned char *raw_pattern, *pat;
- EMACS_INT raw_pattern_size;
- EMACS_INT raw_pattern_size_byte;
+ ptrdiff_t raw_pattern_size;
+ ptrdiff_t raw_pattern_size_byte;
unsigned char *patbuf;
int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
unsigned char *base_pat;
@@ -1271,7 +1281,7 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
raw_pattern_size_byte
= count_size_as_multibyte (SDATA (string),
raw_pattern_size);
- raw_pattern = (unsigned char *) alloca (raw_pattern_size_byte + 1);
+ raw_pattern = alloca (raw_pattern_size_byte + 1);
copy_text (SDATA (string), raw_pattern,
SCHARS (string), 0, 1);
}
@@ -1285,7 +1295,7 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
the chosen single-byte character set can possibly match. */
raw_pattern_size = SCHARS (string);
raw_pattern_size_byte = SCHARS (string);
- raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1);
+ raw_pattern = alloca (raw_pattern_size + 1);
copy_text (SDATA (string), raw_pattern,
SBYTES (string), 1, 0);
}
@@ -1293,7 +1303,7 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
/* Copy and optionally translate the pattern. */
len = raw_pattern_size;
len_byte = raw_pattern_size_byte;
- patbuf = (unsigned char *) alloca (len * MAX_MULTIBYTE_LENGTH);
+ patbuf = alloca (len * MAX_MULTIBYTE_LENGTH);
pat = patbuf;
base_pat = raw_pattern;
if (multibyte)
@@ -1302,7 +1312,7 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
checking if we can use boyer-moore search. If TRT is
non-nil, we can use boyer-moore search only if TRT can be
represented by the byte array of 256 elements. For that,
- all non-ASCII case-equivalents of all case-senstive
+ all non-ASCII case-equivalents of all case-sensitive
characters in STRING must belong to the same charset and
row. */
@@ -1440,15 +1450,15 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
static EMACS_INT
simple_search (EMACS_INT n, unsigned char *pat,
- EMACS_INT len, EMACS_INT len_byte, Lisp_Object trt,
- EMACS_INT pos, EMACS_INT pos_byte,
- EMACS_INT lim, EMACS_INT lim_byte)
+ ptrdiff_t len, ptrdiff_t len_byte, Lisp_Object trt,
+ ptrdiff_t pos, ptrdiff_t pos_byte,
+ ptrdiff_t lim, ptrdiff_t lim_byte)
{
int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
int forward = n > 0;
/* Number of buffer bytes matched. Note that this may be different
from len_byte in a multibyte buffer. */
- EMACS_INT match_byte;
+ ptrdiff_t match_byte = PTRDIFF_MIN;
if (lim > pos && multibyte)
while (n > 0)
@@ -1456,9 +1466,9 @@ simple_search (EMACS_INT n, unsigned char *pat,
while (1)
{
/* Try matching at position POS. */
- EMACS_INT this_pos = pos;
- EMACS_INT this_pos_byte = pos_byte;
- EMACS_INT this_len = len;
+ ptrdiff_t this_pos = pos;
+ ptrdiff_t this_pos_byte = pos_byte;
+ ptrdiff_t this_len = len;
unsigned char *p = pat;
if (pos + len > lim || pos_byte + len_byte > lim_byte)
goto stop;
@@ -1502,8 +1512,8 @@ simple_search (EMACS_INT n, unsigned char *pat,
while (1)
{
/* Try matching at position POS. */
- EMACS_INT this_pos = pos;
- EMACS_INT this_len = len;
+ ptrdiff_t this_pos = pos;
+ ptrdiff_t this_len = len;
unsigned char *p = pat;
if (pos + len > lim)
@@ -1541,9 +1551,9 @@ simple_search (EMACS_INT n, unsigned char *pat,
while (1)
{
/* Try matching at position POS. */
- EMACS_INT this_pos = pos;
- EMACS_INT this_pos_byte = pos_byte;
- EMACS_INT this_len = len;
+ ptrdiff_t this_pos = pos;
+ ptrdiff_t this_pos_byte = pos_byte;
+ ptrdiff_t this_len = len;
const unsigned char *p = pat + len_byte;
if (this_pos - len < lim || (pos_byte - len_byte) < lim_byte)
@@ -1584,8 +1594,8 @@ simple_search (EMACS_INT n, unsigned char *pat,
while (1)
{
/* Try matching at position POS. */
- EMACS_INT this_pos = pos - len;
- EMACS_INT this_len = len;
+ ptrdiff_t this_pos = pos - len;
+ ptrdiff_t this_len = len;
unsigned char *p = pat;
if (this_pos < lim)
@@ -1619,6 +1629,7 @@ simple_search (EMACS_INT n, unsigned char *pat,
stop:
if (n == 0)
{
+ eassert (match_byte != PTRDIFF_MIN);
if (forward)
set_search_regs ((multibyte ? pos_byte : pos) - match_byte, match_byte);
else
@@ -1649,18 +1660,18 @@ simple_search (EMACS_INT n, unsigned char *pat,
static EMACS_INT
boyer_moore (EMACS_INT n, unsigned char *base_pat,
- EMACS_INT len_byte,
+ ptrdiff_t len_byte,
Lisp_Object trt, Lisp_Object inverse_trt,
- EMACS_INT pos_byte, EMACS_INT lim_byte,
+ ptrdiff_t pos_byte, ptrdiff_t lim_byte,
int char_base)
{
int direction = ((n > 0) ? 1 : -1);
- register EMACS_INT dirlen;
- EMACS_INT limit;
+ register ptrdiff_t dirlen;
+ ptrdiff_t limit;
int stride_for_teases = 0;
int BM_tab[0400];
register unsigned char *cursor, *p_limit;
- register EMACS_INT i;
+ register ptrdiff_t i;
register int j;
unsigned char *pat, *pat_end;
int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
@@ -1812,7 +1823,7 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat,
char if reverse) of pattern would align in a possible match. */
while (n != 0)
{
- EMACS_INT tail_end;
+ ptrdiff_t tail_end;
unsigned char *tail_end_ptr;
/* It's been reported that some (broken) compiler thinks that
@@ -1916,7 +1927,7 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat,
cursor += dirlen - i - direction; /* fix cursor */
if (i + direction == 0)
{
- EMACS_INT position, start, end;
+ ptrdiff_t position, start, end;
cursor -= direction;
@@ -2008,7 +2019,7 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat,
pos_byte += dirlen - i - direction;
if (i + direction == 0)
{
- EMACS_INT position, start, end;
+ ptrdiff_t position, start, end;
pos_byte -= direction;
position = pos_byte + ((direction > 0) ? 1 - len_byte : 0);
@@ -2049,9 +2060,9 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat,
Also clear out the match data for registers 1 and up. */
static void
-set_search_regs (EMACS_INT beg_byte, EMACS_INT nbytes)
+set_search_regs (ptrdiff_t beg_byte, ptrdiff_t nbytes)
{
- int i;
+ ptrdiff_t i;
if (!NILP (Vinhibit_changing_match_data))
return;
@@ -2060,8 +2071,8 @@ set_search_regs (EMACS_INT beg_byte, EMACS_INT nbytes)
the match position. */
if (search_regs.num_regs == 0)
{
- search_regs.start = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
- search_regs.end = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
+ search_regs.start = xmalloc (2 * sizeof (regoff_t));
+ search_regs.end = xmalloc (2 * sizeof (regoff_t));
search_regs.num_regs = 2;
}
@@ -2077,102 +2088,6 @@ set_search_regs (EMACS_INT beg_byte, EMACS_INT nbytes)
XSETBUFFER (last_thing_searched, current_buffer);
}
-DEFUN ("word-search-regexp", Fword_search_regexp, Sword_search_regexp, 1, 2, 0,
- doc: /* Return a regexp which matches words, ignoring punctuation.
-Given STRING, a string of words separated by word delimiters,
-compute a regexp that matches those exact words separated by
-arbitrary punctuation. If LAX is non-nil, the end of the string
-need not match a word boundary unless it ends in whitespace.
-
-Used in `word-search-forward', `word-search-backward',
-`word-search-forward-lax', `word-search-backward-lax'. */)
- (Lisp_Object string, Lisp_Object lax)
-{
- register unsigned char *o;
- register EMACS_INT i, i_byte, len, punct_count = 0, word_count = 0;
- Lisp_Object val;
- int prev_c = 0;
- EMACS_INT adjust;
- int whitespace_at_end;
-
- CHECK_STRING (string);
- len = SCHARS (string);
-
- for (i = 0, i_byte = 0; i < len; )
- {
- int c;
-
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
-
- if (SYNTAX (c) != Sword)
- {
- punct_count++;
- if (SYNTAX (prev_c) == Sword)
- word_count++;
- }
-
- prev_c = c;
- }
-
- if (SYNTAX (prev_c) == Sword)
- {
- word_count++;
- whitespace_at_end = 0;
- }
- else
- {
- whitespace_at_end = 1;
- if (!word_count)
- return empty_unibyte_string;
- }
-
- adjust = - punct_count + 5 * (word_count - 1)
- + ((!NILP (lax) && !whitespace_at_end) ? 2 : 4);
- if (STRING_MULTIBYTE (string))
- val = make_uninit_multibyte_string (len + adjust,
- SBYTES (string)
- + adjust);
- else
- val = make_uninit_string (len + adjust);
-
- o = SDATA (val);
- *o++ = '\\';
- *o++ = 'b';
- prev_c = 0;
-
- for (i = 0, i_byte = 0; i < len; )
- {
- int c;
- EMACS_INT i_byte_orig = i_byte;
-
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
-
- if (SYNTAX (c) == Sword)
- {
- memcpy (o, SDATA (string) + i_byte_orig, i_byte - i_byte_orig);
- o += i_byte - i_byte_orig;
- }
- else if (SYNTAX (prev_c) == Sword && --word_count)
- {
- *o++ = '\\';
- *o++ = 'W';
- *o++ = '\\';
- *o++ = 'W';
- *o++ = '*';
- }
-
- prev_c = c;
- }
-
- if (NILP (lax) || whitespace_at_end)
- {
- *o++ = '\\';
- *o++ = 'b';
- }
-
- return val;
-}
-
DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4,
"MSearch backward: ",
doc: /* Search backward from point for STRING.
@@ -2181,7 +2096,9 @@ An optional second argument bounds the search; it is a buffer position.
The match found must not extend before that position.
Optional third argument, if t, means if fail just return nil (no error).
If not nil and not t, position at limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
+Optional fourth argument COUNT, if non-nil, means to search for COUNT
+ successive occurrences. If COUNT is negative, search forward,
+ instead of backward, for -COUNT occurrences.
Search case-sensitivity is determined by the value of the variable
`case-fold-search', which see.
@@ -2200,7 +2117,9 @@ The match found must not extend after that position. A value of nil is
equivalent to (point-max).
Optional third argument, if t, means if fail just return nil (no error).
If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
+Optional fourth argument COUNT, if non-nil, means to search for COUNT
+ successive occurrences. If COUNT is negative, search backward,
+ instead of forward, for -COUNT occurrences.
Search case-sensitivity is determined by the value of the variable
`case-fold-search', which see.
@@ -2211,86 +2130,6 @@ See also the functions `match-beginning', `match-end' and `replace-match'. */)
return search_command (string, bound, noerror, count, 1, 0, 0);
}
-DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4,
- "sWord search backward: ",
- doc: /* Search backward from point for STRING, ignoring differences in punctuation.
-Set point to the beginning of the occurrence found, and return point.
-An optional second argument bounds the search; it is a buffer position.
-The match found must not extend before that position.
-Optional third argument, if t, means if fail just return nil (no error).
- If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-
-Relies on the function `word-search-regexp' to convert a sequence
-of words in STRING to a regexp used to search words without regard
-to punctuation. */)
- (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
-{
- return search_command (Fword_search_regexp (string, Qnil), bound, noerror, count, -1, 1, 0);
-}
-
-DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4,
- "sWord search: ",
- doc: /* Search forward from point for STRING, ignoring differences in punctuation.
-Set point to the end of the occurrence found, and return point.
-An optional second argument bounds the search; it is a buffer position.
-The match found must not extend after that position.
-Optional third argument, if t, means if fail just return nil (no error).
- If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-
-Relies on the function `word-search-regexp' to convert a sequence
-of words in STRING to a regexp used to search words without regard
-to punctuation. */)
- (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
-{
- return search_command (Fword_search_regexp (string, Qnil), bound, noerror, count, 1, 1, 0);
-}
-
-DEFUN ("word-search-backward-lax", Fword_search_backward_lax, Sword_search_backward_lax, 1, 4,
- "sWord search backward: ",
- doc: /* Search backward from point for STRING, ignoring differences in punctuation.
-Set point to the beginning of the occurrence found, and return point.
-
-Unlike `word-search-backward', the end of STRING need not match a word
-boundary unless it ends in whitespace.
-
-An optional second argument bounds the search; it is a buffer position.
-The match found must not extend before that position.
-Optional third argument, if t, means if fail just return nil (no error).
- If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-
-Relies on the function `word-search-regexp' to convert a sequence
-of words in STRING to a regexp used to search words without regard
-to punctuation. */)
- (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
-{
- return search_command (Fword_search_regexp (string, Qt), bound, noerror, count, -1, 1, 0);
-}
-
-DEFUN ("word-search-forward-lax", Fword_search_forward_lax, Sword_search_forward_lax, 1, 4,
- "sWord search: ",
- doc: /* Search forward from point for STRING, ignoring differences in punctuation.
-Set point to the end of the occurrence found, and return point.
-
-Unlike `word-search-forward', the end of STRING need not match a word
-boundary unless it ends in whitespace.
-
-An optional second argument bounds the search; it is a buffer position.
-The match found must not extend after that position.
-Optional third argument, if t, means if fail just return nil (no error).
- If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-
-Relies on the function `word-search-regexp' to convert a sequence
-of words in STRING to a regexp used to search words without regard
-to punctuation. */)
- (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
-{
- return search_command (Fword_search_regexp (string, Qt), bound, noerror, count, 1, 1, 0);
-}
-
DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
"sRE search backward: ",
doc: /* Search backward from point for match for regular expression REGEXP.
@@ -2381,29 +2220,29 @@ DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 0,
doc: /* Replace text matched by last search with NEWTEXT.
Leave point at the end of the replacement text.
-If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
-Otherwise maybe capitalize the whole text, or maybe just word initials,
-based on the replaced text.
-If the replaced text has only capital letters
-and has at least one multiletter word, convert NEWTEXT to all caps.
-Otherwise if all words are capitalized in the replaced text,
-capitalize each word in NEWTEXT.
+If optional second arg FIXEDCASE is non-nil, do not alter the case of
+the replacement text. Otherwise, maybe capitalize the whole text, or
+maybe just word initials, based on the replaced text. If the replaced
+text has only capital letters and has at least one multiletter word,
+convert NEWTEXT to all caps. Otherwise if all words are capitalized
+in the replaced text, capitalize each word in NEWTEXT.
-If third arg LITERAL is non-nil, insert NEWTEXT literally.
+If optional third arg LITERAL is non-nil, insert NEWTEXT literally.
Otherwise treat `\\' as special:
`\\&' in NEWTEXT means substitute original matched text.
`\\N' means substitute what matched the Nth `\\(...\\)'.
If Nth parens didn't match, substitute nothing.
`\\\\' means insert one `\\'.
+ `\\?' is treated literally
+ (for compatibility with `query-replace-regexp').
+ Any other character following `\\' signals an error.
Case conversion does not apply to these substitutions.
-FIXEDCASE and LITERAL are optional arguments.
-
-The optional fourth argument STRING can be a string to modify.
-This is meaningful when the previous match was done against STRING,
-using `string-match'. When used this way, `replace-match'
-creates and returns a new string made by copying STRING and replacing
-the part of STRING that was matched.
+If optional fourth argument STRING is non-nil, it should be a string
+to act on; this should be the string on which the previous match was
+done via `string-match'. In this case, `replace-match' creates and
+returns a new string, made by copying STRING and replacing the part of
+STRING that was matched (the original STRING itself is not altered).
The optional fifth argument SUBEXP specifies a subexpression;
it says to replace just that subexpression with NEWTEXT,
@@ -2416,14 +2255,14 @@ since only regular expressions have distinguished subexpressions. */)
(Lisp_Object newtext, Lisp_Object fixedcase, Lisp_Object literal, Lisp_Object string, Lisp_Object subexp)
{
enum { nochange, all_caps, cap_initial } case_action;
- register EMACS_INT pos, pos_byte;
+ register ptrdiff_t pos, pos_byte;
int some_multiletter_word;
int some_lowercase;
int some_uppercase;
int some_nonuppercase_initial;
register int c, prevc;
ptrdiff_t sub;
- EMACS_INT opoint, newpoint;
+ ptrdiff_t opoint, newpoint;
CHECK_STRING (newtext);
@@ -2466,7 +2305,7 @@ since only regular expressions have distinguished subexpressions. */)
if (NILP (fixedcase))
{
/* Decide how to casify by examining the matched text. */
- EMACS_INT last;
+ ptrdiff_t last;
pos = search_regs.start[sub];
last = search_regs.end[sub];
@@ -2553,19 +2392,19 @@ since only regular expressions have distinguished subexpressions. */)
if desired. */
if (NILP (literal))
{
- EMACS_INT lastpos = 0;
- EMACS_INT lastpos_byte = 0;
+ ptrdiff_t lastpos = 0;
+ ptrdiff_t lastpos_byte = 0;
/* We build up the substituted string in ACCUM. */
Lisp_Object accum;
Lisp_Object middle;
- EMACS_INT length = SBYTES (newtext);
+ ptrdiff_t length = SBYTES (newtext);
accum = Qnil;
for (pos_byte = 0, pos = 0; pos_byte < length;)
{
- EMACS_INT substart = -1;
- EMACS_INT subend = 0;
+ ptrdiff_t substart = -1;
+ ptrdiff_t subend = 0;
int delbackslash = 0;
FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
@@ -2581,8 +2420,8 @@ since only regular expressions have distinguished subexpressions. */)
}
else if (c >= '1' && c <= '9')
{
- if (search_regs.start[c - '0'] >= 0
- && c <= search_regs.num_regs + '0')
+ if (c - '0' < search_regs.num_regs
+ && 0 <= search_regs.start[c - '0'])
{
substart = search_regs.start[c - '0'];
subend = search_regs.end[c - '0'];
@@ -2597,7 +2436,7 @@ since only regular expressions have distinguished subexpressions. */)
}
else if (c == '\\')
delbackslash = 1;
- else
+ else if (c != '?')
error ("Invalid use of `\\' in replacement text");
}
if (substart >= 0)
@@ -2668,7 +2507,7 @@ since only regular expressions have distinguished subexpressions. */)
substed_alloc_size = ((STRING_BYTES_BOUND - 100) / 2 < length
? STRING_BYTES_BOUND
: length * 2 + 100);
- substed = (unsigned char *) xmalloc (substed_alloc_size);
+ substed = xmalloc (substed_alloc_size);
substed_len = 0;
/* Go thru NEWTEXT, producing the actual text to insert in
@@ -2720,7 +2559,7 @@ since only regular expressions have distinguished subexpressions. */)
if (c == '&')
idx = sub;
- else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0')
+ else if (c >= '1' && c <= '9' && c - '0' < search_regs.num_regs)
{
if (search_regs.start[c - '0'] >= 1)
idx = c - '0';
@@ -2772,7 +2611,7 @@ since only regular expressions have distinguished subexpressions. */)
{
if (buf_multibyte)
{
- EMACS_INT nchars =
+ ptrdiff_t nchars =
multibyte_chars_in_text (substed, substed_len);
newtext = make_multibyte_string ((char *) substed, nchars,
@@ -2798,10 +2637,10 @@ since only regular expressions have distinguished subexpressions. */)
/* Adjust search data for this change. */
{
- EMACS_INT oldend = search_regs.end[sub];
- EMACS_INT oldstart = search_regs.start[sub];
- EMACS_INT change = newpoint - search_regs.end[sub];
- int i;
+ ptrdiff_t oldend = search_regs.end[sub];
+ ptrdiff_t oldstart = search_regs.start[sub];
+ ptrdiff_t change = newpoint - search_regs.end[sub];
+ ptrdiff_t i;
for (i = 0; i < search_regs.num_regs; i++)
{
@@ -2894,7 +2733,7 @@ Return value is undefined if the last search failed. */)
{
Lisp_Object tail, prev;
Lisp_Object *data;
- int i, len;
+ ptrdiff_t i, len;
if (!NILP (reseat))
for (tail = reuse; CONSP (tail); tail = XCDR (tail))
@@ -2909,13 +2748,12 @@ Return value is undefined if the last search failed. */)
prev = Qnil;
- data = (Lisp_Object *) alloca ((2 * search_regs.num_regs + 1)
- * sizeof (Lisp_Object));
+ data = alloca ((2 * search_regs.num_regs + 1) * sizeof *data);
len = 0;
for (i = 0; i < search_regs.num_regs; i++)
{
- EMACS_INT start = search_regs.start[i];
+ ptrdiff_t start = search_regs.start[i];
if (start >= 0)
{
if (EQ (last_thing_searched, Qt)
@@ -2937,7 +2775,7 @@ Return value is undefined if the last search failed. */)
}
else
/* last_thing_searched must always be Qt, a buffer, or Qnil. */
- abort ();
+ emacs_abort ();
len = 2 * i + 2;
}
@@ -3006,11 +2844,13 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */)
/* Allocate registers if they don't already exist. */
{
- ptrdiff_t length = XFASTINT (Flength (list)) / 2;
+ EMACS_INT length = XFASTINT (Flength (list)) / 2;
if (length > search_regs.num_regs)
{
ptrdiff_t num_regs = search_regs.num_regs;
+ if (PTRDIFF_MAX < length)
+ memory_full (SIZE_MAX);
search_regs.start =
xpalloc (search_regs.start, &num_regs, length - num_regs,
min (PTRDIFF_MAX, UINT_MAX), sizeof (regoff_t));
@@ -3040,7 +2880,7 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */)
}
else
{
- EMACS_INT from;
+ Lisp_Object from;
Lisp_Object m;
m = marker;
@@ -3053,7 +2893,7 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */)
}
CHECK_NUMBER_COERCE_MARKER (marker);
- from = XINT (marker);
+ from = marker;
if (!NILP (reseat) && MARKERP (m))
{
@@ -3070,8 +2910,20 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */)
XSETFASTINT (marker, 0);
CHECK_NUMBER_COERCE_MARKER (marker);
- search_regs.start[i] = from;
- search_regs.end[i] = XINT (marker);
+ if ((XINT (from) < 0
+ ? TYPE_MINIMUM (regoff_t) <= XINT (from)
+ : XINT (from) <= TYPE_MAXIMUM (regoff_t))
+ && (XINT (marker) < 0
+ ? TYPE_MINIMUM (regoff_t) <= XINT (marker)
+ : XINT (marker) <= TYPE_MAXIMUM (regoff_t)))
+ {
+ search_regs.start[i] = XINT (from);
+ search_regs.end[i] = XINT (marker);
+ }
+ else
+ {
+ search_regs.start[i] = -1;
+ }
if (!NILP (reseat) && MARKERP (m))
{
@@ -3162,7 +3014,7 @@ DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0,
CHECK_STRING (string);
- temp = (char *) alloca (SBYTES (string) * 2);
+ temp = alloca (SBYTES (string) * 2);
/* Now copy the data into the new string, inserting escapes. */
@@ -3194,7 +3046,7 @@ syms_of_search (void)
for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
{
searchbufs[i].buf.allocated = 100;
- searchbufs[i].buf.buffer = (unsigned char *) xmalloc (100);
+ searchbufs[i].buf.buffer = xmalloc (100);
searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
searchbufs[i].regexp = Qnil;
searchbufs[i].whitespace_regexp = Qnil;
@@ -3210,14 +3062,14 @@ syms_of_search (void)
DEFSYM (Qinvalid_regexp, "invalid-regexp");
Fput (Qsearch_failed, Qerror_conditions,
- pure_cons (Qsearch_failed, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qsearch_failed, Qerror));
Fput (Qsearch_failed, Qerror_message,
- make_pure_c_string ("Search failed"));
+ build_pure_c_string ("Search failed"));
Fput (Qinvalid_regexp, Qerror_conditions,
- pure_cons (Qinvalid_regexp, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qinvalid_regexp, Qerror));
Fput (Qinvalid_regexp, Qerror_message,
- make_pure_c_string ("Invalid regexp"));
+ build_pure_c_string ("Invalid regexp"));
last_thing_searched = Qnil;
staticpro (&last_thing_searched);
@@ -3247,11 +3099,6 @@ is to bind it with `let' around a small expression. */);
defsubr (&Sposix_string_match);
defsubr (&Ssearch_forward);
defsubr (&Ssearch_backward);
- defsubr (&Sword_search_regexp);
- defsubr (&Sword_search_forward);
- defsubr (&Sword_search_backward);
- defsubr (&Sword_search_forward_lax);
- defsubr (&Sword_search_backward_lax);
defsubr (&Sre_search_forward);
defsubr (&Sre_search_backward);
defsubr (&Sposix_search_forward);
diff --git a/src/sheap.c b/src/sheap.c
index 31414fbe5c6..f6022ea3ce7 100644
--- a/src/sheap.c
+++ b/src/sheap.c
@@ -1,7 +1,7 @@
/* simulate `sbrk' with an array in .bss, for `unexec' support for Cygwin;
complete rewrite of xemacs Cygwin `unexec' code
- Copyright (C) 2004-2011 Free Software Foundation, Inc.
+ Copyright (C) 2004-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -20,7 +20,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include <unistd.h>
@@ -93,4 +93,3 @@ report_sheap_usage (int die_if_pure_storage_exceeded)
bss_sbrk_ptr - bss_sbrk_buffer, STATIC_HEAP_SIZE);
message ("%s", buf);
}
-
diff --git a/src/sound.c b/src/sound.c
index 4e9758d27df..0ee85312fd3 100644
--- a/src/sound.c
+++ b/src/sound.c
@@ -1,5 +1,6 @@
/* sound.c -- sound support.
- Copyright (C) 1998-1999, 2001-2011 Free Software Foundation, Inc.
+
+Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -30,7 +31,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
cause an error to be generated.
The Windows implementation of play-sound is implemented via the
- Win32 API functions mciSendString, waveOutGetVolume, and
+ Windows API functions mciSendString, waveOutGetVolume, and
waveOutSetVolume which are exported by Winmm.dll.
*/
@@ -43,11 +44,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <unistd.h>
#include <sys/types.h>
#include <errno.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "dispextern.h"
#include "atimer.h"
-#include <signal.h>
#include "syssignal.h"
/* END: Common Includes */
@@ -109,26 +109,11 @@ enum sound_attr
SOUND_ATTR_SENTINEL
};
-#ifdef HAVE_ALSA
-static void alsa_sound_perror (const char *, int) NO_RETURN;
-#endif
-static void sound_perror (const char *) NO_RETURN;
-static void sound_warning (const char *);
-static int parse_sound (Lisp_Object, Lisp_Object *);
-
/* END: Common Definitions */
/* BEGIN: Non Windows Definitions */
#ifndef WINDOWSNT
-#ifndef DEFAULT_SOUND_DEVICE
-#define DEFAULT_SOUND_DEVICE "/dev/dsp"
-#endif
-#ifndef DEFAULT_ALSA_SOUND_DEVICE
-#define DEFAULT_ALSA_SOUND_DEVICE "default"
-#endif
-
-
/* Structure forward declarations. */
struct sound;
@@ -235,11 +220,11 @@ struct sound_device
/* Return a preferred data size in bytes to be sent to write (below)
each time. 2048 is used if this is NULL. */
- EMACS_INT (* period_size) (struct sound_device *sd);
+ ptrdiff_t (* period_size) (struct sound_device *sd);
/* Write NYBTES bytes from BUFFER to device SD. */
void (* write) (struct sound_device *sd, const char *buffer,
- EMACS_INT nbytes);
+ ptrdiff_t nbytes);
/* A place for devices to store additional data. */
void *data;
@@ -291,7 +276,7 @@ static void vox_configure (struct sound_device *);
static void vox_close (struct sound_device *sd);
static void vox_choose_format (struct sound_device *, struct sound *);
static int vox_init (struct sound_device *);
-static void vox_write (struct sound_device *, const char *, EMACS_INT);
+static void vox_write (struct sound_device *, const char *, ptrdiff_t);
static void find_sound_type (struct sound *);
static u_int32_t le2hl (u_int32_t);
static u_int16_t le2hs (u_int16_t);
@@ -323,14 +308,19 @@ static int do_play_sound (const char *, unsigned long);
/* Like perror, but signals an error. */
-static void
+static _Noreturn void
sound_perror (const char *msg)
{
int saved_errno = errno;
turn_on_atimers (1);
-#ifdef SIGIO
- sigunblock (sigmask (SIGIO));
+#ifdef USABLE_SIGIO
+ {
+ sigset_t unblocked;
+ sigemptyset (&unblocked);
+ sigaddset (&unblocked, SIGIO);
+ pthread_sigmask (SIG_UNBLOCK, &unblocked, 0);
+ }
#endif
if (saved_errno != 0)
error ("%s: %s", msg, strerror (saved_errno));
@@ -600,11 +590,11 @@ wav_play (struct sound *s, struct sound_device *sd)
else
{
char *buffer;
- EMACS_INT nbytes = 0;
- EMACS_INT blksize = sd->period_size ? sd->period_size (sd) : 2048;
- EMACS_INT data_left = header->data_length;
+ ptrdiff_t nbytes = 0;
+ ptrdiff_t blksize = sd->period_size ? sd->period_size (sd) : 2048;
+ ptrdiff_t data_left = header->data_length;
- buffer = (char *) alloca (blksize);
+ buffer = alloca (blksize);
lseek (s->fd, sizeof *header, SEEK_SET);
while (data_left > 0
&& (nbytes = emacs_read (s->fd, buffer, blksize)) > 0)
@@ -690,15 +680,15 @@ au_play (struct sound *s, struct sound_device *sd)
SBYTES (s->data) - header->data_offset);
else
{
- EMACS_INT blksize = sd->period_size ? sd->period_size (sd) : 2048;
+ ptrdiff_t blksize = sd->period_size ? sd->period_size (sd) : 2048;
char *buffer;
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
/* Seek */
lseek (s->fd, header->data_offset, SEEK_SET);
/* Copy sound data to the device. */
- buffer = (char *) alloca (blksize);
+ buffer = alloca (blksize);
while ((nbytes = emacs_read (s->fd, buffer, blksize)) > 0)
sd->write (sd, buffer, nbytes);
@@ -724,7 +714,7 @@ vox_open (struct sound_device *sd)
{
const char *file;
- /* Open the sound device. Default is /dev/dsp. */
+ /* Open the sound device (eg /dev/dsp). */
if (sd->file)
file = sd->file;
else
@@ -742,15 +732,20 @@ static void
vox_configure (struct sound_device *sd)
{
int val;
+#ifdef USABLE_SIGIO
+ sigset_t blocked;
+#endif
- xassert (sd->fd >= 0);
+ eassert (sd->fd >= 0);
/* On GNU/Linux, it seems that the device driver doesn't like to be
interrupted by a signal. Block the ones we know to cause
troubles. */
turn_on_atimers (0);
-#ifdef SIGIO
- sigblock (sigmask (SIGIO));
+#ifdef USABLE_SIGIO
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGIO);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
#endif
val = sd->format;
@@ -783,8 +778,8 @@ vox_configure (struct sound_device *sd)
}
turn_on_atimers (1);
-#ifdef SIGIO
- sigunblock (sigmask (SIGIO));
+#ifdef USABLE_SIGIO
+ pthread_sigmask (SIG_UNBLOCK, &blocked, 0);
#endif
}
@@ -799,8 +794,11 @@ vox_close (struct sound_device *sd)
/* On GNU/Linux, it seems that the device driver doesn't like to
be interrupted by a signal. Block the ones we know to cause
troubles. */
-#ifdef SIGIO
- sigblock (sigmask (SIGIO));
+#ifdef USABLE_SIGIO
+ sigset_t blocked;
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGIO);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
#endif
turn_on_atimers (0);
@@ -808,8 +806,8 @@ vox_close (struct sound_device *sd)
ioctl (sd->fd, SNDCTL_DSP_SYNC, NULL);
turn_on_atimers (1);
-#ifdef SIGIO
- sigunblock (sigmask (SIGIO));
+#ifdef USABLE_SIGIO
+ pthread_sigmask (SIG_UNBLOCK, &blocked, 0);
#endif
/* Close the device. */
@@ -857,7 +855,7 @@ vox_choose_format (struct sound_device *sd, struct sound *s)
}
}
else
- abort ();
+ emacs_abort ();
}
@@ -870,7 +868,7 @@ vox_init (struct sound_device *sd)
const char *file;
int fd;
- /* Open the sound device. Default is /dev/dsp. */
+ /* Open the sound device (eg /dev/dsp). */
if (sd->file)
file = sd->file;
else
@@ -895,7 +893,7 @@ vox_init (struct sound_device *sd)
/* Write NBYTES bytes from BUFFER to device SD. */
static void
-vox_write (struct sound_device *sd, const char *buffer, EMACS_INT nbytes)
+vox_write (struct sound_device *sd, const char *buffer, ptrdiff_t nbytes)
{
if (emacs_write (sd->fd, buffer, nbytes) != nbytes)
sound_perror ("Error writing to sound device");
@@ -908,7 +906,11 @@ vox_write (struct sound_device *sd, const char *buffer, EMACS_INT nbytes)
/* This driver is available on GNU/Linux. */
-static void
+#ifndef DEFAULT_ALSA_SOUND_DEVICE
+#define DEFAULT_ALSA_SOUND_DEVICE "default"
+#endif
+
+static _Noreturn void
alsa_sound_perror (const char *msg, int err)
{
error ("%s: %s", msg, snd_strerror (err));
@@ -938,7 +940,7 @@ alsa_open (struct sound_device *sd)
else
file = DEFAULT_ALSA_SOUND_DEVICE;
- p = xmalloc (sizeof (*p));
+ p = xmalloc (sizeof *p);
p->handle = NULL;
p->hwparams = NULL;
p->swparams = NULL;
@@ -952,7 +954,7 @@ alsa_open (struct sound_device *sd)
alsa_sound_perror (file, err);
}
-static EMACS_INT
+static ptrdiff_t
alsa_period_size (struct sound_device *sd)
{
struct alsa_params *p = (struct alsa_params *) sd->data;
@@ -968,7 +970,7 @@ alsa_configure (struct sound_device *sd)
struct alsa_params *p = (struct alsa_params *) sd->data;
snd_pcm_uframes_t buffer_size;
- xassert (p->handle != 0);
+ eassert (p->handle != 0);
err = snd_pcm_hw_params_malloc (&p->hwparams);
if (err < 0)
@@ -1148,20 +1150,20 @@ alsa_choose_format (struct sound_device *sd, struct sound *s)
}
}
else
- abort ();
+ emacs_abort ();
}
/* Write NBYTES bytes from BUFFER to device SD. */
static void
-alsa_write (struct sound_device *sd, const char *buffer, EMACS_INT nbytes)
+alsa_write (struct sound_device *sd, const char *buffer, ptrdiff_t nbytes)
{
struct alsa_params *p = (struct alsa_params *) sd->data;
/* The the third parameter to snd_pcm_writei is frames, not bytes. */
int fact = snd_pcm_format_size (sd->format, 1) * sd->channels;
- EMACS_INT nwritten = 0;
+ ptrdiff_t nwritten = 0;
int err;
while (nwritten < nbytes)
@@ -1348,7 +1350,7 @@ Internal use only, use `play-sound' instead. */)
(Lisp_Object sound)
{
Lisp_Object attrs[SOUND_ATTR_SENTINEL];
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
#ifndef WINDOWSNT
Lisp_Object file;
@@ -1370,12 +1372,10 @@ Internal use only, use `play-sound' instead. */)
#ifndef WINDOWSNT
file = Qnil;
GCPRO2 (sound, file);
- current_sound_device = (struct sound_device *) xmalloc (sizeof (struct sound_device));
- memset (current_sound_device, 0, sizeof (struct sound_device));
- current_sound = (struct sound *) xmalloc (sizeof (struct sound));
- memset (current_sound, 0, sizeof (struct sound));
+ current_sound_device = xzalloc (sizeof *current_sound_device);
+ current_sound = xzalloc (sizeof *current_sound);
record_unwind_protect (sound_cleanup, Qnil);
- current_sound->header = (char *) alloca (MAX_SOUND_HEADER_BYTES);
+ current_sound->header = alloca (MAX_SOUND_HEADER_BYTES);
if (STRINGP (attrs[SOUND_FILE]))
{
@@ -1407,7 +1407,7 @@ Internal use only, use `play-sound' instead. */)
if (STRINGP (attrs[SOUND_DEVICE]))
{
int len = SCHARS (attrs[SOUND_DEVICE]);
- current_sound_device->file = (char *) alloca (len + 1);
+ current_sound_device->file = alloca (len + 1);
strcpy (current_sound_device->file, SSDATA (attrs[SOUND_DEVICE]));
}
@@ -1439,7 +1439,7 @@ Internal use only, use `play-sound' instead. */)
lo_file = Fexpand_file_name (attrs[SOUND_FILE], Qnil);
len = XSTRING (lo_file)->size;
- psz_file = (char *) alloca (len + 1);
+ psz_file = alloca (len + 1);
strcpy (psz_file, XSTRING (lo_file)->data);
if (INTEGERP (attrs[SOUND_VOLUME]))
{
@@ -1485,10 +1485,4 @@ syms_of_sound (void)
defsubr (&Splay_sound_internal);
}
-
-void
-init_sound (void)
-{
-}
-
#endif /* HAVE_SOUND */
diff --git a/src/stamp-h.in b/src/stamp-h.in
deleted file mode 100644
index 9788f70238c..00000000000
--- a/src/stamp-h.in
+++ /dev/null
@@ -1 +0,0 @@
-timestamp
diff --git a/src/syntax.c b/src/syntax.c
index 3e51099794b..d3cafcc472e 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -1,5 +1,5 @@
/* GNU Emacs routines to deal with syntax tables; also word and list parsing.
- Copyright (C) 1985, 1987, 1993-1995, 1997-1999, 2001-2011
+ Copyright (C) 1985, 1987, 1993-1995, 1997-1999, 2001-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -20,13 +20,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <ctype.h>
#include <sys/types.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "commands.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "keymap.h"
#include "regex.h"
@@ -111,18 +110,18 @@ Lisp_Object syntax_temp;
struct lisp_parse_state
{
- int depth; /* Depth at end of parsing. */
+ EMACS_INT depth; /* Depth at end of parsing. */
int instring; /* -1 if not within string, else desired terminator. */
- int incomment; /* -1 if in unnestable comment else comment nesting */
+ EMACS_INT incomment; /* -1 if in unnestable comment else comment nesting */
int comstyle; /* comment style a=0, or b=1, or ST_COMMENT_STYLE. */
int quoted; /* Nonzero if just after an escape char at end of parsing */
- int mindepth; /* Minimum depth seen while scanning. */
+ EMACS_INT mindepth; /* Minimum depth seen while scanning. */
/* Char number of most recent start-of-expression at current level */
- EMACS_INT thislevelstart;
+ ptrdiff_t thislevelstart;
/* Char number of start of containing expression */
- EMACS_INT prevlevelstart;
- EMACS_INT location; /* Char number at which parsing stopped. */
- EMACS_INT comstr_start; /* Position of last comment/string starter. */
+ ptrdiff_t prevlevelstart;
+ ptrdiff_t location; /* Char number at which parsing stopped. */
+ ptrdiff_t comstr_start; /* Position of last comment/string starter. */
Lisp_Object levelstarts; /* Char numbers of starts-of-expression
of levels (starting from outermost). */
};
@@ -135,22 +134,28 @@ struct lisp_parse_state
find_start_begv is the BEGV value when it was found.
find_start_modiff is the value of MODIFF when it was found. */
-static EMACS_INT find_start_pos;
-static EMACS_INT find_start_value;
-static EMACS_INT find_start_value_byte;
+static ptrdiff_t find_start_pos;
+static ptrdiff_t find_start_value;
+static ptrdiff_t find_start_value_byte;
static struct buffer *find_start_buffer;
-static EMACS_INT find_start_begv;
-static int find_start_modiff;
+static ptrdiff_t find_start_begv;
+static EMACS_INT find_start_modiff;
-static Lisp_Object Fsyntax_table_p (Lisp_Object);
static Lisp_Object skip_chars (int, Lisp_Object, Lisp_Object, int);
static Lisp_Object skip_syntaxes (int, Lisp_Object, Lisp_Object);
static Lisp_Object scan_lists (EMACS_INT, EMACS_INT, EMACS_INT, int);
static void scan_sexps_forward (struct lisp_parse_state *,
- EMACS_INT, EMACS_INT, EMACS_INT, int,
+ ptrdiff_t, ptrdiff_t, ptrdiff_t, EMACS_INT,
int, Lisp_Object, int);
static int in_classes (int, Lisp_Object);
+
+/* This setter is used only in this file, so it can be private. */
+static void
+bset_syntax_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (syntax_table) = val;
+}
/* Whether the syntax of the character C has the prefix flag set. */
int syntax_prefix_flag_p (int c)
@@ -172,12 +177,12 @@ struct gl_state_s gl_state; /* Global state of syntax parser. */
direction than the intervals - or in an interval. We update the
current syntax-table basing on the property of this interval, and
update the interval to start further than CHARPOS - or be
- NULL_INTERVAL. We also update lim_property to be the next value of
+ NULL. We also update lim_property to be the next value of
charpos to call this subroutine again - or be before/after the
start/end of OBJECT. */
void
-update_syntax_table (EMACS_INT charpos, EMACS_INT count, int init,
+update_syntax_table (ptrdiff_t charpos, EMACS_INT count, int init,
Lisp_Object object)
{
Lisp_Object tmp_table;
@@ -193,7 +198,7 @@ update_syntax_table (EMACS_INT charpos, EMACS_INT count, int init,
i = interval_of (charpos, object);
gl_state.backward_i = gl_state.forward_i = i;
invalidate = 0;
- if (NULL_INTERVAL_P (i))
+ if (!i)
return;
/* interval_of updates only ->position of the return value, so
update the parents manually to speed up update_interval. */
@@ -218,7 +223,7 @@ update_syntax_table (EMACS_INT charpos, EMACS_INT count, int init,
/* We are guaranteed to be called with CHARPOS either in i,
or further off. */
- if (NULL_INTERVAL_P (i))
+ if (!i)
error ("Error in syntax_table logic for to-the-end intervals");
else if (charpos < i->position) /* Move left. */
{
@@ -288,7 +293,7 @@ update_syntax_table (EMACS_INT charpos, EMACS_INT count, int init,
}
}
- while (!NULL_INTERVAL_P (i))
+ while (i)
{
if (cnt && !EQ (tmp_table, textget (i->plist, Qsyntax_table)))
{
@@ -314,7 +319,7 @@ update_syntax_table (EMACS_INT charpos, EMACS_INT count, int init,
/* e_property at EOB is not set to ZV but to ZV+1, so that
we can do INC(from);UPDATE_SYNTAX_TABLE_FORWARD without
having to check eob between the two. */
- + (NULL_INTERVAL_P (next_interval (i)) ? 1 : 0);
+ + (next_interval (i) ? 0 : 1);
gl_state.forward_i = i;
}
else
@@ -327,7 +332,7 @@ update_syntax_table (EMACS_INT charpos, EMACS_INT count, int init,
cnt++;
i = count > 0 ? next_interval (i) : previous_interval (i);
}
- eassert (NULL_INTERVAL_P (i)); /* This property goes to the end. */
+ eassert (i == NULL); /* This property goes to the end. */
if (count > 0)
gl_state.e_property = gl_state.stop;
else
@@ -339,12 +344,12 @@ update_syntax_table (EMACS_INT charpos, EMACS_INT count, int init,
or after. On return global syntax data is good for lookup at CHARPOS. */
static int
-char_quoted (EMACS_INT charpos, EMACS_INT bytepos)
+char_quoted (ptrdiff_t charpos, ptrdiff_t bytepos)
{
register enum syntaxcode code;
- register EMACS_INT beg = BEGV;
+ register ptrdiff_t beg = BEGV;
register int quoted = 0;
- EMACS_INT orig = charpos;
+ ptrdiff_t orig = charpos;
while (charpos > beg)
{
@@ -367,8 +372,8 @@ char_quoted (EMACS_INT charpos, EMACS_INT bytepos)
/* Return the bytepos one character before BYTEPOS.
We assume that BYTEPOS is not at the start of the buffer. */
-static inline EMACS_INT
-dec_bytepos (EMACS_INT bytepos)
+static ptrdiff_t
+dec_bytepos (ptrdiff_t bytepos)
{
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
return bytepos - 1;
@@ -391,10 +396,10 @@ dec_bytepos (EMACS_INT bytepos)
valid on return from the subroutine, so the caller should explicitly
update the global data. */
-static EMACS_INT
-find_defun_start (EMACS_INT pos, EMACS_INT pos_byte)
+static ptrdiff_t
+find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte)
{
- EMACS_INT opoint = PT, opoint_byte = PT_BYTE;
+ ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
if (!open_paren_in_column_0_is_defun_start)
{
@@ -461,7 +466,7 @@ find_defun_start (EMACS_INT pos, EMACS_INT pos_byte)
/* Return the SYNTAX_COMEND_FIRST of the character before POS, POS_BYTE. */
static int
-prev_char_comend_first (EMACS_INT pos, EMACS_INT pos_byte)
+prev_char_comend_first (ptrdiff_t pos, ptrdiff_t pos_byte)
{
int c, val;
@@ -503,7 +508,7 @@ prev_char_comend_first (EMACS_INT pos, EMACS_INT pos_byte)
the returned value (or at FROM, if the search was not successful). */
static int
-back_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, int comnested, int comstyle, EMACS_INT *charpos_ptr, EMACS_INT *bytepos_ptr)
+back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, int comnested, int comstyle, ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr)
{
/* Look back, counting the parity of string-quotes,
and recording the comment-starters seen.
@@ -522,14 +527,14 @@ back_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, int comnested
inside another comment).
Test case: { a (* b } c (* d *) */
int comment_lossage = 0;
- EMACS_INT comment_end = from;
- EMACS_INT comment_end_byte = from_byte;
- EMACS_INT comstart_pos = 0;
- EMACS_INT comstart_byte IF_LINT (= 0);
+ ptrdiff_t comment_end = from;
+ ptrdiff_t comment_end_byte = from_byte;
+ ptrdiff_t comstart_pos = 0;
+ ptrdiff_t comstart_byte IF_LINT (= 0);
/* Place where the containing defun starts,
or 0 if we didn't come across it yet. */
- EMACS_INT defun_start = 0;
- EMACS_INT defun_start_byte = 0;
+ ptrdiff_t defun_start = 0;
+ ptrdiff_t defun_start_byte = 0;
register enum syntaxcode code;
int nesting = 1; /* current comment nesting */
int c;
@@ -543,7 +548,7 @@ back_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, int comnested
that determines quote parity to the comment-end. */
while (from != stop)
{
- EMACS_INT temp_byte;
+ ptrdiff_t temp_byte;
int prev_syntax, com2start, com2end;
int comstart;
@@ -581,7 +586,7 @@ back_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, int comnested
have %..\n and %{..}%. */
if (from > stop && (com2end || comstart))
{
- EMACS_INT next = from, next_byte = from_byte;
+ ptrdiff_t next = from, next_byte = from_byte;
int next_c, next_syntax;
DEC_BOTH (next, next_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (next);
@@ -737,7 +742,8 @@ back_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, int comnested
{
scan_sexps_forward (&state,
defun_start, defun_start_byte,
- comment_end, -10000, 0, Qnil, 0);
+ comment_end, TYPE_MINIMUM (EMACS_INT),
+ 0, Qnil, 0);
defun_start = comment_end;
if (state.incomment == (comnested ? 1 : -1)
&& state.comstyle == comstyle)
@@ -819,7 +825,7 @@ It is a copy of the TABLE, which defaults to the standard syntax table. */)
/* Only the standard syntax table should have a default element.
Other syntax tables should inherit from parents instead. */
- XCHAR_TABLE (copy)->defalt = Qnil;
+ set_char_table_defalt (copy, Qnil);
/* Copied syntax tables should all have parents.
If we copied one with no parent, such as the standard syntax table,
@@ -836,7 +842,7 @@ One argument, a syntax table. */)
{
int idx;
check_syntax_table (table);
- BVAR (current_buffer, syntax_table) = table;
+ bset_syntax_table (current_buffer, table);
/* Indicate that this buffer now has a specified syntax table. */
idx = PER_BUFFER_VAR_IDX (syntax_table);
SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1);
@@ -915,11 +921,11 @@ DEFUN ("matching-paren", Fmatching_paren, Smatching_paren, 1, 1, 0,
}
DEFUN ("string-to-syntax", Fstring_to_syntax, Sstring_to_syntax, 1, 1, 0,
- doc: /* Convert a syntax specification STRING into syntax cell form.
-STRING should be a string as it is allowed as argument of
-`modify-syntax-entry'. Value is the equivalent cons cell
-\(CODE . MATCHING-CHAR) that can be used as value of a `syntax-table'
-text property. */)
+ doc: /* Convert a syntax descriptor STRING into a raw syntax descriptor.
+STRING should be a string of the form allowed as argument of
+`modify-syntax-entry'. The return value is a raw syntax descriptor: a
+cons cell \(CODE . MATCHING-CHAR) which can be used, for example, as
+the value of a `syntax-table' text property. */)
(Lisp_Object string)
{
register const unsigned char *p;
@@ -987,7 +993,7 @@ text property. */)
}
if (val < ASIZE (Vsyntax_code_object) && NILP (match))
- return XVECTOR (Vsyntax_code_object)->contents[val];
+ return AREF (Vsyntax_code_object, val);
else
/* Since we can't use a shared object, let's make a new one. */
return Fcons (make_number (val), match);
@@ -1009,7 +1015,7 @@ The first character of NEWENTRY should be one of the following:
" string quote. \\ escape.
$ paired delimiter. ' expression quote or prefix operator.
< comment starter. > comment ender.
- / character-quote. @ inherit from `standard-syntax-table'.
+ / character-quote. @ inherit from parent table.
| generic string fence. ! generic comment fence.
Only single-character comment start and end sequences are represented thus.
@@ -1099,13 +1105,13 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
first = XCAR (value);
match_lisp = XCDR (value);
- if (!INTEGERP (first) || !(NILP (match_lisp) || INTEGERP (match_lisp)))
+ if (!INTEGERP (first) || !(NILP (match_lisp) || CHARACTERP (match_lisp)))
{
insert_string ("invalid");
return syntax;
}
- syntax_code = XINT (first);
+ syntax_code = XINT (first) & INT_MAX;
code = (enum syntaxcode) (syntax_code & 0377);
start1 = SYNTAX_FLAGS_COMSTART_FIRST (syntax_code);
start2 = SYNTAX_FLAGS_COMSTART_SECOND (syntax_code);;
@@ -1152,7 +1158,7 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
insert_string ("\twhich means: ");
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Swhitespace:
insert_string ("whitespace"); break;
@@ -1223,12 +1229,12 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
If that many words cannot be found before the end of the buffer, return 0.
COUNT negative means scan backward and stop at word beginning. */
-EMACS_INT
-scan_words (register EMACS_INT from, register EMACS_INT count)
+ptrdiff_t
+scan_words (register ptrdiff_t from, register EMACS_INT count)
{
- register EMACS_INT beg = BEGV;
- register EMACS_INT end = ZV;
- register EMACS_INT from_byte = CHAR_TO_BYTE (from);
+ register ptrdiff_t beg = BEGV;
+ register ptrdiff_t end = ZV;
+ register ptrdiff_t from_byte = CHAR_TO_BYTE (from);
register enum syntaxcode code;
int ch0, ch1;
Lisp_Object func, pos;
@@ -1263,7 +1269,7 @@ scan_words (register EMACS_INT from, register EMACS_INT count)
if (! NILP (Ffboundp (func)))
{
pos = call2 (func, make_number (from - 1), make_number (end));
- if (INTEGERP (pos) && XINT (pos) > from)
+ if (INTEGERP (pos) && from < XINT (pos) && XINT (pos) <= ZV)
{
from = XINT (pos);
from_byte = CHAR_TO_BYTE (from);
@@ -1313,7 +1319,7 @@ scan_words (register EMACS_INT from, register EMACS_INT count)
if (! NILP (Ffboundp (func)))
{
pos = call2 (func, make_number (from), make_number (beg));
- if (INTEGERP (pos) && XINT (pos) < from)
+ if (INTEGERP (pos) && BEGV <= XINT (pos) && XINT (pos) < from)
{
from = XINT (pos);
from_byte = CHAR_TO_BYTE (from);
@@ -1357,7 +1363,7 @@ and the function returns nil. Field boundaries are not noticed if
(Lisp_Object arg)
{
Lisp_Object tmp;
- int orig_val, val;
+ ptrdiff_t orig_val, val;
if (NILP (arg))
XSETFASTINT (arg, 1);
@@ -1432,14 +1438,14 @@ skip_chars (int forwardp, Lisp_Object string, Lisp_Object lim, int handle_iso_cl
int *char_ranges IF_LINT (= NULL);
int n_char_ranges = 0;
int negate = 0;
- register EMACS_INT i, i_byte;
+ register ptrdiff_t i, i_byte;
/* Set to 1 if the current buffer is multibyte and the region
contains non-ASCII chars. */
int multibyte;
/* Set to 1 if STRING is multibyte and it contains non-ASCII
chars. */
int string_multibyte;
- EMACS_INT size_byte;
+ ptrdiff_t size_byte;
const unsigned char *str;
int len;
Lisp_Object iso_classes;
@@ -1581,7 +1587,7 @@ skip_chars (int forwardp, Lisp_Object string, Lisp_Object lim, int handle_iso_cl
fastmap[CHAR_LEADING_CODE (c)] = 1;
range_start_byte = i;
range_start_char = c;
- char_ranges = (int *) alloca (sizeof (int) * 128 * 2);
+ char_ranges = alloca (sizeof *char_ranges * 128 * 2);
for (i = 129; i < 0400; i++)
{
c = BYTE8_TO_CHAR (i);
@@ -1602,7 +1608,7 @@ skip_chars (int forwardp, Lisp_Object string, Lisp_Object lim, int handle_iso_cl
}
else /* STRING is multibyte */
{
- char_ranges = (int *) alloca (sizeof (int) * SCHARS (string) * 2);
+ char_ranges = alloca (sizeof *char_ranges * SCHARS (string) * 2);
while (i_byte < size_byte)
{
@@ -1753,9 +1759,9 @@ skip_chars (int forwardp, Lisp_Object string, Lisp_Object lim, int handle_iso_cl
}
{
- EMACS_INT start_point = PT;
- EMACS_INT pos = PT;
- EMACS_INT pos_byte = PT_BYTE;
+ ptrdiff_t start_point = PT;
+ ptrdiff_t pos = PT;
+ ptrdiff_t pos_byte = PT_BYTE;
unsigned char *p = PT_ADDR, *endp, *stop;
if (forwardp)
@@ -1925,9 +1931,9 @@ skip_syntaxes (int forwardp, Lisp_Object string, Lisp_Object lim)
register unsigned int c;
unsigned char fastmap[0400];
int negate = 0;
- register EMACS_INT i, i_byte;
+ register ptrdiff_t i, i_byte;
int multibyte;
- EMACS_INT size_byte;
+ ptrdiff_t size_byte;
unsigned char *str;
CHECK_STRING (string);
@@ -1980,9 +1986,9 @@ skip_syntaxes (int forwardp, Lisp_Object string, Lisp_Object lim)
fastmap[i] ^= 1;
{
- EMACS_INT start_point = PT;
- EMACS_INT pos = PT;
- EMACS_INT pos_byte = PT_BYTE;
+ ptrdiff_t start_point = PT;
+ ptrdiff_t pos = PT;
+ ptrdiff_t pos_byte = PT_BYTE;
unsigned char *p = PT_ADDR, *endp, *stop;
if (forwardp)
@@ -2135,10 +2141,10 @@ in_classes (int c, Lisp_Object iso_classes)
remains valid for forward search starting at the returned position. */
static int
-forw_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop,
- int nesting, int style, int prev_syntax,
- EMACS_INT *charpos_ptr, EMACS_INT *bytepos_ptr,
- int *incomment_ptr)
+forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
+ EMACS_INT nesting, int style, int prev_syntax,
+ ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr,
+ EMACS_INT *incomment_ptr)
{
register int c, c1;
register enum syntaxcode code;
@@ -2240,17 +2246,17 @@ If COUNT comments are found as expected, with nothing except whitespace
between them, return t; otherwise return nil. */)
(Lisp_Object count)
{
- register EMACS_INT from;
- EMACS_INT from_byte;
- register EMACS_INT stop;
+ register ptrdiff_t from;
+ ptrdiff_t from_byte;
+ register ptrdiff_t stop;
register int c, c1;
register enum syntaxcode code;
int comstyle = 0; /* style of comment encountered */
int comnested = 0; /* whether the comment is nestable or not */
int found;
EMACS_INT count1;
- EMACS_INT out_charpos, out_bytepos;
- int dummy;
+ ptrdiff_t out_charpos, out_bytepos;
+ EMACS_INT dummy;
CHECK_NUMBER (count);
count1 = XINT (count);
@@ -2374,7 +2380,7 @@ between them, return t; otherwise return nil. */)
{
/* Skip until first preceding unquoted comment_fence. */
int fence_found = 0;
- EMACS_INT ini = from, ini_byte = from_byte;
+ ptrdiff_t ini = from, ini_byte = from_byte;
while (1)
{
@@ -2457,21 +2463,22 @@ static Lisp_Object
scan_lists (register EMACS_INT from, EMACS_INT count, EMACS_INT depth, int sexpflag)
{
Lisp_Object val;
- register EMACS_INT stop = count > 0 ? ZV : BEGV;
+ register ptrdiff_t stop = count > 0 ? ZV : BEGV;
register int c, c1;
int stringterm;
int quoted;
int mathexit = 0;
register enum syntaxcode code, temp_code;
- int min_depth = depth; /* Err out if depth gets less than this. */
+ EMACS_INT min_depth = depth; /* Err out if depth gets less than this. */
int comstyle = 0; /* style of comment encountered */
int comnested = 0; /* whether the comment is nestable or not */
- EMACS_INT temp_pos;
+ ptrdiff_t temp_pos;
EMACS_INT last_good = from;
int found;
- EMACS_INT from_byte;
- EMACS_INT out_bytepos, out_charpos;
- int temp, dummy;
+ ptrdiff_t from_byte;
+ ptrdiff_t out_bytepos, out_charpos;
+ int temp;
+ EMACS_INT dummy;
int multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol;
if (depth > 0) min_depth = 0;
@@ -2524,7 +2531,7 @@ scan_lists (register EMACS_INT from, EMACS_INT count, EMACS_INT depth, int sexpf
if (prefix)
continue;
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Sescape:
case Scharquote:
@@ -2701,7 +2708,7 @@ scan_lists (register EMACS_INT from, EMACS_INT count, EMACS_INT depth, int sexpf
else if (SYNTAX_FLAGS_PREFIX (syntax))
continue;
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Sword:
case Ssymbol:
@@ -2844,18 +2851,23 @@ scan_lists (register EMACS_INT from, EMACS_INT count, EMACS_INT depth, int sexpf
DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0,
doc: /* Scan from character number FROM by COUNT lists.
-Returns the character number of the position thus found.
+Scan forward if COUNT is positive, backward if COUNT is negative.
+Return the character number of the position thus found.
+
+A \"list", in this context, refers to a balanced parenthetical
+grouping, as determined by the syntax table.
-If DEPTH is nonzero, paren depth begins counting from that value,
-only places where the depth in parentheses becomes zero
-are candidates for stopping; COUNT such places are counted.
-Thus, a positive value for DEPTH means go out levels.
+If DEPTH is nonzero, treat that as the nesting depth of the starting
+point (i.e. the starting point is DEPTH parentheses deep). This
+function scans over parentheses until the depth goes to zero COUNT
+times. Hence, positive DEPTH moves out that number of levels of
+parentheses, while negative DEPTH moves to a deeper level.
Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
-If the beginning or end of (the accessible part of) the buffer is reached
-and the depth is wrong, an error is signaled.
-If the depth is right but the count is not used up, nil is returned. */)
+If we reach the beginning or end of the accessible part of the buffer
+before we have scanned over COUNT lists, return nil if the depth at
+that point is zero, and signal a error if the depth is nonzero. */)
(Lisp_Object from, Lisp_Object count, Lisp_Object depth)
{
CHECK_NUMBER (from);
@@ -2890,11 +2902,11 @@ DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars,
This includes chars with "quote" or "prefix" syntax (' or p). */)
(void)
{
- EMACS_INT beg = BEGV;
- EMACS_INT opoint = PT;
- EMACS_INT opoint_byte = PT_BYTE;
- EMACS_INT pos = PT;
- EMACS_INT pos_byte = PT_BYTE;
+ ptrdiff_t beg = BEGV;
+ ptrdiff_t opoint = PT;
+ ptrdiff_t opoint_byte = PT_BYTE;
+ ptrdiff_t pos = PT;
+ ptrdiff_t pos_byte = PT_BYTE;
int c;
if (pos <= beg)
@@ -2935,8 +2947,8 @@ This includes chars with "quote" or "prefix" syntax (' or p). */)
static void
scan_sexps_forward (struct lisp_parse_state *stateptr,
- EMACS_INT from, EMACS_INT from_byte, EMACS_INT end,
- int targetdepth, int stopbefore,
+ ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t end,
+ EMACS_INT targetdepth, int stopbefore,
Lisp_Object oldstate, int commentstop)
{
struct lisp_parse_state state;
@@ -2944,23 +2956,23 @@ scan_sexps_forward (struct lisp_parse_state *stateptr,
register enum syntaxcode code;
int c1;
int comnested;
- struct level { int last, prev; };
+ struct level { ptrdiff_t last, prev; };
struct level levelstart[100];
register struct level *curlevel = levelstart;
struct level *endlevel = levelstart + 100;
- register int depth; /* Paren depth of current scanning location.
+ register EMACS_INT depth; /* Paren depth of current scanning location.
level - levelstart equals this except
when the depth becomes negative. */
- int mindepth; /* Lowest DEPTH value seen. */
+ EMACS_INT mindepth; /* Lowest DEPTH value seen. */
int start_quoted = 0; /* Nonzero means starting after a char quote */
Lisp_Object tem;
- EMACS_INT prev_from; /* Keep one character before FROM. */
- EMACS_INT prev_from_byte;
+ ptrdiff_t prev_from; /* Keep one character before FROM. */
+ ptrdiff_t prev_from_byte;
int prev_from_syntax;
int boundary_stop = commentstop == -1;
int nofence;
int found;
- EMACS_INT out_bytepos, out_charpos;
+ ptrdiff_t out_bytepos, out_charpos;
int temp;
prev_from = from;
@@ -3004,7 +3016,7 @@ do { prev_from = from; \
tem = Fcar (oldstate);
/* Check whether we are inside string_fence-style string: */
state.instring = (!NILP (tem)
- ? (INTEGERP (tem) ? XINT (tem) : ST_STRING_STYLE)
+ ? (CHARACTERP (tem) ? XFASTINT (tem) : ST_STRING_STYLE)
: -1);
oldstate = Fcdr (oldstate);
@@ -3024,19 +3036,21 @@ do { prev_from = from; \
tem = Fcar (oldstate);
state.comstyle = (NILP (tem)
? 0
- : (EQ (tem, Qsyntax_table)
- ? ST_COMMENT_STYLE
- : INTEGERP (tem) ? XINT (tem) : 1));
+ : (RANGED_INTEGERP (0, tem, ST_COMMENT_STYLE)
+ ? XINT (tem)
+ : ST_COMMENT_STYLE));
oldstate = Fcdr (oldstate);
tem = Fcar (oldstate);
- state.comstr_start = NILP (tem) ? -1 : XINT (tem) ;
+ state.comstr_start =
+ RANGED_INTEGERP (PTRDIFF_MIN, tem, PTRDIFF_MAX) ? XINT (tem) : -1;
oldstate = Fcdr (oldstate);
tem = Fcar (oldstate);
while (!NILP (tem)) /* >= second enclosing sexps. */
{
- /* curlevel++->last ran into compiler bug on Apollo */
- curlevel->last = XINT (Fcar (tem));
+ Lisp_Object temhd = Fcar (tem);
+ if (RANGED_INTEGERP (PTRDIFF_MIN, temhd, PTRDIFF_MAX))
+ curlevel->last = XINT (temhd);
if (++curlevel == endlevel)
curlevel--; /* error ("Nesting too deep for parser"); */
curlevel->prev = -1;
@@ -3115,7 +3129,7 @@ do { prev_from = from; \
if (SYNTAX_FLAGS_PREFIX (prev_from_syntax))
continue;
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Sescape:
case Scharquote:
@@ -3309,14 +3323,14 @@ Fourth arg STOPBEFORE non-nil means stop when come to
any character that starts a sexp.
Fifth arg OLDSTATE is a list like what this function returns.
It is used to initialize the state of the parse. Elements number 1, 2, 6
- and 8 are ignored.
+ are ignored.
Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.
If it is symbol `syntax-table', stop after the start of a comment or a
string, or after end of a comment or a string. */)
(Lisp_Object from, Lisp_Object to, Lisp_Object targetdepth, Lisp_Object stopbefore, Lisp_Object oldstate, Lisp_Object commentstop)
{
struct lisp_parse_state state;
- int target;
+ EMACS_INT target;
if (!NILP (targetdepth))
{
@@ -3324,7 +3338,7 @@ Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.
target = XINT (targetdepth);
}
else
- target = -100000; /* We won't reach this depth */
+ target = TYPE_MINIMUM (EMACS_INT); /* We won't reach this depth */
validate_region (&from, &to);
scan_sexps_forward (&state, XINT (from), CHAR_TO_BYTE (XINT (from)),
@@ -3377,32 +3391,31 @@ init_syntax_once (void)
/* Create objects which can be shared among syntax tables. */
Vsyntax_code_object = Fmake_vector (make_number (Smax), Qnil);
for (i = 0; i < ASIZE (Vsyntax_code_object); i++)
- XVECTOR (Vsyntax_code_object)->contents[i]
- = Fcons (make_number (i), Qnil);
+ ASET (Vsyntax_code_object, i, Fcons (make_number (i), Qnil));
/* Now we are ready to set up this property, so we can
create syntax tables. */
Fput (Qsyntax_table, Qchar_table_extra_slots, make_number (0));
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Swhitespace];
+ temp = AREF (Vsyntax_code_object, (int) Swhitespace);
Vstandard_syntax_table = Fmake_char_table (Qsyntax_table, temp);
/* Control characters should not be whitespace. */
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Spunct];
+ temp = AREF (Vsyntax_code_object, (int) Spunct);
for (i = 0; i <= ' ' - 1; i++)
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 0177, temp);
/* Except that a few really are whitespace. */
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Swhitespace];
+ temp = AREF (Vsyntax_code_object, (int) Swhitespace);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ' ', temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\t', temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\n', temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 015, temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 014, temp);
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Sword];
+ temp = AREF (Vsyntax_code_object, (int) Sword);
for (i = 'a'; i <= 'z'; i++)
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
for (i = 'A'; i <= 'Z'; i++)
@@ -3430,14 +3443,14 @@ init_syntax_once (void)
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\\',
Fcons (make_number ((int) Sescape), Qnil));
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Ssymbol];
+ temp = AREF (Vsyntax_code_object, (int) Ssymbol);
for (i = 0; i < 10; i++)
{
c = "_-+*/&|<>="[i];
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, c, temp);
}
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Spunct];
+ temp = AREF (Vsyntax_code_object, (int) Spunct);
for (i = 0; i < 12; i++)
{
c = ".,;:?!#@~^'`"[i];
@@ -3445,7 +3458,7 @@ init_syntax_once (void)
}
/* All multibyte characters have syntax `word' by default. */
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Sword];
+ temp = AREF (Vsyntax_code_object, (int) Sword);
char_table_set_range (Vstandard_syntax_table, 0x80, MAX_CHAR, temp);
}
@@ -3466,9 +3479,9 @@ syms_of_syntax (void)
DEFSYM (Qscan_error, "scan-error");
Fput (Qscan_error, Qerror_conditions,
- pure_cons (Qscan_error, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qscan_error, Qerror));
Fput (Qscan_error, Qerror_message,
- make_pure_c_string ("Scan error"));
+ build_pure_c_string ("Scan error"));
DEFVAR_BOOL ("parse-sexp-ignore-comments", parse_sexp_ignore_comments,
doc: /* Non-nil means `forward-sexp', etc., should treat comments as whitespace. */);
@@ -3489,7 +3502,7 @@ See the info node `(elisp)Syntax Properties' for a description of the
DEFVAR_BOOL ("open-paren-in-column-0-is-defun-start",
open_paren_in_column_0_is_defun_start,
- doc: /* *Non-nil means an open paren in column 0 denotes the start of a defun. */);
+ doc: /* Non-nil means an open paren in column 0 denotes the start of a defun. */);
open_paren_in_column_0_is_defun_start = 1;
diff --git a/src/syntax.h b/src/syntax.h
index 42d689cb96c..6edb1585795 100644
--- a/src/syntax.h
+++ b/src/syntax.h
@@ -1,6 +1,6 @@
/* Declarations having to do with GNU Emacs syntax tables.
-Copyright (C) 1985, 1993-1994, 1997-1998, 2001-2011
+Copyright (C) 1985, 1993-1994, 1997-1998, 2001-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,7 +19,7 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-extern void update_syntax_table (EMACS_INT, EMACS_INT, int, Lisp_Object);
+extern void update_syntax_table (ptrdiff_t, EMACS_INT, int, Lisp_Object);
/* The standard syntax table is stored where it will automatically
be used in all new buffers. */
@@ -258,7 +258,7 @@ do \
else if (EQ (gl_state.object, Qt)) \
{ \
gl_state.b_property = 0; \
- gl_state.e_property = MOST_POSITIVE_FIXNUM; \
+ gl_state.e_property = PTRDIFF_MAX; \
gl_state.offset = 0; \
} \
else \
@@ -277,15 +277,15 @@ while (0)
struct gl_state_s
{
Lisp_Object object; /* The object we are scanning. */
- EMACS_INT start; /* Where to stop. */
- EMACS_INT stop; /* Where to stop. */
+ ptrdiff_t start; /* Where to stop. */
+ ptrdiff_t stop; /* Where to stop. */
int use_global; /* Whether to use global_code
or c_s_t. */
Lisp_Object global_code; /* Syntax code of current char. */
Lisp_Object current_syntax_table; /* Syntax table for current pos. */
Lisp_Object old_prop; /* Syntax-table prop at prev pos. */
- EMACS_INT b_property; /* First index where c_s_t is valid. */
- EMACS_INT e_property; /* First index where c_s_t is
+ ptrdiff_t b_property; /* First index where c_s_t is valid. */
+ ptrdiff_t e_property; /* First index where c_s_t is
not valid. */
INTERVAL forward_i; /* Where to start lookup on forward */
INTERVAL backward_i; /* or backward movement. The
@@ -295,8 +295,8 @@ struct gl_state_s
intervals too, depending
on: */
/* Offset for positions specified to UPDATE_SYNTAX_TABLE. */
- EMACS_INT offset;
+ ptrdiff_t offset;
};
extern struct gl_state_s gl_state;
-extern EMACS_INT scan_words (EMACS_INT, EMACS_INT);
+extern ptrdiff_t scan_words (ptrdiff_t, EMACS_INT);
diff --git a/src/sysdep.c b/src/sysdep.c
index b111fa1324c..bc4dc91509f 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -1,5 +1,5 @@
/* Interfaces to system-dependent kernel and library entries.
- Copyright (C) 1985-1988, 1993-1995, 1999-2011
+ Copyright (C) 1985-1988, 1993-1995, 1999-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -18,10 +18,11 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <ctype.h>
-#include <signal.h>
+
+#define SYSTIME_INLINE EXTERN_INLINE
+
+#include <execinfo.h>
#include <stdio.h>
-#include <setjmp.h>
#ifdef HAVE_PWD_H
#include <pwd.h>
#include <grp.h>
@@ -30,41 +31,45 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <unistd.h>
#include <allocator.h>
+#include <c-ctype.h>
#include <careadlinkat.h>
#include <ignore-value.h>
+#include <utimens.h>
#include "lisp.h"
#include "sysselect.h"
#include "blockinput.h"
+#ifdef BSD_SYSTEM
+#include <sys/param.h>
+#include <sys/sysctl.h>
+#endif
+
+#ifdef __FreeBSD__
+#include <sys/user.h>
+#include <sys/resource.h>
+#include <math.h>
+#endif
+
#ifdef WINDOWSNT
#define read sys_read
#define write sys_write
-#include <windows.h>
-#ifndef NULL
-#define NULL 0
+#ifndef STDERR_FILENO
+#define STDERR_FILENO fileno(GetStdHandle(STD_ERROR_HANDLE))
#endif
+#include <windows.h>
#endif /* not WINDOWSNT */
#include <sys/types.h>
#include <sys/stat.h>
#include <errno.h>
-#ifdef HAVE_SETPGID
-#if !defined (USG)
-#undef setpgrp
-#define setpgrp setpgid
-#endif
-#endif
-
/* Get SI_SRPC_DOMAIN, if it is available. */
#ifdef HAVE_SYS_SYSTEMINFO_H
#include <sys/systeminfo.h>
#endif
#ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida, MW Aug 1993 */
-#include <dos.h>
-#include "dosfns.h"
#include "msdos.h"
#include <sys/param.h>
#endif
@@ -96,30 +101,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define _P_WAIT 0
int _cdecl _spawnlp (int, const char *, const char *, ...);
int _cdecl _getpid (void);
-extern char *getwd (char *);
#endif
#include "syssignal.h"
#include "systime.h"
-#ifdef HAVE_UTIME_H
-#include <utime.h>
-#endif
-
-#ifndef HAVE_UTIMES
-#ifndef HAVE_STRUCT_UTIMBUF
-/* We want to use utime rather than utimes, but we couldn't find the
- structure declaration. We'll use the traditional one. */
-struct utimbuf {
- long actime;
- long modtime;
-};
-#endif
-#endif
static int emacs_get_tty (int, struct emacs_tty *);
static int emacs_set_tty (int, struct emacs_tty *, int);
-#if defined TIOCNOTTY || defined USG5 || defined CYGWIN
-static void croak (char *) NO_RETURN;
+
+/* ULLONG_MAX is missing on Red Hat Linux 7.3; see Bug#11781. */
+#ifndef ULLONG_MAX
+#define ULLONG_MAX TYPE_MAXIMUM (unsigned long long int)
#endif
/* Declare here, including term.h is problematic on some systems. */
@@ -141,12 +133,12 @@ char*
get_current_dir_name (void)
{
char *buf;
- char *pwd;
+ char *pwd = getenv ("PWD");
struct stat dotstat, pwdstat;
- /* If PWD is accurate, use it instead of calling getwd. PWD is
+ /* If PWD is accurate, use it instead of calling getcwd. PWD is
sometimes a nicer name, and using it may avoid a fatal error if a
parent directory is searchable but not readable. */
- if ((pwd = getenv ("PWD")) != 0
+ if (pwd
&& (IS_DIRECTORY_SEP (*pwd) || (*pwd && IS_DEVICE_SEP (pwd[1])))
&& stat (pwd, &pwdstat) == 0
&& stat (".", &dotstat) == 0
@@ -157,16 +149,15 @@ get_current_dir_name (void)
#endif
)
{
- buf = (char *) malloc (strlen (pwd) + 1);
+ buf = malloc (strlen (pwd) + 1);
if (!buf)
return NULL;
strcpy (buf, pwd);
}
-#ifdef HAVE_GETCWD
else
{
size_t buf_size = 1024;
- buf = (char *) malloc (buf_size);
+ buf = malloc (buf_size);
if (!buf)
return NULL;
for (;;)
@@ -181,27 +172,11 @@ get_current_dir_name (void)
return NULL;
}
buf_size *= 2;
- buf = (char *) realloc (buf, buf_size);
+ buf = realloc (buf, buf_size);
if (!buf)
return NULL;
}
}
-#else
- else
- {
- /* We need MAXPATHLEN here. */
- buf = (char *) malloc (MAXPATHLEN + 1);
- if (!buf)
- return NULL;
- if (getwd (buf) == NULL)
- {
- int tmp_errno = errno;
- free (buf);
- errno = tmp_errno;
- return NULL;
- }
- }
-#endif
return buf;
}
#endif
@@ -289,52 +264,28 @@ init_baud_rate (int fd)
-/* Set nonzero to make following function work under dbx
- (at least for bsd). */
-int wait_debugging EXTERNALLY_VISIBLE;
-
#ifndef MSDOS
static void
-wait_for_termination_1 (int pid, int interruptible)
+wait_for_termination_1 (pid_t pid, int interruptible)
{
while (1)
{
-#if (defined (BSD_SYSTEM) || defined (HPUX)) && !defined (__GNU__)
- /* Note that kill returns -1 even if the process is just a zombie now.
- But inevitably a SIGCHLD interrupt should be generated
- and child_sig will do wait3 and make the process go away. */
- /* There is some indication that there is a bug involved with
- termination of subprocesses, perhaps involving a kernel bug too,
- but no idea what it is. Just as a hunch we signal SIGCHLD to see
- if that causes the problem to go away or get worse. */
- sigsetmask (sigmask (SIGCHLD));
- if (0 > kill (pid, 0))
+ int status;
+ int wait_result = waitpid (pid, &status, 0);
+ if (wait_result < 0)
{
- sigsetmask (SIGEMPTYMASK);
- kill (getpid (), SIGCHLD);
- break;
+ if (errno != EINTR)
+ break;
}
- if (wait_debugging)
- sleep (1);
else
- sigpause (SIGEMPTYMASK);
-#else /* not BSD_SYSTEM, and not HPUX version >= 6 */
-#ifdef WINDOWSNT
- wait (0);
- break;
-#else /* not WINDOWSNT */
- sigblock (sigmask (SIGCHLD));
- errno = 0;
- if (kill (pid, 0) == -1 && errno == ESRCH)
{
- sigunblock (sigmask (SIGCHLD));
+ record_child_status_change (wait_result, status);
break;
}
- sigsuspend (&empty_mask);
-#endif /* not WINDOWSNT */
-#endif /* not BSD_SYSTEM, and not HPUX version >= 6 */
+ /* Note: the MS-Windows emulation of waitpid calls QUIT
+ internally. */
if (interruptible)
QUIT;
}
@@ -344,14 +295,14 @@ wait_for_termination_1 (int pid, int interruptible)
make sure it will get eliminated (not remain forever as a zombie) */
void
-wait_for_termination (int pid)
+wait_for_termination (pid_t pid)
{
wait_for_termination_1 (pid, 0);
}
/* Like the above, but allow keyboard interruption. */
void
-interruptible_wait_for_termination (int pid)
+interruptible_wait_for_termination (pid_t pid)
{
wait_for_termination_1 (pid, 1);
}
@@ -462,11 +413,11 @@ child_setup_tty (int out)
#endif /* not MSDOS */
-/* Record a signal code and the handler for it. */
+/* Record a signal code and the action for it. */
struct save_signal
{
int code;
- void (*handler) (int);
+ struct sigaction action;
};
static void save_signal_handlers (struct save_signal *);
@@ -480,7 +431,7 @@ sys_suspend (void)
#if defined (SIGTSTP) && !defined (MSDOS)
{
- int pgrp = EMACS_GETPGRP (0);
+ pid_t pgrp = getpgrp ();
EMACS_KILLPG (pgrp, SIGTSTP);
}
@@ -512,7 +463,7 @@ sys_subshell (void)
saved_handlers[0].code = SIGINT;
saved_handlers[1].code = SIGQUIT;
saved_handlers[2].code = SIGTERM;
-#ifdef SIGIO
+#ifdef USABLE_SIGIO
saved_handlers[3].code = SIGIO;
saved_handlers[4].code = 0;
#else
@@ -530,7 +481,7 @@ sys_subshell (void)
goto xyzzy;
dir = expand_and_dir_to_file (Funhandled_file_name_directory (dir), Qnil);
- str_volatile = str = (unsigned char *) alloca (SCHARS (dir) + 2);
+ str_volatile = str = alloca (SCHARS (dir) + 2);
len = SCHARS (dir);
memcpy (str, SDATA (dir), len);
if (str[len - 1] != '/') str[len++] = '/';
@@ -552,7 +503,7 @@ sys_subshell (void)
const char *sh = 0;
#ifdef DOS_NT /* MW, Aug 1993 */
- getwd (oldwd);
+ getcwd (oldwd, sizeof oldwd);
if (sh == 0)
sh = (char *) egetenv ("SUSPEND"); /* KFS, 1994-12-14 */
#endif
@@ -624,8 +575,9 @@ save_signal_handlers (struct save_signal *saved_handlers)
{
while (saved_handlers->code)
{
- saved_handlers->handler
- = (void (*) (int)) signal (saved_handlers->code, SIG_IGN);
+ struct sigaction action;
+ emacs_sigaction_init (&action, SIG_IGN);
+ sigaction (saved_handlers->code, &action, &saved_handlers->action);
saved_handlers++;
}
}
@@ -635,118 +587,149 @@ restore_signal_handlers (struct save_signal *saved_handlers)
{
while (saved_handlers->code)
{
- signal (saved_handlers->code, saved_handlers->handler);
+ sigaction (saved_handlers->code, &saved_handlers->action, 0);
saved_handlers++;
}
}
-#ifndef SIGIO
-/* If SIGIO is broken, don't do anything. */
-void
-init_sigio (int fd)
-{
-}
-
-static void
-reset_sigio (int fd)
-{
-}
-
-void
-request_sigio (void)
-{
-}
-
-void
-unrequest_sigio (void)
-{
-}
-
-#else
-#ifdef F_SETFL
-
+#ifdef USABLE_SIGIO
static int old_fcntl_flags[MAXDESC];
+#endif
void
init_sigio (int fd)
{
-#ifdef FASYNC
+#ifdef USABLE_SIGIO
old_fcntl_flags[fd] = fcntl (fd, F_GETFL, 0) & ~FASYNC;
fcntl (fd, F_SETFL, old_fcntl_flags[fd] | FASYNC);
-#endif
interrupts_deferred = 0;
+#endif
}
static void
reset_sigio (int fd)
{
-#ifdef FASYNC
+#ifdef USABLE_SIGIO
fcntl (fd, F_SETFL, old_fcntl_flags[fd]);
#endif
}
-#ifdef FASYNC /* F_SETFL does not imply existence of FASYNC */
-/* XXX Uhm, FASYNC is not used anymore here. */
-/* XXX Yeah, but you need it for SIGIO, don't you? */
-
void
request_sigio (void)
{
+#ifdef USABLE_SIGIO
+ sigset_t unblocked;
+
if (noninteractive)
return;
-#ifdef SIGWINCH
- sigunblock (sigmask (SIGWINCH));
-#endif
- sigunblock (sigmask (SIGIO));
+ sigemptyset (&unblocked);
+# ifdef SIGWINCH
+ sigaddset (&unblocked, SIGWINCH);
+# endif
+ sigaddset (&unblocked, SIGIO);
+ pthread_sigmask (SIG_UNBLOCK, &unblocked, 0);
interrupts_deferred = 0;
+#endif
}
void
unrequest_sigio (void)
{
+#ifdef USABLE_SIGIO
+ sigset_t blocked;
+
if (noninteractive)
return;
-#if 0 /* XXX What's wrong with blocking SIGIO under X? */
- if (x_display_list)
- return;
+ sigemptyset (&blocked);
+# ifdef SIGWINCH
+ sigaddset (&blocked, SIGWINCH);
+# endif
+ sigaddset (&blocked, SIGIO);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
+ interrupts_deferred = 1;
#endif
+}
-#ifdef SIGWINCH
- sigblock (sigmask (SIGWINCH));
+void
+ignore_sigio (void)
+{
+#ifdef USABLE_SIGIO
+ signal (SIGIO, SIG_IGN);
#endif
- sigblock (sigmask (SIGIO));
- interrupts_deferred = 1;
}
-#else /* no FASYNC */
-#ifndef MSDOS
+
+/* Saving and restoring the process group of Emacs's terminal. */
-void
-request_sigio (void)
-{
- if (noninteractive || read_socket_hook)
- return;
+/* The process group of which Emacs was a member when it initially
+ started.
- croak ("request_sigio");
-}
+ If Emacs was in its own process group (i.e. inherited_pgroup ==
+ getpid ()), then we know we're running under a shell with job
+ control (Emacs would never be run as part of a pipeline).
+ Everything is fine.
+
+ If Emacs was not in its own process group, then we know we're
+ running under a shell (or a caller) that doesn't know how to
+ separate itself from Emacs (like sh). Emacs must be in its own
+ process group in order to receive SIGIO correctly. In this
+ situation, we put ourselves in our own pgroup, forcibly set the
+ tty's pgroup to our pgroup, and make sure to restore and reinstate
+ the tty's pgroup just like any other terminal setting. If
+ inherited_group was not the tty's pgroup, then we'll get a
+ SIGTTmumble when we try to change the tty's pgroup, and a CONT if
+ it goes foreground in the future, which is what should happen. */
+
+static pid_t inherited_pgroup;
void
-unrequest_sigio (void)
+init_foreground_group (void)
{
- if (noninteractive || read_socket_hook)
- return;
+ pid_t pgrp = getpgrp ();
+ inherited_pgroup = getpid () == pgrp ? 0 : pgrp;
+}
+
+/* Safely set a controlling terminal FD's process group to PGID.
+ If we are not in the foreground already, POSIX requires tcsetpgrp
+ to deliver a SIGTTOU signal, which would stop us. This is an
+ annoyance, so temporarily ignore the signal.
- croak ("unrequest_sigio");
+ In practice, platforms lacking SIGTTOU also lack tcsetpgrp, so
+ skip all this unless SIGTTOU is defined. */
+static void
+tcsetpgrp_without_stopping (int fd, pid_t pgid)
+{
+#ifdef SIGTTOU
+ signal_handler_t handler;
+ block_input ();
+ handler = signal (SIGTTOU, SIG_IGN);
+ tcsetpgrp (fd, pgid);
+ signal (SIGTTOU, handler);
+ unblock_input ();
+#endif
}
-#endif /* MSDOS */
-#endif /* FASYNC */
-#endif /* F_SETFL */
-#endif /* SIGIO */
+/* Split off the foreground process group to Emacs alone. When we are
+ in the foreground, but not started in our own process group,
+ redirect the tty device handle FD to point to our own process
+ group. FD must be the file descriptor of the controlling tty. */
+static void
+narrow_foreground_group (int fd)
+{
+ if (inherited_pgroup && setpgid (0, 0) == 0)
+ tcsetpgrp_without_stopping (fd, getpid ());
+}
+/* Set the tty to our original foreground group. */
+static void
+widen_foreground_group (int fd)
+{
+ if (inherited_pgroup && setpgid (0, inherited_pgroup) == 0)
+ tcsetpgrp_without_stopping (fd, inherited_pgroup);
+}
/* Getting and setting emacs_tty structures. */
@@ -864,8 +847,10 @@ init_sys_modes (struct tty_display_info *tty_out)
if (!tty_out->output)
return; /* The tty is suspended. */
+ narrow_foreground_group (fileno (tty_out->input));
+
if (! tty_out->old_tty)
- tty_out->old_tty = (struct emacs_tty *) xmalloc (sizeof (struct emacs_tty));
+ tty_out->old_tty = xmalloc (sizeof *tty_out->old_tty);
emacs_get_tty (fileno (tty_out->input), tty_out->old_tty);
@@ -1033,8 +1018,7 @@ init_sys_modes (struct tty_display_info *tty_out)
#endif
#endif
-#ifdef F_SETFL
-#ifdef F_GETOWN /* F_SETFL does not imply existence of F_GETOWN */
+#ifdef F_GETOWN
if (interrupt_input)
{
old_fcntl_owner[fileno (tty_out->input)] =
@@ -1052,7 +1036,6 @@ init_sys_modes (struct tty_display_info *tty_out)
#endif /* HAVE_GPM */
}
#endif /* F_GETOWN */
-#endif /* F_SETFL */
#ifdef _IOFBF
/* This symbol is defined on recent USG systems.
@@ -1272,8 +1255,8 @@ reset_sys_modes (struct tty_display_info *tty_out)
fsync (fileno (tty_out->output));
#endif
-#ifdef F_SETFL
-#ifdef F_SETOWN /* F_SETFL does not imply existence of F_SETOWN */
+#ifndef DOS_NT
+#ifdef F_SETOWN
if (interrupt_input)
{
reset_sigio (fileno (tty_out->input));
@@ -1281,11 +1264,9 @@ reset_sys_modes (struct tty_display_info *tty_out)
old_fcntl_owner[fileno (tty_out->input)]);
}
#endif /* F_SETOWN */
-#ifdef O_NDELAY
fcntl (fileno (tty_out->input), F_SETFL,
- fcntl (fileno (tty_out->input), F_GETFL, 0) & ~O_NDELAY);
+ fcntl (fileno (tty_out->input), F_GETFL, 0) & ~O_NONBLOCK);
#endif
-#endif /* F_SETFL */
if (tty_out->old_tty)
while (emacs_set_tty (fileno (tty_out->input),
@@ -1296,6 +1277,7 @@ reset_sys_modes (struct tty_display_info *tty_out)
dos_ttcooked ();
#endif
+ widen_foreground_group (fileno (tty_out->input));
}
#ifdef HAVE_PTYS
@@ -1359,7 +1341,7 @@ init_system_name (void)
Vsystem_name = build_string (uts.nodename);
#else /* HAVE_GETHOSTNAME */
unsigned int hostname_size = 256;
- char *hostname = (char *) alloca (hostname_size);
+ char *hostname = alloca (hostname_size);
/* Try to get the host name; if the buffer is too short, try
again. Apparently, the only indication gethostname gives of
@@ -1375,7 +1357,7 @@ init_system_name (void)
break;
hostname_size <<= 1;
- hostname = (char *) alloca (hostname_size);
+ hostname = alloca (hostname_size);
}
#ifdef HAVE_SOCKETS
/* Turn the hostname into the official, fully-qualified hostname.
@@ -1476,105 +1458,218 @@ init_system_name (void)
}
}
-/* POSIX signals support - DJB */
-/* Anyone with POSIX signals should have ANSI C declarations */
-
sigset_t empty_mask;
-#ifndef WINDOWSNT
+static struct sigaction process_fatal_action;
-signal_handler_t
-sys_signal (int signal_number, signal_handler_t action)
-{
- struct sigaction new_action, old_action;
- sigemptyset (&new_action.sa_mask);
- new_action.sa_handler = action;
- new_action.sa_flags = 0;
-#if defined (SA_RESTART)
- /* Emacs mostly works better with restartable system services. If this
- flag exists, we probably want to turn it on here.
- However, on some systems this resets the timeout of `select'
- which means that `select' never finishes if it keeps getting signals.
- BROKEN_SA_RESTART is defined on those systems. */
- /* It's not clear why the comment above says "mostly works better". --Stef
- When SYNC_INPUT is set, we don't want SA_RESTART because we need to poll
+static int
+emacs_sigaction_flags (void)
+{
+#ifdef SA_RESTART
+ /* SA_RESTART causes interruptible functions with timeouts (e.g.,
+ 'select') to reset their timeout on some platforms (e.g.,
+ HP-UX 11), which is not what we want. Also, when Emacs is
+ interactive, we don't want SA_RESTART because we need to poll
for pending input so we need long-running syscalls to be interrupted
- after a signal that sets the interrupt_input_pending flag. */
- /* Non-interactive keyboard input goes through stdio, where we always
- want restartable system calls. */
-# if defined (BROKEN_SA_RESTART) || defined (SYNC_INPUT)
+ after a signal that sets pending_signals.
+
+ Non-interactive keyboard input goes through stdio, where we
+ always want restartable system calls. */
if (noninteractive)
-# endif
- new_action.sa_flags = SA_RESTART;
+ return SA_RESTART;
+#endif
+ return 0;
+}
+
+/* Store into *ACTION a signal action suitable for Emacs, with handler
+ HANDLER. */
+void
+emacs_sigaction_init (struct sigaction *action, signal_handler_t handler)
+{
+ sigemptyset (&action->sa_mask);
+
+ /* When handling a signal, block nonfatal system signals that are caught
+ by Emacs. This makes race conditions less likely. */
+ sigaddset (&action->sa_mask, SIGALRM);
+#ifdef SIGCHLD
+ sigaddset (&action->sa_mask, SIGCHLD);
+#endif
+#ifdef SIGDANGER
+ sigaddset (&action->sa_mask, SIGDANGER);
+#endif
+#ifdef PROFILER_CPU_SUPPORT
+ sigaddset (&action->sa_mask, SIGPROF);
+#endif
+#ifdef SIGWINCH
+ sigaddset (&action->sa_mask, SIGWINCH);
#endif
- sigaction (signal_number, &new_action, &old_action);
- return (old_action.sa_handler);
+ if (! noninteractive)
+ {
+ sigaddset (&action->sa_mask, SIGINT);
+ sigaddset (&action->sa_mask, SIGQUIT);
+#ifdef USABLE_SIGIO
+ sigaddset (&action->sa_mask, SIGIO);
+#endif
+ }
+
+ if (! IEEE_FLOATING_POINT)
+ sigaddset (&action->sa_mask, SIGFPE);
+
+ action->sa_handler = handler;
+ action->sa_flags = emacs_sigaction_flags ();
+}
+
+#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
+static pthread_t main_thread;
+#endif
+
+/* SIG has arrived at the current process. Deliver it to the main
+ thread, which should handle it with HANDLER.
+
+ If we are on the main thread, handle the signal SIG with HANDLER.
+ Otherwise, redirect the signal to the main thread, blocking it from
+ this thread. POSIX says any thread can receive a signal that is
+ associated with a process, process group, or asynchronous event.
+ On GNU/Linux that is not true, but for other systems (FreeBSD at
+ least) it is. */
+void
+deliver_process_signal (int sig, signal_handler_t handler)
+{
+ /* Preserve errno, to avoid race conditions with signal handlers that
+ might change errno. Races can occur even in single-threaded hosts. */
+ int old_errno = errno;
+
+ bool on_main_thread = true;
+#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
+ if (! pthread_equal (pthread_self (), main_thread))
+ {
+ sigset_t blocked;
+ sigemptyset (&blocked);
+ sigaddset (&blocked, sig);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
+ pthread_kill (main_thread, sig);
+ on_main_thread = false;
+ }
+#endif
+ if (on_main_thread)
+ handler (sig);
+
+ errno = old_errno;
}
-#endif /* WINDOWSNT */
+/* Static location to save a fatal backtrace in a thread.
+ FIXME: If two subsidiary threads fail simultaneously, the resulting
+ backtrace may be garbage. */
+enum { BACKTRACE_LIMIT_MAX = 500 };
+static void *thread_backtrace_buffer[BACKTRACE_LIMIT_MAX + 1];
+static int thread_backtrace_npointers;
-#ifndef __GNUC__
-/* If we're compiling with GCC, we don't need this function, since it
- can be written as a macro. */
-sigset_t
-sys_sigmask (int sig)
+/* SIG has arrived at the current thread.
+ If we are on the main thread, handle the signal SIG with HANDLER.
+ Otherwise, this is a fatal error in the handling thread. */
+static void
+deliver_thread_signal (int sig, signal_handler_t handler)
{
- sigset_t mask;
- sigemptyset (&mask);
- sigaddset (&mask, sig);
- return mask;
+ int old_errno = errno;
+
+#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
+ if (! pthread_equal (pthread_self (), main_thread))
+ {
+ thread_backtrace_npointers
+ = backtrace (thread_backtrace_buffer, BACKTRACE_LIMIT_MAX);
+ sigaction (sig, &process_fatal_action, 0);
+ pthread_kill (main_thread, sig);
+
+ /* Avoid further damage while the main thread is exiting. */
+ while (1)
+ sigsuspend (&empty_mask);
+ }
+#endif
+
+ handler (sig);
+ errno = old_errno;
}
+
+#if !HAVE_DECL_SYS_SIGLIST
+# undef sys_siglist
+# ifdef _sys_siglist
+# define sys_siglist _sys_siglist
+# else
+# define sys_siglist my_sys_siglist
+static char const *sys_siglist[NSIG];
+# endif
#endif
-/* I'd like to have these guys return pointers to the mask storage in here,
- but there'd be trouble if the code was saving multiple masks. I'll be
- safe and pass the structure. It normally won't be more than 2 bytes
- anyhow. - DJB */
+#ifdef _sys_nsig
+# define sys_siglist_entries _sys_nsig
+#else
+# define sys_siglist_entries NSIG
+#endif
-sigset_t
-sys_sigblock (sigset_t new_mask)
+/* Handle bus errors, invalid instruction, etc. */
+static void
+handle_fatal_signal (int sig)
{
- sigset_t old_mask;
- pthread_sigmask (SIG_BLOCK, &new_mask, &old_mask);
- return (old_mask);
+ terminate_due_to_signal (sig, 40);
}
-sigset_t
-sys_sigunblock (sigset_t new_mask)
+static void
+deliver_fatal_signal (int sig)
{
- sigset_t old_mask;
- pthread_sigmask (SIG_UNBLOCK, &new_mask, &old_mask);
- return (old_mask);
+ deliver_process_signal (sig, handle_fatal_signal);
}
-sigset_t
-sys_sigsetmask (sigset_t new_mask)
+static void
+deliver_fatal_thread_signal (int sig)
{
- sigset_t old_mask;
- pthread_sigmask (SIG_SETMASK, &new_mask, &old_mask);
- return (old_mask);
+ deliver_thread_signal (sig, handle_fatal_signal);
}
-
-#if !defined HAVE_STRSIGNAL && !HAVE_DECL_SYS_SIGLIST
-static char *my_sys_siglist[NSIG];
-# ifdef sys_siglist
-# undef sys_siglist
-# endif
-# define sys_siglist my_sys_siglist
-#endif
+static _Noreturn void
+handle_arith_signal (int sig)
+{
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
+ xsignal0 (Qarith_error);
+}
+
+static void
+deliver_arith_signal (int sig)
+{
+ deliver_thread_signal (sig, handle_arith_signal);
+}
+
+/* Treat SIG as a terminating signal, unless it is already ignored and
+ we are in --batch mode. Among other things, this makes nohup work. */
+static void
+maybe_fatal_sig (int sig)
+{
+ bool catch_sig = !noninteractive;
+ if (!catch_sig)
+ {
+ struct sigaction old_action;
+ sigaction (sig, 0, &old_action);
+ catch_sig = old_action.sa_handler != SIG_IGN;
+ }
+ if (catch_sig)
+ sigaction (sig, &process_fatal_action, 0);
+}
void
-init_signals (void)
+init_signals (bool dumping)
{
+ struct sigaction thread_fatal_action;
+ struct sigaction action;
+
sigemptyset (&empty_mask);
-#if !defined HAVE_STRSIGNAL && !HAVE_DECL_SYS_SIGLIST
+#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
+ main_thread = pthread_self ();
+#endif
+
+#if !HAVE_DECL_SYS_SIGLIST && !defined _sys_siglist
if (! initialized)
{
-# ifdef SIGABRT
sys_siglist[SIGABRT] = "Aborted";
-# endif
# ifdef SIGAIO
sys_siglist[SIGAIO] = "LAN I/O interrupt";
# endif
@@ -1602,9 +1697,7 @@ init_signals (void)
# ifdef SIGEMT
sys_siglist[SIGEMT] = "Emulation trap";
# endif
-# ifdef SIGFPE
sys_siglist[SIGFPE] = "Arithmetic exception";
-# endif
# ifdef SIGFREEZE
sys_siglist[SIGFREEZE] = "SIGFREEZE";
# endif
@@ -1614,12 +1707,8 @@ init_signals (void)
# ifdef SIGHUP
sys_siglist[SIGHUP] = "Hangup";
# endif
-# ifdef SIGILL
sys_siglist[SIGILL] = "Illegal instruction";
-# endif
-# ifdef SIGINT
sys_siglist[SIGINT] = "Interrupt";
-# endif
# ifdef SIGIO
sys_siglist[SIGIO] = "I/O possible";
# endif
@@ -1668,9 +1757,7 @@ init_signals (void)
# ifdef SIGSAK
sys_siglist[SIGSAK] = "Secure attention";
# endif
-# ifdef SIGSEGV
sys_siglist[SIGSEGV] = "Segmentation violation";
-# endif
# ifdef SIGSOUND
sys_siglist[SIGSOUND] = "Sound completed";
# endif
@@ -1683,9 +1770,7 @@ init_signals (void)
# ifdef SIGSYS
sys_siglist[SIGSYS] = "Bad argument to system call";
# endif
-# ifdef SIGTERM
sys_siglist[SIGTERM] = "Terminated";
-# endif
# ifdef SIGTHAW
sys_siglist[SIGTHAW] = "SIGTHAW";
# endif
@@ -1729,7 +1814,130 @@ init_signals (void)
sys_siglist[SIGXFSZ] = "File size limit exceeded";
# endif
}
-#endif /* !defined HAVE_STRSIGNAL && !defined HAVE_DECL_SYS_SIGLIST */
+#endif /* !HAVE_DECL_SYS_SIGLIST && !_sys_siglist */
+
+ /* Don't alter signal handlers if dumping. On some machines,
+ changing signal handlers sets static data that would make signals
+ fail to work right when the dumped Emacs is run. */
+ if (dumping)
+ return;
+
+ sigfillset (&process_fatal_action.sa_mask);
+ process_fatal_action.sa_handler = deliver_fatal_signal;
+ process_fatal_action.sa_flags = emacs_sigaction_flags ();
+
+ sigfillset (&thread_fatal_action.sa_mask);
+ thread_fatal_action.sa_handler = deliver_fatal_thread_signal;
+ thread_fatal_action.sa_flags = process_fatal_action.sa_flags;
+
+ /* SIGINT may need special treatment on MS-Windows. See
+ http://lists.gnu.org/archive/html/emacs-devel/2010-09/msg01062.html
+ Please update the doc of kill-emacs, kill-emacs-hook, and
+ NEWS if you change this. */
+
+ maybe_fatal_sig (SIGHUP);
+ maybe_fatal_sig (SIGINT);
+ maybe_fatal_sig (SIGTERM);
+
+ /* Emacs checks for write errors, so it can safely ignore SIGPIPE.
+ However, in batch mode leave SIGPIPE alone, as that causes Emacs
+ to behave more like typical batch applications do. */
+ if (! noninteractive)
+ signal (SIGPIPE, SIG_IGN);
+
+ sigaction (SIGQUIT, &process_fatal_action, 0);
+ sigaction (SIGILL, &thread_fatal_action, 0);
+ sigaction (SIGTRAP, &thread_fatal_action, 0);
+
+ /* Typically SIGFPE is thread-specific and is fatal, like SIGILL.
+ But on a non-IEEE host SIGFPE can come from a trap in the Lisp
+ interpreter's floating point operations, so treat SIGFPE as an
+ arith-error if it arises in the main thread. */
+ if (IEEE_FLOATING_POINT)
+ sigaction (SIGFPE, &thread_fatal_action, 0);
+ else
+ {
+ emacs_sigaction_init (&action, deliver_arith_signal);
+ sigaction (SIGFPE, &action, 0);
+ }
+
+#ifdef SIGUSR1
+ add_user_signal (SIGUSR1, "sigusr1");
+#endif
+#ifdef SIGUSR2
+ add_user_signal (SIGUSR2, "sigusr2");
+#endif
+ sigaction (SIGABRT, &thread_fatal_action, 0);
+#ifdef SIGPRE
+ sigaction (SIGPRE, &thread_fatal_action, 0);
+#endif
+#ifdef SIGORE
+ sigaction (SIGORE, &thread_fatal_action, 0);
+#endif
+#ifdef SIGUME
+ sigaction (SIGUME, &thread_fatal_action, 0);
+#endif
+#ifdef SIGDLK
+ sigaction (SIGDLK, &process_fatal_action, 0);
+#endif
+#ifdef SIGCPULIM
+ sigaction (SIGCPULIM, &process_fatal_action, 0);
+#endif
+#ifdef SIGIOT
+ sigaction (SIGIOT, &thread_fatal_action, 0);
+#endif
+#ifdef SIGEMT
+ sigaction (SIGEMT, &thread_fatal_action, 0);
+#endif
+#ifdef SIGBUS
+ sigaction (SIGBUS, &thread_fatal_action, 0);
+#endif
+ sigaction (SIGSEGV, &thread_fatal_action, 0);
+#ifdef SIGSYS
+ sigaction (SIGSYS, &thread_fatal_action, 0);
+#endif
+ sigaction (SIGTERM, &process_fatal_action, 0);
+#ifdef SIGPROF
+ signal (SIGPROF, SIG_IGN);
+#endif
+#ifdef SIGVTALRM
+ sigaction (SIGVTALRM, &process_fatal_action, 0);
+#endif
+#ifdef SIGXCPU
+ sigaction (SIGXCPU, &process_fatal_action, 0);
+#endif
+#ifdef SIGXFSZ
+ sigaction (SIGXFSZ, &process_fatal_action, 0);
+#endif
+
+#ifdef SIGDANGER
+ /* This just means available memory is getting low. */
+ emacs_sigaction_init (&action, deliver_danger_signal);
+ sigaction (SIGDANGER, &action, 0);
+#endif
+
+ /* AIX-specific signals. */
+#ifdef SIGGRANT
+ sigaction (SIGGRANT, &process_fatal_action, 0);
+#endif
+#ifdef SIGMIGRATE
+ sigaction (SIGMIGRATE, &process_fatal_action, 0);
+#endif
+#ifdef SIGMSG
+ sigaction (SIGMSG, &process_fatal_action, 0);
+#endif
+#ifdef SIGRETRACT
+ sigaction (SIGRETRACT, &process_fatal_action, 0);
+#endif
+#ifdef SIGSAK
+ sigaction (SIGSAK, &process_fatal_action, 0);
+#endif
+#ifdef SIGSOUND
+ sigaction (SIGSOUND, &process_fatal_action, 0);
+#endif
+#ifdef SIGTALRM
+ sigaction (SIGTALRM, &thread_fatal_action, 0);
+#endif
}
#ifndef HAVE_RANDOM
@@ -1770,19 +1978,37 @@ init_signals (void)
#endif /* !RAND_BITS */
void
-seed_random (long int arg)
+seed_random (void *seed, ptrdiff_t seed_size)
{
+#if defined HAVE_RANDOM || ! defined HAVE_LRAND48
+ unsigned int arg = 0;
+#else
+ long int arg = 0;
+#endif
+ unsigned char *argp = (unsigned char *) &arg;
+ unsigned char *seedp = seed;
+ ptrdiff_t i;
+ for (i = 0; i < seed_size; i++)
+ argp[i % sizeof arg] ^= seedp[i];
#ifdef HAVE_RANDOM
- srandom ((unsigned int)arg);
+ srandom (arg);
#else
# ifdef HAVE_LRAND48
srand48 (arg);
# else
- srand ((unsigned int)arg);
+ srand (arg);
# endif
#endif
}
+void
+init_random (void)
+{
+ EMACS_TIME t = current_emacs_time ();
+ uintmax_t v = getpid () ^ EMACS_SECS (t) ^ EMACS_NSECS (t);
+ seed_random (&v, sizeof v);
+}
+
/*
* Return a nonnegative random integer out of whatever we've got.
* It contains enough bits to make a random (signed) Emacs fixnum.
@@ -1800,21 +2026,6 @@ get_random (void)
return val & INTMASK;
}
-#ifndef HAVE_STRERROR
-#ifndef WINDOWSNT
-char *
-strerror (int errnum)
-{
- extern char *sys_errlist[];
- extern int sys_nerr;
-
- if (errnum >= 0 && errnum < sys_nerr)
- return sys_errlist[errnum];
- return (char *) "Unknown error";
-}
-#endif /* not WINDOWSNT */
-#endif /* ! HAVE_STRERROR */
-
#ifndef HAVE_SNPRINTF
/* Approximate snprintf as best we can on ancient hosts that lack it. */
int
@@ -1858,6 +2069,46 @@ snprintf (char *buf, size_t bufsize, char const *format, ...)
}
#endif
+/* If a backtrace is available, output the top lines of it to stderr.
+ Do not output more than BACKTRACE_LIMIT or BACKTRACE_LIMIT_MAX lines.
+ This function may be called from a signal handler, so it should
+ not invoke async-unsafe functions like malloc. */
+void
+emacs_backtrace (int backtrace_limit)
+{
+ void *main_backtrace_buffer[BACKTRACE_LIMIT_MAX + 1];
+ int bounded_limit = min (backtrace_limit, BACKTRACE_LIMIT_MAX);
+ void *buffer;
+ int npointers;
+
+ if (thread_backtrace_npointers)
+ {
+ buffer = thread_backtrace_buffer;
+ npointers = thread_backtrace_npointers;
+ }
+ else
+ {
+ buffer = main_backtrace_buffer;
+ npointers = backtrace (buffer, bounded_limit + 1);
+ }
+
+ if (npointers)
+ {
+ ignore_value (write (STDERR_FILENO, "\nBacktrace:\n", 12));
+ backtrace_symbols_fd (buffer, npointers, STDERR_FILENO);
+ if (bounded_limit < npointers)
+ ignore_value (write (STDERR_FILENO, "...\n", 4));
+ }
+}
+
+#ifndef HAVE_NTGUI
+void
+emacs_abort (void)
+{
+ terminate_due_to_signal (SIGABRT, 10);
+}
+#endif
+
int
emacs_open (const char *path, int oflag, int mode)
{
@@ -1902,8 +2153,8 @@ emacs_close (int fd)
/* Read from FILEDESC to a buffer BUF with size NBYTE, retrying if interrupted.
Return the number of bytes read, which might be less than NBYTE.
On error, set errno and return -1. */
-EMACS_INT
-emacs_read (int fildes, char *buf, EMACS_INT nbyte)
+ptrdiff_t
+emacs_read (int fildes, char *buf, ptrdiff_t nbyte)
{
register ssize_t rtnval;
@@ -1919,11 +2170,11 @@ emacs_read (int fildes, char *buf, EMACS_INT nbyte)
/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if interrupted
or if a partial write occurs. Return the number of bytes written, setting
errno if this is less than NBYTE. */
-EMACS_INT
-emacs_write (int fildes, const char *buf, EMACS_INT nbyte)
+ptrdiff_t
+emacs_write (int fildes, const char *buf, ptrdiff_t nbyte)
{
ssize_t rtnval;
- EMACS_INT bytes_written;
+ ptrdiff_t bytes_written;
bytes_written = 0;
@@ -1935,11 +2186,10 @@ emacs_write (int fildes, const char *buf, EMACS_INT nbyte)
{
if (errno == EINTR)
{
-#ifdef SYNC_INPUT
/* I originally used `QUIT' but that might causes files to
be truncated if you hit C-g in the middle of it. --Stef */
- process_pending_signals ();
-#endif
+ if (pending_signals)
+ process_pending_signals ();
continue;
}
else
@@ -1970,329 +2220,66 @@ emacs_readlink (char const *filename, char initial_buf[READLINK_BUFSIZE])
&emacs_norealloc_allocator, careadlinkatcwd);
}
-#ifdef USG
-/*
- * All of the following are for USG.
- *
- * On USG systems the system calls are INTERRUPTIBLE by signals
- * that the user program has elected to catch. Thus the system call
- * must be retried in these cases. To handle this without massive
- * changes in the source code, we remap the standard system call names
- * to names for our own functions in sysdep.c that do the system call
- * with retries. Actually, for portability reasons, it is good
- * programming practice, as this example shows, to limit all actual
- * system calls to a single occurrence in the source. Sure, this
- * adds an extra level of function call overhead but it is almost
- * always negligible. Fred Fish, Unisoft Systems Inc.
- */
-
-/*
- * Warning, this function may not duplicate 4.2 action properly
- * under error conditions.
- */
-
-#ifndef HAVE_GETWD
-
-#ifndef MAXPATHLEN
-/* In 4.1, param.h fails to define this. */
-#define MAXPATHLEN 1024
-#endif
-
-char *
-getwd (char *pathname)
+/* Return a struct timeval that is roughly equivalent to T.
+ Use the least timeval not less than T.
+ Return an extremal value if the result would overflow. */
+struct timeval
+make_timeval (EMACS_TIME t)
{
- char *npath, *spath;
- extern char *getcwd (char *, size_t);
-
- BLOCK_INPUT; /* getcwd uses malloc */
- spath = npath = getcwd ((char *) 0, MAXPATHLEN);
- if (spath == 0)
- {
- UNBLOCK_INPUT;
- return spath;
- }
- /* On Altos 3068, getcwd can return @hostname/dir, so discard
- up to first slash. Should be harmless on other systems. */
- while (*npath && *npath != '/')
- npath++;
- strcpy (pathname, npath);
- free (spath); /* getcwd uses malloc */
- UNBLOCK_INPUT;
- return pathname;
-}
-
-#endif /* HAVE_GETWD */
-
-/*
- * Emulate rename using unlink/link. Note that this is
- * only partially correct. Also, doesn't enforce restriction
- * that files be of same type (regular->regular, dir->dir, etc).
- */
-
-#ifndef HAVE_RENAME
+ struct timeval tv;
+ tv.tv_sec = t.tv_sec;
+ tv.tv_usec = t.tv_nsec / 1000;
-int
-rename (const char *from, const char *to)
-{
- if (access (from, 0) == 0)
+ if (t.tv_nsec % 1000 != 0)
{
- unlink (to);
- if (link (from, to) == 0)
- if (unlink (from) == 0)
- return (0);
- }
- return (-1);
-}
-
-#endif
-
-
-#if defined (HPUX) && !defined (HAVE_PERROR)
-
-/* HPUX curses library references perror, but as far as we know
- it won't be called. Anyway this definition will do for now. */
-
-void
-perror (void)
-{
-}
-#endif /* HPUX and not HAVE_PERROR */
-
-/*
- * Gettimeofday. Simulate as much as possible. Only accurate
- * to nearest second. Emacs doesn't use tzp so ignore it for now.
- * Only needed when subprocesses are defined.
- */
-
-#ifndef HAVE_GETTIMEOFDAY
-#ifdef HAVE_TIMEVAL
-
-int
-gettimeofday (struct timeval *tp, struct timezone *tzp)
-{
- extern long time (long);
-
- tp->tv_sec = time ((long *)0);
- tp->tv_usec = 0;
- if (tzp != 0)
- tzp->tz_minuteswest = -1;
- return 0;
-}
-
-#endif
-#endif /* !HAVE_GETTIMEOFDAY && HAVE_TIMEVAL */
-
-/*
- * This function will go away as soon as all the stubs fixed. (fnf)
- */
-
-void
-croak (char *badfunc)
-{
- printf ("%s not yet implemented\r\n", badfunc);
- reset_all_sys_modes ();
- exit (1);
-}
-
-#endif /* USG */
-
-/* Directory routines for systems that don't have them. */
-
-#ifdef HAVE_DIRENT_H
-
-#include <dirent.h>
-
-#if !defined (HAVE_CLOSEDIR)
-
-int
-closedir (DIR *dirp /* stream from opendir */)
-{
- int rtnval;
-
- rtnval = emacs_close (dirp->dd_fd);
- xfree ((char *) dirp);
-
- return rtnval;
-}
-#endif /* not HAVE_CLOSEDIR */
-#endif /* HAVE_DIRENT_H */
-
-
-int
-set_file_times (const char *filename, EMACS_TIME atime, EMACS_TIME mtime)
-{
-#ifdef HAVE_UTIMES
- struct timeval tv[2];
- tv[0] = atime;
- tv[1] = mtime;
- return utimes (filename, tv);
-#else /* not HAVE_UTIMES */
- struct utimbuf utb;
- utb.actime = EMACS_SECS (atime);
- utb.modtime = EMACS_SECS (mtime);
- return utime (filename, &utb);
-#endif /* not HAVE_UTIMES */
-}
-
-/* mkdir and rmdir functions, for systems which don't have them. */
-
-#ifndef HAVE_MKDIR
-/*
- * Written by Robert Rother, Mariah Corporation, August 1985.
- *
- * If you want it, it's yours. All I ask in return is that if you
- * figure out how to do this in a Bourne Shell script you send me
- * a copy.
- * sdcsvax!rmr or rmr@uscd
- *
- * Severely hacked over by John Gilmore to make a 4.2BSD compatible
- * subroutine. 11Mar86; hoptoad!gnu
- *
- * Modified by rmtodd@uokmax 6-28-87 -- when making an already existing dir,
- * subroutine didn't return EEXIST. It does now.
- */
-
-/*
- * Make a directory.
- */
-int
-mkdir (char *dpath, int dmode)
-{
- int cpid, status, fd;
- struct stat statbuf;
-
- if (stat (dpath, &statbuf) == 0)
- {
- errno = EEXIST; /* Stat worked, so it already exists */
- return -1;
- }
-
- /* If stat fails for a reason other than non-existence, return error */
- if (errno != ENOENT)
- return -1;
-
- synch_process_alive = 1;
- switch (cpid = fork ())
- {
-
- case -1: /* Error in fork */
- return (-1); /* Errno is set already */
-
- case 0: /* Child process */
- /*
- * Cheap hack to set mode of new directory. Since this
- * child process is going away anyway, we zap its umask.
- * FIXME, this won't suffice to set SUID, SGID, etc. on this
- * directory. Does anybody care?
- */
- status = umask (0); /* Get current umask */
- status = umask (status | (0777 & ~dmode)); /* Set for mkdir */
- fd = emacs_open ("/dev/null", O_RDWR, 0);
- if (fd >= 0)
- {
- dup2 (fd, 0);
- dup2 (fd, 1);
- dup2 (fd, 2);
- }
- execl ("/bin/mkdir", "mkdir", dpath, (char *) 0);
- _exit (-1); /* Can't exec /bin/mkdir */
-
- default: /* Parent process */
- wait_for_termination (cpid);
- }
-
- if (synch_process_death != 0 || synch_process_retcode != 0
- || synch_process_termsig != 0)
- {
- errno = EIO; /* We don't know why, but */
- return -1; /* /bin/mkdir failed */
+ if (tv.tv_usec < 999999)
+ tv.tv_usec++;
+ else if (tv.tv_sec < TYPE_MAXIMUM (time_t))
+ {
+ tv.tv_sec++;
+ tv.tv_usec = 0;
+ }
}
- return 0;
+ return tv;
}
-#endif /* not HAVE_MKDIR */
-#ifndef HAVE_RMDIR
+/* Set the access and modification time stamps of FD (a.k.a. FILE) to be
+ ATIME and MTIME, respectively.
+ FD must be either negative -- in which case it is ignored --
+ or a file descriptor that is open on FILE.
+ If FD is nonnegative, then FILE can be NULL. */
int
-rmdir (char *dpath)
+set_file_times (int fd, const char *filename,
+ EMACS_TIME atime, EMACS_TIME mtime)
{
- int cpid, status, fd;
- struct stat statbuf;
-
- if (stat (dpath, &statbuf) != 0)
- {
- /* Stat just set errno. We don't have to */
- return -1;
- }
-
- synch_process_alive = 1;
- switch (cpid = fork ())
- {
-
- case -1: /* Error in fork */
- return (-1); /* Errno is set already */
-
- case 0: /* Child process */
- fd = emacs_open ("/dev/null", O_RDWR, 0);
- if (fd >= 0)
- {
- dup2 (fd, 0);
- dup2 (fd, 1);
- dup2 (fd, 2);
- }
- execl ("/bin/rmdir", "rmdir", dpath, (char *) 0);
- _exit (-1); /* Can't exec /bin/rmdir */
-
- default: /* Parent process */
- wait_for_termination (cpid);
- }
-
- if (synch_process_death != 0 || synch_process_retcode != 0
- || synch_process_termsig != 0)
- {
- errno = EIO; /* We don't know why, but */
- return -1; /* /bin/rmdir failed */
- }
-
- return 0;
+ struct timespec timespec[2];
+ timespec[0] = atime;
+ timespec[1] = mtime;
+ return fdutimens (fd, filename, timespec);
}
-#endif /* !HAVE_RMDIR */
-
-#ifndef HAVE_STRSIGNAL
-char *
-strsignal (int code)
+/* Like strsignal, except async-signal-safe, and this function typically
+ returns a string in the C locale rather than the current locale. */
+char const *
+safe_strsignal (int code)
{
- char *signame = 0;
+ char const *signame = 0;
- if (0 <= code && code < NSIG)
- {
- /* Cast to suppress warning if the table has const char *. */
- signame = (char *) sys_siglist[code];
- }
+ if (0 <= code && code < sys_siglist_entries)
+ signame = sys_siglist[code];
+ if (! signame)
+ signame = "Unknown signal";
return signame;
}
-#endif /* HAVE_STRSIGNAL */
#ifndef DOS_NT
/* For make-serial-process */
int
serial_open (char *port)
{
- int fd = -1;
-
- fd = emacs_open ((char*) port,
- O_RDWR
-#ifdef O_NONBLOCK
- | O_NONBLOCK
-#else
- | O_NDELAY
-#endif
-#ifdef O_NOCTTY
- | O_NOCTTY
-#endif
- , 0);
+ int fd = emacs_open (port, O_RDWR | O_NOCTTY | O_NONBLOCK, 0);
if (fd < 0)
{
error ("Could not open %s: %s",
@@ -2488,8 +2475,7 @@ serial_configure (struct Lisp_Process *p,
error ("tcsetattr() failed: %s", emacs_strerror (errno));
childp2 = Fplist_put (childp2, QCsummary, build_string (summary));
- p->childp = childp2;
-
+ pset_childp (p, childp2);
}
#endif /* not DOS_NT */
@@ -2529,6 +2515,52 @@ list_system_processes (void)
return proclist;
}
+#elif defined BSD_SYSTEM
+
+Lisp_Object
+list_system_processes (void)
+{
+#if defined DARWIN_OS || defined __NetBSD__ || defined __OpenBSD__
+ int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_ALL};
+#else
+ int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_PROC};
+#endif
+ size_t len;
+ struct kinfo_proc *procs;
+ size_t i;
+
+ struct gcpro gcpro1;
+ Lisp_Object proclist = Qnil;
+
+ if (sysctl (mib, 3, NULL, &len, NULL, 0) != 0)
+ return proclist;
+
+ procs = xmalloc (len);
+ if (sysctl (mib, 3, procs, &len, NULL, 0) != 0)
+ {
+ xfree (procs);
+ return proclist;
+ }
+
+ GCPRO1 (proclist);
+ len /= sizeof (struct kinfo_proc);
+ for (i = 0; i < len; i++)
+ {
+#if defined DARWIN_OS || defined __NetBSD__
+ proclist = Fcons (make_fixnum_or_float (procs[i].kp_proc.p_pid), proclist);
+#elif defined __OpenBSD__
+ proclist = Fcons (make_fixnum_or_float (procs[i].p_pid), proclist);
+#else
+ proclist = Fcons (make_fixnum_or_float (procs[i].ki_pid), proclist);
+#endif
+ }
+ UNGCPRO;
+
+ xfree (procs);
+
+ return proclist;
+}
+
/* The WINDOWSNT implementation is in w32.c.
The MSDOS implementation is in dosfns.c. */
#elif !defined (WINDOWSNT) && !defined (MSDOS)
@@ -2542,60 +2574,78 @@ list_system_processes (void)
#endif /* !defined (WINDOWSNT) */
#ifdef GNU_LINUX
-static void
-time_from_jiffies (unsigned long long tval, long hz,
- time_t *sec, unsigned *usec)
-{
- unsigned long long ullsec;
-
- *sec = tval / hz;
- ullsec = *sec;
- tval -= ullsec * hz;
- /* Careful: if HZ > 1 million, then integer division by it yields zero. */
- if (hz <= 1000000)
- *usec = tval * 1000000 / hz;
+static EMACS_TIME
+time_from_jiffies (unsigned long long tval, long hz)
+{
+ unsigned long long s = tval / hz;
+ unsigned long long frac = tval % hz;
+ int ns;
+
+ if (TYPE_MAXIMUM (time_t) < s)
+ time_overflow ();
+ if (LONG_MAX - 1 <= ULLONG_MAX / EMACS_TIME_RESOLUTION
+ || frac <= ULLONG_MAX / EMACS_TIME_RESOLUTION)
+ ns = frac * EMACS_TIME_RESOLUTION / hz;
else
- *usec = tval / (hz / 1000000);
+ {
+ /* This is reachable only in the unlikely case that HZ * HZ
+ exceeds ULLONG_MAX. It calculates an approximation that is
+ guaranteed to be in range. */
+ long hz_per_ns = (hz / EMACS_TIME_RESOLUTION
+ + (hz % EMACS_TIME_RESOLUTION != 0));
+ ns = frac / hz_per_ns;
+ }
+
+ return make_emacs_time (s, ns);
}
static Lisp_Object
ltime_from_jiffies (unsigned long long tval, long hz)
{
- time_t sec;
- unsigned usec;
-
- time_from_jiffies (tval, hz, &sec, &usec);
-
- return list3 (make_number ((sec >> 16) & 0xffff),
- make_number (sec & 0xffff),
- make_number (usec));
+ EMACS_TIME t = time_from_jiffies (tval, hz);
+ return make_lisp_time (t);
}
-static void
-get_up_time (time_t *sec, unsigned *usec)
+static EMACS_TIME
+get_up_time (void)
{
FILE *fup;
+ EMACS_TIME up = make_emacs_time (0, 0);
- *sec = *usec = 0;
-
- BLOCK_INPUT;
+ block_input ();
fup = fopen ("/proc/uptime", "r");
if (fup)
{
- double uptime, idletime;
+ unsigned long long upsec, upfrac, idlesec, idlefrac;
+ int upfrac_start, upfrac_end, idlefrac_start, idlefrac_end;
- /* The numbers in /proc/uptime use C-locale decimal point, but
- we already set ourselves to the C locale (see `fixup_locale'
- in emacs.c). */
- if (2 <= fscanf (fup, "%lf %lf", &uptime, &idletime))
+ if (fscanf (fup, "%llu.%n%llu%n %llu.%n%llu%n",
+ &upsec, &upfrac_start, &upfrac, &upfrac_end,
+ &idlesec, &idlefrac_start, &idlefrac, &idlefrac_end)
+ == 4)
{
- *sec = uptime;
- *usec = (uptime - *sec) * 1000000;
+ if (TYPE_MAXIMUM (time_t) < upsec)
+ {
+ upsec = TYPE_MAXIMUM (time_t);
+ upfrac = EMACS_TIME_RESOLUTION - 1;
+ }
+ else
+ {
+ int upfraclen = upfrac_end - upfrac_start;
+ for (; upfraclen < LOG10_EMACS_TIME_RESOLUTION; upfraclen++)
+ upfrac *= 10;
+ for (; LOG10_EMACS_TIME_RESOLUTION < upfraclen; upfraclen--)
+ upfrac /= 10;
+ upfrac = min (upfrac, EMACS_TIME_RESOLUTION - 1);
+ }
+ up = make_emacs_time (upsec, upfrac);
}
fclose (fup);
}
- UNBLOCK_INPUT;
+ unblock_input ();
+
+ return up;
}
#define MAJOR(d) (((unsigned)(d) >> 8) & 0xfff)
@@ -2607,7 +2657,7 @@ procfs_ttyname (int rdev)
FILE *fdev = NULL;
char name[PATH_MAX];
- BLOCK_INPUT;
+ block_input ();
fdev = fopen ("/proc/tty/drivers", "r");
if (fdev)
@@ -2639,7 +2689,7 @@ procfs_ttyname (int rdev)
}
fclose (fdev);
}
- UNBLOCK_INPUT;
+ unblock_input ();
return build_string (name);
}
@@ -2649,7 +2699,7 @@ procfs_get_total_memory (void)
FILE *fmem = NULL;
unsigned long retval = 2 * 1024 * 1024; /* default: 2GB */
- BLOCK_INPUT;
+ block_input ();
fmem = fopen ("/proc/meminfo", "r");
if (fmem)
@@ -2668,7 +2718,7 @@ procfs_get_total_memory (void)
}
fclose (fmem);
}
- UNBLOCK_INPUT;
+ unblock_input ();
return retval;
}
@@ -2684,26 +2734,28 @@ system_process_attributes (Lisp_Object pid)
char procbuf[1025], *p, *q;
int fd;
ssize_t nread;
- const char *cmd = NULL;
+ static char const default_cmd[] = "???";
+ const char *cmd = default_cmd;
+ int cmdsize = sizeof default_cmd - 1;
char *cmdline = NULL;
- ptrdiff_t cmdsize = 0, cmdline_size;
+ ptrdiff_t cmdline_size;
unsigned char c;
- int proc_id, ppid, uid, gid, pgrp, sess, tty, tpgid, thcount;
+ printmax_t proc_id;
+ int ppid, pgrp, sess, tty, tpgid, thcount;
+ uid_t uid;
+ gid_t gid;
unsigned long long u_time, s_time, cutime, cstime, start;
long priority, niceness, rss;
unsigned long minflt, majflt, cminflt, cmajflt, vsize;
- time_t sec;
- unsigned usec;
- EMACS_TIME tnow, tstart, tboot, telapsed;
+ EMACS_TIME tnow, tstart, tboot, telapsed, us_time;
double pcpu, pmem;
Lisp_Object attrs = Qnil;
Lisp_Object cmd_str, decoded_cmd, tem;
struct gcpro gcpro1, gcpro2;
- EMACS_INT uid_eint, gid_eint;
CHECK_NUMBER_OR_FLOAT (pid);
- proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid);
- sprintf (procfn, "/proc/%u", proc_id);
+ CONS_TO_INTEGER (pid, pid_t, proc_id);
+ sprintf (procfn, "/proc/%"pMd, proc_id);
if (stat (procfn, &st) < 0)
return attrs;
@@ -2711,21 +2763,18 @@ system_process_attributes (Lisp_Object pid)
/* euid egid */
uid = st.st_uid;
- /* Use of EMACS_INT stops GCC whining about limited range of data type. */
- uid_eint = uid;
- attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid_eint)), attrs);
- BLOCK_INPUT;
+ attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs);
+ block_input ();
pw = getpwuid (uid);
- UNBLOCK_INPUT;
+ unblock_input ();
if (pw)
attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
gid = st.st_gid;
- gid_eint = gid;
- attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid_eint)), attrs);
- BLOCK_INPUT;
+ attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs);
+ block_input ();
gr = getgrgid (gid);
- UNBLOCK_INPUT;
+ unblock_input ();
if (gr)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
@@ -2751,11 +2800,6 @@ system_process_attributes (Lisp_Object pid)
}
else
q = NULL;
- if (cmd == NULL)
- {
- cmd = "???";
- cmdsize = 3;
- }
/* Command name is encoded in locale-coding-system; decode it. */
cmd_str = make_unibyte_string (cmd, cmdsize);
decoded_cmd = code_convert_string_norecord (cmd_str,
@@ -2820,36 +2864,19 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qpri, make_number (priority)), attrs);
attrs = Fcons (Fcons (Qnice, make_number (niceness)), attrs);
attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount_eint)), attrs);
- EMACS_GET_TIME (tnow);
- get_up_time (&sec, &usec);
- EMACS_SET_SECS (telapsed, sec);
- EMACS_SET_USECS (telapsed, usec);
- EMACS_SUB_TIME (tboot, tnow, telapsed);
- time_from_jiffies (start, clocks_per_sec, &sec, &usec);
- EMACS_SET_SECS (tstart, sec);
- EMACS_SET_USECS (tstart, usec);
- EMACS_ADD_TIME (tstart, tboot, tstart);
- attrs = Fcons (Fcons (Qstart,
- list3 (make_number
- ((EMACS_SECS (tstart) >> 16) & 0xffff),
- make_number
- (EMACS_SECS (tstart) & 0xffff),
- make_number
- (EMACS_USECS (tstart)))),
- attrs);
+ tnow = current_emacs_time ();
+ telapsed = get_up_time ();
+ tboot = sub_emacs_time (tnow, telapsed);
+ tstart = time_from_jiffies (start, clocks_per_sec);
+ tstart = add_emacs_time (tboot, tstart);
+ attrs = Fcons (Fcons (Qstart, make_lisp_time (tstart)), attrs);
attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize/1024)), attrs);
attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4*rss)), attrs);
- EMACS_SUB_TIME (telapsed, tnow, tstart);
- attrs = Fcons (Fcons (Qetime,
- list3 (make_number
- ((EMACS_SECS (telapsed) >> 16) & 0xffff),
- make_number
- (EMACS_SECS (telapsed) & 0xffff),
- make_number
- (EMACS_USECS (telapsed)))),
- attrs);
- time_from_jiffies (u_time + s_time, clocks_per_sec, &sec, &usec);
- pcpu = (sec + usec / 1000000.0) / (EMACS_SECS (telapsed) + EMACS_USECS (telapsed) / 1000000.0);
+ telapsed = sub_emacs_time (tnow, tstart);
+ attrs = Fcons (Fcons (Qetime, make_lisp_time (telapsed)), attrs);
+ us_time = time_from_jiffies (u_time + s_time, clocks_per_sec);
+ pcpu = (EMACS_TIME_TO_DOUBLE (us_time)
+ / EMACS_TIME_TO_DOUBLE (telapsed));
if (pcpu > 1.0)
pcpu = 1.0;
attrs = Fcons (Fcons (Qpcpu, make_float (100 * pcpu)), attrs);
@@ -2873,7 +2900,7 @@ system_process_attributes (Lisp_Object pid)
if (emacs_read (fd, &ch, 1) != 1)
break;
c = ch;
- if (isspace (c) || c == '\\')
+ if (c_isspace (c) || c == '\\')
cmdline_size++; /* for later quoting, see below */
}
if (cmdline_size)
@@ -2897,7 +2924,7 @@ system_process_attributes (Lisp_Object pid)
for (p = cmdline; p < cmdline + nread; p++)
{
/* Escape-quote whitespace and backslashes. */
- if (isspace (*p) || *p == '\\')
+ if (c_isspace (*p) || *p == '\\')
{
memmove (p + 1, p, nread - (p - cmdline));
nread++;
@@ -2910,14 +2937,9 @@ system_process_attributes (Lisp_Object pid)
}
if (!cmdline_size)
{
- if (!cmd)
- cmd = "???";
- if (!cmdsize)
- cmdsize = strlen (cmd);
cmdline_size = cmdsize + 2;
cmdline = xmalloc (cmdline_size + 1);
- strcpy (cmdline, "[");
- strcat (strncat (cmdline, cmd, cmdsize), "]");
+ sprintf (cmdline, "[%.*s]", cmdsize, cmd);
}
emacs_close (fd);
/* Command line is encoded in locale-coding-system; decode it. */
@@ -2962,15 +2984,16 @@ system_process_attributes (Lisp_Object pid)
struct psinfo pinfo;
int fd;
ssize_t nread;
- int proc_id, uid, gid;
+ printmax_t proc_id;
+ uid_t uid;
+ gid_t gid;
Lisp_Object attrs = Qnil;
Lisp_Object decoded_cmd, tem;
struct gcpro gcpro1, gcpro2;
- EMACS_INT uid_eint, gid_eint;
CHECK_NUMBER_OR_FLOAT (pid);
- proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid);
- sprintf (procfn, "/proc/%u", proc_id);
+ CONS_TO_INTEGER (pid, pid_t, proc_id);
+ sprintf (procfn, "/proc/%"pMd, proc_id);
if (stat (procfn, &st) < 0)
return attrs;
@@ -2978,21 +3001,18 @@ system_process_attributes (Lisp_Object pid)
/* euid egid */
uid = st.st_uid;
- /* Use of EMACS_INT stops GCC whining about limited range of data type. */
- uid_eint = uid;
- attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid_eint)), attrs);
- BLOCK_INPUT;
+ attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs);
+ block_input ();
pw = getpwuid (uid);
- UNBLOCK_INPUT;
+ unblock_input ();
if (pw)
attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
gid = st.st_gid;
- gid_eint = gid;
- attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid_eint)), attrs);
- BLOCK_INPUT;
+ attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs);
+ block_input ();
gr = getgrgid (gid);
- UNBLOCK_INPUT;
+ unblock_input ();
if (gr)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
@@ -3032,33 +3052,20 @@ system_process_attributes (Lisp_Object pid)
Qcstime
Are they available? */
- attrs = Fcons (Fcons (Qtime,
- list3 (make_number (pinfo.pr_time.tv_sec >> 16),
- make_number (pinfo.pr_time.tv_sec & 0xffff),
- make_number (pinfo.pr_time.tv_nsec))),
- attrs);
-
- attrs = Fcons (Fcons (Qctime,
- list3 (make_number (pinfo.pr_ctime.tv_sec >> 16),
- make_number (pinfo.pr_ctime.tv_sec & 0xffff),
- make_number (pinfo.pr_ctime.tv_nsec))),
- attrs);
-
+ attrs = Fcons (Fcons (Qtime, make_lisp_time (pinfo.pr_time)), attrs);
+ attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs);
attrs = Fcons (Fcons (Qpri, make_number (pinfo.pr_lwp.pr_pri)), attrs);
attrs = Fcons (Fcons (Qnice, make_number (pinfo.pr_lwp.pr_nice)), attrs);
attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)), attrs);
- attrs = Fcons (Fcons (Qstart,
- list3 (make_number (pinfo.pr_start.tv_sec >> 16),
- make_number (pinfo.pr_start.tv_sec & 0xffff),
- make_number (pinfo.pr_start.tv_nsec))),
- attrs);
+ attrs = Fcons (Fcons (Qstart, make_lisp_time (pinfo.pr_start)), attrs);
attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (pinfo.pr_size)), attrs);
attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (pinfo.pr_rssize)), attrs);
- /* pr_pctcpu and pr_pctmem are encoded as a fixed point 16 bit number in [0 ... 1]. */
- attrs = Fcons (Fcons (Qpcpu, (pinfo.pr_pctcpu * 100.0) / (double)0x8000), attrs);
- attrs = Fcons (Fcons (Qpmem, (pinfo.pr_pctmem * 100.0) / (double)0x8000), attrs);
+ /* pr_pctcpu and pr_pctmem are unsigned integers in the
+ range 0 .. 2**15, representing 0.0 .. 1.0. */
+ attrs = Fcons (Fcons (Qpcpu, make_float (100.0 / 0x8000 * pinfo.pr_pctcpu)), attrs);
+ attrs = Fcons (Fcons (Qpmem, make_float (100.0 / 0x8000 * pinfo.pr_pctmem)), attrs);
decoded_cmd
= code_convert_string_norecord (make_unibyte_string (pinfo.pr_fname,
@@ -3079,6 +3086,192 @@ system_process_attributes (Lisp_Object pid)
return attrs;
}
+#elif defined __FreeBSD__
+
+static EMACS_TIME
+timeval_to_EMACS_TIME (struct timeval t)
+{
+ return make_emacs_time (t.tv_sec, t.tv_usec * 1000);
+}
+
+static Lisp_Object
+make_lisp_timeval (struct timeval t)
+{
+ return make_lisp_time (timeval_to_EMACS_TIME (t));
+}
+
+Lisp_Object
+system_process_attributes (Lisp_Object pid)
+{
+ int proc_id;
+ int pagesize = getpagesize ();
+ int npages;
+ int fscale;
+ struct passwd *pw;
+ struct group *gr;
+ char *ttyname;
+ size_t len;
+ char args[MAXPATHLEN];
+ EMACS_TIME t, now;
+
+ int mib[4] = {CTL_KERN, KERN_PROC, KERN_PROC_PID};
+ struct kinfo_proc proc;
+ size_t proclen = sizeof proc;
+
+ struct gcpro gcpro1, gcpro2;
+ Lisp_Object attrs = Qnil;
+ Lisp_Object decoded_comm;
+
+ CHECK_NUMBER_OR_FLOAT (pid);
+ CONS_TO_INTEGER (pid, int, proc_id);
+ mib[3] = proc_id;
+
+ if (sysctl (mib, 4, &proc, &proclen, NULL, 0) != 0)
+ return attrs;
+
+ GCPRO2 (attrs, decoded_comm);
+
+ attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (proc.ki_uid)), attrs);
+
+ block_input ();
+ pw = getpwuid (proc.ki_uid);
+ unblock_input ();
+ if (pw)
+ attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
+
+ attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (proc.ki_svgid)), attrs);
+
+ block_input ();
+ gr = getgrgid (proc.ki_svgid);
+ unblock_input ();
+ if (gr)
+ attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
+
+ decoded_comm = code_convert_string_norecord
+ (make_unibyte_string (proc.ki_comm, strlen (proc.ki_comm)),
+ Vlocale_coding_system, 0);
+
+ attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
+ {
+ char state[2] = {'\0', '\0'};
+ switch (proc.ki_stat)
+ {
+ case SRUN:
+ state[0] = 'R';
+ break;
+
+ case SSLEEP:
+ state[0] = 'S';
+ break;
+
+ case SLOCK:
+ state[0] = 'D';
+ break;
+
+ case SZOMB:
+ state[0] = 'Z';
+ break;
+
+ case SSTOP:
+ state[0] = 'T';
+ break;
+ }
+ attrs = Fcons (Fcons (Qstate, build_string (state)), attrs);
+ }
+
+ attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (proc.ki_ppid)), attrs);
+ attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (proc.ki_pgid)), attrs);
+ attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (proc.ki_sid)), attrs);
+
+ block_input ();
+ ttyname = proc.ki_tdev == NODEV ? NULL : devname (proc.ki_tdev, S_IFCHR);
+ unblock_input ();
+ if (ttyname)
+ attrs = Fcons (Fcons (Qtty, build_string (ttyname)), attrs);
+
+ attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (proc.ki_tpgid)), attrs);
+ attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (proc.ki_rusage.ru_minflt)), attrs);
+ attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (proc.ki_rusage.ru_majflt)), attrs);
+ attrs = Fcons (Fcons (Qcminflt, make_number (proc.ki_rusage_ch.ru_minflt)), attrs);
+ attrs = Fcons (Fcons (Qcmajflt, make_number (proc.ki_rusage_ch.ru_majflt)), attrs);
+
+ attrs = Fcons (Fcons (Qutime, make_lisp_timeval (proc.ki_rusage.ru_utime)),
+ attrs);
+ attrs = Fcons (Fcons (Qstime, make_lisp_timeval (proc.ki_rusage.ru_stime)),
+ attrs);
+ t = add_emacs_time (timeval_to_EMACS_TIME (proc.ki_rusage.ru_utime),
+ timeval_to_EMACS_TIME (proc.ki_rusage.ru_stime));
+ attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs);
+
+ attrs = Fcons (Fcons (Qcutime,
+ make_lisp_timeval (proc.ki_rusage_ch.ru_utime)),
+ attrs);
+ attrs = Fcons (Fcons (Qcstime,
+ make_lisp_timeval (proc.ki_rusage_ch.ru_utime)),
+ attrs);
+ t = add_emacs_time (timeval_to_EMACS_TIME (proc.ki_rusage_ch.ru_utime),
+ timeval_to_EMACS_TIME (proc.ki_rusage_ch.ru_stime));
+ attrs = Fcons (Fcons (Qctime, make_lisp_time (t)), attrs);
+
+ attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (proc.ki_numthreads)),
+ attrs);
+ attrs = Fcons (Fcons (Qpri, make_number (proc.ki_pri.pri_native)), attrs);
+ attrs = Fcons (Fcons (Qnice, make_number (proc.ki_nice)), attrs);
+ attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.ki_start)), attrs);
+ attrs = Fcons (Fcons (Qvsize, make_number (proc.ki_size >> 10)), attrs);
+ attrs = Fcons (Fcons (Qrss, make_number (proc.ki_rssize * pagesize >> 10)),
+ attrs);
+
+ now = current_emacs_time ();
+ t = sub_emacs_time (now, timeval_to_EMACS_TIME (proc.ki_start));
+ attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs);
+
+ len = sizeof fscale;
+ if (sysctlbyname ("kern.fscale", &fscale, &len, NULL, 0) == 0)
+ {
+ double pcpu;
+ fixpt_t ccpu;
+ len = sizeof ccpu;
+ if (sysctlbyname ("kern.ccpu", &ccpu, &len, NULL, 0) == 0)
+ {
+ pcpu = (100.0 * proc.ki_pctcpu / fscale
+ / (1 - exp (proc.ki_swtime * log ((double) ccpu / fscale))));
+ attrs = Fcons (Fcons (Qpcpu, make_fixnum_or_float (pcpu)), attrs);
+ }
+ }
+
+ len = sizeof npages;
+ if (sysctlbyname ("hw.availpages", &npages, &len, NULL, 0) == 0)
+ {
+ double pmem = (proc.ki_flag & P_INMEM
+ ? 100.0 * proc.ki_rssize / npages
+ : 0);
+ attrs = Fcons (Fcons (Qpmem, make_fixnum_or_float (pmem)), attrs);
+ }
+
+ mib[2] = KERN_PROC_ARGS;
+ len = MAXPATHLEN;
+ if (sysctl (mib, 4, args, &len, NULL, 0) == 0)
+ {
+ int i;
+ for (i = 0; i < len; i++)
+ {
+ if (! args[i] && i < len - 1)
+ args[i] = ' ';
+ }
+
+ decoded_comm =
+ (code_convert_string_norecord
+ (build_unibyte_string (args),
+ Vlocale_coding_system, 0));
+
+ attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
+ }
+
+ UNGCPRO;
+ return attrs;
+}
+
/* The WINDOWSNT implementation is in w32.c.
The MSDOS implementation is in dosfns.c. */
#elif !defined (WINDOWSNT) && !defined (MSDOS)
diff --git a/src/sysselect.h b/src/sysselect.h
index 20eade8d07a..24bdf469ced 100644
--- a/src/sysselect.h
+++ b/src/sysselect.h
@@ -1,5 +1,5 @@
/* sysselect.h - System-dependent definitions for the select function.
- Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -16,14 +16,8 @@ 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/>. */
-#ifdef HAVE_SYS_SELECT_H
-#if defined (DARWIN_OS)
-#undef init_process
-#endif
+#ifndef DOS_NT
#include <sys/select.h>
-#if defined (DARWIN_OS)
-#define init_process emacs_init_process
-#endif
#endif
/* The w32 build defines select stuff in w32.h, which is included
@@ -53,3 +47,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define select sys_select
#endif
+#ifdef MSDOS
+#define pselect sys_select
+#endif
diff --git a/src/syssignal.h b/src/syssignal.h
index 315400d8498..2bf2f046aa5 100644
--- a/src/syssignal.h
+++ b/src/syssignal.h
@@ -1,5 +1,6 @@
/* syssignal.h - System-dependent definitions for signals.
- Copyright (C) 1993, 1999, 2001-2011 Free Software Foundation, Inc.
+
+Copyright (C) 1993, 1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -16,7 +17,10 @@ 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/>. */
-extern void init_signals (void);
+#include <signal.h>
+#include <stdbool.h>
+
+extern void init_signals (bool);
#ifdef HAVE_PTHREAD
#include <pthread.h>
@@ -25,93 +29,31 @@ extern void init_signals (void);
#define FORWARD_SIGNAL_TO_MAIN_THREAD
#endif
-/* Don't #include <signal.h>. That header should always be #included
- before "config.h", because some configuration files (like s/hpux.h)
- indicate that SIGIO doesn't work by #undef-ing SIGIO. If this file
- #includes <signal.h>, then that will re-#define SIGIO and confuse
- things. */
-/* XXX This is not correct anymore, there is a BROKEN_SIGIO macro. */
-
-#define SIGMASKTYPE sigset_t
-
-#define SIGEMPTYMASK (empty_mask)
-extern sigset_t empty_mask;
-
-/* POSIX pretty much destroys any possibility of writing sigmask as a
- macro in standard C. We always define our own version because the
- predefined macro in Glibc 2.1 is only provided for compatibility for old
- programs that use int as signal mask type. */
-#undef sigmask
-#ifdef __GNUC__
-#define sigmask(SIG) \
- ({ \
- sigset_t _mask; \
- sigemptyset (&_mask); \
- sigaddset (&_mask, SIG); \
- _mask; \
- })
-#else /* ! defined (__GNUC__) */
-extern sigset_t sys_sigmask ();
-#define sigmask(SIG) (sys_sigmask (SIG))
-#endif /* ! defined (__GNUC__) */
-
-#undef sigpause
-#define sigpause(MASK) sigsuspend (&(MASK))
-
-#define sigblock(SIG) sys_sigblock (SIG)
-#define sigunblock(SIG) sys_sigunblock (SIG)
-#ifndef sigsetmask
-#define sigsetmask(SIG) sys_sigsetmask (SIG)
+#if defined HAVE_TIMER_SETTIME && defined SIGEV_SIGNAL
+# define HAVE_ITIMERSPEC
#endif
-#undef signal
-#define signal(SIG,ACT) sys_signal(SIG,ACT)
-
-/* Whether this is what all systems want or not, this is what
- appears to be assumed in the source, for example data.c:arith_error. */
-typedef void (*signal_handler_t) (int);
-signal_handler_t sys_signal (int signal_number, signal_handler_t action);
-sigset_t sys_sigblock (sigset_t new_mask);
-sigset_t sys_sigunblock (sigset_t new_mask);
-sigset_t sys_sigsetmask (sigset_t new_mask);
-#if ! (defined TIOCNOTTY || defined USG5 || defined CYGWIN)
-void croak (char *) NO_RETURN;
+#if (defined SIGPROF && !defined PROFILING \
+ && (defined HAVE_SETITIMER || defined HAVE_ITIMERSPEC))
+# define PROFILER_CPU_SUPPORT
#endif
-#define sys_sigdel(MASK,SIG) sigdelset (&MASK,SIG)
-
-#define sigfree() sigsetmask (SIGEMPTYMASK)
+extern sigset_t empty_mask;
-#if defined (SIGINFO) && defined (BROKEN_SIGINFO)
-#undef SIGINFO
-#endif
-#if defined (SIGIO) && defined (BROKEN_SIGIO)
-# undef SIGIO
-#endif
-#if defined (SIGPOLL) && defined (BROKEN_SIGPOLL)
-#undef SIGPOLL
-#endif
-#if defined (SIGTSTP) && defined (BROKEN_SIGTSTP)
-#undef SIGTSTP
-#endif
-#if defined (SIGURG) && defined (BROKEN_SIGURG)
-#undef SIGURG
-#endif
-#if defined (SIGAIO) && defined (BROKEN_SIGAIO)
-#undef SIGAIO
-#endif
-#if defined (SIGPTY) && defined (BROKEN_SIGPTY)
-#undef SIGPTY
-#endif
+typedef void (*signal_handler_t) (int);
+extern void emacs_sigaction_init (struct sigaction *, signal_handler_t);
+char const *safe_strsignal (int) ATTRIBUTE_CONST;
#if NSIG < NSIG_MINIMUM
-# ifdef NSIG
-# undef NSIG
-# endif
+# undef NSIG
# define NSIG NSIG_MINIMUM
#endif
+#ifndef emacs_raise
+# define emacs_raise(sig) raise (sig)
+#endif
+
/* On bsd, [man says] kill does not accept a negative number to kill a pgrp.
Must do that using the killpg call. */
#ifdef BSD_SYSTEM
@@ -133,30 +75,7 @@ void croak (char *) NO_RETURN;
#endif /* ! defined (SIGCLD) */
#ifndef HAVE_STRSIGNAL
-/* strsignal is in sysdep.c */
-char *strsignal (int);
+# define strsignal(sig) safe_strsignal (sig)
#endif
-#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
-extern pthread_t main_thread;
-#define SIGNAL_THREAD_CHECK(signo) \
- do { \
- if (!pthread_equal (pthread_self (), main_thread)) \
- { \
- /* POSIX says any thread can receive the signal. On GNU/Linux \
- that is not true, but for other systems (FreeBSD at least) \
- it is. So direct the signal to the correct thread and block \
- it from this thread. */ \
- sigset_t new_mask; \
- \
- sigemptyset (&new_mask); \
- sigaddset (&new_mask, signo); \
- pthread_sigmask (SIG_BLOCK, &new_mask, 0); \
- pthread_kill (main_thread, signo); \
- return; \
- } \
- } while (0)
-
-#else /* not FORWARD_SIGNAL_TO_MAIN_THREAD */
-#define SIGNAL_THREAD_CHECK(signo)
-#endif /* not FORWARD_SIGNAL_TO_MAIN_THREAD */
+void deliver_process_signal (int, signal_handler_t);
diff --git a/src/systime.h b/src/systime.h
index b90372dbe20..9ce7ce646fb 100644
--- a/src/systime.h
+++ b/src/systime.h
@@ -1,5 +1,5 @@
/* systime.h - System-dependent definitions for time manipulations.
- Copyright (C) 1993-1994, 2002-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 2002-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,15 +19,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef EMACS_SYSTIME_H
#define EMACS_SYSTIME_H
-#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
+#include <timespec.h>
+
+INLINE_HEADER_BEGIN
+#ifndef SYSTIME_INLINE
+# define SYSTIME_INLINE INLINE
#endif
#ifdef emacs
@@ -47,92 +43,107 @@ typedef unsigned long Time;
#endif
#endif
#endif
-
-/* EMACS_TIME is the type to use to represent temporal intervals -
- struct timeval on some systems, int on others. It can be passed as
- the timeout argument to the select system call.
-
- EMACS_SECS (TIME) is an rvalue for the seconds component of TIME.
- EMACS_SET_SECS (TIME, SECONDS) sets that to SECONDS.
-
- EMACS_HAS_USECS is defined if EMACS_TIME has a usecs component.
- EMACS_USECS (TIME) is an rvalue for the microseconds component of TIME.
- This returns zero if EMACS_TIME doesn't have a microseconds component.
- EMACS_SET_USECS (TIME, MICROSECONDS) sets that to MICROSECONDS.
- This does nothing if EMACS_TIME doesn't have a microseconds component.
-
- EMACS_SET_SECS_USECS (TIME, SECS, USECS) sets both components of TIME.
-
- EMACS_GET_TIME (TIME) stores the current system time in TIME, which
- should be an lvalue.
-
- EMACS_ADD_TIME (DEST, SRC1, SRC2) adds SRC1 to SRC2 and stores the
- result in DEST. SRC should not be negative.
-
- EMACS_SUB_TIME (DEST, SRC1, SRC2) subtracts SRC2 from SRC1 and
- stores the result in DEST. SRC should not be negative.
- EMACS_TIME_NEG_P (TIME) is true if TIME is negative.
-
-*/
-
-#ifdef HAVE_TIMEVAL
-
-#define EMACS_HAS_USECS
-
-#define EMACS_TIME struct timeval
-#define EMACS_SECS(time) ((time).tv_sec + 0)
-#define EMACS_USECS(time) ((time).tv_usec + 0)
-#define EMACS_SET_SECS(time, seconds) ((time).tv_sec = (seconds))
-#define EMACS_SET_USECS(time, microseconds) ((time).tv_usec = (microseconds))
-/* On SVR4, the compiler may complain if given this extra BSD arg. */
-#ifdef GETTIMEOFDAY_ONE_ARGUMENT
-#define EMACS_GET_TIME(time) gettimeofday (&(time))
-#else /* not GETTIMEOFDAY_ONE_ARGUMENT */
-/* Presumably the second arg is ignored. */
-#define EMACS_GET_TIME(time) gettimeofday (&(time), NULL)
-#endif /* not GETTIMEOFDAY_ONE_ARGUMENT */
-
-#define EMACS_ADD_TIME(dest, src1, src2) \
- do { \
- (dest).tv_sec = (src1).tv_sec + (src2).tv_sec; \
- (dest).tv_usec = (src1).tv_usec + (src2).tv_usec; \
- if ((dest).tv_usec > 1000000) \
- (dest).tv_usec -= 1000000, (dest).tv_sec++; \
- } while (0)
-
-#define EMACS_SUB_TIME(dest, src1, src2) \
- do { \
- (dest).tv_sec = (src1).tv_sec - (src2).tv_sec; \
- (dest).tv_usec = (src1).tv_usec - (src2).tv_usec; \
- if ((dest).tv_usec < 0) \
- (dest).tv_usec += 1000000, (dest).tv_sec--; \
- } while (0)
-
-#define EMACS_TIME_NEG_P(time) \
- ((long)(time).tv_sec < 0 \
- || ((time).tv_sec == 0 \
- && (long)(time).tv_usec < 0))
-
-#else /* ! defined (HAVE_TIMEVAL) */
-
-#define EMACS_TIME int
-#define EMACS_SECS(time) (time)
-#define EMACS_USECS(time) 0
-#define EMACS_SET_SECS(time, seconds) ((time) = (seconds))
-#define EMACS_SET_USECS(time, usecs) 0
-
-#define EMACS_GET_TIME(t) ((t) = time ((long *) 0))
-#define EMACS_ADD_TIME(dest, src1, src2) ((dest) = (src1) + (src2))
-#define EMACS_SUB_TIME(dest, src1, src2) ((dest) = (src1) - (src2))
-#define EMACS_TIME_NEG_P(t) ((t) < 0)
-
-#endif /* ! defined (HAVE_TIMEVAL) */
-
-#define EMACS_SET_SECS_USECS(time, secs, usecs) \
- (EMACS_SET_SECS (time, secs), EMACS_SET_USECS (time, usecs))
-
-extern int set_file_times (const char *, EMACS_TIME, EMACS_TIME);
+#include <sys/time.h> /* for 'struct timeval' */
+
+/* The type to use to represent non-negative temporal intervals. Its
+ address can be passed as the timeout argument to the pselect system
+ call. */
+typedef struct timespec EMACS_TIME;
+
+/* Resolution of EMACS_TIME time stamps (in units per second), and log
+ base 10 of the resolution. The log must be a positive integer. */
+enum { EMACS_TIME_RESOLUTION = 1000000000 };
+enum { LOG10_EMACS_TIME_RESOLUTION = 9 };
+
+/* EMACS_SECS (TIME) is the seconds component of TIME.
+ EMACS_NSECS (TIME) is the nanoseconds component of TIME.
+ emacs_secs_addr (PTIME) is the address of *PTIME's seconds component. */
+SYSTIME_INLINE time_t EMACS_SECS (EMACS_TIME t) { return t.tv_sec; }
+SYSTIME_INLINE int EMACS_NSECS (EMACS_TIME t) { return t.tv_nsec; }
+SYSTIME_INLINE time_t *emacs_secs_addr (EMACS_TIME *t) { return &t->tv_sec; }
+
+/* Return an Emacs time with seconds S and nanoseconds NS. */
+SYSTIME_INLINE EMACS_TIME
+make_emacs_time (time_t s, int ns)
+{
+ EMACS_TIME r = { s, ns };
+ return r;
+}
+
+/* Return an invalid Emacs time. */
+SYSTIME_INLINE EMACS_TIME
+invalid_emacs_time (void)
+{
+ EMACS_TIME r = { 0, -1 };
+ return r;
+}
+
+/* Return current system time. */
+SYSTIME_INLINE EMACS_TIME
+current_emacs_time (void)
+{
+ EMACS_TIME r;
+ gettime (&r);
+ return r;
+}
+
+/* Return the result of adding A to B, or of subtracting B from A.
+ On overflow, store an extremal value: ergo, if time_t is unsigned,
+ return 0 if the true answer would be negative.
+
+ WARNING: These are NOT general-purpose macros for adding or
+ subtracting arbitrary time values! They are generally intended to
+ be used with their first argument an absolute time since the epoch
+ and the second argument a non-negative offset. Do NOT use them for
+ anything else. */
+SYSTIME_INLINE EMACS_TIME
+add_emacs_time (EMACS_TIME a, EMACS_TIME b)
+{
+ return timespec_add (a, b);
+}
+SYSTIME_INLINE EMACS_TIME
+sub_emacs_time (EMACS_TIME a, EMACS_TIME b)
+{
+ return timespec_sub (a, b);
+}
+
+/* Return the sign of the valid time stamp TIME, either -1, 0, or 1.
+ Note: this can only return a negative value if time_t is a signed
+ data type. */
+SYSTIME_INLINE int
+EMACS_TIME_SIGN (EMACS_TIME t)
+{
+ return timespec_sign (t);
+}
+
+/* Return 1 if TIME is a valid time stamp. */
+SYSTIME_INLINE int
+EMACS_TIME_VALID_P (EMACS_TIME t)
+{
+ return 0 <= t.tv_nsec;
+}
+
+/* Convert the double D to the greatest EMACS_TIME not greater than D.
+ On overflow, return an extremal value; in particular, if time_t is
+ an unsigned data type and D is negative, return zero. Return the
+ minimum EMACS_TIME if D is not a number. */
+SYSTIME_INLINE EMACS_TIME
+EMACS_TIME_FROM_DOUBLE (double d)
+{
+ return dtotimespec (d);
+}
+
+/* Convert the Emacs time T to an approximate double value D. */
+SYSTIME_INLINE double
+EMACS_TIME_TO_DOUBLE (EMACS_TIME t)
+{
+ return timespectod (t);
+}
+
+/* defined in sysdep.c */
+extern int set_file_times (int, const char *, EMACS_TIME, EMACS_TIME);
+extern struct timeval make_timeval (EMACS_TIME);
/* defined in keyboard.c */
extern void set_waiting_for_input (EMACS_TIME *);
@@ -141,29 +152,45 @@ extern void set_waiting_for_input (EMACS_TIME *);
happen when this files is used outside the src directory).
Use GCPRO1 to determine if lisp.h was included. */
#ifdef GCPRO1
-/* defined in editfns.c*/
-extern Lisp_Object make_time (time_t);
-extern int lisp_time_argument (Lisp_Object, time_t *, int *);
+/* defined in editfns.c */
+extern Lisp_Object make_lisp_time (EMACS_TIME);
+extern bool decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object, EMACS_TIME *, double *);
+extern EMACS_TIME lisp_time_argument (Lisp_Object);
#endif
-/* Compare times T1 and T2. Value is 0 if T1 and T2 are the same.
- Value is < 0 if T1 is less than T2. Value is > 0 otherwise. (Cast
- to long is for those platforms where time_t is an unsigned
- type, and where otherwise T1 will always be grater than T2.) */
-
-#define EMACS_TIME_CMP(T1, T2) \
- ((long)EMACS_SECS (T1) - (long)EMACS_SECS (T2) \
- + (EMACS_SECS (T1) == EMACS_SECS (T2) \
- ? EMACS_USECS (T1) - EMACS_USECS (T2) \
- : 0))
-
/* Compare times T1 and T2 for equality, inequality etc. */
-
-#define EMACS_TIME_EQ(T1, T2) (EMACS_TIME_CMP (T1, T2) == 0)
-#define EMACS_TIME_NE(T1, T2) (EMACS_TIME_CMP (T1, T2) != 0)
-#define EMACS_TIME_GT(T1, T2) (EMACS_TIME_CMP (T1, T2) > 0)
-#define EMACS_TIME_GE(T1, T2) (EMACS_TIME_CMP (T1, T2) >= 0)
-#define EMACS_TIME_LT(T1, T2) (EMACS_TIME_CMP (T1, T2) < 0)
-#define EMACS_TIME_LE(T1, T2) (EMACS_TIME_CMP (T1, T2) <= 0)
+SYSTIME_INLINE int
+EMACS_TIME_EQ (EMACS_TIME t1, EMACS_TIME t2)
+{
+ return timespec_cmp (t1, t2) == 0;
+}
+SYSTIME_INLINE int
+EMACS_TIME_NE (EMACS_TIME t1, EMACS_TIME t2)
+{
+ return timespec_cmp (t1, t2) != 0;
+}
+SYSTIME_INLINE int
+EMACS_TIME_GT (EMACS_TIME t1, EMACS_TIME t2)
+{
+ return timespec_cmp (t1, t2) > 0;
+}
+SYSTIME_INLINE int
+EMACS_TIME_GE (EMACS_TIME t1, EMACS_TIME t2)
+{
+ return timespec_cmp (t1, t2) >= 0;
+}
+SYSTIME_INLINE int
+EMACS_TIME_LT (EMACS_TIME t1, EMACS_TIME t2)
+{
+ return timespec_cmp (t1, t2) < 0;
+}
+SYSTIME_INLINE int
+EMACS_TIME_LE (EMACS_TIME t1, EMACS_TIME t2)
+{
+ return timespec_cmp (t1, t2) <= 0;
+}
+
+INLINE_HEADER_END
#endif /* EMACS_SYSTIME_H */
diff --git a/src/systty.h b/src/systty.h
index 647cfa23cee..80bcaedf740 100644
--- a/src/systty.h
+++ b/src/systty.h
@@ -1,5 +1,5 @@
/* systty.h - System-dependent definitions for terminals.
- Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -17,10 +17,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/>. */
/* Include the proper files. */
+
#ifndef DOS_NT
-#ifndef NO_TERMIO
-#include <termio.h>
-#endif /* not NO_TERMIO */
#include <termios.h>
#include <fcntl.h>
#endif /* not DOS_NT */
@@ -39,20 +37,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <unistd.h>
-/* Special cases - inhibiting the use of certain features. */
-
-/* Allow m- file to inhibit use of FIONREAD. */
-#ifdef BROKEN_FIONREAD
-#undef FIONREAD
-#undef ASYNC
-#endif
-
-/* Interrupt input is not used if there is no FIONREAD. */
-#ifndef FIONREAD
-#undef SIGIO
-#endif
-
-
/* Try to establish the correct character to disable terminal functions
in a system-independent manner. Note that USG (at least) define
_POSIX_VDISABLE as 0! */
@@ -68,27 +52,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif /* not CDEL */
#endif /* not _POSIX_VDISABLE */
-/* Get the number of characters queued for output. */
-
-/* EMACS_OUTQSIZE(FD, int *SIZE) stores the number of characters
- queued for output to the terminal FD in *SIZE, if FD is a tty.
- Returns -1 if there was an error (i.e. FD is not a tty), 0
- otherwise. */
-#ifdef TIOCOUTQ
-#define EMACS_OUTQSIZE(fd, size) (ioctl ((fd), TIOCOUTQ, (size)))
-#endif
-
-
-/* Manipulate a terminal's current process group. */
-
-/* EMACS_GETPGRP (arg) returns the process group of the process. */
-
-#if defined (GETPGRP_VOID)
-# define EMACS_GETPGRP(x) getpgrp()
-#else /* !GETPGRP_VOID */
-# define EMACS_GETPGRP(x) getpgrp(x)
-#endif /* !GETPGRP_VOID */
-
/* Manipulate a TTY's input/output processing parameters. */
/* struct emacs_tty is a structure used to hold the current tty
diff --git a/src/syswait.h b/src/syswait.h
index 44a824abadb..aa4c4bcf527 100644
--- a/src/syswait.h
+++ b/src/syswait.h
@@ -1,5 +1,5 @@
/* Define wait system call interface for Emacs.
- Copyright (C) 1993-1995, 2000-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1995, 2000-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -51,9 +51,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define WTERMSIG(status) ((status) & 0x7f)
#endif
-#undef WRETCODE
-#define WRETCODE(status) WEXITSTATUS (status)
+/* Defined in process.c. */
+extern void record_child_status_change (pid_t, int);
+/* Defined in sysdep.c. */
+extern void wait_for_termination (pid_t);
+extern void interruptible_wait_for_termination (pid_t);
#endif /* EMACS_SYSWAIT_H */
-
diff --git a/src/term.c b/src/term.c
index ae505f020f2..481a3423989 100644
--- a/src/term.c
+++ b/src/term.c
@@ -1,5 +1,5 @@
/* Terminal control module for terminals described by TERMCAP
- Copyright (C) 1985-1987, 1993-1995, 1998, 2000-2011
+ Copyright (C) 1985-1987, 1993-1995, 1998, 2000-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -20,20 +20,18 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* New redisplay, TTY faces by Gerd Moellmann <gerd@gnu.org>. */
#include <config.h>
-#include <stdio.h>
-#include <ctype.h>
#include <errno.h>
+#include <fcntl.h>
+#include <stdio.h>
#include <sys/file.h>
+#include <sys/time.h>
#include <unistd.h>
-#include <signal.h>
-#include <setjmp.h>
#include "lisp.h"
#include "termchar.h"
-#include "termopts.h"
#include "tparam.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "coding.h"
#include "composite.h"
@@ -58,17 +56,10 @@ static int been_here = -1;
#include "xterm.h"
#endif
-#ifndef O_RDWR
-#define O_RDWR 2
-#endif
-
-#ifndef O_NOCTTY
-#define O_NOCTTY 0
-#endif
-
/* The name of the default console device. */
#ifdef WINDOWSNT
#define DEV_TTY "CONOUT$"
+#include "w32term.h"
#else
#define DEV_TTY "/dev/tty"
#endif
@@ -85,11 +76,11 @@ static void clear_tty_hooks (struct terminal *terminal);
static void set_tty_hooks (struct terminal *terminal);
static void dissociate_if_controlling_tty (int fd);
static void delete_tty (struct terminal *);
-static void maybe_fatal (int must_succeed, struct terminal *terminal,
- const char *str1, const char *str2, ...)
- NO_RETURN ATTRIBUTE_FORMAT_PRINTF (3, 5) ATTRIBUTE_FORMAT_PRINTF (4, 5);
-static void vfatal (const char *str, va_list ap)
- NO_RETURN ATTRIBUTE_FORMAT_PRINTF (1, 0);
+static _Noreturn void maybe_fatal (int must_succeed, struct terminal *terminal,
+ const char *str1, const char *str2, ...)
+ ATTRIBUTE_FORMAT_PRINTF (3, 5) ATTRIBUTE_FORMAT_PRINTF (4, 5);
+static _Noreturn void vfatal (const char *str, va_list ap)
+ ATTRIBUTE_FORMAT_PRINTF (1, 0);
#define OUTPUT(tty, a) \
@@ -122,12 +113,11 @@ enum no_color_bit
NC_STANDOUT = 1 << 0,
NC_UNDERLINE = 1 << 1,
NC_REVERSE = 1 << 2,
- NC_BLINK = 1 << 3,
+ NC_ITALIC = 1 << 3,
NC_DIM = 1 << 4,
NC_BOLD = 1 << 5,
NC_INVIS = 1 << 6,
- NC_PROTECT = 1 << 7,
- NC_ALT_CHARSET = 1 << 8
+ NC_PROTECT = 1 << 7
};
/* internal state */
@@ -136,10 +126,6 @@ enum no_color_bit
static int max_frame_cols;
-/* Non-zero if we have dropped our controlling tty and therefore
- should not open a frame on stdout. */
-static int no_controlling_tty;
-
#ifdef HAVE_GPM
@@ -756,13 +742,13 @@ tty_write_glyphs (struct frame *f, struct glyph *string, int len)
conversion_buffer = encode_terminal_code (string, n, coding);
if (coding->produced > 0)
{
- BLOCK_INPUT;
+ block_input ();
fwrite (conversion_buffer, 1, coding->produced, tty->output);
if (ferror (tty->output))
clearerr (tty->output);
if (tty->termscript)
fwrite (conversion_buffer, 1, coding->produced, tty->termscript);
- UNBLOCK_INPUT;
+ unblock_input ();
}
string += n;
@@ -817,13 +803,13 @@ tty_write_glyphs_with_face (register struct frame *f, register struct glyph *str
conversion_buffer = encode_terminal_code (string, len, coding);
if (coding->produced > 0)
{
- BLOCK_INPUT;
+ block_input ();
fwrite (conversion_buffer, 1, coding->produced, tty->output);
if (ferror (tty->output))
clearerr (tty->output);
if (tty->termscript)
fwrite (conversion_buffer, 1, coding->produced, tty->termscript);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Turn appearance modes off. */
@@ -903,13 +889,13 @@ tty_insert_glyphs (struct frame *f, struct glyph *start, int len)
if (coding->produced > 0)
{
- BLOCK_INPUT;
+ block_input ();
fwrite (conversion_buffer, 1, coding->produced, tty->output);
if (ferror (tty->output))
clearerr (tty->output);
if (tty->termscript)
fwrite (conversion_buffer, 1, coding->produced, tty->termscript);
- UNBLOCK_INPUT;
+ unblock_input ();
}
OUTPUT1_IF (tty, tty->TS_pad_inserted_char);
@@ -1333,7 +1319,7 @@ term_get_fkeys_1 (void)
/* This can happen if CANNOT_DUMP or with strange options. */
if (!KEYMAPP (KVAR (kboard, Vinput_decode_map)))
- KVAR (kboard, Vinput_decode_map) = Fmake_sparse_keymap (Qnil);
+ kset_input_decode_map (kboard, Fmake_sparse_keymap (Qnil));
for (i = 0; i < (sizeof (keys)/sizeof (keys[0])); i++)
{
@@ -1459,7 +1445,7 @@ append_glyph (struct it *it)
struct glyph *glyph, *end;
int i;
- xassert (it->glyph_row);
+ eassert (it->glyph_row);
glyph = (it->glyph_row->glyphs[it->area]
+ it->glyph_row->used[it->area]);
end = it->glyph_row->glyphs[1 + it->area];
@@ -1499,7 +1485,7 @@ append_glyph (struct it *it)
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
else
@@ -1546,7 +1532,7 @@ produce_glyphs (struct it *it)
/* If a hook is installed, let it do the work. */
/* Nothing but characters are supported on terminal frames. */
- xassert (it->what == IT_CHARACTER
+ eassert (it->what == IT_CHARACTER
|| it->what == IT_COMPOSITION
|| it->what == IT_STRETCH
|| it->what == IT_GLYPHLESS);
@@ -1633,7 +1619,7 @@ produce_glyphs (struct it *it)
{
Lisp_Object acronym = lookup_glyphless_char_display (-1, it);
- xassert (it->what == IT_GLYPHLESS);
+ eassert (it->what == IT_GLYPHLESS);
produce_glyphless_glyph (it, 1, acronym);
}
}
@@ -1657,7 +1643,7 @@ append_composite_glyph (struct it *it)
{
struct glyph *glyph;
- xassert (it->glyph_row);
+ eassert (it->glyph_row);
glyph = it->glyph_row->glyphs[it->area] + it->glyph_row->used[it->area];
if (glyph < it->glyph_row->glyphs[1 + it->area])
{
@@ -1696,7 +1682,7 @@ append_composite_glyph (struct it *it)
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
else
@@ -1749,7 +1735,7 @@ append_glyphless_glyph (struct it *it, int face_id, const char *str)
struct glyph *glyph, *end;
int i;
- xassert (it->glyph_row);
+ eassert (it->glyph_row);
glyph = it->glyph_row->glyphs[it->area] + it->glyph_row->used[it->area];
end = it->glyph_row->glyphs[1 + it->area];
@@ -1781,7 +1767,7 @@ append_glyphless_glyph (struct it *it, int face_id, const char *str)
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
else
@@ -1809,7 +1795,7 @@ append_glyphless_glyph (struct it *it, int face_id, const char *str)
glyphless_display_method in dispextern.h for the details.
FOR_NO_FONT is nonzero if and only if this is for a character that
- is not supproted by the coding system of the terminal. ACRONYM, if
+ is not supported by the coding system of the terminal. ACRONYM, if
non-nil, is an acronym string for the character.
The glyphs actually produced are of type CHAR_GLYPH. */
@@ -1851,8 +1837,7 @@ produce_glyphless_glyph (struct it *it, int for_no_font, Lisp_Object acronym)
len = 1;
else if (len > 4)
len = 4;
- sprintf (buf, "[%.*s]", len, str);
- len += 2;
+ len = sprintf (buf, "[%.*s]", len, str);
str = buf;
}
else
@@ -1872,7 +1857,7 @@ produce_glyphless_glyph (struct it *it, int for_no_font, Lisp_Object acronym)
}
else
{
- xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE);
+ eassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE);
len = (it->c < 0x10000 ? sprintf (buf, "\\u%04X", it->c)
: it->c <= MAX_UNICODE_CHAR ? sprintf (buf, "\\U%06X", it->c)
: sprintf (buf, "\\x%06X", it->c));
@@ -1886,69 +1871,6 @@ produce_glyphless_glyph (struct it *it, int for_no_font, Lisp_Object acronym)
append_glyphless_glyph (it, face_id, str);
}
-
-/* Get information about special display element WHAT in an
- environment described by IT. WHAT is one of IT_TRUNCATION or
- IT_CONTINUATION. Maybe produce glyphs for WHAT if IT has a
- non-null glyph_row member. This function ensures that fields like
- face_id, c, len of IT are left untouched. */
-
-void
-produce_special_glyphs (struct it *it, enum display_element_type what)
-{
- struct it temp_it;
- Lisp_Object gc;
- GLYPH glyph;
-
- temp_it = *it;
- temp_it.dp = NULL;
- temp_it.what = IT_CHARACTER;
- temp_it.len = 1;
- temp_it.object = make_number (0);
- memset (&temp_it.current, 0, sizeof temp_it.current);
-
- if (what == IT_CONTINUATION)
- {
- /* Continuation glyph. For R2L lines, we mirror it by hand. */
- if (it->bidi_it.paragraph_dir == R2L)
- SET_GLYPH_FROM_CHAR (glyph, '/');
- else
- SET_GLYPH_FROM_CHAR (glyph, '\\');
- if (it->dp
- && (gc = DISP_CONTINUE_GLYPH (it->dp), GLYPH_CODE_P (gc))
- && GLYPH_CODE_CHAR_VALID_P (gc))
- {
- /* FIXME: Should we mirror GC for R2L lines? */
- SET_GLYPH_FROM_GLYPH_CODE (glyph, gc);
- spec_glyph_lookup_face (XWINDOW (it->window), &glyph);
- }
- }
- else if (what == IT_TRUNCATION)
- {
- /* Truncation glyph. */
- SET_GLYPH_FROM_CHAR (glyph, '$');
- if (it->dp
- && (gc = DISP_TRUNC_GLYPH (it->dp), GLYPH_CODE_P (gc))
- && GLYPH_CODE_CHAR_VALID_P (gc))
- {
- /* FIXME: Should we mirror GC for R2L lines? */
- SET_GLYPH_FROM_GLYPH_CODE (glyph, gc);
- spec_glyph_lookup_face (XWINDOW (it->window), &glyph);
- }
- }
- else
- abort ();
-
- temp_it.c = temp_it.char_to_display = GLYPH_CHAR (glyph);
- temp_it.face_id = GLYPH_FACE (glyph);
- temp_it.len = CHAR_BYTES (temp_it.c);
-
- produce_glyphs (&temp_it);
- it->pixel_width = temp_it.pixel_width;
- it->nglyphs = temp_it.pixel_width;
-}
-
-
/***********************************************************************
Faces
@@ -2024,17 +1946,16 @@ turn_on_face (struct frame *f, int face_id)
if (face->tty_bold_p && MAY_USE_WITH_COLORS_P (tty, NC_BOLD))
OUTPUT1_IF (tty, tty->TS_enter_bold_mode);
- if (face->tty_dim_p && MAY_USE_WITH_COLORS_P (tty, NC_DIM))
- OUTPUT1_IF (tty, tty->TS_enter_dim_mode);
-
- /* Alternate charset and blinking not yet used. */
- if (face->tty_alt_charset_p
- && MAY_USE_WITH_COLORS_P (tty, NC_ALT_CHARSET))
- OUTPUT1_IF (tty, tty->TS_enter_alt_charset_mode);
-
- if (face->tty_blinking_p
- && MAY_USE_WITH_COLORS_P (tty, NC_BLINK))
- OUTPUT1_IF (tty, tty->TS_enter_blink_mode);
+ if (face->tty_italic_p && MAY_USE_WITH_COLORS_P (tty, NC_ITALIC))
+ {
+ if (tty->TS_enter_italic_mode)
+ OUTPUT1 (tty, tty->TS_enter_italic_mode);
+ else
+ /* Italics mode is unavailable on many terminals. In that
+ case, map slant to dimmed text; we want italic text to
+ appear different and dimming is not otherwise used. */
+ OUTPUT1 (tty, tty->TS_enter_dim_mode);
+ }
if (face->tty_underline_p && MAY_USE_WITH_COLORS_P (tty, NC_UNDERLINE))
OUTPUT1_IF (tty, tty->TS_enter_underline_mode);
@@ -2071,7 +1992,7 @@ turn_off_face (struct frame *f, int face_id)
struct face *face = FACE_FROM_ID (f, face_id);
struct tty_display_info *tty = FRAME_TTY (f);
- xassert (face != NULL);
+ eassert (face != NULL);
if (tty->TS_exit_attribute_mode)
{
@@ -2079,27 +2000,19 @@ turn_off_face (struct frame *f, int face_id)
half-bright, reverse-video, standout, underline. It may or
may not turn off alt-char-mode. */
if (face->tty_bold_p
- || face->tty_dim_p
+ || face->tty_italic_p
|| face->tty_reverse_p
- || face->tty_alt_charset_p
- || face->tty_blinking_p
|| face->tty_underline_p)
{
OUTPUT1_IF (tty, tty->TS_exit_attribute_mode);
if (strcmp (tty->TS_exit_attribute_mode, tty->TS_end_standout_mode) == 0)
tty->standout_mode = 0;
}
-
- if (face->tty_alt_charset_p)
- OUTPUT_IF (tty, tty->TS_exit_alt_charset_mode);
}
else
{
/* If we don't have "me" we can only have those appearances
that have exit sequences defined. */
- if (face->tty_alt_charset_p)
- OUTPUT_IF (tty, tty->TS_exit_alt_charset_mode);
-
if (face->tty_underline_p)
OUTPUT_IF (tty, tty->TS_exit_underline_mode);
}
@@ -2130,8 +2043,7 @@ tty_capable_p (struct tty_display_info *tty, unsigned int caps,
TTY_CAPABLE_P_TRY (tty, TTY_CAP_UNDERLINE, tty->TS_enter_underline_mode, NC_UNDERLINE);
TTY_CAPABLE_P_TRY (tty, TTY_CAP_BOLD, tty->TS_enter_bold_mode, NC_BOLD);
TTY_CAPABLE_P_TRY (tty, TTY_CAP_DIM, tty->TS_enter_dim_mode, NC_DIM);
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_BLINK, tty->TS_enter_blink_mode, NC_BLINK);
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_ALT_CHARSET, tty->TS_enter_alt_charset_mode, NC_ALT_CHARSET);
+ TTY_CAPABLE_P_TRY (tty, TTY_CAP_ITALIC, tty->TS_enter_italic_mode, NC_ITALIC);
/* We can do it! */
return 1;
@@ -2145,7 +2057,7 @@ DEFUN ("tty-display-color-p", Ftty_display_color_p, Stty_display_color_p,
TERMINAL can be a terminal object, a frame, or nil (meaning the
selected frame's terminal). This function always returns nil if
-TERMINAL does not refer to a text-only terminal. */)
+TERMINAL does not refer to a text terminal. */)
(Lisp_Object terminal)
{
struct terminal *t = get_tty_terminal (terminal, 0);
@@ -2162,7 +2074,7 @@ DEFUN ("tty-display-color-cells", Ftty_display_color_cells,
TERMINAL can be a terminal object, a frame, or nil (meaning the
selected frame's terminal). This function always returns 0 if
-TERMINAL does not refer to a text-only terminal. */)
+TERMINAL does not refer to a text terminal. */)
(Lisp_Object terminal)
{
struct terminal *t = get_tty_terminal (terminal, 0);
@@ -2279,15 +2191,14 @@ set_tty_color_mode (struct tty_display_info *tty, struct frame *f)
else
color_mode = Qnil;
- mode = INTEGERP (color_mode) ? XINT (color_mode) : 0;
+ mode = TYPE_RANGED_INTEGERP (int, color_mode) ? XINT (color_mode) : 0;
if (mode != tty->previous_color_mode)
{
- Lisp_Object funsym = intern ("tty-set-up-initial-frame-faces");
tty->previous_color_mode = mode;
tty_setup_colors (tty , mode);
/* This recomputes all the faces given the new color definitions. */
- safe_call (1, &funsym);
+ safe_call (1, intern ("tty-set-up-initial-frame-faces"));
}
}
@@ -2326,7 +2237,7 @@ get_named_tty (const char *name)
struct terminal *t;
if (!name)
- abort ();
+ emacs_abort ();
for (t = terminal_list; t; t = t->next_terminal)
{
@@ -2384,7 +2295,7 @@ no effect if used on a non-tty terminal.
TERMINAL can be a terminal object, a frame or nil (meaning the
selected frame's terminal). This function always returns nil if
-TERMINAL does not refer to a text-only terminal. */)
+TERMINAL does not refer to a text terminal. */)
(Lisp_Object terminal)
{
struct terminal *t = get_terminal (terminal, 1);
@@ -2394,6 +2305,21 @@ TERMINAL does not refer to a text-only terminal. */)
return Qnil;
}
+DEFUN ("tty-top-frame", Ftty_top_frame, Stty_top_frame, 0, 1, 0,
+ doc: /* Return the topmost terminal frame on TERMINAL.
+TERMINAL can be a terminal object, a frame or nil (meaning the
+selected frame's terminal). This function returns nil if TERMINAL
+does not refer to a text terminal. Otherwise, it returns the
+top-most frame on the text terminal. */)
+ (Lisp_Object terminal)
+{
+ struct terminal *t = get_terminal (terminal, 1);
+
+ if (t->type == output_termcap)
+ return t->display_info.tty->top_frame;
+ return Qnil;
+}
+
DEFUN ("suspend-tty", Fsuspend_tty, Ssuspend_tty, 0, 1, 0,
@@ -2609,6 +2535,18 @@ term_mouse_movement (FRAME_PTR frame, Gpm_Event *event)
return 0;
}
+/* Return the Time that corresponds to T. Wrap around on overflow. */
+static Time
+timeval_to_Time (struct timeval const *t)
+{
+ Time s_1000, ms;
+
+ s_1000 = t->tv_sec;
+ s_1000 *= 1000;
+ ms = t->tv_usec / 1000;
+ return s_1000 + ms;
+}
+
/* Return the current position of the mouse.
Set *f to the frame the mouse is in, or zero if the mouse is in no
@@ -2628,7 +2566,6 @@ term_mouse_position (FRAME_PTR *fp, int insist, Lisp_Object *bar_window,
Lisp_Object *y, Time *timeptr)
{
struct timeval now;
- Time sec, usec;
*fp = SELECTED_FRAME ();
(*fp)->mouse_moved = 0;
@@ -2639,9 +2576,7 @@ term_mouse_position (FRAME_PTR *fp, int insist, Lisp_Object *bar_window,
XSETINT (*x, last_mouse_x);
XSETINT (*y, last_mouse_y);
gettimeofday(&now, 0);
- sec = now.tv_sec;
- usec = now.tv_usec;
- *timeptr = (sec * 1000) + (usec / 1000);
+ *timeptr = timeval_to_Time (&now);
}
/* Prepare a mouse-event in *RESULT for placement in the input queue.
@@ -2665,7 +2600,7 @@ term_mouse_click (struct input_event *result, Gpm_Event *event,
}
}
gettimeofday(&now, 0);
- result->timestamp = (now.tv_sec * 1000) + (now.tv_usec / 1000);
+ result->timestamp = timeval_to_Time (&now);
if (event->type & GPM_UP)
result->modifiers = up_modifier;
@@ -2847,13 +2782,10 @@ DEFUN ("gpm-mouse-stop", Fgpm_mouse_stop, Sgpm_mouse_stop,
void
create_tty_output (struct frame *f)
{
- struct tty_output *t;
+ struct tty_output *t = xzalloc (sizeof *t);
if (! FRAME_TERMCAP_P (f))
- abort ();
-
- t = xmalloc (sizeof (struct tty_output));
- memset (t, 0, sizeof (struct tty_output));
+ emacs_abort ();
t->display_info = FRAME_TERMINAL (f)->display_info.tty;
@@ -2866,7 +2798,7 @@ static void
tty_free_frame_resources (struct frame *f)
{
if (! FRAME_TERMCAP_P (f))
- abort ();
+ emacs_abort ();
if (FRAME_FACE_CACHE (f))
free_frame_faces (f);
@@ -2882,7 +2814,7 @@ static void
tty_free_frame_resources (struct frame *f)
{
if (! FRAME_TERMCAP_P (f) && ! FRAME_MSDOS_P (f))
- abort ();
+ emacs_abort ();
if (FRAME_FACE_CACHE (f))
free_frame_faces (f);
@@ -2975,34 +2907,9 @@ set_tty_hooks (struct terminal *terminal)
static void
dissociate_if_controlling_tty (int fd)
{
-#ifndef DOS_NT
- int pgid = tcgetpgrp (fd); /* If tcgetpgrp succeeds, fd is the ctty. */
- if (pgid != -1)
- {
-#if defined (USG5)
- setpgrp ();
- no_controlling_tty = 1;
-#elif defined (CYGWIN)
- setsid ();
- no_controlling_tty = 1;
-#else
-#ifdef TIOCNOTTY /* Try BSD ioctls. */
- sigblock (sigmask (SIGTTOU));
- fd = emacs_open (DEV_TTY, O_RDWR, 0);
- if (fd != -1 && ioctl (fd, TIOCNOTTY, 0) != -1)
- {
- no_controlling_tty = 1;
- }
- if (fd != -1)
- emacs_close (fd);
- sigunblock (sigmask (SIGTTOU));
-#else
- /* Unknown system. */
- croak ();
-#endif /* ! TIOCNOTTY */
-#endif /* ! USG */
- }
-#endif /* !DOS_NT */
+ pid_t pgid = tcgetpgrp (fd); /* If tcgetpgrp succeeds, fd is the ctty. */
+ if (0 <= pgid)
+ setsid ();
}
/* Create a termcap display on the tty device with the given name and
@@ -3054,9 +2961,9 @@ init_tty (const char *name, const char *terminal_type, int must_succeed)
been_here = 1;
tty = &the_only_display_info;
#else
- tty = (struct tty_display_info *) xmalloc (sizeof (struct tty_display_info));
+ tty = xzalloc (sizeof *tty);
#endif
- memset (tty, 0, sizeof (struct tty_display_info));
+ tty->top_frame = Qnil;
tty->next = tty_list;
tty_list = tty;
@@ -3064,7 +2971,7 @@ init_tty (const char *name, const char *terminal_type, int must_succeed)
terminal->display_info.tty = tty;
tty->terminal = terminal;
- tty->Wcm = (struct cm *) xmalloc (sizeof (struct cm));
+ tty->Wcm = xmalloc (sizeof *tty->Wcm);
Wcm_clear (tty);
encode_terminal_src_size = 0;
@@ -3075,22 +2982,18 @@ init_tty (const char *name, const char *terminal_type, int must_succeed)
set_tty_hooks (terminal);
{
- int fd;
+ /* Open the terminal device. */
FILE *file;
-#ifdef O_IGNORE_CTTY
- if (!ctty)
- /* Open the terminal device. Don't recognize it as our
- controlling terminal, and don't make it the controlling tty
- if we don't have one at the moment. */
- fd = emacs_open (name, O_RDWR | O_IGNORE_CTTY | O_NOCTTY, 0);
- else
-#endif /* O_IGNORE_CTTY */
- /* Alas, O_IGNORE_CTTY is a GNU extension that seems to be only
- defined on Hurd. On other systems, we need to explicitly
- dissociate ourselves from the controlling tty when we want to
- open a frame on the same terminal. */
- fd = emacs_open (name, O_RDWR | O_NOCTTY, 0);
+ /* If !ctty, don't recognize it as our controlling terminal, and
+ don't make it the controlling tty if we don't have one now.
+
+ Alas, O_IGNORE_CTTY is a GNU extension that seems to be only
+ defined on Hurd. On other systems, we need to explicitly
+ dissociate ourselves from the controlling tty when we want to
+ open a frame on the same terminal. */
+ int flags = O_RDWR | O_NOCTTY | (ctty ? 0 : O_IGNORE_CTTY);
+ int fd = emacs_open (name, flags, 0);
tty->name = xstrdup (name);
terminal->name = xstrdup (name);
@@ -3109,10 +3012,8 @@ init_tty (const char *name, const char *terminal_type, int must_succeed)
name);
}
-#ifndef O_IGNORE_CTTY
- if (!ctty)
+ if (!O_IGNORE_CTTY && !ctty)
dissociate_if_controlling_tty (fd);
-#endif
file = fdopen (fd, "w+");
tty->input = file;
@@ -3125,13 +3026,18 @@ init_tty (const char *name, const char *terminal_type, int must_succeed)
Wcm_clear (tty);
- tty->termcap_term_buffer = (char *) xmalloc (buffer_size);
+ tty->termcap_term_buffer = xmalloc (buffer_size);
/* On some systems, tgetent tries to access the controlling
terminal. */
- sigblock (sigmask (SIGTTOU));
- status = tgetent (tty->termcap_term_buffer, terminal_type);
- sigunblock (sigmask (SIGTTOU));
+ {
+ sigset_t blocked;
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGTTOU);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
+ status = tgetent (tty->termcap_term_buffer, terminal_type);
+ pthread_sigmask (SIG_UNBLOCK, &blocked, 0);
+ }
if (status < 0)
{
@@ -3163,10 +3069,10 @@ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\
#ifndef TERMINFO
if (strlen (tty->termcap_term_buffer) >= buffer_size)
- abort ();
+ emacs_abort ();
buffer_size = strlen (tty->termcap_term_buffer);
#endif
- tty->termcap_strings_buffer = area = (char *) xmalloc (buffer_size);
+ tty->termcap_strings_buffer = area = xmalloc (buffer_size);
tty->TS_ins_line = tgetstr ("al", address);
tty->TS_ins_multi_lines = tgetstr ("AL", address);
tty->TS_bell = tgetstr ("bl", address);
@@ -3224,8 +3130,8 @@ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\
tty->TS_enter_underline_mode = tgetstr ("us", address);
tty->TS_exit_underline_mode = tgetstr ("ue", address);
tty->TS_enter_bold_mode = tgetstr ("md", address);
+ tty->TS_enter_italic_mode = tgetstr ("ZH", address);
tty->TS_enter_dim_mode = tgetstr ("mh", address);
- tty->TS_enter_blink_mode = tgetstr ("mb", address);
tty->TS_enter_reverse_mode = tgetstr ("mr", address);
tty->TS_enter_alt_charset_mode = tgetstr ("as", address);
tty->TS_exit_alt_charset_mode = tgetstr ("ae", address);
@@ -3285,7 +3191,6 @@ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\
FrameCols (tty) = FRAME_COLS (f);
tty->specified_window = FRAME_LINES (f);
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
terminal->char_ins_del_ok = 1;
baud_rate = 19200;
@@ -3334,9 +3239,9 @@ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\
tty->mouse_highlight.mouse_face_window = Qnil;
#endif
- terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
+ terminal->kboard = xmalloc (sizeof *terminal->kboard);
init_kboard (terminal->kboard);
- KVAR (terminal->kboard, Vwindow_system) = Qnil;
+ kset_window_system (terminal->kboard, Qnil);
terminal->kboard->next_kboard = all_kboards;
all_kboards = terminal->kboard;
terminal->kboard->reference_count++;
@@ -3522,7 +3427,7 @@ maybe_fatal (int must_succeed, struct terminal *terminal,
verror (str1, ap);
va_end (ap);
- abort ();
+ emacs_abort ();
}
void
@@ -3549,7 +3454,7 @@ delete_tty (struct terminal *terminal)
return;
if (terminal->type != output_termcap)
- abort ();
+ emacs_abort ();
tty = terminal->display_info.tty;
@@ -3563,7 +3468,7 @@ delete_tty (struct terminal *terminal)
if (! p)
/* This should not happen. */
- abort ();
+ emacs_abort ();
p->next = tty->next;
tty->next = 0;
@@ -3594,26 +3499,9 @@ delete_tty (struct terminal *terminal)
xfree (tty->termcap_strings_buffer);
xfree (tty->termcap_term_buffer);
- memset (tty, 0, sizeof (struct tty_display_info));
xfree (tty);
}
-
-
-/* Mark the pointers in the tty_display_info objects.
- Called by the Fgarbage_collector. */
-
-void
-mark_ttys (void)
-{
- struct tty_display_info *tty;
-
- for (tty = tty_list; tty; tty = tty->next)
- mark_object (tty->top_frame);
-}
-
-
-
void
syms_of_term (void)
{
@@ -3627,14 +3515,14 @@ This variable can be used by terminal emulator packages. */);
#endif
DEFVAR_LISP ("suspend-tty-functions", Vsuspend_tty_functions,
- doc: /* Functions to be run after suspending a tty.
+ doc: /* Functions run after suspending a tty.
The functions are run with one argument, the terminal object to be suspended.
See `suspend-tty'. */);
Vsuspend_tty_functions = Qnil;
DEFVAR_LISP ("resume-tty-functions", Vresume_tty_functions,
- doc: /* Functions to be run after resuming a tty.
+ doc: /* Functions run after resuming a tty.
The functions are run with one argument, the terminal object that was revived.
See `resume-tty'. */);
Vresume_tty_functions = Qnil;
@@ -3651,6 +3539,7 @@ bigger, or it may make it blink, or it may do nothing at all. */);
defsubr (&Stty_no_underline);
defsubr (&Stty_type);
defsubr (&Scontrolling_tty_p);
+ defsubr (&Stty_top_frame);
defsubr (&Ssuspend_tty);
defsubr (&Sresume_tty);
#ifdef HAVE_GPM
diff --git a/src/termcap.c b/src/termcap.c
index 10c195eebe2..e494cd113d9 100644
--- a/src/termcap.c
+++ b/src/termcap.c
@@ -19,7 +19,6 @@ Boston, MA 02110-1301, USA. */
/* Emacs config.h may rename various library functions such as malloc. */
#include <config.h>
-#include <setjmp.h>
#include <sys/file.h>
#include <fcntl.h>
#include <unistd.h>
@@ -30,10 +29,6 @@ Boston, MA 02110-1301, USA. */
#include "msdos.h"
#endif
-#ifndef NULL
-#define NULL (char *) 0
-#endif
-
/* BUFSIZE is the initial size allocated for the buffer
for reading the termcap file.
It is not a limit.
@@ -157,7 +152,7 @@ tgetst1 (char *ptr, char **area)
p = ptr;
while ((c = *p++) && c != ':' && c != '\n')
;
- ret = (char *) xmalloc (p - ptr + 1);
+ ret = xmalloc (p - ptr + 1);
}
else
ret = *area;
@@ -381,7 +376,7 @@ tgetent (char *bp, const char *name)
if (!bp)
{
malloc_size = 1 + strlen (term);
- bp = (char *) xmalloc (malloc_size);
+ bp = xmalloc (malloc_size);
}
strcpy (bp, term);
goto ret;
@@ -444,13 +439,13 @@ tgetent (char *bp, const char *name)
buf.size = BUFSIZE;
/* Add 1 to size to ensure room for terminating null. */
- buf.beg = (char *) xmalloc (buf.size + 1);
+ buf.beg = xmalloc (buf.size + 1);
term = indirect ? indirect : (char *)name;
if (!bp)
{
malloc_size = indirect ? strlen (tcenv) + 1 : buf.size;
- bp = (char *) xmalloc (malloc_size);
+ bp = xmalloc (malloc_size);
}
tc_search_point = bp1 = bp;
@@ -482,7 +477,7 @@ tgetent (char *bp, const char *name)
{
ptrdiff_t offset1 = bp1 - bp, offset2 = tc_search_point - bp;
malloc_size = offset1 + buf.size;
- bp = termcap_name = (char *) xrealloc (bp, malloc_size);
+ bp = termcap_name = xrealloc (bp, malloc_size);
bp1 = termcap_name + offset1;
tc_search_point = termcap_name + offset2;
}
@@ -508,7 +503,7 @@ tgetent (char *bp, const char *name)
xfree (buf.beg);
if (malloc_size)
- bp = (char *) xrealloc (bp, bp1 - bp + 1);
+ bp = xrealloc (bp, bp1 - bp + 1);
ret:
term_entry = bp;
@@ -661,10 +656,6 @@ gobble_line (int fd, register struct termcap_buffer *bufp, char *append_end)
#ifdef TEST
-#ifdef NULL
-#undef NULL
-#endif
-
#include <stdio.h>
static void
diff --git a/src/termchar.h b/src/termchar.h
index 5ca3cf305c1..5c57593c04f 100644
--- a/src/termchar.h
+++ b/src/termchar.h
@@ -1,5 +1,5 @@
/* Flags and parameters describing terminal's characteristics.
- Copyright (C) 1985-1986, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -124,8 +124,8 @@ struct tty_display_info
each as vpos and hpos) */
const char *TS_enter_bold_mode; /* "md" -- turn on bold (extra bright mode). */
+ const char *TS_enter_italic_mode; /* "ZH" -- turn on italics mode. */
const char *TS_enter_dim_mode; /* "mh" -- turn on half-bright mode. */
- const char *TS_enter_blink_mode; /* "mb" -- enter blinking mode. */
const char *TS_enter_reverse_mode; /* "mr" -- enter reverse video mode. */
const char *TS_exit_underline_mode; /* "us" -- start underlining. */
const char *TS_enter_underline_mode; /* "ue" -- end underlining. */
@@ -207,6 +207,6 @@ extern struct tty_display_info *tty_list;
(((f)->output_method == output_termcap \
|| (f)->output_method == output_msdos_raw) \
? (f)->terminal->display_info.tty \
- : (abort (), (struct tty_display_info *) 0))
+ : (emacs_abort (), (struct tty_display_info *) 0))
#define CURTTY() FRAME_TTY (SELECTED_FRAME())
diff --git a/src/termhooks.h b/src/termhooks.h
index 5bd081d6d8b..b35c927fc53 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -1,6 +1,6 @@
/* Parameters and display hooks for terminal devices.
-Copyright (C) 1985-1986, 1993-1994, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1985-1986, 1993-1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -22,6 +22,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "systime.h" /* for Time */
+INLINE_HEADER_BEGIN
+#ifndef TERMHOOKS_INLINE
+# define TERMHOOKS_INLINE INLINE
+#endif
+
struct glyph;
struct frame;
@@ -102,9 +107,9 @@ enum event_kind
HORIZ_WHEEL_EVENT, /* A wheel event generated by a second
horizontal wheel that is present on some
mice. See WHEEL_EVENT. */
-#if defined (WINDOWSNT)
+#ifdef HAVE_NTGUI
LANGUAGE_CHANGE_EVENT, /* A LANGUAGE_CHANGE_EVENT is
- generated on WINDOWSNT or Mac OS
+ generated when HAVE_NTGUI or on Mac OS
when the keyboard layout or input
language is changed by the
user. */
@@ -183,7 +188,7 @@ enum event_kind
, CONFIG_CHANGED_EVENT
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
/* Generated when an APPCOMMAND event is received, in response to
Multimedia or Internet buttons on some keyboards.
Such keys are available as normal function keys on X through the
@@ -229,7 +234,7 @@ struct input_event
For a HELP_EVENT, this is the position within the object
(stored in ARG below) where the help was found. */
/* In WindowsNT, for a mouse wheel event, this is the delta. */
- EMACS_INT code;
+ ptrdiff_t code;
enum scroll_bar_part part;
int modifiers; /* See enum below for interpretation. */
@@ -237,16 +242,8 @@ struct input_event
Lisp_Object x, y;
Time timestamp;
- /* This is padding just to put the frame_or_window field
- past the size of struct selection_input_event. */
- int *padding[2];
-
- /* This field is copied into a vector while the event is in the queue,
- so that garbage collections won't kill it. */
- /* In a menu_bar_event, this is a cons cell whose car is the frame
- and whose cdr is the Lisp object that is the event's value. */
- /* This field is last so that struct selection_input_event
- does not overlap with it. */
+ /* This field is copied into a vector while the event is in
+ the queue, so that garbage collections won't kill it. */
Lisp_Object frame_or_window;
/* Additional event argument. This is used for TOOL_BAR_EVENTs and
@@ -417,14 +414,6 @@ struct terminal
int memory_below_frame; /* Terminal remembers lines scrolled
off bottom */
-#if 0 /* These are not used anywhere. */
- /* EMACS_INT baud_rate; */ /* Output speed in baud */
- int min_padding_speed; /* Speed below which no padding necessary. */
- int dont_calculate_costs; /* Nonzero means don't bother computing
- various cost tables; we won't use them. */
-#endif
-
-
/* Window-based redisplay interface for this device (0 for tty
devices). */
struct redisplay_interface *rif;
@@ -472,10 +461,7 @@ struct terminal
Otherwise, set *bar_window to Qnil, and *x and *y to the column and
row of the character cell the mouse is over.
- Set *time to the time the mouse was at the returned position.
-
- This should clear mouse_moved until the next motion
- event arrives. */
+ Set *time to the time the mouse was at the returned position. */
void (*mouse_position_hook) (struct frame **f, int,
Lisp_Object *bar_window,
enum scroll_bar_part *part,
@@ -483,11 +469,6 @@ struct terminal
Lisp_Object *y,
Time *);
- /* The window system handling code should set this if the mouse has
- moved since the last call to the mouse_position_hook. Calling that
- hook should clear this. */
- int mouse_moved;
-
/* When a frame's focus redirection is changed, this hook tells the
window system code to re-decide where to put the highlight. Under
X, this means that Emacs lies about where the focus is. */
@@ -586,24 +567,14 @@ struct terminal
/* Called to read input events.
TERMINAL indicates which terminal device to read from. Input
- events should be read into BUF, the size of which is given in
- SIZE. EXPECTED is non-zero if the caller suspects that new input
- is available.
+ events should be read into HOLD_QUIT.
A positive return value indicates that that many input events
- where read into BUF.
+ were read into BUF.
Zero means no events were immediately available.
A value of -1 means a transient read error, while -2 indicates
- that the device was closed (hangup), and it should be deleted.
-
- XXX Please note that a non-zero value of EXPECTED only means that
- there is available input on at least one of the currently opened
- terminal devices -- but not necessarily on this device.
- Therefore, in most cases EXPECTED should be simply ignored.
-
- XXX This documentation needs to be updated. */
+ that the device was closed (hangup), and it should be deleted. */
int (*read_socket_hook) (struct terminal *terminal,
- int expected,
struct input_event *hold_quit);
/* Called when a frame's display becomes entirely up to date. */
@@ -627,6 +598,18 @@ struct terminal
void (*delete_terminal_hook) (struct terminal *);
};
+/* Most code should use these functions to set Lisp fields in struct
+ terminal. */
+TERMHOOKS_INLINE void
+tset_charset_list (struct terminal *t, Lisp_Object val)
+{
+ t->charset_list = val;
+}
+TERMHOOKS_INLINE void
+tset_selection_alist (struct terminal *t, Lisp_Object val)
+{
+ t->Vselection_alist = val;
+}
/* Chain of all terminal devices currently in use. */
extern struct terminal *terminal_list;
@@ -665,3 +648,5 @@ extern unsigned char *encode_terminal_code (struct glyph *, int,
#ifdef HAVE_GPM
extern void close_gpm (int gpm_fd);
#endif
+
+INLINE_HEADER_END
diff --git a/src/terminal.c b/src/terminal.c
index 67577adf3b4..854ca61f19c 100644
--- a/src/terminal.c
+++ b/src/terminal.c
@@ -1,5 +1,5 @@
/* Functions related to terminal devices.
- Copyright (C) 2005-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -17,8 +17,10 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+
+#define TERMHOOKS_INLINE EXTERN_INLINE
+
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "frame.h"
@@ -39,6 +41,13 @@ struct terminal *initial_terminal;
static void delete_initial_terminal (struct terminal *);
+/* This setter is used only in this file, so it can be private. */
+static void
+tset_param_alist (struct terminal *t, Lisp_Object val)
+{
+ t->param_alist = val;
+}
+
void
@@ -225,16 +234,13 @@ create_terminal (void)
struct terminal *terminal = allocate_terminal ();
Lisp_Object terminal_coding, keyboard_coding;
- terminal->name = NULL;
terminal->next_terminal = terminal_list;
terminal_list = terminal;
terminal->id = next_terminal_id++;
- terminal->keyboard_coding =
- (struct coding_system *) xmalloc (sizeof (struct coding_system));
- terminal->terminal_coding =
- (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ terminal->keyboard_coding = xmalloc (sizeof (struct coding_system));
+ terminal->terminal_coding = xmalloc (sizeof (struct coding_system));
/* If default coding systems for the terminal and the keyboard are
already defined, use them in preference to the defaults. This is
@@ -255,9 +261,6 @@ create_terminal (void)
setup_coding_system (keyboard_coding, terminal->keyboard_coding);
setup_coding_system (terminal_coding, terminal->terminal_coding);
- terminal->param_alist = Qnil;
- terminal->charset_list = Qnil;
- terminal->Vselection_alist = Qnil;
return terminal;
}
@@ -290,7 +293,7 @@ delete_terminal (struct terminal *terminal)
for (tp = &terminal_list; *tp != terminal; tp = &(*tp)->next_terminal)
if (! *tp)
- abort ();
+ emacs_abort ();
*tp = terminal->next_terminal;
xfree (terminal->keyboard_coding);
@@ -357,14 +360,7 @@ If FRAME is nil, the selected frame is used.
The terminal device is represented by its integer identifier. */)
(Lisp_Object frame)
{
- struct terminal *t;
-
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
-
- t = FRAME_TERMINAL (XFRAME (frame));
+ struct terminal *t = FRAME_TERMINAL (decode_live_frame (frame));
if (!t)
return Qnil;
@@ -407,7 +403,7 @@ possible return values. */)
case output_ns:
return Qns;
default:
- abort ();
+ emacs_abort ();
}
}
@@ -452,7 +448,7 @@ store_terminal_param (struct terminal *t, Lisp_Object parameter, Lisp_Object val
Lisp_Object old_alist_elt = Fassq (parameter, t->param_alist);
if (EQ (old_alist_elt, Qnil))
{
- t->param_alist = Fcons (Fcons (parameter, value), t->param_alist);
+ tset_param_alist (t, Fcons (Fcons (parameter, value), t->param_alist));
return Qnil;
}
else
@@ -515,7 +511,7 @@ struct terminal *
init_initial_terminal (void)
{
if (initialized || terminal_list || tty_list)
- abort ();
+ emacs_abort ();
initial_terminal = create_terminal ();
initial_terminal->type = output_initial;
@@ -534,7 +530,7 @@ static void
delete_initial_terminal (struct terminal *terminal)
{
if (terminal != initial_terminal)
- abort ();
+ emacs_abort ();
delete_terminal (terminal);
initial_terminal = NULL;
diff --git a/src/terminfo.c b/src/terminfo.c
index c0418984efa..124c452a4a9 100644
--- a/src/terminfo.c
+++ b/src/terminfo.c
@@ -1,5 +1,5 @@
/* Interface from Emacs to terminfo.
- Copyright (C) 1985-1986, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,7 +19,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include "tparam.h"
-#include <setjmp.h>
#include "lisp.h"
/* Define these variables that serve as global parameters to termcap,
@@ -46,7 +45,7 @@ tparam (const char *string, char *outstring, int len,
/* Emacs always should pass a null OUTSTRING and zero LEN. */
if (outstring || len)
- abort ();
+ emacs_abort ();
temp = tparm (string, arg1, arg2, arg3, arg4);
return xstrdup (temp);
diff --git a/src/termopts.h b/src/termopts.h
index 86b7cf782c4..05fa0a52eee 100644
--- a/src/termopts.h
+++ b/src/termopts.h
@@ -1,5 +1,5 @@
/* Flags and parameters describing user options for handling the terminal.
- Copyright (C) 1985-1986, 1990, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 1990, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -17,15 +17,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/>. */
-/* Nonzero means use ^S/^Q as cretinous flow control. */
-extern int flow_control;
-
/* Nonzero means use interrupt-driven input. */
-extern int interrupt_input;
+extern bool interrupt_input;
/* Nonzero while interrupts are temporarily deferred during redisplay. */
-extern int interrupts_deferred;
-
-/* Terminal has meta key */
-extern int meta_key;
-
+extern bool interrupts_deferred;
diff --git a/src/textprop.c b/src/textprop.c
index a1c7593f568..379eafb73f7 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -1,5 +1,5 @@
/* Interface code for dealing with text properties.
- Copyright (C) 1993-1995, 1997, 1999-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1995, 1997, 1999-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -17,16 +17,13 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "intervals.h"
+#include "character.h"
#include "buffer.h"
#include "window.h"
-#ifndef NULL
-#define NULL (void *)0
-#endif
-
/* Test for membership, allowing for t (actually any non-cons) to mean the
universal set. */
@@ -75,15 +72,11 @@ Lisp_Object Qfront_sticky, Qrear_nonsticky;
static Lisp_Object interval_insert_behind_hooks;
static Lisp_Object interval_insert_in_front_hooks;
-static void text_read_only (Lisp_Object) NO_RETURN;
-static Lisp_Object Fprevious_property_change (Lisp_Object, Lisp_Object,
- Lisp_Object);
-
/* Signal a `text-read-only' error. This function makes it easier
to capture that error in GDB by putting a breakpoint on it. */
-static void
+static _Noreturn void
text_read_only (Lisp_Object propval)
{
if (STRINGP (propval))
@@ -112,7 +105,7 @@ text_read_only (Lisp_Object propval)
Fprevious_property_change which call this function with BEGIN == END.
Handle this case specially.
- If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise,
+ If FORCE is soft (0), it's OK to return NULL. Otherwise,
create an interval tree for OBJECT if one doesn't exist, provided
the object actually contains text. In the current design, if there
is no text, there can be no text properties. */
@@ -124,7 +117,7 @@ INTERVAL
validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *end, int force)
{
register INTERVAL i;
- EMACS_INT searchpos;
+ ptrdiff_t searchpos;
CHECK_STRING_OR_BUFFER (object);
CHECK_NUMBER_COERCE_MARKER (*begin);
@@ -133,7 +126,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *en
/* If we are asked for a point, but from a subr which operates
on a range, then return nothing. */
if (EQ (*begin, *end) && begin != end)
- return NULL_INTERVAL;
+ return NULL;
if (XINT (*begin) > XINT (*end))
{
@@ -150,17 +143,17 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *en
if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
&& XINT (*end) <= BUF_ZV (b)))
args_out_of_range (*begin, *end);
- i = BUF_INTERVALS (b);
+ i = buffer_intervals (b);
/* If there's no text, there are no properties. */
if (BUF_BEGV (b) == BUF_ZV (b))
- return NULL_INTERVAL;
+ return NULL;
searchpos = XINT (*begin);
}
else
{
- EMACS_INT len = SCHARS (object);
+ ptrdiff_t len = SCHARS (object);
if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
&& XINT (*end) <= len))
@@ -168,15 +161,15 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *en
XSETFASTINT (*begin, XFASTINT (*begin));
if (begin != end)
XSETFASTINT (*end, XFASTINT (*end));
- i = STRING_INTERVALS (object);
+ i = string_intervals (object);
if (len == 0)
- return NULL_INTERVAL;
+ return NULL;
searchpos = XINT (*begin);
}
- if (NULL_INTERVAL_P (i))
+ if (!i)
return (force ? create_root_interval (object) : i);
return find_interval (i, searchpos);
@@ -248,7 +241,7 @@ interval_has_all_properties (Lisp_Object plist, INTERVAL i)
/* Return nonzero if the plist of interval I has any of the
properties of PLIST, regardless of their values. */
-static inline int
+static int
interval_has_some_properties (Lisp_Object plist, INTERVAL i)
{
register Lisp_Object tail1, tail2, sym;
@@ -270,7 +263,7 @@ interval_has_some_properties (Lisp_Object plist, INTERVAL i)
/* Return nonzero if the plist of interval I has any of the
property names in LIST, regardless of their values. */
-static inline int
+static int
interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
{
register Lisp_Object tail1, tail2, sym;
@@ -278,7 +271,7 @@ interval_has_some_properties_list (Lisp_Object list, INTERVAL i)
/* Go through each element of LIST. */
for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
{
- sym = Fcar (tail1);
+ sym = XCAR (tail1);
/* Go through i's plist, looking for tail1 */
for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
@@ -345,7 +338,7 @@ set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
}
/* Store new properties. */
- interval->plist = Fcopy_sequence (properties);
+ set_interval_plist (interval, Fcopy_sequence (properties));
}
/* Add the properties of PLIST to the interval I, or set
@@ -418,7 +411,7 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
record_property_change (i->position, LENGTH (i),
sym1, Qnil, object);
}
- i->plist = Fcons (sym1, Fcons (val1, i->plist));
+ set_interval_plist (i, Fcons (sym1, Fcons (val1, i->plist)));
changed++;
}
}
@@ -491,38 +484,23 @@ remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object
}
if (changed)
- i->plist = current_plist;
+ set_interval_plist (i, current_plist);
return changed;
}
-
-#if 0
-/* Remove all properties from interval I. Return non-zero
- if this changes the interval. */
-
-static inline int
-erase_properties (INTERVAL i)
-{
- if (NILP (i->plist))
- return 0;
-
- i->plist = Qnil;
- return 1;
-}
-#endif
/* Returns the interval of POSITION in OBJECT.
POSITION is BEG-based. */
INTERVAL
-interval_of (EMACS_INT position, Lisp_Object object)
+interval_of (ptrdiff_t position, Lisp_Object object)
{
register INTERVAL i;
- EMACS_INT beg, end;
+ ptrdiff_t beg, end;
if (NILP (object))
XSETBUFFER (object, current_buffer);
else if (EQ (object, Qt))
- return NULL_INTERVAL;
+ return NULL;
CHECK_STRING_OR_BUFFER (object);
@@ -532,19 +510,19 @@ interval_of (EMACS_INT position, Lisp_Object object)
beg = BUF_BEGV (b);
end = BUF_ZV (b);
- i = BUF_INTERVALS (b);
+ i = buffer_intervals (b);
}
else
{
beg = 0;
end = SCHARS (object);
- i = STRING_INTERVALS (object);
+ i = string_intervals (object);
}
if (!(beg <= position && position <= end))
args_out_of_range (make_number (position), make_number (position));
- if (beg == end || NULL_INTERVAL_P (i))
- return NULL_INTERVAL;
+ if (beg == end || !i)
+ return NULL;
return find_interval (i, position);
}
@@ -564,7 +542,7 @@ If POSITION is at the end of OBJECT, the value is nil. */)
XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &position, &position, soft);
- if (NULL_INTERVAL_P (i))
+ if (!i)
return Qnil;
/* If POSITION is at the end of the interval,
it means it's the end of OBJECT.
@@ -578,7 +556,8 @@ If POSITION is at the end of OBJECT, the value is nil. */)
DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
doc: /* Return the value of POSITION's property PROP, in OBJECT.
-OBJECT is optional and defaults to the current buffer.
+OBJECT should be a buffer or a string; if omitted or nil, it defaults
+to the current buffer.
If POSITION is at the end of OBJECT, the value is nil. */)
(Lisp_Object position, Lisp_Object prop, Lisp_Object object)
{
@@ -775,14 +754,14 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
else
{
Lisp_Object initial_value, value;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (! NILP (object))
CHECK_BUFFER (object);
if (BUFFERP (object) && current_buffer != XBUFFER (object))
{
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (object);
}
@@ -858,14 +837,14 @@ position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */)
}
else
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (! NILP (object))
CHECK_BUFFER (object);
if (BUFFERP (object) && current_buffer != XBUFFER (object))
{
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (object);
}
@@ -944,12 +923,12 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
bother checking further intervals. */
if (EQ (limit, Qt))
{
- if (NULL_INTERVAL_P (i))
+ if (!i)
next = i;
else
next = next_interval (i);
- if (NULL_INTERVAL_P (next))
+ if (!next)
XSETFASTINT (position, (STRINGP (object)
? SCHARS (object)
: BUF_ZV (XBUFFER (object))));
@@ -958,16 +937,16 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
return position;
}
- if (NULL_INTERVAL_P (i))
+ if (!i)
return limit;
next = next_interval (i);
- while (!NULL_INTERVAL_P (next) && intervals_equal (i, next)
+ while (next && intervals_equal (i, next)
&& (NILP (limit) || next->position < XFASTINT (limit)))
next = next_interval (next);
- if (NULL_INTERVAL_P (next)
+ if (!next
|| (next->position
>= (INTEGERP (limit)
? XFASTINT (limit)
@@ -1005,17 +984,17 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */)
CHECK_NUMBER_COERCE_MARKER (limit);
i = validate_interval_range (object, &position, &position, soft);
- if (NULL_INTERVAL_P (i))
+ if (!i)
return limit;
here_val = textget (i->plist, prop);
next = next_interval (i);
- while (! NULL_INTERVAL_P (next)
+ while (next
&& EQ (here_val, textget (next->plist, prop))
&& (NILP (limit) || next->position < XFASTINT (limit)))
next = next_interval (next);
- if (NULL_INTERVAL_P (next)
+ if (!next
|| (next->position
>= (INTEGERP (limit)
? XFASTINT (limit)
@@ -1051,7 +1030,7 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
CHECK_NUMBER_COERCE_MARKER (limit);
i = validate_interval_range (object, &position, &position, soft);
- if (NULL_INTERVAL_P (i))
+ if (!i)
return limit;
/* Start with the interval containing the char before point. */
@@ -1059,12 +1038,12 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
i = previous_interval (i);
previous = previous_interval (i);
- while (!NULL_INTERVAL_P (previous) && intervals_equal (previous, i)
+ while (previous && intervals_equal (previous, i)
&& (NILP (limit)
|| (previous->position + LENGTH (previous) > XFASTINT (limit))))
previous = previous_interval (previous);
- if (NULL_INTERVAL_P (previous)
+ if (!previous
|| (previous->position + LENGTH (previous)
<= (INTEGERP (limit)
? XFASTINT (limit)
@@ -1102,21 +1081,21 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
i = validate_interval_range (object, &position, &position, soft);
/* Start with the interval containing the char before point. */
- if (!NULL_INTERVAL_P (i) && i->position == XFASTINT (position))
+ if (i && i->position == XFASTINT (position))
i = previous_interval (i);
- if (NULL_INTERVAL_P (i))
+ if (!i)
return limit;
here_val = textget (i->plist, prop);
previous = previous_interval (i);
- while (!NULL_INTERVAL_P (previous)
+ while (previous
&& EQ (here_val, textget (previous->plist, prop))
&& (NILP (limit)
|| (previous->position + LENGTH (previous) > XFASTINT (limit))))
previous = previous_interval (previous);
- if (NULL_INTERVAL_P (previous)
+ if (!previous
|| (previous->position + LENGTH (previous)
<= (INTEGERP (limit)
? XFASTINT (limit)
@@ -1140,7 +1119,7 @@ Return t if any property value actually changed, nil otherwise. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
{
register INTERVAL i, unchanged;
- register EMACS_INT s, len;
+ register ptrdiff_t s, len;
register int modified = 0;
struct gcpro gcpro1;
@@ -1152,7 +1131,7 @@ Return t if any property value actually changed, nil otherwise. */)
XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &start, &end, hard);
- if (NULL_INTERVAL_P (i))
+ if (!i)
return Qnil;
s = XINT (start);
@@ -1170,7 +1149,7 @@ Return t if any property value actually changed, nil otherwise. */)
skip it. */
if (interval_has_all_properties (properties, i))
{
- EMACS_INT got = (LENGTH (i) - (s - i->position));
+ ptrdiff_t got = (LENGTH (i) - (s - i->position));
if (got >= len)
RETURN_UNGCPRO (Qnil);
len -= got;
@@ -1190,8 +1169,7 @@ Return t if any property value actually changed, nil otherwise. */)
/* We are at the beginning of interval I, with LEN chars to scan. */
for (;;)
{
- if (i == 0)
- abort ();
+ eassert (i != 0);
if (LENGTH (i) >= len)
{
@@ -1297,16 +1275,16 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
&& XFASTINT (start) == 0
&& XFASTINT (end) == SCHARS (object))
{
- if (! STRING_INTERVALS (object))
+ if (!string_intervals (object))
return Qnil;
- STRING_SET_INTERVALS (object, NULL_INTERVAL);
+ set_string_intervals (object, NULL);
return Qt;
}
i = validate_interval_range (object, &start, &end, soft);
- if (NULL_INTERVAL_P (i))
+ if (!i)
{
/* If buffer has no properties, and we want none, return now. */
if (NILP (properties))
@@ -1319,7 +1297,7 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
i = validate_interval_range (object, &start, &end, hard);
/* This can return if start == end. */
- if (NULL_INTERVAL_P (i))
+ if (!i)
return Qnil;
}
@@ -1344,8 +1322,8 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
void
set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object buffer, INTERVAL i)
{
- register INTERVAL prev_changed = NULL_INTERVAL;
- register EMACS_INT s, len;
+ register INTERVAL prev_changed = NULL;
+ register ptrdiff_t s, len;
INTERVAL unchanged;
if (XINT (start) < XINT (end))
@@ -1361,8 +1339,8 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object propertie
else
return;
- if (i == 0)
- i = find_interval (BUF_INTERVALS (XBUFFER (buffer)), s);
+ if (i == NULL)
+ i = find_interval (buffer_intervals (XBUFFER (buffer)), s);
if (i->position != s)
{
@@ -1390,8 +1368,7 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object propertie
/* We are starting at the beginning of an interval I. LEN is positive. */
do
{
- if (i == 0)
- abort ();
+ eassert (i != 0);
if (LENGTH (i) >= len)
{
@@ -1402,7 +1379,7 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object propertie
merge the intervals, so as to make the undo records
and cause redisplay to happen. */
set_properties (properties, i, buffer);
- if (!NULL_INTERVAL_P (prev_changed))
+ if (prev_changed)
merge_interval_left (i);
return;
}
@@ -1413,7 +1390,7 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object propertie
merge the intervals, so as to make the undo records
and cause redisplay to happen. */
set_properties (properties, i, buffer);
- if (NULL_INTERVAL_P (prev_changed))
+ if (!prev_changed)
prev_changed = i;
else
prev_changed = i = merge_interval_left (i);
@@ -1438,14 +1415,14 @@ Use `set-text-properties' if you want to remove all text properties. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
{
register INTERVAL i, unchanged;
- register EMACS_INT s, len;
+ register ptrdiff_t s, len;
register int modified = 0;
if (NILP (object))
XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &start, &end, soft);
- if (NULL_INTERVAL_P (i))
+ if (!i)
return Qnil;
s = XINT (start);
@@ -1457,7 +1434,7 @@ Use `set-text-properties' if you want to remove all text properties. */)
it covers the entire region. */
if (! interval_has_some_properties (properties, i))
{
- EMACS_INT got = (LENGTH (i) - (s - i->position));
+ ptrdiff_t got = (LENGTH (i) - (s - i->position));
if (got >= len)
return Qnil;
len -= got;
@@ -1479,8 +1456,7 @@ Use `set-text-properties' if you want to remove all text properties. */)
/* We are at the beginning of an interval, with len to scan */
for (;;)
{
- if (i == 0)
- abort ();
+ eassert (i != 0);
if (LENGTH (i) >= len)
{
@@ -1524,7 +1500,7 @@ Return t if any property was actually removed, nil otherwise. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object list_of_properties, Lisp_Object object)
{
register INTERVAL i, unchanged;
- register EMACS_INT s, len;
+ register ptrdiff_t s, len;
register int modified = 0;
Lisp_Object properties;
properties = list_of_properties;
@@ -1533,7 +1509,7 @@ Return t if any property was actually removed, nil otherwise. */)
XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &start, &end, soft);
- if (NULL_INTERVAL_P (i))
+ if (!i)
return Qnil;
s = XINT (start);
@@ -1545,7 +1521,7 @@ Return t if any property was actually removed, nil otherwise. */)
it covers the entire region. */
if (! interval_has_some_properties_list (properties, i))
{
- EMACS_INT got = (LENGTH (i) - (s - i->position));
+ ptrdiff_t got = (LENGTH (i) - (s - i->position));
if (got >= len)
return Qnil;
len -= got;
@@ -1569,8 +1545,7 @@ Return t if any property was actually removed, nil otherwise. */)
and we call signal_after_change before returning if modified != 0. */
for (;;)
{
- if (i == 0)
- abort ();
+ eassert (i != 0);
if (LENGTH (i) >= len)
{
@@ -1634,16 +1609,16 @@ markers). If OBJECT is a string, START and END are 0-based indices into it. */
(Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
{
register INTERVAL i;
- register EMACS_INT e, pos;
+ register ptrdiff_t e, pos;
if (NILP (object))
XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &start, &end, soft);
- if (NULL_INTERVAL_P (i))
+ if (!i)
return (!NILP (value) || EQ (start, end) ? Qnil : start);
e = XINT (end);
- while (! NULL_INTERVAL_P (i))
+ while (i)
{
if (i->position >= e)
break;
@@ -1670,17 +1645,17 @@ markers). If OBJECT is a string, START and END are 0-based indices into it. */
(Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
{
register INTERVAL i;
- register EMACS_INT s, e;
+ register ptrdiff_t s, e;
if (NILP (object))
XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &start, &end, soft);
- if (NULL_INTERVAL_P (i))
+ if (!i)
return (NILP (value) || EQ (start, end)) ? Qnil : start;
s = XINT (start);
e = XINT (end);
- while (! NULL_INTERVAL_P (i))
+ while (i)
{
if (i->position >= e)
break;
@@ -1780,20 +1755,23 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_
Lisp_Object res;
Lisp_Object stuff;
Lisp_Object plist;
- EMACS_INT s, e, e2, p, len;
+ ptrdiff_t s, e, e2, p, len;
int modified = 0;
struct gcpro gcpro1, gcpro2;
i = validate_interval_range (src, &start, &end, soft);
- if (NULL_INTERVAL_P (i))
+ if (!i)
return Qnil;
CHECK_NUMBER_COERCE_MARKER (pos);
{
Lisp_Object dest_start, dest_end;
+ e = XINT (pos) + (XINT (end) - XINT (start));
+ if (MOST_POSITIVE_FIXNUM < e)
+ args_out_of_range (pos, end);
dest_start = pos;
- XSETFASTINT (dest_end, XINT (dest_start) + (XINT (end) - XINT (start)));
+ XSETFASTINT (dest_end, e);
/* Apply this to a copy of pos; it will try to increment its arguments,
which we don't want. */
validate_interval_range (dest, &dest_start, &dest_end, soft);
@@ -1834,7 +1812,7 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_
}
i = next_interval (i);
- if (NULL_INTERVAL_P (i))
+ if (!i)
break;
p += len;
@@ -1875,14 +1853,14 @@ text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp
result = Qnil;
i = validate_interval_range (object, &start, &end, soft);
- if (!NULL_INTERVAL_P (i))
+ if (i)
{
- EMACS_INT s = XINT (start);
- EMACS_INT e = XINT (end);
+ ptrdiff_t s = XINT (start);
+ ptrdiff_t e = XINT (end);
while (s < e)
{
- EMACS_INT interval_end, len;
+ ptrdiff_t interval_end, len;
Lisp_Object plist;
interval_end = i->position + LENGTH (i);
@@ -1907,7 +1885,7 @@ text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp
result);
i = next_interval (i);
- if (NULL_INTERVAL_P (i))
+ if (!i)
break;
s = i->position;
}
@@ -1960,7 +1938,7 @@ Lisp_Object
extend_property_ranges (Lisp_Object list, Lisp_Object new_end)
{
Lisp_Object prev = Qnil, head = list;
- EMACS_INT max = XINT (new_end);
+ ptrdiff_t max = XINT (new_end);
for (; CONSP (list); prev = list, list = XCDR (list))
{
@@ -2014,12 +1992,12 @@ call_mod_hooks (Lisp_Object list, Lisp_Object start, Lisp_Object end)
void
verify_interval_modification (struct buffer *buf,
- EMACS_INT start, EMACS_INT end)
+ ptrdiff_t start, ptrdiff_t end)
{
- register INTERVAL intervals = BUF_INTERVALS (buf);
- register INTERVAL i;
+ INTERVAL intervals = buffer_intervals (buf);
+ INTERVAL i;
Lisp_Object hooks;
- register Lisp_Object prev_mod_hooks;
+ Lisp_Object prev_mod_hooks;
Lisp_Object mod_hooks;
struct gcpro gcpro1;
@@ -2030,12 +2008,12 @@ verify_interval_modification (struct buffer *buf,
interval_insert_behind_hooks = Qnil;
interval_insert_in_front_hooks = Qnil;
- if (NULL_INTERVAL_P (intervals))
+ if (!intervals)
return;
if (start > end)
{
- EMACS_INT temp = start;
+ ptrdiff_t temp = start;
start = end;
end = temp;
}
@@ -2071,7 +2049,7 @@ verify_interval_modification (struct buffer *buf,
indirectly defined via the category property. */
if (i != prev)
{
- if (! NULL_INTERVAL_P (i))
+ if (i)
{
after = textget (i->plist, Qread_only);
@@ -2091,7 +2069,7 @@ verify_interval_modification (struct buffer *buf,
}
}
- if (! NULL_INTERVAL_P (prev))
+ if (prev)
{
before = textget (prev->plist, Qread_only);
@@ -2111,7 +2089,7 @@ verify_interval_modification (struct buffer *buf,
}
}
}
- else if (! NULL_INTERVAL_P (i))
+ else if (i)
{
after = textget (i->plist, Qread_only);
@@ -2138,10 +2116,10 @@ verify_interval_modification (struct buffer *buf,
}
/* Run both insert hooks (just once if they're the same). */
- if (!NULL_INTERVAL_P (prev))
+ if (prev)
interval_insert_behind_hooks
= textget (prev->plist, Qinsert_behind_hooks);
- if (!NULL_INTERVAL_P (i))
+ if (i)
interval_insert_in_front_hooks
= textget (i->plist, Qinsert_in_front_hooks);
}
@@ -2169,7 +2147,7 @@ verify_interval_modification (struct buffer *buf,
i = next_interval (i);
}
/* Keep going thru the interval containing the char before END. */
- while (! NULL_INTERVAL_P (i) && i->position < end);
+ while (i && i->position < end);
if (!inhibit_modification_hooks)
{
@@ -2227,7 +2205,7 @@ This also inhibits the use of the `intangible' text property. */);
DEFVAR_LISP ("text-property-default-nonsticky",
Vtext_property_default_nonsticky,
- doc: /* Alist of properties vs the corresponding non-stickinesses.
+ doc: /* Alist of properties vs the corresponding non-stickiness.
Each element has the form (PROPERTY . NONSTICKINESS).
If a character in a buffer has PROPERTY, new text inserted adjacent to
diff --git a/src/tparam.c b/src/tparam.c
index ac21667d65b..164f61d471b 100644
--- a/src/tparam.c
+++ b/src/tparam.c
@@ -19,13 +19,9 @@ Boston, MA 02110-1301, USA. */
/* Emacs config.h may rename various library functions such as malloc. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h" /* for xmalloc */
#include "tparam.h"
-
-#ifndef NULL
-#define NULL (char *) 0
-#endif
/* Assuming STRING is the value of a termcap string entry
containing `%' constructs to expand parameters,
@@ -102,7 +98,7 @@ tparam1 (const char *string, char *outstring, int len,
if (outlen == 0)
{
outlen = len + 40;
- new = (char *) xmalloc (outlen);
+ new = xmalloc (outlen);
memcpy (new, outstring, offset);
}
else
@@ -251,7 +247,7 @@ tparam1 (const char *string, char *outstring, int len,
break;
default:
- abort ();
+ emacs_abort ();
}
}
else
diff --git a/src/tparam.h b/src/tparam.h
index dc4cdfaa28c..e845f3e8202 100644
--- a/src/tparam.h
+++ b/src/tparam.h
@@ -1,6 +1,6 @@
/* Interface definitions for termcap entries.
-Copyright (C) 2011 Free Software Foundation, Inc.
+Copyright (C) 2011-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/undo.c b/src/undo.c
index 7e121e8b27d..e878ef4dcf9 100644
--- a/src/undo.c
+++ b/src/undo.c
@@ -1,5 +1,5 @@
/* undo handling for GNU Emacs.
- Copyright (C) 1990, 1993-1994, 2000-2011 Free Software Foundation, Inc.
+ Copyright (C) 1990, 1993-1994, 2000-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -18,8 +18,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "commands.h"
#include "window.h"
@@ -30,7 +31,7 @@ static struct buffer *last_undo_buffer;
/* Position of point last time we inserted a boundary. */
static struct buffer *last_boundary_buffer;
-static EMACS_INT last_boundary_position;
+static ptrdiff_t last_boundary_position;
Lisp_Object Qinhibit_read_only;
@@ -51,7 +52,7 @@ static Lisp_Object pending_boundary;
undo record that will be added just after this command terminates. */
static void
-record_point (EMACS_INT pt)
+record_point (ptrdiff_t pt)
{
int at_boundary;
@@ -103,8 +104,9 @@ record_point (EMACS_INT pt)
if (at_boundary
&& current_buffer == last_boundary_buffer
&& last_boundary_position != pt)
- BVAR (current_buffer, undo_list)
- = Fcons (make_number (last_boundary_position), BVAR (current_buffer, undo_list));
+ bset_undo_list (current_buffer,
+ Fcons (make_number (last_boundary_position),
+ BVAR (current_buffer, undo_list)));
}
/* Record an insertion that just happened or is about to happen,
@@ -113,7 +115,7 @@ record_point (EMACS_INT pt)
because we don't need to record the contents.) */
void
-record_insert (EMACS_INT beg, EMACS_INT length)
+record_insert (ptrdiff_t beg, ptrdiff_t length)
{
Lisp_Object lbeg, lend;
@@ -140,15 +142,15 @@ record_insert (EMACS_INT beg, EMACS_INT length)
XSETFASTINT (lbeg, beg);
XSETINT (lend, beg + length);
- BVAR (current_buffer, undo_list) = Fcons (Fcons (lbeg, lend),
- BVAR (current_buffer, undo_list));
+ bset_undo_list (current_buffer,
+ Fcons (Fcons (lbeg, lend), BVAR (current_buffer, undo_list)));
}
/* Record that a deletion is about to take place,
of the characters in STRING, at location BEG. */
void
-record_delete (EMACS_INT beg, Lisp_Object string)
+record_delete (ptrdiff_t beg, Lisp_Object string)
{
Lisp_Object sbeg;
@@ -166,8 +168,9 @@ record_delete (EMACS_INT beg, Lisp_Object string)
record_point (beg);
}
- BVAR (current_buffer, undo_list)
- = Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list));
+ bset_undo_list
+ (current_buffer,
+ Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list)));
}
/* Record the fact that MARKER is about to be adjusted by ADJUSTMENT.
@@ -176,7 +179,7 @@ record_delete (EMACS_INT beg, Lisp_Object string)
won't be inverted automatically by undoing the buffer modification. */
void
-record_marker_adjustment (Lisp_Object marker, EMACS_INT adjustment)
+record_marker_adjustment (Lisp_Object marker, ptrdiff_t adjustment)
{
if (EQ (BVAR (current_buffer, undo_list), Qt))
return;
@@ -189,9 +192,10 @@ record_marker_adjustment (Lisp_Object marker, EMACS_INT adjustment)
Fundo_boundary ();
last_undo_buffer = current_buffer;
- BVAR (current_buffer, undo_list)
- = Fcons (Fcons (marker, make_number (adjustment)),
- BVAR (current_buffer, undo_list));
+ bset_undo_list
+ (current_buffer,
+ Fcons (Fcons (marker, make_number (adjustment)),
+ BVAR (current_buffer, undo_list)));
}
/* Record that a replacement is about to take place,
@@ -199,7 +203,7 @@ record_marker_adjustment (Lisp_Object marker, EMACS_INT adjustment)
The replacement must not change the number of characters. */
void
-record_change (EMACS_INT beg, EMACS_INT length)
+record_change (ptrdiff_t beg, ptrdiff_t length)
{
record_delete (beg, make_buffer_string (beg, beg + length, 1));
record_insert (beg, length);
@@ -224,16 +228,17 @@ record_first_change (void)
if (base_buffer->base_buffer)
base_buffer = base_buffer->base_buffer;
- BVAR (current_buffer, undo_list) =
- Fcons (Fcons (Qt, INTEGER_TO_CONS (base_buffer->modtime)),
- BVAR (current_buffer, undo_list));
+ bset_undo_list
+ (current_buffer,
+ Fcons (Fcons (Qt, make_lisp_time (base_buffer->modtime)),
+ BVAR (current_buffer, undo_list)));
}
/* Record a change in property PROP (whose old value was VAL)
for LENGTH characters starting at position BEG in BUFFER. */
void
-record_property_change (EMACS_INT beg, EMACS_INT length,
+record_property_change (ptrdiff_t beg, ptrdiff_t length,
Lisp_Object prop, Lisp_Object value,
Lisp_Object buffer)
{
@@ -264,7 +269,8 @@ record_property_change (EMACS_INT beg, EMACS_INT length,
XSETINT (lbeg, beg);
XSETINT (lend, beg + length);
entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
- BVAR (current_buffer, undo_list) = Fcons (entry, BVAR (current_buffer, undo_list));
+ bset_undo_list (current_buffer,
+ Fcons (entry, BVAR (current_buffer, undo_list)));
current_buffer = obuf;
}
@@ -287,11 +293,12 @@ but another undo command will undo to the previous boundary. */)
/* If we have preallocated the cons cell to use here,
use that one. */
XSETCDR (pending_boundary, BVAR (current_buffer, undo_list));
- BVAR (current_buffer, undo_list) = pending_boundary;
+ bset_undo_list (current_buffer, pending_boundary);
pending_boundary = Qnil;
}
else
- BVAR (current_buffer, undo_list) = Fcons (Qnil, BVAR (current_buffer, undo_list));
+ bset_undo_list (current_buffer,
+ Fcons (Qnil, BVAR (current_buffer, undo_list)));
}
last_boundary_position = PT;
last_boundary_buffer = current_buffer;
@@ -308,16 +315,16 @@ truncate_undo_list (struct buffer *b)
{
Lisp_Object list;
Lisp_Object prev, next, last_boundary;
- int size_so_far = 0;
+ EMACS_INT size_so_far = 0;
/* Make sure that calling undo-outer-limit-function
won't cause another GC. */
- int count = inhibit_garbage_collection ();
+ ptrdiff_t count = inhibit_garbage_collection ();
/* Make the buffer current to get its local values of variables such
as undo_limit. Also so that Vundo_outer_limit_function can
tell which buffer to operate on. */
- record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
set_buffer_internal (b);
list = BVAR (b, undo_list);
@@ -432,10 +439,17 @@ truncate_undo_list (struct buffer *b)
XSETCDR (last_boundary, Qnil);
/* There's nothing we decided to keep, so clear it out. */
else
- BVAR (b, undo_list) = Qnil;
+ bset_undo_list (b, Qnil);
unbind_to (count, Qnil);
}
+
+static _Noreturn void
+user_error (const char *msg)
+{
+ xsignal1 (Quser_error, build_string (msg));
+}
+
DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
doc: /* Undo N records from the front of the list LIST.
@@ -444,8 +458,8 @@ Return what remains of the list. */)
{
struct gcpro gcpro1, gcpro2;
Lisp_Object next;
- int count = SPECPDL_INDEX ();
- register int arg;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ register EMACS_INT arg;
Lisp_Object oldlist;
int did_apply = 0;
@@ -497,10 +511,23 @@ Return what remains of the list. */)
cdr = XCDR (next);
if (EQ (car, Qt))
{
- /* Element (t high . low) records previous modtime. */
+ /* Element (t . TIME) records previous modtime.
+ Preserve any flag of NONEXISTENT_MODTIME_NSECS or
+ UNKNOWN_MODTIME_NSECS. */
struct buffer *base_buffer = current_buffer;
- time_t mod_time;
- CONS_TO_INTEGER (cdr, time_t, mod_time);
+ EMACS_TIME mod_time;
+
+ if (CONSP (cdr)
+ && CONSP (XCDR (cdr))
+ && CONSP (XCDR (XCDR (cdr)))
+ && CONSP (XCDR (XCDR (XCDR (cdr))))
+ && INTEGERP (XCAR (XCDR (XCDR (XCDR (cdr)))))
+ && XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) < 0)
+ mod_time =
+ (make_emacs_time
+ (0, XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) / 1000));
+ else
+ mod_time = lisp_time_argument (cdr);
if (current_buffer->base_buffer)
base_buffer = current_buffer->base_buffer;
@@ -508,7 +535,7 @@ Return what remains of the list. */)
/* If this records an obsolete save
(not matching the actual disk file)
then don't mark unmodified. */
- if (mod_time != base_buffer->modtime)
+ if (EMACS_TIME_NE (mod_time, base_buffer->modtime))
continue;
#ifdef CLASH_DETECTION
Funlock_buffer ();
@@ -528,7 +555,7 @@ Return what remains of the list. */)
end = Fcdr (cdr);
if (XINT (beg) < BEGV || XINT (end) > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
+ user_error ("Changes to be undone are outside visible portion of buffer");
Fput_text_property (beg, end, prop, val, Qnil);
}
else if (INTEGERP (car) && INTEGERP (cdr))
@@ -537,7 +564,7 @@ Return what remains of the list. */)
if (XINT (car) < BEGV
|| XINT (cdr) > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
+ user_error ("Changes to be undone are outside visible portion of buffer");
/* Set point first thing, so that undoing this undo
does not send point back to where it is now. */
Fgoto_char (car);
@@ -588,14 +615,14 @@ Return what remains of the list. */)
if (pos < 0)
{
if (-pos < BEGV || -pos > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
+ user_error ("Changes to be undone are outside visible portion of buffer");
SET_PT (-pos);
Finsert (1, &membuf);
}
else
{
if (pos < BEGV || pos > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
+ user_error ("Changes to be undone are outside visible portion of buffer");
SET_PT (pos);
/* Now that we record marker adjustments
@@ -627,8 +654,9 @@ Return what remains of the list. */)
will work right. */
if (did_apply
&& EQ (oldlist, BVAR (current_buffer, undo_list)))
- BVAR (current_buffer, undo_list)
- = Fcons (list3 (Qapply, Qcdr, Qnil), BVAR (current_buffer, undo_list));
+ bset_undo_list
+ (current_buffer,
+ Fcons (list3 (Qapply, Qcdr, Qnil), BVAR (current_buffer, undo_list)));
UNGCPRO;
return unbind_to (count, list);
diff --git a/src/unexaix.c b/src/unexaix.c
index 22120b0ea03..c01a22a79f6 100644
--- a/src/unexaix.c
+++ b/src/unexaix.c
@@ -1,5 +1,5 @@
/* Dump an executable image.
- Copyright (C) 1985-1988, 1999, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1985-1988, 1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -56,8 +56,9 @@ what you give them. Help stamp out software-hoarding! */
#include <unistd.h>
#include <fcntl.h>
+#include "mem-limits.h"
+
char *start_of_text (void); /* Start of text */
-extern char *start_of_data (void); /* Start of initialized data */
extern int _data;
extern int _text;
@@ -78,21 +79,20 @@ static long data_scnptr;
static long load_scnptr;
static long orig_load_scnptr;
static long orig_data_scnptr;
-static int unrelocate_symbols (int, int, char *, char *);
+static int unrelocate_symbols (int, int, const char *, const char *);
#ifndef MAX_SECTIONS
#define MAX_SECTIONS 10
#endif
-static int adjust_lnnoptrs (int, int, char *);
+static int adjust_lnnoptrs (int, int, const char *);
static int pagemask;
-#include <setjmp.h>
#include "lisp.h"
static void
-report_error (char *file, int fd)
+report_error (const char *file, int fd)
{
if (fd)
close (fd);
@@ -104,16 +104,16 @@ report_error (char *file, int fd)
#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1
static void
-report_error_1 (int fd, char *msg, int a1, int a2)
+report_error_1 (int fd, const char *msg, int a1, int a2)
{
close (fd);
error (msg, a1, a2);
}
-static int make_hdr (int, int, unsigned, unsigned, unsigned, char *, char *);
-static void mark_x (char *);
+static int make_hdr (int, int, const char *, const char *);
+static void mark_x (const char *);
static int copy_text_and_data (int);
-static int copy_sym (int, int, char *, char *);
+static int copy_sym (int, int, const char *, const char *);
static void write_segment (int, char *, char *);
/* ****************************************************************
@@ -159,7 +159,7 @@ unexec (const char *new_name, const char *a_name)
*/
static int
make_hdr (int new, int a_out,
- char *a_name, char *new_name)
+ const char *a_name, const char *new_name)
{
int scns;
unsigned int bss_start;
@@ -429,7 +429,7 @@ write_segment (int new, char *ptr, char *end)
* Copy the relocation information and symbol table from the a.out to the new
*/
static int
-copy_sym (int new, int a_out, char *a_name, char *new_name)
+copy_sym (int new, int a_out, const char *a_name, const char *new_name)
{
char page[UnexBlockSz];
int n;
@@ -465,7 +465,7 @@ copy_sym (int new, int a_out, char *a_name, char *new_name)
* After successfully building the new a.out, mark it executable
*/
static void
-mark_x (char *name)
+mark_x (const char *name)
{
struct stat sbuf;
int um;
@@ -483,7 +483,7 @@ mark_x (char *name)
}
static int
-adjust_lnnoptrs (int writedesc, int readdesc, char *new_name)
+adjust_lnnoptrs (int writedesc, int readdesc, const char *new_name)
{
int nsyms;
int naux;
@@ -530,7 +530,8 @@ adjust_lnnoptrs (int writedesc, int readdesc, char *new_name)
}
static int
-unrelocate_symbols (int new, int a_out, char *a_name, char *new_name)
+unrelocate_symbols (int new, int a_out,
+ const char *a_name, const char *new_name)
{
int i;
LDHDR ldhdr;
diff --git a/src/unexcoff.c b/src/unexcoff.c
index ef86a400239..966dd58cb6e 100644
--- a/src/unexcoff.c
+++ b/src/unexcoff.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1985-1988, 1992-1994, 2001-2011 Free Software Foundation, Inc.
+/* Copyright (C) 1985-1988, 1992-1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -98,7 +98,7 @@ struct aouthdr
#include <sys/file.h>
-extern char *start_of_data (void); /* Start of initialized data */
+#include "mem-limits.h"
static long block_copy_start; /* Old executable start point */
static struct filehdr f_hdr; /* File header */
@@ -120,7 +120,6 @@ static int pagemask;
#define ADDR_CORRECT(x) ((char *)(x) - (char*)0)
-#include <setjmp.h>
#include "lisp.h"
static void
diff --git a/src/unexcw.c b/src/unexcw.c
index 62df82ec3bc..8c5d574530d 100644
--- a/src/unexcw.c
+++ b/src/unexcw.c
@@ -1,7 +1,7 @@
/* unexec() support for Cygwin;
complete rewrite of xemacs Cygwin unexec() code
- Copyright (C) 2004-2011 Free Software Foundation, Inc.
+ Copyright (C) 2004-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -20,8 +20,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include "unexec.h"
+#include "w32common.h"
-#include <setjmp.h>
#include <lisp.h>
#include <stdio.h>
#include <fcntl.h>
diff --git a/src/unexelf.c b/src/unexelf.c
index 1715c3670ca..b9f8e05e959 100644
--- a/src/unexelf.c
+++ b/src/unexelf.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1985-1988, 1990, 1992, 1999-2011
+/* Copyright (C) 1985-1988, 1990, 1992, 1999-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -461,7 +461,7 @@ typedef struct {
/*
* NetBSD does not have normal-looking user-land ELF support.
*/
-# if defined __alpha__ || defined __sparc_v9__
+# if defined __alpha__ || defined __sparc_v9__ || defined _LP64
# define ELFSIZE 64
# else
# define ELFSIZE 32
@@ -506,15 +506,13 @@ typedef struct {
#endif
#ifndef ElfW
-# ifdef __STDC__
-# define ElfBitsW(bits, type) Elf##bits##_##type
-# else
-# define ElfBitsW(bits, type) Elf/**/bits/**/_/**/type
-# endif
-# ifdef _LP64
-# define ELFSIZE 64
-# else
-# define ELFSIZE 32
+# define ElfBitsW(bits, type) Elf##bits##_##type
+# ifndef ELFSIZE
+# ifdef _LP64
+# define ELFSIZE 64
+# else
+# define ELFSIZE 32
+# endif
# endif
/* This macro expands `bits' before invoking ElfBitsW. */
# define ElfExpandBitsW(bits, type) ElfBitsW (bits, type)
diff --git a/src/unexmacosx.c b/src/unexmacosx.c
index a4c2f241c9f..d304e85d490 100644
--- a/src/unexmacosx.c
+++ b/src/unexmacosx.c
@@ -1,5 +1,5 @@
/* Dump Emacs in Mach-O format for use on Mac OS X.
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -117,6 +117,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <assert.h>
+/* LC_DATA_IN_CODE is not defined in mach-o/loader.h on OS X 10.7.
+ But it is used if we build with "Command Line Tools for Xcode 4.5
+ (OS X Lion) - September 2012". */
+#ifndef LC_DATA_IN_CODE
+#define LC_DATA_IN_CODE 0x29 /* table of non-instructions in __text */
+#endif
+
#ifdef _LP64
#define mach_header mach_header_64
#define segment_command segment_command_64
@@ -197,8 +204,6 @@ static off_t data_segment_old_fileoff = 0;
static struct segment_command *data_segment_scp;
-static void unexec_error (const char *format, ...) NO_RETURN;
-
/* Read N bytes from infd into memory starting at address DEST.
Return true if successful, false otherwise. */
static int
@@ -275,7 +280,7 @@ unexec_copy (off_t dest, off_t src, ssize_t count)
/* Debugging and informational messages routines. */
-static void
+static _Noreturn void
unexec_error (const char *format, ...)
{
va_list ap;
@@ -396,7 +401,7 @@ build_region_list (void)
}
else
{
- r = (struct region_t *) malloc (sizeof (struct region_t));
+ r = malloc (sizeof *r);
if (!r)
unexec_error ("cannot allocate region structure");
@@ -609,6 +614,26 @@ print_load_command_name (int lc)
printf ("LC_FUNCTION_STARTS");
break;
#endif
+#ifdef LC_MAIN
+ case LC_MAIN:
+ printf ("LC_MAIN ");
+ break;
+#endif
+#ifdef LC_DATA_IN_CODE
+ case LC_DATA_IN_CODE:
+ printf ("LC_DATA_IN_CODE ");
+ break;
+#endif
+#ifdef LC_SOURCE_VERSION
+ case LC_SOURCE_VERSION:
+ printf ("LC_SOURCE_VERSION");
+ break;
+#endif
+#ifdef LC_DYLIB_CODE_SIGN_DRS
+ case LC_DYLIB_CODE_SIGN_DRS:
+ printf ("LC_DYLIB_CODE_SIGN_DRS");
+ break;
+#endif
default:
printf ("unknown ");
}
@@ -671,7 +696,7 @@ read_load_commands (void)
#endif
nlc = mh.ncmds;
- lca = (struct load_command **) malloc (nlc * sizeof (struct load_command *));
+ lca = malloc (nlc * sizeof *lca);
for (i = 0; i < nlc; i++)
{
@@ -680,7 +705,7 @@ read_load_commands (void)
size first and then read the rest. */
if (!unexec_read (&lc, sizeof (struct load_command)))
unexec_error ("cannot read load command");
- lca[i] = (struct load_command *) malloc (lc.cmdsize);
+ lca[i] = malloc (lc.cmdsize);
memcpy (lca[i], &lc, sizeof (struct load_command));
if (!unexec_read (lca[i] + 1, lc.cmdsize - sizeof (struct load_command)))
unexec_error ("cannot read content of load command");
@@ -800,8 +825,24 @@ copy_data_segment (struct load_command *lc)
file. */
if (strncmp (sectp->sectname, SECT_DATA, 16) == 0)
{
- if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size))
+ extern char my_edata[];
+ unsigned long my_size;
+
+ /* The __data section is basically dumped from memory. But
+ initialized data in statically linked libraries are
+ copied from the input file. In particular,
+ add_image_hook.names and add_image_hook.pointers stored
+ by libarclite_macosx.a, are restored so that they will be
+ reinitialized when the dumped binary is executed. */
+ my_size = (unsigned long)my_edata - sectp->addr;
+ if (!(sectp->addr <= (unsigned long)my_edata
+ && my_size <= sectp->size))
+ unexec_error ("my_edata is not in section %s", SECT_DATA);
+ if (!unexec_write (sectp->offset, (void *) sectp->addr, my_size))
unexec_error ("cannot write section %s", SECT_DATA);
+ if (!unexec_copy (sectp->offset + my_size, old_file_offset + my_size,
+ sectp->size - my_size))
+ unexec_error ("cannot copy section %s", SECT_DATA);
if (!unexec_write (header_offset, sectp, sizeof (struct section)))
unexec_error ("cannot write section %s's header", SECT_DATA);
}
@@ -809,9 +850,9 @@ copy_data_segment (struct load_command *lc)
{
sectp->flags = S_REGULAR;
if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size))
- unexec_error ("cannot write section %s", sectp->sectname);
+ unexec_error ("cannot write section %.16s", sectp->sectname);
if (!unexec_write (header_offset, sectp, sizeof (struct section)))
- unexec_error ("cannot write section %s's header", sectp->sectname);
+ unexec_error ("cannot write section %.16s's header", sectp->sectname);
}
else if (strncmp (sectp->sectname, SECT_BSS, 16) == 0)
{
@@ -829,15 +870,15 @@ copy_data_segment (struct load_command *lc)
my_size = (unsigned long)my_endbss_static - sectp->addr;
if (!(sectp->addr <= (unsigned long)my_endbss_static
&& my_size <= sectp->size))
- unexec_error ("my_endbss_static is not in section %s",
+ unexec_error ("my_endbss_static is not in section %.16s",
sectp->sectname);
if (!unexec_write (sectp->offset, (void *) sectp->addr, my_size))
- unexec_error ("cannot write section %s", sectp->sectname);
+ unexec_error ("cannot write section %.16s", sectp->sectname);
if (!unexec_write_zero (sectp->offset + my_size,
sectp->size - my_size))
- unexec_error ("cannot write section %s", sectp->sectname);
+ unexec_error ("cannot write section %.16s", sectp->sectname);
if (!unexec_write (header_offset, sectp, sizeof (struct section)))
- unexec_error ("cannot write section %s's header", sectp->sectname);
+ unexec_error ("cannot write section %.16s's header", sectp->sectname);
}
else if (strncmp (sectp->sectname, "__la_symbol_ptr", 16) == 0
|| strncmp (sectp->sectname, "__nl_symbol_ptr", 16) == 0
@@ -848,15 +889,18 @@ copy_data_segment (struct load_command *lc)
|| strncmp (sectp->sectname, "__cfstring", 16) == 0
|| strncmp (sectp->sectname, "__gcc_except_tab", 16) == 0
|| strncmp (sectp->sectname, "__program_vars", 16) == 0
+ || strncmp (sectp->sectname, "__mod_init_func", 16) == 0
+ || strncmp (sectp->sectname, "__mod_term_func", 16) == 0
|| strncmp (sectp->sectname, "__objc_", 7) == 0)
{
if (!unexec_copy (sectp->offset, old_file_offset, sectp->size))
- unexec_error ("cannot copy section %s", sectp->sectname);
+ unexec_error ("cannot copy section %.16s", sectp->sectname);
if (!unexec_write (header_offset, sectp, sizeof (struct section)))
- unexec_error ("cannot write section %s's header", sectp->sectname);
+ unexec_error ("cannot write section %.16s's header", sectp->sectname);
}
else
- unexec_error ("unrecognized section name in __DATA segment");
+ unexec_error ("unrecognized section %.16s in __DATA segment",
+ sectp->sectname);
printf (" section %-16.16s at %#8lx - %#8lx (sz: %#8lx)\n",
sectp->sectname, (long) (sectp->offset),
@@ -1146,8 +1190,9 @@ copy_dyld_info (struct load_command *lc, long delta)
#endif
#ifdef LC_FUNCTION_STARTS
-/* Copy a LC_FUNCTION_STARTS load command from the input file to the
- output file, adjusting the data offset field. */
+/* Copy a LC_FUNCTION_STARTS/LC_DATA_IN_CODE/LC_DYLIB_CODE_SIGN_DRS
+ load command from the input file to the output file, adjusting the
+ data offset field. */
static void
copy_linkedit_data (struct load_command *lc, long delta)
{
@@ -1241,6 +1286,12 @@ dump_it (void)
#endif
#ifdef LC_FUNCTION_STARTS
case LC_FUNCTION_STARTS:
+#ifdef LC_DATA_IN_CODE
+ case LC_DATA_IN_CODE:
+#endif
+#ifdef LC_DYLIB_CODE_SIGN_DRS
+ case LC_DYLIB_CODE_SIGN_DRS:
+#endif
copy_linkedit_data (lca[i], linkedit_delta);
break;
#endif
@@ -1377,7 +1428,7 @@ unexec_realloc (void *old_ptr, size_t new_size)
size_t old_size = ((unexec_malloc_header_t *) old_ptr)[-1].u.size;
size_t size = new_size > old_size ? old_size : new_size;
- p = (size_t *) malloc (new_size);
+ p = malloc (new_size);
if (size)
memcpy (p, old_ptr, size);
}
diff --git a/src/unexsol.c b/src/unexsol.c
index ef1e34e6f0f..470206d5838 100644
--- a/src/unexsol.c
+++ b/src/unexsol.c
@@ -4,9 +4,9 @@
#include "unexec.h"
#include <dlfcn.h>
-#include <setjmp.h>
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "charset.h"
#include "coding.h"
diff --git a/src/unexw32.c b/src/unexw32.c
index e5440c2f500..1e591a78b73 100644
--- a/src/unexw32.c
+++ b/src/unexw32.c
@@ -1,5 +1,5 @@
/* unexec for GNU Emacs on Windows NT.
- Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -22,6 +22,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include "unexec.h"
+#include "lisp.h"
+#include "w32common.h"
+#include "w32.h"
#include <stdio.h>
#include <fcntl.h>
@@ -67,23 +70,23 @@ void dump_bss_and_heap (file_data *p_infile, file_data *p_outfile);
/* Cached info about the .data section in the executable. */
PIMAGE_SECTION_HEADER data_section;
PCHAR data_start = 0;
-DWORD data_size = 0;
+DWORD_PTR data_size = 0;
/* Cached info about the .bss section in the executable. */
PIMAGE_SECTION_HEADER bss_section;
PCHAR bss_start = 0;
-DWORD bss_size = 0;
-DWORD extra_bss_size = 0;
+DWORD_PTR bss_size = 0;
+DWORD_PTR extra_bss_size = 0;
/* bss data that is static might be discontiguous from non-static. */
PIMAGE_SECTION_HEADER bss_section_static;
PCHAR bss_start_static = 0;
-DWORD bss_size_static = 0;
-DWORD extra_bss_size_static = 0;
+DWORD_PTR bss_size_static = 0;
+DWORD_PTR extra_bss_size_static = 0;
PIMAGE_SECTION_HEADER heap_section;
#ifdef HAVE_NTGUI
-HINSTANCE hinst = NULL;
+extern HINSTANCE hinst;
HINSTANCE hprevinst = NULL;
LPSTR lpCmdLine = "";
int nCmdShow = 0;
@@ -231,7 +234,7 @@ find_section (char * name, IMAGE_NT_HEADERS * nt_header)
/* Return pointer to section header for section containing the given
relative virtual address. */
IMAGE_SECTION_HEADER *
-rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header)
+rva_to_section (DWORD_PTR rva, IMAGE_NT_HEADERS * nt_header)
{
PIMAGE_SECTION_HEADER section;
int i;
@@ -246,7 +249,7 @@ rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header)
some very old exes (eg. gzip dated Dec 1993). Since
w32_executable_type relies on this function to work reliably,
we need to cope with this. */
- DWORD real_size = max (section->SizeOfRawData,
+ DWORD_PTR real_size = max (section->SizeOfRawData,
section->Misc.VirtualSize);
if (rva >= section->VirtualAddress
&& rva < section->VirtualAddress + real_size)
@@ -259,7 +262,7 @@ rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header)
/* Return pointer to section header for section containing the given
offset in its raw data area. */
IMAGE_SECTION_HEADER *
-offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header)
+offset_to_section (DWORD_PTR offset, IMAGE_NT_HEADERS * nt_header)
{
PIMAGE_SECTION_HEADER section;
int i;
@@ -279,8 +282,8 @@ offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header)
/* Return offset to an object in dst, given offset in src. We assume
there is at least one section in both src and dst images, and that
the some sections may have been added to dst (after sections in src). */
-DWORD
-relocate_offset (DWORD offset,
+DWORD_PTR
+relocate_offset (DWORD_PTR offset,
IMAGE_NT_HEADERS * src_nt_header,
IMAGE_NT_HEADERS * dst_nt_header)
{
@@ -314,25 +317,25 @@ relocate_offset (DWORD offset,
}
#define OFFSET_TO_RVA(offset, section) \
- (section->VirtualAddress + ((DWORD)(offset) - section->PointerToRawData))
+ ((section)->VirtualAddress + ((DWORD_PTR)(offset) - (section)->PointerToRawData))
#define RVA_TO_OFFSET(rva, section) \
- (section->PointerToRawData + ((DWORD)(rva) - section->VirtualAddress))
+ ((section)->PointerToRawData + ((DWORD_PTR)(rva) - (section)->VirtualAddress))
#define RVA_TO_SECTION_OFFSET(rva, section) \
- ((DWORD)(rva) - section->VirtualAddress)
+ ((DWORD_PTR)(rva) - (section)->VirtualAddress)
/* Convert address in executing image to RVA. */
-#define PTR_TO_RVA(ptr) ((DWORD)(ptr) - (DWORD) GetModuleHandle (NULL))
+#define PTR_TO_RVA(ptr) ((DWORD_PTR)(ptr) - (DWORD_PTR) GetModuleHandle (NULL))
#define RVA_TO_PTR(var,section,filedata) \
- ((void *)(RVA_TO_OFFSET (var,section) + (filedata).file_base))
+ ((unsigned char *)(RVA_TO_OFFSET (var,section) + (filedata).file_base))
#define PTR_TO_OFFSET(ptr, pfile_data) \
((unsigned char *)(ptr) - (pfile_data)->file_base)
#define OFFSET_TO_PTR(offset, pfile_data) \
- ((pfile_data)->file_base + (DWORD)(offset))
+ ((pfile_data)->file_base + (DWORD_PTR)(offset))
/* Flip through the executable and cache the info necessary for dumping. */
@@ -349,7 +352,7 @@ get_section_info (file_data *p_infile)
printf ("Unknown EXE header in %s...bailing.\n", p_infile->name);
exit (1);
}
- nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) +
+ nt_header = (PIMAGE_NT_HEADERS) (((DWORD_PTR) dos_header) +
dos_header->e_lfanew);
if (nt_header == NULL)
{
@@ -488,7 +491,7 @@ copy_executable_and_dump_data (file_data *p_infile,
PIMAGE_NT_HEADERS dst_nt_header;
PIMAGE_SECTION_HEADER section;
PIMAGE_SECTION_HEADER dst_section;
- DWORD offset;
+ DWORD_PTR offset;
int i;
int be_verbose = GetEnvironmentVariable ("DEBUG_DUMP", NULL, 0) > 0;
@@ -541,17 +544,17 @@ copy_executable_and_dump_data (file_data *p_infile,
Note that dst is updated implicitly by each COPY_CHUNK. */
dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base;
- nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) +
+ nt_header = (PIMAGE_NT_HEADERS) (((DWORD_PTR) dos_header) +
dos_header->e_lfanew);
section = IMAGE_FIRST_SECTION (nt_header);
dst = (unsigned char *) p_outfile->file_base;
COPY_CHUNK ("Copying DOS header...", dos_header,
- (DWORD) nt_header - (DWORD) dos_header, be_verbose);
+ (DWORD_PTR) nt_header - (DWORD_PTR) dos_header, be_verbose);
dst_nt_header = (PIMAGE_NT_HEADERS) dst;
COPY_CHUNK ("Copying NT header...", nt_header,
- (DWORD) section - (DWORD) nt_header, be_verbose);
+ (DWORD_PTR) section - (DWORD_PTR) nt_header, be_verbose);
dst_section = (PIMAGE_SECTION_HEADER) dst;
COPY_CHUNK ("Copying section table...", section,
nt_header->FileHeader.NumberOfSections * sizeof (*section),
@@ -627,8 +630,8 @@ copy_executable_and_dump_data (file_data *p_infile,
}
if (section == heap_section)
{
- DWORD heap_start = (DWORD) get_heap_start ();
- DWORD heap_size = get_committed_heap_size ();
+ DWORD_PTR heap_start = (DWORD_PTR) get_heap_start ();
+ DWORD_PTR heap_size = get_committed_heap_size ();
/* Dump the used portion of the predump heap, adjusting the
section's size to the appropriate size. */
diff --git a/src/vm-limit.c b/src/vm-limit.c
index fc847a295dd..2a71e88695a 100644
--- a/src/vm-limit.c
+++ b/src/vm-limit.c
@@ -1,5 +1,5 @@
/* Functions for memory limit warnings.
- Copyright (C) 1990, 1992, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1990, 1992, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -17,7 +17,7 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+#include <unistd.h> /* for 'environ', on AIX */
#include "lisp.h"
#include "mem-limits.h"
@@ -31,7 +31,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
enum warnlevel { not_warned, warned_75, warned_85, warned_95 };
static enum warnlevel warnlevel;
-typedef POINTER_TYPE *POINTER;
+typedef void *POINTER;
/* Function to call to issue a warning;
0 means don't issue them. */
@@ -41,7 +41,7 @@ static void (*warn_function) (const char *);
static POINTER data_space_start;
/* Number of bytes of writable memory we can expect to be able to get. */
-static unsigned long lim_data;
+static size_t lim_data;
#if defined (HAVE_GETRLIMIT) && defined (RLIMIT_AS)
@@ -85,10 +85,12 @@ get_lim_data (void)
#else /* not USG */
#ifdef WINDOWSNT
+#include "w32heap.h"
+
static void
get_lim_data (void)
{
- extern unsigned long reserved_heap_size;
+ extern size_t reserved_heap_size;
lim_data = reserved_heap_size;
}
@@ -166,13 +168,13 @@ static void
check_memory_limits (void)
{
#ifdef REL_ALLOC
- extern POINTER (*real_morecore) (long);
+ extern POINTER (*real_morecore) (ptrdiff_t);
#endif
- extern POINTER (*__morecore) (long);
+ extern POINTER (*__morecore) (ptrdiff_t);
register POINTER cp;
- unsigned long five_percent;
- unsigned long data_size;
+ size_t five_percent;
+ size_t data_size;
enum warnlevel new_warnlevel;
if (lim_data == 0)
@@ -268,7 +270,6 @@ start_of_data (void)
* is known to live at or near the start of the system crt0.c, and
* we don't sweat the handful of bytes that might lose.
*/
- extern char **environ;
return ((POINTER) &environ);
#else
extern int data_start;
diff --git a/src/w16select.c b/src/w16select.c
index 7ba62fde0e5..b8aaa3619ba 100644
--- a/src/w16select.c
+++ b/src/w16select.c
@@ -1,6 +1,6 @@
/* 16-bit Windows Selection processing for emacs on MS-Windows
-Copyright (C) 1996-1997, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1996-1997, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -31,13 +31,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <dpmi.h>
#include <go32.h>
#include <sys/farptr.h>
-#include <setjmp.h>
#include "lisp.h"
#include "dispextern.h" /* frame.h seems to want this */
#include "frame.h" /* Need this to get the X window of selected_frame */
#include "blockinput.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "coding.h"
#include "composite.h"
@@ -460,7 +459,7 @@ DEFUN ("w16-set-clipboard-data", Fw16_set_clipboard_data, Sw16_set_clipboard_dat
if ( !FRAME_MSDOS_P (XFRAME (frame)))
goto done;
- BLOCK_INPUT;
+ block_input ();
if (!open_clipboard ())
goto error;
@@ -493,7 +492,7 @@ DEFUN ("w16-set-clipboard-data", Fw16_set_clipboard_data, Sw16_set_clipboard_dat
setup_coding_system (Fcheck_coding_system (coding_system), &coding);
coding.dst_bytes = nbytes * 4;
- coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
+ coding.destination = xmalloc (coding.dst_bytes);
Vnext_selection_coding_system = Qnil;
coding.mode |= CODING_MODE_LAST_BLOCK;
dst = coding.destination;
@@ -521,7 +520,7 @@ DEFUN ("w16-set-clipboard-data", Fw16_set_clipboard_data, Sw16_set_clipboard_dat
unblock:
xfree (dst);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Notify user if the text is too large to fit into DOS memory.
(This will happen somewhere after 600K bytes (470K in DJGPP v1.x),
@@ -566,13 +565,13 @@ DEFUN ("w16-get-clipboard-data", Fw16_get_clipboard_data, Sw16_get_clipboard_dat
if ( !FRAME_MSDOS_P (XFRAME (frame)))
goto done;
- BLOCK_INPUT;
+ block_input ();
if (!open_clipboard ())
goto unblock;
if ((data_size = get_clipboard_data_size (CF_OEMTEXT)) == 0 ||
- (htext = (unsigned char *)xmalloc (data_size)) == 0)
+ (htext = xmalloc (data_size)) == 0)
goto closeclip;
/* need to know final size after '\r' chars are removed because
@@ -627,7 +626,7 @@ DEFUN ("w16-get-clipboard-data", Fw16_get_clipboard_data, Sw16_get_clipboard_dat
close_clipboard ();
unblock:
- UNBLOCK_INPUT;
+ unblock_input ();
done:
@@ -637,14 +636,17 @@ DEFUN ("w16-get-clipboard-data", Fw16_get_clipboard_data, Sw16_get_clipboard_dat
/* Support checking for a clipboard selection. */
DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
- 0, 1, 0,
- doc: /* Whether there is an owner for the given X Selection.
-The arg should be the name of the selection in question, typically one of
-the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-\(Those are literal upper-case symbol names, since that's what X expects.)
-For convenience, the symbol nil is the same as `PRIMARY',
-and t is the same as `SECONDARY'. */)
- (Lisp_Object selection)
+ 0, 2, 0,
+ doc: /* Whether there is an owner for the given X selection.
+SELECTION should be the name of the selection in question, typically
+one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
+these literal upper-case names.) The symbol nil is the same as
+`PRIMARY', and t is the same as `SECONDARY'.
+
+TERMINAL should be a terminal object or a frame specifying the X
+server to query. If omitted or nil, that stands for the selected
+frame's display, or the first available X display. */)
+ (Lisp_Object selection, Lisp_Object terminal)
{
CHECK_SYMBOL (selection);
diff --git a/src/w32.c b/src/w32.c
index b26327462d8..c8e16dfaa94 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -1,5 +1,5 @@
-/* Utility and Unix shadow routines for GNU Emacs on the Microsoft W32 API.
- Copyright (C) 1994-1995, 2000-2011 Free Software Foundation, Inc.
+/* Utility and Unix shadow routines for GNU Emacs on the Microsoft Windows API.
+ Copyright (C) 1994-1995, 2000-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -31,14 +31,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/file.h>
#include <sys/time.h>
#include <sys/utime.h>
-#include <mbstring.h> /* for _mbspbrk */
#include <math.h>
-#include <setjmp.h>
#include <time.h>
/* must include CRT headers *before* config.h */
#include <config.h>
+#include <mbstring.h> /* for _mbspbrk */
#undef access
#undef chdir
@@ -116,6 +115,49 @@ typedef struct _PROCESS_MEMORY_COUNTERS_EX {
} PROCESS_MEMORY_COUNTERS_EX,*PPROCESS_MEMORY_COUNTERS_EX;
#endif
+#include <winioctl.h>
+#include <aclapi.h>
+
+#ifdef _MSC_VER
+/* MSVC doesn't provide the definition of REPARSE_DATA_BUFFER and the
+ associated macros, except on ntifs.h, which cannot be included
+ because it triggers conflicts with other Windows API headers. So
+ we define it here by hand. */
+
+typedef struct _REPARSE_DATA_BUFFER {
+ ULONG ReparseTag;
+ USHORT ReparseDataLength;
+ USHORT Reserved;
+ union {
+ struct {
+ USHORT SubstituteNameOffset;
+ USHORT SubstituteNameLength;
+ USHORT PrintNameOffset;
+ USHORT PrintNameLength;
+ ULONG Flags;
+ WCHAR PathBuffer[1];
+ } SymbolicLinkReparseBuffer;
+ struct {
+ USHORT SubstituteNameOffset;
+ USHORT SubstituteNameLength;
+ USHORT PrintNameOffset;
+ USHORT PrintNameLength;
+ WCHAR PathBuffer[1];
+ } MountPointReparseBuffer;
+ struct {
+ UCHAR DataBuffer[1];
+ } GenericReparseBuffer;
+ } DUMMYUNIONNAME;
+} REPARSE_DATA_BUFFER, *PREPARSE_DATA_BUFFER;
+
+#define FILE_DEVICE_FILE_SYSTEM 9
+#define METHOD_BUFFERED 0
+#define FILE_ANY_ACCESS 0x00000000
+#define CTL_CODE(t,f,m,a) (((t)<<16)|((a)<<14)|((f)<<2)|(m))
+#define FSCTL_GET_REPARSE_POINT \
+ CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS)
+#endif
+
/* TCP connection support. */
#include <sys/socket.h>
#undef socket
@@ -137,8 +179,10 @@ typedef struct _PROCESS_MEMORY_COUNTERS_EX {
#undef sendto
#include "w32.h"
-#include "ndir.h"
+#include <dirent.h>
+#include "w32common.h"
#include "w32heap.h"
+#include "w32select.h"
#include "systime.h"
#include "dispextern.h" /* for xstrcasecmp */
#include "coding.h" /* for Vlocale_coding_system */
@@ -156,6 +200,17 @@ Lisp_Object QCloaded_from;
void globals_of_w32 (void);
static DWORD get_rid (PSID);
+static int is_symlink (const char *);
+static char * chase_symlinks (const char *);
+static int enable_privilege (LPCTSTR, BOOL, TOKEN_PRIVILEGES *);
+static int restore_privilege (TOKEN_PRIVILEGES *);
+static BOOL WINAPI revert_to_self (void);
+
+extern int sys_access (const char *, int);
+extern void *e_malloc (size_t);
+extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
+ EMACS_TIME *, void *);
+
/* Initialization states.
@@ -173,6 +228,7 @@ static BOOL g_b_init_get_token_information;
static BOOL g_b_init_lookup_account_sid;
static BOOL g_b_init_get_sid_sub_authority;
static BOOL g_b_init_get_sid_sub_authority_count;
+static BOOL g_b_init_get_security_info;
static BOOL g_b_init_get_file_security;
static BOOL g_b_init_get_security_descriptor_owner;
static BOOL g_b_init_get_security_descriptor_group;
@@ -192,6 +248,7 @@ static BOOL g_b_init_equal_sid;
static BOOL g_b_init_copy_sid;
static BOOL g_b_init_get_native_system_info;
static BOOL g_b_init_get_system_times;
+static BOOL g_b_init_create_symbolic_link;
/*
BEGIN: Wrapper functions around OpenProcessToken
@@ -238,6 +295,15 @@ typedef PDWORD (WINAPI * GetSidSubAuthority_Proc) (
DWORD n);
typedef PUCHAR (WINAPI * GetSidSubAuthorityCount_Proc) (
PSID pSid);
+typedef DWORD (WINAPI * GetSecurityInfo_Proc) (
+ HANDLE handle,
+ SE_OBJECT_TYPE ObjectType,
+ SECURITY_INFORMATION SecurityInfo,
+ PSID *ppsidOwner,
+ PSID *ppsidGroup,
+ PACL *ppDacl,
+ PACL *ppSacl,
+ PSECURITY_DESCRIPTOR *ppSecurityDescriptor);
typedef BOOL (WINAPI * GetFileSecurity_Proc) (
LPCTSTR lpFileName,
SECURITY_INFORMATION RequestedInformation,
@@ -298,6 +364,10 @@ typedef BOOL (WINAPI * GetSystemTimes_Proc) (
LPFILETIME lpIdleTime,
LPFILETIME lpKernelTime,
LPFILETIME lpUserTime);
+typedef BOOLEAN (WINAPI *CreateSymbolicLink_Proc) (
+ LPTSTR lpSymlinkFileName,
+ LPTSTR lpTargetFileName,
+ DWORD dwFlags);
/* ** A utility function ** */
static BOOL
@@ -318,8 +388,10 @@ is_windows_9x (void)
return s_b_ret;
}
+static Lisp_Object ltime (ULONGLONG);
+
/* Get total user and system times for get-internal-run-time.
- Returns a list of three integers if the times are provided by the OS
+ Returns a list of integers if the times are provided by the OS
(NT derivatives), otherwise it returns the result of current-time. */
Lisp_Object
w32_get_internal_run_time (void)
@@ -331,27 +403,12 @@ w32_get_internal_run_time (void)
if ((*get_process_times_fn) (proc, &create, &exit, &kernel, &user))
{
LARGE_INTEGER user_int, kernel_int, total;
- int microseconds;
user_int.LowPart = user.dwLowDateTime;
user_int.HighPart = user.dwHighDateTime;
kernel_int.LowPart = kernel.dwLowDateTime;
kernel_int.HighPart = kernel.dwHighDateTime;
total.QuadPart = user_int.QuadPart + kernel_int.QuadPart;
- /* FILETIME is 100 nanosecond increments, Emacs only wants
- microsecond resolution. */
- total.QuadPart /= 10;
- microseconds = total.QuadPart % 1000000;
- total.QuadPart /= 1000000;
-
- /* Sanity check to make sure we can represent the result. */
- if (total.HighPart == 0)
- {
- int secs = total.LowPart;
-
- return list3 (make_number ((secs >> 16) & 0xffff),
- make_number (secs & 0xffff),
- make_number (microseconds));
- }
+ return ltime (total.QuadPart);
}
}
@@ -512,6 +569,39 @@ get_sid_sub_authority_count (PSID pSid)
return (s_pfn_Get_Sid_Sub_Authority_Count (pSid));
}
+static DWORD WINAPI
+get_security_info (HANDLE handle,
+ SE_OBJECT_TYPE ObjectType,
+ SECURITY_INFORMATION SecurityInfo,
+ PSID *ppsidOwner,
+ PSID *ppsidGroup,
+ PACL *ppDacl,
+ PACL *ppSacl,
+ PSECURITY_DESCRIPTOR *ppSecurityDescriptor)
+{
+ static GetSecurityInfo_Proc s_pfn_Get_Security_Info = NULL;
+ HMODULE hm_advapi32 = NULL;
+ if (is_windows_9x () == TRUE)
+ {
+ return FALSE;
+ }
+ if (g_b_init_get_security_info == 0)
+ {
+ g_b_init_get_security_info = 1;
+ hm_advapi32 = LoadLibrary ("Advapi32.dll");
+ s_pfn_Get_Security_Info =
+ (GetSecurityInfo_Proc) GetProcAddress (
+ hm_advapi32, "GetSecurityInfo");
+ }
+ if (s_pfn_Get_Security_Info == NULL)
+ {
+ return FALSE;
+ }
+ return (s_pfn_Get_Security_Info (handle, ObjectType, SecurityInfo,
+ ppsidOwner, ppsidGroup, ppDacl, ppSacl,
+ ppSecurityDescriptor));
+}
+
static BOOL WINAPI
get_file_security (LPCTSTR lpFileName,
SECURITY_INFORMATION RequestedInformation,
@@ -739,24 +829,58 @@ get_system_times (LPFILETIME lpIdleTime,
return FALSE;
return (s_pfn_Get_System_times (lpIdleTime, lpKernelTime, lpUserTime));
}
-
-/* Equivalent of strerror for W32 error codes. */
-char *
-w32_strerror (int error_no)
+
+static BOOLEAN WINAPI
+create_symbolic_link (LPTSTR lpSymlinkFilename,
+ LPTSTR lpTargetFileName,
+ DWORD dwFlags)
{
- static char buf[500];
+ static CreateSymbolicLink_Proc s_pfn_Create_Symbolic_Link = NULL;
+ BOOLEAN retval;
- if (error_no == 0)
- error_no = GetLastError ();
+ if (is_windows_9x () == TRUE)
+ {
+ errno = ENOSYS;
+ return 0;
+ }
+ if (g_b_init_create_symbolic_link == 0)
+ {
+ g_b_init_create_symbolic_link = 1;
+#ifdef _UNICODE
+ s_pfn_Create_Symbolic_Link =
+ (CreateSymbolicLink_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"),
+ "CreateSymbolicLinkW");
+#else
+ s_pfn_Create_Symbolic_Link =
+ (CreateSymbolicLink_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"),
+ "CreateSymbolicLinkA");
+#endif
+ }
+ if (s_pfn_Create_Symbolic_Link == NULL)
+ {
+ errno = ENOSYS;
+ return 0;
+ }
- buf[0] = '\0';
- if (!FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM, NULL,
- error_no,
- 0, /* choose most suitable language */
- buf, sizeof (buf), NULL))
- sprintf (buf, "w32 error %u", error_no);
- return buf;
+ retval = s_pfn_Create_Symbolic_Link (lpSymlinkFilename, lpTargetFileName,
+ dwFlags);
+ /* If we were denied creation of the symlink, try again after
+ enabling the SeCreateSymbolicLinkPrivilege for our process. */
+ if (!retval)
+ {
+ TOKEN_PRIVILEGES priv_current;
+
+ if (enable_privilege (SE_CREATE_SYMBOLIC_LINK_NAME, TRUE, &priv_current))
+ {
+ retval = s_pfn_Create_Symbolic_Link (lpSymlinkFilename, lpTargetFileName,
+ dwFlags);
+ restore_privilege (&priv_current);
+ revert_to_self ();
+ }
+ }
+ return retval;
}
+
/* Return 1 if P is a valid pointer to an object of size SIZE. Return
0 if P is NOT a valid pointer. Return -1 if we cannot validate P.
@@ -784,16 +908,25 @@ static char startup_dir[MAXPATHLEN];
/* Get the current working directory. */
char *
-getwd (char *dir)
+getcwd (char *dir, int dirsize)
{
+ if (!dirsize)
+ {
+ errno = EINVAL;
+ return NULL;
+ }
+ if (dirsize <= strlen (startup_dir))
+ {
+ errno = ERANGE;
+ return NULL;
+ }
#if 0
if (GetCurrentDirectory (MAXPATHLEN, dir) > 0)
return dir;
return NULL;
#else
- /* Emacs doesn't actually change directory itself, and we want to
- force our real wd to be where emacs.exe is to avoid unnecessary
- conflicts when trying to rename or delete directories. */
+ /* Emacs doesn't actually change directory itself, it stays in the
+ same directory where it was started. */
strcpy (dir, startup_dir);
return dir;
#endif
@@ -1147,9 +1280,9 @@ init_user_info (void)
/* Ensure HOME and SHELL are defined. */
if (getenv ("HOME") == NULL)
- abort ();
+ emacs_abort ();
if (getenv ("SHELL") == NULL)
- abort ();
+ emacs_abort ();
/* Set dir and shell from environment variables. */
strcpy (dflt_passwd.pw_dir, getenv ("HOME"));
@@ -1403,76 +1536,6 @@ is_unc_volume (const char *filename)
return 1;
}
-/* Routines that are no-ops on NT but are defined to get Emacs to compile. */
-
-int
-sigsetmask (int signal_mask)
-{
- return 0;
-}
-
-int
-sigmask (int sig)
-{
- return 0;
-}
-
-int
-sigblock (int sig)
-{
- return 0;
-}
-
-int
-sigunblock (int sig)
-{
- return 0;
-}
-
-int
-sigemptyset (sigset_t *set)
-{
- return 0;
-}
-
-int
-sigaddset (sigset_t *set, int signo)
-{
- return 0;
-}
-
-int
-sigfillset (sigset_t *set)
-{
- return 0;
-}
-
-int
-sigprocmask (int how, const sigset_t *set, sigset_t *oset)
-{
- return 0;
-}
-
-int
-pthread_sigmask (int how, const sigset_t *set, sigset_t *oset)
-{
- if (sigprocmask (how, set, oset) == -1)
- return EINVAL;
- return 0;
-}
-
-int
-setpgrp (int pid, int gid)
-{
- return 0;
-}
-
-int
-alarm (int seconds)
-{
- return 0;
-}
-
#define REG_ROOT "SOFTWARE\\GNU\\Emacs"
LPBYTE
@@ -1490,7 +1553,7 @@ w32_get_resource (char *key, LPDWORD lpdwtype)
lpvalue = NULL;
if (RegQueryValueEx (hrootkey, key, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS
- && (lpvalue = (LPBYTE) xmalloc (cbData)) != NULL
+ && (lpvalue = xmalloc (cbData)) != NULL
&& RegQueryValueEx (hrootkey, key, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS)
{
RegCloseKey (hrootkey);
@@ -1507,7 +1570,7 @@ w32_get_resource (char *key, LPDWORD lpdwtype)
lpvalue = NULL;
if (RegQueryValueEx (hrootkey, key, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS
- && (lpvalue = (LPBYTE) xmalloc (cbData)) != NULL
+ && (lpvalue = xmalloc (cbData)) != NULL
&& RegQueryValueEx (hrootkey, key, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS)
{
RegCloseKey (hrootkey);
@@ -1549,12 +1612,9 @@ init_environment (char ** argv)
read-only filesystem, like CD-ROM or a write-protected floppy.
The only way to be really sure is to actually create a file and
see if it succeeds. But I think that's too much to ask. */
-#ifdef _MSC_VER
- /* MSVC's _access crashes with D_OK. */
- if (tmp && sys_access (tmp, D_OK) == 0)
-#else
- if (tmp && _access (tmp, D_OK) == 0)
-#endif
+
+ /* MSVCRT's _access crashes with D_OK. */
+ if (tmp && faccessat (AT_FDCWD, tmp, D_OK, AT_EACCESS) == 0)
{
char * var = alloca (strlen (tmp) + 8);
sprintf (var, "TMPDIR=%s", tmp);
@@ -1576,7 +1636,6 @@ init_environment (char ** argv)
LPBYTE lpval;
DWORD dwType;
char locale_name[32];
- struct stat ignored;
char default_home[MAX_PATH];
int appdata = 0;
@@ -1586,17 +1645,19 @@ init_environment (char ** argv)
char * def_value;
} dflt_envvars[] =
{
+ /* If the default value is NULL, we will use the value from the
+ outside environment or the Registry, but will not push the
+ variable into the Emacs environment if it is defined neither
+ in the Registry nor in the outside environment. */
{"HOME", "C:/"},
{"PRELOAD_WINSOCK", NULL},
{"emacs_dir", "C:/emacs"},
- {"EMACSLOADPATH", "%emacs_dir%/site-lisp;%emacs_dir%/../site-lisp;%emacs_dir%/lisp;%emacs_dir%/leim"},
+ {"EMACSLOADPATH", NULL},
{"SHELL", "%emacs_dir%/bin/cmdproxy.exe"},
- {"EMACSDATA", "%emacs_dir%/etc"},
- {"EMACSPATH", "%emacs_dir%/bin"},
- /* We no longer set INFOPATH because Info-default-directory-list
- is then ignored. */
- /* {"INFOPATH", "%emacs_dir%/info"}, */
- {"EMACSDOC", "%emacs_dir%/etc"},
+ {"EMACSDATA", NULL},
+ {"EMACSPATH", NULL},
+ {"INFOPATH", NULL},
+ {"EMACSDOC", NULL},
{"TERM", "cmd"},
{"LANG", NULL},
};
@@ -1615,7 +1676,7 @@ init_environment (char ** argv)
/* For backwards compatibility, check if a .emacs file exists in C:/
If not, then we can try to default to the appdata directory under the
user's profile, which is more likely to be writable. */
- if (stat ("C:/.emacs", &ignored) < 0)
+ if (!check_existing ("C:/.emacs"))
{
HRESULT profile_result;
/* Dynamically load ShGetFolderPath, as it won't exist on versions
@@ -1654,37 +1715,18 @@ init_environment (char ** argv)
}
}
- /* When Emacs is invoked with --no-site-lisp, we must remove the
- site-lisp directories from the default value of EMACSLOADPATH.
- This assumes that the site-lisp entries are at the front, and
- that additional entries do exist. */
- if (no_site_lisp)
- {
- for (i = 0; i < N_ENV_VARS; i++)
- {
- if (strcmp (env_vars[i].name, "EMACSLOADPATH") == 0)
- {
- char *site;
- while ((site = strstr (env_vars[i].def_value, "site-lisp")))
- env_vars[i].def_value = strchr (site, ';') + 1;
- break;
- }
- }
- }
-
#define SET_ENV_BUF_SIZE (4 * MAX_PATH) /* to cover EMACSLOADPATH */
/* Treat emacs_dir specially: set it unconditionally based on our
- location, if it appears that we are running from the bin subdir
- of a standard installation. */
+ location. */
{
char *p;
char modname[MAX_PATH];
if (!GetModuleFileName (NULL, modname, MAX_PATH))
- abort ();
+ emacs_abort ();
if ((p = strrchr (modname, '\\')) == NULL)
- abort ();
+ emacs_abort ();
*p = 0;
if ((p = strrchr (modname, '\\')) && xstrcasecmp (p, "\\bin") == 0)
@@ -1703,7 +1745,8 @@ init_environment (char ** argv)
/* FIXME: should use substring of get_emacs_configuration ().
But I don't think the Windows build supports alpha, mips etc
anymore, so have taken the easy option for now. */
- else if (p && xstrcasecmp (p, "\\i386") == 0)
+ else if (p && (xstrcasecmp (p, "\\i386") == 0
+ || xstrcasecmp (p, "\\AMD64") == 0))
{
*p = 0;
p = strrchr (modname, '\\');
@@ -1741,13 +1784,11 @@ init_environment (char ** argv)
dwType = REG_EXPAND_SZ;
dont_free = 1;
if (!strcmp (env_vars[i].name, "HOME") && !appdata)
- {
- Lisp_Object warning[2];
- warning[0] = intern ("initialization");
- warning[1] = build_string ("Setting HOME to C:\\ by default is deprecated");
- Vdelayed_warnings_list = Fcons (Flist (2, warning),
- Vdelayed_warnings_list);
- }
+ Vdelayed_warnings_list
+ = Fcons (listn (CONSTYPE_HEAP, 2,
+ intern ("initialization"),
+ build_string ("Setting HOME to C:\\ by default is deprecated")),
+ Vdelayed_warnings_list);
}
if (lpval)
@@ -1794,27 +1835,17 @@ init_environment (char ** argv)
memcpy (*envp, "COMSPEC=", 8);
}
- /* Remember the initial working directory for getwd, then make the
- real wd be the location of emacs.exe to avoid conflicts when
- renaming or deleting directories. (We also don't call chdir when
- running subprocesses for the same reason.) */
+ /* Remember the initial working directory for getcwd. */
+ /* FIXME: Do we need to resolve possible symlinks in startup_dir?
+ Does it matter anywhere in Emacs? */
if (!GetCurrentDirectory (MAXPATHLEN, startup_dir))
- abort ();
+ emacs_abort ();
{
- char *p;
static char modname[MAX_PATH];
if (!GetModuleFileName (NULL, modname, MAX_PATH))
- abort ();
- if ((p = strrchr (modname, '\\')) == NULL)
- abort ();
- *p = 0;
-
- SetCurrentDirectory (modname);
-
- /* Ensure argv[0] has the full path to Emacs. */
- *p = '\\';
+ emacs_abort ();
argv[0] = modname;
}
@@ -1826,6 +1857,8 @@ init_environment (char ** argv)
init_user_info ();
}
+/* Called from expand-file-name when default-directory is not a string. */
+
char *
emacs_root_dir (void)
{
@@ -1834,7 +1867,7 @@ emacs_root_dir (void)
p = getenv ("emacs_dir");
if (p == NULL)
- abort ();
+ emacs_abort ();
strcpy (root_dir, p);
root_dir[parse_root (root_dir, NULL)] = '\0';
dostounix_filename (root_dir);
@@ -1861,7 +1894,16 @@ get_emacs_configuration (void)
case PROCESSOR_INTEL_386:
case PROCESSOR_INTEL_486:
case PROCESSOR_INTEL_PENTIUM:
+#ifdef _WIN64
+ arch = "amd64";
+#else
arch = "i386";
+#endif
+ break;
+#endif
+#ifdef PROCESSOR_AMD_X8664
+ case PROCESSOR_AMD_X8664:
+ arch = "amd64";
break;
#endif
@@ -1940,6 +1982,9 @@ get_emacs_configuration_options (void)
#ifdef EMACSDEBUG
" --no-opt",
#endif
+#ifdef ENABLE_CHECKING
+ " --enable-checking",
+#endif
/* configure.bat already sets USER_CFLAGS and USER_LDFLAGS
with a starting space to save work here. */
#ifdef USER_CFLAGS
@@ -1997,7 +2042,7 @@ gettimeofday (struct timeval *tv, struct timezone *tz)
changed. We could fix that by using GetSystemTime and
GetTimeZoneInformation, but that doesn't seem necessary, since
Emacs always calls gettimeofday with the 2nd argument NULL (see
- EMACS_GET_TIME). */
+ current_emacs_time). */
if (tz)
{
tz->tz_minuteswest = tb.timezone; /* minutes west of Greenwich */
@@ -2005,8 +2050,43 @@ gettimeofday (struct timeval *tv, struct timezone *tz)
}
}
+/* Emulate fdutimens. */
+
+/* Set the access and modification time stamps of FD (a.k.a. FILE) to be
+ TIMESPEC[0] and TIMESPEC[1], respectively.
+ FD must be either negative -- in which case it is ignored --
+ or a file descriptor that is open on FILE.
+ If FD is nonnegative, then FILE can be NULL, which means
+ use just futimes instead of utimes.
+ If TIMESPEC is null, FAIL.
+ Return 0 on success, -1 (setting errno) on failure. */
+
+int
+fdutimens (int fd, char const *file, struct timespec const timespec[2])
+{
+ struct _utimbuf ut;
+
+ if (!timespec)
+ {
+ errno = ENOSYS;
+ return -1;
+ }
+ if (fd < 0 && !file)
+ {
+ errno = EBADF;
+ return -1;
+ }
+ ut.actime = timespec[0].tv_sec;
+ ut.modtime = timespec[1].tv_sec;
+ if (fd >= 0)
+ return _futime (fd, &ut);
+ else
+ return _utime (file, &ut);
+}
+
+
/* ------------------------------------------------------------------------- */
-/* IO support and wrapper functions for W32 API. */
+/* IO support and wrapper functions for the Windows API. */
/* ------------------------------------------------------------------------- */
/* Place a wrapper around the MSVC version of ctime. It returns NULL
@@ -2162,7 +2242,7 @@ GetCachedVolumeInformation (char * root_dir)
entry if present. */
if (info == NULL)
{
- info = (volume_info_data *) xmalloc (sizeof (volume_info_data));
+ info = xmalloc (sizeof (volume_info_data));
add_volume_info (root_dir, info);
}
else
@@ -2182,8 +2262,15 @@ GetCachedVolumeInformation (char * root_dir)
return info;
}
-/* Get information on the volume where name is held; set path pointer to
- start of pathname in name (past UNC header\volume header if present). */
+/* Get information on the volume where NAME is held; set path pointer to
+ start of pathname in NAME (past UNC header\volume header if present),
+ if pPath is non-NULL.
+
+ Note: if NAME includes symlinks, the information is for the volume
+ of the symlink, not of its target. That's because, even though
+ GetVolumeInformation returns information about the symlink target
+ of its argument, we only pass the root directory to
+ GetVolumeInformation, not the full NAME. */
static int
get_volume_info (const char * name, const char ** pPath)
{
@@ -2194,7 +2281,7 @@ get_volume_info (const char * name, const char ** pPath)
if (name == NULL)
return FALSE;
- /* find the root name of the volume if given */
+ /* Find the root name of the volume if given. */
if (isalpha (name[0]) && name[1] == ':')
{
rootname = temp;
@@ -2234,7 +2321,8 @@ get_volume_info (const char * name, const char ** pPath)
}
/* Determine if volume is FAT format (ie. only supports short 8.3
- names); also set path pointer to start of pathname in name. */
+ names); also set path pointer to start of pathname in name, if
+ pPath is non-NULL. */
static int
is_fat_volume (const char * name, const char ** pPath)
{
@@ -2243,7 +2331,8 @@ is_fat_volume (const char * name, const char ** pPath)
return FALSE;
}
-/* Map filename to a valid 8.3 name if necessary. */
+/* Map filename to a valid 8.3 name if necessary.
+ The result is a pointer to a static buffer, so CAVEAT EMPTOR! */
const char *
map_w32_filename (const char * name, const char ** pPath)
{
@@ -2273,15 +2362,10 @@ map_w32_filename (const char * name, const char ** pPath)
{
switch ( c )
{
+ case ':':
case '\\':
case '/':
- *str++ = '\\';
- extn = 0; /* reset extension flags */
- dots = 2; /* max 2 dots */
- left = 8; /* max length 8 for main part */
- break;
- case ':':
- *str++ = ':';
+ *str++ = (c == ':' ? ':' : '\\');
extn = 0; /* reset extension flags */
dots = 2; /* max 2 dots */
left = 8; /* max length 8 for main part */
@@ -2364,7 +2448,7 @@ is_exec (const char * name)
and readdir. We can't use the procedures supplied in sysdep.c,
so we provide them here. */
-struct direct dir_static; /* simulated directory contents */
+struct dirent dir_static; /* simulated directory contents */
static HANDLE dir_find_handle = INVALID_HANDLE_VALUE;
static int dir_is_fat;
static char dir_pathname[MAXPATHLEN+1];
@@ -2390,6 +2474,9 @@ opendir (char *filename)
if (wnet_enum_handle != INVALID_HANDLE_VALUE)
return NULL;
+ /* Note: We don't support traversal of UNC volumes via symlinks.
+ Doing so would mean punishing 99.99% of use cases by resolving
+ all the possible symlinks in FILENAME, recursively. */
if (is_unc_volume (filename))
{
wnet_enum_handle = open_unc_volume (filename);
@@ -2406,6 +2493,9 @@ opendir (char *filename)
strncpy (dir_pathname, map_w32_filename (filename, NULL), MAXPATHLEN);
dir_pathname[MAXPATHLEN] = '\0';
+ /* Note: We don't support symlinks to file names on FAT volumes.
+ Doing so would mean punishing 99.99% of use cases by resolving
+ all the possible symlinks in FILENAME, recursively. */
dir_is_fat = is_fat_volume (filename, NULL);
return dirp;
@@ -2428,7 +2518,7 @@ closedir (DIR *dirp)
xfree ((char *) dirp);
}
-struct direct *
+struct dirent *
readdir (DIR *dirp)
{
int downcase = !NILP (Vw32_downcase_file_names);
@@ -2452,6 +2542,9 @@ readdir (DIR *dirp)
strcat (filename, "\\");
strcat (filename, "*");
+ /* Note: No need to resolve symlinks in FILENAME, because
+ FindFirst opens the directory that is the target of a
+ symlink. */
dir_find_handle = FindFirstFile (filename, &dir_find_data);
if (dir_find_handle == INVALID_HANDLE_VALUE)
@@ -2479,7 +2572,7 @@ readdir (DIR *dirp)
downcase = 1; /* 8+3 aliases are returned in all caps */
}
dir_static.d_namlen = strlen (dir_static.d_name);
- dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3 +
+ dir_static.d_reclen = sizeof (struct dirent) - MAXNAMLEN + 3 +
dir_static.d_namlen - dir_static.d_namlen % 4;
/* If the file name in cFileName[] includes `?' characters, it means
@@ -2632,34 +2725,62 @@ logon_network_drive (const char *path)
WNetAddConnection2 (&resource, NULL, NULL, CONNECT_INTERACTIVE);
}
-/* Shadow some MSVC runtime functions to map requests for long filenames
- to reasonable short names if necessary. This was originally added to
- permit running Emacs on NT 3.1 on a FAT partition, which doesn't support
- long file names. */
-
+/* Emulate faccessat(2). */
int
-sys_access (const char * path, int mode)
+faccessat (int dirfd, const char * path, int mode, int flags)
{
DWORD attributes;
- /* MSVC implementation doesn't recognize D_OK. */
- path = map_w32_filename (path, NULL);
- if (is_unc_volume (path))
+ if (dirfd != AT_FDCWD
+ && !(IS_DIRECTORY_SEP (path[0])
+ || IS_DEVICE_SEP (path[1])))
{
- attributes = unc_volume_file_attributes (path);
- if (attributes == -1) {
- errno = EACCES;
- return -1;
- }
+ errno = EBADF;
+ return -1;
}
- else if ((attributes = GetFileAttributes (path)) == -1)
+
+ /* MSVCRT implementation of 'access' doesn't recognize D_OK, and its
+ newer versions blow up when passed D_OK. */
+ path = map_w32_filename (path, NULL);
+ /* If the last element of PATH is a symlink, we need to resolve it
+ to get the attributes of its target file. Note: any symlinks in
+ PATH elements other than the last one are transparently resolved
+ by GetFileAttributes below. */
+ if ((volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) != 0
+ && (flags & AT_SYMLINK_NOFOLLOW) == 0)
+ path = chase_symlinks (path);
+
+ if ((attributes = GetFileAttributes (path)) == -1)
{
- /* Should try mapping GetLastError to errno; for now just indicate
- that path doesn't exist. */
- errno = EACCES;
+ DWORD w32err = GetLastError ();
+
+ switch (w32err)
+ {
+ case ERROR_INVALID_NAME:
+ case ERROR_BAD_PATHNAME:
+ if (is_unc_volume (path))
+ {
+ attributes = unc_volume_file_attributes (path);
+ if (attributes == -1)
+ {
+ errno = EACCES;
+ return -1;
+ }
+ break;
+ }
+ /* FALLTHROUGH */
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_BAD_NETPATH:
+ errno = ENOENT;
+ break;
+ default:
+ errno = EACCES;
+ break;
+ }
return -1;
}
- if ((mode & X_OK) != 0 && !is_exec (path))
+ if ((mode & X_OK) != 0
+ && !(is_exec (path) || (attributes & FILE_ATTRIBUTE_DIRECTORY) != 0))
{
errno = EACCES;
return -1;
@@ -2677,6 +2798,11 @@ sys_access (const char * path, int mode)
return 0;
}
+/* Shadow some MSVC runtime functions to map requests for long filenames
+ to reasonable short names if necessary. This was originally added to
+ permit running Emacs on NT 3.1 on a FAT partition, which doesn't support
+ long file names. */
+
int
sys_chdir (const char * path)
{
@@ -2686,7 +2812,8 @@ sys_chdir (const char * path)
int
sys_chmod (const char * path, int mode)
{
- return _chmod (map_w32_filename (path, NULL), mode);
+ path = chase_symlinks (map_w32_filename (path, NULL));
+ return _chmod (path, mode);
}
int
@@ -2861,7 +2988,7 @@ sys_mktemp (char * template)
{
int save_errno = errno;
p[0] = first_char[i];
- if (sys_access (template, 0) < 0)
+ if (faccessat (AT_FDCWD, template, F_OK, AT_EACCESS) < 0)
{
errno = save_errno;
return template;
@@ -2894,6 +3021,8 @@ sys_rename (const char * oldname, const char * newname)
{
BOOL result;
char temp[MAX_PATH];
+ int newname_dev;
+ int oldname_dev;
/* MoveFile on Windows 95 doesn't correctly change the short file name
alias in a number of circumstances (it is not easy to predict when
@@ -2910,7 +3039,10 @@ sys_rename (const char * oldname, const char * newname)
strcpy (temp, map_w32_filename (oldname, NULL));
- if (os_subtype == OS_WIN95)
+ /* volume_info is set indirectly by map_w32_filename. */
+ oldname_dev = volume_info.serialnum;
+
+ if (os_subtype == OS_9X)
{
char * o;
char * p;
@@ -2953,13 +3085,47 @@ sys_rename (const char * oldname, const char * newname)
all the permutations of shared or subst'd drives, etc.) */
newname = map_w32_filename (newname, NULL);
+
+ /* volume_info is set indirectly by map_w32_filename. */
+ newname_dev = volume_info.serialnum;
+
result = rename (temp, newname);
- if (result < 0
- && errno == EEXIST
- && _chmod (newname, 0666) == 0
- && _unlink (newname) == 0)
- result = rename (temp, newname);
+ if (result < 0)
+ {
+ DWORD w32err = GetLastError ();
+
+ if (errno == EACCES
+ && newname_dev != oldname_dev)
+ {
+ /* The implementation of `rename' on Windows does not return
+ errno = EXDEV when you are moving a directory to a
+ different storage device (ex. logical disk). It returns
+ EACCES instead. So here we handle such situations and
+ return EXDEV. */
+ DWORD attributes;
+
+ if ((attributes = GetFileAttributes (temp)) != -1
+ && (attributes & FILE_ATTRIBUTE_DIRECTORY))
+ errno = EXDEV;
+ }
+ else if (errno == EEXIST)
+ {
+ if (_chmod (newname, 0666) != 0)
+ return result;
+ if (_unlink (newname) != 0)
+ return result;
+ result = rename (temp, newname);
+ }
+ else if (w32err == ERROR_PRIVILEGE_NOT_HELD
+ && is_symlink (temp))
+ {
+ /* This is Windows prohibiting the user from creating a
+ symlink in another place, since that requires
+ privileges. */
+ errno = EPERM;
+ }
+ }
return result;
}
@@ -3078,7 +3244,7 @@ generate_inode_val (const char * name)
doesn't resolve aliasing due to subst commands, or recognize hard
links. */
if (!w32_get_long_filename ((char *)name, fullname, MAX_PATH))
- abort ();
+ emacs_abort ();
parse_root (fullname, &p);
/* Normal W32 filesystems are still case insensitive. */
@@ -3089,7 +3255,23 @@ generate_inode_val (const char * name)
#endif
static PSECURITY_DESCRIPTOR
-get_file_security_desc (const char *fname)
+get_file_security_desc_by_handle (HANDLE h)
+{
+ PSECURITY_DESCRIPTOR psd = NULL;
+ DWORD err;
+ SECURITY_INFORMATION si = OWNER_SECURITY_INFORMATION
+ | GROUP_SECURITY_INFORMATION /* | DACL_SECURITY_INFORMATION */ ;
+
+ err = get_security_info (h, SE_FILE_OBJECT, si,
+ NULL, NULL, NULL, NULL, &psd);
+ if (err != ERROR_SUCCESS)
+ return NULL;
+
+ return psd;
+}
+
+static PSECURITY_DESCRIPTOR
+get_file_security_desc_by_name (const char *fname)
{
PSECURITY_DESCRIPTOR psd = NULL;
DWORD sd_len, err;
@@ -3305,18 +3487,24 @@ is_slow_fs (const char *name)
/* MSVC stat function can't cope with UNC names and has other bugs, so
replace it with our own. This also allows us to calculate consistent
- inode values without hacks in the main Emacs code. */
-int
-stat (const char * path, struct stat * buf)
+ inode values and owner/group without hacks in the main Emacs code. */
+
+static int
+stat_worker (const char * path, struct stat * buf, int follow_symlinks)
{
- char *name, *r;
+ char *name, *save_name, *r;
WIN32_FIND_DATA wfd;
HANDLE fh;
- unsigned __int64 fake_inode;
+ unsigned __int64 fake_inode = 0;
int permission;
int len;
int rootdir = FALSE;
PSECURITY_DESCRIPTOR psd = NULL;
+ int is_a_symlink = 0;
+ DWORD file_flags = FILE_FLAG_BACKUP_SEMANTICS;
+ DWORD access_rights = 0;
+ DWORD fattrs = 0, serialnum = 0, fs_high = 0, fs_low = 0, nlinks = 1;
+ FILETIME ctime, atime, wtime;
if (path == NULL || buf == NULL)
{
@@ -3324,7 +3512,7 @@ stat (const char * path, struct stat * buf)
return -1;
}
- name = (char *) map_w32_filename (path, &path);
+ save_name = name = (char *) map_w32_filename (path, &path);
/* Must be valid filename, no wild cards or other invalid
characters. We use _mbspbrk to support multibyte strings that
might look to strpbrk as if they included literal *, ?, and other
@@ -3336,99 +3524,67 @@ stat (const char * path, struct stat * buf)
return -1;
}
- /* If name is "c:/.." or "/.." then stat "c:/" or "/". */
- r = IS_DEVICE_SEP (name[1]) ? &name[2] : name;
- if (IS_DIRECTORY_SEP (r[0]) && r[1] == '.' && r[2] == '.' && r[3] == '\0')
- {
- r[1] = r[2] = '\0';
- }
-
/* Remove trailing directory separator, unless name is the root
directory of a drive or UNC volume in which case ensure there
is a trailing separator. */
len = strlen (name);
- rootdir = (path >= name + len - 1
- && (IS_DIRECTORY_SEP (*path) || *path == 0));
name = strcpy (alloca (len + 2), name);
- if (is_unc_volume (name))
- {
- DWORD attrs = unc_volume_file_attributes (name);
-
- if (attrs == -1)
- return -1;
-
- memset (&wfd, 0, sizeof (wfd));
- wfd.dwFileAttributes = attrs;
- wfd.ftCreationTime = utc_base_ft;
- wfd.ftLastAccessTime = utc_base_ft;
- wfd.ftLastWriteTime = utc_base_ft;
- strcpy (wfd.cFileName, name);
- }
- else if (rootdir)
- {
- if (!IS_DIRECTORY_SEP (name[len-1]))
- strcat (name, "\\");
- if (GetDriveType (name) < 2)
- {
- errno = ENOENT;
- return -1;
- }
- memset (&wfd, 0, sizeof (wfd));
- wfd.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY;
- wfd.ftCreationTime = utc_base_ft;
- wfd.ftLastAccessTime = utc_base_ft;
- wfd.ftLastWriteTime = utc_base_ft;
- strcpy (wfd.cFileName, name);
- }
- else
- {
- if (IS_DIRECTORY_SEP (name[len-1]))
- name[len - 1] = 0;
-
- /* (This is hacky, but helps when doing file completions on
- network drives.) Optimize by using information available from
- active readdir if possible. */
- len = strlen (dir_pathname);
- if (IS_DIRECTORY_SEP (dir_pathname[len-1]))
- len--;
- if (dir_find_handle != INVALID_HANDLE_VALUE
- && strnicmp (name, dir_pathname, len) == 0
- && IS_DIRECTORY_SEP (name[len])
- && xstrcasecmp (name + len + 1, dir_static.d_name) == 0)
- {
- /* This was the last entry returned by readdir. */
- wfd = dir_find_data;
- }
- else
- {
- logon_network_drive (name);
-
- fh = FindFirstFile (name, &wfd);
- if (fh == INVALID_HANDLE_VALUE)
- {
- errno = ENOENT;
- return -1;
- }
- FindClose (fh);
- }
- }
-
+ /* Avoid a somewhat costly call to is_symlink if the filesystem
+ doesn't support symlinks. */
+ if ((volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) != 0)
+ is_a_symlink = is_symlink (name);
+
+ /* Plan A: Open the file and get all the necessary information via
+ the resulting handle. This solves several issues in one blow:
+
+ . retrieves attributes for the target of a symlink, if needed
+ . gets attributes of root directories and symlinks pointing to
+ root directories, thus avoiding the need for special-casing
+ these and detecting them by examining the file-name format
+ . retrieves more accurate attributes (e.g., non-zero size for
+ some directories, esp. directories that are junction points)
+ . correctly resolves "c:/..", "/.." and similar file names
+ . avoids run-time penalties for 99% of use cases
+
+ Plan A is always tried first, unless the user asked not to (but
+ if the file is a symlink and we need to follow links, we try Plan
+ A even if the user asked not to).
+
+ If Plan A fails, we go to Plan B (below), where various
+ potentially expensive techniques must be used to handle "special"
+ files such as UNC volumes etc. */
if (!(NILP (Vw32_get_true_file_attributes)
|| (EQ (Vw32_get_true_file_attributes, Qlocal) && is_slow_fs (name)))
- /* No access rights required to get info. */
- && (fh = CreateFile (name, 0, 0, NULL, OPEN_EXISTING,
- FILE_FLAG_BACKUP_SEMANTICS, NULL))
- != INVALID_HANDLE_VALUE)
+ /* Following symlinks requires getting the info by handle. */
+ || (is_a_symlink && follow_symlinks))
{
+ BY_HANDLE_FILE_INFORMATION info;
+
+ if (is_a_symlink && !follow_symlinks)
+ file_flags |= FILE_FLAG_OPEN_REPARSE_POINT;
+ /* READ_CONTROL access rights are required to get security info
+ by handle. But if the OS doesn't support security in the
+ first place, we don't need to try. */
+ if (is_windows_9x () != TRUE)
+ access_rights |= READ_CONTROL;
+
+ fh = CreateFile (name, access_rights, 0, NULL, OPEN_EXISTING,
+ file_flags, NULL);
+ /* If CreateFile fails with READ_CONTROL, try again with zero as
+ access rights. */
+ if (fh == INVALID_HANDLE_VALUE && access_rights)
+ fh = CreateFile (name, 0, 0, NULL, OPEN_EXISTING,
+ file_flags, NULL);
+ if (fh == INVALID_HANDLE_VALUE)
+ goto no_true_file_attributes;
+
/* This is more accurate in terms of getting the correct number
of links, but is quite slow (it is noticeable when Emacs is
making a list of file name completions). */
- BY_HANDLE_FILE_INFORMATION info;
-
if (GetFileInformationByHandle (fh, &info))
{
- buf->st_nlink = info.nNumberOfLinks;
+ nlinks = info.nNumberOfLinks;
/* Might as well use file index to fake inode values, but this
is not guaranteed to be unique unless we keep a handle open
all the time (even then there are situations where it is
@@ -3437,20 +3593,53 @@ stat (const char * path, struct stat * buf)
fake_inode = info.nFileIndexHigh;
fake_inode <<= 32;
fake_inode += info.nFileIndexLow;
+ serialnum = info.dwVolumeSerialNumber;
+ fs_high = info.nFileSizeHigh;
+ fs_low = info.nFileSizeLow;
+ ctime = info.ftCreationTime;
+ atime = info.ftLastAccessTime;
+ wtime = info.ftLastWriteTime;
+ fattrs = info.dwFileAttributes;
}
else
{
- buf->st_nlink = 1;
- fake_inode = 0;
+ /* We don't go to Plan B here, because it's not clear that
+ it's a good idea. The only known use case where
+ CreateFile succeeds, but GetFileInformationByHandle fails
+ (with ERROR_INVALID_FUNCTION) is for character devices
+ such as NUL, PRN, etc. For these, switching to Plan B is
+ a net loss, because we lose the character device
+ attribute returned by GetFileType below (FindFirstFile
+ doesn't set that bit in the attributes), and the other
+ fields don't make sense for character devices anyway.
+ Emacs doesn't really care for non-file entities in the
+ context of l?stat, so neither do we. */
+
+ /* w32err is assigned so one could put a breakpoint here and
+ examine its value, when GetFileInformationByHandle
+ fails. */
+ DWORD w32err = GetLastError ();
+
+ switch (w32err)
+ {
+ case ERROR_FILE_NOT_FOUND: /* can this ever happen? */
+ errno = ENOENT;
+ return -1;
+ }
}
- if (wfd.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
- {
- buf->st_mode = S_IFDIR;
- }
+ /* Test for a symlink before testing for a directory, since
+ symlinks to directories have the directory bit set, but we
+ don't want them to appear as directories. */
+ if (is_a_symlink && !follow_symlinks)
+ buf->st_mode = S_IFLNK;
+ else if (fattrs & FILE_ATTRIBUTE_DIRECTORY)
+ buf->st_mode = S_IFDIR;
else
{
- switch (GetFileType (fh))
+ DWORD ftype = GetFileType (fh);
+
+ switch (ftype)
{
case FILE_TYPE_DISK:
buf->st_mode = S_IFREG;
@@ -3464,21 +3653,143 @@ stat (const char * path, struct stat * buf)
buf->st_mode = S_IFCHR;
}
}
+ /* We produce the fallback owner and group data, based on the
+ current user that runs Emacs, in the following cases:
+
+ . this is Windows 9X
+ . getting security by handle failed, and we need to produce
+ information for the target of a symlink (this is better
+ than producing a potentially misleading info about the
+ symlink itself)
+
+ If getting security by handle fails, and we don't need to
+ resolve symlinks, we try getting security by name. */
+ if (is_windows_9x () != TRUE)
+ psd = get_file_security_desc_by_handle (fh);
+ if (psd)
+ {
+ get_file_owner_and_group (psd, name, buf);
+ LocalFree (psd);
+ }
+ else if (is_windows_9x () == TRUE)
+ get_file_owner_and_group (NULL, name, buf);
+ else if (!(is_a_symlink && follow_symlinks))
+ {
+ psd = get_file_security_desc_by_name (name);
+ get_file_owner_and_group (psd, name, buf);
+ xfree (psd);
+ }
+ else
+ get_file_owner_and_group (NULL, name, buf);
CloseHandle (fh);
- psd = get_file_security_desc (name);
- get_file_owner_and_group (psd, name, buf);
}
else
{
- /* Don't bother to make this information more accurate. */
- buf->st_mode = (wfd.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) ?
- S_IFDIR : S_IFREG;
- buf->st_nlink = 1;
- fake_inode = 0;
+ no_true_file_attributes:
+ /* Plan B: Either getting a handle on the file failed, or the
+ caller explicitly asked us to not bother making this
+ information more accurate.
+
+ Implementation note: In Plan B, we never bother to resolve
+ symlinks, even if we got here because we tried Plan A and
+ failed. That's because, even if the caller asked for extra
+ precision by setting Vw32_get_true_file_attributes to t,
+ resolving symlinks requires acquiring a file handle to the
+ symlink, which we already know will fail. And if the user
+ did not ask for extra precision, resolving symlinks will fly
+ in the face of that request, since the user then wants the
+ lightweight version of the code. */
+ rootdir = (path >= save_name + len - 1
+ && (IS_DIRECTORY_SEP (*path) || *path == 0));
+
+ /* If name is "c:/.." or "/.." then stat "c:/" or "/". */
+ r = IS_DEVICE_SEP (name[1]) ? &name[2] : name;
+ if (IS_DIRECTORY_SEP (r[0])
+ && r[1] == '.' && r[2] == '.' && r[3] == '\0')
+ r[1] = r[2] = '\0';
+
+ /* Note: If NAME is a symlink to the root of a UNC volume
+ (i.e. "\\SERVER"), we will not detect that here, and we will
+ return data about the symlink as result of FindFirst below.
+ This is unfortunate, but that marginal use case does not
+ justify a call to chase_symlinks which would impose a penalty
+ on all the other use cases. (We get here for symlinks to
+ roots of UNC volumes because CreateFile above fails for them,
+ unlike with symlinks to root directories X:\ of drives.) */
+ if (is_unc_volume (name))
+ {
+ fattrs = unc_volume_file_attributes (name);
+ if (fattrs == -1)
+ return -1;
+
+ ctime = atime = wtime = utc_base_ft;
+ }
+ else if (rootdir)
+ {
+ if (!IS_DIRECTORY_SEP (name[len-1]))
+ strcat (name, "\\");
+ if (GetDriveType (name) < 2)
+ {
+ errno = ENOENT;
+ return -1;
+ }
+
+ fattrs = FILE_ATTRIBUTE_DIRECTORY;
+ ctime = atime = wtime = utc_base_ft;
+ }
+ else
+ {
+ if (IS_DIRECTORY_SEP (name[len-1]))
+ name[len - 1] = 0;
+
+ /* (This is hacky, but helps when doing file completions on
+ network drives.) Optimize by using information available from
+ active readdir if possible. */
+ len = strlen (dir_pathname);
+ if (IS_DIRECTORY_SEP (dir_pathname[len-1]))
+ len--;
+ if (dir_find_handle != INVALID_HANDLE_VALUE
+ && !(is_a_symlink && follow_symlinks)
+ && strnicmp (save_name, dir_pathname, len) == 0
+ && IS_DIRECTORY_SEP (name[len])
+ && xstrcasecmp (name + len + 1, dir_static.d_name) == 0)
+ {
+ /* This was the last entry returned by readdir. */
+ wfd = dir_find_data;
+ }
+ else
+ {
+ logon_network_drive (name);
+
+ fh = FindFirstFile (name, &wfd);
+ if (fh == INVALID_HANDLE_VALUE)
+ {
+ errno = ENOENT;
+ return -1;
+ }
+ FindClose (fh);
+ }
+ /* Note: if NAME is a symlink, the information we get from
+ FindFirstFile is for the symlink, not its target. */
+ fattrs = wfd.dwFileAttributes;
+ ctime = wfd.ftCreationTime;
+ atime = wfd.ftLastAccessTime;
+ wtime = wfd.ftLastWriteTime;
+ fs_high = wfd.nFileSizeHigh;
+ fs_low = wfd.nFileSizeLow;
+ fake_inode = 0;
+ nlinks = 1;
+ serialnum = volume_info.serialnum;
+ }
+ if (is_a_symlink && !follow_symlinks)
+ buf->st_mode = S_IFLNK;
+ else if (fattrs & FILE_ATTRIBUTE_DIRECTORY)
+ buf->st_mode = S_IFDIR;
+ else
+ buf->st_mode = S_IFREG;
get_file_owner_and_group (NULL, name, buf);
}
- xfree (psd);
#if 0
/* Not sure if there is any point in this. */
@@ -3492,43 +3803,56 @@ stat (const char * path, struct stat * buf)
}
#endif
- /* MSVC defines _ino_t to be short; other libc's might not. */
- if (sizeof (buf->st_ino) == 2)
- buf->st_ino = fake_inode ^ (fake_inode >> 16);
- else
- buf->st_ino = fake_inode;
+ buf->st_ino = fake_inode;
- /* volume_info is set indirectly by map_w32_filename */
- buf->st_dev = volume_info.serialnum;
- buf->st_rdev = volume_info.serialnum;
+ buf->st_dev = serialnum;
+ buf->st_rdev = serialnum;
- buf->st_size = wfd.nFileSizeHigh;
+ buf->st_size = fs_high;
buf->st_size <<= 32;
- buf->st_size += wfd.nFileSizeLow;
+ buf->st_size += fs_low;
+ buf->st_nlink = nlinks;
/* Convert timestamps to Unix format. */
- buf->st_mtime = convert_time (wfd.ftLastWriteTime);
- buf->st_atime = convert_time (wfd.ftLastAccessTime);
+ buf->st_mtime = convert_time (wtime);
+ buf->st_atime = convert_time (atime);
if (buf->st_atime == 0) buf->st_atime = buf->st_mtime;
- buf->st_ctime = convert_time (wfd.ftCreationTime);
+ buf->st_ctime = convert_time (ctime);
if (buf->st_ctime == 0) buf->st_ctime = buf->st_mtime;
/* determine rwx permissions */
- if (wfd.dwFileAttributes & FILE_ATTRIBUTE_READONLY)
- permission = S_IREAD;
+ if (is_a_symlink && !follow_symlinks)
+ permission = S_IREAD | S_IWRITE | S_IEXEC; /* Posix expectations */
else
- permission = S_IREAD | S_IWRITE;
+ {
+ if (fattrs & FILE_ATTRIBUTE_READONLY)
+ permission = S_IREAD;
+ else
+ permission = S_IREAD | S_IWRITE;
- if (wfd.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
- permission |= S_IEXEC;
- else if (is_exec (name))
- permission |= S_IEXEC;
+ if (fattrs & FILE_ATTRIBUTE_DIRECTORY)
+ permission |= S_IEXEC;
+ else if (is_exec (name))
+ permission |= S_IEXEC;
+ }
buf->st_mode |= permission | (permission >> 3) | (permission >> 6);
return 0;
}
+int
+stat (const char * path, struct stat * buf)
+{
+ return stat_worker (path, buf, 1);
+}
+
+int
+lstat (const char * path, struct stat * buf)
+{
+ return stat_worker (path, buf, 0);
+}
+
/* Provide fstat and utime as well as stat for consistent handling of
file timestamps. */
int
@@ -3646,9 +3970,13 @@ utime (const char *name, struct utimbuf *times)
}
/* Need write access to set times. */
- fh = CreateFile (name, GENERIC_WRITE, FILE_SHARE_READ | FILE_SHARE_WRITE,
- 0, OPEN_EXISTING, 0, NULL);
- if (fh)
+ fh = CreateFile (name, FILE_WRITE_ATTRIBUTES,
+ /* If NAME specifies a directory, FILE_SHARE_DELETE
+ allows other processes to delete files inside it,
+ while we have the directory open. */
+ FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
+ 0, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ if (fh != INVALID_HANDLE_VALUE)
{
convert_from_time_t (times->actime, &atime);
convert_from_time_t (times->modtime, &mtime);
@@ -3669,31 +3997,460 @@ utime (const char *name, struct utimbuf *times)
}
-/* Symlink-related functions that always fail. Used in fileio.c and in
- sysdep.c to avoid #ifdef's. */
+/* Symlink-related functions. */
+#ifndef SYMBOLIC_LINK_FLAG_DIRECTORY
+#define SYMBOLIC_LINK_FLAG_DIRECTORY 0x1
+#endif
+
int
-symlink (char const *dummy1, char const *dummy2)
+symlink (char const *filename, char const *linkname)
{
- errno = ENOSYS;
- return -1;
+ char linkfn[MAX_PATH], *tgtfn;
+ DWORD flags = 0;
+ int dir_access, filename_ends_in_slash;
+
+ /* Diagnostics follows Posix as much as possible. */
+ if (filename == NULL || linkname == NULL)
+ {
+ errno = EFAULT;
+ return -1;
+ }
+ if (!*filename)
+ {
+ errno = ENOENT;
+ return -1;
+ }
+ if (strlen (filename) > MAX_PATH || strlen (linkname) > MAX_PATH)
+ {
+ errno = ENAMETOOLONG;
+ return -1;
+ }
+
+ strcpy (linkfn, map_w32_filename (linkname, NULL));
+ if ((volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) == 0)
+ {
+ errno = EPERM;
+ return -1;
+ }
+
+ /* Note: since empty FILENAME was already rejected, we can safely
+ refer to FILENAME[1]. */
+ if (!(IS_DIRECTORY_SEP (filename[0]) || IS_DEVICE_SEP (filename[1])))
+ {
+ /* Non-absolute FILENAME is understood as being relative to
+ LINKNAME's directory. We need to prepend that directory to
+ FILENAME to get correct results from faccessat below, since
+ otherwise it will interpret FILENAME relative to the
+ directory where the Emacs process runs. Note that
+ make-symbolic-link always makes sure LINKNAME is a fully
+ expanded file name. */
+ char tem[MAX_PATH];
+ char *p = linkfn + strlen (linkfn);
+
+ while (p > linkfn && !IS_ANY_SEP (p[-1]))
+ p--;
+ if (p > linkfn)
+ strncpy (tem, linkfn, p - linkfn);
+ tem[p - linkfn] = '\0';
+ strcat (tem, filename);
+ dir_access = faccessat (AT_FDCWD, tem, D_OK, AT_EACCESS);
+ }
+ else
+ dir_access = faccessat (AT_FDCWD, filename, D_OK, AT_EACCESS);
+
+ /* Since Windows distinguishes between symlinks to directories and
+ to files, we provide a kludgy feature: if FILENAME doesn't
+ exist, but ends in a slash, we create a symlink to directory. If
+ FILENAME exists and is a directory, we always create a symlink to
+ directory. */
+ filename_ends_in_slash = IS_DIRECTORY_SEP (filename[strlen (filename) - 1]);
+ if (dir_access == 0 || filename_ends_in_slash)
+ flags = SYMBOLIC_LINK_FLAG_DIRECTORY;
+
+ tgtfn = (char *)map_w32_filename (filename, NULL);
+ if (filename_ends_in_slash)
+ tgtfn[strlen (tgtfn) - 1] = '\0';
+
+ errno = 0;
+ if (!create_symbolic_link (linkfn, tgtfn, flags))
+ {
+ /* ENOSYS is set by create_symbolic_link, when it detects that
+ the OS doesn't support the CreateSymbolicLink API. */
+ if (errno != ENOSYS)
+ {
+ DWORD w32err = GetLastError ();
+
+ switch (w32err)
+ {
+ /* ERROR_SUCCESS is sometimes returned when LINKFN and
+ TGTFN point to the same file name, go figure. */
+ case ERROR_SUCCESS:
+ case ERROR_FILE_EXISTS:
+ errno = EEXIST;
+ break;
+ case ERROR_ACCESS_DENIED:
+ errno = EACCES;
+ break;
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_PATH_NOT_FOUND:
+ case ERROR_BAD_NETPATH:
+ case ERROR_INVALID_REPARSE_DATA:
+ errno = ENOENT;
+ break;
+ case ERROR_DIRECTORY:
+ errno = EISDIR;
+ break;
+ case ERROR_PRIVILEGE_NOT_HELD:
+ case ERROR_NOT_ALL_ASSIGNED:
+ errno = EPERM;
+ break;
+ case ERROR_DISK_FULL:
+ errno = ENOSPC;
+ break;
+ default:
+ errno = EINVAL;
+ break;
+ }
+ }
+ return -1;
+ }
+ return 0;
}
+/* A quick inexpensive test of whether FILENAME identifies a file that
+ is a symlink. Returns non-zero if it is, zero otherwise. FILENAME
+ must already be in the normalized form returned by
+ map_w32_filename.
+
+ Note: for repeated operations on many files, it is best to test
+ whether the underlying volume actually supports symlinks, by
+ testing the FILE_SUPPORTS_REPARSE_POINTS bit in volume's flags, and
+ avoid the call to this function if it doesn't. That's because the
+ call to GetFileAttributes takes a non-negligible time, especially
+ on non-local or removable filesystems. See stat_worker for an
+ example of how to do that. */
+static int
+is_symlink (const char *filename)
+{
+ DWORD attrs;
+ WIN32_FIND_DATA wfd;
+ HANDLE fh;
+
+ attrs = GetFileAttributes (filename);
+ if (attrs == -1)
+ {
+ DWORD w32err = GetLastError ();
+
+ switch (w32err)
+ {
+ case ERROR_BAD_NETPATH: /* network share, can't be a symlink */
+ break;
+ case ERROR_ACCESS_DENIED:
+ errno = EACCES;
+ break;
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_PATH_NOT_FOUND:
+ default:
+ errno = ENOENT;
+ break;
+ }
+ return 0;
+ }
+ if ((attrs & FILE_ATTRIBUTE_REPARSE_POINT) == 0)
+ return 0;
+ logon_network_drive (filename);
+ fh = FindFirstFile (filename, &wfd);
+ if (fh == INVALID_HANDLE_VALUE)
+ return 0;
+ FindClose (fh);
+ return (wfd.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT) != 0
+ && (wfd.dwReserved0 & IO_REPARSE_TAG_SYMLINK) == IO_REPARSE_TAG_SYMLINK;
+}
+
+/* If NAME identifies a symbolic link, copy into BUF the file name of
+ the symlink's target. Copy at most BUF_SIZE bytes, and do NOT
+ null-terminate the target name, even if it fits. Return the number
+ of bytes copied, or -1 if NAME is not a symlink or any error was
+ encountered while resolving it. The file name copied into BUF is
+ encoded in the current ANSI codepage. */
ssize_t
-readlink (const char *name, char *dummy1, size_t dummy2)
+readlink (const char *name, char *buf, size_t buf_size)
{
- /* `access' is much faster than `stat' on MS-Windows. */
- if (sys_access (name, 0) == 0)
- errno = EINVAL;
- return -1;
+ const char *path;
+ TOKEN_PRIVILEGES privs;
+ int restore_privs = 0;
+ HANDLE sh;
+ ssize_t retval;
+
+ if (name == NULL)
+ {
+ errno = EFAULT;
+ return -1;
+ }
+ if (!*name)
+ {
+ errno = ENOENT;
+ return -1;
+ }
+
+ path = map_w32_filename (name, NULL);
+
+ if (strlen (path) > MAX_PATH)
+ {
+ errno = ENAMETOOLONG;
+ return -1;
+ }
+
+ errno = 0;
+ if (is_windows_9x () == TRUE
+ || (volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) == 0
+ || !is_symlink (path))
+ {
+ if (!errno)
+ errno = EINVAL; /* not a symlink */
+ return -1;
+ }
+
+ /* Done with simple tests, now we're in for some _real_ work. */
+ if (enable_privilege (SE_BACKUP_NAME, TRUE, &privs))
+ restore_privs = 1;
+ /* Implementation note: From here and onward, don't return early,
+ since that will fail to restore the original set of privileges of
+ the calling thread. */
+
+ retval = -1; /* not too optimistic, are we? */
+
+ /* Note: In the next call to CreateFile, we use zero as the 2nd
+ argument because, when the symlink is a hidden/system file,
+ e.g. 'C:\Users\All Users', GENERIC_READ fails with
+ ERROR_ACCESS_DENIED. Zero seems to work just fine, both for file
+ and directory symlinks. */
+ sh = CreateFile (path, 0, 0, NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS,
+ NULL);
+ if (sh != INVALID_HANDLE_VALUE)
+ {
+ BYTE reparse_buf[MAXIMUM_REPARSE_DATA_BUFFER_SIZE];
+ REPARSE_DATA_BUFFER *reparse_data = (REPARSE_DATA_BUFFER *)&reparse_buf[0];
+ DWORD retbytes;
+
+ if (!DeviceIoControl (sh, FSCTL_GET_REPARSE_POINT, NULL, 0,
+ reparse_buf, MAXIMUM_REPARSE_DATA_BUFFER_SIZE,
+ &retbytes, NULL))
+ errno = EIO;
+ else if (reparse_data->ReparseTag != IO_REPARSE_TAG_SYMLINK)
+ errno = EINVAL;
+ else
+ {
+ /* Copy the link target name, in wide characters, fro
+ reparse_data, then convert it to multibyte encoding in
+ the current locale's codepage. */
+ WCHAR *lwname;
+ BYTE lname[MAX_PATH];
+ USHORT lname_len;
+ USHORT lwname_len =
+ reparse_data->SymbolicLinkReparseBuffer.PrintNameLength;
+ WCHAR *lwname_src =
+ reparse_data->SymbolicLinkReparseBuffer.PathBuffer
+ + reparse_data->SymbolicLinkReparseBuffer.PrintNameOffset/sizeof(WCHAR);
+
+ /* According to MSDN, PrintNameLength does not include the
+ terminating null character. */
+ lwname = alloca ((lwname_len + 1) * sizeof(WCHAR));
+ memcpy (lwname, lwname_src, lwname_len);
+ lwname[lwname_len/sizeof(WCHAR)] = 0; /* null-terminate */
+
+ /* FIXME: Should we use the current file-name coding system
+ instead of the fixed value of the ANSI codepage? */
+ lname_len = WideCharToMultiByte (w32_ansi_code_page, 0, lwname, -1,
+ lname, MAX_PATH, NULL, NULL);
+ if (!lname_len)
+ {
+ /* WideCharToMultiByte failed. */
+ DWORD w32err1 = GetLastError ();
+
+ switch (w32err1)
+ {
+ case ERROR_INSUFFICIENT_BUFFER:
+ errno = ENAMETOOLONG;
+ break;
+ case ERROR_INVALID_PARAMETER:
+ errno = EFAULT;
+ break;
+ case ERROR_NO_UNICODE_TRANSLATION:
+ errno = ENOENT;
+ break;
+ default:
+ errno = EINVAL;
+ break;
+ }
+ }
+ else
+ {
+ size_t size_to_copy = buf_size;
+ BYTE *p = lname;
+ BYTE *pend = p + lname_len;
+
+ /* Normalize like dostounix_filename does, but we don't
+ want to assume that lname is null-terminated. */
+ if (*p && p[1] == ':' && *p >= 'A' && *p <= 'Z')
+ *p += 'a' - 'A';
+ while (p <= pend)
+ {
+ if (*p == '\\')
+ *p = '/';
+ ++p;
+ }
+ /* Testing for null-terminated LNAME is paranoia:
+ WideCharToMultiByte should always return a
+ null-terminated string when its 4th argument is -1
+ and its 3rd argument is null-terminated (which they
+ are, see above). */
+ if (lname[lname_len - 1] == '\0')
+ lname_len--;
+ if (lname_len <= buf_size)
+ size_to_copy = lname_len;
+ strncpy (buf, lname, size_to_copy);
+ /* Success! */
+ retval = size_to_copy;
+ }
+ }
+ CloseHandle (sh);
+ }
+ else
+ {
+ /* CreateFile failed. */
+ DWORD w32err2 = GetLastError ();
+
+ switch (w32err2)
+ {
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_PATH_NOT_FOUND:
+ errno = ENOENT;
+ break;
+ case ERROR_ACCESS_DENIED:
+ case ERROR_TOO_MANY_OPEN_FILES:
+ errno = EACCES;
+ break;
+ default:
+ errno = EPERM;
+ break;
+ }
+ }
+ if (restore_privs)
+ {
+ restore_privilege (&privs);
+ revert_to_self ();
+ }
+
+ return retval;
+}
+
+/* If FILE is a symlink, return its target (stored in a static
+ buffer); otherwise return FILE.
+
+ This function repeatedly resolves symlinks in the last component of
+ a chain of symlink file names, as in foo -> bar -> baz -> ...,
+ until it arrives at a file whose last component is not a symlink,
+ or some error occurs. It returns the target of the last
+ successfully resolved symlink in the chain. If it succeeds to
+ resolve even a single symlink, the value returned is an absolute
+ file name with backslashes (result of GetFullPathName). By
+ contrast, if the original FILE is returned, it is unaltered.
+
+ Note: This function can set errno even if it succeeds.
+
+ Implementation note: we only resolve the last portion ("basename")
+ of the argument FILE and of each following file in the chain,
+ disregarding any possible symlinks in its leading directories.
+ This is because Windows system calls and library functions
+ transparently resolve symlinks in leading directories and return
+ correct information, as long as the basename is not a symlink. */
+static char *
+chase_symlinks (const char *file)
+{
+ static char target[MAX_PATH];
+ char link[MAX_PATH];
+ ssize_t res, link_len;
+ int loop_count = 0;
+
+ if (is_windows_9x () == TRUE || !is_symlink (file))
+ return (char *)file;
+
+ if ((link_len = GetFullPathName (file, MAX_PATH, link, NULL)) == 0)
+ return (char *)file;
+
+ target[0] = '\0';
+ do {
+
+ /* Remove trailing slashes, as we want to resolve the last
+ non-trivial part of the link name. */
+ while (link_len > 3 && IS_DIRECTORY_SEP (link[link_len-1]))
+ link[link_len--] = '\0';
+
+ res = readlink (link, target, MAX_PATH);
+ if (res > 0)
+ {
+ target[res] = '\0';
+ if (!(IS_DEVICE_SEP (target[1])
+ || (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]))))
+ {
+ /* Target is relative. Append it to the directory part of
+ the symlink, then copy the result back to target. */
+ char *p = link + link_len;
+
+ while (p > link && !IS_ANY_SEP (p[-1]))
+ p--;
+ strcpy (p, target);
+ strcpy (target, link);
+ }
+ /* Resolve any "." and ".." to get a fully-qualified file name
+ in link[] again. */
+ link_len = GetFullPathName (target, MAX_PATH, link, NULL);
+ }
+ } while (res > 0 && link_len > 0 && ++loop_count <= 100);
+
+ if (loop_count > 100)
+ errno = ELOOP;
+
+ if (target[0] == '\0') /* not a single call to readlink succeeded */
+ return (char *)file;
+ return target;
}
+/* MS-Windows version of careadlinkat (cf. ../lib/careadlinkat.c). We
+ have a fixed max size for file names, so we don't need the kind of
+ alloc/malloc/realloc dance the gnulib version does. We also don't
+ support FD-relative symlinks. */
char *
careadlinkat (int fd, char const *filename,
char *buffer, size_t buffer_size,
struct allocator const *alloc,
ssize_t (*preadlinkat) (int, char const *, char *, size_t))
{
- errno = ENOSYS;
+ char linkname[MAX_PATH];
+ ssize_t link_size;
+
+ if (fd != AT_FDCWD)
+ {
+ errno = EINVAL;
+ return NULL;
+ }
+
+ link_size = preadlinkat (fd, filename, linkname, sizeof(linkname));
+
+ if (link_size > 0)
+ {
+ char *retval = buffer;
+
+ linkname[link_size++] = '\0';
+ if (link_size > buffer_size)
+ retval = (char *)(alloc ? alloc->allocate : xmalloc) (link_size);
+ if (retval)
+ memcpy (retval, linkname, link_size);
+
+ return retval;
+ }
return NULL;
}
@@ -4038,14 +4795,17 @@ restore_privilege (TOKEN_PRIVILEGES *priv)
}
static Lisp_Object
-ltime (long time_sec, long time_usec)
+ltime (ULONGLONG time_100ns)
{
- return list3 (make_number ((time_sec >> 16) & 0xffff),
+ ULONGLONG time_sec = time_100ns / 10000000;
+ int subsec = time_100ns % 10000000;
+ return list4 (make_number (time_sec >> 16),
make_number (time_sec & 0xffff),
- make_number (time_usec));
+ make_number (subsec / 10),
+ make_number (subsec % 10 * 100000));
}
-#define U64_TO_LISP_TIME(time) ltime ((time) / 1000000L, (time) % 1000000L)
+#define U64_TO_LISP_TIME(time) ltime (time)
static int
process_times (HANDLE h_proc, Lisp_Object *ctime, Lisp_Object *etime,
@@ -4064,11 +4824,9 @@ process_times (HANDLE h_proc, Lisp_Object *ctime, Lisp_Object *etime,
GetSystemTimeAsFileTime (&ft_current);
FILETIME_TO_U64 (tem1, ft_kernel);
- tem1 /= 10L;
*stime = U64_TO_LISP_TIME (tem1);
FILETIME_TO_U64 (tem2, ft_user);
- tem2 /= 10L;
*utime = U64_TO_LISP_TIME (tem2);
tem3 = tem1 + tem2;
@@ -4077,13 +4835,13 @@ process_times (HANDLE h_proc, Lisp_Object *ctime, Lisp_Object *etime,
FILETIME_TO_U64 (tem, ft_creation);
/* Process no 4 (System) returns zero creation time. */
if (tem)
- tem = (tem - utc_base) / 10L;
+ tem -= utc_base;
*ctime = U64_TO_LISP_TIME (tem);
if (tem)
{
FILETIME_TO_U64 (tem3, ft_current);
- tem = (tem3 - utc_base) / 10L - tem;
+ tem = (tem3 - utc_base) - tem;
}
*etime = U64_TO_LISP_TIME (tem);
@@ -4790,7 +5548,7 @@ socket_to_fd (SOCKET s)
if (fd_info[ fd ].cp != NULL)
{
DebPrint (("sys_socket: fd_info[%d] apparently in use!\n", fd));
- abort ();
+ emacs_abort ();
}
fd_info[ fd ].cp = cp;
@@ -5113,7 +5871,7 @@ fcntl (int s, int cmd, int options)
check_errno ();
if (fd_info[s].flags & FILE_SOCKET)
{
- if (cmd == F_SETFL && options == O_NDELAY)
+ if (cmd == F_SETFL && options == O_NONBLOCK)
{
unsigned long nblock = 1;
int rc = pfn_ioctlsocket (SOCK_HANDLE (s), FIONBIO, &nblock);
@@ -5169,7 +5927,7 @@ sys_close (int fd)
{
if (fd_info[fd].flags & FILE_SOCKET)
{
- if (winsock_lib == NULL) abort ();
+ if (winsock_lib == NULL) emacs_abort ();
pfn_shutdown (SOCK_HANDLE (fd), 2);
rc = pfn_closesocket (SOCK_HANDLE (fd));
@@ -5287,7 +6045,7 @@ _sys_read_ahead (int fd)
|| (fd_info[fd].flags & FILE_READ) == 0)
{
DebPrint (("_sys_read_ahead: internal error: fd %d is not a pipe, serial port, or socket!\n", fd));
- abort ();
+ emacs_abort ();
}
cp->status = STATUS_READ_IN_PROGRESS;
@@ -5423,7 +6181,7 @@ sys_read (int fd, char * buffer, unsigned int count)
/* re-read CR carried over from last read */
if (fd_info[fd].flags & FILE_LAST_CR)
{
- if (fd_info[fd].flags & FILE_BINARY) abort ();
+ if (fd_info[fd].flags & FILE_BINARY) emacs_abort ();
*buffer++ = 0x0d;
count--;
nchars++;
@@ -5526,7 +6284,7 @@ sys_read (int fd, char * buffer, unsigned int count)
}
else /* FILE_SOCKET */
{
- if (winsock_lib == NULL) abort ();
+ if (winsock_lib == NULL) emacs_abort ();
/* do the equivalent of a non-blocking read */
pfn_ioctlsocket (SOCK_HANDLE (fd), FIONREAD, &waiting);
@@ -5677,7 +6435,7 @@ sys_write (int fd, const void * buffer, unsigned int count)
else if (fd < MAXDESC && fd_info[fd].flags & FILE_SOCKET)
{
unsigned long nblock = 0;
- if (winsock_lib == NULL) abort ();
+ if (winsock_lib == NULL) emacs_abort ();
/* TODO: implement select() properly so non-blocking I/O works. */
/* For now, make sure the write blocks. */
@@ -5749,33 +6507,27 @@ sys_localtime (const time_t *t)
-/* Delayed loading of libraries. */
-
-Lisp_Object Vlibrary_cache;
-
-/* The argument LIBRARIES is an alist that associates a symbol
- LIBRARY_ID, identifying an external DLL library known to Emacs, to
- a list of filenames under which the library is usually found. In
- most cases, the argument passed as LIBRARIES is the variable
- `dynamic-library-alist', which is initialized to a list of common
- library names. If the function loads the library successfully, it
- returns the handle of the DLL, and records the filename in the
- property :loaded-from of LIBRARY_ID; it returns NULL if the library
- could not be found, or when it was already loaded (because the
- handle is not recorded anywhere, and so is lost after use). It
- would be trivial to save the handle too in :loaded-from, but
- currently there's no use case for it. */
+/* Try loading LIBRARY_ID from the file(s) specified in
+ Vdynamic_library_alist. If the library is loaded successfully,
+ return the handle of the DLL, and record the filename in the
+ property :loaded-from of LIBRARY_ID. If the library could not be
+ found, or when it was already loaded (because the handle is not
+ recorded anywhere, and so is lost after use), return NULL.
+
+ We could also save the handle in :loaded-from, but currently
+ there's no use case for it. */
HMODULE
-w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)
+w32_delayed_load (Lisp_Object library_id)
{
HMODULE library_dll = NULL;
CHECK_SYMBOL (library_id);
- if (CONSP (libraries) && NILP (Fassq (library_id, Vlibrary_cache)))
+ if (CONSP (Vdynamic_library_alist)
+ && NILP (Fassq (library_id, Vlibrary_cache)))
{
Lisp_Object found = Qnil;
- Lisp_Object dlls = Fassq (library_id, libraries);
+ Lisp_Object dlls = Fassq (library_id, Vdynamic_library_alist);
if (CONSP (dlls))
for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
@@ -5783,7 +6535,15 @@ w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)
CHECK_STRING_CAR (dlls);
if ((library_dll = LoadLibrary (SDATA (XCAR (dlls)))))
{
- found = XCAR (dlls);
+ char name[MAX_PATH];
+ DWORD len;
+
+ len = GetModuleFileNameA (library_dll, name, sizeof (name));
+ found = Fcons (XCAR (dlls),
+ (len > 0)
+ /* Possibly truncated */
+ ? make_specified_string (name, -1, len, 1)
+ : Qnil);
break;
}
}
@@ -5795,7 +6555,7 @@ w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)
}
-static void
+void
check_windows_init_file (void)
{
/* A common indication that Emacs is not installed properly is when
@@ -5807,19 +6567,14 @@ check_windows_init_file (void)
loadup.el. */
&& NILP (Vpurify_flag))
{
- Lisp_Object objs[2];
- Lisp_Object full_load_path;
Lisp_Object init_file;
int fd;
- objs[0] = Vload_path;
- objs[1] = decode_env_path (0, (getenv ("EMACSLOADPATH")));
- full_load_path = Fappend (2, objs);
init_file = build_string ("term/w32-win");
- fd = openp (full_load_path, init_file, Fget_load_suffixes (), NULL, Qnil);
+ fd = openp (Vload_path, init_file, Fget_load_suffixes (), NULL, Qnil);
if (fd < 0)
{
- Lisp_Object load_path_print = Fprin1_to_string (full_load_path, Qnil);
+ Lisp_Object load_path_print = Fprin1_to_string (Vload_path, Qnil);
char *init_file_name = SDATA (init_file);
char *load_path = SDATA (load_path_print);
char *buffer = alloca (1024
@@ -5840,8 +6595,7 @@ check_windows_init_file (void)
buffer,
"Emacs Abort Dialog",
MB_OK | MB_ICONEXCLAMATION | MB_TASKMODAL);
- /* Use the low-level Emacs abort. */
-#undef abort
+ /* Use the low-level system abort. */
abort ();
}
else
@@ -5852,8 +6606,12 @@ check_windows_init_file (void)
}
void
-term_ntproc (void)
+term_ntproc (int ignored)
{
+ (void)ignored;
+
+ term_timers ();
+
/* shutdown the socket interface if necessary */
term_winsock ();
@@ -5861,8 +6619,10 @@ term_ntproc (void)
}
void
-init_ntproc (void)
+init_ntproc (int dumping)
{
+ sigset_t initial_mask = 0;
+
/* Initialize the socket interface now if available and requested by
the user by defining PRELOAD_WINSOCK; otherwise loading will be
delayed until open-network-stream is called (w32-has-winsock can
@@ -5918,19 +6678,19 @@ init_ntproc (void)
fclose (stderr);
if (stdin_save != INVALID_HANDLE_VALUE)
- _open_osfhandle ((long) stdin_save, O_TEXT);
+ _open_osfhandle ((intptr_t) stdin_save, O_TEXT);
else
_open ("nul", O_TEXT | O_NOINHERIT | O_RDONLY);
_fdopen (0, "r");
if (stdout_save != INVALID_HANDLE_VALUE)
- _open_osfhandle ((long) stdout_save, O_TEXT);
+ _open_osfhandle ((intptr_t) stdout_save, O_TEXT);
else
_open ("nul", O_TEXT | O_NOINHERIT | O_WRONLY);
_fdopen (1, "w");
if (stderr_save != INVALID_HANDLE_VALUE)
- _open_osfhandle ((long) stderr_save, O_TEXT);
+ _open_osfhandle ((intptr_t) stderr_save, O_TEXT);
else
_open ("nul", O_TEXT | O_NOINHERIT | O_WRONLY);
_fdopen (2, "w");
@@ -5938,7 +6698,13 @@ init_ntproc (void)
/* unfortunately, atexit depends on implementation of malloc */
/* atexit (term_ntproc); */
- signal (SIGABRT, term_ntproc);
+ if (!dumping)
+ {
+ /* Make sure we start with all signals unblocked. */
+ sigprocmask (SIG_SETMASK, &initial_mask, NULL);
+ signal (SIGABRT, term_ntproc);
+ }
+ init_timers ();
/* determine which drives are fixed, for GetCachedVolumeInformation */
{
@@ -5958,9 +6724,6 @@ init_ntproc (void)
/* Reset the volume info cache. */
volume_cache = NULL;
}
-
- /* Check to see if Emacs has been installed correctly. */
- check_windows_init_file ();
}
/*
@@ -5976,7 +6739,7 @@ shutdown_handler (DWORD type)
|| type == CTRL_SHUTDOWN_EVENT) /* User shutsdown. */
{
/* Shut down cleanly, making sure autosave files are up to date. */
- shut_down_emacs (0, 0, Qnil);
+ shut_down_emacs (0, Qnil);
}
/* Allow other handlers to handle this signal. */
@@ -5998,15 +6761,13 @@ globals_of_w32 (void)
DEFSYM (QCloaded_from, ":loaded-from");
- Vlibrary_cache = Qnil;
- staticpro (&Vlibrary_cache);
-
g_b_init_is_windows_9x = 0;
g_b_init_open_process_token = 0;
g_b_init_get_token_information = 0;
g_b_init_lookup_account_sid = 0;
g_b_init_get_sid_sub_authority = 0;
g_b_init_get_sid_sub_authority_count = 0;
+ g_b_init_get_security_info = 0;
g_b_init_get_file_security = 0;
g_b_init_get_security_descriptor_owner = 0;
g_b_init_get_security_descriptor_group = 0;
@@ -6026,6 +6787,7 @@ globals_of_w32 (void)
g_b_init_get_length_sid = 0;
g_b_init_get_native_system_info = 0;
g_b_init_get_system_times = 0;
+ g_b_init_create_symbolic_link = 0;
num_of_processors = 0;
/* The following sets a handler for shutdown notifications for
console apps. This actually applies to Emacs in both console and
@@ -6049,7 +6811,7 @@ serial_open (char *port)
OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
if (hnd == INVALID_HANDLE_VALUE)
error ("Could not open %s", port);
- fd = (int) _open_osfhandle ((int) hnd, 0);
+ fd = (int) _open_osfhandle ((intptr_t) hnd, 0);
if (fd == -1)
error ("Could not open %s", port);
@@ -6224,7 +6986,7 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact)
error ("SetCommState() failed");
childp2 = Fplist_put (childp2, QCsummary, build_string (summary));
- p->childp = childp2;
+ pset_childp (p, childp2);
}
#ifdef HAVE_GNUTLS
@@ -6250,13 +7012,13 @@ emacs_gnutls_pull (gnutls_transport_ptr_t p, void* buf, size_t sz)
if (err == EWOULDBLOCK)
{
/* Set a small timeout. */
- EMACS_SET_SECS_USECS (timeout, 1, 0);
+ timeout = make_emacs_time (1, 0);
FD_ZERO (&fdset);
FD_SET ((int)fd, &fdset);
/* Use select with the timeout to poll the selector. */
sc = select (fd + 1, &fdset, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
- &timeout);
+ &timeout, NULL);
if (sc > 0)
continue; /* Try again. */
diff --git a/src/w32.h b/src/w32.h
index a3ca1130ce6..23eda830268 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -2,7 +2,7 @@
#define EMACS_W32_H
/* Support routines for the NT version of Emacs.
- Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,6 +19,12 @@ 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/>. */
+#ifdef CYGWIN
+#error "w32.h is not compatible with Cygwin"
+#endif
+
+#include <windows.h>
+
/* File descriptor set emulation. */
@@ -127,25 +133,39 @@ extern void reset_standard_handles (int in, int out,
/* Return the string resource associated with KEY of type TYPE. */
extern LPBYTE w32_get_resource (char * key, LPDWORD type);
-extern void init_ntproc (void);
-extern void term_ntproc (void);
+extern void init_ntproc (int);
+extern void term_ntproc (int);
extern void globals_of_w32 (void);
-extern void syms_of_w32term (void);
-extern void syms_of_w32fns (void);
-extern void globals_of_w32fns (void);
-extern void syms_of_w32select (void);
-extern void globals_of_w32select (void);
-extern void term_w32select (void);
-extern void syms_of_w32menu (void);
-extern void globals_of_w32menu (void);
-extern void syms_of_fontset (void);
-extern void syms_of_w32font (void);
+
+extern void term_timers (void);
+extern void init_timers (void);
extern int _sys_read_ahead (int fd);
extern int _sys_wait_accept (int fd);
-extern Lisp_Object Vlibrary_cache, QCloaded_from;
-extern HMODULE w32_delayed_load (Lisp_Object, Lisp_Object);
+extern Lisp_Object QCloaded_from;
+extern HMODULE w32_delayed_load (Lisp_Object);
+
+extern void init_environment (char **);
+extern void check_windows_init_file (void);
+extern void syms_of_ntproc (void);
+extern void syms_of_ntterm (void);
+extern void dostounix_filename (register char *);
+extern void unixtodos_filename (register char *);
+extern BOOL init_winsock (int load_now);
+extern void srandom (int);
+extern int random (void);
+
+extern int sys_pipe (int *);
+
+extern void set_process_dir (char *);
+extern int sys_spawnve (int, char *, char **, char **);
+extern void register_child (int, int);
+
+extern void sys_sleep (int);
+extern int sys_link (const char *, const char *);
+
+
#ifdef HAVE_GNUTLS
#include <gnutls/gnutls.h>
@@ -160,4 +180,3 @@ extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p,
#endif /* HAVE_GNUTLS */
#endif /* EMACS_W32_H */
-
diff --git a/src/w32common.h b/src/w32common.h
new file mode 100644
index 00000000000..50724e5553c
--- /dev/null
+++ b/src/w32common.h
@@ -0,0 +1,53 @@
+/* Common functions for Microsoft Windows builds of Emacs
+ Copyright (C) 2012 Free Software Foundation, Inc.
+
+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/>.
+
+*/
+
+#ifndef W32COMMON_H
+#define W32COMMON_H
+
+#include <windows.h>
+
+#define ROUND_UP(p, align) (((DWORD_PTR)(p) + (align)-1) & ~((DWORD_PTR)(align)-1))
+#define ROUND_DOWN(p, align) ((DWORD_PTR)(p) & ~((DWORD_PTR)(align)-1))
+
+#define get_page_size() sysinfo_cache.dwPageSize
+#define get_allocation_unit() sysinfo_cache.dwAllocationGranularity
+#define get_processor_type() sysinfo_cache.dwProcessorType
+#define get_w32_major_version() w32_major_version
+#define get_w32_minor_version() w32_minor_version
+
+extern SYSTEM_INFO sysinfo_cache;
+extern OSVERSIONINFO osinfo_cache;
+extern unsigned long syspage_mask;
+
+extern int w32_major_version;
+extern int w32_minor_version;
+extern int w32_build_number;
+
+enum {
+ OS_9X = 1,
+ OS_NT
+};
+
+extern int os_subtype;
+
+/* Cache system info, e.g., the NT page size. */
+extern void cache_system_info (void);
+
+#endif /* W32COMMON_H */
diff --git a/src/w32console.c b/src/w32console.c
index 30c71f1c276..f0574689bf1 100644
--- a/src/w32console.c
+++ b/src/w32console.c
@@ -1,5 +1,5 @@
-/* Terminal hooks for GNU Emacs on the Microsoft W32 API.
- Copyright (C) 1992, 1999, 2001-2011 Free Software Foundation, Inc.
+/* Terminal hooks for GNU Emacs on the Microsoft Windows API.
+ Copyright (C) 1992, 1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -26,16 +26,18 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <stdio.h>
#include <windows.h>
-#include <setjmp.h>
#include "lisp.h"
#include "character.h"
#include "coding.h"
#include "disptab.h"
#include "frame.h"
+#include "window.h"
#include "termhooks.h"
#include "termchar.h"
#include "dispextern.h"
+#include "w32term.h"
+#include "w32common.h" /* for os_subtype */
#include "w32inevt.h"
/* from window.c */
@@ -66,6 +68,7 @@ static CONSOLE_CURSOR_INFO prev_console_cursor;
#endif
HANDLE keyboard_handle;
+int w32_console_unicode_input;
/* Setting this as the ctrl handler prevents emacs from being killed when
@@ -339,65 +342,96 @@ w32con_write_glyphs (struct frame *f, register struct glyph *string,
}
}
-
+/* Used for mouse highlight. */
static void
-w32con_delete_glyphs (struct frame *f, int n)
+w32con_write_glyphs_with_face (struct frame *f, register int x, register int y,
+ register struct glyph *string, register int len,
+ register int face_id)
{
- /* delete chars means scroll chars from cursor_coords.X + n to
- cursor_coords.X, anything beyond the edge of the screen should
- come out empty... */
+ unsigned char *conversion_buffer;
+ struct coding_system *coding;
- scroll_line (f, n, LEFT);
-}
+ if (len <= 0)
+ return;
-static unsigned int sound_type = 0xFFFFFFFF;
-#define MB_EMACS_SILENT (0xFFFFFFFF - 1)
+ /* If terminal_coding does any conversion, use it, otherwise use
+ safe_terminal_coding. We can't use CODING_REQUIRE_ENCODING here
+ because it always return 1 if the member src_multibyte is 1. */
+ coding = (FRAME_TERMINAL_CODING (f)->common_flags & CODING_REQUIRE_ENCODING_MASK
+ ? FRAME_TERMINAL_CODING (f) : &safe_terminal_coding);
+ /* We are going to write the entire block of glyphs in one go, as
+ they all have the same face. So this _is_ the last block. */
+ coding->mode |= CODING_MODE_LAST_BLOCK;
-void
-w32_sys_ring_bell (struct frame *f)
-{
- if (sound_type == 0xFFFFFFFF)
+ conversion_buffer = encode_terminal_code (string, len, coding);
+ if (coding->produced > 0)
{
- Beep (666, 100);
+ DWORD filled, written;
+ /* Compute the character attributes corresponding to the face. */
+ DWORD char_attr = w32_face_attributes (f, face_id);
+ COORD start_coords;
+
+ start_coords.X = x;
+ start_coords.Y = y;
+ /* Set the attribute for these characters. */
+ if (!FillConsoleOutputAttribute (cur_screen, char_attr,
+ coding->produced, start_coords,
+ &filled))
+ DebPrint (("Failed writing console attributes: %d\n", GetLastError ()));
+ else
+ {
+ /* Write the characters. */
+ if (!WriteConsoleOutputCharacter (cur_screen, conversion_buffer,
+ filled, start_coords, &written))
+ DebPrint (("Failed writing console characters: %d\n",
+ GetLastError ()));
+ }
}
- else if (sound_type == MB_EMACS_SILENT)
+}
+
+/* Implementation of draw_row_with_mouse_face for W32 console. */
+void
+tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row,
+ int start_hpos, int end_hpos,
+ enum draw_glyphs_face draw)
+{
+ int nglyphs = end_hpos - start_hpos;
+ struct frame *f = XFRAME (WINDOW_FRAME (w));
+ struct tty_display_info *tty = FRAME_TTY (f);
+ int face_id = tty->mouse_highlight.mouse_face_face_id;
+ int pos_x, pos_y;
+
+ if (end_hpos >= row->used[TEXT_AREA])
+ nglyphs = row->used[TEXT_AREA] - start_hpos;
+
+ pos_y = row->y + WINDOW_TOP_EDGE_Y (w);
+ pos_x = row->used[LEFT_MARGIN_AREA] + start_hpos + WINDOW_LEFT_EDGE_X (w);
+
+ if (draw == DRAW_MOUSE_FACE)
+ w32con_write_glyphs_with_face (f, pos_x, pos_y,
+ row->glyphs[TEXT_AREA] + start_hpos,
+ nglyphs, face_id);
+ else if (draw == DRAW_NORMAL_TEXT)
{
- /* Do nothing. */
+ COORD save_coords = cursor_coords;
+
+ w32con_move_cursor (f, pos_y, pos_x);
+ write_glyphs (f, row->glyphs[TEXT_AREA] + start_hpos, nglyphs);
+ w32con_move_cursor (f, save_coords.Y, save_coords.X);
}
- else
- MessageBeep (sound_type);
}
-DEFUN ("set-message-beep", Fset_message_beep, Sset_message_beep, 1, 1, 0,
- doc: /* Set the sound generated when the bell is rung.
-SOUND is 'asterisk, 'exclamation, 'hand, 'question, 'ok, or 'silent
-to use the corresponding system sound for the bell. The 'silent sound
-prevents Emacs from making any sound at all.
-SOUND is nil to use the normal beep. */)
- (Lisp_Object sound)
+static void
+w32con_delete_glyphs (struct frame *f, int n)
{
- CHECK_SYMBOL (sound);
-
- if (NILP (sound))
- sound_type = 0xFFFFFFFF;
- else if (EQ (sound, intern ("asterisk")))
- sound_type = MB_ICONASTERISK;
- else if (EQ (sound, intern ("exclamation")))
- sound_type = MB_ICONEXCLAMATION;
- else if (EQ (sound, intern ("hand")))
- sound_type = MB_ICONHAND;
- else if (EQ (sound, intern ("question")))
- sound_type = MB_ICONQUESTION;
- else if (EQ (sound, intern ("ok")))
- sound_type = MB_OK;
- else if (EQ (sound, intern ("silent")))
- sound_type = MB_EMACS_SILENT;
- else
- sound_type = 0xFFFFFFFF;
+ /* delete chars means scroll chars from cursor_coords.X + n to
+ cursor_coords.X, anything beyond the edge of the screen should
+ come out empty... */
- return sound;
+ scroll_line (f, n, LEFT);
}
+
static void
w32con_reset_terminal_modes (struct terminal *t)
{
@@ -434,7 +468,7 @@ w32con_set_terminal_modes (struct terminal *t)
{
CONSOLE_CURSOR_INFO cci;
- /* make cursor big and visible (100 on Win95 makes it disappear) */
+ /* make cursor big and visible (100 on Windows 95 makes it disappear) */
cci.dwSize = 99;
cci.bVisible = TRUE;
(void) SetConsoleCursorInfo (cur_screen, &cci);
@@ -537,7 +571,7 @@ w32_face_attributes (struct frame *f, int face_id)
WORD char_attr;
struct face *face = FACE_FROM_ID (f, face_id);
- xassert (face != NULL);
+ eassert (face != NULL);
char_attr = char_attr_normal;
@@ -570,6 +604,7 @@ void
initialize_w32_display (struct terminal *term)
{
CONSOLE_SCREEN_BUFFER_INFO info;
+ Mouse_HLInfo *hlinfo;
term->rif = 0; /* No window based redisplay on the console. */
term->cursor_to_hook = w32con_move_cursor;
@@ -600,6 +635,15 @@ initialize_w32_display (struct terminal *term)
term->judge_scroll_bars_hook = 0;
term->frame_up_to_date_hook = 0;
+ /* Initialize the mouse-highlight data. */
+ hlinfo = &term->display_info.tty->mouse_highlight;
+ hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1;
+ hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1;
+ hlinfo->mouse_face_face_id = DEFAULT_FACE_ID;
+ hlinfo->mouse_face_mouse_frame = NULL;
+ hlinfo->mouse_face_window = Qnil;
+ hlinfo->mouse_face_hidden = 0;
+
/* Initialize interrupt_handle. */
init_crit ();
@@ -697,6 +741,11 @@ initialize_w32_display (struct terminal *term)
info.srWindow.Left);
}
+ if (os_subtype == OS_NT)
+ w32_console_unicode_input = 1;
+ else
+ w32_console_unicode_input = 0;
+
/* Setup w32_display_info structure for this frame. */
w32_initialize_display_info (build_string ("Console"));
@@ -755,5 +804,4 @@ scroll-back buffer. */);
defsubr (&Sset_screen_color);
defsubr (&Sget_screen_color);
defsubr (&Sset_cursor_size);
- defsubr (&Sset_message_beep);
}
diff --git a/src/w32fns.c b/src/w32fns.c
index 822e3530bb6..90f5b1695ea 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1,6 +1,6 @@
-/* Graphical user interface functions for the Microsoft W32 API.
+/* Graphical user interface functions for the Microsoft Windows API.
-Copyright (C) 1989, 1992-2011 Free Software Foundation, Inc.
+Copyright (C) 1989, 1992-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -26,27 +26,38 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <limits.h>
#include <errno.h>
#include <math.h>
-#include <setjmp.h>
+#include <fcntl.h>
+#include <unistd.h>
#include "lisp.h"
#include "w32term.h"
#include "frame.h"
#include "window.h"
+#include "character.h"
#include "buffer.h"
#include "intervals.h"
#include "dispextern.h"
#include "keyboard.h"
#include "blockinput.h"
#include "epaths.h"
-#include "character.h"
#include "charset.h"
#include "coding.h"
#include "ccl.h"
#include "fontset.h"
#include "systime.h"
#include "termhooks.h"
+
+#include "w32common.h"
+
+#ifdef WINDOWSNT
#include "w32heap.h"
+#endif /* WINDOWSNT */
+
+#if CYGWIN
+#include "cygw32.h"
+#else
#include "w32.h"
+#endif
#include "bitmaps/gray.xbm"
@@ -59,9 +70,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <dlgs.h>
#include <imm.h>
-#define FILE_NAME_TEXT_FIELD edt1
-#define FILE_NAME_COMBO_BOX cmb13
-#define FILE_NAME_LIST lst1
#include "font.h"
#include "w32font.h"
@@ -79,10 +87,9 @@ extern int w32_console_toggle_lock_key (int, Lisp_Object);
extern void w32_menu_display_help (HWND, HMENU, UINT, UINT);
extern void w32_free_menu_strings (HWND);
extern const char *map_w32_filename (const char *, const char **);
+extern char * w32_strerror (int error_no);
-/* If non-zero, a w32 timer that, when it expires, displays an
- hourglass cursor on all frames. */
-static unsigned hourglass_timer = 0;
+/* If non-NULL, a handle to a frame where to display the hourglass cursor. */
static HWND hourglass_hwnd = NULL;
#ifndef IDC_HAND
@@ -93,7 +100,6 @@ static HWND hourglass_hwnd = NULL;
static int w32_in_use;
-Lisp_Object Qnone;
Lisp_Object Qsuppress_icon;
Lisp_Object Qundefined_color;
Lisp_Object Qcancel_timer;
@@ -141,7 +147,7 @@ struct MONITOR_INFO
};
/* Reportedly, MSVC does not have this in its headers. */
-#ifdef _MSC_VER
+#if defined (_MSC_VER) && _WIN32_WINNT < 0x0500
DECLARE_HANDLE(HMONITOR);
#endif
@@ -165,7 +171,11 @@ ImmSetCompositionWindow_Proc set_ime_composition_window_fn = NULL;
MonitorFromPoint_Proc monitor_from_point_fn = NULL;
GetMonitorInfo_Proc get_monitor_info_fn = NULL;
+#ifdef NTGUI_UNICODE
+#define unicode_append_menu AppendMenuW
+#else /* !NTGUI_UNICODE */
extern AppendMenuW_Proc unicode_append_menu;
+#endif /* NTGUI_UNICODE */
/* Flag to selectively ignore WM_IME_CHAR messages. */
static int ignore_ime_char = 0;
@@ -177,18 +187,19 @@ unsigned int msh_mousewheel = 0;
#define MOUSE_BUTTON_ID 1
#define MOUSE_MOVE_ID 2
#define MENU_FREE_ID 3
-#define HOURGLASS_ID 4
/* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
is received. */
#define MENU_FREE_DELAY 1000
static unsigned menu_free_timer = 0;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
static int image_cache_refcount, dpyinfo_refcount;
#endif
static HWND w32_visible_system_caret_hwnd;
+static int w32_unicode_gui;
+
/* From w32menu.c */
extern HMENU current_popup_menu;
static int menubar_in_use = 0;
@@ -201,6 +212,33 @@ extern int uniscribe_available;
static void w32_show_hourglass (struct frame *);
static void w32_hide_hourglass (void);
+#ifdef WINDOWSNT
+/* From w32inevt.c */
+extern int faked_key;
+#endif /* WINDOWSNT */
+
+/* This gives us the page size and the size of the allocation unit on NT. */
+SYSTEM_INFO sysinfo_cache;
+
+/* This gives us version, build, and platform identification. */
+OSVERSIONINFO osinfo_cache;
+
+unsigned long syspage_mask = 0;
+
+/* The major and minor versions of NT. */
+int w32_major_version;
+int w32_minor_version;
+int w32_build_number;
+
+/* Distinguish between Windows NT and Windows 95. */
+int os_subtype;
+
+#ifdef HAVE_NTGUI
+HINSTANCE hinst = NULL;
+#endif
+
+static unsigned int sound_type = 0xFFFFFFFF;
+#define MB_EMACS_SILENT (0xFFFFFFFF - 1)
/* Error if we are not connected to MS-Windows. */
@@ -226,12 +264,8 @@ have_menus_p (void)
FRAME_PTR
check_x_frame (Lisp_Object frame)
{
- FRAME_PTR f;
+ struct frame *f = decode_live_frame (frame);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
if (! FRAME_W32_P (f))
error ("Non-W32 frame used");
return f;
@@ -270,19 +304,14 @@ check_x_display_info (Lisp_Object frame)
/* Return the Emacs frame-object corresponding to an w32 window.
It could be the frame's main window or an icon window. */
-/* This function can be called during GC, so use GC_xxx type test macros. */
-
struct frame *
x_window_to_frame (struct w32_display_info *dpyinfo, HWND wdesc)
{
Lisp_Object tail, frame;
struct frame *f;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
f = XFRAME (frame);
if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
continue;
@@ -364,7 +393,7 @@ if the entry is new. */)
XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue)));
- BLOCK_INPUT;
+ block_input ();
/* replace existing entry in w32-color-map or add new entry. */
entry = Fassoc (name, Vw32_color_map);
@@ -379,7 +408,7 @@ if the entry is new. */)
Fsetcdr (entry, rgb);
}
- UNBLOCK_INPUT;
+ unblock_input ();
return (oldrgb);
}
@@ -642,7 +671,7 @@ w32_default_color_map (void)
colormap_t *pc = w32_color_map;
Lisp_Object cmap;
- BLOCK_INPUT;
+ block_input ();
cmap = Qnil;
@@ -652,7 +681,7 @@ w32_default_color_map (void)
make_number (pc->colorref)),
cmap);
- UNBLOCK_INPUT;
+ unblock_input ();
return (cmap);
}
@@ -665,11 +694,11 @@ DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
}
static Lisp_Object
-w32_color_map_lookup (char *colorname)
+w32_color_map_lookup (const char *colorname)
{
Lisp_Object tail, ret = Qnil;
- BLOCK_INPUT;
+ block_input ();
for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail))
{
@@ -678,7 +707,7 @@ w32_color_map_lookup (char *colorname)
elt = XCAR (tail);
if (!CONSP (elt)) continue;
- tem = Fcar (elt);
+ tem = XCAR (elt);
if (lstrcmpi (SDATA (tem), colorname) == 0)
{
@@ -689,7 +718,7 @@ w32_color_map_lookup (char *colorname)
QUIT;
}
- UNBLOCK_INPUT;
+ unblock_input ();
return ret;
}
@@ -701,7 +730,7 @@ add_system_logical_colors_to_map (Lisp_Object *system_colors)
HKEY colors_key;
/* Other registry operations are done with input blocked. */
- BLOCK_INPUT;
+ block_input ();
/* Look for "Control Panel/Colors" under User and Machine registry
settings. */
@@ -739,25 +768,24 @@ add_system_logical_colors_to_map (Lisp_Object *system_colors)
RegCloseKey (colors_key);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
static Lisp_Object
-x_to_w32_color (char * colorname)
+x_to_w32_color (const char * colorname)
{
register Lisp_Object ret = Qnil;
- BLOCK_INPUT;
+ block_input ();
if (colorname[0] == '#')
{
/* Could be an old-style RGB Device specification. */
- char *color;
- int size;
- color = colorname + 1;
+ int size = strlen (colorname + 1);
+ char *color = alloca (size + 1);
- size = strlen (color);
+ strcpy (color, colorname + 1);
if (size == 3 || size == 6 || size == 9 || size == 12)
{
UINT colorval;
@@ -801,7 +829,7 @@ x_to_w32_color (char * colorname)
pos += 0x8;
if (i == 2)
{
- UNBLOCK_INPUT;
+ unblock_input ();
XSETINT (ret, colorval);
return ret;
}
@@ -811,7 +839,7 @@ x_to_w32_color (char * colorname)
}
else if (strnicmp (colorname, "rgb:", 4) == 0)
{
- char *color;
+ const char *color;
UINT colorval;
int i, pos;
pos = 0;
@@ -855,7 +883,7 @@ x_to_w32_color (char * colorname)
{
if (*end != '\0')
break;
- UNBLOCK_INPUT;
+ unblock_input ();
XSETINT (ret, colorval);
return ret;
}
@@ -867,7 +895,7 @@ x_to_w32_color (char * colorname)
else if (strnicmp (colorname, "rgbi:", 5) == 0)
{
/* This is an RGB Intensity specification. */
- char *color;
+ const char *color;
UINT colorval;
int i, pos;
pos = 0;
@@ -897,7 +925,7 @@ x_to_w32_color (char * colorname)
{
if (*end != '\0')
break;
- UNBLOCK_INPUT;
+ unblock_input ();
XSETINT (ret, colorval);
return ret;
}
@@ -932,7 +960,7 @@ x_to_w32_color (char * colorname)
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return ret;
}
@@ -1006,8 +1034,7 @@ w32_map_color (FRAME_PTR f, COLORREF color)
}
/* not already mapped, so add to list and recreate Windows palette */
- list = (struct w32_palette_entry *)
- xmalloc (sizeof (struct w32_palette_entry));
+ list = xmalloc (sizeof (struct w32_palette_entry));
SET_W32_COLOR (list->entry, color);
list->refcount = 1;
list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
@@ -1072,7 +1099,7 @@ gamma_correct (struct frame *f, COLORREF *color)
If ALLOC is nonzero, allocate a new colormap cell. */
int
-w32_defined_color (FRAME_PTR f, char *color, XColor *color_def, int alloc)
+w32_defined_color (FRAME_PTR f, const char *color, XColor *color_def, int alloc)
{
register Lisp_Object tem;
COLORREF w32_color_ref;
@@ -1109,8 +1136,7 @@ w32_defined_color (FRAME_PTR f, char *color, XColor *color_def, int alloc)
if (entry == NULL && alloc)
{
/* not already mapped, so add to list */
- entry = (struct w32_palette_entry *)
- xmalloc (sizeof (struct w32_palette_entry));
+ entry = xmalloc (sizeof (struct w32_palette_entry));
SET_W32_COLOR (entry->entry, XUINT (tem));
entry->next = NULL;
*prev = entry;
@@ -1237,7 +1263,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
#if 0 /* TODO : Mouse cursor customization. */
- BLOCK_INPUT;
+ block_input ();
/* It's not okay to crash if the user selects a screwy cursor. */
count = x_catch_errors (FRAME_W32_DISPLAY (f));
@@ -1360,7 +1386,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
f->output_data.w32->hand_cursor = hand_cursor;
XFlush (FRAME_W32_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
update_face_from_frame_parameter (f, Qmouse_color, arg);
#endif /* TODO */
@@ -1392,12 +1418,12 @@ x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
if (FRAME_W32_WINDOW (f) != 0)
{
- BLOCK_INPUT;
+ block_input ();
/* Update frame's cursor_gc. */
f->output_data.w32->cursor_gc->foreground = fore_pixel;
f->output_data.w32->cursor_gc->background = pixel;
- UNBLOCK_INPUT;
+ unblock_input ();
if (FRAME_VISIBLE_P (f))
{
@@ -1468,16 +1494,16 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
return;
- BLOCK_INPUT;
+ block_input ();
result = x_bitmap_icon (f, arg);
if (result)
{
- UNBLOCK_INPUT;
+ unblock_input ();
error ("No icon window available");
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
void
@@ -1491,13 +1517,13 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
else if (!NILP (arg) || NILP (oldval))
return;
- f->icon_name = arg;
+ fset_icon_name (f, arg);
#if 0
if (f->output_data.w32->icon_bitmap != 0)
return;
- BLOCK_INPUT;
+ block_input ();
result = x_text_icon (f,
SSDATA ((!NILP (f->icon_name)
@@ -1508,7 +1534,7 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
if (result)
{
- UNBLOCK_INPUT;
+ unblock_input ();
error ("No icon window available");
}
@@ -1523,7 +1549,7 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
}
XFlush (FRAME_W32_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
#endif
}
@@ -1625,13 +1651,13 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
int width = FRAME_PIXEL_WIDTH (f);
int y = nlines * FRAME_LINE_HEIGHT (f);
- BLOCK_INPUT;
+ block_input ();
{
HDC hdc = get_frame_dc (f);
w32_clear_area (f, hdc, 0, y, width, height);
release_frame_dc (f, hdc);
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (WINDOWP (f->tool_bar_window))
clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
@@ -1687,7 +1713,7 @@ x_set_name (struct frame *f, Lisp_Object name, int explicit)
if (! NILP (Fstring_equal (name, f->name)))
return;
- f->name = name;
+ fset_name (f, name);
/* For setting the frame title, the title parameter should override
the name parameter. */
@@ -1699,9 +1725,9 @@ x_set_name (struct frame *f, Lisp_Object name, int explicit)
if (STRING_MULTIBYTE (name))
name = ENCODE_SYSTEM (name);
- BLOCK_INPUT;
+ block_input ();
SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -1735,7 +1761,7 @@ x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
update_mode_lines = 1;
- f->title = name;
+ fset_title (f, name);
if (NILP (name))
name = f->name;
@@ -1745,9 +1771,9 @@ x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
if (STRING_MULTIBYTE (name))
name = ENCODE_SYSTEM (name);
- BLOCK_INPUT;
+ block_input ();
SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -1782,23 +1808,37 @@ w32_load_cursor (LPCTSTR name)
static LRESULT CALLBACK w32_wnd_proc (HWND, UINT, WPARAM, LPARAM);
+#define INIT_WINDOW_CLASS(WC) \
+ (WC).style = CS_HREDRAW | CS_VREDRAW; \
+ (WC).lpfnWndProc = (WNDPROC) w32_wnd_proc; \
+ (WC).cbClsExtra = 0; \
+ (WC).cbWndExtra = WND_EXTRA_BYTES; \
+ (WC).hInstance = hinst; \
+ (WC).hIcon = LoadIcon (hinst, EMACS_CLASS); \
+ (WC).hCursor = w32_load_cursor (IDC_ARROW); \
+ (WC).hbrBackground = NULL; \
+ (WC).lpszMenuName = NULL; \
+
static BOOL
w32_init_class (HINSTANCE hinst)
{
- WNDCLASS wc;
- wc.style = CS_HREDRAW | CS_VREDRAW;
- wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
- wc.cbClsExtra = 0;
- wc.cbWndExtra = WND_EXTRA_BYTES;
- wc.hInstance = hinst;
- wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
- wc.hCursor = w32_load_cursor (IDC_ARROW);
- wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
- wc.lpszMenuName = NULL;
- wc.lpszClassName = EMACS_CLASS;
+ if (w32_unicode_gui)
+ {
+ WNDCLASSW uwc;
+ INIT_WINDOW_CLASS(uwc);
+ uwc.lpszClassName = L"Emacs";
+
+ return RegisterClassW (&uwc);
+ }
+ else
+ {
+ WNDCLASS wc;
+ INIT_WINDOW_CLASS(wc);
+ wc.lpszClassName = EMACS_CLASS;
- return (RegisterClass (&wc));
+ return RegisterClassA (&wc);
+ }
}
static HWND
@@ -1834,10 +1874,7 @@ w32_createwindow (struct frame *f)
/* Do first time app init */
- if (!hprevinst)
- {
- w32_init_class (hinst);
- }
+ w32_init_class (hinst);
if (f->size_hint_flags & USPosition || f->size_hint_flags & PPosition)
{
@@ -2043,8 +2080,35 @@ sync_modifiers (void)
static int
modifier_set (int vkey)
{
- if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
- return (GetKeyState (vkey) & 0x1);
+ /* Warning: The fact that VK_NUMLOCK is not treated as the other 2
+ toggle keys is not an omission! If you want to add it, you will
+ have to make changes in the default sub-case of the WM_KEYDOWN
+ switch, because if the NUMLOCK modifier is set, the code there
+ will directly convert any key that looks like an ASCII letter,
+ and also downcase those that look like upper-case ASCII. */
+ if (vkey == VK_CAPITAL)
+ {
+ if (NILP (Vw32_enable_caps_lock))
+ return 0;
+ else
+ return (GetKeyState (vkey) & 0x1);
+ }
+ if (vkey == VK_SCROLL)
+ {
+ if (NILP (Vw32_scroll_lock_modifier)
+ /* w32-scroll-lock-modifier can be any non-nil value that is
+ not one of the modifiers, in which case it shall be ignored. */
+ || !( EQ (Vw32_scroll_lock_modifier, Qhyper)
+ || EQ (Vw32_scroll_lock_modifier, Qsuper)
+ || EQ (Vw32_scroll_lock_modifier, Qmeta)
+ || EQ (Vw32_scroll_lock_modifier, Qalt)
+ || EQ (Vw32_scroll_lock_modifier, Qcontrol)
+ || EQ (Vw32_scroll_lock_modifier, Qshift)))
+ return 0;
+ else
+ return (GetKeyState (vkey) & 0x1);
+ }
+
if (!modifiers_recorded)
return (GetKeyState (vkey) & 0x8000);
@@ -2237,19 +2301,103 @@ unregister_hot_keys (HWND hwnd)
}
}
+#if EMACSDEBUG
+const char*
+w32_name_of_message (UINT msg)
+{
+ unsigned i;
+ static char buf[64];
+ static const struct {
+ UINT msg;
+ const char* name;
+ } msgnames[] = {
+#define M(msg) { msg, # msg }
+ M (WM_PAINT),
+ M (WM_TIMER),
+ M (WM_USER),
+ M (WM_MOUSEMOVE),
+ M (WM_LBUTTONUP),
+ M (WM_KEYDOWN),
+ M (WM_EMACS_KILL),
+ M (WM_EMACS_CREATEWINDOW),
+ M (WM_EMACS_DONE),
+ M (WM_EMACS_CREATESCROLLBAR),
+ M (WM_EMACS_SHOWWINDOW),
+ M (WM_EMACS_SETWINDOWPOS),
+ M (WM_EMACS_DESTROYWINDOW),
+ M (WM_EMACS_TRACKPOPUPMENU),
+ M (WM_EMACS_SETFOCUS),
+ M (WM_EMACS_SETFOREGROUND),
+ M (WM_EMACS_SETLOCALE),
+ M (WM_EMACS_SETKEYBOARDLAYOUT),
+ M (WM_EMACS_REGISTER_HOT_KEY),
+ M (WM_EMACS_UNREGISTER_HOT_KEY),
+ M (WM_EMACS_TOGGLE_LOCK_KEY),
+ M (WM_EMACS_TRACK_CARET),
+ M (WM_EMACS_DESTROY_CARET),
+ M (WM_EMACS_SHOW_CARET),
+ M (WM_EMACS_HIDE_CARET),
+ M (WM_EMACS_SETCURSOR),
+ M (WM_EMACS_PAINT),
+ M (WM_CHAR),
+#undef M
+ { 0, 0 }
+ };
+
+ for (i = 0; msgnames[i].name; ++i)
+ if (msgnames[i].msg == msg)
+ return msgnames[i].name;
+
+ sprintf (buf, "message 0x%04x", (unsigned)msg);
+ return buf;
+}
+#endif /* EMACSDEBUG */
+
+/* Here's an overview of how Emacs input works in GUI sessions on
+ MS-Windows. (For description of non-GUI input, see the commentary
+ before w32_console_read_socket in w32inevt.c.)
+
+ System messages are read and processed by w32_msg_pump below. This
+ function runs in a separate thread. It handles a small number of
+ custom WM_EMACS_* messages (posted by the main thread, look for
+ PostMessage calls), and dispatches the rest to w32_wnd_proc, which
+ is the main window procedure for the entire Emacs application.
+
+ w32_wnd_proc also runs in the same separate input thread. It
+ handles some messages, mostly those that need GDI calls, by itself.
+ For the others, it calls my_post_msg, which inserts the messages
+ into the input queue serviced by w32_read_socket.
+
+ w32_read_socket runs in the main (a.k.a. "Lisp") thread, and is
+ called synchronously from keyboard.c when it is known or suspected
+ that some input is available. w32_read_socket either handles
+ messages immediately, or converts them into Emacs input events and
+ stuffs them into kbd_buffer, where kbd_buffer_get_event can get at
+ them and process them when read_char and its callers require
+ input.
+
+ Under Cygwin with the W32 toolkit, the use of /dev/windows with
+ select(2) takes the place of w32_read_socket.
+
+ */
+
/* Main message dispatch loop. */
static void
w32_msg_pump (deferred_msg * msg_buf)
{
MSG msg;
- int result;
+ WPARAM result;
HWND focus_window;
msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
- while (GetMessage (&msg, NULL, 0, 0))
+ while ((w32_unicode_gui ? GetMessageW : GetMessageA) (&msg, NULL, 0, 0))
{
+
+ /* DebPrint (("w32_msg_pump: %s time:%u\n", */
+ /* w32_name_of_message (msg.message), msg.time)); */
+
if (msg.hwnd == NULL)
{
switch (msg.message)
@@ -2267,17 +2415,17 @@ w32_msg_pump (deferred_msg * msg_buf)
CoInitialize (NULL);
w32_createwindow ((struct frame *) msg.wParam);
if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
- abort ();
+ emacs_abort ();
break;
case WM_EMACS_SETLOCALE:
SetThreadLocale (msg.wParam);
/* Reply is not expected. */
break;
case WM_EMACS_SETKEYBOARDLAYOUT:
- result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
+ result = (WPARAM) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
result, 0))
- abort ();
+ emacs_abort ();
break;
case WM_EMACS_REGISTER_HOT_KEY:
focus_window = GetFocus ();
@@ -2296,15 +2444,15 @@ w32_msg_pump (deferred_msg * msg_buf)
thread-safe. The next line is okay because the cons
cell is never made into garbage and is not relocated by
GC. */
- XSETCAR ((Lisp_Object) ((EMACS_INT) msg.lParam), Qnil);
+ XSETCAR (XIL ((EMACS_INT) msg.lParam), Qnil);
if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
- abort ();
+ emacs_abort ();
break;
case WM_EMACS_TOGGLE_LOCK_KEY:
{
int vk_code = (int) msg.wParam;
int cur_state = (GetKeyState (vk_code) & 1);
- Lisp_Object new_state = (Lisp_Object) ((EMACS_INT) msg.lParam);
+ Lisp_Object new_state = XIL ((EMACS_INT) msg.lParam);
/* NB: This code must be thread-safe. It is safe to
call NILP because symbols are not relocated by GC,
@@ -2330,20 +2478,23 @@ w32_msg_pump (deferred_msg * msg_buf)
}
if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
cur_state, 0))
- abort ();
+ emacs_abort ();
}
break;
#ifdef MSG_DEBUG
/* Broadcast messages make it here, so you need to be looking
for something in particular for this to be useful. */
default:
- DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
+ DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
#endif
}
}
else
{
- DispatchMessage (&msg);
+ if (w32_unicode_gui)
+ DispatchMessageW (&msg);
+ else
+ DispatchMessageA (&msg);
}
/* Exit nested loop when our deferred message has completed. */
@@ -2382,11 +2533,11 @@ send_deferred_msg (deferred_msg * msg_buf,
{
/* Only input thread can send deferred messages. */
if (GetCurrentThreadId () != dwWindowsThreadId)
- abort ();
+ emacs_abort ();
/* It is an error to send a message that is already deferred. */
if (find_deferred_msg (hwnd, msg) != NULL)
- abort ();
+ emacs_abort ();
/* Enforced synchronization is not needed because this is the only
function that alters deferred_msg_head, and the following critical
@@ -2459,7 +2610,7 @@ w32_msg_worker (void *arg)
PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
- abort ();
+ emacs_abort ();
memset (&dummy_buf, 0, sizeof (dummy_buf));
dummy_buf.w32msg.msg.hwnd = NULL;
@@ -2479,6 +2630,10 @@ signal_user_input (void)
if (!NILP (Vthrow_on_input))
{
Vquit_flag = Vthrow_on_input;
+ /* Doing a QUIT from this thread is a bad idea, since this
+ unwinds the stack of the Lisp thread, and the Windows runtime
+ rightfully barfs. Disabled. */
+#if 0
/* If we're inside a function that wants immediate quits,
do it now. */
if (immediate_quit && NILP (Vinhibit_quit))
@@ -2486,6 +2641,7 @@ signal_user_input (void)
immediate_quit = 0;
QUIT;
}
+#endif
}
}
@@ -2504,19 +2660,19 @@ post_character_message (HWND hwnd, UINT msg,
woken up if blocked in sys_select, but we do NOT want to post
the quit_char message itself (because it will usually be as if
the user had typed quit_char twice). Instead, we post a dummy
- message that has no particular effect. */
+ message that has no particular effect. */
{
int c = wParam;
if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
c = make_ctrl_char (c) & 0377;
if (c == quit_char
- || (wmsg.dwModifiers == 0 &&
- w32_quit_key && wParam == w32_quit_key))
+ || (wmsg.dwModifiers == 0
+ && w32_quit_key && wParam == w32_quit_key))
{
Vquit_flag = Qt;
/* The choice of message is somewhat arbitrary, as long as
- the main thread handler just ignores it. */
+ the main thread handler just ignores it. */
msg = WM_NULL;
/* Interrupt any blocking system calls. */
@@ -2879,7 +3035,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
key.uChar.AsciiChar = 0;
key.dwControlKeyState = modifiers;
- add = w32_kbd_patch_key (&key);
+ add = w32_kbd_patch_key (&key, w32_keyboard_codepage);
/* 0 means an unrecognized keycode, negative means
dead key. Ignore both. */
while (--add >= 0)
@@ -2889,7 +3045,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
(hwnd, WM_CHAR,
(unsigned char) key.uChar.AsciiChar, lParam,
w32_get_key_modifiers (wParam, lParam));
- w32_kbd_patch_key (&key);
+ w32_kbd_patch_key (&key, w32_keyboard_codepage);
}
return 0;
}
@@ -2915,8 +3071,18 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
case WM_SYSCHAR:
case WM_CHAR:
- post_character_message (hwnd, msg, wParam, lParam,
- w32_get_key_modifiers (wParam, lParam));
+ if (wParam > 255 )
+ {
+ W32Msg wmsg;
+
+ wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
+ signal_user_input ();
+ my_post_msg (&wmsg, hwnd, WM_UNICHAR, wParam, lParam);
+
+ }
+ else
+ post_character_message (hwnd, msg, wParam, lParam,
+ w32_get_key_modifiers (wParam, lParam));
break;
case WM_UNICHAR:
@@ -3105,7 +3271,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
msg = WM_MBUTTONUP;
button_state &= ~MMOUSE;
- if (button_state) abort ();
+ if (button_state) emacs_abort ();
}
else
return 0;
@@ -3185,7 +3351,19 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
versions, there is no way of telling when the mouse leaves the
frame, so we just have to put up with help-echo and mouse
highlighting remaining while the frame is not active. */
- if (track_mouse_event_fn && !track_mouse_window)
+ if (track_mouse_event_fn && !track_mouse_window
+ /* If the menu bar is active, turning on tracking of mouse
+ movement events might send these events to the tooltip
+ frame, if the user happens to move the mouse pointer over
+ the tooltip. But since we don't process events for
+ tooltip frames, this causes Windows to present a
+ hourglass cursor, which is ugly and unexpected. So don't
+ enable tracking mouse events in this case; they will be
+ restarted when the menu pops down. (Confusingly, the
+ menubar_active member of f->output_data.w32, tested
+ above, is only set when a menu was popped up _not_ from
+ the frame's menu bar, but via x-popup-menu.) */
+ && !menubar_in_use)
{
TRACKMOUSEEVENT tme;
tme.cbSize = sizeof (tme);
@@ -3283,12 +3461,6 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
menubar_in_use = 0;
}
}
- else if (wParam == hourglass_timer)
- {
- KillTimer (hwnd, hourglass_timer);
- hourglass_timer = 0;
- w32_show_hourglass (x_window_to_frame (dpyinfo, hwnd));
- }
return 0;
case WM_NCACTIVATE:
@@ -3336,7 +3508,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
/* Detect if message has already been deferred; in this case
we cannot return any sensible value to ignore this. */
if (find_deferred_msg (hwnd, msg) != NULL)
- abort ();
+ emacs_abort ();
menubar_in_use = 1;
@@ -3658,6 +3830,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
case WM_EMACS_SHOWWINDOW:
return ShowWindow ((HWND) wParam, (WPARAM) lParam);
+ case WM_EMACS_BRINGTOTOP:
case WM_EMACS_SETFOREGROUND:
{
HWND foreground_window;
@@ -3675,6 +3848,8 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
foreground_thread = 0;
retval = SetForegroundWindow ((HWND) wParam);
+ if (msg == WM_EMACS_BRINGTOTOP)
+ retval = BringWindowToTop ((HWND) wParam);
/* Detach from the previous foreground thread. */
if (foreground_thread)
@@ -3795,7 +3970,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
}
dflt:
- return DefWindowProc (hwnd, msg, wParam, lParam);
+ return (w32_unicode_gui ? DefWindowProcW : DefWindowProcA) (hwnd, msg, wParam, lParam);
}
/* The most common default return code for handled messages is 0. */
@@ -3808,7 +3983,7 @@ my_create_window (struct frame * f)
MSG msg;
if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
- abort ();
+ emacs_abort ();
GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
}
@@ -3863,7 +4038,7 @@ my_create_tip_window (struct frame *f)
static void
w32_window (struct frame *f, long window_prompting, int minibuffer_only)
{
- BLOCK_INPUT;
+ block_input ();
/* Use the resource name as the top-level window name
for looking up resources. Make a non-Lisp copy
@@ -3873,7 +4048,7 @@ w32_window (struct frame *f, long window_prompting, int minibuffer_only)
{
char *str = SSDATA (Vx_resource_name);
- f->namebuf = (char *) xmalloc (strlen (str) + 1);
+ f->namebuf = xmalloc (strlen (str) + 1);
strcpy (f->namebuf, str);
}
@@ -3891,11 +4066,11 @@ w32_window (struct frame *f, long window_prompting, int minibuffer_only)
f->explicit_name = 0;
name = f->name;
- f->name = Qnil;
+ fset_name (f, Qnil);
x_set_name (f, name, explicit);
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
initialize_frame_menubar (f);
@@ -3926,7 +4101,7 @@ x_icon (struct frame *f, Lisp_Object parms)
else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
error ("Both left and top icon corners of icon must be specified");
- BLOCK_INPUT;
+ block_input ();
if (! EQ (icon_x, Qunbound))
x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
@@ -3943,7 +4118,7 @@ x_icon (struct frame *f, Lisp_Object parms)
: f->name)));
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -3952,7 +4127,7 @@ x_make_gc (struct frame *f)
{
XGCValues gc_values;
- BLOCK_INPUT;
+ block_input ();
/* Create the GC's of this frame.
Note that many default values are used. */
@@ -3972,7 +4147,7 @@ x_make_gc (struct frame *f)
f->output_data.w32->white_relief.gc = 0;
f->output_data.w32->black_relief.gc = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -3988,17 +4163,17 @@ unwind_create_frame (Lisp_Object frame)
/* If frame is ``official'', nothing to do. */
if (NILP (Fmemq (frame, Vframe_list)))
{
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
#endif
x_free_frame_resources (f);
free_glyphs (f);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check that reference counts are indeed correct. */
- xassert (dpyinfo->reference_count == dpyinfo_refcount);
- xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
+ eassert (dpyinfo->reference_count == dpyinfo_refcount);
+ eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
#endif
return Qt;
}
@@ -4030,7 +4205,7 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms)
for (i = 0; names[i]; i++)
{
- font = font_open_by_name (f, names[i]);
+ font = font_open_by_name (f, build_unibyte_string (names[i]));
if (! NILP (font))
break;
}
@@ -4065,7 +4240,7 @@ This function is an internal primitive--use `make-frame' instead. */)
int minibuffer_only = 0;
long window_prompting = 0;
int width, height;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object display;
struct w32_display_info *dpyinfo = NULL;
@@ -4128,31 +4303,26 @@ This function is an internal primitive--use `make-frame' instead. */)
XSETFRAME (frame, f);
- /* Note that Windows does support scroll bars. */
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
-
/* By default, make scrollbars the system standard width. */
FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
f->terminal = dpyinfo->terminal;
f->output_method = output_w32;
- f->output_data.w32 =
- (struct w32_output *) xmalloc (sizeof (struct w32_output));
- memset (f->output_data.w32, 0, sizeof (struct w32_output));
+ f->output_data.w32 = xzalloc (sizeof (struct w32_output));
FRAME_FONTSET (f) = -1;
- f->icon_name
- = x_get_arg (dpyinfo, parameters, Qicon_name, "iconName", "Title",
- RES_TYPE_STRING);
+ fset_icon_name
+ (f, x_get_arg (dpyinfo, parameters, Qicon_name, "iconName", "Title",
+ RES_TYPE_STRING));
if (! STRINGP (f->icon_name))
- f->icon_name = Qnil;
+ fset_icon_name (f, Qnil);
/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
/* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */
record_unwind_protect (unwind_create_frame, frame);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
image_cache_refcount =
FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
dpyinfo_refcount = dpyinfo->reference_count;
@@ -4175,12 +4345,12 @@ This function is an internal primitive--use `make-frame' instead. */)
be set. */
if (EQ (name, Qunbound) || NILP (name))
{
- f->name = build_string (dpyinfo->w32_id_name);
+ fset_name (f, build_string (dpyinfo->w32_id_name));
f->explicit_name = 0;
}
else
{
- f->name = name;
+ fset_name (f, name);
f->explicit_name = 1;
/* use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
@@ -4320,9 +4490,9 @@ This function is an internal primitive--use `make-frame' instead. */)
/* Tell the server what size and position, etc, we want, and how
badly we want them. This should be done after we have the menu
bar so that its size can be taken into account. */
- BLOCK_INPUT;
+ block_input ();
x_wm_set_size_hint (f, window_prompting, 0);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Make the window appear on the frame and enable display, unless
the caller says not to. However, with explicit parent, Emacs
@@ -4349,13 +4519,13 @@ This function is an internal primitive--use `make-frame' instead. */)
if (FRAME_HAS_MINIBUF_P (f)
&& (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
|| !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
- KVAR (kb, Vdefault_minibuffer_frame) = frame;
+ kset_default_minibuffer_frame (kb, frame);
/* All remaining specified parameters, which have not been "used"
by x_get_arg and friends, now go in the misc. alist of the frame. */
for (tem = parameters; CONSP (tem); tem = XCDR (tem))
if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
- f->param_alist = Fcons (XCAR (tem), f->param_alist);
+ fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
UNGCPRO;
@@ -4503,22 +4673,14 @@ If omitted or nil, that stands for the selected frame's display. */)
(Lisp_Object display)
{
struct w32_display_info *dpyinfo = check_x_display_info (display);
- HDC hdc;
int cap;
- hdc = GetDC (dpyinfo->root_window);
- if (dpyinfo->has_palette)
- cap = GetDeviceCaps (hdc, SIZEPALETTE);
- else
- cap = GetDeviceCaps (hdc, NUMCOLORS);
-
- /* We force 24+ bit depths to 24-bit, both to prevent an overflow
- and because probably is more meaningful on Windows anyway */
- if (cap < 0)
- cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
-
- ReleaseDC (dpyinfo->root_window, hdc);
+ /* Don't use NCOLORS: it returns incorrect results under remote
+ * desktop. We force 24+ bit depths to 24-bit, both to prevent an
+ * overflow and because probably is more meaningful on Windows
+ * anyway. */
+ cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
return make_number (cap);
}
@@ -4660,6 +4822,37 @@ If omitted or nil, that stands for the selected frame's display. */)
{
return Qnil;
}
+
+DEFUN ("set-message-beep", Fset_message_beep, Sset_message_beep, 1, 1, 0,
+ doc: /* Set the sound generated when the bell is rung.
+SOUND is 'asterisk, 'exclamation, 'hand, 'question, 'ok, or 'silent
+to use the corresponding system sound for the bell. The 'silent sound
+prevents Emacs from making any sound at all.
+SOUND is nil to use the normal beep. */)
+ (Lisp_Object sound)
+{
+ CHECK_SYMBOL (sound);
+
+ if (NILP (sound))
+ sound_type = 0xFFFFFFFF;
+ else if (EQ (sound, intern ("asterisk")))
+ sound_type = MB_ICONASTERISK;
+ else if (EQ (sound, intern ("exclamation")))
+ sound_type = MB_ICONEXCLAMATION;
+ else if (EQ (sound, intern ("hand")))
+ sound_type = MB_ICONHAND;
+ else if (EQ (sound, intern ("question")))
+ sound_type = MB_ICONQUESTION;
+ else if (EQ (sound, intern ("ok")))
+ sound_type = MB_OK;
+ else if (EQ (sound, intern ("silent")))
+ sound_type = MB_EMACS_SILENT;
+ else
+ sound_type = 0xFFFFFFFF;
+
+ return sound;
+}
+
int
x_pixel_width (register struct frame *f)
@@ -4703,7 +4896,7 @@ x_display_info_for_name (Lisp_Object name)
CHECK_STRING (name);
for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
- dpyinfo;
+ dpyinfo && !NILP (w32_display_name_list);
dpyinfo = dpyinfo->next, names = XCDR (names))
{
Lisp_Object tem;
@@ -4741,12 +4934,21 @@ terminate Emacs if we can't open the connection.
unsigned char *xrm_option;
struct w32_display_info *dpyinfo;
+ CHECK_STRING (display);
+
+ /* Signal an error in order to encourage correct use from callers.
+ * If we ever support multiple window systems in the same Emacs,
+ * we'll need callers to be precise about what window system they
+ * want. */
+
+ if (strcmp (SSDATA (display), "w32") != 0)
+ error ("The name of the display in this Emacs must be \"w32\"");
+
/* If initialization has already been done, return now to avoid
overwriting critical parts of one_w32_display_info. */
if (w32_in_use)
return Qnil;
- CHECK_STRING (display);
if (! NILP (xrm_string))
CHECK_STRING (xrm_string);
@@ -4831,11 +5033,11 @@ If DISPLAY is nil, that stands for the selected frame's display. */)
if (dpyinfo->reference_count > 0)
error ("Display still has frames on it");
- BLOCK_INPUT;
+ block_input ();
x_destroy_all_bitmaps (dpyinfo);
x_delete_display (dpyinfo);
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
@@ -4893,9 +5095,10 @@ If TYPE is not given or nil, the type is STRING.
FORMAT gives the size in bits of each element if VALUE is a list.
It must be one of 8, 16 or 32.
If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
-If OUTER_P is non-nil, the property is changed for the outer X window of
+If OUTER-P is non-nil, the property is changed for the outer X window of
FRAME. Default is to change on the edit X window. */)
- (Lisp_Object prop, Lisp_Object value, Lisp_Object frame, Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
+ (Lisp_Object prop, Lisp_Object value, Lisp_Object frame,
+ Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
@@ -4903,7 +5106,7 @@ FRAME. Default is to change on the edit X window. */)
CHECK_STRING (prop);
CHECK_STRING (value);
- BLOCK_INPUT;
+ block_input ();
prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
prop_atom, XA_STRING, 8, PropModeReplace,
@@ -4911,7 +5114,7 @@ FRAME. Default is to change on the edit X window. */)
/* Make sure the property is set when we return. */
XFlush (FRAME_W32_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
return value;
}
@@ -4927,36 +5130,37 @@ FRAME nil or omitted means use the selected frame. Value is PROP. */)
Atom prop_atom;
CHECK_STRING (prop);
- BLOCK_INPUT;
+ block_input ();
prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
/* Make sure the property is removed when we return. */
XFlush (FRAME_W32_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
return prop;
}
DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
- 1, 2, 0,
+ 1, 6, 0,
doc: /* Value is the value of window property PROP on FRAME.
If FRAME is nil or omitted, use the selected frame.
-On MS Windows, this function only accepts the PROP and FRAME arguments.
-
On X Windows, the following optional arguments are also accepted:
If TYPE is nil or omitted, get the property as a string.
Otherwise TYPE is the name of the atom that denotes the type expected.
If SOURCE is non-nil, get the property on that window instead of from
FRAME. The number 0 denotes the root window.
-If DELETE_P is non-nil, delete the property after retrieving it.
-If VECTOR_RET_P is non-nil, don't return a string but a vector of values.
+If DELETE-P is non-nil, delete the property after retrieving it.
+If VECTOR-RET-P is non-nil, don't return a string but a vector of values.
+
+On MS Windows, this function accepts but ignores those optional arguments.
Value is nil if FRAME hasn't a property with name PROP or if PROP has
no value of TYPE (always string in the MS Windows case). */)
- (Lisp_Object prop, Lisp_Object frame)
+ (Lisp_Object prop, Lisp_Object frame, Lisp_Object type,
+ Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p)
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
@@ -4968,7 +5172,7 @@ no value of TYPE (always string in the MS Windows case). */)
unsigned long actual_size, bytes_remaining;
CHECK_STRING (prop);
- BLOCK_INPUT;
+ block_input ();
prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
prop_atom, 0, 0, False, XA_STRING,
@@ -4993,7 +5197,7 @@ no value of TYPE (always string in the MS Windows case). */)
XFree (tmp_data);
}
- UNBLOCK_INPUT;
+ unblock_input ();
return prop_value;
@@ -5007,76 +5211,50 @@ no value of TYPE (always string in the MS Windows case). */)
Busy cursor
***********************************************************************/
-/* Default number of seconds to wait before displaying an hourglass
- cursor. Duplicated from xdisp.c, but cannot use the version there
- due to lack of atimers on w32. */
-#define DEFAULT_HOURGLASS_DELAY 1
-/* Return non-zero if hourglass timer has been started or hourglass is
- shown. */
-/* PENDING: if W32 can use atimers (atimer.[hc]) then the common impl in
- xdisp.c could be used. */
-
-int
-hourglass_started (void)
-{
- return hourglass_shown_p || hourglass_timer;
-}
-
-/* Cancel a currently active hourglass timer, and start a new one. */
-
void
-start_hourglass (void)
+w32_note_current_window (void)
{
- DWORD delay;
- int secs, msecs = 0;
struct frame * f = SELECTED_FRAME ();
- /* No cursors on non GUI frames. */
if (!FRAME_W32_P (f))
return;
- cancel_hourglass ();
-
- if (INTEGERP (Vhourglass_delay)
- && XINT (Vhourglass_delay) > 0)
- secs = XFASTINT (Vhourglass_delay);
- else if (FLOATP (Vhourglass_delay)
- && XFLOAT_DATA (Vhourglass_delay) > 0)
- {
- Lisp_Object tem;
- tem = Ftruncate (Vhourglass_delay, Qnil);
- secs = XFASTINT (tem);
- msecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000;
- }
- else
- secs = DEFAULT_HOURGLASS_DELAY;
-
- delay = secs * 1000 + msecs;
hourglass_hwnd = FRAME_W32_WINDOW (f);
- hourglass_timer = SetTimer (hourglass_hwnd, HOURGLASS_ID, delay, NULL);
}
-
-/* Cancel the hourglass cursor timer if active, hide an hourglass
- cursor if shown. */
-
void
-cancel_hourglass (void)
+show_hourglass (struct atimer *timer)
{
- if (hourglass_timer)
- {
- KillTimer (hourglass_hwnd, hourglass_timer);
- hourglass_timer = 0;
- }
+ struct frame *f;
- if (hourglass_shown_p)
- w32_hide_hourglass ();
+ hourglass_atimer = NULL;
+
+ block_input ();
+ f = x_window_to_frame (&one_w32_display_info,
+ hourglass_hwnd);
+
+ if (f)
+ f->output_data.w32->hourglass_p = 0;
+ else
+ f = SELECTED_FRAME ();
+
+ if (!FRAME_W32_P (f))
+ return;
+
+ w32_show_hourglass (f);
+ unblock_input ();
}
+void
+hide_hourglass (void)
+{
+ block_input ();
+ w32_hide_hourglass ();
+ unblock_input ();
+}
-/* Timer function of hourglass_timer.
- Display an hourglass cursor. Set the hourglass_p flag in display info
+/* Display an hourglass cursor. Set the hourglass_p flag in display info
to indicate that an hourglass cursor is shown. */
static void
@@ -5178,7 +5356,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
Lisp_Object name;
long window_prompting = 0;
int width, height;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
struct kboard *kb;
int face_change_count_before = face_change_count;
@@ -5213,17 +5391,18 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
XSETFRAME (frame, f);
buffer = Fget_buffer_create (build_string (" *tip*"));
- Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
+ /* Use set_window_buffer instead of Fset_window_buffer (see
+ discussion of bug#11984, bug#12025, bug#12026). */
+ set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, 0, 0);
old_buffer = current_buffer;
set_buffer_internal_1 (XBUFFER (buffer));
- BVAR (current_buffer, truncate_lines) = Qnil;
+ bset_truncate_lines (current_buffer, Qnil);
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Ferase_buffer ();
Finsert (1, &text);
set_buffer_internal_1 (old_buffer);
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
record_unwind_protect (unwind_create_tip_frame, frame);
/* By setting the output method, we're essentially saying that
@@ -5232,16 +5411,14 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
counts etc. */
f->terminal = dpyinfo->terminal;
f->output_method = output_w32;
- f->output_data.w32 =
- (struct w32_output *) xmalloc (sizeof (struct w32_output));
- memset (f->output_data.w32, 0, sizeof (struct w32_output));
+ f->output_data.w32 = xzalloc (sizeof (struct w32_output));
FRAME_FONTSET (f) = -1;
- f->icon_name = Qnil;
+ fset_icon_name (f, Qnil);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
image_cache_refcount =
- FRAME_IMAGE_CACHE ? FRAME_IMAGE_CACHE (f)->refcount : 0;
+ FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
dpyinfo_refcount = dpyinfo->reference_count;
#endif /* GLYPH_DEBUG */
FRAME_KBOARD (f) = kb;
@@ -5252,12 +5429,12 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
be set. */
if (EQ (name, Qunbound) || NILP (name))
{
- f->name = build_string (dpyinfo->w32_id_name);
+ fset_name (f, build_string (dpyinfo->w32_id_name));
f->explicit_name = 0;
}
else
{
- f->name = name;
+ fset_name (f, name);
f->explicit_name = 1;
/* use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
@@ -5326,9 +5503,9 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
f->left_fringe_width = 0;
f->right_fringe_width = 0;
- BLOCK_INPUT;
+ block_input ();
my_create_tip_window (f);
- UNBLOCK_INPUT;
+ unblock_input ();
x_make_gc (f);
@@ -5434,11 +5611,11 @@ compute_tip_xy (struct frame *f,
max_x = x_display_pixel_width (FRAME_W32_DISPLAY_INFO (f));
max_y = x_display_pixel_height (FRAME_W32_DISPLAY_INFO (f));
- BLOCK_INPUT;
+ block_input ();
GetCursorPos (&pt);
*root_x = pt.x;
*root_y = pt.y;
- UNBLOCK_INPUT;
+ unblock_input ();
/* If multiple monitor support is available, constrain the tip onto
the current monitor. This improves the above by allowing negative
@@ -5527,7 +5704,7 @@ Text larger than the specified size is clipped. */)
int i, width, height, seen_reversed_p;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_redisplay, Qt);
@@ -5573,7 +5750,7 @@ Text larger than the specified size is clipped. */)
call1 (Qcancel_timer, timer);
}
- BLOCK_INPUT;
+ block_input ();
compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
@@ -5587,7 +5764,7 @@ Text larger than the specified size is clipped. */)
0, 0, 0, 0,
SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
- UNBLOCK_INPUT;
+ unblock_input ();
goto start_timer;
}
}
@@ -5614,7 +5791,7 @@ Text larger than the specified size is clipped. */)
/* Block input until the tip has been fully drawn, to avoid crashes
when drawing tips in menus. */
- BLOCK_INPUT;
+ block_input ();
/* Create a frame for the tooltip, and record it in the global
variable tip_frame. */
@@ -5623,7 +5800,8 @@ Text larger than the specified size is clipped. */)
/* Set up the frame's root window. */
w = XWINDOW (FRAME_ROOT_WINDOW (f));
- w->left_col = w->top_line = make_number (0);
+ wset_left_col (w, make_number (0));
+ wset_top_line (w, make_number (0));
if (CONSP (Vx_max_tooltip_size)
&& INTEGERP (XCAR (Vx_max_tooltip_size))
@@ -5631,13 +5809,13 @@ Text larger than the specified size is clipped. */)
&& INTEGERP (XCDR (Vx_max_tooltip_size))
&& XINT (XCDR (Vx_max_tooltip_size)) > 0)
{
- w->total_cols = XCAR (Vx_max_tooltip_size);
- w->total_lines = XCDR (Vx_max_tooltip_size);
+ wset_total_cols (w, XCAR (Vx_max_tooltip_size));
+ wset_total_lines (w, XCDR (Vx_max_tooltip_size));
}
else
{
- w->total_cols = make_number (80);
- w->total_lines = make_number (40);
+ wset_total_cols (w, make_number (80));
+ wset_total_lines (w, make_number (40));
}
FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
@@ -5647,7 +5825,7 @@ Text larger than the specified size is clipped. */)
/* Display the tooltip text in a temporary buffer. */
old_buffer = current_buffer;
set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
- BVAR (current_buffer, truncate_lines) = Qnil;
+ bset_truncate_lines (current_buffer, Qnil);
clear_glyph_matrix (w->desired_matrix);
clear_glyph_matrix (w->current_matrix);
SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
@@ -5708,7 +5886,7 @@ Text larger than the specified size is clipped. */)
/* w->total_cols and FRAME_TOTAL_COLS want the width in columns,
not in pixels. */
width /= WINDOW_FRAME_COLUMN_WIDTH (w);
- w->total_cols = make_number (width);
+ wset_total_cols (w, make_number (width));
FRAME_TOTAL_COLS (f) = width;
adjust_glyphs (f);
w->pseudo_window_p = 1;
@@ -5785,7 +5963,7 @@ Text larger than the specified size is clipped. */)
w->must_be_updated_p = 1;
update_single_window (w, 1);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Restore original current buffer. */
set_buffer_internal_1 (old_buffer);
@@ -5806,7 +5984,7 @@ DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
Value is t if tooltip was open, nil otherwise. */)
(void)
{
- int count;
+ ptrdiff_t count;
Lisp_Object deleted, frame, timer;
struct gcpro gcpro1, gcpro2;
@@ -5840,6 +6018,18 @@ Value is t if tooltip was open, nil otherwise. */)
File selection dialog
***********************************************************************/
+#define FILE_NAME_TEXT_FIELD edt1
+#define FILE_NAME_COMBO_BOX cmb13
+#define FILE_NAME_LIST lst1
+
+#ifdef NTGUI_UNICODE
+#define GUISTR(x) (L ## x)
+typedef wchar_t guichar_t;
+#else /* !NTGUI_UNICODE */
+#define GUISTR(x) x
+typedef char guichar_t;
+#endif /* NTGUI_UNICODE */
+
/* Callback for altering the behavior of the Open File dialog.
Makes the Filename text field contain "Current Directory" and be
read-only when "Directories" is selected in the filter. This
@@ -5850,7 +6040,11 @@ file_dialog_callback (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
{
if (msg == WM_NOTIFY)
{
- OFNOTIFY * notify = (OFNOTIFY *)lParam;
+#ifdef NTGUI_UNICODE
+ OFNOTIFYW * notify = (OFNOTIFYW *)lParam;
+#else /* !NTGUI_UNICODE */
+ OFNOTIFYA * notify = (OFNOTIFYA *)lParam;
+#endif /* NTGUI_UNICODE */
/* Detect when the Filter dropdown is changed. */
if (notify->hdr.code == CDN_TYPECHANGE
|| notify->hdr.code == CDN_INITDONE)
@@ -5878,7 +6072,7 @@ file_dialog_callback (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
if (notify->lpOFN->nFilterIndex == 2)
{
CommDlg_OpenSave_SetControlText (dialog, FILE_NAME_TEXT_FIELD,
- "Current Directory");
+ GUISTR ("Current Directory"));
EnableWindow (edit_control, FALSE);
/* Note that at least on Windows 7, the above call to EnableWindow
disables the window that would ordinarily have focus. If we
@@ -5894,7 +6088,8 @@ file_dialog_callback (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
/* Don't override default filename on init done. */
if (notify->hdr.code == CDN_TYPECHANGE)
CommDlg_OpenSave_SetControlText (dialog,
- FILE_NAME_TEXT_FIELD, "");
+ FILE_NAME_TEXT_FIELD,
+ GUISTR (""));
EnableWindow (edit_control, TRUE);
}
}
@@ -5902,158 +6097,216 @@ file_dialog_callback (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
return 0;
}
-/* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility)
- we end up with the old file dialogs. Define a big enough struct for the
- new dialog to trick GetOpenFileName into giving us the new dialogs on
- Windows 2000 and XP. */
-typedef struct
-{
- OPENFILENAME real_details;
- void * pReserved;
- DWORD dwReserved;
- DWORD FlagsEx;
-} NEWOPENFILENAME;
-
-
DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
doc: /* 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 MS Windows, and X Windows with the
+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. */)
(Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object only_dir_p)
{
+ /* Filter index: 1: All Files, 2: Directories only */
+ static const guichar_t filter[] =
+ GUISTR ("All Files (*.*)\0*.*\0Directories\0*|*\0");
+
+ Lisp_Object filename = default_filename;
struct frame *f = SELECTED_FRAME ();
- Lisp_Object file = Qnil;
- int count = SPECPDL_INDEX ();
+ BOOL file_opened = FALSE;
+ Lisp_Object orig_dir = dir;
+ Lisp_Object orig_prompt = prompt;
+
+ /* If we compile with _WIN32_WINNT set to 0x0400 (for NT4
+ compatibility) we end up with the old file dialogs. Define a big
+ enough struct for the new dialog to trick GetOpenFileName into
+ giving us the new dialogs on newer versions of Windows. */
+ struct {
+#ifdef NTGUI_UNICODE
+ OPENFILENAMEW details;
+#else /* !NTGUI_UNICODE */
+ OPENFILENAMEA details;
+#endif /* NTGUI_UNICODE */
+
+#if _WIN32_WINNT < 0x500 /* < win2k */
+ PVOID pvReserved;
+ DWORD dwReserved;
+ DWORD FlagsEx;
+#endif /* < win2k */
+ } new_file_details;
+
+#ifdef NTGUI_UNICODE
+ wchar_t filename_buf[32*1024 + 1]; // NT kernel maximum
+ OPENFILENAMEW * file_details = &new_file_details.details;
+#else /* not NTGUI_UNICODE */
+ char filename_buf[MAX_PATH + 1];
+ OPENFILENAMEA * file_details = &new_file_details.details;
+#endif /* NTGUI_UNICODE */
+
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
- char filename[MAX_PATH + 1];
- char init_dir[MAX_PATH + 1];
- int default_filter_index = 1; /* 1: All Files, 2: Directories only */
-
- GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
- CHECK_STRING (prompt);
- CHECK_STRING (dir);
-
- /* Create the dialog with PROMPT as title, using DIR as initial
- directory and using "*" as pattern. */
- dir = Fexpand_file_name (dir, Qnil);
- strncpy (init_dir, SDATA (ENCODE_FILE (dir)), MAX_PATH);
- init_dir[MAX_PATH] = '\0';
- unixtodos_filename (init_dir);
-
- if (STRINGP (default_filename))
- {
- char *file_name_only;
- char *full_path_name = SDATA (ENCODE_FILE (default_filename));
+ GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, filename);
- unixtodos_filename (full_path_name);
+ {
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (orig_dir, orig_prompt); /* There is no GCPRON, N>6. */
- file_name_only = strrchr (full_path_name, '\\');
- if (!file_name_only)
- file_name_only = full_path_name;
- else
- file_name_only++;
+ /* Note: under NTGUI_UNICODE, we do _NOT_ use ENCODE_FILE: the
+ system file encoding expected by the platform APIs (e.g. Cygwin's
+ POSIX implementation) may not be the same as the encoding expected
+ by the Windows "ANSI" APIs! */
- strncpy (filename, file_name_only, MAX_PATH);
- filename[MAX_PATH] = '\0';
- }
- else
- filename[0] = '\0';
+ CHECK_STRING (prompt);
+ CHECK_STRING (dir);
- /* The code in file_dialog_callback that attempts to set the text
- of the file name edit window when handling the CDN_INITDONE
- WM_NOTIFY message does not work. Setting filename to "Current
- Directory" in the only_dir_p case here does work however. */
- if (filename[0] == 0 && ! NILP (only_dir_p))
- strcpy (filename, "Current Directory");
+ dir = Fexpand_file_name (dir, Qnil);
- {
- NEWOPENFILENAME new_file_details;
- BOOL file_opened = FALSE;
- OPENFILENAME * file_details = &new_file_details.real_details;
+ if (STRINGP (filename))
+ filename = Ffile_name_nondirectory (filename);
+ else
+ filename = empty_unibyte_string;
- /* Prevent redisplay. */
- specbind (Qinhibit_redisplay, Qt);
- BLOCK_INPUT;
+#ifdef CYGWIN
+ dir = Fcygwin_convert_file_name_to_windows (dir, Qt);
+ if (SCHARS (filename) > 0)
+ filename = Fcygwin_convert_file_name_to_windows (filename, Qnil);
+#endif
+ CHECK_STRING (dir);
+ CHECK_STRING (filename);
+
+ /* The code in file_dialog_callback that attempts to set the text
+ of the file name edit window when handling the CDN_INITDONE
+ WM_NOTIFY message does not work. Setting filename to "Current
+ Directory" in the only_dir_p case here does work however. */
+ if (SCHARS (filename) == 0 && ! NILP (only_dir_p))
+ filename = build_string ("Current Directory");
+
+ /* Convert the values we've computed so far to system form. */
+#ifdef NTGUI_UNICODE
+ to_unicode (prompt, &prompt);
+ to_unicode (dir, &dir);
+ to_unicode (filename, &filename);
+#else /* !NTGUI_UNICODE */
+ prompt = ENCODE_FILE (prompt);
+ dir = ENCODE_FILE (dir);
+ filename = ENCODE_FILE (filename);
+
+ /* We modify these in-place, so make copies for safety. */
+ dir = Fcopy_sequence (dir);
+ unixtodos_filename (SDATA (dir));
+ filename = Fcopy_sequence (filename);
+ unixtodos_filename (SDATA (filename));
+#endif /* NTGUI_UNICODE */
+
+ /* Fill in the structure for the call to GetOpenFileName below.
+ For NTGUI_UNICODE builds (which run only on NT), we just use
+ the actual size of the structure. For non-NTGUI_UNICODE
+ builds, we tell the OS we're using an old version of the
+ structure if the OS isn't new enough to support the newer
+ version. */
memset (&new_file_details, 0, sizeof (new_file_details));
- /* Apparently NT4 crashes if you give it an unexpected size.
- I'm not sure about Windows 9x, so play it safe. */
+
if (w32_major_version > 4 && w32_major_version < 95)
- file_details->lStructSize = sizeof (NEWOPENFILENAME);
+ file_details->lStructSize = sizeof (new_file_details);
else
- file_details->lStructSize = sizeof (OPENFILENAME);
+ file_details->lStructSize = sizeof (*file_details);
+
+ /* Set up the inout parameter for the selected file name. */
+ if (SBYTES (filename) + 1 > sizeof (filename_buf))
+ report_file_error ("filename too long", default_filename);
+
+ memcpy (filename_buf, SDATA (filename), SBYTES (filename) + 1);
+ file_details->lpstrFile = filename_buf;
+ file_details->nMaxFile = sizeof (filename_buf) / sizeof (*filename_buf);
file_details->hwndOwner = FRAME_W32_WINDOW (f);
/* Undocumented Bug in Common File Dialog:
If a filter is not specified, shell links are not resolved. */
- file_details->lpstrFilter = "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
- file_details->lpstrFile = filename;
- file_details->nMaxFile = sizeof (filename);
- file_details->lpstrInitialDir = init_dir;
- file_details->lpstrTitle = SDATA (prompt);
-
- if (! NILP (only_dir_p))
- default_filter_index = 2;
-
- file_details->nFilterIndex = default_filter_index;
-
+ file_details->lpstrFilter = filter;
+ file_details->lpstrInitialDir = (guichar_t*) SDATA (dir);
+ file_details->lpstrTitle = (guichar_t*) SDATA (prompt);
+ file_details->nFilterIndex = NILP (only_dir_p) ? 1 : 2;
file_details->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
- | OFN_EXPLORER | OFN_ENABLEHOOK);
+ | OFN_EXPLORER | OFN_ENABLEHOOK);
+
if (!NILP (mustmatch))
{
- /* Require that the path to the parent directory exists. */
- file_details->Flags |= OFN_PATHMUSTEXIST;
- /* If we are looking for a file, require that it exists. */
- if (NILP (only_dir_p))
- file_details->Flags |= OFN_FILEMUSTEXIST;
+ /* Require that the path to the parent directory exists. */
+ file_details->Flags |= OFN_PATHMUSTEXIST;
+ /* If we are looking for a file, require that it exists. */
+ if (NILP (only_dir_p))
+ file_details->Flags |= OFN_FILEMUSTEXIST;
}
- file_details->lpfnHook = (LPOFNHOOKPROC) file_dialog_callback;
-
- file_opened = GetOpenFileName (file_details);
-
- UNBLOCK_INPUT;
+ {
+ int count = SPECPDL_INDEX ();
+ /* Prevent redisplay. */
+ specbind (Qinhibit_redisplay, Qt);
+ block_input ();
+ file_details->lpfnHook = file_dialog_callback;
+
+#ifdef NTGUI_UNICODE
+ file_opened = GetOpenFileNameW (file_details);
+#else /* !NTGUI_UNICODE */
+ file_opened = GetOpenFileNameA (file_details);
+#endif /* NTGUI_UNICODE */
+ unblock_input ();
+ unbind_to (count, Qnil);
+ }
if (file_opened)
{
- dostounix_filename (filename);
-
- if (file_details->nFilterIndex == 2)
- {
- /* "Directories" selected - strip dummy file name. */
- char * last = strrchr (filename, '/');
- *last = '\0';
- }
-
- file = DECODE_FILE (build_string (filename));
+ /* Get an Emacs string from the value Windows gave us. */
+#ifdef NTGUI_UNICODE
+ filename = from_unicode (
+ make_unibyte_string (
+ (char*) filename_buf,
+ /* we get one of the two final 0 bytes for free. */
+ 1 + sizeof (wchar_t) * wcslen (filename_buf)));
+#else /* !NTGUI_UNICODE */
+ dostounix_filename (filename_buf);
+ filename = DECODE_FILE (build_string (filename_buf));
+#endif /* NTGUI_UNICODE */
+
+#ifdef CYGWIN
+ filename = Fcygwin_convert_file_name_from_windows (filename, Qt);
+#endif /* CYGWIN */
+
+ /* Strip the dummy filename off the end of the string if we
+ added it to select a directory. */
+ if (file_details->nFilterIndex == 2)
+ {
+ filename = Ffile_name_directory (filename);
+ }
}
/* User canceled the dialog without making a selection. */
else if (!CommDlgExtendedError ())
- file = Qnil;
+ filename = Qnil;
/* An error occurred, fallback on reading from the mini-buffer. */
else
- file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
- dir, mustmatch, dir, Qfile_name_history,
- default_filename, Qnil);
+ filename = Fcompleting_read (
+ orig_prompt,
+ intern ("read-file-name-internal"),
+ orig_dir,
+ mustmatch,
+ orig_dir,
+ Qfile_name_history,
+ default_filename,
+ Qnil);
- file = unbind_to (count, file);
+ UNGCPRO;
}
- UNGCPRO;
-
/* Make "Cancel" equivalent to C-g. */
- if (NILP (file))
+ if (NILP (filename))
Fsignal (Qquit, Qnil);
- return unbind_to (count, file);
+ RETURN_UNGCPRO (filename);
}
-
+
+#ifdef WINDOWSNT
/* Moving files to the system recycle bin.
Used by `move-file-to-trash' instead of the default moving to ~/.Trash */
DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash,
@@ -6107,6 +6360,8 @@ DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash,
return Qnil;
}
+#endif /* WINDOWSNT */
+
/***********************************************************************
w32 specialized functions
@@ -6203,8 +6458,7 @@ an integer representing a ShowWindow flag:
if (!NILP (Vlocale_coding_system))
{
Lisp_Object decoded =
- code_convert_string_norecord (make_unibyte_string (errstr,
- strlen (errstr)),
+ code_convert_string_norecord (build_unibyte_string (errstr),
Vlocale_coding_system, 0);
errstr = SSDATA (decoded);
}
@@ -6263,7 +6517,7 @@ w32_parse_hot_key (Lisp_Object key)
lisp_modifiers = XINT (Fcar (Fcdr (c)));
c = Fcar (c);
if (!SYMBOLP (c))
- abort ();
+ emacs_abort ();
vk_code = lookup_vk_code (SDATA (SYMBOL_NAME (c)));
}
else if (INTEGERP (c))
@@ -6328,13 +6582,8 @@ The return value is the hotkey-id if registered, otherwise nil. */)
/* Notify input thread about new hot-key definition, so that it
takes effect without needing to switch focus. */
-#ifdef USE_LISP_UNION_TYPE
- PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
- (WPARAM) key.i, 0);
-#else
PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
- (WPARAM) key, 0);
-#endif
+ (WPARAM) XLI (key), 0);
}
return key;
@@ -6356,13 +6605,8 @@ DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
{
/* Notify input thread about hot-key definition being removed, so
that it takes effect without needing focus switch. */
-#ifdef USE_LISP_UNION_TYPE
if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
- (WPARAM) XINT (XCAR (item)), (LPARAM) item.i))
-#else
- if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
- (WPARAM) XINT (XCAR (item)), (LPARAM) item))
-#endif
+ (WPARAM) XINT (XCAR (item)), (LPARAM) XLI (item)))
{
MSG msg;
GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
@@ -6434,13 +6678,8 @@ is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
if (!dwWindowsThreadId)
return make_number (w32_console_toggle_lock_key (vk_code, new_state));
-#ifdef USE_LISP_UNION_TYPE
- if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
- (WPARAM) vk_code, (LPARAM) new_state.i))
-#else
if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
- (WPARAM) vk_code, (LPARAM) new_state))
-#endif
+ (WPARAM) vk_code, (LPARAM) XLI (new_state)))
{
MSG msg;
GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
@@ -6492,7 +6731,6 @@ The following %-sequences are provided:
{
Lisp_Object line_status, battery_status, battery_status_symbol;
Lisp_Object load_percentage, seconds, minutes, hours, remain;
- Lisp_Object sequences[8];
long seconds_left = (long) system_status.BatteryLifeTime;
@@ -6541,7 +6779,7 @@ The following %-sequences are provided:
else
{
char buffer[16];
- _snprintf (buffer, 16, "%d", system_status.BatteryLifePercent);
+ snprintf (buffer, 16, "%d", system_status.BatteryLifePercent);
load_percentage = build_string (buffer);
}
@@ -6552,30 +6790,30 @@ The following %-sequences are provided:
long m;
float h;
char buffer[16];
- _snprintf (buffer, 16, "%ld", seconds_left);
+ snprintf (buffer, 16, "%ld", seconds_left);
seconds = build_string (buffer);
m = seconds_left / 60;
- _snprintf (buffer, 16, "%ld", m);
+ snprintf (buffer, 16, "%ld", m);
minutes = build_string (buffer);
h = seconds_left / 3600.0;
- _snprintf (buffer, 16, "%3.1f", h);
+ snprintf (buffer, 16, "%3.1f", h);
hours = build_string (buffer);
- _snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60);
+ snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60);
remain = build_string (buffer);
}
- sequences[0] = Fcons (make_number ('L'), line_status);
- sequences[1] = Fcons (make_number ('B'), battery_status);
- sequences[2] = Fcons (make_number ('b'), battery_status_symbol);
- sequences[3] = Fcons (make_number ('p'), load_percentage);
- sequences[4] = Fcons (make_number ('s'), seconds);
- sequences[5] = Fcons (make_number ('m'), minutes);
- sequences[6] = Fcons (make_number ('h'), hours);
- sequences[7] = Fcons (make_number ('t'), remain);
-
- status = Flist (8, sequences);
+
+ status = listn (CONSTYPE_HEAP, 8,
+ Fcons (make_number ('L'), line_status),
+ Fcons (make_number ('B'), battery_status),
+ Fcons (make_number ('b'), battery_status_symbol),
+ Fcons (make_number ('p'), load_percentage),
+ Fcons (make_number ('s'), seconds),
+ Fcons (make_number ('m'), minutes),
+ Fcons (make_number ('h'), hours),
+ Fcons (make_number ('t'), remain));
}
return status;
}
@@ -6598,7 +6836,7 @@ If the underlying system call fails, value is nil. */)
value = Qnil;
/* Determining the required information on Windows turns out, sadly,
- to be more involved than one would hope. The original Win32 api
+ to be more involved than one would hope. The original Windows API
call for this will return bogus information on some systems, but we
must dynamically probe for the replacement api, since that was
added rather late on. */
@@ -6704,7 +6942,7 @@ DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
return Qnil;
}
/* Allocate memory for the PRINTER_INFO_2 struct */
- ppi2 = (PRINTER_INFO_2 *) xmalloc (dwNeeded);
+ ppi2 = xmalloc (dwNeeded);
if (!ppi2)
{
ClosePrinter (hPrn);
@@ -6725,10 +6963,10 @@ DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
{
/* a remote printer */
if (*ppi2->pServerName == '\\')
- _snprintf (pname_buf, sizeof (pname_buf), "%s\\%s", ppi2->pServerName,
+ snprintf (pname_buf, sizeof (pname_buf), "%s\\%s", ppi2->pServerName,
ppi2->pShareName);
else
- _snprintf (pname_buf, sizeof (pname_buf), "\\\\%s\\%s", ppi2->pServerName,
+ snprintf (pname_buf, sizeof (pname_buf), "\\\\%s\\%s", ppi2->pServerName,
ppi2->pShareName);
pname_buf[sizeof (pname_buf) - 1] = '\0';
}
@@ -6747,6 +6985,294 @@ DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
return build_string (pname_buf);
}
+
+/* Equivalent of strerror for W32 error codes. */
+char *
+w32_strerror (int error_no)
+{
+ static char buf[500];
+ DWORD ret;
+
+ if (error_no == 0)
+ error_no = GetLastError ();
+
+ ret = FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM |
+ FORMAT_MESSAGE_IGNORE_INSERTS,
+ NULL,
+ error_no,
+ 0, /* choose most suitable language */
+ buf, sizeof (buf), NULL);
+
+ while (ret > 0 && (buf[ret - 1] == '\n' ||
+ buf[ret - 1] == '\r' ))
+ --ret;
+ buf[ret] = '\0';
+ if (!ret)
+ sprintf (buf, "w32 error %u", error_no);
+
+ return buf;
+}
+
+/* For convenience when debugging. (You cannot call GetLastError
+ directly from GDB: it will crash, because it uses the __stdcall
+ calling convention, not the _cdecl convention assumed by GDB.) */
+DWORD
+w32_last_error (void)
+{
+ return GetLastError ();
+}
+
+/* Cache information describing the NT system for later use. */
+void
+cache_system_info (void)
+{
+ union
+ {
+ struct info
+ {
+ char major;
+ char minor;
+ short platform;
+ } info;
+ DWORD data;
+ } version;
+
+ /* Cache the version of the operating system. */
+ version.data = GetVersion ();
+ w32_major_version = version.info.major;
+ w32_minor_version = version.info.minor;
+
+ if (version.info.platform & 0x8000)
+ os_subtype = OS_9X;
+ else
+ os_subtype = OS_NT;
+
+ /* Cache page size, allocation unit, processor type, etc. */
+ GetSystemInfo (&sysinfo_cache);
+ syspage_mask = sysinfo_cache.dwPageSize - 1;
+
+ /* Cache os info. */
+ osinfo_cache.dwOSVersionInfoSize = sizeof (OSVERSIONINFO);
+ GetVersionEx (&osinfo_cache);
+
+ w32_build_number = osinfo_cache.dwBuildNumber;
+ if (os_subtype == OS_9X)
+ w32_build_number &= 0xffff;
+
+ w32_num_mouse_buttons = GetSystemMetrics (SM_CMOUSEBUTTONS);
+}
+
+#ifdef EMACSDEBUG
+void
+_DebPrint (const char *fmt, ...)
+{
+ char buf[1024];
+ va_list args;
+
+ va_start (args, fmt);
+ vsprintf (buf, fmt, args);
+ va_end (args);
+#if CYGWIN
+ fprintf (stderr, "%s", buf);
+#endif
+ OutputDebugString (buf);
+}
+#endif
+
+int
+w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state)
+{
+ int cur_state = (GetKeyState (vk_code) & 1);
+
+ if (NILP (new_state)
+ || (NUMBERP (new_state)
+ && ((XUINT (new_state)) & 1) != cur_state))
+ {
+#ifdef WINDOWSNT
+ faked_key = vk_code;
+#endif /* WINDOWSNT */
+
+ keybd_event ((BYTE) vk_code,
+ (BYTE) MapVirtualKey (vk_code, 0),
+ KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
+ keybd_event ((BYTE) vk_code,
+ (BYTE) MapVirtualKey (vk_code, 0),
+ KEYEVENTF_EXTENDEDKEY | 0, 0);
+ keybd_event ((BYTE) vk_code,
+ (BYTE) MapVirtualKey (vk_code, 0),
+ KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
+ cur_state = !cur_state;
+ }
+
+ return cur_state;
+}
+
+/* Translate console modifiers to emacs modifiers.
+ German keyboard support (Kai Morgan Zeise 2/18/95). */
+int
+w32_kbd_mods_to_emacs (DWORD mods, WORD key)
+{
+ int retval = 0;
+
+ /* If we recognize right-alt and left-ctrl as AltGr, and it has been
+ pressed, first remove those modifiers. */
+ if (!NILP (Vw32_recognize_altgr)
+ && (mods & (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
+ == (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
+ mods &= ~ (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED);
+
+ if (mods & (RIGHT_ALT_PRESSED | LEFT_ALT_PRESSED))
+ retval = ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier);
+
+ if (mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
+ {
+ retval |= ctrl_modifier;
+ if ((mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
+ == (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
+ retval |= meta_modifier;
+ }
+
+ if (mods & LEFT_WIN_PRESSED)
+ retval |= w32_key_to_modifier (VK_LWIN);
+ if (mods & RIGHT_WIN_PRESSED)
+ retval |= w32_key_to_modifier (VK_RWIN);
+ if (mods & APPS_PRESSED)
+ retval |= w32_key_to_modifier (VK_APPS);
+ if (mods & SCROLLLOCK_ON)
+ retval |= w32_key_to_modifier (VK_SCROLL);
+
+ /* Just in case someone wanted the original behavior, make it
+ optional by setting w32-capslock-is-shiftlock to t. */
+ if (NILP (Vw32_capslock_is_shiftlock)
+ /* Keys that should _not_ be affected by CapsLock. */
+ && ( (key == VK_BACK)
+ || (key == VK_TAB)
+ || (key == VK_CLEAR)
+ || (key == VK_RETURN)
+ || (key == VK_ESCAPE)
+ || ((key >= VK_SPACE) && (key <= VK_HELP))
+ || ((key >= VK_NUMPAD0) && (key <= VK_F24))
+ || ((key >= VK_NUMPAD_CLEAR) && (key <= VK_NUMPAD_DELETE))
+ ))
+ {
+ /* Only consider shift state. */
+ if ((mods & SHIFT_PRESSED) != 0)
+ retval |= shift_modifier;
+ }
+ else
+ {
+ /* Ignore CapsLock state if not enabled. */
+ if (NILP (Vw32_enable_caps_lock))
+ mods &= ~CAPSLOCK_ON;
+ if ((mods & (SHIFT_PRESSED | CAPSLOCK_ON)) != 0)
+ retval |= shift_modifier;
+ }
+
+ return retval;
+}
+
+/* The return code indicates key code size. cpID is the codepage to
+ use for translation to Unicode; -1 means use the current console
+ input codepage. */
+int
+w32_kbd_patch_key (KEY_EVENT_RECORD *event, int cpId)
+{
+ unsigned int key_code = event->wVirtualKeyCode;
+ unsigned int mods = event->dwControlKeyState;
+ BYTE keystate[256];
+ static BYTE ansi_code[4];
+ static int isdead = 0;
+
+ if (isdead == 2)
+ {
+ event->uChar.AsciiChar = ansi_code[2];
+ isdead = 0;
+ return 1;
+ }
+ if (event->uChar.AsciiChar != 0)
+ return 1;
+
+ memset (keystate, 0, sizeof (keystate));
+ keystate[key_code] = 0x80;
+ if (mods & SHIFT_PRESSED)
+ keystate[VK_SHIFT] = 0x80;
+ if (mods & CAPSLOCK_ON)
+ keystate[VK_CAPITAL] = 1;
+ /* If we recognize right-alt and left-ctrl as AltGr, set the key
+ states accordingly before invoking ToAscii. */
+ if (!NILP (Vw32_recognize_altgr)
+ && (mods & LEFT_CTRL_PRESSED) && (mods & RIGHT_ALT_PRESSED))
+ {
+ keystate[VK_CONTROL] = 0x80;
+ keystate[VK_LCONTROL] = 0x80;
+ keystate[VK_MENU] = 0x80;
+ keystate[VK_RMENU] = 0x80;
+ }
+
+#if 0
+ /* Because of an OS bug, ToAscii corrupts the stack when called to
+ convert a dead key in console mode on NT4. Unfortunately, trying
+ to check for dead keys using MapVirtualKey doesn't work either -
+ these functions apparently use internal information about keyboard
+ layout which doesn't get properly updated in console programs when
+ changing layout (though apparently it gets partly updated,
+ otherwise ToAscii wouldn't crash). */
+ if (is_dead_key (event->wVirtualKeyCode))
+ return 0;
+#endif
+
+ /* On NT, call ToUnicode instead and then convert to the current
+ console input codepage. */
+ if (os_subtype == OS_NT)
+ {
+ WCHAR buf[128];
+
+ isdead = ToUnicode (event->wVirtualKeyCode, event->wVirtualScanCode,
+ keystate, buf, 128, 0);
+ if (isdead > 0)
+ {
+ /* When we are called from the GUI message processing code,
+ we are passed the current keyboard codepage, a positive
+ number, to use below. */
+ if (cpId == -1)
+ cpId = GetConsoleCP ();
+
+ event->uChar.UnicodeChar = buf[isdead - 1];
+ isdead = WideCharToMultiByte (cpId, 0, buf, isdead,
+ ansi_code, 4, NULL, NULL);
+ }
+ else
+ isdead = 0;
+ }
+ else
+ {
+ isdead = ToAscii (event->wVirtualKeyCode, event->wVirtualScanCode,
+ keystate, (LPWORD) ansi_code, 0);
+ }
+
+ if (isdead == 0)
+ return 0;
+ event->uChar.AsciiChar = ansi_code[0];
+ return isdead;
+}
+
+
+void
+w32_sys_ring_bell (struct frame *f)
+{
+ if (sound_type == 0xFFFFFFFF)
+ {
+ Beep (666, 100);
+ }
+ else if (sound_type == MB_EMACS_SILENT)
+ {
+ /* Do nothing. */
+ }
+ else
+ MessageBeep (sound_type);
+}
+
+
/***********************************************************************
Initialization
***********************************************************************/
@@ -6801,7 +7327,6 @@ syms_of_w32fns (void)
w32_visible_system_caret_hwnd = NULL;
- DEFSYM (Qnone, "none");
DEFSYM (Qsuppress_icon, "suppress-icon");
DEFSYM (Qundefined_color, "undefined-color");
DEFSYM (Qcancel_timer, "cancel-timer");
@@ -6817,9 +7342,9 @@ syms_of_w32fns (void)
Fput (Qundefined_color, Qerror_conditions,
- pure_cons (Qundefined_color, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror));
Fput (Qundefined_color, Qerror_message,
- make_pure_c_string ("Undefined color"));
+ build_pure_c_string ("Undefined color"));
staticpro (&w32_grabbed_keys);
w32_grabbed_keys = Qnil;
@@ -7114,11 +7639,10 @@ only be necessary if the default setting causes problems. */);
defsubr (&Sfile_system_info);
defsubr (&Sdefault_printer_name);
+ defsubr (&Sset_message_beep);
check_window_system_func = check_w32;
-
- hourglass_timer = 0;
hourglass_hwnd = NULL;
defsubr (&Sx_show_tip);
@@ -7132,7 +7656,9 @@ only be necessary if the default setting causes problems. */);
staticpro (&last_show_tip_args);
defsubr (&Sx_file_dialog);
+#ifdef WINDOWSNT
defsubr (&Ssystem_move_file_to_trash);
+#endif
}
@@ -7176,22 +7702,52 @@ globals_of_w32fns (void)
doc: /* The ANSI code page used by the system. */);
w32_ansi_code_page = GetACP ();
+ if (os_subtype == OS_NT)
+ w32_unicode_gui = 1;
+ else
+ w32_unicode_gui = 0;
+
/* MessageBox does not work without this when linked to comctl32.dll 6.0. */
InitCommonControls ();
syms_of_w32uniscribe ();
}
-#undef abort
+typedef USHORT (WINAPI * CaptureStackBackTrace_proc) (ULONG, ULONG, PVOID *,
+ PULONG);
+
+#define BACKTRACE_LIMIT_MAX 62
+
+int
+w32_backtrace (void **buffer, int limit)
+{
+ static CaptureStackBackTrace_proc s_pfn_CaptureStackBackTrace = NULL;
+ HMODULE hm_kernel32 = NULL;
+
+ if (!s_pfn_CaptureStackBackTrace)
+ {
+ hm_kernel32 = LoadLibrary ("Kernel32.dll");
+ s_pfn_CaptureStackBackTrace =
+ (CaptureStackBackTrace_proc) GetProcAddress (hm_kernel32,
+ "RtlCaptureStackBackTrace");
+ }
+ if (s_pfn_CaptureStackBackTrace)
+ return s_pfn_CaptureStackBackTrace (0, min (BACKTRACE_LIMIT_MAX, limit),
+ buffer, NULL);
+ return 0;
+}
void
-w32_abort (void)
+emacs_abort (void)
{
int button;
button = MessageBox (NULL,
"A fatal error has occurred!\n\n"
"Would you like to attach a debugger?\n\n"
- "Select YES to debug, NO to abort Emacs"
+ "Select:\n"
+ "YES -- to debug Emacs, or\n"
+ "NO -- to abort Emacs and produce a backtrace\n"
+ " (emacs_backtrace.txt in current directory)."
#if __GNUC__
"\n\n(type \"gdb -p <emacs-PID>\" and\n"
"\"continue\" inside GDB before clicking YES.)"
@@ -7206,14 +7762,59 @@ w32_abort (void)
exit (2); /* tell the compiler we will never return */
case IDNO:
default:
- abort ();
- break;
- }
-}
+ {
+ void *stack[BACKTRACE_LIMIT_MAX + 1];
+ int i = w32_backtrace (stack, BACKTRACE_LIMIT_MAX + 1);
-/* For convenience when debugging. */
-int
-w32_last_error (void)
-{
- return GetLastError ();
+ if (i)
+ {
+#ifdef CYGWIN
+ int stderr_fd = 2;
+#else
+ HANDLE errout = GetStdHandle (STD_ERROR_HANDLE);
+ int stderr_fd = -1;
+#endif
+ int errfile_fd = -1;
+ int j;
+
+#ifndef CYGWIN
+ if (errout && errout != INVALID_HANDLE_VALUE)
+ stderr_fd = _open_osfhandle ((intptr_t)errout, O_APPEND | O_BINARY);
+#endif
+ if (stderr_fd >= 0)
+ write (stderr_fd, "\r\nBacktrace:\r\n", 14);
+ errfile_fd = _open ("emacs_backtrace.txt", O_RDWR | O_CREAT | O_BINARY, S_IREAD | S_IWRITE);
+ if (errfile_fd >= 0)
+ {
+ lseek (errfile_fd, 0L, SEEK_END);
+ write (errfile_fd, "\r\nBacktrace:\r\n", 14);
+ }
+
+ for (j = 0; j < i; j++)
+ {
+ char buf[INT_BUFSIZE_BOUND (void *)];
+
+ /* stack[] gives the return addresses, whereas we want
+ the address of the call, so decrease each address
+ by approximate size of 1 CALL instruction. */
+ sprintf (buf, "0x%p\r\n", stack[j] - sizeof(void *));
+ if (stderr_fd >= 0)
+ write (stderr_fd, buf, strlen (buf));
+ if (errfile_fd >= 0)
+ write (errfile_fd, buf, strlen (buf));
+ }
+ if (i == BACKTRACE_LIMIT_MAX)
+ {
+ if (stderr_fd >= 0)
+ write (stderr_fd, "...\r\n", 5);
+ if (errfile_fd >= 0)
+ write (errfile_fd, "...\r\n", 5);
+ }
+ if (errfile_fd >= 0)
+ close (errfile_fd);
+ }
+ abort ();
+ break;
+ }
+ }
}
diff --git a/src/w32font.c b/src/w32font.c
index e8a223de0a4..d7d25d89939 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -1,5 +1,5 @@
-/* Font backend for the Microsoft W32 API.
- Copyright (C) 2007-2011 Free Software Foundation, Inc.
+/* Font backend for the Microsoft Windows API.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -18,10 +18,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <windows.h>
+#include <stdio.h>
#include <math.h>
#include <ctype.h>
#include <commdlg.h>
-#include <setjmp.h>
#include "lisp.h"
#include "w32term.h"
@@ -62,7 +62,6 @@ static Lisp_Object Qserif, Qscript, Qdecorative;
static Lisp_Object Qraster, Qoutline, Qunknown;
/* antialiasing */
-extern Lisp_Object Qnone; /* reuse from w32fns.c */
static Lisp_Object Qstandard, Qsubpixel, Qnatural;
/* languages */
@@ -75,7 +74,7 @@ static Lisp_Object Qgurmukhi, Qgujarati, Qoriya, Qtamil, Qtelugu;
static Lisp_Object Qkannada, Qmalayalam, Qsinhala, Qthai, Qlao;
static Lisp_Object Qtibetan, Qmyanmar, Qgeorgian, Qhangul, Qethiopic;
static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic;
-static Lisp_Object Qkhmer, Qmongolian, Qsymbol, Qbraille, Qhan;
+static Lisp_Object Qkhmer, Qmongolian, Qbraille, Qhan;
static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo;
static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol;
static Lisp_Object Qmusical_symbol, Qmathematical, Qcham, Qphonetic;
@@ -235,8 +234,7 @@ get_outline_metrics_w(HDC hdc, UINT cbData, LPOUTLINETEXTMETRICW lpotmw)
s_pfn_Get_Outline_Text_MetricsW = (GetOutlineTextMetricsW_Proc)
GetProcAddress (hm_unicows, "GetOutlineTextMetricsW");
}
- if (s_pfn_Get_Outline_Text_MetricsW == NULL)
- abort (); /* cannot happen */
+ eassert (s_pfn_Get_Outline_Text_MetricsW != NULL);
return s_pfn_Get_Outline_Text_MetricsW (hdc, cbData, lpotmw);
}
@@ -253,8 +251,7 @@ get_text_metrics_w(HDC hdc, LPTEXTMETRICW lptmw)
s_pfn_Get_Text_MetricsW = (GetTextMetricsW_Proc)
GetProcAddress (hm_unicows, "GetTextMetricsW");
}
- if (s_pfn_Get_Text_MetricsW == NULL)
- abort (); /* cannot happen */
+ eassert (s_pfn_Get_Text_MetricsW != NULL);
return s_pfn_Get_Text_MetricsW (hdc, lptmw);
}
@@ -272,8 +269,7 @@ get_glyph_outline_w (HDC hdc, UINT uChar, UINT uFormat, LPGLYPHMETRICS lpgm,
s_pfn_Get_Glyph_OutlineW = (GetGlyphOutlineW_Proc)
GetProcAddress (hm_unicows, "GetGlyphOutlineW");
}
- if (s_pfn_Get_Glyph_OutlineW == NULL)
- abort (); /* cannot happen */
+ eassert (s_pfn_Get_Glyph_OutlineW != NULL);
return s_pfn_Get_Glyph_OutlineW (hdc, uChar, uFormat, lpgm, cbBuffer,
lpvBuffer, lpmat2);
}
@@ -289,20 +285,12 @@ memq_no_quit (Lisp_Object elt, Lisp_Object list)
Lisp_Object
intern_font_name (char * string)
{
- Lisp_Object obarray, tem, str;
- int len;
-
- str = DECODE_SYSTEM (build_string (string));
- len = SCHARS (str);
-
- /* The following code is copied from the function intern (in lread.c). */
- obarray = Vobarray;
- if (!VECTORP (obarray) || ASIZE (obarray) == 0)
- obarray = check_obarray (obarray);
- tem = oblookup (obarray, SDATA (str), len, len);
- if (SYMBOLP (tem))
- return tem;
- return Fintern (str, obarray);
+ Lisp_Object str = DECODE_SYSTEM (build_string (string));
+ int len = SCHARS (str);
+ Lisp_Object obarray = check_obarray (Vobarray);
+ Lisp_Object tem = oblookup (obarray, SDATA (str), len, len);
+ /* This code is similar to intern function from lread.c. */
+ return SYMBOLP (tem) ? tem : Fintern (str, obarray);
}
/* w32 implementation of get_cache for font backend.
@@ -529,9 +517,7 @@ w32font_text_extents (struct font *font, unsigned *code,
if (!w32_font->cached_metrics[block])
{
w32_font->cached_metrics[block]
- = xmalloc (CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
- memset (w32_font->cached_metrics[block], 0,
- CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
+ = xzalloc (CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
}
char_metric = w32_font->cached_metrics[block] + pos_in_block;
@@ -649,9 +635,9 @@ w32font_text_extents (struct font *font, unsigned *code,
/* w32 implementation of draw for font backend.
Optional.
Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
- position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
- is nonzero, fill the background in advance. It is assured that
- WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).
+ position of frame F with S->FACE and S->GC. If WITH_BACKGROUND,
+ fill the background in advance. It is assured that WITH_BACKGROUND
+ is false when (FROM > 0 || TO < S->nchars).
TODO: Currently this assumes that the colors and fonts are already
set in the DC. This seems to be true now, but maybe only due to
@@ -661,7 +647,7 @@ w32font_text_extents (struct font *font, unsigned *code,
int
w32font_draw (struct glyph_string *s, int from, int to,
- int x, int y, int with_background)
+ int x, int y, bool with_background)
{
UINT options;
HRGN orig_clip = NULL;
@@ -818,7 +804,7 @@ static int
w32font_otf_drive (struct font *font, Lisp_Object features,
Lisp_Object gstring_in, int from, int to,
Lisp_Object gstring_out, int idx,
- int alternate_subst);
+ bool alternate_subst);
*/
/* Internal implementation of w32font_list.
@@ -1001,7 +987,6 @@ w32font_open_internal (FRAME_PTR f, Lisp_Object font_entity,
font->space_width = font->average_width = w32_font->metrics.tmAveCharWidth;
font->vertical_centering = 0;
- font->encoding_type = 0;
font->baseline_offset = 0;
font->relative_compose = 0;
font->default_ascent = w32_font->metrics.tmAscent;
@@ -1404,7 +1389,7 @@ font_matches_spec (DWORD type, NEWTEXTMETRICEX *font,
currently appear in fontset.el, so it isn't worth
creating a mapping table of codepages/scripts to languages
or opening the font to see if there are any language tags
- in it that the W32 API does not expose. Fontset
+ in it that the Windows API does not expose. Fontset
spec should have a fallback, as some backends do
not recognize language at all. */
return 0;
@@ -1450,6 +1435,9 @@ w32font_coverage_ok (FONTSIGNATURE * coverage, BYTE charset)
return 1;
}
+#ifndef WINDOWSNT
+#define _strlwr strlwr
+#endif /* !WINDOWSNT */
static int
check_face_name (LOGFONT *font, char *full_name)
@@ -2045,8 +2033,11 @@ fill_in_logfont (FRAME_PTR f, LOGFONT *logfont, Lisp_Object font_spec)
/* Font families are interned, but allow for strings also in case of
user input. */
else if (SYMBOLP (tmp))
- strncpy (logfont->lfFaceName,
- SDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
+ {
+ strncpy (logfont->lfFaceName,
+ SDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
+ logfont->lfFaceName[LF_FACESIZE-1] = '\0';
+ }
}
tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
@@ -2641,7 +2632,6 @@ syms_of_w32font (void)
DEFSYM (Qrunic, "runic");
DEFSYM (Qkhmer, "khmer");
DEFSYM (Qmongolian, "mongolian");
- DEFSYM (Qsymbol, "symbol");
DEFSYM (Qbraille, "braille");
DEFSYM (Qhan, "han");
DEFSYM (Qideographic_description, "ideographic-description");
diff --git a/src/w32font.h b/src/w32font.h
index f77866b869f..8fa00a9b524 100644
--- a/src/w32font.h
+++ b/src/w32font.h
@@ -1,5 +1,5 @@
-/* Shared GDI and Uniscribe Font backend declarations for the W32 API.
- Copyright (C) 2007-2011 Free Software Foundation, Inc.
+/* Shared GDI and Uniscribe Font backend declarations for the Windows API.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,6 +19,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef EMACS_W32FONT_H
#define EMACS_W32FONT_H
+#include "font.h"
/* Bit 17 of ntmFlags in NEWTEXTMETRIC is set for PostScript OpenType fonts,
bit 18 for TrueType OpenType fonts, bit 20 for Type1 fonts. */
@@ -76,11 +77,14 @@ int w32font_has_char (Lisp_Object entity, int c);
int w32font_text_extents (struct font *font, unsigned *code, int nglyphs,
struct font_metrics *metrics);
int w32font_draw (struct glyph_string *s, int from, int to,
- int x, int y, int with_background);
+ int x, int y, bool with_background);
int uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec);
Lisp_Object intern_font_name (char *);
+extern void syms_of_w32font (void);
+extern void globals_of_w32font (void);
+
#endif
diff --git a/src/w32gui.h b/src/w32gui.h
index 2ba9cb53e22..0da8de97f23 100644
--- a/src/w32gui.h
+++ b/src/w32gui.h
@@ -1,5 +1,5 @@
-/* Definitions and headers for communication on the Microsoft W32 API.
- Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+/* Definitions and headers for communication on the Microsoft Windows API.
+ Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -118,9 +118,6 @@ extern int nCmdShow;
#define PBaseSize (1L << 8) /* program specified base for incrementing */
#define PWinGravity (1L << 9) /* program specified window gravity */
-extern int XParseGeometry (char *, int *, int *, unsigned *, unsigned *);
-
-
typedef struct {
int x, y;
unsigned width, height;
diff --git a/src/w32heap.c b/src/w32heap.c
index 477c11a5160..311e1064434 100644
--- a/src/w32heap.c
+++ b/src/w32heap.c
@@ -1,5 +1,5 @@
-/* Heap management routines for GNU Emacs on the Microsoft W32 API.
- Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+/* Heap management routines for GNU Emacs on the Microsoft Windows API.
+ Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -22,66 +22,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
+#include "w32common.h"
#include "w32heap.h"
#include "lisp.h" /* for VALMASK */
-#define RVA_TO_PTR(rva) ((unsigned char *)((DWORD)(rva) + (DWORD)GetModuleHandle (NULL)))
-
-/* This gives us the page size and the size of the allocation unit on NT. */
-SYSTEM_INFO sysinfo_cache;
-
-/* This gives us version, build, and platform identification. */
-OSVERSIONINFO osinfo_cache;
-
-unsigned long syspage_mask = 0;
-
-/* The major and minor versions of NT. */
-int w32_major_version;
-int w32_minor_version;
-int w32_build_number;
-
-/* Distinguish between Windows NT and Windows 95. */
-int os_subtype;
-
-/* Cache information describing the NT system for later use. */
-void
-cache_system_info (void)
-{
- union
- {
- struct info
- {
- char major;
- char minor;
- short platform;
- } info;
- DWORD data;
- } version;
-
- /* Cache the version of the operating system. */
- version.data = GetVersion ();
- w32_major_version = version.info.major;
- w32_minor_version = version.info.minor;
-
- if (version.info.platform & 0x8000)
- os_subtype = OS_WIN95;
- else
- os_subtype = OS_NT;
-
- /* Cache page size, allocation unit, processor type, etc. */
- GetSystemInfo (&sysinfo_cache);
- syspage_mask = sysinfo_cache.dwPageSize - 1;
-
- /* Cache os info. */
- osinfo_cache.dwOSVersionInfoSize = sizeof (OSVERSIONINFO);
- GetVersionEx (&osinfo_cache);
-
- w32_build_number = osinfo_cache.dwBuildNumber;
- if (os_subtype == OS_WIN95)
- w32_build_number &= 0xffff;
-}
+#define RVA_TO_PTR(rva) ((unsigned char *)((DWORD_PTR)(rva) + (DWORD_PTR)GetModuleHandle (NULL)))
/* Emulate getpagesize. */
int
@@ -98,7 +44,7 @@ PIMAGE_SECTION_HEADER preload_heap_section;
unsigned char *data_region_base = NULL;
unsigned char *data_region_end = NULL;
unsigned char *real_data_region_end = NULL;
-unsigned long reserved_heap_size = 0;
+size_t reserved_heap_size = 0;
/* The start of the data segment. */
unsigned char *
@@ -114,7 +60,7 @@ get_data_end (void)
return data_region_end;
}
-#if !defined (USE_LISP_UNION_TYPE) && !defined (USE_LSB_TAG)
+#if !USE_LSB_TAG
static char *
allocate_heap (void)
{
@@ -122,16 +68,20 @@ allocate_heap (void)
the preload heap section up to the usable address limit. Since GNU
malloc can handle gaps in the memory it gets from sbrk, we can
simply set the sbrk pointer to the base of the new heap region. */
- unsigned long base =
+ DWORD_PTR base =
ROUND_UP ((RVA_TO_PTR (preload_heap_section->VirtualAddress)
+ preload_heap_section->Misc.VirtualSize),
get_allocation_unit ());
- unsigned long end = 1 << VALBITS; /* 256MB */
+ DWORD_PTR end = ((unsigned __int64)1) << VALBITS; /* 256MB */
void *ptr = NULL;
while (!ptr && (base < end))
{
+#ifdef _WIN64
+ reserved_heap_size = min(end - base, 0x4000000000i64); /* Limit to 256Gb */
+#else
reserved_heap_size = end - base;
+#endif
ptr = VirtualAlloc ((void *) base,
get_reserved_heap_size (),
MEM_RESERVE,
@@ -141,11 +91,15 @@ allocate_heap (void)
return ptr;
}
-#else /* USE_LISP_UNION_TYPE || USE_LSB_TAG */
+#else /* USE_LSB_TAG */
static char *
allocate_heap (void)
{
- unsigned long size = 0x80000000; /* start by asking for 2GB */
+#ifdef _WIN64
+ size_t size = 0x4000000000i64; /* start by asking for 32GB */
+#else
+ size_t size = 0x80000000; /* start by asking for 2GB */
+#endif
void *ptr = NULL;
while (!ptr && size > 0x00100000)
@@ -160,24 +114,24 @@ allocate_heap (void)
return ptr;
}
-#endif /* USE_LISP_UNION_TYPE || USE_LSB_TAG */
+#endif /* USE_LSB_TAG */
/* Emulate Unix sbrk. Note that ralloc.c expects the return value to
be the address of the _start_ (not end) of the new block in case of
success, and zero (not -1) in case of failure. */
void *
-sbrk (unsigned long increment)
+sbrk (ptrdiff_t increment)
{
void *result;
- long size = (long) increment;
+ ptrdiff_t size = increment;
result = data_region_end;
/* If size is negative, shrink the heap by decommitting pages. */
if (size < 0)
{
- int new_size;
+ ptrdiff_t new_size;
unsigned char *new_data_region_end;
size = -size;
@@ -190,7 +144,7 @@ sbrk (unsigned long increment)
partial deallocation [cga]. */
new_data_region_end = (data_region_end - size);
new_data_region_end = (unsigned char *)
- ((long) (new_data_region_end + syspage_mask) & ~syspage_mask);
+ ((DWORD_PTR) (new_data_region_end + syspage_mask) & ~syspage_mask);
new_size = real_data_region_end - new_data_region_end;
real_data_region_end = new_data_region_end;
if (new_size > 0)
@@ -221,7 +175,7 @@ sbrk (unsigned long increment)
/* We really only commit full pages, so record where
the real end of committed memory is [cga]. */
real_data_region_end = (unsigned char *)
- ((long) (data_region_end + syspage_mask) & ~syspage_mask);
+ ((DWORD_PTR) (data_region_end + syspage_mask) & ~syspage_mask);
}
return result;
@@ -246,7 +200,7 @@ init_heap (void)
PIMAGE_NT_HEADERS nt_header;
dos_header = (PIMAGE_DOS_HEADER) RVA_TO_PTR (0);
- nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) +
+ nt_header = (PIMAGE_NT_HEADERS) (((DWORD_PTR) dos_header) +
dos_header->e_lfanew);
preload_heap_section = find_section ("EMHEAP", nt_header);
@@ -259,10 +213,10 @@ init_heap (void)
exit (1);
}
-#if !defined (USE_LISP_UNION_TYPE) && !defined (USE_LSB_TAG)
+#if !USE_LSB_TAG
/* Ensure that the addresses don't use the upper tag bits since
the Lisp type goes there. */
- if (((unsigned long) data_region_base & ~VALMASK) != 0)
+ if (((DWORD_PTR) data_region_base & ~VALMASK) != 0)
{
printf ("Error: The heap was allocated in upper memory.\n");
exit (1);
@@ -285,38 +239,14 @@ init_heap (void)
/* Round the heap up to the given alignment. */
void
-round_heap (unsigned long align)
+round_heap (size_t align)
{
- unsigned long needs_to_be;
- unsigned long need_to_alloc;
+ DWORD_PTR needs_to_be;
+ DWORD_PTR need_to_alloc;
- needs_to_be = (unsigned long) ROUND_UP (get_heap_end (), align);
- need_to_alloc = needs_to_be - (unsigned long) get_heap_end ();
+ needs_to_be = (DWORD_PTR) ROUND_UP (get_heap_end (), align);
+ need_to_alloc = needs_to_be - (DWORD_PTR) get_heap_end ();
if (need_to_alloc)
sbrk (need_to_alloc);
}
-
-#if (_MSC_VER >= 1000 && _MSC_VER < 1300 && !defined (USE_CRT_DLL))
-
-/* MSVC 4.2 invokes these functions from mainCRTStartup to initialize
- a heap via HeapCreate. They are normally defined by the runtime,
- but we override them here so that the unnecessary HeapCreate call
- is not performed. */
-
-int __cdecl
-_heap_init (void)
-{
- /* Stepping through the assembly indicates that mainCRTStartup is
- expecting a nonzero success return value. */
- return 1;
-}
-
-void __cdecl
-_heap_term (void)
-{
- return;
-}
-
-#endif
-
diff --git a/src/w32heap.h b/src/w32heap.h
index e75bfcf36ec..1630864875f 100644
--- a/src/w32heap.h
+++ b/src/w32heap.h
@@ -1,5 +1,5 @@
/* Heap management routines (including unexec) for GNU Emacs on Windows NT.
- Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -24,9 +24,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
#include <windows.h>
-#define ROUND_UP(p, align) (((DWORD)(p) + (align)-1) & ~((align)-1))
-#define ROUND_DOWN(p, align) ((DWORD)(p) & ~((align)-1))
-
/*
* Heap related stuff.
*/
@@ -34,40 +31,20 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
#define get_committed_heap_size() (get_data_end () - get_data_start ())
#define get_heap_start() get_data_start ()
#define get_heap_end() get_data_end ()
-#define get_page_size() sysinfo_cache.dwPageSize
-#define get_allocation_unit() sysinfo_cache.dwAllocationGranularity
-#define get_processor_type() sysinfo_cache.dwProcessorType
-#define get_w32_major_version() w32_major_version
-#define get_w32_minor_version() w32_minor_version
extern unsigned char *get_data_start (void);
extern unsigned char *get_data_end (void);
-extern unsigned long reserved_heap_size;
-extern SYSTEM_INFO sysinfo_cache;
-extern OSVERSIONINFO osinfo_cache;
+extern size_t reserved_heap_size;
extern BOOL using_dynamic_heap;
-extern int w32_major_version;
-extern int w32_minor_version;
-extern int w32_build_number;
-
-enum {
- OS_WIN95 = 1,
- OS_NT
-};
-
-extern int os_subtype;
/* Emulation of Unix sbrk(). */
-extern void *sbrk (unsigned long size);
+extern void *sbrk (ptrdiff_t size);
/* Initialize heap structures for sbrk on startup. */
extern void init_heap (void);
/* Round the heap to this size. */
-extern void round_heap (unsigned long size);
-
-/* Cache system info, e.g., the NT page size. */
-extern void cache_system_info (void);
+extern void round_heap (size_t size);
/* ----------------------------------------------------------------- */
/* Useful routines for manipulating memory-mapped files. */
@@ -89,7 +66,6 @@ IMAGE_SECTION_HEADER * find_section (char * name, IMAGE_NT_HEADERS * nt_header);
/* Return pointer to section header for section containing the given
relative virtual address. */
-IMAGE_SECTION_HEADER * rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header);
+IMAGE_SECTION_HEADER * rva_to_section (DWORD_PTR rva, IMAGE_NT_HEADERS * nt_header);
#endif /* NTHEAP_H_ */
-
diff --git a/src/w32inevt.c b/src/w32inevt.c
index fddde61663f..899a6fb89bf 100644
--- a/src/w32inevt.c
+++ b/src/w32inevt.c
@@ -1,5 +1,5 @@
-/* Input event support for Emacs on the Microsoft W32 API.
- Copyright (C) 1992-1993, 1995, 2001-2011 Free Software Foundation, Inc.
+/* Input event support for Emacs on the Microsoft Windows API.
+ Copyright (C) 1992-1993, 1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -25,7 +25,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
#include <windows.h>
-#include <setjmp.h>
#ifndef MOUSE_MOVED
#define MOUSE_MOVED 1
@@ -35,10 +34,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "keyboard.h"
#include "frame.h"
#include "dispextern.h"
+#include "window.h"
#include "blockinput.h"
#include "termhooks.h"
+#include "termchar.h"
#include "w32heap.h"
#include "w32term.h"
+#include "w32inevt.h"
/* stdin, from w32console.c */
extern HANDLE keyboard_handle;
@@ -59,6 +61,18 @@ static INPUT_RECORD *queue_ptr = event_queue, *queue_end = event_queue;
/* Temporarily store lead byte of DBCS input sequences. */
static char dbcs_lead = 0;
+static inline BOOL
+w32_read_console_input (HANDLE h, INPUT_RECORD *rec, DWORD recsize,
+ DWORD *waiting)
+{
+ return (w32_console_unicode_input
+ ? ReadConsoleInputW (h, rec, recsize, waiting)
+ : ReadConsoleInputA (h, rec, recsize, waiting));
+}
+
+/* Set by w32_console_toggle_lock_key. */
+int faked_key;
+
static int
fill_queue (BOOL block)
{
@@ -78,8 +92,8 @@ fill_queue (BOOL block)
return 0;
}
- rc = ReadConsoleInput (keyboard_handle, event_queue, EVENT_QUEUE_SIZE,
- &events_waiting);
+ rc = w32_read_console_input (keyboard_handle, event_queue, EVENT_QUEUE_SIZE,
+ &events_waiting);
if (!rc)
return -1;
queue_ptr = event_queue;
@@ -99,67 +113,7 @@ get_frame (void)
/* Translate console modifiers to emacs modifiers.
German keyboard support (Kai Morgan Zeise 2/18/95). */
-int
-w32_kbd_mods_to_emacs (DWORD mods, WORD key)
-{
- int retval = 0;
-
- /* If we recognize right-alt and left-ctrl as AltGr, and it has been
- pressed, first remove those modifiers. */
- if (!NILP (Vw32_recognize_altgr)
- && (mods & (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
- == (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED))
- mods &= ~ (RIGHT_ALT_PRESSED | LEFT_CTRL_PRESSED);
-
- if (mods & (RIGHT_ALT_PRESSED | LEFT_ALT_PRESSED))
- retval = ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier);
- if (mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
- {
- retval |= ctrl_modifier;
- if ((mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
- == (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED))
- retval |= meta_modifier;
- }
-
- if (mods & LEFT_WIN_PRESSED)
- retval |= w32_key_to_modifier (VK_LWIN);
- if (mods & RIGHT_WIN_PRESSED)
- retval |= w32_key_to_modifier (VK_RWIN);
- if (mods & APPS_PRESSED)
- retval |= w32_key_to_modifier (VK_APPS);
- if (mods & SCROLLLOCK_ON)
- retval |= w32_key_to_modifier (VK_SCROLL);
-
- /* Just in case someone wanted the original behavior, make it
- optional by setting w32-capslock-is-shiftlock to t. */
- if (NILP (Vw32_capslock_is_shiftlock)
- /* Keys that should _not_ be affected by CapsLock. */
- && ( (key == VK_BACK)
- || (key == VK_TAB)
- || (key == VK_CLEAR)
- || (key == VK_RETURN)
- || (key == VK_ESCAPE)
- || ((key >= VK_SPACE) && (key <= VK_HELP))
- || ((key >= VK_NUMPAD0) && (key <= VK_F24))
- || ((key >= VK_NUMPAD_CLEAR) && (key <= VK_NUMPAD_DELETE))
- ))
- {
- /* Only consider shift state. */
- if ((mods & SHIFT_PRESSED) != 0)
- retval |= shift_modifier;
- }
- else
- {
- /* Ignore CapsLock state if not enabled. */
- if (NILP (Vw32_enable_caps_lock))
- mods &= ~CAPSLOCK_ON;
- if ((mods & (SHIFT_PRESSED | CAPSLOCK_ON)) != 0)
- retval |= shift_modifier;
- }
-
- return retval;
-}
#if 0
/* Return nonzero if the virtual key is a dead key. */
@@ -173,92 +127,10 @@ is_dead_key (int wparam)
}
#endif
-/* The return code indicates key code size. */
-int
-w32_kbd_patch_key (KEY_EVENT_RECORD *event)
-{
- unsigned int key_code = event->wVirtualKeyCode;
- unsigned int mods = event->dwControlKeyState;
- BYTE keystate[256];
- static BYTE ansi_code[4];
- static int isdead = 0;
-
- if (isdead == 2)
- {
- event->uChar.AsciiChar = ansi_code[2];
- isdead = 0;
- return 1;
- }
- if (event->uChar.AsciiChar != 0)
- return 1;
-
- memset (keystate, 0, sizeof (keystate));
- keystate[key_code] = 0x80;
- if (mods & SHIFT_PRESSED)
- keystate[VK_SHIFT] = 0x80;
- if (mods & CAPSLOCK_ON)
- keystate[VK_CAPITAL] = 1;
- /* If we recognize right-alt and left-ctrl as AltGr, set the key
- states accordingly before invoking ToAscii. */
- if (!NILP (Vw32_recognize_altgr)
- && (mods & LEFT_CTRL_PRESSED) && (mods & RIGHT_ALT_PRESSED))
- {
- keystate[VK_CONTROL] = 0x80;
- keystate[VK_LCONTROL] = 0x80;
- keystate[VK_MENU] = 0x80;
- keystate[VK_RMENU] = 0x80;
- }
-
-#if 0
- /* Because of an OS bug, ToAscii corrupts the stack when called to
- convert a dead key in console mode on NT4. Unfortunately, trying
- to check for dead keys using MapVirtualKey doesn't work either -
- these functions apparently use internal information about keyboard
- layout which doesn't get properly updated in console programs when
- changing layout (though apparently it gets partly updated,
- otherwise ToAscii wouldn't crash). */
- if (is_dead_key (event->wVirtualKeyCode))
- return 0;
-#endif
+/* The return code indicates key code size. cpID is the codepage to
+ use for translation to Unicode; -1 means use the current console
+ input codepage. */
- /* On NT, call ToUnicode instead and then convert to the current
- locale's default codepage. */
- if (os_subtype == OS_NT)
- {
- WCHAR buf[128];
-
- isdead = ToUnicode (event->wVirtualKeyCode, event->wVirtualScanCode,
- keystate, buf, 128, 0);
- if (isdead > 0)
- {
- char cp[20];
- int cpId;
-
- event->uChar.UnicodeChar = buf[isdead - 1];
-
- GetLocaleInfo (GetThreadLocale (),
- LOCALE_IDEFAULTANSICODEPAGE, cp, 20);
- cpId = atoi (cp);
- isdead = WideCharToMultiByte (cpId, 0, buf, isdead,
- ansi_code, 4, NULL, NULL);
- }
- else
- isdead = 0;
- }
- else
- {
- isdead = ToAscii (event->wVirtualKeyCode, event->wVirtualScanCode,
- keystate, (LPWORD) ansi_code, 0);
- }
-
- if (isdead == 0)
- return 0;
- event->uChar.AsciiChar = ansi_code[0];
- return isdead;
-}
-
-
-static int faked_key = 0;
/* return code -1 means that event_queue_ptr won't be incremented.
In other word, this event makes two key codes. (by himi) */
@@ -435,7 +307,7 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead)
base character (ie. translating the base key plus shift
modifier). */
else if (event->uChar.AsciiChar == 0)
- w32_kbd_patch_key (event);
+ w32_kbd_patch_key (event, -1);
}
if (event->uChar.AsciiChar == 0)
@@ -445,26 +317,34 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead)
}
else if (event->uChar.AsciiChar > 0)
{
+ /* Pure ASCII characters < 128. */
emacs_ev->kind = ASCII_KEYSTROKE_EVENT;
emacs_ev->code = event->uChar.AsciiChar;
}
- else if (event->uChar.UnicodeChar > 0)
+ else if (event->uChar.UnicodeChar > 0
+ && w32_console_unicode_input)
{
+ /* Unicode codepoint; only valid if we are using Unicode
+ console input mode. */
emacs_ev->kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT;
emacs_ev->code = event->uChar.UnicodeChar;
}
else
{
- /* Fallback for non-Unicode versions of Windows. */
+ /* Fallback handling of non-ASCII characters for non-Unicode
+ versions of Windows, and for non-Unicode input on NT
+ family of Windows. Only characters in the current
+ console codepage are supported by this fallback. */
wchar_t code;
char dbcs[2];
- char cp[20];
int cpId;
- /* Get the codepage to interpret this key with. */
- GetLocaleInfo (GetThreadLocale (),
- LOCALE_IDEFAULTANSICODEPAGE, cp, 20);
- cpId = atoi (cp);
+ /* Get the current console input codepage to interpret this
+ key with. Note that the system defaults for the OEM
+ codepage could have been changed by calling SetConsoleCP
+ or w32-set-console-codepage, so using GetLocaleInfo to
+ get LOCALE_IDEFAULTCODEPAGE is not TRT here. */
+ cpId = GetConsoleCP ();
dbcs[0] = dbcs_lead;
dbcs[1] = event->uChar.AsciiChar;
@@ -499,6 +379,7 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead)
}
else
{
+ /* Function keys and other non-character keys. */
emacs_ev->kind = NON_ASCII_KEYSTROKE_EVENT;
emacs_ev->code = event->wVirtualKeyCode;
}
@@ -510,32 +391,6 @@ key_event (KEY_EVENT_RECORD *event, struct input_event *emacs_ev, int *isdead)
return 1;
}
-int
-w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state)
-{
- int cur_state = (GetKeyState (vk_code) & 1);
-
- if (NILP (new_state)
- || (NUMBERP (new_state)
- && ((XUINT (new_state)) & 1) != cur_state))
- {
- faked_key = vk_code;
-
- keybd_event ((BYTE) vk_code,
- (BYTE) MapVirtualKey (vk_code, 0),
- KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
- keybd_event ((BYTE) vk_code,
- (BYTE) MapVirtualKey (vk_code, 0),
- KEYEVENTF_EXTENDEDKEY | 0, 0);
- keybd_event ((BYTE) vk_code,
- (BYTE) MapVirtualKey (vk_code, 0),
- KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
- cur_state = !cur_state;
- }
-
- return cur_state;
-}
-
/* Mouse position hook. */
void
w32_console_mouse_position (FRAME_PTR *f,
@@ -546,7 +401,7 @@ w32_console_mouse_position (FRAME_PTR *f,
Lisp_Object *y,
Time *time)
{
- BLOCK_INPUT;
+ block_input ();
insist = insist;
@@ -559,14 +414,14 @@ w32_console_mouse_position (FRAME_PTR *f,
XSETINT (*y, movement_pos.Y);
*time = movement_time;
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Remember mouse motion and notify emacs. */
static void
mouse_moved_to (int x, int y)
{
- /* If we're in the same place, ignore it */
+ /* If we're in the same place, ignore it. */
if (x != movement_pos.X || y != movement_pos.Y)
{
SELECTED_FRAME ()->mouse_moved = 1;
@@ -599,14 +454,63 @@ do_mouse_event (MOUSE_EVENT_RECORD *event,
struct input_event *emacs_ev)
{
static DWORD button_state = 0;
+ static Lisp_Object last_mouse_window;
DWORD but_change, mask;
int i;
if (event->dwEventFlags == MOUSE_MOVED)
{
- /* For movement events we just note that the mouse has moved
- so that emacs will generate drag events. */
- mouse_moved_to (event->dwMousePosition.X, event->dwMousePosition.Y);
+ FRAME_PTR f = SELECTED_FRAME ();
+ Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
+ int mx = event->dwMousePosition.X, my = event->dwMousePosition.Y;
+
+ mouse_moved_to (mx, my);
+
+ if (f->mouse_moved)
+ {
+ if (hlinfo->mouse_face_hidden)
+ {
+ hlinfo->mouse_face_hidden = 0;
+ clear_mouse_face (hlinfo);
+ }
+
+ /* Generate SELECT_WINDOW_EVENTs when needed. */
+ if (!NILP (Vmouse_autoselect_window))
+ {
+ Lisp_Object mouse_window = window_from_coordinates (f, mx, my,
+ 0, 0);
+ /* A window will be selected only when it is not
+ selected now, and the last mouse movement event was
+ not in it. A minibuffer window will be selected iff
+ it is active. */
+ if (WINDOWP (mouse_window)
+ && !EQ (mouse_window, last_mouse_window)
+ && !EQ (mouse_window, selected_window))
+ {
+ struct input_event event;
+
+ EVENT_INIT (event);
+ event.kind = SELECT_WINDOW_EVENT;
+ event.frame_or_window = mouse_window;
+ event.arg = Qnil;
+ event.timestamp = movement_time;
+ kbd_buffer_store_event (&event);
+ }
+ last_mouse_window = mouse_window;
+ }
+ else
+ last_mouse_window = Qnil;
+
+ previous_help_echo_string = help_echo_string;
+ help_echo_string = help_echo_object = help_echo_window = Qnil;
+ help_echo_pos = -1;
+ note_mouse_highlight (f, mx, my);
+ /* If the contents of the global variable help_echo has
+ changed (inside note_mouse_highlight), generate a HELP_EVENT. */
+ if (!NILP (help_echo_string) || !NILP (previous_help_echo_string))
+ gen_help_event (help_echo_string, selected_frame, help_echo_window,
+ help_echo_object, help_echo_pos);
+ }
return 0;
}
@@ -672,22 +576,46 @@ maybe_generate_resize_event (void)
0, 0, 0);
}
+/* Here's an overview of how Emacs input works in non-GUI sessions on
+ MS-Windows. (For description of the GUI input, see the commentary
+ before w32_msg_pump in w32fns.c.)
+
+ When Emacs is idle, it loops inside wait_reading_process_output,
+ calling pselect periodically to check whether any input is
+ available. On Windows, pselect is redirected to sys_select, which
+ uses MsgWaitForMultipleObjects to wait for input, either from the
+ keyboard or from any of the Emacs subprocesses. In addition,
+ MsgWaitForMultipleObjects wakes up when some Windows message is
+ posted to the input queue of the Emacs's main thread (which is the
+ thread in which sys_select runs).
+
+ When the Emacs's console window has focus, Windows sends input
+ events that originate from the keyboard or the mouse; these events
+ wake up MsgWaitForMultipleObjects, which reports that input is
+ available. Emacs then calls w32_console_read_socket, below, to
+ read the input. w32_console_read_socket uses
+ GetNumberOfConsoleInputEvents and ReadConsoleInput to peek at and
+ read the console input events.
+
+ One type of non-keyboard input event that gets reported as input
+ available is due to the Emacs's console window receiving focus.
+ When that happens, Emacs gets the FOCUS_EVENT event and sys_select
+ reports some input; however, w32_console_read_socket ignores such
+ events when called to read them.
+
+ Note that any other Windows message sent to the main thread will
+ also wake up MsgWaitForMultipleObjects. These messages get
+ immediately dispatched to their destinations by calling
+ drain_message_queue. */
+
int
w32_console_read_socket (struct terminal *terminal,
- int expected,
struct input_event *hold_quit)
{
- int nev, ret = 0, add;
+ int nev, add;
int isdead;
- if (interrupt_input_blocked)
- {
- interrupt_input_pending = 1;
- return -1;
- }
-
- interrupt_input_pending = 0;
- BLOCK_INPUT;
+ block_input ();
for (;;)
{
@@ -697,8 +625,7 @@ w32_console_read_socket (struct terminal *terminal,
/* If nev == -1, there was some kind of error
If nev == 0 then waitp must be zero and no events were available
so return. */
- UNBLOCK_INPUT;
- return nev;
+ break;
}
while (nev > 0)
@@ -742,9 +669,6 @@ w32_console_read_socket (struct terminal *terminal,
queue_ptr++;
nev--;
}
-
- if (ret > 0 || expected == 0)
- break;
}
/* We don't get told about changes in the window size (only the buffer
@@ -753,6 +677,6 @@ w32_console_read_socket (struct terminal *terminal,
if (!w32_use_full_screen_buffer)
maybe_generate_resize_event ();
- UNBLOCK_INPUT;
- return ret;
+ unblock_input ();
+ return nev;
}
diff --git a/src/w32inevt.h b/src/w32inevt.h
index 9ca52508151..319688b877b 100644
--- a/src/w32inevt.h
+++ b/src/w32inevt.h
@@ -1,5 +1,5 @@
-/* Input routines for GNU Emacs on the Microsoft W32 API.
- Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+/* Input routines for GNU Emacs on the Microsoft Windows API.
+ Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,7 +19,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef EMACS_W32INEVT_H
#define EMACS_W32INEVT_H
-extern int w32_console_read_socket (struct terminal *term, int numchars,
+extern int w32_console_unicode_input;
+
+extern int w32_console_read_socket (struct terminal *term,
struct input_event *hold_quit);
extern void w32_console_mouse_position (FRAME_PTR *f, int insist,
Lisp_Object *bar_window,
@@ -28,4 +30,3 @@ extern void w32_console_mouse_position (FRAME_PTR *f, int insist,
unsigned long *time);
#endif /* EMACS_W32INEVT_H */
-
diff --git a/src/w32menu.c b/src/w32menu.c
index 9b2d014cd58..84fb1bdc71e 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -1,5 +1,5 @@
-/* Menu support for GNU Emacs on the Microsoft W32 API.
- Copyright (C) 1986, 1988, 1993-1994, 1996, 1998-1999, 2001-2011
+/* Menu support for GNU Emacs on the Microsoft Windows API.
+ Copyright (C) 1986, 1988, 1993-1994, 1996, 1998-1999, 2001-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,7 +21,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <signal.h>
#include <stdio.h>
-#include <mbstring.h>
#include <setjmp.h>
#include "lisp.h"
@@ -31,6 +30,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "termhooks.h"
#include "window.h"
#include "blockinput.h"
+#include "character.h"
#include "buffer.h"
#include "charset.h"
#include "coding.h"
@@ -40,6 +40,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
if this is not done before the other system files. */
#include "w32term.h"
+/* Cygwin does not support the multibyte string functions declared in
+ * mbstring.h below --- but that's okay: because Cygwin is
+ * UNICODE-only, we don't need to use these functions anyway. */
+
+#ifndef NTGUI_UNICODE
+#include <mbstring.h>
+#endif /* !NTGUI_UNICODE */
+
/* Load sys/types.h if not already loaded.
In some systems loading it twice is suicidal. */
#ifndef makedev
@@ -48,6 +56,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dispextern.h"
+#include "w32common.h" /* for osinfo_cache */
+
#undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
#ifndef TRUE
@@ -76,14 +86,21 @@ typedef int (WINAPI * MessageBoxW_Proc) (
IN WCHAR *caption,
IN UINT type);
+#ifdef NTGUI_UNICODE
+#define get_menu_item_info GetMenuItemInfoA
+#define set_menu_item_info SetMenuItemInfoA
+#define unicode_append_menu AppendMenuW
+#define unicode_message_box MessageBoxW
+#else /* !NTGUI_UNICODE */
GetMenuItemInfoA_Proc get_menu_item_info = NULL;
SetMenuItemInfoA_Proc set_menu_item_info = NULL;
AppendMenuW_Proc unicode_append_menu = NULL;
MessageBoxW_Proc unicode_message_box = NULL;
+#endif /* NTGUI_UNICODE */
Lisp_Object Qdebug_on_next_call;
-void set_frame_menubar (FRAME_PTR, int, int);
+void set_frame_menubar (FRAME_PTR, bool, bool);
#ifdef HAVE_DIALOGS
static Lisp_Object w32_dialog_show (FRAME_PTR, int, Lisp_Object, char**);
@@ -96,17 +113,7 @@ static void utf8to16 (unsigned char *, int, WCHAR *);
static int fill_in_menu (HMENU, widget_value *);
void w32_free_menu_strings (HWND);
-
-/* This is set nonzero after the user activates the menu bar, and set
- to zero again after the menu bars are redisplayed by prepare_menu_bar.
- While it is nonzero, all calls to set_frame_menubar go deep.
-
- I don't understand why this is needed, but it does seem to be
- needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
-
-int pending_menu_activation;
-
#ifdef HAVE_MENUS
DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
@@ -159,13 +166,12 @@ otherwise it is "Question". */)
}
else if (CONSP (position))
{
- Lisp_Object tem;
- tem = Fcar (position);
+ Lisp_Object tem = XCAR (position);
if (CONSP (tem))
- window = Fcar (Fcdr (position));
+ window = Fcar (XCDR (position));
else
{
- tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
+ tem = Fcar (XCDR (position)); /* EVENT_START (position) */
window = Fcar (tem); /* POSN_WINDOW (tem) */
}
}
@@ -220,9 +226,9 @@ otherwise it is "Question". */)
list_of_panes (Fcons (contents, Qnil));
/* Display them in a dialog box. */
- BLOCK_INPUT;
+ block_input ();
selection = w32_dialog_show (f, 0, title, header, &error_name);
- UNBLOCK_INPUT;
+ unblock_input ();
discard_menu_items ();
FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
@@ -274,7 +280,7 @@ menubar_selection_callback (FRAME_PTR f, void * client_data)
if (!f)
return;
entry = Qnil;
- subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
+ subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * word_size);
vector = f->menu_bar_vector;
prefix = Qnil;
i = 0;
@@ -355,7 +361,7 @@ menubar_selection_callback (FRAME_PTR f, void * client_data)
it is set the first time this is called, from initialize_frame_menubar. */
void
-set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
+set_frame_menubar (FRAME_PTR f, bool first_time, bool deep_p)
{
HMENU menubar_widget = f->output_data.w32->menubar_widget;
Lisp_Object items;
@@ -372,8 +378,6 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
if (! menubar_widget)
deep_p = 1;
- else if (pending_menu_activation && !deep_p)
- deep_p = 1;
if (deep_p)
{
@@ -381,11 +385,11 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
struct buffer *prev = current_buffer;
Lisp_Object buffer;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
int previous_menu_items_used = f->menu_bar_items_used;
Lisp_Object *previous_items
= (Lisp_Object *) alloca (previous_menu_items_used
- * sizeof (Lisp_Object));
+ * word_size);
/* If we are making a new widget, its contents are empty,
do always reinitialize them. */
@@ -411,14 +415,14 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
/* Run the hooks. */
safe_run_hooks (Qactivate_menubar_hook);
safe_run_hooks (Qmenu_bar_update_hook);
- FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
+ fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
items = FRAME_MENU_BAR_ITEMS (f);
/* Save the frame's previous menu bar contents data. */
if (previous_menu_items_used)
memcpy (previous_items, XVECTOR (f->menu_bar_vector)->contents,
- previous_menu_items_used * sizeof (Lisp_Object));
+ previous_menu_items_used * word_size);
/* Fill in menu_items with the current menu bar contents.
This can evaluate Lisp code. */
@@ -498,7 +502,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
return;
}
- f->menu_bar_vector = menu_items;
+ fset_menu_bar_vector (f, menu_items);
f->menu_bar_items_used = menu_items_used;
/* This undoes save_menu_items. */
@@ -570,7 +574,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
/* Create or update the menu bar widget. */
- BLOCK_INPUT;
+ block_input ();
if (menubar_widget)
{
@@ -600,7 +604,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Called from Fx_create_frame to create the initial menubar of a frame
@@ -613,7 +617,7 @@ initialize_frame_menubar (FRAME_PTR f)
{
/* This function is called before the first chance to redisplay
the frame. It has to be, so the frame will have the right size. */
- FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
+ fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
set_frame_menubar (f, 1, 1);
}
@@ -623,7 +627,7 @@ initialize_frame_menubar (FRAME_PTR f)
void
free_frame_menubar (FRAME_PTR f)
{
- BLOCK_INPUT;
+ block_input ();
{
HMENU old = GetMenu (FRAME_W32_WINDOW (f));
@@ -632,7 +636,7 @@ free_frame_menubar (FRAME_PTR f)
DestroyMenu (old);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -663,7 +667,7 @@ w32_menu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
widget_value **submenu_stack
= (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
Lisp_Object *subprefix_stack
- = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
+ = (Lisp_Object *) alloca (menu_items_used * word_size);
int submenu_depth = 0;
int first_pane;
@@ -818,7 +822,7 @@ w32_menu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
else if (EQ (type, QCradio))
wv->button_type = BUTTON_TYPE_RADIO;
else
- abort ();
+ emacs_abort ();
wv->selected = !NILP (selected);
@@ -1060,7 +1064,7 @@ w32_dialog_show (FRAME_PTR f, int keymaps,
if (!NILP (descrip))
wv->key = SSDATA (descrip);
wv->value = SSDATA (item_name);
- wv->call_data = (void *) &AREF (menu_items, i);
+ wv->call_data = aref_addr (menu_items, i);
wv->enabled = !NILP (enable);
wv->help = Qnil;
prev_wv = wv;
@@ -1173,18 +1177,23 @@ w32_dialog_show (FRAME_PTR f, int keymaps,
static int
is_simple_dialog (Lisp_Object contents)
{
- Lisp_Object options = XCDR (contents);
+ Lisp_Object options;
Lisp_Object name, yes, no, other;
+ if (!CONSP (contents))
+ return 0;
+ options = XCDR (contents);
+
yes = build_string ("Yes");
no = build_string ("No");
if (!CONSP (options))
return 0;
- name = XCAR (XCAR (options));
- if (!CONSP (options))
+ name = XCAR (options);
+ if (!CONSP (name))
return 0;
+ name = XCAR (name);
if (!NILP (Fstring_equal (name, yes)))
other = no;
@@ -1197,7 +1206,10 @@ is_simple_dialog (Lisp_Object contents)
if (!CONSP (options))
return 0;
- name = XCAR (XCAR (options));
+ name = XCAR (options);
+ if (!CONSP (name))
+ return 0;
+ name = XCAR (name);
if (NILP (Fstring_equal (name, other)))
return 0;
@@ -1223,6 +1235,7 @@ simple_dialog_show (FRAME_PTR f, Lisp_Object contents, Lisp_Object header)
if (unicode_message_box)
{
WCHAR *text, *title;
+ USE_SAFE_ALLOCA;
if (STRINGP (temp))
{
@@ -1232,7 +1245,7 @@ simple_dialog_show (FRAME_PTR f, Lisp_Object contents, Lisp_Object header)
one utf16 word, so we cannot simply use the character
length of temp. */
int utf8_len = strlen (utf8_text);
- text = alloca ((utf8_len + 1) * sizeof (WCHAR));
+ text = SAFE_ALLOCA ((utf8_len + 1) * sizeof (WCHAR));
utf8to16 (utf8_text, utf8_len, text);
}
else
@@ -1252,6 +1265,7 @@ simple_dialog_show (FRAME_PTR f, Lisp_Object contents, Lisp_Object header)
}
answer = unicode_message_box (FRAME_W32_WINDOW (f), text, title, type);
+ SAFE_FREE ();
}
else
{
@@ -1358,6 +1372,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
char *out_string, *p, *q;
int return_value;
size_t nlen, orig_len;
+ USE_SAFE_ALLOCA;
if (menu_separator_name_p (wv->name))
{
@@ -1373,7 +1388,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
if (wv->key != NULL)
{
- out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
+ out_string = SAFE_ALLOCA (strlen (wv->name) + strlen (wv->key) + 2);
strcpy (out_string, wv->name);
strcat (out_string, "\t");
strcat (out_string, wv->key);
@@ -1393,6 +1408,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
nlen++;
}
}
+#ifndef NTGUI_UNICODE
else
{
/* If encoded with the system codepage, use multibyte string
@@ -1403,11 +1419,12 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
nlen++;
}
}
+#endif /* !NTGUI_UNICODE */
if (nlen > orig_len)
{
p = out_string;
- out_string = alloca (nlen + 1);
+ out_string = SAFE_ALLOCA (nlen + 1);
q = out_string;
while (*p)
{
@@ -1417,6 +1434,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
*q++ = *p;
*q++ = *p++;
}
+#ifndef NTGUI_UNICODE
else
{
if (_mbsnextc (p) == '&')
@@ -1428,6 +1446,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
p = _mbsinc (p);
q = _mbsinc (q);
}
+#endif /* !NTGUI_UNICODE */
}
*q = '\0';
}
@@ -1467,13 +1486,15 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
if (fuFlags & MF_OWNERDRAW)
utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
else
- utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
+ utf16_string = SAFE_ALLOCA ((utf8_len + 1) * sizeof (WCHAR));
utf8to16 (out_string, utf8_len, utf16_string);
return_value = unicode_append_menu (menu, fuFlags,
- item != NULL ? (UINT) item
- : (UINT) wv->call_data,
+ item != NULL ? (UINT_PTR) item
+ : (UINT_PTR) wv->call_data,
utf16_string);
+
+#ifndef NTGUI_UNICODE /* Fallback does not apply when always UNICODE */
if (!return_value)
{
/* On W9x/ME, Unicode menus are not supported, though AppendMenuW
@@ -1484,11 +1505,15 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
of minor importance compared with menus not working at all. */
return_value =
AppendMenu (menu, fuFlags,
- item != NULL ? (UINT) item: (UINT) wv->call_data,
+ item != NULL ? (UINT_PTR) item: (UINT_PTR) wv->call_data,
out_string);
- /* Don't use Unicode menus in future. */
- unicode_append_menu = NULL;
+ /* Don't use Unicode menus in future, unless this is Windows
+ NT or later, where a failure of AppendMenuW does NOT mean
+ Unicode menus are unsupported. */
+ if (osinfo_cache.dwPlatformId != VER_PLATFORM_WIN32_NT)
+ unicode_append_menu = NULL;
}
+#endif /* NTGUI_UNICODE */
if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
local_free (out_string);
@@ -1498,7 +1523,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
return_value =
AppendMenu (menu,
fuFlags,
- item != NULL ? (UINT) item : (UINT) wv->call_data,
+ item != NULL ? (UINT_PTR) item : (UINT_PTR) wv->call_data,
out_string );
}
@@ -1516,11 +1541,14 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
until it is ready to be displayed, since GC can happen while
menus are active. */
if (!NILP (wv->help))
-#ifdef USE_LISP_UNION_TYPE
- info.dwItemData = (DWORD) (wv->help).i;
-#else
- info.dwItemData = (DWORD) (wv->help);
-#endif
+ {
+ /* As of Jul-2012, w32api headers say that dwItemData
+ has DWORD type, but that's a bug: it should actually
+ be ULONG_PTR, which is correct for 32-bit and 64-bit
+ Windows alike. MSVC headers get it right; hopefully,
+ MinGW headers will, too. */
+ info.dwItemData = (ULONG_PTR) XLI (wv->help);
+ }
if (wv->button_type == BUTTON_TYPE_RADIO)
{
/* CheckMenuRadioItem allows us to differentiate TOGGLE and
@@ -1532,10 +1560,11 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item)
}
set_menu_item_info (menu,
- item != NULL ? (UINT) item : (UINT) wv->call_data,
+ item != NULL ? (UINT_PTR) item : (UINT_PTR) wv->call_data,
FALSE, &info);
}
}
+ SAFE_FREE ();
return return_value;
}
@@ -1594,12 +1623,7 @@ w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
info.fMask = MIIM_DATA;
get_menu_item_info (menu, item, FALSE, &info);
-#ifdef USE_LISP_UNION_TYPE
- help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
- : Qnil;
-#else
- help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
-#endif
+ help = info.dwItemData ? XIL (info.dwItemData) : Qnil;
}
/* Store the help echo in the keyboard buffer as the X toolkit
@@ -1709,10 +1733,12 @@ syms_of_w32menu (void)
void
globals_of_w32menu (void)
{
+#ifndef NTGUI_UNICODE
/* See if Get/SetMenuItemInfo functions are available. */
HMODULE user32 = GetModuleHandle ("user32.dll");
get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
unicode_message_box = (MessageBoxW_Proc) GetProcAddress (user32, "MessageBoxW");
+#endif /* !NTGUI_UNICODE */
}
diff --git a/src/w32proc.c b/src/w32proc.c
index 254a32503c4..9b111b40e36 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -1,5 +1,5 @@
-/* Process support for GNU Emacs on the Microsoft W32 API.
- Copyright (C) 1992, 1995, 1999-2011 Free Software Foundation, Inc.
+/* Process support for GNU Emacs on the Microsoft Windows API.
+ Copyright (C) 1992, 1995, 1999-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -24,11 +24,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <stdio.h>
#include <stdlib.h>
#include <errno.h>
+#include <ctype.h>
#include <io.h>
#include <fcntl.h>
#include <signal.h>
#include <sys/file.h>
-#include <setjmp.h>
/* must include CRT headers *before* config.h */
#include <config.h>
@@ -52,6 +52,7 @@ extern BOOL WINAPI IsValidLocale (LCID, DWORD);
#include "lisp.h"
#include "w32.h"
+#include "w32common.h"
#include "w32heap.h"
#include "systime.h"
#include "syswait.h"
@@ -63,53 +64,731 @@ extern BOOL WINAPI IsValidLocale (LCID, DWORD);
#define RVA_TO_PTR(var,section,filedata) \
((void *)((section)->PointerToRawData \
- + ((DWORD)(var) - (section)->VirtualAddress) \
+ + ((DWORD_PTR)(var) - (section)->VirtualAddress) \
+ (filedata).file_base))
Lisp_Object Qhigh, Qlow;
-#ifdef EMACSDEBUG
-void
-_DebPrint (const char *fmt, ...)
-{
- char buf[1024];
- va_list args;
-
- va_start (args, fmt);
- vsprintf (buf, fmt, args);
- va_end (args);
- OutputDebugString (buf);
-}
-#endif
-
-typedef void (_CALLBACK_ *signal_handler) (int);
-
/* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */
static signal_handler sig_handlers[NSIG];
-/* Fake signal implementation to record the SIGCHLD handler. */
+static sigset_t sig_mask;
+
+static CRITICAL_SECTION crit_sig;
+
+/* Improve on the CRT 'signal' implementation so that we could record
+ the SIGCHLD handler and fake interval timers. */
signal_handler
sys_signal (int sig, signal_handler handler)
{
signal_handler old;
- if (sig != SIGCHLD)
+ /* SIGCHLD is needed for supporting subprocesses, see sys_kill
+ below. SIGALRM and SIGPROF are used by setitimer. All the
+ others are the only ones supported by the MS runtime. */
+ if (!(sig == SIGCHLD || sig == SIGSEGV || sig == SIGILL
+ || sig == SIGFPE || sig == SIGABRT || sig == SIGTERM
+ || sig == SIGALRM || sig == SIGPROF))
{
errno = EINVAL;
return SIG_ERR;
}
old = sig_handlers[sig];
- sig_handlers[sig] = handler;
+ /* SIGABRT is treated specially because w32.c installs term_ntproc
+ as its handler, so we don't want to override that afterwards.
+ Aborting Emacs works specially anyway: either by calling
+ emacs_abort directly or through terminate_due_to_signal, which
+ calls emacs_abort through emacs_raise. */
+ if (!(sig == SIGABRT && old == term_ntproc))
+ {
+ sig_handlers[sig] = handler;
+ if (!(sig == SIGCHLD || sig == SIGALRM || sig == SIGPROF))
+ signal (sig, handler);
+ }
return old;
}
+/* Emulate sigaction. */
+int
+sigaction (int sig, const struct sigaction *act, struct sigaction *oact)
+{
+ signal_handler old = SIG_DFL;
+ int retval = 0;
+
+ if (act)
+ old = sys_signal (sig, act->sa_handler);
+ else if (oact)
+ old = sig_handlers[sig];
+
+ if (old == SIG_ERR)
+ {
+ errno = EINVAL;
+ retval = -1;
+ }
+ if (oact)
+ {
+ oact->sa_handler = old;
+ oact->sa_flags = 0;
+ oact->sa_mask = empty_mask;
+ }
+ return retval;
+}
+
+/* Emulate signal sets and blocking of signals used by timers. */
+
+int
+sigemptyset (sigset_t *set)
+{
+ *set = 0;
+ return 0;
+}
+
+int
+sigaddset (sigset_t *set, int signo)
+{
+ if (!set)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ if (signo < 0 || signo >= NSIG)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+
+ *set |= (1U << signo);
+
+ return 0;
+}
+
+int
+sigfillset (sigset_t *set)
+{
+ if (!set)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+
+ *set = 0xFFFFFFFF;
+ return 0;
+}
+
+int
+sigprocmask (int how, const sigset_t *set, sigset_t *oset)
+{
+ if (!(how == SIG_BLOCK || how == SIG_UNBLOCK || how == SIG_SETMASK))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+
+ if (oset)
+ *oset = sig_mask;
+
+ if (!set)
+ return 0;
+
+ switch (how)
+ {
+ case SIG_BLOCK:
+ sig_mask |= *set;
+ break;
+ case SIG_SETMASK:
+ sig_mask = *set;
+ break;
+ case SIG_UNBLOCK:
+ /* FIXME: Catch signals that are blocked and reissue them when
+ they are unblocked. Important for SIGALRM and SIGPROF only. */
+ sig_mask &= ~(*set);
+ break;
+ }
+
+ return 0;
+}
+
+int
+pthread_sigmask (int how, const sigset_t *set, sigset_t *oset)
+{
+ if (sigprocmask (how, set, oset) == -1)
+ return EINVAL;
+ return 0;
+}
+
+int
+sigismember (const sigset_t *set, int signo)
+{
+ if (signo < 0 || signo >= NSIG)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ if (signo > sizeof (*set) * BITS_PER_CHAR)
+ emacs_abort ();
+
+ return (*set & (1U << signo)) != 0;
+}
+
+pid_t
+getpgrp (void)
+{
+ return getpid ();
+}
+
+pid_t
+tcgetpgrp (int fd)
+{
+ return getpid ();
+}
+
+int
+setpgid (pid_t pid, pid_t pgid)
+{
+ return 0;
+}
+
+pid_t
+setsid (void)
+{
+ return getpid ();
+}
+
+/* Emulations of interval timers.
+
+ Limitations: only ITIMER_REAL and ITIMER_PROF are supported.
+
+ Implementation: a separate thread is started for each timer type,
+ the thread calls the appropriate signal handler when the timer
+ expires, after stopping the thread which installed the timer. */
+
+struct itimer_data {
+ volatile ULONGLONG expire;
+ volatile ULONGLONG reload;
+ volatile int terminate;
+ int type;
+ HANDLE caller_thread;
+ HANDLE timer_thread;
+};
+
+static ULONGLONG ticks_now;
+static struct itimer_data real_itimer, prof_itimer;
+static ULONGLONG clocks_min;
+/* If non-zero, itimers are disabled. Used during shutdown, when we
+ delete the critical sections used by the timer threads. */
+static int disable_itimers;
+
+static CRITICAL_SECTION crit_real, crit_prof;
+
+/* GetThreadTimes is not available on Windows 9X and possibly also on 2K. */
+typedef BOOL (WINAPI *GetThreadTimes_Proc) (
+ HANDLE hThread,
+ LPFILETIME lpCreationTime,
+ LPFILETIME lpExitTime,
+ LPFILETIME lpKernelTime,
+ LPFILETIME lpUserTime);
+
+static GetThreadTimes_Proc s_pfn_Get_Thread_Times;
+
+#define MAX_SINGLE_SLEEP 30
+#define TIMER_TICKS_PER_SEC 1000
+
+/* Return a suitable time value, in 1-ms units, for THREAD, a handle
+ to a thread. If THREAD is NULL or an invalid handle, return the
+ current wall-clock time since January 1, 1601 (UTC). Otherwise,
+ return the sum of kernel and user times used by THREAD since it was
+ created, plus its creation time. */
+static ULONGLONG
+w32_get_timer_time (HANDLE thread)
+{
+ ULONGLONG retval;
+ int use_system_time = 1;
+ /* The functions below return times in 100-ns units. */
+ const int tscale = 10 * TIMER_TICKS_PER_SEC;
+
+ if (thread && thread != INVALID_HANDLE_VALUE
+ && s_pfn_Get_Thread_Times != NULL)
+ {
+ FILETIME creation_ftime, exit_ftime, kernel_ftime, user_ftime;
+ ULARGE_INTEGER temp_creation, temp_kernel, temp_user;
+
+ if (s_pfn_Get_Thread_Times (thread, &creation_ftime, &exit_ftime,
+ &kernel_ftime, &user_ftime))
+ {
+ use_system_time = 0;
+ temp_creation.LowPart = creation_ftime.dwLowDateTime;
+ temp_creation.HighPart = creation_ftime.dwHighDateTime;
+ temp_kernel.LowPart = kernel_ftime.dwLowDateTime;
+ temp_kernel.HighPart = kernel_ftime.dwHighDateTime;
+ temp_user.LowPart = user_ftime.dwLowDateTime;
+ temp_user.HighPart = user_ftime.dwHighDateTime;
+ retval =
+ temp_creation.QuadPart / tscale + temp_kernel.QuadPart / tscale
+ + temp_user.QuadPart / tscale;
+ }
+ else
+ DebPrint (("GetThreadTimes failed with error code %lu\n",
+ GetLastError ()));
+ }
+
+ if (use_system_time)
+ {
+ FILETIME current_ftime;
+ ULARGE_INTEGER temp;
+
+ GetSystemTimeAsFileTime (&current_ftime);
+
+ temp.LowPart = current_ftime.dwLowDateTime;
+ temp.HighPart = current_ftime.dwHighDateTime;
+
+ retval = temp.QuadPart / tscale;
+ }
+
+ return retval;
+}
+
+/* Thread function for a timer thread. */
+static DWORD WINAPI
+timer_loop (LPVOID arg)
+{
+ struct itimer_data *itimer = (struct itimer_data *)arg;
+ int which = itimer->type;
+ int sig = (which == ITIMER_REAL) ? SIGALRM : SIGPROF;
+ CRITICAL_SECTION *crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
+ const DWORD max_sleep = MAX_SINGLE_SLEEP * 1000 / TIMER_TICKS_PER_SEC;
+ HANDLE hth = (which == ITIMER_REAL) ? NULL : itimer->caller_thread;
+
+ while (1)
+ {
+ DWORD sleep_time;
+ signal_handler handler;
+ ULONGLONG now, expire, reload;
+
+ /* Load new values if requested by setitimer. */
+ EnterCriticalSection (crit);
+ expire = itimer->expire;
+ reload = itimer->reload;
+ LeaveCriticalSection (crit);
+ if (itimer->terminate)
+ return 0;
+
+ if (expire == 0)
+ {
+ /* We are idle. */
+ Sleep (max_sleep);
+ continue;
+ }
+
+ if (expire > (now = w32_get_timer_time (hth)))
+ sleep_time = expire - now;
+ else
+ sleep_time = 0;
+ /* Don't sleep too long at a time, to be able to see the
+ termination flag without too long a delay. */
+ while (sleep_time > max_sleep)
+ {
+ if (itimer->terminate)
+ return 0;
+ Sleep (max_sleep);
+ EnterCriticalSection (crit);
+ expire = itimer->expire;
+ LeaveCriticalSection (crit);
+ sleep_time =
+ (expire > (now = w32_get_timer_time (hth))) ? expire - now : 0;
+ }
+ if (itimer->terminate)
+ return 0;
+ if (sleep_time > 0)
+ {
+ Sleep (sleep_time * 1000 / TIMER_TICKS_PER_SEC);
+ /* Always sleep past the expiration time, to make sure we
+ never call the handler _before_ the expiration time,
+ always slightly after it. Sleep(5) makes sure we don't
+ hog the CPU by calling 'w32_get_timer_time' with high
+ frequency, and also let other threads work. */
+ while (w32_get_timer_time (hth) < expire)
+ Sleep (5);
+ }
+
+ EnterCriticalSection (crit);
+ expire = itimer->expire;
+ LeaveCriticalSection (crit);
+ if (expire == 0)
+ continue;
+
+ /* Time's up. */
+ handler = sig_handlers[sig];
+ if (!(handler == SIG_DFL || handler == SIG_IGN || handler == SIG_ERR)
+ /* FIXME: Don't ignore masked signals. Instead, record that
+ they happened and reissue them when the signal is
+ unblocked. */
+ && !sigismember (&sig_mask, sig)
+ /* Simulate masking of SIGALRM and SIGPROF when processing
+ fatal signals. */
+ && !fatal_error_in_progress
+ && itimer->caller_thread)
+ {
+ /* Simulate a signal delivered to the thread which installed
+ the timer, by suspending that thread while the handler
+ runs. */
+ HANDLE th = itimer->caller_thread;
+ DWORD result = SuspendThread (th);
+
+ if (result == (DWORD)-1)
+ return 2;
+
+ handler (sig);
+ ResumeThread (th);
+ }
+
+ /* Update expiration time and loop. */
+ EnterCriticalSection (crit);
+ expire = itimer->expire;
+ if (expire == 0)
+ {
+ LeaveCriticalSection (crit);
+ continue;
+ }
+ reload = itimer->reload;
+ if (reload > 0)
+ {
+ now = w32_get_timer_time (hth);
+ if (expire <= now)
+ {
+ ULONGLONG lag = now - expire;
+
+ /* If we missed some opportunities (presumably while
+ sleeping or while the signal handler ran), skip
+ them. */
+ if (lag > reload)
+ expire = now - (lag % reload);
+
+ expire += reload;
+ }
+ }
+ else
+ expire = 0; /* become idle */
+ itimer->expire = expire;
+ LeaveCriticalSection (crit);
+ }
+ return 0;
+}
+
+static void
+stop_timer_thread (int which)
+{
+ struct itimer_data *itimer =
+ (which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
+ int i;
+ DWORD err, exit_code = 255;
+ BOOL status;
+
+ /* Signal the thread that it should terminate. */
+ itimer->terminate = 1;
+
+ if (itimer->timer_thread == NULL)
+ return;
+
+ /* Wait for the timer thread to terminate voluntarily, then kill it
+ if it doesn't. This loop waits twice more than the maximum
+ amount of time a timer thread sleeps, see above. */
+ for (i = 0; i < MAX_SINGLE_SLEEP / 5; i++)
+ {
+ if (!((status = GetExitCodeThread (itimer->timer_thread, &exit_code))
+ && exit_code == STILL_ACTIVE))
+ break;
+ Sleep (10);
+ }
+ if ((status == FALSE && (err = GetLastError ()) == ERROR_INVALID_HANDLE)
+ || exit_code == STILL_ACTIVE)
+ {
+ if (!(status == FALSE && err == ERROR_INVALID_HANDLE))
+ TerminateThread (itimer->timer_thread, 0);
+ }
+
+ /* Clean up. */
+ CloseHandle (itimer->timer_thread);
+ itimer->timer_thread = NULL;
+ if (itimer->caller_thread)
+ {
+ CloseHandle (itimer->caller_thread);
+ itimer->caller_thread = NULL;
+ }
+}
+
+/* This is called at shutdown time from term_ntproc. */
+void
+term_timers (void)
+{
+ if (real_itimer.timer_thread)
+ stop_timer_thread (ITIMER_REAL);
+ if (prof_itimer.timer_thread)
+ stop_timer_thread (ITIMER_PROF);
+
+ /* We are going to delete the critical sections, so timers cannot
+ work after this. */
+ disable_itimers = 1;
+
+ DeleteCriticalSection (&crit_real);
+ DeleteCriticalSection (&crit_prof);
+ DeleteCriticalSection (&crit_sig);
+}
+
+/* This is called at initialization time from init_ntproc. */
+void
+init_timers (void)
+{
+ /* GetThreadTimes is not available on all versions of Windows, so
+ need to probe for its availability dynamically, and call it
+ through a pointer. */
+ s_pfn_Get_Thread_Times = NULL; /* in case dumped Emacs comes with a value */
+ if (os_subtype != OS_9X)
+ s_pfn_Get_Thread_Times =
+ (GetThreadTimes_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"),
+ "GetThreadTimes");
+
+ /* Make sure we start with zeroed out itimer structures, since
+ dumping may have left there traces of threads long dead. */
+ memset (&real_itimer, 0, sizeof real_itimer);
+ memset (&prof_itimer, 0, sizeof prof_itimer);
+
+ InitializeCriticalSection (&crit_real);
+ InitializeCriticalSection (&crit_prof);
+ InitializeCriticalSection (&crit_sig);
+
+ disable_itimers = 0;
+}
+
+static int
+start_timer_thread (int which)
+{
+ DWORD exit_code;
+ HANDLE th;
+ struct itimer_data *itimer =
+ (which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
+
+ if (itimer->timer_thread
+ && GetExitCodeThread (itimer->timer_thread, &exit_code)
+ && exit_code == STILL_ACTIVE)
+ return 0;
+
+ /* Clean up after possibly exited thread. */
+ if (itimer->timer_thread)
+ {
+ CloseHandle (itimer->timer_thread);
+ itimer->timer_thread = NULL;
+ }
+ if (itimer->caller_thread)
+ {
+ CloseHandle (itimer->caller_thread);
+ itimer->caller_thread = NULL;
+ }
+
+ /* Start a new thread. */
+ if (!DuplicateHandle (GetCurrentProcess (), GetCurrentThread (),
+ GetCurrentProcess (), &th, 0, FALSE,
+ DUPLICATE_SAME_ACCESS))
+ {
+ errno = ESRCH;
+ return -1;
+ }
+ itimer->terminate = 0;
+ itimer->type = which;
+ itimer->caller_thread = th;
+ /* Request that no more than 64KB of stack be reserved for this
+ thread, to avoid reserving too much memory, which would get in
+ the way of threads we start to wait for subprocesses. See also
+ new_child below. */
+ itimer->timer_thread = CreateThread (NULL, 64 * 1024, timer_loop,
+ (void *)itimer, 0x00010000, NULL);
+
+ if (!itimer->timer_thread)
+ {
+ CloseHandle (itimer->caller_thread);
+ itimer->caller_thread = NULL;
+ errno = EAGAIN;
+ return -1;
+ }
+
+ /* This is needed to make sure that the timer thread running for
+ profiling gets CPU as soon as the Sleep call terminates. */
+ if (which == ITIMER_PROF)
+ SetThreadPriority (itimer->timer_thread, THREAD_PRIORITY_TIME_CRITICAL);
+
+ return 0;
+}
+
+/* Most of the code of getitimer and setitimer (but not of their
+ subroutines) was shamelessly stolen from itimer.c in the DJGPP
+ library, see www.delorie.com/djgpp. */
+int
+getitimer (int which, struct itimerval *value)
+{
+ volatile ULONGLONG *t_expire;
+ volatile ULONGLONG *t_reload;
+ ULONGLONG expire, reload;
+ __int64 usecs;
+ CRITICAL_SECTION *crit;
+ struct itimer_data *itimer;
+
+ if (disable_itimers)
+ return -1;
+
+ if (!value)
+ {
+ errno = EFAULT;
+ return -1;
+ }
+
+ if (which != ITIMER_REAL && which != ITIMER_PROF)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+
+ itimer = (which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
+
+ ticks_now = w32_get_timer_time ((which == ITIMER_REAL)
+ ? NULL
+ : GetCurrentThread ());
+
+ t_expire = &itimer->expire;
+ t_reload = &itimer->reload;
+ crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
+
+ EnterCriticalSection (crit);
+ reload = *t_reload;
+ expire = *t_expire;
+ LeaveCriticalSection (crit);
+
+ if (expire)
+ expire -= ticks_now;
+
+ value->it_value.tv_sec = expire / TIMER_TICKS_PER_SEC;
+ usecs =
+ (expire % TIMER_TICKS_PER_SEC) * (__int64)1000000 / TIMER_TICKS_PER_SEC;
+ value->it_value.tv_usec = usecs;
+ value->it_interval.tv_sec = reload / TIMER_TICKS_PER_SEC;
+ usecs =
+ (reload % TIMER_TICKS_PER_SEC) * (__int64)1000000 / TIMER_TICKS_PER_SEC;
+ value->it_interval.tv_usec= usecs;
+
+ return 0;
+}
+
+int
+setitimer(int which, struct itimerval *value, struct itimerval *ovalue)
+{
+ volatile ULONGLONG *t_expire, *t_reload;
+ ULONGLONG expire, reload, expire_old, reload_old;
+ __int64 usecs;
+ CRITICAL_SECTION *crit;
+ struct itimerval tem, *ptem;
+
+ if (disable_itimers)
+ return -1;
+
+ /* Posix systems expect timer values smaller than the resolution of
+ the system clock be rounded up to the clock resolution. First
+ time we are called, measure the clock tick resolution. */
+ if (!clocks_min)
+ {
+ ULONGLONG t1, t2;
+
+ for (t1 = w32_get_timer_time (NULL);
+ (t2 = w32_get_timer_time (NULL)) == t1; )
+ ;
+ clocks_min = t2 - t1;
+ }
+
+ if (ovalue)
+ ptem = ovalue;
+ else
+ ptem = &tem;
+
+ if (getitimer (which, ptem)) /* also sets ticks_now */
+ return -1; /* errno already set */
+
+ t_expire =
+ (which == ITIMER_REAL) ? &real_itimer.expire : &prof_itimer.expire;
+ t_reload =
+ (which == ITIMER_REAL) ? &real_itimer.reload : &prof_itimer.reload;
+
+ crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
+
+ if (!value
+ || (value->it_value.tv_sec == 0 && value->it_value.tv_usec == 0))
+ {
+ EnterCriticalSection (crit);
+ /* Disable the timer. */
+ *t_expire = 0;
+ *t_reload = 0;
+ LeaveCriticalSection (crit);
+ return 0;
+ }
+
+ reload = value->it_interval.tv_sec * TIMER_TICKS_PER_SEC;
+
+ usecs = value->it_interval.tv_usec;
+ if (value->it_interval.tv_sec == 0
+ && usecs && usecs * TIMER_TICKS_PER_SEC < clocks_min * 1000000)
+ reload = clocks_min;
+ else
+ {
+ usecs *= TIMER_TICKS_PER_SEC;
+ reload += usecs / 1000000;
+ }
+
+ expire = value->it_value.tv_sec * TIMER_TICKS_PER_SEC;
+ usecs = value->it_value.tv_usec;
+ if (value->it_value.tv_sec == 0
+ && usecs * TIMER_TICKS_PER_SEC < clocks_min * 1000000)
+ expire = clocks_min;
+ else
+ {
+ usecs *= TIMER_TICKS_PER_SEC;
+ expire += usecs / 1000000;
+ }
+
+ expire += ticks_now;
+
+ EnterCriticalSection (crit);
+ expire_old = *t_expire;
+ reload_old = *t_reload;
+ if (!(expire == expire_old && reload == reload_old))
+ {
+ *t_reload = reload;
+ *t_expire = expire;
+ }
+ LeaveCriticalSection (crit);
+
+ return start_timer_thread (which);
+}
+
+int
+alarm (int seconds)
+{
+#ifdef HAVE_SETITIMER
+ struct itimerval new_values, old_values;
+
+ new_values.it_value.tv_sec = seconds;
+ new_values.it_value.tv_usec = 0;
+ new_values.it_interval.tv_sec = new_values.it_interval.tv_usec = 0;
+
+ if (setitimer (ITIMER_REAL, &new_values, &old_values) < 0)
+ return 0;
+ return old_values.it_value.tv_sec;
+#else
+ return seconds;
+#endif
+}
+
/* Defined in <process.h> which conflicts with the local copy */
#define _P_NOWAIT 1
/* Child process management list. */
int child_proc_count = 0;
child_process child_procs[ MAX_CHILDREN ];
-child_process *dead_child = NULL;
static DWORD WINAPI reader_thread (void *arg);
@@ -141,7 +820,25 @@ new_child (void)
cp->char_consumed = CreateEvent (NULL, FALSE, FALSE, NULL);
if (cp->char_consumed)
{
- cp->thrd = CreateThread (NULL, 1024, reader_thread, cp, 0, &id);
+ /* The 0x00010000 flag is STACK_SIZE_PARAM_IS_A_RESERVATION.
+ It means that the 64K stack we are requesting in the 2nd
+ argument is how much memory should be reserved for the
+ stack. If we don't use this flag, the memory requested
+ by the 2nd argument is the amount actually _committed_,
+ but Windows reserves 8MB of memory for each thread's
+ stack. (The 8MB figure comes from the -stack
+ command-line argument we pass to the linker when building
+ Emacs, but that's because we need a large stack for
+ Emacs's main thread.) Since we request 2GB of reserved
+ memory at startup (see w32heap.c), which is close to the
+ maximum memory available for a 32-bit process on Windows,
+ the 8MB reservation for each thread causes failures in
+ starting subprocesses, because we create a thread running
+ reader_thread for each subprocess. As 8MB of stack is
+ way too much for reader_thread, forcing Windows to
+ reserve less wins the day. */
+ cp->thrd = CreateThread (NULL, 64 * 1024, reader_thread, cp,
+ 0x00010000, &id);
if (cp->thrd)
return cp;
}
@@ -158,7 +855,7 @@ delete_child (child_process *cp)
/* Should not be deleting a child that is still needed. */
for (i = 0; i < MAXDESC; i++)
if (fd_info[i].cp == cp)
- abort ();
+ emacs_abort ();
if (!CHILD_ACTIVE (cp))
return;
@@ -298,7 +995,7 @@ create_child (char *exe, char *cmdline, char *env, int is_gui_app,
DWORD flags;
char dir[ MAXPATHLEN ];
- if (cp == NULL) abort ();
+ if (cp == NULL) emacs_abort ();
memset (&start, 0, sizeof (start));
start.cb = sizeof (start);
@@ -344,9 +1041,6 @@ create_child (char *exe, char *cmdline, char *env, int is_gui_app,
if (cp->pid < 0)
cp->pid = -cp->pid;
- /* pid must fit in a Lisp_Int */
- cp->pid = cp->pid & INTMASK;
-
*pPid = cp->pid;
return TRUE;
@@ -387,7 +1081,7 @@ register_child (int pid, int fd)
if (fd_info[fd].cp != NULL)
{
DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd));
- abort ();
+ emacs_abort ();
}
fd_info[fd].cp = cp;
@@ -422,55 +1116,110 @@ reap_subprocess (child_process *cp)
delete_child (cp);
}
-/* Wait for any of our existing child processes to die
- When it does, close its handle
- Return the pid and fill in the status if non-NULL. */
+/* Wait for a child process specified by PID, or for any of our
+ existing child processes (if PID is nonpositive) to die. When it
+ does, close its handle. Return the pid of the process that died
+ and fill in STATUS if non-NULL. */
-int
-sys_wait (int *status)
+pid_t
+waitpid (pid_t pid, int *status, int options)
{
DWORD active, retval;
int nh;
- int pid;
child_process *cp, *cps[MAX_CHILDREN];
HANDLE wait_hnd[MAX_CHILDREN];
+ DWORD timeout_ms;
+ int dont_wait = (options & WNOHANG) != 0;
nh = 0;
- if (dead_child != NULL)
+ /* According to Posix:
+
+ PID = -1 means status is requested for any child process.
+
+ PID > 0 means status is requested for a single child process
+ whose pid is PID.
+
+ PID = 0 means status is requested for any child process whose
+ process group ID is equal to that of the calling process. But
+ since Windows has only a limited support for process groups (only
+ for console processes and only for the purposes of passing
+ Ctrl-BREAK signal to them), and since we have no documented way
+ of determining whether a given process belongs to our group, we
+ treat 0 as -1.
+
+ PID < -1 means status is requested for any child process whose
+ process group ID is equal to the absolute value of PID. Again,
+ since we don't support process groups, we treat that as -1. */
+ if (pid > 0)
{
- /* We want to wait for a specific child */
- wait_hnd[nh] = dead_child->procinfo.hProcess;
- cps[nh] = dead_child;
- if (!wait_hnd[nh]) abort ();
- nh++;
- active = 0;
- goto get_result;
+ int our_child = 0;
+
+ /* We are requested to wait for a specific child. */
+ for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
+ {
+ /* Some child_procs might be sockets; ignore them. Also
+ ignore subprocesses whose output is not yet completely
+ read. */
+ if (CHILD_ACTIVE (cp)
+ && cp->procinfo.hProcess
+ && cp->pid == pid)
+ {
+ our_child = 1;
+ break;
+ }
+ }
+ if (our_child)
+ {
+ if (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)
+ {
+ wait_hnd[nh] = cp->procinfo.hProcess;
+ cps[nh] = cp;
+ nh++;
+ }
+ else if (dont_wait)
+ {
+ /* PID specifies our subprocess, but its status is not
+ yet available. */
+ return 0;
+ }
+ }
+ if (nh == 0)
+ {
+ /* No such child process, or nothing to wait for, so fail. */
+ errno = ECHILD;
+ return -1;
+ }
}
else
{
for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
- /* some child_procs might be sockets; ignore them */
- if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess
- && (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0))
- {
- wait_hnd[nh] = cp->procinfo.hProcess;
- cps[nh] = cp;
- nh++;
- }
+ {
+ if (CHILD_ACTIVE (cp)
+ && cp->procinfo.hProcess
+ && (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0))
+ {
+ wait_hnd[nh] = cp->procinfo.hProcess;
+ cps[nh] = cp;
+ nh++;
+ }
+ }
+ if (nh == 0)
+ {
+ /* Nothing to wait on, so fail. */
+ errno = ECHILD;
+ return -1;
+ }
}
- if (nh == 0)
- {
- /* Nothing to wait on, so fail */
- errno = ECHILD;
- return -1;
- }
+ if (dont_wait)
+ timeout_ms = 0;
+ else
+ timeout_ms = 1000; /* check for quit about once a second. */
do
{
- /* Check for quit about once a second. */
QUIT;
- active = WaitForMultipleObjects (nh, wait_hnd, FALSE, 1000);
+ active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms);
} while (active == WAIT_TIMEOUT);
if (active == WAIT_FAILED)
@@ -489,9 +1238,8 @@ sys_wait (int *status)
active -= WAIT_ABANDONED_0;
}
else
- abort ();
+ emacs_abort ();
-get_result:
if (!GetExitCodeProcess (wait_hnd[active], &retval))
{
DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
@@ -500,8 +1248,10 @@ get_result:
}
if (retval == STILL_ACTIVE)
{
- /* Should never happen */
+ /* Should never happen. */
DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
+ if (pid > 0 && dont_wait)
+ return 0;
errno = EINVAL;
return -1;
}
@@ -515,6 +1265,8 @@ get_result:
else
retval <<= 8;
+ if (pid > 0 && active != 0)
+ emacs_abort ();
cp = cps[active];
pid = cp->pid;
#ifdef FULL_DEBUG
@@ -531,11 +1283,11 @@ get_result:
/* Report the status of the synchronous process. */
if (WIFEXITED (retval))
- synch_process_retcode = WRETCODE (retval);
+ synch_process_retcode = WEXITSTATUS (retval);
else if (WIFSIGNALED (retval))
{
int code = WTERMSIG (retval);
- char *signame;
+ const char *signame;
synchronize_system_messages_locale ();
signame = strsignal (code);
@@ -610,7 +1362,7 @@ w32_executable_type (char * filename,
if (dos_header->e_magic != IMAGE_DOS_SIGNATURE)
goto unwind;
- nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew);
+ nt_header = (PIMAGE_NT_HEADERS) ((unsigned char *) dos_header + dos_header->e_lfanew);
if ((char *) nt_header > (char *) dos_header + executable.size)
{
@@ -759,7 +1511,7 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp)
}
/* Handle executable names without an executable suffix. */
- program = make_string (cmdname, strlen (cmdname));
+ program = build_string (cmdname);
if (NILP (Ffile_executable_p (program)))
{
struct gcpro gcpro1;
@@ -781,7 +1533,7 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp)
unixtodos_filename (cmdname);
argv[0] = cmdname;
- /* Determine whether program is a 16-bit DOS executable, or a w32
+ /* Determine whether program is a 16-bit DOS executable, or a 32-bit Windows
executable that is implicitly linked to the Cygnus dll (implying it
was compiled with the Cygnus GNU toolchain and hence relies on
cygwin.dll to parse the command line - we use this to decide how to
@@ -994,7 +1746,7 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp)
numenv++;
}
/* extra env vars... */
- sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d",
+ sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%lu",
GetCurrentProcessId ());
arglen += strlen (ppid_env_var_buffer) + 1;
numenv++;
@@ -1062,7 +1814,7 @@ extern int proc_buffered_char[];
int
sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
- EMACS_TIME *timeout)
+ EMACS_TIME *timeout, void *ignored)
{
SELECT_TYPE orfds;
DWORD timeout_ms, start_time;
@@ -1072,7 +1824,8 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
HANDLE wait_hnd[MAXDESC + MAX_CHILDREN];
int fdindex[MAXDESC]; /* mapping from wait handles back to descriptors */
- timeout_ms = timeout ? (timeout->tv_sec * 1000 + timeout->tv_usec / 1000) : INFINITE;
+ timeout_ms =
+ timeout ? (timeout->tv_sec * 1000 + timeout->tv_nsec / 1000000) : INFINITE;
/* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
if (rfds == NULL && wfds == NULL && efds == NULL && timeout != NULL)
@@ -1170,7 +1923,7 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
#endif
wait_hnd[nh] = cp->char_avail;
fdindex[nh] = i;
- if (!wait_hnd[nh]) abort ();
+ if (!wait_hnd[nh]) emacs_abort ();
nh++;
#ifdef FULL_DEBUG
DebPrint (("select waiting on child %d fd %d\n",
@@ -1257,7 +2010,7 @@ count_children:
active -= WAIT_ABANDONED_0;
}
else
- abort ();
+ emacs_abort ();
/* Loop over all handles after active (now officially documented as
being the first signaled handle in the array). We do this to
@@ -1302,9 +2055,7 @@ count_children:
DebPrint (("select calling SIGCHLD handler for pid %d\n",
cp->pid));
#endif
- dead_child = cp;
sig_handlers[SIGCHLD] (SIGCHLD);
- dead_child = NULL;
}
}
else if (fdindex[active] == -1)
@@ -1367,7 +2118,7 @@ find_child_console (HWND hwnd, LPARAM arg)
GetClassName (hwnd, window_class, sizeof (window_class));
if (strcmp (window_class,
- (os_subtype == OS_WIN95)
+ (os_subtype == OS_9X)
? "tty"
: "ConsoleWindowClass") == 0)
{
@@ -1379,6 +2130,7 @@ find_child_console (HWND hwnd, LPARAM arg)
return TRUE;
}
+/* Emulate 'kill', but only for other processes. */
int
sys_kill (int pid, int sig)
{
@@ -1397,6 +2149,11 @@ sys_kill (int pid, int sig)
cp = find_child_pid (pid);
if (cp == NULL)
{
+ /* We were passed a PID of something other than our subprocess.
+ If that is our own PID, we will send to ourself a message to
+ close the selected frame, which does not necessarily
+ terminates Emacs. But then we are not supposed to call
+ sys_kill with our own PID. */
proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid);
if (proc_hand == NULL)
{
@@ -1498,7 +2255,7 @@ sys_kill (int pid, int sig)
if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
{
#if 1
- if (os_subtype == OS_WIN95)
+ if (os_subtype == OS_9X)
{
/*
Another possibility is to try terminating the VDM out-right by
@@ -1517,7 +2274,7 @@ sys_kill (int pid, int sig)
*/
#if 0
- /* On Win95, posting WM_QUIT causes the 16-bit subsystem
+ /* On Windows 95, posting WM_QUIT causes the 16-bit subsystem
to hang when cmdproxy is used in conjunction with
command.com for an interactive shell. Posting
WM_CLOSE pops up a dialog that, when Yes is selected,
@@ -1791,7 +2548,7 @@ If successful, the return value is t, otherwise nil. */)
CHECK_NUMBER (process);
/* Allow pid to be an internally generated one, or one obtained
- externally. This is necessary because real pids on Win95 are
+ externally. This is necessary because real pids on Windows 95 are
negative. */
pid = XINT (process);
@@ -1930,8 +2687,12 @@ If LCID (a 16-bit number) is not a valid locale, the result is nil. */)
got_full = GetLocaleInfo (XINT (lcid),
XINT (longform),
full_name, sizeof (full_name));
+ /* GetLocaleInfo's return value includes the terminating null
+ character, when the returned information is a string, whereas
+ make_unibyte_string needs the string length without the
+ terminating null. */
if (got_full)
- return make_unibyte_string (full_name, got_full);
+ return make_unibyte_string (full_name, got_full - 1);
}
return Qnil;
@@ -2067,8 +2828,8 @@ DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage,
DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage,
Sw32_set_console_codepage, 1, 1, 0,
- doc: /* Make Windows codepage CP be the current codepage setting for Emacs.
-The codepage setting affects keyboard input and display in tty mode.
+ doc: /* Make Windows codepage CP be the codepage for Emacs tty keyboard input.
+This codepage setting affects keyboard input in tty mode.
If successful, the new CP is returned, otherwise nil. */)
(Lisp_Object cp)
{
@@ -2095,8 +2856,8 @@ DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage,
DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage,
Sw32_set_console_output_codepage, 1, 1, 0,
- doc: /* Make Windows codepage CP be the current codepage setting for Emacs.
-The codepage setting affects keyboard input and display in tty mode.
+ doc: /* Make Windows codepage CP be the codepage for Emacs console output.
+This codepage setting affects display in tty mode.
If successful, the new CP is returned, otherwise nil. */)
(Lisp_Object cp)
{
@@ -2114,7 +2875,7 @@ If successful, the new CP is returned, otherwise nil. */)
DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset,
Sw32_get_codepage_charset, 1, 1, 0,
- doc: /* Return charset of codepage CP.
+ doc: /* Return charset ID corresponding to codepage CP.
Returns nil if the codepage is not valid. */)
(Lisp_Object cp)
{
diff --git a/src/w32reg.c b/src/w32reg.c
index 18374431062..8b6c76503a6 100644
--- a/src/w32reg.c
+++ b/src/w32reg.c
@@ -1,5 +1,5 @@
/* Emulate the X Resource Manager through the registry.
- Copyright (C) 1990, 1993-1994, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1990, 1993-1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,7 +19,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Written by Kevin Gallo */
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
#include "w32term.h"
#include "blockinput.h"
@@ -85,7 +84,7 @@ w32_get_string_resource (char *name, char *class, DWORD dwexptype)
trykey:
- BLOCK_INPUT;
+ block_input ();
/* Check both the current user and the local machine to see if we have
any resources */
@@ -110,13 +109,13 @@ w32_get_string_resource (char *name, char *class, DWORD dwexptype)
}
ok = (keyname
- && (lpvalue = (LPBYTE) xmalloc (cbData)) != NULL
+ && (lpvalue = xmalloc (cbData)) != NULL
&& RegQueryValueEx (hrootkey, keyname, NULL, NULL, lpvalue, &cbData) == ERROR_SUCCESS);
RegCloseKey (hrootkey);
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (!ok)
{
diff --git a/src/w32select.c b/src/w32select.c
index 392cb07a96d..6a2a840f914 100644
--- a/src/w32select.c
+++ b/src/w32select.c
@@ -1,6 +1,6 @@
-/* Selection processing for Emacs on the Microsoft W32 API.
+/* Selection processing for Emacs on the Microsoft Windows API.
-Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -73,15 +73,20 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
*/
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
+#include "w32common.h" /* os_subtype */
#include "w32term.h" /* for all of the w32 includes */
-#include "w32heap.h" /* os_subtype */
+#include "keyboard.h"
#include "blockinput.h"
#include "charset.h"
#include "coding.h"
#include "composite.h"
+#ifdef CYGWIN
+#include <string.h>
+#include <stdio.h>
+#define _memccpy memccpy
+#endif
static HGLOBAL convert_to_handle_as_ascii (void);
static HGLOBAL convert_to_handle_as_coded (Lisp_Object coding_system);
@@ -216,7 +221,7 @@ convert_to_handle_as_coded (Lisp_Object coding_system)
setup_windows_coding_system (coding_system, &coding);
coding.dst_bytes = SBYTES (current_text) * 2;
- coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
+ coding.destination = xmalloc (coding.dst_bytes);
encode_coding_object (&coding, current_text, 0, 0,
SCHARS (current_text), SBYTES (current_text), Qnil);
@@ -389,12 +394,11 @@ run_protected (Lisp_Object (*code) (Lisp_Object), Lisp_Object arg)
with global variables and calling strange looking functions. Is
this really the right way to run Lisp callbacks? */
- extern int waiting_for_input; /* from keyboard.c */
int owfi;
- BLOCK_INPUT;
+ block_input ();
- /* Fsignal calls abort() if it sees that waiting_for_input is
+ /* Fsignal calls emacs_abort () if it sees that waiting_for_input is
set. */
owfi = waiting_for_input;
waiting_for_input = 0;
@@ -403,7 +407,7 @@ run_protected (Lisp_Object (*code) (Lisp_Object), Lisp_Object arg)
waiting_for_input = owfi;
- UNBLOCK_INPUT;
+ unblock_input ();
}
static Lisp_Object
@@ -475,7 +479,10 @@ term_w32select (void)
{
/* This is needed to trigger WM_RENDERALLFORMATS. */
if (clipboard_owner != NULL)
- DestroyWindow (clipboard_owner);
+ {
+ DestroyWindow (clipboard_owner);
+ clipboard_owner = NULL;
+ }
}
static void
@@ -695,7 +702,7 @@ DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data,
current_num_nls = 0;
current_requires_encoding = 0;
- BLOCK_INPUT;
+ block_input ();
/* Check for non-ASCII characters. While we are at it, count the
number of LFs, so we know how many CRs we will have to add later
@@ -783,7 +790,7 @@ DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data,
current_coding_system = Qnil;
done:
- UNBLOCK_INPUT;
+ unblock_input ();
return (ok ? string : Qnil);
}
@@ -811,7 +818,7 @@ DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data,
setup_config ();
actual_clipboard_type = cfg_clipboard_type;
- BLOCK_INPUT;
+ block_input ();
if (!OpenClipboard (clipboard_owner))
goto done;
@@ -1001,7 +1008,7 @@ DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data,
CloseClipboard ();
done:
- UNBLOCK_INPUT;
+ unblock_input ();
return (ret);
}
@@ -1009,14 +1016,17 @@ DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data,
/* Support checking for a clipboard selection. */
DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
- 0, 1, 0,
- doc: /* Whether there is an owner for the given X Selection.
-The arg should be the name of the selection in question, typically one of
-the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-\(Those are literal upper-case symbol names, since that's what X expects.)
-For convenience, the symbol nil is the same as `PRIMARY',
-and t is the same as `SECONDARY'. */)
- (Lisp_Object selection)
+ 0, 2, 0,
+ doc: /* Whether there is an owner for the given X selection.
+SELECTION should be the name of the selection in question, typically
+one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
+these literal upper-case names.) The symbol nil is the same as
+`PRIMARY', and t is the same as `SECONDARY'.
+
+TERMINAL should be a terminal object or a frame specifying the X
+server to query. If omitted or nil, that stands for the selected
+frame's display, or the first available X display. */)
+ (Lisp_Object selection, Lisp_Object terminal)
{
CHECK_SYMBOL (selection);
diff --git a/src/m/macppc.h b/src/w32select.h
index aef781e2c39..4f4de59f7fe 100644
--- a/src/m/macppc.h
+++ b/src/w32select.h
@@ -1,6 +1,6 @@
-/* machine description file For the powerpc Macintosh.
+/* Selection processing for Emacs on the Microsoft W32 API.
-Copyright (C) 1994, 2001-2011 Free Software Foundation, Inc.
+Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -17,8 +17,12 @@ 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/>. */
-#ifdef _ARCH_PPC64
-#ifndef _LP64
-#define _LP64
-#endif
+#ifndef W32SELECT_H
+#define W32SELECT_H
+#include <windows.h>
+
+extern void syms_of_w32select (void);
+extern void globals_of_w32select (void);
+extern void term_w32select (void);
+
#endif
diff --git a/src/w32term.c b/src/w32term.c
index 29ac9d119b4..ab6afd32c75 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -1,6 +1,6 @@
-/* Implementation of GUI terminal on the Microsoft W32 API.
+/* Implementation of GUI terminal on the Microsoft Windows API.
-Copyright (C) 1989, 1993-2011 Free Software Foundation, Inc.
+Copyright (C) 1989, 1993-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -20,7 +20,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "blockinput.h"
#include "w32term.h"
@@ -52,7 +51,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "atimer.h"
#include "keymap.h"
+#ifdef WINDOWSNT
#include "w32heap.h"
+#endif
+
+#ifndef WINDOWSNT
+#include <io.h> /* for get_osfhandle */
+#endif
+
#include <shellapi.h>
#include "font.h"
@@ -103,7 +109,7 @@ struct w32_display_info *x_display_list;
Lisp_Object w32_display_name_list;
-#ifndef GLYPHSET
+#if _WIN32_WINNT < 0x0500
/* Pre Windows 2000, this was not available, but define it here so
that Emacs compiled on such a platform will run on newer versions. */
@@ -122,7 +128,7 @@ typedef struct tagGLYPHSET
WCRANGE ranges[1];
} GLYPHSET;
-#endif
+#endif /* compiling for pre-Win2k */
/* Dynamic linking to SetLayeredWindowAttribute (only since 2000). */
BOOL (WINAPI *pfnSetLayeredWindowAttributes) (HWND, COLORREF, BYTE, DWORD);
@@ -155,6 +161,9 @@ int vertical_scroll_bar_bottom_border;
int last_scroll_bar_drag_pos;
+/* Keyboard code page - may be changed by language-change events. */
+int w32_keyboard_codepage;
+
/* Mouse movement. */
/* Where the mouse was last time we reported a mouse event. */
@@ -188,8 +197,9 @@ static int volatile input_signal_count;
static int input_signal_count;
#endif
-/* Keyboard code page - may be changed by language-change events. */
-static int keyboard_codepage;
+#ifdef CYGWIN
+int w32_message_fd = -1;
+#endif /* CYGWIN */
static void x_update_window_end (struct window *, int, int);
static void w32_handle_tool_bar_click (struct frame *,
@@ -198,7 +208,7 @@ static void w32_define_cursor (Window, Cursor);
void x_lower_frame (struct frame *);
void x_scroll_bar_clear (struct frame *);
-void x_wm_set_size_hint (struct frame *, long, int);
+void x_wm_set_size_hint (struct frame *, long, bool);
void x_raise_frame (struct frame *);
void x_set_window_size (struct frame *, int, int, int);
void x_wm_set_window_state (struct frame *, int);
@@ -231,6 +241,10 @@ static void my_set_focus (struct frame *, HWND);
static void my_set_foreground_window (HWND);
static void my_destroy_window (struct frame *, HWND);
+#ifdef GLYPH_DEBUG
+static void x_check_font (struct frame *, struct font *);
+#endif
+
static Lisp_Object Qvendor_specific_keysyms;
@@ -281,8 +295,7 @@ XChangeGC (void *ignore, XGCValues *gc, unsigned long mask,
XGCValues *
XCreateGC (void *ignore, Window window, unsigned long mask, XGCValues *xgcv)
{
- XGCValues *gc = (XGCValues *) xmalloc (sizeof (XGCValues));
- memset (gc, 0, sizeof (XGCValues));
+ XGCValues *gc = xzalloc (sizeof (XGCValues));
XChangeGC (ignore, gc, mask, xgcv);
@@ -309,6 +322,98 @@ w32_set_clip_rectangle (HDC hdc, RECT *rect)
SelectClipRgn (hdc, NULL);
}
+/* Restore clipping rectangle in S */
+static void
+w32_restore_glyph_string_clip (struct glyph_string *s)
+{
+ RECT *r = s->clip;
+ int n = s->num_clips;
+
+ if (n == 1)
+ w32_set_clip_rectangle (s->hdc, r);
+ else if (n > 1)
+ {
+ HRGN clip1 = CreateRectRgnIndirect (r);
+ HRGN clip2 = CreateRectRgnIndirect (r + 1);
+ if (CombineRgn (clip1, clip1, clip2, RGN_OR) != ERROR)
+ SelectClipRgn (s->hdc, clip1);
+ DeleteObject (clip1);
+ DeleteObject (clip2);
+ }
+}
+
+/*
+ Draw a wavy line under S. The wave fills wave_height pixels from y0.
+
+ x0 wave_length = 2
+ --
+ y0 * * * * *
+ |* * * * * * * * *
+ wave_height = 3 | * * * *
+
+*/
+
+void
+w32_draw_underwave (struct glyph_string *s, COLORREF color)
+{
+ int wave_height = 2, wave_length = 3;
+ int dx, dy, x0, y0, width, x1, y1, x2, y2, odd, xmax;
+ XRectangle wave_clip, string_clip, final_clip;
+ RECT w32_final_clip, w32_string_clip;
+ HPEN hp, oldhp;
+
+ dx = wave_length;
+ dy = wave_height - 1;
+ x0 = s->x;
+ y0 = s->ybase + 1;
+ width = s->width;
+ xmax = x0 + width;
+
+ /* Find and set clipping rectangle */
+
+ wave_clip.x = x0;
+ wave_clip.y = y0;
+ wave_clip.width = width;
+ wave_clip.height = wave_height;
+
+ get_glyph_string_clip_rect (s, &w32_string_clip);
+ CONVERT_TO_XRECT (string_clip, w32_string_clip);
+
+ if (!x_intersect_rectangles (&wave_clip, &string_clip, &final_clip))
+ return;
+
+ hp = CreatePen (PS_SOLID, 0, color);
+ oldhp = SelectObject (s->hdc, hp);
+ CONVERT_FROM_XRECT (final_clip, w32_final_clip);
+ w32_set_clip_rectangle (s->hdc, &w32_final_clip);
+
+ /* Draw the waves */
+
+ x1 = x0 - (x0 % dx);
+ x2 = x1 + dx;
+ odd = (x1/dx) % 2;
+ y1 = y2 = y0;
+
+ if (odd)
+ y1 += dy;
+ else
+ y2 += dy;
+
+ MoveToEx (s->hdc, x1, y1, NULL);
+
+ while (x1 <= xmax)
+ {
+ LineTo (s->hdc, x2, y2);
+ x1 = x2, y1 = y2;
+ x2 += dx, y2 = y0 + odd*dy;
+ odd = !odd;
+ }
+
+ /* Restore previous pen and clipping rectangle(s) */
+ w32_restore_glyph_string_clip (s);
+ SelectObject (s->hdc, oldhp);
+ DeleteObject (hp);
+}
/* Draw a hollow rectangle at the specified position. */
void
@@ -473,7 +578,7 @@ x_update_window_begin (struct window *w)
updated_window = w;
set_output_cursor (&w->cursor);
- BLOCK_INPUT;
+ block_input ();
if (f == hlinfo->mouse_face_mouse_frame)
{
@@ -512,7 +617,7 @@ x_update_window_begin (struct window *w)
#endif /* 0 */
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Draw a vertical window border from (x,y0) to (x,y1) */
@@ -562,7 +667,7 @@ x_update_window_end (struct window *w, int cursor_on_p,
if (!w->pseudo_window_p)
{
- BLOCK_INPUT;
+ block_input ();
if (cursor_on_p)
display_and_set_cursor (w, 1, output_cursor.hpos,
@@ -572,7 +677,7 @@ x_update_window_end (struct window *w, int cursor_on_p,
if (draw_window_fringes (w, 1))
x_draw_vertical_border (w);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* If a row with mouse-face was overwritten, arrange for
@@ -618,21 +723,7 @@ static void
w32_frame_up_to_date (struct frame *f)
{
if (FRAME_W32_P (f))
- {
- Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
-
- if (hlinfo->mouse_face_deferred_gc
- || f == hlinfo->mouse_face_mouse_frame)
- {
- BLOCK_INPUT;
- if (hlinfo->mouse_face_mouse_frame)
- note_mouse_highlight (hlinfo->mouse_face_mouse_frame,
- hlinfo->mouse_face_mouse_x,
- hlinfo->mouse_face_mouse_y);
- hlinfo->mouse_face_deferred_gc = 0;
- UNBLOCK_INPUT;
- }
- }
+ FRAME_MOUSE_UPDATE (f);
}
@@ -650,7 +741,7 @@ x_after_update_window_line (struct glyph_row *desired_row)
struct frame *f;
int width, height;
- xassert (w);
+ eassert (w);
if (!desired_row->mode_line_p && !w->pseudo_window_p)
desired_row->redraw_fringe_bitmaps_p = 1;
@@ -671,7 +762,7 @@ x_after_update_window_line (struct glyph_row *desired_row)
{
int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y));
- BLOCK_INPUT;
+ block_input ();
{
HDC hdc = get_frame_dc (f);
w32_clear_area (f, hdc, 0, y, width, height);
@@ -679,7 +770,7 @@ x_after_update_window_line (struct glyph_row *desired_row)
y, width, height);
release_frame_dc (f, hdc);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -994,7 +1085,7 @@ x_set_mouse_face_gc (struct glyph_string *s)
s->gc = FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc;
}
- xassert (s->gc != 0);
+ eassert (s->gc != 0);
}
@@ -1051,7 +1142,7 @@ x_set_glyph_string_gc (struct glyph_string *s)
}
/* GC must have been set. */
- xassert (s->gc != 0);
+ eassert (s->gc != 0);
}
@@ -1468,7 +1559,7 @@ w32_alloc_lighter_color (struct frame *f, COLORREF *color,
delta /= 256;
/* Change RGB values by specified FACTOR. Avoid overflow! */
- xassert (factor >= 0);
+ eassert (factor >= 0);
new = PALETTERGB (min (0xff, factor * GetRValue (*color)),
min (0xff, factor * GetGValue (*color)),
min (0xff, factor * GetBValue (*color)));
@@ -2145,7 +2236,7 @@ x_draw_image_glyph_string (struct glyph_string *s)
static void
x_draw_stretch_glyph_string (struct glyph_string *s)
{
- xassert (s->first_glyph->type == STRETCH_GLYPH);
+ eassert (s->first_glyph->type == STRETCH_GLYPH);
if (s->hl == DRAW_CURSOR
&& !x_stretch_cursor_p)
@@ -2335,7 +2426,7 @@ x_draw_glyph_string (struct glyph_string *s)
break;
default:
- abort ();
+ emacs_abort ();
}
if (!s->for_overlaps)
@@ -2343,60 +2434,74 @@ x_draw_glyph_string (struct glyph_string *s)
/* Draw underline. */
if (s->face->underline_p)
{
- unsigned long thickness, position;
- int y;
-
- if (s->prev && s->prev->face->underline_p)
+ if (s->face->underline_type == FACE_UNDER_WAVE)
{
- /* We use the same underline style as the previous one. */
- thickness = s->prev->underline_thickness;
- position = s->prev->underline_position;
+ COLORREF color;
+
+ if (s->face->underline_defaulted_p)
+ color = s->gc->foreground;
+ else
+ color = s->face->underline_color;
+
+ w32_draw_underwave (s, color);
}
- else
+ else if (s->face->underline_type == FACE_UNDER_LINE)
{
- /* Get the underline thickness. Default is 1 pixel. */
- if (s->font && s->font->underline_thickness > 0)
- thickness = s->font->underline_thickness;
+ unsigned long thickness, position;
+ int y;
+
+ if (s->prev && s->prev->face->underline_p)
+ {
+ /* We use the same underline style as the previous one. */
+ thickness = s->prev->underline_thickness;
+ position = s->prev->underline_position;
+ }
else
- thickness = 1;
- if (x_underline_at_descent_line)
- position = (s->height - thickness) - (s->ybase - s->y);
+ {
+ /* Get the underline thickness. Default is 1 pixel. */
+ if (s->font && s->font->underline_thickness > 0)
+ thickness = s->font->underline_thickness;
+ else
+ thickness = 1;
+ if (x_underline_at_descent_line)
+ position = (s->height - thickness) - (s->ybase - s->y);
+ else
+ {
+ /* Get the underline position. This is the recommended
+ vertical offset in pixels from the baseline to the top of
+ the underline. This is a signed value according to the
+ specs, and its default is
+
+ ROUND ((maximum_descent) / 2), with
+ ROUND (x) = floor (x + 0.5) */
+
+ if (x_use_underline_position_properties
+ && s->font && s->font->underline_position >= 0)
+ position = s->font->underline_position;
+ else if (s->font)
+ position = (s->font->descent + 1) / 2;
+ }
+ position = max (position, underline_minimum_offset);
+ }
+ /* Check the sanity of thickness and position. We should
+ avoid drawing underline out of the current line area. */
+ if (s->y + s->height <= s->ybase + position)
+ position = (s->height - 1) - (s->ybase - s->y);
+ if (s->y + s->height < s->ybase + position + thickness)
+ thickness = (s->y + s->height) - (s->ybase + position);
+ s->underline_thickness = thickness;
+ s->underline_position =position;
+ y = s->ybase + position;
+ if (s->face->underline_defaulted_p)
+ {
+ w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x,
+ y, s->width, 1);
+ }
else
{
- /* Get the underline position. This is the recommended
- vertical offset in pixels from the baseline to the top of
- the underline. This is a signed value according to the
- specs, and its default is
-
- ROUND ((maximum_descent) / 2), with
- ROUND (x) = floor (x + 0.5) */
-
- if (x_use_underline_position_properties
- && s->font && s->font->underline_position >= 0)
- position = s->font->underline_position;
- else if (s->font)
- position = (s->font->descent + 1) / 2;
+ w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x,
+ y, s->width, 1);
}
- position = max (position, underline_minimum_offset);
- }
- /* Check the sanity of thickness and position. We should
- avoid drawing underline out of the current line area. */
- if (s->y + s->height <= s->ybase + position)
- position = (s->height - 1) - (s->ybase - s->y);
- if (s->y + s->height < s->ybase + position + thickness)
- thickness = (s->y + s->height) - (s->ybase + position);
- s->underline_thickness = thickness;
- s->underline_position =position;
- y = s->ybase + position;
- if (s->face->underline_defaulted_p)
- {
- w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x,
- y, s->width, 1);
- }
- else
- {
- w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x,
- y, s->width, 1);
}
}
/* Draw overline. */
@@ -2486,6 +2591,7 @@ x_draw_glyph_string (struct glyph_string *s)
w32_set_clip_rectangle (next->hdc, NULL);
next->hl = save;
next->num_clips = 0;
+ next->clip_head = s->next;
}
}
}
@@ -2521,7 +2627,7 @@ x_delete_glyphs (struct frame *f, register int n)
if (! FRAME_W32_P (f))
return;
- abort ();
+ emacs_abort ();
}
@@ -2541,7 +2647,7 @@ x_clear_frame (struct frame *f)
/* We don't set the output cursor here because there will always
follow an explicit cursor_to. */
- BLOCK_INPUT;
+ block_input ();
w32_clear_window (f);
@@ -2549,7 +2655,7 @@ x_clear_frame (struct frame *f)
colors or something like that, then they should be notified. */
x_scroll_bar_clear (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -2558,7 +2664,7 @@ x_clear_frame (struct frame *f)
static void
w32_ring_bell (struct frame *f)
{
- BLOCK_INPUT;
+ block_input ();
if (FRAME_W32_P (f) && visible_bell)
{
@@ -2575,7 +2681,7 @@ w32_ring_bell (struct frame *f)
else
w32_sys_ring_bell (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -2604,7 +2710,7 @@ x_ins_del_lines (struct frame *f, int vpos, int n)
if (! FRAME_W32_P (f))
return;
- abort ();
+ emacs_abort ();
}
@@ -2674,7 +2780,7 @@ x_scroll_run (struct window *w, struct run *run)
expect_dirty = CreateRectRgn (x, y, x + width, to_y);
}
- BLOCK_INPUT;
+ block_input ();
/* Cursor off. Will be switched on again in x_update_window_end. */
updated_window = w;
@@ -2708,7 +2814,7 @@ x_scroll_run (struct window *w, struct run *run)
DeleteObject (combined);
}
- UNBLOCK_INPUT;
+ unblock_input ();
DeleteObject (expect_dirty);
}
@@ -2867,7 +2973,7 @@ x_frame_rehighlight (struct w32_display_info *dpyinfo)
: dpyinfo->w32_focus_frame);
if (! FRAME_LIVE_P (dpyinfo->x_highlight_frame))
{
- FRAME_FOCUS_FRAME (dpyinfo->w32_focus_frame) = Qnil;
+ fset_focus_frame (dpyinfo->w32_focus_frame, Qnil);
dpyinfo->x_highlight_frame = dpyinfo->w32_focus_frame;
}
}
@@ -2893,9 +2999,9 @@ x_get_keysym_name (int keysym)
/* Make static so we can always return it */
static char value[100];
- BLOCK_INPUT;
+ block_input ();
GetKeyNameText (keysym, value, 100);
- UNBLOCK_INPUT;
+ unblock_input ();
return value;
}
@@ -3203,7 +3309,7 @@ w32_mouse_position (FRAME_PTR *fp, int insist, Lisp_Object *bar_window,
{
FRAME_PTR f1;
- BLOCK_INPUT;
+ block_input ();
if (! NILP (last_mouse_scroll_bar) && insist == 0)
x_scroll_bar_report_motion (fp, bar_window, part, x, y, time);
@@ -3277,7 +3383,7 @@ w32_mouse_position (FRAME_PTR *fp, int insist, Lisp_Object *bar_window,
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -3317,16 +3423,11 @@ w32_handle_tool_bar_click (struct frame *f, struct input_event *button_event)
static struct scroll_bar *
x_window_to_scroll_bar (Window window_id)
{
- Lisp_Object tail;
+ Lisp_Object tail, frame;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- Lisp_Object frame, bar, condemned;
-
- frame = XCAR (tail);
- /* All elements of Vframe_list should be frames. */
- if (! FRAMEP (frame))
- abort ();
+ Lisp_Object bar, condemned;
/* Scan this frame's scroll bar list for a scroll bar with the
right window ID. */
@@ -3375,12 +3476,12 @@ w32_set_scroll_bar_thumb (struct scroll_bar *bar,
if (draggingp)
{
int near_bottom_p;
- BLOCK_INPUT;
+ block_input ();
si.cbSize = sizeof (si);
si.fMask = SIF_POS | SIF_PAGE;
GetScrollInfo (w, SB_CTL, &si);
near_bottom_p = si.nPos + si.nPage >= range;
- UNBLOCK_INPUT;
+ unblock_input ();
if (!near_bottom_p)
return;
}
@@ -3388,7 +3489,7 @@ w32_set_scroll_bar_thumb (struct scroll_bar *bar,
if (whole)
{
/* Position scroll bar at rock bottom if the bottom of the
- buffer is visible. This avoids shinking the thumb away
+ buffer is visible. This avoids shrinking the thumb away
to nothing if it is held at the bottom of the buffer. */
if (position + portion >= whole && !draggingp)
{
@@ -3409,7 +3510,7 @@ w32_set_scroll_bar_thumb (struct scroll_bar *bar,
sb_page = max (sb_page, VERTICAL_SCROLL_BAR_MIN_HANDLE);
- BLOCK_INPUT;
+ block_input ();
si.cbSize = sizeof (si);
si.fMask = SIF_PAGE | SIF_POS;
@@ -3418,7 +3519,7 @@ w32_set_scroll_bar_thumb (struct scroll_bar *bar,
SetScrollInfo (w, SB_CTL, &si, TRUE);
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -3488,6 +3589,12 @@ my_destroy_window (struct frame * f, HWND hwnd)
(WPARAM) hwnd, 0);
}
+static void
+my_bring_window_to_top (HWND hwnd)
+{
+ SendMessage (hwnd, WM_EMACS_BRINGTOTOP, (WPARAM) hwnd, 0);
+}
+
/* Create a scroll bar and return the scroll bar vector for it. W is
the Emacs window on which to create the scroll bar. TOP, LEFT,
WIDTH and HEIGHT are the pixel coordinates and dimensions of the
@@ -3500,9 +3607,10 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height)
HWND hwnd;
SCROLLINFO si;
struct scroll_bar *bar
- = XSCROLL_BAR (Fmake_vector (make_number (SCROLL_BAR_VEC_SIZE), Qnil));
+ = XSCROLL_BAR (Fmake_vector (make_number (VECSIZE (struct scroll_bar)), Qnil));
+ Lisp_Object barobj;
- BLOCK_INPUT;
+ block_input ();
XSETWINDOW (bar->window, w);
XSETINT (bar->top, top);
@@ -3533,11 +3641,12 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height)
/* Add bar to its frame's list of scroll bars. */
bar->next = FRAME_SCROLL_BARS (f);
bar->prev = Qnil;
- XSETVECTOR (FRAME_SCROLL_BARS (f), bar);
+ XSETVECTOR (barobj, bar);
+ fset_scroll_bars (f, barobj);
if (! NILP (bar->next))
XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar);
- UNBLOCK_INPUT;
+ unblock_input ();
return bar;
}
@@ -3551,15 +3660,15 @@ x_scroll_bar_remove (struct scroll_bar *bar)
{
FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window)));
- BLOCK_INPUT;
+ block_input ();
/* Destroy the window. */
my_destroy_window (f, SCROLL_BAR_W32_WINDOW (bar));
/* Dissociate this scroll bar from its window. */
- XWINDOW (bar->window)->vertical_scroll_bar = Qnil;
+ wset_vertical_scroll_bar (XWINDOW (bar->window), Qnil);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Set the handle of the vertical scroll bar for WINDOW to indicate
@@ -3571,6 +3680,7 @@ w32_set_vertical_scroll_bar (struct window *w,
int portion, int whole, int position)
{
struct frame *f = XFRAME (w->frame);
+ Lisp_Object barobj;
struct scroll_bar *bar;
int top, height, left, sb_left, width, sb_width;
int window_y, window_height;
@@ -3613,7 +3723,7 @@ w32_set_vertical_scroll_bar (struct window *w,
if (NILP (w->vertical_scroll_bar))
{
HDC hdc;
- BLOCK_INPUT;
+ block_input ();
if (width > 0 && height > 0)
{
hdc = get_frame_dc (f);
@@ -3623,7 +3733,7 @@ w32_set_vertical_scroll_bar (struct window *w,
w32_clear_area (f, hdc, left, top, width, height);
release_frame_dc (f, hdc);
}
- UNBLOCK_INPUT;
+ unblock_input ();
bar = x_scroll_bar_create (w, top, sb_left, sb_width, height);
}
@@ -3651,7 +3761,7 @@ w32_set_vertical_scroll_bar (struct window *w,
HDC hdc;
SCROLLINFO si;
- BLOCK_INPUT;
+ block_input ();
if (width && height)
{
hdc = get_frame_dc (f);
@@ -3687,14 +3797,14 @@ w32_set_vertical_scroll_bar (struct window *w,
XSETINT (bar->width, sb_width);
XSETINT (bar->height, height);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
bar->fringe_extended_p = fringe_extended_p ? Qt : Qnil;
w32_set_scroll_bar_thumb (bar, portion, position, whole);
-
- XSETVECTOR (w->vertical_scroll_bar, bar);
+ XSETVECTOR (barobj, bar);
+ wset_vertical_scroll_bar (w, barobj);
}
@@ -3718,12 +3828,12 @@ w32_condemn_scroll_bars (FRAME_PTR frame)
{
Lisp_Object bar;
bar = FRAME_SCROLL_BARS (frame);
- FRAME_SCROLL_BARS (frame) = XSCROLL_BAR (bar)->next;
+ fset_scroll_bars (frame, XSCROLL_BAR (bar)->next);
XSCROLL_BAR (bar)->next = FRAME_CONDEMNED_SCROLL_BARS (frame);
XSCROLL_BAR (bar)->prev = Qnil;
if (! NILP (FRAME_CONDEMNED_SCROLL_BARS (frame)))
XSCROLL_BAR (FRAME_CONDEMNED_SCROLL_BARS (frame))->prev = bar;
- FRAME_CONDEMNED_SCROLL_BARS (frame) = bar;
+ fset_condemned_scroll_bars (frame, bar);
}
}
@@ -3735,11 +3845,12 @@ static void
w32_redeem_scroll_bar (struct window *window)
{
struct scroll_bar *bar;
+ Lisp_Object barobj;
struct frame *f;
/* We can't redeem this window's scroll bar if it doesn't have one. */
if (NILP (window->vertical_scroll_bar))
- abort ();
+ emacs_abort ();
bar = XSCROLL_BAR (window->vertical_scroll_bar);
@@ -3754,11 +3865,11 @@ w32_redeem_scroll_bar (struct window *window)
return;
else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f),
window->vertical_scroll_bar))
- FRAME_CONDEMNED_SCROLL_BARS (f) = bar->next;
+ fset_condemned_scroll_bars (f, bar->next);
else
/* If its prev pointer is nil, it must be at the front of
one or the other! */
- abort ();
+ emacs_abort ();
}
else
XSCROLL_BAR (bar->prev)->next = bar->next;
@@ -3768,7 +3879,8 @@ w32_redeem_scroll_bar (struct window *window)
bar->next = FRAME_SCROLL_BARS (f);
bar->prev = Qnil;
- XSETVECTOR (FRAME_SCROLL_BARS (f), bar);
+ XSETVECTOR (barobj, bar);
+ fset_scroll_bars (f, barobj);
if (! NILP (bar->next))
XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar);
}
@@ -3785,7 +3897,7 @@ w32_judge_scroll_bars (FRAME_PTR f)
/* Clear out the condemned list now so we won't try to process any
more events on the hapless scroll bars. */
- FRAME_CONDEMNED_SCROLL_BARS (f) = Qnil;
+ fset_condemned_scroll_bars (f, Qnil);
for (; ! NILP (bar); bar = next)
{
@@ -3812,7 +3924,7 @@ w32_scroll_bar_handle_click (struct scroll_bar *bar, W32Msg *msg,
struct input_event *emacs_event)
{
if (! WINDOWP (bar->window))
- abort ();
+ emacs_abort ();
emacs_event->kind = SCROLL_BAR_CLICK_EVENT;
emacs_event->code = 0;
@@ -3927,7 +4039,7 @@ x_scroll_bar_report_motion (FRAME_PTR *fp, Lisp_Object *bar_window,
int top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (f, XINT (bar->height));
SCROLLINFO si;
- BLOCK_INPUT;
+ block_input ();
*fp = f;
*bar_window = bar->window;
@@ -3964,7 +4076,7 @@ x_scroll_bar_report_motion (FRAME_PTR *fp, Lisp_Object *bar_window,
*time = last_mouse_movement_time;
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -4018,11 +4130,12 @@ static char dbcs_lead = 0;
This routine is called by the SIGIO handler.
We return as soon as there are no more events to be read.
+ For an overview of how Emacs input works on MS-Windows, see the
+ commentary before w32_msg_pump in w32fns.c.
+
We return the number of characters stored into the buffer,
thus pretending to be `read'.
- EXPECTED is nonzero if the caller knows input is available.
-
Some of these messages are reposted back to the message queue since the
system calls the windows proc directly in a context where we cannot return
the data nor can we guarantee the state we are in. So if we dispatch them
@@ -4033,7 +4146,7 @@ static char dbcs_lead = 0;
*/
static int
-w32_read_socket (struct terminal *terminal, int expected,
+w32_read_socket (struct terminal *terminal,
struct input_event *hold_quit)
{
int count = 0;
@@ -4042,25 +4155,26 @@ w32_read_socket (struct terminal *terminal, int expected,
struct frame *f;
struct w32_display_info *dpyinfo = &one_w32_display_info;
Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight;
+ static char buf[1];
- if (interrupt_input_blocked)
- {
- interrupt_input_pending = 1;
- return -1;
- }
-
- interrupt_input_pending = 0;
- BLOCK_INPUT;
+ block_input ();
/* So people can tell when we have read the available input. */
input_signal_count++;
+ /* Process any incoming thread messages. */
+ drain_message_queue ();
+
/* TODO: ghostscript integration. */
while (get_next_msg (&msg, FALSE))
{
struct input_event inev;
int do_help = 0;
+ /* DebPrint (("w32_read_socket: %s time:%u\n", */
+ /* w32_name_of_message (msg.msg.message), */
+ /* msg.msg.time)); */
+
EVENT_INIT (inev);
inev.kind = NO_EVENT;
inev.arg = Qnil;
@@ -4122,16 +4236,16 @@ w32_read_socket (struct terminal *terminal, int expected,
/* Generate a language change event. */
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
- /* lParam contains the input lang ID. Use it to update our
- record of the keyboard codepage. */
- keyboard_codepage = codepage_for_locale ((LCID)(msg.msg.lParam
- & 0xffff));
+ /* lParam contains the input language ID in its low 16 bits.
+ Use it to update our record of the keyboard codepage. */
+ w32_keyboard_codepage = codepage_for_locale ((LCID)(msg.msg.lParam
+ & 0xffff));
if (f)
{
inev.kind = LANGUAGE_CHANGE_EVENT;
XSETFRAME (inev.frame_or_window, f);
- inev.code = msg.msg.wParam;
+ inev.code = w32_keyboard_codepage;
inev.modifiers = msg.msg.lParam & 0xffff;
}
break;
@@ -4197,7 +4311,7 @@ w32_read_socket (struct terminal *terminal, int expected,
{
dbcs[0] = dbcs_lead;
dbcs_lead = 0;
- if (!MultiByteToWideChar (keyboard_codepage, 0,
+ if (!MultiByteToWideChar (w32_keyboard_codepage, 0,
dbcs, 2, &code, 1))
{
/* Garbage */
@@ -4207,7 +4321,7 @@ w32_read_socket (struct terminal *terminal, int expected,
break;
}
}
- else if (IsDBCSLeadByteEx (keyboard_codepage,
+ else if (IsDBCSLeadByteEx (w32_keyboard_codepage,
(BYTE) msg.msg.wParam))
{
dbcs_lead = (char) msg.msg.wParam;
@@ -4216,7 +4330,7 @@ w32_read_socket (struct terminal *terminal, int expected,
}
else
{
- if (!MultiByteToWideChar (keyboard_codepage, 0,
+ if (!MultiByteToWideChar (w32_keyboard_codepage, 0,
&dbcs[1], 1, &code, 1))
{
/* What to do with garbage? */
@@ -4332,7 +4446,7 @@ w32_read_socket (struct terminal *terminal, int expected,
/* If the contents of the global variable help_echo_string
has changed, generate a HELP_EVENT. */
-#if 0 /* The below is an invalid comparison when USE_LISP_UNION_TYPE.
+#if 0 /* The below is an invalid comparison when CHECK_LISP_OBJECT_TYPE.
But it was originally changed to this to fix a bug, so I have
not removed it completely in case the bug is still there. */
if (help_echo_string != previous_help_echo_string ||
@@ -4846,7 +4960,7 @@ w32_read_socket (struct terminal *terminal, int expected,
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return count;
}
@@ -5117,7 +5231,7 @@ w32_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
break;
default:
- abort ();
+ emacs_abort ();
}
}
}
@@ -5361,7 +5475,7 @@ x_set_offset (struct frame *f, register int xoff, register int yoff,
}
x_calc_absolute_position (f);
- BLOCK_INPUT;
+ block_input ();
x_wm_set_size_hint (f, (long) 0, 0);
modified_left = f->left_pos;
@@ -5372,12 +5486,12 @@ x_set_offset (struct frame *f, register int xoff, register int yoff,
modified_left, modified_top,
0, 0,
SWP_NOZORDER | SWP_NOSIZE | SWP_NOACTIVATE);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Check if we need to resize the frame due to a fullscreen request.
- If so needed, resize the frame. */
+ If so needed, resize the frame. */
static void
x_check_fullscreen (struct frame *f)
{
@@ -5397,7 +5511,7 @@ x_check_fullscreen (struct frame *f)
SET_FRAME_GARBAGED (f);
cancel_mouse_face (f);
- /* Wait for the change of frame size to occur */
+ /* Wait for the change of frame size to occur. */
f->want_fullscreen |= FULLSCREEN_WAIT;
}
}
@@ -5413,7 +5527,7 @@ x_set_window_size (struct frame *f, int change_gravity, int cols, int rows)
{
int pixelwidth, pixelheight;
- BLOCK_INPUT;
+ block_input ();
check_frame_size (f, &rows, &cols);
f->scroll_bar_actual_width
@@ -5493,7 +5607,7 @@ x_set_window_size (struct frame *f, int change_gravity, int cols, int rows)
cancel_mouse_face (f);
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Mouse warping. */
@@ -5523,7 +5637,7 @@ x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y)
RECT rect;
POINT pt;
- BLOCK_INPUT;
+ block_input ();
GetClientRect (FRAME_W32_WINDOW (f), &rect);
pt.x = rect.left + pix_x;
@@ -5532,7 +5646,7 @@ x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y)
SetCursorPos (pt.x, pt.y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -5544,7 +5658,7 @@ x_focus_on_frame (struct frame *f)
struct w32_display_info *dpyinfo = &one_w32_display_info;
/* Give input focus to frame. */
- BLOCK_INPUT;
+ block_input ();
#if 0
/* Try not to change its Z-order if possible. */
if (x_window_to_frame (dpyinfo, GetForegroundWindow ()))
@@ -5552,7 +5666,7 @@ x_focus_on_frame (struct frame *f)
else
#endif
my_set_foreground_window (FRAME_W32_WINDOW (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
void
@@ -5564,7 +5678,7 @@ x_unfocus_frame (struct frame *f)
void
x_raise_frame (struct frame *f)
{
- BLOCK_INPUT;
+ block_input ();
/* Strictly speaking, raise-frame should only change the frame's Z
order, leaving input focus unchanged. This is reasonable behavior
@@ -5596,39 +5710,42 @@ x_raise_frame (struct frame *f)
HDWP handle = BeginDeferWindowPos (2);
if (handle)
{
- DeferWindowPos (handle,
- FRAME_W32_WINDOW (f),
- HWND_TOP,
- 0, 0, 0, 0,
- SWP_NOSIZE | SWP_NOMOVE | SWP_NOACTIVATE);
-
- DeferWindowPos (handle,
- GetForegroundWindow (),
- FRAME_W32_WINDOW (f),
- 0, 0, 0, 0,
- SWP_NOSIZE | SWP_NOMOVE | SWP_NOACTIVATE);
-
- EndDeferWindowPos (handle);
+ handle = DeferWindowPos (handle,
+ FRAME_W32_WINDOW (f),
+ HWND_TOP,
+ 0, 0, 0, 0,
+ SWP_NOSIZE | SWP_NOMOVE | SWP_NOACTIVATE);
+ if (handle)
+ {
+ handle = DeferWindowPos (handle,
+ GetForegroundWindow (),
+ FRAME_W32_WINDOW (f),
+ 0, 0, 0, 0,
+ SWP_NOSIZE | SWP_NOMOVE |
+ SWP_NOACTIVATE);
+ if (handle)
+ EndDeferWindowPos (handle);
+ }
}
}
else
{
- my_set_foreground_window (FRAME_W32_WINDOW (f));
+ my_bring_window_to_top (FRAME_W32_WINDOW (f));
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Lower frame F. */
void
x_lower_frame (struct frame *f)
{
- BLOCK_INPUT;
+ block_input ();
my_set_window_pos (FRAME_W32_WINDOW (f),
HWND_BOTTOM,
0, 0, 0, 0,
SWP_NOSIZE | SWP_NOMOVE | SWP_NOACTIVATE);
- UNBLOCK_INPUT;
+ unblock_input ();
}
static void
@@ -5657,7 +5774,7 @@ x_make_frame_visible (struct frame *f)
{
Lisp_Object type;
- BLOCK_INPUT;
+ block_input ();
type = x_icon_type (f);
if (!NILP (type))
@@ -5709,7 +5826,7 @@ x_make_frame_visible (struct frame *f)
int count;
/* This must come after we set COUNT. */
- UNBLOCK_INPUT;
+ unblock_input ();
XSETFRAME (frame, f);
@@ -5752,7 +5869,7 @@ x_make_frame_invisible (struct frame *f)
if (FRAME_W32_DISPLAY_INFO (f)->x_highlight_frame == f)
FRAME_W32_DISPLAY_INFO (f)->x_highlight_frame = 0;
- BLOCK_INPUT;
+ block_input ();
my_show_window (f, FRAME_W32_WINDOW (f), SW_HIDE);
@@ -5766,7 +5883,7 @@ x_make_frame_invisible (struct frame *f)
f->async_visible = 0;
f->async_iconified = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Change window state from mapped to iconified. */
@@ -5783,7 +5900,7 @@ x_iconify_frame (struct frame *f)
if (f->async_iconified)
return;
- BLOCK_INPUT;
+ block_input ();
type = x_icon_type (f);
if (!NILP (type))
@@ -5792,7 +5909,7 @@ x_iconify_frame (struct frame *f)
/* Simulate the user minimizing the frame. */
SendMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, SC_MINIMIZE, 0);
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -5804,7 +5921,7 @@ x_free_frame_resources (struct frame *f)
struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
- BLOCK_INPUT;
+ block_input ();
/* We must free faces before destroying windows because some
font-driver (e.g. xft) access a window while finishing a
@@ -5848,11 +5965,10 @@ x_free_frame_resources (struct frame *f)
hlinfo->mouse_face_end_row
= hlinfo->mouse_face_end_col = -1;
hlinfo->mouse_face_window = Qnil;
- hlinfo->mouse_face_deferred_gc = 0;
hlinfo->mouse_face_mouse_frame = 0;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -5872,10 +5988,10 @@ x_destroy_window (struct frame *f)
/* Set the normal size hints for the window manager, for frame F.
FLAGS is the flags word to use--or 0 meaning preserve the flags
that the window now has.
- If USER_POSITION is nonzero, we set the USPosition
+ If USER_POSITION, set the USPosition
flag (this is useful when FLAGS is 0). */
void
-x_wm_set_size_hint (struct frame *f, long flags, int user_position)
+x_wm_set_size_hint (struct frame *f, long flags, bool user_position)
{
Window window = FRAME_W32_WINDOW (f);
@@ -5906,6 +6022,27 @@ x_wm_set_icon_position (struct frame *f, int icon_x, int icon_y)
/***********************************************************************
+ Fonts
+ ***********************************************************************/
+
+#ifdef GLYPH_DEBUG
+
+/* Check that FONT is valid on frame F. It is if it can be found in F's
+ font table. */
+
+static void
+x_check_font (struct frame *f, struct font *font)
+{
+ eassert (font != NULL && ! NILP (font->props[FONT_TYPE_INDEX]));
+ if (font->driver->check)
+ eassert (font->driver->check (f, font) == 0);
+}
+
+#endif /* GLYPH_DEBUG */
+
+
+
+/***********************************************************************
Initialization
***********************************************************************/
@@ -5924,10 +6061,8 @@ w32_initialize_display_info (Lisp_Object display_name)
w32_display_name_list);
dpyinfo->name_list_element = XCAR (w32_display_name_list);
- dpyinfo->w32_id_name
- = (char *) xmalloc (SCHARS (Vinvocation_name)
- + SCHARS (Vsystem_name)
- + 2);
+ dpyinfo->w32_id_name = xmalloc (SCHARS (Vinvocation_name)
+ + SCHARS (Vsystem_name) + 2);
sprintf (dpyinfo->w32_id_name, "%s@%s",
SDATA (Vinvocation_name), SDATA (Vsystem_name));
@@ -6092,9 +6227,9 @@ w32_create_terminal (struct w32_display_info *dpyinfo)
/* We don't yet support separate terminals on W32, so don't try to share
keyboards between virtual terminals that are on the same physical
terminal like X does. */
- terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
+ terminal->kboard = xmalloc (sizeof (KBOARD));
init_kboard (terminal->kboard);
- KVAR (terminal->kboard, Vwindow_system) = intern ("w32");
+ kset_window_system (terminal->kboard, intern ("w32"));
terminal->kboard->next_kboard = all_kboards;
all_kboards = terminal->kboard;
/* Don't let the initial kboard remain current longer than necessary.
@@ -6117,10 +6252,10 @@ x_delete_terminal (struct terminal *terminal)
if (!terminal->name)
return;
- BLOCK_INPUT;
+ block_input ();
x_delete_display (dpyinfo);
- UNBLOCK_INPUT;
+ unblock_input ();
}
struct w32_display_info *
@@ -6130,7 +6265,7 @@ w32_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
struct terminal *terminal;
HDC hdc;
- BLOCK_INPUT;
+ block_input ();
if (!w32_initialized)
{
@@ -6144,7 +6279,7 @@ w32_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
terminal = w32_create_terminal (dpyinfo);
/* Set the name of the terminal. */
- terminal->name = (char *) xmalloc (SBYTES (display_name) + 1);
+ terminal->name = xmalloc (SBYTES (display_name) + 1);
strncpy (terminal->name, SDATA (display_name), SBYTES (display_name));
terminal->name[SBYTES (display_name)] = 0;
@@ -6171,8 +6306,15 @@ w32_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
w32_defined_color (0, "black", &color, 1);
}
- /* Add the default keyboard. */
+#ifdef WINDOWSNT
+ /* Add the default keyboard. When !WINDOWSNT, we're using the
+ standard Emacs console handling machinery and don't need an
+ explicit FD here. */
add_keyboard_wait_descriptor (0);
+#elif CYGWIN
+ /* /dev/windows wakes us up when we have a thread message pending. */
+ add_keyboard_wait_descriptor (w32_message_fd);
+#endif
/* Create Fringe Bitmaps and store them for later use.
@@ -6183,16 +6325,7 @@ w32_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
the bitmaps. */
w32_init_fringe (terminal->rif);
-#ifdef F_SETOWN
- fcntl (connection, F_SETOWN, getpid ());
-#endif /* ! defined (F_SETOWN) */
-
-#ifdef SIGIO
- if (interrupt_input)
- init_sigio (connection);
-#endif /* ! defined (SIGIO) */
-
- UNBLOCK_INPUT;
+ unblock_input ();
return dpyinfo;
}
@@ -6241,6 +6374,7 @@ x_delete_display (struct w32_display_info *dpyinfo)
w32_reset_fringes ();
}
+
/* Set up use of W32. */
@@ -6278,6 +6412,11 @@ w32_initialize (void)
set_user_model (L"GNU.Emacs");
}
+#ifdef CYGWIN
+ if ((w32_message_fd = open ("/dev/windows", O_RDWR | O_CLOEXEC)) == -1)
+ fatal ("opening /dev/windows: %s", strerror (errno));
+#endif /* CYGWIN */
+
/* Initialize w32_use_visible_system_caret based on whether a screen
reader is in use. */
if (!SystemParametersInfo (SPI_GETSCREENREADER, 0,
@@ -6293,7 +6432,8 @@ w32_initialize (void)
{
DWORD input_locale_id = (DWORD) GetKeyboardLayout (0);
- keyboard_codepage = codepage_for_locale ((LCID) (input_locale_id & 0xffff));
+ w32_keyboard_codepage =
+ codepage_for_locale ((LCID) (input_locale_id & 0xffff));
}
/* Create the window thread - it will terminate itself when the app
@@ -6411,7 +6551,7 @@ the cursor have no effect. */);
from cus-start.el and other places, like "M-x set-variable". */
DEFVAR_BOOL ("x-use-underline-position-properties",
x_use_underline_position_properties,
- doc: /* *Non-nil means make use of UNDERLINE_POSITION font properties.
+ doc: /* Non-nil means make use of UNDERLINE_POSITION font properties.
A value of nil means ignore them. If you encounter fonts with bogus
UNDERLINE_POSITION font properties, for example 7x13 on XFree prior
to 4.1, set this to nil. You can also use `underline-minimum-offset'
@@ -6421,7 +6561,7 @@ sizes. */);
DEFVAR_BOOL ("x-underline-at-descent-line",
x_underline_at_descent_line,
- doc: /* *Non-nil means to draw the underline at the same place as the descent line.
+ doc: /* Non-nil means to draw the underline at the same place as the descent line.
A value of nil means to draw the underline according to the value of the
variable `x-use-underline-position-properties', which is usually at the
baseline level. The default value is nil. */);
@@ -6432,9 +6572,11 @@ baseline level. The default value is nil. */);
A value of nil means Emacs doesn't use toolkit scroll bars.
With the X Window system, the value is a symbol describing the
X toolkit. Possible values are: gtk, motif, xaw, or xaw3d.
-With MS Windows, the value is t. */);
+With MS Windows or Nextstep, the value is t. */);
Vx_toolkit_scroll_bars = Qt;
staticpro (&last_mouse_motion_frame);
last_mouse_motion_frame = Qnil;
+
+ Fprovide (intern_c_string ("w32"), Qnil);
}
diff --git a/src/w32term.h b/src/w32term.h
index f587ee11af9..28d4ca6c490 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -1,5 +1,5 @@
-/* Definitions and headers for communication on the Microsoft W32 API.
- Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
+/* Definitions and headers for communication on the Microsoft Windows API.
+ Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,6 +19,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Added by Kevin Gallo */
#include "w32gui.h"
+#include "frame.h"
+#include "atimer.h"
#define BLACK_PIX_DEFAULT(f) PALETTERGB(0,0,0)
@@ -195,11 +197,47 @@ Lisp_Object display_x_get_resource (struct w32_display_info *,
Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
+extern void x_focus_on_frame (struct frame *f);
+
+/* also defined in xterm.h XXX: factor out to common header */
+
extern struct w32_display_info *w32_term_init (Lisp_Object,
char *, char *);
-
+extern void check_w32 (void);
+extern int w32_defined_color (FRAME_PTR f, const char *color,
+ XColor *color_def, int alloc);
+extern void x_set_window_size (struct frame *f, int change_grav,
+ int cols, int rows);
extern int x_display_pixel_height (struct w32_display_info *);
extern int x_display_pixel_width (struct w32_display_info *);
+extern void x_sync (struct frame *);
+extern Lisp_Object x_get_focus_frame (struct frame *);
+extern void x_set_mouse_position (struct frame *f, int h, int v);
+extern void x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y);
+extern void x_make_frame_visible (struct frame *f);
+extern void x_make_frame_invisible (struct frame *f);
+extern void x_iconify_frame (struct frame *f);
+extern int x_char_width (struct frame *f);
+extern int x_char_height (struct frame *f);
+extern int x_pixel_width (struct frame *f);
+extern int x_pixel_height (struct frame *f);
+extern void x_set_frame_alpha (struct frame *f);
+extern void x_set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
+extern void x_set_tool_bar_lines (struct frame *f,
+ Lisp_Object value,
+ Lisp_Object oldval);
+extern void x_activate_menubar (struct frame *);
+extern int x_bitmap_icon (struct frame *, Lisp_Object);
+extern void initialize_frame_menubar (struct frame *);
+extern void x_free_frame_resources (struct frame *);
+extern void x_real_positions (struct frame *, int *, int *);
+
+/* w32inevt.c */
+extern int w32_kbd_patch_key (KEY_EVENT_RECORD *event, int cpId);
+extern int w32_kbd_mods_to_emacs (DWORD mods, WORD key);
+
+
+extern Lisp_Object x_get_focus_frame (struct frame *);
#define PIX_TYPE COLORREF
@@ -213,16 +251,10 @@ extern int x_display_pixel_width (struct w32_display_info *);
diffs between X and w32 code. */
struct x_output
{
-#if 0 /* These are also defined in struct frame. Use that instead. */
- PIX_TYPE background_pixel;
- PIX_TYPE foreground_pixel;
-#endif
-
/* Keep track of focus. May be EXPLICIT if we received a FocusIn for this
frame, or IMPLICIT if we received an EnterNotify.
FocusOut and LeaveNotify clears EXPLICIT/IMPLICIT. */
int focus_state;
-
};
enum
@@ -302,9 +334,6 @@ struct w32_output
/* Non-hourglass cursor that is currently active. */
Cursor current_cursor;
- /* Flag to set when the window needs to be completely repainted. */
- int needs_exposure;
-
DWORD dwStyle;
/* This is the Emacs structure for the display this frame is on. */
@@ -312,17 +341,13 @@ struct w32_output
/* Nonzero means our parent is another application's window
and was explicitly specified. */
- char explicit_parent;
+ unsigned explicit_parent : 1;
/* Nonzero means tried already to make this frame visible. */
- char asked_for_visible;
+ unsigned asked_for_visible : 1;
/* Nonzero means menubar is currently active. */
- char menubar_active;
-
- /* Nonzero means menubar is about to become active, but should be
- brought up to date first. */
- volatile char pending_menu_activation;
+ unsigned menubar_active : 1;
/* Relief GCs, colors etc. */
struct relief
@@ -345,7 +370,7 @@ extern struct w32_output w32term_display;
/* Return the window associated with the frame F. */
#define FRAME_W32_WINDOW(f) ((f)->output_data.w32->window_desc)
-#define FRAME_X_WINDOW(f) ((f)->output_data.w32->window_desc)
+#define FRAME_X_WINDOW(f) FRAME_W32_WINDOW (f)
#define FRAME_FONT(f) ((f)->output_data.w32->font)
#define FRAME_FONTSET(f) ((f)->output_data.w32->fontset)
@@ -380,9 +405,8 @@ extern struct w32_output w32term_display;
struct scroll_bar {
- /* These fields are shared by all vectors. */
- EMACS_INT size_from_Lisp_Vector_struct;
- struct Lisp_Vector *next_from_Lisp_Vector_struct;
+ /* This field is shared by all vectors. */
+ struct vectorlike_header header;
/* The window we're a scroll bar for. */
Lisp_Object window;
@@ -425,16 +449,18 @@ struct scroll_bar {
Lisp_Object fringe_extended_p;
};
-/* The number of elements a vector holding a struct scroll_bar needs. */
-#define SCROLL_BAR_VEC_SIZE \
- ((sizeof (struct scroll_bar) \
- - sizeof (EMACS_INT) - sizeof (struct Lisp_Vector *)) \
- / sizeof (Lisp_Object))
-
/* Turning a lisp vector value into a pointer to a struct scroll_bar. */
#define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec))
+#ifdef _WIN64
+/* Building a 64-bit C integer from two 32-bit lisp integers. */
+#define SCROLL_BAR_PACK(low, high) (XINT (high) << 32 | XINT (low))
+/* Setting two lisp integers to the low and high words of a 64-bit C int. */
+#define SCROLL_BAR_UNPACK(low, high, int64) \
+ (XSETINT ((low), ((DWORDLONG)(int64)) & 0xffffffff), \
+ XSETINT ((high), ((DWORDLONG)(int64) >> 32) & 0xffffffff))
+#else /* not _WIN64 */
/* Building a 32-bit C integer from two 16-bit lisp integers. */
#define SCROLL_BAR_PACK(low, high) (XINT (high) << 16 | XINT (low))
@@ -442,7 +468,7 @@ struct scroll_bar {
#define SCROLL_BAR_UNPACK(low, high, int32) \
(XSETINT ((low), (int32) & 0xffff), \
XSETINT ((high), ((int32) >> 16) & 0xffff))
-
+#endif /* not _WIN64 */
/* Extract the window id of the scroll bar from a struct scroll_bar. */
#define SCROLL_BAR_W32_WINDOW(ptr) \
@@ -450,7 +476,7 @@ struct scroll_bar {
/* Store a window id in a struct scroll_bar. */
#define SET_SCROLL_BAR_W32_WINDOW(ptr, id) \
- (SCROLL_BAR_UNPACK ((ptr)->w32_window_low, (ptr)->w32_window_high, (int) id))
+ (SCROLL_BAR_UNPACK ((ptr)->w32_window_low, (ptr)->w32_window_high, (intptr_t) id))
/* Extract the X widget of the scroll bar from a struct scroll_bar. */
#define SCROLL_BAR_X_WIDGET(ptr) \
@@ -576,7 +602,9 @@ do { \
#define WM_EMACS_HIDE_CARET (WM_EMACS_START + 18)
#define WM_EMACS_SETCURSOR (WM_EMACS_START + 19)
#define WM_EMACS_PAINT (WM_EMACS_START + 20)
-#define WM_EMACS_END (WM_EMACS_START + 21)
+#define WM_EMACS_BRINGTOTOP (WM_EMACS_START + 21)
+#define WM_EMACS_INPUT_READY (WM_EMACS_START + 22)
+#define WM_EMACS_END (WM_EMACS_START + 23)
#define WND_FONTWIDTH_INDEX (0)
#define WND_LINEHEIGHT_INDEX (4)
@@ -598,6 +626,8 @@ typedef struct W32Msg {
RECT rect;
} W32Msg;
+extern BOOL prepend_msg (W32Msg *lpmsg);
+
/* Structure for recording message when input thread must return a
result that depends on lisp thread to compute. Lisp thread can
complete deferred messages out of order. */
@@ -634,6 +664,9 @@ extern BOOL parse_button (int, int, int *, int *);
extern void w32_sys_ring_bell (struct frame *f);
extern void x_delete_display (struct w32_display_info *dpyinfo);
+extern void w32_initialize_display_info (Lisp_Object);
+extern void initialize_w32_display (struct terminal *);
+
/* Keypad command key support. W32 doesn't have virtual keys defined
for the function keys on the keypad (they are mapped to the standard
@@ -666,6 +699,9 @@ extern void x_delete_display (struct w32_display_info *dpyinfo);
#define RIGHT_WIN_PRESSED 0x4000
#define APPS_PRESSED 0x2000
+/* The current ANSI input codepage for GUI sessions. */
+extern int w32_keyboard_codepage;
+
/* When compiling on Windows 9x/ME and NT 3.x, the following are not defined
(even though they are supported on 98 and ME. */
#ifndef WM_MOUSELEAVE
@@ -687,9 +723,6 @@ struct face;
XGCValues *XCreateGC (void *, Window, unsigned long, XGCValues *);
struct frame * check_x_frame (Lisp_Object);
-EXFUN (Fx_display_color_p, 1);
-EXFUN (Fx_display_grayscale_p, 1);
-
typedef DWORD (WINAPI * ClipboardSequence_Proc) (void);
typedef BOOL (WINAPI * AppendMenuW_Proc) (
IN HMENU,
@@ -701,3 +734,34 @@ extern HWND w32_system_caret_hwnd;
extern int w32_system_caret_height;
extern int w32_system_caret_x;
extern int w32_system_caret_y;
+
+#ifdef _MSC_VER
+#ifndef EnumSystemLocales
+/* MSVC headers define these only for _WIN32_WINNT >= 0x0500. */
+typedef BOOL (CALLBACK *LOCALE_ENUMPROCA)(LPSTR);
+typedef BOOL (CALLBACK *LOCALE_ENUMPROCW)(LPWSTR);
+BOOL WINAPI EnumSystemLocalesA(LOCALE_ENUMPROCA,DWORD);
+BOOL WINAPI EnumSystemLocalesW(LOCALE_ENUMPROCW,DWORD);
+#ifdef UNICODE
+#define EnumSystemLocales EnumSystemLocalesW
+#else
+#define EnumSystemLocales EnumSystemLocalesA
+#endif
+#endif
+#endif
+
+#if EMACSDEBUG
+extern const char*
+w32_name_of_message (UINT msg);
+#endif /* EMACSDEBUG */
+
+extern void syms_of_w32term (void);
+extern void syms_of_w32menu (void);
+extern void syms_of_w32fns (void);
+
+extern void globals_of_w32menu (void);
+extern void globals_of_w32fns (void);
+
+#ifdef CYGWIN
+extern int w32_message_fd;
+#endif /* CYGWIN */
diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c
index 63da3b9e962..5d160b9d42f 100644
--- a/src/w32uniscribe.c
+++ b/src/w32uniscribe.c
@@ -1,5 +1,5 @@
/* Font backend for the Microsoft W32 Uniscribe API.
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -27,7 +27,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define _WIN32_WINNT 0x500
#include <windows.h>
#include <usp10.h>
-#include <setjmp.h>
#include "lisp.h"
#include "w32term.h"
@@ -231,7 +230,7 @@ uniscribe_shape (Lisp_Object lgstring)
/* First we need to break up the glyph string into runs of glyphs that
can be treated together. First try a single run. */
max_items = 2;
- items = (SCRIPT_ITEM *) xmalloc (sizeof (SCRIPT_ITEM) * max_items + 1);
+ items = xmalloc (sizeof (SCRIPT_ITEM) * max_items + 1);
while ((result = ScriptItemize (chars, nchars, max_items, NULL, NULL,
items, &nitems)) == E_OUTOFMEMORY)
@@ -320,7 +319,7 @@ uniscribe_shape (Lisp_Object lgstring)
}
if (SUCCEEDED (result))
{
- int j, from, to;
+ int j, from, to, adj_offset = 0;
from = 0;
to = from;
@@ -364,6 +363,32 @@ uniscribe_shape (Lisp_Object lgstring)
}
}
}
+
+ /* For RTL text, the Uniscribe shaper prepares
+ the values in ADVANCES array for layout in
+ reverse order, whereby "advance width" is
+ applied to move the pen in reverse direction
+ and _before_ drawing the glyph. Since we
+ draw glyphs in their normal left-to-right
+ order, we need to adjust the coordinates of
+ each non-base glyph in a grapheme cluster via
+ X-OFF component of the gstring's ADJUSTMENT
+ sub-vector. This loop computes, for each
+ grapheme cluster, the initial value of the
+ adjustment for the base character, which is
+ then updated for each successive glyph in the
+ grapheme cluster. */
+ if (items[i].a.fRTL)
+ {
+ int j1 = j;
+
+ adj_offset = 0;
+ while (j1 < nglyphs && !attributes[j1].fClusterStart)
+ {
+ adj_offset += advances[j1];
+ j1++;
+ }
+ }
}
LGLYPH_SET_CHAR (lglyph, chars[items[i].iCharPos
@@ -392,9 +417,11 @@ uniscribe_shape (Lisp_Object lgstring)
if (SUCCEEDED (result))
{
- LGLYPH_SET_LBEARING (lglyph, char_metric.abcA);
- LGLYPH_SET_RBEARING (lglyph, (char_metric.abcA
- + char_metric.abcB));
+ int lbearing = char_metric.abcA;
+ int rbearing = char_metric.abcA + char_metric.abcB;
+
+ LGLYPH_SET_LBEARING (lglyph, lbearing);
+ LGLYPH_SET_RBEARING (lglyph, rbearing);
}
else
{
@@ -402,18 +429,47 @@ uniscribe_shape (Lisp_Object lgstring)
LGLYPH_SET_RBEARING (lglyph, advances[j]);
}
- if (offsets[j].du || offsets[j].dv)
+ if (offsets[j].du || offsets[j].dv
+ /* For non-base glyphs of RTL grapheme clusters,
+ adjust the X offset even if both DU and DV
+ are zero. */
+ || (!attributes[j].fClusterStart && items[i].a.fRTL))
{
Lisp_Object vec;
vec = Fmake_vector (make_number (3), Qnil);
- ASET (vec, 0, make_number (offsets[j].du));
- ASET (vec, 1, make_number (offsets[j].dv));
+ if (items[i].a.fRTL)
+ {
+ /* Empirically, it looks like Uniscribe
+ interprets DU in reverse direction for
+ RTL clusters. E.g., if we don't reverse
+ the direction, the Hebrew point HOLAM is
+ drawn above the right edge of the base
+ consonant, instead of above the left edge. */
+ ASET (vec, 0, make_number (-offsets[j].du
+ + adj_offset));
+ /* Update the adjustment value for the width
+ advance of the glyph we just emitted. */
+ adj_offset -= 2 * advances[j];
+ }
+ else
+ ASET (vec, 0, make_number (offsets[j].du + adj_offset));
+ /* In the font definition coordinate system, the
+ Y coordinate points up, while in our screen
+ coordinates Y grows downwards. So we need to
+ reverse the sign of Y-OFFSET here. */
+ ASET (vec, 1, make_number (-offsets[j].dv));
/* Based on what ftfont.c does... */
ASET (vec, 2, make_number (advances[j]));
LGLYPH_SET_ADJUSTMENT (lglyph, vec);
}
else
- LGLYPH_SET_ADJUSTMENT (lglyph, Qnil);
+ {
+ LGLYPH_SET_ADJUSTMENT (lglyph, Qnil);
+ /* Update the adjustment value to compensate for
+ the width of the base character. */
+ if (items[i].a.fRTL)
+ adj_offset -= advances[j];
+ }
}
}
}
diff --git a/src/w32xfns.c b/src/w32xfns.c
index fc2d5904d67..cb452571665 100644
--- a/src/w32xfns.c
+++ b/src/w32xfns.c
@@ -1,5 +1,5 @@
-/* Functions taken directly from X sources for use with the Microsoft W32 API.
- Copyright (C) 1989, 1992-1995, 1999, 2001-2011 Free Software Foundation, Inc.
+/* Functions taken directly from X sources for use with the Microsoft Windows API.
+ Copyright (C) 1989, 1992-1995, 1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,7 +19,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "keyboard.h"
#include "frame.h"
@@ -33,7 +33,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define myfree(lp) GlobalFreePtr (lp)
CRITICAL_SECTION critsect;
+
+#ifdef WINDOWSNT
extern HANDLE keyboard_handle;
+#endif /* WINDOWSNT */
+
HANDLE input_available = NULL;
HANDLE interrupt_handle = NULL;
@@ -44,7 +48,11 @@ init_crit (void)
/* For safety, input_available should only be reset by get_next_msg
when the input queue is empty, so make it a manual reset event. */
- keyboard_handle = input_available = CreateEvent (NULL, TRUE, FALSE, NULL);
+ input_available = CreateEvent (NULL, TRUE, FALSE, NULL);
+
+#ifdef WINDOWSNT
+ keyboard_handle = input_available;
+#endif /* WINDOWSNT */
/* interrupt_handle is signaled when quit (C-g) is detected, so that
blocking system calls can be interrupted. We make it a manual
@@ -122,7 +130,7 @@ get_frame_dc (FRAME_PTR f)
HDC hdc;
if (f->output_method != output_w32)
- abort ();
+ emacs_abort ();
enter_crit ();
@@ -241,6 +249,22 @@ get_next_msg (W32Msg * lpmsg, BOOL bWait)
return (bRet);
}
+extern char * w32_strerror (int error_no);
+
+/* Tell the main thread that we have input available; if the main
+ thread is blocked in select(), we wake it up here. */
+static void
+notify_msg_ready (void)
+{
+ SetEvent (input_available);
+
+#ifdef CYGWIN
+ /* Wakes up the main thread, which is blocked select()ing for /dev/windows,
+ among other files. */
+ (void) PostThreadMessage (dwMainThreadId, WM_EMACS_INPUT_READY, 0, 0);
+#endif /* CYGWIN */
+}
+
BOOL
post_msg (W32Msg * lpmsg)
{
@@ -264,8 +288,7 @@ post_msg (W32Msg * lpmsg)
}
lpTail = lpNew;
- SetEvent (input_available);
-
+ notify_msg_ready ();
leave_crit ();
return (TRUE);
@@ -286,7 +309,7 @@ prepend_msg (W32Msg *lpmsg)
nQueue++;
lpNew->lpNext = lpHead;
lpHead = lpNew;
-
+ notify_msg_ready ();
leave_crit ();
return (TRUE);
@@ -304,140 +327,8 @@ drain_message_queue (void)
}
}
-
-/*
- * XParseGeometry parses strings of the form
- * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
- * width, height, xoffset, and yoffset are unsigned integers.
- * Example: "=80x24+300-49"
- * The equal sign is optional.
- * It returns a bitmask that indicates which of the four values
- * were actually found in the string. For each value found,
- * the corresponding argument is updated; for each value
- * not found, the corresponding argument is left unchanged.
- */
-
-static int
-read_integer (register char *string, char **NextString)
-{
- register int Result = 0;
- int Sign = 1;
-
- if (*string == '+')
- string++;
- else if (*string == '-')
- {
- string++;
- Sign = -1;
- }
- for (; (*string >= '0') && (*string <= '9'); string++)
- {
- Result = (Result * 10) + (*string - '0');
- }
- *NextString = string;
- if (Sign >= 0)
- return (Result);
- else
- return (-Result);
-}
-
-int
-XParseGeometry (char *string,
- int *x, int *y,
- unsigned int *width, unsigned int *height)
-{
- int mask = NoValue;
- register char *strind;
- unsigned int tempWidth, tempHeight;
- int tempX, tempY;
- char *nextCharacter;
-
- if ((string == NULL) || (*string == '\0')) return (mask);
- if (*string == '=')
- string++; /* ignore possible '=' at beg of geometry spec */
-
- strind = (char *)string;
- if (*strind != '+' && *strind != '-' && *strind != 'x')
- {
- tempWidth = read_integer (strind, &nextCharacter);
- if (strind == nextCharacter)
- return (0);
- strind = nextCharacter;
- mask |= WidthValue;
- }
-
- if (*strind == 'x' || *strind == 'X')
- {
- strind++;
- tempHeight = read_integer (strind, &nextCharacter);
- if (strind == nextCharacter)
- return (0);
- strind = nextCharacter;
- mask |= HeightValue;
- }
-
- if ((*strind == '+') || (*strind == '-'))
- {
- if (*strind == '-')
- {
- strind++;
- tempX = -read_integer (strind, &nextCharacter);
- if (strind == nextCharacter)
- return (0);
- strind = nextCharacter;
- mask |= XNegative;
-
- }
- else
- {
- strind++;
- tempX = read_integer (strind, &nextCharacter);
- if (strind == nextCharacter)
- return (0);
- strind = nextCharacter;
- }
- mask |= XValue;
- if ((*strind == '+') || (*strind == '-'))
- {
- if (*strind == '-')
- {
- strind++;
- tempY = -read_integer (strind, &nextCharacter);
- if (strind == nextCharacter)
- return (0);
- strind = nextCharacter;
- mask |= YNegative;
- }
- else
- {
- strind++;
- tempY = read_integer (strind, &nextCharacter);
- if (strind == nextCharacter)
- return (0);
- strind = nextCharacter;
- }
- mask |= YValue;
- }
- }
-
- /* If strind isn't at the end of the string then it's an invalid
- geometry specification. */
-
- if (*strind != '\0') return (0);
-
- if (mask & XValue)
- *x = tempX;
- if (mask & YValue)
- *y = tempY;
- if (mask & WidthValue)
- *width = tempWidth;
- if (mask & HeightValue)
- *height = tempHeight;
- return (mask);
-}
-
/* x_sync is a no-op on W32. */
void
-x_sync (void *f)
+x_sync (struct frame *f)
{
}
diff --git a/src/widget.c b/src/widget.c
index 96bfd4787e9..b4f7335c652 100644
--- a/src/widget.c
+++ b/src/widget.c
@@ -1,5 +1,5 @@
/* The emacs frame widget.
- Copyright (C) 1992-1993, 2000-2011 Free Software Foundation, Inc.
+ Copyright (C) 1992-1993, 2000-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -30,7 +30,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "xterm.h"
@@ -50,9 +50,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <X11/ShellP.h>
#include "../lwlib/lwlib.h"
-#include <signal.h>
-#include "syssignal.h"
-
#include "character.h"
#include "font.h"
@@ -226,7 +223,7 @@ get_wm_shell (Widget w)
static void
mark_shell_size_user_specified (Widget wmshell)
{
- if (! XtIsWMShell (wmshell)) abort ();
+ if (! XtIsWMShell (wmshell)) emacs_abort ();
/* This is kind of sleazy, but I can't see how else to tell it to make it
mark the WM_SIZE_HINTS size as user specified when appropriate. */
((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;
@@ -290,7 +287,7 @@ set_frame_size (EmacsFrame ew)
Widget wmshell = get_wm_shell ((Widget) ew);
/* Each Emacs shell is now independent and top-level. */
- if (! XtIsSubclass (wmshell, shellWidgetClass)) abort ();
+ if (! XtIsSubclass (wmshell, shellWidgetClass)) emacs_abort ();
/* We don't need this for the moment. The geometry is computed in
xfns.c. */
@@ -429,25 +426,15 @@ set_frame_size (EmacsFrame ew)
{
/* the tricky things with the sign is to make sure that
-0 is printed -0. */
- int len;
- char *tem;
sprintf (shell_position, "=%c%d%c%d",
flags & XNegative ? '-' : '+', x < 0 ? -x : x,
flags & YNegative ? '-' : '+', y < 0 ? -y : y);
- len = strlen (shell_position) + 1;
- tem = (char *) xmalloc (len);
- strncpy (tem, shell_position, len);
- XtVaSetValues (wmshell, XtNgeometry, tem, NULL);
+ XtVaSetValues (wmshell, XtNgeometry, xstrdup (shell_position), NULL);
}
else if (flags & (WidthValue | HeightValue))
{
- int len;
- char *tem;
sprintf (shell_position, "=%dx%d", pixel_width, pixel_height);
- len = strlen (shell_position) + 1;
- tem = (char *) xmalloc (len);
- strncpy (tem, shell_position, len);
- XtVaSetValues (wmshell, XtNgeometry, tem, NULL);
+ XtVaSetValues (wmshell, XtNgeometry, xstrdup (shell_position), NULL);
}
/* If the geometry spec we're using has W/H components, mark the size
@@ -663,6 +650,16 @@ EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2)
set_frame_size (ew);
}
+static void
+resize_cb (Widget widget,
+ XtPointer closure,
+ XEvent* event,
+ Boolean* continue_to_dispatch)
+{
+ EmacsFrame ew = (EmacsFrame) widget;
+ EmacsFrameResize (widget);
+}
+
static void
EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs)
@@ -678,27 +675,28 @@ EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs
*mask |= CWEventMask;
XtCreateWindow (widget, InputOutput, (Visual *)CopyFromParent, *mask,
attrs);
+ /* Some ConfigureNotify events does not end up in EmacsFrameResize so
+ make sure we get them all. Seen with xfcwm4 for example. */
+ XtAddRawEventHandler (widget, StructureNotifyMask, False, resize_cb, NULL);
update_wm_hints (ew);
}
-extern void free_frame_faces (struct frame *);
-
static void
EmacsFrameDestroy (Widget widget)
{
EmacsFrame ew = (EmacsFrame) widget;
struct frame* s = ew->emacs_frame.frame;
- if (! s) abort ();
- if (! s->output_data.x) abort ();
+ if (! s) emacs_abort ();
+ if (! s->output_data.x) emacs_abort ();
- BLOCK_INPUT;
+ block_input ();
x_free_gcs (s);
if (s->output_data.x->white_relief.gc)
XFreeGC (XtDisplay (widget), s->output_data.x->white_relief.gc);
if (s->output_data.x->black_relief.gc)
XFreeGC (XtDisplay (widget), s->output_data.x->black_relief.gc);
- UNBLOCK_INPUT;
+ unblock_input ();
}
static void
@@ -706,15 +704,22 @@ EmacsFrameResize (Widget widget)
{
EmacsFrame ew = (EmacsFrame)widget;
struct frame *f = ew->emacs_frame.frame;
+ struct x_output *x = f->output_data.x;
int columns;
int rows;
pixel_to_char_size (ew, ew->core.width, ew->core.height, &columns, &rows);
- change_frame_size (f, rows, columns, 0, 1, 0);
- update_wm_hints (ew);
- update_various_frame_slots (ew);
+ if (columns != FRAME_COLS (f)
+ || rows != FRAME_LINES (f)
+ || ew->core.width != FRAME_PIXEL_WIDTH (f)
+ || ew->core.height + x->menubar_height != FRAME_PIXEL_HEIGHT (f))
+ {
+ change_frame_size (f, rows, columns, 0, 1, 0);
+ update_wm_hints (ew);
+ update_various_frame_slots (ew);
- cancel_mouse_face (f);
+ cancel_mouse_face (f);
+ }
}
static Boolean
diff --git a/src/widget.h b/src/widget.h
index 11041d54ad0..03838a01415 100644
--- a/src/widget.h
+++ b/src/widget.h
@@ -1,5 +1,5 @@
/* The emacs frame widget public header file.
- Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/widgetprv.h b/src/widgetprv.h
index 997a70e026c..00e3eeb1ee1 100644
--- a/src/widgetprv.h
+++ b/src/widgetprv.h
@@ -1,5 +1,5 @@
/* The emacs frame widget private header file.
- Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/window.c b/src/window.c
index ef61d668499..9f3474fcd53 100644
--- a/src/window.c
+++ b/src/window.c
@@ -1,6 +1,6 @@
/* Window creation, deletion and examination for GNU Emacs.
Does not include redisplay.
- Copyright (C) 1985-1987, 1993-1998, 2000-2011
+ Copyright (C) 1985-1987, 1993-1998, 2000-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,10 +19,13 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+
+#define WINDOW_INLINE EXTERN_INLINE
+
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "keyboard.h"
#include "keymap.h"
@@ -40,7 +43,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_X_WINDOWS
#include "xterm.h"
#endif /* HAVE_X_WINDOWS */
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
#include "w32term.h"
#endif
#ifdef MSDOS
@@ -51,19 +54,18 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
Lisp_Object Qwindowp, Qwindow_live_p;
+static Lisp_Object Qwindow_valid_p;
static Lisp_Object Qwindow_configuration_p, Qrecord_window_buffer;
static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer;
static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window;
static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically;
static Lisp_Object Qscroll_up, Qscroll_down, Qscroll_command;
-static Lisp_Object Qsafe, Qabove, Qbelow;
-static Lisp_Object Qauto_buffer_name;
+static Lisp_Object Qsafe, Qabove, Qbelow, Qwindow_size, Qclone_of;
static int displayed_window_lines (struct window *);
-static struct window *decode_window (Lisp_Object);
static int count_windows (struct window *);
static int get_leaf_windows (struct window *, struct window **, int);
-static void window_scroll (Lisp_Object, int, int, int);
+static void window_scroll (Lisp_Object, EMACS_INT, int, int);
static void window_scroll_pixel_based (Lisp_Object, int, int, int);
static void window_scroll_line_based (Lisp_Object, int, int, int);
static int freeze_window_start (struct window *, void *);
@@ -127,11 +129,113 @@ static int window_scroll_pixel_based_preserve_x;
static int window_scroll_pixel_based_preserve_y;
/* Same for window_scroll_line_based. */
-static int window_scroll_preserve_hpos;
-static int window_scroll_preserve_vpos;
+static EMACS_INT window_scroll_preserve_hpos;
+static EMACS_INT window_scroll_preserve_vpos;
-static struct window *
-decode_window (register Lisp_Object window)
+/* These setters are used only in this file, so they can be private. */
+static void
+wset_combination_limit (struct window *w, Lisp_Object val)
+{
+ w->combination_limit = val;
+}
+static void
+wset_dedicated (struct window *w, Lisp_Object val)
+{
+ w->dedicated = val;
+}
+static void
+wset_display_table (struct window *w, Lisp_Object val)
+{
+ w->display_table = val;
+}
+static void
+wset_hchild (struct window *w, Lisp_Object val)
+{
+ w->hchild = val;
+}
+static void
+wset_left_fringe_width (struct window *w, Lisp_Object val)
+{
+ w->left_fringe_width = val;
+}
+static void
+wset_left_margin_cols (struct window *w, Lisp_Object val)
+{
+ w->left_margin_cols = val;
+}
+static void
+wset_new_normal (struct window *w, Lisp_Object val)
+{
+ w->new_normal = val;
+}
+static void
+wset_new_total (struct window *w, Lisp_Object val)
+{
+ w->new_total = val;
+}
+static void
+wset_normal_cols (struct window *w, Lisp_Object val)
+{
+ w->normal_cols = val;
+}
+static void
+wset_normal_lines (struct window *w, Lisp_Object val)
+{
+ w->normal_lines = val;
+}
+static void
+wset_parent (struct window *w, Lisp_Object val)
+{
+ w->parent = val;
+}
+static void
+wset_pointm (struct window *w, Lisp_Object val)
+{
+ w->pointm = val;
+}
+static void
+wset_right_fringe_width (struct window *w, Lisp_Object val)
+{
+ w->right_fringe_width = val;
+}
+static void
+wset_right_margin_cols (struct window *w, Lisp_Object val)
+{
+ w->right_margin_cols = val;
+}
+static void
+wset_scroll_bar_width (struct window *w, Lisp_Object val)
+{
+ w->scroll_bar_width = val;
+}
+static void
+wset_start (struct window *w, Lisp_Object val)
+{
+ w->start = val;
+}
+static void
+wset_temslot (struct window *w, Lisp_Object val)
+{
+ w->temslot = val;
+}
+static void
+wset_vchild (struct window *w, Lisp_Object val)
+{
+ w->vchild = val;
+}
+static void
+wset_vertical_scroll_bar_type (struct window *w, Lisp_Object val)
+{
+ w->vertical_scroll_bar_type = val;
+}
+static void
+wset_window_parameters (struct window *w, Lisp_Object val)
+{
+ w->window_parameters = val;
+}
+
+struct window *
+decode_live_window (register Lisp_Object window)
{
if (NILP (window))
return XWINDOW (selected_window);
@@ -140,14 +244,39 @@ decode_window (register Lisp_Object window)
return XWINDOW (window);
}
-static struct window *
+struct window *
decode_any_window (register Lisp_Object window)
{
+ struct window *w;
+
if (NILP (window))
return XWINDOW (selected_window);
CHECK_WINDOW (window);
- return XWINDOW (window);
+ w = XWINDOW (window);
+ return w;
+}
+
+static struct window *
+decode_valid_window (register Lisp_Object window)
+{
+ struct window *w;
+
+ if (NILP (window))
+ return XWINDOW (selected_window);
+
+ CHECK_VALID_WINDOW (window);
+ w = XWINDOW (window);
+ return w;
+}
+
+/* Build a frequently used 4-integer (X Y W H) list. */
+
+static Lisp_Object
+list4i (EMACS_INT x, EMACS_INT y, EMACS_INT w, EMACS_INT h)
+{
+ return list4 (make_number (x), make_number (y),
+ make_number (w), make_number (h));
}
DEFUN ("windowp", Fwindowp, Swindowp, 1, 1, 0,
@@ -157,6 +286,15 @@ DEFUN ("windowp", Fwindowp, Swindowp, 1, 1, 0,
return WINDOWP (object) ? Qt : Qnil;
}
+DEFUN ("window-valid-p", Fwindow_valid_p, Swindow_valid_p, 1, 1, 0,
+ doc: /* Return t if OBJECT is a valid window and nil otherwise.
+A valid window is either a window that displays a buffer or an internal
+window. Deleted windows are not live. */)
+ (Lisp_Object object)
+{
+ return WINDOW_VALID_P (object) ? Qt : Qnil;
+}
+
DEFUN ("window-live-p", Fwindow_live_p, Swindow_live_p, 1, 1, 0,
doc: /* Return t if OBJECT is a live window and nil otherwise.
A live window is a window that displays a buffer.
@@ -167,12 +305,12 @@ Internal windows and deleted windows are not live. */)
}
/* Frames and windows. */
-DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
+DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 0, 1, 0,
doc: /* Return the frame that window WINDOW is on.
-If WINDOW is omitted or nil, it defaults to the selected window. */)
+WINDOW must be a valid window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_any_window (window)->frame;
+ return decode_valid_window (window)->frame;
}
DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
@@ -186,8 +324,8 @@ With a window argument, return the root window of that window's frame. */)
if (NILP (frame_or_window))
window = SELECTED_FRAME ()->root_window;
- else if (WINDOWP (frame_or_window))
- window = XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window)))->root_window;
+ else if (WINDOW_VALID_P (frame_or_window))
+ window = XFRAME (XWINDOW (frame_or_window)->frame)->root_window;
else
{
CHECK_LIVE_FRAME (frame_or_window);
@@ -202,27 +340,24 @@ DEFUN ("minibuffer-window", Fminibuffer_window, Sminibuffer_window, 0, 1, 0,
If FRAME is omitted or nil, it defaults to the selected frame. */)
(Lisp_Object frame)
{
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- return FRAME_MINIBUF_WINDOW (XFRAME (frame));
+ return FRAME_MINIBUF_WINDOW (decode_live_frame (frame));
}
DEFUN ("window-minibuffer-p", Fwindow_minibuffer_p,
Swindow_minibuffer_p, 0, 1, 0,
doc: /* Return non-nil if WINDOW is a minibuffer window.
-If WINDOW is omitted or nil, it defaults to the selected window. */)
+WINDOW must be a valid window and defaults to the selected one. */)
(Lisp_Object window)
{
- return MINI_WINDOW_P (decode_any_window (window)) ? Qt : Qnil;
+ return MINI_WINDOW_P (decode_valid_window (window)) ? Qt : Qnil;
}
/* Don't move this to window.el - this must be a safe routine. */
DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0,
doc: /* Return the topmost, leftmost live window on FRAME-OR-WINDOW.
If omitted, FRAME-OR-WINDOW defaults to the currently selected frame.
-Else if FRAME-OR-WINDOW denotes any window, return the first window of
-that window's frame. If FRAME-OR-WINDOW denotes a live frame, return
+Else if FRAME-OR-WINDOW denotes a valid window, return the first window
+of that window's frame. If FRAME-OR-WINDOW denotes a live frame, return
the first window of that frame. */)
(Lisp_Object frame_or_window)
{
@@ -230,7 +365,7 @@ the first window of that frame. */)
if (NILP (frame_or_window))
window = SELECTED_FRAME ()->root_window;
- else if (WINDOWP (frame_or_window))
+ else if (WINDOW_VALID_P (frame_or_window))
window = XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window)))->root_window;
else
{
@@ -245,7 +380,7 @@ the first window of that frame. */)
else if (! NILP (XWINDOW (window)->vchild))
window = XWINDOW (window)->vchild;
else
- abort ();
+ emacs_abort ();
}
return window;
@@ -255,16 +390,16 @@ DEFUN ("frame-selected-window", Fframe_selected_window,
Sframe_selected_window, 0, 1, 0,
doc: /* Return the selected window of FRAME-OR-WINDOW.
If omitted, FRAME-OR-WINDOW defaults to the currently selected frame.
-Else if FRAME-OR-WINDOW denotes any window, return the selected window
-of that window's frame. If FRAME-OR-WINDOW denotes a live frame, return
-the selected window of that frame. */)
+Else if FRAME-OR-WINDOW denotes a valid window, return the selected
+window of that window's frame. If FRAME-OR-WINDOW denotes a live frame,
+return the selected window of that frame. */)
(Lisp_Object frame_or_window)
{
Lisp_Object window;
if (NILP (frame_or_window))
window = SELECTED_FRAME ()->selected_window;
- else if (WINDOWP (frame_or_window))
+ else if (WINDOW_VALID_P (frame_or_window))
window = XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window)))->selected_window;
else
{
@@ -297,7 +432,10 @@ Return WINDOW. */)
if (EQ (frame, selected_frame))
return Fselect_window (window, norecord);
else
- return XFRAME (frame)->selected_window = window;
+ {
+ fset_selected_window (XFRAME (frame), window);
+ return window;
+ }
}
DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 0, 0,
@@ -330,18 +468,20 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap)
if (NILP (norecord))
{
- ++window_select_count;
- XSETFASTINT (w->use_time, window_select_count);
+ w->use_time = ++window_select_count;
record_buffer (w->buffer);
}
+ /* Make the selected window's buffer current. */
+ Fset_buffer (w->buffer);
+
if (EQ (window, selected_window) && !inhibit_point_swap)
return window;
sf = SELECTED_FRAME ();
if (XFRAME (WINDOW_FRAME (w)) != sf)
{
- XFRAME (WINDOW_FRAME (w))->selected_window = window;
+ fset_selected_window (XFRAME (WINDOW_FRAME (w)), window);
/* Use this rather than Fhandle_switch_frame
so that FRAME_FOCUS_FRAME is moved appropriately as we
move around in the state where a minibuffer in a separate
@@ -352,11 +492,11 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap)
return window;
}
else
- sf->selected_window = window;
+ fset_selected_window (sf, window);
- /* Store the current buffer's actual point into the
- old selected window. It belongs to that window,
- and when the window is not selected, must be in the window. */
+ /* Store the old selected window's buffer's point in pointm of the old
+ selected window. It belongs to that window, and when the window is
+ not selected, must be in the window. */
if (!inhibit_point_swap)
{
ow = XWINDOW (selected_window);
@@ -367,10 +507,7 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap)
}
selected_window = window;
-
- Fset_buffer (w->buffer);
-
- BVAR (XBUFFER (w->buffer), last_selected_window) = window;
+ bset_last_selected_window (XBUFFER (w->buffer), window);
/* Go to the point recorded in the window.
This is important when the buffer is in more
@@ -378,7 +515,7 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap)
redisplay_window has altered point after scrolling,
because it makes the change only in the window. */
{
- register EMACS_INT new_point = marker_position (w->pointm);
+ register ptrdiff_t new_point = marker_position (w->pointm);
if (new_point < BEGV)
SET_PT (BEGV);
else if (new_point > ZV)
@@ -418,92 +555,96 @@ Return nil for an internal window or a deleted window. */)
DEFUN ("window-parent", Fwindow_parent, Swindow_parent, 0, 1, 0,
doc: /* Return the parent window of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
Return nil for a window with no parent (e.g. a root window). */)
(Lisp_Object window)
{
- return decode_any_window (window)->parent;
+ return decode_valid_window (window)->parent;
}
-DEFUN ("window-top-child", Fwindow_top_child, Swindow_top_child, 1, 1, 0,
+DEFUN ("window-top-child", Fwindow_top_child, Swindow_top_child, 0, 1, 0,
doc: /* Return the topmost child window of window WINDOW.
+WINDOW must be a valid window and defaults to the selected one.
Return nil if WINDOW is a live window (live windows have no children).
Return nil if WINDOW is an internal window whose children form a
horizontal combination. */)
(Lisp_Object window)
{
- CHECK_WINDOW (window);
- return decode_any_window (window)->vchild;
+ return decode_valid_window (window)->vchild;
}
-DEFUN ("window-left-child", Fwindow_left_child, Swindow_left_child, 1, 1, 0,
+DEFUN ("window-left-child", Fwindow_left_child, Swindow_left_child, 0, 1, 0,
doc: /* Return the leftmost child window of window WINDOW.
+WINDOW must be a valid window and defaults to the selected one.
Return nil if WINDOW is a live window (live windows have no children).
Return nil if WINDOW is an internal window whose children form a
vertical combination. */)
(Lisp_Object window)
{
- CHECK_WINDOW (window);
- return decode_any_window (window)->hchild;
+ return decode_valid_window (window)->hchild;
}
DEFUN ("window-next-sibling", Fwindow_next_sibling, Swindow_next_sibling, 0, 1, 0,
doc: /* Return the next sibling window of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
Return nil if WINDOW has no next sibling. */)
(Lisp_Object window)
{
- return decode_any_window (window)->next;
+ return decode_valid_window (window)->next;
}
DEFUN ("window-prev-sibling", Fwindow_prev_sibling, Swindow_prev_sibling, 0, 1, 0,
doc: /* Return the previous sibling window of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
Return nil if WINDOW has no previous sibling. */)
(Lisp_Object window)
{
- return decode_any_window (window)->prev;
+ return decode_valid_window (window)->prev;
}
DEFUN ("window-combination-limit", Fwindow_combination_limit, Swindow_combination_limit, 1, 1, 0,
doc: /* Return combination limit of window WINDOW.
If the return value is nil, child windows of WINDOW can be recombined with
WINDOW's siblings. A return value of t means that child windows of
-WINDOW are never \(re-)combined with WINDOW's siblings. */)
+WINDOW are never \(re-)combined with WINDOW's siblings.
+
+WINDOW must be a valid window. The return value is meaningful for
+internal windows only. */)
(Lisp_Object window)
{
- return decode_any_window (window)->combination_limit;
+ CHECK_VALID_WINDOW (window);
+ return XWINDOW (window)->combination_limit;
}
DEFUN ("set-window-combination-limit", Fset_window_combination_limit, Sset_window_combination_limit, 2, 2, 0,
doc: /* Set combination limit of window WINDOW to LIMIT; return LIMIT.
-If LIMIT is nil, child windows of WINDOW can be recombined with
-WINDOW's siblings. LIMIT t means that child windows of WINDOW are
-never \(re-)combined with WINDOW's siblings. Other values are reserved
-for future use. */)
+If LIMIT is nil, child windows of WINDOW can be recombined with WINDOW's
+siblings. LIMIT t means that child windows of WINDOW are never
+\(re-)combined with WINDOW's siblings. Other values are reserved for
+future use.
+
+WINDOW must be a valid window. Setting the combination limit is
+meaningful for internal windows only. */)
(Lisp_Object window, Lisp_Object limit)
{
- register struct window *w = decode_any_window (window);
-
- w->combination_limit = limit;
-
- return w->combination_limit;
+ wset_combination_limit (decode_valid_window (window), limit);
+ return limit;
}
DEFUN ("window-use-time", Fwindow_use_time, Swindow_use_time, 0, 1, 0,
doc: /* Return the use time of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
The window with the highest use time is the most recently selected
one. The window with the lowest use time is the least recently
selected one. */)
(Lisp_Object window)
{
- return decode_window (window)->use_time;
+ return make_number (decode_live_window (window)->use_time);
}
DEFUN ("window-total-height", Fwindow_total_height, Swindow_total_height, 0, 1, 0,
doc: /* Return the total height, in lines, of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
The return value includes the mode line and header line, if any.
If WINDOW is an internal window, the total height is the height
@@ -513,12 +654,12 @@ On a graphical display, this total height is reported as an
integer multiple of the default character height. */)
(Lisp_Object window)
{
- return decode_any_window (window)->total_lines;
+ return decode_valid_window (window)->total_lines;
}
DEFUN ("window-total-width", Fwindow_total_width, Swindow_total_width, 0, 1, 0,
doc: /* Return the total width, in columns, of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
The return value includes any vertical dividers or scroll bars
belonging to WINDOW. If WINDOW is an internal window, the total width
@@ -528,35 +669,34 @@ On a graphical display, this total width is reported as an
integer multiple of the default character width. */)
(Lisp_Object window)
{
- return decode_any_window (window)->total_cols;
+ return decode_valid_window (window)->total_cols;
}
DEFUN ("window-new-total", Fwindow_new_total, Swindow_new_total, 0, 1, 0,
doc: /* Return the new total size of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window. */)
+WINDOW must be a valid window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_any_window (window)->new_total;
+ return decode_valid_window (window)->new_total;
}
DEFUN ("window-normal-size", Fwindow_normal_size, Swindow_normal_size, 0, 2, 0,
doc: /* Return the normal height of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
If HORIZONTAL is non-nil, return the normal width of WINDOW. */)
(Lisp_Object window, Lisp_Object horizontal)
{
- if (NILP (horizontal))
- return decode_any_window (window)->normal_lines;
- else
- return decode_any_window (window)->normal_cols;
+ struct window *w = decode_valid_window (window);
+
+ return NILP (horizontal) ? w->normal_lines : w->normal_cols;
}
DEFUN ("window-new-normal", Fwindow_new_normal, Swindow_new_normal, 0, 1, 0,
doc: /* Return new normal size of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window. */)
+WINDOW must be a valid window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_any_window (window)->new_normal;
+ return decode_valid_window (window)->new_normal;
}
DEFUN ("window-left-column", Fwindow_left_column, Swindow_left_column, 0, 1, 0,
@@ -565,10 +705,10 @@ This is the distance, in columns, between the left edge of WINDOW and
the left edge of the frame's window area. For instance, the return
value is 0 if there is no window to the left of WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window. */)
+WINDOW must be a valid window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_any_window (window)->left_col;
+ return decode_valid_window (window)->left_col;
}
DEFUN ("window-top-line", Fwindow_top_line, Swindow_top_line, 0, 1, 0,
@@ -577,10 +717,10 @@ This is the distance, in lines, between the top of WINDOW and the top
of the frame's window area. For instance, the return value is 0 if
there is no window above WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window. */)
+WINDOW must be a valid window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_any_window (window)->top_line;
+ return decode_valid_window (window)->top_line;
}
/* Return the number of lines of W's body. Don't count any mode or
@@ -634,8 +774,7 @@ window_body_cols (struct window *w)
DEFUN ("window-body-height", Fwindow_body_height, Swindow_body_height, 0, 1, 0,
doc: /* Return the height, in lines, of WINDOW's text area.
-If WINDOW is omitted or nil, it defaults to the selected window.
-Signal an error if the window is not live.
+WINDOW must be a live window and defaults to the selected one.
The returned height does not include the mode line or header line.
On a graphical display, the height is expressed as an integer multiple
@@ -644,22 +783,19 @@ area is only partially visible, that counts as a whole line; to
exclude partially-visible lines, use `window-text-height'. */)
(Lisp_Object window)
{
- struct window *w = decode_window (window);
- return make_number (window_body_lines (w));
+ return make_number (window_body_lines (decode_live_window (window)));
}
DEFUN ("window-body-width", Fwindow_body_width, Swindow_body_width, 0, 1, 0,
doc: /* Return the width, in columns, of WINDOW's text area.
-If WINDOW is omitted or nil, it defaults to the selected window.
-Signal an error if the window is not live.
+WINDOW must be a live window and defaults to the selected one.
The return value does not include any vertical dividers, fringe or
marginal areas, or scroll bars. On a graphical display, the width is
expressed as an integer multiple of the default character width. */)
(Lisp_Object window)
{
- struct window *w = decode_window (window);
- return make_number (window_body_cols (w));
+ return make_number (window_body_cols (decode_live_window (window)));
}
DEFUN ("window-hscroll", Fwindow_hscroll, Swindow_hscroll, 0, 1, 0,
@@ -667,85 +803,97 @@ DEFUN ("window-hscroll", Fwindow_hscroll, Swindow_hscroll, 0, 1, 0,
WINDOW must be a live window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_window (window)->hscroll;
+ return make_number (decode_live_window (window)->hscroll);
+}
+
+/* Set W's horizontal scroll amount to HSCROLL clipped to a reasonable
+ range, returning the new amount as a fixnum. */
+static Lisp_Object
+set_window_hscroll (struct window *w, EMACS_INT hscroll)
+{
+ /* Horizontal scrolling has problems with large scroll amounts.
+ It's too slow with long lines, and even with small lines the
+ display can be messed up. For now, though, impose only the limits
+ required by the internal representation: horizontal scrolling must
+ fit in fixnum (since it's visible to Elisp) and into ptrdiff_t
+ (since it's stored in a ptrdiff_t). */
+ ptrdiff_t hscroll_max = min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX);
+ ptrdiff_t new_hscroll = clip_to_bounds (0, hscroll, hscroll_max);
+
+ /* Prevent redisplay shortcuts when changing the hscroll. */
+ if (w->hscroll != new_hscroll)
+ XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1;
+
+ w->hscroll = new_hscroll;
+ return make_number (new_hscroll);
}
DEFUN ("set-window-hscroll", Fset_window_hscroll, Sset_window_hscroll, 2, 2, 0,
doc: /* Set number of columns WINDOW is scrolled from left margin to NCOL.
-If WINDOW is nil, the selected window is used.
-Return NCOL. NCOL should be zero or positive.
+WINDOW must be a live window and defaults to the selected one.
+Clip the number to a reasonable value if out of range.
+Return the new number. NCOL should be zero or positive.
Note that if `automatic-hscrolling' is non-nil, you cannot scroll the
window so that the location of point moves off-window. */)
(Lisp_Object window, Lisp_Object ncol)
{
- struct window *w = decode_window (window);
- int hscroll;
-
CHECK_NUMBER (ncol);
- hscroll = max (0, XINT (ncol));
-
- /* Prevent redisplay shortcuts when changing the hscroll. */
- if (XINT (w->hscroll) != hscroll)
- XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1;
-
- w->hscroll = make_number (hscroll);
- return ncol;
+ return set_window_hscroll (decode_live_window (window), XINT (ncol));
}
DEFUN ("window-redisplay-end-trigger", Fwindow_redisplay_end_trigger,
Swindow_redisplay_end_trigger, 0, 1, 0,
doc: /* Return WINDOW's redisplay end trigger value.
-WINDOW defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
See `set-window-redisplay-end-trigger' for more information. */)
(Lisp_Object window)
{
- return decode_window (window)->redisplay_end_trigger;
+ return decode_live_window (window)->redisplay_end_trigger;
}
DEFUN ("set-window-redisplay-end-trigger", Fset_window_redisplay_end_trigger,
Sset_window_redisplay_end_trigger, 2, 2, 0,
doc: /* Set WINDOW's redisplay end trigger value to VALUE.
-VALUE should be a buffer position (typically a marker) or nil.
-If it is a buffer position, then if redisplay in WINDOW reaches a position
-beyond VALUE, the functions in `redisplay-end-trigger-functions' are called
-with two arguments: WINDOW, and the end trigger value.
-Afterwards the end-trigger value is reset to nil. */)
+WINDOW must be a live window and defaults to the selected one. VALUE
+should be a buffer position (typically a marker) or nil. If it is a
+buffer position, then if redisplay in WINDOW reaches a position beyond
+VALUE, the functions in `redisplay-end-trigger-functions' are called
+with two arguments: WINDOW, and the end trigger value. Afterwards the
+end-trigger value is reset to nil. */)
(register Lisp_Object window, Lisp_Object value)
{
- register struct window *w;
-
- w = decode_window (window);
- w->redisplay_end_trigger = value;
+ wset_redisplay_end_trigger (decode_live_window (window), value);
return value;
}
DEFUN ("window-edges", Fwindow_edges, Swindow_edges, 0, 1, 0,
doc: /* Return a list of the edge coordinates of WINDOW.
-The list has the form (LEFT TOP RIGHT BOTTOM).
-TOP and BOTTOM count by lines, and LEFT and RIGHT count by columns,
-all relative to 0, 0 at top left corner of frame.
-
-RIGHT is one more than the rightmost column occupied by WINDOW.
-BOTTOM is one more than the bottommost row occupied by WINDOW.
-The edges include the space used by WINDOW's scroll bar, display
-margins, fringes, header line, and/or mode line. For the edges of
-just the text area, use `window-inside-edges'. */)
+WINDOW must be a valid window and defaults to the selected one.
+
+The returned list has the form (LEFT TOP RIGHT BOTTOM). TOP and BOTTOM
+count by lines, and LEFT and RIGHT count by columns, all relative to 0,
+0 at top left corner of frame.
+
+RIGHT is one more than the rightmost column occupied by WINDOW. BOTTOM
+is one more than the bottommost row occupied by WINDOW. The edges
+include the space used by WINDOW's scroll bar, display margins, fringes,
+header line, and/or mode line. For the edges of just the text area, use
+`window-inside-edges'. */)
(Lisp_Object window)
{
- register struct window *w = decode_any_window (window);
+ register struct window *w = decode_valid_window (window);
- return Fcons (make_number (WINDOW_LEFT_EDGE_COL (w)),
- Fcons (make_number (WINDOW_TOP_EDGE_LINE (w)),
- Fcons (make_number (WINDOW_RIGHT_EDGE_COL (w)),
- Fcons (make_number (WINDOW_BOTTOM_EDGE_LINE (w)),
- Qnil))));
+ return list4i (WINDOW_LEFT_EDGE_COL (w), WINDOW_TOP_EDGE_LINE (w),
+ WINDOW_RIGHT_EDGE_COL (w), WINDOW_BOTTOM_EDGE_LINE (w));
}
DEFUN ("window-pixel-edges", Fwindow_pixel_edges, Swindow_pixel_edges, 0, 1, 0,
doc: /* Return a list of the edge pixel coordinates of WINDOW.
-The list has the form (LEFT TOP RIGHT BOTTOM), all relative to 0, 0 at
-the top left corner of the frame.
+WINDOW must be a valid window and defaults to the selected one.
+
+The returned list has the form (LEFT TOP RIGHT BOTTOM), all relative to
+0, 0 at the top left corner of the frame.
RIGHT is one more than the rightmost x position occupied by WINDOW.
BOTTOM is one more than the bottommost y position occupied by WINDOW.
@@ -754,13 +902,10 @@ margins, fringes, header line, and/or mode line. For the pixel edges
of just the text area, use `window-inside-pixel-edges'. */)
(Lisp_Object window)
{
- register struct window *w = decode_any_window (window);
+ register struct window *w = decode_valid_window (window);
- return Fcons (make_number (WINDOW_LEFT_EDGE_X (w)),
- Fcons (make_number (WINDOW_TOP_EDGE_Y (w)),
- Fcons (make_number (WINDOW_RIGHT_EDGE_X (w)),
- Fcons (make_number (WINDOW_BOTTOM_EDGE_Y (w)),
- Qnil))));
+ return list4i (WINDOW_LEFT_EDGE_X (w), WINDOW_TOP_EDGE_Y (w),
+ WINDOW_RIGHT_EDGE_X (w), WINDOW_BOTTOM_EDGE_Y (w));
}
static void
@@ -788,8 +933,10 @@ calc_absolute_offset (struct window *w, int *add_x, int *add_y)
DEFUN ("window-absolute-pixel-edges", Fwindow_absolute_pixel_edges,
Swindow_absolute_pixel_edges, 0, 1, 0,
doc: /* Return a list of the edge pixel coordinates of WINDOW.
-The list has the form (LEFT TOP RIGHT BOTTOM), all relative to 0, 0 at
-the top left corner of the display.
+WINDOW must be a valid window and defaults to the selected one.
+
+The returned list has the form (LEFT TOP RIGHT BOTTOM), all relative to
+0, 0 at the top left corner of the display.
RIGHT is one more than the rightmost x position occupied by WINDOW.
BOTTOM is one more than the bottommost y position occupied by WINDOW.
@@ -798,47 +945,51 @@ margins, fringes, header line, and/or mode line. For the pixel edges
of just the text area, use `window-inside-absolute-pixel-edges'. */)
(Lisp_Object window)
{
- register struct window *w = decode_any_window (window);
+ register struct window *w = decode_valid_window (window);
int add_x, add_y;
+
calc_absolute_offset (w, &add_x, &add_y);
- return Fcons (make_number (WINDOW_LEFT_EDGE_X (w) + add_x),
- Fcons (make_number (WINDOW_TOP_EDGE_Y (w) + add_y),
- Fcons (make_number (WINDOW_RIGHT_EDGE_X (w) + add_x),
- Fcons (make_number (WINDOW_BOTTOM_EDGE_Y (w) + add_y),
- Qnil))));
+ return list4i (WINDOW_LEFT_EDGE_X (w) + add_x,
+ WINDOW_TOP_EDGE_Y (w) + add_y,
+ WINDOW_RIGHT_EDGE_X (w) + add_x,
+ WINDOW_BOTTOM_EDGE_Y (w) + add_y);
}
DEFUN ("window-inside-edges", Fwindow_inside_edges, Swindow_inside_edges, 0, 1, 0,
doc: /* Return a list of the edge coordinates of WINDOW.
-The list has the form (LEFT TOP RIGHT BOTTOM).
-TOP and BOTTOM count by lines, and LEFT and RIGHT count by columns,
-all relative to 0, 0 at top left corner of frame.
+WINDOW must be a live window and defaults to the selected one.
+
+The returned list has the form (LEFT TOP RIGHT BOTTOM). TOP and BOTTOM
+count by lines, and LEFT and RIGHT count by columns, all relative to 0,
+0 at top left corner of frame.
RIGHT is one more than the rightmost column of WINDOW's text area.
-BOTTOM is one more than the bottommost row of WINDOW's text area.
-The inside edges do not include the space used by the WINDOW's scroll
-bar, display margins, fringes, header line, and/or mode line. */)
+BOTTOM is one more than the bottommost row of WINDOW's text area. The
+inside edges do not include the space used by the WINDOW's scroll bar,
+display margins, fringes, header line, and/or mode line. */)
(Lisp_Object window)
{
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
- return list4 (make_number (WINDOW_BOX_LEFT_EDGE_COL (w)
- + WINDOW_LEFT_MARGIN_COLS (w)
- + WINDOW_LEFT_FRINGE_COLS (w)),
- make_number (WINDOW_TOP_EDGE_LINE (w)
- + WINDOW_HEADER_LINE_LINES (w)),
- make_number (WINDOW_BOX_RIGHT_EDGE_COL (w)
- - WINDOW_RIGHT_MARGIN_COLS (w)
- - WINDOW_RIGHT_FRINGE_COLS (w)),
- make_number (WINDOW_BOTTOM_EDGE_LINE (w)
- - WINDOW_MODE_LINE_LINES (w)));
+ return list4i ((WINDOW_BOX_LEFT_EDGE_COL (w)
+ + WINDOW_LEFT_MARGIN_COLS (w)
+ + WINDOW_LEFT_FRINGE_COLS (w)),
+ (WINDOW_TOP_EDGE_LINE (w)
+ + WINDOW_HEADER_LINE_LINES (w)),
+ (WINDOW_BOX_RIGHT_EDGE_COL (w)
+ - WINDOW_RIGHT_MARGIN_COLS (w)
+ - WINDOW_RIGHT_FRINGE_COLS (w)),
+ (WINDOW_BOTTOM_EDGE_LINE (w)
+ - WINDOW_MODE_LINE_LINES (w)));
}
DEFUN ("window-inside-pixel-edges", Fwindow_inside_pixel_edges, Swindow_inside_pixel_edges, 0, 1, 0,
doc: /* Return a list of the edge pixel coordinates of WINDOW's text area.
-The list has the form (LEFT TOP RIGHT BOTTOM), all relative to (0,0)
-at the top left corner of the frame's window area.
+WINDOW must be a live window and defaults to the selected one.
+
+The returned list has the form (LEFT TOP RIGHT BOTTOM), all relative to
+(0,0) at the top left corner of the frame's window area.
RIGHT is one more than the rightmost x position of WINDOW's text area.
BOTTOM is one more than the bottommost y position of WINDOW's text area.
@@ -846,26 +997,28 @@ The inside edges do not include the space used by WINDOW's scroll bar,
display margins, fringes, header line, and/or mode line. */)
(Lisp_Object window)
{
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
- return list4 (make_number (WINDOW_BOX_LEFT_EDGE_X (w)
- + WINDOW_LEFT_MARGIN_WIDTH (w)
- + WINDOW_LEFT_FRINGE_WIDTH (w)),
- make_number (WINDOW_TOP_EDGE_Y (w)
- + WINDOW_HEADER_LINE_HEIGHT (w)),
- make_number (WINDOW_BOX_RIGHT_EDGE_X (w)
- - WINDOW_RIGHT_MARGIN_WIDTH (w)
- - WINDOW_RIGHT_FRINGE_WIDTH (w)),
- make_number (WINDOW_BOTTOM_EDGE_Y (w)
- - WINDOW_MODE_LINE_HEIGHT (w)));
+ return list4i ((WINDOW_BOX_LEFT_EDGE_X (w)
+ + WINDOW_LEFT_MARGIN_WIDTH (w)
+ + WINDOW_LEFT_FRINGE_WIDTH (w)),
+ (WINDOW_TOP_EDGE_Y (w)
+ + WINDOW_HEADER_LINE_HEIGHT (w)),
+ (WINDOW_BOX_RIGHT_EDGE_X (w)
+ - WINDOW_RIGHT_MARGIN_WIDTH (w)
+ - WINDOW_RIGHT_FRINGE_WIDTH (w)),
+ (WINDOW_BOTTOM_EDGE_Y (w)
+ - WINDOW_MODE_LINE_HEIGHT (w)));
}
DEFUN ("window-inside-absolute-pixel-edges",
Fwindow_inside_absolute_pixel_edges,
Swindow_inside_absolute_pixel_edges, 0, 1, 0,
doc: /* Return a list of the edge pixel coordinates of WINDOW's text area.
-The list has the form (LEFT TOP RIGHT BOTTOM), all relative to (0,0)
-at the top left corner of the frame's window area.
+WINDOW must be a live window and defaults to the selected one.
+
+The returned list has the form (LEFT TOP RIGHT BOTTOM), all relative to
+(0,0) at the top left corner of the frame's window area.
RIGHT is one more than the rightmost x position of WINDOW's text area.
BOTTOM is one more than the bottommost y position of WINDOW's text area.
@@ -873,20 +1026,21 @@ The inside edges do not include the space used by WINDOW's scroll bar,
display margins, fringes, header line, and/or mode line. */)
(Lisp_Object window)
{
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
int add_x, add_y;
+
calc_absolute_offset (w, &add_x, &add_y);
- return list4 (make_number (WINDOW_BOX_LEFT_EDGE_X (w)
- + WINDOW_LEFT_MARGIN_WIDTH (w)
- + WINDOW_LEFT_FRINGE_WIDTH (w) + add_x),
- make_number (WINDOW_TOP_EDGE_Y (w)
- + WINDOW_HEADER_LINE_HEIGHT (w) + add_y),
- make_number (WINDOW_BOX_RIGHT_EDGE_X (w)
- - WINDOW_RIGHT_MARGIN_WIDTH (w)
- - WINDOW_RIGHT_FRINGE_WIDTH (w) + add_x),
- make_number (WINDOW_BOTTOM_EDGE_Y (w)
- - WINDOW_MODE_LINE_HEIGHT (w) + add_y));
+ return list4i ((WINDOW_BOX_LEFT_EDGE_X (w)
+ + WINDOW_LEFT_MARGIN_WIDTH (w)
+ + WINDOW_LEFT_FRINGE_WIDTH (w) + add_x),
+ (WINDOW_TOP_EDGE_Y (w)
+ + WINDOW_HEADER_LINE_HEIGHT (w) + add_y),
+ (WINDOW_BOX_RIGHT_EDGE_X (w)
+ - WINDOW_RIGHT_MARGIN_WIDTH (w)
+ - WINDOW_RIGHT_FRINGE_WIDTH (w) + add_x),
+ (WINDOW_BOTTOM_EDGE_Y (w)
+ - WINDOW_MODE_LINE_HEIGHT (w) + add_y));
}
/* Test if the character at column X, row Y is within window W.
@@ -1052,7 +1206,7 @@ window_relative_x_coord (struct window *w, enum window_part part, int x)
DEFUN ("coordinates-in-window-p", Fcoordinates_in_window_p,
Scoordinates_in_window_p, 2, 2, 0,
doc: /* Return non-nil if COORDINATES are in WINDOW.
-WINDOW must be a live window.
+WINDOW must be a live window and defaults to the selected one.
COORDINATES is a cons of the form (X . Y), X and Y being distances
measured in characters from the upper-left corner of the frame.
\(0 . 0) denotes the character in the upper left corner of the
@@ -1074,8 +1228,7 @@ If they are in the windows's left or right marginal areas, `left-margin'\n\
int x, y;
Lisp_Object lx, ly;
- CHECK_LIVE_WINDOW (window);
- w = XWINDOW (window);
+ w = decode_live_window (window);
f = XFRAME (w->frame);
CHECK_CONS (coordinates);
lx = Fcar (coordinates);
@@ -1124,7 +1277,7 @@ If they are in the windows's left or right marginal areas, `left-margin'\n\
return Qnil;
default:
- abort ();
+ emacs_abort ();
}
}
@@ -1220,12 +1373,7 @@ The top left corner of the frame is considered to be row 0,
column 0. */)
(Lisp_Object x, Lisp_Object y, Lisp_Object frame)
{
- struct frame *f;
-
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
+ struct frame *f = decode_live_frame (frame);
/* Check that arguments are integers or floats. */
CHECK_NUMBER_OR_FLOAT (x);
@@ -1243,22 +1391,21 @@ DEFUN ("window-point", Fwindow_point, Swindow_point, 0, 1, 0,
doc: /* Return current value of point in WINDOW.
WINDOW must be a live window and defaults to the selected one.
-For a nonselected window, this is the value point would have
-if that window were selected.
+For a nonselected window, this is the value point would have if that
+window were selected.
-Note that, when WINDOW is the selected window and its buffer
-is also currently selected, the value returned is the same as (point).
-It would be more strictly correct to return the `top-level' value
-of point, outside of any save-excursion forms.
-But that is hard to define. */)
+Note that, when WINDOW is selected, the value returned is the same as
+that returned by `point' for WINDOW's buffer. It would be more strictly
+correct to return the `top-level' value of `point', outside of any
+`save-excursion' forms. But that is hard to define. */)
(Lisp_Object window)
{
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
- if (w == XWINDOW (selected_window)
- && current_buffer == XBUFFER (w->buffer))
- return Fpoint ();
- return Fmarker_position (w->pointm);
+ if (w == XWINDOW (selected_window))
+ return make_number (BUF_PT (XBUFFER (w->buffer)));
+ else
+ return Fmarker_position (w->pointm);
}
DEFUN ("window-start", Fwindow_start, Swindow_start, 0, 1, 0,
@@ -1267,7 +1414,7 @@ WINDOW must be a live window and defaults to the selected one.
This is updated by redisplay or by calling `set-window-start'. */)
(Lisp_Object window)
{
- return Fmarker_position (decode_window (window)->start);
+ return Fmarker_position (decode_live_window (window)->start);
}
/* This is text temporarily removed from the doc string below.
@@ -1294,7 +1441,7 @@ if it isn't already recorded. */)
(Lisp_Object window, Lisp_Object update)
{
Lisp_Object value;
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
Lisp_Object buf;
struct buffer *b;
@@ -1312,9 +1459,7 @@ if it isn't already recorded. */)
#endif
if (! NILP (update)
- && ! (! NILP (w->window_end_valid)
- && XFASTINT (w->last_modified) >= BUF_MODIFF (b)
- && XFASTINT (w->last_overlay_modified) >= BUF_OVERLAY_MODIFF (b))
+ && (windows_or_buffers_changed || NILP (w->window_end_valid))
&& !noninteractive)
{
struct text_pos startp;
@@ -1361,44 +1506,56 @@ if it isn't already recorded. */)
DEFUN ("set-window-point", Fset_window_point, Sset_window_point, 2, 2, 0,
doc: /* Make point value in WINDOW be at position POS in WINDOW's buffer.
+WINDOW must be a live window and defaults to the selected one.
Return POS. */)
(Lisp_Object window, Lisp_Object pos)
{
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
CHECK_NUMBER_COERCE_MARKER (pos);
- if (w == XWINDOW (selected_window)
- && XBUFFER (w->buffer) == current_buffer)
- Fgoto_char (pos);
- else
- set_marker_restricted (w->pointm, pos, w->buffer);
- /* We have to make sure that redisplay updates the window to show
- the new value of point. */
- if (!EQ (window, selected_window))
- ++windows_or_buffers_changed;
+ if (w == XWINDOW (selected_window))
+ {
+ if (XBUFFER (w->buffer) == current_buffer)
+ Fgoto_char (pos);
+ else
+ {
+ struct buffer *old_buffer = current_buffer;
+
+ set_buffer_internal (XBUFFER (w->buffer));
+ Fgoto_char (pos);
+ set_buffer_internal (old_buffer);
+ }
+ }
+ else
+ {
+ set_marker_restricted (w->pointm, pos, w->buffer);
+ /* We have to make sure that redisplay updates the window to show
+ the new value of point. */
+ ++windows_or_buffers_changed;
+ }
return pos;
}
DEFUN ("set-window-start", Fset_window_start, Sset_window_start, 2, 3, 0,
doc: /* Make display in WINDOW start at position POS in WINDOW's buffer.
-If WINDOW is nil, the selected window is used. Return POS.
-Optional third arg NOFORCE non-nil inhibits next redisplay from
+WINDOW must be a live window and defaults to the selected one. Return
+POS. Optional third arg NOFORCE non-nil inhibits next redisplay from
overriding motion of point in order to display at this exact start. */)
(Lisp_Object window, Lisp_Object pos, Lisp_Object noforce)
{
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
CHECK_NUMBER_COERCE_MARKER (pos);
set_marker_restricted (w->start, pos, w->buffer);
/* this is not right, but much easier than doing what is right. */
- w->start_at_line_beg = Qnil;
+ w->start_at_line_beg = 0;
if (NILP (noforce))
- w->force_start = Qt;
- w->update_mode_line = Qt;
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->force_start = 1;
+ w->update_mode_line = 1;
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
if (!EQ (window, selected_window))
windows_or_buffers_changed++;
@@ -1408,12 +1565,14 @@ overriding motion of point in order to display at this exact start. */)
DEFUN ("pos-visible-in-window-p", Fpos_visible_in_window_p,
Spos_visible_in_window_p, 0, 3, 0,
doc: /* Return non-nil if position POS is currently on the frame in WINDOW.
-Return nil if that position is scrolled vertically out of view.
-If a character is only partially visible, nil is returned, unless the
-optional argument PARTIALLY is non-nil.
-If POS is only out of view because of horizontal scrolling, return non-nil.
-If POS is t, it specifies the position of the last visible glyph in WINDOW.
-POS defaults to point in WINDOW; WINDOW defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
+
+Return nil if that position is scrolled vertically out of view. If a
+character is only partially visible, nil is returned, unless the
+optional argument PARTIALLY is non-nil. If POS is only out of view
+because of horizontal scrolling, return non-nil. If POS is t, it
+specifies the position of the last visible glyph in WINDOW. POS
+defaults to point in WINDOW; WINDOW defaults to the selected window.
If POS is visible, return t if PARTIALLY is nil; if PARTIALLY is non-nil,
return value is a list of 2 or 6 elements (X Y [RTOP RBOT ROWH VPOS]),
@@ -1432,7 +1591,7 @@ display row, and VPOS is the row number (0-based) containing POS. */)
int rtop, rbot, rowh, vpos, fully_p = 1;
int x, y;
- w = decode_window (window);
+ w = decode_live_window (window);
buf = XBUFFER (w->buffer);
SET_TEXT_POS_FROM_MARKER (top, w->start);
@@ -1462,8 +1621,7 @@ display row, and VPOS is the row number (0-based) containing POS. */)
{
Lisp_Object part = Qnil;
if (!fully_p)
- part = list4 (make_number (rtop), make_number (rbot),
- make_number (rowh), make_number (vpos));
+ part = list4i (rtop, rbot, rowh, vpos);
in_window = Fcons (make_number (x),
Fcons (make_number (y), part));
}
@@ -1474,7 +1632,7 @@ display row, and VPOS is the row number (0-based) containing POS. */)
DEFUN ("window-line-height", Fwindow_line_height,
Swindow_line_height, 0, 2, 0,
doc: /* Return height in pixels of text line LINE in window WINDOW.
-WINDOW defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
Return height of current line if LINE is omitted or nil. Return height of
header or mode line if LINE is `header-line' or `mode-line'.
@@ -1495,9 +1653,10 @@ Return nil if window display is not up-to-date. In that case, use
register struct window *w;
register struct buffer *b;
struct glyph_row *row, *end_row;
- int max_y, crop, i, n;
+ int max_y, crop, i;
+ EMACS_INT n;
- w = decode_window (window);
+ w = decode_live_window (window);
if (noninteractive || w->pseudo_window_p)
return Qnil;
@@ -1509,8 +1668,8 @@ Return nil if window display is not up-to-date. In that case, use
if (NILP (w->window_end_valid)
|| current_buffer->clip_changed
|| current_buffer->prevent_redisplay_optimizations_p
- || XFASTINT (w->last_modified) < BUF_MODIFF (b)
- || XFASTINT (w->last_overlay_modified) < BUF_OVERLAY_MODIFF (b))
+ || w->last_modified < BUF_MODIFF (b)
+ || w->last_overlay_modified < BUF_OVERLAY_MODIFF (b))
return Qnil;
if (NILP (line))
@@ -1528,23 +1687,19 @@ Return nil if window display is not up-to-date. In that case, use
if (!WINDOW_WANTS_HEADER_LINE_P (w))
return Qnil;
row = MATRIX_HEADER_LINE_ROW (w->current_matrix);
- if (!row->enabled_p)
- return Qnil;
- return list4 (make_number (row->height),
- make_number (0), make_number (0),
- make_number (0));
+ return row->enabled_p ? list4i (row->height, 0, 0, 0) : Qnil;
}
if (EQ (line, Qmode_line))
{
row = MATRIX_MODE_LINE_ROW (w->current_matrix);
- if (!row->enabled_p)
- return Qnil;
- return list4 (make_number (row->height),
- make_number (0), /* not accurate */
- make_number (WINDOW_HEADER_LINE_HEIGHT (w)
- + window_text_bottom_y (w)),
- make_number (0));
+ return (row->enabled_p ?
+ list4i (row->height,
+ 0, /* not accurate */
+ (WINDOW_HEADER_LINE_HEIGHT (w)
+ + window_text_bottom_y (w)),
+ 0)
+ : Qnil);
}
CHECK_NUMBER (line);
@@ -1573,10 +1728,7 @@ Return nil if window display is not up-to-date. In that case, use
found_row:
crop = max (0, (row->y + row->height) - max_y);
- return list4 (make_number (row->height + min (0, row->y) - crop),
- make_number (i),
- make_number (row->y),
- make_number (crop));
+ return list4i (row->height + min (0, row->y) - crop, i, row->y, crop);
}
DEFUN ("window-dedicated-p", Fwindow_dedicated_p, Swindow_dedicated_p,
@@ -1585,8 +1737,8 @@ DEFUN ("window-dedicated-p", Fwindow_dedicated_p, Swindow_dedicated_p,
More precisely, return the value assigned by the last call of
`set-window-dedicated-p' for WINDOW. Return nil if that function was
never called with WINDOW as its argument, or the value set by that
-function was internally reset since its last call. WINDOW defaults to
-the selected window.
+function was internally reset since its last call. WINDOW must be a
+live window and defaults to the selected one.
When a window is dedicated to its buffer, `display-buffer' will refrain
from displaying another buffer in it. `get-lru-window' and
@@ -1599,7 +1751,7 @@ window, unless that window is "strongly" dedicated to its buffer, that
is the value returned by `window-dedicated-p' is t. */)
(Lisp_Object window)
{
- return decode_window (window)->dedicated;
+ return decode_live_window (window)->dedicated;
}
DEFUN ("set-window-dedicated-p", Fset_window_dedicated_p,
@@ -1623,10 +1775,8 @@ buffer. If and when `set-window-buffer' displays another buffer in a
window, it also makes sure that the window is no more dedicated. */)
(Lisp_Object window, Lisp_Object flag)
{
- register struct window *w = decode_window (window);
-
- w->dedicated = flag;
- return w->dedicated;
+ wset_dedicated (decode_live_window (window), flag);
+ return flag;
}
DEFUN ("window-prev-buffers", Fwindow_prev_buffers, Swindow_prev_buffers,
@@ -1639,7 +1789,7 @@ where BUFFER is a buffer, WINDOW-START is the start position of the
window for that buffer, and POS is a window-specific point value. */)
(Lisp_Object window)
{
- return decode_window (window)->prev_buffers;
+ return decode_live_window (window)->prev_buffers;
}
DEFUN ("set-window-prev-buffers", Fset_window_prev_buffers,
@@ -1652,7 +1802,8 @@ where BUFFER is a buffer, WINDOW-START is the start position of the
window for that buffer, and POS is a window-specific point value. */)
(Lisp_Object window, Lisp_Object prev_buffers)
{
- return decode_window (window)->prev_buffers = prev_buffers;
+ wset_prev_buffers (decode_live_window (window), prev_buffers);
+ return prev_buffers;
}
DEFUN ("window-next-buffers", Fwindow_next_buffers, Swindow_next_buffers,
@@ -1661,7 +1812,7 @@ DEFUN ("window-next-buffers", Fwindow_next_buffers, Swindow_next_buffers,
WINDOW must be a live window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_window (window)->next_buffers;
+ return decode_live_window (window)->next_buffers;
}
DEFUN ("set-window-next-buffers", Fset_window_next_buffers,
@@ -1671,23 +1822,24 @@ WINDOW must be a live window and defaults to the selected one.
NEXT-BUFFERS should be a list of buffers. */)
(Lisp_Object window, Lisp_Object next_buffers)
{
- return decode_window (window)->next_buffers = next_buffers;
+ wset_next_buffers (decode_live_window (window), next_buffers);
+ return next_buffers;
}
DEFUN ("window-parameters", Fwindow_parameters, Swindow_parameters,
0, 1, 0,
doc: /* Return the parameters of WINDOW and their values.
-WINDOW defaults to the selected window. The return value is a list of
-elements of the form (PARAMETER . VALUE). */)
+WINDOW must be a valid window and defaults to the selected one. The
+return value is a list of elements of the form (PARAMETER . VALUE). */)
(Lisp_Object window)
{
- return Fcopy_alist (decode_any_window (window)->window_parameters);
+ return Fcopy_alist (decode_valid_window (window)->window_parameters);
}
DEFUN ("window-parameter", Fwindow_parameter, Swindow_parameter,
2, 2, 0,
doc: /* Return WINDOW's value for PARAMETER.
-WINDOW defaults to the selected window. */)
+WINDOW can be any window and defaults to the selected one. */)
(Lisp_Object window, Lisp_Object parameter)
{
Lisp_Object result;
@@ -1699,7 +1851,8 @@ WINDOW defaults to the selected window. */)
DEFUN ("set-window-parameter", Fset_window_parameter,
Sset_window_parameter, 3, 3, 0,
doc: /* Set WINDOW's value of PARAMETER to VALUE.
-WINDOW defaults to the selected window. Return VALUE. */)
+WINDOW can be any window and defaults to the selected one.
+Return VALUE. */)
(Lisp_Object window, Lisp_Object parameter, Lisp_Object value)
{
register struct window *w = decode_any_window (window);
@@ -1707,7 +1860,8 @@ WINDOW defaults to the selected window. Return VALUE. */)
old_alist_elt = Fassq (parameter, w->window_parameters);
if (NILP (old_alist_elt))
- w->window_parameters = Fcons (Fcons (parameter, value), w->window_parameters);
+ wset_window_parameters
+ (w, Fcons (Fcons (parameter, value), w->window_parameters));
else
Fsetcdr (old_alist_elt, value);
return value;
@@ -1716,10 +1870,10 @@ WINDOW defaults to the selected window. Return VALUE. */)
DEFUN ("window-display-table", Fwindow_display_table, Swindow_display_table,
0, 1, 0,
doc: /* Return the display-table that WINDOW is using.
-WINDOW defaults to the selected window. */)
+WINDOW must be a live window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_window (window)->display_table;
+ return decode_live_window (window)->display_table;
}
/* Get the display table for use on window W. This is either W's
@@ -1748,13 +1902,11 @@ window_display_table (struct window *w)
}
DEFUN ("set-window-display-table", Fset_window_display_table, Sset_window_display_table, 2, 2, 0,
- doc: /* Set WINDOW's display-table to TABLE. */)
+ doc: /* Set WINDOW's display-table to TABLE.
+WINDOW must be a live window and defaults to the selected one. */)
(register Lisp_Object window, Lisp_Object table)
{
- register struct window *w;
-
- w = decode_window (window);
- w->display_table = table;
+ wset_display_table (decode_live_window (window), table);
return table;
}
@@ -1769,7 +1921,7 @@ unshow_buffer (register struct window *w)
buf = w->buffer;
b = XBUFFER (buf);
if (b != XMARKER (w->pointm)->buffer)
- abort ();
+ emacs_abort ();
#if 0
if (w == XWINDOW (selected_window)
@@ -1790,6 +1942,9 @@ unshow_buffer (register struct window *w)
is actually stored in that buffer, and the window's pointm isn't used.
So don't clobber point in that buffer. */
if (! EQ (buf, XWINDOW (selected_window)->buffer)
+ /* Don't clobber point in current buffer either (this could be
+ useful in connection with bug#12208).
+ && XBUFFER (buf) != current_buffer */
/* This line helps to fix Horsley's testbug.el bug. */
&& !(WINDOWP (BVAR (b, last_selected_window))
&& w != XWINDOW (BVAR (b, last_selected_window))
@@ -1804,7 +1959,7 @@ unshow_buffer (register struct window *w)
if (WINDOWP (BVAR (b, last_selected_window))
&& w == XWINDOW (BVAR (b, last_selected_window)))
- BVAR (b, last_selected_window) = Qnil;
+ bset_last_selected_window (b, Qnil);
}
/* Put NEW into the window structure in place of OLD. SETFLAG zero
@@ -1819,18 +1974,18 @@ replace_window (Lisp_Object old, Lisp_Object new, int setflag)
/* If OLD is its frame's root window, then NEW is the new
root window for that frame. */
if (EQ (old, FRAME_ROOT_WINDOW (XFRAME (o->frame))))
- FRAME_ROOT_WINDOW (XFRAME (o->frame)) = new;
-
- if (setflag)
- {
- n->left_col = o->left_col;
- n->top_line = o->top_line;
- n->total_cols = o->total_cols;
- n->total_lines = o->total_lines;
- n->normal_cols = o->normal_cols;
- o->normal_cols = make_float (1.0);
- n->normal_lines = o->normal_lines;
- o->normal_lines = make_float (1.0);
+ fset_root_window (XFRAME (o->frame), new);
+
+ if (setflag)
+ {
+ wset_left_col (n, o->left_col);
+ wset_top_line (n, o->top_line);
+ wset_total_cols (n, o->total_cols);
+ wset_total_lines (n, o->total_lines);
+ wset_normal_cols (n, o->normal_cols);
+ wset_normal_cols (o, make_float (1.0));
+ wset_normal_lines (n, o->normal_lines);
+ wset_normal_lines (o, make_float (1.0));
n->desired_matrix = n->current_matrix = 0;
n->vscroll = 0;
memset (&n->cursor, 0, sizeof (n->cursor));
@@ -1840,27 +1995,30 @@ replace_window (Lisp_Object old, Lisp_Object new, int setflag)
n->phys_cursor_width = -1;
n->must_be_updated_p = 0;
n->pseudo_window_p = 0;
- XSETFASTINT (n->window_end_vpos, 0);
- XSETFASTINT (n->window_end_pos, 0);
- n->window_end_valid = Qnil;
+ wset_window_end_vpos (n, make_number (0));
+ wset_window_end_pos (n, make_number (0));
+ wset_window_end_valid (n, Qnil);
n->frozen_window_start_p = 0;
}
- n->next = tem = o->next;
+ tem = o->next;
+ wset_next (n, tem);
if (!NILP (tem))
- XWINDOW (tem)->prev = new;
+ wset_prev (XWINDOW (tem), new);
- n->prev = tem = o->prev;
+ tem = o->prev;
+ wset_prev (n, tem);
if (!NILP (tem))
- XWINDOW (tem)->next = new;
+ wset_next (XWINDOW (tem), new);
- n->parent = tem = o->parent;
+ tem = o->parent;
+ wset_parent (n, tem);
if (!NILP (tem))
{
if (EQ (XWINDOW (tem)->vchild, old))
- XWINDOW (tem)->vchild = new;
+ wset_vchild (XWINDOW (tem), new);
if (EQ (XWINDOW (tem)->hchild, old))
- XWINDOW (tem)->hchild = new;
+ wset_hchild (XWINDOW (tem), new);
}
}
@@ -1893,34 +2051,34 @@ recombine_windows (Lisp_Object window)
assign new normal sizes. */
if (NILP (w->prev))
if (horflag)
- p->hchild = child;
+ wset_hchild (p, child);
else
- p->vchild = child;
+ wset_vchild (p, child);
else
{
- c->prev = w->prev;
- XWINDOW (w->prev)->next = child;
+ wset_prev (c, w->prev);
+ wset_next (XWINDOW (w->prev), child);
}
while (c)
{
- c->parent = parent;
+ wset_parent (c, parent);
if (horflag)
- c->normal_cols
- = make_float (XFLOATINT (c->total_cols)
- / XFLOATINT (p->total_cols));
+ wset_normal_cols (c,
+ make_float (XFLOATINT (c->total_cols)
+ / XFLOATINT (p->total_cols)));
else
- c->normal_lines
- = make_float (XFLOATINT (c->total_lines)
- / XFLOATINT (p->total_lines));
+ wset_normal_lines (c,
+ make_float (XFLOATINT (c->total_lines)
+ / XFLOATINT (p->total_lines)));
if (NILP (c->next))
{
if (!NILP (w->next))
{
- c->next = w->next;
- XWINDOW (c->next)->prev = child;
+ wset_next (c, w->next);
+ wset_prev (XWINDOW (c->next), child);
}
c = 0;
@@ -1933,7 +2091,8 @@ recombine_windows (Lisp_Object window)
}
/* WINDOW can be deleted now. */
- w->vchild = w->hchild = Qnil;
+ wset_vchild (w, Qnil);
+ wset_hchild (w, Qnil);
}
}
}
@@ -1974,10 +2133,10 @@ window_list (void)
{
if (!CONSP (Vwindow_list))
{
- Lisp_Object tail;
+ Lisp_Object tail, frame;
Vwindow_list = Qnil;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
Lisp_Object args[2];
@@ -1985,7 +2144,7 @@ window_list (void)
new windows at the front of args[1], which means we
have to reverse this list at the end. */
args[1] = Qnil;
- foreach_window (XFRAME (XCAR (tail)), add_window_to_list, &args[1]);
+ foreach_window (XFRAME (frame), add_window_to_list, &args[1]);
args[0] = Vwindow_list;
args[1] = Fnreverse (args[1]);
Vwindow_list = Fnconc (2, args);
@@ -2033,7 +2192,7 @@ candidate_window_p (Lisp_Object window, Lisp_Object owindow, Lisp_Object minibuf
candidate_p = 1;
else if (NILP (all_frames))
{
- xassert (WINDOWP (owindow));
+ eassert (WINDOWP (owindow));
candidate_p = EQ (w->frame, XWINDOW (owindow)->frame);
}
else if (EQ (all_frames, Qvisible))
@@ -2080,11 +2239,9 @@ candidate_window_p (Lisp_Object window, Lisp_Object owindow, Lisp_Object minibuf
static void
decode_next_window_args (Lisp_Object *window, Lisp_Object *minibuf, Lisp_Object *all_frames)
{
- if (NILP (*window))
- *window = selected_window;
- else
- CHECK_LIVE_WINDOW (*window);
+ struct window *w = decode_live_window (*window);
+ XSETWINDOW (*window, w);
/* MINIBUF nil may or may not include minibuffers. Decide if it
does. */
if (NILP (*minibuf))
@@ -2098,9 +2255,10 @@ decode_next_window_args (Lisp_Object *window, Lisp_Object *minibuf, Lisp_Object
/* ALL_FRAMES nil doesn't specify which frames to include. */
if (NILP (*all_frames))
- *all_frames = (!EQ (*minibuf, Qlambda)
- ? FRAME_MINIBUF_WINDOW (XFRAME (XWINDOW (*window)->frame))
- : Qnil);
+ *all_frames
+ = (!EQ (*minibuf, Qlambda)
+ ? FRAME_MINIBUF_WINDOW (XFRAME (w->frame))
+ : Qnil);
else if (EQ (*all_frames, Qvisible))
;
else if (EQ (*all_frames, make_number (0)))
@@ -2453,7 +2611,7 @@ window_loop (enum window_loop type, Lisp_Object obj, int mini, Lisp_Object frame
if (EQ (w->buffer, obj))
{
/* Undedicate WINDOW. */
- w->dedicated = Qnil;
+ wset_dedicated (w, Qnil);
/* Make WINDOW show the buffer returned by
other_buffer_safely, don't run any hooks. */
set_window_buffer
@@ -2471,7 +2629,7 @@ window_loop (enum window_loop type, Lisp_Object obj, int mini, Lisp_Object frame
if (EQ (w->buffer, obj))
{
mark_window_display_accurate (window, 0);
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
XBUFFER (obj)->prevent_redisplay_optimizations_p = 1;
++update_mode_lines;
best_window = window;
@@ -2481,8 +2639,8 @@ window_loop (enum window_loop type, Lisp_Object obj, int mini, Lisp_Object frame
/* Check for a window that has a killed buffer. */
case CHECK_ALL_WINDOWS:
if (! NILP (w->buffer)
- && NILP (BVAR (XBUFFER (w->buffer), name)))
- abort ();
+ && !BUFFER_LIVE_P (XBUFFER (w->buffer)))
+ emacs_abort ();
break;
case WINDOW_LOOP_UNUSED:
@@ -2546,8 +2704,8 @@ resize_root_window (Lisp_Object window, Lisp_Object delta, Lisp_Object horizonta
DEFUN ("delete-other-windows-internal", Fdelete_other_windows_internal,
Sdelete_other_windows_internal, 0, 2, "",
doc: /* Make WINDOW fill its frame.
-Only the frame WINDOW is on is affected. WINDOW may be any window and
-defaults to the selected one.
+Only the frame WINDOW is on is affected. WINDOW must be a valid window
+and defaults to the selected one.
Optional argument ROOT, if non-nil, must specify an internal window such
that WINDOW is in its window subtree. If this is the case, replace ROOT
@@ -2563,10 +2721,10 @@ window-start value is reasonable when this function is called. */)
struct window *w, *r, *s;
struct frame *f;
Lisp_Object sibling, pwindow, swindow IF_LINT (= Qnil), delta;
- EMACS_INT startpos IF_LINT (= 0);
+ ptrdiff_t startpos IF_LINT (= 0);
int top IF_LINT (= 0), new_top, resize_failed;
- w = decode_any_window (window);
+ w = decode_valid_window (window);
XSETWINDOW (window, w);
f = XFRAME (w->frame);
@@ -2579,7 +2737,7 @@ window-start value is reasonable when this function is called. */)
else
/* ROOT must be an ancestor of WINDOW. */
{
- r = decode_any_window (root);
+ r = decode_valid_window (root);
pwindow = XWINDOW (window)->parent;
while (!NILP (pwindow))
if (EQ (pwindow, root))
@@ -2610,7 +2768,7 @@ window-start value is reasonable when this function is called. */)
if (EQ (selected_frame, w->frame))
Fselect_window (window, Qnil);
else
- FRAME_SELECTED_WINDOW (f) = window;
+ fset_selected_window (f, window);
}
}
else
@@ -2640,11 +2798,29 @@ window-start value is reasonable when this function is called. */)
if (EQ (selected_frame, w->frame))
Fselect_window (swindow, Qnil);
else
- FRAME_SELECTED_WINDOW (f) = swindow;
+ fset_selected_window (f, swindow);
}
}
- BLOCK_INPUT;
+ block_input ();
+ if (!FRAME_INITIAL_P (f))
+ {
+ Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
+
+ /* We are going to free the glyph matrices of WINDOW, and with
+ that we might lose any information about glyph rows that have
+ some of their glyphs highlighted in mouse face. (These rows
+ are marked with a non-zero mouse_face_p flag.) If WINDOW
+ indeed has some glyphs highlighted in mouse face, signal to
+ frame's up-to-date hook that mouse highlight was overwritten,
+ so that it will arrange for redisplaying the highlight. */
+ if (EQ (hlinfo->mouse_face_window, window))
+ {
+ hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1;
+ hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1;
+ hlinfo->mouse_face_window = Qnil;
+ }
+ }
free_window_matrices (r);
windows_or_buffers_changed++;
@@ -2655,8 +2831,9 @@ window-start value is reasonable when this function is called. */)
if (NILP (w->buffer))
{
/* Resize child windows vertically. */
- XSETINT (delta, XINT (r->total_lines) - XINT (w->total_lines));
- w->top_line = r->top_line;
+ XSETINT (delta, XINT (r->total_lines)
+ - XINT (w->total_lines));
+ wset_top_line (w, r->top_line);
resize_root_window (window, delta, Qnil, Qnil);
if (window_resize_check (w, 0))
window_resize_apply (w, 0);
@@ -2672,9 +2849,10 @@ window-start value is reasonable when this function is called. */)
/* Resize child windows horizontally. */
if (!resize_failed)
{
- w->left_col = r->left_col;
- XSETINT (delta, XINT (r->total_cols) - XINT (w->total_cols));
- w->left_col = r->left_col;
+ wset_left_col (w, r->left_col);
+ XSETINT (delta,
+ XINT (r->total_cols) - XINT (w->total_cols));
+ wset_left_col (w, r->left_col);
resize_root_window (window, delta, Qt, Qnil);
if (window_resize_check (w, 1))
window_resize_apply (w, 1);
@@ -2702,32 +2880,32 @@ window-start value is reasonable when this function is called. */)
{
sibling = w->prev;
s = XWINDOW (sibling);
- s->next = w->next;
+ wset_next (s, w->next);
if (!NILP (s->next))
- XWINDOW (s->next)->prev = sibling;
+ wset_prev (XWINDOW (s->next), sibling);
}
else
/* Get SIBLING below (on the right of) WINDOW. */
{
sibling = w->next;
s = XWINDOW (sibling);
- s->prev = Qnil;
+ wset_prev (s, Qnil);
if (!NILP (XWINDOW (w->parent)->vchild))
- XWINDOW (w->parent)->vchild = sibling;
+ wset_vchild (XWINDOW (w->parent), sibling);
else
- XWINDOW (w->parent)->hchild = sibling;
+ wset_hchild (XWINDOW (w->parent), sibling);
}
/* Delete ROOT and all child windows of ROOT. */
if (!NILP (r->vchild))
{
delete_all_child_windows (r->vchild);
- r->vchild = Qnil;
+ wset_vchild (r, Qnil);
}
else if (!NILP (r->hchild))
{
delete_all_child_windows (r->hchild);
- r->hchild = Qnil;
+ wset_hchild (r, Qnil);
}
replace_window (root, window, 1);
@@ -2754,20 +2932,19 @@ window-start value is reasonable when this function is called. */)
pos = *vmotion (startpos, -top, w);
set_marker_both (w->start, w->buffer, pos.bufpos, pos.bytepos);
- w->window_end_valid = Qnil;
- w->start_at_line_beg = ((pos.bytepos == BEGV_BYTE
- || FETCH_BYTE (pos.bytepos - 1) == '\n') ? Qt
- : Qnil);
+ wset_window_end_valid (w, Qnil);
+ w->start_at_line_beg = (pos.bytepos == BEGV_BYTE
+ || FETCH_BYTE (pos.bytepos - 1) == '\n');
/* We need to do this, so that the window-scroll-functions
get called. */
- w->optional_new_start = Qt;
+ w->optional_new_start = 1;
set_buffer_internal (obuf);
}
}
adjust_glyphs (f);
- UNBLOCK_INPUT;
+ unblock_input ();
run_window_configuration_change_hook (f);
@@ -2845,23 +3022,18 @@ adjust_window_margins (struct window *w)
if (WINDOW_RIGHT_MARGIN_COLS (w) > 0)
{
if (WINDOW_LEFT_MARGIN_COLS (w) > 0)
- w->left_margin_cols = w->right_margin_cols
- = make_number (margin_cols/2);
+ {
+ wset_left_margin_cols (w, make_number (margin_cols / 2));
+ wset_right_margin_cols (w, make_number (margin_cols / 2));
+ }
else
- w->right_margin_cols = make_number (margin_cols);
+ wset_right_margin_cols (w, make_number (margin_cols));
}
else
- w->left_margin_cols = make_number (margin_cols);
+ wset_left_margin_cols (w, make_number (margin_cols));
return 1;
}
-static Lisp_Object Fset_window_margins (Lisp_Object, Lisp_Object, Lisp_Object);
-static Lisp_Object Fset_window_fringes (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object);
-static Lisp_Object Fset_window_scroll_bars (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object);
-static Lisp_Object Fset_window_vscroll (Lisp_Object, Lisp_Object, Lisp_Object);
-
/* The following three routines are needed for running a window's
configuration change hook. */
static void
@@ -2889,18 +3061,18 @@ select_frame_norecord (Lisp_Object frame)
void
run_window_configuration_change_hook (struct frame *f)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object frame, global_wcch
= Fdefault_value (Qwindow_configuration_change_hook);
XSETFRAME (frame, f);
- if (NILP (Vrun_hooks))
+ if (NILP (Vrun_hooks) || !NILP (inhibit_lisp_code))
return;
/* Use the right buffer. Matters when running the local hooks. */
if (current_buffer != XBUFFER (Fwindow_buffer (Qnil)))
{
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (Fwindow_buffer (Qnil));
}
@@ -2920,7 +3092,7 @@ run_window_configuration_change_hook (struct frame *f)
if (!NILP (Flocal_variable_p (Qwindow_configuration_change_hook,
buffer)))
{
- int inner_count = SPECPDL_INDEX ();
+ ptrdiff_t inner_count = SPECPDL_INDEX ();
record_unwind_protect (select_window_norecord, Fselected_window ());
select_window_norecord (window);
run_funs (Fbuffer_local_value (Qwindow_configuration_change_hook,
@@ -2935,12 +3107,12 @@ run_window_configuration_change_hook (struct frame *f)
}
DEFUN ("run-window-configuration-change-hook", Frun_window_configuration_change_hook,
- Srun_window_configuration_change_hook, 1, 1, 0,
- doc: /* Run `window-configuration-change-hook' for FRAME. */)
- (Lisp_Object frame)
+ Srun_window_configuration_change_hook, 0, 1, 0,
+ doc: /* Run `window-configuration-change-hook' for FRAME.
+If FRAME is omitted or nil, it defaults to the selected frame. */)
+ (Lisp_Object frame)
{
- CHECK_LIVE_FRAME (frame);
- run_window_configuration_change_hook (XFRAME (frame));
+ run_window_configuration_change_hook (decode_live_frame (frame));
return Qnil;
}
@@ -2955,26 +3127,26 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int
{
struct window *w = XWINDOW (window);
struct buffer *b = XBUFFER (buffer);
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int samebuf = EQ (buffer, w->buffer);
- w->buffer = buffer;
+ wset_buffer (w, buffer);
if (EQ (window, selected_window))
- BVAR (b, last_selected_window) = window;
+ bset_last_selected_window (b, window);
/* Let redisplay errors through. */
b->display_error_modiff = 0;
/* Update time stamps of buffer display. */
if (INTEGERP (BVAR (b, display_count)))
- XSETINT (BVAR (b, display_count), XINT (BVAR (b, display_count)) + 1);
- BVAR (b, display_time) = Fcurrent_time ();
+ bset_display_count (b, make_number (XINT (BVAR (b, display_count)) + 1));
+ bset_display_time (b, Fcurrent_time ());
- XSETFASTINT (w->window_end_pos, 0);
- XSETFASTINT (w->window_end_vpos, 0);
+ wset_window_end_pos (w, make_number (0));
+ wset_window_end_vpos (w, make_number (0));
memset (&w->last_cursor, 0, sizeof w->last_cursor);
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
if (!(keep_margins_p && samebuf))
{ /* If we're not actually changing the buffer, don't reset hscroll and
vscroll. This case happens for example when called from
@@ -2984,16 +3156,16 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int
Resetting hscroll and vscroll here is problematic for things like
image-mode and doc-view-mode since it resets the image's position
whenever we resize the frame. */
- w->hscroll = w->min_hscroll = make_number (0);
+ w->hscroll = w->min_hscroll = 0;
w->vscroll = 0;
set_marker_both (w->pointm, buffer, BUF_PT (b), BUF_PT_BYTE (b));
set_marker_restricted (w->start,
make_number (b->last_window_start),
buffer);
- w->start_at_line_beg = Qnil;
- w->force_start = Qnil;
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->start_at_line_beg = 0;
+ w->force_start = 0;
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
}
/* Maybe we could move this into the `if' but it's not obviously safe and
I doubt it's worth the trouble. */
@@ -3004,7 +3176,7 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int
because that might itself be a local variable. */
if (window_initialized)
{
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (buffer);
}
@@ -3019,7 +3191,8 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int
Lisp_Object save_left = w->left_margin_cols;
Lisp_Object save_right = w->right_margin_cols;
- w->left_margin_cols = w->right_margin_cols = Qnil;
+ wset_left_margin_cols (w, Qnil);
+ wset_right_margin_cols (w, Qnil);
Fset_window_fringes (window,
BVAR (b, left_fringe_width), BVAR (b, right_fringe_width),
@@ -3029,8 +3202,8 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int
BVAR (b, scroll_bar_width),
BVAR (b, vertical_scroll_bar_type), Qnil);
- w->left_margin_cols = save_left;
- w->right_margin_cols = save_right;
+ wset_left_margin_cols (w, save_left);
+ wset_right_margin_cols (w, save_right);
Fset_window_margins (window,
BVAR (b, left_margin_cols), BVAR (b, right_margin_cols));
@@ -3049,7 +3222,7 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int
DEFUN ("set-window-buffer", Fset_window_buffer, Sset_window_buffer, 2, 3, 0,
doc: /* Make WINDOW display BUFFER-OR-NAME as its contents.
-WINDOW has to be a live window and defaults to the selected one.
+WINDOW must be a live window and defaults to the selected one.
BUFFER-OR-NAME must be a buffer or the name of an existing buffer.
Optional third argument KEEP-MARGINS non-nil means that WINDOW's current
@@ -3066,12 +3239,12 @@ This function runs `window-scroll-functions' before running
(register Lisp_Object window, Lisp_Object buffer_or_name, Lisp_Object keep_margins)
{
register Lisp_Object tem, buffer;
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
XSETWINDOW (window, w);
buffer = Fget_buffer (buffer_or_name);
CHECK_BUFFER (buffer);
- if (NILP (BVAR (XBUFFER (buffer), name)))
+ if (!BUFFER_LIVE_P (XBUFFER (buffer)))
error ("Attempt to display deleted buffer");
tem = w->buffer;
@@ -3089,7 +3262,7 @@ This function runs `window-scroll-functions' before running
else
/* WINDOW is weakly dedicated to its buffer, reset
dedication. */
- w->dedicated = Qnil;
+ wset_dedicated (w, Qnil);
call1 (Qrecord_window_buffer, window);
}
@@ -3127,7 +3300,7 @@ displaying that buffer. */)
{
struct window *w = XWINDOW (object);
mark_window_display_accurate (object, 0);
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
if (BUFFERP (w->buffer))
XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1;
++update_mode_lines;
@@ -3136,7 +3309,7 @@ displaying that buffer. */)
if (STRINGP (object))
object = Fget_buffer (object);
- if (BUFFERP (object) && !NILP (BVAR (XBUFFER (object), name)))
+ if (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))
{
/* Walk all windows looking for buffer, and force update
of each of those windows. */
@@ -3151,7 +3324,7 @@ displaying that buffer. */)
return Qnil;
}
-
+/* Obsolete since 24.3. */
void
temp_output_buffer_show (register Lisp_Object buf)
{
@@ -3159,7 +3332,7 @@ temp_output_buffer_show (register Lisp_Object buf)
register Lisp_Object window;
register struct window *w;
- BVAR (XBUFFER (buf), directory) = BVAR (current_buffer, directory);
+ bset_directory (XBUFFER (buf), BVAR (current_buffer, directory));
Fset_buffer (buf);
BUF_SAVE_MODIFF (XBUFFER (buf)) = MODIFF;
@@ -3178,15 +3351,15 @@ temp_output_buffer_show (register Lisp_Object buf)
Fmake_frame_visible (WINDOW_FRAME (XWINDOW (window)));
Vminibuf_scroll_window = window;
w = XWINDOW (window);
- XSETFASTINT (w->hscroll, 0);
- XSETFASTINT (w->min_hscroll, 0);
+ w->hscroll = 0;
+ w->min_hscroll = 0;
set_marker_restricted_both (w->start, buf, BEG, BEG);
set_marker_restricted_both (w->pointm, buf, BEG, BEG);
/* Run temp-buffer-show-hook, with the chosen window selected
and its buffer current. */
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object prev_window, prev_buffer;
prev_window = selected_window;
XSETBUFFER (prev_buffer, old);
@@ -3204,16 +3377,6 @@ temp_output_buffer_show (register Lisp_Object buf)
}
}
}
-
-DEFUN ("internal-temp-output-buffer-show",
- Ftemp_output_buffer_show, Stemp_output_buffer_show,
- 1, 1, 0,
- doc: /* Internal function for `with-output-to-temp-buffer'. */)
- (Lisp_Object buf)
-{
- temp_output_buffer_show (buf);
- return Qnil;
-}
/* Make new window, have it replace WINDOW in window-tree, and make
WINDOW its only vertical child (HORFLAG 1 means make WINDOW its only
@@ -3223,31 +3386,29 @@ make_parent_window (Lisp_Object window, int horflag)
{
Lisp_Object parent;
register struct window *o, *p;
- int i;
o = XWINDOW (window);
p = allocate_window ();
- for (i = 0; i < VECSIZE (struct window); ++i)
- ((struct Lisp_Vector *) p)->contents[i]
- = ((struct Lisp_Vector *) o)->contents[i];
+ memcpy ((char *) p + sizeof (struct vectorlike_header),
+ (char *) o + sizeof (struct vectorlike_header),
+ word_size * VECSIZE (struct window));
XSETWINDOW (parent, p);
- ++sequence_number;
- XSETFASTINT (p->sequence_number, sequence_number);
+ p->sequence_number = ++sequence_number;
replace_window (window, parent, 1);
- o->next = Qnil;
- o->prev = Qnil;
- o->parent = parent;
+ wset_next (o, Qnil);
+ wset_prev (o, Qnil);
+ wset_parent (o, parent);
- p->hchild = horflag ? window : Qnil;
- p->vchild = horflag ? Qnil : window;
- p->start = Qnil;
- p->pointm = Qnil;
- p->buffer = Qnil;
- p->combination_limit = Qnil;
- p->window_parameters = Qnil;
+ wset_hchild (p, horflag ? window : Qnil);
+ wset_vchild (p, horflag ? Qnil : window);
+ wset_start (p, Qnil);
+ wset_pointm (p, Qnil);
+ wset_buffer (p, Qnil);
+ wset_combination_limit (p, Qnil);
+ wset_window_parameters (p, Qnil);
}
/* Make new window from scratch. */
@@ -3258,57 +3419,33 @@ make_window (void)
register struct window *w;
w = allocate_window ();
- /* Initialize all Lisp data. */
- w->frame = w->mini_p = Qnil;
- w->next = w->prev = w->hchild = w->vchild = w->parent = Qnil;
- XSETFASTINT (w->left_col, 0);
- XSETFASTINT (w->top_line, 0);
- XSETFASTINT (w->total_lines, 0);
- XSETFASTINT (w->total_cols, 0);
- w->normal_lines = make_float (1.0);
- w->normal_cols = make_float (1.0);
- XSETFASTINT (w->new_total, 0);
- XSETFASTINT (w->new_normal, 0);
- w->buffer = Qnil;
- w->start = Fmake_marker ();
- w->pointm = Fmake_marker ();
- w->force_start = w->optional_new_start = Qnil;
- XSETFASTINT (w->hscroll, 0);
- XSETFASTINT (w->min_hscroll, 0);
- XSETFASTINT (w->use_time, 0);
- ++sequence_number;
- XSETFASTINT (w->sequence_number, sequence_number);
- w->temslot = w->last_modified = w->last_overlay_modified = Qnil;
- XSETFASTINT (w->last_point, 0);
- w->last_had_star = w->vertical_scroll_bar = Qnil;
- w->left_margin_cols = w->right_margin_cols = Qnil;
- w->left_fringe_width = w->right_fringe_width = Qnil;
- w->fringes_outside_margins = Qnil;
- w->scroll_bar_width = Qnil;
- w->vertical_scroll_bar_type = Qt;
- w->last_mark_x = w->last_mark_y = Qnil;
- XSETFASTINT (w->window_end_pos, 0);
- XSETFASTINT (w->window_end_vpos, 0);
- w->window_end_valid = w->update_mode_line = Qnil;
- w->start_at_line_beg = w->display_table = w->dedicated = Qnil;
- w->base_line_number = w->base_line_pos = w->region_showing = Qnil;
- w->column_number_displayed = w->redisplay_end_trigger = Qnil;
- w->combination_limit = w->window_parameters = Qnil;
- w->prev_buffers = w->next_buffers = Qnil;
- /* Initialize non-Lisp data. */
- w->desired_matrix = w->current_matrix = 0;
+ /* Initialize Lisp data. Note that allocate_window initializes all
+ Lisp data to nil, so do it only for slots which should not be nil. */
+ wset_left_col (w, make_number (0));
+ wset_top_line (w, make_number (0));
+ wset_total_lines (w, make_number (0));
+ wset_total_cols (w, make_number (0));
+ wset_normal_lines (w, make_float (1.0));
+ wset_normal_cols (w, make_float (1.0));
+ wset_new_total (w, make_number (0));
+ wset_new_normal (w, make_number (0));
+ wset_start (w, Fmake_marker ());
+ wset_pointm (w, Fmake_marker ());
+ wset_vertical_scroll_bar_type (w, Qt);
+ wset_window_end_pos (w, make_number (0));
+ wset_window_end_vpos (w, make_number (0));
+ /* These Lisp fields are marked specially so they're not set to nil by
+ allocate_window. */
+ wset_prev_buffers (w, Qnil);
+ wset_next_buffers (w, Qnil);
+
+ /* Initialize non-Lisp data. Note that allocate_window zeroes out all
+ non-Lisp data, so do it only for slots which should not be zero. */
w->nrows_scale_factor = w->ncols_scale_factor = 1;
- memset (&w->cursor, 0, sizeof (w->cursor));
- memset (&w->last_cursor, 0, sizeof (w->last_cursor));
- memset (&w->phys_cursor, 0, sizeof (w->phys_cursor));
w->phys_cursor_type = -1;
w->phys_cursor_width = -1;
- w->phys_cursor_on_p = 0;
- w->last_cursor_off_p = w->cursor_off_p = 0;
- w->must_be_updated_p = 0;
- w->pseudo_window_p = 0;
- w->frozen_window_start_p = 0;
- w->vscroll = 0;
+ w->sequence_number = ++sequence_number;
+
/* Reset window_list. */
Vwindow_list = Qnil;
/* Return window. */
@@ -3318,6 +3455,7 @@ make_window (void)
DEFUN ("set-window-new-total", Fset_window_new_total, Sset_window_new_total, 2, 3, 0,
doc: /* Set new total size of WINDOW to SIZE.
+WINDOW must be a valid window and defaults to the selected one.
Return SIZE.
Optional argument ADD non-nil means add SIZE to the new total size of
@@ -3326,28 +3464,27 @@ WINDOW and return the sum.
Note: This function does not operate on any child windows of WINDOW. */)
(Lisp_Object window, Lisp_Object size, Lisp_Object add)
{
- struct window *w = decode_any_window (window);
+ struct window *w = decode_valid_window (window);
CHECK_NUMBER (size);
if (NILP (add))
- XSETINT (w->new_total, XINT (size));
+ wset_new_total (w, size);
else
- XSETINT (w->new_total, XINT (w->new_total) + XINT (size));
+ wset_new_total (w, make_number (XINT (w->new_total) + XINT (size)));
return w->new_total;
}
DEFUN ("set-window-new-normal", Fset_window_new_normal, Sset_window_new_normal, 1, 2, 0,
doc: /* Set new normal size of WINDOW to SIZE.
+WINDOW must be a valid window and defaults to the selected one.
Return SIZE.
Note: This function does not operate on any child windows of WINDOW. */)
(Lisp_Object window, Lisp_Object size)
{
- struct window *w = decode_any_window (window);
-
- w->new_normal = size;
- return w->new_normal;
+ wset_new_normal (decode_valid_window (window), size);
+ return size;
}
/* Return 1 if setting w->total_lines (w->total_cols if HORFLAG is
@@ -3448,17 +3585,17 @@ window_resize_apply (struct window *w, int horflag)
parent window has been set *before*. */
if (horflag)
{
- w->total_cols = w->new_total;
+ wset_total_cols (w, w->new_total);
if (NUMBERP (w->new_normal))
- w->normal_cols = w->new_normal;
+ wset_normal_cols (w, w->new_normal);
pos = XINT (w->left_col);
}
else
{
- w->total_lines = w->new_total;
+ wset_total_lines (w, w->new_total);
if (NUMBERP (w->new_normal))
- w->normal_lines = w->new_normal;
+ wset_normal_lines (w, w->new_normal);
pos = XINT (w->top_line);
}
@@ -3470,9 +3607,9 @@ window_resize_apply (struct window *w, int horflag)
while (c)
{
if (horflag)
- XSETFASTINT (c->left_col, pos);
+ wset_left_col (c, make_number (pos));
else
- XSETFASTINT (c->top_line, pos);
+ wset_top_line (c, make_number (pos));
window_resize_apply (c, horflag);
if (!horflag)
pos = pos + XINT (c->total_lines);
@@ -3486,9 +3623,9 @@ window_resize_apply (struct window *w, int horflag)
while (c)
{
if (horflag)
- XSETFASTINT (c->left_col, pos);
+ wset_left_col (c, make_number (pos));
else
- XSETFASTINT (c->top_line, pos);
+ wset_top_line (c, make_number (pos));
window_resize_apply (c, horflag);
if (horflag)
pos = pos + XINT (c->total_cols);
@@ -3497,15 +3634,17 @@ window_resize_apply (struct window *w, int horflag)
}
/* Clear out some redisplay caches. */
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
}
-DEFUN ("window-resize-apply", Fwindow_resize_apply, Swindow_resize_apply, 1, 2, 0,
+DEFUN ("window-resize-apply", Fwindow_resize_apply, Swindow_resize_apply, 0, 2, 0,
doc: /* Apply requested size values for window-tree of FRAME.
-Optional argument HORIZONTAL omitted or nil means apply requested height
-values. HORIZONTAL non-nil means apply requested width values.
+If FRAME is omitted or nil, it defaults to the selected frame.
+
+Optional argument HORIZONTAL omitted or nil means apply requested
+height values. HORIZONTAL non-nil means apply requested width values.
This function checks whether the requested values sum up to a valid
window layout, recursively assigns the new sizes of all child windows
@@ -3516,29 +3655,23 @@ Note: This function does not check any of `window-fixed-size-p',
be applied on the Elisp level. */)
(Lisp_Object frame, Lisp_Object horizontal)
{
- struct frame *f;
- struct window *r;
+ struct frame *f = decode_live_frame (frame);
+ struct window *r = XWINDOW (FRAME_ROOT_WINDOW (f));
int horflag = !NILP (horizontal);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
-
- f = XFRAME (frame);
- r = XWINDOW (FRAME_ROOT_WINDOW (f));
-
if (!window_resize_check (r, horflag)
- || ! EQ (r->new_total, (horflag ? r->total_cols : r->total_lines)))
+ || ! EQ (r->new_total,
+ (horflag ? r->total_cols : r->total_lines)))
return Qnil;
- BLOCK_INPUT;
+ block_input ();
window_resize_apply (r, horflag);
windows_or_buffers_changed++;
FRAME_WINDOW_SIZES_CHANGED (f) = 1;
adjust_glyphs (f);
- UNBLOCK_INPUT;
+ unblock_input ();
run_window_configuration_change_hook (f);
@@ -3568,23 +3701,25 @@ resize_frame_windows (struct frame *f, int size, int horflag)
- ((FRAME_HAS_MINIBUF_P (f) && !FRAME_MINIBUF_ONLY_P (f))
? 1 : 0)));
- XSETFASTINT (r->top_line, FRAME_TOP_MARGIN (f));
+ wset_top_line (r, make_number (FRAME_TOP_MARGIN (f)));
if (NILP (r->vchild) && NILP (r->hchild))
/* For a leaf root window just set the size. */
if (horflag)
- XSETFASTINT (r->total_cols, new_size);
+ wset_total_cols (r, make_number (new_size));
else
- XSETFASTINT (r->total_lines, new_size);
+ wset_total_lines (r, make_number (new_size));
else
{
/* old_size is the old size of the frame's root window. */
- int old_size = XFASTINT (horflag ? r->total_cols : r->total_lines);
+ int old_size = XFASTINT (horflag ? r->total_cols
+ : r->total_lines);
Lisp_Object delta;
XSETINT (delta, new_size - old_size);
/* Try a "normal" resize first. */
resize_root_window (root, delta, horflag ? Qt : Qnil, Qnil);
- if (window_resize_check (r, horflag) && new_size == XINT (r->new_total))
+ if (window_resize_check (r, horflag)
+ && new_size == XINT (r->new_total))
window_resize_apply (r, horflag);
else
{
@@ -3607,9 +3742,9 @@ resize_frame_windows (struct frame *f, int size, int horflag)
root = f->selected_window;
Fdelete_other_windows_internal (root, Qnil);
if (horflag)
- XSETFASTINT (XWINDOW (root)->total_cols, new_size);
+ wset_total_cols (XWINDOW (root), make_number (new_size));
else
- XSETFASTINT (XWINDOW (root)->total_lines, new_size);
+ wset_total_lines (XWINDOW (root), make_number (new_size));
}
}
}
@@ -3619,14 +3754,17 @@ resize_frame_windows (struct frame *f, int size, int horflag)
{
m = XWINDOW (mini);
if (horflag)
- XSETFASTINT (m->total_cols, size);
+ wset_total_cols (m, make_number (size));
else
{
/* Are we sure we always want 1 line here? */
- XSETFASTINT (m->total_lines, 1);
- XSETFASTINT (m->top_line, XINT (r->top_line) + XINT (r->total_lines));
+ wset_total_lines (m, make_number (1));
+ wset_top_line
+ (m, make_number (XINT (r->top_line) + XINT (r->total_lines)));
}
}
+
+ windows_or_buffers_changed++;
}
@@ -3679,7 +3817,7 @@ set correctly. See the code of `split-window' for how this is done. */)
We do that if either `window-combination-limit' is t, or OLD has no
parent, or OLD is ortho-combined. */
combination_limit =
- !NILP (Vwindow_combination_limit)
+ EQ (Vwindow_combination_limit, Qt)
|| NILP (o->parent)
|| NILP (horflag
? (XWINDOW (o->parent)->hchild)
@@ -3705,14 +3843,14 @@ set correctly. See the code of `split-window' for how this is done. */)
{
p = XWINDOW (o->parent);
/* Temporarily pretend we split the parent window. */
- XSETINT (p->new_total,
- XINT (horflag ? p->total_cols : p->total_lines)
- - XINT (total_size));
+ wset_new_total
+ (p, make_number (XINT (horflag ? p->total_cols : p->total_lines)
+ - XINT (total_size)));
if (!window_resize_check (p, horflag))
error ("Window sizes don't fit");
else
/* Undo the temporary pretension. */
- p->new_total = horflag ? p->total_cols : p->total_lines;
+ wset_new_total (p, horflag ? p->total_cols : p->total_lines);
}
else
{
@@ -3729,16 +3867,18 @@ set correctly. See the code of `split-window' for how this is done. */)
/* Save the old value of o->normal_cols/lines. It gets corrupted
by make_parent_window and we need it below for assigning it to
p->new_normal. */
- Lisp_Object new_normal = horflag ? o->normal_cols : o->normal_lines;
+ Lisp_Object new_normal
+ = horflag ? o->normal_cols : o->normal_lines;
make_parent_window (old, horflag);
p = XWINDOW (o->parent);
- /* Store value of `window-combination-limit' in new parent's
- combination_limit slot. */
- p->combination_limit = Vwindow_combination_limit;
+ if (EQ (Vwindow_combination_limit, Qt))
+ /* Store t in the new parent's combination_limit slot to avoid
+ that its children get merged into another window. */
+ wset_combination_limit (p, Qt);
/* These get applied below. */
- p->new_total = horflag ? o->total_cols : o->total_lines;
- p->new_normal = new_normal;
+ wset_new_total (p, horflag ? o->total_cols : o->total_lines);
+ wset_new_normal (p, new_normal);
}
else
p = XWINDOW (o->parent);
@@ -3747,69 +3887,70 @@ set correctly. See the code of `split-window' for how this is done. */)
FRAME_WINDOW_SIZES_CHANGED (f) = 1;
new = make_window ();
n = XWINDOW (new);
- n->frame = frame;
- n->parent = o->parent;
- n->vchild = n->hchild = Qnil;
+ wset_frame (n, frame);
+ wset_parent (n, o->parent);
+ wset_vchild (n, Qnil);
+ wset_hchild (n, Qnil);
if (EQ (side, Qabove) || EQ (side, Qleft))
{
- n->prev = o->prev;
+ wset_prev (n, o->prev);
if (NILP (n->prev))
if (horflag)
- p->hchild = new;
+ wset_hchild (p, new);
else
- p->vchild = new;
+ wset_vchild (p, new);
else
- XWINDOW (n->prev)->next = new;
- n->next = old;
- o->prev = new;
+ wset_next (XWINDOW (n->prev), new);
+ wset_next (n, old);
+ wset_prev (o, new);
}
else
{
- n->next = o->next;
+ wset_next (n, o->next);
if (!NILP (n->next))
- XWINDOW (n->next)->prev = new;
- n->prev = old;
- o->next = new;
+ wset_prev (XWINDOW (n->next), new);
+ wset_prev (n, old);
+ wset_next (o, new);
}
- n->buffer = Qt;
- n->window_end_valid = Qnil;
+ wset_buffer (n, Qt);
+ wset_window_end_valid (n, Qnil);
memset (&n->last_cursor, 0, sizeof n->last_cursor);
/* Get special geometry settings from reference window. */
- n->left_margin_cols = r->left_margin_cols;
- n->right_margin_cols = r->right_margin_cols;
- n->left_fringe_width = r->left_fringe_width;
- n->right_fringe_width = r->right_fringe_width;
+ wset_left_margin_cols (n, r->left_margin_cols);
+ wset_right_margin_cols (n, r->right_margin_cols);
+ wset_left_fringe_width (n, r->left_fringe_width);
+ wset_right_fringe_width (n, r->right_fringe_width);
n->fringes_outside_margins = r->fringes_outside_margins;
- n->scroll_bar_width = r->scroll_bar_width;
- n->vertical_scroll_bar_type = r->vertical_scroll_bar_type;
+ wset_scroll_bar_width (n, r->scroll_bar_width);
+ wset_vertical_scroll_bar_type (n, r->vertical_scroll_bar_type);
/* Directly assign orthogonal coordinates and sizes. */
if (horflag)
{
- n->top_line = o->top_line;
- n->total_lines = o->total_lines;
+ wset_top_line (n, o->top_line);
+ wset_total_lines (n, o->total_lines);
}
else
{
- n->left_col = o->left_col;
- n->total_cols = o->total_cols;
+ wset_left_col (n, o->left_col);
+ wset_total_cols (n, o->total_cols);
}
/* Iso-coordinates and sizes are assigned by window_resize_apply,
get them ready here. */
- n->new_total = total_size;
- n->new_normal = normal_size;
+ wset_new_total (n, total_size);
+ wset_new_normal (n, normal_size);
- BLOCK_INPUT;
+ block_input ();
window_resize_apply (p, horflag);
adjust_glyphs (f);
/* Set buffer of NEW to buffer of reference window. Don't run
any hooks. */
set_window_buffer (new, r->buffer, 0, 1);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Maybe we should run the scroll functions in Elisp (which already
runs the configuration change hook). */
@@ -3835,7 +3976,8 @@ Signal an error when WINDOW is the only window on its frame. */)
w = decode_any_window (window);
XSETWINDOW (window, w);
- if (NILP (w->buffer) && NILP (w->hchild) && NILP (w->vchild))
+ if (NILP (w->buffer)
+ && NILP (w->hchild) && NILP (w->vchild))
/* It's a no-op to delete an already deleted window. */
return Qnil;
@@ -3866,53 +4008,65 @@ Signal an error when WINDOW is the only window on its frame. */)
before_sibling = 1;
sibling = w->next;
s = XWINDOW (sibling);
- s->prev = Qnil;
+ wset_prev (s, Qnil);
if (horflag)
- p->hchild = sibling;
+ wset_hchild (p, sibling);
else
- p->vchild = sibling;
+ wset_vchild (p, sibling);
}
else
/* Get SIBLING above (on the left of) WINDOW. */
{
sibling = w->prev;
s = XWINDOW (sibling);
- s->next = w->next;
+ wset_next (s, w->next);
if (!NILP (s->next))
- XWINDOW (s->next)->prev = sibling;
+ wset_prev (XWINDOW (s->next), sibling);
}
if (window_resize_check (r, horflag)
- && EQ (r->new_total, (horflag ? r->total_cols : r->total_lines)))
+ && EQ (r->new_total,
+ (horflag ? r->total_cols : r->total_lines)))
/* We can delete WINDOW now. */
{
+
/* Block input. */
- BLOCK_INPUT;
+ block_input ();
window_resize_apply (p, horflag);
+ /* If this window is referred to by the dpyinfo's mouse
+ highlight, invalidate that slot to be safe (Bug#9904). */
+ if (!FRAME_INITIAL_P (f))
+ {
+ Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
+
+ if (EQ (hlinfo->mouse_face_window, window))
+ hlinfo->mouse_face_window = Qnil;
+ }
+
windows_or_buffers_changed++;
Vwindow_list = Qnil;
FRAME_WINDOW_SIZES_CHANGED (f) = 1;
- w->next = Qnil; /* Don't delete w->next too. */
+ wset_next (w, Qnil); /* Don't delete w->next too. */
free_window_matrices (w);
if (!NILP (w->vchild))
{
delete_all_child_windows (w->vchild);
- w->vchild = Qnil;
+ wset_vchild (w, Qnil);
}
else if (!NILP (w->hchild))
{
delete_all_child_windows (w->hchild);
- w->hchild = Qnil;
+ wset_hchild (w, Qnil);
}
else if (!NILP (w->buffer))
{
unshow_buffer (w);
unchain_marker (XMARKER (w->pointm));
unchain_marker (XMARKER (w->start));
- w->buffer = Qnil;
+ wset_buffer (w, Qnil);
}
if (NILP (s->prev) && NILP (s->next))
@@ -3923,10 +4077,11 @@ Signal an error when WINDOW is the only window on its frame. */)
replace_window (parent, sibling, 0);
/* Have SIBLING inherit the following three slot values from
PARENT (the combination_limit slot is not inherited). */
- s->normal_cols = p->normal_cols;
- s->normal_lines = p->normal_lines;
+ wset_normal_cols (s, p->normal_cols);
+ wset_normal_lines (s, p->normal_lines);
/* Mark PARENT as deleted. */
- p->vchild = p->hchild = Qnil;
+ wset_vchild (p, Qnil);
+ wset_hchild (p, Qnil);
/* Try to merge SIBLING into its new parent. */
recombine_windows (sibling);
}
@@ -3946,9 +4101,9 @@ Signal an error when WINDOW is the only window on its frame. */)
if (EQ (FRAME_SELECTED_WINDOW (f), selected_window))
Fselect_window (new_selected_window, Qt);
else
- FRAME_SELECTED_WINDOW (f) = new_selected_window;
+ fset_selected_window (f, new_selected_window);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Now look whether `get-mru-window' gets us something. */
mru_window = call1 (Qget_mru_window, frame);
@@ -3960,10 +4115,10 @@ Signal an error when WINDOW is the only window on its frame. */)
if (EQ (FRAME_SELECTED_WINDOW (f), selected_window))
Fselect_window (new_selected_window, Qnil);
else
- FRAME_SELECTED_WINDOW (f) = new_selected_window;
+ fset_selected_window (f, new_selected_window);
}
else
- UNBLOCK_INPUT;
+ unblock_input ();
/* Must be run by the caller:
run_window_configuration_change_hook (f); */
@@ -3973,17 +4128,17 @@ Signal an error when WINDOW is the only window on its frame. */)
{
if (before_sibling)
{
- s->prev = window;
+ wset_prev (s, window);
if (horflag)
- p->hchild = window;
+ wset_hchild (p, window);
else
- p->vchild = window;
+ wset_vchild (p, window);
}
else
{
- s->next = window;
+ wset_next (s, window);
if (!NILP (w->next))
- XWINDOW (w->next)->prev = window;
+ wset_prev (XWINDOW (w->next), window);
}
error ("Deletion failed");
}
@@ -4004,8 +4159,8 @@ grow_mini_window (struct window *w, int delta)
struct window *r;
Lisp_Object root, value;
- xassert (MINI_WINDOW_P (w));
- xassert (delta >= 0);
+ eassert (MINI_WINDOW_P (w));
+ eassert (delta >= 0);
root = FRAME_ROOT_WINDOW (f);
r = XWINDOW (root);
@@ -4013,17 +4168,20 @@ grow_mini_window (struct window *w, int delta)
root, make_number (- delta));
if (INTEGERP (value) && window_resize_check (r, 0))
{
- BLOCK_INPUT;
+ block_input ();
window_resize_apply (r, 0);
/* Grow the mini-window. */
- XSETFASTINT (w->top_line, XFASTINT (r->top_line) + XFASTINT (r->total_lines));
- XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - XINT (value));
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ wset_top_line
+ (w, make_number (XFASTINT (r->top_line) + XFASTINT (r->total_lines)));
+ wset_total_lines
+ (w, make_number (XFASTINT (w->total_lines) - XINT (value)));
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
+ windows_or_buffers_changed++;
adjust_glyphs (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -4037,7 +4195,7 @@ shrink_mini_window (struct window *w)
Lisp_Object root, value;
EMACS_INT size;
- xassert (MINI_WINDOW_P (w));
+ eassert (MINI_WINDOW_P (w));
size = XINT (w->total_lines);
if (size > 1)
@@ -4048,18 +4206,20 @@ shrink_mini_window (struct window *w)
root, make_number (size - 1));
if (INTEGERP (value) && window_resize_check (r, 0))
{
- BLOCK_INPUT;
+ block_input ();
window_resize_apply (r, 0);
/* Shrink the mini-window. */
- XSETFASTINT (w->top_line, XFASTINT (r->top_line) + XFASTINT (r->total_lines));
- XSETFASTINT (w->total_lines, 1);
+ wset_top_line (w, make_number (XFASTINT (r->top_line)
+ + XFASTINT (r->total_lines)));
+ wset_total_lines (w, make_number (1));
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
+ windows_or_buffers_changed++;
adjust_glyphs (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* If the above failed for whatever strange reason we must make a
one window frame here. The same routine will be needed when
@@ -4091,16 +4251,17 @@ DEFUN ("resize-mini-window-internal", Fresize_mini_window_internal, Sresize_mini
&& XINT (w->new_total) > 0
&& height == XINT (r->new_total) + XINT (w->new_total))
{
- BLOCK_INPUT;
+ block_input ();
window_resize_apply (r, 0);
- w->total_lines = w->new_total;
- XSETFASTINT (w->top_line, XINT (r->top_line) + XINT (r->total_lines));
+ wset_total_lines (w, w->new_total);
+ wset_top_line (w, make_number (XINT (r->top_line)
+ + XINT (r->total_lines)));
windows_or_buffers_changed++;
FRAME_WINDOW_SIZES_CHANGED (f) = 1;
adjust_glyphs (f);
- UNBLOCK_INPUT;
+ unblock_input ();
run_window_configuration_change_hook (f);
return Qt;
@@ -4166,9 +4327,10 @@ window_internal_height (struct window *w)
respectively. */
static void
-window_scroll (Lisp_Object window, int n, int whole, int noerror)
+window_scroll (Lisp_Object window, EMACS_INT n, int whole, int noerror)
{
immediate_quit = 1;
+ n = clip_to_bounds (INT_MIN, n, INT_MAX);
/* If we must, use the pixel-based version which is much slower than
the line-based one but can handle varying line heights. */
@@ -4198,6 +4360,11 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror)
void *itdata = NULL;
SET_TEXT_POS_FROM_MARKER (start, w->start);
+ /* Scrolling a minibuffer window via scroll bar when the echo area
+ shows long text sometimes resets the minibuffer contents behind
+ our backs. */
+ if (CHARPOS (start) > ZV)
+ SET_TEXT_POS (start, BEGV, BEGV_BYTE);
/* If PT is not visible in WINDOW, move back one half of
the screen. Allow PT to be partially visible, otherwise
@@ -4264,7 +4431,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror)
/* Maybe modify window start instead of scrolling. */
if (rbot > 0 || w->vscroll < 0)
{
- EMACS_INT spos;
+ ptrdiff_t spos;
Fset_window_vscroll (window, make_number (0), Qt);
/* If there are other text lines above the current row,
@@ -4275,13 +4442,13 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror)
spos = min (XINT (Fline_end_position (Qnil)) + 1, ZV);
set_marker_restricted (w->start, make_number (spos),
w->buffer);
- w->start_at_line_beg = Qt;
- w->update_mode_line = Qt;
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->start_at_line_beg = 1;
+ w->update_mode_line = 1;
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
/* Set force_start so that redisplay_window will run the
window-scroll-functions. */
- w->force_start = Qt;
+ w->force_start = 1;
return;
}
}
@@ -4319,7 +4486,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror)
start_display (&it, w, start);
if (whole)
{
- EMACS_INT start_pos = IT_CHARPOS (it);
+ ptrdiff_t start_pos = IT_CHARPOS (it);
int dy = WINDOW_FRAME_LINE_HEIGHT (w);
dy = max ((window_box_height (w)
- next_screen_context_lines * dy),
@@ -4406,8 +4573,8 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror)
if (! vscrolled)
{
- EMACS_INT pos = IT_CHARPOS (it);
- EMACS_INT bytepos;
+ ptrdiff_t pos = IT_CHARPOS (it);
+ ptrdiff_t bytepos;
/* If in the middle of a multi-glyph character move forward to
the next character. */
@@ -4421,14 +4588,13 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror)
set_marker_restricted (w->start, make_number (pos),
w->buffer);
bytepos = XMARKER (w->start)->bytepos;
- w->start_at_line_beg = ((pos == BEGV || FETCH_BYTE (bytepos - 1) == '\n')
- ? Qt : Qnil);
- w->update_mode_line = Qt;
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->start_at_line_beg = (pos == BEGV || FETCH_BYTE (bytepos - 1) == '\n');
+ w->update_mode_line = 1;
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
/* Set force_start so that redisplay_window will run the
window-scroll-functions. */
- w->force_start = Qt;
+ w->force_start = 1;
}
/* The rest of this function uses current_y in a nonstandard way,
@@ -4439,7 +4605,8 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror)
This code wants current_y to be zero at the window start position
even if there is a header line. */
this_scroll_margin = max (0, scroll_margin);
- this_scroll_margin = min (this_scroll_margin, XFASTINT (w->total_lines) / 4);
+ this_scroll_margin
+ = min (this_scroll_margin, XFASTINT (w->total_lines) / 4);
this_scroll_margin *= FRAME_LINE_HEIGHT (it.f);
if (n > 0)
@@ -4477,7 +4644,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror)
}
else if (n < 0)
{
- EMACS_INT charpos, bytepos;
+ ptrdiff_t charpos, bytepos;
int partial_p;
/* Save our position, for the
@@ -4554,12 +4721,12 @@ window_scroll_line_based (Lisp_Object window, int n, int whole, int noerror)
in `grep-mode-font-lock-keywords'). So we use a marker to record
the old point position, to prevent crashes in SET_PT_BOTH. */
Lisp_Object opoint_marker = Fpoint_marker ();
- register EMACS_INT pos, pos_byte;
+ register ptrdiff_t pos, pos_byte;
register int ht = window_internal_height (w);
register Lisp_Object tem;
int lose;
Lisp_Object bolp;
- EMACS_INT startpos;
+ ptrdiff_t startpos;
Lisp_Object original_pos = Qnil;
/* If scrolling screen-fulls, compute the number of lines to
@@ -4578,10 +4745,10 @@ window_scroll_line_based (Lisp_Object window, int n, int whole, int noerror)
struct position posit
= *compute_motion (startpos, 0, 0, 0,
PT, ht, 0,
- -1, XINT (w->hscroll),
+ -1, w->hscroll,
0, w);
window_scroll_preserve_vpos = posit.vpos;
- window_scroll_preserve_hpos = posit.hpos + XINT (w->hscroll);
+ window_scroll_preserve_hpos = posit.hpos + w->hscroll;
}
original_pos = Fcons (make_number (window_scroll_preserve_hpos),
@@ -4621,13 +4788,13 @@ window_scroll_line_based (Lisp_Object window, int n, int whole, int noerror)
max (0, min (scroll_margin, XINT (w->total_lines) / 4));
set_marker_restricted_both (w->start, w->buffer, pos, pos_byte);
- w->start_at_line_beg = bolp;
- w->update_mode_line = Qt;
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->start_at_line_beg = !NILP (bolp);
+ w->update_mode_line = 1;
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
/* Set force_start so that redisplay_window will run
the window-scroll-functions. */
- w->force_start = Qt;
+ w->force_start = 1;
if (!NILP (Vscroll_preserve_screen_position)
&& (whole || !EQ (Vscroll_preserve_screen_position, Qt)))
@@ -4708,9 +4875,9 @@ window_scroll_line_based (Lisp_Object window, int n, int whole, int noerror)
static void
scroll_command (Lisp_Object n, int direction)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
- xassert (eabs (direction) == 1);
+ eassert (eabs (direction) == 1);
/* If selected window's buffer isn't current, make it current for
the moment. But don't screw up if window_scroll gets an error. */
@@ -4823,7 +4990,7 @@ specifies the window to scroll. This takes precedence over
{
Lisp_Object window;
struct window *w;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
window = Fother_window_for_scrolling ();
w = XWINDOW (window);
@@ -4842,7 +5009,7 @@ specifies the window to scroll. This takes precedence over
else
{
if (CONSP (arg))
- arg = Fcar (arg);
+ arg = XCAR (arg);
CHECK_NUMBER (arg);
window_scroll (window, XINT (arg), 0, 1);
}
@@ -4864,17 +5031,11 @@ will not scroll a window to a column less than the value returned
by this function. This happens in an interactive call. */)
(register Lisp_Object arg, Lisp_Object set_minimum)
{
- Lisp_Object result;
- int hscroll;
struct window *w = XWINDOW (selected_window);
-
- if (NILP (arg))
- XSETFASTINT (arg, window_body_cols (w) - 2);
- else
- arg = Fprefix_numeric_value (arg);
-
- hscroll = XINT (w->hscroll) + XINT (arg);
- result = Fset_window_hscroll (selected_window, make_number (hscroll));
+ EMACS_INT requested_arg = (NILP (arg)
+ ? window_body_cols (w) - 2
+ : XINT (Fprefix_numeric_value (arg)));
+ Lisp_Object result = set_window_hscroll (w, w->hscroll + requested_arg);
if (!NILP (set_minimum))
w->min_hscroll = w->hscroll;
@@ -4893,17 +5054,11 @@ will not scroll a window to a column less than the value returned
by this function. This happens in an interactive call. */)
(register Lisp_Object arg, Lisp_Object set_minimum)
{
- Lisp_Object result;
- int hscroll;
struct window *w = XWINDOW (selected_window);
-
- if (NILP (arg))
- XSETFASTINT (arg, window_body_cols (w) - 2);
- else
- arg = Fprefix_numeric_value (arg);
-
- hscroll = XINT (w->hscroll) - XINT (arg);
- result = Fset_window_hscroll (selected_window, make_number (hscroll));
+ EMACS_INT requested_arg = (NILP (arg)
+ ? window_body_cols (w) - 2
+ : XINT (Fprefix_numeric_value (arg)));
+ Lisp_Object result = set_window_hscroll (w, w->hscroll - requested_arg);
if (!NILP (set_minimum))
w->min_hscroll = w->hscroll;
@@ -5005,7 +5160,7 @@ and redisplay normally--don't erase and redraw the frame. */)
struct buffer *buf = XBUFFER (w->buffer);
struct buffer *obuf = current_buffer;
int center_p = 0;
- EMACS_INT charpos, bytepos;
+ ptrdiff_t charpos, bytepos;
EMACS_INT iarg IF_LINT (= 0);
int this_scroll_margin;
@@ -5070,7 +5225,7 @@ and redisplay normally--don't erase and redraw the frame. */)
{
struct it it;
struct text_pos pt;
- int nlines = min (INT_MAX, -iarg);
+ ptrdiff_t nlines = min (PTRDIFF_MAX, -iarg);
int extra_line_spacing;
int h = window_box_height (w);
void *itdata = bidi_shelve_cache ();
@@ -5169,14 +5324,12 @@ and redisplay normally--don't erase and redraw the frame. */)
/* Set the new window start. */
set_marker_both (w->start, w->buffer, charpos, bytepos);
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
- w->optional_new_start = Qt;
+ w->optional_new_start = 1;
- if (bytepos == BEGV_BYTE || FETCH_BYTE (bytepos - 1) == '\n')
- w->start_at_line_beg = Qt;
- else
- w->start_at_line_beg = Qnil;
+ w->start_at_line_beg = (bytepos == BEGV_BYTE ||
+ FETCH_BYTE (bytepos - 1) == '\n');
set_buffer_internal (obuf);
return Qnil;
@@ -5185,13 +5338,13 @@ and redisplay normally--don't erase and redraw the frame. */)
DEFUN ("window-text-height", Fwindow_text_height, Swindow_text_height,
0, 1, 0,
doc: /* Return the height in lines of the text display area of WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
The returned height does not include the mode line, any header line,
nor any partial-height lines at the bottom of the text area. */)
(Lisp_Object window)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
int pixel_height = window_box_height (w);
int line_height = pixel_height / FRAME_LINE_HEIGHT (XFRAME (w->frame));
return make_number (line_height);
@@ -5227,8 +5380,8 @@ zero means top of window, negative means relative to bottom of window. */)
int height = window_internal_height (w);
Fvertical_motion (make_number (- (height / 2)), window);
set_marker_both (w->start, w->buffer, PT, PT_BYTE);
- w->start_at_line_beg = Fbolp ();
- w->force_start = Qt;
+ w->start_at_line_beg = !NILP (Fbolp ());
+ w->force_start = 1;
}
else
Fgoto_char (w->start);
@@ -5352,9 +5505,8 @@ the return value is nil. Otherwise the value is t. */)
struct Lisp_Vector *saved_windows;
Lisp_Object new_current_buffer;
Lisp_Object frame;
- Lisp_Object auto_buffer_name;
FRAME_PTR f;
- EMACS_INT old_point = -1;
+ ptrdiff_t old_point = -1;
CHECK_WINDOW_CONFIGURATION (configuration);
@@ -5362,7 +5514,7 @@ the return value is nil. Otherwise the value is t. */)
saved_windows = XVECTOR (data->saved_windows);
new_current_buffer = data->current_buffer;
- if (NILP (BVAR (XBUFFER (new_current_buffer), name)))
+ if (!BUFFER_LIVE_P (XBUFFER (new_current_buffer)))
new_current_buffer = Qnil;
else
{
@@ -5410,6 +5562,7 @@ the return value is nil. Otherwise the value is t. */)
{
Lisp_Object window;
Lisp_Object dead_windows = Qnil;
+ register Lisp_Object tem, par, pers;
register struct window *w;
register struct saved_window *p;
struct window *root_window;
@@ -5427,9 +5580,24 @@ the return value is nil. Otherwise the value is t. */)
int previous_frame_menu_bar_lines = FRAME_MENU_BAR_LINES (f);
int previous_frame_tool_bar_lines = FRAME_TOOL_BAR_LINES (f);
+ /* Don't do this within the main loop below: This may call Lisp
+ code and is thus potentially unsafe while input is blocked. */
+ for (k = 0; k < saved_windows->header.size; k++)
+ {
+ p = SAVED_WINDOW_N (saved_windows, k);
+ window = p->window;
+ w = XWINDOW (window);
+ if (!NILP (w->buffer)
+ && !EQ (w->buffer, p->buffer)
+ && BUFFER_LIVE_P (XBUFFER (p->buffer)))
+ /* If a window we restore gets another buffer, record the
+ window's old buffer. */
+ call1 (Qrecord_window_buffer, window);
+ }
+
/* The mouse highlighting code could get screwed up
if it runs during this. */
- BLOCK_INPUT;
+ block_input ();
if (data->frame_lines != previous_frame_lines
|| data->frame_cols != previous_frame_cols)
@@ -5470,9 +5638,8 @@ the return value is nil. Otherwise the value is t. */)
really like to do is to free only those matrices not reused
below. */
root_window = XWINDOW (FRAME_ROOT_WINDOW (f));
- leaf_windows
- = (struct window **) alloca (count_windows (root_window)
- * sizeof (struct window *));
+ leaf_windows = alloca (count_windows (root_window)
+ * sizeof *leaf_windows);
n_leaf_windows = get_leaf_windows (root_window, leaf_windows, 0);
/* Kludge Alert!
@@ -5489,34 +5656,34 @@ the return value is nil. Otherwise the value is t. */)
p = SAVED_WINDOW_N (saved_windows, k);
window = p->window;
w = XWINDOW (window);
- w->next = Qnil;
+ wset_next (w, Qnil);
if (!NILP (p->parent))
- w->parent = SAVED_WINDOW_N (saved_windows,
- XFASTINT (p->parent))->window;
+ wset_parent
+ (w, SAVED_WINDOW_N (saved_windows, XFASTINT (p->parent))->window);
else
- w->parent = Qnil;
+ wset_parent (w, Qnil);
if (!NILP (p->prev))
{
- w->prev = SAVED_WINDOW_N (saved_windows,
- XFASTINT (p->prev))->window;
- XWINDOW (w->prev)->next = p->window;
+ wset_prev
+ (w, SAVED_WINDOW_N (saved_windows, XFASTINT (p->prev))->window);
+ wset_next (XWINDOW (w->prev), p->window);
}
else
{
- w->prev = Qnil;
+ wset_prev (w, Qnil);
if (!NILP (w->parent))
{
if (EQ (p->total_cols, XWINDOW (w->parent)->total_cols))
{
- XWINDOW (w->parent)->vchild = p->window;
- XWINDOW (w->parent)->hchild = Qnil;
+ wset_vchild (XWINDOW (w->parent), p->window);
+ wset_hchild (XWINDOW (w->parent), Qnil);
}
else
{
- XWINDOW (w->parent)->hchild = p->window;
- XWINDOW (w->parent)->vchild = Qnil;
+ wset_hchild (XWINDOW (w->parent), p->window);
+ wset_vchild (XWINDOW (w->parent), Qnil);
}
}
}
@@ -5524,40 +5691,62 @@ the return value is nil. Otherwise the value is t. */)
/* If we squirreled away the buffer in the window's height,
restore it now. */
if (BUFFERP (w->total_lines))
- w->buffer = w->total_lines;
- w->left_col = p->left_col;
- w->top_line = p->top_line;
- w->total_cols = p->total_cols;
- w->total_lines = p->total_lines;
- w->normal_cols = p->normal_cols;
- w->normal_lines = p->normal_lines;
- w->hscroll = p->hscroll;
- w->min_hscroll = p->min_hscroll;
- w->display_table = p->display_table;
- w->left_margin_cols = p->left_margin_cols;
- w->right_margin_cols = p->right_margin_cols;
- w->left_fringe_width = p->left_fringe_width;
- w->right_fringe_width = p->right_fringe_width;
- w->fringes_outside_margins = p->fringes_outside_margins;
- w->scroll_bar_width = p->scroll_bar_width;
- w->vertical_scroll_bar_type = p->vertical_scroll_bar_type;
- w->dedicated = p->dedicated;
- w->combination_limit = p->combination_limit;
- w->window_parameters = p->window_parameters;
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ wset_buffer (w, w->total_lines);
+ wset_left_col (w, p->left_col);
+ wset_top_line (w, p->top_line);
+ wset_total_cols (w, p->total_cols);
+ wset_total_lines (w, p->total_lines);
+ wset_normal_cols (w, p->normal_cols);
+ wset_normal_lines (w, p->normal_lines);
+ w->hscroll = XFASTINT (p->hscroll);
+ w->min_hscroll = XFASTINT (p->min_hscroll);
+ wset_display_table (w, p->display_table);
+ wset_left_margin_cols (w, p->left_margin_cols);
+ wset_right_margin_cols (w, p->right_margin_cols);
+ wset_left_fringe_width (w, p->left_fringe_width);
+ wset_right_fringe_width (w, p->right_fringe_width);
+ w->fringes_outside_margins = !NILP (p->fringes_outside_margins);
+ wset_scroll_bar_width (w, p->scroll_bar_width);
+ wset_vertical_scroll_bar_type (w, p->vertical_scroll_bar_type);
+ wset_dedicated (w, p->dedicated);
+ wset_combination_limit (w, p->combination_limit);
+ /* Restore any window parameters that have been saved.
+ Parameters that have not been saved are left alone. */
+ for (tem = p->window_parameters; CONSP (tem); tem = XCDR (tem))
+ {
+ pers = XCAR (tem);
+ if (CONSP (pers))
+ {
+ if (NILP (XCDR (pers)))
+ {
+ par = Fassq (XCAR (pers), w->window_parameters);
+ if (CONSP (par) && !NILP (XCDR (par)))
+ /* Reset a parameter to nil if and only if it
+ has a non-nil association. Don't make new
+ associations. */
+ Fsetcdr (par, Qnil);
+ }
+ else
+ /* Always restore a non-nil value. */
+ Fset_window_parameter (window, XCAR (pers), XCDR (pers));
+ }
+ }
+
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
/* Reinstall the saved buffer and pointers into it. */
if (NILP (p->buffer))
/* An internal window. */
- w->buffer = p->buffer;
- else if (!NILP (BVAR (XBUFFER (p->buffer), name)))
+ wset_buffer (w, p->buffer);
+ else if (BUFFER_LIVE_P (XBUFFER (p->buffer)))
/* If saved buffer is alive, install it. */
{
- w->buffer = p->buffer;
- w->start_at_line_beg = p->start_at_line_beg;
+ wset_buffer (w, p->buffer);
+ w->start_at_line_beg = !NILP (p->start_at_line_beg);
set_marker_restricted (w->start, p->start, w->buffer);
- set_marker_restricted (w->pointm, p->pointm, w->buffer);
+ set_marker_restricted (w->pointm, p->pointm,
+ w->buffer);
Fset_marker (BVAR (XBUFFER (w->buffer), mark),
p->mark, w->buffer);
@@ -5567,30 +5756,23 @@ the return value is nil. Otherwise the value is t. */)
if (!EQ (p->buffer, new_current_buffer)
&& XBUFFER (p->buffer) == current_buffer)
Fgoto_char (w->pointm);
- }
- else if (!NILP (w->buffer) && !NILP (BVAR (XBUFFER (w->buffer), name)))
- /* Keep window's old buffer; make sure the markers are
- real. */
- {
- /* Set window markers at start of visible range. */
- if (XMARKER (w->start)->buffer == 0)
- set_marker_restricted (w->start, make_number (0),
- w->buffer);
- if (XMARKER (w->pointm)->buffer == 0)
- set_marker_restricted_both (w->pointm, w->buffer,
- BUF_PT (XBUFFER (w->buffer)),
- BUF_PT_BYTE (XBUFFER (w->buffer)));
- w->start_at_line_beg = Qt;
- }
- else if (STRINGP (auto_buffer_name =
- Fwindow_parameter (window, Qauto_buffer_name))
- && SCHARS (auto_buffer_name) != 0
- && !NILP (w->buffer = Fget_buffer_create (auto_buffer_name)))
- {
- set_marker_restricted (w->start, make_number (0), w->buffer);
- set_marker_restricted (w->pointm, make_number (0), w->buffer);
- w->start_at_line_beg = Qt;
- }
+ }
+ else if (!NILP (w->buffer)
+ && BUFFER_LIVE_P (XBUFFER (w->buffer)))
+ /* Keep window's old buffer; make sure the markers are
+ real. */
+ {
+ /* Set window markers at start of visible range. */
+ if (XMARKER (w->start)->buffer == 0)
+ set_marker_restricted (w->start, make_number (0),
+ w->buffer);
+ if (XMARKER (w->pointm)->buffer == 0)
+ set_marker_restricted_both
+ (w->pointm, w->buffer,
+ BUF_PT (XBUFFER (w->buffer)),
+ BUF_PT_BYTE (XBUFFER (w->buffer)));
+ w->start_at_line_beg = 1;
+ }
else
/* Window has no live buffer, get one. */
{
@@ -5598,21 +5780,23 @@ the return value is nil. Otherwise the value is t. */)
avoid showing an unimportant buffer and, if necessary, to
recreate *scratch* in the course (part of Juanma's bs-show
scenario from March 2011). */
- w->buffer = other_buffer_safely (Fcurrent_buffer ());
+ wset_buffer (w, other_buffer_safely (Fcurrent_buffer ()));
/* This will set the markers to beginning of visible
range. */
- set_marker_restricted (w->start, make_number (0), w->buffer);
- set_marker_restricted (w->pointm, make_number (0), w->buffer);
- w->start_at_line_beg = Qt;
+ set_marker_restricted (w->start,
+ make_number (0), w->buffer);
+ set_marker_restricted (w->pointm,
+ make_number (0), w->buffer);
+ w->start_at_line_beg = 1;
if (!NILP (w->dedicated))
/* Record this window as dead. */
dead_windows = Fcons (window, dead_windows);
/* Make sure window is no more dedicated. */
- w->dedicated = Qnil;
+ wset_dedicated (w, Qnil);
}
}
- FRAME_ROOT_WINDOW (f) = data->root_window;
+ fset_root_window (f, data->root_window);
/* Arrange *not* to restore point in the buffer that was
current when the window configuration was saved. */
if (EQ (XWINDOW (data->current_window)->buffer, new_current_buffer))
@@ -5655,7 +5839,7 @@ the return value is nil. Otherwise the value is t. */)
if (NILP (leaf_windows[i]->buffer))
{
/* Assert it's not reused as a combination. */
- xassert (NILP (leaf_windows[i]->hchild)
+ eassert (NILP (leaf_windows[i]->hchild)
&& NILP (leaf_windows[i]->vchild));
free_window_matrices (leaf_windows[i]);
}
@@ -5664,7 +5848,7 @@ the return value is nil. Otherwise the value is t. */)
}
adjust_glyphs (f);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Scan dead buffer windows. */
for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows))
@@ -5686,7 +5870,13 @@ the return value is nil. Otherwise the value is t. */)
}
if (!NILP (new_current_buffer))
- Fset_buffer (new_current_buffer);
+ {
+ Fset_buffer (new_current_buffer);
+ /* If the new current buffer doesn't appear in the selected
+ window, go to its old point (see bug#12208). */
+ if (!EQ (XWINDOW (data->current_window)->buffer, new_current_buffer))
+ Fgoto_char (make_number (old_point));
+ }
Vminibuf_scroll_window = data->minibuf_scroll_window;
minibuf_selected_window = data->minibuf_selected_window;
@@ -5708,24 +5898,25 @@ delete_all_child_windows (Lisp_Object window)
/* Delete WINDOW's siblings (we traverse postorderly). */
delete_all_child_windows (w->next);
- w->total_lines = w->buffer; /* See Fset_window_configuration for excuse. */
+ /* See Fset_window_configuration for excuse. */
+ wset_total_lines (w, w->buffer);
if (!NILP (w->vchild))
{
delete_all_child_windows (w->vchild);
- w->vchild = Qnil;
+ wset_vchild (w, Qnil);
}
else if (!NILP (w->hchild))
{
delete_all_child_windows (w->hchild);
- w->hchild = Qnil;
+ wset_hchild (w, Qnil);
}
else if (!NILP (w->buffer))
{
unshow_buffer (w);
unchain_marker (XMARKER (w->pointm));
unchain_marker (XMARKER (w->start));
- w->buffer = Qnil;
+ wset_buffer (w, Qnil);
}
Vwindow_list = Qnil;
@@ -5784,7 +5975,7 @@ get_phys_cursor_glyph (struct window *w)
if (!row->enabled_p)
return NULL;
- if (XINT (w->hscroll))
+ if (w->hscroll)
{
/* When the window is hscrolled, cursor hpos can legitimately be
out of bounds, but we draw the cursor at the corresponding
@@ -5810,14 +6001,14 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, int i)
{
register struct saved_window *p;
register struct window *w;
- register Lisp_Object tem;
+ register Lisp_Object tem, pers, par;
for (;!NILP (window); window = w->next)
{
p = SAVED_WINDOW_N (vector, i);
w = XWINDOW (window);
- XSETFASTINT (w->temslot, i); i++;
+ wset_temslot (w, make_number (i)); i++;
p->window = window;
p->buffer = w->buffer;
p->left_col = w->left_col;
@@ -5826,36 +6017,82 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, int i)
p->total_lines = w->total_lines;
p->normal_cols = w->normal_cols;
p->normal_lines = w->normal_lines;
- p->hscroll = w->hscroll;
- p->min_hscroll = w->min_hscroll;
+ XSETFASTINT (p->hscroll, w->hscroll);
+ XSETFASTINT (p->min_hscroll, w->min_hscroll);
p->display_table = w->display_table;
p->left_margin_cols = w->left_margin_cols;
p->right_margin_cols = w->right_margin_cols;
p->left_fringe_width = w->left_fringe_width;
p->right_fringe_width = w->right_fringe_width;
- p->fringes_outside_margins = w->fringes_outside_margins;
+ p->fringes_outside_margins = w->fringes_outside_margins ? Qt : Qnil;
p->scroll_bar_width = w->scroll_bar_width;
p->vertical_scroll_bar_type = w->vertical_scroll_bar_type;
p->dedicated = w->dedicated;
p->combination_limit = w->combination_limit;
- p->window_parameters = w->window_parameters;
- if (!NILP (w->buffer))
+ p->window_parameters = Qnil;
+
+ if (!NILP (Vwindow_persistent_parameters))
{
- /* Save w's value of point in the window configuration.
- If w is the selected window, then get the value of point
- from the buffer; pointm is garbage in the selected window. */
- if (EQ (window, selected_window))
+ /* Run cycle detection on Vwindow_persistent_parameters. */
+ Lisp_Object tortoise, hare;
+
+ hare = tortoise = Vwindow_persistent_parameters;
+ while (CONSP (hare))
+ {
+ hare = XCDR (hare);
+ if (!CONSP (hare))
+ break;
+
+ hare = XCDR (hare);
+ tortoise = XCDR (tortoise);
+
+ if (EQ (hare, tortoise))
+ /* Reset Vwindow_persistent_parameters to Qnil. */
+ {
+ Vwindow_persistent_parameters = Qnil;
+ break;
+ }
+ }
+
+ for (tem = Vwindow_persistent_parameters; CONSP (tem);
+ tem = XCDR (tem))
{
- p->pointm = Fmake_marker ();
- set_marker_both (p->pointm, w->buffer,
- BUF_PT (XBUFFER (w->buffer)),
- BUF_PT_BYTE (XBUFFER (w->buffer)));
+ pers = XCAR (tem);
+ /* Save values for persistent window parameters. */
+ if (CONSP (pers) && !NILP (XCDR (pers)))
+ {
+ par = Fassq (XCAR (pers), w->window_parameters);
+ if (NILP (par))
+ /* If the window has no value for the parameter,
+ make one. */
+ p->window_parameters = Fcons (Fcons (XCAR (pers), Qnil),
+ p->window_parameters);
+ else
+ /* If the window has a value for the parameter,
+ save it. */
+ p->window_parameters = Fcons (Fcons (XCAR (par),
+ XCDR (par)),
+ p->window_parameters);
+ }
}
+ }
+
+ if (!NILP (w->buffer))
+ {
+ /* Save w's value of point in the window configuration. If w
+ is the selected window, then get the value of point from
+ the buffer; pointm is garbage in the selected window. */
+ if (EQ (window, selected_window))
+ p->pointm = build_marker (XBUFFER (w->buffer),
+ BUF_PT (XBUFFER (w->buffer)),
+ BUF_PT_BYTE (XBUFFER (w->buffer)));
else
p->pointm = Fcopy_marker (w->pointm, Qnil);
+ XMARKER (p->pointm)->insertion_type
+ = !NILP (Vwindow_point_insertion_type);
p->start = Fcopy_marker (w->start, Qnil);
- p->start_at_line_beg = w->start_at_line_beg;
+ p->start_at_line_beg = w->start_at_line_beg ? Qt : Qnil;
tem = BVAR (XBUFFER (w->buffer), mark);
p->mark = Fcopy_marker (tem, Qnil);
@@ -5896,19 +6133,16 @@ and for each displayed buffer, where display starts, and the positions of
point and mark. An exception is made for point in the current buffer:
its value is -not- saved.
This also records the currently selected frame, and FRAME's focus
-redirection (see `redirect-frame-focus'). */)
+redirection (see `redirect-frame-focus'). The variable
+`window-persistent-parameters' specifies which window parameters are
+saved by this function. */)
(Lisp_Object frame)
{
register Lisp_Object tem;
register int n_windows;
register struct save_window_data *data;
register int i;
- FRAME_PTR f;
-
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
+ struct frame *f = decode_live_frame (frame);
n_windows = count_windows (XWINDOW (FRAME_ROOT_WINDOW (f)));
data = ALLOCATE_PSEUDOVECTOR (struct save_window_data, frame_cols,
@@ -5928,8 +6162,8 @@ redirection (see `redirect-frame-focus'). */)
tem = Fmake_vector (make_number (n_windows), Qnil);
data->saved_windows = tem;
for (i = 0; i < n_windows; i++)
- XVECTOR (tem)->contents[i]
- = Fmake_vector (make_number (VECSIZE (struct saved_window)), Qnil);
+ ASET (tem, i,
+ Fmake_vector (make_number (VECSIZE (struct saved_window)), Qnil));
save_window_save (FRAME_ROOT_WINDOW (f), XVECTOR (tem), 0);
XSETWINDOW_CONFIGURATION (tem, data);
return (tem);
@@ -5942,14 +6176,15 @@ redirection (see `redirect-frame-focus'). */)
DEFUN ("set-window-margins", Fset_window_margins, Sset_window_margins,
2, 3, 0,
doc: /* Set width of marginal areas of window WINDOW.
-If WINDOW is nil, set margins of the currently selected window.
+WINDOW must be a live window and defaults to the selected one.
+
Second arg LEFT-WIDTH specifies the number of character cells to
reserve for the left marginal area. Optional third arg RIGHT-WIDTH
does the same for the right marginal area. A nil width parameter
means no margin. */)
(Lisp_Object window, Lisp_Object left_width, Lisp_Object right_width)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
/* Translate negative or zero widths to nil.
Margins that are too wide have to be checked elsewhere. */
@@ -5971,8 +6206,8 @@ means no margin. */)
if (!EQ (w->left_margin_cols, left_width)
|| !EQ (w->right_margin_cols, right_width))
{
- w->left_margin_cols = left_width;
- w->right_margin_cols = right_width;
+ wset_left_margin_cols (w, left_width);
+ wset_right_margin_cols (w, right_width);
adjust_window_margins (w);
@@ -5987,13 +6222,14 @@ means no margin. */)
DEFUN ("window-margins", Fwindow_margins, Swindow_margins,
0, 1, 0,
doc: /* Get width of marginal areas of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
+
Value is a cons of the form (LEFT-WIDTH . RIGHT-WIDTH).
If a marginal area does not exist, its width will be returned
as nil. */)
(Lisp_Object window)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
return Fcons (w->left_margin_cols, w->right_margin_cols);
}
@@ -6006,8 +6242,8 @@ as nil. */)
DEFUN ("set-window-fringes", Fset_window_fringes, Sset_window_fringes,
2, 4, 0,
doc: /* Set the fringe widths of window WINDOW.
-If WINDOW is nil, set the fringe widths of the currently selected
-window.
+WINDOW must be a live window and defaults to the selected one.
+
Second arg LEFT-WIDTH specifies the number of pixels to reserve for
the left fringe. Optional third arg RIGHT-WIDTH specifies the right
fringe width. If a fringe width arg is nil, that means to use the
@@ -6018,7 +6254,8 @@ outside of the display margins. By default, fringes are drawn between
display marginal areas and the text area. */)
(Lisp_Object window, Lisp_Object left_width, Lisp_Object right_width, Lisp_Object outside_margins)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
+ int outside = !NILP (outside_margins);
if (!NILP (left_width))
CHECK_NATNUM (left_width);
@@ -6029,16 +6266,16 @@ display marginal areas and the text area. */)
if (FRAME_WINDOW_P (WINDOW_XFRAME (w))
&& (!EQ (w->left_fringe_width, left_width)
|| !EQ (w->right_fringe_width, right_width)
- || !EQ (w->fringes_outside_margins, outside_margins)))
+ || w->fringes_outside_margins != outside))
{
- w->left_fringe_width = left_width;
- w->right_fringe_width = right_width;
- w->fringes_outside_margins = outside_margins;
+ wset_left_fringe_width (w, left_width);
+ wset_right_fringe_width (w, right_width);
+ w->fringes_outside_margins = outside;
adjust_window_margins (w);
clear_glyph_matrix (w->current_matrix);
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
++windows_or_buffers_changed;
adjust_glyphs (XFRAME (WINDOW_FRAME (w)));
@@ -6051,16 +6288,16 @@ display marginal areas and the text area. */)
DEFUN ("window-fringes", Fwindow_fringes, Swindow_fringes,
0, 1, 0,
doc: /* Get width of fringes of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
+
Value is a list of the form (LEFT-WIDTH RIGHT-WIDTH OUTSIDE-MARGINS). */)
(Lisp_Object window)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
- return Fcons (make_number (WINDOW_LEFT_FRINGE_WIDTH (w)),
- Fcons (make_number (WINDOW_RIGHT_FRINGE_WIDTH (w)),
- Fcons ((WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
- ? Qt : Qnil), Qnil)));
+ return list3 (make_number (WINDOW_LEFT_FRINGE_WIDTH (w)),
+ make_number (WINDOW_RIGHT_FRINGE_WIDTH (w)),
+ WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w) ? Qt : Qnil);
}
@@ -6072,7 +6309,8 @@ Value is a list of the form (LEFT-WIDTH RIGHT-WIDTH OUTSIDE-MARGINS). */)
DEFUN ("set-window-scroll-bars", Fset_window_scroll_bars,
Sset_window_scroll_bars, 2, 4, 0,
doc: /* Set width and type of scroll bars of window WINDOW.
-If window is nil, set scroll bars of the currently selected window.
+WINDOW must be a live window and defaults to the selected one.
+
Second parameter WIDTH specifies the pixel width for the scroll bar;
this is automatically adjusted to a multiple of the frame column width.
Third parameter VERTICAL-TYPE specifies the type of the vertical scroll
@@ -6082,11 +6320,11 @@ If VERTICAL-TYPE is t, use the frame's scroll-bar type.
Fourth parameter HORIZONTAL-TYPE is currently unused. */)
(Lisp_Object window, Lisp_Object width, Lisp_Object vertical_type, Lisp_Object horizontal_type)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
if (!NILP (width))
{
- CHECK_NATNUM (width);
+ CHECK_RANGED_INTEGER (width, 0, INT_MAX);
if (XINT (width) == 0)
vertical_type = Qnil;
@@ -6101,13 +6339,13 @@ Fourth parameter HORIZONTAL-TYPE is currently unused. */)
if (!EQ (w->scroll_bar_width, width)
|| !EQ (w->vertical_scroll_bar_type, vertical_type))
{
- w->scroll_bar_width = width;
- w->vertical_scroll_bar_type = vertical_type;
+ wset_scroll_bar_width (w, width);
+ wset_vertical_scroll_bar_type (w, vertical_type);
adjust_window_margins (w);
clear_glyph_matrix (w->current_matrix);
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
++windows_or_buffers_changed;
adjust_glyphs (XFRAME (WINDOW_FRAME (w)));
@@ -6120,19 +6358,20 @@ Fourth parameter HORIZONTAL-TYPE is currently unused. */)
DEFUN ("window-scroll-bars", Fwindow_scroll_bars, Swindow_scroll_bars,
0, 1, 0,
doc: /* Get width and type of scroll bars of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
+
Value is a list of the form (WIDTH COLS VERTICAL-TYPE HORIZONTAL-TYPE).
If WIDTH is nil or TYPE is t, the window is using the frame's corresponding
value. */)
(Lisp_Object window)
{
- struct window *w = decode_window (window);
- return Fcons (make_number ((WINDOW_CONFIG_SCROLL_BAR_WIDTH (w)
+ struct window *w = decode_live_window (window);
+
+ return list4 (make_number ((WINDOW_CONFIG_SCROLL_BAR_WIDTH (w)
? WINDOW_CONFIG_SCROLL_BAR_WIDTH (w)
: WINDOW_SCROLL_BAR_AREA_WIDTH (w))),
- Fcons (make_number (WINDOW_SCROLL_BAR_COLS (w)),
- Fcons (w->vertical_scroll_bar_type,
- Fcons (Qnil, Qnil))));
+ make_number (WINDOW_SCROLL_BAR_COLS (w)),
+ w->vertical_scroll_bar_type, Qnil);
}
@@ -6149,15 +6388,8 @@ optional second arg PIXELS-P means value is measured in pixels. */)
(Lisp_Object window, Lisp_Object pixels_p)
{
Lisp_Object result;
- struct frame *f;
- struct window *w;
-
- if (NILP (window))
- window = selected_window;
- else
- CHECK_WINDOW (window);
- w = XWINDOW (window);
- f = XFRAME (w->frame);
+ struct window *w = decode_live_window (window);
+ struct frame *f = XFRAME (w->frame);
if (FRAME_WINDOW_P (f))
result = (NILP (pixels_p)
@@ -6181,18 +6413,11 @@ result of this rounding.
If PIXELS-P is non-nil, the return value is VSCROLL. */)
(Lisp_Object window, Lisp_Object vscroll, Lisp_Object pixels_p)
{
- struct window *w;
- struct frame *f;
+ struct window *w = decode_live_window (window);
+ struct frame *f = XFRAME (w->frame);
- if (NILP (window))
- window = selected_window;
- else
- CHECK_WINDOW (window);
CHECK_NUMBER_OR_FLOAT (vscroll);
- w = XWINDOW (window);
- f = XFRAME (w->frame);
-
if (FRAME_WINDOW_P (f))
{
int old_dy = w->vscroll;
@@ -6296,15 +6521,17 @@ freeze_window_starts (struct frame *f, int freeze_p)
/* Return 1 if window configurations CONFIGURATION1 and CONFIGURATION2
describe the same state of affairs. This is used by Fequal.
- ignore_positions non-zero means ignore non-matching scroll positions
+ IGNORE_POSITIONS means ignore non-matching scroll positions
and the like.
This ignores a couple of things like the dedication status of
window, combination_limit and the like. This might have to be
fixed. */
-int
-compare_window_configurations (Lisp_Object configuration1, Lisp_Object configuration2, int ignore_positions)
+bool
+compare_window_configurations (Lisp_Object configuration1,
+ Lisp_Object configuration2,
+ bool ignore_positions)
{
register struct save_window_data *d1, *d2;
struct Lisp_Vector *sws1, *sws2;
@@ -6420,6 +6647,7 @@ syms_of_window (void)
DEFSYM (Qwindowp, "windowp");
DEFSYM (Qwindow_configuration_p, "window-configuration-p");
DEFSYM (Qwindow_live_p, "window-live-p");
+ DEFSYM (Qwindow_valid_p, "window-valid-p");
DEFSYM (Qwindow_deletable_p, "window-deletable-p");
DEFSYM (Qdelete_window, "delete-window");
DEFSYM (Qwindow_resize_root_window, "window--resize-root-window");
@@ -6429,10 +6657,11 @@ syms_of_window (void)
DEFSYM (Qreplace_buffer_in_windows, "replace-buffer-in-windows");
DEFSYM (Qrecord_window_buffer, "record-window-buffer");
DEFSYM (Qget_mru_window, "get-mru-window");
+ DEFSYM (Qwindow_size, "window-size");
DEFSYM (Qtemp_buffer_show_hook, "temp-buffer-show-hook");
DEFSYM (Qabove, "above");
DEFSYM (Qbelow, "below");
- DEFSYM (Qauto_buffer_name, "auto-buffer-name");
+ DEFSYM (Qclone_of, "clone-of");
staticpro (&Vwindow_list);
@@ -6524,28 +6753,67 @@ This variable takes no effect if `window-combination-limit' is non-nil. */);
Vwindow_combination_resize = Qnil;
DEFVAR_LISP ("window-combination-limit", Vwindow_combination_limit,
- doc: /* If t, splitting a window makes a new parent window.
-If this variable is nil, splitting a window will create a new parent
-window only if the window has no parent window or the window shall
-become a combination orthogonal to the one it is part of.
-
-If this variable is t, splitting a window always creates a new parent
-window. If all splits behave this way, each frame's window tree is a
-binary tree and every window but the frame's root window has exactly one
-sibling.
-
-Other values are reserved for future use.
-
-The value of this variable is also assigned to the combination limit of
-the new parent window. The combination limit of a window can be
-retrieved via the function `window-combination-limit' and altered by the
-function `set-window-combination-limit'. */);
- Vwindow_combination_limit = Qnil;
+ doc: /* If non-nil, splitting a window makes a new parent window.
+The following values are recognized:
+
+nil means splitting a window will create a new parent window only if the
+ window has no parent window or the window shall become part of a
+ combination orthogonal to the one it is part of.
+
+`window-size' means that splitting a window for displaying a buffer
+ makes a new parent window provided `display-buffer' is supposed to
+ explicitly set the window's size due to the presence of a
+ `window-height' or `window-width' entry in the alist used by
+ `display-buffer'. Otherwise, this value is handled like nil.
+
+`temp-buffer' means that splitting a window for displaying a temporary
+ buffer always makes a new parent window. Otherwise, this value is
+ handled like nil.
+
+`display-buffer' means that splitting a window for displaying a buffer
+ always makes a new parent window. Since temporary buffers are
+ displayed by the function `display-buffer', this value is stronger
+ than `temp-buffer'. Splitting a window for other purpose makes a
+ new parent window only if needed.
+
+t means that splitting a window always creates a new parent window. If
+ all splits behave this way, each frame's window tree is a binary
+ tree and every window but the frame's root window has exactly one
+ sibling.
+
+Other values are reserved for future use. */);
+ Vwindow_combination_limit = Qwindow_size;
+
+ DEFVAR_LISP ("window-persistent-parameters", Vwindow_persistent_parameters,
+ doc: /* Alist of persistent window parameters.
+This alist specifies which window parameters shall get saved by
+`current-window-configuration' and `window-state-get' and subsequently
+restored to their previous values by `set-window-configuration' and
+`window-state-put'.
+
+The car of each entry of this alist is the symbol specifying the
+parameter. The cdr is one of the following:
+
+nil means the parameter is neither saved by `window-state-get' nor by
+`current-window-configuration'.
+
+t means the parameter is saved by `current-window-configuration' and,
+provided its WRITABLE argument is nil, by `window-state-get'.
+
+The symbol `writable' means the parameter is saved unconditionally by
+both `current-window-configuration' and `window-state-get'. Do not use
+this value for parameters without read syntax (like windows or frames).
+
+Parameters not saved by `current-window-configuration' or
+`window-state-get' are left alone by `set-window-configuration'
+respectively are not installed by `window-state-put'. */);
+ Vwindow_persistent_parameters = list1 (Fcons (Qclone_of, Qt));
defsubr (&Sselected_window);
defsubr (&Sminibuffer_window);
defsubr (&Swindow_minibuffer_p);
defsubr (&Swindowp);
+ defsubr (&Swindow_valid_p);
defsubr (&Swindow_live_p);
defsubr (&Swindow_frame);
defsubr (&Sframe_root_window);
@@ -6606,7 +6874,6 @@ function `set-window-combination-limit'. */);
defsubr (&Srun_window_configuration_change_hook);
defsubr (&Sselect_window);
defsubr (&Sforce_window_update);
- defsubr (&Stemp_output_buffer_show);
defsubr (&Ssplit_window_internal);
defsubr (&Sscroll_up);
defsubr (&Sscroll_down);
diff --git a/src/window.h b/src/window.h
index b4e268b1a34..2a12226c0aa 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1,5 +1,5 @@
/* Window definitions for GNU Emacs.
- Copyright (C) 1985-1986, 1993, 1995, 1997-2011
+ Copyright (C) 1985-1986, 1993, 1995, 1997-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -22,7 +22,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dispextern.h"
-extern Lisp_Object Qleft, Qright;
+INLINE_HEADER_BEGIN
+#ifndef WINDOW_INLINE
+# define WINDOW_INLINE INLINE
+#endif
/* Windows are allocated as if they were vectors, but then the
Lisp data type is changed to Lisp_Window. They are garbage
@@ -94,18 +97,17 @@ struct window
/* The frame this window is on. */
Lisp_Object frame;
- /* t if this window is a minibuffer window. */
- Lisp_Object mini_p;
-
/* Following (to right or down) and preceding (to left or up) child
at same level of tree. */
- Lisp_Object next, prev;
+ Lisp_Object next;
+ Lisp_Object prev;
/* First child of this window: vchild is used if this is a vertical
combination, hchild if this is a horizontal combination. Of the
fields vchild, hchild and buffer, one and only one is non-nil
unless the window is dead. */
- Lisp_Object hchild, vchild;
+ Lisp_Object hchild;
+ Lisp_Object vchild;
/* The window this one is a child of. */
Lisp_Object parent;
@@ -144,42 +146,10 @@ struct window
each one can have its own value of point. */
Lisp_Object pointm;
- /* Non-nil means next redisplay must use the value of start
- set up for it in advance. Set by scrolling commands. */
- Lisp_Object force_start;
- /* Non-nil means we have explicitly changed the value of start,
- but that the next redisplay is not obliged to use the new value.
- This is used in Fdelete_other_windows to force a call to
- Vwindow_scroll_functions; also by Frecenter with argument. */
- Lisp_Object optional_new_start;
-
- /* Number of columns display within the window is scrolled to the left. */
- Lisp_Object hscroll;
- /* Minimum hscroll for automatic hscrolling. This is the value
- the user has set, by set-window-hscroll for example. */
- Lisp_Object min_hscroll;
-
- /* Number saying how recently window was selected. */
- Lisp_Object use_time;
-
- /* Unique number of window assigned when it was created. */
- Lisp_Object sequence_number;
-
/* No permanent meaning; used by save-window-excursion's
bookkeeping. */
Lisp_Object temslot;
- /* text.modified of displayed buffer as of last time display
- completed. */
- Lisp_Object last_modified;
- /* BUF_OVERLAY_MODIFIED of displayed buffer as of last complete update. */
- Lisp_Object last_overlay_modified;
- /* Value of point at that time. */
- Lisp_Object last_point;
- /* Non-nil if the buffer was "modified" when the window
- was last updated. */
- Lisp_Object last_had_star;
-
/* This window's vertical scroll bar. This field is only for use
by the window-system-dependent code which implements the
scroll bars; it can store anything it likes here. If this
@@ -189,14 +159,13 @@ struct window
/* Width of left and right marginal areas. A value of nil means
no margin. */
- Lisp_Object left_margin_cols, right_margin_cols;
+ Lisp_Object left_margin_cols;
+ Lisp_Object right_margin_cols;
/* Width of left and right fringes.
A value of nil or t means use frame values. */
- Lisp_Object left_fringe_width, right_fringe_width;
- /* Non-nil means fringes are drawn outside display margins;
- othersize draw them between margin areas and text. */
- Lisp_Object fringes_outside_margins;
+ Lisp_Object left_fringe_width;
+ Lisp_Object right_fringe_width;
/* Pixel width of scroll bars.
A value of nil or t means use frame values. */
@@ -206,11 +175,6 @@ struct window
no scroll bar. A value of t means use frame value. */
Lisp_Object vertical_scroll_bar_type;
- /* Frame coords of mark as of last time display completed */
- /* May be nil if mark does not exist or was not on frame */
- Lisp_Object last_mark_x;
- Lisp_Object last_mark_y;
-
/* Z - the buffer position of the last glyph in the current matrix
of W. Only valid if WINDOW_END_VALID is not nil. */
Lisp_Object window_end_pos;
@@ -223,18 +187,13 @@ struct window
did not get onto the frame. */
Lisp_Object window_end_valid;
- /* Non-nil means must regenerate mode line of this window */
- Lisp_Object update_mode_line;
-
- /* Non-nil means current value of `start'
- was the beginning of a line when it was chosen. */
- Lisp_Object start_at_line_beg;
-
/* Display-table to use for displaying chars in this window.
Nil means use the buffer's own display-table. */
Lisp_Object display_table;
- /* Non-nil means window is marked as dedicated. */
+ /* Non-nil usually means window is marked as dedicated.
+ Note Lisp code may set this to something beyond Qnil
+ and Qt, so bitfield can't be used here. */
Lisp_Object dedicated;
/* Line number and position of a line somewhere above the top of the
@@ -261,13 +220,6 @@ struct window
/* t means this window's child windows are not (re-)combined. */
Lisp_Object combination_limit;
- /* Alist of <buffer, window-start, window-point> triples listing
- buffers previously shown in this window. */
- Lisp_Object prev_buffers;
-
- /* List of buffers re-shown in this window. */
- Lisp_Object next_buffers;
-
/* An alist with parameters. */
Lisp_Object window_parameters;
@@ -279,6 +231,39 @@ struct window
struct glyph_matrix *current_matrix;
struct glyph_matrix *desired_matrix;
+ /* The two Lisp_Object fields below are marked in a special way,
+ which is why they're placed after `current_matrix'. */
+ /* Alist of <buffer, window-start, window-point> triples listing
+ buffers previously shown in this window. */
+ Lisp_Object prev_buffers;
+ /* List of buffers re-shown in this window. */
+ Lisp_Object next_buffers;
+
+ /* Number saying how recently window was selected. */
+ int use_time;
+
+ /* Unique number of window assigned when it was created. */
+ int sequence_number;
+
+ /* Number of columns display within the window is scrolled to the left. */
+ ptrdiff_t hscroll;
+
+ /* Minimum hscroll for automatic hscrolling. This is the value
+ the user has set, by set-window-hscroll for example. */
+ ptrdiff_t min_hscroll;
+
+ /* Displayed buffer's text modification events counter as of last time
+ display completed. */
+ EMACS_INT last_modified;
+
+ /* Displayed buffer's overlays modification events counter as of last
+ complete update. */
+ EMACS_INT last_overlay_modified;
+
+ /* Value of point at that time. Since this is a position in a buffer,
+ it should be positive. */
+ ptrdiff_t last_point;
+
/* Scaling factor for the glyph_matrix size calculation in this window.
Used if window contains many small images or uses proportional fonts,
as the normal may yield a matrix which is too small. */
@@ -302,6 +287,30 @@ struct window
/* This is handy for undrawing the cursor. */
int phys_cursor_ascent, phys_cursor_height;
+ /* Non-zero if this window is a minibuffer window. */
+ unsigned mini : 1;
+
+ /* Non-zero means must regenerate mode line of this window */
+ unsigned update_mode_line : 1;
+
+ /* Non-nil if the buffer was "modified" when the window
+ was last updated. */
+ unsigned last_had_star : 1;
+
+ /* Non-zero means current value of `start'
+ was the beginning of a line when it was chosen. */
+ unsigned start_at_line_beg : 1;
+
+ /* Non-zero means next redisplay must use the value of start
+ set up for it in advance. Set by scrolling commands. */
+ unsigned force_start : 1;
+
+ /* Non-zero means we have explicitly changed the value of start,
+ but that the next redisplay is not obliged to use the new value.
+ This is used in Fdelete_other_windows to force a call to
+ Vwindow_scroll_functions; also by Frecenter with argument. */
+ unsigned optional_new_start : 1;
+
/* Non-zero means the cursor is currently displayed. This can be
set to zero by functions overpainting the cursor image. */
unsigned phys_cursor_on_p : 1;
@@ -326,18 +335,100 @@ struct window
accept that. */
unsigned frozen_window_start_p : 1;
+ /* Non-zero means fringes are drawn outside display margins.
+ Otherwise draw them between margin areas and text. */
+ unsigned fringes_outside_margins : 1;
+
/* Amount by which lines of this window are scrolled in
y-direction (smooth scrolling). */
int vscroll;
- /* Z_BYTE - the buffer position of the last glyph in the current matrix
- of W. Only valid if WINDOW_END_VALID is not nil. */
- int window_end_bytepos;
+ /* Z_BYTE - the buffer position of the last glyph in the current matrix of W.
+ Should be nonnegative, and only valid if window_end_valid is not nil. */
+ ptrdiff_t window_end_bytepos;
};
+/* Most code should use these functions to set Lisp fields in struct
+ window. */
+WINDOW_INLINE void
+wset_buffer (struct window *w, Lisp_Object val)
+{
+ w->buffer = val;
+}
+WINDOW_INLINE void
+wset_frame (struct window *w, Lisp_Object val)
+{
+ w->frame = val;
+}
+WINDOW_INLINE void
+wset_left_col (struct window *w, Lisp_Object val)
+{
+ w->left_col = val;
+}
+WINDOW_INLINE void
+wset_next (struct window *w, Lisp_Object val)
+{
+ w->next = val;
+}
+WINDOW_INLINE void
+wset_prev (struct window *w, Lisp_Object val)
+{
+ w->prev = val;
+}
+WINDOW_INLINE void
+wset_redisplay_end_trigger (struct window *w, Lisp_Object val)
+{
+ w->redisplay_end_trigger = val;
+}
+WINDOW_INLINE void
+wset_top_line (struct window *w, Lisp_Object val)
+{
+ w->top_line = val;
+}
+WINDOW_INLINE void
+wset_total_cols (struct window *w, Lisp_Object val)
+{
+ w->total_cols = val;
+}
+WINDOW_INLINE void
+wset_total_lines (struct window *w, Lisp_Object val)
+{
+ w->total_lines = val;
+}
+WINDOW_INLINE void
+wset_vertical_scroll_bar (struct window *w, Lisp_Object val)
+{
+ w->vertical_scroll_bar = val;
+}
+WINDOW_INLINE void
+wset_window_end_pos (struct window *w, Lisp_Object val)
+{
+ w->window_end_pos = val;
+}
+WINDOW_INLINE void
+wset_window_end_valid (struct window *w, Lisp_Object val)
+{
+ w->window_end_valid = val;
+}
+WINDOW_INLINE void
+wset_window_end_vpos (struct window *w, Lisp_Object val)
+{
+ w->window_end_vpos = val;
+}
+WINDOW_INLINE void
+wset_prev_buffers (struct window *w, Lisp_Object val)
+{
+ w->prev_buffers = val;
+}
+WINDOW_INLINE void
+wset_next_buffers (struct window *w, Lisp_Object val)
+{
+ w->next_buffers = val;
+}
+
/* 1 if W is a minibuffer window. */
-#define MINI_WINDOW_P(W) (!NILP ((W)->mini_p))
+#define MINI_WINDOW_P(W) ((W)->mini)
/* General window layout:
@@ -383,13 +474,13 @@ struct window
This includes scroll bars and fringes. */
#define WINDOW_TOTAL_COLS(W) \
- (XFASTINT ((W)->total_cols))
+ (XFASTINT (W->total_cols))
/* Return the height of window W in canonical line units.
This includes header and mode lines, if any. */
#define WINDOW_TOTAL_LINES(W) \
- (XFASTINT ((W)->total_lines))
+ (XFASTINT (W->total_lines))
/* Return the total pixel width of window W. */
@@ -417,7 +508,7 @@ struct window
This includes a left-hand scroll bar, if any. */
#define WINDOW_LEFT_EDGE_COL(W) \
- (XFASTINT ((W)->left_col))
+ (XFASTINT (W->left_col))
/* Return the canonical frame column before which window W ends.
This includes a right-hand scroll bar, if any. */
@@ -429,7 +520,7 @@ struct window
This includes a header line, if any. */
#define WINDOW_TOP_EDGE_LINE(W) \
- (XFASTINT ((W)->top_line))
+ (XFASTINT (W->top_line))
/* Return the canonical frame line before which window W ends.
This includes a mode line, if any. */
@@ -533,32 +624,32 @@ struct window
/* Width of left margin area in columns. */
-#define WINDOW_LEFT_MARGIN_COLS(W) \
- (NILP ((W)->left_margin_cols) \
- ? 0 \
- : XINT ((W)->left_margin_cols))
+#define WINDOW_LEFT_MARGIN_COLS(W) \
+ (NILP (W->left_margin_cols) \
+ ? 0 \
+ : XINT (W->left_margin_cols))
/* Width of right marginal area in columns. */
-#define WINDOW_RIGHT_MARGIN_COLS(W) \
- (NILP ((W)->right_margin_cols) \
- ? 0 \
- : XINT ((W)->right_margin_cols))
+#define WINDOW_RIGHT_MARGIN_COLS(W) \
+ (NILP (W->right_margin_cols) \
+ ? 0 \
+ : XINT (W->right_margin_cols))
/* Width of left margin area in pixels. */
-#define WINDOW_LEFT_MARGIN_WIDTH(W) \
- (NILP ((W)->left_margin_cols) \
- ? 0 \
- : (XINT ((W)->left_margin_cols) \
+#define WINDOW_LEFT_MARGIN_WIDTH(W) \
+ (NILP (W->left_margin_cols) \
+ ? 0 \
+ : (XINT (W->left_margin_cols) \
* WINDOW_FRAME_COLUMN_WIDTH (W)))
/* Width of right marginal area in pixels. */
-#define WINDOW_RIGHT_MARGIN_WIDTH(W) \
- (NILP ((W)->right_margin_cols) \
- ? 0 \
- : (XINT ((W)->right_margin_cols) \
+#define WINDOW_RIGHT_MARGIN_WIDTH(W) \
+ (NILP (W->right_margin_cols) \
+ ? 0 \
+ : (XINT (W->right_margin_cols) \
* WINDOW_FRAME_COLUMN_WIDTH (W)))
/* Total width of fringes reserved for drawing truncation bitmaps,
@@ -567,37 +658,37 @@ struct window
sizes aren't pixel values. If it weren't the case, we wouldn't be
able to split windows horizontally nicely. */
-#define WINDOW_FRINGE_COLS(W) \
- ((INTEGERP ((W)->left_fringe_width) \
- || INTEGERP ((W)->right_fringe_width)) \
- ? ((WINDOW_LEFT_FRINGE_WIDTH (W) \
- + WINDOW_RIGHT_FRINGE_WIDTH (W) \
- + WINDOW_FRAME_COLUMN_WIDTH (W) - 1) \
- / WINDOW_FRAME_COLUMN_WIDTH (W)) \
+#define WINDOW_FRINGE_COLS(W) \
+ ((INTEGERP (W->left_fringe_width) \
+ || INTEGERP (W->right_fringe_width)) \
+ ? ((WINDOW_LEFT_FRINGE_WIDTH (W) \
+ + WINDOW_RIGHT_FRINGE_WIDTH (W) \
+ + WINDOW_FRAME_COLUMN_WIDTH (W) - 1) \
+ / WINDOW_FRAME_COLUMN_WIDTH (W)) \
: FRAME_FRINGE_COLS (WINDOW_XFRAME (W)))
/* Column-width of the left and right fringe. */
-#define WINDOW_LEFT_FRINGE_COLS(W) \
- ((WINDOW_LEFT_FRINGE_WIDTH ((W)) \
- + WINDOW_FRAME_COLUMN_WIDTH (W) - 1) \
+#define WINDOW_LEFT_FRINGE_COLS(W) \
+ ((WINDOW_LEFT_FRINGE_WIDTH ((W)) \
+ + WINDOW_FRAME_COLUMN_WIDTH (W) - 1) \
/ WINDOW_FRAME_COLUMN_WIDTH (W))
-#define WINDOW_RIGHT_FRINGE_COLS(W) \
- ((WINDOW_RIGHT_FRINGE_WIDTH ((W)) \
- + WINDOW_FRAME_COLUMN_WIDTH (W) - 1) \
+#define WINDOW_RIGHT_FRINGE_COLS(W) \
+ ((WINDOW_RIGHT_FRINGE_WIDTH ((W)) \
+ + WINDOW_FRAME_COLUMN_WIDTH (W) - 1) \
/ WINDOW_FRAME_COLUMN_WIDTH (W))
/* Pixel-width of the left and right fringe. */
#define WINDOW_LEFT_FRINGE_WIDTH(W) \
- (INTEGERP ((W)->left_fringe_width) \
- ? XFASTINT ((W)->left_fringe_width) \
+ (INTEGERP (W->left_fringe_width) \
+ ? XFASTINT (W->left_fringe_width) \
: FRAME_LEFT_FRINGE_WIDTH (WINDOW_XFRAME (W)))
#define WINDOW_RIGHT_FRINGE_WIDTH(W) \
- (INTEGERP ((W)->right_fringe_width) \
- ? XFASTINT ((W)->right_fringe_width) \
+ (INTEGERP (W->right_fringe_width) \
+ ? XFASTINT (W->right_fringe_width) \
: FRAME_RIGHT_FRINGE_WIDTH (WINDOW_XFRAME (W)))
/* Total width of fringes in pixels. */
@@ -608,42 +699,42 @@ struct window
/* Are fringes outside display margins in window W. */
#define WINDOW_HAS_FRINGES_OUTSIDE_MARGINS(W) \
- (!NILP ((W)->fringes_outside_margins))
+ ((W)->fringes_outside_margins)
/* Say whether scroll bars are currently enabled for window W,
and which side they are on. */
#define WINDOW_VERTICAL_SCROLL_BAR_TYPE(w) \
- (EQ ((w)->vertical_scroll_bar_type, Qt) \
+ (EQ (w->vertical_scroll_bar_type, Qt) \
? FRAME_VERTICAL_SCROLL_BAR_TYPE (WINDOW_XFRAME (w)) \
- : EQ ((w)->vertical_scroll_bar_type, Qleft) \
+ : EQ (w->vertical_scroll_bar_type, Qleft) \
? vertical_scroll_bar_left \
- : EQ ((w)->vertical_scroll_bar_type, Qright) \
+ : EQ (w->vertical_scroll_bar_type, Qright) \
? vertical_scroll_bar_right \
: vertical_scroll_bar_none) \
#define WINDOW_HAS_VERTICAL_SCROLL_BAR(w) \
- (EQ ((w)->vertical_scroll_bar_type, Qt) \
+ (EQ (w->vertical_scroll_bar_type, Qt) \
? FRAME_HAS_VERTICAL_SCROLL_BARS (WINDOW_XFRAME (w)) \
- : !NILP ((w)->vertical_scroll_bar_type))
+ : !NILP (w->vertical_scroll_bar_type))
#define WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT(w) \
- (EQ ((w)->vertical_scroll_bar_type, Qt) \
+ (EQ (w->vertical_scroll_bar_type, Qt) \
? FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (WINDOW_XFRAME (w)) \
- : EQ ((w)->vertical_scroll_bar_type, Qleft))
+ : EQ (w->vertical_scroll_bar_type, Qleft))
-#define WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT(w) \
- (EQ ((w)->vertical_scroll_bar_type, Qt) \
- ? FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (WINDOW_XFRAME (w))\
- : EQ ((w)->vertical_scroll_bar_type, Qright))
+#define WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT(w) \
+ (EQ (w->vertical_scroll_bar_type, Qt) \
+ ? FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (WINDOW_XFRAME (w)) \
+ : EQ (w->vertical_scroll_bar_type, Qright))
/* Width that a scroll bar in window W should have, if there is one.
Measured in pixels. If scroll bars are turned off, this is still
nonzero. */
#define WINDOW_CONFIG_SCROLL_BAR_WIDTH(w) \
- (INTEGERP ((w)->scroll_bar_width) \
- ? XFASTINT ((w)->scroll_bar_width) \
+ (INTEGERP (w->scroll_bar_width) \
+ ? XFASTINT (w->scroll_bar_width) \
: FRAME_CONFIG_SCROLL_BAR_WIDTH (WINDOW_XFRAME (w)))
/* Width that a scroll bar in window W should have, if there is one.
@@ -651,8 +742,8 @@ struct window
this is still nonzero. */
#define WINDOW_CONFIG_SCROLL_BAR_COLS(w) \
- (INTEGERP ((w)->scroll_bar_width) \
- ? ((XFASTINT ((w)->scroll_bar_width) \
+ (INTEGERP (w->scroll_bar_width) \
+ ? ((XFASTINT (w->scroll_bar_width) \
+ WINDOW_FRAME_COLUMN_WIDTH (w) - 1) \
/ WINDOW_FRAME_COLUMN_WIDTH (w)) \
: FRAME_CONFIG_SCROLL_BAR_COLS (WINDOW_XFRAME (w)))
@@ -662,14 +753,14 @@ struct window
the right in this frame, or there are no scroll bars, value is 0. */
#define WINDOW_LEFT_SCROLL_BAR_COLS(w) \
- (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w) \
+ (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w) \
? (WINDOW_CONFIG_SCROLL_BAR_COLS (w)) \
: 0)
/* Width of a left scroll bar area in window W , measured in pixels. */
-#define WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH(w) \
- (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w) \
+#define WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH(w) \
+ (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w) \
? (WINDOW_CONFIG_SCROLL_BAR_COLS (w) * WINDOW_FRAME_COLUMN_WIDTH (w)) \
: 0)
@@ -678,7 +769,7 @@ struct window
the left in this frame, or there are no scroll bars, value is 0. */
#define WINDOW_RIGHT_SCROLL_BAR_COLS(w) \
- (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w) \
+ (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w) \
? WINDOW_CONFIG_SCROLL_BAR_COLS (w) \
: 0)
@@ -700,7 +791,7 @@ struct window
/* Width of a left scroll bar area in window W , measured in pixels. */
#define WINDOW_SCROLL_BAR_AREA_WIDTH(w) \
- (WINDOW_HAS_VERTICAL_SCROLL_BAR (w) \
+ (WINDOW_HAS_VERTICAL_SCROLL_BAR (w) \
? (WINDOW_CONFIG_SCROLL_BAR_COLS (w) * WINDOW_FRAME_COLUMN_WIDTH (w)) \
: 0)
@@ -721,7 +812,7 @@ struct window
? CURRENT_MODE_LINE_HEIGHT (W) \
: 0)
-#define WINDOW_MODE_LINE_LINES(W) \
+#define WINDOW_MODE_LINE_LINES(W) \
(!! WINDOW_WANTS_MODELINE_P ((W)))
/* Height in pixels, and in lines, of the header line.
@@ -732,7 +823,7 @@ struct window
? CURRENT_HEADER_LINE_HEIGHT (W) \
: 0)
-#define WINDOW_HEADER_LINE_LINES(W) \
+#define WINDOW_HEADER_LINE_LINES(W) \
(!! WINDOW_WANTS_HEADER_LINE_P ((W)))
/* Pixel height of window W without mode line. */
@@ -743,36 +834,36 @@ struct window
/* Pixel height of window W without mode and header line. */
-#define WINDOW_BOX_TEXT_HEIGHT(W) \
- (WINDOW_TOTAL_HEIGHT ((W)) \
- - WINDOW_MODE_LINE_HEIGHT ((W)) \
+#define WINDOW_BOX_TEXT_HEIGHT(W) \
+ (WINDOW_TOTAL_HEIGHT ((W)) \
+ - WINDOW_MODE_LINE_HEIGHT ((W)) \
- WINDOW_HEADER_LINE_HEIGHT ((W)))
/* Convert window W relative pixel X to frame pixel coordinates. */
-#define WINDOW_TO_FRAME_PIXEL_X(W, X) \
+#define WINDOW_TO_FRAME_PIXEL_X(W, X) \
((X) + WINDOW_BOX_LEFT_EDGE_X ((W)))
/* Convert window W relative pixel Y to frame pixel coordinates. */
-#define WINDOW_TO_FRAME_PIXEL_Y(W, Y) \
+#define WINDOW_TO_FRAME_PIXEL_Y(W, Y) \
((Y) + WINDOW_TOP_EDGE_Y ((W)))
/* Convert frame relative pixel X to window relative pixel X. */
-#define FRAME_TO_WINDOW_PIXEL_X(W, X) \
+#define FRAME_TO_WINDOW_PIXEL_X(W, X) \
((X) - WINDOW_BOX_LEFT_EDGE_X ((W)))
/* Convert frame relative pixel Y to window relative pixel Y. */
-#define FRAME_TO_WINDOW_PIXEL_Y(W, Y) \
+#define FRAME_TO_WINDOW_PIXEL_Y(W, Y) \
((Y) - WINDOW_TOP_EDGE_Y ((W)))
/* Convert a text area relative x-position in window W to frame X
pixel coordinates. */
-#define WINDOW_TEXT_TO_FRAME_PIXEL_X(W, X) \
+#define WINDOW_TEXT_TO_FRAME_PIXEL_X(W, X) \
(window_box_left ((W), TEXT_AREA) + (X))
/* This is the window in which the terminal's cursor should
@@ -810,14 +901,9 @@ extern Lisp_Object Vmouse_window;
extern Lisp_Object Vmouse_event;
-EXFUN (Fnext_window, 3);
-EXFUN (Fselect_window, 2);
-EXFUN (Fset_window_buffer, 3);
-EXFUN (Fset_window_point, 2);
extern Lisp_Object make_window (void);
extern Lisp_Object window_from_coordinates (struct frame *, int, int,
enum window_part *, int);
-EXFUN (Fwindow_dedicated_p, 1);
extern void resize_frame_windows (struct frame *, int, int);
extern void delete_all_child_windows (Lisp_Object);
extern void freeze_window_starts (struct frame *, int);
@@ -852,11 +938,6 @@ extern EMACS_INT minibuf_level;
extern int update_mode_lines;
-/* Nonzero if BEGV - BEG or Z - ZV of current buffer has changed since
- last redisplay that finished. */
-
-extern int clip_changed;
-
/* Nonzero if window sizes or contents have changed since last
redisplay that finished */
@@ -882,32 +963,37 @@ extern void check_frame_size (struct frame *frame, int *rows, int *cols);
struct glyph *get_phys_cursor_glyph (struct window *w);
-/* Value is non-zero if WINDOW is a live window. */
+/* Value is non-zero if WINDOW is a valid window. */
+#define WINDOW_VALID_P(WINDOW) \
+ (WINDOWP (WINDOW) \
+ && (!NILP (XWINDOW (WINDOW)->buffer) \
+ || !NILP (XWINDOW (WINDOW)->vchild) \
+ || !NILP (XWINDOW (WINDOW)->hchild)))
-#define WINDOW_LIVE_P(WINDOW) \
- (WINDOWP ((WINDOW)) && !NILP (XWINDOW ((WINDOW))->buffer))
+/* A window of any sort, leaf or interior, is "valid" if one
+ of its buffer, vchild, or hchild members is non-nil. */
+#define CHECK_VALID_WINDOW(WINDOW) \
+ CHECK_TYPE (WINDOW_VALID_P (WINDOW), Qwindow_valid_p, WINDOW)
+/* Value is non-zero if WINDOW is a live window. */
+#define WINDOW_LIVE_P(WINDOW) \
+ (WINDOWP (WINDOW) && !NILP (XWINDOW (WINDOW)->buffer))
+
+/* A window is "live" if and only if it shows a buffer. */
+#define CHECK_LIVE_WINDOW(WINDOW) \
+ CHECK_TYPE (WINDOW_LIVE_P (WINDOW), Qwindow_live_p, WINDOW)
/* These used to be in lisp.h. */
extern Lisp_Object Qwindowp, Qwindow_live_p;
extern Lisp_Object Vwindow_list;
-EXFUN (Fwindow_buffer, 1);
-EXFUN (Fget_buffer_window, 2);
-EXFUN (Fwindow_minibuffer_p, 1);
-EXFUN (Fselected_window, 0);
-EXFUN (Fframe_root_window, 1);
-EXFUN (Fframe_first_window, 1);
-EXFUN (Fset_frame_selected_window, 3);
-EXFUN (Fset_window_configuration, 1);
-EXFUN (Fcurrent_window_configuration, 1);
-extern int compare_window_configurations (Lisp_Object, Lisp_Object, int);
-EXFUN (Fpos_visible_in_window_p, 3);
+extern struct window *decode_live_window (Lisp_Object);
+extern struct window *decode_any_window (Lisp_Object);
+extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool);
extern void mark_window_cursors_off (struct window *);
extern int window_internal_height (struct window *);
extern int window_body_cols (struct window *w);
-EXFUN (Frecenter, 1);
extern void temp_output_buffer_show (Lisp_Object);
extern void replace_buffer_in_windows (Lisp_Object);
extern void replace_buffer_in_windows_safely (Lisp_Object);
@@ -916,4 +1002,6 @@ extern void init_window (void);
extern void syms_of_window (void);
extern void keys_of_window (void);
+INLINE_HEADER_END
+
#endif /* not WINDOW_H_INCLUDED */
diff --git a/src/xdisp.c b/src/xdisp.c
index 90375ba1a33..2390475ca77 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -1,6 +1,6 @@
/* Display generation from window structure and buffer text.
-Copyright (C) 1985-1988, 1993-1995, 1997-2011 Free Software Foundation, Inc.
+Copyright (C) 1985-1988, 1993-1995, 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -273,16 +273,16 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
#include <limits.h>
-#include <setjmp.h>
#include "lisp.h"
+#include "atimer.h"
#include "keyboard.h"
#include "frame.h"
#include "window.h"
#include "termchar.h"
#include "dispextern.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "indent.h"
#include "commands.h"
@@ -302,7 +302,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_X_WINDOWS
#include "xterm.h"
#endif
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
#include "w32term.h"
#endif
#ifdef HAVE_NS
@@ -333,10 +333,10 @@ static Lisp_Object Qinhibit_eval_during_redisplay;
static Lisp_Object Qbuffer_position, Qposition, Qobject;
static Lisp_Object Qright_to_left, Qleft_to_right;
-/* Cursor shapes */
+/* Cursor shapes. */
Lisp_Object Qbar, Qhbar, Qbox, Qhollow;
-/* Pointer shapes */
+/* Pointer shapes. */
static Lisp_Object Qarrow, Qhand;
Lisp_Object Qtext;
@@ -347,6 +347,7 @@ static Lisp_Object Qfontification_functions;
static Lisp_Object Qwrap_prefix;
static Lisp_Object Qline_prefix;
+static Lisp_Object Qredisplay_internal;
/* Non-nil means don't actually do any redisplay. */
@@ -365,6 +366,28 @@ Lisp_Object Qcenter;
static Lisp_Object Qmargin, Qpointer;
static Lisp_Object Qline_height;
+/* These setters are used only in this file, so they can be private. */
+static void
+wset_base_line_number (struct window *w, Lisp_Object val)
+{
+ w->base_line_number = val;
+}
+static void
+wset_base_line_pos (struct window *w, Lisp_Object val)
+{
+ w->base_line_pos = val;
+}
+static void
+wset_column_number_displayed (struct window *w, Lisp_Object val)
+{
+ w->column_number_displayed = val;
+}
+static void
+wset_region_showing (struct window *w, Lisp_Object val)
+{
+ w->region_showing = val;
+}
+
#ifdef HAVE_WINDOW_SYSTEM
/* Test if overflow newline into fringe. Called with iterator IT
@@ -383,11 +406,21 @@ static Lisp_Object Qline_height;
#define IT_OVERFLOW_NEWLINE_INTO_FRINGE(it) 0
#endif /* HAVE_WINDOW_SYSTEM */
-/* Test if the display element loaded in IT is a space or tab
- character. This is used to determine word wrapping. */
-
-#define IT_DISPLAYING_WHITESPACE(it) \
- (it->what == IT_CHARACTER && (it->c == ' ' || it->c == '\t'))
+/* Test if the display element loaded in IT, or the underlying buffer
+ or string character, is a space or a TAB character. This is used
+ to determine where word wrapping can occur. */
+
+#define IT_DISPLAYING_WHITESPACE(it) \
+ ((it->what == IT_CHARACTER && (it->c == ' ' || it->c == '\t')) \
+ || ((STRINGP (it->string) \
+ && (SREF (it->string, IT_STRING_BYTEPOS (*it)) == ' ' \
+ || SREF (it->string, IT_STRING_BYTEPOS (*it)) == '\t')) \
+ || (it->s \
+ && (it->s[IT_BYTEPOS (*it)] == ' ' \
+ || it->s[IT_BYTEPOS (*it)] == '\t')) \
+ || (IT_BYTEPOS (*it) < ZV_BYTE \
+ && (*BYTE_POS_ADDR (IT_BYTEPOS (*it)) == ' ' \
+ || *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t')))) \
/* Name of the face used to highlight trailing whitespace. */
@@ -482,9 +515,8 @@ Lisp_Object Qmenu_bar_update_hook;
static int overlay_arrow_seen;
-/* Number of windows showing the buffer of the selected window (or
- another buffer with the same base buffer). keyboard.c refers to
- this. */
+/* Number of windows showing the buffer of the selected
+ window (or another buffer with the same base buffer). */
int buffer_shared;
@@ -617,10 +649,10 @@ int current_mode_line_height, current_header_line_height;
CACHE = NULL; \
} while (0)
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Non-zero means print traces of redisplay if compiled with
- GLYPH_DEBUG != 0. */
+ GLYPH_DEBUG defined. */
int trace_redisplay_p;
@@ -736,11 +768,12 @@ static int clear_image_cache_count;
static struct glyph_slice null_glyph_slice = { 0, 0, 0, 0 };
#endif
-/* Non-zero while redisplay_internal is in progress. */
+/* True while redisplay_internal is in progress. */
-int redisplaying_p;
+bool redisplaying_p;
static Lisp_Object Qinhibit_free_realized_faces;
+static Lisp_Object Qmode_line_default_help_echo;
/* If a string, XTread_socket generates an event to display that string.
(The display is done in read_char.) */
@@ -748,7 +781,7 @@ static Lisp_Object Qinhibit_free_realized_faces;
Lisp_Object help_echo_string;
Lisp_Object help_echo_window;
Lisp_Object help_echo_object;
-EMACS_INT help_echo_pos;
+ptrdiff_t help_echo_pos;
/* Temporary variable for XTread_socket. */
@@ -795,50 +828,50 @@ static Lisp_Object get_it_property (struct it *it, Lisp_Object prop);
static void handle_line_prefix (struct it *);
-static void pint2str (char *, int, EMACS_INT);
-static void pint2hrstr (char *, int, EMACS_INT);
+static void pint2str (char *, int, ptrdiff_t);
+static void pint2hrstr (char *, int, ptrdiff_t);
static struct text_pos run_window_scroll_functions (Lisp_Object,
struct text_pos);
static void reconsider_clip_changes (struct window *, struct buffer *);
static int text_outside_line_unchanged_p (struct window *,
- EMACS_INT, EMACS_INT);
+ ptrdiff_t, ptrdiff_t);
static void store_mode_line_noprop_char (char);
static int store_mode_line_noprop (const char *, int, int);
static void handle_stop (struct it *);
-static void handle_stop_backwards (struct it *, EMACS_INT);
+static void handle_stop_backwards (struct it *, ptrdiff_t);
static void vmessage (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0);
static void ensure_echo_area_buffers (void);
static Lisp_Object unwind_with_echo_area_buffer (Lisp_Object);
static Lisp_Object with_echo_area_buffer_unwind_data (struct window *);
static int with_echo_area_buffer (struct window *, int,
- int (*) (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT),
- EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT);
+ int (*) (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t),
+ ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t);
static void clear_garbaged_frames (void);
-static int current_message_1 (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT);
+static int current_message_1 (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t);
static void pop_message (void);
-static int truncate_message_1 (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT);
-static void set_message (const char *, Lisp_Object, EMACS_INT, int);
-static int set_message_1 (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT);
+static int truncate_message_1 (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t);
+static void set_message (const char *, Lisp_Object, ptrdiff_t, int);
+static int set_message_1 (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t);
static int display_echo_area (struct window *);
-static int display_echo_area_1 (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT);
-static int resize_mini_window_1 (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT);
+static int display_echo_area_1 (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t);
+static int resize_mini_window_1 (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t);
static Lisp_Object unwind_redisplay (Lisp_Object);
static int string_char_and_length (const unsigned char *, int *);
static struct text_pos display_prop_end (struct it *, Lisp_Object,
struct text_pos);
static int compute_window_start_on_continuation_line (struct window *);
-static Lisp_Object safe_eval_handler (Lisp_Object);
static void insert_left_trunc_glyphs (struct it *);
static struct glyph_row *get_overlay_arrow_glyph_row (struct window *,
Lisp_Object);
static void extend_face_to_end_of_line (struct it *);
static int append_space_for_newline (struct it *, int);
static int cursor_row_fully_visible_p (struct window *, int, int);
-static int try_scrolling (Lisp_Object, int, EMACS_INT, EMACS_INT, int, int);
+static int try_scrolling (Lisp_Object, int, ptrdiff_t, ptrdiff_t, int, int);
static int try_cursor_movement (Lisp_Object, struct text_pos, int *);
-static int trailing_whitespace_p (EMACS_INT);
-static intmax_t message_log_check_duplicate (EMACS_INT, EMACS_INT);
+static int trailing_whitespace_p (ptrdiff_t);
+static intmax_t message_log_check_duplicate (ptrdiff_t, ptrdiff_t);
static void push_it (struct it *, struct text_pos *);
+static void iterate_out_of_display_property (struct it *);
static void pop_it (struct it *);
static void sync_frame_with_window_matrix_rows (struct window *);
static void select_frame_for_redisplay (Lisp_Object);
@@ -850,7 +883,7 @@ static Lisp_Object redisplay_window_error (Lisp_Object);
static Lisp_Object redisplay_window_0 (Lisp_Object);
static Lisp_Object redisplay_window_1 (Lisp_Object);
static int set_cursor_from_row (struct window *, struct glyph_row *,
- struct glyph_matrix *, EMACS_INT, EMACS_INT,
+ struct glyph_matrix *, ptrdiff_t, ptrdiff_t,
int, int);
static int update_menu_bar (struct frame *, int, int);
static int try_window_reusing_current_matrix (struct window *);
@@ -862,14 +895,14 @@ static int display_mode_element (struct it *, int, int, int, Lisp_Object, Lisp_O
static int store_mode_line_string (const char *, Lisp_Object, int, int, int, Lisp_Object);
static const char *decode_mode_spec (struct window *, int, int, Lisp_Object *);
static void display_menu_bar (struct window *);
-static EMACS_INT display_count_lines (EMACS_INT, EMACS_INT, EMACS_INT,
- EMACS_INT *);
+static ptrdiff_t display_count_lines (ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t *);
static int display_string (const char *, Lisp_Object, Lisp_Object,
- EMACS_INT, EMACS_INT, struct it *, int, int, int, int);
+ ptrdiff_t, ptrdiff_t, struct it *, int, int, int, int);
static void compute_line_metrics (struct it *);
static void run_redisplay_end_trigger_hook (struct it *);
-static int get_overlay_strings (struct it *, EMACS_INT);
-static int get_overlay_strings_1 (struct it *, EMACS_INT, int);
+static int get_overlay_strings (struct it *, ptrdiff_t);
+static int get_overlay_strings_1 (struct it *, ptrdiff_t, int);
static void next_overlay_string (struct it *);
static void reseat (struct it *, struct text_pos, int);
static void reseat_1 (struct it *, struct text_pos, int);
@@ -884,16 +917,17 @@ static int next_element_from_buffer (struct it *);
static int next_element_from_composition (struct it *);
static int next_element_from_image (struct it *);
static int next_element_from_stretch (struct it *);
-static void load_overlay_strings (struct it *, EMACS_INT);
+static void load_overlay_strings (struct it *, ptrdiff_t);
static int init_from_display_pos (struct it *, struct window *,
struct display_pos *);
static void reseat_to_string (struct it *, const char *,
- Lisp_Object, EMACS_INT, EMACS_INT, int, int);
+ Lisp_Object, ptrdiff_t, ptrdiff_t, int, int);
static int get_next_display_element (struct it *);
static enum move_it_result
- move_it_in_display_line_to (struct it *, EMACS_INT, int,
+ move_it_in_display_line_to (struct it *, ptrdiff_t, int,
enum move_operation_enum);
void move_it_vertically_backward (struct it *, int);
+static void get_visually_first_element (struct it *);
static void init_to_row_start (struct it *, struct window *,
struct glyph_row *);
static int init_to_row_end (struct it *, struct window *,
@@ -901,20 +935,20 @@ static int init_to_row_end (struct it *, struct window *,
static void back_to_previous_line_start (struct it *);
static int forward_to_next_line_start (struct it *, int *, struct bidi_it *);
static struct text_pos string_pos_nchars_ahead (struct text_pos,
- Lisp_Object, EMACS_INT);
-static struct text_pos string_pos (EMACS_INT, Lisp_Object);
-static struct text_pos c_string_pos (EMACS_INT, const char *, int);
-static EMACS_INT number_of_chars (const char *, int);
+ Lisp_Object, ptrdiff_t);
+static struct text_pos string_pos (ptrdiff_t, Lisp_Object);
+static struct text_pos c_string_pos (ptrdiff_t, const char *, int);
+static ptrdiff_t number_of_chars (const char *, int);
static void compute_stop_pos (struct it *);
static void compute_string_pos (struct text_pos *, struct text_pos,
Lisp_Object);
static int face_before_or_after_it_pos (struct it *, int);
-static EMACS_INT next_overlay_change (EMACS_INT);
+static ptrdiff_t next_overlay_change (ptrdiff_t);
static int handle_display_spec (struct it *, Lisp_Object, Lisp_Object,
- Lisp_Object, struct text_pos *, EMACS_INT, int);
+ Lisp_Object, struct text_pos *, ptrdiff_t, int);
static int handle_single_display_spec (struct it *, Lisp_Object,
Lisp_Object, Lisp_Object,
- struct text_pos *, EMACS_INT, int, int);
+ struct text_pos *, ptrdiff_t, int, int);
static int underlying_face_id (struct it *);
static int in_ellipses_for_invisible_text_p (struct display_pos *,
struct window *);
@@ -939,6 +973,7 @@ static void append_stretch_glyph (struct it *, Lisp_Object,
#endif /* HAVE_WINDOW_SYSTEM */
+static void produce_special_glyphs (struct it *, enum display_element_type);
static void show_mouse_face (Mouse_HLInfo *, enum draw_glyphs_face);
static int coords_in_mouse_face_p (struct window *, int, int);
@@ -1013,7 +1048,7 @@ window_box_height (struct window *w)
struct frame *f = XFRAME (w->frame);
int height = WINDOW_TOTAL_HEIGHT (w);
- xassert (height >= 0);
+ eassert (height >= 0);
/* Note: the code below that determines the mode-line/header-line
height is essentially the same as that contained in the macro
@@ -1156,7 +1191,7 @@ window_box (struct window *w, int area, int *box_x, int *box_y,
*BOTTOM_RIGHT_Y the coordinates of the bottom-right corner of the
box. */
-static inline void
+static void
window_box_edges (struct window *w, int area, int *top_left_x, int *top_left_y,
int *bottom_right_x, int *bottom_right_y)
{
@@ -1239,6 +1274,23 @@ string_from_display_spec (Lisp_Object spec)
return spec;
}
+
+/* Limit insanely large values of W->hscroll on frame F to the largest
+ value that will still prevent first_visible_x and last_visible_x of
+ 'struct it' from overflowing an int. */
+static int
+window_hscroll_limited (struct window *w, struct frame *f)
+{
+ ptrdiff_t window_hscroll = w->hscroll;
+ int window_text_width = window_box_width (w, TEXT_AREA);
+ int colwidth = FRAME_COLUMN_WIDTH (f);
+
+ if (window_hscroll > (INT_MAX - window_text_width) / colwidth - 1)
+ window_hscroll = (INT_MAX - window_text_width) / colwidth - 1;
+
+ return window_hscroll;
+}
+
/* Return 1 if position CHARPOS is visible in window W.
CHARPOS < 0 means return info about WINDOW_END position.
If visible, set *X and *Y to pixel coordinates of top left corner.
@@ -1246,7 +1298,7 @@ string_from_display_spec (Lisp_Object spec)
Set *ROWH and *VPOS to row's visible height and VPOS (row number). */
int
-pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
+pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
int *rtop, int *rbot, int *rowh, int *vpos)
{
struct it it;
@@ -1265,6 +1317,11 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
}
SET_TEXT_POS_FROM_MARKER (top, w->start);
+ /* Scrolling a minibuffer window via scroll bar when the echo area
+ shows long text sometimes resets the minibuffer contents behind
+ our backs. */
+ if (CHARPOS (top) > ZV)
+ SET_TEXT_POS (top, BEGV, BEGV_BYTE);
/* Compute exact mode line heights. */
if (WINDOW_WANTS_MODELINE_P (w))
@@ -1275,7 +1332,7 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
if (WINDOW_WANTS_HEADER_LINE_P (w))
current_header_line_height
= display_mode_line (w, HEADER_LINE_FACE_ID,
- BVAR (current_buffer, header_line_format));
+ BVAR (current_buffer, header_line_format));
start_display (&it, w, top);
move_it_to (&it, charpos, -1, it.last_visible_y-1, -1,
@@ -1298,8 +1355,8 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
glyph. */
int top_x = it.current_x;
int top_y = it.current_y;
- enum it_method it_method = it.method;
/* Calling line_bottom_y may change it.method, it.position, etc. */
+ enum it_method it_method = it.method;
int bottom_y = (last_height = 0, line_bottom_y (&it));
int window_top_y = WINDOW_HEADER_LINE_HEIGHT (w);
@@ -1307,6 +1364,31 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
visible_p = bottom_y > window_top_y;
else if (top_y < it.last_visible_y)
visible_p = 1;
+ if (bottom_y >= it.last_visible_y
+ && it.bidi_p && it.bidi_it.scan_dir == -1
+ && IT_CHARPOS (it) < charpos)
+ {
+ /* When the last line of the window is scanned backwards
+ under bidi iteration, we could be duped into thinking
+ that we have passed CHARPOS, when in fact move_it_to
+ simply stopped short of CHARPOS because it reached
+ last_visible_y. To see if that's what happened, we call
+ move_it_to again with a slightly larger vertical limit,
+ and see if it actually moved vertically; if it did, we
+ didn't really reach CHARPOS, which is beyond window end. */
+ struct it save_it = it;
+ /* Why 10? because we don't know how many canonical lines
+ will the height of the next line(s) be. So we guess. */
+ int ten_more_lines =
+ 10 * FRAME_LINE_HEIGHT (XFRAME (WINDOW_FRAME (w)));
+
+ move_it_to (&it, charpos, -1, bottom_y + ten_more_lines, -1,
+ MOVE_TO_POS | MOVE_TO_Y);
+ if (it.current_y > top_y)
+ visible_p = 0;
+
+ it = save_it;
+ }
if (visible_p)
{
if (it_method == GET_FROM_DISPLAY_VECTOR)
@@ -1370,6 +1452,7 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
Lisp_Object startpos, endpos;
EMACS_INT start, end;
struct it it3;
+ int it3_moved;
/* Find the first and the last buffer positions
covered by the display string. */
@@ -1426,6 +1509,15 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
begins. */
start_display (&it3, w, top);
move_it_to (&it3, -1, 0, top_y, -1, MOVE_TO_X | MOVE_TO_Y);
+ /* If it3_moved stays zero after the 'while' loop
+ below, that means we already were at a newline
+ before the loop (e.g., the display string begins
+ with a newline), so we don't need to (and cannot)
+ inspect the glyphs of it3.glyph_row, because
+ PRODUCE_GLYPHS will not produce anything for a
+ newline, and thus it3.glyph_row stays at its
+ stale content it got at top of the window. */
+ it3_moved = 0;
/* Finally, advance the iterator until we hit the
first display element whose character position is
CHARPOS, or until the first newline from the
@@ -1437,6 +1529,7 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
if (IT_CHARPOS (it3) == charpos
|| ITERATOR_AT_END_OF_LINE_P (&it3))
break;
+ it3_moved = 1;
set_iterator_to_next (&it3, 0);
}
top_x = it3.current_x - it3.pixel_width;
@@ -1447,7 +1540,8 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
display string, move back over the glyphs
produced from the string, until we find the
rightmost glyph not from the string. */
- if (IT_CHARPOS (it3) != charpos && EQ (it3.object, string))
+ if (it3_moved
+ && IT_CHARPOS (it3) != charpos && EQ (it3.object, string))
{
struct glyph *g = it3.glyph_row->glyphs[TEXT_AREA]
+ it3.glyph_row->used[TEXT_AREA];
@@ -1457,7 +1551,7 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
--g;
top_x -= g->pixel_width;
}
- xassert (g < it3.glyph_row->glyphs[TEXT_AREA]
+ eassert (g < it3.glyph_row->glyphs[TEXT_AREA]
+ it3.glyph_row->used[TEXT_AREA]);
}
}
@@ -1508,8 +1602,10 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
current_header_line_height = current_mode_line_height = -1;
- if (visible_p && XFASTINT (w->hscroll) > 0)
- *x -= XFASTINT (w->hscroll) * WINDOW_FRAME_COLUMN_WIDTH (w);
+ if (visible_p && w->hscroll > 0)
+ *x -=
+ window_hscroll_limited (w, WINDOW_XFRAME (w))
+ * WINDOW_FRAME_COLUMN_WIDTH (w);
#if 0
/* Debugging code. */
@@ -1529,7 +1625,7 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
returns an invalid character. If we find one, we return a `?', but
with the length of the invalid character. */
-static inline int
+static int
string_char_and_length (const unsigned char *str, int *len)
{
int c;
@@ -1550,9 +1646,9 @@ string_char_and_length (const unsigned char *str, int *len)
in STRING, return the position NCHARS ahead (NCHARS >= 0). */
static struct text_pos
-string_pos_nchars_ahead (struct text_pos pos, Lisp_Object string, EMACS_INT nchars)
+string_pos_nchars_ahead (struct text_pos pos, Lisp_Object string, ptrdiff_t nchars)
{
- xassert (STRINGP (string) && nchars >= 0);
+ eassert (STRINGP (string) && nchars >= 0);
if (STRING_MULTIBYTE (string))
{
@@ -1577,12 +1673,12 @@ string_pos_nchars_ahead (struct text_pos pos, Lisp_Object string, EMACS_INT ncha
/* Value is the text position, i.e. character and byte position,
for character position CHARPOS in STRING. */
-static inline struct text_pos
-string_pos (EMACS_INT charpos, Lisp_Object string)
+static struct text_pos
+string_pos (ptrdiff_t charpos, Lisp_Object string)
{
struct text_pos pos;
- xassert (STRINGP (string));
- xassert (charpos >= 0);
+ eassert (STRINGP (string));
+ eassert (charpos >= 0);
SET_TEXT_POS (pos, charpos, string_char_to_byte (string, charpos));
return pos;
}
@@ -1593,12 +1689,12 @@ string_pos (EMACS_INT charpos, Lisp_Object string)
means recognize multibyte characters. */
static struct text_pos
-c_string_pos (EMACS_INT charpos, const char *s, int multibyte_p)
+c_string_pos (ptrdiff_t charpos, const char *s, int multibyte_p)
{
struct text_pos pos;
- xassert (s != NULL);
- xassert (charpos >= 0);
+ eassert (s != NULL);
+ eassert (charpos >= 0);
if (multibyte_p)
{
@@ -1623,14 +1719,14 @@ c_string_pos (EMACS_INT charpos, const char *s, int multibyte_p)
/* Value is the number of characters in C string S. MULTIBYTE_P
non-zero means recognize multibyte characters. */
-static EMACS_INT
+static ptrdiff_t
number_of_chars (const char *s, int multibyte_p)
{
- EMACS_INT nchars;
+ ptrdiff_t nchars;
if (multibyte_p)
{
- EMACS_INT rest = strlen (s);
+ ptrdiff_t rest = strlen (s);
int len;
const unsigned char *p = (const unsigned char *) s;
@@ -1654,8 +1750,8 @@ number_of_chars (const char *s, int multibyte_p)
static void
compute_string_pos (struct text_pos *newpos, struct text_pos pos, Lisp_Object string)
{
- xassert (STRINGP (string));
- xassert (CHARPOS (*newpos) >= CHARPOS (pos));
+ eassert (STRINGP (string));
+ eassert (CHARPOS (*newpos) >= CHARPOS (pos));
if (STRING_MULTIBYTE (string))
*newpos = string_pos_nchars_ahead (pos, string,
@@ -2323,22 +2419,19 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect)
/* Error handler for safe_eval and safe_call. */
static Lisp_Object
-safe_eval_handler (Lisp_Object arg)
+safe_eval_handler (Lisp_Object arg, ptrdiff_t nargs, Lisp_Object *args)
{
- add_to_log ("Error during redisplay: %S", arg, Qnil);
+ add_to_log ("Error during redisplay: %S signaled %S",
+ Flist (nargs, args), arg);
return Qnil;
}
-
-/* Evaluate SEXPR and return the result, or nil if something went
+/* Call function FUNC with the rest of NARGS - 1 arguments
+ following. Return the result, or nil if something went
wrong. Prevent redisplay during the evaluation. */
-/* Call function ARGS[0] with arguments ARGS[1] to ARGS[NARGS - 1].
- Return the result, or nil if something went wrong. Prevent
- redisplay during the evaluation. */
-
Lisp_Object
-safe_call (ptrdiff_t nargs, Lisp_Object *args)
+safe_call (ptrdiff_t nargs, Lisp_Object func, ...)
{
Lisp_Object val;
@@ -2346,8 +2439,17 @@ safe_call (ptrdiff_t nargs, Lisp_Object *args)
val = Qnil;
else
{
- int count = SPECPDL_INDEX ();
+ va_list ap;
+ ptrdiff_t i;
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1;
+ Lisp_Object *args = alloca (nargs * word_size);
+
+ args[0] = func;
+ va_start (ap, func);
+ for (i = 1; i < nargs; i++)
+ args[i] = va_arg (ap, Lisp_Object);
+ va_end (ap);
GCPRO1 (args[0]);
gcpro1.nvars = nargs;
@@ -2370,10 +2472,7 @@ safe_call (ptrdiff_t nargs, Lisp_Object *args)
Lisp_Object
safe_call1 (Lisp_Object fn, Lisp_Object arg)
{
- Lisp_Object args[2];
- args[0] = fn;
- args[1] = arg;
- return safe_call (2, args);
+ return safe_call (2, fn, arg);
}
static Lisp_Object Qeval;
@@ -2384,17 +2483,13 @@ safe_eval (Lisp_Object sexpr)
return safe_call1 (Qeval, sexpr);
}
-/* Call function FN with one argument ARG.
+/* Call function FN with two arguments ARG1 and ARG2.
Return the result, or nil if something went wrong. */
Lisp_Object
safe_call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
{
- Lisp_Object args[3];
- args[0] = fn;
- args[1] = arg1;
- args[2] = arg2;
- return safe_call (3, args);
+ return safe_call (3, fn, arg1, arg2);
}
@@ -2413,23 +2508,23 @@ check_it (struct it *it)
{
if (it->method == GET_FROM_STRING)
{
- xassert (STRINGP (it->string));
- xassert (IT_STRING_CHARPOS (*it) >= 0);
+ eassert (STRINGP (it->string));
+ eassert (IT_STRING_CHARPOS (*it) >= 0);
}
else
{
- xassert (IT_STRING_CHARPOS (*it) < 0);
+ eassert (IT_STRING_CHARPOS (*it) < 0);
if (it->method == GET_FROM_BUFFER)
{
/* Check that character and byte positions agree. */
- xassert (IT_CHARPOS (*it) == BYTE_TO_CHAR (IT_BYTEPOS (*it)));
+ eassert (IT_CHARPOS (*it) == BYTE_TO_CHAR (IT_BYTEPOS (*it)));
}
}
if (it->dpvec)
- xassert (it->current.dpvec_index >= 0);
+ eassert (it->current.dpvec_index >= 0);
else
- xassert (it->current.dpvec_index < 0);
+ eassert (it->current.dpvec_index < 0);
}
#define CHECK_IT(IT) check_it ((IT))
@@ -2441,7 +2536,7 @@ check_it (struct it *it)
#endif /* not 0 */
-#if GLYPH_DEBUG && XASSERTS
+#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
/* Check that the window end of window W is what we expect it
to be---the last row in the current matrix displaying text. */
@@ -2453,7 +2548,7 @@ check_window_end (struct window *w)
&& !NILP (w->window_end_valid))
{
struct glyph_row *row;
- xassert ((row = MATRIX_ROW (w->current_matrix,
+ eassert ((row = MATRIX_ROW (w->current_matrix,
XFASTINT (w->window_end_vpos)),
!row->enabled_p
|| MATRIX_ROW_DISPLAYS_TEXT_P (row)
@@ -2467,7 +2562,7 @@ check_window_end (struct window *w)
#define CHECK_WINDOW_END(W) (void) 0
-#endif
+#endif /* GLYPH_DEBUG and ENABLE_CHECKING */
@@ -2496,15 +2591,15 @@ check_window_end (struct window *w)
void
init_iterator (struct it *it, struct window *w,
- EMACS_INT charpos, EMACS_INT bytepos,
+ ptrdiff_t charpos, ptrdiff_t bytepos,
struct glyph_row *row, enum face_id base_face_id)
{
int highlight_region_p;
enum face_id remapped_base_face_id = base_face_id;
/* Some precondition checks. */
- xassert (w != NULL && it != NULL);
- xassert (charpos < 0 || (charpos >= BUF_BEG (current_buffer)
+ eassert (w != NULL && it != NULL);
+ eassert (charpos < 0 || (charpos >= BUF_BEG (current_buffer)
&& charpos <= ZV));
/* If face attributes have been changed since the last redisplay,
@@ -2519,7 +2614,8 @@ init_iterator (struct it *it, struct window *w,
/* Perhaps remap BASE_FACE_ID to a user-specified alternative. */
if (! NILP (Vface_remapping_alist))
- remapped_base_face_id = lookup_basic_face (XFRAME (w->frame), base_face_id);
+ remapped_base_face_id
+ = lookup_basic_face (XFRAME (w->frame), base_face_id);
/* Use one of the mode line rows of W's desired matrix if
appropriate. */
@@ -2587,7 +2683,9 @@ init_iterator (struct it *it, struct window *w,
is invisible. >0 means lines indented more than this value are
invisible. */
it->selective = (INTEGERP (BVAR (current_buffer, selective_display))
- ? XINT (BVAR (current_buffer, selective_display))
+ ? (clip_to_bounds
+ (-1, XINT (BVAR (current_buffer, selective_display)),
+ PTRDIFF_MAX))
: (!NILP (BVAR (current_buffer, selective_display))
? -1 : 0));
it->selective_display_ellipsis_p
@@ -2620,7 +2718,7 @@ init_iterator (struct it *it, struct window *w,
&& WINDOWP (minibuf_selected_window)
&& w == XWINDOW (minibuf_selected_window))))
{
- EMACS_INT markpos = marker_position (BVAR (current_buffer, mark));
+ ptrdiff_t markpos = marker_position (BVAR (current_buffer, mark));
it->region_beg_charpos = min (PT, markpos);
it->region_end_charpos = max (PT, markpos);
}
@@ -2634,13 +2732,14 @@ init_iterator (struct it *it, struct window *w,
it->redisplay_end_trigger_charpos
= marker_position (w->redisplay_end_trigger);
else if (INTEGERP (w->redisplay_end_trigger))
- it->redisplay_end_trigger_charpos = XINT (w->redisplay_end_trigger);
+ it->redisplay_end_trigger_charpos =
+ clip_to_bounds (PTRDIFF_MIN, XINT (w->redisplay_end_trigger), PTRDIFF_MAX);
it->tab_width = SANE_TAB_WIDTH (current_buffer);
/* Are lines in the display truncated? */
if (base_face_id != DEFAULT_FACE_ID
- || XINT (it->w->hscroll)
+ || it->w->hscroll
|| (! WINDOW_FULL_WIDTH_P (it->w)
&& ((!NILP (Vtruncate_partial_width_windows)
&& !INTEGERP (Vtruncate_partial_width_windows))
@@ -2655,31 +2754,37 @@ init_iterator (struct it *it, struct window *w,
it->line_wrap = TRUNCATE;
/* Get dimensions of truncation and continuation glyphs. These are
- displayed as fringe bitmaps under X, so we don't need them for such
- frames. */
- if (!FRAME_WINDOW_P (it->f))
+ displayed as fringe bitmaps under X, but we need them for such
+ frames when the fringes are turned off. But leave the dimensions
+ zero for tooltip frames, as these glyphs look ugly there and also
+ sabotage calculations of tooltip dimensions in x-show-tip. */
+#ifdef HAVE_WINDOW_SYSTEM
+ if (!(FRAME_WINDOW_P (it->f)
+ && FRAMEP (tip_frame)
+ && it->f == XFRAME (tip_frame)))
+#endif
{
if (it->line_wrap == TRUNCATE)
{
/* We will need the truncation glyph. */
- xassert (it->glyph_row == NULL);
+ eassert (it->glyph_row == NULL);
produce_special_glyphs (it, IT_TRUNCATION);
it->truncation_pixel_width = it->pixel_width;
}
else
{
/* We will need the continuation glyph. */
- xassert (it->glyph_row == NULL);
+ eassert (it->glyph_row == NULL);
produce_special_glyphs (it, IT_CONTINUATION);
it->continuation_pixel_width = it->pixel_width;
}
-
- /* Reset these values to zero because the produce_special_glyphs
- above has changed them. */
- it->pixel_width = it->ascent = it->descent = 0;
- it->phys_ascent = it->phys_descent = 0;
}
+ /* Reset these values to zero because the produce_special_glyphs
+ above has changed them. */
+ it->pixel_width = it->ascent = it->descent = 0;
+ it->phys_ascent = it->phys_descent = 0;
+
/* Set this after getting the dimensions of truncation and
continuation glyphs, so that we don't produce glyphs when calling
produce_special_glyphs, above. */
@@ -2702,16 +2807,19 @@ init_iterator (struct it *it, struct window *w,
}
else
{
- it->first_visible_x
- = XFASTINT (it->w->hscroll) * FRAME_COLUMN_WIDTH (it->f);
+ it->first_visible_x =
+ window_hscroll_limited (it->w, it->f) * FRAME_COLUMN_WIDTH (it->f);
it->last_visible_x = (it->first_visible_x
+ window_box_width (w, TEXT_AREA));
- /* If we truncate lines, leave room for the truncator glyph(s) at
+ /* If we truncate lines, leave room for the truncation glyph(s) at
the right margin. Otherwise, leave room for the continuation
- glyph(s). Truncation and continuation glyphs are not inserted
- for window-based redisplay. */
- if (!FRAME_WINDOW_P (it->f))
+ glyph(s). Done only if the window has no fringes. Since we
+ don't know at this point whether there will be any R2L lines in
+ the window, we reserve space for truncation/continuation glyphs
+ even if only one of the fringes is absent. */
+ if (WINDOW_RIGHT_FRINGE_WIDTH (it->w) == 0
+ || (it->bidi_p && WINDOW_LEFT_FRINGE_WIDTH (it->w) == 0))
{
if (it->line_wrap == TRUNCATE)
it->last_visible_x -= it->truncation_pixel_width;
@@ -2750,9 +2858,12 @@ init_iterator (struct it *it, struct window *w,
if (charpos >= BUF_BEG (current_buffer))
{
it->end_charpos = ZV;
- it->face_id = -1;
IT_CHARPOS (*it) = charpos;
+ /* We will rely on `reseat' to set this up properly, via
+ handle_face_prop. */
+ it->face_id = it->base_face_id;
+
/* Compute byte position if not specified. */
if (bytepos < charpos)
IT_BYTEPOS (*it) = CHAR_TO_BYTE (charpos);
@@ -2844,7 +2955,10 @@ start_display (struct it *it, struct window *w, struct text_pos pos)
/* Or it fits exactly and we're on a window
system frame. */
|| (new_x == it->last_visible_x
- && FRAME_WINDOW_P (it->f))))
+ && FRAME_WINDOW_P (it->f)
+ && ((it->bidi_p && it->bidi_it.paragraph_dir == R2L)
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))))
{
if ((it->current.dpvec_index >= 0
|| it->current.overlay_string_index >= 0)
@@ -2891,7 +3005,7 @@ in_ellipses_for_invisible_text_p (struct display_pos *pos, struct window *w)
{
Lisp_Object prop, window;
int ellipses_p = 0;
- EMACS_INT charpos = CHARPOS (pos->pos);
+ ptrdiff_t charpos = CHARPOS (pos->pos);
/* If POS specifies a position in a display vector, this might
be for an ellipsis displayed for invisible text. We won't
@@ -2923,7 +3037,7 @@ in_ellipses_for_invisible_text_p (struct display_pos *pos, struct window *w)
static int
init_from_display_pos (struct it *it, struct window *w, struct display_pos *pos)
{
- EMACS_INT charpos = CHARPOS (pos->pos), bytepos = BYTEPOS (pos->pos);
+ ptrdiff_t charpos = CHARPOS (pos->pos), bytepos = BYTEPOS (pos->pos);
int i, overlay_strings_with_newlines = 0;
/* If POS specifies a position in a display vector, this might
@@ -2983,7 +3097,7 @@ init_from_display_pos (struct it *it, struct window *w, struct display_pos *pos)
pos->overlay_string_index is in IT->overlay_strings. */
if (pos->overlay_string_index >= OVERLAY_STRING_CHUNK_SIZE)
{
- int n = pos->overlay_string_index / OVERLAY_STRING_CHUNK_SIZE;
+ ptrdiff_t n = pos->overlay_string_index / OVERLAY_STRING_CHUNK_SIZE;
it->current.overlay_string_index = 0;
while (n--)
{
@@ -2996,9 +3110,43 @@ init_from_display_pos (struct it *it, struct window *w, struct display_pos *pos)
relative_index = (it->current.overlay_string_index
% OVERLAY_STRING_CHUNK_SIZE);
it->string = it->overlay_strings[relative_index];
- xassert (STRINGP (it->string));
+ eassert (STRINGP (it->string));
it->current.string_pos = pos->string_pos;
it->method = GET_FROM_STRING;
+ it->end_charpos = SCHARS (it->string);
+ /* Set up the bidi iterator for this overlay string. */
+ if (it->bidi_p)
+ {
+ it->bidi_it.string.lstring = it->string;
+ it->bidi_it.string.s = NULL;
+ it->bidi_it.string.schars = SCHARS (it->string);
+ it->bidi_it.string.bufpos = it->overlay_strings_charpos;
+ it->bidi_it.string.from_disp_str = it->string_from_display_prop_p;
+ it->bidi_it.string.unibyte = !it->multibyte_p;
+ bidi_init_it (IT_STRING_CHARPOS (*it), IT_STRING_BYTEPOS (*it),
+ FRAME_WINDOW_P (it->f), &it->bidi_it);
+
+ /* Synchronize the state of the bidi iterator with
+ pos->string_pos. For any string position other than
+ zero, this will be done automagically when we resume
+ iteration over the string and get_visually_first_element
+ is called. But if string_pos is zero, and the string is
+ to be reordered for display, we need to resync manually,
+ since it could be that the iteration state recorded in
+ pos ended at string_pos of 0 moving backwards in string. */
+ if (CHARPOS (pos->string_pos) == 0)
+ {
+ get_visually_first_element (it);
+ if (IT_STRING_CHARPOS (*it) != 0)
+ do {
+ /* Paranoia. */
+ eassert (it->bidi_it.charpos < it->bidi_it.string.schars);
+ bidi_move_to_visually_next (&it->bidi_it);
+ } while (it->bidi_it.charpos != 0);
+ }
+ eassert (IT_STRING_CHARPOS (*it) == it->bidi_it.charpos
+ && IT_STRING_BYTEPOS (*it) == it->bidi_it.bytepos);
+ }
}
if (CHARPOS (pos->string_pos) >= 0)
@@ -3007,7 +3155,10 @@ init_from_display_pos (struct it *it, struct window *w, struct display_pos *pos)
string. This can only be a string from a `display' property.
IT should already be filled with that string. */
it->current.string_pos = pos->string_pos;
- xassert (STRINGP (it->string));
+ eassert (STRINGP (it->string));
+ if (it->bidi_p)
+ bidi_init_it (IT_STRING_CHARPOS (*it), IT_STRING_BYTEPOS (*it),
+ FRAME_WINDOW_P (it->f), &it->bidi_it);
}
/* Restore position in display vector translations, control
@@ -3016,7 +3167,7 @@ init_from_display_pos (struct it *it, struct window *w, struct display_pos *pos)
{
if (it->dpvec == NULL)
get_next_display_element (it);
- xassert (it->dpvec && it->current.dpvec_index == 0);
+ eassert (it->dpvec && it->current.dpvec_index == 0);
it->current.dpvec_index = pos->dpvec_index;
}
@@ -3105,7 +3256,15 @@ handle_stop (struct it *it)
overlays even if the actual buffer text is replaced. */
if (!handle_overlay_change_p
|| it->sp > 1
- || !get_overlay_strings_1 (it, 0, 0))
+ /* Don't call get_overlay_strings_1 if we already
+ have overlay strings loaded, because doing so
+ will load them again and push the iterator state
+ onto the stack one more time, which is not
+ expected by the rest of the code that processes
+ overlay strings. */
+ || (it->current.overlay_string_index < 0
+ ? !get_overlay_strings_1 (it, 0, 0)
+ : 0))
{
if (it->ellipsis_p)
setup_for_ellipsis (it, 0);
@@ -3170,7 +3329,7 @@ compute_stop_pos (struct it *it)
{
register INTERVAL iv, next_iv;
Lisp_Object object, limit, position;
- EMACS_INT charpos, bytepos;
+ ptrdiff_t charpos, bytepos;
if (STRINGP (it->string))
{
@@ -3184,7 +3343,7 @@ compute_stop_pos (struct it *it)
}
else
{
- EMACS_INT pos;
+ ptrdiff_t pos;
/* If end_charpos is out of range for some reason, such as a
misbehaving display function, rationalize it (Bug#5984). */
@@ -3222,7 +3381,7 @@ compute_stop_pos (struct it *it)
interval if there isn't such an interval. */
position = make_number (charpos);
iv = validate_interval_range (object, &position, &position, 0);
- if (!NULL_INTERVAL_P (iv))
+ if (iv)
{
Lisp_Object values_here[LAST_PROP_IDX];
struct props *p;
@@ -3234,7 +3393,7 @@ compute_stop_pos (struct it *it)
/* Look for an interval following iv that has different
properties. */
for (next_iv = next_interval (iv);
- (!NULL_INTERVAL_P (next_iv)
+ (next_iv
&& (NILP (limit)
|| XFASTINT (limit) > next_iv->position));
next_iv = next_interval (next_iv))
@@ -3252,7 +3411,7 @@ compute_stop_pos (struct it *it)
break;
}
- if (!NULL_INTERVAL_P (next_iv))
+ if (next_iv)
{
if (INTEGERP (limit)
&& next_iv->position >= XFASTINT (limit))
@@ -3266,7 +3425,7 @@ compute_stop_pos (struct it *it)
if (it->cmp_it.id < 0)
{
- EMACS_INT stoppos = it->end_charpos;
+ ptrdiff_t stoppos = it->end_charpos;
if (it->bidi_p && it->bidi_it.scan_dir < 0)
stoppos = -1;
@@ -3274,7 +3433,7 @@ compute_stop_pos (struct it *it)
stoppos, it->string);
}
- xassert (STRINGP (it->string)
+ eassert (STRINGP (it->string)
|| (it->stop_charpos >= BEGV
&& it->stop_charpos >= IT_CHARPOS (*it)));
}
@@ -3285,11 +3444,11 @@ compute_stop_pos (struct it *it)
follows. This is like `next-overlay-change' but doesn't use
xmalloc. */
-static EMACS_INT
-next_overlay_change (EMACS_INT pos)
+static ptrdiff_t
+next_overlay_change (ptrdiff_t pos)
{
ptrdiff_t i, noverlays;
- EMACS_INT endpos;
+ ptrdiff_t endpos;
Lisp_Object *overlays;
/* Get all overlays at the given position. */
@@ -3300,7 +3459,7 @@ next_overlay_change (EMACS_INT pos)
for (i = 0; i < noverlays; ++i)
{
Lisp_Object oend;
- EMACS_INT oendpos;
+ ptrdiff_t oendpos;
oend = OVERLAY_END (overlays[i]);
oendpos = OVERLAY_POSITION (oend);
@@ -3327,7 +3486,7 @@ next_overlay_change (EMACS_INT pos)
strings, non-zero otherwise. It is set to 2 if the display string
uses any kind of `(space ...)' spec that will produce a stretch of
white space in the text area. */
-EMACS_INT
+ptrdiff_t
compute_display_string_pos (struct text_pos *position,
struct bidi_string_data *string,
int frame_window_p, int *disp_prop)
@@ -3337,10 +3496,10 @@ compute_display_string_pos (struct text_pos *position,
(string && STRINGP (string->lstring)) ? string->lstring : Qnil;
Lisp_Object pos, spec, limpos;
int string_p = (string && (STRINGP (string->lstring) || string->s));
- EMACS_INT eob = string_p ? string->schars : ZV;
- EMACS_INT begb = string_p ? 0 : BEGV;
- EMACS_INT bufpos, charpos = CHARPOS (*position);
- EMACS_INT lim =
+ ptrdiff_t eob = string_p ? string->schars : ZV;
+ ptrdiff_t begb = string_p ? 0 : BEGV;
+ ptrdiff_t bufpos, charpos = CHARPOS (*position);
+ ptrdiff_t lim =
(charpos < eob - MAX_DISP_SCAN) ? charpos + MAX_DISP_SCAN : eob;
struct text_pos tpos;
int rv = 0;
@@ -3411,14 +3570,14 @@ compute_display_string_pos (struct text_pos *position,
return -1. A display string is either an overlay with `display'
property whose value is a string or a `display' text property whose
value is a string. */
-EMACS_INT
-compute_display_string_end (EMACS_INT charpos, struct bidi_string_data *string)
+ptrdiff_t
+compute_display_string_end (ptrdiff_t charpos, struct bidi_string_data *string)
{
/* OBJECT = nil means current buffer. */
Lisp_Object object =
(string && STRINGP (string->lstring)) ? string->lstring : Qnil;
Lisp_Object pos = make_number (charpos);
- EMACS_INT eob =
+ ptrdiff_t eob =
(STRINGP (object) || (string && string->s)) ? string->schars : ZV;
if (charpos >= eob || (string->s && !STRINGP (object)))
@@ -3481,7 +3640,7 @@ handle_fontified_prop (struct it *it)
no amount of fontifying will be able to change it. */
NILP (prop) && IT_CHARPOS (*it) < Z))
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object val;
struct buffer *obuf = current_buffer;
int begv = BEGV, zv = ZV;
@@ -3490,7 +3649,7 @@ handle_fontified_prop (struct it *it)
val = Vfontification_functions;
specbind (Qfontification_functions, Qnil);
- xassert (it->end_charpos == ZV);
+ eassert (it->end_charpos == ZV);
if (!CONSP (val) || EQ (XCAR (val), Qlambda))
safe_call1 (val, pos);
@@ -3545,7 +3704,7 @@ handle_fontified_prop (struct it *it)
}
/* There isn't much we can reasonably do to protect against
misbehaving fontification, but here's a fig leaf. */
- else if (!NILP (BVAR (obuf, name)))
+ else if (BUFFER_LIVE_P (obuf))
set_buffer_internal_1 (obuf);
/* The fontification code may have added/removed text.
@@ -3578,7 +3737,7 @@ static enum prop_handled
handle_face_prop (struct it *it)
{
int new_face_id;
- EMACS_INT next_stop;
+ ptrdiff_t next_stop;
if (!STRINGP (it->string))
{
@@ -3619,11 +3778,12 @@ handle_face_prop (struct it *it)
else
{
int base_face_id;
- EMACS_INT bufpos;
+ ptrdiff_t bufpos;
int i;
Lisp_Object from_overlay
= (it->current.overlay_string_index >= 0
- ? it->string_overlays[it->current.overlay_string_index]
+ ? it->string_overlays[it->current.overlay_string_index
+ % OVERLAY_STRING_CHUNK_SIZE]
: Qnil);
/* See if we got to this string directly or indirectly from
@@ -3637,7 +3797,8 @@ handle_face_prop (struct it *it)
{
if (it->stack[i].current.overlay_string_index >= 0)
from_overlay
- = it->string_overlays[it->stack[i].current.overlay_string_index];
+ = it->string_overlays[it->stack[i].current.overlay_string_index
+ % OVERLAY_STRING_CHUNK_SIZE];
else if (! NILP (it->stack[i].from_overlay))
from_overlay = it->stack[i].from_overlay;
@@ -3670,7 +3831,9 @@ handle_face_prop (struct it *it)
with, so that overlay strings appear in the same face as
surrounding text, unless they specify their own
faces. */
- base_face_id = underlying_face_id (it);
+ base_face_id = it->string_from_prefix_prop_p
+ ? DEFAULT_FACE_ID
+ : underlying_face_id (it);
}
new_face_id = face_at_string_position (it->w,
@@ -3718,7 +3881,7 @@ underlying_face_id (struct it *it)
{
int face_id = it->base_face_id, i;
- xassert (STRINGP (it->string));
+ eassert (STRINGP (it->string));
for (i = it->sp - 1; i >= 0; --i)
if (NILP (it->stack[i].string))
@@ -3737,15 +3900,15 @@ static int
face_before_or_after_it_pos (struct it *it, int before_p)
{
int face_id, limit;
- EMACS_INT next_check_charpos;
+ ptrdiff_t next_check_charpos;
struct it it_copy;
void *it_copy_data = NULL;
- xassert (it->s == NULL);
+ eassert (it->s == NULL);
if (STRINGP (it->string))
{
- EMACS_INT bufpos, charpos;
+ ptrdiff_t bufpos, charpos;
int base_face_id;
/* No face change past the end of the string (for the case
@@ -3807,7 +3970,7 @@ face_before_or_after_it_pos (struct it *it, int before_p)
charpos = it_copy.bidi_it.charpos;
}
}
- xassert (0 <= charpos && charpos <= SCHARS (it->string));
+ eassert (0 <= charpos && charpos <= SCHARS (it->string));
if (it->current.overlay_string_index >= 0)
bufpos = IT_CHARPOS (*it);
@@ -3907,7 +4070,7 @@ face_before_or_after_it_pos (struct it *it, int before_p)
it_copy.bidi_it.charpos, it_copy.bidi_it.bytepos);
}
}
- xassert (BEGV <= CHARPOS (pos) && CHARPOS (pos) <= ZV);
+ eassert (BEGV <= CHARPOS (pos) && CHARPOS (pos) <= ZV);
/* Determine face for CHARSET_ASCII, or unibyte. */
face_id = face_at_buffer_position (it->w,
@@ -3944,40 +4107,56 @@ static enum prop_handled
handle_invisible_prop (struct it *it)
{
enum prop_handled handled = HANDLED_NORMALLY;
+ int invis_p;
+ Lisp_Object prop;
if (STRINGP (it->string))
{
- Lisp_Object prop, end_charpos, limit, charpos;
+ Lisp_Object end_charpos, limit, charpos;
/* Get the value of the invisible text property at the
current position. Value will be nil if there is no such
property. */
charpos = make_number (IT_STRING_CHARPOS (*it));
prop = Fget_text_property (charpos, Qinvisible, it->string);
+ invis_p = TEXT_PROP_MEANS_INVISIBLE (prop);
- if (!NILP (prop)
- && IT_STRING_CHARPOS (*it) < it->end_charpos)
+ if (invis_p && IT_STRING_CHARPOS (*it) < it->end_charpos)
{
- EMACS_INT endpos;
+ /* Record whether we have to display an ellipsis for the
+ invisible text. */
+ int display_ellipsis_p = (invis_p == 2);
+ ptrdiff_t len, endpos;
handled = HANDLED_RECOMPUTE_PROPS;
- /* Get the position at which the next change of the
- invisible text property can be found in IT->string.
- Value will be nil if the property value is the same for
- all the rest of IT->string. */
- XSETINT (limit, SCHARS (it->string));
- end_charpos = Fnext_single_property_change (charpos, Qinvisible,
- it->string, limit);
-
- /* Text at current position is invisible. The next
- change in the property is at position end_charpos.
- Move IT's current position to that position. */
- if (INTEGERP (end_charpos)
- && (endpos = XFASTINT (end_charpos)) < XFASTINT (limit))
+ /* Get the position at which the next visible text can be
+ found in IT->string, if any. */
+ endpos = len = SCHARS (it->string);
+ XSETINT (limit, len);
+ do
+ {
+ end_charpos = Fnext_single_property_change (charpos, Qinvisible,
+ it->string, limit);
+ if (INTEGERP (end_charpos))
+ {
+ endpos = XFASTINT (end_charpos);
+ prop = Fget_text_property (end_charpos, Qinvisible, it->string);
+ invis_p = TEXT_PROP_MEANS_INVISIBLE (prop);
+ if (invis_p == 2)
+ display_ellipsis_p = 1;
+ }
+ }
+ while (invis_p && endpos < len);
+
+ if (display_ellipsis_p)
+ it->ellipsis_p = 1;
+
+ if (endpos < len)
{
+ /* Text at END_CHARPOS is visible. Move IT there. */
struct text_pos old;
- EMACS_INT oldpos;
+ ptrdiff_t oldpos;
old = it->current.string_pos;
oldpos = CHARPOS (old);
@@ -4011,7 +4190,8 @@ handle_invisible_prop (struct it *it)
/* The rest of the string is invisible. If this is an
overlay string, proceed with the next overlay string
or whatever comes and return a character from there. */
- if (it->current.overlay_string_index >= 0)
+ if (it->current.overlay_string_index >= 0
+ && !display_ellipsis_p)
{
next_overlay_string (it);
/* Don't check for overlay strings when we just
@@ -4028,9 +4208,8 @@ handle_invisible_prop (struct it *it)
}
else
{
- int invis_p;
- EMACS_INT newpos, next_stop, start_charpos, tem;
- Lisp_Object pos, prop, overlay;
+ ptrdiff_t newpos, next_stop, start_charpos, tem;
+ Lisp_Object pos, overlay;
/* First of all, is there invisible text at this position? */
tem = start_charpos = IT_CHARPOS (*it);
@@ -4092,7 +4271,7 @@ handle_invisible_prop (struct it *it)
/* The position newpos is now either ZV or on visible text. */
if (it->bidi_p)
{
- EMACS_INT bpos = CHAR_TO_BYTE (newpos);
+ ptrdiff_t bpos = CHAR_TO_BYTE (newpos);
int on_newline =
bpos == ZV_BYTE || FETCH_BYTE (bpos) == '\n';
int after_newline =
@@ -4268,7 +4447,7 @@ handle_display_prop (struct it *it)
{
Lisp_Object propval, object, overlay;
struct text_pos *position;
- EMACS_INT bufpos;
+ ptrdiff_t bufpos;
/* Nonzero if some property replaces the display of the text itself. */
int display_replaced_p = 0;
@@ -4333,13 +4512,13 @@ handle_display_prop (struct it *it)
static int
handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
Lisp_Object overlay, struct text_pos *position,
- EMACS_INT bufpos, int frame_window_p)
+ ptrdiff_t bufpos, int frame_window_p)
{
int replacing_p = 0;
int rv;
if (CONSP (spec)
- /* Simple specerties. */
+ /* Simple specifications. */
&& !EQ (XCAR (spec), Qimage)
&& !EQ (XCAR (spec), Qspace)
&& !EQ (XCAR (spec), Qwhen)
@@ -4369,7 +4548,7 @@ handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
}
else if (VECTORP (spec))
{
- int i;
+ ptrdiff_t i;
for (i = 0; i < ASIZE (spec); ++i)
if ((rv = handle_single_display_spec (it, AREF (spec, i), object,
overlay, position, bufpos,
@@ -4440,7 +4619,7 @@ display_prop_end (struct it *it, Lisp_Object object, struct text_pos start_pos)
static int
handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
Lisp_Object overlay, struct text_pos *position,
- EMACS_INT bufpos, int display_replaced_p,
+ ptrdiff_t bufpos, int display_replaced_p,
int frame_window_p)
{
Lisp_Object form;
@@ -4462,7 +4641,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
if (!NILP (form) && !EQ (form, Qt))
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1;
/* Bind `object' to the object having the `display' property, a
@@ -4504,7 +4683,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
&& (EQ (XCAR (it->font_height), Qplus)
|| EQ (XCAR (it->font_height), Qminus))
&& CONSP (XCDR (it->font_height))
- && INTEGERP (XCAR (XCDR (it->font_height))))
+ && RANGED_INTEGERP (0, XCAR (XCDR (it->font_height)), INT_MAX))
{
/* `(+ N)' or `(- N)' where N is an integer. */
int steps = XINT (XCAR (XCDR (it->font_height)));
@@ -4536,7 +4715,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
{
/* Evaluate IT->font_height with `height' bound to the
current specified height to get the new height. */
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qheight, face->lface[LFACE_HEIGHT_INDEX]);
value = safe_eval (it->font_height);
@@ -4659,10 +4838,22 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
if (!FRAME_WINDOW_P (it->f))
/* If we return here, POSITION has been advanced
across the text with this property. */
- return 0;
+ {
+ /* Synchronize the bidi iterator with POSITION. This is
+ needed because we are not going to push the iterator
+ on behalf of this display property, so there will be
+ no pop_it call to do this synchronization for us. */
+ if (it->bidi_p)
+ {
+ it->position = *position;
+ iterate_out_of_display_property (it);
+ *position = it->position;
+ }
+ return 1;
+ }
}
else if (!frame_window_p)
- return 0;
+ return 1;
#ifdef HAVE_WINDOW_SYSTEM
value = XCAR (XCDR (spec));
@@ -4670,7 +4861,15 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
|| !(fringe_bitmap = lookup_fringe_bitmap (value)))
/* If we return here, POSITION has been advanced
across the text with this property. */
- return 0;
+ {
+ if (it && it->bidi_p)
+ {
+ it->position = *position;
+ iterate_out_of_display_property (it);
+ *position = it->position;
+ }
+ return 1;
+ }
if (it)
{
@@ -4865,7 +5064,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
int
display_prop_intangible_p (Lisp_Object prop, Lisp_Object overlay,
- EMACS_INT charpos, EMACS_INT bytepos)
+ ptrdiff_t charpos, ptrdiff_t bytepos)
{
int frame_window_p = FRAME_WINDOW_P (XFRAME (selected_frame));
struct text_pos position;
@@ -4946,7 +5145,7 @@ display_prop_string_p (Lisp_Object prop, Lisp_Object string)
else if (VECTORP (prop))
{
/* A vector of sub-properties. */
- int i;
+ ptrdiff_t i;
for (i = 0; i < ASIZE (prop); ++i)
if (single_display_spec_string_p (AREF (prop, i), string))
return 1;
@@ -4967,14 +5166,14 @@ display_prop_string_p (Lisp_Object prop, Lisp_Object string)
This function may only use code that doesn't eval because it is
called asynchronously from note_mouse_highlight. */
-static EMACS_INT
+static ptrdiff_t
string_buffer_position_lim (Lisp_Object string,
- EMACS_INT from, EMACS_INT to, int back_p)
+ ptrdiff_t from, ptrdiff_t to, int back_p)
{
Lisp_Object limit, prop, pos;
int found = 0;
- pos = make_number (from);
+ pos = make_number (max (from, BEGV));
if (!back_p) /* looking forward */
{
@@ -5015,11 +5214,11 @@ string_buffer_position_lim (Lisp_Object string,
This function may only use code that doesn't eval because it is
called asynchronously from note_mouse_highlight. */
-static EMACS_INT
-string_buffer_position (Lisp_Object string, EMACS_INT around_charpos)
+static ptrdiff_t
+string_buffer_position (Lisp_Object string, ptrdiff_t around_charpos)
{
const int MAX_DISTANCE = 1000;
- EMACS_INT found = string_buffer_position_lim (string, around_charpos,
+ ptrdiff_t found = string_buffer_position_lim (string, around_charpos,
around_charpos + MAX_DISTANCE,
0);
@@ -5042,7 +5241,7 @@ static enum prop_handled
handle_composition_prop (struct it *it)
{
Lisp_Object prop, string;
- EMACS_INT pos, pos_byte, start, end;
+ ptrdiff_t pos, pos_byte, start, end;
if (STRINGP (it->string))
{
@@ -5108,7 +5307,7 @@ struct overlay_entry
{
Lisp_Object overlay;
Lisp_Object string;
- int priority;
+ EMACS_INT priority;
int after_string_p;
};
@@ -5145,7 +5344,7 @@ next_overlay_string (struct it *it)
it->ellipsis_p = (it->stack[it->sp - 1].display_ellipsis_p != 0);
pop_it (it);
- xassert (it->sp > 0
+ eassert (it->sp > 0
|| (NILP (it->string)
&& it->method == GET_FROM_BUFFER
&& it->stop_charpos >= BEGV
@@ -5153,6 +5352,12 @@ next_overlay_string (struct it *it)
it->current.overlay_string_index = -1;
it->n_overlay_strings = 0;
it->overlay_strings_charpos = -1;
+ /* If there's an empty display string on the stack, pop the
+ stack, to resync the bidi iterator with IT's position. Such
+ empty strings are pushed onto the stack in
+ get_overlay_strings_1. */
+ if (it->sp > 0 && STRINGP (it->string) && !SCHARS (it->string))
+ pop_it (it);
/* If we're at the end of the buffer, record that we have
processed the overlay strings there already, so that
@@ -5180,6 +5385,7 @@ next_overlay_string (struct it *it)
SET_TEXT_POS (it->current.string_pos, 0, 0);
it->method = GET_FROM_STRING;
it->stop_charpos = 0;
+ it->end_charpos = SCHARS (it->string);
if (it->cmp_it.stop_pos >= 0)
it->cmp_it.stop_pos = 0;
it->prev_stop = 0;
@@ -5234,12 +5440,17 @@ compare_overlay_entries (const void *e1, const void *e2)
else
result = entry1->after_string_p ? -1 : 1;
}
- else if (entry1->after_string_p)
- /* After-strings sorted in order of decreasing priority. */
- result = entry2->priority - entry1->priority;
+ else if (entry1->priority != entry2->priority)
+ {
+ if (entry1->after_string_p)
+ /* After-strings sorted in order of decreasing priority. */
+ result = entry2->priority < entry1->priority ? -1 : 1;
+ else
+ /* Before-strings sorted in order of increasing priority. */
+ result = entry1->priority < entry2->priority ? -1 : 1;
+ }
else
- /* Before-strings sorted in order of increasing priority. */
- result = entry1->priority - entry2->priority;
+ result = 0;
return result;
}
@@ -5270,15 +5481,16 @@ compare_overlay_entries (const void *e1, const void *e2)
compare_overlay_entries. */
static void
-load_overlay_strings (struct it *it, EMACS_INT charpos)
+load_overlay_strings (struct it *it, ptrdiff_t charpos)
{
Lisp_Object overlay, window, str, invisible;
struct Lisp_Overlay *ov;
- EMACS_INT start, end;
- int size = 20;
- int n = 0, i, j, invis_p;
- struct overlay_entry *entries
- = (struct overlay_entry *) alloca (size * sizeof *entries);
+ ptrdiff_t start, end;
+ ptrdiff_t size = 20;
+ ptrdiff_t n = 0, i, j;
+ int invis_p;
+ struct overlay_entry *entries = alloca (size * sizeof *entries);
+ USE_SAFE_ALLOCA;
if (charpos <= 0)
charpos = IT_CHARPOS (*it);
@@ -5294,13 +5506,10 @@ load_overlay_strings (struct it *it, EMACS_INT charpos)
\
if (n == size) \
{ \
- int new_size = 2 * size; \
struct overlay_entry *old = entries; \
- entries = \
- (struct overlay_entry *) alloca (new_size \
- * sizeof *entries); \
+ SAFE_NALLOCA (entries, 2, size); \
memcpy (entries, old, size * sizeof *entries); \
- size = new_size; \
+ size *= 2; \
} \
\
entries[n].string = (STRING); \
@@ -5316,7 +5525,7 @@ load_overlay_strings (struct it *it, EMACS_INT charpos)
for (ov = current_buffer->overlays_before; ov; ov = ov->next)
{
XSETMISC (overlay, ov);
- xassert (OVERLAYP (overlay));
+ eassert (OVERLAYP (overlay));
start = OVERLAY_POSITION (OVERLAY_START (overlay));
end = OVERLAY_POSITION (OVERLAY_END (overlay));
@@ -5356,7 +5565,7 @@ load_overlay_strings (struct it *it, EMACS_INT charpos)
for (ov = current_buffer->overlays_after; ov; ov = ov->next)
{
XSETMISC (overlay, ov);
- xassert (OVERLAYP (overlay));
+ eassert (OVERLAYP (overlay));
start = OVERLAY_POSITION (OVERLAY_START (overlay));
end = OVERLAY_POSITION (OVERLAY_END (overlay));
@@ -5413,6 +5622,7 @@ load_overlay_strings (struct it *it, EMACS_INT charpos)
}
CHECK_IT (it);
+ SAFE_FREE ();
}
@@ -5421,7 +5631,7 @@ load_overlay_strings (struct it *it, EMACS_INT charpos)
least one overlay string was found. */
static int
-get_overlay_strings_1 (struct it *it, EMACS_INT charpos, int compute_stop_p)
+get_overlay_strings_1 (struct it *it, ptrdiff_t charpos, int compute_stop_p)
{
/* Get the first OVERLAY_STRING_CHUNK_SIZE overlay strings to
process. This fills IT->overlay_strings with strings, and sets
@@ -5443,15 +5653,22 @@ get_overlay_strings_1 (struct it *it, EMACS_INT charpos, int compute_stop_p)
strings. */
if (compute_stop_p)
compute_stop_pos (it);
- xassert (it->face_id >= 0);
+ eassert (it->face_id >= 0);
/* Save IT's settings. They are restored after all overlay
strings have been processed. */
- xassert (!compute_stop_p || it->sp == 0);
+ eassert (!compute_stop_p || it->sp == 0);
/* When called from handle_stop, there might be an empty display
- string loaded. In that case, don't bother saving it. */
- if (!STRINGP (it->string) || SCHARS (it->string))
+ string loaded. In that case, don't bother saving it. But
+ don't use this optimization with the bidi iterator, since we
+ need the corresponding pop_it call to resync the bidi
+ iterator's position with IT's position, after we are done
+ with the overlay strings. (The corresponding call to pop_it
+ in case of an empty display string is in
+ next_overlay_string.) */
+ if (!(!it->bidi_p
+ && STRINGP (it->string) && !SCHARS (it->string)))
push_it (it, NULL);
/* Set up IT to deliver display elements from the first overlay
@@ -5460,7 +5677,7 @@ get_overlay_strings_1 (struct it *it, EMACS_INT charpos, int compute_stop_p)
it->string = it->overlay_strings[0];
it->from_overlay = Qnil;
it->stop_charpos = 0;
- xassert (STRINGP (it->string));
+ eassert (STRINGP (it->string));
it->end_charpos = SCHARS (it->string);
it->prev_stop = 0;
it->base_level_stop = 0;
@@ -5478,7 +5695,7 @@ get_overlay_strings_1 (struct it *it, EMACS_INT charpos, int compute_stop_p)
/* Set up the bidi iterator for this overlay string. */
if (it->bidi_p)
{
- EMACS_INT pos = (charpos > 0 ? charpos : IT_CHARPOS (*it));
+ ptrdiff_t pos = (charpos > 0 ? charpos : IT_CHARPOS (*it));
it->bidi_it.string.lstring = it->string;
it->bidi_it.string.s = NULL;
@@ -5496,7 +5713,7 @@ get_overlay_strings_1 (struct it *it, EMACS_INT charpos, int compute_stop_p)
}
static int
-get_overlay_strings (struct it *it, EMACS_INT charpos)
+get_overlay_strings (struct it *it, ptrdiff_t charpos)
{
it->string = Qnil;
it->method = GET_FROM_BUFFER;
@@ -5526,14 +5743,14 @@ push_it (struct it *it, struct text_pos *position)
{
struct iterator_stack_entry *p;
- xassert (it->sp < IT_STACK_SIZE);
+ eassert (it->sp < IT_STACK_SIZE);
p = it->stack + it->sp;
p->stop_charpos = it->stop_charpos;
p->prev_stop = it->prev_stop;
p->base_level_stop = it->base_level_stop;
p->cmp_it = it->cmp_it;
- xassert (it->face_id >= 0);
+ eassert (it->face_id >= 0);
p->face_id = it->face_id;
p->string = it->string;
p->method = it->method;
@@ -5560,6 +5777,7 @@ push_it (struct it *it, struct text_pos *position)
p->font_height = it->font_height;
p->voffset = it->voffset;
p->string_from_display_prop_p = it->string_from_display_prop_p;
+ p->string_from_prefix_prop_p = it->string_from_prefix_prop_p;
p->display_ellipsis_p = 0;
p->line_wrap = it->line_wrap;
p->bidi_p = it->bidi_p;
@@ -5575,11 +5793,11 @@ push_it (struct it *it, struct text_pos *position)
static void
iterate_out_of_display_property (struct it *it)
{
- int buffer_p = BUFFERP (it->object);
- EMACS_INT eob = (buffer_p ? ZV : it->end_charpos);
- EMACS_INT bob = (buffer_p ? BEGV : 0);
+ int buffer_p = !STRINGP (it->string);
+ ptrdiff_t eob = (buffer_p ? ZV : it->end_charpos);
+ ptrdiff_t bob = (buffer_p ? BEGV : 0);
- xassert (eob >= CHARPOS (it->position) && CHARPOS (it->position) >= bob);
+ eassert (eob >= CHARPOS (it->position) && CHARPOS (it->position) >= bob);
/* Maybe initialize paragraph direction. If we are at the beginning
of a new paragraph, next_element_from_buffer may not have a
@@ -5618,7 +5836,7 @@ pop_it (struct it *it)
struct iterator_stack_entry *p;
int from_display_prop = it->from_disp_prop_p;
- xassert (it->sp > 0);
+ eassert (it->sp > 0);
--it->sp;
p = it->stack + it->sp;
it->stop_charpos = p->stop_charpos;
@@ -5669,6 +5887,7 @@ pop_it (struct it *it)
it->font_height = p->font_height;
it->voffset = p->voffset;
it->string_from_display_prop_p = p->string_from_display_prop_p;
+ it->string_from_prefix_prop_p = p->string_from_prefix_prop_p;
it->line_wrap = p->line_wrap;
it->bidi_p = p->bidi_p;
it->paragraph_embedding = p->paragraph_embedding;
@@ -5687,7 +5906,7 @@ pop_it (struct it *it)
&& (it->method == GET_FROM_BUFFER || it->method == GET_FROM_STRING))
iterate_out_of_display_property (it);
- xassert ((BUFFERP (it->object)
+ eassert ((BUFFERP (it->object)
&& IT_CHARPOS (*it) == it->bidi_it.charpos
&& IT_BYTEPOS (*it) == it->bidi_it.bytepos)
|| (STRINGP (it->object)
@@ -5738,7 +5957,7 @@ static int
forward_to_next_line_start (struct it *it, int *skipped_p,
struct bidi_it *bidi_it_prev)
{
- EMACS_INT old_selective;
+ ptrdiff_t old_selective;
int newline_found_p, n;
const int MAX_NEWLINE_DISTANCE = 500;
@@ -5780,11 +5999,11 @@ forward_to_next_line_start (struct it *it, int *skipped_p,
short-cut. */
if (!newline_found_p)
{
- EMACS_INT start = IT_CHARPOS (*it);
- EMACS_INT limit = find_next_newline_no_quit (start, 1);
+ ptrdiff_t start = IT_CHARPOS (*it);
+ ptrdiff_t limit = find_next_newline_no_quit (start, 1);
Lisp_Object pos;
- xassert (!STRINGP (it->string));
+ eassert (!STRINGP (it->string));
/* If there isn't any `display' property in sight, and no
overlays, we can just use the position of the newline in
@@ -5868,7 +6087,7 @@ back_to_previous_visible_line_start (struct it *it)
{
Lisp_Object prop;
prop = Fget_char_property (make_number (IT_CHARPOS (*it) - 1),
- Qinvisible, it->window);
+ Qinvisible, it->window);
if (TEXT_PROP_MEANS_INVISIBLE (prop))
continue;
}
@@ -5879,8 +6098,8 @@ back_to_previous_visible_line_start (struct it *it)
{
struct it it2;
void *it2data = NULL;
- EMACS_INT pos;
- EMACS_INT beg, end;
+ ptrdiff_t pos;
+ ptrdiff_t beg, end;
Lisp_Object val, overlay;
SAVE_IT (it2, *it, it2data);
@@ -5923,8 +6142,8 @@ back_to_previous_visible_line_start (struct it *it)
it->continuation_lines_width = 0;
- xassert (IT_CHARPOS (*it) >= BEGV);
- xassert (IT_CHARPOS (*it) == BEGV
+ eassert (IT_CHARPOS (*it) >= BEGV);
+ eassert (IT_CHARPOS (*it) == BEGV
|| FETCH_BYTE (IT_BYTEPOS (*it) - 1) == '\n');
CHECK_IT (it);
}
@@ -5966,7 +6185,7 @@ reseat_at_next_visible_line_start (struct it *it, int on_newline_p)
&& indented_beyond_p (IT_CHARPOS (*it), IT_BYTEPOS (*it),
it->selective))
{
- xassert (IT_BYTEPOS (*it) == BEGV
+ eassert (IT_BYTEPOS (*it) == BEGV
|| FETCH_BYTE (IT_BYTEPOS (*it) - 1) == '\n');
newline_found_p =
forward_to_next_line_start (it, &skipped_p, &bidi_it_prev);
@@ -6033,7 +6252,7 @@ reseat_at_next_visible_line_start (struct it *it, int on_newline_p)
static void
reseat (struct it *it, struct text_pos pos, int force_p)
{
- EMACS_INT original_pos = IT_CHARPOS (*it);
+ ptrdiff_t original_pos = IT_CHARPOS (*it);
reseat_1 (it, pos, 0);
@@ -6080,10 +6299,10 @@ static void
reseat_1 (struct it *it, struct text_pos pos, int set_stop_p)
{
/* Don't call this function when scanning a C string. */
- xassert (it->s == NULL);
+ eassert (it->s == NULL);
/* POS must be a reasonable value. */
- xassert (CHARPOS (pos) >= BEGV && CHARPOS (pos) <= ZV);
+ eassert (CHARPOS (pos) >= BEGV && CHARPOS (pos) <= ZV);
it->current.pos = it->position = pos;
it->end_charpos = ZV;
@@ -6099,6 +6318,8 @@ reseat_1 (struct it *it, struct text_pos pos, int set_stop_p)
it->multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters));
it->sp = 0;
it->string_from_display_prop_p = 0;
+ it->string_from_prefix_prop_p = 0;
+
it->from_disp_prop_p = 0;
it->face_before_selective_p = 0;
if (it->bidi_p)
@@ -6118,6 +6339,8 @@ reseat_1 (struct it *it, struct text_pos pos, int set_stop_p)
it->stop_charpos = CHARPOS (pos);
it->base_level_stop = CHARPOS (pos);
}
+ /* This make the information stored in it->cmp_it invalidate. */
+ it->cmp_it.id = -1;
}
@@ -6141,7 +6364,7 @@ reseat_1 (struct it *it, struct text_pos pos, int set_stop_p)
static void
reseat_to_string (struct it *it, const char *s, Lisp_Object string,
- EMACS_INT charpos, EMACS_INT precision, int field_width,
+ ptrdiff_t charpos, ptrdiff_t precision, int field_width,
int multibyte)
{
/* No region in strings. */
@@ -6154,7 +6377,7 @@ reseat_to_string (struct it *it, const char *s, Lisp_Object string,
memset (&it->current, 0, sizeof it->current);
it->current.overlay_string_index = -1;
it->current.dpvec_index = -1;
- xassert (charpos >= 0);
+ eassert (charpos >= 0);
/* If STRING is specified, use its multibyteness, otherwise use the
setting of MULTIBYTE, if specified. */
@@ -6171,7 +6394,7 @@ reseat_to_string (struct it *it, const char *s, Lisp_Object string,
if (s == NULL)
{
- xassert (STRINGP (string));
+ eassert (STRINGP (string));
it->string = string;
it->s = NULL;
it->end_charpos = it->string_nchars = SCHARS (string);
@@ -6259,7 +6482,7 @@ reseat_to_string (struct it *it, const char *s, Lisp_Object string,
}
if (s == NULL && it->multibyte_p)
{
- EMACS_INT endpos = SCHARS (it->string);
+ ptrdiff_t endpos = SCHARS (it->string);
if (endpos > it->end_charpos)
endpos = it->end_charpos;
composition_compute_stop_pos (&it->cmp_it, charpos, -1, endpos,
@@ -6367,11 +6590,11 @@ lookup_glyphless_char_display (int c, struct it *it)
end of buffer (or C string) is reached. */
static struct frame *last_escape_glyph_frame = NULL;
-static unsigned last_escape_glyph_face_id = (1 << FACE_ID_BITS);
+static int last_escape_glyph_face_id = (1 << FACE_ID_BITS);
static int last_escape_glyph_merged_face_id = 0;
struct frame *last_glyphless_glyph_frame = NULL;
-unsigned last_glyphless_glyph_face_id = (1 << FACE_ID_BITS);
+int last_glyphless_glyph_face_id = (1 << FACE_ID_BITS);
int last_glyphless_glyph_merged_face_id = 0;
static int
@@ -6414,7 +6637,7 @@ get_next_display_element (struct it *it)
if (! it->multibyte_p && ! ASCII_CHAR_P (c))
{
- xassert (SINGLE_BYTE_CHAR_P (c));
+ eassert (SINGLE_BYTE_CHAR_P (c));
if (unibyte_display_via_language_environment)
{
c = DECODE_CHAR (unibyte, c);
@@ -6503,7 +6726,7 @@ get_next_display_element (struct it *it)
Lisp_Object gc;
int ctl_len;
int face_id;
- EMACS_INT lface_id = 0;
+ int lface_id = 0;
int escape_glyph;
/* Handle control characters with ^. */
@@ -6515,8 +6738,7 @@ get_next_display_element (struct it *it)
g = '^'; /* default glyph for Control */
/* Set IT->ctl_chars[0] to the glyph for `^'. */
if (it->dp
- && (gc = DISP_CTRL_GLYPH (it->dp), GLYPH_CODE_P (gc))
- && GLYPH_CODE_CHAR_VALID_P (gc))
+ && (gc = DISP_CTRL_GLYPH (it->dp), GLYPH_CODE_P (gc)))
{
g = GLYPH_CODE_CHAR (gc);
lface_id = GLYPH_CODE_FACE (gc);
@@ -6565,8 +6787,7 @@ get_next_display_element (struct it *it)
escape_glyph = '\\';
if (it->dp
- && (gc = DISP_ESCAPE_GLYPH (it->dp), GLYPH_CODE_P (gc))
- && GLYPH_CODE_CHAR_VALID_P (gc))
+ && (gc = DISP_ESCAPE_GLYPH (it->dp), GLYPH_CODE_P (gc)))
{
escape_glyph = GLYPH_CODE_CHAR (gc);
lface_id = GLYPH_CODE_FACE (gc);
@@ -6665,7 +6886,7 @@ get_next_display_element (struct it *it)
}
else
{
- EMACS_INT pos = (it->s ? -1
+ ptrdiff_t pos = (it->s ? -1
: STRINGP (it->string) ? IT_STRING_CHARPOS (*it)
: IT_CHARPOS (*it));
int c;
@@ -6717,7 +6938,7 @@ get_next_display_element (struct it *it)
&& (it->current.overlay_string_index
== it->n_overlay_strings - 1))
{
- EMACS_INT ignore;
+ ptrdiff_t ignore;
int next_face_id;
struct text_pos pos = it->current.pos;
INC_TEXT_POS (pos, it->multibyte_p);
@@ -6741,6 +6962,16 @@ get_next_display_element (struct it *it)
&& FACE_FROM_ID (it->f, face_id)->box == FACE_NO_BOX);
}
}
+ /* If we reached the end of the object we've been iterating (e.g., a
+ display string or an overlay string), and there's something on
+ IT->stack, proceed with what's on the stack. It doesn't make
+ sense to return zero if there's unprocessed stuff on the stack,
+ because otherwise that stuff will never be displayed. */
+ if (!success_p && it->sp > 0)
+ {
+ set_iterator_to_next (it, 0);
+ success_p = get_next_display_element (it);
+ }
/* Value is 0 if end of buffer or string reached. */
return success_p;
@@ -6819,7 +7050,7 @@ set_iterator_to_next (struct it *it, int reseat_p)
{
/* No more grapheme clusters in this composition.
Find the next stop position. */
- EMACS_INT stop = it->end_charpos;
+ ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
/* Now we are scanning backward and don't know
where to stop. */
@@ -6847,7 +7078,7 @@ set_iterator_to_next (struct it *it, int reseat_p)
{
/* No more grapheme clusters in this composition.
Find the next stop position. */
- EMACS_INT stop = it->end_charpos;
+ ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
/* Now we are scanning backward and don't know
where to stop. */
@@ -6859,7 +7090,7 @@ set_iterator_to_next (struct it *it, int reseat_p)
}
else
{
- xassert (it->len != 0);
+ eassert (it->len != 0);
if (!it->bidi_p)
{
@@ -6880,14 +7111,14 @@ set_iterator_to_next (struct it *it, int reseat_p)
{
/* As the scan direction was changed, we must
re-compute the stop position for composition. */
- EMACS_INT stop = it->end_charpos;
+ ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
stop = -1;
composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it),
IT_BYTEPOS (*it), stop, Qnil);
}
}
- xassert (IT_BYTEPOS (*it) == CHAR_TO_BYTE (IT_CHARPOS (*it)));
+ eassert (IT_BYTEPOS (*it) == CHAR_TO_BYTE (IT_CHARPOS (*it)));
}
break;
@@ -6922,7 +7153,7 @@ set_iterator_to_next (struct it *it, int reseat_p)
display vector entry (these entries may contain faces). */
it->face_id = it->saved_face_id;
- if (it->dpvec + it->current.dpvec_index == it->dpend)
+ if (it->dpvec + it->current.dpvec_index >= it->dpend)
{
int recheck_faces = it->ellipsis_p;
@@ -6959,7 +7190,27 @@ set_iterator_to_next (struct it *it, int reseat_p)
case GET_FROM_STRING:
/* Current display element is a character from a Lisp string. */
- xassert (it->s == NULL && STRINGP (it->string));
+ eassert (it->s == NULL && STRINGP (it->string));
+ /* Don't advance past string end. These conditions are true
+ when set_iterator_to_next is called at the end of
+ get_next_display_element, in which case the Lisp string is
+ already exhausted, and all we want is pop the iterator
+ stack. */
+ if (it->current.overlay_string_index >= 0)
+ {
+ /* This is an overlay string, so there's no padding with
+ spaces, and the number of characters in the string is
+ where the string ends. */
+ if (IT_STRING_CHARPOS (*it) >= SCHARS (it->string))
+ goto consider_string_end;
+ }
+ else
+ {
+ /* Not an overlay string. There could be padding, so test
+ against it->end_charpos . */
+ if (IT_STRING_CHARPOS (*it) >= it->end_charpos)
+ goto consider_string_end;
+ }
if (it->cmp_it.id >= 0)
{
int i;
@@ -6990,7 +7241,7 @@ set_iterator_to_next (struct it *it, int reseat_p)
it->cmp_it.from = it->cmp_it.to;
else
{
- EMACS_INT stop = it->end_charpos;
+ ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
stop = -1;
composition_compute_stop_pos (&it->cmp_it,
@@ -7009,7 +7260,7 @@ set_iterator_to_next (struct it *it, int reseat_p)
it->cmp_it.to = it->cmp_it.from;
else
{
- EMACS_INT stop = it->end_charpos;
+ ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
stop = -1;
composition_compute_stop_pos (&it->cmp_it,
@@ -7041,7 +7292,7 @@ set_iterator_to_next (struct it *it, int reseat_p)
IT_STRING_CHARPOS (*it) = it->bidi_it.charpos;
if (prev_scan_dir != it->bidi_it.scan_dir)
{
- EMACS_INT stop = it->end_charpos;
+ ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
stop = -1;
@@ -7088,7 +7339,7 @@ set_iterator_to_next (struct it *it, int reseat_p)
/* The position etc with which we have to proceed are on
the stack. The position may be at the end of a string,
if the `display' property takes up the whole string. */
- xassert (it->sp > 0);
+ eassert (it->sp > 0);
pop_it (it);
if (it->method == GET_FROM_STRING)
goto consider_string_end;
@@ -7096,10 +7347,10 @@ set_iterator_to_next (struct it *it, int reseat_p)
default:
/* There are no other methods defined, so this should be a bug. */
- abort ();
+ emacs_abort ();
}
- xassert (it->method != GET_FROM_STRING
+ eassert (it->method != GET_FROM_STRING
|| (STRINGP (it->string)
&& IT_STRING_CHARPOS (*it) >= 0));
}
@@ -7119,7 +7370,7 @@ next_element_from_display_vector (struct it *it)
Lisp_Object gc;
/* Precondition. */
- xassert (it->dpvec && it->current.dpvec_index >= 0);
+ eassert (it->dpvec && it->current.dpvec_index >= 0);
it->face_id = it->saved_face_id;
@@ -7127,7 +7378,7 @@ next_element_from_display_vector (struct it *it)
That seemed totally bogus - so I changed it... */
gc = it->dpvec[it->current.dpvec_index];
- if (GLYPH_CODE_P (gc) && GLYPH_CODE_CHAR_VALID_P (gc))
+ if (GLYPH_CODE_P (gc))
{
it->c = GLYPH_CODE_CHAR (gc);
it->len = CHAR_BYTES (it->c);
@@ -7139,7 +7390,7 @@ next_element_from_display_vector (struct it *it)
it->face_id = it->dpvec_face_id;
else
{
- EMACS_INT lface_id = GLYPH_CODE_FACE (gc);
+ int lface_id = GLYPH_CODE_FACE (gc);
if (lface_id > 0)
it->face_id = merge_faces (it->f, Qt, lface_id,
it->saved_face_id);
@@ -7162,8 +7413,8 @@ static void
get_visually_first_element (struct it *it)
{
int string_p = STRINGP (it->string) || it->s;
- EMACS_INT eob = (string_p ? it->bidi_it.string.schars : ZV);
- EMACS_INT bob = (string_p ? 0 : BEGV);
+ ptrdiff_t eob = (string_p ? it->bidi_it.string.schars : ZV);
+ ptrdiff_t bob = (string_p ? 0 : BEGV);
if (STRINGP (it->string))
{
@@ -7195,7 +7446,7 @@ get_visually_first_element (struct it *it)
}
else
{
- EMACS_INT orig_bytepos = it->bidi_it.bytepos;
+ ptrdiff_t orig_bytepos = it->bidi_it.bytepos;
/* We need to prime the bidi iterator starting at the line's or
string's beginning, before we will be able to produce the
@@ -7233,11 +7484,11 @@ get_visually_first_element (struct it *it)
if (STRINGP (it->string) || !it->s)
{
- EMACS_INT stop, charpos, bytepos;
+ ptrdiff_t stop, charpos, bytepos;
if (STRINGP (it->string))
{
- xassert (!it->s);
+ eassert (!it->s);
stop = SCHARS (it->string);
if (stop > it->end_charpos)
stop = it->end_charpos;
@@ -7267,9 +7518,9 @@ next_element_from_string (struct it *it)
{
struct text_pos position;
- xassert (STRINGP (it->string));
- xassert (!it->bidi_p || EQ (it->string, it->bidi_it.string.lstring));
- xassert (IT_STRING_CHARPOS (*it) >= 0);
+ eassert (STRINGP (it->string));
+ eassert (!it->bidi_p || EQ (it->string, it->bidi_it.string.lstring));
+ eassert (IT_STRING_CHARPOS (*it) >= 0);
position = it->current.string_pos;
/* With bidi reordering, the character to display might not be the
@@ -7346,7 +7597,7 @@ next_element_from_string (struct it *it)
if (it->current.overlay_string_index >= 0)
{
/* Get the next character from an overlay string. In overlay
- strings, There is no field width or padding with spaces to
+ strings, there is no field width or padding with spaces to
do. */
if (IT_STRING_CHARPOS (*it) >= SCHARS (it->string))
{
@@ -7433,8 +7684,8 @@ next_element_from_c_string (struct it *it)
{
int success_p = 1;
- xassert (it->s);
- xassert (!it->bidi_p || it->s == it->bidi_it.string.s);
+ eassert (it->s);
+ eassert (!it->bidi_p || it->s == it->bidi_it.string.s);
it->what = IT_CHARACTER;
BYTEPOS (it->position) = CHARPOS (it->position) = 0;
it->object = Qnil;
@@ -7534,24 +7785,24 @@ compute_stop_pos_backwards (struct it *it)
struct text_pos pos;
struct display_pos save_current = it->current;
struct text_pos save_position = it->position;
- EMACS_INT charpos = IT_CHARPOS (*it);
- EMACS_INT where_we_are = charpos;
- EMACS_INT save_stop_pos = it->stop_charpos;
- EMACS_INT save_end_pos = it->end_charpos;
+ ptrdiff_t charpos = IT_CHARPOS (*it);
+ ptrdiff_t where_we_are = charpos;
+ ptrdiff_t save_stop_pos = it->stop_charpos;
+ ptrdiff_t save_end_pos = it->end_charpos;
- xassert (NILP (it->string) && !it->s);
- xassert (it->bidi_p);
+ eassert (NILP (it->string) && !it->s);
+ eassert (it->bidi_p);
it->bidi_p = 0;
do
{
it->end_charpos = min (charpos + 1, ZV);
charpos = max (charpos - SCAN_BACK_LIMIT, BEGV);
- SET_TEXT_POS (pos, charpos, BYTE_TO_CHAR (charpos));
+ SET_TEXT_POS (pos, charpos, CHAR_TO_BYTE (charpos));
reseat_1 (it, pos, 0);
compute_stop_pos (it);
/* We must advance forward, right? */
if (it->stop_charpos <= charpos)
- abort ();
+ emacs_abort ();
}
while (charpos > BEGV && it->stop_charpos >= it->end_charpos);
@@ -7575,17 +7826,17 @@ compute_stop_pos_backwards (struct it *it)
position. */
static void
-handle_stop_backwards (struct it *it, EMACS_INT charpos)
+handle_stop_backwards (struct it *it, ptrdiff_t charpos)
{
int bufp = !STRINGP (it->string);
- EMACS_INT where_we_are = (bufp ? IT_CHARPOS (*it) : IT_STRING_CHARPOS (*it));
+ ptrdiff_t where_we_are = (bufp ? IT_CHARPOS (*it) : IT_STRING_CHARPOS (*it));
struct display_pos save_current = it->current;
struct text_pos save_position = it->position;
struct text_pos pos1;
- EMACS_INT next_stop;
+ ptrdiff_t next_stop;
/* Scan in strict logical order. */
- xassert (it->bidi_p);
+ eassert (it->bidi_p);
it->bidi_p = 0;
do
{
@@ -7600,7 +7851,7 @@ handle_stop_backwards (struct it *it, EMACS_INT charpos)
compute_stop_pos (it);
/* We must advance forward, right? */
if (it->stop_charpos <= it->prev_stop)
- abort ();
+ emacs_abort ();
charpos = it->stop_charpos;
}
while (charpos <= where_we_are);
@@ -7624,9 +7875,9 @@ next_element_from_buffer (struct it *it)
{
int success_p = 1;
- xassert (IT_CHARPOS (*it) >= BEGV);
- xassert (NILP (it->string) && !it->s);
- xassert (!it->bidi_p
+ eassert (IT_CHARPOS (*it) >= BEGV);
+ eassert (NILP (it->string) && !it->s);
+ eassert (!it->bidi_p
|| (EQ (it->bidi_it.string.lstring, Qnil)
&& it->bidi_it.string.s == NULL));
@@ -7726,7 +7977,7 @@ next_element_from_buffer (struct it *it)
/* No face changes, overlays etc. in sight, so just return a
character from current_buffer. */
unsigned char *p;
- EMACS_INT stop;
+ ptrdiff_t stop;
/* Maybe run the redisplay end trigger hook. Performance note:
This doesn't seem to cost measurable time. */
@@ -7785,7 +8036,7 @@ next_element_from_buffer (struct it *it)
}
/* Value is zero if end of buffer reached. */
- xassert (!success_p || it->what != IT_CHARACTER || it->len > 0);
+ eassert (!success_p || it->what != IT_CHARACTER || it->len > 0);
return success_p;
}
@@ -7799,7 +8050,7 @@ run_redisplay_end_trigger_hook (struct it *it)
/* IT->glyph_row should be non-null, i.e. we should be actually
displaying something, or otherwise we should not run the hook. */
- xassert (it->glyph_row);
+ eassert (it->glyph_row);
/* Set up hook arguments. */
args[0] = Qredisplay_end_trigger_functions;
@@ -7809,7 +8060,7 @@ run_redisplay_end_trigger_hook (struct it *it)
/* Since we are *trying* to run these functions, don't try to run
them again, even if they get an error. */
- it->w->redisplay_end_trigger = Qnil;
+ wset_redisplay_end_trigger (it->w, Qnil);
Frun_hook_with_args (3, args);
/* Notice if it changed the face of the character we are on. */
@@ -7915,7 +8166,7 @@ next_element_from_composition (struct it *it)
static enum move_it_result
move_it_in_display_line_to (struct it *it,
- EMACS_INT to_charpos, int to_x,
+ ptrdiff_t to_charpos, int to_x,
enum move_operation_enum op)
{
enum move_it_result result = MOVE_UNDEFINED;
@@ -7925,7 +8176,7 @@ move_it_in_display_line_to (struct it *it,
void *ppos_data = NULL;
int may_wrap = 0;
enum it_method prev_method = it->method;
- EMACS_INT prev_pos = IT_CHARPOS (*it);
+ ptrdiff_t prev_pos = IT_CHARPOS (*it);
int saw_smaller_pos = prev_pos < to_charpos;
/* Don't produce glyphs in produce_glyphs. */
@@ -8167,7 +8418,10 @@ move_it_in_display_line_to (struct it *it,
/* Or it fits exactly and we're on a window
system frame. */
|| (new_x == it->last_visible_x
- && FRAME_WINDOW_P (it->f))))
+ && FRAME_WINDOW_P (it->f)
+ && ((it->bidi_p && it->bidi_it.paragraph_dir == R2L)
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))))
{
if (/* IT->hpos == 0 means the very first glyph
doesn't fit on the line, e.g. a wide image. */
@@ -8214,10 +8468,15 @@ move_it_in_display_line_to (struct it *it,
/* On graphical terminals, newlines may
"overflow" into the fringe if
overflow-newline-into-fringe is non-nil.
- On text-only terminals, newlines may
- overflow into the last glyph on the
+ On text terminals, and on graphical
+ terminals with no right margin, newlines
+ may overflow into the last glyph on the
display line.*/
if (!FRAME_WINDOW_P (it->f)
+ || ((it->bidi_p
+ && it->bidi_it.paragraph_dir == R2L)
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)) == 0
|| IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
{
if (!get_next_display_element (it))
@@ -8292,7 +8551,7 @@ move_it_in_display_line_to (struct it *it,
necessary here because of lines consisting of a line end,
only. The line end will not produce any glyphs and we
would never get MOVE_X_REACHED. */
- xassert (it->nglyphs == 0);
+ eassert (it->nglyphs == 0);
result = MOVE_X_REACHED;
break;
}
@@ -8349,6 +8608,9 @@ move_it_in_display_line_to (struct it *it,
&& it->current_x >= it->last_visible_x)
{
if (!FRAME_WINDOW_P (it->f)
+ || ((it->bidi_p && it->bidi_it.paragraph_dir == R2L)
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)) == 0
|| IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
{
int at_eob_p = 0;
@@ -8419,7 +8681,7 @@ move_it_in_display_line_to (struct it *it,
/* For external use. */
void
move_it_in_display_line (struct it *it,
- EMACS_INT to_charpos, int to_x,
+ ptrdiff_t to_charpos, int to_x,
enum move_operation_enum op)
{
if (it->line_wrap == WORD_WRAP
@@ -8462,7 +8724,7 @@ move_it_in_display_line (struct it *it,
displayed to the right of TO_CHARPOS on the screen. */
void
-move_it_to (struct it *it, EMACS_INT to_charpos, int to_x, int to_y, int to_vpos, int op)
+move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos, int op)
{
enum move_it_result skip, skip2 = MOVE_X_REACHED;
int line_height, line_start_x = 0, reached = 0;
@@ -8566,8 +8828,18 @@ move_it_to (struct it *it, EMACS_INT to_charpos, int to_x, int to_y, int to_vpos
{
/* If TO_Y is in this line and TO_X was reached
above, we scanned too far. We have to restore
- IT's settings to the ones before skipping. */
+ IT's settings to the ones before skipping. But
+ keep the more accurate values of max_ascent and
+ max_descent we've found while skipping the rest
+ of the line, for the sake of callers, such as
+ pos_visible_p, that need to know the line
+ height. */
+ int max_ascent = it->max_ascent;
+ int max_descent = it->max_descent;
+
RESTORE_IT (it, &it_backup, backup_data);
+ it->max_ascent = max_ascent;
+ it->max_descent = max_descent;
reached = 6;
}
else
@@ -8667,7 +8939,7 @@ move_it_to (struct it *it, EMACS_INT to_charpos, int to_x, int to_y, int to_vpos
break;
default:
- abort ();
+ emacs_abort ();
}
/* Reset/increment for the next run. */
@@ -8729,10 +9001,10 @@ move_it_vertically_backward (struct it *it, int dy)
int nlines, h;
struct it it2, it3;
void *it2data = NULL, *it3data = NULL;
- EMACS_INT start_pos;
+ ptrdiff_t start_pos;
move_further_back:
- xassert (dy >= 0);
+ eassert (dy >= 0);
start_pos = IT_CHARPOS (*it);
@@ -8775,11 +9047,11 @@ move_it_vertically_backward (struct it *it, int dy)
|| (it2.method == GET_FROM_STRING
&& IT_CHARPOS (it2) == start_pos
&& SREF (it2.string, IT_STRING_BYTEPOS (it2) - 1) == '\n')));
- xassert (IT_CHARPOS (*it) >= BEGV);
+ eassert (IT_CHARPOS (*it) >= BEGV);
SAVE_IT (it3, it2, it3data);
move_it_to (&it2, start_pos, -1, -1, -1, MOVE_TO_POS);
- xassert (IT_CHARPOS (*it) >= BEGV);
+ eassert (IT_CHARPOS (*it) >= BEGV);
/* H is the actual vertical distance from the position in *IT
and the starting position. */
h = it2.current_y - it->current_y;
@@ -8811,7 +9083,7 @@ move_it_vertically_backward (struct it *it, int dy)
&& IT_CHARPOS (*it) > BEGV
&& FETCH_BYTE (IT_BYTEPOS (*it) - 1) != '\n')
{
- EMACS_INT nl_pos =
+ ptrdiff_t nl_pos =
find_next_newline_no_quit (IT_CHARPOS (*it) - 1, -1);
move_it_to (it, nl_pos, -1, -1, -1, MOVE_TO_POS);
@@ -8921,7 +9193,7 @@ move_it_past_eol (struct it *it)
truncate-lines nil. */
void
-move_it_by_lines (struct it *it, int dvpos)
+move_it_by_lines (struct it *it, ptrdiff_t dvpos)
{
/* The commented-out optimization uses vmotion on terminals. This
@@ -8944,7 +9216,6 @@ move_it_by_lines (struct it *it, int dvpos)
{
/* DVPOS == 0 means move to the start of the screen line. */
move_it_vertically_backward (it, 0);
- xassert (it->current_x == 0 && it->hpos == 0);
/* Let next call to line_bottom_y calculate real line height */
last_height = 0;
}
@@ -8952,13 +9223,26 @@ move_it_by_lines (struct it *it, int dvpos)
{
move_it_to (it, -1, -1, -1, it->vpos + dvpos, MOVE_TO_VPOS);
if (!IT_POS_VALID_AFTER_MOVE_P (it))
- move_it_to (it, IT_CHARPOS (*it) + 1, -1, -1, -1, MOVE_TO_POS);
+ {
+ /* Only move to the next buffer position if we ended up in a
+ string from display property, not in an overlay string
+ (before-string or after-string). That is because the
+ latter don't conceal the underlying buffer position, so
+ we can ask to move the iterator to the exact position we
+ are interested in. Note that, even if we are already at
+ IT_CHARPOS (*it), the call below is not a no-op, as it
+ will detect that we are at the end of the string, pop the
+ iterator, and compute it->current_x and it->hpos
+ correctly. */
+ move_it_to (it, IT_CHARPOS (*it) + it->string_from_display_prop_p,
+ -1, -1, -1, MOVE_TO_POS);
+ }
}
else
{
struct it it2;
void *it2data = NULL;
- EMACS_INT start_charpos, i;
+ ptrdiff_t start_charpos, i;
/* Start at the beginning of the screen line containing IT's
position. This may actually move vertically backwards,
@@ -9044,16 +9328,10 @@ add_to_log (const char *format, Lisp_Object arg1, Lisp_Object arg2)
Lisp_Object args[3];
Lisp_Object msg, fmt;
char *buffer;
- EMACS_INT len;
+ ptrdiff_t len;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
USE_SAFE_ALLOCA;
- /* Do nothing if called asynchronously. Inserting text into
- a buffer may call after-change-functions and alike and
- that would means running Lisp asynchronously. */
- if (handling_signal)
- return;
-
fmt = msg = Qnil;
GCPRO4 (fmt, msg, arg1, arg2);
@@ -9063,7 +9341,7 @@ add_to_log (const char *format, Lisp_Object arg1, Lisp_Object arg2)
msg = Fformat (3, args);
len = SBYTES (msg) + 1;
- SAFE_ALLOCA (buffer, char *, len);
+ buffer = SAFE_ALLOCA (len);
memcpy (buffer, SDATA (msg), len);
message_dolog (buffer, len - 1, 1, 0);
@@ -9093,7 +9371,7 @@ message_log_maybe_newline (void)
so the buffer M must NOT point to a Lisp string. */
void
-message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte)
+message_dolog (const char *m, ptrdiff_t nbytes, int nlflag, int multibyte)
{
const unsigned char *msg = (const unsigned char *) m;
@@ -9105,15 +9383,15 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte)
struct buffer *oldbuf;
Lisp_Object oldpoint, oldbegv, oldzv;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
- EMACS_INT point_at_end = 0;
- EMACS_INT zv_at_end = 0;
+ ptrdiff_t point_at_end = 0;
+ ptrdiff_t zv_at_end = 0;
Lisp_Object old_deactivate_mark, tem;
struct gcpro gcpro1;
old_deactivate_mark = Vdeactivate_mark;
oldbuf = current_buffer;
Fset_buffer (Fget_buffer_create (Vmessages_buffer_name));
- BVAR (current_buffer, undo_list) = Qt;
+ bset_undo_list (current_buffer, Qt);
oldpoint = message_dolog_marker1;
set_marker_restricted (oldpoint, make_number (PT), Qnil);
@@ -9139,7 +9417,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte)
if (multibyte
&& NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
- EMACS_INT i;
+ ptrdiff_t i;
int c, char_bytes;
char work[1];
@@ -9157,7 +9435,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte)
else if (! multibyte
&& ! NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
- EMACS_INT i;
+ ptrdiff_t i;
int c, char_bytes;
unsigned char str[MAX_MULTIBYTE_LENGTH];
/* Convert a single-byte string to multibyte
@@ -9175,7 +9453,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte)
if (nlflag)
{
- EMACS_INT this_bol, this_bol_byte, prev_bol, prev_bol_byte;
+ ptrdiff_t this_bol, this_bol_byte, prev_bol, prev_bol_byte;
printmax_t dups;
insert_1 ("\n", 1, 1, 0, 0);
@@ -9201,12 +9479,10 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte)
{
char dupstr[sizeof " [ times]"
+ INT_STRLEN_BOUND (printmax_t)];
- int duplen;
/* If you change this format, don't forget to also
change message_log_check_duplicate. */
- sprintf (dupstr, " [%"pMd" times]", dups);
- duplen = strlen (dupstr);
+ int duplen = sprintf (dupstr, " [%"pMd" times]", dups);
TEMP_SET_PT_BOTH (Z - 1, Z_BYTE - 1);
insert_1 (dupstr, duplen, 1, 0, 1);
}
@@ -9268,10 +9544,10 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte)
value N > 1 if we should also append " [N times]". */
static intmax_t
-message_log_check_duplicate (EMACS_INT prev_bol_byte, EMACS_INT this_bol_byte)
+message_log_check_duplicate (ptrdiff_t prev_bol_byte, ptrdiff_t this_bol_byte)
{
- EMACS_INT i;
- EMACS_INT len = Z_BYTE - 1 - this_bol_byte;
+ ptrdiff_t i;
+ ptrdiff_t len = Z_BYTE - 1 - this_bol_byte;
int seen_dots = 0;
unsigned char *p1 = BUF_BYTE_ADDRESS (current_buffer, prev_bol_byte);
unsigned char *p2 = BUF_BYTE_ADDRESS (current_buffer, this_bol_byte);
@@ -9305,7 +9581,7 @@ message_log_check_duplicate (EMACS_INT prev_bol_byte, EMACS_INT this_bol_byte)
This may GC, so the buffer M must NOT point to a Lisp string. */
void
-message2 (const char *m, EMACS_INT nbytes, int multibyte)
+message2 (const char *m, ptrdiff_t nbytes, int multibyte)
{
/* First flush out any partial line written with print. */
message_log_maybe_newline ();
@@ -9318,7 +9594,7 @@ message2 (const char *m, EMACS_INT nbytes, int multibyte)
/* The non-logging counterpart of message2. */
void
-message2_nolog (const char *m, EMACS_INT nbytes, int multibyte)
+message2_nolog (const char *m, ptrdiff_t nbytes, int multibyte)
{
struct frame *sf = SELECTED_FRAME ();
message_enable_multibyte = multibyte;
@@ -9366,7 +9642,7 @@ message2_nolog (const char *m, EMACS_INT nbytes, int multibyte)
do_pending_window_change (0);
echo_area_display (1);
do_pending_window_change (0);
- if (FRAME_TERMINAL (f)->frame_up_to_date_hook != 0 && ! gc_in_progress)
+ if (FRAME_TERMINAL (f)->frame_up_to_date_hook)
(*FRAME_TERMINAL (f)->frame_up_to_date_hook) (f);
}
}
@@ -9380,7 +9656,7 @@ message2_nolog (const char *m, EMACS_INT nbytes, int multibyte)
This function cancels echoing. */
void
-message3 (Lisp_Object m, EMACS_INT nbytes, int multibyte)
+message3 (Lisp_Object m, ptrdiff_t nbytes, int multibyte)
{
struct gcpro gcpro1;
@@ -9392,10 +9668,8 @@ message3 (Lisp_Object m, EMACS_INT nbytes, int multibyte)
message_log_maybe_newline ();
if (STRINGP (m))
{
- char *buffer;
USE_SAFE_ALLOCA;
-
- SAFE_ALLOCA (buffer, char *, nbytes);
+ char *buffer = SAFE_ALLOCA (nbytes);
memcpy (buffer, SDATA (m), nbytes);
message_dolog (buffer, nbytes, 1, multibyte);
SAFE_FREE ();
@@ -9412,7 +9686,7 @@ message3 (Lisp_Object m, EMACS_INT nbytes, int multibyte)
and make this cancel echoing. */
void
-message3_nolog (Lisp_Object m, EMACS_INT nbytes, int multibyte)
+message3_nolog (Lisp_Object m, ptrdiff_t nbytes, int multibyte)
{
struct frame *sf = SELECTED_FRAME ();
message_enable_multibyte = multibyte;
@@ -9465,7 +9739,7 @@ message3_nolog (Lisp_Object m, EMACS_INT nbytes, int multibyte)
do_pending_window_change (0);
echo_area_display (1);
do_pending_window_change (0);
- if (FRAME_TERMINAL (f)->frame_up_to_date_hook != 0 && ! gc_in_progress)
+ if (FRAME_TERMINAL (f)->frame_up_to_date_hook)
(*FRAME_TERMINAL (f)->frame_up_to_date_hook) (f);
}
}
@@ -9603,7 +9877,7 @@ vmessage (const char *m, va_list ap)
len = doprnt (FRAME_MESSAGE_BUF (f),
FRAME_MESSAGE_BUF_SIZE (f), m, (char *)0, ap);
- message2 (FRAME_MESSAGE_BUF (f), len, 0);
+ message2 (FRAME_MESSAGE_BUF (f), len, 1);
}
else
message1 (0);
@@ -9670,16 +9944,16 @@ ensure_echo_area_buffers (void)
for (i = 0; i < 2; ++i)
if (!BUFFERP (echo_buffer[i])
- || NILP (BVAR (XBUFFER (echo_buffer[i]), name)))
+ || !BUFFER_LIVE_P (XBUFFER (echo_buffer[i])))
{
char name[30];
Lisp_Object old_buffer;
int j;
old_buffer = echo_buffer[i];
- sprintf (name, " *Echo Area %d*", i);
- echo_buffer[i] = Fget_buffer_create (build_string (name));
- BVAR (XBUFFER (echo_buffer[i]), truncate_lines) = Qnil;
+ echo_buffer[i] = Fget_buffer_create
+ (make_formatted_string (name, " *Echo Area %d*", i));
+ bset_truncate_lines (XBUFFER (echo_buffer[i]), Qnil);
/* to force word wrap in echo area -
it was decided to postpone this*/
/* XBUFFER (echo_buffer[i])->word_wrap = Qt; */
@@ -9709,12 +9983,12 @@ ensure_echo_area_buffers (void)
static int
with_echo_area_buffer (struct window *w, int which,
- int (*fn) (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT),
- EMACS_INT a1, Lisp_Object a2, EMACS_INT a3, EMACS_INT a4)
+ int (*fn) (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t),
+ ptrdiff_t a1, Lisp_Object a2, ptrdiff_t a3, ptrdiff_t a4)
{
Lisp_Object buffer;
int this_one, the_other, clear_buffer_p, rc;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* If buffers aren't live, make new ones. */
ensure_echo_area_buffers ();
@@ -9768,25 +10042,25 @@ with_echo_area_buffer (struct window *w, int which,
set_buffer_internal_1 (XBUFFER (buffer));
if (w)
{
- w->buffer = buffer;
+ wset_buffer (w, buffer);
set_marker_both (w->pointm, buffer, BEG, BEG_BYTE);
}
- BVAR (current_buffer, undo_list) = Qt;
- BVAR (current_buffer, read_only) = Qnil;
+ bset_undo_list (current_buffer, Qt);
+ bset_read_only (current_buffer, Qnil);
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
if (clear_buffer_p && Z > BEG)
del_range (BEG, Z);
- xassert (BEGV >= BEG);
- xassert (ZV <= Z && ZV >= BEGV);
+ eassert (BEGV >= BEG);
+ eassert (ZV <= Z && ZV >= BEGV);
rc = fn (a1, a2, a3, a4);
- xassert (BEGV >= BEG);
- xassert (ZV <= Z && ZV >= BEGV);
+ eassert (BEGV >= BEG);
+ eassert (ZV <= Z && ZV >= BEGV);
unbind_to (count, Qnil);
return rc;
@@ -9828,7 +10102,7 @@ with_echo_area_buffer_unwind_data (struct window *w)
ASET (vector, i, Qnil);
}
- xassert (i == ASIZE (vector));
+ eassert (i == ASIZE (vector));
return vector;
}
@@ -9853,7 +10127,7 @@ unwind_with_echo_area_buffer (Lisp_Object vector)
charpos = AREF (vector, 5);
bytepos = AREF (vector, 6);
- w->buffer = buffer;
+ wset_buffer (w, buffer);
set_marker_both (w->pointm, buffer,
XFASTINT (charpos), XFASTINT (bytepos));
}
@@ -9886,11 +10160,11 @@ setup_echo_area_for_printing (int multibyte_p)
/* Switch to that buffer and clear it. */
set_buffer_internal (XBUFFER (echo_area_buffer[0]));
- BVAR (current_buffer, truncate_lines) = Qnil;
+ bset_truncate_lines (current_buffer, Qnil);
if (Z > BEG)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_read_only, Qt);
/* Note that undo recording is always disabled. */
del_range (BEG, Z);
@@ -9929,7 +10203,7 @@ setup_echo_area_for_printing (int multibyte_p)
{
/* Someone switched buffers between print requests. */
set_buffer_internal (XBUFFER (echo_area_buffer[0]));
- BVAR (current_buffer, truncate_lines) = Qnil;
+ bset_truncate_lines (current_buffer, Qnil);
}
}
}
@@ -9943,14 +10217,14 @@ setup_echo_area_for_printing (int multibyte_p)
static int
display_echo_area (struct window *w)
{
- int i, no_message_p, window_height_changed_p, count;
+ int i, no_message_p, window_height_changed_p;
/* Temporarily disable garbage collections while displaying the echo
area. This is done because a GC can print a message itself.
That message would modify the echo area buffer's contents while a
redisplay of the buffer is going on, and seriously confuse
redisplay. */
- count = inhibit_garbage_collection ();
+ ptrdiff_t count = inhibit_garbage_collection ();
/* If there is no message, we must call display_echo_area_1
nevertheless because it resizes the window. But we will have to
@@ -9979,7 +10253,7 @@ display_echo_area (struct window *w)
Value is non-zero if height of W was changed. */
static int
-display_echo_area_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT a3, EMACS_INT a4)
+display_echo_area_1 (ptrdiff_t a1, Lisp_Object a2, ptrdiff_t a3, ptrdiff_t a4)
{
intptr_t i1 = a1;
struct window *w = (struct window *) i1;
@@ -10043,7 +10317,7 @@ resize_echo_area_exactly (void)
resize_mini_window returns. */
static int
-resize_mini_window_1 (EMACS_INT a1, Lisp_Object exactly, EMACS_INT a3, EMACS_INT a4)
+resize_mini_window_1 (ptrdiff_t a1, Lisp_Object exactly, ptrdiff_t a3, ptrdiff_t a4)
{
intptr_t i1 = a1;
return resize_mini_window ((struct window *) i1, !NILP (exactly));
@@ -10067,7 +10341,7 @@ resize_mini_window (struct window *w, int exact_p)
struct frame *f = XFRAME (w->frame);
int window_height_changed_p = 0;
- xassert (MINI_WINDOW_P (w));
+ eassert (MINI_WINDOW_P (w));
/* By default, start display at the beginning. */
set_marker_both (w->start, w->buffer,
@@ -10093,7 +10367,8 @@ resize_mini_window (struct window *w, int exact_p)
struct it it;
struct window *root = XWINDOW (FRAME_ROOT_WINDOW (f));
int total_height = WINDOW_TOTAL_LINES (root) + WINDOW_TOTAL_LINES (w);
- int height, max_height;
+ int height;
+ EMACS_INT max_height;
int unit = FRAME_LINE_HEIGHT (f);
struct text_pos start;
struct buffer *old_current_buffer = NULL;
@@ -10222,7 +10497,7 @@ current_message (void)
static int
-current_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT a3, EMACS_INT a4)
+current_message_1 (ptrdiff_t a1, Lisp_Object a2, ptrdiff_t a3, ptrdiff_t a4)
{
intptr_t i1 = a1;
Lisp_Object *msg = (Lisp_Object *) i1;
@@ -10240,11 +10515,10 @@ current_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT a3, EMACS_INT a4)
empty. This is a relatively infrequent operation, so it's not
worth optimizing. */
-int
+bool
push_message (void)
{
- Lisp_Object msg;
- msg = current_message ();
+ Lisp_Object msg = current_message ();
Vmessage_stack = Fcons (msg, Vmessage_stack);
return STRINGP (msg);
}
@@ -10257,7 +10531,7 @@ restore_message (void)
{
Lisp_Object msg;
- xassert (CONSP (Vmessage_stack));
+ eassert (CONSP (Vmessage_stack));
msg = XCAR (Vmessage_stack);
if (STRINGP (msg))
message3_nolog (msg, SBYTES (msg), STRING_MULTIBYTE (msg));
@@ -10280,7 +10554,7 @@ pop_message_unwind (Lisp_Object dummy)
static void
pop_message (void)
{
- xassert (CONSP (Vmessage_stack));
+ eassert (CONSP (Vmessage_stack));
Vmessage_stack = XCDR (Vmessage_stack);
}
@@ -10293,7 +10567,7 @@ void
check_message_stack (void)
{
if (!NILP (Vmessage_stack))
- abort ();
+ emacs_abort ();
}
@@ -10301,7 +10575,7 @@ check_message_stack (void)
time we display it---but don't redisplay it now. */
void
-truncate_echo_area (EMACS_INT nchars)
+truncate_echo_area (ptrdiff_t nchars)
{
if (nchars == 0)
echo_area_buffer[0] = Qnil;
@@ -10323,7 +10597,7 @@ truncate_echo_area (EMACS_INT nchars)
message to at most NCHARS characters. */
static int
-truncate_message_1 (EMACS_INT nchars, Lisp_Object a2, EMACS_INT a3, EMACS_INT a4)
+truncate_message_1 (ptrdiff_t nchars, Lisp_Object a2, ptrdiff_t a3, ptrdiff_t a4)
{
if (BEG + nchars < Z)
del_range (BEG + nchars, Z);
@@ -10332,7 +10606,6 @@ truncate_message_1 (EMACS_INT nchars, Lisp_Object a2, EMACS_INT a3, EMACS_INT a4
return 0;
}
-
/* Set the current message to a substring of S or STRING.
If STRING is a Lisp string, set the message to the first NBYTES
@@ -10349,7 +10622,7 @@ truncate_message_1 (EMACS_INT nchars, Lisp_Object a2, EMACS_INT a3, EMACS_INT a4
static void
set_message (const char *s, Lisp_Object string,
- EMACS_INT nbytes, int multibyte_p)
+ ptrdiff_t nbytes, int multibyte_p)
{
message_enable_multibyte
= ((s && multibyte_p)
@@ -10359,6 +10632,10 @@ set_message (const char *s, Lisp_Object string,
(intptr_t) s, string, nbytes, multibyte_p);
message_buf_print = 0;
help_echo_showing_p = 0;
+
+ if (STRINGP (Vdebug_on_message)
+ && fast_string_match (Vdebug_on_message, string) >= 0)
+ call_debugger (list2 (Qerror, string));
}
@@ -10368,7 +10645,7 @@ set_message (const char *s, Lisp_Object string,
current. */
static int
-set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multibyte_p)
+set_message_1 (ptrdiff_t a1, Lisp_Object a2, ptrdiff_t nbytes, ptrdiff_t multibyte_p)
{
intptr_t i1 = a1;
const char *s = (const char *) i1;
@@ -10380,16 +10657,16 @@ set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multiby
!= !NILP (BVAR (current_buffer, enable_multibyte_characters)))
Fset_buffer_multibyte (message_enable_multibyte ? Qt : Qnil);
- BVAR (current_buffer, truncate_lines) = message_truncate_lines ? Qt : Qnil;
+ bset_truncate_lines (current_buffer, message_truncate_lines ? Qt : Qnil);
if (!NILP (BVAR (current_buffer, bidi_display_reordering)))
- BVAR (current_buffer, bidi_paragraph_direction) = Qleft_to_right;
+ bset_bidi_paragraph_direction (current_buffer, Qleft_to_right);
/* Insert new message at BEG. */
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
if (STRINGP (string))
{
- EMACS_INT nchars;
+ ptrdiff_t nchars;
if (nbytes == 0)
nbytes = SBYTES (string);
@@ -10408,7 +10685,7 @@ set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multiby
if (multibyte_p && NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
/* Convert from multi-byte to single-byte. */
- EMACS_INT i;
+ ptrdiff_t i;
int c, n;
char work[1];
@@ -10426,7 +10703,7 @@ set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multiby
&& !NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
/* Convert from single-byte to multi-byte. */
- EMACS_INT i;
+ ptrdiff_t i;
int c, n;
unsigned char str[MAX_MULTIBYTE_LENGTH];
@@ -10491,7 +10768,7 @@ clear_garbaged_frames (void)
{
if (f->resized_p)
{
- Fredraw_frame (frame);
+ redraw_frame (f);
f->force_flush_display_p = 1;
}
clear_current_matrices (f);
@@ -10538,8 +10815,7 @@ echo_area_display (int update_frame_p)
#endif /* HAVE_WINDOW_SYSTEM */
/* Redraw garbaged frames. */
- if (frame_garbaged)
- clear_garbaged_frames ();
+ clear_garbaged_frames ();
if (!NILP (echo_area_buffer[0]) || minibuf_level == 0)
{
@@ -10571,7 +10847,7 @@ echo_area_display (int update_frame_p)
/* Must update other windows. Likewise as in other
cases, don't let this update be interrupted by
pending input. */
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qredisplay_dont_pause, Qt);
windows_or_buffers_changed = 1;
redisplay_internal ();
@@ -10612,8 +10888,41 @@ echo_area_display (int update_frame_p)
return window_height_changed_p;
}
+/* Nonzero if the current buffer is shown in more than
+ one window and was modified since last display. */
+
+static int
+buffer_shared_and_changed (void)
+{
+ return (buffer_shared > 1 && UNCHANGED_MODIFIED < MODIFF);
+}
+
+/* Nonzero if W doesn't reflect the actual state of
+ current buffer due to its text or overlays change. */
+
+static int
+window_outdated (struct window *w)
+{
+ eassert (XBUFFER (w->buffer) == current_buffer);
+ return (w->last_modified < MODIFF
+ || w->last_overlay_modified < OVERLAY_MODIFF);
+}
+
+/* Nonzero if W's buffer was changed but not saved or Transient Mark mode
+ is enabled and mark of W's buffer was changed since last W's update. */
+
+static int
+window_buffer_changed (struct window *w)
+{
+ struct buffer *b = XBUFFER (w->buffer);
+
+ eassert (BUFFER_LIVE_P (b));
+
+ return (((BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) != w->last_had_star)
+ || ((!NILP (Vtransient_mark_mode) && !NILP (BVAR (b, mark_active)))
+ != !NILP (w->region_showing)));
+}
-
/***********************************************************************
Mode Lines and Frame Titles
***********************************************************************/
@@ -10656,7 +10965,8 @@ static Lisp_Object mode_line_string_face_prop;
static Lisp_Object Vmode_line_unwind_vector;
static Lisp_Object
-format_mode_line_unwind_data (struct buffer *obuf,
+format_mode_line_unwind_data (struct frame *target_frame,
+ struct buffer *obuf,
Lisp_Object owin,
int save_proptrans)
{
@@ -10668,7 +10978,7 @@ format_mode_line_unwind_data (struct buffer *obuf,
Vmode_line_unwind_vector = Qnil;
if (NILP (vector))
- vector = Fmake_vector (make_number (8), Qnil);
+ vector = Fmake_vector (make_number (10), Qnil);
ASET (vector, 0, make_number (mode_line_target));
ASET (vector, 1, make_number (MODE_LINE_NOPROP_LEN (0)));
@@ -10683,6 +10993,15 @@ format_mode_line_unwind_data (struct buffer *obuf,
tmp = Qnil;
ASET (vector, 6, tmp);
ASET (vector, 7, owin);
+ if (target_frame)
+ {
+ /* Similarly to `with-selected-window', if the operation selects
+ a window on another frame, we must restore that frame's
+ selected window, and (for a tty) the top-frame. */
+ ASET (vector, 8, target_frame->selected_window);
+ if (FRAME_TERMCAP_P (target_frame))
+ ASET (vector, 9, FRAME_TTY (target_frame)->top_frame);
+ }
return vector;
}
@@ -10690,6 +11009,10 @@ format_mode_line_unwind_data (struct buffer *obuf,
static Lisp_Object
unwind_format_mode_line (Lisp_Object vector)
{
+ Lisp_Object old_window = AREF (vector, 7);
+ Lisp_Object target_frame_window = AREF (vector, 8);
+ Lisp_Object old_top_frame = AREF (vector, 9);
+
mode_line_target = XINT (AREF (vector, 0));
mode_line_noprop_ptr = mode_line_noprop_buf + XINT (AREF (vector, 1));
mode_line_string_list = AREF (vector, 2);
@@ -10698,9 +11021,26 @@ unwind_format_mode_line (Lisp_Object vector)
mode_line_string_face = AREF (vector, 4);
mode_line_string_face_prop = AREF (vector, 5);
- if (!NILP (AREF (vector, 7)))
- /* Select window before buffer, since it may change the buffer. */
- Fselect_window (AREF (vector, 7), Qt);
+ /* Select window before buffer, since it may change the buffer. */
+ if (!NILP (old_window))
+ {
+ /* If the operation that we are unwinding had selected a window
+ on a different frame, reset its frame-selected-window. For a
+ text terminal, reset its top-frame if necessary. */
+ if (!NILP (target_frame_window))
+ {
+ Lisp_Object frame
+ = WINDOW_FRAME (XWINDOW (target_frame_window));
+
+ if (!EQ (frame, WINDOW_FRAME (XWINDOW (old_window))))
+ Fselect_window (target_frame_window, Qt);
+
+ if (!NILP (old_top_frame) && !EQ (old_top_frame, frame))
+ Fselect_frame (old_top_frame, Qt);
+ }
+
+ Fselect_window (old_window, Qt);
+ }
if (!NILP (AREF (vector, 6)))
{
@@ -10748,7 +11088,7 @@ store_mode_line_noprop (const char *string, int field_width, int precision)
{
const unsigned char *str = (const unsigned char *) string;
int n = 0;
- EMACS_INT dummy, nbytes;
+ ptrdiff_t dummy, nbytes;
/* Copy at most PRECISION chars from STR. */
nbytes = strlen (string);
@@ -10787,17 +11127,15 @@ x_consider_frame_title (Lisp_Object frame)
|| f->explicit_name)
{
/* Do we have more than one visible frame on this X display? */
- Lisp_Object tail;
- Lisp_Object fmt;
+ Lisp_Object tail, other_frame, fmt;
ptrdiff_t title_start;
char *title;
ptrdiff_t len;
struct it it;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, other_frame)
{
- Lisp_Object other_frame = XCAR (tail);
struct frame *tf = XFRAME (other_frame);
if (tf != f
@@ -10816,10 +11154,11 @@ x_consider_frame_title (Lisp_Object frame)
mode_line_noprop_buf; then display the title. */
record_unwind_protect (unwind_format_mode_line,
format_mode_line_unwind_data
- (current_buffer, selected_window, 0));
+ (f, current_buffer, selected_window, 0));
Fselect_window (f->selected_window, Qt);
- set_buffer_internal_1 (XBUFFER (XWINDOW (f->selected_window)->buffer));
+ set_buffer_internal_1
+ (XBUFFER (XWINDOW (f->selected_window)->buffer));
fmt = FRAME_ICONIFIED_P (f) ? Vicon_title_format : Vframe_title_format;
mode_line_target = MODE_LINE_TITLE;
@@ -10845,8 +11184,6 @@ x_consider_frame_title (Lisp_Object frame)
#endif /* not HAVE_WINDOW_SYSTEM */
-
-
/***********************************************************************
Menu Bars
@@ -10891,12 +11228,12 @@ prepare_menu_bars (void)
/* Update the menu bar item lists, if appropriate. This has to be
done before any actual redisplay or generation of display lines. */
all_windows = (update_mode_lines
- || buffer_shared > 1
+ || buffer_shared_and_changed ()
|| windows_or_buffers_changed);
if (all_windows)
{
Lisp_Object tail, frame;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* 1 means that update_menu_bar has run its hooks
so any further calls to update_menu_bar shouldn't do so again. */
int menu_bar_hooks_run = 0;
@@ -10939,8 +11276,8 @@ prepare_menu_bars (void)
#ifdef HAVE_NS
if (windows_or_buffers_changed
&& FRAME_NS_P (f))
- ns_set_doc_edited (f, Fbuffer_modified_p
- (XWINDOW (f->selected_window)->buffer));
+ ns_set_doc_edited
+ (f, Fbuffer_modified_p (XWINDOW (f->selected_window)->buffer));
#endif
UNGCPRO;
}
@@ -11005,15 +11342,10 @@ update_menu_bar (struct frame *f, int save_match_data, int hooks_run)
/* This used to test w->update_mode_line, but we believe
there is no need to recompute the menu in that case. */
|| update_mode_lines
- || ((BUF_SAVE_MODIFF (XBUFFER (w->buffer))
- < BUF_MODIFF (XBUFFER (w->buffer)))
- != !NILP (w->last_had_star))
- || ((!NILP (Vtransient_mark_mode)
- && !NILP (BVAR (XBUFFER (w->buffer), mark_active)))
- != !NILP (w->region_showing)))
+ || window_buffer_changed (w))
{
struct buffer *prev = current_buffer;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_menubar_update, Qt);
@@ -11042,7 +11374,7 @@ update_menu_bar (struct frame *f, int save_match_data, int hooks_run)
}
XSETFRAME (Vmenu_updating_frame, f);
- FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
+ fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
/* Redisplay the menu bar in case we changed it. */
#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
@@ -11059,11 +11391,11 @@ update_menu_bar (struct frame *f, int save_match_data, int hooks_run)
else
/* On a terminal screen, the menu bar is an ordinary screen
line, and this makes it get updated. */
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
#else /* ! (USE_X_TOOLKIT || HAVE_NTGUI || HAVE_NS || USE_GTK) */
/* In the non-toolkit version, the menu bar is an ordinary screen
line, and this makes it get updated. */
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
#endif /* ! (USE_X_TOOLKIT || HAVE_NTGUI || HAVE_NS || USE_GTK) */
unbind_to (count, Qnil);
@@ -11136,11 +11468,11 @@ x_cursor_to (int vpos, int hpos, int y, int x)
This will also set the cursor position of W. */
if (updated_window == NULL)
{
- BLOCK_INPUT;
+ block_input ();
display_and_set_cursor (w, 1, hpos, vpos, x, y);
if (FRAME_RIF (SELECTED_FRAME ())->flush_display_optional)
FRAME_RIF (SELECTED_FRAME ())->flush_display_optional (SELECTED_FRAME ());
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -11162,11 +11494,18 @@ FRAME_PTR last_mouse_frame;
int last_tool_bar_item;
-
+/* Select `frame' temporarily without running all the code in
+ do_switch_frame.
+ FIXME: Maybe do_switch_frame should be trimmed down similarly
+ when `norecord' is set. */
static Lisp_Object
-update_tool_bar_unwind (Lisp_Object frame)
+fast_set_selected_frame (Lisp_Object frame)
{
- selected_frame = frame;
+ if (!EQ (selected_frame, frame))
+ {
+ selected_frame = frame;
+ selected_window = XFRAME (frame)->selected_window;
+ }
return Qnil;
}
@@ -11201,17 +11540,12 @@ update_tool_bar (struct frame *f, int save_match_data)
the rest of the redisplay algorithm is about the same as
windows_or_buffers_changed anyway. */
if (windows_or_buffers_changed
- || !NILP (w->update_mode_line)
+ || w->update_mode_line
|| update_mode_lines
- || ((BUF_SAVE_MODIFF (XBUFFER (w->buffer))
- < BUF_MODIFF (XBUFFER (w->buffer)))
- != !NILP (w->last_had_star))
- || ((!NILP (Vtransient_mark_mode)
- && !NILP (BVAR (XBUFFER (w->buffer), mark_active)))
- != !NILP (w->region_showing)))
+ || window_buffer_changed (w))
{
struct buffer *prev = current_buffer;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object frame, new_tool_bar;
int new_n_tool_bar;
struct gcpro gcpro1;
@@ -11238,13 +11572,18 @@ update_tool_bar (struct frame *f, int save_match_data)
before calling tool_bar_items, because the calculation of
the tool-bar keymap uses the selected frame (see
`tool-bar-make-keymap' in tool-bar.el). */
- record_unwind_protect (update_tool_bar_unwind, selected_frame);
+ eassert (EQ (selected_window,
+ /* Since we only explicitly preserve selected_frame,
+ check that selected_window would be redundant. */
+ XFRAME (selected_frame)->selected_window));
+ record_unwind_protect (fast_set_selected_frame, selected_frame);
XSETFRAME (frame, f);
- selected_frame = frame;
+ fast_set_selected_frame (frame);
/* Build desired tool-bar items from keymaps. */
- new_tool_bar = tool_bar_items (Fcopy_sequence (f->tool_bar_items),
- &new_n_tool_bar);
+ new_tool_bar
+ = tool_bar_items (Fcopy_sequence (f->tool_bar_items),
+ &new_n_tool_bar);
/* Redisplay the tool-bar if we changed it. */
if (new_n_tool_bar != f->n_tool_bar_items
@@ -11253,11 +11592,11 @@ update_tool_bar (struct frame *f, int save_match_data)
/* Redisplay that happens asynchronously due to an expose event
may access f->tool_bar_items. Make sure we update both
variables within BLOCK_INPUT so no such event interrupts. */
- BLOCK_INPUT;
- f->tool_bar_items = new_tool_bar;
+ block_input ();
+ fset_tool_bar_items (f, new_tool_bar);
f->n_tool_bar_items = new_n_tool_bar;
- w->update_mode_line = Qt;
- UNBLOCK_INPUT;
+ w->update_mode_line = 1;
+ unblock_input ();
}
UNGCPRO;
@@ -11296,8 +11635,8 @@ build_desired_tool_bar_string (struct frame *f)
/* Reuse f->desired_tool_bar_string, if possible. */
if (size < size_needed || NILP (f->desired_tool_bar_string))
- f->desired_tool_bar_string = Fmake_string (make_number (size_needed),
- make_number (' '));
+ fset_desired_tool_bar_string
+ (f, Fmake_string (make_number (size_needed), make_number (' ')));
else
{
props = list4 (Qdisplay, Qnil, Qmenu_item, Qnil);
@@ -11310,7 +11649,8 @@ build_desired_tool_bar_string (struct frame *f)
is the index of the item in F's tool-bar item vector. */
for (i = 0; i < f->n_tool_bar_items; ++i)
{
-#define PROP(IDX) AREF (f->tool_bar_items, i * TOOL_BAR_ITEM_NSLOTS + (IDX))
+#define PROP(IDX) \
+ AREF (f->tool_bar_items, i * TOOL_BAR_ITEM_NSLOTS + (IDX))
int enabled_p = !NILP (PROP (TOOL_BAR_ITEM_ENABLED_P));
int selected_p = !NILP (PROP (TOOL_BAR_ITEM_SELECTED_P));
@@ -11330,7 +11670,7 @@ build_desired_tool_bar_string (struct frame *f)
? TOOL_BAR_IMAGE_DISABLED_SELECTED
: TOOL_BAR_IMAGE_DISABLED_DESELECTED);
- xassert (ASIZE (image) >= idx);
+ eassert (ASIZE (image) >= idx);
image = AREF (image, idx);
}
else
@@ -11349,20 +11689,20 @@ build_desired_tool_bar_string (struct frame *f)
: DEFAULT_TOOL_BAR_BUTTON_RELIEF);
hmargin = vmargin = relief;
- if (INTEGERP (Vtool_bar_button_margin)
- && XINT (Vtool_bar_button_margin) > 0)
+ if (RANGED_INTEGERP (1, Vtool_bar_button_margin,
+ INT_MAX - max (hmargin, vmargin)))
{
hmargin += XFASTINT (Vtool_bar_button_margin);
vmargin += XFASTINT (Vtool_bar_button_margin);
}
else if (CONSP (Vtool_bar_button_margin))
{
- if (INTEGERP (XCAR (Vtool_bar_button_margin))
- && XINT (XCAR (Vtool_bar_button_margin)) > 0)
+ if (RANGED_INTEGERP (1, XCAR (Vtool_bar_button_margin),
+ INT_MAX - hmargin))
hmargin += XFASTINT (XCAR (Vtool_bar_button_margin));
- if (INTEGERP (XCDR (Vtool_bar_button_margin))
- && XINT (XCDR (Vtool_bar_button_margin)) > 0)
+ if (RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin),
+ INT_MAX - vmargin))
vmargin += XFASTINT (XCDR (Vtool_bar_button_margin));
}
@@ -11606,19 +11946,14 @@ tool_bar_lines_needed (struct frame *f, int *n_rows)
DEFUN ("tool-bar-lines-needed", Ftool_bar_lines_needed, Stool_bar_lines_needed,
0, 1, 0,
- doc: /* Return the number of lines occupied by the tool bar of FRAME. */)
+ doc: /* Return the number of lines occupied by the tool bar of FRAME.
+If FRAME is nil or omitted, use the selected frame. */)
(Lisp_Object frame)
{
- struct frame *f;
+ struct frame *f = decode_any_frame (frame);
struct window *w;
int nlines = 0;
- if (NILP (frame))
- frame = selected_frame;
- else
- CHECK_FRAME (frame);
- f = XFRAME (frame);
-
if (WINDOWP (f->tool_bar_window)
&& (w = XWINDOW (f->tool_bar_window),
WINDOW_TOTAL_LINES (w) > 0))
@@ -11708,7 +12043,7 @@ redisplay_tool_bar (struct frame *f)
{
int border, rows, height, extra;
- if (INTEGERP (Vtool_bar_border))
+ if (TYPE_RANGED_INTEGERP (int, Vtool_bar_border))
border = XINT (Vtool_bar_border);
else if (EQ (Vtool_bar_border, Qinternal_border_width))
border = FRAME_INTERNAL_BORDER_WIDTH (f);
@@ -11896,7 +12231,7 @@ get_tool_bar_item (struct frame *f, int x, int y, struct glyph **glyph,
void
handle_tool_bar_click (struct frame *f, int x, int y, int down_p,
- unsigned int modifiers)
+ int modifiers)
{
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
struct window *w = XWINDOW (f->tool_bar_window);
@@ -12075,7 +12410,7 @@ hscroll_window_tree (Lisp_Object window)
hscroll_step_abs = 0;
}
}
- else if (INTEGERP (Vhscroll_step))
+ else if (TYPE_RANGED_INTEGERP (int, Vhscroll_step))
{
hscroll_step_abs = XINT (Vhscroll_step);
if (hscroll_step_abs < 0)
@@ -12117,7 +12452,7 @@ hscroll_window_tree (Lisp_Object window)
inside the left margin and the window is already
hscrolled. */
&& ((!row_r2l_p
- && ((XFASTINT (w->hscroll)
+ && ((w->hscroll
&& w->cursor.x <= h_margin)
|| (cursor_row->enabled_p
&& cursor_row->truncated_on_right_p
@@ -12135,13 +12470,13 @@ hscroll_window_tree (Lisp_Object window)
are actually truncated on the left. */
&& cursor_row->truncated_on_right_p
&& w->cursor.x <= h_margin)
- || (XFASTINT (w->hscroll)
+ || (w->hscroll
&& (w->cursor.x >= text_area_width - h_margin))))))
{
struct it it;
- int hscroll;
+ ptrdiff_t hscroll;
struct buffer *saved_current_buffer;
- EMACS_INT pt;
+ ptrdiff_t pt;
int wanted_x;
/* Find point in a display of infinite width. */
@@ -12196,15 +12531,15 @@ hscroll_window_tree (Lisp_Object window)
hscroll
= max (0, it.current_x - wanted_x) / FRAME_COLUMN_WIDTH (it.f);
}
- hscroll = max (hscroll, XFASTINT (w->min_hscroll));
+ hscroll = max (hscroll, w->min_hscroll);
/* Don't prevent redisplay optimizations if hscroll
hasn't changed, as it will unnecessarily slow down
redisplay. */
- if (XFASTINT (w->hscroll) != hscroll)
+ if (w->hscroll != hscroll)
{
XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1;
- w->hscroll = make_number (hscroll);
+ w->hscroll = hscroll;
hscrolled_p = 1;
}
}
@@ -12243,7 +12578,7 @@ hscroll_windows (Lisp_Object window)
to a non-zero value. This is sometimes handy to have in a debugger
session. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* First and last unchanged row for try_window_id. */
@@ -12256,12 +12591,12 @@ static int debug_dvpos, debug_dy;
/* Delta in characters and bytes for try_window_id. */
-static EMACS_INT debug_delta, debug_delta_bytes;
+static ptrdiff_t debug_delta, debug_delta_bytes;
/* Values of window_end_pos and window_end_vpos at the end of
try_window_id. */
-static EMACS_INT debug_end_vpos;
+static ptrdiff_t debug_end_vpos;
/* Append a string to W->desired_matrix->method. FMT is a printf
format string. If trace_redisplay_p is non-zero also printf the
@@ -12273,23 +12608,21 @@ static void debug_method_add (struct window *, char const *, ...)
static void
debug_method_add (struct window *w, char const *fmt, ...)
{
- char buffer[512];
char *method = w->desired_matrix->method;
int len = strlen (method);
int size = sizeof w->desired_matrix->method;
int remaining = size - len - 1;
va_list ap;
- va_start (ap, fmt);
- vsprintf (buffer, fmt, ap);
- va_end (ap);
if (len && remaining)
{
method[len] = '|';
--remaining, ++len;
}
- strncpy (method + len, buffer, remaining);
+ va_start (ap, fmt);
+ vsnprintf (method + len, remaining + 1, fmt, ap);
+ va_end (ap);
if (trace_redisplay_p)
fprintf (stderr, "%p (%s): %s\n",
@@ -12298,7 +12631,7 @@ debug_method_add (struct window *w, char const *fmt, ...)
&& STRINGP (BVAR (XBUFFER (w->buffer), name)))
? SSDATA (BVAR (XBUFFER (w->buffer), name))
: "no buffer"),
- buffer);
+ method + len);
}
#endif /* GLYPH_DEBUG */
@@ -12309,15 +12642,14 @@ debug_method_add (struct window *w, char const *fmt, ...)
buffer position, END is given as a distance from Z. Used in
redisplay_internal for display optimization. */
-static inline int
+static int
text_outside_line_unchanged_p (struct window *w,
- EMACS_INT start, EMACS_INT end)
+ ptrdiff_t start, ptrdiff_t end)
{
int unchanged_p = 1;
/* If text or overlays have changed, see where. */
- if (XFASTINT (w->last_modified) < MODIFF
- || XFASTINT (w->last_overlay_modified) < OVERLAY_MODIFF)
+ if (window_outdated (w))
{
/* Gap in the line? */
if (GPT < start || Z - GPT < end)
@@ -12520,7 +12852,7 @@ overlay_arrow_at_row (struct it *it, struct glyph_row *row)
return make_number (fringe_bitmap);
}
#endif
- return make_number (-1); /* Use default arrow bitmap */
+ return make_number (-1); /* Use default arrow bitmap. */
}
return overlay_arrow_string_or_property (var);
}
@@ -12534,10 +12866,10 @@ overlay_arrow_at_row (struct it *it, struct glyph_row *row)
position. BUF and PT are the current point buffer and position. */
static int
-check_point_in_composition (struct buffer *prev_buf, EMACS_INT prev_pt,
- struct buffer *buf, EMACS_INT pt)
+check_point_in_composition (struct buffer *prev_buf, ptrdiff_t prev_pt,
+ struct buffer *buf, ptrdiff_t pt)
{
- EMACS_INT start, end;
+ ptrdiff_t start, end;
Lisp_Object prop;
Lisp_Object buffer;
@@ -12570,7 +12902,7 @@ check_point_in_composition (struct buffer *prev_buf, EMACS_INT prev_pt,
/* Reconsider the setting of B->clip_changed which is displayed
in window W. */
-static inline void
+static void
reconsider_clip_changes (struct window *w, struct buffer *b)
{
if (b->clip_changed
@@ -12588,7 +12920,7 @@ reconsider_clip_changes (struct window *w, struct buffer *b)
if (!b->clip_changed
&& BUFFERP (w->buffer) && !NILP (w->window_end_valid))
{
- EMACS_INT pt;
+ ptrdiff_t pt;
if (w == XWINDOW (selected_window))
pt = PT;
@@ -12596,9 +12928,9 @@ reconsider_clip_changes (struct window *w, struct buffer *b)
pt = marker_position (w->pointm);
if ((w->current_matrix->buffer != XBUFFER (w->buffer)
- || pt != XINT (w->last_point))
+ || pt != w->last_point)
&& check_point_in_composition (w->current_matrix->buffer,
- XINT (w->last_point),
+ w->last_point,
XBUFFER (w->buffer), pt))
b->clip_changed = 1;
}
@@ -12616,12 +12948,13 @@ select_frame_for_redisplay (Lisp_Object frame)
Lisp_Object old = selected_frame;
struct Lisp_Symbol *sym;
- xassert (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame)));
+ eassert (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame)));
selected_frame = frame;
do {
- for (tail = XFRAME (frame)->param_alist; CONSP (tail); tail = XCDR (tail))
+ for (tail = XFRAME (frame)->param_alist;
+ CONSP (tail); tail = XCDR (tail))
if (CONSP (XCAR (tail))
&& (tem = XCAR (XCAR (tail)),
SYMBOLP (tem))
@@ -12657,15 +12990,19 @@ redisplay_internal (void)
int must_finish = 0;
struct text_pos tlbufpos, tlendpos;
int number_of_visible_frames;
- int count, count1;
+ ptrdiff_t count, count1;
struct frame *sf;
int polling_stopped_here = 0;
- Lisp_Object old_frame = selected_frame;
+ Lisp_Object tail, frame, old_frame = selected_frame;
+ struct backtrace backtrace;
/* Non-zero means redisplay has to consider all windows on all
frames. Zero means, only selected_window is considered. */
int consider_all_windows_p;
+ /* Non-zero means redisplay has to redisplay the miniwindow. */
+ int update_miniwindow_p = 0;
+
TRACE ((stderr, "redisplay_internal %d\n", redisplaying_p));
/* No redisplay if running in batch mode or frame is not yet fully
@@ -12693,23 +13030,23 @@ redisplay_internal (void)
if (redisplaying_p)
return;
- /* Record a function that resets redisplaying_p to its old value
+ /* Record a function that clears redisplaying_p
when we leave this function. */
count = SPECPDL_INDEX ();
- record_unwind_protect (unwind_redisplay,
- Fcons (make_number (redisplaying_p), selected_frame));
- ++redisplaying_p;
+ record_unwind_protect (unwind_redisplay, selected_frame);
+ redisplaying_p = 1;
specbind (Qinhibit_free_realized_faces, Qnil);
- {
- Lisp_Object tail, frame;
+ /* Record this function, so it appears on the profiler's backtraces. */
+ backtrace.next = backtrace_list;
+ backtrace.function = Qredisplay_internal;
+ backtrace.args = &Qnil;
+ backtrace.nargs = 0;
+ backtrace.debug_on_exit = 0;
+ backtrace_list = &backtrace;
- FOR_EACH_FRAME (tail, frame)
- {
- struct frame *f = XFRAME (frame);
- f->already_hscrolled_p = 0;
- }
- }
+ FOR_EACH_FRAME (tail, frame)
+ XFRAME (frame)->already_hscrolled_p = 0;
retry:
/* Remember the currently selected window. */
@@ -12759,25 +13096,20 @@ redisplay_internal (void)
FRAME_TTY (sf)->previous_frame = sf;
}
- /* Set the visible flags for all frames. Do this before checking
- for resized or garbaged frames; they want to know if their frames
- are visible. See the comment in frame.h for
- FRAME_SAMPLE_VISIBILITY. */
- {
- Lisp_Object tail, frame;
-
- number_of_visible_frames = 0;
+ /* Set the visible flags for all frames. Do this before checking for
+ resized or garbaged frames; they want to know if their frames are
+ visible. See the comment in frame.h for FRAME_SAMPLE_VISIBILITY. */
+ number_of_visible_frames = 0;
- FOR_EACH_FRAME (tail, frame)
- {
- struct frame *f = XFRAME (frame);
+ FOR_EACH_FRAME (tail, frame)
+ {
+ struct frame *f = XFRAME (frame);
- FRAME_SAMPLE_VISIBILITY (f);
- if (FRAME_VISIBLE_P (f))
- ++number_of_visible_frames;
- clear_desired_matrices (f);
- }
- }
+ FRAME_SAMPLE_VISIBILITY (f);
+ if (FRAME_VISIBLE_P (f))
+ ++number_of_visible_frames;
+ clear_desired_matrices (f);
+ }
/* Notice any pending interrupt request to change frame size. */
do_pending_window_change (1);
@@ -12791,8 +13123,7 @@ redisplay_internal (void)
}
/* Clear frames marked as garbaged. */
- if (frame_garbaged)
- clear_garbaged_frames ();
+ clear_garbaged_frames ();
/* Build menubar and tool-bar items. */
if (NILP (Vmemory_full))
@@ -12802,10 +13133,10 @@ redisplay_internal (void)
update_mode_lines++;
/* Detect case that we need to write or remove a star in the mode line. */
- if ((SAVE_MODIFF < MODIFF) != !NILP (w->last_had_star))
+ if ((SAVE_MODIFF < MODIFF) != w->last_had_star)
{
- w->update_mode_line = Qt;
- if (buffer_shared > 1)
+ w->update_mode_line = 1;
+ if (buffer_shared_and_changed ())
update_mode_lines++;
}
@@ -12817,11 +13148,9 @@ redisplay_internal (void)
if (!NILP (w->column_number_displayed)
/* This alternative quickly identifies a common case
where no change is needed. */
- && !(PT == XFASTINT (w->last_point)
- && XFASTINT (w->last_modified) >= MODIFF
- && XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF)
+ && !(PT == w->last_point && !window_outdated (w))
&& (XFASTINT (w->column_number_displayed) != current_column ()))
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
unbind_to (count1, Qnil);
@@ -12830,7 +13159,8 @@ redisplay_internal (void)
/* The variable buffer_shared is set in redisplay_window and
indicates that we redisplay a buffer in different windows. See
there. */
- consider_all_windows_p = (update_mode_lines || buffer_shared > 1
+ consider_all_windows_p = (update_mode_lines
+ || buffer_shared_and_changed ()
|| cursor_type_changed);
/* If specs for an arrow have changed, do thorough redisplay
@@ -12852,6 +13182,10 @@ redisplay_internal (void)
&& !MINI_WINDOW_P (XWINDOW (selected_window))))
{
int window_height_changed_p = echo_area_display (0);
+
+ if (message_cleared_p)
+ update_miniwindow_p = 1;
+
must_finish = 1;
/* If we don't display the current message, don't clear the
@@ -12872,23 +13206,20 @@ redisplay_internal (void)
/* If window configuration was changed, frames may have been
marked garbaged. Clear them or we will experience
surprises wrt scrolling. */
- if (frame_garbaged)
- clear_garbaged_frames ();
+ clear_garbaged_frames ();
}
}
else if (EQ (selected_window, minibuf_window)
- && (current_buffer->clip_changed
- || XFASTINT (w->last_modified) < MODIFF
- || XFASTINT (w->last_overlay_modified) < OVERLAY_MODIFF)
+ && (current_buffer->clip_changed || window_outdated (w))
&& resize_mini_window (w, 0))
{
/* Resized active mini-window to fit the size of what it is
showing if its contents might have changed. */
must_finish = 1;
-/* FIXME: this causes all frames to be updated, which seems unnecessary
- since only the current frame needs to be considered. This function needs
- to be rewritten with two variables, consider_all_windows and
- consider_all_frames. */
+ /* FIXME: this causes all frames to be updated, which seems unnecessary
+ since only the current frame needs to be considered. This function
+ needs to be rewritten with two variables, consider_all_windows and
+ consider_all_frames. */
consider_all_windows_p = 1;
++windows_or_buffers_changed;
++update_mode_lines;
@@ -12896,8 +13227,7 @@ redisplay_internal (void)
/* If window configuration was changed, frames may have been
marked garbaged. Clear them or we will experience
surprises wrt scrolling. */
- if (frame_garbaged)
- clear_garbaged_frames ();
+ clear_garbaged_frames ();
}
@@ -12920,7 +13250,7 @@ redisplay_internal (void)
tlendpos = this_line_end_pos;
if (!consider_all_windows_p
&& CHARPOS (tlbufpos) > 0
- && NILP (w->update_mode_line)
+ && !w->update_mode_line
&& !current_buffer->clip_changed
&& !current_buffer->prevent_redisplay_optimizations_p
&& FRAME_VISIBLE_P (XFRAME (w->frame))
@@ -12928,8 +13258,8 @@ redisplay_internal (void)
/* Make sure recorded data applies to current buffer, etc. */
&& this_line_buffer == current_buffer
&& current_buffer == XBUFFER (w->buffer)
- && NILP (w->force_start)
- && NILP (w->optional_new_start)
+ && !w->force_start
+ && !w->optional_new_start
/* Point must be on the line that we have info recorded about. */
&& PT >= CHARPOS (tlbufpos)
&& PT <= Z - CHARPOS (tlendpos)
@@ -12944,9 +13274,7 @@ redisplay_internal (void)
|| FETCH_BYTE (BYTEPOS (tlbufpos)) == '\n'))
/* Former continuation line has disappeared by becoming empty. */
goto cancel;
- else if (XFASTINT (w->last_modified) < MODIFF
- || XFASTINT (w->last_overlay_modified) < OVERLAY_MODIFF
- || MINI_WINDOW_P (w))
+ else if (window_outdated (w) || MINI_WINDOW_P (w))
{
/* We have to handle the case of continuation around a
wide-column character (see the comment in indent.c around
@@ -13000,7 +13328,7 @@ redisplay_internal (void)
{
struct glyph_row *row
= MATRIX_ROW (w->current_matrix, this_line_vpos + 1);
- EMACS_INT delta, delta_bytes;
+ ptrdiff_t delta, delta_bytes;
/* We used to distinguish between two cases here,
conditioned by Z - CHARPOS (tlendpos) == ZV, for
@@ -13026,17 +13354,17 @@ redisplay_internal (void)
if ((it.glyph_row - 1)->displays_text_p)
{
if (XFASTINT (w->window_end_vpos) < this_line_vpos)
- XSETINT (w->window_end_vpos, this_line_vpos);
+ wset_window_end_vpos (w, make_number (this_line_vpos));
}
else if (XFASTINT (w->window_end_vpos) == this_line_vpos
&& this_line_vpos > 0)
- XSETINT (w->window_end_vpos, this_line_vpos - 1);
- w->window_end_valid = Qnil;
+ wset_window_end_vpos (w, make_number (this_line_vpos - 1));
+ wset_window_end_valid (w, Qnil);
/* Update hint: No need to try to scroll in update_window. */
w->desired_matrix->no_scrolling_p = 1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
*w->desired_matrix->method = 0;
debug_method_add (w, "optimization 1");
#endif
@@ -13049,7 +13377,7 @@ redisplay_internal (void)
goto cancel;
}
else if (/* Cursor position hasn't changed. */
- PT == XFASTINT (w->last_point)
+ PT == w->last_point
/* Make sure the cursor was last displayed
in this window. Otherwise we have to reposition it. */
&& 0 <= w->cursor.vpos
@@ -13074,7 +13402,8 @@ redisplay_internal (void)
then we can't just move the cursor. */
else if (! (!NILP (Vtransient_mark_mode)
&& !NILP (BVAR (current_buffer, mark_active)))
- && (EQ (selected_window, BVAR (current_buffer, last_selected_window))
+ && (EQ (selected_window,
+ BVAR (current_buffer, last_selected_window))
|| highlight_nonselected_windows)
&& NILP (w->region_showing)
&& NILP (Vshow_trailing_whitespace)
@@ -13100,10 +13429,10 @@ redisplay_internal (void)
&& (row = MATRIX_ROW (w->current_matrix, this_line_vpos),
row->enabled_p))
{
- xassert (this_line_vpos == it.vpos);
- xassert (this_line_y == it.current_y);
+ eassert (this_line_vpos == it.vpos);
+ eassert (this_line_y == it.current_y);
set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
*w->desired_matrix->method = 0;
debug_method_add (w, "optimization 3");
#endif
@@ -13119,7 +13448,7 @@ redisplay_internal (void)
}
CHARPOS (this_line_start_pos) = 0;
- consider_all_windows_p |= buffer_shared > 1;
+ consider_all_windows_p |= buffer_shared_and_changed ();
++clear_face_cache_count;
#ifdef HAVE_WINDOW_SYSTEM
++clear_image_cache_count;
@@ -13131,8 +13460,6 @@ redisplay_internal (void)
if (consider_all_windows_p)
{
- Lisp_Object tail, frame;
-
FOR_EACH_FRAME (tail, frame)
XFRAME (frame)->updated_p = 0;
@@ -13144,6 +13471,12 @@ redisplay_internal (void)
{
struct frame *f = XFRAME (frame);
+ /* We don't have to do anything for unselected terminal
+ frames. */
+ if ((FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
+ && !EQ (FRAME_TTY (f)->top_frame, frame))
+ continue;
+
if (FRAME_WINDOW_P (f) || FRAME_TERMCAP_P (f) || f == sf)
{
if (! EQ (frame, selected_frame))
@@ -13206,7 +13539,8 @@ redisplay_internal (void)
and selected_window to be temporarily out-of-sync but let's make
sure this stays contained. */
select_frame_for_redisplay (old_frame);
- eassert (EQ (XFRAME (selected_frame)->selected_window, selected_window));
+ eassert (EQ (XFRAME (selected_frame)->selected_window,
+ selected_window));
if (!pending)
{
@@ -13227,7 +13561,7 @@ redisplay_internal (void)
}
else if (FRAME_VISIBLE_P (sf) && !FRAME_OBSCURED_P (sf))
{
- Lisp_Object mini_window;
+ Lisp_Object mini_window = FRAME_MINIBUF_WINDOW (sf);
struct frame *mini_frame;
displayed_buffer = XBUFFER (XWINDOW (selected_window)->buffer);
@@ -13236,6 +13570,10 @@ redisplay_internal (void)
internal_condition_case_1 (redisplay_window_1, selected_window,
list_of_error,
redisplay_window_error);
+ if (update_miniwindow_p)
+ internal_condition_case_1 (redisplay_window_1, mini_window,
+ list_of_error,
+ redisplay_window_error);
/* Compare desired and current matrices, perform output. */
@@ -13331,7 +13669,6 @@ redisplay_internal (void)
frames here explicitly. */
if (!pending)
{
- Lisp_Object tail, frame;
int new_count = 0;
FOR_EACH_FRAME (tail, frame)
@@ -13382,6 +13719,7 @@ redisplay_internal (void)
#endif /* HAVE_WINDOW_SYSTEM */
end_of_redisplay:
+ backtrace_list = backtrace.next;
unbind_to (count, Qnil);
RESUME_POLLING;
}
@@ -13420,21 +13758,15 @@ redisplay_preserve_echo_area (int from_where)
}
-/* Function registered with record_unwind_protect in
- redisplay_internal. Reset redisplaying_p to the value it had
- before redisplay_internal was called, and clear
- prevent_freeing_realized_faces_p. It also selects the previously
+/* Function registered with record_unwind_protect in redisplay_internal.
+ Clear redisplaying_p. Also, select the previously
selected frame, unless it has been deleted (by an X connection
failure during redisplay, for example). */
static Lisp_Object
-unwind_redisplay (Lisp_Object val)
+unwind_redisplay (Lisp_Object old_frame)
{
- Lisp_Object old_redisplaying_p, old_frame;
-
- old_redisplaying_p = XCAR (val);
- redisplaying_p = XFASTINT (old_redisplaying_p);
- old_frame = XCDR (val);
+ redisplaying_p = 0;
if (! EQ (old_frame, selected_frame)
&& FRAME_LIVE_P (XFRAME (old_frame)))
select_frame_for_redisplay (old_frame);
@@ -13454,12 +13786,10 @@ mark_window_display_accurate_1 (struct window *w, int accurate_p)
{
struct buffer *b = XBUFFER (w->buffer);
- w->last_modified
- = make_number (accurate_p ? BUF_MODIFF (b) : 0);
- w->last_overlay_modified
- = make_number (accurate_p ? BUF_OVERLAY_MODIFF (b) : 0);
+ w->last_modified = accurate_p ? BUF_MODIFF(b) : 0;
+ w->last_overlay_modified = accurate_p ? BUF_OVERLAY_MODIFF(b) : 0;
w->last_had_star
- = BUF_MODIFF (b) > BUF_SAVE_MODIFF (b) ? Qt : Qnil;
+ = BUF_MODIFF (b) > BUF_SAVE_MODIFF (b);
if (accurate_p)
{
@@ -13479,16 +13809,16 @@ mark_window_display_accurate_1 (struct window *w, int accurate_p)
w->last_cursor_off_p = w->cursor_off_p;
if (w == XWINDOW (selected_window))
- w->last_point = make_number (BUF_PT (b));
+ w->last_point = BUF_PT (b);
else
- w->last_point = make_number (XMARKER (w->pointm)->charpos);
+ w->last_point = XMARKER (w->pointm)->charpos;
}
}
if (accurate_p)
{
- w->window_end_valid = w->buffer;
- w->update_mode_line = Qnil;
+ wset_window_end_valid (w, w->buffer);
+ w->update_mode_line = 0;
}
}
@@ -13623,18 +13953,18 @@ redisplay_window_1 (Lisp_Object window)
static int
set_cursor_from_row (struct window *w, struct glyph_row *row,
struct glyph_matrix *matrix,
- EMACS_INT delta, EMACS_INT delta_bytes,
+ ptrdiff_t delta, ptrdiff_t delta_bytes,
int dy, int dvpos)
{
struct glyph *glyph = row->glyphs[TEXT_AREA];
struct glyph *end = glyph + row->used[TEXT_AREA];
struct glyph *cursor = NULL;
/* The last known character position in row. */
- EMACS_INT last_pos = MATRIX_ROW_START_CHARPOS (row) + delta;
+ ptrdiff_t last_pos = MATRIX_ROW_START_CHARPOS (row) + delta;
int x = row->x;
- EMACS_INT pt_old = PT - delta;
- EMACS_INT pos_before = MATRIX_ROW_START_CHARPOS (row) + delta;
- EMACS_INT pos_after = MATRIX_ROW_END_CHARPOS (row) + delta;
+ ptrdiff_t pt_old = PT - delta;
+ ptrdiff_t pos_before = MATRIX_ROW_START_CHARPOS (row) + delta;
+ ptrdiff_t pos_after = MATRIX_ROW_END_CHARPOS (row) + delta;
struct glyph *glyph_before = glyph - 1, *glyph_after = end;
/* A glyph beyond the edge of TEXT_AREA which we should never
touch. */
@@ -13645,17 +13975,24 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
/* Non-zero means we've seen at least one glyph that came from a
display string. */
int string_seen = 0;
- /* Largest and smalles buffer positions seen so far during scan of
+ /* Largest and smallest buffer positions seen so far during scan of
glyph row. */
- EMACS_INT bpos_max = pos_before;
- EMACS_INT bpos_min = pos_after;
+ ptrdiff_t bpos_max = pos_before;
+ ptrdiff_t bpos_min = pos_after;
/* Last buffer position covered by an overlay string with an integer
`cursor' property. */
- EMACS_INT bpos_covered = 0;
+ ptrdiff_t bpos_covered = 0;
/* Non-zero means the display string on which to display the cursor
comes from a text property, not from an overlay. */
int string_from_text_prop = 0;
+ /* Don't even try doing anything if called for a mode-line or
+ header-line row, since the rest of the code isn't prepared to
+ deal with such calamities. */
+ eassert (!row->mode_line_p);
+ if (row->mode_line_p)
+ return 0;
+
/* Skip over glyphs not having an object at the start and the end of
the row. These are special glyphs like truncation marks on
terminal frames. */
@@ -13737,7 +14074,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
{
if (BUFFERP (glyph->object))
{
- EMACS_INT dpos = glyph->charpos - pt_old;
+ ptrdiff_t dpos = glyph->charpos - pt_old;
if (glyph->charpos > bpos_max)
bpos_max = glyph->charpos;
@@ -13753,16 +14090,13 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
break;
}
/* See if we've found a better approximation to
- POS_BEFORE or to POS_AFTER. Note that we want the
- first (leftmost) glyph of all those that are the
- closest from below, and the last (rightmost) of all
- those from above. */
+ POS_BEFORE or to POS_AFTER. */
if (0 > dpos && dpos > pos_before - pt_old)
{
pos_before = glyph->charpos;
glyph_before = glyph;
}
- else if (0 < dpos && dpos <= pos_after - pt_old)
+ else if (0 < dpos && dpos < pos_after - pt_old)
{
pos_after = glyph->charpos;
glyph_after = glyph;
@@ -13774,20 +14108,35 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
else if (STRINGP (glyph->object))
{
Lisp_Object chprop;
- EMACS_INT glyph_pos = glyph->charpos;
+ ptrdiff_t glyph_pos = glyph->charpos;
chprop = Fget_char_property (make_number (glyph_pos), Qcursor,
glyph->object);
+ if (!NILP (chprop))
+ {
+ /* If the string came from a `display' text property,
+ look up the buffer position of that property and
+ use that position to update bpos_max, as if we
+ actually saw such a position in one of the row's
+ glyphs. This helps with supporting integer values
+ of `cursor' property on the display string in
+ situations where most or all of the row's buffer
+ text is completely covered by display properties,
+ so that no glyph with valid buffer positions is
+ ever seen in the row. */
+ ptrdiff_t prop_pos =
+ string_buffer_position_lim (glyph->object, pos_before,
+ pos_after, 0);
+
+ if (prop_pos >= pos_before)
+ bpos_max = prop_pos - 1;
+ }
if (INTEGERP (chprop))
{
bpos_covered = bpos_max + XINT (chprop);
/* If the `cursor' property covers buffer positions up
to and including point, we should display cursor on
- this glyph. Note that overlays and text properties
- with string values stop bidi reordering, so every
- buffer position to the left of the string is always
- smaller than any position to the right of the
- string. Therefore, if a `cursor' property on one
+ this glyph. Note that, if a `cursor' property on one
of the string's characters has an integer value, we
will break out of the loop below _before_ we get to
the position match above. IOW, integer values of
@@ -13813,7 +14162,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
{
if (BUFFERP (glyph->object))
{
- EMACS_INT dpos = glyph->charpos - pt_old;
+ ptrdiff_t dpos = glyph->charpos - pt_old;
if (glyph->charpos > bpos_max)
bpos_max = glyph->charpos;
@@ -13831,7 +14180,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
pos_before = glyph->charpos;
glyph_before = glyph;
}
- else if (0 < dpos && dpos <= pos_after - pt_old)
+ else if (0 < dpos && dpos < pos_after - pt_old)
{
pos_after = glyph->charpos;
glyph_after = glyph;
@@ -13843,10 +14192,19 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
else if (STRINGP (glyph->object))
{
Lisp_Object chprop;
- EMACS_INT glyph_pos = glyph->charpos;
+ ptrdiff_t glyph_pos = glyph->charpos;
chprop = Fget_char_property (make_number (glyph_pos), Qcursor,
glyph->object);
+ if (!NILP (chprop))
+ {
+ ptrdiff_t prop_pos =
+ string_buffer_position_lim (glyph->object, pos_before,
+ pos_after, 0);
+
+ if (prop_pos >= pos_before)
+ bpos_max = prop_pos - 1;
+ }
if (INTEGERP (chprop))
{
bpos_covered = bpos_max + XINT (chprop);
@@ -13875,7 +14233,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
GLYPH_BEFORE and GLYPH_AFTER. */
if (!((row->reversed_p ? glyph > glyphs_end : glyph < glyphs_end)
&& BUFFERP (glyph->object) && glyph->charpos == pt_old)
- && bpos_covered < pt_old)
+ && !(bpos_max < pt_old && pt_old <= bpos_covered))
{
/* An empty line has a single glyph whose OBJECT is zero and
whose CHARPOS is the position of a newline on that line.
@@ -13888,7 +14246,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
if (row->ends_in_ellipsis_p && pos_after == last_pos)
{
- EMACS_INT ellipsis_pos;
+ ptrdiff_t ellipsis_pos;
/* Scan back over the ellipsis glyphs. */
if (!row->reversed_p)
@@ -13928,7 +14286,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
positioned between POS_BEFORE and POS_AFTER in the
buffer. */
struct glyph *start, *stop;
- EMACS_INT pos = pos_before;
+ ptrdiff_t pos = pos_before;
x = -1;
@@ -13971,10 +14329,10 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
if (STRINGP (glyph->object))
{
Lisp_Object str;
- EMACS_INT tem;
+ ptrdiff_t tem;
/* If the display property covers the newline, we
need to search for it one position farther. */
- EMACS_INT lim = pos_after
+ ptrdiff_t lim = pos_after
+ (pos_after == MATRIX_ROW_END_CHARPOS (row) + delta);
string_from_text_prop = 0;
@@ -13984,15 +14342,18 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
|| pos <= tem)
{
/* If the string from which this glyph came is
- found in the buffer at point, then we've
- found the glyph we've been looking for. If
- it comes from an overlay (tem == 0), and it
- has the `cursor' property on one of its
+ found in the buffer at point, or at position
+ that is closer to point than pos_after, then
+ we've found the glyph we've been looking for.
+ If it comes from an overlay (tem == 0), and
+ it has the `cursor' property on one of its
glyphs, record that glyph as a candidate for
displaying the cursor. (As in the
unidirectional version, we will display the
cursor on the last candidate we find.) */
- if (tem == 0 || tem == pt_old)
+ if (tem == 0
+ || tem == pt_old
+ || (tem - pt_old > 0 && tem < pos_after))
{
/* The glyphs from this string could have
been reordered. Find the one with the
@@ -14000,7 +14361,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
be a character in the string with the
`cursor' property, which means display
cursor on that character's glyph. */
- EMACS_INT strpos = glyph->charpos;
+ ptrdiff_t strpos = glyph->charpos;
if (tem)
{
@@ -14013,7 +14374,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
glyph += incr)
{
Lisp_Object cprop;
- EMACS_INT gpos = glyph->charpos;
+ ptrdiff_t gpos = glyph->charpos;
cprop = Fget_char_property (make_number (gpos),
Qcursor,
@@ -14030,7 +14391,8 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
}
}
- if (tem == pt_old)
+ if (tem == pt_old
+ || (tem - pt_old > 0 && tem < pos_after))
goto compute_x;
}
if (tem)
@@ -14050,6 +14412,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
the cursor is not on this line. */
if (cursor == NULL
&& (row->reversed_p ? glyph <= end : glyph >= end)
+ && (row->reversed_p ? end > glyphs_end : end < glyphs_end)
&& STRINGP (end->object)
&& row->continued_p)
return 0;
@@ -14079,6 +14442,21 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
compute_x:
if (cursor != NULL)
glyph = cursor;
+ else if (glyph == glyphs_end
+ && pos_before == pos_after
+ && STRINGP ((row->reversed_p
+ ? row->glyphs[TEXT_AREA] + row->used[TEXT_AREA] - 1
+ : row->glyphs[TEXT_AREA])->object))
+ {
+ /* If all the glyphs of this row came from strings, put the
+ cursor on the first glyph of the row. This avoids having the
+ cursor outside of the text area in this very rare and hard
+ use case. */
+ glyph =
+ row->reversed_p
+ ? row->glyphs[TEXT_AREA] + row->used[TEXT_AREA] - 1
+ : row->glyphs[TEXT_AREA];
+ }
if (x < 0)
{
struct glyph *g;
@@ -14087,7 +14465,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
for (g = row->glyphs[TEXT_AREA], x = row->x; g < glyph; g++)
{
if (g >= row->glyphs[TEXT_AREA] + row->used[TEXT_AREA])
- abort ();
+ emacs_abort ();
x += g->pixel_width;
}
}
@@ -14201,14 +14579,14 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
We assume that the window's buffer is really current. */
-static inline struct text_pos
+static struct text_pos
run_window_scroll_functions (Lisp_Object window, struct text_pos startp)
{
struct window *w = XWINDOW (window);
SET_MARKER_FROM_TEXT_POS (w->start, startp);
if (current_buffer != XBUFFER (w->buffer))
- abort ();
+ emacs_abort ();
if (!NILP (Vwindow_scroll_functions))
{
@@ -14216,8 +14594,7 @@ run_window_scroll_functions (Lisp_Object window, struct text_pos startp)
make_number (CHARPOS (startp)));
SET_TEXT_POS_FROM_MARKER (startp, w->start);
/* In case the hook functions switch buffers. */
- if (current_buffer != XBUFFER (w->buffer))
- set_buffer_internal_1 (XBUFFER (w->buffer));
+ set_buffer_internal (XBUFFER (w->buffer));
}
return startp;
@@ -14303,7 +14680,7 @@ enum
static int
try_scrolling (Lisp_Object window, int just_this_one_p,
- EMACS_INT arg_scroll_conservatively, EMACS_INT scroll_step,
+ ptrdiff_t arg_scroll_conservatively, ptrdiff_t scroll_step,
int temp_scroll_step, int last_line_misfit)
{
struct window *w = XWINDOW (window);
@@ -14317,7 +14694,7 @@ try_scrolling (Lisp_Object window, int just_this_one_p,
/* We will never try scrolling more than this number of lines. */
int scroll_limit = SCROLL_LIMIT;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "try_scrolling");
#endif
@@ -14415,13 +14792,18 @@ try_scrolling (Lisp_Object window, int just_this_one_p,
if (NUMBERP (aggressive))
{
double float_amount = XFLOATINT (aggressive) * height;
- amount_to_scroll = float_amount;
- if (amount_to_scroll == 0 && float_amount > 0)
- amount_to_scroll = 1;
+ int aggressive_scroll = float_amount;
+ if (aggressive_scroll == 0 && float_amount > 0)
+ aggressive_scroll = 1;
/* Don't let point enter the scroll margin near top of
- the window. */
- if (amount_to_scroll > height - 2*this_scroll_margin + dy)
- amount_to_scroll = height - 2*this_scroll_margin + dy;
+ the window. This could happen if the value of
+ scroll_up_aggressively is too large and there are
+ non-zero margins, because scroll_up_aggressively
+ means put point that fraction of window height
+ _from_the_bottom_margin_. */
+ if (aggressive_scroll + 2*this_scroll_margin > height)
+ aggressive_scroll = height - 2*this_scroll_margin;
+ amount_to_scroll = dy + aggressive_scroll;
}
}
@@ -14481,7 +14863,8 @@ try_scrolling (Lisp_Object window, int just_this_one_p,
/* Compute the vertical distance from PT to the scroll
margin position. Move as far as scroll_max allows, or
one screenful, or 10 screen lines, whichever is largest.
- Give up if distance is greater than scroll_max. */
+ Give up if distance is greater than scroll_max or if we
+ didn't reach the scroll margin position. */
SET_TEXT_POS (pos, PT, PT_BYTE);
start_display (&it, w, pos);
y0 = it.current_y;
@@ -14491,7 +14874,8 @@ try_scrolling (Lisp_Object window, int just_this_one_p,
y_to_move, -1,
MOVE_TO_POS | MOVE_TO_X | MOVE_TO_Y);
dy = it.current_y - y0;
- if (dy > scroll_max)
+ if (dy > scroll_max
+ || IT_CHARPOS (it) < CHARPOS (scroll_margin_pos))
return SCROLLING_FAILED;
/* Compute new window start. */
@@ -14509,15 +14893,16 @@ try_scrolling (Lisp_Object window, int just_this_one_p,
if (NUMBERP (aggressive))
{
double float_amount = XFLOATINT (aggressive) * height;
- amount_to_scroll = float_amount;
- if (amount_to_scroll == 0 && float_amount > 0)
- amount_to_scroll = 1;
- amount_to_scroll -=
- this_scroll_margin - dy - FRAME_LINE_HEIGHT (f);
+ int aggressive_scroll = float_amount;
+ if (aggressive_scroll == 0 && float_amount > 0)
+ aggressive_scroll = 1;
/* Don't let point enter the scroll margin near
- bottom of the window. */
- if (amount_to_scroll > height - 2*this_scroll_margin + dy)
- amount_to_scroll = height - 2*this_scroll_margin + dy;
+ bottom of the window, if the value of
+ scroll_down_aggressively happens to be too
+ large. */
+ if (aggressive_scroll + 2*this_scroll_margin > height)
+ aggressive_scroll = height - 2*this_scroll_margin;
+ amount_to_scroll = dy + aggressive_scroll;
}
}
@@ -14547,7 +14932,7 @@ try_scrolling (Lisp_Object window, int just_this_one_p,
if (!just_this_one_p
|| current_buffer->clip_changed
|| BEG_UNCHANGED < CHARPOS (startp))
- w->base_line_number = Qnil;
+ wset_base_line_number (w, Qnil);
/* If cursor ends up on a partially visible line,
treat that as being off the bottom of the screen. */
@@ -14669,11 +15054,16 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
struct frame *f = XFRAME (w->frame);
int rc = CURSOR_MOVEMENT_CANNOT_BE_USED;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
if (inhibit_try_cursor_movement)
return rc;
#endif
+ /* Previously, there was a check for Lisp integer in the
+ if-statement below. Now, this field is converted to
+ ptrdiff_t, thus zero means invalid position in a buffer. */
+ eassert (w->last_point > 0);
+
/* Handle case where text has not changed, only point, and it has
not moved off the frame. */
if (/* Point may be in this window. */
@@ -14694,8 +15084,6 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
&& !NILP (BVAR (current_buffer, mark_active)))
&& NILP (w->region_showing)
&& NILP (Vshow_trailing_whitespace)
- /* Right after splitting windows, last_point may be nil. */
- && INTEGERP (w->last_point)
/* This code is not used for mini-buffer for the sake of the case
of redisplaying to replace an echo area message; since in
that case the mini-buffer contents per se are usually
@@ -14716,7 +15104,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
int this_scroll_margin, top_scroll_margin;
struct glyph_row *row = NULL;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "cursor movement");
#endif
@@ -14753,13 +15141,13 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
int scroll_p = 0, must_scroll = 0;
int last_y = window_text_bottom_y (w) - this_scroll_margin;
- if (PT > XFASTINT (w->last_point))
+ if (PT > w->last_point)
{
/* Point has moved forward. */
while (MATRIX_ROW_END_CHARPOS (row) < PT
&& MATRIX_ROW_BOTTOM_Y (row) < last_y)
{
- xassert (row->enabled_p);
+ eassert (row->enabled_p);
++row;
}
@@ -14788,7 +15176,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
&& !MATRIX_ROW_ENDS_IN_MIDDLE_OF_CHAR_P (row)))
scroll_p = 1;
}
- else if (PT < XFASTINT (w->last_point))
+ else if (PT < w->last_point)
{
/* Cursor has to be moved backward. Note that PT >=
CHARPOS (startp) because of the outer if-statement. */
@@ -14802,7 +15190,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
&& (row->y > top_scroll_margin
|| CHARPOS (startp) == BEGV))
{
- xassert (row->enabled_p);
+ eassert (row->enabled_p);
--row;
}
@@ -14848,6 +15236,8 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
else if (rc != CURSOR_MOVEMENT_SUCCESS
&& !NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)))
{
+ struct glyph_row *row1;
+
/* If rows are bidi-reordered and point moved, back up
until we find a row that does not belong to a
continuation line. This is because we must consider
@@ -14858,24 +15248,28 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
/* FIXME: Revisit this when glyph ``spilling'' in
continuation lines' rows is implemented for
bidi-reordered rows. */
- while (MATRIX_ROW_CONTINUATION_LINE_P (row))
+ for (row1 = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
+ MATRIX_ROW_CONTINUATION_LINE_P (row);
+ --row)
{
/* If we hit the beginning of the displayed portion
without finding the first row of a continued
line, give up. */
- if (row <= w->current_matrix->rows)
+ if (row <= row1)
{
rc = CURSOR_MOVEMENT_MUST_SCROLL;
break;
}
- xassert (row->enabled_p);
- --row;
+ eassert (row->enabled_p);
}
}
if (must_scroll)
;
else if (rc != CURSOR_MOVEMENT_SUCCESS
&& MATRIX_ROW_PARTIALLY_VISIBLE_P (w, row)
+ /* Make sure this isn't a header line by any chance, since
+ then MATRIX_ROW_PARTIALLY_VISIBLE_P might yield non-zero. */
+ && !row->mode_line_p
&& make_cursor_line_fully_visible_p)
{
if (PT == MATRIX_ROW_END_CHARPOS (row)
@@ -14937,7 +15331,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
MATRIX_ROW (w->current_matrix, w->cursor.vpos);
struct glyph *g =
candidate->glyphs[TEXT_AREA] + w->cursor.hpos;
- EMACS_INT endpos = MATRIX_ROW_END_CHARPOS (candidate);
+ ptrdiff_t endpos = MATRIX_ROW_END_CHARPOS (candidate);
exact_match_p =
(BUFFERP (g->object) && g->charpos == PT)
@@ -14997,7 +15391,7 @@ static
void
set_vertical_scroll_bar (struct window *w)
{
- EMACS_INT start, end, whole;
+ ptrdiff_t start, end, whole;
/* Calculate the start and end positions for the current window.
At some point, it would be nice to choose between scrollbars
@@ -15036,7 +15430,7 @@ set_vertical_scroll_bar (struct window *w)
selected_window is redisplayed.
We can return without actually redisplaying the window if
- fonts_changed_p is nonzero. In that case, redisplay_internal will
+ fonts_changed_p. In that case, redisplay_internal will
retry. */
static void
@@ -15057,18 +15451,18 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
It indicates that the buffer contents and narrowing are unchanged. */
int buffer_unchanged_p = 0;
int temp_scroll_step = 0;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int rc;
int centering_position = -1;
int last_line_misfit = 0;
- EMACS_INT beg_unchanged, end_unchanged;
+ ptrdiff_t beg_unchanged, end_unchanged;
SET_TEXT_POS (lpoint, PT, PT_BYTE);
opoint = lpoint;
/* W must be a leaf window here. */
- xassert (!NILP (w->buffer));
-#if GLYPH_DEBUG
+ eassert (!NILP (w->buffer));
+#ifdef GLYPH_DEBUG
*w->desired_matrix->method = 0;
#endif
@@ -15076,7 +15470,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
reconsider_clip_changes (w, buffer);
/* Has the mode line to be updated? */
- update_mode_line = (!NILP (w->update_mode_line)
+ update_mode_line = (w->update_mode_line
|| update_mode_lines
|| buffer->clip_changed
|| buffer->prevent_redisplay_optimizations_p);
@@ -15128,8 +15522,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
= (!NILP (w->window_end_valid)
&& !current_buffer->clip_changed
&& !current_buffer->prevent_redisplay_optimizations_p
- && XFASTINT (w->last_modified) >= MODIFF
- && XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF);
+ && !window_outdated (w));
/* Run the window-bottom-change-functions
if it is possible that the text on the screen has changed
@@ -15151,8 +15544,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
buffer_unchanged_p
= (!NILP (w->window_end_valid)
&& !current_buffer->clip_changed
- && XFASTINT (w->last_modified) >= MODIFF
- && XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF);
+ && !window_outdated (w));
/* When windows_or_buffers_changed is non-zero, we can't rely on
the window end being valid, so set it to nil there. */
@@ -15163,23 +15555,21 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
if (XMARKER (w->start)->buffer == current_buffer)
compute_window_start_on_continuation_line (w);
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
}
/* Some sanity checks. */
CHECK_WINDOW_END (w);
if (Z == Z_BYTE && CHARPOS (opoint) != BYTEPOS (opoint))
- abort ();
+ emacs_abort ();
if (BYTEPOS (opoint) < CHARPOS (opoint))
- abort ();
+ emacs_abort ();
/* If %c is in mode line, update it if needed. */
if (!NILP (w->column_number_displayed)
/* This alternative quickly identifies a common case
where no change is needed. */
- && !(PT == XFASTINT (w->last_point)
- && XFASTINT (w->last_modified) >= MODIFF
- && XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF)
+ && !(PT == w->last_point && !window_outdated (w))
&& (XFASTINT (w->column_number_displayed) != current_column ()))
update_mode_line = 1;
@@ -15202,8 +15592,8 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
window, set up appropriate value. */
if (!EQ (window, selected_window))
{
- EMACS_INT new_pt = XMARKER (w->pointm)->charpos;
- EMACS_INT new_pt_byte = marker_byte_position (w->pointm);
+ ptrdiff_t new_pt = XMARKER (w->pointm)->charpos;
+ ptrdiff_t new_pt_byte = marker_byte_position (w->pointm);
if (new_pt < BEGV)
{
new_pt = BEGV;
@@ -15230,8 +15620,8 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
{
struct Lisp_Char_Table *disptab = buffer_display_table ();
- if (! disptab_matches_widthtab (disptab,
- XVECTOR (BVAR (current_buffer, width_table))))
+ if (! disptab_matches_widthtab
+ (disptab, XVECTOR (BVAR (current_buffer, width_table))))
{
invalidate_region_cache (current_buffer,
current_buffer->width_run_cache,
@@ -15248,38 +15638,37 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
/* If someone specified a new starting point but did not insist,
check whether it can be used. */
- if (!NILP (w->optional_new_start)
+ if (w->optional_new_start
&& CHARPOS (startp) >= BEGV
&& CHARPOS (startp) <= ZV)
{
- w->optional_new_start = Qnil;
+ w->optional_new_start = 0;
start_display (&it, w, startp);
move_it_to (&it, PT, 0, it.last_visible_y, -1,
MOVE_TO_POS | MOVE_TO_X | MOVE_TO_Y);
if (IT_CHARPOS (it) == PT)
- w->force_start = Qt;
+ w->force_start = 1;
/* IT may overshoot PT if text at PT is invisible. */
else if (IT_CHARPOS (it) > PT && CHARPOS (startp) <= PT)
- w->force_start = Qt;
+ w->force_start = 1;
}
force_start:
/* Handle case where place to start displaying has been specified,
unless the specified location is outside the accessible range. */
- if (!NILP (w->force_start)
- || w->frozen_window_start_p)
+ if (w->force_start || w->frozen_window_start_p)
{
/* We set this later on if we have to adjust point. */
int new_vpos = -1;
- w->force_start = Qnil;
+ w->force_start = 0;
w->vscroll = 0;
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
/* Forget any recorded base line for line number display. */
if (!buffer_unchanged_p)
- w->base_line_number = Qnil;
+ wset_base_line_number (w, Qnil);
/* Redisplay the mode line. Select the buffer properly for that.
Also, run the hook window-scroll-functions
@@ -15292,12 +15681,12 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
|| ! NILP (Vwindow_scroll_functions))
{
update_mode_line = 1;
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
startp = run_window_scroll_functions (window, startp);
}
- w->last_modified = make_number (0);
- w->last_overlay_modified = make_number (0);
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
if (CHARPOS (startp) < BEGV)
SET_TEXT_POS (startp, BEGV, BEGV_BYTE);
else if (CHARPOS (startp) > ZV)
@@ -15310,7 +15699,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
the scroll margin (bug#148) -- cyd */
if (!try_window (window, startp, 0))
{
- w->force_start = Qt;
+ w->force_start = 1;
clear_glyph_matrix (w->desired_matrix);
goto need_larger_matrices;
}
@@ -15361,7 +15750,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
}
}
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "forced window start");
#endif
goto done;
@@ -15384,16 +15773,16 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
goto try_to_scroll;
default:
- abort ();
+ emacs_abort ();
}
}
/* If current starting point was originally the beginning of a line
but no longer is, find a new starting point. */
- else if (!NILP (w->start_at_line_beg)
+ else if (w->start_at_line_beg
&& !(CHARPOS (startp) <= BEGV
|| FETCH_BYTE (BYTEPOS (startp) - 1) == '\n'))
{
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "recenter 1");
#endif
goto recenter;
@@ -15404,7 +15793,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
not work. It is 0 if unsuccessful for some other reason. */
else if ((tem = try_window_id (w)) != 0)
{
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "try_window_id %d", tem);
#endif
@@ -15422,8 +15811,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
&& (CHARPOS (startp) < ZV
/* Avoid starting at end of buffer. */
|| CHARPOS (startp) == BEGV
- || (XFASTINT (w->last_modified) >= MODIFF
- && XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF)))
+ || !window_outdated (w)))
{
int d1, d2, d3, d4, d5, d6;
@@ -15436,7 +15824,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
new window start, since that would change the position under
the mouse, resulting in an unwanted mouse-movement rather
than a simple mouse-click. */
- if (NILP (w->start_at_line_beg)
+ if (!w->start_at_line_beg
&& NILP (do_mouse_tracking)
&& CHARPOS (startp) > BEGV
&& CHARPOS (startp) > BEG + beg_unchanged
@@ -15456,12 +15844,12 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
See bug#9324. */
&& pos_visible_p (w, PT, &d1, &d2, &d3, &d4, &d5, &d6))
{
- w->force_start = Qt;
+ w->force_start = 1;
SET_TEXT_POS_FROM_MARKER (startp, w->start);
goto force_start;
}
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "same window start");
#endif
@@ -15493,7 +15881,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
|| current_buffer->clip_changed
|| BEG_UNCHANGED < CHARPOS (startp))
/* Forget any recorded base line for line number display. */
- w->base_line_number = Qnil;
+ wset_base_line_number (w, Qnil);
if (!cursor_row_fully_visible_p (w, 1, 0))
{
@@ -15510,14 +15898,14 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
try_to_scroll:
- w->last_modified = make_number (0);
- w->last_overlay_modified = make_number (0);
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
/* Redisplay the mode line. Select the buffer properly for that. */
if (!update_mode_line)
{
update_mode_line = 1;
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
}
/* Try to scroll by specified few lines. */
@@ -15547,7 +15935,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
break;
default:
- abort ();
+ emacs_abort ();
}
}
@@ -15556,7 +15944,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
recenter:
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "recenter");
#endif
@@ -15564,7 +15952,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
/* Forget any previously recorded base line for line number display. */
if (!buffer_unchanged_p)
- w->base_line_number = Qnil;
+ wset_base_line_number (w, Qnil);
/* Determine the window start relative to point. */
init_iterator (&it, w, PT, PT_BYTE, NULL, DEFAULT_FACE_ID);
@@ -15575,7 +15963,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
scroll_margin > 0
? min (scroll_margin, WINDOW_TOTAL_LINES (w) / 4)
: 0;
- EMACS_INT margin_pos = CHARPOS (startp);
+ ptrdiff_t margin_pos = CHARPOS (startp);
Lisp_Object aggressive;
int scrolling_up;
@@ -15586,7 +15974,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
accessible region of the buffer. This can happen when we
have just switched to a different buffer and/or changed
its restriction. In that case, startp is initialized to
- the character position 1 (BEG) because we did not yet
+ the character position 1 (BEGV) because we did not yet
have chance to display the buffer even once. */
&& BEGV <= CHARPOS (startp) && CHARPOS (startp) <= ZV)
{
@@ -15595,7 +15983,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
SAVE_IT (it1, it, it1data);
start_display (&it1, w, startp);
- move_it_vertically (&it1, margin);
+ move_it_vertically (&it1, margin * FRAME_LINE_HEIGHT (f));
margin_pos = IT_CHARPOS (it1);
RESTORE_IT (&it, &it, it1data);
}
@@ -15648,7 +16036,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
}
move_it_vertically_backward (&it, centering_position);
- xassert (IT_CHARPOS (it) >= BEGV);
+ eassert (IT_CHARPOS (it) >= BEGV);
/* The function move_it_vertically_backward may move over more
than the specified y-distance. If it->w is small, e.g. a
@@ -15772,9 +16160,8 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
done:
SET_TEXT_POS_FROM_MARKER (startp, w->start);
- w->start_at_line_beg = ((CHARPOS (startp) == BEGV
- || FETCH_BYTE (BYTEPOS (startp) - 1) == '\n')
- ? Qt : Qnil);
+ w->start_at_line_beg = (CHARPOS (startp) == BEGV
+ || FETCH_BYTE (BYTEPOS (startp) - 1) == '\n');
/* Display the mode line, if we must. */
if ((update_mode_line
@@ -15823,8 +16210,8 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
if (!line_number_displayed
&& !BUFFERP (w->base_line_pos))
{
- w->base_line_pos = Qnil;
- w->base_line_number = Qnil;
+ wset_base_line_pos (w, Qnil);
+ wset_base_line_number (w, Qnil);
}
finish_menu_bars:
@@ -15874,15 +16261,15 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
|| w->pseudo_window_p)))
{
update_begin (f);
- BLOCK_INPUT;
+ block_input ();
if (draw_window_fringes (w, 1))
x_draw_vertical_border (w);
- UNBLOCK_INPUT;
+ unblock_input ();
update_end (f);
}
#endif /* HAVE_WINDOW_SYSTEM */
- /* We go to this label, with fonts_changed_p nonzero,
+ /* We go to this label, with fonts_changed_p set,
if it is necessary to try again using larger glyph matrices.
We have to redeem the scroll bar even in this case,
because the loop in redisplay_internal expects that. */
@@ -15991,32 +16378,33 @@ try_window (Lisp_Object window, struct text_pos pos, int flags)
/* If bottom moved off end of frame, change mode line percentage. */
if (XFASTINT (w->window_end_pos) <= 0
&& Z != IT_CHARPOS (it))
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
/* Set window_end_pos to the offset of the last character displayed
on the window from the end of current_buffer. Set
window_end_vpos to its row number. */
if (last_text_row)
{
- xassert (MATRIX_ROW_DISPLAYS_TEXT_P (last_text_row));
+ eassert (MATRIX_ROW_DISPLAYS_TEXT_P (last_text_row));
w->window_end_bytepos
= Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_text_row);
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row));
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix));
- xassert (MATRIX_ROW (w->desired_matrix, XFASTINT (w->window_end_vpos))
- ->displays_text_p);
+ wset_window_end_pos
+ (w, make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row)));
+ wset_window_end_vpos
+ (w, make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix)));
+ eassert
+ (MATRIX_ROW (w->desired_matrix,
+ XFASTINT (w->window_end_vpos))->displays_text_p);
}
else
{
w->window_end_bytepos = Z_BYTE - ZV_BYTE;
- w->window_end_pos = make_number (Z - ZV);
- w->window_end_vpos = make_number (0);
+ wset_window_end_pos (w, make_number (Z - ZV));
+ wset_window_end_vpos (w, make_number (0));
}
/* But that is not valid info until redisplay finishes. */
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
return 1;
}
@@ -16045,7 +16433,7 @@ try_window_reusing_current_matrix (struct window *w)
struct glyph_row *start_row;
int start_vpos, min_y, max_y;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
if (inhibit_try_window_reusing)
return 0;
#endif
@@ -16240,34 +16628,36 @@ try_window_reusing_current_matrix (struct window *w)
{
w->window_end_bytepos
= Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_reused_text_row);
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (last_reused_text_row));
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (last_reused_text_row,
- w->current_matrix));
+ wset_window_end_pos
+ (w, make_number (Z
+ - MATRIX_ROW_END_CHARPOS (last_reused_text_row)));
+ wset_window_end_vpos
+ (w, make_number (MATRIX_ROW_VPOS (last_reused_text_row,
+ w->current_matrix)));
}
else if (last_text_row)
{
w->window_end_bytepos
= Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_text_row);
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row));
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix));
+ wset_window_end_pos
+ (w, make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row)));
+ wset_window_end_vpos
+ (w, make_number (MATRIX_ROW_VPOS (last_text_row,
+ w->desired_matrix)));
}
else
{
/* This window must be completely empty. */
w->window_end_bytepos = Z_BYTE - ZV_BYTE;
- w->window_end_pos = make_number (Z - ZV);
- w->window_end_vpos = make_number (0);
+ wset_window_end_pos (w, make_number (Z - ZV));
+ wset_window_end_vpos (w, make_number (0));
}
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
/* Update hint: don't try scrolling again in update_window. */
w->desired_matrix->no_scrolling_p = 1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "try_window_reusing_current_matrix 1");
#endif
return 1;
@@ -16306,12 +16696,15 @@ try_window_reusing_current_matrix (struct window *w)
++first_row_to_display)
{
if (PT >= MATRIX_ROW_START_CHARPOS (first_row_to_display)
- && PT < MATRIX_ROW_END_CHARPOS (first_row_to_display))
+ && (PT < MATRIX_ROW_END_CHARPOS (first_row_to_display)
+ || (PT == MATRIX_ROW_END_CHARPOS (first_row_to_display)
+ && first_row_to_display->ends_at_zv_p
+ && pt_row == NULL)))
pt_row = first_row_to_display;
}
/* Start displaying at the start of first_row_to_display. */
- xassert (first_row_to_display->y < yb);
+ eassert (first_row_to_display->y < yb);
init_to_row_start (&it, w, first_row_to_display);
nrows_scrolled = (MATRIX_ROW_VPOS (first_reusable_row, w->current_matrix)
@@ -16383,7 +16776,7 @@ try_window_reusing_current_matrix (struct window *w)
}
/* Scroll the current matrix. */
- xassert (nrows_scrolled > 0);
+ eassert (nrows_scrolled > 0);
rotate_matrix (w->current_matrix,
start_vpos,
MATRIX_ROW_VPOS (bottom_row, w->current_matrix),
@@ -16398,7 +16791,9 @@ try_window_reusing_current_matrix (struct window *w)
if (pt_row)
{
for (row = MATRIX_ROW (w->current_matrix, w->cursor.vpos);
- row < bottom_row && PT >= MATRIX_ROW_END_CHARPOS (row);
+ row < bottom_row
+ && PT >= MATRIX_ROW_END_CHARPOS (row)
+ && !row->ends_at_zv_p;
row++)
{
w->cursor.vpos++;
@@ -16406,28 +16801,33 @@ try_window_reusing_current_matrix (struct window *w)
}
if (row < bottom_row)
{
- struct glyph *glyph = row->glyphs[TEXT_AREA] + w->cursor.hpos;
- struct glyph *end = row->glyphs[TEXT_AREA] + row->used[TEXT_AREA];
-
- /* Can't use this optimization with bidi-reordered glyph
- rows, unless cursor is already at point. */
+ /* Can't simply scan the row for point with
+ bidi-reordered glyph rows. Let set_cursor_from_row
+ figure out where to put the cursor, and if it fails,
+ give up. */
if (!NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)))
{
- if (!(w->cursor.hpos >= 0
- && w->cursor.hpos < row->used[TEXT_AREA]
- && BUFFERP (glyph->object)
- && glyph->charpos == PT))
- return 0;
+ if (!set_cursor_from_row (w, row, w->current_matrix,
+ 0, 0, 0, 0))
+ {
+ clear_glyph_matrix (w->desired_matrix);
+ return 0;
+ }
}
else
- for (; glyph < end
- && (!BUFFERP (glyph->object)
- || glyph->charpos < PT);
- glyph++)
- {
- w->cursor.hpos++;
- w->cursor.x += glyph->pixel_width;
- }
+ {
+ struct glyph *glyph = row->glyphs[TEXT_AREA] + w->cursor.hpos;
+ struct glyph *end = row->glyphs[TEXT_AREA] + row->used[TEXT_AREA];
+
+ for (; glyph < end
+ && (!BUFFERP (glyph->object)
+ || glyph->charpos < PT);
+ glyph++)
+ {
+ w->cursor.hpos++;
+ w->cursor.x += glyph->pixel_width;
+ }
+ }
}
}
@@ -16438,21 +16838,22 @@ try_window_reusing_current_matrix (struct window *w)
{
w->window_end_bytepos
= Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_text_row);
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row));
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix));
+ wset_window_end_pos
+ (w, make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row)));
+ wset_window_end_vpos
+ (w, make_number (MATRIX_ROW_VPOS (last_text_row,
+ w->desired_matrix)));
}
else
{
- w->window_end_vpos
- = make_number (XFASTINT (w->window_end_vpos) - nrows_scrolled);
+ wset_window_end_vpos
+ (w, make_number (XFASTINT (w->window_end_vpos) - nrows_scrolled));
}
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
w->desired_matrix->no_scrolling_p = 1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "try_window_reusing_current_matrix 2");
#endif
return 1;
@@ -16469,7 +16870,7 @@ try_window_reusing_current_matrix (struct window *w)
static struct glyph_row *find_last_unchanged_at_beg_row (struct window *);
static struct glyph_row *find_first_unchanged_at_end_row (struct window *,
- EMACS_INT *, EMACS_INT *);
+ ptrdiff_t *, ptrdiff_t *);
static struct glyph_row *
find_last_row_displaying_text (struct glyph_matrix *, struct it *,
struct glyph_row *);
@@ -16493,7 +16894,7 @@ find_last_row_displaying_text (struct glyph_matrix *matrix, struct it *it,
row = start ? start : MATRIX_FIRST_TEXT_ROW (matrix);
while (MATRIX_ROW_DISPLAYS_TEXT_P (row))
{
- xassert (row->enabled_p);
+ eassert (row->enabled_p);
row_found = row;
if (MATRIX_ROW_BOTTOM_Y (row) >= it->last_visible_y)
break;
@@ -16517,7 +16918,7 @@ find_last_row_displaying_text (struct glyph_matrix *matrix, struct it *it,
static struct glyph_row *
find_last_unchanged_at_beg_row (struct window *w)
{
- EMACS_INT first_changed_pos = BEG + BEG_UNCHANGED;
+ ptrdiff_t first_changed_pos = BEG + BEG_UNCHANGED;
struct glyph_row *row;
struct glyph_row *row_found = NULL;
int yb = window_text_bottom_y (w);
@@ -16539,7 +16940,15 @@ find_last_unchanged_at_beg_row (struct window *w)
continued. */
&& !(MATRIX_ROW_END_CHARPOS (row) == first_changed_pos
&& (row->continued_p
- || row->exact_window_width_line_p)))
+ || row->exact_window_width_line_p))
+ /* If ROW->end is beyond ZV, then ROW->end is outdated and
+ needs to be recomputed, so don't consider this row as
+ unchanged. This happens when the last line was
+ bidi-reordered and was killed immediately before this
+ redisplay cycle. In that case, ROW->end stores the
+ buffer position of the first visual-order character of
+ the killed text, which is now beyond ZV. */
+ && CHARPOS (row->end.pos) <= ZV)
row_found = row;
/* Stop if last visible row. */
@@ -16565,7 +16974,7 @@ find_last_unchanged_at_beg_row (struct window *w)
static struct glyph_row *
find_first_unchanged_at_end_row (struct window *w,
- EMACS_INT *delta, EMACS_INT *delta_bytes)
+ ptrdiff_t *delta, ptrdiff_t *delta_bytes)
{
struct glyph_row *row;
struct glyph_row *row_found = NULL;
@@ -16593,11 +17002,11 @@ find_first_unchanged_at_end_row (struct window *w,
corresponds to window_end_pos. This allows us to translate
buffer positions in the current matrix to current buffer
positions for characters not in changed text. */
- EMACS_INT Z_old =
+ ptrdiff_t Z_old =
MATRIX_ROW_END_CHARPOS (row) + XFASTINT (w->window_end_pos);
- EMACS_INT Z_BYTE_old =
+ ptrdiff_t Z_BYTE_old =
MATRIX_ROW_END_BYTEPOS (row) + w->window_end_bytepos;
- EMACS_INT last_unchanged_pos, last_unchanged_pos_old;
+ ptrdiff_t last_unchanged_pos, last_unchanged_pos_old;
struct glyph_row *first_text_row
= MATRIX_FIRST_TEXT_ROW (w->current_matrix);
@@ -16647,9 +17056,9 @@ sync_frame_with_window_matrix_rows (struct window *w)
/* Preconditions: W must be a leaf window and full-width. Its frame
must have a frame matrix. */
- xassert (NILP (w->hchild) && NILP (w->vchild));
- xassert (WINDOW_FULL_WIDTH_P (w));
- xassert (!FRAME_WINDOW_P (f));
+ eassert (NILP (w->hchild) && NILP (w->vchild));
+ eassert (WINDOW_FULL_WIDTH_P (w));
+ eassert (!FRAME_WINDOW_P (f));
/* If W is a full-width window, glyph pointers in W's current matrix
have, by definition, to be the same as glyph pointers in the
@@ -16684,12 +17093,12 @@ sync_frame_with_window_matrix_rows (struct window *w)
containing CHARPOS or null. */
struct glyph_row *
-row_containing_pos (struct window *w, EMACS_INT charpos,
+row_containing_pos (struct window *w, ptrdiff_t charpos,
struct glyph_row *start, struct glyph_row *end, int dy)
{
struct glyph_row *row = start;
struct glyph_row *best_row = NULL;
- EMACS_INT mindif = BUF_ZV (XBUFFER (w->buffer)) + 1;
+ ptrdiff_t mindif = BUF_ZV (XBUFFER (w->buffer)) + 1;
int last_y;
/* If we happen to start on a header-line, skip that. */
@@ -16803,16 +17212,16 @@ try_window_id (struct window *w)
struct glyph_row *bottom_row;
int bottom_vpos;
struct it it;
- EMACS_INT delta = 0, delta_bytes = 0, stop_pos;
+ ptrdiff_t delta = 0, delta_bytes = 0, stop_pos;
int dvpos, dy;
struct text_pos start_pos;
struct run run;
int first_unchanged_at_end_vpos = 0;
struct glyph_row *last_text_row, *last_text_row_at_end;
struct text_pos start;
- EMACS_INT first_changed_charpos, last_changed_charpos;
+ ptrdiff_t first_changed_charpos, last_changed_charpos;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
if (inhibit_try_window_id)
return 0;
#endif
@@ -16858,11 +17267,11 @@ try_window_id (struct window *w)
GIVE_UP (5);
/* Another way to prevent redisplay optimizations. */
- if (XFASTINT (w->last_modified) == 0)
+ if (w->last_modified == 0)
GIVE_UP (6);
/* Verify that window is not hscrolled. */
- if (XFASTINT (w->hscroll) != 0)
+ if (w->hscroll != 0)
GIVE_UP (7);
/* Verify that display wasn't paused. */
@@ -16937,7 +17346,7 @@ try_window_id (struct window *w)
|| (last_changed_charpos < CHARPOS (start) - 1
&& FETCH_BYTE (BYTEPOS (start) - 1) == '\n')))
{
- EMACS_INT Z_old, Z_delta, Z_BYTE_old, Z_delta_bytes;
+ ptrdiff_t Z_old, Z_delta, Z_BYTE_old, Z_delta_bytes;
struct glyph_row *r0;
/* Compute how many chars/bytes have been added to or removed
@@ -16979,7 +17388,7 @@ try_window_id (struct window *w)
if (row)
set_cursor_from_row (w, row, current_matrix, 0, 0, 0, 0);
else
- abort ();
+ emacs_abort ();
return 1;
}
}
@@ -17013,8 +17422,8 @@ try_window_id (struct window *w)
{
/* We have to compute the window end anew since text
could have been added/removed after it. */
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (row));
+ wset_window_end_pos
+ (w, make_number (Z - MATRIX_ROW_END_CHARPOS (row)));
w->window_end_bytepos
= Z_BYTE - MATRIX_ROW_END_BYTEPOS (row);
@@ -17023,7 +17432,7 @@ try_window_id (struct window *w)
if (row)
set_cursor_from_row (w, row, current_matrix, 0, 0, 0, 0);
else
- abort ();
+ emacs_abort ();
return 2;
}
}
@@ -17086,7 +17495,7 @@ try_window_id (struct window *w)
it.glyph_row = MATRIX_ROW (desired_matrix, it.vpos);
it.current_y = MATRIX_ROW_BOTTOM_Y (last_unchanged_at_beg_row);
- xassert (it.hpos == 0 && it.current_x == 0);
+ eassert (it.hpos == 0 && it.current_x == 0);
}
else
{
@@ -17116,7 +17525,7 @@ try_window_id (struct window *w)
stop_pos = 0;
if (first_unchanged_at_end_row)
{
- xassert (last_unchanged_at_beg_row == NULL
+ eassert (last_unchanged_at_beg_row == NULL
|| first_unchanged_at_end_row >= last_unchanged_at_beg_row);
/* If this is a continuation line, move forward to the next one
@@ -17139,19 +17548,19 @@ try_window_id (struct window *w)
+ delta);
first_unchanged_at_end_vpos
= MATRIX_ROW_VPOS (first_unchanged_at_end_row, current_matrix);
- xassert (stop_pos >= Z - END_UNCHANGED);
+ eassert (stop_pos >= Z - END_UNCHANGED);
}
}
else if (last_unchanged_at_beg_row == NULL)
GIVE_UP (19);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Either there is no unchanged row at the end, or the one we have
now displays text. This is a necessary condition for the window
end pos calculation at the end of this function. */
- xassert (first_unchanged_at_end_row == NULL
+ eassert (first_unchanged_at_end_row == NULL
|| MATRIX_ROW_DISPLAYS_TEXT_P (first_unchanged_at_end_row));
debug_last_unchanged_at_beg_vpos
@@ -17160,7 +17569,7 @@ try_window_id (struct window *w)
: -1);
debug_first_unchanged_at_end_vpos = first_unchanged_at_end_vpos;
-#endif /* GLYPH_DEBUG != 0 */
+#endif /* GLYPH_DEBUG */
/* Display new lines. Set last_text_row to the last new line
@@ -17346,15 +17755,15 @@ try_window_id (struct window *w)
{
rotate_matrix (current_matrix, first_unchanged_at_end_vpos + dvpos,
bottom_vpos, dvpos);
- enable_glyph_matrix_rows (current_matrix, bottom_vpos + dvpos,
- bottom_vpos, 0);
+ clear_glyph_matrix_rows (current_matrix, bottom_vpos + dvpos,
+ bottom_vpos);
}
else if (dvpos > 0)
{
rotate_matrix (current_matrix, first_unchanged_at_end_vpos,
bottom_vpos, dvpos);
- enable_glyph_matrix_rows (current_matrix, first_unchanged_at_end_vpos,
- first_unchanged_at_end_vpos + dvpos, 0);
+ clear_glyph_matrix_rows (current_matrix, first_unchanged_at_end_vpos,
+ first_unchanged_at_end_vpos + dvpos);
}
/* For frame-based redisplay, make sure that current frame and window
@@ -17396,7 +17805,7 @@ try_window_id (struct window *w)
struct glyph_row *last_row = MATRIX_ROW (current_matrix, last_vpos);
/* If last_row is the window end line, it should display text. */
- xassert (last_row->displays_text_p);
+ eassert (last_row->displays_text_p);
/* If window end line was partially visible before, begin
displaying at that line. Otherwise begin displaying with the
@@ -17443,27 +17852,28 @@ try_window_id (struct window *w)
matrix. Set row to the last row displaying text in current
matrix starting at first_unchanged_at_end_row, after
scrolling. */
- xassert (first_unchanged_at_end_row->displays_text_p);
+ eassert (first_unchanged_at_end_row->displays_text_p);
row = find_last_row_displaying_text (w->current_matrix, &it,
first_unchanged_at_end_row);
- xassert (row && MATRIX_ROW_DISPLAYS_TEXT_P (row));
+ eassert (row && MATRIX_ROW_DISPLAYS_TEXT_P (row));
- w->window_end_pos = make_number (Z - MATRIX_ROW_END_CHARPOS (row));
+ wset_window_end_pos (w, make_number (Z - MATRIX_ROW_END_CHARPOS (row)));
w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (row);
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (row, w->current_matrix));
- xassert (w->window_end_bytepos >= 0);
+ wset_window_end_vpos
+ (w, make_number (MATRIX_ROW_VPOS (row, w->current_matrix)));
+ eassert (w->window_end_bytepos >= 0);
IF_DEBUG (debug_method_add (w, "A"));
}
else if (last_text_row_at_end)
{
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row_at_end));
+ wset_window_end_pos
+ (w, make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row_at_end)));
w->window_end_bytepos
= Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_text_row_at_end);
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (last_text_row_at_end, desired_matrix));
- xassert (w->window_end_bytepos >= 0);
+ wset_window_end_vpos
+ (w, make_number (MATRIX_ROW_VPOS (last_text_row_at_end,
+ desired_matrix)));
+ eassert (w->window_end_bytepos >= 0);
IF_DEBUG (debug_method_add (w, "B"));
}
else if (last_text_row)
@@ -17471,13 +17881,13 @@ try_window_id (struct window *w)
/* We have displayed either to the end of the window or at the
end of the window, i.e. the last row with text is to be found
in the desired matrix. */
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row));
+ wset_window_end_pos
+ (w, make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row)));
w->window_end_bytepos
= Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_text_row);
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (last_text_row, desired_matrix));
- xassert (w->window_end_bytepos >= 0);
+ wset_window_end_vpos
+ (w, make_number (MATRIX_ROW_VPOS (last_text_row, desired_matrix)));
+ eassert (w->window_end_bytepos >= 0);
}
else if (first_unchanged_at_end_row == NULL
&& last_text_row == NULL
@@ -17503,21 +17913,21 @@ try_window_id (struct window *w)
row = current_row;
}
- xassert (row != NULL);
- w->window_end_vpos = make_number (vpos + 1);
- w->window_end_pos = make_number (Z - MATRIX_ROW_END_CHARPOS (row));
+ eassert (row != NULL);
+ wset_window_end_vpos (w, make_number (vpos + 1));
+ wset_window_end_pos (w, make_number (Z - MATRIX_ROW_END_CHARPOS (row)));
w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (row);
- xassert (w->window_end_bytepos >= 0);
+ eassert (w->window_end_bytepos >= 0);
IF_DEBUG (debug_method_add (w, "C"));
}
else
- abort ();
+ emacs_abort ();
IF_DEBUG (debug_end_pos = XFASTINT (w->window_end_pos);
debug_end_vpos = XFASTINT (w->window_end_vpos));
/* Record that display has not been completed. */
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
w->desired_matrix->no_scrolling_p = 1;
return 3;
@@ -17530,7 +17940,7 @@ try_window_id (struct window *w)
More debugging support
***********************************************************************/
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
void dump_glyph_row (struct glyph_row *, int, int) EXTERNALLY_VISIBLE;
void dump_glyph_matrix (struct glyph_matrix *, int) EXTERNALLY_VISIBLE;
@@ -17681,7 +18091,7 @@ dump_glyph_row (struct glyph_row *row, int vpos, int glyphs)
row->visible_height,
row->ascent,
row->phys_ascent);
- fprintf (stderr, "%9d %5d\t%5d\n", row->start.overlay_string_index,
+ fprintf (stderr, "%9"pD"d %5"pD"d\t%5d\n", row->start.overlay_string_index,
row->end.overlay_string_index,
row->continuation_lines_width);
fprintf (stderr, "%9"pI"d %5"pI"d\n",
@@ -17717,7 +18127,7 @@ dump_glyph_row (struct glyph_row *row, int vpos, int glyphs)
for (area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area)
{
- char *s = (char *) alloca (row->used[area] + 1);
+ char *s = alloca (row->used[area] + 1);
int i;
for (i = 0; i < row->used[area]; ++i)
@@ -17755,7 +18165,7 @@ glyphs in short form, otherwise show glyphs in long form. */)
w->cursor.x, w->cursor.y, w->cursor.hpos, w->cursor.vpos);
fprintf (stderr, "=============================================\n");
dump_glyph_matrix (w->current_matrix,
- NILP (glyphs) ? 0 : XINT (glyphs));
+ TYPE_RANGED_INTEGERP (int, glyphs) ? XINT (glyphs) : 0);
return Qnil;
}
@@ -17778,7 +18188,7 @@ GLYPH > 1 or omitted means dump glyphs in long form. */)
(Lisp_Object row, Lisp_Object glyphs)
{
struct glyph_matrix *matrix;
- int vpos;
+ EMACS_INT vpos;
CHECK_NUMBER (row);
matrix = XWINDOW (selected_window)->current_matrix;
@@ -17786,7 +18196,7 @@ GLYPH > 1 or omitted means dump glyphs in long form. */)
if (vpos >= 0 && vpos < matrix->nrows)
dump_glyph_row (MATRIX_ROW (matrix, vpos),
vpos,
- INTEGERP (glyphs) ? XINT (glyphs) : 2);
+ TYPE_RANGED_INTEGERP (int, glyphs) ? XINT (glyphs) : 2);
return Qnil;
}
@@ -17800,13 +18210,13 @@ GLYPH > 1 or omitted means dump glyphs in long form. */)
{
struct frame *sf = SELECTED_FRAME ();
struct glyph_matrix *m = XWINDOW (sf->tool_bar_window)->current_matrix;
- int vpos;
+ EMACS_INT vpos;
CHECK_NUMBER (row);
vpos = XINT (row);
if (vpos >= 0 && vpos < m->nrows)
dump_glyph_row (MATRIX_ROW (m, vpos), vpos,
- INTEGERP (glyphs) ? XINT (glyphs) : 2);
+ TYPE_RANGED_INTEGERP (int, glyphs) ? XINT (glyphs) : 2);
return Qnil;
}
@@ -17909,11 +18319,8 @@ get_overlay_arrow_glyph_row (struct window *w, Lisp_Object overlay_arrow_string)
}
-/* Insert truncation glyphs at the start of IT->glyph_row. Truncation
- glyphs are only inserted for terminal frames since we can't really
- win with truncation glyphs when partially visible glyphs are
- involved. Which glyphs to insert is determined by
- produce_special_glyphs. */
+/* Insert truncation glyphs at the start of IT->glyph_row. Which
+ glyphs to insert is determined by produce_special_glyphs. */
static void
insert_left_trunc_glyphs (struct it *it)
@@ -17921,7 +18328,11 @@ insert_left_trunc_glyphs (struct it *it)
struct it truncate_it;
struct glyph *from, *end, *to, *toend;
- xassert (!FRAME_WINDOW_P (it->f));
+ eassert (!FRAME_WINDOW_P (it->f)
+ || (!it->glyph_row->reversed_p
+ && WINDOW_LEFT_FRINGE_WIDTH (it->w) == 0)
+ || (it->glyph_row->reversed_p
+ && WINDOW_RIGHT_FRINGE_WIDTH (it->w) == 0));
/* Get the truncation glyphs. */
truncate_it = *it;
@@ -17936,20 +18347,65 @@ insert_left_trunc_glyphs (struct it *it)
/* Overwrite glyphs from IT with truncation glyphs. */
if (!it->glyph_row->reversed_p)
{
+ short tused = truncate_it.glyph_row->used[TEXT_AREA];
+
from = truncate_it.glyph_row->glyphs[TEXT_AREA];
- end = from + truncate_it.glyph_row->used[TEXT_AREA];
+ end = from + tused;
to = it->glyph_row->glyphs[TEXT_AREA];
toend = to + it->glyph_row->used[TEXT_AREA];
+ if (FRAME_WINDOW_P (it->f))
+ {
+ /* On GUI frames, when variable-size fonts are displayed,
+ the truncation glyphs may need more pixels than the row's
+ glyphs they overwrite. We overwrite more glyphs to free
+ enough screen real estate, and enlarge the stretch glyph
+ on the right (see display_line), if there is one, to
+ preserve the screen position of the truncation glyphs on
+ the right. */
+ int w = 0;
+ struct glyph *g = to;
+ short used;
+
+ /* The first glyph could be partially visible, in which case
+ it->glyph_row->x will be negative. But we want the left
+ truncation glyphs to be aligned at the left margin of the
+ window, so we override the x coordinate at which the row
+ will begin. */
+ it->glyph_row->x = 0;
+ while (g < toend && w < it->truncation_pixel_width)
+ {
+ w += g->pixel_width;
+ ++g;
+ }
+ if (g - to - tused > 0)
+ {
+ memmove (to + tused, g, (toend - g) * sizeof(*g));
+ it->glyph_row->used[TEXT_AREA] -= g - to - tused;
+ }
+ used = it->glyph_row->used[TEXT_AREA];
+ if (it->glyph_row->truncated_on_right_p
+ && WINDOW_RIGHT_FRINGE_WIDTH (it->w) == 0
+ && it->glyph_row->glyphs[TEXT_AREA][used - 2].type
+ == STRETCH_GLYPH)
+ {
+ int extra = w - it->truncation_pixel_width;
+
+ it->glyph_row->glyphs[TEXT_AREA][used - 2].pixel_width += extra;
+ }
+ }
while (from < end)
*to++ = *from++;
/* There may be padding glyphs left over. Overwrite them too. */
- while (to < toend && CHAR_GLYPH_PADDING_P (*to))
+ if (!FRAME_WINDOW_P (it->f))
{
- from = truncate_it.glyph_row->glyphs[TEXT_AREA];
- while (from < end)
- *to++ = *from++;
+ while (to < toend && CHAR_GLYPH_PADDING_P (*to))
+ {
+ from = truncate_it.glyph_row->glyphs[TEXT_AREA];
+ while (from < end)
+ *to++ = *from++;
+ }
}
if (to > toend)
@@ -17957,22 +18413,48 @@ insert_left_trunc_glyphs (struct it *it)
}
else
{
+ short tused = truncate_it.glyph_row->used[TEXT_AREA];
+
/* In R2L rows, overwrite the last (rightmost) glyphs, and do
that back to front. */
end = truncate_it.glyph_row->glyphs[TEXT_AREA];
from = end + truncate_it.glyph_row->used[TEXT_AREA] - 1;
toend = it->glyph_row->glyphs[TEXT_AREA];
to = toend + it->glyph_row->used[TEXT_AREA] - 1;
+ if (FRAME_WINDOW_P (it->f))
+ {
+ int w = 0;
+ struct glyph *g = to;
+
+ while (g >= toend && w < it->truncation_pixel_width)
+ {
+ w += g->pixel_width;
+ --g;
+ }
+ if (to - g - tused > 0)
+ to = g + tused;
+ if (it->glyph_row->truncated_on_right_p
+ && WINDOW_LEFT_FRINGE_WIDTH (it->w) == 0
+ && it->glyph_row->glyphs[TEXT_AREA][1].type == STRETCH_GLYPH)
+ {
+ int extra = w - it->truncation_pixel_width;
+
+ it->glyph_row->glyphs[TEXT_AREA][1].pixel_width += extra;
+ }
+ }
while (from >= end && to >= toend)
*to-- = *from--;
- while (to >= toend && CHAR_GLYPH_PADDING_P (*to))
+ if (!FRAME_WINDOW_P (it->f))
{
- from =
- truncate_it.glyph_row->glyphs[TEXT_AREA]
- + truncate_it.glyph_row->used[TEXT_AREA] - 1;
- while (from >= end && to >= toend)
- *to-- = *from--;
+ while (to >= toend && CHAR_GLYPH_PADDING_P (*to))
+ {
+ from =
+ truncate_it.glyph_row->glyphs[TEXT_AREA]
+ + truncate_it.glyph_row->used[TEXT_AREA] - 1;
+ while (from >= end && to >= toend)
+ *to-- = *from--;
+ }
}
if (from >= end)
{
@@ -18054,8 +18536,8 @@ compute_line_metrics (struct it *it)
for (i = 0; i < row->used[TEXT_AREA]; ++i)
row->pixel_width += row->glyphs[TEXT_AREA][i].pixel_width;
- xassert (row->pixel_width >= 0);
- xassert (row->ascent >= 0 && row->height > 0);
+ eassert (row->pixel_width >= 0);
+ eassert (row->ascent >= 0 && row->height > 0);
row->overlapping_p = (MATRIX_ROW_OVERLAPS_SUCC_P (row)
|| MATRIX_ROW_OVERLAPS_PRED_P (row));
@@ -18145,8 +18627,10 @@ append_space_for_newline (struct it *it, int default_face_p)
it->c = it->char_to_display = ' ';
it->len = 1;
+ /* If the default face was remapped, be sure to use the
+ remapped face for the appended newline. */
if (default_face_p)
- it->face_id = DEFAULT_FACE_ID;
+ it->face_id = lookup_basic_face (it->f, DEFAULT_FACE_ID);
else if (it->face_before_selective_p)
it->face_id = it->saved_face_id;
face = FACE_FROM_ID (it->f, it->face_id);
@@ -18182,7 +18666,7 @@ append_space_for_newline (struct it *it, int default_face_p)
static void
extend_face_to_end_of_line (struct it *it)
{
- struct face *face;
+ struct face *face, *default_face;
struct frame *f = it->f;
/* If line is already filled, do nothing. Non window-system frames
@@ -18196,6 +18680,9 @@ extend_face_to_end_of_line (struct it *it)
&& !it->glyph_row->continued_p))
return;
+ /* The default face, possibly remapped. */
+ default_face = FACE_FROM_ID (f, lookup_basic_face (f, DEFAULT_FACE_ID));
+
/* Face extension extends the background and box of IT->face_id
to the end of the line. If the background equals the background
of the frame, we don't have to do anything. */
@@ -18233,7 +18720,7 @@ extend_face_to_end_of_line (struct it *it)
if (it->glyph_row->used[TEXT_AREA] == 0)
{
it->glyph_row->glyphs[TEXT_AREA][0] = space_glyph;
- it->glyph_row->glyphs[TEXT_AREA][0].face_id = it->face_id;
+ it->glyph_row->glyphs[TEXT_AREA][0].face_id = face->id;
it->glyph_row->used[TEXT_AREA] = 1;
}
#ifdef HAVE_WINDOW_SYSTEM
@@ -18269,7 +18756,7 @@ extend_face_to_end_of_line (struct it *it)
face, to avoid painting the rest of the window with
the region face, if the region ends at ZV. */
if (it->glyph_row->ends_at_zv_p)
- it->face_id = DEFAULT_FACE_ID;
+ it->face_id = default_face->id;
else
it->face_id = face->id;
append_stretch_glyph (it, make_number (0), stretch_width,
@@ -18302,7 +18789,7 @@ extend_face_to_end_of_line (struct it *it)
avoid painting the rest of the window with the region face,
if the region ends at ZV. */
if (it->glyph_row->ends_at_zv_p)
- it->face_id = DEFAULT_FACE_ID;
+ it->face_id = default_face->id;
else
it->face_id = face->id;
@@ -18326,9 +18813,9 @@ extend_face_to_end_of_line (struct it *it)
trailing whitespace. */
static int
-trailing_whitespace_p (EMACS_INT charpos)
+trailing_whitespace_p (ptrdiff_t charpos)
{
- EMACS_INT bytepos = CHAR_TO_BYTE (charpos);
+ ptrdiff_t bytepos = CHAR_TO_BYTE (charpos);
int c = 0;
while (bytepos < ZV_BYTE
@@ -18435,9 +18922,11 @@ cursor_row_p (struct glyph_row *row)
/* Suppose the row ends on a string.
Unless the row is continued, that means it ends on a newline
in the string. If it's anything other than a display string
- (e.g. a before-string from an overlay), we don't want the
+ (e.g., a before-string from an overlay), we don't want the
cursor there. (This heuristic seems to give the optimal
- behavior for the various types of multi-line strings.) */
+ behavior for the various types of multi-line strings.)
+ One exception: if the string has `cursor' property on one of
+ its characters, we _do_ want the cursor there. */
if (CHARPOS (row->end.string_pos) >= 0)
{
if (row->continued_p)
@@ -18459,6 +18948,25 @@ cursor_row_p (struct glyph_row *row)
result =
(!NILP (prop)
&& display_prop_string_p (prop, glyph->object));
+ /* If there's a `cursor' property on one of the
+ string's characters, this row is a cursor row,
+ even though this is not a display string. */
+ if (!result)
+ {
+ Lisp_Object s = glyph->object;
+
+ for ( ; glyph >= beg && EQ (glyph->object, s); --glyph)
+ {
+ ptrdiff_t gpos = glyph->charpos;
+
+ if (!NILP (Fget_char_property (make_number (gpos),
+ Qcursor, s)))
+ {
+ result = 1;
+ break;
+ }
+ }
+ }
break;
}
}
@@ -18497,12 +19005,12 @@ cursor_row_p (struct glyph_row *row)
`line-prefix' and `wrap-prefix' properties. */
static int
-push_display_prop (struct it *it, Lisp_Object prop)
+push_prefix_prop (struct it *it, Lisp_Object prop)
{
struct text_pos pos =
STRINGP (it->string) ? it->current.string_pos : it->current.pos;
- xassert (it->method == GET_FROM_BUFFER
+ eassert (it->method == GET_FROM_BUFFER
|| it->method == GET_FROM_DISPLAY_VECTOR
|| it->method == GET_FROM_STRING);
@@ -18521,6 +19029,7 @@ push_display_prop (struct it *it, Lisp_Object prop)
}
it->string = prop;
+ it->string_from_prefix_prop_p = 1;
it->multibyte_p = STRING_MULTIBYTE (it->string);
it->current.overlay_string_index = -1;
IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = 0;
@@ -18607,7 +19116,7 @@ handle_line_prefix (struct it *it)
if (NILP (prefix))
prefix = Vline_prefix;
}
- if (! NILP (prefix) && push_display_prop (it, prefix))
+ if (! NILP (prefix) && push_prefix_prop (it, prefix))
{
/* If the prefix is wider than the window, and we try to wrap
it, it would acquire its own wrap prefix, and so on till the
@@ -18628,10 +19137,10 @@ unproduce_glyphs (struct it *it, int n)
{
struct glyph *glyph, *end;
- xassert (it->glyph_row);
- xassert (it->glyph_row->reversed_p);
- xassert (it->area == TEXT_AREA);
- xassert (n <= it->glyph_row->used[TEXT_AREA]);
+ eassert (it->glyph_row);
+ eassert (it->glyph_row->reversed_p);
+ eassert (it->area == TEXT_AREA);
+ eassert (n <= it->glyph_row->used[TEXT_AREA]);
if (n > it->glyph_row->used[TEXT_AREA])
n = it->glyph_row->used[TEXT_AREA];
@@ -18645,8 +19154,8 @@ unproduce_glyphs (struct it *it, int n)
and ROW->maxpos. */
static void
find_row_edges (struct it *it, struct glyph_row *row,
- EMACS_INT min_pos, EMACS_INT min_bpos,
- EMACS_INT max_pos, EMACS_INT max_bpos)
+ ptrdiff_t min_pos, ptrdiff_t min_bpos,
+ ptrdiff_t max_pos, ptrdiff_t max_bpos)
{
/* FIXME: Revisit this when glyph ``spilling'' in continuation
lines' rows is implemented for bidi-reordered rows. */
@@ -18789,7 +19298,7 @@ find_row_edges (struct it *it, struct glyph_row *row,
/* A line that is entirely from a string/image/stretch... */
row->maxpos = row->minpos;
else
- abort ();
+ emacs_abort ();
}
else
row->maxpos = it->current.pos;
@@ -18813,14 +19322,14 @@ display_line (struct it *it)
int wrap_row_ascent IF_LINT (= 0), wrap_row_height IF_LINT (= 0);
int wrap_row_phys_ascent IF_LINT (= 0), wrap_row_phys_height IF_LINT (= 0);
int wrap_row_extra_line_spacing IF_LINT (= 0);
- EMACS_INT wrap_row_min_pos IF_LINT (= 0), wrap_row_min_bpos IF_LINT (= 0);
- EMACS_INT wrap_row_max_pos IF_LINT (= 0), wrap_row_max_bpos IF_LINT (= 0);
+ ptrdiff_t wrap_row_min_pos IF_LINT (= 0), wrap_row_min_bpos IF_LINT (= 0);
+ ptrdiff_t wrap_row_max_pos IF_LINT (= 0), wrap_row_max_bpos IF_LINT (= 0);
int cvpos;
- EMACS_INT min_pos = ZV + 1, max_pos = 0;
- EMACS_INT min_bpos IF_LINT (= 0), max_bpos IF_LINT (= 0);
+ ptrdiff_t min_pos = ZV + 1, max_pos = 0;
+ ptrdiff_t min_bpos IF_LINT (= 0), max_bpos IF_LINT (= 0);
/* We always start displaying at hpos zero even if hscrolled. */
- xassert (it->hpos == 0 && it->current_x == 0);
+ eassert (it->hpos == 0 && it->current_x == 0);
if (MATRIX_ROW_VPOS (row, it->w->desired_matrix)
>= it->w->desired_matrix->nrows)
@@ -18831,7 +19340,7 @@ display_line (struct it *it)
}
/* Is IT->w showing the region? */
- it->w->region_showing = it->region_beg_charpos > 0 ? Qt : Qnil;
+ wset_region_showing (it->w, it->region_beg_charpos > 0 ? Qt : Qnil);
/* Clear the result glyph row and enable it. */
prepare_desired_row (row);
@@ -18855,9 +19364,22 @@ display_line (struct it *it)
if the first glyph is partially visible or if we hit a line end. */
if (it->current_x < it->first_visible_x)
{
+ enum move_it_result move_result;
+
this_line_min_pos = row->start.pos;
- move_it_in_display_line_to (it, ZV, it->first_visible_x,
- MOVE_TO_POS | MOVE_TO_X);
+ move_result = move_it_in_display_line_to (it, ZV, it->first_visible_x,
+ MOVE_TO_POS | MOVE_TO_X);
+ /* If we are under a large hscroll, move_it_in_display_line_to
+ could hit the end of the line without reaching
+ it->first_visible_x. Pretend that we did reach it. This is
+ especially important on a TTY, where we will call
+ extend_face_to_end_of_line, which needs to know how many
+ blank glyphs to produce. */
+ if (it->current_x < it->first_visible_x
+ && (move_result == MOVE_NEWLINE_OR_CR
+ || move_result == MOVE_POS_MATCH_OR_ZV))
+ it->current_x = it->first_visible_x;
+
/* Record the smallest positions seen while we moved over
display elements that are not visible. This is needed by
redisplay_internal for optimizing the case where the cursor
@@ -18890,10 +19412,10 @@ display_line (struct it *it)
{ \
int composition_p = !STRINGP ((IT)->string) \
&& ((IT)->what == IT_COMPOSITION); \
- EMACS_INT current_pos = \
+ ptrdiff_t current_pos = \
composition_p ? (IT)->cmp_it.charpos \
: IT_CHARPOS (*(IT)); \
- EMACS_INT current_bpos = \
+ ptrdiff_t current_bpos = \
composition_p ? CHAR_TO_BYTE (current_pos) \
: IT_BYTEPOS (*(IT)); \
if (current_pos < min_pos) \
@@ -18944,8 +19466,13 @@ display_line (struct it *it)
/* A row that displays right-to-left text must always have
its last face extended all the way to the end of line,
even if this row ends in ZV, because we still write to
- the screen left to right. */
- if (row->reversed_p)
+ the screen left to right. We also need to extend the
+ last face if the default face is remapped to some
+ different face, otherwise the functions that clear
+ portions of the screen will clear with the default face's
+ background color. */
+ if (row->reversed_p
+ || lookup_basic_face (it->f, DEFAULT_FACE_ID) != DEFAULT_FACE_ID)
extend_face_to_end_of_line (it);
break;
}
@@ -19053,13 +19580,19 @@ display_line (struct it *it)
new_x > it->last_visible_x
/* Or it fits exactly on a window system frame. */
|| (new_x == it->last_visible_x
- && FRAME_WINDOW_P (it->f))))
+ && FRAME_WINDOW_P (it->f)
+ && (row->reversed_p
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))))
{
/* End of a continued line. */
if (it->hpos == 0
|| (new_x == it->last_visible_x
- && FRAME_WINDOW_P (it->f)))
+ && FRAME_WINDOW_P (it->f)
+ && (row->reversed_p
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))
{
/* Current glyph is the only one on the line or
fits exactly on the line. We must continue
@@ -19170,6 +19703,10 @@ display_line (struct it *it)
window system frames. We leave the glyph in
this row and let it fill the row, but don't
consume the TAB. */
+ if ((row->reversed_p
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)) == 0)
+ produce_special_glyphs (it, IT_CONTINUATION);
it->continuation_lines_width += it->last_visible_x;
row->ends_in_middle_of_char_p = 1;
row->continued_p = 1;
@@ -19187,12 +19724,15 @@ display_line (struct it *it)
row->used[TEXT_AREA] = n_glyphs_before + i;
/* Display continuation glyphs. */
- if (!FRAME_WINDOW_P (it->f))
+ it->current_x = x_before;
+ it->continuation_lines_width += x;
+ if (!FRAME_WINDOW_P (it->f)
+ || (row->reversed_p
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)) == 0)
produce_special_glyphs (it, IT_CONTINUATION);
row->continued_p = 1;
- it->current_x = x_before;
- it->continuation_lines_width += x;
extend_face_to_end_of_line (it);
if (nglyphs > 1 && i > 0)
@@ -19234,7 +19774,7 @@ display_line (struct it *it)
move_it_in_display_line at the start of this
function, unless the text display area of the
window is empty. */
- xassert (it->first_visible_x <= it->last_visible_x);
+ eassert (it->first_visible_x <= it->last_visible_x);
}
}
/* Even if this display element produced no glyphs at all,
@@ -19294,12 +19834,15 @@ display_line (struct it *it)
/* If we truncate lines, we are done when the last displayed
glyphs reach past the right margin of the window. */
if (it->line_wrap == TRUNCATE
- && (FRAME_WINDOW_P (it->f)
+ && (FRAME_WINDOW_P (it->f) && WINDOW_RIGHT_FRINGE_WIDTH (it->w)
? (it->current_x >= it->last_visible_x)
: (it->current_x > it->last_visible_x)))
{
/* Maybe add truncation glyphs. */
- if (!FRAME_WINDOW_P (it->f))
+ if (!FRAME_WINDOW_P (it->f)
+ || (row->reversed_p
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)) == 0)
{
int i, n;
@@ -19324,7 +19867,16 @@ display_line (struct it *it)
i = row->used[TEXT_AREA] - (i + 1);
}
- for (n = row->used[TEXT_AREA]; i < n; ++i)
+ it->current_x = x_before;
+ if (!FRAME_WINDOW_P (it->f))
+ {
+ for (n = row->used[TEXT_AREA]; i < n; ++i)
+ {
+ row->used[TEXT_AREA] = i;
+ produce_special_glyphs (it, IT_TRUNCATION);
+ }
+ }
+ else
{
row->used[TEXT_AREA] = i;
produce_special_glyphs (it, IT_TRUNCATION);
@@ -19345,6 +19897,7 @@ display_line (struct it *it)
row->exact_window_width_line_p = 1;
goto at_end_of_line;
}
+ it->current_x = x_before;
}
row->truncated_on_right_p = 1;
@@ -19352,7 +19905,6 @@ display_line (struct it *it)
reseat_at_next_visible_line_start (it, 0);
row->ends_at_zv_p = FETCH_BYTE (IT_BYTEPOS (*it) - 1) != '\n';
it->hpos = hpos_before;
- it->current_x = x_before;
break;
}
}
@@ -19365,7 +19917,10 @@ display_line (struct it *it)
if (it->first_visible_x
&& IT_CHARPOS (*it) != CHARPOS (row->start.pos))
{
- if (!FRAME_WINDOW_P (it->f))
+ if (!FRAME_WINDOW_P (it->f)
+ || (row->reversed_p
+ ? WINDOW_RIGHT_FRINGE_WIDTH (it->w)
+ : WINDOW_LEFT_FRINGE_WIDTH (it->w)) == 0)
insert_left_trunc_glyphs (it);
row->truncated_on_left_p = 1;
}
@@ -19426,7 +19981,7 @@ display_line (struct it *it)
}
else
{
- xassert (INTEGERP (overlay_arrow_string));
+ eassert (INTEGERP (overlay_arrow_string));
row->overlay_arrow_bitmap = XINT (overlay_arrow_string);
}
overlay_arrow_seen = 1;
@@ -19536,8 +20091,8 @@ See also `bidi-paragraph-direction'. */)
use current_matrix if it is up to date, but this seems fast
enough as it is. */
struct bidi_it itb;
- EMACS_INT pos = BUF_PT (buf);
- EMACS_INT bytepos = BUF_PT_BYTE (buf);
+ ptrdiff_t pos = BUF_PT (buf);
+ ptrdiff_t bytepos = BUF_PT_BYTE (buf);
int c;
void *itb_data = bidi_shelve_cache ();
@@ -19584,7 +20139,7 @@ See also `bidi-paragraph-direction'. */)
return Qright_to_left;
break;
default:
- abort ();
+ emacs_abort ();
}
}
}
@@ -19629,7 +20184,7 @@ display_menu_bar (struct window *w)
#endif /* HAVE_NS */
#ifdef USE_X_TOOLKIT
- xassert (!FRAME_WINDOW_P (f));
+ eassert (!FRAME_WINDOW_P (f));
init_iterator (&it, w, -1, -1, f->desired_matrix->rows, MENU_FACE_ID);
it.first_visible_x = 0;
it.last_visible_x = FRAME_TOTAL_COLS (f) * FRAME_COLUMN_WIDTH (f);
@@ -19639,7 +20194,7 @@ display_menu_bar (struct window *w)
/* Menu bar lines are displayed in the desired matrix of the
dummy window menu_bar_window. */
struct window *menu_w;
- xassert (WINDOWP (f->menu_bar_window));
+ eassert (WINDOWP (f->menu_bar_window));
menu_w = XWINDOW (f->menu_bar_window);
init_iterator (&it, menu_w, -1, -1, menu_w->desired_matrix->rows,
MENU_FACE_ID);
@@ -19662,10 +20217,6 @@ display_menu_bar (struct window *w)
this. */
it.paragraph_embedding = L2R;
- if (! mode_line_inverse_video)
- /* Force the menu-bar to be displayed in the default face. */
- it.base_face_id = it.face_id = DEFAULT_FACE_ID;
-
/* Clear all rows of the menu bar. */
for (i = 0; i < FRAME_MENU_BAR_LINES (f); ++i)
{
@@ -19789,7 +20340,7 @@ display_mode_lines (struct window *w)
/* These will be set while the mode line specs are processed. */
line_number_displayed = 0;
- w->column_number_displayed = Qnil;
+ wset_column_number_displayed (w, Qnil);
if (WINDOW_WANTS_MODELINE_P (w))
{
@@ -19825,7 +20376,7 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format)
{
struct it it;
struct face *face;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
init_iterator (&it, w, -1, -1, NULL, face_id);
/* Don't extend on a previously drawn mode-line.
@@ -19835,17 +20386,13 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format)
it.glyph_row->mode_line_p = 1;
- if (! mode_line_inverse_video)
- /* Force the mode-line to be displayed in the default face. */
- it.base_face_id = it.face_id = DEFAULT_FACE_ID;
-
/* FIXME: This should be controlled by a user option. But
supporting such an option is not trivial, since the mode line is
made up of many separate strings. */
it.paragraph_embedding = L2R;
record_unwind_protect (unwind_format_mode_line,
- format_mode_line_unwind_data (NULL, Qnil, 0));
+ format_mode_line_unwind_data (NULL, NULL, Qnil, 0));
mode_line_target = MODE_LINE_DISPLAY;
@@ -19955,13 +20502,13 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
depth++;
- switch (SWITCH_ENUM_CAST (XTYPE (elt)))
+ switch (XTYPE (elt))
{
case Lisp_String:
{
/* A string: output it and check for %-constructs within it. */
unsigned char c;
- EMACS_INT offset = 0;
+ ptrdiff_t offset = 0;
if (SCHARS (elt) > 0
&& (!NILP (props) || risky))
@@ -20058,7 +20605,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
&& (mode_line_target != MODE_LINE_DISPLAY
|| it->current_x < it->last_visible_x))
{
- EMACS_INT last_offset = offset;
+ ptrdiff_t last_offset = offset;
/* Advance to end of string or next format specifier. */
while ((c = SREF (elt, offset++)) != '\0' && c != '%')
@@ -20066,7 +20613,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
if (offset - 1 != last_offset)
{
- EMACS_INT nchars, nbytes;
+ ptrdiff_t nchars, nbytes;
/* Output to end of string or up to '%'. Field width
is length of string. Don't output more than
@@ -20085,9 +20632,9 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
break;
case MODE_LINE_STRING:
{
- EMACS_INT bytepos = last_offset;
- EMACS_INT charpos = string_byte_to_char (elt, bytepos);
- EMACS_INT endpos = (precision <= 0
+ ptrdiff_t bytepos = last_offset;
+ ptrdiff_t charpos = string_byte_to_char (elt, bytepos);
+ ptrdiff_t endpos = (precision <= 0
? string_byte_to_char (elt, offset)
: charpos + nchars);
@@ -20099,8 +20646,8 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
break;
case MODE_LINE_DISPLAY:
{
- EMACS_INT bytepos = last_offset;
- EMACS_INT charpos = string_byte_to_char (elt, bytepos);
+ ptrdiff_t bytepos = last_offset;
+ ptrdiff_t charpos = string_byte_to_char (elt, bytepos);
if (precision <= 0)
nchars = string_byte_to_char (elt, offset) - charpos;
@@ -20113,7 +20660,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
}
else /* c == '%' */
{
- EMACS_INT percent_position = offset;
+ ptrdiff_t percent_position = offset;
/* Get the specified minimum width. Zero means
don't pad. */
@@ -20135,7 +20682,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
else if (c != 0)
{
int multibyte;
- EMACS_INT bytepos, charpos;
+ ptrdiff_t bytepos, charpos;
const char *spec;
Lisp_Object string;
@@ -20408,7 +20955,7 @@ static int
store_mode_line_string (const char *string, Lisp_Object lisp_string, int copy_string,
int field_width, int precision, Lisp_Object props)
{
- EMACS_INT len;
+ ptrdiff_t len;
int n = 0;
if (string != NULL)
@@ -20509,14 +21056,12 @@ are the selected window and the WINDOW's buffer). */)
struct buffer *old_buffer = NULL;
int face_id;
int no_props = INTEGERP (face);
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object str;
int string_start = 0;
- if (NILP (window))
- window = selected_window;
- CHECK_WINDOW (window);
- w = XWINDOW (window);
+ w = decode_any_window (window);
+ XSETWINDOW (window, w);
if (NILP (buffer))
buffer = w->buffer;
@@ -20539,19 +21084,18 @@ are the selected window and the WINDOW's buffer). */)
: EQ (face, Qtool_bar) ? TOOL_BAR_FACE_ID
: DEFAULT_FACE_ID;
- if (XBUFFER (buffer) != current_buffer)
- old_buffer = current_buffer;
+ old_buffer = current_buffer;
/* Save things including mode_line_proptrans_alist,
and set that to nil so that we don't alter the outer value. */
record_unwind_protect (unwind_format_mode_line,
format_mode_line_unwind_data
- (old_buffer, selected_window, 1));
+ (XFRAME (WINDOW_FRAME (w)),
+ old_buffer, selected_window, 1));
mode_line_proptrans_alist = Qnil;
Fselect_window (window, Qt);
- if (old_buffer)
- set_buffer_internal_1 (XBUFFER (buffer));
+ set_buffer_internal_1 (XBUFFER (buffer));
init_iterator (&it, w, -1, -1, NULL, face_id);
@@ -20595,7 +21139,7 @@ are the selected window and the WINDOW's buffer). */)
the positive integer D to BUF using a minimal field width WIDTH. */
static void
-pint2str (register char *buf, register int width, register EMACS_INT d)
+pint2str (register char *buf, register int width, register ptrdiff_t d)
{
register char *p = buf;
@@ -20639,11 +21183,11 @@ static const char power_letter[] =
};
static void
-pint2hrstr (char *buf, int width, EMACS_INT d)
+pint2hrstr (char *buf, int width, ptrdiff_t d)
{
/* We aim to represent the nonnegative integer D as
QUOTIENT.TENTHS * 10 ^ (3 * EXPONENT). */
- EMACS_INT quotient = d;
+ ptrdiff_t quotient = d;
int remainder = 0;
/* -1 means: do not use TENTHS. */
int tenths = -1;
@@ -20753,8 +21297,7 @@ decode_mode_spec_coding (Lisp_Object coding_system, register char *buf, int eol_
if (!VECTORP (val)) /* Not yet decided. */
{
- if (multibyte)
- *buf++ = '-';
+ *buf++ = multibyte ? '-' : ' ';
if (eol_flag)
eoltype = eol_mnemonic_undecided;
/* Don't mention EOL conversion if it isn't decided. */
@@ -20767,8 +21310,9 @@ decode_mode_spec_coding (Lisp_Object coding_system, register char *buf, int eol_
attrs = AREF (val, 0);
eolvalue = AREF (val, 2);
- if (multibyte)
- *buf++ = XFASTINT (CODING_ATTR_MNEMONIC (attrs));
+ *buf++ = multibyte
+ ? XFASTINT (CODING_ATTR_MNEMONIC (attrs))
+ : ' ';
if (eol_flag)
{
@@ -20796,7 +21340,7 @@ decode_mode_spec_coding (Lisp_Object coding_system, register char *buf, int eol_
}
else if (CHARACTERP (eoltype))
{
- unsigned char *tmp = (unsigned char *) alloca (MAX_MULTIBYTE_LENGTH);
+ unsigned char *tmp = alloca (MAX_MULTIBYTE_LENGTH);
int c = XFASTINT (eoltype);
eol_str_len = CHAR_STRING (c, tmp);
eol_str = tmp;
@@ -20830,6 +21374,12 @@ decode_mode_spec (struct window *w, register int c, int field_width,
Lisp_Object obj;
struct frame *f = XFRAME (WINDOW_FRAME (w));
char *decode_mode_spec_buf = f->decode_mode_spec_buffer;
+ /* We are going to use f->decode_mode_spec_buffer as the buffer to
+ produce strings from numerical values, so limit preposterously
+ large values of FIELD_WIDTH to avoid overrunning the buffer's
+ end. The size of the buffer is enough for FRAME_MESSAGE_BUF_SIZE
+ bytes plus the terminating null. */
+ int width = min (field_width, FRAME_MESSAGE_BUF_SIZE (f));
struct buffer *b = current_buffer;
obj = Qnil;
@@ -20923,9 +21473,9 @@ decode_mode_spec (struct window *w, register int c, int field_width,
return "";
else
{
- EMACS_INT col = current_column ();
- w->column_number_displayed = make_number (col);
- pint2str (decode_mode_spec_buf, field_width, col);
+ ptrdiff_t col = current_column ();
+ wset_column_number_displayed (w, make_number (col));
+ pint2str (decode_mode_spec_buf, width, col);
return decode_mode_spec_buf;
}
@@ -20955,23 +21505,23 @@ decode_mode_spec (struct window *w, register int c, int field_width,
case 'i':
{
- EMACS_INT size = ZV - BEGV;
- pint2str (decode_mode_spec_buf, field_width, size);
+ ptrdiff_t size = ZV - BEGV;
+ pint2str (decode_mode_spec_buf, width, size);
return decode_mode_spec_buf;
}
case 'I':
{
- EMACS_INT size = ZV - BEGV;
- pint2hrstr (decode_mode_spec_buf, field_width, size);
+ ptrdiff_t size = ZV - BEGV;
+ pint2hrstr (decode_mode_spec_buf, width, size);
return decode_mode_spec_buf;
}
case 'l':
{
- EMACS_INT startpos, startpos_byte, line, linepos, linepos_byte;
- EMACS_INT topline, nlines, height;
- EMACS_INT junk;
+ ptrdiff_t startpos, startpos_byte, line, linepos, linepos_byte;
+ ptrdiff_t topline, nlines, height;
+ ptrdiff_t junk;
/* %c and %l are ignored in `frame-title-format'. */
if (mode_line_target == MODE_LINE_TITLE)
@@ -20987,14 +21537,14 @@ decode_mode_spec (struct window *w, register int c, int field_width,
goto no_value;
/* But do forget it, if the window shows a different buffer now. */
else if (BUFFERP (w->base_line_pos))
- w->base_line_pos = Qnil;
+ wset_base_line_pos (w, Qnil);
/* If the buffer is very big, don't waste time. */
if (INTEGERP (Vline_number_display_limit)
&& BUF_ZV (b) - BUF_BEGV (b) > XINT (Vline_number_display_limit))
{
- w->base_line_pos = Qnil;
- w->base_line_number = Qnil;
+ wset_base_line_pos (w, Qnil);
+ wset_base_line_number (w, Qnil);
goto no_value;
}
@@ -21026,16 +21576,16 @@ decode_mode_spec (struct window *w, register int c, int field_width,
go back past it. */
if (startpos == BUF_BEGV (b))
{
- w->base_line_number = make_number (topline);
- w->base_line_pos = make_number (BUF_BEGV (b));
+ wset_base_line_number (w, make_number (topline));
+ wset_base_line_pos (w, make_number (BUF_BEGV (b)));
}
else if (nlines < height + 25 || nlines > height * 3 + 50
|| linepos == BUF_BEGV (b))
{
- EMACS_INT limit = BUF_BEGV (b);
- EMACS_INT limit_byte = BUF_BEGV_BYTE (b);
- EMACS_INT position;
- EMACS_INT distance =
+ ptrdiff_t limit = BUF_BEGV (b);
+ ptrdiff_t limit_byte = BUF_BEGV_BYTE (b);
+ ptrdiff_t position;
+ ptrdiff_t distance =
(height * 2 + 30) * line_number_display_limit_width;
if (startpos - distance > limit)
@@ -21053,13 +21603,13 @@ decode_mode_spec (struct window *w, register int c, int field_width,
give up on line numbers for this window. */
if (position == limit_byte && limit == startpos - distance)
{
- w->base_line_pos = w->buffer;
- w->base_line_number = Qnil;
+ wset_base_line_pos (w, w->buffer);
+ wset_base_line_number (w, Qnil);
goto no_value;
}
- w->base_line_number = make_number (topline - nlines);
- w->base_line_pos = make_number (BYTE_TO_CHAR (position));
+ wset_base_line_number (w, make_number (topline - nlines));
+ wset_base_line_pos (w, make_number (BYTE_TO_CHAR (position)));
}
/* Now count lines from the start pos to point. */
@@ -21070,12 +21620,12 @@ decode_mode_spec (struct window *w, register int c, int field_width,
line_number_displayed = 1;
/* Make the string to show. */
- pint2str (decode_mode_spec_buf, field_width, topline + nlines);
+ pint2str (decode_mode_spec_buf, width, topline + nlines);
return decode_mode_spec_buf;
no_value:
{
char* p = decode_mode_spec_buf;
- int pad = field_width - 2;
+ int pad = width - 2;
while (pad-- > 0)
*p++ = ' ';
*p++ = '?';
@@ -21097,8 +21647,8 @@ decode_mode_spec (struct window *w, register int c, int field_width,
case 'p':
{
- EMACS_INT pos = marker_position (w->start);
- EMACS_INT total = BUF_ZV (b) - BUF_BEGV (b);
+ ptrdiff_t pos = marker_position (w->start);
+ ptrdiff_t total = BUF_ZV (b) - BUF_BEGV (b);
if (XFASTINT (w->window_end_pos) <= BUF_Z (b) - BUF_ZV (b))
{
@@ -21120,7 +21670,7 @@ decode_mode_spec (struct window *w, register int c, int field_width,
so get us a 2-digit number that is close. */
if (total == 100)
total = 99;
- sprintf (decode_mode_spec_buf, "%2"pI"d%%", total);
+ sprintf (decode_mode_spec_buf, "%2"pD"d%%", total);
return decode_mode_spec_buf;
}
}
@@ -21128,9 +21678,9 @@ decode_mode_spec (struct window *w, register int c, int field_width,
/* Display percentage of size above the bottom of the screen. */
case 'P':
{
- EMACS_INT toppos = marker_position (w->start);
- EMACS_INT botpos = BUF_Z (b) - XFASTINT (w->window_end_pos);
- EMACS_INT total = BUF_ZV (b) - BUF_BEGV (b);
+ ptrdiff_t toppos = marker_position (w->start);
+ ptrdiff_t botpos = BUF_Z (b) - XFASTINT (w->window_end_pos);
+ ptrdiff_t total = BUF_ZV (b) - BUF_BEGV (b);
if (botpos >= BUF_ZV (b))
{
@@ -21151,9 +21701,9 @@ decode_mode_spec (struct window *w, register int c, int field_width,
if (total == 100)
total = 99;
if (toppos <= BUF_BEGV (b))
- sprintf (decode_mode_spec_buf, "Top%2"pI"d%%", total);
+ sprintf (decode_mode_spec_buf, "Top%2"pD"d%%", total);
else
- sprintf (decode_mode_spec_buf, "%2"pI"d%%", total);
+ sprintf (decode_mode_spec_buf, "%2"pD"d%%", total);
return decode_mode_spec_buf;
}
}
@@ -21170,7 +21720,7 @@ decode_mode_spec (struct window *w, register int c, int field_width,
case '@':
{
- int count = inhibit_garbage_collection ();
+ ptrdiff_t count = inhibit_garbage_collection ();
Lisp_Object val = call1 (intern ("file-remote-p"),
BVAR (current_buffer, directory));
unbind_to (count, Qnil);
@@ -21211,10 +21761,10 @@ decode_mode_spec (struct window *w, register int c, int field_width,
obj = Fget_buffer_process (Fcurrent_buffer ());
if (PROCESSP (obj))
{
- p = decode_mode_spec_coding (XPROCESS (obj)->decode_coding_system,
- p, eol_flag);
- p = decode_mode_spec_coding (XPROCESS (obj)->encode_coding_system,
- p, eol_flag);
+ p = decode_mode_spec_coding
+ (XPROCESS (obj)->decode_coding_system, p, eol_flag);
+ p = decode_mode_spec_coding
+ (XPROCESS (obj)->encode_coding_system, p, eol_flag);
}
#endif /* subprocesses */
#endif /* 0 */
@@ -21239,17 +21789,17 @@ decode_mode_spec (struct window *w, register int c, int field_width,
Set *BYTE_POS_PTR to 1 if we found COUNT lines, 0 if we hit LIMIT. */
-static EMACS_INT
-display_count_lines (EMACS_INT start_byte,
- EMACS_INT limit_byte, EMACS_INT count,
- EMACS_INT *byte_pos_ptr)
+static ptrdiff_t
+display_count_lines (ptrdiff_t start_byte,
+ ptrdiff_t limit_byte, ptrdiff_t count,
+ ptrdiff_t *byte_pos_ptr)
{
register unsigned char *cursor;
unsigned char *base;
- register EMACS_INT ceiling;
+ register ptrdiff_t ceiling;
register unsigned char *ceiling_addr;
- EMACS_INT orig_count = count;
+ ptrdiff_t orig_count = count;
/* If we are not in selective display mode,
check only for newlines. */
@@ -21383,13 +21933,13 @@ display_count_lines (EMACS_INT start_byte,
static int
display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_string,
- EMACS_INT face_string_pos, EMACS_INT start, struct it *it,
+ ptrdiff_t face_string_pos, ptrdiff_t start, struct it *it,
int field_width, int precision, int max_x, int multibyte)
{
int hpos_at_start = it->hpos;
int saved_face_id = it->face_id;
struct glyph_row *row = it->glyph_row;
- EMACS_INT it_charpos;
+ ptrdiff_t it_charpos;
/* Initialize the iterator IT for iteration over STRING beginning
with index START. */
@@ -21404,7 +21954,7 @@ display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_st
FACE_STRING, if that's given. */
if (STRINGP (face_string))
{
- EMACS_INT endptr;
+ ptrdiff_t endptr;
struct face *face;
it->face_id
@@ -21496,7 +22046,7 @@ display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_st
{
/* Glyph is off the left margin of the display area.
Should not happen. */
- abort ();
+ emacs_abort ();
}
row->ascent = max (row->ascent, it->max_ascent);
@@ -21573,7 +22123,10 @@ display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_st
if (it->first_visible_x
&& it_charpos > 0)
{
- if (!FRAME_WINDOW_P (it->f))
+ if (!FRAME_WINDOW_P (it->f)
+ || (row->reversed_p
+ ? WINDOW_RIGHT_FRINGE_WIDTH (it->w)
+ : WINDOW_LEFT_FRINGE_WIDTH (it->w)) == 0)
insert_left_trunc_glyphs (it);
row->truncated_on_left_p = 1;
}
@@ -21734,7 +22287,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
if (NILP (prop))
return OK_PIXELS (0);
- xassert (FRAME_LIVE_P (it->f));
+ eassert (FRAME_LIVE_P (it->f));
if (SYMBOLP (prop))
{
@@ -21833,7 +22386,9 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
return OK_PIXELS (WINDOW_SCROLL_BAR_AREA_WIDTH (it->w));
}
- prop = Fbuffer_local_value (prop, it->w->buffer);
+ prop = buffer_local_value_1 (prop, it->w->buffer);
+ if (EQ (prop, Qunbound))
+ prop = Qnil;
}
if (INTEGERP (prop) || FLOATP (prop))
@@ -21883,7 +22438,9 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
return OK_PIXELS (pixels);
}
- car = Fbuffer_local_value (car, it->w->buffer);
+ car = buffer_local_value_1 (car, it->w->buffer);
+ if (EQ (car, Qunbound))
+ car = Qnil;
}
if (INTEGERP (car) || FLOATP (car))
@@ -21911,7 +22468,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
#ifdef HAVE_WINDOW_SYSTEM
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
void
dump_glyph_string (struct glyph_string *s)
@@ -21982,7 +22539,7 @@ init_glyph_string (struct glyph_string *s,
/* Append the list of glyph strings with head H and tail T to the list
with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the result. */
-static inline void
+static void
append_glyph_string_lists (struct glyph_string **head, struct glyph_string **tail,
struct glyph_string *h, struct glyph_string *t)
{
@@ -22002,7 +22559,7 @@ append_glyph_string_lists (struct glyph_string **head, struct glyph_string **tai
list with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the
result. */
-static inline void
+static void
prepend_glyph_string_lists (struct glyph_string **head, struct glyph_string **tail,
struct glyph_string *h, struct glyph_string *t)
{
@@ -22021,7 +22578,7 @@ prepend_glyph_string_lists (struct glyph_string **head, struct glyph_string **ta
/* Append glyph string S to the list with head *HEAD and tail *TAIL.
Set *HEAD and *TAIL to the resulting list. */
-static inline void
+static void
append_glyph_string (struct glyph_string **head, struct glyph_string **tail,
struct glyph_string *s)
{
@@ -22036,7 +22593,7 @@ append_glyph_string (struct glyph_string **head, struct glyph_string **tail,
Value is a pointer to a realized face that is ready for display if
DISPLAY_P is non-zero. */
-static inline struct face *
+static struct face *
get_char_face_and_encoding (struct frame *f, int c, int face_id,
XChar2b *char2b, int display_p)
{
@@ -22057,7 +22614,7 @@ get_char_face_and_encoding (struct frame *f, int c, int face_id,
if (display_p)
#endif
{
- xassert (face != NULL);
+ eassert (face != NULL);
PREPARE_FACE_FOR_DISPLAY (f, face);
}
@@ -22069,13 +22626,13 @@ get_char_face_and_encoding (struct frame *f, int c, int face_id,
The encoding of GLYPH->u.ch is returned in *CHAR2B. Value is
a pointer to a realized face that is ready for display. */
-static inline struct face *
+static struct face *
get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph,
XChar2b *char2b, int *two_byte_p)
{
struct face *face;
- xassert (glyph->type == CHAR_GLYPH);
+ eassert (glyph->type == CHAR_GLYPH);
face = FACE_FROM_ID (f, glyph->face_id);
if (two_byte_p)
@@ -22097,7 +22654,7 @@ get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph,
}
/* Make sure X resources of the face are allocated. */
- xassert (face != NULL);
+ eassert (face != NULL);
PREPARE_FACE_FOR_DISPLAY (f, face);
return face;
}
@@ -22106,7 +22663,7 @@ get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph,
/* Get glyph code of character C in FONT in the two-byte form CHAR2B.
Return 1 if FONT has a glyph for C, otherwise return 0. */
-static inline int
+static int
get_char_glyph_code (int c, struct font *font, XChar2b *char2b)
{
unsigned code;
@@ -22143,7 +22700,7 @@ fill_composite_glyph_string (struct glyph_string *s, struct face *base_face,
glyph that requires the different face, add it to S. */
struct face *face;
- xassert (s);
+ eassert (s);
s->for_overlaps = overlaps;
s->face = NULL;
@@ -22253,13 +22810,13 @@ fill_glyphless_glyph_string (struct glyph_string *s, int face_id,
struct glyph *glyph, *last;
int voffset;
- xassert (s->first_glyph->type == GLYPHLESS_GLYPH);
+ eassert (s->first_glyph->type == GLYPHLESS_GLYPH);
s->for_overlaps = overlaps;
glyph = s->row->glyphs[s->area] + start;
last = s->row->glyphs[s->area] + end;
voffset = glyph->voffset;
s->face = FACE_FROM_ID (s->f, face_id);
- s->font = s->face->font;
+ s->font = s->face->font ? s->face->font : FRAME_FONT (s->f);
s->nchars = 1;
s->width = glyph->pixel_width;
glyph++;
@@ -22294,9 +22851,9 @@ fill_glyph_string (struct glyph_string *s, int face_id,
int voffset;
int glyph_not_available_p;
- xassert (s->f == XFRAME (s->w->frame));
- xassert (s->nchars == 0);
- xassert (start >= 0 && end > start);
+ eassert (s->f == XFRAME (s->w->frame));
+ eassert (s->nchars == 0);
+ eassert (start >= 0 && end > start);
s->for_overlaps = overlaps;
glyph = s->row->glyphs[s->area] + start;
@@ -22319,7 +22876,7 @@ fill_glyph_string (struct glyph_string *s, int face_id,
&two_byte_p);
s->two_byte_p = two_byte_p;
++s->nchars;
- xassert (s->nchars <= end - start);
+ eassert (s->nchars <= end - start);
s->width += glyph->pixel_width;
if (glyph++->padding_p != s->padding_p)
break;
@@ -22340,7 +22897,7 @@ fill_glyph_string (struct glyph_string *s, int face_id,
/* Adjust base line for subscript/superscript text. */
s->ybase += voffset;
- xassert (s->face && s->face->gc);
+ eassert (s->face && s->face->gc);
return glyph - s->row->glyphs[s->area];
}
@@ -22350,9 +22907,9 @@ fill_glyph_string (struct glyph_string *s, int face_id,
static void
fill_image_glyph_string (struct glyph_string *s)
{
- xassert (s->first_glyph->type == IMAGE_GLYPH);
+ eassert (s->first_glyph->type == IMAGE_GLYPH);
s->img = IMAGE_FROM_ID (s->f, s->first_glyph->u.img_id);
- xassert (s->img);
+ eassert (s->img);
s->slice = s->first_glyph->slice.img;
s->face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
s->font = s->face->font;
@@ -22376,7 +22933,7 @@ fill_stretch_glyph_string (struct glyph_string *s, int start, int end)
struct glyph *glyph, *last;
int voffset, face_id;
- xassert (s->first_glyph->type == STRETCH_GLYPH);
+ eassert (s->first_glyph->type == STRETCH_GLYPH);
glyph = s->row->glyphs[s->area] + start;
last = s->row->glyphs[s->area] + end;
@@ -22400,7 +22957,7 @@ fill_stretch_glyph_string (struct glyph_string *s, int start, int end)
/* The case that face->gc == 0 is handled when drawing the glyph
string by calling PREPARE_FACE_FOR_DISPLAY. */
- xassert (s->face);
+ eassert (s->face);
return glyph - s->row->glyphs[s->area];
}
@@ -22534,7 +23091,8 @@ right_overwritten (struct glyph_string *s)
{
int x = 0, i;
struct glyph *glyphs = s->row->glyphs[s->area];
- int first = (s->first_glyph - glyphs) + (s->cmp ? 1 : s->nchars);
+ int first = (s->first_glyph - glyphs
+ + (s->first_glyph->type == COMPOSITE_GLYPH ? 1 : s->nchars));
int end = s->row->used[s->area];
for (i = first; i < end && s->right_overhang > x; ++i)
@@ -22557,7 +23115,8 @@ right_overwriting (struct glyph_string *s)
int i, k, x;
int end = s->row->used[s->area];
struct glyph *glyphs = s->row->glyphs[s->area];
- int first = (s->first_glyph - glyphs) + (s->cmp ? 1 : s->nchars);
+ int first = (s->first_glyph - glyphs
+ + (s->first_glyph->type == COMPOSITE_GLYPH ? 1 : s->nchars));
k = -1;
x = 0;
@@ -22578,7 +23137,7 @@ right_overwriting (struct glyph_string *s)
first glyph following S. LAST_X is the right-most x-position + 1
in the drawing area. */
-static inline void
+static void
set_glyph_string_background_width (struct glyph_string *s, int start, int last_x)
{
/* If the face of this glyph string has to be drawn to the end of
@@ -22665,7 +23224,7 @@ compute_overhangs_and_x (struct glyph_string *s, int x, int backward_p)
#define BUILD_STRETCH_GLYPH_STRING(START, END, HEAD, TAIL, HL, X, LAST_X) \
do \
{ \
- s = (struct glyph_string *) alloca (sizeof *s); \
+ s = alloca (sizeof *s); \
INIT_GLYPH_STRING (s, NULL, w, row, area, START, HL); \
START = fill_stretch_glyph_string (s, START, END); \
append_glyph_string (&HEAD, &TAIL, s); \
@@ -22685,7 +23244,7 @@ compute_overhangs_and_x (struct glyph_string *s, int x, int backward_p)
#define BUILD_IMAGE_GLYPH_STRING(START, END, HEAD, TAIL, HL, X, LAST_X) \
do \
{ \
- s = (struct glyph_string *) alloca (sizeof *s); \
+ s = alloca (sizeof *s); \
INIT_GLYPH_STRING (s, NULL, w, row, area, START, HL); \
fill_image_glyph_string (s); \
append_glyph_string (&HEAD, &TAIL, s); \
@@ -22712,8 +23271,8 @@ compute_overhangs_and_x (struct glyph_string *s, int x, int backward_p)
\
face_id = (row)->glyphs[area][START].face_id; \
\
- s = (struct glyph_string *) alloca (sizeof *s); \
- char2b = (XChar2b *) alloca ((END - START) * sizeof *char2b); \
+ s = alloca (sizeof *s); \
+ char2b = alloca ((END - START) * sizeof *char2b); \
INIT_GLYPH_STRING (s, char2b, w, row, area, START, HL); \
append_glyph_string (&HEAD, &TAIL, s); \
s->x = (X); \
@@ -22738,16 +23297,16 @@ compute_overhangs_and_x (struct glyph_string *s, int x, int backward_p)
ptrdiff_t cmp_id = (row)->glyphs[area][START].u.cmp.id; \
struct composition *cmp = composition_table[cmp_id]; \
XChar2b *char2b; \
- struct glyph_string *first_s IF_LINT (= NULL); \
+ struct glyph_string *first_s = NULL; \
int n; \
\
- char2b = (XChar2b *) alloca ((sizeof *char2b) * cmp->glyph_len); \
+ char2b = alloca (cmp->glyph_len * sizeof *char2b); \
\
/* Make glyph_strings for each glyph sequence that is drawable by \
the same face, and append them to HEAD/TAIL. */ \
for (n = 0; n < cmp->glyph_len;) \
{ \
- s = (struct glyph_string *) alloca (sizeof *s); \
+ s = alloca (sizeof *s); \
INIT_GLYPH_STRING (s, char2b, w, row, area, START, HL); \
append_glyph_string (&(HEAD), &(TAIL), s); \
s->cmp = cmp; \
@@ -22775,9 +23334,8 @@ compute_overhangs_and_x (struct glyph_string *s, int x, int backward_p)
face_id = (row)->glyphs[area][START].face_id; \
gstring = (composition_gstring_from_id \
((row)->glyphs[area][START].u.cmp.id)); \
- s = (struct glyph_string *) alloca (sizeof *s); \
- char2b = (XChar2b *) alloca ((sizeof *char2b) \
- * LGSTRING_GLYPH_LEN (gstring)); \
+ s = alloca (sizeof *s); \
+ char2b = alloca (LGSTRING_GLYPH_LEN (gstring) * sizeof *char2b); \
INIT_GLYPH_STRING (s, char2b, w, row, area, START, HL); \
append_glyph_string (&(HEAD), &(TAIL), s); \
s->x = (X); \
@@ -22796,7 +23354,7 @@ compute_overhangs_and_x (struct glyph_string *s, int x, int backward_p)
\
face_id = (row)->glyphs[area][START].face_id; \
\
- s = (struct glyph_string *) alloca (sizeof *s); \
+ s = alloca (sizeof *s); \
INIT_GLYPH_STRING (s, NULL, w, row, area, START, HL); \
append_glyph_string (&HEAD, &TAIL, s); \
s->x = (X); \
@@ -22855,7 +23413,7 @@ compute_overhangs_and_x (struct glyph_string *s, int x, int backward_p)
break; \
\
default: \
- abort (); \
+ emacs_abort (); \
} \
\
if (s) \
@@ -22891,7 +23449,7 @@ compute_overhangs_and_x (struct glyph_string *s, int x, int backward_p)
static int
draw_glyphs (struct window *w, int x, struct glyph_row *row,
- enum glyph_row_area area, EMACS_INT start, EMACS_INT end,
+ enum glyph_row_area area, ptrdiff_t start, ptrdiff_t end,
enum draw_glyphs_face hl, int overlaps)
{
struct glyph_string *head, *tail;
@@ -23140,14 +23698,14 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row,
/* Store one glyph for IT->char_to_display in IT->glyph_row.
Called from x_produce_glyphs when IT->glyph_row is non-null. */
-static inline void
+static void
append_glyph (struct it *it)
{
struct glyph *glyph;
enum glyph_row_area area = it->area;
- xassert (it->glyph_row);
- xassert (it->char_to_display != '\n' && it->char_to_display != '\t');
+ eassert (it->glyph_row);
+ eassert (it->char_to_display != '\n' && it->char_to_display != '\t');
glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
if (glyph < it->glyph_row->glyphs[area + 1])
@@ -23196,7 +23754,7 @@ append_glyph (struct it *it)
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
else
@@ -23214,13 +23772,13 @@ append_glyph (struct it *it)
IT->glyph_row. Called from x_produce_glyphs when IT->glyph_row is
non-null. */
-static inline void
+static void
append_composite_glyph (struct it *it)
{
struct glyph *glyph;
enum glyph_row_area area = it->area;
- xassert (it->glyph_row);
+ eassert (it->glyph_row);
glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
if (glyph < it->glyph_row->glyphs[area + 1])
@@ -23270,7 +23828,7 @@ append_composite_glyph (struct it *it)
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
++it->glyph_row->used[area];
@@ -23283,7 +23841,7 @@ append_composite_glyph (struct it *it)
/* Change IT->ascent and IT->height according to the setting of
IT->voffset. */
-static inline void
+static void
take_vertical_position_into_account (struct it *it)
{
if (it->voffset)
@@ -23312,10 +23870,10 @@ produce_image_glyph (struct it *it)
int glyph_ascent, crop;
struct glyph_slice slice;
- xassert (it->what == IT_IMAGE);
+ eassert (it->what == IT_IMAGE);
face = FACE_FROM_ID (it->f, it->face_id);
- xassert (face);
+ eassert (face);
/* Make sure X resources of the face is loaded. */
PREPARE_FACE_FOR_DISPLAY (it->f, face);
@@ -23330,7 +23888,7 @@ produce_image_glyph (struct it *it)
}
img = IMAGE_FROM_ID (it->f, it->image_id);
- xassert (img);
+ eassert (img);
/* Make sure X resources of the image is loaded. */
prepare_image_for_display (it->f, img);
@@ -23449,7 +24007,7 @@ produce_image_glyph (struct it *it)
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
++it->glyph_row->used[area];
@@ -23471,7 +24029,7 @@ append_stretch_glyph (struct it *it, Lisp_Object object,
struct glyph *glyph;
enum glyph_row_area area = it->area;
- xassert (ascent >= 0 && ascent <= height);
+ eassert (ascent >= 0 && ascent <= height);
glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
if (glyph < it->glyph_row->glyphs[area + 1])
@@ -23510,7 +24068,7 @@ append_stretch_glyph (struct it *it, Lisp_Object object,
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
else
@@ -23564,24 +24122,23 @@ produce_stretch_glyph (struct it *it)
Lisp_Object prop, plist;
int width = 0, height = 0, align_to = -1;
int zero_width_ok_p = 0;
- int ascent = 0;
double tem;
- struct face *face = NULL;
struct font *font = NULL;
#ifdef HAVE_WINDOW_SYSTEM
+ int ascent = 0;
int zero_height_ok_p = 0;
if (FRAME_WINDOW_P (it->f))
{
- face = FACE_FROM_ID (it->f, it->face_id);
+ struct face *face = FACE_FROM_ID (it->f, it->face_id);
font = face->font ? face->font : FRAME_FONT (it->f);
PREPARE_FACE_FOR_DISPLAY (it->f, face);
}
#endif
/* List should start with `space'. */
- xassert (CONSP (it->object) && EQ (XCAR (it->object), Qspace));
+ eassert (CONSP (it->object) && EQ (XCAR (it->object), Qspace));
plist = XCDR (it->object);
/* Compute the width of the stretch. */
@@ -23720,6 +24277,102 @@ produce_stretch_glyph (struct it *it)
it->nglyphs = width;
}
+/* Get information about special display element WHAT in an
+ environment described by IT. WHAT is one of IT_TRUNCATION or
+ IT_CONTINUATION. Maybe produce glyphs for WHAT if IT has a
+ non-null glyph_row member. This function ensures that fields like
+ face_id, c, len of IT are left untouched. */
+
+static void
+produce_special_glyphs (struct it *it, enum display_element_type what)
+{
+ struct it temp_it;
+ Lisp_Object gc;
+ GLYPH glyph;
+
+ temp_it = *it;
+ temp_it.object = make_number (0);
+ memset (&temp_it.current, 0, sizeof temp_it.current);
+
+ if (what == IT_CONTINUATION)
+ {
+ /* Continuation glyph. For R2L lines, we mirror it by hand. */
+ if (it->bidi_it.paragraph_dir == R2L)
+ SET_GLYPH_FROM_CHAR (glyph, '/');
+ else
+ SET_GLYPH_FROM_CHAR (glyph, '\\');
+ if (it->dp
+ && (gc = DISP_CONTINUE_GLYPH (it->dp), GLYPH_CODE_P (gc)))
+ {
+ /* FIXME: Should we mirror GC for R2L lines? */
+ SET_GLYPH_FROM_GLYPH_CODE (glyph, gc);
+ spec_glyph_lookup_face (XWINDOW (it->window), &glyph);
+ }
+ }
+ else if (what == IT_TRUNCATION)
+ {
+ /* Truncation glyph. */
+ SET_GLYPH_FROM_CHAR (glyph, '$');
+ if (it->dp
+ && (gc = DISP_TRUNC_GLYPH (it->dp), GLYPH_CODE_P (gc)))
+ {
+ /* FIXME: Should we mirror GC for R2L lines? */
+ SET_GLYPH_FROM_GLYPH_CODE (glyph, gc);
+ spec_glyph_lookup_face (XWINDOW (it->window), &glyph);
+ }
+ }
+ else
+ emacs_abort ();
+
+#ifdef HAVE_WINDOW_SYSTEM
+ /* On a GUI frame, when the right fringe (left fringe for R2L rows)
+ is turned off, we precede the truncation/continuation glyphs by a
+ stretch glyph whose width is computed such that these special
+ glyphs are aligned at the window margin, even when very different
+ fonts are used in different glyph rows. */
+ if (FRAME_WINDOW_P (temp_it.f)
+ /* init_iterator calls this with it->glyph_row == NULL, and it
+ wants only the pixel width of the truncation/continuation
+ glyphs. */
+ && temp_it.glyph_row
+ /* insert_left_trunc_glyphs calls us at the beginning of the
+ row, and it has its own calculation of the stretch glyph
+ width. */
+ && temp_it.glyph_row->used[TEXT_AREA] > 0
+ && (temp_it.glyph_row->reversed_p
+ ? WINDOW_LEFT_FRINGE_WIDTH (temp_it.w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (temp_it.w)) == 0)
+ {
+ int stretch_width = temp_it.last_visible_x - temp_it.current_x;
+
+ if (stretch_width > 0)
+ {
+ struct face *face = FACE_FROM_ID (temp_it.f, temp_it.face_id);
+ struct font *font =
+ face->font ? face->font : FRAME_FONT (temp_it.f);
+ int stretch_ascent =
+ (((temp_it.ascent + temp_it.descent)
+ * FONT_BASE (font)) / FONT_HEIGHT (font));
+
+ append_stretch_glyph (&temp_it, make_number (0), stretch_width,
+ temp_it.ascent + temp_it.descent,
+ stretch_ascent);
+ }
+ }
+#endif
+
+ temp_it.dp = NULL;
+ temp_it.what = IT_CHARACTER;
+ temp_it.len = 1;
+ temp_it.c = temp_it.char_to_display = GLYPH_CHAR (glyph);
+ temp_it.face_id = GLYPH_FACE (glyph);
+ temp_it.len = CHAR_BYTES (temp_it.c);
+
+ PRODUCE_GLYPHS (&temp_it);
+ it->pixel_width = temp_it.pixel_width;
+ it->nglyphs = temp_it.pixel_width;
+}
+
#ifdef HAVE_WINDOW_SYSTEM
/* Calculate line-height and line-spacing properties.
@@ -23866,7 +24519,7 @@ append_glyphless_glyph (struct it *it, int face_id, int for_no_font, int len,
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
++it->glyph_row->used[area];
@@ -23960,11 +24613,11 @@ produce_glyphless_glyph (struct it *it, int for_no_font, Lisp_Object acronym)
}
else
{
- xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE);
+ eassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE);
sprintf (buf, "%0*X", it->c < 0x10000 ? 4 : 6, it->c);
str = buf;
}
- for (len = 0; str[len] && ASCII_BYTE_P (str[len]); len++)
+ for (len = 0; str[len] && ASCII_BYTE_P (str[len]) && len < 6; len++)
code[len] = font->driver->encode_char (font, str[len]);
upper_len = (len + 1) / 2;
font->driver->text_extents (font, code, upper_len,
@@ -24062,7 +24715,7 @@ x_produce_glyphs (struct it *it)
Vglyphless_char_display. */
Lisp_Object acronym = lookup_glyphless_char_display (-1, it);
- xassert (it->what == IT_GLYPHLESS);
+ eassert (it->what == IT_GLYPHLESS);
produce_glyphless_glyph (it, 1, STRINGP (acronym) ? acronym : Qnil);
goto done;
}
@@ -24355,7 +25008,7 @@ x_produce_glyphs (struct it *it)
XChar2b char2b;
struct font_metrics *pcm;
int font_not_found_p;
- EMACS_INT pos;
+ ptrdiff_t pos;
for (glyph_len = cmp->glyph_len; glyph_len > 0; glyph_len--)
if ((c = COMPOSITION_GLYPH (cmp, glyph_len - 1)) != '\t')
@@ -24387,7 +25040,7 @@ x_produce_glyphs (struct it *it)
font_descent = FONT_DESCENT (font) - boff;
font_height = FONT_HEIGHT (font);
- cmp->font = (void *) font;
+ cmp->font = font;
pcm = NULL;
if (! font_not_found_p)
@@ -24400,7 +25053,7 @@ x_produce_glyphs (struct it *it)
/* Initialize the bounding box. */
if (pcm)
{
- width = pcm->width;
+ width = cmp->glyph_len > 0 ? pcm->width : 0;
ascent = pcm->ascent;
descent = pcm->descent;
lbearing = pcm->lbearing;
@@ -24408,7 +25061,7 @@ x_produce_glyphs (struct it *it)
}
else
{
- width = font->space_width;
+ width = cmp->glyph_len > 0 ? font->space_width : 0;
ascent = FONT_BASE (font);
descent = FONT_DESCENT (font);
lbearing = 0;
@@ -24626,7 +25279,7 @@ x_produce_glyphs (struct it *it)
if (it->descent < 0)
it->descent = 0;
- if (it->glyph_row)
+ if (it->glyph_row && cmp->glyph_len > 0)
append_composite_glyph (it);
}
else if (it->what == IT_COMPOSITION)
@@ -24687,7 +25340,7 @@ x_produce_glyphs (struct it *it)
done:
/* Accumulate dimensions. Note: can't assume that it->descent > 0
because this isn't true for images with `:ascent 100'. */
- xassert (it->ascent >= 0 && it->descent >= 0);
+ eassert (it->ascent >= 0 && it->descent >= 0);
if (it->area == TEXT_AREA)
it->current_x += it->pixel_width;
@@ -24716,7 +25369,7 @@ x_write_glyphs (struct glyph *start, int len)
{
int x, hpos, chpos = updated_window->phys_cursor.hpos;
- xassert (updated_window && updated_row);
+ eassert (updated_window && updated_row);
/* When the window is hscrolled, cursor hpos can legitimately be out
of bounds, but we draw the cursor at the corresponding window
margin in that case. */
@@ -24725,7 +25378,7 @@ x_write_glyphs (struct glyph *start, int len)
if (updated_row->reversed_p && chpos >= updated_row->used[TEXT_AREA])
chpos = updated_row->used[TEXT_AREA] - 1;
- BLOCK_INPUT;
+ block_input ();
/* Write glyphs. */
@@ -24743,7 +25396,7 @@ x_write_glyphs (struct glyph *start, int len)
&& chpos < hpos + len)
updated_window->phys_cursor_on_p = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
/* Advance the output cursor. */
output_cursor.hpos += len;
@@ -24763,10 +25416,10 @@ x_insert_glyphs (struct glyph *start, int len)
struct glyph_row *row;
struct glyph *glyph;
int frame_x, frame_y;
- EMACS_INT hpos;
+ ptrdiff_t hpos;
- xassert (updated_window && updated_row);
- BLOCK_INPUT;
+ eassert (updated_window && updated_row);
+ block_input ();
w = updated_window;
f = XFRAME (WINDOW_FRAME (w));
@@ -24800,7 +25453,7 @@ x_insert_glyphs (struct glyph *start, int len)
/* Advance the output cursor. */
output_cursor.hpos += len;
output_cursor.x += shift_by_width;
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -24820,7 +25473,7 @@ x_clear_end_of_line (int to_x)
int max_x, min_y, max_y;
int from_x, from_y, to_y;
- xassert (updated_window && updated_row);
+ eassert (updated_window && updated_row);
f = XFRAME (w->frame);
if (updated_row->full_width_p)
@@ -24869,10 +25522,10 @@ x_clear_end_of_line (int to_x)
/* Prevent inadvertently clearing to end of the X window. */
if (to_x > from_x && to_y > from_y)
{
- BLOCK_INPUT;
+ block_input ();
FRAME_RIF (f)->clear_frame_area (f, from_x, from_y,
to_x - from_x, to_y - from_y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -24910,8 +25563,7 @@ get_specified_cursor_type (Lisp_Object arg, int *width)
if (CONSP (arg)
&& EQ (XCAR (arg), Qbar)
- && INTEGERP (XCDR (arg))
- && XINT (XCDR (arg)) >= 0)
+ && RANGED_INTEGERP (0, XCDR (arg), INT_MAX))
{
*width = XINT (XCDR (arg));
return BAR_CURSOR;
@@ -24925,8 +25577,7 @@ get_specified_cursor_type (Lisp_Object arg, int *width)
if (CONSP (arg)
&& EQ (XCAR (arg), Qhbar)
- && INTEGERP (XCDR (arg))
- && XINT (XCDR (arg)) >= 0)
+ && RANGED_INTEGERP (0, XCDR (arg), INT_MAX))
{
*width = XINT (XCDR (arg));
return HBAR_CURSOR;
@@ -25201,7 +25852,7 @@ x_fix_overlapping_area (struct window *w, struct glyph_row *row,
{
int i, x;
- BLOCK_INPUT;
+ block_input ();
x = 0;
for (i = 0; i < row->used[area];)
@@ -25229,7 +25880,7 @@ x_fix_overlapping_area (struct window *w, struct glyph_row *row,
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -25447,7 +26098,7 @@ display_and_set_cursor (struct window *w, int on,
|| (0 <= hpos && hpos < glyph_row->used[TEXT_AREA]))
glyph = glyph_row->glyphs[TEXT_AREA] + hpos;
- xassert (interrupt_input_blocked);
+ eassert (input_blocked_p ());
/* Set new_cursor_type to the cursor we want to be displayed. */
new_cursor_type = get_window_cursor_type (w, glyph,
@@ -25517,10 +26168,10 @@ update_window_cursor (struct window *w, int on)
if (row->reversed_p && hpos >= row->used[TEXT_AREA])
hpos = row->used[TEXT_AREA] - 1;
- BLOCK_INPUT;
+ block_input ();
display_and_set_cursor (w, on, hpos, vpos,
w->phys_cursor.x, w->phys_cursor.y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -25584,7 +26235,7 @@ draw_row_with_mouse_face (struct window *w, int start_x, struct glyph_row *row,
return;
}
#endif
-#if defined (HAVE_GPM) || defined (MSDOS)
+#if defined (HAVE_GPM) || defined (MSDOS) || defined (WINDOWSNT)
tty_draw_row_with_mouse_face (w, row, start_hpos, end_hpos, draw);
#endif
}
@@ -25698,10 +26349,10 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw)
if (row->reversed_p && hpos >= row->used[TEXT_AREA])
hpos = row->used[TEXT_AREA] - 1;
- BLOCK_INPUT;
+ block_input ();
display_and_set_cursor (w, 1, hpos, w->phys_cursor.vpos,
w->phys_cursor.x, w->phys_cursor.y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* HAVE_WINDOW_SYSTEM */
}
@@ -25817,12 +26468,14 @@ cursor_in_mouse_face_p (struct window *w)
/* Find the glyph rows START_ROW and END_ROW of window W that display
characters between buffer positions START_CHARPOS and END_CHARPOS
- (excluding END_CHARPOS). This is similar to row_containing_pos,
- but is more accurate when bidi reordering makes buffer positions
- change non-linearly with glyph rows. */
+ (excluding END_CHARPOS). DISP_STRING is a display string that
+ covers these buffer positions. This is similar to
+ row_containing_pos, but is more accurate when bidi reordering makes
+ buffer positions change non-linearly with glyph rows. */
static void
rows_from_pos_range (struct window *w,
- EMACS_INT start_charpos, EMACS_INT end_charpos,
+ ptrdiff_t start_charpos, ptrdiff_t end_charpos,
+ Lisp_Object disp_string,
struct glyph_row **start, struct glyph_row **end)
{
struct glyph_row *first = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
@@ -25874,8 +26527,11 @@ rows_from_pos_range (struct window *w,
while (g < e)
{
- if ((BUFFERP (g->object) || INTEGERP (g->object))
- && start_charpos <= g->charpos && g->charpos < end_charpos)
+ if (((BUFFERP (g->object) || INTEGERP (g->object))
+ && start_charpos <= g->charpos && g->charpos < end_charpos)
+ /* A glyph that comes from DISP_STRING is by
+ definition to be highlighted. */
+ || EQ (g->object, disp_string))
*start = row;
g++;
}
@@ -25894,14 +26550,15 @@ rows_from_pos_range (struct window *w,
for ( ; row->enabled_p && MATRIX_ROW_BOTTOM_Y (row) <= last_y; row++)
{
struct glyph_row *next = row + 1;
+ ptrdiff_t next_start = MATRIX_ROW_START_CHARPOS (next);
if (!next->enabled_p
|| next >= MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)
/* The first row >= START whose range of displayed characters
does NOT intersect the range [START_CHARPOS..END_CHARPOS]
is the row END + 1. */
- || (start_charpos < MATRIX_ROW_START_CHARPOS (next)
- && end_charpos < MATRIX_ROW_START_CHARPOS (next))
+ || (start_charpos < next_start
+ && end_charpos < next_start)
|| ((start_charpos > MATRIX_ROW_END_CHARPOS (next)
|| (start_charpos == MATRIX_ROW_END_CHARPOS (next)
&& !next->ends_at_zv_p
@@ -25920,12 +26577,29 @@ rows_from_pos_range (struct window *w,
but none of the characters it displays are in the range, it is
also END + 1. */
struct glyph *g = next->glyphs[TEXT_AREA];
+ struct glyph *s = g;
struct glyph *e = g + next->used[TEXT_AREA];
while (g < e)
{
- if ((BUFFERP (g->object) || INTEGERP (g->object))
- && start_charpos <= g->charpos && g->charpos < end_charpos)
+ if (((BUFFERP (g->object) || INTEGERP (g->object))
+ && ((start_charpos <= g->charpos && g->charpos < end_charpos)
+ /* If the buffer position of the first glyph in
+ the row is equal to END_CHARPOS, it means
+ the last character to be highlighted is the
+ newline of ROW, and we must consider NEXT as
+ END, not END+1. */
+ || (((!next->reversed_p && g == s)
+ || (next->reversed_p && g == e - 1))
+ && (g->charpos == end_charpos
+ /* Special case for when NEXT is an
+ empty line at ZV. */
+ || (g->charpos == -1
+ && !row->ends_at_zv_p
+ && next_start == end_charpos)))))
+ /* A glyph that comes from DISP_STRING is by
+ definition to be highlighted. */
+ || EQ (g->object, disp_string))
break;
g++;
}
@@ -25934,6 +26608,13 @@ rows_from_pos_range (struct window *w,
*end = row;
break;
}
+ /* The first row that ends at ZV must be the last to be
+ highlighted. */
+ else if (next->ends_at_zv_p)
+ {
+ *end = next;
+ break;
+ }
}
}
}
@@ -25950,9 +26631,9 @@ rows_from_pos_range (struct window *w,
static void
mouse_face_from_buffer_pos (Lisp_Object window,
Mouse_HLInfo *hlinfo,
- EMACS_INT mouse_charpos,
- EMACS_INT start_charpos,
- EMACS_INT end_charpos,
+ ptrdiff_t mouse_charpos,
+ ptrdiff_t start_charpos,
+ ptrdiff_t end_charpos,
Lisp_Object before_string,
Lisp_Object after_string,
Lisp_Object disp_string)
@@ -25961,15 +26642,15 @@ mouse_face_from_buffer_pos (Lisp_Object window,
struct glyph_row *first = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
struct glyph_row *r1, *r2;
struct glyph *glyph, *end;
- EMACS_INT ignore, pos;
+ ptrdiff_t ignore, pos;
int x;
- xassert (NILP (disp_string) || STRINGP (disp_string));
- xassert (NILP (before_string) || STRINGP (before_string));
- xassert (NILP (after_string) || STRINGP (after_string));
+ eassert (NILP (disp_string) || STRINGP (disp_string));
+ eassert (NILP (before_string) || STRINGP (before_string));
+ eassert (NILP (after_string) || STRINGP (after_string));
/* Find the rows corresponding to START_CHARPOS and END_CHARPOS. */
- rows_from_pos_range (w, start_charpos, end_charpos, &r1, &r2);
+ rows_from_pos_range (w, start_charpos, end_charpos, disp_string, &r1, &r2);
if (r1 == NULL)
r1 = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos));
/* If the before-string or display-string contains newlines,
@@ -26247,6 +26928,19 @@ mouse_face_from_buffer_pos (Lisp_Object window,
}
x += end->pixel_width;
}
+ /* If we exited the above loop because we arrived at the last
+ glyph of the row, and its buffer position is still not in
+ range, it means the last character in range is the preceding
+ newline. Bump the end column and x values to get past the
+ last glyph. */
+ if (end == glyph
+ && BUFFERP (end->object)
+ && (end->charpos < start_charpos
+ || end->charpos >= end_charpos))
+ {
+ x += end->pixel_width;
+ ++end;
+ }
hlinfo->mouse_face_end_x = x;
hlinfo->mouse_face_end_col = end - r2->glyphs[TEXT_AREA];
}
@@ -26281,7 +26975,7 @@ mouse_face_from_buffer_pos (Lisp_Object window,
Value is non-zero if a glyph was found. */
static int
-fast_find_string_pos (struct window *w, EMACS_INT pos, Lisp_Object object,
+fast_find_string_pos (struct window *w, ptrdiff_t pos, Lisp_Object object,
int *hpos, int *vpos, int *x, int *y, int right_p)
{
int yb = window_text_bottom_y (w);
@@ -26351,7 +27045,7 @@ fast_find_string_pos (struct window *w, EMACS_INT pos, Lisp_Object object,
static void
mouse_face_from_string_pos (struct window *w, Mouse_HLInfo *hlinfo,
Lisp_Object object,
- EMACS_INT startpos, EMACS_INT endpos)
+ ptrdiff_t startpos, ptrdiff_t endpos)
{
int yb = window_text_bottom_y (w);
struct glyph_row *r;
@@ -26521,8 +27215,8 @@ on_hot_spot_p (Lisp_Object hot_spot, int x, int y)
{
struct Lisp_Vector *v = XVECTOR (XCDR (hot_spot));
Lisp_Object *poly = v->contents;
- int n = v->header.size;
- int i;
+ ptrdiff_t n = v->header.size;
+ ptrdiff_t i;
int inside = 0;
Lisp_Object lx, ly;
int x0, y0;
@@ -26600,7 +27294,9 @@ Returns the alist element for the first matching AREA in MAP. */)
CHECK_NUMBER (x);
CHECK_NUMBER (y);
- return find_hot_spot (map, XINT (x), XINT (y));
+ return find_hot_spot (map,
+ clip_to_bounds (INT_MIN, XINT (x), INT_MAX),
+ clip_to_bounds (INT_MIN, XINT (y), INT_MAX));
}
@@ -26659,14 +27355,14 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
Cursor cursor = No_Cursor;
Lisp_Object pointer = Qnil;
int dx, dy, width, height;
- EMACS_INT charpos;
+ ptrdiff_t charpos;
Lisp_Object string, object = Qnil;
- Lisp_Object pos, help;
+ Lisp_Object pos IF_LINT (= Qnil), help;
Lisp_Object mouse_face;
int original_x_pixel = x;
struct glyph * glyph = NULL, * row_start_glyph = NULL;
- struct glyph_row *row;
+ struct glyph_row *row IF_LINT (= 0);
if (area == ON_MODE_LINE || area == ON_HEADER_LINE)
{
@@ -26734,7 +27430,6 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
if (!NILP (help))
{
help_echo_string = help;
- /* Is this correct? ++kfs */
XSETWINDOW (help_echo_window, w);
help_echo_object = w->buffer;
help_echo_pos = charpos;
@@ -26747,14 +27442,20 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
#endif /* HAVE_WINDOW_SYSTEM */
if (STRINGP (string))
+ pos = make_number (charpos);
+
+ /* Set the help text and mouse pointer. If the mouse is on a part
+ of the mode line without any text (e.g. past the right edge of
+ the mode line text), use the default help text and pointer. */
+ if (STRINGP (string) || area == ON_MODE_LINE)
{
- pos = make_number (charpos);
- /* If we're on a string with `help-echo' text property, arrange
- for the help to be displayed. This is done by setting the
- global variable help_echo_string to the help string. */
+ /* Arrange to display the help by setting the global variables
+ help_echo_string, help_echo_object, and help_echo_pos. */
if (NILP (help))
{
- help = Fget_text_property (pos, Qhelp_echo, string);
+ if (STRINGP (string))
+ help = Fget_text_property (pos, Qhelp_echo, string);
+
if (!NILP (help))
{
help_echo_string = help;
@@ -26762,31 +27463,56 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
help_echo_object = string;
help_echo_pos = charpos;
}
+ else if (area == ON_MODE_LINE)
+ {
+ Lisp_Object default_help
+ = buffer_local_value_1 (Qmode_line_default_help_echo,
+ w->buffer);
+
+ if (STRINGP (default_help))
+ {
+ help_echo_string = default_help;
+ XSETWINDOW (help_echo_window, w);
+ help_echo_object = Qnil;
+ help_echo_pos = -1;
+ }
+ }
}
#ifdef HAVE_WINDOW_SYSTEM
+ /* Change the mouse pointer according to what is under it. */
if (FRAME_WINDOW_P (f))
{
dpyinfo = FRAME_X_DISPLAY_INFO (f);
- cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
- if (NILP (pointer))
- pointer = Fget_text_property (pos, Qpointer, string);
-
- /* Change the mouse pointer according to what is under X/Y. */
- if (NILP (pointer)
- && ((area == ON_MODE_LINE) || (area == ON_HEADER_LINE)))
+ if (STRINGP (string))
{
- Lisp_Object map;
- map = Fget_text_property (pos, Qlocal_map, string);
- if (!KEYMAPP (map))
- map = Fget_text_property (pos, Qkeymap, string);
- if (!KEYMAPP (map))
- cursor = dpyinfo->vertical_scroll_bar_cursor;
+ cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
+
+ if (NILP (pointer))
+ pointer = Fget_text_property (pos, Qpointer, string);
+
+ /* Change the mouse pointer according to what is under X/Y. */
+ if (NILP (pointer)
+ && ((area == ON_MODE_LINE) || (area == ON_HEADER_LINE)))
+ {
+ Lisp_Object map;
+ map = Fget_text_property (pos, Qlocal_map, string);
+ if (!KEYMAPP (map))
+ map = Fget_text_property (pos, Qkeymap, string);
+ if (!KEYMAPP (map))
+ cursor = dpyinfo->vertical_scroll_bar_cursor;
+ }
}
+ else
+ /* Default mode-line pointer. */
+ cursor = FRAME_X_DISPLAY_INFO (f)->vertical_scroll_bar_cursor;
}
#endif
+ }
- /* Change the mouse face according to what is under X/Y. */
+ /* Change the mouse face according to what is under X/Y. */
+ if (STRINGP (string))
+ {
mouse_face = Fget_text_property (pos, Qmouse_face, string);
if (!NILP (mouse_face)
&& ((area == ON_MODE_LINE) || (area == ON_HEADER_LINE))
@@ -26799,7 +27525,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
int gpos;
int gseq_length;
int total_pixel_width;
- EMACS_INT begpos, endpos, ignore;
+ ptrdiff_t begpos, endpos, ignore;
int vpos, hpos;
@@ -26959,12 +27685,6 @@ note_mouse_highlight (struct frame *f, int x, int y)
if (hlinfo->mouse_face_defer)
return;
- if (gc_in_progress)
- {
- hlinfo->mouse_face_deferred_gc = 1;
- return;
- }
-
/* Which window is that in? */
window = window_from_coordinates (f, x, y, &part, 1);
@@ -27025,18 +27745,18 @@ note_mouse_highlight (struct frame *f, int x, int y)
b = XBUFFER (w->buffer);
if (part == ON_TEXT
&& EQ (w->window_end_valid, w->buffer)
- && XFASTINT (w->last_modified) == BUF_MODIFF (b)
- && XFASTINT (w->last_overlay_modified) == BUF_OVERLAY_MODIFF (b))
+ && w->last_modified == BUF_MODIFF (b)
+ && w->last_overlay_modified == BUF_OVERLAY_MODIFF (b))
{
int hpos, vpos, dx, dy, area = LAST_AREA;
- EMACS_INT pos;
+ ptrdiff_t pos;
struct glyph *glyph;
Lisp_Object object;
Lisp_Object mouse_face = Qnil, position;
Lisp_Object *overlay_vec = NULL;
ptrdiff_t i, noverlays;
struct buffer *obuf;
- EMACS_INT obegv, ozv;
+ ptrdiff_t obegv, ozv;
int same_region;
/* Find the glyph under X/Y. */
@@ -27194,7 +27914,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
/* The mouse-highlighting comes from a display string
with a mouse-face. */
Lisp_Object s, e;
- EMACS_INT ignore;
+ ptrdiff_t ignore;
s = Fprevious_single_property_change
(make_number (pos + 1), Qmouse_face, object, Qnil);
@@ -27226,7 +27946,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
/* If we are on a display string with no mouse-face,
check if the text under it has one. */
struct glyph_row *r = MATRIX_ROW (w->current_matrix, vpos);
- EMACS_INT start = MATRIX_ROW_START_CHARPOS (r);
+ ptrdiff_t start = MATRIX_ROW_START_CHARPOS (r);
pos = string_buffer_position (object, start);
if (pos > 0)
{
@@ -27325,7 +28045,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
else
{
Lisp_Object obj = glyph->object;
- EMACS_INT charpos = glyph->charpos;
+ ptrdiff_t charpos = glyph->charpos;
/* Try text properties. */
if (STRINGP (obj)
@@ -27340,8 +28060,8 @@ note_mouse_highlight (struct frame *f, int x, int y)
see if the buffer text ``under'' it does. */
struct glyph_row *r
= MATRIX_ROW (w->current_matrix, vpos);
- EMACS_INT start = MATRIX_ROW_START_CHARPOS (r);
- EMACS_INT p = string_buffer_position (obj, start);
+ ptrdiff_t start = MATRIX_ROW_START_CHARPOS (r);
+ ptrdiff_t p = string_buffer_position (obj, start);
if (p > 0)
{
help = Fget_char_property (make_number (p),
@@ -27381,7 +28101,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
if (NILP (pointer))
{
Lisp_Object obj = glyph->object;
- EMACS_INT charpos = glyph->charpos;
+ ptrdiff_t charpos = glyph->charpos;
/* Try text properties. */
if (STRINGP (obj)
@@ -27396,8 +28116,8 @@ note_mouse_highlight (struct frame *f, int x, int y)
see if the buffer text ``under'' it does. */
struct glyph_row *r
= MATRIX_ROW (w->current_matrix, vpos);
- EMACS_INT start = MATRIX_ROW_START_CHARPOS (r);
- EMACS_INT p = string_buffer_position (obj, start);
+ ptrdiff_t start = MATRIX_ROW_START_CHARPOS (r);
+ ptrdiff_t p = string_buffer_position (obj, start);
if (p > 0)
pointer = Fget_char_property (make_number (p),
Qpointer, w->buffer);
@@ -27441,11 +28161,11 @@ x_clear_window_mouse_face (struct window *w)
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (w->frame));
Lisp_Object window;
- BLOCK_INPUT;
+ block_input ();
XSETWINDOW (window, w);
if (EQ (window, hlinfo->mouse_face_window))
clear_mouse_face (hlinfo);
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -27537,7 +28257,7 @@ expose_area (struct window *w, struct glyph_row *row, XRectangle *r,
static int
expose_line (struct window *w, struct glyph_row *row, XRectangle *r)
{
- xassert (row->enabled_p);
+ eassert (row->enabled_p);
if (row->mode_line_p || w->pseudo_window_p)
draw_glyphs (w, 0, row, TEXT_AREA,
@@ -27577,7 +28297,7 @@ expose_overlaps (struct window *w,
for (row = first_overlapping_row; row <= last_overlapping_row; ++row)
if (row->overlapping_p)
{
- xassert (row->enabled_p && !row->mode_line_p);
+ eassert (row->enabled_p && !row->mode_line_p);
row->clip = r;
if (row->used[LEFT_MARGIN_AREA])
@@ -28015,6 +28735,7 @@ syms_of_xdisp (void)
staticpro (&Vmessage_stack);
DEFSYM (Qinhibit_redisplay, "inhibit-redisplay");
+ DEFSYM (Qredisplay_internal, "redisplay_internal (C function)");
message_dolog_marker1 = Fmake_marker ();
staticpro (&message_dolog_marker1);
@@ -28023,7 +28744,7 @@ syms_of_xdisp (void)
message_dolog_marker3 = Fmake_marker ();
staticpro (&message_dolog_marker3);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
defsubr (&Sdump_frame_glyph_matrix);
defsubr (&Sdump_glyph_matrix);
defsubr (&Sdump_glyph_row);
@@ -28113,7 +28834,7 @@ syms_of_xdisp (void)
staticpro (&echo_area_buffer[0]);
staticpro (&echo_area_buffer[1]);
- Vmessages_buffer_name = make_pure_c_string ("*Messages*");
+ Vmessages_buffer_name = build_pure_c_string ("*Messages*");
staticpro (&Vmessages_buffer_name);
mode_line_proptrans_alist = Qnil;
@@ -28127,6 +28848,8 @@ syms_of_xdisp (void)
Vmode_line_unwind_vector = Qnil;
staticpro (&Vmode_line_unwind_vector);
+ DEFSYM (Qmode_line_default_help_echo, "mode-line-default-help-echo");
+
help_echo_string = Qnil;
staticpro (&help_echo_string);
help_echo_object = Qnil;
@@ -28142,14 +28865,14 @@ syms_of_xdisp (void)
#ifdef HAVE_WINDOW_SYSTEM
DEFVAR_BOOL ("x-stretch-cursor", x_stretch_cursor_p,
- doc: /* *Non-nil means draw block cursor as wide as the glyph under it.
+ doc: /* Non-nil means draw block cursor as wide as the glyph under it.
For example, if a block cursor is over a tab, it will be drawn as
wide as that tab on the display. */);
x_stretch_cursor_p = 0;
#endif
DEFVAR_LISP ("show-trailing-whitespace", Vshow_trailing_whitespace,
- doc: /* *Non-nil means highlight trailing whitespace.
+ doc: /* Non-nil means highlight trailing whitespace.
The face used for trailing whitespace is `trailing-whitespace'. */);
Vshow_trailing_whitespace = Qnil;
@@ -28169,7 +28892,7 @@ A value of nil means no special handling of these characters. */);
Vnobreak_char_display = Qt;
DEFVAR_LISP ("void-text-area-pointer", Vvoid_text_area_pointer,
- doc: /* *The pointer shape to show in void text areas.
+ doc: /* The pointer shape to show in void text areas.
A value of nil means to show the text pointer. Other options are `arrow',
`text', `hand', `vdrag', `hdrag', `modeline', and `hourglass'. */);
Vvoid_text_area_pointer = Qarrow;
@@ -28192,7 +28915,7 @@ See also `overlay-arrow-string'. */);
DEFVAR_LISP ("overlay-arrow-string", Voverlay_arrow_string,
doc: /* String to display as an arrow in non-window frames.
See also `overlay-arrow-position'. */);
- Voverlay_arrow_string = make_pure_c_string ("=>");
+ Voverlay_arrow_string = build_pure_c_string ("=>");
DEFVAR_LISP ("overlay-arrow-variable-list", Voverlay_arrow_variable_list,
doc: /* List of variables (symbols) which hold markers for overlay arrows.
@@ -28202,14 +28925,14 @@ where to display overlay arrows. */);
= Fcons (intern_c_string ("overlay-arrow-position"), Qnil);
DEFVAR_INT ("scroll-step", emacs_scroll_step,
- doc: /* *The number of lines to try scrolling a window by when point moves out.
+ doc: /* The number of lines to try scrolling a window by when point moves out.
If that fails to bring point back on frame, point is centered instead.
If this is zero, point is always centered after it moves off frame.
If you want scrolling to always be a line at a time, you should set
`scroll-conservatively' to a large value rather than set this to 1. */);
DEFVAR_INT ("scroll-conservatively", scroll_conservatively,
- doc: /* *Scroll up to this many lines, to bring point back on screen.
+ doc: /* Scroll up to this many lines, to bring point back on screen.
If point moves off-screen, redisplay will scroll by up to
`scroll-conservatively' lines in order to bring point just barely
onto the screen again. If that cannot be done, then redisplay
@@ -28223,7 +28946,7 @@ A value of zero means always recenter point if it moves off screen. */);
scroll_conservatively = 0;
DEFVAR_INT ("scroll-margin", scroll_margin,
- doc: /* *Number of lines of margin at the top and bottom of a window.
+ doc: /* Number of lines of margin at the top and bottom of a window.
Recenter the window whenever point gets within this many lines
of the top or bottom of the window. */);
scroll_margin = 0;
@@ -28233,7 +28956,7 @@ of the top or bottom of the window. */);
Value is a number or a cons (WIDTH-DPI . HEIGHT-DPI). */);
Vdisplay_pixels_per_inch = make_float (72.0);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
DEFVAR_INT ("debug-end-pos", debug_end_pos, doc: /* Don't ask. */);
#endif
@@ -28252,27 +28975,21 @@ A value of nil means to respect the value of `truncate-lines'.
If `word-wrap' is enabled, you might want to reduce this. */);
Vtruncate_partial_width_windows = make_number (50);
- DEFVAR_BOOL ("mode-line-inverse-video", mode_line_inverse_video,
- doc: /* When nil, display the mode-line/header-line/menu-bar in the default face.
-Any other value means to use the appropriate face, `mode-line',
-`header-line', or `menu' respectively. */);
- mode_line_inverse_video = 1;
-
DEFVAR_LISP ("line-number-display-limit", Vline_number_display_limit,
- doc: /* *Maximum buffer size for which line number should be displayed.
+ doc: /* Maximum buffer size for which line number should be displayed.
If the buffer is bigger than this, the line number does not appear
in the mode line. A value of nil means no limit. */);
Vline_number_display_limit = Qnil;
DEFVAR_INT ("line-number-display-limit-width",
line_number_display_limit_width,
- doc: /* *Maximum line width (in characters) for line number display.
+ doc: /* Maximum line width (in characters) for line number display.
If the average length of the lines near point is bigger than this, then the
line number may be omitted from the mode line. */);
line_number_display_limit_width = 200;
DEFVAR_BOOL ("highlight-nonselected-windows", highlight_nonselected_windows,
- doc: /* *Non-nil means highlight region even in nonselected windows. */);
+ doc: /* Non-nil means highlight region even in nonselected windows. */);
highlight_nonselected_windows = 0;
DEFVAR_BOOL ("multiple-frames", multiple_frames,
@@ -28297,20 +29014,20 @@ and is used only on frames for which no explicit name has been set
\(see `modify-frame-parameters'). */);
Vicon_title_format
= Vframe_title_format
- = pure_cons (intern_c_string ("multiple-frames"),
- pure_cons (make_pure_c_string ("%b"),
- pure_cons (pure_cons (empty_unibyte_string,
- pure_cons (intern_c_string ("invocation-name"),
- pure_cons (make_pure_c_string ("@"),
- pure_cons (intern_c_string ("system-name"),
- Qnil)))),
- Qnil)));
+ = listn (CONSTYPE_PURE, 3,
+ intern_c_string ("multiple-frames"),
+ build_pure_c_string ("%b"),
+ listn (CONSTYPE_PURE, 4,
+ empty_unibyte_string,
+ intern_c_string ("invocation-name"),
+ build_pure_c_string ("@"),
+ intern_c_string ("system-name")));
DEFVAR_LISP ("message-log-max", Vmessage_log_max,
doc: /* Maximum number of lines to keep in the message log buffer.
If nil, disable message logging. If t, log messages but don't truncate
the buffer when it becomes large. */);
- Vmessage_log_max = make_number (100);
+ Vmessage_log_max = make_number (1000);
DEFVAR_LISP ("window-size-change-functions", Vwindow_size_change_functions,
doc: /* Functions called before redisplay, if window sizes have changed.
@@ -28325,7 +29042,11 @@ all the functions in the list are called, with the frame as argument. */);
Each function is called with two arguments, the window and its new
display-start position. Note that these functions are also called by
`set-window-buffer'. Also note that the value of `window-end' is not
-valid when these functions are called. */);
+valid when these functions are called.
+
+Warning: Do not use this feature to alter the way the window
+is scrolled. It is not designed for that, and such use probably won't
+work. */);
Vwindow_scroll_functions = Qnil;
DEFVAR_LISP ("window-text-change-functions",
@@ -28340,7 +29061,7 @@ See `set-window-redisplay-end-trigger'. */);
Vredisplay_end_trigger_functions = Qnil;
DEFVAR_LISP ("mouse-autoselect-window", Vmouse_autoselect_window,
- doc: /* *Non-nil means autoselect window with mouse pointer.
+ doc: /* Non-nil means autoselect window with mouse pointer.
If nil, do not autoselect windows.
A positive number means delay autoselection by that many seconds: a
window is autoselected only after the mouse has remained in that
@@ -28360,7 +29081,7 @@ When customizing this variable make sure that the actual value of
Vmouse_autoselect_window = Qnil;
DEFVAR_LISP ("auto-resize-tool-bars", Vauto_resize_tool_bars,
- doc: /* *Non-nil means automatically resize tool-bars.
+ doc: /* Non-nil means automatically resize tool-bars.
This dynamically changes the tool-bar's height to the minimum height
that is needed to make all tool-bar items visible.
If value is `grow-only', the tool-bar's height is only increased
@@ -28368,15 +29089,15 @@ automatically; to decrease the tool-bar height, use \\[recenter]. */);
Vauto_resize_tool_bars = Qt;
DEFVAR_BOOL ("auto-raise-tool-bar-buttons", auto_raise_tool_bar_buttons_p,
- doc: /* *Non-nil means raise tool-bar buttons when the mouse moves over them. */);
+ doc: /* Non-nil means raise tool-bar buttons when the mouse moves over them. */);
auto_raise_tool_bar_buttons_p = 1;
DEFVAR_BOOL ("make-cursor-line-fully-visible", make_cursor_line_fully_visible_p,
- doc: /* *Non-nil means to scroll (recenter) cursor line if it is not fully visible. */);
+ doc: /* Non-nil means to scroll (recenter) cursor line if it is not fully visible. */);
make_cursor_line_fully_visible_p = 1;
DEFVAR_LISP ("tool-bar-border", Vtool_bar_border,
- doc: /* *Border below tool-bar in pixels.
+ doc: /* Border below tool-bar in pixels.
If an integer, use it as the height of the border.
If it is one of `internal-border-width' or `border-width', use the
value of the corresponding frame parameter.
@@ -28384,7 +29105,7 @@ Otherwise, no border is added below the tool-bar. */);
Vtool_bar_border = Qinternal_border_width;
DEFVAR_LISP ("tool-bar-button-margin", Vtool_bar_button_margin,
- doc: /* *Margin around tool-bar buttons in pixels.
+ doc: /* Margin around tool-bar buttons in pixels.
If an integer, use that for both horizontal and vertical margins.
Otherwise, value should be a pair of integers `(HORZ . VERT)' with
HORZ specifying the horizontal margin, and VERT specifying the
@@ -28392,7 +29113,7 @@ vertical margin. */);
Vtool_bar_button_margin = make_number (DEFAULT_TOOL_BAR_BUTTON_MARGIN);
DEFVAR_INT ("tool-bar-button-relief", tool_bar_button_relief,
- doc: /* *Relief thickness of tool-bar buttons. */);
+ doc: /* Relief thickness of tool-bar buttons. */);
tool_bar_button_relief = DEFAULT_TOOL_BAR_BUTTON_RELIEF;
DEFVAR_LISP ("tool-bar-style", Vtool_bar_style,
@@ -28403,11 +29124,13 @@ It can be one of
both - show both, text below image
both-horiz - show text to the right of the image
text-image-horiz - show text to the left of the image
- any other - use system default or image if no system default. */);
+ any other - use system default or image if no system default.
+
+This variable only affects the GTK+ toolkit version of Emacs. */);
Vtool_bar_style = Qnil;
DEFVAR_INT ("tool-bar-max-label-size", tool_bar_max_label_size,
- doc: /* *Maximum number of characters a label can have to be shown.
+ doc: /* Maximum number of characters a label can have to be shown.
The tool bar style must also show labels for this to have any effect, see
`tool-bar-style'. */);
tool_bar_max_label_size = DEFAULT_TOOL_BAR_LABEL_SIZE;
@@ -28422,7 +29145,7 @@ fontified regions the property `fontified'. */);
DEFVAR_BOOL ("unibyte-display-via-language-environment",
unibyte_display_via_language_environment,
- doc: /* *Non-nil means display unibyte text according to language environment.
+ doc: /* Non-nil means display unibyte text according to language environment.
Specifically, this means that raw bytes in the range 160-255 decimal
are displayed by converting them to the equivalent multibyte characters
according to the current language environment. As a result, they are
@@ -28433,7 +29156,7 @@ but does not change the fact they are interpreted as raw bytes. */);
unibyte_display_via_language_environment = 0;
DEFVAR_LISP ("max-mini-window-height", Vmax_mini_window_height,
- doc: /* *Maximum height for resizing mini-windows (the minibuffer and the echo area).
+ doc: /* Maximum height for resizing mini-windows (the minibuffer and the echo area).
If a float, it specifies a fraction of the mini-window frame's height.
If an integer, it specifies a number of lines. */);
Vmax_mini_window_height = make_float (0.25);
@@ -28467,12 +29190,12 @@ point visible. */);
DEFSYM (Qauto_hscroll_mode, "auto-hscroll-mode");
DEFVAR_INT ("hscroll-margin", hscroll_margin,
- doc: /* *How many columns away from the window edge point is allowed to get
+ doc: /* How many columns away from the window edge point is allowed to get
before automatic hscrolling will horizontally scroll the window. */);
hscroll_margin = 5;
DEFVAR_LISP ("hscroll-step", Vhscroll_step,
- doc: /* *How many columns to scroll the window when point gets too close to the edge.
+ doc: /* How many columns to scroll the window when point gets too close to the edge.
When point is less than `hscroll-margin' columns from the window
edge, automatic hscrolling will scroll the window by the amount of columns
determined by this variable. If its value is a positive integer, scroll that
@@ -28544,7 +29267,7 @@ To add a prefix to continuation lines, use `wrap-prefix'. */);
doc: /* Non-nil means don't free realized faces. Internal use only. */);
inhibit_free_realized_faces = 0;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
DEFVAR_BOOL ("inhibit-try-window-id", inhibit_try_window_id,
doc: /* Inhibit try_window_id display optimization. */);
inhibit_try_window_id = 0;
@@ -28559,7 +29282,7 @@ To add a prefix to continuation lines, use `wrap-prefix'. */);
#endif /* GLYPH_DEBUG */
DEFVAR_INT ("overline-margin", overline_margin,
- doc: /* *Space between overline and text, in pixels.
+ doc: /* Space between overline and text, in pixels.
The default value is 2: the height of the overline (1 pixel) plus 1 pixel
margin to the character height. */);
overline_margin = 2;
@@ -28580,7 +29303,7 @@ cursor shapes. */);
display_hourglass_p = 1;
DEFVAR_LISP ("hourglass-delay", Vhourglass_delay,
- doc: /* *Seconds to wait before displaying an hourglass pointer when Emacs is busy. */);
+ doc: /* Seconds to wait before displaying an hourglass pointer when Emacs is busy. */);
Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
hourglass_atimer = NULL;
@@ -28618,6 +29341,10 @@ Its value should be an ASCII acronym string, `hex-code', `empty-box', or
Vglyphless_char_display = Fmake_char_table (Qglyphless_char_display, Qnil);
Fset_char_table_extra_slot (Vglyphless_char_display, make_number (0),
Qempty_box);
+
+ DEFVAR_LISP ("debug-on-message", Vdebug_on_message,
+ doc: /* If non-nil, debug if a message matching this regexp is displayed. */);
+ Vdebug_on_message = Qnil;
}
@@ -28641,12 +29368,13 @@ init_xdisp (void)
echo_area_window = minibuf_window;
- XSETFASTINT (r->top_line, FRAME_TOP_MARGIN (f));
- XSETFASTINT (r->total_lines, FRAME_LINES (f) - 1 - FRAME_TOP_MARGIN (f));
- XSETFASTINT (r->total_cols, FRAME_COLS (f));
- XSETFASTINT (m->top_line, FRAME_LINES (f) - 1);
- XSETFASTINT (m->total_lines, 1);
- XSETFASTINT (m->total_cols, FRAME_COLS (f));
+ wset_top_line (r, make_number (FRAME_TOP_MARGIN (f)));
+ wset_total_lines
+ (r, make_number (FRAME_LINES (f) - 1 - FRAME_TOP_MARGIN (f)));
+ wset_total_cols (r, make_number (FRAME_COLS (f)));
+ wset_top_line (m, make_number (FRAME_LINES (f) - 1));
+ wset_total_lines (m, make_number (1));
+ wset_total_cols (m, make_number (FRAME_COLS (f)));
scratch_glyph_row.glyphs[TEXT_AREA] = scratch_glyphs;
scratch_glyph_row.glyphs[TEXT_AREA + 1]
@@ -28661,7 +29389,7 @@ init_xdisp (void)
/* Allocate the buffer for frame titles.
Also used for `format-mode-line'. */
int size = 100;
- mode_line_noprop_buf = (char *) xmalloc (size);
+ mode_line_noprop_buf = xmalloc (size);
mode_line_noprop_buf_end = mode_line_noprop_buf + size;
mode_line_noprop_ptr = mode_line_noprop_buf;
mode_line_target = MODE_LINE_DISPLAY;
@@ -28670,19 +29398,7 @@ init_xdisp (void)
help_echo_showing_p = 0;
}
-/* Since w32 does not support atimers, it defines its own implementation of
- the following three functions in w32fns.c. */
-#ifndef WINDOWSNT
-
-/* Platform-independent portion of hourglass implementation. */
-
-/* Return non-zero if hourglass timer has been started or hourglass is
- shown. */
-int
-hourglass_started (void)
-{
- return hourglass_shown_p || hourglass_atimer != NULL;
-}
+/* Platform-independent portion of hourglass implementation. */
/* Cancel a currently active hourglass timer, and start a new one. */
void
@@ -28690,25 +29406,27 @@ start_hourglass (void)
{
#if defined (HAVE_WINDOW_SYSTEM)
EMACS_TIME delay;
- int secs, usecs = 0;
cancel_hourglass ();
if (INTEGERP (Vhourglass_delay)
&& XINT (Vhourglass_delay) > 0)
- secs = XFASTINT (Vhourglass_delay);
+ delay = make_emacs_time (min (XINT (Vhourglass_delay),
+ TYPE_MAXIMUM (time_t)),
+ 0);
else if (FLOATP (Vhourglass_delay)
&& XFLOAT_DATA (Vhourglass_delay) > 0)
- {
- Lisp_Object tem;
- tem = Ftruncate (Vhourglass_delay, Qnil);
- secs = XFASTINT (tem);
- usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
- }
+ delay = EMACS_TIME_FROM_DOUBLE (XFLOAT_DATA (Vhourglass_delay));
else
- secs = DEFAULT_HOURGLASS_DELAY;
+ delay = make_emacs_time (DEFAULT_HOURGLASS_DELAY, 0);
+
+#ifdef HAVE_NTGUI
+ {
+ extern void w32_note_current_window (void);
+ w32_note_current_window ();
+ }
+#endif /* HAVE_NTGUI */
- EMACS_SET_SECS_USECS (delay, secs, usecs);
hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
show_hourglass, NULL);
#endif
@@ -28731,4 +29449,3 @@ cancel_hourglass (void)
hide_hourglass ();
#endif
}
-#endif /* ! WINDOWSNT */
diff --git a/src/xfaces.c b/src/xfaces.c
index 7e3ce4103d9..1e27d5cc043 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -1,6 +1,6 @@
/* xfaces.c -- "Face" primitives.
-Copyright (C) 1993-1994, 1998-2011 Free Software Foundation, Inc.
+Copyright (C) 1993-1994, 1998-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -204,7 +204,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/types.h>
#include <sys/stat.h>
#include <stdio.h> /* This needs to be before termchar.h */
-#include <setjmp.h>
#include "lisp.h"
#include "character.h"
@@ -225,28 +224,25 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dosfns.h"
#endif
-#ifdef WINDOWSNT
-#include "w32term.h"
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
#include "fontset.h"
-/* Redefine X specifics to W32 equivalents to avoid cluttering the
- code with #ifdef blocks. */
+#ifdef HAVE_NTGUI
#undef FRAME_X_DISPLAY_INFO
#define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
#define x_display_info w32_display_info
-#define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
#define check_x check_w32
#define GCGraphicsExposures 0
-#endif /* WINDOWSNT */
+#endif /* HAVE_NTGUI */
#ifdef HAVE_NS
-#include "nsterm.h"
#undef FRAME_X_DISPLAY_INFO
#define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
#define x_display_info ns_display_info
-#define FRAME_X_FONT_TABLE FRAME_NS_FONT_TABLE
#define check_x check_ns
#define GCGraphicsExposures 0
#endif /* HAVE_NS */
+#endif /* HAVE_WINDOW_SYSTEM */
#include "buffer.h"
#include "dispextern.h"
@@ -256,9 +252,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "termchar.h"
#include "font.h"
-#ifdef HAVE_WINDOW_SYSTEM
-#include "fontset.h"
-#endif /* HAVE_WINDOW_SYSTEM */
#ifdef HAVE_X_WINDOWS
@@ -281,7 +274,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif /* HAVE_X_WINDOWS */
-#include <ctype.h>
+#include <c-ctype.h>
/* Number of pt per inch (from the TeXbook). */
@@ -320,15 +313,11 @@ static Lisp_Object QCfontset;
Lisp_Object Qnormal;
Lisp_Object Qbold;
-static Lisp_Object Qultra_light, Qextra_light, Qlight;
-static Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold;
-static Lisp_Object Qoblique, Qreverse_oblique, Qreverse_italic;
+static Lisp_Object Qline, Qwave;
+Lisp_Object Qextra_light, Qlight;
+Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold;
+Lisp_Object Qoblique;
Lisp_Object Qitalic;
-static Lisp_Object Qultra_condensed, Qextra_condensed;
-Lisp_Object Qcondensed;
-static Lisp_Object Qsemi_condensed, Qsemi_expanded, Qextra_expanded;
-Lisp_Object Qexpanded;
-static Lisp_Object Qultra_expanded;
static Lisp_Object Qreleased_button, Qpressed_button;
static Lisp_Object QCstyle, QCcolor, QCline_width;
Lisp_Object Qunspecified; /* used in dosfns.c */
@@ -376,8 +365,6 @@ Lisp_Object Vface_alternative_font_registry_alist;
static Lisp_Object Qscalable_fonts_allowed;
-#define DEFAULT_FONT_LIST_LIMIT 100
-
/* The symbols `foreground-color' and `background-color' which can be
used as part of a `face' property. This is for compatibility with
Emacs 20.2. */
@@ -440,7 +427,7 @@ static Lisp_Object Vparam_value_alist;
/* The total number of colors currently allocated. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
static int ncolors_allocated;
static int npixmaps_allocated;
static int ngcs;
@@ -457,18 +444,7 @@ static int menu_face_changed_default;
struct table_entry;
struct named_merge_point;
-static void map_tty_color (struct frame *, struct face *,
- enum lface_attribute_index, int *);
-static Lisp_Object resolve_face_name (Lisp_Object, int);
static void set_font_frame_param (Lisp_Object, Lisp_Object);
-static int get_lface_attributes (struct frame *, Lisp_Object, Lisp_Object *,
- int, struct named_merge_point *);
-static ptrdiff_t load_pixmap (struct frame *, Lisp_Object,
- unsigned *, unsigned *);
-static struct frame *frame_or_selected_frame (Lisp_Object, int);
-static void load_face_colors (struct frame *, struct face *, Lisp_Object *);
-static void free_face_colors (struct frame *, struct face *);
-static int face_color_gray_p (struct frame *, const char *);
static struct face *realize_face (struct face_cache *, Lisp_Object *,
int);
static struct face *realize_non_ascii_face (struct frame *, Lisp_Object,
@@ -478,38 +454,11 @@ static struct face *realize_tty_face (struct face_cache *, Lisp_Object *);
static int realize_basic_faces (struct frame *);
static int realize_default_face (struct frame *);
static void realize_named_face (struct frame *, Lisp_Object, int);
-static int lface_fully_specified_p (Lisp_Object *);
-static int lface_equal_p (Lisp_Object *, Lisp_Object *);
-static unsigned hash_string_case_insensitive (Lisp_Object);
-static unsigned lface_hash (Lisp_Object *);
-static int lface_same_font_attributes_p (Lisp_Object *, Lisp_Object *);
static struct face_cache *make_face_cache (struct frame *);
static void clear_face_gcs (struct face_cache *);
static void free_face_cache (struct face_cache *);
-static int face_fontset (Lisp_Object *);
-static void merge_face_vectors (struct frame *, Lisp_Object *, Lisp_Object*,
- struct named_merge_point *);
static int merge_face_ref (struct frame *, Lisp_Object, Lisp_Object *,
int, struct named_merge_point *);
-static int set_lface_from_font (struct frame *, Lisp_Object, Lisp_Object,
- int);
-static Lisp_Object lface_from_face_name (struct frame *, Lisp_Object, int);
-static struct face *make_realized_face (Lisp_Object *);
-static void cache_face (struct face_cache *, struct face *, unsigned);
-static void uncache_face (struct face_cache *, struct face *);
-
-#ifdef HAVE_WINDOW_SYSTEM
-
-static GC x_create_gc (struct frame *, unsigned long, XGCValues *);
-static void x_free_gc (struct frame *, GC);
-
-#ifdef USE_X_TOOLKIT
-static void x_update_menu_appearance (struct frame *);
-
-extern void free_frame_menubar (struct frame *);
-#endif /* USE_X_TOOLKIT */
-
-#endif /* HAVE_WINDOW_SYSTEM */
/***********************************************************************
@@ -538,7 +487,7 @@ int color_count[256];
void
register_color (unsigned long pixel)
{
- xassert (pixel < 256);
+ eassert (pixel < 256);
++color_count[pixel];
}
@@ -548,11 +497,11 @@ register_color (unsigned long pixel)
void
unregister_color (unsigned long pixel)
{
- xassert (pixel < 256);
+ eassert (pixel < 256);
if (color_count[pixel] > 0)
--color_count[pixel];
else
- abort ();
+ emacs_abort ();
}
@@ -644,13 +593,13 @@ x_free_dpy_colors (Display *dpy, Screen *screen, Colormap cmap,
/* Create and return a GC for use on frame F. GC values and mask
are given by XGCV and MASK. */
-static inline GC
+static GC
x_create_gc (struct frame *f, long unsigned int mask, XGCValues *xgcv)
{
GC gc;
- BLOCK_INPUT;
+ block_input ();
gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), mask, xgcv);
- UNBLOCK_INPUT;
+ unblock_input ();
IF_DEBUG (++ngcs);
return gc;
}
@@ -658,26 +607,26 @@ x_create_gc (struct frame *f, long unsigned int mask, XGCValues *xgcv)
/* Free GC which was used on frame F. */
-static inline void
+static void
x_free_gc (struct frame *f, GC gc)
{
- eassert (interrupt_input_blocked);
- IF_DEBUG (xassert (--ngcs >= 0));
+ eassert (input_blocked_p ());
+ IF_DEBUG (eassert (--ngcs >= 0));
XFreeGC (FRAME_X_DISPLAY (f), gc);
}
#endif /* HAVE_X_WINDOWS */
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
/* W32 emulation of GCs */
-static inline GC
+static GC
x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv)
{
GC gc;
- BLOCK_INPUT;
+ block_input ();
gc = XCreateGC (NULL, FRAME_W32_WINDOW (f), mask, xgcv);
- UNBLOCK_INPUT;
+ unblock_input ();
IF_DEBUG (++ngcs);
return gc;
}
@@ -685,76 +634,35 @@ x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv)
/* Free GC which was used on frame F. */
-static inline void
+static void
x_free_gc (struct frame *f, GC gc)
{
- IF_DEBUG (xassert (--ngcs >= 0));
+ IF_DEBUG (eassert (--ngcs >= 0));
xfree (gc);
}
-#endif /* WINDOWSNT */
+#endif /* HAVE_NTGUI */
#ifdef HAVE_NS
/* NS emulation of GCs */
-static inline GC
+static GC
x_create_gc (struct frame *f,
unsigned long mask,
XGCValues *xgcv)
{
- GC gc = xmalloc (sizeof (*gc));
- if (gc)
- memcpy (gc, xgcv, sizeof (XGCValues));
+ GC gc = xmalloc (sizeof *gc);
+ *gc = *xgcv;
return gc;
}
-static inline void
+static void
x_free_gc (struct frame *f, GC gc)
{
xfree (gc);
}
#endif /* HAVE_NS */
-/* Like strcasecmp/stricmp. Used to compare parts of font names which
- are in ISO8859-1. */
-
-int
-xstrcasecmp (const char *s1, const char *s2)
-{
- while (*s1 && *s2)
- {
- unsigned char b1 = *s1;
- unsigned char b2 = *s2;
- unsigned char c1 = tolower (b1);
- unsigned char c2 = tolower (b2);
- if (c1 != c2)
- return c1 < c2 ? -1 : 1;
- ++s1, ++s2;
- }
-
- if (*s1 == 0)
- return *s2 == 0 ? 0 : -1;
- return 1;
-}
-
-
-/* If FRAME is nil, return a pointer to the selected frame.
- Otherwise, check that FRAME is a live frame, and return a pointer
- to it. NPARAM is the parameter number of FRAME, for
- CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
- Lisp function definitions. */
-
-static inline struct frame *
-frame_or_selected_frame (Lisp_Object frame, int nparam)
-{
- if (NILP (frame))
- frame = selected_frame;
-
- CHECK_LIVE_FRAME (frame);
- return XFRAME (frame);
-}
-
-
/***********************************************************************
Frames and faces
***********************************************************************/
@@ -786,14 +694,14 @@ init_frame_faces (struct frame *f)
#ifdef HAVE_X_WINDOWS
if (!FRAME_X_P (f) || FRAME_X_WINDOW (f))
#endif
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
if (!FRAME_WINDOW_P (f) || FRAME_W32_WINDOW (f))
#endif
#ifdef HAVE_NS
if (!FRAME_NS_P (f) || FRAME_NS_WINDOW (f))
#endif
if (!realize_basic_faces (f))
- abort ();
+ emacs_abort ();
}
@@ -837,7 +745,7 @@ recompute_basic_faces (struct frame *f)
{
clear_face_cache (0);
if (!realize_basic_faces (f))
- abort ();
+ emacs_abort ();
}
}
@@ -922,7 +830,7 @@ the pixmap. Bits are stored row by row, each row occupies
else if (CONSP (object))
{
/* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
- HEIGHT must be integers > 0, and DATA must be string large
+ HEIGHT must be ints > 0, and DATA must be string large
enough to hold a bitmap of the specified size. */
Lisp_Object width, height, data;
@@ -942,11 +850,11 @@ the pixmap. Bits are stored row by row, each row occupies
}
if (STRINGP (data)
- && INTEGERP (width) && 0 < XINT (width)
- && INTEGERP (height) && 0 < XINT (height))
+ && RANGED_INTEGERP (1, width, INT_MAX)
+ && RANGED_INTEGERP (1, height, INT_MAX))
{
- EMACS_INT bytes_per_row = ((XINT (width) + BITS_PER_CHAR - 1)
- / BITS_PER_CHAR);
+ int bytes_per_row = ((XINT (width) + BITS_PER_CHAR - 1)
+ / BITS_PER_CHAR);
if (XINT (height) <= SBYTES (data) / bytes_per_row)
pixmap_p = 1;
}
@@ -974,7 +882,7 @@ load_pixmap (FRAME_PTR f, Lisp_Object name, unsigned int *w_ptr,
CHECK_TYPE (!NILP (Fbitmap_spec_p (name)), Qbitmap_spec_p, name);
- BLOCK_INPUT;
+ block_input ();
if (CONSP (name))
{
/* Decode a bitmap spec into a bitmap. */
@@ -994,7 +902,7 @@ load_pixmap (FRAME_PTR f, Lisp_Object name, unsigned int *w_ptr,
/* It must be a string -- a file name. */
bitmap_id = x_create_bitmap_from_file (f, name);
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (bitmap_id < 0)
{
@@ -1008,7 +916,7 @@ load_pixmap (FRAME_PTR f, Lisp_Object name, unsigned int *w_ptr,
}
else
{
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
++npixmaps_allocated;
#endif
if (w_ptr)
@@ -1058,7 +966,7 @@ parse_rgb_list (Lisp_Object rgb_list, XColor *color)
non-zero, then the `standard' definition of the same color is
returned in it. */
-static int
+static bool
tty_lookup_color (struct frame *f, Lisp_Object color, XColor *tty_color,
XColor *std_color)
{
@@ -1119,11 +1027,11 @@ tty_lookup_color (struct frame *f, Lisp_Object color, XColor *tty_color,
/* A version of defined_color for non-X frames. */
-static int
+static bool
tty_defined_color (struct frame *f, const char *color_name,
- XColor *color_def, int alloc)
+ XColor *color_def, bool alloc)
{
- int status = 1;
+ bool status = 1;
/* Defaults. */
color_def->pixel = FACE_TTY_DEFAULT_COLOR;
@@ -1151,13 +1059,13 @@ tty_defined_color (struct frame *f, const char *color_name,
/* Decide if color named COLOR_NAME is valid for the display
associated with the frame F; if so, return the rgb values in
- COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
+ COLOR_DEF. If ALLOC, allocate a new colormap cell.
This does the right thing for any type of frame. */
-static int
+static bool
defined_color (struct frame *f, const char *color_name, XColor *color_def,
- int alloc)
+ bool alloc)
{
if (!FRAME_WINDOW_P (f))
return tty_defined_color (f, color_name, color_def, alloc);
@@ -1165,7 +1073,7 @@ defined_color (struct frame *f, const char *color_name, XColor *color_def,
else if (FRAME_X_P (f))
return x_defined_color (f, color_name, color_def, alloc);
#endif
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
else if (FRAME_W32_P (f))
return w32_defined_color (f, color_name, color_def, alloc);
#endif
@@ -1174,7 +1082,7 @@ defined_color (struct frame *f, const char *color_name, XColor *color_def,
return ns_defined_color (f, color_name, color_def, alloc, 1);
#endif
else
- abort ();
+ emacs_abort ();
}
@@ -1273,15 +1181,9 @@ FRAME specifies the frame and thus the display for interpreting COLOR.
If FRAME is nil or omitted, use the selected frame. */)
(Lisp_Object color, Lisp_Object frame)
{
- struct frame *f;
-
CHECK_STRING (color);
- if (NILP (frame))
- frame = selected_frame;
- else
- CHECK_FRAME (frame);
- f = XFRAME (frame);
- return face_color_gray_p (f, SSDATA (color)) ? Qt : Qnil;
+ return (face_color_gray_p (decode_any_frame (frame), SSDATA (color))
+ ? Qt : Qnil);
}
@@ -1294,17 +1196,10 @@ If FRAME is nil or omitted, use the selected frame.
COLOR must be a valid color name. */)
(Lisp_Object color, Lisp_Object frame, Lisp_Object background_p)
{
- struct frame *f;
-
CHECK_STRING (color);
- if (NILP (frame))
- frame = selected_frame;
- else
- CHECK_FRAME (frame);
- f = XFRAME (frame);
- if (face_color_supported_p (f, SSDATA (color), !NILP (background_p)))
- return Qt;
- return Qnil;
+ return (face_color_supported_p (decode_any_frame (frame),
+ SSDATA (color), !NILP (background_p))
+ ? Qt : Qnil);
}
@@ -1323,8 +1218,8 @@ load_color (struct frame *f, struct face *face, Lisp_Object name,
{
XColor color;
- xassert (STRINGP (name));
- xassert (target_index == LFACE_FOREGROUND_INDEX
+ eassert (STRINGP (name));
+ eassert (target_index == LFACE_FOREGROUND_INDEX
|| target_index == LFACE_BACKGROUND_INDEX
|| target_index == LFACE_UNDERLINE_INDEX
|| target_index == LFACE_OVERLINE_INDEX
@@ -1370,10 +1265,10 @@ load_color (struct frame *f, struct face *face, Lisp_Object name,
break;
default:
- abort ();
+ emacs_abort ();
}
}
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
else
++ncolors_allocated;
#endif
@@ -1390,7 +1285,8 @@ load_color (struct frame *f, struct face *face, Lisp_Object name,
try to emulate gray colors with a stipple from Vface_default_stipple. */
static void
-load_face_colors (struct frame *f, struct face *face, Lisp_Object *attrs)
+load_face_colors (struct frame *f, struct face *face,
+ Lisp_Object attrs[LFACE_VECTOR_SIZE])
{
Lisp_Object fg, bg;
@@ -1431,9 +1327,9 @@ unload_color (struct frame *f, long unsigned int pixel)
#ifdef HAVE_X_WINDOWS
if (pixel != -1)
{
- BLOCK_INPUT;
+ block_input ();
x_free_colors (f, &pixel, 1);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif
}
@@ -1449,7 +1345,7 @@ free_face_colors (struct frame *f, struct face *face)
if (face->colors_copied_bitwise_p)
return;
- BLOCK_INPUT;
+ block_input ();
if (!face->foreground_defaulted_p)
{
@@ -1491,7 +1387,7 @@ free_face_colors (struct frame *f, struct face *face)
IF_DEBUG (--ncolors_allocated);
}
- UNBLOCK_INPUT;
+ unblock_input ();
#endif /* HAVE_X_WINDOWS */
}
@@ -1584,8 +1480,10 @@ static enum font_property_index font_props_for_sorting[FONT_SIZE_INDEX];
static int
compare_fonts_by_sort_order (const void *v1, const void *v2)
{
- Lisp_Object font1 = *(Lisp_Object *) v1;
- Lisp_Object font2 = *(Lisp_Object *) v2;
+ Lisp_Object const *p1 = v1;
+ Lisp_Object const *p2 = v2;
+ Lisp_Object font1 = *p1;
+ Lisp_Object font2 = *p2;
int i;
for (i = 0; i < FONT_SIZE_INDEX; i++)
@@ -1604,7 +1502,9 @@ compare_fonts_by_sort_order (const void *v1, const void *v2)
else
{
if (INTEGERP (val1))
- result = INTEGERP (val2) ? XINT (val1) - XINT (val2) : -1;
+ result = (INTEGERP (val2) && XINT (val1) >= XINT (val2)
+ ? XINT (val1) > XINT (val2)
+ : -1);
else
result = INTEGERP (val2) ? 1 : 0;
}
@@ -1633,8 +1533,10 @@ the face font sort order. */)
(Lisp_Object family, Lisp_Object frame)
{
Lisp_Object font_spec, list, *drivers, vec;
- int i, nfonts, ndrivers;
+ ptrdiff_t i, nfonts;
+ EMACS_INT ndrivers;
Lisp_Object result;
+ USE_SAFE_ALLOCA;
if (NILP (frame))
frame = selected_frame;
@@ -1670,13 +1572,13 @@ the face font sort order. */)
font_props_for_sorting[i++] = FONT_REGISTRY_INDEX;
ndrivers = XINT (Flength (list));
- drivers = alloca (sizeof (Lisp_Object) * ndrivers);
+ SAFE_ALLOCA_LISP (drivers, ndrivers);
for (i = 0; i < ndrivers; i++, list = XCDR (list))
drivers[i] = XCAR (list);
vec = Fvconcat (ndrivers, drivers);
nfonts = ASIZE (vec);
- qsort (XVECTOR (vec)->contents, nfonts, sizeof (Lisp_Object),
+ qsort (XVECTOR (vec)->contents, nfonts, word_size,
compare_fonts_by_sort_order);
result = Qnil;
@@ -1702,6 +1604,7 @@ the face font sort order. */)
result = Fcons (v, result);
}
+ SAFE_FREE ();
return result;
}
@@ -1744,9 +1647,7 @@ the WIDTH times as wide as FACE on FRAME. */)
/* We can't simply call check_x_frame because this function may be
called before any frame is created. */
- if (NILP (frame))
- frame = selected_frame;
- f = frame_or_selected_frame (frame, 2);
+ f = decode_live_frame (frame);
if (! FRAME_WINDOW_P (f))
{
/* Perhaps we have not yet created any frame. */
@@ -1754,6 +1655,8 @@ the WIDTH times as wide as FACE on FRAME. */)
frame = Qnil;
face = Qnil;
}
+ else
+ XSETFRAME (frame, f);
/* Determine the width standard for comparison with the fonts we find. */
@@ -1848,7 +1751,6 @@ the WIDTH times as wide as FACE on FRAME. */)
#define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
#define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
-#if XASSERTS
/* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
@@ -1856,77 +1758,77 @@ the WIDTH times as wide as FACE on FRAME. */)
(VECTORP (LFACE) \
&& ASIZE (LFACE) == LFACE_VECTOR_SIZE \
&& EQ (AREF (LFACE, 0), Qface))
-#endif
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check consistency of Lisp face attribute vector ATTRS. */
static void
-check_lface_attrs (Lisp_Object *attrs)
+check_lface_attrs (Lisp_Object attrs[LFACE_VECTOR_SIZE])
{
- xassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_FAMILY_INDEX])
|| STRINGP (attrs[LFACE_FAMILY_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_FOUNDRY_INDEX])
|| STRINGP (attrs[LFACE_FOUNDRY_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_SWIDTH_INDEX])
|| SYMBOLP (attrs[LFACE_SWIDTH_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_HEIGHT_INDEX])
|| INTEGERP (attrs[LFACE_HEIGHT_INDEX])
|| FLOATP (attrs[LFACE_HEIGHT_INDEX])
|| FUNCTIONP (attrs[LFACE_HEIGHT_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_WEIGHT_INDEX])
|| SYMBOLP (attrs[LFACE_WEIGHT_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_SLANT_INDEX])
|| SYMBOLP (attrs[LFACE_SLANT_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_UNDERLINE_INDEX])
|| SYMBOLP (attrs[LFACE_UNDERLINE_INDEX])
- || STRINGP (attrs[LFACE_UNDERLINE_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
+ || STRINGP (attrs[LFACE_UNDERLINE_INDEX])
+ || CONSP (attrs[LFACE_UNDERLINE_INDEX]));
+ eassert (UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_OVERLINE_INDEX])
|| SYMBOLP (attrs[LFACE_OVERLINE_INDEX])
|| STRINGP (attrs[LFACE_OVERLINE_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_STRIKE_THROUGH_INDEX])
|| SYMBOLP (attrs[LFACE_STRIKE_THROUGH_INDEX])
|| STRINGP (attrs[LFACE_STRIKE_THROUGH_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_BOX_INDEX])
|| SYMBOLP (attrs[LFACE_BOX_INDEX])
|| STRINGP (attrs[LFACE_BOX_INDEX])
|| INTEGERP (attrs[LFACE_BOX_INDEX])
|| CONSP (attrs[LFACE_BOX_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_INVERSE_INDEX])
|| SYMBOLP (attrs[LFACE_INVERSE_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_FOREGROUND_INDEX])
|| STRINGP (attrs[LFACE_FOREGROUND_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_BACKGROUND_INDEX])
|| STRINGP (attrs[LFACE_BACKGROUND_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_INHERIT_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_INHERIT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_INHERIT_INDEX])
|| NILP (attrs[LFACE_INHERIT_INDEX])
|| SYMBOLP (attrs[LFACE_INHERIT_INDEX])
|| CONSP (attrs[LFACE_INHERIT_INDEX]));
#ifdef HAVE_WINDOW_SYSTEM
- xassert (UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_STIPPLE_INDEX])
|| SYMBOLP (attrs[LFACE_STIPPLE_INDEX])
|| !NILP (Fbitmap_spec_p (attrs[LFACE_STIPPLE_INDEX])));
- xassert (UNSPECIFIEDP (attrs[LFACE_FONT_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_FONT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_FONT_INDEX])
|| FONTP (attrs[LFACE_FONT_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_FONTSET_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_FONTSET_INDEX])
|| STRINGP (attrs[LFACE_FONTSET_INDEX])
|| NILP (attrs[LFACE_FONTSET_INDEX]));
#endif
@@ -1940,17 +1842,17 @@ check_lface (Lisp_Object lface)
{
if (!NILP (lface))
{
- xassert (LFACEP (lface));
+ eassert (LFACEP (lface));
check_lface_attrs (XVECTOR (lface)->contents);
}
}
-#else /* GLYPH_DEBUG == 0 */
+#else /* not GLYPH_DEBUG */
#define check_lface_attrs(attrs) (void) 0
#define check_lface(lface) (void) 0
-#endif /* GLYPH_DEBUG == 0 */
+#endif /* GLYPH_DEBUG */
@@ -1981,7 +1883,7 @@ struct named_merge_point
FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
pointed to by NAMED_MERGE_POINTS, and return 1. */
-static inline int
+static int
push_named_merge_point (struct named_merge_point *new_named_merge_point,
Lisp_Object face_name,
enum named_merge_point_kind named_merge_point_kind,
@@ -2065,7 +1967,7 @@ resolve_face_name (Lisp_Object face_name, int signal_p)
face text properties; Ediff uses that). If SIGNAL_P is non-zero,
signal an error if FACE_NAME is not a valid face name. If SIGNAL_P
is zero, value is nil if FACE_NAME is not a valid face name. */
-static inline Lisp_Object
+static Lisp_Object
lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name,
int signal_p)
{
@@ -2094,7 +1996,7 @@ lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name,
non-zero, signal an error if FACE_NAME is not a valid face name.
If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
name. */
-static inline Lisp_Object
+static Lisp_Object
lface_from_face_name (struct frame *f, Lisp_Object face_name, int signal_p)
{
face_name = resolve_face_name (face_name, signal_p);
@@ -2108,9 +2010,10 @@ lface_from_face_name (struct frame *f, Lisp_Object face_name, int signal_p)
is non-zero, signal an error if FACE_NAME does not name a face.
Otherwise, value is zero if FACE_NAME is not a face. */
-static inline int
+static int
get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name,
- Lisp_Object *attrs, int signal_p)
+ Lisp_Object attrs[LFACE_VECTOR_SIZE],
+ int signal_p)
{
Lisp_Object lface;
@@ -2130,9 +2033,9 @@ get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name,
non-zero, signal an error if FACE_NAME does not name a face.
Otherwise, value is zero if FACE_NAME is not a face. */
-static inline int
+static int
get_lface_attributes (struct frame *f, Lisp_Object face_name,
- Lisp_Object *attrs, int signal_p,
+ Lisp_Object attrs[LFACE_VECTOR_SIZE], int signal_p,
struct named_merge_point *named_merge_points)
{
Lisp_Object face_remapping;
@@ -2169,7 +2072,7 @@ get_lface_attributes (struct frame *f, Lisp_Object face_name,
specified, i.e. are non-nil. */
static int
-lface_fully_specified_p (Lisp_Object *attrs)
+lface_fully_specified_p (Lisp_Object attrs[LFACE_VECTOR_SIZE])
{
int i;
@@ -2203,41 +2106,41 @@ set_lface_from_font (struct frame *f, Lisp_Object lface,
{
Lisp_Object family = AREF (font_object, FONT_FAMILY_INDEX);
- LFACE_FAMILY (lface) = SYMBOL_NAME (family);
+ ASET (lface, LFACE_FAMILY_INDEX, SYMBOL_NAME (family));
}
if (force_p || UNSPECIFIEDP (LFACE_FOUNDRY (lface)))
{
Lisp_Object foundry = AREF (font_object, FONT_FOUNDRY_INDEX);
- LFACE_FOUNDRY (lface) = SYMBOL_NAME (foundry);
+ ASET (lface, LFACE_FOUNDRY_INDEX, SYMBOL_NAME (foundry));
}
if (force_p || UNSPECIFIEDP (LFACE_HEIGHT (lface)))
{
int pt = PIXEL_TO_POINT (font->pixel_size * 10, f->resy);
- xassert (pt > 0);
- LFACE_HEIGHT (lface) = make_number (pt);
+ eassert (pt > 0);
+ ASET (lface, LFACE_HEIGHT_INDEX, make_number (pt));
}
if (force_p || UNSPECIFIEDP (LFACE_WEIGHT (lface)))
{
val = FONT_WEIGHT_FOR_FACE (font_object);
- LFACE_WEIGHT (lface) = ! NILP (val) ? val :Qnormal;
+ ASET (lface, LFACE_WEIGHT_INDEX, ! NILP (val) ? val :Qnormal);
}
if (force_p || UNSPECIFIEDP (LFACE_SLANT (lface)))
{
val = FONT_SLANT_FOR_FACE (font_object);
- LFACE_SLANT (lface) = ! NILP (val) ? val : Qnormal;
+ ASET (lface, LFACE_SLANT_INDEX, ! NILP (val) ? val : Qnormal);
}
if (force_p || UNSPECIFIEDP (LFACE_SWIDTH (lface)))
{
val = FONT_WIDTH_FOR_FACE (font_object);
- LFACE_SWIDTH (lface) = ! NILP (val) ? val : Qnormal;
+ ASET (lface, LFACE_SWIDTH_INDEX, ! NILP (val) ? val : Qnormal);
}
- LFACE_FONT (lface) = font_object;
+ ASET (lface, LFACE_FONT_INDEX, font_object);
return 1;
}
@@ -2263,7 +2166,7 @@ merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid)
{
if (INTEGERP (to))
/* relative X absolute => absolute */
- result = make_number ((EMACS_INT)(XFLOAT_DATA (from) * XINT (to)));
+ result = make_number (XFLOAT_DATA (from) * XINT (to));
else if (FLOATP (to))
/* relative X relative => relative */
result = make_float (XFLOAT_DATA (from) * XFLOAT_DATA (to));
@@ -2275,11 +2178,7 @@ merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid)
{
/* Call function with current height as argument.
From is the new height. */
- Lisp_Object args[2];
-
- args[0] = from;
- args[1] = to;
- result = safe_call (2, args);
+ result = safe_call1 (from, to);
/* Ensure that if TO was absolute, so is the result. */
if (INTEGERP (to) && !INTEGERP (result))
@@ -2299,11 +2198,12 @@ merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid)
loops in face inheritance/remapping; it should be 0 when called from
other places. */
-static inline void
+static void
merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to,
struct named_merge_point *named_merge_points)
{
int i;
+ Lisp_Object font = Qnil;
/* If FROM inherits from some other faces, merge their attributes into
TO before merging FROM's direct attributes. Note that an :inherit
@@ -2314,24 +2214,13 @@ merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to,
&& !NILP (from[LFACE_INHERIT_INDEX]))
merge_face_ref (f, from[LFACE_INHERIT_INDEX], to, 0, named_merge_points);
- i = LFACE_FONT_INDEX;
- if (!UNSPECIFIEDP (from[i]))
+ if (FONT_SPEC_P (from[LFACE_FONT_INDEX]))
{
- if (!UNSPECIFIEDP (to[i]))
- to[i] = merge_font_spec (from[i], to[i]);
+ if (!UNSPECIFIEDP (to[LFACE_FONT_INDEX]))
+ font = merge_font_spec (from[LFACE_FONT_INDEX], to[LFACE_FONT_INDEX]);
else
- to[i] = copy_font_spec (from[i]);
- if (! NILP (AREF (to[i], FONT_FOUNDRY_INDEX)))
- to[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (to[i], FONT_FOUNDRY_INDEX));
- if (! NILP (AREF (to[i], FONT_FAMILY_INDEX)))
- to[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (to[i], FONT_FAMILY_INDEX));
- if (! NILP (AREF (to[i], FONT_WEIGHT_INDEX)))
- to[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (to[i]);
- if (! NILP (AREF (to[i], FONT_SLANT_INDEX)))
- to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (to[i]);
- if (! NILP (AREF (to[i], FONT_WIDTH_INDEX)))
- to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (to[i]);
- ASET (to[i], FONT_SIZE_INDEX, Qnil);
+ font = copy_font_spec (from[LFACE_FONT_INDEX]);
+ to[LFACE_FONT_INDEX] = font;
}
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
@@ -2342,8 +2231,7 @@ merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to,
to[i] = merge_face_heights (from[i], to[i], to[i]);
font_clear_prop (to, FONT_SIZE_INDEX);
}
- else if (i != LFACE_FONT_INDEX
- && ! EQ (to[i], from[i]))
+ else if (i != LFACE_FONT_INDEX && ! EQ (to[i], from[i]))
{
to[i] = from[i];
if (i >= LFACE_FAMILY_INDEX && i <=LFACE_SLANT_INDEX)
@@ -2357,6 +2245,25 @@ merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to,
}
}
+ /* If FROM specifies a font spec, make its contents take precedence
+ over :family and other attributes. This is needed for face
+ remapping using :font to work. */
+
+ if (!NILP (font))
+ {
+ if (! NILP (AREF (font, FONT_FOUNDRY_INDEX)))
+ to[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (font, FONT_FOUNDRY_INDEX));
+ if (! NILP (AREF (font, FONT_FAMILY_INDEX)))
+ to[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (font, FONT_FAMILY_INDEX));
+ if (! NILP (AREF (font, FONT_WEIGHT_INDEX)))
+ to[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (font);
+ if (! NILP (AREF (font, FONT_SLANT_INDEX)))
+ to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (font);
+ if (! NILP (AREF (font, FONT_WIDTH_INDEX)))
+ to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (font);
+ ASET (font, FONT_SIZE_INDEX, Qnil);
+ }
+
/* TO is always an absolute face, which should inherit from nothing.
We blindly copy the :inherit attribute above and fix it up here. */
to[LFACE_INHERIT_INDEX] = Qnil;
@@ -2520,7 +2427,8 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to,
{
if (EQ (value, Qt)
|| NILP (value)
- || STRINGP (value))
+ || STRINGP (value)
+ || CONSP (value))
to[LFACE_UNDERLINE_INDEX] = value;
else
err = 1;
@@ -2579,13 +2487,13 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to,
}
else if (EQ (keyword, QCstipple))
{
-#if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
+#if defined (HAVE_WINDOW_SYSTEM)
Lisp_Object pixmap_p = Fbitmap_spec_p (value);
if (!NILP (pixmap_p))
to[LFACE_STIPPLE_INDEX] = value;
else
err = 1;
-#endif
+#endif /* HAVE_WINDOW_SYSTEM */
}
else if (EQ (keyword, QCwidth))
{
@@ -2597,6 +2505,13 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to,
else
err = 1;
}
+ else if (EQ (keyword, QCfont))
+ {
+ if (FONTP (value))
+ to[LFACE_FONT_INDEX] = value;
+ else
+ err = 1;
+ }
else if (EQ (keyword, QCinherit))
{
/* This is not really very useful; it's just like a
@@ -2683,8 +2598,7 @@ Value is a vector of face attributes. */)
property `face' of the Lisp face name. */
if (next_lface_id == lface_id_to_name_size)
lface_id_to_name =
- xpalloc (lface_id_to_name, &lface_id_to_name_size, 1,
- min (INT_MAX, MOST_POSITIVE_FIXNUM),
+ xpalloc (lface_id_to_name, &lface_id_to_name_size, 1, MAX_FACE_ID,
sizeof *lface_id_to_name);
lface_id_to_name[next_lface_id] = face;
@@ -2703,7 +2617,7 @@ Value is a vector of face attributes. */)
lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
Qunspecified);
ASET (lface, 0, Qface);
- f->face_alist = Fcons (Fcons (face, lface), f->face_alist);
+ fset_face_alist (f, Fcons (Fcons (face, lface), f->face_alist));
}
else
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
@@ -2723,7 +2637,7 @@ Value is a vector of face attributes. */)
++windows_or_buffers_changed;
}
- xassert (LFACEP (lface));
+ eassert (LFACEP (lface));
check_lface (lface);
return lface;
}
@@ -2789,8 +2703,7 @@ The value is TO. */)
copy = Finternal_make_lisp_face (to, new_frame);
}
- memcpy (XVECTOR (copy)->contents, XVECTOR (lface)->contents,
- LFACE_VECTOR_SIZE * sizeof (Lisp_Object));
+ vcopy (copy, 0, XVECTOR (lface)->contents, LFACE_VECTOR_SIZE);
/* Changing a named face means that all realized faces depending on
that face are invalid. Since we cannot tell which realized faces
@@ -2875,7 +2788,7 @@ FRAME 0 means change the face on all frames, and change the default
signal_error ("Invalid face family", value);
}
old_value = LFACE_FAMILY (lface);
- LFACE_FAMILY (lface) = value;
+ ASET (lface, LFACE_FAMILY_INDEX, value);
prop_index = FONT_FAMILY_INDEX;
}
else if (EQ (attr, QCfoundry))
@@ -2887,7 +2800,7 @@ FRAME 0 means change the face on all frames, and change the default
signal_error ("Invalid face foundry", value);
}
old_value = LFACE_FOUNDRY (lface);
- LFACE_FOUNDRY (lface) = value;
+ ASET (lface, LFACE_FOUNDRY_INDEX, value);
prop_index = FONT_FOUNDRY_INDEX;
}
else if (EQ (attr, QCheight))
@@ -2915,7 +2828,7 @@ FRAME 0 means change the face on all frames, and change the default
}
old_value = LFACE_HEIGHT (lface);
- LFACE_HEIGHT (lface) = value;
+ ASET (lface, LFACE_HEIGHT_INDEX, value);
prop_index = FONT_SIZE_INDEX;
}
else if (EQ (attr, QCweight))
@@ -2927,7 +2840,7 @@ FRAME 0 means change the face on all frames, and change the default
signal_error ("Invalid face weight", value);
}
old_value = LFACE_WEIGHT (lface);
- LFACE_WEIGHT (lface) = value;
+ ASET (lface, LFACE_WEIGHT_INDEX, value);
prop_index = FONT_WEIGHT_INDEX;
}
else if (EQ (attr, QCslant))
@@ -2939,22 +2852,67 @@ FRAME 0 means change the face on all frames, and change the default
signal_error ("Invalid face slant", value);
}
old_value = LFACE_SLANT (lface);
- LFACE_SLANT (lface) = value;
+ ASET (lface, LFACE_SLANT_INDEX, value);
prop_index = FONT_SLANT_INDEX;
}
else if (EQ (attr, QCunderline))
{
- if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
- if ((SYMBOLP (value)
- && !EQ (value, Qt)
- && !EQ (value, Qnil))
- /* Underline color. */
- || (STRINGP (value)
- && SCHARS (value) == 0))
- signal_error ("Invalid face underline", value);
+ int valid_p = 0;
+
+ if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value))
+ valid_p = 1;
+ else if (NILP (value) || EQ (value, Qt))
+ valid_p = 1;
+ else if (STRINGP (value) && SCHARS (value) > 0)
+ valid_p = 1;
+ else if (CONSP (value))
+ {
+ Lisp_Object key, val, list;
+
+ list = value;
+ /* FIXME? This errs on the side of acceptance. Eg it accepts:
+ (defface foo '((t :underline 'foo) "doc")
+ Maybe this is intentional, maybe it isn't.
+ Non-nil symbols other than t are not documented as being valid.
+ Eg compare with inverse-video, which explicitly rejects them.
+ */
+ valid_p = 1;
+
+ while (!NILP (CAR_SAFE(list)))
+ {
+ key = CAR_SAFE (list);
+ list = CDR_SAFE (list);
+ val = CAR_SAFE (list);
+ list = CDR_SAFE (list);
+
+ if (NILP (key) || NILP (val))
+ {
+ valid_p = 0;
+ break;
+ }
+
+ else if (EQ (key, QCcolor)
+ && !(EQ (val, Qforeground_color)
+ || (STRINGP (val) && SCHARS (val) > 0)))
+ {
+ valid_p = 0;
+ break;
+ }
+
+ else if (EQ (key, QCstyle)
+ && !(EQ (val, Qline) || EQ (val, Qwave)))
+ {
+ valid_p = 0;
+ break;
+ }
+ }
+ }
+
+ if (!valid_p)
+ signal_error ("Invalid face underline", value);
old_value = LFACE_UNDERLINE (lface);
- LFACE_UNDERLINE (lface) = value;
+ ASET (lface, LFACE_UNDERLINE_INDEX, value);
}
else if (EQ (attr, QCoverline))
{
@@ -2968,7 +2926,7 @@ FRAME 0 means change the face on all frames, and change the default
signal_error ("Invalid face overline", value);
old_value = LFACE_OVERLINE (lface);
- LFACE_OVERLINE (lface) = value;
+ ASET (lface, LFACE_OVERLINE_INDEX, value);
}
else if (EQ (attr, QCstrike_through))
{
@@ -2982,7 +2940,7 @@ FRAME 0 means change the face on all frames, and change the default
signal_error ("Invalid face strike-through", value);
old_value = LFACE_STRIKE_THROUGH (lface);
- LFACE_STRIKE_THROUGH (lface) = value;
+ ASET (lface, LFACE_STRIKE_THROUGH_INDEX, value);
}
else if (EQ (attr, QCbox))
{
@@ -3045,7 +3003,7 @@ FRAME 0 means change the face on all frames, and change the default
signal_error ("Invalid face box", value);
old_value = LFACE_BOX (lface);
- LFACE_BOX (lface) = value;
+ ASET (lface, LFACE_BOX_INDEX, value);
}
else if (EQ (attr, QCinverse_video)
|| EQ (attr, QCreverse_video))
@@ -3057,7 +3015,7 @@ FRAME 0 means change the face on all frames, and change the default
signal_error ("Invalid inverse-video face attribute value", value);
}
old_value = LFACE_INVERSE (lface);
- LFACE_INVERSE (lface) = value;
+ ASET (lface, LFACE_INVERSE_INDEX, value);
}
else if (EQ (attr, QCforeground))
{
@@ -3074,7 +3032,7 @@ FRAME 0 means change the face on all frames, and change the default
signal_error ("Empty foreground color value", value);
}
old_value = LFACE_FOREGROUND (lface);
- LFACE_FOREGROUND (lface) = value;
+ ASET (lface, LFACE_FOREGROUND_INDEX, value);
}
else if (EQ (attr, QCbackground))
{
@@ -3091,18 +3049,18 @@ FRAME 0 means change the face on all frames, and change the default
signal_error ("Empty background color value", value);
}
old_value = LFACE_BACKGROUND (lface);
- LFACE_BACKGROUND (lface) = value;
+ ASET (lface, LFACE_BACKGROUND_INDEX, value);
}
else if (EQ (attr, QCstipple))
{
-#if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
+#if defined (HAVE_WINDOW_SYSTEM)
if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)
&& !NILP (value)
&& NILP (Fbitmap_spec_p (value)))
signal_error ("Invalid stipple attribute", value);
old_value = LFACE_STIPPLE (lface);
- LFACE_STIPPLE (lface) = value;
-#endif /* HAVE_X_WINDOWS || HAVE_NS */
+ ASET (lface, LFACE_STIPPLE_INDEX, value);
+#endif /* HAVE_WINDOW_SYSTEM */
}
else if (EQ (attr, QCwidth))
{
@@ -3113,7 +3071,7 @@ FRAME 0 means change the face on all frames, and change the default
signal_error ("Invalid face width", value);
}
old_value = LFACE_SWIDTH (lface);
- LFACE_SWIDTH (lface) = value;
+ ASET (lface, LFACE_SWIDTH_INDEX, value);
prop_index = FONT_WIDTH_INDEX;
}
else if (EQ (attr, QCfont))
@@ -3159,7 +3117,7 @@ FRAME 0 means change the face on all frames, and change the default
set_lface_from_font (f, lface, value, 1);
}
else
- LFACE_FONT (lface) = value;
+ ASET (lface, LFACE_FONT_INDEX, value);
}
#endif /* HAVE_WINDOW_SYSTEM */
}
@@ -3174,7 +3132,7 @@ FRAME 0 means change the face on all frames, and change the default
tmp = Fquery_fontset (value, Qnil);
if (NILP (tmp))
signal_error ("Invalid fontset name", value);
- LFACE_FONTSET (lface) = value = tmp;
+ ASET (lface, LFACE_FONTSET_INDEX, value = tmp);
}
#endif /* HAVE_WINDOW_SYSTEM */
}
@@ -3188,21 +3146,21 @@ FRAME 0 means change the face on all frames, and change the default
if (!SYMBOLP (XCAR (tail)))
break;
if (NILP (tail))
- LFACE_INHERIT (lface) = value;
+ ASET (lface, LFACE_INHERIT_INDEX, value);
else
signal_error ("Invalid face inheritance", value);
}
else if (EQ (attr, QCbold))
{
old_value = LFACE_WEIGHT (lface);
- LFACE_WEIGHT (lface) = NILP (value) ? Qnormal : Qbold;
+ ASET (lface, LFACE_WEIGHT_INDEX, NILP (value) ? Qnormal : Qbold);
prop_index = FONT_WEIGHT_INDEX;
}
else if (EQ (attr, QCitalic))
{
attr = QCslant;
old_value = LFACE_SLANT (lface);
- LFACE_SLANT (lface) = NILP (value) ? Qnormal : Qitalic;
+ ASET (lface, LFACE_SLANT_INDEX, NILP (value) ? Qnormal : Qitalic);
prop_index = FONT_SLANT_INDEX;
}
else
@@ -3257,7 +3215,7 @@ FRAME 0 means change the face on all frames, and change the default
param = Qbackground_color;
}
#ifdef HAVE_WINDOW_SYSTEM
-#ifndef WINDOWSNT
+#ifndef HAVE_NTGUI
else if (EQ (face, Qscroll_bar))
{
/* Changing the colors of `scroll-bar' sets frame parameters
@@ -3267,7 +3225,7 @@ FRAME 0 means change the face on all frames, and change the default
else if (EQ (attr, QCbackground))
param = Qscroll_bar_background;
}
-#endif /* not WINDOWSNT */
+#endif /* not HAVE_NTGUI */
else if (EQ (face, Qborder))
{
/* Changing background color of `border' sets frame parameter
@@ -3350,8 +3308,8 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param,
{
face = Qdefault;
lface = lface_from_face_name (f, face, 1);
- LFACE_FOREGROUND (lface) = (STRINGP (new_value)
- ? new_value : Qunspecified);
+ ASET (lface, LFACE_FOREGROUND_INDEX,
+ (STRINGP (new_value) ? new_value : Qunspecified));
realize_basic_faces (f);
}
else if (EQ (param, Qbackground_color))
@@ -3360,14 +3318,14 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param,
/* Changing the background color might change the background
mode, so that we have to load new defface specs.
- Call frame-update-face-colors to do that. */
+ Call frame-set-background-mode to do that. */
XSETFRAME (frame, f);
call1 (Qframe_set_background_mode, frame);
face = Qdefault;
lface = lface_from_face_name (f, face, 1);
- LFACE_BACKGROUND (lface) = (STRINGP (new_value)
- ? new_value : Qunspecified);
+ ASET (lface, LFACE_BACKGROUND_INDEX,
+ (STRINGP (new_value) ? new_value : Qunspecified));
realize_basic_faces (f);
}
#ifdef HAVE_WINDOW_SYSTEM
@@ -3375,22 +3333,22 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param,
{
face = Qborder;
lface = lface_from_face_name (f, face, 1);
- LFACE_BACKGROUND (lface) = (STRINGP (new_value)
- ? new_value : Qunspecified);
+ ASET (lface, LFACE_BACKGROUND_INDEX,
+ (STRINGP (new_value) ? new_value : Qunspecified));
}
else if (EQ (param, Qcursor_color))
{
face = Qcursor;
lface = lface_from_face_name (f, face, 1);
- LFACE_BACKGROUND (lface) = (STRINGP (new_value)
- ? new_value : Qunspecified);
+ ASET (lface, LFACE_BACKGROUND_INDEX,
+ (STRINGP (new_value) ? new_value : Qunspecified));
}
else if (EQ (param, Qmouse_color))
{
face = Qmouse;
lface = lface_from_face_name (f, face, 1);
- LFACE_BACKGROUND (lface) = (STRINGP (new_value)
- ? new_value : Qunspecified);
+ ASET (lface, LFACE_BACKGROUND_INDEX,
+ (STRINGP (new_value) ? new_value : Qunspecified));
}
#endif
@@ -3430,7 +3388,7 @@ set_font_frame_param (Lisp_Object frame, Lisp_Object lface)
font = font_load_for_lface (f, XVECTOR (lface)->contents, font);
if (NILP (font))
return;
- LFACE_FONT (lface) = font;
+ ASET (lface, LFACE_FONT_INDEX, font);
}
f->default_face_done_p = 0;
Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font), Qnil));
@@ -3450,10 +3408,10 @@ DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource,
CHECK_STRING (resource);
CHECK_STRING (class);
CHECK_LIVE_FRAME (frame);
- BLOCK_INPUT;
+ block_input ();
value = display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame)),
resource, class, Qnil, Qnil);
- UNBLOCK_INPUT;
+ unblock_input ();
return value;
}
@@ -3468,7 +3426,7 @@ face_boolean_x_resource_value (Lisp_Object value, int signal_p)
{
Lisp_Object result = make_number (0);
- xassert (STRINGP (value));
+ eassert (STRINGP (value));
if (xstrcasecmp (SSDATA (value), "on") == 0
|| xstrcasecmp (SSDATA (value), "true") == 0)
@@ -3691,21 +3649,12 @@ frame. If FRAME is t, report on the defaults for face SYMBOL (for new
frames). If FRAME is omitted or nil, use the selected frame. */)
(Lisp_Object symbol, Lisp_Object keyword, Lisp_Object frame)
{
- Lisp_Object lface, value = Qnil;
+ struct frame *f = EQ (frame, Qt) ? NULL : decode_live_frame (frame);
+ Lisp_Object lface = lface_from_face_name (f, symbol, 1), value = Qnil;
CHECK_SYMBOL (symbol);
CHECK_SYMBOL (keyword);
- if (EQ (frame, Qt))
- lface = lface_from_face_name (NULL, symbol, 1);
- else
- {
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- lface = lface_from_face_name (XFRAME (frame), symbol, 1);
- }
-
if (EQ (keyword, QCfamily))
value = LFACE_FAMILY (lface);
else if (EQ (keyword, QCfoundry))
@@ -3800,9 +3749,9 @@ Default face attributes override any local face attributes. */)
gvec = XVECTOR (global_lface)->contents;
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
if (IGNORE_DEFFACE_P (gvec[i]))
- lvec[i] = Qunspecified;
+ ASET (local_lface, i, Qunspecified);
else if (! UNSPECIFIEDP (gvec[i]))
- lvec[i] = gvec[i];
+ ASET (local_lface, i, AREF (global_lface, i));
/* If the default face was changed, update the face cache and the
`font' frame parameter. */
@@ -3819,7 +3768,7 @@ Default face attributes override any local face attributes. */)
the previously-cached vector. */
memcpy (attrs, oldface->lface, sizeof attrs);
merge_face_vectors (f, lvec, attrs, 0);
- memcpy (lvec, attrs, sizeof attrs);
+ vcopy (local_lface, 0, attrs, LFACE_VECTOR_SIZE);
newface = realize_face (c, lvec, DEFAULT_FACE_ID);
if ((! UNSPECIFIEDP (gvec[LFACE_FAMILY_INDEX])
@@ -3888,7 +3837,7 @@ return the font name used for CHARACTER. */)
}
else
{
- struct frame *f = frame_or_selected_frame (frame, 1);
+ struct frame *f = decode_live_frame (frame);
int face_id = lookup_named_face (f, face, 1);
struct face *fface = FACE_FROM_ID (f, face_id);
@@ -3918,7 +3867,7 @@ return the font name used for CHARACTER. */)
all attributes are `equal'. Tries to be fast because this function
is called quite often. */
-static inline int
+static int
face_attr_equal_p (Lisp_Object v1, Lisp_Object v2)
{
/* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
@@ -3951,7 +3900,7 @@ face_attr_equal_p (Lisp_Object v1, Lisp_Object v2)
all attributes are `equal'. Tries to be fast because this function
is called quite often. */
-static inline int
+static int
lface_equal_p (Lisp_Object *v1, Lisp_Object *v2)
{
int i, equal_p = 1;
@@ -3975,14 +3924,11 @@ If FRAME is omitted or nil, use the selected frame. */)
struct frame *f;
Lisp_Object lface1, lface2;
- if (EQ (frame, Qt))
- f = NULL;
- else
- /* Don't use check_x_frame here because this function is called
- before X frames exist. At that time, if FRAME is nil,
- selected_frame will be used which is the frame dumped with
- Emacs. That frame is not an X frame. */
- f = frame_or_selected_frame (frame, 2);
+ /* Don't use check_x_frame here because this function is called
+ before X frames exist. At that time, if FRAME is nil,
+ selected_frame will be used which is the frame dumped with
+ Emacs. That frame is not an X frame. */
+ f = EQ (frame, Qt) ? NULL : decode_live_frame (frame);
lface1 = lface_from_face_name (f, face1, 1);
lface2 = lface_from_face_name (f, face2, 1);
@@ -4000,20 +3946,10 @@ If FRAME is t, report on the defaults for face FACE (for new frames).
If FRAME is omitted or nil, use the selected frame. */)
(Lisp_Object face, Lisp_Object frame)
{
- struct frame *f;
- Lisp_Object lface;
+ struct frame *f = EQ (frame, Qt) ? NULL : decode_live_frame (frame);
+ Lisp_Object lface = lface_from_face_name (f, face, 1);
int i;
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
-
- if (EQ (frame, Qt))
- lface = lface_from_face_name (NULL, face, 1);
- else
- lface = lface_from_face_name (f, face, 1);
-
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
if (!UNSPECIFIEDP (AREF (lface, i)))
break;
@@ -4028,29 +3964,28 @@ DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist,
For internal use only. */)
(Lisp_Object frame)
{
- struct frame *f = frame_or_selected_frame (frame, 0);
- return f->face_alist;
+ return decode_live_frame (frame)->face_alist;
}
/* Return a hash code for Lisp string STRING with case ignored. Used
below in computing a hash value for a Lisp face. */
-static inline unsigned
+static unsigned
hash_string_case_insensitive (Lisp_Object string)
{
const unsigned char *s;
unsigned hash = 0;
- xassert (STRINGP (string));
+ eassert (STRINGP (string));
for (s = SDATA (string); *s; ++s)
- hash = (hash << 1) ^ tolower (*s);
+ hash = (hash << 1) ^ c_tolower (*s);
return hash;
}
/* Return a hash code for face attribute vector V. */
-static inline unsigned
+static unsigned
lface_hash (Lisp_Object *v)
{
return (hash_string_case_insensitive (v[LFACE_FAMILY_INDEX])
@@ -4069,10 +4004,10 @@ lface_hash (Lisp_Object *v)
family, point size, weight, width, slant, and font. Both
LFACE1 and LFACE2 must be fully-specified. */
-static inline int
+static int
lface_same_font_attributes_p (Lisp_Object *lface1, Lisp_Object *lface2)
{
- xassert (lface_fully_specified_p (lface1)
+ eassert (lface_fully_specified_p (lface1)
&& lface_fully_specified_p (lface2));
return (xstrcasecmp (SSDATA (lface1[LFACE_FAMILY_INDEX]),
SSDATA (lface2[LFACE_FAMILY_INDEX])) == 0
@@ -4103,8 +4038,7 @@ lface_same_font_attributes_p (Lisp_Object *lface1, Lisp_Object *lface2)
static struct face *
make_realized_face (Lisp_Object *attr)
{
- struct face *face = (struct face *) xmalloc (sizeof *face);
- memset (face, 0, sizeof *face);
+ struct face *face = xzalloc (sizeof *face);
face->ascii_face = face;
memcpy (face->lface, attr, sizeof face->lface);
return face;
@@ -4127,12 +4061,12 @@ free_realized_face (struct frame *f, struct face *face)
free_face_fontset (f, face);
if (face->gc)
{
- BLOCK_INPUT;
+ block_input ();
if (face->font)
font_done_for_face (f, face);
x_free_gc (f, face->gc);
face->gc = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
free_face_colors (f, face);
@@ -4153,7 +4087,7 @@ void
prepare_face_for_display (struct frame *f, struct face *face)
{
#ifdef HAVE_WINDOW_SYSTEM
- xassert (FRAME_WINDOW_P (f));
+ eassert (FRAME_WINDOW_P (f));
if (face->gc == 0)
{
@@ -4166,7 +4100,7 @@ prepare_face_for_display (struct frame *f, struct face *face)
xgcv.graphics_exposures = False;
#endif
- BLOCK_INPUT;
+ block_input ();
#ifdef HAVE_X_WINDOWS
if (face->stipple)
{
@@ -4178,7 +4112,7 @@ prepare_face_for_display (struct frame *f, struct face *face)
face->gc = x_create_gc (f, mask, &xgcv);
if (face->font)
font_prepare_for_face (f, face);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* HAVE_WINDOW_SYSTEM */
}
@@ -4218,14 +4152,9 @@ or lists of the form (RED GREEN BLUE).
If FRAME is unspecified or nil, the current frame is used. */)
(Lisp_Object color1, Lisp_Object color2, Lisp_Object frame)
{
- struct frame *f;
+ struct frame *f = decode_live_frame (frame);
XColor cdef1, cdef2;
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
-
if (!(CONSP (color1) && parse_rgb_list (color1, &cdef1))
&& !(STRINGP (color1) && defined_color (f, SSDATA (color1), &cdef1, 0)))
signal_error ("Invalid color", color1);
@@ -4249,13 +4178,11 @@ make_face_cache (struct frame *f)
struct face_cache *c;
int size;
- c = (struct face_cache *) xmalloc (sizeof *c);
- memset (c, 0, sizeof *c);
+ c = xzalloc (sizeof *c);
size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
- c->buckets = (struct face **) xmalloc (size);
- memset (c->buckets, 0, size);
+ c->buckets = xzalloc (size);
c->size = 50;
- c->faces_by_id = (struct face **) xmalloc (c->size * sizeof *c->faces_by_id);
+ c->faces_by_id = xmalloc (c->size * sizeof *c->faces_by_id);
c->f = f;
c->menu_face_changed_p = menu_face_changed_default;
return c;
@@ -4278,12 +4205,12 @@ clear_face_gcs (struct face_cache *c)
struct face *face = c->faces_by_id[i];
if (face && face->gc)
{
- BLOCK_INPUT;
+ block_input ();
if (face->font)
font_done_for_face (c->f, face);
x_free_gc (c->f, face->gc);
face->gc = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
#endif /* HAVE_WINDOW_SYSTEM */
@@ -4307,7 +4234,7 @@ free_realized_faces (struct face_cache *c)
/* We must block input here because we can't process X events
safely while only some faces are freed, or when the frame's
current matrix still references freed faces. */
- BLOCK_INPUT;
+ block_input ();
for (i = 0; i < c->used; ++i)
{
@@ -4329,7 +4256,7 @@ free_realized_faces (struct face_cache *c)
++windows_or_buffers_changed;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -4414,7 +4341,7 @@ cache_face (struct face_cache *c, struct face *face, unsigned int hash)
break;
face->id = i;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check that FACE got a unique id. */
{
int j, n;
@@ -4425,7 +4352,7 @@ cache_face (struct face_cache *c, struct face *face, unsigned int hash)
if (face1->id == i)
++n;
- xassert (n == 1);
+ eassert (n == 1);
}
#endif /* GLYPH_DEBUG */
@@ -4468,7 +4395,7 @@ uncache_face (struct face_cache *c, struct face *face)
Value is the ID of the face found. If no suitable face is found,
realize a new one. */
-static inline int
+static int
lookup_face (struct frame *f, Lisp_Object *attr)
{
struct face_cache *cache = FRAME_FACE_CACHE (f);
@@ -4476,7 +4403,7 @@ lookup_face (struct frame *f, Lisp_Object *attr)
int i;
struct face *face;
- xassert (cache != NULL);
+ eassert (cache != NULL);
check_lface_attrs (attr);
/* Look up ATTR in the face cache. */
@@ -4500,8 +4427,8 @@ lookup_face (struct frame *f, Lisp_Object *attr)
if (face == NULL)
face = realize_face (cache, attr, -1);
-#if GLYPH_DEBUG
- xassert (face == FACE_FROM_ID (f, face->id));
+#ifdef GLYPH_DEBUG
+ eassert (face == FACE_FROM_ID (f, face->id));
#endif /* GLYPH_DEBUG */
return face->id;
@@ -4522,7 +4449,7 @@ face_for_font (struct frame *f, Lisp_Object font_object, struct face *base_face)
int i;
struct face *face;
- xassert (cache != NULL);
+ eassert (cache != NULL);
base_face = base_face->ascii_face;
hash = lface_hash (base_face->lface);
i = hash % FACE_CACHE_BUCKETS_SIZE;
@@ -4562,7 +4489,7 @@ lookup_named_face (struct frame *f, Lisp_Object symbol, int signal_p)
return -1;
default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
if (default_face == NULL)
- abort (); /* realize_basic_faces must have set it up */
+ emacs_abort (); /* realize_basic_faces must have set it up */
}
if (! get_lface_attributes (f, symbol, symbol_attrs, signal_p, 0))
@@ -4575,7 +4502,7 @@ lookup_named_face (struct frame *f, Lisp_Object symbol, int signal_p)
}
-/* Return the display face-id of the basic face who's canonical face-id
+/* Return the display face-id of the basic face whose canonical face-id
is FACE_ID. The return value will usually simply be FACE_ID, unless that
basic face has bee remapped via Vface_remapping_alist. This function is
conservative: if something goes wrong, it will simply return FACE_ID
@@ -4605,7 +4532,7 @@ lookup_basic_face (struct frame *f, int face_id)
case MENU_FACE_ID: name = Qmenu; break;
default:
- abort (); /* the caller is supposed to pass us a basic face id */
+ emacs_abort (); /* the caller is supposed to pass us a basic face id */
}
/* Do a quick scan through Vface_remapping_alist, and return immediately
@@ -4726,7 +4653,7 @@ lookup_derived_face (struct frame *f, Lisp_Object symbol, int face_id,
struct face *default_face = FACE_FROM_ID (f, face_id);
if (!default_face)
- abort ();
+ emacs_abort ();
if (!get_lface_attributes (f, symbol, symbol_attrs, signal_p, 0))
return -1;
@@ -4775,7 +4702,8 @@ DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector,
\(2) `close in spirit' to what the attributes specify, if not exact. */
static int
-x_supports_face_attributes_p (struct frame *f, Lisp_Object *attrs,
+x_supports_face_attributes_p (struct frame *f,
+ Lisp_Object attrs[LFACE_VECTOR_SIZE],
struct face *def_face)
{
Lisp_Object *def_attrs = def_face->lface;
@@ -4877,17 +4805,17 @@ x_supports_face_attributes_p (struct frame *f, Lisp_Object *attrs,
substitution of a `dim' face for italic. */
static int
-tty_supports_face_attributes_p (struct frame *f, Lisp_Object *attrs,
+tty_supports_face_attributes_p (struct frame *f,
+ Lisp_Object attrs[LFACE_VECTOR_SIZE],
struct face *def_face)
{
- int weight;
+ int weight, slant;
Lisp_Object val, fg, bg;
XColor fg_tty_color, fg_std_color;
XColor bg_tty_color, bg_std_color;
unsigned test_caps = 0;
Lisp_Object *def_attrs = def_face->lface;
-
/* First check some easy-to-check stuff; ttys support none of the
following attributes, so we can just return false if any are requested
(even if `nominal' values are specified, we should still return false,
@@ -4903,11 +4831,9 @@ tty_supports_face_attributes_p (struct frame *f, Lisp_Object *attrs,
|| !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
- || !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
- || !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX]))
+ || !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX]))
return 0;
-
/* Test for terminal `capabilities' (non-color character attributes). */
/* font weight (bold/dim) */
@@ -4933,6 +4859,18 @@ tty_supports_face_attributes_p (struct frame *f, Lisp_Object *attrs,
return 0; /* same as default */
}
+ /* font slant */
+ val = attrs[LFACE_SLANT_INDEX];
+ if (!UNSPECIFIEDP (val)
+ && (slant = FONT_SLANT_NAME_NUMERIC (val), slant >= 0))
+ {
+ int def_slant = FONT_SLANT_NAME_NUMERIC (def_attrs[LFACE_SLANT_INDEX]);
+ if (slant == 100 || slant == def_slant)
+ return 0; /* same as default */
+ else
+ test_caps |= TTY_CAP_ITALIC;
+ }
+
/* underlining */
val = attrs[LFACE_UNDERLINE_INDEX];
if (!UNSPECIFIEDP (val))
@@ -5080,17 +5018,14 @@ face for italic. */)
else
{
/* Find any frame on DISPLAY. */
- Lisp_Object fl_tail;
+ Lisp_Object tail;
frame = Qnil;
- for (fl_tail = Vframe_list; CONSP (fl_tail); fl_tail = XCDR (fl_tail))
- {
- frame = XCAR (fl_tail);
- if (!NILP (Fequal (Fcdr (Fassq (Qdisplay,
- XFRAME (frame)->param_alist)),
- display)))
- break;
- }
+ FOR_EACH_FRAME (tail, frame)
+ if (!NILP (Fequal (Fcdr (Fassq (Qdisplay,
+ XFRAME (frame)->param_alist)),
+ display)))
+ break;
}
CHECK_LIVE_FRAME (frame);
@@ -5107,7 +5042,7 @@ face for italic. */)
error ("Cannot realize default face");
def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
if (def_face == NULL)
- abort (); /* realize_basic_faces must have set it up */
+ emacs_abort (); /* realize_basic_faces must have set it up */
}
/* Dispatch to the appropriate handler. */
@@ -5251,7 +5186,7 @@ be found. Value is ALIST. */)
attribute of ATTRS doesn't name a fontset. */
static int
-face_fontset (Lisp_Object *attrs)
+face_fontset (Lisp_Object attrs[LFACE_VECTOR_SIZE])
{
Lisp_Object name;
@@ -5277,11 +5212,11 @@ static int
realize_basic_faces (struct frame *f)
{
int success_p = 0;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* Block input here so that we won't be surprised by an X expose
event, for instance, without having the faces set up. */
- BLOCK_INPUT;
+ block_input ();
specbind (Qscalable_fonts_allowed, Qt);
if (realize_default_face (f))
@@ -5312,7 +5247,7 @@ realize_basic_faces (struct frame *f)
}
unbind_to (count, Qnil);
- UNBLOCK_INPUT;
+ unblock_input ();
return success_p;
}
@@ -5332,11 +5267,11 @@ realize_default_face (struct frame *f)
/* If the `default' face is not yet known, create it. */
lface = lface_from_face_name (f, Qdefault, 0);
if (NILP (lface))
- {
+ {
Lisp_Object frame;
XSETFRAME (frame, f);
lface = Finternal_make_lisp_face (Qdefault, frame);
- }
+ }
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
@@ -5345,39 +5280,39 @@ realize_default_face (struct frame *f)
XSETFONT (font_object, FRAME_FONT (f));
set_lface_from_font (f, lface, font_object, f->default_face_done_p);
- LFACE_FONTSET (lface) = fontset_name (FRAME_FONTSET (f));
+ ASET (lface, LFACE_FONTSET_INDEX, fontset_name (FRAME_FONTSET (f)));
f->default_face_done_p = 1;
}
#endif /* HAVE_WINDOW_SYSTEM */
if (!FRAME_WINDOW_P (f))
{
- LFACE_FAMILY (lface) = build_string ("default");
- LFACE_FOUNDRY (lface) = LFACE_FAMILY (lface);
- LFACE_SWIDTH (lface) = Qnormal;
- LFACE_HEIGHT (lface) = make_number (1);
+ ASET (lface, LFACE_FAMILY_INDEX, build_string ("default"));
+ ASET (lface, LFACE_FOUNDRY_INDEX, LFACE_FAMILY (lface));
+ ASET (lface, LFACE_SWIDTH_INDEX, Qnormal);
+ ASET (lface, LFACE_HEIGHT_INDEX, make_number (1));
if (UNSPECIFIEDP (LFACE_WEIGHT (lface)))
- LFACE_WEIGHT (lface) = Qnormal;
+ ASET (lface, LFACE_WEIGHT_INDEX, Qnormal);
if (UNSPECIFIEDP (LFACE_SLANT (lface)))
- LFACE_SLANT (lface) = Qnormal;
+ ASET (lface, LFACE_SLANT_INDEX, Qnormal);
if (UNSPECIFIEDP (LFACE_FONTSET (lface)))
- LFACE_FONTSET (lface) = Qnil;
+ ASET (lface, LFACE_FONTSET_INDEX, Qnil);
}
if (UNSPECIFIEDP (LFACE_UNDERLINE (lface)))
- LFACE_UNDERLINE (lface) = Qnil;
+ ASET (lface, LFACE_UNDERLINE_INDEX, Qnil);
if (UNSPECIFIEDP (LFACE_OVERLINE (lface)))
- LFACE_OVERLINE (lface) = Qnil;
+ ASET (lface, LFACE_OVERLINE_INDEX, Qnil);
if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface)))
- LFACE_STRIKE_THROUGH (lface) = Qnil;
+ ASET (lface, LFACE_STRIKE_THROUGH_INDEX, Qnil);
if (UNSPECIFIEDP (LFACE_BOX (lface)))
- LFACE_BOX (lface) = Qnil;
+ ASET (lface, LFACE_BOX_INDEX, Qnil);
if (UNSPECIFIEDP (LFACE_INVERSE (lface)))
- LFACE_INVERSE (lface) = Qnil;
+ ASET (lface, LFACE_INVERSE_INDEX, Qnil);
if (UNSPECIFIEDP (LFACE_FOREGROUND (lface)))
{
@@ -5386,13 +5321,13 @@ realize_default_face (struct frame *f)
Lisp_Object color = Fassq (Qforeground_color, f->param_alist);
if (CONSP (color) && STRINGP (XCDR (color)))
- LFACE_FOREGROUND (lface) = XCDR (color);
+ ASET (lface, LFACE_FOREGROUND_INDEX, XCDR (color));
else if (FRAME_WINDOW_P (f))
return 0;
else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
- LFACE_FOREGROUND (lface) = build_string (unspecified_fg);
+ ASET (lface, LFACE_FOREGROUND_INDEX, build_string (unspecified_fg));
else
- abort ();
+ emacs_abort ();
}
if (UNSPECIFIEDP (LFACE_BACKGROUND (lface)))
@@ -5401,20 +5336,20 @@ realize_default_face (struct frame *f)
set in the frame parameter list. */
Lisp_Object color = Fassq (Qbackground_color, f->param_alist);
if (CONSP (color) && STRINGP (XCDR (color)))
- LFACE_BACKGROUND (lface) = XCDR (color);
+ ASET (lface, LFACE_BACKGROUND_INDEX, XCDR (color));
else if (FRAME_WINDOW_P (f))
return 0;
else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
- LFACE_BACKGROUND (lface) = build_string (unspecified_bg);
+ ASET (lface, LFACE_BACKGROUND_INDEX, build_string (unspecified_bg));
else
- abort ();
+ emacs_abort ();
}
if (UNSPECIFIEDP (LFACE_STIPPLE (lface)))
- LFACE_STIPPLE (lface) = Qnil;
+ ASET (lface, LFACE_STIPPLE_INDEX, Qnil);
/* Realize the face; it must be fully-specified now. */
- xassert (lface_fully_specified_p (XVECTOR (lface)->contents));
+ eassert (lface_fully_specified_p (XVECTOR (lface)->contents));
check_lface (lface);
memcpy (attrs, XVECTOR (lface)->contents, sizeof attrs);
face = realize_face (c, attrs, DEFAULT_FACE_ID);
@@ -5455,7 +5390,7 @@ realize_named_face (struct frame *f, Lisp_Object symbol, int id)
/* The default face must exist and be fully specified. */
get_lface_attributes_no_remap (f, Qdefault, attrs, 1);
check_lface_attrs (attrs);
- xassert (lface_fully_specified_p (attrs));
+ eassert (lface_fully_specified_p (attrs));
/* If SYMBOL isn't know as a face, create it. */
if (NILP (lface))
@@ -5480,12 +5415,13 @@ realize_named_face (struct frame *f, Lisp_Object symbol, int id)
face. Value is a pointer to the newly created realized face. */
static struct face *
-realize_face (struct face_cache *cache, Lisp_Object *attrs, int former_face_id)
+realize_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE],
+ int former_face_id)
{
struct face *face;
/* LFACE must be fully specified. */
- xassert (cache != NULL);
+ eassert (cache != NULL);
check_lface_attrs (attrs);
if (former_face_id >= 0 && cache->used > former_face_id)
@@ -5507,7 +5443,7 @@ realize_face (struct face_cache *cache, Lisp_Object *attrs, int former_face_id)
face = make_realized_face (attrs);
}
else
- abort ();
+ emacs_abort ();
/* Insert the new face. */
cache_face (cache, face, lface_hash (attrs));
@@ -5528,7 +5464,7 @@ realize_non_ascii_face (struct frame *f, Lisp_Object font_object,
struct face_cache *cache = FRAME_FACE_CACHE (f);
struct face *face;
- face = (struct face *) xmalloc (sizeof *face);
+ face = xmalloc (sizeof *face);
*face = *base_face;
face->gc = 0;
face->extra = NULL;
@@ -5557,15 +5493,15 @@ realize_non_ascii_face (struct frame *f, Lisp_Object font_object,
created realized face. */
static struct face *
-realize_x_face (struct face_cache *cache, Lisp_Object *attrs)
+realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE])
{
struct face *face = NULL;
#ifdef HAVE_WINDOW_SYSTEM
struct face *default_face;
struct frame *f;
- Lisp_Object stipple, overline, strike_through, box;
+ Lisp_Object stipple, underline, overline, strike_through, box;
- xassert (FRAME_WINDOW_P (cache->f));
+ eassert (FRAME_WINDOW_P (cache->f));
/* Allocate a new realized face. */
face = make_realized_face (attrs);
@@ -5602,7 +5538,7 @@ realize_x_face (struct face_cache *cache, Lisp_Object *attrs)
if (default_face)
fontset = default_face->fontset;
if (fontset == -1)
- abort ();
+ emacs_abort ();
}
if (! FONT_OBJECT_P (attrs[LFACE_FONT_INDEX]))
attrs[LFACE_FONT_INDEX]
@@ -5643,7 +5579,7 @@ realize_x_face (struct face_cache *cache, Lisp_Object *attrs)
{
/* Simple box of specified line width in foreground color of the
face. */
- xassert (XINT (box) != 0);
+ eassert (XINT (box) != 0);
face->box = FACE_SIMPLE_BOX;
face->box_line_width = XINT (box);
face->box_color = face->foreground;
@@ -5696,28 +5632,77 @@ realize_x_face (struct face_cache *cache, Lisp_Object *attrs)
/* Text underline, overline, strike-through. */
- if (EQ (attrs[LFACE_UNDERLINE_INDEX], Qt))
+ underline = attrs[LFACE_UNDERLINE_INDEX];
+ if (EQ (underline, Qt))
{
/* Use default color (same as foreground color). */
face->underline_p = 1;
+ face->underline_type = FACE_UNDER_LINE;
face->underline_defaulted_p = 1;
face->underline_color = 0;
}
- else if (STRINGP (attrs[LFACE_UNDERLINE_INDEX]))
+ else if (STRINGP (underline))
{
/* Use specified color. */
face->underline_p = 1;
+ face->underline_type = FACE_UNDER_LINE;
face->underline_defaulted_p = 0;
face->underline_color
- = load_color (f, face, attrs[LFACE_UNDERLINE_INDEX],
+ = load_color (f, face, underline,
LFACE_UNDERLINE_INDEX);
}
- else if (NILP (attrs[LFACE_UNDERLINE_INDEX]))
+ else if (NILP (underline))
{
face->underline_p = 0;
face->underline_defaulted_p = 0;
face->underline_color = 0;
}
+ else if (CONSP (underline))
+ {
+ /* `(:color COLOR :style STYLE)'.
+ STYLE being one of `line' or `wave'. */
+ face->underline_p = 1;
+ face->underline_color = 0;
+ face->underline_defaulted_p = 1;
+ face->underline_type = FACE_UNDER_LINE;
+
+ /* FIXME? This is also not robust about checking the precise form.
+ See comments in Finternal_set_lisp_face_attribute. */
+ while (CONSP (underline))
+ {
+ Lisp_Object keyword, value;
+
+ keyword = XCAR (underline);
+ underline = XCDR (underline);
+
+ if (!CONSP (underline))
+ break;
+ value = XCAR (underline);
+ underline = XCDR (underline);
+
+ if (EQ (keyword, QCcolor))
+ {
+ if (EQ (value, Qforeground_color))
+ {
+ face->underline_defaulted_p = 1;
+ face->underline_color = 0;
+ }
+ else if (STRINGP (value))
+ {
+ face->underline_defaulted_p = 0;
+ face->underline_color = load_color (f, face, value,
+ LFACE_UNDERLINE_INDEX);
+ }
+ }
+ else if (EQ (keyword, QCstyle))
+ {
+ if (EQ (value, Qline))
+ face->underline_type = FACE_UNDER_LINE;
+ else if (EQ (value, Qwave))
+ face->underline_type = FACE_UNDER_WAVE;
+ }
+ }
+ }
overline = attrs[LFACE_OVERLINE_INDEX];
if (STRINGP (overline))
@@ -5777,7 +5762,7 @@ map_tty_color (struct frame *f, struct face *face,
foreground_p ? FACE_TTY_DEFAULT_BG_COLOR : FACE_TTY_DEFAULT_FG_COLOR;
#endif
- xassert (idx == LFACE_FOREGROUND_INDEX || idx == LFACE_BACKGROUND_INDEX);
+ eassert (idx == LFACE_FOREGROUND_INDEX || idx == LFACE_BACKGROUND_INDEX);
XSETFRAME (frame, f);
color = face->lface[idx];
@@ -5837,7 +5822,8 @@ map_tty_color (struct frame *f, struct face *face,
Value is a pointer to the newly created realized face. */
static struct face *
-realize_tty_face (struct face_cache *cache, Lisp_Object *attrs)
+realize_tty_face (struct face_cache *cache,
+ Lisp_Object attrs[LFACE_VECTOR_SIZE])
{
struct face *face;
int weight, slant;
@@ -5845,7 +5831,7 @@ realize_tty_face (struct face_cache *cache, Lisp_Object *attrs)
struct frame *f = cache->f;
/* Frame must be a termcap frame. */
- xassert (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f));
+ eassert (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f));
/* Allocate a new realized face. */
face = make_realized_face (attrs);
@@ -5853,15 +5839,13 @@ realize_tty_face (struct face_cache *cache, Lisp_Object *attrs)
face->font_name = FRAME_MSDOS_P (cache->f) ? "ms-dos" : "tty";
#endif
- /* Map face attributes to TTY appearances. We map slant to
- dimmed text because we want italic text to appear differently
- and because dimmed text is probably used infrequently. */
+ /* Map face attributes to TTY appearances. */
weight = FONT_WEIGHT_NAME_NUMERIC (attrs[LFACE_WEIGHT_INDEX]);
slant = FONT_SLANT_NAME_NUMERIC (attrs[LFACE_SLANT_INDEX]);
if (weight > 100)
face->tty_bold_p = 1;
- if (weight < 100 || slant != 100)
- face->tty_dim_p = 1;
+ if (slant != 100)
+ face->tty_italic_p = 1;
if (!NILP (attrs[LFACE_UNDERLINE_INDEX]))
face->tty_underline_p = 1;
if (!NILP (attrs[LFACE_INVERSE_INDEX]))
@@ -5960,9 +5944,9 @@ compute_char_face (struct frame *f, int ch, Lisp_Object prop)
The face returned is suitable for displaying ASCII characters. */
int
-face_at_buffer_position (struct window *w, EMACS_INT pos,
- EMACS_INT region_beg, EMACS_INT region_end,
- EMACS_INT *endptr, EMACS_INT limit,
+face_at_buffer_position (struct window *w, ptrdiff_t pos,
+ ptrdiff_t region_beg, ptrdiff_t region_end,
+ ptrdiff_t *endptr, ptrdiff_t limit,
int mouse, int base_face_id)
{
struct frame *f = XFRAME (w->frame);
@@ -5970,17 +5954,15 @@ face_at_buffer_position (struct window *w, EMACS_INT pos,
Lisp_Object prop, position;
ptrdiff_t i, noverlays;
Lisp_Object *overlay_vec;
- Lisp_Object frame;
- EMACS_INT endpos;
+ ptrdiff_t endpos;
Lisp_Object propname = mouse ? Qmouse_face : Qface;
Lisp_Object limit1, end;
struct face *default_face;
/* W must display the current buffer. We could write this function
to use the frame and buffer of W, but right now it doesn't. */
- /* xassert (XBUFFER (w->buffer) == current_buffer); */
+ /* eassert (XBUFFER (w->buffer) == current_buffer); */
- XSETFRAME (frame, f);
XSETFASTINT (position, pos);
endpos = ZV;
@@ -5997,7 +5979,7 @@ face_at_buffer_position (struct window *w, EMACS_INT pos,
/* Look at properties from overlays. */
{
- EMACS_INT next_overlay;
+ ptrdiff_t next_overlay;
GET_OVERLAYS_AT (pos, overlay_vec, noverlays, &next_overlay, 0);
if (next_overlay < endpos)
@@ -6037,7 +6019,7 @@ face_at_buffer_position (struct window *w, EMACS_INT pos,
for (i = 0; i < noverlays; i++)
{
Lisp_Object oend;
- int oendpos;
+ ptrdiff_t oendpos;
prop = Foverlay_get (overlay_vec[i], propname);
if (!NILP (prop))
@@ -6072,25 +6054,23 @@ face_at_buffer_position (struct window *w, EMACS_INT pos,
simply disregards the `face' properties of all overlays. */
int
-face_for_overlay_string (struct window *w, EMACS_INT pos,
- EMACS_INT region_beg, EMACS_INT region_end,
- EMACS_INT *endptr, EMACS_INT limit,
+face_for_overlay_string (struct window *w, ptrdiff_t pos,
+ ptrdiff_t region_beg, ptrdiff_t region_end,
+ ptrdiff_t *endptr, ptrdiff_t limit,
int mouse, Lisp_Object overlay)
{
struct frame *f = XFRAME (w->frame);
Lisp_Object attrs[LFACE_VECTOR_SIZE];
Lisp_Object prop, position;
- Lisp_Object frame;
- int endpos;
+ ptrdiff_t endpos;
Lisp_Object propname = mouse ? Qmouse_face : Qface;
Lisp_Object limit1, end;
struct face *default_face;
/* W must display the current buffer. We could write this function
to use the frame and buffer of W, but right now it doesn't. */
- /* xassert (XBUFFER (w->buffer) == current_buffer); */
+ /* eassert (XBUFFER (w->buffer) == current_buffer); */
- XSETFRAME (frame, f);
XSETFASTINT (position, pos);
endpos = ZV;
@@ -6107,14 +6087,14 @@ face_for_overlay_string (struct window *w, EMACS_INT pos,
*endptr = endpos;
- default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
-
- /* Optimize common cases where we can use the default face. */
+ /* Optimize common case where we can use the default face. */
if (NILP (prop)
- && !(pos >= region_beg && pos < region_end))
+ && !(pos >= region_beg && pos < region_end)
+ && NILP (Vface_remapping_alist))
return DEFAULT_FACE_ID;
/* Begin with attributes from the default face. */
+ default_face = FACE_FROM_ID (f, lookup_basic_face (f, DEFAULT_FACE_ID));
memcpy (attrs, default_face->lface, sizeof attrs);
/* Merge in attributes specified via text properties. */
@@ -6161,9 +6141,9 @@ face_for_overlay_string (struct window *w, EMACS_INT pos,
int
face_at_string_position (struct window *w, Lisp_Object string,
- EMACS_INT pos, EMACS_INT bufpos,
- EMACS_INT region_beg, EMACS_INT region_end,
- EMACS_INT *endptr, enum face_id base_face_id,
+ ptrdiff_t pos, ptrdiff_t bufpos,
+ ptrdiff_t region_beg, ptrdiff_t region_end,
+ ptrdiff_t *endptr, enum face_id base_face_id,
int mouse_p)
{
Lisp_Object prop, position, end, limit;
@@ -6192,7 +6172,7 @@ face_at_string_position (struct window *w, Lisp_Object string,
*endptr = -1;
base_face = FACE_FROM_ID (f, base_face_id);
- xassert (base_face);
+ eassert (base_face);
/* Optimize the default case that there is no face property and we
are not in the region. */
@@ -6246,7 +6226,7 @@ face_at_string_position (struct window *w, Lisp_Object string,
*/
int
-merge_faces (struct frame *f, Lisp_Object face_name, EMACS_INT face_id,
+merge_faces (struct frame *f, Lisp_Object face_name, int face_id,
int base_face_id)
{
Lisp_Object attrs[LFACE_VECTOR_SIZE];
@@ -6310,14 +6290,14 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
CHECK_STRING (filename);
abspath = Fexpand_file_name (filename, Qnil);
- fp = fopen (SDATA (abspath), "rt");
+ fp = fopen (SSDATA (abspath), "rt");
if (fp)
{
char buf[512];
int red, green, blue;
int num;
- BLOCK_INPUT;
+ block_input ();
while (fgets (buf, sizeof (buf), fp) != NULL) {
if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
@@ -6327,7 +6307,7 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
if (num >= 0 && name[num] == '\n')
name[num] = 0;
cmap = Fcons (Fcons (build_string (name),
-#ifdef WINDOWSNT
+#ifdef HAVE_NTGUI
make_number (RGB (red, green, blue))),
#else
make_number ((red << 16) | (green << 8) | blue)),
@@ -6337,7 +6317,7 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
}
fclose (fp);
- UNBLOCK_INPUT;
+ unblock_input ();
}
return cmap;
@@ -6349,7 +6329,7 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
Tests
***********************************************************************/
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Print the contents of the realized face FACE to stderr. */
@@ -6424,7 +6404,7 @@ DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources,
return Qnil;
}
-#endif /* GLYPH_DEBUG != 0 */
+#endif /* GLYPH_DEBUG */
@@ -6465,10 +6445,11 @@ syms_of_xfaces (void)
DEFSYM (QCcolor, ":color");
DEFSYM (QCline_width, ":line-width");
DEFSYM (QCstyle, ":style");
+ DEFSYM (Qline, "line");
+ DEFSYM (Qwave, "wave");
DEFSYM (Qreleased_button, "released-button");
DEFSYM (Qpressed_button, "pressed-button");
DEFSYM (Qnormal, "normal");
- DEFSYM (Qultra_light, "ultra-light");
DEFSYM (Qextra_light, "extra-light");
DEFSYM (Qlight, "light");
DEFSYM (Qsemi_light, "semi-light");
@@ -6478,16 +6459,6 @@ syms_of_xfaces (void)
DEFSYM (Qultra_bold, "ultra-bold");
DEFSYM (Qoblique, "oblique");
DEFSYM (Qitalic, "italic");
- DEFSYM (Qreverse_oblique, "reverse-oblique");
- DEFSYM (Qreverse_italic, "reverse-italic");
- DEFSYM (Qultra_condensed, "ultra-condensed");
- DEFSYM (Qextra_condensed, "extra-condensed");
- DEFSYM (Qcondensed, "condensed");
- DEFSYM (Qsemi_condensed, "semi-condensed");
- DEFSYM (Qsemi_expanded, "semi-expanded");
- DEFSYM (Qexpanded, "expanded");
- DEFSYM (Qextra_expanded, "extra-expanded");
- DEFSYM (Qultra_expanded, "ultra-expanded");
DEFSYM (Qbackground_color, "background-color");
DEFSYM (Qforeground_color, "foreground-color");
DEFSYM (Qunspecified, "unspecified");
@@ -6546,7 +6517,7 @@ syms_of_xfaces (void)
defsubr (&Sinternal_set_alternative_font_family_alist);
defsubr (&Sinternal_set_alternative_font_registry_alist);
defsubr (&Sface_attributes_as_vector);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
defsubr (&Sdump_face);
defsubr (&Sshow_face_resources);
#endif /* GLYPH_DEBUG */
@@ -6557,22 +6528,16 @@ syms_of_xfaces (void)
defsubr (&Sdump_colors);
#endif
- DEFVAR_LISP ("font-list-limit", Vfont_list_limit,
- doc: /* *Limit for font matching.
-If an integer > 0, font matching functions won't load more than
-that number of fonts when searching for a matching font. */);
- Vfont_list_limit = make_number (DEFAULT_FONT_LIST_LIMIT);
-
DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults,
doc: /* List of global face definitions (for internal use only.) */);
Vface_new_frame_defaults = Qnil;
DEFVAR_LISP ("face-default-stipple", Vface_default_stipple,
- doc: /* *Default stipple pattern used on monochrome displays.
+ doc: /* Default stipple pattern used on monochrome displays.
This stipple pattern is used on monochrome displays
instead of shades of gray for a face background color.
See `set-face-stipple' for possible values for this variable. */);
- Vface_default_stipple = make_pure_c_string ("gray3");
+ Vface_default_stipple = build_pure_c_string ("gray3");
DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist,
doc: /* An alist of defined terminal colors and their RGB values.
@@ -6599,20 +6564,22 @@ ignore. */);
doc: /* Alist of face remappings.
Each element is of the form:
- (FACE REPLACEMENT...),
+ (FACE . REPLACEMENT),
+
+which causes display of the face FACE to use REPLACEMENT instead.
+REPLACEMENT is a face specification, i.e. one of the following:
-which causes display of the face FACE to use REPLACEMENT... instead.
-REPLACEMENT... is interpreted the same way as the value of a `face'
-text property: it may be (1) A face name, (2) A list of face names,
-(3) A property-list of face attribute/value pairs, or (4) A list of
-face names or lists containing face attribute/value pairs.
+ (1) a face name
+ (2) a property list of attribute/value pairs, or
+ (3) a list in which each element has the form of (1) or (2).
-Multiple entries in REPLACEMENT... are merged together to form the final
-result, with faces or attributes earlier in the list taking precedence
-over those that are later.
+List values for REPLACEMENT are merged to form the final face
+specification, with earlier entries taking precedence, in the same as
+as in the `face' text property.
-Face-name remapping cycles are suppressed; recursive references use the
-underlying face instead of the remapped face. So a remapping of the form:
+Face-name remapping cycles are suppressed; recursive references use
+the underlying face instead of the remapped face. So a remapping of
+the form:
(FACE EXTRA-FACE... FACE)
@@ -6620,13 +6587,13 @@ or:
(FACE (FACE-ATTR VAL ...) FACE)
-will cause EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
-existing definition of FACE. Note that for the default face, this isn't
-necessary, as every face inherits from the default face.
+causes EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
+existing definition of FACE. Note that this isn't necessary for the
+default face, since every face inherits from the default face.
-Making this variable buffer-local is a good way to allow buffer-specific
-face definitions. For instance, the mode my-mode could define a face
-`my-mode-default', and then in the mode setup function, do:
+If this variable is made buffer-local, the face remapping takes effect
+only in that buffer. For instance, the mode my-mode could define a
+face `my-mode-default', and then in the mode setup function, do:
(set (make-local-variable 'face-remapping-alist)
'((default my-mode-default)))).
diff --git a/src/xfns.c b/src/xfns.c
index e44f28df870..1f98e9fc8c7 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1,6 +1,6 @@
/* Functions for the X window system.
-Copyright (C) 1989, 1992-2011 Free Software Foundation, Inc.
+Copyright (C) 1989, 1992-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -20,8 +20,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
#include <math.h>
-#include <setjmp.h>
-#include <ctype.h>
#include <unistd.h>
/* This makes the fields of a Display accessible, in Xlib header files. */
@@ -32,13 +30,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "xterm.h"
#include "frame.h"
#include "window.h"
+#include "character.h"
#include "buffer.h"
#include "intervals.h"
#include "dispextern.h"
#include "keyboard.h"
#include "blockinput.h"
#include <epaths.h>
-#include "character.h"
#include "charset.h"
#include "coding.h"
#include "fontset.h"
@@ -50,7 +48,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_X_WINDOWS
-#include <ctype.h>
#include <sys/types.h>
#include <sys/stat.h>
@@ -126,33 +123,20 @@ extern LWLIB_ID widget_id_tick;
#define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
-/* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
- it, and including `bitmaps/gray' more than once is a problem when
- config.h defines `static' as an empty replacement string. */
-
-int gray_bitmap_width = gray_width;
-int gray_bitmap_height = gray_height;
-char *gray_bitmap_bits = gray_bits;
-
/* Nonzero if using X. */
-static int x_in_use;
+int x_in_use;
-static Lisp_Object Qnone;
static Lisp_Object Qsuppress_icon;
static Lisp_Object Qundefined_color;
static Lisp_Object Qcompound_text, Qcancel_timer;
Lisp_Object Qfont_param;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
static ptrdiff_t image_cache_refcount;
static int dpyinfo_refcount;
#endif
-#if defined (USE_GTK) && defined (HAVE_FREETYPE)
-static char *x_last_font_name;
-#endif
-
static struct x_display_info *x_display_info_for_name (Lisp_Object);
@@ -180,12 +164,8 @@ have_menus_p (void)
FRAME_PTR
check_x_frame (Lisp_Object frame)
{
- FRAME_PTR f;
+ struct frame *f = decode_live_frame (frame);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
if (! FRAME_X_P (f))
error ("Non-X frame used");
return f;
@@ -244,13 +224,11 @@ x_window_to_frame (struct x_display_info *dpyinfo, int wdesc)
Lisp_Object tail, frame;
struct frame *f;
- if (wdesc == None) return 0;
+ if (wdesc == None)
+ return NULL;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
continue;
@@ -290,18 +268,16 @@ struct frame *
x_any_window_to_frame (struct x_display_info *dpyinfo, int wdesc)
{
Lisp_Object tail, frame;
- struct frame *f, *found;
+ struct frame *f, *found = NULL;
struct x_output *x;
- if (wdesc == None) return NULL;
+ if (wdesc == None)
+ return NULL;
- found = NULL;
- for (tail = Vframe_list; CONSP (tail) && !found; tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
-
+ if (found)
+ break;
f = XFRAME (frame);
if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
{
@@ -345,13 +321,11 @@ x_menubar_window_to_frame (struct x_display_info *dpyinfo, XEvent *event)
struct frame *f;
struct x_output *x;
- if (wdesc == None) return 0;
+ if (wdesc == None)
+ return NULL;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
continue;
@@ -379,13 +353,11 @@ x_top_window_to_frame (struct x_display_info *dpyinfo, int wdesc)
struct frame *f;
struct x_output *x;
- if (wdesc == None) return 0;
+ if (wdesc == None)
+ return NULL;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
continue;
@@ -441,7 +413,7 @@ x_real_positions (FRAME_PTR f, int *xptr, int *yptr)
unsigned char *tmp_data = NULL;
Atom target_type = XA_CARDINAL;
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (dpy);
@@ -468,7 +440,7 @@ x_real_positions (FRAME_PTR f, int *xptr, int *yptr)
if (! success)
break;
- XFree ((char *) tmp_children);
+ XFree (tmp_children);
if (wm_window == rootw || had_errors)
break;
@@ -559,7 +531,7 @@ x_real_positions (FRAME_PTR f, int *xptr, int *yptr)
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
if (had_errors) return;
@@ -591,27 +563,27 @@ gamma_correct (struct frame *f, XColor *color)
/* Decide if color named COLOR_NAME is valid for use on frame F. If
- so, return the RGB values in COLOR. If ALLOC_P is non-zero,
- allocate the color. Value is zero if COLOR_NAME is invalid, or
+ so, return the RGB values in COLOR. If ALLOC_P,
+ allocate the color. Value is false if COLOR_NAME is invalid, or
no color could be allocated. */
-int
+bool
x_defined_color (struct frame *f, const char *color_name,
- XColor *color, int alloc_p)
+ XColor *color, bool alloc_p)
{
- int success_p = 0;
+ bool success_p = 0;
Display *dpy = FRAME_X_DISPLAY (f);
Colormap cmap = FRAME_X_COLORMAP (f);
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_GTK
success_p = xg_check_special_colors (f, color_name, color);
#endif
if (!success_p)
- success_p = XParseColor (dpy, cmap, color_name, color);
+ success_p = XParseColor (dpy, cmap, color_name, color) != 0;
if (success_p && alloc_p)
success_p = x_alloc_nearest_color (f, cmap, color);
- UNBLOCK_INPUT;
+ unblock_input ();
return success_p;
}
@@ -672,8 +644,8 @@ x_set_tool_bar_position (struct frame *f,
if (EQ (new_value, old_value)) return;
#ifdef USE_GTK
- if (xg_change_toolbar_position (f, new_value))
- f->tool_bar_position = new_value;
+ xg_change_toolbar_position (f, new_value);
+ fset_tool_bar_position (f, new_value);
#endif
}
@@ -695,7 +667,7 @@ xg_set_icon (FRAME_PTR f, Lisp_Object file)
GdkPixbuf *pixbuf;
GError *err = NULL;
char *filename = SSDATA (found);
- BLOCK_INPUT;
+ block_input ();
pixbuf = gdk_pixbuf_new_from_file (filename, &err);
@@ -710,7 +682,7 @@ xg_set_icon (FRAME_PTR f, Lisp_Object file)
else
g_error_free (err);
- UNBLOCK_INPUT;
+ unblock_input ();
}
return result;
@@ -753,7 +725,7 @@ x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
Display *dpy = FRAME_X_DISPLAY (f);
- BLOCK_INPUT;
+ block_input ();
XSetForeground (dpy, x->normal_gc, fg);
XSetBackground (dpy, x->reverse_gc, fg);
@@ -764,7 +736,7 @@ x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
}
- UNBLOCK_INPUT;
+ unblock_input ();
update_face_from_frame_parameter (f, Qforeground_color, arg);
@@ -789,7 +761,7 @@ x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
Display *dpy = FRAME_X_DISPLAY (f);
- BLOCK_INPUT;
+ block_input ();
XSetBackground (dpy, x->normal_gc, bg);
XSetForeground (dpy, x->reverse_gc, bg);
XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
@@ -813,7 +785,7 @@ x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
}
#endif /* USE_TOOLKIT_SCROLL_BARS */
- UNBLOCK_INPUT;
+ unblock_input ();
update_face_from_frame_parameter (f, Qbackground_color, arg);
if (FRAME_VISIBLE_P (f))
@@ -870,7 +842,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
unload_color (f, x->mouse_pixel);
x->mouse_pixel = pixel;
- BLOCK_INPUT;
+ block_input ();
/* It's not okay to crash if the user selects a screwy cursor. */
x_catch_errors (dpy);
@@ -990,7 +962,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
x->horizontal_drag_cursor = horizontal_drag_cursor;
XFlush (dpy);
- UNBLOCK_INPUT;
+ unblock_input ();
update_face_from_frame_parameter (f, Qmouse_color, arg);
}
@@ -1047,10 +1019,10 @@ x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
if (FRAME_X_WINDOW (f) != 0)
{
- BLOCK_INPUT;
+ block_input ();
XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
- UNBLOCK_INPUT;
+ unblock_input ();
if (FRAME_VISIBLE_P (f))
{
@@ -1074,9 +1046,9 @@ x_set_border_pixel (struct frame *f, int pix)
if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0)
{
- BLOCK_INPUT;
+ block_input ();
XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), pix);
- UNBLOCK_INPUT;
+ unblock_input ();
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
@@ -1128,7 +1100,7 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
return;
- BLOCK_INPUT;
+ block_input ();
if (NILP (arg))
result = x_text_icon (f,
SSDATA ((!NILP (f->icon_name)
@@ -1139,12 +1111,12 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
if (result)
{
- UNBLOCK_INPUT;
+ unblock_input ();
error ("No icon window available");
}
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
static void
@@ -1160,12 +1132,12 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
else if (!NILP (arg) || NILP (oldval))
return;
- f->icon_name = arg;
+ fset_icon_name (f, arg);
if (f->output_data.x->icon_bitmap != 0)
return;
- BLOCK_INPUT;
+ block_input ();
result = x_text_icon (f,
SSDATA ((!NILP (f->icon_name)
@@ -1176,12 +1148,12 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
if (result)
{
- UNBLOCK_INPUT;
+ unblock_input ();
error ("No icon window available");
}
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -1200,7 +1172,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
if (FRAME_MINIBUF_ONLY_P (f))
return;
- if (INTEGERP (value))
+ if (TYPE_RANGED_INTEGERP (int, value))
nlines = XINT (value);
else
nlines = 0;
@@ -1215,7 +1187,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
FRAME_EXTERNAL_MENU_BAR (f) = 1;
if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
/* Make sure next redisplay shows the menu bar. */
- XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
+ XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = 1;
}
else
{
@@ -1244,10 +1216,10 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
y = FRAME_TOP_MARGIN_HEIGHT (f);
- BLOCK_INPUT;
+ block_input ();
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
0, y, width, height, False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (nlines > 1 && nlines > olines)
@@ -1255,10 +1227,10 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
y = (olines == 0 ? 1 : olines) * FRAME_LINE_HEIGHT (f);
height = nlines * FRAME_LINE_HEIGHT (f) - y;
- BLOCK_INPUT;
+ block_input ();
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
0, y, width, height, False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (nlines == 0 && WINDOWP (f->menu_bar_window))
@@ -1286,8 +1258,8 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
if (FRAME_MINIBUF_ONLY_P (f))
return;
- /* Use VALUE only if an integer >= 0. */
- if (INTEGERP (value) && XINT (value) >= 0)
+ /* Use VALUE only if an int >= 0. */
+ if (RANGED_INTEGERP (0, value, INT_MAX))
nlines = XFASTINT (value);
else
nlines = 0;
@@ -1299,7 +1271,7 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
FRAME_EXTERNAL_TOOL_BAR (f) = 1;
if (FRAME_X_P (f) && f->output_data.x->toolbar_widget == 0)
/* Make sure next redisplay shows the tool bar. */
- XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
+ XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = 1;
update_frame_tool_bar (f);
}
else
@@ -1354,10 +1326,10 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
/* height can be zero here. */
if (height > 0 && width > 0)
{
- BLOCK_INPUT;
+ block_input ();
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
0, y, width, height, False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (WINDOWP (f->tool_bar_window))
@@ -1510,7 +1482,7 @@ x_set_name_internal (FRAME_PTR f, Lisp_Object name)
{
if (FRAME_X_WINDOW (f))
{
- BLOCK_INPUT;
+ block_input ();
{
XTextProperty text, icon;
ptrdiff_t bytes;
@@ -1602,7 +1574,7 @@ x_set_name_internal (FRAME_PTR f, Lisp_Object name)
if (do_free_text_value)
xfree (text.value);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -1651,7 +1623,7 @@ x_set_name (struct frame *f, Lisp_Object name, int explicit)
if (! NILP (Fstring_equal (name, f->name)))
return;
- f->name = name;
+ fset_name (f, name);
/* For setting the frame title, the title parameter should override
the name parameter. */
@@ -1691,7 +1663,7 @@ x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
update_mode_lines = 1;
- f->title = name;
+ fset_title (f, name);
if (NILP (name))
name = f->name;
@@ -1795,7 +1767,7 @@ hack_wm_protocols (FRAME_PTR f, Widget widget)
int need_focus = 1;
int need_save = 1;
- BLOCK_INPUT;
+ block_input ();
{
Atom type;
unsigned char *catoms;
@@ -1843,7 +1815,7 @@ hack_wm_protocols (FRAME_PTR f, Widget widget)
XA_ATOM, 32, PropModeAppend,
(unsigned char *) props, count);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif
@@ -1889,10 +1861,9 @@ xic_create_fontsetname (const char *base_fontname, int motif)
/* Make a fontset name from the base font name. */
if (xic_default_fontset == base_fontname)
- { /* There is no base font name, use the default. */
- ptrdiff_t len = strlen (base_fontname) + 2;
- fontsetname = xmalloc (len);
- memset (fontsetname, 0, len);
+ {
+ /* There is no base font name, use the default. */
+ fontsetname = xmalloc (strlen (base_fontname) + 2);
strcpy (fontsetname, base_fontname);
}
else
@@ -1908,13 +1879,12 @@ xic_create_fontsetname (const char *base_fontname, int motif)
for (i = 0; *p; p++)
if (*p == '-') i++;
if (i != 14)
- { /* As the font name doesn't conform to XLFD, we can't
+ {
+ /* As the font name doesn't conform to XLFD, we can't
modify it to generalize it to allcs and allfamilies.
Use the specified font plus the default. */
- ptrdiff_t len =
- strlen (base_fontname) + strlen (xic_default_fontset) + 3;
- fontsetname = xmalloc (len);
- memset (fontsetname, 0, len);
+ fontsetname = xmalloc (strlen (base_fontname)
+ + strlen (xic_default_fontset) + 3);
strcpy (fontsetname, base_fontname);
strcat (fontsetname, sep);
strcat (fontsetname, xic_default_fontset);
@@ -1963,24 +1933,21 @@ xic_create_fontsetname (const char *base_fontname, int motif)
/* Build the font spec that matches all charsets. */
len = p - base_fontname + strlen (allcs) + 1;
- font_allcs = (char *) alloca (len);
- memset (font_allcs, 0, len);
+ font_allcs = alloca (len);
memcpy (font_allcs, base_fontname, p - base_fontname);
strcat (font_allcs, allcs);
/* Build the font spec that matches all families and
add-styles. */
len = p - p1 + strlen (allcs) + strlen (allfamilies) + 1;
- font_allfamilies = (char *) alloca (len);
- memset (font_allfamilies, 0, len);
+ font_allfamilies = alloca (len);
strcpy (font_allfamilies, allfamilies);
memcpy (font_allfamilies + strlen (allfamilies), p1, p - p1);
strcat (font_allfamilies, allcs);
/* Build the font spec that matches all. */
len = p - p2 + strlen (allcs) + strlen (all) + strlen (allfamilies) + 1;
- font_all = (char *) alloca (len);
- memset (font_all, 0, len);
+ font_all = alloca (len);
strcpy (font_all, allfamilies);
strcat (font_all, all);
memcpy (font_all + strlen (all) + strlen (allfamilies), p2, p - p2);
@@ -1990,7 +1957,6 @@ xic_create_fontsetname (const char *base_fontname, int motif)
len = strlen (base_fontname) + strlen (font_allcs)
+ strlen (font_allfamilies) + strlen (font_all) + 5;
fontsetname = xmalloc (len);
- memset (fontsetname, 0, len);
strcpy (fontsetname, base_fontname);
strcat (fontsetname, sep);
strcat (fontsetname, font_allcs);
@@ -2372,7 +2338,7 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only)
Arg al [25];
int ac;
- BLOCK_INPUT;
+ block_input ();
/* Use the resource name as the top-level widget name
for looking up resources. Make a non-Lisp copy
@@ -2382,7 +2348,7 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only)
{
char *str = SSDATA (Vx_resource_name);
- f->namebuf = (char *) xmalloc (strlen (str) + 1);
+ f->namebuf = xmalloc (strlen (str) + 1);
strcpy (f->namebuf, str);
}
@@ -2439,7 +2405,6 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only)
/* Do some needed geometry management. */
{
- ptrdiff_t len;
char *tem, shell_position[sizeof "=x++" + 4 * INT_STRLEN_BOUND (int)];
Arg gal[10];
int gac = 0;
@@ -2508,13 +2473,11 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only)
}
}
- len = strlen (shell_position) + 1;
/* We don't free this because we don't know whether
it is safe to free it while the frame exists.
It isn't worth the trouble of arranging to free it
when the frame is deleted. */
- tem = (char *) xmalloc (len);
- strncpy (tem, shell_position, len);
+ tem = xstrdup (shell_position);
XtSetArg (gal[gac], XtNgeometry, tem); gac++;
XtSetValues (shell_widget, gal, gac);
}
@@ -2589,7 +2552,7 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only)
f->explicit_name = 0;
name = f->name;
- f->name = Qnil;
+ fset_name (f, Qnil);
x_set_name (f, name, explicit);
}
@@ -2597,7 +2560,7 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only)
f->output_data.x->current_cursor
= f->output_data.x->text_cursor);
- UNBLOCK_INPUT;
+ unblock_input ();
/* This is a no-op, except under Motif. Make sure main areas are
set to something reasonable, in case we get an error later. */
@@ -2616,7 +2579,7 @@ x_window (FRAME_PTR f)
FRAME_XIC (f) = NULL;
if (use_xim)
{
- BLOCK_INPUT;
+ block_input ();
create_frame_xic (f);
if (FRAME_XIC (f))
{
@@ -2638,7 +2601,7 @@ x_window (FRAME_PTR f)
attribute_mask, &attributes);
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif
}
@@ -2663,7 +2626,7 @@ x_window (struct frame *f)
attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
| CWColormap);
- BLOCK_INPUT;
+ block_input ();
FRAME_X_WINDOW (f)
= XCreateWindow (FRAME_X_DISPLAY (f),
f->output_data.x->parent_desc,
@@ -2732,7 +2695,7 @@ x_window (struct frame *f)
f->explicit_name = 0;
name = f->name;
- f->name = Qnil;
+ fset_name (f, Qnil);
x_set_name (f, name, explicit);
}
@@ -2740,7 +2703,7 @@ x_window (struct frame *f)
f->output_data.x->current_cursor
= f->output_data.x->text_cursor);
- UNBLOCK_INPUT;
+ unblock_input ();
if (FRAME_X_WINDOW (f) == 0)
error ("Unable to create window");
@@ -2787,13 +2750,13 @@ x_icon (struct frame *f, Lisp_Object parms)
icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
{
- CHECK_NUMBER (icon_x);
- CHECK_NUMBER (icon_y);
+ CHECK_TYPE_RANGED_INTEGER (int, icon_x);
+ CHECK_TYPE_RANGED_INTEGER (int, icon_y);
}
else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
error ("Both left and top icon corners of icon must be specified");
- BLOCK_INPUT;
+ block_input ();
if (! EQ (icon_x, Qunbound))
x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
@@ -2812,7 +2775,7 @@ x_icon (struct frame *f, Lisp_Object parms)
? f->icon_name
: f->name)));
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Make the GCs needed for this window, setting the
@@ -2824,7 +2787,7 @@ x_make_gc (struct frame *f)
{
XGCValues gc_values;
- BLOCK_INPUT;
+ block_input ();
/* Create the GCs of this frame.
Note that many default values are used. */
@@ -2872,7 +2835,7 @@ x_make_gc (struct frame *f)
FRAME_BACKGROUND_PIXEL (f),
DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -2883,7 +2846,7 @@ x_free_gcs (struct frame *f)
{
Display *dpy = FRAME_X_DISPLAY (f);
- BLOCK_INPUT;
+ block_input ();
if (f->output_data.x->normal_gc)
{
@@ -2909,7 +2872,7 @@ x_free_gcs (struct frame *f)
f->output_data.x->border_tile = 0;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -2931,17 +2894,17 @@ unwind_create_frame (Lisp_Object frame)
/* If frame is ``official'', nothing to do. */
if (NILP (Fmemq (frame, Vframe_list)))
{
-#if GLYPH_DEBUG && XASSERTS
+#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
#endif
x_free_frame_resources (f);
free_glyphs (f);
-#if GLYPH_DEBUG
+#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
/* Check that reference counts are indeed correct. */
- xassert (dpyinfo->reference_count == dpyinfo_refcount);
- xassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
+ eassert (dpyinfo->reference_count == dpyinfo_refcount);
+ eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
#endif
return Qt;
}
@@ -2949,6 +2912,12 @@ unwind_create_frame (Lisp_Object frame)
return Qnil;
}
+static Lisp_Object
+unwind_create_frame_1 (Lisp_Object val)
+{
+ inhibit_lisp_code = val;
+ return Qnil;
+}
static void
x_default_font_parameter (struct frame *f, Lisp_Object parms)
@@ -2967,11 +2936,7 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms)
read yet. */
const char *system_font = xsettings_get_system_font ();
if (system_font)
- {
- char *name = xstrdup (system_font);
- font = font_open_by_name (f, name);
- xfree (name);
- }
+ font = font_open_by_name (f, build_unibyte_string (system_font));
}
if (NILP (font))
@@ -3001,7 +2966,7 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms)
for (i = 0; names[i]; i++)
{
- font = font_open_by_name (f, names[i]);
+ font = font_open_by_name (f, build_unibyte_string (names[i]));
if (! NILP (font))
break;
}
@@ -3023,17 +2988,15 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms)
DEFUN ("x-wm-set-size-hint", Fx_wm_set_size_hint, Sx_wm_set_size_hint,
0, 1, 0,
doc: /* Send the size hints for frame FRAME to the window manager.
-If FRAME is nil, use the selected frame. */)
+If FRAME is omitted or nil, use the selected frame.
+Signal error if FRAME is not an X frame. */)
(Lisp_Object frame)
{
- struct frame *f;
- if (NILP (frame))
- frame = selected_frame;
- f = XFRAME (frame);
- BLOCK_INPUT;
- if (FRAME_X_P (f))
- x_wm_set_size_hint (f, 0, 0);
- UNBLOCK_INPUT;
+ struct frame *f = check_x_frame (frame);
+
+ block_input ();
+ x_wm_set_size_hint (f, 0, 0);
+ unblock_input ();
return Qnil;
}
@@ -3073,7 +3036,7 @@ This function is an internal primitive--use `make-frame' instead. */)
int minibuffer_only = 0;
long window_prompting = 0;
int width, height;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object display;
struct x_display_info *dpyinfo = NULL;
@@ -3134,14 +3097,10 @@ This function is an internal primitive--use `make-frame' instead. */)
XSETFRAME (frame, f);
- /* Note that X Windows does support scroll bars. */
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
-
f->terminal = dpyinfo->terminal;
f->output_method = output_x_window;
- f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
- memset (f->output_data.x, 0, sizeof (struct x_output));
+ f->output_data.x = xzalloc (sizeof *f->output_data.x);
f->output_data.x->icon_bitmap = -1;
FRAME_FONTSET (f) = -1;
f->output_data.x->scroll_bar_foreground_pixel = -1;
@@ -3151,11 +3110,11 @@ This function is an internal primitive--use `make-frame' instead. */)
f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
#endif /* USE_TOOLKIT_SCROLL_BARS */
- f->icon_name
- = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
- RES_TYPE_STRING);
+ fset_icon_name (f,
+ x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
+ RES_TYPE_STRING));
if (! STRINGP (f->icon_name))
- f->icon_name = Qnil;
+ fset_icon_name (f, Qnil);
FRAME_X_DISPLAY_INFO (f) = dpyinfo;
@@ -3212,12 +3171,12 @@ This function is an internal primitive--use `make-frame' instead. */)
be set. */
if (EQ (name, Qunbound) || NILP (name))
{
- f->name = build_string (dpyinfo->x_id_name);
+ fset_name (f, build_string (dpyinfo->x_id_name));
f->explicit_name = 0;
}
else
{
- f->name = name;
+ fset_name (f, name);
f->explicit_name = 1;
/* use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
@@ -3307,7 +3266,7 @@ This function is an internal primitive--use `make-frame' instead. */)
"scrollBarBackground",
"ScrollBarBackground", 0);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
image_cache_refcount =
FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
dpyinfo_refcount = dpyinfo->reference_count;
@@ -3321,17 +3280,30 @@ This function is an internal primitive--use `make-frame' instead. */)
happen. */
init_frame_faces (f);
- /* The X resources controlling the menu-bar and tool-bar are
- processed specially at startup, and reflected in the mode
- variables; ignore them here. */
- x_default_parameter (f, parms, Qmenu_bar_lines,
- NILP (Vmenu_bar_mode)
- ? make_number (0) : make_number (1),
- NULL, NULL, RES_TYPE_NUMBER);
- x_default_parameter (f, parms, Qtool_bar_lines,
- NILP (Vtool_bar_mode)
- ? make_number (0) : make_number (1),
- NULL, NULL, RES_TYPE_NUMBER);
+ /* Set the menu-bar-lines and tool-bar-lines parameters. We don't
+ look up the X resources controlling the menu-bar and tool-bar
+ here; they are processed specially at startup, and reflected in
+ the values of the mode variables.
+
+ Avoid calling window-configuration-change-hook; otherwise we
+ could get an infloop in next_frame since the frame is not yet in
+ Vframe_list. */
+ {
+ ptrdiff_t count2 = SPECPDL_INDEX ();
+ record_unwind_protect (unwind_create_frame_1, inhibit_lisp_code);
+ inhibit_lisp_code = Qt;
+
+ x_default_parameter (f, parms, Qmenu_bar_lines,
+ NILP (Vmenu_bar_mode)
+ ? make_number (0) : make_number (1),
+ NULL, NULL, RES_TYPE_NUMBER);
+ x_default_parameter (f, parms, Qtool_bar_lines,
+ NILP (Vtool_bar_mode)
+ ? make_number (0) : make_number (1),
+ NULL, NULL, RES_TYPE_NUMBER);
+
+ unbind_to (count2, Qnil);
+ }
x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
"bufferPredicate", "BufferPredicate",
@@ -3416,9 +3388,9 @@ This function is an internal primitive--use `make-frame' instead. */)
/* Tell the server what size and position, etc, we want, and how
badly we want them. This should be done after we have the menu
bar so that its size can be taken into account. */
- BLOCK_INPUT;
+ block_input ();
x_wm_set_size_hint (f, window_prompting, 0);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Make the window appear on the frame and enable display, unless
the caller says not to. However, with explicit parent, Emacs
@@ -3442,7 +3414,7 @@ This function is an internal primitive--use `make-frame' instead. */)
}
}
- BLOCK_INPUT;
+ block_input ();
/* Set machine name and pid for the purpose of window managers. */
set_machine_and_pid_properties (f);
@@ -3458,20 +3430,20 @@ This function is an internal primitive--use `make-frame' instead. */)
(unsigned char *) &dpyinfo->client_leader_window, 1);
}
- UNBLOCK_INPUT;
+ unblock_input ();
/* Initialize `default-minibuffer-frame' in case this is the first
frame on this terminal. */
if (FRAME_HAS_MINIBUF_P (f)
&& (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
|| !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
- KVAR (kb, Vdefault_minibuffer_frame) = frame;
+ kset_default_minibuffer_frame (kb, frame);
/* All remaining specified parameters, which have not been "used"
by x_get_arg and friends, now go in the misc. alist of the frame. */
for (tem = parms; CONSP (tem); tem = XCDR (tem))
if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
- f->param_alist = Fcons (XCAR (tem), f->param_alist);
+ fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
UNGCPRO;
@@ -3517,13 +3489,25 @@ FRAME nil means use the selected frame. */)
struct frame *f = check_x_frame (frame);
Display *dpy = FRAME_X_DISPLAY (f);
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (dpy);
- XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- RevertToParent, CurrentTime);
- x_ewmh_activate_frame (f);
+
+ if (FRAME_X_EMBEDDED_P (f))
+ {
+ /* For Xembedded frames, normally the embedder forwards key
+ events. See XEmbed Protocol Specification at
+ http://freedesktop.org/wiki/Specifications/xembed-spec */
+ xembed_request_focus (f);
+ }
+ else
+ {
+ XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ RevertToParent, CurrentTime);
+ x_ewmh_activate_frame (f);
+ }
+
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
@@ -3944,7 +3928,7 @@ select_visual (struct x_display_info *dpyinfo)
/* VALUE should be of the form CLASS-DEPTH, where CLASS is one
of `PseudoColor', `TrueColor' etc. and DEPTH is the color
depth, a decimal number. NAME is compared with case ignored. */
- char *s = (char *) alloca (SBYTES (value) + 1);
+ char *s = alloca (SBYTES (value) + 1);
char *dash;
int i, class = -1;
XVisualInfo vinfo;
@@ -3992,7 +3976,7 @@ select_visual (struct x_display_info *dpyinfo)
fatal ("Can't get proper X visual info");
dpyinfo->n_planes = vinfo->depth;
- XFree ((char *) vinfo);
+ XFree (vinfo);
}
}
@@ -4151,9 +4135,9 @@ If TERMINAL is omitted or nil, that stands for the selected frame's display. */
void
x_sync (FRAME_PTR f)
{
- BLOCK_INPUT;
+ block_input ();
XSync (FRAME_X_DISPLAY (f), False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -4176,9 +4160,10 @@ If TYPE is not given or nil, the type is STRING.
FORMAT gives the size in bits of each element if VALUE is a list.
It must be one of 8, 16 or 32.
If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
-If OUTER_P is non-nil, the property is changed for the outer X window of
+If OUTER-P is non-nil, the property is changed for the outer X window of
FRAME. Default is to change on the edit X window. */)
- (Lisp_Object prop, Lisp_Object value, Lisp_Object frame, Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
+ (Lisp_Object prop, Lisp_Object value, Lisp_Object frame,
+ Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
@@ -4193,11 +4178,11 @@ FRAME. Default is to change on the edit X window. */)
if (! NILP (format))
{
CHECK_NUMBER (format);
- element_format = XFASTINT (format);
- if (element_format != 8 && element_format != 16
- && element_format != 32)
+ if (XINT (format) != 8 && XINT (format) != 16
+ && XINT (format) != 32)
error ("FORMAT must be one of 8, 16 or 32");
+ element_format = XINT (format);
}
if (CONSP (value))
@@ -4227,7 +4212,7 @@ FRAME. Default is to change on the edit X window. */)
nelements = SBYTES (value);
}
- BLOCK_INPUT;
+ block_input ();
prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False);
if (! NILP (type))
{
@@ -4246,7 +4231,7 @@ FRAME. Default is to change on the edit X window. */)
/* Make sure the property is set when we return. */
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
return value;
}
@@ -4262,13 +4247,13 @@ FRAME nil or omitted means use the selected frame. Value is PROP. */)
Atom prop_atom;
CHECK_STRING (prop);
- BLOCK_INPUT;
+ block_input ();
prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False);
XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
/* Make sure the property is removed when we return. */
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
return prop;
}
@@ -4279,19 +4264,20 @@ DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
doc: /* Value is the value of window property PROP on FRAME.
If FRAME is nil or omitted, use the selected frame.
-On MS Windows, this function only accepts the PROP and FRAME arguments.
-
On X Windows, the following optional arguments are also accepted:
If TYPE is nil or omitted, get the property as a string.
Otherwise TYPE is the name of the atom that denotes the type expected.
If SOURCE is non-nil, get the property on that window instead of from
FRAME. The number 0 denotes the root window.
-If DELETE_P is non-nil, delete the property after retrieving it.
-If VECTOR_RET_P is non-nil, don't return a string but a vector of values.
+If DELETE-P is non-nil, delete the property after retrieving it.
+If VECTOR-RET-P is non-nil, don't return a string but a vector of values.
+
+On MS Windows, this function accepts but ignores those optional arguments.
Value is nil if FRAME hasn't a property with name PROP or if PROP has
no value of TYPE (always string in the MS Windows case). */)
- (Lisp_Object prop, Lisp_Object frame, Lisp_Object type, Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p)
+ (Lisp_Object prop, Lisp_Object frame, Lisp_Object type,
+ Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p)
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
@@ -4315,7 +4301,7 @@ no value of TYPE (always string in the MS Windows case). */)
target_window = FRAME_X_DISPLAY_INFO (f)->root_window;
}
- BLOCK_INPUT;
+ block_input ();
if (STRINGP (type))
{
if (strcmp ("AnyPropertyType", SSDATA (type)) == 0)
@@ -4381,7 +4367,7 @@ no value of TYPE (always string in the MS Windows case). */)
if (tmp_data) XFree (tmp_data);
}
- UNBLOCK_INPUT;
+ unblock_input ();
UNGCPRO;
return prop_value;
}
@@ -4412,7 +4398,7 @@ show_hourglass (struct atimer *timer)
{
Lisp_Object rest, frame;
- BLOCK_INPUT;
+ block_input ();
FOR_EACH_FRAME (rest, frame)
{
@@ -4456,7 +4442,7 @@ show_hourglass (struct atimer *timer)
}
hourglass_shown_p = 1;
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -4471,7 +4457,7 @@ hide_hourglass (void)
{
Lisp_Object rest, frame;
- BLOCK_INPUT;
+ block_input ();
FOR_EACH_FRAME (rest, frame)
{
struct frame *f = XFRAME (frame);
@@ -4490,7 +4476,7 @@ hide_hourglass (void)
}
hourglass_shown_p = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -4555,7 +4541,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
Lisp_Object frame;
Lisp_Object name;
int width, height;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
int face_change_count_before = face_change_count;
Lisp_Object buffer;
@@ -4581,17 +4567,18 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
XSETFRAME (frame, f);
buffer = Fget_buffer_create (build_string (" *tip*"));
- Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
+ /* Use set_window_buffer instead of Fset_window_buffer (see
+ discussion of bug#11984, bug#12025, bug#12026). */
+ set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, 0, 0);
old_buffer = current_buffer;
set_buffer_internal_1 (XBUFFER (buffer));
- BVAR (current_buffer, truncate_lines) = Qnil;
+ bset_truncate_lines (current_buffer, Qnil);
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Ferase_buffer ();
Finsert (1, &text);
set_buffer_internal_1 (old_buffer);
- FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
record_unwind_protect (unwind_create_tip_frame, frame);
f->terminal = dpyinfo->terminal;
@@ -4601,8 +4588,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
from this point on, x_destroy_window might screw up reference
counts etc. */
f->output_method = output_x_window;
- f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
- memset (f->output_data.x, 0, sizeof (struct x_output));
+ f->output_data.x = xzalloc (sizeof *f->output_data.x);
f->output_data.x->icon_bitmap = -1;
FRAME_FONTSET (f) = -1;
f->output_data.x->scroll_bar_foreground_pixel = -1;
@@ -4611,7 +4597,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
f->output_data.x->scroll_bar_top_shadow_pixel = -1;
f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
#endif /* USE_TOOLKIT_SCROLL_BARS */
- f->icon_name = Qnil;
+ fset_icon_name (f, Qnil);
FRAME_X_DISPLAY_INFO (f) = dpyinfo;
f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
f->output_data.x->explicit_parent = 0;
@@ -4653,12 +4639,12 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
be set. */
if (EQ (name, Qunbound) || NILP (name))
{
- f->name = build_string (dpyinfo->x_id_name);
+ fset_name (f, build_string (dpyinfo->x_id_name));
f->explicit_name = 0;
}
else
{
- f->name = name;
+ fset_name (f, name);
f->explicit_name = 1;
/* use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
@@ -4716,7 +4702,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
x_default_parameter (f, parms, Qborder_color, build_string ("black"),
"borderColor", "BorderColor", RES_TYPE_STRING);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
image_cache_refcount =
FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
dpyinfo_refcount = dpyinfo->reference_count;
@@ -4739,7 +4725,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
unsigned long mask;
Atom type = FRAME_X_DISPLAY_INFO (f)->Xatom_net_window_type_tooltip;
- BLOCK_INPUT;
+ block_input ();
mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
if (DoesSaveUnders (dpyinfo->screen))
mask |= CWSaveUnder;
@@ -4766,7 +4752,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
FRAME_X_DISPLAY_INFO (f)->Xatom_net_window_type,
XA_ATOM, 32, PropModeReplace,
(unsigned char *)&type, 1);
- UNBLOCK_INPUT;
+ unblock_input ();
}
x_make_gc (f);
@@ -4880,10 +4866,10 @@ compute_tip_xy (struct frame *f, Lisp_Object parms, Lisp_Object dx, Lisp_Object
show it. */
if (!INTEGERP (left) || !INTEGERP (top))
{
- BLOCK_INPUT;
+ block_input ();
XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
&root, &child, root_x, root_y, &win_x, &win_y, &pmask);
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (INTEGERP (top))
@@ -4952,7 +4938,7 @@ Text larger than the specified size is clipped. */)
int i, width, height, seen_reversed_p;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_redisplay, Qt);
@@ -4981,20 +4967,21 @@ Text larger than the specified size is clipped. */)
#ifdef USE_GTK
if (x_gtk_use_system_tooltips)
{
- int ok;
+ bool ok;
/* Hide a previous tip, if any. */
Fx_hide_tip ();
- BLOCK_INPUT;
- if ((ok = xg_prepare_tooltip (f, string, &width, &height)) != 0)
+ block_input ();
+ ok = xg_prepare_tooltip (f, string, &width, &height);
+ if (ok)
{
compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
xg_show_tooltip (f, root_x, root_y);
/* This is used in Fx_hide_tip. */
XSETFRAME (tip_frame, f);
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (ok) goto start_timer;
}
#endif /* USE_GTK */
@@ -5022,12 +5009,12 @@ Text larger than the specified size is clipped. */)
call1 (Qcancel_timer, timer);
}
- BLOCK_INPUT;
+ block_input ();
compute_tip_xy (tip_f, parms, dx, dy, FRAME_PIXEL_WIDTH (tip_f),
FRAME_PIXEL_HEIGHT (tip_f), &root_x, &root_y);
XMoveWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f),
root_x, root_y);
- UNBLOCK_INPUT;
+ unblock_input ();
goto start_timer;
}
}
@@ -5059,21 +5046,20 @@ Text larger than the specified size is clipped. */)
/* Set up the frame's root window. */
w = XWINDOW (FRAME_ROOT_WINDOW (f));
- w->left_col = w->top_line = make_number (0);
+ wset_left_col (w, make_number (0));
+ wset_top_line (w, make_number (0));
if (CONSP (Vx_max_tooltip_size)
- && INTEGERP (XCAR (Vx_max_tooltip_size))
- && XINT (XCAR (Vx_max_tooltip_size)) > 0
- && INTEGERP (XCDR (Vx_max_tooltip_size))
- && XINT (XCDR (Vx_max_tooltip_size)) > 0)
+ && RANGED_INTEGERP (1, XCAR (Vx_max_tooltip_size), INT_MAX)
+ && RANGED_INTEGERP (1, XCDR (Vx_max_tooltip_size), INT_MAX))
{
- w->total_cols = XCAR (Vx_max_tooltip_size);
- w->total_lines = XCDR (Vx_max_tooltip_size);
+ wset_total_cols (w, XCAR (Vx_max_tooltip_size));
+ wset_total_lines (w, XCDR (Vx_max_tooltip_size));
}
else
{
- w->total_cols = make_number (80);
- w->total_lines = make_number (40);
+ wset_total_cols (w, make_number (80));
+ wset_total_lines (w, make_number (40));
}
FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
@@ -5083,7 +5069,7 @@ Text larger than the specified size is clipped. */)
/* Display the tooltip text in a temporary buffer. */
old_buffer = current_buffer;
set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
- BVAR (current_buffer, truncate_lines) = Qnil;
+ bset_truncate_lines (current_buffer, Qnil);
clear_glyph_matrix (w->desired_matrix);
clear_glyph_matrix (w->current_matrix);
SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
@@ -5143,7 +5129,7 @@ Text larger than the specified size is clipped. */)
/* w->total_cols and FRAME_TOTAL_COLS want the width in columns,
not in pixels. */
width /= WINDOW_FRAME_COLUMN_WIDTH (w);
- w->total_cols = make_number (width);
+ wset_total_cols (w, make_number (width));
FRAME_TOTAL_COLS (f) = width;
adjust_glyphs (f);
clear_glyph_matrix (w->desired_matrix);
@@ -5182,11 +5168,11 @@ Text larger than the specified size is clipped. */)
show it. */
compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
- BLOCK_INPUT;
+ block_input ();
XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
root_x, root_y, width, height);
XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
- UNBLOCK_INPUT;
+ unblock_input ();
/* Draw into the window. */
w->must_be_updated_p = 1;
@@ -5211,7 +5197,7 @@ DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
Value is t if tooltip was open, nil otherwise. */)
(void)
{
- int count;
+ ptrdiff_t count;
Lisp_Object deleted, frame, timer;
struct gcpro gcpro1, gcpro2;
@@ -5258,9 +5244,9 @@ Value is t if tooltip was open, nil otherwise. */)
if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
&& w != NULL)
{
- BLOCK_INPUT;
+ block_input ();
xlwmenu_redisplay (w);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
#endif /* USE_LUCID */
@@ -5324,11 +5310,11 @@ clean_up_file_dialog (Lisp_Object arg)
Widget dialog = (Widget) p->pointer;
/* Clean up. */
- BLOCK_INPUT;
+ block_input ();
XtUnmanageChild (dialog);
XtDestroyWidget (dialog);
x_menu_set_in_use (0);
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
@@ -5340,7 +5326,7 @@ 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 MS Windows, and X Windows with the
+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. */)
(Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object only_dir_p)
@@ -5353,7 +5339,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
Arg al[10];
int ac = 0;
XmString dir_xmstring, pattern_xmstring;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
check_x ();
@@ -5369,12 +5355,12 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
/* Prevent redisplay. */
specbind (Qinhibit_redisplay, Qt);
- BLOCK_INPUT;
+ block_input ();
/* Create the dialog with PROMPT as title, using DIR as initial
directory and using "*" as pattern. */
dir = Fexpand_file_name (dir, Qnil);
- dir_xmstring = XmStringCreateLocalized (SDATA (dir));
+ dir_xmstring = XmStringCreateLocalized (SSDATA (dir));
pattern_xmstring = XmStringCreateLocalized ("*");
XtSetArg (al[ac], XmNtitle, SDATA (prompt)); ++ac;
@@ -5427,12 +5413,12 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
XmTextPosition last_pos = XmTextFieldGetLastPosition (wtext);
XmTextFieldReplace (wtext, 0, last_pos,
- (SDATA (Ffile_name_nondirectory (default_filename))));
+ (SSDATA (Ffile_name_nondirectory (default_filename))));
/* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
must include the path for this to work. */
- default_xmstring = XmStringCreateLocalized (SDATA (default_filename));
+ default_xmstring = XmStringCreateLocalized (SSDATA (default_filename));
if (XmListItemExists (list, default_xmstring))
{
@@ -5483,7 +5469,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
else
file = Qnil;
- UNBLOCK_INPUT;
+ unblock_input ();
UNGCPRO;
/* Make "Cancel" equivalent to C-g. */
@@ -5513,7 +5499,7 @@ 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 MS Windows, and X Windows with the
+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. */)
(Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object only_dir_p)
@@ -5522,7 +5508,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
char *fn;
Lisp_Object file = Qnil;
Lisp_Object decoded_file;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
char *cdef_file;
@@ -5540,7 +5526,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
specbind (Qinhibit_redisplay, Qt);
record_unwind_protect (clean_up_dialog, Qnil);
- BLOCK_INPUT;
+ block_input ();
if (STRINGP (default_filename))
cdef_file = SSDATA (default_filename);
@@ -5557,7 +5543,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
xfree (fn);
}
- UNBLOCK_INPUT;
+ unblock_input ();
UNGCPRO;
/* Make "Cancel" equivalent to C-g. */
@@ -5573,19 +5559,20 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
#ifdef HAVE_FREETYPE
DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0,
- doc: /* Read a font name using a GTK font selection dialog.
-Return a GTK-style font string corresponding to the selection.
+ doc: /* Read a font using a GTK dialog.
+Return either a font spec (for GTK versions >= 3.2) or a string
+containing a GTK-style font name.
-If FRAME is omitted or nil, it defaults to the selected frame. */)
+FRAME is the frame on which to pop up the font chooser. If omitted or
+nil, it defaults to the selected frame. */)
(Lisp_Object frame, Lisp_Object ignored)
{
FRAME_PTR f = check_x_frame (frame);
- char *name;
Lisp_Object font;
Lisp_Object font_param;
char *default_name = NULL;
struct gcpro gcpro1, gcpro2;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
check_x ();
@@ -5596,7 +5583,7 @@ If FRAME is omitted or nil, it defaults to the selected frame. */)
specbind (Qinhibit_redisplay, Qt);
record_unwind_protect (clean_up_dialog, Qnil);
- BLOCK_INPUT;
+ block_input ();
GCPRO2 (font_param, font);
@@ -5611,33 +5598,10 @@ If FRAME is omitted or nil, it defaults to the selected frame. */)
default_name = xstrdup (SSDATA (font_param));
}
- if (default_name == NULL && x_last_font_name != NULL)
- default_name = xstrdup (x_last_font_name);
-
- /* Convert fontconfig names to Gtk names, i.e. remove - before number */
- if (default_name)
- {
- char *p = strrchr (default_name, '-');
- if (p)
- {
- char *ep = p+1;
- while (isdigit (*ep))
- ++ep;
- if (*ep == '\0') *p = ' ';
- }
- }
-
- name = xg_get_font_name (f, default_name);
+ font = xg_get_font (f, default_name);
xfree (default_name);
- if (name)
- {
- font = build_string (name);
- g_free (x_last_font_name);
- x_last_font_name = name;
- }
-
- UNBLOCK_INPUT;
+ unblock_input ();
if (NILP (font))
Fsignal (Qquit, Qnil);
@@ -5674,14 +5638,14 @@ present and mapped to the usual X keysyms. */)
Lisp_Object have_keys;
int major, minor, op, event, error_code;
- BLOCK_INPUT;
+ block_input ();
/* Check library version in case we're dynamically linked. */
major = XkbMajorVersion;
minor = XkbMinorVersion;
if (!XkbLibraryVersion (&major, &minor))
{
- UNBLOCK_INPUT;
+ unblock_input ();
return Qlambda;
}
@@ -5690,7 +5654,7 @@ present and mapped to the usual X keysyms. */)
minor = XkbMinorVersion;
if (!XkbQueryExtension (dpy, &op, &event, &error_code, &major, &minor))
{
- UNBLOCK_INPUT;
+ unblock_input ();
return Qlambda;
}
@@ -5743,7 +5707,7 @@ present and mapped to the usual X keysyms. */)
&& XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
have_keys = Qt;
}
- UNBLOCK_INPUT;
+ unblock_input ();
return have_keys;
#else /* not HAVE_XKBGETKEYBOARD */
return Qlambda;
@@ -5805,7 +5769,6 @@ syms_of_xfns (void)
/* The section below is built by the lisp expression at the top of the file,
just above where these variables are declared. */
/*&&& init symbols here &&&*/
- DEFSYM (Qnone, "none");
DEFSYM (Qsuppress_icon, "suppress-icon");
DEFSYM (Qundefined_color, "undefined-color");
DEFSYM (Qcompound_text, "compound-text");
@@ -5814,9 +5777,9 @@ syms_of_xfns (void)
/* This is the end of symbol initialization. */
Fput (Qundefined_color, Qerror_conditions,
- pure_cons (Qundefined_color, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror));
Fput (Qundefined_color, Qerror_message,
- make_pure_c_string ("Undefined color"));
+ build_pure_c_string ("Undefined color"));
DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape,
doc: /* The shape of the pointer when over text.
@@ -5889,32 +5852,32 @@ Chinese, Japanese, and Korean. */);
/* This is not ifdef:ed, so other builds than GTK can customize it. */
DEFVAR_BOOL ("x-gtk-use-old-file-dialog", x_gtk_use_old_file_dialog,
- doc: /* *Non-nil means prompt with the old GTK file selection dialog.
+ doc: /* Non-nil means prompt with the old GTK file selection dialog.
If nil or if the file selection dialog is not available, the new GTK file
chooser is used instead. To turn off all file dialogs set the
variable `use-file-dialog'. */);
x_gtk_use_old_file_dialog = 0;
DEFVAR_BOOL ("x-gtk-show-hidden-files", x_gtk_show_hidden_files,
- doc: /* *If non-nil, the GTK file chooser will by default show hidden files.
+ doc: /* If non-nil, the GTK file chooser will by default show hidden files.
Note that this is just the default, there is a toggle button on the file
chooser to show or not show hidden files on a case by case basis. */);
x_gtk_show_hidden_files = 0;
DEFVAR_BOOL ("x-gtk-file-dialog-help-text", x_gtk_file_dialog_help_text,
- doc: /* *If non-nil, the GTK file chooser will show additional help text.
+ doc: /* If non-nil, the GTK file chooser will show additional help text.
If more space for files in the file chooser dialog is wanted, set this to nil
to turn the additional text off. */);
x_gtk_file_dialog_help_text = 1;
DEFVAR_BOOL ("x-gtk-whole-detached-tool-bar", x_gtk_whole_detached_tool_bar,
- doc: /* *If non-nil, a detached tool bar is shown in full.
+ doc: /* If non-nil, a detached tool bar is shown in full.
The default is to just show an arrow and pressing on that arrow shows
the tool bar buttons. */);
x_gtk_whole_detached_tool_bar = 0;
DEFVAR_BOOL ("x-gtk-use-system-tooltips", x_gtk_use_system_tooltips,
- doc: /* *If non-nil with a Gtk+ built Emacs, the Gtk+ tooltip is used.
+ doc: /* If non-nil with a Gtk+ built Emacs, the Gtk+ tooltip is used.
Otherwise use Emacs own tooltip implementation.
When using Gtk+ tooltips, the tooltip face is not used. */);
x_gtk_use_system_tooltips = 1;
@@ -5944,10 +5907,10 @@ When using Gtk+ tooltips, the tooltip face is not used. */);
DEFVAR_LISP ("gtk-version-string", Vgtk_version_string,
doc: /* Version info for GTK+. */);
{
- char gtk_version[40];
- g_snprintf (gtk_version, sizeof (gtk_version), "%u.%u.%u",
- GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
- Vgtk_version_string = make_pure_string (gtk_version, strlen (gtk_version), strlen (gtk_version), 0);
+ char gtk_version[sizeof ".." + 3 * INT_STRLEN_BOUND (int)];
+ int len = sprintf (gtk_version, "%d.%d.%d",
+ GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
+ Vgtk_version_string = make_pure_string (gtk_version, len, len, 0);
}
#endif /* USE_GTK */
@@ -6002,7 +5965,6 @@ When using Gtk+ tooltips, the tooltip face is not used. */);
#if defined (USE_GTK) && defined (HAVE_FREETYPE)
defsubr (&Sx_select_font);
- x_last_font_name = NULL;
#endif
}
diff --git a/src/xfont.c b/src/xfont.c
index 60e5aa6e98e..2d493088b0b 100644
--- a/src/xfont.c
+++ b/src/xfont.c
@@ -1,5 +1,5 @@
/* xfont.c -- X core font driver.
- Copyright (C) 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 2006-2012 Free Software Foundation, Inc.
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
@@ -21,7 +21,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include <X11/Xlib.h>
#include "lisp.h"
@@ -46,7 +45,6 @@ struct xfont_info
};
/* Prototypes of support functions. */
-extern void x_clear_errors (Display *);
static XCharStruct *xfont_get_pcm (XFontStruct *, XChar2b *);
@@ -59,7 +57,7 @@ xfont_get_pcm (XFontStruct *xfont, XChar2b *char2b)
/* The result metric information. */
XCharStruct *pcm = NULL;
- font_assert (xfont && char2b);
+ eassert (xfont && char2b);
if (xfont->per_char != NULL)
{
@@ -127,12 +125,12 @@ static int xfont_has_char (Lisp_Object, int);
static unsigned xfont_encode_char (struct font *, int);
static int xfont_text_extents (struct font *, unsigned *, int,
struct font_metrics *);
-static int xfont_draw (struct glyph_string *, int, int, int, int, int);
+static int xfont_draw (struct glyph_string *, int, int, int, int, bool);
static int xfont_check (FRAME_PTR, struct font *);
struct font_driver xfont_driver =
{
- 0, /* Qx */
+ LISP_INITIALLY_ZERO, /* Qx */
0, /* case insensitive */
xfont_get_cache,
xfont_list,
@@ -164,8 +162,9 @@ xfont_get_cache (FRAME_PTR f)
static int
compare_font_names (const void *name1, const void *name2)
{
- return xstrcasecmp (*(const char **) name1,
- *(const char **) name2);
+ char *const *n1 = name1;
+ char *const *n2 = name2;
+ return xstrcasecmp (*n1, *n2);
}
/* Decode XLFD as iso-8859-1 into OUTPUT, and return the byte length
@@ -173,7 +172,7 @@ compare_font_names (const void *name1, const void *name2)
XLFD is NULL terminated. The caller must assure that OUTPUT is at
least twice (plus 1) as large as XLFD. */
-static int
+static ptrdiff_t
xfont_decode_coding_xlfd (char *xlfd, int len, char *output)
{
char *p0 = xlfd, *p1 = output;
@@ -217,9 +216,9 @@ xfont_encode_coding_xlfd (char *xlfd)
/* Check if CHARS (cons or vector) is supported by XFONT whose
encoding charset is ENCODING (XFONT is NULL) or by a font whose
registry corresponds to ENCODING and REPERTORY.
- Return 1 if supported, return 0 otherwise. */
+ Return true if supported. */
-static int
+static bool
xfont_chars_supported (Lisp_Object chars, XFontStruct *xfont,
struct charset *encoding, struct charset *repertory)
{
@@ -248,7 +247,7 @@ xfont_chars_supported (Lisp_Object chars, XFontStruct *xfont,
}
else if (VECTORP (chars))
{
- int i;
+ ptrdiff_t i;
for (i = ASIZE (chars) - 1; i >= 0; i--)
{
@@ -363,7 +362,7 @@ xfont_list_pattern (Display *display, const char *pattern,
}
}
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (display);
for (limit = 512; ; limit *= 2)
@@ -389,20 +388,21 @@ xfont_list_pattern (Display *display, const char *pattern,
Lisp_Object scripts = Qnil;
for (i = 0; i < ASIZE (xfont_scratch_props); i++)
- props[i] = Qnil;
+ ASET (xfont_scratch_props, i, Qnil);
for (i = 0; i < num_fonts; i++)
indices[i] = names[i];
qsort (indices, num_fonts, sizeof (char *), compare_font_names);
for (i = 0; i < num_fonts; i++)
{
+ ptrdiff_t len;
Lisp_Object entity;
if (i > 0 && xstrcasecmp (indices[i - 1], indices[i]) == 0)
continue;
entity = font_make_entity ();
- xfont_decode_coding_xlfd (indices[i], -1, buf);
- if (font_parse_xlfd (buf, entity) < 0)
+ len = xfont_decode_coding_xlfd (indices[i], -1, buf);
+ if (font_parse_xlfd (buf, len, entity) < 0)
continue;
ASET (entity, FONT_TYPE_INDEX, Qx);
/* Avoid auto-scaled fonts. */
@@ -432,7 +432,8 @@ xfont_list_pattern (Display *display, const char *pattern,
{
elt = XCAR (tail);
if (STRINGP (elt)
- && fast_c_string_match_ignore_case (elt, indices[i]) >= 0)
+ && fast_c_string_match_ignore_case (elt, indices[i],
+ len) >= 0)
break;
}
if (! CONSP (tail))
@@ -460,13 +461,13 @@ xfont_list_pattern (Display *display, const char *pattern,
list = Fcons (entity, list);
continue;
}
- if (memcmp (props, &(AREF (entity, FONT_FOUNDRY_INDEX)),
- sizeof (Lisp_Object) * 7)
+ if (memcmp (props, aref_addr (entity, FONT_FOUNDRY_INDEX),
+ word_size * 7)
|| ! EQ (AREF (entity, FONT_SPACING_INDEX), props[7]))
{
- memcpy (props, &(AREF (entity, FONT_FOUNDRY_INDEX)),
- sizeof (Lisp_Object) * 7);
- props[7] = AREF (entity, FONT_SPACING_INDEX);
+ vcopy (xfont_scratch_props, 0,
+ aref_addr (entity, FONT_FOUNDRY_INDEX), 7);
+ ASET (xfont_scratch_props, 7, AREF (entity, FONT_SPACING_INDEX));
scripts = xfont_supported_scripts (display, indices[i],
xfont_scratch_props, encoding);
}
@@ -478,7 +479,7 @@ xfont_list_pattern (Display *display, const char *pattern,
}
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
FONT_ADD_LOG ("xfont-list", build_string (pattern), list);
return list;
@@ -587,7 +588,7 @@ xfont_match (Lisp_Object frame, Lisp_Object spec)
if (xfont_encode_coding_xlfd (name) < 0)
return Qnil;
- BLOCK_INPUT;
+ block_input ();
entity = Qnil;
xfont = XLoadQueryFont (display, name);
if (xfont)
@@ -603,17 +604,18 @@ xfont_match (Lisp_Object frame, Lisp_Object spec)
string. We must avoid such a name. */
if (*s)
{
+ ptrdiff_t len;
entity = font_make_entity ();
ASET (entity, FONT_TYPE_INDEX, Qx);
- xfont_decode_coding_xlfd (s, -1, name);
- if (font_parse_xlfd (name, entity) < 0)
+ len = xfont_decode_coding_xlfd (s, -1, name);
+ if (font_parse_xlfd (name, len, entity) < 0)
entity = Qnil;
}
XFree (s);
}
XFreeFont (display, xfont);
}
- UNBLOCK_INPUT;
+ unblock_input ();
FONT_ADD_LOG ("xfont-match", spec, entity);
return entity;
@@ -630,7 +632,7 @@ xfont_list_family (Lisp_Object frame)
char *last_family IF_LINT (= 0);
int last_len;
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (dpyinfo->display);
names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
0x8000, &num_fonts);
@@ -671,7 +673,7 @@ xfont_list_family (Lisp_Object frame)
XFreeFontNames (names);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return list;
}
@@ -715,7 +717,7 @@ xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
return Qnil;
}
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (display);
xfont = XLoadQueryFont (display, name);
if (x_had_errors_p (display))
@@ -782,7 +784,7 @@ xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
XFree (p0);
}
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
if (! xfont)
{
@@ -795,7 +797,7 @@ xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
ASET (font_object, FONT_TYPE_INDEX, Qx);
if (STRINGP (fullname))
{
- font_parse_xlfd (SSDATA (fullname), font_object);
+ font_parse_xlfd (SSDATA (fullname), SBYTES (fullname), font_object);
ASET (font_object, FONT_NAME_INDEX, fullname);
}
else
@@ -819,6 +821,7 @@ xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
font->descent = xfont->descent;
font->height = font->ascent + font->descent;
font->min_width = xfont->min_bounds.width;
+ font->max_width = xfont->max_bounds.width;
if (xfont->min_bounds.width == xfont->max_bounds.width)
{
/* Fixed width font. */
@@ -863,7 +866,7 @@ xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
}
}
- BLOCK_INPUT;
+ block_input ();
font->underline_thickness
= (XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &value)
? (long) value : 0);
@@ -879,7 +882,7 @@ xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
font->default_ascent
= (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value)
? (long) value : 0);
- UNBLOCK_INPUT;
+ unblock_input ();
if (NILP (fullname))
fullname = AREF (font_object, FONT_NAME_INDEX);
@@ -894,18 +897,18 @@ xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
static void
xfont_close (FRAME_PTR f, struct font *font)
{
- BLOCK_INPUT;
+ block_input ();
XFreeFont (FRAME_X_DISPLAY (f), ((struct xfont_info *) font)->xfont);
- UNBLOCK_INPUT;
+ unblock_input ();
}
static int
xfont_prepare_face (FRAME_PTR f, struct face *face)
{
- BLOCK_INPUT;
+ block_input ();
XSetFont (FRAME_X_DISPLAY (f), face->gc,
((struct xfont_info *) face->font)->xfont->fid);
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
@@ -1015,7 +1018,8 @@ xfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct f
}
static int
-xfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_background)
+xfont_draw (struct glyph_string *s, int from, int to, int x, int y,
+ bool with_background)
{
XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
int len = to - from;
@@ -1024,21 +1028,19 @@ xfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_bac
if (s->gc != s->face->gc)
{
- BLOCK_INPUT;
+ block_input ();
XSetFont (s->display, gc, xfont->fid);
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
{
- char *str;
USE_SAFE_ALLOCA;
-
- SAFE_ALLOCA (str, char *, len);
+ char *str = SAFE_ALLOCA (len);
for (i = 0; i < len ; i++)
str[i] = XCHAR2B_BYTE2 (s->char2b + from + i);
- BLOCK_INPUT;
- if (with_background > 0)
+ block_input ();
+ if (with_background)
{
if (s->padding_p)
for (i = 0; i < len; i++)
@@ -1058,13 +1060,13 @@ xfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_bac
XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
gc, x, y, str, len);
}
- UNBLOCK_INPUT;
+ unblock_input ();
SAFE_FREE ();
return s->nchars;
}
- BLOCK_INPUT;
- if (with_background > 0)
+ block_input ();
+ if (with_background)
{
if (s->padding_p)
for (i = 0; i < len; i++)
@@ -1084,7 +1086,7 @@ xfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_bac
XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
gc, x, y, s->char2b + from, len);
}
- UNBLOCK_INPUT;
+ unblock_input ();
return len;
}
diff --git a/src/xftfont.c b/src/xftfont.c
index 8cb4c494854..181a1da9b38 100644
--- a/src/xftfont.c
+++ b/src/xftfont.c
@@ -1,5 +1,5 @@
/* xftfont.c -- XFT font driver.
- Copyright (C) 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 2006-2012 Free Software Foundation, Inc.
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
@@ -21,7 +21,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include <X11/Xlib.h>
#include <X11/Xft/Xft.h>
@@ -39,7 +38,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Xft font driver. */
-static Lisp_Object Qxft;
+Lisp_Object Qxft;
static Lisp_Object QChinting, QCautohint, QChintstyle, QCrgba, QCembolden,
QClcdfilter;
@@ -52,7 +51,7 @@ struct xftfont_info
/* The following five members must be here in this order to be
compatible with struct ftfont_info (in ftfont.c). */
#ifdef HAVE_LIBOTF
- int maybe_otf; /* Flag to tell if this may be OTF or not. */
+ bool maybe_otf; /* Flag to tell if this may be OTF or not. */
OTF *otf;
#endif /* HAVE_LIBOTF */
FT_Size ft_size;
@@ -92,9 +91,9 @@ xftfont_get_colors (FRAME_PTR f, struct face *face, GC gc, struct xftface_info *
else
{
XGCValues xgcv;
- int fg_done = 0, bg_done = 0;
+ bool fg_done = 0, bg_done = 0;
- BLOCK_INPUT;
+ block_input ();
XGetGCValues (FRAME_X_DISPLAY (f), gc,
GCForeground | GCBackground, &xgcv);
if (xftface_info)
@@ -111,7 +110,7 @@ xftfont_get_colors (FRAME_PTR f, struct face *face, GC gc, struct xftface_info *
*bg = xftface_info->xft_fg, bg_done = 1;
}
- if (fg_done + bg_done < 2)
+ if (! (fg_done & bg_done))
{
XColor colors[2];
@@ -132,24 +131,11 @@ xftfont_get_colors (FRAME_PTR f, struct face *face, GC gc, struct xftface_info *
bg->color.blue = colors[1].blue;
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
-static Lisp_Object xftfont_list (Lisp_Object, Lisp_Object);
-static Lisp_Object xftfont_match (Lisp_Object, Lisp_Object);
-static Lisp_Object xftfont_open (FRAME_PTR, Lisp_Object, int);
-static void xftfont_close (FRAME_PTR, struct font *);
-static int xftfont_prepare_face (FRAME_PTR, struct face *);
-static void xftfont_done_face (FRAME_PTR, struct face *);
-static int xftfont_has_char (Lisp_Object, int);
-static unsigned xftfont_encode_char (struct font *, int);
-static int xftfont_text_extents (struct font *, unsigned *, int,
- struct font_metrics *);
-static int xftfont_draw (struct glyph_string *, int, int, int, int, int);
-static int xftfont_end_for_frame (FRAME_PTR f);
-
struct font_driver xftfont_driver;
static Lisp_Object
@@ -338,7 +324,7 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
FcPatternAddInteger (pat, FC_INDEX, XINT (idx));
- BLOCK_INPUT;
+ block_input ();
/* Make sure that the Xrender extension is added before the Xft one.
Otherwise, the close-display hook set by Xft is called after the
one for Xrender, and the former tries to re-add the latter. This
@@ -359,12 +345,12 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
xftfont = XftFontOpenPattern (display, match);
if (!xftfont)
{
- UNBLOCK_INPUT;
+ unblock_input ();
XftPatternDestroy (match);
return Qnil;
}
ft_face = XftLockFace (xftfont);
- UNBLOCK_INPUT;
+ unblock_input ();
/* We should not destroy PAT here because it is kept in XFTFONT and
destroyed automatically when XFTFONT is closed. */
@@ -383,7 +369,7 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
ASET (font_object, FONT_FORMAT_INDEX,
ftfont_font_format (xftfont->pattern, filename));
font = XFONT_OBJECT (font_object);
- font->pixel_size = pixel_size;
+ font->pixel_size = size;
font->driver = &xftfont_driver;
font->encoding_charset = font->repertory_charset = -1;
@@ -401,8 +387,6 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
xftfont_info->matrix.xy = 0x10000L * matrix->xy;
xftfont_info->matrix.yx = 0x10000L * matrix->yx;
}
- font->pixel_size = size;
- font->driver = &xftfont_driver;
if (INTEGERP (AREF (entity, FONT_SPACING_INDEX)))
spacing = XINT (AREF (entity, FONT_SPACING_INDEX));
else
@@ -413,28 +397,33 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
for (ch = 0; ch < 95; ch++)
ascii_printable[ch] = ' ' + ch;
}
- BLOCK_INPUT;
+ block_input ();
+
+ /* Unfortunately Xft doesn't provide a way to get minimum char
+ width. So, we set min_width to space_width. */
+
if (spacing != FC_PROPORTIONAL
#ifdef FC_DUAL
&& spacing != FC_DUAL
#endif /* FC_DUAL */
)
{
- font->min_width = font->average_width = font->space_width
- = xftfont->max_advance_width;
+ font->min_width = font->max_width = font->average_width
+ = font->space_width = xftfont->max_advance_width;
XftTextExtents8 (display, xftfont, ascii_printable + 1, 94, &extents);
}
else
{
XftTextExtents8 (display, xftfont, ascii_printable, 1, &extents);
- font->space_width = extents.xOff;
+ font->min_width = font->max_width = font->space_width
+ = extents.xOff;
if (font->space_width <= 0)
/* dirty workaround */
font->space_width = pixel_size;
XftTextExtents8 (display, xftfont, ascii_printable + 1, 94, &extents);
font->average_width = (font->space_width + extents.xOff) / 95;
}
- UNBLOCK_INPUT;
+ unblock_input ();
font->ascent = xftfont->ascent;
font->descent = xftfont->descent;
@@ -465,15 +454,11 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
font->underline_thickness = 0;
}
#ifdef HAVE_LIBOTF
- xftfont_info->maybe_otf = ft_face->face_flags & FT_FACE_FLAG_SFNT;
+ xftfont_info->maybe_otf = (ft_face->face_flags & FT_FACE_FLAG_SFNT) != 0;
xftfont_info->otf = NULL;
#endif /* HAVE_LIBOTF */
xftfont_info->ft_size = ft_face->size;
- /* Unfortunately Xft doesn't provide a way to get minimum char
- width. So, we use space_width instead. */
- font->min_width = font->space_width;
-
font->baseline_offset = 0;
font->relative_compose = 0;
font->default_ascent = 0;
@@ -507,10 +492,10 @@ xftfont_close (FRAME_PTR f, struct font *font)
if (xftfont_info->otf)
OTF_close (xftfont_info->otf);
#endif
- BLOCK_INPUT;
+ block_input ();
XftUnlockFace (xftfont_info->xftfont);
XftFontClose (xftfont_info->display, xftfont_info->xftfont);
- UNBLOCK_INPUT;
+ unblock_input ();
}
static int
@@ -527,7 +512,7 @@ xftfont_prepare_face (FRAME_PTR f, struct face *face)
}
#endif
- xftface_info = malloc (sizeof (struct xftface_info));
+ xftface_info = malloc (sizeof *xftface_info);
if (! xftface_info)
return -1;
xftfont_get_colors (f, face, face->gc, NULL,
@@ -594,10 +579,10 @@ xftfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct
struct xftfont_info *xftfont_info = (struct xftfont_info *) font;
XGlyphInfo extents;
- BLOCK_INPUT;
+ block_input ();
XftGlyphExtents (xftfont_info->display, xftfont_info->xftfont, code, nglyphs,
&extents);
- UNBLOCK_INPUT;
+ unblock_input ();
if (metrics)
{
metrics->lbearing = - extents.x;
@@ -616,21 +601,21 @@ xftfont_get_xft_draw (FRAME_PTR f)
if (! xft_draw)
{
- BLOCK_INPUT;
+ block_input ();
xft_draw= XftDrawCreate (FRAME_X_DISPLAY (f),
FRAME_X_WINDOW (f),
FRAME_X_VISUAL (f),
FRAME_X_COLORMAP (f));
- UNBLOCK_INPUT;
- if (! xft_draw)
- abort ();
+ unblock_input ();
+ eassert (xft_draw != NULL);
font_put_frame_data (f, &xftfont_driver, xft_draw);
}
return xft_draw;
}
static int
-xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_background)
+xftfont_draw (struct glyph_string *s, int from, int to, int x, int y,
+ bool with_background)
{
FRAME_PTR f = s->f;
struct face *face = s->face;
@@ -646,7 +631,7 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_b
xftface_info = (struct xftface_info *) face->extra;
xftfont_get_colors (f, face, s->gc, xftface_info,
&fg, with_background ? &bg : NULL);
- BLOCK_INPUT;
+ block_input ();
if (s->num_clips > 0)
XftDrawSetClipRectangles (xft_draw, 0, 0, s->clip, s->num_clips);
else
@@ -667,7 +652,7 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_b
else
XftDrawGlyphs (xft_draw, &fg, xftfont_info->xftfont,
x, y, code, len);
- UNBLOCK_INPUT;
+ unblock_input ();
return len;
}
@@ -703,23 +688,25 @@ xftfont_end_for_frame (FRAME_PTR f)
if (xft_draw)
{
- BLOCK_INPUT;
+ block_input ();
XftDrawDestroy (xft_draw);
- UNBLOCK_INPUT;
+ unblock_input ();
font_put_frame_data (f, &xftfont_driver, NULL);
}
return 0;
}
-static int
-xftfont_cached_font_ok (struct frame *f, Lisp_Object font_object, Lisp_Object entity)
+static bool
+xftfont_cached_font_ok (struct frame *f, Lisp_Object font_object,
+ Lisp_Object entity)
{
struct xftfont_info *info = (struct xftfont_info *) XFONT_OBJECT (font_object);
FcPattern *oldpat = info->xftfont->pattern;
Display *display = FRAME_X_DISPLAY (f);
FcPattern *pat = FcPatternCreate ();
FcBool b1, b2;
- int ok = 0, i1, i2, r1, r2;
+ bool ok = 0;
+ int i1, i2, r1, r2;
xftfont_add_rendering_parameters (pat, entity);
XftDefaultSubstitute (display, FRAME_X_SCREEN_NUMBER (f), pat);
@@ -765,6 +752,8 @@ syms_of_xftfont (void)
DEFSYM (QCembolden, ":embolden");
DEFSYM (QClcdfilter, ":lcdfilter");
+ ascii_printable[0] = 0;
+
xftfont_driver = ftfont_driver;
xftfont_driver.type = Qxft;
xftfont_driver.get_cache = xfont_driver.get_cache;
diff --git a/src/xgselect.c b/src/xgselect.c
index 339ec475117..c161564a322 100644
--- a/src/xgselect.c
+++ b/src/xgselect.c
@@ -1,6 +1,6 @@
/* Function for handling the GLib event loop.
-Copyright (C) 2009-2011 Free Software Foundation, Inc.
+Copyright (C) 2009-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,52 +19,48 @@ along with GNU Emacs. If not, see <http§://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
#include "xgselect.h"
#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
#include <glib.h>
#include <errno.h>
-#include <setjmp.h>
-
-static GPollFD *gfds;
-static ptrdiff_t gfds_size;
+#include "xterm.h"
int
-xg_select (int max_fds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
- EMACS_TIME *timeout)
+xg_select (int fds_lim, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
+ EMACS_TIME *timeout, sigset_t *sigmask)
{
SELECT_TYPE all_rfds, all_wfds;
EMACS_TIME tmo, *tmop = timeout;
- GMainContext *context = g_main_context_default ();
+ GMainContext *context;
int have_wfds = wfds != NULL;
- int n_gfds = 0, our_tmo = 0, retval = 0, our_fds = 0;
+ GPollFD gfds_buf[128];
+ GPollFD *gfds = gfds_buf;
+ int gfds_size = sizeof gfds_buf / sizeof *gfds_buf;
+ int n_gfds, retval = 0, our_fds = 0, max_fds = fds_lim - 1;
int i, nfds, tmo_in_millisec;
+ USE_SAFE_ALLOCA;
+
+ if (! (x_in_use
+ && g_main_context_pending (context = g_main_context_default ())))
+ return pselect (fds_lim, rfds, wfds, efds, timeout, sigmask);
- if (rfds) memcpy (&all_rfds, rfds, sizeof (all_rfds));
+ if (rfds) all_rfds = *rfds;
else FD_ZERO (&all_rfds);
- if (wfds) memcpy (&all_wfds, wfds, sizeof (all_rfds));
+ if (wfds) all_wfds = *wfds;
else FD_ZERO (&all_wfds);
- /* Update event sources in GLib. */
- g_main_context_pending (context);
-
- do {
- if (n_gfds > gfds_size)
- {
- xfree (gfds);
- gfds = xpalloc (0, &gfds_size, n_gfds - gfds_size, INT_MAX,
- sizeof *gfds);
- }
-
- n_gfds = g_main_context_query (context,
- G_PRIORITY_LOW,
- &tmo_in_millisec,
- gfds,
- gfds_size);
- } while (n_gfds > gfds_size);
+ n_gfds = g_main_context_query (context, G_PRIORITY_LOW, &tmo_in_millisec,
+ gfds, gfds_size);
+ if (gfds_size < n_gfds)
+ {
+ SAFE_NALLOCA (gfds, sizeof *gfds, n_gfds);
+ gfds_size = n_gfds;
+ n_gfds = g_main_context_query (context, G_PRIORITY_LOW, &tmo_in_millisec,
+ gfds, gfds_size);
+ }
for (i = 0; i < n_gfds; ++i)
{
@@ -81,30 +77,25 @@ xg_select (int max_fds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
}
}
+ SAFE_FREE ();
+
if (tmo_in_millisec >= 0)
{
- EMACS_SET_SECS_USECS (tmo, tmo_in_millisec/1000,
- 1000 * (tmo_in_millisec % 1000));
- if (!timeout) our_tmo = 1;
- else
- {
- EMACS_TIME difference;
-
- EMACS_SUB_TIME (difference, tmo, *timeout);
- if (EMACS_TIME_NEG_P (difference)) our_tmo = 1;
- }
-
- if (our_tmo) tmop = &tmo;
+ tmo = make_emacs_time (tmo_in_millisec / 1000,
+ 1000 * 1000 * (tmo_in_millisec % 1000));
+ if (!timeout || EMACS_TIME_LT (tmo, *timeout))
+ tmop = &tmo;
}
- nfds = select (max_fds+1, &all_rfds, have_wfds ? &all_wfds : NULL,
- efds, tmop);
+ fds_lim = max_fds + 1;
+ nfds = pselect (fds_lim, &all_rfds, have_wfds ? &all_wfds : NULL,
+ efds, tmop, sigmask);
if (nfds < 0)
retval = nfds;
else if (nfds > 0)
{
- for (i = 0; i < max_fds+1; ++i)
+ for (i = 0; i < fds_lim; ++i)
{
if (FD_ISSET (i, &all_rfds))
{
@@ -127,7 +118,7 @@ xg_select (int max_fds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
}
}
- if (our_fds > 0 || (nfds == 0 && our_tmo))
+ if (our_fds > 0 || (nfds == 0 && tmop == &tmo))
{
/* If Gtk+ is in use eventually gtk_main_iteration will be called,
@@ -149,12 +140,3 @@ xg_select (int max_fds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
return retval;
}
#endif /* USE_GTK || HAVE_GCONF || HAVE_GSETTINGS */
-
-void
-xgselect_initialize (void)
-{
-#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
- gfds_size = 128;
- gfds = xmalloc (sizeof (*gfds)*gfds_size);
-#endif
-}
diff --git a/src/xgselect.h b/src/xgselect.h
index 1d3a8508b9c..5509e23c5c0 100644
--- a/src/xgselect.h
+++ b/src/xgselect.h
@@ -1,6 +1,6 @@
/* Header for xg_select.
-Copyright (C) 2009-2011 Free Software Foundation, Inc.
+Copyright (C) 2009-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -28,9 +28,7 @@ extern int xg_select (int max_fds,
SELECT_TYPE *rfds,
SELECT_TYPE *wfds,
SELECT_TYPE *efds,
- EMACS_TIME *timeout);
-
-extern void xgselect_initialize (void);
+ EMACS_TIME *timeout,
+ sigset_t *sigmask);
#endif /* XGSELECT_H */
-
diff --git a/src/xmenu.c b/src/xmenu.c
index ba99b8ac1e3..b585df2125b 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -1,6 +1,6 @@
/* X Communication module for terminals which understand the X protocol.
-Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2011
+Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -32,13 +32,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#if 0 /* Why was this included? And without syssignal.h? */
-/* On 4.3 this loses if it comes after xterm.h. */
-#include <signal.h>
-#endif
-
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "keyboard.h"
@@ -47,6 +41,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "termhooks.h"
#include "window.h"
#include "blockinput.h"
+#include "character.h"
#include "buffer.h"
#include "charset.h"
#include "coding.h"
@@ -116,7 +111,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
static Lisp_Object Qdebug_on_next_call;
#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
-static Lisp_Object xdialog_show (FRAME_PTR, int, Lisp_Object, Lisp_Object,
+static Lisp_Object xdialog_show (FRAME_PTR, bool, Lisp_Object, Lisp_Object,
const char **);
#endif
@@ -137,11 +132,8 @@ menubar_id_to_frame (LWLIB_ID id)
Lisp_Object tail, frame;
FRAME_PTR f;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- frame = XCAR (tail);
- if (!FRAMEP (frame))
- continue;
f = XFRAME (frame);
if (!FRAME_WINDOW_P (f))
continue;
@@ -168,9 +160,9 @@ mouse_position_for_popup (FRAME_PTR f, int *x, int *y)
int dummy;
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
- BLOCK_INPUT;
+ block_input ();
XQueryPointer (FRAME_X_DISPLAY (f),
DefaultRootWindow (FRAME_X_DISPLAY (f)),
@@ -191,7 +183,7 @@ mouse_position_for_popup (FRAME_PTR f, int *x, int *y)
we don't care. */
(unsigned int *) &dummy);
- UNBLOCK_INPUT;
+ unblock_input ();
/* xmenu_show expects window coordinates, not root window
coordinates. Translate. */
@@ -257,13 +249,12 @@ for instance using the window manager, then this produces a quit and
}
else if (CONSP (position))
{
- Lisp_Object tem;
- tem = Fcar (position);
+ Lisp_Object tem = XCAR (position);
if (CONSP (tem))
- window = Fcar (Fcdr (position));
+ window = Fcar (XCDR (position));
else
{
- tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
+ tem = Fcar (XCDR (position)); /* EVENT_START (position) */
window = Fcar (tem); /* POSN_WINDOW (tem) */
}
}
@@ -318,7 +309,7 @@ for instance using the window manager, then this produces a quit and
Lisp_Object title;
const char *error_name;
Lisp_Object selection;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
/* Decode the dialog items from what was specified. */
title = Fcar (contents);
@@ -334,9 +325,9 @@ for instance using the window manager, then this produces a quit and
list_of_panes (Fcons (contents, Qnil));
/* Display them in a dialog box. */
- BLOCK_INPUT;
+ block_input ();
selection = xdialog_show (f, 0, title, header, &error_name);
- UNBLOCK_INPUT;
+ unblock_input ();
unbind_to (specpdl_count, Qnil);
discard_menu_items ();
@@ -391,8 +382,6 @@ x_menu_wait_for_event (void *data)
)
{
EMACS_TIME next_time = timer_check (), *ntp;
- long secs = EMACS_SECS (next_time);
- long usecs = EMACS_USECS (next_time);
SELECT_TYPE read_fds;
struct x_display_info *dpyinfo;
int n = 0;
@@ -406,19 +395,18 @@ x_menu_wait_for_event (void *data)
XFlush (dpyinfo->display);
}
- if (secs < 0 && usecs < 0)
+ if (! EMACS_TIME_VALID_P (next_time))
ntp = 0;
else
ntp = &next_time;
#ifdef HAVE_GTK3
- /* Gtk3 have arrows on menus when they don't fit. When the pointer is
- over an arrow, a timeout scrolls it a bit. Use xg_select so that
- timeout gets triggered. */
-
- xg_select (n + 1, &read_fds, (SELECT_TYPE *)0, (SELECT_TYPE *)0, ntp);
+ /* Gtk3 have arrows on menus when they don't fit. When the
+ pointer is over an arrow, a timeout scrolls it a bit. Use
+ xg_select so that timeout gets triggered. */
+ xg_select (n + 1, &read_fds, NULL, NULL, ntp, NULL);
#else
- select (n + 1, &read_fds, (SELECT_TYPE *)0, (SELECT_TYPE *)0, ntp);
+ pselect (n + 1, &read_fds, NULL, NULL, ntp, NULL);
#endif
}
}
@@ -499,7 +487,7 @@ If FRAME is nil or not given, use the selected frame. */)
XEvent ev;
FRAME_PTR f = check_x_frame (frame);
Widget menubar;
- BLOCK_INPUT;
+ block_input ();
if (FRAME_EXTERNAL_MENU_BAR (f))
set_frame_menubar (f, 0, 1);
@@ -557,7 +545,7 @@ If FRAME is nil or not given, use the selected frame. */)
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
@@ -578,9 +566,9 @@ If FRAME is nil or not given, use the selected frame. */)
FRAME_PTR f;
/* gcc 2.95 doesn't accept the FRAME_PTR declaration after
- BLOCK_INPUT. */
+ block_input (). */
- BLOCK_INPUT;
+ block_input ();
f = check_x_frame (frame);
if (FRAME_EXTERNAL_MENU_BAR (f))
@@ -599,7 +587,7 @@ If FRAME is nil or not given, use the selected frame. */)
g_list_free (children);
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
@@ -639,7 +627,7 @@ void
x_activate_menubar (FRAME_PTR f)
{
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
if (!f->output_data.x->saved_menu_event->type)
return;
@@ -651,7 +639,7 @@ x_activate_menubar (FRAME_PTR f)
#endif
set_frame_menubar (f, 0, 1);
- BLOCK_INPUT;
+ block_input ();
popup_activated_flag = 1;
#ifdef USE_GTK
XPutBackEvent (f->output_data.x->display_info->display,
@@ -659,7 +647,7 @@ x_activate_menubar (FRAME_PTR f)
#else
XtDispatchEvent (f->output_data.x->saved_menu_event);
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
/* Ignore this if we get it a second time. */
f->output_data.x->saved_menu_event->type = 0;
@@ -682,19 +670,17 @@ popup_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
/* This callback is invoked when a dialog or menu is finished being
used and has been unposted. */
-#ifdef USE_GTK
static void
-popup_deactivate_callback (GtkWidget *widget, gpointer client_data)
-{
- popup_activated_flag = 0;
-}
+popup_deactivate_callback (
+#ifdef USE_GTK
+ GtkWidget *widget, gpointer client_data
#else
-static void
-popup_deactivate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
+ Widget widget, LWLIB_ID id, XtPointer client_data
+#endif
+ )
{
popup_activated_flag = 0;
}
-#endif
/* Function that finds the frame for WIDGET and shows the HELP text
@@ -814,10 +800,10 @@ menubar_selection_callback (GtkWidget *widget, gpointer client_data)
sit-for will exit at once if the focus event follows the menu selection
event. */
- BLOCK_INPUT;
+ block_input ();
while (gtk_events_pending ())
gtk_main_iteration ();
- UNBLOCK_INPUT;
+ unblock_input ();
find_and_call_menu_selection (cb_data->cl_data->f,
cb_data->cl_data->menu_bar_items_used,
@@ -845,26 +831,26 @@ menubar_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
#endif /* not USE_GTK */
/* Recompute all the widgets of frame F, when the menu bar has been
- changed. Value is non-zero if widgets were updated. */
+ changed. */
-static int
+static void
update_frame_menubar (FRAME_PTR f)
{
#ifdef USE_GTK
- return xg_update_frame_menubar (f);
+ xg_update_frame_menubar (f);
#else
struct x_output *x;
int columns, rows;
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
x = f->output_data.x;
if (!x->menubar_widget || XtIsManaged (x->menubar_widget))
- return 0;
+ return;
- BLOCK_INPUT;
+ block_input ();
/* Save the size of the frame because the pane widget doesn't accept
to resize itself. So force it. */
columns = FRAME_COLS (f);
@@ -891,9 +877,8 @@ update_frame_menubar (FRAME_PTR f)
/* Force the pane widget to resize itself with the right values. */
EmacsFrameSetCharSize (x->edit_widget, columns, rows);
- UNBLOCK_INPUT;
+ unblock_input ();
#endif
- return 1;
}
#ifdef USE_LUCID
@@ -932,7 +917,7 @@ apply_systemfont_to_menu (struct frame *f, Widget w)
it is set the first time this is called, from initialize_frame_menubar. */
void
-set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
+set_frame_menubar (FRAME_PTR f, bool first_time, bool deep_p)
{
xt_or_gtk_widget menubar_widget;
#ifdef USE_X_TOOLKIT
@@ -942,10 +927,11 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
widget_value *wv, *first_wv, *prev_wv = 0;
int i;
int *submenu_start, *submenu_end;
- int *submenu_top_level_items, *submenu_n_panes;
+ bool *submenu_top_level_items;
+ int *submenu_n_panes;
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
menubar_widget = f->output_data.x->menubar_widget;
@@ -963,7 +949,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
else if (!f->output_data.x->saved_menu_event && !deep_p)
{
deep_p = 1;
- f->output_data.x->saved_menu_event = (XEvent*)xmalloc (sizeof (XEvent));
+ f->output_data.x->saved_menu_event = xmalloc (sizeof (XEvent));
f->output_data.x->saved_menu_event->type = 0;
}
@@ -979,11 +965,10 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
struct buffer *prev = current_buffer;
Lisp_Object buffer;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
int previous_menu_items_used = f->menu_bar_items_used;
Lisp_Object *previous_items
- = (Lisp_Object *) alloca (previous_menu_items_used
- * sizeof (Lisp_Object));
+ = alloca (previous_menu_items_used * sizeof *previous_items);
int subitems;
/* If we are making a new widget, its contents are empty,
@@ -1014,14 +999,14 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
if (! NILP (Vlucid_menu_bar_dirty_flag))
call0 (Qrecompute_lucid_menubar);
safe_run_hooks (Qmenu_bar_update_hook);
- FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
+ fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
items = FRAME_MENU_BAR_ITEMS (f);
/* Save the frame's previous menu bar contents data. */
if (previous_menu_items_used)
memcpy (previous_items, XVECTOR (f->menu_bar_vector)->contents,
- previous_menu_items_used * sizeof (Lisp_Object));
+ previous_menu_items_used * word_size);
/* Fill in menu_items with the current menu bar contents.
This can evaluate Lisp code. */
@@ -1030,18 +1015,19 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
menu_items = f->menu_bar_vector;
menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
subitems = ASIZE (items) / 4;
- submenu_start = (int *) alloca ((subitems + 1) * sizeof (int));
- submenu_end = (int *) alloca (subitems * sizeof (int));
- submenu_n_panes = (int *) alloca (subitems * sizeof (int));
- submenu_top_level_items = (int *) alloca (subitems * sizeof (int));
+ submenu_start = alloca ((subitems + 1) * sizeof *submenu_start);
+ submenu_end = alloca (subitems * sizeof *submenu_end);
+ submenu_n_panes = alloca (subitems * sizeof *submenu_n_panes);
+ submenu_top_level_items = alloca (subitems
+ * sizeof *submenu_top_level_items);
init_menu_items ();
for (i = 0; i < subitems; i++)
{
Lisp_Object key, string, maps;
- key = XVECTOR (items)->contents[4 * i];
- string = XVECTOR (items)->contents[4 * i + 1];
- maps = XVECTOR (items)->contents[4 * i + 2];
+ key = AREF (items, 4 * i);
+ string = AREF (items, 4 * i + 1);
+ maps = AREF (items, 4 * i + 2);
if (NILP (string))
break;
@@ -1092,7 +1078,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
/* Compare the new menu items with the ones computed last time. */
for (i = 0; i < previous_menu_items_used; i++)
if (menu_items_used == i
- || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
+ || (!EQ (previous_items[i], AREF (menu_items, i))))
break;
if (i == menu_items_used && i == previous_menu_items_used && i != 0)
{
@@ -1105,7 +1091,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
}
/* The menu items are different, so store them in the frame. */
- f->menu_bar_vector = menu_items;
+ fset_menu_bar_vector (f, menu_items);
f->menu_bar_items_used = menu_items_used;
/* This undoes save_menu_items. */
@@ -1117,7 +1103,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
for (i = 0; i < ASIZE (items); i += 4)
{
Lisp_Object string;
- string = XVECTOR (items)->contents[i + 1];
+ string = AREF (items, i + 1);
if (NILP (string))
break;
wv->name = SSDATA (string);
@@ -1144,7 +1130,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
{
Lisp_Object string;
- string = XVECTOR (items)->contents[i + 1];
+ string = AREF (items, i + 1);
if (NILP (string))
break;
@@ -1175,7 +1161,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
/* Create or update the menu bar widget. */
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_GTK
xg_crazy_callback_abort = 1;
@@ -1275,7 +1261,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
xg_crazy_callback_abort = 0;
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Called from Fx_create_frame to create the initial menubar of a frame
@@ -1288,7 +1274,7 @@ initialize_frame_menubar (FRAME_PTR f)
{
/* This function is called before the first chance to redisplay
the frame. It has to be, so the frame will have the right size. */
- FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
+ fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
set_frame_menubar (f, 1, 1);
}
@@ -1304,7 +1290,7 @@ free_frame_menubar (FRAME_PTR f)
Widget menubar_widget;
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
menubar_widget = f->output_data.x->menubar_widget;
@@ -1324,7 +1310,7 @@ free_frame_menubar (FRAME_PTR f)
Position x0, y0, x1, y1;
#endif
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_MOTIF
if (f->output_data.x->widget)
@@ -1343,7 +1329,7 @@ free_frame_menubar (FRAME_PTR f)
#endif
x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
#endif /* not USE_GTK */
@@ -1358,8 +1344,8 @@ free_frame_menubar (FRAME_PTR f)
/* F is the frame the menu is for.
X and Y are the frame-relative specified position,
relative to the inside upper left corner of the frame F.
- FOR_CLICK is nonzero if this menu was invoked for a mouse click.
- KEYMAPS is 1 if this menu was specified with keymaps;
+ FOR_CLICK is true if this menu was invoked for a mouse click.
+ KEYMAPS is true if this menu was specified with keymaps;
in that case, we return a list containing the chosen item's value
and perhaps also the pane's prefix.
TITLE is the specified menu title.
@@ -1428,9 +1414,9 @@ pop_down_menu (Lisp_Object arg)
struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
popup_activated_flag = 0;
- BLOCK_INPUT;
+ block_input ();
gtk_widget_destroy (GTK_WIDGET (p->pointer));
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
@@ -1439,14 +1425,14 @@ pop_down_menu (Lisp_Object arg)
menu_item_selection will be set to the selection. */
static void
create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, int x, int y,
- int for_click, Time timestamp)
+ bool for_click, Time timestamp)
{
int i;
GtkWidget *menu;
GtkMenuPositionFunc pos_func = 0; /* Pop up at pointer. */
struct next_popup_x_y popup_x_y;
- int specpdl_count = SPECPDL_INDEX ();
- int use_pos_func = ! for_click;
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
+ bool use_pos_func = ! for_click;
#ifdef HAVE_GTK3
/* Always use position function for Gtk3. Otherwise menus may become
@@ -1455,7 +1441,7 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, int x, int y,
#endif
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
xg_crazy_callback_abort = 1;
menu = xg_create_widget ("popup", first_wv->name, f, first_wv,
@@ -1538,9 +1524,9 @@ pop_down_menu (Lisp_Object arg)
LWLIB_ID id = (XINT (XCAR (arg)) << 4 * sizeof (LWLIB_ID)
| XINT (XCDR (arg)));
- BLOCK_INPUT;
+ block_input ();
lw_destroy_all_widgets (id);
- UNBLOCK_INPUT;
+ unblock_input ();
popup_activated_flag = 0;
return Qnil;
@@ -1551,7 +1537,7 @@ pop_down_menu (Lisp_Object arg)
menu_item_selection will be set to the selection. */
static void
create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv,
- int x, int y, int for_click, Time timestamp)
+ int x, int y, bool for_click, Time timestamp)
{
int i;
Arg av[2];
@@ -1562,7 +1548,7 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv,
Widget menu;
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
#ifdef USE_LUCID
apply_systemfont_to_menu (f, f->output_data.x->widget);
@@ -1609,7 +1595,7 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv,
{
int fact = 4 * sizeof (LWLIB_ID);
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
record_unwind_protect (pop_down_menu,
Fcons (make_number (menu_id >> (fact)),
make_number (menu_id & ~(-1 << (fact)))));
@@ -1635,23 +1621,23 @@ cleanup_widget_value_tree (Lisp_Object arg)
}
Lisp_Object
-xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
+xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps,
Lisp_Object title, const char **error_name, Time timestamp)
{
int i;
widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
widget_value **submenu_stack
- = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
+ = alloca (menu_items_used * sizeof *submenu_stack);
Lisp_Object *subprefix_stack
- = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
+ = alloca (menu_items_used * sizeof *subprefix_stack);
int submenu_depth = 0;
int first_pane;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
*error_name = NULL;
@@ -1676,7 +1662,7 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
i = 0;
while (i < menu_items_used)
{
- if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
+ if (EQ (AREF (menu_items, i), Qnil))
{
submenu_stack[submenu_depth++] = save_wv;
save_wv = prev_wv;
@@ -1684,21 +1670,21 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
first_pane = 1;
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
+ else if (EQ (AREF (menu_items, i), Qlambda))
{
prev_wv = save_wv;
save_wv = submenu_stack[--submenu_depth];
first_pane = 0;
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
+ else if (EQ (AREF (menu_items, i), Qt)
&& submenu_depth != 0)
i += MENU_ITEMS_PANE_LENGTH;
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
- else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ else if (EQ (AREF (menu_items, i), Qquote))
i += 1;
- else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ else if (EQ (AREF (menu_items, i), Qt))
{
/* Create a new pane. */
Lisp_Object pane_name, prefix;
@@ -1731,7 +1717,7 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
save_wv->next = wv;
else
first_wv->contents = wv;
- wv->name = pane_string;
+ wv->name = (char *) pane_string;
if (keymaps && !NILP (prefix))
wv->name++;
wv->value = 0;
@@ -1787,8 +1773,7 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
/* If this item has a null value,
make the call_data null so that it won't display a box
when the mouse is on it. */
- wv->call_data
- = (!NILP (def) ? (void *) &XVECTOR (menu_items)->contents[i] : 0);
+ wv->call_data = !NILP (def) ? aref_addr (menu_items, i) : 0;
wv->enabled = !NILP (enable);
if (NILP (type))
@@ -1798,7 +1783,7 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
else if (EQ (type, QCradio))
wv->button_type = BUTTON_TYPE_RADIO;
else
- abort ();
+ emacs_abort ();
wv->selected = !NILP (selected);
@@ -1864,34 +1849,34 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
i = 0;
while (i < menu_items_used)
{
- if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
+ if (EQ (AREF (menu_items, i), Qnil))
{
subprefix_stack[submenu_depth++] = prefix;
prefix = entry;
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
+ else if (EQ (AREF (menu_items, i), Qlambda))
{
prefix = subprefix_stack[--submenu_depth];
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ else if (EQ (AREF (menu_items, i), Qt))
{
prefix
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
i += MENU_ITEMS_PANE_LENGTH;
}
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
- else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ else if (EQ (AREF (menu_items, i), Qquote))
i += 1;
else
{
entry
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
- if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
+ = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
+ if (menu_item_selection == aref_addr (menu_items, i))
{
- if (keymaps != 0)
+ if (keymaps)
{
int j;
@@ -1936,7 +1921,7 @@ create_and_show_dialog (FRAME_PTR f, widget_value *first_wv)
GtkWidget *menu;
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
menu = xg_create_widget ("dialog", first_wv->name, f, first_wv,
G_CALLBACK (dialog_selection_callback),
@@ -1945,7 +1930,7 @@ create_and_show_dialog (FRAME_PTR f, widget_value *first_wv)
if (menu)
{
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
/* Display the menu. */
@@ -1967,9 +1952,9 @@ dialog_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
if ((intptr_t) client_data != -1)
menu_item_selection = (Lisp_Object *) client_data;
- BLOCK_INPUT;
+ block_input ();
lw_destroy_all_widgets (id);
- UNBLOCK_INPUT;
+ unblock_input ();
popup_activated_flag = 0;
}
@@ -1983,7 +1968,7 @@ create_and_show_dialog (FRAME_PTR f, widget_value *first_wv)
LWLIB_ID dialog_id;
if (!FRAME_X_P (f))
- abort ();
+ emacs_abort ();
dialog_id = widget_id_tick++;
#ifdef USE_LUCID
@@ -2001,7 +1986,7 @@ create_and_show_dialog (FRAME_PTR f, widget_value *first_wv)
/* Process events that apply to the dialog box.
Also handle timers. */
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int fact = 4 * sizeof (LWLIB_ID);
/* xdialog_show_unwind is responsible for popping the dialog box down. */
@@ -2024,7 +2009,7 @@ static const char * button_names [] = {
static Lisp_Object
xdialog_show (FRAME_PTR f,
- int keymaps,
+ bool keymaps,
Lisp_Object title,
Lisp_Object header,
const char **error_name)
@@ -2039,10 +2024,10 @@ xdialog_show (FRAME_PTR f,
/* 1 means we've seen the boundary between left-hand elts and right-hand. */
int boundary_seen = 0;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
*error_name = NULL;
@@ -2057,12 +2042,12 @@ xdialog_show (FRAME_PTR f,
{
Lisp_Object pane_name, prefix;
const char *pane_string;
- pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
- prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
+ pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
+ prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
pane_string = (NILP (pane_name)
? "" : SSDATA (pane_name));
prev_wv = xmalloc_widget_value ();
- prev_wv->value = pane_string;
+ prev_wv->value = (char *) pane_string;
if (keymaps && !NILP (prefix))
prev_wv->name++;
prev_wv->enabled = 1;
@@ -2077,10 +2062,10 @@ xdialog_show (FRAME_PTR f,
/* Create a new item within current pane. */
Lisp_Object item_name, enable, descrip;
- item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
- enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
+ item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
+ enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
descrip
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
+ = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
if (NILP (item_name))
{
@@ -2109,7 +2094,7 @@ xdialog_show (FRAME_PTR f,
if (!NILP (descrip))
wv->key = SSDATA (descrip);
wv->value = SSDATA (item_name);
- wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
+ wv->call_data = aref_addr (menu_items, i);
wv->enabled = !NILP (enable);
wv->help = Qnil;
prev_wv = wv;
@@ -2176,13 +2161,13 @@ xdialog_show (FRAME_PTR f,
{
Lisp_Object entry;
- if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ if (EQ (AREF (menu_items, i), Qt))
{
prefix
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
i += MENU_ITEMS_PANE_LENGTH;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ else if (EQ (AREF (menu_items, i), Qquote))
{
/* This is the boundary between left-side elts and
right-side elts. */
@@ -2191,8 +2176,8 @@ xdialog_show (FRAME_PTR f,
else
{
entry
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
- if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
+ = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
+ if (menu_item_selection == aref_addr (menu_items, i))
{
if (keymaps != 0)
{
@@ -2263,7 +2248,7 @@ pop_down_menu (Lisp_Object arg)
FRAME_PTR f = p1->pointer;
XMenu *menu = p2->pointer;
- BLOCK_INPUT;
+ block_input ();
#ifndef MSDOS
XUngrabPointer (FRAME_X_DISPLAY (f), CurrentTime);
XUngrabKeyboard (FRAME_X_DISPLAY (f), CurrentTime);
@@ -2283,14 +2268,14 @@ pop_down_menu (Lisp_Object arg)
#endif /* HAVE_X_WINDOWS */
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
Lisp_Object
-xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
+xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps,
Lisp_Object title, const char **error_name, Time timestamp)
{
Window root;
@@ -2304,10 +2289,10 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
int maxwidth;
int dummy_int;
unsigned int dummy_uint;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
if (! FRAME_X_P (f) && ! FRAME_MSDOS_P (f))
- abort ();
+ emacs_abort ();
*error_name = 0;
if (menu_items_n_panes == 0)
@@ -2352,7 +2337,7 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
lpane = XM_FAILURE;
while (i < menu_items_used)
{
- if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ if (EQ (AREF (menu_items, i), Qt))
{
/* Create a new pane. */
Lisp_Object pane_name, prefix;
@@ -2360,8 +2345,8 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
maxlines = max (maxlines, lines);
lines = 0;
- pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
- prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
+ prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
pane_string = (NILP (pane_name)
? "" : SSDATA (pane_name));
if (keymaps && !NILP (prefix))
@@ -2381,7 +2366,7 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
while (j < menu_items_used)
{
Lisp_Object item;
- item = XVECTOR (menu_items)->contents[j];
+ item = AREF (menu_items, j);
if (EQ (item, Qt))
break;
if (NILP (item))
@@ -2398,7 +2383,7 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
}
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
- else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ else if (EQ (AREF (menu_items, i), Qquote))
i += 1;
else
{
@@ -2407,18 +2392,18 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
char *item_data;
char const *help_string;
- item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
- enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
+ item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
+ enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
descrip
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
- help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
+ = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
+ help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
help_string = STRINGP (help) ? SSDATA (help) : NULL;
if (!NILP (descrip))
{
/* if alloca is fast, use that to make the space,
to reduce gc needs. */
- item_data = (char *) alloca (maxwidth + SBYTES (descrip) + 1);
+ item_data = alloca (maxwidth + SBYTES (descrip) + 1);
memcpy (item_data, SSDATA (item_name), SBYTES (item_name));
for (j = SCHARS (item_name); j < maxwidth; j++)
item_data[j] = ' ';
@@ -2525,11 +2510,11 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
i = 0;
while (i < menu_items_used)
{
- if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ if (EQ (AREF (menu_items, i), Qt))
{
if (pane == 0)
pane_prefix
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
pane--;
i += MENU_ITEMS_PANE_LENGTH;
}
@@ -2540,8 +2525,8 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
if (selidx == 0)
{
entry
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
- if (keymaps != 0)
+ = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
+ if (keymaps)
{
entry = Fcons (entry, Qnil);
if (!NILP (pane_prefix))
@@ -2581,7 +2566,7 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps,
/* Detect if a dialog or menu has been posted. MSDOS has its own
implementation on msdos.c. */
-int
+int ATTRIBUTE_CONST
popup_activated (void)
{
return popup_activated_flag;
diff --git a/src/xml.c b/src/xml.c
index f0422875f7e..a0c4fe17fc4 100644
--- a/src/xml.c
+++ b/src/xml.c
@@ -1,5 +1,5 @@
/* Interface to libxml2.
- Copyright (C) 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2010-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -20,14 +20,105 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_LIBXML2
-#include <setjmp.h>
#include <libxml/tree.h>
#include <libxml/parser.h>
#include <libxml/HTMLparser.h>
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
+
+static Lisp_Object Qlibxml2_dll;
+
+#ifdef WINDOWSNT
+
+#include <windows.h>
+#include "w32.h"
+
+/* Macro for defining functions that will be loaded from the libxml2 DLL. */
+#define DEF_XML2_FN(rettype,func,args) static rettype (FAR CDECL *fn_##func)args
+
+/* Macro for loading libxml2 functions from the library. */
+#define LOAD_XML2_FN(lib,func) { \
+ fn_##func = (void *) GetProcAddress (lib, #func); \
+ if (!fn_##func) goto bad_library; \
+ }
+
+DEF_XML2_FN (htmlDocPtr, htmlReadMemory,
+ (const char *, int, const char *, const char *, int));
+DEF_XML2_FN (xmlDocPtr, xmlReadMemory,
+ (const char *, int, const char *, const char *, int));
+DEF_XML2_FN (xmlNodePtr, xmlDocGetRootElement, (xmlDocPtr));
+DEF_XML2_FN (void, xmlFreeDoc, (xmlDocPtr));
+DEF_XML2_FN (void, xmlCleanupParser, (void));
+DEF_XML2_FN (void, xmlCheckVersion, (int));
+
+static int
+libxml2_loaded_p (void)
+{
+ Lisp_Object found = Fassq (Qlibxml2_dll, Vlibrary_cache);
+
+ if (CONSP (found))
+ return EQ (XCDR (found), Qt) ? 1 : 0;
+ return 0;
+}
+
+#else /* !WINDOWSNT */
+
+#define fn_htmlReadMemory htmlReadMemory
+#define fn_xmlReadMemory xmlReadMemory
+#define fn_xmlDocGetRootElement xmlDocGetRootElement
+#define fn_xmlFreeDoc xmlFreeDoc
+#define fn_xmlCleanupParser xmlCleanupParser
+#define fn_xmlCheckVersion xmlCheckVersion
+
+static int
+libxml2_loaded_p (void)
+{
+ return 1;
+}
+
+#endif /* !WINDOWSNT */
+
+static int
+init_libxml2_functions (void)
+{
+#ifdef WINDOWSNT
+ if (libxml2_loaded_p ())
+ return 1;
+ else
+ {
+ HMODULE library;
+
+ if (!(library = w32_delayed_load (Qlibxml2_dll)))
+ {
+ message ("%s", "libxml2 library not found");
+ return 0;
+ }
+
+ /* LOAD_XML2_FN jumps to bad_library if it fails to find the
+ named function. */
+ LOAD_XML2_FN (library, htmlReadMemory);
+ LOAD_XML2_FN (library, xmlReadMemory);
+ LOAD_XML2_FN (library, xmlDocGetRootElement);
+ LOAD_XML2_FN (library, xmlFreeDoc);
+ LOAD_XML2_FN (library, xmlCleanupParser);
+ LOAD_XML2_FN (library, xmlCheckVersion);
+
+ Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qt), Vlibrary_cache);
+ return 1;
+ }
+
+ bad_library:
+ Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qnil), Vlibrary_cache);
+
+ return 0;
+#else /* !WINDOWSNT */
+ return 1;
+#endif /* !WINDOWSNT */
+}
+
static Lisp_Object
make_dom (xmlNode *node)
{
@@ -89,10 +180,10 @@ parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, int html
xmlDoc *doc;
Lisp_Object result = Qnil;
const char *burl = "";
- EMACS_INT bytes;
- EMACS_INT istart, iend;
+ ptrdiff_t bytes;
+ ptrdiff_t istart, iend;
- LIBXML_TEST_VERSION;
+ fn_xmlCheckVersion (LIBXML_VERSION);
validate_region (&start, &end);
@@ -111,16 +202,16 @@ parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, int html
bytes = CHAR_TO_BYTE (iend) - CHAR_TO_BYTE (istart);
if (htmlp)
- doc = htmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
- bytes, burl, "utf-8",
- HTML_PARSE_RECOVER|HTML_PARSE_NONET|
- HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR|
- HTML_PARSE_NOBLANKS);
+ doc = fn_htmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
+ bytes, burl, "utf-8",
+ HTML_PARSE_RECOVER|HTML_PARSE_NONET|
+ HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR|
+ HTML_PARSE_NOBLANKS);
else
- doc = xmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
- bytes, burl, "utf-8",
- XML_PARSE_NONET|XML_PARSE_NOWARNING|
- XML_PARSE_NOBLANKS |XML_PARSE_NOERROR);
+ doc = fn_xmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
+ bytes, burl, "utf-8",
+ XML_PARSE_NONET|XML_PARSE_NOWARNING|
+ XML_PARSE_NOBLANKS |XML_PARSE_NOERROR);
if (doc != NULL)
{
@@ -139,19 +230,26 @@ parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, int html
if (NILP (result)) {
/* The document isn't just comments, so get the tree the
proper way. */
- xmlNode *node = xmlDocGetRootElement (doc);
+ xmlNode *node = fn_xmlDocGetRootElement (doc);
if (node != NULL)
result = make_dom (node);
} else
result = Fcons (intern ("top"),
Fcons (Qnil, Fnreverse (Fcons (r, result))));
- xmlFreeDoc (doc);
+ fn_xmlFreeDoc (doc);
}
return result;
}
+void
+xml_cleanup_parser (void)
+{
+ if (libxml2_loaded_p ())
+ fn_xmlCleanupParser ();
+}
+
DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region,
Slibxml_parse_html_region,
2, 3, 0,
@@ -159,7 +257,9 @@ DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region,
If BASE-URL is non-nil, it is used to expand relative URLs. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object base_url)
{
- return parse_region (start, end, base_url, 1);
+ if (init_libxml2_functions ())
+ return parse_region (start, end, base_url, 1);
+ return Qnil;
}
DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region,
@@ -169,7 +269,9 @@ DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region,
If BASE-URL is non-nil, it is used to expand relative URLs. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object base_url)
{
- return parse_region (start, end, base_url, 0);
+ if (init_libxml2_functions ())
+ return parse_region (start, end, base_url, 0);
+ return Qnil;
}
@@ -181,6 +283,8 @@ syms_of_xml (void)
{
defsubr (&Slibxml_parse_html_region);
defsubr (&Slibxml_parse_xml_region);
+
+ DEFSYM (Qlibxml2_dll, "libxml2");
}
#endif /* HAVE_LIBXML2 */
diff --git a/src/xrdb.c b/src/xrdb.c
index 4237ed11c53..59b0876ebf8 100644
--- a/src/xrdb.c
+++ b/src/xrdb.c
@@ -1,5 +1,5 @@
/* Deal with the X Resource Manager.
- Copyright (C) 1990, 1993-1994, 2000-2011 Free Software Foundation, Inc.
+ Copyright (C) 1990, 1993-1994, 2000-2012 Free Software Foundation, Inc.
Author: Joseph Arceneaux
Created: 4/90
@@ -24,9 +24,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <unistd.h>
#include <errno.h>
#include <epaths.h>
-
+#include <stdlib.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
@@ -42,21 +41,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_PWD_H
#include <pwd.h>
#endif
-#include <sys/stat.h>
#ifdef USE_MOTIF
/* For Vdouble_click_time. */
#include "keyboard.h"
#endif
-extern char *getenv (const char *);
-
-extern struct passwd *getpwuid (uid_t);
-extern struct passwd *getpwnam (const char *);
-
char *x_get_string_resource (XrmDatabase rdb, const char *name,
const char *class);
-static int file_p (const char *filename);
/* X file search path processing. */
@@ -74,10 +66,8 @@ static char *
x_get_customization_string (XrmDatabase db, const char *name,
const char *class)
{
- char *full_name
- = (char *) alloca (strlen (name) + sizeof ("customization") + 3);
- char *full_class
- = (char *) alloca (strlen (class) + sizeof ("Customization") + 3);
+ char *full_name = alloca (strlen (name) + sizeof "customization" + 3);
+ char *full_class = alloca (strlen (class) + sizeof "Customization" + 3);
char *result;
sprintf (full_name, "%s.%s", name, "customization");
@@ -87,7 +77,7 @@ x_get_customization_string (XrmDatabase db, const char *name,
if (result)
{
- char *copy = (char *) xmalloc (strlen (result) + 1);
+ char *copy = xmalloc (strlen (result) + 1);
strcpy (copy, result);
return copy;
}
@@ -116,7 +106,7 @@ x_get_customization_string (XrmDatabase db, const char *name,
database associated with display.
(This is x_customization_string.)
- Return the expanded file name if it exists and is readable, and
+ Return the resource database if its file was read successfully, and
refers to %L only when the LANG environment variable is set, or
otherwise provided by X.
@@ -125,14 +115,15 @@ x_get_customization_string (XrmDatabase db, const char *name,
Return NULL otherwise. */
-static char *
-magic_file_p (const char *string, EMACS_INT string_len, const char *class,
- const char *escaped_suffix)
+static XrmDatabase
+magic_db (const char *string, ptrdiff_t string_len, const char *class,
+ const char *escaped_suffix)
{
+ XrmDatabase db;
char *lang = getenv ("LANG");
ptrdiff_t path_size = 100;
- char *path = (char *) xmalloc (path_size);
+ char *path = xmalloc (path_size);
ptrdiff_t path_len = 0;
const char *p = string;
@@ -206,7 +197,7 @@ magic_file_p (const char *string, EMACS_INT string_len, const char *class,
if (min (PTRDIFF_MAX, SIZE_MAX) / 2 - 1 - path_len < next_len)
memory_full (SIZE_MAX);
path_size = (path_len + next_len + 1) * 2;
- path = (char *) xrealloc (path, path_size);
+ path = xrealloc (path, path_size);
}
memcpy (path + path_len, next, next_len);
@@ -225,14 +216,9 @@ magic_file_p (const char *string, EMACS_INT string_len, const char *class,
}
path[path_len] = '\0';
-
- if (! file_p (path))
- {
- xfree (path);
- return NULL;
- }
-
- return path;
+ db = XrmGetFileDatabase (path);
+ xfree (path);
+ return db;
}
@@ -258,7 +244,7 @@ gethomedir (void)
if (ptr == NULL)
return xstrdup ("/");
- copy = (char *) xmalloc (strlen (ptr) + 2);
+ copy = xmalloc (strlen (ptr) + 2);
strcpy (copy, ptr);
strcat (copy, "/");
@@ -266,22 +252,11 @@ gethomedir (void)
}
-static int
-file_p (const char *filename)
-{
- struct stat status;
-
- return (access (filename, 4) == 0 /* exists and is readable */
- && stat (filename, &status) == 0 /* get the status */
- && (S_ISDIR (status.st_mode)) == 0); /* not a directory */
-}
-
-
/* Find the first element of SEARCH_PATH which exists and is readable,
after expanding the %-escapes. Return 0 if we didn't find any, and
the path name of the one we found otherwise. */
-static char *
+static XrmDatabase
search_magic_path (const char *search_path, const char *class,
const char *escaped_suffix)
{
@@ -294,18 +269,16 @@ search_magic_path (const char *search_path, const char *class,
if (p > s)
{
- char *path = magic_file_p (s, p - s, class, escaped_suffix);
- if (path)
- return path;
+ XrmDatabase db = magic_db (s, p - s, class, escaped_suffix);
+ if (db)
+ return db;
}
else if (*p == ':')
{
- char *path;
-
- s = "%N%S";
- path = magic_file_p (s, strlen (s), class, escaped_suffix);
- if (path)
- return path;
+ static char const ns[] = "%N%S";
+ XrmDatabase db = magic_db (ns, strlen (ns), class, escaped_suffix);
+ if (db)
+ return db;
}
if (*p == ':')
@@ -320,21 +293,12 @@ search_magic_path (const char *search_path, const char *class,
static XrmDatabase
get_system_app (const char *class)
{
- XrmDatabase db = NULL;
const char *path;
- char *p;
path = getenv ("XFILESEARCHPATH");
if (! path) path = PATH_X_DEFAULTS;
- p = search_magic_path (path, class, 0);
- if (p)
- {
- db = XrmGetFileDatabase (p);
- xfree (p);
- }
-
- return db;
+ return search_magic_path (path, class, 0);
}
@@ -348,35 +312,40 @@ get_fallback (Display *display)
static XrmDatabase
get_user_app (const char *class)
{
+ XrmDatabase db = 0;
const char *path;
- char *file = 0;
- char *free_it = 0;
/* Check for XUSERFILESEARCHPATH. It is a path of complete file
names, not directories. */
- if (((path = getenv ("XUSERFILESEARCHPATH"))
- && (file = search_magic_path (path, class, 0)))
+ path = getenv ("XUSERFILESEARCHPATH");
+ if (path)
+ db = search_magic_path (path, class, 0);
+ if (! db)
+ {
/* Check for APPLRESDIR; it is a path of directories. In each,
we have to search for LANG/CLASS and then CLASS. */
- || ((path = getenv ("XAPPLRESDIR"))
- && ((file = search_magic_path (path, class, "/%L/%N"))
- || (file = search_magic_path (path, class, "/%N"))))
+ path = getenv ("XAPPLRESDIR");
+ if (path)
+ {
+ db = search_magic_path (path, class, "/%L/%N");
+ if (!db)
+ db = search_magic_path (path, class, "/%N");
+ }
+ }
+ if (! db)
+ {
/* Check in the home directory. This is a bit of a hack; let's
hope one's home directory doesn't contain any %-escapes. */
- || (free_it = gethomedir (),
- ((file = search_magic_path (free_it, class, "%L/%N"))
- || (file = search_magic_path (free_it, class, "%N")))))
- {
- XrmDatabase db = XrmGetFileDatabase (file);
- xfree (file);
- xfree (free_it);
- return db;
+ char *home = gethomedir ();
+ db = search_magic_path (home, class, "%L/%N");
+ if (! db)
+ db = search_magic_path (home, class, "%N");
+ xfree (home);
}
- xfree (free_it);
- return NULL;
+ return db;
}
@@ -400,7 +369,7 @@ get_user_db (Display *display)
char *xdefault;
home = gethomedir ();
- xdefault = (char *) xmalloc (strlen (home) + sizeof (".Xdefaults"));
+ xdefault = xmalloc (strlen (home) + sizeof ".Xdefaults");
strcpy (xdefault, home);
strcat (xdefault, ".Xdefaults");
db = XrmGetFileDatabase (xdefault);
@@ -432,9 +401,10 @@ get_environ_db (void)
{
static char const xdefaults[] = ".Xdefaults-";
char *home = gethomedir ();
- char const *host = get_system_name ();
- ptrdiff_t pathsize = strlen (home) + sizeof xdefaults + strlen (host);
- path = (char *) xrealloc (home, pathsize);
+ char const *host = SSDATA (Vsystem_name);
+ ptrdiff_t pathsize = (strlen (home) + sizeof xdefaults
+ + SBYTES (Vsystem_name));
+ path = xrealloc (home, pathsize);
strcat (strcat (path, xdefaults), host);
p = path;
}
diff --git a/src/xselect.c b/src/xselect.c
index 5e5e6a098b6..64c64fa0c76 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -1,5 +1,5 @@
/* X Selection processing for Emacs.
- Copyright (C) 1993-1997, 2000-2011 Free Software Foundation, Inc.
+ Copyright (C) 1993-1997, 2000-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -22,7 +22,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <limits.h>
#include <stdio.h> /* termhooks.h needs this */
-#include <setjmp.h>
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
@@ -35,11 +34,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dispextern.h" /* frame.h seems to want this */
#include "frame.h" /* Need this to get the X window of selected_frame */
#include "blockinput.h"
+#include "character.h"
#include "buffer.h"
#include "process.h"
#include "termhooks.h"
#include "keyboard.h"
-#include "character.h"
#include <X11/Xproto.h>
@@ -81,13 +80,13 @@ static Lisp_Object clean_local_selection_data (Lisp_Object);
#ifdef TRACE_SELECTION
#define TRACE0(fmt) \
- fprintf (stderr, "%d: " fmt "\n", getpid ())
+ fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid ())
#define TRACE1(fmt, a0) \
- fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
+ fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0)
#define TRACE2(fmt, a0, a1) \
- fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
+ fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1)
#define TRACE3(fmt, a0, a1, a2) \
- fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
+ fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1, a2)
#else
#define TRACE0(fmt) (void) 0
#define TRACE1(fmt, a0) (void) 0
@@ -180,16 +179,11 @@ x_queue_event (struct input_event *event)
}
}
- queue_tmp
- = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue));
-
- if (queue_tmp != NULL)
- {
- TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp);
- queue_tmp->event = *event;
- queue_tmp->next = selection_queue;
- selection_queue = queue_tmp;
- }
+ queue_tmp = xmalloc (sizeof *queue_tmp);
+ TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp);
+ queue_tmp->event = *event;
+ queue_tmp->next = selection_queue;
+ selection_queue = queue_tmp;
}
/* Start queuing SELECTION_REQUEST_EVENT events. */
@@ -198,7 +192,7 @@ static void
x_start_queuing_selection_requests (void)
{
if (x_queue_selection_requests)
- abort ();
+ emacs_abort ();
x_queue_selection_requests++;
TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests);
@@ -221,7 +215,7 @@ x_stop_queuing_selection_requests (void)
TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp);
kbd_buffer_unget_event (&queue_tmp->event);
selection_queue = queue_tmp->next;
- xfree ((char *)queue_tmp);
+ xfree (queue_tmp);
}
}
@@ -250,12 +244,12 @@ symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym)
if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
- if (!SYMBOLP (sym)) abort ();
+ if (!SYMBOLP (sym)) emacs_abort ();
TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym)));
- BLOCK_INPUT;
+ block_input ();
val = XInternAtom (dpyinfo->display, SSDATA (SYMBOL_NAME (sym)), False);
- UNBLOCK_INPUT;
+ unblock_input ();
return val;
}
@@ -313,16 +307,16 @@ x_atom_to_symbol (Display *dpy, Atom atom)
if (atom == dpyinfo->Xatom_NULL)
return QNULL;
- BLOCK_INPUT;
+ block_input ();
str = XGetAtomName (dpy, atom);
- UNBLOCK_INPUT;
+ unblock_input ();
TRACE1 ("XGetAtomName --> %s", str);
if (! str) return Qnil;
val = intern (str);
- BLOCK_INPUT;
+ block_input ();
/* This was allocated by Xlib, so use XFree. */
XFree (str);
- UNBLOCK_INPUT;
+ unblock_input ();
return val;
}
@@ -342,12 +336,12 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
Time timestamp = last_event_timestamp;
Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_name);
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (display);
XSetSelectionOwner (display, selection_atom, selecting_window, timestamp);
x_check_errors (display, "Can't set selection: %s");
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
/* Now update the local cache */
{
@@ -358,8 +352,9 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
INTEGER_TO_CONS (timestamp), frame);
prev_value = LOCAL_SELECTION (selection_name, dpyinfo);
- dpyinfo->terminal->Vselection_alist
- = Fcons (selection_data, dpyinfo->terminal->Vselection_alist);
+ tset_selection_alist
+ (dpyinfo->terminal,
+ Fcons (selection_data, dpyinfo->terminal->Vselection_alist));
/* If we already owned the selection, remove the old selection
data. Don't use Fdelq as that may QUIT. */
@@ -392,7 +387,6 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
{
Lisp_Object local_value;
Lisp_Object handler_fn, value, check;
- int count;
local_value = LOCAL_SELECTION (selection_symbol, dpyinfo);
@@ -409,7 +403,7 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
/* Don't allow a quit within the converter.
When the user types C-g, he would be surprised
if by luck it came during a converter. */
- count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
CHECK_SYMBOL (target_type);
@@ -475,12 +469,12 @@ x_decline_selection_request (struct input_event *event)
/* The reason for the error may be that the receiver has
died in the meantime. Handle that case. */
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (reply->display);
XSendEvent (reply->display, reply->requestor, False, 0L, &reply_base);
XFlush (reply->display);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* This is the selection request currently being processed.
@@ -542,9 +536,9 @@ x_selection_request_lisp_error (Lisp_Object ignore)
static Lisp_Object
x_catch_errors_unwind (Lisp_Object dummy)
{
- BLOCK_INPUT;
+ block_input ();
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
@@ -603,7 +597,7 @@ x_reply_selection_request (struct input_event *event,
Window window = SELECTION_EVENT_REQUESTOR (event);
ptrdiff_t bytes_remaining;
int max_bytes = selection_quantum (display);
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct selection_data *cs;
reply->type = SelectionNotify;
@@ -616,7 +610,7 @@ x_reply_selection_request (struct input_event *event,
if (reply->property == None)
reply->property = reply->target;
- BLOCK_INPUT;
+ block_input ();
/* The protected block contains wait_for_property_change, which can
run random lisp code (process handlers) or signal. Therefore, we
put the x_uncatch_errors call in an unwind. */
@@ -688,7 +682,7 @@ x_reply_selection_request (struct input_event *event,
{
int format_bytes = cs->format / 8;
int had_errors = x_had_errors_p (display);
- UNBLOCK_INPUT;
+ unblock_input ();
bytes_remaining = cs->size;
bytes_remaining *= format_bytes;
@@ -709,7 +703,7 @@ x_reply_selection_request (struct input_event *event,
int i = ((bytes_remaining < max_bytes)
? bytes_remaining
: max_bytes) / format_bytes;
- BLOCK_INPUT;
+ block_input ();
cs->wait_object
= expect_property_change (display, window, cs->property,
@@ -728,7 +722,7 @@ x_reply_selection_request (struct input_event *event,
: format_bytes);
XFlush (display);
had_errors = x_had_errors_p (display);
- UNBLOCK_INPUT;
+ unblock_input ();
if (had_errors) break;
@@ -741,7 +735,7 @@ x_reply_selection_request (struct input_event *event,
/* Now write a zero-length chunk to the property to tell the
requestor that we're done. */
- BLOCK_INPUT;
+ block_input ();
if (! waiting_for_other_props_on_window (display, window))
XSelectInput (display, window, 0L);
@@ -763,15 +757,15 @@ x_reply_selection_request (struct input_event *event,
/* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
delivered before uncatch errors. */
XSync (display, False);
- UNBLOCK_INPUT;
+ unblock_input ();
/* GTK queues events in addition to the queue in Xlib. So we
UNBLOCK to enter the event loop and get possible errors delivered,
and then BLOCK again because x_uncatch_errors requires it. */
- BLOCK_INPUT;
+ block_input ();
/* This calls x_uncatch_errors. */
unbind_to (count, Qnil);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Handle a SelectionRequest event EVENT.
@@ -792,7 +786,7 @@ x_handle_selection_request (struct input_event *event)
Atom property = SELECTION_EVENT_PROPERTY (event);
Lisp_Object local_selection_data;
int success = 0;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
GCPRO2 (local_selection_data, target_symbol);
if (!dpyinfo) goto DONE;
@@ -913,7 +907,7 @@ x_convert_selection (struct input_event *event, Lisp_Object selection_symbol,
{
if (for_multiple)
{
- cs = xmalloc (sizeof (struct selection_data));
+ cs = xmalloc (sizeof *cs);
cs->data = (unsigned char *) &conversion_fail_tag;
cs->size = 1;
cs->format = 32;
@@ -930,7 +924,8 @@ x_convert_selection (struct input_event *event, Lisp_Object selection_symbol,
}
/* Otherwise, record the converted selection to binary. */
- cs = xmalloc (sizeof (struct selection_data));
+ cs = xmalloc (sizeof *cs);
+ cs->data = NULL;
cs->nofree = 1;
cs->property = property;
cs->wait_object = NULL;
@@ -994,7 +989,7 @@ x_handle_selection_clear (struct input_event *event)
break;
}
}
- dpyinfo->terminal->Vselection_alist = Vselection_alist;
+ tset_selection_alist (dpyinfo->terminal, Vselection_alist);
/* Run the `x-lost-selection-functions' abnormal hook. */
{
@@ -1044,7 +1039,7 @@ x_clear_frame_selections (FRAME_PTR f)
args[1] = Fcar (Fcar (t->Vselection_alist));
Frun_hook_with_args (2, args);
- t->Vselection_alist = XCDR (t->Vselection_alist);
+ tset_selection_alist (t, XCDR (t->Vselection_alist));
}
/* Delete elements after the beginning of Vselection_alist. */
@@ -1085,7 +1080,7 @@ static struct prop_location *
expect_property_change (Display *display, Window window,
Atom property, int state)
{
- struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
+ struct prop_location *pl = xmalloc (sizeof *pl);
pl->identifier = ++prop_location_identifier;
pl->display = display;
pl->window = window;
@@ -1139,11 +1134,10 @@ wait_for_property_change_unwind (Lisp_Object loc)
static void
wait_for_property_change (struct prop_location *location)
{
- int secs, usecs;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (property_change_reply_object)
- abort ();
+ emacs_abort ();
/* Make sure to do unexpect_property_change if we quit or err. */
record_unwind_protect (wait_for_property_change_unwind,
@@ -1156,10 +1150,11 @@ wait_for_property_change (struct prop_location *location)
property_change_reply, because property_change_reply_object says so. */
if (! location->arrived)
{
- secs = x_selection_timeout / 1000;
- usecs = (x_selection_timeout % 1000) * 1000;
- TRACE2 (" Waiting %d secs, %d usecs", secs, usecs);
- wait_reading_process_output (secs, usecs, 0, 0,
+ EMACS_INT timeout = max (0, x_selection_timeout);
+ EMACS_INT secs = timeout / 1000;
+ int nsecs = (timeout % 1000) * 1000000;
+ TRACE2 (" Waiting %"pI"d secs, %d nsecs", secs, nsecs);
+ wait_reading_process_output (secs, nsecs, 0, 0,
property_change_reply, NULL, 0);
if (NILP (XCAR (property_change_reply)))
@@ -1228,7 +1223,8 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
Atom type_atom = (CONSP (target_type)
? symbol_to_x_atom (dpyinfo, XCAR (target_type))
: symbol_to_x_atom (dpyinfo, target_type));
- int secs, usecs;
+ EMACS_INT timeout, secs;
+ int nsecs;
if (!FRAME_LIVE_P (f))
return Qnil;
@@ -1236,7 +1232,7 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
if (! NILP (time_stamp))
CONS_TO_INTEGER (time_stamp, Time, requestor_time);
- BLOCK_INPUT;
+ block_input ();
TRACE2 ("Get selection %s, type %s",
XGetAtomName (display, type_atom),
XGetAtomName (display, target_property));
@@ -1261,13 +1257,14 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
record_unwind_protect (queue_selection_requests_unwind, Qnil);
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
/* This allows quits. Also, don't wait forever. */
- secs = x_selection_timeout / 1000;
- usecs = (x_selection_timeout % 1000) * 1000;
- TRACE1 (" Start waiting %d secs for SelectionNotify", secs);
- wait_reading_process_output (secs, usecs, 0, 0,
+ timeout = max (0, x_selection_timeout);
+ secs = timeout / 1000;
+ nsecs = (timeout % 1000) * 1000000;
+ TRACE1 (" Start waiting %"pI"d secs for SelectionNotify", secs);
+ wait_reading_process_output (secs, nsecs, 0, 0,
reading_selection_reply, NULL, 0);
TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
@@ -1312,7 +1309,7 @@ x_get_window_property (Display *display, Window window, Atom property,
? min (PTRDIFF_MAX, SIZE_MAX) - 1
: LONG_MAX * x_long_size);
- BLOCK_INPUT;
+ block_input ();
/* First probe the thing to find out how big it is. */
result = XGetWindowProperty (display, window, property,
@@ -1324,7 +1321,7 @@ x_get_window_property (Display *display, Window window, Atom property,
goto done;
/* This was allocated by Xlib, so use XFree. */
- XFree ((char *) tmp_data);
+ XFree (tmp_data);
if (*actual_type_ret == None || *actual_format_ret == 0)
goto done;
@@ -1357,7 +1354,7 @@ x_get_window_property (Display *display, Window window, Atom property,
break;
bytes_per_item = *actual_format_ret >> 3;
- xassert (*actual_size_ret <= buffer_size / bytes_per_item);
+ eassert (*actual_size_ret <= buffer_size / bytes_per_item);
/* The man page for XGetWindowProperty says:
"If the returned format is 32, the returned data is represented
@@ -1406,26 +1403,26 @@ x_get_window_property (Display *display, Window window, Atom property,
offset += bytes_gotten;
/* This was allocated by Xlib, so use XFree. */
- XFree ((char *) tmp_data);
+ XFree (tmp_data);
}
XFlush (display);
data[offset] = '\0';
done:
- UNBLOCK_INPUT;
+ unblock_input ();
*data_ret = data;
*bytes_ret = offset;
return;
size_overflow:
free (data);
- UNBLOCK_INPUT;
+ unblock_input ();
memory_full (SIZE_MAX);
memory_exhausted:
free (data);
- UNBLOCK_INPUT;
+ unblock_input ();
memory_full (total_size + 1);
}
@@ -1444,7 +1441,7 @@ receive_incremental_selection (Display *display, Window window, Atom property,
struct prop_location *wait_object;
if (min (PTRDIFF_MAX, SIZE_MAX) < min_size_bytes)
memory_full (SIZE_MAX);
- *data_ret = (unsigned char *) xmalloc (min_size_bytes);
+ *data_ret = xmalloc (min_size_bytes);
*size_bytes_ret = min_size_bytes;
TRACE1 ("Read %u bytes incrementally", min_size_bytes);
@@ -1457,7 +1454,7 @@ receive_incremental_selection (Display *display, Window window, Atom property,
that property, then reading the property, then deleting it to ack.
We are done when the sender places a property of length 0.
*/
- BLOCK_INPUT;
+ block_input ();
XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
TRACE1 (" Delete property %s",
SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
@@ -1467,7 +1464,7 @@ receive_incremental_selection (Display *display, Window window, Atom property,
wait_object = expect_property_change (display, window, property,
PropertyNewValue);
XFlush (display);
- UNBLOCK_INPUT;
+ unblock_input ();
while (1)
{
@@ -1499,14 +1496,14 @@ receive_incremental_selection (Display *display, Window window, Atom property,
break;
}
- BLOCK_INPUT;
+ block_input ();
TRACE1 (" ACK by deleting property %s",
XGetAtomName (display, property));
XDeleteProperty (display, window, property);
wait_object = expect_property_change (display, window, property,
PropertyNewValue);
XFlush (display);
- UNBLOCK_INPUT;
+ unblock_input ();
if (*size_bytes_ret - offset < tmp_size_bytes)
*data_ret = xpalloc (*data_ret, size_bytes_ret,
@@ -1548,10 +1545,10 @@ x_get_window_property_as_lisp_data (Display *display, Window window,
if (! data)
{
int there_is_a_selection_owner;
- BLOCK_INPUT;
+ block_input ();
there_is_a_selection_owner
= XGetSelectionOwner (display, selection_atom);
- UNBLOCK_INPUT;
+ unblock_input ();
if (there_is_a_selection_owner)
signal_error ("Selection owner couldn't convert",
actual_type
@@ -1568,22 +1565,22 @@ x_get_window_property_as_lisp_data (Display *display, Window window,
/* That wasn't really the data, just the beginning. */
unsigned int min_size_bytes = * ((unsigned int *) data);
- BLOCK_INPUT;
+ block_input ();
/* Use xfree, not XFree, because x_get_window_property
calls xmalloc itself. */
- xfree ((char *) data);
- UNBLOCK_INPUT;
+ xfree (data);
+ unblock_input ();
receive_incremental_selection (display, window, property, target_type,
min_size_bytes, &data, &bytes,
&actual_type, &actual_format,
&actual_size);
}
- BLOCK_INPUT;
+ block_input ();
TRACE1 (" Delete property %s", XGetAtomName (display, property));
XDeleteProperty (display, window, property);
XFlush (display);
- UNBLOCK_INPUT;
+ unblock_input ();
/* It's been read. Now convert it to a lisp object in some semi-rational
manner. */
@@ -1592,7 +1589,7 @@ x_get_window_property_as_lisp_data (Display *display, Window window,
/* Use xfree, not XFree, because x_get_window_property
calls xmalloc itself. */
- xfree ((char *) data);
+ xfree (data);
return val;
}
@@ -1701,7 +1698,7 @@ selection_data_to_lisp_data (Display *display, const unsigned char *data,
v = Fmake_vector (make_number (size / 2), make_number (0));
for (i = 0; i < size / 2; i++)
{
- EMACS_INT j = ((short *) data) [i];
+ short j = ((short *) data) [i];
Faset (v, make_number (i), make_number (j));
}
return v;
@@ -1778,20 +1775,24 @@ lisp_data_to_selection_data (Display *display, Lisp_Object obj,
}
else if (SYMBOLP (obj))
{
- *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
+ void *data = xmalloc (sizeof (Atom) + 1);
+ Atom *x_atom_ptr = data;
+ *data_ret = data;
*format_ret = 32;
*size_ret = 1;
(*data_ret) [sizeof (Atom)] = 0;
- (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, obj);
+ *x_atom_ptr = symbol_to_x_atom (dpyinfo, obj);
if (NILP (type)) type = QATOM;
}
else if (RANGED_INTEGERP (X_SHRT_MIN, obj, X_SHRT_MAX))
{
- *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
+ void *data = xmalloc (sizeof (short) + 1);
+ short *short_ptr = data;
+ *data_ret = data;
*format_ret = 16;
*size_ret = 1;
(*data_ret) [sizeof (short)] = 0;
- (*(short **) data_ret) [0] = XINT (obj);
+ *short_ptr = XINT (obj);
if (NILP (type)) type = QINTEGER;
}
else if (INTEGERP (obj)
@@ -1800,11 +1801,13 @@ lisp_data_to_selection_data (Display *display, Lisp_Object obj,
|| (CONSP (XCDR (obj))
&& INTEGERP (XCAR (XCDR (obj)))))))
{
- *data_ret = (unsigned char *) xmalloc (sizeof (unsigned long) + 1);
+ void *data = xmalloc (sizeof (unsigned long) + 1);
+ unsigned long *x_long_ptr = data;
+ *data_ret = data;
*format_ret = 32;
*size_ret = 1;
(*data_ret) [sizeof (unsigned long)] = 0;
- (*(unsigned long **) data_ret) [0] = cons_to_x_long (obj);
+ *x_long_ptr = cons_to_x_long (obj);
if (NILP (type)) type = QINTEGER;
}
else if (VECTORP (obj))
@@ -1816,30 +1819,35 @@ lisp_data_to_selection_data (Display *display, Lisp_Object obj,
ptrdiff_t i;
ptrdiff_t size = ASIZE (obj);
- if (SYMBOLP (XVECTOR (obj)->contents [0]))
+ if (SYMBOLP (AREF (obj, 0)))
/* This vector is an ATOM set */
{
+ void *data;
+ Atom *x_atoms;
if (NILP (type)) type = QATOM;
for (i = 0; i < size; i++)
- if (!SYMBOLP (XVECTOR (obj)->contents [i]))
+ if (!SYMBOLP (AREF (obj, i)))
signal_error ("All elements of selection vector must have same type", obj);
- *data_ret = xnmalloc (size, sizeof (Atom));
+ *data_ret = data = xnmalloc (size, sizeof *x_atoms);
+ x_atoms = data;
*format_ret = 32;
*size_ret = size;
for (i = 0; i < size; i++)
- (*(Atom **) data_ret) [i]
- = symbol_to_x_atom (dpyinfo, XVECTOR (obj)->contents [i]);
+ x_atoms[i] = symbol_to_x_atom (dpyinfo, AREF (obj, i));
}
else
/* This vector is an INTEGER set, or something like it */
{
int format = 16;
int data_size = sizeof (short);
+ void *data;
+ unsigned long *x_atoms;
+ short *shorts;
if (NILP (type)) type = QINTEGER;
for (i = 0; i < size; i++)
{
- if (! RANGED_INTEGERP (X_SHRT_MIN, XVECTOR (obj)->contents[i],
+ if (! RANGED_INTEGERP (X_SHRT_MIN, AREF (obj, i),
X_SHRT_MAX))
{
/* Use sizeof (long) even if it is more than 32 bits.
@@ -1850,17 +1858,17 @@ lisp_data_to_selection_data (Display *display, Lisp_Object obj,
break;
}
}
- *data_ret = xnmalloc (size, data_size);
+ *data_ret = data = xnmalloc (size, data_size);
+ x_atoms = data;
+ shorts = data;
*format_ret = format;
*size_ret = size;
for (i = 0; i < size; i++)
{
if (format == 32)
- (*((unsigned long **) data_ret)) [i] =
- cons_to_x_long (XVECTOR (obj)->contents[i]);
+ x_atoms[i] = cons_to_x_long (AREF (obj, i));
else
- (*((short **) data_ret)) [i] =
- XINT (XVECTOR (obj)->contents[i]);
+ shorts[i] = XINT (AREF (obj, i));
}
}
}
@@ -1895,11 +1903,10 @@ clean_local_selection_data (Lisp_Object obj)
ptrdiff_t size = ASIZE (obj);
Lisp_Object copy;
if (size == 1)
- return clean_local_selection_data (XVECTOR (obj)->contents [0]);
+ return clean_local_selection_data (AREF (obj, 0));
copy = Fmake_vector (make_number (size), Qnil);
for (i = 0; i < size; i++)
- XVECTOR (copy)->contents [i]
- = clean_local_selection_data (XVECTOR (obj)->contents [i]);
+ ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
return copy;
}
return obj;
@@ -1933,7 +1940,7 @@ x_handle_selection_notify (XSelectionEvent *event)
static struct frame *
frame_for_x_selection (Lisp_Object object)
{
- Lisp_Object tail;
+ Lisp_Object tail, frame;
struct frame *f;
if (NILP (object))
@@ -1942,9 +1949,9 @@ frame_for_x_selection (Lisp_Object object)
if (FRAME_X_P (f) && FRAME_LIVE_P (f))
return f;
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- f = XFRAME (XCAR (tail));
+ f = XFRAME (frame);
if (FRAME_X_P (f) && FRAME_LIVE_P (f))
return f;
}
@@ -1952,15 +1959,14 @@ frame_for_x_selection (Lisp_Object object)
else if (TERMINALP (object))
{
struct terminal *t = get_terminal (object, 1);
+
if (t->type == output_x_window)
- {
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
- {
- f = XFRAME (XCAR (tail));
- if (FRAME_LIVE_P (f) && f->terminal == t)
- return f;
- }
- }
+ FOR_EACH_FRAME (tail, frame)
+ {
+ f = XFRAME (frame);
+ if (FRAME_LIVE_P (f) && f->terminal == t)
+ return f;
+ }
}
else if (FRAMEP (object))
{
@@ -1982,7 +1988,9 @@ VALUE is typically a string, or a cons of two markers, but may be
anything that the functions on `selection-converter-alist' know about.
FRAME should be a frame that should own the selection. If omitted or
-nil, it defaults to the selected frame. */)
+nil, it defaults to the selected frame.
+
+On Nextstep, FRAME is unused. */)
(Lisp_Object selection, Lisp_Object value, Lisp_Object frame)
{
if (NILP (frame)) frame = selected_frame;
@@ -2003,15 +2011,18 @@ nil, it defaults to the selected frame. */)
DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
Sx_get_selection_internal, 2, 4, 0,
doc: /* Return text selected from some X window.
-SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
\(Those are literal upper-case symbol names, since that's what X expects.)
-TYPE is the type of data desired, typically `STRING'.
-TIME_STAMP is the time to use in the XConvertSelection call for foreign
+TARGET-TYPE is the type of data desired, typically `STRING'.
+
+TIME-STAMP is the time to use in the XConvertSelection call for foreign
selections. If omitted, defaults to the time for the last event.
TERMINAL should be a terminal object or a frame specifying the X
server to query. If omitted or nil, that stands for the selected
-frame's display, or the first available X display. */)
+frame's display, or the first available X display.
+
+On Nextstep, TIME-STAMP and TERMINAL are unused. */)
(Lisp_Object selection_symbol, Lisp_Object target_type,
Lisp_Object time_stamp, Lisp_Object terminal)
{
@@ -2052,9 +2063,15 @@ DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
doc: /* If we own the selection SELECTION, disown it.
Disowning it means there is no such selection.
+Sets the last-change time for the selection to TIME-OBJECT (by default
+the time of the last event).
+
TERMINAL should be a terminal object or a frame specifying the X
server to query. If omitted or nil, that stands for the selected
-frame's display, or the first available X display. */)
+frame's display, or the first available X display.
+
+On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
+On MS-DOS, all this does is return non-nil if we own the selection. */)
(Lisp_Object selection, Lisp_Object time_object, Lisp_Object terminal)
{
Time timestamp;
@@ -2078,13 +2095,13 @@ frame's display, or the first available X display. */)
selection_atom = symbol_to_x_atom (dpyinfo, selection);
- BLOCK_INPUT;
+ block_input ();
if (NILP (time_object))
timestamp = last_event_timestamp;
else
CONS_TO_INTEGER (time_object, Time, timestamp);
XSetSelectionOwner (dpyinfo->display, selection_atom, None, timestamp);
- UNBLOCK_INPUT;
+ unblock_input ();
/* It doesn't seem to be guaranteed that a SelectionClear event will be
generated for a window which owns the selection when that window sets
@@ -2110,7 +2127,9 @@ and t is the same as `SECONDARY'.
TERMINAL should be a terminal object or a frame specifying the X
server to query. If omitted or nil, that stands for the selected
-frame's display, or the first available X display. */)
+frame's display, or the first available X display.
+
+On Nextstep, TERMINAL is unused. */)
(Lisp_Object selection, Lisp_Object terminal)
{
struct frame *f = frame_for_x_selection (terminal);
@@ -2129,13 +2148,15 @@ DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
0, 2, 0,
doc: /* Whether there is an owner for the given X selection.
SELECTION should be the name of the selection in question, typically
-one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
-these literal upper-case names.) The symbol nil is the same as
-`PRIMARY', and t is the same as `SECONDARY'.
+one of the symbols `PRIMARY', `SECONDARY', `CLIPBOARD', or
+`CLIPBOARD_MANAGER' (X expects these literal upper-case names.) The
+symbol nil is the same as `PRIMARY', and t is the same as `SECONDARY'.
TERMINAL should be a terminal object or a frame specifying the X
server to query. If omitted or nil, that stands for the selected
-frame's display, or the first available X display. */)
+frame's display, or the first available X display.
+
+On Nextstep, TERMINAL is unused. */)
(Lisp_Object selection, Lisp_Object terminal)
{
Window owner;
@@ -2157,9 +2178,9 @@ frame's display, or the first available X display. */)
atom = symbol_to_x_atom (dpyinfo, selection);
if (atom == 0) return Qnil;
- BLOCK_INPUT;
+ block_input ();
owner = XGetSelectionOwner (dpyinfo->display, atom);
- UNBLOCK_INPUT;
+ unblock_input ();
return (owner ? Qt : Qnil);
}
@@ -2258,8 +2279,14 @@ x_clipboard_manager_save_all (void)
local_frame = XCAR (XCDR (XCDR (XCDR (local_selection))));
if (FRAME_LIVE_P (XFRAME (local_frame)))
- internal_condition_case_1 (x_clipboard_manager_save, local_frame,
- Qt, x_clipboard_manager_error_2);
+ {
+ Lisp_Object args[1];
+ args[0] = build_string ("Saving clipboard to X clipboard manager...");
+ Fmessage (1, args);
+
+ internal_condition_case_1 (x_clipboard_manager_save, local_frame,
+ Qt, x_clipboard_manager_error_2);
+ }
}
}
@@ -2325,9 +2352,9 @@ x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format)
val = cons_to_signed (o, LONG_MIN, LONG_MAX);
else if (STRINGP (o))
{
- BLOCK_INPUT;
+ block_input ();
val = (long) XInternAtom (dpy, SSDATA (o), False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
else
error ("Wrong type, must be string, number or cons");
@@ -2385,7 +2412,7 @@ mouse_position_for_drop (FRAME_PTR f, int *x, int *y)
Window root, dummy_window;
int dummy;
- BLOCK_INPUT;
+ block_input ();
XQueryPointer (FRAME_X_DISPLAY (f),
DefaultRootWindow (FRAME_X_DISPLAY (f)),
@@ -2411,7 +2438,7 @@ mouse_position_for_drop (FRAME_PTR f, int *x, int *y)
*x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
*y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
DEFUN ("x-get-atom-name", Fx_get_atom_name,
@@ -2434,7 +2461,7 @@ If the value is 0 or the atom is not known, return the empty string. */)
CONS_TO_INTEGER (value, Atom, atom);
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (dpy);
name = atom ? XGetAtomName (dpy, atom) : empty;
had_errors = x_had_errors_p (dpy);
@@ -2446,7 +2473,7 @@ If the value is 0 or the atom is not known, return the empty string. */)
if (atom && name) XFree (name);
if (NILP (ret)) ret = empty_unibyte_string;
- UNBLOCK_INPUT;
+ unblock_input ();
return ret;
}
@@ -2468,9 +2495,9 @@ FRAME is on. If FRAME is nil, the selected frame is used. */)
x_atom = symbol_to_x_atom (dpyinfo, atom);
else if (STRINGP (atom))
{
- BLOCK_INPUT;
+ block_input ();
x_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (atom), False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
else
error ("ATOM must be a symbol or a string");
@@ -2601,13 +2628,12 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from,
if (x_check_property_data (values) == -1)
error ("Bad data in VALUES, must be number, cons or string");
- event.xclient.type = ClientMessage;
- event.xclient.format = XFASTINT (format);
-
- if (event.xclient.format != 8 && event.xclient.format != 16
- && event.xclient.format != 32)
+ if (XINT (format) != 8 && XINT (format) != 16 && XINT (format) != 32)
error ("FORMAT must be one of 8, 16 or 32");
+ event.xclient.type = ClientMessage;
+ event.xclient.format = XINT (format);
+
if (FRAMEP (dest) || NILP (dest))
{
struct frame *fdest = check_x_frame (dest);
@@ -2630,7 +2656,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from,
if (wdest == 0) wdest = dpyinfo->root_window;
to_root = wdest == dpyinfo->root_window;
- BLOCK_INPUT;
+ block_input ();
event.xclient.message_type = message_type;
event.xclient.display = dpyinfo->display;
@@ -2656,7 +2682,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from,
XFlush (dpyinfo->display);
}
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
}
diff --git a/src/xsettings.c b/src/xsettings.c
index a8604ac5897..d23070791d8 100644
--- a/src/xsettings.c
+++ b/src/xsettings.c
@@ -1,6 +1,6 @@
/* Functions for handling font and other changes dynamically.
-Copyright (C) 2009-2011 Free Software Foundation, Inc.
+Copyright (C) 2009-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,7 +21,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <float.h>
#include <limits.h>
-#include <setjmp.h>
#include <fcntl.h>
#include "lisp.h"
#include "xterm.h"
@@ -30,7 +29,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "keyboard.h"
#include "blockinput.h"
#include "termhooks.h"
-#include "termopts.h"
#include <X11/Xproto.h>
@@ -159,8 +157,9 @@ store_tool_bar_style_changed (const char *newstyle,
XCAR (dpyinfo->name_list_element));
}
-
+#ifdef HAVE_XFT
#define XSETTINGS_FONT_NAME "Gtk/FontName"
+#endif
#define XSETTINGS_TOOL_BAR_STYLE "Gtk/ToolbarStyle"
enum {
@@ -710,10 +709,12 @@ apply_xft_settings (struct x_display_info *dpyinfo,
if (send_event_p)
store_config_changed_event (Qfont_render,
XCAR (dpyinfo->name_list_element));
- sprintf (buf, format, oldsettings.aa, oldsettings.hinting,
- oldsettings.rgba, oldsettings.lcdfilter,
- oldsettings.hintstyle, oldsettings.dpi);
- Vxft_settings = build_string (buf);
+ Vxft_settings
+ = make_formatted_string (buf, format,
+ oldsettings.aa, oldsettings.hinting,
+ oldsettings.rgba, oldsettings.lcdfilter,
+ oldsettings.hintstyle, oldsettings.dpi);
+
}
else
FcPatternDestroy (pat);
@@ -927,7 +928,7 @@ init_xsettings (struct x_display_info *dpyinfo)
{
Display *dpy = dpyinfo->display;
- BLOCK_INPUT;
+ block_input ();
/* Select events so we can detect client messages sent when selection
owner changes. */
@@ -937,7 +938,7 @@ init_xsettings (struct x_display_info *dpyinfo)
if (dpyinfo->xsettings_window != None)
read_and_apply_settings (dpyinfo, False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
void
@@ -1024,7 +1025,7 @@ syms_of_xsettings (void)
defsubr (&Sfont_get_system_normal_font);
DEFVAR_BOOL ("font-use-system-font", use_system_font,
- doc: /* *Non-nil means to apply the system defined font dynamically.
+ doc: /* Non-nil means to apply the system defined font dynamically.
When this is non-nil and the system defined fixed width font changes, we
update frames dynamically.
If this variable is nil, Emacs ignores system font changes. */);
@@ -1032,7 +1033,7 @@ If this variable is nil, Emacs ignores system font changes. */);
DEFVAR_LISP ("xft-settings", Vxft_settings,
doc: /* Font settings applied to Xft. */);
- Vxft_settings = make_string ("", 0);
+ Vxft_settings = empty_unibyte_string;
#ifdef HAVE_XFT
Fprovide (intern_c_string ("font-render-setting"), Qnil);
diff --git a/src/xsettings.h b/src/xsettings.h
index 38448eb88f5..10dc7ef926a 100644
--- a/src/xsettings.h
+++ b/src/xsettings.h
@@ -1,6 +1,6 @@
/* Functions for handle font changes dynamically.
-Copyright (C) 2009-2011 Free Software Foundation, Inc.
+Copyright (C) 2009-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -20,8 +20,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef XSETTINGS_H
#define XSETTINGS_H
-EXFUN (Ftool_bar_get_system_style, 0);
-
extern void xsettings_initialize (struct x_display_info *dpyinfo);
extern void xft_settings_event (struct x_display_info *dpyinfo,
XEvent *);
diff --git a/src/xsmfns.c b/src/xsmfns.c
index 7deac7b14e4..289aac8492b 100644
--- a/src/xsmfns.c
+++ b/src/xsmfns.c
@@ -1,7 +1,7 @@
/* Session management module for systems which understand the X Session
management protocol.
-Copyright (C) 2002-2011 Free Software Foundation, Inc.
+Copyright (C) 2002-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -29,14 +29,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <unistd.h>
#include <sys/param.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "systime.h"
#include "sysselect.h"
#include "frame.h"
#include "termhooks.h"
-#include "termopts.h"
#include "xterm.h"
#include "process.h"
#include "keyboard.h"
@@ -97,7 +95,7 @@ ice_connection_closed (void)
open to a session manager, just return. */
static void
-x_session_check_input (int fd, void *data, int for_read)
+x_session_check_input (int fd, void *data)
{
int ret;
diff --git a/src/xterm.c b/src/xterm.c
index e2f356db7b0..61e942e10d2 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -1,6 +1,6 @@
/* X Communication module for terminals which understand the X protocol.
-Copyright (C) 1989, 1993-2011 Free Software Foundation, Inc.
+Copyright (C) 1989, 1993-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,17 +21,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Xt features made by Fred Pierresteguy. */
#include <config.h>
-#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
#ifdef HAVE_X_WINDOWS
#include "lisp.h"
#include "blockinput.h"
-
-/* Need syssignal.h for various externs and definitions that may be required
- by some configurations for calls to signal later in this source file. */
#include "syssignal.h"
/* This may include sys/types.h, and that somehow loses
@@ -50,9 +45,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "systime.h"
#include <fcntl.h>
-#include <ctype.h>
#include <errno.h>
-#include <setjmp.h>
#include <sys/stat.h>
/* Caused redefinition of DBL_DIG on Netbsd; seems not to be needed. */
/* #include <sys/param.h> */
@@ -85,10 +78,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <X11/Shell.h>
#endif
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#endif
-
#include <unistd.h>
#ifdef USE_GTK
@@ -139,6 +128,8 @@ extern void _XEditResCheckMessages (Widget, XtPointer, XEvent *, Boolean *);
#endif
#endif
+#include "bitmaps/gray.xbm"
+
/* Default to using XIM if available. */
#ifdef USE_XIM
int use_xim = 1;
@@ -168,13 +159,6 @@ struct x_display_info *x_display_list;
Lisp_Object x_display_name_list;
-/* Frame being updated by update_frame. This is declared in term.c.
- This is set by update_begin and looked at by all the XT functions.
- It is zero while not inside an update. In that case, the XT
- functions assume that `selected_frame' is the frame to apply to. */
-
-extern struct frame *updating_frame;
-
/* This is a frame waiting to be auto-raised, within XTread_socket. */
static struct frame *pending_autoraise_frame;
@@ -256,11 +240,7 @@ static Time last_user_time;
/* Incremented by XTread_socket whenever it really tries to read
events. */
-#ifdef __STDC__
static int volatile input_signal_count;
-#else
-static int input_signal_count;
-#endif
/* Used locally within XTread_socket. */
@@ -307,7 +287,7 @@ enum xembed_message
/* Used in x_flush. */
-static int x_alloc_nearest_color_1 (Display *, Colormap, XColor *);
+static bool x_alloc_nearest_color_1 (Display *, Colormap, XColor *);
static void x_set_window_size_1 (struct frame *, int, int, int);
static void x_raise_frame (struct frame *);
static void x_lower_frame (struct frame *);
@@ -322,7 +302,7 @@ static void XTframe_up_to_date (struct frame *);
static void XTset_terminal_modes (struct terminal *);
static void XTreset_terminal_modes (struct terminal *);
static void x_clear_frame (struct frame *);
-static void x_ins_del_lines (struct frame *, int, int) NO_RETURN;
+static _Noreturn void x_ins_del_lines (struct frame *, int, int);
static void frame_highlight (struct frame *);
static void frame_unhighlight (struct frame *);
static void x_new_focus_frame (struct x_display_info *, struct frame *);
@@ -355,7 +335,7 @@ static int handle_one_xevent (struct x_display_info *, XEvent *,
#ifdef USE_GTK
static int x_dispatch_event (XEvent *, Display *);
#endif
-/* Don't declare this NO_RETURN because we want no
+/* Don't declare this _Noreturn because we want no
interference with debugging failing X calls. */
static void x_connection_closed (Display *, const char *);
static void x_wm_set_window_state (struct frame *, int);
@@ -373,7 +353,7 @@ x_flush (struct frame *f)
if (!NILP (Vinhibit_redisplay))
return;
- BLOCK_INPUT;
+ block_input ();
if (f == NULL)
{
Lisp_Object rest, frame;
@@ -383,7 +363,7 @@ x_flush (struct frame *f)
}
else if (FRAME_X_P (f))
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -526,7 +506,7 @@ x_set_frame_alpha (struct frame *f)
if (rc == Success && actual != None)
{
unsigned long value = *(unsigned long *)data;
- XFree ((void *) data);
+ XFree (data);
if (value == opac)
{
x_uncatch_errors ();
@@ -584,7 +564,7 @@ x_update_window_begin (struct window *w)
updated_window = w;
set_output_cursor (&w->cursor);
- BLOCK_INPUT;
+ block_input ();
if (f == hlinfo->mouse_face_mouse_frame)
{
@@ -597,7 +577,7 @@ x_update_window_begin (struct window *w)
hlinfo->mouse_face_window = Qnil;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -638,7 +618,7 @@ x_update_window_end (struct window *w, int cursor_on_p, int mouse_face_overwritt
if (!w->pseudo_window_p)
{
- BLOCK_INPUT;
+ block_input ();
if (cursor_on_p)
display_and_set_cursor (w, 1, output_cursor.hpos,
@@ -648,7 +628,7 @@ x_update_window_end (struct window *w, int cursor_on_p, int mouse_face_overwritt
if (draw_window_fringes (w, 1))
x_draw_vertical_border (w);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* If a row with mouse-face was overwritten, arrange for
@@ -674,9 +654,9 @@ x_update_end (struct frame *f)
MOUSE_HL_INFO (f)->mouse_face_defer = 0;
#ifndef XFlush
- BLOCK_INPUT;
+ block_input ();
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
#endif
}
@@ -689,21 +669,7 @@ static void
XTframe_up_to_date (struct frame *f)
{
if (FRAME_X_P (f))
- {
- Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
-
- if (hlinfo->mouse_face_deferred_gc
- || f == hlinfo->mouse_face_mouse_frame)
- {
- BLOCK_INPUT;
- if (hlinfo->mouse_face_mouse_frame)
- note_mouse_highlight (hlinfo->mouse_face_mouse_frame,
- hlinfo->mouse_face_mouse_x,
- hlinfo->mouse_face_mouse_y);
- hlinfo->mouse_face_deferred_gc = 0;
- UNBLOCK_INPUT;
- }
- }
+ FRAME_MOUSE_UPDATE (f);
}
@@ -721,7 +687,7 @@ x_after_update_window_line (struct glyph_row *desired_row)
struct frame *f;
int width, height;
- xassert (w);
+ eassert (w);
if (!desired_row->mode_line_p && !w->pseudo_window_p)
desired_row->redraw_fringe_bitmaps_p = 1;
@@ -742,13 +708,13 @@ x_after_update_window_line (struct glyph_row *desired_row)
{
int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y));
- BLOCK_INPUT;
+ block_input ();
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
0, y, width, height, False);
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
FRAME_PIXEL_WIDTH (f) - width,
y, width, height, False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -914,13 +880,13 @@ static void x_draw_glyph_string_foreground (struct glyph_string *);
static void x_draw_composite_glyph_string_foreground (struct glyph_string *);
static void x_draw_glyph_string_box (struct glyph_string *);
static void x_draw_glyph_string (struct glyph_string *);
-static void x_delete_glyphs (struct frame *, int) NO_RETURN;
+static _Noreturn void x_delete_glyphs (struct frame *, int);
static void x_compute_glyph_string_overhangs (struct glyph_string *);
static void x_set_cursor_gc (struct glyph_string *);
static void x_set_mode_line_face_gc (struct glyph_string *);
static void x_set_mouse_face_gc (struct glyph_string *);
-static int x_alloc_lighter_color (struct frame *, Display *, Colormap,
- unsigned long *, double, int);
+static bool x_alloc_lighter_color (struct frame *, Display *, Colormap,
+ unsigned long *, double, int);
static void x_setup_relief_color (struct frame *, struct relief *,
double, int, unsigned long);
static void x_setup_relief_colors (struct glyph_string *);
@@ -937,7 +903,7 @@ static void x_draw_box_rect (struct glyph_string *, int, int, int, int,
int, int, int, XRectangle *);
static void x_scroll_bar_clear (struct frame *);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
static void x_check_font (struct frame *, struct font *);
#endif
@@ -1039,7 +1005,7 @@ x_set_mouse_face_gc (struct glyph_string *s)
s->gc = FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc;
}
- xassert (s->gc != 0);
+ eassert (s->gc != 0);
}
@@ -1047,7 +1013,7 @@ x_set_mouse_face_gc (struct glyph_string *s)
Faces to use in the mode line have already been computed when the
matrix was built, so there isn't much to do, here. */
-static inline void
+static void
x_set_mode_line_face_gc (struct glyph_string *s)
{
s->gc = s->face->gc;
@@ -1058,7 +1024,7 @@ x_set_mode_line_face_gc (struct glyph_string *s)
S->stippled_p to a non-zero value if the face of S has a stipple
pattern. */
-static inline void
+static void
x_set_glyph_string_gc (struct glyph_string *s)
{
PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
@@ -1096,14 +1062,14 @@ x_set_glyph_string_gc (struct glyph_string *s)
}
/* GC must have been set. */
- xassert (s->gc != 0);
+ eassert (s->gc != 0);
}
/* Set clipping for output of glyph string S. S may be part of a mode
line or menu if we don't have X toolkit support. */
-static inline void
+static void
x_set_glyph_string_clipping (struct glyph_string *s)
{
XRectangle *r = s->clip;
@@ -1176,7 +1142,7 @@ x_compute_glyph_string_overhangs (struct glyph_string *s)
/* Fill rectangle X, Y, W, H with background color of glyph string S. */
-static inline void
+static void
x_clear_glyph_string_rect (struct glyph_string *s, int x, int y, int w, int h)
{
XGCValues xgcv;
@@ -1444,12 +1410,12 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s)
#ifdef USE_X_TOOLKIT
-static struct frame *x_frame_of_widget (Widget);
static Boolean cvt_string_to_pixel (Display *, XrmValue *, Cardinal *,
XrmValue *, XrmValue *, XtPointer *);
static void cvt_pixel_dtor (XtAppContext, XrmValue *, XtPointer,
XrmValue *, Cardinal *);
+#ifdef USE_LUCID
/* Return the frame on which widget WIDGET is used.. Abort if frame
cannot be determined. */
@@ -1458,7 +1424,7 @@ static struct frame *
x_frame_of_widget (Widget widget)
{
struct x_display_info *dpyinfo;
- Lisp_Object tail;
+ Lisp_Object tail, frame;
struct frame *f;
dpyinfo = x_display_info_for_display (XtDisplay (widget));
@@ -1472,29 +1438,26 @@ x_frame_of_widget (Widget widget)
/* Look for a frame with that top-level widget. Allocate the color
on that frame to get the right gamma correction value. */
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
- if (FRAMEP (XCAR (tail))
- && (f = XFRAME (XCAR (tail)),
- (FRAME_X_P (f)
- && f->output_data.nothing != 1
- && FRAME_X_DISPLAY_INFO (f) == dpyinfo))
- && f->output_data.x->widget == widget)
- return f;
-
- abort ();
+ FOR_EACH_FRAME (tail, frame)
+ {
+ f = XFRAME (frame);
+ if (FRAME_X_P (f)
+ && f->output_data.nothing != 1
+ && FRAME_X_DISPLAY_INFO (f) == dpyinfo
+ && f->output_data.x->widget == widget)
+ return f;
+ }
+ emacs_abort ();
}
-
-#ifdef USE_LUCID
-
/* Allocate a color which is lighter or darker than *PIXEL by FACTOR
or DELTA. Try a color with RGB values multiplied by FACTOR first.
If this produces the same color as PIXEL, try a color where all RGB
values have DELTA added. Return the allocated color in *PIXEL.
DISPLAY is the X display, CMAP is the colormap to operate on.
- Value is non-zero if successful. */
+ Value is true if successful. */
-int
+bool
x_alloc_lighter_color_for_widget (Widget widget, Display *display, Colormap cmap,
unsigned long *pixel, double factor, int delta)
{
@@ -1502,7 +1465,7 @@ x_alloc_lighter_color_for_widget (Widget widget, Display *display, Colormap cmap
return x_alloc_lighter_color (f, display, cmap, pixel, factor, delta);
}
-#endif
+#endif /* USE_LUCID */
/* Structure specifying which arguments should be passed by Xt to
@@ -1697,8 +1660,8 @@ x_query_colors (struct frame *f, XColor *colors, int ncolors)
for (i = 0; i < ncolors; ++i)
{
unsigned long pixel = colors[i].pixel;
- xassert (pixel < dpyinfo->ncolor_cells);
- xassert (dpyinfo->color_cells[pixel].pixel == pixel);
+ eassert (pixel < dpyinfo->ncolor_cells);
+ eassert (dpyinfo->color_cells[pixel].pixel == pixel);
colors[i] = dpyinfo->color_cells[pixel];
}
}
@@ -1719,15 +1682,15 @@ x_query_color (struct frame *f, XColor *color)
/* Allocate the color COLOR->pixel on DISPLAY, colormap CMAP. If an
exact match can't be allocated, try the nearest color available.
- Value is non-zero if successful. Set *COLOR to the color
+ Value is true if successful. Set *COLOR to the color
allocated. */
-static int
+static bool
x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color)
{
- int rc;
+ bool rc;
- rc = XAllocColor (dpy, cmap, color);
+ rc = XAllocColor (dpy, cmap, color) != 0;
if (rc == 0)
{
/* If we got to this point, the colormap is full, so we're going
@@ -1758,7 +1721,7 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color)
color->red = cells[nearest].red;
color->green = cells[nearest].green;
color->blue = cells[nearest].blue;
- rc = XAllocColor (dpy, cmap, color);
+ rc = XAllocColor (dpy, cmap, color) != 0;
}
else
{
@@ -1791,10 +1754,10 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color)
/* Allocate the color COLOR->pixel on frame F, colormap CMAP. If an
exact match can't be allocated, try the nearest color available.
- Value is non-zero if successful. Set *COLOR to the color
+ Value is true if successful. Set *COLOR to the color
allocated. */
-int
+bool
x_alloc_nearest_color (struct frame *f, Colormap cmap, XColor *color)
{
gamma_correct (f, color);
@@ -1812,10 +1775,10 @@ x_copy_color (struct frame *f, long unsigned int pixel)
XColor color;
color.pixel = pixel;
- BLOCK_INPUT;
+ block_input ();
x_query_color (f, &color);
XAllocColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), &color);
- UNBLOCK_INPUT;
+ unblock_input ();
#ifdef DEBUG_X_COLORS
register_color (pixel);
#endif
@@ -1844,19 +1807,19 @@ x_copy_color (struct frame *f, long unsigned int pixel)
DISPLAY is the X display, CMAP is the colormap to operate on.
Value is non-zero if successful. */
-static int
+static bool
x_alloc_lighter_color (struct frame *f, Display *display, Colormap cmap, long unsigned int *pixel, double factor, int delta)
{
XColor color, new;
long bright;
- int success_p;
+ bool success_p;
/* Get RGB color values. */
color.pixel = *pixel;
x_query_color (f, &color);
/* Change RGB values by specified FACTOR. Avoid overflow! */
- xassert (factor >= 0);
+ eassert (factor >= 0);
new.red = min (0xffff, factor * color.red);
new.green = min (0xffff, factor * color.green);
new.blue = min (0xffff, factor * color.blue);
@@ -2292,7 +2255,8 @@ x_draw_image_foreground (struct glyph_string *s)
static void
x_draw_image_relief (struct glyph_string *s)
{
- int x0, y0, x1, y1, thick, raised_p, extra;
+ int x0, y0, x1, y1, thick, raised_p;
+ int extra_x, extra_y;
XRectangle r;
int x = s->x;
int y = s->ybase - image_ascent (s->img, s->face, &s->slice);
@@ -2323,13 +2287,24 @@ x_draw_image_relief (struct glyph_string *s)
raised_p = s->img->relief > 0;
}
- extra = s->face->id == TOOL_BAR_FACE_ID
- ? XINT (Vtool_bar_button_margin) : 0;
+ extra_x = extra_y = 0;
+ if (s->face->id == TOOL_BAR_FACE_ID)
+ {
+ if (CONSP (Vtool_bar_button_margin)
+ && INTEGERP (XCAR (Vtool_bar_button_margin))
+ && INTEGERP (XCDR (Vtool_bar_button_margin)))
+ {
+ extra_x = XINT (XCAR (Vtool_bar_button_margin));
+ extra_y = XINT (XCDR (Vtool_bar_button_margin));
+ }
+ else if (INTEGERP (Vtool_bar_button_margin))
+ extra_x = extra_y = XINT (Vtool_bar_button_margin);
+ }
- x0 = x - thick - extra;
- y0 = y - thick - extra;
- x1 = x + s->slice.width + thick - 1 + extra;
- y1 = y + s->slice.height + thick - 1 + extra;
+ x0 = x - thick - extra_x;
+ y0 = y - thick - extra_y;
+ x1 = x + s->slice.width + thick - 1 + extra_x;
+ y1 = y + s->slice.height + thick - 1 + extra_y;
x_setup_relief_colors (s);
get_glyph_string_clip_rect (s, &r);
@@ -2556,7 +2531,7 @@ x_draw_image_glyph_string (struct glyph_string *s)
static void
x_draw_stretch_glyph_string (struct glyph_string *s)
{
- xassert (s->first_glyph->type == STRETCH_GLYPH);
+ eassert (s->first_glyph->type == STRETCH_GLYPH);
if (s->hl == DRAW_CURSOR
&& !x_stretch_cursor_p)
@@ -2653,6 +2628,68 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
s->background_filled_p = 1;
}
+/*
+ Draw a wavy line under S. The wave fills wave_height pixels from y0.
+
+ x0 wave_length = 2
+ --
+ y0 * * * * *
+ |* * * * * * * * *
+ wave_height = 3 | * * * *
+
+*/
+
+static void
+x_draw_underwave (struct glyph_string *s)
+{
+ int wave_height = 2, wave_length = 3;
+ int dx, dy, x0, y0, width, x1, y1, x2, y2, odd, xmax;
+ XRectangle wave_clip, string_clip, final_clip;
+
+ dx = wave_length;
+ dy = wave_height - 1;
+ x0 = s->x;
+ y0 = s->ybase + 1;
+ width = s->width;
+ xmax = x0 + width;
+
+ /* Find and set clipping rectangle */
+
+ wave_clip = (XRectangle){ x0, y0, width, wave_height };
+ get_glyph_string_clip_rect (s, &string_clip);
+
+ if (!x_intersect_rectangles (&wave_clip, &string_clip, &final_clip))
+ return;
+
+ XSetClipRectangles (s->display, s->gc, 0, 0, &final_clip, 1, Unsorted);
+
+ /* Draw the waves */
+
+ x1 = x0 - (x0 % dx);
+ x2 = x1 + dx;
+ odd = (x1/dx) % 2;
+ y1 = y2 = y0;
+
+ if (odd)
+ y1 += dy;
+ else
+ y2 += dy;
+
+ if (INT_MAX - dx < xmax)
+ emacs_abort ();
+
+ while (x1 <= xmax)
+ {
+ XDrawLine (s->display, s->window, s->gc, x1, y1, x2, y2);
+ x1 = x2, y1 = y2;
+ x2 += dx, y2 = y0 + odd*dy;
+ odd = !odd;
+ }
+
+ /* Restore previous clipping rectangle(s) */
+ XSetClipRectangles (s->display, s->gc, 0, 0, s->clip, s->num_clips, Unsorted);
+}
+
/* Draw glyph string S. */
@@ -2748,75 +2785,90 @@ x_draw_glyph_string (struct glyph_string *s)
break;
default:
- abort ();
+ emacs_abort ();
}
if (!s->for_overlaps)
{
/* Draw underline. */
if (s->face->underline_p)
- {
- unsigned long thickness, position;
- int y;
-
- if (s->prev && s->prev->face->underline_p)
- {
- /* We use the same underline style as the previous one. */
- thickness = s->prev->underline_thickness;
- position = s->prev->underline_position;
- }
- else
- {
- /* Get the underline thickness. Default is 1 pixel. */
- if (s->font && s->font->underline_thickness > 0)
- thickness = s->font->underline_thickness;
- else
- thickness = 1;
- if (x_underline_at_descent_line)
- position = (s->height - thickness) - (s->ybase - s->y);
- else
- {
- /* Get the underline position. This is the recommended
- vertical offset in pixels from the baseline to the top of
- the underline. This is a signed value according to the
- specs, and its default is
-
- ROUND ((maximum descent) / 2), with
- ROUND(x) = floor (x + 0.5) */
-
- if (x_use_underline_position_properties
- && s->font && s->font->underline_position >= 0)
- position = s->font->underline_position;
- else if (s->font)
- position = (s->font->descent + 1) / 2;
- else
- position = underline_minimum_offset;
- }
- position = max (position, underline_minimum_offset);
- }
- /* Check the sanity of thickness and position. We should
- avoid drawing underline out of the current line area. */
- if (s->y + s->height <= s->ybase + position)
- position = (s->height - 1) - (s->ybase - s->y);
- if (s->y + s->height < s->ybase + position + thickness)
- thickness = (s->y + s->height) - (s->ybase + position);
- s->underline_thickness = thickness;
- s->underline_position = position;
- y = s->ybase + position;
- if (s->face->underline_defaulted_p)
- XFillRectangle (s->display, s->window, s->gc,
- s->x, y, s->width, thickness);
- else
- {
- XGCValues xgcv;
- XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
- XSetForeground (s->display, s->gc, s->face->underline_color);
- XFillRectangle (s->display, s->window, s->gc,
- s->x, y, s->width, thickness);
- XSetForeground (s->display, s->gc, xgcv.foreground);
- }
- }
+ {
+ if (s->face->underline_type == FACE_UNDER_WAVE)
+ {
+ if (s->face->underline_defaulted_p)
+ x_draw_underwave (s);
+ else
+ {
+ XGCValues xgcv;
+ XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
+ XSetForeground (s->display, s->gc, s->face->underline_color);
+ x_draw_underwave (s);
+ XSetForeground (s->display, s->gc, xgcv.foreground);
+ }
+ }
+ else if (s->face->underline_type == FACE_UNDER_LINE)
+ {
+ unsigned long thickness, position;
+ int y;
+ if (s->prev && s->prev->face->underline_p)
+ {
+ /* We use the same underline style as the previous one. */
+ thickness = s->prev->underline_thickness;
+ position = s->prev->underline_position;
+ }
+ else
+ {
+ /* Get the underline thickness. Default is 1 pixel. */
+ if (s->font && s->font->underline_thickness > 0)
+ thickness = s->font->underline_thickness;
+ else
+ thickness = 1;
+ if (x_underline_at_descent_line)
+ position = (s->height - thickness) - (s->ybase - s->y);
+ else
+ {
+ /* Get the underline position. This is the recommended
+ vertical offset in pixels from the baseline to the top of
+ the underline. This is a signed value according to the
+ specs, and its default is
+
+ ROUND ((maximum descent) / 2), with
+ ROUND(x) = floor (x + 0.5) */
+
+ if (x_use_underline_position_properties
+ && s->font && s->font->underline_position >= 0)
+ position = s->font->underline_position;
+ else if (s->font)
+ position = (s->font->descent + 1) / 2;
+ else
+ position = underline_minimum_offset;
+ }
+ position = max (position, underline_minimum_offset);
+ }
+ /* Check the sanity of thickness and position. We should
+ avoid drawing underline out of the current line area. */
+ if (s->y + s->height <= s->ybase + position)
+ position = (s->height - 1) - (s->ybase - s->y);
+ if (s->y + s->height < s->ybase + position + thickness)
+ thickness = (s->y + s->height) - (s->ybase + position);
+ s->underline_thickness = thickness;
+ s->underline_position = position;
+ y = s->ybase + position;
+ if (s->face->underline_defaulted_p)
+ XFillRectangle (s->display, s->window, s->gc,
+ s->x, y, s->width, thickness);
+ else
+ {
+ XGCValues xgcv;
+ XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
+ XSetForeground (s->display, s->gc, s->face->underline_color);
+ XFillRectangle (s->display, s->window, s->gc,
+ s->x, y, s->width, thickness);
+ XSetForeground (s->display, s->gc, xgcv.foreground);
+ }
+ }
+ }
/* Draw overline. */
if (s->face->overline_p)
{
@@ -2907,6 +2959,7 @@ x_draw_glyph_string (struct glyph_string *s)
XSetClipMask (next->display, next->gc, None);
next->hl = save;
next->num_clips = 0;
+ next->clip_head = s->next;
}
}
}
@@ -2933,7 +2986,7 @@ x_shift_glyphs_for_insert (struct frame *f, int x, int y, int width, int height,
static void
x_delete_glyphs (struct frame *f, register int n)
{
- abort ();
+ emacs_abort ();
}
@@ -2943,7 +2996,7 @@ x_delete_glyphs (struct frame *f, register int n)
void
x_clear_area (Display *dpy, Window window, int x, int y, int width, int height, int exposures)
{
- xassert (width > 0 && height > 0);
+ eassert (width > 0 && height > 0);
XClearArea (dpy, window, x, y, width, height, exposures);
}
@@ -2961,7 +3014,7 @@ x_clear_frame (struct frame *f)
/* We don't set the output cursor here because there will always
follow an explicit cursor_to. */
- BLOCK_INPUT;
+ block_input ();
XClearWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
@@ -2978,55 +3031,17 @@ x_clear_frame (struct frame *f)
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Invert the middle quarter of the frame for .15 sec. */
-/* We use the select system call to do the waiting, so we have to make
- sure it's available. If it isn't, we just won't do visual bells. */
-
-#if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT)
-
-
-/* Subtract the `struct timeval' values X and Y, storing the result in
- *RESULT. Return 1 if the difference is negative, otherwise 0. */
-
-static int
-timeval_subtract (struct timeval *result, struct timeval x, struct timeval y)
-{
- /* Perform the carry for the later subtraction by updating y. This
- is safer because on some systems the tv_sec member is unsigned. */
- if (x.tv_usec < y.tv_usec)
- {
- int nsec = (y.tv_usec - x.tv_usec) / 1000000 + 1;
- y.tv_usec -= 1000000 * nsec;
- y.tv_sec += nsec;
- }
-
- if (x.tv_usec - y.tv_usec > 1000000)
- {
- int nsec = (y.tv_usec - x.tv_usec) / 1000000;
- y.tv_usec += 1000000 * nsec;
- y.tv_sec -= nsec;
- }
-
- /* Compute the time remaining to wait. tv_usec is certainly
- positive. */
- result->tv_sec = x.tv_sec - y.tv_sec;
- result->tv_usec = x.tv_usec - y.tv_usec;
-
- /* Return indication of whether the result should be considered
- negative. */
- return x.tv_sec < y.tv_sec;
-}
-
static void
XTflash (struct frame *f)
{
- BLOCK_INPUT;
+ block_input ();
{
#ifdef USE_GTK
@@ -3123,34 +3138,25 @@ XTflash (struct frame *f)
x_flush (f);
{
- struct timeval wakeup;
-
- EMACS_GET_TIME (wakeup);
-
- /* Compute time to wait until, propagating carry from usecs. */
- wakeup.tv_usec += 150000;
- wakeup.tv_sec += (wakeup.tv_usec / 1000000);
- wakeup.tv_usec %= 1000000;
+ EMACS_TIME delay = make_emacs_time (0, 150 * 1000 * 1000);
+ EMACS_TIME wakeup = add_emacs_time (current_emacs_time (), delay);
/* Keep waiting until past the time wakeup or any input gets
available. */
while (! detect_input_pending ())
{
- struct timeval current;
- struct timeval timeout;
+ EMACS_TIME current = current_emacs_time ();
+ EMACS_TIME timeout;
- EMACS_GET_TIME (current);
-
- /* Break if result would be negative. */
- if (timeval_subtract (&current, wakeup, current))
+ /* Break if result would not be positive. */
+ if (EMACS_TIME_LE (wakeup, current))
break;
/* How long `select' should wait. */
- timeout.tv_sec = 0;
- timeout.tv_usec = 10000;
+ timeout = make_emacs_time (0, 10 * 1000 * 1000);
/* Try to wait that long--but we might wake up sooner. */
- select (0, NULL, NULL, NULL, &timeout);
+ pselect (0, NULL, NULL, NULL, &timeout, NULL);
}
}
@@ -3188,16 +3194,14 @@ XTflash (struct frame *f)
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
-#endif /* defined (HAVE_TIMEVAL) && defined (HAVE_SELECT) */
-
static void
XTtoggle_invisible_pointer (FRAME_PTR f, int invisible)
{
- BLOCK_INPUT;
+ block_input ();
if (invisible)
{
if (FRAME_X_DISPLAY_INFO (f)->invisible_cursor != 0)
@@ -3208,7 +3212,7 @@ XTtoggle_invisible_pointer (FRAME_PTR f, int invisible)
XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
f->output_data.x->current_cursor);
f->pointer_invisible = invisible;
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -3219,16 +3223,14 @@ XTring_bell (struct frame *f)
{
if (FRAME_X_DISPLAY (f))
{
-#if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT)
if (visible_bell)
XTflash (f);
else
-#endif
{
- BLOCK_INPUT;
+ block_input ();
XBell (FRAME_X_DISPLAY (f), 0);
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
}
@@ -3257,7 +3259,7 @@ XTset_terminal_window (struct frame *f, int n)
static void
x_ins_del_lines (struct frame *f, int vpos, int n)
{
- abort ();
+ emacs_abort ();
}
@@ -3325,7 +3327,7 @@ x_scroll_run (struct window *w, struct run *run)
height = run->height;
}
- BLOCK_INPUT;
+ block_input ();
/* Cursor off. Will be switched on again in x_update_window_end. */
updated_window = w;
@@ -3338,7 +3340,7 @@ x_scroll_run (struct window *w, struct run *run)
width, height,
x, to_y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -3355,7 +3357,7 @@ frame_highlight (struct frame *f)
the ICCCM (section 4.1.6) says that the window's border pixmap
and border pixel are window attributes which are "private to the
client", so we can always change it to whatever we want. */
- BLOCK_INPUT;
+ block_input ();
/* I recently started to get errors in this XSetWindowBorder, depending on
the window-manager in use, tho something more is at play since I've been
using that same window-manager binary for ever. Let's not crash just
@@ -3364,7 +3366,7 @@ frame_highlight (struct frame *f)
XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
f->output_data.x->border_pixel);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
x_update_cursor (f, 1);
x_set_frame_alpha (f);
}
@@ -3376,13 +3378,13 @@ frame_unhighlight (struct frame *f)
the ICCCM (section 4.1.6) says that the window's border pixmap
and border pixel are window attributes which are "private to the
client", so we can always change it to whatever we want. */
- BLOCK_INPUT;
+ block_input ();
/* Same as above for XSetWindowBorder (bug#9310). */
x_catch_errors (FRAME_X_DISPLAY (f));
XSetWindowBorderPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
f->output_data.x->border_tile);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
x_update_cursor (f, 1);
x_set_frame_alpha (f);
}
@@ -3432,7 +3434,8 @@ x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct fra
/* Don't stop displaying the initial startup message
for a switch-frame event we don't need. */
- if (NILP (Vterminal_frame)
+ /* When run as a daemon, Vterminal_frame is always NIL. */
+ if ((NILP (Vterminal_frame) || EQ (Fdaemonp(), Qt))
&& CONSP (Vframe_list)
&& !NILP (XCDR (Vframe_list)))
{
@@ -3556,7 +3559,7 @@ x_frame_rehighlight (struct x_display_info *dpyinfo)
: dpyinfo->x_focus_frame);
if (! FRAME_LIVE_P (dpyinfo->x_highlight_frame))
{
- FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame) = Qnil;
+ fset_focus_frame (dpyinfo->x_focus_frame, Qnil);
dpyinfo->x_highlight_frame = dpyinfo->x_focus_frame;
}
}
@@ -3681,31 +3684,30 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo)
dpyinfo->alt_mod_mask &= ~dpyinfo->meta_mod_mask;
}
- XFree ((char *) syms);
+ XFree (syms);
XFreeModifiermap (mods);
}
/* Convert between the modifier bits X uses and the modifier bits
Emacs uses. */
-EMACS_INT
+int
x_x_to_emacs_modifiers (struct x_display_info *dpyinfo, int state)
{
- EMACS_INT mod_meta = meta_modifier;
- EMACS_INT mod_alt = alt_modifier;
- EMACS_INT mod_hyper = hyper_modifier;
- EMACS_INT mod_super = super_modifier;
+ int mod_meta = meta_modifier;
+ int mod_alt = alt_modifier;
+ int mod_hyper = hyper_modifier;
+ int mod_super = super_modifier;
Lisp_Object tem;
tem = Fget (Vx_alt_keysym, Qmodifier_value);
- if (INTEGERP (tem)) mod_alt = XINT (tem);
+ if (INTEGERP (tem)) mod_alt = XINT (tem) & INT_MAX;
tem = Fget (Vx_meta_keysym, Qmodifier_value);
- if (INTEGERP (tem)) mod_meta = XINT (tem);
+ if (INTEGERP (tem)) mod_meta = XINT (tem) & INT_MAX;
tem = Fget (Vx_hyper_keysym, Qmodifier_value);
- if (INTEGERP (tem)) mod_hyper = XINT (tem);
+ if (INTEGERP (tem)) mod_hyper = XINT (tem) & INT_MAX;
tem = Fget (Vx_super_keysym, Qmodifier_value);
- if (INTEGERP (tem)) mod_super = XINT (tem);
-
+ if (INTEGERP (tem)) mod_super = XINT (tem) & INT_MAX;
return ( ((state & (ShiftMask | dpyinfo->shift_lock_mask)) ? shift_modifier : 0)
| ((state & ControlMask) ? ctrl_modifier : 0)
@@ -3718,10 +3720,10 @@ x_x_to_emacs_modifiers (struct x_display_info *dpyinfo, int state)
static int
x_emacs_to_x_modifiers (struct x_display_info *dpyinfo, EMACS_INT state)
{
- int mod_meta = meta_modifier;
- int mod_alt = alt_modifier;
- int mod_hyper = hyper_modifier;
- int mod_super = super_modifier;
+ EMACS_INT mod_meta = meta_modifier;
+ EMACS_INT mod_alt = alt_modifier;
+ EMACS_INT mod_hyper = hyper_modifier;
+ EMACS_INT mod_super = super_modifier;
Lisp_Object tem;
@@ -3750,9 +3752,9 @@ x_get_keysym_name (int keysym)
{
char *value;
- BLOCK_INPUT;
+ block_input ();
value = XKeysymToString (keysym);
- UNBLOCK_INPUT;
+ unblock_input ();
return value;
}
@@ -3882,7 +3884,7 @@ XTmouse_position (FRAME_PTR *fp, int insist, Lisp_Object *bar_window,
{
FRAME_PTR f1;
- BLOCK_INPUT;
+ block_input ();
if (! NILP (last_mouse_scroll_bar) && insist == 0)
x_scroll_bar_report_motion (fp, bar_window, part, x, y, timestamp);
@@ -4063,7 +4065,7 @@ XTmouse_position (FRAME_PTR *fp, int insist, Lisp_Object *bar_window,
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -4082,20 +4084,15 @@ XTmouse_position (FRAME_PTR *fp, int insist, Lisp_Object *bar_window,
static struct scroll_bar *
x_window_to_scroll_bar (Display *display, Window window_id)
{
- Lisp_Object tail;
+ Lisp_Object tail, frame;
#if defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS)
window_id = (Window) xg_get_scroll_id_for_window (display, window_id);
#endif /* USE_GTK && USE_TOOLKIT_SCROLL_BARS */
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_FRAME (tail, frame)
{
- Lisp_Object frame, bar, condemned;
-
- frame = XCAR (tail);
- /* All elements of Vframe_list should be frames. */
- if (! FRAMEP (frame))
- abort ();
+ Lisp_Object bar, condemned;
if (! FRAME_X_P (XFRAME (frame)))
continue;
@@ -4127,20 +4124,16 @@ x_window_to_scroll_bar (Display *display, Window window_id)
static Widget
x_window_to_menu_bar (Window window)
{
- Lisp_Object tail;
-
- for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
- {
- if (FRAME_X_P (XFRAME (XCAR (tail))))
- {
- Lisp_Object frame = XCAR (tail);
- Widget menu_bar = XFRAME (frame)->output_data.x->menubar_widget;
+ Lisp_Object tail, frame;
- if (menu_bar && xlwmenu_window_p (menu_bar, window))
- return menu_bar;
- }
- }
+ FOR_EACH_FRAME (tail, frame)
+ if (FRAME_X_P (XFRAME (frame)))
+ {
+ Widget menu_bar = XFRAME (frame)->output_data.x->menubar_widget;
+ if (menu_bar && xlwmenu_window_p (menu_bar, window))
+ return menu_bar;
+ }
return NULL;
}
@@ -4252,7 +4245,7 @@ x_send_scroll_bar_event (Lisp_Object window, int part, int portion, int whole)
struct frame *f = XFRAME (w->frame);
ptrdiff_t i;
- BLOCK_INPUT;
+ block_input ();
/* Construct a ClientMessage event to send to the frame. */
ev->type = ClientMessage;
@@ -4299,7 +4292,7 @@ x_send_scroll_bar_event (Lisp_Object window, int part, int portion, int whole)
be sent to the client that created the window, and if that
window no longer exists, no event will be sent. */
XSendEvent (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), False, 0, &event);
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -4390,9 +4383,9 @@ xm_scroll_callback (Widget widget, XtPointer client_data, XtPointer call_data)
int slider_size;
/* Get the slider size. */
- BLOCK_INPUT;
+ block_input ();
XtVaGetValues (widget, XmNsliderSize, &slider_size, NULL);
- UNBLOCK_INPUT;
+ unblock_input ();
whole = XM_SB_MAX - slider_size;
portion = min (cs->value, whole);
@@ -4513,14 +4506,14 @@ xaw_jump_callback (Widget widget, XtPointer client_data, XtPointer call_data)
int part;
/* Get the size of the thumb, a value between 0 and 1. */
- BLOCK_INPUT;
+ block_input ();
XtVaGetValues (widget, XtNshown, &shown, XtNheight, &height, NULL);
- UNBLOCK_INPUT;
+ unblock_input ();
whole = 10000000;
portion = shown < 1 ? top * whole : 0;
- if (shown < 1 && (eabs (top + shown - 1) < 1.0/height))
+ if (shown < 1 && (eabs (top + shown - 1) < 1.0f / height))
/* Some derivatives of Xaw refuse to shrink the thumb when you reach
the bottom, so we force the scrolling whenever we see that we're
too close to the bottom (in x_set_toolkit_scroll_bar_thumb
@@ -4555,9 +4548,9 @@ xaw_scroll_callback (Widget widget, XtPointer client_data, XtPointer call_data)
int part;
/* Get the height of the scroll bar. */
- BLOCK_INPUT;
+ block_input ();
XtVaGetValues (widget, XtNheight, &height, NULL);
- UNBLOCK_INPUT;
+ unblock_input ();
if (eabs (position) >= height)
part = (position < 0) ? scroll_bar_above_handle : scroll_bar_below_handle;
@@ -4588,11 +4581,11 @@ x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar)
{
const char *scroll_bar_name = SCROLL_BAR_NAME;
- BLOCK_INPUT;
+ block_input ();
xg_create_scroll_bar (f, bar, G_CALLBACK (xg_scroll_callback),
G_CALLBACK (xg_end_scroll_callback),
scroll_bar_name);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#else /* not USE_GTK */
@@ -4604,10 +4597,10 @@ x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar)
Widget widget;
Arg av[20];
int ac = 0;
- char const *scroll_bar_name = SCROLL_BAR_NAME;
+ const char *scroll_bar_name = SCROLL_BAR_NAME;
unsigned long pixel;
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_MOTIF
/* Set resources. Create the widget. */
@@ -4634,7 +4627,7 @@ x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar)
}
widget = XmCreateScrollBar (f->output_data.x->edit_widget,
- scroll_bar_name, av, ac);
+ (char *) scroll_bar_name, av, ac);
/* Add one callback for everything that can happen. */
XtAddCallback (widget, XmNdecrementCallback, xm_scroll_callback,
@@ -4791,7 +4784,7 @@ x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar)
xwindow = XtWindow (widget);
bar->x_window = xwindow;
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* not USE_GTK */
@@ -4815,7 +4808,7 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio
Widget widget = SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar);
float top, shown;
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_MOTIF
@@ -4885,7 +4878,7 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio
else
top = old_top;
/* Keep two pixels available for moving the thumb down. */
- shown = max (0, min (1 - top - (2.0 / height), shown));
+ shown = max (0, min (1 - top - (2.0f / height), shown));
/* If the call to XawScrollbarSetThumb below doesn't seem to work,
check that your system's configuration file contains a define
@@ -4906,7 +4899,7 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio
}
#endif /* !USE_MOTIF */
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* not USE_GTK */
@@ -4929,8 +4922,9 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height)
struct frame *f = XFRAME (w->frame);
struct scroll_bar *bar
= ALLOCATE_PSEUDOVECTOR (struct scroll_bar, x_window, PVEC_OTHER);
+ Lisp_Object barobj;
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_TOOLKIT_SCROLL_BARS
x_create_toolkit_scroll_bar (f, bar);
@@ -4989,7 +4983,8 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height)
/* Add bar to its frame's list of scroll bars. */
bar->next = FRAME_SCROLL_BARS (f);
bar->prev = Qnil;
- XSETVECTOR (FRAME_SCROLL_BARS (f), bar);
+ XSETVECTOR (barobj, bar);
+ fset_scroll_bars (f, barobj);
if (!NILP (bar->next))
XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar);
@@ -5017,7 +5012,7 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height)
XMapRaised (FRAME_X_DISPLAY (f), bar->x_window);
#endif /* not USE_TOOLKIT_SCROLL_BARS */
- UNBLOCK_INPUT;
+ unblock_input ();
return bar;
}
@@ -5051,7 +5046,7 @@ x_scroll_bar_set_handle (struct scroll_bar *bar, int start, int end, int rebuild
&& end == bar->end)
return;
- BLOCK_INPUT;
+ block_input ();
{
int inside_width = VERTICAL_SCROLL_BAR_INSIDE_WIDTH (f, bar->width);
@@ -5127,7 +5122,7 @@ x_scroll_bar_set_handle (struct scroll_bar *bar, int start, int end, int rebuild
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* !USE_TOOLKIT_SCROLL_BARS */
@@ -5139,7 +5134,7 @@ static void
x_scroll_bar_remove (struct scroll_bar *bar)
{
struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window)));
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_TOOLKIT_SCROLL_BARS
#ifdef USE_GTK
@@ -5152,9 +5147,9 @@ x_scroll_bar_remove (struct scroll_bar *bar)
#endif
/* Dissociate this scroll bar from its window. */
- XWINDOW (bar->window)->vertical_scroll_bar = Qnil;
+ wset_vertical_scroll_bar (XWINDOW (bar->window), Qnil);
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -5167,6 +5162,7 @@ static void
XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int position)
{
struct frame *f = XFRAME (w->frame);
+ Lisp_Object barobj;
struct scroll_bar *bar;
int top, height, left, sb_left, width, sb_width;
int window_y, window_height;
@@ -5221,7 +5217,7 @@ XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int positio
{
if (width > 0 && height > 0)
{
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_TOOLKIT_SCROLL_BARS
if (fringe_extended_p)
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
@@ -5230,7 +5226,7 @@ XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int positio
#endif
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
left, top, width, height, False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
bar = x_scroll_bar_create (w, top, sb_left, sb_width, height);
@@ -5242,7 +5238,7 @@ XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int positio
bar = XSCROLL_BAR (w->vertical_scroll_bar);
- BLOCK_INPUT;
+ block_input ();
if (sb_left != bar->left)
mask |= CWX;
@@ -5339,7 +5335,7 @@ XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int positio
bar->width = sb_width;
bar->height = height;
- UNBLOCK_INPUT;
+ unblock_input ();
}
#ifdef USE_TOOLKIT_SCROLL_BARS
@@ -5364,7 +5360,8 @@ XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int positio
}
#endif /* not USE_TOOLKIT_SCROLL_BARS */
- XSETVECTOR (w->vertical_scroll_bar, bar);
+ XSETVECTOR (barobj, bar);
+ wset_vertical_scroll_bar (w, barobj);
}
@@ -5388,12 +5385,12 @@ XTcondemn_scroll_bars (FRAME_PTR frame)
{
Lisp_Object bar;
bar = FRAME_SCROLL_BARS (frame);
- FRAME_SCROLL_BARS (frame) = XSCROLL_BAR (bar)->next;
+ fset_scroll_bars (frame, XSCROLL_BAR (bar)->next);
XSCROLL_BAR (bar)->next = FRAME_CONDEMNED_SCROLL_BARS (frame);
XSCROLL_BAR (bar)->prev = Qnil;
if (! NILP (FRAME_CONDEMNED_SCROLL_BARS (frame)))
XSCROLL_BAR (FRAME_CONDEMNED_SCROLL_BARS (frame))->prev = bar;
- FRAME_CONDEMNED_SCROLL_BARS (frame) = bar;
+ fset_condemned_scroll_bars (frame, bar);
}
}
@@ -5406,10 +5403,11 @@ XTredeem_scroll_bar (struct window *window)
{
struct scroll_bar *bar;
struct frame *f;
+ Lisp_Object barobj;
/* We can't redeem this window's scroll bar if it doesn't have one. */
if (NILP (window->vertical_scroll_bar))
- abort ();
+ emacs_abort ();
bar = XSCROLL_BAR (window->vertical_scroll_bar);
@@ -5424,11 +5422,11 @@ XTredeem_scroll_bar (struct window *window)
return;
else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f),
window->vertical_scroll_bar))
- FRAME_CONDEMNED_SCROLL_BARS (f) = bar->next;
+ fset_condemned_scroll_bars (f, bar->next);
else
/* If its prev pointer is nil, it must be at the front of
one or the other! */
- abort ();
+ emacs_abort ();
}
else
XSCROLL_BAR (bar->prev)->next = bar->next;
@@ -5438,7 +5436,8 @@ XTredeem_scroll_bar (struct window *window)
bar->next = FRAME_SCROLL_BARS (f);
bar->prev = Qnil;
- XSETVECTOR (FRAME_SCROLL_BARS (f), bar);
+ XSETVECTOR (barobj, bar);
+ fset_scroll_bars (f, barobj);
if (! NILP (bar->next))
XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar);
}
@@ -5455,7 +5454,7 @@ XTjudge_scroll_bars (FRAME_PTR f)
/* Clear out the condemned list now so we won't try to process any
more events on the hapless scroll bars. */
- FRAME_CONDEMNED_SCROLL_BARS (f) = Qnil;
+ fset_condemned_scroll_bars (f, Qnil);
for (; ! NILP (bar); bar = next)
{
@@ -5487,7 +5486,7 @@ x_scroll_bar_expose (struct scroll_bar *bar, XEvent *event)
GC gc = f->output_data.x->normal_gc;
int width_trim = VERTICAL_SCROLL_BAR_WIDTH_TRIM;
- BLOCK_INPUT;
+ block_input ();
x_scroll_bar_set_handle (bar, bar->start, bar->end, 1);
@@ -5509,7 +5508,7 @@ x_scroll_bar_expose (struct scroll_bar *bar, XEvent *event)
XSetForeground (FRAME_X_DISPLAY (f), gc,
FRAME_FOREGROUND_PIXEL (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* not USE_TOOLKIT_SCROLL_BARS */
@@ -5525,7 +5524,7 @@ static void
x_scroll_bar_handle_click (struct scroll_bar *bar, XEvent *event, struct input_event *emacs_event)
{
if (! WINDOWP (bar->window))
- abort ();
+ emacs_abort ();
emacs_event->kind = SCROLL_BAR_CLICK_EVENT;
emacs_event->code = event->xbutton.button - Button1;
@@ -5622,7 +5621,7 @@ x_scroll_bar_report_motion (FRAME_PTR *fp, Lisp_Object *bar_window,
int dummy_coord;
unsigned int dummy_mask;
- BLOCK_INPUT;
+ block_input ();
/* Get the mouse's position relative to the scroll bar window, and
report that. */
@@ -5674,7 +5673,7 @@ x_scroll_bar_report_motion (FRAME_PTR *fp, Lisp_Object *bar_window,
*timestamp = last_mouse_movement_time;
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -5742,9 +5741,9 @@ static struct x_display_info *next_noop_dpyinfo;
do \
{ \
if (f->output_data.x->saved_menu_event == 0) \
- f->output_data.x->saved_menu_event \
- = (XEvent *) xmalloc (sizeof (XEvent)); \
- *f->output_data.x->saved_menu_event = event; \
+ f->output_data.x->saved_menu_event = \
+ xmalloc (sizeof (XEvent)); \
+ *f->output_data.x->saved_menu_event = event; \
inev.ie.kind = MENU_BAR_ACTIVATE_EVENT; \
XSETFRAME (inev.ie.frame_or_window, f); \
} \
@@ -5795,7 +5794,7 @@ event_handler_gdk (GdkXEvent *gxev, GdkEvent *ev, gpointer data)
{
XEvent *xev = (XEvent *) gxev;
- BLOCK_INPUT;
+ block_input ();
if (current_count >= 0)
{
struct x_display_info *dpyinfo;
@@ -5810,7 +5809,7 @@ event_handler_gdk (GdkXEvent *gxev, GdkEvent *ev, gpointer data)
&& dpyinfo
&& x_filter_event (dpyinfo, xev))
{
- UNBLOCK_INPUT;
+ unblock_input ();
return GDK_FILTER_REMOVE;
}
#endif
@@ -5825,7 +5824,7 @@ event_handler_gdk (GdkXEvent *gxev, GdkEvent *ev, gpointer data)
else
current_finish = x_dispatch_event (xev, xev->xany.display);
- UNBLOCK_INPUT;
+ unblock_input ();
if (current_finish == X_EVENT_GOTO_OUT || current_finish == X_EVENT_DROP)
return GDK_FILTER_REMOVE;
@@ -6086,7 +6085,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr,
SELECTION_EVENT_DISPLAY (&inev.sie) = eventp->display;
SELECTION_EVENT_SELECTION (&inev.sie) = eventp->selection;
SELECTION_EVENT_TIME (&inev.sie) = eventp->time;
- inev.ie.frame_or_window = Qnil;
}
break;
@@ -6106,7 +6104,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr,
SELECTION_EVENT_TARGET (&inev.sie) = eventp->target;
SELECTION_EVENT_PROPERTY (&inev.sie) = eventp->property;
SELECTION_EVENT_TIME (&inev.sie) = eventp->time;
- inev.ie.frame_or_window = Qnil;
}
break;
@@ -6415,7 +6412,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr,
if (status_return == XBufferOverflow)
{
copy_bufsiz = nbytes + 1;
- copy_bufptr = (unsigned char *) alloca (copy_bufsiz);
+ copy_bufptr = alloca (copy_bufsiz);
nbytes = XmbLookupString (FRAME_XIC (f),
&event.xkey, (char *) copy_bufptr,
copy_bufsiz, &keysym,
@@ -6431,7 +6428,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr,
}
else if (status_return != XLookupKeySym
&& status_return != XLookupBoth)
- abort ();
+ emacs_abort ();
}
else
nbytes = XLookupString (&event.xkey, (char *) copy_bufptr,
@@ -6480,9 +6477,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr,
/* Now non-ASCII. */
if (HASH_TABLE_P (Vx_keysym_table)
- && (NATNUMP (c = Fgethash (make_number (keysym),
- Vx_keysym_table,
- Qnil))))
+ && (c = Fgethash (make_number (keysym),
+ Vx_keysym_table,
+ Qnil),
+ NATNUMP (c)))
{
inev.ie.kind = (SINGLE_BYTE_CHAR_P (XFASTINT (c))
? ASCII_KEYSTROKE_EVENT
@@ -7019,10 +7017,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr,
default:
OTHER:
#ifdef USE_X_TOOLKIT
- BLOCK_INPUT;
+ block_input ();
if (*finish != X_EVENT_DROP)
XtDispatchEvent (&event);
- UNBLOCK_INPUT;
+ unblock_input ();
#endif /* USE_X_TOOLKIT */
break;
}
@@ -7087,42 +7085,24 @@ x_dispatch_event (XEvent *event, Display *display)
/* Read events coming from the X server.
- This routine is called by the SIGIO handler.
- We return as soon as there are no more events to be read.
+ Return as soon as there are no more events to be read.
- We return the number of characters stored into the buffer,
+ Return the number of characters stored into the buffer,
thus pretending to be `read' (except the characters we store
in the keyboard buffer can be multibyte, so are not necessarily
- C chars).
-
- EXPECTED is nonzero if the caller knows input is available. */
+ C chars). */
static int
-XTread_socket (struct terminal *terminal, int expected, struct input_event *hold_quit)
+XTread_socket (struct terminal *terminal, struct input_event *hold_quit)
{
int count = 0;
int event_found = 0;
- if (interrupt_input_blocked)
- {
- interrupt_input_pending = 1;
-#ifdef SYNC_INPUT
- pending_signals = 1;
-#endif
- return -1;
- }
-
- interrupt_input_pending = 0;
-#ifdef SYNC_INPUT
- pending_signals = pending_atimers;
-#endif
- BLOCK_INPUT;
+ block_input ();
/* So people can tell when we have read the available input. */
input_signal_count++;
- ++handling_signal;
-
/* For debugging, this gives a way to fake an I/O error. */
if (terminal->display_info.x == XTread_socket_fake_io_error)
{
@@ -7211,8 +7191,7 @@ XTread_socket (struct terminal *terminal, int expected, struct input_event *hold
pending_autoraise_frame = 0;
}
- --handling_signal;
- UNBLOCK_INPUT;
+ unblock_input ();
return count;
}
@@ -7464,7 +7443,7 @@ x_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, int
break;
default:
- abort ();
+ emacs_abort ();
}
}
@@ -7629,7 +7608,7 @@ x_error_catcher (Display *display, XErrorEvent *event)
void
x_catch_errors (Display *dpy)
{
- struct x_error_message_stack *data = xmalloc (sizeof (*data));
+ struct x_error_message_stack *data = xmalloc (sizeof *data);
/* Make sure any errors from previous requests have been dealt with. */
XSync (dpy, False);
@@ -7648,7 +7627,7 @@ x_uncatch_errors (void)
{
struct x_error_message_stack *tmp;
- BLOCK_INPUT;
+ block_input ();
/* The display may have been closed before this function is called.
Check if it is still open before calling XSync. */
@@ -7658,7 +7637,7 @@ x_uncatch_errors (void)
tmp = x_error_message;
x_error_message = x_error_message->prev;
xfree (tmp);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* If any X protocol errors have arrived since the last call to
@@ -7721,24 +7700,6 @@ x_trace_wire (void)
#endif /* ! 0 */
-/* Handle SIGPIPE, which can happen when the connection to a server
- simply goes away. SIGPIPE is handled by x_connection_signal.
- Don't need to do anything, because the write which caused the
- SIGPIPE will fail, causing Xlib to invoke the X IO error handler,
- which will do the appropriate cleanup for us. */
-
-static void
-x_connection_signal (int signalnum) /* If we don't have an argument, */
- /* some compilers complain in signal calls. */
-{
-#ifdef USG
- /* USG systems forget handlers when they are used;
- must reestablish each time */
- signal (signalnum, x_connection_signal);
-#endif /* USG */
-}
-
-
/************************************************************************
Handling X errors
************************************************************************/
@@ -7755,11 +7716,10 @@ x_connection_closed (Display *dpy, const char *error_message)
{
struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
Lisp_Object frame, tail;
- int idx = SPECPDL_INDEX ();
+ ptrdiff_t idx = SPECPDL_INDEX ();
- error_msg = (char *) alloca (strlen (error_message) + 1);
+ error_msg = alloca (strlen (error_message) + 1);
strcpy (error_msg, error_message);
- handling_signal = 0;
/* Inhibit redisplay while frames are being deleted. */
specbind (Qinhibit_redisplay, Qt);
@@ -7795,7 +7755,7 @@ x_connection_closed (Display *dpy, const char *error_message)
{
/* Set this to t so that delete_frame won't get confused
trying to find a replacement. */
- KVAR (FRAME_KBOARD (XFRAME (frame)), Vdefault_minibuffer_frame) = Qt;
+ kset_default_minibuffer_frame (FRAME_KBOARD (XFRAME (frame)), Qt);
delete_frame (frame, Qnoelisp);
}
@@ -7811,13 +7771,13 @@ x_connection_closed (Display *dpy, const char *error_message)
(https://bugzilla.gnome.org/show_bug.cgi?id=85715). Once,
the resulting Glib error message loop filled a user's disk.
To avoid this, kill Emacs unconditionally on disconnect. */
- shut_down_emacs (0, 0, Qnil);
+ shut_down_emacs (0, Qnil);
fprintf (stderr, "%s\n\
When compiled with GTK, Emacs cannot recover from X disconnects.\n\
This is a GTK bug: https://bugzilla.gnome.org/show_bug.cgi?id=85715\n\
For details, see etc/PROBLEMS.\n",
error_msg);
- abort ();
+ emacs_abort ();
#endif /* USE_GTK */
/* Indicate that this display is dead. */
@@ -7827,7 +7787,7 @@ For details, see etc/PROBLEMS.\n",
dpyinfo->terminal->reference_count--;
if (dpyinfo->reference_count != 0)
/* We have just closed all frames on this display. */
- abort ();
+ emacs_abort ();
{
Lisp_Object tmp;
@@ -7843,12 +7803,7 @@ For details, see etc/PROBLEMS.\n",
/* NOTREACHED */
}
- /* Ordinary stack unwind doesn't deal with these. */
-#ifdef SIGIO
- sigunblock (sigmask (SIGIO));
-#endif
- sigunblock (sigmask (SIGALRM));
- TOTALLY_UNBLOCK_INPUT;
+ totally_unblock_input ();
unbind_to (idx, Qnil);
clear_waiting_for_input ();
@@ -7987,9 +7942,9 @@ x_new_font (struct frame *f, Lisp_Object font_object, int fontset)
if (FRAME_XIC (f)
&& (FRAME_XIC_STYLE (f) & (XIMPreeditPosition | XIMStatusArea)))
{
- BLOCK_INPUT;
+ block_input ();
xic_set_xfontset (f, SSDATA (fontset_ascii (fontset)));
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif
@@ -8015,7 +7970,7 @@ xim_destroy_callback (XIM xim, XPointer client_data, XPointer call_data)
struct x_display_info *dpyinfo = (struct x_display_info *) client_data;
Lisp_Object frame, tail;
- BLOCK_INPUT;
+ block_input ();
/* No need to call XDestroyIC.. */
FOR_EACH_FRAME (tail, frame)
@@ -8031,7 +7986,7 @@ xim_destroy_callback (XIM xim, XPointer client_data, XPointer call_data)
/* No need to call XCloseIM. */
dpyinfo->xim = NULL;
XFree (dpyinfo->xim_styles);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* HAVE_X11R6 */
@@ -8106,7 +8061,7 @@ xim_instantiate_callback (Display *display, XPointer client_data, XPointer call_
{
Lisp_Object tail, frame;
- BLOCK_INPUT;
+ block_input ();
FOR_EACH_FRAME (tail, frame)
{
struct frame *f = XFRAME (frame);
@@ -8126,7 +8081,7 @@ xim_instantiate_callback (Display *display, XPointer client_data, XPointer call_
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -8146,14 +8101,13 @@ xim_initialize (struct x_display_info *dpyinfo, char *resource_name)
if (use_xim)
{
#ifdef HAVE_X11R6_XIM
- struct xim_inst_t *xim_inst;
+ struct xim_inst_t *xim_inst = xmalloc (sizeof *xim_inst);
ptrdiff_t len;
- xim_inst = (struct xim_inst_t *) xmalloc (sizeof (struct xim_inst_t));
dpyinfo->xim_callback_data = xim_inst;
xim_inst->dpyinfo = dpyinfo;
len = strlen (resource_name);
- xim_inst->resource_name = (char *) xmalloc (len + 1);
+ xim_inst->resource_name = xmalloc (len + 1);
memcpy (xim_inst->resource_name, resource_name, len + 1);
XRegisterIMInstantiateCallback (dpyinfo->display, dpyinfo->xrdb,
resource_name, emacs_class,
@@ -8274,7 +8228,7 @@ x_set_offset (struct frame *f, register int xoff, register int yoff, int change_
}
x_calc_absolute_position (f);
- BLOCK_INPUT;
+ block_input ();
x_wm_set_size_hint (f, (long) 0, 0);
modified_left = f->left_pos;
@@ -8313,7 +8267,7 @@ x_set_offset (struct frame *f, register int xoff, register int yoff, int change_
&& FRAME_X_OUTPUT (f)->move_offset_top == 0))))
x_check_expected_move (f, modified_left, modified_top);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Return non-zero if _NET_SUPPORTING_WM_CHECK window exists and _NET_SUPPORTED
@@ -8336,7 +8290,7 @@ wm_supports (struct frame *f, Atom want_atom)
unsigned char *tmp_data = NULL;
Atom target_type = XA_WINDOW;
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (dpy);
rc = XGetWindowProperty (dpy, target_window,
@@ -8349,7 +8303,7 @@ wm_supports (struct frame *f, Atom want_atom)
{
if (tmp_data) XFree (tmp_data);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
@@ -8362,7 +8316,7 @@ wm_supports (struct frame *f, Atom want_atom)
if (x_had_errors_p (dpy))
{
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
@@ -8387,7 +8341,7 @@ wm_supports (struct frame *f, Atom want_atom)
{
if (tmp_data) XFree (tmp_data);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
@@ -8402,7 +8356,7 @@ wm_supports (struct frame *f, Atom want_atom)
rc = dpyinfo->net_supported_atoms[i] == want_atom;
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return rc;
}
@@ -8461,7 +8415,7 @@ get_current_wm_state (struct frame *f,
*sticky = 0;
*size_state = FULLSCREEN_NONE;
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (dpy);
rc = XGetWindowProperty (dpy, window, dpyinfo->Xatom_net_wm_state,
0, max_len, False, target_type,
@@ -8472,7 +8426,7 @@ get_current_wm_state (struct frame *f,
{
if (tmp_data) XFree (tmp_data);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return ! f->iconified;
}
@@ -8507,7 +8461,7 @@ get_current_wm_state (struct frame *f,
}
if (tmp_data) XFree (tmp_data);
- UNBLOCK_INPUT;
+ unblock_input ();
return ! is_hidden;
}
@@ -8587,10 +8541,10 @@ XTfullscreen_hook (FRAME_PTR f)
{
if (f->async_visible)
{
- BLOCK_INPUT;
+ block_input ();
x_check_fullscreen (f);
x_sync (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
@@ -8770,25 +8724,26 @@ x_wait_for_event (struct frame *f, int eventtype)
/* Set timeout to 0.1 second. Hopefully not noticeable.
Maybe it should be configurable. */
- EMACS_SET_SECS_USECS (tmo, 0, 100000);
- EMACS_GET_TIME (tmo_at);
- EMACS_ADD_TIME (tmo_at, tmo_at, tmo);
+ tmo = make_emacs_time (0, 100 * 1000 * 1000);
+ tmo_at = add_emacs_time (current_emacs_time (), tmo);
while (pending_event_wait.eventtype)
{
- interrupt_input_pending = 1;
- TOTALLY_UNBLOCK_INPUT;
+ pending_signals = 1;
+ totally_unblock_input ();
/* XTread_socket is called after unblock. */
- BLOCK_INPUT;
+ block_input ();
interrupt_input_blocked = level;
FD_ZERO (&fds);
FD_SET (fd, &fds);
- EMACS_GET_TIME (time_now);
- EMACS_SUB_TIME (tmo, tmo_at, time_now);
+ time_now = current_emacs_time ();
+ if (EMACS_TIME_LT (tmo_at, time_now))
+ break;
- if (EMACS_TIME_NEG_P (tmo) || select (fd+1, &fds, NULL, NULL, &tmo) == 0)
+ tmo = sub_emacs_time (tmo_at, time_now);
+ if (pselect (fd + 1, &fds, NULL, NULL, &tmo, NULL) == 0)
break; /* Timeout */
}
pending_event_wait.f = 0;
@@ -8868,7 +8823,7 @@ x_set_window_size_1 (struct frame *f, int change_gravity, int cols, int rows)
void
x_set_window_size (struct frame *f, int change_gravity, int cols, int rows)
{
- BLOCK_INPUT;
+ block_input ();
if (NILP (tip_frame) || XFRAME (tip_frame) != f)
{
@@ -8916,7 +8871,7 @@ x_set_window_size (struct frame *f, int change_gravity, int cols, int rows)
so don't try--just let the highlighting be done afresh with new size. */
cancel_mouse_face (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Mouse warping. */
@@ -8935,11 +8890,11 @@ x_set_mouse_position (struct frame *f, int x, int y)
if (pix_y < 0) pix_y = 0;
if (pix_y > FRAME_PIXEL_HEIGHT (f)) pix_y = FRAME_PIXEL_HEIGHT (f);
- BLOCK_INPUT;
+ block_input ();
XWarpPointer (FRAME_X_DISPLAY (f), None, FRAME_X_WINDOW (f),
0, 0, 0, 0, pix_x, pix_y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Move the mouse to position pixel PIX_X, PIX_Y relative to frame F. */
@@ -8947,11 +8902,11 @@ x_set_mouse_position (struct frame *f, int x, int y)
void
x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y)
{
- BLOCK_INPUT;
+ block_input ();
XWarpPointer (FRAME_X_DISPLAY (f), None, FRAME_X_WINDOW (f),
0, 0, 0, 0, pix_x, pix_y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Raise frame F. */
@@ -8959,12 +8914,12 @@ x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y)
void
x_raise_frame (struct frame *f)
{
- BLOCK_INPUT;
+ block_input ();
if (f->async_visible)
XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Lower frame F. */
@@ -8974,13 +8929,25 @@ x_lower_frame (struct frame *f)
{
if (f->async_visible)
{
- BLOCK_INPUT;
+ block_input ();
XLowerWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
+/* Request focus with XEmbed */
+
+void
+xembed_request_focus (FRAME_PTR f)
+{
+ /* See XEmbed Protocol Specification at
+ http://freedesktop.org/wiki/Specifications/xembed-spec */
+ if (f->async_visible)
+ xembed_send_message (f, CurrentTime,
+ XEMBED_REQUEST_FOCUS, 0, 0, 0);
+}
+
/* Activate frame with Extended Window Manager Hints */
void
@@ -9074,7 +9041,7 @@ x_make_frame_visible (struct frame *f)
retry:
- BLOCK_INPUT;
+ block_input ();
type = x_icon_type (f);
if (!NILP (type))
@@ -9133,7 +9100,7 @@ x_make_frame_visible (struct frame *f)
original_top = f->top_pos;
/* This must come after we set COUNT. */
- UNBLOCK_INPUT;
+ unblock_input ();
/* We unblock here so that arriving X events are processed. */
@@ -9156,7 +9123,7 @@ x_make_frame_visible (struct frame *f)
int x, y;
unsigned int width, height, border, depth;
- BLOCK_INPUT;
+ block_input ();
/* On some window managers (such as FVWM) moving an existing
window, even to the same place, causes the window manager
@@ -9172,7 +9139,7 @@ x_make_frame_visible (struct frame *f)
XMoveWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
original_left, original_top);
- UNBLOCK_INPUT;
+ unblock_input ();
}
XSETFRAME (frame, f);
@@ -9239,7 +9206,7 @@ x_make_frame_invisible (struct frame *f)
if (FRAME_X_DISPLAY_INFO (f)->x_highlight_frame == f)
FRAME_X_DISPLAY_INFO (f)->x_highlight_frame = 0;
- BLOCK_INPUT;
+ block_input ();
/* Before unmapping the window, update the WM_SIZE_HINTS property to claim
that the current position of the window is user-specified, rather than
@@ -9262,7 +9229,7 @@ x_make_frame_invisible (struct frame *f)
if (! XWithdrawWindow (FRAME_X_DISPLAY (f), window,
DefaultScreen (FRAME_X_DISPLAY (f))))
{
- UNBLOCK_INPUT_RESIGNAL;
+ unblock_input ();
error ("Can't notify window manager of window withdrawal");
}
}
@@ -9279,7 +9246,7 @@ x_make_frame_invisible (struct frame *f)
x_sync (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Change window state from mapped to iconified. */
@@ -9299,7 +9266,7 @@ x_iconify_frame (struct frame *f)
if (f->async_iconified)
return;
- BLOCK_INPUT;
+ block_input ();
FRAME_SAMPLE_VISIBILITY (f);
@@ -9318,7 +9285,7 @@ x_iconify_frame (struct frame *f)
f->visible = 1;
f->async_iconified = 1;
f->async_visible = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
#endif
@@ -9338,14 +9305,14 @@ x_iconify_frame (struct frame *f)
f->visible = 1;
f->async_iconified = 1;
f->async_visible = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
result = XIconifyWindow (FRAME_X_DISPLAY (f),
XtWindow (f->output_data.x->widget),
DefaultScreen (FRAME_X_DISPLAY (f)));
- UNBLOCK_INPUT;
+ unblock_input ();
if (!result)
error ("Can't notify window manager of iconification");
@@ -9354,9 +9321,9 @@ x_iconify_frame (struct frame *f)
f->async_visible = 0;
- BLOCK_INPUT;
+ block_input ();
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
#else /* not USE_X_TOOLKIT */
/* Make sure the X server knows where the window should be positioned,
@@ -9386,7 +9353,7 @@ x_iconify_frame (struct frame *f)
SubstructureRedirectMask | SubstructureNotifyMask,
&msg))
{
- UNBLOCK_INPUT_RESIGNAL;
+ unblock_input ();
error ("Can't notify window manager of iconification");
}
}
@@ -9405,7 +9372,7 @@ x_iconify_frame (struct frame *f)
f->async_visible = 0;
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
#endif /* not USE_X_TOOLKIT */
}
@@ -9422,7 +9389,7 @@ x_free_frame_resources (struct frame *f)
struct scroll_bar *b;
#endif
- BLOCK_INPUT;
+ block_input ();
/* If a display connection is dead, don't try sending more
commands to the X server. */
@@ -9521,11 +9488,10 @@ x_free_frame_resources (struct frame *f)
hlinfo->mouse_face_end_row
= hlinfo->mouse_face_end_col = -1;
hlinfo->mouse_face_window = Qnil;
- hlinfo->mouse_face_deferred_gc = 0;
hlinfo->mouse_face_mouse_frame = 0;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
@@ -9550,13 +9516,13 @@ x_destroy_window (struct frame *f)
/* Set the normal size hints for the window manager, for frame F.
FLAGS is the flags word to use--or 0 meaning preserve the flags
that the window now has.
- If USER_POSITION is nonzero, we set the USPosition
+ If USER_POSITION, set the USPosition
flag (this is useful when FLAGS is 0).
- The GTK version is in gtkutils.c */
+ The GTK version is in gtkutils.c. */
#ifndef USE_GTK
void
-x_wm_set_size_hint (struct frame *f, long flags, int user_position)
+x_wm_set_size_hint (struct frame *f, long flags, bool user_position)
{
XSizeHints size_hints;
Window window = FRAME_OUTER_WINDOW (f);
@@ -9746,7 +9712,7 @@ x_wm_set_icon_position (struct frame *f, int icon_x, int icon_y)
Fonts
***********************************************************************/
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check that FONT is valid on frame F. It is if it can be found in F's
font table. */
@@ -9754,12 +9720,12 @@ x_wm_set_icon_position (struct frame *f, int icon_x, int icon_y)
static void
x_check_font (struct frame *f, struct font *font)
{
- xassert (font != NULL && ! NILP (font->props[FONT_TYPE_INDEX]));
+ eassert (font != NULL && ! NILP (font->props[FONT_TYPE_INDEX]));
if (font->driver->check)
- xassert (font->driver->check (f, font) == 0);
+ eassert (font->driver->check (f, font) == 0);
}
-#endif /* GLYPH_DEBUG != 0 */
+#endif /* GLYPH_DEBUG */
/***********************************************************************
@@ -9905,7 +9871,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
Mouse_HLInfo *hlinfo;
ptrdiff_t lim;
- BLOCK_INPUT;
+ block_input ();
if (!x_initialized)
{
@@ -9966,11 +9932,13 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
Call before gtk_init so Gtk+ event filters comes after our. */
gdk_window_add_filter (NULL, event_handler_gdk, NULL);
+ /* gtk_init does set_locale. Fix locale before and after. */
+ fixup_locale ();
gtk_init (&argc, &argv2);
+ fixup_locale ();
+
g_log_remove_handler ("GLib", id);
- /* gtk_init does set_locale. We must fix locale after calling it. */
- fixup_locale ();
xg_initialize ();
dpy = DEFAULT_GDK_DISPLAY ();
@@ -9981,7 +9949,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
const char *file = "~/.emacs.d/gtkrc";
Lisp_Object s, abs_file;
- s = make_string (file, strlen (file));
+ s = build_string (file);
abs_file = Fexpand_file_name (s, Qnil);
if (! NILP (abs_file) && !NILP (Ffile_readable_p (abs_file)))
@@ -10037,14 +10005,13 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
/* Detect failure. */
if (dpy == 0)
{
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
/* We have definitely succeeded. Record the new connection. */
- dpyinfo = (struct x_display_info *) xmalloc (sizeof (struct x_display_info));
- memset (dpyinfo, 0, sizeof *dpyinfo);
+ dpyinfo = xzalloc (sizeof *dpyinfo);
hlinfo = &dpyinfo->mouse_highlight;
terminal = x_create_terminal (dpyinfo);
@@ -10062,9 +10029,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
terminal->kboard = share->terminal->kboard;
else
{
- terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
+ terminal->kboard = xmalloc (sizeof *terminal->kboard);
init_kboard (terminal->kboard);
- KVAR (terminal->kboard, Vwindow_system) = Qx;
+ kset_window_system (terminal->kboard, Qx);
/* Add the keyboard to the list before running Lisp code (via
Qvendor_specific_keysyms below), since these are not traced
@@ -10085,11 +10052,12 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
/* Temporarily hide the partially initialized terminal. */
terminal_list = terminal->next_terminal;
- UNBLOCK_INPUT;
- KVAR (terminal->kboard, Vsystem_key_alist)
- = call1 (Qvendor_specific_keysyms,
- vendor ? build_string (vendor) : empty_unibyte_string);
- BLOCK_INPUT;
+ unblock_input ();
+ kset_system_key_alist
+ (terminal->kboard,
+ call1 (Qvendor_specific_keysyms,
+ vendor ? build_string (vendor) : empty_unibyte_string));
+ block_input ();
terminal->next_terminal = terminal_list;
terminal_list = terminal;
UNGCPRO;
@@ -10116,8 +10084,8 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
dpyinfo->display = dpy;
/* Set the name of the terminal. */
- terminal->name = (char *) xmalloc (SBYTES (display_name) + 1);
- strncpy (terminal->name, SSDATA (display_name), SBYTES (display_name));
+ terminal->name = xmalloc (SBYTES (display_name) + 1);
+ memcpy (terminal->name, SSDATA (display_name), SBYTES (display_name));
terminal->name[SBYTES (display_name)] = 0;
#if 0
@@ -10127,10 +10095,8 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
lim = min (PTRDIFF_MAX, SIZE_MAX) - sizeof "@";
if (lim - SBYTES (Vinvocation_name) < SBYTES (Vsystem_name))
memory_full (SIZE_MAX);
- dpyinfo->x_id_name
- = (char *) xmalloc (SBYTES (Vinvocation_name)
- + SBYTES (Vsystem_name)
- + 2);
+ dpyinfo->x_id_name = xmalloc (SBYTES (Vinvocation_name)
+ + SBYTES (Vsystem_name) + 2);
strcat (strcat (strcpy (dpyinfo->x_id_name, SSDATA (Vinvocation_name)), "@"),
SSDATA (Vsystem_name));
@@ -10172,7 +10138,6 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
dpyinfo->bitmaps_last = 0;
dpyinfo->scratch_cursor_gc = 0;
hlinfo->mouse_face_mouse_frame = 0;
- hlinfo->mouse_face_deferred_gc = 0;
hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1;
hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1;
hlinfo->mouse_face_face_id = DEFAULT_FACE_ID;
@@ -10318,16 +10283,18 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
const int atom_count = sizeof (atom_refs) / sizeof (atom_refs[0]);
/* 1 for _XSETTINGS_SN */
const int total_atom_count = 1 + atom_count;
- Atom *atoms_return = xmalloc (sizeof (Atom) * total_atom_count);
- char **atom_names = xmalloc (sizeof (char *) * total_atom_count);
- char xsettings_atom_name[64];
+ Atom *atoms_return = xmalloc (total_atom_count * sizeof *atoms_return);
+ char **atom_names = xmalloc (total_atom_count * sizeof *atom_names);
+ static char const xsettings_fmt[] = "_XSETTINGS_S%d";
+ char xsettings_atom_name[sizeof xsettings_fmt - 2
+ + INT_STRLEN_BOUND (int)];
for (i = 0; i < atom_count; i++)
atom_names[i] = (char *) atom_refs[i].name;
/* Build _XSETTINGS_SN atom name */
- snprintf (xsettings_atom_name, sizeof (xsettings_atom_name),
- "_XSETTINGS_S%d", XScreenNumberOfScreen (dpyinfo->screen));
+ sprintf (xsettings_atom_name, xsettings_fmt,
+ XScreenNumberOfScreen (dpyinfo->screen));
atom_names[i] = xsettings_atom_name;
XInternAtoms (dpyinfo->display, atom_names, total_atom_count,
@@ -10345,7 +10312,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
dpyinfo->x_dnd_atoms_size = 8;
dpyinfo->x_dnd_atoms_length = 0;
- dpyinfo->x_dnd_atoms = xmalloc (sizeof (*dpyinfo->x_dnd_atoms)
+ dpyinfo->x_dnd_atoms = xmalloc (sizeof *dpyinfo->x_dnd_atoms
* dpyinfo->x_dnd_atoms_size);
dpyinfo->net_supported_atoms = NULL;
@@ -10354,14 +10321,10 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
connection = ConnectionNumber (dpyinfo->display);
dpyinfo->connection = connection;
-
- {
- dpyinfo->gray
- = XCreatePixmapFromBitmapData (dpyinfo->display, dpyinfo->root_window,
- gray_bitmap_bits,
- gray_bitmap_width, gray_bitmap_height,
- 1, 0, 1);
- }
+ dpyinfo->gray
+ = XCreatePixmapFromBitmapData (dpyinfo->display, dpyinfo->root_window,
+ gray_bits, gray_width, gray_height,
+ 1, 0, 1);
#ifdef HAVE_X_I18N
xim_initialize (dpyinfo, resource_name);
@@ -10377,10 +10340,8 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
fcntl (connection, F_SETOWN, getpid ());
#endif /* ! defined (F_SETOWN) */
-#ifdef SIGIO
if (interrupt_input)
init_sigio (connection);
-#endif /* ! defined (SIGIO) */
#ifdef USE_LUCID
{
@@ -10396,7 +10357,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
to.addr = (XPointer)&font;
x_catch_errors (dpy);
if (!XtCallConverter (dpy, XtCvtStringToFont, &d, 1, &fr, &to, NULL))
- abort ();
+ emacs_abort ();
if (x_had_errors_p (dpy) || !XQueryFont (dpy, font))
XrmPutLineResource (&xrdb, "Emacs.dialog.*.font: 9x15");
x_uncatch_errors ();
@@ -10444,7 +10405,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
x_session_initialize (dpyinfo);
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
return dpyinfo;
}
@@ -10524,7 +10485,7 @@ x_delete_display (struct x_display_info *dpyinfo)
static void
x_process_timeouts (struct atimer *timer)
{
- BLOCK_INPUT;
+ block_input ();
x_timeout_atimer_activated_flag = 0;
if (toolkit_scroll_bar_interaction || popup_activated ())
{
@@ -10533,7 +10494,7 @@ x_process_timeouts (struct atimer *timer)
/* Reactivate the atimer for next time. */
x_activate_timeout_atimer ();
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Install an asynchronous timer that processes Xt timeout events
@@ -10547,16 +10508,14 @@ x_process_timeouts (struct atimer *timer)
void
x_activate_timeout_atimer (void)
{
- BLOCK_INPUT;
+ block_input ();
if (!x_timeout_atimer_activated_flag)
{
- EMACS_TIME interval;
-
- EMACS_SET_SECS_USECS (interval, 0, 100000);
+ EMACS_TIME interval = make_emacs_time (0, 100 * 1000 * 1000);
start_atimer (ATIMER_RELATIVE, interval, x_process_timeouts, 0);
x_timeout_atimer_activated_flag = 1;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* USE_X_TOOLKIT */
@@ -10564,8 +10523,6 @@ x_activate_timeout_atimer (void)
/* Set up use of X before we make the first connection. */
-extern frame_parm_handler x_frame_parm_handlers[];
-
static struct redisplay_interface x_redisplay_interface =
{
x_frame_parm_handlers,
@@ -10611,7 +10568,7 @@ x_delete_terminal (struct terminal *terminal)
if (!terminal->name)
return;
- BLOCK_INPUT;
+ block_input ();
#ifdef HAVE_X_I18N
/* We must close our connection to the XIM server before closing the
X display. */
@@ -10666,7 +10623,7 @@ x_delete_terminal (struct terminal *terminal)
/* Mark as dead. */
dpyinfo->display = NULL;
x_delete_display (dpyinfo);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Create a struct terminal, initialize it with the X11 specific
@@ -10768,10 +10725,6 @@ x_initialize (void)
original error handler. */
XSetErrorHandler (x_error_handler);
XSetIOErrorHandler (x_io_error_quitter);
-
- signal (SIGPIPE, x_connection_signal);
-
- xgselect_initialize ();
}
@@ -10793,7 +10746,7 @@ syms_of_xterm (void)
last_mouse_press_frame = Qnil;
#ifdef USE_GTK
- xg_default_icon_file = make_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg");
+ xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg");
staticpro (&xg_default_icon_file);
DEFSYM (Qx_gtk_map_stock, "x-gtk-map-stock");
@@ -10801,7 +10754,7 @@ syms_of_xterm (void)
DEFVAR_BOOL ("x-use-underline-position-properties",
x_use_underline_position_properties,
- doc: /* *Non-nil means make use of UNDERLINE_POSITION font properties.
+ doc: /* Non-nil means make use of UNDERLINE_POSITION font properties.
A value of nil means ignore them. If you encounter fonts with bogus
UNDERLINE_POSITION font properties, for example 7x13 on XFree prior
to 4.1, set this to nil. You can also use `underline-minimum-offset'
@@ -10811,7 +10764,7 @@ sizes. */);
DEFVAR_BOOL ("x-underline-at-descent-line",
x_underline_at_descent_line,
- doc: /* *Non-nil means to draw the underline at the same place as the descent line.
+ doc: /* Non-nil means to draw the underline at the same place as the descent line.
A value of nil means to draw the underline according to the value of the
variable `x-use-underline-position-properties', which is usually at the
baseline level. The default value is nil. */);
@@ -10832,7 +10785,7 @@ selected window or cursor position is preserved. */);
A value of nil means Emacs doesn't use toolkit scroll bars.
With the X Window system, the value is a symbol describing the
X toolkit. Possible values are: gtk, motif, xaw, or xaw3d.
-With MS Windows, the value is t. */);
+With MS Windows or Nextstep, the value is t. */);
#ifdef USE_TOOLKIT_SCROLL_BARS
#ifdef USE_MOTIF
Vx_toolkit_scroll_bars = intern_c_string ("motif");
@@ -10890,10 +10843,10 @@ default is nil, which is the same as `super'. */);
DEFVAR_LISP ("x-keysym-table", Vx_keysym_table,
doc: /* Hash table of character codes indexed by X keysym codes. */);
- Vx_keysym_table = make_hash_table (Qeql, make_number (900),
+ Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900),
make_float (DEFAULT_REHASH_SIZE),
make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil, Qnil, Qnil);
+ Qnil);
}
#endif /* HAVE_X_WINDOWS */
diff --git a/src/xterm.h b/src/xterm.h
index 9e0e1acca92..d63ed1c4583 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -1,5 +1,5 @@
/* Definitions and headers for communication with X protocol.
- Copyright (C) 1989, 1993-1994, 1998-2011 Free Software Foundation, Inc.
+ Copyright (C) 1989, 1993-1994, 1998-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -16,6 +16,9 @@ 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/>. */
+#ifndef XTERM_H
+#define XTERM_H
+
#include <X11/Xlib.h>
#include <X11/cursorfont.h>
@@ -367,13 +370,14 @@ extern int use_xim;
extern void check_x (void);
extern struct frame *x_window_to_frame (struct x_display_info *, int);
-
extern struct frame *x_any_window_to_frame (struct x_display_info *, int);
extern struct frame *x_menubar_window_to_frame (struct x_display_info *,
XEvent *);
-
extern struct frame *x_top_window_to_frame (struct x_display_info *, int);
+extern struct frame *x_menubar_window_to_frame (struct x_display_info *,
+ XEvent *);
+
#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
#define x_any_window_to_frame x_window_to_frame
#define x_top_window_to_frame x_window_to_frame
@@ -389,7 +393,6 @@ extern struct x_display_info *x_display_list;
extern Lisp_Object x_display_name_list;
extern struct x_display_info *x_display_info_for_display (Display *);
-extern void x_set_frame_alpha (struct frame *);
extern struct x_display_info *x_term_init (Lisp_Object, char *, char *);
extern int x_display_ok (const char *);
@@ -503,12 +506,6 @@ struct x_output
value contains an ID of the fontset, else -1. */
int fontset;
- /* Pixel values used for various purposes.
- border_pixel may be -1 meaning use a gray tile. */
-#if 0 /* These are also defined in struct frame. Use that instead. */
- unsigned long background_pixel;
- unsigned long foreground_pixel;
-#endif
unsigned long cursor_pixel;
unsigned long border_pixel;
unsigned long mouse_pixel;
@@ -544,9 +541,6 @@ struct x_output
/* Non-zero means hourglass cursor is currently displayed. */
unsigned hourglass_p : 1;
- /* Flag to set when the X window needs to be completely repainted. */
- int needs_exposure;
-
/* These are the current window manager hints. It seems that
XSetWMHints, when presented with an unset bit in the `flags'
member of the hints structure, does not leave the corresponding
@@ -574,13 +568,13 @@ struct x_output
/* Nonzero means our parent is another application's window
and was explicitly specified. */
- char explicit_parent;
+ unsigned explicit_parent : 1;
/* Nonzero means tried already to make this frame visible. */
- char asked_for_visible;
+ unsigned asked_for_visible : 1;
/* Nonzero if this frame was ever previously visible. */
- char has_been_visible;
+ unsigned has_been_visible : 1;
#ifdef HAVE_X_I18N
/* Input context (currently, this means Compose key handler setup). */
@@ -634,7 +628,7 @@ struct x_output
int top_before_move;
/* Non-zero if _NET_WM_STATE_HIDDEN is set for this frame. */
- int net_wm_state_hidden_seen;
+ unsigned net_wm_state_hidden_seen : 1;
};
#define No_Cursor (None)
@@ -736,9 +730,6 @@ enum
/* This is the Colormap which frame F uses. */
#define FRAME_X_COLORMAP(f) FRAME_X_DISPLAY_INFO (f)->cmap
-/* This is the 'font_info *' which frame F has. */
-#define FRAME_X_FONT_TABLE(f) (FRAME_X_DISPLAY_INFO (f)->font_table)
-
/* The difference in pixels between the top left corner of the
Emacs window (including possible window manager decorations)
and FRAME_X_WINDOW (f). */
@@ -779,8 +770,7 @@ enum
struct scroll_bar
{
/* These fields are shared by all vectors. */
- EMACS_INT size_from_Lisp_Vector_struct;
- struct Lisp_Vector *next_from_Lisp_Vector_struct;
+ struct vectorlike_header header;
/* The window we're a scroll bar for. */
Lisp_Object window;
@@ -821,12 +811,6 @@ struct scroll_bar
unsigned int fringe_extended_p : 1;
};
-/* The number of elements a vector holding a struct scroll_bar needs. */
-#define SCROLL_BAR_VEC_SIZE \
- ((sizeof (struct scroll_bar) \
- - sizeof (EMACS_INT) - sizeof (struct Lisp_Vector *)) \
- / sizeof (Lisp_Object))
-
/* Turning a lisp vector value into a pointer to a struct scroll_bar. */
#define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec))
@@ -900,10 +884,8 @@ struct scroll_bar
by this structure. */
/* For an event of kind SELECTION_REQUEST_EVENT,
- this structure really describes the contents.
- **Don't make this struct longer!**
- If it overlaps the frame_or_window field of struct input_event,
- that will cause GC to crash. */
+ this structure really describes the contents. */
+
struct selection_input_event
{
int kind;
@@ -944,10 +926,7 @@ void x_handle_property_notify (XPropertyEvent *);
/* From xfns.c. */
struct frame *check_x_frame (Lisp_Object);
-EXFUN (Fx_display_grayscale_p, 1);
extern void x_free_gcs (struct frame *);
-extern int gray_bitmap_width, gray_bitmap_height;
-extern char *gray_bitmap_bits;
/* From xrdb.c. */
@@ -957,7 +936,6 @@ XrmDatabase x_load_resources (Display *, const char *, const char *,
/* Defined in xterm.c */
extern int x_text_icon (struct frame *, const char *);
-extern int x_bitmap_icon (struct frame *, Lisp_Object);
extern void x_catch_errors (Display *);
extern void x_check_errors (Display *, const char *)
ATTRIBUTE_FORMAT_PRINTF (2, 0);
@@ -967,12 +945,8 @@ extern void x_clear_errors (Display *);
extern void x_set_window_size (struct frame *, int, int, int);
extern void x_set_mouse_position (struct frame *, int, int);
extern void x_set_mouse_pixel_position (struct frame *, int, int);
+extern void xembed_request_focus (struct frame *);
extern void x_ewmh_activate_frame (struct frame *);
-extern void x_make_frame_visible (struct frame *);
-extern void x_make_frame_invisible (struct frame *);
-extern void x_iconify_frame (struct frame *);
-extern void x_free_frame_resources (struct frame *);
-extern void x_wm_set_size_hint (struct frame *, long, int);
extern void x_delete_terminal (struct terminal *terminal);
extern unsigned long x_copy_color (struct frame *, unsigned long);
#ifdef USE_X_TOOLKIT
@@ -980,12 +954,11 @@ extern XtAppContext Xt_app_con;
extern void x_activate_timeout_atimer (void);
#endif
#ifdef USE_LUCID
-extern int x_alloc_lighter_color_for_widget (Widget, Display *, Colormap,
- unsigned long *,
- double, int);
+extern bool x_alloc_lighter_color_for_widget (Widget, Display *, Colormap,
+ unsigned long *,
+ double, int);
#endif
-extern int x_alloc_nearest_color (struct frame *, Colormap, XColor *);
-extern void x_query_colors (struct frame *f, XColor *, int);
+extern bool x_alloc_nearest_color (struct frame *, Colormap, XColor *);
extern void x_query_color (struct frame *f, XColor *);
extern void x_clear_area (Display *, Window, int, int, int, int, int);
#if defined HAVE_MENUS && !defined USE_X_TOOLKIT && !defined USE_GTK
@@ -995,7 +968,7 @@ extern void x_mouse_leave (struct x_display_info *);
#ifdef USE_X_TOOLKIT
extern int x_dispatch_event (XEvent *, Display *);
#endif
-extern EMACS_INT x_x_to_emacs_modifiers (struct x_display_info *, int);
+extern int x_x_to_emacs_modifiers (struct x_display_info *, int);
extern int x_display_pixel_height (struct x_display_info *);
extern int x_display_pixel_width (struct x_display_info *);
@@ -1037,14 +1010,13 @@ extern void x_clipboard_manager_save_all (void);
extern struct x_display_info * check_x_display_info (Lisp_Object);
extern Lisp_Object x_get_focus_frame (struct frame *);
+extern int x_in_use;
#ifdef USE_GTK
extern int xg_set_icon (struct frame *, Lisp_Object);
extern int xg_set_icon_from_xpm_data (struct frame *, const char**);
#endif /* USE_GTK */
-extern void x_real_positions (struct frame *, int *, int *);
-extern void x_set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
extern void x_implicitly_set_name (struct frame *, Lisp_Object, Lisp_Object);
extern void xic_free_xfontset (struct frame *);
extern void create_frame_xic (struct frame *);
@@ -1054,17 +1026,13 @@ extern void xic_set_statusarea (struct frame *);
extern void xic_set_xfontset (struct frame *, const char *);
extern int x_pixel_width (struct frame *);
extern int x_pixel_height (struct frame *);
-extern int x_char_width (struct frame *);
-extern int x_char_height (struct frame *);
-extern void x_sync (struct frame *);
-extern int x_defined_color (struct frame *, const char *, XColor *, int);
+extern bool x_defined_color (struct frame *, const char *, XColor *, bool);
#ifdef HAVE_X_I18N
extern void free_frame_xic (struct frame *);
# if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
extern char * xic_create_fontsetname (const char *base_fontname, int motif);
# endif
#endif
-extern void x_set_tool_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
/* Defined in xfaces.c */
@@ -1081,10 +1049,8 @@ extern void x_menu_set_in_use (int);
#ifdef USE_MOTIF
extern void x_menu_wait_for_event (void *data);
#endif
-extern void x_activate_menubar (struct frame *);
extern int popup_activated (void);
extern void initialize_frame_menubar (struct frame *);
-extern void free_frame_menubar (struct frame *);
/* Defined in widget.c */
@@ -1126,3 +1092,5 @@ extern Lisp_Object Qx_gtk_map_stock;
(nr).y = (ry), \
(nr).width = (rwidth), \
(nr).height = (rheight))
+
+#endif /* XTERM_H */
diff --git a/test/ChangeLog b/test/ChangeLog
index 964238ae45b..b66c2925287 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,8 +1,200 @@
+2012-11-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * automated/advice-tests.el (advice-tests--data): Remove.
+ (advice-tests): Move the tests directly here instead.
+ Add called-interactively-p tests.
+
+2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * automated/ert-x-tests.el: Use cl-lib.
+ * automated/ert-tests.el: Use lexical-binding and cl-lib.
+
+2012-11-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/ruby-mode-tests.el (ruby-indent-singleton-class): Pass.
+ (ruby-indent-inside-heredoc-after-operator)
+ (ruby-indent-inside-heredoc-after-space): New tests.
+ Change direct font-lock face references to var references.
+ (ruby-interpolation-suppresses-syntax-inside): New test.
+ (ruby-interpolation-inside-percent-literal-with-paren):
+ New failing test.
+
+2012-11-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/ruby-mode-tests.el (ruby-heredoc-font-lock)
+ (ruby-singleton-class-no-heredoc-font-lock)
+ (ruby-add-log-current-method-examples): New tests.
+ (ruby-test-string): Extract from ruby-should-indent-buffer.
+ (ruby-deftest-move-to-block): New macro.
+ Add several move-to-block tests.
+
+2012-11-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * automated/advice-tests.el: New tests.
+
+2012-10-14 Eli Zaretskii <eliz@gnu.org>
+
+ * automated/compile-tests.el (compile-tests--test-regexps-data):
+ Add new data for msft's new format.
+
+2012-09-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/ruby-mode-tests.el:
+ (ruby-toggle-block-to-multiline): New test.
+ (ruby-should-indent-buffer, ruby-toggle-block-to-do-end)
+ (ruby-toggle-block-to-brace): Use buffer-string.
+
+2012-09-07 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/ruby-mode-tests.el: New tests (Bug#11613).
+
+2012-08-28 Chong Yidong <cyd@gnu.org>
+
+ * automated/files.el: Test every combination of values for
+ enable-local-variables and enable-local-eval.
+
+2012-08-19 Chong Yidong <cyd@gnu.org>
+
+ * redisplay-testsuite.el (test-redisplay): Use switch-to-buffer.
+
+2012-08-18 Chong Yidong <cyd@gnu.org>
+
+ * redisplay-testsuite.el (test-redisplay-4): New test (Bug#3874).
+
+2012-08-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * indent/ruby.rb: Rearrange examples, add new ones.
+
+2012-08-12 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/ruby-mode-tests.el (ruby-move-to-block-stops-at-opening)
+ (ruby-toggle-block-to-do-end, ruby-toggle-block-to-brace): New test.
+
+2012-08-11 Glenn Morris <rgm@gnu.org>
+
+ * automated/files.el: New file.
+
+ * automated/Makefile.in (all): Fix typo.
+
+2012-08-10 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/ruby-mode-tests.el (ruby-should-indent):
+ Add docstring, check (current-indentation) instead of (current-column).
+ (ruby-should-indent-buffer): New function.
+ Add tests for `ruby-deep-indent-paren' behavior.
+ Port all tests from test/misc/test_ruby_mode.rb in Ruby repo.
+
+2012-08-10 Nobuyoshi Nakada <nobu@ruby-lang.org>
+
+ Original tests in test_ruby_mode.rb in upstream (author).
+
+2012-08-09 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/ruby-mode-tests.el (ruby-should-indent)
+ (ruby-assert-state): New functions.
+ Add new tests.
+
+2012-07-29 David Engster <deng@randomsample.de>
+
+ * automated/xml-parse-tests.el (xml-parse-tests--qnames):
+ New variable to hold test data for name expansion.
+ (xml-parse-tests): Test the two different types of name expansion.
+
+2012-07-29 Juri Linkov <juri@jurta.org>
+
+ * automated/occur-tests.el (occur-test-case): Use predefined
+ buffer name " *test-occur*" instead of a random buffer name.
+
+2012-07-20 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/ruby-mode-tests.el: New file with one test.
+
+2012-07-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * indent/shell.sh: Add test case for ${#VAR}.
+
+ * indent/latex-mode.tex: New file.
+
+2012-07-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eshell.el: Use cl-lib.
+
+2012-07-03 Chong Yidong <cyd@gnu.org>
+
+ * automated/xml-parse-tests.el (xml-parse-tests--bad-data): New.
+
+2012-07-02 Chong Yidong <cyd@gnu.org>
+
+ * automated/xml-parse-tests.el (xml-parse-tests--data):
+ More testcases.
+
+2012-07-01 Chong Yidong <cyd@gnu.org>
+
+ * automated/xml-parse-tests.el: New file.
+
+2012-06-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * automated/ert-x-tests.el (ert-test-run-tests-interactively-2):
+ Use cl-flet.
+
+2012-06-08 Ulf Jasper <ulf.jasper@web.de>
+
+ * automated/icalendar-tests.el (icalendar--parse-vtimezone):
+ Test escaped commas in TZID (Bug#11473).
+ (icalendar-import-with-timezone): New.
+ (icalendar-real-world): Add new testcase as given in the bugreport
+ of Bug#11473.
+
+2012-05-29 Ulf Jasper <ulf.jasper@web.de>
+
+ * automated/icalendar-tests.el (icalendar-tests--test-import):
+ Include UID in import tests (Bug#11525).
+ (icalendar-import-non-recurring, icalendar-import-rrule)
+ (icalendar-import-duration, icalendar-import-bug-6766): Adjust to
+ UID-import change.
+ (icalendar-import-with-uid): New.
+ (icalendar-tests--test-cycle, icalendar-tests--do-test-cycle):
+ Include UID in cycle tests.
+ (icalendar-cycle, icalendar-real-world): UID-import change.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * automated/Makefile.in (setwins): Scrap superfluous subshell.
+
+2012-05-15 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * automated/url-util-tests.el: New file to test
+ lisp/url/url-util.el. Only `url-build-query-string' and
+ `url-parse-query-string' are tested right now (Bug#8706).
+
+2012-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * indent/shell.sh:
+ * indent/shell.rc: Ad some test cases.
+
+2012-04-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * indent/ruby.rb: New file, to test new syntax-propertize code.
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * automated/vc-bzr.el (vc-bzr-test-faulty-bzr-autoloads): New test.
+
+2012-02-13 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * automated/url-future-tests.el (url-future-tests): Move from
+ lisp/url/url-future.el and rename.
+
+2012-01-29 Ulf Jasper <ulf.jasper@web.de>
+
+ * automated/icalendar-tests.el (icalendar-import-non-recurring):
+ Fix broken test, caused by missing trailing blank.
+
2011-12-03 Chong Yidong <cyd@gnu.org>
* automated/compile-tests.el (compile-tests--test-regexps-data):
Increase column numbers by one to reflect change in how
- compilation-message is recorded (Bug#10172).
+ compilation-message is recorded (Bug#10172).
2011-11-22 Glenn Morris <rgm@gnu.org>
@@ -21,7 +213,7 @@
2011-10-30 Ulf Jasper <ulf.jasper@web.de>
* automated/newsticker-tests.el
- (newsticker--group-manage-orphan-feeds): Removed fsetting of
+ (newsticker--group-manage-orphan-feeds): Remove fsetting of
newsticker--treeview-tree-update.
2011-10-29 Ulf Jasper <ulf.jasper@web.de>
@@ -58,7 +250,7 @@
(icalendar--format-ical-event)
(icalendar--parse-summary-and-rest)
(icalendar-tests--do-test-import)
- (icalendar-tests--do-test-cycle) : Changed argument order of
+ (icalendar-tests--do-test-cycle): Change argument order of
string= to EXPECTED ACTUAL.
(icalendar--import-format-sample)
(icalendar--format-ical-event)
@@ -66,7 +258,7 @@
(icalendar-import-rrule)
(icalendar-import-duration)
(icalendar-import-bug-6766)
- (icalendar-real-world): Adjusted to string= instead of
+ (icalendar-real-world): Adjust to string= instead of
icalendar-tests--compare-strings.
(icalendar-import-multiple-vcalendars): New.
@@ -253,8 +445,8 @@
2010-02-19 Ulf Jasper <ulf.jasper@web.de>
* icalendar-testsuite.el
- (icalendar-testsuite--run-function-tests): Added new tests.
- (icalendar-testsuite--test-diarytime-to-isotime): Added another
+ (icalendar-testsuite--run-function-tests): Add new tests.
+ (icalendar-testsuite--test-diarytime-to-isotime): Add another
testcase.
(icalendar-testsuite--test-convert-ordinary-to-ical): New.
(icalendar-testsuite--test-convert-weekly-to-ical): New.
@@ -279,14 +471,14 @@
2009-12-18 Ulf Jasper <ulf.jasper@web.de>
* icalendar-testsuite.el
- (icalendar-testsuite--run-function-tests): Added
- icalendar-testsuite--test-parse-vtimezone.
+ (icalendar-testsuite--run-function-tests):
+ Add icalendar-testsuite--test-parse-vtimezone.
(icalendar-testsuite--test-parse-vtimezone): New.
(icalendar-testsuite--do-test-cycle): Doc changes.
- (icalendar-testsuite--run-real-world-tests): Removed trailing
+ (icalendar-testsuite--run-real-world-tests): Remove trailing
whitespace -- see change of icalendar--add-diary-entry in
icalendar.el.
- (icalendar-testsuite--run-cycle-tests): Re-enabled all tests.
+ (icalendar-testsuite--run-cycle-tests): Re-enable all tests.
2009-09-30 Glenn Morris <rgm@gnu.org>
@@ -307,12 +499,12 @@
2009-01-25 Ulf Jasper <ulf.jasper@web.de>
* icalendar-testsuite.el
- (icalendar-testsuite--run-function-tests): Added
- icalendar-testsuite--test-diarytime-to-isotime.
- (icalendar-testsuite--test-parse-summary-and-rest): Adjusted to
+ (icalendar-testsuite--run-function-tests):
+ Add icalendar-testsuite--test-diarytime-to-isotime.
+ (icalendar-testsuite--test-parse-summary-and-rest): Adjust to
recent icalendar fixes.
(icalendar-testsuite--test-diarytime-to-isotime): New.
- (icalendar-testsuite--test-create-uid): Adjusted to recent
+ (icalendar-testsuite--test-create-uid): Adjust to recent
icalendar changes.
2008-11-30 Shigeru Fukaya <shigeru.fukaya@gmail.com>
@@ -322,7 +514,7 @@
2008-10-31 Ulf Jasper <ulf.jasper@web.de>
* icalendar-testsuite.el (icalendar-testsuite--run-function-tests):
- Added `icalendar-testsuite--test-create-uid'.
+ Add `icalendar-testsuite--test-create-uid'.
(icalendar-testsuite--test-create-uid): New.
2008-06-14 Ulf Jasper <ulf.jasper@web.de>
@@ -365,7 +557,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/test/automated/Makefile.in b/test/automated/Makefile.in
index b16c9721897..5f92e21d91a 100644
--- a/test/automated/Makefile.in
+++ b/test/automated/Makefile.in
@@ -1,5 +1,5 @@
# Maintenance productions for the automated test directory
-# Copyright (C) 2010-2011 Free Software Foundation, Inc.
+# Copyright (C) 2010-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -48,14 +48,14 @@ BYTE_COMPILE_EXTRA_FLAGS =
emacs = EMACSLOADPATH=$(lispsrc):$(test) LC_ALL=C $(EMACS) $(EMACSOPT)
# Common command to find subdirectories
-setwins=subdirs=`(find . -type d -print)`; \
+setwins=subdirs=`find . -type d -print`; \
for file in $$subdirs; do \
case $$file in */.* | */.*/* | */=* ) ;; \
*) wins="$$wins $$file" ;; \
esac; \
done
-all: test
+all: check
doit:
diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el
new file mode 100644
index 00000000000..94f69e77e43
--- /dev/null
+++ b/test/automated/advice-tests.el
@@ -0,0 +1,116 @@
+;;; advice-tests.el --- Test suite for the new advice thingy.
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(ert-deftest advice-tests ()
+ "Test advice code."
+ (with-temp-buffer
+ (defun sm-test1 (x) (+ x 4))
+ (should (equal (sm-test1 6) 10))
+ (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
+ (should (equal (sm-test1 6) 50))
+ (defun sm-test1 (x) (+ x 14))
+ (should (equal (sm-test1 6) 100))
+ (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil))
+ (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5)))
+ (should (equal (sm-test1 6) 20))
+ (should (equal (null (get 'sm-test1 'defalias-fset-function)) t))
+
+ (defun sm-test2 (x) (+ x 4))
+ (should (equal (sm-test2 6) 10))
+ (defadvice sm-test2 (around sm-test activate)
+ ad-do-it (setq ad-return-value (* ad-return-value 5)))
+ (should (equal (sm-test2 6) 50))
+ (ad-deactivate 'sm-test2)
+ (should (equal (sm-test2 6) 10))
+ (ad-activate 'sm-test2)
+ (should (equal (sm-test2 6) 50))
+ (defun sm-test2 (x) (+ x 14))
+ (should (equal (sm-test2 6) 100))
+ (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil))
+ (ad-remove-advice 'sm-test2 'around 'sm-test)
+ (should (equal (sm-test2 6) 100))
+ (ad-activate 'sm-test2)
+ (should (equal (sm-test2 6) 20))
+ (should (equal (null (get 'sm-test2 'defalias-fset-function)) t))
+
+ (advice-add 'sm-test3 :around
+ (lambda (f &rest args) `(toto ,(apply f args)))
+ '((name . wrap-with-toto)))
+ (defmacro sm-test3 (x) `(call-test3 ,x))
+ (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56))))
+
+ (defadvice sm-test4 (around wrap-with-toto activate)
+ ad-do-it (setq ad-return-value `(toto ,ad-return-value)))
+ (defmacro sm-test4 (x) `(call-test4 ,x))
+ (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56))))
+ (defmacro sm-test4 (x) `(call-testq ,x))
+ (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56))))
+
+ ;; Combining old style and new style advices.
+ (defun sm-test5 (x) (+ x 4))
+ (should (equal (sm-test5 6) 10))
+ (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5)))
+ (should (equal (sm-test5 6) 50))
+ (defadvice sm-test5 (around test activate)
+ ad-do-it (setq ad-return-value (+ ad-return-value 0.1)))
+ (should (equal (sm-test5 5) 45.1))
+ (ad-deactivate 'sm-test5)
+ (should (equal (sm-test5 6) 50))
+ (ad-activate 'sm-test5)
+ (should (equal (sm-test5 6) 50.1))
+ (defun sm-test5 (x) (+ x 14))
+ (should (equal (sm-test5 6) 100.1))
+ (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5)))
+ (should (equal (sm-test5 6) 20.1))
+
+ ;; This used to signal an error (bug#12858).
+ (autoload 'sm-test6 "foo")
+ (defadvice sm-test6 (around test activate)
+ ad-do-it)
+
+ ;; Check interaction between advice and called-interactively-p.
+ (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4))
+ (advice-add 'sm-test7 :around
+ (lambda (f &rest args)
+ (list (cons 1 (called-interactively-p)) (apply f args))))
+ (should (equal (sm-test7) '((1 . nil) 11)))
+ (should (equal (call-interactively 'sm-test7) '((1 . t) 11)))
+ (let ((smi 7))
+ (advice-add 'sm-test7 :before
+ (lambda (&rest args)
+ (setq smi (called-interactively-p))))
+ (should (equal (list (sm-test7) smi)
+ '(((1 . nil) 11) nil)))
+ (should (equal (list (call-interactively 'sm-test7) smi)
+ '(((1 . t) 11) t))))
+ (advice-add 'sm-test7 :around
+ (lambda (f &rest args)
+ (cons (cons 2 (called-interactively-p)) (apply f args))))
+ (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11)))
+ ))
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; advice-tests.el ends here.
diff --git a/test/automated/bytecomp-tests.el b/test/automated/bytecomp-tests.el
index 45d5b19ee71..b7ec79fd51c 100644
--- a/test/automated/bytecomp-tests.el
+++ b/test/automated/bytecomp-tests.el
@@ -1,6 +1,6 @@
;;; bytecomp-testsuite.el
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Shigeru Fukaya <shigeru.fukaya@gmail.com>
;; Created: November 2008
diff --git a/test/automated/comint-testsuite.el b/test/automated/comint-testsuite.el
index 4b2d3896407..7317c107d59 100644
--- a/test/automated/comint-testsuite.el
+++ b/test/automated/comint-testsuite.el
@@ -1,6 +1,6 @@
;;; comint-testsuite.el
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/automated/compile-tests.el b/test/automated/compile-tests.el
index 0203084bf38..9415ee3a17e 100644
--- a/test/automated/compile-tests.el
+++ b/test/automated/compile-tests.el
@@ -1,6 +1,6 @@
;;; compile-tests.el --- Test suite for font parsing.
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Chong Yidong <cyd@stupidchicken.com>
;; Keywords: internal
@@ -199,6 +199,8 @@
;; maven
("FooBar.java:[111,53] no interface expected here"
1 53 111 "FooBar.java")
+ (" [ERROR] /Users/cinsk/hello.java:[651,96] ';' expected"
+ 15 96 651 "/Users/cinsk/hello.java") ;Bug#11517.
;; mips-1 mips-2
("TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation"
11 nil 255 "solomon.c")
@@ -213,6 +215,10 @@
1 nil 23 "d:\\tmp\\test.c")
("d:\\tmp\\test.c(1145) : see declaration of 'nsRefPtr'"
1 nil 1145 "d:\\tmp\\test.c")
+ ("1>test_main.cpp(29): error C2144: syntax error : 'int' should be preceded by ';'"
+ 3 nil 29 "test_main.cpp")
+ ("1>test_main.cpp(29): error C4430: missing type specifier - int assumed. Note: C++ does not support default-int"
+ 3 nil 29 "test_main.cpp")
;; watcom
("..\src\ctrl\lister.c(109): Error! E1009: Expecting ';' but found '{'"
1 nil 109 "..\src\ctrl\lister.c")
diff --git a/test/automated/ert-tests.el b/test/automated/ert-tests.el
index 1fe6352e1fe..1aef1921871 100644
--- a/test/automated/ert-tests.el
+++ b/test/automated/ert-tests.el
@@ -1,6 +1,6 @@
-;;; ert-tests.el --- ERT's self-tests
+;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2008, 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc.
;; Author: Christian Ohler <ohler@gnu.org>
@@ -27,7 +27,7 @@
;;; Code:
(eval-when-compile
- (require 'cl))
+ (require 'cl-lib))
(require 'ert)
@@ -45,7 +45,7 @@
;; The buffer name chosen here should not compete with the default
;; results buffer name for completion in `switch-to-buffer'.
(let ((stats (ert-run-tests-interactively "^ert-" " *ert self-tests*")))
- (assert ert--test-body-was-run)
+ (cl-assert ert--test-body-was-run)
(if (zerop (ert-stats-completed-unexpected stats))
;; Hide results window only when everything went well.
(set-window-configuration window-configuration)
@@ -71,26 +71,26 @@ failed or if there was a problem."
(ert-deftest ert-test-nested-test-body-runs ()
"Test that nested test bodies run."
- (lexical-let ((was-run nil))
+ (let ((was-run nil))
(let ((test (make-ert-test :body (lambda ()
(setq was-run t)))))
- (assert (not was-run))
+ (cl-assert (not was-run))
(ert-run-test test)
- (assert was-run))))
+ (cl-assert was-run))))
;;; Test that pass/fail works.
(ert-deftest ert-test-pass ()
(let ((test (make-ert-test :body (lambda ()))))
(let ((result (ert-run-test test)))
- (assert (ert-test-passed-p result)))))
+ (cl-assert (ert-test-passed-p result)))))
(ert-deftest ert-test-fail ()
(let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
(let ((result (let ((ert-debug-on-error nil))
(ert-run-test test))))
- (assert (ert-test-failed-p result) t)
- (assert (equal (ert-test-result-with-condition-condition result)
+ (cl-assert (ert-test-failed-p result) t)
+ (cl-assert (equal (ert-test-result-with-condition-condition result)
'(ert-test-failed "failure message"))
t))))
@@ -100,50 +100,50 @@ failed or if there was a problem."
(progn
(let ((ert-debug-on-error t))
(ert-run-test test))
- (assert nil))
+ (cl-assert nil))
((error)
- (assert (equal condition '(ert-test-failed "failure message")) t)))))
+ (cl-assert (equal condition '(ert-test-failed "failure message")) t)))))
(ert-deftest ert-test-fail-debug-with-debugger-1 ()
(let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
- (let ((debugger (lambda (&rest debugger-args)
- (assert nil))))
+ (let ((debugger (lambda (&rest _args)
+ (cl-assert nil))))
(let ((ert-debug-on-error nil))
(ert-run-test test)))))
(ert-deftest ert-test-fail-debug-with-debugger-2 ()
(let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
- (block nil
- (let ((debugger (lambda (&rest debugger-args)
- (return-from nil nil))))
+ (cl-block nil
+ (let ((debugger (lambda (&rest _args)
+ (cl-return-from nil nil))))
(let ((ert-debug-on-error t))
(ert-run-test test))
- (assert nil)))))
+ (cl-assert nil)))))
(ert-deftest ert-test-fail-debug-nested-with-debugger ()
(let ((test (make-ert-test :body (lambda ()
(let ((ert-debug-on-error t))
(ert-fail "failure message"))))))
- (let ((debugger (lambda (&rest debugger-args)
- (assert nil nil "Assertion a"))))
+ (let ((debugger (lambda (&rest _args)
+ (cl-assert nil nil "Assertion a"))))
(let ((ert-debug-on-error nil))
(ert-run-test test))))
(let ((test (make-ert-test :body (lambda ()
(let ((ert-debug-on-error nil))
(ert-fail "failure message"))))))
- (block nil
- (let ((debugger (lambda (&rest debugger-args)
- (return-from nil nil))))
+ (cl-block nil
+ (let ((debugger (lambda (&rest _args)
+ (cl-return-from nil nil))))
(let ((ert-debug-on-error t))
(ert-run-test test))
- (assert nil nil "Assertion b")))))
+ (cl-assert nil nil "Assertion b")))))
(ert-deftest ert-test-error ()
(let ((test (make-ert-test :body (lambda () (error "Error message")))))
(let ((result (let ((ert-debug-on-error nil))
(ert-run-test test))))
- (assert (ert-test-failed-p result) t)
- (assert (equal (ert-test-result-with-condition-condition result)
+ (cl-assert (ert-test-failed-p result) t)
+ (cl-assert (equal (ert-test-result-with-condition-condition result)
'(error "Error message"))
t))))
@@ -153,9 +153,9 @@ failed or if there was a problem."
(progn
(let ((ert-debug-on-error t))
(ert-run-test test))
- (assert nil))
+ (cl-assert nil))
((error)
- (assert (equal condition '(error "Error message")) t)))))
+ (cl-assert (equal condition '(error "Error message")) t)))))
;;; Test that `should' works.
@@ -163,13 +163,13 @@ failed or if there was a problem."
(let ((test (make-ert-test :body (lambda () (should nil)))))
(let ((result (let ((ert-debug-on-error nil))
(ert-run-test test))))
- (assert (ert-test-failed-p result) t)
- (assert (equal (ert-test-result-with-condition-condition result)
+ (cl-assert (ert-test-failed-p result) t)
+ (cl-assert (equal (ert-test-result-with-condition-condition result)
'(ert-test-failed ((should nil) :form nil :value nil)))
t)))
(let ((test (make-ert-test :body (lambda () (should t)))))
(let ((result (ert-run-test test)))
- (assert (ert-test-passed-p result) t))))
+ (cl-assert (ert-test-passed-p result) t))))
(ert-deftest ert-test-should-value ()
(should (eql (should 'foo) 'foo))
@@ -179,17 +179,18 @@ failed or if there was a problem."
(let ((test (make-ert-test :body (lambda () (should-not t)))))
(let ((result (let ((ert-debug-on-error nil))
(ert-run-test test))))
- (assert (ert-test-failed-p result) t)
- (assert (equal (ert-test-result-with-condition-condition result)
+ (cl-assert (ert-test-failed-p result) t)
+ (cl-assert (equal (ert-test-result-with-condition-condition result)
'(ert-test-failed ((should-not t) :form t :value t)))
t)))
(let ((test (make-ert-test :body (lambda () (should-not nil)))))
(let ((result (ert-run-test test)))
- (assert (ert-test-passed-p result)))))
+ (cl-assert (ert-test-passed-p result)))))
+
(ert-deftest ert-test-should-with-macrolet ()
(let ((test (make-ert-test :body (lambda ()
- (macrolet ((foo () `(progn t nil)))
+ (cl-macrolet ((foo () `(progn t nil)))
(should (foo)))))))
(let ((result (let ((ert-debug-on-error nil))
(ert-run-test test))))
@@ -303,32 +304,33 @@ This macro is used to test if macroexpansion in `should' works."
(ert-deftest ert-test-should-failure-debugging ()
"Test that `should' errors contain the information we expect them to."
- (loop for (body expected-condition) in
- `((,(lambda () (let ((x nil)) (should x)))
- (ert-test-failed ((should x) :form x :value nil)))
- (,(lambda () (let ((x t)) (should-not x)))
- (ert-test-failed ((should-not x) :form x :value t)))
- (,(lambda () (let ((x t)) (should (not x))))
- (ert-test-failed ((should (not x)) :form (not t) :value nil)))
- (,(lambda () (let ((x nil)) (should-not (not x))))
- (ert-test-failed ((should-not (not x)) :form (not nil) :value t)))
- (,(lambda () (let ((x t) (y nil)) (should-not
- (ert--test-my-list x y))))
- (ert-test-failed
- ((should-not (ert--test-my-list x y))
- :form (list t nil)
- :value (t nil))))
- (,(lambda () (let ((x t)) (should (error "Foo"))))
- (error "Foo")))
- do
- (let ((test (make-ert-test :body body)))
- (condition-case actual-condition
- (progn
- (let ((ert-debug-on-error t))
- (ert-run-test test))
- (assert nil))
- ((error)
- (should (equal actual-condition expected-condition)))))))
+ (cl-loop
+ for (body expected-condition) in
+ `((,(lambda () (let ((x nil)) (should x)))
+ (ert-test-failed ((should x) :form x :value nil)))
+ (,(lambda () (let ((x t)) (should-not x)))
+ (ert-test-failed ((should-not x) :form x :value t)))
+ (,(lambda () (let ((x t)) (should (not x))))
+ (ert-test-failed ((should (not x)) :form (not t) :value nil)))
+ (,(lambda () (let ((x nil)) (should-not (not x))))
+ (ert-test-failed ((should-not (not x)) :form (not nil) :value t)))
+ (,(lambda () (let ((x t) (y nil)) (should-not
+ (ert--test-my-list x y))))
+ (ert-test-failed
+ ((should-not (ert--test-my-list x y))
+ :form (list t nil)
+ :value (t nil))))
+ (,(lambda () (let ((_x t)) (should (error "Foo"))))
+ (error "Foo")))
+ do
+ (let ((test (make-ert-test :body body)))
+ (condition-case actual-condition
+ (progn
+ (let ((ert-debug-on-error t))
+ (ert-run-test test))
+ (cl-assert nil))
+ ((error)
+ (should (equal actual-condition expected-condition)))))))
(ert-deftest ert-test-deftest ()
(should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar)))
@@ -520,7 +522,7 @@ This macro is used to test if macroexpansion in `should' works."
(setf (cdr (last a)) (cddr a))
(should (not (ert--proper-list-p a))))
(let ((a (list 1 2 3 4)))
- (setf (cdr (last a)) (cdddr a))
+ (setf (cdr (last a)) (cl-cdddr a))
(should (not (ert--proper-list-p a)))))
(ert-deftest ert-test-parse-keys-and-body ()
@@ -657,14 +659,14 @@ This macro is used to test if macroexpansion in `should' works."
(i 0))
(let ((result (ert--remove-if-not (lambda (x)
(should (eql x (nth i list)))
- (incf i)
+ (cl-incf i)
(member i '(2 3)))
list)))
(should (equal i 4))
(should (equal result '(b c)))
(should (equal list '(a b c d)))))
(should (equal '()
- (ert--remove-if-not (lambda (x) (should nil)) '()))))
+ (ert--remove-if-not (lambda (_x) (should nil)) '()))))
(ert-deftest ert-test-remove* ()
(let ((list (list 'a 'b 'c 'd))
@@ -676,13 +678,13 @@ This macro is used to test if macroexpansion in `should' works."
(should (eql x (nth key-index list)))
(prog1
(list key-index x)
- (incf key-index)))
+ (cl-incf key-index)))
:test
(lambda (a b)
(should (eql a 'foo))
(should (equal b (list test-index
(nth test-index list))))
- (incf test-index)
+ (cl-incf test-index)
(member test-index '(2 3))))))
(should (equal key-index 4))
(should (equal test-index 4))
diff --git a/test/automated/ert-x-tests.el b/test/automated/ert-x-tests.el
index ff056b40b36..e03c8475442 100644
--- a/test/automated/ert-x-tests.el
+++ b/test/automated/ert-x-tests.el
@@ -1,6 +1,6 @@
;;; ert-x-tests.el --- Tests for ert-x.el
-;; Copyright (C) 2008, 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc.
;; Author: Phil Hagelberg
;; Christian Ohler <ohler@gnu.org>
@@ -28,7 +28,7 @@
;;; Code:
(eval-when-compile
- (require 'cl))
+ (require 'cl-lib))
(require 'ert)
(require 'ert-x)
@@ -103,79 +103,79 @@
(ert-deftest ert-test-run-tests-interactively-2 ()
:tags '(:causes-redisplay)
- (let ((passing-test (make-ert-test :name 'passing-test
- :body (lambda () (ert-pass))))
- (failing-test (make-ert-test :name 'failing-test
- :body (lambda ()
- (ert-info ((propertize "foo\nbar"
- 'a 'b))
- (ert-fail
- "failure message"))))))
- (let ((ert-debug-on-error nil))
- (let* ((buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
- (messages nil)
- (mock-message-fn
- (lambda (format-string &rest args)
- (push (apply #'format format-string args) messages))))
- (flet ((expected-string (with-font-lock-p)
- (ert-propertized-string
- "Selector: (member <passing-test> <failing-test>)\n"
- "Passed: 1\n"
- "Failed: 1 (1 unexpected)\n"
- "Total: 2/2\n\n"
- "Started at:\n"
- "Finished.\n"
- "Finished at:\n\n"
- `(category ,(button-category-symbol
- 'ert--results-progress-bar-button)
- button (t)
- face ,(if with-font-lock-p
- 'ert-test-result-unexpected
- 'button))
- ".F" nil "\n\n"
- `(category ,(button-category-symbol
- 'ert--results-expand-collapse-button)
- button (t)
- face ,(if with-font-lock-p
- 'ert-test-result-unexpected
- 'button))
- "F" nil " "
- `(category ,(button-category-symbol
- 'ert--test-name-button)
- button (t)
- ert-test-name failing-test)
- "failing-test"
- nil "\n Info: " '(a b) "foo\n"
- nil " " '(a b) "bar"
- nil "\n (ert-test-failed \"failure message\")\n\n\n"
- )))
- (save-window-excursion
- (unwind-protect
- (let ((case-fold-search nil))
- (ert-run-tests-interactively
- `(member ,passing-test ,failing-test) buffer-name
- mock-message-fn)
- (should (equal messages `(,(concat
- "Ran 2 tests, 1 results were "
- "as expected, 1 unexpected"))))
- (with-current-buffer buffer-name
- (font-lock-mode 0)
- (should (ert-equal-including-properties
- (ert-filter-string (buffer-string)
- '("Started at:\\(.*\\)$" 1)
- '("Finished at:\\(.*\\)$" 1))
- (expected-string nil)))
- ;; `font-lock-mode' only works if interactive, so
- ;; pretend we are.
- (let ((noninteractive nil))
- (font-lock-mode 1))
- (should (ert-equal-including-properties
- (ert-filter-string (buffer-string)
- '("Started at:\\(.*\\)$" 1)
- '("Finished at:\\(.*\\)$" 1))
- (expected-string t)))))
- (when (get-buffer buffer-name)
- (kill-buffer buffer-name)))))))))
+ (let* ((passing-test (make-ert-test :name 'passing-test
+ :body (lambda () (ert-pass))))
+ (failing-test (make-ert-test :name 'failing-test
+ :body (lambda ()
+ (ert-info ((propertize "foo\nbar"
+ 'a 'b))
+ (ert-fail
+ "failure message")))))
+ (ert-debug-on-error nil)
+ (buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
+ (messages nil)
+ (mock-message-fn
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages))))
+ (cl-flet ((expected-string (with-font-lock-p)
+ (ert-propertized-string
+ "Selector: (member <passing-test> <failing-test>)\n"
+ "Passed: 1\n"
+ "Failed: 1 (1 unexpected)\n"
+ "Total: 2/2\n\n"
+ "Started at:\n"
+ "Finished.\n"
+ "Finished at:\n\n"
+ `(category ,(button-category-symbol
+ 'ert--results-progress-bar-button)
+ button (t)
+ face ,(if with-font-lock-p
+ 'ert-test-result-unexpected
+ 'button))
+ ".F" nil "\n\n"
+ `(category ,(button-category-symbol
+ 'ert--results-expand-collapse-button)
+ button (t)
+ face ,(if with-font-lock-p
+ 'ert-test-result-unexpected
+ 'button))
+ "F" nil " "
+ `(category ,(button-category-symbol
+ 'ert--test-name-button)
+ button (t)
+ ert-test-name failing-test)
+ "failing-test"
+ nil "\n Info: " '(a b) "foo\n"
+ nil " " '(a b) "bar"
+ nil "\n (ert-test-failed \"failure message\")\n\n\n"
+ )))
+ (save-window-excursion
+ (unwind-protect
+ (let ((case-fold-search nil))
+ (ert-run-tests-interactively
+ `(member ,passing-test ,failing-test) buffer-name
+ mock-message-fn)
+ (should (equal messages `(,(concat
+ "Ran 2 tests, 1 results were "
+ "as expected, 1 unexpected"))))
+ (with-current-buffer buffer-name
+ (font-lock-mode 0)
+ (should (ert-equal-including-properties
+ (ert-filter-string (buffer-string)
+ '("Started at:\\(.*\\)$" 1)
+ '("Finished at:\\(.*\\)$" 1))
+ (expected-string nil)))
+ ;; `font-lock-mode' only works if interactive, so
+ ;; pretend we are.
+ (let ((noninteractive nil))
+ (font-lock-mode 1))
+ (should (ert-equal-including-properties
+ (ert-filter-string (buffer-string)
+ '("Started at:\\(.*\\)$" 1)
+ '("Finished at:\\(.*\\)$" 1))
+ (expected-string t)))))
+ (when (get-buffer buffer-name)
+ (kill-buffer buffer-name)))))))
(ert-deftest ert-test-describe-test ()
"Tests `ert-describe-test'."
@@ -233,8 +233,8 @@ desired effect."
(should (equal (buffer-string) ""))
(let ((message-log-max 2))
(let ((message-log-max t))
- (loop for i below 4 do
- (message "%s" i))
+ (cl-loop for i below 4 do
+ (message "%s" i))
(should (equal (buffer-string) "0\n1\n2\n3\n")))
(should (equal (buffer-string) "0\n1\n2\n3\n"))
(message "")
@@ -244,28 +244,28 @@ desired effect."
(ert-deftest ert-test-force-message-log-buffer-truncation ()
:tags '(:causes-redisplay)
- (labels ((body ()
- (loop for i below 3 do
- (message "%s" i)))
- ;; Uses the implicit messages buffer truncation implemented
- ;; in Emacs' C core.
- (c (x)
- (ert-with-buffer-renamed ("*Messages*")
- (let ((message-log-max x))
- (body))
- (with-current-buffer "*Messages*"
- (buffer-string))))
- ;; Uses our lisp reimplementation.
- (lisp (x)
- (ert-with-buffer-renamed ("*Messages*")
- (let ((message-log-max t))
- (body))
- (let ((message-log-max x))
- (ert--force-message-log-buffer-truncation))
- (with-current-buffer "*Messages*"
- (buffer-string)))))
- (loop for x in '(0 1 2 3 4 t) do
- (should (equal (c x) (lisp x))))))
+ (cl-labels ((body ()
+ (cl-loop for i below 3 do
+ (message "%s" i)))
+ ;; Uses the implicit messages buffer truncation implemented
+ ;; in Emacs' C core.
+ (c (x)
+ (ert-with-buffer-renamed ("*Messages*")
+ (let ((message-log-max x))
+ (body))
+ (with-current-buffer "*Messages*"
+ (buffer-string))))
+ ;; Uses our lisp reimplementation.
+ (lisp (x)
+ (ert-with-buffer-renamed ("*Messages*")
+ (let ((message-log-max t))
+ (body))
+ (let ((message-log-max x))
+ (ert--force-message-log-buffer-truncation))
+ (with-current-buffer "*Messages*"
+ (buffer-string)))))
+ (cl-loop for x in '(0 1 2 3 4 t) do
+ (should (equal (c x) (lisp x))))))
(provide 'ert-x-tests)
diff --git a/test/automated/f90.el b/test/automated/f90.el
index 5d75d5cd0fb..25b77f07ad3 100644
--- a/test/automated/f90.el
+++ b/test/automated/f90.el
@@ -1,6 +1,6 @@
;;; f90.el --- tests for progmodes/f90.el
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Glenn Morris <rgm@gnu.org>
diff --git a/test/automated/files.el b/test/automated/files.el
new file mode 100644
index 00000000000..b6011395bfd
--- /dev/null
+++ b/test/automated/files.el
@@ -0,0 +1,149 @@
+;;; files.el --- tests for file handling.
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; 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/>.
+
+;;; Code:
+
+(require 'ert)
+
+;; Set to t if the local variable was set, `query' if the query was
+;; triggered.
+(defvar files-test-result)
+
+(defvar files-test-safe-result)
+(put 'files-test-safe-result 'safe-local-variable 'booleanp)
+
+(defun files-test-fun1 ()
+ (setq files-test-result t))
+
+;; Test combinations:
+;; `enable-local-variables' t, nil, :safe, :all, or something else.
+;; `enable-local-eval' t, nil, or something else.
+
+(defvar files-test-local-variable-data
+ ;; Unsafe eval form
+ '((("eval: (files-test-fun1)")
+ (t t (eq files-test-result t))
+ (t nil (eq files-test-result nil))
+ (t maybe (eq files-test-result 'query))
+ (nil t (eq files-test-result nil))
+ (nil nil (eq files-test-result nil))
+ (nil maybe (eq files-test-result nil))
+ (:safe t (eq files-test-result nil))
+ (:safe nil (eq files-test-result nil))
+ (:safe maybe (eq files-test-result nil))
+ (:all t (eq files-test-result t))
+ (:all nil (eq files-test-result nil))
+ (:all maybe (eq files-test-result t)) ; This combination is ambiguous.
+ (maybe t (eq files-test-result 'query))
+ (maybe nil (eq files-test-result 'query))
+ (maybe maybe (eq files-test-result 'query)))
+ ;; Unsafe local variable value
+ (("files-test-result: t")
+ (t t (eq files-test-result 'query))
+ (t nil (eq files-test-result 'query))
+ (t maybe (eq files-test-result 'query))
+ (nil t (eq files-test-result nil))
+ (nil nil (eq files-test-result nil))
+ (nil maybe (eq files-test-result nil))
+ (:safe t (eq files-test-result nil))
+ (:safe nil (eq files-test-result nil))
+ (:safe maybe (eq files-test-result nil))
+ (:all t (eq files-test-result t))
+ (:all nil (eq files-test-result t))
+ (:all maybe (eq files-test-result t))
+ (maybe t (eq files-test-result 'query))
+ (maybe nil (eq files-test-result 'query))
+ (maybe maybe (eq files-test-result 'query)))
+ ;; Safe local variable
+ (("files-test-safe-result: t")
+ (t t (eq files-test-safe-result t))
+ (t nil (eq files-test-safe-result t))
+ (t maybe (eq files-test-safe-result t))
+ (nil t (eq files-test-safe-result nil))
+ (nil nil (eq files-test-safe-result nil))
+ (nil maybe (eq files-test-safe-result nil))
+ (:safe t (eq files-test-safe-result t))
+ (:safe nil (eq files-test-safe-result t))
+ (:safe maybe (eq files-test-safe-result t))
+ (:all t (eq files-test-safe-result t))
+ (:all nil (eq files-test-safe-result t))
+ (:all maybe (eq files-test-safe-result t))
+ (maybe t (eq files-test-result 'query))
+ (maybe nil (eq files-test-result 'query))
+ (maybe maybe (eq files-test-result 'query)))
+ ;; Safe local variable with unsafe value
+ (("files-test-safe-result: 1")
+ (t t (eq files-test-result 'query))
+ (t nil (eq files-test-result 'query))
+ (t maybe (eq files-test-result 'query))
+ (nil t (eq files-test-safe-result nil))
+ (nil nil (eq files-test-safe-result nil))
+ (nil maybe (eq files-test-safe-result nil))
+ (:safe t (eq files-test-safe-result nil))
+ (:safe nil (eq files-test-safe-result nil))
+ (:safe maybe (eq files-test-safe-result nil))
+ (:all t (eq files-test-safe-result 1))
+ (:all nil (eq files-test-safe-result 1))
+ (:all maybe (eq files-test-safe-result 1))
+ (maybe t (eq files-test-result 'query))
+ (maybe nil (eq files-test-result 'query))
+ (maybe maybe (eq files-test-result 'query))))
+ "List of file-local variable tests.
+Each list element should have the form
+
+ (LOCAL-VARS-LIST . TEST-LIST)
+
+where LOCAL-VARS-LISTS should be a list of local variable
+definitions (strings) and TEST-LIST is a list of tests to
+perform. Each entry of TEST-LIST should have the form
+
+ (ENABLE-LOCAL-VARIABLES ENABLE-LOCAL-EVAL FORM)
+
+where ENABLE-LOCAL-VARIABLES is the value to assign to
+`enable-local-variables', ENABLE-LOCAL-EVAL is the value to
+assign to `enable-local-eval', and FORM is a desired `should'
+form.")
+
+(defun file-test--do-local-variables-test (str test-settings)
+ (with-temp-buffer
+ (insert str)
+ (let ((enable-local-variables (nth 0 test-settings))
+ (enable-local-eval (nth 1 test-settings))
+ (files-test-result nil)
+ (files-test-queried nil)
+ (files-test-safe-result nil))
+ (hack-local-variables)
+ (eval (nth 2 test-settings)))))
+
+(ert-deftest files-test-local-variables ()
+ "Test the file-local variables implementation."
+ (unwind-protect
+ (progn
+ (defadvice hack-local-variables-confirm (around files-test activate)
+ (setq files-test-result 'query)
+ nil)
+ (dolist (test files-test-local-variable-data)
+ (let ((str (concat "text\n\n;; Local Variables:\n;; "
+ (mapconcat 'identity (car test) "\n;; ")
+ "\n;; End:\n")))
+ (dolist (subtest (cdr test))
+ (should (file-test--do-local-variables-test str subtest))))))
+ (ad-disable-advice 'hack-local-variables-confirm 'around 'files-test)))
+
+;;; files.el ends here
diff --git a/test/automated/font-parse-tests.el b/test/automated/font-parse-tests.el
index 5ba8ad2be32..6aeaee4adce 100644
--- a/test/automated/font-parse-tests.el
+++ b/test/automated/font-parse-tests.el
@@ -1,6 +1,6 @@
;;; font-parse-tests.el --- Test suite for font parsing.
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Chong Yidong <cyd@stupidchicken.com>
;; Keywords: internal
diff --git a/test/automated/gnus-tests.el b/test/automated/gnus-tests.el
index f5742261d5b..3b5340bcdd3 100644
--- a/test/automated/gnus-tests.el
+++ b/test/automated/gnus-tests.el
@@ -1,6 +1,6 @@
;;; gnus-tests.el --- Wrapper for the Gnus tests
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
diff --git a/test/automated/icalendar-tests.el b/test/automated/icalendar-tests.el
index 6ed1d73767a..58b8379bb11 100644
--- a/test/automated/icalendar-tests.el
+++ b/test/automated/icalendar-tests.el
@@ -1,6 +1,6 @@
;; icalendar-tests.el --- Test suite for icalendar.el
-;; Copyright (C) 2005, 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2008-2012 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Created: March 2005
@@ -188,7 +188,7 @@ END:VTIMEZONE
(should (string= "STD-02:00DST-03:00,M3.5.0/03:00:00,M10.5.0/04:00:00"
(cdr result)))
(setq vtimezone (icalendar-tests--get-ical-event "BEGIN:VTIMEZONE
-TZID:anothername
+TZID:anothername\, with a comma
BEGIN:STANDARD
DTSTART:16010101T040000
TZOFFSETFROM:+0300
@@ -204,7 +204,7 @@ END:DAYLIGHT
END:VTIMEZONE
"))
(setq result (icalendar--parse-vtimezone vtimezone))
- (should (string= "anothername" (car result)))
+ (should (string= "anothername, with a comma" (car result)))
(message (cdr result))
(should (string= "STD-02:00DST-03:00,M3.2.1/03:00:00,M10.2.1/04:00:00"
(cdr result)))))
@@ -682,7 +682,7 @@ Argument EXPECTED-AMERICAN expected american style diary string."
(unless (eq (char-before) ?\n)
(insert "\n"))
(insert "END:VEVENT\nEND:VCALENDAR\n"))
- (let ((icalendar-import-format "%s%d%l%o%t%u%c")
+ (let ((icalendar-import-format "%s%d%l%o%t%u%c%U")
(icalendar-import-format-summary "%s")
(icalendar-import-format-location "\n Location: %s")
(icalendar-import-format-description "\n Desc: %s")
@@ -690,6 +690,7 @@ Argument EXPECTED-AMERICAN expected american style diary string."
(icalendar-import-format-status "\n Status: %s")
(icalendar-import-format-url "\n URL: %s")
(icalendar-import-format-class "\n Class: %s")
+ (icalendar-import-format-uid "\n UID: %s")
calendar-date-style)
(when expected-iso
(setq calendar-date-style 'iso)
@@ -731,10 +732,9 @@ DTSTART;VALUE=DATE-TIME:20030919"
"&19/9/2003 non-recurring allday\n"
"&9/19/2003 non-recurring allday\n")
(icalendar-tests--test-import
- ;; do not remove the trailing blank after "long"!
- "SUMMARY:long
- summary
-DTSTART;VALUE=DATE:20030919"
+ ;; Checkdoc removes trailing blanks. Therefore: format!
+ (format "%s\n%s\n%s" "SUMMARY:long " " summary"
+ "DTSTART;VALUE=DATE:20030919")
"&2003/9/19 long summary\n"
"&19/9/2003 long summary\n"
"&9/19/2003 long summary\n")
@@ -752,14 +752,17 @@ DTSTAMP:20031103T011641Z
"&%%(and (diary-block 2004 7 19 2004 8 27)) Sommerferien
Status: TENTATIVE
Class: PRIVATE
+ UID: 748f2da0-0d9b-11d8-97af-b4ec8686ea61
"
"&%%(and (diary-block 19 7 2004 27 8 2004)) Sommerferien
Status: TENTATIVE
Class: PRIVATE
+ UID: 748f2da0-0d9b-11d8-97af-b4ec8686ea61
"
"&%%(and (diary-block 7 19 2004 8 27 2004)) Sommerferien
Status: TENTATIVE
Class: PRIVATE
+ UID: 748f2da0-0d9b-11d8-97af-b4ec8686ea61
")
(icalendar-tests--test-import
"UID
@@ -783,13 +786,16 @@ LAST-MODIFIED
"
"&2004/11/23 14:00-14:30 folded summary
Status: TENTATIVE
- Class: PRIVATE\n"
+ Class: PRIVATE
+ UID: 04979712-3902-11d9-93dd-8f9f4afe08da\n"
"&23/11/2004 14:00-14:30 folded summary
Status: TENTATIVE
- Class: PRIVATE\n"
+ Class: PRIVATE
+ UID: 04979712-3902-11d9-93dd-8f9f4afe08da\n"
"&11/23/2004 14:00-14:30 folded summary
Status: TENTATIVE
- Class: PRIVATE\n")
+ Class: PRIVATE
+ UID: 04979712-3902-11d9-93dd-8f9f4afe08da\n")
(icalendar-tests--test-import
"UID
@@ -811,13 +817,16 @@ DTSTAMP
"
"&2004/11/23 14:45-15:45 another example
Status: TENTATIVE
- Class: PRIVATE\n"
+ Class: PRIVATE
+ UID: 6161a312-3902-11d9-b512-f764153bb28b\n"
"&23/11/2004 14:45-15:45 another example
Status: TENTATIVE
- Class: PRIVATE\n"
+ Class: PRIVATE
+ UID: 6161a312-3902-11d9-b512-f764153bb28b\n"
"&11/23/2004 14:45-15:45 another example
Status: TENTATIVE
- Class: PRIVATE\n"))
+ Class: PRIVATE
+ UID: 6161a312-3902-11d9-b512-f764153bb28b\n"))
(ert-deftest icalendar-import-rrule ()
(icalendar-tests--test-import
@@ -880,7 +889,6 @@ RRULE:FREQ=MONTHLY;UNTIL=20050819;
"DTSTART;VALUE=DATE:20040815
DTEND;VALUE=DATE:20040816
SUMMARY:Maria Himmelfahrt
-UID:CC56BEA6-49D2-11D8-8833-00039386D1C2-RID
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=8
"
"&%%(and (diary-anniversary 2004 8 15)) Maria Himmelfahrt\n"
@@ -983,11 +991,14 @@ SEQUENCE:1
CREATED:20041127T183329
"
"&%%(and (diary-cyclic 1 2001 12 21) (diary-block 2001 12 21 2001 12 29)) Urlaub
- Class: PUBLIC\n"
+ Class: PUBLIC
+ UID: 20041127T183329Z-18215-1001-4536-49109@andromeda\n"
"&%%(and (diary-cyclic 1 21 12 2001) (diary-block 21 12 2001 29 12 2001)) Urlaub
- Class: PUBLIC\n"
+ Class: PUBLIC
+ UID: 20041127T183329Z-18215-1001-4536-49109@andromeda\n"
"&%%(and (diary-cyclic 1 12 21 2001) (diary-block 12 21 2001 12 29 2001)) Urlaub
- Class: PUBLIC\n"))
+ Class: PUBLIC
+ UID: 20041127T183329Z-18215-1001-4536-49109@andromeda\n"))
(ert-deftest icalendar-import-bug-6766 ()
;;bug#6766 -- multiple byday values in a weekly rrule
@@ -1017,20 +1028,26 @@ UID:8814e3f9-7482-408f-996c-3bfe486a1263
"&%%(and (memq (calendar-day-of-week date) '(1 3 4 5)) (diary-cyclic 1 2010 4 21)) 11:30-12:00 Scrum
Status: CONFIRMED
Class: PUBLIC
+ UID: 8814e3f9-7482-408f-996c-3bfe486a1262
&%%(and (memq (calendar-day-of-week date) '(2 4)) (diary-cyclic 1 2010 4 22)) Tues + Thurs thinking
Class: PUBLIC
+ UID: 8814e3f9-7482-408f-996c-3bfe486a1263
"
"&%%(and (memq (calendar-day-of-week date) '(1 3 4 5)) (diary-cyclic 1 21 4 2010)) 11:30-12:00 Scrum
Status: CONFIRMED
Class: PUBLIC
+ UID: 8814e3f9-7482-408f-996c-3bfe486a1262
&%%(and (memq (calendar-day-of-week date) '(2 4)) (diary-cyclic 1 22 4 2010)) Tues + Thurs thinking
Class: PUBLIC
+ UID: 8814e3f9-7482-408f-996c-3bfe486a1263
"
"&%%(and (memq (calendar-day-of-week date) '(1 3 4 5)) (diary-cyclic 1 4 21 2010)) 11:30-12:00 Scrum
Status: CONFIRMED
Class: PUBLIC
+ UID: 8814e3f9-7482-408f-996c-3bfe486a1262
&%%(and (memq (calendar-day-of-week date) '(2 4)) (diary-cyclic 1 4 22 2010)) Tues + Thurs thinking
Class: PUBLIC
+ UID: 8814e3f9-7482-408f-996c-3bfe486a1263
"))
(ert-deftest icalendar-import-multiple-vcalendars ()
@@ -1075,6 +1092,55 @@ END:VCALENDAR
"&23/7/2011 event-1\n&24/7/2011 event-2\n&25/7/2011 event-3a\n&25/7/2011 event-3b\n"
"&7/23/2011 event-1\n&7/24/2011 event-2\n&7/25/2011 event-3a\n&7/25/2011 event-3b\n"))
+(ert-deftest icalendar-import-with-uid ()
+ "Perform import test with uid."
+ (icalendar-tests--test-import
+ "UID:1234567890uid
+SUMMARY:non-recurring
+DTSTART;VALUE=DATE-TIME:20030919T090000
+DTEND;VALUE=DATE-TIME:20030919T113000"
+ "&2003/9/19 09:00-11:30 non-recurring\n UID: 1234567890uid\n"
+ "&19/9/2003 09:00-11:30 non-recurring\n UID: 1234567890uid\n"
+ "&9/19/2003 09:00-11:30 non-recurring\n UID: 1234567890uid\n"))
+
+(ert-deftest icalendar-import-with-timezone ()
+ ;; bug#11473
+ (icalendar-tests--test-import
+ "BEGIN:VCALENDAR
+BEGIN:VTIMEZONE
+TZID:fictional\, nonexistent\, arbitrary
+BEGIN:STANDARD
+DTSTART:20100101T000000
+TZOFFSETFROM:+0200
+TZOFFSETTO:-0200
+RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=1SU;BYMONTH=01
+END:STANDARD
+BEGIN:DAYLIGHT
+DTSTART:20101201T000000
+TZOFFSETFROM:-0200
+TZOFFSETTO:+0200
+RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=1SU;BYMONTH=11
+END:DAYLIGHT
+END:VTIMEZONE
+BEGIN:VEVENT
+SUMMARY:standardtime
+DTSTART;TZID=\"fictional, nonexistent, arbitrary\":20120115T120000
+DTEND;TZID=\"fictional, nonexistent, arbitrary\":20120115T123000
+END:VEVENT
+BEGIN:VEVENT
+SUMMARY:daylightsavingtime
+DTSTART;TZID=\"fictional, nonexistent, arbitrary\":20121215T120000
+DTEND;TZID=\"fictional, nonexistent, arbitrary\":20121215T123000
+END:VEVENT
+END:VCALENDAR"
+ ;; "standardtime" begins first sunday in january and is 4 hours behind CET
+ ;; "daylightsavingtime" begins first sunday in november and is 1 hour before CET
+ "&2012/1/15 15:00-15:30 standardtime
+&2012/12/15 11:00-11:30 daylightsavingtime
+"
+ nil
+ nil)
+ )
;; ======================================================================
;; Cycle
;; ======================================================================
@@ -1090,14 +1156,15 @@ Argument INPUT icalendar event string."
(unless (eq (char-before) ?\n)
(insert "\n"))
(insert "END:VEVENT\nEND:VCALENDAR\n"))
- (let ((icalendar-import-format "%s%d%l%o%t%u%c")
+ (let ((icalendar-import-format "%s%d%l%o%t%u%c%U")
(icalendar-import-format-summary "%s")
(icalendar-import-format-location "\n Location: %s")
(icalendar-import-format-description "\n Desc: %s")
(icalendar-import-format-organizer "\n Organizer: %s")
(icalendar-import-format-status "\n Status: %s")
(icalendar-import-format-url "\n URL: %s")
- (icalendar-import-format-class "\n Class: %s"))
+ (icalendar-import-format-class "\n Class: %s")
+ (icalendar-import-format-class "\n UID: %s"))
(dolist (calendar-date-style '(iso european american))
(icalendar-tests--do-test-cycle)))))
@@ -1121,8 +1188,8 @@ Argument INPUT icalendar event string."
(save-excursion
(find-file temp-ics)
(goto-char (point-min))
- (when (re-search-forward "\nUID:.*\n" nil t)
- (replace-match "\n"))
+ ;;(when (re-search-forward "\nUID:.*\n" nil t)
+ ;;(replace-match "\n"))
(let ((cycled (buffer-substring-no-properties (point-min) (point-max))))
(should (string= org-input cycled)))))
;; clean up
@@ -1135,14 +1202,17 @@ Argument INPUT icalendar event string."
(delete-file temp-ics))))
(ert-deftest icalendar-cycle ()
- "Perform cycling tests."
+ "Perform cycling tests.
+Take care to avoid auto-generated UIDs here."
(icalendar-tests--test-cycle
- "DTSTART;VALUE=DATE-TIME:20030919T090000
+ "UID:dummyuid
+DTSTART;VALUE=DATE-TIME:20030919T090000
DTEND;VALUE=DATE-TIME:20030919T113000
SUMMARY:Cycletest
")
(icalendar-tests--test-cycle
- "DTSTART;VALUE=DATE-TIME:20030919T090000
+ "UID:blah
+DTSTART;VALUE=DATE-TIME:20030919T090000
DTEND;VALUE=DATE-TIME:20030919T113000
SUMMARY:Cycletest
DESCRIPTION:beschreibung!
@@ -1150,7 +1220,8 @@ LOCATION:nowhere
ORGANIZER:ulf
")
(icalendar-tests--test-cycle
- "DTSTART;VALUE=DATE:19190909
+ "UID:4711
+DTSTART;VALUE=DATE:19190909
DTEND;VALUE=DATE:19190910
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=09;BYMONTHDAY=09
SUMMARY:and diary-anniversary
@@ -1223,12 +1294,14 @@ END:VCALENDAR"
Location: Cccc
Organizer: MAILTO:aaaaaaa@aaaaaaa.com
Status: CONFIRMED
+ UID: 040000008200E00074C5B7101A82E0080000000080B6DE661216C301000000000000000010000000DB823520692542408ED02D7023F9DFF9
"
"&5/9/2003 10:30-15:30 On-Site Interview
Desc: 10:30am - Blah
Location: Cccc
Organizer: MAILTO:aaaaaaa@aaaaaaa.com
Status: CONFIRMED
+ UID: 040000008200E00074C5B7101A82E0080000000080B6DE661216C301000000000000000010000000DB823520692542408ED02D7023F9DFF9
")
;; 2003-06-18 a
@@ -1269,12 +1342,14 @@ END:VALARM"
Location: 555 or TN 555-5555 ID 5555 & NochWas (see below)
Organizer: MAILTO:xxx@xxxxx.com
Status: CONFIRMED
+ UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E
"
"&6/23/2003 11:00-12:00 Dress Rehearsal for XXXX-XXXX
Desc: 753 Zeichen hier radiert
Location: 555 or TN 555-5555 ID 5555 & NochWas (see below)
Organizer: MAILTO:xxx@xxxxx.com
Status: CONFIRMED
+ UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E
")
;; 2003-06-18 b -- uses timezone
(icalendar-tests--test-import
@@ -1339,12 +1414,14 @@ END:VCALENDAR"
Location: 123 or TN 123-1234 ID abcd & SonstWo (see below)
Organizer: MAILTO:bbb@bbbbb.com
Status: CONFIRMED
+ UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E
"
"&6/23/2003 17:00-18:00 Updated: Dress Rehearsal for ABC01-15
Desc: Viele Zeichen standen hier früher
Location: 123 or TN 123-1234 ID abcd & SonstWo (see below)
Organizer: MAILTO:bbb@bbbbb.com
Status: CONFIRMED
+ UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E
")
;; export 2004-10-28 block entries
(icalendar-tests--test-export
@@ -1568,8 +1645,6 @@ VERSION
PRODID
:-//Mozilla.org/NONSGML Mozilla Calendar V1.0//EN
BEGIN:VEVENT
-UID
- :04979712-3902-11d9-93dd-8f9f4afe08da
SUMMARY
:Jjjjj & Wwwww
STATUS
@@ -1588,8 +1663,6 @@ LAST-MODIFIED
:20041118T013640Z
END:VEVENT
BEGIN:VEVENT
-UID
- :6161a312-3902-11d9-b512-f764153bb28b
SUMMARY
:BB Aaaaaaaa Bbbbb
STATUS
@@ -1606,8 +1679,6 @@ DTSTAMP
:20041118T013641Z
END:VEVENT
BEGIN:VEVENT
-UID
- :943a4d7e-3902-11d9-9ce7-c9addeadf928
SUMMARY
:Hhhhhhhh
STATUS
@@ -1624,8 +1695,6 @@ DTSTAMP
:20041118T013831Z
END:VEVENT
BEGIN:VEVENT
-UID
- :fe53615e-3902-11d9-9dd8-9d38a155bf41
SUMMARY
:MMM Aaaaaaaaa
STATUS
@@ -1646,8 +1715,6 @@ DTSTAMP
:20041118T014117Z
END:VEVENT
BEGIN:VEVENT
-UID
- :87c928ee-3901-11d9-b21f-b45042155024
SUMMARY
:Rrrr/Cccccc ii Aaaaaaaa
DESCRIPTION
@@ -1670,8 +1737,6 @@ LAST-MODIFIED
:20041118T014203Z
END:VEVENT
BEGIN:VEVENT
-UID
- :e8f331ae-3902-11d9-9948-dfdcb66a2872
SUMMARY
:Wwww aa hhhh
STATUS
@@ -1791,11 +1856,13 @@ DTSTAMP
Desc: abcdef
Status: CONFIRMED
Class: PRIVATE
+ UID: b60d398e-1dd1-11b2-a159-cf8cb05139f4
"
"&%%(and (diary-block 2 6 2005 2 6 2005)) Waitangi Day
Desc: abcdef
Status: CONFIRMED
Class: PRIVATE
+ UID: b60d398e-1dd1-11b2-a159-cf8cb05139f4
")
;; 2005-03-01 lt
@@ -1806,8 +1873,10 @@ UID:6AFA7558-6994-11D9-8A3A-000A95A0E830-RID
DTSTAMP:20050118T210335Z
DURATION:P7D"
nil
- "&%%(and (diary-block 17 2 2005 23 2 2005)) Hhhhhh Aaaaa ii Aaaaaaaa\n"
- "&%%(and (diary-block 2 17 2005 2 23 2005)) Hhhhhh Aaaaa ii Aaaaaaaa\n")
+ "&%%(and (diary-block 17 2 2005 23 2 2005)) Hhhhhh Aaaaa ii Aaaaaaaa
+ UID: 6AFA7558-6994-11D9-8A3A-000A95A0E830-RID\n"
+ "&%%(and (diary-block 2 17 2005 2 23 2005)) Hhhhhh Aaaaa ii Aaaaaaaa
+ UID: 6AFA7558-6994-11D9-8A3A-000A95A0E830-RID\n")
;; 2005-03-23 lt
(icalendar-tests--test-export
@@ -1832,7 +1901,72 @@ DTEND;VALUE=DATE:19001102
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=11;BYMONTHDAY=1
SUMMARY:NNN Wwwwwwww Wwwww - Aaaaaa Pppppppp rrrrrr ddd oo Nnnnnnnn 30
")
- )
+
+ ;; bug#11473
+ (icalendar-tests--test-import
+ "BEGIN:VCALENDAR
+METHOD:REQUEST
+PRODID:Microsoft Exchange Server 2007
+VERSION:2.0
+BEGIN:VTIMEZONE
+TZID:(UTC+01:00) Amsterdam\, Berlin\, Bern\, Rome\, Stockholm\, Vienna
+BEGIN:STANDARD
+DTSTART:16010101T030000
+TZOFFSETFROM:+0200
+TZOFFSETTO:+0100
+RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=-1SU;BYMONTH=10
+END:STANDARD
+BEGIN:DAYLIGHT
+DTSTART:16010101T020000
+TZOFFSETFROM:+0100
+TZOFFSETTO:+0200
+RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=-1SU;BYMONTH=3
+END:DAYLIGHT
+END:VTIMEZONE
+BEGIN:VEVENT
+ORGANIZER;CN=\"A. Luser\":MAILTO:a.luser@foo.com
+ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;CN=\"Luser, Oth
+ er\":MAILTO:other.luser@foo.com
+DESCRIPTION;LANGUAGE=en-US:\nWhassup?\n\n
+SUMMARY;LANGUAGE=en-US:Query
+DTSTART;TZID=\"(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, Vienna\"
+ :20120515T150000
+DTEND;TZID=\"(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, Vienna\":2
+ 0120515T153000
+UID:040000008200E00074C5B7101A82E0080000000020FFAED0CFEFCC01000000000000000
+ 010000000575268034ECDB649A15349B1BF240F15
+RECURRENCE-ID;TZID=\"(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, V
+ ienna\":20120515T170000
+CLASS:PUBLIC
+PRIORITY:5
+DTSTAMP:20120514T153645Z
+TRANSP:OPAQUE
+STATUS:CONFIRMED
+SEQUENCE:15
+LOCATION;LANGUAGE=en-US:phone
+X-MICROSOFT-CDO-APPT-SEQUENCE:15
+X-MICROSOFT-CDO-OWNERAPPTID:1907632092
+X-MICROSOFT-CDO-BUSYSTATUS:TENTATIVE
+X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY
+X-MICROSOFT-CDO-ALLDAYEVENT:FALSE
+X-MICROSOFT-CDO-IMPORTANCE:1
+X-MICROSOFT-CDO-INSTTYPE:3
+BEGIN:VALARM
+ACTION:DISPLAY
+DESCRIPTION:REMINDER
+TRIGGER;RELATED=START:-PT15M
+END:VALARM
+END:VEVENT
+END:VCALENDAR"
+ nil
+ "&15/5/2012 15:00-15:30 Query
+ Location: phone
+ Organizer: MAILTO:a.luser@foo.com
+ Status: CONFIRMED
+ Class: PUBLIC
+ UID: 040000008200E00074C5B7101A82E0080000000020FFAED0CFEFCC01000000000000000010000000575268034ECDB649A15349B1BF240F15
+" nil)
+)
(provide 'icalendar-tests)
;;; icalendar-tests.el ends here
diff --git a/test/automated/lexbind-tests.el b/test/automated/lexbind-tests.el
index 95b8bbe8858..22668bc7d02 100644
--- a/test/automated/lexbind-tests.el
+++ b/test/automated/lexbind-tests.el
@@ -1,6 +1,6 @@
;;; lexbind-tests.el --- Testing the lexbind byte-compiler
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
diff --git a/test/automated/newsticker-tests.el b/test/automated/newsticker-tests.el
index 76f4345da55..5b60535e463 100644
--- a/test/automated/newsticker-tests.el
+++ b/test/automated/newsticker-tests.el
@@ -1,6 +1,6 @@
;;; newsticker-testsuite.el --- Test suite for newsticker.
-;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Keywords: News, RSS, Atom
diff --git a/test/automated/occur-tests.el b/test/automated/occur-tests.el
index 2ae5b1c132f..5fe9722d4e7 100644
--- a/test/automated/occur-tests.el
+++ b/test/automated/occur-tests.el
@@ -1,6 +1,6 @@
;;; occur-tests.el --- Test suite for occur.
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Juri Linkov <juri@jurta.org>
;; Keywords: matching, internal
@@ -35,7 +35,7 @@ xd
xex
fx
" "\
-5 matches for \"x\" in buffer: *temp*<2>
+5 matches for \"x\" in buffer: *test-occur*
1:xa
3:cx
4:xd
@@ -52,7 +52,7 @@ a
a
a
" "\
-2 matches for \"a^Ja\" in buffer: *temp*<2>
+2 matches for \"a^Ja\" in buffer: *test-occur*
1:a
:a
3:a
@@ -68,7 +68,7 @@ c
a
b
" "\
-2 matches for \"a^Jb\" in buffer: *temp*<2>
+2 matches for \"a^Jb\" in buffer: *test-occur*
1:a
:b
4:a
@@ -82,7 +82,7 @@ c
a
" "\
-2 matches for \"a^J\" in buffer: *temp*<2>
+2 matches for \"a^J\" in buffer: *test-occur*
1:a
:
4:a
@@ -97,7 +97,7 @@ d
ex
fx
" "\
-2 matches for \"x^J.x^J\" in buffer: *temp*<2>
+2 matches for \"x^J.x^J\" in buffer: *test-occur*
1:ax
:bx
:c
@@ -116,7 +116,7 @@ f
g
hx
" "\
-3 matches for \"x\" in buffer: *temp*<2>
+3 matches for \"x\" in buffer: *test-occur*
1:ax
:b
-------
@@ -136,7 +136,7 @@ d
ex
f
" "\
-2 matches for \"x\" in buffer: *temp*<2>
+2 matches for \"x\" in buffer: *test-occur*
:a
2:bx
:c
@@ -159,7 +159,7 @@ i
j
kx
" "\
-5 matches for \"x\" in buffer: *temp*<2>
+5 matches for \"x\" in buffer: *test-occur*
1:ax
2:bx
:c
@@ -184,7 +184,7 @@ gx
h
i
" "\
-2 matches for \"x\" in buffer: *temp*<2>
+2 matches for \"x\" in buffer: *test-occur*
:a
:b
3:cx
@@ -207,7 +207,7 @@ gx
h
" "\
-2 matches for \"x\" in buffer: *temp*<2>
+2 matches for \"x\" in buffer: *test-occur*
:
:b
3:cx
@@ -232,7 +232,7 @@ i
jx
kx
" "\
-3 matches for \"x^J.x\" in buffer: *temp*<2>
+3 matches for \"x^J.x\" in buffer: *test-occur*
1:ax
:bx
:c
@@ -256,7 +256,7 @@ f
gx
hx
" "\
-2 matches for \"x^J.x\" in buffer: *temp*<2>
+2 matches for \"x^J.x\" in buffer: *test-occur*
1:ax
:bx
:c
@@ -279,7 +279,7 @@ g
h
ix
" "\
-3 matches for \"x\" in buffer: *temp*<2>
+3 matches for \"x\" in buffer: *test-occur*
:a
2:bx
-------
@@ -302,7 +302,7 @@ f
gx
h
" "\
-3 matches for \"x\" in buffer: *temp*<2>
+3 matches for \"x\" in buffer: *test-occur*
:a
2:bx
:c
@@ -321,14 +321,19 @@ Each element has the format:
(let ((regexp (nth 0 test))
(nlines (nth 1 test))
(input-buffer-string (nth 2 test))
- (output-buffer-string (nth 3 test)))
- (save-window-excursion
- (with-temp-buffer
- (insert input-buffer-string)
- (occur regexp nlines)
- (equal output-buffer-string
- (with-current-buffer "*Occur*"
- (buffer-string)))))))
+ (output-buffer-string (nth 3 test))
+ (temp-buffer (get-buffer-create " *test-occur*")))
+ (unwind-protect
+ (save-window-excursion
+ (with-current-buffer temp-buffer
+ (erase-buffer)
+ (insert input-buffer-string)
+ (occur regexp nlines)
+ (equal output-buffer-string
+ (with-current-buffer "*Occur*"
+ (buffer-string)))))
+ (and (buffer-name temp-buffer)
+ (kill-buffer temp-buffer)))))
(ert-deftest occur-tests ()
"Test the functionality of `occur'.
diff --git a/test/automated/ruby-mode-tests.el b/test/automated/ruby-mode-tests.el
new file mode 100644
index 00000000000..ad48413b030
--- /dev/null
+++ b/test/automated/ruby-mode-tests.el
@@ -0,0 +1,365 @@
+;;; ruby-mode-tests.el --- Test suite for ruby-mode
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ruby-mode)
+
+(defun ruby-should-indent (content column)
+ "Assert indentation COLUMN on the last line of CONTENT."
+ (with-temp-buffer
+ (insert content)
+ (ruby-mode)
+ (ruby-indent-line)
+ (should (= (current-indentation) column))))
+
+(defun ruby-should-indent-buffer (expected content)
+ "Assert that CONTENT turns into EXPECTED after the buffer is re-indented.
+
+The whitespace before and including \"|\" on each line is removed."
+ (with-temp-buffer
+ (insert (ruby-test-string content))
+ (ruby-mode)
+ (indent-region (point-min) (point-max))
+ (should (string= (ruby-test-string expected) (buffer-string)))))
+
+(defun ruby-test-string (s &rest args)
+ (apply 'format (replace-regexp-in-string "^[ \t]*|" "" s) args))
+
+(defun ruby-assert-state (content &rest values-plist)
+ "Assert syntax state values at the end of CONTENT.
+
+VALUES-PLIST is a list with alternating index and value elements."
+ (with-temp-buffer
+ (insert content)
+ (ruby-mode)
+ (syntax-propertize (point))
+ (while values-plist
+ (should (eq (nth (car values-plist)
+ (parse-partial-sexp (point-min) (point)))
+ (cadr values-plist)))
+ (setq values-plist (cddr values-plist)))))
+
+(defun ruby-assert-face (content pos face)
+ (with-temp-buffer
+ (insert content)
+ (ruby-mode)
+ (font-lock-fontify-buffer)
+ (should (eq face (get-text-property pos 'face)))))
+
+(ert-deftest ruby-indent-after-symbol-made-from-string-interpolation ()
+ "It can indent the line after symbol made using string interpolation."
+ (ruby-should-indent "def foo(suffix)\n :\"bar#{suffix}\"\n"
+ ruby-indent-level))
+
+(ert-deftest ruby-indent-after-js-style-symbol-with-block-beg-name ()
+ "JS-style hash symbol can have keyword name."
+ (ruby-should-indent "link_to \"home\", home_path, class: \"foo\"\n" 0))
+
+(ert-deftest ruby-discern-singleton-class-from-heredoc ()
+ (ruby-assert-state "foo <<asd\n" 3 ?\n)
+ (ruby-assert-state "class <<asd\n" 3 nil))
+
+(ert-deftest ruby-heredoc-font-lock ()
+ (let ((s "foo <<eos.gsub('^ *', '')"))
+ (ruby-assert-face s 9 font-lock-string-face)
+ (ruby-assert-face s 10 nil)))
+
+(ert-deftest ruby-singleton-class-no-heredoc-font-lock ()
+ (ruby-assert-face "class<<a" 8 nil))
+
+(ert-deftest ruby-deep-indent ()
+ (let ((ruby-deep-arglist nil)
+ (ruby-deep-indent-paren '(?\( ?\{ ?\[ ?\] t)))
+ (ruby-should-indent "foo = [1,\n2" 7)
+ (ruby-should-indent "foo = {a: b,\nc: d" 7)
+ (ruby-should-indent "foo(a,\nb" 4)))
+
+(ert-deftest ruby-deep-indent-disabled ()
+ (let ((ruby-deep-arglist nil)
+ (ruby-deep-indent-paren nil))
+ (ruby-should-indent "foo = [\n1" ruby-indent-level)
+ (ruby-should-indent "foo = {\na: b" ruby-indent-level)
+ (ruby-should-indent "foo(\na" ruby-indent-level)))
+
+(ert-deftest ruby-indent-after-keyword-in-a-string ()
+ (ruby-should-indent "a = \"abc\nif\"\n " 0)
+ (ruby-should-indent "a = %w[abc\n def]\n " 0)
+ (ruby-should-indent "a = \"abc\n def\"\n " 0))
+
+(ert-deftest ruby-indent-simple ()
+ (ruby-should-indent-buffer
+ "if foo
+ | bar
+ |end
+ |zot
+ |"
+ "if foo
+ |bar
+ | end
+ | zot
+ |"))
+
+(ert-deftest ruby-indent-keyword-label ()
+ (ruby-should-indent-buffer
+ "bar(class: XXX) do
+ | foo
+ |end
+ |bar
+ |"
+ "bar(class: XXX) do
+ | foo
+ | end
+ | bar
+ |"))
+
+(ert-deftest ruby-indent-method-with-question-mark ()
+ (ruby-should-indent-buffer
+ "if x.is_a?(XXX)
+ | foo
+ |end
+ |"
+ "if x.is_a?(XXX)
+ | foo
+ | end
+ |"))
+
+(ert-deftest ruby-indent-expr-in-regexp ()
+ (ruby-should-indent-buffer
+ "if /#{foo}/ =~ s
+ | x = 1
+ |end
+ |"
+ "if /#{foo}/ =~ s
+ | x = 1
+ | end
+ |"))
+
+(ert-deftest ruby-indent-singleton-class ()
+ (ruby-should-indent-buffer
+ "class<<bar
+ | foo
+ |end
+ |"
+ "class<<bar
+ |foo
+ | end
+ |"))
+
+(ert-deftest ruby-indent-inside-heredoc-after-operator ()
+ (ruby-should-indent-buffer
+ "b=<<eos
+ | 42"
+ "b=<<eos
+ | 42"))
+
+(ert-deftest ruby-indent-inside-heredoc-after-space ()
+ (ruby-should-indent-buffer
+ "foo <<eos.gsub(' ', '*')
+ | 42"
+ "foo <<eos.gsub(' ', '*')
+ | 42"))
+
+(ert-deftest ruby-indent-array-literal ()
+ (let ((ruby-deep-indent-paren nil))
+ (ruby-should-indent-buffer
+ "foo = [
+ | bar
+ |]
+ |"
+ "foo = [
+ | bar
+ | ]
+ |"))
+ (ruby-should-indent-buffer
+ "foo do
+ | [bar]
+ |end
+ |"
+ "foo do
+ |[bar]
+ | end
+ |"))
+
+(ert-deftest ruby-indent-begin-end ()
+ (ruby-should-indent-buffer
+ "begin
+ | a[b]
+ |end
+ |"
+ "begin
+ | a[b]
+ | end
+ |"))
+
+(ert-deftest ruby-indent-array-after-paren-and-space ()
+ (ruby-should-indent-buffer
+ "class A
+ | def foo
+ | foo( [])
+ | end
+ |end
+ |"
+ "class A
+ | def foo
+ |foo( [])
+ |end
+ | end
+ |"))
+
+(ert-deftest ruby-move-to-block-stops-at-indentation ()
+ (with-temp-buffer
+ (insert "def f\nend")
+ (beginning-of-line)
+ (ruby-mode)
+ (ruby-move-to-block -1)
+ (should (looking-at "^def"))))
+
+(ert-deftest ruby-toggle-block-to-do-end ()
+ (with-temp-buffer
+ (insert "foo {|b|\n}")
+ (ruby-mode)
+ (beginning-of-line)
+ (ruby-toggle-block)
+ (should (string= "foo do |b|\nend" (buffer-string)))))
+
+(ert-deftest ruby-toggle-block-to-brace ()
+ (let ((pairs '((16 . "foo {|b| b + 2 }")
+ (15 . "foo {|b|\n b + 2\n}"))))
+ (dolist (pair pairs)
+ (with-temp-buffer
+ (let ((fill-column (car pair)))
+ (insert "foo do |b|\n b + 2\nend")
+ (ruby-mode)
+ (beginning-of-line)
+ (ruby-toggle-block)
+ (should (string= (cdr pair) (buffer-string))))))))
+
+(ert-deftest ruby-toggle-block-to-multiline ()
+ (with-temp-buffer
+ (insert "foo {|b| b + 1}")
+ (ruby-mode)
+ (beginning-of-line)
+ (ruby-toggle-block)
+ (should (string= "foo do |b|\n b + 1\nend" (buffer-string)))))
+
+(ert-deftest ruby-recognize-symbols-starting-with-at-character ()
+ (ruby-assert-face ":@abc" 3 font-lock-constant-face))
+
+(ert-deftest ruby-hash-character-not-interpolation ()
+ (ruby-assert-face "\"This is #{interpolation}\"" 15
+ font-lock-variable-name-face)
+ (ruby-assert-face "\"This is \\#{no interpolation} despite the #\""
+ 15 font-lock-string-face)
+ (ruby-assert-face "\n#@comment, not ruby code" 5 font-lock-comment-face)
+ (ruby-assert-state "\n#@comment, not ruby code" 4 t)
+ (ruby-assert-face "# A comment cannot have #{an interpolation} in it"
+ 30 font-lock-comment-face)
+ (ruby-assert-face "# #{comment}\n \"#{interpolation}\"" 16
+ font-lock-variable-name-face))
+
+(ert-deftest ruby-interpolation-suppresses-syntax-inside ()
+ (let ((s "\"<ul><li>#{@files.join(\"</li><li>\")}</li></ul>\""))
+ (ruby-assert-state s 8 nil)
+ (ruby-assert-face s 9 font-lock-string-face)
+ (ruby-assert-face s 10 font-lock-variable-name-face)
+ (ruby-assert-face s 41 font-lock-string-face)))
+
+(ert-deftest ruby-interpolation-inside-percent-literal-with-paren ()
+ :expected-result :failed
+ (let ((s "%(^#{\")\"}^)"))
+ (ruby-assert-face s 3 font-lock-string-face)
+ (ruby-assert-face s 4 font-lock-variable-name-face)
+ (ruby-assert-face s 10 font-lock-string-face)
+ ;; It's confused by the closing paren in the middle.
+ (ruby-assert-state s 8 nil)))
+
+(ert-deftest ruby-add-log-current-method-examples ()
+ (let ((pairs '(("foo" . "#foo")
+ ("C.foo" . ".foo")
+ ("self.foo" . ".foo"))))
+ (loop for (name . value) in pairs
+ do (with-temp-buffer
+ (insert (ruby-test-string
+ "module M
+ | class C
+ | def %s
+ | end
+ | end
+ |end"
+ name))
+ (ruby-mode)
+ (search-backward "def")
+ (forward-line)
+ (should (string= (ruby-add-log-current-method)
+ (format "M::C%s" value)))))))
+
+(defvar ruby-block-test-example
+ (ruby-test-string
+ "class C
+ | def foo
+ | 1
+ | end
+ |
+ | def bar
+ | 2
+ | end
+ |
+ | def baz
+ | some do
+ | end
+ | end
+ |end"))
+
+(defmacro ruby-deftest-move-to-block (name &rest body)
+ `(ert-deftest ,(intern (format "ruby-move-to-block-%s" name)) ()
+ (with-temp-buffer
+ (insert ruby-block-test-example)
+ (ruby-mode)
+ ,@body)))
+
+(put 'ruby-deftest-move-to-block 'lisp-indent-function 'defun)
+
+(ruby-deftest-move-to-block works-on-do
+ (goto-line 11)
+ (ruby-end-of-block)
+ (should (= 12 (line-number-at-pos)))
+ (ruby-beginning-of-block)
+ (should (= 11 (line-number-at-pos))))
+
+(ruby-deftest-move-to-block zero-is-noop
+ (goto-line 5)
+ (ruby-move-to-block 0)
+ (should (= 5 (line-number-at-pos))))
+
+(ruby-deftest-move-to-block ok-with-three
+ (goto-line 2)
+ (ruby-move-to-block 3)
+ (should (= 13 (line-number-at-pos))))
+
+(ruby-deftest-move-to-block ok-with-minus-two
+ (goto-line 10)
+ (ruby-move-to-block -2)
+ (should (= 2 (line-number-at-pos))))
+
+(provide 'ruby-mode-tests)
+
+;;; ruby-mode-tests.el ends here
diff --git a/test/automated/url-future-tests.el b/test/automated/url-future-tests.el
new file mode 100644
index 00000000000..d499da6dbe2
--- /dev/null
+++ b/test/automated/url-future-tests.el
@@ -0,0 +1,57 @@
+;;; url-future-tests.el --- Test suite for url-future.
+
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+;; Author: Teodor Zlatanov <tzz@lifelogs.com>
+;; Keywords: data
+
+;; 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/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'url-future)
+
+(ert-deftest url-future-tests ()
+ (let* (saver
+ (text "running future")
+ (good (make-url-future :value (lambda () (format text))
+ :callback (lambda (f) (set 'saver f))))
+ (bad (make-url-future :value (lambda () (/ 1 0))
+ :errorback (lambda (&rest d) (set 'saver d))))
+ (tocancel (make-url-future :value (lambda () (/ 1 0))
+ :callback (lambda (f) (set 'saver f))
+ :errorback (lambda (&rest d)
+ (set 'saver d)))))
+ (should (equal good (url-future-call good)))
+ (should (equal good saver))
+ (should (equal text (url-future-value good)))
+ (should (url-future-completed-p good))
+ (should-error (url-future-call good))
+ (setq saver nil)
+ (should (equal bad (url-future-call bad)))
+ (should-error (url-future-call bad))
+ (should (equal saver (list bad '(arith-error))))
+ (should (url-future-errored-p bad))
+ (setq saver nil)
+ (should (equal (url-future-cancel tocancel) tocancel))
+ (should-error (url-future-call tocancel))
+ (should (null saver))
+ (should (url-future-cancelled-p tocancel))))
+
+(provide 'url-future-tests)
+
+;;; url-future-tests.el ends here
diff --git a/test/automated/url-util-tests.el b/test/automated/url-util-tests.el
new file mode 100644
index 00000000000..65eb37ce926
--- /dev/null
+++ b/test/automated/url-util-tests.el
@@ -0,0 +1,51 @@
+;;; url-util-tests.el --- Test suite for url-util.
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Teodor Zlatanov <tzz@lifelogs.com>
+;; Keywords: data
+
+;; 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/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'url-util)
+
+(ert-deftest url-util-tests ()
+ (let ((tests
+ '(("key1=val1&key2=val2&key3=val1&key3=val2&key4&key5"
+ ((key1 val1) (key2 "val2") (key3 val1 val2) (key4) (key5 "")))
+ ("key1=val1;key2=val2;key3=val1;key3=val2;key4;key5"
+ ((key1 "val1") (key2 val2) (key3 val1 val2) ("key4") (key5 "")) t)
+ ("key1=val1;key2=val2;key3=val1;key3=val2;key4=;key5="
+ ((key1 val1) (key2 val2) ("key3" val1 val2) (key4) (key5 "")) t t)))
+ test)
+ (while tests
+ (setq test (car tests)
+ tests (cdr tests))
+ (should (equal (apply 'url-build-query-string (cdr test)) (car test)))))
+ (should (equal (url-parse-query-string
+ "key1=val1&key2=val2&key3=val1&key3=val2&key4=&key5")
+ '(("key5" "")
+ ("key4" "")
+ ("key3" "val2" "val1")
+ ("key2" "val2")
+ ("key1" "val1")))))
+
+(provide 'url-util-tests)
+
+;;; url-util-tests.el ends here
diff --git a/test/automated/vc-bzr.el b/test/automated/vc-bzr.el
index b2cbda4d669..94f8502b882 100644
--- a/test/automated/vc-bzr.el
+++ b/test/automated/vc-bzr.el
@@ -1,6 +1,6 @@
;;; vc-bzr.el --- tests for vc/vc-bzr.el
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Glenn Morris <rgm@gnu.org>
@@ -98,4 +98,31 @@
(should (get-buffer "*vc-log*")))
(delete-directory tempdir t))))
+;; http://lists.gnu.org/archive/html/help-gnu-emacs/2012-04/msg00145.html
+(ert-deftest vc-bzr-test-faulty-bzr-autoloads ()
+ "Test we can generate autoloads in a bzr directory when bzr is faulty."
+ :expected-result (if (executable-find vc-bzr-program) :passed :failed)
+ (should (executable-find vc-bzr-program))
+ (let* ((tempdir (make-temp-file "vc-bzr-test" t))
+ (file (expand-file-name "foo.el" tempdir))
+ (default-directory (file-name-as-directory tempdir))
+ (generated-autoload-file (expand-file-name "loaddefs.el" tempdir)))
+ (unwind-protect
+ (progn
+ (call-process vc-bzr-program nil nil nil "init")
+ (with-temp-buffer
+ (insert ";;;###autoload
+\(defun foo () \"foo\" (interactive) (message \"foo!\"))")
+ (write-region nil nil file nil 'silent))
+ (call-process vc-bzr-program nil nil nil "add")
+ (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
+ ;; Deleting dirstate ensures both that vc-bzr's status heuristic
+ ;; fails, so it has to call the external bzr status, and
+ ;; causes bzr status to fail. This simulates a broken bzr
+ ;; installation.
+ (delete-file ".bzr/checkout/dirstate")
+ (should (progn (update-directory-autoloads default-directory)
+ t)))
+ (delete-directory tempdir t))))
+
;;; vc-bzr.el ends here
diff --git a/test/automated/xml-parse-tests.el b/test/automated/xml-parse-tests.el
new file mode 100644
index 00000000000..35009ed36a2
--- /dev/null
+++ b/test/automated/xml-parse-tests.el
@@ -0,0 +1,135 @@
+;;; xml-parse-tests.el --- Test suite for XML parsing.
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Chong Yidong <cyd@stupidchicken.com>
+;; Keywords: internal
+;; Human-Keywords: internal
+
+;; 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:
+
+;; Type M-x test-xml-parse RET to generate the test buffer.
+
+;;; Code:
+
+(require 'xml)
+
+(defvar xml-parse-tests--data
+ `(;; General entity substitution
+ ("<?xml version=\"1.0\"?><!DOCTYPE foo SYSTEM \"bar.dtd\" [<!ENTITY ent \"AbC\">]><foo a=\"b\"><bar>&ent;;</bar></foo>" .
+ ((foo ((a . "b")) (bar nil "AbC;"))))
+ ("<?xml version=\"1.0\"?><foo>&amp;amp;&#x26;apos;&apos;&lt;&gt;&quot;</foo>" .
+ ((foo () "&amp;&apos;'<>\"")))
+ ;; Parameter entity substitution
+ ("<?xml version=\"1.0\"?><!DOCTYPE foo SYSTEM \"bar.dtd\" [<!ENTITY % pent \"AbC\"><!ENTITY ent \"%pent;\">]><foo a=\"b\"><bar>&ent;;</bar></foo>" .
+ ((foo ((a . "b")) (bar nil "AbC;"))))
+ ;; Tricky parameter entity substitution (like XML spec Appendix D)
+ ("<?xml version='1.0'?><!DOCTYPE foo [ <!ENTITY % xx '&#37;zz;'><!ENTITY % zz '&#60;!ENTITY ent \"b\" >' > %xx; ]><foo>A&ent;C</foo>" .
+ ((foo () "AbC")))
+ ;; Bug#7172
+ ("<?xml version=\"1.0\"?><!DOCTYPE foo [ <!ELEMENT EXAM_PLE EMPTY> ]><foo></foo>" .
+ ((foo ())))
+ ;; Entities referencing entities, in character data
+ ("<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">]><foo>&abc;</foo>" .
+ ((foo () "aBc")))
+ ;; Entities referencing entities, in attribute values
+ ("<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">]><foo a=\"-&abc;-\">1</foo>" .
+ ((foo ((a . "-aBc-")) "1")))
+ ;; Character references must be treated as character data
+ ("<foo>AT&amp;T;</foo>" . ((foo () "AT&T;")))
+ ("<foo>&#38;amp;</foo>" . ((foo () "&amp;")))
+ ("<foo>&#x26;amp;</foo>" . ((foo () "&amp;")))
+ ;; Unusual but valid XML names [5]
+ ("<ÀÖØö.3·-‿⁀󯿿>abc</ÀÖØö.3·-‿⁀󯿿>" . ((,(intern "ÀÖØö.3·-‿⁀󯿿") () "abc")))
+ ("<:>abc</:>" . ((,(intern ":") () "abc"))))
+ "Alist of XML strings and their expected parse trees.")
+
+(defvar xml-parse-tests--bad-data
+ '(;; XML bomb in content
+ "<!DOCTYPE foo [<!ENTITY lol \"lol\"><!ENTITY lol1 \"&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;\"><!ENTITY lol2 \"&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;\">]><foo>&lol2;</foo>"
+ ;; XML bomb in attribute value
+ "<!DOCTYPE foo [<!ENTITY lol \"lol\"><!ENTITY lol1 \"&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;\"><!ENTITY lol2 \"&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;\">]><foo a=\"&lol2;\">!</foo>"
+ ;; Non-terminating DTD
+ "<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">"
+ "<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">asdf"
+ "<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">asdf&abc;"
+ ;; Invalid XML names
+ "<0foo>abc</0foo>"
+ "<‿foo>abc</‿foo>"
+ "<f¿>abc</f¿>")
+ "List of XML strings that should signal an error in the parser")
+
+(defvar xml-parse-tests--qnames
+ '( ;; Test data for name expansion
+ ("<?xml version=\"1.0\" encoding=\"UTF-8\"?><D:multistatus xmlns:D=\"DAV:\"><D:response><D:href>/calendar/events/</D:href><D:propstat><D:status>HTTP/1.1 200 OK</D:status></D:propstat></D:response></D:multistatus>"
+ ;; Result with qnames as cons
+ ((("DAV:" . "multistatus")
+ ((("http://www.w3.org/2000/xmlns/" . "D") . "DAV:"))
+ (("DAV:" . "response") nil (("DAV:" . "href") nil "/calendar/events/")
+ (("DAV:" . "propstat") nil (("DAV:" . "status") nil "HTTP/1.1 200 OK")))))
+ ;; Result with qnames as symbols
+ ((DAV:multistatus
+ ((("http://www.w3.org/2000/xmlns/" . "D") . "DAV:"))
+ (DAV:response nil (DAV:href nil "/calendar/events/")
+ (DAV:propstat nil (DAV:status nil "HTTP/1.1 200 OK"))))))
+ ("<?xml version=\"1.0\" encoding=\"UTF-8\"?><F:something>hi there</F:something>"
+ ((("FOOBAR:" . "something") nil "hi there"))
+ ((FOOBAR:something nil "hi there"))))
+ "List of strings which are parsed using namespace expansion.
+Parser is called with and without 'symbol-qnames argument.")
+
+(ert-deftest xml-parse-tests ()
+ "Test XML parsing."
+ (with-temp-buffer
+ (dolist (test xml-parse-tests--data)
+ (erase-buffer)
+ (insert (car test))
+ (should (equal (cdr test) (xml-parse-region))))
+ (let ((xml-entity-expansion-limit 50))
+ (dolist (test xml-parse-tests--bad-data)
+ (erase-buffer)
+ (insert test)
+ (should-error (xml-parse-region))))
+ (let ((testdata (car xml-parse-tests--qnames)))
+ (erase-buffer)
+ (insert (car testdata))
+ (should (equal (nth 1 testdata)
+ (xml-parse-region nil nil nil nil t)))
+ (should (equal (nth 2 testdata)
+ (xml-parse-region nil nil nil nil 'symbol-qnames))))
+ (let ((testdata (nth 1 xml-parse-tests--qnames)))
+ (erase-buffer)
+ (insert (car testdata))
+ ;; Provide additional namespace-URI mapping
+ (should (equal (nth 1 testdata)
+ (xml-parse-region
+ nil nil nil nil
+ (append xml-default-ns
+ '(("F" . "FOOBAR:"))))))
+ (should (equal (nth 2 testdata)
+ (xml-parse-region
+ nil nil nil nil
+ (cons 'symbol-qnames
+ (append xml-default-ns
+ '(("F" . "FOOBAR:"))))))))))
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; xml-parse-tests.el ends here.
diff --git a/test/cedet/cedet-utests.el b/test/cedet/cedet-utests.el
index f7eef05dd99..f5df51dc4c9 100644
--- a/test/cedet/cedet-utests.el
+++ b/test/cedet/cedet-utests.el
@@ -1,6 +1,6 @@
;;; cedet-utests.el --- Run all unit tests in the CEDET suite.
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/ede-tests.el b/test/cedet/ede-tests.el
index f07098a8a9a..f73e4bed63f 100644
--- a/test/cedet/ede-tests.el
+++ b/test/cedet/ede-tests.el
@@ -1,6 +1,6 @@
;;; ede-tests.el --- Some tests for the Emacs Development Environment
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/semantic-ia-utest.el b/test/cedet/semantic-ia-utest.el
index 765029151dc..c523e103669 100644
--- a/test/cedet/semantic-ia-utest.el
+++ b/test/cedet/semantic-ia-utest.el
@@ -1,6 +1,6 @@
;;; semantic-ia-utest.el --- Analyzer unit tests
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/semantic-tests.el b/test/cedet/semantic-tests.el
index 16dcd42c2ae..22b959016c1 100644
--- a/test/cedet/semantic-tests.el
+++ b/test/cedet/semantic-tests.el
@@ -1,6 +1,6 @@
;;; semantic-utest.el --- Miscellaneous Semantic tests.
-;;; Copyright (C) 2003-2004, 2007-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2003-2004, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/cedet/semantic-utest-c.el b/test/cedet/semantic-utest-c.el
index 3fbd180290c..c500f543187 100644
--- a/test/cedet/semantic-utest-c.el
+++ b/test/cedet/semantic-utest-c.el
@@ -1,6 +1,6 @@
;;; semantic-utest-c.el --- C based parsing tests.
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/semantic-utest.el b/test/cedet/semantic-utest.el
index 12fbc37a112..728106d863c 100644
--- a/test/cedet/semantic-utest.el
+++ b/test/cedet/semantic-utest.el
@@ -1,6 +1,6 @@
;;; semantic-utest.el --- Tests for semantic's parsing system.
-;;; Copyright (C) 2003-2004, 2007-2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2003-2004, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/cedet/srecode-tests.el b/test/cedet/srecode-tests.el
index a1b8f60b2ec..d0239f627b3 100644
--- a/test/cedet/srecode-tests.el
+++ b/test/cedet/srecode-tests.el
@@ -1,6 +1,6 @@
;;; srecode-tests.el --- Some tests for CEDET's srecode
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/tests/test.c b/test/cedet/tests/test.c
index 6f96f794915..b2d9971ff4f 100644
--- a/test/cedet/tests/test.c
+++ b/test/cedet/tests/test.c
@@ -1,6 +1,6 @@
/* test.c --- Semantic unit test for C.
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/tests/test.el b/test/cedet/tests/test.el
index 57056b8065b..a07a9316f35 100644
--- a/test/cedet/tests/test.el
+++ b/test/cedet/tests/test.el
@@ -1,6 +1,6 @@
;;; test.el --- Unit test file for Semantic Emacs Lisp support.
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/tests/test.make b/test/cedet/tests/test.make
index a8a3e344cad..cc9d450c1e0 100644
--- a/test/cedet/tests/test.make
+++ b/test/cedet/tests/test.make
@@ -1,6 +1,6 @@
# test.make --- Semantic unit test for Make -*- makefile -*-
-# Copyright (C) 2001-2002, 2010-2011 Free Software Foundation, Inc.
+# Copyright (C) 2001-2002, 2010-2012 Free Software Foundation, Inc.
# Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/tests/testdoublens.cpp b/test/cedet/tests/testdoublens.cpp
index c0993af0863..72a7e10dc5a 100644
--- a/test/cedet/tests/testdoublens.cpp
+++ b/test/cedet/tests/testdoublens.cpp
@@ -1,6 +1,6 @@
// testdoublens.cpp --- semantic-ia-utest completion engine unit tests
-// Copyright (C) 2008-2011 Free Software Foundation, Inc.
+// Copyright (C) 2008-2012 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/tests/testdoublens.hpp b/test/cedet/tests/testdoublens.hpp
index 94349ed8544..69475ee3c19 100644
--- a/test/cedet/tests/testdoublens.hpp
+++ b/test/cedet/tests/testdoublens.hpp
@@ -1,6 +1,6 @@
// testdoublens.hpp --- Header file used in one of the Semantic tests
-// Copyright (C) 2008-2011 Free Software Foundation, Inc.
+// Copyright (C) 2008-2012 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/tests/testjavacomp.java b/test/cedet/tests/testjavacomp.java
index e9aed8c51f3..54b9f4aa004 100644
--- a/test/cedet/tests/testjavacomp.java
+++ b/test/cedet/tests/testjavacomp.java
@@ -1,6 +1,6 @@
// testjavacomp.java --- Semantic unit test for Java
-// Copyright (C) 2009-2011 Free Software Foundation, Inc.
+// Copyright (C) 2009-2012 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/tests/testpolymorph.cpp b/test/cedet/tests/testpolymorph.cpp
index 83175406e90..2108da14e56 100644
--- a/test/cedet/tests/testpolymorph.cpp
+++ b/test/cedet/tests/testpolymorph.cpp
@@ -1,6 +1,6 @@
/** testpolymorph.cpp --- A sequence of polymorphism examples.
*
- * Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ * Copyright (C) 2009-2012 Free Software Foundation, Inc.
*
* Author: Eric M. Ludlam <eric@siege-engine.com>
*
diff --git a/test/cedet/tests/testspp.c b/test/cedet/tests/testspp.c
index 1cd45e47e1f..1fbabd62d14 100644
--- a/test/cedet/tests/testspp.c
+++ b/test/cedet/tests/testspp.c
@@ -1,6 +1,6 @@
/* testspp.cpp --- Semantic unit test for the C preprocessor
- Copyright (C) 2007-2011 Free Software Foundation, Inc.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/tests/testsppreplace.c b/test/cedet/tests/testsppreplace.c
index 4ec87654dc4..36b4cb5fa57 100644
--- a/test/cedet/tests/testsppreplace.c
+++ b/test/cedet/tests/testsppreplace.c
@@ -1,5 +1,5 @@
/* testsppreplace.c --- unit test for CPP/SPP Replacement
- Copyright (C) 2007-2011 Free Software Foundation, Inc.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/tests/testsppreplaced.c b/test/cedet/tests/testsppreplaced.c
index 58d1ac2b684..19e3b7ec869 100644
--- a/test/cedet/tests/testsppreplaced.c
+++ b/test/cedet/tests/testsppreplaced.c
@@ -1,5 +1,5 @@
/* testsppreplaced.c --- unit test for CPP/SPP Replacement
- Copyright (C) 2007-2011 Free Software Foundation, Inc.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/tests/testsubclass.cpp b/test/cedet/tests/testsubclass.cpp
index 6a704818b0d..3fb61053a41 100644
--- a/test/cedet/tests/testsubclass.cpp
+++ b/test/cedet/tests/testsubclass.cpp
@@ -1,6 +1,6 @@
// testsubclass.cpp --- unit test for analyzer and complex C++ inheritance
-// Copyright (C) 2007-2011 Free Software Foundation, Inc.
+// Copyright (C) 2007-2012 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/tests/testsubclass.hh b/test/cedet/tests/testsubclass.hh
index 9e6d777d74d..dee470b899f 100644
--- a/test/cedet/tests/testsubclass.hh
+++ b/test/cedet/tests/testsubclass.hh
@@ -1,6 +1,6 @@
// testsubclass.hh --- unit test for analyzer and complex C++ inheritance
-// Copyright (C) 2007-2011 Free Software Foundation, Inc.
+// Copyright (C) 2007-2012 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/tests/testtypedefs.cpp b/test/cedet/tests/testtypedefs.cpp
index f97b1400454..f3666bea316 100644
--- a/test/cedet/tests/testtypedefs.cpp
+++ b/test/cedet/tests/testtypedefs.cpp
@@ -1,6 +1,6 @@
// testtypedefs.cpp --- Sample with some fake bits out of std::string
-// Copyright (C) 2008-2011 Free Software Foundation, Inc.
+// Copyright (C) 2008-2012 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/test/cedet/tests/testvarnames.c b/test/cedet/tests/testvarnames.c
index 51d8285730f..5cade2f0bd8 100644
--- a/test/cedet/tests/testvarnames.c
+++ b/test/cedet/tests/testvarnames.c
@@ -1,7 +1,7 @@
/* testvarnames.cpp
Test variable and function names, lists of variables on one line, etc.
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -31,7 +31,7 @@ struct independent var_indep_struct;
struct {
int unnamed_1;
int unnamed_2;
-} var_unamed_struct;
+} var_unnamed_struct;
struct {
int unnamed_3;
@@ -59,12 +59,12 @@ struct inline2struct in_var2;
int test_1(int var_arg1) {
var_// -1-
- ; // #1# ("var_arg1" "var_indep_struct" "var_n_2" "var_n_3" "var_named_struct" "var_un_2" "var_un_3" "var_unamed_struct")
+ ; // #1# ("var_arg1" "var_indep_struct" "var_n_2" "var_n_3" "var_named_struct" "var_un_2" "var_un_3" "var_unnamed_struct")
var_indep_struct.// -2-
; // #2# ( "indep_1" "indep_2" )
- var_unamed_struct.// -3-
+ var_unnamed_struct.// -3-
; // #3# ( "unnamed_1" "unnamed_2" )
var_named_struct.// -4-
@@ -88,4 +88,3 @@ int test_1(int var_arg1) {
in_var2.// -11-
; // #11# ( "named_3" "named_4")
}
-
diff --git a/test/eshell.el b/test/eshell.el
index 8a9e62a759a..4d6480c81bb 100644
--- a/test/eshell.el
+++ b/test/eshell.el
@@ -1,6 +1,6 @@
;;; esh-test.el --- Eshell test suite
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -28,7 +28,7 @@
;;; Code:
(eval-when-compile
- (require 'cl) ; assert
+ (require 'cl-lib)
(require 'eshell)
(require 'esh-util))
(require 'esh-mode)
@@ -267,9 +267,9 @@
(eshell-deftest banner banner-displayed
"Startup banner is displayed at point-min"
- (assert eshell-banner-message)
+ (cl-assert eshell-banner-message)
(let ((msg (eval eshell-banner-message)))
- (assert msg)
+ (cl-assert msg)
(goto-char (point-min))
(looking-at msg)))
diff --git a/test/indent/latex-mode.tex b/test/indent/latex-mode.tex
new file mode 100644
index 00000000000..55c8e7033bd
--- /dev/null
+++ b/test/indent/latex-mode.tex
@@ -0,0 +1,11 @@
+\documentclass{article} % -*- eval: (bug-reference-mode 1) -*-
+
+\usepackage[utf8]{inputenc}
+
+\begin{document}
+
+To fix this, remove the \url{sn9c102.ko} from where it appears in
+\url{/lib/modules/$(uname -r)}, %bug#11953.
+and install the appropriate \url{gspca-modules} package.
+
+\end{document}
diff --git a/test/indent/perl.perl b/test/indent/perl.perl
new file mode 100755
index 00000000000..2411c96a5e4
--- /dev/null
+++ b/test/indent/perl.perl
@@ -0,0 +1,5 @@
+#!/usr/bin/perl
+# -*- eval: (bug-reference-mode 1) -*-
+
+$fileType_filesButNot # bug#12373?
+ = join( '|', map { quotemeta($_).'$' } @{$fileType->{filesButNot}} );
diff --git a/test/indent/ruby.rb b/test/indent/ruby.rb
new file mode 100644
index 00000000000..4f2e9e63377
--- /dev/null
+++ b/test/indent/ruby.rb
@@ -0,0 +1,27 @@
+# Percent literals.
+b = %Q{This is a "string"}
+c = %w!foo
+ bar
+ baz!
+d = %(hello (nested) world)
+
+# Don't propertize percent literals inside strings.
+"(%s, %s)" % [123, 456]
+
+# Or inside comments.
+x = # "tot %q/to"; =
+y = 2 / 3
+
+# Regexp after whitelisted method.
+"abc".sub /b/, 'd'
+
+# Don't mis-match "sub" at the end of words.
+a = asub / aslb + bsub / bslb;
+
+# Highlight the regexp after "if".
+x = toto / foo if /do bar/ =~ "dobar"
+
+# Some Cucumber code:
+Given /toto/ do
+ print "hello"
+end
diff --git a/test/indent/shell.rc b/test/indent/shell.rc
index 841223555b9..e5c63e335b9 100755
--- a/test/indent/shell.rc
+++ b/test/indent/shell.rc
@@ -1,7 +1,10 @@
#!/bin/rc
if (foo) {
- echo 1
+ echo 1 \
+ toto \
+ tutu
+ titi
}
if not {
echo 2
@@ -23,6 +26,10 @@ switch ($a) {
for (i in a b c)
echo "$i" # KNOWN INDENT BUG
echo titi
+ if (foo)
+ echo 3 # KNOWN INDENT BUG
+ if not
+ echo 4 # KNOWN INDENT BUG
case *
echo other
diff --git a/test/indent/shell.sh b/test/indent/shell.sh
index 89f47d0bfe3..6f3447c3aa9 100755
--- a/test/indent/shell.sh
+++ b/test/indent/shell.sh
@@ -1,9 +1,26 @@
#!/bin/sh
+# -*- eval: (bug-reference-mode 1) -*-
setlock -n /tmp/getmail.lock && echo getmail isn\'t running
# adsgsdg
+echo -n $(( 5 << 2 ))
+# This should not be treated as a heredoc (bug#12770).
+2
+
+foo='bar<<' # bug#11263
+echo ${foo%<<aa} # bug#11263
+echo $((1<<8)) # bug#11263
+echo $[1<<8] # bug#11263
+
+declare -a VERSION
+for i in $(ls "$PREFIX/sbin") ; do
+ echo -e $N')' $i
+ VERSION[${#VERSION[*]}]=$i #bug#11946.
+ N=$(($N + 1))
+done
+
foo () {
bar () {
@@ -13,11 +30,15 @@ foo () {
case toto
in a) hello # KNOWN INDENT BUG
;; b) hi # KNOWN INDENT BUG
+ ;; c) hi # KNOWN INDENT BUG
esac
case $toto in
a) echo 1;; b) echo 2;;
- c) echo 3;;
+ (c)
+ echo 3;;
+ d)
+ echo 3;;
esac
case $as_nl`(ac_space=' '; set) 2>&1` in #(
@@ -34,7 +55,8 @@ foo () {
sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
;;
esac |
- cat # KNOWN INDENT BUG
+ grep '.' | # KNOWN INDENT BUG
+ sed 1d
case toto in
-exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
diff --git a/test/redisplay-testsuite.el b/test/redisplay-testsuite.el
index afa42cc494a..39f81a13c60 100644
--- a/test/redisplay-testsuite.el
+++ b/test/redisplay-testsuite.el
@@ -1,6 +1,6 @@
;;; redisplay-testsuite.el --- Test suite for redisplay.
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Author: Chong Yidong <cyd@stupidchicken.com>
;; Keywords: internal
@@ -113,7 +113,7 @@
(insert "\n\n"))
(defun test-redisplay-3 ()
- (insert "Test 3: Overlay with before/after strings and images:\n\n")
+ (insert "Test 3: Overlay with strings and images:\n\n")
(let ((img-data "#define x_width 8
#define x_height 8
static unsigned char x_bits[] = {0xff, 0x81, 0xbd, 0xa5, 0xa5, 0xbd, 0x81, 0xff };"))
@@ -165,16 +165,109 @@ static unsigned char x_bits[] = {0xff, 0x81, 0xbd, 0xa5, 0xa5, 0xbd, 0x81, 0xff
(overlay-put ov2 'before-string "C")
(overlay-put ov3 'display `(image :data ,img-data :type xbm))))))
+(defun test-redisplay-4 ()
+ (insert "Test 4: Overlay strings and invisibility:\n\n")
+ ;; Before and after strings with non-nil `invisibility'.
+ (insert " Expected: ABC\n")
+ (insert " Result: ")
+ (let ((opoint (point)))
+ (insert "ABC\n")
+ (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
+ (overlay-put ov 'before-string
+ (propertize "XX" 'invisible
+ 'test-redisplay--simple-invis))
+ (overlay-put ov 'after-string
+ (propertize "XX" 'invisible
+ 'test-redisplay--simple-invis))))
+
+ ;; Before and after strings bogus `invisibility' property (value is
+ ;; not listed in `buffer-invisibility-spec').
+ (insert "\n Expected: ABC")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "B\n")
+ (let ((ov (make-overlay opoint (1+ opoint))))
+ (overlay-put ov 'before-string
+ (propertize "A" 'invisible 'bogus-invis-spec))
+ (overlay-put ov 'after-string
+ (propertize "C" 'invisible 'bogus-invis-spec))))
+
+ ;; Before/after string with ellipsis `invisibility' property.
+ (insert "\n Expected: ...B...")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "B\n")
+ (let ((ov (make-overlay opoint (1+ opoint))))
+ (overlay-put ov 'before-string
+ (propertize "A" 'invisible 'test-redisplay--ellipsis-invis))
+ (overlay-put ov 'after-string
+ (propertize "C" 'invisible 'test-redisplay--ellipsis-invis))))
+
+ ;; Before/after string with partial ellipsis `invisibility' property.
+ (insert "\n Expected: A...ABC...C")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "B\n")
+ (let ((ov (make-overlay opoint (1+ opoint)))
+ (a "AAA")
+ (c "CCC"))
+ (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis a)
+ (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis c)
+ (overlay-put ov 'before-string a)
+ (overlay-put ov 'after-string c)))
+
+ ;; Display string with `invisibility' property.
+ (insert "\n Expected: ABC")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "AYBC\n")
+ (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
+ (overlay-put ov 'display
+ (propertize "XX" 'invisible
+ 'test-redisplay--simple-invis))))
+ ;; Display string with bogus `invisibility' property.
+ (insert "\n Expected: ABC")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "AXC\n")
+ (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
+ (overlay-put ov 'display
+ (propertize "B" 'invisible 'bogus-invis-spec))))
+ ;; Display string with ellipsis `invisibility' property.
+ (insert "\n Expected: A...C")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "AXC\n")
+ (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
+ (overlay-put ov 'display
+ (propertize "B" 'invisible
+ 'test-redisplay--ellipsis-invis))))
+ ;; Display string with partial `invisibility' property.
+ (insert "\n Expected: A...C")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "X\n")
+ (let ((ov (make-overlay opoint (1+ opoint)))
+ (str "ABC"))
+ (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis str)
+ (overlay-put ov 'display str)))
+
+ (insert "\n"))
+
(defun test-redisplay ()
(interactive)
(let ((buf (get-buffer "*Redisplay Test*")))
(if buf
(kill-buffer buf))
- (pop-to-buffer (get-buffer-create "*Redisplay Test*"))
+ (switch-to-buffer (get-buffer-create "*Redisplay Test*"))
(erase-buffer)
+ (setq buffer-invisibility-spec
+ '(test-redisplay--simple-invis
+ (test-redisplay--ellipsis-invis . t)))
(test-redisplay-1)
(test-redisplay-2)
(test-redisplay-3)
+ (test-redisplay-4)
(goto-char (point-min))))
diff --git a/test/rmailmm.el b/test/rmailmm.el
index 97577ee35cb..6844eb8187b 100644
--- a/test/rmailmm.el
+++ b/test/rmailmm.el
@@ -1,6 +1,6 @@
;;; rmailmm.el --- tests for mail/rmailmm.el
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/vpath.sed b/vpath.sed
deleted file mode 100644
index a792eb0e913..00000000000
--- a/vpath.sed
+++ /dev/null
@@ -1,8 +0,0 @@
-/^VPATH *=/c\
-# This works only in GNU make. Using the patterns avoids\
-# object files being found by VPATH, and thus permits building\
-# when $srcdir is configured itself.\
-vpath %.c $(srcdir)\
-vpath %.h $(srcdir)\
-\
-